From b79e6b442c79be0cd52dd0980863960ca11999fb Mon Sep 17 00:00:00 2001 From: kio-watatanabe Date: Tue, 27 Dec 2022 16:17:25 +0900 Subject: [PATCH 01/17] Fix CobolFile.java --- .../libcobj/file/CobolFile.java | 57 +++++++++---------- 1 file changed, 28 insertions(+), 29 deletions(-) diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java index 387616c2..e4a4053b 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java @@ -165,7 +165,7 @@ public class CobolFile { protected static String file_open_name; protected static byte[] file_open_buff = new byte[1024]; - protected static final String[] prefix = {"DD_", "dd_", ""}; + protected static final String[] prefix = { "DD_", "dd_", "" }; protected static final int NUM_PREFIX = prefix.length; protected static int eop_status = 0; @@ -174,16 +174,16 @@ public class CobolFile { private static List file_cache = new ArrayList(); protected static int[] status_exception = { - 0, - CobolExceptionId.COB_EC_I_O_AT_END, - CobolExceptionId.COB_EC_I_O_INVALID_KEY, - CobolExceptionId.COB_EC_I_O_PERMANENT_ERROR, - CobolExceptionId.COB_EC_I_O_LOGIC_ERROR, - CobolExceptionId.COB_EC_I_O_RECORD_OPERATION, - CobolExceptionId.COB_EC_I_O_FILE_SHARING, - CobolExceptionId.COB_EC_I_O, - CobolExceptionId.COB_EC_I_O, - CobolExceptionId.COB_EC_I_O_IMP + 0, + CobolExceptionId.COB_EC_I_O_AT_END, + CobolExceptionId.COB_EC_I_O_INVALID_KEY, + CobolExceptionId.COB_EC_I_O_PERMANENT_ERROR, + CobolExceptionId.COB_EC_I_O_LOGIC_ERROR, + CobolExceptionId.COB_EC_I_O_RECORD_OPERATION, + CobolExceptionId.COB_EC_I_O_FILE_SHARING, + CobolExceptionId.COB_EC_I_O, + CobolExceptionId.COB_EC_I_O, + CobolExceptionId.COB_EC_I_O_IMP }; protected String select_name; public byte[] file_status; @@ -229,7 +229,8 @@ public void setLinorkeyptr(Linage ptr) { this.linorkeyptr = ptr; } - public CobolFile() {} + public CobolFile() { + } public CobolFile( String select_name, @@ -286,7 +287,8 @@ public CobolFile( } /** - * libcob/fileio.cのsave_statusの実装 RETURN_STATUSマクロは実装できないため,本メソッドの呼び出し後の次の文はreturn;を書くこと. + * libcob/fileio.cのsave_statusの実装 + * RETURN_STATUSマクロは実装できないため,本メソッドの呼び出し後の次の文はreturn;を書くこと. * * @param status * @param fnstatus @@ -771,22 +773,19 @@ public int open_(String filename, int mode, int sharing) throws IOException { fp = FileChannel.open(Paths.get(filename), StandardOpenOption.READ); break; case COB_OPEN_OUTPUT: - fp = - FileChannel.open( - Paths.get(filename), - StandardOpenOption.WRITE, - StandardOpenOption.CREATE, - StandardOpenOption.TRUNCATE_EXISTING); + fp = FileChannel.open( + Paths.get(filename), + StandardOpenOption.WRITE, + StandardOpenOption.CREATE, + StandardOpenOption.TRUNCATE_EXISTING); break; case COB_OPEN_I_O: - fp = - FileChannel.open( - Paths.get(filename), StandardOpenOption.READ, StandardOpenOption.WRITE); + fp = FileChannel.open( + Paths.get(filename), StandardOpenOption.READ, StandardOpenOption.WRITE, StandardOpenOption.CREATE); break; case COB_OPEN_EXTEND: - fp = - FileChannel.open( - Paths.get(filename), StandardOpenOption.APPEND, StandardOpenOption.CREATE); + fp = FileChannel.open( + Paths.get(filename), StandardOpenOption.APPEND, StandardOpenOption.CREATE); break; } } catch (IOException e) { @@ -1021,7 +1020,7 @@ public void read(AbstractCobolField key, AbstractCobolField fnstatus, int read_o read_opts &= ~COB_READ_LOCK; } - if (this.organization == COB_ORG_INDEXED /* && bdb_env != null*/) { + if (this.organization == COB_ORG_INDEXED /* && bdb_env != null */) { if (this.open_mode != COB_OPEN_I_O || (this.lock_mode & COB_LOCK_EXCLUSIVE) != 0) { read_opts &= ~COB_READ_LOCK; } else if ((this.lock_mode & COB_LOCK_AUTOMATIC) != 0 @@ -1090,8 +1089,7 @@ public void write(AbstractCobolField rec, int opt, AbstractCobolField fnstatus) } String openMode = String.format("%02d", (int) this.last_open_mode); - if (invokeFun(COB_IO_WRITE, this, null, rec.getDataStorage(), fnstatus, openMode, null, null) - != 0) { + if (invokeFun(COB_IO_WRITE, this, null, rec.getDataStorage(), fnstatus, openMode, null, null) != 0) { return; } @@ -1265,7 +1263,8 @@ public void unlock(AbstractCobolField fnstatus) { public void unlock_() { if (this.open_mode != COB_OPEN_CLOSED && this.open_mode != COB_OPEN_LOCKED) { this.file.flush(); - if ((this.lock_mode & COB_LOCK_EXCLUSIVE) == 0) {} + if ((this.lock_mode & COB_LOCK_EXCLUSIVE) == 0) { + } } } From 15ce388bb092f3d91bb2754ed61822ea8b619125 Mon Sep 17 00:00:00 2001 From: kio-watatanabe Date: Tue, 27 Dec 2022 16:37:45 +0900 Subject: [PATCH 02/17] Fix CobolFile.java --- .../libcobj/file/CobolFile.java | 58 ++++++++++--------- 1 file changed, 31 insertions(+), 27 deletions(-) diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java index e4a4053b..236a7ac1 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java @@ -165,7 +165,7 @@ public class CobolFile { protected static String file_open_name; protected static byte[] file_open_buff = new byte[1024]; - protected static final String[] prefix = { "DD_", "dd_", "" }; + protected static final String[] prefix = {"DD_", "dd_", ""}; protected static final int NUM_PREFIX = prefix.length; protected static int eop_status = 0; @@ -174,16 +174,16 @@ public class CobolFile { private static List file_cache = new ArrayList(); protected static int[] status_exception = { - 0, - CobolExceptionId.COB_EC_I_O_AT_END, - CobolExceptionId.COB_EC_I_O_INVALID_KEY, - CobolExceptionId.COB_EC_I_O_PERMANENT_ERROR, - CobolExceptionId.COB_EC_I_O_LOGIC_ERROR, - CobolExceptionId.COB_EC_I_O_RECORD_OPERATION, - CobolExceptionId.COB_EC_I_O_FILE_SHARING, - CobolExceptionId.COB_EC_I_O, - CobolExceptionId.COB_EC_I_O, - CobolExceptionId.COB_EC_I_O_IMP + 0, + CobolExceptionId.COB_EC_I_O_AT_END, + CobolExceptionId.COB_EC_I_O_INVALID_KEY, + CobolExceptionId.COB_EC_I_O_PERMANENT_ERROR, + CobolExceptionId.COB_EC_I_O_LOGIC_ERROR, + CobolExceptionId.COB_EC_I_O_RECORD_OPERATION, + CobolExceptionId.COB_EC_I_O_FILE_SHARING, + CobolExceptionId.COB_EC_I_O, + CobolExceptionId.COB_EC_I_O, + CobolExceptionId.COB_EC_I_O_IMP }; protected String select_name; public byte[] file_status; @@ -229,8 +229,7 @@ public void setLinorkeyptr(Linage ptr) { this.linorkeyptr = ptr; } - public CobolFile() { - } + public CobolFile() {} public CobolFile( String select_name, @@ -287,8 +286,7 @@ public CobolFile( } /** - * libcob/fileio.cのsave_statusの実装 - * RETURN_STATUSマクロは実装できないため,本メソッドの呼び出し後の次の文はreturn;を書くこと. + * libcob/fileio.cのsave_statusの実装 RETURN_STATUSマクロは実装できないため,本メソッドの呼び出し後の次の文はreturn;を書くこと. * * @param status * @param fnstatus @@ -773,19 +771,25 @@ public int open_(String filename, int mode, int sharing) throws IOException { fp = FileChannel.open(Paths.get(filename), StandardOpenOption.READ); break; case COB_OPEN_OUTPUT: - fp = FileChannel.open( - Paths.get(filename), - StandardOpenOption.WRITE, - StandardOpenOption.CREATE, - StandardOpenOption.TRUNCATE_EXISTING); + fp = + FileChannel.open( + Paths.get(filename), + StandardOpenOption.WRITE, + StandardOpenOption.CREATE, + StandardOpenOption.TRUNCATE_EXISTING); break; case COB_OPEN_I_O: - fp = FileChannel.open( - Paths.get(filename), StandardOpenOption.READ, StandardOpenOption.WRITE, StandardOpenOption.CREATE); + fp = + FileChannel.open( + Paths.get(filename), + StandardOpenOption.READ, + StandardOpenOption.WRITE, + StandardOpenOption.CREATE); break; case COB_OPEN_EXTEND: - fp = FileChannel.open( - Paths.get(filename), StandardOpenOption.APPEND, StandardOpenOption.CREATE); + fp = + FileChannel.open( + Paths.get(filename), StandardOpenOption.APPEND, StandardOpenOption.CREATE); break; } } catch (IOException e) { @@ -1089,7 +1093,8 @@ public void write(AbstractCobolField rec, int opt, AbstractCobolField fnstatus) } String openMode = String.format("%02d", (int) this.last_open_mode); - if (invokeFun(COB_IO_WRITE, this, null, rec.getDataStorage(), fnstatus, openMode, null, null) != 0) { + if (invokeFun(COB_IO_WRITE, this, null, rec.getDataStorage(), fnstatus, openMode, null, null) + != 0) { return; } @@ -1263,8 +1268,7 @@ public void unlock(AbstractCobolField fnstatus) { public void unlock_() { if (this.open_mode != COB_OPEN_CLOSED && this.open_mode != COB_OPEN_LOCKED) { this.file.flush(); - if ((this.lock_mode & COB_LOCK_EXCLUSIVE) == 0) { - } + if ((this.lock_mode & COB_LOCK_EXCLUSIVE) == 0) {} } } From e17adb98688ff1c2e330dd1dd5cf399e859461e5 Mon Sep 17 00:00:00 2001 From: kio-watatanabe Date: Thu, 5 Jan 2023 14:23:13 +0900 Subject: [PATCH 03/17] Fix file-control.at --- tests/jp-compat.src/file-control.at | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/tests/jp-compat.src/file-control.at b/tests/jp-compat.src/file-control.at index b8d0b174..75b5ff02 100644 --- a/tests/jp-compat.src/file-control.at +++ b/tests/jp-compat.src/file-control.at @@ -24,7 +24,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([export OC_IO_CREATES=yes && ${COBCRUN} prog], [0], [00 +AT_CHECK([export OC_IO_CREATES=yes && ${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -55,7 +55,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([export OC_IO_CREATES=yes && ${COBCRUN} prog], [0], [00 +AT_CHECK([export OC_IO_CREATES=yes && ${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -88,7 +88,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([export OC_IO_CREATES=yes && ${COBCRUN} prog], [0], [00 +AT_CHECK([export OC_IO_CREATES=yes && ${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -121,7 +121,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([export OC_IO_CREATES=yes && ${COBCRUN} prog], [0], [00 +AT_CHECK([export OC_IO_CREATES=yes && ${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -152,7 +152,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([export OC_EXTEND_CREATES=yes && ${COBCRUN} prog], [0], [00 +AT_CHECK([export OC_EXTEND_CREATES=yes && ${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -183,7 +183,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([export OC_EXTEND_CREATES=yes && ${COBCRUN} prog], [0], [00 +AT_CHECK([export OC_EXTEND_CREATES=yes && ${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -216,7 +216,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([export OC_EXTEND_CREATES=yes && ${COBCRUN} prog], [0], [00 +AT_CHECK([export OC_EXTEND_CREATES=yes && ${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -249,7 +249,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([export OC_EXTEND_CREATES=yes && ${COBCRUN} prog], [0], [00 +AT_CHECK([export OC_EXTEND_CREATES=yes && ${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -281,7 +281,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([${COBCRUN} prog], [0], [00 +AT_CHECK([${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -313,7 +313,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([${COBCRUN} prog], [0], [00 +AT_CHECK([${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -347,7 +347,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([${COBCRUN} prog], [0], [00 +AT_CHECK([${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -383,7 +383,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([${COBCRUN} prog], [0], [00 +AT_CHECK([${RUN_MODULE} prog], [0], [00 ]) AT_CLEANUP @@ -419,7 +419,7 @@ AT_DATA([prog.cob], [ ]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([${COBCRUN} prog], [0], [91 +AT_CHECK([${RUN_MODULE} prog], [0], [91 ]) AT_CLEANUP @@ -449,7 +449,7 @@ AT_DATA([prog.cob], [ AT_CHECK([echo 000011112222 >TEST-FILE]) AT_CHECK([${COMPILE_MODULE} -o prog prog.cob]) -AT_CHECK([COB_IO_ASSUME_REWRITE=Y ${COBCRUN} prog]) +AT_CHECK([COB_IO_ASSUME_REWRITE=Y ${RUN_MODULE} prog]) AT_CHECK([test `cat TEST-FILE` = '0000AAAA2222']) AT_CLEANUP From 1a660e3e4c72af665e8c76f6abe240493c942e9b Mon Sep 17 00:00:00 2001 From: kio-watatanabe Date: Wed, 11 Jan 2023 09:25:13 +0900 Subject: [PATCH 04/17] Fix CobolFile.java --- .../opensourcecobol/libcobj/file/CobolFile.java | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java index 236a7ac1..b96c4ab1 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java @@ -688,8 +688,8 @@ public void open(int mode, int sharing, AbstractCobolField fnstatus) { was_not_exist = true; if (mode != COB_OPEN_OUTPUT && !this.flag_optional - && (mode != COB_OPEN_I_O || System.getenv(COB_IO_CREATES).equals("yes")) - && (mode != COB_OPEN_EXTEND || System.getenv(COB_EXTEND_CREATES).equals("yes"))) { + && (mode != COB_OPEN_I_O || !System.getenv(COB_IO_CREATES).equals("yes")) + && (mode != COB_OPEN_EXTEND || !System.getenv(COB_EXTEND_CREATES).equals("yes"))) { saveStatus(COB_STATUS_35_NOT_EXISTS, fnstatus); return; } @@ -707,6 +707,13 @@ public void open(int mode, int sharing, AbstractCobolField fnstatus) { cacheFile(this); try { + + if (this.organization == COB_ORG_INDEXED) { + int status = this.open_(file_open_name, mode, sharing); + saveStatus(status, fnstatus); + return; + } + switch (this.open_(file_open_name, mode, sharing)) { case 0: this.open_mode = (char) mode; From b878a5f334ef2ee4fbea72f15cd8802a9cf6bbc9 Mon Sep 17 00:00:00 2001 From: kio-watatanabe Date: Wed, 11 Jan 2023 10:38:56 +0900 Subject: [PATCH 05/17] Fix CobolFile.java --- .../libcobj/file/CobolFile.java | 68 ++++++++----------- 1 file changed, 30 insertions(+), 38 deletions(-) diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java index b96c4ab1..a6d6bc19 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java @@ -165,7 +165,7 @@ public class CobolFile { protected static String file_open_name; protected static byte[] file_open_buff = new byte[1024]; - protected static final String[] prefix = {"DD_", "dd_", ""}; + protected static final String[] prefix = { "DD_", "dd_", "" }; protected static final int NUM_PREFIX = prefix.length; protected static int eop_status = 0; @@ -174,16 +174,16 @@ public class CobolFile { private static List file_cache = new ArrayList(); protected static int[] status_exception = { - 0, - CobolExceptionId.COB_EC_I_O_AT_END, - CobolExceptionId.COB_EC_I_O_INVALID_KEY, - CobolExceptionId.COB_EC_I_O_PERMANENT_ERROR, - CobolExceptionId.COB_EC_I_O_LOGIC_ERROR, - CobolExceptionId.COB_EC_I_O_RECORD_OPERATION, - CobolExceptionId.COB_EC_I_O_FILE_SHARING, - CobolExceptionId.COB_EC_I_O, - CobolExceptionId.COB_EC_I_O, - CobolExceptionId.COB_EC_I_O_IMP + 0, + CobolExceptionId.COB_EC_I_O_AT_END, + CobolExceptionId.COB_EC_I_O_INVALID_KEY, + CobolExceptionId.COB_EC_I_O_PERMANENT_ERROR, + CobolExceptionId.COB_EC_I_O_LOGIC_ERROR, + CobolExceptionId.COB_EC_I_O_RECORD_OPERATION, + CobolExceptionId.COB_EC_I_O_FILE_SHARING, + CobolExceptionId.COB_EC_I_O, + CobolExceptionId.COB_EC_I_O, + CobolExceptionId.COB_EC_I_O_IMP }; protected String select_name; public byte[] file_status; @@ -229,7 +229,8 @@ public void setLinorkeyptr(Linage ptr) { this.linorkeyptr = ptr; } - public CobolFile() {} + public CobolFile() { + } public CobolFile( String select_name, @@ -286,7 +287,8 @@ public CobolFile( } /** - * libcob/fileio.cのsave_statusの実装 RETURN_STATUSマクロは実装できないため,本メソッドの呼び出し後の次の文はreturn;を書くこと. + * libcob/fileio.cのsave_statusの実装 + * RETURN_STATUSマクロは実装できないため,本メソッドの呼び出し後の次の文はreturn;を書くこと. * * @param status * @param fnstatus @@ -707,13 +709,6 @@ public void open(int mode, int sharing, AbstractCobolField fnstatus) { cacheFile(this); try { - - if (this.organization == COB_ORG_INDEXED) { - int status = this.open_(file_open_name, mode, sharing); - saveStatus(status, fnstatus); - return; - } - switch (this.open_(file_open_name, mode, sharing)) { case 0: this.open_mode = (char) mode; @@ -778,25 +773,22 @@ public int open_(String filename, int mode, int sharing) throws IOException { fp = FileChannel.open(Paths.get(filename), StandardOpenOption.READ); break; case COB_OPEN_OUTPUT: - fp = - FileChannel.open( - Paths.get(filename), - StandardOpenOption.WRITE, - StandardOpenOption.CREATE, - StandardOpenOption.TRUNCATE_EXISTING); + fp = FileChannel.open( + Paths.get(filename), + StandardOpenOption.WRITE, + StandardOpenOption.CREATE, + StandardOpenOption.TRUNCATE_EXISTING); break; case COB_OPEN_I_O: - fp = - FileChannel.open( - Paths.get(filename), - StandardOpenOption.READ, - StandardOpenOption.WRITE, - StandardOpenOption.CREATE); + fp = FileChannel.open( + Paths.get(filename), + StandardOpenOption.READ, + StandardOpenOption.WRITE, + StandardOpenOption.CREATE); break; case COB_OPEN_EXTEND: - fp = - FileChannel.open( - Paths.get(filename), StandardOpenOption.APPEND, StandardOpenOption.CREATE); + fp = FileChannel.open( + Paths.get(filename), StandardOpenOption.APPEND, StandardOpenOption.CREATE); break; } } catch (IOException e) { @@ -1100,8 +1092,7 @@ public void write(AbstractCobolField rec, int opt, AbstractCobolField fnstatus) } String openMode = String.format("%02d", (int) this.last_open_mode); - if (invokeFun(COB_IO_WRITE, this, null, rec.getDataStorage(), fnstatus, openMode, null, null) - != 0) { + if (invokeFun(COB_IO_WRITE, this, null, rec.getDataStorage(), fnstatus, openMode, null, null) != 0) { return; } @@ -1275,7 +1266,8 @@ public void unlock(AbstractCobolField fnstatus) { public void unlock_() { if (this.open_mode != COB_OPEN_CLOSED && this.open_mode != COB_OPEN_LOCKED) { this.file.flush(); - if ((this.lock_mode & COB_LOCK_EXCLUSIVE) == 0) {} + if ((this.lock_mode & COB_LOCK_EXCLUSIVE) == 0) { + } } } From 8f509cd9e928fd0d5104e4489bf114162ef48c67 Mon Sep 17 00:00:00 2001 From: kio-watatanabe Date: Wed, 11 Jan 2023 10:40:33 +0900 Subject: [PATCH 06/17] Fix CobolFile.java --- .../libcobj/file/CobolFile.java | 61 ++++++++++--------- 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java index a6d6bc19..b78ef712 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java @@ -165,7 +165,7 @@ public class CobolFile { protected static String file_open_name; protected static byte[] file_open_buff = new byte[1024]; - protected static final String[] prefix = { "DD_", "dd_", "" }; + protected static final String[] prefix = {"DD_", "dd_", ""}; protected static final int NUM_PREFIX = prefix.length; protected static int eop_status = 0; @@ -174,16 +174,16 @@ public class CobolFile { private static List file_cache = new ArrayList(); protected static int[] status_exception = { - 0, - CobolExceptionId.COB_EC_I_O_AT_END, - CobolExceptionId.COB_EC_I_O_INVALID_KEY, - CobolExceptionId.COB_EC_I_O_PERMANENT_ERROR, - CobolExceptionId.COB_EC_I_O_LOGIC_ERROR, - CobolExceptionId.COB_EC_I_O_RECORD_OPERATION, - CobolExceptionId.COB_EC_I_O_FILE_SHARING, - CobolExceptionId.COB_EC_I_O, - CobolExceptionId.COB_EC_I_O, - CobolExceptionId.COB_EC_I_O_IMP + 0, + CobolExceptionId.COB_EC_I_O_AT_END, + CobolExceptionId.COB_EC_I_O_INVALID_KEY, + CobolExceptionId.COB_EC_I_O_PERMANENT_ERROR, + CobolExceptionId.COB_EC_I_O_LOGIC_ERROR, + CobolExceptionId.COB_EC_I_O_RECORD_OPERATION, + CobolExceptionId.COB_EC_I_O_FILE_SHARING, + CobolExceptionId.COB_EC_I_O, + CobolExceptionId.COB_EC_I_O, + CobolExceptionId.COB_EC_I_O_IMP }; protected String select_name; public byte[] file_status; @@ -229,8 +229,7 @@ public void setLinorkeyptr(Linage ptr) { this.linorkeyptr = ptr; } - public CobolFile() { - } + public CobolFile() {} public CobolFile( String select_name, @@ -287,8 +286,7 @@ public CobolFile( } /** - * libcob/fileio.cのsave_statusの実装 - * RETURN_STATUSマクロは実装できないため,本メソッドの呼び出し後の次の文はreturn;を書くこと. + * libcob/fileio.cのsave_statusの実装 RETURN_STATUSマクロは実装できないため,本メソッドの呼び出し後の次の文はreturn;を書くこと. * * @param status * @param fnstatus @@ -773,22 +771,25 @@ public int open_(String filename, int mode, int sharing) throws IOException { fp = FileChannel.open(Paths.get(filename), StandardOpenOption.READ); break; case COB_OPEN_OUTPUT: - fp = FileChannel.open( - Paths.get(filename), - StandardOpenOption.WRITE, - StandardOpenOption.CREATE, - StandardOpenOption.TRUNCATE_EXISTING); + fp = + FileChannel.open( + Paths.get(filename), + StandardOpenOption.WRITE, + StandardOpenOption.CREATE, + StandardOpenOption.TRUNCATE_EXISTING); break; case COB_OPEN_I_O: - fp = FileChannel.open( - Paths.get(filename), - StandardOpenOption.READ, - StandardOpenOption.WRITE, - StandardOpenOption.CREATE); + fp = + FileChannel.open( + Paths.get(filename), + StandardOpenOption.READ, + StandardOpenOption.WRITE, + StandardOpenOption.CREATE); break; case COB_OPEN_EXTEND: - fp = FileChannel.open( - Paths.get(filename), StandardOpenOption.APPEND, StandardOpenOption.CREATE); + fp = + FileChannel.open( + Paths.get(filename), StandardOpenOption.APPEND, StandardOpenOption.CREATE); break; } } catch (IOException e) { @@ -1092,7 +1093,8 @@ public void write(AbstractCobolField rec, int opt, AbstractCobolField fnstatus) } String openMode = String.format("%02d", (int) this.last_open_mode); - if (invokeFun(COB_IO_WRITE, this, null, rec.getDataStorage(), fnstatus, openMode, null, null) != 0) { + if (invokeFun(COB_IO_WRITE, this, null, rec.getDataStorage(), fnstatus, openMode, null, null) + != 0) { return; } @@ -1266,8 +1268,7 @@ public void unlock(AbstractCobolField fnstatus) { public void unlock_() { if (this.open_mode != COB_OPEN_CLOSED && this.open_mode != COB_OPEN_LOCKED) { this.file.flush(); - if ((this.lock_mode & COB_LOCK_EXCLUSIVE) == 0) { - } + if ((this.lock_mode & COB_LOCK_EXCLUSIVE) == 0) {} } } From 9e29098be89f4c8f39920b085ffd50aacd4a6c99 Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Fri, 13 Jan 2023 10:58:19 +0900 Subject: [PATCH 07/17] Improve tests and CI (#66) --- .github/workflows/cicd.yml | 110 +- tests/atlocal.in | 1 + tests/cobol85/EXEC85.conf.in | 0 tests/cobol85/IC.txt | 35 - tests/cobol85/IC/IC101A.CBL | 382 +++ tests/cobol85/IC/IC103A.CBL | 497 +++ tests/cobol85/IC/IC106A.CBL | 530 +++ tests/cobol85/IC/IC108A.CBL | 444 +++ tests/cobol85/IC/IC112A.CBL | 555 ++++ tests/cobol85/IC/IC114A.CBL | 471 +++ tests/cobol85/IC/IC116M.CBL | 343 ++ tests/cobol85/IC/IC201A.CBL | 619 ++++ tests/cobol85/IC/IC203A.CBL | 683 ++++ tests/cobol85/IC/IC207A.CBL | 479 +++ tests/cobol85/IC/IC209A.CBL | 352 ++ tests/cobol85/IC/IC213A.CBL | 341 ++ tests/cobol85/IC/IC216A.CBL | 333 ++ tests/cobol85/IC/IC222A.CBL | 1162 +++++++ tests/cobol85/IC/IC223A.CBL | 771 +++++ tests/cobol85/IC/IC224A.CBL | 703 ++++ tests/cobol85/IC/IC225A.CBL | 1054 ++++++ tests/cobol85/IC/IC226A.CBL | 506 +++ tests/cobol85/IC/IC227A.CBL | 1200 +++++++ tests/cobol85/IC/IC228A.CBL | 445 +++ tests/cobol85/IC/IC233A.CBL | 513 +++ tests/cobol85/IC/IC234A.CBL | 737 +++++ tests/cobol85/IC/IC235A.CBL | 668 ++++ tests/cobol85/IC/IC237A.CBL | 433 +++ tests/cobol85/IC/IC401M.CBL | 74 + tests/cobol85/IC/lib/IC102A.CBL | 48 + tests/cobol85/IC/lib/IC104A.CBL | 71 + tests/cobol85/IC/lib/IC105A.CBL | 64 + tests/cobol85/IC/lib/IC107A.CBL | 109 + tests/cobol85/IC/lib/IC109A.CBL | 65 + tests/cobol85/IC/lib/IC110A.CBL | 69 + tests/cobol85/IC/lib/IC111A.CBL | 56 + tests/cobol85/IC/lib/IC113A.CBL | 78 + tests/cobol85/IC/lib/IC115A.CBL | 213 ++ tests/cobol85/IC/lib/IC117M.CBL | 71 + tests/cobol85/IC/lib/IC118M.CBL | 55 + tests/cobol85/IC/lib/IC202A.CBL | 58 + tests/cobol85/IC/lib/IC204A.CBL | 73 + tests/cobol85/IC/lib/IC205A.CBL | 70 + tests/cobol85/IC/lib/IC206A.CBL | 56 + tests/cobol85/IC/lib/IC208A.CBL | 103 + tests/cobol85/IC/lib/IC210A.CBL | 50 + tests/cobol85/IC/lib/IC211A.CBL | 40 + tests/cobol85/IC/lib/IC212A.CBL | 40 + tests/cobol85/IC/lib/IC214A.CBL | 36 + tests/cobol85/IC/lib/IC215A.CBL | 40 + tests/cobol85/IC/lib/IC217A.CBL | 48 + tests/cobol85/IF.txt | 55 - tests/cobol85/IF/IF101A.CBL | 906 +++++ tests/cobol85/IF/IF102A.CBL | 617 ++++ tests/cobol85/IF/IF103A.CBL | 840 +++++ tests/cobol85/IF/IF104A.CBL | 927 ++++++ tests/cobol85/IF/IF105A.CBL | 487 +++ tests/cobol85/IF/IF106A.CBL | 1005 ++++++ tests/cobol85/IF/IF107A.CBL | 379 +++ tests/cobol85/IF/IF108A.CBL | 489 +++ tests/cobol85/IF/IF109A.CBL | 451 +++ tests/cobol85/IF/IF110A.CBL | 500 +++ tests/cobol85/IF/IF111A.CBL | 731 ++++ tests/cobol85/IF/IF112A.CBL | 452 +++ tests/cobol85/IF/IF113A.CBL | 451 +++ tests/cobol85/IF/IF114A.CBL | 732 ++++ tests/cobol85/IF/IF115A.CBL | 450 +++ tests/cobol85/IF/IF116A.CBL | 889 +++++ tests/cobol85/IF/IF117A.CBL | 1037 ++++++ tests/cobol85/IF/IF118A.CBL | 544 +++ tests/cobol85/IF/IF119A.CBL | 797 +++++ tests/cobol85/IF/IF120A.CBL | 684 ++++ tests/cobol85/IF/IF121A.CBL | 680 ++++ tests/cobol85/IF/IF122A.CBL | 680 ++++ tests/cobol85/IF/IF123A.CBL | 797 +++++ tests/cobol85/IF/IF124A.CBL | 761 +++++ tests/cobol85/IF/IF125A.CBL | 686 ++++ tests/cobol85/IF/IF126A.CBL | 886 +++++ tests/cobol85/IF/IF127A.CBL | 505 +++ tests/cobol85/IF/IF128A.CBL | 647 ++++ tests/cobol85/IF/IF129A.CBL | 632 ++++ tests/cobol85/IF/IF130A.CBL | 818 +++++ tests/cobol85/IF/IF131A.CBL | 512 +++ tests/cobol85/IF/IF132A.CBL | 633 ++++ tests/cobol85/IF/IF133A.CBL | 678 ++++ tests/cobol85/IF/IF134A.CBL | 546 +++ tests/cobol85/IF/IF135A.CBL | 1036 ++++++ tests/cobol85/IF/IF136A.CBL | 904 +++++ tests/cobol85/IF/IF137A.CBL | 725 ++++ tests/cobol85/IF/IF138A.CBL | 659 ++++ tests/cobol85/IF/IF139A.CBL | 992 ++++++ tests/cobol85/IF/IF140A.CBL | 543 +++ tests/cobol85/IF/IF141A.CBL | 692 ++++ tests/cobol85/IF/IF142A.CBL | 367 +++ tests/cobol85/IF/IF401M.CBL | 104 + tests/cobol85/IF/IF402M.CBL | 124 + tests/cobol85/IF/IF403M.CBL | 97 + tests/cobol85/IX.txt | 52 - tests/cobol85/IX/IX101A.CBL | 507 +++ tests/cobol85/IX/IX102A.SUB | 701 ++++ tests/cobol85/IX/IX103A.SUB | 757 +++++ tests/cobol85/IX/IX104A.CBL | 729 ++++ tests/cobol85/IX/IX105A.CBL | 875 +++++ tests/cobol85/IX/IX106A.CBL | 1233 +++++++ tests/cobol85/IX/IX107A.CBL | 982 ++++++ tests/cobol85/IX/IX108A.CBL | 1458 ++++++++ tests/cobol85/IX/IX109A.CBL | 1071 ++++++ tests/cobol85/IX/IX110A.SUB | 620 ++++ tests/cobol85/IX/IX111A.SUB | 444 +++ tests/cobol85/IX/IX112A.CBL | 876 +++++ tests/cobol85/IX/IX113A.CBL | 769 +++++ tests/cobol85/IX/IX114A.SUB | 720 ++++ tests/cobol85/IX/IX115A.SUB | 721 ++++ tests/cobol85/IX/IX116A.SUB | 721 ++++ tests/cobol85/IX/IX117A.SUB | 720 ++++ tests/cobol85/IX/IX118A.SUB | 722 ++++ tests/cobol85/IX/IX119A.SUB | 731 ++++ tests/cobol85/IX/IX120A.SUB | 705 ++++ tests/cobol85/IX/IX121A.CBL | 762 +++++ tests/cobol85/IX/IX201A.CBL | 506 +++ tests/cobol85/IX/IX202A.SUB | 664 ++++ tests/cobol85/IX/IX203A.SUB | 735 +++++ tests/cobol85/IX/IX204A.CBL | 739 +++++ tests/cobol85/IX/IX205A.CBL | 973 ++++++ tests/cobol85/IX/IX206A.CBL | 892 +++++ tests/cobol85/IX/IX207A.CBL | 1081 ++++++ tests/cobol85/IX/IX208A.CBL | 1525 +++++++++ tests/cobol85/IX/IX209A.CBL | 2859 ++++++++++++++++ tests/cobol85/IX/IX210A.CBL | 2333 +++++++++++++ tests/cobol85/IX/IX211A.CBL | 1125 +++++++ tests/cobol85/IX/IX212A.CBL | 1053 ++++++ tests/cobol85/IX/IX213A.CBL | 1019 ++++++ tests/cobol85/IX/IX214A.CBL | 2358 +++++++++++++ tests/cobol85/IX/IX215A.CBL | 2805 ++++++++++++++++ tests/cobol85/IX/IX216A.CBL | 792 +++++ tests/cobol85/IX/IX217A.CBL | 687 ++++ tests/cobol85/IX/IX218A.CBL | 613 ++++ tests/cobol85/IX/IX301M.CBL | 70 + tests/cobol85/IX/IX302M.CBL | 71 + tests/cobol85/IX/IX401M.CBL | 84 + tests/cobol85/Makefile.am | 33 +- tests/cobol85/Makefile.in | 34 +- tests/cobol85/NC.txt | 105 - tests/cobol85/NC/NC101A.CBL | 1867 +++++++++++ tests/cobol85/NC/NC101A.log | 146 + tests/cobol85/NC/NC102A.CBL | 1503 +++++++++ tests/cobol85/NC/NC103A.CBL | 2139 ++++++++++++ tests/cobol85/NC/NC104A.CBL | 2851 ++++++++++++++++ tests/cobol85/NC/NC105A.CBL | 3117 ++++++++++++++++++ tests/cobol85/NC/NC106A.CBL | 2533 ++++++++++++++ tests/cobol85/NC/NC107A.CBL | 2033 ++++++++++++ tests/cobol85/NC/NC108M.CBL | 777 +++++ tests/cobol85/NC/NC109M.CBL | 964 ++++++ tests/cobol85/NC/NC109M.DAT | 11 + tests/cobol85/NC/NC110M.CBL | 89 + tests/cobol85/NC/NC111A.CBL | 478 +++ tests/cobol85/NC/NC112A.CBL | 1027 ++++++ tests/cobol85/NC/NC113M.CBL | 262 ++ tests/cobol85/NC/NC114M.CBL | 500 +++ tests/cobol85/NC/NC115A.CBL | 1104 +++++++ tests/cobol85/NC/NC116A.CBL | 1493 +++++++++ tests/cobol85/NC/NC117A.CBL | 1208 +++++++ tests/cobol85/NC/NC118A.CBL | 1037 ++++++ tests/cobol85/NC/NC119A.CBL | 1176 +++++++ tests/cobol85/NC/NC120A.CBL | 1147 +++++++ tests/cobol85/NC/NC121M.CBL | 1288 ++++++++ tests/cobol85/NC/NC122A.CBL | 1038 ++++++ tests/cobol85/NC/NC123A.CBL | 1129 +++++++ tests/cobol85/NC/NC124A.CBL | 2354 +++++++++++++ tests/cobol85/NC/NC125A.CBL | 750 +++++ tests/cobol85/NC/NC126A.CBL | 2636 +++++++++++++++ tests/cobol85/NC/NC127A.CBL | 349 ++ tests/cobol85/NC/NC131A.CBL | 468 +++ tests/cobol85/NC/NC132A.CBL | 794 +++++ tests/cobol85/NC/NC133A.CBL | 713 ++++ tests/cobol85/NC/NC134A.CBL | 713 ++++ tests/cobol85/NC/NC135A.CBL | 521 +++ tests/cobol85/NC/NC136A.CBL | 489 +++ tests/cobol85/NC/NC137A.CBL | 503 +++ tests/cobol85/NC/NC138A.CBL | 654 ++++ tests/cobol85/NC/NC139A.CBL | 617 ++++ tests/cobol85/NC/NC140A.CBL | 749 +++++ tests/cobol85/NC/NC141A.CBL | 507 +++ tests/cobol85/NC/NC170A.CBL | 2015 +++++++++++ tests/cobol85/NC/NC171A.CBL | 2268 +++++++++++++ tests/cobol85/NC/NC172A.CBL | 2215 +++++++++++++ tests/cobol85/NC/NC173A.CBL | 2218 +++++++++++++ tests/cobol85/NC/NC174A.CBL | 1935 +++++++++++ tests/cobol85/NC/NC175A.CBL | 2079 ++++++++++++ tests/cobol85/NC/NC176A.CBL | 2417 ++++++++++++++ tests/cobol85/NC/NC177A.CBL | 2137 ++++++++++++ tests/cobol85/NC/NC201A.CBL | 2120 ++++++++++++ tests/cobol85/NC/NC202A.CBL | 2219 +++++++++++++ tests/cobol85/NC/NC203A.CBL | 1693 ++++++++++ tests/cobol85/NC/NC204M.CBL | 1207 +++++++ tests/cobol85/NC/NC204M.DAT | 15 + tests/cobol85/NC/NC205A.CBL | 804 +++++ tests/cobol85/NC/NC206A.CBL | 1695 ++++++++++ tests/cobol85/NC/NC207A.CBL | 2723 +++++++++++++++ tests/cobol85/NC/NC208A.CBL | 1130 +++++++ tests/cobol85/NC/NC209A.CBL | 966 ++++++ tests/cobol85/NC/NC210A.CBL | 737 +++++ tests/cobol85/NC/NC211A.CBL | 1896 +++++++++++ tests/cobol85/NC/NC214M.CBL | 409 +++ tests/cobol85/NC/NC215A.CBL | 483 +++ tests/cobol85/NC/NC216A.CBL | 2227 +++++++++++++ tests/cobol85/NC/NC217A.CBL | 2187 ++++++++++++ tests/cobol85/NC/NC218A.CBL | 3077 +++++++++++++++++ tests/cobol85/NC/NC219A.CBL | 591 ++++ tests/cobol85/NC/NC220M.CBL | 1037 ++++++ tests/cobol85/NC/NC221A.CBL | 961 ++++++ tests/cobol85/NC/NC222A.CBL | 552 ++++ tests/cobol85/NC/NC223A.CBL | 2290 +++++++++++++ tests/cobol85/NC/NC224A.CBL | 647 ++++ tests/cobol85/NC/NC225A.CBL | 1924 +++++++++++ tests/cobol85/NC/NC231A.CBL | 1110 +++++++ tests/cobol85/NC/NC232A.CBL | 923 ++++++ tests/cobol85/NC/NC233A.CBL | 881 +++++ tests/cobol85/NC/NC234A.CBL | 922 ++++++ tests/cobol85/NC/NC235A.CBL | 626 ++++ tests/cobol85/NC/NC236A.CBL | 584 ++++ tests/cobol85/NC/NC237A.CBL | 661 ++++ tests/cobol85/NC/NC238A.CBL | 658 ++++ tests/cobol85/NC/NC239A.CBL | 528 +++ tests/cobol85/NC/NC240A.CBL | 693 ++++ tests/cobol85/NC/NC241A.CBL | 671 ++++ tests/cobol85/NC/NC242A.CBL | 575 ++++ tests/cobol85/NC/NC243A.CBL | 702 ++++ tests/cobol85/NC/NC244A.CBL | 511 +++ tests/cobol85/NC/NC245A.CBL | 537 +++ tests/cobol85/NC/NC246A.CBL | 1320 ++++++++ tests/cobol85/NC/NC247A.CBL | 864 +++++ tests/cobol85/NC/NC248A.CBL | 621 ++++ tests/cobol85/NC/NC250A.CBL | 1971 +++++++++++ tests/cobol85/NC/NC251A.CBL | 1417 ++++++++ tests/cobol85/NC/NC252A.CBL | 1710 ++++++++++ tests/cobol85/NC/NC253A.CBL | 1978 +++++++++++ tests/cobol85/NC/NC254A.CBL | 671 ++++ tests/cobol85/NC/NC302M.CBL | 51 + tests/cobol85/NC/NC303M.CBL | 32 + tests/cobol85/NC/NC401M.CBL | 332 ++ tests/cobol85/NC/report.txt | 105 + tests/cobol85/NC/tmp.cbl | 671 ++++ tests/cobol85/OB.txt | 17 - tests/cobol85/OB/OBIC1A.CBL | 80 + tests/cobol85/OB/OBNC1M.CBL | 782 +++++ tests/cobol85/OB/OBNC2M.CBL | 929 ++++++ tests/cobol85/OB/OBSQ1A.CBL | 629 ++++ tests/cobol85/OB/OBSQ3A.CBL | 647 ++++ tests/cobol85/OB/OBSQ4A.SUB | 574 ++++ tests/cobol85/OB/OBSQ5A.SUB | 626 ++++ tests/cobol85/OB/lib/OBIC2A.CBL | 310 ++ tests/cobol85/OB/lib/OBIC3A.CBL | 336 ++ tests/cobol85/README | 0 tests/cobol85/RL.txt | 45 - tests/cobol85/RL/RL101A.CBL | 457 +++ tests/cobol85/RL/RL102A.SUB | 617 ++++ tests/cobol85/RL/RL103A.SUB | 616 ++++ tests/cobol85/RL/RL104A.CBL | 639 ++++ tests/cobol85/RL/RL105A.CBL | 633 ++++ tests/cobol85/RL/RL106A.CBL | 814 +++++ tests/cobol85/RL/RL107A.CBL | 791 +++++ tests/cobol85/RL/RL108A.CBL | 462 +++ tests/cobol85/RL/RL109A.SUB | 645 ++++ tests/cobol85/RL/RL110A.SUB | 622 ++++ tests/cobol85/RL/RL111A.CBL | 1094 ++++++ tests/cobol85/RL/RL112A.CBL | 642 ++++ tests/cobol85/RL/RL113A.CBL | 812 +++++ tests/cobol85/RL/RL114A.CBL | 824 +++++ tests/cobol85/RL/RL115A.CBL | 719 ++++ tests/cobol85/RL/RL116A.CBL | 614 ++++ tests/cobol85/RL/RL117A.CBL | 604 ++++ tests/cobol85/RL/RL118A.CBL | 554 ++++ tests/cobol85/RL/RL119A.CBL | 545 +++ tests/cobol85/RL/RL201A.CBL | 444 +++ tests/cobol85/RL/RL202A.SUB | 617 ++++ tests/cobol85/RL/RL203A.SUB | 614 ++++ tests/cobol85/RL/RL204A.CBL | 644 ++++ tests/cobol85/RL/RL205A.CBL | 2410 ++++++++++++++ tests/cobol85/RL/RL206A.CBL | 563 ++++ tests/cobol85/RL/RL207A.SUB | 1064 ++++++ tests/cobol85/RL/RL208A.SUB | 615 ++++ tests/cobol85/RL/RL209A.CBL | 460 +++ tests/cobol85/RL/RL210A.CBL | 487 +++ tests/cobol85/RL/RL211A.CBL | 553 ++++ tests/cobol85/RL/RL212A.CBL | 444 +++ tests/cobol85/RL/RL213A.SUB | 475 +++ tests/cobol85/RL/RL301M.CBL | 67 + tests/cobol85/RL/RL302M.CBL | 70 + tests/cobol85/RL/RL401M.CBL | 78 + tests/cobol85/SG.txt | 23 - tests/cobol85/SG/SG101A.CBL | 2849 ++++++++++++++++ tests/cobol85/SG/SG102A.CBL | 610 ++++ tests/cobol85/SG/SG103A.CBL | 485 +++ tests/cobol85/SG/SG104A.CBL | 592 ++++ tests/cobol85/SG/SG105A.CBL | 592 ++++ tests/cobol85/SG/SG106A.CBL | 592 ++++ tests/cobol85/SG/SG201A.CBL | 1950 +++++++++++ tests/cobol85/SG/SG202A.CBL | 432 +++ tests/cobol85/SG/SG203A.CBL | 794 +++++ tests/cobol85/SG/SG204A.CBL | 880 +++++ tests/cobol85/SG/SG302M.CBL | 21 + tests/cobol85/SG/SG303M.CBL | 37 + tests/cobol85/SG/SG401M.CBL | 39 + tests/cobol85/SM.txt | 27 - tests/cobol85/SM/SM101A.CBL | 569 ++++ tests/cobol85/SM/SM102A.SUB | 393 +++ tests/cobol85/SM/SM103A.CBL | 555 ++++ tests/cobol85/SM/SM104A.SUB | 449 +++ tests/cobol85/SM/SM105A.CBL | 612 ++++ tests/cobol85/SM/SM106A.CBL | 29 + tests/cobol85/SM/SM107A.CBL | 312 ++ tests/cobol85/SM/SM201A.CBL | 634 ++++ tests/cobol85/SM/SM202A.SUB | 529 +++ tests/cobol85/SM/SM203A.CBL | 379 +++ tests/cobol85/SM/SM204A.SUB | 397 +++ tests/cobol85/SM/SM205A.CBL | 621 ++++ tests/cobol85/SM/SM206A.CBL | 711 ++++ tests/cobol85/SM/SM207A.CBL | 362 ++ tests/cobol85/SM/SM208A.CBL | 642 ++++ tests/cobol85/SM/SM301M.CBL | 27 + tests/cobol85/SM/SM401M.CBL | 30 + tests/cobol85/SQ.txt | 95 - tests/cobol85/SQ/SQ101M.CBL | 1881 +++++++++++ tests/cobol85/SQ/SQ102A.CBL | 841 +++++ tests/cobol85/SQ/SQ103A.CBL | 1055 ++++++ tests/cobol85/SQ/SQ104A.CBL | 845 +++++ tests/cobol85/SQ/SQ105A.CBL | 1174 +++++++ tests/cobol85/SQ/SQ106A.CBL | 2660 +++++++++++++++ tests/cobol85/SQ/SQ107A.CBL | 708 ++++ tests/cobol85/SQ/SQ108A.CBL | 799 +++++ tests/cobol85/SQ/SQ109M.CBL | 615 ++++ tests/cobol85/SQ/SQ110M.CBL | 615 ++++ tests/cobol85/SQ/SQ111A.CBL | 491 +++ tests/cobol85/SQ/SQ112A.CBL | 686 ++++ tests/cobol85/SQ/SQ113A.CBL | 1022 ++++++ tests/cobol85/SQ/SQ114A.CBL | 962 ++++++ tests/cobol85/SQ/SQ115A.CBL | 584 ++++ tests/cobol85/SQ/SQ116A.CBL | 957 ++++++ tests/cobol85/SQ/SQ117A.CBL | 817 +++++ tests/cobol85/SQ/SQ121A.CBL | 608 ++++ tests/cobol85/SQ/SQ122A.CBL | 756 +++++ tests/cobol85/SQ/SQ123A.CBL | 904 +++++ tests/cobol85/SQ/SQ124A.CBL | 1192 +++++++ tests/cobol85/SQ/SQ125A.CBL | 600 ++++ tests/cobol85/SQ/SQ126A.CBL | 735 +++++ tests/cobol85/SQ/SQ127A.CBL | 619 ++++ tests/cobol85/SQ/SQ128A.CBL | 552 ++++ tests/cobol85/SQ/SQ129A.CBL | 625 ++++ tests/cobol85/SQ/SQ130A.CBL | 524 +++ tests/cobol85/SQ/SQ131A.CBL | 583 ++++ tests/cobol85/SQ/SQ132A.CBL | 582 ++++ tests/cobol85/SQ/SQ133A.CBL | 1113 +++++++ tests/cobol85/SQ/SQ134A.CBL | 1090 ++++++ tests/cobol85/SQ/SQ135A.CBL | 596 ++++ tests/cobol85/SQ/SQ136A.CBL | 813 +++++ tests/cobol85/SQ/SQ137A.CBL | 835 +++++ tests/cobol85/SQ/SQ138A.CBL | 831 +++++ tests/cobol85/SQ/SQ139A.CBL | 650 ++++ tests/cobol85/SQ/SQ140A.CBL | 658 ++++ tests/cobol85/SQ/SQ141A.CBL | 625 ++++ tests/cobol85/SQ/SQ142A.CBL | 628 ++++ tests/cobol85/SQ/SQ143A.CBL | 479 +++ tests/cobol85/SQ/SQ144A.CBL | 769 +++++ tests/cobol85/SQ/SQ146A.CBL | 510 +++ tests/cobol85/SQ/SQ147A.CBL | 613 ++++ tests/cobol85/SQ/SQ148A.CBL | 652 ++++ tests/cobol85/SQ/SQ149A.CBL | 505 +++ tests/cobol85/SQ/SQ150A.CBL | 512 +++ tests/cobol85/SQ/SQ151A.CBL | 598 ++++ tests/cobol85/SQ/SQ152A.CBL | 607 ++++ tests/cobol85/SQ/SQ153A.CBL | 596 ++++ tests/cobol85/SQ/SQ154A.CBL | 503 +++ tests/cobol85/SQ/SQ155A.CBL | 516 +++ tests/cobol85/SQ/SQ156A.CBL | 516 +++ tests/cobol85/SQ/SQ201M.CBL | 778 +++++ tests/cobol85/SQ/SQ202A.CBL | 448 +++ tests/cobol85/SQ/SQ203A.SUB | 553 ++++ tests/cobol85/SQ/SQ204A.CBL | 617 ++++ tests/cobol85/SQ/SQ205A.CBL | 571 ++++ tests/cobol85/SQ/SQ206A.CBL | 689 ++++ tests/cobol85/SQ/SQ207M.CBL | 440 +++ tests/cobol85/SQ/SQ208M.CBL | 664 ++++ tests/cobol85/SQ/SQ209M.CBL | 459 +++ tests/cobol85/SQ/SQ210M.CBL | 374 +++ tests/cobol85/SQ/SQ211A.CBL | 554 ++++ tests/cobol85/SQ/SQ212A.CBL | 767 +++++ tests/cobol85/SQ/SQ213A.CBL | 640 ++++ tests/cobol85/SQ/SQ214A.CBL | 570 ++++ tests/cobol85/SQ/SQ215A.CBL | 648 ++++ tests/cobol85/SQ/SQ216A.CBL | 608 ++++ tests/cobol85/SQ/SQ217A.CBL | 609 ++++ tests/cobol85/SQ/SQ218A.CBL | 699 ++++ tests/cobol85/SQ/SQ219A.CBL | 702 ++++ tests/cobol85/SQ/SQ220A.CBL | 720 ++++ tests/cobol85/SQ/SQ221A.CBL | 717 ++++ tests/cobol85/SQ/SQ222A.CBL | 701 ++++ tests/cobol85/SQ/SQ223A.CBL | 711 ++++ tests/cobol85/SQ/SQ224A.CBL | 571 ++++ tests/cobol85/SQ/SQ225A.CBL | 652 ++++ tests/cobol85/SQ/SQ226A.CBL | 1650 +++++++++ tests/cobol85/SQ/SQ227A.CBL | 1112 +++++++ tests/cobol85/SQ/SQ228A.CBL | 783 +++++ tests/cobol85/SQ/SQ229A.CBL | 609 ++++ tests/cobol85/SQ/SQ230A.CBL | 512 +++ tests/cobol85/SQ/SQ302M.CBL | 68 + tests/cobol85/SQ/SQ303M.CBL | 49 + tests/cobol85/SQ/SQ401M.CBL | 137 + tests/cobol85/ST.txt | 50 - tests/cobol85/ST/ST101A.CBL | 575 ++++ tests/cobol85/ST/ST102A.SUB | 78 + tests/cobol85/ST/ST103A.SUB | 473 +++ tests/cobol85/ST/ST104A.CBL | 352 ++ tests/cobol85/ST/ST105A.SUB | 445 +++ tests/cobol85/ST/ST106A.CBL | 400 +++ tests/cobol85/ST/ST107A.SUB | 522 +++ tests/cobol85/ST/ST108A.CBL | 619 ++++ tests/cobol85/ST/ST109A.CBL | 368 +++ tests/cobol85/ST/ST110A.SUB | 105 + tests/cobol85/ST/ST111A.SUB | 497 +++ tests/cobol85/ST/ST112M.CBL | 386 +++ tests/cobol85/ST/ST113M.SUB | 67 + tests/cobol85/ST/ST114M.SUB | 467 +++ tests/cobol85/ST/ST115A.CBL | 518 +++ tests/cobol85/ST/ST116A.SUB | 184 ++ tests/cobol85/ST/ST117A.SUB | 550 +++ tests/cobol85/ST/ST118A.CBL | 629 ++++ tests/cobol85/ST/ST119A.CBL | 999 ++++++ tests/cobol85/ST/ST120A.SUB | 78 + tests/cobol85/ST/ST121A.SUB | 473 +++ tests/cobol85/ST/ST122A.CBL | 377 +++ tests/cobol85/ST/ST123A.SUB | 121 + tests/cobol85/ST/ST124A.SUB | 510 +++ tests/cobol85/ST/ST125A.CBL | 434 +++ tests/cobol85/ST/ST126A.SUB | 960 ++++++ tests/cobol85/ST/ST127A.CBL | 1001 ++++++ tests/cobol85/ST/ST131A.CBL | 960 ++++++ tests/cobol85/ST/ST132A.CBL | 743 +++++ tests/cobol85/ST/ST133A.CBL | 905 +++++ tests/cobol85/ST/ST134A.CBL | 617 ++++ tests/cobol85/ST/ST135A.CBL | 593 ++++ tests/cobol85/ST/ST136A.CBL | 554 ++++ tests/cobol85/ST/ST137A.CBL | 747 +++++ tests/cobol85/ST/ST139A.CBL | 864 +++++ tests/cobol85/ST/ST140A.CBL | 947 ++++++ tests/cobol85/ST/ST144A.CBL | 951 ++++++ tests/cobol85/ST/ST146A.CBL | 688 ++++ tests/cobol85/ST/ST147A.CBL | 1315 ++++++++ tests/cobol85/ST/ST301M.CBL | 84 + tests/cobol85/copy/ALTLB | 5 + tests/cobol85/copy/K101A | 3 + tests/cobol85/copy/K1DAA | 5 + tests/cobol85/copy/K1FDA | 7 + tests/cobol85/copy/K1P01 | 1 + tests/cobol85/copy/K1PRA | 1 + tests/cobol85/copy/K1PRB | 3 + tests/cobol85/copy/K1PRC | 1 + tests/cobol85/copy/K1SEA | 8 + tests/cobol85/copy/K1W01 | 2 + tests/cobol85/copy/K1W02 | 2 + tests/cobol85/copy/K1W03 | 1 + tests/cobol85/copy/K1W04 | 5 + tests/cobol85/copy/K1WKA | 2 + tests/cobol85/copy/K1WKB | 3 + tests/cobol85/copy/K1WKC | 2 + tests/cobol85/copy/K1WKY | 2 + tests/cobol85/copy/K1WKZ | 3 + tests/cobol85/copy/K2PRA | 7 + tests/cobol85/copy/K2SEA | 10 + tests/cobol85/copy/K3FCA | 6 + tests/cobol85/copy/K3FCB | 4 + tests/cobol85/copy/K3IOA | 2 + tests/cobol85/copy/K3IOB | 1 + tests/cobol85/copy/K3LGE | 6 + tests/cobol85/copy/K3OCA | 1 + tests/cobol85/copy/K3SCA | 1 + tests/cobol85/copy/K3SML | 1 + tests/cobol85/copy/K3SNA | 1 + tests/cobol85/copy/K3SNB | 4 + tests/cobol85/copy/K4NTA | 3 + tests/cobol85/copy/K501A | 8 + tests/cobol85/copy/K501B | 8 + tests/cobol85/copy/K5SDA | 1 + tests/cobol85/copy/K5SDB | 1 + tests/cobol85/copy/K6SCA | 290 ++ tests/cobol85/copy/K7SEA | 1599 +++++++++ tests/cobol85/copy/KK208A | 1 + tests/cobol85/copy/KP001 | 10 + tests/cobol85/copy/KP002 | 9 + tests/cobol85/copy/KP003 | 5 + tests/cobol85/copy/KP004 | 15 + tests/cobol85/copy/KP005 | 1 + tests/cobol85/copy/KP006 | 2 + tests/cobol85/copy/KP007 | 3 + tests/cobol85/copy/KP008 | 3 + tests/cobol85/copy/KP009 | 1 + tests/cobol85/copy/KP010 | 6 + tests/cobol85/copy/KSM31 | 1 + tests/cobol85/copy/KSM41 | 1 + tests/cobol85/copyalt/ALTLB | 5 + tests/cobol85/newcob.val | 0 tests/cobol85/report.pl | 0 tests/cobol85/summary.pl | 0 tests/cobol85/summary.txt | 0 tests/data-rep.src/binary.at | 5 + tests/data-rep.src/display.at | 3 + tests/data-rep.src/packed.at | 2 + tests/data-rep.src/pointer.at | 1 + tests/i18n_sjis.src/limits.at | 16 + tests/i18n_sjis.src/mb-space.at | 3 + tests/i18n_sjis.src/national.at | 11 + tests/i18n_sjis.src/pic-n.at | 23 + tests/i18n_sjis.src/pic-x.at | 23 + tests/i18n_sjis.src/program-id.at | 4 + tests/i18n_sjis.src/user-defined-word.at | 16 + tests/jp-compat.src/catch-exception.at | 3 + tests/jp-compat.src/file-control.at | 7 + tests/jp-compat.src/file-desc.at | 1 + tests/jp-compat.src/file-userfh.at | 1 + tests/jp-compat.src/intr-funcs.at | 4 + tests/jp-compat.src/job-date.at | 1 + tests/jp-compat.src/nibble-c-for-unsigned.at | 1 + tests/jp-compat.src/sort-key-is.at | 1 + tests/jp-compat.src/special-names.at | 6 + tests/jp-compat.src/spl-registers.at | 13 + tests/jp-compat.src/split-keys.at | 9 + tests/jp-compat.src/system-routine.at | 2 + tests/jp-compat.src/verbose-runtime.at | 1 + tests/run.src/extensions.at | 17 + tests/run.src/functions.at | 36 + tests/run.src/fundamental.at | 4 + tests/run.src/miscellaneous.at | 27 + tests/run.src/ref-mod.at | 7 + tests/run.src/return-code.at | 1 + tests/run.src/subscripts.at | 16 + tests/syntax.src/assign-external.at | 1 + tests/syntax.src/free-1col-aster.at | 1 + tests/syntax.src/indicator.at | 7 + tests/syntax.src/move.at | 7 + 539 files changed, 331138 insertions(+), 610 deletions(-) mode change 100644 => 100755 tests/cobol85/EXEC85.conf.in delete mode 100644 tests/cobol85/IC.txt create mode 100755 tests/cobol85/IC/IC101A.CBL create mode 100755 tests/cobol85/IC/IC103A.CBL create mode 100755 tests/cobol85/IC/IC106A.CBL create mode 100755 tests/cobol85/IC/IC108A.CBL create mode 100755 tests/cobol85/IC/IC112A.CBL create mode 100755 tests/cobol85/IC/IC114A.CBL create mode 100755 tests/cobol85/IC/IC116M.CBL create mode 100755 tests/cobol85/IC/IC201A.CBL create mode 100755 tests/cobol85/IC/IC203A.CBL create mode 100755 tests/cobol85/IC/IC207A.CBL create mode 100755 tests/cobol85/IC/IC209A.CBL create mode 100755 tests/cobol85/IC/IC213A.CBL create mode 100755 tests/cobol85/IC/IC216A.CBL create mode 100755 tests/cobol85/IC/IC222A.CBL create mode 100755 tests/cobol85/IC/IC223A.CBL create mode 100755 tests/cobol85/IC/IC224A.CBL create mode 100755 tests/cobol85/IC/IC225A.CBL create mode 100755 tests/cobol85/IC/IC226A.CBL create mode 100755 tests/cobol85/IC/IC227A.CBL create mode 100755 tests/cobol85/IC/IC228A.CBL create mode 100755 tests/cobol85/IC/IC233A.CBL create mode 100755 tests/cobol85/IC/IC234A.CBL create mode 100755 tests/cobol85/IC/IC235A.CBL create mode 100755 tests/cobol85/IC/IC237A.CBL create mode 100755 tests/cobol85/IC/IC401M.CBL create mode 100755 tests/cobol85/IC/lib/IC102A.CBL create mode 100755 tests/cobol85/IC/lib/IC104A.CBL create mode 100755 tests/cobol85/IC/lib/IC105A.CBL create mode 100755 tests/cobol85/IC/lib/IC107A.CBL create mode 100755 tests/cobol85/IC/lib/IC109A.CBL create mode 100755 tests/cobol85/IC/lib/IC110A.CBL create mode 100755 tests/cobol85/IC/lib/IC111A.CBL create mode 100755 tests/cobol85/IC/lib/IC113A.CBL create mode 100755 tests/cobol85/IC/lib/IC115A.CBL create mode 100755 tests/cobol85/IC/lib/IC117M.CBL create mode 100755 tests/cobol85/IC/lib/IC118M.CBL create mode 100755 tests/cobol85/IC/lib/IC202A.CBL create mode 100755 tests/cobol85/IC/lib/IC204A.CBL create mode 100755 tests/cobol85/IC/lib/IC205A.CBL create mode 100755 tests/cobol85/IC/lib/IC206A.CBL create mode 100755 tests/cobol85/IC/lib/IC208A.CBL create mode 100755 tests/cobol85/IC/lib/IC210A.CBL create mode 100755 tests/cobol85/IC/lib/IC211A.CBL create mode 100755 tests/cobol85/IC/lib/IC212A.CBL create mode 100755 tests/cobol85/IC/lib/IC214A.CBL create mode 100755 tests/cobol85/IC/lib/IC215A.CBL create mode 100755 tests/cobol85/IC/lib/IC217A.CBL delete mode 100644 tests/cobol85/IF.txt create mode 100755 tests/cobol85/IF/IF101A.CBL create mode 100755 tests/cobol85/IF/IF102A.CBL create mode 100755 tests/cobol85/IF/IF103A.CBL create mode 100755 tests/cobol85/IF/IF104A.CBL create mode 100755 tests/cobol85/IF/IF105A.CBL create mode 100755 tests/cobol85/IF/IF106A.CBL create mode 100755 tests/cobol85/IF/IF107A.CBL create mode 100755 tests/cobol85/IF/IF108A.CBL create mode 100755 tests/cobol85/IF/IF109A.CBL create mode 100755 tests/cobol85/IF/IF110A.CBL create mode 100755 tests/cobol85/IF/IF111A.CBL create mode 100755 tests/cobol85/IF/IF112A.CBL create mode 100755 tests/cobol85/IF/IF113A.CBL create mode 100755 tests/cobol85/IF/IF114A.CBL create mode 100755 tests/cobol85/IF/IF115A.CBL create mode 100755 tests/cobol85/IF/IF116A.CBL create mode 100755 tests/cobol85/IF/IF117A.CBL create mode 100755 tests/cobol85/IF/IF118A.CBL create mode 100755 tests/cobol85/IF/IF119A.CBL create mode 100755 tests/cobol85/IF/IF120A.CBL create mode 100755 tests/cobol85/IF/IF121A.CBL create mode 100755 tests/cobol85/IF/IF122A.CBL create mode 100755 tests/cobol85/IF/IF123A.CBL create mode 100755 tests/cobol85/IF/IF124A.CBL create mode 100755 tests/cobol85/IF/IF125A.CBL create mode 100755 tests/cobol85/IF/IF126A.CBL create mode 100755 tests/cobol85/IF/IF127A.CBL create mode 100755 tests/cobol85/IF/IF128A.CBL create mode 100755 tests/cobol85/IF/IF129A.CBL create mode 100755 tests/cobol85/IF/IF130A.CBL create mode 100755 tests/cobol85/IF/IF131A.CBL create mode 100755 tests/cobol85/IF/IF132A.CBL create mode 100755 tests/cobol85/IF/IF133A.CBL create mode 100755 tests/cobol85/IF/IF134A.CBL create mode 100755 tests/cobol85/IF/IF135A.CBL create mode 100755 tests/cobol85/IF/IF136A.CBL create mode 100755 tests/cobol85/IF/IF137A.CBL create mode 100755 tests/cobol85/IF/IF138A.CBL create mode 100755 tests/cobol85/IF/IF139A.CBL create mode 100755 tests/cobol85/IF/IF140A.CBL create mode 100755 tests/cobol85/IF/IF141A.CBL create mode 100755 tests/cobol85/IF/IF142A.CBL create mode 100755 tests/cobol85/IF/IF401M.CBL create mode 100755 tests/cobol85/IF/IF402M.CBL create mode 100755 tests/cobol85/IF/IF403M.CBL delete mode 100644 tests/cobol85/IX.txt create mode 100755 tests/cobol85/IX/IX101A.CBL create mode 100755 tests/cobol85/IX/IX102A.SUB create mode 100755 tests/cobol85/IX/IX103A.SUB create mode 100755 tests/cobol85/IX/IX104A.CBL create mode 100755 tests/cobol85/IX/IX105A.CBL create mode 100755 tests/cobol85/IX/IX106A.CBL create mode 100755 tests/cobol85/IX/IX107A.CBL create mode 100755 tests/cobol85/IX/IX108A.CBL create mode 100755 tests/cobol85/IX/IX109A.CBL create mode 100755 tests/cobol85/IX/IX110A.SUB create mode 100755 tests/cobol85/IX/IX111A.SUB create mode 100755 tests/cobol85/IX/IX112A.CBL create mode 100755 tests/cobol85/IX/IX113A.CBL create mode 100755 tests/cobol85/IX/IX114A.SUB create mode 100755 tests/cobol85/IX/IX115A.SUB create mode 100755 tests/cobol85/IX/IX116A.SUB create mode 100755 tests/cobol85/IX/IX117A.SUB create mode 100755 tests/cobol85/IX/IX118A.SUB create mode 100755 tests/cobol85/IX/IX119A.SUB create mode 100755 tests/cobol85/IX/IX120A.SUB create mode 100755 tests/cobol85/IX/IX121A.CBL create mode 100755 tests/cobol85/IX/IX201A.CBL create mode 100755 tests/cobol85/IX/IX202A.SUB create mode 100755 tests/cobol85/IX/IX203A.SUB create mode 100755 tests/cobol85/IX/IX204A.CBL create mode 100755 tests/cobol85/IX/IX205A.CBL create mode 100755 tests/cobol85/IX/IX206A.CBL create mode 100755 tests/cobol85/IX/IX207A.CBL create mode 100755 tests/cobol85/IX/IX208A.CBL create mode 100755 tests/cobol85/IX/IX209A.CBL create mode 100755 tests/cobol85/IX/IX210A.CBL create mode 100755 tests/cobol85/IX/IX211A.CBL create mode 100755 tests/cobol85/IX/IX212A.CBL create mode 100755 tests/cobol85/IX/IX213A.CBL create mode 100755 tests/cobol85/IX/IX214A.CBL create mode 100755 tests/cobol85/IX/IX215A.CBL create mode 100755 tests/cobol85/IX/IX216A.CBL create mode 100755 tests/cobol85/IX/IX217A.CBL create mode 100755 tests/cobol85/IX/IX218A.CBL create mode 100755 tests/cobol85/IX/IX301M.CBL create mode 100755 tests/cobol85/IX/IX302M.CBL create mode 100755 tests/cobol85/IX/IX401M.CBL mode change 100644 => 100755 tests/cobol85/Makefile.am delete mode 100644 tests/cobol85/NC.txt create mode 100755 tests/cobol85/NC/NC101A.CBL create mode 100755 tests/cobol85/NC/NC101A.log create mode 100755 tests/cobol85/NC/NC102A.CBL create mode 100755 tests/cobol85/NC/NC103A.CBL create mode 100755 tests/cobol85/NC/NC104A.CBL create mode 100755 tests/cobol85/NC/NC105A.CBL create mode 100755 tests/cobol85/NC/NC106A.CBL create mode 100755 tests/cobol85/NC/NC107A.CBL create mode 100755 tests/cobol85/NC/NC108M.CBL create mode 100755 tests/cobol85/NC/NC109M.CBL create mode 100755 tests/cobol85/NC/NC109M.DAT create mode 100755 tests/cobol85/NC/NC110M.CBL create mode 100755 tests/cobol85/NC/NC111A.CBL create mode 100755 tests/cobol85/NC/NC112A.CBL create mode 100755 tests/cobol85/NC/NC113M.CBL create mode 100755 tests/cobol85/NC/NC114M.CBL create mode 100755 tests/cobol85/NC/NC115A.CBL create mode 100755 tests/cobol85/NC/NC116A.CBL create mode 100755 tests/cobol85/NC/NC117A.CBL create mode 100755 tests/cobol85/NC/NC118A.CBL create mode 100755 tests/cobol85/NC/NC119A.CBL create mode 100755 tests/cobol85/NC/NC120A.CBL create mode 100755 tests/cobol85/NC/NC121M.CBL create mode 100755 tests/cobol85/NC/NC122A.CBL create mode 100755 tests/cobol85/NC/NC123A.CBL create mode 100755 tests/cobol85/NC/NC124A.CBL create mode 100755 tests/cobol85/NC/NC125A.CBL create mode 100755 tests/cobol85/NC/NC126A.CBL create mode 100755 tests/cobol85/NC/NC127A.CBL create mode 100755 tests/cobol85/NC/NC131A.CBL create mode 100755 tests/cobol85/NC/NC132A.CBL create mode 100755 tests/cobol85/NC/NC133A.CBL create mode 100755 tests/cobol85/NC/NC134A.CBL create mode 100755 tests/cobol85/NC/NC135A.CBL create mode 100755 tests/cobol85/NC/NC136A.CBL create mode 100755 tests/cobol85/NC/NC137A.CBL create mode 100755 tests/cobol85/NC/NC138A.CBL create mode 100755 tests/cobol85/NC/NC139A.CBL create mode 100755 tests/cobol85/NC/NC140A.CBL create mode 100755 tests/cobol85/NC/NC141A.CBL create mode 100755 tests/cobol85/NC/NC170A.CBL create mode 100755 tests/cobol85/NC/NC171A.CBL create mode 100755 tests/cobol85/NC/NC172A.CBL create mode 100755 tests/cobol85/NC/NC173A.CBL create mode 100755 tests/cobol85/NC/NC174A.CBL create mode 100755 tests/cobol85/NC/NC175A.CBL create mode 100755 tests/cobol85/NC/NC176A.CBL create mode 100755 tests/cobol85/NC/NC177A.CBL create mode 100755 tests/cobol85/NC/NC201A.CBL create mode 100755 tests/cobol85/NC/NC202A.CBL create mode 100755 tests/cobol85/NC/NC203A.CBL create mode 100755 tests/cobol85/NC/NC204M.CBL create mode 100755 tests/cobol85/NC/NC204M.DAT create mode 100755 tests/cobol85/NC/NC205A.CBL create mode 100755 tests/cobol85/NC/NC206A.CBL create mode 100755 tests/cobol85/NC/NC207A.CBL create mode 100755 tests/cobol85/NC/NC208A.CBL create mode 100755 tests/cobol85/NC/NC209A.CBL create mode 100755 tests/cobol85/NC/NC210A.CBL create mode 100755 tests/cobol85/NC/NC211A.CBL create mode 100755 tests/cobol85/NC/NC214M.CBL create mode 100755 tests/cobol85/NC/NC215A.CBL create mode 100755 tests/cobol85/NC/NC216A.CBL create mode 100755 tests/cobol85/NC/NC217A.CBL create mode 100755 tests/cobol85/NC/NC218A.CBL create mode 100755 tests/cobol85/NC/NC219A.CBL create mode 100755 tests/cobol85/NC/NC220M.CBL create mode 100755 tests/cobol85/NC/NC221A.CBL create mode 100755 tests/cobol85/NC/NC222A.CBL create mode 100755 tests/cobol85/NC/NC223A.CBL create mode 100755 tests/cobol85/NC/NC224A.CBL create mode 100755 tests/cobol85/NC/NC225A.CBL create mode 100755 tests/cobol85/NC/NC231A.CBL create mode 100755 tests/cobol85/NC/NC232A.CBL create mode 100755 tests/cobol85/NC/NC233A.CBL create mode 100755 tests/cobol85/NC/NC234A.CBL create mode 100755 tests/cobol85/NC/NC235A.CBL create mode 100755 tests/cobol85/NC/NC236A.CBL create mode 100755 tests/cobol85/NC/NC237A.CBL create mode 100755 tests/cobol85/NC/NC238A.CBL create mode 100755 tests/cobol85/NC/NC239A.CBL create mode 100755 tests/cobol85/NC/NC240A.CBL create mode 100755 tests/cobol85/NC/NC241A.CBL create mode 100755 tests/cobol85/NC/NC242A.CBL create mode 100755 tests/cobol85/NC/NC243A.CBL create mode 100755 tests/cobol85/NC/NC244A.CBL create mode 100755 tests/cobol85/NC/NC245A.CBL create mode 100755 tests/cobol85/NC/NC246A.CBL create mode 100755 tests/cobol85/NC/NC247A.CBL create mode 100755 tests/cobol85/NC/NC248A.CBL create mode 100755 tests/cobol85/NC/NC250A.CBL create mode 100755 tests/cobol85/NC/NC251A.CBL create mode 100755 tests/cobol85/NC/NC252A.CBL create mode 100755 tests/cobol85/NC/NC253A.CBL create mode 100755 tests/cobol85/NC/NC254A.CBL create mode 100755 tests/cobol85/NC/NC302M.CBL create mode 100755 tests/cobol85/NC/NC303M.CBL create mode 100755 tests/cobol85/NC/NC401M.CBL create mode 100755 tests/cobol85/NC/report.txt create mode 100755 tests/cobol85/NC/tmp.cbl delete mode 100644 tests/cobol85/OB.txt create mode 100755 tests/cobol85/OB/OBIC1A.CBL create mode 100755 tests/cobol85/OB/OBNC1M.CBL create mode 100755 tests/cobol85/OB/OBNC2M.CBL create mode 100755 tests/cobol85/OB/OBSQ1A.CBL create mode 100755 tests/cobol85/OB/OBSQ3A.CBL create mode 100755 tests/cobol85/OB/OBSQ4A.SUB create mode 100755 tests/cobol85/OB/OBSQ5A.SUB create mode 100755 tests/cobol85/OB/lib/OBIC2A.CBL create mode 100755 tests/cobol85/OB/lib/OBIC3A.CBL mode change 100644 => 100755 tests/cobol85/README delete mode 100644 tests/cobol85/RL.txt create mode 100644 tests/cobol85/RL/RL101A.CBL create mode 100644 tests/cobol85/RL/RL102A.SUB create mode 100644 tests/cobol85/RL/RL103A.SUB create mode 100644 tests/cobol85/RL/RL104A.CBL create mode 100644 tests/cobol85/RL/RL105A.CBL create mode 100644 tests/cobol85/RL/RL106A.CBL create mode 100644 tests/cobol85/RL/RL107A.CBL create mode 100644 tests/cobol85/RL/RL108A.CBL create mode 100644 tests/cobol85/RL/RL109A.SUB create mode 100644 tests/cobol85/RL/RL110A.SUB create mode 100644 tests/cobol85/RL/RL111A.CBL create mode 100644 tests/cobol85/RL/RL112A.CBL create mode 100644 tests/cobol85/RL/RL113A.CBL create mode 100644 tests/cobol85/RL/RL114A.CBL create mode 100644 tests/cobol85/RL/RL115A.CBL create mode 100644 tests/cobol85/RL/RL116A.CBL create mode 100644 tests/cobol85/RL/RL117A.CBL create mode 100644 tests/cobol85/RL/RL118A.CBL create mode 100644 tests/cobol85/RL/RL119A.CBL create mode 100644 tests/cobol85/RL/RL201A.CBL create mode 100644 tests/cobol85/RL/RL202A.SUB create mode 100644 tests/cobol85/RL/RL203A.SUB create mode 100644 tests/cobol85/RL/RL204A.CBL create mode 100644 tests/cobol85/RL/RL205A.CBL create mode 100644 tests/cobol85/RL/RL206A.CBL create mode 100644 tests/cobol85/RL/RL207A.SUB create mode 100644 tests/cobol85/RL/RL208A.SUB create mode 100644 tests/cobol85/RL/RL209A.CBL create mode 100644 tests/cobol85/RL/RL210A.CBL create mode 100644 tests/cobol85/RL/RL211A.CBL create mode 100644 tests/cobol85/RL/RL212A.CBL create mode 100644 tests/cobol85/RL/RL213A.SUB create mode 100644 tests/cobol85/RL/RL301M.CBL create mode 100644 tests/cobol85/RL/RL302M.CBL create mode 100644 tests/cobol85/RL/RL401M.CBL delete mode 100644 tests/cobol85/SG.txt create mode 100755 tests/cobol85/SG/SG101A.CBL create mode 100755 tests/cobol85/SG/SG102A.CBL create mode 100755 tests/cobol85/SG/SG103A.CBL create mode 100755 tests/cobol85/SG/SG104A.CBL create mode 100755 tests/cobol85/SG/SG105A.CBL create mode 100755 tests/cobol85/SG/SG106A.CBL create mode 100755 tests/cobol85/SG/SG201A.CBL create mode 100755 tests/cobol85/SG/SG202A.CBL create mode 100755 tests/cobol85/SG/SG203A.CBL create mode 100755 tests/cobol85/SG/SG204A.CBL create mode 100755 tests/cobol85/SG/SG302M.CBL create mode 100755 tests/cobol85/SG/SG303M.CBL create mode 100755 tests/cobol85/SG/SG401M.CBL delete mode 100644 tests/cobol85/SM.txt create mode 100755 tests/cobol85/SM/SM101A.CBL create mode 100755 tests/cobol85/SM/SM102A.SUB create mode 100755 tests/cobol85/SM/SM103A.CBL create mode 100755 tests/cobol85/SM/SM104A.SUB create mode 100755 tests/cobol85/SM/SM105A.CBL create mode 100755 tests/cobol85/SM/SM106A.CBL create mode 100755 tests/cobol85/SM/SM107A.CBL create mode 100755 tests/cobol85/SM/SM201A.CBL create mode 100755 tests/cobol85/SM/SM202A.SUB create mode 100755 tests/cobol85/SM/SM203A.CBL create mode 100755 tests/cobol85/SM/SM204A.SUB create mode 100755 tests/cobol85/SM/SM205A.CBL create mode 100755 tests/cobol85/SM/SM206A.CBL create mode 100755 tests/cobol85/SM/SM207A.CBL create mode 100755 tests/cobol85/SM/SM208A.CBL create mode 100755 tests/cobol85/SM/SM301M.CBL create mode 100755 tests/cobol85/SM/SM401M.CBL delete mode 100644 tests/cobol85/SQ.txt create mode 100755 tests/cobol85/SQ/SQ101M.CBL create mode 100755 tests/cobol85/SQ/SQ102A.CBL create mode 100755 tests/cobol85/SQ/SQ103A.CBL create mode 100755 tests/cobol85/SQ/SQ104A.CBL create mode 100755 tests/cobol85/SQ/SQ105A.CBL create mode 100755 tests/cobol85/SQ/SQ106A.CBL create mode 100755 tests/cobol85/SQ/SQ107A.CBL create mode 100755 tests/cobol85/SQ/SQ108A.CBL create mode 100755 tests/cobol85/SQ/SQ109M.CBL create mode 100755 tests/cobol85/SQ/SQ110M.CBL create mode 100755 tests/cobol85/SQ/SQ111A.CBL create mode 100755 tests/cobol85/SQ/SQ112A.CBL create mode 100755 tests/cobol85/SQ/SQ113A.CBL create mode 100755 tests/cobol85/SQ/SQ114A.CBL create mode 100755 tests/cobol85/SQ/SQ115A.CBL create mode 100755 tests/cobol85/SQ/SQ116A.CBL create mode 100755 tests/cobol85/SQ/SQ117A.CBL create mode 100755 tests/cobol85/SQ/SQ121A.CBL create mode 100755 tests/cobol85/SQ/SQ122A.CBL create mode 100755 tests/cobol85/SQ/SQ123A.CBL create mode 100755 tests/cobol85/SQ/SQ124A.CBL create mode 100755 tests/cobol85/SQ/SQ125A.CBL create mode 100755 tests/cobol85/SQ/SQ126A.CBL create mode 100755 tests/cobol85/SQ/SQ127A.CBL create mode 100755 tests/cobol85/SQ/SQ128A.CBL create mode 100755 tests/cobol85/SQ/SQ129A.CBL create mode 100755 tests/cobol85/SQ/SQ130A.CBL create mode 100755 tests/cobol85/SQ/SQ131A.CBL create mode 100755 tests/cobol85/SQ/SQ132A.CBL create mode 100755 tests/cobol85/SQ/SQ133A.CBL create mode 100755 tests/cobol85/SQ/SQ134A.CBL create mode 100755 tests/cobol85/SQ/SQ135A.CBL create mode 100755 tests/cobol85/SQ/SQ136A.CBL create mode 100755 tests/cobol85/SQ/SQ137A.CBL create mode 100755 tests/cobol85/SQ/SQ138A.CBL create mode 100755 tests/cobol85/SQ/SQ139A.CBL create mode 100755 tests/cobol85/SQ/SQ140A.CBL create mode 100755 tests/cobol85/SQ/SQ141A.CBL create mode 100755 tests/cobol85/SQ/SQ142A.CBL create mode 100755 tests/cobol85/SQ/SQ143A.CBL create mode 100755 tests/cobol85/SQ/SQ144A.CBL create mode 100755 tests/cobol85/SQ/SQ146A.CBL create mode 100755 tests/cobol85/SQ/SQ147A.CBL create mode 100755 tests/cobol85/SQ/SQ148A.CBL create mode 100755 tests/cobol85/SQ/SQ149A.CBL create mode 100755 tests/cobol85/SQ/SQ150A.CBL create mode 100755 tests/cobol85/SQ/SQ151A.CBL create mode 100755 tests/cobol85/SQ/SQ152A.CBL create mode 100755 tests/cobol85/SQ/SQ153A.CBL create mode 100755 tests/cobol85/SQ/SQ154A.CBL create mode 100755 tests/cobol85/SQ/SQ155A.CBL create mode 100755 tests/cobol85/SQ/SQ156A.CBL create mode 100755 tests/cobol85/SQ/SQ201M.CBL create mode 100755 tests/cobol85/SQ/SQ202A.CBL create mode 100755 tests/cobol85/SQ/SQ203A.SUB create mode 100755 tests/cobol85/SQ/SQ204A.CBL create mode 100755 tests/cobol85/SQ/SQ205A.CBL create mode 100755 tests/cobol85/SQ/SQ206A.CBL create mode 100755 tests/cobol85/SQ/SQ207M.CBL create mode 100755 tests/cobol85/SQ/SQ208M.CBL create mode 100755 tests/cobol85/SQ/SQ209M.CBL create mode 100755 tests/cobol85/SQ/SQ210M.CBL create mode 100755 tests/cobol85/SQ/SQ211A.CBL create mode 100755 tests/cobol85/SQ/SQ212A.CBL create mode 100755 tests/cobol85/SQ/SQ213A.CBL create mode 100755 tests/cobol85/SQ/SQ214A.CBL create mode 100755 tests/cobol85/SQ/SQ215A.CBL create mode 100755 tests/cobol85/SQ/SQ216A.CBL create mode 100755 tests/cobol85/SQ/SQ217A.CBL create mode 100755 tests/cobol85/SQ/SQ218A.CBL create mode 100755 tests/cobol85/SQ/SQ219A.CBL create mode 100755 tests/cobol85/SQ/SQ220A.CBL create mode 100755 tests/cobol85/SQ/SQ221A.CBL create mode 100755 tests/cobol85/SQ/SQ222A.CBL create mode 100755 tests/cobol85/SQ/SQ223A.CBL create mode 100755 tests/cobol85/SQ/SQ224A.CBL create mode 100755 tests/cobol85/SQ/SQ225A.CBL create mode 100755 tests/cobol85/SQ/SQ226A.CBL create mode 100755 tests/cobol85/SQ/SQ227A.CBL create mode 100755 tests/cobol85/SQ/SQ228A.CBL create mode 100755 tests/cobol85/SQ/SQ229A.CBL create mode 100755 tests/cobol85/SQ/SQ230A.CBL create mode 100755 tests/cobol85/SQ/SQ302M.CBL create mode 100755 tests/cobol85/SQ/SQ303M.CBL create mode 100755 tests/cobol85/SQ/SQ401M.CBL delete mode 100644 tests/cobol85/ST.txt create mode 100755 tests/cobol85/ST/ST101A.CBL create mode 100755 tests/cobol85/ST/ST102A.SUB create mode 100755 tests/cobol85/ST/ST103A.SUB create mode 100755 tests/cobol85/ST/ST104A.CBL create mode 100755 tests/cobol85/ST/ST105A.SUB create mode 100755 tests/cobol85/ST/ST106A.CBL create mode 100755 tests/cobol85/ST/ST107A.SUB create mode 100755 tests/cobol85/ST/ST108A.CBL create mode 100755 tests/cobol85/ST/ST109A.CBL create mode 100755 tests/cobol85/ST/ST110A.SUB create mode 100755 tests/cobol85/ST/ST111A.SUB create mode 100755 tests/cobol85/ST/ST112M.CBL create mode 100755 tests/cobol85/ST/ST113M.SUB create mode 100755 tests/cobol85/ST/ST114M.SUB create mode 100755 tests/cobol85/ST/ST115A.CBL create mode 100755 tests/cobol85/ST/ST116A.SUB create mode 100755 tests/cobol85/ST/ST117A.SUB create mode 100755 tests/cobol85/ST/ST118A.CBL create mode 100755 tests/cobol85/ST/ST119A.CBL create mode 100755 tests/cobol85/ST/ST120A.SUB create mode 100755 tests/cobol85/ST/ST121A.SUB create mode 100755 tests/cobol85/ST/ST122A.CBL create mode 100755 tests/cobol85/ST/ST123A.SUB create mode 100755 tests/cobol85/ST/ST124A.SUB create mode 100755 tests/cobol85/ST/ST125A.CBL create mode 100755 tests/cobol85/ST/ST126A.SUB create mode 100755 tests/cobol85/ST/ST127A.CBL create mode 100755 tests/cobol85/ST/ST131A.CBL create mode 100755 tests/cobol85/ST/ST132A.CBL create mode 100755 tests/cobol85/ST/ST133A.CBL create mode 100755 tests/cobol85/ST/ST134A.CBL create mode 100755 tests/cobol85/ST/ST135A.CBL create mode 100755 tests/cobol85/ST/ST136A.CBL create mode 100755 tests/cobol85/ST/ST137A.CBL create mode 100755 tests/cobol85/ST/ST139A.CBL create mode 100755 tests/cobol85/ST/ST140A.CBL create mode 100755 tests/cobol85/ST/ST144A.CBL create mode 100755 tests/cobol85/ST/ST146A.CBL create mode 100755 tests/cobol85/ST/ST147A.CBL create mode 100755 tests/cobol85/ST/ST301M.CBL create mode 100755 tests/cobol85/copy/ALTLB create mode 100755 tests/cobol85/copy/K101A create mode 100755 tests/cobol85/copy/K1DAA create mode 100755 tests/cobol85/copy/K1FDA create mode 100755 tests/cobol85/copy/K1P01 create mode 100755 tests/cobol85/copy/K1PRA create mode 100755 tests/cobol85/copy/K1PRB create mode 100755 tests/cobol85/copy/K1PRC create mode 100755 tests/cobol85/copy/K1SEA create mode 100755 tests/cobol85/copy/K1W01 create mode 100755 tests/cobol85/copy/K1W02 create mode 100755 tests/cobol85/copy/K1W03 create mode 100755 tests/cobol85/copy/K1W04 create mode 100755 tests/cobol85/copy/K1WKA create mode 100755 tests/cobol85/copy/K1WKB create mode 100755 tests/cobol85/copy/K1WKC create mode 100755 tests/cobol85/copy/K1WKY create mode 100755 tests/cobol85/copy/K1WKZ create mode 100755 tests/cobol85/copy/K2PRA create mode 100755 tests/cobol85/copy/K2SEA create mode 100755 tests/cobol85/copy/K3FCA create mode 100755 tests/cobol85/copy/K3FCB create mode 100755 tests/cobol85/copy/K3IOA create mode 100755 tests/cobol85/copy/K3IOB create mode 100755 tests/cobol85/copy/K3LGE create mode 100755 tests/cobol85/copy/K3OCA create mode 100755 tests/cobol85/copy/K3SCA create mode 100755 tests/cobol85/copy/K3SML create mode 100755 tests/cobol85/copy/K3SNA create mode 100755 tests/cobol85/copy/K3SNB create mode 100755 tests/cobol85/copy/K4NTA create mode 100755 tests/cobol85/copy/K501A create mode 100755 tests/cobol85/copy/K501B create mode 100755 tests/cobol85/copy/K5SDA create mode 100755 tests/cobol85/copy/K5SDB create mode 100755 tests/cobol85/copy/K6SCA create mode 100755 tests/cobol85/copy/K7SEA create mode 100755 tests/cobol85/copy/KK208A create mode 100755 tests/cobol85/copy/KP001 create mode 100755 tests/cobol85/copy/KP002 create mode 100755 tests/cobol85/copy/KP003 create mode 100755 tests/cobol85/copy/KP004 create mode 100755 tests/cobol85/copy/KP005 create mode 100755 tests/cobol85/copy/KP006 create mode 100755 tests/cobol85/copy/KP007 create mode 100755 tests/cobol85/copy/KP008 create mode 100755 tests/cobol85/copy/KP009 create mode 100755 tests/cobol85/copy/KP010 create mode 100755 tests/cobol85/copy/KSM31 create mode 100755 tests/cobol85/copy/KSM41 create mode 100755 tests/cobol85/copyalt/ALTLB mode change 100644 => 100755 tests/cobol85/newcob.val mode change 100644 => 100755 tests/cobol85/report.pl mode change 100644 => 100755 tests/cobol85/summary.pl mode change 100644 => 100755 tests/cobol85/summary.txt diff --git a/.github/workflows/cicd.yml b/.github/workflows/cicd.yml index 86a5b0df..b085369d 100644 --- a/.github/workflows/cicd.yml +++ b/.github/workflows/cicd.yml @@ -40,59 +40,59 @@ jobs: make install export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - - name: Make test scripts - run: | - cd tests/ - make - cd ../ + #- name: Make test scripts + # run: | + # cd tests/ + # make + # cd ../ - - name: Run tests "command-line-options" - run: | - export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - cd tests/ - ./command-line-options - cd ../ + #- name: Run tests "command-line-options" + # run: | + # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + # cd tests/ + # ./command-line-options + # cd ../ - - name: Run tests "misc" - run: | - export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - cd tests/ - ./misc - cd ../ + #- name: Run tests "misc" + # run: | + # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + # cd tests/ + # ./misc + # cd ../ - - name: Run tests "data-rep" - run: | - export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - cd tests/ - ./data-rep || true - cd ../ + #- name: Run tests "data-rep" + # run: | + # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + # cd tests/ + # ./data-rep + # cd ../ - - name: Run tests "i18n_sjis" - run: | - export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - cd tests/ - ./i18n_sjis || true + #- name: Run tests "i18n_sjis" + # run: | + # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + # cd tests/ + # ./i18n_sjis - - name: Run tests "jp-compat" - run: | - export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - cd tests/ - ./jp-compat || true - cd ../ + #- name: Run tests "jp-compat" + # run: | + # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + # cd tests/ + # ./jp-compat + # cd ../ - #- name: Run tests "run" - # run: | - # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - # cd tests/ - # ./run || true - # cd ../ + #- name: Run tests "run" + # run: | + # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + # cd tests/ + # ./run + # cd ../ - - name: Run tests "syntax" - run: | - export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - cd tests/ - ./syntax || true - cd ../ + #- name: Run tests "syntax" + # run: | + # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + # cd tests/ + # ./syntax + # cd ../ - name: Run NIST test run: | @@ -100,15 +100,15 @@ jobs: cd tests/cobol85/ make test - - name: Run tests "i18n_utf8" - run: | - export CLASSPATH=":$HOME/.java_lib/sqlite.jar" - ./configure --prefix=/usr/ --with-vbisam --enable-utf8 - make - make install - export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - ./i18n_utf8 || true - cd ../ + #- name: Run tests "i18n_utf8" + # run: | + # export CLASSPATH=":$HOME/.java_lib/sqlite.jar" + # ./configure --prefix=/usr/ --with-vbisam --enable-utf8 + # make + # make install + # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + # ./i18n_utf8 || true + # cd ../ static_analysis: runs-on: ubuntu-latest diff --git a/tests/atlocal.in b/tests/atlocal.in index c42707c0..744175c9 100644 --- a/tests/atlocal.in +++ b/tests/atlocal.in @@ -64,3 +64,4 @@ export LIBPATH="${abs_top_builddir}/libcob/.libs:$LIBPATH" export COB_HAS_ISAM export COB_SPLITKEY_FLAGS +SKIP_TEST="exit 77" diff --git a/tests/cobol85/EXEC85.conf.in b/tests/cobol85/EXEC85.conf.in old mode 100644 new mode 100755 diff --git a/tests/cobol85/IC.txt b/tests/cobol85/IC.txt deleted file mode 100644 index 4f16596d..00000000 --- a/tests/cobol85/IC.txt +++ /dev/null @@ -1,35 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -IC101A.CBL 5 5 0 0 0 OK -IC103A.CBL 10 10 0 0 0 OK -IC106A.CBL 14 14 0 0 0 OK -IC108A.CBL 9 9 0 0 0 OK -IC112A.CBL 3 3 0 0 0 OK -IC114A.CBL 3 3 0 0 0 OK -IC116M.CBL 1 1 0 0 0 OK -IC201A.CBL 11 11 0 0 0 OK -IC203A.CBL 21 21 0 0 0 OK -IC207A.CBL 11 11 0 0 0 OK -IC209A.CBL 4 4 0 0 0 OK -IC213A.CBL 3 3 0 0 0 OK -IC216A.CBL 2 2 0 0 0 OK -IC222A.CBL 16 16 0 0 0 OK -IC223A.CBL 11 11 0 0 0 OK -IC224A.CBL 44 44 0 0 0 OK -IC225A.CBL 36 36 0 0 0 OK -IC226A.CBL 4 4 0 0 0 OK -IC227A.CBL 23 19 0 4 0 OK -IC228A.CBL 4 4 0 0 0 OK -IC233A.CBL 1 1 0 0 0 OK -IC234A.CBL 1 1 0 0 0 OK -IC235A.CBL 12 12 0 0 0 OK -IC237A.CBL 1 1 0 0 0 OK -IC401M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 250 246 0 4 0 -% 100.0 98.4 0.0 1.6 0.0 - -Number of programs: 24 -Successfully executed: 24 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/IC/IC101A.CBL b/tests/cobol85/IC/IC101A.CBL new file mode 100755 index 00000000..49d78cf2 --- /dev/null +++ b/tests/cobol85/IC/IC101A.CBL @@ -0,0 +1,382 @@ +000100 IDENTIFICATION DIVISION. IC1014.2 +000200 PROGRAM-ID. IC1014.2 +000300 IC101A. IC1014.2 +000400**************************************************************** IC1014.2 +000500* * IC1014.2 +000600* VALIDATION FOR:- * IC1014.2 +000700* * IC1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1014.2 +000900* * IC1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1014.2 +001100* * IC1014.2 +001200**************************************************************** IC1014.2 +001300* * IC1014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1014.2 +001500* * IC1014.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1014.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1014.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1014.2 +001900* * IC1014.2 +002000**************************************************************** IC1014.2 +002100* THIS ROUTINE CHECKS THE USE OF THE CALL STATEMENT IC1014.2 +002200* WITH ONE PARAMETER IN THE USING PHRASE. SUBSEQUENT CALLS IC1014.2 +002300* CHECK THAT THE CALLED ROUTINE REMAINS IN THE LAST USED STATE.IC1014.2 +002400* IC1014.2 +002500* THERE ARE NO DELETE PARAGRAPHS IN THIS ROUTINE IC1014.2 +002600* SINCE THESE ARE THE BASIC CALL TESTS AND IF A CALL IC1014.2 +002700* STATEMENT IS REJECTED THERE IS NO REASON TO RUN THE ROUTINE. IC1014.2 +002800* IC1014.2 +002900* THE FIRST THREE CALLS USE A DATA-NAME THE SAME AS IC1014.2 +003000* THE NAME IN THE SUBPROGRAM. THE LAST TWO CALLS USE IC1014.2 +003100* A DIFFERENT DATA-NAME FROM THE NAME IN THE SUBPROGRAM. IC1014.2 +003200* THE PICTURE CLAUSES FOR DATA-NAMES IN THE USING PHRASES IC1014.2 +003300* OF THE CALLED AND CALLING PROGRAMS ARE IDENTICAL. IC1014.2 +003400 ENVIRONMENT DIVISION. IC1014.2 +003500 CONFIGURATION SECTION. IC1014.2 +003600 SOURCE-COMPUTER. IC1014.2 +003700 Linux. IC1014.2 +003800 OBJECT-COMPUTER. IC1014.2 +003900 Linux. IC1014.2 +004000 INPUT-OUTPUT SECTION. IC1014.2 +004100 FILE-CONTROL. IC1014.2 +004200 SELECT PRINT-FILE ASSIGN TO IC1014.2 +004300 "report.log". IC1014.2 +004400 DATA DIVISION. IC1014.2 +004500 FILE SECTION. IC1014.2 +004600 FD PRINT-FILE. IC1014.2 +004700 01 PRINT-REC PICTURE X(120). IC1014.2 +004800 01 DUMMY-RECORD PICTURE X(120). IC1014.2 +004900 WORKING-STORAGE SECTION. IC1014.2 +005000 77 DN1 PICTURE S9 VALUE ZERO. IC1014.2 +005100 77 DN2 PICTURE S9 VALUE ZERO. IC1014.2 +005200 01 TEST-RESULTS. IC1014.2 +005300 02 FILLER PIC X VALUE SPACE. IC1014.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. IC1014.2 +005500 02 FILLER PIC X VALUE SPACE. IC1014.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. IC1014.2 +005700 02 FILLER PIC X VALUE SPACE. IC1014.2 +005800 02 PAR-NAME. IC1014.2 +005900 03 FILLER PIC X(19) VALUE SPACE. IC1014.2 +006000 03 PARDOT-X PIC X VALUE SPACE. IC1014.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. IC1014.2 +006200 02 FILLER PIC X(8) VALUE SPACE. IC1014.2 +006300 02 RE-MARK PIC X(61). IC1014.2 +006400 01 TEST-COMPUTED. IC1014.2 +006500 02 FILLER PIC X(30) VALUE SPACE. IC1014.2 +006600 02 FILLER PIC X(17) VALUE IC1014.2 +006700 " COMPUTED=". IC1014.2 +006800 02 COMPUTED-X. IC1014.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1014.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A IC1014.2 +007100 PIC -9(9).9(9). IC1014.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1014.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1014.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1014.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. IC1014.2 +007600 04 COMPUTED-18V0 PIC -9(18). IC1014.2 +007700 04 FILLER PIC X. IC1014.2 +007800 03 FILLER PIC X(50) VALUE SPACE. IC1014.2 +007900 01 TEST-CORRECT. IC1014.2 +008000 02 FILLER PIC X(30) VALUE SPACE. IC1014.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". IC1014.2 +008200 02 CORRECT-X. IC1014.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. IC1014.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1014.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1014.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1014.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1014.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. IC1014.2 +008900 04 CORRECT-18V0 PIC -9(18). IC1014.2 +009000 04 FILLER PIC X. IC1014.2 +009100 03 FILLER PIC X(2) VALUE SPACE. IC1014.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1014.2 +009300 01 CCVS-C-1. IC1014.2 +009400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1014.2 +009500- "SS PARAGRAPH-NAME IC1014.2 +009600- " REMARKS". IC1014.2 +009700 02 FILLER PIC X(20) VALUE SPACE. IC1014.2 +009800 01 CCVS-C-2. IC1014.2 +009900 02 FILLER PIC X VALUE SPACE. IC1014.2 +010000 02 FILLER PIC X(6) VALUE "TESTED". IC1014.2 +010100 02 FILLER PIC X(15) VALUE SPACE. IC1014.2 +010200 02 FILLER PIC X(4) VALUE "FAIL". IC1014.2 +010300 02 FILLER PIC X(94) VALUE SPACE. IC1014.2 +010400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1014.2 +010500 01 REC-CT PIC 99 VALUE ZERO. IC1014.2 +010600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1014.2 +010700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1014.2 +010800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1014.2 +010900 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1014.2 +011000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1014.2 +011100 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1014.2 +011200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1014.2 +011300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1014.2 +011400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1014.2 +011500 01 CCVS-H-1. IC1014.2 +011600 02 FILLER PIC X(39) VALUE SPACES. IC1014.2 +011700 02 FILLER PIC X(42) VALUE IC1014.2 +011800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1014.2 +011900 02 FILLER PIC X(39) VALUE SPACES. IC1014.2 +012000 01 CCVS-H-2A. IC1014.2 +012100 02 FILLER PIC X(40) VALUE SPACE. IC1014.2 +012200 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1014.2 +012300 02 FILLER PIC XXXX VALUE IC1014.2 +012400 "4.2 ". IC1014.2 +012500 02 FILLER PIC X(28) VALUE IC1014.2 +012600 " COPY - NOT FOR DISTRIBUTION". IC1014.2 +012700 02 FILLER PIC X(41) VALUE SPACE. IC1014.2 +012800 IC1014.2 +012900 01 CCVS-H-2B. IC1014.2 +013000 02 FILLER PIC X(15) VALUE IC1014.2 +013100 "TEST RESULT OF ". IC1014.2 +013200 02 TEST-ID PIC X(9). IC1014.2 +013300 02 FILLER PIC X(4) VALUE IC1014.2 +013400 " IN ". IC1014.2 +013500 02 FILLER PIC X(12) VALUE IC1014.2 +013600 " HIGH ". IC1014.2 +013700 02 FILLER PIC X(22) VALUE IC1014.2 +013800 " LEVEL VALIDATION FOR ". IC1014.2 +013900 02 FILLER PIC X(58) VALUE IC1014.2 +014000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1014.2 +014100 01 CCVS-H-3. IC1014.2 +014200 02 FILLER PIC X(34) VALUE IC1014.2 +014300 " FOR OFFICIAL USE ONLY ". IC1014.2 +014400 02 FILLER PIC X(58) VALUE IC1014.2 +014500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1014.2 +014600 02 FILLER PIC X(28) VALUE IC1014.2 +014700 " COPYRIGHT 1985 ". IC1014.2 +014800 01 CCVS-E-1. IC1014.2 +014900 02 FILLER PIC X(52) VALUE SPACE. IC1014.2 +015000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1014.2 +015100 02 ID-AGAIN PIC X(9). IC1014.2 +015200 02 FILLER PIC X(45) VALUE SPACES. IC1014.2 +015300 01 CCVS-E-2. IC1014.2 +015400 02 FILLER PIC X(31) VALUE SPACE. IC1014.2 +015500 02 FILLER PIC X(21) VALUE SPACE. IC1014.2 +015600 02 CCVS-E-2-2. IC1014.2 +015700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1014.2 +015800 03 FILLER PIC X VALUE SPACE. IC1014.2 +015900 03 ENDER-DESC PIC X(44) VALUE IC1014.2 +016000 "ERRORS ENCOUNTERED". IC1014.2 +016100 01 CCVS-E-3. IC1014.2 +016200 02 FILLER PIC X(22) VALUE IC1014.2 +016300 " FOR OFFICIAL USE ONLY". IC1014.2 +016400 02 FILLER PIC X(12) VALUE SPACE. IC1014.2 +016500 02 FILLER PIC X(58) VALUE IC1014.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1014.2 +016700 02 FILLER PIC X(13) VALUE SPACE. IC1014.2 +016800 02 FILLER PIC X(15) VALUE IC1014.2 +016900 " COPYRIGHT 1985". IC1014.2 +017000 01 CCVS-E-4. IC1014.2 +017100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1014.2 +017200 02 FILLER PIC X(4) VALUE " OF ". IC1014.2 +017300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1014.2 +017400 02 FILLER PIC X(40) VALUE IC1014.2 +017500 " TESTS WERE EXECUTED SUCCESSFULLY". IC1014.2 +017600 01 XXINFO. IC1014.2 +017700 02 FILLER PIC X(19) VALUE IC1014.2 +017800 "*** INFORMATION ***". IC1014.2 +017900 02 INFO-TEXT. IC1014.2 +018000 04 FILLER PIC X(8) VALUE SPACE. IC1014.2 +018100 04 XXCOMPUTED PIC X(20). IC1014.2 +018200 04 FILLER PIC X(5) VALUE SPACE. IC1014.2 +018300 04 XXCORRECT PIC X(20). IC1014.2 +018400 02 INF-ANSI-REFERENCE PIC X(48). IC1014.2 +018500 01 HYPHEN-LINE. IC1014.2 +018600 02 FILLER PIC IS X VALUE IS SPACE. IC1014.2 +018700 02 FILLER PIC IS X(65) VALUE IS "************************IC1014.2 +018800- "*****************************************". IC1014.2 +018900 02 FILLER PIC IS X(54) VALUE IS "************************IC1014.2 +019000- "******************************". IC1014.2 +019100 01 CCVS-PGM-ID PIC X(9) VALUE IC1014.2 +019200 "IC101A". IC1014.2 +019300 PROCEDURE DIVISION. IC1014.2 +019400 CCVS1 SECTION. IC1014.2 +019500 OPEN-FILES. IC1014.2 +019600 OPEN OUTPUT PRINT-FILE. IC1014.2 +019700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1014.2 +019800 MOVE SPACE TO TEST-RESULTS. IC1014.2 +019900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1014.2 +020000 GO TO CCVS1-EXIT. IC1014.2 +020100 CLOSE-FILES. IC1014.2 +020200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1014.2 +020300 TERMINATE-CCVS. IC1014.2 +020400*S EXIT PROGRAM. IC1014.2 +020500*SERMINATE-CALL. IC1014.2 +020600 STOP RUN. IC1014.2 +020700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1014.2 +020800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1014.2 +020900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1014.2 +021000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1014.2 +021100 MOVE "****TEST DELETED****" TO RE-MARK. IC1014.2 +021200 PRINT-DETAIL. IC1014.2 +021300 IF REC-CT NOT EQUAL TO ZERO IC1014.2 +021400 MOVE "." TO PARDOT-X IC1014.2 +021500 MOVE REC-CT TO DOTVALUE. IC1014.2 +021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1014.2 +021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1014.2 +021800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1014.2 +021900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1014.2 +022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1014.2 +022100 MOVE SPACE TO CORRECT-X. IC1014.2 +022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1014.2 +022300 MOVE SPACE TO RE-MARK. IC1014.2 +022400 HEAD-ROUTINE. IC1014.2 +022500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +022600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +022700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1014.2 +022800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1014.2 +022900 COLUMN-NAMES-ROUTINE. IC1014.2 +023000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +023100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +023300 END-ROUTINE. IC1014.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1014.2 +023500 END-RTN-EXIT. IC1014.2 +023600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +023700 END-ROUTINE-1. IC1014.2 +023800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1014.2 +023900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1014.2 +024000 ADD PASS-COUNTER TO ERROR-HOLD. IC1014.2 +024100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1014.2 +024200 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1014.2 +024300 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1014.2 +024400 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1014.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1014.2 +024600 END-ROUTINE-12. IC1014.2 +024700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1014.2 +024800 IF ERROR-COUNTER IS EQUAL TO ZERO IC1014.2 +024900 MOVE "NO " TO ERROR-TOTAL IC1014.2 +025000 ELSE IC1014.2 +025100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1014.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1014.2 +025300 PERFORM WRITE-LINE. IC1014.2 +025400 END-ROUTINE-13. IC1014.2 +025500 IF DELETE-COUNTER IS EQUAL TO ZERO IC1014.2 +025600 MOVE "NO " TO ERROR-TOTAL ELSE IC1014.2 +025700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1014.2 +025800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1014.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +026000 IF INSPECT-COUNTER EQUAL TO ZERO IC1014.2 +026100 MOVE "NO " TO ERROR-TOTAL IC1014.2 +026200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1014.2 +026300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1014.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +026500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1014.2 +026600 WRITE-LINE. IC1014.2 +026700 ADD 1 TO RECORD-COUNT. IC1014.2 +026800 IF RECORD-COUNT GREATER 50 IC1014.2 +026900 MOVE DUMMY-RECORD TO DUMMY-HOLD IC1014.2 +027000 MOVE SPACE TO DUMMY-RECORD IC1014.2 +027100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1014.2 +027200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1014.2 +027300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1014.2 +027400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1014.2 +027500 MOVE DUMMY-HOLD TO DUMMY-RECORD IC1014.2 +027600 MOVE ZERO TO RECORD-COUNT. IC1014.2 +027700 PERFORM WRT-LN. IC1014.2 +027800 WRT-LN. IC1014.2 +027900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1014.2 +028000 MOVE SPACE TO DUMMY-RECORD. IC1014.2 +028100 BLANK-LINE-PRINT. IC1014.2 +028200 PERFORM WRT-LN. IC1014.2 +028300 FAIL-ROUTINE. IC1014.2 +028400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1014.2 +028500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1014.2 +028600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1014.2 +028700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1014.2 +028800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +028900 MOVE SPACES TO INF-ANSI-REFERENCE. IC1014.2 +029000 GO TO FAIL-ROUTINE-EX. IC1014.2 +029100 FAIL-ROUTINE-WRITE. IC1014.2 +029200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1014.2 +029300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1014.2 +029400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1014.2 +029500 MOVE SPACES TO COR-ANSI-REFERENCE. IC1014.2 +029600 FAIL-ROUTINE-EX. EXIT. IC1014.2 +029700 BAIL-OUT. IC1014.2 +029800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1014.2 +029900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1014.2 +030000 BAIL-OUT-WRITE. IC1014.2 +030100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1014.2 +030200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1014.2 +030300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1014.2 +030400 MOVE SPACES TO INF-ANSI-REFERENCE. IC1014.2 +030500 BAIL-OUT-EX. EXIT. IC1014.2 +030600 CCVS1-EXIT. IC1014.2 +030700 EXIT. IC1014.2 +030800 SECT-IC101-0001 SECTION. IC1014.2 +030900 CALL-INIT-1. IC1014.2 +031000 MOVE "CALL...USING DATA-NM" TO FEATURE. IC1014.2 +031100 MOVE "CALL-TEST-01" TO PAR-NAME. IC1014.2 +031200 CALL-TEST-1. IC1014.2 +031300 CALL "IC102A" USING DN1. IC1014.2 +031400 IF DN1 IS EQUAL TO 1 IC1014.2 +031500 PERFORM PASS IC1014.2 +031600 GO TO CALL-WRITE-1. IC1014.2 +031700 CALL-FAIL-1. IC1014.2 +031800 MOVE 1 TO CORRECT-18V0. IC1014.2 +031900 MOVE DN1 TO COMPUTED-18V0. IC1014.2 +032000 PERFORM FAIL. IC1014.2 +032100 CALL-WRITE-1. IC1014.2 +032200 PERFORM PRINT-DETAIL. IC1014.2 +032300 CALL-INIT-2. IC1014.2 +032400 MOVE 0 TO DN1. IC1014.2 +032500 CALL-TEST-2. IC1014.2 +032600 CALL "IC102A" USING DN1. IC1014.2 +032700 IF DN1 IS EQUAL TO 2 IC1014.2 +032800 PERFORM PASS IC1014.2 +032900 GO TO CALL-WRITE-2. IC1014.2 +033000 CALL-FAIL-2. IC1014.2 +033100 MOVE 2 TO CORRECT-18V0. IC1014.2 +033200 MOVE DN1 TO COMPUTED-18V0. IC1014.2 +033300 PERFORM FAIL. IC1014.2 +033400 CALL-WRITE-2. IC1014.2 +033500 MOVE "CALL-TEST-02" TO PAR-NAME. IC1014.2 +033600 PERFORM PRINT-DETAIL. IC1014.2 +033700 CALL-INIT-3. IC1014.2 +033800 ADD 4 TO DN1. IC1014.2 +033900 CALL-TEST-3. IC1014.2 +034000 CALL "IC102A" USING DN1. IC1014.2 +034100 IF DN1 IS EQUAL TO 3 IC1014.2 +034200 PERFORM PASS IC1014.2 +034300 GO TO CALL-WRITE-3. IC1014.2 +034400 CALL-FAIL-3. IC1014.2 +034500 MOVE 3 TO CORRECT-18V0. IC1014.2 +034600 MOVE DN1 TO COMPUTED-18V0. IC1014.2 +034700 PERFORM FAIL. IC1014.2 +034800 CALL-WRITE-3. IC1014.2 +034900 MOVE "CALL-TEST-03" TO PAR-NAME. IC1014.2 +035000 PERFORM PRINT-DETAIL. IC1014.2 +035100 CALL-TEST-4. IC1014.2 +035200 CALL "IC102A" USING DN2. IC1014.2 +035300 IF DN2 IS NOT EQUAL TO 4 IC1014.2 +035400 GO TO CALL-FAIL-4. IC1014.2 +035500 PERFORM PASS. IC1014.2 +035600 GO TO CALL-WRITE-4. IC1014.2 +035700 CALL-FAIL-4. IC1014.2 +035800 MOVE 4 TO CORRECT-18V0. IC1014.2 +035900 MOVE DN2 TO COMPUTED-18V0. IC1014.2 +036000 PERFORM FAIL. IC1014.2 +036100 CALL-WRITE-4. IC1014.2 +036200 MOVE "CALL-TEST-04" TO PAR-NAME. IC1014.2 +036300 PERFORM PRINT-DETAIL. IC1014.2 +036400 CALL-INIT-5. IC1014.2 +036500 MOVE 0 TO DN2. IC1014.2 +036600 CALL-TEST-5. IC1014.2 +036700 CALL "IC102A" USING DN2. IC1014.2 +036800 IF DN2 IS EQUAL TO 5 IC1014.2 +036900 PERFORM PASS IC1014.2 +037000 GO TO CALL-WRITE-5. IC1014.2 +037100 CALL-FAIL-5. IC1014.2 +037200 MOVE 5 TO CORRECT-18V0. IC1014.2 +037300 MOVE DN2 TO COMPUTED-18V0. IC1014.2 +037400 PERFORM FAIL. IC1014.2 +037500 CALL-WRITE-5. IC1014.2 +037600 MOVE "CALL-TEST-05" TO PAR-NAME. IC1014.2 +037700 PERFORM PRINT-DETAIL. IC1014.2 +037800 CALL-END-ROUTINE. IC1014.2 +037900 GO TO CCVS-EXIT. IC1014.2 +038000 CCVS-EXIT SECTION. IC1014.2 +038100 CCVS-999999. IC1014.2 +038200 GO TO CLOSE-FILES. IC1014.2 diff --git a/tests/cobol85/IC/IC103A.CBL b/tests/cobol85/IC/IC103A.CBL new file mode 100755 index 00000000..f40489be --- /dev/null +++ b/tests/cobol85/IC/IC103A.CBL @@ -0,0 +1,497 @@ +000100 IDENTIFICATION DIVISION. IC1034.2 +000200 PROGRAM-ID. IC1034.2 +000300 IC103A. IC1034.2 +000400**************************************************************** IC1034.2 +000500* * IC1034.2 +000600* VALIDATION FOR:- * IC1034.2 +000700* * IC1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1034.2 +000900* * IC1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1034.2 +001100* * IC1034.2 +001200**************************************************************** IC1034.2 +001300* * IC1034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1034.2 +001500* * IC1034.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1034.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1034.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1034.2 +001900* * IC1034.2 +002000**************************************************************** IC1034.2 +002100* THIS PROGRAM TESTS THE USE OF MULTIPLE DATA-NAMES IC1034.2 +002200* IN THE USING PHRASE OF THE CALL STATEMENT. TWO 01 GROUP IC1034.2 +002300* ITEMS AND AN ELEMENTARY 77 ITEM ARE THE PARAMETERS. THE IC1034.2 +002400* DATA DEFINITIONS FOR THE GROUP ITEM PARAMETERS ARE NOT IC1034.2 +002500* THE SAME AS IN THE SUBPROGRAM BUT THE NUMBER OF CHARACTERS IC1034.2 +002600* ARE IDENTICAL. IC1034.2 +002700* THIS PROGRAM ALSO CALLS A SUBPROGRAM WITH MORE IC1034.2 +002800* THAN ONE EXIT PROGRAM STATEMENT. IC1034.2 +002900 ENVIRONMENT DIVISION. IC1034.2 +003000 CONFIGURATION SECTION. IC1034.2 +003100 SOURCE-COMPUTER. IC1034.2 +003200 Linux. IC1034.2 +003300 OBJECT-COMPUTER. IC1034.2 +003400 Linux. IC1034.2 +003500 INPUT-OUTPUT SECTION. IC1034.2 +003600 FILE-CONTROL. IC1034.2 +003700 SELECT PRINT-FILE ASSIGN TO IC1034.2 +003800 "report.log". IC1034.2 +003900 DATA DIVISION. IC1034.2 +004000 FILE SECTION. IC1034.2 +004100 FD PRINT-FILE. IC1034.2 +004200 01 PRINT-REC PICTURE X(120). IC1034.2 +004300 01 DUMMY-RECORD PICTURE X(120). IC1034.2 +004400 WORKING-STORAGE SECTION. IC1034.2 +004500 77 MAIN-DN1 PICTURE 999. IC1034.2 +004600 77 MAIN-DN2 PICTURE S99 COMPUTATIONAL. IC1034.2 +004700 77 ELEM-77 PICTURE V9(4) COMPUTATIONAL. IC1034.2 +004800 01 GROUP-01. IC1034.2 +004900 02 ALPHA-NUM-FIELD PIC X(5). IC1034.2 +005000 02 GROUP-LEV2. IC1034.2 +005100 03 NUMER-FIELD PIC 99. IC1034.2 +005200 03 ALPHA-FIELD PIC A(3). IC1034.2 +005300 01 GROUP-02. IC1034.2 +005400 02 NUM-ITEM PIC S99. IC1034.2 +005500 02 ALPHA-EDITED PICTURE X(6). IC1034.2 +005600 01 TEST-RESULTS. IC1034.2 +005700 02 FILLER PIC X VALUE SPACE. IC1034.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. IC1034.2 +005900 02 FILLER PIC X VALUE SPACE. IC1034.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. IC1034.2 +006100 02 FILLER PIC X VALUE SPACE. IC1034.2 +006200 02 PAR-NAME. IC1034.2 +006300 03 FILLER PIC X(19) VALUE SPACE. IC1034.2 +006400 03 PARDOT-X PIC X VALUE SPACE. IC1034.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. IC1034.2 +006600 02 FILLER PIC X(8) VALUE SPACE. IC1034.2 +006700 02 RE-MARK PIC X(61). IC1034.2 +006800 01 TEST-COMPUTED. IC1034.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IC1034.2 +007000 02 FILLER PIC X(17) VALUE IC1034.2 +007100 " COMPUTED=". IC1034.2 +007200 02 COMPUTED-X. IC1034.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1034.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A IC1034.2 +007500 PIC -9(9).9(9). IC1034.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1034.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1034.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1034.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. IC1034.2 +008000 04 COMPUTED-18V0 PIC -9(18). IC1034.2 +008100 04 FILLER PIC X. IC1034.2 +008200 03 FILLER PIC X(50) VALUE SPACE. IC1034.2 +008300 01 TEST-CORRECT. IC1034.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IC1034.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". IC1034.2 +008600 02 CORRECT-X. IC1034.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. IC1034.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1034.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1034.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1034.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1034.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. IC1034.2 +009300 04 CORRECT-18V0 PIC -9(18). IC1034.2 +009400 04 FILLER PIC X. IC1034.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IC1034.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1034.2 +009700 01 CCVS-C-1. IC1034.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1034.2 +009900- "SS PARAGRAPH-NAME IC1034.2 +010000- " REMARKS". IC1034.2 +010100 02 FILLER PIC X(20) VALUE SPACE. IC1034.2 +010200 01 CCVS-C-2. IC1034.2 +010300 02 FILLER PIC X VALUE SPACE. IC1034.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". IC1034.2 +010500 02 FILLER PIC X(15) VALUE SPACE. IC1034.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". IC1034.2 +010700 02 FILLER PIC X(94) VALUE SPACE. IC1034.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1034.2 +010900 01 REC-CT PIC 99 VALUE ZERO. IC1034.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1034.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1034.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1034.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1034.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1034.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1034.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1034.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1034.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1034.2 +011900 01 CCVS-H-1. IC1034.2 +012000 02 FILLER PIC X(39) VALUE SPACES. IC1034.2 +012100 02 FILLER PIC X(42) VALUE IC1034.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1034.2 +012300 02 FILLER PIC X(39) VALUE SPACES. IC1034.2 +012400 01 CCVS-H-2A. IC1034.2 +012500 02 FILLER PIC X(40) VALUE SPACE. IC1034.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1034.2 +012700 02 FILLER PIC XXXX VALUE IC1034.2 +012800 "4.2 ". IC1034.2 +012900 02 FILLER PIC X(28) VALUE IC1034.2 +013000 " COPY - NOT FOR DISTRIBUTION". IC1034.2 +013100 02 FILLER PIC X(41) VALUE SPACE. IC1034.2 +013200 IC1034.2 +013300 01 CCVS-H-2B. IC1034.2 +013400 02 FILLER PIC X(15) VALUE IC1034.2 +013500 "TEST RESULT OF ". IC1034.2 +013600 02 TEST-ID PIC X(9). IC1034.2 +013700 02 FILLER PIC X(4) VALUE IC1034.2 +013800 " IN ". IC1034.2 +013900 02 FILLER PIC X(12) VALUE IC1034.2 +014000 " HIGH ". IC1034.2 +014100 02 FILLER PIC X(22) VALUE IC1034.2 +014200 " LEVEL VALIDATION FOR ". IC1034.2 +014300 02 FILLER PIC X(58) VALUE IC1034.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1034.2 +014500 01 CCVS-H-3. IC1034.2 +014600 02 FILLER PIC X(34) VALUE IC1034.2 +014700 " FOR OFFICIAL USE ONLY ". IC1034.2 +014800 02 FILLER PIC X(58) VALUE IC1034.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1034.2 +015000 02 FILLER PIC X(28) VALUE IC1034.2 +015100 " COPYRIGHT 1985 ". IC1034.2 +015200 01 CCVS-E-1. IC1034.2 +015300 02 FILLER PIC X(52) VALUE SPACE. IC1034.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1034.2 +015500 02 ID-AGAIN PIC X(9). IC1034.2 +015600 02 FILLER PIC X(45) VALUE SPACES. IC1034.2 +015700 01 CCVS-E-2. IC1034.2 +015800 02 FILLER PIC X(31) VALUE SPACE. IC1034.2 +015900 02 FILLER PIC X(21) VALUE SPACE. IC1034.2 +016000 02 CCVS-E-2-2. IC1034.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1034.2 +016200 03 FILLER PIC X VALUE SPACE. IC1034.2 +016300 03 ENDER-DESC PIC X(44) VALUE IC1034.2 +016400 "ERRORS ENCOUNTERED". IC1034.2 +016500 01 CCVS-E-3. IC1034.2 +016600 02 FILLER PIC X(22) VALUE IC1034.2 +016700 " FOR OFFICIAL USE ONLY". IC1034.2 +016800 02 FILLER PIC X(12) VALUE SPACE. IC1034.2 +016900 02 FILLER PIC X(58) VALUE IC1034.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1034.2 +017100 02 FILLER PIC X(13) VALUE SPACE. IC1034.2 +017200 02 FILLER PIC X(15) VALUE IC1034.2 +017300 " COPYRIGHT 1985". IC1034.2 +017400 01 CCVS-E-4. IC1034.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1034.2 +017600 02 FILLER PIC X(4) VALUE " OF ". IC1034.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1034.2 +017800 02 FILLER PIC X(40) VALUE IC1034.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". IC1034.2 +018000 01 XXINFO. IC1034.2 +018100 02 FILLER PIC X(19) VALUE IC1034.2 +018200 "*** INFORMATION ***". IC1034.2 +018300 02 INFO-TEXT. IC1034.2 +018400 04 FILLER PIC X(8) VALUE SPACE. IC1034.2 +018500 04 XXCOMPUTED PIC X(20). IC1034.2 +018600 04 FILLER PIC X(5) VALUE SPACE. IC1034.2 +018700 04 XXCORRECT PIC X(20). IC1034.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). IC1034.2 +018900 01 HYPHEN-LINE. IC1034.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. IC1034.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************IC1034.2 +019200- "*****************************************". IC1034.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************IC1034.2 +019400- "******************************". IC1034.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE IC1034.2 +019600 "IC103A". IC1034.2 +019700 PROCEDURE DIVISION. IC1034.2 +019800 CCVS1 SECTION. IC1034.2 +019900 OPEN-FILES. IC1034.2 +020000 OPEN OUTPUT PRINT-FILE. IC1034.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1034.2 +020200 MOVE SPACE TO TEST-RESULTS. IC1034.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1034.2 +020400 GO TO CCVS1-EXIT. IC1034.2 +020500 CLOSE-FILES. IC1034.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1034.2 +020700 TERMINATE-CCVS. IC1034.2 +020800*S EXIT PROGRAM. IC1034.2 +020900*SERMINATE-CALL. IC1034.2 +021000 STOP RUN. IC1034.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1034.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1034.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1034.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1034.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. IC1034.2 +021600 PRINT-DETAIL. IC1034.2 +021700 IF REC-CT NOT EQUAL TO ZERO IC1034.2 +021800 MOVE "." TO PARDOT-X IC1034.2 +021900 MOVE REC-CT TO DOTVALUE. IC1034.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1034.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1034.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1034.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1034.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1034.2 +022500 MOVE SPACE TO CORRECT-X. IC1034.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1034.2 +022700 MOVE SPACE TO RE-MARK. IC1034.2 +022800 HEAD-ROUTINE. IC1034.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1034.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1034.2 +023300 COLUMN-NAMES-ROUTINE. IC1034.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +023700 END-ROUTINE. IC1034.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1034.2 +023900 END-RTN-EXIT. IC1034.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +024100 END-ROUTINE-1. IC1034.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1034.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1034.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. IC1034.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1034.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1034.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1034.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1034.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1034.2 +025000 END-ROUTINE-12. IC1034.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1034.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO IC1034.2 +025300 MOVE "NO " TO ERROR-TOTAL IC1034.2 +025400 ELSE IC1034.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1034.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1034.2 +025700 PERFORM WRITE-LINE. IC1034.2 +025800 END-ROUTINE-13. IC1034.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO IC1034.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE IC1034.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1034.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1034.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO IC1034.2 +026500 MOVE "NO " TO ERROR-TOTAL IC1034.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1034.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1034.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1034.2 +027000 WRITE-LINE. IC1034.2 +027100 ADD 1 TO RECORD-COUNT. IC1034.2 +027200 IF RECORD-COUNT GREATER 50 IC1034.2 +027300 MOVE DUMMY-RECORD TO DUMMY-HOLD IC1034.2 +027400 MOVE SPACE TO DUMMY-RECORD IC1034.2 +027500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1034.2 +027600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1034.2 +027700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1034.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1034.2 +027900 MOVE DUMMY-HOLD TO DUMMY-RECORD IC1034.2 +028000 MOVE ZERO TO RECORD-COUNT. IC1034.2 +028100 PERFORM WRT-LN. IC1034.2 +028200 WRT-LN. IC1034.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1034.2 +028400 MOVE SPACE TO DUMMY-RECORD. IC1034.2 +028500 BLANK-LINE-PRINT. IC1034.2 +028600 PERFORM WRT-LN. IC1034.2 +028700 FAIL-ROUTINE. IC1034.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1034.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1034.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1034.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1034.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. IC1034.2 +029400 GO TO FAIL-ROUTINE-EX. IC1034.2 +029500 FAIL-ROUTINE-WRITE. IC1034.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1034.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1034.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1034.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. IC1034.2 +030000 FAIL-ROUTINE-EX. EXIT. IC1034.2 +030100 BAIL-OUT. IC1034.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1034.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1034.2 +030400 BAIL-OUT-WRITE. IC1034.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1034.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1034.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1034.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. IC1034.2 +030900 BAIL-OUT-EX. EXIT. IC1034.2 +031000 CCVS1-EXIT. IC1034.2 +031100 EXIT. IC1034.2 +031200 SECT-IC103-0001 SECTION. IC1034.2 +031300* THE TESTS IN THIS SECTION CALL A SUBPROGRAM WHICH IC1034.2 +031400* HAS FOUR EXIT PROGRAM STATEMENTS. A DIFFERENT EXIT IS IC1034.2 +031500* TAKEN FOR EACH CALL TO THE SUBPROGRAM. IC1034.2 +031600 EXIT-INIT. IC1034.2 +031700 MOVE "MULTIPLE EXIT PROGRM" TO FEATURE. IC1034.2 +031800 EXIT-INIT-001. IC1034.2 +031900 MOVE 0 TO MAIN-DN2. IC1034.2 +032000 MOVE 1 TO MAIN-DN1. IC1034.2 +032100 EXIT-TEST-001. IC1034.2 +032200 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2 +032300 IF MAIN-DN2 EQUAL TO 1 IC1034.2 +032400 PERFORM PASS IC1034.2 +032500 GO TO EXIT-WRITE-001. IC1034.2 +032600 EXIT-FAIL-001. IC1034.2 +032700 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2 +032800 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2 +032900 MOVE "FIRST EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2 +033000 PERFORM FAIL. IC1034.2 +033100 EXIT-WRITE-001. IC1034.2 +033200 MOVE "EXIT-TEST-01" TO PAR-NAME. IC1034.2 +033300 PERFORM PRINT-DETAIL. IC1034.2 +033400 EXIT-INIT-002. IC1034.2 +033500 MOVE 0 TO MAIN-DN2. IC1034.2 +033600 MOVE 2 TO MAIN-DN1. IC1034.2 +033700 EXIT-TEST-002. IC1034.2 +033800 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2 +033900 IF MAIN-DN2 EQUAL TO 2 IC1034.2 +034000 PERFORM PASS IC1034.2 +034100 GO TO EXIT-WRITE-002. IC1034.2 +034200 EXIT-FAIL-002. IC1034.2 +034300 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2 +034400 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2 +034500 MOVE "SECOND EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2 +034600 PERFORM FAIL. IC1034.2 +034700 EXIT-WRITE-002. IC1034.2 +034800 MOVE "EXIT-TEST-02" TO PAR-NAME. IC1034.2 +034900 PERFORM PRINT-DETAIL. IC1034.2 +035000 EXIT-INIT-003. IC1034.2 +035100 MOVE 0 TO MAIN-DN2. IC1034.2 +035200 MOVE 3 TO MAIN-DN1. IC1034.2 +035300 EXIT-TEST-003. IC1034.2 +035400 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2 +035500 IF MAIN-DN2 NOT EQUAL TO 3 IC1034.2 +035600 GO TO EXIT-FAIL-003. IC1034.2 +035700 PERFORM PASS. IC1034.2 +035800 GO TO EXIT-WRITE-003. IC1034.2 +035900 EXIT-FAIL-003. IC1034.2 +036000 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2 +036100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2 +036200 MOVE "THIRD EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2 +036300 PERFORM FAIL. IC1034.2 +036400 EXIT-WRITE-003. IC1034.2 +036500 MOVE "EXIT-TEST-03" TO PAR-NAME. IC1034.2 +036600 PERFORM PRINT-DETAIL. IC1034.2 +036700 EXIT-INIT-004. IC1034.2 +036800 MOVE 0 TO MAIN-DN2. IC1034.2 +036900 MOVE 4 TO MAIN-DN1. IC1034.2 +037000 EXIT-TEST-004. IC1034.2 +037100 CALL "IC105A" USING MAIN-DN1 MAIN-DN2. IC1034.2 +037200 IF MAIN-DN2 NOT EQUAL TO 4 IC1034.2 +037300 GO TO EXIT-FAIL-004. IC1034.2 +037400 PERFORM PASS. IC1034.2 +037500 GO TO EXIT-WRITE-004. IC1034.2 +037600 EXIT-FAIL-004. IC1034.2 +037700 MOVE MAIN-DN1 TO CORRECT-18V0. IC1034.2 +037800 MOVE MAIN-DN2 TO COMPUTED-18V0. IC1034.2 +037900 MOVE "FOURTH EXIT FROM SUBPROGRAM" TO RE-MARK. IC1034.2 +038000 PERFORM FAIL. IC1034.2 +038100 EXIT-WRITE-004. IC1034.2 +038200 MOVE "EXIT-TEST-04" TO PAR-NAME. IC1034.2 +038300 PERFORM PRINT-DETAIL. IC1034.2 +038400 GO TO SECT-IC103-0002. IC1034.2 +038500 EXIT-DELETES. IC1034.2 +038600* IF THE SUBPROGRAM WITH MULTIPLE EXIT PROGRAM IC1034.2 +038700* STATEMENTS CANNOT BE INCLUDED IN THE RUN UNIT IC1034.2 +038800* DELETE PARAGRAPH EXIT-INIT-001 THRU EXIT-WRITE-004. IC1034.2 +038900 PERFORM DE-LETE. IC1034.2 +039000 MOVE "EXIT-TEST-01" TO PAR-NAME. IC1034.2 +039100 PERFORM PRINT-DETAIL. IC1034.2 +039200 PERFORM DE-LETE. IC1034.2 +039300 MOVE "EXIT-TEST-02" TO PAR-NAME. IC1034.2 +039400 PERFORM PRINT-DETAIL. IC1034.2 +039500 PERFORM DE-LETE. IC1034.2 +039600 MOVE "EXIT-TEST-03" TO PAR-NAME. IC1034.2 +039700 PERFORM PRINT-DETAIL. IC1034.2 +039800 PERFORM DE-LETE. IC1034.2 +039900 MOVE "EXIT-TEST-04" TO PAR-NAME. IC1034.2 +040000 PERFORM PRINT-DETAIL. IC1034.2 +040100 SECT-IC103-0002 SECTION. IC1034.2 +040200* THIS SECTION CALLS A SUBPROGRAM WITH TWO GROUP ITEMS IC1034.2 +040300* AND ONE ELEMENTARY ITEM IN THE USING PHRASE. THE ITEM IC1034.2 +040400* DESCRIPTIONS ARE DIFFERENT IN THE SUBPROGRAM FROM THE MAIN IC1034.2 +040500* PROGRAM, BUT THE NUMBER OF CHARACTERS IS IDENTICAL. IC1034.2 +040600* REFERENCE X3.23-1974, SECTION XII, 3.1 AND 3.2. IC1034.2 +040700 CALL-INIT-06. IC1034.2 +040800 MOVE "CALL-TEST-06" TO PAR-NAME. IC1034.2 +040900 MOVE 0 TO NUMER-FIELD ELEM-77 NUM-ITEM. IC1034.2 +041000 MOVE SPACE TO ALPHA-NUM-FIELD ALPHA-FIELD ALPHA-EDITED. IC1034.2 +041100 MOVE "CALL USING DN SERIES" TO FEATURE. IC1034.2 +041200 CALL-TEST-06. IC1034.2 +041300 CALL "IC104A" USING GROUP-01 ELEM-77 GROUP-02. IC1034.2 +041400 GO TO CALL-TEST-06-01. IC1034.2 +041500 CALL-DELETE-06. IC1034.2 +041600 PERFORM DE-LETE. IC1034.2 +041700 PERFORM PRINT-DETAIL. IC1034.2 +041800 GO TO CCVS-EXIT. IC1034.2 +041900* IF IC104 CANNOT BE INCLUDED IN THE RUN UNIT IC1034.2 +042000* DELETE THE PARAGRAPH CALL-TEST-06. IC1034.2 +042100 CALL-TEST-06-01. IC1034.2 +042200 IF ALPHA-NUM-FIELD NOT EQUAL TO "IC104" IC1034.2 +042300 GO TO CALL-FAIL-06-01. IC1034.2 +042400 PERFORM PASS. IC1034.2 +042500 GO TO CALL-WRITE-06-01. IC1034.2 +042600 CALL-FAIL-06-01. IC1034.2 +042700 MOVE ALPHA-NUM-FIELD TO COMPUTED-A. IC1034.2 +042800 MOVE "IC104" TO CORRECT-A. IC1034.2 +042900 PERFORM FAIL. IC1034.2 +043000 MOVE "ALPHANUMERIC PARAMETER" TO RE-MARK. IC1034.2 +043100 CALL-WRITE-06-01. IC1034.2 +043200 ADD 1 TO REC-CT. IC1034.2 +043300 PERFORM PRINT-DETAIL. IC1034.2 +043400 CALL-TEST-06-02. IC1034.2 +043500 IF NUMER-FIELD EQUAL TO 25 IC1034.2 +043600 PERFORM PASS IC1034.2 +043700 GO TO CALL-WRITE-06-02. IC1034.2 +043800 CALL-FAIL-06-02. IC1034.2 +043900 PERFORM FAIL. IC1034.2 +044000 MOVE NUMER-FIELD TO COMPUTED-18V0. IC1034.2 +044100 MOVE 25 TO CORRECT-18V0. IC1034.2 +044200 MOVE "NUMERIC DISPLAY PARAMETER" TO RE-MARK. IC1034.2 +044300 CALL-WRITE-06-02. IC1034.2 +044400 ADD 1 TO REC-CT. IC1034.2 +044500 PERFORM PRINT-DETAIL. IC1034.2 +044600 CALL-TEST-06-03. IC1034.2 +044700 IF ALPHA-FIELD EQUAL TO "YES" IC1034.2 +044800 PERFORM PASS IC1034.2 +044900 GO TO CALL-WRITE-06-03. IC1034.2 +045000 CALL-FAIL-06-03. IC1034.2 +045100 PERFORM FAIL. IC1034.2 +045200 MOVE ALPHA-FIELD TO COMPUTED-A. IC1034.2 +045300 MOVE "YES" TO CORRECT-A. IC1034.2 +045400 MOVE "ALPHABETIC PARAMETER" TO RE-MARK. IC1034.2 +045500 CALL-WRITE-06-03. IC1034.2 +045600 ADD 1 TO REC-CT. IC1034.2 +045700 PERFORM PRINT-DETAIL. IC1034.2 +045800 CALL-TEST-06-04. IC1034.2 +045900 IF ELEM-77 EQUAL TO 0.7654 IC1034.2 +046000 PERFORM PASS IC1034.2 +046100 GO TO CALL-WRITE-06-04. IC1034.2 +046200 CALL-FAIL-06-04. IC1034.2 +046300 PERFORM FAIL. IC1034.2 +046400 MOVE ELEM-77 TO COMPUTED-4V14. IC1034.2 +046500 MOVE 0.7654 TO CORRECT-4V14. IC1034.2 +046600 MOVE "COMPUTATIONAL PARAMETER" TO RE-MARK. IC1034.2 +046700 CALL-WRITE-06-04. IC1034.2 +046800 ADD 1 TO REC-CT. IC1034.2 +046900 PERFORM PRINT-DETAIL. IC1034.2 +047000 CALL-TEST-06-05. IC1034.2 +047100 IF NUM-ITEM EQUAL TO 25 IC1034.2 +047200 PERFORM PASS IC1034.2 +047300 GO TO CALL-WRITE-06-05. IC1034.2 +047400 CALL-FAIL-06-05. IC1034.2 +047500 PERFORM FAIL. IC1034.2 +047600 MOVE NUM-ITEM TO COMPUTED-18V0. IC1034.2 +047700 MOVE 25 TO CORRECT-18V0. IC1034.2 +047800 MOVE "SIGNED NUMERIC PARAMETER" TO RE-MARK. IC1034.2 +047900 CALL-WRITE-06-05. IC1034.2 +048000 ADD 1 TO REC-CT. IC1034.2 +048100 PERFORM PRINT-DETAIL. IC1034.2 +048200 CALL-TEST-06-06. IC1034.2 +048300 IF ALPHA-EDITED EQUAL TO "AB C0D" IC1034.2 +048400 PERFORM PASS IC1034.2 +048500 GO TO CALL-WRITE-06-06. IC1034.2 +048600 CALL-FAIL-06-06. IC1034.2 +048700 PERFORM FAIL. IC1034.2 +048800 MOVE ALPHA-EDITED TO COMPUTED-A. IC1034.2 +048900 MOVE "AB C0D" TO CORRECT-A. IC1034.2 +049000 MOVE "ALPHANUMERIC EDITED" TO RE-MARK. IC1034.2 +049100 CALL-WRITE-06-06. IC1034.2 +049200 ADD 1 TO REC-CT. IC1034.2 +049300 PERFORM PRINT-DETAIL. IC1034.2 +049400 GO TO CCVS-EXIT. IC1034.2 +049500 CCVS-EXIT SECTION. IC1034.2 +049600 CCVS-999999. IC1034.2 +049700 GO TO CLOSE-FILES. IC1034.2 diff --git a/tests/cobol85/IC/IC106A.CBL b/tests/cobol85/IC/IC106A.CBL new file mode 100755 index 00000000..e82cd5b5 --- /dev/null +++ b/tests/cobol85/IC/IC106A.CBL @@ -0,0 +1,530 @@ +000100 IDENTIFICATION DIVISION. IC1064.2 +000200 PROGRAM-ID. IC1064.2 +000300 IC106A. IC1064.2 +000400**************************************************************** IC1064.2 +000500* * IC1064.2 +000600* VALIDATION FOR:- * IC1064.2 +000700* * IC1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1064.2 +000900* * IC1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1064.2 +001100* * IC1064.2 +001200**************************************************************** IC1064.2 +001300* * IC1064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1064.2 +001500* * IC1064.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1064.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1064.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1064.2 +001900* * IC1064.2 +002000**************************************************************** IC1064.2 +002100* THIS PROGRAM CALLS A SUBPROGRAM WITH TWO TABLES IC1064.2 +002200* AND AN INDEX DATA ITEM REFERENCED IN THE USING PHRASE IC1064.2 +002300* OF THE CALL STATEMENT. BOTH OF THE TABLES CONTAIN AN IC1064.2 +002400* INDEXED BY CLAUSE. IC1064.2 +002500* THE TESTS IN THIS PROGRAM VERIFY THAT IC1064.2 +002600* (1) THE INDICES IN THE MAIN PROGRAM AND THE IC1064.2 +002700* SUBPROGRAM ARE SEPARATE, IC1064.2 +002800* (2) AN INDEX DATA ITEM SET IN A MAIN PROGRAM IC1064.2 +002900* CAN BE USED TO SET AN INDEX IN A SUBPROGRAM, IC1064.2 +003000* (3) TABLES CAN BE SHARED BETWEEN A MAIN PROGRAM IC1064.2 +003100* AND A SUBPROGRAM. IC1064.2 +003200* THE SUBPROGRAM IC107 IS CALLED BY THIS PROGRAM. IC1064.2 +003300 ENVIRONMENT DIVISION. IC1064.2 +003400 CONFIGURATION SECTION. IC1064.2 +003500 SOURCE-COMPUTER. IC1064.2 +003600 Linux. IC1064.2 +003700 OBJECT-COMPUTER. IC1064.2 +003800 Linux. IC1064.2 +003900 INPUT-OUTPUT SECTION. IC1064.2 +004000 FILE-CONTROL. IC1064.2 +004100 SELECT PRINT-FILE ASSIGN TO IC1064.2 +004200 "report.log". IC1064.2 +004300 DATA DIVISION. IC1064.2 +004400 FILE SECTION. IC1064.2 +004500 FD PRINT-FILE. IC1064.2 +004600 01 PRINT-REC PICTURE X(120). IC1064.2 +004700 01 DUMMY-RECORD PICTURE X(120). IC1064.2 +004800 WORKING-STORAGE SECTION. IC1064.2 +004900 77 IDN1 USAGE IS INDEX. IC1064.2 +005000 77 INDEX-VALUE PIC 999. IC1064.2 +005100 01 TABLE-1. IC1064.2 +005200 02 DN1 PICTURE X IC1064.2 +005300 OCCURS 10 TIMES IC1064.2 +005400 INDEXED BY IN1. IC1064.2 +005500 01 TABLE-2. IC1064.2 +005600 02 DN2 PICTURE X IC1064.2 +005700 OCCURS 10 TIMES IC1064.2 +005800 INDEXED BY IN2. IC1064.2 +005900 01 TEST-RESULTS. IC1064.2 +006000 02 FILLER PIC X VALUE SPACE. IC1064.2 +006100 02 FEATURE PIC X(20) VALUE SPACE. IC1064.2 +006200 02 FILLER PIC X VALUE SPACE. IC1064.2 +006300 02 P-OR-F PIC X(5) VALUE SPACE. IC1064.2 +006400 02 FILLER PIC X VALUE SPACE. IC1064.2 +006500 02 PAR-NAME. IC1064.2 +006600 03 FILLER PIC X(19) VALUE SPACE. IC1064.2 +006700 03 PARDOT-X PIC X VALUE SPACE. IC1064.2 +006800 03 DOTVALUE PIC 99 VALUE ZERO. IC1064.2 +006900 02 FILLER PIC X(8) VALUE SPACE. IC1064.2 +007000 02 RE-MARK PIC X(61). IC1064.2 +007100 01 TEST-COMPUTED. IC1064.2 +007200 02 FILLER PIC X(30) VALUE SPACE. IC1064.2 +007300 02 FILLER PIC X(17) VALUE IC1064.2 +007400 " COMPUTED=". IC1064.2 +007500 02 COMPUTED-X. IC1064.2 +007600 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1064.2 +007700 03 COMPUTED-N REDEFINES COMPUTED-A IC1064.2 +007800 PIC -9(9).9(9). IC1064.2 +007900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1064.2 +008000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1064.2 +008100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1064.2 +008200 03 CM-18V0 REDEFINES COMPUTED-A. IC1064.2 +008300 04 COMPUTED-18V0 PIC -9(18). IC1064.2 +008400 04 FILLER PIC X. IC1064.2 +008500 03 FILLER PIC X(50) VALUE SPACE. IC1064.2 +008600 01 TEST-CORRECT. IC1064.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IC1064.2 +008800 02 FILLER PIC X(17) VALUE " CORRECT =". IC1064.2 +008900 02 CORRECT-X. IC1064.2 +009000 03 CORRECT-A PIC X(20) VALUE SPACE. IC1064.2 +009100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1064.2 +009200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1064.2 +009300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1064.2 +009400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1064.2 +009500 03 CR-18V0 REDEFINES CORRECT-A. IC1064.2 +009600 04 CORRECT-18V0 PIC -9(18). IC1064.2 +009700 04 FILLER PIC X. IC1064.2 +009800 03 FILLER PIC X(2) VALUE SPACE. IC1064.2 +009900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1064.2 +010000 01 CCVS-C-1. IC1064.2 +010100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1064.2 +010200- "SS PARAGRAPH-NAME IC1064.2 +010300- " REMARKS". IC1064.2 +010400 02 FILLER PIC X(20) VALUE SPACE. IC1064.2 +010500 01 CCVS-C-2. IC1064.2 +010600 02 FILLER PIC X VALUE SPACE. IC1064.2 +010700 02 FILLER PIC X(6) VALUE "TESTED". IC1064.2 +010800 02 FILLER PIC X(15) VALUE SPACE. IC1064.2 +010900 02 FILLER PIC X(4) VALUE "FAIL". IC1064.2 +011000 02 FILLER PIC X(94) VALUE SPACE. IC1064.2 +011100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1064.2 +011200 01 REC-CT PIC 99 VALUE ZERO. IC1064.2 +011300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1064.2 +011400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1064.2 +011500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1064.2 +011600 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1064.2 +011700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1064.2 +011800 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1064.2 +011900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1064.2 +012000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1064.2 +012100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1064.2 +012200 01 CCVS-H-1. IC1064.2 +012300 02 FILLER PIC X(39) VALUE SPACES. IC1064.2 +012400 02 FILLER PIC X(42) VALUE IC1064.2 +012500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1064.2 +012600 02 FILLER PIC X(39) VALUE SPACES. IC1064.2 +012700 01 CCVS-H-2A. IC1064.2 +012800 02 FILLER PIC X(40) VALUE SPACE. IC1064.2 +012900 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1064.2 +013000 02 FILLER PIC XXXX VALUE IC1064.2 +013100 "4.2 ". IC1064.2 +013200 02 FILLER PIC X(28) VALUE IC1064.2 +013300 " COPY - NOT FOR DISTRIBUTION". IC1064.2 +013400 02 FILLER PIC X(41) VALUE SPACE. IC1064.2 +013500 IC1064.2 +013600 01 CCVS-H-2B. IC1064.2 +013700 02 FILLER PIC X(15) VALUE IC1064.2 +013800 "TEST RESULT OF ". IC1064.2 +013900 02 TEST-ID PIC X(9). IC1064.2 +014000 02 FILLER PIC X(4) VALUE IC1064.2 +014100 " IN ". IC1064.2 +014200 02 FILLER PIC X(12) VALUE IC1064.2 +014300 " HIGH ". IC1064.2 +014400 02 FILLER PIC X(22) VALUE IC1064.2 +014500 " LEVEL VALIDATION FOR ". IC1064.2 +014600 02 FILLER PIC X(58) VALUE IC1064.2 +014700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1064.2 +014800 01 CCVS-H-3. IC1064.2 +014900 02 FILLER PIC X(34) VALUE IC1064.2 +015000 " FOR OFFICIAL USE ONLY ". IC1064.2 +015100 02 FILLER PIC X(58) VALUE IC1064.2 +015200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1064.2 +015300 02 FILLER PIC X(28) VALUE IC1064.2 +015400 " COPYRIGHT 1985 ". IC1064.2 +015500 01 CCVS-E-1. IC1064.2 +015600 02 FILLER PIC X(52) VALUE SPACE. IC1064.2 +015700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1064.2 +015800 02 ID-AGAIN PIC X(9). IC1064.2 +015900 02 FILLER PIC X(45) VALUE SPACES. IC1064.2 +016000 01 CCVS-E-2. IC1064.2 +016100 02 FILLER PIC X(31) VALUE SPACE. IC1064.2 +016200 02 FILLER PIC X(21) VALUE SPACE. IC1064.2 +016300 02 CCVS-E-2-2. IC1064.2 +016400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1064.2 +016500 03 FILLER PIC X VALUE SPACE. IC1064.2 +016600 03 ENDER-DESC PIC X(44) VALUE IC1064.2 +016700 "ERRORS ENCOUNTERED". IC1064.2 +016800 01 CCVS-E-3. IC1064.2 +016900 02 FILLER PIC X(22) VALUE IC1064.2 +017000 " FOR OFFICIAL USE ONLY". IC1064.2 +017100 02 FILLER PIC X(12) VALUE SPACE. IC1064.2 +017200 02 FILLER PIC X(58) VALUE IC1064.2 +017300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1064.2 +017400 02 FILLER PIC X(13) VALUE SPACE. IC1064.2 +017500 02 FILLER PIC X(15) VALUE IC1064.2 +017600 " COPYRIGHT 1985". IC1064.2 +017700 01 CCVS-E-4. IC1064.2 +017800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1064.2 +017900 02 FILLER PIC X(4) VALUE " OF ". IC1064.2 +018000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1064.2 +018100 02 FILLER PIC X(40) VALUE IC1064.2 +018200 " TESTS WERE EXECUTED SUCCESSFULLY". IC1064.2 +018300 01 XXINFO. IC1064.2 +018400 02 FILLER PIC X(19) VALUE IC1064.2 +018500 "*** INFORMATION ***". IC1064.2 +018600 02 INFO-TEXT. IC1064.2 +018700 04 FILLER PIC X(8) VALUE SPACE. IC1064.2 +018800 04 XXCOMPUTED PIC X(20). IC1064.2 +018900 04 FILLER PIC X(5) VALUE SPACE. IC1064.2 +019000 04 XXCORRECT PIC X(20). IC1064.2 +019100 02 INF-ANSI-REFERENCE PIC X(48). IC1064.2 +019200 01 HYPHEN-LINE. IC1064.2 +019300 02 FILLER PIC IS X VALUE IS SPACE. IC1064.2 +019400 02 FILLER PIC IS X(65) VALUE IS "************************IC1064.2 +019500- "*****************************************". IC1064.2 +019600 02 FILLER PIC IS X(54) VALUE IS "************************IC1064.2 +019700- "******************************". IC1064.2 +019800 01 CCVS-PGM-ID PIC X(9) VALUE IC1064.2 +019900 "IC106A". IC1064.2 +020000 PROCEDURE DIVISION. IC1064.2 +020100 CCVS1 SECTION. IC1064.2 +020200 OPEN-FILES. IC1064.2 +020300 OPEN OUTPUT PRINT-FILE. IC1064.2 +020400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1064.2 +020500 MOVE SPACE TO TEST-RESULTS. IC1064.2 +020600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1064.2 +020700 GO TO CCVS1-EXIT. IC1064.2 +020800 CLOSE-FILES. IC1064.2 +020900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1064.2 +021000 TERMINATE-CCVS. IC1064.2 +021100*S EXIT PROGRAM. IC1064.2 +021200*SERMINATE-CALL. IC1064.2 +021300 STOP RUN. IC1064.2 +021400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1064.2 +021500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1064.2 +021600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1064.2 +021700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1064.2 +021800 MOVE "****TEST DELETED****" TO RE-MARK. IC1064.2 +021900 PRINT-DETAIL. IC1064.2 +022000 IF REC-CT NOT EQUAL TO ZERO IC1064.2 +022100 MOVE "." TO PARDOT-X IC1064.2 +022200 MOVE REC-CT TO DOTVALUE. IC1064.2 +022300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1064.2 +022400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1064.2 +022500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1064.2 +022600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1064.2 +022700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1064.2 +022800 MOVE SPACE TO CORRECT-X. IC1064.2 +022900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1064.2 +023000 MOVE SPACE TO RE-MARK. IC1064.2 +023100 HEAD-ROUTINE. IC1064.2 +023200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +023300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +023400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1064.2 +023500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1064.2 +023600 COLUMN-NAMES-ROUTINE. IC1064.2 +023700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +023800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +023900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +024000 END-ROUTINE. IC1064.2 +024100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1064.2 +024200 END-RTN-EXIT. IC1064.2 +024300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +024400 END-ROUTINE-1. IC1064.2 +024500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1064.2 +024600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1064.2 +024700 ADD PASS-COUNTER TO ERROR-HOLD. IC1064.2 +024800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1064.2 +024900 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1064.2 +025000 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1064.2 +025100 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1064.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1064.2 +025300 END-ROUTINE-12. IC1064.2 +025400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1064.2 +025500 IF ERROR-COUNTER IS EQUAL TO ZERO IC1064.2 +025600 MOVE "NO " TO ERROR-TOTAL IC1064.2 +025700 ELSE IC1064.2 +025800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1064.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1064.2 +026000 PERFORM WRITE-LINE. IC1064.2 +026100 END-ROUTINE-13. IC1064.2 +026200 IF DELETE-COUNTER IS EQUAL TO ZERO IC1064.2 +026300 MOVE "NO " TO ERROR-TOTAL ELSE IC1064.2 +026400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1064.2 +026500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1064.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +026700 IF INSPECT-COUNTER EQUAL TO ZERO IC1064.2 +026800 MOVE "NO " TO ERROR-TOTAL IC1064.2 +026900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1064.2 +027000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1064.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +027200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1064.2 +027300 WRITE-LINE. IC1064.2 +027400 ADD 1 TO RECORD-COUNT. IC1064.2 +027500 IF RECORD-COUNT GREATER 50 IC1064.2 +027600 MOVE DUMMY-RECORD TO DUMMY-HOLD IC1064.2 +027700 MOVE SPACE TO DUMMY-RECORD IC1064.2 +027800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1064.2 +027900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1064.2 +028000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1064.2 +028100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1064.2 +028200 MOVE DUMMY-HOLD TO DUMMY-RECORD IC1064.2 +028300 MOVE ZERO TO RECORD-COUNT. IC1064.2 +028400 PERFORM WRT-LN. IC1064.2 +028500 WRT-LN. IC1064.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1064.2 +028700 MOVE SPACE TO DUMMY-RECORD. IC1064.2 +028800 BLANK-LINE-PRINT. IC1064.2 +028900 PERFORM WRT-LN. IC1064.2 +029000 FAIL-ROUTINE. IC1064.2 +029100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1064.2 +029200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1064.2 +029300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1064.2 +029400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1064.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IC1064.2 +029700 GO TO FAIL-ROUTINE-EX. IC1064.2 +029800 FAIL-ROUTINE-WRITE. IC1064.2 +029900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1064.2 +030000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1064.2 +030100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1064.2 +030200 MOVE SPACES TO COR-ANSI-REFERENCE. IC1064.2 +030300 FAIL-ROUTINE-EX. EXIT. IC1064.2 +030400 BAIL-OUT. IC1064.2 +030500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1064.2 +030600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1064.2 +030700 BAIL-OUT-WRITE. IC1064.2 +030800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1064.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1064.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1064.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. IC1064.2 +031200 BAIL-OUT-EX. EXIT. IC1064.2 +031300 CCVS1-EXIT. IC1064.2 +031400 EXIT. IC1064.2 +031500 SEC-IC106-0001 SECTION. IC1064.2 +031600 LINK-TEST-INITIALIZE. IC1064.2 +031700 MOVE "ABCDEFGHIJ" TO TABLE-1. IC1064.2 +031800 MOVE SPACE TO TABLE-2. IC1064.2 +031900 SET IN1 TO 6. IC1064.2 +032000 SET IDN1 TO IN1. IC1064.2 +032100 CALL "IC107A" USING IDN1 TABLE-1 TABLE-2. IC1064.2 +032200 LINK-TEST-01. IC1064.2 +032300 MOVE "SEPARATE INDEXES" TO FEATURE. IC1064.2 +032400 MOVE "LINK-TEST-01" TO PAR-NAME. IC1064.2 +032500* THIS TEST VERIFIES THAT IN1 HAS NOT BEEN AFFECTED IC1064.2 +032600* BY THE USE OF AN INDEX FOR TABLE-1 IN THE SUBPROGRAM. IC1064.2 +032700 LINK-TEST-01-01. IC1064.2 +032800 MOVE 1 TO REC-CT. IC1064.2 +032900 IF DN1 (IN1) EQUAL TO "F" IC1064.2 +033000 PERFORM PASS IC1064.2 +033100 GO TO LINK-WRITE-01-01. IC1064.2 +033200 LINK-FAIL-01-01. IC1064.2 +033300 PERFORM FAIL. IC1064.2 +033400 MOVE DN1 (IN1) TO COMPUTED-A. IC1064.2 +033500 MOVE "F" TO CORRECT-A. IC1064.2 +033600 MOVE "TABLE INDEX DESTROYED" TO RE-MARK. IC1064.2 +033700 LINK-WRITE-01-01. IC1064.2 +033800 PERFORM PRINT-DETAIL. IC1064.2 +033900 LINK-TEST-01-02. IC1064.2 +034000 ADD 1 TO REC-CT. IC1064.2 +034100 IF IN1 EQUAL TO 6 IC1064.2 +034200 PERFORM PASS IC1064.2 +034300 GO TO LINK-WRITE-01-02. IC1064.2 +034400 LINK-FAIL-01-02. IC1064.2 +034500 PERFORM FAIL. IC1064.2 +034600 MOVE 6 TO CORRECT-18V0. IC1064.2 +034700 SET INDEX-VALUE TO IN1. IC1064.2 +034800 MOVE INDEX-VALUE TO COMPUTED-18V0. IC1064.2 +034900 MOVE "TABLE INDEX DESTROYED" TO RE-MARK. IC1064.2 +035000 LINK-WRITE-01-02. IC1064.2 +035100 PERFORM PRINT-DETAIL. IC1064.2 +035200 LINK-TEST-02. IC1064.2 +035300 MOVE "INDEX DATA ITEM" TO FEATURE. IC1064.2 +035400 MOVE "LINK-TEST-02" TO PAR-NAME. IC1064.2 +035500* THIS TEST VERIFIES THAT THE INDEX DATA ITEM WAS IC1064.2 +035600* USED IN THE SUBPROGRAM TO SET AN INDEX AND AN INDEX IC1064.2 +035700* DATA ITEM. IC1064.2 +035800 LINK-TEST-02-01. IC1064.2 +035900 MOVE 1 TO REC-CT. IC1064.2 +036000 IF DN2 (7) IS EQUAL TO "G" IC1064.2 +036100 PERFORM PASS IC1064.2 +036200 GO TO LINK-WRITE-02-01. IC1064.2 +036300 LINK-FAIL-02-01. IC1064.2 +036400 PERFORM FAIL. IC1064.2 +036500 MOVE DN2 (7) TO COMPUTED-A. IC1064.2 +036600 MOVE "G" TO CORRECT-A. IC1064.2 +036700 MOVE "INDEX DATA ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +036800 LINK-WRITE-02-01. IC1064.2 +036900 PERFORM PRINT-DETAIL. IC1064.2 +037000 LINK-TEST-02-02. IC1064.2 +037100 ADD 1 TO REC-CT. IC1064.2 +037200 IF DN2 (6) EQUAL TO "F" IC1064.2 +037300 PERFORM PASS IC1064.2 +037400 GO TO LINK-WRITE-02-02. IC1064.2 +037500 LINK-FAIL-02-02. IC1064.2 +037600 PERFORM FAIL. IC1064.2 +037700 MOVE DN2 (6) TO COMPUTED-A. IC1064.2 +037800 MOVE "F" TO CORRECT-A. IC1064.2 +037900 MOVE "INDEX DATA ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +038000 LINK-WRITE-02-02. IC1064.2 +038100 PERFORM PRINT-DETAIL. IC1064.2 +038200 LINK-TEST-03. IC1064.2 +038300 MOVE "SUBPROGRAM INDEX" TO FEATURE. IC1064.2 +038400 MOVE "LINK-TEST-03" TO PAR-NAME. IC1064.2 +038500* THIS TEST VERIFIES THAT A SUBPROGRAM INDEX FOR IC1064.2 +038600* A TABLE DEFINED IN THE LINKAGE SECTION OF IC107 CAN BE IC1064.2 +038700* USED TO REFERENCE THE TABLE. IC1064.2 +038800 LINK-TEST-03-01. IC1064.2 +038900 MOVE 1 TO REC-CT. IC1064.2 +039000 IF DN2 (1) EQUAL TO "A" IC1064.2 +039100 PERFORM PASS IC1064.2 +039200 GO TO LINK-WRITE-03-01. IC1064.2 +039300 LINK-FAIL-03-01. IC1064.2 +039400 PERFORM FAIL. IC1064.2 +039500 MOVE DN2 (1) TO COMPUTED-A. IC1064.2 +039600 MOVE "A" TO CORRECT-A. IC1064.2 +039700 MOVE "INDEX IN LINKAGE SECTION" TO RE-MARK. IC1064.2 +039800 LINK-WRITE-03-01. IC1064.2 +039900 PERFORM PRINT-DETAIL. IC1064.2 +040000 LINK-TEST-03-02. IC1064.2 +040100 ADD 1 TO REC-CT. IC1064.2 +040200 IF DN2 (2) EQUAL TO "B" IC1064.2 +040300 PERFORM PASS IC1064.2 +040400 GO TO LINK-WRITE-03-02. IC1064.2 +040500 LINK-FAIL-03-02. IC1064.2 +040600 PERFORM FAIL. IC1064.2 +040700 MOVE DN2 (2) TO COMPUTED-A. IC1064.2 +040800 MOVE "B" TO CORRECT-A. IC1064.2 +040900 MOVE "INDEX IN LINKAGE SECTION" TO RE-MARK. IC1064.2 +041000 LINK-WRITE-03-02. IC1064.2 +041100 PERFORM PRINT-DETAIL. IC1064.2 +041200 LINK-TEST-04. IC1064.2 +041300 MOVE "INDEX DATA ITEM" TO FEATURE. IC1064.2 +041400 MOVE "LINK-TEST-04" TO PAR-NAME. IC1064.2 +041500* THIS TEST VERIFIES THAT AN INDEX DATA ITEM IC1064.2 +041600* SET IN THE SUBPROGRAM CAN BE USED IN THE MAIN PROGRAM. IC1064.2 +041700 LINK-TEST-04-01. IC1064.2 +041800 MOVE 1 TO REC-CT. IC1064.2 +041900 SET IN1 TO IDN1. IC1064.2 +042000 IF IN1 EQUAL TO 3 IC1064.2 +042100 PERFORM PASS IC1064.2 +042200 GO TO LINK-WRITE-04-01. IC1064.2 +042300 LINK-FAIL-04-01. IC1064.2 +042400 MOVE 3 TO CORRECT-18V0. IC1064.2 +042500 SET INDEX-VALUE TO IN1. IC1064.2 +042600 MOVE INDEX-VALUE TO COMPUTED-18V0. IC1064.2 +042700 PERFORM FAIL. IC1064.2 +042800 MOVE "INDEX DATA ITEM SET IN SUBPROG" TO RE-MARK. IC1064.2 +042900 LINK-WRITE-04-01. IC1064.2 +043000 PERFORM PRINT-DETAIL. IC1064.2 +043100 LINK-TEST-04-02. IC1064.2 +043200 ADD 1 TO REC-CT. IC1064.2 +043300 IF DN1 (IN1) EQUAL TO "C" IC1064.2 +043400 PERFORM PASS IC1064.2 +043500 GO TO LINK-WRITE-04-02. IC1064.2 +043600 LINK-FAIL-04-02. IC1064.2 +043700 MOVE "C" TO CORRECT-A. IC1064.2 +043800 MOVE DN1 (IN1) TO COMPUTED-A. IC1064.2 +043900 MOVE "INDEX DATA ITEM SET IN SUBPROG" TO RE-MARK. IC1064.2 +044000 PERFORM FAIL. IC1064.2 +044100 LINK-WRITE-04-02. IC1064.2 +044200 PERFORM PRINT-DETAIL. IC1064.2 +044300 LINK-TEST-04-03. IC1064.2 +044400 ADD 1 TO REC-CT. IC1064.2 +044500 IF DN2 (3) EQUAL TO "C" IC1064.2 +044600 PERFORM PASS IC1064.2 +044700 GO TO LINK-WRITE-04-03. IC1064.2 +044800 LINK-FAIL-04-03. IC1064.2 +044900 PERFORM FAIL. IC1064.2 +045000 MOVE "C" TO CORRECT-A. IC1064.2 +045100 MOVE DN2 (3) TO COMPUTED-A. IC1064.2 +045200 MOVE "INDEX DATA ITEM SET IN SUBPROG" TO RE-MARK. IC1064.2 +045300 LINK-WRITE-04-03. IC1064.2 +045400 PERFORM PRINT-DETAIL. IC1064.2 +045500 LINK-TEST-05. IC1064.2 +045600 MOVE "TABLE REFERENCES" TO FEATURE. IC1064.2 +045700 MOVE "LINK-TEST-05" TO PAR-NAME. IC1064.2 +045800* THIS TEST VERIFIES THAT DATA WAS MOVED FROM THE IC1064.2 +045900* FIRST TABLE IN USING PHRASE TO SECOND TABLE IN USING PHRASE. IC1064.2 +046000* DATA WAS MOVED IN SUBPROGRAM IC107. IC1064.2 +046100 LINK-TEST-05-01. IC1064.2 +046200 MOVE 1 TO REC-CT. IC1064.2 +046300 IF DN2 (4) EQUAL TO "D" IC1064.2 +046400 PERFORM PASS IC1064.2 +046500 GO TO LINK-WRITE-05-01. IC1064.2 +046600 LINK-FAIL-05-01. IC1064.2 +046700 PERFORM FAIL. IC1064.2 +046800 MOVE DN2 (4) TO COMPUTED-A. IC1064.2 +046900 MOVE "D" TO CORRECT-A. IC1064.2 +047000 MOVE "TABLES DEFINED IN LINKAGE SEC" TO RE-MARK. IC1064.2 +047100 LINK-WRITE-05-01. IC1064.2 +047200 PERFORM PRINT-DETAIL. IC1064.2 +047300 LINK-TEST-05-02. IC1064.2 +047400 ADD 1 TO REC-CT. IC1064.2 +047500 IF DN2 (5) EQUAL TO "E" IC1064.2 +047600 PERFORM PASS IC1064.2 +047700 GO TO LINK-WRITE-05-02. IC1064.2 +047800 LINK-FAIL-05-02. IC1064.2 +047900 PERFORM FAIL. IC1064.2 +048000 MOVE DN2 (5) TO COMPUTED-A. IC1064.2 +048100 MOVE "E" TO CORRECT-A. IC1064.2 +048200 MOVE "TABLES DEFINED IN LINKAGE SEC" TO RE-MARK. IC1064.2 +048300 LINK-WRITE-05-02. IC1064.2 +048400 PERFORM PRINT-DETAIL. IC1064.2 +048500 LINK-TEST-06. IC1064.2 +048600 MOVE "REDEFINED ITEM" TO FEATURE. IC1064.2 +048700 MOVE "LINK-TEST-06" TO PAR-NAME. IC1064.2 +048800* THIS TEST VERIFIES THAT DATA WAS MOVED TO IC1064.2 +048900* A REDEFINED ITEM IN THE LINKAGE SECTION OF IC107. IC1064.2 +049000 LINK-TEST-06-01. IC1064.2 +049100 MOVE 1 TO REC-CT. IC1064.2 +049200 IF DN2 (8) EQUAL TO "X" IC1064.2 +049300 PERFORM PASS IC1064.2 +049400 GO TO LINK-WRITE-06-01. IC1064.2 +049500 LINK-FAIL-06-01. IC1064.2 +049600 PERFORM FAIL. IC1064.2 +049700 MOVE DN2 (8) TO COMPUTED-A. IC1064.2 +049800 MOVE "X" TO CORRECT-A. IC1064.2 +049900 MOVE "REDEFINED ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +050000 LINK-WRITE-06-01. IC1064.2 +050100 PERFORM PRINT-DETAIL. IC1064.2 +050200 LINK-TEST-06-02. IC1064.2 +050300 ADD 1 TO REC-CT. IC1064.2 +050400 IF DN2 (9) EQUAL TO "Y" IC1064.2 +050500 PERFORM PASS IC1064.2 +050600 GO TO LINK-WRITE-06-02. IC1064.2 +050700 LINK-FAIL-06-02. IC1064.2 +050800 PERFORM FAIL. IC1064.2 +050900 MOVE DN2 (9) TO COMPUTED-A. IC1064.2 +051000 MOVE "Y" TO CORRECT-A. IC1064.2 +051100 MOVE "REDEFINED ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +051200 LINK-WRITE-06-02. IC1064.2 +051300 PERFORM PRINT-DETAIL. IC1064.2 +051400 LINK-TEST-06-03. IC1064.2 +051500 ADD 1 TO REC-CT. IC1064.2 +051600 IF DN2 (10) EQUAL TO "Z" IC1064.2 +051700 PERFORM PASS IC1064.2 +051800 GO TO LINK-WRITE-06-03. IC1064.2 +051900 LINK-FAIL-06-03. IC1064.2 +052000 PERFORM FAIL. IC1064.2 +052100 MOVE DN2 (10) TO COMPUTED-A. IC1064.2 +052200 MOVE "Z" TO CORRECT-A. IC1064.2 +052300 MOVE "REDEFINED ITEM IN LINKAGE SEC" TO RE-MARK. IC1064.2 +052400 LINK-WRITE-06-03. IC1064.2 +052500 PERFORM PRINT-DETAIL. IC1064.2 +052600 LINK-END-ROUTINE. IC1064.2 +052700 GO TO CCVS-EXIT. IC1064.2 +052800 CCVS-EXIT SECTION. IC1064.2 +052900 CCVS-999999. IC1064.2 +053000 GO TO CLOSE-FILES. IC1064.2 diff --git a/tests/cobol85/IC/IC108A.CBL b/tests/cobol85/IC/IC108A.CBL new file mode 100755 index 00000000..1c23bc18 --- /dev/null +++ b/tests/cobol85/IC/IC108A.CBL @@ -0,0 +1,444 @@ +000100 IDENTIFICATION DIVISION. IC1084.2 +000200 PROGRAM-ID. IC1084.2 +000300 IC108A. IC1084.2 +000400**************************************************************** IC1084.2 +000500* * IC1084.2 +000600* VALIDATION FOR:- * IC1084.2 +000700* * IC1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1084.2 +000900* * IC1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1084.2 +001100* * IC1084.2 +001200**************************************************************** IC1084.2 +001300* * IC1084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1084.2 +001500* * IC1084.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1084.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1084.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1084.2 +001900* * IC1084.2 +002000**************************************************************** IC1084.2 +002100* THE PROGRAM IC108 IS THE MAIN PROGRAM WHICH STARTS IC1084.2 +002200* A SEQUENCE OF CALLS TO THE SUBPROGRAMS IC109A,IC110A AND IC1084.2 +002300* IC111A. PARAMETERS ARE SET IN EACH OF THESE SUBPROGRAMS IC1084.2 +002400* AND CHECKED WHEN CONTROL IS RETURNED TO THE MAIN PROGRAM. IC1084.2 +002500 ENVIRONMENT DIVISION. IC1084.2 +002600 CONFIGURATION SECTION. IC1084.2 +002700 SOURCE-COMPUTER. IC1084.2 +002800 Linux. IC1084.2 +002900 OBJECT-COMPUTER. IC1084.2 +003000 Linux. IC1084.2 +003100 INPUT-OUTPUT SECTION. IC1084.2 +003200 FILE-CONTROL. IC1084.2 +003300 SELECT PRINT-FILE ASSIGN TO IC1084.2 +003400 "report.log". IC1084.2 +003500 DATA DIVISION. IC1084.2 +003600 FILE SECTION. IC1084.2 +003700 FD PRINT-FILE. IC1084.2 +003800 01 PRINT-REC PICTURE X(120). IC1084.2 +003900 01 DUMMY-RECORD PICTURE X(120). IC1084.2 +004000 WORKING-STORAGE SECTION. IC1084.2 +004100 01 GRP-01. IC1084.2 +004200 02 SUB-CALLED. IC1084.2 +004300 03 DN1 PICTURE X(6). IC1084.2 +004400 03 DN2 PICTURE X(6). IC1084.2 +004500 03 DN3 PICTURE X(6). IC1084.2 +004600 02 TIMES-CALLED. IC1084.2 +004700 03 DN4 PICTURE S999 VALUE ZERO. IC1084.2 +004800 03 DN5 PICTURE S999 VALUE ZERO. IC1084.2 +004900 03 DN6 PICTURE S999 VALUE ZERO. IC1084.2 +005000 02 SPECIAL-FLAGS. IC1084.2 +005100 03 DN7 PICTURE X. IC1084.2 +005200 03 DN8 PICTURE X. IC1084.2 +005300 03 DN9 PICTURE X. IC1084.2 +005400 01 TEST-RESULTS. IC1084.2 +005500 02 FILLER PIC X VALUE SPACE. IC1084.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IC1084.2 +005700 02 FILLER PIC X VALUE SPACE. IC1084.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IC1084.2 +005900 02 FILLER PIC X VALUE SPACE. IC1084.2 +006000 02 PAR-NAME. IC1084.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IC1084.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IC1084.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IC1084.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IC1084.2 +006500 02 RE-MARK PIC X(61). IC1084.2 +006600 01 TEST-COMPUTED. IC1084.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IC1084.2 +006800 02 FILLER PIC X(17) VALUE IC1084.2 +006900 " COMPUTED=". IC1084.2 +007000 02 COMPUTED-X. IC1084.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1084.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IC1084.2 +007300 PIC -9(9).9(9). IC1084.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1084.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1084.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1084.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IC1084.2 +007800 04 COMPUTED-18V0 PIC -9(18). IC1084.2 +007900 04 FILLER PIC X. IC1084.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IC1084.2 +008100 01 TEST-CORRECT. IC1084.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IC1084.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IC1084.2 +008400 02 CORRECT-X. IC1084.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IC1084.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1084.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1084.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1084.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1084.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IC1084.2 +009100 04 CORRECT-18V0 PIC -9(18). IC1084.2 +009200 04 FILLER PIC X. IC1084.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IC1084.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1084.2 +009500 01 CCVS-C-1. IC1084.2 +009600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1084.2 +009700- "SS PARAGRAPH-NAME IC1084.2 +009800- " REMARKS". IC1084.2 +009900 02 FILLER PIC X(20) VALUE SPACE. IC1084.2 +010000 01 CCVS-C-2. IC1084.2 +010100 02 FILLER PIC X VALUE SPACE. IC1084.2 +010200 02 FILLER PIC X(6) VALUE "TESTED". IC1084.2 +010300 02 FILLER PIC X(15) VALUE SPACE. IC1084.2 +010400 02 FILLER PIC X(4) VALUE "FAIL". IC1084.2 +010500 02 FILLER PIC X(94) VALUE SPACE. IC1084.2 +010600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1084.2 +010700 01 REC-CT PIC 99 VALUE ZERO. IC1084.2 +010800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1084.2 +010900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1084.2 +011000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1084.2 +011100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1084.2 +011200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1084.2 +011300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1084.2 +011400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1084.2 +011500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1084.2 +011600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1084.2 +011700 01 CCVS-H-1. IC1084.2 +011800 02 FILLER PIC X(39) VALUE SPACES. IC1084.2 +011900 02 FILLER PIC X(42) VALUE IC1084.2 +012000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1084.2 +012100 02 FILLER PIC X(39) VALUE SPACES. IC1084.2 +012200 01 CCVS-H-2A. IC1084.2 +012300 02 FILLER PIC X(40) VALUE SPACE. IC1084.2 +012400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1084.2 +012500 02 FILLER PIC XXXX VALUE IC1084.2 +012600 "4.2 ". IC1084.2 +012700 02 FILLER PIC X(28) VALUE IC1084.2 +012800 " COPY - NOT FOR DISTRIBUTION". IC1084.2 +012900 02 FILLER PIC X(41) VALUE SPACE. IC1084.2 +013000 IC1084.2 +013100 01 CCVS-H-2B. IC1084.2 +013200 02 FILLER PIC X(15) VALUE IC1084.2 +013300 "TEST RESULT OF ". IC1084.2 +013400 02 TEST-ID PIC X(9). IC1084.2 +013500 02 FILLER PIC X(4) VALUE IC1084.2 +013600 " IN ". IC1084.2 +013700 02 FILLER PIC X(12) VALUE IC1084.2 +013800 " HIGH ". IC1084.2 +013900 02 FILLER PIC X(22) VALUE IC1084.2 +014000 " LEVEL VALIDATION FOR ". IC1084.2 +014100 02 FILLER PIC X(58) VALUE IC1084.2 +014200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1084.2 +014300 01 CCVS-H-3. IC1084.2 +014400 02 FILLER PIC X(34) VALUE IC1084.2 +014500 " FOR OFFICIAL USE ONLY ". IC1084.2 +014600 02 FILLER PIC X(58) VALUE IC1084.2 +014700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1084.2 +014800 02 FILLER PIC X(28) VALUE IC1084.2 +014900 " COPYRIGHT 1985 ". IC1084.2 +015000 01 CCVS-E-1. IC1084.2 +015100 02 FILLER PIC X(52) VALUE SPACE. IC1084.2 +015200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1084.2 +015300 02 ID-AGAIN PIC X(9). IC1084.2 +015400 02 FILLER PIC X(45) VALUE SPACES. IC1084.2 +015500 01 CCVS-E-2. IC1084.2 +015600 02 FILLER PIC X(31) VALUE SPACE. IC1084.2 +015700 02 FILLER PIC X(21) VALUE SPACE. IC1084.2 +015800 02 CCVS-E-2-2. IC1084.2 +015900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1084.2 +016000 03 FILLER PIC X VALUE SPACE. IC1084.2 +016100 03 ENDER-DESC PIC X(44) VALUE IC1084.2 +016200 "ERRORS ENCOUNTERED". IC1084.2 +016300 01 CCVS-E-3. IC1084.2 +016400 02 FILLER PIC X(22) VALUE IC1084.2 +016500 " FOR OFFICIAL USE ONLY". IC1084.2 +016600 02 FILLER PIC X(12) VALUE SPACE. IC1084.2 +016700 02 FILLER PIC X(58) VALUE IC1084.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1084.2 +016900 02 FILLER PIC X(13) VALUE SPACE. IC1084.2 +017000 02 FILLER PIC X(15) VALUE IC1084.2 +017100 " COPYRIGHT 1985". IC1084.2 +017200 01 CCVS-E-4. IC1084.2 +017300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1084.2 +017400 02 FILLER PIC X(4) VALUE " OF ". IC1084.2 +017500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1084.2 +017600 02 FILLER PIC X(40) VALUE IC1084.2 +017700 " TESTS WERE EXECUTED SUCCESSFULLY". IC1084.2 +017800 01 XXINFO. IC1084.2 +017900 02 FILLER PIC X(19) VALUE IC1084.2 +018000 "*** INFORMATION ***". IC1084.2 +018100 02 INFO-TEXT. IC1084.2 +018200 04 FILLER PIC X(8) VALUE SPACE. IC1084.2 +018300 04 XXCOMPUTED PIC X(20). IC1084.2 +018400 04 FILLER PIC X(5) VALUE SPACE. IC1084.2 +018500 04 XXCORRECT PIC X(20). IC1084.2 +018600 02 INF-ANSI-REFERENCE PIC X(48). IC1084.2 +018700 01 HYPHEN-LINE. IC1084.2 +018800 02 FILLER PIC IS X VALUE IS SPACE. IC1084.2 +018900 02 FILLER PIC IS X(65) VALUE IS "************************IC1084.2 +019000- "*****************************************". IC1084.2 +019100 02 FILLER PIC IS X(54) VALUE IS "************************IC1084.2 +019200- "******************************". IC1084.2 +019300 01 CCVS-PGM-ID PIC X(9) VALUE IC1084.2 +019400 "IC108A". IC1084.2 +019500 PROCEDURE DIVISION. IC1084.2 +019600 CCVS1 SECTION. IC1084.2 +019700 OPEN-FILES. IC1084.2 +019800 OPEN OUTPUT PRINT-FILE. IC1084.2 +019900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1084.2 +020000 MOVE SPACE TO TEST-RESULTS. IC1084.2 +020100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1084.2 +020200 GO TO CCVS1-EXIT. IC1084.2 +020300 CLOSE-FILES. IC1084.2 +020400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1084.2 +020500 TERMINATE-CCVS. IC1084.2 +020600*S EXIT PROGRAM. IC1084.2 +020700*SERMINATE-CALL. IC1084.2 +020800 STOP RUN. IC1084.2 +020900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1084.2 +021000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1084.2 +021100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1084.2 +021200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1084.2 +021300 MOVE "****TEST DELETED****" TO RE-MARK. IC1084.2 +021400 PRINT-DETAIL. IC1084.2 +021500 IF REC-CT NOT EQUAL TO ZERO IC1084.2 +021600 MOVE "." TO PARDOT-X IC1084.2 +021700 MOVE REC-CT TO DOTVALUE. IC1084.2 +021800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1084.2 +021900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1084.2 +022000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1084.2 +022100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1084.2 +022200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1084.2 +022300 MOVE SPACE TO CORRECT-X. IC1084.2 +022400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1084.2 +022500 MOVE SPACE TO RE-MARK. IC1084.2 +022600 HEAD-ROUTINE. IC1084.2 +022700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +022800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +022900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1084.2 +023000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1084.2 +023100 COLUMN-NAMES-ROUTINE. IC1084.2 +023200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +023300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +023500 END-ROUTINE. IC1084.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1084.2 +023700 END-RTN-EXIT. IC1084.2 +023800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +023900 END-ROUTINE-1. IC1084.2 +024000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1084.2 +024100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1084.2 +024200 ADD PASS-COUNTER TO ERROR-HOLD. IC1084.2 +024300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1084.2 +024400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1084.2 +024500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1084.2 +024600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1084.2 +024700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1084.2 +024800 END-ROUTINE-12. IC1084.2 +024900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1084.2 +025000 IF ERROR-COUNTER IS EQUAL TO ZERO IC1084.2 +025100 MOVE "NO " TO ERROR-TOTAL IC1084.2 +025200 ELSE IC1084.2 +025300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1084.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1084.2 +025500 PERFORM WRITE-LINE. IC1084.2 +025600 END-ROUTINE-13. IC1084.2 +025700 IF DELETE-COUNTER IS EQUAL TO ZERO IC1084.2 +025800 MOVE "NO " TO ERROR-TOTAL ELSE IC1084.2 +025900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1084.2 +026000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1084.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +026200 IF INSPECT-COUNTER EQUAL TO ZERO IC1084.2 +026300 MOVE "NO " TO ERROR-TOTAL IC1084.2 +026400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1084.2 +026500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1084.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +026700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1084.2 +026800 WRITE-LINE. IC1084.2 +026900 ADD 1 TO RECORD-COUNT. IC1084.2 +027000 IF RECORD-COUNT GREATER 50 IC1084.2 +027100 MOVE DUMMY-RECORD TO DUMMY-HOLD IC1084.2 +027200 MOVE SPACE TO DUMMY-RECORD IC1084.2 +027300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1084.2 +027400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1084.2 +027500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1084.2 +027600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1084.2 +027700 MOVE DUMMY-HOLD TO DUMMY-RECORD IC1084.2 +027800 MOVE ZERO TO RECORD-COUNT. IC1084.2 +027900 PERFORM WRT-LN. IC1084.2 +028000 WRT-LN. IC1084.2 +028100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1084.2 +028200 MOVE SPACE TO DUMMY-RECORD. IC1084.2 +028300 BLANK-LINE-PRINT. IC1084.2 +028400 PERFORM WRT-LN. IC1084.2 +028500 FAIL-ROUTINE. IC1084.2 +028600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1084.2 +028700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1084.2 +028800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1084.2 +028900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1084.2 +029000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +029100 MOVE SPACES TO INF-ANSI-REFERENCE. IC1084.2 +029200 GO TO FAIL-ROUTINE-EX. IC1084.2 +029300 FAIL-ROUTINE-WRITE. IC1084.2 +029400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1084.2 +029500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1084.2 +029600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1084.2 +029700 MOVE SPACES TO COR-ANSI-REFERENCE. IC1084.2 +029800 FAIL-ROUTINE-EX. EXIT. IC1084.2 +029900 BAIL-OUT. IC1084.2 +030000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1084.2 +030100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1084.2 +030200 BAIL-OUT-WRITE. IC1084.2 +030300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1084.2 +030400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1084.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1084.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. IC1084.2 +030700 BAIL-OUT-EX. EXIT. IC1084.2 +030800 CCVS1-EXIT. IC1084.2 +030900 EXIT. IC1084.2 +031000 SECTION-IC108-0001 SECTION. IC1084.2 +031100 CALL-PARAGRAPH. IC1084.2 +031200* THE CALL IN THIS PARAGRAPH STARTS THE SEQUENCE IC1084.2 +031300* OF CALLS TO THE SUBPROGRAMS. IC1084.2 +031400 MOVE SPACE TO SUB-CALLED. IC1084.2 +031500 MOVE SPACE TO SPECIAL-FLAGS. IC1084.2 +031600 CALL "IC109A" USING GRP-01. IC1084.2 +031700 CALL-TEST-07. IC1084.2 +031800* THIS TEST VERIFIES THAT EACH SUBPROGRAM WAS CALLED IC1084.2 +031900* BY CHECKING THE PARAMETER FIELDS SET IN EACH SUBPROGRAM. IC1084.2 +032000 MOVE "SUBPROGRAM CALLS" TO FEATURE. IC1084.2 +032100 MOVE "CALL-TEST-07" TO PAR-NAME. IC1084.2 +032200 CALL-TEST-07-01. IC1084.2 +032300 MOVE 1 TO REC-CT. IC1084.2 +032400 IF DN1 IS EQUAL TO "IC109A" IC1084.2 +032500 PERFORM PASS IC1084.2 +032600 GO TO CALL-WRITE-07-01. IC1084.2 +032700 CALL-FAIL-07-01. IC1084.2 +032800 PERFORM FAIL. IC1084.2 +032900 MOVE DN1 TO COMPUTED-A. IC1084.2 +033000 MOVE "IC109A" TO CORRECT-A. IC1084.2 +033100 MOVE "SUBPROGRAM IC109A ERROR" TO RE-MARK. IC1084.2 +033200 CALL-WRITE-07-01. IC1084.2 +033300 PERFORM PRINT-DETAIL. IC1084.2 +033400 CALL-TEST-07-02. IC1084.2 +033500 ADD 1 TO REC-CT. IC1084.2 +033600 IF DN2 IS EQUAL TO "IC110A" IC1084.2 +033700 PERFORM PASS IC1084.2 +033800 GO TO CALL-WRITE-07-02. IC1084.2 +033900 CALL-FAIL-07-02. IC1084.2 +034000 PERFORM FAIL. IC1084.2 +034100 MOVE DN2 TO COMPUTED-A. IC1084.2 +034200 MOVE "IC110A" TO CORRECT-A. IC1084.2 +034300 MOVE "SUBPROGRAM IC110A ERROR" TO RE-MARK. IC1084.2 +034400 CALL-WRITE-07-02. IC1084.2 +034500 PERFORM PRINT-DETAIL. IC1084.2 +034600 CALL-TEST-07-03. IC1084.2 +034700 ADD 1 TO REC-CT. IC1084.2 +034800 IF DN3 EQUAL TO "IC111A" IC1084.2 +034900 PERFORM PASS IC1084.2 +035000 GO TO CALL-WRITE-07-03. IC1084.2 +035100 CALL-FAIL-07-03. IC1084.2 +035200 PERFORM FAIL. IC1084.2 +035300 MOVE DN3 TO COMPUTED-A. IC1084.2 +035400 MOVE "IC111A" TO CORRECT-A. IC1084.2 +035500 MOVE "SUBPROGRAM IC111A ERROR" TO RE-MARK. IC1084.2 +035600 CALL-WRITE-07-03. IC1084.2 +035700 PERFORM PRINT-DETAIL. IC1084.2 +035800 CALL-TEST-08. IC1084.2 +035900* THIS TEST VERIFIES THAT EACH OF THE SUBPROGRAMS IC1084.2 +036000* WERE CALLED ONLY ONCE. IC1084.2 +036100 MOVE "CALL-TEST-08" TO PAR-NAME. IC1084.2 +036200 MOVE "SUBPRGMS CALLED ONCE" TO FEATURE. IC1084.2 +036300 CALL-TEST-08-01. IC1084.2 +036400 MOVE 1 TO REC-CT. IC1084.2 +036500 IF DN4 EQUAL TO 1 IC1084.2 +036600 PERFORM PASS IC1084.2 +036700 GO TO CALL-WRITE-08-01. IC1084.2 +036800 CALL-FAIL-08-01. IC1084.2 +036900 PERFORM FAIL. IC1084.2 +037000 MOVE DN4 TO COMPUTED-18V0. IC1084.2 +037100 MOVE 1 TO CORRECT-18V0. IC1084.2 +037200 MOVE "IC109A CALLED N TIMES" TO RE-MARK. IC1084.2 +037300 CALL-WRITE-08-01. IC1084.2 +037400 PERFORM PRINT-DETAIL. IC1084.2 +037500 CALL-TEST-08-02. IC1084.2 +037600 ADD 1 TO REC-CT. IC1084.2 +037700 IF DN5 EQUAL TO 1 IC1084.2 +037800 PERFORM PASS IC1084.2 +037900 GO TO CALL-WRITE-08-02. IC1084.2 +038000 CALL-FAIL-08-02. IC1084.2 +038100 PERFORM FAIL. IC1084.2 +038200 MOVE DN5 TO COMPUTED-18V0. IC1084.2 +038300 MOVE 1 TO CORRECT-18V0. IC1084.2 +038400 MOVE "IC110A CALLED N TIMES" TO RE-MARK. IC1084.2 +038500 CALL-WRITE-08-02. IC1084.2 +038600 PERFORM PRINT-DETAIL. IC1084.2 +038700 CALL-TEST-08-03. IC1084.2 +038800 ADD 1 TO REC-CT. IC1084.2 +038900 IF DN6 EQUAL TO 1 IC1084.2 +039000 PERFORM PASS IC1084.2 +039100 GO TO CALL-WRITE-08-03. IC1084.2 +039200 CALL-FAIL-08-03. IC1084.2 +039300 PERFORM FAIL. IC1084.2 +039400 MOVE DN6 TO COMPUTED-18V0. IC1084.2 +039500 MOVE 1 TO CORRECT-18V0. IC1084.2 +039600 MOVE "IC111A CALLED N TIMES" TO RE-MARK. IC1084.2 +039700 CALL-WRITE-08-03. IC1084.2 +039800 PERFORM PRINT-DETAIL. IC1084.2 +039900 LINK-TEST-07. IC1084.2 +040000* THIS TEST VERIFIES THAT USING PHRASE OPERANDS IC1084.2 +040100* WHICH WERE DEFINED IN SUBPROGRAM WORKING-STORAGE IC1084.2 +040200* SECTIONS WERE PROCESSED CORRECTLY. IC1084.2 +040300 MOVE "LINK-TEST-07" TO PAR-NAME. IC1084.2 +040400 MOVE "USING OPERANDS" TO FEATURE. IC1084.2 +040500 LINK-TEST-07-01. IC1084.2 +040600 MOVE 1 TO REC-CT. IC1084.2 +040700 IF DN7 EQUAL TO "A" IC1084.2 +040800 PERFORM PASS IC1084.2 +040900 GO TO LINK-WRITE-07-01. IC1084.2 +041000 LINK-FAIL-07-01. IC1084.2 +041100 PERFORM FAIL. IC1084.2 +041200 MOVE DN7 TO COMPUTED-A. IC1084.2 +041300 MOVE "A" TO CORRECT-A. IC1084.2 +041400 MOVE "IC109A WK-STORAGE OPERAND" TO RE-MARK. IC1084.2 +041500 LINK-WRITE-07-01. IC1084.2 +041600 PERFORM PRINT-DETAIL. IC1084.2 +041700 LINK-TEST-07-02. IC1084.2 +041800 ADD 1 TO REC-CT. IC1084.2 +041900 IF DN8 EQUAL TO "A" IC1084.2 +042000 PERFORM PASS IC1084.2 +042100 GO TO LINK-WRITE-07-02. IC1084.2 +042200 LINK-FAIL-07-02. IC1084.2 +042300 PERFORM FAIL. IC1084.2 +042400 MOVE DN8 TO COMPUTED-A. IC1084.2 +042500 MOVE "A" TO CORRECT-A. IC1084.2 +042600 MOVE "IC110A WK-STORAGE OPERAND" TO RE-MARK. IC1084.2 +042700 LINK-WRITE-07-02. IC1084.2 +042800 PERFORM PRINT-DETAIL. IC1084.2 +042900 LINK-TEST-07-03. IC1084.2 +043000 ADD 1 TO REC-CT. IC1084.2 +043100 IF DN9 EQUAL TO "B" IC1084.2 +043200 PERFORM PASS IC1084.2 +043300 GO TO LINK-WRITE-07-03. IC1084.2 +043400 LINK-FAIL-07-03. IC1084.2 +043500 PERFORM FAIL. IC1084.2 +043600 MOVE DN9 TO COMPUTED-A. IC1084.2 +043700 MOVE "B" TO CORRECT-A. IC1084.2 +043800 MOVE "IC111A WK-STORAGE OPERAND" TO RE-MARK. IC1084.2 +043900 LINK-WRITE-07-03. IC1084.2 +044000 PERFORM PRINT-DETAIL. IC1084.2 +044100 GO TO CCVS-EXIT. IC1084.2 +044200 CCVS-EXIT SECTION. IC1084.2 +044300 CCVS-999999. IC1084.2 +044400 GO TO CLOSE-FILES. IC1084.2 diff --git a/tests/cobol85/IC/IC112A.CBL b/tests/cobol85/IC/IC112A.CBL new file mode 100755 index 00000000..6eeaf7c2 --- /dev/null +++ b/tests/cobol85/IC/IC112A.CBL @@ -0,0 +1,555 @@ +000100 IDENTIFICATION DIVISION. IC1124.2 +000200 PROGRAM-ID. IC1124.2 +000300 IC112A. IC1124.2 +000400**************************************************************** IC1124.2 +000500* * IC1124.2 +000600* VALIDATION FOR:- * IC1124.2 +000700* * IC1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1124.2 +000900* * IC1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1124.2 +001100* * IC1124.2 +001200**************************************************************** IC1124.2 +001300* * IC1124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1124.2 +001500* * IC1124.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1124.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1124.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1124.2 +001900* * IC1124.2 +002000**************************************************************** IC1124.2 +002100**************************************************************** IC1124.2 +002200* IC1124.2 +002300* THE ROUTINE IC112 IS A MAIN PROGRAM WHICH HAS A FILE IC1124.2 +002400* DESCRIPTION FOR A SEQUENTIAL MASS STORAGE FILE WITH FIXED IC1124.2 +002500* LENGTH RECORDS. THE FILE IS CREATED, CLOSED AND OPENED AS IC1124.2 +002600* AN INPUT FILE. THE MAIN ROUTINE READS THE FILE AND VERIFIES IC1124.2 +002700* THAT THE FILE IS CORRECT. THE FILE IS CLOSED AND OPENED IC1124.2 +002800* AGAIN AS AN INPUT FILE. A RECORD IS READ AND A CALL IS MADE IC1124.2 +002900* TO THE SUBPROGRAM IC113 WITH THE FILE DESCRIPTION 01 RECORD IC1124.2 +003000* LISTED AS ONE OF THE OPERANDS OF THE USING PHRASE. THE IC1124.2 +003100* SUBPROGRAM IC113 COMPARES THE FIELDS IN THE INPUT RECORD TO IC1124.2 +003200* THE VALUES WRITTEN WHEN THE FILE WAS CREATED. IC1124.2 +003300* IC1124.2 +003400* THIS PROGRAM WAS ADAPTED FROM THE SEQUENTIAL I-O TEST IC1124.2 +003500* CONTAINED IN ROUTINE SQ104. IF ANY ERRORS OCCUR IN RUNNING IC1124.2 +003600* THE ROUTINE SQ104, THE RESULTS OF THE TESTS IN THE ROUTINES IC1124.2 +003700* IC112 AND IC113 ARE INCONCLUSIVE. IC1124.2 +003800* IC1124.2 +003900******************************************* IC1124.2 +004000 ENVIRONMENT DIVISION. IC1124.2 +004100 CONFIGURATION SECTION. IC1124.2 +004200 SOURCE-COMPUTER. IC1124.2 +004300 Linux. IC1124.2 +004400 OBJECT-COMPUTER. IC1124.2 +004500 Linux. IC1124.2 +004600 INPUT-OUTPUT SECTION. IC1124.2 +004700 FILE-CONTROL. IC1124.2 +004800 SELECT PRINT-FILE ASSIGN TO IC1124.2 +004900 "report.log". IC1124.2 +005000 SELECT SQ-FS3 ASSIGN TO IC1124.2 +005100 "XXXXX014" IC1124.2 +005200 ORGANIZATION IS SEQUENTIAL IC1124.2 +005300 ACCESS MODE IS SEQUENTIAL. IC1124.2 +005400 DATA DIVISION. IC1124.2 +005500 FILE SECTION. IC1124.2 +005600 FD PRINT-FILE. IC1124.2 +005700 01 PRINT-REC PICTURE X(120). IC1124.2 +005800 01 DUMMY-RECORD PICTURE X(120). IC1124.2 +005900 FD SQ-FS3 IC1124.2 +006000 BLOCK CONTAINS 120 CHARACTERS IC1124.2 +006100 RECORD CONTAINS 120 CHARACTERS IC1124.2 +006200 LABEL RECORDS ARE STANDARD IC1124.2 +006300*C VALUE OF IC1124.2 +006400*C OCLABELID IC1124.2 +006500*C IS IC1124.2 +006600*C "OCDUMMY" IC1124.2 +006700*G SYSIN IC1124.2 +006800 DATA RECORD SQ-FS3R1-F-G-120. IC1124.2 +006900 01 SQ-FS3R1-F-G-120. IC1124.2 +007000 02 FILLER PIC X(120). IC1124.2 +007100 WORKING-STORAGE SECTION. IC1124.2 +007200 01 WRK-CS-09V00 PICTURE S9(9) USAGE COMP VALUE ZERO. IC1124.2 +007300 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. IC1124.2 +007400 01 ERROR-FLAG PICTURE 9 VALUE 0. IC1124.2 +007500 01 EOF-FLAG PICTURE 9 VALUE 0. IC1124.2 +007600 01 FILE-RECORD-INFORMATION-REC. IC1124.2 +007700 03 FILE-RECORD-INFO-SKELETON. IC1124.2 +007800 05 FILLER PICTURE X(48) VALUE IC1124.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IC1124.2 +008000 05 FILLER PICTURE X(46) VALUE IC1124.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IC1124.2 +008200 05 FILLER PICTURE X(26) VALUE IC1124.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". IC1124.2 +008400 05 FILLER PICTURE X(37) VALUE IC1124.2 +008500 ",RECKEY= ". IC1124.2 +008600 05 FILLER PICTURE X(38) VALUE IC1124.2 +008700 ",ALTKEY1= ". IC1124.2 +008800 05 FILLER PICTURE X(38) VALUE IC1124.2 +008900 ",ALTKEY2= ". IC1124.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.IC1124.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. IC1124.2 +009200 05 FILE-RECORD-INFO-P1-120. IC1124.2 +009300 07 FILLER PIC X(5). IC1124.2 +009400 07 XFILE-NAME PIC X(6). IC1124.2 +009500 07 FILLER PIC X(8). IC1124.2 +009600 07 XRECORD-NAME PIC X(6). IC1124.2 +009700 07 FILLER PIC X(1). IC1124.2 +009800 07 REELUNIT-NUMBER PIC 9(1). IC1124.2 +009900 07 FILLER PIC X(7). IC1124.2 +010000 07 XRECORD-NUMBER PIC 9(6). IC1124.2 +010100 07 FILLER PIC X(6). IC1124.2 +010200 07 UPDATE-NUMBER PIC 9(2). IC1124.2 +010300 07 FILLER PIC X(5). IC1124.2 +010400 07 ODO-NUMBER PIC 9(4). IC1124.2 +010500 07 FILLER PIC X(5). IC1124.2 +010600 07 XPROGRAM-NAME PIC X(5). IC1124.2 +010700 07 FILLER PIC X(7). IC1124.2 +010800 07 XRECORD-LENGTH PIC 9(6). IC1124.2 +010900 07 FILLER PIC X(7). IC1124.2 +011000 07 CHARS-OR-RECORDS PIC X(2). IC1124.2 +011100 07 FILLER PIC X(1). IC1124.2 +011200 07 XBLOCK-SIZE PIC 9(4). IC1124.2 +011300 07 FILLER PIC X(6). IC1124.2 +011400 07 RECORDS-IN-FILE PIC 9(6). IC1124.2 +011500 07 FILLER PIC X(5). IC1124.2 +011600 07 XFILE-ORGANIZATION PIC X(2). IC1124.2 +011700 07 FILLER PIC X(6). IC1124.2 +011800 07 XLABEL-TYPE PIC X(1). IC1124.2 +011900 05 FILE-RECORD-INFO-P121-240. IC1124.2 +012000 07 FILLER PIC X(8). IC1124.2 +012100 07 XRECORD-KEY PIC X(29). IC1124.2 +012200 07 FILLER PIC X(9). IC1124.2 +012300 07 ALTERNATE-KEY1 PIC X(29). IC1124.2 +012400 07 FILLER PIC X(9). IC1124.2 +012500 07 ALTERNATE-KEY2 PIC X(29). IC1124.2 +012600 07 FILLER PIC X(7). IC1124.2 +012700 01 TEST-RESULTS. IC1124.2 +012800 02 FILLER PIC X VALUE SPACE. IC1124.2 +012900 02 FEATURE PIC X(20) VALUE SPACE. IC1124.2 +013000 02 FILLER PIC X VALUE SPACE. IC1124.2 +013100 02 P-OR-F PIC X(5) VALUE SPACE. IC1124.2 +013200 02 FILLER PIC X VALUE SPACE. IC1124.2 +013300 02 PAR-NAME. IC1124.2 +013400 03 FILLER PIC X(19) VALUE SPACE. IC1124.2 +013500 03 PARDOT-X PIC X VALUE SPACE. IC1124.2 +013600 03 DOTVALUE PIC 99 VALUE ZERO. IC1124.2 +013700 02 FILLER PIC X(8) VALUE SPACE. IC1124.2 +013800 02 RE-MARK PIC X(61). IC1124.2 +013900 01 TEST-COMPUTED. IC1124.2 +014000 02 FILLER PIC X(30) VALUE SPACE. IC1124.2 +014100 02 FILLER PIC X(17) VALUE IC1124.2 +014200 " COMPUTED=". IC1124.2 +014300 02 COMPUTED-X. IC1124.2 +014400 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1124.2 +014500 03 COMPUTED-N REDEFINES COMPUTED-A IC1124.2 +014600 PIC -9(9).9(9). IC1124.2 +014700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1124.2 +014800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1124.2 +014900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1124.2 +015000 03 CM-18V0 REDEFINES COMPUTED-A. IC1124.2 +015100 04 COMPUTED-18V0 PIC -9(18). IC1124.2 +015200 04 FILLER PIC X. IC1124.2 +015300 03 FILLER PIC X(50) VALUE SPACE. IC1124.2 +015400 01 TEST-CORRECT. IC1124.2 +015500 02 FILLER PIC X(30) VALUE SPACE. IC1124.2 +015600 02 FILLER PIC X(17) VALUE " CORRECT =". IC1124.2 +015700 02 CORRECT-X. IC1124.2 +015800 03 CORRECT-A PIC X(20) VALUE SPACE. IC1124.2 +015900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1124.2 +016000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1124.2 +016100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1124.2 +016200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1124.2 +016300 03 CR-18V0 REDEFINES CORRECT-A. IC1124.2 +016400 04 CORRECT-18V0 PIC -9(18). IC1124.2 +016500 04 FILLER PIC X. IC1124.2 +016600 03 FILLER PIC X(2) VALUE SPACE. IC1124.2 +016700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1124.2 +016800 01 CCVS-C-1. IC1124.2 +016900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1124.2 +017000- "SS PARAGRAPH-NAME IC1124.2 +017100- " REMARKS". IC1124.2 +017200 02 FILLER PIC X(20) VALUE SPACE. IC1124.2 +017300 01 CCVS-C-2. IC1124.2 +017400 02 FILLER PIC X VALUE SPACE. IC1124.2 +017500 02 FILLER PIC X(6) VALUE "TESTED". IC1124.2 +017600 02 FILLER PIC X(15) VALUE SPACE. IC1124.2 +017700 02 FILLER PIC X(4) VALUE "FAIL". IC1124.2 +017800 02 FILLER PIC X(94) VALUE SPACE. IC1124.2 +017900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1124.2 +018000 01 REC-CT PIC 99 VALUE ZERO. IC1124.2 +018100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1124.2 +018200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1124.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1124.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1124.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1124.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1124.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1124.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1124.2 +018900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1124.2 +019000 01 CCVS-H-1. IC1124.2 +019100 02 FILLER PIC X(39) VALUE SPACES. IC1124.2 +019200 02 FILLER PIC X(42) VALUE IC1124.2 +019300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1124.2 +019400 02 FILLER PIC X(39) VALUE SPACES. IC1124.2 +019500 01 CCVS-H-2A. IC1124.2 +019600 02 FILLER PIC X(40) VALUE SPACE. IC1124.2 +019700 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1124.2 +019800 02 FILLER PIC XXXX VALUE IC1124.2 +019900 "4.2 ". IC1124.2 +020000 02 FILLER PIC X(28) VALUE IC1124.2 +020100 " COPY - NOT FOR DISTRIBUTION". IC1124.2 +020200 02 FILLER PIC X(41) VALUE SPACE. IC1124.2 +020300 IC1124.2 +020400 01 CCVS-H-2B. IC1124.2 +020500 02 FILLER PIC X(15) VALUE IC1124.2 +020600 "TEST RESULT OF ". IC1124.2 +020700 02 TEST-ID PIC X(9). IC1124.2 +020800 02 FILLER PIC X(4) VALUE IC1124.2 +020900 " IN ". IC1124.2 +021000 02 FILLER PIC X(12) VALUE IC1124.2 +021100 " HIGH ". IC1124.2 +021200 02 FILLER PIC X(22) VALUE IC1124.2 +021300 " LEVEL VALIDATION FOR ". IC1124.2 +021400 02 FILLER PIC X(58) VALUE IC1124.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1124.2 +021600 01 CCVS-H-3. IC1124.2 +021700 02 FILLER PIC X(34) VALUE IC1124.2 +021800 " FOR OFFICIAL USE ONLY ". IC1124.2 +021900 02 FILLER PIC X(58) VALUE IC1124.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1124.2 +022100 02 FILLER PIC X(28) VALUE IC1124.2 +022200 " COPYRIGHT 1985 ". IC1124.2 +022300 01 CCVS-E-1. IC1124.2 +022400 02 FILLER PIC X(52) VALUE SPACE. IC1124.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1124.2 +022600 02 ID-AGAIN PIC X(9). IC1124.2 +022700 02 FILLER PIC X(45) VALUE SPACES. IC1124.2 +022800 01 CCVS-E-2. IC1124.2 +022900 02 FILLER PIC X(31) VALUE SPACE. IC1124.2 +023000 02 FILLER PIC X(21) VALUE SPACE. IC1124.2 +023100 02 CCVS-E-2-2. IC1124.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1124.2 +023300 03 FILLER PIC X VALUE SPACE. IC1124.2 +023400 03 ENDER-DESC PIC X(44) VALUE IC1124.2 +023500 "ERRORS ENCOUNTERED". IC1124.2 +023600 01 CCVS-E-3. IC1124.2 +023700 02 FILLER PIC X(22) VALUE IC1124.2 +023800 " FOR OFFICIAL USE ONLY". IC1124.2 +023900 02 FILLER PIC X(12) VALUE SPACE. IC1124.2 +024000 02 FILLER PIC X(58) VALUE IC1124.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1124.2 +024200 02 FILLER PIC X(13) VALUE SPACE. IC1124.2 +024300 02 FILLER PIC X(15) VALUE IC1124.2 +024400 " COPYRIGHT 1985". IC1124.2 +024500 01 CCVS-E-4. IC1124.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1124.2 +024700 02 FILLER PIC X(4) VALUE " OF ". IC1124.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1124.2 +024900 02 FILLER PIC X(40) VALUE IC1124.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". IC1124.2 +025100 01 XXINFO. IC1124.2 +025200 02 FILLER PIC X(19) VALUE IC1124.2 +025300 "*** INFORMATION ***". IC1124.2 +025400 02 INFO-TEXT. IC1124.2 +025500 04 FILLER PIC X(8) VALUE SPACE. IC1124.2 +025600 04 XXCOMPUTED PIC X(20). IC1124.2 +025700 04 FILLER PIC X(5) VALUE SPACE. IC1124.2 +025800 04 XXCORRECT PIC X(20). IC1124.2 +025900 02 INF-ANSI-REFERENCE PIC X(48). IC1124.2 +026000 01 HYPHEN-LINE. IC1124.2 +026100 02 FILLER PIC IS X VALUE IS SPACE. IC1124.2 +026200 02 FILLER PIC IS X(65) VALUE IS "************************IC1124.2 +026300- "*****************************************". IC1124.2 +026400 02 FILLER PIC IS X(54) VALUE IS "************************IC1124.2 +026500- "******************************". IC1124.2 +026600 01 CCVS-PGM-ID PIC X(9) VALUE IC1124.2 +026700 "IC112A". IC1124.2 +026800 PROCEDURE DIVISION. IC1124.2 +026900 CCVS1 SECTION. IC1124.2 +027000 OPEN-FILES. IC1124.2 +027100 OPEN OUTPUT PRINT-FILE. IC1124.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1124.2 +027300 MOVE SPACE TO TEST-RESULTS. IC1124.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1124.2 +027500 GO TO CCVS1-EXIT. IC1124.2 +027600 CLOSE-FILES. IC1124.2 +027700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1124.2 +027800 TERMINATE-CCVS. IC1124.2 +027900*S EXIT PROGRAM. IC1124.2 +028000*SERMINATE-CALL. IC1124.2 +028100 STOP RUN. IC1124.2 +028200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1124.2 +028300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1124.2 +028400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1124.2 +028500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1124.2 +028600 MOVE "****TEST DELETED****" TO RE-MARK. IC1124.2 +028700 PRINT-DETAIL. IC1124.2 +028800 IF REC-CT NOT EQUAL TO ZERO IC1124.2 +028900 MOVE "." TO PARDOT-X IC1124.2 +029000 MOVE REC-CT TO DOTVALUE. IC1124.2 +029100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1124.2 +029200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1124.2 +029300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1124.2 +029400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1124.2 +029500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1124.2 +029600 MOVE SPACE TO CORRECT-X. IC1124.2 +029700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1124.2 +029800 MOVE SPACE TO RE-MARK. IC1124.2 +029900 HEAD-ROUTINE. IC1124.2 +030000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +030100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +030200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1124.2 +030300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1124.2 +030400 COLUMN-NAMES-ROUTINE. IC1124.2 +030500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +030600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +030700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +030800 END-ROUTINE. IC1124.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1124.2 +031000 END-RTN-EXIT. IC1124.2 +031100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +031200 END-ROUTINE-1. IC1124.2 +031300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1124.2 +031400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1124.2 +031500 ADD PASS-COUNTER TO ERROR-HOLD. IC1124.2 +031600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1124.2 +031700 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1124.2 +031800 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1124.2 +031900 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1124.2 +032000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1124.2 +032100 END-ROUTINE-12. IC1124.2 +032200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1124.2 +032300 IF ERROR-COUNTER IS EQUAL TO ZERO IC1124.2 +032400 MOVE "NO " TO ERROR-TOTAL IC1124.2 +032500 ELSE IC1124.2 +032600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1124.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1124.2 +032800 PERFORM WRITE-LINE. IC1124.2 +032900 END-ROUTINE-13. IC1124.2 +033000 IF DELETE-COUNTER IS EQUAL TO ZERO IC1124.2 +033100 MOVE "NO " TO ERROR-TOTAL ELSE IC1124.2 +033200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1124.2 +033300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1124.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +033500 IF INSPECT-COUNTER EQUAL TO ZERO IC1124.2 +033600 MOVE "NO " TO ERROR-TOTAL IC1124.2 +033700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1124.2 +033800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1124.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +034000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1124.2 +034100 WRITE-LINE. IC1124.2 +034200 ADD 1 TO RECORD-COUNT. IC1124.2 +034300 IF RECORD-COUNT GREATER 50 IC1124.2 +034400 MOVE DUMMY-RECORD TO DUMMY-HOLD IC1124.2 +034500 MOVE SPACE TO DUMMY-RECORD IC1124.2 +034600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1124.2 +034700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1124.2 +034800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1124.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1124.2 +035000 MOVE DUMMY-HOLD TO DUMMY-RECORD IC1124.2 +035100 MOVE ZERO TO RECORD-COUNT. IC1124.2 +035200 PERFORM WRT-LN. IC1124.2 +035300 WRT-LN. IC1124.2 +035400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1124.2 +035500 MOVE SPACE TO DUMMY-RECORD. IC1124.2 +035600 BLANK-LINE-PRINT. IC1124.2 +035700 PERFORM WRT-LN. IC1124.2 +035800 FAIL-ROUTINE. IC1124.2 +035900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1124.2 +036000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1124.2 +036100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1124.2 +036200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1124.2 +036300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +036400 MOVE SPACES TO INF-ANSI-REFERENCE. IC1124.2 +036500 GO TO FAIL-ROUTINE-EX. IC1124.2 +036600 FAIL-ROUTINE-WRITE. IC1124.2 +036700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1124.2 +036800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1124.2 +036900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1124.2 +037000 MOVE SPACES TO COR-ANSI-REFERENCE. IC1124.2 +037100 FAIL-ROUTINE-EX. EXIT. IC1124.2 +037200 BAIL-OUT. IC1124.2 +037300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1124.2 +037400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1124.2 +037500 BAIL-OUT-WRITE. IC1124.2 +037600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1124.2 +037700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1124.2 +037800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1124.2 +037900 MOVE SPACES TO INF-ANSI-REFERENCE. IC1124.2 +038000 BAIL-OUT-EX. EXIT. IC1124.2 +038100 CCVS1-EXIT. IC1124.2 +038200 EXIT. IC1124.2 +038300 SECT-IC112-0001 SECTION. IC1124.2 +038400 SEQ-INIT-007. IC1124.2 +038500 MOVE FILE-RECORD-INFO-SKELETON IC1124.2 +038600 TO FILE-RECORD-INFO-P1-120 (1). IC1124.2 +038700 MOVE "SQ-FS3" TO XFILE-NAME (1). IC1124.2 +038800 MOVE "R1-F-G" TO XRECORD-NAME (1). IC1124.2 +038900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IC1124.2 +039000 MOVE 120 TO XRECORD-LENGTH (1). IC1124.2 +039100 MOVE "CH" TO CHARS-OR-RECORDS (1). IC1124.2 +039200 MOVE 120 TO XBLOCK-SIZE (1). IC1124.2 +039300 MOVE 000649 TO RECORDS-IN-FILE (1). IC1124.2 +039400 MOVE "SQ" TO XFILE-ORGANIZATION (1). IC1124.2 +039500 MOVE "S" TO XLABEL-TYPE (1). IC1124.2 +039600 MOVE 000001 TO XRECORD-NUMBER (1). IC1124.2 +039700 OPEN OUTPUT SQ-FS3. IC1124.2 +039800 SEQ-TEST-007. IC1124.2 +039900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. IC1124.2 +040000 WRITE SQ-FS3R1-F-G-120. IC1124.2 +040100 IF XRECORD-NUMBER (1) EQUAL TO 649 IC1124.2 +040200 GO TO SEQ-WRITE-007. IC1124.2 +040300 ADD 1 TO XRECORD-NUMBER (1). IC1124.2 +040400 GO TO SEQ-TEST-007. IC1124.2 +040500 SEQ-WRITE-007. IC1124.2 +040600 MOVE "CREATE FILE SQ-FS3" TO FEATURE. IC1124.2 +040700 MOVE "SEQ-TEST-007" TO PAR-NAME. IC1124.2 +040800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IC1124.2 +040900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IC1124.2 +041000 PERFORM PRINT-DETAIL. IC1124.2 +041100 CLOSE SQ-FS3. IC1124.2 +041200* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTER IC1124.2 +041300* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. IC1124.2 +041400 SEQ-INIT-008. IC1124.2 +041500 MOVE ZERO TO WRK-CS-09V00. IC1124.2 +041600* THIS TEST READS AND CHECKS THE FILE CREATED IN IC1124.2 +041700* SEQ-TEST-007. IC1124.2 +041800 OPEN INPUT SQ-FS3. IC1124.2 +041900 SEQ-TEST-008. IC1124.2 +042000 READ SQ-FS3 RECORD IC1124.2 +042100 AT END GO TO SEQ-TEST-008-1. IC1124.2 +042200 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). IC1124.2 +042300 ADD 1 TO WRK-CS-09V00. IC1124.2 +042400 IF WRK-CS-09V00 GREATER THAN 649 IC1124.2 +042500 MOVE "MORE THAN 649 RECORDS" TO RE-MARK IC1124.2 +042600 GO TO SEQ-FAIL-008. IC1124.2 +042700 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) IC1124.2 +042800 ADD 1 TO RECORDS-IN-ERROR IC1124.2 +042900 GO TO SEQ-TEST-008. IC1124.2 +043000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" IC1124.2 +043100 ADD 1 TO RECORDS-IN-ERROR IC1124.2 +043200 GO TO SEQ-TEST-008. IC1124.2 +043300 IF XLABEL-TYPE (1) NOT EQUAL TO "S" IC1124.2 +043400 ADD 1 TO RECORDS-IN-ERROR. IC1124.2 +043500 GO TO SEQ-TEST-008. IC1124.2 +043600 SEQ-TEST-008-1. IC1124.2 +043700 IF RECORDS-IN-ERROR EQUAL TO ZERO IC1124.2 +043800 GO TO SEQ-PASS-008. IC1124.2 +043900 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. IC1124.2 +044000 SEQ-FAIL-008. IC1124.2 +044100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IC1124.2 +044200 PERFORM FAIL. IC1124.2 +044300 GO TO SEQ-WRITE-008. IC1124.2 +044400 SEQ-PASS-008. IC1124.2 +044500 PERFORM PASS. IC1124.2 +044600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IC1124.2 +044700 MOVE WRK-CS-09V00 TO CORRECT-18V0. IC1124.2 +044800 SEQ-WRITE-008. IC1124.2 +044900 MOVE "SEQ-TEST-008" TO PAR-NAME. IC1124.2 +045000 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. IC1124.2 +045100 PERFORM PRINT-DETAIL. IC1124.2 +045200 SEQ-CLOSE-008. IC1124.2 +045300 CLOSE SQ-FS3. IC1124.2 +045400 LINK-INIT-08. IC1124.2 +045500 MOVE ZERO TO WRK-CS-09V00. IC1124.2 +045600 MOVE ZERO TO RECORDS-IN-ERROR. IC1124.2 +045700 OPEN INPUT SQ-FS3. IC1124.2 +045800* IC1124.2 +045900* LINK-TEST-08 READS THE FILE SQ-FS3 AND CALLS THE SUB- IC1124.2 +046000* PROGRAM IC113 TO CHECK THE FIELDS IN THE RECORD. THE FILE IC1124.2 +046100* DESCRIPTION RECORD IS ONE OF THE OPERANDS IN THE USING IC1124.2 +046200* PHRASE OF THE CALL STATEMENT. IC1124.2 +046300* IC1124.2 +046400 MOVE ZERO TO ERROR-FLAG. IC1124.2 +046500 LINK-TEST-08. IC1124.2 +046600 READ SQ-FS3 RECORD IC1124.2 +046700 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A IC1124.2 +046800 MOVE 1 TO EOF-FLAG IC1124.2 +046900 GO TO LINK-FAIL-08. IC1124.2 +047000 CALL "IC113A" USING RECORDS-IN-ERROR SQ-FS3R1-F-G-120 IC1124.2 +047100 ERROR-FLAG WRK-CS-09V00. IC1124.2 +047200 IF WRK-CS-09V00 LESS THAN 649 IC1124.2 +047300 GO TO LINK-TEST-08. IC1124.2 +047400 LINK-TEST-08-01. IC1124.2 +047500 IF ERROR-FLAG EQUAL TO ZERO IC1124.2 +047600 GO TO LINK-PASS-08. IC1124.2 +047700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IC1124.2 +047800 LINK-FAIL-08. IC1124.2 +047900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IC1124.2 +048000 MOVE "CORRECT COL. = RECORDS-IN-ERROR" TO RE-MARK. IC1124.2 +048100 PERFORM FAIL. IC1124.2 +048200 GO TO LINK-WRITE-08. IC1124.2 +048300 LINK-PASS-08. IC1124.2 +048400 PERFORM PASS. IC1124.2 +048500 LINK-WRITE-08. IC1124.2 +048600 MOVE "LINK-TEST-08" TO PAR-NAME. IC1124.2 +048700 MOVE "USING FD 01 RECORD" TO FEATURE. IC1124.2 +048800 PERFORM PRINT-DETAIL. IC1124.2 +048900 LINK-INIT-09. IC1124.2 +049000 MOVE ZERO TO RECORDS-IN-ERROR ERROR-FLAG. IC1124.2 +049100* IC1124.2 +049200* LINK-TEST-09 READS THE FILE SQ-FS3. THE AT END PHRASE IC1124.2 +049300* OF THE READ STATEMENT SHOULD BE EXECUTED. A CALL TO THE IC1124.2 +049400* SUBPROGRAM IC113 IS CONTAINED IN THE AT END PHRASE WITH IC1124.2 +049500* THE FD 01 RECORD AS ONE OF THE USING OPERANDS. IC1124.2 +049600* IC1124.2 +049700 LINK-TEST-09-01. IC1124.2 +049800 IF EOF-FLAG EQUAL TO 1 IC1124.2 +049900 CALL "IC113A" USING RECORDS-IN-ERROR SQ-FS3R1-F-G-120IC1124.2 +050000 ERROR-FLAG WRK-CS-09V00 IC1124.2 +050100 GO TO LINK-TEST-09-02. IC1124.2 +050200 LINK-TEST-09. IC1124.2 +050300 READ SQ-FS3 IC1124.2 +050400 AT END CALL "IC113A" USING RECORDS-IN-ERROR IC1124.2 +050500 SQ-FS3R1-F-G-120 ERROR-FLAG WRK-CS-09V00 IC1124.2 +050600 GO TO LINK-TEST-09-02. IC1124.2 +050700 MOVE "MORE THAN 649 RECORDS" TO RE-MARK. IC1124.2 +050800 GO TO LINK-FAIL-09. IC1124.2 +050900 LINK-TEST-09-02. IC1124.2 +051000 IF ERROR-FLAG EQUAL TO 1 IC1124.2 +051100 GO TO LINK-PASS-09. IC1124.2 +051200 MOVE "ERROR FLAG NOT SET IN SUBPRGRM" TO RE-MARK. IC1124.2 +051300 LINK-FAIL-09. IC1124.2 +051400 PERFORM FAIL. IC1124.2 +051500 GO TO LINK-WRITE-09. IC1124.2 +051600 LINK-PASS-09. IC1124.2 +051700 PERFORM PASS. IC1124.2 +051800 LINK-WRITE-09. IC1124.2 +051900 MOVE "LINK-TEST-09" TO PAR-NAME. IC1124.2 +052000 MOVE "CALL AFTER AT END" TO FEATURE. IC1124.2 +052100 PERFORM PRINT-DETAIL. IC1124.2 +052200 CLOSE SQ-FS3. IC1124.2 +052300 EXIT-IC112. IC1124.2 +052400 EXIT. IC1124.2 +052500*XILE-DUMP SECTION. IC1124.2 +052600*XILE-3-DUMP-INIT. IC1124.2 +052700*X OPEN INPUT SQ-FS3. IC1124.2 +052800*X MOVE ZERO TO WRK-CS-09V00. IC1124.2 +052900*XILE-3-DUMP. IC1124.2 +053000*X ADD 1 TO WRK-CS-09V00. IC1124.2 +053100*X IF WRK-CS-09V00 GREATER THAN 649 IC1124.2 +053200*X GO TO FILE-3-DUMP-EXTRA. IC1124.2 +053300*X READ SQ-FS3 RECORD AT END IC1124.2 +053400*X GO TO FILE-3-DUMP-END. IC1124.2 +053500*X PERFORM FILE-3-DUMP-WRITE. IC1124.2 +053600*X GO TO FILE-3-DUMP. IC1124.2 +053700*XILE-3-DUMP-WRITE. IC1124.2 +053800*X MOVE SQ-FS3R1-F-G-120 TO DUMMY-RECORD. IC1124.2 +053900*X PERFORM WRITE-LINE. IC1124.2 +054000*XILE-3-DUMP-EXTRA. IC1124.2 +054100*X PERFORM BLANK-LINE-PRINT 5 TIMES. IC1124.2 +054200*XILE-3-DUMP-MORE. IC1124.2 +054300*X READ SQ-FS3 RECORD AT END IC1124.2 +054400*X GO TO FILE-3-DUMP-END. IC1124.2 +054500*X PERFORM FILE-3-DUMP-WRITE. IC1124.2 +054600*X ADD 1 TO WRK-CS-09V00. IC1124.2 +054700*X IF WRK-CS-09V00 LESS THAN 669 IC1124.2 +054800*X GO TO FILE-3-DUMP-MORE. IC1124.2 +054900*XILE-3-DUMP-END. IC1124.2 +055000*X CLOSE SQ-FS3. IC1124.2 +055100*XILE-3-DUMP-EXIT. IC1124.2 +055200*X EXIT. IC1124.2 +055300 CCVS-EXIT SECTION. IC1124.2 +055400 CCVS-999999. IC1124.2 +055500 GO TO CLOSE-FILES. IC1124.2 diff --git a/tests/cobol85/IC/IC114A.CBL b/tests/cobol85/IC/IC114A.CBL new file mode 100755 index 00000000..c5ec38c4 --- /dev/null +++ b/tests/cobol85/IC/IC114A.CBL @@ -0,0 +1,471 @@ +000100 IDENTIFICATION DIVISION. IC1144.2 +000200 PROGRAM-ID. IC1144.2 +000300 IC114A. IC1144.2 +000400**************************************************************** IC1144.2 +000500* * IC1144.2 +000600* VALIDATION FOR:- * IC1144.2 +000700* * IC1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1144.2 +000900* * IC1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1144.2 +001100* * IC1144.2 +001200**************************************************************** IC1144.2 +001300* * IC1144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1144.2 +001500* * IC1144.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1144.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1144.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1144.2 +001900* * IC1144.2 +002000**************************************************************** IC1144.2 +002100* IC1144.2 +002200* THE ROUTINE IC114 IS A MAIN PROGRAM WHICH CALLS THE IC1144.2 +002300* SUBPROGRAM IC115. THE PURPOSE OF THESE PROGRAMS IS TO IC1144.2 +002400* VERIFY THAT A FILE SECTION, A WORKING-STORAGE SECTION, AND IC1144.2 +002500* A LINKAGE SECTION CAN APPEAR IN A SUBPROGRAM, AND A FILE IC1144.2 +002600* CAN BE WRITTEN AND READ WITHIN A SUBPROGRAM. IC1144.2 +002700* IC1144.2 +002800* THE PROGRAM IC114 CALLS IC115 TO CREATE AND VERIFY THE IC1144.2 +002900* FILE. SUBSEQUENT CALLS TO THE SUBPROGRAM ARE MADE TO READ IC1144.2 +003000* THE FILE AND RETURN A RECORD TO THE MAIN PROGRAM WHICH CHECKSIC1144.2 +003100* THE RECORD CONTENTS. IC1144.2 +003200* IC1144.2 +003300* THE SUBPROGRAM IC115 IS ADAPTED FROM THE SEQUENTIAL I-O IC1144.2 +003400* ROUTINE SQ104. IF SQ104 DOES NOT EXECUTE CORRECTLY THEN IC1144.2 +003500* THE RESULTS OF THESE TESTS ARE INCONCLUSIVE. IC1144.2 +003600* IC1144.2 +003700**************************************************************** IC1144.2 +003800 ENVIRONMENT DIVISION. IC1144.2 +003900 CONFIGURATION SECTION. IC1144.2 +004000 SOURCE-COMPUTER. IC1144.2 +004100 Linux. IC1144.2 +004200 OBJECT-COMPUTER. IC1144.2 +004300 Linux. IC1144.2 +004400 INPUT-OUTPUT SECTION. IC1144.2 +004500 FILE-CONTROL. IC1144.2 +004600 SELECT PRINT-FILE ASSIGN TO IC1144.2 +004700 "report.log". IC1144.2 +004800 DATA DIVISION. IC1144.2 +004900 FILE SECTION. IC1144.2 +005000 FD PRINT-FILE. IC1144.2 +005100 01 PRINT-REC PICTURE X(120). IC1144.2 +005200 01 DUMMY-RECORD PICTURE X(120). IC1144.2 +005300 WORKING-STORAGE SECTION. IC1144.2 +005400 01 GROUP-LINKAGE-VARIABLES. IC1144.2 +005500 02 COUNT-OF-RECORDS PICTURE 9(6). IC1144.2 +005600 02 RECORDS-IN-ERROR PICTURE 9(6). IC1144.2 +005700 02 ERROR-FLAG PICTURE 9. IC1144.2 +005800 02 EOF-FLAG PICTURE 9. IC1144.2 +005900 02 CALL-FLAG PICTURE 9. IC1144.2 +006000 01 FILE-REC-SQ-FS3. IC1144.2 +006100 02 XFILE-NAME-GROUP. IC1144.2 +006200 03 FILLER PIC X(5). IC1144.2 +006300 03 XFILE-NAME PIC X(6). IC1144.2 +006400 02 XRECORD-NAME-GROUP. IC1144.2 +006500 03 FILLER PIC X(8). IC1144.2 +006600 03 XRECORD-NAME PIC X(6). IC1144.2 +006700 02 REELUNIT-NUMBER-GROUP. IC1144.2 +006800 03 FILLER PIC X(1). IC1144.2 +006900 03 REELUNIT-NUMBER PIC 9(1). IC1144.2 +007000 02 FILLER PIC X(7). IC1144.2 +007100 02 XRECORD-NUMBER PIC 9(6). IC1144.2 +007200 02 FILLER PIC X(79). IC1144.2 +007300 02 XLABEL-TYPE PIC X(1). IC1144.2 +007400 01 TEST-RESULTS. IC1144.2 +007500 02 FILLER PIC X VALUE SPACE. IC1144.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. IC1144.2 +007700 02 FILLER PIC X VALUE SPACE. IC1144.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. IC1144.2 +007900 02 FILLER PIC X VALUE SPACE. IC1144.2 +008000 02 PAR-NAME. IC1144.2 +008100 03 FILLER PIC X(19) VALUE SPACE. IC1144.2 +008200 03 PARDOT-X PIC X VALUE SPACE. IC1144.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. IC1144.2 +008400 02 FILLER PIC X(8) VALUE SPACE. IC1144.2 +008500 02 RE-MARK PIC X(61). IC1144.2 +008600 01 TEST-COMPUTED. IC1144.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IC1144.2 +008800 02 FILLER PIC X(17) VALUE IC1144.2 +008900 " COMPUTED=". IC1144.2 +009000 02 COMPUTED-X. IC1144.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1144.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A IC1144.2 +009300 PIC -9(9).9(9). IC1144.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1144.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1144.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1144.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. IC1144.2 +009800 04 COMPUTED-18V0 PIC -9(18). IC1144.2 +009900 04 FILLER PIC X. IC1144.2 +010000 03 FILLER PIC X(50) VALUE SPACE. IC1144.2 +010100 01 TEST-CORRECT. IC1144.2 +010200 02 FILLER PIC X(30) VALUE SPACE. IC1144.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". IC1144.2 +010400 02 CORRECT-X. IC1144.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. IC1144.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1144.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1144.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1144.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1144.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. IC1144.2 +011100 04 CORRECT-18V0 PIC -9(18). IC1144.2 +011200 04 FILLER PIC X. IC1144.2 +011300 03 FILLER PIC X(2) VALUE SPACE. IC1144.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1144.2 +011500 01 CCVS-C-1. IC1144.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1144.2 +011700- "SS PARAGRAPH-NAME IC1144.2 +011800- " REMARKS". IC1144.2 +011900 02 FILLER PIC X(20) VALUE SPACE. IC1144.2 +012000 01 CCVS-C-2. IC1144.2 +012100 02 FILLER PIC X VALUE SPACE. IC1144.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". IC1144.2 +012300 02 FILLER PIC X(15) VALUE SPACE. IC1144.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". IC1144.2 +012500 02 FILLER PIC X(94) VALUE SPACE. IC1144.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1144.2 +012700 01 REC-CT PIC 99 VALUE ZERO. IC1144.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1144.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1144.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1144.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1144.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1144.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1144.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1144.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1144.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1144.2 +013700 01 CCVS-H-1. IC1144.2 +013800 02 FILLER PIC X(39) VALUE SPACES. IC1144.2 +013900 02 FILLER PIC X(42) VALUE IC1144.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1144.2 +014100 02 FILLER PIC X(39) VALUE SPACES. IC1144.2 +014200 01 CCVS-H-2A. IC1144.2 +014300 02 FILLER PIC X(40) VALUE SPACE. IC1144.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1144.2 +014500 02 FILLER PIC XXXX VALUE IC1144.2 +014600 "4.2 ". IC1144.2 +014700 02 FILLER PIC X(28) VALUE IC1144.2 +014800 " COPY - NOT FOR DISTRIBUTION". IC1144.2 +014900 02 FILLER PIC X(41) VALUE SPACE. IC1144.2 +015000 IC1144.2 +015100 01 CCVS-H-2B. IC1144.2 +015200 02 FILLER PIC X(15) VALUE IC1144.2 +015300 "TEST RESULT OF ". IC1144.2 +015400 02 TEST-ID PIC X(9). IC1144.2 +015500 02 FILLER PIC X(4) VALUE IC1144.2 +015600 " IN ". IC1144.2 +015700 02 FILLER PIC X(12) VALUE IC1144.2 +015800 " HIGH ". IC1144.2 +015900 02 FILLER PIC X(22) VALUE IC1144.2 +016000 " LEVEL VALIDATION FOR ". IC1144.2 +016100 02 FILLER PIC X(58) VALUE IC1144.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1144.2 +016300 01 CCVS-H-3. IC1144.2 +016400 02 FILLER PIC X(34) VALUE IC1144.2 +016500 " FOR OFFICIAL USE ONLY ". IC1144.2 +016600 02 FILLER PIC X(58) VALUE IC1144.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1144.2 +016800 02 FILLER PIC X(28) VALUE IC1144.2 +016900 " COPYRIGHT 1985 ". IC1144.2 +017000 01 CCVS-E-1. IC1144.2 +017100 02 FILLER PIC X(52) VALUE SPACE. IC1144.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1144.2 +017300 02 ID-AGAIN PIC X(9). IC1144.2 +017400 02 FILLER PIC X(45) VALUE SPACES. IC1144.2 +017500 01 CCVS-E-2. IC1144.2 +017600 02 FILLER PIC X(31) VALUE SPACE. IC1144.2 +017700 02 FILLER PIC X(21) VALUE SPACE. IC1144.2 +017800 02 CCVS-E-2-2. IC1144.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1144.2 +018000 03 FILLER PIC X VALUE SPACE. IC1144.2 +018100 03 ENDER-DESC PIC X(44) VALUE IC1144.2 +018200 "ERRORS ENCOUNTERED". IC1144.2 +018300 01 CCVS-E-3. IC1144.2 +018400 02 FILLER PIC X(22) VALUE IC1144.2 +018500 " FOR OFFICIAL USE ONLY". IC1144.2 +018600 02 FILLER PIC X(12) VALUE SPACE. IC1144.2 +018700 02 FILLER PIC X(58) VALUE IC1144.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1144.2 +018900 02 FILLER PIC X(13) VALUE SPACE. IC1144.2 +019000 02 FILLER PIC X(15) VALUE IC1144.2 +019100 " COPYRIGHT 1985". IC1144.2 +019200 01 CCVS-E-4. IC1144.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1144.2 +019400 02 FILLER PIC X(4) VALUE " OF ". IC1144.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1144.2 +019600 02 FILLER PIC X(40) VALUE IC1144.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". IC1144.2 +019800 01 XXINFO. IC1144.2 +019900 02 FILLER PIC X(19) VALUE IC1144.2 +020000 "*** INFORMATION ***". IC1144.2 +020100 02 INFO-TEXT. IC1144.2 +020200 04 FILLER PIC X(8) VALUE SPACE. IC1144.2 +020300 04 XXCOMPUTED PIC X(20). IC1144.2 +020400 04 FILLER PIC X(5) VALUE SPACE. IC1144.2 +020500 04 XXCORRECT PIC X(20). IC1144.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). IC1144.2 +020700 01 HYPHEN-LINE. IC1144.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. IC1144.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************IC1144.2 +021000- "*****************************************". IC1144.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************IC1144.2 +021200- "******************************". IC1144.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE IC1144.2 +021400 "IC114A". IC1144.2 +021500 PROCEDURE DIVISION. IC1144.2 +021600 CCVS1 SECTION. IC1144.2 +021700 OPEN-FILES. IC1144.2 +021800 OPEN OUTPUT PRINT-FILE. IC1144.2 +021900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1144.2 +022000 MOVE SPACE TO TEST-RESULTS. IC1144.2 +022100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1144.2 +022200 GO TO CCVS1-EXIT. IC1144.2 +022300 CLOSE-FILES. IC1144.2 +022400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1144.2 +022500 TERMINATE-CCVS. IC1144.2 +022600*S EXIT PROGRAM. IC1144.2 +022700*SERMINATE-CALL. IC1144.2 +022800 STOP RUN. IC1144.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1144.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1144.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1144.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1144.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IC1144.2 +023400 PRINT-DETAIL. IC1144.2 +023500 IF REC-CT NOT EQUAL TO ZERO IC1144.2 +023600 MOVE "." TO PARDOT-X IC1144.2 +023700 MOVE REC-CT TO DOTVALUE. IC1144.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1144.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1144.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1144.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1144.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1144.2 +024300 MOVE SPACE TO CORRECT-X. IC1144.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1144.2 +024500 MOVE SPACE TO RE-MARK. IC1144.2 +024600 HEAD-ROUTINE. IC1144.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1144.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1144.2 +025100 COLUMN-NAMES-ROUTINE. IC1144.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +025500 END-ROUTINE. IC1144.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1144.2 +025700 END-RTN-EXIT. IC1144.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +025900 END-ROUTINE-1. IC1144.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1144.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1144.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IC1144.2 +026300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1144.2 +026400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1144.2 +026500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1144.2 +026600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1144.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1144.2 +026800 END-ROUTINE-12. IC1144.2 +026900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1144.2 +027000 IF ERROR-COUNTER IS EQUAL TO ZERO IC1144.2 +027100 MOVE "NO " TO ERROR-TOTAL IC1144.2 +027200 ELSE IC1144.2 +027300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1144.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1144.2 +027500 PERFORM WRITE-LINE. IC1144.2 +027600 END-ROUTINE-13. IC1144.2 +027700 IF DELETE-COUNTER IS EQUAL TO ZERO IC1144.2 +027800 MOVE "NO " TO ERROR-TOTAL ELSE IC1144.2 +027900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1144.2 +028000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1144.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +028200 IF INSPECT-COUNTER EQUAL TO ZERO IC1144.2 +028300 MOVE "NO " TO ERROR-TOTAL IC1144.2 +028400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1144.2 +028500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1144.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +028700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1144.2 +028800 WRITE-LINE. IC1144.2 +028900 ADD 1 TO RECORD-COUNT. IC1144.2 +029000 IF RECORD-COUNT GREATER 50 IC1144.2 +029100 MOVE DUMMY-RECORD TO DUMMY-HOLD IC1144.2 +029200 MOVE SPACE TO DUMMY-RECORD IC1144.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1144.2 +029400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1144.2 +029500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1144.2 +029600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1144.2 +029700 MOVE DUMMY-HOLD TO DUMMY-RECORD IC1144.2 +029800 MOVE ZERO TO RECORD-COUNT. IC1144.2 +029900 PERFORM WRT-LN. IC1144.2 +030000 WRT-LN. IC1144.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1144.2 +030200 MOVE SPACE TO DUMMY-RECORD. IC1144.2 +030300 BLANK-LINE-PRINT. IC1144.2 +030400 PERFORM WRT-LN. IC1144.2 +030500 FAIL-ROUTINE. IC1144.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1144.2 +030700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1144.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1144.2 +030900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1144.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. IC1144.2 +031200 GO TO FAIL-ROUTINE-EX. IC1144.2 +031300 FAIL-ROUTINE-WRITE. IC1144.2 +031400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1144.2 +031500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1144.2 +031600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1144.2 +031700 MOVE SPACES TO COR-ANSI-REFERENCE. IC1144.2 +031800 FAIL-ROUTINE-EX. EXIT. IC1144.2 +031900 BAIL-OUT. IC1144.2 +032000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1144.2 +032100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1144.2 +032200 BAIL-OUT-WRITE. IC1144.2 +032300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1144.2 +032400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1144.2 +032500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1144.2 +032600 MOVE SPACES TO INF-ANSI-REFERENCE. IC1144.2 +032700 BAIL-OUT-EX. EXIT. IC1144.2 +032800 CCVS1-EXIT. IC1144.2 +032900 EXIT. IC1144.2 +033000 LINK-TEST-10. IC1144.2 +033100 MOVE 1 TO CALL-FLAG. IC1144.2 +033200* IC1144.2 +033300* THIS TEST CALLS IC115 WHICH CREATES THE FILE SQ-FS3. IC1144.2 +033400* THIS FILE IS A MASS STORAGE SEQUENTIAL FILE WITH 120 IC1144.2 +033500* CHARACTER RECORDS. THERE ARE 649 RECORDS IN THE FILE. IC1144.2 +033600* IC1144.2 +033700 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +033800 FILE-REC-SQ-FS3. IC1144.2 +033900 IF COUNT-OF-RECORDS EQUAL TO 649 IC1144.2 +034000 GO TO LINK-PASS-10. IC1144.2 +034100 LINK-FAIL-10. IC1144.2 +034200 PERFORM FAIL. IC1144.2 +034300 MOVE "FILE NOT CREATED IN IC115" TO RE-MARK. IC1144.2 +034400 MOVE "RECS WRITTEN =" TO COMPUTED-A. IC1144.2 +034500 GO TO LINK-WRITE-10. IC1144.2 +034600 LINK-PASS-10. IC1144.2 +034700 PERFORM PASS. IC1144.2 +034800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IC1144.2 +034900 LINK-WRITE-10. IC1144.2 +035000 MOVE "LINK-TEST-10" TO PAR-NAME. IC1144.2 +035100 MOVE "CREATE FILE SQ-FS3" TO FEATURE. IC1144.2 +035200 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IC1144.2 +035300 PERFORM PRINT-DETAIL. IC1144.2 +035400 LINK-TEST-11. IC1144.2 +035500 MOVE 2 TO CALL-FLAG. IC1144.2 +035600 MOVE ZERO TO COUNT-OF-RECORDS RECORDS-IN-ERROR IC1144.2 +035700 ERROR-FLAG EOF-FLAG. IC1144.2 +035800 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +035900 FILE-REC-SQ-FS3. IC1144.2 +036000 IF ERROR-FLAG EQUAL TO ZERO IC1144.2 +036100 GO TO LINK-PASS-11. IC1144.2 +036200 IF COUNT-OF-RECORDS GREATER THAN 649 IC1144.2 +036300 MOVE "MORE THAN 649 RECORDS" TO RE-MARK IC1144.2 +036400 GO TO LINK-FAIL-11. IC1144.2 +036500 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. IC1144.2 +036600 LINK-FAIL-11. IC1144.2 +036700 MOVE "RECORDS-IN-ERROR =" TO COMPUTED-A. IC1144.2 +036800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IC1144.2 +036900 GO TO LINK-WRITE-11. IC1144.2 +037000 LINK-PASS-11. IC1144.2 +037100 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IC1144.2 +037200 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IC1144.2 +037300 PERFORM PASS. IC1144.2 +037400 LINK-WRITE-11. IC1144.2 +037500 MOVE "LINK-TEST-11" TO PAR-NAME. IC1144.2 +037600 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. IC1144.2 +037700 PERFORM PRINT-DETAIL. IC1144.2 +037800 LINK-INIT-12. IC1144.2 +037900 MOVE 3 TO CALL-FLAG. IC1144.2 +038000 MOVE ZERO TO COUNT-OF-RECORDS RECORDS-IN-ERROR IC1144.2 +038100 ERROR-FLAG EOF-FLAG. IC1144.2 +038200 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +038300 FILE-REC-SQ-FS3. IC1144.2 +038400* CALL IC115 TO OPEN FILE SQ-FS3. IC1144.2 +038500 MOVE 4 TO CALL-FLAG. IC1144.2 +038600 LINK-TEST-12. IC1144.2 +038700 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +038800 FILE-REC-SQ-FS3. IC1144.2 +038900* IC1144.2 +039000* THIS TEST REPEATEDLY CALLS IC115 TO READ THE FILE SQ-FS3.IC1144.2 +039100* THE CONTENTS OF EACH DATA RECORD IS CHECKED FOR VALID DATA. IC1144.2 +039200* IC1144.2 +039300 IF EOF-FLAG EQUAL TO 1 IC1144.2 +039400 GO TO LINK-TEST-12-01. IC1144.2 +039500 ADD 1 TO COUNT-OF-RECORDS. IC1144.2 +039600 IF COUNT-OF-RECORDS GREATER THAN 649 IC1144.2 +039700 GO TO LINK-FAIL-12-02. IC1144.2 +039800 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER IC1144.2 +039900 GO TO LINK-FAIL-12-01. IC1144.2 +040000 IF REELUNIT-NUMBER-GROUP NOT EQUAL TO "/0" IC1144.2 +040100 GO TO LINK-FAIL-12-01. IC1144.2 +040200 IF XFILE-NAME NOT EQUAL TO "SQ-FS3" IC1144.2 +040300 GO TO LINK-FAIL-12-01. IC1144.2 +040400 IF XRECORD-NAME NOT EQUAL TO "R1-F-G" IC1144.2 +040500 GO TO LINK-FAIL-12-01. IC1144.2 +040600 IF XLABEL-TYPE NOT EQUAL TO "S" IC1144.2 +040700 GO TO LINK-FAIL-12-01. IC1144.2 +040800 GO TO LINK-TEST-12. IC1144.2 +040900 LINK-FAIL-12-01. IC1144.2 +041000 ADD 1 TO RECORDS-IN-ERROR. IC1144.2 +041100 MOVE 1 TO ERROR-FLAG. IC1144.2 +041200 GO TO LINK-TEST-12. IC1144.2 +041300 LINK-FAIL-12-02. IC1144.2 +041400 MOVE "MORE THAN 649 RECORDS" TO RE-MARK. IC1144.2 +041500 GO TO LINK-FAIL-12. IC1144.2 +041600 LINK-TEST-12-01. IC1144.2 +041700 IF COUNT-OF-RECORDS LESS THAN 649 IC1144.2 +041800 GO TO LINK-FAIL-12-04. IC1144.2 +041900 IF ERROR-FLAG EQUAL TO ZERO IC1144.2 +042000 GO TO LINK-PASS-12. IC1144.2 +042100 LINK-FAIL-12-03. IC1144.2 +042200 MOVE "RECORDS-IN-ERROR =" TO COMPUTED-A. IC1144.2 +042300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IC1144.2 +042400 LINK-FAIL-12. IC1144.2 +042500 PERFORM FAIL. IC1144.2 +042600 GO TO LINK-WRITE-12. IC1144.2 +042700 LINK-FAIL-12-04. IC1144.2 +042800 MOVE "UNEXPECTED EOF" TO RE-MARK. IC1144.2 +042900 MOVE "RECORDS READ =" TO COMPUTED-A. IC1144.2 +043000 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IC1144.2 +043100 GO TO LINK-FAIL-12. IC1144.2 +043200 LINK-PASS-12. IC1144.2 +043300 PERFORM PASS. IC1144.2 +043400 LINK-WRITE-12. IC1144.2 +043500 MOVE "LINK-TEST-12" TO PAR-NAME. IC1144.2 +043600 MOVE "READ IN SUBPRGM" TO FEATURE. IC1144.2 +043700 PERFORM PRINT-DETAIL. IC1144.2 +043800 LINK-CLOSE-12. IC1144.2 +043900 MOVE 5 TO CALL-FLAG. IC1144.2 +044000 CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +044100 FILE-REC-SQ-FS3. IC1144.2 +044200 TERMINATE-ROUTINE. IC1144.2 +044300 EXIT. IC1144.2 +044400*XILE-DUMP SECTION. IC1144.2 +044500*XILE-DUMP-INIT. IC1144.2 +044600*X MOVE 3 TO CALL-FLAG. IC1144.2 +044700*X MOVE ZERO TO EOF-FLAG COUNT-OF-RECORDS. IC1144.2 +044800*X CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +044900*X FILE-REC-SQ-FS3. IC1144.2 +045000*X MOVE 4 TO CALL-FLAG. IC1144.2 +045100*XILE-3-DUMP. IC1144.2 +045200*X CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +045300*X FILE-REC-SQ-FS3. IC1144.2 +045400*X IF EOF-FLAG EQUAL TO 1 IC1144.2 +045500*X GO TO FILE-3-DUMP-END. IC1144.2 +045600*X ADD 1 TO COUNT-OF-RECORDS. IC1144.2 +045700*X IF COUNT-OF-RECORDS EQUAL TO 650 IC1144.2 +045800*X PERFORM BLANK-LINE-PRINT 5 TIMES. IC1144.2 +045900*X MOVE FILE-REC-SQ-FS3 TO DUMMY-RECORD. IC1144.2 +046000*X PERFORM WRITE-LINE. IC1144.2 +046100*X IF COUNT-OF-RECORDS LESS THAN 669 IC1144.2 +046200*X GO TO FILE-3-DUMP. IC1144.2 +046300*XILE-3-DUMP-END. IC1144.2 +046400*X MOVE 5 TO CALL-FLAG. IC1144.2 +046500*X CALL "IC115A" USING GROUP-LINKAGE-VARIABLES IC1144.2 +046600*X FILE-REC-SQ-FS3. IC1144.2 +046700*XILE-3-DUMP-EXIT. IC1144.2 +046800*X EXIT. IC1144.2 +046900 CCVS-EXIT SECTION. IC1144.2 +047000 CCVS-999999. IC1144.2 +047100 GO TO CLOSE-FILES. IC1144.2 diff --git a/tests/cobol85/IC/IC116M.CBL b/tests/cobol85/IC/IC116M.CBL new file mode 100755 index 00000000..7056f54b --- /dev/null +++ b/tests/cobol85/IC/IC116M.CBL @@ -0,0 +1,343 @@ +000100 IDENTIFICATION DIVISION. IC1164.2 +000200 PROGRAM-ID. IC1164.2 +000300 IC116M. IC1164.2 +000400**************************************************************** IC1164.2 +000500* * IC1164.2 +000600* VALIDATION FOR:- * IC1164.2 +000700* * IC1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1164.2 +000900* * IC1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1164.2 +001100* * IC1164.2 +001200**************************************************************** IC1164.2 +001300* * IC1164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1164.2 +001500* * IC1164.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1164.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1164.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1164.2 +001900* * IC1164.2 +002000**************************************************************** IC1164.2 +002100* IC1164.2 +002200* THE PROGRAM IC116 AND THE SUBPROGRAMS IC117 AND IC118 IC1164.2 +002300* TEST THE CALL STATEMENT WITHOUT THE OPTIONAL USING PHRASE IC1164.2 +002400* AND THE PROCEDURE DIVISION HEADER WITHOUT THE OPTIONAL IC1164.2 +002500* USING PHRASE IN THE SUBPROGRAMS. THE MAIN PROGRAM IC116 IC1164.2 +002600* CALLS THE SUBPROGRAM IC117 WHICH IN TURN CALLS THE SUBPRO- IC1164.2 +002700* GRAM IC118. THE SUBPROGRAMS CONTAIN DISPLAY STATEMENTS WHICHIC1164.2 +002800* SHOW THE EXECUTION SEQUENCE FOR THE PROGRAMS. IC1164.2 +002900* IC1164.2 +003000* REFERENCE - AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE IC1164.2 +003100* COBOL, X3.23-1974 IC1164.2 +003200* SECTION XII, INTER-PROGRAM COMMUNICATION MODULE. IC1164.2 +003300* IC1164.2 +003400******************************************************************IC1164.2 +003500 ENVIRONMENT DIVISION. IC1164.2 +003600 CONFIGURATION SECTION. IC1164.2 +003700 SOURCE-COMPUTER. IC1164.2 +003800 Linux. IC1164.2 +003900 OBJECT-COMPUTER. IC1164.2 +004000 Linux. IC1164.2 +004100 INPUT-OUTPUT SECTION. IC1164.2 +004200 FILE-CONTROL. IC1164.2 +004300 SELECT PRINT-FILE ASSIGN TO IC1164.2 +004400 "report.log". IC1164.2 +004500 DATA DIVISION. IC1164.2 +004600 FILE SECTION. IC1164.2 +004700 FD PRINT-FILE. IC1164.2 +004800 01 PRINT-REC PICTURE X(120). IC1164.2 +004900 01 DUMMY-RECORD PICTURE X(120). IC1164.2 +005000 WORKING-STORAGE SECTION. IC1164.2 +005100 01 SUMMARY-MESSAGE-1. IC1164.2 +005200 02 FILLER PICTURE X(10) VALUE SPACE. IC1164.2 +005300 02 FILLER PICTURE X(46) IC1164.2 +005400 VALUE "THERE SHOULD BE THREE DISPLAY MESSAGES ON THE ". IC1164.2 +005500 02 FILLER PICTURE X(23) IC1164.2 +005600 VALUE "DEFAULT DISPLAY DEVICE.". IC1164.2 +005700 01 SUMMARY-MESSAGE-2. IC1164.2 +005800 02 FILLER PICTURE X(10) VALUE SPACE. IC1164.2 +005900 02 FILLER PICTURE X(44) IC1164.2 +006000 VALUE "IF THERE ARE NOT THREE DISPLAY MESSAGES THE ". IC1164.2 +006100 02 FILLER PICTURE X(33) IC1164.2 +006200 VALUE "OPTIONAL USING PHRASE TESTS FAIL.". IC1164.2 +006300 01 TEST-RESULTS. IC1164.2 +006400 02 FILLER PIC X VALUE SPACE. IC1164.2 +006500 02 FEATURE PIC X(20) VALUE SPACE. IC1164.2 +006600 02 FILLER PIC X VALUE SPACE. IC1164.2 +006700 02 P-OR-F PIC X(5) VALUE SPACE. IC1164.2 +006800 02 FILLER PIC X VALUE SPACE. IC1164.2 +006900 02 PAR-NAME. IC1164.2 +007000 03 FILLER PIC X(19) VALUE SPACE. IC1164.2 +007100 03 PARDOT-X PIC X VALUE SPACE. IC1164.2 +007200 03 DOTVALUE PIC 99 VALUE ZERO. IC1164.2 +007300 02 FILLER PIC X(8) VALUE SPACE. IC1164.2 +007400 02 RE-MARK PIC X(61). IC1164.2 +007500 01 TEST-COMPUTED. IC1164.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IC1164.2 +007700 02 FILLER PIC X(17) VALUE IC1164.2 +007800 " COMPUTED=". IC1164.2 +007900 02 COMPUTED-X. IC1164.2 +008000 03 COMPUTED-A PIC X(20) VALUE SPACE. IC1164.2 +008100 03 COMPUTED-N REDEFINES COMPUTED-A IC1164.2 +008200 PIC -9(9).9(9). IC1164.2 +008300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC1164.2 +008400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC1164.2 +008500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC1164.2 +008600 03 CM-18V0 REDEFINES COMPUTED-A. IC1164.2 +008700 04 COMPUTED-18V0 PIC -9(18). IC1164.2 +008800 04 FILLER PIC X. IC1164.2 +008900 03 FILLER PIC X(50) VALUE SPACE. IC1164.2 +009000 01 TEST-CORRECT. IC1164.2 +009100 02 FILLER PIC X(30) VALUE SPACE. IC1164.2 +009200 02 FILLER PIC X(17) VALUE " CORRECT =". IC1164.2 +009300 02 CORRECT-X. IC1164.2 +009400 03 CORRECT-A PIC X(20) VALUE SPACE. IC1164.2 +009500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC1164.2 +009600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC1164.2 +009700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC1164.2 +009800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC1164.2 +009900 03 CR-18V0 REDEFINES CORRECT-A. IC1164.2 +010000 04 CORRECT-18V0 PIC -9(18). IC1164.2 +010100 04 FILLER PIC X. IC1164.2 +010200 03 FILLER PIC X(2) VALUE SPACE. IC1164.2 +010300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC1164.2 +010400 01 CCVS-C-1. IC1164.2 +010500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC1164.2 +010600- "SS PARAGRAPH-NAME IC1164.2 +010700- " REMARKS". IC1164.2 +010800 02 FILLER PIC X(20) VALUE SPACE. IC1164.2 +010900 01 CCVS-C-2. IC1164.2 +011000 02 FILLER PIC X VALUE SPACE. IC1164.2 +011100 02 FILLER PIC X(6) VALUE "TESTED". IC1164.2 +011200 02 FILLER PIC X(15) VALUE SPACE. IC1164.2 +011300 02 FILLER PIC X(4) VALUE "FAIL". IC1164.2 +011400 02 FILLER PIC X(94) VALUE SPACE. IC1164.2 +011500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC1164.2 +011600 01 REC-CT PIC 99 VALUE ZERO. IC1164.2 +011700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC1164.2 +011800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC1164.2 +011900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC1164.2 +012000 01 PASS-COUNTER PIC 999 VALUE ZERO. IC1164.2 +012100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC1164.2 +012200 01 ERROR-HOLD PIC 999 VALUE ZERO. IC1164.2 +012300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC1164.2 +012400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC1164.2 +012500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC1164.2 +012600 01 CCVS-H-1. IC1164.2 +012700 02 FILLER PIC X(39) VALUE SPACES. IC1164.2 +012800 02 FILLER PIC X(42) VALUE IC1164.2 +012900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC1164.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC1164.2 +013100 01 CCVS-H-2A. IC1164.2 +013200 02 FILLER PIC X(40) VALUE SPACE. IC1164.2 +013300 02 FILLER PIC X(7) VALUE "CCVS85 ". IC1164.2 +013400 02 FILLER PIC XXXX VALUE IC1164.2 +013500 "4.2 ". IC1164.2 +013600 02 FILLER PIC X(28) VALUE IC1164.2 +013700 " COPY - NOT FOR DISTRIBUTION". IC1164.2 +013800 02 FILLER PIC X(41) VALUE SPACE. IC1164.2 +013900 IC1164.2 +014000 01 CCVS-H-2B. IC1164.2 +014100 02 FILLER PIC X(15) VALUE IC1164.2 +014200 "TEST RESULT OF ". IC1164.2 +014300 02 TEST-ID PIC X(9). IC1164.2 +014400 02 FILLER PIC X(4) VALUE IC1164.2 +014500 " IN ". IC1164.2 +014600 02 FILLER PIC X(12) VALUE IC1164.2 +014700 " HIGH ". IC1164.2 +014800 02 FILLER PIC X(22) VALUE IC1164.2 +014900 " LEVEL VALIDATION FOR ". IC1164.2 +015000 02 FILLER PIC X(58) VALUE IC1164.2 +015100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1164.2 +015200 01 CCVS-H-3. IC1164.2 +015300 02 FILLER PIC X(34) VALUE IC1164.2 +015400 " FOR OFFICIAL USE ONLY ". IC1164.2 +015500 02 FILLER PIC X(58) VALUE IC1164.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1164.2 +015700 02 FILLER PIC X(28) VALUE IC1164.2 +015800 " COPYRIGHT 1985 ". IC1164.2 +015900 01 CCVS-E-1. IC1164.2 +016000 02 FILLER PIC X(52) VALUE SPACE. IC1164.2 +016100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC1164.2 +016200 02 ID-AGAIN PIC X(9). IC1164.2 +016300 02 FILLER PIC X(45) VALUE SPACES. IC1164.2 +016400 01 CCVS-E-2. IC1164.2 +016500 02 FILLER PIC X(31) VALUE SPACE. IC1164.2 +016600 02 FILLER PIC X(21) VALUE SPACE. IC1164.2 +016700 02 CCVS-E-2-2. IC1164.2 +016800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC1164.2 +016900 03 FILLER PIC X VALUE SPACE. IC1164.2 +017000 03 ENDER-DESC PIC X(44) VALUE IC1164.2 +017100 "ERRORS ENCOUNTERED". IC1164.2 +017200 01 CCVS-E-3. IC1164.2 +017300 02 FILLER PIC X(22) VALUE IC1164.2 +017400 " FOR OFFICIAL USE ONLY". IC1164.2 +017500 02 FILLER PIC X(12) VALUE SPACE. IC1164.2 +017600 02 FILLER PIC X(58) VALUE IC1164.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1164.2 +017800 02 FILLER PIC X(13) VALUE SPACE. IC1164.2 +017900 02 FILLER PIC X(15) VALUE IC1164.2 +018000 " COPYRIGHT 1985". IC1164.2 +018100 01 CCVS-E-4. IC1164.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC1164.2 +018300 02 FILLER PIC X(4) VALUE " OF ". IC1164.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC1164.2 +018500 02 FILLER PIC X(40) VALUE IC1164.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". IC1164.2 +018700 01 XXINFO. IC1164.2 +018800 02 FILLER PIC X(19) VALUE IC1164.2 +018900 "*** INFORMATION ***". IC1164.2 +019000 02 INFO-TEXT. IC1164.2 +019100 04 FILLER PIC X(8) VALUE SPACE. IC1164.2 +019200 04 XXCOMPUTED PIC X(20). IC1164.2 +019300 04 FILLER PIC X(5) VALUE SPACE. IC1164.2 +019400 04 XXCORRECT PIC X(20). IC1164.2 +019500 02 INF-ANSI-REFERENCE PIC X(48). IC1164.2 +019600 01 HYPHEN-LINE. IC1164.2 +019700 02 FILLER PIC IS X VALUE IS SPACE. IC1164.2 +019800 02 FILLER PIC IS X(65) VALUE IS "************************IC1164.2 +019900- "*****************************************". IC1164.2 +020000 02 FILLER PIC IS X(54) VALUE IS "************************IC1164.2 +020100- "******************************". IC1164.2 +020200 01 CCVS-PGM-ID PIC X(9) VALUE IC1164.2 +020300 "IC116M". IC1164.2 +020400 PROCEDURE DIVISION. IC1164.2 +020500 CCVS1 SECTION. IC1164.2 +020600 OPEN-FILES. IC1164.2 +020700 OPEN OUTPUT PRINT-FILE. IC1164.2 +020800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC1164.2 +020900 MOVE SPACE TO TEST-RESULTS. IC1164.2 +021000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC1164.2 +021100 GO TO CCVS1-EXIT. IC1164.2 +021200 CLOSE-FILES. IC1164.2 +021300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC1164.2 +021400 TERMINATE-CCVS. IC1164.2 +021500*S EXIT PROGRAM. IC1164.2 +021600*SERMINATE-CALL. IC1164.2 +021700 STOP RUN. IC1164.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC1164.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC1164.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC1164.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC1164.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. IC1164.2 +022300 PRINT-DETAIL. IC1164.2 +022400 IF REC-CT NOT EQUAL TO ZERO IC1164.2 +022500 MOVE "." TO PARDOT-X IC1164.2 +022600 MOVE REC-CT TO DOTVALUE. IC1164.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC1164.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC1164.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC1164.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC1164.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC1164.2 +023200 MOVE SPACE TO CORRECT-X. IC1164.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC1164.2 +023400 MOVE SPACE TO RE-MARK. IC1164.2 +023500 HEAD-ROUTINE. IC1164.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1164.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC1164.2 +024000 COLUMN-NAMES-ROUTINE. IC1164.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +024400 END-ROUTINE. IC1164.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC1164.2 +024600 END-RTN-EXIT. IC1164.2 +024700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +024800 END-ROUTINE-1. IC1164.2 +024900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC1164.2 +025000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC1164.2 +025100 ADD PASS-COUNTER TO ERROR-HOLD. IC1164.2 +025200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC1164.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. IC1164.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. IC1164.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. IC1164.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC1164.2 +025700 END-ROUTINE-12. IC1164.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC1164.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO IC1164.2 +026000 MOVE "NO " TO ERROR-TOTAL IC1164.2 +026100 ELSE IC1164.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC1164.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. IC1164.2 +026400 PERFORM WRITE-LINE. IC1164.2 +026500 END-ROUTINE-13. IC1164.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO IC1164.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE IC1164.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC1164.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC1164.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO IC1164.2 +027200 MOVE "NO " TO ERROR-TOTAL IC1164.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC1164.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC1164.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC1164.2 +027700 WRITE-LINE. IC1164.2 +027800 ADD 1 TO RECORD-COUNT. IC1164.2 +027900 IF RECORD-COUNT GREATER 50 IC1164.2 +028000 MOVE DUMMY-RECORD TO DUMMY-HOLD IC1164.2 +028100 MOVE SPACE TO DUMMY-RECORD IC1164.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC1164.2 +028300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC1164.2 +028400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC1164.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC1164.2 +028600 MOVE DUMMY-HOLD TO DUMMY-RECORD IC1164.2 +028700 MOVE ZERO TO RECORD-COUNT. IC1164.2 +028800 PERFORM WRT-LN. IC1164.2 +028900 WRT-LN. IC1164.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC1164.2 +029100 MOVE SPACE TO DUMMY-RECORD. IC1164.2 +029200 BLANK-LINE-PRINT. IC1164.2 +029300 PERFORM WRT-LN. IC1164.2 +029400 FAIL-ROUTINE. IC1164.2 +029500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC1164.2 +029600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC1164.2 +029700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1164.2 +029800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC1164.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. IC1164.2 +030100 GO TO FAIL-ROUTINE-EX. IC1164.2 +030200 FAIL-ROUTINE-WRITE. IC1164.2 +030300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC1164.2 +030400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC1164.2 +030500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC1164.2 +030600 MOVE SPACES TO COR-ANSI-REFERENCE. IC1164.2 +030700 FAIL-ROUTINE-EX. EXIT. IC1164.2 +030800 BAIL-OUT. IC1164.2 +030900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC1164.2 +031000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC1164.2 +031100 BAIL-OUT-WRITE. IC1164.2 +031200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC1164.2 +031300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC1164.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC1164.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IC1164.2 +031600 BAIL-OUT-EX. EXIT. IC1164.2 +031700 CCVS1-EXIT. IC1164.2 +031800 EXIT. IC1164.2 +031900 SECT-IC116-0001 SECTION. IC1164.2 +032000 USNG-TEST-01. IC1164.2 +032100 CALL "IC117M". IC1164.2 +032200* IC1164.2 +032300* THIS TEST CONTAINS A CALL STATEMENT WITHOUT THE OPTIONAL IC1164.2 +032400* USING PHRASE. IC1164.2 +032500* IC1164.2 +032600 USNG-WRITE-01. IC1164.2 +032700 PERFORM BLANK-LINE-PRINT. IC1164.2 +032800 MOVE "CALL WITHOUT USING" TO FEATURE. IC1164.2 +032900 MOVE "USNG-TEST-01" TO PAR-NAME. IC1164.2 +033000 PERFORM PASS. IC1164.2 +033100 PERFORM PRINT-DETAIL. IC1164.2 +033200 SUMMARY-REMARKS. IC1164.2 +033300 PERFORM BLANK-LINE-PRINT. IC1164.2 +033400 MOVE SUMMARY-MESSAGE-1 TO DUMMY-RECORD. IC1164.2 +033500 PERFORM WRITE-LINE. IC1164.2 +033600 MOVE SUMMARY-MESSAGE-2 TO DUMMY-RECORD. IC1164.2 +033700 PERFORM WRITE-LINE. IC1164.2 +033800 PERFORM BLANK-LINE-PRINT. IC1164.2 +033900 IC116-EXIT. IC1164.2 +034000 EXIT. IC1164.2 +034100 CCVS-EXIT SECTION. IC1164.2 +034200 CCVS-999999. IC1164.2 +034300 GO TO CLOSE-FILES. IC1164.2 diff --git a/tests/cobol85/IC/IC201A.CBL b/tests/cobol85/IC/IC201A.CBL new file mode 100755 index 00000000..b4503a45 --- /dev/null +++ b/tests/cobol85/IC/IC201A.CBL @@ -0,0 +1,619 @@ +000100 IDENTIFICATION DIVISION. IC2014.2 +000200 PROGRAM-ID. IC2014.2 +000300 IC201A. IC2014.2 +000400**************************************************************** IC2014.2 +000500* * IC2014.2 +000600* VALIDATION FOR:- * IC2014.2 +000700* * IC2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2014.2 +000900* * IC2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2014.2 +001100* * IC2014.2 +001200**************************************************************** IC2014.2 +001300* * IC2014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2014.2 +001500* * IC2014.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2014.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2014.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2014.2 +001900* * IC2014.2 +002000**************************************************************** IC2014.2 +002100* THE PROGRAM IC201 TESTS THE CALL STATEMENT WITH AN IC2014.2 +002200* IDENTIFIER AS AN OPERAND, AND FOUR OPERANDS IN THE IC2014.2 +002300* USING PHRASE. THE REPETITION OF A DATA-NAME IN THE IC2014.2 +002400* USING PHRASE IS TESTED, AND THE USE OF THE ON OVERFLOW IC2014.2 +002500* PHRASE IN A CALL STATEMENT IS SYNTACTICALLY CHECKED IC2014.2 +002600* IN THE PROGRAM. IC2014.2 +002700**************************************************************** IC2014.2 +002800 ENVIRONMENT DIVISION. IC2014.2 +002900 CONFIGURATION SECTION. IC2014.2 +003000 SOURCE-COMPUTER. IC2014.2 +003100 Linux. IC2014.2 +003200 OBJECT-COMPUTER. IC2014.2 +003300 Linux. IC2014.2 +003400 INPUT-OUTPUT SECTION. IC2014.2 +003500 FILE-CONTROL. IC2014.2 +003600 SELECT PRINT-FILE ASSIGN TO IC2014.2 +003700 "report.log". IC2014.2 +003800 DATA DIVISION. IC2014.2 +003900 FILE SECTION. IC2014.2 +004000 FD PRINT-FILE. IC2014.2 +004100 01 PRINT-REC PICTURE X(120). IC2014.2 +004200 01 DUMMY-RECORD PICTURE X(120). IC2014.2 +004300 WORKING-STORAGE SECTION. IC2014.2 +004400 77 DN1 PICTURE S99 VALUE ZERO. IC2014.2 +004500 77 DN3 PICTURE S99. IC2014.2 +004600 77 ID1 PICTURE X(6) VALUE "IC202A". IC2014.2 +004700 77 ID2 PICTURE X(6). IC2014.2 +004800 77 DN2 PICTURE S99 IC2014.2 +004900 USAGE COMPUTATIONAL, VALUE ZERO. IC2014.2 +005000 77 DN4 PICTURE S99 IC2014.2 +005100 USAGE IS COMPUTATIONAL. IC2014.2 +005200 77 CALL-COUNT PIC S99. IC2014.2 +005300 77 FAIL-FLAG PIC 9. IC2014.2 +005400 01 TEST-RESULTS. IC2014.2 +005500 02 FILLER PIC X VALUE SPACE. IC2014.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IC2014.2 +005700 02 FILLER PIC X VALUE SPACE. IC2014.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IC2014.2 +005900 02 FILLER PIC X VALUE SPACE. IC2014.2 +006000 02 PAR-NAME. IC2014.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IC2014.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IC2014.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IC2014.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IC2014.2 +006500 02 RE-MARK PIC X(61). IC2014.2 +006600 01 TEST-COMPUTED. IC2014.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IC2014.2 +006800 02 FILLER PIC X(17) VALUE IC2014.2 +006900 " COMPUTED=". IC2014.2 +007000 02 COMPUTED-X. IC2014.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2014.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IC2014.2 +007300 PIC -9(9).9(9). IC2014.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2014.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2014.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2014.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IC2014.2 +007800 04 COMPUTED-18V0 PIC -9(18). IC2014.2 +007900 04 FILLER PIC X. IC2014.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IC2014.2 +008100 01 TEST-CORRECT. IC2014.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IC2014.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IC2014.2 +008400 02 CORRECT-X. IC2014.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IC2014.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2014.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2014.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2014.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2014.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IC2014.2 +009100 04 CORRECT-18V0 PIC -9(18). IC2014.2 +009200 04 FILLER PIC X. IC2014.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IC2014.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2014.2 +009500 01 CCVS-C-1. IC2014.2 +009600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2014.2 +009700- "SS PARAGRAPH-NAME IC2014.2 +009800- " REMARKS". IC2014.2 +009900 02 FILLER PIC X(20) VALUE SPACE. IC2014.2 +010000 01 CCVS-C-2. IC2014.2 +010100 02 FILLER PIC X VALUE SPACE. IC2014.2 +010200 02 FILLER PIC X(6) VALUE "TESTED". IC2014.2 +010300 02 FILLER PIC X(15) VALUE SPACE. IC2014.2 +010400 02 FILLER PIC X(4) VALUE "FAIL". IC2014.2 +010500 02 FILLER PIC X(94) VALUE SPACE. IC2014.2 +010600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2014.2 +010700 01 REC-CT PIC 99 VALUE ZERO. IC2014.2 +010800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2014.2 +010900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2014.2 +011000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2014.2 +011100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2014.2 +011200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2014.2 +011300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2014.2 +011400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2014.2 +011500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2014.2 +011600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2014.2 +011700 01 CCVS-H-1. IC2014.2 +011800 02 FILLER PIC X(39) VALUE SPACES. IC2014.2 +011900 02 FILLER PIC X(42) VALUE IC2014.2 +012000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2014.2 +012100 02 FILLER PIC X(39) VALUE SPACES. IC2014.2 +012200 01 CCVS-H-2A. IC2014.2 +012300 02 FILLER PIC X(40) VALUE SPACE. IC2014.2 +012400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2014.2 +012500 02 FILLER PIC XXXX VALUE IC2014.2 +012600 "4.2 ". IC2014.2 +012700 02 FILLER PIC X(28) VALUE IC2014.2 +012800 " COPY - NOT FOR DISTRIBUTION". IC2014.2 +012900 02 FILLER PIC X(41) VALUE SPACE. IC2014.2 +013000 IC2014.2 +013100 01 CCVS-H-2B. IC2014.2 +013200 02 FILLER PIC X(15) VALUE IC2014.2 +013300 "TEST RESULT OF ". IC2014.2 +013400 02 TEST-ID PIC X(9). IC2014.2 +013500 02 FILLER PIC X(4) VALUE IC2014.2 +013600 " IN ". IC2014.2 +013700 02 FILLER PIC X(12) VALUE IC2014.2 +013800 " HIGH ". IC2014.2 +013900 02 FILLER PIC X(22) VALUE IC2014.2 +014000 " LEVEL VALIDATION FOR ". IC2014.2 +014100 02 FILLER PIC X(58) VALUE IC2014.2 +014200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2014.2 +014300 01 CCVS-H-3. IC2014.2 +014400 02 FILLER PIC X(34) VALUE IC2014.2 +014500 " FOR OFFICIAL USE ONLY ". IC2014.2 +014600 02 FILLER PIC X(58) VALUE IC2014.2 +014700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2014.2 +014800 02 FILLER PIC X(28) VALUE IC2014.2 +014900 " COPYRIGHT 1985 ". IC2014.2 +015000 01 CCVS-E-1. IC2014.2 +015100 02 FILLER PIC X(52) VALUE SPACE. IC2014.2 +015200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2014.2 +015300 02 ID-AGAIN PIC X(9). IC2014.2 +015400 02 FILLER PIC X(45) VALUE SPACES. IC2014.2 +015500 01 CCVS-E-2. IC2014.2 +015600 02 FILLER PIC X(31) VALUE SPACE. IC2014.2 +015700 02 FILLER PIC X(21) VALUE SPACE. IC2014.2 +015800 02 CCVS-E-2-2. IC2014.2 +015900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2014.2 +016000 03 FILLER PIC X VALUE SPACE. IC2014.2 +016100 03 ENDER-DESC PIC X(44) VALUE IC2014.2 +016200 "ERRORS ENCOUNTERED". IC2014.2 +016300 01 CCVS-E-3. IC2014.2 +016400 02 FILLER PIC X(22) VALUE IC2014.2 +016500 " FOR OFFICIAL USE ONLY". IC2014.2 +016600 02 FILLER PIC X(12) VALUE SPACE. IC2014.2 +016700 02 FILLER PIC X(58) VALUE IC2014.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2014.2 +016900 02 FILLER PIC X(13) VALUE SPACE. IC2014.2 +017000 02 FILLER PIC X(15) VALUE IC2014.2 +017100 " COPYRIGHT 1985". IC2014.2 +017200 01 CCVS-E-4. IC2014.2 +017300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2014.2 +017400 02 FILLER PIC X(4) VALUE " OF ". IC2014.2 +017500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2014.2 +017600 02 FILLER PIC X(40) VALUE IC2014.2 +017700 " TESTS WERE EXECUTED SUCCESSFULLY". IC2014.2 +017800 01 XXINFO. IC2014.2 +017900 02 FILLER PIC X(19) VALUE IC2014.2 +018000 "*** INFORMATION ***". IC2014.2 +018100 02 INFO-TEXT. IC2014.2 +018200 04 FILLER PIC X(8) VALUE SPACE. IC2014.2 +018300 04 XXCOMPUTED PIC X(20). IC2014.2 +018400 04 FILLER PIC X(5) VALUE SPACE. IC2014.2 +018500 04 XXCORRECT PIC X(20). IC2014.2 +018600 02 INF-ANSI-REFERENCE PIC X(48). IC2014.2 +018700 01 HYPHEN-LINE. IC2014.2 +018800 02 FILLER PIC IS X VALUE IS SPACE. IC2014.2 +018900 02 FILLER PIC IS X(65) VALUE IS "************************IC2014.2 +019000- "*****************************************". IC2014.2 +019100 02 FILLER PIC IS X(54) VALUE IS "************************IC2014.2 +019200- "******************************". IC2014.2 +019300 01 CCVS-PGM-ID PIC X(9) VALUE IC2014.2 +019400 "IC201A". IC2014.2 +019500 PROCEDURE DIVISION. IC2014.2 +019600 CCVS1 SECTION. IC2014.2 +019700 OPEN-FILES. IC2014.2 +019800 OPEN OUTPUT PRINT-FILE. IC2014.2 +019900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2014.2 +020000 MOVE SPACE TO TEST-RESULTS. IC2014.2 +020100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2014.2 +020200 GO TO CCVS1-EXIT. IC2014.2 +020300 CLOSE-FILES. IC2014.2 +020400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2014.2 +020500 TERMINATE-CCVS. IC2014.2 +020600*S EXIT PROGRAM. IC2014.2 +020700*SERMINATE-CALL. IC2014.2 +020800 STOP RUN. IC2014.2 +020900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2014.2 +021000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2014.2 +021100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2014.2 +021200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2014.2 +021300 MOVE "****TEST DELETED****" TO RE-MARK. IC2014.2 +021400 PRINT-DETAIL. IC2014.2 +021500 IF REC-CT NOT EQUAL TO ZERO IC2014.2 +021600 MOVE "." TO PARDOT-X IC2014.2 +021700 MOVE REC-CT TO DOTVALUE. IC2014.2 +021800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2014.2 +021900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2014.2 +022000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2014.2 +022100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2014.2 +022200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2014.2 +022300 MOVE SPACE TO CORRECT-X. IC2014.2 +022400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2014.2 +022500 MOVE SPACE TO RE-MARK. IC2014.2 +022600 HEAD-ROUTINE. IC2014.2 +022700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +022800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +022900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2014.2 +023000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2014.2 +023100 COLUMN-NAMES-ROUTINE. IC2014.2 +023200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +023300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +023500 END-ROUTINE. IC2014.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2014.2 +023700 END-RTN-EXIT. IC2014.2 +023800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +023900 END-ROUTINE-1. IC2014.2 +024000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2014.2 +024100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2014.2 +024200 ADD PASS-COUNTER TO ERROR-HOLD. IC2014.2 +024300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2014.2 +024400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2014.2 +024500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2014.2 +024600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2014.2 +024700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2014.2 +024800 END-ROUTINE-12. IC2014.2 +024900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2014.2 +025000 IF ERROR-COUNTER IS EQUAL TO ZERO IC2014.2 +025100 MOVE "NO " TO ERROR-TOTAL IC2014.2 +025200 ELSE IC2014.2 +025300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2014.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2014.2 +025500 PERFORM WRITE-LINE. IC2014.2 +025600 END-ROUTINE-13. IC2014.2 +025700 IF DELETE-COUNTER IS EQUAL TO ZERO IC2014.2 +025800 MOVE "NO " TO ERROR-TOTAL ELSE IC2014.2 +025900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2014.2 +026000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2014.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +026200 IF INSPECT-COUNTER EQUAL TO ZERO IC2014.2 +026300 MOVE "NO " TO ERROR-TOTAL IC2014.2 +026400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2014.2 +026500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2014.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +026700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2014.2 +026800 WRITE-LINE. IC2014.2 +026900 ADD 1 TO RECORD-COUNT. IC2014.2 +027000 IF RECORD-COUNT GREATER 50 IC2014.2 +027100 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2014.2 +027200 MOVE SPACE TO DUMMY-RECORD IC2014.2 +027300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2014.2 +027400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2014.2 +027500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2014.2 +027600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2014.2 +027700 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2014.2 +027800 MOVE ZERO TO RECORD-COUNT. IC2014.2 +027900 PERFORM WRT-LN. IC2014.2 +028000 WRT-LN. IC2014.2 +028100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2014.2 +028200 MOVE SPACE TO DUMMY-RECORD. IC2014.2 +028300 BLANK-LINE-PRINT. IC2014.2 +028400 PERFORM WRT-LN. IC2014.2 +028500 FAIL-ROUTINE. IC2014.2 +028600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2014.2 +028700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2014.2 +028800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2014.2 +028900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2014.2 +029000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +029100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2014.2 +029200 GO TO FAIL-ROUTINE-EX. IC2014.2 +029300 FAIL-ROUTINE-WRITE. IC2014.2 +029400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2014.2 +029500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2014.2 +029600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2014.2 +029700 MOVE SPACES TO COR-ANSI-REFERENCE. IC2014.2 +029800 FAIL-ROUTINE-EX. EXIT. IC2014.2 +029900 BAIL-OUT. IC2014.2 +030000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2014.2 +030100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2014.2 +030200 BAIL-OUT-WRITE. IC2014.2 +030300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2014.2 +030400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2014.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2014.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2014.2 +030700 BAIL-OUT-EX. EXIT. IC2014.2 +030800 CCVS1-EXIT. IC2014.2 +030900 EXIT. IC2014.2 +031000 SECT-IC201-0001 SECTION. IC2014.2 +031100 CALL-TEST-01. IC2014.2 +031200 MOVE "CALL-TEST-01" TO PAR-NAME. IC2014.2 +031300 MOVE "LEV 2 CALL STATEMENT" TO FEATURE. IC2014.2 +031400 MOVE 0 TO CALL-COUNT. IC2014.2 +031500* THIS TEST HAS CALL STATEMENTS WITH AN IDENTIFIER IC2014.2 +031600* CONTAINING THE NAME OF THE SUBPROGRAM TO BE CALLED. IC2014.2 +031700* CALL-TEST-01 CONTAINS THE BASIC LEVEL 2 CALL STATEMENT. IC2014.2 +031800* IF IT CANNOT BE COMPILED AND EXECUTED CORRECTLY, THERE IS IC2014.2 +031900* NO USE IN RUNNING THE LEVEL 2 IPC ROUTINES. IC2014.2 +032000 CALL-TEST-01-01. IC2014.2 +032100 MOVE 1 TO REC-CT. IC2014.2 +032200 MOVE ZERO TO DN3, DN4. IC2014.2 +032300 CALL "IC202A" USING DN1, DN2, DN3, DN4. IC2014.2 +032400 PERFORM CHECK-TEST-01. IC2014.2 +032500 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +032600 PERFORM PASS IC2014.2 +032700 GO TO CALL-WRITE-01-01. IC2014.2 +032800 CALL-FAIL-01-01. IC2014.2 +032900 PERFORM FAIL. IC2014.2 +033000 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +033100 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +033200 CALL-WRITE-01-01. IC2014.2 +033300 PERFORM PRINT-DETAIL. IC2014.2 +033400 CALL-TEST-01-02. IC2014.2 +033500 ADD 1 TO REC-CT. IC2014.2 +033600 MOVE ZERO TO DN3, DN4. IC2014.2 +033700 CALL ID1 USING DN1, DN2, DN3, DN4. IC2014.2 +033800 PERFORM CHECK-TEST-01. IC2014.2 +033900 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +034000 PERFORM PASS IC2014.2 +034100 GO TO CALL-WRITE-01-02. IC2014.2 +034200 CALL-FAIL-01-02. IC2014.2 +034300 PERFORM FAIL. IC2014.2 +034400 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +034500 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +034600 CALL-WRITE-01-02. IC2014.2 +034700 PERFORM PRINT-DETAIL. IC2014.2 +034800 CALL-TEST-01-03. IC2014.2 +034900 ADD 1 TO REC-CT. IC2014.2 +035000 MOVE ID1 TO ID2. IC2014.2 +035100 MOVE ZERO TO DN3, DN4. IC2014.2 +035200 CALL ID2 USING DN1 DN2 DN3 DN4. IC2014.2 +035300 PERFORM CHECK-TEST-01. IC2014.2 +035400 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +035500 PERFORM PASS IC2014.2 +035600 GO TO CALL-WRITE-01-03. IC2014.2 +035700 CALL-FAIL-01-03. IC2014.2 +035800 PERFORM FAIL. IC2014.2 +035900 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +036000 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +036100 CALL-WRITE-01-03. IC2014.2 +036200 PERFORM PRINT-DETAIL. IC2014.2 +036300 CALL-TEST-01-04. IC2014.2 +036400 ADD 1 TO REC-CT. IC2014.2 +036500 MOVE "IC202A" TO ID2. IC2014.2 +036600 MOVE ZERO TO DN3, DN4. IC2014.2 +036700 CALL ID2 USING DN1, DN2, DN3, DN4. IC2014.2 +036800 PERFORM CHECK-TEST-01. IC2014.2 +036900 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +037000 PERFORM PASS IC2014.2 +037100 GO TO CALL-WRITE-01-04. IC2014.2 +037200 CALL-FAIL-01-04. IC2014.2 +037300 PERFORM FAIL. IC2014.2 +037400 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +037500 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +037600 CALL-WRITE-01-04. IC2014.2 +037700 PERFORM PRINT-DETAIL. IC2014.2 +037800 CALL-TEST-02. IC2014.2 +037900 MOVE "CALL-TEST-02" TO PAR-NAME. IC2014.2 +038000 MOVE "DATA-NAME USED TWICE" TO FEATURE. IC2014.2 +038100* THIS TEST USES A DATA-NAME MORE THAN ONCE IN IC2014.2 +038200* A USING PHRASE OF A CALL STATEMENT. IC2014.2 +038300 CALL-TEST-02-01. IC2014.2 +038400 MOVE 1 TO REC-CT. IC2014.2 +038500 MOVE 1 TO DN1. IC2014.2 +038600 MOVE 0 TO DN2, DN3, DN4. IC2014.2 +038700 CALL "IC202A" USING DN1, DN2, DN1, DN4. IC2014.2 +038800 IF DN1 NOT EQUAL TO 2 IC2014.2 +038900 GO TO CALL-FAIL-02-01-1. IC2014.2 +039000 IF DN2 NOT EQUAL TO 0 IC2014.2 +039100 GO TO CALL-FAIL-02-01-2. IC2014.2 +039200 IF DN3 NOT EQUAL TO 0 IC2014.2 +039300 GO TO CALL-FAIL-02-01-3. IC2014.2 +039400 IF DN4 NOT EQUAL TO 5 IC2014.2 +039500 GO TO CALL-FAIL-02-01-4. IC2014.2 +039600 GO TO CALL-PASS-02-01. IC2014.2 +039700 CALL-DELETE-02-01. IC2014.2 +039800 PERFORM DE-LETE. IC2014.2 +039900 GO TO CALL-WRITE-02-01. IC2014.2 +040000 CALL-PASS-02-01. IC2014.2 +040100 PERFORM PASS. IC2014.2 +040200 GO TO CALL-WRITE-02-01. IC2014.2 +040300 CALL-FAIL-02-01-1. IC2014.2 +040400 MOVE DN1 TO COMPUTED-18V0. IC2014.2 +040500 MOVE 2 TO CORRECT-18V0. IC2014.2 +040600 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2014.2 +040700 GO TO CALL-FAIL-02-01. IC2014.2 +040800 CALL-FAIL-02-01-2. IC2014.2 +040900 MOVE DN2 TO COMPUTED-18V0. IC2014.2 +041000 MOVE 0 TO CORRECT-18V0. IC2014.2 +041100 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2014.2 +041200 GO TO CALL-FAIL-02-01. IC2014.2 +041300 CALL-FAIL-02-01-3. IC2014.2 +041400 MOVE DN3 TO COMPUTED-18V0. IC2014.2 +041500 MOVE ZERO TO CORRECT-18V0. IC2014.2 +041600 MOVE "DN3 VALUE CHANGED BY CALL" TO RE-MARK. IC2014.2 +041700 GO TO CALL-FAIL-02-01. IC2014.2 +041800 CALL-FAIL-02-01-4. IC2014.2 +041900 MOVE DN4 TO COMPUTED-18V0. IC2014.2 +042000 MOVE 5 TO CORRECT-18V0. IC2014.2 +042100 MOVE "ERROR IN DN4 VALUE RETURNED" TO RE-MARK. IC2014.2 +042200 CALL-FAIL-02-01. IC2014.2 +042300 PERFORM FAIL. IC2014.2 +042400 CALL-WRITE-02-01. IC2014.2 +042500 PERFORM PRINT-DETAIL. IC2014.2 +042600 CALL-TEST-02-02. IC2014.2 +042700 ADD 1 TO REC-CT. IC2014.2 +042800 MOVE 0 TO DN4, DN3, DN2, DN1. IC2014.2 +042900 CALL ID1 USING DN1 DN2 DN3 DN2. IC2014.2 +043000 IF DN1 NOT EQUAL TO 0 IC2014.2 +043100 GO TO CALL-FAIL-02-02-1. IC2014.2 +043200 IF DN2 NOT EQUAL TO 6 IC2014.2 +043300 GO TO CALL-FAIL-02-02-2. IC2014.2 +043400 IF DN3 NOT EQUAL TO 1 IC2014.2 +043500 GO TO CALL-FAIL-02-02-3. IC2014.2 +043600 IF DN4 NOT EQUAL TO 0 IC2014.2 +043700 GO TO CALL-FAIL-02-02-4. IC2014.2 +043800 GO TO CALL-PASS-02-02. IC2014.2 +043900 CALL-DELETE-02-02. IC2014.2 +044000 PERFORM DE-LETE. IC2014.2 +044100 GO TO CALL-WRITE-02-02. IC2014.2 +044200 CALL-PASS-02-02. IC2014.2 +044300 PERFORM PASS. IC2014.2 +044400 GO TO CALL-WRITE-02-02. IC2014.2 +044500 CALL-FAIL-02-02-1. IC2014.2 +044600 MOVE DN1 TO COMPUTED-18V0. IC2014.2 +044700 MOVE ZERO TO CORRECT-18V0. IC2014.2 +044800 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2014.2 +044900 GO TO CALL-FAIL-02-02. IC2014.2 +045000 CALL-FAIL-02-02-2. IC2014.2 +045100 MOVE DN2 TO COMPUTED-18V0. IC2014.2 +045200 MOVE 6 TO CORRECT-18V0. IC2014.2 +045300 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2014.2 +045400 GO TO CALL-FAIL-02-02. IC2014.2 +045500 CALL-FAIL-02-02-3. IC2014.2 +045600 MOVE DN3 TO COMPUTED-18V0. IC2014.2 +045700 MOVE 1 TO CORRECT-18V0. IC2014.2 +045800 MOVE "ERROR IN DN3 VALUE RETURNED" TO RE-MARK. IC2014.2 +045900 GO TO CALL-FAIL-02-02. IC2014.2 +046000 CALL-FAIL-02-02-4. IC2014.2 +046100 MOVE DN4 TO COMPUTED-18V0. IC2014.2 +046200 MOVE 0 TO CORRECT-18V0. IC2014.2 +046300 MOVE "DN4 VALUE CHANGED BY CALL" TO RE-MARK. IC2014.2 +046400 CALL-FAIL-02-02. IC2014.2 +046500 PERFORM FAIL. IC2014.2 +046600 CALL-WRITE-02-02. IC2014.2 +046700 PERFORM PRINT-DETAIL. IC2014.2 +046800 CALL-TEST-02-03. IC2014.2 +046900 ADD 1 TO REC-CT. IC2014.2 +047000 MOVE 0 TO DN4, DN3. IC2014.2 +047100 MOVE 10 TO DN2. IC2014.2 +047200 MOVE 25 TO DN1. IC2014.2 +047300 CALL ID1 USING DN1 DN2 DN1 DN2. IC2014.2 +047400 IF DN1 EQUAL TO 26 IC2014.2 +047500 GO TO CHECK-02-03-2. IC2014.2 +047600 GO TO CALL-FAIL-02-03-1. IC2014.2 +047700 CALL-DELETE-02-03. IC2014.2 +047800 PERFORM DE-LETE. IC2014.2 +047900 GO TO CALL-WRITE-02-03. IC2014.2 +048000 CALL-FAIL-02-03-1. IC2014.2 +048100 MOVE DN1 TO COMPUTED-18V0. IC2014.2 +048200 MOVE 26 TO CORRECT-18V0. IC2014.2 +048300 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2014.2 +048400 GO TO CALL-FAIL-02-03. IC2014.2 +048500 CHECK-02-03-2. IC2014.2 +048600 IF DN2 EQUAL TO 7 IC2014.2 +048700 GO TO CHECK-02-03-3. IC2014.2 +048800 CALL-FAIL-02-03-2. IC2014.2 +048900 MOVE DN2 TO COMPUTED-18V0. IC2014.2 +049000 MOVE 7 TO CORRECT-18V0. IC2014.2 +049100 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2014.2 +049200 GO TO CALL-FAIL-02-03. IC2014.2 +049300 CHECK-02-03-3. IC2014.2 +049400 IF DN3 EQUAL TO 0 IC2014.2 +049500 GO TO CHECK-02-03-4. IC2014.2 +049600 CALL-FAIL-02-03-3. IC2014.2 +049700 MOVE DN3 TO COMPUTED-18V0. IC2014.2 +049800 MOVE 0 TO CORRECT-18V0. IC2014.2 +049900 MOVE "DN3 VALUE CHANGED BY CALL" TO RE-MARK. IC2014.2 +050000 GO TO CALL-FAIL-02-03. IC2014.2 +050100 CHECK-02-03-4. IC2014.2 +050200 IF DN4 EQUAL TO 0 IC2014.2 +050300 GO TO CALL-PASS-02-03. IC2014.2 +050400 CALL-FAIL-02-03-4. IC2014.2 +050500 MOVE DN4 TO COMPUTED-18V0. IC2014.2 +050600 MOVE 0 TO CORRECT-18V0. IC2014.2 +050700 MOVE "DN4 VALUE CHANGED BY CALL" TO RE-MARK. IC2014.2 +050800 CALL-FAIL-02-03. IC2014.2 +050900 PERFORM FAIL. IC2014.2 +051000 GO TO CALL-WRITE-02-03. IC2014.2 +051100 CALL-PASS-02-03. IC2014.2 +051200 PERFORM PASS. IC2014.2 +051300 CALL-WRITE-02-03. IC2014.2 +051400 PERFORM PRINT-DETAIL. IC2014.2 +051500 CALL-TEST-03. IC2014.2 +051600* THIS TEST USES THE ON OVERFLOW PHRASE IN THE CALL IC2014.2 +051700* STATEMENT. THIS IS A SYNTACTICAL CHECK ONLY, THE ON IC2014.2 +051800* OVERFLOW CONDITION SHOULD NEVER OCCUR. IC2014.2 +051900 MOVE "CALL-TEST-03" TO PAR-NAME. IC2014.2 +052000 MOVE "ON OVERFLOW PHRASE" TO FEATURE. IC2014.2 +052100 CALL-TEST-03-01. IC2014.2 +052200 MOVE 7 TO CALL-COUNT. IC2014.2 +052300 MOVE 20 TO DN1. IC2014.2 +052400 MOVE 30 TO DN2. IC2014.2 +052500 MOVE ZERO TO DN3, DN4. IC2014.2 +052600 CALL "IC202A" USING DN1, DN2, DN3, DN4; IC2014.2 +052700 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2014.2 +052800 GO TO CALL-FAIL-03-01. IC2014.2 +052900 PERFORM CHECK-TEST-03. IC2014.2 +053000 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +053100 PERFORM PASS IC2014.2 +053200 GO TO CALL-WRITE-03-01. IC2014.2 +053300 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +053400 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +053500 CALL-FAIL-03-01. IC2014.2 +053600 PERFORM FAIL. IC2014.2 +053700 CALL-WRITE-03-01. IC2014.2 +053800 PERFORM PRINT-DETAIL. IC2014.2 +053900 CALL-TEST-03-02. IC2014.2 +054000 MOVE ZERO TO DN3, DN4. IC2014.2 +054100 CALL "IC202A" USING DN1, DN2, DN3, DN4; IC2014.2 +054200 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2014.2 +054300 GO TO CALL-FAIL-03-02. IC2014.2 +054400 PERFORM CHECK-TEST-03. IC2014.2 +054500 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +054600 PERFORM PASS IC2014.2 +054700 GO TO CALL-WRITE-03-02. IC2014.2 +054800 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +054900 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +055000 CALL-FAIL-03-02. IC2014.2 +055100 PERFORM FAIL. IC2014.2 +055200 CALL-WRITE-03-02. IC2014.2 +055300 PERFORM PRINT-DETAIL. IC2014.2 +055400 CALL-TEST-03-03. IC2014.2 +055500 MOVE ZERO TO DN3, DN4. IC2014.2 +055600 CALL ID1 USING DN1 DN2 DN3 DN4 IC2014.2 +055700 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2014.2 +055800 GO TO CALL-FAIL-03-03. IC2014.2 +055900 PERFORM CHECK-TEST-03. IC2014.2 +056000 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +056100 PERFORM PASS IC2014.2 +056200 GO TO CALL-WRITE-03-03. IC2014.2 +056300 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +056400 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +056500 CALL-FAIL-03-03. IC2014.2 +056600 PERFORM FAIL. IC2014.2 +056700 CALL-WRITE-03-03. IC2014.2 +056800 PERFORM PRINT-DETAIL. IC2014.2 +056900 CALL-TEST-03-04. IC2014.2 +057000 MOVE ZERO TO DN3, DN4. IC2014.2 +057100 CALL ID1 USING DN1 DN2 DN3 DN4; IC2014.2 +057200 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK, IC2014.2 +057300 GO TO CALL-FAIL-03-04. IC2014.2 +057400 PERFORM CHECK-TEST-03. IC2014.2 +057500 IF FAIL-FLAG EQUAL TO ZERO IC2014.2 +057600 PERFORM PASS IC2014.2 +057700 GO TO CALL-WRITE-03-04. IC2014.2 +057800 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2014.2 +057900 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2014.2 +058000 CALL-FAIL-03-04. IC2014.2 +058100 PERFORM FAIL. IC2014.2 +058200 CALL-WRITE-03-04. IC2014.2 +058300 PERFORM PRINT-DETAIL. IC2014.2 +058400 GO TO EXIT-IC201. IC2014.2 +058500 CALL-DELETE-03. IC2014.2 +058600* IF THE ON OVERFLOW PHRASE IS NOT RECOGNIZED, DELETE ALL IC2014.2 +058700* OF THE ABOVE CALL-TEST-03 PARAGRAPHS, STARTING WITH IC2014.2 +058800* CALL-TEST-03-01. IC2014.2 +058900 PERFORM DE-LETE. IC2014.2 +059000 PERFORM PRINT-DETAIL. IC2014.2 +059100 EXIT-IC201. IC2014.2 +059200 GO TO CCVS-EXIT. IC2014.2 +059300 SECT-IC201-0002 SECTION. IC2014.2 +059400 CHECK-TEST-01. IC2014.2 +059500 MOVE ZERO TO FAIL-FLAG. IC2014.2 +059600 ADD 1 TO CALL-COUNT. IC2014.2 +059700 IF DN1 EQUAL TO ZERO IC2014.2 +059800 NEXT SENTENCE IC2014.2 +059900 ELSE ADD 1 TO FAIL-FLAG. IC2014.2 +060000 IF DN2 NOT EQUAL TO ZERO IC2014.2 +060100 ADD 1 TO FAIL-FLAG. IC2014.2 +060200 IF DN3 NOT EQUAL TO 1 IC2014.2 +060300 ADD 1 TO FAIL-FLAG. IC2014.2 +060400 IF DN4 NOT EQUAL TO CALL-COUNT IC2014.2 +060500 ADD 1 TO FAIL-FLAG. IC2014.2 +060600 CHECK-TEST-03. IC2014.2 +060700 MOVE ZERO TO FAIL-FLAG. IC2014.2 +060800 ADD 1 TO CALL-COUNT. IC2014.2 +060900 IF DN4 NOT EQUAL TO CALL-COUNT IC2014.2 +061000 ADD 1 TO FAIL-FLAG. IC2014.2 +061100 IF DN3 NOT EQUAL TO 21 IC2014.2 +061200 ADD 1 TO FAIL-FLAG. IC2014.2 +061300 IF DN2 NOT EQUAL TO 30 IC2014.2 +061400 ADD 1 TO FAIL-FLAG. IC2014.2 +061500 IF DN1 NOT EQUAL TO 20 IC2014.2 +061600 ADD 1 TO FAIL-FLAG. IC2014.2 +061700 CCVS-EXIT SECTION. IC2014.2 +061800 CCVS-999999. IC2014.2 +061900 GO TO CLOSE-FILES. IC2014.2 diff --git a/tests/cobol85/IC/IC203A.CBL b/tests/cobol85/IC/IC203A.CBL new file mode 100755 index 00000000..21ed3cfa --- /dev/null +++ b/tests/cobol85/IC/IC203A.CBL @@ -0,0 +1,683 @@ +000100 IDENTIFICATION DIVISION. IC2034.2 +000200 PROGRAM-ID. IC2034.2 +000300 IC203A. IC2034.2 +000400**************************************************************** IC2034.2 +000500* * IC2034.2 +000600* VALIDATION FOR:- * IC2034.2 +000700* * IC2034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2034.2 +000900* * IC2034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2034.2 +001100* * IC2034.2 +001200**************************************************************** IC2034.2 +001300* * IC2034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2034.2 +001500* * IC2034.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2034.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2034.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2034.2 +001900* * IC2034.2 +002000**************************************************************** IC2034.2 +002100* THE PROGRAM IC203 TESTS THE USE OF THE CANCEL * IC2034.2 +002200* STATEMENT. THIS PROGRAM VERIFIES THAT THE INITIAL * IC2034.2 +002300* CALL TO A SUBPROGRAM AND THE FIRST CALL AFTER A CANCEL * IC2034.2 +002400* RESULTS IN A SUBPROGRAM BEING INITIATED IN ITS INITIAL * IC2034.2 +002500* STATE. THE PROGRAM ALSO CANCELS A PROGRAM WHICH HAS * IC2034.2 +002600* NOT BEEN CALLED, IN WHICH CASE CONTROL SHOULD PASS * IC2034.2 +002700* TO THE NEXT SENTENCE. * IC2034.2 +002800**************************************************************** IC2034.2 +002900 ENVIRONMENT DIVISION. IC2034.2 +003000 CONFIGURATION SECTION. IC2034.2 +003100 SOURCE-COMPUTER. IC2034.2 +003200 Linux. IC2034.2 +003300 OBJECT-COMPUTER. IC2034.2 +003400 Linux. IC2034.2 +003500 INPUT-OUTPUT SECTION. IC2034.2 +003600 FILE-CONTROL. IC2034.2 +003700 SELECT PRINT-FILE ASSIGN TO IC2034.2 +003800 "report.log". IC2034.2 +003900 DATA DIVISION. IC2034.2 +004000 FILE SECTION. IC2034.2 +004100 FD PRINT-FILE. IC2034.2 +004200 01 PRINT-REC PICTURE X(120). IC2034.2 +004300 01 DUMMY-RECORD PICTURE X(120). IC2034.2 +004400 WORKING-STORAGE SECTION. IC2034.2 +004500 77 ID1 PICTURE X(6) VALUE "IC204A". IC2034.2 +004600 77 ID2 PICTURE X(6) VALUE "IC206A". IC2034.2 +004700 77 DN1 PICTURE S999. IC2034.2 +004800 77 DN5 PICTURE S999. IC2034.2 +004900 01 TABLE-1. IC2034.2 +005000 02 DN2 PICTURE XXX. IC2034.2 +005100 02 DN3 PICTURE 99. IC2034.2 +005200 02 DN4 PICTURE X(5). IC2034.2 +005300 01 TABLE-2. IC2034.2 +005400 02 DN6 PICTURE X IC2034.2 +005500 OCCURS 2 TIMES. IC2034.2 +005600 01 TEST-RESULTS. IC2034.2 +005700 02 FILLER PIC X VALUE SPACE. IC2034.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. IC2034.2 +005900 02 FILLER PIC X VALUE SPACE. IC2034.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. IC2034.2 +006100 02 FILLER PIC X VALUE SPACE. IC2034.2 +006200 02 PAR-NAME. IC2034.2 +006300 03 FILLER PIC X(19) VALUE SPACE. IC2034.2 +006400 03 PARDOT-X PIC X VALUE SPACE. IC2034.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. IC2034.2 +006600 02 FILLER PIC X(8) VALUE SPACE. IC2034.2 +006700 02 RE-MARK PIC X(61). IC2034.2 +006800 01 TEST-COMPUTED. IC2034.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IC2034.2 +007000 02 FILLER PIC X(17) VALUE IC2034.2 +007100 " COMPUTED=". IC2034.2 +007200 02 COMPUTED-X. IC2034.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2034.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A IC2034.2 +007500 PIC -9(9).9(9). IC2034.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2034.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2034.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2034.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. IC2034.2 +008000 04 COMPUTED-18V0 PIC -9(18). IC2034.2 +008100 04 FILLER PIC X. IC2034.2 +008200 03 FILLER PIC X(50) VALUE SPACE. IC2034.2 +008300 01 TEST-CORRECT. IC2034.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IC2034.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2034.2 +008600 02 CORRECT-X. IC2034.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2034.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2034.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2034.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2034.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2034.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. IC2034.2 +009300 04 CORRECT-18V0 PIC -9(18). IC2034.2 +009400 04 FILLER PIC X. IC2034.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IC2034.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2034.2 +009700 01 CCVS-C-1. IC2034.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2034.2 +009900- "SS PARAGRAPH-NAME IC2034.2 +010000- " REMARKS". IC2034.2 +010100 02 FILLER PIC X(20) VALUE SPACE. IC2034.2 +010200 01 CCVS-C-2. IC2034.2 +010300 02 FILLER PIC X VALUE SPACE. IC2034.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". IC2034.2 +010500 02 FILLER PIC X(15) VALUE SPACE. IC2034.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". IC2034.2 +010700 02 FILLER PIC X(94) VALUE SPACE. IC2034.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2034.2 +010900 01 REC-CT PIC 99 VALUE ZERO. IC2034.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2034.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2034.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2034.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2034.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2034.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2034.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2034.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2034.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2034.2 +011900 01 CCVS-H-1. IC2034.2 +012000 02 FILLER PIC X(39) VALUE SPACES. IC2034.2 +012100 02 FILLER PIC X(42) VALUE IC2034.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2034.2 +012300 02 FILLER PIC X(39) VALUE SPACES. IC2034.2 +012400 01 CCVS-H-2A. IC2034.2 +012500 02 FILLER PIC X(40) VALUE SPACE. IC2034.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2034.2 +012700 02 FILLER PIC XXXX VALUE IC2034.2 +012800 "4.2 ". IC2034.2 +012900 02 FILLER PIC X(28) VALUE IC2034.2 +013000 " COPY - NOT FOR DISTRIBUTION". IC2034.2 +013100 02 FILLER PIC X(41) VALUE SPACE. IC2034.2 +013200 IC2034.2 +013300 01 CCVS-H-2B. IC2034.2 +013400 02 FILLER PIC X(15) VALUE IC2034.2 +013500 "TEST RESULT OF ". IC2034.2 +013600 02 TEST-ID PIC X(9). IC2034.2 +013700 02 FILLER PIC X(4) VALUE IC2034.2 +013800 " IN ". IC2034.2 +013900 02 FILLER PIC X(12) VALUE IC2034.2 +014000 " HIGH ". IC2034.2 +014100 02 FILLER PIC X(22) VALUE IC2034.2 +014200 " LEVEL VALIDATION FOR ". IC2034.2 +014300 02 FILLER PIC X(58) VALUE IC2034.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2034.2 +014500 01 CCVS-H-3. IC2034.2 +014600 02 FILLER PIC X(34) VALUE IC2034.2 +014700 " FOR OFFICIAL USE ONLY ". IC2034.2 +014800 02 FILLER PIC X(58) VALUE IC2034.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2034.2 +015000 02 FILLER PIC X(28) VALUE IC2034.2 +015100 " COPYRIGHT 1985 ". IC2034.2 +015200 01 CCVS-E-1. IC2034.2 +015300 02 FILLER PIC X(52) VALUE SPACE. IC2034.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2034.2 +015500 02 ID-AGAIN PIC X(9). IC2034.2 +015600 02 FILLER PIC X(45) VALUE SPACES. IC2034.2 +015700 01 CCVS-E-2. IC2034.2 +015800 02 FILLER PIC X(31) VALUE SPACE. IC2034.2 +015900 02 FILLER PIC X(21) VALUE SPACE. IC2034.2 +016000 02 CCVS-E-2-2. IC2034.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2034.2 +016200 03 FILLER PIC X VALUE SPACE. IC2034.2 +016300 03 ENDER-DESC PIC X(44) VALUE IC2034.2 +016400 "ERRORS ENCOUNTERED". IC2034.2 +016500 01 CCVS-E-3. IC2034.2 +016600 02 FILLER PIC X(22) VALUE IC2034.2 +016700 " FOR OFFICIAL USE ONLY". IC2034.2 +016800 02 FILLER PIC X(12) VALUE SPACE. IC2034.2 +016900 02 FILLER PIC X(58) VALUE IC2034.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2034.2 +017100 02 FILLER PIC X(13) VALUE SPACE. IC2034.2 +017200 02 FILLER PIC X(15) VALUE IC2034.2 +017300 " COPYRIGHT 1985". IC2034.2 +017400 01 CCVS-E-4. IC2034.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2034.2 +017600 02 FILLER PIC X(4) VALUE " OF ". IC2034.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2034.2 +017800 02 FILLER PIC X(40) VALUE IC2034.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2034.2 +018000 01 XXINFO. IC2034.2 +018100 02 FILLER PIC X(19) VALUE IC2034.2 +018200 "*** INFORMATION ***". IC2034.2 +018300 02 INFO-TEXT. IC2034.2 +018400 04 FILLER PIC X(8) VALUE SPACE. IC2034.2 +018500 04 XXCOMPUTED PIC X(20). IC2034.2 +018600 04 FILLER PIC X(5) VALUE SPACE. IC2034.2 +018700 04 XXCORRECT PIC X(20). IC2034.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). IC2034.2 +018900 01 HYPHEN-LINE. IC2034.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. IC2034.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************IC2034.2 +019200- "*****************************************". IC2034.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************IC2034.2 +019400- "******************************". IC2034.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE IC2034.2 +019600 "IC203A". IC2034.2 +019700 PROCEDURE DIVISION. IC2034.2 +019800 CCVS1 SECTION. IC2034.2 +019900 OPEN-FILES. IC2034.2 +020000 OPEN OUTPUT PRINT-FILE. IC2034.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2034.2 +020200 MOVE SPACE TO TEST-RESULTS. IC2034.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2034.2 +020400 GO TO CCVS1-EXIT. IC2034.2 +020500 CLOSE-FILES. IC2034.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2034.2 +020700 TERMINATE-CCVS. IC2034.2 +020800*S EXIT PROGRAM. IC2034.2 +020900*SERMINATE-CALL. IC2034.2 +021000 STOP RUN. IC2034.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2034.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2034.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2034.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2034.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. IC2034.2 +021600 PRINT-DETAIL. IC2034.2 +021700 IF REC-CT NOT EQUAL TO ZERO IC2034.2 +021800 MOVE "." TO PARDOT-X IC2034.2 +021900 MOVE REC-CT TO DOTVALUE. IC2034.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2034.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2034.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2034.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2034.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2034.2 +022500 MOVE SPACE TO CORRECT-X. IC2034.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2034.2 +022700 MOVE SPACE TO RE-MARK. IC2034.2 +022800 HEAD-ROUTINE. IC2034.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2034.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2034.2 +023300 COLUMN-NAMES-ROUTINE. IC2034.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +023700 END-ROUTINE. IC2034.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2034.2 +023900 END-RTN-EXIT. IC2034.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +024100 END-ROUTINE-1. IC2034.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2034.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2034.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. IC2034.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2034.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2034.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2034.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2034.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2034.2 +025000 END-ROUTINE-12. IC2034.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2034.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2034.2 +025300 MOVE "NO " TO ERROR-TOTAL IC2034.2 +025400 ELSE IC2034.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2034.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2034.2 +025700 PERFORM WRITE-LINE. IC2034.2 +025800 END-ROUTINE-13. IC2034.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2034.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE IC2034.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2034.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2034.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO IC2034.2 +026500 MOVE "NO " TO ERROR-TOTAL IC2034.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2034.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2034.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2034.2 +027000 WRITE-LINE. IC2034.2 +027100 ADD 1 TO RECORD-COUNT. IC2034.2 +027200 IF RECORD-COUNT GREATER 50 IC2034.2 +027300 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2034.2 +027400 MOVE SPACE TO DUMMY-RECORD IC2034.2 +027500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2034.2 +027600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2034.2 +027700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2034.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2034.2 +027900 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2034.2 +028000 MOVE ZERO TO RECORD-COUNT. IC2034.2 +028100 PERFORM WRT-LN. IC2034.2 +028200 WRT-LN. IC2034.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2034.2 +028400 MOVE SPACE TO DUMMY-RECORD. IC2034.2 +028500 BLANK-LINE-PRINT. IC2034.2 +028600 PERFORM WRT-LN. IC2034.2 +028700 FAIL-ROUTINE. IC2034.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2034.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2034.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2034.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2034.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2034.2 +029400 GO TO FAIL-ROUTINE-EX. IC2034.2 +029500 FAIL-ROUTINE-WRITE. IC2034.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2034.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2034.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2034.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2034.2 +030000 FAIL-ROUTINE-EX. EXIT. IC2034.2 +030100 BAIL-OUT. IC2034.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2034.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2034.2 +030400 BAIL-OUT-WRITE. IC2034.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2034.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2034.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2034.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2034.2 +030900 BAIL-OUT-EX. EXIT. IC2034.2 +031000 CCVS1-EXIT. IC2034.2 +031100 EXIT. IC2034.2 +031200 SECT-IC203-0001 SECTION. IC2034.2 +031300 CALL-TEST-04. IC2034.2 +031400* CALL-TEST-04 VERIFIES THAT A PROGRAM IS IN ITS IC2034.2 +031500* INITIAL STATE THE FIRST TIME IT IS CALLED. IC2034.2 +031600 MOVE "CALL-TEST-04" TO PAR-NAME. IC2034.2 +031700 MOVE "INITIAL STATE" TO FEATURE. IC2034.2 +031800 MOVE 1 TO DN3. IC2034.2 +031900 MOVE SPACE TO DN2, DN4. IC2034.2 +032000 MOVE ZERO TO DN1. IC2034.2 +032100 CALL ID1 USING TABLE-1, DN1. IC2034.2 +032200 GO TO CALL-TEST-04-01. IC2034.2 +032300 CALL-DELETE-04. IC2034.2 +032400 PERFORM DE-LETE. IC2034.2 +032500 PERFORM PRINT-DETAIL. IC2034.2 +032600 GO TO CALL-TEST-05. IC2034.2 +032700 CALL-TEST-04-01. IC2034.2 +032800 MOVE 1 TO REC-CT. IC2034.2 +032900 IF DN1 IS EQUAL TO 1 IC2034.2 +033000 PERFORM PASS IC2034.2 +033100 GO TO CALL-WRITE-04-01. IC2034.2 +033200 CALL-FAIL-04-01. IC2034.2 +033300 PERFORM FAIL. IC2034.2 +033400 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +033500 MOVE 1 TO CORRECT-18V0. IC2034.2 +033600 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +033700 CALL-WRITE-04-01. IC2034.2 +033800 PERFORM PRINT-DETAIL. IC2034.2 +033900 CALL-TEST-04-02. IC2034.2 +034000 ADD 1 TO REC-CT. IC2034.2 +034100 IF DN2 IS EQUAL TO "YES" IC2034.2 +034200 PERFORM PASS IC2034.2 +034300 GO TO CALL-WRITE-04-02. IC2034.2 +034400 CALL-FAIL-04-02. IC2034.2 +034500 PERFORM FAIL. IC2034.2 +034600 MOVE DN2 TO COMPUTED-A. IC2034.2 +034700 MOVE "YES" TO CORRECT-A. IC2034.2 +034800 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +034900 CALL-WRITE-04-02. IC2034.2 +035000 PERFORM PRINT-DETAIL. IC2034.2 +035100 CALL-TEST-04-03. IC2034.2 +035200 ADD 1 TO REC-CT. IC2034.2 +035300 IF DN4 EQUAL TO "EQUAL" IC2034.2 +035400 PERFORM PASS IC2034.2 +035500 GO TO CALL-WRITE-04-03. IC2034.2 +035600 CALL-FAIL-04-03. IC2034.2 +035700 PERFORM FAIL. IC2034.2 +035800 MOVE DN4 TO COMPUTED-A. IC2034.2 +035900 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +036000 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +036100 CALL-WRITE-04-03. IC2034.2 +036200 PERFORM PRINT-DETAIL. IC2034.2 +036300 CALL-TEST-05. IC2034.2 +036400 MOVE "CALL-TEST-05" TO PAR-NAME. IC2034.2 +036500 MOVE "STATE UNCHANGED" TO FEATURE. IC2034.2 +036600* CALL-TEST-05 TESTS THAT THE STATE OF THE SUBPROGRAM IC2034.2 +036700* IS UNCHANGED FROM ITS STATE WHEN LAST EXITED. IC2034.2 +036800 MOVE 2 TO DN3. IC2034.2 +036900 MOVE SPACE TO DN2, DN4. IC2034.2 +037000 MOVE ZERO TO DN5. IC2034.2 +037100 CALL ID1 USING TABLE-1, DN5. IC2034.2 +037200 GO TO CALL-TEST-05-01. IC2034.2 +037300 CALL-DELETE-05. IC2034.2 +037400 PERFORM DE-LETE. IC2034.2 +037500 PERFORM PRINT-DETAIL. IC2034.2 +037600 GO TO CNCL-TEST-01. IC2034.2 +037700 CALL-TEST-05-01. IC2034.2 +037800 MOVE 1 TO REC-CT. IC2034.2 +037900 IF DN5 EQUAL TO 2 IC2034.2 +038000 PERFORM PASS IC2034.2 +038100 GO TO CALL-WRITE-05-01. IC2034.2 +038200 CALL-FAIL-05-01. IC2034.2 +038300 PERFORM FAIL. IC2034.2 +038400 MOVE DN5 TO COMPUTED-18V0. IC2034.2 +038500 MOVE 2 TO CORRECT-18V0. IC2034.2 +038600 MOVE "DN5 INCORRECT" TO RE-MARK. IC2034.2 +038700 CALL-WRITE-05-01. IC2034.2 +038800 PERFORM PRINT-DETAIL. IC2034.2 +038900 CALL-TEST-05-02. IC2034.2 +039000 ADD 1 TO REC-CT. IC2034.2 +039100 IF DN2 EQUAL TO "NO" IC2034.2 +039200 PERFORM PASS IC2034.2 +039300 GO TO CALL-WRITE-05-02. IC2034.2 +039400 CALL-FAIL-05-02. IC2034.2 +039500 PERFORM FAIL. IC2034.2 +039600 MOVE DN2 TO COMPUTED-A. IC2034.2 +039700 MOVE "NO" TO CORRECT-A. IC2034.2 +039800 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +039900 CALL-WRITE-05-02. IC2034.2 +040000 PERFORM PRINT-DETAIL. IC2034.2 +040100 CALL-TEST-05-03. IC2034.2 +040200 ADD 1 TO REC-CT. IC2034.2 +040300 IF DN4 EQUAL TO "EQUAL" IC2034.2 +040400 PERFORM PASS IC2034.2 +040500 GO TO CALL-WRITE-05-03. IC2034.2 +040600 CALL-FAIL-05-03. IC2034.2 +040700 PERFORM FAIL. IC2034.2 +040800 MOVE DN4 TO COMPUTED-A. IC2034.2 +040900 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +041000 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +041100 CALL-WRITE-05-03. IC2034.2 +041200 PERFORM PRINT-DETAIL. IC2034.2 +041300 CNCL-TEST-01. IC2034.2 +041400* THIS TEST VERIFIES THAT A SUBPROGRAM IS IN ITS IC2034.2 +041500* INITIAL STATE THE FIRST TIME IT IS CALLED FOLLOWING IC2034.2 +041600* A CANCEL STATEMENT. IC2034.2 +041700 MOVE "CNCL-TEST-01" TO PAR-NAME. IC2034.2 +041800 MOVE "SET TO INITIAL STATE" TO FEATURE. IC2034.2 +041900 CALL "IC204A" USING TABLE-1, DN1. IC2034.2 +042000 CANCEL "IC204A". IC2034.2 +042100 MOVE 1 TO DN3. IC2034.2 +042200 MOVE SPACE TO DN2, DN4. IC2034.2 +042300 MOVE ZERO TO DN1. IC2034.2 +042400 CALL "IC204A" USING TABLE-1, DN1. IC2034.2 +042500 GO TO CNCL-TEST-01-01. IC2034.2 +042600 CNCL-DELETE-01. IC2034.2 +042700 PERFORM DE-LETE. IC2034.2 +042800 PERFORM PRINT-DETAIL. IC2034.2 +042900 GO TO CNCL-TEST-02. IC2034.2 +043000 CNCL-TEST-01-01. IC2034.2 +043100 MOVE 1 TO REC-CT. IC2034.2 +043200 IF DN1 IS EQUAL TO 1 IC2034.2 +043300 PERFORM PASS IC2034.2 +043400 GO TO CNCL-WRITE-01-01. IC2034.2 +043500 CNCL-FAIL-01-01. IC2034.2 +043600 PERFORM FAIL. IC2034.2 +043700 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +043800 MOVE 1 TO CORRECT-18V0. IC2034.2 +043900 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +044000 CNCL-WRITE-01-01. IC2034.2 +044100 PERFORM PRINT-DETAIL. IC2034.2 +044200 CNCL-TEST-01-02. IC2034.2 +044300 ADD 1 TO REC-CT. IC2034.2 +044400 IF DN2 IS EQUAL TO "YES" IC2034.2 +044500 PERFORM PASS IC2034.2 +044600 GO TO CNCL-WRITE-01-02. IC2034.2 +044700 CNCL-FAIL-01-02. IC2034.2 +044800 PERFORM FAIL. IC2034.2 +044900 MOVE DN2 TO COMPUTED-A. IC2034.2 +045000 MOVE "YES" TO CORRECT-A. IC2034.2 +045100 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +045200 CNCL-WRITE-01-02. IC2034.2 +045300 PERFORM PRINT-DETAIL. IC2034.2 +045400 CNCL-TEST-01-03. IC2034.2 +045500 ADD 1 TO REC-CT. IC2034.2 +045600 IF DN4 EQUAL TO "EQUAL" IC2034.2 +045700 PERFORM PASS IC2034.2 +045800 GO TO CNCL-WRITE-01-03. IC2034.2 +045900 CNCL-FAIL-01-03. IC2034.2 +046000 PERFORM FAIL. IC2034.2 +046100 MOVE DN4 TO COMPUTED-A. IC2034.2 +046200 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +046300 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +046400 CNCL-WRITE-01-03. IC2034.2 +046500 PERFORM PRINT-DETAIL. IC2034.2 +046600 CNCL-TEST-02. IC2034.2 +046700* THIS TEST USES AN IDENTIFIER IN THE CANCEL STATEMENT. IC2034.2 +046800* THE SUBPROGRAM SHOULD BE IN ITS INITIAL STATE ON THE FIRST IC2034.2 +046900* CALL FOLLOWING A CANCEL OF THE SUBPROGRAM. IC2034.2 +047000 MOVE "CNCL-TEST-02" TO PAR-NAME. IC2034.2 +047100 MOVE "SET TO INITIAL STATE" TO FEATURE. IC2034.2 +047200 CALL "IC204A" USING TABLE-1, DN1. IC2034.2 +047300 CANCEL ID1. IC2034.2 +047400 MOVE 1 TO DN3. IC2034.2 +047500 MOVE SPACE TO DN2, DN4. IC2034.2 +047600 MOVE ZERO TO DN1. IC2034.2 +047700 CALL ID1 USING TABLE-1, DN1. IC2034.2 +047800 GO TO CNCL-TEST-02-01. IC2034.2 +047900 CNCL-DELETE-02. IC2034.2 +048000 PERFORM DE-LETE. IC2034.2 +048100 PERFORM PRINT-DETAIL. IC2034.2 +048200 GO TO CNCL-TEST-03. IC2034.2 +048300 CNCL-TEST-02-01. IC2034.2 +048400 MOVE 1 TO REC-CT. IC2034.2 +048500 IF DN1 EQUAL TO 1 IC2034.2 +048600 PERFORM PASS IC2034.2 +048700 GO TO CNCL-WRITE-02-01. IC2034.2 +048800 CNCL-FAIL-02-01. IC2034.2 +048900 PERFORM FAIL. IC2034.2 +049000 MOVE 1 TO CORRECT-18V0. IC2034.2 +049100 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +049200 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +049300 CNCL-WRITE-02-01. IC2034.2 +049400 PERFORM PRINT-DETAIL. IC2034.2 +049500 CNCL-TEST-02-02. IC2034.2 +049600 ADD 1 TO REC-CT. IC2034.2 +049700 IF DN2 EQUAL TO "YES" IC2034.2 +049800 PERFORM PASS IC2034.2 +049900 GO TO CNCL-WRITE-02-02. IC2034.2 +050000 CNCL-FAIL-02-02. IC2034.2 +050100 PERFORM FAIL. IC2034.2 +050200 MOVE DN2 TO COMPUTED-A. IC2034.2 +050300 MOVE "YES" TO CORRECT-A. IC2034.2 +050400 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +050500 CNCL-WRITE-02-02. IC2034.2 +050600 PERFORM PRINT-DETAIL. IC2034.2 +050700 CNCL-TEST-02-03. IC2034.2 +050800 ADD 1 TO REC-CT. IC2034.2 +050900 IF DN4 EQUAL TO "EQUAL" IC2034.2 +051000 PERFORM PASS IC2034.2 +051100 GO TO CNCL-WRITE-02-03. IC2034.2 +051200 CNCL-FAIL-02-03. IC2034.2 +051300 PERFORM FAIL. IC2034.2 +051400 MOVE DN4 TO COMPUTED-A. IC2034.2 +051500 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +051600 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +051700 CNCL-WRITE-02-03. IC2034.2 +051800 PERFORM PRINT-DETAIL. IC2034.2 +051900 CNCL-TEST-03. IC2034.2 +052000* THIS TEST CANCELS A SUBPROGRAM WHICH HAS ALREADY IC2034.2 +052100* BEEN CANCELED. THE SUBPROGRAM IS THEN CALLED AND A CHECK IC2034.2 +052200* IS MADE TO ENSURE THAT THE SUBPROGRAM WAS IN ITS INITIAL IC2034.2 +052300* STATE. IC2034.2 +052400 MOVE "CNCL-TEST-03" TO PAR-NAME. IC2034.2 +052500 MOVE "PREVIOUSLY CANCELED" TO FEATURE. IC2034.2 +052600 CNCL-INIT-03. IC2034.2 +052700 CALL "IC204A" USING TABLE-1, DN1. IC2034.2 +052800 CANCEL ID1. IC2034.2 +052900 CANCEL ID1. IC2034.2 +053000 MOVE 1 TO DN3. IC2034.2 +053100 MOVE SPACE TO DN2, DN4. IC2034.2 +053200 MOVE ZERO TO DN1. IC2034.2 +053300 CALL ID1 USING TABLE-1, DN1. IC2034.2 +053400 GO TO CNCL-TEST-03-01. IC2034.2 +053500 CNCL-DELETE-03. IC2034.2 +053600 PERFORM DE-LETE. IC2034.2 +053700 PERFORM PRINT-DETAIL. IC2034.2 +053800 GO TO CNCL-TEST-04. IC2034.2 +053900 CNCL-TEST-03-01. IC2034.2 +054000 MOVE 1 TO REC-CT. IC2034.2 +054100 IF DN1 EQUAL TO 1 IC2034.2 +054200 PERFORM PASS IC2034.2 +054300 GO TO CNCL-WRITE-03-01. IC2034.2 +054400 CNCL-FAIL-03-01. IC2034.2 +054500 PERFORM FAIL. IC2034.2 +054600 MOVE 1 TO CORRECT-18V0. IC2034.2 +054700 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +054800 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +054900 CNCL-WRITE-03-01. IC2034.2 +055000 PERFORM PRINT-DETAIL. IC2034.2 +055100 CNCL-TEST-03-02. IC2034.2 +055200 ADD 1 TO REC-CT. IC2034.2 +055300 IF DN2 IS EQUAL TO "YES" IC2034.2 +055400 PERFORM PASS IC2034.2 +055500 GO TO CNCL-WRITE-03-02. IC2034.2 +055600 CNCL-FAIL-03-02. IC2034.2 +055700 PERFORM FAIL. IC2034.2 +055800 MOVE DN2 TO COMPUTED-A. IC2034.2 +055900 MOVE "YES" TO CORRECT-A. IC2034.2 +056000 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +056100 CNCL-WRITE-03-02. IC2034.2 +056200 PERFORM PRINT-DETAIL. IC2034.2 +056300 CNCL-TEST-03-03. IC2034.2 +056400 ADD 1 TO REC-CT. IC2034.2 +056500 IF DN4 EQUAL TO "EQUAL" IC2034.2 +056600 PERFORM PASS IC2034.2 +056700 GO TO CNCL-WRITE-03-03. IC2034.2 +056800 CNCL-FAIL-03-03. IC2034.2 +056900 PERFORM FAIL. IC2034.2 +057000 MOVE DN4 TO COMPUTED-A. IC2034.2 +057100 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +057200 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +057300 CNCL-WRITE-03-03. IC2034.2 +057400 PERFORM PRINT-DETAIL. IC2034.2 +057500 CNCL-INIT-04. IC2034.2 +057600 MOVE "CNCL-TEST-04" TO PAR-NAME. IC2034.2 +057700 MOVE "CANCEL UNCALLED PROG" TO FEATURE. IC2034.2 +057800 MOVE ZERO TO REC-CT. IC2034.2 +057900 CNCL-TEST-04. IC2034.2 +058000* THIS TEST CANCELS A SUBPROGRAM WHICH HAS NEVER IC2034.2 +058100* BEEN CALLED. THE NEXT SENTENCE SHOULD BE EXECUTED IC2034.2 +058200* IN THIS CASE. IC2034.2 +058300 CANCEL "IC205A". IC2034.2 +058400 GO TO CNCL-PASS-04. IC2034.2 +058500 CNCL-DELETE-04. IC2034.2 +058600 PERFORM DE-LETE. IC2034.2 +058700 GO TO CNCL-WRITE-04. IC2034.2 +058800 CNCL-PASS-04. IC2034.2 +058900 PERFORM PASS. IC2034.2 +059000 CNCL-WRITE-04. IC2034.2 +059100 PERFORM PRINT-DETAIL. IC2034.2 +059200 CNCL-INIT-05. IC2034.2 +059300 MOVE "CNCL-TEST-05" TO PAR-NAME. IC2034.2 +059400 MOVE "CANCEL IN SUBPROGRAM" TO FEATURE. IC2034.2 +059500* THIS TEST CALLS SUBPROGRAM IC205 WHICH CALLS AND IC2034.2 +059600* CANCELS A THIRD SUBPROGRAM IC206. IC2034.2 +059700 CNCL-TEST-05. IC2034.2 +059800 MOVE SPACE TO DN2, DN4, TABLE-2. IC2034.2 +059900 MOVE ZERO TO DN1. IC2034.2 +060000 CALL "IC205A" USING TABLE-1, TABLE-2, DN1. IC2034.2 +060100 IF TABLE-2 EQUAL TO "AB" IC2034.2 +060200 PERFORM PASS IC2034.2 +060300 GO TO CNCL-WRITE-05. IC2034.2 +060400 GO TO CNCL-FAIL-05. IC2034.2 +060500 CNCL-DELETE-05. IC2034.2 +060600 PERFORM DE-LETE. IC2034.2 +060700 GO TO CNCL-WRITE-05. IC2034.2 +060800 CNCL-FAIL-05. IC2034.2 +060900 PERFORM FAIL. IC2034.2 +061000 MOVE "AB" TO CORRECT-A. IC2034.2 +061100 MOVE TABLE-2 TO COMPUTED-A. IC2034.2 +061200 MOVE "TABLE-2 INCORRECT" TO RE-MARK. IC2034.2 +061300 CNCL-WRITE-05. IC2034.2 +061400 PERFORM PRINT-DETAIL. IC2034.2 +061500 CNCL-INIT-06. IC2034.2 +061600 MOVE "CNCL-TEST-06" TO PAR-NAME. IC2034.2 +061700 MOVE "CALL CANCELED PROG" TO FEATURE. IC2034.2 +061800* THIS TEST CHECKS THAT THE CANCEL OF IC204 WHICH IC2034.2 +061900* WAS MADE IN THE SUBPROGRAM IC205 WAS EXECUTED PROPERLY. IC2034.2 +062000* THE SUBPROGRAM IC204 IS CALLED AND THE DATA VALUES IC2034.2 +062100* ARE CHECKED TO SEE IF IC204 WAS IN ITS INITIAL STATE. IC2034.2 +062200 CNCL-TEST-06. IC2034.2 +062300 MOVE 1 TO DN3. IC2034.2 +062400 MOVE SPACE TO DN2, DN4. IC2034.2 +062500 MOVE ZERO TO DN1. IC2034.2 +062600 CALL ID1 USING TABLE-1, DN1. IC2034.2 +062700 GO TO CNCL-TEST-06-01. IC2034.2 +062800 CNCL-DELETE-06. IC2034.2 +062900 PERFORM DE-LETE. IC2034.2 +063000 GO TO CNCL-WRITE-06-03. IC2034.2 +063100 CNCL-TEST-06-01. IC2034.2 +063200 MOVE 1 TO REC-CT. IC2034.2 +063300 IF DN1 IS EQUAL TO 1 IC2034.2 +063400 PERFORM PASS IC2034.2 +063500 GO TO CNCL-WRITE-06-01. IC2034.2 +063600 CNCL-FAIL-06-01. IC2034.2 +063700 PERFORM FAIL. IC2034.2 +063800 MOVE DN1 TO COMPUTED-18V0. IC2034.2 +063900 MOVE 1 TO CORRECT-18V0. IC2034.2 +064000 MOVE "DN1 INCORRECT" TO RE-MARK. IC2034.2 +064100 CNCL-WRITE-06-01. IC2034.2 +064200 PERFORM PRINT-DETAIL. IC2034.2 +064300 CNCL-TEST-06-02. IC2034.2 +064400 ADD 1 TO REC-CT. IC2034.2 +064500 IF DN2 IS EQUAL TO "YES" IC2034.2 +064600 PERFORM PASS IC2034.2 +064700 GO TO CNCL-WRITE-06-02. IC2034.2 +064800 CNCL-FAIL-06-02. IC2034.2 +064900 PERFORM FAIL. IC2034.2 +065000 MOVE DN2 TO COMPUTED-A. IC2034.2 +065100 MOVE "YES" TO CORRECT-A. IC2034.2 +065200 MOVE "DN2 INCORRECT" TO RE-MARK. IC2034.2 +065300 CNCL-WRITE-06-02. IC2034.2 +065400 PERFORM PRINT-DETAIL. IC2034.2 +065500 CNCL-TEST-06-03. IC2034.2 +065600 ADD 1 TO REC-CT. IC2034.2 +065700 IF DN4 EQUAL TO "EQUAL" IC2034.2 +065800 PERFORM PASS IC2034.2 +065900 GO TO CNCL-WRITE-06-03. IC2034.2 +066000 CNCL-FAIL-06-03. IC2034.2 +066100 PERFORM FAIL. IC2034.2 +066200 MOVE DN4 TO COMPUTED-A. IC2034.2 +066300 MOVE "EQUAL" TO CORRECT-A. IC2034.2 +066400 MOVE "DN4 INCORRECT" TO RE-MARK. IC2034.2 +066500 CNCL-WRITE-06-03. IC2034.2 +066600 PERFORM PRINT-DETAIL. IC2034.2 +066700 CNCL-INIT-07. IC2034.2 +066800* THIS TEST CANCELS THE THREE SUBPROGRAMS IC2034.2 +066900* CALLED BY THIS ROUTINE. IC2034.2 +067000 MOVE "CNCL-TEST-07" TO PAR-NAME. IC2034.2 +067100 MOVE "CANCEL 3 PROGS" TO FEATURE. IC2034.2 +067200 MOVE ZERO TO REC-CT. IC2034.2 +067300 CNCL-TEST-07. IC2034.2 +067400 CANCEL ID1, "IC205A", ID2. IC2034.2 +067500 PERFORM PASS. IC2034.2 +067600 GO TO CNCL-WRITE-07. IC2034.2 +067700 CNCL-DELETE-07. IC2034.2 +067800 PERFORM DE-LETE. IC2034.2 +067900 CNCL-WRITE-07. IC2034.2 +068000 PERFORM PRINT-DETAIL. IC2034.2 +068100 CCVS-EXIT SECTION. IC2034.2 +068200 CCVS-999999. IC2034.2 +068300 GO TO CLOSE-FILES. IC2034.2 diff --git a/tests/cobol85/IC/IC207A.CBL b/tests/cobol85/IC/IC207A.CBL new file mode 100755 index 00000000..5ecf6d08 --- /dev/null +++ b/tests/cobol85/IC/IC207A.CBL @@ -0,0 +1,479 @@ +000100 IDENTIFICATION DIVISION. IC2074.2 +000200 PROGRAM-ID. IC2074.2 +000300 IC207A. IC2074.2 +000400**************************************************************** IC2074.2 +000500* * IC2074.2 +000600* VALIDATION FOR:- * IC2074.2 +000700* * IC2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2074.2 +000900* * IC2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2074.2 +001100* * IC2074.2 +001200**************************************************************** IC2074.2 +001300* * IC2074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2074.2 +001500* * IC2074.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2074.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2074.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2074.2 +001900* * IC2074.2 +002000**************************************************************** IC2074.2 +002100* THE PROGRAM IC207 DEFINES A VARIABLE LENGTH TABLE. IC2074.2 +002200* THE TABLE AND THE VARIABLE CONTAINING THE TABLE LENGTH IC2074.2 +002300* ARE OPERANDS IN A CALL STATEMENT USING PHRASE. ALSO AN IC2074.2 +002400* INDEX IS DEFINED FOR THE TABLE AND AN INDEX DATA ITEM IC2074.2 +002500* IS USED TO PASS AN INDEX VALUE FOR A TABLE REFERENCE IC2074.2 +002600* TO AND FROM THE SUBPROGRAM IC208. IC2074.2 +002700**************************************************************** IC2074.2 +002800 ENVIRONMENT DIVISION. IC2074.2 +002900 CONFIGURATION SECTION. IC2074.2 +003000 SOURCE-COMPUTER. IC2074.2 +003100 Linux. IC2074.2 +003200 OBJECT-COMPUTER. IC2074.2 +003300 Linux. IC2074.2 +003400 INPUT-OUTPUT SECTION. IC2074.2 +003500 FILE-CONTROL. IC2074.2 +003600 SELECT PRINT-FILE ASSIGN TO IC2074.2 +003700 "report.log". IC2074.2 +003800 DATA DIVISION. IC2074.2 +003900 FILE SECTION. IC2074.2 +004000 FD PRINT-FILE. IC2074.2 +004100 01 PRINT-REC PICTURE X(120). IC2074.2 +004200 01 DUMMY-RECORD PICTURE X(120). IC2074.2 +004300 WORKING-STORAGE SECTION. IC2074.2 +004400 77 INDEX-1 USAGE IS INDEX. IC2074.2 +004500 77 DN3 PICTURE 99 VALUE 15. IC2074.2 +004600 77 ID1 PICTURE X(6) VALUE "IC208A". IC2074.2 +004700 77 DN4 PICTURE X. IC2074.2 +004800 77 DN5 PICTURE X(15). IC2074.2 +004900 01 TABLE-01. IC2074.2 +005000 02 DN1 PICTURE X IC2074.2 +005100 OCCURS 1 TO 15 TIMES IC2074.2 +005200 DEPENDING ON DN3 IC2074.2 +005300 INDEXED BY IN1. IC2074.2 +005400 01 TABLE-02. IC2074.2 +005500 02 DN2 PICTURE X OCCURS 8 TIMES. IC2074.2 +005600 01 TEST-RESULTS. IC2074.2 +005700 02 FILLER PIC X VALUE SPACE. IC2074.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. IC2074.2 +005900 02 FILLER PIC X VALUE SPACE. IC2074.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. IC2074.2 +006100 02 FILLER PIC X VALUE SPACE. IC2074.2 +006200 02 PAR-NAME. IC2074.2 +006300 03 FILLER PIC X(19) VALUE SPACE. IC2074.2 +006400 03 PARDOT-X PIC X VALUE SPACE. IC2074.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. IC2074.2 +006600 02 FILLER PIC X(8) VALUE SPACE. IC2074.2 +006700 02 RE-MARK PIC X(61). IC2074.2 +006800 01 TEST-COMPUTED. IC2074.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IC2074.2 +007000 02 FILLER PIC X(17) VALUE IC2074.2 +007100 " COMPUTED=". IC2074.2 +007200 02 COMPUTED-X. IC2074.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2074.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A IC2074.2 +007500 PIC -9(9).9(9). IC2074.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2074.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2074.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2074.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. IC2074.2 +008000 04 COMPUTED-18V0 PIC -9(18). IC2074.2 +008100 04 FILLER PIC X. IC2074.2 +008200 03 FILLER PIC X(50) VALUE SPACE. IC2074.2 +008300 01 TEST-CORRECT. IC2074.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IC2074.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2074.2 +008600 02 CORRECT-X. IC2074.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2074.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2074.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2074.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2074.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2074.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. IC2074.2 +009300 04 CORRECT-18V0 PIC -9(18). IC2074.2 +009400 04 FILLER PIC X. IC2074.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IC2074.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2074.2 +009700 01 CCVS-C-1. IC2074.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2074.2 +009900- "SS PARAGRAPH-NAME IC2074.2 +010000- " REMARKS". IC2074.2 +010100 02 FILLER PIC X(20) VALUE SPACE. IC2074.2 +010200 01 CCVS-C-2. IC2074.2 +010300 02 FILLER PIC X VALUE SPACE. IC2074.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". IC2074.2 +010500 02 FILLER PIC X(15) VALUE SPACE. IC2074.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". IC2074.2 +010700 02 FILLER PIC X(94) VALUE SPACE. IC2074.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2074.2 +010900 01 REC-CT PIC 99 VALUE ZERO. IC2074.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2074.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2074.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2074.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2074.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2074.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2074.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2074.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2074.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2074.2 +011900 01 CCVS-H-1. IC2074.2 +012000 02 FILLER PIC X(39) VALUE SPACES. IC2074.2 +012100 02 FILLER PIC X(42) VALUE IC2074.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2074.2 +012300 02 FILLER PIC X(39) VALUE SPACES. IC2074.2 +012400 01 CCVS-H-2A. IC2074.2 +012500 02 FILLER PIC X(40) VALUE SPACE. IC2074.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2074.2 +012700 02 FILLER PIC XXXX VALUE IC2074.2 +012800 "4.2 ". IC2074.2 +012900 02 FILLER PIC X(28) VALUE IC2074.2 +013000 " COPY - NOT FOR DISTRIBUTION". IC2074.2 +013100 02 FILLER PIC X(41) VALUE SPACE. IC2074.2 +013200 IC2074.2 +013300 01 CCVS-H-2B. IC2074.2 +013400 02 FILLER PIC X(15) VALUE IC2074.2 +013500 "TEST RESULT OF ". IC2074.2 +013600 02 TEST-ID PIC X(9). IC2074.2 +013700 02 FILLER PIC X(4) VALUE IC2074.2 +013800 " IN ". IC2074.2 +013900 02 FILLER PIC X(12) VALUE IC2074.2 +014000 " HIGH ". IC2074.2 +014100 02 FILLER PIC X(22) VALUE IC2074.2 +014200 " LEVEL VALIDATION FOR ". IC2074.2 +014300 02 FILLER PIC X(58) VALUE IC2074.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2074.2 +014500 01 CCVS-H-3. IC2074.2 +014600 02 FILLER PIC X(34) VALUE IC2074.2 +014700 " FOR OFFICIAL USE ONLY ". IC2074.2 +014800 02 FILLER PIC X(58) VALUE IC2074.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2074.2 +015000 02 FILLER PIC X(28) VALUE IC2074.2 +015100 " COPYRIGHT 1985 ". IC2074.2 +015200 01 CCVS-E-1. IC2074.2 +015300 02 FILLER PIC X(52) VALUE SPACE. IC2074.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2074.2 +015500 02 ID-AGAIN PIC X(9). IC2074.2 +015600 02 FILLER PIC X(45) VALUE SPACES. IC2074.2 +015700 01 CCVS-E-2. IC2074.2 +015800 02 FILLER PIC X(31) VALUE SPACE. IC2074.2 +015900 02 FILLER PIC X(21) VALUE SPACE. IC2074.2 +016000 02 CCVS-E-2-2. IC2074.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2074.2 +016200 03 FILLER PIC X VALUE SPACE. IC2074.2 +016300 03 ENDER-DESC PIC X(44) VALUE IC2074.2 +016400 "ERRORS ENCOUNTERED". IC2074.2 +016500 01 CCVS-E-3. IC2074.2 +016600 02 FILLER PIC X(22) VALUE IC2074.2 +016700 " FOR OFFICIAL USE ONLY". IC2074.2 +016800 02 FILLER PIC X(12) VALUE SPACE. IC2074.2 +016900 02 FILLER PIC X(58) VALUE IC2074.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2074.2 +017100 02 FILLER PIC X(13) VALUE SPACE. IC2074.2 +017200 02 FILLER PIC X(15) VALUE IC2074.2 +017300 " COPYRIGHT 1985". IC2074.2 +017400 01 CCVS-E-4. IC2074.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2074.2 +017600 02 FILLER PIC X(4) VALUE " OF ". IC2074.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2074.2 +017800 02 FILLER PIC X(40) VALUE IC2074.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2074.2 +018000 01 XXINFO. IC2074.2 +018100 02 FILLER PIC X(19) VALUE IC2074.2 +018200 "*** INFORMATION ***". IC2074.2 +018300 02 INFO-TEXT. IC2074.2 +018400 04 FILLER PIC X(8) VALUE SPACE. IC2074.2 +018500 04 XXCOMPUTED PIC X(20). IC2074.2 +018600 04 FILLER PIC X(5) VALUE SPACE. IC2074.2 +018700 04 XXCORRECT PIC X(20). IC2074.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). IC2074.2 +018900 01 HYPHEN-LINE. IC2074.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. IC2074.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************IC2074.2 +019200- "*****************************************". IC2074.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************IC2074.2 +019400- "******************************". IC2074.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE IC2074.2 +019600 "IC207A". IC2074.2 +019700 PROCEDURE DIVISION. IC2074.2 +019800 CCVS1 SECTION. IC2074.2 +019900 OPEN-FILES. IC2074.2 +020000 OPEN OUTPUT PRINT-FILE. IC2074.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2074.2 +020200 MOVE SPACE TO TEST-RESULTS. IC2074.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2074.2 +020400 GO TO CCVS1-EXIT. IC2074.2 +020500 CLOSE-FILES. IC2074.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2074.2 +020700 TERMINATE-CCVS. IC2074.2 +020800*S EXIT PROGRAM. IC2074.2 +020900*SERMINATE-CALL. IC2074.2 +021000 STOP RUN. IC2074.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2074.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2074.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2074.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2074.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. IC2074.2 +021600 PRINT-DETAIL. IC2074.2 +021700 IF REC-CT NOT EQUAL TO ZERO IC2074.2 +021800 MOVE "." TO PARDOT-X IC2074.2 +021900 MOVE REC-CT TO DOTVALUE. IC2074.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2074.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2074.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2074.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2074.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2074.2 +022500 MOVE SPACE TO CORRECT-X. IC2074.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2074.2 +022700 MOVE SPACE TO RE-MARK. IC2074.2 +022800 HEAD-ROUTINE. IC2074.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2074.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2074.2 +023300 COLUMN-NAMES-ROUTINE. IC2074.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +023700 END-ROUTINE. IC2074.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2074.2 +023900 END-RTN-EXIT. IC2074.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +024100 END-ROUTINE-1. IC2074.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2074.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2074.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. IC2074.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2074.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2074.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2074.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2074.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2074.2 +025000 END-ROUTINE-12. IC2074.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2074.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2074.2 +025300 MOVE "NO " TO ERROR-TOTAL IC2074.2 +025400 ELSE IC2074.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2074.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2074.2 +025700 PERFORM WRITE-LINE. IC2074.2 +025800 END-ROUTINE-13. IC2074.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2074.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE IC2074.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2074.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2074.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO IC2074.2 +026500 MOVE "NO " TO ERROR-TOTAL IC2074.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2074.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2074.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2074.2 +027000 WRITE-LINE. IC2074.2 +027100 ADD 1 TO RECORD-COUNT. IC2074.2 +027200 IF RECORD-COUNT GREATER 50 IC2074.2 +027300 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2074.2 +027400 MOVE SPACE TO DUMMY-RECORD IC2074.2 +027500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2074.2 +027600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2074.2 +027700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2074.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2074.2 +027900 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2074.2 +028000 MOVE ZERO TO RECORD-COUNT. IC2074.2 +028100 PERFORM WRT-LN. IC2074.2 +028200 WRT-LN. IC2074.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2074.2 +028400 MOVE SPACE TO DUMMY-RECORD. IC2074.2 +028500 BLANK-LINE-PRINT. IC2074.2 +028600 PERFORM WRT-LN. IC2074.2 +028700 FAIL-ROUTINE. IC2074.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2074.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2074.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2074.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2074.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2074.2 +029400 GO TO FAIL-ROUTINE-EX. IC2074.2 +029500 FAIL-ROUTINE-WRITE. IC2074.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2074.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2074.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2074.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2074.2 +030000 FAIL-ROUTINE-EX. EXIT. IC2074.2 +030100 BAIL-OUT. IC2074.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2074.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2074.2 +030400 BAIL-OUT-WRITE. IC2074.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2074.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2074.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2074.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2074.2 +030900 BAIL-OUT-EX. EXIT. IC2074.2 +031000 CCVS1-EXIT. IC2074.2 +031100 EXIT. IC2074.2 +031200 SECT-IC207-0001 SECTION. IC2074.2 +031300 INIT-PARAGRAPH. IC2074.2 +031400 MOVE "ABCDEFGHIJKLMNO" TO TABLE-01. IC2074.2 +031500 SET IN1 TO 3. IC2074.2 +031600 SET INDEX-1 TO IN1. IC2074.2 +031700 MOVE 3 TO DN3. IC2074.2 +031800 MOVE SPACE TO TABLE-02. IC2074.2 +031900 CALL ID1 USING TABLE-01, TABLE-02, INDEX-1, DN3. IC2074.2 +032000 LINK-TEST-01. IC2074.2 +032100* THIS TEST CHECKS THAT AN INDEX DATA ITEM WAS IC2074.2 +032200* CORRECTLY PASSED TO A SUBPROGRAM. IC2074.2 +032300 MOVE "LINK-TEST-01" TO PAR-NAME. IC2074.2 +032400 MOVE "INDEX DATA ITEM" TO FEATURE. IC2074.2 +032500 IF DN2 (1) IS EQUAL TO "C" IC2074.2 +032600 PERFORM PASS IC2074.2 +032700 GO TO LINK-WRITE-01. IC2074.2 +032800 LINK-FAIL-01. IC2074.2 +032900 PERFORM FAIL. IC2074.2 +033000 MOVE DN2 (1) TO COMPUTED-A. IC2074.2 +033100 MOVE "C" TO CORRECT-A. IC2074.2 +033200 MOVE "VALUE OF DN2(1)" TO RE-MARK. IC2074.2 +033300 LINK-WRITE-01. IC2074.2 +033400 PERFORM PRINT-DETAIL. IC2074.2 +033500 LINK-TEST-02. IC2074.2 +033600* THIS TEST VERIFIES THAT THE VARIABLE LENGTH TABLE IC2074.2 +033700* AND ITS LENGTH WERE PROCESSED CORRECTLY IN THE SUBPROGRAM. IC2074.2 +033800 MOVE 1 TO REC-CT. IC2074.2 +033900 MOVE "LINK-TEST-02" TO PAR-NAME. IC2074.2 +034000 MOVE "VAR. LENGTH TABLE" TO FEATURE. IC2074.2 +034100 LINK-TEST-02-01. IC2074.2 +034200 IF DN2 (2) EQUAL TO "Z" IC2074.2 +034300 PERFORM PASS IC2074.2 +034400 GO TO LINK-WRITE-02-01. IC2074.2 +034500 LINK-FAIL-02-01. IC2074.2 +034600 PERFORM FAIL. IC2074.2 +034700 MOVE DN2 (2) TO COMPUTED-A. IC2074.2 +034800 MOVE "Z" TO CORRECT-A. IC2074.2 +034900 MOVE "VALUE OF DN2(2)" TO RE-MARK. IC2074.2 +035000 LINK-WRITE-02-01. IC2074.2 +035100 PERFORM PRINT-DETAIL. IC2074.2 +035200 LINK-TEST-02-02. IC2074.2 +035300 ADD 1 TO REC-CT. IC2074.2 +035400 IF DN2 (3) EQUAL TO "B" IC2074.2 +035500 PERFORM PASS IC2074.2 +035600 GO TO LINK-WRITE-02-02. IC2074.2 +035700 LINK-FAIL-02-02. IC2074.2 +035800 PERFORM FAIL. IC2074.2 +035900 MOVE DN2 (3) TO COMPUTED-A. IC2074.2 +036000 MOVE "B" TO CORRECT-A. IC2074.2 +036100 MOVE "VALUE OF DN2(3)" TO RE-MARK. IC2074.2 +036200 LINK-WRITE-02-02. IC2074.2 +036300 PERFORM PRINT-DETAIL. IC2074.2 +036400 LINK-TEST-02-03. IC2074.2 +036500 ADD 1 TO REC-CT. IC2074.2 +036600 IF DN2 (4) EQUAL TO "X" IC2074.2 +036700 PERFORM PASS IC2074.2 +036800 GO TO LINK-WRITE-02-03. IC2074.2 +036900 LINK-FAIL-02-03. IC2074.2 +037000 PERFORM FAIL. IC2074.2 +037100 MOVE DN2 (4) TO COMPUTED-A. IC2074.2 +037200 MOVE "X" TO CORRECT-A. IC2074.2 +037300 MOVE "VALUE OF DN2(4)" TO RE-MARK. IC2074.2 +037400 LINK-WRITE-02-03. IC2074.2 +037500 PERFORM PRINT-DETAIL. IC2074.2 +037600 LINK-TEST-02-04. IC2074.2 +037700 ADD 1 TO REC-CT. IC2074.2 +037800 IF DN2 (5) EQUAL TO "G" IC2074.2 +037900 PERFORM PASS IC2074.2 +038000 GO TO LINK-WRITE-02-04. IC2074.2 +038100 LINK-FAIL-02-04. IC2074.2 +038200 PERFORM FAIL. IC2074.2 +038300 MOVE DN2 (5) TO COMPUTED-A. IC2074.2 +038400 MOVE "G" TO CORRECT-A. IC2074.2 +038500 MOVE "VALUE OF DN2(5)" TO RE-MARK. IC2074.2 +038600 LINK-WRITE-02-04. IC2074.2 +038700 PERFORM PRINT-DETAIL. IC2074.2 +038800 LINK-TEST-03. IC2074.2 +038900* THIS TEST VERIFIES THAT THE CONDITION NAMES DEFINED IC2074.2 +039000* IN THE LINKAGE SECTION OF THE SUBPROGRAM WERE PROCESSED IC2074.2 +039100* CORRECTLY. IC2074.2 +039200 MOVE "LINK-TEST-03" TO PAR-NAME. IC2074.2 +039300 MOVE 1 TO REC-CT. IC2074.2 +039400 MOVE "CONDITION NAME" TO FEATURE. IC2074.2 +039500 LINK-TEST-03-01. IC2074.2 +039600 IF DN2 (6) EQUAL TO "A" IC2074.2 +039700 PERFORM PASS IC2074.2 +039800 GO TO LINK-WRITE-03-01. IC2074.2 +039900 LINK-FAIL-03-01. IC2074.2 +040000 PERFORM FAIL. IC2074.2 +040100 MOVE DN2 (6) TO COMPUTED-A. IC2074.2 +040200 MOVE "A" TO CORRECT-A. IC2074.2 +040300 MOVE "VALUE OF DN2(6)" TO RE-MARK. IC2074.2 +040400 LINK-WRITE-03-01. IC2074.2 +040500 PERFORM PRINT-DETAIL. IC2074.2 +040600 LINK-TEST-03-02. IC2074.2 +040700 ADD 1 TO REC-CT. IC2074.2 +040800 IF DN2 (7) EQUAL TO "V" IC2074.2 +040900 PERFORM PASS IC2074.2 +041000 GO TO LINK-WRITE-03-02. IC2074.2 +041100 LINK-FAIL-03-02. IC2074.2 +041200 PERFORM FAIL. IC2074.2 +041300 MOVE DN2 (7) TO COMPUTED-A. IC2074.2 +041400 MOVE "V" TO CORRECT-A. IC2074.2 +041500 MOVE "VALUE OF DN2(7)" TO RE-MARK. IC2074.2 +041600 LINK-WRITE-03-02. IC2074.2 +041700 PERFORM PRINT-DETAIL. IC2074.2 +041800 LINK-TEST-03-03. IC2074.2 +041900 ADD 1 TO REC-CT. IC2074.2 +042000 IF DN2 (8) EQUAL TO "H" IC2074.2 +042100 PERFORM PASS IC2074.2 +042200 GO TO LINK-WRITE-03-03. IC2074.2 +042300 LINK-FAIL-03-03. IC2074.2 +042400 PERFORM FAIL. IC2074.2 +042500 MOVE DN2 (8) TO COMPUTED-A. IC2074.2 +042600 MOVE "H" TO CORRECT-A. IC2074.2 +042700 MOVE "VALUE OF DN2(8)" TO RE-MARK. IC2074.2 +042800 LINK-WRITE-03-03. IC2074.2 +042900 PERFORM PRINT-DETAIL. IC2074.2 +043000 LINK-TEST-04. IC2074.2 +043100 MOVE "LINK-TEST-04" TO PAR-NAME. IC2074.2 +043200 MOVE "CALL PARAMETERS" TO FEATURE. IC2074.2 +043300 MOVE 1 TO REC-CT. IC2074.2 +043400* CHECK THE INDEX DATA ITEM AND TABLE LENGTH WHICH IC2074.2 +043500* WERE SET IN THE SUBPROGRAM AND RETURNED CORRECTLY IC2074.2 +043600* TO THE CALLING PROGRAM. IC2074.2 +043700 LINK-TEST-04-01. IC2074.2 +043800 SET IN1 TO INDEX-1. IC2074.2 +043900 MOVE DN1 (IN1) TO DN4. IC2074.2 +044000 IF DN4 EQUAL TO "B" IC2074.2 +044100 PERFORM PASS IC2074.2 +044200 GO TO LINK-WRITE-04-01. IC2074.2 +044300 LINK-FAIL-04-01. IC2074.2 +044400 PERFORM FAIL. IC2074.2 +044500 MOVE DN4 TO COMPUTED-A. IC2074.2 +044600 MOVE "B" TO CORRECT-A. IC2074.2 +044700 MOVE "VALUE OF DN1(IN1)" TO RE-MARK. IC2074.2 +044800 LINK-WRITE-04-01. IC2074.2 +044900 PERFORM PRINT-DETAIL. IC2074.2 +045000 LINK-TEST-04-02. IC2074.2 +045100 SET IN1 TO 1. IC2074.2 +045200 SEARCH DN1 VARYING IN1 IC2074.2 +045300 AT END PERFORM PASS IC2074.2 +045400 GO TO LINK-WRITE-04-02, IC2074.2 +045500 WHEN DN1 (IN1) EQUAL TO "J" IC2074.2 +045600 PERFORM FAIL IC2074.2 +045700 MOVE DN1 (IN1) TO COMPUTED-A IC2074.2 +045800 MOVE "MATCH SHOULD NOT BE FOUND" TO RE-MARK. IC2074.2 +045900 LINK-WRITE-04-02. IC2074.2 +046000 ADD 1 TO REC-CT. IC2074.2 +046100 PERFORM PRINT-DETAIL. IC2074.2 +046200 LINK-TEST-04-03. IC2074.2 +046300 ADD 1 TO REC-CT. IC2074.2 +046400 MOVE TABLE-01 TO DN5. IC2074.2 +046500 IF DN5 EQUAL TO "ABCDEFGHI " IC2074.2 +046600 PERFORM PASS IC2074.2 +046700 GO TO LINK-WRITE-04-03. IC2074.2 +046800 LINK-FAIL-04-03. IC2074.2 +046900 PERFORM FAIL. IC2074.2 +047000 MOVE DN5 TO COMPUTED-A. IC2074.2 +047100 MOVE "ABCDEFGHI " TO CORRECT-A. IC2074.2 +047200 MOVE "CONTENTS OF TABLE-01" TO RE-MARK. IC2074.2 +047300 LINK-WRITE-04-03. IC2074.2 +047400 PERFORM PRINT-DETAIL. IC2074.2 +047500 EXIT-IC207. IC2074.2 +047600 GO TO CCVS-EXIT. IC2074.2 +047700 CCVS-EXIT SECTION. IC2074.2 +047800 CCVS-999999. IC2074.2 +047900 GO TO CLOSE-FILES. IC2074.2 diff --git a/tests/cobol85/IC/IC209A.CBL b/tests/cobol85/IC/IC209A.CBL new file mode 100755 index 00000000..cc7cfaf7 --- /dev/null +++ b/tests/cobol85/IC/IC209A.CBL @@ -0,0 +1,352 @@ +000100 IDENTIFICATION DIVISION. IC2094.2 +000200 PROGRAM-ID. IC2094.2 +000300 IC209A. IC2094.2 +000400**************************************************************** IC2094.2 +000500* * IC2094.2 +000600* VALIDATION FOR:- * IC2094.2 +000700* * IC2094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2094.2 +000900* * IC2094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2094.2 +001100* * IC2094.2 +001200**************************************************************** IC2094.2 +001300* * IC2094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2094.2 +001500* * IC2094.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2094.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2094.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2094.2 +001900* * IC2094.2 +002000**************************************************************** IC2094.2 +002100* THIS IS MAIN PROGRAM IC209. IC2094.2 +002200**************************************************************** IC2094.2 +002300 ENVIRONMENT DIVISION. IC2094.2 +002400 CONFIGURATION SECTION. IC2094.2 +002500 SOURCE-COMPUTER. IC2094.2 +002600 Linux. IC2094.2 +002700 OBJECT-COMPUTER. IC2094.2 +002800 Linux. IC2094.2 +002900 INPUT-OUTPUT SECTION. IC2094.2 +003000 FILE-CONTROL. IC2094.2 +003100 SELECT PRINT-FILE ASSIGN TO IC2094.2 +003200 "report.log". IC2094.2 +003300 DATA DIVISION. IC2094.2 +003400 FILE SECTION. IC2094.2 +003500 FD PRINT-FILE. IC2094.2 +003600 01 PRINT-REC PICTURE X(120). IC2094.2 +003700 01 DUMMY-RECORD PICTURE X(120). IC2094.2 +003800 WORKING-STORAGE SECTION. IC2094.2 +003900 01 TEST-AREA. IC2094.2 +004000 02 TEST1 PICTURE X. IC2094.2 +004100 02 TEST2 PICTURE X. IC2094.2 +004200 02 TEST3 PICTURE X. IC2094.2 +004300 02 TEST4 PICTURE X. IC2094.2 +004400 01 TEST-RESULTS. IC2094.2 +004500 02 FILLER PIC X VALUE SPACE. IC2094.2 +004600 02 FEATURE PIC X(20) VALUE SPACE. IC2094.2 +004700 02 FILLER PIC X VALUE SPACE. IC2094.2 +004800 02 P-OR-F PIC X(5) VALUE SPACE. IC2094.2 +004900 02 FILLER PIC X VALUE SPACE. IC2094.2 +005000 02 PAR-NAME. IC2094.2 +005100 03 FILLER PIC X(19) VALUE SPACE. IC2094.2 +005200 03 PARDOT-X PIC X VALUE SPACE. IC2094.2 +005300 03 DOTVALUE PIC 99 VALUE ZERO. IC2094.2 +005400 02 FILLER PIC X(8) VALUE SPACE. IC2094.2 +005500 02 RE-MARK PIC X(61). IC2094.2 +005600 01 TEST-COMPUTED. IC2094.2 +005700 02 FILLER PIC X(30) VALUE SPACE. IC2094.2 +005800 02 FILLER PIC X(17) VALUE IC2094.2 +005900 " COMPUTED=". IC2094.2 +006000 02 COMPUTED-X. IC2094.2 +006100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2094.2 +006200 03 COMPUTED-N REDEFINES COMPUTED-A IC2094.2 +006300 PIC -9(9).9(9). IC2094.2 +006400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2094.2 +006500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2094.2 +006600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2094.2 +006700 03 CM-18V0 REDEFINES COMPUTED-A. IC2094.2 +006800 04 COMPUTED-18V0 PIC -9(18). IC2094.2 +006900 04 FILLER PIC X. IC2094.2 +007000 03 FILLER PIC X(50) VALUE SPACE. IC2094.2 +007100 01 TEST-CORRECT. IC2094.2 +007200 02 FILLER PIC X(30) VALUE SPACE. IC2094.2 +007300 02 FILLER PIC X(17) VALUE " CORRECT =". IC2094.2 +007400 02 CORRECT-X. IC2094.2 +007500 03 CORRECT-A PIC X(20) VALUE SPACE. IC2094.2 +007600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2094.2 +007700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2094.2 +007800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2094.2 +007900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2094.2 +008000 03 CR-18V0 REDEFINES CORRECT-A. IC2094.2 +008100 04 CORRECT-18V0 PIC -9(18). IC2094.2 +008200 04 FILLER PIC X. IC2094.2 +008300 03 FILLER PIC X(2) VALUE SPACE. IC2094.2 +008400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2094.2 +008500 01 CCVS-C-1. IC2094.2 +008600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2094.2 +008700- "SS PARAGRAPH-NAME IC2094.2 +008800- " REMARKS". IC2094.2 +008900 02 FILLER PIC X(20) VALUE SPACE. IC2094.2 +009000 01 CCVS-C-2. IC2094.2 +009100 02 FILLER PIC X VALUE SPACE. IC2094.2 +009200 02 FILLER PIC X(6) VALUE "TESTED". IC2094.2 +009300 02 FILLER PIC X(15) VALUE SPACE. IC2094.2 +009400 02 FILLER PIC X(4) VALUE "FAIL". IC2094.2 +009500 02 FILLER PIC X(94) VALUE SPACE. IC2094.2 +009600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2094.2 +009700 01 REC-CT PIC 99 VALUE ZERO. IC2094.2 +009800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2094.2 +009900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2094.2 +010000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2094.2 +010100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2094.2 +010200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2094.2 +010300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2094.2 +010400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2094.2 +010500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2094.2 +010600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2094.2 +010700 01 CCVS-H-1. IC2094.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IC2094.2 +010900 02 FILLER PIC X(42) VALUE IC2094.2 +011000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2094.2 +011100 02 FILLER PIC X(39) VALUE SPACES. IC2094.2 +011200 01 CCVS-H-2A. IC2094.2 +011300 02 FILLER PIC X(40) VALUE SPACE. IC2094.2 +011400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2094.2 +011500 02 FILLER PIC XXXX VALUE IC2094.2 +011600 "4.2 ". IC2094.2 +011700 02 FILLER PIC X(28) VALUE IC2094.2 +011800 " COPY - NOT FOR DISTRIBUTION". IC2094.2 +011900 02 FILLER PIC X(41) VALUE SPACE. IC2094.2 +012000 IC2094.2 +012100 01 CCVS-H-2B. IC2094.2 +012200 02 FILLER PIC X(15) VALUE IC2094.2 +012300 "TEST RESULT OF ". IC2094.2 +012400 02 TEST-ID PIC X(9). IC2094.2 +012500 02 FILLER PIC X(4) VALUE IC2094.2 +012600 " IN ". IC2094.2 +012700 02 FILLER PIC X(12) VALUE IC2094.2 +012800 " HIGH ". IC2094.2 +012900 02 FILLER PIC X(22) VALUE IC2094.2 +013000 " LEVEL VALIDATION FOR ". IC2094.2 +013100 02 FILLER PIC X(58) VALUE IC2094.2 +013200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2094.2 +013300 01 CCVS-H-3. IC2094.2 +013400 02 FILLER PIC X(34) VALUE IC2094.2 +013500 " FOR OFFICIAL USE ONLY ". IC2094.2 +013600 02 FILLER PIC X(58) VALUE IC2094.2 +013700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2094.2 +013800 02 FILLER PIC X(28) VALUE IC2094.2 +013900 " COPYRIGHT 1985 ". IC2094.2 +014000 01 CCVS-E-1. IC2094.2 +014100 02 FILLER PIC X(52) VALUE SPACE. IC2094.2 +014200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2094.2 +014300 02 ID-AGAIN PIC X(9). IC2094.2 +014400 02 FILLER PIC X(45) VALUE SPACES. IC2094.2 +014500 01 CCVS-E-2. IC2094.2 +014600 02 FILLER PIC X(31) VALUE SPACE. IC2094.2 +014700 02 FILLER PIC X(21) VALUE SPACE. IC2094.2 +014800 02 CCVS-E-2-2. IC2094.2 +014900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2094.2 +015000 03 FILLER PIC X VALUE SPACE. IC2094.2 +015100 03 ENDER-DESC PIC X(44) VALUE IC2094.2 +015200 "ERRORS ENCOUNTERED". IC2094.2 +015300 01 CCVS-E-3. IC2094.2 +015400 02 FILLER PIC X(22) VALUE IC2094.2 +015500 " FOR OFFICIAL USE ONLY". IC2094.2 +015600 02 FILLER PIC X(12) VALUE SPACE. IC2094.2 +015700 02 FILLER PIC X(58) VALUE IC2094.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2094.2 +015900 02 FILLER PIC X(13) VALUE SPACE. IC2094.2 +016000 02 FILLER PIC X(15) VALUE IC2094.2 +016100 " COPYRIGHT 1985". IC2094.2 +016200 01 CCVS-E-4. IC2094.2 +016300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2094.2 +016400 02 FILLER PIC X(4) VALUE " OF ". IC2094.2 +016500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2094.2 +016600 02 FILLER PIC X(40) VALUE IC2094.2 +016700 " TESTS WERE EXECUTED SUCCESSFULLY". IC2094.2 +016800 01 XXINFO. IC2094.2 +016900 02 FILLER PIC X(19) VALUE IC2094.2 +017000 "*** INFORMATION ***". IC2094.2 +017100 02 INFO-TEXT. IC2094.2 +017200 04 FILLER PIC X(8) VALUE SPACE. IC2094.2 +017300 04 XXCOMPUTED PIC X(20). IC2094.2 +017400 04 FILLER PIC X(5) VALUE SPACE. IC2094.2 +017500 04 XXCORRECT PIC X(20). IC2094.2 +017600 02 INF-ANSI-REFERENCE PIC X(48). IC2094.2 +017700 01 HYPHEN-LINE. IC2094.2 +017800 02 FILLER PIC IS X VALUE IS SPACE. IC2094.2 +017900 02 FILLER PIC IS X(65) VALUE IS "************************IC2094.2 +018000- "*****************************************". IC2094.2 +018100 02 FILLER PIC IS X(54) VALUE IS "************************IC2094.2 +018200- "******************************". IC2094.2 +018300 01 CCVS-PGM-ID PIC X(9) VALUE IC2094.2 +018400 "IC209A". IC2094.2 +018500 PROCEDURE DIVISION. IC2094.2 +018600 CCVS1 SECTION. IC2094.2 +018700 OPEN-FILES. IC2094.2 +018800 OPEN OUTPUT PRINT-FILE. IC2094.2 +018900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2094.2 +019000 MOVE SPACE TO TEST-RESULTS. IC2094.2 +019100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2094.2 +019200 GO TO CCVS1-EXIT. IC2094.2 +019300 CLOSE-FILES. IC2094.2 +019400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2094.2 +019500 TERMINATE-CCVS. IC2094.2 +019600*S EXIT PROGRAM. IC2094.2 +019700*SERMINATE-CALL. IC2094.2 +019800 STOP RUN. IC2094.2 +019900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2094.2 +020000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2094.2 +020100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2094.2 +020200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2094.2 +020300 MOVE "****TEST DELETED****" TO RE-MARK. IC2094.2 +020400 PRINT-DETAIL. IC2094.2 +020500 IF REC-CT NOT EQUAL TO ZERO IC2094.2 +020600 MOVE "." TO PARDOT-X IC2094.2 +020700 MOVE REC-CT TO DOTVALUE. IC2094.2 +020800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2094.2 +020900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2094.2 +021000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2094.2 +021100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2094.2 +021200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2094.2 +021300 MOVE SPACE TO CORRECT-X. IC2094.2 +021400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2094.2 +021500 MOVE SPACE TO RE-MARK. IC2094.2 +021600 HEAD-ROUTINE. IC2094.2 +021700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +021800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +021900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2094.2 +022000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2094.2 +022100 COLUMN-NAMES-ROUTINE. IC2094.2 +022200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +022300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +022500 END-ROUTINE. IC2094.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2094.2 +022700 END-RTN-EXIT. IC2094.2 +022800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +022900 END-ROUTINE-1. IC2094.2 +023000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2094.2 +023100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2094.2 +023200 ADD PASS-COUNTER TO ERROR-HOLD. IC2094.2 +023300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2094.2 +023400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2094.2 +023500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2094.2 +023600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2094.2 +023700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2094.2 +023800 END-ROUTINE-12. IC2094.2 +023900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2094.2 +024000 IF ERROR-COUNTER IS EQUAL TO ZERO IC2094.2 +024100 MOVE "NO " TO ERROR-TOTAL IC2094.2 +024200 ELSE IC2094.2 +024300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2094.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2094.2 +024500 PERFORM WRITE-LINE. IC2094.2 +024600 END-ROUTINE-13. IC2094.2 +024700 IF DELETE-COUNTER IS EQUAL TO ZERO IC2094.2 +024800 MOVE "NO " TO ERROR-TOTAL ELSE IC2094.2 +024900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2094.2 +025000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2094.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +025200 IF INSPECT-COUNTER EQUAL TO ZERO IC2094.2 +025300 MOVE "NO " TO ERROR-TOTAL IC2094.2 +025400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2094.2 +025500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2094.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +025700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2094.2 +025800 WRITE-LINE. IC2094.2 +025900 ADD 1 TO RECORD-COUNT. IC2094.2 +026000 IF RECORD-COUNT GREATER 50 IC2094.2 +026100 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2094.2 +026200 MOVE SPACE TO DUMMY-RECORD IC2094.2 +026300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2094.2 +026400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2094.2 +026500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2094.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2094.2 +026700 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2094.2 +026800 MOVE ZERO TO RECORD-COUNT. IC2094.2 +026900 PERFORM WRT-LN. IC2094.2 +027000 WRT-LN. IC2094.2 +027100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2094.2 +027200 MOVE SPACE TO DUMMY-RECORD. IC2094.2 +027300 BLANK-LINE-PRINT. IC2094.2 +027400 PERFORM WRT-LN. IC2094.2 +027500 FAIL-ROUTINE. IC2094.2 +027600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2094.2 +027700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2094.2 +027800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2094.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2094.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +028100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2094.2 +028200 GO TO FAIL-ROUTINE-EX. IC2094.2 +028300 FAIL-ROUTINE-WRITE. IC2094.2 +028400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2094.2 +028500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2094.2 +028600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2094.2 +028700 MOVE SPACES TO COR-ANSI-REFERENCE. IC2094.2 +028800 FAIL-ROUTINE-EX. EXIT. IC2094.2 +028900 BAIL-OUT. IC2094.2 +029000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2094.2 +029100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2094.2 +029200 BAIL-OUT-WRITE. IC2094.2 +029300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2094.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2094.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2094.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2094.2 +029700 BAIL-OUT-EX. EXIT. IC2094.2 +029800 CCVS1-EXIT. IC2094.2 +029900 EXIT. IC2094.2 +030000 CALL-TEST-1. IC2094.2 +030100 MOVE SPACES TO TEST-AREA. IC2094.2 +030200 CALL "IC210A" USING TEST-AREA. IC2094.2 +030300 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2094.2 +030400 MOVE "CALL-TEST-1" TO PAR-NAME. IC2094.2 +030500 MOVE "MAIN PROGRAM CALLS SUBPROGRAM1" TO RE-MARK. IC2094.2 +030600 IF TEST1 = "Y" PERFORM PASS IC2094.2 +030700 GO TO CALL-WRITE-1. IC2094.2 +030800 CALL-FAIL-1. IC2094.2 +030900 MOVE TEST1 TO COMPUTED-A. IC2094.2 +031000 MOVE "Y" TO CORRECT-A. IC2094.2 +031100 PERFORM FAIL. IC2094.2 +031200 CALL-WRITE-1. IC2094.2 +031300 PERFORM PRINT-DETAIL. IC2094.2 +031400 CALL-TEST-2. IC2094.2 +031500 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2094.2 +031600 MOVE "CALL-TEST-2" TO PAR-NAME. IC2094.2 +031700 MOVE "SUBPROGRAM1 CALLS SUBPROGRAM2" TO RE-MARK. IC2094.2 +031800 IF TEST2 = "Y" PERFORM PASS IC2094.2 +031900 GO TO CALL-WRITE-2. IC2094.2 +032000 CALL-FAIL-2. IC2094.2 +032100 MOVE TEST2 TO COMPUTED-A. IC2094.2 +032200 MOVE "Y" TO CORRECT-A. IC2094.2 +032300 PERFORM FAIL. IC2094.2 +032400 CALL-WRITE-2. IC2094.2 +032500 PERFORM PRINT-DETAIL. IC2094.2 +032600 CALL-TEST-3. IC2094.2 +032700 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2094.2 +032800 MOVE "CALL-TEST-3" TO PAR-NAME. IC2094.2 +032900 MOVE "SUBPROGRAM1 CALLS SUBPROGRAM3" TO RE-MARK. IC2094.2 +033000 IF TEST3 = "Y" PERFORM PASS IC2094.2 +033100 GO TO CALL-WRITE-3. IC2094.2 +033200 CALL-FAIL-3. IC2094.2 +033300 MOVE TEST3 TO COMPUTED-A. IC2094.2 +033400 MOVE "Y" TO CORRECT-A. IC2094.2 +033500 PERFORM FAIL. IC2094.2 +033600 CALL-WRITE-3. IC2094.2 +033700 PERFORM PRINT-DETAIL. IC2094.2 +033800 CANCEL-TEST-1. IC2094.2 +033900 MOVE "CANCEL" TO FEATURE. IC2094.2 +034000 MOVE "CANCEL-TEST-1" TO PAR-NAME. IC2094.2 +034100 MOVE "SUBPROGRAM1 CANCELS SUBPROGRAM2" TO RE-MARK. IC2094.2 +034200 IF TEST4 = "Y" PERFORM PASS IC2094.2 +034300 GO TO CANCEL-WRITE-1. IC2094.2 +034400 CANCEL-FAIL-1. IC2094.2 +034500 MOVE TEST4 TO COMPUTED-A. IC2094.2 +034600 MOVE "Y" TO CORRECT-A. IC2094.2 +034700 PERFORM FAIL. IC2094.2 +034800 CANCEL-WRITE-1. IC2094.2 +034900 PERFORM PRINT-DETAIL. IC2094.2 +035000 CCVS-EXIT SECTION. IC2094.2 +035100 CCVS-999999. IC2094.2 +035200 GO TO CLOSE-FILES. IC2094.2 diff --git a/tests/cobol85/IC/IC213A.CBL b/tests/cobol85/IC/IC213A.CBL new file mode 100755 index 00000000..3efed6c0 --- /dev/null +++ b/tests/cobol85/IC/IC213A.CBL @@ -0,0 +1,341 @@ +000100 IDENTIFICATION DIVISION. IC2134.2 +000200 PROGRAM-ID. IC2134.2 +000300 IC213A. IC2134.2 +000400**************************************************************** IC2134.2 +000500* * IC2134.2 +000600* VALIDATION FOR:- * IC2134.2 +000700* * IC2134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2134.2 +000900* * IC2134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2134.2 +001100* * IC2134.2 +001200**************************************************************** IC2134.2 +001300* * IC2134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2134.2 +001500* * IC2134.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2134.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2134.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2134.2 +001900* * IC2134.2 +002000**************************************************************** IC2134.2 +002100* THIS IS MAIN PROGRAM IC213. IC2134.2 +002200**************************************************************** IC2134.2 +002300 ENVIRONMENT DIVISION. IC2134.2 +002400 CONFIGURATION SECTION. IC2134.2 +002500 SOURCE-COMPUTER. IC2134.2 +002600 Linux. IC2134.2 +002700 OBJECT-COMPUTER. IC2134.2 +002800 Linux. IC2134.2 +002900 INPUT-OUTPUT SECTION. IC2134.2 +003000 FILE-CONTROL. IC2134.2 +003100 SELECT PRINT-FILE ASSIGN TO IC2134.2 +003200 "report.log". IC2134.2 +003300 DATA DIVISION. IC2134.2 +003400 FILE SECTION. IC2134.2 +003500 FD PRINT-FILE. IC2134.2 +003600 01 PRINT-REC PICTURE X(120). IC2134.2 +003700 01 DUMMY-RECORD PICTURE X(120). IC2134.2 +003800 WORKING-STORAGE SECTION. IC2134.2 +003900 01 DN1 PICTURE S9 VALUE ZERO. IC2134.2 +004000 01 DN2 PICTURE S9 VALUE ZERO. IC2134.2 +004100 01 DN3 PICTURE S9 VALUE ZERO. IC2134.2 +004200 01 TEST-RESULTS. IC2134.2 +004300 02 FILLER PIC X VALUE SPACE. IC2134.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IC2134.2 +004500 02 FILLER PIC X VALUE SPACE. IC2134.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IC2134.2 +004700 02 FILLER PIC X VALUE SPACE. IC2134.2 +004800 02 PAR-NAME. IC2134.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IC2134.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IC2134.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IC2134.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IC2134.2 +005300 02 RE-MARK PIC X(61). IC2134.2 +005400 01 TEST-COMPUTED. IC2134.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IC2134.2 +005600 02 FILLER PIC X(17) VALUE IC2134.2 +005700 " COMPUTED=". IC2134.2 +005800 02 COMPUTED-X. IC2134.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2134.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IC2134.2 +006100 PIC -9(9).9(9). IC2134.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2134.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2134.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2134.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IC2134.2 +006600 04 COMPUTED-18V0 PIC -9(18). IC2134.2 +006700 04 FILLER PIC X. IC2134.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IC2134.2 +006900 01 TEST-CORRECT. IC2134.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IC2134.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IC2134.2 +007200 02 CORRECT-X. IC2134.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IC2134.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2134.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2134.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2134.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2134.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IC2134.2 +007900 04 CORRECT-18V0 PIC -9(18). IC2134.2 +008000 04 FILLER PIC X. IC2134.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IC2134.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2134.2 +008300 01 CCVS-C-1. IC2134.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2134.2 +008500- "SS PARAGRAPH-NAME IC2134.2 +008600- " REMARKS". IC2134.2 +008700 02 FILLER PIC X(20) VALUE SPACE. IC2134.2 +008800 01 CCVS-C-2. IC2134.2 +008900 02 FILLER PIC X VALUE SPACE. IC2134.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". IC2134.2 +009100 02 FILLER PIC X(15) VALUE SPACE. IC2134.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". IC2134.2 +009300 02 FILLER PIC X(94) VALUE SPACE. IC2134.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2134.2 +009500 01 REC-CT PIC 99 VALUE ZERO. IC2134.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2134.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2134.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2134.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2134.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2134.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2134.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2134.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2134.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2134.2 +010500 01 CCVS-H-1. IC2134.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IC2134.2 +010700 02 FILLER PIC X(42) VALUE IC2134.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2134.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IC2134.2 +011000 01 CCVS-H-2A. IC2134.2 +011100 02 FILLER PIC X(40) VALUE SPACE. IC2134.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2134.2 +011300 02 FILLER PIC XXXX VALUE IC2134.2 +011400 "4.2 ". IC2134.2 +011500 02 FILLER PIC X(28) VALUE IC2134.2 +011600 " COPY - NOT FOR DISTRIBUTION". IC2134.2 +011700 02 FILLER PIC X(41) VALUE SPACE. IC2134.2 +011800 IC2134.2 +011900 01 CCVS-H-2B. IC2134.2 +012000 02 FILLER PIC X(15) VALUE IC2134.2 +012100 "TEST RESULT OF ". IC2134.2 +012200 02 TEST-ID PIC X(9). IC2134.2 +012300 02 FILLER PIC X(4) VALUE IC2134.2 +012400 " IN ". IC2134.2 +012500 02 FILLER PIC X(12) VALUE IC2134.2 +012600 " HIGH ". IC2134.2 +012700 02 FILLER PIC X(22) VALUE IC2134.2 +012800 " LEVEL VALIDATION FOR ". IC2134.2 +012900 02 FILLER PIC X(58) VALUE IC2134.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2134.2 +013100 01 CCVS-H-3. IC2134.2 +013200 02 FILLER PIC X(34) VALUE IC2134.2 +013300 " FOR OFFICIAL USE ONLY ". IC2134.2 +013400 02 FILLER PIC X(58) VALUE IC2134.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2134.2 +013600 02 FILLER PIC X(28) VALUE IC2134.2 +013700 " COPYRIGHT 1985 ". IC2134.2 +013800 01 CCVS-E-1. IC2134.2 +013900 02 FILLER PIC X(52) VALUE SPACE. IC2134.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2134.2 +014100 02 ID-AGAIN PIC X(9). IC2134.2 +014200 02 FILLER PIC X(45) VALUE SPACES. IC2134.2 +014300 01 CCVS-E-2. IC2134.2 +014400 02 FILLER PIC X(31) VALUE SPACE. IC2134.2 +014500 02 FILLER PIC X(21) VALUE SPACE. IC2134.2 +014600 02 CCVS-E-2-2. IC2134.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2134.2 +014800 03 FILLER PIC X VALUE SPACE. IC2134.2 +014900 03 ENDER-DESC PIC X(44) VALUE IC2134.2 +015000 "ERRORS ENCOUNTERED". IC2134.2 +015100 01 CCVS-E-3. IC2134.2 +015200 02 FILLER PIC X(22) VALUE IC2134.2 +015300 " FOR OFFICIAL USE ONLY". IC2134.2 +015400 02 FILLER PIC X(12) VALUE SPACE. IC2134.2 +015500 02 FILLER PIC X(58) VALUE IC2134.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2134.2 +015700 02 FILLER PIC X(13) VALUE SPACE. IC2134.2 +015800 02 FILLER PIC X(15) VALUE IC2134.2 +015900 " COPYRIGHT 1985". IC2134.2 +016000 01 CCVS-E-4. IC2134.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2134.2 +016200 02 FILLER PIC X(4) VALUE " OF ". IC2134.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2134.2 +016400 02 FILLER PIC X(40) VALUE IC2134.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". IC2134.2 +016600 01 XXINFO. IC2134.2 +016700 02 FILLER PIC X(19) VALUE IC2134.2 +016800 "*** INFORMATION ***". IC2134.2 +016900 02 INFO-TEXT. IC2134.2 +017000 04 FILLER PIC X(8) VALUE SPACE. IC2134.2 +017100 04 XXCOMPUTED PIC X(20). IC2134.2 +017200 04 FILLER PIC X(5) VALUE SPACE. IC2134.2 +017300 04 XXCORRECT PIC X(20). IC2134.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). IC2134.2 +017500 01 HYPHEN-LINE. IC2134.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. IC2134.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************IC2134.2 +017800- "*****************************************". IC2134.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************IC2134.2 +018000- "******************************". IC2134.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE IC2134.2 +018200 "IC213A". IC2134.2 +018300 PROCEDURE DIVISION. IC2134.2 +018400 CCVS1 SECTION. IC2134.2 +018500 OPEN-FILES. IC2134.2 +018600 OPEN OUTPUT PRINT-FILE. IC2134.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2134.2 +018800 MOVE SPACE TO TEST-RESULTS. IC2134.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2134.2 +019000 GO TO CCVS1-EXIT. IC2134.2 +019100 CLOSE-FILES. IC2134.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2134.2 +019300 TERMINATE-CCVS. IC2134.2 +019400*S EXIT PROGRAM. IC2134.2 +019500*SERMINATE-CALL. IC2134.2 +019600 STOP RUN. IC2134.2 +019700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2134.2 +019800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2134.2 +019900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2134.2 +020000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2134.2 +020100 MOVE "****TEST DELETED****" TO RE-MARK. IC2134.2 +020200 PRINT-DETAIL. IC2134.2 +020300 IF REC-CT NOT EQUAL TO ZERO IC2134.2 +020400 MOVE "." TO PARDOT-X IC2134.2 +020500 MOVE REC-CT TO DOTVALUE. IC2134.2 +020600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2134.2 +020700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2134.2 +020800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2134.2 +020900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2134.2 +021000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2134.2 +021100 MOVE SPACE TO CORRECT-X. IC2134.2 +021200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2134.2 +021300 MOVE SPACE TO RE-MARK. IC2134.2 +021400 HEAD-ROUTINE. IC2134.2 +021500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +021600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +021700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2134.2 +021800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2134.2 +021900 COLUMN-NAMES-ROUTINE. IC2134.2 +022000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +022100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +022300 END-ROUTINE. IC2134.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2134.2 +022500 END-RTN-EXIT. IC2134.2 +022600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +022700 END-ROUTINE-1. IC2134.2 +022800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2134.2 +022900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2134.2 +023000 ADD PASS-COUNTER TO ERROR-HOLD. IC2134.2 +023100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2134.2 +023200 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2134.2 +023300 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2134.2 +023400 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2134.2 +023500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2134.2 +023600 END-ROUTINE-12. IC2134.2 +023700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2134.2 +023800 IF ERROR-COUNTER IS EQUAL TO ZERO IC2134.2 +023900 MOVE "NO " TO ERROR-TOTAL IC2134.2 +024000 ELSE IC2134.2 +024100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2134.2 +024200 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2134.2 +024300 PERFORM WRITE-LINE. IC2134.2 +024400 END-ROUTINE-13. IC2134.2 +024500 IF DELETE-COUNTER IS EQUAL TO ZERO IC2134.2 +024600 MOVE "NO " TO ERROR-TOTAL ELSE IC2134.2 +024700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2134.2 +024800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2134.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +025000 IF INSPECT-COUNTER EQUAL TO ZERO IC2134.2 +025100 MOVE "NO " TO ERROR-TOTAL IC2134.2 +025200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2134.2 +025300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2134.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +025500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2134.2 +025600 WRITE-LINE. IC2134.2 +025700 ADD 1 TO RECORD-COUNT. IC2134.2 +025800 IF RECORD-COUNT GREATER 50 IC2134.2 +025900 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2134.2 +026000 MOVE SPACE TO DUMMY-RECORD IC2134.2 +026100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2134.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2134.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2134.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2134.2 +026500 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2134.2 +026600 MOVE ZERO TO RECORD-COUNT. IC2134.2 +026700 PERFORM WRT-LN. IC2134.2 +026800 WRT-LN. IC2134.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2134.2 +027000 MOVE SPACE TO DUMMY-RECORD. IC2134.2 +027100 BLANK-LINE-PRINT. IC2134.2 +027200 PERFORM WRT-LN. IC2134.2 +027300 FAIL-ROUTINE. IC2134.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2134.2 +027500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2134.2 +027600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2134.2 +027700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2134.2 +027800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +027900 MOVE SPACES TO INF-ANSI-REFERENCE. IC2134.2 +028000 GO TO FAIL-ROUTINE-EX. IC2134.2 +028100 FAIL-ROUTINE-WRITE. IC2134.2 +028200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2134.2 +028300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2134.2 +028400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2134.2 +028500 MOVE SPACES TO COR-ANSI-REFERENCE. IC2134.2 +028600 FAIL-ROUTINE-EX. EXIT. IC2134.2 +028700 BAIL-OUT. IC2134.2 +028800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2134.2 +028900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2134.2 +029000 BAIL-OUT-WRITE. IC2134.2 +029100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2134.2 +029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2134.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2134.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. IC2134.2 +029500 BAIL-OUT-EX. EXIT. IC2134.2 +029600 CCVS1-EXIT. IC2134.2 +029700 EXIT. IC2134.2 +029800 CALL-TEST-1. IC2134.2 +029900 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2134.2 +030000 MOVE "CALL-TEST-1" TO PAR-NAME. IC2134.2 +030100 MOVE "MAIN PROGRAM CALLS SUBPROGRAM1" TO RE-MARK. IC2134.2 +030200 CALL "IC214A" USING DN1. IC2134.2 +030300 IF DN1 IS EQUAL TO 1 IC2134.2 +030400 PERFORM PASS IC2134.2 +030500 GO TO CALL-WRITE-1. IC2134.2 +030600 CALL-FAIL-1. IC2134.2 +030700 MOVE 1 TO CORRECT-18V0. IC2134.2 +030800 MOVE DN1 TO COMPUTED-18V0. IC2134.2 +030900 PERFORM FAIL. IC2134.2 +031000 CALL-WRITE-1. IC2134.2 +031100 PERFORM PRINT-DETAIL. IC2134.2 +031200 CALL-TEST-2. IC2134.2 +031300 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2134.2 +031400 MOVE "CALL-TEST-2" TO PAR-NAME. IC2134.2 +031500 MOVE "MAIN PROGRAM CALLS SUBPROGRAM2" TO RE-MARK. IC2134.2 +031600 CALL "IC215A" USING DN2, DN3. IC2134.2 +031700 IF DN2 IS EQUAL TO 1 IC2134.2 +031800 PERFORM PASS IC2134.2 +031900 GO TO CALL-WRITE-2. IC2134.2 +032000 CALL-FAIL-2. IC2134.2 +032100 MOVE 1 TO CORRECT-18V0. IC2134.2 +032200 MOVE DN2 TO COMPUTED-18V0. IC2134.2 +032300 PERFORM FAIL. IC2134.2 +032400 CALL-WRITE-2. IC2134.2 +032500 PERFORM PRINT-DETAIL. IC2134.2 +032600 CANCEL-TEST-1. IC2134.2 +032700 MOVE "CANCEL" TO FEATURE. IC2134.2 +032800 MOVE "CANCEL-TEST-1" TO PAR-NAME. IC2134.2 +032900 MOVE "SUBPROGRAM2 CANCELS SUBPROGRAM1" TO RE-MARK. IC2134.2 +033000 IF DN3 IS EQUAL TO 1 IC2134.2 +033100 PERFORM PASS IC2134.2 +033200 GO TO CANCEL-WRITE-1. IC2134.2 +033300 CANCEL-FAIL-1. IC2134.2 +033400 MOVE 1 TO CORRECT-18V0. IC2134.2 +033500 MOVE DN3 TO COMPUTED-18V0. IC2134.2 +033600 PERFORM FAIL. IC2134.2 +033700 CANCEL-WRITE-1. IC2134.2 +033800 PERFORM PRINT-DETAIL. IC2134.2 +033900 CCVS-EXIT SECTION. IC2134.2 +034000 CCVS-999999. IC2134.2 +034100 GO TO CLOSE-FILES. IC2134.2 diff --git a/tests/cobol85/IC/IC216A.CBL b/tests/cobol85/IC/IC216A.CBL new file mode 100755 index 00000000..2dcd35d9 --- /dev/null +++ b/tests/cobol85/IC/IC216A.CBL @@ -0,0 +1,333 @@ +000100 IDENTIFICATION DIVISION. IC2164.2 +000200 PROGRAM-ID. IC2164.2 +000300 IC216A. IC2164.2 +000400**************************************************************** IC2164.2 +000500* * IC2164.2 +000600* VALIDATION FOR:- * IC2164.2 +000700* * IC2164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2164.2 +000900* * IC2164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2164.2 +001100* * IC2164.2 +001200**************************************************************** IC2164.2 +001300* * IC2164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2164.2 +001500* * IC2164.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2164.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2164.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2164.2 +001900* * IC2164.2 +002000**************************************************************** IC2164.2 +002100* THIS IS MAIN PROGRAM IC216. IC2164.2 +002200**************************************************************** IC2164.2 +002300 ENVIRONMENT DIVISION. IC2164.2 +002400 CONFIGURATION SECTION. IC2164.2 +002500 SOURCE-COMPUTER. IC2164.2 +002600 Linux. IC2164.2 +002700 OBJECT-COMPUTER. IC2164.2 +002800 Linux. IC2164.2 +002900 INPUT-OUTPUT SECTION. IC2164.2 +003000 FILE-CONTROL. IC2164.2 +003100 SELECT PRINT-FILE ASSIGN TO IC2164.2 +003200 "report.log". IC2164.2 +003300 DATA DIVISION. IC2164.2 +003400 FILE SECTION. IC2164.2 +003500 FD PRINT-FILE. IC2164.2 +003600 01 PRINT-REC PICTURE X(120). IC2164.2 +003700 01 DUMMY-RECORD PICTURE X(120). IC2164.2 +003800 WORKING-STORAGE SECTION. IC2164.2 +003900 01 DN1. IC2164.2 +004000 02 DN2 PICTURE X(5). IC2164.2 +004100 02 DN3 REDEFINES DN2 PICTURE 9(5). IC2164.2 +004200 01 DN4. IC2164.2 +004300 02 DN5. IC2164.2 +004400 03 DN6 PICTURE X(3). IC2164.2 +004500 03 DN7 PICTURE X(3). IC2164.2 +004600 03 DN8 REDEFINES DN7 PICTURE 9(3). IC2164.2 +004700 02 DN9 PICTURE XX. IC2164.2 +004800 01 TEST-RESULTS. IC2164.2 +004900 02 FILLER PIC X VALUE SPACE. IC2164.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IC2164.2 +005100 02 FILLER PIC X VALUE SPACE. IC2164.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IC2164.2 +005300 02 FILLER PIC X VALUE SPACE. IC2164.2 +005400 02 PAR-NAME. IC2164.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IC2164.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IC2164.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IC2164.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IC2164.2 +005900 02 RE-MARK PIC X(61). IC2164.2 +006000 01 TEST-COMPUTED. IC2164.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IC2164.2 +006200 02 FILLER PIC X(17) VALUE IC2164.2 +006300 " COMPUTED=". IC2164.2 +006400 02 COMPUTED-X. IC2164.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2164.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IC2164.2 +006700 PIC -9(9).9(9). IC2164.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2164.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2164.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2164.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IC2164.2 +007200 04 COMPUTED-18V0 PIC -9(18). IC2164.2 +007300 04 FILLER PIC X. IC2164.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IC2164.2 +007500 01 TEST-CORRECT. IC2164.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IC2164.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IC2164.2 +007800 02 CORRECT-X. IC2164.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IC2164.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2164.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2164.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2164.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2164.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IC2164.2 +008500 04 CORRECT-18V0 PIC -9(18). IC2164.2 +008600 04 FILLER PIC X. IC2164.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IC2164.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2164.2 +008900 01 CCVS-C-1. IC2164.2 +009000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2164.2 +009100- "SS PARAGRAPH-NAME IC2164.2 +009200- " REMARKS". IC2164.2 +009300 02 FILLER PIC X(20) VALUE SPACE. IC2164.2 +009400 01 CCVS-C-2. IC2164.2 +009500 02 FILLER PIC X VALUE SPACE. IC2164.2 +009600 02 FILLER PIC X(6) VALUE "TESTED". IC2164.2 +009700 02 FILLER PIC X(15) VALUE SPACE. IC2164.2 +009800 02 FILLER PIC X(4) VALUE "FAIL". IC2164.2 +009900 02 FILLER PIC X(94) VALUE SPACE. IC2164.2 +010000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2164.2 +010100 01 REC-CT PIC 99 VALUE ZERO. IC2164.2 +010200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2164.2 +010300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2164.2 +010400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2164.2 +010500 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2164.2 +010600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2164.2 +010700 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2164.2 +010800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2164.2 +010900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2164.2 +011000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2164.2 +011100 01 CCVS-H-1. IC2164.2 +011200 02 FILLER PIC X(39) VALUE SPACES. IC2164.2 +011300 02 FILLER PIC X(42) VALUE IC2164.2 +011400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2164.2 +011500 02 FILLER PIC X(39) VALUE SPACES. IC2164.2 +011600 01 CCVS-H-2A. IC2164.2 +011700 02 FILLER PIC X(40) VALUE SPACE. IC2164.2 +011800 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2164.2 +011900 02 FILLER PIC XXXX VALUE IC2164.2 +012000 "4.2 ". IC2164.2 +012100 02 FILLER PIC X(28) VALUE IC2164.2 +012200 " COPY - NOT FOR DISTRIBUTION". IC2164.2 +012300 02 FILLER PIC X(41) VALUE SPACE. IC2164.2 +012400 IC2164.2 +012500 01 CCVS-H-2B. IC2164.2 +012600 02 FILLER PIC X(15) VALUE IC2164.2 +012700 "TEST RESULT OF ". IC2164.2 +012800 02 TEST-ID PIC X(9). IC2164.2 +012900 02 FILLER PIC X(4) VALUE IC2164.2 +013000 " IN ". IC2164.2 +013100 02 FILLER PIC X(12) VALUE IC2164.2 +013200 " HIGH ". IC2164.2 +013300 02 FILLER PIC X(22) VALUE IC2164.2 +013400 " LEVEL VALIDATION FOR ". IC2164.2 +013500 02 FILLER PIC X(58) VALUE IC2164.2 +013600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2164.2 +013700 01 CCVS-H-3. IC2164.2 +013800 02 FILLER PIC X(34) VALUE IC2164.2 +013900 " FOR OFFICIAL USE ONLY ". IC2164.2 +014000 02 FILLER PIC X(58) VALUE IC2164.2 +014100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2164.2 +014200 02 FILLER PIC X(28) VALUE IC2164.2 +014300 " COPYRIGHT 1985 ". IC2164.2 +014400 01 CCVS-E-1. IC2164.2 +014500 02 FILLER PIC X(52) VALUE SPACE. IC2164.2 +014600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2164.2 +014700 02 ID-AGAIN PIC X(9). IC2164.2 +014800 02 FILLER PIC X(45) VALUE SPACES. IC2164.2 +014900 01 CCVS-E-2. IC2164.2 +015000 02 FILLER PIC X(31) VALUE SPACE. IC2164.2 +015100 02 FILLER PIC X(21) VALUE SPACE. IC2164.2 +015200 02 CCVS-E-2-2. IC2164.2 +015300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2164.2 +015400 03 FILLER PIC X VALUE SPACE. IC2164.2 +015500 03 ENDER-DESC PIC X(44) VALUE IC2164.2 +015600 "ERRORS ENCOUNTERED". IC2164.2 +015700 01 CCVS-E-3. IC2164.2 +015800 02 FILLER PIC X(22) VALUE IC2164.2 +015900 " FOR OFFICIAL USE ONLY". IC2164.2 +016000 02 FILLER PIC X(12) VALUE SPACE. IC2164.2 +016100 02 FILLER PIC X(58) VALUE IC2164.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2164.2 +016300 02 FILLER PIC X(13) VALUE SPACE. IC2164.2 +016400 02 FILLER PIC X(15) VALUE IC2164.2 +016500 " COPYRIGHT 1985". IC2164.2 +016600 01 CCVS-E-4. IC2164.2 +016700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2164.2 +016800 02 FILLER PIC X(4) VALUE " OF ". IC2164.2 +016900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2164.2 +017000 02 FILLER PIC X(40) VALUE IC2164.2 +017100 " TESTS WERE EXECUTED SUCCESSFULLY". IC2164.2 +017200 01 XXINFO. IC2164.2 +017300 02 FILLER PIC X(19) VALUE IC2164.2 +017400 "*** INFORMATION ***". IC2164.2 +017500 02 INFO-TEXT. IC2164.2 +017600 04 FILLER PIC X(8) VALUE SPACE. IC2164.2 +017700 04 XXCOMPUTED PIC X(20). IC2164.2 +017800 04 FILLER PIC X(5) VALUE SPACE. IC2164.2 +017900 04 XXCORRECT PIC X(20). IC2164.2 +018000 02 INF-ANSI-REFERENCE PIC X(48). IC2164.2 +018100 01 HYPHEN-LINE. IC2164.2 +018200 02 FILLER PIC IS X VALUE IS SPACE. IC2164.2 +018300 02 FILLER PIC IS X(65) VALUE IS "************************IC2164.2 +018400- "*****************************************". IC2164.2 +018500 02 FILLER PIC IS X(54) VALUE IS "************************IC2164.2 +018600- "******************************". IC2164.2 +018700 01 CCVS-PGM-ID PIC X(9) VALUE IC2164.2 +018800 "IC216A". IC2164.2 +018900 PROCEDURE DIVISION. IC2164.2 +019000 CCVS1 SECTION. IC2164.2 +019100 OPEN-FILES. IC2164.2 +019200 OPEN OUTPUT PRINT-FILE. IC2164.2 +019300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2164.2 +019400 MOVE SPACE TO TEST-RESULTS. IC2164.2 +019500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2164.2 +019600 GO TO CCVS1-EXIT. IC2164.2 +019700 CLOSE-FILES. IC2164.2 +019800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2164.2 +019900 TERMINATE-CCVS. IC2164.2 +020000*S EXIT PROGRAM. IC2164.2 +020100*SERMINATE-CALL. IC2164.2 +020200 STOP RUN. IC2164.2 +020300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2164.2 +020400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2164.2 +020500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2164.2 +020600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2164.2 +020700 MOVE "****TEST DELETED****" TO RE-MARK. IC2164.2 +020800 PRINT-DETAIL. IC2164.2 +020900 IF REC-CT NOT EQUAL TO ZERO IC2164.2 +021000 MOVE "." TO PARDOT-X IC2164.2 +021100 MOVE REC-CT TO DOTVALUE. IC2164.2 +021200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2164.2 +021300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2164.2 +021400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2164.2 +021500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2164.2 +021600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2164.2 +021700 MOVE SPACE TO CORRECT-X. IC2164.2 +021800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2164.2 +021900 MOVE SPACE TO RE-MARK. IC2164.2 +022000 HEAD-ROUTINE. IC2164.2 +022100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +022200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +022300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2164.2 +022400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2164.2 +022500 COLUMN-NAMES-ROUTINE. IC2164.2 +022600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +022700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +022800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +022900 END-ROUTINE. IC2164.2 +023000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2164.2 +023100 END-RTN-EXIT. IC2164.2 +023200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +023300 END-ROUTINE-1. IC2164.2 +023400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2164.2 +023500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2164.2 +023600 ADD PASS-COUNTER TO ERROR-HOLD. IC2164.2 +023700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2164.2 +023800 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2164.2 +023900 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2164.2 +024000 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2164.2 +024100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2164.2 +024200 END-ROUTINE-12. IC2164.2 +024300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2164.2 +024400 IF ERROR-COUNTER IS EQUAL TO ZERO IC2164.2 +024500 MOVE "NO " TO ERROR-TOTAL IC2164.2 +024600 ELSE IC2164.2 +024700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2164.2 +024800 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2164.2 +024900 PERFORM WRITE-LINE. IC2164.2 +025000 END-ROUTINE-13. IC2164.2 +025100 IF DELETE-COUNTER IS EQUAL TO ZERO IC2164.2 +025200 MOVE "NO " TO ERROR-TOTAL ELSE IC2164.2 +025300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2164.2 +025400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2164.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +025600 IF INSPECT-COUNTER EQUAL TO ZERO IC2164.2 +025700 MOVE "NO " TO ERROR-TOTAL IC2164.2 +025800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2164.2 +025900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2164.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +026100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2164.2 +026200 WRITE-LINE. IC2164.2 +026300 ADD 1 TO RECORD-COUNT. IC2164.2 +026400 IF RECORD-COUNT GREATER 50 IC2164.2 +026500 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2164.2 +026600 MOVE SPACE TO DUMMY-RECORD IC2164.2 +026700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2164.2 +026800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2164.2 +026900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2164.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2164.2 +027100 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2164.2 +027200 MOVE ZERO TO RECORD-COUNT. IC2164.2 +027300 PERFORM WRT-LN. IC2164.2 +027400 WRT-LN. IC2164.2 +027500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2164.2 +027600 MOVE SPACE TO DUMMY-RECORD. IC2164.2 +027700 BLANK-LINE-PRINT. IC2164.2 +027800 PERFORM WRT-LN. IC2164.2 +027900 FAIL-ROUTINE. IC2164.2 +028000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2164.2 +028100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2164.2 +028200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2164.2 +028300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2164.2 +028400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +028500 MOVE SPACES TO INF-ANSI-REFERENCE. IC2164.2 +028600 GO TO FAIL-ROUTINE-EX. IC2164.2 +028700 FAIL-ROUTINE-WRITE. IC2164.2 +028800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2164.2 +028900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2164.2 +029000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2164.2 +029100 MOVE SPACES TO COR-ANSI-REFERENCE. IC2164.2 +029200 FAIL-ROUTINE-EX. EXIT. IC2164.2 +029300 BAIL-OUT. IC2164.2 +029400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2164.2 +029500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2164.2 +029600 BAIL-OUT-WRITE. IC2164.2 +029700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2164.2 +029800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2164.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2164.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. IC2164.2 +030100 BAIL-OUT-EX. EXIT. IC2164.2 +030200 CCVS1-EXIT. IC2164.2 +030300 EXIT. IC2164.2 +030400 CALL-TEST-1. IC2164.2 +030500 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2164.2 +030600 MOVE "CALL-TEST-1" TO PAR-NAME. IC2164.2 +030700 MOVE "REFERENCING REDEFINED DATA-NAMES" TO RE-MARK. IC2164.2 +030800 CALL "IC217A" USING DN1, DN4. IC2164.2 +030900 IF DN1 = 12345 IC2164.2 +031000 PERFORM PASS IC2164.2 +031100 GO TO CALL-WRITE-1. IC2164.2 +031200 CALL-FAIL-1. IC2164.2 +031300 MOVE DN1 TO COMPUTED-A. IC2164.2 +031400 MOVE 12345 TO CORRECT-A. IC2164.2 +031500 PERFORM FAIL. IC2164.2 +031600 CALL-WRITE-1. IC2164.2 +031700 PERFORM PRINT-DETAIL. IC2164.2 +031800 CALL-TEST-2. IC2164.2 +031900 MOVE "CALL...USING DATA-NM" TO FEATURE. IC2164.2 +032000 MOVE "CALL-TEST-2" TO PAR-NAME. IC2164.2 +032100 MOVE "REFERENCING REDEFINED DATA-NAMES" TO RE-MARK. IC2164.2 +032200 IF DN4 = "YES987NO" IC2164.2 +032300 PERFORM PASS IC2164.2 +032400 GO TO CALL-WRITE-2. IC2164.2 +032500 CALL-FAIL-2. IC2164.2 +032600 MOVE DN4 TO COMPUTED-A. IC2164.2 +032700 MOVE "YES987NO" TO CORRECT-A. IC2164.2 +032800 PERFORM FAIL. IC2164.2 +032900 CALL-WRITE-2. IC2164.2 +033000 PERFORM PRINT-DETAIL. IC2164.2 +033100 CCVS-EXIT SECTION. IC2164.2 +033200 CCVS-999999. IC2164.2 +033300 GO TO CLOSE-FILES. IC2164.2 diff --git a/tests/cobol85/IC/IC222A.CBL b/tests/cobol85/IC/IC222A.CBL new file mode 100755 index 00000000..fcadfe33 --- /dev/null +++ b/tests/cobol85/IC/IC222A.CBL @@ -0,0 +1,1162 @@ +000100 IDENTIFICATION DIVISION. IC2224.2 +000200 PROGRAM-ID. IC2224.2 +000300 IC222A. IC2224.2 +000400**************************************************************** IC2224.2 +000500* * IC2224.2 +000600* VALIDATION FOR:- * IC2224.2 +000700* * IC2224.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2224.2 +000900* * IC2224.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2224.2 +001100* * IC2224.2 +001200**************************************************************** IC2224.2 +001300* * IC2224.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2224.2 +001500* * IC2224.2 +001600* X-55 SYSTEM PRINTER * IC2224.2 +001700* X-82 SOURCE-COMPUTER * IC2224.2 +001800* X-83 OBJECT-COMPUTER. * IC2224.2 +001900* * IC2224.2 +002000**************************************************************** IC2224.2 +002100* * IC2224.2 +002200* THE SOURCE FILE CONTAINS TWO PROGRAMS, IC222A AND * IC2224.2 +002300* IC222A-1, WHICH TEST LANGUAGE ELEMENTS FROM LEVEL 2 OF * IC2224.2 +002400* THE INTER-PROGRAM COMMUNICATION MODULE. THE LANGUAGE * IC2224.2 +002500* ELEMENTS TESTED ARE: * IC2224.2 +002600* "ON EXCEPTION" PHRASE * IC2224.2 +002700* "NOT ON EXCEPTION" PHRASE * IC2224.2 +002800* "END-CALL" PHRASE * IC2224.2 +002900* "ON OVERFLOW" PHRASE * IC2224.2 +003000* * IC2224.2 +003100* THE TWO PROGRAMS SHOULD BE COMPILED IN THE SAME * IC2224.2 +003200* INVOCATION OF THE COMPILER TO TEST THE BATCH COMPILATION * IC2224.2 +003300* FEATURE AND RECOGNITION OF THE END PROGRAM HEADER. THE * IC2224.2 +003400* ARRANGEMENT OF THE PROGRAMS IN THE SOURCE FILE IS: * IC2224.2 +003500* * IC2224.2 +003600* IDENTIFICATION DIVISION. * IC2224.2 +003700* PROGRAM-ID. IC222A. * IC2224.2 +003800* . * IC2224.2 +003900* . * IC2224.2 +004000* . * IC2224.2 +004100* END PROGRAM IC222A. IC2224.2 +004200* IDENTIFICATION DIVISION. IC2224.2 +004300* PROGRAM-ID. IC222A-1. IC2224.2 +004400* . * IC2224.2 +004500* . * IC2224.2 +004600* . * IC2224.2 +004700* * IC2224.2 +004800* IC222A, THE FIRST PROGRAM IN THE FILE, CONTAINS THE * IC2224.2 +004900* SUBSTANTIVE TESTS. THE ONLY FUNCTION OF THE OTHER * IC2224.2 +005000* PROGRAM IS TO ENSURE THAT A PROGRAM WITH KNOWN PARAMETER * IC2224.2 +005100* REQUIREMENTS IS AVAILABLE TO BE CALLED. IC222A TESTS * IC2224.2 +005200* CONTROL FLOW THROUGH VARIANTS OF THE CALL STATEMENT WITH * IC2224.2 +005300* THE "ON EXCEPTION" PHRASE PRESENT OR ABSENT; THE "NOT ON * IC2224.2 +005400* EXCEPTION" PHRASE PRESENT OR ABSENT; AND AVAILABLE OR * IC2224.2 +005500* NON-AVAIABLE TARGET PROGRAMS. EACH CALL STATEMENT HAS AN * IC2224.2 +005600* END-CALL PHRASE, AND THERE ARE SECONDARY TESTS WHICH * IC2224.2 +005700* CHECK THAT STATEMENTS FOLLOWING END-CALL ARE PROPERLY * IC2224.2 +005800* EXECUTED. * IC2224.2 +005900* IC2224.2 +006000* THIS TEST SET DOES NOT EXAMINE THE RESULTS RETURNED BY * IC2224.2 +006100* THE CALLED PROGRAM, BUT IS WHOLLY CONCERNED WITH THE FLOW * IC2224.2 +006200* OF CONTROL IN THE CALLING PROGRAM DURING EXECUTION OF A * IC2224.2 +006300* CALL STATEMENT. * IC2224.2 +006400* * IC2224.2 +006500* THERE ARE EIGHT POSIBLE COMBINATIONS OF CALL STATEMENT * IC2224.2 +006600* FORMAT AND CALLED PROGRAM AVAILABILITY THAT COULD BE * IC2224.2 +006700* TESTED. TWO OF THESE COMBINATIONS, THOSE WHERE A PROGRAM * IC2224.2 +006800* WHICH IS NOT AVAILABLE IS CALLED THROUGH A STATEMENT * IC2224.2 +006900* WHICH DOES NOT CONTAIN AN "ON EXCEPTION" PHRASE, PRODUCE * IC2224.2 +007000* EFFECTS WHICH THE STANDARD LEAVES UNDEFINED. THUS THERE * IC2224.2 +007100* ARE SIX CASES WHICH CAN BE TESTED. THIS TEST SUITE TESTS * IC2224.2 +007200* ALL SIX. IN ADDITION, IT TESTS THE TWO CASES WHERE * IC2224.2 +007300* "ON OVERFLOW" CAN BE USED IN PLACE OF "ON EXCEPTION". * IC2224.2 +007400* EACH OF THE EIGHT MAJOR TESTS IS FOLLOWED BY A * IC2224.2 +007500* SUBORDINATE TEST WHICH IS INTENDED TO CHECK THE WAY * IC2224.2 +007600* THAT CONTROL HAS FLOWED THROUGH THE PHRASES OF THE CALL * IC2224.2 +007700* STATEMENT. EVERY CALL STATEMENT IN IC222A HAS AN * IC2224.2 +007800* "END-CALL" SCOPE DELIMITER. THIS SCOPE DELIMITER IS * IC2224.2 +007900* FOLLOWED BY ONE MORE STATEMENT IN THE SENTENCE, AND THE * IC2224.2 +008000* SUBORDINATE TESTS CHECK THAT THIS ADDITIONAL STATEMENT * IC2224.2 +008100* HAS BEEN EXECUTED. * IC2224.2 +008200* * IC2224.2 +008300**************************************************************** IC2224.2 +008400* IC2224.2 +008500 ENVIRONMENT DIVISION. IC2224.2 +008600 CONFIGURATION SECTION. IC2224.2 +008700 SOURCE-COMPUTER. IC2224.2 +008800 Linux. IC2224.2 +008900 OBJECT-COMPUTER. IC2224.2 +009000 Linux. IC2224.2 +009100 INPUT-OUTPUT SECTION. IC2224.2 +009200 FILE-CONTROL. IC2224.2 +009300 SELECT PRINT-FILE ASSIGN TO IC2224.2 +009400 "report.log". IC2224.2 +009500* IC2224.2 +009600 DATA DIVISION. IC2224.2 +009700 FILE SECTION. IC2224.2 +009800 FD PRINT-FILE. IC2224.2 +009900 01 PRINT-REC PICTURE X(120). IC2224.2 +010000 01 DUMMY-RECORD PICTURE X(120). IC2224.2 +010100* IC2224.2 +010200 WORKING-STORAGE SECTION. IC2224.2 +010300 77 DN1 PICTURE S99 VALUE ZERO. IC2224.2 +010400 77 DN3 PICTURE S99. IC2224.2 +010500 77 ID1 PICTURE X(8) VALUE "IC222A-1". IC2224.2 +010600 77 ID2 PICTURE X(8). IC2224.2 +010700 77 DN2 PICTURE S99 IC2224.2 +010800 USAGE COMPUTATIONAL, VALUE ZERO. IC2224.2 +010900 77 DN4 PICTURE S99 IC2224.2 +011000 USAGE IS COMPUTATIONAL. IC2224.2 +011100 77 CALL-FLAG PIC 9. IC2224.2 +011200 01 EXCEPTION-PATH-FLAG PICTURE X. IC2224.2 +011300* IC2224.2 +011400 01 TEST-RESULTS. IC2224.2 +011500 02 FILLER PIC X VALUE SPACE. IC2224.2 +011600 02 FEATURE PIC X(20) VALUE SPACE. IC2224.2 +011700 02 FILLER PIC X VALUE SPACE. IC2224.2 +011800 02 P-OR-F PIC X(5) VALUE SPACE. IC2224.2 +011900 02 FILLER PIC X VALUE SPACE. IC2224.2 +012000 02 PAR-NAME. IC2224.2 +012100 03 FILLER PIC X(19) VALUE SPACE. IC2224.2 +012200 03 PARDOT-X PIC X VALUE SPACE. IC2224.2 +012300 03 DOTVALUE PIC 99 VALUE ZERO. IC2224.2 +012400 02 FILLER PIC X(8) VALUE SPACE. IC2224.2 +012500 02 RE-MARK PIC X(61). IC2224.2 +012600 01 TEST-COMPUTED. IC2224.2 +012700 02 FILLER PIC X(30) VALUE SPACE. IC2224.2 +012800 02 FILLER PIC X(17) VALUE IC2224.2 +012900 " COMPUTED=". IC2224.2 +013000 02 COMPUTED-X. IC2224.2 +013100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2224.2 +013200 03 COMPUTED-N REDEFINES COMPUTED-A IC2224.2 +013300 PIC -9(9).9(9). IC2224.2 +013400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2224.2 +013500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2224.2 +013600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2224.2 +013700 03 CM-18V0 REDEFINES COMPUTED-A. IC2224.2 +013800 04 COMPUTED-18V0 PIC -9(18). IC2224.2 +013900 04 FILLER PIC X. IC2224.2 +014000 03 FILLER PIC X(50) VALUE SPACE. IC2224.2 +014100 01 TEST-CORRECT. IC2224.2 +014200 02 FILLER PIC X(30) VALUE SPACE. IC2224.2 +014300 02 FILLER PIC X(17) VALUE " CORRECT =". IC2224.2 +014400 02 CORRECT-X. IC2224.2 +014500 03 CORRECT-A PIC X(20) VALUE SPACE. IC2224.2 +014600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2224.2 +014700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2224.2 +014800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2224.2 +014900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2224.2 +015000 03 CR-18V0 REDEFINES CORRECT-A. IC2224.2 +015100 04 CORRECT-18V0 PIC -9(18). IC2224.2 +015200 04 FILLER PIC X. IC2224.2 +015300 03 FILLER PIC X(2) VALUE SPACE. IC2224.2 +015400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2224.2 +015500 01 CCVS-C-1. IC2224.2 +015600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2224.2 +015700- "SS PARAGRAPH-NAME IC2224.2 +015800- " REMARKS". IC2224.2 +015900 02 FILLER PIC X(20) VALUE SPACE. IC2224.2 +016000 01 CCVS-C-2. IC2224.2 +016100 02 FILLER PIC X VALUE SPACE. IC2224.2 +016200 02 FILLER PIC X(6) VALUE "TESTED". IC2224.2 +016300 02 FILLER PIC X(15) VALUE SPACE. IC2224.2 +016400 02 FILLER PIC X(4) VALUE "FAIL". IC2224.2 +016500 02 FILLER PIC X(94) VALUE SPACE. IC2224.2 +016600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2224.2 +016700 01 REC-CT PIC 99 VALUE ZERO. IC2224.2 +016800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2224.2 +016900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2224.2 +017000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2224.2 +017100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2224.2 +017200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2224.2 +017300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2224.2 +017400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2224.2 +017500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2224.2 +017600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2224.2 +017700 01 CCVS-H-1. IC2224.2 +017800 02 FILLER PIC X(39) VALUE SPACES. IC2224.2 +017900 02 FILLER PIC X(42) VALUE IC2224.2 +018000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2224.2 +018100 02 FILLER PIC X(39) VALUE SPACES. IC2224.2 +018200 01 CCVS-H-2A. IC2224.2 +018300 02 FILLER PIC X(40) VALUE SPACE. IC2224.2 +018400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2224.2 +018500 02 FILLER PIC XXXX VALUE IC2224.2 +018600 "4.2 ". IC2224.2 +018700 02 FILLER PIC X(28) VALUE IC2224.2 +018800 " COPY - NOT FOR DISTRIBUTION". IC2224.2 +018900 02 FILLER PIC X(41) VALUE SPACE. IC2224.2 +019000 IC2224.2 +019100 01 CCVS-H-2B. IC2224.2 +019200 02 FILLER PIC X(15) VALUE IC2224.2 +019300 "TEST RESULT OF ". IC2224.2 +019400 02 TEST-ID PIC X(9). IC2224.2 +019500 02 FILLER PIC X(4) VALUE IC2224.2 +019600 " IN ". IC2224.2 +019700 02 FILLER PIC X(12) VALUE IC2224.2 +019800 " HIGH ". IC2224.2 +019900 02 FILLER PIC X(22) VALUE IC2224.2 +020000 " LEVEL VALIDATION FOR ". IC2224.2 +020100 02 FILLER PIC X(58) VALUE IC2224.2 +020200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2224.2 +020300 01 CCVS-H-3. IC2224.2 +020400 02 FILLER PIC X(34) VALUE IC2224.2 +020500 " FOR OFFICIAL USE ONLY ". IC2224.2 +020600 02 FILLER PIC X(58) VALUE IC2224.2 +020700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2224.2 +020800 02 FILLER PIC X(28) VALUE IC2224.2 +020900 " COPYRIGHT 1985,1986 ". IC2224.2 +021000 01 CCVS-E-1. IC2224.2 +021100 02 FILLER PIC X(52) VALUE SPACE. IC2224.2 +021200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2224.2 +021300 02 ID-AGAIN PIC X(9). IC2224.2 +021400 02 FILLER PIC X(45) VALUE SPACES. IC2224.2 +021500 01 CCVS-E-2. IC2224.2 +021600 02 FILLER PIC X(31) VALUE SPACE. IC2224.2 +021700 02 FILLER PIC X(21) VALUE SPACE. IC2224.2 +021800 02 CCVS-E-2-2. IC2224.2 +021900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2224.2 +022000 03 FILLER PIC X VALUE SPACE. IC2224.2 +022100 03 ENDER-DESC PIC X(44) VALUE IC2224.2 +022200 "ERRORS ENCOUNTERED". IC2224.2 +022300 01 CCVS-E-3. IC2224.2 +022400 02 FILLER PIC X(22) VALUE IC2224.2 +022500 " FOR OFFICIAL USE ONLY". IC2224.2 +022600 02 FILLER PIC X(12) VALUE SPACE. IC2224.2 +022700 02 FILLER PIC X(58) VALUE IC2224.2 +022800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2224.2 +022900 02 FILLER PIC X(8) VALUE SPACE. IC2224.2 +023000 02 FILLER PIC X(20) VALUE IC2224.2 +023100 " COPYRIGHT 1985,1986". IC2224.2 +023200 01 CCVS-E-4. IC2224.2 +023300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2224.2 +023400 02 FILLER PIC X(4) VALUE " OF ". IC2224.2 +023500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2224.2 +023600 02 FILLER PIC X(40) VALUE IC2224.2 +023700 " TESTS WERE EXECUTED SUCCESSFULLY". IC2224.2 +023800 01 XXINFO. IC2224.2 +023900 02 FILLER PIC X(19) VALUE IC2224.2 +024000 "*** INFORMATION ***". IC2224.2 +024100 02 INFO-TEXT. IC2224.2 +024200 04 FILLER PIC X(8) VALUE SPACE. IC2224.2 +024300 04 XXCOMPUTED PIC X(20). IC2224.2 +024400 04 FILLER PIC X(5) VALUE SPACE. IC2224.2 +024500 04 XXCORRECT PIC X(20). IC2224.2 +024600 02 INF-ANSI-REFERENCE PIC X(48). IC2224.2 +024700 01 HYPHEN-LINE. IC2224.2 +024800 02 FILLER PIC IS X VALUE IS SPACE. IC2224.2 +024900 02 FILLER PIC IS X(65) VALUE IS "************************IC2224.2 +025000- "*****************************************". IC2224.2 +025100 02 FILLER PIC IS X(54) VALUE IS "************************IC2224.2 +025200- "******************************". IC2224.2 +025300 01 CCVS-PGM-ID PIC X(9) VALUE IC2224.2 +025400 "IC222A". IC2224.2 +025500* IC2224.2 +025600 PROCEDURE DIVISION. IC2224.2 +025700 CCVS1 SECTION. IC2224.2 +025800 OPEN-FILES. IC2224.2 +025900 OPEN OUTPUT PRINT-FILE. IC2224.2 +026000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2224.2 +026100 MOVE SPACE TO TEST-RESULTS. IC2224.2 +026200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2224.2 +026300 GO TO CCVS1-EXIT. IC2224.2 +026400 CLOSE-FILES. IC2224.2 +026500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2224.2 +026600 TERMINATE-CCVS. IC2224.2 +026700*S EXIT PROGRAM. IC2224.2 +026800*SERMINATE-CALL. IC2224.2 +026900 STOP RUN. IC2224.2 +027000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2224.2 +027100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2224.2 +027200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2224.2 +027300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2224.2 +027400 MOVE "****TEST DELETED****" TO RE-MARK. IC2224.2 +027500 PRINT-DETAIL. IC2224.2 +027600 IF REC-CT NOT EQUAL TO ZERO IC2224.2 +027700 MOVE "." TO PARDOT-X IC2224.2 +027800 MOVE REC-CT TO DOTVALUE. IC2224.2 +027900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2224.2 +028000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2224.2 +028100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2224.2 +028200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2224.2 +028300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2224.2 +028400 MOVE SPACE TO CORRECT-X. IC2224.2 +028500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2224.2 +028600 MOVE SPACE TO RE-MARK. IC2224.2 +028700 HEAD-ROUTINE. IC2224.2 +028800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +028900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +029000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2224.2 +029100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2224.2 +029200 COLUMN-NAMES-ROUTINE. IC2224.2 +029300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +029400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +029500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +029600 END-ROUTINE. IC2224.2 +029700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2224.2 +029800 END-RTN-EXIT. IC2224.2 +029900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +030000 END-ROUTINE-1. IC2224.2 +030100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2224.2 +030200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2224.2 +030300 ADD PASS-COUNTER TO ERROR-HOLD. IC2224.2 +030400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2224.2 +030500 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2224.2 +030600 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2224.2 +030700 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2224.2 +030800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2224.2 +030900 END-ROUTINE-12. IC2224.2 +031000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2224.2 +031100 IF ERROR-COUNTER IS EQUAL TO ZERO IC2224.2 +031200 MOVE "NO " TO ERROR-TOTAL IC2224.2 +031300 ELSE IC2224.2 +031400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2224.2 +031500 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2224.2 +031600 PERFORM WRITE-LINE. IC2224.2 +031700 END-ROUTINE-13. IC2224.2 +031800 IF DELETE-COUNTER IS EQUAL TO ZERO IC2224.2 +031900 MOVE "NO " TO ERROR-TOTAL ELSE IC2224.2 +032000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2224.2 +032100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2224.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +032300 IF INSPECT-COUNTER EQUAL TO ZERO IC2224.2 +032400 MOVE "NO " TO ERROR-TOTAL IC2224.2 +032500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2224.2 +032600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2224.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +032800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2224.2 +032900 WRITE-LINE. IC2224.2 +033000 ADD 1 TO RECORD-COUNT. IC2224.2 +033100 IF RECORD-COUNT GREATER 50 IC2224.2 +033200 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2224.2 +033300 MOVE SPACE TO DUMMY-RECORD IC2224.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2224.2 +033500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2224.2 +033600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2224.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2224.2 +033800 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2224.2 +033900 MOVE ZERO TO RECORD-COUNT. IC2224.2 +034000 PERFORM WRT-LN. IC2224.2 +034100 WRT-LN. IC2224.2 +034200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2224.2 +034300 MOVE SPACE TO DUMMY-RECORD. IC2224.2 +034400 BLANK-LINE-PRINT. IC2224.2 +034500 PERFORM WRT-LN. IC2224.2 +034600 FAIL-ROUTINE. IC2224.2 +034700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2224.2 +034800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2224.2 +034900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2224.2 +035000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2224.2 +035100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +035200 MOVE SPACES TO INF-ANSI-REFERENCE. IC2224.2 +035300 GO TO FAIL-ROUTINE-EX. IC2224.2 +035400 FAIL-ROUTINE-WRITE. IC2224.2 +035500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2224.2 +035600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2224.2 +035700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2224.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. IC2224.2 +035900 FAIL-ROUTINE-EX. EXIT. IC2224.2 +036000 BAIL-OUT. IC2224.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2224.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2224.2 +036300 BAIL-OUT-WRITE. IC2224.2 +036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2224.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2224.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2224.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. IC2224.2 +036800 BAIL-OUT-EX. EXIT. IC2224.2 +036900 CCVS1-EXIT. IC2224.2 +037000 EXIT. IC2224.2 +037100* IC2224.2 +037200 SECT-IC222A-001 SECTION. IC2224.2 +037300 CALL-INIT-1. IC2224.2 +037400**************************************************************** IC2224.2 +037500* * IC2224.2 +037600* CALL A PROGRAM WHICH EXISTS AND FOR WHICH PARAMETERS * IC2224.2 +037700* MATCH IN NUMBER AND TYPE. EXECUTION SHOULD BE SUCCESSFUL * IC2224.2 +037800* AND THE STATEMENTS IN THE "ON EXCEPTION" PATH IGNORED. * IC2224.2 +037900* THE STATEMENT FOLLOWING THE SCOPE TERMINATOR SHOULD BE * IC2224.2 +038000* EXECUTED. * IC2224.2 +038100* * IC2224.2 +038200**************************************************************** IC2224.2 +038300* IC2224.2 +038400 MOVE 1 TO REC-CT. IC2224.2 +038500 MOVE "CALL-TEST-1" TO PAR-NAME. IC2224.2 +038600 MOVE "AVAILABLE ON " TO FEATURE. IC2224.2 +038700 MOVE 0 TO CALL-FLAG. IC2224.2 +038800 MOVE "P" TO EXCEPTION-PATH-FLAG. IC2224.2 +038900 MOVE "X-27 5.2.4 (2)" TO ANSI-REFERENCE. IC2224.2 +039000 MOVE ZERO TO DN3, DN4. IC2224.2 +039100 GO TO CALL-TEST-1-1. IC2224.2 +039200 CALL-DELETE-1-1. IC2224.2 +039300 PERFORM DE-LETE. IC2224.2 +039400 PERFORM PRINT-DETAIL. IC2224.2 +039500 ADD 1 TO REC-CT. IC2224.2 +039600* IC2224.2 +039700* IF THIS TEST IS DELETED THEN ITS SUBORDINATE IS * IC2224.2 +039800* AUTOMATICALLY DELETED. * IC2224.2 +039900* IC2224.2 +040000 GO TO CALL-DELETE-1-2. IC2224.2 +040100 CALL-TEST-1-1. IC2224.2 +040200 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +040300 ON EXCEPTION IC2224.2 +040400 MOVE "F" TO EXCEPTION-PATH-FLAG IC2224.2 +040500 END-CALL IC2224.2 +040600 MOVE 1 TO CALL-FLAG. IC2224.2 +040700 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +040800 MOVE "UNEXPECTED EXECUTION OF EXCEPTION PATH" IC2224.2 +040900 TO RE-MARK IC2224.2 +041000 MOVE "P" TO CORRECT-A IC2224.2 +041100 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +041200 PERFORM FAIL IC2224.2 +041300 ELSE IC2224.2 +041400 PERFORM PASS. IC2224.2 +041500 CALL-WRITE-1-1. IC2224.2 +041600 PERFORM PRINT-DETAIL. IC2224.2 +041700 ADD 1 TO REC-CT. IC2224.2 +041800* IC2224.2 +041900 CALL-INIT-1-2. IC2224.2 +042000 GO TO CALL-TEST-1-2. IC2224.2 +042100 CALL-DELETE-1-2. IC2224.2 +042200 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +042300 PERFORM DE-LETE. IC2224.2 +042400 PERFORM PRINT-DETAIL. IC2224.2 +042500 ADD 1 TO REC-CT. IC2224.2 +042600 GO TO CALL-EXIT-1. IC2224.2 +042700* IC2224.2 +042800 CALL-TEST-1-2. IC2224.2 +042900**************************************************************** IC2224.2 +043000* * IC2224.2 +043100* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +043200* WAS EXECUTED. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +043300* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +043400* CORRECTLY. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +043500* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +043600* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +043700* * IC2224.2 +043800**************************************************************** IC2224.2 +043900* IC2224.2 +044000 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +044100 IF CALL-FLAG = 1 IC2224.2 +044200 PERFORM PASS IC2224.2 +044300 ELSE IC2224.2 +044400 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +044500 MOVE 1 TO CORRECT-N IC2224.2 +044600 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +044700 PERFORM FAIL. IC2224.2 +044800 PERFORM PRINT-DETAIL. IC2224.2 +044900* IC2224.2 +045000 CALL-EXIT-1. IC2224.2 +045100* IC2224.2 +045200* IC2224.2 +045300 CALL-INIT-2. IC2224.2 +045400**************************************************************** IC2224.2 +045500* * IC2224.2 +045600* CALL A PROGRAM WHICH DOES NOT EXIST. PAGE X-28, 5.2.4, * IC2224.2 +045700* RULE (3)A STATES THAT IF A PROGRAM CANNOT BE MADE * IC2224.2 +045800* AVAILABLE THEN THE STATEMENTS IN THE "ON EXCEPTION" * IC2224.2 +045900* PHRASE MUST BE EXECUTED. * IC2224.2 +046000* * IC2224.2 +046100**************************************************************** IC2224.2 +046200* IC2224.2 +046300 MOVE 1 TO REC-CT. IC2224.2 +046400 MOVE "CALL-TEST-2" TO PAR-NAME. IC2224.2 +046500 MOVE "NO PROGRAM ON " TO FEATURE. IC2224.2 +046600 MOVE 0 TO CALL-FLAG. IC2224.2 +046700 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +046800 MOVE "X-28 5.2.4 (3)A" TO ANSI-REFERENCE. IC2224.2 +046900 MOVE ZERO TO DN3, DN4. IC2224.2 +047000 GO TO CALL-TEST-2-1. IC2224.2 +047100 CALL-DELETE-2-1. IC2224.2 +047200 PERFORM DE-LETE. IC2224.2 +047300 PERFORM PRINT-DETAIL. IC2224.2 +047400 ADD 1 TO REC-CT. IC2224.2 +047500* IC2224.2 +047600* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +047700* AUTOMATICALLY DELETED. * IC2224.2 +047800* IC2224.2 +047900 GO TO CALL-DELETE-2-2. IC2224.2 +048000 CALL-TEST-2-1. IC2224.2 +048100* CALL "NON-EXISTING-PROGRAM" IC2224.2 +048200 CALL "XXXXXXXX" USING DN1, DN2, DN3, DN4 IC2224.2 +048300 ON EXCEPTION IC2224.2 +048400 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +048500 END-CALL IC2224.2 +048600 MOVE 1 TO CALL-FLAG. IC2224.2 +048700 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +048800 MOVE "EXCEPTION SHOULD HAVE OCCURRED" TO RE-MARK IC2224.2 +048900 MOVE "P" TO CORRECT-A IC2224.2 +049000 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +049100 PERFORM FAIL IC2224.2 +049200 ELSE IC2224.2 +049300 PERFORM PASS. IC2224.2 +049400 CALL-WRITE-2-1. IC2224.2 +049500 PERFORM PRINT-DETAIL. IC2224.2 +049600 ADD 1 TO REC-CT. IC2224.2 +049700* IC2224.2 +049800 CALL-INIT-2-2. IC2224.2 +049900 GO TO CALL-TEST-2-2. IC2224.2 +050000 CALL-DELETE-2-2. IC2224.2 +050100 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +050200 PERFORM DE-LETE. IC2224.2 +050300 PERFORM PRINT-DETAIL. IC2224.2 +050400 ADD 1 TO REC-CT. IC2224.2 +050500 GO TO CALL-EXIT-2. IC2224.2 +050600* IC2224.2 +050700 CALL-TEST-2-2. IC2224.2 +050800**************************************************************** IC2224.2 +050900* * IC2224.2 +051000* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +051100* WAS EXECUTED. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +051200* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +051300* CORRECTLY. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +051400* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +051500* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +051600* * IC2224.2 +051700**************************************************************** IC2224.2 +051800* IC2224.2 +051900 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +052000 IF CALL-FLAG = 1 IC2224.2 +052100 PERFORM PASS IC2224.2 +052200 ELSE IC2224.2 +052300 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +052400 MOVE 1 TO CORRECT-N IC2224.2 +052500 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +052600 PERFORM FAIL. IC2224.2 +052700 PERFORM PRINT-DETAIL. IC2224.2 +052800* IC2224.2 +052900 CALL-EXIT-2. IC2224.2 +053000* IC2224.2 +053100* IC2224.2 +053200 CALL-INIT-3. IC2224.2 +053300**************************************************************** IC2224.2 +053400* * IC2224.2 +053500* CALL A PROGRAM WHICH EXISTS, USING A CALL STATEMENT WITH * IC2224.2 +053600* BOTH AN "ON EXCEPTION" PHRASE AND A "NOT ON EXCEPTION" * IC2224.2 +053700* PHRASE. EXECUTION SHOULD BE SUCCESSFUL, THE * IC2224.2 +053800* "ON EXCEPTION" PHRASE IGNORED, AND THE STATEMENTS IN THE * IC2224.2 +053900* "NOT ON EXCEPTION" PHRASE EXECUTED. THE STATEMENT * IC2224.2 +054000* FOLLOWING THE SCOPE TERMINATOR SHOULD BE EXECUTED. * IC2224.2 +054100* * IC2224.2 +054200**************************************************************** IC2224.2 +054300* IC2224.2 +054400 MOVE 1 TO REC-CT. IC2224.2 +054500 MOVE "CALL-TEST-3" TO PAR-NAME. IC2224.2 +054600 MOVE "AVAILABLE ON NOT ON" TO FEATURE. IC2224.2 +054700 MOVE 0 TO CALL-FLAG. IC2224.2 +054800 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +054900 MOVE "X-28 5.2.4 (2)" TO ANSI-REFERENCE. IC2224.2 +055000 MOVE ZERO TO DN3, DN4. IC2224.2 +055100 GO TO CALL-TEST-3-1. IC2224.2 +055200 CALL-DELETE-3-1. IC2224.2 +055300 PERFORM DE-LETE. IC2224.2 +055400 PERFORM PRINT-DETAIL. IC2224.2 +055500 ADD 1 TO REC-CT. IC2224.2 +055600* IC2224.2 +055700* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +055800* AUTOMATICALLY DELETED. * IC2224.2 +055900* IC2224.2 +056000 GO TO CALL-DELETE-3-2. IC2224.2 +056100 CALL-TEST-3-1. IC2224.2 +056200 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +056300 ON EXCEPTION IC2224.2 +056400 MOVE "F" TO EXCEPTION-PATH-FLAG IC2224.2 +056500 ADD 2 TO CALL-FLAG IC2224.2 +056600 NOT ON EXCEPTION IC2224.2 +056700 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +056800 ADD 2 TO CALL-FLAG IC2224.2 +056900 END-CALL IC2224.2 +057000 ADD 1 TO CALL-FLAG. IC2224.2 +057100 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +057200 MOVE "NON-EXECUTION OF NOT EXCEPTION PATH" IC2224.2 +057300 TO RE-MARK IC2224.2 +057400 MOVE "P" TO CORRECT-A IC2224.2 +057500 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +057600 PERFORM FAIL IC2224.2 +057700 ELSE IC2224.2 +057800 PERFORM PASS. IC2224.2 +057900 CALL-WRITE-3-1. IC2224.2 +058000 PERFORM PRINT-DETAIL. IC2224.2 +058100 ADD 1 TO REC-CT. IC2224.2 +058200* IC2224.2 +058300 CALL-INIT-3-2. IC2224.2 +058400 GO TO CALL-TEST-3-2. IC2224.2 +058500 CALL-DELETE-3-2. IC2224.2 +058600 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +058700 PERFORM DE-LETE. IC2224.2 +058800 PERFORM PRINT-DETAIL. IC2224.2 +058900 ADD 1 TO REC-CT. IC2224.2 +059000 GO TO CALL-EXIT-3. IC2224.2 +059100* IC2224.2 +059200 CALL-TEST-3-2. IC2224.2 +059300**************************************************************** IC2224.2 +059400* * IC2224.2 +059500* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +059600* WAS EXECUTED. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +059700* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +059800* CORRECTLY. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +059900* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +060000* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +060100* * IC2224.2 +060200**************************************************************** IC2224.2 +060300* IC2224.2 +060400 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +060500 IF CALL-FLAG = 3 IC2224.2 +060600 PERFORM PASS IC2224.2 +060700 ELSE IC2224.2 +060800 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +060900 MOVE 3 TO CORRECT-N IC2224.2 +061000 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +061100 PERFORM FAIL. IC2224.2 +061200 PERFORM PRINT-DETAIL. IC2224.2 +061300* IC2224.2 +061400 CALL-EXIT-3. IC2224.2 +061500* IC2224.2 +061600* IC2224.2 +061700 CALL-INIT-4. IC2224.2 +061800**************************************************************** IC2224.2 +061900* * IC2224.2 +062000* CALL A PROGRAM WHICH IS NOT AVAILABLE FOR EXECUTION, * IC2224.2 +062100* USING A CALL STATEMENT WITH BOTH AN "ON EXCEPTION" PHRASE * IC2224.2 +062200* AND A "NOT ON EXCEPTION" PHRASE. EXECUTION SHOULD BE * IC2224.2 +062300* UNSUCCESSFUL, THE STATEMENTS IN THE "ON EXCEPTION" PHRASE * IC2224.2 +062400* EXECUTED, AND THE STATEMENTS IN THE "NOT ON EXCEPTION" * IC2224.2 +062500* PHRASE IGNORED. THE STATEMENT FOLLOWING THE SCOPE * IC2224.2 +062600* TERMINATOR SHOULD BE EXECUTED IN EITHER CASE. * IC2224.2 +062700* * IC2224.2 +062800**************************************************************** IC2224.2 +062900* IC2224.2 +063000 MOVE 1 TO REC-CT. IC2224.2 +063100 MOVE "CALL-TEST-4" TO PAR-NAME. IC2224.2 +063200 MOVE "CALL ON EXCEPTION" TO FEATURE. IC2224.2 +063300 MOVE 0 TO CALL-FLAG. IC2224.2 +063400 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +063500 MOVE "X-28 5.2.4 (3)A" TO ANSI-REFERENCE. IC2224.2 +063600 MOVE ZERO TO DN3, DN4. IC2224.2 +063700 GO TO CALL-TEST-4-1. IC2224.2 +063800 CALL-DELETE-4-1. IC2224.2 +063900 PERFORM DE-LETE. IC2224.2 +064000 PERFORM PRINT-DETAIL. IC2224.2 +064100 ADD 1 TO REC-CT. IC2224.2 +064200* IC2224.2 +064300* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +064400* AUTOMATICALLY DELETED. * IC2224.2 +064500* IC2224.2 +064600 GO TO CALL-DELETE-4-2. IC2224.2 +064700 CALL-TEST-4-1. IC2224.2 +064800* CALL "NON-EXISTENT PROGRAM" IC2224.2 +064900 CALL "XXXXXXXX" USING DN1, DN2, DN3, DN4 IC2224.2 +065000 ON EXCEPTION IC2224.2 +065100 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +065200 ADD 2 TO CALL-FLAG IC2224.2 +065300 NOT ON EXCEPTION IC2224.2 +065400 MOVE "F" TO EXCEPTION-PATH-FLAG IC2224.2 +065500 ADD 2 TO CALL-FLAG IC2224.2 +065600 END-CALL IC2224.2 +065700 ADD 1 TO CALL-FLAG. IC2224.2 +065800 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +065900 MOVE "NON-EXECUTION OF EXCEPTION PATH" IC2224.2 +066000 TO RE-MARK IC2224.2 +066100 MOVE "P" TO CORRECT-A IC2224.2 +066200 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +066300 PERFORM FAIL IC2224.2 +066400 ELSE IC2224.2 +066500 PERFORM PASS. IC2224.2 +066600 CALL-WRITE-4-1. IC2224.2 +066700 PERFORM PRINT-DETAIL. IC2224.2 +066800 ADD 1 TO REC-CT. IC2224.2 +066900* IC2224.2 +067000 CALL-INIT-4-2. IC2224.2 +067100 GO TO CALL-TEST-4-2. IC2224.2 +067200 CALL-DELETE-4-2. IC2224.2 +067300 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +067400 PERFORM DE-LETE. IC2224.2 +067500 PERFORM PRINT-DETAIL. IC2224.2 +067600 ADD 1 TO REC-CT. IC2224.2 +067700 GO TO CALL-EXIT-4. IC2224.2 +067800* IC2224.2 +067900 CALL-TEST-4-2. IC2224.2 +068000**************************************************************** IC2224.2 +068100* * IC2224.2 +068200* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +068300* WAS EXECUTED. A PASS HERE ALSO INDICATES THAT ONE AND * IC2224.2 +068400* ONLY ONE OF THE "ON EXCEPTION" AND "NOT ON EXCEPTION" * IC2224.2 +068500* PHRASES OF THE PRECEDING CALL STATEMENT WAS EXECUTED. * IC2224.2 +068600* * IC2224.2 +068700**************************************************************** IC2224.2 +068800* IC2224.2 +068900 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +069000 IF CALL-FLAG = 3 IC2224.2 +069100 PERFORM PASS IC2224.2 +069200 ELSE IC2224.2 +069300 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +069400 MOVE 3 TO CORRECT-N IC2224.2 +069500 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +069600 PERFORM FAIL. IC2224.2 +069700 PERFORM PRINT-DETAIL. IC2224.2 +069800* IC2224.2 +069900 CALL-EXIT-4. IC2224.2 +070000* IC2224.2 +070100* IC2224.2 +070200 CALL-INIT-5. IC2224.2 +070300**************************************************************** IC2224.2 +070400* * IC2224.2 +070500* CALL A PROGRAM WHICH IS AVAILABLE FOR EXECUTION, USING A * IC2224.2 +070600* CALL STATEMENT WITH A "NOT ON EXCEPTION" PHRASE BUT NO * IC2224.2 +070700* "ON EXCEPTION" PHRASE. EXECUTION SHOULD BE SUCCESSFUL, * IC2224.2 +070800* AND THE STATEMENTS IN THE "NOT ON EXCEPTION" PHRASE * IC2224.2 +070900* EXECUTED. THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +071000* SHOULD ALSO BE EXECUTED. * IC2224.2 +071100* * IC2224.2 +071200**************************************************************** IC2224.2 +071300* IC2224.2 +071400 MOVE 1 TO REC-CT. IC2224.2 +071500 MOVE "CALL-TEST-5" TO PAR-NAME. IC2224.2 +071600 MOVE "AVAILABLE -- NOT ON" TO FEATURE. IC2224.2 +071700 MOVE 0 TO CALL-FLAG. IC2224.2 +071800 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +071900 MOVE "X-28 5.2.4 (3)A" TO ANSI-REFERENCE. IC2224.2 +072000 MOVE ZERO TO DN3, DN4. IC2224.2 +072100 GO TO CALL-TEST-5-1. IC2224.2 +072200 CALL-DELETE-5-1. IC2224.2 +072300 PERFORM DE-LETE. IC2224.2 +072400 PERFORM PRINT-DETAIL. IC2224.2 +072500 ADD 1 TO REC-CT. IC2224.2 +072600* IC2224.2 +072700* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +072800* AUTOMATICALLY DELETED. * IC2224.2 +072900* IC2224.2 +073000 GO TO CALL-DELETE-5-2. IC2224.2 +073100 CALL-TEST-5-1. IC2224.2 +073200 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +073300 NOT ON EXCEPTION IC2224.2 +073400 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +073500 ADD 2 TO CALL-FLAG IC2224.2 +073600 END-CALL IC2224.2 +073700 ADD 1 TO CALL-FLAG. IC2224.2 +073800 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +073900 MOVE "NON-EXECUTION OF NOT ON EXCEPTION PATH" IC2224.2 +074000 TO RE-MARK IC2224.2 +074100 MOVE "P" TO CORRECT-A IC2224.2 +074200 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +074300 PERFORM FAIL IC2224.2 +074400 ELSE IC2224.2 +074500 PERFORM PASS. IC2224.2 +074600 CALL-WRITE-5-1. IC2224.2 +074700 PERFORM PRINT-DETAIL. IC2224.2 +074800 ADD 1 TO REC-CT. IC2224.2 +074900* IC2224.2 +075000 CALL-INIT-5-2. IC2224.2 +075100 GO TO CALL-TEST-5-2. IC2224.2 +075200 CALL-DELETE-5-2. IC2224.2 +075300 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +075400 PERFORM DE-LETE. IC2224.2 +075500 PERFORM PRINT-DETAIL. IC2224.2 +075600 ADD 1 TO REC-CT. IC2224.2 +075700 GO TO CALL-EXIT-5. IC2224.2 +075800* IC2224.2 +075900 CALL-TEST-5-2. IC2224.2 +076000**************************************************************** IC2224.2 +076100* * IC2224.2 +076200* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +076300* WAS EXECUTED. A PASS HERE ALSO INDICATES THAT THE * IC2224.2 +076400* "NOT ON EXCEPTION" PHRASE OF THE PRECEDING CALL STATEMENT * IC2224.2 +076500* WAS EXECUTED. * IC2224.2 +076600* * IC2224.2 +076700**************************************************************** IC2224.2 +076800* IC2224.2 +076900 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +077000 IF CALL-FLAG = 3 IC2224.2 +077100 PERFORM PASS IC2224.2 +077200 ELSE IC2224.2 +077300 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +077400 MOVE 3 TO CORRECT-N IC2224.2 +077500 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +077600 PERFORM FAIL. IC2224.2 +077700 PERFORM PRINT-DETAIL. IC2224.2 +077800* IC2224.2 +077900 CALL-EXIT-5. IC2224.2 +078000* IC2224.2 +078100* IC2224.2 +078200 CALL-INIT-6. IC2224.2 +078300**************************************************************** IC2224.2 +078400* * IC2224.2 +078500* CALL A PROGRAM WHICH IS AVAILABLE FOR EXECUTION, USING A * IC2224.2 +078600* CALL STATEMENT WITH NEITHER AN "ON EXCEPTION" PHRASE NOR * IC2224.2 +078700* A "NOT ON EXCEPTION" PHRASE. EXECUTION SHOULD BE * IC2224.2 +078800* SUCCESSFUL. THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +078900* SHOULD BE EXECUTED. * IC2224.2 +079000* * IC2224.2 +079100**************************************************************** IC2224.2 +079200* IC2224.2 +079300 MOVE 1 TO REC-CT. IC2224.2 +079400 MOVE "CALL-TEST-6" TO PAR-NAME. IC2224.2 +079500 MOVE "AVAILABLE -- ---" TO FEATURE. IC2224.2 +079600 MOVE 0 TO CALL-FLAG. IC2224.2 +079700 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +079800 MOVE "X-28 5.2.4 (2)" TO ANSI-REFERENCE. IC2224.2 +079900 MOVE ZERO TO DN3, DN4. IC2224.2 +080000 GO TO CALL-TEST-6-1. IC2224.2 +080100 CALL-DELETE-6-1. IC2224.2 +080200 PERFORM DE-LETE. IC2224.2 +080300 PERFORM PRINT-DETAIL. IC2224.2 +080400 ADD 1 TO REC-CT. IC2224.2 +080500* IC2224.2 +080600* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +080700* AUTOMATICALLY DELETED. * IC2224.2 +080800* IC2224.2 +080900 GO TO CALL-DELETE-6-2. IC2224.2 +081000 CALL-TEST-6-1. IC2224.2 +081100 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +081200 END-CALL IC2224.2 +081300 ADD 1 TO CALL-FLAG. IC2224.2 +081400 IF EXCEPTION-PATH-FLAG NOT = "X" IC2224.2 +081500 MOVE "EXCEPTION-PATH-FLAG ALTERED" TO RE-MARK IC2224.2 +081600 MOVE "X" TO CORRECT-A IC2224.2 +081700 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +081800 PERFORM FAIL IC2224.2 +081900 ELSE IC2224.2 +082000 PERFORM PASS. IC2224.2 +082100 CALL-WRITE-6-1. IC2224.2 +082200 PERFORM PRINT-DETAIL. IC2224.2 +082300 ADD 1 TO REC-CT. IC2224.2 +082400* IC2224.2 +082500 CALL-INIT-6-2. IC2224.2 +082600 GO TO CALL-TEST-6-2. IC2224.2 +082700 CALL-DELETE-6-2. IC2224.2 +082800 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +082900 PERFORM DE-LETE. IC2224.2 +083000 PERFORM PRINT-DETAIL. IC2224.2 +083100 ADD 1 TO REC-CT. IC2224.2 +083200 GO TO CALL-EXIT-6. IC2224.2 +083300* IC2224.2 +083400 CALL-TEST-6-2. IC2224.2 +083500**************************************************************** IC2224.2 +083600* * IC2224.2 +083700* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +083800* WAS EXECUTED. * IC2224.2 +083900* * IC2224.2 +084000**************************************************************** IC2224.2 +084100* IC2224.2 +084200 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +084300 IF CALL-FLAG = 1 IC2224.2 +084400 PERFORM PASS IC2224.2 +084500 ELSE IC2224.2 +084600 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +084700 MOVE 1 TO CORRECT-N IC2224.2 +084800 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +084900 PERFORM FAIL. IC2224.2 +085000 PERFORM PRINT-DETAIL. IC2224.2 +085100* IC2224.2 +085200 CALL-EXIT-6. IC2224.2 +085300* IC2224.2 +085400* IC2224.2 +085500 CALL-INIT-7. IC2224.2 +085600**************************************************************** IC2224.2 +085700* * IC2224.2 +085800* CALL A PROGRAM WHICH EXISTS AND FOR WHICH PARAMETERS * IC2224.2 +085900* MATCH IN NUMBER AND TYPE. THIS TEST IS A DUPLICATION OF * IC2224.2 +086000* CALL-TEST-1, WITH "ON OVERFLOW" SUBSTITUTED FOR * IC2224.2 +086100* "ON EXCEPTION" IN THE CALL STATEMENT. * IC2224.2 +086200* * IC2224.2 +086300**************************************************************** IC2224.2 +086400* IC2224.2 +086500 MOVE 1 TO REC-CT. IC2224.2 +086600 MOVE "CALL-TEST-7" TO PAR-NAME. IC2224.2 +086700 MOVE "AVAILABLE OV ---" TO FEATURE. IC2224.2 +086800 MOVE 0 TO CALL-FLAG. IC2224.2 +086900 MOVE "P" TO EXCEPTION-PATH-FLAG. IC2224.2 +087000 MOVE "X-27 5.2.4 (2)" TO ANSI-REFERENCE. IC2224.2 +087100 MOVE ZERO TO DN3, DN4. IC2224.2 +087200 GO TO CALL-TEST-7-1. IC2224.2 +087300 CALL-DELETE-7-1. IC2224.2 +087400 PERFORM DE-LETE. IC2224.2 +087500 PERFORM PRINT-DETAIL. IC2224.2 +087600 ADD 1 TO REC-CT. IC2224.2 +087700* IC2224.2 +087800* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +087900* AUTOMATICALLY DELETED. * IC2224.2 +088000* IC2224.2 +088100 GO TO CALL-DELETE-7-2. IC2224.2 +088200 CALL-TEST-7-1. IC2224.2 +088300 CALL "IC222A-1" USING DN1, DN2, DN3, DN4 IC2224.2 +088400 ON OVERFLOW IC2224.2 +088500 MOVE "F" TO EXCEPTION-PATH-FLAG IC2224.2 +088600 END-CALL IC2224.2 +088700 MOVE 1 TO CALL-FLAG. IC2224.2 +088800 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +088900 MOVE "UNEXPECTED EXECUTION OF EXCEPTION PATH" IC2224.2 +089000 TO RE-MARK IC2224.2 +089100 MOVE "P" TO CORRECT-A IC2224.2 +089200 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +089300 PERFORM FAIL IC2224.2 +089400 ELSE IC2224.2 +089500 PERFORM PASS. IC2224.2 +089600 CALL-WRITE-7-1. IC2224.2 +089700 PERFORM PRINT-DETAIL. IC2224.2 +089800 ADD 1 TO REC-CT. IC2224.2 +089900* IC2224.2 +090000 CALL-INIT-7-2. IC2224.2 +090100 GO TO CALL-TEST-7-2. IC2224.2 +090200 CALL-DELETE-7-2. IC2224.2 +090300 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +090400 PERFORM DE-LETE. IC2224.2 +090500 PERFORM PRINT-DETAIL. IC2224.2 +090600 ADD 1 TO REC-CT. IC2224.2 +090700 GO TO CALL-EXIT-7. IC2224.2 +090800* IC2224.2 +090900 CALL-TEST-7-2. IC2224.2 +091000**************************************************************** IC2224.2 +091100* * IC2224.2 +091200* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +091300* WAS EXECUTED. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +091400* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +091500* CORRECTLY. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +091600* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +091700* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +091800* * IC2224.2 +091900**************************************************************** IC2224.2 +092000* IC2224.2 +092100 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +092200 IF CALL-FLAG = 1 IC2224.2 +092300 PERFORM PASS IC2224.2 +092400 ELSE IC2224.2 +092500 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +092600 MOVE 1 TO CORRECT-N IC2224.2 +092700 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +092800 PERFORM FAIL. IC2224.2 +092900 PERFORM PRINT-DETAIL. IC2224.2 +093000* IC2224.2 +093100 CALL-EXIT-7. IC2224.2 +093200* IC2224.2 +093300* IC2224.2 +093400 CALL-INIT-8. IC2224.2 +093500**************************************************************** IC2224.2 +093600* * IC2224.2 +093700* CALL A PROGRAM WHICH DOES NOT EXIST. PAGE X-28, 5.2.4 * IC2224.2 +093800* RULE (3)A STATES THAT IF A PROGRAM CANNOT BE MADE * IC2224.2 +093900* AVAILABLE THEN THE STATEMENTS IN THE "ON EXCEPTION" OR * IC2224.2 +094000* "ON OVERFLOW" PHRASE MUST BE EXECUTED. THIS TEST IS A * IC2224.2 +094100* DUPLICATION OF CALL-TEST-2 WITH "ON OVERFLOW" SUBSTITUTED * IC2224.2 +094200* FOR "ON EXCEPTION" IN THE CALL STATEMENT. * IC2224.2 +094300* * IC2224.2 +094400**************************************************************** IC2224.2 +094500* IC2224.2 +094600 MOVE 1 TO REC-CT. IC2224.2 +094700 MOVE "CALL-TEST-8" TO PAR-NAME. IC2224.2 +094800 MOVE "NO PROGRAM OV ---" TO FEATURE. IC2224.2 +094900 MOVE 0 TO CALL-FLAG. IC2224.2 +095000 MOVE "X" TO EXCEPTION-PATH-FLAG. IC2224.2 +095100 MOVE "X-28 5.2.4 (3)A" TO ANSI-REFERENCE. IC2224.2 +095200 MOVE ZERO TO DN3, DN4. IC2224.2 +095300 GO TO CALL-TEST-8-1. IC2224.2 +095400 CALL-DELETE-8-1. IC2224.2 +095500 PERFORM DE-LETE. IC2224.2 +095600 PERFORM PRINT-DETAIL. IC2224.2 +095700 ADD 1 TO REC-CT. IC2224.2 +095800* IC2224.2 +095900* IF THIS TEST IS DELETED THEN ITS SUBORDINATE TEST IS * IC2224.2 +096000* AUTOMATICALLY DELETED. * IC2224.2 +096100* IC2224.2 +096200 GO TO CALL-DELETE-8-2. IC2224.2 +096300 CALL-TEST-8-1. IC2224.2 +096400* CALL "NON-EXISTING-PROGRAM" IC2224.2 +096500 CALL "XXXXXXXX" USING DN1, DN2, DN3, DN4 IC2224.2 +096600 ON OVERFLOW IC2224.2 +096700 MOVE "P" TO EXCEPTION-PATH-FLAG IC2224.2 +096800 END-CALL IC2224.2 +096900 MOVE 1 TO CALL-FLAG. IC2224.2 +097000 IF EXCEPTION-PATH-FLAG NOT = "P" IC2224.2 +097100 MOVE "EXCEPTION SHOULD HAVE OCCURRED" TO RE-MARK IC2224.2 +097200 MOVE "P" TO CORRECT-A IC2224.2 +097300 MOVE EXCEPTION-PATH-FLAG TO COMPUTED-A IC2224.2 +097400 PERFORM FAIL IC2224.2 +097500 ELSE IC2224.2 +097600 PERFORM PASS. IC2224.2 +097700 CALL-WRITE-8-1. IC2224.2 +097800 PERFORM PRINT-DETAIL. IC2224.2 +097900 ADD 1 TO REC-CT. IC2224.2 +098000* IC2224.2 +098100 CALL-INIT-8-2. IC2224.2 +098200 GO TO CALL-TEST-8-2. IC2224.2 +098300 CALL-DELETE-8-2. IC2224.2 +098400 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +098500 PERFORM DE-LETE. IC2224.2 +098600 PERFORM PRINT-DETAIL. IC2224.2 +098700 ADD 1 TO REC-CT. IC2224.2 +098800 GO TO CALL-EXIT-8. IC2224.2 +098900* IC2224.2 +099000 CALL-TEST-8-2. IC2224.2 +099100**************************************************************** IC2224.2 +099200* * IC2224.2 +099300* CHECKS THAT THE STATEMENT FOLLOWING THE SCOPE TERMINATOR * IC2224.2 +099400* WAS EXECUTED. IF THE PREVIOUS TEST FAILED, A PASS HERE * IC2224.2 +099500* INDICATES THAT THE SCOPE TERMINATOR HAS BEEN INTERPRETED * IC2224.2 +099600* CORRECTLY. IF THE PREVIOUS TEST PASSED, A PASS HERE * IC2224.2 +099700* INDICATES THAT THE SCOPE TERMINATOR WAS NOT INTERPRETED * IC2224.2 +099800* AS "NOT ON EXCEPTION" OR "GO TO NEXT-SENTENCE". * IC2224.2 +099900* * IC2224.2 +100000**************************************************************** IC2224.2 +100100* IC2224.2 +100200 MOVE "END-CALL OBSERVANCE" TO FEATURE. IC2224.2 +100300 IF CALL-FLAG = 1 IC2224.2 +100400 PERFORM PASS IC2224.2 +100500 ELSE IC2224.2 +100600 MOVE "INCORRECT CONTROL FLOW" TO RE-MARK IC2224.2 +100700 MOVE 1 TO CORRECT-N IC2224.2 +100800 MOVE CALL-FLAG TO COMPUTED-N IC2224.2 +100900 PERFORM FAIL. IC2224.2 +101000 PERFORM PRINT-DETAIL. IC2224.2 +101100* IC2224.2 +101200 CALL-EXIT-8. IC2224.2 +101300* IC2224.2 +101400* IC2224.2 +101500 CCVS-EXIT SECTION. IC2224.2 +101600 CCVS-999999. IC2224.2 +101700 GO TO CLOSE-FILES. IC2224.2 +101800 END PROGRAM IC222A. IC2224.2 +101900 IDENTIFICATION DIVISION. IC2224.2 +102000 PROGRAM-ID. IC2224.2 +102100 IC222A-1. IC2224.2 +102200**************************************************************** IC2224.2 +102300* * IC2224.2 +102400* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2224.2 +102500* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2224.2 +102600* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2224.2 +102700* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2224.2 +102800* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2224.2 +102900* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2224.2 +103000* * IC2224.2 +103100* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2224.2 +103200* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2224.2 +103300* DOCUMENT REFERENCE: ISO-1989-1978). * IC2224.2 +103400* * IC2224.2 +103500* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2224.2 +103600* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2224.2 +103700* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2224.2 +103800* * IC2224.2 +103900* THE FEDERAL SOFTWARE TESTING CENTER * IC2224.2 +104000* OFFICE OF SOFTWARE DEVELOPMENT * IC2224.2 +104100* & INFORMATION TECHNOLOGY * IC2224.2 +104200* TWO SKYLINE PLACE * IC2224.2 +104300* SUITE 1100 * IC2224.2 +104400* 5203 LEESBURG PIKE * IC2224.2 +104500* FALLS CHURCH * IC2224.2 +104600* VA 22041 * IC2224.2 +104700* U.S.A. * IC2224.2 +104800* * IC2224.2 +104900* THE PROJECT TEAM MEMBERS WERE: * IC2224.2 +105000* * IC2224.2 +105100* BIADI (BUREAU INTER ADMINISTRATION * IC2224.2 +105200* DE DOCUMENTATION INFORMATIQUE) * IC2224.2 +105300* 21 RUE BARA * IC2224.2 +105400* F-92132 ISSY * IC2224.2 +105500* FRANCE * IC2224.2 +105600* * IC2224.2 +105700* * IC2224.2 +105800* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2224.2 +105900* UND DATENVERARBEITUNG MBH) * IC2224.2 +106000* SCHLOSS BIRLINGHOVEN * IC2224.2 +106100* POSTFACH 12 40 * IC2224.2 +106200* D-5205 ST. AUGUSTIN 1 * IC2224.2 +106300* GERMANY FR * IC2224.2 +106400* * IC2224.2 +106500* * IC2224.2 +106600* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2224.2 +106700* OXFORD ROAD * IC2224.2 +106800* MANCHESTER * IC2224.2 +106900* M1 7ED * IC2224.2 +107000* UNITED KINGDOM * IC2224.2 +107100* * IC2224.2 +107200* * IC2224.2 +107300* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2224.2 +107400* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2224.2 +107500* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2224.2 +107600* * IC2224.2 +107700* REVISED 1986 AUGUST * IC2224.2 +107800* * IC2224.2 +107900**************************************************************** IC2224.2 +108000* * IC2224.2 +108100* VALIDATION FOR:- * IC2224.2 +108200* * IC2224.2 +108300* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2224.2 +108400* * IC2224.2 +108500* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2224.2 +108600* * IC2224.2 +108700**************************************************************** IC2224.2 +108800* * IC2224.2 +108900* X-CARDS USED BY THIS PROGRAM ARE :- * IC2224.2 +109000* * IC2224.2 +109100* X-82 SOURCE-COMPUTER * IC2224.2 +109200* X-83 OBJECT-COMPUTER. * IC2224.2 +109300* * IC2224.2 +109400**************************************************************** IC2224.2 +109500* * IC2224.2 +109600* THE SOURCE FILE CONTAINS TWO PROGRAMS, IC222A AND * IC2224.2 +109700* IC222A-1, WHICH TEST LANGUAGE ELEMENTS FROM LEVEL 2 OF * IC2224.2 +109800* THE INTER-PROGRAM COMMUNICATION MODULE. THE LANGUAGE * IC2224.2 +109900* ELEMENTS TESTED ARE: * IC2224.2 +110000* "ON EXCEPTION" PHRASE * IC2224.2 +110100* "NOT ON EXCEPTION" PHRASE * IC2224.2 +110200* "END-CALL" PHRASE * IC2224.2 +110300* "ON OVERFLOW" PHRASE * IC2224.2 +110400* IC2224.2 +110500* THE TWO PROGRAMS SHOULD BE COMPILED IN THE SAME * IC2224.2 +110600* INVOCATION OF THE COMPILER TO TEST THE BATCH COMPILATION * IC2224.2 +110700* FEATURE AND RECOGNITION OF THE END PROGRAM HEADER. THE * IC2224.2 +110800* ARRANGEMENT OF THE PROGRAMS IN THE SOURCE FILE IS: IC2224.2 +110900* IC2224.2 +111000* IDENTIFICATION DIVISION. IC2224.2 +111100* PROGRAM-ID. IC222A. IC2224.2 +111200* . IC2224.2 +111300* . IC2224.2 +111400* . IC2224.2 +111500* END PROGRAM IC222A. IC2224.2 +111600* IDENTIFICATION DIVISION. IC2224.2 +111700* PROGRAM-ID. IC222A-1. IC2224.2 +111800* . IC2224.2 +111900* . IC2224.2 +112000* . IC2224.2 +112100* IC2224.2 +112200* A FULL DESCRIPTION OF THE TWO PROGRAMS IS INCLUDED AS * IC2224.2 +112300* COMMENTS IN PROGRAM IC222A. * IC2224.2 +112400* * IC2224.2 +112500**************************************************************** IC2224.2 +112600* IC2224.2 +112700 ENVIRONMENT DIVISION. IC2224.2 +112800 CONFIGURATION SECTION. IC2224.2 +112900 SOURCE-COMPUTER. IC2224.2 +113000 Linux. IC2224.2 +113100 OBJECT-COMPUTER. IC2224.2 +113200 Linux. IC2224.2 +113300 INPUT-OUTPUT SECTION. IC2224.2 +113400 FILE-CONTROL. IC2224.2 +113500 SELECT PRINT-FILE ASSIGN TO IC2224.2 +113600 "report.log". IC2224.2 +113700* IC2224.2 +113800 DATA DIVISION. IC2224.2 +113900 FILE SECTION. IC2224.2 +114000 FD PRINT-FILE. IC2224.2 +114100 01 PRINT-REC PICTURE X(120). IC2224.2 +114200 01 DUMMY-RECORD PICTURE X(120). IC2224.2 +114300 WORKING-STORAGE SECTION. IC2224.2 +114400 77 WS1 PICTURE S999. IC2224.2 +114500 77 WS2 PICTURE S999 IC2224.2 +114600 USAGE COMPUTATIONAL, VALUE ZERO. IC2224.2 +114700 LINKAGE SECTION. IC2224.2 +114800 77 DN1 PICTURE S99. IC2224.2 +114900 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2224.2 +115000 77 DN3 PICTURE S99. IC2224.2 +115100 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2224.2 +115200* IC2224.2 +115300 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2224.2 +115400 SECT-IC222A-1-001 SECTION. IC2224.2 +115500 CALL-TEST-001. IC2224.2 +115600 MOVE DN1 TO WS1. IC2224.2 +115700 ADD 1 TO WS1. IC2224.2 +115800 ADD 1 TO WS2. IC2224.2 +115900 MOVE WS1 TO DN3. IC2224.2 +116000 MOVE WS2 TO DN4. IC2224.2 +116100 CALL-EXIT-001. IC2224.2 +116200 EXIT PROGRAM. IC2224.2 diff --git a/tests/cobol85/IC/IC223A.CBL b/tests/cobol85/IC/IC223A.CBL new file mode 100755 index 00000000..087f7848 --- /dev/null +++ b/tests/cobol85/IC/IC223A.CBL @@ -0,0 +1,771 @@ +000100 IDENTIFICATION DIVISION. IC2234.2 +000200 PROGRAM-ID. IC2234.2 +000300 IC223A. IC2234.2 +000400**************************************************************** IC2234.2 +000500* * IC2234.2 +000600* VALIDATION FOR:- * IC2234.2 +000700* * IC2234.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2234.2 +000900* * IC2234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2234.2 +001100* * IC2234.2 +001200**************************************************************** IC2234.2 +001300* * IC2234.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2234.2 +001500* * IC2234.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2234.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2234.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2234.2 +001900* * IC2234.2 +002000**************************************************************** IC2234.2 +002100* * IC2234.2 +002200* PROGRAM IC223A AND IC223A-1 WILL TEST THE NEW LANGUAGE * IC2234.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2234.2 +002400* MODULE. * IC2234.2 +002500* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2234.2 +002600* "BY REFERENCE" PHRASE * IC2234.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2234.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2234.2 +002900* IDENTIFICATION DIVISION. * IC2234.2 +003000* PROGRAM-ID. IC223A. * IC2234.2 +003100* . * IC2234.2 +003200* . * IC2234.2 +003300* . * IC2234.2 +003400* END PROGRAM IC223A. * IC2234.2 +003500* PROGRAM-ID. IC223A-1. * IC2234.2 +003600* . * IC2234.2 +003700* . * IC2234.2 +003800* . * IC2234.2 +003900**************************************************************** IC2234.2 +004000 ENVIRONMENT DIVISION. IC2234.2 +004100 CONFIGURATION SECTION. IC2234.2 +004200 SOURCE-COMPUTER. IC2234.2 +004300 Linux. IC2234.2 +004400 OBJECT-COMPUTER. IC2234.2 +004500 Linux. IC2234.2 +004600 INPUT-OUTPUT SECTION. IC2234.2 +004700 FILE-CONTROL. IC2234.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2234.2 +004900 "report.log". IC2234.2 +005000 DATA DIVISION. IC2234.2 +005100 FILE SECTION. IC2234.2 +005200 FD PRINT-FILE. IC2234.2 +005300 01 PRINT-REC PICTURE X(120). IC2234.2 +005400 01 DUMMY-RECORD PICTURE X(120). IC2234.2 +005500 WORKING-STORAGE SECTION. IC2234.2 +005600 77 DN1 PICTURE S99 VALUE ZERO. IC2234.2 +005700 77 DN3 PICTURE S99. IC2234.2 +005800 77 ID1 PICTURE X(8) VALUE "IC223A-1". IC2234.2 +005900 77 ID2 PICTURE X(8). IC2234.2 +006000 77 DN2 PICTURE S99 IC2234.2 +006100 USAGE COMPUTATIONAL, VALUE ZERO. IC2234.2 +006200 77 DN4 PICTURE S99 IC2234.2 +006300 USAGE IS COMPUTATIONAL. IC2234.2 +006400 77 CALL-COUNT PIC S99. IC2234.2 +006500 77 FAIL-FLAG PIC 9. IC2234.2 +006600 01 TEST-RESULTS. IC2234.2 +006700 02 FILLER PIC X VALUE SPACE. IC2234.2 +006800 02 FEATURE PIC X(20) VALUE SPACE. IC2234.2 +006900 02 FILLER PIC X VALUE SPACE. IC2234.2 +007000 02 P-OR-F PIC X(5) VALUE SPACE. IC2234.2 +007100 02 FILLER PIC X VALUE SPACE. IC2234.2 +007200 02 PAR-NAME. IC2234.2 +007300 03 FILLER PIC X(19) VALUE SPACE. IC2234.2 +007400 03 PARDOT-X PIC X VALUE SPACE. IC2234.2 +007500 03 DOTVALUE PIC 99 VALUE ZERO. IC2234.2 +007600 02 FILLER PIC X(8) VALUE SPACE. IC2234.2 +007700 02 RE-MARK PIC X(61). IC2234.2 +007800 01 TEST-COMPUTED. IC2234.2 +007900 02 FILLER PIC X(30) VALUE SPACE. IC2234.2 +008000 02 FILLER PIC X(17) VALUE IC2234.2 +008100 " COMPUTED=". IC2234.2 +008200 02 COMPUTED-X. IC2234.2 +008300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2234.2 +008400 03 COMPUTED-N REDEFINES COMPUTED-A IC2234.2 +008500 PIC -9(9).9(9). IC2234.2 +008600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2234.2 +008700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2234.2 +008800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2234.2 +008900 03 CM-18V0 REDEFINES COMPUTED-A. IC2234.2 +009000 04 COMPUTED-18V0 PIC -9(18). IC2234.2 +009100 04 FILLER PIC X. IC2234.2 +009200 03 FILLER PIC X(50) VALUE SPACE. IC2234.2 +009300 01 TEST-CORRECT. IC2234.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IC2234.2 +009500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2234.2 +009600 02 CORRECT-X. IC2234.2 +009700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2234.2 +009800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2234.2 +009900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2234.2 +010000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2234.2 +010100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2234.2 +010200 03 CR-18V0 REDEFINES CORRECT-A. IC2234.2 +010300 04 CORRECT-18V0 PIC -9(18). IC2234.2 +010400 04 FILLER PIC X. IC2234.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IC2234.2 +010600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2234.2 +010700 01 CCVS-C-1. IC2234.2 +010800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2234.2 +010900- "SS PARAGRAPH-NAME IC2234.2 +011000- " REMARKS". IC2234.2 +011100 02 FILLER PIC X(20) VALUE SPACE. IC2234.2 +011200 01 CCVS-C-2. IC2234.2 +011300 02 FILLER PIC X VALUE SPACE. IC2234.2 +011400 02 FILLER PIC X(6) VALUE "TESTED". IC2234.2 +011500 02 FILLER PIC X(15) VALUE SPACE. IC2234.2 +011600 02 FILLER PIC X(4) VALUE "FAIL". IC2234.2 +011700 02 FILLER PIC X(94) VALUE SPACE. IC2234.2 +011800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2234.2 +011900 01 REC-CT PIC 99 VALUE ZERO. IC2234.2 +012000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2234.2 +012100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2234.2 +012200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2234.2 +012300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2234.2 +012400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2234.2 +012500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2234.2 +012600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2234.2 +012700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2234.2 +012800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2234.2 +012900 01 CCVS-H-1. IC2234.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC2234.2 +013100 02 FILLER PIC X(42) VALUE IC2234.2 +013200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2234.2 +013300 02 FILLER PIC X(39) VALUE SPACES. IC2234.2 +013400 01 CCVS-H-2A. IC2234.2 +013500 02 FILLER PIC X(40) VALUE SPACE. IC2234.2 +013600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2234.2 +013700 02 FILLER PIC XXXX VALUE IC2234.2 +013800 "4.2 ". IC2234.2 +013900 02 FILLER PIC X(28) VALUE IC2234.2 +014000 " COPY - NOT FOR DISTRIBUTION". IC2234.2 +014100 02 FILLER PIC X(41) VALUE SPACE. IC2234.2 +014200 IC2234.2 +014300 01 CCVS-H-2B. IC2234.2 +014400 02 FILLER PIC X(15) VALUE IC2234.2 +014500 "TEST RESULT OF ". IC2234.2 +014600 02 TEST-ID PIC X(9). IC2234.2 +014700 02 FILLER PIC X(4) VALUE IC2234.2 +014800 " IN ". IC2234.2 +014900 02 FILLER PIC X(12) VALUE IC2234.2 +015000 " HIGH ". IC2234.2 +015100 02 FILLER PIC X(22) VALUE IC2234.2 +015200 " LEVEL VALIDATION FOR ". IC2234.2 +015300 02 FILLER PIC X(58) VALUE IC2234.2 +015400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2234.2 +015500 01 CCVS-H-3. IC2234.2 +015600 02 FILLER PIC X(34) VALUE IC2234.2 +015700 " FOR OFFICIAL USE ONLY ". IC2234.2 +015800 02 FILLER PIC X(58) VALUE IC2234.2 +015900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2234.2 +016000 02 FILLER PIC X(28) VALUE IC2234.2 +016100 " COPYRIGHT 1985 ". IC2234.2 +016200 01 CCVS-E-1. IC2234.2 +016300 02 FILLER PIC X(52) VALUE SPACE. IC2234.2 +016400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2234.2 +016500 02 ID-AGAIN PIC X(9). IC2234.2 +016600 02 FILLER PIC X(45) VALUE SPACES. IC2234.2 +016700 01 CCVS-E-2. IC2234.2 +016800 02 FILLER PIC X(31) VALUE SPACE. IC2234.2 +016900 02 FILLER PIC X(21) VALUE SPACE. IC2234.2 +017000 02 CCVS-E-2-2. IC2234.2 +017100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2234.2 +017200 03 FILLER PIC X VALUE SPACE. IC2234.2 +017300 03 ENDER-DESC PIC X(44) VALUE IC2234.2 +017400 "ERRORS ENCOUNTERED". IC2234.2 +017500 01 CCVS-E-3. IC2234.2 +017600 02 FILLER PIC X(22) VALUE IC2234.2 +017700 " FOR OFFICIAL USE ONLY". IC2234.2 +017800 02 FILLER PIC X(12) VALUE SPACE. IC2234.2 +017900 02 FILLER PIC X(58) VALUE IC2234.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2234.2 +018100 02 FILLER PIC X(13) VALUE SPACE. IC2234.2 +018200 02 FILLER PIC X(15) VALUE IC2234.2 +018300 " COPYRIGHT 1985". IC2234.2 +018400 01 CCVS-E-4. IC2234.2 +018500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2234.2 +018600 02 FILLER PIC X(4) VALUE " OF ". IC2234.2 +018700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2234.2 +018800 02 FILLER PIC X(40) VALUE IC2234.2 +018900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2234.2 +019000 01 XXINFO. IC2234.2 +019100 02 FILLER PIC X(19) VALUE IC2234.2 +019200 "*** INFORMATION ***". IC2234.2 +019300 02 INFO-TEXT. IC2234.2 +019400 04 FILLER PIC X(8) VALUE SPACE. IC2234.2 +019500 04 XXCOMPUTED PIC X(20). IC2234.2 +019600 04 FILLER PIC X(5) VALUE SPACE. IC2234.2 +019700 04 XXCORRECT PIC X(20). IC2234.2 +019800 02 INF-ANSI-REFERENCE PIC X(48). IC2234.2 +019900 01 HYPHEN-LINE. IC2234.2 +020000 02 FILLER PIC IS X VALUE IS SPACE. IC2234.2 +020100 02 FILLER PIC IS X(65) VALUE IS "************************IC2234.2 +020200- "*****************************************". IC2234.2 +020300 02 FILLER PIC IS X(54) VALUE IS "************************IC2234.2 +020400- "******************************". IC2234.2 +020500 01 CCVS-PGM-ID PIC X(9) VALUE IC2234.2 +020600 "IC223A". IC2234.2 +020700 PROCEDURE DIVISION. IC2234.2 +020800 CCVS1 SECTION. IC2234.2 +020900 OPEN-FILES. IC2234.2 +021000 OPEN OUTPUT PRINT-FILE. IC2234.2 +021100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2234.2 +021200 MOVE SPACE TO TEST-RESULTS. IC2234.2 +021300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2234.2 +021400 GO TO CCVS1-EXIT. IC2234.2 +021500 CLOSE-FILES. IC2234.2 +021600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2234.2 +021700 TERMINATE-CCVS. IC2234.2 +021800*S EXIT PROGRAM. IC2234.2 +021900*SERMINATE-CALL. IC2234.2 +022000 STOP RUN. IC2234.2 +022100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2234.2 +022200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2234.2 +022300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2234.2 +022400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2234.2 +022500 MOVE "****TEST DELETED****" TO RE-MARK. IC2234.2 +022600 PRINT-DETAIL. IC2234.2 +022700 IF REC-CT NOT EQUAL TO ZERO IC2234.2 +022800 MOVE "." TO PARDOT-X IC2234.2 +022900 MOVE REC-CT TO DOTVALUE. IC2234.2 +023000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2234.2 +023100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2234.2 +023200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2234.2 +023300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2234.2 +023400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2234.2 +023500 MOVE SPACE TO CORRECT-X. IC2234.2 +023600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2234.2 +023700 MOVE SPACE TO RE-MARK. IC2234.2 +023800 HEAD-ROUTINE. IC2234.2 +023900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +024000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +024100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2234.2 +024200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2234.2 +024300 COLUMN-NAMES-ROUTINE. IC2234.2 +024400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +024500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +024700 END-ROUTINE. IC2234.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2234.2 +024900 END-RTN-EXIT. IC2234.2 +025000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +025100 END-ROUTINE-1. IC2234.2 +025200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2234.2 +025300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2234.2 +025400 ADD PASS-COUNTER TO ERROR-HOLD. IC2234.2 +025500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2234.2 +025600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2234.2 +025700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2234.2 +025800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2234.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2234.2 +026000 END-ROUTINE-12. IC2234.2 +026100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2234.2 +026200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2234.2 +026300 MOVE "NO " TO ERROR-TOTAL IC2234.2 +026400 ELSE IC2234.2 +026500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2234.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2234.2 +026700 PERFORM WRITE-LINE. IC2234.2 +026800 END-ROUTINE-13. IC2234.2 +026900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2234.2 +027000 MOVE "NO " TO ERROR-TOTAL ELSE IC2234.2 +027100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2234.2 +027200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2234.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +027400 IF INSPECT-COUNTER EQUAL TO ZERO IC2234.2 +027500 MOVE "NO " TO ERROR-TOTAL IC2234.2 +027600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2234.2 +027700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2234.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +027900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2234.2 +028000 WRITE-LINE. IC2234.2 +028100 ADD 1 TO RECORD-COUNT. IC2234.2 +028200 IF RECORD-COUNT GREATER 50 IC2234.2 +028300 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2234.2 +028400 MOVE SPACE TO DUMMY-RECORD IC2234.2 +028500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2234.2 +028600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2234.2 +028700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2234.2 +028800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2234.2 +028900 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2234.2 +029000 MOVE ZERO TO RECORD-COUNT. IC2234.2 +029100 PERFORM WRT-LN. IC2234.2 +029200 WRT-LN. IC2234.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2234.2 +029400 MOVE SPACE TO DUMMY-RECORD. IC2234.2 +029500 BLANK-LINE-PRINT. IC2234.2 +029600 PERFORM WRT-LN. IC2234.2 +029700 FAIL-ROUTINE. IC2234.2 +029800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2234.2 +029900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2234.2 +030000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2234.2 +030100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2234.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2234.2 +030400 GO TO FAIL-ROUTINE-EX. IC2234.2 +030500 FAIL-ROUTINE-WRITE. IC2234.2 +030600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2234.2 +030700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2234.2 +030800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2234.2 +030900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2234.2 +031000 FAIL-ROUTINE-EX. EXIT. IC2234.2 +031100 BAIL-OUT. IC2234.2 +031200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2234.2 +031300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2234.2 +031400 BAIL-OUT-WRITE. IC2234.2 +031500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2234.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2234.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2234.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2234.2 +031900 BAIL-OUT-EX. EXIT. IC2234.2 +032000 CCVS1-EXIT. IC2234.2 +032100 EXIT. IC2234.2 +032200 SECT-IC223A-001 SECTION. IC2234.2 +032300 CALL-TEST-01. IC2234.2 +032400 MOVE "CALL-TEST-01" TO PAR-NAME. IC2234.2 +032500 MOVE "LEV 2 CALL STATEMENT" TO FEATURE. IC2234.2 +032600 MOVE 0 TO CALL-COUNT. IC2234.2 +032700* THIS TEST HAS CALL STATEMENTS WITH AN IDENTIFIER IC2234.2 +032800* CONTAINING THE NAME OF THE SUBPROGRAM TO BE CALLED. IC2234.2 +032900* CALL-TEST-01 CONTAINS THE BASIC LEVEL 2 CALL STATEMENT. IC2234.2 +033000* IF IT CANNOT BE COMPILED AND EXECUTED CORRECTLY, THERE IS IC2234.2 +033100* NO USE IN RUNNING THE LEVEL 2 IPC ROUTINES. IC2234.2 +033200 CALL-TEST-01-01. IC2234.2 +033300 MOVE 1 TO REC-CT. IC2234.2 +033400 MOVE ZERO TO DN3, DN4. IC2234.2 +033500 CALL "IC223A-1" USING BY REFERENCE DN1, DN2, DN3, DN4 IC2234.2 +033600 END-CALL IC2234.2 +033700 PERFORM CHECK-TEST-01. IC2234.2 +033800 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +033900 PERFORM PASS IC2234.2 +034000 GO TO CALL-WRITE-01-01. IC2234.2 +034100 CALL-FAIL-01-01. IC2234.2 +034200 PERFORM FAIL. IC2234.2 +034300 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +034400 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +034500 CALL-WRITE-01-01. IC2234.2 +034600 PERFORM PRINT-DETAIL. IC2234.2 +034700 CALL-TEST-01-02. IC2234.2 +034800 ADD 1 TO REC-CT. IC2234.2 +034900 MOVE ZERO TO DN3, DN4. IC2234.2 +035000 CALL ID1 USING BY REFERENCE DN1, DN2, DN3, DN4 IC2234.2 +035100 END-CALL IC2234.2 +035200 PERFORM CHECK-TEST-01. IC2234.2 +035300 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +035400 PERFORM PASS IC2234.2 +035500 GO TO CALL-WRITE-01-02. IC2234.2 +035600 CALL-FAIL-01-02. IC2234.2 +035700 PERFORM FAIL. IC2234.2 +035800 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +035900 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +036000 CALL-WRITE-01-02. IC2234.2 +036100 PERFORM PRINT-DETAIL. IC2234.2 +036200 CALL-TEST-01-03. IC2234.2 +036300 ADD 1 TO REC-CT. IC2234.2 +036400 MOVE ID1 TO ID2. IC2234.2 +036500 MOVE ZERO TO DN3, DN4. IC2234.2 +036600 CALL ID2 USING REFERENCE DN1 DN2 DN3 DN4 IC2234.2 +036700 END-CALL. IC2234.2 +036800 PERFORM CHECK-TEST-01. IC2234.2 +036900 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +037000 PERFORM PASS IC2234.2 +037100 GO TO CALL-WRITE-01-03. IC2234.2 +037200 CALL-FAIL-01-03. IC2234.2 +037300 PERFORM FAIL. IC2234.2 +037400 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +037500 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +037600 CALL-WRITE-01-03. IC2234.2 +037700 PERFORM PRINT-DETAIL. IC2234.2 +037800 CALL-TEST-01-04. IC2234.2 +037900 ADD 1 TO REC-CT. IC2234.2 +038000 MOVE "IC223A-1" TO ID2. IC2234.2 +038100 MOVE ZERO TO DN3, DN4. IC2234.2 +038200 CALL ID2 USING REFERENCE DN1, DN2, DN3, DN4 IC2234.2 +038300 END-CALL. IC2234.2 +038400 PERFORM CHECK-TEST-01. IC2234.2 +038500 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +038600 PERFORM PASS IC2234.2 +038700 GO TO CALL-WRITE-01-04. IC2234.2 +038800 CALL-FAIL-01-04. IC2234.2 +038900 PERFORM FAIL. IC2234.2 +039000 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +039100 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +039200 CALL-WRITE-01-04. IC2234.2 +039300 PERFORM PRINT-DETAIL. IC2234.2 +039400 CALL-TEST-02. IC2234.2 +039500 MOVE "CALL-TEST-02" TO PAR-NAME. IC2234.2 +039600 MOVE "DATA-NAME USED TWICE" TO FEATURE. IC2234.2 +039700* THIS TEST USES A DATA-NAME MORE THAN ONCE IN IC2234.2 +039800* A USING PHRASE OF A CALL STATEMENT. IC2234.2 +039900 CALL-TEST-02-01. IC2234.2 +040000 MOVE 1 TO REC-CT. IC2234.2 +040100 MOVE 1 TO DN1. IC2234.2 +040200 MOVE 0 TO DN2, DN3, DN4. IC2234.2 +040300 CALL "IC223A-1" USING REFERENCE DN1, DN2, DN1, DN4 IC2234.2 +040400 END-CALL. IC2234.2 +040500 IF DN1 NOT EQUAL TO 2 IC2234.2 +040600 GO TO CALL-FAIL-02-01-1. IC2234.2 +040700 IF DN2 NOT EQUAL TO 0 IC2234.2 +040800 GO TO CALL-FAIL-02-01-2. IC2234.2 +040900 IF DN3 NOT EQUAL TO 0 IC2234.2 +041000 GO TO CALL-FAIL-02-01-3. IC2234.2 +041100 IF DN4 NOT EQUAL TO 5 IC2234.2 +041200 GO TO CALL-FAIL-02-01-4. IC2234.2 +041300 GO TO CALL-PASS-02-01. IC2234.2 +041400 CALL-DELETE-02-01. IC2234.2 +041500 PERFORM DE-LETE. IC2234.2 +041600 GO TO CALL-WRITE-02-01. IC2234.2 +041700 CALL-PASS-02-01. IC2234.2 +041800 PERFORM PASS. IC2234.2 +041900 GO TO CALL-WRITE-02-01. IC2234.2 +042000 CALL-FAIL-02-01-1. IC2234.2 +042100 MOVE DN1 TO COMPUTED-18V0. IC2234.2 +042200 MOVE 2 TO CORRECT-18V0. IC2234.2 +042300 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2234.2 +042400 GO TO CALL-FAIL-02-01. IC2234.2 +042500 CALL-FAIL-02-01-2. IC2234.2 +042600 MOVE DN2 TO COMPUTED-18V0. IC2234.2 +042700 MOVE 0 TO CORRECT-18V0. IC2234.2 +042800 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2234.2 +042900 GO TO CALL-FAIL-02-01. IC2234.2 +043000 CALL-FAIL-02-01-3. IC2234.2 +043100 MOVE DN3 TO COMPUTED-18V0. IC2234.2 +043200 MOVE ZERO TO CORRECT-18V0. IC2234.2 +043300 MOVE "DN3 VALUE CHANGED BY CALL" TO RE-MARK. IC2234.2 +043400 GO TO CALL-FAIL-02-01. IC2234.2 +043500 CALL-FAIL-02-01-4. IC2234.2 +043600 MOVE DN4 TO COMPUTED-18V0. IC2234.2 +043700 MOVE 5 TO CORRECT-18V0. IC2234.2 +043800 MOVE "ERROR IN DN4 VALUE RETURNED" TO RE-MARK. IC2234.2 +043900 CALL-FAIL-02-01. IC2234.2 +044000 PERFORM FAIL. IC2234.2 +044100 CALL-WRITE-02-01. IC2234.2 +044200 PERFORM PRINT-DETAIL. IC2234.2 +044300 CALL-TEST-02-02. IC2234.2 +044400 ADD 1 TO REC-CT. IC2234.2 +044500 MOVE 0 TO DN4, DN3, DN2, DN1. IC2234.2 +044600 CALL ID1 USING REFERENCE DN1 DN2 DN3 DN2 IC2234.2 +044700 END-CALL. IC2234.2 +044800 IF DN1 NOT EQUAL TO 0 IC2234.2 +044900 GO TO CALL-FAIL-02-02-1. IC2234.2 +045000 IF DN2 NOT EQUAL TO 6 IC2234.2 +045100 GO TO CALL-FAIL-02-02-2. IC2234.2 +045200 IF DN3 NOT EQUAL TO 1 IC2234.2 +045300 GO TO CALL-FAIL-02-02-3. IC2234.2 +045400 IF DN4 NOT EQUAL TO 0 IC2234.2 +045500 GO TO CALL-FAIL-02-02-4. IC2234.2 +045600 GO TO CALL-PASS-02-02. IC2234.2 +045700 CALL-DELETE-02-02. IC2234.2 +045800 PERFORM DE-LETE. IC2234.2 +045900 GO TO CALL-WRITE-02-02. IC2234.2 +046000 CALL-PASS-02-02. IC2234.2 +046100 PERFORM PASS. IC2234.2 +046200 GO TO CALL-WRITE-02-02. IC2234.2 +046300 CALL-FAIL-02-02-1. IC2234.2 +046400 MOVE DN1 TO COMPUTED-18V0. IC2234.2 +046500 MOVE ZERO TO CORRECT-18V0. IC2234.2 +046600 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2234.2 +046700 GO TO CALL-FAIL-02-02. IC2234.2 +046800 CALL-FAIL-02-02-2. IC2234.2 +046900 MOVE DN2 TO COMPUTED-18V0. IC2234.2 +047000 MOVE 6 TO CORRECT-18V0. IC2234.2 +047100 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2234.2 +047200 GO TO CALL-FAIL-02-02. IC2234.2 +047300 CALL-FAIL-02-02-3. IC2234.2 +047400 MOVE DN3 TO COMPUTED-18V0. IC2234.2 +047500 MOVE 1 TO CORRECT-18V0. IC2234.2 +047600 MOVE "ERROR IN DN3 VALUE RETURNED" TO RE-MARK. IC2234.2 +047700 GO TO CALL-FAIL-02-02. IC2234.2 +047800 CALL-FAIL-02-02-4. IC2234.2 +047900 MOVE DN4 TO COMPUTED-18V0. IC2234.2 +048000 MOVE 0 TO CORRECT-18V0. IC2234.2 +048100 MOVE "DN4 VALUE CHANGED BY CALL" TO RE-MARK. IC2234.2 +048200 CALL-FAIL-02-02. IC2234.2 +048300 PERFORM FAIL. IC2234.2 +048400 CALL-WRITE-02-02. IC2234.2 +048500 PERFORM PRINT-DETAIL. IC2234.2 +048600 CALL-TEST-02-03. IC2234.2 +048700 ADD 1 TO REC-CT. IC2234.2 +048800 MOVE 0 TO DN4, DN3. IC2234.2 +048900 MOVE 10 TO DN2. IC2234.2 +049000 MOVE 25 TO DN1. IC2234.2 +049100 CALL ID1 USING REFERENCE DN1 DN2 DN1 DN2 IC2234.2 +049200 END-CALL. IC2234.2 +049300 IF DN1 EQUAL TO 26 IC2234.2 +049400 GO TO CHECK-02-03-2. IC2234.2 +049500 GO TO CALL-FAIL-02-03-1. IC2234.2 +049600 CALL-DELETE-02-03. IC2234.2 +049700 PERFORM DE-LETE. IC2234.2 +049800 GO TO CALL-WRITE-02-03. IC2234.2 +049900 CALL-FAIL-02-03-1. IC2234.2 +050000 MOVE DN1 TO COMPUTED-18V0. IC2234.2 +050100 MOVE 26 TO CORRECT-18V0. IC2234.2 +050200 MOVE "ERROR IN DN1 VALUE RETURNED" TO RE-MARK. IC2234.2 +050300 GO TO CALL-FAIL-02-03. IC2234.2 +050400 CHECK-02-03-2. IC2234.2 +050500 IF DN2 EQUAL TO 7 IC2234.2 +050600 GO TO CHECK-02-03-3. IC2234.2 +050700 CALL-FAIL-02-03-2. IC2234.2 +050800 MOVE DN2 TO COMPUTED-18V0. IC2234.2 +050900 MOVE 7 TO CORRECT-18V0. IC2234.2 +051000 MOVE "ERROR IN DN2 VALUE RETURNED" TO RE-MARK. IC2234.2 +051100 GO TO CALL-FAIL-02-03. IC2234.2 +051200 CHECK-02-03-3. IC2234.2 +051300 IF DN3 EQUAL TO 0 IC2234.2 +051400 GO TO CHECK-02-03-4. IC2234.2 +051500 CALL-FAIL-02-03-3. IC2234.2 +051600 MOVE DN3 TO COMPUTED-18V0. IC2234.2 +051700 MOVE 0 TO CORRECT-18V0. IC2234.2 +051800 MOVE "DN3 VALUE CHANGED BY CALL" TO RE-MARK. IC2234.2 +051900 GO TO CALL-FAIL-02-03. IC2234.2 +052000 CHECK-02-03-4. IC2234.2 +052100 IF DN4 EQUAL TO 0 IC2234.2 +052200 GO TO CALL-PASS-02-03. IC2234.2 +052300 CALL-FAIL-02-03-4. IC2234.2 +052400 MOVE DN4 TO COMPUTED-18V0. IC2234.2 +052500 MOVE 0 TO CORRECT-18V0. IC2234.2 +052600 MOVE "DN4 VALUE CHANGED BY CALL" TO RE-MARK. IC2234.2 +052700 CALL-FAIL-02-03. IC2234.2 +052800 PERFORM FAIL. IC2234.2 +052900 GO TO CALL-WRITE-02-03. IC2234.2 +053000 CALL-PASS-02-03. IC2234.2 +053100 PERFORM PASS. IC2234.2 +053200 CALL-WRITE-02-03. IC2234.2 +053300 PERFORM PRINT-DETAIL. IC2234.2 +053400 CALL-TEST-03. IC2234.2 +053500* THIS TEST USES THE ON OVERFLOW PHRASE IN THE CALL IC2234.2 +053600* STATEMENT. THIS IS A SYNTACTICAL CHECK ONLY, THE ON IC2234.2 +053700* OVERFLOW CONDITION SHOULD NEVER OCCUR. IC2234.2 +053800 MOVE "CALL-TEST-03" TO PAR-NAME. IC2234.2 +053900 MOVE "ON OVERFLOW PHRASE" TO FEATURE. IC2234.2 +054000 CALL-TEST-03-01. IC2234.2 +054100 MOVE 7 TO CALL-COUNT. IC2234.2 +054200 MOVE 20 TO DN1. IC2234.2 +054300 MOVE 30 TO DN2. IC2234.2 +054400 MOVE ZERO TO DN3, DN4. IC2234.2 +054500 CALL "IC223A-1" USING REFERENCE DN1, DN2, DN3, DN4; IC2234.2 +054600 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2234.2 +054700 GO TO CALL-FAIL-03-01 IC2234.2 +054800 END-CALL. IC2234.2 +054900 PERFORM CHECK-TEST-03. IC2234.2 +055000 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +055100 PERFORM PASS IC2234.2 +055200 GO TO CALL-WRITE-03-01. IC2234.2 +055300 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +055400 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +055500 CALL-FAIL-03-01. IC2234.2 +055600 PERFORM FAIL. IC2234.2 +055700 CALL-WRITE-03-01. IC2234.2 +055800 PERFORM PRINT-DETAIL. IC2234.2 +055900 CALL-TEST-03-02. IC2234.2 +056000 MOVE ZERO TO DN3, DN4. IC2234.2 +056100 CALL "IC223A-1" USING REFERENCE DN1, DN2, DN3, DN4; IC2234.2 +056200 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2234.2 +056300 GO TO CALL-FAIL-03-02 IC2234.2 +056400 END-CALL. IC2234.2 +056500 PERFORM CHECK-TEST-03. IC2234.2 +056600 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +056700 PERFORM PASS IC2234.2 +056800 GO TO CALL-WRITE-03-02. IC2234.2 +056900 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +057000 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +057100 CALL-FAIL-03-02. IC2234.2 +057200 PERFORM FAIL. IC2234.2 +057300 CALL-WRITE-03-02. IC2234.2 +057400 PERFORM PRINT-DETAIL. IC2234.2 +057500 CALL-TEST-03-03. IC2234.2 +057600 MOVE ZERO TO DN3, DN4. IC2234.2 +057700 CALL ID1 USING REFERENCE DN1 DN2 DN3 DN4 IC2234.2 +057800 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2234.2 +057900 GO TO CALL-FAIL-03-03 IC2234.2 +058000 END-CALL. IC2234.2 +058100 PERFORM CHECK-TEST-03. IC2234.2 +058200 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +058300 PERFORM PASS IC2234.2 +058400 GO TO CALL-WRITE-03-03. IC2234.2 +058500 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +058600 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +058700 CALL-FAIL-03-03. IC2234.2 +058800 PERFORM FAIL. IC2234.2 +058900 CALL-WRITE-03-03. IC2234.2 +059000 PERFORM PRINT-DETAIL. IC2234.2 +059100 CALL-TEST-03-04. IC2234.2 +059200 MOVE ZERO TO DN3, DN4. IC2234.2 +059300 CALL ID1 USING REFERENCE DN1 DN2 DN3 DN4; IC2234.2 +059400 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK, IC2234.2 +059500 GO TO CALL-FAIL-03-04 IC2234.2 +059600 END-CALL. IC2234.2 +059700 PERFORM CHECK-TEST-03. IC2234.2 +059800 IF FAIL-FLAG EQUAL TO ZERO IC2234.2 +059900 PERFORM PASS IC2234.2 +060000 GO TO CALL-WRITE-03-04. IC2234.2 +060100 MOVE FAIL-FLAG TO COMPUTED-18V0. IC2234.2 +060200 MOVE "NO. OF WRONG VALUES RETURNED" TO RE-MARK. IC2234.2 +060300 CALL-FAIL-03-04. IC2234.2 +060400 PERFORM FAIL. IC2234.2 +060500 CALL-WRITE-03-04. IC2234.2 +060600 PERFORM PRINT-DETAIL. IC2234.2 +060700 GO TO EXIT-IC223A. IC2234.2 +060800 CALL-DELETE-03. IC2234.2 +060900* IF THE ON OVERFLOW PHRASE IS NOT RECOGNIZED, DELETE ALL IC2234.2 +061000* OF THE ABOVE CALL-TEST-03 PARAGRAPHS, STARTING WITH IC2234.2 +061100* CALL-TEST-03-01. IC2234.2 +061200 PERFORM DE-LETE. IC2234.2 +061300 PERFORM PRINT-DETAIL. IC2234.2 +061400 EXIT-IC223A. IC2234.2 +061500 GO TO CCVS-EXIT. IC2234.2 +061600 SECT-IC223A-002 SECTION. IC2234.2 +061700 CHECK-TEST-01. IC2234.2 +061800 MOVE ZERO TO FAIL-FLAG. IC2234.2 +061900 ADD 1 TO CALL-COUNT. IC2234.2 +062000 IF DN1 EQUAL TO ZERO IC2234.2 +062100 NEXT SENTENCE IC2234.2 +062200 ELSE ADD 1 TO FAIL-FLAG. IC2234.2 +062300 IF DN2 NOT EQUAL TO ZERO IC2234.2 +062400 ADD 1 TO FAIL-FLAG. IC2234.2 +062500 IF DN3 NOT EQUAL TO 1 IC2234.2 +062600 ADD 1 TO FAIL-FLAG. IC2234.2 +062700 IF DN4 NOT EQUAL TO CALL-COUNT IC2234.2 +062800 ADD 1 TO FAIL-FLAG. IC2234.2 +062900 CHECK-TEST-03. IC2234.2 +063000 MOVE ZERO TO FAIL-FLAG. IC2234.2 +063100 ADD 1 TO CALL-COUNT. IC2234.2 +063200 IF DN4 NOT EQUAL TO CALL-COUNT IC2234.2 +063300 ADD 1 TO FAIL-FLAG. IC2234.2 +063400 IF DN3 NOT EQUAL TO 21 IC2234.2 +063500 ADD 1 TO FAIL-FLAG. IC2234.2 +063600 IF DN2 NOT EQUAL TO 30 IC2234.2 +063700 ADD 1 TO FAIL-FLAG. IC2234.2 +063800 IF DN1 NOT EQUAL TO 20 IC2234.2 +063900 ADD 1 TO FAIL-FLAG. IC2234.2 +064000 CCVS-EXIT SECTION. IC2234.2 +064100 CCVS-999999. IC2234.2 +064200 GO TO CLOSE-FILES. IC2234.2 +064300 END PROGRAM IC223A. IC2234.2 +064400 IDENTIFICATION DIVISION. IC2234.2 +064500 PROGRAM-ID. IC2234.2 +064600 IC223A-1. IC2234.2 +064700**************************************************************** IC2234.2 +064800* * IC2234.2 +064900* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2234.2 +065000* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2234.2 +065100* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2234.2 +065200* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2234.2 +065300* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2234.2 +065400* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2234.2 +065500* * IC2234.2 +065600* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2234.2 +065700* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2234.2 +065800* DOCUMENT REFERENCE: ISO-1989-1978). * IC2234.2 +065900* * IC2234.2 +066000* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2234.2 +066100* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2234.2 +066200* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2234.2 +066300* * IC2234.2 +066400* THE FEDERAL SOFTWARE TESTING CENTER * IC2234.2 +066500* OFFICE OF SOFTWARE DEVELOPMENT * IC2234.2 +066600* & INFORMATION TECHNOLOGY * IC2234.2 +066700* TWO SKYLINE PLACE * IC2234.2 +066800* SUITE 1100 * IC2234.2 +066900* 5203 LEESBURG PIKE * IC2234.2 +067000* FALLS CHURCH * IC2234.2 +067100* VA 22041 * IC2234.2 +067200* U.S.A. * IC2234.2 +067300* * IC2234.2 +067400* THE PROJECT TEAM MEMBERS WERE: * IC2234.2 +067500* * IC2234.2 +067600* BIADI (BUREAU INTER ADMINISTRATION * IC2234.2 +067700* DE DOCUMENTATION INFORMATIQUE) * IC2234.2 +067800* 21 RUE BARA * IC2234.2 +067900* F-92132 ISSY * IC2234.2 +068000* FRANCE * IC2234.2 +068100* * IC2234.2 +068200* * IC2234.2 +068300* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2234.2 +068400* UND DATENVERARBEITUNG MBH) * IC2234.2 +068500* SCHLOSS BIRLINGHOVEN * IC2234.2 +068600* POSTFACH 12 40 * IC2234.2 +068700* D-5205 ST. AUGUSTIN 1 * IC2234.2 +068800* GERMANY FR * IC2234.2 +068900* * IC2234.2 +069000* * IC2234.2 +069100* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2234.2 +069200* OXFORD ROAD * IC2234.2 +069300* MANCHESTER * IC2234.2 +069400* M1 7ED * IC2234.2 +069500* UNITED KINGDOM * IC2234.2 +069600* * IC2234.2 +069700* * IC2234.2 +069800* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2234.2 +069900* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2234.2 +070000* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2234.2 +070100* * IC2234.2 +070200**************************************************************** IC2234.2 +070300* * IC2234.2 +070400* VALIDATION FOR:- * IC2234.2 +070500* * IC2234.2 +070600* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2234.2 +070700* * IC2234.2 +070800* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2234.2 +070900* * IC2234.2 +071000**************************************************************** IC2234.2 +071100* * IC2234.2 +071200* X-CARDS USED BY THIS PROGRAM ARE :- * IC2234.2 +071300* * IC2234.2 +071400* X-55 - SYSTEM PRINTER NAME. * IC2234.2 +071500* X-82 - SOURCE COMPUTER NAME. * IC2234.2 +071600* X-83 - OBJECT COMPUTER NAME. * IC2234.2 +071700* * IC2234.2 +071800**************************************************************** IC2234.2 +071900* * IC2234.2 +072000* PROGRAM IC223A AND IC223A-1 WILL TEST THE NEW LANGUAGE * IC2234.2 +072100* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2234.2 +072200* MODULE. * IC2234.2 +072300* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2234.2 +072400* "BY REFERENCE" PHRASE * IC2234.2 +072500* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2234.2 +072600* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2234.2 +072700* IDENTIFICATION DIVISION. * IC2234.2 +072800* PROGRAM-ID. IC223A. * IC2234.2 +072900* . * IC2234.2 +073000* . * IC2234.2 +073100* . * IC2234.2 +073200* END PROGRAM IC223A. * IC2234.2 +073300* PROGRAM-ID. IC223A-1. * IC2234.2 +073400* . * IC2234.2 +073500* . * IC2234.2 +073600* . * IC2234.2 +073700**************************************************************** IC2234.2 +073800 ENVIRONMENT DIVISION. IC2234.2 +073900 CONFIGURATION SECTION. IC2234.2 +074000 SOURCE-COMPUTER. IC2234.2 +074100 Linux. IC2234.2 +074200 OBJECT-COMPUTER. IC2234.2 +074300 Linux. IC2234.2 +074400 INPUT-OUTPUT SECTION. IC2234.2 +074500 FILE-CONTROL. IC2234.2 +074600 SELECT PRINT-FILE ASSIGN TO IC2234.2 +074700 "report.log". IC2234.2 +074800 DATA DIVISION. IC2234.2 +074900 FILE SECTION. IC2234.2 +075000 FD PRINT-FILE. IC2234.2 +075100 01 PRINT-REC PICTURE X(120). IC2234.2 +075200 01 DUMMY-RECORD PICTURE X(120). IC2234.2 +075300 WORKING-STORAGE SECTION. IC2234.2 +075400 77 WS1 PICTURE S999. IC2234.2 +075500 77 WS2 PICTURE S999 IC2234.2 +075600 USAGE COMPUTATIONAL, VALUE ZERO. IC2234.2 +075700 LINKAGE SECTION. IC2234.2 +075800 77 DN1 PICTURE S99. IC2234.2 +075900 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2234.2 +076000 77 DN3 PICTURE S99. IC2234.2 +076100 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2234.2 +076200 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2234.2 +076300 SECT-IC223A-1-001 SECTION. IC2234.2 +076400 CALL-TEST-001. IC2234.2 +076500 MOVE DN1 TO WS1. IC2234.2 +076600 ADD 1 TO WS1. IC2234.2 +076700 ADD 1 TO WS2. IC2234.2 +076800 MOVE WS1 TO DN3. IC2234.2 +076900 MOVE WS2 TO DN4. IC2234.2 +077000 CALL-EXIT-001. IC2234.2 +077100 EXIT PROGRAM. IC2234.2 diff --git a/tests/cobol85/IC/IC224A.CBL b/tests/cobol85/IC/IC224A.CBL new file mode 100755 index 00000000..d513515c --- /dev/null +++ b/tests/cobol85/IC/IC224A.CBL @@ -0,0 +1,703 @@ +000100 IDENTIFICATION DIVISION. IC2244.2 +000200 PROGRAM-ID. IC2244.2 +000300 IC224A. IC2244.2 +000400**************************************************************** IC2244.2 +000500* * IC2244.2 +000600* VALIDATION FOR:- * IC2244.2 +000700* * IC2244.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2244.2 +000900* * IC2244.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2244.2 +001100* * IC2244.2 +001200**************************************************************** IC2244.2 +001300* * IC2244.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2244.2 +001500* * IC2244.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2244.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2244.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2244.2 +001900* * IC2244.2 +002000**************************************************************** IC2244.2 +002100* * IC2244.2 +002200* PROGRAM IC224A AND IC224A-1 WILL TEST THE NEW LANGUAGE * IC2244.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2244.2 +002400* MODULE. * IC2244.2 +002500* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2244.2 +002600* "BY CONTENT" PHRASE * IC2244.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2244.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2244.2 +002900* IDENTIFICATION DIVISION. * IC2244.2 +003000* PROGRAM-ID. IC224A. * IC2244.2 +003100* . * IC2244.2 +003200* . * IC2244.2 +003300* . * IC2244.2 +003400* END PROGRAM IC224A. * IC2244.2 +003500* PROGRAM-ID. IC224A-1. * IC2244.2 +003600* . * IC2244.2 +003700* . * IC2244.2 +003800* . * IC2244.2 +003900**************************************************************** IC2244.2 +004000 ENVIRONMENT DIVISION. IC2244.2 +004100 CONFIGURATION SECTION. IC2244.2 +004200 SOURCE-COMPUTER. IC2244.2 +004300 Linux. IC2244.2 +004400 OBJECT-COMPUTER. IC2244.2 +004500 Linux. IC2244.2 +004600 INPUT-OUTPUT SECTION. IC2244.2 +004700 FILE-CONTROL. IC2244.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2244.2 +004900 "report.log". IC2244.2 +005000 DATA DIVISION. IC2244.2 +005100 FILE SECTION. IC2244.2 +005200 FD PRINT-FILE. IC2244.2 +005300 01 PRINT-REC PICTURE X(120). IC2244.2 +005400 01 DUMMY-RECORD PICTURE X(120). IC2244.2 +005500 WORKING-STORAGE SECTION. IC2244.2 +005600 77 DN1 PICTURE S99 VALUE ZERO. IC2244.2 +005700 77 DN3 PICTURE S99. IC2244.2 +005800 77 ID1 PICTURE X(8) VALUE "IC224A-1". IC2244.2 +005900 77 ID2 PICTURE X(8). IC2244.2 +006000 77 DN2 PICTURE S99 IC2244.2 +006100 USAGE COMPUTATIONAL, VALUE ZERO. IC2244.2 +006200 77 DN4 PICTURE S99 IC2244.2 +006300 USAGE IS COMPUTATIONAL. IC2244.2 +006400 77 SAVE-DN1 PICTURE S99. IC2244.2 +006500 77 SAVE-DN3 PICTURE S99. IC2244.2 +006600 77 SAVE-DN2 PICTURE S99 IC2244.2 +006700 USAGE COMPUTATIONAL. IC2244.2 +006800 77 SAVE-DN4 PICTURE S99 IC2244.2 +006900 USAGE IS COMPUTATIONAL. IC2244.2 +007000 77 CALL-COUNT PIC S99. IC2244.2 +007100 77 FAIL-FLAG PIC 9. IC2244.2 +007200 01 TEST-RESULTS. IC2244.2 +007300 02 FILLER PIC X VALUE SPACE. IC2244.2 +007400 02 FEATURE PIC X(20) VALUE SPACE. IC2244.2 +007500 02 FILLER PIC X VALUE SPACE. IC2244.2 +007600 02 P-OR-F PIC X(5) VALUE SPACE. IC2244.2 +007700 02 FILLER PIC X VALUE SPACE. IC2244.2 +007800 02 PAR-NAME. IC2244.2 +007900 03 FILLER PIC X(19) VALUE SPACE. IC2244.2 +008000 03 PARDOT-X PIC X VALUE SPACE. IC2244.2 +008100 03 DOTVALUE PIC 99 VALUE ZERO. IC2244.2 +008200 02 FILLER PIC X(8) VALUE SPACE. IC2244.2 +008300 02 RE-MARK PIC X(61). IC2244.2 +008400 01 TEST-COMPUTED. IC2244.2 +008500 02 FILLER PIC X(30) VALUE SPACE. IC2244.2 +008600 02 FILLER PIC X(17) VALUE IC2244.2 +008700 " COMPUTED=". IC2244.2 +008800 02 COMPUTED-X. IC2244.2 +008900 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2244.2 +009000 03 COMPUTED-N REDEFINES COMPUTED-A IC2244.2 +009100 PIC -9(9).9(9). IC2244.2 +009200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2244.2 +009300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2244.2 +009400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2244.2 +009500 03 CM-18V0 REDEFINES COMPUTED-A. IC2244.2 +009600 04 COMPUTED-18V0 PIC -9(18). IC2244.2 +009700 04 FILLER PIC X. IC2244.2 +009800 03 FILLER PIC X(50) VALUE SPACE. IC2244.2 +009900 01 TEST-CORRECT. IC2244.2 +010000 02 FILLER PIC X(30) VALUE SPACE. IC2244.2 +010100 02 FILLER PIC X(17) VALUE " CORRECT =". IC2244.2 +010200 02 CORRECT-X. IC2244.2 +010300 03 CORRECT-A PIC X(20) VALUE SPACE. IC2244.2 +010400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2244.2 +010500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2244.2 +010600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2244.2 +010700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2244.2 +010800 03 CR-18V0 REDEFINES CORRECT-A. IC2244.2 +010900 04 CORRECT-18V0 PIC -9(18). IC2244.2 +011000 04 FILLER PIC X. IC2244.2 +011100 03 FILLER PIC X(2) VALUE SPACE. IC2244.2 +011200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2244.2 +011300 01 CCVS-C-1. IC2244.2 +011400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2244.2 +011500- "SS PARAGRAPH-NAME IC2244.2 +011600- " REMARKS". IC2244.2 +011700 02 FILLER PIC X(20) VALUE SPACE. IC2244.2 +011800 01 CCVS-C-2. IC2244.2 +011900 02 FILLER PIC X VALUE SPACE. IC2244.2 +012000 02 FILLER PIC X(6) VALUE "TESTED". IC2244.2 +012100 02 FILLER PIC X(15) VALUE SPACE. IC2244.2 +012200 02 FILLER PIC X(4) VALUE "FAIL". IC2244.2 +012300 02 FILLER PIC X(94) VALUE SPACE. IC2244.2 +012400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2244.2 +012500 01 REC-CT PIC 99 VALUE ZERO. IC2244.2 +012600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2244.2 +012700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2244.2 +012800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2244.2 +012900 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2244.2 +013000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2244.2 +013100 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2244.2 +013200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2244.2 +013300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2244.2 +013400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2244.2 +013500 01 CCVS-H-1. IC2244.2 +013600 02 FILLER PIC X(39) VALUE SPACES. IC2244.2 +013700 02 FILLER PIC X(42) VALUE IC2244.2 +013800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2244.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IC2244.2 +014000 01 CCVS-H-2A. IC2244.2 +014100 02 FILLER PIC X(40) VALUE SPACE. IC2244.2 +014200 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2244.2 +014300 02 FILLER PIC XXXX VALUE IC2244.2 +014400 "4.2 ". IC2244.2 +014500 02 FILLER PIC X(28) VALUE IC2244.2 +014600 " COPY - NOT FOR DISTRIBUTION". IC2244.2 +014700 02 FILLER PIC X(41) VALUE SPACE. IC2244.2 +014800 IC2244.2 +014900 01 CCVS-H-2B. IC2244.2 +015000 02 FILLER PIC X(15) VALUE IC2244.2 +015100 "TEST RESULT OF ". IC2244.2 +015200 02 TEST-ID PIC X(9). IC2244.2 +015300 02 FILLER PIC X(4) VALUE IC2244.2 +015400 " IN ". IC2244.2 +015500 02 FILLER PIC X(12) VALUE IC2244.2 +015600 " HIGH ". IC2244.2 +015700 02 FILLER PIC X(22) VALUE IC2244.2 +015800 " LEVEL VALIDATION FOR ". IC2244.2 +015900 02 FILLER PIC X(58) VALUE IC2244.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2244.2 +016100 01 CCVS-H-3. IC2244.2 +016200 02 FILLER PIC X(34) VALUE IC2244.2 +016300 " FOR OFFICIAL USE ONLY ". IC2244.2 +016400 02 FILLER PIC X(58) VALUE IC2244.2 +016500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2244.2 +016600 02 FILLER PIC X(28) VALUE IC2244.2 +016700 " COPYRIGHT 1985 ". IC2244.2 +016800 01 CCVS-E-1. IC2244.2 +016900 02 FILLER PIC X(52) VALUE SPACE. IC2244.2 +017000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2244.2 +017100 02 ID-AGAIN PIC X(9). IC2244.2 +017200 02 FILLER PIC X(45) VALUE SPACES. IC2244.2 +017300 01 CCVS-E-2. IC2244.2 +017400 02 FILLER PIC X(31) VALUE SPACE. IC2244.2 +017500 02 FILLER PIC X(21) VALUE SPACE. IC2244.2 +017600 02 CCVS-E-2-2. IC2244.2 +017700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2244.2 +017800 03 FILLER PIC X VALUE SPACE. IC2244.2 +017900 03 ENDER-DESC PIC X(44) VALUE IC2244.2 +018000 "ERRORS ENCOUNTERED". IC2244.2 +018100 01 CCVS-E-3. IC2244.2 +018200 02 FILLER PIC X(22) VALUE IC2244.2 +018300 " FOR OFFICIAL USE ONLY". IC2244.2 +018400 02 FILLER PIC X(12) VALUE SPACE. IC2244.2 +018500 02 FILLER PIC X(58) VALUE IC2244.2 +018600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2244.2 +018700 02 FILLER PIC X(13) VALUE SPACE. IC2244.2 +018800 02 FILLER PIC X(15) VALUE IC2244.2 +018900 " COPYRIGHT 1985". IC2244.2 +019000 01 CCVS-E-4. IC2244.2 +019100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2244.2 +019200 02 FILLER PIC X(4) VALUE " OF ". IC2244.2 +019300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2244.2 +019400 02 FILLER PIC X(40) VALUE IC2244.2 +019500 " TESTS WERE EXECUTED SUCCESSFULLY". IC2244.2 +019600 01 XXINFO. IC2244.2 +019700 02 FILLER PIC X(19) VALUE IC2244.2 +019800 "*** INFORMATION ***". IC2244.2 +019900 02 INFO-TEXT. IC2244.2 +020000 04 FILLER PIC X(8) VALUE SPACE. IC2244.2 +020100 04 XXCOMPUTED PIC X(20). IC2244.2 +020200 04 FILLER PIC X(5) VALUE SPACE. IC2244.2 +020300 04 XXCORRECT PIC X(20). IC2244.2 +020400 02 INF-ANSI-REFERENCE PIC X(48). IC2244.2 +020500 01 HYPHEN-LINE. IC2244.2 +020600 02 FILLER PIC IS X VALUE IS SPACE. IC2244.2 +020700 02 FILLER PIC IS X(65) VALUE IS "************************IC2244.2 +020800- "*****************************************". IC2244.2 +020900 02 FILLER PIC IS X(54) VALUE IS "************************IC2244.2 +021000- "******************************". IC2244.2 +021100 01 CCVS-PGM-ID PIC X(9) VALUE IC2244.2 +021200 "IC224A". IC2244.2 +021300 PROCEDURE DIVISION. IC2244.2 +021400 CCVS1 SECTION. IC2244.2 +021500 OPEN-FILES. IC2244.2 +021600 OPEN OUTPUT PRINT-FILE. IC2244.2 +021700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2244.2 +021800 MOVE SPACE TO TEST-RESULTS. IC2244.2 +021900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2244.2 +022000 GO TO CCVS1-EXIT. IC2244.2 +022100 CLOSE-FILES. IC2244.2 +022200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2244.2 +022300 TERMINATE-CCVS. IC2244.2 +022400*S EXIT PROGRAM. IC2244.2 +022500*SERMINATE-CALL. IC2244.2 +022600 STOP RUN. IC2244.2 +022700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2244.2 +022800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2244.2 +022900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2244.2 +023000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2244.2 +023100 MOVE "****TEST DELETED****" TO RE-MARK. IC2244.2 +023200 PRINT-DETAIL. IC2244.2 +023300 IF REC-CT NOT EQUAL TO ZERO IC2244.2 +023400 MOVE "." TO PARDOT-X IC2244.2 +023500 MOVE REC-CT TO DOTVALUE. IC2244.2 +023600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2244.2 +023700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2244.2 +023800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2244.2 +023900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2244.2 +024000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2244.2 +024100 MOVE SPACE TO CORRECT-X. IC2244.2 +024200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2244.2 +024300 MOVE SPACE TO RE-MARK. IC2244.2 +024400 HEAD-ROUTINE. IC2244.2 +024500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +024600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +024700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2244.2 +024800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2244.2 +024900 COLUMN-NAMES-ROUTINE. IC2244.2 +025000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +025100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +025200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +025300 END-ROUTINE. IC2244.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2244.2 +025500 END-RTN-EXIT. IC2244.2 +025600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +025700 END-ROUTINE-1. IC2244.2 +025800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2244.2 +025900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2244.2 +026000 ADD PASS-COUNTER TO ERROR-HOLD. IC2244.2 +026100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2244.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2244.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2244.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2244.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2244.2 +026600 END-ROUTINE-12. IC2244.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2244.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IC2244.2 +026900 MOVE "NO " TO ERROR-TOTAL IC2244.2 +027000 ELSE IC2244.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2244.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2244.2 +027300 PERFORM WRITE-LINE. IC2244.2 +027400 END-ROUTINE-13. IC2244.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IC2244.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IC2244.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2244.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2244.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IC2244.2 +028100 MOVE "NO " TO ERROR-TOTAL IC2244.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2244.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2244.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2244.2 +028600 WRITE-LINE. IC2244.2 +028700 ADD 1 TO RECORD-COUNT. IC2244.2 +028800 IF RECORD-COUNT GREATER 50 IC2244.2 +028900 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2244.2 +029000 MOVE SPACE TO DUMMY-RECORD IC2244.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2244.2 +029200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2244.2 +029300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2244.2 +029400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2244.2 +029500 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2244.2 +029600 MOVE ZERO TO RECORD-COUNT. IC2244.2 +029700 PERFORM WRT-LN. IC2244.2 +029800 WRT-LN. IC2244.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2244.2 +030000 MOVE SPACE TO DUMMY-RECORD. IC2244.2 +030100 BLANK-LINE-PRINT. IC2244.2 +030200 PERFORM WRT-LN. IC2244.2 +030300 FAIL-ROUTINE. IC2244.2 +030400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2244.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2244.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2244.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2244.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. IC2244.2 +031000 GO TO FAIL-ROUTINE-EX. IC2244.2 +031100 FAIL-ROUTINE-WRITE. IC2244.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2244.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2244.2 +031400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2244.2 +031500 MOVE SPACES TO COR-ANSI-REFERENCE. IC2244.2 +031600 FAIL-ROUTINE-EX. EXIT. IC2244.2 +031700 BAIL-OUT. IC2244.2 +031800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2244.2 +031900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2244.2 +032000 BAIL-OUT-WRITE. IC2244.2 +032100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2244.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2244.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2244.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. IC2244.2 +032500 BAIL-OUT-EX. EXIT. IC2244.2 +032600 CCVS1-EXIT. IC2244.2 +032700 EXIT. IC2244.2 +032800 SECT-IC224A-001 SECTION. IC2244.2 +032900 CALL-TEST-01. IC2244.2 +033000 MOVE "CALL-TEST-01" TO PAR-NAME. IC2244.2 +033100 MOVE "LEV 2 CALL STATEMENT" TO FEATURE. IC2244.2 +033200 MOVE 0 TO CALL-COUNT. IC2244.2 +033300* THIS TEST HAS CALL STATEMENTS WITH AN IDENTIFIER IC2244.2 +033400* CONTAINING THE NAME OF THE SUBPROGRAM TO BE CALLED. IC2244.2 +033500* CALL-TEST-01 CONTAINS THE BASIC LEVEL 2 CALL STATEMENT. IC2244.2 +033600* IF IT CANNOT BE COMPILED AND EXECUTED CORRECTLY, THERE IS IC2244.2 +033700* NO USE IN RUNNING THE LEVEL 2 IPC ROUTINES. IC2244.2 +033800 CALL-TEST-01-01. IC2244.2 +033900 MOVE ZERO TO DN3, DN4. IC2244.2 +034000 MOVE "CALL-TEST-01-01" TO PAR-NAME. IC2244.2 +034100 MOVE DN1 TO SAVE-DN1. IC2244.2 +034200 MOVE DN2 TO SAVE-DN2. IC2244.2 +034300 MOVE DN3 TO SAVE-DN3. IC2244.2 +034400 MOVE DN4 TO SAVE-DN4. IC2244.2 +034500 CALL "IC224A-1" USING BY CONTENT DN1, DN2, DN3, DN4 IC2244.2 +034600 END-CALL. IC2244.2 +034700 PERFORM CHECK-TEST-01. IC2244.2 +034800 CALL-TEST-01-02. IC2244.2 +034900 ADD 1 TO REC-CT. IC2244.2 +035000 MOVE ZERO TO DN3, DN4. IC2244.2 +035100 MOVE "CALL-TEST-01-02" TO PAR-NAME. IC2244.2 +035200 MOVE DN1 TO SAVE-DN1. IC2244.2 +035300 MOVE DN2 TO SAVE-DN2. IC2244.2 +035400 MOVE DN3 TO SAVE-DN3. IC2244.2 +035500 MOVE DN4 TO SAVE-DN4. IC2244.2 +035600 CALL ID1 USING CONTENT DN1, DN2, DN3, DN4 IC2244.2 +035700 END-CALL. IC2244.2 +035800 PERFORM CHECK-TEST-01. IC2244.2 +035900 CALL-TEST-01-03. IC2244.2 +036000 MOVE ID1 TO ID2. IC2244.2 +036100 MOVE ZERO TO DN3, DN4. IC2244.2 +036200 MOVE "CALL-TEST-01-03" TO PAR-NAME. IC2244.2 +036300 MOVE DN1 TO SAVE-DN1. IC2244.2 +036400 MOVE DN2 TO SAVE-DN2. IC2244.2 +036500 MOVE DN3 TO SAVE-DN3. IC2244.2 +036600 MOVE DN4 TO SAVE-DN4. IC2244.2 +036700 CALL ID2 USING CONTENT DN1 DN2 DN3 DN4 IC2244.2 +036800 END-CALL. IC2244.2 +036900 PERFORM CHECK-TEST-01. IC2244.2 +037000 CALL-TEST-01-04. IC2244.2 +037100 MOVE "IC224A-1" TO ID2. IC2244.2 +037200 MOVE ZERO TO DN3, DN4. IC2244.2 +037300 MOVE "CALL-TEST-01-03" TO PAR-NAME. IC2244.2 +037400 MOVE DN1 TO SAVE-DN1. IC2244.2 +037500 MOVE DN2 TO SAVE-DN2. IC2244.2 +037600 MOVE DN3 TO SAVE-DN3. IC2244.2 +037700 MOVE DN4 TO SAVE-DN4. IC2244.2 +037800 CALL ID2 USING CONTENT DN1, DN2, DN3, DN4 IC2244.2 +037900 END-CALL. IC2244.2 +038000 PERFORM CHECK-TEST-01. IC2244.2 +038100 CALL-TEST-02. IC2244.2 +038200 MOVE "CALL-TEST-02" TO PAR-NAME. IC2244.2 +038300 MOVE "DATA-NAME USED TWICE" TO FEATURE. IC2244.2 +038400* THIS TEST USES A DATA-NAME MORE THAN ONCE IN IC2244.2 +038500* A USING PHRASE OF A CALL STATEMENT. IC2244.2 +038600 CALL-INIT-02-01. IC2244.2 +038700 MOVE 1 TO DN1. IC2244.2 +038800 MOVE 0 TO DN2, DN3, DN4. IC2244.2 +038900 MOVE "CALL-TEST-02-01" TO PAR-NAME. IC2244.2 +039000 MOVE DN1 TO SAVE-DN1. IC2244.2 +039100 MOVE DN2 TO SAVE-DN2. IC2244.2 +039200 MOVE DN3 TO SAVE-DN3. IC2244.2 +039300 MOVE DN4 TO SAVE-DN4. IC2244.2 +039400 GO TO CALL-TEST-02-01. IC2244.2 +039500 CALL-DELETE-02-01. IC2244.2 +039600 PERFORM DE-LETE. IC2244.2 +039700 PERFORM PRINT-DETAIL. IC2244.2 +039800 GO TO CALL-INIT-02-02. IC2244.2 +039900 CALL-TEST-02-01. IC2244.2 +040000 CALL "IC224A-1" USING CONTENT DN1, DN2, DN1, DN4 IC2244.2 +040100 END-CALL. IC2244.2 +040200 PERFORM CHECK-TEST-01. IC2244.2 +040300 CALL-INIT-02-02. IC2244.2 +040400 MOVE 0 TO DN1, DN2, DN3, DN4. IC2244.2 +040500 MOVE "CALL-TEST-02-02" TO PAR-NAME. IC2244.2 +040600 MOVE DN1 TO SAVE-DN1. IC2244.2 +040700 MOVE DN2 TO SAVE-DN2. IC2244.2 +040800 MOVE DN3 TO SAVE-DN3. IC2244.2 +040900 MOVE DN4 TO SAVE-DN4. IC2244.2 +041000 GO TO CALL-TEST-02-02. IC2244.2 +041100 CALL-DELETE-02-02. IC2244.2 +041200 PERFORM DE-LETE. IC2244.2 +041300 PERFORM PRINT-DETAIL. IC2244.2 +041400 GO TO CALL-INIT-02-03. IC2244.2 +041500 CALL-TEST-02-02. IC2244.2 +041600 CALL "IC224A-1" USING CONTENT DN1, DN2, DN3, DN2 IC2244.2 +041700 END-CALL. IC2244.2 +041800 PERFORM CHECK-TEST-01. IC2244.2 +041900 CALL-INIT-02-03. IC2244.2 +042000 MOVE 0 TO DN4, DN3. IC2244.2 +042100 MOVE 10 TO DN2. IC2244.2 +042200 MOVE 25 TO DN1. IC2244.2 +042300 MOVE "CALL-TEST-02-03" TO PAR-NAME. IC2244.2 +042400 MOVE DN1 TO SAVE-DN1. IC2244.2 +042500 MOVE DN2 TO SAVE-DN2. IC2244.2 +042600 MOVE DN3 TO SAVE-DN3. IC2244.2 +042700 MOVE DN4 TO SAVE-DN4. IC2244.2 +042800 GO TO CALL-TEST-02-03. IC2244.2 +042900 CALL-DELETE-02-03. IC2244.2 +043000 PERFORM DE-LETE. IC2244.2 +043100 PERFORM PRINT-DETAIL. IC2244.2 +043200 GO TO CALL-TEST-03. IC2244.2 +043300 CALL-TEST-02-03. IC2244.2 +043400 CALL ID1 USING CONTENT DN1 DN2 DN1 DN2 IC2244.2 +043500 END-CALL. IC2244.2 +043600 PERFORM CHECK-TEST-01. IC2244.2 +043700 CALL-TEST-03. IC2244.2 +043800* THIS TEST USES THE ON OVERFLOW PHRASE IN THE CALL IC2244.2 +043900* STATEMENT. THIS IS A SYNTACTICAL CHECK ONLY, THE ON IC2244.2 +044000* OVERFLOW CONDITION SHOULD NEVER OCCUR. IC2244.2 +044100 MOVE "ON OVERFLOW PHRASE" TO FEATURE. IC2244.2 +044200 CALL-INIT-03-01. IC2244.2 +044300 MOVE 20 TO DN1. IC2244.2 +044400 MOVE 30 TO DN2. IC2244.2 +044500 MOVE ZERO TO DN3, DN4. IC2244.2 +044600 MOVE "CALL-TEST-03-01" TO PAR-NAME. IC2244.2 +044700 MOVE DN1 TO SAVE-DN1. IC2244.2 +044800 MOVE DN2 TO SAVE-DN2. IC2244.2 +044900 MOVE DN3 TO SAVE-DN3. IC2244.2 +045000 MOVE DN4 TO SAVE-DN4. IC2244.2 +045100 GO TO CALL-TEST-03-01. IC2244.2 +045200 CALL-DELETE-03-01. IC2244.2 +045300 PERFORM DE-LETE. IC2244.2 +045400 PERFORM PRINT-DETAIL. IC2244.2 +045500 GO TO CALL-INIT-03-02. IC2244.2 +045600 CALL-TEST-03-01. IC2244.2 +045700 CALL "IC224A-1" USING CONTENT DN1, DN2, DN3, DN4; IC2244.2 +045800 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2244.2 +045900 PERFORM FAIL PERFORM PRINT-DETAIL IC2244.2 +046000 END-CALL. IC2244.2 +046100 MOVE "CALL-TEST-03-01" TO PAR-NAME. IC2244.2 +046200 PERFORM CHECK-TEST-01. IC2244.2 +046300 CALL-INIT-03-02. IC2244.2 +046400 MOVE ZERO TO DN3, DN4. IC2244.2 +046500 MOVE "CALL-TEST-03-02" TO PAR-NAME. IC2244.2 +046600 MOVE DN1 TO SAVE-DN1. IC2244.2 +046700 MOVE DN2 TO SAVE-DN2. IC2244.2 +046800 MOVE DN3 TO SAVE-DN3. IC2244.2 +046900 MOVE DN4 TO SAVE-DN4. IC2244.2 +047000 GO TO CALL-TEST-03-02. IC2244.2 +047100 CALL-DELETE-03-02. IC2244.2 +047200 PERFORM DE-LETE. IC2244.2 +047300 PERFORM PRINT-DETAIL. IC2244.2 +047400 GO TO CALL-INIT-03-03. IC2244.2 +047500 CALL-TEST-03-02. IC2244.2 +047600 CALL "IC224A-1" USING CONTENT DN1, DN2, DN3, DN4; IC2244.2 +047700 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2244.2 +047800 PERFORM FAIL PERFORM PRINT-DETAIL IC2244.2 +047900 END-CALL. IC2244.2 +048000 PERFORM CHECK-TEST-01. IC2244.2 +048100 CALL-INIT-03-03. IC2244.2 +048200 MOVE ZERO TO DN3, DN4. IC2244.2 +048300 MOVE "CALL-TEST-03-03" TO PAR-NAME. IC2244.2 +048400 MOVE DN1 TO SAVE-DN1. IC2244.2 +048500 MOVE DN2 TO SAVE-DN2. IC2244.2 +048600 MOVE DN3 TO SAVE-DN3. IC2244.2 +048700 MOVE DN4 TO SAVE-DN4. IC2244.2 +048800 GO TO CALL-TEST-03-03. IC2244.2 +048900 CALL-DELETE-03-03. IC2244.2 +049000 PERFORM DE-LETE. IC2244.2 +049100 PERFORM PRINT-DETAIL. IC2244.2 +049200 GO TO CALL-INIT-03-04. IC2244.2 +049300 CALL-TEST-03-03. IC2244.2 +049400 CALL ID1 USING CONTENT DN1 DN2 DN3 DN4 IC2244.2 +049500 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2244.2 +049600 PERFORM FAIL PERFORM PRINT-DETAIL IC2244.2 +049700 END-CALL. IC2244.2 +049800 PERFORM CHECK-TEST-01. IC2244.2 +049900 CALL-INIT-03-04. IC2244.2 +050000 MOVE ZERO TO DN3, DN4. IC2244.2 +050100 MOVE "CALL-TEST-03-04" TO PAR-NAME. IC2244.2 +050200 MOVE DN1 TO SAVE-DN1. IC2244.2 +050300 MOVE DN2 TO SAVE-DN2. IC2244.2 +050400 MOVE DN3 TO SAVE-DN3. IC2244.2 +050500 MOVE DN4 TO SAVE-DN4. IC2244.2 +050600 GO TO CALL-TEST-03-04. IC2244.2 +050700 CALL-DELETE-03-04. IC2244.2 +050800 PERFORM DE-LETE. IC2244.2 +050900 PERFORM PRINT-DETAIL. IC2244.2 +051000 GO TO EXIT-IC224A. IC2244.2 +051100 CALL-TEST-03-04. IC2244.2 +051200 CALL ID1 USING CONTENT DN1 DN2 DN3 DN4; IC2244.2 +051300 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK, IC2244.2 +051400 PERFORM FAIL PERFORM PRINT-DETAIL IC2244.2 +051500 END-CALL. IC2244.2 +051600 PERFORM CHECK-TEST-01. IC2244.2 +051700 GO TO EXIT-IC224A. IC2244.2 +051800 CALL-DELETE-03. IC2244.2 +051900* IF THE ON OVERFLOW PHRASE IS NOT RECOGNIZED, DELETE ALL IC2244.2 +052000* OF THE ABOVE CALL-TEST-03 PARAGRAPHS, STARTING WITH IC2244.2 +052100* CALL-TEST-03-01. IC2244.2 +052200 PERFORM DE-LETE. IC2244.2 +052300 PERFORM PRINT-DETAIL. IC2244.2 +052400 EXIT-IC224A. IC2244.2 +052500 GO TO CCVS-EXIT. IC2244.2 +052600* IC2244.2 +052700 SECT-IC224A-CHECK-01. IC2244.2 +052800*===================== IC2244.2 +052900 CHECK-TEST-01. IC2244.2 +053000 MOVE 1 TO REC-CT. IC2244.2 +053100 IF DN1 = SAVE-DN1 IC2244.2 +053200 PERFORM PASS IC2244.2 +053300 PERFORM PRINT-DETAIL IC2244.2 +053400 ELSE IC2244.2 +053500 MOVE SAVE-DN1 TO CORRECT-N IC2244.2 +053600 MOVE DN1 TO COMPUTED-N IC2244.2 +053700 MOVE "VALUE OF DN1 HAS CHANGED" TO RE-MARK IC2244.2 +053800 PERFORM FAIL IC2244.2 +053900 PERFORM PRINT-DETAIL. IC2244.2 +054000 ADD 1 TO REC-CT. IC2244.2 +054100 IF DN2 = SAVE-DN2 IC2244.2 +054200 PERFORM PASS IC2244.2 +054300 PERFORM PRINT-DETAIL IC2244.2 +054400 ELSE IC2244.2 +054500 MOVE SAVE-DN2 TO CORRECT-N IC2244.2 +054600 MOVE DN2 TO COMPUTED-N IC2244.2 +054700 MOVE "VALUE OF DN2 HAS CHANGED" TO RE-MARK IC2244.2 +054800 PERFORM FAIL IC2244.2 +054900 PERFORM PRINT-DETAIL. IC2244.2 +055000 ADD 1 TO REC-CT. IC2244.2 +055100 IF DN3 = SAVE-DN3 IC2244.2 +055200 PERFORM PASS IC2244.2 +055300 PERFORM PRINT-DETAIL IC2244.2 +055400 ELSE IC2244.2 +055500 MOVE SAVE-DN3 TO CORRECT-N IC2244.2 +055600 MOVE DN3 TO COMPUTED-N IC2244.2 +055700 MOVE "VALUE OF DN3 HAS CHANGED" TO RE-MARK IC2244.2 +055800 PERFORM FAIL IC2244.2 +055900 PERFORM PRINT-DETAIL. IC2244.2 +056000 ADD 1 TO REC-CT. IC2244.2 +056100 IF DN4 = SAVE-DN4 IC2244.2 +056200 PERFORM PASS IC2244.2 +056300 PERFORM PRINT-DETAIL IC2244.2 +056400 ELSE IC2244.2 +056500 MOVE SAVE-DN4 TO CORRECT-N IC2244.2 +056600 MOVE DN4 TO COMPUTED-N IC2244.2 +056700 MOVE "VALUE OF DN4 HAS CHANGED" TO RE-MARK IC2244.2 +056800 PERFORM FAIL IC2244.2 +056900 PERFORM PRINT-DETAIL. IC2244.2 +057000* IC2244.2 +057100* IC2244.2 +057200 CCVS-EXIT SECTION. IC2244.2 +057300 CCVS-999999. IC2244.2 +057400 GO TO CLOSE-FILES. IC2244.2 +057500 END PROGRAM IC224A. IC2244.2 +057600 IDENTIFICATION DIVISION. IC2244.2 +057700 PROGRAM-ID. IC2244.2 +057800 IC224A-1. IC2244.2 +057900**************************************************************** IC2244.2 +058000* * IC2244.2 +058100* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2244.2 +058200* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2244.2 +058300* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2244.2 +058400* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2244.2 +058500* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2244.2 +058600* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2244.2 +058700* * IC2244.2 +058800* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2244.2 +058900* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2244.2 +059000* DOCUMENT REFERENCE: ISO-1989-1978). * IC2244.2 +059100* * IC2244.2 +059200* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2244.2 +059300* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2244.2 +059400* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2244.2 +059500* * IC2244.2 +059600* THE FEDERAL SOFTWARE TESTING CENTER * IC2244.2 +059700* OFFICE OF SOFTWARE DEVELOPMENT * IC2244.2 +059800* & INFORMATION TECHNOLOGY * IC2244.2 +059900* TWO SKYLINE PLACE * IC2244.2 +060000* SUITE 1100 * IC2244.2 +060100* 5203 LEESBURG PIKE * IC2244.2 +060200* FALLS CHURCH * IC2244.2 +060300* VA 22041 * IC2244.2 +060400* U.S.A. * IC2244.2 +060500* * IC2244.2 +060600* THE PROJECT TEAM MEMBERS WERE: * IC2244.2 +060700* * IC2244.2 +060800* BIADI (BUREAU INTER ADMINISTRATION * IC2244.2 +060900* DE DOCUMENTATION INFORMATIQUE) * IC2244.2 +061000* 21 RUE BARA * IC2244.2 +061100* F-92132 ISSY * IC2244.2 +061200* FRANCE * IC2244.2 +061300* * IC2244.2 +061400* * IC2244.2 +061500* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2244.2 +061600* UND DATENVERARBEITUNG MBH) * IC2244.2 +061700* SCHLOSS BIRLINGHOVEN * IC2244.2 +061800* POSTFACH 12 40 * IC2244.2 +061900* D-5205 ST. AUGUSTIN 1 * IC2244.2 +062000* GERMANY FR * IC2244.2 +062100* * IC2244.2 +062200* * IC2244.2 +062300* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2244.2 +062400* OXFORD ROAD * IC2244.2 +062500* MANCHESTER * IC2244.2 +062600* M1 7ED * IC2244.2 +062700* UNITED KINGDOM * IC2244.2 +062800* * IC2244.2 +062900* * IC2244.2 +063000* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2244.2 +063100* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2244.2 +063200* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2244.2 +063300* * IC2244.2 +063400**************************************************************** IC2244.2 +063500* * IC2244.2 +063600* VALIDATION FOR:- * IC2244.2 +063700* * IC2244.2 +063800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2244.2 +063900* * IC2244.2 +064000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2244.2 +064100* * IC2244.2 +064200**************************************************************** IC2244.2 +064300* * IC2244.2 +064400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2244.2 +064500* * IC2244.2 +064600* X-55 - SYSTEM PRINTER NAME. * IC2244.2 +064700* X-82 - SOURCE COMPUTER NAME. * IC2244.2 +064800* X-83 - OBJECT COMPUTER NAME. * IC2244.2 +064900* * IC2244.2 +065000**************************************************************** IC2244.2 +065100* * IC2244.2 +065200* PROGRAM IC224A AND IC224A-1 WILL TEST THE NEW LANGUAGE * IC2244.2 +065300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2244.2 +065400* MODULE. * IC2244.2 +065500* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2244.2 +065600* "BY CONTENT" PHRASE * IC2244.2 +065700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2244.2 +065800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2244.2 +065900* IDENTIFICATION DIVISION. * IC2244.2 +066000* PROGRAM-ID. IC224A. * IC2244.2 +066100* . * IC2244.2 +066200* . * IC2244.2 +066300* . * IC2244.2 +066400* END PROGRAM IC224A. * IC2244.2 +066500* PROGRAM-ID. IC224A-1. * IC2244.2 +066600* . * IC2244.2 +066700* . * IC2244.2 +066800* . * IC2244.2 +066900**************************************************************** IC2244.2 +067000 ENVIRONMENT DIVISION. IC2244.2 +067100 CONFIGURATION SECTION. IC2244.2 +067200 SOURCE-COMPUTER. IC2244.2 +067300 Linux. IC2244.2 +067400 OBJECT-COMPUTER. IC2244.2 +067500 Linux. IC2244.2 +067600 INPUT-OUTPUT SECTION. IC2244.2 +067700 FILE-CONTROL. IC2244.2 +067800 SELECT PRINT-FILE ASSIGN TO IC2244.2 +067900 "report.log". IC2244.2 +068000 DATA DIVISION. IC2244.2 +068100 FILE SECTION. IC2244.2 +068200 FD PRINT-FILE. IC2244.2 +068300 01 PRINT-REC PICTURE X(120). IC2244.2 +068400 01 DUMMY-RECORD PICTURE X(120). IC2244.2 +068500 WORKING-STORAGE SECTION. IC2244.2 +068600 77 WS1 PICTURE S999. IC2244.2 +068700 77 WS2 PICTURE S999 IC2244.2 +068800 USAGE COMPUTATIONAL, VALUE ZERO. IC2244.2 +068900 LINKAGE SECTION. IC2244.2 +069000 77 DN1 PICTURE S99. IC2244.2 +069100 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2244.2 +069200 77 DN3 PICTURE S99. IC2244.2 +069300 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2244.2 +069400 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2244.2 +069500 SECT-IC224A-1-001 SECTION. IC2244.2 +069600 CALL-TEST-001. IC2244.2 +069700 MOVE DN1 TO WS1. IC2244.2 +069800 ADD 1 TO WS1. IC2244.2 +069900 ADD 1 TO WS2. IC2244.2 +070000 MOVE WS1 TO DN3. IC2244.2 +070100 MOVE WS2 TO DN4. IC2244.2 +070200 CALL-EXIT-001. IC2244.2 +070300 EXIT PROGRAM. IC2244.2 diff --git a/tests/cobol85/IC/IC225A.CBL b/tests/cobol85/IC/IC225A.CBL new file mode 100755 index 00000000..e8e636a2 --- /dev/null +++ b/tests/cobol85/IC/IC225A.CBL @@ -0,0 +1,1054 @@ +000100 IDENTIFICATION DIVISION. IC2254.2 +000200 PROGRAM-ID. IC2254.2 +000300 IC225A. IC2254.2 +000400**************************************************************** IC2254.2 +000500* * IC2254.2 +000600* VALIDATION FOR:- * IC2254.2 +000700* * IC2254.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2254.2 +000900* * IC2254.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2254.2 +001100* * IC2254.2 +001200**************************************************************** IC2254.2 +001300* * IC2254.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2254.2 +001500* * IC2254.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2254.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2254.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2254.2 +001900* * IC2254.2 +002000**************************************************************** IC2254.2 +002100* * IC2254.2 +002200* PROGRAM IC225A AND IC225A-1 WILL TEST THE NEW LANGUAGE * IC2254.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2254.2 +002400* MODULE. * IC2254.2 +002500* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2254.2 +002600* "BY REFERENCE" PHRASE * IC2254.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2254.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2254.2 +002900* IDENTIFICATION DIVISION. * IC2254.2 +003000* PROGRAM-ID. IC225A. * IC2254.2 +003100* . * IC2254.2 +003200* . * IC2254.2 +003300* . * IC2254.2 +003400* END PROGRAM IC225A. * IC2254.2 +003500* PROGRAM-ID. IC225A-1. * IC2254.2 +003600* . * IC2254.2 +003700* . * IC2254.2 +003800* . * IC2254.2 +003900**************************************************************** IC2254.2 +004000 ENVIRONMENT DIVISION. IC2254.2 +004100 CONFIGURATION SECTION. IC2254.2 +004200 SOURCE-COMPUTER. IC2254.2 +004300 Linux. IC2254.2 +004400 OBJECT-COMPUTER. IC2254.2 +004500 Linux. IC2254.2 +004600 INPUT-OUTPUT SECTION. IC2254.2 +004700 FILE-CONTROL. IC2254.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2254.2 +004900 "report.log". IC2254.2 +005000 DATA DIVISION. IC2254.2 +005100 FILE SECTION. IC2254.2 +005200 FD PRINT-FILE. IC2254.2 +005300 01 PRINT-REC PICTURE X(120). IC2254.2 +005400 01 DUMMY-RECORD PICTURE X(120). IC2254.2 +005500 WORKING-STORAGE SECTION. IC2254.2 +005600 77 DN1 PICTURE S99 VALUE ZERO. IC2254.2 +005700 77 DN3 PICTURE S99. IC2254.2 +005800 77 ID1 PICTURE X(8) VALUE "IC225A-1". IC2254.2 +005900 77 ID2 PICTURE X(8). IC2254.2 +006000 77 DN2 PICTURE S99 IC2254.2 +006100 USAGE COMPUTATIONAL, VALUE ZERO. IC2254.2 +006200 77 DN4 PICTURE S99 IC2254.2 +006300 USAGE IS COMPUTATIONAL. IC2254.2 +006400 77 CALL-COUNT PIC S99. IC2254.2 +006500 77 FAIL-FLAG PIC 9. IC2254.2 +006600 01 TEST-RESULTS. IC2254.2 +006700 02 FILLER PIC X VALUE SPACE. IC2254.2 +006800 02 FEATURE PIC X(20) VALUE SPACE. IC2254.2 +006900 02 FILLER PIC X VALUE SPACE. IC2254.2 +007000 02 P-OR-F PIC X(5) VALUE SPACE. IC2254.2 +007100 02 FILLER PIC X VALUE SPACE. IC2254.2 +007200 02 PAR-NAME. IC2254.2 +007300 03 FILLER PIC X(19) VALUE SPACE. IC2254.2 +007400 03 PARDOT-X PIC X VALUE SPACE. IC2254.2 +007500 03 DOTVALUE PIC 99 VALUE ZERO. IC2254.2 +007600 02 FILLER PIC X(8) VALUE SPACE. IC2254.2 +007700 02 RE-MARK PIC X(61). IC2254.2 +007800 01 TEST-COMPUTED. IC2254.2 +007900 02 FILLER PIC X(30) VALUE SPACE. IC2254.2 +008000 02 FILLER PIC X(17) VALUE IC2254.2 +008100 " COMPUTED=". IC2254.2 +008200 02 COMPUTED-X. IC2254.2 +008300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2254.2 +008400 03 COMPUTED-N REDEFINES COMPUTED-A IC2254.2 +008500 PIC -9(9).9(9). IC2254.2 +008600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2254.2 +008700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2254.2 +008800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2254.2 +008900 03 CM-18V0 REDEFINES COMPUTED-A. IC2254.2 +009000 04 COMPUTED-18V0 PIC -9(18). IC2254.2 +009100 04 FILLER PIC X. IC2254.2 +009200 03 FILLER PIC X(50) VALUE SPACE. IC2254.2 +009300 01 TEST-CORRECT. IC2254.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IC2254.2 +009500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2254.2 +009600 02 CORRECT-X. IC2254.2 +009700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2254.2 +009800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2254.2 +009900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2254.2 +010000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2254.2 +010100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2254.2 +010200 03 CR-18V0 REDEFINES CORRECT-A. IC2254.2 +010300 04 CORRECT-18V0 PIC -9(18). IC2254.2 +010400 04 FILLER PIC X. IC2254.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IC2254.2 +010600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2254.2 +010700 01 CCVS-C-1. IC2254.2 +010800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2254.2 +010900- "SS PARAGRAPH-NAME IC2254.2 +011000- " REMARKS". IC2254.2 +011100 02 FILLER PIC X(20) VALUE SPACE. IC2254.2 +011200 01 CCVS-C-2. IC2254.2 +011300 02 FILLER PIC X VALUE SPACE. IC2254.2 +011400 02 FILLER PIC X(6) VALUE "TESTED". IC2254.2 +011500 02 FILLER PIC X(15) VALUE SPACE. IC2254.2 +011600 02 FILLER PIC X(4) VALUE "FAIL". IC2254.2 +011700 02 FILLER PIC X(94) VALUE SPACE. IC2254.2 +011800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2254.2 +011900 01 REC-CT PIC 99 VALUE ZERO. IC2254.2 +012000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2254.2 +012100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2254.2 +012200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2254.2 +012300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2254.2 +012400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2254.2 +012500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2254.2 +012600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2254.2 +012700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2254.2 +012800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2254.2 +012900 01 CCVS-H-1. IC2254.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC2254.2 +013100 02 FILLER PIC X(42) VALUE IC2254.2 +013200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2254.2 +013300 02 FILLER PIC X(39) VALUE SPACES. IC2254.2 +013400 01 CCVS-H-2A. IC2254.2 +013500 02 FILLER PIC X(40) VALUE SPACE. IC2254.2 +013600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2254.2 +013700 02 FILLER PIC XXXX VALUE IC2254.2 +013800 "4.2 ". IC2254.2 +013900 02 FILLER PIC X(28) VALUE IC2254.2 +014000 " COPY - NOT FOR DISTRIBUTION". IC2254.2 +014100 02 FILLER PIC X(41) VALUE SPACE. IC2254.2 +014200 IC2254.2 +014300 01 CCVS-H-2B. IC2254.2 +014400 02 FILLER PIC X(15) VALUE IC2254.2 +014500 "TEST RESULT OF ". IC2254.2 +014600 02 TEST-ID PIC X(9). IC2254.2 +014700 02 FILLER PIC X(4) VALUE IC2254.2 +014800 " IN ". IC2254.2 +014900 02 FILLER PIC X(12) VALUE IC2254.2 +015000 " HIGH ". IC2254.2 +015100 02 FILLER PIC X(22) VALUE IC2254.2 +015200 " LEVEL VALIDATION FOR ". IC2254.2 +015300 02 FILLER PIC X(58) VALUE IC2254.2 +015400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2254.2 +015500 01 CCVS-H-3. IC2254.2 +015600 02 FILLER PIC X(34) VALUE IC2254.2 +015700 " FOR OFFICIAL USE ONLY ". IC2254.2 +015800 02 FILLER PIC X(58) VALUE IC2254.2 +015900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2254.2 +016000 02 FILLER PIC X(28) VALUE IC2254.2 +016100 " COPYRIGHT 1985 ". IC2254.2 +016200 01 CCVS-E-1. IC2254.2 +016300 02 FILLER PIC X(52) VALUE SPACE. IC2254.2 +016400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2254.2 +016500 02 ID-AGAIN PIC X(9). IC2254.2 +016600 02 FILLER PIC X(45) VALUE SPACES. IC2254.2 +016700 01 CCVS-E-2. IC2254.2 +016800 02 FILLER PIC X(31) VALUE SPACE. IC2254.2 +016900 02 FILLER PIC X(21) VALUE SPACE. IC2254.2 +017000 02 CCVS-E-2-2. IC2254.2 +017100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2254.2 +017200 03 FILLER PIC X VALUE SPACE. IC2254.2 +017300 03 ENDER-DESC PIC X(44) VALUE IC2254.2 +017400 "ERRORS ENCOUNTERED". IC2254.2 +017500 01 CCVS-E-3. IC2254.2 +017600 02 FILLER PIC X(22) VALUE IC2254.2 +017700 " FOR OFFICIAL USE ONLY". IC2254.2 +017800 02 FILLER PIC X(12) VALUE SPACE. IC2254.2 +017900 02 FILLER PIC X(58) VALUE IC2254.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2254.2 +018100 02 FILLER PIC X(13) VALUE SPACE. IC2254.2 +018200 02 FILLER PIC X(15) VALUE IC2254.2 +018300 " COPYRIGHT 1985". IC2254.2 +018400 01 CCVS-E-4. IC2254.2 +018500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2254.2 +018600 02 FILLER PIC X(4) VALUE " OF ". IC2254.2 +018700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2254.2 +018800 02 FILLER PIC X(40) VALUE IC2254.2 +018900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2254.2 +019000 01 XXINFO. IC2254.2 +019100 02 FILLER PIC X(19) VALUE IC2254.2 +019200 "*** INFORMATION ***". IC2254.2 +019300 02 INFO-TEXT. IC2254.2 +019400 04 FILLER PIC X(8) VALUE SPACE. IC2254.2 +019500 04 XXCOMPUTED PIC X(20). IC2254.2 +019600 04 FILLER PIC X(5) VALUE SPACE. IC2254.2 +019700 04 XXCORRECT PIC X(20). IC2254.2 +019800 02 INF-ANSI-REFERENCE PIC X(48). IC2254.2 +019900 01 HYPHEN-LINE. IC2254.2 +020000 02 FILLER PIC IS X VALUE IS SPACE. IC2254.2 +020100 02 FILLER PIC IS X(65) VALUE IS "************************IC2254.2 +020200- "*****************************************". IC2254.2 +020300 02 FILLER PIC IS X(54) VALUE IS "************************IC2254.2 +020400- "******************************". IC2254.2 +020500 01 CCVS-PGM-ID PIC X(9) VALUE IC2254.2 +020600 "IC225A". IC2254.2 +020700 PROCEDURE DIVISION. IC2254.2 +020800 CCVS1 SECTION. IC2254.2 +020900 OPEN-FILES. IC2254.2 +021000 OPEN OUTPUT PRINT-FILE. IC2254.2 +021100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2254.2 +021200 MOVE SPACE TO TEST-RESULTS. IC2254.2 +021300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2254.2 +021400 GO TO CCVS1-EXIT. IC2254.2 +021500 CLOSE-FILES. IC2254.2 +021600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2254.2 +021700 TERMINATE-CCVS. IC2254.2 +021800*S EXIT PROGRAM. IC2254.2 +021900*SERMINATE-CALL. IC2254.2 +022000 STOP RUN. IC2254.2 +022100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2254.2 +022200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2254.2 +022300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2254.2 +022400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2254.2 +022500 MOVE "****TEST DELETED****" TO RE-MARK. IC2254.2 +022600 PRINT-DETAIL. IC2254.2 +022700 IF REC-CT NOT EQUAL TO ZERO IC2254.2 +022800 MOVE "." TO PARDOT-X IC2254.2 +022900 MOVE REC-CT TO DOTVALUE. IC2254.2 +023000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2254.2 +023100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2254.2 +023200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2254.2 +023300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2254.2 +023400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2254.2 +023500 MOVE SPACE TO CORRECT-X. IC2254.2 +023600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2254.2 +023700 MOVE SPACE TO RE-MARK. IC2254.2 +023800 HEAD-ROUTINE. IC2254.2 +023900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +024000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +024100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2254.2 +024200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2254.2 +024300 COLUMN-NAMES-ROUTINE. IC2254.2 +024400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +024500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +024700 END-ROUTINE. IC2254.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2254.2 +024900 END-RTN-EXIT. IC2254.2 +025000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +025100 END-ROUTINE-1. IC2254.2 +025200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2254.2 +025300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2254.2 +025400 ADD PASS-COUNTER TO ERROR-HOLD. IC2254.2 +025500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2254.2 +025600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2254.2 +025700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2254.2 +025800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2254.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2254.2 +026000 END-ROUTINE-12. IC2254.2 +026100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2254.2 +026200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2254.2 +026300 MOVE "NO " TO ERROR-TOTAL IC2254.2 +026400 ELSE IC2254.2 +026500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2254.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2254.2 +026700 PERFORM WRITE-LINE. IC2254.2 +026800 END-ROUTINE-13. IC2254.2 +026900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2254.2 +027000 MOVE "NO " TO ERROR-TOTAL ELSE IC2254.2 +027100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2254.2 +027200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2254.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +027400 IF INSPECT-COUNTER EQUAL TO ZERO IC2254.2 +027500 MOVE "NO " TO ERROR-TOTAL IC2254.2 +027600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2254.2 +027700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2254.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +027900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2254.2 +028000 WRITE-LINE. IC2254.2 +028100 ADD 1 TO RECORD-COUNT. IC2254.2 +028200 IF RECORD-COUNT GREATER 50 IC2254.2 +028300 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2254.2 +028400 MOVE SPACE TO DUMMY-RECORD IC2254.2 +028500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2254.2 +028600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2254.2 +028700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2254.2 +028800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2254.2 +028900 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2254.2 +029000 MOVE ZERO TO RECORD-COUNT. IC2254.2 +029100 PERFORM WRT-LN. IC2254.2 +029200 WRT-LN. IC2254.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2254.2 +029400 MOVE SPACE TO DUMMY-RECORD. IC2254.2 +029500 BLANK-LINE-PRINT. IC2254.2 +029600 PERFORM WRT-LN. IC2254.2 +029700 FAIL-ROUTINE. IC2254.2 +029800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2254.2 +029900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2254.2 +030000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2254.2 +030100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2254.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2254.2 +030400 GO TO FAIL-ROUTINE-EX. IC2254.2 +030500 FAIL-ROUTINE-WRITE. IC2254.2 +030600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2254.2 +030700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2254.2 +030800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2254.2 +030900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2254.2 +031000 FAIL-ROUTINE-EX. EXIT. IC2254.2 +031100 BAIL-OUT. IC2254.2 +031200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2254.2 +031300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2254.2 +031400 BAIL-OUT-WRITE. IC2254.2 +031500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2254.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2254.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2254.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2254.2 +031900 BAIL-OUT-EX. EXIT. IC2254.2 +032000 CCVS1-EXIT. IC2254.2 +032100 EXIT. IC2254.2 +032200 SECT-IC225A-001 SECTION. IC2254.2 +032300 CALL-TEST-01. IC2254.2 +032400 MOVE "X-27 5.2.2" TO ANSI-REFERENCE. IC2254.2 +032500 MOVE "CALL-TEST-01" TO PAR-NAME. IC2254.2 +032600 MOVE "LEV 2 CALL STATEMENT" TO FEATURE. IC2254.2 +032700 MOVE 0 TO CALL-COUNT. IC2254.2 +032800* THIS TEST HAS CALL STATEMENTS WITH AN IDENTIFIER IC2254.2 +032900* CONTAINING THE NAME OF THE SUBPROGRAM TO BE CALLED. IC2254.2 +033000* CALL-TEST-01 CONTAINS THE BASIC LEVEL 2 CALL STATEMENT. IC2254.2 +033100* IF IT CANNOT BE COMPILED AND EXECUTED CORRECTLY, THERE IS IC2254.2 +033200* NO USE IN RUNNING THE LEVEL 2 IPC ROUTINES. IC2254.2 +033300 CALL-INIT-01-01. IC2254.2 +033400 MOVE 1 TO REC-CT. IC2254.2 +033500 MOVE ZERO TO DN3, DN4. IC2254.2 +033600 CALL-TEST-01-01-0. IC2254.2 +033700 CALL "IC225A-1" USING BY REFERENCE DN1, DN2, IC2254.2 +033800 CONTENT DN3, DN4 IC2254.2 +033900 END-CALL. IC2254.2 +034000 GO TO CALL-TEST-01-01-1. IC2254.2 +034100 CALL-DELETE-01-01. IC2254.2 +034200 PERFORM DE-LETE. IC2254.2 +034300 PERFORM PRINT-DETAIL. IC2254.2 +034400 GO TO CALL-INIT-01-02. IC2254.2 +034500 CALL-TEST-01-01-1. IC2254.2 +034600 MOVE "CALL-TEST-01-01-1" TO PAR-NAME. IC2254.2 +034700 IF DN1 = ZERO IC2254.2 +034800 PERFORM PASS IC2254.2 +034900 PERFORM PRINT-DETAIL IC2254.2 +035000 ELSE IC2254.2 +035100 MOVE DN1 TO COMPUTED-N IC2254.2 +035200 MOVE ZERO TO CORRECT-N IC2254.2 +035300 MOVE "INCORRECT DN1 VALUE RETURNED" TO RE-MARK IC2254.2 +035400 PERFORM FAIL IC2254.2 +035500 PERFORM PRINT-DETAIL. IC2254.2 +035600 ADD 1 TO REC-CT. IC2254.2 +035700 CALL-TEST-01-01-2. IC2254.2 +035800 MOVE "CALL-TEST-01-01-2" TO PAR-NAME. IC2254.2 +035900 IF DN2 = ZERO IC2254.2 +036000 PERFORM PASS IC2254.2 +036100 PERFORM PRINT-DETAIL IC2254.2 +036200 ELSE IC2254.2 +036300 MOVE DN2 TO COMPUTED-N IC2254.2 +036400 MOVE ZERO TO CORRECT-N IC2254.2 +036500 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +036600 PERFORM FAIL IC2254.2 +036700 PERFORM PRINT-DETAIL. IC2254.2 +036800 ADD 1 TO REC-CT. IC2254.2 +036900 CALL-TEST-01-01-3. IC2254.2 +037000 MOVE "CALL-TEST-01-01-3" TO PAR-NAME. IC2254.2 +037100 IF DN3 = ZERO IC2254.2 +037200 PERFORM PASS IC2254.2 +037300 PERFORM PRINT-DETAIL IC2254.2 +037400 ELSE IC2254.2 +037500 MOVE DN3 TO COMPUTED-N IC2254.2 +037600 MOVE ZERO TO CORRECT-N IC2254.2 +037700 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +037800 PERFORM FAIL IC2254.2 +037900 PERFORM PRINT-DETAIL. IC2254.2 +038000 ADD 1 TO REC-CT. IC2254.2 +038100 CALL-TEST-01-01-4. IC2254.2 +038200 MOVE "CALL-TEST-01-01-4" TO PAR-NAME. IC2254.2 +038300 IF DN4 = ZERO IC2254.2 +038400 PERFORM PASS IC2254.2 +038500 PERFORM PRINT-DETAIL IC2254.2 +038600 ELSE IC2254.2 +038700 MOVE DN4 TO COMPUTED-N IC2254.2 +038800 MOVE ZERO TO CORRECT-N IC2254.2 +038900 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +039000 PERFORM FAIL IC2254.2 +039100 PERFORM PRINT-DETAIL. IC2254.2 +039200* IC2254.2 +039300 CALL-INIT-01-02. IC2254.2 +039400 MOVE 1 TO REC-CT. IC2254.2 +039500 MOVE 2 TO DN1, DN2, DN3 IC2254.2 +039600 MOVE 42 TO DN4. IC2254.2 +039700 CALL-TEST-01-02-0. IC2254.2 +039800 CALL "IC225A-1" USING BY CONTENT DN1 DN2 IC2254.2 +039900 REFERENCE DN3 IC2254.2 +040000 CONTENT DN4 IC2254.2 +040100 END-CALL. IC2254.2 +040200 GO TO CALL-TEST-01-02-1. IC2254.2 +040300 CALL-DELETE-01-02. IC2254.2 +040400 PERFORM DE-LETE. IC2254.2 +040500 PERFORM PRINT-DETAIL. IC2254.2 +040600 GO TO CALL-INIT-01-03. IC2254.2 +040700 CALL-TEST-01-02-1. IC2254.2 +040800 MOVE "CALL-TEST-01-02-1" TO PAR-NAME. IC2254.2 +040900 IF DN1 = 2 IC2254.2 +041000 PERFORM PASS IC2254.2 +041100 PERFORM PRINT-DETAIL IC2254.2 +041200 ELSE IC2254.2 +041300 MOVE DN1 TO COMPUTED-N IC2254.2 +041400 MOVE 2 TO CORRECT-N IC2254.2 +041500 MOVE "INCORRECT DN1 VALUE RETURNED" TO RE-MARK IC2254.2 +041600 PERFORM FAIL IC2254.2 +041700 PERFORM PRINT-DETAIL. IC2254.2 +041800 ADD 1 TO REC-CT. IC2254.2 +041900 CALL-TEST-01-02-2. IC2254.2 +042000 MOVE "CALL-TEST-01-02-2" TO PAR-NAME. IC2254.2 +042100 IF DN2 = 2 IC2254.2 +042200 PERFORM PASS IC2254.2 +042300 PERFORM PRINT-DETAIL IC2254.2 +042400 ELSE IC2254.2 +042500 MOVE DN2 TO COMPUTED-N IC2254.2 +042600 MOVE 2 TO CORRECT-N IC2254.2 +042700 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +042800 PERFORM FAIL IC2254.2 +042900 PERFORM PRINT-DETAIL. IC2254.2 +043000 ADD 1 TO REC-CT. IC2254.2 +043100 CALL-TEST-01-02-3. IC2254.2 +043200 MOVE "CALL-TEST-01-02-3" TO PAR-NAME. IC2254.2 +043300 IF DN3 = 3 IC2254.2 +043400 PERFORM PASS IC2254.2 +043500 PERFORM PRINT-DETAIL IC2254.2 +043600 ELSE IC2254.2 +043700 MOVE DN3 TO COMPUTED-N IC2254.2 +043800 MOVE 3 TO CORRECT-N IC2254.2 +043900 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +044000 PERFORM FAIL IC2254.2 +044100 PERFORM PRINT-DETAIL. IC2254.2 +044200 ADD 1 TO REC-CT. IC2254.2 +044300 CALL-TEST-01-02-4. IC2254.2 +044400 MOVE "CALL-TEST-01-02-4" TO PAR-NAME. IC2254.2 +044500 IF DN4 = 42 IC2254.2 +044600 PERFORM PASS IC2254.2 +044700 PERFORM PRINT-DETAIL IC2254.2 +044800 ELSE IC2254.2 +044900 MOVE DN4 TO COMPUTED-N IC2254.2 +045000 MOVE 42 TO CORRECT-N IC2254.2 +045100 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +045200 PERFORM FAIL IC2254.2 +045300 PERFORM PRINT-DETAIL. IC2254.2 +045400* IC2254.2 +045500 CALL-INIT-01-03. IC2254.2 +045600 MOVE 1 TO REC-CT. IC2254.2 +045700 MOVE 3 TO DN1, DN2, DN3 IC2254.2 +045800 MOVE 71 TO DN4. IC2254.2 +045900 CALL-TEST-01-03-0. IC2254.2 +046000 CALL "IC225A-1" USING BY CONTENT DN1 IC2254.2 +046100 REFERENCE DN2 IC2254.2 +046200 CONTENT DN3 IC2254.2 +046300 REFERENCE DN4 IC2254.2 +046400 END-CALL. IC2254.2 +046500 GO TO CALL-TEST-01-03-1. IC2254.2 +046600 CALL-DELETE-01-03. IC2254.2 +046700 PERFORM DE-LETE. IC2254.2 +046800 PERFORM PRINT-DETAIL. IC2254.2 +046900 GO TO CALL-TEST-02. IC2254.2 +047000 CALL-TEST-01-03-1. IC2254.2 +047100 MOVE "CALL-TEST-01-03-1" TO PAR-NAME. IC2254.2 +047200 IF DN1 = 3 IC2254.2 +047300 PERFORM PASS IC2254.2 +047400 PERFORM PRINT-DETAIL IC2254.2 +047500 ELSE IC2254.2 +047600 MOVE DN1 TO COMPUTED-N IC2254.2 +047700 MOVE 3 TO CORRECT-N IC2254.2 +047800 MOVE "VALUE OF DN1 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +047900 PERFORM FAIL IC2254.2 +048000 PERFORM PRINT-DETAIL. IC2254.2 +048100 ADD 1 TO REC-CT. IC2254.2 +048200 CALL-TEST-01-03-2. IC2254.2 +048300 MOVE "CALL-TEST-01-03-2" TO PAR-NAME. IC2254.2 +048400 IF DN2 = 3 IC2254.2 +048500 PERFORM PASS IC2254.2 +048600 PERFORM PRINT-DETAIL IC2254.2 +048700 ELSE IC2254.2 +048800 MOVE DN2 TO COMPUTED-N IC2254.2 +048900 MOVE 3 TO CORRECT-N IC2254.2 +049000 MOVE "INCORRECT DN2 VALUE RETURNED" TO RE-MARK IC2254.2 +049100 PERFORM FAIL IC2254.2 +049200 PERFORM PRINT-DETAIL. IC2254.2 +049300 ADD 1 TO REC-CT. IC2254.2 +049400 CALL-TEST-01-03-3. IC2254.2 +049500 MOVE "CALL-TEST-01-03-3" TO PAR-NAME. IC2254.2 +049600 IF DN3 = 3 IC2254.2 +049700 PERFORM PASS IC2254.2 +049800 PERFORM PRINT-DETAIL IC2254.2 +049900 ELSE IC2254.2 +050000 MOVE DN3 TO COMPUTED-N IC2254.2 +050100 MOVE 3 TO CORRECT-N IC2254.2 +050200 MOVE "VALUE OF DN3 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +050300 PERFORM FAIL IC2254.2 +050400 PERFORM PRINT-DETAIL. IC2254.2 +050500 ADD 1 TO REC-CT. IC2254.2 +050600 CALL-TEST-01-03-4. IC2254.2 +050700 MOVE "CALL-TEST-01-03-4" TO PAR-NAME. IC2254.2 +050800 IF DN4 = 3 IC2254.2 +050900 PERFORM PASS IC2254.2 +051000 PERFORM PRINT-DETAIL IC2254.2 +051100 ELSE IC2254.2 +051200 MOVE DN4 TO COMPUTED-N IC2254.2 +051300 MOVE 3 TO CORRECT-N IC2254.2 +051400 MOVE "INCORRECT DN4 VALUE RETURNED" TO RE-MARK IC2254.2 +051500 PERFORM FAIL IC2254.2 +051600 PERFORM PRINT-DETAIL. IC2254.2 +051700* IC2254.2 +051800 CALL-TEST-02. IC2254.2 +051900 MOVE "DATA-NAME USED TWICE" TO FEATURE. IC2254.2 +052000* THIS TEST USES A DATA-NAME MORE THAN ONCE IN IC2254.2 +052100* A USING PHRASE OF A CALL STATEMENT. IC2254.2 +052200 CALL-INIT-02-01. IC2254.2 +052300 MOVE 1 TO REC-CT. IC2254.2 +052400 MOVE 1 TO DN1. IC2254.2 +052500 MOVE 0 TO DN2, DN3, DN4. IC2254.2 +052600 CALL-TEST-02-01-0. IC2254.2 +052700 CALL "IC225A-1" USING REFERENCE DN1, IC2254.2 +052800 CONTENT DN2, IC2254.2 +052900 REFERENCE DN1, DN4, IC2254.2 +053000 END-CALL. IC2254.2 +053100 GO TO CALL-TEST-02-01-1. IC2254.2 +053200 CALL-DELETE-02-01. IC2254.2 +053300 PERFORM DE-LETE. IC2254.2 +053400 PERFORM PRINT-DETAIL. IC2254.2 +053500 GO TO CALL-INIT-02-02. IC2254.2 +053600 CALL-TEST-02-01-1. IC2254.2 +053700 MOVE "CALL-TEST-02-01-1" TO PAR-NAME. IC2254.2 +053800 IF DN1 = 2 IC2254.2 +053900 PERFORM PASS IC2254.2 +054000 PERFORM PRINT-DETAIL IC2254.2 +054100 ELSE IC2254.2 +054200 MOVE DN1 TO COMPUTED-N IC2254.2 +054300 MOVE 2 TO CORRECT-N IC2254.2 +054400 MOVE "INCORRECT DN1 VALUE RETURNED" TO RE-MARK IC2254.2 +054500 PERFORM FAIL IC2254.2 +054600 PERFORM PRINT-DETAIL. IC2254.2 +054700 ADD 1 TO REC-CT. IC2254.2 +054800 CALL-TEST-02-01-2. IC2254.2 +054900 MOVE "CALL-TEST-02-01-2" TO PAR-NAME. IC2254.2 +055000 IF DN2 = 0 IC2254.2 +055100 PERFORM PASS IC2254.2 +055200 PERFORM PRINT-DETAIL IC2254.2 +055300 ELSE IC2254.2 +055400 MOVE DN2 TO COMPUTED-N IC2254.2 +055500 MOVE ZERO TO CORRECT-N IC2254.2 +055600 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +055700 PERFORM FAIL IC2254.2 +055800 PERFORM PRINT-DETAIL. IC2254.2 +055900 ADD 1 TO REC-CT. IC2254.2 +056000 CALL-TEST-02-01-3. IC2254.2 +056100 MOVE "CALL-TEST-02-01-3" TO PAR-NAME. IC2254.2 +056200 IF DN3 = 0 IC2254.2 +056300 PERFORM PASS IC2254.2 +056400 PERFORM PRINT-DETAIL IC2254.2 +056500 ELSE IC2254.2 +056600 MOVE DN3 TO COMPUTED-N IC2254.2 +056700 MOVE ZERO TO CORRECT-N IC2254.2 +056800 MOVE "VALUE OF DN3 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +056900 PERFORM FAIL IC2254.2 +057000 PERFORM PRINT-DETAIL. IC2254.2 +057100 ADD 1 TO REC-CT. IC2254.2 +057200 CALL-TEST-02-01-4. IC2254.2 +057300 MOVE "CALL-TEST-02-01-4" TO PAR-NAME. IC2254.2 +057400 IF DN4 = 4 IC2254.2 +057500 PERFORM PASS IC2254.2 +057600 PERFORM PRINT-DETAIL IC2254.2 +057700 ELSE IC2254.2 +057800 MOVE DN4 TO COMPUTED-N IC2254.2 +057900 MOVE 4 TO CORRECT-N IC2254.2 +058000 MOVE "INCORRECT DN4 VALUE RETURNED" TO RE-MARK IC2254.2 +058100 PERFORM FAIL IC2254.2 +058200 PERFORM PRINT-DETAIL. IC2254.2 +058300* IC2254.2 +058400 CALL-INIT-02-02. IC2254.2 +058500 MOVE 1 TO REC-CT. IC2254.2 +058600 MOVE 0 TO DN4, DN3, DN2, DN1. IC2254.2 +058700 CALL-TEST-02-02-0. IC2254.2 +058800 CALL ID1 USING BY REFERENCE DN1 IC2254.2 +058900 CONTENT DN2 DN3 DN2 IC2254.2 +059000 END-CALL. IC2254.2 +059100 GO TO CALL-TEST-02-02-1. IC2254.2 +059200 CALL-DELETE-02-02. IC2254.2 +059300 PERFORM DE-LETE. IC2254.2 +059400 PERFORM PRINT-DETAIL. IC2254.2 +059500 GO TO CALL-INIT-02-03. IC2254.2 +059600 CALL-TEST-02-02-1. IC2254.2 +059700 MOVE "CALL-TEST-02-02-1" TO PAR-NAME. IC2254.2 +059800 IF DN1 = 0 IC2254.2 +059900 PERFORM PASS IC2254.2 +060000 PERFORM PRINT-DETAIL IC2254.2 +060100 ELSE IC2254.2 +060200 MOVE DN1 TO COMPUTED-N IC2254.2 +060300 MOVE ZERO TO CORRECT-N IC2254.2 +060400 MOVE "INCORRECT DN1 VALUE RETURNED" TO RE-MARK IC2254.2 +060500 PERFORM FAIL IC2254.2 +060600 PERFORM PRINT-DETAIL. IC2254.2 +060700 ADD 1 TO REC-CT. IC2254.2 +060800 CALL-TEST-02-02-2. IC2254.2 +060900 MOVE "CALL-TEST-02-02-2" TO PAR-NAME. IC2254.2 +061000 IF DN2 = 0 IC2254.2 +061100 PERFORM PASS IC2254.2 +061200 PERFORM PRINT-DETAIL IC2254.2 +061300 ELSE IC2254.2 +061400 MOVE DN2 TO COMPUTED-N IC2254.2 +061500 MOVE ZERO TO CORRECT-N IC2254.2 +061600 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +061700 PERFORM FAIL IC2254.2 +061800 PERFORM PRINT-DETAIL. IC2254.2 +061900 ADD 1 TO REC-CT. IC2254.2 +062000 CALL-TEST-02-02-3. IC2254.2 +062100 MOVE "CALL-TEST-02-02-3" TO PAR-NAME. IC2254.2 +062200 IF DN3 = 0 IC2254.2 +062300 PERFORM PASS IC2254.2 +062400 PERFORM PRINT-DETAIL IC2254.2 +062500 ELSE IC2254.2 +062600 MOVE DN3 TO COMPUTED-N IC2254.2 +062700 MOVE ZERO TO CORRECT-N IC2254.2 +062800 MOVE "VALUE OF DN3 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +062900 PERFORM FAIL IC2254.2 +063000 PERFORM PRINT-DETAIL. IC2254.2 +063100 ADD 1 TO REC-CT. IC2254.2 +063200 CALL-TEST-02-02-4. IC2254.2 +063300 MOVE "CALL-TEST-02-02-4" TO PAR-NAME. IC2254.2 +063400 IF DN4 = ZERO IC2254.2 +063500 PERFORM PASS IC2254.2 +063600 PERFORM PRINT-DETAIL IC2254.2 +063700 ELSE IC2254.2 +063800 MOVE DN4 TO COMPUTED-N IC2254.2 +063900 MOVE ZERO TO CORRECT-N IC2254.2 +064000 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +064100 PERFORM FAIL IC2254.2 +064200 PERFORM PRINT-DETAIL. IC2254.2 +064300* IC2254.2 +064400 CALL-INIT-02-03. IC2254.2 +064500 MOVE 1 TO REC-CT. IC2254.2 +064600 MOVE 0 TO DN4, DN3. IC2254.2 +064700 MOVE 10 TO DN2. IC2254.2 +064800 MOVE 25 TO DN1. IC2254.2 +064900 CALL-TEST-02-03-0. IC2254.2 +065000 CALL ID1 USING CONTENT DN1 IC2254.2 +065100 REFERENCE DN2 DN1 IC2254.2 +065200 REFERENCE DN2 IC2254.2 +065300 END-CALL. IC2254.2 +065400 GO TO CALL-TEST-02-03-1. IC2254.2 +065500 CALL-DELETE-02-03. IC2254.2 +065600 PERFORM DE-LETE. IC2254.2 +065700 PERFORM PRINT-DETAIL. IC2254.2 +065800 GO TO CALL-INIT-03-01. IC2254.2 +065900 CALL-TEST-02-03-1. IC2254.2 +066000 MOVE "CALL-TEST-02-03-1" TO PAR-NAME. IC2254.2 +066100 IF DN1 = 26 IC2254.2 +066200 PERFORM PASS IC2254.2 +066300 PERFORM PRINT-DETAIL IC2254.2 +066400 ELSE IC2254.2 +066500 MOVE DN1 TO COMPUTED-N IC2254.2 +066600 MOVE 26 TO CORRECT-N IC2254.2 +066700 MOVE "INCORRECT VALUE RETURNED " TO RE-MARK IC2254.2 +066800 PERFORM FAIL IC2254.2 +066900 PERFORM PRINT-DETAIL. IC2254.2 +067000 ADD 1 TO REC-CT. IC2254.2 +067100 CALL-TEST-02-03-2. IC2254.2 +067200 MOVE "CALL-TEST-02-03-2" TO PAR-NAME. IC2254.2 +067300 IF DN2 = 6 IC2254.2 +067400 PERFORM PASS IC2254.2 +067500 PERFORM PRINT-DETAIL IC2254.2 +067600 ELSE IC2254.2 +067700 MOVE DN2 TO COMPUTED-N IC2254.2 +067800 MOVE 6 TO CORRECT-N IC2254.2 +067900 MOVE "INCORRECT DN2 VALUE RETURNED" TO RE-MARK IC2254.2 +068000 PERFORM FAIL IC2254.2 +068100 PERFORM PRINT-DETAIL. IC2254.2 +068200 ADD 1 TO REC-CT. IC2254.2 +068300 CALL-TEST-02-03-3. IC2254.2 +068400 MOVE "CALL-TEST-02-03-3" TO PAR-NAME. IC2254.2 +068500 IF DN3 = 0 IC2254.2 +068600 PERFORM PASS IC2254.2 +068700 PERFORM PRINT-DETAIL IC2254.2 +068800 ELSE IC2254.2 +068900 MOVE DN3 TO COMPUTED-N IC2254.2 +069000 MOVE ZERO TO CORRECT-N IC2254.2 +069100 MOVE "VALUE OF DN3 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +069200 PERFORM FAIL IC2254.2 +069300 PERFORM PRINT-DETAIL. IC2254.2 +069400 ADD 1 TO REC-CT. IC2254.2 +069500 CALL-TEST-02-03-4. IC2254.2 +069600 MOVE "CALL-TEST-02-03-4" TO PAR-NAME. IC2254.2 +069700 IF DN4 = ZERO IC2254.2 +069800 PERFORM PASS IC2254.2 +069900 PERFORM PRINT-DETAIL IC2254.2 +070000 ELSE IC2254.2 +070100 MOVE DN4 TO COMPUTED-N IC2254.2 +070200 MOVE ZERO TO CORRECT-N IC2254.2 +070300 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +070400 PERFORM FAIL IC2254.2 +070500 PERFORM PRINT-DETAIL. IC2254.2 +070600* IC2254.2 +070700 CALL-TEST-03. IC2254.2 +070800* THIS TEST USES THE ON OVERFLOW PHRASE IN THE CALL IC2254.2 +070900* STATEMENT. THIS IS A SYNTACTICAL CHECK ONLY, THE IC2254.2 +071000* ON OVERFLOW CONDITION SHOULD NEVER OCCUR. IC2254.2 +071100 MOVE "CALL-TEST-03" TO PAR-NAME. IC2254.2 +071200 MOVE "ON OVERFLOW PHRASE" TO FEATURE. IC2254.2 +071300 CALL-INIT-03-01. IC2254.2 +071400 MOVE 1 TO REC-CT. IC2254.2 +071500 MOVE 6 TO CALL-COUNT. IC2254.2 +071600 MOVE 20 TO DN1. IC2254.2 +071700 MOVE 30 TO DN2. IC2254.2 +071800 MOVE ZERO TO DN3, DN4. IC2254.2 +071900 CALL-TEST-03-01-0. IC2254.2 +072000 MOVE "CALL-TEST-03-01-0" TO PAR-NAME. IC2254.2 +072100 CALL "IC225A-1" USING BY CONTENT DN1, DN2, IC2254.2 +072200 REFERENCE DN3, DN4; IC2254.2 +072300 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2254.2 +072400 PERFORM FAIL IC2254.2 +072500 PERFORM PRINT-DETAIL. IC2254.2 +072600 GO TO CALL-TEST-03-01-1. IC2254.2 +072700 CALL-DELETE-03-01. IC2254.2 +072800 PERFORM DE-LETE. IC2254.2 +072900 PERFORM PRINT-DETAIL. IC2254.2 +073000 GO TO CALL-INIT-03-02. IC2254.2 +073100 CALL-TEST-03-01-1. IC2254.2 +073200 MOVE "CALL-TEST-03-01-1" TO PAR-NAME. IC2254.2 +073300 IF DN1 = 20 IC2254.2 +073400 PERFORM PASS IC2254.2 +073500 PERFORM PRINT-DETAIL IC2254.2 +073600 ELSE IC2254.2 +073700 MOVE DN1 TO COMPUTED-N IC2254.2 +073800 MOVE 20 TO CORRECT-N IC2254.2 +073900 MOVE "VALUE OF DN1 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +074000 PERFORM FAIL IC2254.2 +074100 PERFORM PRINT-DETAIL. IC2254.2 +074200 ADD 1 TO REC-CT. IC2254.2 +074300 CALL-TEST-03-01-2. IC2254.2 +074400 MOVE "CALL-TEST-03-01-2" TO PAR-NAME. IC2254.2 +074500 IF DN2 = 30 IC2254.2 +074600 PERFORM PASS IC2254.2 +074700 PERFORM PRINT-DETAIL IC2254.2 +074800 ELSE IC2254.2 +074900 MOVE DN2 TO COMPUTED-N IC2254.2 +075000 MOVE 30 TO CORRECT-N IC2254.2 +075100 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +075200 PERFORM FAIL IC2254.2 +075300 PERFORM PRINT-DETAIL. IC2254.2 +075400 ADD 1 TO REC-CT. IC2254.2 +075500 CALL-TEST-03-01-3. IC2254.2 +075600 MOVE "CALL-TEST-03-01-3" TO PAR-NAME. IC2254.2 +075700 IF DN3 = 21 IC2254.2 +075800 PERFORM PASS IC2254.2 +075900 PERFORM PRINT-DETAIL IC2254.2 +076000 ELSE IC2254.2 +076100 MOVE DN3 TO COMPUTED-N IC2254.2 +076200 MOVE 21 TO CORRECT-N IC2254.2 +076300 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +076400 PERFORM FAIL IC2254.2 +076500 PERFORM PRINT-DETAIL. IC2254.2 +076600 ADD 1 TO REC-CT. IC2254.2 +076700 CALL-TEST-03-01-4. IC2254.2 +076800 MOVE "CALL-TEST-03-01-4" TO PAR-NAME. IC2254.2 +076900 IF DN4 = 7 IC2254.2 +077000 PERFORM PASS IC2254.2 +077100 PERFORM PRINT-DETAIL IC2254.2 +077200 ELSE IC2254.2 +077300 MOVE DN4 TO COMPUTED-N IC2254.2 +077400 MOVE 7 TO CORRECT-N IC2254.2 +077500 MOVE "INCORRECT DN4 VALUE RETURNED" TO RE-MARK IC2254.2 +077600 PERFORM FAIL IC2254.2 +077700 PERFORM PRINT-DETAIL. IC2254.2 +077800* IC2254.2 +077900 CALL-INIT-03-02. IC2254.2 +078000 MOVE "CALL-TEST-03-02-0" TO PAR-NAME. IC2254.2 +078100 MOVE 0 TO DN3, DN4. IC2254.2 +078200 MOVE 1 TO REC-CT. IC2254.2 +078300 CALL-TEST-03-02-0. IC2254.2 +078400 CALL "IC225A-1" USING REFERENCE DN1, IC2254.2 +078500 CONTENT DN2, IC2254.2 +078600 REFERENCE DN3, IC2254.2 +078700 CONTENT DN4, IC2254.2 +078800 OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2254.2 +078900 PERFORM FAIL IC2254.2 +079000 PERFORM PRINT-DETAIL. IC2254.2 +079100 GO TO CALL-TEST-03-02-1. IC2254.2 +079200 CALL-DELETE-03-02. IC2254.2 +079300 PERFORM DE-LETE. IC2254.2 +079400 PERFORM PRINT-DETAIL. IC2254.2 +079500 GO TO CALL-INIT-03-03. IC2254.2 +079600 CALL-TEST-03-02-1. IC2254.2 +079700 MOVE "CALL-TEST-03-02-1" TO PAR-NAME. IC2254.2 +079800 IF DN1 = 20 IC2254.2 +079900 PERFORM PASS IC2254.2 +080000 PERFORM PRINT-DETAIL IC2254.2 +080100 ELSE IC2254.2 +080200 MOVE DN1 TO COMPUTED-N IC2254.2 +080300 MOVE 20 TO CORRECT-N IC2254.2 +080400 MOVE "VALUE OF DN1 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +080500 PERFORM FAIL IC2254.2 +080600 PERFORM PRINT-DETAIL. IC2254.2 +080700 ADD 1 TO REC-CT. IC2254.2 +080800 CALL-TEST-03-02-2. IC2254.2 +080900 MOVE "CALL-TEST-03-02-2" TO PAR-NAME. IC2254.2 +081000 IF DN2 = 30 IC2254.2 +081100 PERFORM PASS IC2254.2 +081200 PERFORM PRINT-DETAIL IC2254.2 +081300 ELSE IC2254.2 +081400 MOVE DN2 TO COMPUTED-N IC2254.2 +081500 MOVE 30 TO CORRECT-N IC2254.2 +081600 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +081700 PERFORM FAIL IC2254.2 +081800 PERFORM PRINT-DETAIL. IC2254.2 +081900 ADD 1 TO REC-CT. IC2254.2 +082000 CALL-TEST-03-02-3. IC2254.2 +082100 MOVE "CALL-TEST-03-02-3" TO PAR-NAME. IC2254.2 +082200 IF DN3 = 21 IC2254.2 +082300 PERFORM PASS IC2254.2 +082400 PERFORM PRINT-DETAIL IC2254.2 +082500 ELSE IC2254.2 +082600 MOVE DN3 TO COMPUTED-N IC2254.2 +082700 MOVE 21 TO CORRECT-N IC2254.2 +082800 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +082900 PERFORM FAIL IC2254.2 +083000 PERFORM PRINT-DETAIL. IC2254.2 +083100 ADD 1 TO REC-CT. IC2254.2 +083200 CALL-TEST-03-02-4. IC2254.2 +083300 MOVE "CALL-TEST-03-02-4" TO PAR-NAME. IC2254.2 +083400 IF DN4 = 0 IC2254.2 +083500 PERFORM PASS IC2254.2 +083600 PERFORM PRINT-DETAIL IC2254.2 +083700 ELSE IC2254.2 +083800 MOVE DN4 TO COMPUTED-N IC2254.2 +083900 MOVE ZERO TO CORRECT-N IC2254.2 +084000 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +084100 PERFORM FAIL IC2254.2 +084200 PERFORM PRINT-DETAIL. IC2254.2 +084300* IC2254.2 +084400 CALL-INIT-03-03. IC2254.2 +084500 MOVE "CALL-TEST-03-03-0" TO PAR-NAME. IC2254.2 +084600 MOVE 0 TO DN3, DN4. IC2254.2 +084700 MOVE 1 TO REC-CT. IC2254.2 +084800 CALL-TEST-03-03-0. IC2254.2 +084900 CALL ID1 USING BY CONTENT DN1 IC2254.2 +085000 REFERENCE DN2 DN3 DN4 IC2254.2 +085100 ON OVERFLOW MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK IC2254.2 +085200 PERFORM FAIL IC2254.2 +085300 PERFORM PRINT-DETAIL. IC2254.2 +085400 GO TO CALL-TEST-03-03-1. IC2254.2 +085500 CALL-DELETE-03-03. IC2254.2 +085600 PERFORM DE-LETE. IC2254.2 +085700 PERFORM PRINT-DETAIL. IC2254.2 +085800 GO TO CALL-INIT-03-03. IC2254.2 +085900 CALL-TEST-03-03-1. IC2254.2 +086000 MOVE "CALL-TEST-03-03-1" TO PAR-NAME. IC2254.2 +086100 IF DN1 = 20 IC2254.2 +086200 PERFORM PASS IC2254.2 +086300 PERFORM PRINT-DETAIL IC2254.2 +086400 ELSE IC2254.2 +086500 MOVE DN1 TO COMPUTED-N IC2254.2 +086600 MOVE 20 TO CORRECT-N IC2254.2 +086700 MOVE "VALUE OF DN1 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +086800 PERFORM FAIL IC2254.2 +086900 PERFORM PRINT-DETAIL. IC2254.2 +087000 ADD 1 TO REC-CT. IC2254.2 +087100 CALL-TEST-03-03-2. IC2254.2 +087200 MOVE "CALL-TEST-03-03-2" TO PAR-NAME. IC2254.2 +087300 IF DN2 = 30 IC2254.2 +087400 PERFORM PASS IC2254.2 +087500 PERFORM PRINT-DETAIL IC2254.2 +087600 ELSE IC2254.2 +087700 MOVE DN2 TO COMPUTED-N IC2254.2 +087800 MOVE 30 TO CORRECT-N IC2254.2 +087900 MOVE "VALUE OF DN2 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +088000 PERFORM FAIL IC2254.2 +088100 PERFORM PRINT-DETAIL. IC2254.2 +088200 ADD 1 TO REC-CT. IC2254.2 +088300 CALL-TEST-03-03-3. IC2254.2 +088400 MOVE "CALL-TEST-03-03-3" TO PAR-NAME. IC2254.2 +088500 IF DN3 = 21 IC2254.2 +088600 PERFORM PASS IC2254.2 +088700 PERFORM PRINT-DETAIL IC2254.2 +088800 ELSE IC2254.2 +088900 MOVE DN3 TO COMPUTED-N IC2254.2 +089000 MOVE 21 TO CORRECT-N IC2254.2 +089100 MOVE "INCORRECT DN3 VALUE RETURNED" TO RE-MARK IC2254.2 +089200 PERFORM FAIL IC2254.2 +089300 PERFORM PRINT-DETAIL. IC2254.2 +089400 ADD 1 TO REC-CT. IC2254.2 +089500 CALL-TEST-03-03-4. IC2254.2 +089600 MOVE "CALL-TEST-03-03-4" TO PAR-NAME. IC2254.2 +089700 IF DN4 = 9 IC2254.2 +089800 PERFORM PASS IC2254.2 +089900 PERFORM PRINT-DETAIL IC2254.2 +090000 ELSE IC2254.2 +090100 MOVE DN4 TO COMPUTED-N IC2254.2 +090200 MOVE 9 TO CORRECT-N IC2254.2 +090300 MOVE "VALUE OF DN4 HAS BEEN CHANGED" TO RE-MARK IC2254.2 +090400 PERFORM FAIL IC2254.2 +090500 PERFORM PRINT-DETAIL. IC2254.2 +090600* IC2254.2 +090700 GO TO EXIT-IC225A. IC2254.2 +090800* IC2254.2 +090900 CALL-DELETE-03. IC2254.2 +091000* IF THE ON OVERFLOW PHRASE IS NOT RECOGNIZED, DELETE ALL IC2254.2 +091100* OF THE ABOVE CALL-TEST-03 PARAGRAPHS, STARTING WITH IC2254.2 +091200* CALL-TEST-03-01. IC2254.2 +091300 PERFORM DE-LETE. IC2254.2 +091400 PERFORM PRINT-DETAIL. IC2254.2 +091500 EXIT-IC225A. IC2254.2 +091600 GO TO CCVS-EXIT. IC2254.2 +091700 SECT-IC225A-002 SECTION. IC2254.2 +091800 CHECK-TEST-03. IC2254.2 +091900 MOVE ZERO TO FAIL-FLAG. IC2254.2 +092000 ADD 1 TO CALL-COUNT. IC2254.2 +092100 IF DN4 NOT EQUAL TO CALL-COUNT IC2254.2 +092200 ADD 1 TO FAIL-FLAG. IC2254.2 +092300 IF DN3 NOT EQUAL TO 21 IC2254.2 +092400 ADD 1 TO FAIL-FLAG. IC2254.2 +092500 IF DN2 NOT EQUAL TO 30 IC2254.2 +092600 ADD 1 TO FAIL-FLAG. IC2254.2 +092700 IF DN1 NOT EQUAL TO 20 IC2254.2 +092800 ADD 1 TO FAIL-FLAG. IC2254.2 +092900 CCVS-EXIT SECTION. IC2254.2 +093000 CCVS-999999. IC2254.2 +093100 GO TO CLOSE-FILES. IC2254.2 +093200 END PROGRAM IC225A. IC2254.2 +093300 IDENTIFICATION DIVISION. IC2254.2 +093400 PROGRAM-ID. IC2254.2 +093500 IC225A-1. IC2254.2 +093600**************************************************************** IC2254.2 +093700* * IC2254.2 +093800* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2254.2 +093900* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2254.2 +094000* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2254.2 +094100* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2254.2 +094200* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2254.2 +094300* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2254.2 +094400* * IC2254.2 +094500* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2254.2 +094600* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2254.2 +094700* DOCUMENT REFERENCE: ISO-1989-1978). * IC2254.2 +094800* * IC2254.2 +094900* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2254.2 +095000* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2254.2 +095100* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2254.2 +095200* * IC2254.2 +095300* THE FEDERAL SOFTWARE TESTING CENTER * IC2254.2 +095400* OFFICE OF SOFTWARE DEVELOPMENT * IC2254.2 +095500* & INFORMATION TECHNOLOGY * IC2254.2 +095600* TWO SKYLINE PLACE * IC2254.2 +095700* SUITE 1100 * IC2254.2 +095800* 5203 LEESBURG PIKE * IC2254.2 +095900* FALLS CHURCH * IC2254.2 +096000* VA 22041 * IC2254.2 +096100* U.S.A. * IC2254.2 +096200* * IC2254.2 +096300* THE PROJECT TEAM MEMBERS WERE: * IC2254.2 +096400* * IC2254.2 +096500* BIADI (BUREAU INTER ADMINISTRATION * IC2254.2 +096600* DE DOCUMENTATION INFORMATIQUE) * IC2254.2 +096700* 21 RUE BARA * IC2254.2 +096800* F-92132 ISSY * IC2254.2 +096900* FRANCE * IC2254.2 +097000* * IC2254.2 +097100* * IC2254.2 +097200* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2254.2 +097300* UND DATENVERARBEITUNG MBH) * IC2254.2 +097400* SCHLOSS BIRLINGHOVEN * IC2254.2 +097500* POSTFACH 12 40 * IC2254.2 +097600* D-5205 ST. AUGUSTIN 1 * IC2254.2 +097700* GERMANY FR * IC2254.2 +097800* * IC2254.2 +097900* * IC2254.2 +098000* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2254.2 +098100* OXFORD ROAD * IC2254.2 +098200* MANCHESTER * IC2254.2 +098300* M1 7ED * IC2254.2 +098400* UNITED KINGDOM * IC2254.2 +098500* * IC2254.2 +098600* * IC2254.2 +098700* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2254.2 +098800* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2254.2 +098900* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2254.2 +099000* * IC2254.2 +099100**************************************************************** IC2254.2 +099200* * IC2254.2 +099300* VALIDATION FOR:- * IC2254.2 +099400* * IC2254.2 +099500* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2254.2 +099600* * IC2254.2 +099700* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2254.2 +099800* * IC2254.2 +099900**************************************************************** IC2254.2 +100000* * IC2254.2 +100100* X-CARDS USED BY THIS PROGRAM ARE :- * IC2254.2 +100200* * IC2254.2 +100300* X-55 - SYSTEM PRINTER NAME. * IC2254.2 +100400* X-82 - SOURCE COMPUTER NAME. * IC2254.2 +100500* X-83 - OBJECT COMPUTER NAME. * IC2254.2 +100600* * IC2254.2 +100700**************************************************************** IC2254.2 +100800* * IC2254.2 +100900* PROGRAM IC225A AND IC225A-1 WILL TEST THE NEW LANGUAGE * IC2254.2 +101000* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2254.2 +101100* MODULE. * IC2254.2 +101200* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2254.2 +101300* "BY REFERENCE" PHRASE * IC2254.2 +101400* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2254.2 +101500* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2254.2 +101600* IDENTIFICATION DIVISION. * IC2254.2 +101700* PROGRAM-ID. IC225A. * IC2254.2 +101800* . * IC2254.2 +101900* . * IC2254.2 +102000* . * IC2254.2 +102100* END PROGRAM IC225A. * IC2254.2 +102200* PROGRAM-ID. IC225A-1. * IC2254.2 +102300* . * IC2254.2 +102400* . * IC2254.2 +102500* . * IC2254.2 +102600**************************************************************** IC2254.2 +102700 ENVIRONMENT DIVISION. IC2254.2 +102800 CONFIGURATION SECTION. IC2254.2 +102900 SOURCE-COMPUTER. IC2254.2 +103000 Linux. IC2254.2 +103100 OBJECT-COMPUTER. IC2254.2 +103200 Linux. IC2254.2 +103300*INPUT-OUTPUT SECTION. IC2254.2 +103400 DATA DIVISION. IC2254.2 +103500 FILE SECTION. IC2254.2 +103600 WORKING-STORAGE SECTION. IC2254.2 +103700 77 WS1 PICTURE S999. IC2254.2 +103800 77 WS2 PICTURE S999 IC2254.2 +103900 USAGE COMPUTATIONAL, VALUE ZERO. IC2254.2 +104000 LINKAGE SECTION. IC2254.2 +104100 77 DN1 PICTURE S99. IC2254.2 +104200 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2254.2 +104300 77 DN3 PICTURE S99. IC2254.2 +104400 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2254.2 +104500 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2254.2 +104600 SECT-IC225A-1-001 SECTION. IC2254.2 +104700 CALL-TEST-001. IC2254.2 +104800 MOVE DN1 TO WS1. IC2254.2 +104900 ADD 1 TO WS1. IC2254.2 +105000 ADD 1 TO WS2. IC2254.2 +105100 MOVE WS1 TO DN3. IC2254.2 +105200 MOVE WS2 TO DN4. IC2254.2 +105300 CALL-EXIT-001. IC2254.2 +105400 EXIT PROGRAM. IC2254.2 diff --git a/tests/cobol85/IC/IC226A.CBL b/tests/cobol85/IC/IC226A.CBL new file mode 100755 index 00000000..2de19eb5 --- /dev/null +++ b/tests/cobol85/IC/IC226A.CBL @@ -0,0 +1,506 @@ +000100 IDENTIFICATION DIVISION. IC2264.2 +000200 PROGRAM-ID. IC2264.2 +000300 IC226A. IC2264.2 +000400**************************************************************** IC2264.2 +000500* * IC2264.2 +000600* VALIDATION FOR:- * IC2264.2 +000700* * IC2264.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2264.2 +000900* * IC2264.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2264.2 +001100* * IC2264.2 +001200**************************************************************** IC2264.2 +001300* * IC2264.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2264.2 +001500* * IC2264.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2264.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2264.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2264.2 +001900* * IC2264.2 +002000**************************************************************** IC2264.2 +002100* * IC2264.2 +002200* PROGRAM IC226A AND IC226A-1 WILL TEST THE NEW LANGUAGE * IC2264.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2264.2 +002400* MODULE. * IC2264.2 +002500* THE NEW LANGUAGE ELEMENT TO BE TESTED WILL BE: * IC2264.2 +002600* THE "EXTERNAL" PHRASE * IC2264.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2264.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2264.2 +002900* IDENTIFICATION DIVISION. * IC2264.2 +003000* PROGRAM-ID. IC226A. * IC2264.2 +003100* . * IC2264.2 +003200* . * IC2264.2 +003300* . * IC2264.2 +003400* END PROGRAM IC226A. * IC2264.2 +003500* PROGRAM-ID. IC226A-1. * IC2264.2 +003600* . * IC2264.2 +003700* . * IC2264.2 +003800* . * IC2264.2 +003900**************************************************************** IC2264.2 +004000 ENVIRONMENT DIVISION. IC2264.2 +004100 CONFIGURATION SECTION. IC2264.2 +004200 SOURCE-COMPUTER. IC2264.2 +004300 Linux. IC2264.2 +004400 OBJECT-COMPUTER. IC2264.2 +004500 Linux. IC2264.2 +004600 INPUT-OUTPUT SECTION. IC2264.2 +004700 FILE-CONTROL. IC2264.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2264.2 +004900 "report.log". IC2264.2 +005000 DATA DIVISION. IC2264.2 +005100 FILE SECTION. IC2264.2 +005200 FD PRINT-FILE. IC2264.2 +005300 01 PRINT-REC PICTURE X(120). IC2264.2 +005400 01 DUMMY-RECORD PICTURE X(120). IC2264.2 +005500 WORKING-STORAGE SECTION. IC2264.2 +005600 01 EXTERNAL-DATA IS EXTERNAL. IC2264.2 +005700 03 EXT-DATA-1 PIC X(2). IC2264.2 +005800 03 EXT-DATA-2 PIC X(6). IC2264.2 +005900 03 EXT-DATA-3 PIC 9(8). IC2264.2 +006000 03 EXT-DATA-4 PIC 9(4). IC2264.2 +006100 01 SUB PIC 9(4) VALUE ZERO. IC2264.2 +006200* IC2264.2 +006300 01 TEST-RESULTS. IC2264.2 +006400 02 FILLER PIC X VALUE SPACE. IC2264.2 +006500 02 FEATURE PIC X(20) VALUE SPACE. IC2264.2 +006600 02 FILLER PIC X VALUE SPACE. IC2264.2 +006700 02 P-OR-F PIC X(5) VALUE SPACE. IC2264.2 +006800 02 FILLER PIC X VALUE SPACE. IC2264.2 +006900 02 PAR-NAME. IC2264.2 +007000 03 FILLER PIC X(19) VALUE SPACE. IC2264.2 +007100 03 PARDOT-X PIC X VALUE SPACE. IC2264.2 +007200 03 DOTVALUE PIC 99 VALUE ZERO. IC2264.2 +007300 02 FILLER PIC X(8) VALUE SPACE. IC2264.2 +007400 02 RE-MARK PIC X(61). IC2264.2 +007500 01 TEST-COMPUTED. IC2264.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IC2264.2 +007700 02 FILLER PIC X(17) VALUE IC2264.2 +007800 " COMPUTED=". IC2264.2 +007900 02 COMPUTED-X. IC2264.2 +008000 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2264.2 +008100 03 COMPUTED-N REDEFINES COMPUTED-A IC2264.2 +008200 PIC -9(9).9(9). IC2264.2 +008300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2264.2 +008400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2264.2 +008500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2264.2 +008600 03 CM-18V0 REDEFINES COMPUTED-A. IC2264.2 +008700 04 COMPUTED-18V0 PIC -9(18). IC2264.2 +008800 04 FILLER PIC X. IC2264.2 +008900 03 FILLER PIC X(50) VALUE SPACE. IC2264.2 +009000 01 TEST-CORRECT. IC2264.2 +009100 02 FILLER PIC X(30) VALUE SPACE. IC2264.2 +009200 02 FILLER PIC X(17) VALUE " CORRECT =". IC2264.2 +009300 02 CORRECT-X. IC2264.2 +009400 03 CORRECT-A PIC X(20) VALUE SPACE. IC2264.2 +009500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2264.2 +009600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2264.2 +009700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2264.2 +009800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2264.2 +009900 03 CR-18V0 REDEFINES CORRECT-A. IC2264.2 +010000 04 CORRECT-18V0 PIC -9(18). IC2264.2 +010100 04 FILLER PIC X. IC2264.2 +010200 03 FILLER PIC X(2) VALUE SPACE. IC2264.2 +010300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2264.2 +010400 01 CCVS-C-1. IC2264.2 +010500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2264.2 +010600- "SS PARAGRAPH-NAME IC2264.2 +010700- " REMARKS". IC2264.2 +010800 02 FILLER PIC X(20) VALUE SPACE. IC2264.2 +010900 01 CCVS-C-2. IC2264.2 +011000 02 FILLER PIC X VALUE SPACE. IC2264.2 +011100 02 FILLER PIC X(6) VALUE "TESTED". IC2264.2 +011200 02 FILLER PIC X(15) VALUE SPACE. IC2264.2 +011300 02 FILLER PIC X(4) VALUE "FAIL". IC2264.2 +011400 02 FILLER PIC X(94) VALUE SPACE. IC2264.2 +011500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2264.2 +011600 01 REC-CT PIC 99 VALUE ZERO. IC2264.2 +011700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2264.2 +011800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2264.2 +011900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2264.2 +012000 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2264.2 +012100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2264.2 +012200 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2264.2 +012300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2264.2 +012400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2264.2 +012500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2264.2 +012600 01 CCVS-H-1. IC2264.2 +012700 02 FILLER PIC X(39) VALUE SPACES. IC2264.2 +012800 02 FILLER PIC X(42) VALUE IC2264.2 +012900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2264.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC2264.2 +013100 01 CCVS-H-2A. IC2264.2 +013200 02 FILLER PIC X(40) VALUE SPACE. IC2264.2 +013300 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2264.2 +013400 02 FILLER PIC XXXX VALUE IC2264.2 +013500 "4.2 ". IC2264.2 +013600 02 FILLER PIC X(28) VALUE IC2264.2 +013700 " COPY - NOT FOR DISTRIBUTION". IC2264.2 +013800 02 FILLER PIC X(41) VALUE SPACE. IC2264.2 +013900 IC2264.2 +014000 01 CCVS-H-2B. IC2264.2 +014100 02 FILLER PIC X(15) VALUE IC2264.2 +014200 "TEST RESULT OF ". IC2264.2 +014300 02 TEST-ID PIC X(9). IC2264.2 +014400 02 FILLER PIC X(4) VALUE IC2264.2 +014500 " IN ". IC2264.2 +014600 02 FILLER PIC X(12) VALUE IC2264.2 +014700 " HIGH ". IC2264.2 +014800 02 FILLER PIC X(22) VALUE IC2264.2 +014900 " LEVEL VALIDATION FOR ". IC2264.2 +015000 02 FILLER PIC X(58) VALUE IC2264.2 +015100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2264.2 +015200 01 CCVS-H-3. IC2264.2 +015300 02 FILLER PIC X(34) VALUE IC2264.2 +015400 " FOR OFFICIAL USE ONLY ". IC2264.2 +015500 02 FILLER PIC X(58) VALUE IC2264.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2264.2 +015700 02 FILLER PIC X(28) VALUE IC2264.2 +015800 " COPYRIGHT 1985 ". IC2264.2 +015900 01 CCVS-E-1. IC2264.2 +016000 02 FILLER PIC X(52) VALUE SPACE. IC2264.2 +016100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2264.2 +016200 02 ID-AGAIN PIC X(9). IC2264.2 +016300 02 FILLER PIC X(45) VALUE SPACES. IC2264.2 +016400 01 CCVS-E-2. IC2264.2 +016500 02 FILLER PIC X(31) VALUE SPACE. IC2264.2 +016600 02 FILLER PIC X(21) VALUE SPACE. IC2264.2 +016700 02 CCVS-E-2-2. IC2264.2 +016800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2264.2 +016900 03 FILLER PIC X VALUE SPACE. IC2264.2 +017000 03 ENDER-DESC PIC X(44) VALUE IC2264.2 +017100 "ERRORS ENCOUNTERED". IC2264.2 +017200 01 CCVS-E-3. IC2264.2 +017300 02 FILLER PIC X(22) VALUE IC2264.2 +017400 " FOR OFFICIAL USE ONLY". IC2264.2 +017500 02 FILLER PIC X(12) VALUE SPACE. IC2264.2 +017600 02 FILLER PIC X(58) VALUE IC2264.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2264.2 +017800 02 FILLER PIC X(13) VALUE SPACE. IC2264.2 +017900 02 FILLER PIC X(15) VALUE IC2264.2 +018000 " COPYRIGHT 1985". IC2264.2 +018100 01 CCVS-E-4. IC2264.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2264.2 +018300 02 FILLER PIC X(4) VALUE " OF ". IC2264.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2264.2 +018500 02 FILLER PIC X(40) VALUE IC2264.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". IC2264.2 +018700 01 XXINFO. IC2264.2 +018800 02 FILLER PIC X(19) VALUE IC2264.2 +018900 "*** INFORMATION ***". IC2264.2 +019000 02 INFO-TEXT. IC2264.2 +019100 04 FILLER PIC X(8) VALUE SPACE. IC2264.2 +019200 04 XXCOMPUTED PIC X(20). IC2264.2 +019300 04 FILLER PIC X(5) VALUE SPACE. IC2264.2 +019400 04 XXCORRECT PIC X(20). IC2264.2 +019500 02 INF-ANSI-REFERENCE PIC X(48). IC2264.2 +019600 01 HYPHEN-LINE. IC2264.2 +019700 02 FILLER PIC IS X VALUE IS SPACE. IC2264.2 +019800 02 FILLER PIC IS X(65) VALUE IS "************************IC2264.2 +019900- "*****************************************". IC2264.2 +020000 02 FILLER PIC IS X(54) VALUE IS "************************IC2264.2 +020100- "******************************". IC2264.2 +020200 01 CCVS-PGM-ID PIC X(9) VALUE IC2264.2 +020300 "IC226A". IC2264.2 +020400 PROCEDURE DIVISION. IC2264.2 +020500 CCVS1 SECTION. IC2264.2 +020600 OPEN-FILES. IC2264.2 +020700 OPEN OUTPUT PRINT-FILE. IC2264.2 +020800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2264.2 +020900 MOVE SPACE TO TEST-RESULTS. IC2264.2 +021000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2264.2 +021100 GO TO CCVS1-EXIT. IC2264.2 +021200 CLOSE-FILES. IC2264.2 +021300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2264.2 +021400 TERMINATE-CCVS. IC2264.2 +021500*S EXIT PROGRAM. IC2264.2 +021600*SERMINATE-CALL. IC2264.2 +021700 STOP RUN. IC2264.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2264.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2264.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2264.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2264.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. IC2264.2 +022300 PRINT-DETAIL. IC2264.2 +022400 IF REC-CT NOT EQUAL TO ZERO IC2264.2 +022500 MOVE "." TO PARDOT-X IC2264.2 +022600 MOVE REC-CT TO DOTVALUE. IC2264.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2264.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2264.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2264.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2264.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2264.2 +023200 MOVE SPACE TO CORRECT-X. IC2264.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2264.2 +023400 MOVE SPACE TO RE-MARK. IC2264.2 +023500 HEAD-ROUTINE. IC2264.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2264.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2264.2 +024000 COLUMN-NAMES-ROUTINE. IC2264.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +024400 END-ROUTINE. IC2264.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2264.2 +024600 END-RTN-EXIT. IC2264.2 +024700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +024800 END-ROUTINE-1. IC2264.2 +024900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2264.2 +025000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2264.2 +025100 ADD PASS-COUNTER TO ERROR-HOLD. IC2264.2 +025200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2264.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2264.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2264.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2264.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2264.2 +025700 END-ROUTINE-12. IC2264.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2264.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO IC2264.2 +026000 MOVE "NO " TO ERROR-TOTAL IC2264.2 +026100 ELSE IC2264.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2264.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2264.2 +026400 PERFORM WRITE-LINE. IC2264.2 +026500 END-ROUTINE-13. IC2264.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO IC2264.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE IC2264.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2264.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2264.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO IC2264.2 +027200 MOVE "NO " TO ERROR-TOTAL IC2264.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2264.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2264.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2264.2 +027700 WRITE-LINE. IC2264.2 +027800 ADD 1 TO RECORD-COUNT. IC2264.2 +027900 IF RECORD-COUNT GREATER 50 IC2264.2 +028000 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2264.2 +028100 MOVE SPACE TO DUMMY-RECORD IC2264.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2264.2 +028300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2264.2 +028400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2264.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2264.2 +028600 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2264.2 +028700 MOVE ZERO TO RECORD-COUNT. IC2264.2 +028800 PERFORM WRT-LN. IC2264.2 +028900 WRT-LN. IC2264.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2264.2 +029100 MOVE SPACE TO DUMMY-RECORD. IC2264.2 +029200 BLANK-LINE-PRINT. IC2264.2 +029300 PERFORM WRT-LN. IC2264.2 +029400 FAIL-ROUTINE. IC2264.2 +029500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2264.2 +029600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2264.2 +029700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2264.2 +029800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2264.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. IC2264.2 +030100 GO TO FAIL-ROUTINE-EX. IC2264.2 +030200 FAIL-ROUTINE-WRITE. IC2264.2 +030300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2264.2 +030400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2264.2 +030500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2264.2 +030600 MOVE SPACES TO COR-ANSI-REFERENCE. IC2264.2 +030700 FAIL-ROUTINE-EX. EXIT. IC2264.2 +030800 BAIL-OUT. IC2264.2 +030900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2264.2 +031000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2264.2 +031100 BAIL-OUT-WRITE. IC2264.2 +031200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2264.2 +031300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2264.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2264.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IC2264.2 +031600 BAIL-OUT-EX. EXIT. IC2264.2 +031700 CCVS1-EXIT. IC2264.2 +031800 EXIT. IC2264.2 +031900 SECT-IC226A-001 SECTION. IC2264.2 +032000 EXT-INIT-01. IC2264.2 +032100 MOVE 1 TO REC-CT. IC2264.2 +032200 MOVE "X-21 4.5.1" TO ANSI-REFERENCE. IC2264.2 +032300 MOVE "EXTERNAL CLAUSE" TO FEATURE. IC2264.2 +032400 MOVE "AA" TO EXT-DATA-1. IC2264.2 +032500 MOVE "FIRST]" TO EXT-DATA-2. IC2264.2 +032600 MOVE 12345678 TO EXT-DATA-3. IC2264.2 +032700 MOVE 1 TO EXT-DATA-4. IC2264.2 +032800 EXT-TEST-01-01-0. IC2264.2 +032900 CALL "IC226A-1" IC2264.2 +033000 END-CALL. IC2264.2 +033100 GO TO EXT-TEST-01-01-1. IC2264.2 +033200 EXT-DELETE-01-01. IC2264.2 +033300 PERFORM DE-LETE. IC2264.2 +033400 PERFORM PRINT-DETAIL. IC2264.2 +033500 GO TO CCVS-EXIT. IC2264.2 +033600 EXT-TEST-01-01-1. IC2264.2 +033700 MOVE "EXT-TEST-01-01-1" TO PAR-NAME. IC2264.2 +033800 IF EXT-DATA-1 = "ZZ" IC2264.2 +033900 PERFORM PASS IC2264.2 +034000 PERFORM PRINT-DETAIL IC2264.2 +034100 ELSE IC2264.2 +034200 MOVE EXT-DATA-1 TO COMPUTED-X IC2264.2 +034300 MOVE "ZZ" TO CORRECT-X IC2264.2 +034400 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2264.2 +034500 PERFORM FAIL IC2264.2 +034600 PERFORM PRINT-DETAIL. IC2264.2 +034700 ADD 1 TO REC-CT. IC2264.2 +034800 CALL-TEST-01-01-2. IC2264.2 +034900 MOVE "CALL-TEST-01-01-2" TO PAR-NAME. IC2264.2 +035000 IF EXT-DATA-2 = "CHANGE" IC2264.2 +035100 PERFORM PASS IC2264.2 +035200 PERFORM PRINT-DETAIL IC2264.2 +035300 ELSE IC2264.2 +035400 MOVE EXT-DATA-2 TO COMPUTED-X IC2264.2 +035500 MOVE "CHANGE" TO CORRECT-X IC2264.2 +035600 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2264.2 +035700 PERFORM FAIL IC2264.2 +035800 PERFORM PRINT-DETAIL. IC2264.2 +035900 ADD 1 TO REC-CT. IC2264.2 +036000 CALL-TEST-01-01-3. IC2264.2 +036100 MOVE "CALL-TEST-01-01-3" TO PAR-NAME. IC2264.2 +036200 IF EXT-DATA-3 = 87654321 IC2264.2 +036300 PERFORM PASS IC2264.2 +036400 PERFORM PRINT-DETAIL IC2264.2 +036500 ELSE IC2264.2 +036600 MOVE EXT-DATA-3 TO COMPUTED-N IC2264.2 +036700 MOVE 87654321 TO CORRECT-N IC2264.2 +036800 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2264.2 +036900 PERFORM FAIL IC2264.2 +037000 PERFORM PRINT-DETAIL. IC2264.2 +037100 ADD 1 TO REC-CT. IC2264.2 +037200 CALL-TEST-01-01-4. IC2264.2 +037300 MOVE "CALL-TEST-01-01-4" TO PAR-NAME. IC2264.2 +037400 IF EXT-DATA-4 = 11 IC2264.2 +037500 PERFORM PASS IC2264.2 +037600 PERFORM PRINT-DETAIL IC2264.2 +037700 ELSE IC2264.2 +037800 MOVE EXT-DATA-4 TO COMPUTED-N IC2264.2 +037900 MOVE 11 TO CORRECT-N IC2264.2 +038000 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2264.2 +038100 PERFORM FAIL IC2264.2 +038200 PERFORM PRINT-DETAIL. IC2264.2 +038300* IC2264.2 +038400 CCVS-EXIT SECTION. IC2264.2 +038500 CCVS-999999. IC2264.2 +038600 GO TO CLOSE-FILES. IC2264.2 +038700 END PROGRAM IC226A. IC2264.2 +038800 IDENTIFICATION DIVISION. IC2264.2 +038900 PROGRAM-ID. IC2264.2 +039000 IC226A-1. IC2264.2 +039100**************************************************************** IC2264.2 +039200* * IC2264.2 +039300* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2264.2 +039400* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2264.2 +039500* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2264.2 +039600* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2264.2 +039700* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2264.2 +039800* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2264.2 +039900* * IC2264.2 +040000* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2264.2 +040100* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2264.2 +040200* DOCUMENT REFERENCE: ISO-1989-1978). * IC2264.2 +040300* * IC2264.2 +040400* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2264.2 +040500* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2264.2 +040600* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2264.2 +040700* * IC2264.2 +040800* THE FEDERAL SOFTWARE TESTING CENTER * IC2264.2 +040900* OFFICE OF SOFTWARE DEVELOPMENT * IC2264.2 +041000* & INFORMATION TECHNOLOGY * IC2264.2 +041100* TWO SKYLINE PLACE * IC2264.2 +041200* SUITE 1100 * IC2264.2 +041300* 5203 LEESBURG PIKE * IC2264.2 +041400* FALLS CHURCH * IC2264.2 +041500* VA 22041 * IC2264.2 +041600* U.S.A. * IC2264.2 +041700* * IC2264.2 +041800* THE PROJECT TEAM MEMBERS WERE: * IC2264.2 +041900* * IC2264.2 +042000* BIADI (BUREAU INTER ADMINISTRATION * IC2264.2 +042100* DE DOCUMENTATION INFORMATIQUE) * IC2264.2 +042200* 21 RUE BARA * IC2264.2 +042300* F-92132 ISSY * IC2264.2 +042400* FRANCE * IC2264.2 +042500* * IC2264.2 +042600* * IC2264.2 +042700* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2264.2 +042800* UND DATENVERARBEITUNG MBH) * IC2264.2 +042900* SCHLOSS BIRLINGHOVEN * IC2264.2 +043000* POSTFACH 12 40 * IC2264.2 +043100* D-5205 ST. AUGUSTIN 1 * IC2264.2 +043200* GERMANY FR * IC2264.2 +043300* * IC2264.2 +043400* * IC2264.2 +043500* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2264.2 +043600* OXFORD ROAD * IC2264.2 +043700* MANCHESTER * IC2264.2 +043800* M1 7ED * IC2264.2 +043900* UNITED KINGDOM * IC2264.2 +044000* * IC2264.2 +044100* * IC2264.2 +044200* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2264.2 +044300* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2264.2 +044400* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2264.2 +044500* * IC2264.2 +044600**************************************************************** IC2264.2 +044700* * IC2264.2 +044800* VALIDATION FOR:- * IC2264.2 +044900* * IC2264.2 +045000* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2264.2 +045100* * IC2264.2 +045200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2264.2 +045300* * IC2264.2 +045400**************************************************************** IC2264.2 +045500* * IC2264.2 +045600* X-CARDS USED BY THIS PROGRAM ARE :- * IC2264.2 +045700* * IC2264.2 +045800* X-14 - SEQUENTIAL MASS STORAGE * IC2264.2 +045900* X-55 - SYSTEM PRINTER NAME. * IC2264.2 +046000* X-82 - SOURCE COMPUTER NAME. * IC2264.2 +046100* X-83 - OBJECT COMPUTER NAME. * IC2264.2 +046200* * IC2264.2 +046300**************************************************************** IC2264.2 +046400* * IC2264.2 +046500* PROGRAM IC226A AND IC226A-1 WILL TEST THE NEW LANGUAGE * IC2264.2 +046600* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2264.2 +046700* MODULE. * IC2264.2 +046800* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2264.2 +046900* THE "EXTERNAL" CLAUSE IN WORKING-STORAGE. * IC2264.2 +047000* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2264.2 +047100* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2264.2 +047200* IDENTIFICATION DIVISION. * IC2264.2 +047300* PROGRAM-ID. IC226A. * IC2264.2 +047400* . * IC2264.2 +047500* . * IC2264.2 +047600* . * IC2264.2 +047700* END PROGRAM IC226A. * IC2264.2 +047800* PROGRAM-ID. IC226A-1. * IC2264.2 +047900* . * IC2264.2 +048000* . * IC2264.2 +048100* . * IC2264.2 +048200**************************************************************** IC2264.2 +048300 ENVIRONMENT DIVISION. IC2264.2 +048400 CONFIGURATION SECTION. IC2264.2 +048500 SOURCE-COMPUTER. IC2264.2 +048600 Linux. IC2264.2 +048700 OBJECT-COMPUTER. IC2264.2 +048800 Linux. IC2264.2 +048900*INPUT-OUTPUT SECTION. IC2264.2 +049000 DATA DIVISION. IC2264.2 +049100 FILE SECTION. IC2264.2 +049200 WORKING-STORAGE SECTION. IC2264.2 +049300 01 EXTERNAL-DATA IS EXTERNAL. IC2264.2 +049400 03 EXT-DATA-1 PIC X(2). IC2264.2 +049500 03 EXT-DATA-2 PIC X(6). IC2264.2 +049600 03 EXT-DATA-3 PIC 9(8). IC2264.2 +049700 03 EXT-DATA-4 PIC 9(4). IC2264.2 +049800 PROCEDURE DIVISION. IC2264.2 +049900 SECT-IC226A-1-001 SECTION. IC2264.2 +050000 EXT-TEST-001. IC2264.2 +050100 MOVE "ZZ" TO EXT-DATA-1. IC2264.2 +050200 MOVE "CHANGE" TO EXT-DATA-2. IC2264.2 +050300 MOVE 87654321 TO EXT-DATA-3. IC2264.2 +050400 ADD 10 TO EXT-DATA-4. IC2264.2 +050500 EXT-EXIT-001. IC2264.2 +050600 EXIT PROGRAM. IC2264.2 diff --git a/tests/cobol85/IC/IC227A.CBL b/tests/cobol85/IC/IC227A.CBL new file mode 100755 index 00000000..8dfe02d1 --- /dev/null +++ b/tests/cobol85/IC/IC227A.CBL @@ -0,0 +1,1200 @@ +000100 IDENTIFICATION DIVISION. IC2274.2 +000200 PROGRAM-ID. IC2274.2 +000300 IC227A. IC2274.2 +000400**************************************************************** IC2274.2 +000500* * IC2274.2 +000600* VALIDATION FOR:- * IC2274.2 +000700* * IC2274.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2 +000900* * IC2274.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2274.2 +001100* * IC2274.2 +001200**************************************************************** IC2274.2 +001300* * IC2274.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2274.2 +001500* * IC2274.2 +001600* X-55 SYSTEM PRINTER * IC2274.2 +001700* X-82 SOURCE-COMPUTER * IC2274.2 +001800* X-83 OBJECT-COMPUTER. * IC2274.2 +001900* * IC2274.2 +002000**************************************************************** IC2274.2 +002100* * IC2274.2 +002200* PROGRAMS IC227A AND IC227A-1 TEST LEVEL 2 LANGUAGE * IC2274.2 +002300* ELEMENTS FROM THE INTER-PROGRAM COMMUNICATION MODULE. * IC2274.2 +002400* THE PARTICULAR ELEMENTS TESTED ARE: * IC2274.2 +002500* THE "EXTERNAL" CLAUSE IN THE FILE DESCRIPTION ENTRY * IC2274.2 +002600* * IC2274.2 +002700* ALTHOUGH IC227A AND IC227A-1 ARE SEPARATELY COMPILED * IC2274.2 +002800* PROGRAMS, BOTH ARE INTENDED TO BE COMPILED BY THE SAME * IC2274.2 +002900* INVOCATION OF THE COMPILER, IN ORDER TO TEST STREAM * IC2274.2 +003000* COMPILATION AND RECOGNITION OF THE END PROGRAM HEADER. * IC2274.2 +003100* * IC2274.2 +003200* THE STRUCTURE OF THE SOURCE FILE IS: IC2274.2 +003300* * IC2274.2 +003400* IDENTIFICATION DIVISION. * IC2274.2 +003500* PROGRAM-ID. IC227A. * IC2274.2 +003600* . * IC2274.2 +003700* . * IC2274.2 +003800* . * IC2274.2 +003900* END PROGRAM IC227A. * IC2274.2 +004000* IDENTIFICATION DIVISION. * IC2274.2 +004100* PROGRAM-ID. IC227A-1. * IC2274.2 +004200* . * IC2274.2 +004300* . * IC2274.2 +004400* . * IC2274.2 +004500* END PROGRAM IC227A-1. * IC2274.2 +004600* * IC2274.2 +004700**************************************************************** IC2274.2 +004800* IC2274.2 +004900 ENVIRONMENT DIVISION. IC2274.2 +005000 CONFIGURATION SECTION. IC2274.2 +005100 SOURCE-COMPUTER. IC2274.2 +005200 Linux. IC2274.2 +005300 OBJECT-COMPUTER. IC2274.2 +005400 Linux. IC2274.2 +005500* IC2274.2 +005600 INPUT-OUTPUT SECTION. IC2274.2 +005700 FILE-CONTROL. IC2274.2 +005800 SELECT PRINT-FILE ASSIGN TO IC2274.2 +005900 "report.log". IC2274.2 +006000* IC2274.2 +006100 SELECT EXTERNAL-FILE ASSIGN TO IC2274.2 +006200 "XXXXX014" IC2274.2 +006300 FILE STATUS IS EXTERNAL-FILE-FS. IC2274.2 +006400* IC2274.2 +006500 DATA DIVISION. IC2274.2 +006600 FILE SECTION. IC2274.2 +006700 FD PRINT-FILE. IC2274.2 +006800 01 PRINT-REC PICTURE X(120). IC2274.2 +006900 01 DUMMY-RECORD PICTURE X(120). IC2274.2 +007000* IC2274.2 +007100 FD EXTERNAL-FILE IC2274.2 +007200 IS EXTERNAL IC2274.2 +007300 RECORD CONTAINS 18 CHARACTERS. IC2274.2 +007400 01 EXTERNAL-FILE-RECORD. IC2274.2 +007500 03 EXT-DATA-1 PIC X(2). IC2274.2 +007600 03 EXT-DATA-2 PIC X(6). IC2274.2 +007700 03 EXT-DATA-3 PIC 9(6). IC2274.2 +007800 03 EXT-DATA-4 PIC 9(4). IC2274.2 +007900* IC2274.2 +008000 WORKING-STORAGE SECTION. IC2274.2 +008100* IC2274.2 +008200*************************************************************** IC2274.2 +008300* * IC2274.2 +008400* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * IC2274.2 +008500* * IC2274.2 +008600*************************************************************** IC2274.2 +008700* IC2274.2 +008800 01 EXTERNAL-RECORD-HOLD. IC2274.2 +008900 03 WSE-DATA-1 PIC X(2). IC2274.2 +009000 03 WSE-DATA-2 PIC X(6). IC2274.2 +009100 03 WSE-DATA-3 PIC 9(6). IC2274.2 +009200 03 WSE-DATA-4 PIC 9(4). IC2274.2 +009300* IC2274.2 +009400 01 EXTERNAL-RECORD-WORK. IC2274.2 +009500 03 WRK-DATA-1 PIC X(2). IC2274.2 +009600 03 WRK-DATA-2 PIC X(6). IC2274.2 +009700 03 WRK-DATA-3 PIC 9(6). IC2274.2 +009800 03 WRK-DATA-4 PIC 9(4). IC2274.2 +009900* IC2274.2 +010000 01 EXTERNAL-FILE-FS PIC XX. IC2274.2 +010100 01 F-S-PARAM PIC XX. IC2274.2 +010200 01 ACTION-CODE PIC 99. IC2274.2 +010300 77 ID1 PICTURE X(8) VALUE "IC227A-1". IC2274.2 +010400* IC2274.2 +010500*************************************************************** IC2274.2 +010600* * IC2274.2 +010700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * IC2274.2 +010800* * IC2274.2 +010900*************************************************************** IC2274.2 +011000* IC2274.2 +011100 01 TEST-RESULTS. IC2274.2 +011200 02 FILLER PIC X VALUE SPACE. IC2274.2 +011300 02 FEATURE PIC X(20) VALUE SPACE. IC2274.2 +011400 02 FILLER PIC X VALUE SPACE. IC2274.2 +011500 02 P-OR-F PIC X(5) VALUE SPACE. IC2274.2 +011600 02 FILLER PIC X VALUE SPACE. IC2274.2 +011700 02 PAR-NAME. IC2274.2 +011800 03 FILLER PIC X(19) VALUE SPACE. IC2274.2 +011900 03 PARDOT-X PIC X VALUE SPACE. IC2274.2 +012000 03 DOTVALUE PIC 99 VALUE ZERO. IC2274.2 +012100 02 FILLER PIC X(8) VALUE SPACE. IC2274.2 +012200 02 RE-MARK PIC X(61). IC2274.2 +012300 01 TEST-COMPUTED. IC2274.2 +012400 02 FILLER PIC X(30) VALUE SPACE. IC2274.2 +012500 02 FILLER PIC X(17) VALUE IC2274.2 +012600 " COMPUTED=". IC2274.2 +012700 02 COMPUTED-X. IC2274.2 +012800 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2274.2 +012900 03 COMPUTED-N REDEFINES COMPUTED-A IC2274.2 +013000 PIC -9(9).9(9). IC2274.2 +013100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2274.2 +013200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2274.2 +013300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2274.2 +013400 03 CM-18V0 REDEFINES COMPUTED-A. IC2274.2 +013500 04 COMPUTED-18V0 PIC -9(18). IC2274.2 +013600 04 FILLER PIC X. IC2274.2 +013700 03 FILLER PIC X(50) VALUE SPACE. IC2274.2 +013800 01 TEST-CORRECT. IC2274.2 +013900 02 FILLER PIC X(30) VALUE SPACE. IC2274.2 +014000 02 FILLER PIC X(17) VALUE " CORRECT =". IC2274.2 +014100 02 CORRECT-X. IC2274.2 +014200 03 CORRECT-A PIC X(20) VALUE SPACE. IC2274.2 +014300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2274.2 +014400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2274.2 +014500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2274.2 +014600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2274.2 +014700 03 CR-18V0 REDEFINES CORRECT-A. IC2274.2 +014800 04 CORRECT-18V0 PIC -9(18). IC2274.2 +014900 04 FILLER PIC X. IC2274.2 +015000 03 FILLER PIC X(2) VALUE SPACE. IC2274.2 +015100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2274.2 +015200 01 CCVS-C-1. IC2274.2 +015300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2274.2 +015400- "SS PARAGRAPH-NAME IC2274.2 +015500- " REMARKS". IC2274.2 +015600 02 FILLER PIC X(20) VALUE SPACE. IC2274.2 +015700 01 CCVS-C-2. IC2274.2 +015800 02 FILLER PIC X VALUE SPACE. IC2274.2 +015900 02 FILLER PIC X(6) VALUE "TESTED". IC2274.2 +016000 02 FILLER PIC X(15) VALUE SPACE. IC2274.2 +016100 02 FILLER PIC X(4) VALUE "FAIL". IC2274.2 +016200 02 FILLER PIC X(94) VALUE SPACE. IC2274.2 +016300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2274.2 +016400 01 REC-CT PIC 99 VALUE ZERO. IC2274.2 +016500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2274.2 +016600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2274.2 +016700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2274.2 +016800 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2274.2 +016900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2274.2 +017000 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2274.2 +017100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2274.2 +017200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2274.2 +017300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2274.2 +017400 01 CCVS-H-1. IC2274.2 +017500 02 FILLER PIC X(39) VALUE SPACES. IC2274.2 +017600 02 FILLER PIC X(42) VALUE IC2274.2 +017700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2274.2 +017800 02 FILLER PIC X(39) VALUE SPACES. IC2274.2 +017900 01 CCVS-H-2A. IC2274.2 +018000 02 FILLER PIC X(40) VALUE SPACE. IC2274.2 +018100 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2274.2 +018200 02 FILLER PIC XXXX VALUE IC2274.2 +018300 "4.2 ". IC2274.2 +018400 02 FILLER PIC X(28) VALUE IC2274.2 +018500 " COPY - NOT FOR DISTRIBUTION". IC2274.2 +018600 02 FILLER PIC X(41) VALUE SPACE. IC2274.2 +018700 IC2274.2 +018800 01 CCVS-H-2B. IC2274.2 +018900 02 FILLER PIC X(15) VALUE IC2274.2 +019000 "TEST RESULT OF ". IC2274.2 +019100 02 TEST-ID PIC X(9). IC2274.2 +019200 02 FILLER PIC X(4) VALUE IC2274.2 +019300 " IN ". IC2274.2 +019400 02 FILLER PIC X(12) VALUE IC2274.2 +019500 " HIGH ". IC2274.2 +019600 02 FILLER PIC X(22) VALUE IC2274.2 +019700 " LEVEL VALIDATION FOR ". IC2274.2 +019800 02 FILLER PIC X(58) VALUE IC2274.2 +019900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2 +020000 01 CCVS-H-3. IC2274.2 +020100 02 FILLER PIC X(34) VALUE IC2274.2 +020200 " FOR OFFICIAL USE ONLY ". IC2274.2 +020300 02 FILLER PIC X(58) VALUE IC2274.2 +020400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2274.2 +020500 02 FILLER PIC X(28) VALUE IC2274.2 +020600 " COPYRIGHT 1985,1986 ". IC2274.2 +020700 01 CCVS-E-1. IC2274.2 +020800 02 FILLER PIC X(52) VALUE SPACE. IC2274.2 +020900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2274.2 +021000 02 ID-AGAIN PIC X(9). IC2274.2 +021100 02 FILLER PIC X(45) VALUE SPACES. IC2274.2 +021200 01 CCVS-E-2. IC2274.2 +021300 02 FILLER PIC X(31) VALUE SPACE. IC2274.2 +021400 02 FILLER PIC X(21) VALUE SPACE. IC2274.2 +021500 02 CCVS-E-2-2. IC2274.2 +021600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2274.2 +021700 03 FILLER PIC X VALUE SPACE. IC2274.2 +021800 03 ENDER-DESC PIC X(44) VALUE IC2274.2 +021900 "ERRORS ENCOUNTERED". IC2274.2 +022000 01 CCVS-E-3. IC2274.2 +022100 02 FILLER PIC X(22) VALUE IC2274.2 +022200 " FOR OFFICIAL USE ONLY". IC2274.2 +022300 02 FILLER PIC X(12) VALUE SPACE. IC2274.2 +022400 02 FILLER PIC X(58) VALUE IC2274.2 +022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2 +022600 02 FILLER PIC X(8) VALUE SPACE. IC2274.2 +022700 02 FILLER PIC X(20) VALUE IC2274.2 +022800 " COPYRIGHT 1985,1986". IC2274.2 +022900 01 CCVS-E-4. IC2274.2 +023000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2274.2 +023100 02 FILLER PIC X(4) VALUE " OF ". IC2274.2 +023200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2274.2 +023300 02 FILLER PIC X(40) VALUE IC2274.2 +023400 " TESTS WERE EXECUTED SUCCESSFULLY". IC2274.2 +023500 01 XXINFO. IC2274.2 +023600 02 FILLER PIC X(19) VALUE IC2274.2 +023700 "*** INFORMATION ***". IC2274.2 +023800 02 INFO-TEXT. IC2274.2 +023900 04 FILLER PIC X(8) VALUE SPACE. IC2274.2 +024000 04 XXCOMPUTED PIC X(20). IC2274.2 +024100 04 FILLER PIC X(5) VALUE SPACE. IC2274.2 +024200 04 XXCORRECT PIC X(20). IC2274.2 +024300 02 INF-ANSI-REFERENCE PIC X(48). IC2274.2 +024400 01 HYPHEN-LINE. IC2274.2 +024500 02 FILLER PIC IS X VALUE IS SPACE. IC2274.2 +024600 02 FILLER PIC IS X(65) VALUE IS "************************IC2274.2 +024700- "*****************************************". IC2274.2 +024800 02 FILLER PIC IS X(54) VALUE IS "************************IC2274.2 +024900- "******************************". IC2274.2 +025000 01 CCVS-PGM-ID PIC X(9) VALUE IC2274.2 +025100 "IC227A". IC2274.2 +025200* IC2274.2 +025300* IC2274.2 +025400 PROCEDURE DIVISION. IC2274.2 +025500 CCVS1 SECTION. IC2274.2 +025600 OPEN-FILES. IC2274.2 +025700 OPEN OUTPUT PRINT-FILE. IC2274.2 +025800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2274.2 +025900 MOVE SPACE TO TEST-RESULTS. IC2274.2 +026000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2274.2 +026100 GO TO CCVS1-EXIT. IC2274.2 +026200 CLOSE-FILES. IC2274.2 +026300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2274.2 +026400 TERMINATE-CCVS. IC2274.2 +026500 STOP RUN. IC2274.2 +026600* IC2274.2 +026700 INSPT. IC2274.2 +026800 MOVE "INSPT" TO P-OR-F. IC2274.2 +026900 ADD 1 TO INSPECT-COUNTER. IC2274.2 +027000 PERFORM PRINT-DETAIL. IC2274.2 +027100 IC2274.2 +027200 PASS. IC2274.2 +027300 MOVE "PASS " TO P-OR-F. IC2274.2 +027400 ADD 1 TO PASS-COUNTER. IC2274.2 +027500 PERFORM PRINT-DETAIL. IC2274.2 +027600* IC2274.2 +027700 FAIL. IC2274.2 +027800 MOVE "FAIL*" TO P-OR-F. IC2274.2 +027900 ADD 1 TO ERROR-COUNTER. IC2274.2 +028000 PERFORM PRINT-DETAIL. IC2274.2 +028100* IC2274.2 +028200 DE-LETE. IC2274.2 +028300 MOVE "****TEST DELETED****" TO RE-MARK. IC2274.2 +028400 MOVE "*****" TO P-OR-F. IC2274.2 +028500 ADD 1 TO DELETE-COUNTER. IC2274.2 +028600 PERFORM PRINT-DETAIL. IC2274.2 +028700 IC2274.2 +028800 PRINT-DETAIL. IC2274.2 +028900 IF REC-CT NOT EQUAL TO ZERO IC2274.2 +029000 MOVE "." TO PARDOT-X IC2274.2 +029100 MOVE REC-CT TO DOTVALUE. IC2274.2 +029200 MOVE TEST-RESULTS TO PRINT-REC. IC2274.2 +029300 PERFORM WRITE-LINE. IC2274.2 +029400 IF P-OR-F EQUAL TO "FAIL*" IC2274.2 +029500 PERFORM WRITE-LINE IC2274.2 +029600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2274.2 +029700 ELSE IC2274.2 +029800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2274.2 +029900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2274.2 +030000 MOVE SPACE TO CORRECT-X. IC2274.2 +030100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2274.2 +030200 MOVE SPACE TO RE-MARK. IC2274.2 +030300* IC2274.2 +030400 HEAD-ROUTINE. IC2274.2 +030500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +030600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +030700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2274.2 +030800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2274.2 +030900 COLUMN-NAMES-ROUTINE. IC2274.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +031300 END-ROUTINE. IC2274.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. IC2274.2 +031500 PERFORM WRITE-LINE 5 TIMES. IC2274.2 +031600 END-RTN-EXIT. IC2274.2 +031700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +031800* IC2274.2 +031900 END-ROUTINE-1. IC2274.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD IC2274.2 +032100 ADD INSPECT-COUNTER TO ERROR-HOLD. IC2274.2 +032200 ADD DELETE-COUNTER TO ERROR-HOLD. IC2274.2 +032300 ADD PASS-COUNTER TO ERROR-HOLD. IC2274.2 +032400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2274.2 +032500 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2274.2 +032600 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2274.2 +032700 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2274.2 +032800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2274.2 +032900 END-ROUTINE-12. IC2274.2 +033000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2274.2 +033100 IF ERROR-COUNTER IS EQUAL TO ZERO IC2274.2 +033200 MOVE "NO " TO ERROR-TOTAL IC2274.2 +033300 ELSE IC2274.2 +033400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2274.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2274.2 +033600 PERFORM WRITE-LINE. IC2274.2 +033700 END-ROUTINE-13. IC2274.2 +033800 IF DELETE-COUNTER IS EQUAL TO ZERO IC2274.2 +033900 MOVE "NO " TO ERROR-TOTAL ELSE IC2274.2 +034000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2274.2 +034100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2274.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +034300 IF INSPECT-COUNTER EQUAL TO ZERO IC2274.2 +034400 MOVE "NO " TO ERROR-TOTAL IC2274.2 +034500 ELSE IC2274.2 +034600 MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2274.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2274.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2 +035000* IC2274.2 +035100 WRITE-LINE. IC2274.2 +035200 ADD 1 TO RECORD-COUNT. IC2274.2 +035300 IF RECORD-COUNT GREATER 50 IC2274.2 +035400 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2274.2 +035500 MOVE SPACE TO DUMMY-RECORD IC2274.2 +035600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2274.2 +035700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2274.2 +035800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2274.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2274.2 +036000 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2274.2 +036100 MOVE ZERO TO RECORD-COUNT. IC2274.2 +036200 PERFORM WRT-LN. IC2274.2 +036300 WRT-LN. IC2274.2 +036400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2274.2 +036500 MOVE SPACE TO DUMMY-RECORD. IC2274.2 +036600 BLANK-LINE-PRINT. IC2274.2 +036700 PERFORM WRT-LN. IC2274.2 +036800 FAIL-ROUTINE. IC2274.2 +036900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2274.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2274.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2274.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2274.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. IC2274.2 +037500 GO TO FAIL-ROUTINE-EX. IC2274.2 +037600 FAIL-ROUTINE-WRITE. IC2274.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2274.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2274.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2274.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. IC2274.2 +038100 FAIL-ROUTINE-EX. EXIT. IC2274.2 +038200 BAIL-OUT. IC2274.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2274.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2274.2 +038500 BAIL-OUT-WRITE. IC2274.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2274.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2274.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. IC2274.2 +039000 BAIL-OUT-EX. EXIT. IC2274.2 +039100 CCVS1-EXIT. IC2274.2 +039200 EXIT. IC2274.2 +039300* IC2274.2 +039400**************************************************************** IC2274.2 +039500* * IC2274.2 +039600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * IC2274.2 +039700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * IC2274.2 +039800* * IC2274.2 +039900**************************************************************** IC2274.2 +040000* IC2274.2 +040100 SECT-IC227A-01 SECTION. IC2274.2 +040200 EXT-INIT-01. IC2274.2 +040300* IC2274.2 +040400* ************************************************* IC2274.2 +040500* * * IC2274.2 +040600* * MAKE EXTERNAL FILE RECORD AREA AVAILABLE * IC2274.2 +040700* * * IC2274.2 +040800* ************************************************* IC2274.2 +040900* IC2274.2 +041000 OPEN OUTPUT EXTERNAL-FILE. IC2274.2 +041100* IC2274.2 +041200 MOVE 1 TO REC-CT. IC2274.2 +041300 MOVE "EXTERNAL FILE RECORD" TO FEATURE. IC2274.2 +041400 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +041500 MOVE "EXT-REC-TEST-01" TO PAR-NAME. IC2274.2 +041600 MOVE "******************" TO EXTERNAL-FILE-RECORD. IC2274.2 +041700 MOVE "**" TO F-S-PARAM. IC2274.2 +041800 MOVE "AA" TO WRK-DATA-1 IC2274.2 +041900 MOVE "PQRSTU" TO WRK-DATA-2 IC2274.2 +042000 MOVE 123456 TO WRK-DATA-3 IC2274.2 +042100 MOVE 9876 TO WRK-DATA-4. IC2274.2 +042200 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-RECORD-HOLD. IC2274.2 +042300 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +042400 GO TO EXT-REC-TEST-01. IC2274.2 +042500 EXT-REC-DELETE-01. IC2274.2 +042600 PERFORM DE-LETE. IC2274.2 +042700 GO TO EXT-REC-DELETE-01-02. IC2274.2 +042800* IC2274.2 +042900* ************************************************* IC2274.2 +043000* * * IC2274.2 +043100* * CHECK THAT SUBPROGRAM SEES SAME RECORD AREA * IC2274.2 +043200* * * IC2274.2 +043300* ************************************************* IC2274.2 +043400* IC2274.2 +043500 EXT-REC-TEST-01. IC2274.2 +043600 MOVE 1 TO ACTION-CODE. IC2274.2 +043700 CALL "IC227A-1" USING ACTION-CODE IC2274.2 +043800 EXTERNAL-RECORD-WORK IC2274.2 +043900 F-S-PARAM. IC2274.2 +044000 IF EXTERNAL-FILE-RECORD EQUAL EXTERNAL-RECORD-HOLD IC2274.2 +044100 PERFORM PASS IC2274.2 +044200 ELSE IC2274.2 +044300 MOVE "SUBPROGRAM DID NOT WRITE TO RECORD AREA" IC2274.2 +044400 TO RE-MARK IC2274.2 +044500 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +044600 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +044700 PERFORM FAIL IC2274.2 +044800 END-IF. IC2274.2 +044900 GO TO EXT-REC-TEST-01-02. IC2274.2 +045000 EXT-REC-DELETE-01-02. IC2274.2 +045100 ADD 1 TO REC-CT IC2274.2 +045200 PERFORM DE-LETE. IC2274.2 +045300 GO TO EXT-REC-DELETE-01-03. IC2274.2 +045400 EXT-REC-TEST-01-02. IC2274.2 +045500 ADD 1 TO REC-CT. IC2274.2 +045600 IF EXTERNAL-RECORD-WORK EQUAL "******************" IC2274.2 +045700 PERFORM PASS IC2274.2 +045800 ELSE IC2274.2 +045900 MOVE "SUBPROGRAM DID NOT READ FROM RECORD AREA" IC2274.2 +046000 TO RE-MARK IC2274.2 +046100 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2 +046200 MOVE "******************" TO CORRECT-A IC2274.2 +046300 PERFORM FAIL IC2274.2 +046400 END-IF. IC2274.2 +046500 GO TO EXT-REC-TEST-01-03. IC2274.2 +046600 EXT-REC-DELETE-01-03. IC2274.2 +046700 ADD 1 TO REC-CT IC2274.2 +046800 PERFORM DE-LETE. IC2274.2 +046900 GO TO EXT-REC-TEST-01-END. IC2274.2 +047000 EXT-REC-TEST-01-03. IC2274.2 +047100 ADD 1 TO REC-CT. IC2274.2 +047200 IF F-S-PARAM IS EQUAL "XX" IC2274.2 +047300 PERFORM PASS IC2274.2 +047400 ELSE IC2274.2 +047500 MOVE "WRONG FILE STATUS VALUE RETURNED" IC2274.2 +047600 TO RE-MARK IC2274.2 +047700 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +047800 MOVE "XX" TO CORRECT-A IC2274.2 +047900 PERFORM FAIL IC2274.2 +048000 END-IF. IC2274.2 +048100 EXT-REC-TEST-01-END. IC2274.2 +048200* IC2274.2 +048300* IC2274.2 +048400 EXT-INIT-02. IC2274.2 +048500* IC2274.2 +048600* ************************************************* IC2274.2 +048700* * * IC2274.2 +048800* * WRITE RECORD FROM PARAMETERS TO FILE * IC2274.2 +048900* * * IC2274.2 +049000* ************************************************* IC2274.2 +049100* IC2274.2 +049200 MOVE 1 TO REC-CT. IC2274.2 +049300 MOVE "EXTERNAL FILE WRITE" TO FEATURE. IC2274.2 +049400 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +049500 MOVE "EXT-FILE-TEST-02" TO PAR-NAME. IC2274.2 +049600 MOVE "******************" TO EXTERNAL-FILE-RECORD. IC2274.2 +049700 MOVE "**" TO F-S-PARAM. IC2274.2 +049800 MOVE "AA" TO WRK-DATA-1 IC2274.2 +049900 MOVE "PQRSTU" TO WRK-DATA-2 IC2274.2 +050000 MOVE 123456 TO WRK-DATA-3 IC2274.2 +050100 MOVE 9876 TO WRK-DATA-4. IC2274.2 +050200 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +050300 GO TO EXT-FILE-TEST-02. IC2274.2 +050400 EXT-FILE-DELETE-02. IC2274.2 +050500 PERFORM DE-LETE. IC2274.2 +050600 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-FILE-RECORD. IC2274.2 +050700 WRITE EXTERNAL-FILE-RECORD. IC2274.2 +050800 GO TO EXT-FILE-DELETE-02-02. IC2274.2 +050900* IC2274.2 +051000* ************************************************* IC2274.2 +051100* * * IC2274.2 +051200* * CHECK THAT SUBPROGRAM WILL WRITE * IC2274.2 +051300* * * IC2274.2 +051400* ************************************************* IC2274.2 +051500* IC2274.2 +051600 EXT-FILE-TEST-02. IC2274.2 +051700 MOVE 2 TO ACTION-CODE. IC2274.2 +051800 CALL "IC227A-1" USING CONTENT ACTION-CODE IC2274.2 +051900 REFERENCE EXTERNAL-RECORD-WORK IC2274.2 +052000 F-S-PARAM. IC2274.2 +052100 IF F-S-PARAM IS EQUAL "00" IC2274.2 +052200 PERFORM PASS IC2274.2 +052300 ELSE IC2274.2 +052400 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +052500 TO RE-MARK IC2274.2 +052600 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +052700 MOVE "00" TO CORRECT-A IC2274.2 +052800 PERFORM FAIL IC2274.2 +052900 END-IF. IC2274.2 +053000 GO TO EXT-FILE-TEST-02-02. IC2274.2 +053100 EXT-FILE-DELETE-02-02. IC2274.2 +053200 ADD 1 TO REC-CT IC2274.2 +053300 PERFORM DE-LETE. IC2274.2 +053400 GO TO EXT-FILE-TEST-02-END. IC2274.2 +053500 EXT-FILE-TEST-02-02. IC2274.2 +053600 ADD 1 TO REC-CT. IC2274.2 +053700 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +053800 PERFORM PASS IC2274.2 +053900 ELSE IC2274.2 +054000 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +054100 MOVE "<>" TO CORRECT-A IC2274.2 +054200 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +054300 PERFORM FAIL. IC2274.2 +054400* IC2274.2 +054500 EXT-FILE-TEST-02-END. IC2274.2 +054600* IC2274.2 +054700* IC2274.2 +054800 EXT-INIT-03. IC2274.2 +054900* IC2274.2 +055000* ************************************************* IC2274.2 +055100* * * IC2274.2 +055200* * WRITE A RECORD FROM THE MAIN PROGRAM * IC2274.2 +055300* * * IC2274.2 +055400* ************************************************* IC2274.2 +055500* IC2274.2 +055600 MOVE 1 TO REC-CT. IC2274.2 +055700 MOVE "EXTERNAL FILE WRITE" TO FEATURE. IC2274.2 +055800 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +055900 MOVE "EXT-FILE-TEST-03" TO PAR-NAME. IC2274.2 +056000 MOVE "BB" TO EXT-DATA-1 IC2274.2 +056100 MOVE "ZYXWVU" TO EXT-DATA-2 IC2274.2 +056200 MOVE 222222 TO EXT-DATA-3 IC2274.2 +056300 MOVE 9765 TO EXT-DATA-4. IC2274.2 +056400 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +056500 GO TO EXT-FILE-TEST-03-01. IC2274.2 +056600 EXT-FILE-DELETE-03. IC2274.2 +056700 PERFORM DE-LETE. IC2274.2 +056800 GO TO EXT-FILE-TEST-03-END. IC2274.2 +056900* IC2274.2 +057000 EXT-FILE-TEST-03-01. IC2274.2 +057100 WRITE EXTERNAL-FILE-RECORD. IC2274.2 +057200 IF EXTERNAL-FILE-FS IS EQUAL TO "00" IC2274.2 +057300 PERFORM PASS IC2274.2 +057400 ELSE IC2274.2 +057500 MOVE "MAIN PROGRAM FILE STATUS NON-ZERO" TO RE-MARK IC2274.2 +057600 MOVE "00" TO CORRECT-A IC2274.2 +057700 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +057800 PERFORM FAIL. IC2274.2 +057900* IC2274.2 +058000 EXT-FILE-TEST-03-END. IC2274.2 +058100* IC2274.2 +058200* IC2274.2 +058300 EXT-INIT-04. IC2274.2 +058400* IC2274.2 +058500* ************************************************* IC2274.2 +058600* * * IC2274.2 +058700* * CLOSE THE FILE THROUGH THE SUBPROGRAM * IC2274.2 +058800* * * IC2274.2 +058900* ************************************************* IC2274.2 +059000* IC2274.2 +059100 MOVE 1 TO REC-CT. IC2274.2 +059200 MOVE "EXTERNAL FILE CLOSE" TO FEATURE. IC2274.2 +059300 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +059400 MOVE "EXT-FILE-TEST-04" TO PAR-NAME. IC2274.2 +059500 MOVE "**" TO F-S-PARAM. IC2274.2 +059600 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +059700 GO TO EXT-FILE-TEST-04-01. IC2274.2 +059800 EXT-FILE-DELETE-04-01. IC2274.2 +059900 PERFORM DE-LETE. IC2274.2 +060000 CLOSE EXTERNAL-FILE. IC2274.2 +060100 GO TO EXT-FILE-DELETE-04-02. IC2274.2 +060200* IC2274.2 +060300 EXT-FILE-TEST-04-01. IC2274.2 +060400 MOVE 3 TO ACTION-CODE. IC2274.2 +060500 CALL "IC227A-1" USING CONTENT ACTION-CODE IC2274.2 +060600 EXTERNAL-RECORD-WORK IC2274.2 +060700 REFERENCE F-S-PARAM. IC2274.2 +060800 IF F-S-PARAM IS EQUAL "00" IC2274.2 +060900 PERFORM PASS IC2274.2 +061000 ELSE IC2274.2 +061100 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +061200 TO RE-MARK IC2274.2 +061300 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +061400 MOVE "00" TO CORRECT-A IC2274.2 +061500 PERFORM FAIL IC2274.2 +061600 END-IF. IC2274.2 +061700 GO TO EXT-FILE-TEST-04-02. IC2274.2 +061800 EXT-FILE-DELETE-04-02. IC2274.2 +061900 ADD 1 TO REC-CT IC2274.2 +062000 PERFORM DE-LETE. IC2274.2 +062100 GO TO EXT-FILE-TEST-04-END. IC2274.2 +062200 EXT-FILE-TEST-04-02. IC2274.2 +062300 ADD 1 TO REC-CT. IC2274.2 +062400 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +062500 PERFORM PASS IC2274.2 +062600 ELSE IC2274.2 +062700 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +062800 MOVE "<>" TO CORRECT-A IC2274.2 +062900 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +063000 PERFORM FAIL. IC2274.2 +063100* IC2274.2 +063200 EXT-FILE-TEST-04-END. IC2274.2 +063300* IC2274.2 +063400* IC2274.2 +063500 EXT-INIT-05. IC2274.2 +063600* IC2274.2 +063700* ************************************************* IC2274.2 +063800* * * IC2274.2 +063900* * OPEN FILE FOR INPUT FROM SUBPROGRAM * IC2274.2 +064000* * * IC2274.2 +064100* ************************************************* IC2274.2 +064200* IC2274.2 +064300 MOVE 1 TO REC-CT. IC2274.2 +064400 MOVE "EXTERNAL FILE OPEN" TO FEATURE. IC2274.2 +064500 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +064600 MOVE "EXT-FILE-TEST-05" TO PAR-NAME. IC2274.2 +064700 MOVE "******************" TO EXTERNAL-RECORD-WORK. IC2274.2 +064800 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-RECORD-HOLD. IC2274.2 +064900 MOVE "**" TO F-S-PARAM. IC2274.2 +065000 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +065100 GO TO EXT-FILE-TEST-05-01. IC2274.2 +065200 EXT-FILE-DELETE-05. IC2274.2 +065300 PERFORM DE-LETE. IC2274.2 +065400 OPEN INPUT EXTERNAL-FILE. IC2274.2 +065500 GO TO EXT-FILE-DELETE-05-02. IC2274.2 +065600 EXT-FILE-TEST-05-01. IC2274.2 +065700 MOVE 4 TO ACTION-CODE. IC2274.2 +065800 CALL ID1 USING BY CONTENT ACTION-CODE IC2274.2 +065900 REFERENCE EXTERNAL-RECORD-WORK IC2274.2 +066000 BY REFERENCE F-S-PARAM. IC2274.2 +066100 IF F-S-PARAM IS EQUAL "00" IC2274.2 +066200 PERFORM PASS IC2274.2 +066300 ELSE IC2274.2 +066400 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +066500 TO RE-MARK IC2274.2 +066600 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +066700 MOVE "00" TO CORRECT-A IC2274.2 +066800 PERFORM FAIL IC2274.2 +066900 END-IF. IC2274.2 +067000 GO TO EXT-FILE-TEST-05-02. IC2274.2 +067100 EXT-FILE-DELETE-05-02. IC2274.2 +067200 ADD 1 TO REC-CT IC2274.2 +067300 PERFORM DE-LETE. IC2274.2 +067400 GO TO EXT-FILE-DELETE-05-03. IC2274.2 +067500 EXT-FILE-TEST-05-02. IC2274.2 +067600 ADD 1 TO REC-CT. IC2274.2 +067700 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +067800 PERFORM PASS IC2274.2 +067900 ELSE IC2274.2 +068000 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +068100 MOVE "<>" TO CORRECT-A IC2274.2 +068200 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +068300 PERFORM FAIL. IC2274.2 +068400* GO TO EXT-FILE-TEST-05-03. IC2274.2 +068500 EXT-FILE-DELETE-05-03. IC2274.2 +068600 ADD 1 TO REC-CT. IC2274.2 +068700 PERFORM DE-LETE. IC2274.2 +068800 GO TO EXT-FILE-DELETE-05-04. IC2274.2 +068900 EXT-FILE-TEST-05-03. IC2274.2 +069000 ADD 1 TO REC-CT. IC2274.2 +069100 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2 +069200 PERFORM PASS IC2274.2 +069300 ELSE IC2274.2 +069400 MOVE "PARAMETER NOT RETURNED THROUGH RECORD AREA" IC2274.2 +069500 TO RE-MARK IC2274.2 +069600 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +069700 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +069800 PERFORM FAIL. IC2274.2 +069900 GO TO EXT-FILE-TEST-05-04. IC2274.2 +070000 EXT-FILE-DELETE-05-04. IC2274.2 +070100 ADD 1 TO REC-CT. IC2274.2 +070200 PERFORM DE-LETE. IC2274.2 +070300 GO TO EXT-FILE-TEST-05-END. IC2274.2 +070400 EXT-FILE-TEST-05-04. IC2274.2 +070500 ADD 1 TO REC-CT. IC2274.2 +070600 IF EXTERNAL-RECORD-WORK IS = "OPEN OPEN OPEN" IC2274.2 +070700 PERFORM PASS IC2274.2 +070800 ELSE IC2274.2 +070900 MOVE "PARAMETER RETURN INCORRECT" TO RE-MARK IC2274.2 +071000 MOVE "OPEN OPEN OPEN" TO CORRECT-A IC2274.2 +071100 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2 +071200 PERFORM FAIL. IC2274.2 +071300* IC2274.2 +071400 EXT-FILE-TEST-05-END. IC2274.2 +071500* IC2274.2 +071600* IC2274.2 +071700 EXT-INIT-06. IC2274.2 +071800* IC2274.2 +071900* ************************************************* IC2274.2 +072000* * * IC2274.2 +072100* * READ THE FIRST RECORD FROM THE FILE WITH * IC2274.2 +072200* * THE MAIN PROGRAM . * IC2274.2 +072300* * * IC2274.2 +072400* ************************************************* IC2274.2 +072500* IC2274.2 +072600 MOVE 1 TO REC-CT. IC2274.2 +072700 MOVE "EXTERNAL FILE READ" TO FEATURE. IC2274.2 +072800 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +072900 MOVE "EXT-FILE-TEST-06" TO PAR-NAME. IC2274.2 +073000 MOVE "%%%%%%%%%%%%%%%%%%" TO EXTERNAL-FILE-RECORD. IC2274.2 +073100 MOVE "AAPQRSTU1234569876" TO EXTERNAL-RECORD-HOLD. IC2274.2 +073200 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +073300 GO TO EXT-FILE-TEST-06-01. IC2274.2 +073400 EXT-FILE-DELETE-06. IC2274.2 +073500 PERFORM DE-LETE. IC2274.2 +073600 GO TO EXT-FILE-DELETE-06-02. IC2274.2 +073700 EXT-FILE-TEST-06-01. IC2274.2 +073800 READ EXTERNAL-FILE NEXT RECORD IC2274.2 +073900 AT END GO TO EXT-FILE-TEST-06-02. IC2274.2 +074000 IF EXTERNAL-FILE-FS IS EQUAL "00" IC2274.2 +074100 PERFORM PASS IC2274.2 +074200 ELSE IC2274.2 +074300 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +074400 TO RE-MARK IC2274.2 +074500 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +074600 MOVE "00" TO CORRECT-A IC2274.2 +074700 PERFORM FAIL IC2274.2 +074800 END-IF. IC2274.2 +074900 GO TO EXT-FILE-TEST-06-02. IC2274.2 +075000 EXT-FILE-DELETE-06-02. IC2274.2 +075100 ADD 1 TO REC-CT IC2274.2 +075200 PERFORM DE-LETE. IC2274.2 +075300 GO TO EXT-FILE-TEST-06-END. IC2274.2 +075400 EXT-FILE-TEST-06-02. IC2274.2 +075500 ADD 1 TO REC-CT. IC2274.2 +075600 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2 +075700 PERFORM PASS IC2274.2 +075800 ELSE IC2274.2 +075900 MOVE "EXPECTED RECORD NOT READ FROM FILE" IC2274.2 +076000 TO RE-MARK IC2274.2 +076100 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +076200 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +076300 PERFORM FAIL. IC2274.2 +076400* IC2274.2 +076500 EXT-FILE-TEST-06-END. IC2274.2 +076600* IC2274.2 +076700* IC2274.2 +076800 EXT-INIT-07. IC2274.2 +076900* IC2274.2 +077000* ************************************************* IC2274.2 +077100* * * IC2274.2 +077200* * READ SECOND RECORD FROM THE FILE THROUGH * IC2274.2 +077300* * THE SUBPROGRAM * IC2274.2 +077400* * * IC2274.2 +077500* ************************************************* IC2274.2 +077600* IC2274.2 +077700 MOVE 1 TO REC-CT. IC2274.2 +077800 MOVE "EXTERNAL FILE READ" TO FEATURE. IC2274.2 +077900 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +078000 MOVE "EXT-FILE-TEST-07" TO PAR-NAME. IC2274.2 +078100 MOVE "%%%%%%%%%%%%%%%%%%" TO EXTERNAL-FILE-RECORD. IC2274.2 +078200 MOVE ";;;;;;;;;;;;;;;;;;" TO EXTERNAL-RECORD-WORK. IC2274.2 +078300 MOVE "BBZYXWVU2222229765" TO EXTERNAL-RECORD-HOLD. IC2274.2 +078400 MOVE "**" TO F-S-PARAM. IC2274.2 +078500 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +078600 GO TO EXT-FILE-TEST-07-01. IC2274.2 +078700 EXT-FILE-DELETE-07. IC2274.2 +078800 PERFORM DE-LETE. IC2274.2 +078900 GO TO EXT-FILE-DELETE-07-02. IC2274.2 +079000 EXT-FILE-TEST-07-01. IC2274.2 +079100 MOVE 5 TO ACTION-CODE. IC2274.2 +079200 CALL ID1 USING BY CONTENT ACTION-CODE IC2274.2 +079300 REFERENCE EXTERNAL-RECORD-WORK IC2274.2 +079400 BY REFERENCE F-S-PARAM. IC2274.2 +079500 IF F-S-PARAM IS EQUAL "00" IC2274.2 +079600 PERFORM PASS IC2274.2 +079700 ELSE IC2274.2 +079800 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +079900 TO RE-MARK IC2274.2 +080000 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +080100 MOVE "00" TO CORRECT-A IC2274.2 +080200 PERFORM FAIL IC2274.2 +080300 END-IF. IC2274.2 +080400 GO TO EXT-FILE-TEST-07-02. IC2274.2 +080500 EXT-FILE-DELETE-07-02. IC2274.2 +080600 ADD 1 TO REC-CT IC2274.2 +080700 PERFORM DE-LETE. IC2274.2 +080800 GO TO EXT-FILE-DELETE-07-03. IC2274.2 +080900 EXT-FILE-TEST-07-02. IC2274.2 +081000 ADD 1 TO REC-CT. IC2274.2 +081100 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +081200 PERFORM PASS IC2274.2 +081300 ELSE IC2274.2 +081400 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +081500 MOVE "<>" TO CORRECT-A IC2274.2 +081600 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +081700 PERFORM FAIL. IC2274.2 +081800 GO TO EXT-FILE-TEST-07-03. IC2274.2 +081900 EXT-FILE-DELETE-07-03. IC2274.2 +082000 ADD 1 TO REC-CT. IC2274.2 +082100 PERFORM DE-LETE. IC2274.2 +082200 GO TO EXT-FILE-DELETE-07-04. IC2274.2 +082300 EXT-FILE-TEST-07-03. IC2274.2 +082400 ADD 1 TO REC-CT. IC2274.2 +082500 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2 +082600 PERFORM PASS IC2274.2 +082700 ELSE IC2274.2 +082800 MOVE "EXPECTED RECORD NOT RETURNED THROUGH RECORD AREA" IC2274.2 +082900 TO RE-MARK IC2274.2 +083000 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +083100 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +083200 PERFORM FAIL. IC2274.2 +083300 GO TO EXT-FILE-TEST-07-04. IC2274.2 +083400 EXT-FILE-DELETE-07-04. IC2274.2 +083500 ADD 1 TO REC-CT. IC2274.2 +083600 PERFORM DE-LETE. IC2274.2 +083700 GO TO EXT-FILE-TEST-07-END. IC2274.2 +083800 EXT-FILE-TEST-07-04. IC2274.2 +083900 ADD 1 TO REC-CT. IC2274.2 +084000 IF EXTERNAL-RECORD-WORK IS = EXTERNAL-RECORD-HOLD IC2274.2 +084100 PERFORM PASS IC2274.2 +084200 ELSE IC2274.2 +084300 MOVE "PARAMETER RETURN INCORRECT" TO RE-MARK IC2274.2 +084400 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +084500 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2 +084600 PERFORM FAIL. IC2274.2 +084700* IC2274.2 +084800 EXT-FILE-TEST-07-END. IC2274.2 +084900* IC2274.2 +085000* IC2274.2 +085100 EXT-INIT-08. IC2274.2 +085200* IC2274.2 +085300* ************************************************* IC2274.2 +085400* * * IC2274.2 +085500* * ATTEMPT TO READ A THIRD RECORD FROM THE * IC2274.2 +085600* * FILE THROUGH THE SUBPROGRAM. THIS SHOULD * IC2274.2 +085700* * CAUSE AN END OF FILE CONDITION. * IC2274.2 +085800* * * IC2274.2 +085900* ************************************************* IC2274.2 +086000* IC2274.2 +086100 MOVE 1 TO REC-CT. IC2274.2 +086200 MOVE "EXTERNAL FILE EOF" TO FEATURE. IC2274.2 +086300 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +086400 MOVE "EXT-FILE-TEST-08" TO PAR-NAME. IC2274.2 +086500 MOVE "%%%%%%%%%%%%%%%%%%" TO EXTERNAL-FILE-RECORD. IC2274.2 +086600 MOVE ";;;;;;;;;;;;;;;;;;" TO EXTERNAL-RECORD-WORK. IC2274.2 +086700 MOVE "END-FILE END-FILE" TO EXTERNAL-RECORD-HOLD. IC2274.2 +086800 MOVE "**" TO F-S-PARAM. IC2274.2 +086900 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +087000 GO TO EXT-FILE-TEST-08-01. IC2274.2 +087100 EXT-FILE-DELETE-08. IC2274.2 +087200 PERFORM DE-LETE. IC2274.2 +087300 GO TO EXT-FILE-DELETE-08-02. IC2274.2 +087400 EXT-FILE-TEST-08-01. IC2274.2 +087500 MOVE 5 TO ACTION-CODE. IC2274.2 +087600 CALL "IC227A-1" USING CONTENT ACTION-CODE IC2274.2 +087700 REFERENCE EXTERNAL-RECORD-WORK IC2274.2 +087800 BY REFERENCE F-S-PARAM. IC2274.2 +087900 IF F-S-PARAM IS EQUAL "10" IC2274.2 +088000 PERFORM PASS IC2274.2 +088100 ELSE IC2274.2 +088200 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2 +088300 TO RE-MARK IC2274.2 +088400 MOVE F-S-PARAM TO COMPUTED-A IC2274.2 +088500 MOVE "10" TO CORRECT-A IC2274.2 +088600 PERFORM FAIL IC2274.2 +088700 END-IF. IC2274.2 +088800 GO TO EXT-FILE-TEST-08-02. IC2274.2 +088900 EXT-FILE-DELETE-08-02. IC2274.2 +089000 ADD 1 TO REC-CT IC2274.2 +089100 PERFORM DE-LETE. IC2274.2 +089200 GO TO EXT-FILE-DELETE-08-03. IC2274.2 +089300 EXT-FILE-TEST-08-02. IC2274.2 +089400 ADD 1 TO REC-CT. IC2274.2 +089500 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2 +089600 PERFORM PASS IC2274.2 +089700 ELSE IC2274.2 +089800 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2 +089900 MOVE "<>" TO CORRECT-A IC2274.2 +090000 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +090100 PERFORM FAIL. IC2274.2 +090200* GO TO EXT-FILE-TEST-08-03. IC2274.2 +090300 EXT-FILE-DELETE-08-03. IC2274.2 +090400 ADD 1 TO REC-CT. IC2274.2 +090500 PERFORM DE-LETE. IC2274.2 +090600 GO TO EXT-FILE-DELETE-08-04. IC2274.2 +090700 EXT-FILE-TEST-08-03. IC2274.2 +090800 ADD 1 TO REC-CT. IC2274.2 +090900 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2 +091000 PERFORM PASS IC2274.2 +091100 ELSE IC2274.2 +091200 MOVE "EXPECTED VALUE NOT RETURNED THROUGH RECORD AREA" IC2274.2 +091300 TO RE-MARK IC2274.2 +091400 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2 +091500 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +091600 PERFORM FAIL. IC2274.2 +091700* GO TO EXT-FILE-TEST-08-04. IC2274.2 +091800 EXT-FILE-DELETE-08-04. IC2274.2 +091900 ADD 1 TO REC-CT. IC2274.2 +092000 PERFORM DE-LETE. IC2274.2 +092100 GO TO EXT-FILE-TEST-08-END. IC2274.2 +092200 EXT-FILE-TEST-08-04. IC2274.2 +092300 ADD 1 TO REC-CT. IC2274.2 +092400 IF EXTERNAL-RECORD-WORK IS = EXTERNAL-RECORD-HOLD IC2274.2 +092500 PERFORM PASS IC2274.2 +092600 ELSE IC2274.2 +092700 MOVE "PARAMETER RETURN INCORRECT" TO RE-MARK IC2274.2 +092800 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2 +092900 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2 +093000 PERFORM FAIL. IC2274.2 +093100* IC2274.2 +093200 EXT-FILE-TEST-08-END. IC2274.2 +093300* IC2274.2 +093400* IC2274.2 +093500 EXT-INIT-09. IC2274.2 +093600* IC2274.2 +093700* ************************************************* IC2274.2 +093800* * * IC2274.2 +093900* * CLOSE THE EXTERNAL FILE FROM THE MAIN * IC2274.2 +094000* * PROGRAM. * IC2274.2 +094100* * * IC2274.2 +094200* ************************************************* IC2274.2 +094300* IC2274.2 +094400 MOVE 1 TO REC-CT. IC2274.2 +094500 MOVE "EXTERNAL FILE CLOSE" TO FEATURE. IC2274.2 +094600 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2 +094700 MOVE "EXT-FILE-TEST-09" TO PAR-NAME. IC2274.2 +094800 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2 +094900 GO TO EXT-FILE-TEST-09-01. IC2274.2 +095000 EXT-FILE-DELETE-09. IC2274.2 +095100 PERFORM DE-LETE. IC2274.2 +095200 GO TO EXT-FILE-TEST-09-END. IC2274.2 +095300 EXT-FILE-TEST-09-01. IC2274.2 +095400 CLOSE EXTERNAL-FILE. IC2274.2 +095500 IF EXTERNAL-FILE-FS IS EQUAL TO "00" IC2274.2 +095600 PERFORM PASS IC2274.2 +095700 ELSE IC2274.2 +095800 MOVE "FILE CLOSE FAILURE" TO RE-MARK IC2274.2 +095900 MOVE "00" TO CORRECT-A IC2274.2 +096000 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2 +096100 PERFORM FAIL. IC2274.2 +096200 EXT-FILE-TEST-09-END. IC2274.2 +096300* IC2274.2 +096400* IC2274.2 +096500 CCVS-EXIT SECTION. IC2274.2 +096600 CCVS-999999. IC2274.2 +096700 GO TO CLOSE-FILES. IC2274.2 +096800 END PROGRAM IC227A. IC2274.2 +096900 IDENTIFICATION DIVISION. IC2274.2 +097000 PROGRAM-ID. IC2274.2 +097100 IC227A-1. IC2274.2 +097200**************************************************************** IC2274.2 +097300* * IC2274.2 +097400* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2274.2 +097500* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2274.2 +097600* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2274.2 +097700* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2274.2 +097800* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2274.2 +097900* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2274.2 +098000* * IC2274.2 +098100* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2274.2 +098200* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2274.2 +098300* DOCUMENT REFERENCE: ISO-1989-1978). * IC2274.2 +098400* * IC2274.2 +098500* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2274.2 +098600* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2274.2 +098700* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2274.2 +098800* * IC2274.2 +098900* THE FEDERAL SOFTWARE TESTING CENTER * IC2274.2 +099000* OFFICE OF SOFTWARE DEVELOPMENT * IC2274.2 +099100* & INFORMATION TECHNOLOGY * IC2274.2 +099200* TWO SKYLINE PLACE * IC2274.2 +099300* SUITE 1100 * IC2274.2 +099400* 5203 LEESBURG PIKE * IC2274.2 +099500* FALLS CHURCH * IC2274.2 +099600* VA 22041 * IC2274.2 +099700* U.S.A. * IC2274.2 +099800* * IC2274.2 +099900* THE PROJECT TEAM MEMBERS WERE: * IC2274.2 +100000* * IC2274.2 +100100* BIADI (BUREAU INTER ADMINISTRATION * IC2274.2 +100200* DE DOCUMENTATION INFORMATIQUE) * IC2274.2 +100300* 21 RUE BARA * IC2274.2 +100400* F-92132 ISSY * IC2274.2 +100500* FRANCE * IC2274.2 +100600* * IC2274.2 +100700* * IC2274.2 +100800* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2274.2 +100900* UND DATENVERARBEITUNG MBH) * IC2274.2 +101000* SCHLOSS BIRLINGHOVEN * IC2274.2 +101100* POSTFACH 12 40 * IC2274.2 +101200* D-5205 ST. AUGUSTIN 1 * IC2274.2 +101300* GERMANY FR * IC2274.2 +101400* * IC2274.2 +101500* * IC2274.2 +101600* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2274.2 +101700* OXFORD ROAD * IC2274.2 +101800* MANCHESTER * IC2274.2 +101900* M1 7ED * IC2274.2 +102000* UNITED KINGDOM * IC2274.2 +102100* * IC2274.2 +102200* * IC2274.2 +102300* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2274.2 +102400* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2274.2 +102500* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2274.2 +102600* * IC2274.2 +102700* REVISED 1986 AUGUST * IC2274.2 +102800* * IC2274.2 +102900**************************************************************** IC2274.2 +103000* * IC2274.2 +103100* VALIDATION FOR:- * IC2274.2 +103200* * IC2274.2 +103300* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2 +103400* * IC2274.2 +103500* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2274.2 +103600* * IC2274.2 +103700**************************************************************** IC2274.2 +103800* * IC2274.2 +103900* X-CARDS USED BY THIS PROGRAM ARE :- * IC2274.2 +104000* * IC2274.2 +104100* X-82 SOURCE-COMPUTER * IC2274.2 +104200* X-83 OBJECT-COMPUTER. * IC2274.2 +104300* * IC2274.2 +104400**************************************************************** IC2274.2 +104500* * IC2274.2 +104600* PROGRAMS IC227A AND IC227A-1 TEST LEVEL 2 LANGUAGE * IC2274.2 +104700* ELEMENTS FROM THE INTER-PROGRAM COMMUNICATION MODULE. * IC2274.2 +104800* THE PARTICULAR ELEMENTS TESTED ARE: * IC2274.2 +104900* THE "EXTERNAL" CLAUSE IN THE FILE DESCRIPTION ENTRY * IC2274.2 +105000* * IC2274.2 +105100* ALTHOUGH IC227A AND IC227A-1 ARE SEPARATELY COMPILED * IC2274.2 +105200* PROGRAMS, BOTH ARE INTENDED TO BE COMPILED BY THE SAME * IC2274.2 +105300* INVOCATION OF THE COMPILER, IN ORDER TO TEST STREAM * IC2274.2 +105400* COMPILATION AND RECOGNITION OF THE END PROGRAM HEADER. * IC2274.2 +105500* * IC2274.2 +105600* THE STRUCTURE OF THE SOURCE FILE IS: * IC2274.2 +105700* * IC2274.2 +105800* IDENTIFICATION DIVISION. * IC2274.2 +105900* PROGRAM-ID. IC227A. * IC2274.2 +106000* . * IC2274.2 +106100* . * IC2274.2 +106200* . * IC2274.2 +106300* END PROGRAM IC227A. * IC2274.2 +106400* IDENTIFICATION DIVISION. * IC2274.2 +106500* PROGRAM-ID. IC227A-1. * IC2274.2 +106600* . * IC2274.2 +106700* . * IC2274.2 +106800* . * IC2274.2 +106900* END PROGRAM IC227A-1. * IC2274.2 +107000* * IC2274.2 +107100**************************************************************** IC2274.2 +107200* IC2274.2 +107300 ENVIRONMENT DIVISION. IC2274.2 +107400 CONFIGURATION SECTION. IC2274.2 +107500 SOURCE-COMPUTER. IC2274.2 +107600 Linux. IC2274.2 +107700 OBJECT-COMPUTER. IC2274.2 +107800 Linux. IC2274.2 +107900* IC2274.2 +108000 INPUT-OUTPUT SECTION. IC2274.2 +108100 FILE-CONTROL. IC2274.2 +108200 SELECT EXTERNAL-FILE ASSIGN TO IC2274.2 +108300 "XXXXX014" IC2274.2 +108400 FILE STATUS IS LINKAGE-FS. IC2274.2 +108500* IC2274.2 +108600 DATA DIVISION. IC2274.2 +108700 FILE SECTION. IC2274.2 +108800 FD EXTERNAL-FILE IC2274.2 +108900 IS EXTERNAL IC2274.2 +109000 RECORD CONTAINS 18 CHARACTERS. IC2274.2 +109100 01 EXTERNAL-FILE-RECORD. IC2274.2 +109200 03 EXT-DATA-1 PIC X(2). IC2274.2 +109300 03 EXT-DATA-2 PIC X(6). IC2274.2 +109400 03 EXT-DATA-3 PIC 9(6). IC2274.2 +109500 03 EXT-DATA-4 PIC 9(4). IC2274.2 +109600* IC2274.2 +109700 WORKING-STORAGE SECTION. IC2274.2 +109800* IC2274.2 +109900*************************************************************** IC2274.2 +110000* * IC2274.2 +110100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * IC2274.2 +110200* * IC2274.2 +110300*************************************************************** IC2274.2 +110400* IC2274.2 +110500 01 EXTERNAL-RECORD-WORK. IC2274.2 +110600 03 WRK-DATA-1 PIC X(2). IC2274.2 +110700 03 WRK-DATA-2 PIC X(6). IC2274.2 +110800 03 WRK-DATA-3 PIC 9(6). IC2274.2 +110900 03 WRK-DATA-4 PIC 9(4). IC2274.2 +111000* IC2274.2 +111100 LINKAGE SECTION. IC2274.2 +111200* IC2274.2 +111300 01 LINKAGE-RECORD-WORK. IC2274.2 +111400 05 WRK-DATA-1 PIC X(2). IC2274.2 +111500 05 WRK-DATA-2 PIC X(6). IC2274.2 +111600 05 WRK-DATA-3 PIC 9(6). IC2274.2 +111700 05 WRK-DATA-4 PIC 9(4). IC2274.2 +111800* IC2274.2 +111900 01 LINKAGE-FS PIC XX. IC2274.2 +112000 01 ACTION-CODE PIC 99. IC2274.2 +112100* IC2274.2 +112200* IC2274.2 +112300 PROCEDURE DIVISION USING ACTION-CODE IC2274.2 +112400 LINKAGE-RECORD-WORK IC2274.2 +112500 LINKAGE-FS. IC2274.2 +112600* IC2274.2 +112700 SECT-IC227A-1-01 SECTION. IC2274.2 +112800 EXT-DECODE-01. IC2274.2 +112900* IC2274.2 +113000* ************************************************* IC2274.2 +113100* * * IC2274.2 +113200* * USE THE ACTION CODE PARAMETER TO IDENTIFY * IC2274.2 +113300* * THE FUNCTION REQUIRED ON THIS ENTRY. * IC2274.2 +113400* * * IC2274.2 +113500* ************************************************* IC2274.2 +113600* IC2274.2 +113700 GO TO SUBPROGRAM-FUNCTION-01 IC2274.2 +113800 SUBPROGRAM-FUNCTION-02 IC2274.2 +113900 SUBPROGRAM-FUNCTION-03 IC2274.2 +114000 SUBPROGRAM-FUNCTION-04 IC2274.2 +114100 SUBPROGRAM-FUNCTION-05 IC2274.2 +114200 DEPENDING ON ACTION-CODE. IC2274.2 +114300* IC2274.2 +114400* CONTROL SHOULD NEVER REACH HERE, BUT ... IC2274.2 +114500* IC2274.2 +114600 MOVE "FFFFFFFFFFFFFFFFFF" TO LINKAGE-RECORD-WORK IC2274.2 +114700 MOVE "FF" TO LINKAGE-FS IC2274.2 +114800 EXIT PROGRAM. IC2274.2 +114900* IC2274.2 +115000* IC2274.2 +115100 SUBPROGRAM-FUNCTION-01. IC2274.2 +115200 MOVE EXTERNAL-FILE-RECORD TO EXTERNAL-RECORD-WORK IC2274.2 +115300 MOVE LINKAGE-RECORD-WORK TO EXTERNAL-FILE-RECORD IC2274.2 +115400 MOVE EXTERNAL-RECORD-WORK TO LINKAGE-RECORD-WORK. IC2274.2 +115500 MOVE "XX" TO LINKAGE-FS. IC2274.2 +115600 EXIT PROGRAM. IC2274.2 +115700* IC2274.2 +115800* IC2274.2 +115900 SUBPROGRAM-FUNCTION-02. IC2274.2 +116000* IC2274.2 +116100* WRITE A RECORD TO THE EXTERNAL FILE IC2274.2 +116200* IC2274.2 +116300 MOVE LINKAGE-RECORD-WORK TO EXTERNAL-FILE-RECORD. IC2274.2 +116400 WRITE EXTERNAL-FILE-RECORD. IC2274.2 +116500 EXIT PROGRAM. IC2274.2 +116600* IC2274.2 +116700* IC2274.2 +116800 SUBPROGRAM-FUNCTION-03. IC2274.2 +116900* IC2274.2 +117000* CLOSE THE EXTERNAL FILE IC2274.2 +117100* IC2274.2 +117200 CLOSE EXTERNAL-FILE. IC2274.2 +117300 EXIT PROGRAM. IC2274.2 +117400* IC2274.2 +117500* IC2274.2 +117600 SUBPROGRAM-FUNCTION-04. IC2274.2 +117700* IC2274.2 +117800* OPEN THE EXTERNAL FILE FOR INPUT IC2274.2 +117900* IC2274.2 +118000 OPEN INPUT EXTERNAL-FILE. IC2274.2 +118100 MOVE "OPEN OPEN OPEN" TO EXTERNAL-FILE-RECORD. IC2274.2 +118200 MOVE EXTERNAL-FILE-RECORD TO LINKAGE-RECORD-WORK. IC2274.2 +118300 EXIT PROGRAM. IC2274.2 +118400* IC2274.2 +118500* IC2274.2 +118600 SUBPROGRAM-FUNCTION-05. IC2274.2 +118700* IC2274.2 +118800* READ A RECORD FROM THE EXTERNAL FILE IC2274.2 +118900* IC2274.2 +119000 READ EXTERNAL-FILE IC2274.2 +119100 AT END GO TO SUBPROGRAM-FUNCTION-05-EOF. IC2274.2 +119200 MOVE EXTERNAL-FILE-RECORD TO LINKAGE-RECORD-WORK. IC2274.2 +119300 EXIT PROGRAM. IC2274.2 +119400* IC2274.2 +119500 SUBPROGRAM-FUNCTION-05-EOF. IC2274.2 +119600 MOVE EXTERNAL-FILE-RECORD TO LINKAGE-RECORD-WORK. IC2274.2 +119700 MOVE "END-FILE END-FILE" TO EXTERNAL-FILE-RECORD. IC2274.2 +119800 EXIT PROGRAM. IC2274.2 +119900* IC2274.2 +120000 END PROGRAM IC227A-1. IC2274.2 diff --git a/tests/cobol85/IC/IC228A.CBL b/tests/cobol85/IC/IC228A.CBL new file mode 100755 index 00000000..61f9678e --- /dev/null +++ b/tests/cobol85/IC/IC228A.CBL @@ -0,0 +1,445 @@ +000100 IDENTIFICATION DIVISION. IC2284.2 +000200 PROGRAM-ID. IC2284.2 +000300 IC228A. IC2284.2 +000400**************************************************************** IC2284.2 +000500* * IC2284.2 +000600* VALIDATION FOR:- * IC2284.2 +000700* * IC2284.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2284.2 +000900* * IC2284.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2284.2 +001100* * IC2284.2 +001200**************************************************************** IC2284.2 +001300* * IC2284.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2284.2 +001500* * IC2284.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2284.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2284.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2284.2 +001900* * IC2284.2 +002000**************************************************************** IC2284.2 +002100* * IC2284.2 +002200* PROGRAM IC228A AND IC228A-1 WILL TEST THE NEW LANGUAGE * IC2284.2 +002300* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2284.2 +002400* MODULE. * IC2284.2 +002500* THE NEW LANGUAGE ELEMENT TO BE TESTED WILL BE: * IC2284.2 +002600* THE "GLOBAL" PHRASE IN WORKING-STORAGE. * IC2284.2 +002700* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2284.2 +002800* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2284.2 +002900* IDENTIFICATION DIVISION. * IC2284.2 +003000* PROGRAM-ID. IC228A. * IC2284.2 +003100* . * IC2284.2 +003200* . * IC2284.2 +003300* . * IC2284.2 +003400* IDENTIFICATION DIVISION. * IC2284.2 +003500* PROGRAM-ID. IC228A-1. * IC2284.2 +003600* . * IC2284.2 +003700* . * IC2284.2 +003800* . * IC2284.2 +003900* END PROGRAM IC228A-1. * IC2284.2 +004000* END PROGRAM IC228A. * IC2284.2 +004100**************************************************************** IC2284.2 +004200 ENVIRONMENT DIVISION. IC2284.2 +004300 CONFIGURATION SECTION. IC2284.2 +004400 SOURCE-COMPUTER. IC2284.2 +004500 Linux. IC2284.2 +004600 OBJECT-COMPUTER. IC2284.2 +004700 Linux. IC2284.2 +004800 INPUT-OUTPUT SECTION. IC2284.2 +004900 FILE-CONTROL. IC2284.2 +005000 SELECT PRINT-FILE ASSIGN TO IC2284.2 +005100 "report.log". IC2284.2 +005200 DATA DIVISION. IC2284.2 +005300 FILE SECTION. IC2284.2 +005400 FD PRINT-FILE. IC2284.2 +005500 01 PRINT-REC PICTURE X(120). IC2284.2 +005600 01 DUMMY-RECORD PICTURE X(120). IC2284.2 +005700 WORKING-STORAGE SECTION. IC2284.2 +005800 01 GLOBAL-DATA IS GLOBAL. IC2284.2 +005900 03 GLO-DATA-1 PIC X(2). IC2284.2 +006000 03 GLO-DATA-2 PIC X(6). IC2284.2 +006100 88 CHANGE-MADE-OK VALUE "CHANGE". IC2284.2 +006200 03 GLO-DATA-3 PIC 9(8). IC2284.2 +006300 03 GLO-DATA-4 PIC 9(4). IC2284.2 +006400 01 SUB PIC 9(4) VALUE ZERO. IC2284.2 +006500* IC2284.2 +006600 01 TEST-RESULTS. IC2284.2 +006700 02 FILLER PIC X VALUE SPACE. IC2284.2 +006800 02 FEATURE PIC X(20) VALUE SPACE. IC2284.2 +006900 02 FILLER PIC X VALUE SPACE. IC2284.2 +007000 02 P-OR-F PIC X(5) VALUE SPACE. IC2284.2 +007100 02 FILLER PIC X VALUE SPACE. IC2284.2 +007200 02 PAR-NAME. IC2284.2 +007300 03 FILLER PIC X(19) VALUE SPACE. IC2284.2 +007400 03 PARDOT-X PIC X VALUE SPACE. IC2284.2 +007500 03 DOTVALUE PIC 99 VALUE ZERO. IC2284.2 +007600 02 FILLER PIC X(8) VALUE SPACE. IC2284.2 +007700 02 RE-MARK PIC X(61). IC2284.2 +007800 01 TEST-COMPUTED. IC2284.2 +007900 02 FILLER PIC X(30) VALUE SPACE. IC2284.2 +008000 02 FILLER PIC X(17) VALUE IC2284.2 +008100 " COMPUTED=". IC2284.2 +008200 02 COMPUTED-X. IC2284.2 +008300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2284.2 +008400 03 COMPUTED-N REDEFINES COMPUTED-A IC2284.2 +008500 PIC -9(9).9(9). IC2284.2 +008600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2284.2 +008700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2284.2 +008800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2284.2 +008900 03 CM-18V0 REDEFINES COMPUTED-A. IC2284.2 +009000 04 COMPUTED-18V0 PIC -9(18). IC2284.2 +009100 04 FILLER PIC X. IC2284.2 +009200 03 FILLER PIC X(50) VALUE SPACE. IC2284.2 +009300 01 TEST-CORRECT. IC2284.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IC2284.2 +009500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2284.2 +009600 02 CORRECT-X. IC2284.2 +009700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2284.2 +009800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2284.2 +009900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2284.2 +010000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2284.2 +010100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2284.2 +010200 03 CR-18V0 REDEFINES CORRECT-A. IC2284.2 +010300 04 CORRECT-18V0 PIC -9(18). IC2284.2 +010400 04 FILLER PIC X. IC2284.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IC2284.2 +010600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2284.2 +010700 01 CCVS-C-1. IC2284.2 +010800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2284.2 +010900- "SS PARAGRAPH-NAME IC2284.2 +011000- " REMARKS". IC2284.2 +011100 02 FILLER PIC X(20) VALUE SPACE. IC2284.2 +011200 01 CCVS-C-2. IC2284.2 +011300 02 FILLER PIC X VALUE SPACE. IC2284.2 +011400 02 FILLER PIC X(6) VALUE "TESTED". IC2284.2 +011500 02 FILLER PIC X(15) VALUE SPACE. IC2284.2 +011600 02 FILLER PIC X(4) VALUE "FAIL". IC2284.2 +011700 02 FILLER PIC X(94) VALUE SPACE. IC2284.2 +011800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2284.2 +011900 01 REC-CT PIC 99 VALUE ZERO. IC2284.2 +012000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2284.2 +012100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2284.2 +012200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2284.2 +012300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2284.2 +012400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2284.2 +012500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2284.2 +012600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2284.2 +012700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2284.2 +012800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2284.2 +012900 01 CCVS-H-1. IC2284.2 +013000 02 FILLER PIC X(39) VALUE SPACES. IC2284.2 +013100 02 FILLER PIC X(42) VALUE IC2284.2 +013200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2284.2 +013300 02 FILLER PIC X(39) VALUE SPACES. IC2284.2 +013400 01 CCVS-H-2A. IC2284.2 +013500 02 FILLER PIC X(40) VALUE SPACE. IC2284.2 +013600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2284.2 +013700 02 FILLER PIC XXXX VALUE IC2284.2 +013800 "4.2 ". IC2284.2 +013900 02 FILLER PIC X(28) VALUE IC2284.2 +014000 " COPY - NOT FOR DISTRIBUTION". IC2284.2 +014100 02 FILLER PIC X(41) VALUE SPACE. IC2284.2 +014200 IC2284.2 +014300 01 CCVS-H-2B. IC2284.2 +014400 02 FILLER PIC X(15) VALUE IC2284.2 +014500 "TEST RESULT OF ". IC2284.2 +014600 02 TEST-ID PIC X(9). IC2284.2 +014700 02 FILLER PIC X(4) VALUE IC2284.2 +014800 " IN ". IC2284.2 +014900 02 FILLER PIC X(12) VALUE IC2284.2 +015000 " HIGH ". IC2284.2 +015100 02 FILLER PIC X(22) VALUE IC2284.2 +015200 " LEVEL VALIDATION FOR ". IC2284.2 +015300 02 FILLER PIC X(58) VALUE IC2284.2 +015400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2284.2 +015500 01 CCVS-H-3. IC2284.2 +015600 02 FILLER PIC X(34) VALUE IC2284.2 +015700 " FOR OFFICIAL USE ONLY ". IC2284.2 +015800 02 FILLER PIC X(58) VALUE IC2284.2 +015900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2284.2 +016000 02 FILLER PIC X(28) VALUE IC2284.2 +016100 " COPYRIGHT 1985 ". IC2284.2 +016200 01 CCVS-E-1. IC2284.2 +016300 02 FILLER PIC X(52) VALUE SPACE. IC2284.2 +016400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2284.2 +016500 02 ID-AGAIN PIC X(9). IC2284.2 +016600 02 FILLER PIC X(45) VALUE SPACES. IC2284.2 +016700 01 CCVS-E-2. IC2284.2 +016800 02 FILLER PIC X(31) VALUE SPACE. IC2284.2 +016900 02 FILLER PIC X(21) VALUE SPACE. IC2284.2 +017000 02 CCVS-E-2-2. IC2284.2 +017100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2284.2 +017200 03 FILLER PIC X VALUE SPACE. IC2284.2 +017300 03 ENDER-DESC PIC X(44) VALUE IC2284.2 +017400 "ERRORS ENCOUNTERED". IC2284.2 +017500 01 CCVS-E-3. IC2284.2 +017600 02 FILLER PIC X(22) VALUE IC2284.2 +017700 " FOR OFFICIAL USE ONLY". IC2284.2 +017800 02 FILLER PIC X(12) VALUE SPACE. IC2284.2 +017900 02 FILLER PIC X(58) VALUE IC2284.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2284.2 +018100 02 FILLER PIC X(13) VALUE SPACE. IC2284.2 +018200 02 FILLER PIC X(15) VALUE IC2284.2 +018300 " COPYRIGHT 1985". IC2284.2 +018400 01 CCVS-E-4. IC2284.2 +018500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2284.2 +018600 02 FILLER PIC X(4) VALUE " OF ". IC2284.2 +018700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2284.2 +018800 02 FILLER PIC X(40) VALUE IC2284.2 +018900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2284.2 +019000 01 XXINFO. IC2284.2 +019100 02 FILLER PIC X(19) VALUE IC2284.2 +019200 "*** INFORMATION ***". IC2284.2 +019300 02 INFO-TEXT. IC2284.2 +019400 04 FILLER PIC X(8) VALUE SPACE. IC2284.2 +019500 04 XXCOMPUTED PIC X(20). IC2284.2 +019600 04 FILLER PIC X(5) VALUE SPACE. IC2284.2 +019700 04 XXCORRECT PIC X(20). IC2284.2 +019800 02 INF-ANSI-REFERENCE PIC X(48). IC2284.2 +019900 01 HYPHEN-LINE. IC2284.2 +020000 02 FILLER PIC IS X VALUE IS SPACE. IC2284.2 +020100 02 FILLER PIC IS X(65) VALUE IS "************************IC2284.2 +020200- "*****************************************". IC2284.2 +020300 02 FILLER PIC IS X(54) VALUE IS "************************IC2284.2 +020400- "******************************". IC2284.2 +020500 01 CCVS-PGM-ID PIC X(9) VALUE IC2284.2 +020600 "IC228A". IC2284.2 +020700 PROCEDURE DIVISION. IC2284.2 +020800 CCVS1 SECTION. IC2284.2 +020900 OPEN-FILES. IC2284.2 +021000 OPEN OUTPUT PRINT-FILE. IC2284.2 +021100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2284.2 +021200 MOVE SPACE TO TEST-RESULTS. IC2284.2 +021300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2284.2 +021400 GO TO CCVS1-EXIT. IC2284.2 +021500 CLOSE-FILES. IC2284.2 +021600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2284.2 +021700 TERMINATE-CCVS. IC2284.2 +021800*S EXIT PROGRAM. IC2284.2 +021900*SERMINATE-CALL. IC2284.2 +022000 STOP RUN. IC2284.2 +022100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2284.2 +022200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2284.2 +022300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2284.2 +022400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2284.2 +022500 MOVE "****TEST DELETED****" TO RE-MARK. IC2284.2 +022600 PRINT-DETAIL. IC2284.2 +022700 IF REC-CT NOT EQUAL TO ZERO IC2284.2 +022800 MOVE "." TO PARDOT-X IC2284.2 +022900 MOVE REC-CT TO DOTVALUE. IC2284.2 +023000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2284.2 +023100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2284.2 +023200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2284.2 +023300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2284.2 +023400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2284.2 +023500 MOVE SPACE TO CORRECT-X. IC2284.2 +023600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2284.2 +023700 MOVE SPACE TO RE-MARK. IC2284.2 +023800 HEAD-ROUTINE. IC2284.2 +023900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +024000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +024100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2284.2 +024200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2284.2 +024300 COLUMN-NAMES-ROUTINE. IC2284.2 +024400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +024500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +024700 END-ROUTINE. IC2284.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2284.2 +024900 END-RTN-EXIT. IC2284.2 +025000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +025100 END-ROUTINE-1. IC2284.2 +025200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2284.2 +025300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2284.2 +025400 ADD PASS-COUNTER TO ERROR-HOLD. IC2284.2 +025500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2284.2 +025600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2284.2 +025700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2284.2 +025800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2284.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2284.2 +026000 END-ROUTINE-12. IC2284.2 +026100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2284.2 +026200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2284.2 +026300 MOVE "NO " TO ERROR-TOTAL IC2284.2 +026400 ELSE IC2284.2 +026500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2284.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2284.2 +026700 PERFORM WRITE-LINE. IC2284.2 +026800 END-ROUTINE-13. IC2284.2 +026900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2284.2 +027000 MOVE "NO " TO ERROR-TOTAL ELSE IC2284.2 +027100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2284.2 +027200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2284.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +027400 IF INSPECT-COUNTER EQUAL TO ZERO IC2284.2 +027500 MOVE "NO " TO ERROR-TOTAL IC2284.2 +027600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2284.2 +027700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2284.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +027900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2284.2 +028000 WRITE-LINE. IC2284.2 +028100 ADD 1 TO RECORD-COUNT. IC2284.2 +028200 IF RECORD-COUNT GREATER 50 IC2284.2 +028300 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2284.2 +028400 MOVE SPACE TO DUMMY-RECORD IC2284.2 +028500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2284.2 +028600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2284.2 +028700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2284.2 +028800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2284.2 +028900 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2284.2 +029000 MOVE ZERO TO RECORD-COUNT. IC2284.2 +029100 PERFORM WRT-LN. IC2284.2 +029200 WRT-LN. IC2284.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2284.2 +029400 MOVE SPACE TO DUMMY-RECORD. IC2284.2 +029500 BLANK-LINE-PRINT. IC2284.2 +029600 PERFORM WRT-LN. IC2284.2 +029700 FAIL-ROUTINE. IC2284.2 +029800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2284.2 +029900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2284.2 +030000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2284.2 +030100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2284.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2284.2 +030400 GO TO FAIL-ROUTINE-EX. IC2284.2 +030500 FAIL-ROUTINE-WRITE. IC2284.2 +030600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2284.2 +030700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2284.2 +030800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2284.2 +030900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2284.2 +031000 FAIL-ROUTINE-EX. EXIT. IC2284.2 +031100 BAIL-OUT. IC2284.2 +031200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2284.2 +031300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2284.2 +031400 BAIL-OUT-WRITE. IC2284.2 +031500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2284.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2284.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2284.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2284.2 +031900 BAIL-OUT-EX. EXIT. IC2284.2 +032000 CCVS1-EXIT. IC2284.2 +032100 EXIT. IC2284.2 +032200 SECT-IC228A-001 SECTION. IC2284.2 +032300 GLO-INIT-01. IC2284.2 +032400 MOVE "X-20 4.3.2" TO ANSI-REFERENCE. IC2284.2 +032500 MOVE "GLOBAL CLAUSE" TO FEATURE. IC2284.2 +032600 MOVE "AA" TO GLO-DATA-1. IC2284.2 +032700 MOVE "FIRST]" TO GLO-DATA-2. IC2284.2 +032800 MOVE 12345678 TO GLO-DATA-3. IC2284.2 +032900 MOVE 1 TO GLO-DATA-4. IC2284.2 +033000 GLO-TEST-01-01-0. IC2284.2 +033100 CALL "IC228A-1" IC2284.2 +033200 END-CALL. IC2284.2 +033300 GO TO GLO-TEST-01-01-1. IC2284.2 +033400 GLO-DELETE-01-01. IC2284.2 +033500 PERFORM DE-LETE. IC2284.2 +033600 PERFORM PRINT-DETAIL. IC2284.2 +033700 GO TO CCVS-EXIT. IC2284.2 +033800 GLO-TEST-01-01-1. IC2284.2 +033900 MOVE "GLO-TEST-01-01-1" TO PAR-NAME. IC2284.2 +034000 IF GLO-DATA-1 = "ZZ" IC2284.2 +034100 PERFORM PASS IC2284.2 +034200 PERFORM PRINT-DETAIL IC2284.2 +034300 ELSE IC2284.2 +034400 MOVE GLO-DATA-1 TO COMPUTED-X IC2284.2 +034500 MOVE "ZZ" TO CORRECT-X IC2284.2 +034600 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2284.2 +034700 PERFORM FAIL IC2284.2 +034800 PERFORM PRINT-DETAIL. IC2284.2 +034900 ADD 1 TO REC-CT. IC2284.2 +035000 CALL-TEST-01-01-2. IC2284.2 +035100 MOVE "CALL-TEST-01-01-2" TO PAR-NAME. IC2284.2 +035200 IF CHANGE-MADE-OK IC2284.2 +035300 PERFORM PASS IC2284.2 +035400 PERFORM PRINT-DETAIL IC2284.2 +035500 ELSE IC2284.2 +035600 MOVE GLO-DATA-2 TO COMPUTED-X IC2284.2 +035700 MOVE "CHANGE" TO CORRECT-X IC2284.2 +035800 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2284.2 +035900 PERFORM FAIL IC2284.2 +036000 PERFORM PRINT-DETAIL. IC2284.2 +036100 ADD 1 TO REC-CT. IC2284.2 +036200 CALL-TEST-01-01-3. IC2284.2 +036300 MOVE "CALL-TEST-01-01-3" TO PAR-NAME. IC2284.2 +036400 IF GLO-DATA-3 = 87654321 IC2284.2 +036500 PERFORM PASS IC2284.2 +036600 PERFORM PRINT-DETAIL IC2284.2 +036700 ELSE IC2284.2 +036800 MOVE GLO-DATA-3 TO COMPUTED-N IC2284.2 +036900 MOVE 87654321 TO CORRECT-N IC2284.2 +037000 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2284.2 +037100 PERFORM FAIL IC2284.2 +037200 PERFORM PRINT-DETAIL. IC2284.2 +037300 ADD 1 TO REC-CT. IC2284.2 +037400 CALL-TEST-01-01-4. IC2284.2 +037500 MOVE "CALL-TEST-01-01-4" TO PAR-NAME. IC2284.2 +037600 IF GLO-DATA-4 = 11 IC2284.2 +037700 PERFORM PASS IC2284.2 +037800 PERFORM PRINT-DETAIL IC2284.2 +037900 ELSE IC2284.2 +038000 MOVE GLO-DATA-4 TO COMPUTED-N IC2284.2 +038100 MOVE 11 TO CORRECT-N IC2284.2 +038200 MOVE "INCORRECT VALUE RETURNED" TO RE-MARK IC2284.2 +038300 PERFORM FAIL IC2284.2 +038400 PERFORM PRINT-DETAIL. IC2284.2 +038500* IC2284.2 +038600 CCVS-EXIT SECTION. IC2284.2 +038700 CCVS-999999. IC2284.2 +038800 GO TO CLOSE-FILES. IC2284.2 +038900 IDENTIFICATION DIVISION. IC2284.2 +039000 PROGRAM-ID. IC2284.2 +039100 IC228A-1. IC2284.2 +039200**************************************************************** IC2284.2 +039300* * IC2284.2 +039400* VALIDATION FOR:- * IC2284.2 +039500* * IC2284.2 +039600* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2284.2 +039700* * IC2284.2 +039800* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2284.2 +039900* * IC2284.2 +040000**************************************************************** IC2284.2 +040100* * IC2284.2 +040200* X-CARDS USED BY THIS PROGRAM ARE :- * IC2284.2 +040300* * IC2284.2 +040400* X-55 - SYSTEM PRINTER NAME. * IC2284.2 +040500* X-82 - SOURCE COMPUTER NAME. * IC2284.2 +040600* X-83 - OBJECT COMPUTER NAME. * IC2284.2 +040700* * IC2284.2 +040800**************************************************************** IC2284.2 +040900* * IC2284.2 +041000* PROGRAM IC228A AND IC228A-1 WILL TEST THE NEW LANGUAGE * IC2284.2 +041100* ELEMENTS FOR THE LEVEL 2 INTER-PROGRAM COMMUNICATION * IC2284.2 +041200* MODULE. * IC2284.2 +041300* THE NEW LANGUAGE ELEMENTS TO BE TESTED WILL BE: * IC2284.2 +041400* THE "GLOBAL" CLAUSE IN WORKING-STORAGE. * IC2284.2 +041500* THE TWO PROGRAMS WILL BE COMPILED IN THE SAME FLOW * IC2284.2 +041600* (TO TEST THE "END PROGRAM" STATEMENT) AS SHOWN BELOW: * IC2284.2 +041700* IDENTIFICATION DIVISION. * IC2284.2 +041800* PROGRAM-ID. IC228A. * IC2284.2 +041900* . * IC2284.2 +042000* . * IC2284.2 +042100* . * IC2284.2 +042200* IDENTIFICATION DIVISION. * IC2284.2 +042300* PROGRAM-ID. IC228A-1. * IC2284.2 +042400* . * IC2284.2 +042500* . * IC2284.2 +042600* . * IC2284.2 +042700* END PROGRAM IC228A-1. * IC2284.2 +042800* END PROGRAM IC228A. * IC2284.2 +042900**************************************************************** IC2284.2 +043000 ENVIRONMENT DIVISION. IC2284.2 +043100*INPUT-OUTPUT SECTION. IC2284.2 +043200 DATA DIVISION. IC2284.2 +043300*FILE SECTION. IC2284.2 +043400 WORKING-STORAGE SECTION. IC2284.2 +043500 PROCEDURE DIVISION. IC2284.2 +043600 SECT-IC228A-1-001 SECTION. IC2284.2 +043700 GLO-TEST-001. IC2284.2 +043800 MOVE "ZZ" TO GLO-DATA-1. IC2284.2 +043900 MOVE "CHANGE" TO GLO-DATA-2. IC2284.2 +044000 MOVE 87654321 TO GLO-DATA-3. IC2284.2 +044100 ADD 10 TO GLO-DATA-4. IC2284.2 +044200 GLO-EXIT-001. IC2284.2 +044300 EXIT PROGRAM. IC2284.2 +044400 END PROGRAM IC228A-1. IC2284.2 +044500 END PROGRAM IC228A. IC2284.2 diff --git a/tests/cobol85/IC/IC233A.CBL b/tests/cobol85/IC/IC233A.CBL new file mode 100755 index 00000000..8849b6ae --- /dev/null +++ b/tests/cobol85/IC/IC233A.CBL @@ -0,0 +1,513 @@ +000100 IDENTIFICATION DIVISION. IC2334.2 +000200 PROGRAM-ID. IC2334.2 +000300 IC233A. IC2334.2 +000400**************************************************************** IC2334.2 +000500* * IC2334.2 +000600* VALIDATION FOR:- * IC2334.2 +000700* * IC2334.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 +000900* * IC2334.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 +001100* * IC2334.2 +001200**************************************************************** IC2334.2 +001300* * IC2334.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2334.2 +001500* * IC2334.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2334.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2334.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2334.2 +001900* X-18 - OPTIONAL SEQUENTIAL MASS STORAGE FILE. * IC2334.2 +002000**************************************************************** IC2334.2 +002100* * IC2334.2 +002200* PROGRAMS IC233A AND IC233A-1 TEST THAT A "USE" PROCEDURE * IC2334.2 +002300* IN A CALLING PROGRAM IS INVOKED BY A QUALIFYING CONDITION * IC2334.2 +002400* OCCURRING IN A CONTAINED PROGRAM. * IC2334.2 +002500* * IC2334.2 +002600* BOTH PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2334.2 +002700* COMPILER AS SHOWN BELOW: * IC2334.2 +002800* IDENTIFICATION DIVISION. * IC2334.2 +002900* PROGRAM-ID. IC233A. * IC2334.2 +003000* . * IC2334.2 +003100* . * IC2334.2 +003200* . * IC2334.2 +003300* IDENTIFICATION DIVISION. * IC2334.2 +003400* PROGRAM-ID. IC233A-1. * IC2334.2 +003500* . * IC2334.2 +003600* . * IC2334.2 +003700* END PROGRAM IC233A-1. * IC2334.2 +003800* END PROGRAM IC233A. * IC2334.2 +003900**************************************************************** IC2334.2 +004000 ENVIRONMENT DIVISION. IC2334.2 +004100 CONFIGURATION SECTION. IC2334.2 +004200 SOURCE-COMPUTER. IC2334.2 +004300 Linux. IC2334.2 +004400 OBJECT-COMPUTER. IC2334.2 +004500 Linux. IC2334.2 +004600 INPUT-OUTPUT SECTION. IC2334.2 +004700 FILE-CONTROL. IC2334.2 +004800 SELECT PRINT-FILE ASSIGN TO IC2334.2 +004900 "report.log". IC2334.2 +005000 SELECT OPTIONAL TEST-FILE ASSIGN TO IC2334.2 +005100 "XXXXX018". IC2334.2 +005200 DATA DIVISION. IC2334.2 +005300 FILE SECTION. IC2334.2 +005400 FD PRINT-FILE. IC2334.2 +005500 01 PRINT-REC PICTURE X(120). IC2334.2 +005600 01 DUMMY-RECORD PICTURE X(120). IC2334.2 +005700 FD TEST-FILE GLOBAL. IC2334.2 +005800 01 TEST-REC PIC X(20). IC2334.2 +005900 WORKING-STORAGE SECTION. IC2334.2 +006000 01 DILFRAP PIC 9. IC2334.2 +006100 01 TEST-RESULTS. IC2334.2 +006200 02 FILLER PIC X VALUE SPACE. IC2334.2 +006300 02 FEATURE PIC X(20) VALUE SPACE. IC2334.2 +006400 02 FILLER PIC X VALUE SPACE. IC2334.2 +006500 02 P-OR-F PIC X(5) VALUE SPACE. IC2334.2 +006600 02 FILLER PIC X VALUE SPACE. IC2334.2 +006700 02 PAR-NAME. IC2334.2 +006800 03 FILLER PIC X(19) VALUE SPACE. IC2334.2 +006900 03 PARDOT-X PIC X VALUE SPACE. IC2334.2 +007000 03 DOTVALUE PIC 99 VALUE ZERO. IC2334.2 +007100 02 FILLER PIC X(8) VALUE SPACE. IC2334.2 +007200 02 RE-MARK PIC X(61). IC2334.2 +007300 01 TEST-COMPUTED. IC2334.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IC2334.2 +007500 02 FILLER PIC X(17) VALUE IC2334.2 +007600 " COMPUTED=". IC2334.2 +007700 02 COMPUTED-X. IC2334.2 +007800 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2334.2 +007900 03 COMPUTED-N REDEFINES COMPUTED-A IC2334.2 +008000 PIC -9(9).9(9). IC2334.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2334.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2334.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2334.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. IC2334.2 +008500 04 COMPUTED-18V0 PIC -9(18). IC2334.2 +008600 04 FILLER PIC X. IC2334.2 +008700 03 FILLER PIC X(50) VALUE SPACE. IC2334.2 +008800 01 TEST-CORRECT. IC2334.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IC2334.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". IC2334.2 +009100 02 CORRECT-X. IC2334.2 +009200 03 CORRECT-A PIC X(20) VALUE SPACE. IC2334.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2334.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2334.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2334.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2334.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. IC2334.2 +009800 04 CORRECT-18V0 PIC -9(18). IC2334.2 +009900 04 FILLER PIC X. IC2334.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IC2334.2 +010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2334.2 +010200 01 CCVS-C-1. IC2334.2 +010300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2334.2 +010400- "SS PARAGRAPH-NAME IC2334.2 +010500- " REMARKS". IC2334.2 +010600 02 FILLER PIC X(20) VALUE SPACE. IC2334.2 +010700 01 CCVS-C-2. IC2334.2 +010800 02 FILLER PIC X VALUE SPACE. IC2334.2 +010900 02 FILLER PIC X(6) VALUE "TESTED". IC2334.2 +011000 02 FILLER PIC X(15) VALUE SPACE. IC2334.2 +011100 02 FILLER PIC X(4) VALUE "FAIL". IC2334.2 +011200 02 FILLER PIC X(94) VALUE SPACE. IC2334.2 +011300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2334.2 +011400 01 REC-CT PIC 99 VALUE ZERO. IC2334.2 +011500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2334.2 +011600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2334.2 +011700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2334.2 +011800 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2334.2 +011900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2334.2 +012000 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2334.2 +012100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2334.2 +012200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2334.2 +012300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2334.2 +012400 01 CCVS-H-1. IC2334.2 +012500 02 FILLER PIC X(39) VALUE SPACES. IC2334.2 +012600 02 FILLER PIC X(42) VALUE IC2334.2 +012700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2334.2 +012800 02 FILLER PIC X(39) VALUE SPACES. IC2334.2 +012900 01 CCVS-H-2A. IC2334.2 +013000 02 FILLER PIC X(40) VALUE SPACE. IC2334.2 +013100 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2334.2 +013200 02 FILLER PIC XXXX VALUE IC2334.2 +013300 "4.2 ". IC2334.2 +013400 02 FILLER PIC X(28) VALUE IC2334.2 +013500 " COPY - NOT FOR DISTRIBUTION". IC2334.2 +013600 02 FILLER PIC X(41) VALUE SPACE. IC2334.2 +013700 IC2334.2 +013800 01 CCVS-H-2B. IC2334.2 +013900 02 FILLER PIC X(15) VALUE IC2334.2 +014000 "TEST RESULT OF ". IC2334.2 +014100 02 TEST-ID PIC X(9). IC2334.2 +014200 02 FILLER PIC X(4) VALUE IC2334.2 +014300 " IN ". IC2334.2 +014400 02 FILLER PIC X(12) VALUE IC2334.2 +014500 " HIGH ". IC2334.2 +014600 02 FILLER PIC X(22) VALUE IC2334.2 +014700 " LEVEL VALIDATION FOR ". IC2334.2 +014800 02 FILLER PIC X(58) VALUE IC2334.2 +014900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 +015000 01 CCVS-H-3. IC2334.2 +015100 02 FILLER PIC X(34) VALUE IC2334.2 +015200 " FOR OFFICIAL USE ONLY ". IC2334.2 +015300 02 FILLER PIC X(58) VALUE IC2334.2 +015400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 +015500 02 FILLER PIC X(28) VALUE IC2334.2 +015600 " COPYRIGHT 1985 ". IC2334.2 +015700 01 CCVS-E-1. IC2334.2 +015800 02 FILLER PIC X(52) VALUE SPACE. IC2334.2 +015900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2334.2 +016000 02 ID-AGAIN PIC X(9). IC2334.2 +016100 02 FILLER PIC X(45) VALUE SPACES. IC2334.2 +016200 01 CCVS-E-2. IC2334.2 +016300 02 FILLER PIC X(31) VALUE SPACE. IC2334.2 +016400 02 FILLER PIC X(21) VALUE SPACE. IC2334.2 +016500 02 CCVS-E-2-2. IC2334.2 +016600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2334.2 +016700 03 FILLER PIC X VALUE SPACE. IC2334.2 +016800 03 ENDER-DESC PIC X(44) VALUE IC2334.2 +016900 "ERRORS ENCOUNTERED". IC2334.2 +017000 01 CCVS-E-3. IC2334.2 +017100 02 FILLER PIC X(22) VALUE IC2334.2 +017200 " FOR OFFICIAL USE ONLY". IC2334.2 +017300 02 FILLER PIC X(12) VALUE SPACE. IC2334.2 +017400 02 FILLER PIC X(58) VALUE IC2334.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 +017600 02 FILLER PIC X(13) VALUE SPACE. IC2334.2 +017700 02 FILLER PIC X(15) VALUE IC2334.2 +017800 " COPYRIGHT 1985". IC2334.2 +017900 01 CCVS-E-4. IC2334.2 +018000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2334.2 +018100 02 FILLER PIC X(4) VALUE " OF ". IC2334.2 +018200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2334.2 +018300 02 FILLER PIC X(40) VALUE IC2334.2 +018400 " TESTS WERE EXECUTED SUCCESSFULLY". IC2334.2 +018500 01 XXINFO. IC2334.2 +018600 02 FILLER PIC X(19) VALUE IC2334.2 +018700 "*** INFORMATION ***". IC2334.2 +018800 02 INFO-TEXT. IC2334.2 +018900 04 FILLER PIC X(8) VALUE SPACE. IC2334.2 +019000 04 XXCOMPUTED PIC X(20). IC2334.2 +019100 04 FILLER PIC X(5) VALUE SPACE. IC2334.2 +019200 04 XXCORRECT PIC X(20). IC2334.2 +019300 02 INF-ANSI-REFERENCE PIC X(48). IC2334.2 +019400 01 HYPHEN-LINE. IC2334.2 +019500 02 FILLER PIC IS X VALUE IS SPACE. IC2334.2 +019600 02 FILLER PIC IS X(65) VALUE IS "************************IC2334.2 +019700- "*****************************************". IC2334.2 +019800 02 FILLER PIC IS X(54) VALUE IS "************************IC2334.2 +019900- "******************************". IC2334.2 +020000 01 CCVS-PGM-ID PIC X(9) VALUE IC2334.2 +020100 "IC233A". IC2334.2 +020200 PROCEDURE DIVISION. IC2334.2 +020300 DECLARATIVES. IC2334.2 +020400 SECT-IC233A-001 SECTION. IC2334.2 +020500 USE GLOBAL AFTER ERROR PROCEDURE ON INPUT. IC2334.2 +020600 USE-TEST-2. IC2334.2 +020700 PERFORM D1-PASS. IC2334.2 +020800 PERFORM D1-PRINT-DETAIL. IC2334.2 +020900 MOVE 1 TO DILFRAP. IC2334.2 +021000 GO TO EXIT-USE-TEST-2. IC2334.2 +021100 D1-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2334.2 +021200 D1-PRINT-DETAIL. IC2334.2 +021300 IF REC-CT NOT EQUAL TO ZERO IC2334.2 +021400 MOVE "." TO PARDOT-X IC2334.2 +021500 MOVE REC-CT TO DOTVALUE. IC2334.2 +021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D1-WRITE-LINE. IC2334.2 +021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM D1-WRITE-LINE IC2334.2 +021800 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX IC2334.2 +021900 ELSE PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. IC2334.2 +022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2334.2 +022100 MOVE SPACE TO CORRECT-X. IC2334.2 +022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2334.2 +022300 MOVE SPACE TO RE-MARK. IC2334.2 +022400 D1-WRITE-LINE. IC2334.2 +022500 ADD 1 TO RECORD-COUNT. IC2334.2 +022600 IF RECORD-COUNT GREATER 50 IC2334.2 +022700 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2334.2 +022800 MOVE SPACE TO DUMMY-RECORD IC2334.2 +022900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2334.2 +023000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D1-WRT-LN IC2334.2 +023100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D1-WRT-LN 2 TIMES IC2334.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D1-WRT-LN IC2334.2 +023300 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2334.2 +023400 MOVE ZERO TO RECORD-COUNT. IC2334.2 +023500 PERFORM D1-WRT-LN. IC2334.2 +023600 D1-WRT-LN. IC2334.2 +023700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2334.2 +023800 MOVE SPACE TO DUMMY-RECORD. IC2334.2 +023900 D1-FAIL-ROUTINE. IC2334.2 +024000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO D1-FAIL-ROUTINE-WRITE.IC2334.2 +024100 IF CORRECT-X NOT EQUAL TO SPACE GO TO D1-FAIL-ROUTINE-WRITE. IC2334.2 +024200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 +024300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2334.2 +024400 MOVE XXINFO TO DUMMY-RECORD. PERFORM D1-WRITE-LINE 2 TIMES.IC2334.2 +024500 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 +024600 GO TO D1-FAIL-ROUTINE-EX. IC2334.2 +024700 D1-FAIL-ROUTINE-WRITE. IC2334.2 +024800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D1-WRITE-LINE IC2334.2 +024900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2334.2 +025000 MOVE TEST-CORRECT TO PRINT-REC PERFORM D1-WRITE-LINE 2 TIMES.IC2334.2 +025100 MOVE SPACES TO COR-ANSI-REFERENCE. IC2334.2 +025200 D1-FAIL-ROUTINE-EX. EXIT. IC2334.2 +025300 D1-BAIL-OUT. IC2334.2 +025400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D1-BAIL-OUT-WRITE. IC2334.2 +025500 IF CORRECT-A EQUAL TO SPACE GO TO D1-BAIL-OUT-EX. IC2334.2 +025600 D1-BAIL-OUT-WRITE. IC2334.2 +025700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2334.2 +025800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 +025900 MOVE XXINFO TO DUMMY-RECORD. IC2334.2 +026000 PERFORM D1-WRITE-LINE 2 TIMES. IC2334.2 +026100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 +026200 D1-BAIL-OUT-EX. EXIT. IC2334.2 +026300 EXIT-USE-TEST-2. IC2334.2 +026400 EXIT. IC2334.2 +026500 END DECLARATIVES. IC2334.2 +026600 CCVS1 SECTION. IC2334.2 +026700 OPEN-FILES. IC2334.2 +026800 OPEN OUTPUT PRINT-FILE. IC2334.2 +026900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2334.2 +027000 MOVE SPACE TO TEST-RESULTS. IC2334.2 +027100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2334.2 +027200 GO TO CCVS1-EXIT. IC2334.2 +027300 CLOSE-FILES. IC2334.2 +027400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2334.2 +027500 TERMINATE-CCVS. IC2334.2 +027600*S EXIT PROGRAM. IC2334.2 +027700*SERMINATE-CALL. IC2334.2 +027800 STOP RUN. IC2334.2 +027900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2334.2 +028000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2334.2 +028100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2334.2 +028200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2334.2 +028300 MOVE "****TEST DELETED****" TO RE-MARK. IC2334.2 +028400 PRINT-DETAIL. IC2334.2 +028500 IF REC-CT NOT EQUAL TO ZERO IC2334.2 +028600 MOVE "." TO PARDOT-X IC2334.2 +028700 MOVE REC-CT TO DOTVALUE. IC2334.2 +028800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2334.2 +028900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2334.2 +029000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2334.2 +029100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2334.2 +029200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2334.2 +029300 MOVE SPACE TO CORRECT-X. IC2334.2 +029400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2334.2 +029500 MOVE SPACE TO RE-MARK. IC2334.2 +029600 HEAD-ROUTINE. IC2334.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2334.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2334.2 +030100 COLUMN-NAMES-ROUTINE. IC2334.2 +030200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +030300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +030400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +030500 END-ROUTINE. IC2334.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2334.2 +030700 END-RTN-EXIT. IC2334.2 +030800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +030900 END-ROUTINE-1. IC2334.2 +031000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2334.2 +031100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2334.2 +031200 ADD PASS-COUNTER TO ERROR-HOLD. IC2334.2 +031300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2334.2 +031400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2334.2 +031500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2334.2 +031600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2334.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2334.2 +031800 END-ROUTINE-12. IC2334.2 +031900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2334.2 +032000 IF ERROR-COUNTER IS EQUAL TO ZERO IC2334.2 +032100 MOVE "NO " TO ERROR-TOTAL IC2334.2 +032200 ELSE IC2334.2 +032300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2334.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2334.2 +032500 PERFORM WRITE-LINE. IC2334.2 +032600 END-ROUTINE-13. IC2334.2 +032700 IF DELETE-COUNTER IS EQUAL TO ZERO IC2334.2 +032800 MOVE "NO " TO ERROR-TOTAL ELSE IC2334.2 +032900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2334.2 +033000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2334.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +033200 IF INSPECT-COUNTER EQUAL TO ZERO IC2334.2 +033300 MOVE "NO " TO ERROR-TOTAL IC2334.2 +033400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2334.2 +033500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2334.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +033700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 +033800 WRITE-LINE. IC2334.2 +033900 ADD 1 TO RECORD-COUNT. IC2334.2 +034000 IF RECORD-COUNT GREATER 50 IC2334.2 +034100 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2334.2 +034200 MOVE SPACE TO DUMMY-RECORD IC2334.2 +034300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2334.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2334.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2334.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2334.2 +034700 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2334.2 +034800 MOVE ZERO TO RECORD-COUNT. IC2334.2 +034900 PERFORM WRT-LN. IC2334.2 +035000 WRT-LN. IC2334.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2334.2 +035200 MOVE SPACE TO DUMMY-RECORD. IC2334.2 +035300 BLANK-LINE-PRINT. IC2334.2 +035400 PERFORM WRT-LN. IC2334.2 +035500 FAIL-ROUTINE. IC2334.2 +035600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2334.2 +035700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2334.2 +035800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 +035900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2334.2 +036000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +036100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 +036200 GO TO FAIL-ROUTINE-EX. IC2334.2 +036300 FAIL-ROUTINE-WRITE. IC2334.2 +036400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2334.2 +036500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2334.2 +036600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2334.2 +036700 MOVE SPACES TO COR-ANSI-REFERENCE. IC2334.2 +036800 FAIL-ROUTINE-EX. EXIT. IC2334.2 +036900 BAIL-OUT. IC2334.2 +037000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2334.2 +037100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2334.2 +037200 BAIL-OUT-WRITE. IC2334.2 +037300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2334.2 +037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 +037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 +037600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 +037700 BAIL-OUT-EX. EXIT. IC2334.2 +037800 CCVS1-EXIT. IC2334.2 +037900 EXIT. IC2334.2 +038000 SECT-IC233A-1R-001 SECTION. IC2334.2 +038100 USE-INIT-1. IC2334.2 +038200 MOVE "USE-TEST-1" TO PAR-NAME. IC2334.2 +038300 MOVE "X-34 5.5.4 GR(1)B" TO ANSI-REFERENCE. IC2334.2 +038400 MOVE ZERO TO DILFRAP. IC2334.2 +038500 USE-TEST-0. IC2334.2 +038600 CALL "IC233A-1". IC2334.2 +038700 IF DILFRAP = 1 IC2334.2 +038800 GO TO CCVS-EXIT. IC2334.2 +038900 USE-FAIL-1. IC2334.2 +039000 MOVE "USE PROCEDURE NOT INVOKED" TO RE-MARK. IC2334.2 +039100 PERFORM FAIL. IC2334.2 +039200 GO TO USE-WRITE-1. IC2334.2 +039300 USE-DELETE-1. IC2334.2 +039400 PERFORM DE-LETE. IC2334.2 +039500 USE-WRITE-1. IC2334.2 +039600 PERFORM PRINT-DETAIL. IC2334.2 +039700* IC2334.2 +039800 CCVS-EXIT SECTION. IC2334.2 +039900 CCVS-999999. IC2334.2 +040000 GO TO CLOSE-FILES. IC2334.2 +040100* IC2334.2 +040200 IDENTIFICATION DIVISION. IC2334.2 +040300 PROGRAM-ID. IC2334.2 +040400 IC233A-1. IC2334.2 +040500**************************************************************** IC2334.2 +040600* * IC2334.2 +040700* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2334.2 +040800* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2334.2 +040900* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2334.2 +041000* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2334.2 +041100* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2334.2 +041200* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2334.2 +041300* * IC2334.2 +041400* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2334.2 +041500* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2334.2 +041600* DOCUMENT REFERENCE: ISO-1989-1978). * IC2334.2 +041700* * IC2334.2 +041800* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2334.2 +041900* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2334.2 +042000* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2334.2 +042100* * IC2334.2 +042200* THE FEDERAL SOFTWARE TESTING CENTER * IC2334.2 +042300* OFFICE OF SOFTWARE DEVELOPMENT * IC2334.2 +042400* & INFORMATION TECHNOLOGY * IC2334.2 +042500* TWO SKYLINE PLACE * IC2334.2 +042600* SUITE 1100 * IC2334.2 +042700* 5203 LEESBURG PIKE * IC2334.2 +042800* FALLS CHURCH * IC2334.2 +042900* VA 22041 * IC2334.2 +043000* U.S.A. * IC2334.2 +043100* * IC2334.2 +043200* THE PROJECT TEAM MEMBERS WERE: * IC2334.2 +043300* * IC2334.2 +043400* BIADI (BUREAU INTER ADMINISTRATION * IC2334.2 +043500* DE DOCUMENTATION INFORMATIQUE) * IC2334.2 +043600* 21 RUE BARA * IC2334.2 +043700* F-92132 ISSY * IC2334.2 +043800* FRANCE * IC2334.2 +043900* * IC2334.2 +044000* * IC2334.2 +044100* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2334.2 +044200* UND DATENVERARBEITUNG MBH) * IC2334.2 +044300* SCHLOSS BIRLINGHOVEN * IC2334.2 +044400* POSTFACH 12 40 * IC2334.2 +044500* D-5205 ST. AUGUSTIN 1 * IC2334.2 +044600* GERMANY FR * IC2334.2 +044700* * IC2334.2 +044800* * IC2334.2 +044900* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2334.2 +045000* OXFORD ROAD * IC2334.2 +045100* MANCHESTER * IC2334.2 +045200* M1 7ED * IC2334.2 +045300* UNITED KINGDOM * IC2334.2 +045400* * IC2334.2 +045500* * IC2334.2 +045600* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2334.2 +045700* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2334.2 +045800* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2334.2 +045900* * IC2334.2 +046000**************************************************************** IC2334.2 +046100* * IC2334.2 +046200* VALIDATION FOR:- * IC2334.2 +046300* * IC2334.2 +046400* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 +046500* * IC2334.2 +046600* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 +046700* * IC2334.2 +046800**************************************************************** IC2334.2 +046900* * IC2334.2 +047000* X-CARDS USED BY THIS PROGRAM ARE :- * IC2334.2 +047100* * IC2334.2 +047200* X-55 - SYSTEM PRINTER NAME. * IC2334.2 +047300* X-82 - SOURCE COMPUTER NAME. * IC2334.2 +047400* X-83 - OBJECT COMPUTER NAME. * IC2334.2 +047500* X-92 - TEST-FILE. * IC2334.2 +047600* * IC2334.2 +047700**************************************************************** IC2334.2 +047800* * IC2334.2 +047900* PROGRAMS IC233A AND IC233A-1 TEST THAT A "USE" PROCEDURE * IC2334.2 +048000* IN A CALLING PROGRAM IS INVOKED BY A QUALIFYING CONDITION * IC2334.2 +048100* OCCURRING IN A CONTAINED PROGRAM. * IC2334.2 +048200* * IC2334.2 +048300* BOTH PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2334.2 +048400* COMPILER AS SHOWN BELOW: * IC2334.2 +048500* IDENTIFICATION DIVISION. * IC2334.2 +048600* PROGRAM-ID. IC233A. * IC2334.2 +048700* . * IC2334.2 +048800* . * IC2334.2 +048900* . * IC2334.2 +049000* IDENTIFICATION DIVISION. * IC2334.2 +049100* PROGRAM-ID. IC233A-1. * IC2334.2 +049200* . * IC2334.2 +049300* . * IC2334.2 +049400* END PROGRAM IC233A-1. * IC2334.2 +049500* END PROGRAM IC233A. * IC2334.2 +049600**************************************************************** IC2334.2 +049700*ENVIRONMENT DIVISION. IC2334.2 +049800*INPUT-OUTPUT SECTION. IC2334.2 +049900*FILE-CONTROL. IC2334.2 +050000* SELECT TEST-FILE ASSIGN TO IC2334.2 +050100* "XXXXX018". IC2334.2 +050200 DATA DIVISION. IC2334.2 +050300 FILE SECTION. IC2334.2 +050400 WORKING-STORAGE SECTION. IC2334.2 +050500 PROCEDURE DIVISION. IC2334.2 +050600 SECT-IC233A-1-001 SECTION. IC2334.2 +050700 USE-INIT-1. IC2334.2 +050800 OPEN INPUT TEST-FILE. IC2334.2 +050900 READ TEST-FILE. IC2334.2 +051000 END-PROG. IC2334.2 +051100 EXIT PROGRAM. IC2334.2 +051200 END PROGRAM IC233A-1. IC2334.2 +051300 END PROGRAM IC233A. IC2334.2 diff --git a/tests/cobol85/IC/IC234A.CBL b/tests/cobol85/IC/IC234A.CBL new file mode 100755 index 00000000..3d0c3eb6 --- /dev/null +++ b/tests/cobol85/IC/IC234A.CBL @@ -0,0 +1,737 @@ +000100 IDENTIFICATION DIVISION. IC2344.2 +000200 PROGRAM-ID. IC2344.2 +000300 IC234A. IC2344.2 +000400**************************************************************** IC2344.2 +000500* * IC2344.2 +000600* VALIDATION FOR:- * IC2344.2 +000700* * IC2344.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +000900* * IC2344.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +001100* * IC2344.2 +001200**************************************************************** IC2344.2 +001300* * IC2344.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2344.2 +001500* * IC2344.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2344.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2344.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2344.2 +001900* X-14 - TEST-FILE. * IC2344.2 +002000* * IC2344.2 +002100**************************************************************** IC2344.2 +002200* * IC2344.2 +002300* PROGRAMS IC234A, IC234A-1, IC234A-2 AND IC234A-3 TEST * IC2344.2 +002400* TEST THAT A "USE" PROCEDURE IN A CALLING PROGRAM IS * IC2344.2 +002500* INVOKED BY A QUALIFYING CONDITION OCURRING IN A CONTAINED * IC2344.2 +002600* PROGRAM NESTED TO FOUR LEVELS. * IC2344.2 +002700* * IC2344.2 +002800* ALL PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2344.2 +002900* COMPILER AS SHOWN BELOW: * IC2344.2 +003000* IDENTIFICATION DIVISION. * IC2344.2 +003100* PROGRAM-ID. IC234A. * IC2344.2 +003200* . * IC2344.2 +003300* . * IC2344.2 +003400* . * IC2344.2 +003500* IDENTIFICATION DIVISION. * IC2344.2 +003600* PROGRAM-ID. IC234A-1. * IC2344.2 +003700* . * IC2344.2 +003800* . * IC2344.2 +003900* IDENTIFICATION DIVISION. * IC2344.2 +004000* PROGRAM-ID. IC234A-2. * IC2344.2 +004100* . * IC2344.2 +004200* . * IC2344.2 +004300* . * IC2344.2 +004400* IDENTIFICATION DIVISION. * IC2344.2 +004500* PROGRAM-ID. IC234A-3. * IC2344.2 +004600* . * IC2344.2 +004700* . * IC2344.2 +004800* END PROGRAM IC234A-3. * IC2344.2 +004900* END PROGRAM IC234A-2. * IC2344.2 +005000* END PROGRAM IC234A-1. * IC2344.2 +005100* END PROGRAM IC234A. * IC2344.2 +005200**************************************************************** IC2344.2 +005300 ENVIRONMENT DIVISION. IC2344.2 +005400 CONFIGURATION SECTION. IC2344.2 +005500 SOURCE-COMPUTER. IC2344.2 +005600 Linux. IC2344.2 +005700 OBJECT-COMPUTER. IC2344.2 +005800 Linux. IC2344.2 +005900 INPUT-OUTPUT SECTION. IC2344.2 +006000 FILE-CONTROL. IC2344.2 +006100 SELECT PRINT-FILE ASSIGN TO IC2344.2 +006200 "report.log". IC2344.2 +006300 SELECT TEST-FILE ASSIGN TO IC2344.2 +006400 "XXXXX014". IC2344.2 +006500 DATA DIVISION. IC2344.2 +006600 FILE SECTION. IC2344.2 +006700 FD PRINT-FILE. IC2344.2 +006800 01 PRINT-REC PIC X(120). IC2344.2 +006900 01 DUMMY-RECORD PIC X(120). IC2344.2 +007000 FD TEST-FILE GLOBAL. IC2344.2 +007100 01 TEST-RECORD PIC X(20). IC2344.2 +007200 WORKING-STORAGE SECTION. IC2344.2 +007300 01 DILFRAP GLOBAL PIC 9. IC2344.2 +007400 01 TEST-RESULTS. IC2344.2 +007500 02 FILLER PIC X VALUE SPACE. IC2344.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. IC2344.2 +007700 02 FILLER PIC X VALUE SPACE. IC2344.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. IC2344.2 +007900 02 FILLER PIC X VALUE SPACE. IC2344.2 +008000 02 PAR-NAME. IC2344.2 +008100 03 FILLER PIC X(19) VALUE SPACE. IC2344.2 +008200 03 PARDOT-X PIC X VALUE SPACE. IC2344.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. IC2344.2 +008400 02 FILLER PIC X(8) VALUE SPACE. IC2344.2 +008500 02 RE-MARK PIC X(61). IC2344.2 +008600 01 TEST-COMPUTED. IC2344.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IC2344.2 +008800 02 FILLER PIC X(17) VALUE IC2344.2 +008900 " COMPUTED=". IC2344.2 +009000 02 COMPUTED-X. IC2344.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2344.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A IC2344.2 +009300 PIC -9(9).9(9). IC2344.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2344.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2344.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2344.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. IC2344.2 +009800 04 COMPUTED-18V0 PIC -9(18). IC2344.2 +009900 04 FILLER PIC X. IC2344.2 +010000 03 FILLER PIC X(50) VALUE SPACE. IC2344.2 +010100 01 TEST-CORRECT. IC2344.2 +010200 02 FILLER PIC X(30) VALUE SPACE. IC2344.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". IC2344.2 +010400 02 CORRECT-X. IC2344.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. IC2344.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2344.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2344.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2344.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2344.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. IC2344.2 +011100 04 CORRECT-18V0 PIC -9(18). IC2344.2 +011200 04 FILLER PIC X. IC2344.2 +011300 03 FILLER PIC X(2) VALUE SPACE. IC2344.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2344.2 +011500 01 CCVS-C-1. IC2344.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2344.2 +011700- "SS PARAGRAPH-NAME IC2344.2 +011800- " REMARKS". IC2344.2 +011900 02 FILLER PIC X(20) VALUE SPACE. IC2344.2 +012000 01 CCVS-C-2. IC2344.2 +012100 02 FILLER PIC X VALUE SPACE. IC2344.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". IC2344.2 +012300 02 FILLER PIC X(15) VALUE SPACE. IC2344.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". IC2344.2 +012500 02 FILLER PIC X(94) VALUE SPACE. IC2344.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2344.2 +012700 01 REC-CT PIC 99 VALUE ZERO. IC2344.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2344.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2344.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2344.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2344.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2344.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2344.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2344.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2344.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2344.2 +013700 01 CCVS-H-1. IC2344.2 +013800 02 FILLER PIC X(39) VALUE SPACES. IC2344.2 +013900 02 FILLER PIC X(42) VALUE IC2344.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2344.2 +014100 02 FILLER PIC X(39) VALUE SPACES. IC2344.2 +014200 01 CCVS-H-2A. IC2344.2 +014300 02 FILLER PIC X(40) VALUE SPACE. IC2344.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2344.2 +014500 02 FILLER PIC XXXX VALUE IC2344.2 +014600 "4.2 ". IC2344.2 +014700 02 FILLER PIC X(28) VALUE IC2344.2 +014800 " COPY - NOT FOR DISTRIBUTION". IC2344.2 +014900 02 FILLER PIC X(41) VALUE SPACE. IC2344.2 +015000 IC2344.2 +015100 01 CCVS-H-2B. IC2344.2 +015200 02 FILLER PIC X(15) VALUE IC2344.2 +015300 "TEST RESULT OF ". IC2344.2 +015400 02 TEST-ID PIC X(9). IC2344.2 +015500 02 FILLER PIC X(4) VALUE IC2344.2 +015600 " IN ". IC2344.2 +015700 02 FILLER PIC X(12) VALUE IC2344.2 +015800 " HIGH ". IC2344.2 +015900 02 FILLER PIC X(22) VALUE IC2344.2 +016000 " LEVEL VALIDATION FOR ". IC2344.2 +016100 02 FILLER PIC X(58) VALUE IC2344.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +016300 01 CCVS-H-3. IC2344.2 +016400 02 FILLER PIC X(34) VALUE IC2344.2 +016500 " FOR OFFICIAL USE ONLY ". IC2344.2 +016600 02 FILLER PIC X(58) VALUE IC2344.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +016800 02 FILLER PIC X(28) VALUE IC2344.2 +016900 " COPYRIGHT 1985 ". IC2344.2 +017000 01 CCVS-E-1. IC2344.2 +017100 02 FILLER PIC X(52) VALUE SPACE. IC2344.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2344.2 +017300 02 ID-AGAIN PIC X(9). IC2344.2 +017400 02 FILLER PIC X(45) VALUE SPACES. IC2344.2 +017500 01 CCVS-E-2. IC2344.2 +017600 02 FILLER PIC X(31) VALUE SPACE. IC2344.2 +017700 02 FILLER PIC X(21) VALUE SPACE. IC2344.2 +017800 02 CCVS-E-2-2. IC2344.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2344.2 +018000 03 FILLER PIC X VALUE SPACE. IC2344.2 +018100 03 ENDER-DESC PIC X(44) VALUE IC2344.2 +018200 "ERRORS ENCOUNTERED". IC2344.2 +018300 01 CCVS-E-3. IC2344.2 +018400 02 FILLER PIC X(22) VALUE IC2344.2 +018500 " FOR OFFICIAL USE ONLY". IC2344.2 +018600 02 FILLER PIC X(12) VALUE SPACE. IC2344.2 +018700 02 FILLER PIC X(58) VALUE IC2344.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +018900 02 FILLER PIC X(13) VALUE SPACE. IC2344.2 +019000 02 FILLER PIC X(15) VALUE IC2344.2 +019100 " COPYRIGHT 1985". IC2344.2 +019200 01 CCVS-E-4. IC2344.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2344.2 +019400 02 FILLER PIC X(4) VALUE " OF ". IC2344.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2344.2 +019600 02 FILLER PIC X(40) VALUE IC2344.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". IC2344.2 +019800 01 XXINFO. IC2344.2 +019900 02 FILLER PIC X(19) VALUE IC2344.2 +020000 "*** INFORMATION ***". IC2344.2 +020100 02 INFO-TEXT. IC2344.2 +020200 04 FILLER PIC X(8) VALUE SPACE. IC2344.2 +020300 04 XXCOMPUTED PIC X(20). IC2344.2 +020400 04 FILLER PIC X(5) VALUE SPACE. IC2344.2 +020500 04 XXCORRECT PIC X(20). IC2344.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). IC2344.2 +020700 01 HYPHEN-LINE. IC2344.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. IC2344.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************IC2344.2 +021000- "*****************************************". IC2344.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************IC2344.2 +021200- "******************************". IC2344.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE IC2344.2 +021400 "IC234A". IC2344.2 +021500 PROCEDURE DIVISION. IC2344.2 +021600 DECLARATIVES. IC2344.2 +021700 SECT-IC234A-001 SECTION. IC2344.2 +021800 USE GLOBAL AFTER ERROR PROCEDURE ON INPUT. IC2344.2 +021900 USE-TEST-2. IC2344.2 +022000 ADD 1 TO DILFRAP. IC2344.2 +022100 END DECLARATIVES. IC2344.2 +022200 CCVS1 SECTION. IC2344.2 +022300 OPEN-FILES. IC2344.2 +022400 OPEN OUTPUT PRINT-FILE. IC2344.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2344.2 +022600 MOVE SPACE TO TEST-RESULTS. IC2344.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2344.2 +022800 GO TO CCVS1-EXIT. IC2344.2 +022900 CLOSE-FILES. IC2344.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2344.2 +023100 TERMINATE-CCVS. IC2344.2 +023200*S EXIT PROGRAM. IC2344.2 +023300*SERMINATE-CALL. IC2344.2 +023400 STOP RUN. IC2344.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2344.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2344.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2344.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2344.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. IC2344.2 +024000 PRINT-DETAIL. IC2344.2 +024100 IF REC-CT NOT EQUAL TO ZERO IC2344.2 +024200 MOVE "." TO PARDOT-X IC2344.2 +024300 MOVE REC-CT TO DOTVALUE. IC2344.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2344.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2344.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2344.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2344.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2344.2 +024900 MOVE SPACE TO CORRECT-X. IC2344.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2344.2 +025100 MOVE SPACE TO RE-MARK. IC2344.2 +025200 HEAD-ROUTINE. IC2344.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2344.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2344.2 +025700 COLUMN-NAMES-ROUTINE. IC2344.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +026100 END-ROUTINE. IC2344.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2344.2 +026300 END-RTN-EXIT. IC2344.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +026500 END-ROUTINE-1. IC2344.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2344.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2344.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. IC2344.2 +026900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2344.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2344.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2344.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2344.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2344.2 +027400 END-ROUTINE-12. IC2344.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2344.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO IC2344.2 +027700 MOVE "NO " TO ERROR-TOTAL IC2344.2 +027800 ELSE IC2344.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2344.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2344.2 +028100 PERFORM WRITE-LINE. IC2344.2 +028200 END-ROUTINE-13. IC2344.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO IC2344.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE IC2344.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2344.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2344.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO IC2344.2 +028900 MOVE "NO " TO ERROR-TOTAL IC2344.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2344.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2344.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2344.2 +029400 WRITE-LINE. IC2344.2 +029500 ADD 1 TO RECORD-COUNT. IC2344.2 +029600 IF RECORD-COUNT GREATER 50 IC2344.2 +029700 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2344.2 +029800 MOVE SPACE TO DUMMY-RECORD IC2344.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2344.2 +030000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2344.2 +030100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2344.2 +030200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2344.2 +030300 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2344.2 +030400 MOVE ZERO TO RECORD-COUNT. IC2344.2 +030500 PERFORM WRT-LN. IC2344.2 +030600 WRT-LN. IC2344.2 +030700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2344.2 +030800 MOVE SPACE TO DUMMY-RECORD. IC2344.2 +030900 BLANK-LINE-PRINT. IC2344.2 +031000 PERFORM WRT-LN. IC2344.2 +031100 FAIL-ROUTINE. IC2344.2 +031200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2344.2 +031300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2344.2 +031400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2344.2 +031500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2344.2 +031600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +031700 MOVE SPACES TO INF-ANSI-REFERENCE. IC2344.2 +031800 GO TO FAIL-ROUTINE-EX. IC2344.2 +031900 FAIL-ROUTINE-WRITE. IC2344.2 +032000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2344.2 +032100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2344.2 +032200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2344.2 +032300 MOVE SPACES TO COR-ANSI-REFERENCE. IC2344.2 +032400 FAIL-ROUTINE-EX. EXIT. IC2344.2 +032500 BAIL-OUT. IC2344.2 +032600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2344.2 +032700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2344.2 +032800 BAIL-OUT-WRITE. IC2344.2 +032900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2344.2 +033000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2344.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2344.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. IC2344.2 +033300 BAIL-OUT-EX. EXIT. IC2344.2 +033400 CCVS1-EXIT. IC2344.2 +033500 EXIT. IC2344.2 +033600 SECT-IC234A-1R-001 SECTION. IC2344.2 +033700 USE-INIT-1. IC2344.2 +033800 OPEN OUTPUT TEST-FILE. IC2344.2 +033900 CLOSE TEST-FILE. IC2344.2 +034000 MOVE 1 TO REC-CT. IC2344.2 +034100 MOVE "USE GLOBAL INPUT" TO FEATURE. IC2344.2 +034200 MOVE "USE-TEST-1" TO PAR-NAME. IC2344.2 +034300 MOVE "X-34 5.5.4 GR(1)C" TO ANSI-REFERENCE. IC2344.2 +034400 MOVE ZERO TO DILFRAP. IC2344.2 +034500 USE-TEST-0. IC2344.2 +034600 CALL "IC234A-1". IC2344.2 +034700 IF DILFRAP = 1 IC2344.2 +034800 PERFORM PASS IC2344.2 +034900 GO TO USE-WRITE-1. IC2344.2 +035000 USE-FAIL-1. IC2344.2 +035100 MOVE 1 TO CORRECT-N. IC2344.2 +035200 MOVE DILFRAP TO COMPUTED-N. IC2344.2 +035300 IF DILFRAP = 0 IC2344.2 +035400 MOVE "USE PROCEDURE NOT INVOKED" TO RE-MARK IC2344.2 +035500 ELSE MOVE "WRONG 'USE' PROCEDURE INVOKED" TO RE-MARK. IC2344.2 +035600 PERFORM FAIL. IC2344.2 +035700 GO TO USE-WRITE-1. IC2344.2 +035800 USE-DELETE-1. IC2344.2 +035900 PERFORM DE-LETE. IC2344.2 +036000 USE-WRITE-1. IC2344.2 +036100 PERFORM PRINT-DETAIL. IC2344.2 +036200* IC2344.2 +036300 CCVS-EXIT SECTION. IC2344.2 +036400 CCVS-999999. IC2344.2 +036500 GO TO CLOSE-FILES. IC2344.2 +036600* IC2344.2 +036700 IDENTIFICATION DIVISION. IC2344.2 +036800 PROGRAM-ID. IC2344.2 +036900 IC234A-1. IC2344.2 +037000**************************************************************** IC2344.2 +037100* * IC2344.2 +037200* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2344.2 +037300* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2344.2 +037400* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2344.2 +037500* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2344.2 +037600* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2344.2 +037700* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2344.2 +037800* * IC2344.2 +037900* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2344.2 +038000* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2344.2 +038100* DOCUMENT REFERENCE: ISO-1989-1978). * IC2344.2 +038200* * IC2344.2 +038300* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2344.2 +038400* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2344.2 +038500* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2344.2 +038600* * IC2344.2 +038700* THE FEDERAL SOFTWARE TESTING CENTER * IC2344.2 +038800* OFFICE OF SOFTWARE DEVELOPMENT * IC2344.2 +038900* & INFORMATION TECHNOLOGY * IC2344.2 +039000* TWO SKYLINE PLACE * IC2344.2 +039100* SUITE 1100 * IC2344.2 +039200* 5203 LEESBURG PIKE * IC2344.2 +039300* FALLS CHURCH * IC2344.2 +039400* VA 22041 * IC2344.2 +039500* U.S.A. * IC2344.2 +039600* * IC2344.2 +039700* THE PROJECT TEAM MEMBERS WERE: * IC2344.2 +039800* * IC2344.2 +039900* BIADI (BUREAU INTER ADMINISTRATION * IC2344.2 +040000* DE DOCUMENTATION INFORMATIQUE) * IC2344.2 +040100* 21 RUE BARA * IC2344.2 +040200* F-92132 ISSY * IC2344.2 +040300* FRANCE * IC2344.2 +040400* * IC2344.2 +040500* * IC2344.2 +040600* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2344.2 +040700* UND DATENVERARBEITUNG MBH) * IC2344.2 +040800* SCHLOSS BIRLINGHOVEN * IC2344.2 +040900* POSTFACH 12 40 * IC2344.2 +041000* D-5205 ST. AUGUSTIN 1 * IC2344.2 +041100* GERMANY FR * IC2344.2 +041200* * IC2344.2 +041300* * IC2344.2 +041400* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2344.2 +041500* OXFORD ROAD * IC2344.2 +041600* MANCHESTER * IC2344.2 +041700* M1 7ED * IC2344.2 +041800* UNITED KINGDOM * IC2344.2 +041900* * IC2344.2 +042000* * IC2344.2 +042100* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2344.2 +042200* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2344.2 +042300* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2344.2 +042400* * IC2344.2 +042500**************************************************************** IC2344.2 +042600* * IC2344.2 +042700* VALIDATION FOR:- * IC2344.2 +042800* * IC2344.2 +042900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +043000* * IC2344.2 +043100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +043200* * IC2344.2 +043300**************************************************************** IC2344.2 +043400* * IC2344.2 +043500* X-CARDS USED BY THIS PROGRAM ARE :- * IC2344.2 +043600* * IC2344.2 +043700* X-55 - SYSTEM PRINTER NAME. * IC2344.2 +043800* X-82 - SOURCE COMPUTER NAME. * IC2344.2 +043900* X-83 - OBJECT COMPUTER NAME. * IC2344.2 +044000* * IC2344.2 +044100**************************************************************** IC2344.2 +044200* * IC2344.2 +044300* PROGRAMS IC234A, IC234A-1, IC234A-2 AND IC234A-3 TEST * IC2344.2 +044400* TEST THAT A "USE" PROCEDURE IN A CALLING PROGRAM IS * IC2344.2 +044500* INVOKED BY A QUALIFYING CONDITION OCURRING IN A CONTAINED * IC2344.2 +044600* PROGRAM NESTED TO FOUR LEVELS. * IC2344.2 +044700* * IC2344.2 +044800* ALL PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2344.2 +044900* COMPILER AS SHOWN BELOW: * IC2344.2 +045000* IDENTIFICATION DIVISION. * IC2344.2 +045100* PROGRAM-ID. IC234A. * IC2344.2 +045200* . * IC2344.2 +045300* . * IC2344.2 +045400* . * IC2344.2 +045500* IDENTIFICATION DIVISION. * IC2344.2 +045600* PROGRAM-ID. IC234A-1. * IC2344.2 +045700* . * IC2344.2 +045800* . * IC2344.2 +045900* IDENTIFICATION DIVISION. * IC2344.2 +046000* PROGRAM-ID. IC234A-2. * IC2344.2 +046100* . * IC2344.2 +046200* . * IC2344.2 +046300* . * IC2344.2 +046400* IDENTIFICATION DIVISION. * IC2344.2 +046500* PROGRAM-ID. IC234A-3. * IC2344.2 +046600* . * IC2344.2 +046700* . * IC2344.2 +046800* END PROGRAM IC234A-3. * IC2344.2 +046900* END PROGRAM IC234A-2. * IC2344.2 +047000* END PROGRAM IC234A-1. * IC2344.2 +047100* END PROGRAM IC234A. * IC2344.2 +047200**************************************************************** IC2344.2 +047300*ENVIRONMENT DIVISION. IC2344.2 +047400*INPUT-OUTPUT SECTION. IC2344.2 +047500*FILE-CONTROL. IC2344.2 +047600 DATA DIVISION. IC2344.2 +047700 FILE SECTION. IC2344.2 +047800 WORKING-STORAGE SECTION. IC2344.2 +047900 PROCEDURE DIVISION. IC2344.2 +048000 DECLARATIVES. IC2344.2 +048100 NON-GLOBAL-SECTION SECTION. IC2344.2 +048200 USE AFTER STANDARD EXCEPTION PROCEDURE ON TEST-FILE. IC2344.2 +048300 USE-PARA. IC2344.2 +048400 ADD 2 TO DILFRAP. IC2344.2 +048500 END DECLARATIVES. IC2344.2 +048600 SECT-IC234A-1-001 SECTION. IC2344.2 +048700 USE-INIT-1. IC2344.2 +048800 CALL "IC234A-2". IC2344.2 +048900 EXIT PROGRAM. IC2344.2 +049000* IC2344.2 +049100 IDENTIFICATION DIVISION. IC2344.2 +049200 PROGRAM-ID. IC2344.2 +049300 IC234A-2. IC2344.2 +049400**************************************************************** IC2344.2 +049500* * IC2344.2 +049600* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2344.2 +049700* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2344.2 +049800* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2344.2 +049900* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2344.2 +050000* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2344.2 +050100* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2344.2 +050200* * IC2344.2 +050300* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2344.2 +050400* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2344.2 +050500* DOCUMENT REFERENCE: ISO-1989-1978). * IC2344.2 +050600* * IC2344.2 +050700* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2344.2 +050800* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2344.2 +050900* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2344.2 +051000* * IC2344.2 +051100* THE FEDERAL SOFTWARE TESTING CENTER * IC2344.2 +051200* OFFICE OF SOFTWARE DEVELOPMENT * IC2344.2 +051300* & INFORMATION TECHNOLOGY * IC2344.2 +051400* TWO SKYLINE PLACE * IC2344.2 +051500* SUITE 1100 * IC2344.2 +051600* 5203 LEESBURG PIKE * IC2344.2 +051700* FALLS CHURCH * IC2344.2 +051800* VA 22041 * IC2344.2 +051900* U.S.A. * IC2344.2 +052000* * IC2344.2 +052100* THE PROJECT TEAM MEMBERS WERE: * IC2344.2 +052200* * IC2344.2 +052300* BIADI (BUREAU INTER ADMINISTRATION * IC2344.2 +052400* DE DOCUMENTATION INFORMATIQUE) * IC2344.2 +052500* 21 RUE BARA * IC2344.2 +052600* F-92132 ISSY * IC2344.2 +052700* FRANCE * IC2344.2 +052800* * IC2344.2 +052900* * IC2344.2 +053000* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2344.2 +053100* UND DATENVERARBEITUNG MBH) * IC2344.2 +053200* SCHLOSS BIRLINGHOVEN * IC2344.2 +053300* POSTFACH 12 40 * IC2344.2 +053400* D-5205 ST. AUGUSTIN 1 * IC2344.2 +053500* GERMANY FR * IC2344.2 +053600* * IC2344.2 +053700* * IC2344.2 +053800* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2344.2 +053900* OXFORD ROAD * IC2344.2 +054000* MANCHESTER * IC2344.2 +054100* M1 7ED * IC2344.2 +054200* UNITED KINGDOM * IC2344.2 +054300* * IC2344.2 +054400* * IC2344.2 +054500* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2344.2 +054600* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2344.2 +054700* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2344.2 +054800* * IC2344.2 +054900**************************************************************** IC2344.2 +055000* * IC2344.2 +055100* VALIDATION FOR:- * IC2344.2 +055200* * IC2344.2 +055300* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +055400* * IC2344.2 +055500* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +055600* * IC2344.2 +055700**************************************************************** IC2344.2 +055800* * IC2344.2 +055900* X-CARDS USED BY THIS PROGRAM ARE :- * IC2344.2 +056000* * IC2344.2 +056100* X-55 - SYSTEM PRINTER NAME. * IC2344.2 +056200* X-82 - SOURCE COMPUTER NAME. * IC2344.2 +056300* X-83 - OBJECT COMPUTER NAME. * IC2344.2 +056400* * IC2344.2 +056500**************************************************************** IC2344.2 +056600* * IC2344.2 +056700* PROGRAMS IC234A, IC234A-1, IC234A-2 AND IC234A-3 TEST * IC2344.2 +056800* TEST THAT A "USE" PROCEDURE IN A CALLING PROGRAM IS * IC2344.2 +056900* INVOKED BY A QUALIFYING CONDITION OCURRING IN A CONTAINED * IC2344.2 +057000* PROGRAM NESTED TO FOUR LEVELS. * IC2344.2 +057100* * IC2344.2 +057200* ALL PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2344.2 +057300* COMPILER AS SHOWN BELOW: * IC2344.2 +057400* IDENTIFICATION DIVISION. * IC2344.2 +057500* PROGRAM-ID. IC234A. * IC2344.2 +057600* . * IC2344.2 +057700* . * IC2344.2 +057800* . * IC2344.2 +057900* IDENTIFICATION DIVISION. * IC2344.2 +058000* PROGRAM-ID. IC234A-1. * IC2344.2 +058100* . * IC2344.2 +058200* . * IC2344.2 +058300* IDENTIFICATION DIVISION. * IC2344.2 +058400* PROGRAM-ID. IC234A-2. * IC2344.2 +058500* . * IC2344.2 +058600* . * IC2344.2 +058700* . * IC2344.2 +058800* IDENTIFICATION DIVISION. * IC2344.2 +058900* PROGRAM-ID. IC234A-3. * IC2344.2 +059000* . * IC2344.2 +059100* . * IC2344.2 +059200* END PROGRAM IC234A-3. * IC2344.2 +059300* END PROGRAM IC234A-2. * IC2344.2 +059400* END PROGRAM IC234A-1. * IC2344.2 +059500* END PROGRAM IC234A. * IC2344.2 +059600**************************************************************** IC2344.2 +059700*ENVIRONMENT DIVISION. IC2344.2 +059800*INPUT-OUTPUT SECTION. IC2344.2 +059900*FILE-CONTROL. IC2344.2 +060000 DATA DIVISION. IC2344.2 +060100 FILE SECTION. IC2344.2 +060200 WORKING-STORAGE SECTION. IC2344.2 +060300 PROCEDURE DIVISION. IC2344.2 +060400 DECLARATIVES. IC2344.2 +060500 USE-TEST SECTION. IC2344.2 +060600 USE GLOBAL AFTER ERROR PROCEDURE ON OUTPUT. IC2344.2 +060700 USE-TEST-1. IC2344.2 +060800 ADD 4 TO DILFRAP. IC2344.2 +060900 END DECLARATIVES. IC2344.2 +061000 SECT-IC234A-2-001 SECTION. IC2344.2 +061100 USE-INIT-1. IC2344.2 +061200 CALL "IC234A-3". IC2344.2 +061300 EXIT PROGRAM. IC2344.2 +061400* IC2344.2 +061500 IDENTIFICATION DIVISION. IC2344.2 +061600 PROGRAM-ID. IC2344.2 +061700 IC234A-3. IC2344.2 +061800**************************************************************** IC2344.2 +061900* * IC2344.2 +062000* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2344.2 +062100* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2344.2 +062200* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2344.2 +062300* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2344.2 +062400* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2344.2 +062500* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2344.2 +062600* * IC2344.2 +062700* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2344.2 +062800* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2344.2 +062900* DOCUMENT REFERENCE: ISO-1989-1978). * IC2344.2 +063000* * IC2344.2 +063100* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2344.2 +063200* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2344.2 +063300* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2344.2 +063400* * IC2344.2 +063500* THE FEDERAL SOFTWARE TESTING CENTER * IC2344.2 +063600* OFFICE OF SOFTWARE DEVELOPMENT * IC2344.2 +063700* & INFORMATION TECHNOLOGY * IC2344.2 +063800* TWO SKYLINE PLACE * IC2344.2 +063900* SUITE 1100 * IC2344.2 +064000* 5203 LEESBURG PIKE * IC2344.2 +064100* FALLS CHURCH * IC2344.2 +064200* VA 22041 * IC2344.2 +064300* U.S.A. * IC2344.2 +064400* * IC2344.2 +064500* THE PROJECT TEAM MEMBERS WERE: * IC2344.2 +064600* * IC2344.2 +064700* BIADI (BUREAU INTER ADMINISTRATION * IC2344.2 +064800* DE DOCUMENTATION INFORMATIQUE) * IC2344.2 +064900* 21 RUE BARA * IC2344.2 +065000* F-92132 ISSY * IC2344.2 +065100* FRANCE * IC2344.2 +065200* * IC2344.2 +065300* * IC2344.2 +065400* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2344.2 +065500* UND DATENVERARBEITUNG MBH) * IC2344.2 +065600* SCHLOSS BIRLINGHOVEN * IC2344.2 +065700* POSTFACH 12 40 * IC2344.2 +065800* D-5205 ST. AUGUSTIN 1 * IC2344.2 +065900* GERMANY FR * IC2344.2 +066000* * IC2344.2 +066100* * IC2344.2 +066200* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2344.2 +066300* OXFORD ROAD * IC2344.2 +066400* MANCHESTER * IC2344.2 +066500* M1 7ED * IC2344.2 +066600* UNITED KINGDOM * IC2344.2 +066700* * IC2344.2 +066800* * IC2344.2 +066900* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2344.2 +067000* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2344.2 +067100* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2344.2 +067200* * IC2344.2 +067300**************************************************************** IC2344.2 +067400* * IC2344.2 +067500* VALIDATION FOR:- * IC2344.2 +067600* * IC2344.2 +067700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2344.2 +067800* * IC2344.2 +067900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2344.2 +068000* * IC2344.2 +068100**************************************************************** IC2344.2 +068200* * IC2344.2 +068300* X-CARDS USED BY THIS PROGRAM ARE :- * IC2344.2 +068400* * IC2344.2 +068500* X-55 - SYSTEM PRINTER NAME. * IC2344.2 +068600* X-82 - SOURCE COMPUTER NAME. * IC2344.2 +068700* X-83 - OBJECT COMPUTER NAME. * IC2344.2 +068800* * IC2344.2 +068900**************************************************************** IC2344.2 +069000* * IC2344.2 +069100* PROGRAMS IC234A, IC234A-1, IC234A-2 AND IC234A-3 TEST * IC2344.2 +069200* TEST THAT A "USE" PROCEDURE IN A CALLING PROGRAM IS * IC2344.2 +069300* INVOKED BY A QUALIFYING CONDITION OCURRING IN A CONTAINED * IC2344.2 +069400* PROGRAM NESTED TO FOUR LEVELS. * IC2344.2 +069500* * IC2344.2 +069600* ALL PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2344.2 +069700* COMPILER AS SHOWN BELOW: * IC2344.2 +069800* IDENTIFICATION DIVISION. * IC2344.2 +069900* PROGRAM-ID. IC234A. * IC2344.2 +070000* . * IC2344.2 +070100* . * IC2344.2 +070200* . * IC2344.2 +070300* IDENTIFICATION DIVISION. * IC2344.2 +070400* PROGRAM-ID. IC234A-1. * IC2344.2 +070500* . * IC2344.2 +070600* . * IC2344.2 +070700* IDENTIFICATION DIVISION. * IC2344.2 +070800* PROGRAM-ID. IC234A-2. * IC2344.2 +070900* . * IC2344.2 +071000* . * IC2344.2 +071100* . * IC2344.2 +071200* IDENTIFICATION DIVISION. * IC2344.2 +071300* PROGRAM-ID. IC234A-3. * IC2344.2 +071400* . * IC2344.2 +071500* . * IC2344.2 +071600* END PROGRAM IC234A-3. * IC2344.2 +071700* END PROGRAM IC234A-2. * IC2344.2 +071800* END PROGRAM IC234A-1. * IC2344.2 +071900* END PROGRAM IC234A. * IC2344.2 +072000**************************************************************** IC2344.2 +072100*ENVIRONMENT DIVISION. IC2344.2 +072200*INPUT-OUTPUT SECTION. IC2344.2 +072300*FILE-CONTROL. IC2344.2 +072400 DATA DIVISION. IC2344.2 +072500 FILE SECTION. IC2344.2 +072600 WORKING-STORAGE SECTION. IC2344.2 +072700 PROCEDURE DIVISION. IC2344.2 +072800 SECT-IC234A-3-001 SECTION. IC2344.2 +072900 USE-INIT-1. IC2344.2 +073000 OPEN INPUT TEST-FILE. IC2344.2 +073100 READ TEST-FILE. IC2344.2 +073200 EXIT PROGRAM. IC2344.2 +073300* IC2344.2 +073400 END PROGRAM IC234A-3. IC2344.2 +073500 END PROGRAM IC234A-2. IC2344.2 +073600 END PROGRAM IC234A-1. IC2344.2 +073700 END PROGRAM IC234A. IC2344.2 diff --git a/tests/cobol85/IC/IC235A.CBL b/tests/cobol85/IC/IC235A.CBL new file mode 100755 index 00000000..89dfc67f --- /dev/null +++ b/tests/cobol85/IC/IC235A.CBL @@ -0,0 +1,668 @@ +000100 IDENTIFICATION DIVISION. IC2354.2 +000200 PROGRAM-ID. IC2354.2 +000300 IC235A. IC2354.2 +000400**************************************************************** IC2354.2 +000500* * IC2354.2 +000600* VALIDATION FOR:- * IC2354.2 +000700* * IC2354.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +000900* * IC2354.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2 +001100* * IC2354.2 +001200**************************************************************** IC2354.2 +001300* * IC2354.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2 +001500* * IC2354.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2354.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2354.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2354.2 +001900* * IC2354.2 +002000**************************************************************** IC2354.2 +002100* THIS PROGRAM TESTS THE USE OF MULTIPLE DATA-NAMES IC2354.2 +002200* IN THE USING PHRASE OF THE CALL STATEMENT. TWO 01 GROUP IC2354.2 +002300* ITEMS AND AN ELEMENTARY 77 ITEM ARE THE PARAMETERS. THE IC2354.2 +002400* DATA DEFINITIONS FOR THE GROUP ITEM PARAMETERS ARE NOT IC2354.2 +002500* THE SAME AS IN THE SUBPROGRAM BUT THE NUMBER OF CHARACTERS IC2354.2 +002600* ARE IDENTICAL. IC2354.2 +002700* THIS PROGRAM ALSO CALLS A SUBPROGRAM WITH MORE IC2354.2 +002800* THAN ONE EXIT PROGRAM STATEMENT. IC2354.2 +002900* REFERENCE: AMERICAN NATIONAL STANDARD IC2354.2 +003000* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IC2354.2 +003100 ENVIRONMENT DIVISION. IC2354.2 +003200 CONFIGURATION SECTION. IC2354.2 +003300 SOURCE-COMPUTER. IC2354.2 +003400 Linux. IC2354.2 +003500 OBJECT-COMPUTER. IC2354.2 +003600 Linux. IC2354.2 +003700 INPUT-OUTPUT SECTION. IC2354.2 +003800 FILE-CONTROL. IC2354.2 +003900 SELECT PRINT-FILE ASSIGN TO IC2354.2 +004000 "report.log". IC2354.2 +004100 DATA DIVISION. IC2354.2 +004200 FILE SECTION. IC2354.2 +004300 FD PRINT-FILE. IC2354.2 +004400 01 PRINT-REC PICTURE X(120). IC2354.2 +004500 01 DUMMY-RECORD PICTURE X(120). IC2354.2 +004600 WORKING-STORAGE SECTION. IC2354.2 +004700 77 MAIN-DN1 PICTURE 999. IC2354.2 +004800 77 MAIN-DN2 PICTURE S99 COMPUTATIONAL. IC2354.2 +004900 77 ELEM-77 PICTURE V9(4) COMPUTATIONAL. IC2354.2 +005000 01 GROUP-01. IC2354.2 +005100 02 ALPHA-NUM-FIELD PIC X(8). IC2354.2 +005200 02 GROUP-LEV2. IC2354.2 +005300 03 NUMER-FIELD PIC 99. IC2354.2 +005400 03 ALPHA-FIELD PIC A(3). IC2354.2 +005500 01 GROUP-02. IC2354.2 +005600 02 NUM-ITEM PIC S99. IC2354.2 +005700 02 ALPHA-EDITED PICTURE X(6). IC2354.2 +005800 01 GROUP-03. IC2354.2 +005900 02 ALPHA-NUM-FIELD-3 PIC X(5). IC2354.2 +006000 02 GROUP-LEV2-3. IC2354.2 +006100 03 NUMER-FIELD-3 PIC 99. IC2354.2 +006200 03 ALPHA-FIELD-3 PIC A(3). IC2354.2 +006300 01 GROUP-04. IC2354.2 +006400 03 FILLER PIC XX. IC2354.2 +006500 03 ELEM-NON-01 PIC XX. IC2354.2 +006600 01 FILLER. IC2354.2 +006700 03 SUBSCRIPTED-DATA OCCURS 10 IC2354.2 +006800 PIC XX. IC2354.2 +006900 01 TEST-RESULTS. IC2354.2 +007000 02 FILLER PIC X VALUE SPACE. IC2354.2 +007100 02 FEATURE PIC X(20) VALUE SPACE. IC2354.2 +007200 02 FILLER PIC X VALUE SPACE. IC2354.2 +007300 02 P-OR-F PIC X(5) VALUE SPACE. IC2354.2 +007400 02 FILLER PIC X VALUE SPACE. IC2354.2 +007500 02 PAR-NAME. IC2354.2 +007600 03 FILLER PIC X(19) VALUE SPACE. IC2354.2 +007700 03 PARDOT-X PIC X VALUE SPACE. IC2354.2 +007800 03 DOTVALUE PIC 99 VALUE ZERO. IC2354.2 +007900 02 FILLER PIC X(8) VALUE SPACE. IC2354.2 +008000 02 RE-MARK PIC X(61). IC2354.2 +008100 01 TEST-COMPUTED. IC2354.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IC2354.2 +008300 02 FILLER PIC X(17) VALUE IC2354.2 +008400 " COMPUTED=". IC2354.2 +008500 02 COMPUTED-X. IC2354.2 +008600 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2354.2 +008700 03 COMPUTED-N REDEFINES COMPUTED-A IC2354.2 +008800 PIC -9(9).9(9). IC2354.2 +008900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2354.2 +009000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2354.2 +009100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2354.2 +009200 03 CM-18V0 REDEFINES COMPUTED-A. IC2354.2 +009300 04 COMPUTED-18V0 PIC -9(18). IC2354.2 +009400 04 FILLER PIC X. IC2354.2 +009500 03 FILLER PIC X(50) VALUE SPACE. IC2354.2 +009600 01 TEST-CORRECT. IC2354.2 +009700 02 FILLER PIC X(30) VALUE SPACE. IC2354.2 +009800 02 FILLER PIC X(17) VALUE " CORRECT =". IC2354.2 +009900 02 CORRECT-X. IC2354.2 +010000 03 CORRECT-A PIC X(20) VALUE SPACE. IC2354.2 +010100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2354.2 +010200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2354.2 +010300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2354.2 +010400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2354.2 +010500 03 CR-18V0 REDEFINES CORRECT-A. IC2354.2 +010600 04 CORRECT-18V0 PIC -9(18). IC2354.2 +010700 04 FILLER PIC X. IC2354.2 +010800 03 FILLER PIC X(2) VALUE SPACE. IC2354.2 +010900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2354.2 +011000 01 CCVS-C-1. IC2354.2 +011100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2354.2 +011200- "SS PARAGRAPH-NAME IC2354.2 +011300- " REMARKS". IC2354.2 +011400 02 FILLER PIC X(20) VALUE SPACE. IC2354.2 +011500 01 CCVS-C-2. IC2354.2 +011600 02 FILLER PIC X VALUE SPACE. IC2354.2 +011700 02 FILLER PIC X(6) VALUE "TESTED". IC2354.2 +011800 02 FILLER PIC X(15) VALUE SPACE. IC2354.2 +011900 02 FILLER PIC X(4) VALUE "FAIL". IC2354.2 +012000 02 FILLER PIC X(94) VALUE SPACE. IC2354.2 +012100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2354.2 +012200 01 REC-CT PIC 99 VALUE ZERO. IC2354.2 +012300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2354.2 +012400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2354.2 +012500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2354.2 +012600 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2354.2 +012700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2354.2 +012800 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2354.2 +012900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2354.2 +013000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2354.2 +013100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2354.2 +013200 01 CCVS-H-1. IC2354.2 +013300 02 FILLER PIC X(39) VALUE SPACES. IC2354.2 +013400 02 FILLER PIC X(42) VALUE IC2354.2 +013500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2354.2 +013600 02 FILLER PIC X(39) VALUE SPACES. IC2354.2 +013700 01 CCVS-H-2A. IC2354.2 +013800 02 FILLER PIC X(40) VALUE SPACE. IC2354.2 +013900 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2354.2 +014000 02 FILLER PIC XXXX VALUE IC2354.2 +014100 "4.2 ". IC2354.2 +014200 02 FILLER PIC X(28) VALUE IC2354.2 +014300 " COPY - NOT FOR DISTRIBUTION". IC2354.2 +014400 02 FILLER PIC X(41) VALUE SPACE. IC2354.2 +014500 IC2354.2 +014600 01 CCVS-H-2B. IC2354.2 +014700 02 FILLER PIC X(15) VALUE IC2354.2 +014800 "TEST RESULT OF ". IC2354.2 +014900 02 TEST-ID PIC X(9). IC2354.2 +015000 02 FILLER PIC X(4) VALUE IC2354.2 +015100 " IN ". IC2354.2 +015200 02 FILLER PIC X(12) VALUE IC2354.2 +015300 " HIGH ". IC2354.2 +015400 02 FILLER PIC X(22) VALUE IC2354.2 +015500 " LEVEL VALIDATION FOR ". IC2354.2 +015600 02 FILLER PIC X(58) VALUE IC2354.2 +015700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +015800 01 CCVS-H-3. IC2354.2 +015900 02 FILLER PIC X(34) VALUE IC2354.2 +016000 " FOR OFFICIAL USE ONLY ". IC2354.2 +016100 02 FILLER PIC X(58) VALUE IC2354.2 +016200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2 +016300 02 FILLER PIC X(28) VALUE IC2354.2 +016400 " COPYRIGHT 1985 ". IC2354.2 +016500 01 CCVS-E-1. IC2354.2 +016600 02 FILLER PIC X(52) VALUE SPACE. IC2354.2 +016700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2354.2 +016800 02 ID-AGAIN PIC X(9). IC2354.2 +016900 02 FILLER PIC X(45) VALUE SPACES. IC2354.2 +017000 01 CCVS-E-2. IC2354.2 +017100 02 FILLER PIC X(31) VALUE SPACE. IC2354.2 +017200 02 FILLER PIC X(21) VALUE SPACE. IC2354.2 +017300 02 CCVS-E-2-2. IC2354.2 +017400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2354.2 +017500 03 FILLER PIC X VALUE SPACE. IC2354.2 +017600 03 ENDER-DESC PIC X(44) VALUE IC2354.2 +017700 "ERRORS ENCOUNTERED". IC2354.2 +017800 01 CCVS-E-3. IC2354.2 +017900 02 FILLER PIC X(22) VALUE IC2354.2 +018000 " FOR OFFICIAL USE ONLY". IC2354.2 +018100 02 FILLER PIC X(12) VALUE SPACE. IC2354.2 +018200 02 FILLER PIC X(58) VALUE IC2354.2 +018300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +018400 02 FILLER PIC X(13) VALUE SPACE. IC2354.2 +018500 02 FILLER PIC X(15) VALUE IC2354.2 +018600 " COPYRIGHT 1985". IC2354.2 +018700 01 CCVS-E-4. IC2354.2 +018800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2354.2 +018900 02 FILLER PIC X(4) VALUE " OF ". IC2354.2 +019000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2354.2 +019100 02 FILLER PIC X(40) VALUE IC2354.2 +019200 " TESTS WERE EXECUTED SUCCESSFULLY". IC2354.2 +019300 01 XXINFO. IC2354.2 +019400 02 FILLER PIC X(19) VALUE IC2354.2 +019500 "*** INFORMATION ***". IC2354.2 +019600 02 INFO-TEXT. IC2354.2 +019700 04 FILLER PIC X(8) VALUE SPACE. IC2354.2 +019800 04 XXCOMPUTED PIC X(20). IC2354.2 +019900 04 FILLER PIC X(5) VALUE SPACE. IC2354.2 +020000 04 XXCORRECT PIC X(20). IC2354.2 +020100 02 INF-ANSI-REFERENCE PIC X(48). IC2354.2 +020200 01 HYPHEN-LINE. IC2354.2 +020300 02 FILLER PIC IS X VALUE IS SPACE. IC2354.2 +020400 02 FILLER PIC IS X(65) VALUE IS "************************IC2354.2 +020500- "*****************************************". IC2354.2 +020600 02 FILLER PIC IS X(54) VALUE IS "************************IC2354.2 +020700- "******************************". IC2354.2 +020800 01 CCVS-PGM-ID PIC X(9) VALUE IC2354.2 +020900 "IC235A". IC2354.2 +021000 PROCEDURE DIVISION. IC2354.2 +021100 CCVS1 SECTION. IC2354.2 +021200 OPEN-FILES. IC2354.2 +021300 OPEN OUTPUT PRINT-FILE. IC2354.2 +021400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2354.2 +021500 MOVE SPACE TO TEST-RESULTS. IC2354.2 +021600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2354.2 +021700 GO TO CCVS1-EXIT. IC2354.2 +021800 CLOSE-FILES. IC2354.2 +021900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2354.2 +022000 TERMINATE-CCVS. IC2354.2 +022100*S EXIT PROGRAM. IC2354.2 +022200*SERMINATE-CALL. IC2354.2 +022300 STOP RUN. IC2354.2 +022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2354.2 +022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2354.2 +022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2354.2 +022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2354.2 +022800 MOVE "****TEST DELETED****" TO RE-MARK. IC2354.2 +022900 PRINT-DETAIL. IC2354.2 +023000 IF REC-CT NOT EQUAL TO ZERO IC2354.2 +023100 MOVE "." TO PARDOT-X IC2354.2 +023200 MOVE REC-CT TO DOTVALUE. IC2354.2 +023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2354.2 +023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2354.2 +023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2354.2 +023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2354.2 +023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2354.2 +023800 MOVE SPACE TO CORRECT-X. IC2354.2 +023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2354.2 +024000 MOVE SPACE TO RE-MARK. IC2354.2 +024100 HEAD-ROUTINE. IC2354.2 +024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2354.2 +024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2354.2 +024600 COLUMN-NAMES-ROUTINE. IC2354.2 +024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +025000 END-ROUTINE. IC2354.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2354.2 +025200 END-RTN-EXIT. IC2354.2 +025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +025400 END-ROUTINE-1. IC2354.2 +025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2354.2 +025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2354.2 +025700 ADD PASS-COUNTER TO ERROR-HOLD. IC2354.2 +025800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2354.2 +025900 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2354.2 +026000 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2354.2 +026100 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2354.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2354.2 +026300 END-ROUTINE-12. IC2354.2 +026400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2354.2 +026500 IF ERROR-COUNTER IS EQUAL TO ZERO IC2354.2 +026600 MOVE "NO " TO ERROR-TOTAL IC2354.2 +026700 ELSE IC2354.2 +026800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2354.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2354.2 +027000 PERFORM WRITE-LINE. IC2354.2 +027100 END-ROUTINE-13. IC2354.2 +027200 IF DELETE-COUNTER IS EQUAL TO ZERO IC2354.2 +027300 MOVE "NO " TO ERROR-TOTAL ELSE IC2354.2 +027400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2354.2 +027500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2354.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +027700 IF INSPECT-COUNTER EQUAL TO ZERO IC2354.2 +027800 MOVE "NO " TO ERROR-TOTAL IC2354.2 +027900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2354.2 +028000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2354.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +028200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2 +028300 WRITE-LINE. IC2354.2 +028400 ADD 1 TO RECORD-COUNT. IC2354.2 +028500 IF RECORD-COUNT GREATER 50 IC2354.2 +028600 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2354.2 +028700 MOVE SPACE TO DUMMY-RECORD IC2354.2 +028800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2354.2 +028900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2354.2 +029000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2354.2 +029100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2354.2 +029200 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2354.2 +029300 MOVE ZERO TO RECORD-COUNT. IC2354.2 +029400 PERFORM WRT-LN. IC2354.2 +029500 WRT-LN. IC2354.2 +029600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2354.2 +029700 MOVE SPACE TO DUMMY-RECORD. IC2354.2 +029800 BLANK-LINE-PRINT. IC2354.2 +029900 PERFORM WRT-LN. IC2354.2 +030000 FAIL-ROUTINE. IC2354.2 +030100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2354.2 +030200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2354.2 +030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2354.2 +030400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2354.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2354.2 +030700 GO TO FAIL-ROUTINE-EX. IC2354.2 +030800 FAIL-ROUTINE-WRITE. IC2354.2 +030900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2354.2 +031000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2354.2 +031100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2354.2 +031200 MOVE SPACES TO COR-ANSI-REFERENCE. IC2354.2 +031300 FAIL-ROUTINE-EX. EXIT. IC2354.2 +031400 BAIL-OUT. IC2354.2 +031500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2354.2 +031600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2354.2 +031700 BAIL-OUT-WRITE. IC2354.2 +031800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2354.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2354.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2354.2 +032200 BAIL-OUT-EX. EXIT. IC2354.2 +032300 CCVS1-EXIT. IC2354.2 +032400 EXIT. IC2354.2 +032500 SECT-IC235-0001 SECTION. IC2354.2 +032600* THE TESTS IN THIS SECTION CALL A SUBPROGRAM WHICH IC2354.2 +032700* HAS FOUR EXIT PROGRAM STATEMENTS. A DIFFERENT EXIT IS IC2354.2 +032800* TAKEN FOR EACH CALL TO THE SUBPROGRAM. IC2354.2 +032900 EXIT-INIT. IC2354.2 +033000 MOVE "MULTIPLE EXIT PROGRM" TO FEATURE. IC2354.2 +033100 EXIT-INIT-001. IC2354.2 +033200 MOVE 0 TO MAIN-DN2. IC2354.2 +033300 MOVE 1 TO MAIN-DN1. IC2354.2 +033400 EXIT-TEST-001. IC2354.2 +033500 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2 +033600 IF MAIN-DN2 EQUAL TO 1 IC2354.2 +033700 PERFORM PASS IC2354.2 +033800 GO TO EXIT-WRITE-001. IC2354.2 +033900 EXIT-FAIL-001. IC2354.2 +034000 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2 +034100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2 +034200 MOVE "FIRST EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2 +034300 PERFORM FAIL. IC2354.2 +034400 EXIT-WRITE-001. IC2354.2 +034500 MOVE "EXIT-TEST-01" TO PAR-NAME. IC2354.2 +034600 PERFORM PRINT-DETAIL. IC2354.2 +034700 EXIT-INIT-002. IC2354.2 +034800 MOVE 0 TO MAIN-DN2. IC2354.2 +034900 MOVE 2 TO MAIN-DN1. IC2354.2 +035000 EXIT-TEST-002. IC2354.2 +035100 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2 +035200 IF MAIN-DN2 EQUAL TO 2 IC2354.2 +035300 PERFORM PASS IC2354.2 +035400 GO TO EXIT-WRITE-002. IC2354.2 +035500 EXIT-FAIL-002. IC2354.2 +035600 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2 +035700 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2 +035800 MOVE "SECOND EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2 +035900 PERFORM FAIL. IC2354.2 +036000 EXIT-WRITE-002. IC2354.2 +036100 MOVE "EXIT-TEST-02" TO PAR-NAME. IC2354.2 +036200 PERFORM PRINT-DETAIL. IC2354.2 +036300 EXIT-INIT-003. IC2354.2 +036400 MOVE 0 TO MAIN-DN2. IC2354.2 +036500 MOVE 3 TO MAIN-DN1. IC2354.2 +036600 EXIT-TEST-003. IC2354.2 +036700 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2 +036800 IF MAIN-DN2 NOT EQUAL TO 3 IC2354.2 +036900 GO TO EXIT-FAIL-003. IC2354.2 +037000 PERFORM PASS. IC2354.2 +037100 GO TO EXIT-WRITE-003. IC2354.2 +037200 EXIT-FAIL-003. IC2354.2 +037300 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2 +037400 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2 +037500 MOVE "THIRD EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2 +037600 PERFORM FAIL. IC2354.2 +037700 EXIT-WRITE-003. IC2354.2 +037800 MOVE "EXIT-TEST-03" TO PAR-NAME. IC2354.2 +037900 PERFORM PRINT-DETAIL. IC2354.2 +038000 EXIT-INIT-004. IC2354.2 +038100 MOVE 0 TO MAIN-DN2. IC2354.2 +038200 MOVE 4 TO MAIN-DN1. IC2354.2 +038300 EXIT-TEST-004. IC2354.2 +038400 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2 +038500 IF MAIN-DN2 NOT EQUAL TO 4 IC2354.2 +038600 GO TO EXIT-FAIL-004. IC2354.2 +038700 PERFORM PASS. IC2354.2 +038800 GO TO EXIT-WRITE-004. IC2354.2 +038900 EXIT-FAIL-004. IC2354.2 +039000 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2 +039100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2 +039200 MOVE "FOURTH EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2 +039300 PERFORM FAIL. IC2354.2 +039400 EXIT-WRITE-004. IC2354.2 +039500 MOVE "EXIT-TEST-04" TO PAR-NAME. IC2354.2 +039600 PERFORM PRINT-DETAIL. IC2354.2 +039700 GO TO SECT-IC235-0002. IC2354.2 +039800 EXIT-DELETES. IC2354.2 +039900* IF THE SUBPROGRAM WITH MULTIPLE EXIT PROGRAM IC2354.2 +040000* STATEMENTS CANNOT BE INCLUDED IN THE RUN UNIT IC2354.2 +040100* DELETE PARAGRAPH EXIT-INIT-001 THRU EXIT-WRITE-004. IC2354.2 +040200 PERFORM DE-LETE. IC2354.2 +040300 MOVE "EXIT-TEST-01" TO PAR-NAME. IC2354.2 +040400 PERFORM PRINT-DETAIL. IC2354.2 +040500 PERFORM DE-LETE. IC2354.2 +040600 MOVE "EXIT-TEST-02" TO PAR-NAME. IC2354.2 +040700 PERFORM PRINT-DETAIL. IC2354.2 +040800 PERFORM DE-LETE. IC2354.2 +040900 MOVE "EXIT-TEST-03" TO PAR-NAME. IC2354.2 +041000 PERFORM PRINT-DETAIL. IC2354.2 +041100 PERFORM DE-LETE. IC2354.2 +041200 MOVE "EXIT-TEST-04" TO PAR-NAME. IC2354.2 +041300 PERFORM PRINT-DETAIL. IC2354.2 +041400 SECT-IC235-0002 SECTION. IC2354.2 +041500* THIS SECTION CALLS A SUBPROGRAM WITH TWO GROUP ITEMS IC2354.2 +041600* AND ONE ELEMENTARY ITEM IN THE USING PHRASE. THE ITEM IC2354.2 +041700* DESCRIPTIONS ARE DIFFERENT IN THE SUBPROGRAM FROM THE MAIN IC2354.2 +041800* PROGRAM, BUT THE NUMBER OF CHARACTERS IS IDENTICAL. IC2354.2 +041900 CALL-INIT-06. IC2354.2 +042000 MOVE "CALL-TEST-06" TO PAR-NAME. IC2354.2 +042100 MOVE 0 TO NUMER-FIELD ELEM-77 NUM-ITEM. IC2354.2 +042200 MOVE SPACE TO ALPHA-NUM-FIELD ALPHA-FIELD ALPHA-EDITED. IC2354.2 +042300 MOVE 11 TO ELEM-NON-01. IC2354.2 +042400 MOVE 99 TO SUBSCRIPTED-DATA (4). IC2354.2 +042500 MOVE "CALL USING DN SERIES" TO FEATURE. IC2354.2 +042600 CALL-TEST-06. IC2354.2 +042700 CALL "IC235A-1" USING GROUP-01 ELEM-77 GROUP-02 IC2354.2 +042800 ELEM-NON-01 SUBSCRIPTED-DATA (4). IC2354.2 +042900 GO TO CALL-TEST-06-01. IC2354.2 +043000 CALL-DELETE-06. IC2354.2 +043100 PERFORM DE-LETE. IC2354.2 +043200 PERFORM PRINT-DETAIL. IC2354.2 +043300 GO TO CCVS-EXIT. IC2354.2 +043400* IF IC235A-1 CANNOT BE INCLUDED IN THE RUN UNIT IC2354.2 +043500* DELETE THE PARAGRAPH CALL-TEST-06. IC2354.2 +043600 CALL-TEST-06-01. IC2354.2 +043700 IF ALPHA-NUM-FIELD NOT EQUAL TO "IC235A-1" IC2354.2 +043800 GO TO CALL-FAIL-06-01. IC2354.2 +043900 PERFORM PASS. IC2354.2 +044000 GO TO CALL-WRITE-06-01. IC2354.2 +044100 CALL-FAIL-06-01. IC2354.2 +044200 MOVE ALPHA-NUM-FIELD TO COMPUTED-A. IC2354.2 +044300 MOVE "IC235A-1" TO CORRECT-A. IC2354.2 +044400 PERFORM FAIL. IC2354.2 +044500 MOVE "ALPHANUMERIC PARAMETER" TO RE-MARK. IC2354.2 +044600 CALL-WRITE-06-01. IC2354.2 +044700 ADD 1 TO REC-CT. IC2354.2 +044800 PERFORM PRINT-DETAIL. IC2354.2 +044900 CALL-TEST-06-02. IC2354.2 +045000 IF NUMER-FIELD EQUAL TO 25 IC2354.2 +045100 PERFORM PASS IC2354.2 +045200 GO TO CALL-WRITE-06-02. IC2354.2 +045300 CALL-FAIL-06-02. IC2354.2 +045400 PERFORM FAIL. IC2354.2 +045500 MOVE NUMER-FIELD TO COMPUTED-18V0. IC2354.2 +045600 MOVE 25 TO CORRECT-18V0. IC2354.2 +045700 MOVE "NUMERIC DISPLAY PARAMETER" TO RE-MARK. IC2354.2 +045800 CALL-WRITE-06-02. IC2354.2 +045900 ADD 1 TO REC-CT. IC2354.2 +046000 PERFORM PRINT-DETAIL. IC2354.2 +046100 CALL-TEST-06-03. IC2354.2 +046200 IF ALPHA-FIELD EQUAL TO "YES" IC2354.2 +046300 PERFORM PASS IC2354.2 +046400 GO TO CALL-WRITE-06-03. IC2354.2 +046500 CALL-FAIL-06-03. IC2354.2 +046600 PERFORM FAIL. IC2354.2 +046700 MOVE ALPHA-FIELD TO COMPUTED-A. IC2354.2 +046800 MOVE "YES" TO CORRECT-A. IC2354.2 +046900 MOVE "ALPHABETIC PARAMETER" TO RE-MARK. IC2354.2 +047000 CALL-WRITE-06-03. IC2354.2 +047100 ADD 1 TO REC-CT. IC2354.2 +047200 PERFORM PRINT-DETAIL. IC2354.2 +047300 CALL-TEST-06-04. IC2354.2 +047400 IF ELEM-77 EQUAL TO 0.7654 IC2354.2 +047500 PERFORM PASS IC2354.2 +047600 GO TO CALL-WRITE-06-04. IC2354.2 +047700 CALL-FAIL-06-04. IC2354.2 +047800 PERFORM FAIL. IC2354.2 +047900 MOVE ELEM-77 TO COMPUTED-4V14. IC2354.2 +048000 MOVE 0.7654 TO CORRECT-4V14. IC2354.2 +048100 MOVE "COMPUTATIONAL PARAMETER" TO RE-MARK. IC2354.2 +048200 CALL-WRITE-06-04. IC2354.2 +048300 ADD 1 TO REC-CT. IC2354.2 +048400 PERFORM PRINT-DETAIL. IC2354.2 +048500 CALL-TEST-06-05. IC2354.2 +048600 IF NUM-ITEM EQUAL TO 25 IC2354.2 +048700 PERFORM PASS IC2354.2 +048800 GO TO CALL-WRITE-06-05. IC2354.2 +048900 CALL-FAIL-06-05. IC2354.2 +049000 PERFORM FAIL. IC2354.2 +049100 MOVE NUM-ITEM TO COMPUTED-18V0. IC2354.2 +049200 MOVE 25 TO CORRECT-18V0. IC2354.2 +049300 MOVE "SIGNED NUMERIC PARAMETER" TO RE-MARK. IC2354.2 +049400 CALL-WRITE-06-05. IC2354.2 +049500 ADD 1 TO REC-CT. IC2354.2 +049600 PERFORM PRINT-DETAIL. IC2354.2 +049700 CALL-TEST-06-06. IC2354.2 +049800 IF ALPHA-EDITED EQUAL TO "AB C0D" IC2354.2 +049900 PERFORM PASS IC2354.2 +050000 GO TO CALL-WRITE-06-06. IC2354.2 +050100 CALL-FAIL-06-06. IC2354.2 +050200 PERFORM FAIL. IC2354.2 +050300 MOVE ALPHA-EDITED TO COMPUTED-A. IC2354.2 +050400 MOVE "AB C0D" TO CORRECT-A. IC2354.2 +050500 MOVE "ALPHANUMERIC EDITED" TO RE-MARK. IC2354.2 +050600 CALL-WRITE-06-06. IC2354.2 +050700 ADD 1 TO REC-CT. IC2354.2 +050800 PERFORM PRINT-DETAIL. IC2354.2 +050900 CALL-TEST-06-07. IC2354.2 +051000 IF ELEM-NON-01 = "ZZ" IC2354.2 +051100 PERFORM PASS IC2354.2 +051200 GO TO CALL-WRITE-06-07. IC2354.2 +051300 CALL-FAIL-06-07. IC2354.2 +051400 PERFORM FAIL. IC2354.2 +051500 MOVE ELEM-NON-01 TO COMPUTED-A. IC2354.2 +051600 MOVE "ZZ" TO CORRECT-A. IC2354.2 +051700 MOVE "ELEMENTARY NON LEVEL-01 DATA ITEM" TO RE-MARK. IC2354.2 +051800 CALL-WRITE-06-07. IC2354.2 +051900 MOVE "X-27 5.2.3 SR3" TO ANSI-REFERENCE. IC2354.2 +052000 ADD 1 TO REC-CT. IC2354.2 +052100 PERFORM PRINT-DETAIL. IC2354.2 +052200 CALL-TEST-06-08. IC2354.2 +052300 IF SUBSCRIPTED-DATA (4) = "1A" IC2354.2 +052400 PERFORM PASS IC2354.2 +052500 GO TO CALL-WRITE-06-08. IC2354.2 +052600 CALL-FAIL-06-08. IC2354.2 +052700 PERFORM FAIL. IC2354.2 +052800 MOVE SUBSCRIPTED-DATA (4) TO COMPUTED-A. IC2354.2 +052900 MOVE "1A" TO CORRECT-A. IC2354.2 +053000 MOVE "SUBSCRIPTED LINKAGE DATA ITEM" TO RE-MARK. IC2354.2 +053100 CALL-WRITE-06-08. IC2354.2 +053200 MOVE "XVII-46 (59)" TO ANSI-REFERENCE. IC2354.2 +053300 ADD 1 TO REC-CT. IC2354.2 +053400 PERFORM PRINT-DETAIL. IC2354.2 +053500* IC2354.2 +053600 GO TO CCVS-EXIT. IC2354.2 +053700 CCVS-EXIT SECTION. IC2354.2 +053800 CCVS-999999. IC2354.2 +053900 GO TO CLOSE-FILES. IC2354.2 +054000 IDENTIFICATION DIVISION. IC2354.2 +054100 PROGRAM-ID. IC2354.2 +054200 IC235A-1. IC2354.2 +054300**************************************************************** IC2354.2 +054400* * IC2354.2 +054500* VALIDATION FOR:- * IC2354.2 +054600* * IC2354.2 +054700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +054800* * IC2354.2 +054900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2 +055000* * IC2354.2 +055100**************************************************************** IC2354.2 +055200* * IC2354.2 +055300* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2 +055400* * IC2354.2 +055500* X-55 - SYSTEM PRINTER NAME. * IC2354.2 +055600* X-82 - SOURCE COMPUTER NAME. * IC2354.2 +055700* X-83 - OBJECT COMPUTER NAME. * IC2354.2 +055800* * IC2354.2 +055900**************************************************************** IC2354.2 +056000* THE SUBPROGRAM IC235A-1 HAS THREE OPERANDS IN THE IC2354.2 +056100* USING PHRASE OF THE PROCEDURE DIVISION HEADER. TWO IC2354.2 +056200* OPERANDS ARE 01 GROUP ITEMS AND THE THIRD OPERAND IS IC2354.2 +056300* AN ELEMENTARY 77 ITEM. THE DATA DESCRIPTIONS OF THESE IC2354.2 +056400* OPERANDS IN THE LINKAGE SECTION ARE NOT THE SAME AS THE IC2354.2 +056500* DATA DESCRIPTIONS IN THE WORKING-STORAGE SECTION OF THE IC2354.2 +056600* CALLING PROGRAM, BUT AN EQUAL NUMBER OF CHARACTER IC2354.2 +056700* POSITIONS ARE DEFINED. THE CALLING PROGRAM IS IC235. IC2354.2 +056800 ENVIRONMENT DIVISION. IC2354.2 +056900 INPUT-OUTPUT SECTION. IC2354.2 +057000 FILE-CONTROL. IC2354.2 +057100 SELECT PRINT-FILE ASSIGN TO IC2354.2 +057200 "report.log". IC2354.2 +057300 DATA DIVISION. IC2354.2 +057400 FILE SECTION. IC2354.2 +057500 FD PRINT-FILE. IC2354.2 +057600 01 PRINT-REC PICTURE X(120). IC2354.2 +057700 01 DUMMY-RECORD PICTURE X(120). IC2354.2 +057800 WORKING-STORAGE SECTION. IC2354.2 +057900 01 CONSTANT-VALUES. IC2354.2 +058000 02 AN-CONSTANT PIC X(8) VALUE "IC235A-1". IC2354.2 +058100 02 NUM-CONSTANT PIC 99V9999 VALUE 0.7654. IC2354.2 +058200 LINKAGE SECTION. IC2354.2 +058300 01 GRP-01. IC2354.2 +058400 02 AN-FIELD PICTURE X(8). IC2354.2 +058500 02 NUM-DISPLAY PIC 99. IC2354.2 +058600 02 GRP-LEVEL. IC2354.2 +058700 03 A-FIELD PICTURE A(3). IC2354.2 +058800 77 ELEM-01 PIC V9(4) COMPUTATIONAL. IC2354.2 +058900 01 GRP-02. IC2354.2 +059000 02 GRP-03. IC2354.2 +059100 03 NUM-ITEM PICTURE S99. IC2354.2 +059200 03 EDITED-FIELD PIC XXBX0X. IC2354.2 +059300 01 ELEM-NON-01 PIC XX. IC2354.2 +059400 01 SUBSCRIPTED-DATA PIC XX. IC2354.2 +059500 PROCEDURE DIVISION USING GRP-01 ELEM-01 GRP-02 IC2354.2 +059600 ELEM-NON-01 SUBSCRIPTED-DATA. IC2354.2 +059700 SECT-IC235A-1-001 SECTION. IC2354.2 +059800* THIS SECTION SETS THE PARAMETER FIELDS REFERRED TO IC2354.2 +059900* IN THE USING PHRASE AND DEFINED IN THE LINKAGE SECTION. IC2354.2 +060000 CALL-TEST-06. IC2354.2 +060100 MOVE AN-CONSTANT TO AN-FIELD. IC2354.2 +060200 ADD 25 TO NUM-DISPLAY. IC2354.2 +060300 MOVE "YES" TO A-FIELD. IC2354.2 +060400 MOVE NUM-CONSTANT TO ELEM-01. IC2354.2 +060500 MOVE NUM-DISPLAY TO NUM-ITEM. IC2354.2 +060600 MOVE "ABCD" TO EDITED-FIELD. IC2354.2 +060700 MOVE "ZZ" TO ELEM-NON-01. IC2354.2 +060800 MOVE "1A" TO SUBSCRIPTED-DATA. IC2354.2 +060900 CALL-EXIT-06. IC2354.2 +061000 EXIT PROGRAM. IC2354.2 +061100 END PROGRAM IC235A-1. IC2354.2 +061200 IDENTIFICATION DIVISION. IC2354.2 +061300 PROGRAM-ID. IC2354.2 +061400 IC235A-2. IC2354.2 +061500**************************************************************** IC2354.2 +061600* * IC2354.2 +061700* VALIDATION FOR:- * IC2354.2 +061800* * IC2354.2 +061900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2 +062000* * IC2354.2 +062100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2 +062200* * IC2354.2 +062300**************************************************************** IC2354.2 +062400* * IC2354.2 +062500* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2 +062600* * IC2354.2 +062700* X-55 - SYSTEM PRINTER NAME. * IC2354.2 +062800* X-82 - SOURCE COMPUTER NAME. * IC2354.2 +062900* X-83 - OBJECT COMPUTER NAME. * IC2354.2 +063000* * IC2354.2 +063100**************************************************************** IC2354.2 +063200* THE SUBPROGRAM IC235A-2 HAS TWO OPERANDS IN THE IC2354.2 +063300* PROCEDURE DIVISION HEADER AND THE ROUTINE CONTAINS IC2354.2 +063400* FOUR EXIT PROGRAM STATEMENTS. THE CALLING PROGRAM IC2354.2 +063500* IS IC235. IC2354.2 +063600 ENVIRONMENT DIVISION. IC2354.2 +063700 DATA DIVISION. IC2354.2 +063800 LINKAGE SECTION. IC2354.2 +063900 77 DN1 PICTURE 999. IC2354.2 +064000 77 DN2 PICTURE S99 COMPUTATIONAL. IC2354.2 +064100 PROCEDURE DIVISION USING DN1 DN2. IC2354.2 +064200* THIS SUBPROGRAM CONTANS FOUR EXIT PROGRAM STATEMENTS. IC2354.2 +064300 SECT-IC235A-2-0001 SECTION. IC2354.2 +064400 EXIT-TEST-001. IC2354.2 +064500 IF DN1 IS NOT EQUAL TO 1 IC2354.2 +064600 GO TO EXIT-TEST-002. IC2354.2 +064700 MOVE 1 TO DN2. IC2354.2 +064800 EXIT PROGRAM. IC2354.2 +064900 EXIT-TEST-002. IC2354.2 +065000 IF DN1 IS NOT EQUAL TO 2 IC2354.2 +065100 GO TO EXIT-TEST-003. IC2354.2 +065200 MOVE 2 TO DN2. IC2354.2 +065300 EXIT PROGRAM. IC2354.2 +065400 EXIT-TEST-003. IC2354.2 +065500 IF DN1 NOT EQUAL TO 3 IC2354.2 +065600 GO TO EXIT-TEST-004. IC2354.2 +065700 MOVE 3 TO DN2. IC2354.2 +065800 EXIT PROGRAM. IC2354.2 +065900 EXIT-TEST-004. IC2354.2 +066000 MOVE 4 TO DN2. IC2354.2 +066100 GO TO EXIT-STATEMENT-004. IC2354.2 +066200 EXTRANEOUS-PARAGRAPH. IC2354.2 +066300* THIS PARAGRAPH IS NEVER EXECUTED. IC2354.2 +066400 MOVE 5 TO DN2. IC2354.2 +066500 EXIT-STATEMENT-004. IC2354.2 +066600 EXIT PROGRAM. IC2354.2 +066700 END PROGRAM IC235A-2. IC2354.2 +066800 END PROGRAM IC235A. IC2354.2 diff --git a/tests/cobol85/IC/IC237A.CBL b/tests/cobol85/IC/IC237A.CBL new file mode 100755 index 00000000..163f35c6 --- /dev/null +++ b/tests/cobol85/IC/IC237A.CBL @@ -0,0 +1,433 @@ +000100 IDENTIFICATION DIVISION. IC2374.2 +000200 PROGRAM-ID. IC2374.2 +000300 IC237A. IC2374.2 +000400**************************************************************** IC2374.2 +000500* * IC2374.2 +000600* VALIDATION FOR:- * IC2374.2 +000700* * IC2374.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2374.2 +000900* * IC2374.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2374.2 +001100* * IC2374.2 +001200**************************************************************** IC2374.2 +001300* * IC2374.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2374.2 +001500* * IC2374.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2374.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2374.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2374.2 +001900* * IC2374.2 +002000**************************************************************** IC2374.2 +002100* * IC2374.2 +002200* PROGRAMS IC237A AND IC237A-1 TEST THE ACCESSING OF A * IC2374.2 +002300* LINKAGE SECTION ITEM. * IC2374.2 +002400* * IC2374.2 +002500**************************************************************** IC2374.2 +002600 ENVIRONMENT DIVISION. IC2374.2 +002700 CONFIGURATION SECTION. IC2374.2 +002800 SOURCE-COMPUTER. IC2374.2 +002900 Linux. IC2374.2 +003000 OBJECT-COMPUTER. IC2374.2 +003100 Linux. IC2374.2 +003200 INPUT-OUTPUT SECTION. IC2374.2 +003300 FILE-CONTROL. IC2374.2 +003400 SELECT PRINT-FILE ASSIGN TO IC2374.2 +003500 "report.log". IC2374.2 +003600 DATA DIVISION. IC2374.2 +003700 FILE SECTION. IC2374.2 +003800 FD PRINT-FILE. IC2374.2 +003900 01 PRINT-REC PICTURE X(120). IC2374.2 +004000 01 DUMMY-RECORD PICTURE X(120). IC2374.2 +004100 WORKING-STORAGE SECTION. IC2374.2 +004200 01 WS-A PIC 9 VALUE ZERO. IC2374.2 +004300 01 WS-B PIC 9 VALUE ZERO. IC2374.2 +004400 01 WS-C PIC 9 VALUE ZERO. IC2374.2 +004500* IC2374.2 +004600 01 TEST-RESULTS. IC2374.2 +004700 02 FILLER PIC X VALUE SPACE. IC2374.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. IC2374.2 +004900 02 FILLER PIC X VALUE SPACE. IC2374.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. IC2374.2 +005100 02 FILLER PIC X VALUE SPACE. IC2374.2 +005200 02 PAR-NAME. IC2374.2 +005300 03 FILLER PIC X(19) VALUE SPACE. IC2374.2 +005400 03 PARDOT-X PIC X VALUE SPACE. IC2374.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. IC2374.2 +005600 02 FILLER PIC X(8) VALUE SPACE. IC2374.2 +005700 02 RE-MARK PIC X(61). IC2374.2 +005800 01 TEST-COMPUTED. IC2374.2 +005900 02 FILLER PIC X(30) VALUE SPACE. IC2374.2 +006000 02 FILLER PIC X(17) VALUE IC2374.2 +006100 " COMPUTED=". IC2374.2 +006200 02 COMPUTED-X. IC2374.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2374.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A IC2374.2 +006500 PIC -9(9).9(9). IC2374.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2374.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2374.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2374.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. IC2374.2 +007000 04 COMPUTED-18V0 PIC -9(18). IC2374.2 +007100 04 FILLER PIC X. IC2374.2 +007200 03 FILLER PIC X(50) VALUE SPACE. IC2374.2 +007300 01 TEST-CORRECT. IC2374.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IC2374.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". IC2374.2 +007600 02 CORRECT-X. IC2374.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. IC2374.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2374.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2374.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2374.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2374.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. IC2374.2 +008300 04 CORRECT-18V0 PIC -9(18). IC2374.2 +008400 04 FILLER PIC X. IC2374.2 +008500 03 FILLER PIC X(2) VALUE SPACE. IC2374.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2374.2 +008700 01 CCVS-C-1. IC2374.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2374.2 +008900- "SS PARAGRAPH-NAME IC2374.2 +009000- " REMARKS". IC2374.2 +009100 02 FILLER PIC X(20) VALUE SPACE. IC2374.2 +009200 01 CCVS-C-2. IC2374.2 +009300 02 FILLER PIC X VALUE SPACE. IC2374.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". IC2374.2 +009500 02 FILLER PIC X(15) VALUE SPACE. IC2374.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". IC2374.2 +009700 02 FILLER PIC X(94) VALUE SPACE. IC2374.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2374.2 +009900 01 REC-CT PIC 99 VALUE ZERO. IC2374.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2374.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2374.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2374.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2374.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2374.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2374.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2374.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2374.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2374.2 +010900 01 CCVS-H-1. IC2374.2 +011000 02 FILLER PIC X(39) VALUE SPACES. IC2374.2 +011100 02 FILLER PIC X(42) VALUE IC2374.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2374.2 +011300 02 FILLER PIC X(39) VALUE SPACES. IC2374.2 +011400 01 CCVS-H-2A. IC2374.2 +011500 02 FILLER PIC X(40) VALUE SPACE. IC2374.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2374.2 +011700 02 FILLER PIC XXXX VALUE IC2374.2 +011800 "4.2 ". IC2374.2 +011900 02 FILLER PIC X(28) VALUE IC2374.2 +012000 " COPY - NOT FOR DISTRIBUTION". IC2374.2 +012100 02 FILLER PIC X(41) VALUE SPACE. IC2374.2 +012200 IC2374.2 +012300 01 CCVS-H-2B. IC2374.2 +012400 02 FILLER PIC X(15) VALUE IC2374.2 +012500 "TEST RESULT OF ". IC2374.2 +012600 02 TEST-ID PIC X(9). IC2374.2 +012700 02 FILLER PIC X(4) VALUE IC2374.2 +012800 " IN ". IC2374.2 +012900 02 FILLER PIC X(12) VALUE IC2374.2 +013000 " HIGH ". IC2374.2 +013100 02 FILLER PIC X(22) VALUE IC2374.2 +013200 " LEVEL VALIDATION FOR ". IC2374.2 +013300 02 FILLER PIC X(58) VALUE IC2374.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2374.2 +013500 01 CCVS-H-3. IC2374.2 +013600 02 FILLER PIC X(34) VALUE IC2374.2 +013700 " FOR OFFICIAL USE ONLY ". IC2374.2 +013800 02 FILLER PIC X(58) VALUE IC2374.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2374.2 +014000 02 FILLER PIC X(28) VALUE IC2374.2 +014100 " COPYRIGHT 1985 ". IC2374.2 +014200 01 CCVS-E-1. IC2374.2 +014300 02 FILLER PIC X(52) VALUE SPACE. IC2374.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2374.2 +014500 02 ID-AGAIN PIC X(9). IC2374.2 +014600 02 FILLER PIC X(45) VALUE SPACES. IC2374.2 +014700 01 CCVS-E-2. IC2374.2 +014800 02 FILLER PIC X(31) VALUE SPACE. IC2374.2 +014900 02 FILLER PIC X(21) VALUE SPACE. IC2374.2 +015000 02 CCVS-E-2-2. IC2374.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2374.2 +015200 03 FILLER PIC X VALUE SPACE. IC2374.2 +015300 03 ENDER-DESC PIC X(44) VALUE IC2374.2 +015400 "ERRORS ENCOUNTERED". IC2374.2 +015500 01 CCVS-E-3. IC2374.2 +015600 02 FILLER PIC X(22) VALUE IC2374.2 +015700 " FOR OFFICIAL USE ONLY". IC2374.2 +015800 02 FILLER PIC X(12) VALUE SPACE. IC2374.2 +015900 02 FILLER PIC X(58) VALUE IC2374.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2374.2 +016100 02 FILLER PIC X(13) VALUE SPACE. IC2374.2 +016200 02 FILLER PIC X(15) VALUE IC2374.2 +016300 " COPYRIGHT 1985". IC2374.2 +016400 01 CCVS-E-4. IC2374.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2374.2 +016600 02 FILLER PIC X(4) VALUE " OF ". IC2374.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2374.2 +016800 02 FILLER PIC X(40) VALUE IC2374.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". IC2374.2 +017000 01 XXINFO. IC2374.2 +017100 02 FILLER PIC X(19) VALUE IC2374.2 +017200 "*** INFORMATION ***". IC2374.2 +017300 02 INFO-TEXT. IC2374.2 +017400 04 FILLER PIC X(8) VALUE SPACE. IC2374.2 +017500 04 XXCOMPUTED PIC X(20). IC2374.2 +017600 04 FILLER PIC X(5) VALUE SPACE. IC2374.2 +017700 04 XXCORRECT PIC X(20). IC2374.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). IC2374.2 +017900 01 HYPHEN-LINE. IC2374.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. IC2374.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************IC2374.2 +018200- "*****************************************". IC2374.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************IC2374.2 +018400- "******************************". IC2374.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE IC2374.2 +018600 "IC237A". IC2374.2 +018700 PROCEDURE DIVISION. IC2374.2 +018800 CCVS1 SECTION. IC2374.2 +018900 OPEN-FILES. IC2374.2 +019000 OPEN OUTPUT PRINT-FILE. IC2374.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2374.2 +019200 MOVE SPACE TO TEST-RESULTS. IC2374.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2374.2 +019400 GO TO CCVS1-EXIT. IC2374.2 +019500 CLOSE-FILES. IC2374.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2374.2 +019700 TERMINATE-CCVS. IC2374.2 +019800*S EXIT PROGRAM. IC2374.2 +019900*SERMINATE-CALL. IC2374.2 +020000 STOP RUN. IC2374.2 +020100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2374.2 +020200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2374.2 +020300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2374.2 +020400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2374.2 +020500 MOVE "****TEST DELETED****" TO RE-MARK. IC2374.2 +020600 PRINT-DETAIL. IC2374.2 +020700 IF REC-CT NOT EQUAL TO ZERO IC2374.2 +020800 MOVE "." TO PARDOT-X IC2374.2 +020900 MOVE REC-CT TO DOTVALUE. IC2374.2 +021000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2374.2 +021100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2374.2 +021200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2374.2 +021300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2374.2 +021400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2374.2 +021500 MOVE SPACE TO CORRECT-X. IC2374.2 +021600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2374.2 +021700 MOVE SPACE TO RE-MARK. IC2374.2 +021800 HEAD-ROUTINE. IC2374.2 +021900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +022000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +022100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2374.2 +022200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2374.2 +022300 COLUMN-NAMES-ROUTINE. IC2374.2 +022400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +022500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +022700 END-ROUTINE. IC2374.2 +022800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2374.2 +022900 END-RTN-EXIT. IC2374.2 +023000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +023100 END-ROUTINE-1. IC2374.2 +023200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2374.2 +023300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2374.2 +023400 ADD PASS-COUNTER TO ERROR-HOLD. IC2374.2 +023500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2374.2 +023600 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2374.2 +023700 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2374.2 +023800 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2374.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2374.2 +024000 END-ROUTINE-12. IC2374.2 +024100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2374.2 +024200 IF ERROR-COUNTER IS EQUAL TO ZERO IC2374.2 +024300 MOVE "NO " TO ERROR-TOTAL IC2374.2 +024400 ELSE IC2374.2 +024500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2374.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2374.2 +024700 PERFORM WRITE-LINE. IC2374.2 +024800 END-ROUTINE-13. IC2374.2 +024900 IF DELETE-COUNTER IS EQUAL TO ZERO IC2374.2 +025000 MOVE "NO " TO ERROR-TOTAL ELSE IC2374.2 +025100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2374.2 +025200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2374.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +025400 IF INSPECT-COUNTER EQUAL TO ZERO IC2374.2 +025500 MOVE "NO " TO ERROR-TOTAL IC2374.2 +025600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2374.2 +025700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2374.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +025900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2374.2 +026000 WRITE-LINE. IC2374.2 +026100 ADD 1 TO RECORD-COUNT. IC2374.2 +026200 IF RECORD-COUNT GREATER 50 IC2374.2 +026300 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2374.2 +026400 MOVE SPACE TO DUMMY-RECORD IC2374.2 +026500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2374.2 +026600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2374.2 +026700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2374.2 +026800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2374.2 +026900 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2374.2 +027000 MOVE ZERO TO RECORD-COUNT. IC2374.2 +027100 PERFORM WRT-LN. IC2374.2 +027200 WRT-LN. IC2374.2 +027300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2374.2 +027400 MOVE SPACE TO DUMMY-RECORD. IC2374.2 +027500 BLANK-LINE-PRINT. IC2374.2 +027600 PERFORM WRT-LN. IC2374.2 +027700 FAIL-ROUTINE. IC2374.2 +027800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2374.2 +027900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2374.2 +028000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2374.2 +028100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2374.2 +028200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +028300 MOVE SPACES TO INF-ANSI-REFERENCE. IC2374.2 +028400 GO TO FAIL-ROUTINE-EX. IC2374.2 +028500 FAIL-ROUTINE-WRITE. IC2374.2 +028600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2374.2 +028700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2374.2 +028800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2374.2 +028900 MOVE SPACES TO COR-ANSI-REFERENCE. IC2374.2 +029000 FAIL-ROUTINE-EX. EXIT. IC2374.2 +029100 BAIL-OUT. IC2374.2 +029200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2374.2 +029300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2374.2 +029400 BAIL-OUT-WRITE. IC2374.2 +029500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2374.2 +029600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2374.2 +029700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2374.2 +029800 MOVE SPACES TO INF-ANSI-REFERENCE. IC2374.2 +029900 BAIL-OUT-EX. EXIT. IC2374.2 +030000 CCVS1-EXIT. IC2374.2 +030100 EXIT. IC2374.2 +030200 SECT-IC237A-001 SECTION. IC2374.2 +030300* IC2374.2 +030400 CALL-INIT-1. IC2374.2 +030500 MOVE "CALL-TEST-1" TO PAR-NAME. IC2374.2 +030600 MOVE 1 TO WS-A. IC2374.2 +030700 MOVE 3 TO WS-B. IC2374.2 +030800 MOVE 5 TO WS-C. IC2374.2 +030900 CALL-TEST-0. IC2374.2 +031000 CALL "IC237A-1" USING WS-A WS-B WS-C. IC2374.2 +031100 CALL-TEST-1. IC2374.2 +031200 IF WS-C = WS-A IC2374.2 +031300 PERFORM PASS IC2374.2 +031400 PERFORM PRINT-DETAIL IC2374.2 +031500 ELSE IC2374.2 +031600 MOVE 1 TO CORRECT-N IC2374.2 +031700 MOVE WS-A TO COMPUTED-N IC2374.2 +031800 MOVE "WRONG VALUE RETURNED FROM CALL TO IC237A-1" IC2374.2 +031900 TO RE-MARK IC2374.2 +032000 PERFORM FAIL IC2374.2 +032100 PERFORM PRINT-DETAIL. IC2374.2 +032200* IC2374.2 +032300 CCVS-EXIT SECTION. IC2374.2 +032400 CCVS-999999. IC2374.2 +032500 GO TO CLOSE-FILES. IC2374.2 +032600 END PROGRAM IC237A. IC2374.2 +032700 IDENTIFICATION DIVISION. IC2374.2 +032800 PROGRAM-ID. IC2374.2 +032900 IC237A-1. IC2374.2 +033000**************************************************************** IC2374.2 +033100* * IC2374.2 +033200* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2374.2 +033300* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2374.2 +033400* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2374.2 +033500* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2374.2 +033600* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2374.2 +033700* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2374.2 +033800* * IC2374.2 +033900* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2374.2 +034000* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2374.2 +034100* DOCUMENT REFERENCE: ISO-1989-1978). * IC2374.2 +034200* * IC2374.2 +034300* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2374.2 +034400* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2374.2 +034500* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2374.2 +034600* * IC2374.2 +034700* THE FEDERAL SOFTWARE TESTING CENTER * IC2374.2 +034800* OFFICE OF SOFTWARE DEVELOPMENT * IC2374.2 +034900* & INFORMATION TECHNOLOGY * IC2374.2 +035000* TWO SKYLINE PLACE * IC2374.2 +035100* SUITE 1100 * IC2374.2 +035200* 5203 LEESBURG PIKE * IC2374.2 +035300* FALLS CHURCH * IC2374.2 +035400* VA 22041 * IC2374.2 +035500* U.S.A. * IC2374.2 +035600* * IC2374.2 +035700* THE PROJECT TEAM MEMBERS WERE: * IC2374.2 +035800* * IC2374.2 +035900* BIADI (BUREAU INTER ADMINISTRATION * IC2374.2 +036000* DE DOCUMENTATION INFORMATIQUE) * IC2374.2 +036100* 21 RUE BARA * IC2374.2 +036200* F-92132 ISSY * IC2374.2 +036300* FRANCE * IC2374.2 +036400* * IC2374.2 +036500* * IC2374.2 +036600* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2374.2 +036700* UND DATENVERARBEITUNG MBH) * IC2374.2 +036800* SCHLOSS BIRLINGHOVEN * IC2374.2 +036900* POSTFACH 12 40 * IC2374.2 +037000* D-5205 ST. AUGUSTIN 1 * IC2374.2 +037100* GERMANY FR * IC2374.2 +037200* * IC2374.2 +037300* * IC2374.2 +037400* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2374.2 +037500* OXFORD ROAD * IC2374.2 +037600* MANCHESTER * IC2374.2 +037700* M1 7ED * IC2374.2 +037800* UNITED KINGDOM * IC2374.2 +037900* * IC2374.2 +038000* * IC2374.2 +038100* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2374.2 +038200* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2374.2 +038300* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2374.2 +038400* * IC2374.2 +038500**************************************************************** IC2374.2 +038600* * IC2374.2 +038700* VALIDATION FOR:- * IC2374.2 +038800* * IC2374.2 +038900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2374.2 +039000* * IC2374.2 +039100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2374.2 +039200* * IC2374.2 +039300**************************************************************** IC2374.2 +039400* * IC2374.2 +039500* X-CARDS USED BY THIS PROGRAM ARE :- * IC2374.2 +039600* * IC2374.2 +039700* X-55 - SYSTEM PRINTER NAME. * IC2374.2 +039800* X-82 - SOURCE COMPUTER NAME. * IC2374.2 +039900* X-83 - OBJECT COMPUTER NAME. * IC2374.2 +040000* * IC2374.2 +040100**************************************************************** IC2374.2 +040200 ENVIRONMENT DIVISION. IC2374.2 +040300 CONFIGURATION SECTION. IC2374.2 +040400 SOURCE-COMPUTER. IC2374.2 +040500 Linux. IC2374.2 +040600 OBJECT-COMPUTER. IC2374.2 +040700 Linux. IC2374.2 +040800 INPUT-OUTPUT SECTION. IC2374.2 +040900 FILE-CONTROL. IC2374.2 +041000 SELECT PRINT-FILE ASSIGN TO IC2374.2 +041100 "report.log". IC2374.2 +041200 DATA DIVISION. IC2374.2 +041300 FILE SECTION. IC2374.2 +041400 FD PRINT-FILE. IC2374.2 +041500 01 PRINT-REC PICTURE X(120). IC2374.2 +041600 01 DUMMY-RECORD PICTURE X(120). IC2374.2 +041700 WORKING-STORAGE SECTION. IC2374.2 +041800* IC2374.2 +041900 LINKAGE SECTION. IC2374.2 +042000 01 L-A PIC 9. IC2374.2 +042100 01 L-A1 REDEFINES L-A PIC 9. IC2374.2 +042200 01 L-B PIC 9. IC2374.2 +042300 01 L-C PIC 9. IC2374.2 +042400 PROCEDURE DIVISION USING L-A L-B L-C. IC2374.2 +042500* IC2374.2 +042600 SECT-IC237A-1-001 SECTION. IC2374.2 +042700* IC2374.2 +042800 CALLED-FROM-NC121A-FUNCTION. IC2374.2 +042900 MOVE L-A1 TO L-C. IC2374.2 +043000 IC237A-EXIT. IC2374.2 +043100 EXIT PROGRAM. IC2374.2 +043200 END-OF-PROGRAM. IC2374.2 +043300 END PROGRAM IC237A-1. IC2374.2 diff --git a/tests/cobol85/IC/IC401M.CBL b/tests/cobol85/IC/IC401M.CBL new file mode 100755 index 00000000..4f930819 --- /dev/null +++ b/tests/cobol85/IC/IC401M.CBL @@ -0,0 +1,74 @@ +000100 IDENTIFICATION DIVISION. IC4014.2 +000200 PROGRAM-ID. IC4014.2 +000300 IC401M IS INITIAL. IC4014.2 +000400*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +000500 IC4014.2 +000600*The following program tests the flagging of high IC4014.2 +000700*subset Features that are used in inter-program IC4014.2 +000800*communication. IC4014.2 +000900 ENVIRONMENT DIVISION. IC4014.2 +001000 CONFIGURATION SECTION. IC4014.2 +001100 SOURCE-COMPUTER. IC4014.2 +001200 Linux. IC4014.2 +001300 OBJECT-COMPUTER. IC4014.2 +001400 Linux. IC4014.2 +001500 DATA DIVISION. IC4014.2 +001600 WORKING-STORAGE SECTION. IC4014.2 +001700 IC4014.2 +001800 01 GLOB IS GLOBAL PIC IS X(2) VALUE IS "HI". IC4014.2 +001900*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +002000 IC4014.2 +002100 01 EXTE IS EXTERNAL PIC IS X(5). IC4014.2 +002200*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +002300 IC4014.2 +002400 PROCEDURE DIVISION. IC4014.2 +002500 IC4014.2 +002600 DECLARATIVES. IC4014.2 +002700 IC4014.2 +002800 IC401M-USE SECTION. IC4014.2 +002900 USE GLOBAL AFTER STANDARD ERROR PROCEDURE ON I-O. IC4014.2 +003000*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +003100 IC4014.2 +003200 END DECLARATIVES. IC4014.2 +003300 IC401M-NONDECL SECTION. IC4014.2 +003400 IC401M-CONTROL. IC4014.2 +003500 PERFORM IC401M-CANCEL THRU IC401M-BYCONT. IC4014.2 +003600 STOP RUN. IC4014.2 +003700 IC4014.2 +003800 IC401M-CANCEL. IC4014.2 +003900 CANCEL "NESTEDPROG". IC4014.2 +004000*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +004100 IC4014.2 +004200 IC4014.2 +004300 IC401M-BYREF. IC4014.2 +004400 CALL "NESTEDPROG" USING BY REFERENCE GLOB. IC4014.2 +004500*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +004600 IC4014.2 +004700 IC4014.2 +004800 IC401M-BYCONT. IC4014.2 +004900 CALL "FIC401M" USING BY CONTENT GLOB. IC4014.2 +005000*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +005100 IC4014.2 +005200 IC4014.2 +005300 IDENTIFICATION DIVISION. IC4014.2 +005400*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +005500 IC4014.2 +005600 PROGRAM-ID. IC4014.2 +005700 NESTEDPROG IS COMMON. IC4014.2 +005800*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +005900 IC4014.2 +006000 ENVIRONMENT DIVISION. IC4014.2 +006100 DATA DIVISION. IC4014.2 +006200 LINKAGE SECTION. IC4014.2 +006300 01 GLOB-2 PIC X(2). IC4014.2 +006400 IC4014.2 +006500 PROCEDURE DIVISION USING GLOB-2. IC4014.2 +006600 DUMMY-PARA. IC4014.2 +006700 DISPLAY "HELLO". IC4014.2 +006800 IC4014.2 +006900 END-PARA. IC4014.2 +007000*TOTAL NUMBER OF FLAGS EXPECTED = 11. IC4014.2 +007100 END PROGRAM NESTEDPROG. IC4014.2 +007200*Message expected for above statement: NON-CONFORMING STANDARD IC4014.2 +007300*Message expected for following statement: NON-CONFORMING STANDARDIC4014.2 +007400 END PROGRAM IC401M. IC4014.2 diff --git a/tests/cobol85/IC/lib/IC102A.CBL b/tests/cobol85/IC/lib/IC102A.CBL new file mode 100755 index 00000000..556701ec --- /dev/null +++ b/tests/cobol85/IC/lib/IC102A.CBL @@ -0,0 +1,48 @@ +000100 IDENTIFICATION DIVISION. IC1024.2 +000200 PROGRAM-ID. IC1024.2 +000300 IC102A. IC1024.2 +000400**************************************************************** IC1024.2 +000500* * IC1024.2 +000600* VALIDATION FOR:- * IC1024.2 +000700* * IC1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1024.2 +000900* * IC1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1024.2 +001100* * IC1024.2 +001200**************************************************************** IC1024.2 +001300* * IC1024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1024.2 +001500* * IC1024.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1024.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1024.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1024.2 +001900* * IC1024.2 +002000**************************************************************** IC1024.2 +002100* THIS PROGRAM TESTS THE USE OF THE LINKAGE SECTION IC1024.2 +002200* AND USING PHRASE IN THE PROCEDURE DIVISION HEADER. IC1024.2 +002300 ENVIRONMENT DIVISION. IC1024.2 +002400 CONFIGURATION SECTION. IC1024.2 +002500 SOURCE-COMPUTER. IC1024.2 +002600 Linux. IC1024.2 +002700 OBJECT-COMPUTER. IC1024.2 +002800 Linux. IC1024.2 +002900 INPUT-OUTPUT SECTION. IC1024.2 +003000 FILE-CONTROL. IC1024.2 +003100 SELECT PRINT-FILE ASSIGN TO IC1024.2 +003200 "report.log". IC1024.2 +003300 DATA DIVISION. IC1024.2 +003400 FILE SECTION. IC1024.2 +003500 FD PRINT-FILE. IC1024.2 +003600 01 PRINT-REC PICTURE X(120). IC1024.2 +003700 01 DUMMY-RECORD PICTURE X(120). IC1024.2 +003800 WORKING-STORAGE SECTION. IC1024.2 +003900 77 DN2 PICTURE S9 VALUE ZERO. IC1024.2 +004000 LINKAGE SECTION. IC1024.2 +004100 77 DN1 PICTURE S9. IC1024.2 +004200 PROCEDURE DIVISION USING DN1. IC1024.2 +004300 SECT-IC102-0001 SECTION. IC1024.2 +004400 CALL-TEST-001. IC1024.2 +004500 ADD 1 TO DN2. IC1024.2 +004600 MOVE DN2 TO DN1. IC1024.2 +004700 CALL-EXIT-001. IC1024.2 +004800 EXIT PROGRAM. IC1024.2 diff --git a/tests/cobol85/IC/lib/IC104A.CBL b/tests/cobol85/IC/lib/IC104A.CBL new file mode 100755 index 00000000..fdd80328 --- /dev/null +++ b/tests/cobol85/IC/lib/IC104A.CBL @@ -0,0 +1,71 @@ +000100 IDENTIFICATION DIVISION. IC1044.2 +000200 PROGRAM-ID. IC1044.2 +000300 IC104A. IC1044.2 +000400**************************************************************** IC1044.2 +000500* * IC1044.2 +000600* VALIDATION FOR:- * IC1044.2 +000700* * IC1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1044.2 +000900* * IC1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1044.2 +001100* * IC1044.2 +001200**************************************************************** IC1044.2 +001300* * IC1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1044.2 +001500* * IC1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1044.2 +001900* * IC1044.2 +002000**************************************************************** IC1044.2 +002100* THE SUBPROGRAM IC104 HAS THREE OPERANDS IN THE IC1044.2 +002200* USING PHRASE OF THE PROCEDURE DIVISION HEADER. TWO IC1044.2 +002300* OPERANDS ARE 01 GROUP ITEMS AND THE THIRD OPERAND IS IC1044.2 +002400* AN ELEMENTARY 77 ITEM. THE DATA DESCRIPTIONS OF THESE IC1044.2 +002500* OPERANDS IN THE LINKAGE SECTION ARE NOT THE SAME AS THE IC1044.2 +002600* DATA DESCRIPTIONS IN THE WORKING-STORAGE SECTION OF THE IC1044.2 +002700* CALLING PROGRAM, BUT AN EQUAL NUMBER OF CHARACTER IC1044.2 +002800* POSITIONS ARE DEFINED. THE CALLING PROGRAM IS IC103. IC1044.2 +002900 ENVIRONMENT DIVISION. IC1044.2 +003000 CONFIGURATION SECTION. IC1044.2 +003100 SOURCE-COMPUTER. IC1044.2 +003200 Linux. IC1044.2 +003300 OBJECT-COMPUTER. IC1044.2 +003400 Linux. IC1044.2 +003500 INPUT-OUTPUT SECTION. IC1044.2 +003600 FILE-CONTROL. IC1044.2 +003700 SELECT PRINT-FILE ASSIGN TO IC1044.2 +003800 "report.log". IC1044.2 +003900 DATA DIVISION. IC1044.2 +004000 FILE SECTION. IC1044.2 +004100 FD PRINT-FILE. IC1044.2 +004200 01 PRINT-REC PICTURE X(120). IC1044.2 +004300 01 DUMMY-RECORD PICTURE X(120). IC1044.2 +004400 WORKING-STORAGE SECTION. IC1044.2 +004500 01 CONSTANT-VALUES. IC1044.2 +004600 02 AN-CONSTANT PIC X(5) VALUE "IC104". IC1044.2 +004700 02 NUM-CONSTANT PIC 99V9999 VALUE 0.7654. IC1044.2 +004800 LINKAGE SECTION. IC1044.2 +004900 01 GRP-01. IC1044.2 +005000 02 AN-FIELD PICTURE X(5). IC1044.2 +005100 02 NUM-DISPLAY PIC 99. IC1044.2 +005200 02 GRP-LEVEL. IC1044.2 +005300 03 A-FIELD PICTURE A(3). IC1044.2 +005400 77 ELEM-01 PIC V9(4) COMPUTATIONAL. IC1044.2 +005500 01 GRP-02. IC1044.2 +005600 02 GRP-03. IC1044.2 +005700 03 NUM-ITEM PICTURE S99. IC1044.2 +005800 03 EDITED-FIELD PIC XXBX0X. IC1044.2 +005900 PROCEDURE DIVISION USING GRP-01 ELEM-01 GRP-02. IC1044.2 +006000 SECT-IC104-0001 SECTION. IC1044.2 +006100* THIS SECTION SETS THE PARAMETER FIELDS REFERRED TO IC1044.2 +006200* IN THE USING PHRASE AND DEFINED IN THE LINKAGE SECTION. IC1044.2 +006300 CALL-TEST-06. IC1044.2 +006400 MOVE AN-CONSTANT TO AN-FIELD. IC1044.2 +006500 ADD 25 TO NUM-DISPLAY. IC1044.2 +006600 MOVE "YES" TO A-FIELD. IC1044.2 +006700 MOVE NUM-CONSTANT TO ELEM-01. IC1044.2 +006800 MOVE NUM-DISPLAY TO NUM-ITEM. IC1044.2 +006900 MOVE "ABCD" TO EDITED-FIELD. IC1044.2 +007000 CALL-EXIT-06. IC1044.2 +007100 EXIT PROGRAM. IC1044.2 diff --git a/tests/cobol85/IC/lib/IC105A.CBL b/tests/cobol85/IC/lib/IC105A.CBL new file mode 100755 index 00000000..111b0162 --- /dev/null +++ b/tests/cobol85/IC/lib/IC105A.CBL @@ -0,0 +1,64 @@ +000100 IDENTIFICATION DIVISION. IC1054.2 +000200 PROGRAM-ID. IC1054.2 +000300 IC105A. IC1054.2 +000400**************************************************************** IC1054.2 +000500* * IC1054.2 +000600* VALIDATION FOR:- * IC1054.2 +000700* * IC1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1054.2 +000900* * IC1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1054.2 +001100* * IC1054.2 +001200**************************************************************** IC1054.2 +001300* * IC1054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1054.2 +001500* * IC1054.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1054.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1054.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1054.2 +001900* * IC1054.2 +002000**************************************************************** IC1054.2 +002100* THE SUBPROGRAM IC105 HAS TWO OPERANDS IN THE IC1054.2 +002200* PROCEDURE DIVISION HEADER AND THE ROUTINE CONTAINS IC1054.2 +002300* FOUR EXIT PROGRAM STATEMENTS. THE CALLING PROGRAM IC1054.2 +002400* IS IC103. IC1054.2 +002500 ENVIRONMENT DIVISION. IC1054.2 +002600 CONFIGURATION SECTION. IC1054.2 +002700 SOURCE-COMPUTER. IC1054.2 +002800 Linux. IC1054.2 +002900 OBJECT-COMPUTER. IC1054.2 +003000 Linux. IC1054.2 +003100 DATA DIVISION. IC1054.2 +003200 LINKAGE SECTION. IC1054.2 +003300 77 DN1 PICTURE 999. IC1054.2 +003400 77 DN2 PICTURE S99 COMPUTATIONAL. IC1054.2 +003500 PROCEDURE DIVISION USING DN1 DN2. IC1054.2 +003600* THIS SUBPROGRAM CONTANS FOUR EXIT PROGRAM STATEMENTS. IC1054.2 +003700* REFERENCE X3.23-1974, SECTION XII, 3.4. IC1054.2 +003800 SECT-IC105-0001 SECTION. IC1054.2 +003900 EXIT-TEST-001. IC1054.2 +004000 IF DN1 IS NOT EQUAL TO 1 IC1054.2 +004100 GO TO EXIT-TEST-002. IC1054.2 +004200 MOVE 1 TO DN2. IC1054.2 +004300 EXIT-STATEMENT-001. IC1054.2 +004400 EXIT PROGRAM. IC1054.2 +004500 EXIT-TEST-002. IC1054.2 +004600 IF DN1 IS NOT EQUAL TO 2 IC1054.2 +004700 GO TO EXIT-TEST-003. IC1054.2 +004800 MOVE 2 TO DN2. IC1054.2 +004900 EXIT-STATEMENT-002. IC1054.2 +005000 EXIT PROGRAM. IC1054.2 +005100 EXIT-TEST-003. IC1054.2 +005200 IF DN1 NOT EQUAL TO 3 IC1054.2 +005300 GO TO EXIT-TEST-004. IC1054.2 +005400 MOVE 3 TO DN2. IC1054.2 +005500 EXIT-STATEMENT-003. IC1054.2 +005600 EXIT PROGRAM. IC1054.2 +005700 EXIT-TEST-004. IC1054.2 +005800 MOVE 4 TO DN2. IC1054.2 +005900 GO TO EXIT-STATEMENT-004. IC1054.2 +006000 EXTRANEOUS-PARAGRAPH. IC1054.2 +006100* THIS PARAGRAPH IS NEVER EXECUTED. IC1054.2 +006200 MOVE 5 TO DN2. IC1054.2 +006300 EXIT-STATEMENT-004. IC1054.2 +006400 EXIT PROGRAM. IC1054.2 diff --git a/tests/cobol85/IC/lib/IC107A.CBL b/tests/cobol85/IC/lib/IC107A.CBL new file mode 100755 index 00000000..65d52af8 --- /dev/null +++ b/tests/cobol85/IC/lib/IC107A.CBL @@ -0,0 +1,109 @@ +000100 IDENTIFICATION DIVISION. IC1074.2 +000200 PROGRAM-ID. IC1074.2 +000300 IC107A. IC1074.2 +000400**************************************************************** IC1074.2 +000500* * IC1074.2 +000600* VALIDATION FOR:- * IC1074.2 +000700* * IC1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1074.2 +000900* * IC1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1074.2 +001100* * IC1074.2 +001200**************************************************************** IC1074.2 +001300* * IC1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1074.2 +001500* * IC1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1074.2 +001900* * IC1074.2 +002000**************************************************************** IC1074.2 +002100* THE SUBPROGRAM IC107 CONTAINS TABLES AND AN INDEX IC1074.2 +002200* DATA ITEM WHICH ARE DEFINED IN THE LINKAGE SECTION AND IC1074.2 +002300* NAMED AS OPERANDS IN THE USING PHRASE OF THE PROCEDURE IC1074.2 +002400* DIVISION HEADER. ONE OF THE TABLES HAS AN INDEX DEFINED IC1074.2 +002500* FOR IT. THIS INDEX SHOULD BE SEPARATE FROM THE INDEX IC1074.2 +002600* DEFINED FOR THE SAME TABLE IN THE MAIN PROGRAM IC106, IC1074.2 +002700* BUT NO SPACE SHOULD BE ALLOCATED FOR THE TABLES DEFINED IC1074.2 +002800* IN THE LINKAGE SECTION. THE INDEX DATA ITEM IS SET IN IC1074.2 +002900* THE MAIN PROGRAM PRIOR TO CALLING IC107, AND IT IS USED IC1074.2 +003000* IN THIS SUBPROGRAM TO SET AN INDEX FOR REFERENCING THE IC1074.2 +003100* TABLE IN THE SUBPROGRAM. IC1074.2 +003200 ENVIRONMENT DIVISION. IC1074.2 +003300 CONFIGURATION SECTION. IC1074.2 +003400 SOURCE-COMPUTER. IC1074.2 +003500 Linux. IC1074.2 +003600 OBJECT-COMPUTER. IC1074.2 +003700 Linux. IC1074.2 +003800 INPUT-OUTPUT SECTION. IC1074.2 +003900 FILE-CONTROL. IC1074.2 +004000 SELECT PRINT-FILE ASSIGN TO IC1074.2 +004100 "report.log". IC1074.2 +004200 DATA DIVISION. IC1074.2 +004300 FILE SECTION. IC1074.2 +004400 FD PRINT-FILE. IC1074.2 +004500 01 PRINT-REC PICTURE X(120). IC1074.2 +004600 01 DUMMY-RECORD PICTURE X(120). IC1074.2 +004700 WORKING-STORAGE SECTION. IC1074.2 +004800 77 IDN3 USAGE IS INDEX. IC1074.2 +004900 77 S1 PICTURE 99. IC1074.2 +005000 77 AL-CON PICTURE XXX VALUE "XYZ". IC1074.2 +005100 LINKAGE SECTION. IC1074.2 +005200 77 IDN2 USAGE IS INDEX. IC1074.2 +005300 01 GROUP-1. IC1074.2 +005400 02 DN1 PICTURE X OCCURS 10 TIMES IC1074.2 +005500 INDEXED BY IN3. IC1074.2 +005600 01 GROUP-2. IC1074.2 +005700 02 GROUP-21. IC1074.2 +005800 06 DN2 PIC X OCCURS 10 TIMES. IC1074.2 +005900 02 GROUP-2-1 REDEFINES GROUP-21. IC1074.2 +006000 03 FILLER PICTURE X(7). IC1074.2 +006100 03 DN3 PICTURE XXX. IC1074.2 +006200 PROCEDURE DIVISION USING IDN2 GROUP-1 GROUP-2. IC1074.2 +006300 SECT-IC107-0001 SECTION. IC1074.2 +006400 LINK-TEST-02-01. IC1074.2 +006500 SET IN3 TO IDN2. IC1074.2 +006600 IF DN1 (IN3) EQUAL TO "F" IC1074.2 +006700 MOVE "G" TO DN2 (7). IC1074.2 +006800 LINK-TEST-02-02. IC1074.2 +006900 SET IDN3 TO IDN2. IC1074.2 +007000 SET IN3 TO IDN3. IC1074.2 +007100 IF IN3 EQUAL TO 6 IC1074.2 +007200 MOVE "F" TO DN2 (6). IC1074.2 +007300* THE TESTS IN LINK-TEST-02 USE THE INDEX DATA ITEM IC1074.2 +007400* WHICH IS DEFINED IN THE LINKAGE SECTION AND WAS SET IN IC1074.2 +007500* THE MAIN PROGRAM BEFORE THIS SUBPROGRAM WAS CALLED. IC1074.2 +007600 LINK-TEST-03-01. IC1074.2 +007700 SET IN3 TO 1. IC1074.2 +007800 MOVE 1 TO S1. IC1074.2 +007900 MOVE DN1 (IN3) TO DN2 (S1). IC1074.2 +008000 LINK-TEST-03-02. IC1074.2 +008100 SET IN3 UP BY 1. IC1074.2 +008200 ADD 1 TO S1. IC1074.2 +008300 MOVE DN1 (IN3) TO DN2 (S1). IC1074.2 +008400* THE TESTS IN LINK-TEST-03 SET THE INDEX DEFINED IN THE IC1074.2 +008500* TABLE IN THE LINKAGE SECTION AND USE THE INDEX TO REFERENCE IC1074.2 +008600* THE TABLE ITEMS. IC1074.2 +008700 LINK-TEST-04-01. IC1074.2 +008800 SET IN3 TO 3. IC1074.2 +008900 SET IDN2 TO IN3. IC1074.2 +009000 LINK-TEST-04-02. IC1074.2 +009100 IF IDN2 IS EQUAL TO IN3 IC1074.2 +009200 MOVE "C" TO DN2 (3). IC1074.2 +009300* THE TESTS IN LINK-TEST-04 RESET THE INDEX DATA ITEM IC1074.2 +009400* TO CORRESPOND TO TABLE POSITION 3, AND COMPARES THE IC1074.2 +009500* INDEX DATA ITEM TO THE INDEX. IC1074.2 +009600 LINK-TEST-05-01. IC1074.2 +009700 MOVE 4 TO S1. IC1074.2 +009800 SET IN3 TO S1. IC1074.2 +009900 MOVE DN1 (IN3) TO DN2 (S1). IC1074.2 +010000 LINK-TEST-05-02. IC1074.2 +010100 MOVE DN1 (5) TO DN2 (5). IC1074.2 +010200* THE TESTS IN LINK-TEST-05 MOVE DATA FROM THE FIRST IC1074.2 +010300* TABLE DEFINED IN THE LINKAGE SECTION TO THE SECOND TABLE. IC1074.2 +010400 LINK-TEST-06. IC1074.2 +010500 MOVE AL-CON TO DN3. IC1074.2 +010600* THIS TEST MOVES DATA TO THE REDEFINED FIELD IN A TABLE IC1074.2 +010700* IN THE LINKAGE SECTION. IC1074.2 +010800 EXIT-IC107. IC1074.2 +010900 EXIT PROGRAM. IC1074.2 diff --git a/tests/cobol85/IC/lib/IC109A.CBL b/tests/cobol85/IC/lib/IC109A.CBL new file mode 100755 index 00000000..057f1641 --- /dev/null +++ b/tests/cobol85/IC/lib/IC109A.CBL @@ -0,0 +1,65 @@ +000100 IDENTIFICATION DIVISION. IC1094.2 +000200 PROGRAM-ID. IC1094.2 +000300 IC109A. IC1094.2 +000400**************************************************************** IC1094.2 +000500* * IC1094.2 +000600* VALIDATION FOR:- * IC1094.2 +000700* * IC1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1094.2 +000900* * IC1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1094.2 +001100* * IC1094.2 +001200**************************************************************** IC1094.2 +001300* * IC1094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1094.2 +001500* * IC1094.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1094.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1094.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1094.2 +001900* * IC1094.2 +002000**************************************************************** IC1094.2 +002100* THE SUBPROGRAM IC109 IS THE FIRST SUBPROGRAM IN A IC1094.2 +002200* SEQUENCE OF CALLS WHICH START IN THE MAIN PROGRAM IC108. IC1094.2 +002300* IC109 CALLS IC110 WITH ONE OPERAND IN THE WORKING-STORAGE IC1094.2 +002400* SECTION AND ONE OPERAND IN THE LINKAGE SECTION. IC1094.2 +002500 ENVIRONMENT DIVISION. IC1094.2 +002600 CONFIGURATION SECTION. IC1094.2 +002700 SOURCE-COMPUTER. IC1094.2 +002800 Linux. IC1094.2 +002900 OBJECT-COMPUTER. IC1094.2 +003000 Linux. IC1094.2 +003100 INPUT-OUTPUT SECTION. IC1094.2 +003200 FILE-CONTROL. IC1094.2 +003300 SELECT PRINT-FILE ASSIGN TO IC1094.2 +003400 "report.log". IC1094.2 +003500 DATA DIVISION. IC1094.2 +003600 FILE SECTION. IC1094.2 +003700 FD PRINT-FILE. IC1094.2 +003800 01 PRINT-REC PICTURE X(120). IC1094.2 +003900 01 DUMMY-RECORD PICTURE X(120). IC1094.2 +004000 WORKING-STORAGE SECTION. IC1094.2 +004100 77 WS1 PICTURE X. IC1094.2 +004200 LINKAGE SECTION. IC1094.2 +004300 01 GRP-01. IC1094.2 +004400 02 SUB-CALLED. IC1094.2 +004500 03 DN1 PICTURE X(6). IC1094.2 +004600 03 DN2 PICTURE X(6). IC1094.2 +004700 03 DN3 PICTURE X(6). IC1094.2 +004800 02 TIMES-CALLED. IC1094.2 +004900 03 DN4 PICTURE S999. IC1094.2 +005000 03 DN5 PICTURE S999. IC1094.2 +005100 03 DN6 PICTURE S999. IC1094.2 +005200 02 SPECIAL-FLAGS. IC1094.2 +005300 03 DN7 PICTURE X. IC1094.2 +005400 03 DN8 PICTURE X. IC1094.2 +005500 03 DN9 PICTURE X. IC1094.2 +005600 PROCEDURE DIVISION USING GRP-01. IC1094.2 +005700 SECT-IC109-0001 SECTION. IC1094.2 +005800 PARA-IC109. IC1094.2 +005900 MOVE "IC109A" TO DN1. IC1094.2 +006000 MOVE SPACE TO WS1. IC1094.2 +006100 CALL "IC110A" USING WS1 GRP-01. IC1094.2 +006200 ADD 1 TO DN4. IC1094.2 +006300 MOVE WS1 TO DN9. IC1094.2 +006400 EXIT-IC109. IC1094.2 +006500 EXIT PROGRAM. IC1094.2 diff --git a/tests/cobol85/IC/lib/IC110A.CBL b/tests/cobol85/IC/lib/IC110A.CBL new file mode 100755 index 00000000..79dc37f7 --- /dev/null +++ b/tests/cobol85/IC/lib/IC110A.CBL @@ -0,0 +1,69 @@ +000100 IDENTIFICATION DIVISION. IC1104.2 +000200 PROGRAM-ID. IC1104.2 +000300 IC110A. IC1104.2 +000400**************************************************************** IC1104.2 +000500* * IC1104.2 +000600* VALIDATION FOR:- * IC1104.2 +000700* * IC1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1104.2 +000900* * IC1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1104.2 +001100* * IC1104.2 +001200**************************************************************** IC1104.2 +001300* * IC1104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1104.2 +001500* * IC1104.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1104.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1104.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1104.2 +001900* * IC1104.2 +002000**************************************************************** IC1104.2 +002100* THE SUBPROGRAM IC110 IS THE SECOND SUBPROGRAM IN A IC1104.2 +002200* SEQUENCE OF CALLS WHICH START IN THE MAIN PROGRAM IC108. IC1104.2 +002300* THIS SUBPROGRAM CALLS IC111 WITH OPERANDS IN THE LINKAGE IC1104.2 +002400* SECTION AND IN THE WORKING-STORAGE SECTION. THE SUBPROGRAM IC1104.2 +002500* IC110 IS CALLED BY IC109. IC1104.2 +002600 ENVIRONMENT DIVISION. IC1104.2 +002700 CONFIGURATION SECTION. IC1104.2 +002800 SOURCE-COMPUTER. IC1104.2 +002900 Linux. IC1104.2 +003000 OBJECT-COMPUTER. IC1104.2 +003100 Linux. IC1104.2 +003200 INPUT-OUTPUT SECTION. IC1104.2 +003300 FILE-CONTROL. IC1104.2 +003400 SELECT PRINT-FILE ASSIGN TO IC1104.2 +003500 "report.log". IC1104.2 +003600 DATA DIVISION. IC1104.2 +003700 FILE SECTION. IC1104.2 +003800 FD PRINT-FILE. IC1104.2 +003900 01 PRINT-REC PICTURE X(120). IC1104.2 +004000 01 DUMMY-RECORD PICTURE X(120). IC1104.2 +004100 WORKING-STORAGE SECTION. IC1104.2 +004200 77 WS2 PICTURE X. IC1104.2 +004300 LINKAGE SECTION. IC1104.2 +004400 01 GRP-01. IC1104.2 +004500 02 SUB-CALLED. IC1104.2 +004600 03 DN1 PICTURE X(6). IC1104.2 +004700 03 DN2 PICTURE X(6). IC1104.2 +004800 03 DN3 PICTURE X(6). IC1104.2 +004900 02 TIMES-CALLED. IC1104.2 +005000 03 DN4 PICTURE S999. IC1104.2 +005100 03 DN5 PICTURE S999. IC1104.2 +005200 03 DN6 PICTURE S999. IC1104.2 +005300 02 SPECIAL-FLAGS. IC1104.2 +005400 03 DN7 PICTURE X. IC1104.2 +005500 03 DN8 PICTURE X. IC1104.2 +005600 03 DN9 PICTURE X. IC1104.2 +005700 01 LS1 PICTURE X. IC1104.2 +005800 PROCEDURE DIVISION USING LS1 GRP-01. IC1104.2 +005900 SECT-IC110-0001 SECTION. IC1104.2 +006000 PARA-IC110. IC1104.2 +006100 MOVE "IC110A" TO DN2. IC1104.2 +006200 MOVE SPACE TO WS2. IC1104.2 +006300 CALL "IC111A" USING LS1 GRP-01 WS2. IC1104.2 +006400 MOVE WS2 TO DN7. IC1104.2 +006500 MOVE LS1 TO DN8. IC1104.2 +006600 ADD 1 TO DN5. IC1104.2 +006700 MOVE "B" TO LS1. IC1104.2 +006800 EXIT-IC110. IC1104.2 +006900 EXIT PROGRAM. IC1104.2 diff --git a/tests/cobol85/IC/lib/IC111A.CBL b/tests/cobol85/IC/lib/IC111A.CBL new file mode 100755 index 00000000..9ce81e70 --- /dev/null +++ b/tests/cobol85/IC/lib/IC111A.CBL @@ -0,0 +1,56 @@ +000100 IDENTIFICATION DIVISION. IC1114.2 +000200 PROGRAM-ID. IC1114.2 +000300 IC111A. IC1114.2 +000400**************************************************************** IC1114.2 +000500* * IC1114.2 +000600* VALIDATION FOR:- * IC1114.2 +000700* * IC1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1114.2 +000900* * IC1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1114.2 +001100* * IC1114.2 +001200**************************************************************** IC1114.2 +001300* * IC1114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1114.2 +001500* * IC1114.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1114.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1114.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1114.2 +001900* * IC1114.2 +002000**************************************************************** IC1114.2 +002100* THE SUBPROGRAM IC111 IS THE LAST SUBPROGRAM CALLED IC1114.2 +002200* IN A SEQUENCE OF SUBPROGRAM CALLS WHICH IS STARTED IN IC1114.2 +002300* MAIN PROGRAM IC108. THE SUBPROGRAM IC111 IS CALLED BY IC1114.2 +002400* THE SUBPROGRAM IC110. IC1114.2 +002500 ENVIRONMENT DIVISION. IC1114.2 +002600 CONFIGURATION SECTION. IC1114.2 +002700 SOURCE-COMPUTER. IC1114.2 +002800 Linux. IC1114.2 +002900 OBJECT-COMPUTER. IC1114.2 +003000 Linux. IC1114.2 +003100 DATA DIVISION. IC1114.2 +003200 LINKAGE SECTION. IC1114.2 +003300 77 LS1 PICTURE X. IC1114.2 +003400 77 LS2 PICTURE X. IC1114.2 +003500 01 GRP-01. IC1114.2 +003600 02 SUB-CALLED. IC1114.2 +003700 03 DN1 PICTURE X(6). IC1114.2 +003800 03 DN2 PICTURE X(6). IC1114.2 +003900 03 DN3 PICTURE X(6). IC1114.2 +004000 02 TIMES-CALLED. IC1114.2 +004100 03 DN4 PICTURE S999. IC1114.2 +004200 03 DN5 PICTURE S999. IC1114.2 +004300 03 DN6 PICTURE S999. IC1114.2 +004400 02 SPECIAL-FLAGS. IC1114.2 +004500 03 DN7 PICTURE X. IC1114.2 +004600 03 DN8 PICTURE X. IC1114.2 +004700 03 DN9 PICTURE X. IC1114.2 +004800 PROCEDURE DIVISION USING LS1 GRP-01 LS2. IC1114.2 +004900 SECT-IC111-0001 SECTION. IC1114.2 +005000 PARA-IC111. IC1114.2 +005100 MOVE "IC111A" TO DN3. IC1114.2 +005200 ADD 1 TO DN6. IC1114.2 +005300 MOVE "A" TO LS2. IC1114.2 +005400 MOVE "A" TO LS1. IC1114.2 +005500 EXIT-IC111. IC1114.2 +005600 EXIT PROGRAM. IC1114.2 diff --git a/tests/cobol85/IC/lib/IC113A.CBL b/tests/cobol85/IC/lib/IC113A.CBL new file mode 100755 index 00000000..f6b514c9 --- /dev/null +++ b/tests/cobol85/IC/lib/IC113A.CBL @@ -0,0 +1,78 @@ +000100 IDENTIFICATION DIVISION. IC1134.2 +000200 PROGRAM-ID. IC1134.2 +000300 IC113A. IC1134.2 +000400**************************************************************** IC1134.2 +000500* * IC1134.2 +000600* VALIDATION FOR:- * IC1134.2 +000700* * IC1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1134.2 +000900* * IC1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1134.2 +001100* * IC1134.2 +001200**************************************************************** IC1134.2 +001300* * IC1134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1134.2 +001500* * IC1134.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1134.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1134.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1134.2 +001900* * IC1134.2 +002000**************************************************************** IC1134.2 +002100* IC1134.2 +002200* THE SUBPROGRAM IC113 IS CALLED BY THE MAIN PROGRAM IC112IC1134.2 +002300* WHICH HAS A FILE DESCRIPTION RECORD IN THE USING PHRASE OF IC1134.2 +002400* THE CALL STATEMENT REFERENCING THIS SUBPROGRAM. IC113 CHECKSIC1134.2 +002500* THE VALUES IN THE FILE RECORD DESCRIBED IN THE LINKAGE IC1134.2 +002600* SECTION OF THE SUBPROGRAM. IF ANY ERRORS ARE ENCOUNTERED IC1134.2 +002700* THE ERROR-FLAG IS SET TO 1 AND THE RECORDS-IN-ERROR COUNTER IC1134.2 +002800* IS INCREMENTED BY 1. IC1134.2 +002900* IC1134.2 +003000******************************************** IC1134.2 +003100 ENVIRONMENT DIVISION. IC1134.2 +003200 CONFIGURATION SECTION. IC1134.2 +003300 SOURCE-COMPUTER. IC1134.2 +003400 Linux. IC1134.2 +003500 OBJECT-COMPUTER. IC1134.2 +003600 Linux. IC1134.2 +003700 DATA DIVISION. IC1134.2 +003800 WORKING-STORAGE SECTION. IC1134.2 +003900 01 DUMMY-WS-ENTRY PIC 99 VALUE 0. IC1134.2 +004000 LINKAGE SECTION. IC1134.2 +004100 01 COUNT-OF-RECORDS PIC S9(9) USAGE COMP. IC1134.2 +004200 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP. IC1134.2 +004300 01 ERROR-FLAG PICTURE 9. IC1134.2 +004400 01 SQ-FS3-R1-G-120. IC1134.2 +004500 02 XFILE-NAME-GROUP. IC1134.2 +004600 03 FILLER PIC X(5). IC1134.2 +004700 03 XFILE-NAME PIC X(6). IC1134.2 +004800 02 XRECORD-NAME-GROUP. IC1134.2 +004900 03 FILLER PIC X(8). IC1134.2 +005000 03 XRECORD-NAME PIC X(6). IC1134.2 +005100 02 REELUNIT-NUMBER-GROUP. IC1134.2 +005200 03 FILLER PIC X(1). IC1134.2 +005300 03 REELUNIT-NUMBER PIC 9(1). IC1134.2 +005400 02 FILLER PIC X(7). IC1134.2 +005500 02 XRECORD-NUMBER PIC 9(6). IC1134.2 +005600 02 FILLER PIC X(79). IC1134.2 +005700 02 XLABEL-TYPE PIC X(1). IC1134.2 +005800 PROCEDURE DIVISION USING RECORDS-IN-ERROR SQ-FS3-R1-G-120 IC1134.2 +005900 ERROR-FLAG COUNT-OF-RECORDS. IC1134.2 +006000 SECT-IC113-0001 SECTION. IC1134.2 +006100 LINK-TEST-08. IC1134.2 +006200 ADD 1 TO COUNT-OF-RECORDS. IC1134.2 +006300 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER IC1134.2 +006400 GO TO LINK-FAIL-08. IC1134.2 +006500 IF REELUNIT-NUMBER-GROUP NOT EQUAL TO "/0" IC1134.2 +006600 GO TO LINK-FAIL-08. IC1134.2 +006700 IF XFILE-NAME NOT EQUAL TO "SQ-FS3" IC1134.2 +006800 GO TO LINK-FAIL-08. IC1134.2 +006900 IF XRECORD-NAME NOT EQUAL TO "R1-F-G" IC1134.2 +007000 GO TO LINK-FAIL-08. IC1134.2 +007100 IF XLABEL-TYPE NOT EQUAL TO "S" IC1134.2 +007200 GO TO LINK-FAIL-08. IC1134.2 +007300 LINK-EXIT-08. IC1134.2 +007400 EXIT PROGRAM. IC1134.2 +007500 LINK-FAIL-08. IC1134.2 +007600 ADD 1 TO RECORDS-IN-ERROR. IC1134.2 +007700 MOVE 1 TO ERROR-FLAG. IC1134.2 +007800 GO TO LINK-EXIT-08. IC1134.2 diff --git a/tests/cobol85/IC/lib/IC115A.CBL b/tests/cobol85/IC/lib/IC115A.CBL new file mode 100755 index 00000000..c7ba4402 --- /dev/null +++ b/tests/cobol85/IC/lib/IC115A.CBL @@ -0,0 +1,213 @@ +000100 IDENTIFICATION DIVISION. IC1154.2 +000200 PROGRAM-ID. IC1154.2 +000300 IC115A. IC1154.2 +000400**************************************************************** IC1154.2 +000500* * IC1154.2 +000600* VALIDATION FOR:- * IC1154.2 +000700* * IC1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1154.2 +000900* * IC1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1154.2 +001100* * IC1154.2 +001200**************************************************************** IC1154.2 +001300* * IC1154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1154.2 +001500* * IC1154.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1154.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1154.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1154.2 +001900* * IC1154.2 +002000**************************************************************** IC1154.2 +002100* IC1154.2 +002200* THE ROUTINE IC115 IS A SUBPROGRAM CALLED BY IC114. IC1154.2 +002300* THIS SUBPROGRAM CONTAINS A FILE SECTION, A WORKING-STORAGE IC1154.2 +002400* SECTION AND A LINKAGE SECTION. THE FILE SQ-FS3 IS CREATED IC1154.2 +002500* AND VERIFIED IN THIS ROUTINE. THE FILE IS OPENED AND READ IC1154.2 +002600* AGAIN. EACH RECORD IS CHECKED BY MOVING IT TO THE LINKAGE IC1154.2 +002700* SECTION AND RETURNING TO THE MAIN PROGRAM TO VERIFY THE IC1154.2 +002800* RECORD CONTENTS. THE PRINTING OF THE OUTPUT REPORT FOR THE IC1154.2 +002900* TEST RESULTS IS PERFORMED BY RETURNING TO THE MAIN PROGRAM IC1154.2 +003000* IC114. IC1154.2 +003100* IC1154.2 +003200* THIS SUBPROGRAM IS ADAPTED FROM THE SEQUENTIAL I-O IC1154.2 +003300* ROUTINE SQ104. IF THAT ROUTINE DOES NOT PERFORM CORRECTLY IC1154.2 +003400* THEN THE RESULTS OF THESE TESTS ARE INCONCLUSIVE. IC1154.2 +003500* IC1154.2 +003600******************************************** IC1154.2 +003700 ENVIRONMENT DIVISION. IC1154.2 +003800 CONFIGURATION SECTION. IC1154.2 +003900 SOURCE-COMPUTER. IC1154.2 +004000 Linux. IC1154.2 +004100 OBJECT-COMPUTER. IC1154.2 +004200 Linux. IC1154.2 +004300 INPUT-OUTPUT SECTION. IC1154.2 +004400 FILE-CONTROL. IC1154.2 +004500 SELECT SQ-FS3 ASSIGN TO IC1154.2 +004600 "XXXXX014" IC1154.2 +004700 ORGANIZATION IS SEQUENTIAL IC1154.2 +004800 ACCESS MODE IS SEQUENTIAL. IC1154.2 +004900 DATA DIVISION. IC1154.2 +005000 FILE SECTION. IC1154.2 +005100 FD SQ-FS3 IC1154.2 +005200 BLOCK CONTAINS 120 CHARACTERS IC1154.2 +005300 RECORD CONTAINS 120 CHARACTERS IC1154.2 +005400 LABEL RECORDS ARE STANDARD IC1154.2 +005500*C VALUE OF IC1154.2 +005600*C OCLABELID IC1154.2 +005700*C IS IC1154.2 +005800*C "OCDUMMY" IC1154.2 +005900*G SYSIN IC1154.2 +006000 DATA RECORD SQ-FS3R1-F-G-120. IC1154.2 +006100 01 SQ-FS3R1-F-G-120. IC1154.2 +006200 02 FILLER PIC X(120). IC1154.2 +006300 WORKING-STORAGE SECTION. IC1154.2 +006400 01 FILE-RECORD-INFORMATION-REC. IC1154.2 +006500 03 FILE-RECORD-INFO-SKELETON. IC1154.2 +006600 05 FILLER PICTURE X(48) VALUE IC1154.2 +006700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IC1154.2 +006800 05 FILLER PICTURE X(46) VALUE IC1154.2 +006900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IC1154.2 +007000 05 FILLER PICTURE X(26) VALUE IC1154.2 +007100 ",LFIL=000000,ORG= ,LBLR= ". IC1154.2 +007200 05 FILLER PICTURE X(37) VALUE IC1154.2 +007300 ",RECKEY= ". IC1154.2 +007400 05 FILLER PICTURE X(38) VALUE IC1154.2 +007500 ",ALTKEY1= ". IC1154.2 +007600 05 FILLER PICTURE X(38) VALUE IC1154.2 +007700 ",ALTKEY2= ". IC1154.2 +007800 05 FILLER PICTURE X(7) VALUE SPACE.IC1154.2 +007900 03 FILE-RECORD-INFO OCCURS 10 TIMES. IC1154.2 +008000 05 FILE-RECORD-INFO-P1-120. IC1154.2 +008100 07 FILLER PIC X(5). IC1154.2 +008200 07 XFILE-NAME PIC X(6). IC1154.2 +008300 07 FILLER PIC X(8). IC1154.2 +008400 07 XRECORD-NAME PIC X(6). IC1154.2 +008500 07 FILLER PIC X(1). IC1154.2 +008600 07 REELUNIT-NUMBER PIC 9(1). IC1154.2 +008700 07 FILLER PIC X(7). IC1154.2 +008800 07 XRECORD-NUMBER PIC 9(6). IC1154.2 +008900 07 FILLER PIC X(6). IC1154.2 +009000 07 UPDATE-NUMBER PIC 9(2). IC1154.2 +009100 07 FILLER PIC X(5). IC1154.2 +009200 07 ODO-NUMBER PIC 9(4). IC1154.2 +009300 07 FILLER PIC X(5). IC1154.2 +009400 07 XPROGRAM-NAME PIC X(5). IC1154.2 +009500 07 FILLER PIC X(7). IC1154.2 +009600 07 XRECORD-LENGTH PIC 9(6). IC1154.2 +009700 07 FILLER PIC X(7). IC1154.2 +009800 07 CHARS-OR-RECORDS PIC X(2). IC1154.2 +009900 07 FILLER PIC X(1). IC1154.2 +010000 07 XBLOCK-SIZE PIC 9(4). IC1154.2 +010100 07 FILLER PIC X(6). IC1154.2 +010200 07 RECORDS-IN-FILE PIC 9(6). IC1154.2 +010300 07 FILLER PIC X(5). IC1154.2 +010400 07 XFILE-ORGANIZATION PIC X(2). IC1154.2 +010500 07 FILLER PIC X(6). IC1154.2 +010600 07 XLABEL-TYPE PIC X(1). IC1154.2 +010700 05 FILE-RECORD-INFO-P121-240. IC1154.2 +010800 07 FILLER PIC X(8). IC1154.2 +010900 07 XRECORD-KEY PIC X(29). IC1154.2 +011000 07 FILLER PIC X(9). IC1154.2 +011100 07 ALTERNATE-KEY1 PIC X(29). IC1154.2 +011200 07 FILLER PIC X(9). IC1154.2 +011300 07 ALTERNATE-KEY2 PIC X(29). IC1154.2 +011400 07 FILLER PIC X(7). IC1154.2 +011500 01 CCVS-PGM-ID PIC X(6) VALUE IC1154.2 +011600 "IC115A". IC1154.2 +011700 LINKAGE SECTION. IC1154.2 +011800 01 GROUP-LINKAGE-VARIABLES. IC1154.2 +011900 02 COUNT-OF-RECORDS PICTURE 9(6). IC1154.2 +012000 02 RECORDS-IN-ERROR PICTURE 9(6). IC1154.2 +012100 02 ERROR-FLAG PICTURE 9. IC1154.2 +012200 02 EOF-FLAG PICTURE 9. IC1154.2 +012300 02 CALL-FLAG PICTURE 9. IC1154.2 +012400 01 FILE-REC-SQ-FS3. IC1154.2 +012500 02 FILLER PICTURE X(120). IC1154.2 +012600 PROCEDURE DIVISION USING GROUP-LINKAGE-VARIABLES IC1154.2 +012700 FILE-REC-SQ-FS3. IC1154.2 +012800 SECT-IC115-0001 SECTION. IC1154.2 +012900 INIT-PARAGRAPH. IC1154.2 +013000 GO TO SECT-IC115-0002 SECT-IC115-0003 SECT-IC115-0004 IC1154.2 +013100 SECT-IC115-0005 SECT-IC115-0006 IC1154.2 +013200 DEPENDING ON CALL-FLAG. IC1154.2 +013300* THE IDENTIFIER CALL-FLAG CONTROLS THE SUBPROGRAM IC1154.2 +013400* PROCESSING AND IT IS SET BY THE CALLING PROGRAM IC114. IC1154.2 +013500 SECT-IC115-0002 SECTION. IC1154.2 +013600 LINK-INIT-10. IC1154.2 +013700 MOVE FILE-RECORD-INFO-SKELETON TO IC1154.2 +013800 FILE-RECORD-INFO (1). IC1154.2 +013900 MOVE "SQ-FS3" TO XFILE-NAME (1). IC1154.2 +014000 MOVE "R1-F-G" TO XRECORD-NAME (1). IC1154.2 +014100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IC1154.2 +014200 MOVE 120 TO XRECORD-LENGTH (1). IC1154.2 +014300 MOVE "CH" TO CHARS-OR-RECORDS (1). IC1154.2 +014400 MOVE 120 TO XBLOCK-SIZE (1). IC1154.2 +014500 MOVE 000649 TO RECORDS-IN-FILE (1). IC1154.2 +014600 MOVE "SQ" TO XFILE-ORGANIZATION (1). IC1154.2 +014700 MOVE "S" TO XLABEL-TYPE (1). IC1154.2 +014800 MOVE 000001 TO XRECORD-NUMBER (1). IC1154.2 +014900 OPEN OUTPUT SQ-FS3. IC1154.2 +015000 LINK-TEST-10. IC1154.2 +015100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. IC1154.2 +015200 WRITE SQ-FS3R1-F-G-120. IC1154.2 +015300 IF XRECORD-NUMBER (1) EQUAL TO 649 IC1154.2 +015400 GO TO LINK-TEST-10-01. IC1154.2 +015500 ADD 1 TO XRECORD-NUMBER (1). IC1154.2 +015600 GO TO LINK-TEST-10. IC1154.2 +015700 LINK-TEST-10-01. IC1154.2 +015800 CLOSE SQ-FS3. IC1154.2 +015900 MOVE XRECORD-NUMBER (1) TO COUNT-OF-RECORDS. IC1154.2 +016000* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTERS PER IC1154.2 +016100* RECORD HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. IC1154.2 +016200 LINK-EXIT-10. IC1154.2 +016300 EXIT PROGRAM. IC1154.2 +016400 SECT-IC115-0003 SECTION. IC1154.2 +016500 LINK-INIT-11. IC1154.2 +016600* THIS TEST READS AND CHECKS THE FILE CREATED IN IC1154.2 +016700* SECT-IC115-0002. IC1154.2 +016800 OPEN INPUT SQ-FS3. IC1154.2 +016900 LINK-TEST-11. IC1154.2 +017000 READ SQ-FS3 RECORD IC1154.2 +017100 AT END GO TO LINK-CLOSE-11. IC1154.2 +017200 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). IC1154.2 +017300 ADD 1 TO COUNT-OF-RECORDS. IC1154.2 +017400 IF COUNT-OF-RECORDS GREATER THAN 649 IC1154.2 +017500 MOVE 1 TO ERROR-FLAG IC1154.2 +017600 GO TO LINK-CLOSE-11. IC1154.2 +017700 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER (1) IC1154.2 +017800 GO TO LINK-FAIL-11. IC1154.2 +017900 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" IC1154.2 +018000 GO TO LINK-FAIL-11. IC1154.2 +018100 IF XLABEL-TYPE (1) NOT EQUAL TO "S" IC1154.2 +018200 GO TO LINK-FAIL-11. IC1154.2 +018300 GO TO LINK-TEST-11. IC1154.2 +018400 LINK-FAIL-11. IC1154.2 +018500 ADD 1 TO RECORDS-IN-ERROR. IC1154.2 +018600 MOVE 1 TO ERROR-FLAG. IC1154.2 +018700 LINK-CLOSE-11. IC1154.2 +018800 CLOSE SQ-FS3. IC1154.2 +018900 LINK-EXIT-11. IC1154.2 +019000 EXIT PROGRAM. IC1154.2 +019100 SECT-IC115-0004 SECTION. IC1154.2 +019200 LINK-INIT-12. IC1154.2 +019300 OPEN INPUT SQ-FS3. IC1154.2 +019400 LINK-INIT-12-EXIT. IC1154.2 +019500 EXIT PROGRAM. IC1154.2 +019600 SECT-IC115-0005 SECTION. IC1154.2 +019700 LINK-TEST-12. IC1154.2 +019800 READ SQ-FS3 RECORD IC1154.2 +019900 AT END MOVE 1 TO EOF-FLAG. IC1154.2 +020000 MOVE SQ-FS3R1-F-G-120 TO FILE-REC-SQ-FS3. IC1154.2 +020100* IC1154.2 +020200* THE MAIN PROGRAM IC114 REPEATLY CALLS THE SUBPROGRAM IC1154.2 +020300* IC115 TO READ THE FILE SQ-FS3. THE DATA RECORD IS MOVED IC1154.2 +020400* TO A LINKAGE RECORD FOR CHECKING OF THE CONTENTS BY THE IC1154.2 +020500* MAIN PROGRAM. IC1154.2 +020600* IC1154.2 +020700 LINK-EXIT-12. IC1154.2 +020800 EXIT PROGRAM. IC1154.2 +020900 SECT-IC115-0006 SECTION. IC1154.2 +021000 LINK-CLOSE-12. IC1154.2 +021100 CLOSE SQ-FS3. IC1154.2 +021200 LINK-CLOSE-EXIT-12. IC1154.2 +021300 EXIT PROGRAM. IC1154.2 diff --git a/tests/cobol85/IC/lib/IC117M.CBL b/tests/cobol85/IC/lib/IC117M.CBL new file mode 100755 index 00000000..a6871f29 --- /dev/null +++ b/tests/cobol85/IC/lib/IC117M.CBL @@ -0,0 +1,71 @@ +000100 IDENTIFICATION DIVISION. IC1174.2 +000200 PROGRAM-ID. IC1174.2 +000300 IC117M. IC1174.2 +000400**************************************************************** IC1174.2 +000500* * IC1174.2 +000600* VALIDATION FOR:- * IC1174.2 +000700* * IC1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1174.2 +000900* * IC1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1174.2 +001100* * IC1174.2 +001200**************************************************************** IC1174.2 +001300* * IC1174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1174.2 +001500* * IC1174.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1174.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1174.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1174.2 +001900* * IC1174.2 +002000**************************************************************** IC1174.2 +002100* IC1174.2 +002200* THE SUBPROGRAM IC117 IS CALLED BY THE MAIN PROGRAM IC116.IC1174.2 +002300* THE SUBPROGRAM IC117 DOES NOT CONTAIN A LINKAGE SECTION OR IC1174.2 +002400* AN USING PHRASE IN THE PROCEDURE DIVISION HEADER. DISPLAY IC1174.2 +002500* STATEMENTS ARE USED TO VERIFY THE PROGRAM EXECUTION SEQUENCE.IC1174.2 +002600* THE SUBPROGRAM IC118 IS CALLED BY THE SUBPROGRAM IC117 AND IC1174.2 +002700* THE CALL STATEMENT IN THE SUBPROGRAM ALSO DOES NOT HAVE AN IC1174.2 +002800* USING PHRASE. IC1174.2 +002900* IC1174.2 +003000* REFERENCE - AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE IC1174.2 +003100* COBOL, X3.23-1974 IC1174.2 +003200* SECTION XII, INTER-PROGRAM COMMUNICATION MODULE. IC1174.2 +003300* IC1174.2 +003400******************************************************************IC1174.2 +003500 ENVIRONMENT DIVISION. IC1174.2 +003600 CONFIGURATION SECTION. IC1174.2 +003700 SOURCE-COMPUTER. IC1174.2 +003800 Linux. IC1174.2 +003900 OBJECT-COMPUTER. IC1174.2 +004000 Linux. IC1174.2 +004100 DATA DIVISION. IC1174.2 +004200 WORKING-STORAGE SECTION. IC1174.2 +004300 01 IC117-TEMP1 PICTURE 9. IC1174.2 +004400 01 ONE PICTURE 9 VALUE 1. IC1174.2 +004500 01 IC117-TEMP2 PICTURE 9 VALUE 0. IC1174.2 +004600 PROCEDURE DIVISION. IC1174.2 +004700*USNG-TEST-02. IC1174.2 +004800* IC1174.2 +004900* THIS TEST VERIFIES THAT A SUBPROGRAM PROCEDURE DIVISION IC1174.2 +005000* HEADER IS NOT REQUIRED TO HAVE THE OPTIONAL USING PHRASE. IC1174.2 +005100* IC1174.2 +005200 USNG-VERIFY-02. IC1174.2 +005300 MOVE 1 TO IC117-TEMP1. IC1174.2 +005400 ADD ONE TO IC117-TEMP2. IC1174.2 +005500* IC1174.2 +005600* THE RESULTS OF THE ABOVE STATEMENTS ARE NOT TESTED. IC1174.2 +005700* IC1174.2 +005800 USNG-DISPLAY-02. IC1174.2 +005900 DISPLAY " ". IC1174.2 +006000 DISPLAY "IC117M CALLED". IC1174.2 +006100 USNG-TEST-03. IC1174.2 +006200 CALL "IC118M". IC1174.2 +006300* IC1174.2 +006400* THIS TEST CONTAINS A CALL STATEMENT WITHOUT THE OPTIONAL IC1174.2 +006500* USING PHRASE. IC1174.2 +006600* REFERENCE - X3.23-1995, PAGE X-27, 5.2, THE CALL STATEMENT. IC1174.2 +006700* IC1174.2 +006800 USNG-DISPLAY-03. IC1174.2 +006900 DISPLAY "RETURNED TO IC117M". IC1174.2 +007000 IC117-EXIT. IC1174.2 +007100 EXIT PROGRAM. IC1174.2 diff --git a/tests/cobol85/IC/lib/IC118M.CBL b/tests/cobol85/IC/lib/IC118M.CBL new file mode 100755 index 00000000..62205854 --- /dev/null +++ b/tests/cobol85/IC/lib/IC118M.CBL @@ -0,0 +1,55 @@ +000100 IDENTIFICATION DIVISION. IC1184.2 +000200 PROGRAM-ID. IC1184.2 +000300 IC118M. IC1184.2 +000400**************************************************************** IC1184.2 +000500* * IC1184.2 +000600* VALIDATION FOR:- * IC1184.2 +000700* * IC1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC1184.2 +000900* * IC1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC1184.2 +001100* * IC1184.2 +001200**************************************************************** IC1184.2 +001300* * IC1184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC1184.2 +001500* * IC1184.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC1184.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC1184.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC1184.2 +001900* * IC1184.2 +002000**************************************************************** IC1184.2 +002100* IC1184.2 +002200* THE SUBPROGRAM IC118 IS CALLED BY THE SUBPROGRAM IC117. IC1184.2 +002300* THE SUBPROGRAM IC118 DOES NOT CONTAIN A LINKAGE SECTION OR IC1184.2 +002400* AN USING PHRASE IN THE PROCEDURE DIVISION HEADER. A DISPLAY IC1184.2 +002500* STATEMENT IS EXECUTED TO VERIFY THAT THIS SUBPROGRAM WAS IC1184.2 +002600* EXECUTED. IC1184.2 +002700* IC1184.2 +002800******************************************************************IC1184.2 +002900 ENVIRONMENT DIVISION. IC1184.2 +003000 CONFIGURATION SECTION. IC1184.2 +003100 SOURCE-COMPUTER. IC1184.2 +003200 Linux. IC1184.2 +003300 OBJECT-COMPUTER. IC1184.2 +003400 Linux. IC1184.2 +003500 DATA DIVISION. IC1184.2 +003600 WORKING-STORAGE SECTION. IC1184.2 +003700 01 IC118-TEMP1 PICTURE 9. IC1184.2 +003800 01 TWO PICTURE 9 VALUE 2. IC1184.2 +003900 01 IC118-TEMP2 PICTURE 99 VALUE 97. IC1184.2 +004000 PROCEDURE DIVISION. IC1184.2 +004100*USNG-TEST-04. IC1184.2 +004200* IC1184.2 +004300* THIS TEST VERIFIES THAT A SUBPROGRAM PROCEDURE DIVISION IC1184.2 +004400* HEADER IS NOT REQUIRED TO HAVE THE OPTIONAL USING PHRASE. IC1184.2 +004500* IC1184.2 +004600 USNG-VERIFY-04. IC1184.2 +004700 MOVE 2 TO IC118-TEMP1. IC1184.2 +004800 ADD TWO TO IC118-TEMP2. IC1184.2 +004900* IC1184.2 +005000* THE RESULTS OF THE ABOVE STATEMENTS ARE NOT TESTED. IC1184.2 +005100* IC1184.2 +005200 USNG-DISPLAY-04. IC1184.2 +005300 DISPLAY "IC118M CALLED". IC1184.2 +005400 IC118-EXIT. IC1184.2 +005500 EXIT PROGRAM. IC1184.2 diff --git a/tests/cobol85/IC/lib/IC202A.CBL b/tests/cobol85/IC/lib/IC202A.CBL new file mode 100755 index 00000000..2a795a2f --- /dev/null +++ b/tests/cobol85/IC/lib/IC202A.CBL @@ -0,0 +1,58 @@ +000100 IDENTIFICATION DIVISION. IC2024.2 +000200 PROGRAM-ID. IC2024.2 +000300 IC202A. IC2024.2 +000400**************************************************************** IC2024.2 +000500* * IC2024.2 +000600* VALIDATION FOR:- * IC2024.2 +000700* * IC2024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2024.2 +000900* * IC2024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2024.2 +001100* * IC2024.2 +001200**************************************************************** IC2024.2 +001300* * IC2024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2024.2 +001500* * IC2024.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2024.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2024.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2024.2 +001900* * IC2024.2 +002000**************************************************************** IC2024.2 +002100* THE SUBPROGRAM IC202 IS CALLED BY THE PROGRAM IC201. * IC2024.2 +002200* THE SUBPROGRAM HAS FOUR OPERANDS IN THE USING PHRASE * IC2024.2 +002300* OF THE PROCEDURE DIVISION HEADER. * IC2024.2 +002400**************************************************************** IC2024.2 +002500 ENVIRONMENT DIVISION. IC2024.2 +002600 CONFIGURATION SECTION. IC2024.2 +002700 SOURCE-COMPUTER. IC2024.2 +002800 Linux. IC2024.2 +002900 OBJECT-COMPUTER. IC2024.2 +003000 Linux. IC2024.2 +003100 INPUT-OUTPUT SECTION. IC2024.2 +003200 FILE-CONTROL. IC2024.2 +003300 SELECT PRINT-FILE ASSIGN TO IC2024.2 +003400 "report.log". IC2024.2 +003500 DATA DIVISION. IC2024.2 +003600 FILE SECTION. IC2024.2 +003700 FD PRINT-FILE. IC2024.2 +003800 01 PRINT-REC PICTURE X(120). IC2024.2 +003900 01 DUMMY-RECORD PICTURE X(120). IC2024.2 +004000 WORKING-STORAGE SECTION. IC2024.2 +004100 77 WS1 PICTURE S999. IC2024.2 +004200 77 WS2 PICTURE S999 IC2024.2 +004300 USAGE COMPUTATIONAL, VALUE ZERO. IC2024.2 +004400 LINKAGE SECTION. IC2024.2 +004500 77 DN1 PICTURE S99. IC2024.2 +004600 77 DN2 PICTURE S99 USAGE COMPUTATIONAL. IC2024.2 +004700 77 DN3 PICTURE S99. IC2024.2 +004800 77 DN4 PICTURE S99 USAGE COMPUTATIONAL. IC2024.2 +004900 PROCEDURE DIVISION USING DN1, DN2, DN3, DN4. IC2024.2 +005000 SECT-IC202-0001 SECTION. IC2024.2 +005100 CALL-TEST-001. IC2024.2 +005200 MOVE DN1 TO WS1. IC2024.2 +005300 ADD 1 TO WS1. IC2024.2 +005400 ADD 1 TO WS2. IC2024.2 +005500 MOVE WS1 TO DN3. IC2024.2 +005600 MOVE WS2 TO DN4. IC2024.2 +005700 CALL-EXIT-001. IC2024.2 +005800 EXIT PROGRAM. IC2024.2 diff --git a/tests/cobol85/IC/lib/IC204A.CBL b/tests/cobol85/IC/lib/IC204A.CBL new file mode 100755 index 00000000..562012e9 --- /dev/null +++ b/tests/cobol85/IC/lib/IC204A.CBL @@ -0,0 +1,73 @@ +000100 IDENTIFICATION DIVISION. IC2044.2 +000200 PROGRAM-ID. IC2044.2 +000300 IC204A. IC2044.2 +000400**************************************************************** IC2044.2 +000500* * IC2044.2 +000600* VALIDATION FOR:- * IC2044.2 +000700* * IC2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2044.2 +000900* * IC2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2044.2 +001100* * IC2044.2 +001200**************************************************************** IC2044.2 +001300* * IC2044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2044.2 +001500* * IC2044.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2044.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2044.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2044.2 +001900* * IC2044.2 +002000**************************************************************** IC2044.2 +002100* THE SUBPROGRAM IC204 HAS TWO VARIABLES IN WORKING- IC2044.2 +002200* STORAGE WHICH ARE INITIALIZED BY A VALUE STATEMENT. THE IC2044.2 +002300* DATA CONTENTS OF THESE VARIABLES ARE MODIFIED DURING IC2044.2 +002400* EXECUTION OF THE SUBPROGRAM. INDICATORS ARE SET FOR IC2044.2 +002500* VARIABLES IN THE LINKAGE SECTION WHICH RELATE HOW MANY IC2044.2 +002600* TIMES THE SUBPROGRAM HAS BEEN CALLED SINCE IT WAS IC2044.2 +002700* INITIALIZED, AND WHETHER OR NOT THE SUBPROGRAM IS IN IC2044.2 +002800* ITS INITIAL STATE. IC2044.2 +002900**************************************************************** IC2044.2 +003000 ENVIRONMENT DIVISION. IC2044.2 +003100 CONFIGURATION SECTION. IC2044.2 +003200 SOURCE-COMPUTER. IC2044.2 +003300 Linux. IC2044.2 +003400 OBJECT-COMPUTER. IC2044.2 +003500 Linux. IC2044.2 +003600 INPUT-OUTPUT SECTION. IC2044.2 +003700 FILE-CONTROL. IC2044.2 +003800 SELECT PRINT-FILE ASSIGN TO IC2044.2 +003900 "report.log". IC2044.2 +004000 DATA DIVISION. IC2044.2 +004100 FILE SECTION. IC2044.2 +004200 FD PRINT-FILE. IC2044.2 +004300 01 PRINT-REC PICTURE X(120). IC2044.2 +004400 01 DUMMY-RECORD PICTURE X(120). IC2044.2 +004500 WORKING-STORAGE SECTION. IC2044.2 +004600 77 WS1 PICTURE 99 VALUE ZERO. IC2044.2 +004700 77 WS2 PICTURE X(5) VALUE "FIRST". IC2044.2 +004800 LINKAGE SECTION. IC2044.2 +004900 77 SUB-DN1 PICTURE S999. IC2044.2 +005000 01 SUB-TABLE-1. IC2044.2 +005100 02 SUB-DN2 PIC XXX. IC2044.2 +005200 02 SUB-DN3 PIC 99. IC2044.2 +005300 02 SUB-DN4 PIC X(5). IC2044.2 +005400 PROCEDURE DIVISION USING SUB-TABLE-1, SUB-DN1. IC2044.2 +005500 SECT-IC204-0001 SECTION. IC2044.2 +005600 CNCL-TEST-01. IC2044.2 +005700 ADD 1 TO WS1. IC2044.2 +005800 MOVE WS1 TO SUB-DN1. IC2044.2 +005900 CNCL-TEST-02. IC2044.2 +006000 MOVE "NO" TO SUB-DN2. IC2044.2 +006100 IF WS2 EQUAL TO "FIRST" IC2044.2 +006200 MOVE SPACE TO WS2 IC2044.2 +006300 MOVE "YES" TO SUB-DN2. IC2044.2 +006400 CNCL-TEST-03. IC2044.2 +006500 MOVE SPACE TO SUB-DN4. IC2044.2 +006600 IF WS1 EQUAL TO SUB-DN3 IC2044.2 +006700 MOVE "EQUAL" TO SUB-DN4. IC2044.2 +006800 IC204-EXIT. IC2044.2 +006900 EXIT PROGRAM. IC2044.2 +007000* THE PARAMETER SUB-DN3 IS SET IN THE CALLING PROGRAM IC2044.2 +007100* EQUAL TO THE NUMBER OF TIMES THE SUBPROGRAM HAS BEEN IC2044.2 +007200* CALLED SINCE BEING INITIALIZED, EITHER BY THE FIRST CALL IC2044.2 +007300* OR THE FIRST CALL AFTER A CANCEL STATEMENT. IC2044.2 diff --git a/tests/cobol85/IC/lib/IC205A.CBL b/tests/cobol85/IC/lib/IC205A.CBL new file mode 100755 index 00000000..caa3b535 --- /dev/null +++ b/tests/cobol85/IC/lib/IC205A.CBL @@ -0,0 +1,70 @@ +000100 IDENTIFICATION DIVISION. IC2054.2 +000200 PROGRAM-ID. IC2054.2 +000300 IC205A. IC2054.2 +000400**************************************************************** IC2054.2 +000500* * IC2054.2 +000600* VALIDATION FOR:- * IC2054.2 +000700* * IC2054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2054.2 +000900* * IC2054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2054.2 +001100* * IC2054.2 +001200**************************************************************** IC2054.2 +001300* * IC2054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2054.2 +001500* * IC2054.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2054.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2054.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2054.2 +001900* * IC2054.2 +002000**************************************************************** IC2054.2 +002100* THE SUBPROGRAM IC205 TESTS THE USE OF THE CANCEL * IC2054.2 +002200* STATEMENT WITHIN A SUBPROGRAM. THIS SUBPROGRAM IS * IC2054.2 +002300* CALLED BY IC203 AND CALLS THE SUBPROGRAMS IC204 AND IC206.* IC2054.2 +002400**************************************************************** IC2054.2 +002500 ENVIRONMENT DIVISION. IC2054.2 +002600 CONFIGURATION SECTION. IC2054.2 +002700 SOURCE-COMPUTER. IC2054.2 +002800 Linux. IC2054.2 +002900 OBJECT-COMPUTER. IC2054.2 +003000 Linux. IC2054.2 +003100 INPUT-OUTPUT SECTION. IC2054.2 +003200 FILE-CONTROL. IC2054.2 +003300 SELECT PRINT-FILE ASSIGN TO IC2054.2 +003400 "report.log". IC2054.2 +003500 DATA DIVISION. IC2054.2 +003600 FILE SECTION. IC2054.2 +003700 FD PRINT-FILE. IC2054.2 +003800 01 PRINT-REC PICTURE X(120). IC2054.2 +003900 01 DUMMY-RECORD PICTURE X(120). IC2054.2 +004000 WORKING-STORAGE SECTION. IC2054.2 +004100 77 ID1 PICTURE X(6) VALUE "IC204A". IC2054.2 +004200 77 DN2 PICTURE S9(8) USAGE COMP VALUE ZERO. IC2054.2 +004300 LINKAGE SECTION. IC2054.2 +004400 01 TABLE-1. IC2054.2 +004500 02 T-DN1 PIC XXX. IC2054.2 +004600 02 T-DN2 PIC 99. IC2054.2 +004700 02 T-DN3 PIC X(5). IC2054.2 +004800 77 DN1 PICTURE S999. IC2054.2 +004900 01 TABLE-2. IC2054.2 +005000 02 TV-1 PIC X. IC2054.2 +005100 02 TV-2 PIC X. IC2054.2 +005200 PROCEDURE DIVISION USING TABLE-1, TABLE-2, DN1. IC2054.2 +005300 CNCL-TEST-05. IC2054.2 +005400 CALL "IC206A" USING DN2. IC2054.2 +005500 CALL "IC206A" USING DN2. IC2054.2 +005600 CALL "IC206A" USING DN2. IC2054.2 +005700 MOVE "X" TO TV-1. IC2054.2 +005800 IF DN2 EQUAL TO 3 IC2054.2 +005900 MOVE "A" TO TV-1. IC2054.2 +006000 CANCEL "IC206A". IC2054.2 +006100 MOVE ZERO TO DN2. IC2054.2 +006200 CALL "IC206A" USING DN2. IC2054.2 +006300 IF DN2 NOT EQUAL TO 1 IC2054.2 +006400 MOVE "Y" TO TV-2, IC2054.2 +006500 GO TO CNCL-TEST-06. IC2054.2 +006600 MOVE "B" TO TV-2. IC2054.2 +006700 CNCL-TEST-06. IC2054.2 +006800 CANCEL ID1. IC2054.2 +006900 EXIT-IC205. IC2054.2 +007000 EXIT PROGRAM. IC2054.2 diff --git a/tests/cobol85/IC/lib/IC206A.CBL b/tests/cobol85/IC/lib/IC206A.CBL new file mode 100755 index 00000000..f886f90c --- /dev/null +++ b/tests/cobol85/IC/lib/IC206A.CBL @@ -0,0 +1,56 @@ +000100 IDENTIFICATION DIVISION. IC2064.2 +000200 PROGRAM-ID. IC2064.2 +000300 IC206A. IC2064.2 +000400**************************************************************** IC2064.2 +000500* * IC2064.2 +000600* VALIDATION FOR:- * IC2064.2 +000700* * IC2064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2064.2 +000900* * IC2064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2064.2 +001100* * IC2064.2 +001200**************************************************************** IC2064.2 +001300* * IC2064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2064.2 +001500* * IC2064.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2064.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2064.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2064.2 +001900* * IC2064.2 +002000**************************************************************** IC2064.2 +002100* THE SUBPROGRAM IC206 IS CALLED BY THE SUBPROGRAM IC2064.2 +002200* IC205. THE SUBPROGRAM IS THEN CANCELED AND CALLED IC2064.2 +002300* AGAIN. THE PROGRAM IC205 CHECKS IF IC206 WAS IN ITS IC2064.2 +002400* INITIAL STATE ON THE FIRST CALL AFTER THE PROGRAM WAS IC2064.2 +002500* CANCELED. IC2064.2 +002600* THE LINKAGE PARAMETER DN1 CONTAINS THE NUMBER OF IC2064.2 +002700* TIMES IC206 HAS BEEN CALLED SINCE INITIALIZATION WHEN IC2064.2 +002800* CONTROL IS RETURNED TO THE CALLING PROGRAM. IC2064.2 +002900**************************************************************** IC2064.2 +003000 ENVIRONMENT DIVISION. IC2064.2 +003100 CONFIGURATION SECTION. IC2064.2 +003200 SOURCE-COMPUTER. IC2064.2 +003300 Linux. IC2064.2 +003400 OBJECT-COMPUTER. IC2064.2 +003500 Linux. IC2064.2 +003600 INPUT-OUTPUT SECTION. IC2064.2 +003700 FILE-CONTROL. IC2064.2 +003800 SELECT PRINT-FILE ASSIGN TO IC2064.2 +003900 "report.log". IC2064.2 +004000 DATA DIVISION. IC2064.2 +004100 FILE SECTION. IC2064.2 +004200 FD PRINT-FILE. IC2064.2 +004300 01 PRINT-REC PICTURE X(120). IC2064.2 +004400 01 DUMMY-RECORD PICTURE X(120). IC2064.2 +004500 WORKING-STORAGE SECTION. IC2064.2 +004600 77 WS1 PICTURE S9(8) USAGE COMPUTATIONAL IC2064.2 +004700 VALUE ZERO. IC2064.2 +004800 LINKAGE SECTION. IC2064.2 +004900 01 DN1 PICTURE S9(8) USAGE COMPUTATIONAL. IC2064.2 +005000 PROCEDURE DIVISION USING DN1. IC2064.2 +005100 SECT-IC206-0001 SECTION. IC2064.2 +005200 TEST-PARAGRAPH. IC2064.2 +005300 ADD 1 TO WS1. IC2064.2 +005400 MOVE WS1 TO DN1. IC2064.2 +005500 EXIT-IC206. IC2064.2 +005600 EXIT PROGRAM. IC2064.2 diff --git a/tests/cobol85/IC/lib/IC208A.CBL b/tests/cobol85/IC/lib/IC208A.CBL new file mode 100755 index 00000000..9ed9b3a4 --- /dev/null +++ b/tests/cobol85/IC/lib/IC208A.CBL @@ -0,0 +1,103 @@ +000100 IDENTIFICATION DIVISION. IC2084.2 +000200 PROGRAM-ID. IC2084.2 +000300 IC208A. IC2084.2 +000400**************************************************************** IC2084.2 +000500* * IC2084.2 +000600* VALIDATION FOR:- * IC2084.2 +000700* * IC2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2084.2 +000900* * IC2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2084.2 +001100* * IC2084.2 +001200**************************************************************** IC2084.2 +001300* * IC2084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2084.2 +001500* * IC2084.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2084.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2084.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2084.2 +001900* * IC2084.2 +002000**************************************************************** IC2084.2 +002100* THE SUBPROGRAM IC208 CONTAINS TABLES AND AN INDEX IC2084.2 +002200* DATA ITEM WHICH ARE DEFINED IN THE LINKAGE SECTION IC2084.2 +002300* AND NAMED AS OPERANDS IN THE USING PHRASE OF THE IC2084.2 +002400* PROCEDURE DIVISION HEADER. ONE OF THE TABLES IS DEFINED IC2084.2 +002500* WITH AN OCCURS DEPENDING ON CLAUSE AND HAS CONDITION-NAME IC2084.2 +002600* ENTRIES ASSOCIATED WITH IT. THE SEARCH STATEMENT IS USED IC2084.2 +002700* TO TEST THE VARIABLE LENGTH TABLE CAPABILITY. IC2084.2 +002800**************************************************************** IC2084.2 +002900 ENVIRONMENT DIVISION. IC2084.2 +003000 CONFIGURATION SECTION. IC2084.2 +003100 SOURCE-COMPUTER. IC2084.2 +003200 Linux. IC2084.2 +003300 OBJECT-COMPUTER. IC2084.2 +003400 Linux. IC2084.2 +003500 DATA DIVISION. IC2084.2 +003600 LINKAGE SECTION. IC2084.2 +003700 77 INDEX-1 USAGE IS INDEX. IC2084.2 +003800 77 DN3 PICTURE 99. IC2084.2 +003900 01 TABLE-01. IC2084.2 +004000 02 DN1 PICTURE X IC2084.2 +004100 OCCURS 1 TO 15 TIMES IC2084.2 +004200 DEPENDING ON DN3 IC2084.2 +004300 INDEXED BY IN1. IC2084.2 +004400 88 CN1 VALUE "A". IC2084.2 +004500 88 CN2 VALUE "H". IC2084.2 +004600 88 CN3 VALUE "O". IC2084.2 +004700 01 TABLE-02. IC2084.2 +004800 02 DN2 PICTURE X IC2084.2 +004900 OCCURS 8 TIMES. IC2084.2 +005000 PROCEDURE DIVISION USING TABLE-01, TABLE-02, INDEX-1, DN3. IC2084.2 +005100 SECT-IC208-0001 SECTION. IC2084.2 +005200 LINK-TEST-01. IC2084.2 +005300* THIS TEST USES THE INDEX DATA ITEM SET IN THE CALLING IC2084.2 +005400* PROGRAM TO SET AN INDEX AND REFERENCE A TABLE ITEM. IC2084.2 +005500 SET IN1 TO INDEX-1. IC2084.2 +005600 MOVE DN1 (IN1) TO DN2 (1). IC2084.2 +005700* LINK-TEST-02 TESTS THE VARIABLE LENGTH TABLE CAPABILITY IC2084.2 +005800* WITH THE DATA-NAME WHOSE CONTENTS IS THE TABLE LENGTH IC2084.2 +005900* DEFINED IN THE LINKAGE SECTION. IC2084.2 +006000 LINK-TEST-02-01. IC2084.2 +006100 SET IN1 TO 1. IC2084.2 +006200 SEARCH DN1 VARYING IN1 IC2084.2 +006300 AT END MOVE "Z" TO DN2 (2) IC2084.2 +006400 WHEN DN1 (IN1) EQUAL TO "D" IC2084.2 +006500 MOVE "D" TO DN2 (2). IC2084.2 +006600 LINK-TEST-02-02. IC2084.2 +006700 SET IN1 TO 1. IC2084.2 +006800 SEARCH DN1 VARYING IN1 IC2084.2 +006900 AT END MOVE "Y" TO DN2 (3) IC2084.2 +007000 WHEN DN1 (IN1) EQUAL TO "B" IC2084.2 +007100 MOVE "B" TO DN2 (3). IC2084.2 +007200 LINK-TEST-02-03. IC2084.2 +007300 MOVE 7 TO DN3. IC2084.2 +007400 SET IN1 TO 1. IC2084.2 +007500 SEARCH DN1 VARYING IN1 IC2084.2 +007600 AT END MOVE "X" TO DN2 (4) IC2084.2 +007700 WHEN DN1 (IN1) EQUAL TO "H" IC2084.2 +007800 MOVE "H" TO DN2 (4). IC2084.2 +007900 LINK-TEST-02-04. IC2084.2 +008000 SET IN1 TO 1. IC2084.2 +008100 SEARCH DN1 VARYING IN1 IC2084.2 +008200 AT END MOVE "W" TO DN2 (5) IC2084.2 +008300 WHEN DN1 (IN1) EQUAL TO "G" IC2084.2 +008400 MOVE "G" TO DN2 (5). IC2084.2 +008500 LINK-TEST-03. IC2084.2 +008600 MOVE 10 TO DN3. IC2084.2 +008700* LINK-TEST-03 TESTS THE USE OF CONDITION-NAMES WHICH IC2084.2 +008800* WERE DEFINED IN THE LINKAGE SECTION. IC2084.2 +008900 LINK-TEST-03-01. IC2084.2 +009000 IF CN1 (1) MOVE "A" TO DN2 (6). IC2084.2 +009100 LINK-TEST-03-02. IC2084.2 +009200 IF CN1 (5) MOVE "N" TO DN2 (7) IC2084.2 +009300 ELSE MOVE "V" TO DN2 (7). IC2084.2 +009400 LINK-TEST-03-03. IC2084.2 +009500 IF CN2 (8) MOVE "H" TO DN2 (8). IC2084.2 +009600 LINK-TEST-04. IC2084.2 +009700* THIS TEST SETS THE INDEX DATA ITEM AND TABLE LENGTH IC2084.2 +009800* FOR REFERENCE IN THE CALLING PROGRAM. IC2084.2 +009900 SET IN1 TO 2. IC2084.2 +010000 SET INDEX-1 TO IN1. IC2084.2 +010100 MOVE 9 TO DN3. IC2084.2 +010200 EXIT-IC208. IC2084.2 +010300 EXIT PROGRAM. IC2084.2 diff --git a/tests/cobol85/IC/lib/IC210A.CBL b/tests/cobol85/IC/lib/IC210A.CBL new file mode 100755 index 00000000..112853fb --- /dev/null +++ b/tests/cobol85/IC/lib/IC210A.CBL @@ -0,0 +1,50 @@ +000100 IDENTIFICATION DIVISION. IC2104.2 +000200 PROGRAM-ID. IC2104.2 +000300 IC210A. IC2104.2 +000400**************************************************************** IC2104.2 +000500* * IC2104.2 +000600* VALIDATION FOR:- * IC2104.2 +000700* * IC2104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2104.2 +000900* * IC2104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2104.2 +001100* * IC2104.2 +001200**************************************************************** IC2104.2 +001300* * IC2104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2104.2 +001500* * IC2104.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2104.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2104.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2104.2 +001900* * IC2104.2 +002000**************************************************************** IC2104.2 +002100* 1 THIS IS SUBPROGRAM IC210. IC2104.2 +002200**************************************************************** IC2104.2 +002300 ENVIRONMENT DIVISION. IC2104.2 +002400 CONFIGURATION SECTION. IC2104.2 +002500 SOURCE-COMPUTER. IC2104.2 +002600 Linux. IC2104.2 +002700 OBJECT-COMPUTER. IC2104.2 +002800 Linux. IC2104.2 +002900 DATA DIVISION. IC2104.2 +003000 LINKAGE SECTION. IC2104.2 +003100 01 TEST-AREA. IC2104.2 +003200 02 TEST1 PICTURE X. IC2104.2 +003300 02 TEST2 PICTURE X. IC2104.2 +003400 02 TEST3 PICTURE X. IC2104.2 +003500 02 TEST4 PICTURE X. IC2104.2 +003600 PROCEDURE DIVISION USING TEST-AREA. IC2104.2 +003700 CALL-TEST-2. IC2104.2 +003800 MOVE "Y" TO TEST1. IC2104.2 +003900 CALL "IC211A" USING TEST-AREA. IC2104.2 +004000 IF TEST2 = "Y" GO TO CALL-TEST-3. IC2104.2 +004100 MOVE "N" TO TEST2. IC2104.2 +004200 CALL-TEST-3. IC2104.2 +004300 CALL "IC212A" USING TEST-AREA. IC2104.2 +004400 IF TEST3 = "Y" GO TO CANCEL-TEST-1. IC2104.2 +004500 MOVE "N" TO TEST3. IC2104.2 +004600 CANCEL-TEST-1. IC2104.2 +004700 CANCEL "IC211A". IC2104.2 +004800 MOVE "Y" TO TEST4. IC2104.2 +004900 IC210-EXIT. IC2104.2 +005000 EXIT PROGRAM. IC2104.2 diff --git a/tests/cobol85/IC/lib/IC211A.CBL b/tests/cobol85/IC/lib/IC211A.CBL new file mode 100755 index 00000000..cf0eda92 --- /dev/null +++ b/tests/cobol85/IC/lib/IC211A.CBL @@ -0,0 +1,40 @@ +000100 IDENTIFICATION DIVISION. IC2114.2 +000200 PROGRAM-ID. IC2114.2 +000300 IC211A. IC2114.2 +000400**************************************************************** IC2114.2 +000500* * IC2114.2 +000600* VALIDATION FOR:- * IC2114.2 +000700* * IC2114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2114.2 +000900* * IC2114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2114.2 +001100* * IC2114.2 +001200**************************************************************** IC2114.2 +001300* * IC2114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2114.2 +001500* * IC2114.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2114.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2114.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2114.2 +001900* * IC2114.2 +002000**************************************************************** IC2114.2 +002100* THIS IS SUBPROGRAM IC211. IC2114.2 +002200**************************************************************** IC2114.2 +002300 ENVIRONMENT DIVISION. IC2114.2 +002400 CONFIGURATION SECTION. IC2114.2 +002500 SOURCE-COMPUTER. IC2114.2 +002600 Linux. IC2114.2 +002700 OBJECT-COMPUTER. IC2114.2 +002800 Linux. IC2114.2 +002900 DATA DIVISION. IC2114.2 +003000 LINKAGE SECTION. IC2114.2 +003100 01 TEST-AREA. IC2114.2 +003200 02 TEST1 PICTURE X. IC2114.2 +003300 02 TEST2 PICTURE X. IC2114.2 +003400 02 TEST3 PICTURE X. IC2114.2 +003500 02 TEST4 PICTURE X. IC2114.2 +003600 PROCEDURE DIVISION USING TEST-AREA. IC2114.2 +003700 CALL-TEST-2. IC2114.2 +003800 MOVE "Y" TO TEST2. IC2114.2 +003900 IC211-EXIT. IC2114.2 +004000 EXIT PROGRAM. IC2114.2 diff --git a/tests/cobol85/IC/lib/IC212A.CBL b/tests/cobol85/IC/lib/IC212A.CBL new file mode 100755 index 00000000..1aee5c04 --- /dev/null +++ b/tests/cobol85/IC/lib/IC212A.CBL @@ -0,0 +1,40 @@ +000100 IDENTIFICATION DIVISION. IC2124.2 +000200 PROGRAM-ID. IC2124.2 +000300 IC212A. IC2124.2 +000400**************************************************************** IC2124.2 +000500* * IC2124.2 +000600* VALIDATION FOR:- * IC2124.2 +000700* * IC2124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2124.2 +000900* * IC2124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2124.2 +001100* * IC2124.2 +001200**************************************************************** IC2124.2 +001300* * IC2124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2124.2 +001500* * IC2124.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2124.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2124.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2124.2 +001900* * IC2124.2 +002000**************************************************************** IC2124.2 +002100* THIS IS SUBPROGRAM IC212. IC2124.2 +002200**************************************************************** IC2124.2 +002300 ENVIRONMENT DIVISION. IC2124.2 +002400 CONFIGURATION SECTION. IC2124.2 +002500 SOURCE-COMPUTER. IC2124.2 +002600 Linux. IC2124.2 +002700 OBJECT-COMPUTER. IC2124.2 +002800 Linux. IC2124.2 +002900 DATA DIVISION. IC2124.2 +003000 LINKAGE SECTION. IC2124.2 +003100 01 TEST-AREA. IC2124.2 +003200 02 TEST1 PICTURE X. IC2124.2 +003300 02 TEST2 PICTURE X. IC2124.2 +003400 02 TEST3 PICTURE X. IC2124.2 +003500 02 TEST4 PICTURE X. IC2124.2 +003600 PROCEDURE DIVISION USING TEST-AREA. IC2124.2 +003700 CALL-TEST-3. IC2124.2 +003800 MOVE "Y" TO TEST3. IC2124.2 +003900 IC212-EXIT. IC2124.2 +004000 EXIT PROGRAM. IC2124.2 diff --git a/tests/cobol85/IC/lib/IC214A.CBL b/tests/cobol85/IC/lib/IC214A.CBL new file mode 100755 index 00000000..487fb834 --- /dev/null +++ b/tests/cobol85/IC/lib/IC214A.CBL @@ -0,0 +1,36 @@ +000100 IDENTIFICATION DIVISION. IC2144.2 +000200 PROGRAM-ID. IC2144.2 +000300 IC214A. IC2144.2 +000400**************************************************************** IC2144.2 +000500* * IC2144.2 +000600* VALIDATION FOR:- * IC2144.2 +000700* * IC2144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2144.2 +000900* * IC2144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2144.2 +001100* * IC2144.2 +001200**************************************************************** IC2144.2 +001300* * IC2144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2144.2 +001500* * IC2144.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2144.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2144.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2144.2 +001900* * IC2144.2 +002000**************************************************************** IC2144.2 +002100* THIS IS SUBPROGRAM IC214. IC2144.2 +002200**************************************************************** IC2144.2 +002300 ENVIRONMENT DIVISION. IC2144.2 +002400 CONFIGURATION SECTION. IC2144.2 +002500 SOURCE-COMPUTER. IC2144.2 +002600 Linux. IC2144.2 +002700 OBJECT-COMPUTER. IC2144.2 +002800 Linux. IC2144.2 +002900 DATA DIVISION. IC2144.2 +003000 LINKAGE SECTION. IC2144.2 +003100 01 DN1 PICTURE S9. IC2144.2 +003200 PROCEDURE DIVISION USING DN1. IC2144.2 +003300 CALL-TEST-1. IC2144.2 +003400 MOVE 1 TO DN1. IC2144.2 +003500 IC214-EXIT. IC2144.2 +003600 EXIT PROGRAM. IC2144.2 diff --git a/tests/cobol85/IC/lib/IC215A.CBL b/tests/cobol85/IC/lib/IC215A.CBL new file mode 100755 index 00000000..403cf655 --- /dev/null +++ b/tests/cobol85/IC/lib/IC215A.CBL @@ -0,0 +1,40 @@ +000100 IDENTIFICATION DIVISION. IC2154.2 +000200 PROGRAM-ID. IC2154.2 +000300 IC215A. IC2154.2 +000400**************************************************************** IC2154.2 +000500* * IC2154.2 +000600* VALIDATION FOR:- * IC2154.2 +000700* * IC2154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2154.2 +000900* * IC2154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2154.2 +001100* * IC2154.2 +001200**************************************************************** IC2154.2 +001300* * IC2154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2154.2 +001500* * IC2154.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2154.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2154.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2154.2 +001900* * IC2154.2 +002000**************************************************************** IC2154.2 +002100* THIS IS SUBPROGRAM IC215. IC2154.2 +002200**************************************************************** IC2154.2 +002300 ENVIRONMENT DIVISION. IC2154.2 +002400 CONFIGURATION SECTION. IC2154.2 +002500 SOURCE-COMPUTER. IC2154.2 +002600 Linux. IC2154.2 +002700 OBJECT-COMPUTER. IC2154.2 +002800 Linux. IC2154.2 +002900 DATA DIVISION. IC2154.2 +003000 LINKAGE SECTION. IC2154.2 +003100 01 DN2 PICTURE S9. IC2154.2 +003200 01 DN3 PICTURE S9. IC2154.2 +003300 PROCEDURE DIVISION USING DN2, DN3. IC2154.2 +003400 CALL-TEST-2. IC2154.2 +003500 MOVE 1 TO DN2. IC2154.2 +003600 CANCEL-TEST-1. IC2154.2 +003700 CANCEL "IC214A". IC2154.2 +003800 MOVE 1 TO DN3. IC2154.2 +003900 IC215-EXIT. IC2154.2 +004000 EXIT PROGRAM. IC2154.2 diff --git a/tests/cobol85/IC/lib/IC217A.CBL b/tests/cobol85/IC/lib/IC217A.CBL new file mode 100755 index 00000000..e52a44b0 --- /dev/null +++ b/tests/cobol85/IC/lib/IC217A.CBL @@ -0,0 +1,48 @@ +000100 IDENTIFICATION DIVISION. IC2174.2 +000200 PROGRAM-ID. IC2174.2 +000300 IC217A. IC2174.2 +000400**************************************************************** IC2174.2 +000500* * IC2174.2 +000600* VALIDATION FOR:- * IC2174.2 +000700* * IC2174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2174.2 +000900* * IC2174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2174.2 +001100* * IC2174.2 +001200**************************************************************** IC2174.2 +001300* * IC2174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2174.2 +001500* * IC2174.2 +001600* X-55 - SYSTEM PRINTER NAME. * IC2174.2 +001700* X-82 - SOURCE COMPUTER NAME. * IC2174.2 +001800* X-83 - OBJECT COMPUTER NAME. * IC2174.2 +001900* * IC2174.2 +002000**************************************************************** IC2174.2 +002100* THIS IS SUBPROGRAM IC217. IC2174.2 +002200**************************************************************** IC2174.2 +002300 ENVIRONMENT DIVISION. IC2174.2 +002400 CONFIGURATION SECTION. IC2174.2 +002500 SOURCE-COMPUTER. IC2174.2 +002600 Linux. IC2174.2 +002700 OBJECT-COMPUTER. IC2174.2 +002800 Linux. IC2174.2 +002900 DATA DIVISION. IC2174.2 +003000 LINKAGE SECTION. IC2174.2 +003100 01 DN1. IC2174.2 +003200 02 DN2 PICTURE X(5). IC2174.2 +003300 02 DN3 REDEFINES DN2 PICTURE 9(5). IC2174.2 +003400 01 DN4. IC2174.2 +003500 02 DN5. IC2174.2 +003600 03 DN6 PICTURE X(3). IC2174.2 +003700 03 DN7 PICTURE X(3). IC2174.2 +003800 03 DN8 REDEFINES DN7 PICTURE 9(3). IC2174.2 +003900 02 DN9 PICTURE XX. IC2174.2 +004000 PROCEDURE DIVISION USING DN1, DN4. IC2174.2 +004100 CALL-TEST-1. IC2174.2 +004200 MOVE 12345 TO DN3. IC2174.2 +004300 CALL-TEST-2. IC2174.2 +004400 MOVE "YES" TO DN6. IC2174.2 +004500 MOVE 987 TO DN8. IC2174.2 +004600 MOVE "NO" TO DN9. IC2174.2 +004700 IC217-EXIT. IC2174.2 +004800 EXIT PROGRAM. IC2174.2 diff --git a/tests/cobol85/IF.txt b/tests/cobol85/IF.txt deleted file mode 100644 index e63cda0f..00000000 --- a/tests/cobol85/IF.txt +++ /dev/null @@ -1,55 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -IF101A.CBL 26 26 0 0 0 OK -IF102A.CBL 13 13 0 0 0 OK -IF103A.CBL 23 23 0 0 0 OK -IF104A.CBL 27 27 0 0 0 OK -IF105A.CBL 8 8 0 0 0 OK -IF106A.CBL 30 30 0 0 0 OK -IF107A.CBL 2 2 0 0 0 OK -IF108A.CBL 10 10 0 0 0 OK -IF109A.CBL 8 8 0 0 0 OK -IF110A.CBL 9 9 0 0 0 OK -IF111A.CBL 23 23 0 0 0 OK -IF112A.CBL 8 8 0 0 0 OK -IF113A.CBL 8 8 0 0 0 OK -IF114A.CBL 23 23 0 0 0 OK -IF115A.CBL 8 8 0 0 0 OK -IF116A.CBL 25 25 0 0 0 OK -IF117A.CBL 32 32 0 0 0 OK -IF118A.CBL 13 13 0 0 0 OK -IF119A.CBL 23 23 0 0 0 OK -IF120A.CBL 17 17 0 0 0 OK -IF121A.CBL 17 17 0 0 0 OK -IF122A.CBL 17 17 0 0 0 OK -IF123A.CBL 23 23 0 0 0 OK -IF124A.CBL 21 21 0 0 0 OK -IF125A.CBL 20 20 0 0 0 OK -IF126A.CBL 30 30 0 0 0 OK -IF127A.CBL 9 9 0 0 0 OK -IF128A.CBL 16 16 0 0 0 OK -IF129A.CBL 17 17 0 0 0 OK -IF130A.CBL 21 21 0 0 0 OK -IF131A.CBL 8 8 0 0 0 OK -IF132A.CBL 15 15 0 0 0 OK -IF133A.CBL 17 17 0 0 0 OK -IF134A.CBL 13 13 0 0 0 OK -IF135A.CBL 32 32 0 0 0 OK -IF136A.CBL 26 26 0 0 0 OK -IF137A.CBL 17 17 0 0 0 OK -IF138A.CBL 16 16 0 0 0 OK -IF139A.CBL 30 30 0 0 0 OK -IF140A.CBL 13 13 0 0 0 OK -IF141A.CBL 16 16 0 0 0 OK -IF142A.CBL 2 2 0 0 0 OK -IF401M.CBL ----- test skipped ----- -IF402M.CBL ----- test skipped ----- -IF403M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 732 732 0 0 0 -% 100.0 100.0 0.0 0.0 0.0 - -Number of programs: 42 -Successfully executed: 42 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/IF/IF101A.CBL b/tests/cobol85/IF/IF101A.CBL new file mode 100755 index 00000000..3d024549 --- /dev/null +++ b/tests/cobol85/IF/IF101A.CBL @@ -0,0 +1,906 @@ +000100 IDENTIFICATION DIVISION. IF1014.2 +000200 PROGRAM-ID. IF1014.2 +000300 IF101A. IF1014.2 +000400 IF1014.2 +000500*********************************************************** IF1014.2 +000600* * IF1014.2 +000700* This program is intended to form part of the CCVS85 * IF1014.2 +000800* COBOL Test Suite. It contains tests for the * IF1014.2 +000900* Intrinsic Function ACOS. * IF1014.2 +001000* * IF1014.2 +001100*********************************************************** IF1014.2 +001200 ENVIRONMENT DIVISION. IF1014.2 +001300 CONFIGURATION SECTION. IF1014.2 +001400 SOURCE-COMPUTER. IF1014.2 +001500 Linux. IF1014.2 +001600 OBJECT-COMPUTER. IF1014.2 +001700 Linux. IF1014.2 +001800 INPUT-OUTPUT SECTION. IF1014.2 +001900 FILE-CONTROL. IF1014.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1014.2 +002100 "report.log". IF1014.2 +002200 DATA DIVISION. IF1014.2 +002300 FILE SECTION. IF1014.2 +002400 FD PRINT-FILE. IF1014.2 +002500 01 PRINT-REC PICTURE X(120). IF1014.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1014.2 +002700 WORKING-STORAGE SECTION. IF1014.2 +002800*********************************************************** IF1014.2 +002900* Variables specific to the Intrinsic Function Test IF101A* IF1014.2 +003000*********************************************************** IF1014.2 +003100 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1014.2 +003200 01 B PIC S9(10) VALUE 4. IF1014.2 +003300 01 C PIC S9(10) VALUE 100000. IF1014.2 +003400 01 D PIC S9(10) VALUE 1000. IF1014.2 +003500 01 PI PIC S9V9(17) VALUE 3.141592654. IF1014.2 +003600 01 ARG1 PIC S9V9(17) VALUE 0.00. IF1014.2 +003700 01 SQRT2 PIC S9V9(17) VALUE 1.414213562. IF1014.2 +003800 01 SQRT3D2 PIC S9V9(17) VALUE 0.866025403. IF1014.2 +003900 01 ARR VALUE "40537". IF1014.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1014.2 +004100 01 TEMP PIC S9(5)V9(5). IF1014.2 +004200 01 WS-NUM PIC S9(5)V9(6). IF1014.2 +004300 01 MIN-RANGE PIC S9(5)V9(7). IF1014.2 +004400 01 MAX-RANGE PIC S9(5)V9(7). IF1014.2 +004500* IF1014.2 +004600********************************************************** IF1014.2 +004700* IF1014.2 +004800 01 TEST-RESULTS. IF1014.2 +004900 02 FILLER PIC X VALUE SPACE. IF1014.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IF1014.2 +005100 02 FILLER PIC X VALUE SPACE. IF1014.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IF1014.2 +005300 02 FILLER PIC X VALUE SPACE. IF1014.2 +005400 02 PAR-NAME. IF1014.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IF1014.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IF1014.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IF1014.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IF1014.2 +005900 02 RE-MARK PIC X(61). IF1014.2 +006000 01 TEST-COMPUTED. IF1014.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IF1014.2 +006200 02 FILLER PIC X(17) VALUE IF1014.2 +006300 " COMPUTED=". IF1014.2 +006400 02 COMPUTED-X. IF1014.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1014.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IF1014.2 +006700 PIC -9(9).9(9). IF1014.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1014.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1014.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1014.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IF1014.2 +007200 04 COMPUTED-18V0 PIC -9(18). IF1014.2 +007300 04 FILLER PIC X. IF1014.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IF1014.2 +007500 01 TEST-CORRECT. IF1014.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IF1014.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1014.2 +007800 02 CORRECT-X. IF1014.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1014.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1014.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1014.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1014.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1014.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IF1014.2 +008500 04 CORRECT-18V0 PIC -9(18). IF1014.2 +008600 04 FILLER PIC X. IF1014.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IF1014.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1014.2 +008900 01 TEST-CORRECT-MIN. IF1014.2 +009000 02 FILLER PIC X(30) VALUE SPACE. IF1014.2 +009100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1014.2 +009200 02 CORRECTMI-X. IF1014.2 +009300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1014.2 +009400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1014.2 +009500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1014.2 +009600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1014.2 +009700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1014.2 +009800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1014.2 +009900 04 CORRECTMI-18V0 PIC -9(18). IF1014.2 +010000 04 FILLER PIC X. IF1014.2 +010100 03 FILLER PIC X(2) VALUE SPACE. IF1014.2 +010200 03 FILLER PIC X(48) VALUE SPACE. IF1014.2 +010300 01 TEST-CORRECT-MAX. IF1014.2 +010400 02 FILLER PIC X(30) VALUE SPACE. IF1014.2 +010500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1014.2 +010600 02 CORRECTMA-X. IF1014.2 +010700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1014.2 +010800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1014.2 +010900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1014.2 +011000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1014.2 +011100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1014.2 +011200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1014.2 +011300 04 CORRECTMA-18V0 PIC -9(18). IF1014.2 +011400 04 FILLER PIC X. IF1014.2 +011500 03 FILLER PIC X(2) VALUE SPACE. IF1014.2 +011600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1014.2 +011700 01 CCVS-C-1. IF1014.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1014.2 +011900- "SS PARAGRAPH-NAME IF1014.2 +012000- " REMARKS". IF1014.2 +012100 02 FILLER PIC X(20) VALUE SPACE. IF1014.2 +012200 01 CCVS-C-2. IF1014.2 +012300 02 FILLER PIC X VALUE SPACE. IF1014.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". IF1014.2 +012500 02 FILLER PIC X(15) VALUE SPACE. IF1014.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". IF1014.2 +012700 02 FILLER PIC X(94) VALUE SPACE. IF1014.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1014.2 +012900 01 REC-CT PIC 99 VALUE ZERO. IF1014.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1014.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1014.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1014.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1014.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1014.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1014.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1014.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1014.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1014.2 +013900 01 CCVS-H-1. IF1014.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1014.2 +014100 02 FILLER PIC X(42) VALUE IF1014.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1014.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IF1014.2 +014400 01 CCVS-H-2A. IF1014.2 +014500 02 FILLER PIC X(40) VALUE SPACE. IF1014.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1014.2 +014700 02 FILLER PIC XXXX VALUE IF1014.2 +014800 "4.2 ". IF1014.2 +014900 02 FILLER PIC X(28) VALUE IF1014.2 +015000 " COPY - NOT FOR DISTRIBUTION". IF1014.2 +015100 02 FILLER PIC X(41) VALUE SPACE. IF1014.2 +015200 IF1014.2 +015300 01 CCVS-H-2B. IF1014.2 +015400 02 FILLER PIC X(15) VALUE IF1014.2 +015500 "TEST RESULT OF ". IF1014.2 +015600 02 TEST-ID PIC X(9). IF1014.2 +015700 02 FILLER PIC X(4) VALUE IF1014.2 +015800 " IN ". IF1014.2 +015900 02 FILLER PIC X(12) VALUE IF1014.2 +016000 " HIGH ". IF1014.2 +016100 02 FILLER PIC X(22) VALUE IF1014.2 +016200 " LEVEL VALIDATION FOR ". IF1014.2 +016300 02 FILLER PIC X(58) VALUE IF1014.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1014.2 +016500 01 CCVS-H-3. IF1014.2 +016600 02 FILLER PIC X(34) VALUE IF1014.2 +016700 " FOR OFFICIAL USE ONLY ". IF1014.2 +016800 02 FILLER PIC X(58) VALUE IF1014.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1014.2 +017000 02 FILLER PIC X(28) VALUE IF1014.2 +017100 " COPYRIGHT 1985 ". IF1014.2 +017200 01 CCVS-E-1. IF1014.2 +017300 02 FILLER PIC X(52) VALUE SPACE. IF1014.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1014.2 +017500 02 ID-AGAIN PIC X(9). IF1014.2 +017600 02 FILLER PIC X(45) VALUE SPACES. IF1014.2 +017700 01 CCVS-E-2. IF1014.2 +017800 02 FILLER PIC X(31) VALUE SPACE. IF1014.2 +017900 02 FILLER PIC X(21) VALUE SPACE. IF1014.2 +018000 02 CCVS-E-2-2. IF1014.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1014.2 +018200 03 FILLER PIC X VALUE SPACE. IF1014.2 +018300 03 ENDER-DESC PIC X(44) VALUE IF1014.2 +018400 "ERRORS ENCOUNTERED". IF1014.2 +018500 01 CCVS-E-3. IF1014.2 +018600 02 FILLER PIC X(22) VALUE IF1014.2 +018700 " FOR OFFICIAL USE ONLY". IF1014.2 +018800 02 FILLER PIC X(12) VALUE SPACE. IF1014.2 +018900 02 FILLER PIC X(58) VALUE IF1014.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1014.2 +019100 02 FILLER PIC X(13) VALUE SPACE. IF1014.2 +019200 02 FILLER PIC X(15) VALUE IF1014.2 +019300 " COPYRIGHT 1985". IF1014.2 +019400 01 CCVS-E-4. IF1014.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1014.2 +019600 02 FILLER PIC X(4) VALUE " OF ". IF1014.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1014.2 +019800 02 FILLER PIC X(40) VALUE IF1014.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1014.2 +020000 01 XXINFO. IF1014.2 +020100 02 FILLER PIC X(19) VALUE IF1014.2 +020200 "*** INFORMATION ***". IF1014.2 +020300 02 INFO-TEXT. IF1014.2 +020400 04 FILLER PIC X(8) VALUE SPACE. IF1014.2 +020500 04 XXCOMPUTED PIC X(20). IF1014.2 +020600 04 FILLER PIC X(5) VALUE SPACE. IF1014.2 +020700 04 XXCORRECT PIC X(20). IF1014.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). IF1014.2 +020900 01 HYPHEN-LINE. IF1014.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. IF1014.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************IF1014.2 +021200- "*****************************************". IF1014.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************IF1014.2 +021400- "******************************". IF1014.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE IF1014.2 +021600 "IF101A". IF1014.2 +021700 PROCEDURE DIVISION. IF1014.2 +021800 CCVS1 SECTION. IF1014.2 +021900 OPEN-FILES. IF1014.2 +022000 OPEN OUTPUT PRINT-FILE. IF1014.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1014.2 +022200 MOVE SPACE TO TEST-RESULTS. IF1014.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1014.2 +022400 GO TO CCVS1-EXIT. IF1014.2 +022500 CLOSE-FILES. IF1014.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1014.2 +022700 TERMINATE-CCVS. IF1014.2 +022800 STOP RUN. IF1014.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1014.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1014.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1014.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1014.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IF1014.2 +023400 PRINT-DETAIL. IF1014.2 +023500 IF REC-CT NOT EQUAL TO ZERO IF1014.2 +023600 MOVE "." TO PARDOT-X IF1014.2 +023700 MOVE REC-CT TO DOTVALUE. IF1014.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1014.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1014.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1014.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1014.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1014.2 +024300 MOVE SPACE TO CORRECT-X. IF1014.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1014.2 +024500 MOVE SPACE TO RE-MARK. IF1014.2 +024600 HEAD-ROUTINE. IF1014.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1014.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1014.2 +025100 COLUMN-NAMES-ROUTINE. IF1014.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +025500 END-ROUTINE. IF1014.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1014.2 +025700 END-RTN-EXIT. IF1014.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +025900 END-ROUTINE-1. IF1014.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1014.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1014.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IF1014.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1014.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1014.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1014.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1014.2 +026700 END-ROUTINE-12. IF1014.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1014.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1014.2 +027000 MOVE "NO " TO ERROR-TOTAL IF1014.2 +027100 ELSE IF1014.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1014.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1014.2 +027400 PERFORM WRITE-LINE. IF1014.2 +027500 END-ROUTINE-13. IF1014.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1014.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE IF1014.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1014.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1014.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO IF1014.2 +028200 MOVE "NO " TO ERROR-TOTAL IF1014.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1014.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1014.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1014.2 +028700 WRITE-LINE. IF1014.2 +028800 ADD 1 TO RECORD-COUNT. IF1014.2 +028900 IF RECORD-COUNT GREATER 42 IF1014.2 +029000 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1014.2 +029100 MOVE SPACE TO DUMMY-RECORD IF1014.2 +029200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1014.2 +029300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1014.2 +029400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1014.2 +029500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1014.2 +029600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1014.2 +029700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1014.2 +029800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1014.2 +029900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1014.2 +030000 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1014.2 +030100 MOVE ZERO TO RECORD-COUNT. IF1014.2 +030200 PERFORM WRT-LN. IF1014.2 +030300 WRT-LN. IF1014.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1014.2 +030500 MOVE SPACE TO DUMMY-RECORD. IF1014.2 +030600 BLANK-LINE-PRINT. IF1014.2 +030700 PERFORM WRT-LN. IF1014.2 +030800 FAIL-ROUTINE. IF1014.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE IF1014.2 +031000 GO TO FAIL-ROUTINE-WRITE. IF1014.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1014.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1014.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1014.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1014.2 +031600 GO TO FAIL-ROUTINE-EX. IF1014.2 +031700 FAIL-ROUTINE-WRITE. IF1014.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1014.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1014.2 +032000 CORMA-ANSI-REFERENCE. IF1014.2 +032100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1014.2 +032200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1014.2 +032300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1014.2 +032400 ELSE IF1014.2 +032500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1014.2 +032600 PERFORM WRITE-LINE. IF1014.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1014.2 +032800 FAIL-ROUTINE-EX. EXIT. IF1014.2 +032900 BAIL-OUT. IF1014.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1014.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1014.2 +033200 BAIL-OUT-WRITE. IF1014.2 +033300 MOVE CORRECT-A TO XXCORRECT. IF1014.2 +033400 MOVE COMPUTED-A TO XXCOMPUTED. IF1014.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1014.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1014.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1014.2 +033800 BAIL-OUT-EX. EXIT. IF1014.2 +033900 CCVS1-EXIT. IF1014.2 +034000 EXIT. IF1014.2 +034100******************************************************** IF1014.2 +034200* * IF1014.2 +034300* Intrinsic Function Tests IF101A - ACOS * IF1014.2 +034400* * IF1014.2 +034500******************************************************** IF1014.2 +034600 SECT-IF101A SECTION. IF1014.2 +034700 F-ACOS-INFO. IF1014.2 +034800 MOVE "See ref. A-33 2.5" TO ANSI-REFERENCE. IF1014.2 +034900 MOVE "ACOS Function" TO FEATURE. IF1014.2 +035000*****************TEST (a) - SIMPLE TEST***************** IF1014.2 +035100 F-ACOS-01. IF1014.2 +035200 MOVE ZERO TO WS-NUM. IF1014.2 +035300 MOVE 0.000000 TO MIN-RANGE. IF1014.2 +035400 MOVE 0.000020 TO MAX-RANGE. IF1014.2 +035500 F-ACOS-TEST-01. IF1014.2 +035600 COMPUTE WS-NUM = FUNCTION ACOS(1.0). IF1014.2 +035700 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +035800 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +035900 PERFORM PASS IF1014.2 +036000 ELSE IF1014.2 +036100 MOVE WS-NUM TO COMPUTED-N IF1014.2 +036200 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +036300 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +036400 PERFORM FAIL. IF1014.2 +036500 GO TO F-ACOS-WRITE-01. IF1014.2 +036600 F-ACOS-DELETE-01. IF1014.2 +036700 PERFORM DE-LETE. IF1014.2 +036800 GO TO F-ACOS-WRITE-01. IF1014.2 +036900 F-ACOS-WRITE-01. IF1014.2 +037000 MOVE "F-ACOS-01" TO PAR-NAME. IF1014.2 +037100 PERFORM PRINT-DETAIL. IF1014.2 +037200*****************TEST (b) - SIMPLE TEST***************** IF1014.2 +037300 F-ACOS-02. IF1014.2 +037400 MOVE 1.04718 TO MIN-RANGE. IF1014.2 +037500 MOVE 1.04722 TO MAX-RANGE. IF1014.2 +037600 F-ACOS-TEST-02. IF1014.2 +037700 IF (FUNCTION ACOS(0.5) >= MIN-RANGE) AND IF1014.2 +037800 (FUNCTION ACOS(0.5) <= MAX-RANGE) THEN IF1014.2 +037900 PERFORM PASS IF1014.2 +038000 ELSE IF1014.2 +038100 PERFORM FAIL. IF1014.2 +038200 GO TO F-ACOS-WRITE-02. IF1014.2 +038300 F-ACOS-DELETE-02. IF1014.2 +038400 PERFORM DE-LETE. IF1014.2 +038500 GO TO F-ACOS-WRITE-02. IF1014.2 +038600 F-ACOS-WRITE-02. IF1014.2 +038700 MOVE "F-ACOS-02" TO PAR-NAME. IF1014.2 +038800 PERFORM PRINT-DETAIL. IF1014.2 +038900*****************TEST (c) - SIMPLE TEST***************** IF1014.2 +039000 F-ACOS-03. IF1014.2 +039100 EVALUATE FUNCTION ACOS(0) IF1014.2 +039200 WHEN 1.57076 THRU 1.57082 IF1014.2 +039300 PERFORM PASS IF1014.2 +039400 WHEN OTHER IF1014.2 +039500 PERFORM FAIL. IF1014.2 +039600 GO TO F-ACOS-WRITE-03. IF1014.2 +039700 F-ACOS-DELETE-03. IF1014.2 +039800 PERFORM DE-LETE. IF1014.2 +039900 GO TO F-ACOS-WRITE-03. IF1014.2 +040000 F-ACOS-WRITE-03. IF1014.2 +040100 MOVE "F-ACOS-03" TO PAR-NAME. IF1014.2 +040200 PERFORM PRINT-DETAIL. IF1014.2 +040300*****************TEST (d) - SIMPLE TEST***************** IF1014.2 +040400 F-ACOS-04. IF1014.2 +040500 MOVE ZERO TO WS-NUM. IF1014.2 +040600 MOVE 3.14153 TO MIN-RANGE. IF1014.2 +040700 MOVE 3.14165 TO MAX-RANGE. IF1014.2 +040800 F-ACOS-TEST-04. IF1014.2 +040900 COMPUTE WS-NUM = FUNCTION ACOS(-1). IF1014.2 +041000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +041100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +041200 PERFORM PASS IF1014.2 +041300 ELSE IF1014.2 +041400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +041500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +041600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +041700 PERFORM FAIL. IF1014.2 +041800 GO TO F-ACOS-WRITE-04. IF1014.2 +041900 F-ACOS-DELETE-04. IF1014.2 +042000 PERFORM DE-LETE. IF1014.2 +042100 GO TO F-ACOS-WRITE-04. IF1014.2 +042200 F-ACOS-WRITE-04. IF1014.2 +042300 MOVE "F-ACOS-04" TO PAR-NAME. IF1014.2 +042400 PERFORM PRINT-DETAIL. IF1014.2 +042500*****************TEST (e) - SIMPLE TEST***************** IF1014.2 +042600 F-ACOS-05. IF1014.2 +042700 MOVE ZERO TO WS-NUM. IF1014.2 +042800 MOVE 0.044724 TO MIN-RANGE. IF1014.2 +042900 MOVE 0.044726 TO MAX-RANGE. IF1014.2 +043000 F-ACOS-TEST-05. IF1014.2 +043100 COMPUTE WS-NUM = FUNCTION ACOS(.999). IF1014.2 +043200 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +043300 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +043400 PERFORM PASS IF1014.2 +043500 ELSE IF1014.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1014.2 +043700 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +043800 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +043900 PERFORM FAIL. IF1014.2 +044000 GO TO F-ACOS-WRITE-05. IF1014.2 +044100 F-ACOS-DELETE-05. IF1014.2 +044200 PERFORM DE-LETE. IF1014.2 +044300 GO TO F-ACOS-WRITE-05. IF1014.2 +044400 F-ACOS-WRITE-05. IF1014.2 +044500 MOVE "F-ACOS-05" TO PAR-NAME. IF1014.2 +044600 PERFORM PRINT-DETAIL. IF1014.2 +044700*****************TEST (f) - SIMPLE TEST***************** IF1014.2 +044800 F-ACOS-06. IF1014.2 +044900 MOVE ZERO TO WS-NUM. IF1014.2 +045000 MOVE 1.05868 TO MIN-RANGE. IF1014.2 +045100 MOVE 1.05872 TO MAX-RANGE. IF1014.2 +045200 F-ACOS-TEST-06. IF1014.2 +045300 COMPUTE WS-NUM = FUNCTION ACOS(.49). IF1014.2 +045400 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +045500 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +045600 PERFORM PASS IF1014.2 +045700 ELSE IF1014.2 +045800 MOVE WS-NUM TO COMPUTED-N IF1014.2 +045900 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +046000 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +046100 PERFORM FAIL. IF1014.2 +046200 GO TO F-ACOS-WRITE-06. IF1014.2 +046300 F-ACOS-DELETE-06. IF1014.2 +046400 PERFORM DE-LETE. IF1014.2 +046500 GO TO F-ACOS-WRITE-06. IF1014.2 +046600 F-ACOS-WRITE-06. IF1014.2 +046700 MOVE "F-ACOS-06" TO PAR-NAME. IF1014.2 +046800 PERFORM PRINT-DETAIL. IF1014.2 +046900*****************TEST (g) - SIMPLE TEST***************** IF1014.2 +047000 F-ACOS-07. IF1014.2 +047100 MOVE ZERO TO WS-NUM. IF1014.2 +047200 MOVE 1.56976 TO MIN-RANGE. IF1014.2 +047300 MOVE 1.56982 TO MAX-RANGE. IF1014.2 +047400 F-ACOS-TEST-07. IF1014.2 +047500 COMPUTE WS-NUM = FUNCTION ACOS(.001). IF1014.2 +047600 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +047700 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +047800 PERFORM PASS IF1014.2 +047900 ELSE IF1014.2 +048000 MOVE WS-NUM TO COMPUTED-N IF1014.2 +048100 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +048200 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +048300 PERFORM FAIL. IF1014.2 +048400 GO TO F-ACOS-WRITE-07. IF1014.2 +048500 F-ACOS-DELETE-07. IF1014.2 +048600 PERFORM DE-LETE. IF1014.2 +048700 GO TO F-ACOS-WRITE-07. IF1014.2 +048800 F-ACOS-WRITE-07. IF1014.2 +048900 MOVE "F-ACOS-07" TO PAR-NAME. IF1014.2 +049000 PERFORM PRINT-DETAIL. IF1014.2 +049100*****************TEST (h) - SIMPLE TEST***************** IF1014.2 +049200 F-ACOS-08. IF1014.2 +049300 MOVE ZERO TO WS-NUM. IF1014.2 +049400 MOVE 3.09680 TO MIN-RANGE. IF1014.2 +049500 MOVE 3.09692 TO MAX-RANGE. IF1014.2 +049600 F-ACOS-TEST-08. IF1014.2 +049700 COMPUTE WS-NUM = FUNCTION ACOS(-.999). IF1014.2 +049800 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +049900 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +050000 PERFORM PASS IF1014.2 +050100 ELSE IF1014.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1014.2 +050300 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +050400 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +050500 PERFORM FAIL. IF1014.2 +050600 GO TO F-ACOS-WRITE-08. IF1014.2 +050700 F-ACOS-DELETE-08. IF1014.2 +050800 PERFORM DE-LETE. IF1014.2 +050900 GO TO F-ACOS-WRITE-08. IF1014.2 +051000 F-ACOS-WRITE-08. IF1014.2 +051100 MOVE "F-ACOS-08" TO PAR-NAME. IF1014.2 +051200 PERFORM PRINT-DETAIL. IF1014.2 +051300*****************TEST (i) - SIMPLE TEST***************** IF1014.2 +051400 F-ACOS-09. IF1014.2 +051500 MOVE ZERO TO WS-NUM. IF1014.2 +051600 MOVE 1.57080 TO MIN-RANGE. IF1014.2 +051700 MOVE 1.57086 TO MAX-RANGE. IF1014.2 +051800 F-ACOS-TEST-09. IF1014.2 +051900 COMPUTE WS-NUM = FUNCTION ACOS(A). IF1014.2 +052000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +052100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +052200 PERFORM PASS IF1014.2 +052300 ELSE IF1014.2 +052400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +052500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +052600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +052700 PERFORM FAIL. IF1014.2 +052800 GO TO F-ACOS-WRITE-09. IF1014.2 +052900 F-ACOS-DELETE-09. IF1014.2 +053000 PERFORM DE-LETE. IF1014.2 +053100 GO TO F-ACOS-WRITE-09. IF1014.2 +053200 F-ACOS-WRITE-09. IF1014.2 +053300 MOVE "F-ACOS-09" TO PAR-NAME. IF1014.2 +053400 PERFORM PRINT-DETAIL. IF1014.2 +053500*****************TEST (j) - SIMPLE TEST***************** IF1014.2 +053600 F-ACOS-10. IF1014.2 +053700 MOVE ZERO TO WS-NUM. IF1014.2 +053800 MOVE 1.57074 TO MIN-RANGE. IF1014.2 +053900 MOVE 1.57080 TO MAX-RANGE. IF1014.2 +054000 F-ACOS-TEST-10. IF1014.2 +054100 COMPUTE WS-NUM = FUNCTION ACOS(.00002). IF1014.2 +054200 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +054300 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +054400 PERFORM PASS IF1014.2 +054500 ELSE IF1014.2 +054600 MOVE WS-NUM TO COMPUTED-N IF1014.2 +054700 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +054800 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +054900 PERFORM FAIL. IF1014.2 +055000 GO TO F-ACOS-WRITE-10. IF1014.2 +055100 F-ACOS-DELETE-10. IF1014.2 +055200 PERFORM DE-LETE. IF1014.2 +055300 GO TO F-ACOS-WRITE-10. IF1014.2 +055400 F-ACOS-WRITE-10. IF1014.2 +055500 MOVE "F-ACOS-10" TO PAR-NAME. IF1014.2 +055600 PERFORM PRINT-DETAIL. IF1014.2 +055700*****************TEST (a) - COMPLEX TEST**************** IF1014.2 +055800 F-ACOS-11. IF1014.2 +055900 MOVE ZERO TO WS-NUM. IF1014.2 +056000 MOVE 0.785367 TO MIN-RANGE. IF1014.2 +056100 MOVE 0.785429 TO MAX-RANGE. IF1014.2 +056200 F-ACOS-TEST-11. IF1014.2 +056300 COMPUTE WS-NUM = FUNCTION ACOS(1 / SQRT2). IF1014.2 +056400 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +056500 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +056600 PERFORM PASS IF1014.2 +056700 ELSE IF1014.2 +056800 MOVE WS-NUM TO COMPUTED-N IF1014.2 +056900 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +057000 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +057100 PERFORM FAIL. IF1014.2 +057200 GO TO F-ACOS-WRITE-11. IF1014.2 +057300 F-ACOS-DELETE-11. IF1014.2 +057400 PERFORM DE-LETE. IF1014.2 +057500 GO TO F-ACOS-WRITE-11. IF1014.2 +057600 F-ACOS-WRITE-11. IF1014.2 +057700 MOVE "F-ACOS-11" TO PAR-NAME. IF1014.2 +057800 PERFORM PRINT-DETAIL. IF1014.2 +057900*****************TEST (b) - COMPLEX TEST**************** IF1014.2 +058000 F-ACOS-12. IF1014.2 +058100 MOVE ZERO TO WS-NUM. IF1014.2 +058200 MOVE 0.523577 TO MIN-RANGE. IF1014.2 +058300 MOVE 0.523619 TO MAX-RANGE. IF1014.2 +058400 F-ACOS-TEST-12. IF1014.2 +058500 COMPUTE WS-NUM = FUNCTION ACOS(SQRT3D2). IF1014.2 +058600 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +058700 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +058800 PERFORM PASS IF1014.2 +058900 ELSE IF1014.2 +059000 MOVE WS-NUM TO COMPUTED-N IF1014.2 +059100 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +059200 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +059300 PERFORM FAIL. IF1014.2 +059400 GO TO F-ACOS-WRITE-12. IF1014.2 +059500 F-ACOS-DELETE-12. IF1014.2 +059600 PERFORM DE-LETE. IF1014.2 +059700 GO TO F-ACOS-WRITE-12. IF1014.2 +059800 F-ACOS-WRITE-12. IF1014.2 +059900 MOVE "F-ACOS-12" TO PAR-NAME. IF1014.2 +060000 PERFORM PRINT-DETAIL. IF1014.2 +060100*****************TEST (c) - COMPLEX TEST**************** IF1014.2 +060200 F-ACOS-13. IF1014.2 +060300 MOVE ZERO TO WS-NUM. IF1014.2 +060400 MOVE 1.58073 TO MIN-RANGE. IF1014.2 +060500 MOVE 1.58085 TO MAX-RANGE. IF1014.2 +060600 F-ACOS-TEST-13. IF1014.2 +060700 COMPUTE WS-NUM = FUNCTION ACOS( 1 - 1.01). IF1014.2 +060800 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +060900 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +061000 PERFORM PASS IF1014.2 +061100 ELSE IF1014.2 +061200 MOVE WS-NUM TO COMPUTED-N IF1014.2 +061300 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +061400 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +061500 PERFORM FAIL. IF1014.2 +061600 GO TO F-ACOS-WRITE-13. IF1014.2 +061700 F-ACOS-DELETE-13. IF1014.2 +061800 PERFORM DE-LETE. IF1014.2 +061900 GO TO F-ACOS-WRITE-13. IF1014.2 +062000 F-ACOS-WRITE-13. IF1014.2 +062100 MOVE "F-ACOS-13" TO PAR-NAME. IF1014.2 +062200 PERFORM PRINT-DETAIL. IF1014.2 +062300*****************TEST (d) - COMPLEX TEST**************** IF1014.2 +062400 F-ACOS-14. IF1014.2 +062500 MOVE ZERO TO WS-NUM. IF1014.2 +062600 MOVE 0.141533 TO MIN-RANGE. IF1014.2 +062700 MOVE 0.141545 TO MAX-RANGE. IF1014.2 +062800 F-ACOS-TEST-14. IF1014.2 +062900 COMPUTE WS-NUM = FUNCTION ACOS(1.98 / 2). IF1014.2 +063000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +063100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +063200 PERFORM PASS IF1014.2 +063300 ELSE IF1014.2 +063400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +063500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +063600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +063700 PERFORM FAIL. IF1014.2 +063800 GO TO F-ACOS-WRITE-14. IF1014.2 +063900 F-ACOS-DELETE-14. IF1014.2 +064000 PERFORM DE-LETE. IF1014.2 +064100 GO TO F-ACOS-WRITE-14. IF1014.2 +064200 F-ACOS-WRITE-14. IF1014.2 +064300 MOVE "F-ACOS-14" TO PAR-NAME. IF1014.2 +064400 PERFORM PRINT-DETAIL. IF1014.2 +064500*****************TEST (e) - COMPLEX TEST**************** IF1014.2 +064600 F-ACOS-15. IF1014.2 +064700 MOVE ZERO TO WS-NUM. IF1014.2 +064800 MOVE 1.05866 TO MIN-RANGE. IF1014.2 +064900 MOVE 1.05874 TO MAX-RANGE. IF1014.2 +065000 F-ACOS-TEST-15. IF1014.2 +065100 COMPUTE WS-NUM = FUNCTION ACOS(0.2 + 0.29). IF1014.2 +065200 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +065300 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +065400 PERFORM PASS IF1014.2 +065500 ELSE IF1014.2 +065600 MOVE WS-NUM TO COMPUTED-N IF1014.2 +065700 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +065800 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +065900 PERFORM FAIL. IF1014.2 +066000 GO TO F-ACOS-WRITE-15. IF1014.2 +066100 F-ACOS-DELETE-15. IF1014.2 +066200 PERFORM DE-LETE. IF1014.2 +066300 GO TO F-ACOS-WRITE-15. IF1014.2 +066400 F-ACOS-WRITE-15. IF1014.2 +066500 MOVE "F-ACOS-15" TO PAR-NAME. IF1014.2 +066600 PERFORM PRINT-DETAIL. IF1014.2 +066700*****************TEST (f) - COMPLEX TEST**************** IF1014.2 +066800 F-ACOS-16. IF1014.2 +066900 MOVE ZERO TO WS-NUM. IF1014.2 +067000 MOVE 2.99993 TO MIN-RANGE. IF1014.2 +067100 MOVE 3.00017 TO MAX-RANGE. IF1014.2 +067200 F-ACOS-TEST-16. IF1014.2 +067300 COMPUTE WS-NUM = FUNCTION ACOS(0.99 * -1). IF1014.2 +067400 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +067500 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +067600 PERFORM PASS IF1014.2 +067700 ELSE IF1014.2 +067800 MOVE WS-NUM TO COMPUTED-N IF1014.2 +067900 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +068000 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +068100 PERFORM FAIL. IF1014.2 +068200 GO TO F-ACOS-WRITE-16. IF1014.2 +068300 F-ACOS-DELETE-16. IF1014.2 +068400 PERFORM DE-LETE. IF1014.2 +068500 GO TO F-ACOS-WRITE-16. IF1014.2 +068600 F-ACOS-WRITE-16. IF1014.2 +068700 MOVE "F-ACOS-16" TO PAR-NAME. IF1014.2 +068800 PERFORM PRINT-DETAIL. IF1014.2 +068900*****************TEST (g) - COMPLEX TEST**************** IF1014.2 +069000 F-ACOS-17. IF1014.2 +069100 MOVE ZERO TO WS-NUM. IF1014.2 +069200 MOVE -0.000040 TO MIN-RANGE. IF1014.2 +069300 MOVE 0.00004 TO MAX-RANGE. IF1014.2 +069400 F-ACOS-TEST-17. IF1014.2 +069500 COMPUTE WS-NUM = FUNCTION ACOS(IND (B) - 2). IF1014.2 +069600 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +069700 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +069800 PERFORM PASS IF1014.2 +069900 ELSE IF1014.2 +070000 MOVE WS-NUM TO COMPUTED-N IF1014.2 +070100 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +070200 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +070300 PERFORM FAIL. IF1014.2 +070400 GO TO F-ACOS-WRITE-17. IF1014.2 +070500 F-ACOS-DELETE-17. IF1014.2 +070600 PERFORM DE-LETE. IF1014.2 +070700 GO TO F-ACOS-WRITE-17. IF1014.2 +070800 F-ACOS-WRITE-17. IF1014.2 +070900 MOVE "F-ACOS-17" TO PAR-NAME. IF1014.2 +071000 PERFORM PRINT-DETAIL. IF1014.2 +071100*****************TEST (h) - COMPLEX TEST**************** IF1014.2 +071200 F-ACOS-18. IF1014.2 +071300 MOVE ZERO TO WS-NUM. IF1014.2 +071400 MOVE 0.679646 TO MIN-RANGE. IF1014.2 +071500 MOVE 0.679700 TO MAX-RANGE. IF1014.2 +071600 F-ACOS-TEST-18. IF1014.2 +071700 COMPUTE WS-NUM = FUNCTION ACOS(IND(5) / 9). IF1014.2 +071800 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +071900 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +072000 PERFORM PASS IF1014.2 +072100 ELSE IF1014.2 +072200 MOVE WS-NUM TO COMPUTED-N IF1014.2 +072300 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +072400 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +072500 PERFORM FAIL. IF1014.2 +072600 GO TO F-ACOS-WRITE-18. IF1014.2 +072700 F-ACOS-DELETE-18. IF1014.2 +072800 PERFORM DE-LETE. IF1014.2 +072900 GO TO F-ACOS-WRITE-18. IF1014.2 +073000 F-ACOS-WRITE-18. IF1014.2 +073100 MOVE "F-ACOS-18" TO PAR-NAME. IF1014.2 +073200 PERFORM PRINT-DETAIL. IF1014.2 +073300*****************TEST (i) - COMPLEX TEST**************** IF1014.2 +073400 F-ACOS-19. IF1014.2 +073500 MOVE ZERO TO WS-NUM. IF1014.2 +073600 MOVE 0.000000 TO MIN-RANGE. IF1014.2 +073700 MOVE 0.000040 TO MAX-RANGE. IF1014.2 +073800 F-ACOS-TEST-19. IF1014.2 +073900 COMPUTE WS-NUM = FUNCTION ACOS(4 - 3). IF1014.2 +074000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +074100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +074200 PERFORM PASS IF1014.2 +074300 ELSE IF1014.2 +074400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +074500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +074600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +074700 PERFORM FAIL. IF1014.2 +074800 GO TO F-ACOS-WRITE-19. IF1014.2 +074900 F-ACOS-DELETE-19. IF1014.2 +075000 PERFORM DE-LETE. IF1014.2 +075100 GO TO F-ACOS-WRITE-19. IF1014.2 +075200 F-ACOS-WRITE-19. IF1014.2 +075300 MOVE "F-ACOS-19" TO PAR-NAME. IF1014.2 +075400 PERFORM PRINT-DETAIL. IF1014.2 +075500*****************TEST (j) - COMPLEX TEST**************** IF1014.2 +075600 F-ACOS-20. IF1014.2 +075700 MOVE ZERO TO WS-NUM. IF1014.2 +075800 MOVE 0.000000 TO MIN-RANGE. IF1014.2 +075900 MOVE 0.000004 TO MAX-RANGE. IF1014.2 +076000 F-ACOS-TEST-20. IF1014.2 +076100 COMPUTE WS-NUM = FUNCTION ACOS(C / C). IF1014.2 +076200 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +076300 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +076400 PERFORM PASS IF1014.2 +076500 ELSE IF1014.2 +076600 MOVE WS-NUM TO COMPUTED-N IF1014.2 +076700 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +076800 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +076900 PERFORM FAIL. IF1014.2 +077000 GO TO F-ACOS-WRITE-20. IF1014.2 +077100 F-ACOS-DELETE-20. IF1014.2 +077200 PERFORM DE-LETE. IF1014.2 +077300 GO TO F-ACOS-WRITE-20. IF1014.2 +077400 F-ACOS-WRITE-20. IF1014.2 +077500 MOVE "F-ACOS-20" TO PAR-NAME. IF1014.2 +077600 PERFORM PRINT-DETAIL. IF1014.2 +077700*****************TEST (k) - COMPLEX TEST**************** IF1014.2 +077800 F-ACOS-21. IF1014.2 +077900 MOVE ZERO TO WS-NUM. IF1014.2 +078000 MOVE 1.31806 TO MIN-RANGE. IF1014.2 +078100 MOVE 1.31816 TO MAX-RANGE. IF1014.2 +078200 F-ACOS-TEST-21. IF1014.2 +078300 COMPUTE WS-NUM = FUNCTION ACOS(0.25 * 1). IF1014.2 +078400 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +078500 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +078600 PERFORM PASS IF1014.2 +078700 ELSE IF1014.2 +078800 MOVE WS-NUM TO COMPUTED-N IF1014.2 +078900 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +079000 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +079100 PERFORM FAIL. IF1014.2 +079200 GO TO F-ACOS-WRITE-21. IF1014.2 +079300 F-ACOS-DELETE-21. IF1014.2 +079400 PERFORM DE-LETE. IF1014.2 +079500 GO TO F-ACOS-WRITE-21. IF1014.2 +079600 F-ACOS-WRITE-21. IF1014.2 +079700 MOVE "F-ACOS-21" TO PAR-NAME. IF1014.2 +079800 PERFORM PRINT-DETAIL. IF1014.2 +079900*****************TEST (l) - COMPLEX TEST**************** IF1014.2 +080000 F-ACOS-22. IF1014.2 +080100 MOVE ZERO TO WS-NUM. IF1014.2 +080200 MOVE 1.57073 TO MIN-RANGE. IF1014.2 +080300 MOVE 1.57085 TO MAX-RANGE. IF1014.2 +080400 F-ACOS-TEST-22. IF1014.2 +080500 COMPUTE WS-NUM = FUNCTION ACOS((D / D) - 1). IF1014.2 +080600 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +080700 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +080800 PERFORM PASS IF1014.2 +080900 ELSE IF1014.2 +081000 MOVE WS-NUM TO COMPUTED-N IF1014.2 +081100 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +081200 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +081300 PERFORM FAIL. IF1014.2 +081400 GO TO F-ACOS-WRITE-22. IF1014.2 +081500 F-ACOS-DELETE-22. IF1014.2 +081600 PERFORM DE-LETE. IF1014.2 +081700 GO TO F-ACOS-WRITE-22. IF1014.2 +081800 F-ACOS-WRITE-22. IF1014.2 +081900 MOVE "F-ACOS-22" TO PAR-NAME. IF1014.2 +082000 PERFORM PRINT-DETAIL. IF1014.2 +082100*****************TEST (m) - COMPLEX TEST**************** IF1014.2 +082200 F-ACOS-23. IF1014.2 +082300 MOVE ZERO TO WS-NUM. IF1014.2 +082400 MOVE 2.60285 TO MIN-RANGE. IF1014.2 +082500 MOVE 2.60305 TO MAX-RANGE. IF1014.2 +082600 F-ACOS-TEST-23. IF1014.2 +082700 COMPUTE WS-NUM = FUNCTION ACOS(PI - 4). IF1014.2 +082800 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +082900 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +083000 PERFORM PASS IF1014.2 +083100 ELSE IF1014.2 +083200 MOVE WS-NUM TO COMPUTED-N IF1014.2 +083300 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +083400 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +083500 PERFORM FAIL. IF1014.2 +083600 GO TO F-ACOS-WRITE-23. IF1014.2 +083700 F-ACOS-DELETE-23. IF1014.2 +083800 PERFORM DE-LETE. IF1014.2 +083900 GO TO F-ACOS-WRITE-23. IF1014.2 +084000 F-ACOS-WRITE-23. IF1014.2 +084100 MOVE "F-ACOS-23" TO PAR-NAME. IF1014.2 +084200 PERFORM PRINT-DETAIL. IF1014.2 +084300*****************TEST (n) - COMPLEX TEST**************** IF1014.2 +084400 F-ACOS-24. IF1014.2 +084500 MOVE ZERO TO WS-NUM. IF1014.2 +084600 MOVE 1.57073 TO MIN-RANGE. IF1014.2 +084700 MOVE 1.57085 TO MAX-RANGE. IF1014.2 +084800 F-ACOS-TEST-24. IF1014.2 +084900 COMPUTE WS-NUM = FUNCTION ACOS(FUNCTION ACOS(D / D)). IF1014.2 +085000 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +085100 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +085200 PERFORM PASS IF1014.2 +085300 ELSE IF1014.2 +085400 MOVE WS-NUM TO COMPUTED-N IF1014.2 +085500 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +085600 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +085700 PERFORM FAIL. IF1014.2 +085800 GO TO F-ACOS-WRITE-24. IF1014.2 +085900 F-ACOS-DELETE-24. IF1014.2 +086000 PERFORM DE-LETE. IF1014.2 +086100 GO TO F-ACOS-WRITE-24. IF1014.2 +086200 F-ACOS-WRITE-24. IF1014.2 +086300 MOVE "F-ACOS-24" TO PAR-NAME. IF1014.2 +086400 PERFORM PRINT-DETAIL. IF1014.2 +086500*****************TEST (o) - COMPLEX TEST**************** IF1014.2 +086600 F-ACOS-25. IF1014.2 +086700 MOVE ZERO TO WS-NUM. IF1014.2 +086800 MOVE 0.000000 TO MIN-RANGE. IF1014.2 +086900 MOVE 0.000040 TO MAX-RANGE. IF1014.2 +087000 F-ACOS-TEST-25. IF1014.2 +087100 COMPUTE WS-NUM = FUNCTION ACOS(D / D) + FUNCTION ACOS(D / D).IF1014.2 +087200 IF1014.2 +087300 IF (WS-NUM >= MIN-RANGE) AND IF1014.2 +087400 (WS-NUM <= MAX-RANGE) THEN IF1014.2 +087500 PERFORM PASS IF1014.2 +087600 ELSE IF1014.2 +087700 MOVE WS-NUM TO COMPUTED-N IF1014.2 +087800 MOVE MIN-RANGE TO CORRECT-MIN IF1014.2 +087900 MOVE MAX-RANGE TO CORRECT-MAX IF1014.2 +088000 PERFORM FAIL. IF1014.2 +088100 GO TO F-ACOS-WRITE-25. IF1014.2 +088200 F-ACOS-DELETE-25. IF1014.2 +088300 PERFORM DE-LETE. IF1014.2 +088400 GO TO F-ACOS-WRITE-25. IF1014.2 +088500 F-ACOS-WRITE-25. IF1014.2 +088600 MOVE "F-ACOS-25" TO PAR-NAME. IF1014.2 +088700 PERFORM PRINT-DETAIL. IF1014.2 +088800*****************SPECIAL PERFORM TEST********************** IF1014.2 +088900 F-ACOS-26. IF1014.2 +089000 MOVE ZERO TO ARG1. IF1014.2 +089100 PERFORM F-ACOS-TEST-26 IF1014.2 +089200 UNTIL FUNCTION ACOS(ARG1) < 1. IF1014.2 +089300 PERFORM PASS. IF1014.2 +089400 GO TO F-ACOS-WRITE-26. IF1014.2 +089500 F-ACOS-TEST-26. IF1014.2 +089600 COMPUTE ARG1 = ARG1 + 0.25. IF1014.2 +089700 F-ACOS-DELETE-26. IF1014.2 +089800 PERFORM DE-LETE. IF1014.2 +089900 GO TO F-ACOS-WRITE-26. IF1014.2 +090000 F-ACOS-WRITE-26. IF1014.2 +090100 MOVE "F-ACOS-26" TO PAR-NAME. IF1014.2 +090200 PERFORM PRINT-DETAIL. IF1014.2 +090300********************END OF TESTS*************** IF1014.2 +090400 CCVS-EXIT SECTION. IF1014.2 +090500 CCVS-999999. IF1014.2 +090600 GO TO CLOSE-FILES. IF1014.2 diff --git a/tests/cobol85/IF/IF102A.CBL b/tests/cobol85/IF/IF102A.CBL new file mode 100755 index 00000000..a33cd08f --- /dev/null +++ b/tests/cobol85/IF/IF102A.CBL @@ -0,0 +1,617 @@ +000100 IDENTIFICATION DIVISION. IF1024.2 +000200 PROGRAM-ID. IF1024.2 +000300 IF102A. IF1024.2 +000400 IF1024.2 +000500*********************************************************** IF1024.2 +000600* * IF1024.2 +000700* This program is intended to form part of the CCVS85 * IF1024.2 +000800* COBOL Test Suite. It contains tests for the * IF1024.2 +000900* Intrinsic Function ANNUITY. * IF1024.2 +001000* * IF1024.2 +001100*********************************************************** IF1024.2 +001200 ENVIRONMENT DIVISION. IF1024.2 +001300 CONFIGURATION SECTION. IF1024.2 +001400 SOURCE-COMPUTER. IF1024.2 +001500 Linux. IF1024.2 +001600 OBJECT-COMPUTER. IF1024.2 +001700 Linux. IF1024.2 +001800 INPUT-OUTPUT SECTION. IF1024.2 +001900 FILE-CONTROL. IF1024.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1024.2 +002100 "report.log". IF1024.2 +002200 DATA DIVISION. IF1024.2 +002300 FILE SECTION. IF1024.2 +002400 FD PRINT-FILE. IF1024.2 +002500 01 PRINT-REC PICTURE X(120). IF1024.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1024.2 +002700 WORKING-STORAGE SECTION. IF1024.2 +002800*********************************************************** IF1024.2 +002900* Variables specific to the Intrinsic Function Test IF102A* IF1024.2 +003000*********************************************************** IF1024.2 +003100 01 A PIC S9(10) VALUE 4. IF1024.2 +003200 01 B PIC S9(5)V9(5) VALUE .25. IF1024.2 +003300 01 C PIC S9(10) VALUE 10. IF1024.2 +003400 01 D PIC S9(10) VALUE 100. IF1024.2 +003500 01 ARG2 PIC S9(10) VALUE 1. IF1024.2 +003600 01 ARR VALUE "40537". IF1024.2 +003700 02 IND OCCURS 5 TIMES PIC 9. IF1024.2 +003800 01 TEMP PIC S9(5)V9(5). IF1024.2 +003900 01 WS-NUM PIC S9(5)V9(6). IF1024.2 +004000 01 MIN-RANGE PIC S9(5)V9(7). IF1024.2 +004100 01 MAX-RANGE PIC S9(5)V9(7). IF1024.2 +004200* IF1024.2 +004300********************************************************** IF1024.2 +004400* IF1024.2 +004500 01 TEST-RESULTS. IF1024.2 +004600 02 FILLER PIC X VALUE SPACE. IF1024.2 +004700 02 FEATURE PIC X(20) VALUE SPACE. IF1024.2 +004800 02 FILLER PIC X VALUE SPACE. IF1024.2 +004900 02 P-OR-F PIC X(5) VALUE SPACE. IF1024.2 +005000 02 FILLER PIC X VALUE SPACE. IF1024.2 +005100 02 PAR-NAME. IF1024.2 +005200 03 FILLER PIC X(19) VALUE SPACE. IF1024.2 +005300 03 PARDOT-X PIC X VALUE SPACE. IF1024.2 +005400 03 DOTVALUE PIC 99 VALUE ZERO. IF1024.2 +005500 02 FILLER PIC X(8) VALUE SPACE. IF1024.2 +005600 02 RE-MARK PIC X(61). IF1024.2 +005700 01 TEST-COMPUTED. IF1024.2 +005800 02 FILLER PIC X(30) VALUE SPACE. IF1024.2 +005900 02 FILLER PIC X(17) VALUE IF1024.2 +006000 " COMPUTED=". IF1024.2 +006100 02 COMPUTED-X. IF1024.2 +006200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1024.2 +006300 03 COMPUTED-N REDEFINES COMPUTED-A IF1024.2 +006400 PIC -9(9).9(9). IF1024.2 +006500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1024.2 +006600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1024.2 +006700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1024.2 +006800 03 CM-18V0 REDEFINES COMPUTED-A. IF1024.2 +006900 04 COMPUTED-18V0 PIC -9(18). IF1024.2 +007000 04 FILLER PIC X. IF1024.2 +007100 03 FILLER PIC X(50) VALUE SPACE. IF1024.2 +007200 01 TEST-CORRECT. IF1024.2 +007300 02 FILLER PIC X(30) VALUE SPACE. IF1024.2 +007400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1024.2 +007500 02 CORRECT-X. IF1024.2 +007600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1024.2 +007700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1024.2 +007800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1024.2 +007900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1024.2 +008000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1024.2 +008100 03 CR-18V0 REDEFINES CORRECT-A. IF1024.2 +008200 04 CORRECT-18V0 PIC -9(18). IF1024.2 +008300 04 FILLER PIC X. IF1024.2 +008400 03 FILLER PIC X(2) VALUE SPACE. IF1024.2 +008500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1024.2 +008600 01 TEST-CORRECT-MIN. IF1024.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IF1024.2 +008800 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1024.2 +008900 02 CORRECTMI-X. IF1024.2 +009000 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1024.2 +009100 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1024.2 +009200 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1024.2 +009300 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1024.2 +009400 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1024.2 +009500 03 CR-18V0 REDEFINES CORRECTMI-A. IF1024.2 +009600 04 CORRECTMI-18V0 PIC -9(18). IF1024.2 +009700 04 FILLER PIC X. IF1024.2 +009800 03 FILLER PIC X(2) VALUE SPACE. IF1024.2 +009900 03 FILLER PIC X(48) VALUE SPACE. IF1024.2 +010000 01 TEST-CORRECT-MAX. IF1024.2 +010100 02 FILLER PIC X(30) VALUE SPACE. IF1024.2 +010200 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1024.2 +010300 02 CORRECTMA-X. IF1024.2 +010400 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1024.2 +010500 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1024.2 +010600 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1024.2 +010700 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1024.2 +010800 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1024.2 +010900 03 CR-18V0 REDEFINES CORRECTMA-A. IF1024.2 +011000 04 CORRECTMA-18V0 PIC -9(18). IF1024.2 +011100 04 FILLER PIC X. IF1024.2 +011200 03 FILLER PIC X(2) VALUE SPACE. IF1024.2 +011300 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1024.2 +011400 01 CCVS-C-1. IF1024.2 +011500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1024.2 +011600- "SS PARAGRAPH-NAME IF1024.2 +011700- " REMARKS". IF1024.2 +011800 02 FILLER PIC X(20) VALUE SPACE. IF1024.2 +011900 01 CCVS-C-2. IF1024.2 +012000 02 FILLER PIC X VALUE SPACE. IF1024.2 +012100 02 FILLER PIC X(6) VALUE "TESTED". IF1024.2 +012200 02 FILLER PIC X(15) VALUE SPACE. IF1024.2 +012300 02 FILLER PIC X(4) VALUE "FAIL". IF1024.2 +012400 02 FILLER PIC X(94) VALUE SPACE. IF1024.2 +012500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1024.2 +012600 01 REC-CT PIC 99 VALUE ZERO. IF1024.2 +012700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1024.2 +012800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1024.2 +012900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1024.2 +013000 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1024.2 +013100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1024.2 +013200 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1024.2 +013300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1024.2 +013400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1024.2 +013500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1024.2 +013600 01 CCVS-H-1. IF1024.2 +013700 02 FILLER PIC X(39) VALUE SPACES. IF1024.2 +013800 02 FILLER PIC X(42) VALUE IF1024.2 +013900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1024.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1024.2 +014100 01 CCVS-H-2A. IF1024.2 +014200 02 FILLER PIC X(40) VALUE SPACE. IF1024.2 +014300 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1024.2 +014400 02 FILLER PIC XXXX VALUE IF1024.2 +014500 "4.2 ". IF1024.2 +014600 02 FILLER PIC X(28) VALUE IF1024.2 +014700 " COPY - NOT FOR DISTRIBUTION". IF1024.2 +014800 02 FILLER PIC X(41) VALUE SPACE. IF1024.2 +014900 IF1024.2 +015000 01 CCVS-H-2B. IF1024.2 +015100 02 FILLER PIC X(15) VALUE IF1024.2 +015200 "TEST RESULT OF ". IF1024.2 +015300 02 TEST-ID PIC X(9). IF1024.2 +015400 02 FILLER PIC X(4) VALUE IF1024.2 +015500 " IN ". IF1024.2 +015600 02 FILLER PIC X(12) VALUE IF1024.2 +015700 " HIGH ". IF1024.2 +015800 02 FILLER PIC X(22) VALUE IF1024.2 +015900 " LEVEL VALIDATION FOR ". IF1024.2 +016000 02 FILLER PIC X(58) VALUE IF1024.2 +016100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1024.2 +016200 01 CCVS-H-3. IF1024.2 +016300 02 FILLER PIC X(34) VALUE IF1024.2 +016400 " FOR OFFICIAL USE ONLY ". IF1024.2 +016500 02 FILLER PIC X(58) VALUE IF1024.2 +016600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1024.2 +016700 02 FILLER PIC X(28) VALUE IF1024.2 +016800 " COPYRIGHT 1985 ". IF1024.2 +016900 01 CCVS-E-1. IF1024.2 +017000 02 FILLER PIC X(52) VALUE SPACE. IF1024.2 +017100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1024.2 +017200 02 ID-AGAIN PIC X(9). IF1024.2 +017300 02 FILLER PIC X(45) VALUE SPACES. IF1024.2 +017400 01 CCVS-E-2. IF1024.2 +017500 02 FILLER PIC X(31) VALUE SPACE. IF1024.2 +017600 02 FILLER PIC X(21) VALUE SPACE. IF1024.2 +017700 02 CCVS-E-2-2. IF1024.2 +017800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1024.2 +017900 03 FILLER PIC X VALUE SPACE. IF1024.2 +018000 03 ENDER-DESC PIC X(44) VALUE IF1024.2 +018100 "ERRORS ENCOUNTERED". IF1024.2 +018200 01 CCVS-E-3. IF1024.2 +018300 02 FILLER PIC X(22) VALUE IF1024.2 +018400 " FOR OFFICIAL USE ONLY". IF1024.2 +018500 02 FILLER PIC X(12) VALUE SPACE. IF1024.2 +018600 02 FILLER PIC X(58) VALUE IF1024.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1024.2 +018800 02 FILLER PIC X(13) VALUE SPACE. IF1024.2 +018900 02 FILLER PIC X(15) VALUE IF1024.2 +019000 " COPYRIGHT 1985". IF1024.2 +019100 01 CCVS-E-4. IF1024.2 +019200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1024.2 +019300 02 FILLER PIC X(4) VALUE " OF ". IF1024.2 +019400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1024.2 +019500 02 FILLER PIC X(40) VALUE IF1024.2 +019600 " TESTS WERE EXECUTED SUCCESSFULLY". IF1024.2 +019700 01 XXINFO. IF1024.2 +019800 02 FILLER PIC X(19) VALUE IF1024.2 +019900 "*** INFORMATION ***". IF1024.2 +020000 02 INFO-TEXT. IF1024.2 +020100 04 FILLER PIC X(8) VALUE SPACE. IF1024.2 +020200 04 XXCOMPUTED PIC X(20). IF1024.2 +020300 04 FILLER PIC X(5) VALUE SPACE. IF1024.2 +020400 04 XXCORRECT PIC X(20). IF1024.2 +020500 02 INF-ANSI-REFERENCE PIC X(48). IF1024.2 +020600 01 HYPHEN-LINE. IF1024.2 +020700 02 FILLER PIC IS X VALUE IS SPACE. IF1024.2 +020800 02 FILLER PIC IS X(65) VALUE IS "************************IF1024.2 +020900- "*****************************************". IF1024.2 +021000 02 FILLER PIC IS X(54) VALUE IS "************************IF1024.2 +021100- "******************************". IF1024.2 +021200 01 CCVS-PGM-ID PIC X(9) VALUE IF1024.2 +021300 "IF102A". IF1024.2 +021400 PROCEDURE DIVISION. IF1024.2 +021500 CCVS1 SECTION. IF1024.2 +021600 OPEN-FILES. IF1024.2 +021700 OPEN OUTPUT PRINT-FILE. IF1024.2 +021800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1024.2 +021900 MOVE SPACE TO TEST-RESULTS. IF1024.2 +022000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1024.2 +022100 GO TO CCVS1-EXIT. IF1024.2 +022200 CLOSE-FILES. IF1024.2 +022300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1024.2 +022400 TERMINATE-CCVS. IF1024.2 +022500 STOP RUN. IF1024.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1024.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1024.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1024.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1024.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. IF1024.2 +023100 PRINT-DETAIL. IF1024.2 +023200 IF REC-CT NOT EQUAL TO ZERO IF1024.2 +023300 MOVE "." TO PARDOT-X IF1024.2 +023400 MOVE REC-CT TO DOTVALUE. IF1024.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1024.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1024.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1024.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1024.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1024.2 +024000 MOVE SPACE TO CORRECT-X. IF1024.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1024.2 +024200 MOVE SPACE TO RE-MARK. IF1024.2 +024300 HEAD-ROUTINE. IF1024.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1024.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1024.2 +024800 COLUMN-NAMES-ROUTINE. IF1024.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +025200 END-ROUTINE. IF1024.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1024.2 +025400 END-RTN-EXIT. IF1024.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +025600 END-ROUTINE-1. IF1024.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1024.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1024.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. IF1024.2 +026000 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1024.2 +026100 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1024.2 +026200 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1024.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1024.2 +026400 END-ROUTINE-12. IF1024.2 +026500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1024.2 +026600 IF ERROR-COUNTER IS EQUAL TO ZERO IF1024.2 +026700 MOVE "NO " TO ERROR-TOTAL IF1024.2 +026800 ELSE IF1024.2 +026900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1024.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1024.2 +027100 PERFORM WRITE-LINE. IF1024.2 +027200 END-ROUTINE-13. IF1024.2 +027300 IF DELETE-COUNTER IS EQUAL TO ZERO IF1024.2 +027400 MOVE "NO " TO ERROR-TOTAL ELSE IF1024.2 +027500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1024.2 +027600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1024.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +027800 IF INSPECT-COUNTER EQUAL TO ZERO IF1024.2 +027900 MOVE "NO " TO ERROR-TOTAL IF1024.2 +028000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1024.2 +028100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1024.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +028300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1024.2 +028400 WRITE-LINE. IF1024.2 +028500 ADD 1 TO RECORD-COUNT. IF1024.2 +028600 IF RECORD-COUNT GREATER 42 IF1024.2 +028700 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1024.2 +028800 MOVE SPACE TO DUMMY-RECORD IF1024.2 +028900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1024.2 +029000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1024.2 +029100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1024.2 +029200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1024.2 +029300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1024.2 +029400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1024.2 +029500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1024.2 +029600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1024.2 +029700 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1024.2 +029800 MOVE ZERO TO RECORD-COUNT. IF1024.2 +029900 PERFORM WRT-LN. IF1024.2 +030000 WRT-LN. IF1024.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1024.2 +030200 MOVE SPACE TO DUMMY-RECORD. IF1024.2 +030300 BLANK-LINE-PRINT. IF1024.2 +030400 PERFORM WRT-LN. IF1024.2 +030500 FAIL-ROUTINE. IF1024.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE IF1024.2 +030700 GO TO FAIL-ROUTINE-WRITE. IF1024.2 +030800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1024.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1024.2 +031000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1024.2 +031100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +031200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1024.2 +031300 GO TO FAIL-ROUTINE-EX. IF1024.2 +031400 FAIL-ROUTINE-WRITE. IF1024.2 +031500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1024.2 +031600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1024.2 +031700 CORMA-ANSI-REFERENCE. IF1024.2 +031800 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1024.2 +031900 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1024.2 +032000 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1024.2 +032100 ELSE IF1024.2 +032200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1024.2 +032300 PERFORM WRITE-LINE. IF1024.2 +032400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1024.2 +032500 FAIL-ROUTINE-EX. EXIT. IF1024.2 +032600 BAIL-OUT. IF1024.2 +032700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1024.2 +032800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1024.2 +032900 BAIL-OUT-WRITE. IF1024.2 +033000 MOVE CORRECT-A TO XXCORRECT. IF1024.2 +033100 MOVE COMPUTED-A TO XXCOMPUTED. IF1024.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1024.2 +033300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1024.2 +033400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1024.2 +033500 BAIL-OUT-EX. EXIT. IF1024.2 +033600 CCVS1-EXIT. IF1024.2 +033700 EXIT. IF1024.2 +033800******************************************************** IF1024.2 +033900* * IF1024.2 +034000* Intrinsic Function Tests IF102A - ANNUITY * IF1024.2 +034100* * IF1024.2 +034200******************************************************** IF1024.2 +034300 SECT-IF102A SECTION. IF1024.2 +034400 F-ANNUITY-INFO. IF1024.2 +034500 MOVE "See ref. A-34 2.6" TO ANSI-REFERENCE. IF1024.2 +034600 MOVE "ANNUITY Function" TO FEATURE. IF1024.2 +034700*****************TEST (a) - SIMPLE TEST***************** IF1024.2 +034800 F-ANNUITY-01. IF1024.2 +034900 MOVE ZERO TO WS-NUM. IF1024.2 +035000 MOVE 0.249995 TO MIN-RANGE. IF1024.2 +035100 MOVE 0.250005 TO MAX-RANGE. IF1024.2 +035200 F-ANNUITY-TEST-01. IF1024.2 +035300 COMPUTE WS-NUM = FUNCTION ANNUITY(0, 4). IF1024.2 +035400 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +035500 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +035600 PERFORM PASS IF1024.2 +035700 ELSE IF1024.2 +035800 MOVE WS-NUM TO COMPUTED-N IF1024.2 +035900 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +036000 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +036100 PERFORM FAIL. IF1024.2 +036200 GO TO F-ANNUITY-WRITE-01. IF1024.2 +036300 F-ANNUITY-DELETE-01. IF1024.2 +036400 PERFORM DE-LETE. IF1024.2 +036500 GO TO F-ANNUITY-WRITE-01. IF1024.2 +036600 F-ANNUITY-WRITE-01. IF1024.2 +036700 MOVE "F-ANNUITY-01" TO PAR-NAME. IF1024.2 +036800 PERFORM PRINT-DETAIL. IF1024.2 +036900*****************TEST (b) - SIMPLE TEST***************** IF1024.2 +037000 F-ANNUITY-02. IF1024.2 +037100 EVALUATE FUNCTION ANNUITY(2.9, 4) IF1024.2 +037200 WHEN 2.91252 THRU 2.91264 IF1024.2 +037300 PERFORM PASS IF1024.2 +037400 WHEN OTHER IF1024.2 +037500 PERFORM FAIL. IF1024.2 +037600 GO TO F-ANNUITY-WRITE-02. IF1024.2 +037700 F-ANNUITY-DELETE-02. IF1024.2 +037800 PERFORM DE-LETE. IF1024.2 +037900 GO TO F-ANNUITY-WRITE-02. IF1024.2 +038000 F-ANNUITY-WRITE-02. IF1024.2 +038100 MOVE "F-ANNUITY-02" TO PAR-NAME. IF1024.2 +038200 PERFORM PRINT-DETAIL. IF1024.2 +038300*****************TEST (c) - SIMPLE TEST***************** IF1024.2 +038400 F-ANNUITY-03. IF1024.2 +038500 MOVE 0.308663 TO MIN-RANGE. IF1024.2 +038600 MOVE 0.308675 TO MAX-RANGE. IF1024.2 +038700 F-ANNUITY-TEST-03. IF1024.2 +038800 IF (FUNCTION ANNUITY(.09, A) >= MIN-RANGE) AND IF1024.2 +038900 (FUNCTION ANNUITY(.09, A) <= MAX-RANGE) THEN IF1024.2 +039000 PERFORM PASS IF1024.2 +039100 ELSE IF1024.2 +039200 PERFORM FAIL. IF1024.2 +039300 GO TO F-ANNUITY-WRITE-03. IF1024.2 +039400 F-ANNUITY-DELETE-03. IF1024.2 +039500 PERFORM DE-LETE. IF1024.2 +039600 GO TO F-ANNUITY-WRITE-03. IF1024.2 +039700 F-ANNUITY-WRITE-03. IF1024.2 +039800 MOVE "F-ANNUITY-03" TO PAR-NAME. IF1024.2 +039900 PERFORM PRINT-DETAIL. IF1024.2 +040000*****************TEST (d) - SIMPLE TEST***************** IF1024.2 +040100 F-ANNUITY-04. IF1024.2 +040200 MOVE ZERO TO WS-NUM. IF1024.2 +040300 MOVE 0.694430 TO MIN-RANGE. IF1024.2 +040400 MOVE 0.694458 TO MAX-RANGE. IF1024.2 +040500 F-ANNUITY-TEST-04. IF1024.2 +040600 COMPUTE WS-NUM = FUNCTION ANNUITY(B, 2). IF1024.2 +040700 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +040800 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +040900 PERFORM PASS IF1024.2 +041000 ELSE IF1024.2 +041100 MOVE WS-NUM TO COMPUTED-N IF1024.2 +041200 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +041300 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +041400 PERFORM FAIL. IF1024.2 +041500 GO TO F-ANNUITY-WRITE-04. IF1024.2 +041600 F-ANNUITY-DELETE-04. IF1024.2 +041700 PERFORM DE-LETE. IF1024.2 +041800 GO TO F-ANNUITY-WRITE-04. IF1024.2 +041900 F-ANNUITY-WRITE-04. IF1024.2 +042000 MOVE "F-ANNUITY-04" TO PAR-NAME. IF1024.2 +042100 PERFORM PRINT-DETAIL. IF1024.2 +042200*****************TEST (e) - SIMPLE TEST***************** IF1024.2 +042300 F-ANNUITY-05. IF1024.2 +042400 MOVE ZERO TO WS-NUM. IF1024.2 +042500 MOVE 0.423434 TO MIN-RANGE. IF1024.2 +042600 MOVE 0.423450 TO MAX-RANGE. IF1024.2 +042700 F-ANNUITY-TEST-05. IF1024.2 +042800 COMPUTE WS-NUM = FUNCTION ANNUITY(B, 4). IF1024.2 +042900 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +043000 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +043100 PERFORM PASS IF1024.2 +043200 ELSE IF1024.2 +043300 MOVE WS-NUM TO COMPUTED-N IF1024.2 +043400 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +043500 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +043600 PERFORM FAIL. IF1024.2 +043700 GO TO F-ANNUITY-WRITE-05. IF1024.2 +043800 F-ANNUITY-DELETE-05. IF1024.2 +043900 PERFORM DE-LETE. IF1024.2 +044000 GO TO F-ANNUITY-WRITE-05. IF1024.2 +044100 F-ANNUITY-WRITE-05. IF1024.2 +044200 MOVE "F-ANNUITY-05" TO PAR-NAME. IF1024.2 +044300 PERFORM PRINT-DETAIL. IF1024.2 +044400*****************TEST (f) - SIMPLE TEST***************** IF1024.2 +044500 F-ANNUITY-06. IF1024.2 +044600 MOVE ZERO TO WS-NUM. IF1024.2 +044700 MOVE 3.99992 TO MIN-RANGE. IF1024.2 +044800 MOVE 4.00008 TO MAX-RANGE. IF1024.2 +044900 F-ANNUITY-TEST-06. IF1024.2 +045000 COMPUTE WS-NUM = FUNCTION ANNUITY(A, 9). IF1024.2 +045100 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +045200 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +045300 PERFORM PASS IF1024.2 +045400 ELSE IF1024.2 +045500 MOVE WS-NUM TO COMPUTED-N IF1024.2 +045600 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +045700 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +045800 PERFORM FAIL. IF1024.2 +045900 GO TO F-ANNUITY-WRITE-06. IF1024.2 +046000 F-ANNUITY-DELETE-06. IF1024.2 +046100 PERFORM DE-LETE. IF1024.2 +046200 GO TO F-ANNUITY-WRITE-06. IF1024.2 +046300 F-ANNUITY-WRITE-06. IF1024.2 +046400 MOVE "F-ANNUITY-06" TO PAR-NAME. IF1024.2 +046500 PERFORM PRINT-DETAIL. IF1024.2 +046600*****************TEST (g) -SIMPLE TEST****************** IF1024.2 +046700 F-ANNUITY-07. IF1024.2 +046800 MOVE ZERO TO WS-NUM. IF1024.2 +046900 MOVE 5.00054 TO MIN-RANGE. IF1024.2 +047000 MOVE 5.00074 TO MAX-RANGE. IF1024.2 +047100 F-ANNUITY-TEST-07. IF1024.2 +047200 COMPUTE WS-NUM = FUNCTION ANNUITY(5, 5). IF1024.2 +047300 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +047400 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +047500 PERFORM PASS IF1024.2 +047600 ELSE IF1024.2 +047700 MOVE WS-NUM TO COMPUTED-N IF1024.2 +047800 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +047900 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +048000 PERFORM FAIL. IF1024.2 +048100 GO TO F-ANNUITY-WRITE-07. IF1024.2 +048200 F-ANNUITY-DELETE-07. IF1024.2 +048300 PERFORM DE-LETE. IF1024.2 +048400 GO TO F-ANNUITY-WRITE-07. IF1024.2 +048500 F-ANNUITY-WRITE-07. IF1024.2 +048600 MOVE "F-ANNUITY-07" TO PAR-NAME. IF1024.2 +048700 PERFORM PRINT-DETAIL. IF1024.2 +048800*****************TEST (h) - SIMPLE TEST***************** IF1024.2 +048900 F-ANNUITY-08. IF1024.2 +049000 MOVE ZERO TO WS-NUM. IF1024.2 +049100 MOVE 4.03217 TO MIN-RANGE. IF1024.2 +049200 MOVE 4.03233 TO MAX-RANGE. IF1024.2 +049300 F-ANNUITY-TEST-08. IF1024.2 +049400 COMPUTE WS-NUM = FUNCTION ANNUITY(IND(1), IND(A)). IF1024.2 +049500 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +049600 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +049700 PERFORM PASS IF1024.2 +049800 ELSE IF1024.2 +049900 MOVE WS-NUM TO COMPUTED-N IF1024.2 +050000 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +050100 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +050200 PERFORM FAIL. IF1024.2 +050300 GO TO F-ANNUITY-WRITE-08. IF1024.2 +050400 F-ANNUITY-DELETE-08. IF1024.2 +050500 PERFORM DE-LETE. IF1024.2 +050600 GO TO F-ANNUITY-WRITE-08. IF1024.2 +050700 F-ANNUITY-WRITE-08. IF1024.2 +050800 MOVE "F-ANNUITY-08" TO PAR-NAME. IF1024.2 +050900 PERFORM PRINT-DETAIL. IF1024.2 +051000*****************TEST (a) - COMPLEX TEST**************** IF1024.2 +051100 F-ANNUITY-09. IF1024.2 +051200 MOVE ZERO TO WS-NUM. IF1024.2 +051300 MOVE 0.204824 TO MIN-RANGE. IF1024.2 +051400 MOVE 0.204840 TO MAX-RANGE. IF1024.2 +051500 F-ANNUITY-TEST-09. IF1024.2 +051600 COMPUTE WS-NUM = FUNCTION ANNUITY(B / 2, 8). IF1024.2 +051700 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +051800 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +051900 PERFORM PASS IF1024.2 +052000 ELSE IF1024.2 +052100 MOVE WS-NUM TO COMPUTED-N IF1024.2 +052200 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +052300 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +052400 PERFORM FAIL. IF1024.2 +052500 GO TO F-ANNUITY-WRITE-09. IF1024.2 +052600 F-ANNUITY-DELETE-09. IF1024.2 +052700 PERFORM DE-LETE. IF1024.2 +052800 GO TO F-ANNUITY-WRITE-09. IF1024.2 +052900 F-ANNUITY-WRITE-09. IF1024.2 +053000 MOVE "F-ANNUITY-09" TO PAR-NAME. IF1024.2 +053100 PERFORM PRINT-DETAIL. IF1024.2 +053200*****************TEST (b) - COMPLEX TEST**************** IF1024.2 +053300 F-ANNUITY-10. IF1024.2 +053400 MOVE ZERO TO WS-NUM. IF1024.2 +053500 MOVE 0.576553 TO MIN-RANGE. IF1024.2 +053600 MOVE 0.576599 TO MAX-RANGE. IF1024.2 +053700 F-ANNUITY-TEST-10. IF1024.2 +053800 COMPUTE WS-NUM = FUNCTION ANNUITY( IF1024.2 +053900 FUNCTION ANNUITY(0, 3), 3). IF1024.2 +054000 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +054100 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +054200 PERFORM PASS IF1024.2 +054300 ELSE IF1024.2 +054400 MOVE WS-NUM TO COMPUTED-N IF1024.2 +054500 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +054600 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +054700 PERFORM FAIL. IF1024.2 +054800 GO TO F-ANNUITY-WRITE-10. IF1024.2 +054900 F-ANNUITY-DELETE-10. IF1024.2 +055000 PERFORM DE-LETE. IF1024.2 +055100 GO TO F-ANNUITY-WRITE-10. IF1024.2 +055200 F-ANNUITY-WRITE-10. IF1024.2 +055300 MOVE "F-ANNUITY-10" TO PAR-NAME. IF1024.2 +055400 PERFORM PRINT-DETAIL. IF1024.2 +055500*****************TEST (c) - COMPLEX TEST**************** IF1024.2 +055600 F-ANNUITY-11. IF1024.2 +055700 MOVE ZERO TO WS-NUM. IF1024.2 +055800 MOVE 4.49978 TO MIN-RANGE. IF1024.2 +055900 MOVE 5.50022 TO MAX-RANGE. IF1024.2 +056000 F-ANNUITY-TEST-11. IF1024.2 +056100 COMPUTE WS-NUM = FUNCTION ANNUITY(0, 2) + 5. IF1024.2 +056200 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +056300 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +056400 PERFORM PASS IF1024.2 +056500 ELSE IF1024.2 +056600 MOVE WS-NUM TO COMPUTED-N IF1024.2 +056700 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +056800 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +056900 PERFORM FAIL. IF1024.2 +057000 GO TO F-ANNUITY-WRITE-11. IF1024.2 +057100 F-ANNUITY-DELETE-11. IF1024.2 +057200 PERFORM DE-LETE. IF1024.2 +057300 GO TO F-ANNUITY-WRITE-11. IF1024.2 +057400 F-ANNUITY-WRITE-11. IF1024.2 +057500 MOVE "F-ANNUITY-11" TO PAR-NAME. IF1024.2 +057600 PERFORM PRINT-DETAIL. IF1024.2 +057700*****************TEST (d) - COMPLEX TEST**************** IF1024.2 +057800 F-ANNUITY-12. IF1024.2 +057900 MOVE ZERO TO WS-NUM. IF1024.2 +058000 MOVE 0.999960 TO MIN-RANGE. IF1024.2 +058100 MOVE 1.00004 TO MAX-RANGE. IF1024.2 +058200 F-ANNUITY-TEST-12. IF1024.2 +058300 COMPUTE WS-NUM = FUNCTION ANNUITY(0, 2) + IF1024.2 +058400 FUNCTION ANNUITY(0, 2). IF1024.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1024.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1024.2 +058700 PERFORM PASS IF1024.2 +058800 ELSE IF1024.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1024.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1024.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1024.2 +059200 PERFORM FAIL. IF1024.2 +059300 GO TO F-ANNUITY-WRITE-12. IF1024.2 +059400 F-ANNUITY-DELETE-12. IF1024.2 +059500 PERFORM DE-LETE. IF1024.2 +059600 GO TO F-ANNUITY-WRITE-12. IF1024.2 +059700 F-ANNUITY-WRITE-12. IF1024.2 +059800 MOVE "F-ANNUITY-12" TO PAR-NAME. IF1024.2 +059900 PERFORM PRINT-DETAIL. IF1024.2 +060000*****************SPECIAL PERFORM TEST********************** IF1024.2 +060100 F-ANNUITY-13. IF1024.2 +060200 PERFORM F-ANNUITY-TEST-13 IF1024.2 +060300 UNTIL FUNCTION ANNUITY(0, ARG2) < .25. IF1024.2 +060400 PERFORM PASS. IF1024.2 +060500 GO TO F-ANNUITY-WRITE-13. IF1024.2 +060600 F-ANNUITY-TEST-13. IF1024.2 +060700 COMPUTE ARG2 = ARG2 + 1. IF1024.2 +060800 F-ANNUITY-DELETE-13. IF1024.2 +060900 PERFORM DE-LETE. IF1024.2 +061000 GO TO F-ANNUITY-WRITE-13. IF1024.2 +061100 F-ANNUITY-WRITE-13. IF1024.2 +061200 MOVE "F-ANNUITY-13" TO PAR-NAME. IF1024.2 +061300 PERFORM PRINT-DETAIL. IF1024.2 +061400********************END OF TESTS*************** IF1024.2 +061500 CCVS-EXIT SECTION. IF1024.2 +061600 CCVS-999999. IF1024.2 +061700 GO TO CLOSE-FILES. IF1024.2 diff --git a/tests/cobol85/IF/IF103A.CBL b/tests/cobol85/IF/IF103A.CBL new file mode 100755 index 00000000..897e988a --- /dev/null +++ b/tests/cobol85/IF/IF103A.CBL @@ -0,0 +1,840 @@ +000100 IDENTIFICATION DIVISION. IF1034.2 +000200 PROGRAM-ID. IF1034.2 +000300 IF103A. IF1034.2 +000400 IF1034.2 +000500*********************************************************** IF1034.2 +000600* * IF1034.2 +000700* This program is intended to form part of the CCVS85 * IF1034.2 +000800* COBOL Test Suite. It contains tests for the * IF1034.2 +000900* Intrinsic Function ASIN. * IF1034.2 +001000* * IF1034.2 +001100*********************************************************** IF1034.2 +001200 ENVIRONMENT DIVISION. IF1034.2 +001300 CONFIGURATION SECTION. IF1034.2 +001400 SOURCE-COMPUTER. IF1034.2 +001500 Linux. IF1034.2 +001600 OBJECT-COMPUTER. IF1034.2 +001700 Linux. IF1034.2 +001800 INPUT-OUTPUT SECTION. IF1034.2 +001900 FILE-CONTROL. IF1034.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1034.2 +002100 "report.log". IF1034.2 +002200 DATA DIVISION. IF1034.2 +002300 FILE SECTION. IF1034.2 +002400 FD PRINT-FILE. IF1034.2 +002500 01 PRINT-REC PICTURE X(120). IF1034.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1034.2 +002700 WORKING-STORAGE SECTION. IF1034.2 +002800*********************************************************** IF1034.2 +002900* Variables specific to the Intrinsic Function Test IF103A* IF1034.2 +003000*********************************************************** IF1034.2 +003100 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1034.2 +003200 01 B PIC S9(10) VALUE 2. IF1034.2 +003300 01 C PIC S9(10) VALUE 100000. IF1034.2 +003400 01 D PIC S9(10) VALUE 1000. IF1034.2 +003500 01 PI PIC S9V9(17) VALUE 3.141592654. IF1034.2 +003600 01 ARG1 PIC S9V9(17) VALUE 1. IF1034.2 +003700 01 SQRT2 PIC S9V9(17) VALUE 1.414213562. IF1034.2 +003800 01 SQRT3D2 PIC S9V9(17) VALUE 0.866025403. IF1034.2 +003900 01 ARR VALUE "40537". IF1034.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1034.2 +004100 01 TEMP PIC S9(5)V9(5). IF1034.2 +004200 01 WS-NUM PIC S9(5)V9(6). IF1034.2 +004300 01 MIN-RANGE PIC S9(5)V9(7). IF1034.2 +004400 01 MAX-RANGE PIC S9(5)V9(7). IF1034.2 +004500* IF1034.2 +004600********************************************************** IF1034.2 +004700* IF1034.2 +004800 01 TEST-RESULTS. IF1034.2 +004900 02 FILLER PIC X VALUE SPACE. IF1034.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IF1034.2 +005100 02 FILLER PIC X VALUE SPACE. IF1034.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IF1034.2 +005300 02 FILLER PIC X VALUE SPACE. IF1034.2 +005400 02 PAR-NAME. IF1034.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IF1034.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IF1034.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IF1034.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IF1034.2 +005900 02 RE-MARK PIC X(61). IF1034.2 +006000 01 TEST-COMPUTED. IF1034.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IF1034.2 +006200 02 FILLER PIC X(17) VALUE IF1034.2 +006300 " COMPUTED=". IF1034.2 +006400 02 COMPUTED-X. IF1034.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1034.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IF1034.2 +006700 PIC -9(9).9(9). IF1034.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1034.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1034.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1034.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IF1034.2 +007200 04 COMPUTED-18V0 PIC -9(18). IF1034.2 +007300 04 FILLER PIC X. IF1034.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IF1034.2 +007500 01 TEST-CORRECT. IF1034.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IF1034.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1034.2 +007800 02 CORRECT-X. IF1034.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1034.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1034.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1034.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1034.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1034.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IF1034.2 +008500 04 CORRECT-18V0 PIC -9(18). IF1034.2 +008600 04 FILLER PIC X. IF1034.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IF1034.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1034.2 +008900 01 TEST-CORRECT-MIN. IF1034.2 +009000 02 FILLER PIC X(30) VALUE SPACE. IF1034.2 +009100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1034.2 +009200 02 CORRECTMI-X. IF1034.2 +009300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1034.2 +009400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1034.2 +009500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1034.2 +009600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1034.2 +009700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1034.2 +009800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1034.2 +009900 04 CORRECTMI-18V0 PIC -9(18). IF1034.2 +010000 04 FILLER PIC X. IF1034.2 +010100 03 FILLER PIC X(2) VALUE SPACE. IF1034.2 +010200 03 FILLER PIC X(48) VALUE SPACE. IF1034.2 +010300 01 TEST-CORRECT-MAX. IF1034.2 +010400 02 FILLER PIC X(30) VALUE SPACE. IF1034.2 +010500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1034.2 +010600 02 CORRECTMA-X. IF1034.2 +010700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1034.2 +010800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1034.2 +010900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1034.2 +011000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1034.2 +011100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1034.2 +011200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1034.2 +011300 04 CORRECTMA-18V0 PIC -9(18). IF1034.2 +011400 04 FILLER PIC X. IF1034.2 +011500 03 FILLER PIC X(2) VALUE SPACE. IF1034.2 +011600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1034.2 +011700 01 CCVS-C-1. IF1034.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1034.2 +011900- "SS PARAGRAPH-NAME IF1034.2 +012000- " REMARKS". IF1034.2 +012100 02 FILLER PIC X(20) VALUE SPACE. IF1034.2 +012200 01 CCVS-C-2. IF1034.2 +012300 02 FILLER PIC X VALUE SPACE. IF1034.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". IF1034.2 +012500 02 FILLER PIC X(15) VALUE SPACE. IF1034.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". IF1034.2 +012700 02 FILLER PIC X(94) VALUE SPACE. IF1034.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1034.2 +012900 01 REC-CT PIC 99 VALUE ZERO. IF1034.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1034.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1034.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1034.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1034.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1034.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1034.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1034.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1034.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1034.2 +013900 01 CCVS-H-1. IF1034.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1034.2 +014100 02 FILLER PIC X(42) VALUE IF1034.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1034.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IF1034.2 +014400 01 CCVS-H-2A. IF1034.2 +014500 02 FILLER PIC X(40) VALUE SPACE. IF1034.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1034.2 +014700 02 FILLER PIC XXXX VALUE IF1034.2 +014800 "4.2 ". IF1034.2 +014900 02 FILLER PIC X(28) VALUE IF1034.2 +015000 " COPY - NOT FOR DISTRIBUTION". IF1034.2 +015100 02 FILLER PIC X(41) VALUE SPACE. IF1034.2 +015200 IF1034.2 +015300 01 CCVS-H-2B. IF1034.2 +015400 02 FILLER PIC X(15) VALUE IF1034.2 +015500 "TEST RESULT OF ". IF1034.2 +015600 02 TEST-ID PIC X(9). IF1034.2 +015700 02 FILLER PIC X(4) VALUE IF1034.2 +015800 " IN ". IF1034.2 +015900 02 FILLER PIC X(12) VALUE IF1034.2 +016000 " HIGH ". IF1034.2 +016100 02 FILLER PIC X(22) VALUE IF1034.2 +016200 " LEVEL VALIDATION FOR ". IF1034.2 +016300 02 FILLER PIC X(58) VALUE IF1034.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1034.2 +016500 01 CCVS-H-3. IF1034.2 +016600 02 FILLER PIC X(34) VALUE IF1034.2 +016700 " FOR OFFICIAL USE ONLY ". IF1034.2 +016800 02 FILLER PIC X(58) VALUE IF1034.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1034.2 +017000 02 FILLER PIC X(28) VALUE IF1034.2 +017100 " COPYRIGHT 1985 ". IF1034.2 +017200 01 CCVS-E-1. IF1034.2 +017300 02 FILLER PIC X(52) VALUE SPACE. IF1034.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1034.2 +017500 02 ID-AGAIN PIC X(9). IF1034.2 +017600 02 FILLER PIC X(45) VALUE SPACES. IF1034.2 +017700 01 CCVS-E-2. IF1034.2 +017800 02 FILLER PIC X(31) VALUE SPACE. IF1034.2 +017900 02 FILLER PIC X(21) VALUE SPACE. IF1034.2 +018000 02 CCVS-E-2-2. IF1034.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1034.2 +018200 03 FILLER PIC X VALUE SPACE. IF1034.2 +018300 03 ENDER-DESC PIC X(44) VALUE IF1034.2 +018400 "ERRORS ENCOUNTERED". IF1034.2 +018500 01 CCVS-E-3. IF1034.2 +018600 02 FILLER PIC X(22) VALUE IF1034.2 +018700 " FOR OFFICIAL USE ONLY". IF1034.2 +018800 02 FILLER PIC X(12) VALUE SPACE. IF1034.2 +018900 02 FILLER PIC X(58) VALUE IF1034.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1034.2 +019100 02 FILLER PIC X(13) VALUE SPACE. IF1034.2 +019200 02 FILLER PIC X(15) VALUE IF1034.2 +019300 " COPYRIGHT 1985". IF1034.2 +019400 01 CCVS-E-4. IF1034.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1034.2 +019600 02 FILLER PIC X(4) VALUE " OF ". IF1034.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1034.2 +019800 02 FILLER PIC X(40) VALUE IF1034.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1034.2 +020000 01 XXINFO. IF1034.2 +020100 02 FILLER PIC X(19) VALUE IF1034.2 +020200 "*** INFORMATION ***". IF1034.2 +020300 02 INFO-TEXT. IF1034.2 +020400 04 FILLER PIC X(8) VALUE SPACE. IF1034.2 +020500 04 XXCOMPUTED PIC X(20). IF1034.2 +020600 04 FILLER PIC X(5) VALUE SPACE. IF1034.2 +020700 04 XXCORRECT PIC X(20). IF1034.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). IF1034.2 +020900 01 HYPHEN-LINE. IF1034.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. IF1034.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************IF1034.2 +021200- "*****************************************". IF1034.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************IF1034.2 +021400- "******************************". IF1034.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE IF1034.2 +021600 "IF103A". IF1034.2 +021700 PROCEDURE DIVISION. IF1034.2 +021800 CCVS1 SECTION. IF1034.2 +021900 OPEN-FILES. IF1034.2 +022000 OPEN OUTPUT PRINT-FILE. IF1034.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1034.2 +022200 MOVE SPACE TO TEST-RESULTS. IF1034.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1034.2 +022400 GO TO CCVS1-EXIT. IF1034.2 +022500 CLOSE-FILES. IF1034.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1034.2 +022700 TERMINATE-CCVS. IF1034.2 +022800 STOP RUN. IF1034.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1034.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1034.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1034.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1034.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IF1034.2 +023400 PRINT-DETAIL. IF1034.2 +023500 IF REC-CT NOT EQUAL TO ZERO IF1034.2 +023600 MOVE "." TO PARDOT-X IF1034.2 +023700 MOVE REC-CT TO DOTVALUE. IF1034.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1034.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1034.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1034.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1034.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1034.2 +024300 MOVE SPACE TO CORRECT-X. IF1034.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1034.2 +024500 MOVE SPACE TO RE-MARK. IF1034.2 +024600 HEAD-ROUTINE. IF1034.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1034.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1034.2 +025100 COLUMN-NAMES-ROUTINE. IF1034.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +025500 END-ROUTINE. IF1034.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1034.2 +025700 END-RTN-EXIT. IF1034.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +025900 END-ROUTINE-1. IF1034.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1034.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1034.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IF1034.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1034.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1034.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1034.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1034.2 +026700 END-ROUTINE-12. IF1034.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1034.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1034.2 +027000 MOVE "NO " TO ERROR-TOTAL IF1034.2 +027100 ELSE IF1034.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1034.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1034.2 +027400 PERFORM WRITE-LINE. IF1034.2 +027500 END-ROUTINE-13. IF1034.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1034.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE IF1034.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1034.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1034.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO IF1034.2 +028200 MOVE "NO " TO ERROR-TOTAL IF1034.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1034.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1034.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1034.2 +028700 WRITE-LINE. IF1034.2 +028800 ADD 1 TO RECORD-COUNT. IF1034.2 +028900 IF RECORD-COUNT GREATER 42 IF1034.2 +029000 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1034.2 +029100 MOVE SPACE TO DUMMY-RECORD IF1034.2 +029200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1034.2 +029300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1034.2 +029400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1034.2 +029500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1034.2 +029600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1034.2 +029700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1034.2 +029800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1034.2 +029900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1034.2 +030000 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1034.2 +030100 MOVE ZERO TO RECORD-COUNT. IF1034.2 +030200 PERFORM WRT-LN. IF1034.2 +030300 WRT-LN. IF1034.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1034.2 +030500 MOVE SPACE TO DUMMY-RECORD. IF1034.2 +030600 BLANK-LINE-PRINT. IF1034.2 +030700 PERFORM WRT-LN. IF1034.2 +030800 FAIL-ROUTINE. IF1034.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE IF1034.2 +031000 GO TO FAIL-ROUTINE-WRITE. IF1034.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1034.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1034.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1034.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1034.2 +031600 GO TO FAIL-ROUTINE-EX. IF1034.2 +031700 FAIL-ROUTINE-WRITE. IF1034.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1034.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1034.2 +032000 CORMA-ANSI-REFERENCE. IF1034.2 +032100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1034.2 +032200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1034.2 +032300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1034.2 +032400 ELSE IF1034.2 +032500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1034.2 +032600 PERFORM WRITE-LINE. IF1034.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1034.2 +032800 FAIL-ROUTINE-EX. EXIT. IF1034.2 +032900 BAIL-OUT. IF1034.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1034.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1034.2 +033200 BAIL-OUT-WRITE. IF1034.2 +033300 MOVE CORRECT-A TO XXCORRECT. IF1034.2 +033400 MOVE COMPUTED-A TO XXCOMPUTED. IF1034.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1034.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1034.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1034.2 +033800 BAIL-OUT-EX. EXIT. IF1034.2 +033900 CCVS1-EXIT. IF1034.2 +034000 EXIT. IF1034.2 +034100******************************************************** IF1034.2 +034200* * IF1034.2 +034300* Intrinsic Function Tests IF103A - ASIN * IF1034.2 +034400* * IF1034.2 +034500******************************************************** IF1034.2 +034600 SECT-IF103A SECTION. IF1034.2 +034700 F-ASIN-INFO. IF1034.2 +034800 MOVE "See ref. A-35 2.7" TO ANSI-REFERENCE. IF1034.2 +034900 MOVE "ASIN Function" TO FEATURE. IF1034.2 +035000*****************TEST (a) - SIMPLE TEST***************** IF1034.2 +035100 F-ASIN-01. IF1034.2 +035200 MOVE ZERO TO WS-NUM. IF1034.2 +035300 MOVE 1.57076 TO MIN-RANGE. IF1034.2 +035400 MOVE 1.57080 TO MAX-RANGE. IF1034.2 +035500 F-ASIN-TEST-01. IF1034.2 +035600 COMPUTE WS-NUM = FUNCTION ASIN(1.0). IF1034.2 +035700 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +035800 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +035900 PERFORM PASS IF1034.2 +036000 ELSE IF1034.2 +036100 MOVE WS-NUM TO COMPUTED-N IF1034.2 +036200 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +036300 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +036400 PERFORM FAIL. IF1034.2 +036500 GO TO F-ASIN-WRITE-01. IF1034.2 +036600 F-ASIN-DELETE-01. IF1034.2 +036700 PERFORM DE-LETE. IF1034.2 +036800 GO TO F-ASIN-WRITE-01. IF1034.2 +036900 F-ASIN-WRITE-01. IF1034.2 +037000 MOVE "F-ASIN-01" TO PAR-NAME. IF1034.2 +037100 PERFORM PRINT-DETAIL. IF1034.2 +037200*****************TEST (b) - SIMPLE TEST***************** IF1034.2 +037300 F-ASIN-02. IF1034.2 +037400 EVALUATE FUNCTION ASIN(0.5) IF1034.2 +037500 WHEN 0.523588 THRU 0.523609 IF1034.2 +037600 PERFORM PASS IF1034.2 +037700 WHEN OTHER IF1034.2 +037800 PERFORM FAIL. IF1034.2 +037900 GO TO F-ASIN-WRITE-02. IF1034.2 +038000 F-ASIN-DELETE-02. IF1034.2 +038100 PERFORM DE-LETE. IF1034.2 +038200 GO TO F-ASIN-WRITE-02. IF1034.2 +038300 F-ASIN-WRITE-02. IF1034.2 +038400 MOVE "F-ASIN-02" TO PAR-NAME. IF1034.2 +038500 PERFORM PRINT-DETAIL. IF1034.2 +038600*****************TEST (c) - SIMPLE TEST***************** IF1034.2 +038700 F-ASIN-03. IF1034.2 +038800 MOVE -0.000020 TO MIN-RANGE. IF1034.2 +038900 MOVE 0.000020 TO MAX-RANGE. IF1034.2 +039000 F-ASIN-TEST-03. IF1034.2 +039100 IF (FUNCTION ASIN(0) >= MIN-RANGE) AND IF1034.2 +039200 (FUNCTION ASIN(0) <= MAX-RANGE) THEN IF1034.2 +039300 PERFORM PASS IF1034.2 +039400 ELSE IF1034.2 +039500 PERFORM FAIL. IF1034.2 +039600 GO TO F-ASIN-WRITE-03. IF1034.2 +039700 F-ASIN-DELETE-03. IF1034.2 +039800 PERFORM DE-LETE. IF1034.2 +039900 GO TO F-ASIN-WRITE-03. IF1034.2 +040000 F-ASIN-WRITE-03. IF1034.2 +040100 MOVE "F-ASIN-03" TO PAR-NAME. IF1034.2 +040200 PERFORM PRINT-DETAIL. IF1034.2 +040300*****************TEST (d) - SIMPLE TEST***************** IF1034.2 +040400 F-ASIN-04. IF1034.2 +040500 MOVE ZERO TO WS-NUM. IF1034.2 +040600 MOVE -1.57080 TO MIN-RANGE. IF1034.2 +040700 MOVE -1.57076 TO MAX-RANGE. IF1034.2 +040800 F-ASIN-TEST-04. IF1034.2 +040900 COMPUTE WS-NUM = FUNCTION ASIN(-1). IF1034.2 +041000 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +041100 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +041200 PERFORM PASS IF1034.2 +041300 ELSE IF1034.2 +041400 MOVE WS-NUM TO COMPUTED-N IF1034.2 +041500 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +041600 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +041700 PERFORM FAIL. IF1034.2 +041800 GO TO F-ASIN-WRITE-04. IF1034.2 +041900 F-ASIN-DELETE-04. IF1034.2 +042000 PERFORM DE-LETE. IF1034.2 +042100 GO TO F-ASIN-WRITE-04. IF1034.2 +042200 F-ASIN-WRITE-04. IF1034.2 +042300 MOVE "F-ASIN-04" TO PAR-NAME. IF1034.2 +042400 PERFORM PRINT-DETAIL. IF1034.2 +042500*****************TEST (e) - SIMPLE TEST***************** IF1034.2 +042600 F-ASIN-05. IF1034.2 +042700 MOVE ZERO TO WS-NUM. IF1034.2 +042800 MOVE 1.52604 TO MIN-RANGE. IF1034.2 +042900 MOVE 1.52610 TO MAX-RANGE. IF1034.2 +043000 F-ASIN-TEST-05. IF1034.2 +043100 COMPUTE WS-NUM = FUNCTION ASIN(.999). IF1034.2 +043200 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +043300 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +043400 PERFORM PASS IF1034.2 +043500 ELSE IF1034.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1034.2 +043700 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +043800 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +043900 PERFORM FAIL. IF1034.2 +044000 GO TO F-ASIN-WRITE-05. IF1034.2 +044100 F-ASIN-DELETE-05. IF1034.2 +044200 PERFORM DE-LETE. IF1034.2 +044300 GO TO F-ASIN-WRITE-05. IF1034.2 +044400 F-ASIN-WRITE-05. IF1034.2 +044500 MOVE "F-ASIN-05" TO PAR-NAME. IF1034.2 +044600 PERFORM PRINT-DETAIL. IF1034.2 +044700*****************TEST (f) - SIMPLE TEST***************** IF1034.2 +044800 F-ASIN-06. IF1034.2 +044900 MOVE ZERO TO WS-NUM. IF1034.2 +045000 MOVE 0.512079 TO MIN-RANGE. IF1034.2 +045100 MOVE 0.512099 TO MAX-RANGE. IF1034.2 +045200 F-ASIN-TEST-06. IF1034.2 +045300 COMPUTE WS-NUM = FUNCTION ASIN(.49). IF1034.2 +045400 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +045500 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +045600 PERFORM PASS IF1034.2 +045700 ELSE IF1034.2 +045800 MOVE WS-NUM TO COMPUTED-N IF1034.2 +045900 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +046000 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +046100 PERFORM FAIL. IF1034.2 +046200 GO TO F-ASIN-WRITE-06. IF1034.2 +046300 F-ASIN-DELETE-06. IF1034.2 +046400 PERFORM DE-LETE. IF1034.2 +046500 GO TO F-ASIN-WRITE-06. IF1034.2 +046600 F-ASIN-WRITE-06. IF1034.2 +046700 MOVE "F-ASIN-06" TO PAR-NAME. IF1034.2 +046800 PERFORM PRINT-DETAIL. IF1034.2 +046900*****************TEST (h) - SIMPLE TEST***************** IF1034.2 +047000 F-ASIN-08. IF1034.2 +047100 MOVE ZERO TO WS-NUM. IF1034.2 +047200 MOVE -1.52610 TO MIN-RANGE. IF1034.2 +047300 MOVE -1.52604 TO MAX-RANGE. IF1034.2 +047400 F-ASIN-TEST-08. IF1034.2 +047500 COMPUTE WS-NUM = FUNCTION ASIN(-.999). IF1034.2 +047600 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +047700 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +047800 PERFORM PASS IF1034.2 +047900 ELSE IF1034.2 +048000 MOVE WS-NUM TO COMPUTED-N IF1034.2 +048100 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +048200 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +048300 PERFORM FAIL. IF1034.2 +048400 GO TO F-ASIN-WRITE-08. IF1034.2 +048500 F-ASIN-DELETE-08. IF1034.2 +048600 PERFORM DE-LETE. IF1034.2 +048700 GO TO F-ASIN-WRITE-08. IF1034.2 +048800 F-ASIN-WRITE-08. IF1034.2 +048900 MOVE "F-ASIN-08" TO PAR-NAME. IF1034.2 +049000 PERFORM PRINT-DETAIL. IF1034.2 +049100*****************TEST (k) - SIMPLE TEST***************** IF1034.2 +049200 F-ASIN-11. IF1034.2 +049300 MOVE ZERO TO WS-NUM. IF1034.2 +049400 MOVE -0.000020 TO MIN-RANGE. IF1034.2 +049500 MOVE 0.000020 TO MAX-RANGE. IF1034.2 +049600 F-ASIN-TEST-11. IF1034.2 +049700 COMPUTE WS-NUM = FUNCTION ASIN(IND(B)). IF1034.2 +049800 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +049900 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +050000 PERFORM PASS IF1034.2 +050100 ELSE IF1034.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1034.2 +050300 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +050400 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +050500 PERFORM FAIL. IF1034.2 +050600 GO TO F-ASIN-WRITE-11. IF1034.2 +050700 F-ASIN-DELETE-11. IF1034.2 +050800 PERFORM DE-LETE. IF1034.2 +050900 GO TO F-ASIN-WRITE-11. IF1034.2 +051000 F-ASIN-WRITE-11. IF1034.2 +051100 MOVE "F-ASIN-11" TO PAR-NAME. IF1034.2 +051200 PERFORM PRINT-DETAIL. IF1034.2 +051300*****************TEST (a) - COMPLEX TEST**************** IF1034.2 +051400 F-ASIN-12. IF1034.2 +051500 MOVE ZERO TO WS-NUM. IF1034.2 +051600 MOVE 0.785367 TO MIN-RANGE. IF1034.2 +051700 MOVE 0.785429 TO MAX-RANGE. IF1034.2 +051800 F-ASIN-TEST-12. IF1034.2 +051900 COMPUTE WS-NUM = FUNCTION ASIN(1 / SQRT2). IF1034.2 +052000 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +052100 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +052200 PERFORM PASS IF1034.2 +052300 ELSE IF1034.2 +052400 MOVE WS-NUM TO COMPUTED-N IF1034.2 +052500 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +052600 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +052700 PERFORM FAIL. IF1034.2 +052800 GO TO F-ASIN-WRITE-12. IF1034.2 +052900 F-ASIN-DELETE-12. IF1034.2 +053000 PERFORM DE-LETE. IF1034.2 +053100 GO TO F-ASIN-WRITE-12. IF1034.2 +053200 F-ASIN-WRITE-12. IF1034.2 +053300 MOVE "F-ASIN-12" TO PAR-NAME. IF1034.2 +053400 PERFORM PRINT-DETAIL. IF1034.2 +053500*****************TEST (b) COMPLEX-TEST****************** IF1034.2 +053600 F-ASIN-13. IF1034.2 +053700 MOVE ZERO TO WS-NUM. IF1034.2 +053800 MOVE 1.04715 TO MIN-RANGE. IF1034.2 +053900 MOVE 1.04723 TO MAX-RANGE. IF1034.2 +054000 F-ASIN-TEST-13. IF1034.2 +054100 COMPUTE WS-NUM = FUNCTION ASIN(SQRT3D2). IF1034.2 +054200 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +054300 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +054400 PERFORM PASS IF1034.2 +054500 ELSE IF1034.2 +054600 MOVE WS-NUM TO COMPUTED-N IF1034.2 +054700 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +054800 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +054900 PERFORM FAIL. IF1034.2 +055000 GO TO F-ASIN-WRITE-13. IF1034.2 +055100 F-ASIN-DELETE-13. IF1034.2 +055200 PERFORM DE-LETE. IF1034.2 +055300 GO TO F-ASIN-WRITE-13. IF1034.2 +055400 F-ASIN-WRITE-13. IF1034.2 +055500 MOVE "F-ASIN-13" TO PAR-NAME. IF1034.2 +055600 PERFORM PRINT-DETAIL. IF1034.2 +055700*****************TEST (d) - COMPLEX TEST**************** IF1034.2 +055800 F-ASIN-15. IF1034.2 +055900 MOVE ZERO TO WS-NUM. IF1034.2 +056000 MOVE 1.42919 TO MIN-RANGE. IF1034.2 +056100 MOVE 1.42931 TO MAX-RANGE. IF1034.2 +056200 F-ASIN-TEST-15. IF1034.2 +056300 COMPUTE WS-NUM = FUNCTION ASIN(1.98 / 2). IF1034.2 +056400 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +056500 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +056600 PERFORM PASS IF1034.2 +056700 ELSE IF1034.2 +056800 MOVE WS-NUM TO COMPUTED-N IF1034.2 +056900 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +057000 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +057100 PERFORM FAIL. IF1034.2 +057200 GO TO F-ASIN-WRITE-15. IF1034.2 +057300 F-ASIN-DELETE-15. IF1034.2 +057400 PERFORM DE-LETE. IF1034.2 +057500 GO TO F-ASIN-WRITE-15. IF1034.2 +057600 F-ASIN-WRITE-15. IF1034.2 +057700 MOVE "F-ASIN-15" TO PAR-NAME. IF1034.2 +057800 PERFORM PRINT-DETAIL. IF1034.2 +057900*****************TEST (e) - COMPLEX TEST**************** IF1034.2 +058000 F-ASIN-16. IF1034.2 +058100 MOVE ZERO TO WS-NUM. IF1034.2 +058200 MOVE 0.512069 TO MIN-RANGE. IF1034.2 +058300 MOVE 0.512110 TO MAX-RANGE. IF1034.2 +058400 F-ASIN-TEST-16. IF1034.2 +058500 COMPUTE WS-NUM = FUNCTION ASIN(0.2 + 0.29). IF1034.2 +058600 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +058700 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +058800 PERFORM PASS IF1034.2 +058900 ELSE IF1034.2 +059000 MOVE WS-NUM TO COMPUTED-N IF1034.2 +059100 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +059200 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +059300 PERFORM FAIL. IF1034.2 +059400 GO TO F-ASIN-WRITE-16. IF1034.2 +059500 F-ASIN-DELETE-16. IF1034.2 +059600 PERFORM DE-LETE. IF1034.2 +059700 GO TO F-ASIN-WRITE-16. IF1034.2 +059800 F-ASIN-WRITE-16. IF1034.2 +059900 MOVE "F-ASIN-16" TO PAR-NAME. IF1034.2 +060000 PERFORM PRINT-DETAIL. IF1034.2 +060100*****************TEST (f) - COMPLEX TEST**************** IF1034.2 +060200 F-ASIN-17. IF1034.2 +060300 MOVE ZERO TO WS-NUM. IF1034.2 +060400 MOVE -1.42931 TO MIN-RANGE. IF1034.2 +060500 MOVE -1.42919 TO MAX-RANGE. IF1034.2 +060600 F-ASIN-TEST-17. IF1034.2 +060700 COMPUTE WS-NUM = FUNCTION ASIN(0.99 * -1). IF1034.2 +060800 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +060900 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +061000 PERFORM PASS IF1034.2 +061100 ELSE IF1034.2 +061200 MOVE WS-NUM TO COMPUTED-N IF1034.2 +061300 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +061400 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +061500 PERFORM FAIL. IF1034.2 +061600 GO TO F-ASIN-WRITE-17. IF1034.2 +061700 F-ASIN-DELETE-17. IF1034.2 +061800 PERFORM DE-LETE. IF1034.2 +061900 GO TO F-ASIN-WRITE-17. IF1034.2 +062000 F-ASIN-WRITE-17. IF1034.2 +062100 MOVE "F-ASIN-17" TO PAR-NAME. IF1034.2 +062200 PERFORM PRINT-DETAIL. IF1034.2 +062300*****************TEST (g) - COMPLEX TEST**************** IF1034.2 +062400 F-ASIN-18. IF1034.2 +062500 MOVE ZERO TO WS-NUM. IF1034.2 +062600 MOVE 0.675104 TO MIN-RANGE. IF1034.2 +062700 MOVE 0.675158 TO MAX-RANGE. IF1034.2 +062800 F-ASIN-TEST-18. IF1034.2 +062900 COMPUTE WS-NUM = FUNCTION ASIN(IND(3) / 8). IF1034.2 +063000 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +063100 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +063200 PERFORM PASS IF1034.2 +063300 ELSE IF1034.2 +063400 MOVE WS-NUM TO COMPUTED-N IF1034.2 +063500 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +063600 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +063700 PERFORM FAIL. IF1034.2 +063800 GO TO F-ASIN-WRITE-18. IF1034.2 +063900 F-ASIN-DELETE-18. IF1034.2 +064000 PERFORM DE-LETE. IF1034.2 +064100 GO TO F-ASIN-WRITE-18. IF1034.2 +064200 F-ASIN-WRITE-18. IF1034.2 +064300 MOVE "F-ASIN-18" TO PAR-NAME. IF1034.2 +064400 PERFORM PRINT-DETAIL. IF1034.2 +064500*****************TEST (h) - COMPLEX TEST**************** IF1034.2 +064600 F-ASIN-19. IF1034.2 +064700 MOVE ZERO TO WS-NUM. IF1034.2 +064800 MOVE 1.57073 TO MIN-RANGE. IF1034.2 +064900 MOVE 1.57080 TO MAX-RANGE. IF1034.2 +065000 F-ASIN-TEST-19. IF1034.2 +065100 COMPUTE WS-NUM = FUNCTION ASIN(4 - 3). IF1034.2 +065200 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +065300 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +065400 PERFORM PASS IF1034.2 +065500 ELSE IF1034.2 +065600 MOVE WS-NUM TO COMPUTED-N IF1034.2 +065700 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +065800 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +065900 PERFORM FAIL. IF1034.2 +066000 GO TO F-ASIN-WRITE-19. IF1034.2 +066100 F-ASIN-DELETE-19. IF1034.2 +066200 PERFORM DE-LETE. IF1034.2 +066300 GO TO F-ASIN-WRITE-19. IF1034.2 +066400 F-ASIN-WRITE-19. IF1034.2 +066500 MOVE "F-ASIN-19" TO PAR-NAME. IF1034.2 +066600 PERFORM PRINT-DETAIL. IF1034.2 +066700*****************TEST (i) - COMPLEX TEST**************** IF1034.2 +066800 F-ASIN-20. IF1034.2 +066900 MOVE ZERO TO WS-NUM. IF1034.2 +067000 MOVE -0.000040 TO MIN-RANGE. IF1034.2 +067100 MOVE 0.000040 TO MAX-RANGE. IF1034.2 +067200 F-ASIN-TEST-20. IF1034.2 +067300 COMPUTE WS-NUM = FUNCTION ASIN(C - C). IF1034.2 +067400 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +067500 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +067600 PERFORM PASS IF1034.2 +067700 ELSE IF1034.2 +067800 MOVE WS-NUM TO COMPUTED-N IF1034.2 +067900 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +068000 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +068100 PERFORM FAIL. IF1034.2 +068200 GO TO F-ASIN-WRITE-20. IF1034.2 +068300 F-ASIN-DELETE-20. IF1034.2 +068400 PERFORM DE-LETE. IF1034.2 +068500 GO TO F-ASIN-WRITE-20. IF1034.2 +068600 F-ASIN-WRITE-20. IF1034.2 +068700 MOVE "F-ASIN-20" TO PAR-NAME. IF1034.2 +068800 PERFORM PRINT-DETAIL. IF1034.2 +068900*****************TEST (j) - COMPLEX TEST**************** IF1034.2 +069000 F-ASIN-21. IF1034.2 +069100 MOVE ZERO TO WS-NUM. IF1034.2 +069200 MOVE 0.252670 TO MIN-RANGE. IF1034.2 +069300 MOVE 0.252690 TO MAX-RANGE. IF1034.2 +069400 F-ASIN-TEST-21. IF1034.2 +069500 COMPUTE WS-NUM = FUNCTION ASIN(0.25 * 1). IF1034.2 +069600 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +069700 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +069800 PERFORM PASS IF1034.2 +069900 ELSE IF1034.2 +070000 MOVE WS-NUM TO COMPUTED-N IF1034.2 +070100 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +070200 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +070300 PERFORM FAIL. IF1034.2 +070400 GO TO F-ASIN-WRITE-21. IF1034.2 +070500 F-ASIN-DELETE-21. IF1034.2 +070600 PERFORM DE-LETE. IF1034.2 +070700 GO TO F-ASIN-WRITE-21. IF1034.2 +070800 F-ASIN-WRITE-21. IF1034.2 +070900 MOVE "F-ASIN-21" TO PAR-NAME. IF1034.2 +071000 PERFORM PRINT-DETAIL. IF1034.2 +071100*****************TEST (k) - COMPLEX TEST**************** IF1034.2 +071200 F-ASIN-22. IF1034.2 +071300 MOVE ZERO TO WS-NUM. IF1034.2 +071400 MOVE 0.323933 TO MIN-RANGE. IF1034.2 +071500 MOVE 0.323959 TO MAX-RANGE. IF1034.2 +071600 F-ASIN-TEST-22. IF1034.2 +071700 COMPUTE WS-NUM = FUNCTION ASIN(1 / PI). IF1034.2 +071800 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +071900 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +072000 PERFORM PASS IF1034.2 +072100 ELSE IF1034.2 +072200 MOVE WS-NUM TO COMPUTED-N IF1034.2 +072300 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +072400 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +072500 PERFORM FAIL. IF1034.2 +072600 GO TO F-ASIN-WRITE-22. IF1034.2 +072700 F-ASIN-DELETE-22. IF1034.2 +072800 PERFORM DE-LETE. IF1034.2 +072900 GO TO F-ASIN-WRITE-22. IF1034.2 +073000 F-ASIN-WRITE-22. IF1034.2 +073100 MOVE "F-ASIN-22" TO PAR-NAME. IF1034.2 +073200 PERFORM PRINT-DETAIL. IF1034.2 +073300*****************TEST (l) - COMPLEX TEST**************** IF1034.2 +073400 F-ASIN-23. IF1034.2 +073500 MOVE ZERO TO WS-NUM. IF1034.2 +073600 MOVE -0.000040 TO MIN-RANGE. IF1034.2 +073700 MOVE 0.000040 TO MAX-RANGE. IF1034.2 +073800 F-ASIN-TEST-23. IF1034.2 +073900 COMPUTE WS-NUM = FUNCTION ASIN((D / D) - 1). IF1034.2 +074000 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +074100 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +074200 PERFORM PASS IF1034.2 +074300 ELSE IF1034.2 +074400 MOVE WS-NUM TO COMPUTED-N IF1034.2 +074500 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +074600 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +074700 PERFORM FAIL. IF1034.2 +074800 GO TO F-ASIN-WRITE-23. IF1034.2 +074900 F-ASIN-DELETE-23. IF1034.2 +075000 PERFORM DE-LETE. IF1034.2 +075100 GO TO F-ASIN-WRITE-23. IF1034.2 +075200 F-ASIN-WRITE-23. IF1034.2 +075300 MOVE "F-ASIN-23" TO PAR-NAME. IF1034.2 +075400 PERFORM PRINT-DETAIL. IF1034.2 +075500*****************TEST (m) - COMPLEX TEST**************** IF1034.2 +075600 F-ASIN-24. IF1034.2 +075700 MOVE ZERO TO WS-NUM. IF1034.2 +075800 MOVE -1.03219 TO MIN-RANGE. IF1034.2 +075900 MOVE -1.03211 TO MAX-RANGE. IF1034.2 +076000 F-ASIN-TEST-24. IF1034.2 +076100 COMPUTE WS-NUM = FUNCTION ASIN(PI - 4). IF1034.2 +076200 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +076300 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +076400 PERFORM PASS IF1034.2 +076500 ELSE IF1034.2 +076600 MOVE WS-NUM TO COMPUTED-N IF1034.2 +076700 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +076800 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +076900 PERFORM FAIL. IF1034.2 +077000 GO TO F-ASIN-WRITE-24. IF1034.2 +077100 F-ASIN-DELETE-24. IF1034.2 +077200 PERFORM DE-LETE. IF1034.2 +077300 GO TO F-ASIN-WRITE-24. IF1034.2 +077400 F-ASIN-WRITE-24. IF1034.2 +077500 MOVE "F-ASIN-24" TO PAR-NAME. IF1034.2 +077600 PERFORM PRINT-DETAIL. IF1034.2 +077700*****************TEST (n) - COMPLEX TEST**************** IF1034.2 +077800 F-ASIN-25. IF1034.2 +077900 MOVE ZERO TO WS-NUM. IF1034.2 +078000 MOVE 0.142546 TO MIN-RANGE. IF1034.2 +078100 MOVE 0.142558 TO MAX-RANGE. IF1034.2 +078200 F-ASIN-TEST-25. IF1034.2 +078300 COMPUTE WS-NUM = FUNCTION ASIN(FUNCTION ASIN(PI - 3)). IF1034.2 +078400 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +078500 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +078600 PERFORM PASS IF1034.2 +078700 ELSE IF1034.2 +078800 MOVE WS-NUM TO COMPUTED-N IF1034.2 +078900 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +079000 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +079100 PERFORM FAIL. IF1034.2 +079200 GO TO F-ASIN-WRITE-25. IF1034.2 +079300 F-ASIN-DELETE-25. IF1034.2 +079400 PERFORM DE-LETE. IF1034.2 +079500 GO TO F-ASIN-WRITE-25. IF1034.2 +079600 F-ASIN-WRITE-25. IF1034.2 +079700 MOVE "F-ASIN-25" TO PAR-NAME. IF1034.2 +079800 PERFORM PRINT-DETAIL. IF1034.2 +079900*****************TEST (o) - COMPLEX TEST**************** IF1034.2 +080000 F-ASIN-26. IF1034.2 +080100 MOVE ZERO TO WS-NUM. IF1034.2 +080200 MOVE 1.28695 TO MIN-RANGE. IF1034.2 +080300 MOVE 1.28705 TO MAX-RANGE. IF1034.2 +080400 F-ASIN-TEST-26. IF1034.2 +080500 COMPUTE WS-NUM = FUNCTION ASIN(0.6) + IF1034.2 +080600 FUNCTION ASIN(0.6). IF1034.2 +080700 IF (WS-NUM >= MIN-RANGE) AND IF1034.2 +080800 (WS-NUM <= MAX-RANGE) THEN IF1034.2 +080900 PERFORM PASS IF1034.2 +081000 ELSE IF1034.2 +081100 MOVE WS-NUM TO COMPUTED-N IF1034.2 +081200 MOVE MIN-RANGE TO CORRECT-MIN IF1034.2 +081300 MOVE MAX-RANGE TO CORRECT-MAX IF1034.2 +081400 PERFORM FAIL. IF1034.2 +081500 GO TO F-ASIN-WRITE-26. IF1034.2 +081600 F-ASIN-DELETE-26. IF1034.2 +081700 PERFORM DE-LETE. IF1034.2 +081800 GO TO F-ASIN-WRITE-26. IF1034.2 +081900 F-ASIN-WRITE-26. IF1034.2 +082000 MOVE "F-ASIN-26" TO PAR-NAME. IF1034.2 +082100 PERFORM PRINT-DETAIL. IF1034.2 +082200*****************SPECIAL PERFORM TEST********************** IF1034.2 +082300 F-ASIN-27. IF1034.2 +082400 MOVE ZERO TO WS-NUM. IF1034.2 +082500 PERFORM F-ASIN-TEST-27 IF1034.2 +082600 UNTIL FUNCTION ASIN(ARG1) < 0. IF1034.2 +082700 PERFORM PASS. IF1034.2 +082800 GO TO F-ASIN-WRITE-27. IF1034.2 +082900 F-ASIN-TEST-27. IF1034.2 +083000 COMPUTE ARG1 = ARG1 - 0.25. IF1034.2 +083100 F-ASIN-DELETE-27. IF1034.2 +083200 PERFORM DE-LETE. IF1034.2 +083300 GO TO F-ASIN-WRITE-27. IF1034.2 +083400 F-ASIN-WRITE-27. IF1034.2 +083500 MOVE "F-ASIN-27" TO PAR-NAME. IF1034.2 +083600 PERFORM PRINT-DETAIL. IF1034.2 +083700********************END OF TESTS*************** IF1034.2 +083800 CCVS-EXIT SECTION. IF1034.2 +083900 CCVS-999999. IF1034.2 +084000 GO TO CLOSE-FILES. IF1034.2 diff --git a/tests/cobol85/IF/IF104A.CBL b/tests/cobol85/IF/IF104A.CBL new file mode 100755 index 00000000..9acc560f --- /dev/null +++ b/tests/cobol85/IF/IF104A.CBL @@ -0,0 +1,927 @@ +000100 IDENTIFICATION DIVISION. IF1044.2 +000200 PROGRAM-ID. IF1044.2 +000300 IF104A. IF1044.2 +000400 IF1044.2 +000500*********************************************************** IF1044.2 +000600* * IF1044.2 +000700* This program is intended to form part of the CCVS85 * IF1044.2 +000800* COBOL Test Suite. It contains tests for the * IF1044.2 +000900* Intrinsic Function ATAN. * IF1044.2 +001000* * IF1044.2 +001100*********************************************************** IF1044.2 +001200 ENVIRONMENT DIVISION. IF1044.2 +001300 CONFIGURATION SECTION. IF1044.2 +001400 SOURCE-COMPUTER. IF1044.2 +001500 Linux. IF1044.2 +001600 OBJECT-COMPUTER. IF1044.2 +001700 Linux. IF1044.2 +001800 INPUT-OUTPUT SECTION. IF1044.2 +001900 FILE-CONTROL. IF1044.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1044.2 +002100 "report.log". IF1044.2 +002200 DATA DIVISION. IF1044.2 +002300 FILE SECTION. IF1044.2 +002400 FD PRINT-FILE. IF1044.2 +002500 01 PRINT-REC PICTURE X(120). IF1044.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1044.2 +002700 WORKING-STORAGE SECTION. IF1044.2 +002800*********************************************************** IF1044.2 +002900* Variables specific to the Intrinsic Function Test IF104A* IF1044.2 +003000*********************************************************** IF1044.2 +003100 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1044.2 +003200 01 B PIC S9(10) VALUE 2. IF1044.2 +003300 01 C PIC S9(10) VALUE 100000. IF1044.2 +003400 01 D PIC S9(10) VALUE 1000. IF1044.2 +003500 01 PI PIC S9V9(17) VALUE 3.141592654. IF1044.2 +003600 01 ARG1 PIC S9V9(17) VALUE 1.00. IF1044.2 +003700 01 SQRT3 PIC S9V9(17) VALUE 1.732050808. IF1044.2 +003800 01 ARR VALUE "40537". IF1044.2 +003900 02 IND OCCURS 5 TIMES PIC 9. IF1044.2 +004000 01 TEMP PIC S9(5)V9(5). IF1044.2 +004100 01 WS-NUM PIC S9(5)V9(6). IF1044.2 +004200 01 MIN-RANGE PIC S9(5)V9(7). IF1044.2 +004300 01 MAX-RANGE PIC S9(5)V9(7). IF1044.2 +004400* IF1044.2 +004500********************************************************** IF1044.2 +004600* IF1044.2 +004700 01 TEST-RESULTS. IF1044.2 +004800 02 FILLER PIC X VALUE SPACE. IF1044.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1044.2 +005000 02 FILLER PIC X VALUE SPACE. IF1044.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1044.2 +005200 02 FILLER PIC X VALUE SPACE. IF1044.2 +005300 02 PAR-NAME. IF1044.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1044.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1044.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1044.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1044.2 +005800 02 RE-MARK PIC X(61). IF1044.2 +005900 01 TEST-COMPUTED. IF1044.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1044.2 +006100 02 FILLER PIC X(17) VALUE IF1044.2 +006200 " COMPUTED=". IF1044.2 +006300 02 COMPUTED-X. IF1044.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1044.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1044.2 +006600 PIC -9(9).9(9). IF1044.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1044.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1044.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1044.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1044.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1044.2 +007200 04 FILLER PIC X. IF1044.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1044.2 +007400 01 TEST-CORRECT. IF1044.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1044.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1044.2 +007700 02 CORRECT-X. IF1044.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1044.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1044.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1044.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1044.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1044.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1044.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1044.2 +008500 04 FILLER PIC X. IF1044.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1044.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1044.2 +008800 01 TEST-CORRECT-MIN. IF1044.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1044.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1044.2 +009100 02 CORRECTMI-X. IF1044.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1044.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1044.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1044.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1044.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1044.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1044.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1044.2 +009900 04 FILLER PIC X. IF1044.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1044.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1044.2 +010200 01 TEST-CORRECT-MAX. IF1044.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1044.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1044.2 +010500 02 CORRECTMA-X. IF1044.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1044.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1044.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1044.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1044.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1044.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1044.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1044.2 +011300 04 FILLER PIC X. IF1044.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1044.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1044.2 +011600 01 CCVS-C-1. IF1044.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1044.2 +011800- "SS PARAGRAPH-NAME IF1044.2 +011900- " REMARKS". IF1044.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1044.2 +012100 01 CCVS-C-2. IF1044.2 +012200 02 FILLER PIC X VALUE SPACE. IF1044.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1044.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1044.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1044.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1044.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1044.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1044.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1044.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1044.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1044.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1044.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1044.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1044.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1044.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1044.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1044.2 +013800 01 CCVS-H-1. IF1044.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1044.2 +014000 02 FILLER PIC X(42) VALUE IF1044.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1044.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1044.2 +014300 01 CCVS-H-2A. IF1044.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1044.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1044.2 +014600 02 FILLER PIC XXXX VALUE IF1044.2 +014700 "4.2 ". IF1044.2 +014800 02 FILLER PIC X(28) VALUE IF1044.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1044.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1044.2 +015100 IF1044.2 +015200 01 CCVS-H-2B. IF1044.2 +015300 02 FILLER PIC X(15) VALUE IF1044.2 +015400 "TEST RESULT OF ". IF1044.2 +015500 02 TEST-ID PIC X(9). IF1044.2 +015600 02 FILLER PIC X(4) VALUE IF1044.2 +015700 " IN ". IF1044.2 +015800 02 FILLER PIC X(12) VALUE IF1044.2 +015900 " HIGH ". IF1044.2 +016000 02 FILLER PIC X(22) VALUE IF1044.2 +016100 " LEVEL VALIDATION FOR ". IF1044.2 +016200 02 FILLER PIC X(58) VALUE IF1044.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1044.2 +016400 01 CCVS-H-3. IF1044.2 +016500 02 FILLER PIC X(34) VALUE IF1044.2 +016600 " FOR OFFICIAL USE ONLY ". IF1044.2 +016700 02 FILLER PIC X(58) VALUE IF1044.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1044.2 +016900 02 FILLER PIC X(28) VALUE IF1044.2 +017000 " COPYRIGHT 1985 ". IF1044.2 +017100 01 CCVS-E-1. IF1044.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1044.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1044.2 +017400 02 ID-AGAIN PIC X(9). IF1044.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1044.2 +017600 01 CCVS-E-2. IF1044.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1044.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1044.2 +017900 02 CCVS-E-2-2. IF1044.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1044.2 +018100 03 FILLER PIC X VALUE SPACE. IF1044.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1044.2 +018300 "ERRORS ENCOUNTERED". IF1044.2 +018400 01 CCVS-E-3. IF1044.2 +018500 02 FILLER PIC X(22) VALUE IF1044.2 +018600 " FOR OFFICIAL USE ONLY". IF1044.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1044.2 +018800 02 FILLER PIC X(58) VALUE IF1044.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1044.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1044.2 +019100 02 FILLER PIC X(15) VALUE IF1044.2 +019200 " COPYRIGHT 1985". IF1044.2 +019300 01 CCVS-E-4. IF1044.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1044.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1044.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1044.2 +019700 02 FILLER PIC X(40) VALUE IF1044.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1044.2 +019900 01 XXINFO. IF1044.2 +020000 02 FILLER PIC X(19) VALUE IF1044.2 +020100 "*** INFORMATION ***". IF1044.2 +020200 02 INFO-TEXT. IF1044.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1044.2 +020400 04 XXCOMPUTED PIC X(20). IF1044.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1044.2 +020600 04 XXCORRECT PIC X(20). IF1044.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1044.2 +020800 01 HYPHEN-LINE. IF1044.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1044.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1044.2 +021100- "*****************************************". IF1044.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1044.2 +021300- "******************************". IF1044.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1044.2 +021500 "IF104A". IF1044.2 +021600 PROCEDURE DIVISION. IF1044.2 +021700 CCVS1 SECTION. IF1044.2 +021800 OPEN-FILES. IF1044.2 +021900 OPEN OUTPUT PRINT-FILE. IF1044.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1044.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1044.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1044.2 +022300 GO TO CCVS1-EXIT. IF1044.2 +022400 CLOSE-FILES. IF1044.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1044.2 +022600 TERMINATE-CCVS. IF1044.2 +022700 STOP RUN. IF1044.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1044.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1044.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1044.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1044.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1044.2 +023300 PRINT-DETAIL. IF1044.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1044.2 +023500 MOVE "." TO PARDOT-X IF1044.2 +023600 MOVE REC-CT TO DOTVALUE. IF1044.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1044.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1044.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1044.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1044.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1044.2 +024200 MOVE SPACE TO CORRECT-X. IF1044.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1044.2 +024400 MOVE SPACE TO RE-MARK. IF1044.2 +024500 HEAD-ROUTINE. IF1044.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1044.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1044.2 +025000 COLUMN-NAMES-ROUTINE. IF1044.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +025400 END-ROUTINE. IF1044.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1044.2 +025600 END-RTN-EXIT. IF1044.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +025800 END-ROUTINE-1. IF1044.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1044.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1044.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1044.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1044.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1044.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1044.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1044.2 +026600 END-ROUTINE-12. IF1044.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1044.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1044.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1044.2 +027000 ELSE IF1044.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1044.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1044.2 +027300 PERFORM WRITE-LINE. IF1044.2 +027400 END-ROUTINE-13. IF1044.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1044.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1044.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1044.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1044.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1044.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1044.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1044.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1044.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1044.2 +028600 WRITE-LINE. IF1044.2 +028700 ADD 1 TO RECORD-COUNT. IF1044.2 +028800 IF RECORD-COUNT GREATER 42 IF1044.2 +028900 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1044.2 +029000 MOVE SPACE TO DUMMY-RECORD IF1044.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1044.2 +029200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1044.2 +029300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1044.2 +029400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1044.2 +029500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1044.2 +029600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1044.2 +029700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1044.2 +029800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1044.2 +029900 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1044.2 +030000 MOVE ZERO TO RECORD-COUNT. IF1044.2 +030100 PERFORM WRT-LN. IF1044.2 +030200 WRT-LN. IF1044.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1044.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1044.2 +030500 BLANK-LINE-PRINT. IF1044.2 +030600 PERFORM WRT-LN. IF1044.2 +030700 FAIL-ROUTINE. IF1044.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1044.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1044.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1044.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1044.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1044.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1044.2 +031500 GO TO FAIL-ROUTINE-EX. IF1044.2 +031600 FAIL-ROUTINE-WRITE. IF1044.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1044.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1044.2 +031900 CORMA-ANSI-REFERENCE. IF1044.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1044.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1044.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1044.2 +032300 ELSE IF1044.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1044.2 +032500 PERFORM WRITE-LINE. IF1044.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1044.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1044.2 +032800 BAIL-OUT. IF1044.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1044.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1044.2 +033100 BAIL-OUT-WRITE. IF1044.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1044.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1044.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1044.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1044.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1044.2 +033700 BAIL-OUT-EX. EXIT. IF1044.2 +033800 CCVS1-EXIT. IF1044.2 +033900 EXIT. IF1044.2 +034000******************************************************** IF1044.2 +034100* * IF1044.2 +034200* Intrinsic Function Tests IF104A - ATAN * IF1044.2 +034300* * IF1044.2 +034400******************************************************** IF1044.2 +034500 SECT-IF104A SECTION. IF1044.2 +034600 F-ATAN-INFO. IF1044.2 +034700 MOVE "See ref. A-36 2.8" TO ANSI-REFERENCE. IF1044.2 +034800 MOVE "ATAN Function" TO FEATURE. IF1044.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1044.2 +035000 F-ATAN-01. IF1044.2 +035100 MOVE ZERO TO WS-NUM. IF1044.2 +035200 MOVE 0.785382 TO MIN-RANGE. IF1044.2 +035300 MOVE 0.785414 TO MAX-RANGE. IF1044.2 +035400 F-ATAN-TEST-01. IF1044.2 +035500 COMPUTE WS-NUM = FUNCTION ATAN(1.0). IF1044.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +035800 PERFORM PASS IF1044.2 +035900 ELSE IF1044.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1044.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +036300 PERFORM FAIL. IF1044.2 +036400 GO TO F-ATAN-WRITE-01. IF1044.2 +036500 F-ATAN-DELETE-01. IF1044.2 +036600 PERFORM DE-LETE. IF1044.2 +036700 GO TO F-ATAN-WRITE-01. IF1044.2 +036800 F-ATAN-WRITE-01. IF1044.2 +036900 MOVE "F-ATAN-01" TO PAR-NAME. IF1044.2 +037000 PERFORM PRINT-DETAIL. IF1044.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1044.2 +037200 F-ATAN-02. IF1044.2 +037300 EVALUATE FUNCTION ATAN(0.5) IF1044.2 +037400 WHEN 0.463638 THRU 0.463656 IF1044.2 +037500 PERFORM PASS IF1044.2 +037600 WHEN OTHER IF1044.2 +037700 PERFORM FAIL. IF1044.2 +037800 GO TO F-ATAN-WRITE-02. IF1044.2 +037900 F-ATAN-DELETE-02. IF1044.2 +038000 PERFORM DE-LETE. IF1044.2 +038100 GO TO F-ATAN-WRITE-02. IF1044.2 +038200 F-ATAN-WRITE-02. IF1044.2 +038300 MOVE "F-ATAN-02" TO PAR-NAME. IF1044.2 +038400 PERFORM PRINT-DETAIL. IF1044.2 +038500*****************TEST (c) - SIMPLE TEST***************** IF1044.2 +038600 F-ATAN-03. IF1044.2 +038700 MOVE -0.000020 TO MIN-RANGE. IF1044.2 +038800 MOVE 0.000020 TO MAX-RANGE. IF1044.2 +038900 F-ATAN-TEST-03. IF1044.2 +039000 IF (FUNCTION ATAN(0) >= MIN-RANGE) AND IF1044.2 +039100 (FUNCTION ATAN(0) <= MAX-RANGE) THEN IF1044.2 +039200 PERFORM PASS IF1044.2 +039300 ELSE IF1044.2 +039400 PERFORM FAIL. IF1044.2 +039500 GO TO F-ATAN-WRITE-03. IF1044.2 +039600 F-ATAN-DELETE-03. IF1044.2 +039700 PERFORM DE-LETE. IF1044.2 +039800 GO TO F-ATAN-WRITE-03. IF1044.2 +039900 F-ATAN-WRITE-03. IF1044.2 +040000 MOVE "F-ATAN-03" TO PAR-NAME. IF1044.2 +040100 PERFORM PRINT-DETAIL. IF1044.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1044.2 +040300 F-ATAN-04. IF1044.2 +040400 MOVE ZERO TO WS-NUM. IF1044.2 +040500 MOVE -0.785414 TO MIN-RANGE. IF1044.2 +040600 MOVE -0.785382 TO MAX-RANGE. IF1044.2 +040700 F-ATAN-TEST-04. IF1044.2 +040800 COMPUTE WS-NUM = FUNCTION ATAN(-1). IF1044.2 +040900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +041000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +041100 PERFORM PASS IF1044.2 +041200 ELSE IF1044.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +041400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +041500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +041600 PERFORM FAIL. IF1044.2 +041700 GO TO F-ATAN-WRITE-04. IF1044.2 +041800 F-ATAN-DELETE-04. IF1044.2 +041900 PERFORM DE-LETE. IF1044.2 +042000 GO TO F-ATAN-WRITE-04. IF1044.2 +042100 F-ATAN-WRITE-04. IF1044.2 +042200 MOVE "F-ATAN-04" TO PAR-NAME. IF1044.2 +042300 PERFORM PRINT-DETAIL. IF1044.2 +042400*****************TEST (e) - SIMPLE TEST***************** IF1044.2 +042500 F-ATAN-05. IF1044.2 +042600 MOVE ZERO TO WS-NUM. IF1044.2 +042700 MOVE 0.784881 TO MIN-RANGE. IF1044.2 +042800 MOVE 0.784913 TO MAX-RANGE. IF1044.2 +042900 F-ATAN-TEST-05. IF1044.2 +043000 COMPUTE WS-NUM = FUNCTION ATAN(.999). IF1044.2 +043100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +043200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +043300 PERFORM PASS IF1044.2 +043400 ELSE IF1044.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +043600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +043700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +043800 PERFORM FAIL. IF1044.2 +043900 GO TO F-ATAN-WRITE-05. IF1044.2 +044000 F-ATAN-DELETE-05. IF1044.2 +044100 PERFORM DE-LETE. IF1044.2 +044200 GO TO F-ATAN-WRITE-05. IF1044.2 +044300 F-ATAN-WRITE-05. IF1044.2 +044400 MOVE "F-ATAN-05" TO PAR-NAME. IF1044.2 +044500 PERFORM PRINT-DETAIL. IF1044.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1044.2 +044700 F-ATAN-06. IF1044.2 +044800 MOVE ZERO TO WS-NUM. IF1044.2 +044900 MOVE 0.048959 TO MIN-RANGE. IF1044.2 +045000 MOVE 0.048961 TO MAX-RANGE. IF1044.2 +045100 F-ATAN-TEST-06. IF1044.2 +045200 COMPUTE WS-NUM = FUNCTION ATAN(.049). IF1044.2 +045300 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +045400 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +045500 PERFORM PASS IF1044.2 +045600 ELSE IF1044.2 +045700 MOVE WS-NUM TO COMPUTED-N IF1044.2 +045800 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +045900 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +046000 PERFORM FAIL. IF1044.2 +046100 GO TO F-ATAN-WRITE-06. IF1044.2 +046200 F-ATAN-DELETE-06. IF1044.2 +046300 PERFORM DE-LETE. IF1044.2 +046400 GO TO F-ATAN-WRITE-06. IF1044.2 +046500 F-ATAN-WRITE-06. IF1044.2 +046600 MOVE "F-ATAN-06" TO PAR-NAME. IF1044.2 +046700 PERFORM PRINT-DETAIL. IF1044.2 +046800*****************TEST (g) - SIMPLE TEST***************** IF1044.2 +046900 F-ATAN-07. IF1044.2 +047000 MOVE ZERO TO WS-NUM. IF1044.2 +047100 MOVE -0.000040 TO MIN-RANGE. IF1044.2 +047200 MOVE -0.000039 TO MAX-RANGE. IF1044.2 +047300 F-ATAN-TEST-07. IF1044.2 +047400 COMPUTE WS-NUM = FUNCTION ATAN(A). IF1044.2 +047500 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +047600 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +047700 PERFORM PASS IF1044.2 +047800 ELSE IF1044.2 +047900 MOVE WS-NUM TO COMPUTED-N IF1044.2 +048000 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +048100 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +048200 PERFORM FAIL. IF1044.2 +048300 GO TO F-ATAN-WRITE-07. IF1044.2 +048400 F-ATAN-DELETE-07. IF1044.2 +048500 PERFORM DE-LETE. IF1044.2 +048600 GO TO F-ATAN-WRITE-07. IF1044.2 +048700 F-ATAN-WRITE-07. IF1044.2 +048800 MOVE "F-ATAN-07" TO PAR-NAME. IF1044.2 +048900 PERFORM PRINT-DETAIL. IF1044.2 +049000*****************TEST (h) - SIMPLE TEST***************** IF1044.2 +049100 F-ATAN-08. IF1044.2 +049200 MOVE ZERO TO WS-NUM. IF1044.2 +049300 MOVE 0.000019 TO MIN-RANGE. IF1044.2 +049400 MOVE 0.000020 TO MAX-RANGE. IF1044.2 +049500 F-ATAN-TEST-08. IF1044.2 +049600 COMPUTE WS-NUM = FUNCTION ATAN(.00002). IF1044.2 +049700 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +049800 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +049900 PERFORM PASS IF1044.2 +050000 ELSE IF1044.2 +050100 MOVE WS-NUM TO COMPUTED-N IF1044.2 +050200 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +050300 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +050400 PERFORM FAIL. IF1044.2 +050500 GO TO F-ATAN-WRITE-08. IF1044.2 +050600 F-ATAN-DELETE-08. IF1044.2 +050700 PERFORM DE-LETE. IF1044.2 +050800 GO TO F-ATAN-WRITE-08. IF1044.2 +050900 F-ATAN-WRITE-08. IF1044.2 +051000 MOVE "F-ATAN-08" TO PAR-NAME. IF1044.2 +051100 PERFORM PRINT-DETAIL. IF1044.2 +051200*****************TEST (i) - SIMPLE TEST***************** IF1044.2 +051300 F-ATAN-09. IF1044.2 +051400 MOVE ZERO TO WS-NUM. IF1044.2 +051500 MOVE -0.000020 TO MIN-RANGE. IF1044.2 +051600 MOVE 0.000020 TO MAX-RANGE. IF1044.2 +051700 F-ATAN-TEST-09. IF1044.2 +051800 COMPUTE WS-NUM = FUNCTION ATAN(IND(B)). IF1044.2 +051900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +052000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +052100 PERFORM PASS IF1044.2 +052200 ELSE IF1044.2 +052300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +052400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +052500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +052600 PERFORM FAIL. IF1044.2 +052700 GO TO F-ATAN-WRITE-09. IF1044.2 +052800 F-ATAN-DELETE-09. IF1044.2 +052900 PERFORM DE-LETE. IF1044.2 +053000 GO TO F-ATAN-WRITE-09. IF1044.2 +053100 F-ATAN-WRITE-09. IF1044.2 +053200 MOVE "F-ATAN-09" TO PAR-NAME. IF1044.2 +053300 PERFORM PRINT-DETAIL. IF1044.2 +053400*****************TEST (a) - COMPLEX TEST**************** IF1044.2 +053500 F-ATAN-10. IF1044.2 +053600 MOVE ZERO TO WS-NUM. IF1044.2 +053700 MOVE 0.523577 TO MIN-RANGE. IF1044.2 +053800 MOVE 0.523619 TO MAX-RANGE. IF1044.2 +053900 F-ATAN-TEST-10. IF1044.2 +054000 COMPUTE WS-NUM = FUNCTION ATAN(1 / SQRT3). IF1044.2 +054100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +054200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +054300 PERFORM PASS IF1044.2 +054400 ELSE IF1044.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +054600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +054700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +054800 PERFORM FAIL. IF1044.2 +054900 GO TO F-ATAN-WRITE-10. IF1044.2 +055000 F-ATAN-DELETE-10. IF1044.2 +055100 PERFORM DE-LETE. IF1044.2 +055200 GO TO F-ATAN-WRITE-10. IF1044.2 +055300 F-ATAN-WRITE-10. IF1044.2 +055400 MOVE "F-ATAN-10" TO PAR-NAME. IF1044.2 +055500 PERFORM PRINT-DETAIL. IF1044.2 +055600*****************TEST (b) - COMPLEX TEST**************** IF1044.2 +055700 F-ATAN-11. IF1044.2 +055800 MOVE ZERO TO WS-NUM. IF1044.2 +055900 MOVE 1.04715 TO MIN-RANGE. IF1044.2 +056000 MOVE 1.04723 TO MAX-RANGE. IF1044.2 +056100 F-ATAN-TEST-11. IF1044.2 +056200 COMPUTE WS-NUM = FUNCTION ATAN(SQRT3). IF1044.2 +056300 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +056400 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +056500 PERFORM PASS IF1044.2 +056600 ELSE IF1044.2 +056700 MOVE WS-NUM TO COMPUTED-N IF1044.2 +056800 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +056900 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +057000 PERFORM FAIL. IF1044.2 +057100 GO TO F-ATAN-WRITE-11. IF1044.2 +057200 F-ATAN-DELETE-11. IF1044.2 +057300 PERFORM DE-LETE. IF1044.2 +057400 GO TO F-ATAN-WRITE-11. IF1044.2 +057500 F-ATAN-WRITE-11. IF1044.2 +057600 MOVE "F-ATAN-11" TO PAR-NAME. IF1044.2 +057700 PERFORM PRINT-DETAIL. IF1044.2 +057800*****************TEST (c) - COMPLEX TEST**************** IF1044.2 +057900 F-ATAN-12. IF1044.2 +058000 MOVE ZERO TO WS-NUM. IF1044.2 +058100 MOVE 1.04690 TO MIN-RANGE. IF1044.2 +058200 MOVE 1.04698 TO MAX-RANGE. IF1044.2 +058300 F-ATAN-TEST-12. IF1044.2 +058400 COMPUTE WS-NUM = FUNCTION ATAN(SQRT3 - .001). IF1044.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +058700 PERFORM PASS IF1044.2 +058800 ELSE IF1044.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1044.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +059200 PERFORM FAIL. IF1044.2 +059300 GO TO F-ATAN-WRITE-12. IF1044.2 +059400 F-ATAN-DELETE-12. IF1044.2 +059500 PERFORM DE-LETE. IF1044.2 +059600 GO TO F-ATAN-WRITE-12. IF1044.2 +059700 F-ATAN-WRITE-12. IF1044.2 +059800 MOVE "F-ATAN-12" TO PAR-NAME. IF1044.2 +059900 PERFORM PRINT-DETAIL. IF1044.2 +060000*****************TEST (d) - COMPLEX TEST**************** IF1044.2 +060100 F-ATAN-13. IF1044.2 +060200 MOVE ZERO TO WS-NUM. IF1044.2 +060300 MOVE 0.522827 TO MIN-RANGE. IF1044.2 +060400 MOVE 0.522869 TO MAX-RANGE. IF1044.2 +060500 F-ATAN-TEST-13. IF1044.2 +060600 COMPUTE WS-NUM = FUNCTION ATAN((1 / SQRT3) - .001). IF1044.2 +060700 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +060800 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +060900 PERFORM PASS IF1044.2 +061000 ELSE IF1044.2 +061100 MOVE WS-NUM TO COMPUTED-N IF1044.2 +061200 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +061300 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +061400 PERFORM FAIL. IF1044.2 +061500 GO TO F-ATAN-WRITE-13. IF1044.2 +061600 F-ATAN-DELETE-13. IF1044.2 +061700 PERFORM DE-LETE. IF1044.2 +061800 GO TO F-ATAN-WRITE-13. IF1044.2 +061900 F-ATAN-WRITE-13. IF1044.2 +062000 MOVE "F-ATAN-13" TO PAR-NAME. IF1044.2 +062100 PERFORM PRINT-DETAIL. IF1044.2 +062200*****************TEST (e) - COMPLEX TEST**************** IF1044.2 +062300 F-ATAN-14. IF1044.2 +062400 MOVE ZERO TO WS-NUM. IF1044.2 +062500 MOVE -0.010000 TO MIN-RANGE. IF1044.2 +062600 MOVE -0.009998 TO MAX-RANGE. IF1044.2 +062700 F-ATAN-TEST-14. IF1044.2 +062800 COMPUTE WS-NUM = FUNCTION ATAN( 1 - 1.01). IF1044.2 +062900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +063000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +063100 PERFORM PASS IF1044.2 +063200 ELSE IF1044.2 +063300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +063400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +063500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +063600 PERFORM FAIL. IF1044.2 +063700 GO TO F-ATAN-WRITE-14. IF1044.2 +063800 F-ATAN-DELETE-14. IF1044.2 +063900 PERFORM DE-LETE. IF1044.2 +064000 GO TO F-ATAN-WRITE-14. IF1044.2 +064100 F-ATAN-WRITE-14. IF1044.2 +064200 MOVE "F-ATAN-14" TO PAR-NAME. IF1044.2 +064300 PERFORM PRINT-DETAIL. IF1044.2 +064400*****************TEST (f) - COMPLEX TEST**************** IF1044.2 +064500 F-ATAN-15. IF1044.2 +064600 MOVE ZERO TO WS-NUM. IF1044.2 +064700 MOVE 0.780342 TO MIN-RANGE. IF1044.2 +064800 MOVE 0.780404 TO MAX-RANGE. IF1044.2 +064900 F-ATAN-TEST-15. IF1044.2 +065000 COMPUTE WS-NUM = FUNCTION ATAN(1.98 / 2). IF1044.2 +065100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +065200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +065300 PERFORM PASS IF1044.2 +065400 ELSE IF1044.2 +065500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +065600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +065700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +065800 PERFORM FAIL. IF1044.2 +065900 GO TO F-ATAN-WRITE-15. IF1044.2 +066000 F-ATAN-DELETE-15. IF1044.2 +066100 PERFORM DE-LETE. IF1044.2 +066200 GO TO F-ATAN-WRITE-15. IF1044.2 +066300 F-ATAN-WRITE-15. IF1044.2 +066400 MOVE "F-ATAN-15" TO PAR-NAME. IF1044.2 +066500 PERFORM PRINT-DETAIL. IF1044.2 +066600*****************TEST (g) - COMPLEX TEST**************** IF1044.2 +066700 F-ATAN-16. IF1044.2 +066800 MOVE ZERO TO WS-NUM. IF1044.2 +066900 MOVE 1.04964 TO MIN-RANGE. IF1044.2 +067000 MOVE 1.04972 TO MAX-RANGE. IF1044.2 +067100 F-ATAN-TEST-16. IF1044.2 +067200 COMPUTE WS-NUM = FUNCTION ATAN(SQRT3 + .01). IF1044.2 +067300 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +067400 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +067500 PERFORM PASS IF1044.2 +067600 ELSE IF1044.2 +067700 MOVE WS-NUM TO COMPUTED-N IF1044.2 +067800 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +067900 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +068000 PERFORM FAIL. IF1044.2 +068100 GO TO F-ATAN-WRITE-16. IF1044.2 +068200 F-ATAN-DELETE-16. IF1044.2 +068300 PERFORM DE-LETE. IF1044.2 +068400 GO TO F-ATAN-WRITE-16. IF1044.2 +068500 F-ATAN-WRITE-16. IF1044.2 +068600 MOVE "F-ATAN-16" TO PAR-NAME. IF1044.2 +068700 PERFORM PRINT-DETAIL. IF1044.2 +068800*****************TEST (h) - COMPLEX TEST**************** IF1044.2 +068900 F-ATAN-17. IF1044.2 +069000 MOVE ZERO TO WS-NUM. IF1044.2 +069100 MOVE 0.531045 TO MIN-RANGE. IF1044.2 +069200 MOVE 0.531087 TO MAX-RANGE. IF1044.2 +069300 F-ATAN-TEST-17. IF1044.2 +069400 COMPUTE WS-NUM = FUNCTION ATAN((1 / SQRT3) + .01). IF1044.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +069700 PERFORM PASS IF1044.2 +069800 ELSE IF1044.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1044.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +070200 PERFORM FAIL. IF1044.2 +070300 GO TO F-ATAN-WRITE-17. IF1044.2 +070400 F-ATAN-DELETE-17. IF1044.2 +070500 PERFORM DE-LETE. IF1044.2 +070600 GO TO F-ATAN-WRITE-17. IF1044.2 +070700 F-ATAN-WRITE-17. IF1044.2 +070800 MOVE "F-ATAN-17" TO PAR-NAME. IF1044.2 +070900 PERFORM PRINT-DETAIL. IF1044.2 +071000*****************TEST (i) - COMPLEX TEST**************** IF1044.2 +071100 F-ATAN-18. IF1044.2 +071200 MOVE ZERO TO WS-NUM. IF1044.2 +071300 MOVE 1.19023 TO MIN-RANGE. IF1044.2 +071400 MOVE 1.19033 TO MAX-RANGE. IF1044.2 +071500 F-ATAN-TEST-18. IF1044.2 +071600 COMPUTE WS-NUM = FUNCTION ATAN(IND(3) / B). IF1044.2 +071700 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +071800 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +071900 PERFORM PASS IF1044.2 +072000 ELSE IF1044.2 +072100 MOVE WS-NUM TO COMPUTED-N IF1044.2 +072200 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +072300 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +072400 PERFORM FAIL. IF1044.2 +072500 GO TO F-ATAN-WRITE-18. IF1044.2 +072600 F-ATAN-DELETE-18. IF1044.2 +072700 PERFORM DE-LETE. IF1044.2 +072800 GO TO F-ATAN-WRITE-18. IF1044.2 +072900 F-ATAN-WRITE-18. IF1044.2 +073000 MOVE "F-ATAN-18" TO PAR-NAME. IF1044.2 +073100 PERFORM PRINT-DETAIL. IF1044.2 +073200*****************TEST (j) - COMPLEX TEST**************** IF1044.2 +073300 F-ATAN-19. IF1044.2 +073400 MOVE ZERO TO WS-NUM. IF1044.2 +073500 MOVE 0.785367 TO MIN-RANGE. IF1044.2 +073600 MOVE 0.785429 TO MAX-RANGE. IF1044.2 +073700 F-ATAN-TEST-19. IF1044.2 +073800 COMPUTE WS-NUM = FUNCTION ATAN(4 - 3). IF1044.2 +073900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +074000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +074100 PERFORM PASS IF1044.2 +074200 ELSE IF1044.2 +074300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +074400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +074500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +074600 PERFORM FAIL. IF1044.2 +074700 GO TO F-ATAN-WRITE-19. IF1044.2 +074800 F-ATAN-DELETE-19. IF1044.2 +074900 PERFORM DE-LETE. IF1044.2 +075000 GO TO F-ATAN-WRITE-19. IF1044.2 +075100 F-ATAN-WRITE-19. IF1044.2 +075200 MOVE "F-ATAN-19" TO PAR-NAME. IF1044.2 +075300 PERFORM PRINT-DETAIL. IF1044.2 +075400*****************TEST (k) - COMPLEX TEST**************** IF1044.2 +075500 F-ATAN-20. IF1044.2 +075600 MOVE ZERO TO WS-NUM. IF1044.2 +075700 MOVE -0.000040 TO MIN-RANGE. IF1044.2 +075800 MOVE 0.000040 TO MAX-RANGE. IF1044.2 +075900 F-ATAN-TEST-20. IF1044.2 +076000 COMPUTE WS-NUM = FUNCTION ATAN(C - C). IF1044.2 +076100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +076200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +076300 PERFORM PASS IF1044.2 +076400 ELSE IF1044.2 +076500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +076600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +076700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +076800 PERFORM FAIL. IF1044.2 +076900 GO TO F-ATAN-WRITE-20. IF1044.2 +077000 F-ATAN-DELETE-20. IF1044.2 +077100 PERFORM DE-LETE. IF1044.2 +077200 GO TO F-ATAN-WRITE-20. IF1044.2 +077300 F-ATAN-WRITE-20. IF1044.2 +077400 MOVE "F-ATAN-20" TO PAR-NAME. IF1044.2 +077500 PERFORM PRINT-DETAIL. IF1044.2 +077600*****************TEST (l) - COMPLEX TEST**************** IF1044.2 +077700 F-ATAN-21. IF1044.2 +077800 MOVE ZERO TO WS-NUM. IF1044.2 +077900 MOVE 0.244968 TO MIN-RANGE. IF1044.2 +078000 MOVE 0.244988 TO MAX-RANGE. IF1044.2 +078100 F-ATAN-TEST-21. IF1044.2 +078200 COMPUTE WS-NUM = FUNCTION ATAN(0.25 * 1). IF1044.2 +078300 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +078400 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +078500 PERFORM PASS IF1044.2 +078600 ELSE IF1044.2 +078700 MOVE WS-NUM TO COMPUTED-N IF1044.2 +078800 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +078900 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +079000 PERFORM FAIL. IF1044.2 +079100 GO TO F-ATAN-WRITE-21. IF1044.2 +079200 F-ATAN-DELETE-21. IF1044.2 +079300 PERFORM DE-LETE. IF1044.2 +079400 GO TO F-ATAN-WRITE-21. IF1044.2 +079500 F-ATAN-WRITE-21. IF1044.2 +079600 MOVE "F-ATAN-21" TO PAR-NAME. IF1044.2 +079700 PERFORM PRINT-DETAIL. IF1044.2 +079800*****************TEST (m) - COMPLEX TEST**************** IF1044.2 +079900 F-ATAN-22. IF1044.2 +080000 MOVE ZERO TO WS-NUM. IF1044.2 +080100 MOVE 0.308157 TO MIN-RANGE. IF1044.2 +080200 MOVE 0.308181 TO MAX-RANGE. IF1044.2 +080300 F-ATAN-TEST-22. IF1044.2 +080400 COMPUTE WS-NUM = FUNCTION ATAN(1 / PI). IF1044.2 +080500 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +080600 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +080700 PERFORM PASS IF1044.2 +080800 ELSE IF1044.2 +080900 MOVE WS-NUM TO COMPUTED-N IF1044.2 +081000 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +081100 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +081200 PERFORM FAIL. IF1044.2 +081300 GO TO F-ATAN-WRITE-22. IF1044.2 +081400 F-ATAN-DELETE-22. IF1044.2 +081500 PERFORM DE-LETE. IF1044.2 +081600 GO TO F-ATAN-WRITE-22. IF1044.2 +081700 F-ATAN-WRITE-22. IF1044.2 +081800 MOVE "F-ATAN-22" TO PAR-NAME. IF1044.2 +081900 PERFORM PRINT-DETAIL. IF1044.2 +082000*****************TEST (n) - COMPLEX TEST**************** IF1044.2 +082100 F-ATAN-23. IF1044.2 +082200 MOVE ZERO TO WS-NUM. IF1044.2 +082300 MOVE -0.000040 TO MIN-RANGE. IF1044.2 +082400 MOVE 0.000040 TO MAX-RANGE. IF1044.2 +082500 F-ATAN-TEST-23. IF1044.2 +082600 COMPUTE WS-NUM = FUNCTION ATAN((D / D) - 1). IF1044.2 +082700 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +082800 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +082900 PERFORM PASS IF1044.2 +083000 ELSE IF1044.2 +083100 MOVE WS-NUM TO COMPUTED-N IF1044.2 +083200 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +083300 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +083400 PERFORM FAIL. IF1044.2 +083500 GO TO F-ATAN-WRITE-23. IF1044.2 +083600 F-ATAN-DELETE-23. IF1044.2 +083700 PERFORM DE-LETE. IF1044.2 +083800 GO TO F-ATAN-WRITE-23. IF1044.2 +083900 F-ATAN-WRITE-23. IF1044.2 +084000 MOVE "F-ATAN-23" TO PAR-NAME. IF1044.2 +084100 PERFORM PRINT-DETAIL. IF1044.2 +084200*****************TEST (o) - COMPLEX TEST**************** IF1044.2 +084300 F-ATAN-24. IF1044.2 +084400 MOVE ZERO TO WS-NUM. IF1044.2 +084500 MOVE -0.709382 TO MIN-RANGE. IF1044.2 +084600 MOVE -0.709326 TO MAX-RANGE. IF1044.2 +084700 F-ATAN-TEST-24. IF1044.2 +084800 COMPUTE WS-NUM = FUNCTION ATAN(PI - 4). IF1044.2 +084900 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +085000 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +085100 PERFORM PASS IF1044.2 +085200 ELSE IF1044.2 +085300 MOVE WS-NUM TO COMPUTED-N IF1044.2 +085400 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +085500 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +085600 PERFORM FAIL. IF1044.2 +085700 GO TO F-ATAN-WRITE-24. IF1044.2 +085800 F-ATAN-DELETE-24. IF1044.2 +085900 PERFORM DE-LETE. IF1044.2 +086000 GO TO F-ATAN-WRITE-24. IF1044.2 +086100 F-ATAN-WRITE-24. IF1044.2 +086200 MOVE "F-ATAN-24" TO PAR-NAME. IF1044.2 +086300 PERFORM PRINT-DETAIL. IF1044.2 +086400*****************TEST (p) - COMPLEX TEST**************** IF1044.2 +086500 F-ATAN-25. IF1044.2 +086600 MOVE ZERO TO WS-NUM. IF1044.2 +086700 MOVE 0.511215 TO MIN-RANGE. IF1044.2 +086800 MOVE 0.511255 TO MAX-RANGE. IF1044.2 +086900 F-ATAN-TEST-25. IF1044.2 +087000 COMPUTE WS-NUM = FUNCTION ATAN(FUNCTION ATAN(PI / 5)). IF1044.2 +087100 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +087200 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +087300 PERFORM PASS IF1044.2 +087400 ELSE IF1044.2 +087500 MOVE WS-NUM TO COMPUTED-N IF1044.2 +087600 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +087700 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +087800 PERFORM FAIL. IF1044.2 +087900 GO TO F-ATAN-WRITE-25. IF1044.2 +088000 F-ATAN-DELETE-25. IF1044.2 +088100 PERFORM DE-LETE. IF1044.2 +088200 GO TO F-ATAN-WRITE-25. IF1044.2 +088300 F-ATAN-WRITE-25. IF1044.2 +088400 MOVE "F-ATAN-25" TO PAR-NAME. IF1044.2 +088500 PERFORM PRINT-DETAIL. IF1044.2 +088600*****************TEST (q) - COMPLEX TEST**************** IF1044.2 +088700 F-ATAN-26. IF1044.2 +088800 MOVE ZERO TO WS-NUM. IF1044.2 +088900 MOVE -0.000040 TO MIN-RANGE. IF1044.2 +089000 MOVE 0.000040 TO MAX-RANGE. IF1044.2 +089100 F-ATAN-TEST-26. IF1044.2 +089200 COMPUTE WS-NUM = FUNCTION ATAN(0.6) + FUNCTION ATAN(-0.6). IF1044.2 +089300 IF1044.2 +089400 IF (WS-NUM >= MIN-RANGE) AND IF1044.2 +089500 (WS-NUM <= MAX-RANGE) THEN IF1044.2 +089600 PERFORM PASS IF1044.2 +089700 ELSE IF1044.2 +089800 MOVE WS-NUM TO COMPUTED-N IF1044.2 +089900 MOVE MIN-RANGE TO CORRECT-MIN IF1044.2 +090000 MOVE MAX-RANGE TO CORRECT-MAX IF1044.2 +090100 PERFORM FAIL. IF1044.2 +090200 GO TO F-ATAN-WRITE-26. IF1044.2 +090300 F-ATAN-DELETE-26. IF1044.2 +090400 PERFORM DE-LETE. IF1044.2 +090500 GO TO F-ATAN-WRITE-26. IF1044.2 +090600 F-ATAN-WRITE-26. IF1044.2 +090700 MOVE "F-ATAN-26" TO PAR-NAME. IF1044.2 +090800 PERFORM PRINT-DETAIL. IF1044.2 +090900*****************SPECIAL PERFORM TEST********************** IF1044.2 +091000 F-ATAN-27. IF1044.2 +091100 MOVE ZERO TO WS-NUM. IF1044.2 +091200 PERFORM F-ATAN-TEST-27 IF1044.2 +091300 UNTIL FUNCTION ATAN(ARG1) < 0. IF1044.2 +091400 PERFORM PASS. IF1044.2 +091500 GO TO F-ATAN-WRITE-27. IF1044.2 +091600 F-ATAN-TEST-27. IF1044.2 +091700 COMPUTE ARG1 = ARG1 - 0.25. IF1044.2 +091800 F-ATAN-DELETE-27. IF1044.2 +091900 PERFORM DE-LETE. IF1044.2 +092000 GO TO F-ATAN-WRITE-27. IF1044.2 +092100 F-ATAN-WRITE-27. IF1044.2 +092200 MOVE "F-ATAN-27" TO PAR-NAME. IF1044.2 +092300 PERFORM PRINT-DETAIL. IF1044.2 +092400********************END OF TESTS*************** IF1044.2 +092500 CCVS-EXIT SECTION. IF1044.2 +092600 CCVS-999999. IF1044.2 +092700 GO TO CLOSE-FILES. IF1044.2 diff --git a/tests/cobol85/IF/IF105A.CBL b/tests/cobol85/IF/IF105A.CBL new file mode 100755 index 00000000..9c10d712 --- /dev/null +++ b/tests/cobol85/IF/IF105A.CBL @@ -0,0 +1,487 @@ +000100 IDENTIFICATION DIVISION. IF1054.2 +000200 PROGRAM-ID. IF1054.2 +000300 IF105A. IF1054.2 +000400 IF1054.2 +000500*********************************************************** IF1054.2 +000600* * IF1054.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1054.2 +000800* It contains tests for the Intrinsic Function CHAR. * IF1054.2 +000900* * IF1054.2 +001000* * IF1054.2 +001100*********************************************************** IF1054.2 +001200 ENVIRONMENT DIVISION. IF1054.2 +001300 CONFIGURATION SECTION. IF1054.2 +001400 SOURCE-COMPUTER. IF1054.2 +001500 Linux. IF1054.2 +001600 OBJECT-COMPUTER. IF1054.2 +001700 Linux IF1054.2 +001800 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1054.2 +001900 SPECIAL-NAMES. IF1054.2 +002000 ALPHABET PRG-COLL-SEQ IS IF1054.2 +002100 STANDARD-2. IF1054.2 +002200 INPUT-OUTPUT SECTION. IF1054.2 +002300 FILE-CONTROL. IF1054.2 +002400 SELECT PRINT-FILE ASSIGN TO IF1054.2 +002500 "report.log". IF1054.2 +002600 DATA DIVISION. IF1054.2 +002700 FILE SECTION. IF1054.2 +002800 FD PRINT-FILE. IF1054.2 +002900 01 PRINT-REC PICTURE X(120). IF1054.2 +003000 01 DUMMY-RECORD PICTURE X(120). IF1054.2 +003100 WORKING-STORAGE SECTION. IF1054.2 +003200*********************************************************** IF1054.2 +003300* Variables specific to the Intrinsic Function Test IF105A* IF1054.2 +003400*********************************************************** IF1054.2 +003500 01 B PIC S9(10) VALUE 37. IF1054.2 +003600 01 C PIC S9(10) VALUE 2. IF1054.2 +003700 01 D PIC S9(10) VALUE 100. IF1054.2 +003800 01 ARR VALUE "066037100070044". IF1054.2 +003900 02 IND OCCURS 5 TIMES PIC 9(3). IF1054.2 +004000 01 TEMP PIC S9(5)V9(5). IF1054.2 +004100 01 WS-ANUM PIC X. IF1054.2 +004200* IF1054.2 +004300********************************************************** IF1054.2 +004400* IF1054.2 +004500 01 TEST-RESULTS. IF1054.2 +004600 02 FILLER PIC X VALUE SPACE. IF1054.2 +004700 02 FEATURE PIC X(20) VALUE SPACE. IF1054.2 +004800 02 FILLER PIC X VALUE SPACE. IF1054.2 +004900 02 P-OR-F PIC X(5) VALUE SPACE. IF1054.2 +005000 02 FILLER PIC X VALUE SPACE. IF1054.2 +005100 02 PAR-NAME. IF1054.2 +005200 03 FILLER PIC X(19) VALUE SPACE. IF1054.2 +005300 03 PARDOT-X PIC X VALUE SPACE. IF1054.2 +005400 03 DOTVALUE PIC 99 VALUE ZERO. IF1054.2 +005500 02 FILLER PIC X(8) VALUE SPACE. IF1054.2 +005600 02 RE-MARK PIC X(61). IF1054.2 +005700 01 TEST-COMPUTED. IF1054.2 +005800 02 FILLER PIC X(30) VALUE SPACE. IF1054.2 +005900 02 FILLER PIC X(17) VALUE IF1054.2 +006000 " COMPUTED=". IF1054.2 +006100 02 COMPUTED-X. IF1054.2 +006200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1054.2 +006300 03 COMPUTED-N REDEFINES COMPUTED-A IF1054.2 +006400 PIC -9(9).9(9). IF1054.2 +006500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1054.2 +006600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1054.2 +006700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1054.2 +006800 03 CM-18V0 REDEFINES COMPUTED-A. IF1054.2 +006900 04 COMPUTED-18V0 PIC -9(18). IF1054.2 +007000 04 FILLER PIC X. IF1054.2 +007100 03 FILLER PIC X(50) VALUE SPACE. IF1054.2 +007200 01 TEST-CORRECT. IF1054.2 +007300 02 FILLER PIC X(30) VALUE SPACE. IF1054.2 +007400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1054.2 +007500 02 CORRECT-X. IF1054.2 +007600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1054.2 +007700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1054.2 +007800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1054.2 +007900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1054.2 +008000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1054.2 +008100 03 CR-18V0 REDEFINES CORRECT-A. IF1054.2 +008200 04 CORRECT-18V0 PIC -9(18). IF1054.2 +008300 04 FILLER PIC X. IF1054.2 +008400 03 FILLER PIC X(2) VALUE SPACE. IF1054.2 +008500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1054.2 +008600 01 TEST-CORRECT-MIN. IF1054.2 +008700 02 FILLER PIC X(30) VALUE SPACE. IF1054.2 +008800 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1054.2 +008900 02 CORRECTMI-X. IF1054.2 +009000 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1054.2 +009100 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1054.2 +009200 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1054.2 +009300 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1054.2 +009400 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1054.2 +009500 03 CR-18V0 REDEFINES CORRECTMI-A. IF1054.2 +009600 04 CORRECTMI-18V0 PIC -9(18). IF1054.2 +009700 04 FILLER PIC X. IF1054.2 +009800 03 FILLER PIC X(2) VALUE SPACE. IF1054.2 +009900 03 FILLER PIC X(48) VALUE SPACE. IF1054.2 +010000 01 TEST-CORRECT-MAX. IF1054.2 +010100 02 FILLER PIC X(30) VALUE SPACE. IF1054.2 +010200 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1054.2 +010300 02 CORRECTMA-X. IF1054.2 +010400 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1054.2 +010500 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1054.2 +010600 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1054.2 +010700 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1054.2 +010800 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1054.2 +010900 03 CR-18V0 REDEFINES CORRECTMA-A. IF1054.2 +011000 04 CORRECTMA-18V0 PIC -9(18). IF1054.2 +011100 04 FILLER PIC X. IF1054.2 +011200 03 FILLER PIC X(2) VALUE SPACE. IF1054.2 +011300 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1054.2 +011400 01 CCVS-C-1. IF1054.2 +011500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1054.2 +011600- "SS PARAGRAPH-NAME IF1054.2 +011700- " REMARKS". IF1054.2 +011800 02 FILLER PIC X(20) VALUE SPACE. IF1054.2 +011900 01 CCVS-C-2. IF1054.2 +012000 02 FILLER PIC X VALUE SPACE. IF1054.2 +012100 02 FILLER PIC X(6) VALUE "TESTED". IF1054.2 +012200 02 FILLER PIC X(15) VALUE SPACE. IF1054.2 +012300 02 FILLER PIC X(4) VALUE "FAIL". IF1054.2 +012400 02 FILLER PIC X(94) VALUE SPACE. IF1054.2 +012500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1054.2 +012600 01 REC-CT PIC 99 VALUE ZERO. IF1054.2 +012700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1054.2 +012800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1054.2 +012900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1054.2 +013000 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1054.2 +013100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1054.2 +013200 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1054.2 +013300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1054.2 +013400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1054.2 +013500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1054.2 +013600 01 CCVS-H-1. IF1054.2 +013700 02 FILLER PIC X(39) VALUE SPACES. IF1054.2 +013800 02 FILLER PIC X(42) VALUE IF1054.2 +013900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1054.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1054.2 +014100 01 CCVS-H-2A. IF1054.2 +014200 02 FILLER PIC X(40) VALUE SPACE. IF1054.2 +014300 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1054.2 +014400 02 FILLER PIC XXXX VALUE IF1054.2 +014500 "4.2 ". IF1054.2 +014600 02 FILLER PIC X(28) VALUE IF1054.2 +014700 " COPY - NOT FOR DISTRIBUTION". IF1054.2 +014800 02 FILLER PIC X(41) VALUE SPACE. IF1054.2 +014900 IF1054.2 +015000 01 CCVS-H-2B. IF1054.2 +015100 02 FILLER PIC X(15) VALUE IF1054.2 +015200 "TEST RESULT OF ". IF1054.2 +015300 02 TEST-ID PIC X(9). IF1054.2 +015400 02 FILLER PIC X(4) VALUE IF1054.2 +015500 " IN ". IF1054.2 +015600 02 FILLER PIC X(12) VALUE IF1054.2 +015700 " HIGH ". IF1054.2 +015800 02 FILLER PIC X(22) VALUE IF1054.2 +015900 " LEVEL VALIDATION FOR ". IF1054.2 +016000 02 FILLER PIC X(58) VALUE IF1054.2 +016100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1054.2 +016200 01 CCVS-H-3. IF1054.2 +016300 02 FILLER PIC X(34) VALUE IF1054.2 +016400 " FOR OFFICIAL USE ONLY ". IF1054.2 +016500 02 FILLER PIC X(58) VALUE IF1054.2 +016600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1054.2 +016700 02 FILLER PIC X(28) VALUE IF1054.2 +016800 " COPYRIGHT 1985 ". IF1054.2 +016900 01 CCVS-E-1. IF1054.2 +017000 02 FILLER PIC X(52) VALUE SPACE. IF1054.2 +017100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1054.2 +017200 02 ID-AGAIN PIC X(9). IF1054.2 +017300 02 FILLER PIC X(45) VALUE SPACES. IF1054.2 +017400 01 CCVS-E-2. IF1054.2 +017500 02 FILLER PIC X(31) VALUE SPACE. IF1054.2 +017600 02 FILLER PIC X(21) VALUE SPACE. IF1054.2 +017700 02 CCVS-E-2-2. IF1054.2 +017800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1054.2 +017900 03 FILLER PIC X VALUE SPACE. IF1054.2 +018000 03 ENDER-DESC PIC X(44) VALUE IF1054.2 +018100 "ERRORS ENCOUNTERED". IF1054.2 +018200 01 CCVS-E-3. IF1054.2 +018300 02 FILLER PIC X(22) VALUE IF1054.2 +018400 " FOR OFFICIAL USE ONLY". IF1054.2 +018500 02 FILLER PIC X(12) VALUE SPACE. IF1054.2 +018600 02 FILLER PIC X(58) VALUE IF1054.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1054.2 +018800 02 FILLER PIC X(13) VALUE SPACE. IF1054.2 +018900 02 FILLER PIC X(15) VALUE IF1054.2 +019000 " COPYRIGHT 1985". IF1054.2 +019100 01 CCVS-E-4. IF1054.2 +019200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1054.2 +019300 02 FILLER PIC X(4) VALUE " OF ". IF1054.2 +019400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1054.2 +019500 02 FILLER PIC X(40) VALUE IF1054.2 +019600 " TESTS WERE EXECUTED SUCCESSFULLY". IF1054.2 +019700 01 XXINFO. IF1054.2 +019800 02 FILLER PIC X(19) VALUE IF1054.2 +019900 "*** INFORMATION ***". IF1054.2 +020000 02 INFO-TEXT. IF1054.2 +020100 04 FILLER PIC X(8) VALUE SPACE. IF1054.2 +020200 04 XXCOMPUTED PIC X(20). IF1054.2 +020300 04 FILLER PIC X(5) VALUE SPACE. IF1054.2 +020400 04 XXCORRECT PIC X(20). IF1054.2 +020500 02 INF-ANSI-REFERENCE PIC X(48). IF1054.2 +020600 01 HYPHEN-LINE. IF1054.2 +020700 02 FILLER PIC IS X VALUE IS SPACE. IF1054.2 +020800 02 FILLER PIC IS X(65) VALUE IS "************************IF1054.2 +020900- "*****************************************". IF1054.2 +021000 02 FILLER PIC IS X(54) VALUE IS "************************IF1054.2 +021100- "******************************". IF1054.2 +021200 01 CCVS-PGM-ID PIC X(9) VALUE IF1054.2 +021300 "IF105A". IF1054.2 +021400 PROCEDURE DIVISION. IF1054.2 +021500 CCVS1 SECTION. IF1054.2 +021600 OPEN-FILES. IF1054.2 +021700 OPEN OUTPUT PRINT-FILE. IF1054.2 +021800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1054.2 +021900 MOVE SPACE TO TEST-RESULTS. IF1054.2 +022000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1054.2 +022100 GO TO CCVS1-EXIT. IF1054.2 +022200 CLOSE-FILES. IF1054.2 +022300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1054.2 +022400 TERMINATE-CCVS. IF1054.2 +022500 STOP RUN. IF1054.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1054.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1054.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1054.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1054.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. IF1054.2 +023100 PRINT-DETAIL. IF1054.2 +023200 IF REC-CT NOT EQUAL TO ZERO IF1054.2 +023300 MOVE "." TO PARDOT-X IF1054.2 +023400 MOVE REC-CT TO DOTVALUE. IF1054.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1054.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1054.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1054.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1054.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1054.2 +024000 MOVE SPACE TO CORRECT-X. IF1054.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1054.2 +024200 MOVE SPACE TO RE-MARK. IF1054.2 +024300 HEAD-ROUTINE. IF1054.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1054.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1054.2 +024800 COLUMN-NAMES-ROUTINE. IF1054.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +025200 END-ROUTINE. IF1054.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1054.2 +025400 END-RTN-EXIT. IF1054.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +025600 END-ROUTINE-1. IF1054.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1054.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1054.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. IF1054.2 +026000 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1054.2 +026100 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1054.2 +026200 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1054.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1054.2 +026400 END-ROUTINE-12. IF1054.2 +026500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1054.2 +026600 IF ERROR-COUNTER IS EQUAL TO ZERO IF1054.2 +026700 MOVE "NO " TO ERROR-TOTAL IF1054.2 +026800 ELSE IF1054.2 +026900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1054.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1054.2 +027100 PERFORM WRITE-LINE. IF1054.2 +027200 END-ROUTINE-13. IF1054.2 +027300 IF DELETE-COUNTER IS EQUAL TO ZERO IF1054.2 +027400 MOVE "NO " TO ERROR-TOTAL ELSE IF1054.2 +027500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1054.2 +027600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1054.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +027800 IF INSPECT-COUNTER EQUAL TO ZERO IF1054.2 +027900 MOVE "NO " TO ERROR-TOTAL IF1054.2 +028000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1054.2 +028100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1054.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +028300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1054.2 +028400 WRITE-LINE. IF1054.2 +028500 ADD 1 TO RECORD-COUNT. IF1054.2 +028600 IF RECORD-COUNT GREATER 42 IF1054.2 +028700 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1054.2 +028800 MOVE SPACE TO DUMMY-RECORD IF1054.2 +028900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1054.2 +029000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1054.2 +029100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1054.2 +029200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1054.2 +029300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1054.2 +029400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1054.2 +029500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1054.2 +029600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1054.2 +029700 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1054.2 +029800 MOVE ZERO TO RECORD-COUNT. IF1054.2 +029900 PERFORM WRT-LN. IF1054.2 +030000 WRT-LN. IF1054.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1054.2 +030200 MOVE SPACE TO DUMMY-RECORD. IF1054.2 +030300 BLANK-LINE-PRINT. IF1054.2 +030400 PERFORM WRT-LN. IF1054.2 +030500 FAIL-ROUTINE. IF1054.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE IF1054.2 +030700 GO TO FAIL-ROUTINE-WRITE. IF1054.2 +030800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1054.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1054.2 +031000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1054.2 +031100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +031200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1054.2 +031300 GO TO FAIL-ROUTINE-EX. IF1054.2 +031400 FAIL-ROUTINE-WRITE. IF1054.2 +031500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1054.2 +031600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1054.2 +031700 CORMA-ANSI-REFERENCE. IF1054.2 +031800 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1054.2 +031900 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1054.2 +032000 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1054.2 +032100 ELSE IF1054.2 +032200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1054.2 +032300 PERFORM WRITE-LINE. IF1054.2 +032400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1054.2 +032500 FAIL-ROUTINE-EX. EXIT. IF1054.2 +032600 BAIL-OUT. IF1054.2 +032700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1054.2 +032800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1054.2 +032900 BAIL-OUT-WRITE. IF1054.2 +033000 MOVE CORRECT-A TO XXCORRECT. IF1054.2 +033100 MOVE COMPUTED-A TO XXCOMPUTED. IF1054.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1054.2 +033300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1054.2 +033400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1054.2 +033500 BAIL-OUT-EX. EXIT. IF1054.2 +033600 CCVS1-EXIT. IF1054.2 +033700 EXIT. IF1054.2 +033800******************************************************** IF1054.2 +033900* * IF1054.2 +034000* Intrinsic Function Tests IF105A - CHAR * IF1054.2 +034100* * IF1054.2 +034200******************************************************** IF1054.2 +034300 SECT-IF105A SECTION. IF1054.2 +034400 F-CHAR-INFO. IF1054.2 +034500 MOVE "See ref. A-37 2.9" TO ANSI-REFERENCE. IF1054.2 +034600 MOVE "CHAR Function" TO FEATURE. IF1054.2 +034700*****************TEST (a) ****************************** IF1054.2 +034800 F-CHAR-01. IF1054.2 +034900 MOVE SPACE TO WS-ANUM. IF1054.2 +035000 F-CHAR-TEST-01. IF1054.2 +035100 MOVE FUNCTION CHAR(37) TO WS-ANUM. IF1054.2 +035200 IF WS-ANUM = "$" THEN IF1054.2 +035300 PERFORM PASS IF1054.2 +035400 ELSE IF1054.2 +035500 MOVE "$" TO CORRECT-X IF1054.2 +035600 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +035700 PERFORM FAIL. IF1054.2 +035800 GO TO F-CHAR-WRITE-01. IF1054.2 +035900 F-CHAR-DELETE-01. IF1054.2 +036000 PERFORM DE-LETE. IF1054.2 +036100 GO TO F-CHAR-WRITE-01. IF1054.2 +036200 F-CHAR-WRITE-01. IF1054.2 +036300 MOVE "F-CHAR-01" TO PAR-NAME. IF1054.2 +036400 PERFORM PRINT-DETAIL. IF1054.2 +036500*****************TEST (b) ****************************** IF1054.2 +036600 F-CHAR-TEST-02. IF1054.2 +036700 IF FUNCTION CHAR(B) = "$" THEN IF1054.2 +036800 PERFORM PASS IF1054.2 +036900 ELSE IF1054.2 +037000 PERFORM FAIL. IF1054.2 +037100 GO TO F-CHAR-WRITE-02. IF1054.2 +037200 F-CHAR-DELETE-02. IF1054.2 +037300 PERFORM DE-LETE. IF1054.2 +037400 GO TO F-CHAR-WRITE-02. IF1054.2 +037500 F-CHAR-WRITE-02. IF1054.2 +037600 MOVE "F-CHAR-02" TO PAR-NAME. IF1054.2 +037700 PERFORM PRINT-DETAIL. IF1054.2 +037800*****************TEST (c) ****************************** IF1054.2 +037900 F-CHAR-03. IF1054.2 +038000 MOVE SPACE TO WS-ANUM. IF1054.2 +038100 F-CHAR-TEST-03. IF1054.2 +038200 MOVE FUNCTION CHAR(IND(5)) TO WS-ANUM. IF1054.2 +038300 IF WS-ANUM = "+" THEN IF1054.2 +038400 PERFORM PASS IF1054.2 +038500 ELSE IF1054.2 +038600 MOVE "+" TO CORRECT-X IF1054.2 +038700 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +038800 PERFORM FAIL. IF1054.2 +038900 GO TO F-CHAR-WRITE-03. IF1054.2 +039000 F-CHAR-DELETE-03. IF1054.2 +039100 PERFORM DE-LETE. IF1054.2 +039200 GO TO F-CHAR-WRITE-03. IF1054.2 +039300 F-CHAR-WRITE-03. IF1054.2 +039400 MOVE "F-CHAR-03" TO PAR-NAME. IF1054.2 +039500 PERFORM PRINT-DETAIL. IF1054.2 +039600*****************TEST (d) ****************************** IF1054.2 +039700 F-CHAR-04. IF1054.2 +039800 MOVE SPACE TO WS-ANUM. IF1054.2 +039900 F-CHAR-TEST-04. IF1054.2 +040000 MOVE FUNCTION CHAR(IND(C)) TO WS-ANUM. IF1054.2 +040100 IF WS-ANUM = "$" THEN IF1054.2 +040200 PERFORM PASS IF1054.2 +040300 ELSE IF1054.2 +040400 MOVE "$" TO CORRECT-X IF1054.2 +040500 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +040600 PERFORM FAIL. IF1054.2 +040700 GO TO F-CHAR-WRITE-04. IF1054.2 +040800 F-CHAR-DELETE-04. IF1054.2 +040900 PERFORM DE-LETE. IF1054.2 +041000 GO TO F-CHAR-WRITE-04. IF1054.2 +041100 F-CHAR-WRITE-04. IF1054.2 +041200 MOVE "F-CHAR-04" TO PAR-NAME. IF1054.2 +041300 PERFORM PRINT-DETAIL. IF1054.2 +041400*****************TEST (e) ****************************** IF1054.2 +041500 F-CHAR-05. IF1054.2 +041600 MOVE SPACE TO WS-ANUM. IF1054.2 +041700 F-CHAR-TEST-05. IF1054.2 +041800 MOVE FUNCTION CHAR(87) TO WS-ANUM. IF1054.2 +041900 IF WS-ANUM = "V" THEN IF1054.2 +042000 PERFORM PASS IF1054.2 +042100 ELSE IF1054.2 +042200 MOVE "V" TO CORRECT-X IF1054.2 +042300 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +042400 PERFORM FAIL. IF1054.2 +042500 GO TO F-CHAR-WRITE-05. IF1054.2 +042600 F-CHAR-DELETE-05. IF1054.2 +042700 PERFORM DE-LETE. IF1054.2 +042800 GO TO F-CHAR-WRITE-05. IF1054.2 +042900 F-CHAR-WRITE-05. IF1054.2 +043000 MOVE "F-CHAR-05" TO PAR-NAME. IF1054.2 +043100 PERFORM PRINT-DETAIL. IF1054.2 +043200*****************TEST (f) ****************************** IF1054.2 +043300 F-CHAR-06. IF1054.2 +043400 MOVE SPACE TO WS-ANUM. IF1054.2 +043500 F-CHAR-TEST-06. IF1054.2 +043600 MOVE FUNCTION CHAR(D) TO WS-ANUM. IF1054.2 +043700 IF WS-ANUM = "c" THEN IF1054.2 +043800 PERFORM PASS IF1054.2 +043900 ELSE IF1054.2 +044000 MOVE "c" TO CORRECT-X IF1054.2 +044100 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +044200 PERFORM FAIL. IF1054.2 +044300 GO TO F-CHAR-WRITE-06. IF1054.2 +044400 F-CHAR-DELETE-06. IF1054.2 +044500 PERFORM DE-LETE. IF1054.2 +044600 GO TO F-CHAR-WRITE-06. IF1054.2 +044700 F-CHAR-WRITE-06. IF1054.2 +044800 MOVE "F-CHAR-06" TO PAR-NAME. IF1054.2 +044900 PERFORM PRINT-DETAIL. IF1054.2 +045000*****************TEST (g) ****************************** IF1054.2 +045100 F-CHAR-07. IF1054.2 +045200 MOVE SPACE TO WS-ANUM. IF1054.2 +045300 F-CHAR-TEST-07. IF1054.2 +045400 IF1054.2 +045500 IF FUNCTION ORD(FUNCTION CHAR(2)) = 2 THEN IF1054.2 +045600 PERFORM PASS IF1054.2 +045700 ELSE IF1054.2 +045800 MOVE 2 TO CORRECT-N IF1054.2 +045900 MOVE WS-ANUM TO COMPUTED-A IF1054.2 +046000 PERFORM FAIL. IF1054.2 +046100 GO TO F-CHAR-WRITE-07. IF1054.2 +046200 F-CHAR-DELETE-07. IF1054.2 +046300 PERFORM DE-LETE. IF1054.2 +046400 GO TO F-CHAR-WRITE-07. IF1054.2 +046500 F-CHAR-WRITE-07. IF1054.2 +046600 MOVE "F-CHAR-07" TO PAR-NAME. IF1054.2 +046700 PERFORM PRINT-DETAIL. IF1054.2 +046800*****************TEST (h) ****************************** IF1054.2 +046900 F-CHAR-08. IF1054.2 +047000 MOVE SPACE TO WS-ANUM. IF1054.2 +047100 F-CHAR-TEST-08. IF1054.2 +047200 IF FUNCTION ORD(FUNCTION CHAR(4)) + IF1054.2 +047300 FUNCTION ORD(FUNCTION CHAR(7)) = 11 THEN IF1054.2 +047400 PERFORM PASS IF1054.2 +047500 ELSE IF1054.2 +047600 PERFORM FAIL. IF1054.2 +047700 GO TO F-CHAR-WRITE-08. IF1054.2 +047800 F-CHAR-DELETE-08. IF1054.2 +047900 PERFORM DE-LETE. IF1054.2 +048000 GO TO F-CHAR-WRITE-08. IF1054.2 +048100 F-CHAR-WRITE-08. IF1054.2 +048200 MOVE "F-CHAR-08" TO PAR-NAME. IF1054.2 +048300 PERFORM PRINT-DETAIL. IF1054.2 +048400*******************END OF TESTS************************** IF1054.2 +048500 CCVS-EXIT SECTION. IF1054.2 +048600 CCVS-999999. IF1054.2 +048700 GO TO CLOSE-FILES. IF1054.2 diff --git a/tests/cobol85/IF/IF106A.CBL b/tests/cobol85/IF/IF106A.CBL new file mode 100755 index 00000000..14b210c0 --- /dev/null +++ b/tests/cobol85/IF/IF106A.CBL @@ -0,0 +1,1005 @@ +000100 IDENTIFICATION DIVISION. IF1064.2 +000200 PROGRAM-ID. IF1064.2 +000300 IF106A. IF1064.2 +000400 IF1064.2 +000500*********************************************************** IF1064.2 +000600* * IF1064.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1064.2 +000800* It contains tests for the Intrinsic Function COS. * IF1064.2 +000900* * IF1064.2 +001000*********************************************************** IF1064.2 +001100 ENVIRONMENT DIVISION. IF1064.2 +001200 CONFIGURATION SECTION. IF1064.2 +001300 SOURCE-COMPUTER. IF1064.2 +001400 Linux. IF1064.2 +001500 OBJECT-COMPUTER. IF1064.2 +001600 Linux. IF1064.2 +001700 INPUT-OUTPUT SECTION. IF1064.2 +001800 FILE-CONTROL. IF1064.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1064.2 +002000 "report.log". IF1064.2 +002100 DATA DIVISION. IF1064.2 +002200 FILE SECTION. IF1064.2 +002300 FD PRINT-FILE. IF1064.2 +002400 01 PRINT-REC PICTURE X(120). IF1064.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1064.2 +002600 WORKING-STORAGE SECTION. IF1064.2 +002700*********************************************************** IF1064.2 +002800* Variables specific to the Intrinsic Function Test IF106A* IF1064.2 +002900*********************************************************** IF1064.2 +003000 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1064.2 +003100 01 B PIC S9(5)V9(5) VALUE 14000.105. IF1064.2 +003200 01 C PIC S9(10) VALUE 100000. IF1064.2 +003300 01 D PIC S9(10) VALUE 1000. IF1064.2 +003400 01 E PIC S9(10) VALUE 3. IF1064.2 +003500 01 PI PIC S9V9(17) VALUE 3.141592654. IF1064.2 +003600 01 MINUSPI PIC S9V9(17) VALUE -3.141592654. IF1064.2 +003700 01 ARG1 PIC S9V9(17) VALUE 1.00. IF1064.2 +003800 01 ARR VALUE "40537". IF1064.2 +003900 02 IND OCCURS 5 TIMES PIC 9. IF1064.2 +004000 01 TEMP PIC S9(5)V9(5). IF1064.2 +004100 01 WS-NUM PIC S9(5)V9(6). IF1064.2 +004200 01 MIN-RANGE PIC S9(5)V9(7). IF1064.2 +004300 01 MAX-RANGE PIC S9(5)V9(7). IF1064.2 +004400* IF1064.2 +004500********************************************************** IF1064.2 +004600* IF1064.2 +004700 01 TEST-RESULTS. IF1064.2 +004800 02 FILLER PIC X VALUE SPACE. IF1064.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1064.2 +005000 02 FILLER PIC X VALUE SPACE. IF1064.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1064.2 +005200 02 FILLER PIC X VALUE SPACE. IF1064.2 +005300 02 PAR-NAME. IF1064.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1064.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1064.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1064.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1064.2 +005800 02 RE-MARK PIC X(61). IF1064.2 +005900 01 TEST-COMPUTED. IF1064.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1064.2 +006100 02 FILLER PIC X(17) VALUE IF1064.2 +006200 " COMPUTED=". IF1064.2 +006300 02 COMPUTED-X. IF1064.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1064.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1064.2 +006600 PIC -9(9).9(9). IF1064.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1064.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1064.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1064.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1064.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1064.2 +007200 04 FILLER PIC X. IF1064.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1064.2 +007400 01 TEST-CORRECT. IF1064.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1064.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1064.2 +007700 02 CORRECT-X. IF1064.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1064.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1064.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1064.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1064.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1064.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1064.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1064.2 +008500 04 FILLER PIC X. IF1064.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1064.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1064.2 +008800 01 TEST-CORRECT-MIN. IF1064.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1064.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1064.2 +009100 02 CORRECTMI-X. IF1064.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1064.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1064.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1064.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1064.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1064.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1064.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1064.2 +009900 04 FILLER PIC X. IF1064.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1064.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1064.2 +010200 01 TEST-CORRECT-MAX. IF1064.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1064.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1064.2 +010500 02 CORRECTMA-X. IF1064.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1064.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1064.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1064.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1064.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1064.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1064.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1064.2 +011300 04 FILLER PIC X. IF1064.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1064.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1064.2 +011600 01 CCVS-C-1. IF1064.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1064.2 +011800- "SS PARAGRAPH-NAME IF1064.2 +011900- " REMARKS". IF1064.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1064.2 +012100 01 CCVS-C-2. IF1064.2 +012200 02 FILLER PIC X VALUE SPACE. IF1064.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1064.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1064.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1064.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1064.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1064.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1064.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1064.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1064.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1064.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1064.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1064.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1064.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1064.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1064.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1064.2 +013800 01 CCVS-H-1. IF1064.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1064.2 +014000 02 FILLER PIC X(42) VALUE IF1064.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1064.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1064.2 +014300 01 CCVS-H-2A. IF1064.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1064.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1064.2 +014600 02 FILLER PIC XXXX VALUE IF1064.2 +014700 "4.2 ". IF1064.2 +014800 02 FILLER PIC X(28) VALUE IF1064.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1064.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1064.2 +015100 IF1064.2 +015200 01 CCVS-H-2B. IF1064.2 +015300 02 FILLER PIC X(15) VALUE IF1064.2 +015400 "TEST RESULT OF ". IF1064.2 +015500 02 TEST-ID PIC X(9). IF1064.2 +015600 02 FILLER PIC X(4) VALUE IF1064.2 +015700 " IN ". IF1064.2 +015800 02 FILLER PIC X(12) VALUE IF1064.2 +015900 " HIGH ". IF1064.2 +016000 02 FILLER PIC X(22) VALUE IF1064.2 +016100 " LEVEL VALIDATION FOR ". IF1064.2 +016200 02 FILLER PIC X(58) VALUE IF1064.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1064.2 +016400 01 CCVS-H-3. IF1064.2 +016500 02 FILLER PIC X(34) VALUE IF1064.2 +016600 " FOR OFFICIAL USE ONLY ". IF1064.2 +016700 02 FILLER PIC X(58) VALUE IF1064.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1064.2 +016900 02 FILLER PIC X(28) VALUE IF1064.2 +017000 " COPYRIGHT 1985 ". IF1064.2 +017100 01 CCVS-E-1. IF1064.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1064.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1064.2 +017400 02 ID-AGAIN PIC X(9). IF1064.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1064.2 +017600 01 CCVS-E-2. IF1064.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1064.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1064.2 +017900 02 CCVS-E-2-2. IF1064.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1064.2 +018100 03 FILLER PIC X VALUE SPACE. IF1064.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1064.2 +018300 "ERRORS ENCOUNTERED". IF1064.2 +018400 01 CCVS-E-3. IF1064.2 +018500 02 FILLER PIC X(22) VALUE IF1064.2 +018600 " FOR OFFICIAL USE ONLY". IF1064.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1064.2 +018800 02 FILLER PIC X(58) VALUE IF1064.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1064.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1064.2 +019100 02 FILLER PIC X(15) VALUE IF1064.2 +019200 " COPYRIGHT 1985". IF1064.2 +019300 01 CCVS-E-4. IF1064.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1064.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1064.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1064.2 +019700 02 FILLER PIC X(40) VALUE IF1064.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1064.2 +019900 01 XXINFO. IF1064.2 +020000 02 FILLER PIC X(19) VALUE IF1064.2 +020100 "*** INFORMATION ***". IF1064.2 +020200 02 INFO-TEXT. IF1064.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1064.2 +020400 04 XXCOMPUTED PIC X(20). IF1064.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1064.2 +020600 04 XXCORRECT PIC X(20). IF1064.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1064.2 +020800 01 HYPHEN-LINE. IF1064.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1064.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1064.2 +021100- "*****************************************". IF1064.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1064.2 +021300- "******************************". IF1064.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1064.2 +021500 "IF106A". IF1064.2 +021600 PROCEDURE DIVISION. IF1064.2 +021700 CCVS1 SECTION. IF1064.2 +021800 OPEN-FILES. IF1064.2 +021900 OPEN OUTPUT PRINT-FILE. IF1064.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1064.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1064.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1064.2 +022300 GO TO CCVS1-EXIT. IF1064.2 +022400 CLOSE-FILES. IF1064.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1064.2 +022600 TERMINATE-CCVS. IF1064.2 +022700 STOP RUN. IF1064.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1064.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1064.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1064.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1064.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1064.2 +023300 PRINT-DETAIL. IF1064.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1064.2 +023500 MOVE "." TO PARDOT-X IF1064.2 +023600 MOVE REC-CT TO DOTVALUE. IF1064.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1064.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1064.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1064.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1064.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1064.2 +024200 MOVE SPACE TO CORRECT-X. IF1064.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1064.2 +024400 MOVE SPACE TO RE-MARK. IF1064.2 +024500 HEAD-ROUTINE. IF1064.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1064.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1064.2 +025000 COLUMN-NAMES-ROUTINE. IF1064.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +025400 END-ROUTINE. IF1064.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1064.2 +025600 END-RTN-EXIT. IF1064.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +025800 END-ROUTINE-1. IF1064.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1064.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1064.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1064.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1064.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1064.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1064.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1064.2 +026600 END-ROUTINE-12. IF1064.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1064.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1064.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1064.2 +027000 ELSE IF1064.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1064.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1064.2 +027300 PERFORM WRITE-LINE. IF1064.2 +027400 END-ROUTINE-13. IF1064.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1064.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1064.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1064.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1064.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1064.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1064.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1064.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1064.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1064.2 +028600 WRITE-LINE. IF1064.2 +028700 ADD 1 TO RECORD-COUNT. IF1064.2 +028800 IF RECORD-COUNT GREATER 42 IF1064.2 +028900 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1064.2 +029000 MOVE SPACE TO DUMMY-RECORD IF1064.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1064.2 +029200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1064.2 +029300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1064.2 +029400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1064.2 +029500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1064.2 +029600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1064.2 +029700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1064.2 +029800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1064.2 +029900 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1064.2 +030000 MOVE ZERO TO RECORD-COUNT. IF1064.2 +030100 PERFORM WRT-LN. IF1064.2 +030200 WRT-LN. IF1064.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1064.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1064.2 +030500 BLANK-LINE-PRINT. IF1064.2 +030600 PERFORM WRT-LN. IF1064.2 +030700 FAIL-ROUTINE. IF1064.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1064.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1064.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1064.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1064.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1064.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1064.2 +031500 GO TO FAIL-ROUTINE-EX. IF1064.2 +031600 FAIL-ROUTINE-WRITE. IF1064.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1064.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1064.2 +031900 CORMA-ANSI-REFERENCE. IF1064.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1064.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1064.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1064.2 +032300 ELSE IF1064.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1064.2 +032500 PERFORM WRITE-LINE. IF1064.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1064.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1064.2 +032800 BAIL-OUT. IF1064.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1064.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1064.2 +033100 BAIL-OUT-WRITE. IF1064.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1064.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1064.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1064.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1064.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1064.2 +033700 BAIL-OUT-EX. EXIT. IF1064.2 +033800 CCVS1-EXIT. IF1064.2 +033900 EXIT. IF1064.2 +034000******************************************************** IF1064.2 +034100* * IF1064.2 +034200* Intrinsic Function Tests IF106A - COS * IF1064.2 +034300* * IF1064.2 +034400******************************************************** IF1064.2 +034500 SECT-IF106A SECTION. IF1064.2 +034600 F-COS-INFO. IF1064.2 +034700 MOVE "See ref. A-38 2.8" TO ANSI-REFERENCE. IF1064.2 +034800 MOVE "COS Function" TO FEATURE. IF1064.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1064.2 +035000 F-COS-01. IF1064.2 +035100 MOVE ZERO TO WS-NUM. IF1064.2 +035200 MOVE 0.999980 TO MIN-RANGE. IF1064.2 +035300 MOVE 1.00000 TO MAX-RANGE. IF1064.2 +035400 F-COS-TEST-01. IF1064.2 +035500 COMPUTE WS-NUM = FUNCTION COS(0). IF1064.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +035800 PERFORM PASS IF1064.2 +035900 ELSE IF1064.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +036300 PERFORM FAIL. IF1064.2 +036400 GO TO F-COS-WRITE-01. IF1064.2 +036500 F-COS-DELETE-01. IF1064.2 +036600 PERFORM DE-LETE. IF1064.2 +036700 GO TO F-COS-WRITE-01. IF1064.2 +036800 F-COS-WRITE-01. IF1064.2 +036900 MOVE "F-COS-01" TO PAR-NAME. IF1064.2 +037000 PERFORM PRINT-DETAIL. IF1064.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1064.2 +037200 F-COS-02. IF1064.2 +037300 MOVE ZERO TO WS-NUM. IF1064.2 +037400 MOVE -1.00000 TO MIN-RANGE. IF1064.2 +037500 MOVE -0.999980 TO MAX-RANGE. IF1064.2 +037600 F-COS-TEST-02. IF1064.2 +037700 COMPUTE WS-NUM = FUNCTION COS(PI). IF1064.2 +037800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +037900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +038000 PERFORM PASS IF1064.2 +038100 ELSE IF1064.2 +038200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +038300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +038400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +038500 PERFORM FAIL. IF1064.2 +038600 GO TO F-COS-WRITE-02. IF1064.2 +038700 F-COS-DELETE-02. IF1064.2 +038800 PERFORM DE-LETE. IF1064.2 +038900 GO TO F-COS-WRITE-02. IF1064.2 +039000 F-COS-WRITE-02. IF1064.2 +039100 MOVE "F-COS-02" TO PAR-NAME. IF1064.2 +039200 PERFORM PRINT-DETAIL. IF1064.2 +039300*****************TEST (c) - SIMPLE TEST***************** IF1064.2 +039400 F-COS-03. IF1064.2 +039500 MOVE ZERO TO WS-NUM. IF1064.2 +039600 MOVE -1.00000 TO MIN-RANGE. IF1064.2 +039700 MOVE -0.999980 TO MAX-RANGE. IF1064.2 +039800 F-COS-TEST-03. IF1064.2 +039900 COMPUTE WS-NUM = FUNCTION COS(MINUSPI). IF1064.2 +040000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +040100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +040200 PERFORM PASS IF1064.2 +040300 ELSE IF1064.2 +040400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +040500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +040600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +040700 PERFORM FAIL. IF1064.2 +040800 GO TO F-COS-WRITE-03. IF1064.2 +040900 F-COS-DELETE-03. IF1064.2 +041000 PERFORM DE-LETE. IF1064.2 +041100 GO TO F-COS-WRITE-03. IF1064.2 +041200 F-COS-WRITE-03. IF1064.2 +041300 MOVE "F-COS-03" TO PAR-NAME. IF1064.2 +041400 PERFORM PRINT-DETAIL. IF1064.2 +041500*****************TEST (d) - SIMPLE TEST***************** IF1064.2 +041600 F-COS-04. IF1064.2 +041700 MOVE ZERO TO WS-NUM. IF1064.2 +041800 MOVE 0.999980 TO MIN-RANGE. IF1064.2 +041900 MOVE 1.000000 TO MAX-RANGE. IF1064.2 +042000 F-COS-TEST-04. IF1064.2 +042100 COMPUTE WS-NUM = FUNCTION COS(0.001). IF1064.2 +042200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +042300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +042400 PERFORM PASS IF1064.2 +042500 ELSE IF1064.2 +042600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +042700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +042800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +042900 PERFORM FAIL. IF1064.2 +043000 GO TO F-COS-WRITE-04. IF1064.2 +043100 F-COS-DELETE-04. IF1064.2 +043200 PERFORM DE-LETE. IF1064.2 +043300 GO TO F-COS-WRITE-04. IF1064.2 +043400 F-COS-WRITE-04. IF1064.2 +043500 MOVE "F-COS-04" TO PAR-NAME. IF1064.2 +043600 PERFORM PRINT-DETAIL. IF1064.2 +043700*****************TEST (e) - SIMPLE TEST***************** IF1064.2 +043800 F-COS-05. IF1064.2 +043900 MOVE ZERO TO WS-NUM. IF1064.2 +044000 MOVE 0.999980 TO MIN-RANGE. IF1064.2 +044100 MOVE 1.000000 TO MAX-RANGE. IF1064.2 +044200 F-COS-TEST-05. IF1064.2 +044300 COMPUTE WS-NUM = FUNCTION COS(.00009). IF1064.2 +044400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +044500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +044600 PERFORM PASS IF1064.2 +044700 ELSE IF1064.2 +044800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +044900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +045000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +045100 PERFORM FAIL. IF1064.2 +045200 GO TO F-COS-WRITE-05. IF1064.2 +045300 F-COS-DELETE-05. IF1064.2 +045400 PERFORM DE-LETE. IF1064.2 +045500 GO TO F-COS-WRITE-05. IF1064.2 +045600 F-COS-WRITE-05. IF1064.2 +045700 MOVE "F-COS-05" TO PAR-NAME. IF1064.2 +045800 PERFORM PRINT-DETAIL. IF1064.2 +045900*****************TEST (f) - SIMPLE TEST***************** IF1064.2 +046000 F-COS-06. IF1064.2 +046100 MOVE ZERO TO WS-NUM. IF1064.2 +046200 MOVE 0.99998 TO MIN-RANGE. IF1064.2 +046300 MOVE 1.000000 TO MAX-RANGE. IF1064.2 +046400 F-COS-TEST-06. IF1064.2 +046500 COMPUTE WS-NUM = FUNCTION COS(A). IF1064.2 +046600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +046700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +046800 PERFORM PASS IF1064.2 +046900 ELSE IF1064.2 +047000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +047100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +047200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +047300 PERFORM FAIL. IF1064.2 +047400 GO TO F-COS-WRITE-06. IF1064.2 +047500 F-COS-DELETE-06. IF1064.2 +047600 PERFORM DE-LETE. IF1064.2 +047700 GO TO F-COS-WRITE-06. IF1064.2 +047800 F-COS-WRITE-06. IF1064.2 +047900 MOVE "F-COS-06" TO PAR-NAME. IF1064.2 +048000 PERFORM PRINT-DETAIL. IF1064.2 +048100*****************TEST (g) - SIMPLE TEST***************** IF1064.2 +048200 F-COS-07. IF1064.2 +048300 MOVE ZERO TO WS-NUM. IF1064.2 +048400 MOVE 0.283656 TO MIN-RANGE. IF1064.2 +048500 MOVE 0.283668 TO MAX-RANGE. IF1064.2 +048600 F-COS-TEST-07. IF1064.2 +048700 COMPUTE WS-NUM = FUNCTION COS(IND(E)). IF1064.2 +048800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +048900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +049000 PERFORM PASS IF1064.2 +049100 ELSE IF1064.2 +049200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +049300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +049400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +049500 PERFORM FAIL. IF1064.2 +049600 GO TO F-COS-WRITE-07. IF1064.2 +049700 F-COS-DELETE-07. IF1064.2 +049800 PERFORM DE-LETE. IF1064.2 +049900 GO TO F-COS-WRITE-07. IF1064.2 +050000 F-COS-WRITE-07. IF1064.2 +050100 MOVE "F-COS-07" TO PAR-NAME. IF1064.2 +050200 PERFORM PRINT-DETAIL. IF1064.2 +050300*****************TEST (h) - SIMPLE TEST***************** IF1064.2 +050400 F-COS-08. IF1064.2 +050500 MOVE ZERO TO WS-NUM. IF1064.2 +050600 MOVE 0.753887 TO MIN-RANGE. IF1064.2 +050700 MOVE 0.753917 TO MAX-RANGE. IF1064.2 +050800 F-COS-TEST-08. IF1064.2 +050900 COMPUTE WS-NUM = FUNCTION COS(IND(5)). IF1064.2 +051000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +051100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +051200 PERFORM PASS IF1064.2 +051300 ELSE IF1064.2 +051400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +051500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +051600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +051700 PERFORM FAIL. IF1064.2 +051800 GO TO F-COS-WRITE-08. IF1064.2 +051900 F-COS-DELETE-08. IF1064.2 +052000 PERFORM DE-LETE. IF1064.2 +052100 GO TO F-COS-WRITE-08. IF1064.2 +052200 F-COS-WRITE-08. IF1064.2 +052300 MOVE "F-COS-08" TO PAR-NAME. IF1064.2 +052400 PERFORM PRINT-DETAIL. IF1064.2 +052500*****************TEST (a) - COMPLEX TEST**************** IF1064.2 +052600 F-COS-09. IF1064.2 +052700 MOVE ZERO TO WS-NUM. IF1064.2 +052800 MOVE 0.499980 TO MIN-RANGE. IF1064.2 +052900 MOVE 0.500020 TO MAX-RANGE. IF1064.2 +053000 F-COS-TEST-09. IF1064.2 +053100 COMPUTE WS-NUM = FUNCTION COS(PI / 3). IF1064.2 +053200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +053300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +053400 PERFORM PASS IF1064.2 +053500 ELSE IF1064.2 +053600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +053700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +053800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +053900 PERFORM FAIL. IF1064.2 +054000 GO TO F-COS-WRITE-09. IF1064.2 +054100 F-COS-DELETE-09. IF1064.2 +054200 PERFORM DE-LETE. IF1064.2 +054300 GO TO F-COS-WRITE-09. IF1064.2 +054400 F-COS-WRITE-09. IF1064.2 +054500 MOVE "F-COS-09" TO PAR-NAME. IF1064.2 +054600 PERFORM PRINT-DETAIL. IF1064.2 +054700*****************TEST (b) - COMPLEX TEST**************** IF1064.2 +054800 F-COS-10. IF1064.2 +054900 MOVE ZERO TO WS-NUM. IF1064.2 +055000 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +055100 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +055200 F-COS-TEST-10. IF1064.2 +055300 COMPUTE WS-NUM = FUNCTION COS(PI / 2). IF1064.2 +055400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +055500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +055600 PERFORM PASS IF1064.2 +055700 ELSE IF1064.2 +055800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +055900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +056000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +056100 PERFORM FAIL. IF1064.2 +056200 GO TO F-COS-WRITE-10. IF1064.2 +056300 F-COS-DELETE-10. IF1064.2 +056400 PERFORM DE-LETE. IF1064.2 +056500 GO TO F-COS-WRITE-10. IF1064.2 +056600 F-COS-WRITE-10. IF1064.2 +056700 MOVE "F-COS-10" TO PAR-NAME. IF1064.2 +056800 PERFORM PRINT-DETAIL. IF1064.2 +056900*****************TEST (c) - COMPLEX TEST**************** IF1064.2 +057000 F-COS-11. IF1064.2 +057100 MOVE ZERO TO WS-NUM. IF1064.2 +057200 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +057300 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +057400 F-COS-TEST-11. IF1064.2 +057500 COMPUTE WS-NUM = FUNCTION COS((3 * PI) / 2). IF1064.2 +057600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +057700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +057800 PERFORM PASS IF1064.2 +057900 ELSE IF1064.2 +058000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +058100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +058200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +058300 PERFORM FAIL. IF1064.2 +058400 GO TO F-COS-WRITE-11. IF1064.2 +058500 F-COS-DELETE-11. IF1064.2 +058600 PERFORM DE-LETE. IF1064.2 +058700 GO TO F-COS-WRITE-11. IF1064.2 +058800 F-COS-WRITE-11. IF1064.2 +058900 MOVE "F-COS-11" TO PAR-NAME. IF1064.2 +059000 PERFORM PRINT-DETAIL. IF1064.2 +059100*****************TEST (d) - COMPLEX TEST**************** IF1064.2 +059200 F-COS-12. IF1064.2 +059300 MOVE ZERO TO WS-NUM. IF1064.2 +059400 MOVE 0.499980 TO MIN-RANGE. IF1064.2 +059500 MOVE 0.500002 TO MAX-RANGE. IF1064.2 +059600 F-COS-TEST-12. IF1064.2 +059700 COMPUTE WS-NUM = FUNCTION COS(MINUSPI / 3). IF1064.2 +059800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +059900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +060000 PERFORM PASS IF1064.2 +060100 ELSE IF1064.2 +060200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +060300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +060400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +060500 PERFORM FAIL. IF1064.2 +060600 GO TO F-COS-WRITE-12. IF1064.2 +060700 F-COS-DELETE-12. IF1064.2 +060800 PERFORM DE-LETE. IF1064.2 +060900 GO TO F-COS-WRITE-12. IF1064.2 +061000 F-COS-WRITE-12. IF1064.2 +061100 MOVE "F-COS-12" TO PAR-NAME. IF1064.2 +061200 PERFORM PRINT-DETAIL. IF1064.2 +061300*****************TEST (e) - COMPLEX TEST**************** IF1064.2 +061400 F-COS-13. IF1064.2 +061500 MOVE ZERO TO WS-NUM. IF1064.2 +061600 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +061700 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +061800 F-COS-TEST-13. IF1064.2 +061900 COMPUTE WS-NUM = FUNCTION COS(MINUSPI / 2). IF1064.2 +062000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +062100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +062200 PERFORM PASS IF1064.2 +062300 ELSE IF1064.2 +062400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +062500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +062600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +062700 PERFORM FAIL. IF1064.2 +062800 GO TO F-COS-WRITE-13. IF1064.2 +062900 F-COS-DELETE-13. IF1064.2 +063000 PERFORM DE-LETE. IF1064.2 +063100 GO TO F-COS-WRITE-13. IF1064.2 +063200 F-COS-WRITE-13. IF1064.2 +063300 MOVE "F-COS-13" TO PAR-NAME. IF1064.2 +063400 PERFORM PRINT-DETAIL. IF1064.2 +063500*****************TEST (f) - COMPLEX TEST**************** IF1064.2 +063600 F-COS-14. IF1064.2 +063700 MOVE ZERO TO WS-NUM. IF1064.2 +063800 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +063900 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +064000 F-COS-TEST-14. IF1064.2 +064100 COMPUTE WS-NUM = FUNCTION COS((3 * MINUSPI) / 2). IF1064.2 +064200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +064300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +064400 PERFORM PASS IF1064.2 +064500 ELSE IF1064.2 +064600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +064700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +064800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +064900 PERFORM FAIL. IF1064.2 +065000 GO TO F-COS-WRITE-14. IF1064.2 +065100 F-COS-DELETE-14. IF1064.2 +065200 PERFORM DE-LETE. IF1064.2 +065300 GO TO F-COS-WRITE-14. IF1064.2 +065400 F-COS-WRITE-14. IF1064.2 +065500 MOVE "F-COS-14" TO PAR-NAME. IF1064.2 +065600 PERFORM PRINT-DETAIL. IF1064.2 +065700*****************TEST (h) - COMPLEX TEST**************** IF1064.2 +065800 F-COS-16. IF1064.2 +065900 MOVE ZERO TO WS-NUM. IF1064.2 +066000 MOVE 0.499113 TO MIN-RANGE. IF1064.2 +066100 MOVE 0.499153 TO MAX-RANGE. IF1064.2 +066200 F-COS-TEST-16. IF1064.2 +066300 COMPUTE WS-NUM = FUNCTION COS((PI / 3) + 0.001). IF1064.2 +066400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +066500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +066600 PERFORM PASS IF1064.2 +066700 ELSE IF1064.2 +066800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +066900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +067000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +067100 PERFORM FAIL. IF1064.2 +067200 GO TO F-COS-WRITE-16. IF1064.2 +067300 F-COS-DELETE-16. IF1064.2 +067400 PERFORM DE-LETE. IF1064.2 +067500 GO TO F-COS-WRITE-16. IF1064.2 +067600 F-COS-WRITE-16. IF1064.2 +067700 MOVE "F-COS-16" TO PAR-NAME. IF1064.2 +067800 PERFORM PRINT-DETAIL. IF1064.2 +067900*****************TEST (j) - COMPLEX TEST**************** IF1064.2 +068000 F-COS-18. IF1064.2 +068100 MOVE ZERO TO WS-NUM. IF1064.2 +068200 MOVE 0.999350 TO MIN-RANGE. IF1064.2 +068300 MOVE 0.999430 TO MAX-RANGE. IF1064.2 +068400 F-COS-TEST-18. IF1064.2 +068500 COMPUTE WS-NUM = FUNCTION COS(PI * (4 - 2) / 180). IF1064.2 +068600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +068700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +068800 PERFORM PASS IF1064.2 +068900 ELSE IF1064.2 +069000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +069100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +069200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +069300 PERFORM FAIL. IF1064.2 +069400 GO TO F-COS-WRITE-18. IF1064.2 +069500 F-COS-DELETE-18. IF1064.2 +069600 PERFORM DE-LETE. IF1064.2 +069700 GO TO F-COS-WRITE-18. IF1064.2 +069800 F-COS-WRITE-18. IF1064.2 +069900 MOVE "F-COS-18" TO PAR-NAME. IF1064.2 +070000 PERFORM PRINT-DETAIL. IF1064.2 +070100*****************TEST (k) - COMPLEX TEST**************** IF1064.2 +070200 F-COS-19. IF1064.2 +070300 MOVE ZERO TO WS-NUM. IF1064.2 +070400 MOVE 0.017451 TO MIN-RANGE. IF1064.2 +070500 MOVE 0.017453 TO MAX-RANGE. IF1064.2 +070600 F-COS-TEST-19. IF1064.2 +070700 COMPUTE WS-NUM = FUNCTION COS((PI / 2) - (PI / 180)). IF1064.2 +070800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +070900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +071000 PERFORM PASS IF1064.2 +071100 ELSE IF1064.2 +071200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +071300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +071400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +071500 PERFORM FAIL. IF1064.2 +071600 GO TO F-COS-WRITE-19. IF1064.2 +071700 F-COS-DELETE-19. IF1064.2 +071800 PERFORM DE-LETE. IF1064.2 +071900 GO TO F-COS-WRITE-19. IF1064.2 +072000 F-COS-WRITE-19. IF1064.2 +072100 MOVE "F-COS-19" TO PAR-NAME. IF1064.2 +072200 PERFORM PRINT-DETAIL. IF1064.2 +072300*****************TEST (l) - COMPLEX TEST**************** IF1064.2 +072400 F-COS-20. IF1064.2 +072500 MOVE ZERO TO WS-NUM. IF1064.2 +072600 MOVE 0.515017 TO MIN-RANGE. IF1064.2 +072700 MOVE 0.515059 TO MAX-RANGE. IF1064.2 +072800 F-COS-TEST-20. IF1064.2 +072900 COMPUTE WS-NUM = FUNCTION COS((PI / 3) - (PI / 180)). IF1064.2 +073000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +073100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +073200 PERFORM PASS IF1064.2 +073300 ELSE IF1064.2 +073400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +073500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +073600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +073700 PERFORM FAIL. IF1064.2 +073800 GO TO F-COS-WRITE-20. IF1064.2 +073900 F-COS-DELETE-20. IF1064.2 +074000 PERFORM DE-LETE. IF1064.2 +074100 GO TO F-COS-WRITE-20. IF1064.2 +074200 F-COS-WRITE-20. IF1064.2 +074300 MOVE "F-COS-20" TO PAR-NAME. IF1064.2 +074400 PERFORM PRINT-DETAIL. IF1064.2 +074500*****************TEST (m) - COMPLEX TEST**************** IF1064.2 +074600 F-COS-21. IF1064.2 +074700 MOVE ZERO TO WS-NUM. IF1064.2 +074800 MOVE -0.999887 TO MIN-RANGE. IF1064.2 +074900 MOVE -0.999807 TO MAX-RANGE. IF1064.2 +075000 F-COS-TEST-21. IF1064.2 +075100 COMPUTE WS-NUM = FUNCTION COS(PI + (PI / 180)). IF1064.2 +075200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +075300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +075400 PERFORM PASS IF1064.2 +075500 ELSE IF1064.2 +075600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +075700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +075800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +075900 PERFORM FAIL. IF1064.2 +076000 GO TO F-COS-WRITE-21. IF1064.2 +076100 F-COS-DELETE-21. IF1064.2 +076200 PERFORM DE-LETE. IF1064.2 +076300 GO TO F-COS-WRITE-21. IF1064.2 +076400 F-COS-WRITE-21. IF1064.2 +076500 MOVE "F-COS-21" TO PAR-NAME. IF1064.2 +076600 PERFORM PRINT-DETAIL. IF1064.2 +076700*****************TEST (n) - COMPLEX TEST**************** IF1064.2 +076800 F-COS-22. IF1064.2 +076900 MOVE ZERO TO WS-NUM. IF1064.2 +077000 MOVE 0.034898 TO MIN-RANGE. IF1064.2 +077100 MOVE 0.034900 TO MAX-RANGE. IF1064.2 +077200 F-COS-TEST-22. IF1064.2 +077300 COMPUTE WS-NUM = FUNCTION COS(( PI * 272) / 180). IF1064.2 +077400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +077500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +077600 PERFORM PASS IF1064.2 +077700 ELSE IF1064.2 +077800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +077900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +078000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +078100 PERFORM FAIL. IF1064.2 +078200 GO TO F-COS-WRITE-22. IF1064.2 +078300 F-COS-DELETE-22. IF1064.2 +078400 PERFORM DE-LETE. IF1064.2 +078500 GO TO F-COS-WRITE-22. IF1064.2 +078600 F-COS-WRITE-22. IF1064.2 +078700 MOVE "F-COS-22" TO PAR-NAME. IF1064.2 +078800 PERFORM PRINT-DETAIL. IF1064.2 +078900*****************TEST (o) - COMPLEX TEST**************** IF1064.2 +079000 F-COS-23. IF1064.2 +079100 MOVE ZERO TO WS-NUM. IF1064.2 +079200 MOVE -0.416163 TO MIN-RANGE. IF1064.2 +079300 MOVE -0.416129 TO MAX-RANGE. IF1064.2 +079400 F-COS-TEST-23. IF1064.2 +079500 COMPUTE WS-NUM = FUNCTION COS(4 / 2). IF1064.2 +079600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +079700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +079800 PERFORM PASS IF1064.2 +079900 ELSE IF1064.2 +080000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +080100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +080200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +080300 PERFORM FAIL. IF1064.2 +080400 GO TO F-COS-WRITE-23. IF1064.2 +080500 F-COS-DELETE-23. IF1064.2 +080600 PERFORM DE-LETE. IF1064.2 +080700 GO TO F-COS-WRITE-23. IF1064.2 +080800 F-COS-WRITE-23. IF1064.2 +080900 MOVE "F-COS-23" TO PAR-NAME. IF1064.2 +081000 PERFORM PRINT-DETAIL. IF1064.2 +081100*****************TEST (p) - COMPLEX TEST**************** IF1064.2 +081200 F-COS-24. IF1064.2 +081300 MOVE ZERO TO WS-NUM. IF1064.2 +081400 MOVE 0.070734 TO MIN-RANGE. IF1064.2 +081500 MOVE 0.070740 TO MAX-RANGE. IF1064.2 +081600 F-COS-TEST-24. IF1064.2 +081700 COMPUTE WS-NUM = FUNCTION COS(3 / 2). IF1064.2 +081800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +081900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +082000 PERFORM PASS IF1064.2 +082100 ELSE IF1064.2 +082200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +082300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +082400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +082500 PERFORM FAIL. IF1064.2 +082600 GO TO F-COS-WRITE-24. IF1064.2 +082700 F-COS-DELETE-24. IF1064.2 +082800 PERFORM DE-LETE. IF1064.2 +082900 GO TO F-COS-WRITE-24. IF1064.2 +083000 F-COS-WRITE-24. IF1064.2 +083100 MOVE "F-COS-24" TO PAR-NAME. IF1064.2 +083200 PERFORM PRINT-DETAIL. IF1064.2 +083300*****************TEST (q) - COMPLEX TEST**************** IF1064.2 +083400 F-COS-25. IF1064.2 +083500 MOVE ZERO TO WS-NUM. IF1064.2 +083600 MOVE -1.000000 TO MIN-RANGE. IF1064.2 +083700 MOVE -0.999960 TO MAX-RANGE. IF1064.2 +083800 F-COS-TEST-25. IF1064.2 +083900 COMPUTE WS-NUM = FUNCTION COS(PI - A). IF1064.2 +084000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +084100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +084200 PERFORM PASS IF1064.2 +084300 ELSE IF1064.2 +084400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +084500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +084600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +084700 PERFORM FAIL. IF1064.2 +084800 GO TO F-COS-WRITE-25. IF1064.2 +084900 F-COS-DELETE-25. IF1064.2 +085000 PERFORM DE-LETE. IF1064.2 +085100 GO TO F-COS-WRITE-25. IF1064.2 +085200 F-COS-WRITE-25. IF1064.2 +085300 MOVE "F-COS-25" TO PAR-NAME. IF1064.2 +085400 PERFORM PRINT-DETAIL. IF1064.2 +085500*****************TEST (r) - COMPLEX TEST**************** IF1064.2 +085600 F-COS-26. IF1064.2 +085700 MOVE ZERO TO WS-NUM. IF1064.2 +085800 MOVE -0.839105 TO MIN-RANGE. IF1064.2 +085900 MOVE -0.839037 TO MAX-RANGE. IF1064.2 +086000 F-COS-TEST-26. IF1064.2 +086100 COMPUTE WS-NUM = FUNCTION COS(D / 100). IF1064.2 +086200 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +086300 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +086400 PERFORM PASS IF1064.2 +086500 ELSE IF1064.2 +086600 MOVE WS-NUM TO COMPUTED-N IF1064.2 +086700 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +086800 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +086900 PERFORM FAIL. IF1064.2 +087000 GO TO F-COS-WRITE-26. IF1064.2 +087100 F-COS-DELETE-26. IF1064.2 +087200 PERFORM DE-LETE. IF1064.2 +087300 GO TO F-COS-WRITE-26. IF1064.2 +087400 F-COS-WRITE-26. IF1064.2 +087500 MOVE "F-COS-26" TO PAR-NAME. IF1064.2 +087600 PERFORM PRINT-DETAIL. IF1064.2 +087700*****************TEST (s) - COMPLEX TEST**************** IF1064.2 +087800 F-COS-27. IF1064.2 +087900 MOVE ZERO TO WS-NUM. IF1064.2 +088000 MOVE 0.999807 TO MIN-RANGE. IF1064.2 +088100 MOVE 0.999887 TO MAX-RANGE. IF1064.2 +088200 F-COS-TEST-27. IF1064.2 +088300 COMPUTE WS-NUM = FUNCTION COS(PI / 180). IF1064.2 +088400 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +088500 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +088600 PERFORM PASS IF1064.2 +088700 ELSE IF1064.2 +088800 MOVE WS-NUM TO COMPUTED-N IF1064.2 +088900 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +089000 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +089100 PERFORM FAIL. IF1064.2 +089200 GO TO F-COS-WRITE-27. IF1064.2 +089300 F-COS-DELETE-27. IF1064.2 +089400 PERFORM DE-LETE. IF1064.2 +089500 GO TO F-COS-WRITE-27. IF1064.2 +089600 F-COS-WRITE-27. IF1064.2 +089700 MOVE "F-COS-27" TO PAR-NAME. IF1064.2 +089800 PERFORM PRINT-DETAIL. IF1064.2 +089900*****************TEST (t) - COMPLEX TEST**************** IF1064.2 +090000 F-COS-28. IF1064.2 +090100 MOVE ZERO TO WS-NUM. IF1064.2 +090200 MOVE -1.000000 TO MIN-RANGE. IF1064.2 +090300 MOVE -0.999960 TO MAX-RANGE. IF1064.2 +090400 F-COS-TEST-28. IF1064.2 +090500 COMPUTE WS-NUM = FUNCTION COS(PI - 0.001). IF1064.2 +090600 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +090700 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +090800 PERFORM PASS IF1064.2 +090900 ELSE IF1064.2 +091000 MOVE WS-NUM TO COMPUTED-N IF1064.2 +091100 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +091200 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +091300 PERFORM FAIL. IF1064.2 +091400 GO TO F-COS-WRITE-28. IF1064.2 +091500 F-COS-DELETE-28. IF1064.2 +091600 PERFORM DE-LETE. IF1064.2 +091700 GO TO F-COS-WRITE-28. IF1064.2 +091800 F-COS-WRITE-28. IF1064.2 +091900 MOVE "F-COS-28" TO PAR-NAME. IF1064.2 +092000 PERFORM PRINT-DETAIL. IF1064.2 +092100*****************TEST (u) - COMPLEX TEST**************** IF1064.2 +092200 F-COS-29. IF1064.2 +092300 MOVE ZERO TO WS-NUM. IF1064.2 +092400 MOVE -0.000040 TO MIN-RANGE. IF1064.2 +092500 MOVE 0.000040 TO MAX-RANGE. IF1064.2 +092600 F-COS-TEST-29. IF1064.2 +092700 COMPUTE WS-NUM = FUNCTION COS(PI) + 1. IF1064.2 +092800 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +092900 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +093000 PERFORM PASS IF1064.2 +093100 ELSE IF1064.2 +093200 MOVE WS-NUM TO COMPUTED-N IF1064.2 +093300 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +093400 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +093500 PERFORM FAIL. IF1064.2 +093600 GO TO F-COS-WRITE-29. IF1064.2 +093700 F-COS-DELETE-29. IF1064.2 +093800 PERFORM DE-LETE. IF1064.2 +093900 GO TO F-COS-WRITE-29. IF1064.2 +094000 F-COS-WRITE-29. IF1064.2 +094100 MOVE "F-COS-29" TO PAR-NAME. IF1064.2 +094200 PERFORM PRINT-DETAIL. IF1064.2 +094300*****************TEST (v) - COMPLEX TEST**************** IF1064.2 +094400 F-COS-30. IF1064.2 +094500 MOVE ZERO TO WS-NUM. IF1064.2 +094600 MOVE 0.914616 TO MIN-RANGE. IF1064.2 +094700 MOVE 0.914690 TO MAX-RANGE. IF1064.2 +094800 F-COS-TEST-30. IF1064.2 +094900 COMPUTE WS-NUM = FUNCTION COS(FUNCTION COS(2)). IF1064.2 +095000 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +095100 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +095200 PERFORM PASS IF1064.2 +095300 ELSE IF1064.2 +095400 MOVE WS-NUM TO COMPUTED-N IF1064.2 +095500 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +095600 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +095700 PERFORM FAIL. IF1064.2 +095800 GO TO F-COS-WRITE-30. IF1064.2 +095900 F-COS-DELETE-30. IF1064.2 +096000 PERFORM DE-LETE. IF1064.2 +096100 GO TO F-COS-WRITE-30. IF1064.2 +096200 F-COS-WRITE-30. IF1064.2 +096300 MOVE "F-COS-30" TO PAR-NAME. IF1064.2 +096400 PERFORM PRINT-DETAIL. IF1064.2 +096500*****************TEST (w) - COMPLEX TEST**************** IF1064.2 +096600 F-COS-31. IF1064.2 +096700 MOVE ZERO TO WS-NUM. IF1064.2 +096800 MOVE -2.00008 TO MIN-RANGE. IF1064.2 +096900 MOVE -1.99992 TO MAX-RANGE. IF1064.2 +097000 F-COS-TEST-31. IF1064.2 +097100 COMPUTE WS-NUM = FUNCTION COS(PI) + IF1064.2 +097200 FUNCTION COS(PI). IF1064.2 +097300 IF (WS-NUM >= MIN-RANGE) AND IF1064.2 +097400 (WS-NUM <= MAX-RANGE) THEN IF1064.2 +097500 PERFORM PASS IF1064.2 +097600 ELSE IF1064.2 +097700 MOVE WS-NUM TO COMPUTED-N IF1064.2 +097800 MOVE MIN-RANGE TO CORRECT-MIN IF1064.2 +097900 MOVE MAX-RANGE TO CORRECT-MAX IF1064.2 +098000 PERFORM FAIL. IF1064.2 +098100 GO TO F-COS-WRITE-31. IF1064.2 +098200 F-COS-DELETE-31. IF1064.2 +098300 PERFORM DE-LETE. IF1064.2 +098400 GO TO F-COS-WRITE-31. IF1064.2 +098500 F-COS-WRITE-31. IF1064.2 +098600 MOVE "F-COS-31" TO PAR-NAME. IF1064.2 +098700 PERFORM PRINT-DETAIL. IF1064.2 +098800*****************SPECIAL PERFORM TEST********************** IF1064.2 +098900 F-COS-32. IF1064.2 +099000 PERFORM F-COS-TEST-32 IF1064.2 +099100 UNTIL FUNCTION COS(ARG1) < 0. IF1064.2 +099200 PERFORM PASS. IF1064.2 +099300 GO TO F-COS-WRITE-32. IF1064.2 +099400 F-COS-TEST-32. IF1064.2 +099500 COMPUTE ARG1 = ARG1 - 0.25. IF1064.2 +099600 F-COS-DELETE-32. IF1064.2 +099700 PERFORM DE-LETE. IF1064.2 +099800 GO TO F-COS-WRITE-32. IF1064.2 +099900 F-COS-WRITE-32. IF1064.2 +100000 MOVE "F-COS-32" TO PAR-NAME. IF1064.2 +100100 PERFORM PRINT-DETAIL. IF1064.2 +100200********************END OF TESTS*************** IF1064.2 +100300 CCVS-EXIT SECTION. IF1064.2 +100400 CCVS-999999. IF1064.2 +100500 GO TO CLOSE-FILES. IF1064.2 diff --git a/tests/cobol85/IF/IF107A.CBL b/tests/cobol85/IF/IF107A.CBL new file mode 100755 index 00000000..3baa6f59 --- /dev/null +++ b/tests/cobol85/IF/IF107A.CBL @@ -0,0 +1,379 @@ +000100 IDENTIFICATION DIVISION. IF1074.2 +000200 PROGRAM-ID. IF1074.2 +000300 IF107A. IF1074.2 +000400 IF1074.2 +000500*********************************************************** IF1074.2 +000600* * IF1074.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1074.2 +000800* It contains tests for the Intrinsic Function * IF1074.2 +000900* CURRENT-DATE. * IF1074.2 +001000* * IF1074.2 +001100*********************************************************** IF1074.2 +001200 ENVIRONMENT DIVISION. IF1074.2 +001300 CONFIGURATION SECTION. IF1074.2 +001400 SOURCE-COMPUTER. IF1074.2 +001500 Linux. IF1074.2 +001600 OBJECT-COMPUTER. IF1074.2 +001700 Linux. IF1074.2 +001800 INPUT-OUTPUT SECTION. IF1074.2 +001900 FILE-CONTROL. IF1074.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1074.2 +002100 "report.log". IF1074.2 +002200 DATA DIVISION. IF1074.2 +002300 FILE SECTION. IF1074.2 +002400 FD PRINT-FILE. IF1074.2 +002500 01 PRINT-REC PICTURE X(120). IF1074.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1074.2 +002700 WORKING-STORAGE SECTION. IF1074.2 +002800*********************************************************** IF1074.2 +002900* Variables specific to the Intrinsic Function Test IF107A* IF1074.2 +003000*********************************************************** IF1074.2 +003100 01 TEMP1 PIC X(21). IF1074.2 +003200 01 TEMP2 PIC X(21). IF1074.2 +003300 01 WS-FIRST VALUE SPACES. IF1074.2 +003400 02 FILLER PIC X(8). IF1074.2 +003500 02 WS-TIME1 PIC X(8). IF1074.2 +003600 02 FILLER PIC X(5). IF1074.2 +003700 01 WS-SECOND VALUE SPACES. IF1074.2 +003800 02 FILLER PIC X(8). IF1074.2 +003900 02 WS-TIME2 PIC X(8). IF1074.2 +004000 02 FILLER PIC X(5). IF1074.2 +004100 01 WS-DATE. IF1074.2 +004200 02 WS-YEAR PIC 9999. IF1074.2 +004300 88 CON-YEAR VALUE 1990 THRU 9999. IF1074.2 +004400 02 WS-MONTH PIC 99. IF1074.2 +004500 88 CON-MONTH VALUE 01 THRU 12. IF1074.2 +004600 02 WS-DAY PIC 99. IF1074.2 +004700 88 CON-DAY VALUE 01 THRU 31. IF1074.2 +004800 02 WS-HOUR PIC 99. IF1074.2 +004900 88 CON-HOUR VALUE 00 THRU 23. IF1074.2 +005000 02 WS-MIN PIC 99. IF1074.2 +005100 88 CON-MIN VALUE 00 THRU 59. IF1074.2 +005200 02 WS-SECOND PIC 99. IF1074.2 +005300 88 CON-SEC VALUE 00 THRU 59. IF1074.2 +005400 02 WS-HUNDSEC PIC 99. IF1074.2 +005500 88 CON-HUNDSEC VALUE 00 THRU 99. IF1074.2 +005600 02 WS-GREENW PIC X. IF1074.2 +005700 88 CON-GREENW VALUE "-", "+", "0". IF1074.2 +005800 02 WS-OFFSET PIC 99. IF1074.2 +005900 88 CON-OFFSET VALUE 00 THRU 13. IF1074.2 +006000 02 WS-OFFSET2 PIC 99. IF1074.2 +006100 88 CON-OFFSET2 VALUE 00 THRU 59. IF1074.2 +006200* IF1074.2 +006300********************************************************** IF1074.2 +006400* IF1074.2 +006500 01 TEST-RESULTS. IF1074.2 +006600 02 FILLER PIC X VALUE SPACE. IF1074.2 +006700 02 FEATURE PIC X(20) VALUE SPACE. IF1074.2 +006800 02 FILLER PIC X VALUE SPACE. IF1074.2 +006900 02 P-OR-F PIC X(5) VALUE SPACE. IF1074.2 +007000 02 FILLER PIC X VALUE SPACE. IF1074.2 +007100 02 PAR-NAME. IF1074.2 +007200 03 FILLER PIC X(19) VALUE SPACE. IF1074.2 +007300 03 PARDOT-X PIC X VALUE SPACE. IF1074.2 +007400 03 DOTVALUE PIC 99 VALUE ZERO. IF1074.2 +007500 02 FILLER PIC X(8) VALUE SPACE. IF1074.2 +007600 02 RE-MARK PIC X(61). IF1074.2 +007700 01 TEST-COMPUTED. IF1074.2 +007800 02 FILLER PIC X(30) VALUE SPACE. IF1074.2 +007900 02 FILLER PIC X(17) VALUE IF1074.2 +008000 " COMPUTED=". IF1074.2 +008100 02 COMPUTED-X. IF1074.2 +008200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1074.2 +008300 03 COMPUTED-N REDEFINES COMPUTED-A IF1074.2 +008400 PIC -9(9).9(9). IF1074.2 +008500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1074.2 +008600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1074.2 +008700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1074.2 +008800 03 CM-18V0 REDEFINES COMPUTED-A. IF1074.2 +008900 04 COMPUTED-18V0 PIC -9(18). IF1074.2 +009000 04 FILLER PIC X. IF1074.2 +009100 03 FILLER PIC X(50) VALUE SPACE. IF1074.2 +009200 01 TEST-CORRECT. IF1074.2 +009300 02 FILLER PIC X(30) VALUE SPACE. IF1074.2 +009400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1074.2 +009500 02 CORRECT-X. IF1074.2 +009600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1074.2 +009700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1074.2 +009800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1074.2 +009900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1074.2 +010000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1074.2 +010100 03 CR-18V0 REDEFINES CORRECT-A. IF1074.2 +010200 04 CORRECT-18V0 PIC -9(18). IF1074.2 +010300 04 FILLER PIC X. IF1074.2 +010400 03 FILLER PIC X(2) VALUE SPACE. IF1074.2 +010500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1074.2 +010600 01 CCVS-C-1. IF1074.2 +010700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1074.2 +010800- "SS PARAGRAPH-NAME IF1074.2 +010900- " REMARKS". IF1074.2 +011000 02 FILLER PIC X(20) VALUE SPACE. IF1074.2 +011100 01 CCVS-C-2. IF1074.2 +011200 02 FILLER PIC X VALUE SPACE. IF1074.2 +011300 02 FILLER PIC X(6) VALUE "TESTED". IF1074.2 +011400 02 FILLER PIC X(15) VALUE SPACE. IF1074.2 +011500 02 FILLER PIC X(4) VALUE "FAIL". IF1074.2 +011600 02 FILLER PIC X(94) VALUE SPACE. IF1074.2 +011700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1074.2 +011800 01 REC-CT PIC 99 VALUE ZERO. IF1074.2 +011900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1074.2 +012000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1074.2 +012100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1074.2 +012200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1074.2 +012300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1074.2 +012400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1074.2 +012500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1074.2 +012600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1074.2 +012700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1074.2 +012800 01 CCVS-H-1. IF1074.2 +012900 02 FILLER PIC X(39) VALUE SPACES. IF1074.2 +013000 02 FILLER PIC X(42) VALUE IF1074.2 +013100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1074.2 +013200 02 FILLER PIC X(39) VALUE SPACES. IF1074.2 +013300 01 CCVS-H-2A. IF1074.2 +013400 02 FILLER PIC X(40) VALUE SPACE. IF1074.2 +013500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1074.2 +013600 02 FILLER PIC XXXX VALUE IF1074.2 +013700 "4.2 ". IF1074.2 +013800 02 FILLER PIC X(28) VALUE IF1074.2 +013900 " COPY - NOT FOR DISTRIBUTION". IF1074.2 +014000 02 FILLER PIC X(41) VALUE SPACE. IF1074.2 +014100 IF1074.2 +014200 01 CCVS-H-2B. IF1074.2 +014300 02 FILLER PIC X(15) VALUE IF1074.2 +014400 "TEST RESULT OF ". IF1074.2 +014500 02 TEST-ID PIC X(9). IF1074.2 +014600 02 FILLER PIC X(4) VALUE IF1074.2 +014700 " IN ". IF1074.2 +014800 02 FILLER PIC X(12) VALUE IF1074.2 +014900 " HIGH ". IF1074.2 +015000 02 FILLER PIC X(22) VALUE IF1074.2 +015100 " LEVEL VALIDATION FOR ". IF1074.2 +015200 02 FILLER PIC X(58) VALUE IF1074.2 +015300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1074.2 +015400 01 CCVS-H-3. IF1074.2 +015500 02 FILLER PIC X(34) VALUE IF1074.2 +015600 " FOR OFFICIAL USE ONLY ". IF1074.2 +015700 02 FILLER PIC X(58) VALUE IF1074.2 +015800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1074.2 +015900 02 FILLER PIC X(28) VALUE IF1074.2 +016000 " COPYRIGHT 1985 ". IF1074.2 +016100 01 CCVS-E-1. IF1074.2 +016200 02 FILLER PIC X(52) VALUE SPACE. IF1074.2 +016300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1074.2 +016400 02 ID-AGAIN PIC X(9). IF1074.2 +016500 02 FILLER PIC X(45) VALUE SPACES. IF1074.2 +016600 01 CCVS-E-2. IF1074.2 +016700 02 FILLER PIC X(31) VALUE SPACE. IF1074.2 +016800 02 FILLER PIC X(21) VALUE SPACE. IF1074.2 +016900 02 CCVS-E-2-2. IF1074.2 +017000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1074.2 +017100 03 FILLER PIC X VALUE SPACE. IF1074.2 +017200 03 ENDER-DESC PIC X(44) VALUE IF1074.2 +017300 "ERRORS ENCOUNTERED". IF1074.2 +017400 01 CCVS-E-3. IF1074.2 +017500 02 FILLER PIC X(22) VALUE IF1074.2 +017600 " FOR OFFICIAL USE ONLY". IF1074.2 +017700 02 FILLER PIC X(12) VALUE SPACE. IF1074.2 +017800 02 FILLER PIC X(58) VALUE IF1074.2 +017900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1074.2 +018000 02 FILLER PIC X(13) VALUE SPACE. IF1074.2 +018100 02 FILLER PIC X(15) VALUE IF1074.2 +018200 " COPYRIGHT 1985". IF1074.2 +018300 01 CCVS-E-4. IF1074.2 +018400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1074.2 +018500 02 FILLER PIC X(4) VALUE " OF ". IF1074.2 +018600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1074.2 +018700 02 FILLER PIC X(40) VALUE IF1074.2 +018800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1074.2 +018900 01 XXINFO. IF1074.2 +019000 02 FILLER PIC X(19) VALUE IF1074.2 +019100 "*** INFORMATION ***". IF1074.2 +019200 02 INFO-TEXT. IF1074.2 +019300 04 FILLER PIC X(8) VALUE SPACE. IF1074.2 +019400 04 XXCOMPUTED PIC X(20). IF1074.2 +019500 04 FILLER PIC X(5) VALUE SPACE. IF1074.2 +019600 04 XXCORRECT PIC X(20). IF1074.2 +019700 02 INF-ANSI-REFERENCE PIC X(48). IF1074.2 +019800 01 HYPHEN-LINE. IF1074.2 +019900 02 FILLER PIC IS X VALUE IS SPACE. IF1074.2 +020000 02 FILLER PIC IS X(65) VALUE IS "************************IF1074.2 +020100- "*****************************************". IF1074.2 +020200 02 FILLER PIC IS X(54) VALUE IS "************************IF1074.2 +020300- "******************************". IF1074.2 +020400 01 CCVS-PGM-ID PIC X(9) VALUE IF1074.2 +020500 "IF107A". IF1074.2 +020600 PROCEDURE DIVISION. IF1074.2 +020700 CCVS1 SECTION. IF1074.2 +020800 OPEN-FILES. IF1074.2 +020900 OPEN OUTPUT PRINT-FILE. IF1074.2 +021000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1074.2 +021100 MOVE SPACE TO TEST-RESULTS. IF1074.2 +021200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1074.2 +021300 GO TO CCVS1-EXIT. IF1074.2 +021400 CLOSE-FILES. IF1074.2 +021500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1074.2 +021600 TERMINATE-CCVS. IF1074.2 +021700 STOP RUN. IF1074.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1074.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1074.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1074.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1074.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. IF1074.2 +022300 PRINT-DETAIL. IF1074.2 +022400 IF REC-CT NOT EQUAL TO ZERO IF1074.2 +022500 MOVE "." TO PARDOT-X IF1074.2 +022600 MOVE REC-CT TO DOTVALUE. IF1074.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1074.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1074.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1074.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1074.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1074.2 +023200 MOVE SPACE TO CORRECT-X. IF1074.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1074.2 +023400 MOVE SPACE TO RE-MARK. IF1074.2 +023500 HEAD-ROUTINE. IF1074.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1074.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1074.2 +024000 COLUMN-NAMES-ROUTINE. IF1074.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +024400 END-ROUTINE. IF1074.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 IF1074.2 +024600 TIMES. IF1074.2 +024700 END-RTN-EXIT. IF1074.2 +024800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +024900 END-ROUTINE-1. IF1074.2 +025000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1074.2 +025100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1074.2 +025200 ADD PASS-COUNTER TO ERROR-HOLD. IF1074.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1074.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1074.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1074.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1074.2 +025700 END-ROUTINE-12. IF1074.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1074.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1074.2 +026000 MOVE "NO " TO ERROR-TOTAL IF1074.2 +026100 ELSE IF1074.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1074.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1074.2 +026400 PERFORM WRITE-LINE. IF1074.2 +026500 END-ROUTINE-13. IF1074.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1074.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE IF1074.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1074.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1074.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO IF1074.2 +027200 MOVE "NO " TO ERROR-TOTAL IF1074.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1074.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1074.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1074.2 +027700 WRITE-LINE. IF1074.2 +027800 ADD 1 TO RECORD-COUNT. IF1074.2 +027900 IF RECORD-COUNT GREATER 42 IF1074.2 +028000 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1074.2 +028100 MOVE SPACE TO DUMMY-RECORD IF1074.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1074.2 +028300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1074.2 +028400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1074.2 +028500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1074.2 +028600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1074.2 +028700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1074.2 +028800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1074.2 +028900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1074.2 +029000 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1074.2 +029100 MOVE ZERO TO RECORD-COUNT. IF1074.2 +029200 PERFORM WRT-LN. IF1074.2 +029300 WRT-LN. IF1074.2 +029400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1074.2 +029500 MOVE SPACE TO DUMMY-RECORD. IF1074.2 +029600 BLANK-LINE-PRINT. IF1074.2 +029700 PERFORM WRT-LN. IF1074.2 +029800 FAIL-ROUTINE. IF1074.2 +029900 IF COMPUTED-X NOT EQUAL TO SPACE IF1074.2 +030000 GO TO FAIL-ROUTINE-WRITE. IF1074.2 +030100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1074.2 +030200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1074.2 +030300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1074.2 +030400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +030500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1074.2 +030600 GO TO FAIL-ROUTINE-EX. IF1074.2 +030700 FAIL-ROUTINE-WRITE. IF1074.2 +030800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1074.2 +030900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1074.2 +031000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1074.2 +031100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1074.2 +031200 FAIL-ROUTINE-EX. EXIT. IF1074.2 +031300 BAIL-OUT. IF1074.2 +031400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1074.2 +031500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1074.2 +031600 BAIL-OUT-WRITE. IF1074.2 +031700 MOVE CORRECT-A TO XXCORRECT. IF1074.2 +031800 MOVE COMPUTED-A TO XXCOMPUTED. IF1074.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1074.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1074.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1074.2 +032200 BAIL-OUT-EX. EXIT. IF1074.2 +032300 CCVS1-EXIT. IF1074.2 +032400 EXIT. IF1074.2 +032500******************************************************** IF1074.2 +032600* * IF1074.2 +032700* Intrinsic Function Tests IF107A - CURRENT-DATE * IF1074.2 +032800* * IF1074.2 +032900******************************************************** IF1074.2 +033000 SECT-IF107A SECTION. IF1074.2 +033100 F-WHENCOMP-INFO. IF1074.2 +033200 MOVE "See ref. A-39 2.11" TO ANSI-REFERENCE. IF1074.2 +033300 MOVE "CURRENT-DATE" TO FEATURE. IF1074.2 +033400*****************TEST (a) ****************************** IF1074.2 +033500 F-WHENCOMP-01. IF1074.2 +033600 MOVE SPACES TO TEMP1. IF1074.2 +033700 MOVE SPACES TO WS-DATE. IF1074.2 +033800 F-WHENCOMP-TEST-01. IF1074.2 +033900 MOVE FUNCTION CURRENT-DATE TO TEMP1. IF1074.2 +034000 MOVE TEMP1 TO WS-DATE. IF1074.2 +034100 IF CON-YEAR AND IF1074.2 +034200 CON-MONTH AND IF1074.2 +034300 CON-DAY AND IF1074.2 +034400 CON-HOUR AND IF1074.2 +034500 CON-MIN AND IF1074.2 +034600 CON-SEC AND IF1074.2 +034700 CON-HUNDSEC AND IF1074.2 +034800 CON-GREENW AND IF1074.2 +034900 CON-OFFSET AND IF1074.2 +035000 CON-OFFSET2 THEN IF1074.2 +035100 PERFORM PASS IF1074.2 +035200 ELSE IF1074.2 +035300 MOVE TEMP1 TO COMPUTED-A IF1074.2 +035400 MOVE "Date & Time value " TO CORRECT-X IF1074.2 +035500 PERFORM FAIL. IF1074.2 +035600 GO TO F-WHENCOMP-WRITE-01. IF1074.2 +035700 F-WHENCOMP-DELETE-01. IF1074.2 +035800 PERFORM DE-LETE. IF1074.2 +035900 GO TO F-WHENCOMP-WRITE-01. IF1074.2 +036000 F-WHENCOMP-WRITE-01. IF1074.2 +036100 MOVE "F-WHENCOMP-01" TO PAR-NAME. IF1074.2 +036200 PERFORM PRINT-DETAIL. IF1074.2 +036300*****************TEST (b) ****************************** IF1074.2 +036400 F-WHENCOMP-TEST-02. IF1074.2 +036500 IF FUNCTION CURRENT-DATE >= TEMP1 THEN IF1074.2 +036600 PERFORM PASS IF1074.2 +036700 ELSE IF1074.2 +036800 PERFORM FAIL. IF1074.2 +036900 GO TO F-WHENCOMP-WRITE-02. IF1074.2 +037000 F-WHENCOMP-DELETE-02. IF1074.2 +037100 PERFORM DE-LETE. IF1074.2 +037200 GO TO F-WHENCOMP-WRITE-02. IF1074.2 +037300 F-WHENCOMP-WRITE-02. IF1074.2 +037400 MOVE "F-WHENCOMP-02" TO PAR-NAME. IF1074.2 +037500 PERFORM PRINT-DETAIL. IF1074.2 +037600*******************END OF TESTS************************** IF1074.2 +037700 CCVS-EXIT SECTION. IF1074.2 +037800 CCVS-999999. IF1074.2 +037900 GO TO CLOSE-FILES. IF1074.2 diff --git a/tests/cobol85/IF/IF108A.CBL b/tests/cobol85/IF/IF108A.CBL new file mode 100755 index 00000000..c5c75c87 --- /dev/null +++ b/tests/cobol85/IF/IF108A.CBL @@ -0,0 +1,489 @@ +000100 IDENTIFICATION DIVISION. IF1084.2 +000200 PROGRAM-ID. IF1084.2 +000300 IF108A. IF1084.2 +000400 IF1084.2 +000500*********************************************************** IF1084.2 +000600* * IF1084.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1084.2 +000800* It contains tests for the Intrinsic Function * IF1084.2 +000900* DATE-OF-INTEGER. * IF1084.2 +001000* * IF1084.2 +001100*********************************************************** IF1084.2 +001200 ENVIRONMENT DIVISION. IF1084.2 +001300 CONFIGURATION SECTION. IF1084.2 +001400 SOURCE-COMPUTER. IF1084.2 +001500 Linux. IF1084.2 +001600 OBJECT-COMPUTER. IF1084.2 +001700 Linux. IF1084.2 +001800 INPUT-OUTPUT SECTION. IF1084.2 +001900 FILE-CONTROL. IF1084.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1084.2 +002100 "report.log". IF1084.2 +002200 DATA DIVISION. IF1084.2 +002300 FILE SECTION. IF1084.2 +002400 FD PRINT-FILE. IF1084.2 +002500 01 PRINT-REC PICTURE X(120). IF1084.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1084.2 +002700 WORKING-STORAGE SECTION. IF1084.2 +002800*********************************************************** IF1084.2 +002900* Variables specific to the Intrinsic Function Test IF108A* IF1084.2 +003000*********************************************************** IF1084.2 +003100 01 A PIC S9(10) VALUE 400. IF1084.2 +003200 01 C PIC S9(10) VALUE 300. IF1084.2 +003300 01 D PIC S9(10) VALUE 1. IF1084.2 +003400 01 ARG1 PIC S9(10) VALUE 1. IF1084.2 +003500 01 ARR VALUE "40537". IF1084.2 +003600 02 IND OCCURS 5 TIMES PIC 9. IF1084.2 +003700 01 TEMP PIC S9(5)V9(5). IF1084.2 +003800 01 WS-DATE PIC 9(8). IF1084.2 +003900* IF1084.2 +004000********************************************************** IF1084.2 +004100* IF1084.2 +004200 01 TEST-RESULTS. IF1084.2 +004300 02 FILLER PIC X VALUE SPACE. IF1084.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1084.2 +004500 02 FILLER PIC X VALUE SPACE. IF1084.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1084.2 +004700 02 FILLER PIC X VALUE SPACE. IF1084.2 +004800 02 PAR-NAME. IF1084.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1084.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1084.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1084.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1084.2 +005300 02 RE-MARK PIC X(61). IF1084.2 +005400 01 TEST-COMPUTED. IF1084.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1084.2 +005600 02 FILLER PIC X(17) VALUE IF1084.2 +005700 " COMPUTED=". IF1084.2 +005800 02 COMPUTED-X. IF1084.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1084.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1084.2 +006100 PIC -9(9).9(9). IF1084.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1084.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1084.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1084.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1084.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1084.2 +006700 04 FILLER PIC X. IF1084.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1084.2 +006900 01 TEST-CORRECT. IF1084.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1084.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1084.2 +007200 02 CORRECT-X. IF1084.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1084.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1084.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1084.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1084.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1084.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1084.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1084.2 +008000 04 FILLER PIC X. IF1084.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1084.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1084.2 +008300 01 CCVS-C-1. IF1084.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1084.2 +008500- "SS PARAGRAPH-NAME IF1084.2 +008600- " REMARKS". IF1084.2 +008700 02 FILLER PIC X(20) VALUE SPACE. IF1084.2 +008800 01 CCVS-C-2. IF1084.2 +008900 02 FILLER PIC X VALUE SPACE. IF1084.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". IF1084.2 +009100 02 FILLER PIC X(15) VALUE SPACE. IF1084.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". IF1084.2 +009300 02 FILLER PIC X(94) VALUE SPACE. IF1084.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1084.2 +009500 01 REC-CT PIC 99 VALUE ZERO. IF1084.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1084.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1084.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1084.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1084.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1084.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1084.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1084.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1084.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1084.2 +010500 01 CCVS-H-1. IF1084.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IF1084.2 +010700 02 FILLER PIC X(42) VALUE IF1084.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1084.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IF1084.2 +011000 01 CCVS-H-2A. IF1084.2 +011100 02 FILLER PIC X(40) VALUE SPACE. IF1084.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1084.2 +011300 02 FILLER PIC XXXX VALUE IF1084.2 +011400 "4.2 ". IF1084.2 +011500 02 FILLER PIC X(28) VALUE IF1084.2 +011600 " COPY - NOT FOR DISTRIBUTION". IF1084.2 +011700 02 FILLER PIC X(41) VALUE SPACE. IF1084.2 +011800 IF1084.2 +011900 01 CCVS-H-2B. IF1084.2 +012000 02 FILLER PIC X(15) VALUE IF1084.2 +012100 "TEST RESULT OF ". IF1084.2 +012200 02 TEST-ID PIC X(9). IF1084.2 +012300 02 FILLER PIC X(4) VALUE IF1084.2 +012400 " IN ". IF1084.2 +012500 02 FILLER PIC X(12) VALUE IF1084.2 +012600 " HIGH ". IF1084.2 +012700 02 FILLER PIC X(22) VALUE IF1084.2 +012800 " LEVEL VALIDATION FOR ". IF1084.2 +012900 02 FILLER PIC X(58) VALUE IF1084.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1084.2 +013100 01 CCVS-H-3. IF1084.2 +013200 02 FILLER PIC X(34) VALUE IF1084.2 +013300 " FOR OFFICIAL USE ONLY ". IF1084.2 +013400 02 FILLER PIC X(58) VALUE IF1084.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1084.2 +013600 02 FILLER PIC X(28) VALUE IF1084.2 +013700 " COPYRIGHT 1985 ". IF1084.2 +013800 01 CCVS-E-1. IF1084.2 +013900 02 FILLER PIC X(52) VALUE SPACE. IF1084.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1084.2 +014100 02 ID-AGAIN PIC X(9). IF1084.2 +014200 02 FILLER PIC X(45) VALUE SPACES. IF1084.2 +014300 01 CCVS-E-2. IF1084.2 +014400 02 FILLER PIC X(31) VALUE SPACE. IF1084.2 +014500 02 FILLER PIC X(21) VALUE SPACE. IF1084.2 +014600 02 CCVS-E-2-2. IF1084.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1084.2 +014800 03 FILLER PIC X VALUE SPACE. IF1084.2 +014900 03 ENDER-DESC PIC X(44) VALUE IF1084.2 +015000 "ERRORS ENCOUNTERED". IF1084.2 +015100 01 CCVS-E-3. IF1084.2 +015200 02 FILLER PIC X(22) VALUE IF1084.2 +015300 " FOR OFFICIAL USE ONLY". IF1084.2 +015400 02 FILLER PIC X(12) VALUE SPACE. IF1084.2 +015500 02 FILLER PIC X(58) VALUE IF1084.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1084.2 +015700 02 FILLER PIC X(13) VALUE SPACE. IF1084.2 +015800 02 FILLER PIC X(15) VALUE IF1084.2 +015900 " COPYRIGHT 1985". IF1084.2 +016000 01 CCVS-E-4. IF1084.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1084.2 +016200 02 FILLER PIC X(4) VALUE " OF ". IF1084.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1084.2 +016400 02 FILLER PIC X(40) VALUE IF1084.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1084.2 +016600 01 XXINFO. IF1084.2 +016700 02 FILLER PIC X(19) VALUE IF1084.2 +016800 "*** INFORMATION ***". IF1084.2 +016900 02 INFO-TEXT. IF1084.2 +017000 04 FILLER PIC X(8) VALUE SPACE. IF1084.2 +017100 04 XXCOMPUTED PIC X(20). IF1084.2 +017200 04 FILLER PIC X(5) VALUE SPACE. IF1084.2 +017300 04 XXCORRECT PIC X(20). IF1084.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). IF1084.2 +017500 01 HYPHEN-LINE. IF1084.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. IF1084.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************IF1084.2 +017800- "*****************************************". IF1084.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************IF1084.2 +018000- "******************************". IF1084.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE IF1084.2 +018200 "IF108A". IF1084.2 +018300 PROCEDURE DIVISION. IF1084.2 +018400 CCVS1 SECTION. IF1084.2 +018500 OPEN-FILES. IF1084.2 +018600 OPEN OUTPUT PRINT-FILE. IF1084.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1084.2 +018800 MOVE SPACE TO TEST-RESULTS. IF1084.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1084.2 +019000 GO TO CCVS1-EXIT. IF1084.2 +019100 CLOSE-FILES. IF1084.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1084.2 +019300 TERMINATE-CCVS. IF1084.2 +019400 STOP RUN. IF1084.2 +019500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1084.2 +019600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1084.2 +019700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1084.2 +019800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1084.2 +019900 MOVE "****TEST DELETED****" TO RE-MARK. IF1084.2 +020000 PRINT-DETAIL. IF1084.2 +020100 IF REC-CT NOT EQUAL TO ZERO IF1084.2 +020200 MOVE "." TO PARDOT-X IF1084.2 +020300 MOVE REC-CT TO DOTVALUE. IF1084.2 +020400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1084.2 +020500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1084.2 +020600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1084.2 +020700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1084.2 +020800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1084.2 +020900 MOVE SPACE TO CORRECT-X. IF1084.2 +021000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1084.2 +021100 MOVE SPACE TO RE-MARK. IF1084.2 +021200 HEAD-ROUTINE. IF1084.2 +021300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +021400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +021500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1084.2 +021600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1084.2 +021700 COLUMN-NAMES-ROUTINE. IF1084.2 +021800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +021900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +022000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +022100 END-ROUTINE. IF1084.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1084.2 +022300 END-RTN-EXIT. IF1084.2 +022400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +022500 END-ROUTINE-1. IF1084.2 +022600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1084.2 +022700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1084.2 +022800 ADD PASS-COUNTER TO ERROR-HOLD. IF1084.2 +022900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1084.2 +023000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1084.2 +023100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1084.2 +023200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1084.2 +023300 END-ROUTINE-12. IF1084.2 +023400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1084.2 +023500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1084.2 +023600 MOVE "NO " TO ERROR-TOTAL IF1084.2 +023700 ELSE IF1084.2 +023800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1084.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1084.2 +024000 PERFORM WRITE-LINE. IF1084.2 +024100 END-ROUTINE-13. IF1084.2 +024200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1084.2 +024300 MOVE "NO " TO ERROR-TOTAL ELSE IF1084.2 +024400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1084.2 +024500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1084.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +024700 IF INSPECT-COUNTER EQUAL TO ZERO IF1084.2 +024800 MOVE "NO " TO ERROR-TOTAL IF1084.2 +024900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1084.2 +025000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1084.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +025200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1084.2 +025300 WRITE-LINE. IF1084.2 +025400 ADD 1 TO RECORD-COUNT. IF1084.2 +025500 IF RECORD-COUNT GREATER 42 IF1084.2 +025600 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1084.2 +025700 MOVE SPACE TO DUMMY-RECORD IF1084.2 +025800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1084.2 +025900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1084.2 +026000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1084.2 +026100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1084.2 +026200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1084.2 +026300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1084.2 +026400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1084.2 +026500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1084.2 +026600 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1084.2 +026700 MOVE ZERO TO RECORD-COUNT. IF1084.2 +026800 PERFORM WRT-LN. IF1084.2 +026900 WRT-LN. IF1084.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1084.2 +027100 MOVE SPACE TO DUMMY-RECORD. IF1084.2 +027200 BLANK-LINE-PRINT. IF1084.2 +027300 PERFORM WRT-LN. IF1084.2 +027400 FAIL-ROUTINE. IF1084.2 +027500 IF COMPUTED-X NOT EQUAL TO SPACE IF1084.2 +027600 GO TO FAIL-ROUTINE-WRITE. IF1084.2 +027700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1084.2 +027800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1084.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1084.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +028100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1084.2 +028200 GO TO FAIL-ROUTINE-EX. IF1084.2 +028300 FAIL-ROUTINE-WRITE. IF1084.2 +028400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1084.2 +028500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1084.2 +028600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1084.2 +028700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1084.2 +028800 FAIL-ROUTINE-EX. EXIT. IF1084.2 +028900 BAIL-OUT. IF1084.2 +029000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1084.2 +029100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1084.2 +029200 BAIL-OUT-WRITE. IF1084.2 +029300 MOVE CORRECT-A TO XXCORRECT. IF1084.2 +029400 MOVE COMPUTED-A TO XXCOMPUTED. IF1084.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1084.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1084.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1084.2 +029800 BAIL-OUT-EX. EXIT. IF1084.2 +029900 CCVS1-EXIT. IF1084.2 +030000 EXIT. IF1084.2 +030100******************************************************** IF1084.2 +030200* * IF1084.2 +030300* Intrinsic Function Test IF108A - DATE-OF-INTEGER * IF1084.2 +030400* * IF1084.2 +030500******************************************************** IF1084.2 +030600 SECT-IF108A SECTION. IF1084.2 +030700 F-DATEOFINT-INFO. IF1084.2 +030800 MOVE "See ref. A-41 2.12" TO ANSI-REFERENCE. IF1084.2 +030900 MOVE "DATE-OF-INTEGER" TO FEATURE. IF1084.2 +031000*****************TEST (a) ****************************** IF1084.2 +031100 F-DATEOFINT-01. IF1084.2 +031200 MOVE ZERO TO WS-DATE. IF1084.2 +031300 F-DATEOFINT-TEST-01. IF1084.2 +031400 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(1). IF1084.2 +031500 IF WS-DATE = 16010101 THEN IF1084.2 +031600 PERFORM PASS IF1084.2 +031700 ELSE IF1084.2 +031800 MOVE 16010101 TO CORRECT-N IF1084.2 +031900 MOVE WS-DATE TO COMPUTED-N IF1084.2 +032000 PERFORM FAIL. IF1084.2 +032100 GO TO F-DATEOFINT-WRITE-01. IF1084.2 +032200 F-DATEOFINT-DELETE-01. IF1084.2 +032300 PERFORM DE-LETE. IF1084.2 +032400 GO TO F-DATEOFINT-WRITE-01. IF1084.2 +032500 F-DATEOFINT-WRITE-01. IF1084.2 +032600 MOVE "F-DATEOFINT-01" TO PAR-NAME. IF1084.2 +032700 PERFORM PRINT-DETAIL. IF1084.2 +032800*****************TEST (b) ****************************** IF1084.2 +032900 F-DATEOFINT-TEST-02. IF1084.2 +033000 EVALUATE FUNCTION DATE-OF-INTEGER(A) IF1084.2 +033100 WHEN 16020204 IF1084.2 +033200 PERFORM PASS IF1084.2 +033300 GO TO F-DATEOFINT-WRITE-02. IF1084.2 +033400 PERFORM FAIL. IF1084.2 +033500 GO TO F-DATEOFINT-WRITE-02. IF1084.2 +033600 F-DATEOFINT-DELETE-02. IF1084.2 +033700 PERFORM DE-LETE. IF1084.2 +033800 GO TO F-DATEOFINT-WRITE-02. IF1084.2 +033900 F-DATEOFINT-WRITE-02. IF1084.2 +034000 MOVE "F-DATEOFINT-02" TO PAR-NAME. IF1084.2 +034100 PERFORM PRINT-DETAIL. IF1084.2 +034200*****************TEST (c) ****************************** IF1084.2 +034300 F-DATEOFINT-TEST-03. IF1084.2 +034400 IF FUNCTION DATE-OF-INTEGER(IND(1)) = 16010104 THEN IF1084.2 +034500 PERFORM PASS IF1084.2 +034600 ELSE IF1084.2 +034700 PERFORM FAIL. IF1084.2 +034800 GO TO F-DATEOFINT-WRITE-03. IF1084.2 +034900 F-DATEOFINT-DELETE-03. IF1084.2 +035000 PERFORM DE-LETE. IF1084.2 +035100 GO TO F-DATEOFINT-WRITE-03. IF1084.2 +035200 F-DATEOFINT-WRITE-03. IF1084.2 +035300 MOVE "F-DATEOFINT-03" TO PAR-NAME. IF1084.2 +035400 PERFORM PRINT-DETAIL. IF1084.2 +035500*****************TEST (d) ****************************** IF1084.2 +035600 F-DATEOFINT-04. IF1084.2 +035700 MOVE ZERO TO WS-DATE. IF1084.2 +035800 F-DATEOFINT-TEST-04. IF1084.2 +035900 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(IND(D)). IF1084.2 +036000 IF WS-DATE = 16010104 THEN IF1084.2 +036100 PERFORM PASS IF1084.2 +036200 ELSE IF1084.2 +036300 MOVE 16010104 TO CORRECT-N IF1084.2 +036400 MOVE WS-DATE TO COMPUTED-N IF1084.2 +036500 PERFORM FAIL. IF1084.2 +036600 GO TO F-DATEOFINT-WRITE-04. IF1084.2 +036700 F-DATEOFINT-DELETE-04. IF1084.2 +036800 PERFORM DE-LETE. IF1084.2 +036900 GO TO F-DATEOFINT-WRITE-04. IF1084.2 +037000 F-DATEOFINT-WRITE-04. IF1084.2 +037100 MOVE "F-DATEOFINT-04" TO PAR-NAME. IF1084.2 +037200 PERFORM PRINT-DETAIL. IF1084.2 +037300*****************TEST (e) ****************************** IF1084.2 +037400 F-DATEOFINT-05. IF1084.2 +037500 MOVE ZERO TO WS-DATE. IF1084.2 +037600 F-DATEOFINT-TEST-05. IF1084.2 +037700 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(730). IF1084.2 +037800 IF WS-DATE = 16021231 THEN IF1084.2 +037900 PERFORM PASS IF1084.2 +038000 ELSE IF1084.2 +038100 MOVE 16021231 TO CORRECT-N IF1084.2 +038200 MOVE WS-DATE TO COMPUTED-N IF1084.2 +038300 PERFORM FAIL. IF1084.2 +038400 GO TO F-DATEOFINT-WRITE-05. IF1084.2 +038500 F-DATEOFINT-DELETE-05. IF1084.2 +038600 PERFORM DE-LETE. IF1084.2 +038700 GO TO F-DATEOFINT-WRITE-05. IF1084.2 +038800 F-DATEOFINT-WRITE-05. IF1084.2 +038900 MOVE "F-DATEOFINT-05" TO PAR-NAME. IF1084.2 +039000 PERFORM PRINT-DETAIL. IF1084.2 +039100*****************TEST (f) ****************************** IF1084.2 +039200 F-DATEOFINT-06. IF1084.2 +039300 MOVE ZERO TO WS-DATE. IF1084.2 +039400 F-DATEOFINT-TEST-06. IF1084.2 +039500 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(C). IF1084.2 +039600 IF WS-DATE = 16011027 THEN IF1084.2 +039700 PERFORM PASS IF1084.2 +039800 ELSE IF1084.2 +039900 MOVE 16011027 TO CORRECT-N IF1084.2 +040000 MOVE WS-DATE TO COMPUTED-N IF1084.2 +040100 PERFORM FAIL. IF1084.2 +040200 GO TO F-DATEOFINT-WRITE-06. IF1084.2 +040300 F-DATEOFINT-DELETE-06. IF1084.2 +040400 PERFORM DE-LETE. IF1084.2 +040500 GO TO F-DATEOFINT-WRITE-06. IF1084.2 +040600 F-DATEOFINT-WRITE-06. IF1084.2 +040700 MOVE "F-DATEOFINT-06" TO PAR-NAME. IF1084.2 +040800 PERFORM PRINT-DETAIL. IF1084.2 +040900*****************TEST (g) ****************************** IF1084.2 +041000 F-DATEOFINT-07. IF1084.2 +041100 MOVE ZERO TO WS-DATE. IF1084.2 +041200 F-DATEOFINT-TEST-07. IF1084.2 +041300 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(365). IF1084.2 +041400 IF WS-DATE = 16011231 THEN IF1084.2 +041500 PERFORM PASS IF1084.2 +041600 ELSE IF1084.2 +041700 MOVE 16011231 TO CORRECT-N IF1084.2 +041800 MOVE WS-DATE TO COMPUTED-N IF1084.2 +041900 PERFORM FAIL. IF1084.2 +042000 GO TO F-DATEOFINT-WRITE-07. IF1084.2 +042100 F-DATEOFINT-DELETE-07. IF1084.2 +042200 PERFORM DE-LETE. IF1084.2 +042300 GO TO F-DATEOFINT-WRITE-07. IF1084.2 +042400 F-DATEOFINT-WRITE-07. IF1084.2 +042500 MOVE "F-DATEOFINT-07" TO PAR-NAME. IF1084.2 +042600 PERFORM PRINT-DETAIL. IF1084.2 +042700*****************TEST (h) ****************************** IF1084.2 +042800 F-DATEOFINT-08. IF1084.2 +042900 MOVE ZERO TO WS-DATE. IF1084.2 +043000 F-DATEOFINT-TEST-08. IF1084.2 +043100 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(D) + 10. IF1084.2 +043200 IF WS-DATE = 16010111 THEN IF1084.2 +043300 PERFORM PASS IF1084.2 +043400 ELSE IF1084.2 +043500 MOVE 16010111 TO CORRECT-N IF1084.2 +043600 MOVE WS-DATE TO COMPUTED-N IF1084.2 +043700 PERFORM FAIL. IF1084.2 +043800 GO TO F-DATEOFINT-WRITE-08. IF1084.2 +043900 F-DATEOFINT-DELETE-08. IF1084.2 +044000 PERFORM DE-LETE. IF1084.2 +044100 GO TO F-DATEOFINT-WRITE-08. IF1084.2 +044200 F-DATEOFINT-WRITE-08. IF1084.2 +044300 MOVE "F-DATEOFINT-08" TO PAR-NAME. IF1084.2 +044400 PERFORM PRINT-DETAIL. IF1084.2 +044500*****************TEST (i) ****************************** IF1084.2 +044600 F-DATEOFINT-09. IF1084.2 +044700 MOVE ZERO TO WS-DATE. IF1084.2 +044800 F-DATEOFINT-TEST-09. IF1084.2 +044900 COMPUTE WS-DATE = FUNCTION DATE-OF-INTEGER(D) + IF1084.2 +045000 FUNCTION DATE-OF-INTEGER(D). IF1084.2 +045100 IF WS-DATE = 32020202 THEN IF1084.2 +045200 PERFORM PASS IF1084.2 +045300 ELSE IF1084.2 +045400 MOVE 32020202 TO CORRECT-N IF1084.2 +045500 MOVE WS-DATE TO COMPUTED-N IF1084.2 +045600 PERFORM FAIL. IF1084.2 +045700 GO TO F-DATEOFINT-WRITE-09. IF1084.2 +045800 F-DATEOFINT-DELETE-09. IF1084.2 +045900 PERFORM DE-LETE. IF1084.2 +046000 GO TO F-DATEOFINT-WRITE-09. IF1084.2 +046100 F-DATEOFINT-WRITE-09. IF1084.2 +046200 MOVE "F-DATEOFINT-09" TO PAR-NAME. IF1084.2 +046300 PERFORM PRINT-DETAIL. IF1084.2 +046400 IF1084.2 +046500***************** SPECIAL TEST 1 *********************** IF1084.2 +046600 IF1084.2 +046700 F-DATEOFINT-10. IF1084.2 +046800 MOVE 1 TO ARG1. IF1084.2 +046900 PERFORM F-DATEOFINT-TEST-10 IF1084.2 +047000 UNTIL FUNCTION DATE-OF-INTEGER(ARG1) > 16010110. IF1084.2 +047100 IF ARG1 = 11 THEN IF1084.2 +047200 PERFORM PASS IF1084.2 +047300 ELSE IF1084.2 +047400 PERFORM FAIL. IF1084.2 +047500 GO TO F-DATEOFINT-WRITE-10. IF1084.2 +047600* IF1084.2 +047700 F-DATEOFINT-TEST-10. IF1084.2 +047800 COMPUTE ARG1 = ARG1 + 1. IF1084.2 +047900* IF1084.2 +048000 F-DATEOFINT-DELETE-10. IF1084.2 +048100 PERFORM DE-LETE. IF1084.2 +048200 GO TO F-DATEOFINT-WRITE-10. IF1084.2 +048300 F-DATEOFINT-WRITE-10. IF1084.2 +048400 MOVE "F-DATEOFINT-10" TO PAR-NAME. IF1084.2 +048500 PERFORM PRINT-DETAIL. IF1084.2 +048600*******************END OF TESTS************************** IF1084.2 +048700 CCVS-EXIT SECTION. IF1084.2 +048800 CCVS-999999. IF1084.2 +048900 GO TO CLOSE-FILES. IF1084.2 diff --git a/tests/cobol85/IF/IF109A.CBL b/tests/cobol85/IF/IF109A.CBL new file mode 100755 index 00000000..4af75ab0 --- /dev/null +++ b/tests/cobol85/IF/IF109A.CBL @@ -0,0 +1,451 @@ +000100 IDENTIFICATION DIVISION. IF1094.2 +000200 PROGRAM-ID. IF1094.2 +000300 IF109A. IF1094.2 +000400 IF1094.2 +000500*********************************************************** IF1094.2 +000600* * IF1094.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1094.2 +000800* It contains tests for the Intrinsic Function * IF1094.2 +000900* DAY-OF-INTEGER. * IF1094.2 +001000* * IF1094.2 +001100*********************************************************** IF1094.2 +001200 ENVIRONMENT DIVISION. IF1094.2 +001300 CONFIGURATION SECTION. IF1094.2 +001400 SOURCE-COMPUTER. IF1094.2 +001500 Linux. IF1094.2 +001600 OBJECT-COMPUTER. IF1094.2 +001700 Linux. IF1094.2 +001800 INPUT-OUTPUT SECTION. IF1094.2 +001900 FILE-CONTROL. IF1094.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1094.2 +002100 "report.log". IF1094.2 +002200 DATA DIVISION. IF1094.2 +002300 FILE SECTION. IF1094.2 +002400 FD PRINT-FILE. IF1094.2 +002500 01 PRINT-REC PICTURE X(120). IF1094.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1094.2 +002700 WORKING-STORAGE SECTION. IF1094.2 +002800*********************************************************** IF1094.2 +002900* Variables specific to the Intrinsic Function Test IF109A* IF1094.2 +003000*********************************************************** IF1094.2 +003100 01 A PIC S9(10) VALUE 400. IF1094.2 +003200 01 C PIC S9(10) VALUE 365. IF1094.2 +003300 01 D PIC S9(10) VALUE 1. IF1094.2 +003400 01 ARG1 PIC S9(10) VALUE 1. IF1094.2 +003500 01 ARR VALUE "40537". IF1094.2 +003600 02 IND OCCURS 5 TIMES PIC 9. IF1094.2 +003700 01 TEMP PIC S9(5)V9(5). IF1094.2 +003800 01 WS-DATE PIC 9(7). IF1094.2 +003900* IF1094.2 +004000********************************************************** IF1094.2 +004100* IF1094.2 +004200 01 TEST-RESULTS. IF1094.2 +004300 02 FILLER PIC X VALUE SPACE. IF1094.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1094.2 +004500 02 FILLER PIC X VALUE SPACE. IF1094.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1094.2 +004700 02 FILLER PIC X VALUE SPACE. IF1094.2 +004800 02 PAR-NAME. IF1094.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1094.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1094.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1094.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1094.2 +005300 02 RE-MARK PIC X(61). IF1094.2 +005400 01 TEST-COMPUTED. IF1094.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1094.2 +005600 02 FILLER PIC X(17) VALUE IF1094.2 +005700 " COMPUTED=". IF1094.2 +005800 02 COMPUTED-X. IF1094.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1094.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1094.2 +006100 PIC -9(9).9(9). IF1094.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1094.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1094.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1094.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1094.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1094.2 +006700 04 FILLER PIC X. IF1094.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1094.2 +006900 01 TEST-CORRECT. IF1094.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1094.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1094.2 +007200 02 CORRECT-X. IF1094.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1094.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1094.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1094.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1094.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1094.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1094.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1094.2 +008000 04 FILLER PIC X. IF1094.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1094.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1094.2 +008300 01 CCVS-C-1. IF1094.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1094.2 +008500- "SS PARAGRAPH-NAME IF1094.2 +008600- " REMARKS". IF1094.2 +008700 02 FILLER PIC X(20) VALUE SPACE. IF1094.2 +008800 01 CCVS-C-2. IF1094.2 +008900 02 FILLER PIC X VALUE SPACE. IF1094.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". IF1094.2 +009100 02 FILLER PIC X(15) VALUE SPACE. IF1094.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". IF1094.2 +009300 02 FILLER PIC X(94) VALUE SPACE. IF1094.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1094.2 +009500 01 REC-CT PIC 99 VALUE ZERO. IF1094.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1094.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1094.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1094.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1094.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1094.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1094.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1094.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1094.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1094.2 +010500 01 CCVS-H-1. IF1094.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IF1094.2 +010700 02 FILLER PIC X(42) VALUE IF1094.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1094.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IF1094.2 +011000 01 CCVS-H-2A. IF1094.2 +011100 02 FILLER PIC X(40) VALUE SPACE. IF1094.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1094.2 +011300 02 FILLER PIC XXXX VALUE IF1094.2 +011400 "4.2 ". IF1094.2 +011500 02 FILLER PIC X(28) VALUE IF1094.2 +011600 " COPY - NOT FOR DISTRIBUTION". IF1094.2 +011700 02 FILLER PIC X(41) VALUE SPACE. IF1094.2 +011800 IF1094.2 +011900 01 CCVS-H-2B. IF1094.2 +012000 02 FILLER PIC X(15) VALUE IF1094.2 +012100 "TEST RESULT OF ". IF1094.2 +012200 02 TEST-ID PIC X(9). IF1094.2 +012300 02 FILLER PIC X(4) VALUE IF1094.2 +012400 " IN ". IF1094.2 +012500 02 FILLER PIC X(12) VALUE IF1094.2 +012600 " HIGH ". IF1094.2 +012700 02 FILLER PIC X(22) VALUE IF1094.2 +012800 " LEVEL VALIDATION FOR ". IF1094.2 +012900 02 FILLER PIC X(58) VALUE IF1094.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1094.2 +013100 01 CCVS-H-3. IF1094.2 +013200 02 FILLER PIC X(34) VALUE IF1094.2 +013300 " FOR OFFICIAL USE ONLY ". IF1094.2 +013400 02 FILLER PIC X(58) VALUE IF1094.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1094.2 +013600 02 FILLER PIC X(28) VALUE IF1094.2 +013700 " COPYRIGHT 1985 ". IF1094.2 +013800 01 CCVS-E-1. IF1094.2 +013900 02 FILLER PIC X(52) VALUE SPACE. IF1094.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1094.2 +014100 02 ID-AGAIN PIC X(9). IF1094.2 +014200 02 FILLER PIC X(45) VALUE SPACES. IF1094.2 +014300 01 CCVS-E-2. IF1094.2 +014400 02 FILLER PIC X(31) VALUE SPACE. IF1094.2 +014500 02 FILLER PIC X(21) VALUE SPACE. IF1094.2 +014600 02 CCVS-E-2-2. IF1094.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1094.2 +014800 03 FILLER PIC X VALUE SPACE. IF1094.2 +014900 03 ENDER-DESC PIC X(44) VALUE IF1094.2 +015000 "ERRORS ENCOUNTERED". IF1094.2 +015100 01 CCVS-E-3. IF1094.2 +015200 02 FILLER PIC X(22) VALUE IF1094.2 +015300 " FOR OFFICIAL USE ONLY". IF1094.2 +015400 02 FILLER PIC X(12) VALUE SPACE. IF1094.2 +015500 02 FILLER PIC X(58) VALUE IF1094.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1094.2 +015700 02 FILLER PIC X(13) VALUE SPACE. IF1094.2 +015800 02 FILLER PIC X(15) VALUE IF1094.2 +015900 " COPYRIGHT 1985". IF1094.2 +016000 01 CCVS-E-4. IF1094.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1094.2 +016200 02 FILLER PIC X(4) VALUE " OF ". IF1094.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1094.2 +016400 02 FILLER PIC X(40) VALUE IF1094.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1094.2 +016600 01 XXINFO. IF1094.2 +016700 02 FILLER PIC X(19) VALUE IF1094.2 +016800 "*** INFORMATION ***". IF1094.2 +016900 02 INFO-TEXT. IF1094.2 +017000 04 FILLER PIC X(8) VALUE SPACE. IF1094.2 +017100 04 XXCOMPUTED PIC X(20). IF1094.2 +017200 04 FILLER PIC X(5) VALUE SPACE. IF1094.2 +017300 04 XXCORRECT PIC X(20). IF1094.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). IF1094.2 +017500 01 HYPHEN-LINE. IF1094.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. IF1094.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************IF1094.2 +017800- "*****************************************". IF1094.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************IF1094.2 +018000- "******************************". IF1094.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE IF1094.2 +018200 "IF109A". IF1094.2 +018300 PROCEDURE DIVISION. IF1094.2 +018400 CCVS1 SECTION. IF1094.2 +018500 OPEN-FILES. IF1094.2 +018600 OPEN OUTPUT PRINT-FILE. IF1094.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1094.2 +018800 MOVE SPACE TO TEST-RESULTS. IF1094.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1094.2 +019000 GO TO CCVS1-EXIT. IF1094.2 +019100 CLOSE-FILES. IF1094.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1094.2 +019300 TERMINATE-CCVS. IF1094.2 +019400 STOP RUN. IF1094.2 +019500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1094.2 +019600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1094.2 +019700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1094.2 +019800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1094.2 +019900 MOVE "****TEST DELETED****" TO RE-MARK. IF1094.2 +020000 PRINT-DETAIL. IF1094.2 +020100 IF REC-CT NOT EQUAL TO ZERO IF1094.2 +020200 MOVE "." TO PARDOT-X IF1094.2 +020300 MOVE REC-CT TO DOTVALUE. IF1094.2 +020400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1094.2 +020500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1094.2 +020600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1094.2 +020700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1094.2 +020800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1094.2 +020900 MOVE SPACE TO CORRECT-X. IF1094.2 +021000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1094.2 +021100 MOVE SPACE TO RE-MARK. IF1094.2 +021200 HEAD-ROUTINE. IF1094.2 +021300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +021400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +021500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1094.2 +021600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1094.2 +021700 COLUMN-NAMES-ROUTINE. IF1094.2 +021800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +021900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +022000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +022100 END-ROUTINE. IF1094.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1094.2 +022300 END-RTN-EXIT. IF1094.2 +022400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +022500 END-ROUTINE-1. IF1094.2 +022600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1094.2 +022700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1094.2 +022800 ADD PASS-COUNTER TO ERROR-HOLD. IF1094.2 +022900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1094.2 +023000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1094.2 +023100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1094.2 +023200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1094.2 +023300 END-ROUTINE-12. IF1094.2 +023400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1094.2 +023500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1094.2 +023600 MOVE "NO " TO ERROR-TOTAL IF1094.2 +023700 ELSE IF1094.2 +023800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1094.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1094.2 +024000 PERFORM WRITE-LINE. IF1094.2 +024100 END-ROUTINE-13. IF1094.2 +024200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1094.2 +024300 MOVE "NO " TO ERROR-TOTAL ELSE IF1094.2 +024400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1094.2 +024500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1094.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +024700 IF INSPECT-COUNTER EQUAL TO ZERO IF1094.2 +024800 MOVE "NO " TO ERROR-TOTAL IF1094.2 +024900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1094.2 +025000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1094.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +025200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1094.2 +025300 WRITE-LINE. IF1094.2 +025400 ADD 1 TO RECORD-COUNT. IF1094.2 +025500 IF RECORD-COUNT GREATER 42 IF1094.2 +025600 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1094.2 +025700 MOVE SPACE TO DUMMY-RECORD IF1094.2 +025800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1094.2 +025900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1094.2 +026000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1094.2 +026100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1094.2 +026200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1094.2 +026300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1094.2 +026400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1094.2 +026500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1094.2 +026600 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1094.2 +026700 MOVE ZERO TO RECORD-COUNT. IF1094.2 +026800 PERFORM WRT-LN. IF1094.2 +026900 WRT-LN. IF1094.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1094.2 +027100 MOVE SPACE TO DUMMY-RECORD. IF1094.2 +027200 BLANK-LINE-PRINT. IF1094.2 +027300 PERFORM WRT-LN. IF1094.2 +027400 FAIL-ROUTINE. IF1094.2 +027500 IF COMPUTED-X NOT EQUAL TO SPACE IF1094.2 +027600 GO TO FAIL-ROUTINE-WRITE. IF1094.2 +027700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1094.2 +027800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1094.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1094.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +028100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1094.2 +028200 GO TO FAIL-ROUTINE-EX. IF1094.2 +028300 FAIL-ROUTINE-WRITE. IF1094.2 +028400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1094.2 +028500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1094.2 +028600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1094.2 +028700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1094.2 +028800 FAIL-ROUTINE-EX. EXIT. IF1094.2 +028900 BAIL-OUT. IF1094.2 +029000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1094.2 +029100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1094.2 +029200 BAIL-OUT-WRITE. IF1094.2 +029300 MOVE CORRECT-A TO XXCORRECT. IF1094.2 +029400 MOVE COMPUTED-A TO XXCOMPUTED. IF1094.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1094.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1094.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1094.2 +029800 BAIL-OUT-EX. EXIT. IF1094.2 +029900 CCVS1-EXIT. IF1094.2 +030000 EXIT. IF1094.2 +030100******************************************************** IF1094.2 +030200* * IF1094.2 +030300* Intrinsic Function Test IF109A - DAY-OF-INTEGER * IF1094.2 +030400* * IF1094.2 +030500******************************************************** IF1094.2 +030600 SECT-IF109A SECTION. IF1094.2 +030700 F-DAYOFINT-INFO. IF1094.2 +030800 MOVE "See ref. A-42 2.13" TO ANSI-REFERENCE. IF1094.2 +030900 MOVE "DAY-OF-INTEGER" TO FEATURE. IF1094.2 +031000*****************TEST (a) ****************************** IF1094.2 +031100 F-DAYOFINT-01. IF1094.2 +031200 MOVE ZERO TO WS-DATE. IF1094.2 +031300 F-DAYOFINT-TEST-01. IF1094.2 +031400 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(1). IF1094.2 +031500 IF WS-DATE = 1601001 THEN IF1094.2 +031600 PERFORM PASS IF1094.2 +031700 ELSE IF1094.2 +031800 MOVE 1601001 TO CORRECT-N IF1094.2 +031900 MOVE WS-DATE TO COMPUTED-N IF1094.2 +032000 PERFORM FAIL. IF1094.2 +032100 GO TO F-DAYOFINT-WRITE-01. IF1094.2 +032200 F-DAYOFINT-DELETE-01. IF1094.2 +032300 PERFORM DE-LETE. IF1094.2 +032400 GO TO F-DAYOFINT-WRITE-01. IF1094.2 +032500 F-DAYOFINT-WRITE-01. IF1094.2 +032600 MOVE "F-DAYOFINT-01" TO PAR-NAME. IF1094.2 +032700 PERFORM PRINT-DETAIL. IF1094.2 +032800*****************TEST (b) ****************************** IF1094.2 +032900 F-DAYOFINT-TEST-02. IF1094.2 +033000 EVALUATE FUNCTION DAY-OF-INTEGER(A) IF1094.2 +033100 WHEN 1602035 IF1094.2 +033200 PERFORM PASS IF1094.2 +033300 GO TO F-DAYOFINT-WRITE-02. IF1094.2 +033400 PERFORM FAIL. IF1094.2 +033500 GO TO F-DAYOFINT-WRITE-02. IF1094.2 +033600 F-DAYOFINT-DELETE-02. IF1094.2 +033700 PERFORM DE-LETE. IF1094.2 +033800 GO TO F-DAYOFINT-WRITE-02. IF1094.2 +033900 F-DAYOFINT-WRITE-02. IF1094.2 +034000 MOVE "F-DAYOFINT-02" TO PAR-NAME. IF1094.2 +034100 PERFORM PRINT-DETAIL. IF1094.2 +034200*****************TEST (c) ****************************** IF1094.2 +034300 F-DAYOFINT-TEST-03. IF1094.2 +034400 IF FUNCTION DAY-OF-INTEGER(IND(1)) = 1601004 THEN IF1094.2 +034500 PERFORM PASS IF1094.2 +034600 ELSE IF1094.2 +034700 PERFORM FAIL. IF1094.2 +034800 GO TO F-DAYOFINT-WRITE-03. IF1094.2 +034900 F-DAYOFINT-DELETE-03. IF1094.2 +035000 PERFORM DE-LETE. IF1094.2 +035100 GO TO F-DAYOFINT-WRITE-03. IF1094.2 +035200 F-DAYOFINT-WRITE-03. IF1094.2 +035300 MOVE "F-DAYOFINT-03" TO PAR-NAME. IF1094.2 +035400 PERFORM PRINT-DETAIL. IF1094.2 +035500*****************TEST (d) ****************************** IF1094.2 +035600 F-DAYOFINT-04. IF1094.2 +035700 MOVE ZERO TO WS-DATE. IF1094.2 +035800 F-DAYOFINT-TEST-04. IF1094.2 +035900 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(IND(D)). IF1094.2 +036000 IF WS-DATE = 1601004 THEN IF1094.2 +036100 PERFORM PASS IF1094.2 +036200 ELSE IF1094.2 +036300 MOVE 1601004 TO CORRECT-N IF1094.2 +036400 MOVE WS-DATE TO COMPUTED-N IF1094.2 +036500 PERFORM FAIL. IF1094.2 +036600 GO TO F-DAYOFINT-WRITE-04. IF1094.2 +036700 F-DAYOFINT-DELETE-04. IF1094.2 +036800 PERFORM DE-LETE. IF1094.2 +036900 GO TO F-DAYOFINT-WRITE-04. IF1094.2 +037000 F-DAYOFINT-WRITE-04. IF1094.2 +037100 MOVE "F-DAYOFINT-04" TO PAR-NAME. IF1094.2 +037200 PERFORM PRINT-DETAIL. IF1094.2 +037300*****************TEST (e) ****************************** IF1094.2 +037400 F-DAYOFINT-05. IF1094.2 +037500 MOVE ZERO TO WS-DATE. IF1094.2 +037600 F-DAYOFINT-TEST-05. IF1094.2 +037700 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(C). IF1094.2 +037800 IF WS-DATE = 1601365 THEN IF1094.2 +037900 PERFORM PASS IF1094.2 +038000 ELSE IF1094.2 +038100 MOVE 1601365 TO CORRECT-N IF1094.2 +038200 MOVE WS-DATE TO COMPUTED-N IF1094.2 +038300 PERFORM FAIL. IF1094.2 +038400 GO TO F-DAYOFINT-WRITE-05. IF1094.2 +038500 F-DAYOFINT-DELETE-05. IF1094.2 +038600 PERFORM DE-LETE. IF1094.2 +038700 GO TO F-DAYOFINT-WRITE-05. IF1094.2 +038800 F-DAYOFINT-WRITE-05. IF1094.2 +038900 MOVE "F-DAYOFINT-05" TO PAR-NAME. IF1094.2 +039000 PERFORM PRINT-DETAIL. IF1094.2 +039100*****************TEST (f) ****************************** IF1094.2 +039200 F-DAYOFINT-06. IF1094.2 +039300 MOVE ZERO TO WS-DATE. IF1094.2 +039400 F-DAYOFINT-TEST-06. IF1094.2 +039500 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(D) + 10. IF1094.2 +039600 IF WS-DATE = 1601011 THEN IF1094.2 +039700 PERFORM PASS IF1094.2 +039800 ELSE IF1094.2 +039900 MOVE 1601011 TO CORRECT-N IF1094.2 +040000 MOVE WS-DATE TO COMPUTED-N IF1094.2 +040100 PERFORM FAIL. IF1094.2 +040200 GO TO F-DAYOFINT-WRITE-06. IF1094.2 +040300 F-DAYOFINT-DELETE-06. IF1094.2 +040400 PERFORM DE-LETE. IF1094.2 +040500 GO TO F-DAYOFINT-WRITE-06. IF1094.2 +040600 F-DAYOFINT-WRITE-06. IF1094.2 +040700 MOVE "F-DAYOFINT-06" TO PAR-NAME. IF1094.2 +040800 PERFORM PRINT-DETAIL. IF1094.2 +040900*****************TEST (g) ****************************** IF1094.2 +041000 F-DAYOFINT-07. IF1094.2 +041100 MOVE ZERO TO WS-DATE. IF1094.2 +041200 F-DAYOFINT-TEST-07. IF1094.2 +041300 COMPUTE WS-DATE = FUNCTION DAY-OF-INTEGER(D) + IF1094.2 +041400 FUNCTION DAY-OF-INTEGER(D). IF1094.2 +041500 IF WS-DATE = 3202002 THEN IF1094.2 +041600 PERFORM PASS IF1094.2 +041700 ELSE IF1094.2 +041800 MOVE 3202002 TO CORRECT-N IF1094.2 +041900 MOVE WS-DATE TO COMPUTED-N IF1094.2 +042000 PERFORM FAIL. IF1094.2 +042100 GO TO F-DAYOFINT-WRITE-07. IF1094.2 +042200 F-DAYOFINT-DELETE-07. IF1094.2 +042300 PERFORM DE-LETE. IF1094.2 +042400 GO TO F-DAYOFINT-WRITE-07. IF1094.2 +042500 F-DAYOFINT-WRITE-07. IF1094.2 +042600 MOVE "F-DAYOFINT-07" TO PAR-NAME. IF1094.2 +042700 PERFORM PRINT-DETAIL. IF1094.2 +042800***************** SPECIAL TEST 1 *********************** IF1094.2 +042900 F-DAYOFINT-08. IF1094.2 +043000 MOVE 1 TO ARG1. IF1094.2 +043100 PERFORM F-DAYOFINT-TEST-08 IF1094.2 +043200 UNTIL FUNCTION DAY-OF-INTEGER(ARG1) > 1601010. IF1094.2 +043300 IF ARG1 = 11 THEN IF1094.2 +043400 PERFORM PASS IF1094.2 +043500 ELSE IF1094.2 +043600 PERFORM FAIL. IF1094.2 +043700 GO TO F-DAYOFINT-WRITE-08. IF1094.2 +043800* IF1094.2 +043900 F-DAYOFINT-TEST-08. IF1094.2 +044000 COMPUTE ARG1 = ARG1 + 1. IF1094.2 +044100* IF1094.2 +044200 F-DAYOFINT-DELETE-08. IF1094.2 +044300 PERFORM DE-LETE. IF1094.2 +044400 GO TO F-DAYOFINT-WRITE-08. IF1094.2 +044500 F-DAYOFINT-WRITE-08. IF1094.2 +044600 MOVE "F-DAYOFINT-08" TO PAR-NAME. IF1094.2 +044700 PERFORM PRINT-DETAIL. IF1094.2 +044800*******************END OF TESTS************************** IF1094.2 +044900 CCVS-EXIT SECTION. IF1094.2 +045000 CCVS-999999. IF1094.2 +045100 GO TO CLOSE-FILES. IF1094.2 diff --git a/tests/cobol85/IF/IF110A.CBL b/tests/cobol85/IF/IF110A.CBL new file mode 100755 index 00000000..4abba346 --- /dev/null +++ b/tests/cobol85/IF/IF110A.CBL @@ -0,0 +1,500 @@ +000100 IDENTIFICATION DIVISION. IF1104.2 +000200 PROGRAM-ID. IF1104.2 +000300 IF110A. IF1104.2 +000400 IF1104.2 +000500*********************************************************** IF1104.2 +000600* * IF1104.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1104.2 +000800* It contains tests for the Intrinsic Function * IF1104.2 +000900* FACTORIAL. * IF1104.2 +001000* * IF1104.2 +001100*********************************************************** IF1104.2 +001200 ENVIRONMENT DIVISION. IF1104.2 +001300 CONFIGURATION SECTION. IF1104.2 +001400 SOURCE-COMPUTER. IF1104.2 +001500 Linux. IF1104.2 +001600 OBJECT-COMPUTER. IF1104.2 +001700 Linux. IF1104.2 +001800 INPUT-OUTPUT SECTION. IF1104.2 +001900 FILE-CONTROL. IF1104.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1104.2 +002100 "report.log". IF1104.2 +002200 DATA DIVISION. IF1104.2 +002300 FILE SECTION. IF1104.2 +002400 FD PRINT-FILE. IF1104.2 +002500 01 PRINT-REC PICTURE X(120). IF1104.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1104.2 +002700 WORKING-STORAGE SECTION. IF1104.2 +002800*********************************************************** IF1104.2 +002900* Variables specific to the Intrinsic Function Test IF110A* IF1104.2 +003000*********************************************************** IF1104.2 +003100 01 A PIC S9(10) VALUE 5. IF1104.2 +003200 01 B PIC S9(10) VALUE 7. IF1104.2 +003300 01 ARG1 PIC S9(10) VALUE 1. IF1104.2 +003400 01 ARR VALUE "40537". IF1104.2 +003500 02 IND OCCURS 5 TIMES PIC 9. IF1104.2 +003600 01 TEMP PIC S9(5)V9(5). IF1104.2 +003700 01 WS-NUM PIC S9(5)V9(6). IF1104.2 +003800 01 MIN-RANGE PIC S9(5)V9(7). IF1104.2 +003900 01 MAX-RANGE PIC S9(5)V9(7). IF1104.2 +004000* IF1104.2 +004100********************************************************** IF1104.2 +004200* IF1104.2 +004300 01 TEST-RESULTS. IF1104.2 +004400 02 FILLER PIC X VALUE SPACE. IF1104.2 +004500 02 FEATURE PIC X(20) VALUE SPACE. IF1104.2 +004600 02 FILLER PIC X VALUE SPACE. IF1104.2 +004700 02 P-OR-F PIC X(5) VALUE SPACE. IF1104.2 +004800 02 FILLER PIC X VALUE SPACE. IF1104.2 +004900 02 PAR-NAME. IF1104.2 +005000 03 FILLER PIC X(19) VALUE SPACE. IF1104.2 +005100 03 PARDOT-X PIC X VALUE SPACE. IF1104.2 +005200 03 DOTVALUE PIC 99 VALUE ZERO. IF1104.2 +005300 02 FILLER PIC X(8) VALUE SPACE. IF1104.2 +005400 02 RE-MARK PIC X(61). IF1104.2 +005500 01 TEST-COMPUTED. IF1104.2 +005600 02 FILLER PIC X(30) VALUE SPACE. IF1104.2 +005700 02 FILLER PIC X(17) VALUE IF1104.2 +005800 " COMPUTED=". IF1104.2 +005900 02 COMPUTED-X. IF1104.2 +006000 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1104.2 +006100 03 COMPUTED-N REDEFINES COMPUTED-A IF1104.2 +006200 PIC -9(9).9(9). IF1104.2 +006300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1104.2 +006400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1104.2 +006500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1104.2 +006600 03 CM-18V0 REDEFINES COMPUTED-A. IF1104.2 +006700 04 COMPUTED-18V0 PIC -9(18). IF1104.2 +006800 04 FILLER PIC X. IF1104.2 +006900 03 FILLER PIC X(50) VALUE SPACE. IF1104.2 +007000 01 TEST-CORRECT. IF1104.2 +007100 02 FILLER PIC X(30) VALUE SPACE. IF1104.2 +007200 02 FILLER PIC X(17) VALUE " CORRECT =". IF1104.2 +007300 02 CORRECT-X. IF1104.2 +007400 03 CORRECT-A PIC X(20) VALUE SPACE. IF1104.2 +007500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1104.2 +007600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1104.2 +007700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1104.2 +007800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1104.2 +007900 03 CR-18V0 REDEFINES CORRECT-A. IF1104.2 +008000 04 CORRECT-18V0 PIC -9(18). IF1104.2 +008100 04 FILLER PIC X. IF1104.2 +008200 03 FILLER PIC X(2) VALUE SPACE. IF1104.2 +008300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1104.2 +008400 01 TEST-CORRECT-MIN. IF1104.2 +008500 02 FILLER PIC X(30) VALUE SPACE. IF1104.2 +008600 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1104.2 +008700 02 CORRECTMI-X. IF1104.2 +008800 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1104.2 +008900 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1104.2 +009000 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1104.2 +009100 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1104.2 +009200 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1104.2 +009300 03 CR-18V0 REDEFINES CORRECTMI-A. IF1104.2 +009400 04 CORRECTMI-18V0 PIC -9(18). IF1104.2 +009500 04 FILLER PIC X. IF1104.2 +009600 03 FILLER PIC X(2) VALUE SPACE. IF1104.2 +009700 03 FILLER PIC X(48) VALUE SPACE. IF1104.2 +009800 01 TEST-CORRECT-MAX. IF1104.2 +009900 02 FILLER PIC X(30) VALUE SPACE. IF1104.2 +010000 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1104.2 +010100 02 CORRECTMA-X. IF1104.2 +010200 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1104.2 +010300 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1104.2 +010400 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1104.2 +010500 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1104.2 +010600 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1104.2 +010700 03 CR-18V0 REDEFINES CORRECTMA-A. IF1104.2 +010800 04 CORRECTMA-18V0 PIC -9(18). IF1104.2 +010900 04 FILLER PIC X. IF1104.2 +011000 03 FILLER PIC X(2) VALUE SPACE. IF1104.2 +011100 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1104.2 +011200 01 CCVS-C-1. IF1104.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1104.2 +011400- "SS PARAGRAPH-NAME IF1104.2 +011500- " REMARKS". IF1104.2 +011600 02 FILLER PIC X(20) VALUE SPACE. IF1104.2 +011700 01 CCVS-C-2. IF1104.2 +011800 02 FILLER PIC X VALUE SPACE. IF1104.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". IF1104.2 +012000 02 FILLER PIC X(15) VALUE SPACE. IF1104.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". IF1104.2 +012200 02 FILLER PIC X(94) VALUE SPACE. IF1104.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1104.2 +012400 01 REC-CT PIC 99 VALUE ZERO. IF1104.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1104.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1104.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1104.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1104.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1104.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1104.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1104.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1104.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1104.2 +013400 01 CCVS-H-1. IF1104.2 +013500 02 FILLER PIC X(39) VALUE SPACES. IF1104.2 +013600 02 FILLER PIC X(42) VALUE IF1104.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1104.2 +013800 02 FILLER PIC X(39) VALUE SPACES. IF1104.2 +013900 01 CCVS-H-2A. IF1104.2 +014000 02 FILLER PIC X(40) VALUE SPACE. IF1104.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1104.2 +014200 02 FILLER PIC XXXX VALUE IF1104.2 +014300 "4.2 ". IF1104.2 +014400 02 FILLER PIC X(28) VALUE IF1104.2 +014500 " COPY - NOT FOR DISTRIBUTION". IF1104.2 +014600 02 FILLER PIC X(41) VALUE SPACE. IF1104.2 +014700 IF1104.2 +014800 01 CCVS-H-2B. IF1104.2 +014900 02 FILLER PIC X(15) VALUE IF1104.2 +015000 "TEST RESULT OF ". IF1104.2 +015100 02 TEST-ID PIC X(9). IF1104.2 +015200 02 FILLER PIC X(4) VALUE IF1104.2 +015300 " IN ". IF1104.2 +015400 02 FILLER PIC X(12) VALUE IF1104.2 +015500 " HIGH ". IF1104.2 +015600 02 FILLER PIC X(22) VALUE IF1104.2 +015700 " LEVEL VALIDATION FOR ". IF1104.2 +015800 02 FILLER PIC X(58) VALUE IF1104.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1104.2 +016000 01 CCVS-H-3. IF1104.2 +016100 02 FILLER PIC X(34) VALUE IF1104.2 +016200 " FOR OFFICIAL USE ONLY ". IF1104.2 +016300 02 FILLER PIC X(58) VALUE IF1104.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1104.2 +016500 02 FILLER PIC X(28) VALUE IF1104.2 +016600 " COPYRIGHT 1985 ". IF1104.2 +016700 01 CCVS-E-1. IF1104.2 +016800 02 FILLER PIC X(52) VALUE SPACE. IF1104.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1104.2 +017000 02 ID-AGAIN PIC X(9). IF1104.2 +017100 02 FILLER PIC X(45) VALUE SPACES. IF1104.2 +017200 01 CCVS-E-2. IF1104.2 +017300 02 FILLER PIC X(31) VALUE SPACE. IF1104.2 +017400 02 FILLER PIC X(21) VALUE SPACE. IF1104.2 +017500 02 CCVS-E-2-2. IF1104.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1104.2 +017700 03 FILLER PIC X VALUE SPACE. IF1104.2 +017800 03 ENDER-DESC PIC X(44) VALUE IF1104.2 +017900 "ERRORS ENCOUNTERED". IF1104.2 +018000 01 CCVS-E-3. IF1104.2 +018100 02 FILLER PIC X(22) VALUE IF1104.2 +018200 " FOR OFFICIAL USE ONLY". IF1104.2 +018300 02 FILLER PIC X(12) VALUE SPACE. IF1104.2 +018400 02 FILLER PIC X(58) VALUE IF1104.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1104.2 +018600 02 FILLER PIC X(13) VALUE SPACE. IF1104.2 +018700 02 FILLER PIC X(15) VALUE IF1104.2 +018800 " COPYRIGHT 1985". IF1104.2 +018900 01 CCVS-E-4. IF1104.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1104.2 +019100 02 FILLER PIC X(4) VALUE " OF ". IF1104.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1104.2 +019300 02 FILLER PIC X(40) VALUE IF1104.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1104.2 +019500 01 XXINFO. IF1104.2 +019600 02 FILLER PIC X(19) VALUE IF1104.2 +019700 "*** INFORMATION ***". IF1104.2 +019800 02 INFO-TEXT. IF1104.2 +019900 04 FILLER PIC X(8) VALUE SPACE. IF1104.2 +020000 04 XXCOMPUTED PIC X(20). IF1104.2 +020100 04 FILLER PIC X(5) VALUE SPACE. IF1104.2 +020200 04 XXCORRECT PIC X(20). IF1104.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). IF1104.2 +020400 01 HYPHEN-LINE. IF1104.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. IF1104.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************IF1104.2 +020700- "*****************************************". IF1104.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************IF1104.2 +020900- "******************************". IF1104.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE IF1104.2 +021100 "IF110A". IF1104.2 +021200 PROCEDURE DIVISION. IF1104.2 +021300 CCVS1 SECTION. IF1104.2 +021400 OPEN-FILES. IF1104.2 +021500 OPEN OUTPUT PRINT-FILE. IF1104.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1104.2 +021700 MOVE SPACE TO TEST-RESULTS. IF1104.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1104.2 +021900 GO TO CCVS1-EXIT. IF1104.2 +022000 CLOSE-FILES. IF1104.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1104.2 +022200 TERMINATE-CCVS. IF1104.2 +022300 STOP RUN. IF1104.2 +022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1104.2 +022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1104.2 +022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1104.2 +022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1104.2 +022800 MOVE "****TEST DELETED****" TO RE-MARK. IF1104.2 +022900 PRINT-DETAIL. IF1104.2 +023000 IF REC-CT NOT EQUAL TO ZERO IF1104.2 +023100 MOVE "." TO PARDOT-X IF1104.2 +023200 MOVE REC-CT TO DOTVALUE. IF1104.2 +023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1104.2 +023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1104.2 +023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1104.2 +023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1104.2 +023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1104.2 +023800 MOVE SPACE TO CORRECT-X. IF1104.2 +023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1104.2 +024000 MOVE SPACE TO RE-MARK. IF1104.2 +024100 HEAD-ROUTINE. IF1104.2 +024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1104.2 +024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1104.2 +024600 COLUMN-NAMES-ROUTINE. IF1104.2 +024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +025000 END-ROUTINE. IF1104.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1104.2 +025200 END-RTN-EXIT. IF1104.2 +025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +025400 END-ROUTINE-1. IF1104.2 +025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1104.2 +025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1104.2 +025700 ADD PASS-COUNTER TO ERROR-HOLD. IF1104.2 +025800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1104.2 +025900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1104.2 +026000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1104.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1104.2 +026200 END-ROUTINE-12. IF1104.2 +026300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1104.2 +026400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1104.2 +026500 MOVE "NO " TO ERROR-TOTAL IF1104.2 +026600 ELSE IF1104.2 +026700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1104.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1104.2 +026900 PERFORM WRITE-LINE. IF1104.2 +027000 END-ROUTINE-13. IF1104.2 +027100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1104.2 +027200 MOVE "NO " TO ERROR-TOTAL ELSE IF1104.2 +027300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1104.2 +027400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1104.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +027600 IF INSPECT-COUNTER EQUAL TO ZERO IF1104.2 +027700 MOVE "NO " TO ERROR-TOTAL IF1104.2 +027800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1104.2 +027900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1104.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +028100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1104.2 +028200 WRITE-LINE. IF1104.2 +028300 ADD 1 TO RECORD-COUNT. IF1104.2 +028400 IF RECORD-COUNT GREATER 42 IF1104.2 +028500 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1104.2 +028600 MOVE SPACE TO DUMMY-RECORD IF1104.2 +028700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1104.2 +028800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1104.2 +028900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1104.2 +029000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1104.2 +029100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1104.2 +029200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1104.2 +029300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1104.2 +029400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1104.2 +029500 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1104.2 +029600 MOVE ZERO TO RECORD-COUNT. IF1104.2 +029700 PERFORM WRT-LN. IF1104.2 +029800 WRT-LN. IF1104.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1104.2 +030000 MOVE SPACE TO DUMMY-RECORD. IF1104.2 +030100 BLANK-LINE-PRINT. IF1104.2 +030200 PERFORM WRT-LN. IF1104.2 +030300 FAIL-ROUTINE. IF1104.2 +030400 IF COMPUTED-X NOT EQUAL TO SPACE IF1104.2 +030500 GO TO FAIL-ROUTINE-WRITE. IF1104.2 +030600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1104.2 +030700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1104.2 +030800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1104.2 +030900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +031000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1104.2 +031100 GO TO FAIL-ROUTINE-EX. IF1104.2 +031200 FAIL-ROUTINE-WRITE. IF1104.2 +031300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1104.2 +031400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1104.2 +031500 CORMA-ANSI-REFERENCE. IF1104.2 +031600 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1104.2 +031700 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1104.2 +031800 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1104.2 +031900 ELSE IF1104.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1104.2 +032100 PERFORM WRITE-LINE. IF1104.2 +032200 MOVE SPACES TO COR-ANSI-REFERENCE. IF1104.2 +032300 FAIL-ROUTINE-EX. EXIT. IF1104.2 +032400 BAIL-OUT. IF1104.2 +032500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1104.2 +032600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1104.2 +032700 BAIL-OUT-WRITE. IF1104.2 +032800 MOVE CORRECT-A TO XXCORRECT. IF1104.2 +032900 MOVE COMPUTED-A TO XXCOMPUTED. IF1104.2 +033000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1104.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1104.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1104.2 +033300 BAIL-OUT-EX. EXIT. IF1104.2 +033400 CCVS1-EXIT. IF1104.2 +033500 EXIT. IF1104.2 +033600******************************************************** IF1104.2 +033700* * IF1104.2 +033800* Intrinsic Function Tests IF110A - FACTORIAL * IF1104.2 +033900* * IF1104.2 +034000******************************************************** IF1104.2 +034100 SECT-IF110A SECTION. IF1104.2 +034200 F-FACTORIAL-INFO. IF1104.2 +034300 MOVE "See ref. A-43 2.14" TO ANSI-REFERENCE. IF1104.2 +034400 MOVE "FACTORIAL Function" TO FEATURE. IF1104.2 +034500*****************TEST (a) ****************************** IF1104.2 +034600 F-FACTORIAL-01. IF1104.2 +034700 MOVE ZERO TO WS-NUM. IF1104.2 +034800 F-FACTORIAL-TEST-01. IF1104.2 +034900 COMPUTE WS-NUM = FUNCTION FACTORIAL(0). IF1104.2 +035000 IF WS-NUM = 1 THEN IF1104.2 +035100 PERFORM PASS IF1104.2 +035200 ELSE IF1104.2 +035300 MOVE WS-NUM TO COMPUTED-N IF1104.2 +035400 MOVE 1 TO CORRECT-N IF1104.2 +035500 PERFORM FAIL. IF1104.2 +035600 GO TO F-FACTORIAL-WRITE-01. IF1104.2 +035700 F-FACTORIAL-DELETE-01. IF1104.2 +035800 PERFORM DE-LETE. IF1104.2 +035900 GO TO F-FACTORIAL-WRITE-01. IF1104.2 +036000 F-FACTORIAL-WRITE-01. IF1104.2 +036100 MOVE "F-FACTORIAL-01" TO PAR-NAME. IF1104.2 +036200 PERFORM PRINT-DETAIL. IF1104.2 +036300*****************TEST (b) ****************************** IF1104.2 +036400 F-FACTORIAL-02. IF1104.2 +036500 EVALUATE FUNCTION FACTORIAL(3) IF1104.2 +036600 WHEN 6 IF1104.2 +036700 PERFORM PASS IF1104.2 +036800 WHEN OTHER IF1104.2 +036900 PERFORM FAIL. IF1104.2 +037000 GO TO F-FACTORIAL-WRITE-02. IF1104.2 +037100 F-FACTORIAL-DELETE-02. IF1104.2 +037200 PERFORM DE-LETE. IF1104.2 +037300 GO TO F-FACTORIAL-WRITE-02. IF1104.2 +037400 F-FACTORIAL-WRITE-02. IF1104.2 +037500 MOVE "F-FACTORIAL-02" TO PAR-NAME. IF1104.2 +037600 PERFORM PRINT-DETAIL. IF1104.2 +037700*****************TEST (c) ****************************** IF1104.2 +037800 F-FACTORIAL-03. IF1104.2 +037900 IF FUNCTION FACTORIAL(A) = 120 THEN IF1104.2 +038000 PERFORM PASS IF1104.2 +038100 ELSE IF1104.2 +038200 PERFORM FAIL. IF1104.2 +038300 GO TO F-FACTORIAL-WRITE-03. IF1104.2 +038400 F-FACTORIAL-DELETE-03. IF1104.2 +038500 PERFORM DE-LETE. IF1104.2 +038600 GO TO F-FACTORIAL-WRITE-03. IF1104.2 +038700 F-FACTORIAL-WRITE-03. IF1104.2 +038800 MOVE "F-FACTORIAL-03" TO PAR-NAME. IF1104.2 +038900 PERFORM PRINT-DETAIL. IF1104.2 +039000*****************TEST (d) ****************************** IF1104.2 +039100 F-FACTORIAL-04. IF1104.2 +039200 MOVE ZERO TO WS-NUM. IF1104.2 +039300 F-FACTORIAL-TEST-04. IF1104.2 +039400 COMPUTE WS-NUM = FUNCTION FACTORIAL(IND(4)). IF1104.2 +039500 IF WS-NUM = 6 THEN IF1104.2 +039600 PERFORM PASS IF1104.2 +039700 ELSE IF1104.2 +039800 MOVE WS-NUM TO COMPUTED-N IF1104.2 +039900 MOVE 6 TO CORRECT-N IF1104.2 +040000 PERFORM FAIL. IF1104.2 +040100 GO TO F-FACTORIAL-WRITE-04. IF1104.2 +040200 F-FACTORIAL-DELETE-04. IF1104.2 +040300 PERFORM DE-LETE. IF1104.2 +040400 GO TO F-FACTORIAL-WRITE-04. IF1104.2 +040500 F-FACTORIAL-WRITE-04. IF1104.2 +040600 MOVE "F-FACTORIAL-04" TO PAR-NAME. IF1104.2 +040700 PERFORM PRINT-DETAIL. IF1104.2 +040800*****************TEST (e) ****************************** IF1104.2 +040900 F-FACTORIAL-05. IF1104.2 +041000 MOVE ZERO TO WS-NUM. IF1104.2 +041100 F-FACTORIAL-TEST-05. IF1104.2 +041200 COMPUTE WS-NUM = FUNCTION FACTORIAL(IND(A)). IF1104.2 +041300 IF WS-NUM = 5040 THEN IF1104.2 +041400 PERFORM PASS IF1104.2 +041500 ELSE IF1104.2 +041600 MOVE WS-NUM TO COMPUTED-N IF1104.2 +041700 MOVE 5040 TO CORRECT-N IF1104.2 +041800 PERFORM FAIL. IF1104.2 +041900 GO TO F-FACTORIAL-WRITE-05. IF1104.2 +042000 F-FACTORIAL-DELETE-05. IF1104.2 +042100 PERFORM DE-LETE. IF1104.2 +042200 GO TO F-FACTORIAL-WRITE-05. IF1104.2 +042300 F-FACTORIAL-WRITE-05. IF1104.2 +042400 MOVE "F-FACTORIAL-05" TO PAR-NAME. IF1104.2 +042500 PERFORM PRINT-DETAIL. IF1104.2 +042600*****************TEST (f) ****************************** IF1104.2 +042700 F-FACTORIAL-06. IF1104.2 +042800 MOVE ZERO TO WS-NUM. IF1104.2 +042900 F-FACTORIAL-TEST-06. IF1104.2 +043000 COMPUTE WS-NUM = FUNCTION FACTORIAL( IF1104.2 +043100 FUNCTION FACTORIAL(3)). IF1104.2 +043200 IF WS-NUM = 720 THEN IF1104.2 +043300 PERFORM PASS IF1104.2 +043400 ELSE IF1104.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1104.2 +043600 MOVE 720 TO CORRECT-N IF1104.2 +043700 PERFORM FAIL. IF1104.2 +043800 GO TO F-FACTORIAL-WRITE-06. IF1104.2 +043900 F-FACTORIAL-DELETE-06. IF1104.2 +044000 PERFORM DE-LETE. IF1104.2 +044100 GO TO F-FACTORIAL-WRITE-06. IF1104.2 +044200 F-FACTORIAL-WRITE-06. IF1104.2 +044300 MOVE "F-FACTORIAL-06" TO PAR-NAME. IF1104.2 +044400 PERFORM PRINT-DETAIL. IF1104.2 +044500*****************TEST (g) ****************************** IF1104.2 +044600 F-FACTORIAL-07. IF1104.2 +044700 MOVE ZERO TO WS-NUM. IF1104.2 +044800 F-FACTORIAL-TEST-07. IF1104.2 +044900 COMPUTE WS-NUM = FUNCTION FACTORIAL(1) + B. IF1104.2 +045000 IF WS-NUM = 8 THEN IF1104.2 +045100 PERFORM PASS IF1104.2 +045200 ELSE IF1104.2 +045300 MOVE WS-NUM TO COMPUTED-N IF1104.2 +045400 MOVE 8 TO CORRECT-N IF1104.2 +045500 PERFORM FAIL. IF1104.2 +045600 GO TO F-FACTORIAL-WRITE-07. IF1104.2 +045700 F-FACTORIAL-DELETE-07. IF1104.2 +045800 PERFORM DE-LETE. IF1104.2 +045900 GO TO F-FACTORIAL-WRITE-07. IF1104.2 +046000 F-FACTORIAL-WRITE-07. IF1104.2 +046100 MOVE "F-FACTORIAL-07" TO PAR-NAME. IF1104.2 +046200 PERFORM PRINT-DETAIL. IF1104.2 +046300*****************TEST (h) ****************************** IF1104.2 +046400 F-FACTORIAL-08. IF1104.2 +046500 MOVE ZERO TO WS-NUM. IF1104.2 +046600 F-FACTORIAL-TEST-08. IF1104.2 +046700 COMPUTE WS-NUM = FUNCTION FACTORIAL(4) + IF1104.2 +046800 FUNCTION FACTORIAL(2). IF1104.2 +046900 IF WS-NUM = 26 THEN IF1104.2 +047000 PERFORM PASS IF1104.2 +047100 ELSE IF1104.2 +047200 MOVE WS-NUM TO COMPUTED-N IF1104.2 +047300 MOVE 26 TO CORRECT-N IF1104.2 +047400 PERFORM FAIL. IF1104.2 +047500 GO TO F-FACTORIAL-WRITE-08. IF1104.2 +047600 F-FACTORIAL-DELETE-08. IF1104.2 +047700 PERFORM DE-LETE. IF1104.2 +047800 GO TO F-FACTORIAL-WRITE-08. IF1104.2 +047900 F-FACTORIAL-WRITE-08. IF1104.2 +048000 MOVE "F-FACTORIAL-08" TO PAR-NAME. IF1104.2 +048100 PERFORM PRINT-DETAIL. IF1104.2 +048200*****************SPECIAL PERFORM TEST********************** IF1104.2 +048300 F-FACTORIAL-09. IF1104.2 +048400 MOVE ZERO TO WS-NUM. IF1104.2 +048500 PERFORM F-FACTORIAL-TEST-09 IF1104.2 +048600 UNTIL FUNCTION FACTORIAL(ARG1) > 120. IF1104.2 +048700 PERFORM PASS. IF1104.2 +048800 GO TO F-FACTORIAL-WRITE-09. IF1104.2 +048900 F-FACTORIAL-TEST-09. IF1104.2 +049000 COMPUTE ARG1 = ARG1 + 1. IF1104.2 +049100 F-FACTORIAL-DELETE-09. IF1104.2 +049200 PERFORM DE-LETE. IF1104.2 +049300 GO TO F-FACTORIAL-WRITE-09. IF1104.2 +049400 F-FACTORIAL-WRITE-09. IF1104.2 +049500 MOVE "F-FACTORIAL-09" TO PAR-NAME. IF1104.2 +049600 PERFORM PRINT-DETAIL. IF1104.2 +049700********************END OF TESTS*************** IF1104.2 +049800 CCVS-EXIT SECTION. IF1104.2 +049900 CCVS-999999. IF1104.2 +050000 GO TO CLOSE-FILES. IF1104.2 diff --git a/tests/cobol85/IF/IF111A.CBL b/tests/cobol85/IF/IF111A.CBL new file mode 100755 index 00000000..8187918b --- /dev/null +++ b/tests/cobol85/IF/IF111A.CBL @@ -0,0 +1,731 @@ +000100 IDENTIFICATION DIVISION. IF1114.2 +000200 PROGRAM-ID. IF1114.2 +000300 IF111A. IF1114.2 +000400 IF1114.2 +000500*********************************************************** IF1114.2 +000600* * IF1114.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1114.2 +000800* It contains tests for the Intrinsic Function * IF1114.2 +000900* INTEGER. * IF1114.2 +001000* * IF1114.2 +001100*********************************************************** IF1114.2 +001200 ENVIRONMENT DIVISION. IF1114.2 +001300 CONFIGURATION SECTION. IF1114.2 +001400 SOURCE-COMPUTER. IF1114.2 +001500 Linux. IF1114.2 +001600 OBJECT-COMPUTER. IF1114.2 +001700 Linux. IF1114.2 +001800 INPUT-OUTPUT SECTION. IF1114.2 +001900 FILE-CONTROL. IF1114.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1114.2 +002100 "report.log". IF1114.2 +002200 DATA DIVISION. IF1114.2 +002300 FILE SECTION. IF1114.2 +002400 FD PRINT-FILE. IF1114.2 +002500 01 PRINT-REC PICTURE X(120). IF1114.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1114.2 +002700 WORKING-STORAGE SECTION. IF1114.2 +002800*********************************************************** IF1114.2 +002900* Variables specific to the Intrinsic Function Test IF111A* IF1114.2 +003000*********************************************************** IF1114.2 +003100 01 A PIC S9(10) VALUE 500000. IF1114.2 +003200 01 B PIC S9(10) VALUE 1. IF1114.2 +003300 01 E PIC S9(6)V9(5) VALUE 399999.122. IF1114.2 +003400 01 F PIC S9(5)V9(5) VALUE 0.00032. IF1114.2 +003500 01 G PIC S9(5)V9(5) VALUE 4.08. IF1114.2 +003600 01 H PIC S9(5)V9(5) VALUE -5. IF1114.2 +003700 01 I PIC S9(5)V9(5) VALUE 3.4. IF1114.2 +003800 01 ARG1 PIC S9(5)V9(5) VALUE 4.4. IF1114.2 +003900 01 ARR VALUE "40537". IF1114.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1114.2 +004100 01 TEMP PIC S9(5)V9(5). IF1114.2 +004200 01 WS-INT PIC S9(10). IF1114.2 +004300* IF1114.2 +004400********************************************************** IF1114.2 +004500* IF1114.2 +004600 01 TEST-RESULTS. IF1114.2 +004700 02 FILLER PIC X VALUE SPACE. IF1114.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. IF1114.2 +004900 02 FILLER PIC X VALUE SPACE. IF1114.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. IF1114.2 +005100 02 FILLER PIC X VALUE SPACE. IF1114.2 +005200 02 PAR-NAME. IF1114.2 +005300 03 FILLER PIC X(19) VALUE SPACE. IF1114.2 +005400 03 PARDOT-X PIC X VALUE SPACE. IF1114.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. IF1114.2 +005600 02 FILLER PIC X(8) VALUE SPACE. IF1114.2 +005700 02 RE-MARK PIC X(61). IF1114.2 +005800 01 TEST-COMPUTED. IF1114.2 +005900 02 FILLER PIC X(30) VALUE SPACE. IF1114.2 +006000 02 FILLER PIC X(17) VALUE IF1114.2 +006100 " COMPUTED=". IF1114.2 +006200 02 COMPUTED-X. IF1114.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1114.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A IF1114.2 +006500 PIC -9(9).9(9). IF1114.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1114.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1114.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1114.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. IF1114.2 +007000 04 COMPUTED-18V0 PIC -9(18). IF1114.2 +007100 04 FILLER PIC X. IF1114.2 +007200 03 FILLER PIC X(50) VALUE SPACE. IF1114.2 +007300 01 TEST-CORRECT. IF1114.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IF1114.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". IF1114.2 +007600 02 CORRECT-X. IF1114.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. IF1114.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1114.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1114.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1114.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1114.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. IF1114.2 +008300 04 CORRECT-18V0 PIC -9(18). IF1114.2 +008400 04 FILLER PIC X. IF1114.2 +008500 03 FILLER PIC X(2) VALUE SPACE. IF1114.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1114.2 +008700 01 CCVS-C-1. IF1114.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1114.2 +008900- "SS PARAGRAPH-NAME IF1114.2 +009000- " REMARKS". IF1114.2 +009100 02 FILLER PIC X(20) VALUE SPACE. IF1114.2 +009200 01 CCVS-C-2. IF1114.2 +009300 02 FILLER PIC X VALUE SPACE. IF1114.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". IF1114.2 +009500 02 FILLER PIC X(15) VALUE SPACE. IF1114.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". IF1114.2 +009700 02 FILLER PIC X(94) VALUE SPACE. IF1114.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1114.2 +009900 01 REC-CT PIC 99 VALUE ZERO. IF1114.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1114.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1114.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1114.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1114.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1114.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1114.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1114.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1114.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1114.2 +010900 01 CCVS-H-1. IF1114.2 +011000 02 FILLER PIC X(39) VALUE SPACES. IF1114.2 +011100 02 FILLER PIC X(42) VALUE IF1114.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1114.2 +011300 02 FILLER PIC X(39) VALUE SPACES. IF1114.2 +011400 01 CCVS-H-2A. IF1114.2 +011500 02 FILLER PIC X(40) VALUE SPACE. IF1114.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1114.2 +011700 02 FILLER PIC XXXX VALUE IF1114.2 +011800 "4.2 ". IF1114.2 +011900 02 FILLER PIC X(28) VALUE IF1114.2 +012000 " COPY - NOT FOR DISTRIBUTION". IF1114.2 +012100 02 FILLER PIC X(41) VALUE SPACE. IF1114.2 +012200 IF1114.2 +012300 01 CCVS-H-2B. IF1114.2 +012400 02 FILLER PIC X(15) VALUE IF1114.2 +012500 "TEST RESULT OF ". IF1114.2 +012600 02 TEST-ID PIC X(9). IF1114.2 +012700 02 FILLER PIC X(4) VALUE IF1114.2 +012800 " IN ". IF1114.2 +012900 02 FILLER PIC X(12) VALUE IF1114.2 +013000 " HIGH ". IF1114.2 +013100 02 FILLER PIC X(22) VALUE IF1114.2 +013200 " LEVEL VALIDATION FOR ". IF1114.2 +013300 02 FILLER PIC X(58) VALUE IF1114.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1114.2 +013500 01 CCVS-H-3. IF1114.2 +013600 02 FILLER PIC X(34) VALUE IF1114.2 +013700 " FOR OFFICIAL USE ONLY ". IF1114.2 +013800 02 FILLER PIC X(58) VALUE IF1114.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1114.2 +014000 02 FILLER PIC X(28) VALUE IF1114.2 +014100 " COPYRIGHT 1985 ". IF1114.2 +014200 01 CCVS-E-1. IF1114.2 +014300 02 FILLER PIC X(52) VALUE SPACE. IF1114.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1114.2 +014500 02 ID-AGAIN PIC X(9). IF1114.2 +014600 02 FILLER PIC X(45) VALUE SPACES. IF1114.2 +014700 01 CCVS-E-2. IF1114.2 +014800 02 FILLER PIC X(31) VALUE SPACE. IF1114.2 +014900 02 FILLER PIC X(21) VALUE SPACE. IF1114.2 +015000 02 CCVS-E-2-2. IF1114.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1114.2 +015200 03 FILLER PIC X VALUE SPACE. IF1114.2 +015300 03 ENDER-DESC PIC X(44) VALUE IF1114.2 +015400 "ERRORS ENCOUNTERED". IF1114.2 +015500 01 CCVS-E-3. IF1114.2 +015600 02 FILLER PIC X(22) VALUE IF1114.2 +015700 " FOR OFFICIAL USE ONLY". IF1114.2 +015800 02 FILLER PIC X(12) VALUE SPACE. IF1114.2 +015900 02 FILLER PIC X(58) VALUE IF1114.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1114.2 +016100 02 FILLER PIC X(13) VALUE SPACE. IF1114.2 +016200 02 FILLER PIC X(15) VALUE IF1114.2 +016300 " COPYRIGHT 1985". IF1114.2 +016400 01 CCVS-E-4. IF1114.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1114.2 +016600 02 FILLER PIC X(4) VALUE " OF ". IF1114.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1114.2 +016800 02 FILLER PIC X(40) VALUE IF1114.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1114.2 +017000 01 XXINFO. IF1114.2 +017100 02 FILLER PIC X(19) VALUE IF1114.2 +017200 "*** INFORMATION ***". IF1114.2 +017300 02 INFO-TEXT. IF1114.2 +017400 04 FILLER PIC X(8) VALUE SPACE. IF1114.2 +017500 04 XXCOMPUTED PIC X(20). IF1114.2 +017600 04 FILLER PIC X(5) VALUE SPACE. IF1114.2 +017700 04 XXCORRECT PIC X(20). IF1114.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). IF1114.2 +017900 01 HYPHEN-LINE. IF1114.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. IF1114.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************IF1114.2 +018200- "*****************************************". IF1114.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************IF1114.2 +018400- "******************************". IF1114.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE IF1114.2 +018600 "IF111A". IF1114.2 +018700 PROCEDURE DIVISION. IF1114.2 +018800 CCVS1 SECTION. IF1114.2 +018900 OPEN-FILES. IF1114.2 +019000 OPEN OUTPUT PRINT-FILE. IF1114.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1114.2 +019200 MOVE SPACE TO TEST-RESULTS. IF1114.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1114.2 +019400 GO TO CCVS1-EXIT. IF1114.2 +019500 CLOSE-FILES. IF1114.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1114.2 +019700 TERMINATE-CCVS. IF1114.2 +019800 STOP RUN. IF1114.2 +019900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1114.2 +020000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1114.2 +020100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1114.2 +020200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1114.2 +020300 MOVE "****TEST DELETED****" TO RE-MARK. IF1114.2 +020400 PRINT-DETAIL. IF1114.2 +020500 IF REC-CT NOT EQUAL TO ZERO IF1114.2 +020600 MOVE "." TO PARDOT-X IF1114.2 +020700 MOVE REC-CT TO DOTVALUE. IF1114.2 +020800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1114.2 +020900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1114.2 +021000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1114.2 +021100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1114.2 +021200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1114.2 +021300 MOVE SPACE TO CORRECT-X. IF1114.2 +021400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1114.2 +021500 MOVE SPACE TO RE-MARK. IF1114.2 +021600 HEAD-ROUTINE. IF1114.2 +021700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +021800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +021900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1114.2 +022000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1114.2 +022100 COLUMN-NAMES-ROUTINE. IF1114.2 +022200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +022300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +022500 END-ROUTINE. IF1114.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1114.2 +022700 END-RTN-EXIT. IF1114.2 +022800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +022900 END-ROUTINE-1. IF1114.2 +023000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1114.2 +023100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1114.2 +023200 ADD PASS-COUNTER TO ERROR-HOLD. IF1114.2 +023300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1114.2 +023400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1114.2 +023500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1114.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1114.2 +023700 END-ROUTINE-12. IF1114.2 +023800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1114.2 +023900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1114.2 +024000 MOVE "NO " TO ERROR-TOTAL IF1114.2 +024100 ELSE IF1114.2 +024200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1114.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1114.2 +024400 PERFORM WRITE-LINE. IF1114.2 +024500 END-ROUTINE-13. IF1114.2 +024600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1114.2 +024700 MOVE "NO " TO ERROR-TOTAL ELSE IF1114.2 +024800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1114.2 +024900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1114.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +025100 IF INSPECT-COUNTER EQUAL TO ZERO IF1114.2 +025200 MOVE "NO " TO ERROR-TOTAL IF1114.2 +025300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1114.2 +025400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1114.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +025600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1114.2 +025700 WRITE-LINE. IF1114.2 +025800 ADD 1 TO RECORD-COUNT. IF1114.2 +025900 IF RECORD-COUNT GREATER 42 IF1114.2 +026000 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1114.2 +026100 MOVE SPACE TO DUMMY-RECORD IF1114.2 +026200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1114.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1114.2 +026400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1114.2 +026500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1114.2 +026600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1114.2 +026700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1114.2 +026800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1114.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1114.2 +027000 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1114.2 +027100 MOVE ZERO TO RECORD-COUNT. IF1114.2 +027200 PERFORM WRT-LN. IF1114.2 +027300 WRT-LN. IF1114.2 +027400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1114.2 +027500 MOVE SPACE TO DUMMY-RECORD. IF1114.2 +027600 BLANK-LINE-PRINT. IF1114.2 +027700 PERFORM WRT-LN. IF1114.2 +027800 FAIL-ROUTINE. IF1114.2 +027900 IF COMPUTED-X NOT EQUAL TO SPACE IF1114.2 +028000 GO TO FAIL-ROUTINE-WRITE. IF1114.2 +028100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1114.2 +028200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1114.2 +028300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1114.2 +028400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +028500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1114.2 +028600 GO TO FAIL-ROUTINE-EX. IF1114.2 +028700 FAIL-ROUTINE-WRITE. IF1114.2 +028800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1114.2 +028900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1114.2 +029000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1114.2 +029100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1114.2 +029200 FAIL-ROUTINE-EX. EXIT. IF1114.2 +029300 BAIL-OUT. IF1114.2 +029400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1114.2 +029500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1114.2 +029600 BAIL-OUT-WRITE. IF1114.2 +029700 MOVE CORRECT-A TO XXCORRECT. IF1114.2 +029800 MOVE COMPUTED-A TO XXCOMPUTED. IF1114.2 +029900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1114.2 +030000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1114.2 +030100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1114.2 +030200 BAIL-OUT-EX. EXIT. IF1114.2 +030300 CCVS1-EXIT. IF1114.2 +030400 EXIT. IF1114.2 +030500******************************************************** IF1114.2 +030600* * IF1114.2 +030700* Intrinsic Function Tests IF111A - INTEGER * IF1114.2 +030800* * IF1114.2 +030900******************************************************** IF1114.2 +031000 SECT-IF111A SECTION. IF1114.2 +031100 F-INTEGER-INFO. IF1114.2 +031200 MOVE "See ref. A-44 2.15" TO ANSI-REFERENCE. IF1114.2 +031300 MOVE "INTEGER Function" TO FEATURE. IF1114.2 +031400*****************TEST (a) ****************************** IF1114.2 +031500 F-INTEGER-01. IF1114.2 +031600 MOVE ZERO TO WS-INT. IF1114.2 +031700 F-INTEGER-TEST-01. IF1114.2 +031800 COMPUTE WS-INT = FUNCTION INTEGER(0). IF1114.2 +031900 IF WS-INT = 0 THEN IF1114.2 +032000 PERFORM PASS IF1114.2 +032100 ELSE IF1114.2 +032200 MOVE 0 TO CORRECT-N IF1114.2 +032300 MOVE WS-INT TO COMPUTED-N IF1114.2 +032400 PERFORM FAIL. IF1114.2 +032500 GO TO F-INTEGER-WRITE-01. IF1114.2 +032600 F-INTEGER-DELETE-01. IF1114.2 +032700 PERFORM DE-LETE. IF1114.2 +032800 GO TO F-INTEGER-WRITE-01. IF1114.2 +032900 F-INTEGER-WRITE-01. IF1114.2 +033000 MOVE "F-INTEGER-01" TO PAR-NAME. IF1114.2 +033100 PERFORM PRINT-DETAIL. IF1114.2 +033200*****************TEST (b) ****************************** IF1114.2 +033300 F-INTEGER-02. IF1114.2 +033400 MOVE ZERO TO WS-INT. IF1114.2 +033500 F-INTEGER-TEST-02. IF1114.2 +033600 EVALUATE FUNCTION INTEGER(3) IF1114.2 +033700 WHEN 3 IF1114.2 +033800 PERFORM PASS IF1114.2 +033900 GO TO F-INTEGER-WRITE-02. IF1114.2 +034000 PERFORM FAIL. IF1114.2 +034100 GO TO F-INTEGER-WRITE-02. IF1114.2 +034200 F-INTEGER-DELETE-02. IF1114.2 +034300 PERFORM DE-LETE. IF1114.2 +034400 GO TO F-INTEGER-WRITE-02. IF1114.2 +034500 F-INTEGER-WRITE-02. IF1114.2 +034600 MOVE "F-INTEGER-02" TO PAR-NAME. IF1114.2 +034700 PERFORM PRINT-DETAIL. IF1114.2 +034800*****************TEST (c) ****************************** IF1114.2 +034900 F-INTEGER-03. IF1114.2 +035000 MOVE ZERO TO WS-INT. IF1114.2 +035100 F-INTEGER-TEST-03. IF1114.2 +035200 IF FUNCTION INTEGER(4.578) = 4 THEN IF1114.2 +035300 PERFORM PASS IF1114.2 +035400 ELSE IF1114.2 +035500 MOVE 4 TO CORRECT-N IF1114.2 +035600 PERFORM FAIL. IF1114.2 +035700 GO TO F-INTEGER-WRITE-03. IF1114.2 +035800 F-INTEGER-DELETE-03. IF1114.2 +035900 PERFORM DE-LETE. IF1114.2 +036000 GO TO F-INTEGER-WRITE-03. IF1114.2 +036100 F-INTEGER-WRITE-03. IF1114.2 +036200 MOVE "F-INTEGER-03" TO PAR-NAME. IF1114.2 +036300 PERFORM PRINT-DETAIL. IF1114.2 +036400*****************TEST (d) ****************************** IF1114.2 +036500 F-INTEGER-04. IF1114.2 +036600 MOVE ZERO TO WS-INT. IF1114.2 +036700 F-INTEGER-TEST-04. IF1114.2 +036800 COMPUTE WS-INT = FUNCTION INTEGER(-58). IF1114.2 +036900 IF WS-INT = -58 THEN IF1114.2 +037000 PERFORM PASS IF1114.2 +037100 ELSE IF1114.2 +037200 MOVE -58 TO CORRECT-N IF1114.2 +037300 MOVE WS-INT TO COMPUTED-N IF1114.2 +037400 PERFORM FAIL. IF1114.2 +037500 GO TO F-INTEGER-WRITE-04. IF1114.2 +037600 F-INTEGER-DELETE-04. IF1114.2 +037700 PERFORM DE-LETE. IF1114.2 +037800 GO TO F-INTEGER-WRITE-04. IF1114.2 +037900 F-INTEGER-WRITE-04. IF1114.2 +038000 MOVE "F-INTEGER-04" TO PAR-NAME. IF1114.2 +038100 PERFORM PRINT-DETAIL. IF1114.2 +038200*****************TEST (e) ****************************** IF1114.2 +038300 F-INTEGER-05. IF1114.2 +038400 MOVE ZERO TO WS-INT. IF1114.2 +038500 F-INTEGER-TEST-05. IF1114.2 +038600 COMPUTE WS-INT = FUNCTION INTEGER(-9.763). IF1114.2 +038700 IF WS-INT = -10 THEN IF1114.2 +038800 PERFORM PASS IF1114.2 +038900 ELSE IF1114.2 +039000 MOVE -10 TO CORRECT-N IF1114.2 +039100 MOVE WS-INT TO COMPUTED-N IF1114.2 +039200 PERFORM FAIL. IF1114.2 +039300 GO TO F-INTEGER-WRITE-05. IF1114.2 +039400 F-INTEGER-DELETE-05. IF1114.2 +039500 PERFORM DE-LETE. IF1114.2 +039600 GO TO F-INTEGER-WRITE-05. IF1114.2 +039700 F-INTEGER-WRITE-05. IF1114.2 +039800 MOVE "F-INTEGER-05" TO PAR-NAME. IF1114.2 +039900 PERFORM PRINT-DETAIL. IF1114.2 +040000*****************TEST (f) ****************************** IF1114.2 +040100 F-INTEGER-06. IF1114.2 +040200 MOVE ZERO TO WS-INT. IF1114.2 +040300 F-INTEGER-TEST-06. IF1114.2 +040400 COMPUTE WS-INT = FUNCTION INTEGER(320485). IF1114.2 +040500 IF WS-INT = 320485 THEN IF1114.2 +040600 PERFORM PASS IF1114.2 +040700 ELSE IF1114.2 +040800 MOVE 320485 TO CORRECT-N IF1114.2 +040900 MOVE WS-INT TO COMPUTED-N IF1114.2 +041000 PERFORM FAIL. IF1114.2 +041100 GO TO F-INTEGER-WRITE-06. IF1114.2 +041200 F-INTEGER-DELETE-06. IF1114.2 +041300 PERFORM DE-LETE. IF1114.2 +041400 GO TO F-INTEGER-WRITE-06. IF1114.2 +041500 F-INTEGER-WRITE-06. IF1114.2 +041600 MOVE "F-INTEGER-06" TO PAR-NAME. IF1114.2 +041700 PERFORM PRINT-DETAIL. IF1114.2 +041800*****************TEST (g) ****************************** IF1114.2 +041900 F-INTEGER-07. IF1114.2 +042000 MOVE ZERO TO WS-INT. IF1114.2 +042100 F-INTEGER-TEST-07. IF1114.2 +042200 COMPUTE WS-INT = FUNCTION INTEGER(230492.4828). IF1114.2 +042300 IF WS-INT = 230492 THEN IF1114.2 +042400 PERFORM PASS IF1114.2 +042500 ELSE IF1114.2 +042600 MOVE 230492 TO CORRECT-N IF1114.2 +042700 MOVE WS-INT TO COMPUTED-N IF1114.2 +042800 PERFORM FAIL. IF1114.2 +042900 GO TO F-INTEGER-WRITE-07. IF1114.2 +043000 F-INTEGER-DELETE-07. IF1114.2 +043100 PERFORM DE-LETE. IF1114.2 +043200 GO TO F-INTEGER-WRITE-07. IF1114.2 +043300 F-INTEGER-WRITE-07. IF1114.2 +043400 MOVE "F-INTEGER-07" TO PAR-NAME. IF1114.2 +043500 PERFORM PRINT-DETAIL. IF1114.2 +043600*****************TEST (h) ****************************** IF1114.2 +043700 F-INTEGER-08. IF1114.2 +043800 MOVE ZERO TO WS-INT. IF1114.2 +043900 F-INTEGER-TEST-08. IF1114.2 +044000 COMPUTE WS-INT = FUNCTION INTEGER(0.00032). IF1114.2 +044100 IF WS-INT = 0 THEN IF1114.2 +044200 PERFORM PASS IF1114.2 +044300 ELSE IF1114.2 +044400 MOVE 0 TO CORRECT-N IF1114.2 +044500 MOVE WS-INT TO COMPUTED-N IF1114.2 +044600 PERFORM FAIL. IF1114.2 +044700 GO TO F-INTEGER-WRITE-08. IF1114.2 +044800 F-INTEGER-DELETE-08. IF1114.2 +044900 PERFORM DE-LETE. IF1114.2 +045000 GO TO F-INTEGER-WRITE-08. IF1114.2 +045100 F-INTEGER-WRITE-08. IF1114.2 +045200 MOVE "F-INTEGER-08" TO PAR-NAME. IF1114.2 +045300 PERFORM PRINT-DETAIL. IF1114.2 +045400*****************TEST (i) ****************************** IF1114.2 +045500 F-INTEGER-09. IF1114.2 +045600 MOVE ZERO TO WS-INT. IF1114.2 +045700 F-INTEGER-TEST-09. IF1114.2 +045800 COMPUTE WS-INT = FUNCTION INTEGER(A). IF1114.2 +045900 IF WS-INT = 500000 THEN IF1114.2 +046000 PERFORM PASS IF1114.2 +046100 ELSE IF1114.2 +046200 MOVE 500000 TO CORRECT-N IF1114.2 +046300 MOVE WS-INT TO COMPUTED-N IF1114.2 +046400 PERFORM FAIL. IF1114.2 +046500 GO TO F-INTEGER-WRITE-09. IF1114.2 +046600 F-INTEGER-DELETE-09. IF1114.2 +046700 PERFORM DE-LETE. IF1114.2 +046800 GO TO F-INTEGER-WRITE-09. IF1114.2 +046900 F-INTEGER-WRITE-09. IF1114.2 +047000 MOVE "F-INTEGER-09" TO PAR-NAME. IF1114.2 +047100 PERFORM PRINT-DETAIL. IF1114.2 +047200*****************TEST (j) ****************************** IF1114.2 +047300 F-INTEGER-10. IF1114.2 +047400 MOVE ZERO TO WS-INT. IF1114.2 +047500 F-INTEGER-TEST-10. IF1114.2 +047600 COMPUTE WS-INT = FUNCTION INTEGER(E). IF1114.2 +047700 IF WS-INT = 399999 THEN IF1114.2 +047800 PERFORM PASS IF1114.2 +047900 ELSE IF1114.2 +048000 MOVE 399999 TO CORRECT-N IF1114.2 +048100 MOVE WS-INT TO COMPUTED-N IF1114.2 +048200 PERFORM FAIL. IF1114.2 +048300 GO TO F-INTEGER-WRITE-10. IF1114.2 +048400 F-INTEGER-DELETE-10. IF1114.2 +048500 PERFORM DE-LETE. IF1114.2 +048600 GO TO F-INTEGER-WRITE-10. IF1114.2 +048700 F-INTEGER-WRITE-10. IF1114.2 +048800 MOVE "F-INTEGER-10" TO PAR-NAME. IF1114.2 +048900 PERFORM PRINT-DETAIL. IF1114.2 +049000*****************TEST (k) ****************************** IF1114.2 +049100 F-INTEGER-11. IF1114.2 +049200 MOVE ZERO TO WS-INT. IF1114.2 +049300 F-INTEGER-TEST-11. IF1114.2 +049400 COMPUTE WS-INT = FUNCTION INTEGER(B). IF1114.2 +049500 IF WS-INT = 1 THEN IF1114.2 +049600 PERFORM PASS IF1114.2 +049700 ELSE IF1114.2 +049800 MOVE 1 TO CORRECT-N IF1114.2 +049900 MOVE WS-INT TO COMPUTED-N IF1114.2 +050000 PERFORM FAIL. IF1114.2 +050100 GO TO F-INTEGER-WRITE-11. IF1114.2 +050200 F-INTEGER-DELETE-11. IF1114.2 +050300 PERFORM DE-LETE. IF1114.2 +050400 GO TO F-INTEGER-WRITE-11. IF1114.2 +050500 F-INTEGER-WRITE-11. IF1114.2 +050600 MOVE "F-INTEGER-11" TO PAR-NAME. IF1114.2 +050700 PERFORM PRINT-DETAIL. IF1114.2 +050800*****************TEST (l) ****************************** IF1114.2 +050900 F-INTEGER-12. IF1114.2 +051000 MOVE ZERO TO WS-INT. IF1114.2 +051100 F-INTEGER-TEST-12. IF1114.2 +051200 COMPUTE WS-INT = FUNCTION INTEGER(F). IF1114.2 +051300 IF WS-INT = 0 THEN IF1114.2 +051400 PERFORM PASS IF1114.2 +051500 ELSE IF1114.2 +051600 MOVE 0 TO CORRECT-N IF1114.2 +051700 MOVE WS-INT TO COMPUTED-N IF1114.2 +051800 PERFORM FAIL. IF1114.2 +051900 GO TO F-INTEGER-WRITE-12. IF1114.2 +052000 F-INTEGER-DELETE-12. IF1114.2 +052100 PERFORM DE-LETE. IF1114.2 +052200 GO TO F-INTEGER-WRITE-12. IF1114.2 +052300 F-INTEGER-WRITE-12. IF1114.2 +052400 MOVE "F-INTEGER-12" TO PAR-NAME. IF1114.2 +052500 PERFORM PRINT-DETAIL. IF1114.2 +052600*****************TEST (m) ****************************** IF1114.2 +052700 F-INTEGER-13. IF1114.2 +052800 MOVE ZERO TO WS-INT. IF1114.2 +052900 F-INTEGER-TEST-13. IF1114.2 +053000 COMPUTE WS-INT = FUNCTION INTEGER(IND(2)). IF1114.2 +053100 IF WS-INT = 0 THEN IF1114.2 +053200 PERFORM PASS IF1114.2 +053300 ELSE IF1114.2 +053400 MOVE 0 TO CORRECT-N IF1114.2 +053500 MOVE WS-INT TO COMPUTED-N IF1114.2 +053600 PERFORM FAIL. IF1114.2 +053700 GO TO F-INTEGER-WRITE-13. IF1114.2 +053800 F-INTEGER-DELETE-13. IF1114.2 +053900 PERFORM DE-LETE. IF1114.2 +054000 GO TO F-INTEGER-WRITE-13. IF1114.2 +054100 F-INTEGER-WRITE-13. IF1114.2 +054200 MOVE "F-INTEGER-13" TO PAR-NAME. IF1114.2 +054300 PERFORM PRINT-DETAIL. IF1114.2 +054400*****************TEST (n) ****************************** IF1114.2 +054500 F-INTEGER-14. IF1114.2 +054600 MOVE ZERO TO WS-INT. IF1114.2 +054700 F-INTEGER-TEST-14. IF1114.2 +054800 COMPUTE WS-INT = FUNCTION INTEGER(IND(B)). IF1114.2 +054900 IF WS-INT = 4 THEN IF1114.2 +055000 PERFORM PASS IF1114.2 +055100 ELSE IF1114.2 +055200 MOVE 4 TO CORRECT-N IF1114.2 +055300 MOVE WS-INT TO COMPUTED-N IF1114.2 +055400 PERFORM FAIL. IF1114.2 +055500 GO TO F-INTEGER-WRITE-14. IF1114.2 +055600 F-INTEGER-DELETE-14. IF1114.2 +055700 PERFORM DE-LETE. IF1114.2 +055800 GO TO F-INTEGER-WRITE-14. IF1114.2 +055900 F-INTEGER-WRITE-14. IF1114.2 +056000 MOVE "F-INTEGER-14" TO PAR-NAME. IF1114.2 +056100 PERFORM PRINT-DETAIL. IF1114.2 +056200*****************TEST (o) ****************************** IF1114.2 +056300 F-INTEGER-15. IF1114.2 +056400 MOVE ZERO TO WS-INT. IF1114.2 +056500 F-INTEGER-TEST-15. IF1114.2 +056600 COMPUTE WS-INT = FUNCTION INTEGER((6 / 3) + 9). IF1114.2 +056700 IF WS-INT = 11 THEN IF1114.2 +056800 PERFORM PASS IF1114.2 +056900 ELSE IF1114.2 +057000 MOVE 11 TO CORRECT-N IF1114.2 +057100 MOVE WS-INT TO COMPUTED-N IF1114.2 +057200 PERFORM FAIL. IF1114.2 +057300 GO TO F-INTEGER-WRITE-15. IF1114.2 +057400 F-INTEGER-DELETE-15. IF1114.2 +057500 PERFORM DE-LETE. IF1114.2 +057600 GO TO F-INTEGER-WRITE-15. IF1114.2 +057700 F-INTEGER-WRITE-15. IF1114.2 +057800 MOVE "F-INTEGER-15" TO PAR-NAME. IF1114.2 +057900 PERFORM PRINT-DETAIL. IF1114.2 +058000*****************TEST (p) ****************************** IF1114.2 +058100 F-INTEGER-16. IF1114.2 +058200 MOVE ZERO TO WS-INT. IF1114.2 +058300 F-INTEGER-TEST-16. IF1114.2 +058400 COMPUTE WS-INT = FUNCTION INTEGER(H + B). IF1114.2 +058500 IF WS-INT = -4 THEN IF1114.2 +058600 PERFORM PASS IF1114.2 +058700 ELSE IF1114.2 +058800 MOVE -4 TO CORRECT-N IF1114.2 +058900 MOVE WS-INT TO COMPUTED-N IF1114.2 +059000 PERFORM FAIL. IF1114.2 +059100 GO TO F-INTEGER-WRITE-16. IF1114.2 +059200 F-INTEGER-DELETE-16. IF1114.2 +059300 PERFORM DE-LETE. IF1114.2 +059400 GO TO F-INTEGER-WRITE-16. IF1114.2 +059500 F-INTEGER-WRITE-16. IF1114.2 +059600 MOVE "F-INTEGER-16" TO PAR-NAME. IF1114.2 +059700 PERFORM PRINT-DETAIL. IF1114.2 +059800*****************TEST (q) ****************************** IF1114.2 +059900 F-INTEGER-17. IF1114.2 +060000 MOVE ZERO TO WS-INT. IF1114.2 +060100 F-INTEGER-TEST-17. IF1114.2 +060200 COMPUTE WS-INT = FUNCTION INTEGER(6.3 - 4.2 / 2). IF1114.2 +060300 IF WS-INT = 4 THEN IF1114.2 +060400 PERFORM PASS IF1114.2 +060500 ELSE IF1114.2 +060600 MOVE 4 TO CORRECT-N IF1114.2 +060700 MOVE WS-INT TO COMPUTED-N IF1114.2 +060800 PERFORM FAIL. IF1114.2 +060900 GO TO F-INTEGER-WRITE-17. IF1114.2 +061000 F-INTEGER-DELETE-17. IF1114.2 +061100 PERFORM DE-LETE. IF1114.2 +061200 GO TO F-INTEGER-WRITE-17. IF1114.2 +061300 F-INTEGER-WRITE-17. IF1114.2 +061400 MOVE "F-INTEGER-17" TO PAR-NAME. IF1114.2 +061500 PERFORM PRINT-DETAIL. IF1114.2 +061600*****************TEST (r) ****************************** IF1114.2 +061700 F-INTEGER-18. IF1114.2 +061800 MOVE ZERO TO WS-INT. IF1114.2 +061900 F-INTEGER-TEST-18. IF1114.2 +062000 COMPUTE WS-INT = FUNCTION INTEGER((H + G) * I). IF1114.2 +062100 IF WS-INT = -4 THEN IF1114.2 +062200 PERFORM PASS IF1114.2 +062300 ELSE IF1114.2 +062400 MOVE -4 TO CORRECT-N IF1114.2 +062500 MOVE WS-INT TO COMPUTED-N IF1114.2 +062600 PERFORM FAIL. IF1114.2 +062700 GO TO F-INTEGER-WRITE-18. IF1114.2 +062800 F-INTEGER-DELETE-18. IF1114.2 +062900 PERFORM DE-LETE. IF1114.2 +063000 GO TO F-INTEGER-WRITE-18. IF1114.2 +063100 F-INTEGER-WRITE-18. IF1114.2 +063200 MOVE "F-INTEGER-18" TO PAR-NAME. IF1114.2 +063300 PERFORM PRINT-DETAIL. IF1114.2 +063400*****************TEST (s) ****************************** IF1114.2 +063500 F-INTEGER-19. IF1114.2 +063600 MOVE ZERO TO WS-INT. IF1114.2 +063700 F-INTEGER-TEST-19. IF1114.2 +063800 COMPUTE WS-INT = FUNCTION INTEGER(H / 5). IF1114.2 +063900 IF WS-INT = -1 THEN IF1114.2 +064000 PERFORM PASS IF1114.2 +064100 ELSE IF1114.2 +064200 MOVE -1 TO CORRECT-N IF1114.2 +064300 MOVE WS-INT TO COMPUTED-N IF1114.2 +064400 PERFORM FAIL. IF1114.2 +064500 GO TO F-INTEGER-WRITE-19. IF1114.2 +064600 F-INTEGER-DELETE-19. IF1114.2 +064700 PERFORM DE-LETE. IF1114.2 +064800 GO TO F-INTEGER-WRITE-19. IF1114.2 +064900 F-INTEGER-WRITE-19. IF1114.2 +065000 MOVE "F-INTEGER-19" TO PAR-NAME. IF1114.2 +065100 PERFORM PRINT-DETAIL. IF1114.2 +065200*****************TEST (t) ****************************** IF1114.2 +065300 F-INTEGER-20. IF1114.2 +065400 MOVE ZERO TO TEMP. IF1114.2 +065500 F-INTEGER-TEST-20. IF1114.2 +065600 COMPUTE TEMP = FUNCTION INTEGER(3.2) + I. IF1114.2 +065700 IF (TEMP >= 6.39987) AND IF1114.2 +065800 (TEMP <= 6.40013) IF1114.2 +065900 PERFORM PASS IF1114.2 +066000 ELSE IF1114.2 +066100 MOVE 6.4 TO CORRECT-N IF1114.2 +066200 MOVE TEMP TO COMPUTED-N IF1114.2 +066300 PERFORM FAIL. IF1114.2 +066400 GO TO F-INTEGER-WRITE-20. IF1114.2 +066500 F-INTEGER-DELETE-20. IF1114.2 +066600 PERFORM DE-LETE. IF1114.2 +066700 GO TO F-INTEGER-WRITE-20. IF1114.2 +066800 F-INTEGER-WRITE-20. IF1114.2 +066900 MOVE "F-INTEGER-20" TO PAR-NAME. IF1114.2 +067000 PERFORM PRINT-DETAIL. IF1114.2 +067100*****************TEST (u) ****************************** IF1114.2 +067200 F-INTEGER-21. IF1114.2 +067300 MOVE ZERO TO WS-INT. IF1114.2 +067400 F-INTEGER-TEST-21. IF1114.2 +067500 COMPUTE WS-INT = FUNCTION INTEGER(FUNCTION INTEGER(1.6)). IF1114.2 +067600 IF WS-INT = 1 THEN IF1114.2 +067700 PERFORM PASS IF1114.2 +067800 ELSE IF1114.2 +067900 MOVE 1 TO CORRECT-N IF1114.2 +068000 MOVE WS-INT TO COMPUTED-N IF1114.2 +068100 PERFORM FAIL. IF1114.2 +068200 GO TO F-INTEGER-WRITE-21. IF1114.2 +068300 F-INTEGER-DELETE-21. IF1114.2 +068400 PERFORM DE-LETE. IF1114.2 +068500 GO TO F-INTEGER-WRITE-21. IF1114.2 +068600 F-INTEGER-WRITE-21. IF1114.2 +068700 MOVE "F-INTEGER-21" TO PAR-NAME. IF1114.2 +068800 PERFORM PRINT-DETAIL. IF1114.2 +068900*****************TEST (v) ****************************** IF1114.2 +069000 F-INTEGER-22. IF1114.2 +069100 MOVE ZERO TO WS-INT. IF1114.2 +069200 F-INTEGER-TEST-22. IF1114.2 +069300 COMPUTE WS-INT = FUNCTION INTEGER(1.2) + IF1114.2 +069400 FUNCTION INTEGER(1.6). IF1114.2 +069500 IF WS-INT = 2 THEN IF1114.2 +069600 PERFORM PASS IF1114.2 +069700 ELSE IF1114.2 +069800 MOVE 2 TO CORRECT-N IF1114.2 +069900 MOVE WS-INT TO COMPUTED-N IF1114.2 +070000 PERFORM FAIL. IF1114.2 +070100 GO TO F-INTEGER-WRITE-22. IF1114.2 +070200 F-INTEGER-DELETE-22. IF1114.2 +070300 PERFORM DE-LETE. IF1114.2 +070400 GO TO F-INTEGER-WRITE-22. IF1114.2 +070500 F-INTEGER-WRITE-22. IF1114.2 +070600 MOVE "F-INTEGER-22" TO PAR-NAME. IF1114.2 +070700 PERFORM PRINT-DETAIL. IF1114.2 +070800***************** SPECIAL TEST 1 *********************** IF1114.2 +070900 F-DATEOFINT-23. IF1114.2 +071000*** ARG1:=4.4 *** IF1114.2 +071100 PERFORM F-DATEOFINT-TEST-23 IF1114.2 +071200 UNTIL FUNCTION INTEGER(ARG1) < 0. IF1114.2 +071300 IF ARG1 < 0 THEN IF1114.2 +071400 PERFORM PASS IF1114.2 +071500 ELSE IF1114.2 +071600 PERFORM FAIL. IF1114.2 +071700 GO TO F-DATEOFINT-WRITE-23. IF1114.2 +071800* IF1114.2 +071900 F-DATEOFINT-TEST-23. IF1114.2 +072000 COMPUTE ARG1 = ARG1 - 1. IF1114.2 +072100* IF1114.2 +072200 F-DATEOFINT-DELETE-23. IF1114.2 +072300 PERFORM DE-LETE. IF1114.2 +072400 GO TO F-DATEOFINT-WRITE-23. IF1114.2 +072500 F-DATEOFINT-WRITE-23. IF1114.2 +072600 MOVE "F-DATEOFINT-23" TO PAR-NAME. IF1114.2 +072700 PERFORM PRINT-DETAIL. IF1114.2 +072800*******************END OF TESTS************************** IF1114.2 +072900 CCVS-EXIT SECTION. IF1114.2 +073000 CCVS-999999. IF1114.2 +073100 GO TO CLOSE-FILES. IF1114.2 diff --git a/tests/cobol85/IF/IF112A.CBL b/tests/cobol85/IF/IF112A.CBL new file mode 100755 index 00000000..08f18b67 --- /dev/null +++ b/tests/cobol85/IF/IF112A.CBL @@ -0,0 +1,452 @@ +000100 IDENTIFICATION DIVISION. IF1124.2 +000200 PROGRAM-ID. IF1124.2 +000300 IF112A. IF1124.2 +000400 IF1124.2 +000500*********************************************************** IF1124.2 +000600* * IF1124.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1124.2 +000800* It contains tests for the Intrinsic Function * IF1124.2 +000900* INTEGER-OF-DATE. * IF1124.2 +001000* * IF1124.2 +001100*********************************************************** IF1124.2 +001200 ENVIRONMENT DIVISION. IF1124.2 +001300 CONFIGURATION SECTION. IF1124.2 +001400 SOURCE-COMPUTER. IF1124.2 +001500 Linux. IF1124.2 +001600 OBJECT-COMPUTER. IF1124.2 +001700 Linux. IF1124.2 +001800 INPUT-OUTPUT SECTION. IF1124.2 +001900 FILE-CONTROL. IF1124.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1124.2 +002100 "report.log". IF1124.2 +002200 DATA DIVISION. IF1124.2 +002300 FILE SECTION. IF1124.2 +002400 FD PRINT-FILE. IF1124.2 +002500 01 PRINT-REC PICTURE X(120). IF1124.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1124.2 +002700 WORKING-STORAGE SECTION. IF1124.2 +002800*********************************************************** IF1124.2 +002900* Variables specific to the Intrinsic Function Test IF112A* IF1124.2 +003000*********************************************************** IF1124.2 +003100 01 A PIC S9(10) VALUE 16020204. IF1124.2 +003200 01 D PIC S9(10) VALUE 2. IF1124.2 +003300 01 ARG1 PIC S9(10) VALUE 16010101. IF1124.2 +003400 01 ARR VALUE "1601010116020210". IF1124.2 +003500 02 IND OCCURS 2 TIMES PIC 9(8). IF1124.2 +003600 01 TEMP PIC S9(10). IF1124.2 +003700 01 WS-INT PIC 9(8). IF1124.2 +003800* IF1124.2 +003900********************************************************** IF1124.2 +004000* IF1124.2 +004100 01 TEST-RESULTS. IF1124.2 +004200 02 FILLER PIC X VALUE SPACE. IF1124.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. IF1124.2 +004400 02 FILLER PIC X VALUE SPACE. IF1124.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. IF1124.2 +004600 02 FILLER PIC X VALUE SPACE. IF1124.2 +004700 02 PAR-NAME. IF1124.2 +004800 03 FILLER PIC X(19) VALUE SPACE. IF1124.2 +004900 03 PARDOT-X PIC X VALUE SPACE. IF1124.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. IF1124.2 +005100 02 FILLER PIC X(8) VALUE SPACE. IF1124.2 +005200 02 RE-MARK PIC X(61). IF1124.2 +005300 01 TEST-COMPUTED. IF1124.2 +005400 02 FILLER PIC X(30) VALUE SPACE. IF1124.2 +005500 02 FILLER PIC X(17) VALUE IF1124.2 +005600 " COMPUTED=". IF1124.2 +005700 02 COMPUTED-X. IF1124.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1124.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A IF1124.2 +006000 PIC -9(9).9(9). IF1124.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1124.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1124.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1124.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. IF1124.2 +006500 04 COMPUTED-18V0 PIC -9(18). IF1124.2 +006600 04 FILLER PIC X. IF1124.2 +006700 03 FILLER PIC X(50) VALUE SPACE. IF1124.2 +006800 01 TEST-CORRECT. IF1124.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1124.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1124.2 +007100 02 CORRECT-X. IF1124.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1124.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1124.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1124.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1124.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1124.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. IF1124.2 +007800 04 CORRECT-18V0 PIC -9(18). IF1124.2 +007900 04 FILLER PIC X. IF1124.2 +008000 03 FILLER PIC X(2) VALUE SPACE. IF1124.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1124.2 +008200 01 CCVS-C-1. IF1124.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1124.2 +008400- "SS PARAGRAPH-NAME IF1124.2 +008500- " REMARKS". IF1124.2 +008600 02 FILLER PIC X(20) VALUE SPACE. IF1124.2 +008700 01 CCVS-C-2. IF1124.2 +008800 02 FILLER PIC X VALUE SPACE. IF1124.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". IF1124.2 +009000 02 FILLER PIC X(15) VALUE SPACE. IF1124.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". IF1124.2 +009200 02 FILLER PIC X(94) VALUE SPACE. IF1124.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1124.2 +009400 01 REC-CT PIC 99 VALUE ZERO. IF1124.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1124.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1124.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1124.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1124.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1124.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1124.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1124.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1124.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1124.2 +010400 01 CCVS-H-1. IF1124.2 +010500 02 FILLER PIC X(39) VALUE SPACES. IF1124.2 +010600 02 FILLER PIC X(42) VALUE IF1124.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1124.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IF1124.2 +010900 01 CCVS-H-2A. IF1124.2 +011000 02 FILLER PIC X(40) VALUE SPACE. IF1124.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1124.2 +011200 02 FILLER PIC XXXX VALUE IF1124.2 +011300 "4.2 ". IF1124.2 +011400 02 FILLER PIC X(28) VALUE IF1124.2 +011500 " COPY - NOT FOR DISTRIBUTION". IF1124.2 +011600 02 FILLER PIC X(41) VALUE SPACE. IF1124.2 +011700 IF1124.2 +011800 01 CCVS-H-2B. IF1124.2 +011900 02 FILLER PIC X(15) VALUE IF1124.2 +012000 "TEST RESULT OF ". IF1124.2 +012100 02 TEST-ID PIC X(9). IF1124.2 +012200 02 FILLER PIC X(4) VALUE IF1124.2 +012300 " IN ". IF1124.2 +012400 02 FILLER PIC X(12) VALUE IF1124.2 +012500 " HIGH ". IF1124.2 +012600 02 FILLER PIC X(22) VALUE IF1124.2 +012700 " LEVEL VALIDATION FOR ". IF1124.2 +012800 02 FILLER PIC X(58) VALUE IF1124.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1124.2 +013000 01 CCVS-H-3. IF1124.2 +013100 02 FILLER PIC X(34) VALUE IF1124.2 +013200 " FOR OFFICIAL USE ONLY ". IF1124.2 +013300 02 FILLER PIC X(58) VALUE IF1124.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1124.2 +013500 02 FILLER PIC X(28) VALUE IF1124.2 +013600 " COPYRIGHT 1985 ". IF1124.2 +013700 01 CCVS-E-1. IF1124.2 +013800 02 FILLER PIC X(52) VALUE SPACE. IF1124.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1124.2 +014000 02 ID-AGAIN PIC X(9). IF1124.2 +014100 02 FILLER PIC X(45) VALUE SPACES. IF1124.2 +014200 01 CCVS-E-2. IF1124.2 +014300 02 FILLER PIC X(31) VALUE SPACE. IF1124.2 +014400 02 FILLER PIC X(21) VALUE SPACE. IF1124.2 +014500 02 CCVS-E-2-2. IF1124.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1124.2 +014700 03 FILLER PIC X VALUE SPACE. IF1124.2 +014800 03 ENDER-DESC PIC X(44) VALUE IF1124.2 +014900 "ERRORS ENCOUNTERED". IF1124.2 +015000 01 CCVS-E-3. IF1124.2 +015100 02 FILLER PIC X(22) VALUE IF1124.2 +015200 " FOR OFFICIAL USE ONLY". IF1124.2 +015300 02 FILLER PIC X(12) VALUE SPACE. IF1124.2 +015400 02 FILLER PIC X(58) VALUE IF1124.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1124.2 +015600 02 FILLER PIC X(13) VALUE SPACE. IF1124.2 +015700 02 FILLER PIC X(15) VALUE IF1124.2 +015800 " COPYRIGHT 1985". IF1124.2 +015900 01 CCVS-E-4. IF1124.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1124.2 +016100 02 FILLER PIC X(4) VALUE " OF ". IF1124.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1124.2 +016300 02 FILLER PIC X(40) VALUE IF1124.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1124.2 +016500 01 XXINFO. IF1124.2 +016600 02 FILLER PIC X(19) VALUE IF1124.2 +016700 "*** INFORMATION ***". IF1124.2 +016800 02 INFO-TEXT. IF1124.2 +016900 04 FILLER PIC X(8) VALUE SPACE. IF1124.2 +017000 04 XXCOMPUTED PIC X(20). IF1124.2 +017100 04 FILLER PIC X(5) VALUE SPACE. IF1124.2 +017200 04 XXCORRECT PIC X(20). IF1124.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). IF1124.2 +017400 01 HYPHEN-LINE. IF1124.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. IF1124.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************IF1124.2 +017700- "*****************************************". IF1124.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************IF1124.2 +017900- "******************************". IF1124.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE IF1124.2 +018100 "IF112A". IF1124.2 +018200 PROCEDURE DIVISION. IF1124.2 +018300 CCVS1 SECTION. IF1124.2 +018400 OPEN-FILES. IF1124.2 +018500 OPEN OUTPUT PRINT-FILE. IF1124.2 +018600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1124.2 +018700 MOVE SPACE TO TEST-RESULTS. IF1124.2 +018800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1124.2 +018900 GO TO CCVS1-EXIT. IF1124.2 +019000 CLOSE-FILES. IF1124.2 +019100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1124.2 +019200 TERMINATE-CCVS. IF1124.2 +019300 STOP RUN. IF1124.2 +019400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1124.2 +019500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1124.2 +019600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1124.2 +019700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1124.2 +019800 MOVE "****TEST DELETED****" TO RE-MARK. IF1124.2 +019900 PRINT-DETAIL. IF1124.2 +020000 IF REC-CT NOT EQUAL TO ZERO IF1124.2 +020100 MOVE "." TO PARDOT-X IF1124.2 +020200 MOVE REC-CT TO DOTVALUE. IF1124.2 +020300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1124.2 +020400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1124.2 +020500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1124.2 +020600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1124.2 +020700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1124.2 +020800 MOVE SPACE TO CORRECT-X. IF1124.2 +020900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1124.2 +021000 MOVE SPACE TO RE-MARK. IF1124.2 +021100 HEAD-ROUTINE. IF1124.2 +021200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +021300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +021400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1124.2 +021500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1124.2 +021600 COLUMN-NAMES-ROUTINE. IF1124.2 +021700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +021800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +022000 END-ROUTINE. IF1124.2 +022100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1124.2 +022200 END-RTN-EXIT. IF1124.2 +022300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +022400 END-ROUTINE-1. IF1124.2 +022500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1124.2 +022600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1124.2 +022700 ADD PASS-COUNTER TO ERROR-HOLD. IF1124.2 +022800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1124.2 +022900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1124.2 +023000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1124.2 +023100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1124.2 +023200 END-ROUTINE-12. IF1124.2 +023300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1124.2 +023400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1124.2 +023500 MOVE "NO " TO ERROR-TOTAL IF1124.2 +023600 ELSE IF1124.2 +023700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1124.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1124.2 +023900 PERFORM WRITE-LINE. IF1124.2 +024000 END-ROUTINE-13. IF1124.2 +024100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1124.2 +024200 MOVE "NO " TO ERROR-TOTAL ELSE IF1124.2 +024300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1124.2 +024400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1124.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +024600 IF INSPECT-COUNTER EQUAL TO ZERO IF1124.2 +024700 MOVE "NO " TO ERROR-TOTAL IF1124.2 +024800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1124.2 +024900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1124.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +025100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1124.2 +025200 WRITE-LINE. IF1124.2 +025300 ADD 1 TO RECORD-COUNT. IF1124.2 +025400 IF RECORD-COUNT GREATER 42 IF1124.2 +025500 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1124.2 +025600 MOVE SPACE TO DUMMY-RECORD IF1124.2 +025700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1124.2 +025800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1124.2 +025900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1124.2 +026000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1124.2 +026100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1124.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1124.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1124.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1124.2 +026500 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1124.2 +026600 MOVE ZERO TO RECORD-COUNT. IF1124.2 +026700 PERFORM WRT-LN. IF1124.2 +026800 WRT-LN. IF1124.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1124.2 +027000 MOVE SPACE TO DUMMY-RECORD. IF1124.2 +027100 BLANK-LINE-PRINT. IF1124.2 +027200 PERFORM WRT-LN. IF1124.2 +027300 FAIL-ROUTINE. IF1124.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE IF1124.2 +027500 GO TO FAIL-ROUTINE-WRITE. IF1124.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1124.2 +027700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1124.2 +027800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1124.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +028000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1124.2 +028100 GO TO FAIL-ROUTINE-EX. IF1124.2 +028200 FAIL-ROUTINE-WRITE. IF1124.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1124.2 +028400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1124.2 +028500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1124.2 +028600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1124.2 +028700 FAIL-ROUTINE-EX. EXIT. IF1124.2 +028800 BAIL-OUT. IF1124.2 +028900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1124.2 +029000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1124.2 +029100 BAIL-OUT-WRITE. IF1124.2 +029200 MOVE CORRECT-A TO XXCORRECT. IF1124.2 +029300 MOVE COMPUTED-A TO XXCOMPUTED. IF1124.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1124.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1124.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1124.2 +029700 BAIL-OUT-EX. EXIT. IF1124.2 +029800 CCVS1-EXIT. IF1124.2 +029900 EXIT. IF1124.2 +030000******************************************************** IF1124.2 +030100* * IF1124.2 +030200* Intrinsic Function Test IF112A - INTEGER-OF-DATE * IF1124.2 +030300* * IF1124.2 +030400******************************************************** IF1124.2 +030500 SECT-IF112A SECTION. IF1124.2 +030600 F-DATEOFINT-INFO. IF1124.2 +030700 MOVE "See ref. A-45 2.16" TO ANSI-REFERENCE. IF1124.2 +030800 MOVE "INTEGER-OF-DATE" TO FEATURE. IF1124.2 +030900*****************TEST (a) ****************************** IF1124.2 +031000 F-DATEOFINT-01. IF1124.2 +031100 MOVE ZERO TO WS-INT. IF1124.2 +031200 F-DATEOFINT-TEST-01. IF1124.2 +031300 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(16010101). IF1124.2 +031400 IF WS-INT = 1 THEN IF1124.2 +031500 PERFORM PASS IF1124.2 +031600 ELSE IF1124.2 +031700 MOVE 1 TO CORRECT-N IF1124.2 +031800 MOVE WS-INT TO COMPUTED-N IF1124.2 +031900 PERFORM FAIL. IF1124.2 +032000 GO TO F-DATEOFINT-WRITE-01. IF1124.2 +032100 F-DATEOFINT-DELETE-01. IF1124.2 +032200 PERFORM DE-LETE. IF1124.2 +032300 GO TO F-DATEOFINT-WRITE-01. IF1124.2 +032400 F-DATEOFINT-WRITE-01. IF1124.2 +032500 MOVE "F-DATEOFINT-01" TO PAR-NAME. IF1124.2 +032600 PERFORM PRINT-DETAIL. IF1124.2 +032700*****************TEST (b) ****************************** IF1124.2 +032800 F-DATEOFINT-TEST-02. IF1124.2 +032900 EVALUATE FUNCTION INTEGER-OF-DATE(A) IF1124.2 +033000 WHEN 400 IF1124.2 +033100 PERFORM PASS IF1124.2 +033200 GO TO F-DATEOFINT-WRITE-02. IF1124.2 +033300 PERFORM FAIL. IF1124.2 +033400 GO TO F-DATEOFINT-WRITE-02. IF1124.2 +033500 F-DATEOFINT-DELETE-02. IF1124.2 +033600 PERFORM DE-LETE. IF1124.2 +033700 GO TO F-DATEOFINT-WRITE-02. IF1124.2 +033800 F-DATEOFINT-WRITE-02. IF1124.2 +033900 MOVE "F-DATEOFINT-02" TO PAR-NAME. IF1124.2 +034000 PERFORM PRINT-DETAIL. IF1124.2 +034100*****************TEST (c) ****************************** IF1124.2 +034200 F-DATEOFINT-TEST-03. IF1124.2 +034300 IF FUNCTION INTEGER-OF-DATE(IND(1)) = 1 THEN IF1124.2 +034400 PERFORM PASS IF1124.2 +034500 ELSE IF1124.2 +034600 PERFORM FAIL. IF1124.2 +034700 GO TO F-DATEOFINT-WRITE-03. IF1124.2 +034800 F-DATEOFINT-DELETE-03. IF1124.2 +034900 PERFORM DE-LETE. IF1124.2 +035000 GO TO F-DATEOFINT-WRITE-03. IF1124.2 +035100 F-DATEOFINT-WRITE-03. IF1124.2 +035200 MOVE "F-DATEOFINT-03" TO PAR-NAME. IF1124.2 +035300 PERFORM PRINT-DETAIL. IF1124.2 +035400*****************TEST (d) ****************************** IF1124.2 +035500 F-DATEOFINT-04. IF1124.2 +035600 MOVE ZERO TO WS-INT. IF1124.2 +035700 F-DATEOFINT-TEST-04. IF1124.2 +035800 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(IND(D)). IF1124.2 +035900 IF WS-INT = 406 THEN IF1124.2 +036000 PERFORM PASS IF1124.2 +036100 ELSE IF1124.2 +036200 MOVE 406 TO CORRECT-N IF1124.2 +036300 MOVE WS-INT TO COMPUTED-N IF1124.2 +036400 PERFORM FAIL. IF1124.2 +036500 GO TO F-DATEOFINT-WRITE-04. IF1124.2 +036600 F-DATEOFINT-DELETE-04. IF1124.2 +036700 PERFORM DE-LETE. IF1124.2 +036800 GO TO F-DATEOFINT-WRITE-04. IF1124.2 +036900 F-DATEOFINT-WRITE-04. IF1124.2 +037000 MOVE "F-DATEOFINT-04" TO PAR-NAME. IF1124.2 +037100 PERFORM PRINT-DETAIL. IF1124.2 +037200*****************TEST (e) ****************************** IF1124.2 +037300 F-DATEOFINT-05. IF1124.2 +037400 MOVE ZERO TO WS-INT. IF1124.2 +037500 F-DATEOFINT-TEST-05. IF1124.2 +037600 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(16011231). IF1124.2 +037700 IF WS-INT = 365 THEN IF1124.2 +037800 PERFORM PASS IF1124.2 +037900 ELSE IF1124.2 +038000 MOVE 365 TO CORRECT-N IF1124.2 +038100 MOVE WS-INT TO COMPUTED-N IF1124.2 +038200 PERFORM FAIL. IF1124.2 +038300 GO TO F-DATEOFINT-WRITE-05. IF1124.2 +038400 F-DATEOFINT-DELETE-05. IF1124.2 +038500 PERFORM DE-LETE. IF1124.2 +038600 GO TO F-DATEOFINT-WRITE-05. IF1124.2 +038700 F-DATEOFINT-WRITE-05. IF1124.2 +038800 MOVE "F-DATEOFINT-05" TO PAR-NAME. IF1124.2 +038900 PERFORM PRINT-DETAIL. IF1124.2 +039000*****************TEST (f) ****************************** IF1124.2 +039100 F-DATEOFINT-06. IF1124.2 +039200 MOVE ZERO TO WS-INT. IF1124.2 +039300 F-DATEOFINT-TEST-06. IF1124.2 +039400 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(A) + 10. IF1124.2 +039500 IF WS-INT = 410 THEN IF1124.2 +039600 PERFORM PASS IF1124.2 +039700 ELSE IF1124.2 +039800 MOVE 410 TO CORRECT-N IF1124.2 +039900 MOVE WS-INT TO COMPUTED-N IF1124.2 +040000 PERFORM FAIL. IF1124.2 +040100 GO TO F-DATEOFINT-WRITE-06. IF1124.2 +040200 F-DATEOFINT-DELETE-06. IF1124.2 +040300 PERFORM DE-LETE. IF1124.2 +040400 GO TO F-DATEOFINT-WRITE-06. IF1124.2 +040500 F-DATEOFINT-WRITE-06. IF1124.2 +040600 MOVE "F-DATEOFINT-06" TO PAR-NAME. IF1124.2 +040700 PERFORM PRINT-DETAIL. IF1124.2 +040800*****************TEST (g) ****************************** IF1124.2 +040900 F-DATEOFINT-07. IF1124.2 +041000 MOVE ZERO TO WS-INT. IF1124.2 +041100 F-DATEOFINT-TEST-07. IF1124.2 +041200 COMPUTE WS-INT = FUNCTION INTEGER-OF-DATE(A) + IF1124.2 +041300 FUNCTION INTEGER-OF-DATE(A). IF1124.2 +041400 IF WS-INT = 800 THEN IF1124.2 +041500 PERFORM PASS IF1124.2 +041600 ELSE IF1124.2 +041700 MOVE 800 TO CORRECT-N IF1124.2 +041800 MOVE WS-INT TO COMPUTED-N IF1124.2 +041900 PERFORM FAIL. IF1124.2 +042000 GO TO F-DATEOFINT-WRITE-07. IF1124.2 +042100 F-DATEOFINT-DELETE-07. IF1124.2 +042200 PERFORM DE-LETE. IF1124.2 +042300 GO TO F-DATEOFINT-WRITE-07. IF1124.2 +042400 F-DATEOFINT-WRITE-07. IF1124.2 +042500 MOVE "F-DATEOFINT-07" TO PAR-NAME. IF1124.2 +042600 PERFORM PRINT-DETAIL. IF1124.2 +042700 IF1124.2 +042800***************** SPECIAL TEST 1 *********************** IF1124.2 +042900 IF1124.2 +043000 F-DATEOFINT-10. IF1124.2 +043100 MOVE 16010101 TO ARG1. IF1124.2 +043200 PERFORM F-DATEOFINT-TEST-10 IF1124.2 +043300 UNTIL FUNCTION INTEGER-OF-DATE(ARG1) > 10. IF1124.2 +043400 IF ARG1 = 16010111 THEN IF1124.2 +043500 PERFORM PASS IF1124.2 +043600 ELSE IF1124.2 +043700 PERFORM FAIL. IF1124.2 +043800 GO TO F-DATEOFINT-WRITE-10. IF1124.2 +043900* IF1124.2 +044000 F-DATEOFINT-TEST-10. IF1124.2 +044100 COMPUTE ARG1 = ARG1 + 1. IF1124.2 +044200* IF1124.2 +044300 F-DATEOFINT-DELETE-10. IF1124.2 +044400 PERFORM DE-LETE. IF1124.2 +044500 GO TO F-DATEOFINT-WRITE-10. IF1124.2 +044600 F-DATEOFINT-WRITE-10. IF1124.2 +044700 MOVE "F-DATEOFINT-10" TO PAR-NAME. IF1124.2 +044800 PERFORM PRINT-DETAIL. IF1124.2 +044900*******************END OF TESTS************************** IF1124.2 +045000 CCVS-EXIT SECTION. IF1124.2 +045100 CCVS-999999. IF1124.2 +045200 GO TO CLOSE-FILES. IF1124.2 diff --git a/tests/cobol85/IF/IF113A.CBL b/tests/cobol85/IF/IF113A.CBL new file mode 100755 index 00000000..12f31776 --- /dev/null +++ b/tests/cobol85/IF/IF113A.CBL @@ -0,0 +1,451 @@ +000100 IDENTIFICATION DIVISION. IF1134.2 +000200 PROGRAM-ID. IF1134.2 +000300 IF113A. IF1134.2 +000400 IF1134.2 +000500*********************************************************** IF1134.2 +000600* * IF1134.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1134.2 +000800* It contains tests for the Intrinsic Function * IF1134.2 +000900* INTEGER-OF-DAY. * IF1134.2 +001000* * IF1134.2 +001100*********************************************************** IF1134.2 +001200 ENVIRONMENT DIVISION. IF1134.2 +001300 CONFIGURATION SECTION. IF1134.2 +001400 SOURCE-COMPUTER. IF1134.2 +001500 Linux. IF1134.2 +001600 OBJECT-COMPUTER. IF1134.2 +001700 Linux. IF1134.2 +001800 INPUT-OUTPUT SECTION. IF1134.2 +001900 FILE-CONTROL. IF1134.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1134.2 +002100 "report.log". IF1134.2 +002200 DATA DIVISION. IF1134.2 +002300 FILE SECTION. IF1134.2 +002400 FD PRINT-FILE. IF1134.2 +002500 01 PRINT-REC PICTURE X(120). IF1134.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1134.2 +002700 WORKING-STORAGE SECTION. IF1134.2 +002800*********************************************************** IF1134.2 +002900* Variables specific to the Intrinsic Function Test IF113A* IF1134.2 +003000*********************************************************** IF1134.2 +003100 01 A PIC S9(10) VALUE 1602035. IF1134.2 +003200 01 C PIC S9(10) VALUE 2. IF1134.2 +003300 01 D PIC S9(10) VALUE 2. IF1134.2 +003400 01 ARG1 PIC S9(10) VALUE 1601001. IF1134.2 +003500 01 ARR VALUE "16010011602035". IF1134.2 +003600 02 IND OCCURS 2 TIMES PIC 9(7). IF1134.2 +003700 01 TEMP PIC S9(10). IF1134.2 +003800 01 WS-INT PIC 9(10). IF1134.2 +003900* IF1134.2 +004000********************************************************** IF1134.2 +004100* IF1134.2 +004200 01 TEST-RESULTS. IF1134.2 +004300 02 FILLER PIC X VALUE SPACE. IF1134.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1134.2 +004500 02 FILLER PIC X VALUE SPACE. IF1134.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1134.2 +004700 02 FILLER PIC X VALUE SPACE. IF1134.2 +004800 02 PAR-NAME. IF1134.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1134.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1134.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1134.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1134.2 +005300 02 RE-MARK PIC X(61). IF1134.2 +005400 01 TEST-COMPUTED. IF1134.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1134.2 +005600 02 FILLER PIC X(17) VALUE IF1134.2 +005700 " COMPUTED=". IF1134.2 +005800 02 COMPUTED-X. IF1134.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1134.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1134.2 +006100 PIC -9(9).9(9). IF1134.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1134.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1134.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1134.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1134.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1134.2 +006700 04 FILLER PIC X. IF1134.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1134.2 +006900 01 TEST-CORRECT. IF1134.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1134.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1134.2 +007200 02 CORRECT-X. IF1134.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1134.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1134.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1134.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1134.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1134.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1134.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1134.2 +008000 04 FILLER PIC X. IF1134.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1134.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1134.2 +008300 01 CCVS-C-1. IF1134.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1134.2 +008500- "SS PARAGRAPH-NAME IF1134.2 +008600- " REMARKS". IF1134.2 +008700 02 FILLER PIC X(20) VALUE SPACE. IF1134.2 +008800 01 CCVS-C-2. IF1134.2 +008900 02 FILLER PIC X VALUE SPACE. IF1134.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". IF1134.2 +009100 02 FILLER PIC X(15) VALUE SPACE. IF1134.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". IF1134.2 +009300 02 FILLER PIC X(94) VALUE SPACE. IF1134.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1134.2 +009500 01 REC-CT PIC 99 VALUE ZERO. IF1134.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1134.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1134.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1134.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1134.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1134.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1134.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1134.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1134.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1134.2 +010500 01 CCVS-H-1. IF1134.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IF1134.2 +010700 02 FILLER PIC X(42) VALUE IF1134.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1134.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IF1134.2 +011000 01 CCVS-H-2A. IF1134.2 +011100 02 FILLER PIC X(40) VALUE SPACE. IF1134.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1134.2 +011300 02 FILLER PIC XXXX VALUE IF1134.2 +011400 "4.2 ". IF1134.2 +011500 02 FILLER PIC X(28) VALUE IF1134.2 +011600 " COPY - NOT FOR DISTRIBUTION". IF1134.2 +011700 02 FILLER PIC X(41) VALUE SPACE. IF1134.2 +011800 IF1134.2 +011900 01 CCVS-H-2B. IF1134.2 +012000 02 FILLER PIC X(15) VALUE IF1134.2 +012100 "TEST RESULT OF ". IF1134.2 +012200 02 TEST-ID PIC X(9). IF1134.2 +012300 02 FILLER PIC X(4) VALUE IF1134.2 +012400 " IN ". IF1134.2 +012500 02 FILLER PIC X(12) VALUE IF1134.2 +012600 " HIGH ". IF1134.2 +012700 02 FILLER PIC X(22) VALUE IF1134.2 +012800 " LEVEL VALIDATION FOR ". IF1134.2 +012900 02 FILLER PIC X(58) VALUE IF1134.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1134.2 +013100 01 CCVS-H-3. IF1134.2 +013200 02 FILLER PIC X(34) VALUE IF1134.2 +013300 " FOR OFFICIAL USE ONLY ". IF1134.2 +013400 02 FILLER PIC X(58) VALUE IF1134.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1134.2 +013600 02 FILLER PIC X(28) VALUE IF1134.2 +013700 " COPYRIGHT 1985 ". IF1134.2 +013800 01 CCVS-E-1. IF1134.2 +013900 02 FILLER PIC X(52) VALUE SPACE. IF1134.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1134.2 +014100 02 ID-AGAIN PIC X(9). IF1134.2 +014200 02 FILLER PIC X(45) VALUE SPACES. IF1134.2 +014300 01 CCVS-E-2. IF1134.2 +014400 02 FILLER PIC X(31) VALUE SPACE. IF1134.2 +014500 02 FILLER PIC X(21) VALUE SPACE. IF1134.2 +014600 02 CCVS-E-2-2. IF1134.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1134.2 +014800 03 FILLER PIC X VALUE SPACE. IF1134.2 +014900 03 ENDER-DESC PIC X(44) VALUE IF1134.2 +015000 "ERRORS ENCOUNTERED". IF1134.2 +015100 01 CCVS-E-3. IF1134.2 +015200 02 FILLER PIC X(22) VALUE IF1134.2 +015300 " FOR OFFICIAL USE ONLY". IF1134.2 +015400 02 FILLER PIC X(12) VALUE SPACE. IF1134.2 +015500 02 FILLER PIC X(58) VALUE IF1134.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1134.2 +015700 02 FILLER PIC X(13) VALUE SPACE. IF1134.2 +015800 02 FILLER PIC X(15) VALUE IF1134.2 +015900 " COPYRIGHT 1985". IF1134.2 +016000 01 CCVS-E-4. IF1134.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1134.2 +016200 02 FILLER PIC X(4) VALUE " OF ". IF1134.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1134.2 +016400 02 FILLER PIC X(40) VALUE IF1134.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1134.2 +016600 01 XXINFO. IF1134.2 +016700 02 FILLER PIC X(19) VALUE IF1134.2 +016800 "*** INFORMATION ***". IF1134.2 +016900 02 INFO-TEXT. IF1134.2 +017000 04 FILLER PIC X(8) VALUE SPACE. IF1134.2 +017100 04 XXCOMPUTED PIC X(20). IF1134.2 +017200 04 FILLER PIC X(5) VALUE SPACE. IF1134.2 +017300 04 XXCORRECT PIC X(20). IF1134.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). IF1134.2 +017500 01 HYPHEN-LINE. IF1134.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. IF1134.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************IF1134.2 +017800- "*****************************************". IF1134.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************IF1134.2 +018000- "******************************". IF1134.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE IF1134.2 +018200 "IF113A". IF1134.2 +018300 PROCEDURE DIVISION. IF1134.2 +018400 CCVS1 SECTION. IF1134.2 +018500 OPEN-FILES. IF1134.2 +018600 OPEN OUTPUT PRINT-FILE. IF1134.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1134.2 +018800 MOVE SPACE TO TEST-RESULTS. IF1134.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1134.2 +019000 GO TO CCVS1-EXIT. IF1134.2 +019100 CLOSE-FILES. IF1134.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1134.2 +019300 TERMINATE-CCVS. IF1134.2 +019400 STOP RUN. IF1134.2 +019500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1134.2 +019600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1134.2 +019700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1134.2 +019800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1134.2 +019900 MOVE "****TEST DELETED****" TO RE-MARK. IF1134.2 +020000 PRINT-DETAIL. IF1134.2 +020100 IF REC-CT NOT EQUAL TO ZERO IF1134.2 +020200 MOVE "." TO PARDOT-X IF1134.2 +020300 MOVE REC-CT TO DOTVALUE. IF1134.2 +020400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1134.2 +020500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1134.2 +020600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1134.2 +020700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1134.2 +020800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1134.2 +020900 MOVE SPACE TO CORRECT-X. IF1134.2 +021000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1134.2 +021100 MOVE SPACE TO RE-MARK. IF1134.2 +021200 HEAD-ROUTINE. IF1134.2 +021300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +021400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +021500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1134.2 +021600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1134.2 +021700 COLUMN-NAMES-ROUTINE. IF1134.2 +021800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +021900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +022000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +022100 END-ROUTINE. IF1134.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1134.2 +022300 END-RTN-EXIT. IF1134.2 +022400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +022500 END-ROUTINE-1. IF1134.2 +022600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1134.2 +022700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1134.2 +022800 ADD PASS-COUNTER TO ERROR-HOLD. IF1134.2 +022900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1134.2 +023000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1134.2 +023100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1134.2 +023200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1134.2 +023300 END-ROUTINE-12. IF1134.2 +023400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1134.2 +023500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1134.2 +023600 MOVE "NO " TO ERROR-TOTAL IF1134.2 +023700 ELSE IF1134.2 +023800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1134.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1134.2 +024000 PERFORM WRITE-LINE. IF1134.2 +024100 END-ROUTINE-13. IF1134.2 +024200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1134.2 +024300 MOVE "NO " TO ERROR-TOTAL ELSE IF1134.2 +024400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1134.2 +024500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1134.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +024700 IF INSPECT-COUNTER EQUAL TO ZERO IF1134.2 +024800 MOVE "NO " TO ERROR-TOTAL IF1134.2 +024900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1134.2 +025000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1134.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +025200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1134.2 +025300 WRITE-LINE. IF1134.2 +025400 ADD 1 TO RECORD-COUNT. IF1134.2 +025500 IF RECORD-COUNT GREATER 42 IF1134.2 +025600 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1134.2 +025700 MOVE SPACE TO DUMMY-RECORD IF1134.2 +025800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1134.2 +025900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1134.2 +026000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1134.2 +026100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1134.2 +026200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1134.2 +026300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1134.2 +026400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1134.2 +026500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1134.2 +026600 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1134.2 +026700 MOVE ZERO TO RECORD-COUNT. IF1134.2 +026800 PERFORM WRT-LN. IF1134.2 +026900 WRT-LN. IF1134.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1134.2 +027100 MOVE SPACE TO DUMMY-RECORD. IF1134.2 +027200 BLANK-LINE-PRINT. IF1134.2 +027300 PERFORM WRT-LN. IF1134.2 +027400 FAIL-ROUTINE. IF1134.2 +027500 IF COMPUTED-X NOT EQUAL TO SPACE IF1134.2 +027600 GO TO FAIL-ROUTINE-WRITE. IF1134.2 +027700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1134.2 +027800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1134.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1134.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +028100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1134.2 +028200 GO TO FAIL-ROUTINE-EX. IF1134.2 +028300 FAIL-ROUTINE-WRITE. IF1134.2 +028400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1134.2 +028500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1134.2 +028600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1134.2 +028700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1134.2 +028800 FAIL-ROUTINE-EX. EXIT. IF1134.2 +028900 BAIL-OUT. IF1134.2 +029000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1134.2 +029100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1134.2 +029200 BAIL-OUT-WRITE. IF1134.2 +029300 MOVE CORRECT-A TO XXCORRECT. IF1134.2 +029400 MOVE COMPUTED-A TO XXCOMPUTED. IF1134.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1134.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1134.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1134.2 +029800 BAIL-OUT-EX. EXIT. IF1134.2 +029900 CCVS1-EXIT. IF1134.2 +030000 EXIT. IF1134.2 +030100******************************************************** IF1134.2 +030200* * IF1134.2 +030300* Intrinsic Function Test IF113A - INTEGER-OF-DAY * IF1134.2 +030400* * IF1134.2 +030500******************************************************** IF1134.2 +030600 SECT-IF113A SECTION. IF1134.2 +030700 F-INTOFDAY-INFO. IF1134.2 +030800 MOVE "See ref. A-46 2.17" TO ANSI-REFERENCE. IF1134.2 +030900 MOVE "INTEGER-OF-DAY" TO FEATURE. IF1134.2 +031000*****************TEST (a) ****************************** IF1134.2 +031100 F-INTOFDAY-01. IF1134.2 +031200 MOVE ZERO TO WS-INT. IF1134.2 +031300 F-INTOFDAY-TEST-01. IF1134.2 +031400 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(1601001). IF1134.2 +031500 IF WS-INT = 1 THEN IF1134.2 +031600 PERFORM PASS IF1134.2 +031700 ELSE IF1134.2 +031800 MOVE 1 TO CORRECT-N IF1134.2 +031900 MOVE WS-INT TO COMPUTED-N IF1134.2 +032000 PERFORM FAIL. IF1134.2 +032100 GO TO F-INTOFDAY-WRITE-01. IF1134.2 +032200 F-INTOFDAY-DELETE-01. IF1134.2 +032300 PERFORM DE-LETE. IF1134.2 +032400 GO TO F-INTOFDAY-WRITE-01. IF1134.2 +032500 F-INTOFDAY-WRITE-01. IF1134.2 +032600 MOVE "F-INTOFDAY-01" TO PAR-NAME. IF1134.2 +032700 PERFORM PRINT-DETAIL. IF1134.2 +032800*****************TEST (b) ****************************** IF1134.2 +032900 F-INTOFDAY-TEST-02. IF1134.2 +033000 EVALUATE FUNCTION INTEGER-OF-DAY(A) IF1134.2 +033100 WHEN 400 IF1134.2 +033200 PERFORM PASS IF1134.2 +033300 GO TO F-INTOFDAY-WRITE-02. IF1134.2 +033400 PERFORM FAIL. IF1134.2 +033500 GO TO F-INTOFDAY-WRITE-02. IF1134.2 +033600 F-INTOFDAY-DELETE-02. IF1134.2 +033700 PERFORM DE-LETE. IF1134.2 +033800 GO TO F-INTOFDAY-WRITE-02. IF1134.2 +033900 F-INTOFDAY-WRITE-02. IF1134.2 +034000 MOVE "F-INTOFDAY-02" TO PAR-NAME. IF1134.2 +034100 PERFORM PRINT-DETAIL. IF1134.2 +034200*****************TEST (c) ****************************** IF1134.2 +034300 F-INTOFDAY-TEST-03. IF1134.2 +034400 IF FUNCTION INTEGER-OF-DAY(IND(1)) = 1 THEN IF1134.2 +034500 PERFORM PASS IF1134.2 +034600 ELSE IF1134.2 +034700 PERFORM FAIL. IF1134.2 +034800 GO TO F-INTOFDAY-WRITE-03. IF1134.2 +034900 F-INTOFDAY-DELETE-03. IF1134.2 +035000 PERFORM DE-LETE. IF1134.2 +035100 GO TO F-INTOFDAY-WRITE-03. IF1134.2 +035200 F-INTOFDAY-WRITE-03. IF1134.2 +035300 MOVE "F-INTOFDAY-03" TO PAR-NAME. IF1134.2 +035400 PERFORM PRINT-DETAIL. IF1134.2 +035500*****************TEST (d) ****************************** IF1134.2 +035600 F-INTOFDAY-04. IF1134.2 +035700 MOVE ZERO TO WS-INT. IF1134.2 +035800 F-INTOFDAY-TEST-04. IF1134.2 +035900 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(IND(D)). IF1134.2 +036000 IF WS-INT = 400 THEN IF1134.2 +036100 PERFORM PASS IF1134.2 +036200 ELSE IF1134.2 +036300 MOVE 400 TO CORRECT-N IF1134.2 +036400 MOVE WS-INT TO COMPUTED-N IF1134.2 +036500 PERFORM FAIL. IF1134.2 +036600 GO TO F-INTOFDAY-WRITE-04. IF1134.2 +036700 F-INTOFDAY-DELETE-04. IF1134.2 +036800 PERFORM DE-LETE. IF1134.2 +036900 GO TO F-INTOFDAY-WRITE-04. IF1134.2 +037000 F-INTOFDAY-WRITE-04. IF1134.2 +037100 MOVE "F-INTOFDAY-04" TO PAR-NAME. IF1134.2 +037200 PERFORM PRINT-DETAIL. IF1134.2 +037300*****************TEST (e) ****************************** IF1134.2 +037400 F-INTOFDAY-05. IF1134.2 +037500 MOVE ZERO TO WS-INT. IF1134.2 +037600 F-INTOFDAY-TEST-05. IF1134.2 +037700 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(1601365). IF1134.2 +037800 IF WS-INT = 365 THEN IF1134.2 +037900 PERFORM PASS IF1134.2 +038000 ELSE IF1134.2 +038100 MOVE 365 TO CORRECT-N IF1134.2 +038200 MOVE WS-INT TO COMPUTED-N IF1134.2 +038300 PERFORM FAIL. IF1134.2 +038400 GO TO F-INTOFDAY-WRITE-05. IF1134.2 +038500 F-INTOFDAY-DELETE-05. IF1134.2 +038600 PERFORM DE-LETE. IF1134.2 +038700 GO TO F-INTOFDAY-WRITE-05. IF1134.2 +038800 F-INTOFDAY-WRITE-05. IF1134.2 +038900 MOVE "F-INTOFDAY-05" TO PAR-NAME. IF1134.2 +039000 PERFORM PRINT-DETAIL. IF1134.2 +039100*****************TEST (f) ****************************** IF1134.2 +039200 F-INTOFDAY-06. IF1134.2 +039300 MOVE ZERO TO WS-INT. IF1134.2 +039400 F-INTOFDAY-TEST-06. IF1134.2 +039500 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(A) + 10. IF1134.2 +039600 IF WS-INT = 410 THEN IF1134.2 +039700 PERFORM PASS IF1134.2 +039800 ELSE IF1134.2 +039900 MOVE 410 TO CORRECT-N IF1134.2 +040000 MOVE WS-INT TO COMPUTED-N IF1134.2 +040100 PERFORM FAIL. IF1134.2 +040200 GO TO F-INTOFDAY-WRITE-06. IF1134.2 +040300 F-INTOFDAY-DELETE-06. IF1134.2 +040400 PERFORM DE-LETE. IF1134.2 +040500 GO TO F-INTOFDAY-WRITE-06. IF1134.2 +040600 F-INTOFDAY-WRITE-06. IF1134.2 +040700 MOVE "F-INTOFDAY-06" TO PAR-NAME. IF1134.2 +040800 PERFORM PRINT-DETAIL. IF1134.2 +040900*****************TEST (g) ****************************** IF1134.2 +041000 F-INTOFDAY-07. IF1134.2 +041100 MOVE ZERO TO WS-INT. IF1134.2 +041200 F-INTOFDAY-TEST-07. IF1134.2 +041300 COMPUTE WS-INT = FUNCTION INTEGER-OF-DAY(A) + IF1134.2 +041400 FUNCTION INTEGER-OF-DAY(A). IF1134.2 +041500 IF WS-INT = 800 THEN IF1134.2 +041600 PERFORM PASS IF1134.2 +041700 ELSE IF1134.2 +041800 MOVE 800 TO CORRECT-N IF1134.2 +041900 MOVE WS-INT TO COMPUTED-N IF1134.2 +042000 PERFORM FAIL. IF1134.2 +042100 GO TO F-INTOFDAY-WRITE-07. IF1134.2 +042200 F-INTOFDAY-DELETE-07. IF1134.2 +042300 PERFORM DE-LETE. IF1134.2 +042400 GO TO F-INTOFDAY-WRITE-07. IF1134.2 +042500 F-INTOFDAY-WRITE-07. IF1134.2 +042600 MOVE "F-INTOFDAY-07" TO PAR-NAME. IF1134.2 +042700 PERFORM PRINT-DETAIL. IF1134.2 +042800***************** SPECIAL TEST 1 *********************** IF1134.2 +042900 F-INTOFDAY-08. IF1134.2 +043000 MOVE 1601001 TO ARG1. IF1134.2 +043100 PERFORM F-INTOFDAY-TEST-08 IF1134.2 +043200 UNTIL FUNCTION INTEGER-OF-DAY(ARG1) > 10. IF1134.2 +043300 IF ARG1 = 1601011 THEN IF1134.2 +043400 PERFORM PASS IF1134.2 +043500 ELSE IF1134.2 +043600 PERFORM FAIL. IF1134.2 +043700 GO TO F-INTOFDAY-WRITE-08. IF1134.2 +043800* IF1134.2 +043900 F-INTOFDAY-TEST-08. IF1134.2 +044000 COMPUTE ARG1 = ARG1 + 1. IF1134.2 +044100* IF1134.2 +044200 F-INTOFDAY-DELETE-08. IF1134.2 +044300 PERFORM DE-LETE. IF1134.2 +044400 GO TO F-INTOFDAY-WRITE-08. IF1134.2 +044500 F-INTOFDAY-WRITE-08. IF1134.2 +044600 MOVE "F-INTOFDAY-08" TO PAR-NAME. IF1134.2 +044700 PERFORM PRINT-DETAIL. IF1134.2 +044800*******************END OF TESTS************************** IF1134.2 +044900 CCVS-EXIT SECTION. IF1134.2 +045000 CCVS-999999. IF1134.2 +045100 GO TO CLOSE-FILES. IF1134.2 diff --git a/tests/cobol85/IF/IF114A.CBL b/tests/cobol85/IF/IF114A.CBL new file mode 100755 index 00000000..2789c987 --- /dev/null +++ b/tests/cobol85/IF/IF114A.CBL @@ -0,0 +1,732 @@ +000100 IDENTIFICATION DIVISION. IF1144.2 +000200 PROGRAM-ID. IF1144.2 +000300 IF114A. IF1144.2 +000400 IF1144.2 +000500*********************************************************** IF1144.2 +000600* * IF1144.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1144.2 +000800* It contains tests for the Intrinsic Function * IF1144.2 +000900* INTEGER-PART. * IF1144.2 +001000* * IF1144.2 +001100*********************************************************** IF1144.2 +001200 ENVIRONMENT DIVISION. IF1144.2 +001300 CONFIGURATION SECTION. IF1144.2 +001400 SOURCE-COMPUTER. IF1144.2 +001500 Linux. IF1144.2 +001600 OBJECT-COMPUTER. IF1144.2 +001700 Linux. IF1144.2 +001800 INPUT-OUTPUT SECTION. IF1144.2 +001900 FILE-CONTROL. IF1144.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1144.2 +002100 "report.log". IF1144.2 +002200 DATA DIVISION. IF1144.2 +002300 FILE SECTION. IF1144.2 +002400 FD PRINT-FILE. IF1144.2 +002500 01 PRINT-REC PICTURE X(120). IF1144.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1144.2 +002700 WORKING-STORAGE SECTION. IF1144.2 +002800*********************************************************** IF1144.2 +002900* Variables specific to the Intrinsic Function Test IF114A* IF1144.2 +003000*********************************************************** IF1144.2 +003100 01 A PIC S9(10) VALUE 500000. IF1144.2 +003200 01 B PIC S9(10) VALUE 1. IF1144.2 +003300 01 E PIC S9(6)V9(5) VALUE 399999.122. IF1144.2 +003400 01 F PIC S9(5)V9(5) VALUE 0.00032. IF1144.2 +003500 01 G PIC S9(5)V9(5) VALUE 4.08. IF1144.2 +003600 01 H PIC S9(5)V9(5) VALUE -5. IF1144.2 +003700 01 I PIC S9(5)V9(5) VALUE 3.4. IF1144.2 +003800 01 ARG1 PIC S9(5)V9(5) VALUE 4.4. IF1144.2 +003900 01 ARR VALUE "40537". IF1144.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1144.2 +004100 01 TEMP PIC S9(5)V9(5). IF1144.2 +004200 01 WS-INT PIC S9(10). IF1144.2 +004300* IF1144.2 +004400********************************************************** IF1144.2 +004500* IF1144.2 +004600 01 TEST-RESULTS. IF1144.2 +004700 02 FILLER PIC X VALUE SPACE. IF1144.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. IF1144.2 +004900 02 FILLER PIC X VALUE SPACE. IF1144.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. IF1144.2 +005100 02 FILLER PIC X VALUE SPACE. IF1144.2 +005200 02 PAR-NAME. IF1144.2 +005300 03 FILLER PIC X(19) VALUE SPACE. IF1144.2 +005400 03 PARDOT-X PIC X VALUE SPACE. IF1144.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. IF1144.2 +005600 02 FILLER PIC X(8) VALUE SPACE. IF1144.2 +005700 02 RE-MARK PIC X(61). IF1144.2 +005800 01 TEST-COMPUTED. IF1144.2 +005900 02 FILLER PIC X(30) VALUE SPACE. IF1144.2 +006000 02 FILLER PIC X(17) VALUE IF1144.2 +006100 " COMPUTED=". IF1144.2 +006200 02 COMPUTED-X. IF1144.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1144.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A IF1144.2 +006500 PIC -9(9).9(9). IF1144.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1144.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1144.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1144.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. IF1144.2 +007000 04 COMPUTED-18V0 PIC -9(18). IF1144.2 +007100 04 FILLER PIC X. IF1144.2 +007200 03 FILLER PIC X(50) VALUE SPACE. IF1144.2 +007300 01 TEST-CORRECT. IF1144.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IF1144.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". IF1144.2 +007600 02 CORRECT-X. IF1144.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. IF1144.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1144.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1144.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1144.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1144.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. IF1144.2 +008300 04 CORRECT-18V0 PIC -9(18). IF1144.2 +008400 04 FILLER PIC X. IF1144.2 +008500 03 FILLER PIC X(2) VALUE SPACE. IF1144.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1144.2 +008700 01 CCVS-C-1. IF1144.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1144.2 +008900- "SS PARAGRAPH-NAME IF1144.2 +009000- " REMARKS". IF1144.2 +009100 02 FILLER PIC X(20) VALUE SPACE. IF1144.2 +009200 01 CCVS-C-2. IF1144.2 +009300 02 FILLER PIC X VALUE SPACE. IF1144.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". IF1144.2 +009500 02 FILLER PIC X(15) VALUE SPACE. IF1144.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". IF1144.2 +009700 02 FILLER PIC X(94) VALUE SPACE. IF1144.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1144.2 +009900 01 REC-CT PIC 99 VALUE ZERO. IF1144.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1144.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1144.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1144.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1144.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1144.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1144.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1144.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1144.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1144.2 +010900 01 CCVS-H-1. IF1144.2 +011000 02 FILLER PIC X(39) VALUE SPACES. IF1144.2 +011100 02 FILLER PIC X(42) VALUE IF1144.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1144.2 +011300 02 FILLER PIC X(39) VALUE SPACES. IF1144.2 +011400 01 CCVS-H-2A. IF1144.2 +011500 02 FILLER PIC X(40) VALUE SPACE. IF1144.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1144.2 +011700 02 FILLER PIC XXXX VALUE IF1144.2 +011800 "4.2 ". IF1144.2 +011900 02 FILLER PIC X(28) VALUE IF1144.2 +012000 " COPY - NOT FOR DISTRIBUTION". IF1144.2 +012100 02 FILLER PIC X(41) VALUE SPACE. IF1144.2 +012200 IF1144.2 +012300 01 CCVS-H-2B. IF1144.2 +012400 02 FILLER PIC X(15) VALUE IF1144.2 +012500 "TEST RESULT OF ". IF1144.2 +012600 02 TEST-ID PIC X(9). IF1144.2 +012700 02 FILLER PIC X(4) VALUE IF1144.2 +012800 " IN ". IF1144.2 +012900 02 FILLER PIC X(12) VALUE IF1144.2 +013000 " HIGH ". IF1144.2 +013100 02 FILLER PIC X(22) VALUE IF1144.2 +013200 " LEVEL VALIDATION FOR ". IF1144.2 +013300 02 FILLER PIC X(58) VALUE IF1144.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1144.2 +013500 01 CCVS-H-3. IF1144.2 +013600 02 FILLER PIC X(34) VALUE IF1144.2 +013700 " FOR OFFICIAL USE ONLY ". IF1144.2 +013800 02 FILLER PIC X(58) VALUE IF1144.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1144.2 +014000 02 FILLER PIC X(28) VALUE IF1144.2 +014100 " COPYRIGHT 1985 ". IF1144.2 +014200 01 CCVS-E-1. IF1144.2 +014300 02 FILLER PIC X(52) VALUE SPACE. IF1144.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1144.2 +014500 02 ID-AGAIN PIC X(9). IF1144.2 +014600 02 FILLER PIC X(45) VALUE SPACES. IF1144.2 +014700 01 CCVS-E-2. IF1144.2 +014800 02 FILLER PIC X(31) VALUE SPACE. IF1144.2 +014900 02 FILLER PIC X(21) VALUE SPACE. IF1144.2 +015000 02 CCVS-E-2-2. IF1144.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1144.2 +015200 03 FILLER PIC X VALUE SPACE. IF1144.2 +015300 03 ENDER-DESC PIC X(44) VALUE IF1144.2 +015400 "ERRORS ENCOUNTERED". IF1144.2 +015500 01 CCVS-E-3. IF1144.2 +015600 02 FILLER PIC X(22) VALUE IF1144.2 +015700 " FOR OFFICIAL USE ONLY". IF1144.2 +015800 02 FILLER PIC X(12) VALUE SPACE. IF1144.2 +015900 02 FILLER PIC X(58) VALUE IF1144.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1144.2 +016100 02 FILLER PIC X(13) VALUE SPACE. IF1144.2 +016200 02 FILLER PIC X(15) VALUE IF1144.2 +016300 " COPYRIGHT 1985". IF1144.2 +016400 01 CCVS-E-4. IF1144.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1144.2 +016600 02 FILLER PIC X(4) VALUE " OF ". IF1144.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1144.2 +016800 02 FILLER PIC X(40) VALUE IF1144.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1144.2 +017000 01 XXINFO. IF1144.2 +017100 02 FILLER PIC X(19) VALUE IF1144.2 +017200 "*** INFORMATION ***". IF1144.2 +017300 02 INFO-TEXT. IF1144.2 +017400 04 FILLER PIC X(8) VALUE SPACE. IF1144.2 +017500 04 XXCOMPUTED PIC X(20). IF1144.2 +017600 04 FILLER PIC X(5) VALUE SPACE. IF1144.2 +017700 04 XXCORRECT PIC X(20). IF1144.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). IF1144.2 +017900 01 HYPHEN-LINE. IF1144.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. IF1144.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************IF1144.2 +018200- "*****************************************". IF1144.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************IF1144.2 +018400- "******************************". IF1144.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE IF1144.2 +018600 "IF114A". IF1144.2 +018700 PROCEDURE DIVISION. IF1144.2 +018800 CCVS1 SECTION. IF1144.2 +018900 OPEN-FILES. IF1144.2 +019000 OPEN OUTPUT PRINT-FILE. IF1144.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1144.2 +019200 MOVE SPACE TO TEST-RESULTS. IF1144.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1144.2 +019400 GO TO CCVS1-EXIT. IF1144.2 +019500 CLOSE-FILES. IF1144.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1144.2 +019700 TERMINATE-CCVS. IF1144.2 +019800 STOP RUN. IF1144.2 +019900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1144.2 +020000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1144.2 +020100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1144.2 +020200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1144.2 +020300 MOVE "****TEST DELETED****" TO RE-MARK. IF1144.2 +020400 PRINT-DETAIL. IF1144.2 +020500 IF REC-CT NOT EQUAL TO ZERO IF1144.2 +020600 MOVE "." TO PARDOT-X IF1144.2 +020700 MOVE REC-CT TO DOTVALUE. IF1144.2 +020800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1144.2 +020900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1144.2 +021000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1144.2 +021100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1144.2 +021200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1144.2 +021300 MOVE SPACE TO CORRECT-X. IF1144.2 +021400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1144.2 +021500 MOVE SPACE TO RE-MARK. IF1144.2 +021600 HEAD-ROUTINE. IF1144.2 +021700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +021800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +021900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1144.2 +022000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1144.2 +022100 COLUMN-NAMES-ROUTINE. IF1144.2 +022200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +022300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +022500 END-ROUTINE. IF1144.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1144.2 +022700 END-RTN-EXIT. IF1144.2 +022800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +022900 END-ROUTINE-1. IF1144.2 +023000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1144.2 +023100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1144.2 +023200 ADD PASS-COUNTER TO ERROR-HOLD. IF1144.2 +023300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1144.2 +023400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1144.2 +023500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1144.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1144.2 +023700 END-ROUTINE-12. IF1144.2 +023800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1144.2 +023900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1144.2 +024000 MOVE "NO " TO ERROR-TOTAL IF1144.2 +024100 ELSE IF1144.2 +024200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1144.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1144.2 +024400 PERFORM WRITE-LINE. IF1144.2 +024500 END-ROUTINE-13. IF1144.2 +024600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1144.2 +024700 MOVE "NO " TO ERROR-TOTAL ELSE IF1144.2 +024800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1144.2 +024900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1144.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +025100 IF INSPECT-COUNTER EQUAL TO ZERO IF1144.2 +025200 MOVE "NO " TO ERROR-TOTAL IF1144.2 +025300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1144.2 +025400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1144.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +025600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1144.2 +025700 WRITE-LINE. IF1144.2 +025800 ADD 1 TO RECORD-COUNT. IF1144.2 +025900 IF RECORD-COUNT GREATER 42 IF1144.2 +026000 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1144.2 +026100 MOVE SPACE TO DUMMY-RECORD IF1144.2 +026200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1144.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1144.2 +026400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1144.2 +026500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1144.2 +026600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1144.2 +026700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1144.2 +026800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1144.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1144.2 +027000 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1144.2 +027100 MOVE ZERO TO RECORD-COUNT. IF1144.2 +027200 PERFORM WRT-LN. IF1144.2 +027300 WRT-LN. IF1144.2 +027400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1144.2 +027500 MOVE SPACE TO DUMMY-RECORD. IF1144.2 +027600 BLANK-LINE-PRINT. IF1144.2 +027700 PERFORM WRT-LN. IF1144.2 +027800 FAIL-ROUTINE. IF1144.2 +027900 IF COMPUTED-X NOT EQUAL TO SPACE IF1144.2 +028000 GO TO FAIL-ROUTINE-WRITE. IF1144.2 +028100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1144.2 +028200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1144.2 +028300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1144.2 +028400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +028500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1144.2 +028600 GO TO FAIL-ROUTINE-EX. IF1144.2 +028700 FAIL-ROUTINE-WRITE. IF1144.2 +028800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1144.2 +028900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1144.2 +029000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1144.2 +029100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1144.2 +029200 FAIL-ROUTINE-EX. EXIT. IF1144.2 +029300 BAIL-OUT. IF1144.2 +029400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1144.2 +029500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1144.2 +029600 BAIL-OUT-WRITE. IF1144.2 +029700 MOVE CORRECT-A TO XXCORRECT. IF1144.2 +029800 MOVE COMPUTED-A TO XXCOMPUTED. IF1144.2 +029900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1144.2 +030000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1144.2 +030100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1144.2 +030200 BAIL-OUT-EX. EXIT. IF1144.2 +030300 CCVS1-EXIT. IF1144.2 +030400 EXIT. IF1144.2 +030500******************************************************** IF1144.2 +030600* * IF1144.2 +030700* Intrinsic Function Tests IF114A - INTEGER-PART * IF1144.2 +030800* * IF1144.2 +030900******************************************************** IF1144.2 +031000 SECT-IF114A SECTION. IF1144.2 +031100 F-INTPART-INFO. IF1144.2 +031200 MOVE "See ref. A-47 2.18" TO ANSI-REFERENCE. IF1144.2 +031300 MOVE "INTEGER-PART Function" TO FEATURE. IF1144.2 +031400*****************TEST (a) ****************************** IF1144.2 +031500 F-INTPART-01. IF1144.2 +031600 MOVE ZERO TO WS-INT. IF1144.2 +031700 F-INTPART-TEST-01. IF1144.2 +031800 COMPUTE WS-INT = FUNCTION INTEGER-PART(0). IF1144.2 +031900 IF WS-INT = 0 THEN IF1144.2 +032000 PERFORM PASS IF1144.2 +032100 ELSE IF1144.2 +032200 MOVE 0 TO CORRECT-N IF1144.2 +032300 MOVE WS-INT TO COMPUTED-N IF1144.2 +032400 PERFORM FAIL. IF1144.2 +032500 GO TO F-INTPART-WRITE-01. IF1144.2 +032600 F-INTPART-DELETE-01. IF1144.2 +032700 PERFORM DE-LETE. IF1144.2 +032800 GO TO F-INTPART-WRITE-01. IF1144.2 +032900 F-INTPART-WRITE-01. IF1144.2 +033000 MOVE "F-INTPART-01" TO PAR-NAME. IF1144.2 +033100 PERFORM PRINT-DETAIL. IF1144.2 +033200*****************TEST (b) ****************************** IF1144.2 +033300 F-INTPART-02. IF1144.2 +033400 MOVE ZERO TO WS-INT. IF1144.2 +033500 F-INTPART-TEST-02. IF1144.2 +033600 EVALUATE FUNCTION INTEGER-PART(3) IF1144.2 +033700 WHEN 3 IF1144.2 +033800 PERFORM PASS IF1144.2 +033900 GO TO F-INTPART-WRITE-02. IF1144.2 +034000 PERFORM FAIL. IF1144.2 +034100 GO TO F-INTPART-WRITE-02. IF1144.2 +034200 F-INTPART-DELETE-02. IF1144.2 +034300 PERFORM DE-LETE. IF1144.2 +034400 GO TO F-INTPART-WRITE-02. IF1144.2 +034500 F-INTPART-WRITE-02. IF1144.2 +034600 MOVE "F-INTPART-02" TO PAR-NAME. IF1144.2 +034700 PERFORM PRINT-DETAIL. IF1144.2 +034800*****************TEST (c) ****************************** IF1144.2 +034900 F-INTPART-03. IF1144.2 +035000 MOVE ZERO TO WS-INT. IF1144.2 +035100 F-INTPART-TEST-03. IF1144.2 +035200 IF FUNCTION INTEGER-PART(4.578) = 4 THEN IF1144.2 +035300 PERFORM PASS IF1144.2 +035400 ELSE IF1144.2 +035500 MOVE 4 TO CORRECT-N IF1144.2 +035600 PERFORM FAIL. IF1144.2 +035700 GO TO F-INTPART-WRITE-03. IF1144.2 +035800 F-INTPART-DELETE-03. IF1144.2 +035900 PERFORM DE-LETE. IF1144.2 +036000 GO TO F-INTPART-WRITE-03. IF1144.2 +036100 F-INTPART-WRITE-03. IF1144.2 +036200 MOVE "F-INTPART-03" TO PAR-NAME. IF1144.2 +036300 PERFORM PRINT-DETAIL. IF1144.2 +036400*****************TEST (d) ****************************** IF1144.2 +036500 F-INTPART-04. IF1144.2 +036600 MOVE ZERO TO WS-INT. IF1144.2 +036700 F-INTPART-TEST-04. IF1144.2 +036800 COMPUTE WS-INT = FUNCTION INTEGER-PART(-58). IF1144.2 +036900 IF WS-INT = -58 THEN IF1144.2 +037000 PERFORM PASS IF1144.2 +037100 ELSE IF1144.2 +037200 MOVE -58 TO CORRECT-N IF1144.2 +037300 MOVE WS-INT TO COMPUTED-N IF1144.2 +037400 PERFORM FAIL. IF1144.2 +037500 GO TO F-INTPART-WRITE-04. IF1144.2 +037600 F-INTPART-DELETE-04. IF1144.2 +037700 PERFORM DE-LETE. IF1144.2 +037800 GO TO F-INTPART-WRITE-04. IF1144.2 +037900 F-INTPART-WRITE-04. IF1144.2 +038000 MOVE "F-INTPART-04" TO PAR-NAME. IF1144.2 +038100 PERFORM PRINT-DETAIL. IF1144.2 +038200*****************TEST (e) ****************************** IF1144.2 +038300 F-INTPART-05. IF1144.2 +038400 MOVE ZERO TO WS-INT. IF1144.2 +038500 F-INTPART-TEST-05. IF1144.2 +038600 COMPUTE WS-INT = FUNCTION INTEGER-PART(-9.763). IF1144.2 +038700 IF WS-INT = -9 THEN IF1144.2 +038800 PERFORM PASS IF1144.2 +038900 ELSE IF1144.2 +039000 MOVE -9 TO CORRECT-N IF1144.2 +039100 MOVE WS-INT TO COMPUTED-N IF1144.2 +039200 PERFORM FAIL. IF1144.2 +039300 GO TO F-INTPART-WRITE-05. IF1144.2 +039400 F-INTPART-DELETE-05. IF1144.2 +039500 PERFORM DE-LETE. IF1144.2 +039600 GO TO F-INTPART-WRITE-05. IF1144.2 +039700 F-INTPART-WRITE-05. IF1144.2 +039800 MOVE "F-INTPART-05" TO PAR-NAME. IF1144.2 +039900 PERFORM PRINT-DETAIL. IF1144.2 +040000*****************TEST (f) ****************************** IF1144.2 +040100 F-INTPART-06. IF1144.2 +040200 MOVE ZERO TO WS-INT. IF1144.2 +040300 F-INTPART-TEST-06. IF1144.2 +040400 COMPUTE WS-INT = FUNCTION INTEGER-PART(320485). IF1144.2 +040500 IF WS-INT = 320485 THEN IF1144.2 +040600 PERFORM PASS IF1144.2 +040700 ELSE IF1144.2 +040800 MOVE 320485 TO CORRECT-N IF1144.2 +040900 MOVE WS-INT TO COMPUTED-N IF1144.2 +041000 PERFORM FAIL. IF1144.2 +041100 GO TO F-INTPART-WRITE-06. IF1144.2 +041200 F-INTPART-DELETE-06. IF1144.2 +041300 PERFORM DE-LETE. IF1144.2 +041400 GO TO F-INTPART-WRITE-06. IF1144.2 +041500 F-INTPART-WRITE-06. IF1144.2 +041600 MOVE "F-INTPART-06" TO PAR-NAME. IF1144.2 +041700 PERFORM PRINT-DETAIL. IF1144.2 +041800*****************TEST (g) ****************************** IF1144.2 +041900 F-INTPART-07. IF1144.2 +042000 MOVE ZERO TO WS-INT. IF1144.2 +042100 F-INTPART-TEST-07. IF1144.2 +042200 COMPUTE WS-INT = FUNCTION INTEGER-PART(230492.4828). IF1144.2 +042300 IF WS-INT = 230492 THEN IF1144.2 +042400 PERFORM PASS IF1144.2 +042500 ELSE IF1144.2 +042600 MOVE 230492 TO CORRECT-N IF1144.2 +042700 MOVE WS-INT TO COMPUTED-N IF1144.2 +042800 PERFORM FAIL. IF1144.2 +042900 GO TO F-INTPART-WRITE-07. IF1144.2 +043000 F-INTPART-DELETE-07. IF1144.2 +043100 PERFORM DE-LETE. IF1144.2 +043200 GO TO F-INTPART-WRITE-07. IF1144.2 +043300 F-INTPART-WRITE-07. IF1144.2 +043400 MOVE "F-INTPART-07" TO PAR-NAME. IF1144.2 +043500 PERFORM PRINT-DETAIL. IF1144.2 +043600*****************TEST (h) ****************************** IF1144.2 +043700 F-INTPART-08. IF1144.2 +043800 MOVE ZERO TO WS-INT. IF1144.2 +043900 F-INTPART-TEST-08. IF1144.2 +044000 COMPUTE WS-INT = FUNCTION INTEGER-PART(0.00032). IF1144.2 +044100 IF WS-INT = 0 THEN IF1144.2 +044200 PERFORM PASS IF1144.2 +044300 ELSE IF1144.2 +044400 MOVE 0 TO CORRECT-N IF1144.2 +044500 MOVE WS-INT TO COMPUTED-N IF1144.2 +044600 PERFORM FAIL. IF1144.2 +044700 GO TO F-INTPART-WRITE-08. IF1144.2 +044800 F-INTPART-DELETE-08. IF1144.2 +044900 PERFORM DE-LETE. IF1144.2 +045000 GO TO F-INTPART-WRITE-08. IF1144.2 +045100 F-INTPART-WRITE-08. IF1144.2 +045200 MOVE "F-INTPART-08" TO PAR-NAME. IF1144.2 +045300 PERFORM PRINT-DETAIL. IF1144.2 +045400*****************TEST (i) ****************************** IF1144.2 +045500 F-INTPART-09. IF1144.2 +045600 MOVE ZERO TO WS-INT. IF1144.2 +045700 F-INTPART-TEST-09. IF1144.2 +045800 COMPUTE WS-INT = FUNCTION INTEGER-PART(A). IF1144.2 +045900 IF WS-INT = 500000 THEN IF1144.2 +046000 PERFORM PASS IF1144.2 +046100 ELSE IF1144.2 +046200 MOVE 500000 TO CORRECT-N IF1144.2 +046300 MOVE WS-INT TO COMPUTED-N IF1144.2 +046400 PERFORM FAIL. IF1144.2 +046500 GO TO F-INTPART-WRITE-09. IF1144.2 +046600 F-INTPART-DELETE-09. IF1144.2 +046700 PERFORM DE-LETE. IF1144.2 +046800 GO TO F-INTPART-WRITE-09. IF1144.2 +046900 F-INTPART-WRITE-09. IF1144.2 +047000 MOVE "F-INTPART-09" TO PAR-NAME. IF1144.2 +047100 PERFORM PRINT-DETAIL. IF1144.2 +047200*****************TEST (j) ****************************** IF1144.2 +047300 F-INTPART-10. IF1144.2 +047400 MOVE ZERO TO WS-INT. IF1144.2 +047500 F-INTPART-TEST-10. IF1144.2 +047600 COMPUTE WS-INT = FUNCTION INTEGER-PART(E). IF1144.2 +047700 IF WS-INT = 399999 THEN IF1144.2 +047800 PERFORM PASS IF1144.2 +047900 ELSE IF1144.2 +048000 MOVE 399999 TO CORRECT-N IF1144.2 +048100 MOVE WS-INT TO COMPUTED-N IF1144.2 +048200 PERFORM FAIL. IF1144.2 +048300 GO TO F-INTPART-WRITE-10. IF1144.2 +048400 F-INTPART-DELETE-10. IF1144.2 +048500 PERFORM DE-LETE. IF1144.2 +048600 GO TO F-INTPART-WRITE-10. IF1144.2 +048700 F-INTPART-WRITE-10. IF1144.2 +048800 MOVE "F-INTPART-10" TO PAR-NAME. IF1144.2 +048900 PERFORM PRINT-DETAIL. IF1144.2 +049000*****************TEST (k) ****************************** IF1144.2 +049100 F-INTPART-11. IF1144.2 +049200 MOVE ZERO TO WS-INT. IF1144.2 +049300 F-INTPART-TEST-11. IF1144.2 +049400 COMPUTE WS-INT = FUNCTION INTEGER-PART(B). IF1144.2 +049500 IF WS-INT = 1 THEN IF1144.2 +049600 PERFORM PASS IF1144.2 +049700 ELSE IF1144.2 +049800 MOVE 1 TO CORRECT-N IF1144.2 +049900 MOVE WS-INT TO COMPUTED-N IF1144.2 +050000 PERFORM FAIL. IF1144.2 +050100 GO TO F-INTPART-WRITE-11. IF1144.2 +050200 F-INTPART-DELETE-11. IF1144.2 +050300 PERFORM DE-LETE. IF1144.2 +050400 GO TO F-INTPART-WRITE-11. IF1144.2 +050500 F-INTPART-WRITE-11. IF1144.2 +050600 MOVE "F-INTPART-11" TO PAR-NAME. IF1144.2 +050700 PERFORM PRINT-DETAIL. IF1144.2 +050800*****************TEST (l) ****************************** IF1144.2 +050900 F-INTPART-12. IF1144.2 +051000 MOVE ZERO TO WS-INT. IF1144.2 +051100 F-INTPART-TEST-12. IF1144.2 +051200 COMPUTE WS-INT = FUNCTION INTEGER-PART(F). IF1144.2 +051300 IF WS-INT = 0 THEN IF1144.2 +051400 PERFORM PASS IF1144.2 +051500 ELSE IF1144.2 +051600 MOVE 0 TO CORRECT-N IF1144.2 +051700 MOVE WS-INT TO COMPUTED-N IF1144.2 +051800 PERFORM FAIL. IF1144.2 +051900 GO TO F-INTPART-WRITE-12. IF1144.2 +052000 F-INTPART-DELETE-12. IF1144.2 +052100 PERFORM DE-LETE. IF1144.2 +052200 GO TO F-INTPART-WRITE-12. IF1144.2 +052300 F-INTPART-WRITE-12. IF1144.2 +052400 MOVE "F-INTPART-12" TO PAR-NAME. IF1144.2 +052500 PERFORM PRINT-DETAIL. IF1144.2 +052600*****************TEST (m) ****************************** IF1144.2 +052700 F-INTPART-13. IF1144.2 +052800 MOVE ZERO TO WS-INT. IF1144.2 +052900 F-INTPART-TEST-13. IF1144.2 +053000 COMPUTE WS-INT = FUNCTION INTEGER-PART(IND(1)). IF1144.2 +053100 IF WS-INT = 4 THEN IF1144.2 +053200 PERFORM PASS IF1144.2 +053300 ELSE IF1144.2 +053400 MOVE 4 TO CORRECT-N IF1144.2 +053500 MOVE WS-INT TO COMPUTED-N IF1144.2 +053600 PERFORM FAIL. IF1144.2 +053700 GO TO F-INTPART-WRITE-13. IF1144.2 +053800 F-INTPART-DELETE-13. IF1144.2 +053900 PERFORM DE-LETE. IF1144.2 +054000 GO TO F-INTPART-WRITE-13. IF1144.2 +054100 F-INTPART-WRITE-13. IF1144.2 +054200 MOVE "F-INTPART-13" TO PAR-NAME. IF1144.2 +054300 PERFORM PRINT-DETAIL. IF1144.2 +054400*****************TEST (n) ****************************** IF1144.2 +054500 F-INTPART-14. IF1144.2 +054600 MOVE ZERO TO WS-INT. IF1144.2 +054700 F-INTPART-TEST-14. IF1144.2 +054800 COMPUTE WS-INT = FUNCTION INTEGER-PART(IND(B)). IF1144.2 +054900 IF WS-INT = 4 THEN IF1144.2 +055000 PERFORM PASS IF1144.2 +055100 ELSE IF1144.2 +055200 MOVE 4 TO CORRECT-N IF1144.2 +055300 MOVE WS-INT TO COMPUTED-N IF1144.2 +055400 PERFORM FAIL. IF1144.2 +055500 GO TO F-INTPART-WRITE-14. IF1144.2 +055600 F-INTPART-DELETE-14. IF1144.2 +055700 PERFORM DE-LETE. IF1144.2 +055800 GO TO F-INTPART-WRITE-14. IF1144.2 +055900 F-INTPART-WRITE-14. IF1144.2 +056000 MOVE "F-INTPART-14" TO PAR-NAME. IF1144.2 +056100 PERFORM PRINT-DETAIL. IF1144.2 +056200*****************TEST (o) ****************************** IF1144.2 +056300 F-INTPART-15. IF1144.2 +056400 MOVE ZERO TO WS-INT. IF1144.2 +056500 F-INTPART-TEST-15. IF1144.2 +056600 COMPUTE WS-INT = FUNCTION INTEGER-PART((6 / 3) + 9). IF1144.2 +056700 IF WS-INT = 11 THEN IF1144.2 +056800 PERFORM PASS IF1144.2 +056900 ELSE IF1144.2 +057000 MOVE 11 TO CORRECT-N IF1144.2 +057100 MOVE WS-INT TO COMPUTED-N IF1144.2 +057200 PERFORM FAIL. IF1144.2 +057300 GO TO F-INTPART-WRITE-15. IF1144.2 +057400 F-INTPART-DELETE-15. IF1144.2 +057500 PERFORM DE-LETE. IF1144.2 +057600 GO TO F-INTPART-WRITE-15. IF1144.2 +057700 F-INTPART-WRITE-15. IF1144.2 +057800 MOVE "F-INTPART-15" TO PAR-NAME. IF1144.2 +057900 PERFORM PRINT-DETAIL. IF1144.2 +058000*****************TEST (p) ****************************** IF1144.2 +058100 F-INTPART-16. IF1144.2 +058200 MOVE ZERO TO WS-INT. IF1144.2 +058300 F-INTPART-TEST-16. IF1144.2 +058400 COMPUTE WS-INT = FUNCTION INTEGER-PART(H + B). IF1144.2 +058500 IF WS-INT = -4 THEN IF1144.2 +058600 PERFORM PASS IF1144.2 +058700 ELSE IF1144.2 +058800 MOVE -4 TO CORRECT-N IF1144.2 +058900 MOVE WS-INT TO COMPUTED-N IF1144.2 +059000 PERFORM FAIL. IF1144.2 +059100 GO TO F-INTPART-WRITE-16. IF1144.2 +059200 F-INTPART-DELETE-16. IF1144.2 +059300 PERFORM DE-LETE. IF1144.2 +059400 GO TO F-INTPART-WRITE-16. IF1144.2 +059500 F-INTPART-WRITE-16. IF1144.2 +059600 MOVE "F-INTPART-16" TO PAR-NAME. IF1144.2 +059700 PERFORM PRINT-DETAIL. IF1144.2 +059800*****************TEST (q) ****************************** IF1144.2 +059900 F-INTPART-17. IF1144.2 +060000 MOVE ZERO TO WS-INT. IF1144.2 +060100 F-INTPART-TEST-17. IF1144.2 +060200 COMPUTE WS-INT = FUNCTION INTEGER-PART(6.3 - (4.2 / 2)). IF1144.2 +060300 IF WS-INT = 4 THEN IF1144.2 +060400 PERFORM PASS IF1144.2 +060500 ELSE IF1144.2 +060600 MOVE 4 TO CORRECT-N IF1144.2 +060700 MOVE WS-INT TO COMPUTED-N IF1144.2 +060800 PERFORM FAIL. IF1144.2 +060900 GO TO F-INTPART-WRITE-17. IF1144.2 +061000 F-INTPART-DELETE-17. IF1144.2 +061100 PERFORM DE-LETE. IF1144.2 +061200 GO TO F-INTPART-WRITE-17. IF1144.2 +061300 F-INTPART-WRITE-17. IF1144.2 +061400 MOVE "F-INTPART-17" TO PAR-NAME. IF1144.2 +061500 PERFORM PRINT-DETAIL. IF1144.2 +061600*****************TEST (r) ****************************** IF1144.2 +061700 F-INTPART-18. IF1144.2 +061800 MOVE ZERO TO WS-INT. IF1144.2 +061900 F-INTPART-TEST-18. IF1144.2 +062000 COMPUTE WS-INT = FUNCTION INTEGER-PART((H + G) * I). IF1144.2 +062100 IF WS-INT = -3 THEN IF1144.2 +062200 PERFORM PASS IF1144.2 +062300 ELSE IF1144.2 +062400 MOVE -3 TO CORRECT-N IF1144.2 +062500 MOVE WS-INT TO COMPUTED-N IF1144.2 +062600 PERFORM FAIL. IF1144.2 +062700 GO TO F-INTPART-WRITE-18. IF1144.2 +062800 F-INTPART-DELETE-18. IF1144.2 +062900 PERFORM DE-LETE. IF1144.2 +063000 GO TO F-INTPART-WRITE-18. IF1144.2 +063100 F-INTPART-WRITE-18. IF1144.2 +063200 MOVE "F-INTPART-18" TO PAR-NAME. IF1144.2 +063300 PERFORM PRINT-DETAIL. IF1144.2 +063400*****************TEST (s) ****************************** IF1144.2 +063500 F-INTPART-19. IF1144.2 +063600 MOVE ZERO TO WS-INT. IF1144.2 +063700 F-INTPART-TEST-19. IF1144.2 +063800 COMPUTE WS-INT = FUNCTION INTEGER-PART(H / 5). IF1144.2 +063900 IF WS-INT = -1 THEN IF1144.2 +064000 PERFORM PASS IF1144.2 +064100 ELSE IF1144.2 +064200 MOVE -1 TO CORRECT-N IF1144.2 +064300 MOVE WS-INT TO COMPUTED-N IF1144.2 +064400 PERFORM FAIL. IF1144.2 +064500 GO TO F-INTPART-WRITE-19. IF1144.2 +064600 F-INTPART-DELETE-19. IF1144.2 +064700 PERFORM DE-LETE. IF1144.2 +064800 GO TO F-INTPART-WRITE-19. IF1144.2 +064900 F-INTPART-WRITE-19. IF1144.2 +065000 MOVE "F-INTPART-19" TO PAR-NAME. IF1144.2 +065100 PERFORM PRINT-DETAIL. IF1144.2 +065200*****************TEST (t) ****************************** IF1144.2 +065300 F-INTPART-20. IF1144.2 +065400 MOVE ZERO TO TEMP. IF1144.2 +065500 F-INTPART-TEST-20. IF1144.2 +065600 COMPUTE TEMP = FUNCTION INTEGER-PART(3.2) + I. IF1144.2 +065700 IF (TEMP >= 6.39987) AND IF1144.2 +065800 (TEMP <= 6.40013) IF1144.2 +065900 PERFORM PASS IF1144.2 +066000 ELSE IF1144.2 +066100 MOVE 6.4 TO CORRECT-N IF1144.2 +066200 MOVE TEMP TO COMPUTED-N IF1144.2 +066300 PERFORM FAIL. IF1144.2 +066400 GO TO F-INTPART-WRITE-20. IF1144.2 +066500 F-INTPART-DELETE-20. IF1144.2 +066600 PERFORM DE-LETE. IF1144.2 +066700 GO TO F-INTPART-WRITE-20. IF1144.2 +066800 F-INTPART-WRITE-20. IF1144.2 +066900 MOVE "F-INTPART-20" TO PAR-NAME. IF1144.2 +067000 PERFORM PRINT-DETAIL. IF1144.2 +067100*****************TEST (u) ****************************** IF1144.2 +067200 F-INTPART-21. IF1144.2 +067300 MOVE ZERO TO WS-INT. IF1144.2 +067400 F-INTPART-TEST-21. IF1144.2 +067500 COMPUTE WS-INT = IF1144.2 +067600 FUNCTION INTEGER-PART(FUNCTION INTEGER-PART(3.2)). IF1144.2 +067700 IF WS-INT = 3 THEN IF1144.2 +067800 PERFORM PASS IF1144.2 +067900 ELSE IF1144.2 +068000 MOVE 3 TO CORRECT-N IF1144.2 +068100 MOVE WS-INT TO COMPUTED-N IF1144.2 +068200 PERFORM FAIL. IF1144.2 +068300 GO TO F-INTPART-WRITE-21. IF1144.2 +068400 F-INTPART-DELETE-21. IF1144.2 +068500 PERFORM DE-LETE. IF1144.2 +068600 GO TO F-INTPART-WRITE-21. IF1144.2 +068700 F-INTPART-WRITE-21. IF1144.2 +068800 MOVE "F-INTPART-21" TO PAR-NAME. IF1144.2 +068900 PERFORM PRINT-DETAIL. IF1144.2 +069000*****************TEST (v) ****************************** IF1144.2 +069100 F-INTPART-22. IF1144.2 +069200 MOVE ZERO TO WS-INT. IF1144.2 +069300 F-INTPART-TEST-22. IF1144.2 +069400 COMPUTE WS-INT = FUNCTION INTEGER-PART(3.2) + IF1144.2 +069500 FUNCTION INTEGER-PART(1.3). IF1144.2 +069600 IF WS-INT = 4 THEN IF1144.2 +069700 PERFORM PASS IF1144.2 +069800 ELSE IF1144.2 +069900 MOVE 4 TO CORRECT-N IF1144.2 +070000 MOVE WS-INT TO COMPUTED-N IF1144.2 +070100 PERFORM FAIL. IF1144.2 +070200 GO TO F-INTPART-WRITE-22. IF1144.2 +070300 F-INTPART-DELETE-22. IF1144.2 +070400 PERFORM DE-LETE. IF1144.2 +070500 GO TO F-INTPART-WRITE-22. IF1144.2 +070600 F-INTPART-WRITE-22. IF1144.2 +070700 MOVE "F-INTPART-22" TO PAR-NAME. IF1144.2 +070800 PERFORM PRINT-DETAIL. IF1144.2 +070900***************** SPECIAL TEST 1 *********************** IF1144.2 +071000 F-INTPART-23. IF1144.2 +071100 MOVE 4.4 TO ARG1. IF1144.2 +071200 PERFORM F-INTPART-TEST-23 IF1144.2 +071300 UNTIL FUNCTION INTEGER-PART(ARG1) > 10. IF1144.2 +071400 IF ARG1 = 11.4 THEN IF1144.2 +071500 PERFORM PASS IF1144.2 +071600 ELSE IF1144.2 +071700 PERFORM FAIL. IF1144.2 +071800 GO TO F-INTPART-WRITE-23. IF1144.2 +071900* IF1144.2 +072000 F-INTPART-TEST-23. IF1144.2 +072100 COMPUTE ARG1 = ARG1 + 1. IF1144.2 +072200* IF1144.2 +072300 F-INTPART-DELETE-23. IF1144.2 +072400 PERFORM DE-LETE. IF1144.2 +072500 GO TO F-INTPART-WRITE-23. IF1144.2 +072600 F-INTPART-WRITE-23. IF1144.2 +072700 MOVE "F-INTPART-23" TO PAR-NAME. IF1144.2 +072800 PERFORM PRINT-DETAIL. IF1144.2 +072900*******************END OF TESTS************************** IF1144.2 +073000 CCVS-EXIT SECTION. IF1144.2 +073100 CCVS-999999. IF1144.2 +073200 GO TO CLOSE-FILES. IF1144.2 diff --git a/tests/cobol85/IF/IF115A.CBL b/tests/cobol85/IF/IF115A.CBL new file mode 100755 index 00000000..da872535 --- /dev/null +++ b/tests/cobol85/IF/IF115A.CBL @@ -0,0 +1,450 @@ +000100 IDENTIFICATION DIVISION. IF1154.2 +000200 PROGRAM-ID. IF1154.2 +000300 IF115A. IF1154.2 +000400 IF1154.2 +000500*********************************************************** IF1154.2 +000600* * IF1154.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1154.2 +000800* It contains tests for the Intrinsic Function LENGTH. * IF1154.2 +000900* * IF1154.2 +001000* * IF1154.2 +001100*********************************************************** IF1154.2 +001200 ENVIRONMENT DIVISION. IF1154.2 +001300 CONFIGURATION SECTION. IF1154.2 +001400 SOURCE-COMPUTER. IF1154.2 +001500 Linux. IF1154.2 +001600 OBJECT-COMPUTER. IF1154.2 +001700 Linux. IF1154.2 +001800 INPUT-OUTPUT SECTION. IF1154.2 +001900 FILE-CONTROL. IF1154.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1154.2 +002100 "report.log". IF1154.2 +002200 DATA DIVISION. IF1154.2 +002300 FILE SECTION. IF1154.2 +002400 FD PRINT-FILE. IF1154.2 +002500 01 PRINT-REC PICTURE X(120). IF1154.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1154.2 +002700 WORKING-STORAGE SECTION. IF1154.2 +002800*********************************************************** IF1154.2 +002900* Variables specific to the Intrinsic Function Test IF115A* IF1154.2 +003000*********************************************************** IF1154.2 +003100 01 K PIC A(1) VALUE "D". IF1154.2 +003200 01 M PIC A(17) VALUE "longstringofchars". IF1154.2 +003300 01 N PIC A(3) VALUE "abc". IF1154.2 +003400 01 C PIC S9(10). IF1154.2 +003500 01 WS-INT PIC S9(10). IF1154.2 +003600* IF1154.2 +003700********************************************************** IF1154.2 +003800* IF1154.2 +003900 01 TEST-RESULTS. IF1154.2 +004000 02 FILLER PIC X VALUE SPACE. IF1154.2 +004100 02 FEATURE PIC X(20) VALUE SPACE. IF1154.2 +004200 02 FILLER PIC X VALUE SPACE. IF1154.2 +004300 02 P-OR-F PIC X(5) VALUE SPACE. IF1154.2 +004400 02 FILLER PIC X VALUE SPACE. IF1154.2 +004500 02 PAR-NAME. IF1154.2 +004600 03 FILLER PIC X(19) VALUE SPACE. IF1154.2 +004700 03 PARDOT-X PIC X VALUE SPACE. IF1154.2 +004800 03 DOTVALUE PIC 99 VALUE ZERO. IF1154.2 +004900 02 FILLER PIC X(8) VALUE SPACE. IF1154.2 +005000 02 RE-MARK PIC X(61). IF1154.2 +005100 01 TEST-COMPUTED. IF1154.2 +005200 02 FILLER PIC X(30) VALUE SPACE. IF1154.2 +005300 02 FILLER PIC X(17) VALUE IF1154.2 +005400 " COMPUTED=". IF1154.2 +005500 02 COMPUTED-X. IF1154.2 +005600 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1154.2 +005700 03 COMPUTED-N REDEFINES COMPUTED-A IF1154.2 +005800 PIC -9(9).9(9). IF1154.2 +005900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1154.2 +006000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1154.2 +006100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1154.2 +006200 03 CM-18V0 REDEFINES COMPUTED-A. IF1154.2 +006300 04 COMPUTED-18V0 PIC -9(18). IF1154.2 +006400 04 FILLER PIC X. IF1154.2 +006500 03 FILLER PIC X(50) VALUE SPACE. IF1154.2 +006600 01 TEST-CORRECT. IF1154.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1154.2 +006800 02 FILLER PIC X(17) VALUE " CORRECT =". IF1154.2 +006900 02 CORRECT-X. IF1154.2 +007000 03 CORRECT-A PIC X(20) VALUE SPACE. IF1154.2 +007100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1154.2 +007200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1154.2 +007300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1154.2 +007400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1154.2 +007500 03 CR-18V0 REDEFINES CORRECT-A. IF1154.2 +007600 04 CORRECT-18V0 PIC -9(18). IF1154.2 +007700 04 FILLER PIC X. IF1154.2 +007800 03 FILLER PIC X(2) VALUE SPACE. IF1154.2 +007900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1154.2 +008000 01 CCVS-C-1. IF1154.2 +008100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1154.2 +008200- "SS PARAGRAPH-NAME IF1154.2 +008300- " REMARKS". IF1154.2 +008400 02 FILLER PIC X(20) VALUE SPACE. IF1154.2 +008500 01 CCVS-C-2. IF1154.2 +008600 02 FILLER PIC X VALUE SPACE. IF1154.2 +008700 02 FILLER PIC X(6) VALUE "TESTED". IF1154.2 +008800 02 FILLER PIC X(15) VALUE SPACE. IF1154.2 +008900 02 FILLER PIC X(4) VALUE "FAIL". IF1154.2 +009000 02 FILLER PIC X(94) VALUE SPACE. IF1154.2 +009100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1154.2 +009200 01 REC-CT PIC 99 VALUE ZERO. IF1154.2 +009300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1154.2 +009400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1154.2 +009500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1154.2 +009600 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1154.2 +009700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1154.2 +009800 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1154.2 +009900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1154.2 +010000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1154.2 +010100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1154.2 +010200 01 CCVS-H-1. IF1154.2 +010300 02 FILLER PIC X(39) VALUE SPACES. IF1154.2 +010400 02 FILLER PIC X(42) VALUE IF1154.2 +010500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1154.2 +010600 02 FILLER PIC X(39) VALUE SPACES. IF1154.2 +010700 01 CCVS-H-2A. IF1154.2 +010800 02 FILLER PIC X(40) VALUE SPACE. IF1154.2 +010900 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1154.2 +011000 02 FILLER PIC XXXX VALUE IF1154.2 +011100 "4.2 ". IF1154.2 +011200 02 FILLER PIC X(28) VALUE IF1154.2 +011300 " COPY - NOT FOR DISTRIBUTION". IF1154.2 +011400 02 FILLER PIC X(41) VALUE SPACE. IF1154.2 +011500 IF1154.2 +011600 01 CCVS-H-2B. IF1154.2 +011700 02 FILLER PIC X(15) VALUE IF1154.2 +011800 "TEST RESULT OF ". IF1154.2 +011900 02 TEST-ID PIC X(9). IF1154.2 +012000 02 FILLER PIC X(4) VALUE IF1154.2 +012100 " IN ". IF1154.2 +012200 02 FILLER PIC X(12) VALUE IF1154.2 +012300 " HIGH ". IF1154.2 +012400 02 FILLER PIC X(22) VALUE IF1154.2 +012500 " LEVEL VALIDATION FOR ". IF1154.2 +012600 02 FILLER PIC X(58) VALUE IF1154.2 +012700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1154.2 +012800 01 CCVS-H-3. IF1154.2 +012900 02 FILLER PIC X(34) VALUE IF1154.2 +013000 " FOR OFFICIAL USE ONLY ". IF1154.2 +013100 02 FILLER PIC X(58) VALUE IF1154.2 +013200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1154.2 +013300 02 FILLER PIC X(28) VALUE IF1154.2 +013400 " COPYRIGHT 1985 ". IF1154.2 +013500 01 CCVS-E-1. IF1154.2 +013600 02 FILLER PIC X(52) VALUE SPACE. IF1154.2 +013700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1154.2 +013800 02 ID-AGAIN PIC X(9). IF1154.2 +013900 02 FILLER PIC X(45) VALUE SPACES. IF1154.2 +014000 01 CCVS-E-2. IF1154.2 +014100 02 FILLER PIC X(31) VALUE SPACE. IF1154.2 +014200 02 FILLER PIC X(21) VALUE SPACE. IF1154.2 +014300 02 CCVS-E-2-2. IF1154.2 +014400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1154.2 +014500 03 FILLER PIC X VALUE SPACE. IF1154.2 +014600 03 ENDER-DESC PIC X(44) VALUE IF1154.2 +014700 "ERRORS ENCOUNTERED". IF1154.2 +014800 01 CCVS-E-3. IF1154.2 +014900 02 FILLER PIC X(22) VALUE IF1154.2 +015000 " FOR OFFICIAL USE ONLY". IF1154.2 +015100 02 FILLER PIC X(12) VALUE SPACE. IF1154.2 +015200 02 FILLER PIC X(58) VALUE IF1154.2 +015300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1154.2 +015400 02 FILLER PIC X(13) VALUE SPACE. IF1154.2 +015500 02 FILLER PIC X(15) VALUE IF1154.2 +015600 " COPYRIGHT 1985". IF1154.2 +015700 01 CCVS-E-4. IF1154.2 +015800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1154.2 +015900 02 FILLER PIC X(4) VALUE " OF ". IF1154.2 +016000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1154.2 +016100 02 FILLER PIC X(40) VALUE IF1154.2 +016200 " TESTS WERE EXECUTED SUCCESSFULLY". IF1154.2 +016300 01 XXINFO. IF1154.2 +016400 02 FILLER PIC X(19) VALUE IF1154.2 +016500 "*** INFORMATION ***". IF1154.2 +016600 02 INFO-TEXT. IF1154.2 +016700 04 FILLER PIC X(8) VALUE SPACE. IF1154.2 +016800 04 XXCOMPUTED PIC X(20). IF1154.2 +016900 04 FILLER PIC X(5) VALUE SPACE. IF1154.2 +017000 04 XXCORRECT PIC X(20). IF1154.2 +017100 02 INF-ANSI-REFERENCE PIC X(48). IF1154.2 +017200 01 HYPHEN-LINE. IF1154.2 +017300 02 FILLER PIC IS X VALUE IS SPACE. IF1154.2 +017400 02 FILLER PIC IS X(65) VALUE IS "************************IF1154.2 +017500- "*****************************************". IF1154.2 +017600 02 FILLER PIC IS X(54) VALUE IS "************************IF1154.2 +017700- "******************************". IF1154.2 +017800 01 CCVS-PGM-ID PIC X(9) VALUE IF1154.2 +017900 "IF115A". IF1154.2 +018000 PROCEDURE DIVISION. IF1154.2 +018100 CCVS1 SECTION. IF1154.2 +018200 OPEN-FILES. IF1154.2 +018300 OPEN OUTPUT PRINT-FILE. IF1154.2 +018400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1154.2 +018500 MOVE SPACE TO TEST-RESULTS. IF1154.2 +018600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1154.2 +018700 GO TO CCVS1-EXIT. IF1154.2 +018800 CLOSE-FILES. IF1154.2 +018900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1154.2 +019000 TERMINATE-CCVS. IF1154.2 +019100 STOP RUN. IF1154.2 +019200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1154.2 +019300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1154.2 +019400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1154.2 +019500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1154.2 +019600 MOVE "****TEST DELETED****" TO RE-MARK. IF1154.2 +019700 PRINT-DETAIL. IF1154.2 +019800 IF REC-CT NOT EQUAL TO ZERO IF1154.2 +019900 MOVE "." TO PARDOT-X IF1154.2 +020000 MOVE REC-CT TO DOTVALUE. IF1154.2 +020100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1154.2 +020200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1154.2 +020300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1154.2 +020400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1154.2 +020500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1154.2 +020600 MOVE SPACE TO CORRECT-X. IF1154.2 +020700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1154.2 +020800 MOVE SPACE TO RE-MARK. IF1154.2 +020900 HEAD-ROUTINE. IF1154.2 +021000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +021100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +021200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1154.2 +021300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1154.2 +021400 COLUMN-NAMES-ROUTINE. IF1154.2 +021500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +021600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +021700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +021800 END-ROUTINE. IF1154.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1154.2 +022000 END-RTN-EXIT. IF1154.2 +022100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +022200 END-ROUTINE-1. IF1154.2 +022300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1154.2 +022400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1154.2 +022500 ADD PASS-COUNTER TO ERROR-HOLD. IF1154.2 +022600 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1154.2 +022700 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1154.2 +022800 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1154.2 +022900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1154.2 +023000 END-ROUTINE-12. IF1154.2 +023100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1154.2 +023200 IF ERROR-COUNTER IS EQUAL TO ZERO IF1154.2 +023300 MOVE "NO " TO ERROR-TOTAL IF1154.2 +023400 ELSE IF1154.2 +023500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1154.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1154.2 +023700 PERFORM WRITE-LINE. IF1154.2 +023800 END-ROUTINE-13. IF1154.2 +023900 IF DELETE-COUNTER IS EQUAL TO ZERO IF1154.2 +024000 MOVE "NO " TO ERROR-TOTAL ELSE IF1154.2 +024100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1154.2 +024200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1154.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +024400 IF INSPECT-COUNTER EQUAL TO ZERO IF1154.2 +024500 MOVE "NO " TO ERROR-TOTAL IF1154.2 +024600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1154.2 +024700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1154.2 +024800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +024900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2 +025000 WRITE-LINE. IF1154.2 +025100 ADD 1 TO RECORD-COUNT. IF1154.2 +025200 IF RECORD-COUNT GREATER 42 IF1154.2 +025300 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1154.2 +025400 MOVE SPACE TO DUMMY-RECORD IF1154.2 +025500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1154.2 +025600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1154.2 +025700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1154.2 +025800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1154.2 +025900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1154.2 +026000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1154.2 +026100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1154.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1154.2 +026300 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1154.2 +026400 MOVE ZERO TO RECORD-COUNT. IF1154.2 +026500 PERFORM WRT-LN. IF1154.2 +026600 WRT-LN. IF1154.2 +026700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1154.2 +026800 MOVE SPACE TO DUMMY-RECORD. IF1154.2 +026900 BLANK-LINE-PRINT. IF1154.2 +027000 PERFORM WRT-LN. IF1154.2 +027100 FAIL-ROUTINE. IF1154.2 +027200 IF COMPUTED-X NOT EQUAL TO SPACE IF1154.2 +027300 GO TO FAIL-ROUTINE-WRITE. IF1154.2 +027400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1154.2 +027500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1154.2 +027600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1154.2 +027700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +027800 MOVE SPACES TO INF-ANSI-REFERENCE. IF1154.2 +027900 GO TO FAIL-ROUTINE-EX. IF1154.2 +028000 FAIL-ROUTINE-WRITE. IF1154.2 +028100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1154.2 +028200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1154.2 +028300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1154.2 +028400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1154.2 +028500 FAIL-ROUTINE-EX. EXIT. IF1154.2 +028600 BAIL-OUT. IF1154.2 +028700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1154.2 +028800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1154.2 +028900 BAIL-OUT-WRITE. IF1154.2 +029000 MOVE CORRECT-A TO XXCORRECT. IF1154.2 +029100 MOVE COMPUTED-A TO XXCOMPUTED. IF1154.2 +029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1154.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1154.2 +029500 BAIL-OUT-EX. EXIT. IF1154.2 +029600 CCVS1-EXIT. IF1154.2 +029700 EXIT. IF1154.2 +029800******************************************************** IF1154.2 +029900* * IF1154.2 +030000* Intrinsic Function Tests IF115A - LENGTH * IF1154.2 +030100* * IF1154.2 +030200******************************************************** IF1154.2 +030300 SECT-IF115A SECTION. IF1154.2 +030400 F-LENGTH-INFO. IF1154.2 +030500 MOVE "See ref. A-48 2.19" TO ANSI-REFERENCE. IF1154.2 +030600 MOVE "LENGTH Function" TO FEATURE. IF1154.2 +030700*****************TEST (a) ****************************** IF1154.2 +030800 F-LENGTH-01. IF1154.2 +030900 MOVE ZERO TO WS-INT. IF1154.2 +031000 F-LENGTH-TEST-01. IF1154.2 +031100 COMPUTE WS-INT = FUNCTION LENGTH("A"). IF1154.2 +031200 IF WS-INT = 1 THEN IF1154.2 +031300 PERFORM PASS IF1154.2 +031400 ELSE IF1154.2 +031500 MOVE 1 TO CORRECT-X IF1154.2 +031600 MOVE WS-INT TO COMPUTED-A IF1154.2 +031700 PERFORM FAIL. IF1154.2 +031800 GO TO F-LENGTH-WRITE-01. IF1154.2 +031900 F-LENGTH-DELETE-01. IF1154.2 +032000 PERFORM DE-LETE. IF1154.2 +032100 GO TO F-LENGTH-WRITE-01. IF1154.2 +032200 F-LENGTH-WRITE-01. IF1154.2 +032300 MOVE "F-LENGTH-01" TO PAR-NAME. IF1154.2 +032400 PERFORM PRINT-DETAIL. IF1154.2 +032500*****************TEST (b) ****************************** IF1154.2 +032600 F-LENGTH-TEST-02. IF1154.2 +032700 EVALUATE FUNCTION LENGTH("ABCDEFGHIJKLMNOPQRST") IF1154.2 +032800 WHEN 20 IF1154.2 +032900 PERFORM PASS IF1154.2 +033000 GO TO F-LENGTH-WRITE-02. IF1154.2 +033100 PERFORM FAIL. IF1154.2 +033200 GO TO F-LENGTH-WRITE-02. IF1154.2 +033300 F-LENGTH-DELETE-02. IF1154.2 +033400 PERFORM DE-LETE. IF1154.2 +033500 GO TO F-LENGTH-WRITE-02. IF1154.2 +033600 F-LENGTH-WRITE-02. IF1154.2 +033700 MOVE "F-LENGTH-02" TO PAR-NAME. IF1154.2 +033800 PERFORM PRINT-DETAIL. IF1154.2 +033900*****************TEST (c) ****************************** IF1154.2 +034000 F-LENGTH-03. IF1154.2 +034100 MOVE ZERO TO WS-INT. IF1154.2 +034200 F-LENGTH-TEST-03. IF1154.2 +034300 IF FUNCTION LENGTH("ABCD") = 4 THEN IF1154.2 +034400 PERFORM PASS IF1154.2 +034500 ELSE IF1154.2 +034600 MOVE 4 TO CORRECT-X IF1154.2 +034700 MOVE WS-INT TO COMPUTED-A IF1154.2 +034800 PERFORM FAIL. IF1154.2 +034900 GO TO F-LENGTH-WRITE-03. IF1154.2 +035000 F-LENGTH-DELETE-03. IF1154.2 +035100 PERFORM DE-LETE. IF1154.2 +035200 GO TO F-LENGTH-WRITE-03. IF1154.2 +035300 F-LENGTH-WRITE-03. IF1154.2 +035400 MOVE "F-LENGTH-03" TO PAR-NAME. IF1154.2 +035500 PERFORM PRINT-DETAIL. IF1154.2 +035600*****************TEST (d) ****************************** IF1154.2 +035700 F-LENGTH-04. IF1154.2 +035800 MOVE ZERO TO WS-INT. IF1154.2 +035900 F-LENGTH-TEST-04. IF1154.2 +036000 COMPUTE WS-INT = FUNCTION LENGTH(K). IF1154.2 +036100 IF WS-INT = 1 THEN IF1154.2 +036200 PERFORM PASS IF1154.2 +036300 ELSE IF1154.2 +036400 MOVE 1 TO CORRECT-X IF1154.2 +036500 MOVE WS-INT TO COMPUTED-A IF1154.2 +036600 PERFORM FAIL. IF1154.2 +036700 GO TO F-LENGTH-WRITE-04. IF1154.2 +036800 F-LENGTH-DELETE-04. IF1154.2 +036900 PERFORM DE-LETE. IF1154.2 +037000 GO TO F-LENGTH-WRITE-04. IF1154.2 +037100 F-LENGTH-WRITE-04. IF1154.2 +037200 MOVE "F-LENGTH-04" TO PAR-NAME. IF1154.2 +037300 PERFORM PRINT-DETAIL. IF1154.2 +037400*****************TEST (e) ****************************** IF1154.2 +037500 F-LENGTH-05. IF1154.2 +037600 MOVE ZERO TO WS-INT. IF1154.2 +037700 F-LENGTH-TEST-05. IF1154.2 +037800 COMPUTE WS-INT = FUNCTION LENGTH(M). IF1154.2 +037900 IF WS-INT = 17 THEN IF1154.2 +038000 PERFORM PASS IF1154.2 +038100 ELSE IF1154.2 +038200 MOVE 17 TO CORRECT-X IF1154.2 +038300 MOVE WS-INT TO COMPUTED-A IF1154.2 +038400 PERFORM FAIL. IF1154.2 +038500 GO TO F-LENGTH-WRITE-05. IF1154.2 +038600 F-LENGTH-DELETE-05. IF1154.2 +038700 PERFORM DE-LETE. IF1154.2 +038800 GO TO F-LENGTH-WRITE-05. IF1154.2 +038900 F-LENGTH-WRITE-05. IF1154.2 +039000 MOVE "F-LENGTH-05" TO PAR-NAME. IF1154.2 +039100 PERFORM PRINT-DETAIL. IF1154.2 +039200*****************TEST (f) ****************************** IF1154.2 +039300 F-LENGTH-06. IF1154.2 +039400 MOVE ZERO TO WS-INT. IF1154.2 +039500 F-LENGTH-TEST-06. IF1154.2 +039600 COMPUTE WS-INT = FUNCTION LENGTH(N). IF1154.2 +039700 IF WS-INT = 3 THEN IF1154.2 +039800 PERFORM PASS IF1154.2 +039900 ELSE IF1154.2 +040000 MOVE 3 TO CORRECT-X IF1154.2 +040100 MOVE WS-INT TO COMPUTED-A IF1154.2 +040200 PERFORM FAIL. IF1154.2 +040300 GO TO F-LENGTH-WRITE-06. IF1154.2 +040400 F-LENGTH-DELETE-06. IF1154.2 +040500 PERFORM DE-LETE. IF1154.2 +040600 GO TO F-LENGTH-WRITE-06. IF1154.2 +040700 F-LENGTH-WRITE-06. IF1154.2 +040800 MOVE "F-LENGTH-06" TO PAR-NAME. IF1154.2 +040900 PERFORM PRINT-DETAIL. IF1154.2 +041000*****************TEST (g) ****************************** IF1154.2 +041100 F-LENGTH-07. IF1154.2 +041200 MOVE ZERO TO WS-INT. IF1154.2 +041300 F-LENGTH-TEST-07. IF1154.2 +041400 COMPUTE WS-INT = FUNCTION LENGTH(N) + 2. IF1154.2 +041500 IF WS-INT = 5 THEN IF1154.2 +041600 PERFORM PASS IF1154.2 +041700 ELSE IF1154.2 +041800 MOVE 5 TO CORRECT-N IF1154.2 +041900 MOVE WS-INT TO COMPUTED-A IF1154.2 +042000 PERFORM FAIL. IF1154.2 +042100 GO TO F-LENGTH-WRITE-07. IF1154.2 +042200 F-LENGTH-DELETE-07. IF1154.2 +042300 PERFORM DE-LETE. IF1154.2 +042400 GO TO F-LENGTH-WRITE-07. IF1154.2 +042500 F-LENGTH-WRITE-07. IF1154.2 +042600 MOVE "F-LENGTH-07" TO PAR-NAME. IF1154.2 +042700 PERFORM PRINT-DETAIL. IF1154.2 +042800*****************TEST (h) ****************************** IF1154.2 +042900 F-LENGTH-08. IF1154.2 +043000 MOVE ZERO TO WS-INT. IF1154.2 +043100 F-LENGTH-TEST-08. IF1154.2 +043200 COMPUTE WS-INT = FUNCTION LENGTH(N) + IF1154.2 +043300 FUNCTION LENGTH(N). IF1154.2 +043400 IF WS-INT = 6 THEN IF1154.2 +043500 PERFORM PASS IF1154.2 +043600 ELSE IF1154.2 +043700 MOVE 6 TO CORRECT-N IF1154.2 +043800 MOVE WS-INT TO COMPUTED-A IF1154.2 +043900 PERFORM FAIL. IF1154.2 +044000 GO TO F-LENGTH-WRITE-08. IF1154.2 +044100 F-LENGTH-DELETE-08. IF1154.2 +044200 PERFORM DE-LETE. IF1154.2 +044300 GO TO F-LENGTH-WRITE-08. IF1154.2 +044400 F-LENGTH-WRITE-08. IF1154.2 +044500 MOVE "F-LENGTH-08" TO PAR-NAME. IF1154.2 +044600 PERFORM PRINT-DETAIL. IF1154.2 +044700*******************END OF TESTS************************** IF1154.2 +044800 CCVS-EXIT SECTION. IF1154.2 +044900 CCVS-999999. IF1154.2 +045000 GO TO CLOSE-FILES. IF1154.2 diff --git a/tests/cobol85/IF/IF116A.CBL b/tests/cobol85/IF/IF116A.CBL new file mode 100755 index 00000000..2112b453 --- /dev/null +++ b/tests/cobol85/IF/IF116A.CBL @@ -0,0 +1,889 @@ +000100 IDENTIFICATION DIVISION. IF1164.2 +000200 PROGRAM-ID. IF1164.2 +000300 IF116A. IF1164.2 +000400 IF1164.2 +000500*********************************************************** IF1164.2 +000600* * IF1164.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1164.2 +000800* It contains tests for the Intrinsic Function LOG. * IF1164.2 +000900* * IF1164.2 +001000*********************************************************** IF1164.2 +001100 ENVIRONMENT DIVISION. IF1164.2 +001200 CONFIGURATION SECTION. IF1164.2 +001300 SOURCE-COMPUTER. IF1164.2 +001400 Linux. IF1164.2 +001500 OBJECT-COMPUTER. IF1164.2 +001600 Linux. IF1164.2 +001700 INPUT-OUTPUT SECTION. IF1164.2 +001800 FILE-CONTROL. IF1164.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1164.2 +002000 "report.log". IF1164.2 +002100 DATA DIVISION. IF1164.2 +002200 FILE SECTION. IF1164.2 +002300 FD PRINT-FILE. IF1164.2 +002400 01 PRINT-REC PICTURE X(120). IF1164.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1164.2 +002600 WORKING-STORAGE SECTION. IF1164.2 +002700*********************************************************** IF1164.2 +002800* Variables specific to the Intrinsic Function Test IF116A* IF1164.2 +002900*********************************************************** IF1164.2 +003000 01 A PIC S9(10) VALUE 600000. IF1164.2 +003100 01 B PIC S9(10) VALUE 7. IF1164.2 +003200 01 C PIC S9(10) VALUE -4. IF1164.2 +003300 01 D PIC S9(10) VALUE 10. IF1164.2 +003400 01 E PIC S9(1)V9(9) VALUE 2.718281828. IF1164.2 +003500 01 F PIC S9(5)V9(5) VALUE 32000.8. IF1164.2 +003600 01 G PIC S9(5)V9(5) VALUE .00002. IF1164.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1164.2 +003800 01 ARG1 PIC S9(5)V9(5) VALUE 1.00. IF1164.2 +003900 01 ARR VALUE "40537". IF1164.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1164.2 +004100 01 TEMP PIC S9(10). IF1164.2 +004200 01 WS-NUM PIC S9(5)V9(6). IF1164.2 +004300 01 MIN-RANGE PIC S9(5)V9(7). IF1164.2 +004400 01 MAX-RANGE PIC S9(5)V9(7). IF1164.2 +004500* IF1164.2 +004600********************************************************** IF1164.2 +004700* IF1164.2 +004800 01 TEST-RESULTS. IF1164.2 +004900 02 FILLER PIC X VALUE SPACE. IF1164.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IF1164.2 +005100 02 FILLER PIC X VALUE SPACE. IF1164.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IF1164.2 +005300 02 FILLER PIC X VALUE SPACE. IF1164.2 +005400 02 PAR-NAME. IF1164.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IF1164.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IF1164.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IF1164.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IF1164.2 +005900 02 RE-MARK PIC X(61). IF1164.2 +006000 01 TEST-COMPUTED. IF1164.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IF1164.2 +006200 02 FILLER PIC X(17) VALUE IF1164.2 +006300 " COMPUTED=". IF1164.2 +006400 02 COMPUTED-X. IF1164.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1164.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IF1164.2 +006700 PIC -9(9).9(9). IF1164.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1164.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1164.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1164.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IF1164.2 +007200 04 COMPUTED-18V0 PIC -9(18). IF1164.2 +007300 04 FILLER PIC X. IF1164.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IF1164.2 +007500 01 TEST-CORRECT. IF1164.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IF1164.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1164.2 +007800 02 CORRECT-X. IF1164.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1164.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1164.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1164.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1164.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1164.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IF1164.2 +008500 04 CORRECT-18V0 PIC -9(18). IF1164.2 +008600 04 FILLER PIC X. IF1164.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IF1164.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1164.2 +008900 01 TEST-CORRECT-MIN. IF1164.2 +009000 02 FILLER PIC X(30) VALUE SPACE. IF1164.2 +009100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1164.2 +009200 02 CORRECTMI-X. IF1164.2 +009300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1164.2 +009400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1164.2 +009500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1164.2 +009600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1164.2 +009700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1164.2 +009800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1164.2 +009900 04 CORRECTMI-18V0 PIC -9(18). IF1164.2 +010000 04 FILLER PIC X. IF1164.2 +010100 03 FILLER PIC X(2) VALUE SPACE. IF1164.2 +010200 03 FILLER PIC X(48) VALUE SPACE. IF1164.2 +010300 01 TEST-CORRECT-MAX. IF1164.2 +010400 02 FILLER PIC X(30) VALUE SPACE. IF1164.2 +010500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1164.2 +010600 02 CORRECTMA-X. IF1164.2 +010700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1164.2 +010800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1164.2 +010900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1164.2 +011000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1164.2 +011100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1164.2 +011200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1164.2 +011300 04 CORRECTMA-18V0 PIC -9(18). IF1164.2 +011400 04 FILLER PIC X. IF1164.2 +011500 03 FILLER PIC X(2) VALUE SPACE. IF1164.2 +011600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1164.2 +011700 01 CCVS-C-1. IF1164.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1164.2 +011900- "SS PARAGRAPH-NAME IF1164.2 +012000- " REMARKS". IF1164.2 +012100 02 FILLER PIC X(20) VALUE SPACE. IF1164.2 +012200 01 CCVS-C-2. IF1164.2 +012300 02 FILLER PIC X VALUE SPACE. IF1164.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". IF1164.2 +012500 02 FILLER PIC X(15) VALUE SPACE. IF1164.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". IF1164.2 +012700 02 FILLER PIC X(94) VALUE SPACE. IF1164.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1164.2 +012900 01 REC-CT PIC 99 VALUE ZERO. IF1164.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1164.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1164.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1164.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1164.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1164.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1164.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1164.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1164.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1164.2 +013900 01 CCVS-H-1. IF1164.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1164.2 +014100 02 FILLER PIC X(42) VALUE IF1164.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1164.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IF1164.2 +014400 01 CCVS-H-2A. IF1164.2 +014500 02 FILLER PIC X(40) VALUE SPACE. IF1164.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1164.2 +014700 02 FILLER PIC XXXX VALUE IF1164.2 +014800 "4.2 ". IF1164.2 +014900 02 FILLER PIC X(28) VALUE IF1164.2 +015000 " COPY - NOT FOR DISTRIBUTION". IF1164.2 +015100 02 FILLER PIC X(41) VALUE SPACE. IF1164.2 +015200 IF1164.2 +015300 01 CCVS-H-2B. IF1164.2 +015400 02 FILLER PIC X(15) VALUE IF1164.2 +015500 "TEST RESULT OF ". IF1164.2 +015600 02 TEST-ID PIC X(9). IF1164.2 +015700 02 FILLER PIC X(4) VALUE IF1164.2 +015800 " IN ". IF1164.2 +015900 02 FILLER PIC X(12) VALUE IF1164.2 +016000 " HIGH ". IF1164.2 +016100 02 FILLER PIC X(22) VALUE IF1164.2 +016200 " LEVEL VALIDATION FOR ". IF1164.2 +016300 02 FILLER PIC X(58) VALUE IF1164.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1164.2 +016500 01 CCVS-H-3. IF1164.2 +016600 02 FILLER PIC X(34) VALUE IF1164.2 +016700 " FOR OFFICIAL USE ONLY ". IF1164.2 +016800 02 FILLER PIC X(58) VALUE IF1164.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1164.2 +017000 02 FILLER PIC X(28) VALUE IF1164.2 +017100 " COPYRIGHT 1985 ". IF1164.2 +017200 01 CCVS-E-1. IF1164.2 +017300 02 FILLER PIC X(52) VALUE SPACE. IF1164.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1164.2 +017500 02 ID-AGAIN PIC X(9). IF1164.2 +017600 02 FILLER PIC X(45) VALUE SPACES. IF1164.2 +017700 01 CCVS-E-2. IF1164.2 +017800 02 FILLER PIC X(31) VALUE SPACE. IF1164.2 +017900 02 FILLER PIC X(21) VALUE SPACE. IF1164.2 +018000 02 CCVS-E-2-2. IF1164.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1164.2 +018200 03 FILLER PIC X VALUE SPACE. IF1164.2 +018300 03 ENDER-DESC PIC X(44) VALUE IF1164.2 +018400 "ERRORS ENCOUNTERED". IF1164.2 +018500 01 CCVS-E-3. IF1164.2 +018600 02 FILLER PIC X(22) VALUE IF1164.2 +018700 " FOR OFFICIAL USE ONLY". IF1164.2 +018800 02 FILLER PIC X(12) VALUE SPACE. IF1164.2 +018900 02 FILLER PIC X(58) VALUE IF1164.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1164.2 +019100 02 FILLER PIC X(13) VALUE SPACE. IF1164.2 +019200 02 FILLER PIC X(15) VALUE IF1164.2 +019300 " COPYRIGHT 1985". IF1164.2 +019400 01 CCVS-E-4. IF1164.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1164.2 +019600 02 FILLER PIC X(4) VALUE " OF ". IF1164.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1164.2 +019800 02 FILLER PIC X(40) VALUE IF1164.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1164.2 +020000 01 XXINFO. IF1164.2 +020100 02 FILLER PIC X(19) VALUE IF1164.2 +020200 "*** INFORMATION ***". IF1164.2 +020300 02 INFO-TEXT. IF1164.2 +020400 04 FILLER PIC X(8) VALUE SPACE. IF1164.2 +020500 04 XXCOMPUTED PIC X(20). IF1164.2 +020600 04 FILLER PIC X(5) VALUE SPACE. IF1164.2 +020700 04 XXCORRECT PIC X(20). IF1164.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). IF1164.2 +020900 01 HYPHEN-LINE. IF1164.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. IF1164.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************IF1164.2 +021200- "*****************************************". IF1164.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************IF1164.2 +021400- "******************************". IF1164.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE IF1164.2 +021600 "IF116A". IF1164.2 +021700 PROCEDURE DIVISION. IF1164.2 +021800 CCVS1 SECTION. IF1164.2 +021900 OPEN-FILES. IF1164.2 +022000 OPEN OUTPUT PRINT-FILE. IF1164.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1164.2 +022200 MOVE SPACE TO TEST-RESULTS. IF1164.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1164.2 +022400 GO TO CCVS1-EXIT. IF1164.2 +022500 CLOSE-FILES. IF1164.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1164.2 +022700 TERMINATE-CCVS. IF1164.2 +022800 STOP RUN. IF1164.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1164.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1164.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1164.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1164.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IF1164.2 +023400 PRINT-DETAIL. IF1164.2 +023500 IF REC-CT NOT EQUAL TO ZERO IF1164.2 +023600 MOVE "." TO PARDOT-X IF1164.2 +023700 MOVE REC-CT TO DOTVALUE. IF1164.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1164.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1164.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1164.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1164.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1164.2 +024300 MOVE SPACE TO CORRECT-X. IF1164.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1164.2 +024500 MOVE SPACE TO RE-MARK. IF1164.2 +024600 HEAD-ROUTINE. IF1164.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1164.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1164.2 +025100 COLUMN-NAMES-ROUTINE. IF1164.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +025500 END-ROUTINE. IF1164.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1164.2 +025700 END-RTN-EXIT. IF1164.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +025900 END-ROUTINE-1. IF1164.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1164.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1164.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IF1164.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1164.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1164.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1164.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1164.2 +026700 END-ROUTINE-12. IF1164.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1164.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1164.2 +027000 MOVE "NO " TO ERROR-TOTAL IF1164.2 +027100 ELSE IF1164.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1164.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1164.2 +027400 PERFORM WRITE-LINE. IF1164.2 +027500 END-ROUTINE-13. IF1164.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1164.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE IF1164.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1164.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1164.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO IF1164.2 +028200 MOVE "NO " TO ERROR-TOTAL IF1164.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1164.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1164.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1164.2 +028700 WRITE-LINE. IF1164.2 +028800 ADD 1 TO RECORD-COUNT. IF1164.2 +028900 IF RECORD-COUNT GREATER 42 IF1164.2 +029000 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1164.2 +029100 MOVE SPACE TO DUMMY-RECORD IF1164.2 +029200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1164.2 +029300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1164.2 +029400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1164.2 +029500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1164.2 +029600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1164.2 +029700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1164.2 +029800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1164.2 +029900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1164.2 +030000 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1164.2 +030100 MOVE ZERO TO RECORD-COUNT. IF1164.2 +030200 PERFORM WRT-LN. IF1164.2 +030300 WRT-LN. IF1164.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1164.2 +030500 MOVE SPACE TO DUMMY-RECORD. IF1164.2 +030600 BLANK-LINE-PRINT. IF1164.2 +030700 PERFORM WRT-LN. IF1164.2 +030800 FAIL-ROUTINE. IF1164.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE IF1164.2 +031000 GO TO FAIL-ROUTINE-WRITE. IF1164.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1164.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1164.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1164.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1164.2 +031600 GO TO FAIL-ROUTINE-EX. IF1164.2 +031700 FAIL-ROUTINE-WRITE. IF1164.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1164.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1164.2 +032000 CORMA-ANSI-REFERENCE. IF1164.2 +032100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1164.2 +032200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1164.2 +032300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1164.2 +032400 ELSE IF1164.2 +032500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1164.2 +032600 PERFORM WRITE-LINE. IF1164.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1164.2 +032800 FAIL-ROUTINE-EX. EXIT. IF1164.2 +032900 BAIL-OUT. IF1164.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1164.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1164.2 +033200 BAIL-OUT-WRITE. IF1164.2 +033300 MOVE CORRECT-A TO XXCORRECT. IF1164.2 +033400 MOVE COMPUTED-A TO XXCOMPUTED. IF1164.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1164.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1164.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1164.2 +033800 BAIL-OUT-EX. EXIT. IF1164.2 +033900 CCVS1-EXIT. IF1164.2 +034000 EXIT. IF1164.2 +034100******************************************************** IF1164.2 +034200* * IF1164.2 +034300* Intrinsic Function Tests IF116A - LOG * IF1164.2 +034400* * IF1164.2 +034500******************************************************** IF1164.2 +034600 SECT-IF116A SECTION. IF1164.2 +034700 F-LOG-INFO. IF1164.2 +034800 MOVE "See ref. A-49 2.20" TO ANSI-REFERENCE. IF1164.2 +034900 MOVE "LOG Function" TO FEATURE. IF1164.2 +035000*****************TEST (a) - SIMPLE TEST***************** IF1164.2 +035100 F-LOG-01. IF1164.2 +035200 MOVE ZERO TO WS-NUM. IF1164.2 +035300 MOVE 0.999980 TO MIN-RANGE. IF1164.2 +035400 MOVE 1.00002 TO MAX-RANGE. IF1164.2 +035500 F-LOG-TEST-01. IF1164.2 +035600 COMPUTE WS-NUM = FUNCTION LOG(E). IF1164.2 +035700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +035800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +035900 PERFORM PASS IF1164.2 +036000 ELSE IF1164.2 +036100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +036200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +036300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +036400 PERFORM FAIL. IF1164.2 +036500 GO TO F-LOG-WRITE-01. IF1164.2 +036600 F-LOG-DELETE-01. IF1164.2 +036700 PERFORM DE-LETE. IF1164.2 +036800 GO TO F-LOG-WRITE-01. IF1164.2 +036900 F-LOG-WRITE-01. IF1164.2 +037000 MOVE "F-LOG-01" TO PAR-NAME. IF1164.2 +037100 PERFORM PRINT-DETAIL. IF1164.2 +037200*****************TEST (b) - SIMPLE TEST***************** IF1164.2 +037300 F-LOG-02. IF1164.2 +037400 EVALUATE FUNCTION LOG(1) IF1164.2 +037500 WHEN -0.000020 THRU 0.000020 IF1164.2 +037600 PERFORM PASS IF1164.2 +037700 WHEN OTHER IF1164.2 +037800 PERFORM FAIL. IF1164.2 +037900 GO TO F-LOG-WRITE-02. IF1164.2 +038000 F-LOG-DELETE-02. IF1164.2 +038100 PERFORM DE-LETE. IF1164.2 +038200 GO TO F-LOG-WRITE-02. IF1164.2 +038300 F-LOG-WRITE-02. IF1164.2 +038400 MOVE "F-LOG-02" TO PAR-NAME. IF1164.2 +038500 PERFORM PRINT-DETAIL. IF1164.2 +038600*****************TEST (d) - SIMPLE TEST***************** IF1164.2 +038700 F-LOG-04. IF1164.2 +038800 MOVE ZERO TO WS-NUM. IF1164.2 +038900 MOVE -6.90789 TO MIN-RANGE. IF1164.2 +039000 MOVE -6.90761 TO MAX-RANGE. IF1164.2 +039100 F-LOG-TEST-04. IF1164.2 +039200 COMPUTE WS-NUM = FUNCTION LOG(.001). IF1164.2 +039300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +039400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +039500 PERFORM PASS IF1164.2 +039600 ELSE IF1164.2 +039700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +039800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +039900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +040000 PERFORM FAIL. IF1164.2 +040100 GO TO F-LOG-WRITE-04. IF1164.2 +040200 F-LOG-DELETE-04. IF1164.2 +040300 PERFORM DE-LETE. IF1164.2 +040400 GO TO F-LOG-WRITE-04. IF1164.2 +040500 F-LOG-WRITE-04. IF1164.2 +040600 MOVE "F-LOG-04" TO PAR-NAME. IF1164.2 +040700 PERFORM PRINT-DETAIL. IF1164.2 +040800*****************TEST (e) - SIMPLE TEST***************** IF1164.2 +040900 F-LOG-05. IF1164.2 +041000 MOVE ZERO TO WS-NUM. IF1164.2 +041100 MOVE 9.21015 TO MIN-RANGE. IF1164.2 +041200 MOVE 9.21524 TO MAX-RANGE. IF1164.2 +041300 F-LOG-TEST-05. IF1164.2 +041400 COMPUTE WS-NUM = FUNCTION LOG(10000). IF1164.2 +041500 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +041600 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +041700 PERFORM PASS IF1164.2 +041800 ELSE IF1164.2 +041900 MOVE WS-NUM TO COMPUTED-N IF1164.2 +042000 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +042100 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +042200 PERFORM FAIL. IF1164.2 +042300 GO TO F-LOG-WRITE-05. IF1164.2 +042400 F-LOG-DELETE-05. IF1164.2 +042500 PERFORM DE-LETE. IF1164.2 +042600 GO TO F-LOG-WRITE-05. IF1164.2 +042700 F-LOG-WRITE-05. IF1164.2 +042800 MOVE "F-LOG-05" TO PAR-NAME. IF1164.2 +042900 PERFORM PRINT-DETAIL. IF1164.2 +043000*****************TEST (f) - SIMPLE TEST***************** IF1164.2 +043100 F-LOG-06. IF1164.2 +043200 MOVE ZERO TO WS-NUM. IF1164.2 +043300 MOVE 8.01598 TO MIN-RANGE. IF1164.2 +043400 MOVE 8.01630 TO MAX-RANGE. IF1164.2 +043500 F-LOG-TEST-06. IF1164.2 +043600 COMPUTE WS-NUM = FUNCTION LOG(3029.48). IF1164.2 +043700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +043800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +043900 PERFORM PASS IF1164.2 +044000 ELSE IF1164.2 +044100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +044200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +044300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +044400 PERFORM FAIL. IF1164.2 +044500 GO TO F-LOG-WRITE-06. IF1164.2 +044600 F-LOG-DELETE-06. IF1164.2 +044700 PERFORM DE-LETE. IF1164.2 +044800 GO TO F-LOG-WRITE-06. IF1164.2 +044900 F-LOG-WRITE-06. IF1164.2 +045000 MOVE "F-LOG-06" TO PAR-NAME. IF1164.2 +045100 PERFORM PRINT-DETAIL. IF1164.2 +045200*****************TEST (g) - SIMPLE TEST***************** IF1164.2 +045300 F-LOG-07. IF1164.2 +045400 MOVE ZERO TO WS-NUM. IF1164.2 +045500 MOVE -9.90368 TO MIN-RANGE. IF1164.2 +045600 MOVE -9.90328 TO MAX-RANGE. IF1164.2 +045700 F-LOG-TEST-07. IF1164.2 +045800 COMPUTE WS-NUM = FUNCTION LOG(.00005). IF1164.2 +045900 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +046000 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +046100 PERFORM PASS IF1164.2 +046200 ELSE IF1164.2 +046300 MOVE WS-NUM TO COMPUTED-N IF1164.2 +046400 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +046500 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +046600 PERFORM FAIL. IF1164.2 +046700 GO TO F-LOG-WRITE-07. IF1164.2 +046800 F-LOG-DELETE-07. IF1164.2 +046900 PERFORM DE-LETE. IF1164.2 +047000 GO TO F-LOG-WRITE-07. IF1164.2 +047100 F-LOG-WRITE-07. IF1164.2 +047200 MOVE "F-LOG-07" TO PAR-NAME. IF1164.2 +047300 PERFORM PRINT-DETAIL. IF1164.2 +047400*****************TEST (h) - SIMPLE TEST***************** IF1164.2 +047500 F-LOG-08. IF1164.2 +047600 MOVE ZERO TO WS-NUM. IF1164.2 +047700 MOVE 13.3044 TO MIN-RANGE. IF1164.2 +047800 MOVE 13.3050 TO MAX-RANGE. IF1164.2 +047900 F-LOG-TEST-08. IF1164.2 +048000 COMPUTE WS-NUM = FUNCTION LOG(A). IF1164.2 +048100 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +048200 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +048300 PERFORM PASS IF1164.2 +048400 ELSE IF1164.2 +048500 MOVE WS-NUM TO COMPUTED-N IF1164.2 +048600 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +048700 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +048800 PERFORM FAIL. IF1164.2 +048900 GO TO F-LOG-WRITE-08. IF1164.2 +049000 F-LOG-DELETE-08. IF1164.2 +049100 PERFORM DE-LETE. IF1164.2 +049200 GO TO F-LOG-WRITE-08. IF1164.2 +049300 F-LOG-WRITE-08. IF1164.2 +049400 MOVE "F-LOG-08" TO PAR-NAME. IF1164.2 +049500 PERFORM PRINT-DETAIL. IF1164.2 +049600*****************TEST (i) - SIMPLE TEST***************** IF1164.2 +049700 F-LOG-09. IF1164.2 +049800 MOVE ZERO TO WS-NUM. IF1164.2 +049900 MOVE 10.3733 TO MIN-RANGE. IF1164.2 +050000 MOVE 10.3737 TO MAX-RANGE. IF1164.2 +050100 F-LOG-TEST-09. IF1164.2 +050200 COMPUTE WS-NUM = FUNCTION LOG(F). IF1164.2 +050300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +050400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +050500 PERFORM PASS IF1164.2 +050600 ELSE IF1164.2 +050700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +050800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +050900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +051000 PERFORM FAIL. IF1164.2 +051100 GO TO F-LOG-WRITE-09. IF1164.2 +051200 F-LOG-DELETE-09. IF1164.2 +051300 PERFORM DE-LETE. IF1164.2 +051400 GO TO F-LOG-WRITE-09. IF1164.2 +051500 F-LOG-WRITE-09. IF1164.2 +051600 MOVE "F-LOG-09" TO PAR-NAME. IF1164.2 +051700 PERFORM PRINT-DETAIL. IF1164.2 +051800*****************TEST (j) - SIMPLE TEST***************** IF1164.2 +051900 F-LOG-10. IF1164.2 +052000 MOVE ZERO TO WS-NUM. IF1164.2 +052100 MOVE -10.8199 TO MIN-RANGE. IF1164.2 +052200 MOVE -10.8195 TO MAX-RANGE. IF1164.2 +052300 F-LOG-TEST-10. IF1164.2 +052400 COMPUTE WS-NUM = FUNCTION LOG(G). IF1164.2 +052500 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +052600 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +052700 PERFORM PASS IF1164.2 +052800 ELSE IF1164.2 +052900 MOVE WS-NUM TO COMPUTED-N IF1164.2 +053000 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +053100 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +053200 PERFORM FAIL. IF1164.2 +053300 GO TO F-LOG-WRITE-10. IF1164.2 +053400 F-LOG-DELETE-10. IF1164.2 +053500 PERFORM DE-LETE. IF1164.2 +053600 GO TO F-LOG-WRITE-10. IF1164.2 +053700 F-LOG-WRITE-10. IF1164.2 +053800 MOVE "F-LOG-10" TO PAR-NAME. IF1164.2 +053900 PERFORM PRINT-DETAIL. IF1164.2 +054000*****************TEST (k) - SIMPLE TEST***************** IF1164.2 +054100 F-LOG-11. IF1164.2 +054200 MOVE ZERO TO WS-NUM. IF1164.2 +054300 MOVE 1.09859 TO MIN-RANGE. IF1164.2 +054400 MOVE 1.09863 TO MAX-RANGE. IF1164.2 +054500 F-LOG-TEST-11. IF1164.2 +054600 COMPUTE WS-NUM = FUNCTION LOG(IND(4)). IF1164.2 +054700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +054800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +054900 PERFORM PASS IF1164.2 +055000 ELSE IF1164.2 +055100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +055200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +055300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +055400 PERFORM FAIL. IF1164.2 +055500 GO TO F-LOG-WRITE-11. IF1164.2 +055600 F-LOG-DELETE-11. IF1164.2 +055700 PERFORM DE-LETE. IF1164.2 +055800 GO TO F-LOG-WRITE-11. IF1164.2 +055900 F-LOG-WRITE-11. IF1164.2 +056000 MOVE "F-LOG-11" TO PAR-NAME. IF1164.2 +056100 PERFORM PRINT-DETAIL. IF1164.2 +056200*****************TEST (a) - COMPLEX TEST**************** IF1164.2 +056300 F-LOG-12. IF1164.2 +056400 MOVE ZERO TO WS-NUM. IF1164.2 +056500 MOVE 1.00032 TO MIN-RANGE. IF1164.2 +056600 MOVE 1.00040 TO MAX-RANGE. IF1164.2 +056700 F-LOG-TEST-12. IF1164.2 +056800 COMPUTE WS-NUM = FUNCTION LOG(E + .001). IF1164.2 +056900 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +057000 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +057100 PERFORM PASS IF1164.2 +057200 ELSE IF1164.2 +057300 MOVE WS-NUM TO COMPUTED-N IF1164.2 +057400 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +057500 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +057600 PERFORM FAIL. IF1164.2 +057700 GO TO F-LOG-WRITE-12. IF1164.2 +057800 F-LOG-DELETE-12. IF1164.2 +057900 PERFORM DE-LETE. IF1164.2 +058000 GO TO F-LOG-WRITE-12. IF1164.2 +058100 F-LOG-WRITE-12. IF1164.2 +058200 MOVE "F-LOG-12" TO PAR-NAME. IF1164.2 +058300 PERFORM PRINT-DETAIL. IF1164.2 +058400*****************TEST (b) - COMPLEX TEST**************** IF1164.2 +058500 F-LOG-13. IF1164.2 +058600 MOVE ZERO TO WS-NUM. IF1164.2 +058700 MOVE -2.30267 TO MIN-RANGE. IF1164.2 +058800 MOVE -2.30249 TO MAX-RANGE. IF1164.2 +058900 F-LOG-TEST-13. IF1164.2 +059000 COMPUTE WS-NUM = FUNCTION LOG(1 / 10). IF1164.2 +059100 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +059200 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +059300 PERFORM PASS IF1164.2 +059400 ELSE IF1164.2 +059500 MOVE WS-NUM TO COMPUTED-N IF1164.2 +059600 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +059700 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +059800 PERFORM FAIL. IF1164.2 +059900 GO TO F-LOG-WRITE-13. IF1164.2 +060000 F-LOG-DELETE-13. IF1164.2 +060100 PERFORM DE-LETE. IF1164.2 +060200 GO TO F-LOG-WRITE-13. IF1164.2 +060300 F-LOG-WRITE-13. IF1164.2 +060400 MOVE "F-LOG-13" TO PAR-NAME. IF1164.2 +060500 PERFORM PRINT-DETAIL. IF1164.2 +060600*****************TEST (c) - COMPLEX TEST**************** IF1164.2 +060700 F-LOG-14. IF1164.2 +060800 MOVE ZERO TO WS-NUM. IF1164.2 +060900 MOVE 0.962479 TO MIN-RANGE. IF1164.2 +061000 MOVE 0.962556 TO MAX-RANGE. IF1164.2 +061100 F-LOG-TEST-14. IF1164.2 +061200 COMPUTE WS-NUM = FUNCTION LOG(E - .1). IF1164.2 +061300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +061400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +061500 PERFORM PASS IF1164.2 +061600 ELSE IF1164.2 +061700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +061800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +061900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +062000 PERFORM FAIL. IF1164.2 +062100 GO TO F-LOG-WRITE-14. IF1164.2 +062200 F-LOG-DELETE-14. IF1164.2 +062300 PERFORM DE-LETE. IF1164.2 +062400 GO TO F-LOG-WRITE-14. IF1164.2 +062500 F-LOG-WRITE-14. IF1164.2 +062600 MOVE "F-LOG-14" TO PAR-NAME. IF1164.2 +062700 PERFORM PRINT-DETAIL. IF1164.2 +062800*****************TEST (d) - COMPLEX TEST**************** IF1164.2 +062900 F-LOG-15. IF1164.2 +063000 MOVE ZERO TO WS-NUM. IF1164.2 +063100 MOVE -0.105364 TO MIN-RANGE. IF1164.2 +063200 MOVE -0.105356 TO MAX-RANGE. IF1164.2 +063300 F-LOG-TEST-15. IF1164.2 +063400 COMPUTE WS-NUM = FUNCTION LOG(1 - .1). IF1164.2 +063500 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +063600 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +063700 PERFORM PASS IF1164.2 +063800 ELSE IF1164.2 +063900 MOVE WS-NUM TO COMPUTED-N IF1164.2 +064000 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +064100 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +064200 PERFORM FAIL. IF1164.2 +064300 GO TO F-LOG-WRITE-15. IF1164.2 +064400 F-LOG-DELETE-15. IF1164.2 +064500 PERFORM DE-LETE. IF1164.2 +064600 GO TO F-LOG-WRITE-15. IF1164.2 +064700 F-LOG-WRITE-15. IF1164.2 +064800 MOVE "F-LOG-15" TO PAR-NAME. IF1164.2 +064900 PERFORM PRINT-DETAIL. IF1164.2 +065000*****************TEST (e) - COMPLEX TEST**************** IF1164.2 +065100 F-LOG-16. IF1164.2 +065200 MOVE ZERO TO WS-NUM. IF1164.2 +065300 MOVE 1.94583 TO MIN-RANGE. IF1164.2 +065400 MOVE 1.94599 TO MAX-RANGE. IF1164.2 +065500 F-LOG-TEST-16. IF1164.2 +065600 COMPUTE WS-NUM = FUNCTION LOG(IND(D - 5)). IF1164.2 +065700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +065800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +065900 PERFORM PASS IF1164.2 +066000 ELSE IF1164.2 +066100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +066200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +066300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +066400 PERFORM FAIL. IF1164.2 +066500 GO TO F-LOG-WRITE-16. IF1164.2 +066600 F-LOG-DELETE-16. IF1164.2 +066700 PERFORM DE-LETE. IF1164.2 +066800 GO TO F-LOG-WRITE-16. IF1164.2 +066900 F-LOG-WRITE-16. IF1164.2 +067000 MOVE "F-LOG-16" TO PAR-NAME. IF1164.2 +067100 PERFORM PRINT-DETAIL. IF1164.2 +067200*****************TEST (f) - COMPLEX TEST**************** IF1164.2 +067300 F-LOG-17. IF1164.2 +067400 MOVE ZERO TO WS-NUM. IF1164.2 +067500 MOVE 2.99561 TO MIN-RANGE. IF1164.2 +067600 MOVE 2.99585 TO MAX-RANGE. IF1164.2 +067700 F-LOG-TEST-17. IF1164.2 +067800 COMPUTE WS-NUM = FUNCTION LOG(2 * 10). IF1164.2 +067900 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +068000 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +068100 PERFORM PASS IF1164.2 +068200 ELSE IF1164.2 +068300 MOVE WS-NUM TO COMPUTED-N IF1164.2 +068400 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +068500 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +068600 PERFORM FAIL. IF1164.2 +068700 GO TO F-LOG-WRITE-17. IF1164.2 +068800 F-LOG-DELETE-17. IF1164.2 +068900 PERFORM DE-LETE. IF1164.2 +069000 GO TO F-LOG-WRITE-17. IF1164.2 +069100 F-LOG-WRITE-17. IF1164.2 +069200 MOVE "F-LOG-17" TO PAR-NAME. IF1164.2 +069300 PERFORM PRINT-DETAIL. IF1164.2 +069400*****************TEST (g) - COMPLEX TEST**************** IF1164.2 +069500 F-LOG-18. IF1164.2 +069600 MOVE ZERO TO WS-NUM. IF1164.2 +069700 MOVE 1.09857 TO MIN-RANGE. IF1164.2 +069800 MOVE 1.09865 TO MAX-RANGE. IF1164.2 +069900 F-LOG-TEST-18. IF1164.2 +070000 COMPUTE WS-NUM = FUNCTION LOG(B + C). IF1164.2 +070100 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +070200 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +070300 PERFORM PASS IF1164.2 +070400 ELSE IF1164.2 +070500 MOVE WS-NUM TO COMPUTED-N IF1164.2 +070600 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +070700 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +070800 PERFORM FAIL. IF1164.2 +070900 GO TO F-LOG-WRITE-18. IF1164.2 +071000 F-LOG-DELETE-18. IF1164.2 +071100 PERFORM DE-LETE. IF1164.2 +071200 GO TO F-LOG-WRITE-18. IF1164.2 +071300 F-LOG-WRITE-18. IF1164.2 +071400 MOVE "F-LOG-18" TO PAR-NAME. IF1164.2 +071500 PERFORM PRINT-DETAIL. IF1164.2 +071600*****************TEST (h) - COMPLEX TEST**************** IF1164.2 +071700 F-LOG-19. IF1164.2 +071800 MOVE ZERO TO WS-NUM. IF1164.2 +071900 MOVE 0.632497 TO MIN-RANGE. IF1164.2 +072000 MOVE 0.632547 TO MAX-RANGE. IF1164.2 +072100 F-LOG-TEST-19. IF1164.2 +072200 COMPUTE WS-NUM = FUNCTION LOG(3.2 / 1.7). IF1164.2 +072300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +072400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +072500 PERFORM PASS IF1164.2 +072600 ELSE IF1164.2 +072700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +072800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +072900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +073000 PERFORM FAIL. IF1164.2 +073100 GO TO F-LOG-WRITE-19. IF1164.2 +073200 F-LOG-DELETE-19. IF1164.2 +073300 PERFORM DE-LETE. IF1164.2 +073400 GO TO F-LOG-WRITE-19. IF1164.2 +073500 F-LOG-WRITE-19. IF1164.2 +073600 MOVE "F-LOG-19" TO PAR-NAME. IF1164.2 +073700 PERFORM PRINT-DETAIL. IF1164.2 +073800*****************TEST (i) - COMPLEX TEST**************** IF1164.2 +073900 F-LOG-20. IF1164.2 +074000 MOVE ZERO TO WS-NUM. IF1164.2 +074100 MOVE 2.08164 TO MIN-RANGE. IF1164.2 +074200 MOVE 2.08180 TO MAX-RANGE. IF1164.2 +074300 F-LOG-TEST-20. IF1164.2 +074400 COMPUTE WS-NUM = FUNCTION LOG(E - H). IF1164.2 +074500 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +074600 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +074700 PERFORM PASS IF1164.2 +074800 ELSE IF1164.2 +074900 MOVE WS-NUM TO COMPUTED-N IF1164.2 +075000 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +075100 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +075200 PERFORM FAIL. IF1164.2 +075300 GO TO F-LOG-WRITE-20. IF1164.2 +075400 F-LOG-DELETE-20. IF1164.2 +075500 PERFORM DE-LETE. IF1164.2 +075600 GO TO F-LOG-WRITE-20. IF1164.2 +075700 F-LOG-WRITE-20. IF1164.2 +075800 MOVE "F-LOG-20" TO PAR-NAME. IF1164.2 +075900 PERFORM PRINT-DETAIL. IF1164.2 +076000*****************TEST (j) - COMPLEX TEST**************** IF1164.2 +076100 F-LOG-21. IF1164.2 +076200 MOVE ZERO TO WS-NUM. IF1164.2 +076300 MOVE 1.60937 TO MIN-RANGE. IF1164.2 +076400 MOVE 1.60949 TO MAX-RANGE. IF1164.2 +076500 F-LOG-TEST-21. IF1164.2 +076600 COMPUTE WS-NUM = FUNCTION LOG(B - 2). IF1164.2 +076700 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +076800 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +076900 PERFORM PASS IF1164.2 +077000 ELSE IF1164.2 +077100 MOVE WS-NUM TO COMPUTED-N IF1164.2 +077200 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +077300 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +077400 PERFORM FAIL. IF1164.2 +077500 GO TO F-LOG-WRITE-21. IF1164.2 +077600 F-LOG-DELETE-21. IF1164.2 +077700 PERFORM DE-LETE. IF1164.2 +077800 GO TO F-LOG-WRITE-21. IF1164.2 +077900 F-LOG-WRITE-21. IF1164.2 +078000 MOVE "F-LOG-21" TO PAR-NAME. IF1164.2 +078100 PERFORM PRINT-DETAIL. IF1164.2 +078200*****************TEST (k) - COMPLEX TEST**************** IF1164.2 +078300 F-LOG-22. IF1164.2 +078400 MOVE ZERO TO WS-NUM. IF1164.2 +078500 MOVE 1.48569 TO MIN-RANGE. IF1164.2 +078600 MOVE 1.48581 TO MAX-RANGE. IF1164.2 +078700 F-LOG-TEST-22. IF1164.2 +078800 COMPUTE WS-NUM = FUNCTION LOG(E + 1.7). IF1164.2 +078900 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +079000 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +079100 PERFORM PASS IF1164.2 +079200 ELSE IF1164.2 +079300 MOVE WS-NUM TO COMPUTED-N IF1164.2 +079400 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +079500 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +079600 PERFORM FAIL. IF1164.2 +079700 GO TO F-LOG-WRITE-22. IF1164.2 +079800 F-LOG-DELETE-22. IF1164.2 +079900 PERFORM DE-LETE. IF1164.2 +080000 GO TO F-LOG-WRITE-22. IF1164.2 +080100 F-LOG-WRITE-22. IF1164.2 +080200 MOVE "F-LOG-22" TO PAR-NAME. IF1164.2 +080300 PERFORM PRINT-DETAIL. IF1164.2 +080400*****************TEST (l) - COMPLEX TEST**************** IF1164.2 +080500 F-LOG-23. IF1164.2 +080600 MOVE ZERO TO WS-NUM. IF1164.2 +080700 MOVE 4.99980 TO MIN-RANGE. IF1164.2 +080800 MOVE 5.00002 TO MAX-RANGE. IF1164.2 +080900 F-LOG-TEST-23. IF1164.2 +081000 COMPUTE WS-NUM = FUNCTION LOG(E) + 4. IF1164.2 +081100 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +081200 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +081300 PERFORM PASS IF1164.2 +081400 ELSE IF1164.2 +081500 MOVE WS-NUM TO COMPUTED-N IF1164.2 +081600 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +081700 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +081800 PERFORM FAIL. IF1164.2 +081900 GO TO F-LOG-WRITE-23. IF1164.2 +082000 F-LOG-DELETE-23. IF1164.2 +082100 PERFORM DE-LETE. IF1164.2 +082200 GO TO F-LOG-WRITE-23. IF1164.2 +082300 F-LOG-WRITE-23. IF1164.2 +082400 MOVE "F-LOG-23" TO PAR-NAME. IF1164.2 +082500 PERFORM PRINT-DETAIL. IF1164.2 +082600*****************TEST (m) - COMPLEX TEST**************** IF1164.2 +082700 F-LOG-24. IF1164.2 +082800 MOVE ZERO TO WS-NUM. IF1164.2 +082900 MOVE 0.665702 TO MIN-RANGE. IF1164.2 +083000 MOVE 0.665756 TO MAX-RANGE. IF1164.2 +083100 F-LOG-TEST-24. IF1164.2 +083200 COMPUTE WS-NUM = FUNCTION LOG(FUNCTION LOG(B)). IF1164.2 +083300 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +083400 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +083500 PERFORM PASS IF1164.2 +083600 ELSE IF1164.2 +083700 MOVE WS-NUM TO COMPUTED-N IF1164.2 +083800 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +083900 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +084000 PERFORM FAIL. IF1164.2 +084100 GO TO F-LOG-WRITE-24. IF1164.2 +084200 F-LOG-DELETE-24. IF1164.2 +084300 PERFORM DE-LETE. IF1164.2 +084400 GO TO F-LOG-WRITE-24. IF1164.2 +084500 F-LOG-WRITE-24. IF1164.2 +084600 MOVE "F-LOG-24" TO PAR-NAME. IF1164.2 +084700 PERFORM PRINT-DETAIL. IF1164.2 +084800*****************TEST (n) - COMPLEX TEST**************** IF1164.2 +084900 F-LOG-25. IF1164.2 +085000 MOVE ZERO TO WS-NUM. IF1164.2 +085100 MOVE 1.69307 TO MIN-RANGE. IF1164.2 +085200 MOVE 1.69321 TO MAX-RANGE. IF1164.2 +085300 F-LOG-TEST-25. IF1164.2 +085400 COMPUTE WS-NUM = FUNCTION LOG(E) + IF1164.2 +085500 FUNCTION LOG(2). IF1164.2 +085600 IF (WS-NUM >= MIN-RANGE) AND IF1164.2 +085700 (WS-NUM <= MAX-RANGE) THEN IF1164.2 +085800 PERFORM PASS IF1164.2 +085900 ELSE IF1164.2 +086000 MOVE WS-NUM TO COMPUTED-N IF1164.2 +086100 MOVE MIN-RANGE TO CORRECT-MIN IF1164.2 +086200 MOVE MAX-RANGE TO CORRECT-MAX IF1164.2 +086300 PERFORM FAIL. IF1164.2 +086400 GO TO F-LOG-WRITE-25. IF1164.2 +086500 F-LOG-DELETE-25. IF1164.2 +086600 PERFORM DE-LETE. IF1164.2 +086700 GO TO F-LOG-WRITE-25. IF1164.2 +086800 F-LOG-WRITE-25. IF1164.2 +086900 MOVE "F-LOG-25" TO PAR-NAME. IF1164.2 +087000 PERFORM PRINT-DETAIL. IF1164.2 +087100*****************SPECIAL PERFORM TEST********************** IF1164.2 +087200 F-LOG-26. IF1164.2 +087300 MOVE ZERO TO WS-NUM. IF1164.2 +087400 PERFORM F-LOG-TEST-26 IF1164.2 +087500 UNTIL FUNCTION LOG(ARG1) > 1. IF1164.2 +087600 PERFORM PASS. IF1164.2 +087700 GO TO F-LOG-WRITE-26. IF1164.2 +087800 F-LOG-TEST-26. IF1164.2 +087900 COMPUTE ARG1 = ARG1 + 0.2. IF1164.2 +088000 F-LOG-DELETE-26. IF1164.2 +088100 PERFORM DE-LETE. IF1164.2 +088200 GO TO F-LOG-WRITE-26. IF1164.2 +088300 F-LOG-WRITE-26. IF1164.2 +088400 MOVE "F-LOG-26" TO PAR-NAME. IF1164.2 +088500 PERFORM PRINT-DETAIL. IF1164.2 +088600********************END OF TESTS*************** IF1164.2 +088700 CCVS-EXIT SECTION. IF1164.2 +088800 CCVS-999999. IF1164.2 +088900 GO TO CLOSE-FILES. IF1164.2 diff --git a/tests/cobol85/IF/IF117A.CBL b/tests/cobol85/IF/IF117A.CBL new file mode 100755 index 00000000..9cffadae --- /dev/null +++ b/tests/cobol85/IF/IF117A.CBL @@ -0,0 +1,1037 @@ +000100 IDENTIFICATION DIVISION. IF1174.2 +000200 PROGRAM-ID. IF1174.2 +000300 IF117A. IF1174.2 +000400 IF1174.2 +000500*********************************************************** IF1174.2 +000600* * IF1174.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1174.2 +000800* It contains tests for the Intrinsic Function LOG10. * IF1174.2 +000900* * IF1174.2 +001000*********************************************************** IF1174.2 +001100 ENVIRONMENT DIVISION. IF1174.2 +001200 CONFIGURATION SECTION. IF1174.2 +001300 SOURCE-COMPUTER. IF1174.2 +001400 Linux. IF1174.2 +001500 OBJECT-COMPUTER. IF1174.2 +001600 Linux. IF1174.2 +001700 INPUT-OUTPUT SECTION. IF1174.2 +001800 FILE-CONTROL. IF1174.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1174.2 +002000 "report.log". IF1174.2 +002100 DATA DIVISION. IF1174.2 +002200 FILE SECTION. IF1174.2 +002300 FD PRINT-FILE. IF1174.2 +002400 01 PRINT-REC PICTURE X(120). IF1174.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1174.2 +002600 WORKING-STORAGE SECTION. IF1174.2 +002700*********************************************************** IF1174.2 +002800* Variables specific to the Intrinsic Function Test IF117A* IF1174.2 +002900*********************************************************** IF1174.2 +003000 01 A PIC S9(10) VALUE 600000. IF1174.2 +003100 01 B PIC S9(10) VALUE 7. IF1174.2 +003200 01 C PIC S9(10) VALUE -4. IF1174.2 +003300 01 D PIC S9(10) VALUE 10. IF1174.2 +003400 01 E PIC S9(1)V9(9) VALUE 2.718281828. IF1174.2 +003500 01 F PIC S9(5)V9(5) VALUE 32000.8. IF1174.2 +003600 01 G PIC S9(5)V9(5) VALUE .00002. IF1174.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1174.2 +003800 01 ARG1 PIC S9(5)V9(5) VALUE 10.00. IF1174.2 +003900 01 ARR VALUE "40537". IF1174.2 +004000 02 IND OCCURS 5 TIMES PIC 9. IF1174.2 +004100 01 TEMP PIC S9(10). IF1174.2 +004200 01 WS-NUM PIC S9(5)V9(6). IF1174.2 +004300 01 MIN-RANGE PIC S9(5)V9(7). IF1174.2 +004400 01 MAX-RANGE PIC S9(5)V9(7). IF1174.2 +004500* IF1174.2 +004600********************************************************** IF1174.2 +004700* IF1174.2 +004800 01 TEST-RESULTS. IF1174.2 +004900 02 FILLER PIC X VALUE SPACE. IF1174.2 +005000 02 FEATURE PIC X(20) VALUE SPACE. IF1174.2 +005100 02 FILLER PIC X VALUE SPACE. IF1174.2 +005200 02 P-OR-F PIC X(5) VALUE SPACE. IF1174.2 +005300 02 FILLER PIC X VALUE SPACE. IF1174.2 +005400 02 PAR-NAME. IF1174.2 +005500 03 FILLER PIC X(19) VALUE SPACE. IF1174.2 +005600 03 PARDOT-X PIC X VALUE SPACE. IF1174.2 +005700 03 DOTVALUE PIC 99 VALUE ZERO. IF1174.2 +005800 02 FILLER PIC X(8) VALUE SPACE. IF1174.2 +005900 02 RE-MARK PIC X(61). IF1174.2 +006000 01 TEST-COMPUTED. IF1174.2 +006100 02 FILLER PIC X(30) VALUE SPACE. IF1174.2 +006200 02 FILLER PIC X(17) VALUE IF1174.2 +006300 " COMPUTED=". IF1174.2 +006400 02 COMPUTED-X. IF1174.2 +006500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1174.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A IF1174.2 +006700 PIC -9(9).9(9). IF1174.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1174.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1174.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1174.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. IF1174.2 +007200 04 COMPUTED-18V0 PIC -9(18). IF1174.2 +007300 04 FILLER PIC X. IF1174.2 +007400 03 FILLER PIC X(50) VALUE SPACE. IF1174.2 +007500 01 TEST-CORRECT. IF1174.2 +007600 02 FILLER PIC X(30) VALUE SPACE. IF1174.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1174.2 +007800 02 CORRECT-X. IF1174.2 +007900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1174.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1174.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1174.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1174.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1174.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. IF1174.2 +008500 04 CORRECT-18V0 PIC -9(18). IF1174.2 +008600 04 FILLER PIC X. IF1174.2 +008700 03 FILLER PIC X(2) VALUE SPACE. IF1174.2 +008800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1174.2 +008900 01 TEST-CORRECT-MIN. IF1174.2 +009000 02 FILLER PIC X(30) VALUE SPACE. IF1174.2 +009100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1174.2 +009200 02 CORRECTMI-X. IF1174.2 +009300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1174.2 +009400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1174.2 +009500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1174.2 +009600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1174.2 +009700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1174.2 +009800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1174.2 +009900 04 CORRECTMI-18V0 PIC -9(18). IF1174.2 +010000 04 FILLER PIC X. IF1174.2 +010100 03 FILLER PIC X(2) VALUE SPACE. IF1174.2 +010200 03 FILLER PIC X(48) VALUE SPACE. IF1174.2 +010300 01 TEST-CORRECT-MAX. IF1174.2 +010400 02 FILLER PIC X(30) VALUE SPACE. IF1174.2 +010500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1174.2 +010600 02 CORRECTMA-X. IF1174.2 +010700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1174.2 +010800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1174.2 +010900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1174.2 +011000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1174.2 +011100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1174.2 +011200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1174.2 +011300 04 CORRECTMA-18V0 PIC -9(18). IF1174.2 +011400 04 FILLER PIC X. IF1174.2 +011500 03 FILLER PIC X(2) VALUE SPACE. IF1174.2 +011600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1174.2 +011700 01 CCVS-C-1. IF1174.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1174.2 +011900- "SS PARAGRAPH-NAME IF1174.2 +012000- " REMARKS". IF1174.2 +012100 02 FILLER PIC X(20) VALUE SPACE. IF1174.2 +012200 01 CCVS-C-2. IF1174.2 +012300 02 FILLER PIC X VALUE SPACE. IF1174.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". IF1174.2 +012500 02 FILLER PIC X(15) VALUE SPACE. IF1174.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". IF1174.2 +012700 02 FILLER PIC X(94) VALUE SPACE. IF1174.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1174.2 +012900 01 REC-CT PIC 99 VALUE ZERO. IF1174.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1174.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1174.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1174.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1174.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1174.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1174.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1174.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1174.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1174.2 +013900 01 CCVS-H-1. IF1174.2 +014000 02 FILLER PIC X(39) VALUE SPACES. IF1174.2 +014100 02 FILLER PIC X(42) VALUE IF1174.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1174.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IF1174.2 +014400 01 CCVS-H-2A. IF1174.2 +014500 02 FILLER PIC X(40) VALUE SPACE. IF1174.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1174.2 +014700 02 FILLER PIC XXXX VALUE IF1174.2 +014800 "4.2 ". IF1174.2 +014900 02 FILLER PIC X(28) VALUE IF1174.2 +015000 " COPY - NOT FOR DISTRIBUTION". IF1174.2 +015100 02 FILLER PIC X(41) VALUE SPACE. IF1174.2 +015200 IF1174.2 +015300 01 CCVS-H-2B. IF1174.2 +015400 02 FILLER PIC X(15) VALUE IF1174.2 +015500 "TEST RESULT OF ". IF1174.2 +015600 02 TEST-ID PIC X(9). IF1174.2 +015700 02 FILLER PIC X(4) VALUE IF1174.2 +015800 " IN ". IF1174.2 +015900 02 FILLER PIC X(12) VALUE IF1174.2 +016000 " HIGH ". IF1174.2 +016100 02 FILLER PIC X(22) VALUE IF1174.2 +016200 " LEVEL VALIDATION FOR ". IF1174.2 +016300 02 FILLER PIC X(58) VALUE IF1174.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1174.2 +016500 01 CCVS-H-3. IF1174.2 +016600 02 FILLER PIC X(34) VALUE IF1174.2 +016700 " FOR OFFICIAL USE ONLY ". IF1174.2 +016800 02 FILLER PIC X(58) VALUE IF1174.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1174.2 +017000 02 FILLER PIC X(28) VALUE IF1174.2 +017100 " COPYRIGHT 1985 ". IF1174.2 +017200 01 CCVS-E-1. IF1174.2 +017300 02 FILLER PIC X(52) VALUE SPACE. IF1174.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1174.2 +017500 02 ID-AGAIN PIC X(9). IF1174.2 +017600 02 FILLER PIC X(45) VALUE SPACES. IF1174.2 +017700 01 CCVS-E-2. IF1174.2 +017800 02 FILLER PIC X(31) VALUE SPACE. IF1174.2 +017900 02 FILLER PIC X(21) VALUE SPACE. IF1174.2 +018000 02 CCVS-E-2-2. IF1174.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1174.2 +018200 03 FILLER PIC X VALUE SPACE. IF1174.2 +018300 03 ENDER-DESC PIC X(44) VALUE IF1174.2 +018400 "ERRORS ENCOUNTERED". IF1174.2 +018500 01 CCVS-E-3. IF1174.2 +018600 02 FILLER PIC X(22) VALUE IF1174.2 +018700 " FOR OFFICIAL USE ONLY". IF1174.2 +018800 02 FILLER PIC X(12) VALUE SPACE. IF1174.2 +018900 02 FILLER PIC X(58) VALUE IF1174.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1174.2 +019100 02 FILLER PIC X(13) VALUE SPACE. IF1174.2 +019200 02 FILLER PIC X(15) VALUE IF1174.2 +019300 " COPYRIGHT 1985". IF1174.2 +019400 01 CCVS-E-4. IF1174.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1174.2 +019600 02 FILLER PIC X(4) VALUE " OF ". IF1174.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1174.2 +019800 02 FILLER PIC X(40) VALUE IF1174.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1174.2 +020000 01 XXINFO. IF1174.2 +020100 02 FILLER PIC X(19) VALUE IF1174.2 +020200 "*** INFORMATION ***". IF1174.2 +020300 02 INFO-TEXT. IF1174.2 +020400 04 FILLER PIC X(8) VALUE SPACE. IF1174.2 +020500 04 XXCOMPUTED PIC X(20). IF1174.2 +020600 04 FILLER PIC X(5) VALUE SPACE. IF1174.2 +020700 04 XXCORRECT PIC X(20). IF1174.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). IF1174.2 +020900 01 HYPHEN-LINE. IF1174.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. IF1174.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************IF1174.2 +021200- "*****************************************". IF1174.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************IF1174.2 +021400- "******************************". IF1174.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE IF1174.2 +021600 "IF117A". IF1174.2 +021700 PROCEDURE DIVISION. IF1174.2 +021800 CCVS1 SECTION. IF1174.2 +021900 OPEN-FILES. IF1174.2 +022000 OPEN OUTPUT PRINT-FILE. IF1174.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1174.2 +022200 MOVE SPACE TO TEST-RESULTS. IF1174.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1174.2 +022400 GO TO CCVS1-EXIT. IF1174.2 +022500 CLOSE-FILES. IF1174.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1174.2 +022700 TERMINATE-CCVS. IF1174.2 +022800 STOP RUN. IF1174.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1174.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1174.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1174.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1174.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. IF1174.2 +023400 PRINT-DETAIL. IF1174.2 +023500 IF REC-CT NOT EQUAL TO ZERO IF1174.2 +023600 MOVE "." TO PARDOT-X IF1174.2 +023700 MOVE REC-CT TO DOTVALUE. IF1174.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1174.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1174.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1174.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1174.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1174.2 +024300 MOVE SPACE TO CORRECT-X. IF1174.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1174.2 +024500 MOVE SPACE TO RE-MARK. IF1174.2 +024600 HEAD-ROUTINE. IF1174.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1174.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1174.2 +025100 COLUMN-NAMES-ROUTINE. IF1174.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +025500 END-ROUTINE. IF1174.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1174.2 +025700 END-RTN-EXIT. IF1174.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +025900 END-ROUTINE-1. IF1174.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1174.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1174.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. IF1174.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1174.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1174.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1174.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1174.2 +026700 END-ROUTINE-12. IF1174.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1174.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1174.2 +027000 MOVE "NO " TO ERROR-TOTAL IF1174.2 +027100 ELSE IF1174.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1174.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1174.2 +027400 PERFORM WRITE-LINE. IF1174.2 +027500 END-ROUTINE-13. IF1174.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1174.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE IF1174.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1174.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1174.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO IF1174.2 +028200 MOVE "NO " TO ERROR-TOTAL IF1174.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1174.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1174.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1174.2 +028700 WRITE-LINE. IF1174.2 +028800 ADD 1 TO RECORD-COUNT. IF1174.2 +028900 IF RECORD-COUNT GREATER 42 IF1174.2 +029000 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1174.2 +029100 MOVE SPACE TO DUMMY-RECORD IF1174.2 +029200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1174.2 +029300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1174.2 +029400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1174.2 +029500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1174.2 +029600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1174.2 +029700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1174.2 +029800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1174.2 +029900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1174.2 +030000 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1174.2 +030100 MOVE ZERO TO RECORD-COUNT. IF1174.2 +030200 PERFORM WRT-LN. IF1174.2 +030300 WRT-LN. IF1174.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1174.2 +030500 MOVE SPACE TO DUMMY-RECORD. IF1174.2 +030600 BLANK-LINE-PRINT. IF1174.2 +030700 PERFORM WRT-LN. IF1174.2 +030800 FAIL-ROUTINE. IF1174.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE IF1174.2 +031000 GO TO FAIL-ROUTINE-WRITE. IF1174.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1174.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1174.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1174.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1174.2 +031600 GO TO FAIL-ROUTINE-EX. IF1174.2 +031700 FAIL-ROUTINE-WRITE. IF1174.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1174.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1174.2 +032000 CORMA-ANSI-REFERENCE. IF1174.2 +032100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1174.2 +032200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1174.2 +032300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1174.2 +032400 ELSE IF1174.2 +032500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1174.2 +032600 PERFORM WRITE-LINE. IF1174.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1174.2 +032800 FAIL-ROUTINE-EX. EXIT. IF1174.2 +032900 BAIL-OUT. IF1174.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1174.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1174.2 +033200 BAIL-OUT-WRITE. IF1174.2 +033300 MOVE CORRECT-A TO XXCORRECT. IF1174.2 +033400 MOVE COMPUTED-A TO XXCOMPUTED. IF1174.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1174.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1174.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1174.2 +033800 BAIL-OUT-EX. EXIT. IF1174.2 +033900 CCVS1-EXIT. IF1174.2 +034000 EXIT. IF1174.2 +034100******************************************************** IF1174.2 +034200* * IF1174.2 +034300* Intrinsic Function Tests IF117A - LOG10 * IF1174.2 +034400* * IF1174.2 +034500******************************************************** IF1174.2 +034600 SECT-IF117A SECTION. IF1174.2 +034700 F-LOG10-INFO. IF1174.2 +034800 MOVE "See ref. A-49 2.21" TO ANSI-REFERENCE. IF1174.2 +034900 MOVE "LOG10 Function" TO FEATURE. IF1174.2 +035000*****************TEST (a) - SIMPLE TEST***************** IF1174.2 +035100 F-LOG10-01. IF1174.2 +035200 MOVE ZERO TO WS-NUM. IF1174.2 +035300 MOVE -0.000020 TO MIN-RANGE. IF1174.2 +035400 MOVE 0.000020 TO MAX-RANGE. IF1174.2 +035500 F-LOG10-TEST-01. IF1174.2 +035600 COMPUTE WS-NUM = FUNCTION LOG10(1). IF1174.2 +035700 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +035800 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +035900 PERFORM PASS IF1174.2 +036000 ELSE IF1174.2 +036100 MOVE WS-NUM TO COMPUTED-N IF1174.2 +036200 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +036300 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +036400 PERFORM FAIL. IF1174.2 +036500 GO TO F-LOG10-WRITE-01. IF1174.2 +036600 F-LOG10-DELETE-01. IF1174.2 +036700 PERFORM DE-LETE. IF1174.2 +036800 GO TO F-LOG10-WRITE-01. IF1174.2 +036900 F-LOG10-WRITE-01. IF1174.2 +037000 MOVE "F-LOG10-01" TO PAR-NAME. IF1174.2 +037100 PERFORM PRINT-DETAIL. IF1174.2 +037200*****************TEST (b) - SIMPLE TEST***************** IF1174.2 +037300 F-LOG10-02. IF1174.2 +037400 EVALUATE FUNCTION LOG10(10) IF1174.2 +037500 WHEN 0.999980 THRU 1.000020 IF1174.2 +037600 PERFORM PASS IF1174.2 +037700 WHEN OTHER IF1174.2 +037800 PERFORM FAIL. IF1174.2 +037900 GO TO F-LOG10-WRITE-02. IF1174.2 +038000 F-LOG10-DELETE-02. IF1174.2 +038100 PERFORM DE-LETE. IF1174.2 +038200 GO TO F-LOG10-WRITE-02. IF1174.2 +038300 F-LOG10-WRITE-02. IF1174.2 +038400 MOVE "F-LOG10-02" TO PAR-NAME. IF1174.2 +038500 PERFORM PRINT-DETAIL. IF1174.2 +038600*****************TEST (c) - SIMPLE TEST***************** IF1174.2 +038700 F-LOG10-03. IF1174.2 +038800 MOVE -2.00004 TO MIN-RANGE. IF1174.2 +038900 MOVE -1.99996 TO MAX-RANGE. IF1174.2 +039000 F-LOG10-TEST-03. IF1174.2 +039100 IF (FUNCTION LOG10(.01) >= MIN-RANGE) AND IF1174.2 +039200 (FUNCTION LOG10(.01) <= MAX-RANGE) THEN IF1174.2 +039300 PERFORM PASS IF1174.2 +039400 ELSE IF1174.2 +039500 PERFORM FAIL. IF1174.2 +039600 GO TO F-LOG10-WRITE-03. IF1174.2 +039700 F-LOG10-DELETE-03. IF1174.2 +039800 PERFORM DE-LETE. IF1174.2 +039900 GO TO F-LOG10-WRITE-03. IF1174.2 +040000 F-LOG10-WRITE-03. IF1174.2 +040100 MOVE "F-LOG10-03" TO PAR-NAME. IF1174.2 +040200 PERFORM PRINT-DETAIL. IF1174.2 +040300*****************TEST (d) - SIMPLE TEST***************** IF1174.2 +040400 F-LOG10-04. IF1174.2 +040500 MOVE ZERO TO WS-NUM. IF1174.2 +040600 MOVE -3.00006 TO MIN-RANGE. IF1174.2 +040700 MOVE -2.99994 TO MAX-RANGE. IF1174.2 +040800 F-LOG10-TEST-04. IF1174.2 +040900 COMPUTE WS-NUM = FUNCTION LOG10(.001). IF1174.2 +041000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +041100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +041200 PERFORM PASS IF1174.2 +041300 ELSE IF1174.2 +041400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +041500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +041600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +041700 PERFORM FAIL. IF1174.2 +041800 GO TO F-LOG10-WRITE-04. IF1174.2 +041900 F-LOG10-DELETE-04. IF1174.2 +042000 PERFORM DE-LETE. IF1174.2 +042100 GO TO F-LOG10-WRITE-04. IF1174.2 +042200 F-LOG10-WRITE-04. IF1174.2 +042300 MOVE "F-LOG10-04" TO PAR-NAME. IF1174.2 +042400 PERFORM PRINT-DETAIL. IF1174.2 +042500*****************TEST (e) - SIMPLE TEST***************** IF1174.2 +042600 F-LOG10-05. IF1174.2 +042700 MOVE ZERO TO WS-NUM. IF1174.2 +042800 MOVE 1.99996 TO MIN-RANGE. IF1174.2 +042900 MOVE 2.00004 TO MAX-RANGE. IF1174.2 +043000 F-LOG10-TEST-05. IF1174.2 +043100 COMPUTE WS-NUM = FUNCTION LOG10(100). IF1174.2 +043200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +043300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +043400 PERFORM PASS IF1174.2 +043500 ELSE IF1174.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +043700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +043800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +043900 PERFORM FAIL. IF1174.2 +044000 GO TO F-LOG10-WRITE-05. IF1174.2 +044100 F-LOG10-DELETE-05. IF1174.2 +044200 PERFORM DE-LETE. IF1174.2 +044300 GO TO F-LOG10-WRITE-05. IF1174.2 +044400 F-LOG10-WRITE-05. IF1174.2 +044500 MOVE "F-LOG10-05" TO PAR-NAME. IF1174.2 +044600 PERFORM PRINT-DETAIL. IF1174.2 +044700*****************TEST (f) - SIMPLE TEST***************** IF1174.2 +044800 F-LOG10-06. IF1174.2 +044900 MOVE ZERO TO WS-NUM. IF1174.2 +045000 MOVE 0.999936 TO MIN-RANGE. IF1174.2 +045100 MOVE 0.999976 TO MAX-RANGE. IF1174.2 +045200 F-LOG10-TEST-06. IF1174.2 +045300 COMPUTE WS-NUM = FUNCTION LOG10(9.999). IF1174.2 +045400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +045500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +045600 PERFORM PASS IF1174.2 +045700 ELSE IF1174.2 +045800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +045900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +046000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +046100 PERFORM FAIL. IF1174.2 +046200 GO TO F-LOG10-WRITE-06. IF1174.2 +046300 F-LOG10-DELETE-06. IF1174.2 +046400 PERFORM DE-LETE. IF1174.2 +046500 GO TO F-LOG10-WRITE-06. IF1174.2 +046600 F-LOG10-WRITE-06. IF1174.2 +046700 MOVE "F-LOG10-06" TO PAR-NAME. IF1174.2 +046800 PERFORM PRINT-DETAIL. IF1174.2 +046900*****************TEST (h) - SIMPLE TEST***************** IF1174.2 +047000 F-LOG10-08. IF1174.2 +047100 MOVE ZERO TO WS-NUM. IF1174.2 +047200 MOVE -2.04579 TO MIN-RANGE. IF1174.2 +047300 MOVE -2.04571 TO MAX-RANGE. IF1174.2 +047400 F-LOG10-TEST-08. IF1174.2 +047500 COMPUTE WS-NUM = FUNCTION LOG10(.009). IF1174.2 +047600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +047700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +047800 PERFORM PASS IF1174.2 +047900 ELSE IF1174.2 +048000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +048100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +048200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +048300 PERFORM FAIL. IF1174.2 +048400 GO TO F-LOG10-WRITE-08. IF1174.2 +048500 F-LOG10-DELETE-08. IF1174.2 +048600 PERFORM DE-LETE. IF1174.2 +048700 GO TO F-LOG10-WRITE-08. IF1174.2 +048800 F-LOG10-WRITE-08. IF1174.2 +048900 MOVE "F-LOG10-08" TO PAR-NAME. IF1174.2 +049000 PERFORM PRINT-DETAIL. IF1174.2 +049100*****************TEST (i) - SIMPLE TEST***************** IF1174.2 +049200 F-LOG10-09. IF1174.2 +049300 MOVE ZERO TO WS-NUM. IF1174.2 +049400 MOVE 2.00039 TO MIN-RANGE. IF1174.2 +049500 MOVE 2.00047 TO MAX-RANGE. IF1174.2 +049600 F-LOG10-TEST-09. IF1174.2 +049700 COMPUTE WS-NUM = FUNCTION LOG10(100.1). IF1174.2 +049800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +049900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +050000 PERFORM PASS IF1174.2 +050100 ELSE IF1174.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +050300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +050400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +050500 PERFORM FAIL. IF1174.2 +050600 GO TO F-LOG10-WRITE-09. IF1174.2 +050700 F-LOG10-DELETE-09. IF1174.2 +050800 PERFORM DE-LETE. IF1174.2 +050900 GO TO F-LOG10-WRITE-09. IF1174.2 +051000 F-LOG10-WRITE-09. IF1174.2 +051100 MOVE "F-LOG10-09" TO PAR-NAME. IF1174.2 +051200 PERFORM PRINT-DETAIL. IF1174.2 +051300*****************TEST (j) - SIMPLE TEST***************** IF1174.2 +051400 F-LOG10-10. IF1174.2 +051500 MOVE ZERO TO WS-NUM. IF1174.2 +051600 MOVE 3.99992 TO MIN-RANGE. IF1174.2 +051700 MOVE 4.00008 TO MAX-RANGE. IF1174.2 +051800 F-LOG10-TEST-10. IF1174.2 +051900 COMPUTE WS-NUM = FUNCTION LOG10(10000). IF1174.2 +052000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +052100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +052200 PERFORM PASS IF1174.2 +052300 ELSE IF1174.2 +052400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +052500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +052600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +052700 PERFORM FAIL. IF1174.2 +052800 GO TO F-LOG10-WRITE-10. IF1174.2 +052900 F-LOG10-DELETE-10. IF1174.2 +053000 PERFORM DE-LETE. IF1174.2 +053100 GO TO F-LOG10-WRITE-10. IF1174.2 +053200 F-LOG10-WRITE-10. IF1174.2 +053300 MOVE "F-LOG10-10" TO PAR-NAME. IF1174.2 +053400 PERFORM PRINT-DETAIL. IF1174.2 +053500*****************TEST (k) - SIMPLE TEST***************** IF1174.2 +053600 F-LOG10-11. IF1174.2 +053700 MOVE ZERO TO WS-NUM. IF1174.2 +053800 MOVE 3.48129 TO MIN-RANGE. IF1174.2 +053900 MOVE 3.48143 TO MAX-RANGE. IF1174.2 +054000 F-LOG10-TEST-11. IF1174.2 +054100 COMPUTE WS-NUM = FUNCTION LOG10(3029.48). IF1174.2 +054200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +054300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +054400 PERFORM PASS IF1174.2 +054500 ELSE IF1174.2 +054600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +054700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +054800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +054900 PERFORM FAIL. IF1174.2 +055000 GO TO F-LOG10-WRITE-11. IF1174.2 +055100 F-LOG10-DELETE-11. IF1174.2 +055200 PERFORM DE-LETE. IF1174.2 +055300 GO TO F-LOG10-WRITE-11. IF1174.2 +055400 F-LOG10-WRITE-11. IF1174.2 +055500 MOVE "F-LOG10-11" TO PAR-NAME. IF1174.2 +055600 PERFORM PRINT-DETAIL. IF1174.2 +055700*****************TEST (l) - SIMPLE TEST***************** IF1174.2 +055800 F-LOG10-12. IF1174.2 +055900 MOVE ZERO TO WS-NUM. IF1174.2 +056000 MOVE -4.30111 TO MIN-RANGE. IF1174.2 +056100 MOVE -4.30093 TO MAX-RANGE. IF1174.2 +056200 F-LOG10-TEST-12. IF1174.2 +056300 COMPUTE WS-NUM = FUNCTION LOG10(.00005). IF1174.2 +056400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +056500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +056600 PERFORM PASS IF1174.2 +056700 ELSE IF1174.2 +056800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +056900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +057000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +057100 PERFORM FAIL. IF1174.2 +057200 GO TO F-LOG10-WRITE-12. IF1174.2 +057300 F-LOG10-DELETE-12. IF1174.2 +057400 PERFORM DE-LETE. IF1174.2 +057500 GO TO F-LOG10-WRITE-12. IF1174.2 +057600 F-LOG10-WRITE-12. IF1174.2 +057700 MOVE "F-LOG10-12" TO PAR-NAME. IF1174.2 +057800 PERFORM PRINT-DETAIL. IF1174.2 +057900*****************TEST (m) - SIMPLE TEST***************** IF1174.2 +058000 F-LOG10-13. IF1174.2 +058100 MOVE ZERO TO WS-NUM. IF1174.2 +058200 MOVE 5.77803 TO MIN-RANGE. IF1174.2 +058300 MOVE 5.77826 TO MAX-RANGE. IF1174.2 +058400 F-LOG10-TEST-13. IF1174.2 +058500 COMPUTE WS-NUM = FUNCTION LOG10(A). IF1174.2 +058600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +058700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +058800 PERFORM PASS IF1174.2 +058900 ELSE IF1174.2 +059000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +059100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +059200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +059300 PERFORM FAIL. IF1174.2 +059400 GO TO F-LOG10-WRITE-13. IF1174.2 +059500 F-LOG10-DELETE-13. IF1174.2 +059600 PERFORM DE-LETE. IF1174.2 +059700 GO TO F-LOG10-WRITE-13. IF1174.2 +059800 F-LOG10-WRITE-13. IF1174.2 +059900 MOVE "F-LOG10-13" TO PAR-NAME. IF1174.2 +060000 PERFORM PRINT-DETAIL. IF1174.2 +060100*****************TEST (n) - SIMPLE TEST***************** IF1174.2 +060200 F-LOG10-14. IF1174.2 +060300 MOVE ZERO TO WS-NUM. IF1174.2 +060400 MOVE 4.50507 TO MIN-RANGE. IF1174.2 +060500 MOVE 4.50525 TO MAX-RANGE. IF1174.2 +060600 F-LOG10-TEST-14. IF1174.2 +060700 COMPUTE WS-NUM = FUNCTION LOG10(F). IF1174.2 +060800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +060900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +061000 PERFORM PASS IF1174.2 +061100 ELSE IF1174.2 +061200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +061300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +061400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +061500 PERFORM FAIL. IF1174.2 +061600 GO TO F-LOG10-WRITE-14. IF1174.2 +061700 F-LOG10-DELETE-14. IF1174.2 +061800 PERFORM DE-LETE. IF1174.2 +061900 GO TO F-LOG10-WRITE-14. IF1174.2 +062000 F-LOG10-WRITE-14. IF1174.2 +062100 MOVE "F-LOG10-14" TO PAR-NAME. IF1174.2 +062200 PERFORM PRINT-DETAIL. IF1174.2 +062300*****************TEST (o) - SIMPLE TEST***************** IF1174.2 +062400 F-LOG10-15. IF1174.2 +062500 MOVE ZERO TO WS-NUM. IF1174.2 +062600 MOVE -4.69906 TO MIN-RANGE. IF1174.2 +062700 MOVE -4.69888 TO MAX-RANGE. IF1174.2 +062800 F-LOG10-TEST-15. IF1174.2 +062900 COMPUTE WS-NUM = FUNCTION LOG10(G). IF1174.2 +063000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +063100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +063200 PERFORM PASS IF1174.2 +063300 ELSE IF1174.2 +063400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +063500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +063600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +063700 PERFORM FAIL. IF1174.2 +063800 GO TO F-LOG10-WRITE-15. IF1174.2 +063900 F-LOG10-DELETE-15. IF1174.2 +064000 PERFORM DE-LETE. IF1174.2 +064100 GO TO F-LOG10-WRITE-15. IF1174.2 +064200 F-LOG10-WRITE-15. IF1174.2 +064300 MOVE "F-LOG10-15" TO PAR-NAME. IF1174.2 +064400 PERFORM PRINT-DETAIL. IF1174.2 +064500*****************TEST (p) - SIMPLE TEST***************** IF1174.2 +064600 F-LOG10-16. IF1174.2 +064700 MOVE ZERO TO WS-NUM. IF1174.2 +064800 MOVE 0.477111 TO MIN-RANGE. IF1174.2 +064900 MOVE 0.477131 TO MAX-RANGE. IF1174.2 +065000 F-LOG10-TEST-16. IF1174.2 +065100 COMPUTE WS-NUM = FUNCTION LOG10(IND(4)). IF1174.2 +065200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +065300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +065400 PERFORM PASS IF1174.2 +065500 ELSE IF1174.2 +065600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +065700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +065800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +065900 PERFORM FAIL. IF1174.2 +066000 GO TO F-LOG10-WRITE-16. IF1174.2 +066100 F-LOG10-DELETE-16. IF1174.2 +066200 PERFORM DE-LETE. IF1174.2 +066300 GO TO F-LOG10-WRITE-16. IF1174.2 +066400 F-LOG10-WRITE-16. IF1174.2 +066500 MOVE "F-LOG10-16" TO PAR-NAME. IF1174.2 +066600 PERFORM PRINT-DETAIL. IF1174.2 +066700*****************TEST (a) - COMPLEX TEST**************** IF1174.2 +066800 F-LOG10-17. IF1174.2 +066900 MOVE ZERO TO WS-NUM. IF1174.2 +067000 MOVE 0.434437 TO MIN-RANGE. IF1174.2 +067100 MOVE 0.434471 TO MAX-RANGE. IF1174.2 +067200 F-LOG10-TEST-17. IF1174.2 +067300 COMPUTE WS-NUM = FUNCTION LOG10(E + .001). IF1174.2 +067400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +067500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +067600 PERFORM PASS IF1174.2 +067700 ELSE IF1174.2 +067800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +067900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +068000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +068100 PERFORM FAIL. IF1174.2 +068200 GO TO F-LOG10-WRITE-17. IF1174.2 +068300 F-LOG10-DELETE-17. IF1174.2 +068400 PERFORM DE-LETE. IF1174.2 +068500 GO TO F-LOG10-WRITE-17. IF1174.2 +068600 F-LOG10-WRITE-17. IF1174.2 +068700 MOVE "F-LOG10-17" TO PAR-NAME. IF1174.2 +068800 PERFORM PRINT-DETAIL. IF1174.2 +068900*****************TEST (b) - COMPLEX TEST**************** IF1174.2 +069000 F-LOG10-18. IF1174.2 +069100 MOVE ZERO TO WS-NUM. IF1174.2 +069200 MOVE -1.00004 TO MIN-RANGE. IF1174.2 +069300 MOVE -0.999960 TO MAX-RANGE. IF1174.2 +069400 F-LOG10-TEST-18. IF1174.2 +069500 COMPUTE WS-NUM = FUNCTION LOG10(1 / 10). IF1174.2 +069600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +069700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +069800 PERFORM PASS IF1174.2 +069900 ELSE IF1174.2 +070000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +070100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +070200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +070300 PERFORM FAIL. IF1174.2 +070400 GO TO F-LOG10-WRITE-18. IF1174.2 +070500 F-LOG10-DELETE-18. IF1174.2 +070600 PERFORM DE-LETE. IF1174.2 +070700 GO TO F-LOG10-WRITE-18. IF1174.2 +070800 F-LOG10-WRITE-18. IF1174.2 +070900 MOVE "F-LOG10-18" TO PAR-NAME. IF1174.2 +071000 PERFORM PRINT-DETAIL. IF1174.2 +071100*****************TEST (c) - COMPLEX TEST**************** IF1174.2 +071200 F-LOG10-19. IF1174.2 +071300 MOVE ZERO TO WS-NUM. IF1174.2 +071400 MOVE 0.417999 TO MIN-RANGE. IF1174.2 +071500 MOVE 0.418033 TO MAX-RANGE. IF1174.2 +071600 F-LOG10-TEST-19. IF1174.2 +071700 COMPUTE WS-NUM = FUNCTION LOG10(E - .1). IF1174.2 +071800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +071900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +072000 PERFORM PASS IF1174.2 +072100 ELSE IF1174.2 +072200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +072300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +072400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +072500 PERFORM FAIL. IF1174.2 +072600 GO TO F-LOG10-WRITE-19. IF1174.2 +072700 F-LOG10-DELETE-19. IF1174.2 +072800 PERFORM DE-LETE. IF1174.2 +072900 GO TO F-LOG10-WRITE-19. IF1174.2 +073000 F-LOG10-WRITE-19. IF1174.2 +073100 MOVE "F-LOG10-19" TO PAR-NAME. IF1174.2 +073200 PERFORM PRINT-DETAIL. IF1174.2 +073300*****************TEST (d) - COMPLEX TEST**************** IF1174.2 +073400 F-LOG10-20. IF1174.2 +073500 MOVE ZERO TO WS-NUM. IF1174.2 +073600 MOVE -0.045759 TO MIN-RANGE. IF1174.2 +073700 MOVE -0.045755 TO MAX-RANGE. IF1174.2 +073800 F-LOG10-TEST-20. IF1174.2 +073900 COMPUTE WS-NUM = FUNCTION LOG10(1 - .1). IF1174.2 +074000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +074100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +074200 PERFORM PASS IF1174.2 +074300 ELSE IF1174.2 +074400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +074500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +074600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +074700 PERFORM FAIL. IF1174.2 +074800 GO TO F-LOG10-WRITE-20. IF1174.2 +074900 F-LOG10-DELETE-20. IF1174.2 +075000 PERFORM DE-LETE. IF1174.2 +075100 GO TO F-LOG10-WRITE-20. IF1174.2 +075200 F-LOG10-WRITE-20. IF1174.2 +075300 MOVE "F-LOG10-20" TO PAR-NAME. IF1174.2 +075400 PERFORM PRINT-DETAIL. IF1174.2 +075500*****************TEST (e) - COMPLEX TEST**************** IF1174.2 +075600 F-LOG10-21. IF1174.2 +075700 MOVE ZERO TO WS-NUM. IF1174.2 +075800 MOVE 1.04135 TO MIN-RANGE. IF1174.2 +075900 MOVE 1.04143 TO MAX-RANGE. IF1174.2 +076000 F-LOG10-TEST-21. IF1174.2 +076100 COMPUTE WS-NUM = FUNCTION LOG10(10 * 1.1). IF1174.2 +076200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +076300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +076400 PERFORM PASS IF1174.2 +076500 ELSE IF1174.2 +076600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +076700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +076800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +076900 PERFORM FAIL. IF1174.2 +077000 GO TO F-LOG10-WRITE-21. IF1174.2 +077100 F-LOG10-DELETE-21. IF1174.2 +077200 PERFORM DE-LETE. IF1174.2 +077300 GO TO F-LOG10-WRITE-21. IF1174.2 +077400 F-LOG10-WRITE-21. IF1174.2 +077500 MOVE "F-LOG10-21" TO PAR-NAME. IF1174.2 +077600 PERFORM PRINT-DETAIL. IF1174.2 +077700*****************TEST (f) - COMPLEX TEST**************** IF1174.2 +077800 F-LOG10-22. IF1174.2 +077900 MOVE ZERO TO WS-NUM. IF1174.2 +078000 MOVE -1.92090 TO MIN-RANGE. IF1174.2 +078100 MOVE -1.92074 TO MAX-RANGE. IF1174.2 +078200 F-LOG10-TEST-22. IF1174.2 +078300 COMPUTE WS-NUM = FUNCTION LOG10((A * G)/ 1000). IF1174.2 +078400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +078500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +078600 PERFORM PASS IF1174.2 +078700 ELSE IF1174.2 +078800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +078900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +079000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +079100 PERFORM FAIL. IF1174.2 +079200 GO TO F-LOG10-WRITE-22. IF1174.2 +079300 F-LOG10-DELETE-22. IF1174.2 +079400 PERFORM DE-LETE. IF1174.2 +079500 GO TO F-LOG10-WRITE-22. IF1174.2 +079600 F-LOG10-WRITE-22. IF1174.2 +079700 MOVE "F-LOG10-22" TO PAR-NAME. IF1174.2 +079800 PERFORM PRINT-DETAIL. IF1174.2 +079900*****************TEST (g) - COMPLEX TEST**************** IF1174.2 +080000 F-LOG10-23. IF1174.2 +080100 MOVE ZERO TO WS-NUM. IF1174.2 +080200 MOVE 0.845064 TO MIN-RANGE. IF1174.2 +080300 MOVE 0.845132 TO MAX-RANGE. IF1174.2 +080400 F-LOG10-TEST-23. IF1174.2 +080500 COMPUTE WS-NUM = FUNCTION LOG10(IND(D - 5)). IF1174.2 +080600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +080700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +080800 PERFORM PASS IF1174.2 +080900 ELSE IF1174.2 +081000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +081100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +081200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +081300 PERFORM FAIL. IF1174.2 +081400 GO TO F-LOG10-WRITE-23. IF1174.2 +081500 F-LOG10-DELETE-23. IF1174.2 +081600 PERFORM DE-LETE. IF1174.2 +081700 GO TO F-LOG10-WRITE-23. IF1174.2 +081800 F-LOG10-WRITE-23. IF1174.2 +081900 MOVE "F-LOG10-23" TO PAR-NAME. IF1174.2 +082000 PERFORM PRINT-DETAIL. IF1174.2 +082100*****************TEST (h) - COMPLEX TEST**************** IF1174.2 +082200 F-LOG10-24. IF1174.2 +082300 MOVE ZERO TO WS-NUM. IF1174.2 +082400 MOVE 1.30097 TO MIN-RANGE. IF1174.2 +082500 MOVE 1.30107 TO MAX-RANGE. IF1174.2 +082600 F-LOG10-TEST-24. IF1174.2 +082700 COMPUTE WS-NUM = FUNCTION LOG10(2 * 10). IF1174.2 +082800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +082900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +083000 PERFORM PASS IF1174.2 +083100 ELSE IF1174.2 +083200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +083300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +083400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +083500 PERFORM FAIL. IF1174.2 +083600 GO TO F-LOG10-WRITE-24. IF1174.2 +083700 F-LOG10-DELETE-24. IF1174.2 +083800 PERFORM DE-LETE. IF1174.2 +083900 GO TO F-LOG10-WRITE-24. IF1174.2 +084000 F-LOG10-WRITE-24. IF1174.2 +084100 MOVE "F-LOG10-24" TO PAR-NAME. IF1174.2 +084200 PERFORM PRINT-DETAIL. IF1174.2 +084300*****************TEST (i) - COMPLEX TEST**************** IF1174.2 +084400 F-LOG10-25. IF1174.2 +084500 MOVE ZERO TO WS-NUM. IF1174.2 +084600 MOVE 0.477102 TO MIN-RANGE. IF1174.2 +084700 MOVE 0.477140 TO MAX-RANGE. IF1174.2 +084800 F-LOG10-TEST-25. IF1174.2 +084900 COMPUTE WS-NUM = FUNCTION LOG10(B + C). IF1174.2 +085000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +085100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +085200 PERFORM PASS IF1174.2 +085300 ELSE IF1174.2 +085400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +085500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +085600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +085700 PERFORM FAIL. IF1174.2 +085800 GO TO F-LOG10-WRITE-25. IF1174.2 +085900 F-LOG10-DELETE-25. IF1174.2 +086000 PERFORM DE-LETE. IF1174.2 +086100 GO TO F-LOG10-WRITE-25. IF1174.2 +086200 F-LOG10-WRITE-25. IF1174.2 +086300 MOVE "F-LOG10-25" TO PAR-NAME. IF1174.2 +086400 PERFORM PRINT-DETAIL. IF1174.2 +086500*****************TEST (j) -COMPLEX TEST***************** IF1174.2 +086600 F-LOG10-26. IF1174.2 +086700 MOVE ZERO TO WS-NUM. IF1174.2 +086800 MOVE 0.274690 TO MIN-RANGE. IF1174.2 +086900 MOVE 0.274712 TO MAX-RANGE. IF1174.2 +087000 F-LOG10-TEST-26. IF1174.2 +087100 COMPUTE WS-NUM = FUNCTION LOG10(3.2 / 1.7). IF1174.2 +087200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +087300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +087400 PERFORM PASS IF1174.2 +087500 ELSE IF1174.2 +087600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +087700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +087800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +087900 PERFORM FAIL. IF1174.2 +088000 GO TO F-LOG10-WRITE-26. IF1174.2 +088100 F-LOG10-DELETE-26. IF1174.2 +088200 PERFORM DE-LETE. IF1174.2 +088300 GO TO F-LOG10-WRITE-26. IF1174.2 +088400 F-LOG10-WRITE-26. IF1174.2 +088500 MOVE "F-LOG10-26" TO PAR-NAME. IF1174.2 +088600 PERFORM PRINT-DETAIL. IF1174.2 +088700*****************TEST (k) - COMPLEX TEST**************** IF1174.2 +088800 F-LOG10-27. IF1174.2 +088900 MOVE ZERO TO WS-NUM. IF1174.2 +089000 MOVE 0.904045 TO MIN-RANGE. IF1174.2 +089100 MOVE 0.904117 TO MAX-RANGE. IF1174.2 +089200 F-LOG10-TEST-27. IF1174.2 +089300 COMPUTE WS-NUM = FUNCTION LOG10(E - H). IF1174.2 +089400 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +089500 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +089600 PERFORM PASS IF1174.2 +089700 ELSE IF1174.2 +089800 MOVE WS-NUM TO COMPUTED-N IF1174.2 +089900 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +090000 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +090100 PERFORM FAIL. IF1174.2 +090200 GO TO F-LOG10-WRITE-27. IF1174.2 +090300 F-LOG10-DELETE-27. IF1174.2 +090400 PERFORM DE-LETE. IF1174.2 +090500 GO TO F-LOG10-WRITE-27. IF1174.2 +090600 F-LOG10-WRITE-27. IF1174.2 +090700 MOVE "F-LOG10-27" TO PAR-NAME. IF1174.2 +090800 PERFORM PRINT-DETAIL. IF1174.2 +090900*****************TEST (l) - COMPLEX TEST**************** IF1174.2 +091000 F-LOG10-28. IF1174.2 +091100 MOVE ZERO TO WS-NUM. IF1174.2 +091200 MOVE 0.698942 TO MIN-RANGE. IF1174.2 +091300 MOVE 0.698998 TO MAX-RANGE. IF1174.2 +091400 F-LOG10-TEST-28. IF1174.2 +091500 COMPUTE WS-NUM = FUNCTION LOG10(B - 2). IF1174.2 +091600 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +091700 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +091800 PERFORM PASS IF1174.2 +091900 ELSE IF1174.2 +092000 MOVE WS-NUM TO COMPUTED-N IF1174.2 +092100 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +092200 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +092300 PERFORM FAIL. IF1174.2 +092400 GO TO F-LOG10-WRITE-28. IF1174.2 +092500 F-LOG10-DELETE-28. IF1174.2 +092600 PERFORM DE-LETE. IF1174.2 +092700 GO TO F-LOG10-WRITE-28. IF1174.2 +092800 F-LOG10-WRITE-28. IF1174.2 +092900 MOVE "F-LOG10-28" TO PAR-NAME. IF1174.2 +093000 PERFORM PRINT-DETAIL. IF1174.2 +093100*****************TEST (m) - COMPLEX TEST**************** IF1174.2 +093200 F-LOG10-29. IF1174.2 +093300 MOVE ZERO TO WS-NUM. IF1174.2 +093400 MOVE 0.645227 TO MIN-RANGE. IF1174.2 +093500 MOVE 0.645279 TO MAX-RANGE. IF1174.2 +093600 F-LOG10-TEST-29. IF1174.2 +093700 COMPUTE WS-NUM = FUNCTION LOG10(E + 1.7). IF1174.2 +093800 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +093900 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +094000 PERFORM PASS IF1174.2 +094100 ELSE IF1174.2 +094200 MOVE WS-NUM TO COMPUTED-N IF1174.2 +094300 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +094400 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +094500 PERFORM FAIL. IF1174.2 +094600 GO TO F-LOG10-WRITE-29. IF1174.2 +094700 F-LOG10-DELETE-29. IF1174.2 +094800 PERFORM DE-LETE. IF1174.2 +094900 GO TO F-LOG10-WRITE-29. IF1174.2 +095000 F-LOG10-WRITE-29. IF1174.2 +095100 MOVE "F-LOG10-29" TO PAR-NAME. IF1174.2 +095200 PERFORM PRINT-DETAIL. IF1174.2 +095300*****************TEST (n) - COMPLEX TEST**************** IF1174.2 +095400 F-LOG10-30. IF1174.2 +095500 MOVE ZERO TO WS-NUM. IF1174.2 +095600 MOVE 4.84490 TO MIN-RANGE. IF1174.2 +095700 MOVE 4.84529 TO MAX-RANGE. IF1174.2 +095800 F-LOG10-TEST-30. IF1174.2 +095900 COMPUTE WS-NUM = FUNCTION LOG10(B) + 4. IF1174.2 +096000 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +096100 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +096200 PERFORM PASS IF1174.2 +096300 ELSE IF1174.2 +096400 MOVE WS-NUM TO COMPUTED-N IF1174.2 +096500 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +096600 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +096700 PERFORM FAIL. IF1174.2 +096800 GO TO F-LOG10-WRITE-30. IF1174.2 +096900 F-LOG10-DELETE-30. IF1174.2 +097000 PERFORM DE-LETE. IF1174.2 +097100 GO TO F-LOG10-WRITE-30. IF1174.2 +097200 F-LOG10-WRITE-30. IF1174.2 +097300 MOVE "F-LOG10-30" TO PAR-NAME. IF1174.2 +097400 PERFORM PRINT-DETAIL. IF1174.2 +097500*****************TEST (o) - COMPLEX TEST**************** IF1174.2 +097600 F-LOG10-31. IF1174.2 +097700 MOVE ZERO TO WS-NUM. IF1174.2 +097800 MOVE -0.521411 TO MIN-RANGE. IF1174.2 +097900 MOVE -0.521369 TO MAX-RANGE. IF1174.2 +098000 F-LOG10-TEST-31. IF1174.2 +098100 COMPUTE WS-NUM = FUNCTION LOG10(FUNCTION LOG10(2)). IF1174.2 +098200 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +098300 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +098400 PERFORM PASS IF1174.2 +098500 ELSE IF1174.2 +098600 MOVE WS-NUM TO COMPUTED-N IF1174.2 +098700 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +098800 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +098900 PERFORM FAIL. IF1174.2 +099000 GO TO F-LOG10-WRITE-31. IF1174.2 +099100 F-LOG10-DELETE-31. IF1174.2 +099200 PERFORM DE-LETE. IF1174.2 +099300 GO TO F-LOG10-WRITE-31. IF1174.2 +099400 F-LOG10-WRITE-31. IF1174.2 +099500 MOVE "F-LOG10-31" TO PAR-NAME. IF1174.2 +099600 PERFORM PRINT-DETAIL. IF1174.2 +099700*****************TEST (p) - COMPLEX TEST**************** IF1174.2 +099800 F-LOG10-32. IF1174.2 +099900 MOVE ZERO TO WS-NUM. IF1174.2 +100000 MOVE -0.000040 TO MIN-RANGE. IF1174.2 +100100 MOVE 0.000040 TO MAX-RANGE. IF1174.2 +100200 F-LOG10-TEST-32. IF1174.2 +100300 COMPUTE WS-NUM = FUNCTION LOG10(1) + IF1174.2 +100400 FUNCTION LOG10(1). IF1174.2 +100500 IF (WS-NUM >= MIN-RANGE) AND IF1174.2 +100600 (WS-NUM <= MAX-RANGE) THEN IF1174.2 +100700 PERFORM PASS IF1174.2 +100800 ELSE IF1174.2 +100900 MOVE WS-NUM TO COMPUTED-N IF1174.2 +101000 MOVE MIN-RANGE TO CORRECT-MIN IF1174.2 +101100 MOVE MAX-RANGE TO CORRECT-MAX IF1174.2 +101200 PERFORM FAIL. IF1174.2 +101300 GO TO F-LOG10-WRITE-32. IF1174.2 +101400 F-LOG10-DELETE-32. IF1174.2 +101500 PERFORM DE-LETE. IF1174.2 +101600 GO TO F-LOG10-WRITE-32. IF1174.2 +101700 F-LOG10-WRITE-32. IF1174.2 +101800 MOVE "F-LOG10-32" TO PAR-NAME. IF1174.2 +101900 PERFORM PRINT-DETAIL. IF1174.2 +102000*****************SPECIAL PERFORM TEST********************** IF1174.2 +102100 F-LOG10-33. IF1174.2 +102200 PERFORM F-LOG10-TEST-33 IF1174.2 +102300 UNTIL FUNCTION LOG10(ARG1) < 0.30. IF1174.2 +102400 PERFORM PASS. IF1174.2 +102500 GO TO F-LOG10-WRITE-33. IF1174.2 +102600 F-LOG10-TEST-33. IF1174.2 +102700 COMPUTE ARG1 = ARG1 - 1.00. IF1174.2 +102800 F-LOG10-DELETE-33. IF1174.2 +102900 PERFORM DE-LETE. IF1174.2 +103000 GO TO F-LOG10-WRITE-33. IF1174.2 +103100 F-LOG10-WRITE-33. IF1174.2 +103200 MOVE "F-LOG10-33" TO PAR-NAME. IF1174.2 +103300 PERFORM PRINT-DETAIL. IF1174.2 +103400********************END OF TESTS*************** IF1174.2 +103500 CCVS-EXIT SECTION. IF1174.2 +103600 CCVS-999999. IF1174.2 +103700 GO TO CLOSE-FILES. IF1174.2 diff --git a/tests/cobol85/IF/IF118A.CBL b/tests/cobol85/IF/IF118A.CBL new file mode 100755 index 00000000..d8d9ad07 --- /dev/null +++ b/tests/cobol85/IF/IF118A.CBL @@ -0,0 +1,544 @@ +000100 IDENTIFICATION DIVISION. IF1184.2 +000200 PROGRAM-ID. IF1184.2 +000300 IF118A. IF1184.2 +000400 IF1184.2 +000500*********************************************************** IF1184.2 +000600* * IF1184.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1184.2 +000800* It contains tests for the Intrinsic Function * IF1184.2 +000900* LOWER-CASE. * IF1184.2 +001000* * IF1184.2 +001100*********************************************************** IF1184.2 +001200 ENVIRONMENT DIVISION. IF1184.2 +001300 CONFIGURATION SECTION. IF1184.2 +001400 SOURCE-COMPUTER. IF1184.2 +001500 Linux. IF1184.2 +001600 OBJECT-COMPUTER. IF1184.2 +001700 Linux. IF1184.2 +001800 INPUT-OUTPUT SECTION. IF1184.2 +001900 FILE-CONTROL. IF1184.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1184.2 +002100 "report.log". IF1184.2 +002200 DATA DIVISION. IF1184.2 +002300 FILE SECTION. IF1184.2 +002400 FD PRINT-FILE. IF1184.2 +002500 01 PRINT-REC PICTURE X(120). IF1184.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1184.2 +002700 WORKING-STORAGE SECTION. IF1184.2 +002800*********************************************************** IF1184.2 +002900* Variables specific to the Intrinsic Function Test IF118A* IF1184.2 +003000*********************************************************** IF1184.2 +003100 01 A PIC A(10) VALUE "tumble". IF1184.2 +003200 01 B PIC A(10) VALUE "WEED". IF1184.2 +003300 01 C PIC X(10) VALUE "Was". IF1184.2 +003400 01 D PIC X(10) VALUE "4". IF1184.2 +003500 01 E PIC X(10) VALUE "And4". IF1184.2 +003600 01 TEMP PIC S9(10). IF1184.2 +003700 01 WS-ANUM PIC X(10). IF1184.2 +003800* IF1184.2 +003900********************************************************** IF1184.2 +004000* IF1184.2 +004100 01 TEST-RESULTS. IF1184.2 +004200 02 FILLER PIC X VALUE SPACE. IF1184.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. IF1184.2 +004400 02 FILLER PIC X VALUE SPACE. IF1184.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. IF1184.2 +004600 02 FILLER PIC X VALUE SPACE. IF1184.2 +004700 02 PAR-NAME. IF1184.2 +004800 03 FILLER PIC X(19) VALUE SPACE. IF1184.2 +004900 03 PARDOT-X PIC X VALUE SPACE. IF1184.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. IF1184.2 +005100 02 FILLER PIC X(8) VALUE SPACE. IF1184.2 +005200 02 RE-MARK PIC X(61). IF1184.2 +005300 01 TEST-COMPUTED. IF1184.2 +005400 02 FILLER PIC X(30) VALUE SPACE. IF1184.2 +005500 02 FILLER PIC X(17) VALUE IF1184.2 +005600 " COMPUTED=". IF1184.2 +005700 02 COMPUTED-X. IF1184.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1184.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A IF1184.2 +006000 PIC -9(9).9(9). IF1184.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1184.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1184.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1184.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. IF1184.2 +006500 04 COMPUTED-18V0 PIC -9(18). IF1184.2 +006600 04 FILLER PIC X. IF1184.2 +006700 03 FILLER PIC X(50) VALUE SPACE. IF1184.2 +006800 01 TEST-CORRECT. IF1184.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1184.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1184.2 +007100 02 CORRECT-X. IF1184.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1184.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1184.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1184.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1184.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1184.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. IF1184.2 +007800 04 CORRECT-18V0 PIC -9(18). IF1184.2 +007900 04 FILLER PIC X. IF1184.2 +008000 03 FILLER PIC X(2) VALUE SPACE. IF1184.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1184.2 +008200 01 CCVS-C-1. IF1184.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1184.2 +008400- "SS PARAGRAPH-NAME IF1184.2 +008500- " REMARKS". IF1184.2 +008600 02 FILLER PIC X(20) VALUE SPACE. IF1184.2 +008700 01 CCVS-C-2. IF1184.2 +008800 02 FILLER PIC X VALUE SPACE. IF1184.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". IF1184.2 +009000 02 FILLER PIC X(15) VALUE SPACE. IF1184.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". IF1184.2 +009200 02 FILLER PIC X(94) VALUE SPACE. IF1184.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1184.2 +009400 01 REC-CT PIC 99 VALUE ZERO. IF1184.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1184.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1184.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1184.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1184.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1184.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1184.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1184.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1184.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1184.2 +010400 01 CCVS-H-1. IF1184.2 +010500 02 FILLER PIC X(39) VALUE SPACES. IF1184.2 +010600 02 FILLER PIC X(42) VALUE IF1184.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1184.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IF1184.2 +010900 01 CCVS-H-2A. IF1184.2 +011000 02 FILLER PIC X(40) VALUE SPACE. IF1184.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1184.2 +011200 02 FILLER PIC XXXX VALUE IF1184.2 +011300 "4.2 ". IF1184.2 +011400 02 FILLER PIC X(28) VALUE IF1184.2 +011500 " COPY - NOT FOR DISTRIBUTION". IF1184.2 +011600 02 FILLER PIC X(41) VALUE SPACE. IF1184.2 +011700 IF1184.2 +011800 01 CCVS-H-2B. IF1184.2 +011900 02 FILLER PIC X(15) VALUE IF1184.2 +012000 "TEST RESULT OF ". IF1184.2 +012100 02 TEST-ID PIC X(9). IF1184.2 +012200 02 FILLER PIC X(4) VALUE IF1184.2 +012300 " IN ". IF1184.2 +012400 02 FILLER PIC X(12) VALUE IF1184.2 +012500 " HIGH ". IF1184.2 +012600 02 FILLER PIC X(22) VALUE IF1184.2 +012700 " LEVEL VALIDATION FOR ". IF1184.2 +012800 02 FILLER PIC X(58) VALUE IF1184.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1184.2 +013000 01 CCVS-H-3. IF1184.2 +013100 02 FILLER PIC X(34) VALUE IF1184.2 +013200 " FOR OFFICIAL USE ONLY ". IF1184.2 +013300 02 FILLER PIC X(58) VALUE IF1184.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1184.2 +013500 02 FILLER PIC X(28) VALUE IF1184.2 +013600 " COPYRIGHT 1985 ". IF1184.2 +013700 01 CCVS-E-1. IF1184.2 +013800 02 FILLER PIC X(52) VALUE SPACE. IF1184.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1184.2 +014000 02 ID-AGAIN PIC X(9). IF1184.2 +014100 02 FILLER PIC X(45) VALUE SPACES. IF1184.2 +014200 01 CCVS-E-2. IF1184.2 +014300 02 FILLER PIC X(31) VALUE SPACE. IF1184.2 +014400 02 FILLER PIC X(21) VALUE SPACE. IF1184.2 +014500 02 CCVS-E-2-2. IF1184.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1184.2 +014700 03 FILLER PIC X VALUE SPACE. IF1184.2 +014800 03 ENDER-DESC PIC X(44) VALUE IF1184.2 +014900 "ERRORS ENCOUNTERED". IF1184.2 +015000 01 CCVS-E-3. IF1184.2 +015100 02 FILLER PIC X(22) VALUE IF1184.2 +015200 " FOR OFFICIAL USE ONLY". IF1184.2 +015300 02 FILLER PIC X(12) VALUE SPACE. IF1184.2 +015400 02 FILLER PIC X(58) VALUE IF1184.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1184.2 +015600 02 FILLER PIC X(13) VALUE SPACE. IF1184.2 +015700 02 FILLER PIC X(15) VALUE IF1184.2 +015800 " COPYRIGHT 1985". IF1184.2 +015900 01 CCVS-E-4. IF1184.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1184.2 +016100 02 FILLER PIC X(4) VALUE " OF ". IF1184.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1184.2 +016300 02 FILLER PIC X(40) VALUE IF1184.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1184.2 +016500 01 XXINFO. IF1184.2 +016600 02 FILLER PIC X(19) VALUE IF1184.2 +016700 "*** INFORMATION ***". IF1184.2 +016800 02 INFO-TEXT. IF1184.2 +016900 04 FILLER PIC X(8) VALUE SPACE. IF1184.2 +017000 04 XXCOMPUTED PIC X(20). IF1184.2 +017100 04 FILLER PIC X(5) VALUE SPACE. IF1184.2 +017200 04 XXCORRECT PIC X(20). IF1184.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). IF1184.2 +017400 01 HYPHEN-LINE. IF1184.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. IF1184.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************IF1184.2 +017700- "*****************************************". IF1184.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************IF1184.2 +017900- "******************************". IF1184.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE IF1184.2 +018100 "IF118A". IF1184.2 +018200 PROCEDURE DIVISION. IF1184.2 +018300 CCVS1 SECTION. IF1184.2 +018400 OPEN-FILES. IF1184.2 +018500 OPEN OUTPUT PRINT-FILE. IF1184.2 +018600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1184.2 +018700 MOVE SPACE TO TEST-RESULTS. IF1184.2 +018800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1184.2 +018900 GO TO CCVS1-EXIT. IF1184.2 +019000 CLOSE-FILES. IF1184.2 +019100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1184.2 +019200 TERMINATE-CCVS. IF1184.2 +019300 STOP RUN. IF1184.2 +019400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1184.2 +019500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1184.2 +019600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1184.2 +019700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1184.2 +019800 MOVE "****TEST DELETED****" TO RE-MARK. IF1184.2 +019900 PRINT-DETAIL. IF1184.2 +020000 IF REC-CT NOT EQUAL TO ZERO IF1184.2 +020100 MOVE "." TO PARDOT-X IF1184.2 +020200 MOVE REC-CT TO DOTVALUE. IF1184.2 +020300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1184.2 +020400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1184.2 +020500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1184.2 +020600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1184.2 +020700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1184.2 +020800 MOVE SPACE TO CORRECT-X. IF1184.2 +020900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1184.2 +021000 MOVE SPACE TO RE-MARK. IF1184.2 +021100 HEAD-ROUTINE. IF1184.2 +021200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +021300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +021400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1184.2 +021500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1184.2 +021600 COLUMN-NAMES-ROUTINE. IF1184.2 +021700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +021800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +022000 END-ROUTINE. IF1184.2 +022100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1184.2 +022200 END-RTN-EXIT. IF1184.2 +022300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +022400 END-ROUTINE-1. IF1184.2 +022500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1184.2 +022600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1184.2 +022700 ADD PASS-COUNTER TO ERROR-HOLD. IF1184.2 +022800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1184.2 +022900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1184.2 +023000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1184.2 +023100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1184.2 +023200 END-ROUTINE-12. IF1184.2 +023300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1184.2 +023400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1184.2 +023500 MOVE "NO " TO ERROR-TOTAL IF1184.2 +023600 ELSE IF1184.2 +023700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1184.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1184.2 +023900 PERFORM WRITE-LINE. IF1184.2 +024000 END-ROUTINE-13. IF1184.2 +024100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1184.2 +024200 MOVE "NO " TO ERROR-TOTAL ELSE IF1184.2 +024300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1184.2 +024400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1184.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +024600 IF INSPECT-COUNTER EQUAL TO ZERO IF1184.2 +024700 MOVE "NO " TO ERROR-TOTAL IF1184.2 +024800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1184.2 +024900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1184.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +025100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1184.2 +025200 WRITE-LINE. IF1184.2 +025300 ADD 1 TO RECORD-COUNT. IF1184.2 +025400 IF RECORD-COUNT GREATER 42 IF1184.2 +025500 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1184.2 +025600 MOVE SPACE TO DUMMY-RECORD IF1184.2 +025700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1184.2 +025800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1184.2 +025900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1184.2 +026000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1184.2 +026100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1184.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1184.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1184.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1184.2 +026500 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1184.2 +026600 MOVE ZERO TO RECORD-COUNT. IF1184.2 +026700 PERFORM WRT-LN. IF1184.2 +026800 WRT-LN. IF1184.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1184.2 +027000 MOVE SPACE TO DUMMY-RECORD. IF1184.2 +027100 BLANK-LINE-PRINT. IF1184.2 +027200 PERFORM WRT-LN. IF1184.2 +027300 FAIL-ROUTINE. IF1184.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE IF1184.2 +027500 GO TO FAIL-ROUTINE-WRITE. IF1184.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1184.2 +027700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1184.2 +027800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1184.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +028000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1184.2 +028100 GO TO FAIL-ROUTINE-EX. IF1184.2 +028200 FAIL-ROUTINE-WRITE. IF1184.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1184.2 +028400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1184.2 +028500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1184.2 +028600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1184.2 +028700 FAIL-ROUTINE-EX. EXIT. IF1184.2 +028800 BAIL-OUT. IF1184.2 +028900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1184.2 +029000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1184.2 +029100 BAIL-OUT-WRITE. IF1184.2 +029200 MOVE CORRECT-A TO XXCORRECT. IF1184.2 +029300 MOVE COMPUTED-A TO XXCOMPUTED. IF1184.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1184.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1184.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1184.2 +029700 BAIL-OUT-EX. EXIT. IF1184.2 +029800 CCVS1-EXIT. IF1184.2 +029900 EXIT. IF1184.2 +030000******************************************************** IF1184.2 +030100* * IF1184.2 +030200* Intrinsic Function Tests IF118A - LOWCASE * IF1184.2 +030300* * IF1184.2 +030400******************************************************** IF1184.2 +030500 SECT-IF118A SECTION. IF1184.2 +030600 F-LOWCASE-INFO. IF1184.2 +030700 MOVE "See ref. A-51 2.22" TO ANSI-REFERENCE. IF1184.2 +030800 MOVE "LOWER-CASE Function" TO FEATURE. IF1184.2 +030900*****************TEST (a) ****************************** IF1184.2 +031000 F-LOWCASE-01. IF1184.2 +031100 MOVE SPACES TO WS-ANUM. IF1184.2 +031200 F-LOWCASE-TEST-01. IF1184.2 +031300 MOVE FUNCTION LOWER-CASE("figure") TO WS-ANUM. IF1184.2 +031400 IF WS-ANUM = "figure" THEN IF1184.2 +031500 PERFORM PASS IF1184.2 +031600 ELSE IF1184.2 +031700 MOVE "figure" TO CORRECT-A IF1184.2 +031800 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +031900 PERFORM FAIL. IF1184.2 +032000 GO TO F-LOWCASE-WRITE-01. IF1184.2 +032100 F-LOWCASE-DELETE-01. IF1184.2 +032200 PERFORM DE-LETE. IF1184.2 +032300 GO TO F-LOWCASE-WRITE-01. IF1184.2 +032400 F-LOWCASE-WRITE-01. IF1184.2 +032500 MOVE "F-LOWCASE-01" TO PAR-NAME. IF1184.2 +032600 PERFORM PRINT-DETAIL. IF1184.2 +032700*****************TEST (b) ****************************** IF1184.2 +032800 F-LOWCASE-TEST-02. IF1184.2 +032900 MOVE FUNCTION LOWER-CASE("CAPS") TO WS-ANUM. IF1184.2 +033000 IF WS-ANUM = "caps" THEN IF1184.2 +033100 PERFORM PASS IF1184.2 +033200 ELSE IF1184.2 +033300 PERFORM FAIL. IF1184.2 +033400 GO TO F-LOWCASE-WRITE-02. IF1184.2 +033500 F-LOWCASE-DELETE-02. IF1184.2 +033600 PERFORM DE-LETE. IF1184.2 +033700 GO TO F-LOWCASE-WRITE-02. IF1184.2 +033800 F-LOWCASE-WRITE-02. IF1184.2 +033900 MOVE "F-LOWCASE-02" TO PAR-NAME. IF1184.2 +034000 PERFORM PRINT-DETAIL. IF1184.2 +034100*****************TEST (c) ****************************** IF1184.2 +034200 F-LOWCASE-03. IF1184.2 +034300 MOVE SPACES TO WS-ANUM. IF1184.2 +034400 F-LOWCASE-TEST-03. IF1184.2 +034500 IF FUNCTION LOWER-CASE("highnLOW") = "highnlow" THEN IF1184.2 +034600 PERFORM PASS IF1184.2 +034700 ELSE IF1184.2 +034800 MOVE "highnlow" TO CORRECT-A IF1184.2 +034900 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +035000 PERFORM FAIL. IF1184.2 +035100 GO TO F-LOWCASE-WRITE-03. IF1184.2 +035200 F-LOWCASE-DELETE-03. IF1184.2 +035300 PERFORM DE-LETE. IF1184.2 +035400 GO TO F-LOWCASE-WRITE-03. IF1184.2 +035500 F-LOWCASE-WRITE-03. IF1184.2 +035600 MOVE "F-LOWCASE-03" TO PAR-NAME. IF1184.2 +035700 PERFORM PRINT-DETAIL. IF1184.2 +035800*****************TEST (d) ****************************** IF1184.2 +035900 F-LOWCASE-04. IF1184.2 +036000 MOVE SPACES TO WS-ANUM. IF1184.2 +036100 F-LOWCASE-TEST-04. IF1184.2 +036200 MOVE FUNCTION LOWER-CASE("95") TO WS-ANUM. IF1184.2 +036300 IF WS-ANUM = "95" THEN IF1184.2 +036400 PERFORM PASS IF1184.2 +036500 ELSE IF1184.2 +036600 MOVE "95" TO CORRECT-A IF1184.2 +036700 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +036800 PERFORM FAIL. IF1184.2 +036900 GO TO F-LOWCASE-WRITE-04. IF1184.2 +037000 F-LOWCASE-DELETE-04. IF1184.2 +037100 PERFORM DE-LETE. IF1184.2 +037200 GO TO F-LOWCASE-WRITE-04. IF1184.2 +037300 F-LOWCASE-WRITE-04. IF1184.2 +037400 MOVE "F-LOWCASE-04" TO PAR-NAME. IF1184.2 +037500 PERFORM PRINT-DETAIL. IF1184.2 +037600*****************TEST (e) ****************************** IF1184.2 +037700 F-LOWCASE-05. IF1184.2 +037800 MOVE SPACES TO WS-ANUM. IF1184.2 +037900 F-LOWCASE-TEST-05. IF1184.2 +038000 MOVE FUNCTION LOWER-CASE("8isaNUMBER") TO WS-ANUM. IF1184.2 +038100 IF WS-ANUM = "8isanumber" THEN IF1184.2 +038200 PERFORM PASS IF1184.2 +038300 ELSE IF1184.2 +038400 MOVE "8isanumber" TO CORRECT-A IF1184.2 +038500 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +038600 PERFORM FAIL. IF1184.2 +038700 GO TO F-LOWCASE-WRITE-05. IF1184.2 +038800 F-LOWCASE-DELETE-05. IF1184.2 +038900 PERFORM DE-LETE. IF1184.2 +039000 GO TO F-LOWCASE-WRITE-05. IF1184.2 +039100 F-LOWCASE-WRITE-05. IF1184.2 +039200 MOVE "F-LOWCASE-05" TO PAR-NAME. IF1184.2 +039300 PERFORM PRINT-DETAIL. IF1184.2 +039400*****************TEST (f) ****************************** IF1184.2 +039500 F-LOWCASE-06. IF1184.2 +039600 MOVE SPACES TO WS-ANUM. IF1184.2 +039700 F-LOWCASE-TEST-06. IF1184.2 +039800 MOVE FUNCTION LOWER-CASE(A) TO WS-ANUM. IF1184.2 +039900 IF WS-ANUM = "tumble" THEN IF1184.2 +040000 PERFORM PASS IF1184.2 +040100 ELSE IF1184.2 +040200 MOVE "tumble" TO CORRECT-A IF1184.2 +040300 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +040400 PERFORM FAIL. IF1184.2 +040500 GO TO F-LOWCASE-WRITE-06. IF1184.2 +040600 F-LOWCASE-DELETE-06. IF1184.2 +040700 PERFORM DE-LETE. IF1184.2 +040800 GO TO F-LOWCASE-WRITE-06. IF1184.2 +040900 F-LOWCASE-WRITE-06. IF1184.2 +041000 MOVE "F-LOWCASE-06" TO PAR-NAME. IF1184.2 +041100 PERFORM PRINT-DETAIL. IF1184.2 +041200*****************TEST (g) ****************************** IF1184.2 +041300 F-LOWCASE-07. IF1184.2 +041400 MOVE SPACES TO WS-ANUM. IF1184.2 +041500 F-LOWCASE-TEST-07. IF1184.2 +041600 MOVE FUNCTION LOWER-CASE(B) TO WS-ANUM. IF1184.2 +041700 IF WS-ANUM = "weed" THEN IF1184.2 +041800 PERFORM PASS IF1184.2 +041900 ELSE IF1184.2 +042000 MOVE "weed" TO CORRECT-A IF1184.2 +042100 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +042200 PERFORM FAIL. IF1184.2 +042300 GO TO F-LOWCASE-WRITE-07. IF1184.2 +042400 F-LOWCASE-DELETE-07. IF1184.2 +042500 PERFORM DE-LETE. IF1184.2 +042600 GO TO F-LOWCASE-WRITE-07. IF1184.2 +042700 F-LOWCASE-WRITE-07. IF1184.2 +042800 MOVE "F-LOWCASE-07" TO PAR-NAME. IF1184.2 +042900 PERFORM PRINT-DETAIL. IF1184.2 +043000*****************TEST (h) ****************************** IF1184.2 +043100 F-LOWCASE-08. IF1184.2 +043200 MOVE SPACES TO WS-ANUM. IF1184.2 +043300 F-LOWCASE-TEST-08. IF1184.2 +043400 MOVE FUNCTION LOWER-CASE(C) TO WS-ANUM. IF1184.2 +043500 IF WS-ANUM = "was" THEN IF1184.2 +043600 PERFORM PASS IF1184.2 +043700 ELSE IF1184.2 +043800 MOVE "was" TO CORRECT-A IF1184.2 +043900 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +044000 PERFORM FAIL. IF1184.2 +044100 GO TO F-LOWCASE-WRITE-08. IF1184.2 +044200 F-LOWCASE-DELETE-08. IF1184.2 +044300 PERFORM DE-LETE. IF1184.2 +044400 GO TO F-LOWCASE-WRITE-08. IF1184.2 +044500 F-LOWCASE-WRITE-08. IF1184.2 +044600 MOVE "F-LOWCASE-08" TO PAR-NAME. IF1184.2 +044700 PERFORM PRINT-DETAIL. IF1184.2 +044800*****************TEST (i) ****************************** IF1184.2 +044900 F-LOWCASE-09. IF1184.2 +045000 MOVE SPACES TO WS-ANUM. IF1184.2 +045100 F-LOWCASE-TEST-09. IF1184.2 +045200 MOVE FUNCTION LOWER-CASE(D) TO WS-ANUM. IF1184.2 +045300 IF WS-ANUM = "4" THEN IF1184.2 +045400 PERFORM PASS IF1184.2 +045500 ELSE IF1184.2 +045600 MOVE "4" TO CORRECT-A IF1184.2 +045700 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +045800 PERFORM FAIL. IF1184.2 +045900 GO TO F-LOWCASE-WRITE-09. IF1184.2 +046000 F-LOWCASE-DELETE-09. IF1184.2 +046100 PERFORM DE-LETE. IF1184.2 +046200 GO TO F-LOWCASE-WRITE-09. IF1184.2 +046300 F-LOWCASE-WRITE-09. IF1184.2 +046400 MOVE "F-LOWCASE-09" TO PAR-NAME. IF1184.2 +046500 PERFORM PRINT-DETAIL. IF1184.2 +046600*****************TEST (j) ****************************** IF1184.2 +046700 F-LOWCASE-10. IF1184.2 +046800 MOVE SPACES TO WS-ANUM. IF1184.2 +046900 F-LOWCASE-TEST-10. IF1184.2 +047000 MOVE FUNCTION LOWER-CASE(E) TO WS-ANUM. IF1184.2 +047100 IF WS-ANUM = "and4" THEN IF1184.2 +047200 PERFORM PASS IF1184.2 +047300 ELSE IF1184.2 +047400 MOVE "and4" TO CORRECT-A IF1184.2 +047500 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +047600 PERFORM FAIL. IF1184.2 +047700 GO TO F-LOWCASE-WRITE-10. IF1184.2 +047800 F-LOWCASE-DELETE-10. IF1184.2 +047900 PERFORM DE-LETE. IF1184.2 +048000 GO TO F-LOWCASE-WRITE-10. IF1184.2 +048100 F-LOWCASE-WRITE-10. IF1184.2 +048200 MOVE "F-LOWCASE-10" TO PAR-NAME. IF1184.2 +048300 PERFORM PRINT-DETAIL. IF1184.2 +048400*****************TEST (k) ****************************** IF1184.2 +048500 F-LOWCASE-11. IF1184.2 +048600 MOVE ZERO TO TEMP. IF1184.2 +048700 F-LOWCASE-TEST-11. IF1184.2 +048800 IF IF1184.2 +048900 FUNCTION LENGTH(FUNCTION LOWER-CASE("GIZZARD")) + 2 = 9 IF1184.2 +049000 THEN IF1184.2 +049100 PERFORM PASS IF1184.2 +049200 ELSE IF1184.2 +049300 MOVE 9 TO CORRECT-N IF1184.2 +049400 MOVE TEMP TO COMPUTED-N IF1184.2 +049500 PERFORM FAIL. IF1184.2 +049600 GO TO F-LOWCASE-WRITE-11. IF1184.2 +049700 F-LOWCASE-DELETE-11. IF1184.2 +049800 PERFORM DE-LETE. IF1184.2 +049900 GO TO F-LOWCASE-WRITE-11. IF1184.2 +050000 F-LOWCASE-WRITE-11. IF1184.2 +050100 MOVE "F-LOWCASE-11" TO PAR-NAME. IF1184.2 +050200 PERFORM PRINT-DETAIL. IF1184.2 +050300*****************TEST (l) ****************************** IF1184.2 +050400 F-LOWCASE-12. IF1184.2 +050500 MOVE SPACES TO WS-ANUM. IF1184.2 +050600 F-LOWCASE-TEST-12. IF1184.2 +050700 MOVE FUNCTION LOWER-CASE(FUNCTION LOWER-CASE("giZZard")) IF1184.2 +050800 TO WS-ANUM. IF1184.2 +050900 IF WS-ANUM = "gizzard" THEN IF1184.2 +051000 PERFORM PASS IF1184.2 +051100 ELSE IF1184.2 +051200 MOVE "gizzard" TO CORRECT-A IF1184.2 +051300 MOVE WS-ANUM TO COMPUTED-A IF1184.2 +051400 PERFORM FAIL. IF1184.2 +051500 GO TO F-LOWCASE-WRITE-12. IF1184.2 +051600 F-LOWCASE-DELETE-12. IF1184.2 +051700 PERFORM DE-LETE. IF1184.2 +051800 GO TO F-LOWCASE-WRITE-12. IF1184.2 +051900 F-LOWCASE-WRITE-12. IF1184.2 +052000 MOVE "F-LOWCASE-12" TO PAR-NAME. IF1184.2 +052100 PERFORM PRINT-DETAIL. IF1184.2 +052200*****************TEST (m) ****************************** IF1184.2 +052300 F-LOWCASE-13. IF1184.2 +052400 MOVE ZERO TO TEMP. IF1184.2 +052500 F-LOWCASE-TEST-13. IF1184.2 +052600 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION LOWER-CASE("HOME")) IF1184.2 +052700 + FUNCTION LENGTH(FUNCTION LOWER-CASE("HOME")). IF1184.2 +052800 IF TEMP = 8 THEN IF1184.2 +052900 PERFORM PASS IF1184.2 +053000 ELSE IF1184.2 +053100 MOVE 8 TO CORRECT-N IF1184.2 +053200 MOVE TEMP TO COMPUTED-N IF1184.2 +053300 PERFORM FAIL. IF1184.2 +053400 GO TO F-LOWCASE-WRITE-13. IF1184.2 +053500 F-LOWCASE-DELETE-13. IF1184.2 +053600 PERFORM DE-LETE. IF1184.2 +053700 GO TO F-LOWCASE-WRITE-13. IF1184.2 +053800 F-LOWCASE-WRITE-13. IF1184.2 +053900 MOVE "F-LOWCASE-13" TO PAR-NAME. IF1184.2 +054000 PERFORM PRINT-DETAIL. IF1184.2 +054100*******************END OF TESTS************************** IF1184.2 +054200 CCVS-EXIT SECTION. IF1184.2 +054300 CCVS-999999. IF1184.2 +054400 GO TO CLOSE-FILES. IF1184.2 diff --git a/tests/cobol85/IF/IF119A.CBL b/tests/cobol85/IF/IF119A.CBL new file mode 100755 index 00000000..7ab64986 --- /dev/null +++ b/tests/cobol85/IF/IF119A.CBL @@ -0,0 +1,797 @@ +000100 IDENTIFICATION DIVISION. IF1194.2 +000200 PROGRAM-ID. IF1194.2 +000300 IF119A. IF1194.2 +000400 IF1194.2 +000500*********************************************************** IF1194.2 +000600* * IF1194.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1194.2 +000800* It contains tests for the Intrinsic Function MAX. * IF1194.2 +000900* * IF1194.2 +001000*********************************************************** IF1194.2 +001100 ENVIRONMENT DIVISION. IF1194.2 +001200 CONFIGURATION SECTION. IF1194.2 +001300 SOURCE-COMPUTER. IF1194.2 +001400 Linux. IF1194.2 +001500 OBJECT-COMPUTER. IF1194.2 +001600 Linux IF1194.2 +001700 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1194.2 +001800 SPECIAL-NAMES. IF1194.2 +001900 ALPHABET PRG-COLL-SEQ IS IF1194.2 +002000 STANDARD-2. IF1194.2 +002100 INPUT-OUTPUT SECTION. IF1194.2 +002200 FILE-CONTROL. IF1194.2 +002300 SELECT PRINT-FILE ASSIGN TO IF1194.2 +002400 "report.log". IF1194.2 +002500 DATA DIVISION. IF1194.2 +002600 FILE SECTION. IF1194.2 +002700 FD PRINT-FILE. IF1194.2 +002800 01 PRINT-REC PICTURE X(120). IF1194.2 +002900 01 DUMMY-RECORD PICTURE X(120). IF1194.2 +003000 WORKING-STORAGE SECTION. IF1194.2 +003100*********************************************************** IF1194.2 +003200* Variables specific to the Intrinsic Function Test IF119A* IF1194.2 +003300*********************************************************** IF1194.2 +003400 01 A PIC S9(10) VALUE 5. IF1194.2 +003500 01 B PIC S9(10) VALUE 7. IF1194.2 +003600 01 C PIC S9(10) VALUE -4. IF1194.2 +003700 01 D PIC S9(10) VALUE 10. IF1194.2 +003800 01 E PIC S9(5)V9(5) VALUE 34.26. IF1194.2 +003900 01 F PIC S9(5)V9(5) VALUE -8.32. IF1194.2 +004000 01 G PIC S9(5)V9(5) VALUE 4.08. IF1194.2 +004100 01 H PIC S9(5)V9(5) VALUE -5.3. IF1194.2 +004200 01 I PIC X VALUE "R". IF1194.2 +004300 01 J PIC X VALUE "U". IF1194.2 +004400 01 M PIC S9(10) VALUE 1. IF1194.2 +004500 01 N PIC S9(10) VALUE 3. IF1194.2 +004600 01 O PIC S9(10) VALUE 5. IF1194.2 +004700 01 ARG1 PIC S9(10) VALUE 1. IF1194.2 +004800 01 ARR VALUE "40537". IF1194.2 +004900 02 IND OCCURS 5 TIMES PIC 9. IF1194.2 +005000 01 TEMP PIC S9(10). IF1194.2 +005100 01 WS-NUM PIC S9(6)V9(6). IF1194.2 +005200 01 WS-ANUM PIC X. IF1194.2 +005300 01 MIN-RANGE PIC S9(5)V9(7). IF1194.2 +005400 01 MAX-RANGE PIC S9(5)V9(7). IF1194.2 +005500* IF1194.2 +005600********************************************************** IF1194.2 +005700* IF1194.2 +005800 01 TEST-RESULTS. IF1194.2 +005900 02 FILLER PIC X VALUE SPACE. IF1194.2 +006000 02 FEATURE PIC X(20) VALUE SPACE. IF1194.2 +006100 02 FILLER PIC X VALUE SPACE. IF1194.2 +006200 02 P-OR-F PIC X(5) VALUE SPACE. IF1194.2 +006300 02 FILLER PIC X VALUE SPACE. IF1194.2 +006400 02 PAR-NAME. IF1194.2 +006500 03 FILLER PIC X(19) VALUE SPACE. IF1194.2 +006600 03 PARDOT-X PIC X VALUE SPACE. IF1194.2 +006700 03 DOTVALUE PIC 99 VALUE ZERO. IF1194.2 +006800 02 FILLER PIC X(8) VALUE SPACE. IF1194.2 +006900 02 RE-MARK PIC X(61). IF1194.2 +007000 01 TEST-COMPUTED. IF1194.2 +007100 02 FILLER PIC X(30) VALUE SPACE. IF1194.2 +007200 02 FILLER PIC X(17) VALUE IF1194.2 +007300 " COMPUTED=". IF1194.2 +007400 02 COMPUTED-X. IF1194.2 +007500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1194.2 +007600 03 COMPUTED-N REDEFINES COMPUTED-A IF1194.2 +007700 PIC -9(9).9(9). IF1194.2 +007800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1194.2 +007900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1194.2 +008000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1194.2 +008100 03 CM-18V0 REDEFINES COMPUTED-A. IF1194.2 +008200 04 COMPUTED-18V0 PIC -9(18). IF1194.2 +008300 04 FILLER PIC X. IF1194.2 +008400 03 FILLER PIC X(50) VALUE SPACE. IF1194.2 +008500 01 TEST-CORRECT. IF1194.2 +008600 02 FILLER PIC X(30) VALUE SPACE. IF1194.2 +008700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1194.2 +008800 02 CORRECT-X. IF1194.2 +008900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1194.2 +009000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1194.2 +009100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1194.2 +009200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1194.2 +009300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1194.2 +009400 03 CR-18V0 REDEFINES CORRECT-A. IF1194.2 +009500 04 CORRECT-18V0 PIC -9(18). IF1194.2 +009600 04 FILLER PIC X. IF1194.2 +009700 03 FILLER PIC X(2) VALUE SPACE. IF1194.2 +009800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1194.2 +009900 01 TEST-CORRECT-MIN. IF1194.2 +010000 02 FILLER PIC X(30) VALUE SPACE. IF1194.2 +010100 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1194.2 +010200 02 CORRECTMI-X. IF1194.2 +010300 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1194.2 +010400 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1194.2 +010500 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1194.2 +010600 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1194.2 +010700 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1194.2 +010800 03 CR-18V0 REDEFINES CORRECTMI-A. IF1194.2 +010900 04 CORRECTMI-18V0 PIC -9(18). IF1194.2 +011000 04 FILLER PIC X. IF1194.2 +011100 03 FILLER PIC X(2) VALUE SPACE. IF1194.2 +011200 03 FILLER PIC X(48) VALUE SPACE. IF1194.2 +011300 01 TEST-CORRECT-MAX. IF1194.2 +011400 02 FILLER PIC X(30) VALUE SPACE. IF1194.2 +011500 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1194.2 +011600 02 CORRECTMA-X. IF1194.2 +011700 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1194.2 +011800 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1194.2 +011900 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1194.2 +012000 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1194.2 +012100 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1194.2 +012200 03 CR-18V0 REDEFINES CORRECTMA-A. IF1194.2 +012300 04 CORRECTMA-18V0 PIC -9(18). IF1194.2 +012400 04 FILLER PIC X. IF1194.2 +012500 03 FILLER PIC X(2) VALUE SPACE. IF1194.2 +012600 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1194.2 +012700 01 CCVS-C-1. IF1194.2 +012800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1194.2 +012900- "SS PARAGRAPH-NAME IF1194.2 +013000- " REMARKS". IF1194.2 +013100 02 FILLER PIC X(20) VALUE SPACE. IF1194.2 +013200 01 CCVS-C-2. IF1194.2 +013300 02 FILLER PIC X VALUE SPACE. IF1194.2 +013400 02 FILLER PIC X(6) VALUE "TESTED". IF1194.2 +013500 02 FILLER PIC X(15) VALUE SPACE. IF1194.2 +013600 02 FILLER PIC X(4) VALUE "FAIL". IF1194.2 +013700 02 FILLER PIC X(94) VALUE SPACE. IF1194.2 +013800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1194.2 +013900 01 REC-CT PIC 99 VALUE ZERO. IF1194.2 +014000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1194.2 +014100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1194.2 +014200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1194.2 +014300 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1194.2 +014400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1194.2 +014500 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1194.2 +014600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1194.2 +014700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1194.2 +014800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1194.2 +014900 01 CCVS-H-1. IF1194.2 +015000 02 FILLER PIC X(39) VALUE SPACES. IF1194.2 +015100 02 FILLER PIC X(42) VALUE IF1194.2 +015200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1194.2 +015300 02 FILLER PIC X(39) VALUE SPACES. IF1194.2 +015400 01 CCVS-H-2A. IF1194.2 +015500 02 FILLER PIC X(40) VALUE SPACE. IF1194.2 +015600 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1194.2 +015700 02 FILLER PIC XXXX VALUE IF1194.2 +015800 "4.2 ". IF1194.2 +015900 02 FILLER PIC X(28) VALUE IF1194.2 +016000 " COPY - NOT FOR DISTRIBUTION". IF1194.2 +016100 02 FILLER PIC X(41) VALUE SPACE. IF1194.2 +016200 IF1194.2 +016300 01 CCVS-H-2B. IF1194.2 +016400 02 FILLER PIC X(15) VALUE IF1194.2 +016500 "TEST RESULT OF ". IF1194.2 +016600 02 TEST-ID PIC X(9). IF1194.2 +016700 02 FILLER PIC X(4) VALUE IF1194.2 +016800 " IN ". IF1194.2 +016900 02 FILLER PIC X(12) VALUE IF1194.2 +017000 " HIGH ". IF1194.2 +017100 02 FILLER PIC X(22) VALUE IF1194.2 +017200 " LEVEL VALIDATION FOR ". IF1194.2 +017300 02 FILLER PIC X(58) VALUE IF1194.2 +017400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1194.2 +017500 01 CCVS-H-3. IF1194.2 +017600 02 FILLER PIC X(34) VALUE IF1194.2 +017700 " FOR OFFICIAL USE ONLY ". IF1194.2 +017800 02 FILLER PIC X(58) VALUE IF1194.2 +017900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1194.2 +018000 02 FILLER PIC X(28) VALUE IF1194.2 +018100 " COPYRIGHT 1985 ". IF1194.2 +018200 01 CCVS-E-1. IF1194.2 +018300 02 FILLER PIC X(52) VALUE SPACE. IF1194.2 +018400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1194.2 +018500 02 ID-AGAIN PIC X(9). IF1194.2 +018600 02 FILLER PIC X(45) VALUE SPACES. IF1194.2 +018700 01 CCVS-E-2. IF1194.2 +018800 02 FILLER PIC X(31) VALUE SPACE. IF1194.2 +018900 02 FILLER PIC X(21) VALUE SPACE. IF1194.2 +019000 02 CCVS-E-2-2. IF1194.2 +019100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1194.2 +019200 03 FILLER PIC X VALUE SPACE. IF1194.2 +019300 03 ENDER-DESC PIC X(44) VALUE IF1194.2 +019400 "ERRORS ENCOUNTERED". IF1194.2 +019500 01 CCVS-E-3. IF1194.2 +019600 02 FILLER PIC X(22) VALUE IF1194.2 +019700 " FOR OFFICIAL USE ONLY". IF1194.2 +019800 02 FILLER PIC X(12) VALUE SPACE. IF1194.2 +019900 02 FILLER PIC X(58) VALUE IF1194.2 +020000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1194.2 +020100 02 FILLER PIC X(13) VALUE SPACE. IF1194.2 +020200 02 FILLER PIC X(15) VALUE IF1194.2 +020300 " COPYRIGHT 1985". IF1194.2 +020400 01 CCVS-E-4. IF1194.2 +020500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1194.2 +020600 02 FILLER PIC X(4) VALUE " OF ". IF1194.2 +020700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1194.2 +020800 02 FILLER PIC X(40) VALUE IF1194.2 +020900 " TESTS WERE EXECUTED SUCCESSFULLY". IF1194.2 +021000 01 XXINFO. IF1194.2 +021100 02 FILLER PIC X(19) VALUE IF1194.2 +021200 "*** INFORMATION ***". IF1194.2 +021300 02 INFO-TEXT. IF1194.2 +021400 04 FILLER PIC X(8) VALUE SPACE. IF1194.2 +021500 04 XXCOMPUTED PIC X(20). IF1194.2 +021600 04 FILLER PIC X(5) VALUE SPACE. IF1194.2 +021700 04 XXCORRECT PIC X(20). IF1194.2 +021800 02 INF-ANSI-REFERENCE PIC X(48). IF1194.2 +021900 01 HYPHEN-LINE. IF1194.2 +022000 02 FILLER PIC IS X VALUE IS SPACE. IF1194.2 +022100 02 FILLER PIC IS X(65) VALUE IS "************************IF1194.2 +022200- "*****************************************". IF1194.2 +022300 02 FILLER PIC IS X(54) VALUE IS "************************IF1194.2 +022400- "******************************". IF1194.2 +022500 01 CCVS-PGM-ID PIC X(9) VALUE IF1194.2 +022600 "IF119A". IF1194.2 +022700 PROCEDURE DIVISION. IF1194.2 +022800 CCVS1 SECTION. IF1194.2 +022900 OPEN-FILES. IF1194.2 +023000 OPEN OUTPUT PRINT-FILE. IF1194.2 +023100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1194.2 +023200 MOVE SPACE TO TEST-RESULTS. IF1194.2 +023300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1194.2 +023400 GO TO CCVS1-EXIT. IF1194.2 +023500 CLOSE-FILES. IF1194.2 +023600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1194.2 +023700 TERMINATE-CCVS. IF1194.2 +023800 STOP RUN. IF1194.2 +023900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1194.2 +024000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1194.2 +024100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1194.2 +024200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1194.2 +024300 MOVE "****TEST DELETED****" TO RE-MARK. IF1194.2 +024400 PRINT-DETAIL. IF1194.2 +024500 IF REC-CT NOT EQUAL TO ZERO IF1194.2 +024600 MOVE "." TO PARDOT-X IF1194.2 +024700 MOVE REC-CT TO DOTVALUE. IF1194.2 +024800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1194.2 +024900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1194.2 +025000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1194.2 +025100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1194.2 +025200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1194.2 +025300 MOVE SPACE TO CORRECT-X. IF1194.2 +025400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1194.2 +025500 MOVE SPACE TO RE-MARK. IF1194.2 +025600 HEAD-ROUTINE. IF1194.2 +025700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +025800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +025900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1194.2 +026000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1194.2 +026100 COLUMN-NAMES-ROUTINE. IF1194.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +026500 END-ROUTINE. IF1194.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1194.2 +026700 END-RTN-EXIT. IF1194.2 +026800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +026900 END-ROUTINE-1. IF1194.2 +027000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1194.2 +027100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1194.2 +027200 ADD PASS-COUNTER TO ERROR-HOLD. IF1194.2 +027300 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1194.2 +027400 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1194.2 +027500 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1194.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1194.2 +027700 END-ROUTINE-12. IF1194.2 +027800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1194.2 +027900 IF ERROR-COUNTER IS EQUAL TO ZERO IF1194.2 +028000 MOVE "NO " TO ERROR-TOTAL IF1194.2 +028100 ELSE IF1194.2 +028200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1194.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1194.2 +028400 PERFORM WRITE-LINE. IF1194.2 +028500 END-ROUTINE-13. IF1194.2 +028600 IF DELETE-COUNTER IS EQUAL TO ZERO IF1194.2 +028700 MOVE "NO " TO ERROR-TOTAL ELSE IF1194.2 +028800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1194.2 +028900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1194.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +029100 IF INSPECT-COUNTER EQUAL TO ZERO IF1194.2 +029200 MOVE "NO " TO ERROR-TOTAL IF1194.2 +029300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1194.2 +029400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1194.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +029600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1194.2 +029700 WRITE-LINE. IF1194.2 +029800 ADD 1 TO RECORD-COUNT. IF1194.2 +029900 IF RECORD-COUNT GREATER 42 IF1194.2 +030000 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1194.2 +030100 MOVE SPACE TO DUMMY-RECORD IF1194.2 +030200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1194.2 +030300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1194.2 +030400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1194.2 +030500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1194.2 +030600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1194.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1194.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1194.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1194.2 +031000 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1194.2 +031100 MOVE ZERO TO RECORD-COUNT. IF1194.2 +031200 PERFORM WRT-LN. IF1194.2 +031300 WRT-LN. IF1194.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1194.2 +031500 MOVE SPACE TO DUMMY-RECORD. IF1194.2 +031600 BLANK-LINE-PRINT. IF1194.2 +031700 PERFORM WRT-LN. IF1194.2 +031800 FAIL-ROUTINE. IF1194.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE IF1194.2 +032000 GO TO FAIL-ROUTINE-WRITE. IF1194.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1194.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1194.2 +032300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1194.2 +032400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +032500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1194.2 +032600 GO TO FAIL-ROUTINE-EX. IF1194.2 +032700 FAIL-ROUTINE-WRITE. IF1194.2 +032800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1194.2 +032900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1194.2 +033000 CORMA-ANSI-REFERENCE. IF1194.2 +033100 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1194.2 +033200 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1194.2 +033300 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1194.2 +033400 ELSE IF1194.2 +033500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1194.2 +033600 PERFORM WRITE-LINE. IF1194.2 +033700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1194.2 +033800 FAIL-ROUTINE-EX. EXIT. IF1194.2 +033900 BAIL-OUT. IF1194.2 +034000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1194.2 +034100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1194.2 +034200 BAIL-OUT-WRITE. IF1194.2 +034300 MOVE CORRECT-A TO XXCORRECT. IF1194.2 +034400 MOVE COMPUTED-A TO XXCOMPUTED. IF1194.2 +034500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1194.2 +034600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1194.2 +034700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1194.2 +034800 BAIL-OUT-EX. EXIT. IF1194.2 +034900 CCVS1-EXIT. IF1194.2 +035000 EXIT. IF1194.2 +035100******************************************************** IF1194.2 +035200* * IF1194.2 +035300* Intrinsic Function Tests IF119A - MAX * IF1194.2 +035400* * IF1194.2 +035500******************************************************** IF1194.2 +035600 SECT-IF119A SECTION. IF1194.2 +035700 F-MAX-INFO. IF1194.2 +035800 MOVE "See ref. A-52 2.23" TO ANSI-REFERENCE. IF1194.2 +035900 MOVE "MAX Function" TO FEATURE. IF1194.2 +036000*****************TEST (a) - SIMPLE TEST***************** IF1194.2 +036100 F-MAX-01. IF1194.2 +036200 MOVE ZERO TO WS-NUM. IF1194.2 +036300 F-MAX-TEST-01. IF1194.2 +036400 COMPUTE WS-NUM = FUNCTION MAX(5, 6, 10, 3, 7). IF1194.2 +036500 IF WS-NUM = 10 THEN IF1194.2 +036600 PERFORM PASS IF1194.2 +036700 ELSE IF1194.2 +036800 MOVE WS-NUM TO COMPUTED-N IF1194.2 +036900 MOVE 10 TO CORRECT-N IF1194.2 +037000 PERFORM FAIL. IF1194.2 +037100 GO TO F-MAX-WRITE-01. IF1194.2 +037200 F-MAX-DELETE-01. IF1194.2 +037300 PERFORM DE-LETE. IF1194.2 +037400 GO TO F-MAX-WRITE-01. IF1194.2 +037500 F-MAX-WRITE-01. IF1194.2 +037600 MOVE "F-MAX-01" TO PAR-NAME. IF1194.2 +037700 PERFORM PRINT-DETAIL. IF1194.2 +037800*****************TEST (b) - SIMPLE TEST***************** IF1194.2 +037900 F-MAX-02. IF1194.2 +038000 EVALUATE FUNCTION MAX(-4, 7, 304, 3, -8) IF1194.2 +038100 WHEN 304 IF1194.2 +038200 PERFORM PASS IF1194.2 +038300 WHEN OTHER IF1194.2 +038400 PERFORM FAIL. IF1194.2 +038500 GO TO F-MAX-WRITE-02. IF1194.2 +038600 F-MAX-DELETE-02. IF1194.2 +038700 PERFORM DE-LETE. IF1194.2 +038800 GO TO F-MAX-WRITE-02. IF1194.2 +038900 F-MAX-WRITE-02. IF1194.2 +039000 MOVE "F-MAX-02" TO PAR-NAME. IF1194.2 +039100 PERFORM PRINT-DETAIL. IF1194.2 +039200*****************TEST (c) - SIMPLE TEST***************** IF1194.2 +039300 F-MAX-03. IF1194.2 +039400 IF (FUNCTION MAX(4.3, 2.6, 7.3, 9.1) >= 9.09982) AND IF1194.2 +039500 (FUNCTION MAX(4.3, 2.6, 7.3, 9.1) <= 9.10018) IF1194.2 +039600 PERFORM PASS IF1194.2 +039700 ELSE IF1194.2 +039800 PERFORM FAIL. IF1194.2 +039900 GO TO F-MAX-WRITE-03. IF1194.2 +040000 F-MAX-DELETE-03. IF1194.2 +040100 PERFORM DE-LETE. IF1194.2 +040200 GO TO F-MAX-WRITE-03. IF1194.2 +040300 F-MAX-WRITE-03. IF1194.2 +040400 MOVE "F-MAX-03" TO PAR-NAME. IF1194.2 +040500 PERFORM PRINT-DETAIL. IF1194.2 +040600*****************TEST (d) - SIMPLE TEST***************** IF1194.2 +040700 F-MAX-04. IF1194.2 +040800 MOVE ZERO TO WS-NUM. IF1194.2 +040900 F-MAX-TEST-04. IF1194.2 +041000 COMPUTE WS-NUM = FUNCTION MAX(-4.3, 10.2, -0.7, 3.9). IF1194.2 +041100 IF (WS-NUM >= 10.1998) AND IF1194.2 +041200 (WS-NUM <= 10.2002) IF1194.2 +041300 PERFORM PASS IF1194.2 +041400 ELSE IF1194.2 +041500 MOVE WS-NUM TO COMPUTED-N IF1194.2 +041600 MOVE 10.2 TO CORRECT-N IF1194.2 +041700 PERFORM FAIL. IF1194.2 +041800 GO TO F-MAX-WRITE-04. IF1194.2 +041900 F-MAX-DELETE-04. IF1194.2 +042000 PERFORM DE-LETE. IF1194.2 +042100 GO TO F-MAX-WRITE-04. IF1194.2 +042200 F-MAX-WRITE-04. IF1194.2 +042300 MOVE "F-MAX-04" TO PAR-NAME. IF1194.2 +042400 PERFORM PRINT-DETAIL. IF1194.2 +042500*****************TEST (e) - SIMPLE TEST***************** IF1194.2 +042600 F-MAX-05. IF1194.2 +042700 MOVE ZERO TO WS-NUM. IF1194.2 +042800 F-MAX-TEST-05. IF1194.2 +042900 COMPUTE WS-NUM = FUNCTION MAX(A, B, D). IF1194.2 +043000 IF WS-NUM = 10 THEN IF1194.2 +043100 PERFORM PASS IF1194.2 +043200 ELSE IF1194.2 +043300 MOVE WS-NUM TO COMPUTED-N IF1194.2 +043400 MOVE 10 TO CORRECT-N IF1194.2 +043500 PERFORM FAIL. IF1194.2 +043600 GO TO F-MAX-WRITE-05. IF1194.2 +043700 F-MAX-DELETE-05. IF1194.2 +043800 PERFORM DE-LETE. IF1194.2 +043900 GO TO F-MAX-WRITE-05. IF1194.2 +044000 F-MAX-WRITE-05. IF1194.2 +044100 MOVE "F-MAX-05" TO PAR-NAME. IF1194.2 +044200 PERFORM PRINT-DETAIL. IF1194.2 +044300*****************TEST (f) - SIMPLE TEST***************** IF1194.2 +044400 F-MAX-06. IF1194.2 +044500 MOVE ZERO TO WS-NUM. IF1194.2 +044600 F-MAX-TEST-06. IF1194.2 +044700 COMPUTE WS-NUM = FUNCTION MAX(A, B, C). IF1194.2 +044800 IF WS-NUM = 7 THEN IF1194.2 +044900 PERFORM PASS IF1194.2 +045000 ELSE IF1194.2 +045100 MOVE WS-NUM TO COMPUTED-N IF1194.2 +045200 MOVE 7 TO CORRECT-N IF1194.2 +045300 PERFORM FAIL. IF1194.2 +045400 GO TO F-MAX-WRITE-06. IF1194.2 +045500 F-MAX-DELETE-06. IF1194.2 +045600 PERFORM DE-LETE. IF1194.2 +045700 GO TO F-MAX-WRITE-06. IF1194.2 +045800 F-MAX-WRITE-06. IF1194.2 +045900 MOVE "F-MAX-06" TO PAR-NAME. IF1194.2 +046000 PERFORM PRINT-DETAIL. IF1194.2 +046100*****************TEST (g) - SIMPLE TEST***************** IF1194.2 +046200 F-MAX-07. IF1194.2 +046300 MOVE ZERO TO WS-NUM. IF1194.2 +046400 F-MAX-TEST-07. IF1194.2 +046500 COMPUTE WS-NUM = FUNCTION MAX(E, G). IF1194.2 +046600 IF (WS-NUM >= 34.2593) AND IF1194.2 +046700 (WS-NUM <= 34.2607) IF1194.2 +046800 PERFORM PASS IF1194.2 +046900 ELSE IF1194.2 +047000 MOVE WS-NUM TO COMPUTED-N IF1194.2 +047100 MOVE 34.26 TO CORRECT-N IF1194.2 +047200 PERFORM FAIL. IF1194.2 +047300 GO TO F-MAX-WRITE-07. IF1194.2 +047400 F-MAX-DELETE-07. IF1194.2 +047500 PERFORM DE-LETE. IF1194.2 +047600 GO TO F-MAX-WRITE-07. IF1194.2 +047700 F-MAX-WRITE-07. IF1194.2 +047800 MOVE "F-MAX-07" TO PAR-NAME. IF1194.2 +047900 PERFORM PRINT-DETAIL. IF1194.2 +048000*****************TEST (h) - SIMPLE TEST***************** IF1194.2 +048100 F-MAX-08. IF1194.2 +048200 MOVE ZERO TO WS-NUM. IF1194.2 +048300 F-MAX-TEST-08. IF1194.2 +048400 COMPUTE WS-NUM = FUNCTION MAX(F, G, H). IF1194.2 +048500 IF (WS-NUM >= 4.07992) AND IF1194.2 +048600 (WS-NUM <= 4.08008) IF1194.2 +048700 PERFORM PASS IF1194.2 +048800 ELSE IF1194.2 +048900 MOVE WS-NUM TO COMPUTED-N IF1194.2 +049000 MOVE 4.08 TO CORRECT-N IF1194.2 +049100 PERFORM FAIL. IF1194.2 +049200 GO TO F-MAX-WRITE-08. IF1194.2 +049300 F-MAX-DELETE-08. IF1194.2 +049400 PERFORM DE-LETE. IF1194.2 +049500 GO TO F-MAX-WRITE-08. IF1194.2 +049600 F-MAX-WRITE-08. IF1194.2 +049700 MOVE "F-MAX-08" TO PAR-NAME. IF1194.2 +049800 PERFORM PRINT-DETAIL. IF1194.2 +049900*****************TEST (i) - SIMPLE TEST***************** IF1194.2 +050000 F-MAX-09. IF1194.2 +050100 MOVE ZERO TO WS-NUM. IF1194.2 +050200 F-MAX-TEST-09. IF1194.2 +050300 COMPUTE WS-NUM = FUNCTION MAX(A, 4, 8, -10, C, 0). IF1194.2 +050400 IF WS-NUM = 8 THEN IF1194.2 +050500 PERFORM PASS IF1194.2 +050600 ELSE IF1194.2 +050700 MOVE WS-NUM TO COMPUTED-N IF1194.2 +050800 MOVE 8 TO CORRECT-N IF1194.2 +050900 PERFORM FAIL. IF1194.2 +051000 GO TO F-MAX-WRITE-09. IF1194.2 +051100 F-MAX-DELETE-09. IF1194.2 +051200 PERFORM DE-LETE. IF1194.2 +051300 GO TO F-MAX-WRITE-09. IF1194.2 +051400 F-MAX-WRITE-09. IF1194.2 +051500 MOVE "F-MAX-09" TO PAR-NAME. IF1194.2 +051600 PERFORM PRINT-DETAIL. IF1194.2 +051700*****************TEST (j) - SIMPLE TEST***************** IF1194.2 +051800 F-MAX-10. IF1194.2 +051900 MOVE ZERO TO WS-NUM. IF1194.2 +052000 F-MAX-TEST-10. IF1194.2 +052100 COMPUTE WS-NUM = FUNCTION MAX(4, D, H, 6.3, -2.0). IF1194.2 +052200 IF (WS-NUM >= 9.9998) AND IF1194.2 +052300 (WS-NUM <= 10.0002) IF1194.2 +052400 PERFORM PASS IF1194.2 +052500 ELSE IF1194.2 +052600 MOVE WS-NUM TO COMPUTED-N IF1194.2 +052700 MOVE 10 TO CORRECT-N IF1194.2 +052800 PERFORM FAIL. IF1194.2 +052900 GO TO F-MAX-WRITE-10. IF1194.2 +053000 F-MAX-DELETE-10. IF1194.2 +053100 PERFORM DE-LETE. IF1194.2 +053200 GO TO F-MAX-WRITE-10. IF1194.2 +053300 F-MAX-WRITE-10. IF1194.2 +053400 MOVE "F-MAX-10" TO PAR-NAME. IF1194.2 +053500 PERFORM PRINT-DETAIL. IF1194.2 +053600*****************TEST (k) - SIMPLE TEST***************** IF1194.2 +053700 F-MAX-11. IF1194.2 +053800 MOVE SPACES TO WS-ANUM. IF1194.2 +053900 F-MAX-TEST-11. IF1194.2 +054000 MOVE FUNCTION MAX("R", I, "I", "a") TO WS-ANUM. IF1194.2 +054100 IF WS-ANUM = "a" THEN IF1194.2 +054200 PERFORM PASS IF1194.2 +054300 ELSE IF1194.2 +054400 MOVE WS-ANUM TO COMPUTED-A IF1194.2 +054500 MOVE "a" TO CORRECT-A IF1194.2 +054600 PERFORM FAIL. IF1194.2 +054700 GO TO F-MAX-WRITE-11. IF1194.2 +054800 F-MAX-DELETE-11. IF1194.2 +054900 PERFORM DE-LETE. IF1194.2 +055000 GO TO F-MAX-WRITE-11. IF1194.2 +055100 F-MAX-WRITE-11. IF1194.2 +055200 MOVE "F-MAX-11" TO PAR-NAME. IF1194.2 +055300 PERFORM PRINT-DETAIL. IF1194.2 +055400*****************TEST (l) - SIMPLE TEST***************** IF1194.2 +055500 F-MAX-12. IF1194.2 +055600 MOVE ZERO TO WS-NUM. IF1194.2 +055700 F-MAX-TEST-12. IF1194.2 +055800 MOVE FUNCTION MAX("A", J, "J") TO WS-ANUM. IF1194.2 +055900 IF WS-ANUM = "U" THEN IF1194.2 +056000 PERFORM PASS IF1194.2 +056100 ELSE IF1194.2 +056200 MOVE WS-ANUM TO COMPUTED-A IF1194.2 +056300 MOVE "U" TO CORRECT-A IF1194.2 +056400 PERFORM FAIL. IF1194.2 +056500 GO TO F-MAX-WRITE-12. IF1194.2 +056600 F-MAX-DELETE-12. IF1194.2 +056700 PERFORM DE-LETE. IF1194.2 +056800 GO TO F-MAX-WRITE-12. IF1194.2 +056900 F-MAX-WRITE-12. IF1194.2 +057000 MOVE "F-MAX-12" TO PAR-NAME. IF1194.2 +057100 PERFORM PRINT-DETAIL. IF1194.2 +057200*****************TEST (m) - SIMPLE TEST***************** IF1194.2 +057300 F-MAX-13. IF1194.2 +057400 MOVE ZERO TO WS-NUM. IF1194.2 +057500 F-MAX-TEST-13. IF1194.2 +057600 COMPUTE WS-NUM = FUNCTION MAX(IND(M), IND(N), IND(O)). IF1194.2 +057700 IF WS-NUM = 7 THEN IF1194.2 +057800 PERFORM PASS IF1194.2 +057900 ELSE IF1194.2 +058000 MOVE WS-NUM TO COMPUTED-N IF1194.2 +058100 MOVE 7 TO CORRECT-N IF1194.2 +058200 PERFORM FAIL. IF1194.2 +058300 GO TO F-MAX-WRITE-13. IF1194.2 +058400 F-MAX-DELETE-13. IF1194.2 +058500 PERFORM DE-LETE. IF1194.2 +058600 GO TO F-MAX-WRITE-13. IF1194.2 +058700 F-MAX-WRITE-13. IF1194.2 +058800 MOVE "F-MAX-13" TO PAR-NAME. IF1194.2 +058900 PERFORM PRINT-DETAIL. IF1194.2 +059000*****************TEST (n) - SIMPLE TEST***************** IF1194.2 +059100 F-MAX-14. IF1194.2 +059200 MOVE ZERO TO WS-NUM. IF1194.2 +059300 F-MAX-TEST-14. IF1194.2 +059400 COMPUTE WS-NUM = FUNCTION MAX(IND(1), IND(2), IND(3)). IF1194.2 +059500 IF WS-NUM = 5 THEN IF1194.2 +059600 PERFORM PASS IF1194.2 +059700 ELSE IF1194.2 +059800 MOVE WS-NUM TO COMPUTED-N IF1194.2 +059900 MOVE 5 TO CORRECT-N IF1194.2 +060000 PERFORM FAIL. IF1194.2 +060100 GO TO F-MAX-WRITE-14. IF1194.2 +060200 F-MAX-DELETE-14. IF1194.2 +060300 PERFORM DE-LETE. IF1194.2 +060400 GO TO F-MAX-WRITE-14. IF1194.2 +060500 F-MAX-WRITE-14. IF1194.2 +060600 MOVE "F-MAX-14" TO PAR-NAME. IF1194.2 +060700 PERFORM PRINT-DETAIL. IF1194.2 +060800*****************TEST (o) - SIMPLE TEST***************** IF1194.2 +060900 F-MAX-15. IF1194.2 +061000 MOVE ZERO TO WS-NUM. IF1194.2 +061100 F-MAX-TEST-15. IF1194.2 +rogerw COMPUTE WS-NUM = FUNCTION MAX (4 0 5 3 7). +061300 IF WS-NUM = 7 THEN IF1194.2 +061400 PERFORM PASS IF1194.2 +061500 ELSE IF1194.2 +061600 MOVE WS-NUM TO COMPUTED-N IF1194.2 +061700 MOVE 7 TO CORRECT-N IF1194.2 +061800 PERFORM FAIL. IF1194.2 +061900 GO TO F-MAX-WRITE-15. IF1194.2 +062000 F-MAX-DELETE-15. IF1194.2 +062100 PERFORM DE-LETE. IF1194.2 +062200 GO TO F-MAX-WRITE-15. IF1194.2 +062300 F-MAX-WRITE-15. IF1194.2 +062400 MOVE "F-MAX-15" TO PAR-NAME. IF1194.2 +062500 PERFORM PRINT-DETAIL. IF1194.2 +062600*****************TEST (q) - SIMPLE TEST***************** IF1194.2 +062700 F-MAX-17. IF1194.2 +062800 MOVE ZERO TO WS-NUM. IF1194.2 +062900 F-MAX-TEST-17. IF1194.2 +063000 COMPUTE WS-NUM = IF1194.2 +063100 FUNCTION MAX(31000, 310001, 78000, 29000, 12000). IF1194.2 +063200 IF WS-NUM = 310001 THEN IF1194.2 +063300 PERFORM PASS IF1194.2 +063400 ELSE IF1194.2 +063500 MOVE WS-NUM TO COMPUTED-N IF1194.2 +063600 MOVE 310001 TO CORRECT-N IF1194.2 +063700 PERFORM FAIL. IF1194.2 +063800 GO TO F-MAX-WRITE-17. IF1194.2 +063900 F-MAX-DELETE-17. IF1194.2 +064000 PERFORM DE-LETE. IF1194.2 +064100 GO TO F-MAX-WRITE-17. IF1194.2 +064200 F-MAX-WRITE-17. IF1194.2 +064300 MOVE "F-MAX-17" TO PAR-NAME. IF1194.2 +064400 PERFORM PRINT-DETAIL. IF1194.2 +064500*****************TEST (a) - COMPLEX TEST**************** IF1194.2 +064600 F-MAX-18. IF1194.2 +064700 MOVE ZERO TO WS-NUM. IF1194.2 +064800 MOVE 34.9993 TO MIN-RANGE. IF1194.2 +064900 MOVE 35.0007 TO MAX-RANGE. IF1194.2 +065000 F-MAX-TEST-18. IF1194.2 +065100 COMPUTE WS-NUM = FUNCTION MAX(A * B, (C + 1) / 2, 3 + 4). IF1194.2 +065200 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +065300 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +065400 PERFORM PASS IF1194.2 +065500 ELSE IF1194.2 +065600 MOVE WS-NUM TO COMPUTED-N IF1194.2 +065700 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +065800 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +065900 PERFORM FAIL. IF1194.2 +066000 GO TO F-MAX-WRITE-18. IF1194.2 +066100 F-MAX-DELETE-18. IF1194.2 +066200 PERFORM DE-LETE. IF1194.2 +066300 GO TO F-MAX-WRITE-18. IF1194.2 +066400 F-MAX-WRITE-18. IF1194.2 +066500 MOVE "F-MAX-18" TO PAR-NAME. IF1194.2 +066600 PERFORM PRINT-DETAIL. IF1194.2 +066700*****************TEST (b) - COMPLEX TEST**************** IF1194.2 +066800 F-MAX-19. IF1194.2 +066900 MOVE ZERO TO WS-NUM. IF1194.2 +067000 MOVE 38.2592 TO MIN-RANGE. IF1194.2 +067100 MOVE 38.2608 TO MAX-RANGE. IF1194.2 +067200 F-MAX-TEST-19. IF1194.2 +067300 COMPUTE WS-NUM = FUNCTION MAX(E + 4, H * 2, 5 + A). IF1194.2 +067400 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +067500 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +067600 PERFORM PASS IF1194.2 +067700 ELSE IF1194.2 +067800 MOVE WS-NUM TO COMPUTED-N IF1194.2 +067900 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +068000 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +068100 PERFORM FAIL. IF1194.2 +068200 GO TO F-MAX-WRITE-19. IF1194.2 +068300 F-MAX-DELETE-19. IF1194.2 +068400 PERFORM DE-LETE. IF1194.2 +068500 GO TO F-MAX-WRITE-19. IF1194.2 +068600 F-MAX-WRITE-19. IF1194.2 +068700 MOVE "F-MAX-19" TO PAR-NAME. IF1194.2 +068800 PERFORM PRINT-DETAIL. IF1194.2 +068900*****************TEST (c) - COMPLEX TEST**************** IF1194.2 +069000 F-MAX-20. IF1194.2 +069100 MOVE ZERO TO WS-NUM. IF1194.2 +069200 MOVE -7.00014 TO MIN-RANGE. IF1194.2 +069300 MOVE -6.99986 TO MAX-RANGE. IF1194.2 +069400 F-MAX-TEST-20. IF1194.2 +069500 COMPUTE WS-NUM = FUNCTION MAX(-7, -9 + 2, -7). IF1194.2 +069600 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +069700 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +069800 PERFORM PASS IF1194.2 +069900 ELSE IF1194.2 +070000 MOVE WS-NUM TO COMPUTED-N IF1194.2 +070100 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +070200 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +070300 PERFORM FAIL. IF1194.2 +070400 GO TO F-MAX-WRITE-20. IF1194.2 +070500 F-MAX-DELETE-20. IF1194.2 +070600 PERFORM DE-LETE. IF1194.2 +070700 GO TO F-MAX-WRITE-20. IF1194.2 +070800 F-MAX-WRITE-20. IF1194.2 +070900 MOVE "F-MAX-20" TO PAR-NAME. IF1194.2 +071000 PERFORM PRINT-DETAIL. IF1194.2 +071100*****************TEST (d) - COMPLEX TEST**************** IF1194.2 +071200 F-MAX-21. IF1194.2 +071300 MOVE ZERO TO WS-NUM. IF1194.2 +071400 MOVE 49.9990 TO MIN-RANGE. IF1194.2 +071500 MOVE 50.0001 TO MAX-RANGE. IF1194.2 +071600 F-MAX-TEST-21. IF1194.2 +071700 COMPUTE WS-NUM = FUNCTION MAX(FUNCTION MAX(14, A), E, 50). IF1194.2 +071800 IF1194.2 +071900 IF1194.2 +072000 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +072100 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +072200 PERFORM PASS IF1194.2 +072300 ELSE IF1194.2 +072400 MOVE WS-NUM TO COMPUTED-N IF1194.2 +072500 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +072600 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +072700 PERFORM FAIL. IF1194.2 +072800 GO TO F-MAX-WRITE-21. IF1194.2 +072900 F-MAX-DELETE-21. IF1194.2 +073000 PERFORM DE-LETE. IF1194.2 +073100 GO TO F-MAX-WRITE-21. IF1194.2 +073200 F-MAX-WRITE-21. IF1194.2 +073300 MOVE "F-MAX-21" TO PAR-NAME. IF1194.2 +073400 PERFORM PRINT-DETAIL. IF1194.2 +073500*****************TEST (e) - COMPLEX TEST**************** IF1194.2 +073600 F-MAX-22. IF1194.2 +073700 MOVE ZERO TO WS-NUM. IF1194.2 +073800 MOVE 36.2593 TO MIN-RANGE. IF1194.2 +073900 MOVE 36.2607 TO MAX-RANGE. IF1194.2 +074000 F-MAX-TEST-22. IF1194.2 +074100 COMPUTE WS-NUM = FUNCTION MAX(4, B, E) + 2. IF1194.2 +074200 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +074300 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +074400 PERFORM PASS IF1194.2 +074500 ELSE IF1194.2 +074600 MOVE WS-NUM TO COMPUTED-N IF1194.2 +074700 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +074800 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +074900 PERFORM FAIL. IF1194.2 +075000 GO TO F-MAX-WRITE-22. IF1194.2 +075100 F-MAX-DELETE-22. IF1194.2 +075200 PERFORM DE-LETE. IF1194.2 +075300 GO TO F-MAX-WRITE-22. IF1194.2 +075400 F-MAX-WRITE-22. IF1194.2 +075500 MOVE "F-MAX-22" TO PAR-NAME. IF1194.2 +075600 PERFORM PRINT-DETAIL. IF1194.2 +075700*****************TEST (f) - COMPLEX TEST**************** IF1194.2 +075800 F-MAX-23. IF1194.2 +075900 MOVE ZERO TO WS-NUM. IF1194.2 +076000 MOVE 11.9998 TO MIN-RANGE. IF1194.2 +076100 MOVE 12.0002 TO MAX-RANGE. IF1194.2 +076200 F-MAX-TEST-23. IF1194.2 +076300 COMPUTE WS-NUM = FUNCTION MAX(A, G) + IF1194.2 +076400 FUNCTION MAX(B, 0). IF1194.2 +076500 IF (WS-NUM >= MIN-RANGE) AND IF1194.2 +076600 (WS-NUM <= MAX-RANGE) THEN IF1194.2 +076700 PERFORM PASS IF1194.2 +076800 ELSE IF1194.2 +076900 MOVE WS-NUM TO COMPUTED-N IF1194.2 +077000 MOVE MIN-RANGE TO CORRECT-MIN IF1194.2 +077100 MOVE MAX-RANGE TO CORRECT-MAX IF1194.2 +077200 PERFORM FAIL. IF1194.2 +077300 GO TO F-MAX-WRITE-23. IF1194.2 +077400 F-MAX-DELETE-23. IF1194.2 +077500 PERFORM DE-LETE. IF1194.2 +077600 GO TO F-MAX-WRITE-23. IF1194.2 +077700 F-MAX-WRITE-23. IF1194.2 +077800 MOVE "F-MAX-23" TO PAR-NAME. IF1194.2 +077900 PERFORM PRINT-DETAIL. IF1194.2 +078000*****************SPECIAL PERFORM TEST********************** IF1194.2 +078100 F-MAX-24. IF1194.2 +078200 PERFORM F-MAX-TEST-24 IF1194.2 +078300 UNTIL FUNCTION MAX(ARG1, 1) > 5. IF1194.2 +078400 PERFORM PASS. IF1194.2 +078500 GO TO F-MAX-WRITE-24. IF1194.2 +078600 F-MAX-TEST-24. IF1194.2 +078700 COMPUTE ARG1 = ARG1 + 1. IF1194.2 +078800 F-MAX-DELETE-24. IF1194.2 +078900 PERFORM DE-LETE. IF1194.2 +079000 GO TO F-MAX-WRITE-24. IF1194.2 +079100 F-MAX-WRITE-24. IF1194.2 +079200 MOVE "F-MAX-24" TO PAR-NAME. IF1194.2 +079300 PERFORM PRINT-DETAIL. IF1194.2 +079400********************END OF TESTS*************** IF1194.2 +079500 CCVS-EXIT SECTION. IF1194.2 +079600 CCVS-999999. IF1194.2 +079700 GO TO CLOSE-FILES. IF1194.2 diff --git a/tests/cobol85/IF/IF120A.CBL b/tests/cobol85/IF/IF120A.CBL new file mode 100755 index 00000000..c95fd880 --- /dev/null +++ b/tests/cobol85/IF/IF120A.CBL @@ -0,0 +1,684 @@ +000100 IDENTIFICATION DIVISION. IF1204.2 +000200 PROGRAM-ID. IF1204.2 +000300 IF120A. IF1204.2 +000400 IF1204.2 +000500*********************************************************** IF1204.2 +000600* * IF1204.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1204.2 +000800* It contains tests for the Intrinsic Function MEAN. * IF1204.2 +000900* * IF1204.2 +001000*********************************************************** IF1204.2 +001100 ENVIRONMENT DIVISION. IF1204.2 +001200 CONFIGURATION SECTION. IF1204.2 +001300 SOURCE-COMPUTER. IF1204.2 +001400 Linux. IF1204.2 +001500 OBJECT-COMPUTER. IF1204.2 +001600 Linux. IF1204.2 +001700 INPUT-OUTPUT SECTION. IF1204.2 +001800 FILE-CONTROL. IF1204.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1204.2 +002000 "report.log". IF1204.2 +002100 DATA DIVISION. IF1204.2 +002200 FILE SECTION. IF1204.2 +002300 FD PRINT-FILE. IF1204.2 +002400 01 PRINT-REC PICTURE X(120). IF1204.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1204.2 +002600 WORKING-STORAGE SECTION. IF1204.2 +002700*********************************************************** IF1204.2 +002800* Variables specific to the Intrinsic Function Test IF120A* IF1204.2 +002900*********************************************************** IF1204.2 +003000 01 A PIC S9(10) VALUE 5. IF1204.2 +003100 01 B PIC S9(10) VALUE 7. IF1204.2 +003200 01 C PIC S9(10) VALUE -4. IF1204.2 +003300 01 D PIC S9(10) VALUE 10. IF1204.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1204.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1204.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1204.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1204.2 +003800 01 M PIC S9(10) VALUE 320000. IF1204.2 +003900 01 N PIC S9(10) VALUE 650000. IF1204.2 +004000 01 O PIC S9(10) VALUE -430000. IF1204.2 +004100 01 P PIC S9(10) VALUE 1. IF1204.2 +004200 01 Q PIC S9(10) VALUE 3. IF1204.2 +004300 01 R PIC S9(10) VALUE 5. IF1204.2 +004400 01 ARG1 PIC S9(10) VALUE 1. IF1204.2 +004500 01 ARG2 PIC S9(10) VALUE 1. IF1204.2 +004600 01 ARR VALUE "40537". IF1204.2 +004700 02 IND OCCURS 5 TIMES PIC 9. IF1204.2 +004800 01 TEMP PIC S9(10)V9(5). IF1204.2 +004900 01 WS-NUM PIC S9(6)V9(6). IF1204.2 +005000 01 MIN-RANGE PIC S9(5)V9(7). IF1204.2 +005100 01 MAX-RANGE PIC S9(5)V9(7). IF1204.2 +005200* IF1204.2 +005300********************************************************** IF1204.2 +005400* IF1204.2 +005500 01 TEST-RESULTS. IF1204.2 +005600 02 FILLER PIC X VALUE SPACE. IF1204.2 +005700 02 FEATURE PIC X(20) VALUE SPACE. IF1204.2 +005800 02 FILLER PIC X VALUE SPACE. IF1204.2 +005900 02 P-OR-F PIC X(5) VALUE SPACE. IF1204.2 +006000 02 FILLER PIC X VALUE SPACE. IF1204.2 +006100 02 PAR-NAME. IF1204.2 +006200 03 FILLER PIC X(19) VALUE SPACE. IF1204.2 +006300 03 PARDOT-X PIC X VALUE SPACE. IF1204.2 +006400 03 DOTVALUE PIC 99 VALUE ZERO. IF1204.2 +006500 02 FILLER PIC X(8) VALUE SPACE. IF1204.2 +006600 02 RE-MARK PIC X(61). IF1204.2 +006700 01 TEST-COMPUTED. IF1204.2 +006800 02 FILLER PIC X(30) VALUE SPACE. IF1204.2 +006900 02 FILLER PIC X(17) VALUE IF1204.2 +007000 " COMPUTED=". IF1204.2 +007100 02 COMPUTED-X. IF1204.2 +007200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1204.2 +007300 03 COMPUTED-N REDEFINES COMPUTED-A IF1204.2 +007400 PIC -9(9).9(9). IF1204.2 +007500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1204.2 +007600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1204.2 +007700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1204.2 +007800 03 CM-18V0 REDEFINES COMPUTED-A. IF1204.2 +007900 04 COMPUTED-18V0 PIC -9(18). IF1204.2 +008000 04 FILLER PIC X. IF1204.2 +008100 03 FILLER PIC X(50) VALUE SPACE. IF1204.2 +008200 01 TEST-CORRECT. IF1204.2 +008300 02 FILLER PIC X(30) VALUE SPACE. IF1204.2 +008400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1204.2 +008500 02 CORRECT-X. IF1204.2 +008600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1204.2 +008700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1204.2 +008800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1204.2 +008900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1204.2 +009000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1204.2 +009100 03 CR-18V0 REDEFINES CORRECT-A. IF1204.2 +009200 04 CORRECT-18V0 PIC -9(18). IF1204.2 +009300 04 FILLER PIC X. IF1204.2 +009400 03 FILLER PIC X(2) VALUE SPACE. IF1204.2 +009500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1204.2 +009600 01 TEST-CORRECT-MIN. IF1204.2 +009700 02 FILLER PIC X(30) VALUE SPACE. IF1204.2 +009800 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1204.2 +009900 02 CORRECTMI-X. IF1204.2 +010000 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1204.2 +010100 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1204.2 +010200 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1204.2 +010300 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1204.2 +010400 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1204.2 +010500 03 CR-18V0 REDEFINES CORRECTMI-A. IF1204.2 +010600 04 CORRECTMI-18V0 PIC -9(18). IF1204.2 +010700 04 FILLER PIC X. IF1204.2 +010800 03 FILLER PIC X(2) VALUE SPACE. IF1204.2 +010900 03 FILLER PIC X(48) VALUE SPACE. IF1204.2 +011000 01 TEST-CORRECT-MAX. IF1204.2 +011100 02 FILLER PIC X(30) VALUE SPACE. IF1204.2 +011200 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1204.2 +011300 02 CORRECTMA-X. IF1204.2 +011400 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1204.2 +011500 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1204.2 +011600 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1204.2 +011700 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1204.2 +011800 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1204.2 +011900 03 CR-18V0 REDEFINES CORRECTMA-A. IF1204.2 +012000 04 CORRECTMA-18V0 PIC -9(18). IF1204.2 +012100 04 FILLER PIC X. IF1204.2 +012200 03 FILLER PIC X(2) VALUE SPACE. IF1204.2 +012300 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1204.2 +012400 01 CCVS-C-1. IF1204.2 +012500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1204.2 +012600- "SS PARAGRAPH-NAME IF1204.2 +012700- " REMARKS". IF1204.2 +012800 02 FILLER PIC X(20) VALUE SPACE. IF1204.2 +012900 01 CCVS-C-2. IF1204.2 +013000 02 FILLER PIC X VALUE SPACE. IF1204.2 +013100 02 FILLER PIC X(6) VALUE "TESTED". IF1204.2 +013200 02 FILLER PIC X(15) VALUE SPACE. IF1204.2 +013300 02 FILLER PIC X(4) VALUE "FAIL". IF1204.2 +013400 02 FILLER PIC X(94) VALUE SPACE. IF1204.2 +013500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1204.2 +013600 01 REC-CT PIC 99 VALUE ZERO. IF1204.2 +013700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1204.2 +013800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1204.2 +013900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1204.2 +014000 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1204.2 +014100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1204.2 +014200 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1204.2 +014300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1204.2 +014400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1204.2 +014500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1204.2 +014600 01 CCVS-H-1. IF1204.2 +014700 02 FILLER PIC X(39) VALUE SPACES. IF1204.2 +014800 02 FILLER PIC X(42) VALUE IF1204.2 +014900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1204.2 +015000 02 FILLER PIC X(39) VALUE SPACES. IF1204.2 +015100 01 CCVS-H-2A. IF1204.2 +015200 02 FILLER PIC X(40) VALUE SPACE. IF1204.2 +015300 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1204.2 +015400 02 FILLER PIC XXXX VALUE IF1204.2 +015500 "4.2 ". IF1204.2 +015600 02 FILLER PIC X(28) VALUE IF1204.2 +015700 " COPY - NOT FOR DISTRIBUTION". IF1204.2 +015800 02 FILLER PIC X(41) VALUE SPACE. IF1204.2 +015900 IF1204.2 +016000 01 CCVS-H-2B. IF1204.2 +016100 02 FILLER PIC X(15) VALUE IF1204.2 +016200 "TEST RESULT OF ". IF1204.2 +016300 02 TEST-ID PIC X(9). IF1204.2 +016400 02 FILLER PIC X(4) VALUE IF1204.2 +016500 " IN ". IF1204.2 +016600 02 FILLER PIC X(12) VALUE IF1204.2 +016700 " HIGH ". IF1204.2 +016800 02 FILLER PIC X(22) VALUE IF1204.2 +016900 " LEVEL VALIDATION FOR ". IF1204.2 +017000 02 FILLER PIC X(58) VALUE IF1204.2 +017100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1204.2 +017200 01 CCVS-H-3. IF1204.2 +017300 02 FILLER PIC X(34) VALUE IF1204.2 +017400 " FOR OFFICIAL USE ONLY ". IF1204.2 +017500 02 FILLER PIC X(58) VALUE IF1204.2 +017600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1204.2 +017700 02 FILLER PIC X(28) VALUE IF1204.2 +017800 " COPYRIGHT 1985 ". IF1204.2 +017900 01 CCVS-E-1. IF1204.2 +018000 02 FILLER PIC X(52) VALUE SPACE. IF1204.2 +018100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1204.2 +018200 02 ID-AGAIN PIC X(9). IF1204.2 +018300 02 FILLER PIC X(45) VALUE SPACES. IF1204.2 +018400 01 CCVS-E-2. IF1204.2 +018500 02 FILLER PIC X(31) VALUE SPACE. IF1204.2 +018600 02 FILLER PIC X(21) VALUE SPACE. IF1204.2 +018700 02 CCVS-E-2-2. IF1204.2 +018800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1204.2 +018900 03 FILLER PIC X VALUE SPACE. IF1204.2 +019000 03 ENDER-DESC PIC X(44) VALUE IF1204.2 +019100 "ERRORS ENCOUNTERED". IF1204.2 +019200 01 CCVS-E-3. IF1204.2 +019300 02 FILLER PIC X(22) VALUE IF1204.2 +019400 " FOR OFFICIAL USE ONLY". IF1204.2 +019500 02 FILLER PIC X(12) VALUE SPACE. IF1204.2 +019600 02 FILLER PIC X(58) VALUE IF1204.2 +019700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1204.2 +019800 02 FILLER PIC X(13) VALUE SPACE. IF1204.2 +019900 02 FILLER PIC X(15) VALUE IF1204.2 +020000 " COPYRIGHT 1985". IF1204.2 +020100 01 CCVS-E-4. IF1204.2 +020200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1204.2 +020300 02 FILLER PIC X(4) VALUE " OF ". IF1204.2 +020400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1204.2 +020500 02 FILLER PIC X(40) VALUE IF1204.2 +020600 " TESTS WERE EXECUTED SUCCESSFULLY". IF1204.2 +020700 01 XXINFO. IF1204.2 +020800 02 FILLER PIC X(19) VALUE IF1204.2 +020900 "*** INFORMATION ***". IF1204.2 +021000 02 INFO-TEXT. IF1204.2 +021100 04 FILLER PIC X(8) VALUE SPACE. IF1204.2 +021200 04 XXCOMPUTED PIC X(20). IF1204.2 +021300 04 FILLER PIC X(5) VALUE SPACE. IF1204.2 +021400 04 XXCORRECT PIC X(20). IF1204.2 +021500 02 INF-ANSI-REFERENCE PIC X(48). IF1204.2 +021600 01 HYPHEN-LINE. IF1204.2 +021700 02 FILLER PIC IS X VALUE IS SPACE. IF1204.2 +021800 02 FILLER PIC IS X(65) VALUE IS "************************IF1204.2 +021900- "*****************************************". IF1204.2 +022000 02 FILLER PIC IS X(54) VALUE IS "************************IF1204.2 +022100- "******************************". IF1204.2 +022200 01 CCVS-PGM-ID PIC X(9) VALUE IF1204.2 +022300 "IF120A". IF1204.2 +022400 PROCEDURE DIVISION. IF1204.2 +022500 CCVS1 SECTION. IF1204.2 +022600 OPEN-FILES. IF1204.2 +022700 OPEN OUTPUT PRINT-FILE. IF1204.2 +022800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1204.2 +022900 MOVE SPACE TO TEST-RESULTS. IF1204.2 +023000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1204.2 +023100 GO TO CCVS1-EXIT. IF1204.2 +023200 CLOSE-FILES. IF1204.2 +023300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1204.2 +023400 TERMINATE-CCVS. IF1204.2 +023500 STOP RUN. IF1204.2 +023600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1204.2 +023700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1204.2 +023800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1204.2 +023900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1204.2 +024000 MOVE "****TEST DELETED****" TO RE-MARK. IF1204.2 +024100 PRINT-DETAIL. IF1204.2 +024200 IF REC-CT NOT EQUAL TO ZERO IF1204.2 +024300 MOVE "." TO PARDOT-X IF1204.2 +024400 MOVE REC-CT TO DOTVALUE. IF1204.2 +024500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1204.2 +024600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1204.2 +024700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1204.2 +024800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1204.2 +024900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1204.2 +025000 MOVE SPACE TO CORRECT-X. IF1204.2 +025100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1204.2 +025200 MOVE SPACE TO RE-MARK. IF1204.2 +025300 HEAD-ROUTINE. IF1204.2 +025400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +025500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +025600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1204.2 +025700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1204.2 +025800 COLUMN-NAMES-ROUTINE. IF1204.2 +025900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +026000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +026100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +026200 END-ROUTINE. IF1204.2 +026300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1204.2 +026400 END-RTN-EXIT. IF1204.2 +026500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +026600 END-ROUTINE-1. IF1204.2 +026700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1204.2 +026800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1204.2 +026900 ADD PASS-COUNTER TO ERROR-HOLD. IF1204.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1204.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1204.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1204.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1204.2 +027400 END-ROUTINE-12. IF1204.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1204.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO IF1204.2 +027700 MOVE "NO " TO ERROR-TOTAL IF1204.2 +027800 ELSE IF1204.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1204.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1204.2 +028100 PERFORM WRITE-LINE. IF1204.2 +028200 END-ROUTINE-13. IF1204.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO IF1204.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE IF1204.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1204.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1204.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO IF1204.2 +028900 MOVE "NO " TO ERROR-TOTAL IF1204.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1204.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1204.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1204.2 +029400 WRITE-LINE. IF1204.2 +029500 ADD 1 TO RECORD-COUNT. IF1204.2 +029600 IF RECORD-COUNT GREATER 42 IF1204.2 +029700 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1204.2 +029800 MOVE SPACE TO DUMMY-RECORD IF1204.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1204.2 +030000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1204.2 +030100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1204.2 +030200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1204.2 +030300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1204.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1204.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1204.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1204.2 +030700 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1204.2 +030800 MOVE ZERO TO RECORD-COUNT. IF1204.2 +030900 PERFORM WRT-LN. IF1204.2 +031000 WRT-LN. IF1204.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1204.2 +031200 MOVE SPACE TO DUMMY-RECORD. IF1204.2 +031300 BLANK-LINE-PRINT. IF1204.2 +031400 PERFORM WRT-LN. IF1204.2 +031500 FAIL-ROUTINE. IF1204.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE IF1204.2 +031700 GO TO FAIL-ROUTINE-WRITE. IF1204.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1204.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1204.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1204.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1204.2 +032300 GO TO FAIL-ROUTINE-EX. IF1204.2 +032400 FAIL-ROUTINE-WRITE. IF1204.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1204.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1204.2 +032700 CORMA-ANSI-REFERENCE. IF1204.2 +032800 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1204.2 +032900 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1204.2 +033000 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1204.2 +033100 ELSE IF1204.2 +033200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1204.2 +033300 PERFORM WRITE-LINE. IF1204.2 +033400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1204.2 +033500 FAIL-ROUTINE-EX. EXIT. IF1204.2 +033600 BAIL-OUT. IF1204.2 +033700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1204.2 +033800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1204.2 +033900 BAIL-OUT-WRITE. IF1204.2 +034000 MOVE CORRECT-A TO XXCORRECT. IF1204.2 +034100 MOVE COMPUTED-A TO XXCOMPUTED. IF1204.2 +034200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1204.2 +034300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1204.2 +034400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1204.2 +034500 BAIL-OUT-EX. EXIT. IF1204.2 +034600 CCVS1-EXIT. IF1204.2 +034700 EXIT. IF1204.2 +034800******************************************************** IF1204.2 +034900* * IF1204.2 +035000* Intrinsic Function Tests IF120A - MEAN * IF1204.2 +035100* * IF1204.2 +035200******************************************************** IF1204.2 +035300 SECT-IF120A SECTION. IF1204.2 +035400 F-MEAN-TEST-INFO. IF1204.2 +035500 MOVE "See ref. A-53 2.24" TO ANSI-REFERENCE. IF1204.2 +035600 MOVE "MEAN Function" TO FEATURE. IF1204.2 +035700*****************TEST (a) - SIMPLE TEST***************** IF1204.2 +035800 F-MEAN-01. IF1204.2 +035900 MOVE ZERO TO WS-NUM. IF1204.2 +036000 F-MEAN-TEST-01. IF1204.2 +036100 COMPUTE WS-NUM = FUNCTION MEAN(5, -2, -14, 0). IF1204.2 +036200 IF (WS-NUM >= -2.75006) AND IF1204.2 +036300 (WS-NUM <= -2.74995) IF1204.2 +036400 PERFORM PASS IF1204.2 +036500 ELSE IF1204.2 +036600 MOVE WS-NUM TO COMPUTED-N IF1204.2 +036700 MOVE -2.75 TO CORRECT-N IF1204.2 +036800 PERFORM FAIL. IF1204.2 +036900 GO TO F-MEAN-WRITE-01. IF1204.2 +037000 F-MEAN-DELETE-01. IF1204.2 +037100 PERFORM DE-LETE. IF1204.2 +037200 GO TO F-MEAN-WRITE-01. IF1204.2 +037300 F-MEAN-WRITE-01. IF1204.2 +037400 MOVE "F-MEAN-01" TO PAR-NAME. IF1204.2 +037500 PERFORM PRINT-DETAIL. IF1204.2 +037600*****************TEST (b) - SIMPLE TEST***************** IF1204.2 +037700 F-MEAN-02. IF1204.2 +037800 EVALUATE FUNCTION MEAN(3.9, -0.3, 8.7, 100.2) IF1204.2 +037900 WHEN 28.1244 THRU 28.1256 IF1204.2 +038000 PERFORM PASS IF1204.2 +038100 WHEN OTHER IF1204.2 +038200 PERFORM FAIL. IF1204.2 +038300 GO TO F-MEAN-WRITE-02. IF1204.2 +038400 F-MEAN-DELETE-02. IF1204.2 +038500 PERFORM DE-LETE. IF1204.2 +038600 GO TO F-MEAN-WRITE-02. IF1204.2 +038700 F-MEAN-WRITE-02. IF1204.2 +038800 MOVE "F-MEAN-02" TO PAR-NAME. IF1204.2 +038900 PERFORM PRINT-DETAIL. IF1204.2 +039000*****************TEST (c) - SIMPLE TEST***************** IF1204.2 +039100 F-MEAN-03. IF1204.2 +039200 IF (FUNCTION MEAN(A, B, C, D) >= 4.49991) AND IF1204.2 +039300 (FUNCTION MEAN(A, B, C, D) <= 4.50009) IF1204.2 +039400 PERFORM PASS IF1204.2 +039500 ELSE IF1204.2 +039600 PERFORM FAIL. IF1204.2 +039700 GO TO F-MEAN-WRITE-03. IF1204.2 +039800 F-MEAN-DELETE-03. IF1204.2 +039900 PERFORM DE-LETE. IF1204.2 +040000 GO TO F-MEAN-WRITE-03. IF1204.2 +040100 F-MEAN-WRITE-03. IF1204.2 +040200 MOVE "F-MEAN-03" TO PAR-NAME. IF1204.2 +040300 PERFORM PRINT-DETAIL. IF1204.2 +040400*****************TEST (d) - SIMPLE TEST***************** IF1204.2 +040500 F-MEAN-04. IF1204.2 +040600 MOVE ZERO TO WS-NUM. IF1204.2 +040700 F-MEAN-TEST-04. IF1204.2 +040800 COMPUTE WS-NUM = FUNCTION MEAN(E, F, G, H). IF1204.2 +040900 IF (WS-NUM >= 6.17988) AND IF1204.2 +041000 (WS-NUM <= 6.18012) IF1204.2 +041100 PERFORM PASS IF1204.2 +041200 ELSE IF1204.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1204.2 +041400 MOVE 6.18 TO CORRECT-N IF1204.2 +041500 PERFORM FAIL. IF1204.2 +041600 GO TO F-MEAN-WRITE-04. IF1204.2 +041700 F-MEAN-DELETE-04. IF1204.2 +041800 PERFORM DE-LETE. IF1204.2 +041900 GO TO F-MEAN-WRITE-04. IF1204.2 +042000 F-MEAN-WRITE-04. IF1204.2 +042100 MOVE "F-MEAN-04" TO PAR-NAME. IF1204.2 +042200 PERFORM PRINT-DETAIL. IF1204.2 +042300*****************TEST (e) - SIMPLE TEST***************** IF1204.2 +042400 F-MEAN-05. IF1204.2 +042500 MOVE ZERO TO WS-NUM. IF1204.2 +042600 F-MEAN-TEST-05. IF1204.2 +042700 COMPUTE WS-NUM = FUNCTION MEAN(10.2, -0.2, 5.6, -15.6). IF1204.2 +042800 IF (WS-NUM >= -0.000020) AND IF1204.2 +042900 (WS-NUM <= 0.000020) IF1204.2 +043000 PERFORM PASS IF1204.2 +043100 ELSE IF1204.2 +043200 MOVE WS-NUM TO COMPUTED-N IF1204.2 +043300 MOVE 0.0 TO CORRECT-N IF1204.2 +043400 PERFORM FAIL. IF1204.2 +043500 GO TO F-MEAN-WRITE-05. IF1204.2 +043600 F-MEAN-DELETE-05. IF1204.2 +043700 PERFORM DE-LETE. IF1204.2 +043800 GO TO F-MEAN-WRITE-05. IF1204.2 +043900 F-MEAN-WRITE-05. IF1204.2 +044000 MOVE "F-MEAN-05" TO PAR-NAME. IF1204.2 +044100 PERFORM PRINT-DETAIL. IF1204.2 +044200*****************TEST (f) - SIMPLE TEST***************** IF1204.2 +044300 F-MEAN-06. IF1204.2 +044400 MOVE ZERO TO WS-NUM. IF1204.2 +044500 F-MEAN-TEST-06. IF1204.2 +044600 COMPUTE WS-NUM = FUNCTION MEAN(A, B, C, D, E, F, G, H). IF1204.2 +044700 IF (WS-NUM >= 5.33989) AND IF1204.2 +044800 (WS-NUM <= 5.34011) IF1204.2 +044900 PERFORM PASS IF1204.2 +045000 ELSE IF1204.2 +045100 MOVE WS-NUM TO COMPUTED-N IF1204.2 +045200 MOVE 5.34 TO CORRECT-N IF1204.2 +045300 PERFORM FAIL. IF1204.2 +045400 GO TO F-MEAN-WRITE-06. IF1204.2 +045500 F-MEAN-DELETE-06. IF1204.2 +045600 PERFORM DE-LETE. IF1204.2 +045700 GO TO F-MEAN-WRITE-06. IF1204.2 +045800 F-MEAN-WRITE-06. IF1204.2 +045900 MOVE "F-MEAN-06" TO PAR-NAME. IF1204.2 +046000 PERFORM PRINT-DETAIL. IF1204.2 +046100*****************TEST (g) - SIMPLE TEST***************** IF1204.2 +046200 F-MEAN-07. IF1204.2 +046300 MOVE ZERO TO WS-NUM. IF1204.2 +046400 F-MEAN-TEST-07. IF1204.2 +046500 COMPUTE WS-NUM = FUNCTION MEAN(IND(2), IND(1), IND(3)). IF1204.2 +046600 IF (WS-NUM >= 2.99994) AND IF1204.2 +046700 (WS-NUM <= 3.00006) IF1204.2 +046800 PERFORM PASS IF1204.2 +046900 ELSE IF1204.2 +047000 MOVE WS-NUM TO COMPUTED-N IF1204.2 +047100 MOVE 3.0 TO CORRECT-N IF1204.2 +047200 PERFORM FAIL. IF1204.2 +047300 GO TO F-MEAN-WRITE-07. IF1204.2 +047400 F-MEAN-DELETE-07. IF1204.2 +047500 PERFORM DE-LETE. IF1204.2 +047600 GO TO F-MEAN-WRITE-07. IF1204.2 +047700 F-MEAN-WRITE-07. IF1204.2 +047800 MOVE "F-MEAN-07" TO PAR-NAME. IF1204.2 +047900 PERFORM PRINT-DETAIL. IF1204.2 +048000*****************TEST (h) - SIMPLE TEST***************** IF1204.2 +048100 F-MEAN-08. IF1204.2 +048200 MOVE ZERO TO WS-NUM. IF1204.2 +048300 F-MEAN-TEST-08. IF1204.2 +048400 COMPUTE WS-NUM = FUNCTION MEAN(IND(P), IND(Q), IND(R)). IF1204.2 +048500 IF (WS-NUM >= 5.33323) AND IF1204.2 +048600 (WS-NUM <= 5.33344) IF1204.2 +048700 PERFORM PASS IF1204.2 +048800 ELSE IF1204.2 +048900 MOVE WS-NUM TO COMPUTED-N IF1204.2 +049000 MOVE 5.333 TO CORRECT-N IF1204.2 +049100 PERFORM FAIL. IF1204.2 +049200 GO TO F-MEAN-WRITE-08. IF1204.2 +049300 F-MEAN-DELETE-08. IF1204.2 +049400 PERFORM DE-LETE. IF1204.2 +049500 GO TO F-MEAN-WRITE-08. IF1204.2 +049600 F-MEAN-WRITE-08. IF1204.2 +049700 MOVE "F-MEAN-08" TO PAR-NAME. IF1204.2 +049800 PERFORM PRINT-DETAIL. IF1204.2 +049900*****************TEST (i) - SIMPLE TEST***************** IF1204.2 +050000 F-MEAN-09. IF1204.2 +050100 MOVE ZERO TO WS-NUM. IF1204.2 +050200 F-MEAN-TEST-09. IF1204.2 +rogerw COMPUTE WS-NUM = FUNCTION MEAN (4 0 5 3 7). +050400 IF (WS-NUM >= 3.79992) AND IF1204.2 +050500 (WS-NUM <= 3.80008) IF1204.2 +050600 PERFORM PASS IF1204.2 +050700 ELSE IF1204.2 +050800 MOVE WS-NUM TO COMPUTED-N IF1204.2 +050900 MOVE 3.8 TO CORRECT-N IF1204.2 +051000 PERFORM FAIL. IF1204.2 +051100 GO TO F-MEAN-WRITE-09. IF1204.2 +051200 F-MEAN-DELETE-09. IF1204.2 +051300 PERFORM DE-LETE. IF1204.2 +051400 GO TO F-MEAN-WRITE-09. IF1204.2 +051500 F-MEAN-WRITE-09. IF1204.2 +051600 MOVE "F-MEAN-09" TO PAR-NAME. IF1204.2 +051700 PERFORM PRINT-DETAIL. IF1204.2 +051800*****************TEST (k) - SIMPLE TEST***************** IF1204.2 +051900 F-MEAN-11. IF1204.2 +052000 MOVE ZERO TO WS-NUM. IF1204.2 +052100 F-MEAN-TEST-11. IF1204.2 +052200 COMPUTE WS-NUM = FUNCTION MEAN(M, N, O). IF1204.2 +052300 IF WS-NUM = 180000 THEN IF1204.2 +052400 PERFORM PASS IF1204.2 +052500 ELSE IF1204.2 +052600 MOVE WS-NUM TO COMPUTED-N IF1204.2 +052700 MOVE 180000 TO CORRECT-N IF1204.2 +052800 PERFORM FAIL. IF1204.2 +052900 GO TO F-MEAN-WRITE-11. IF1204.2 +053000 F-MEAN-DELETE-11. IF1204.2 +053100 PERFORM DE-LETE. IF1204.2 +053200 GO TO F-MEAN-WRITE-11. IF1204.2 +053300 F-MEAN-WRITE-11. IF1204.2 +053400 MOVE "F-MEAN-11" TO PAR-NAME. IF1204.2 +053500 PERFORM PRINT-DETAIL. IF1204.2 +053600*****************TEST (l) - SIMPLE TEST***************** IF1204.2 +053700 F-MEAN-12. IF1204.2 +053800 MOVE ZERO TO WS-NUM. IF1204.2 +053900 F-MEAN-TEST-12. IF1204.2 +054000 COMPUTE WS-NUM = FUNCTION MEAN(A, 5, A). IF1204.2 +054100 IF WS-NUM = 5 THEN IF1204.2 +054200 PERFORM PASS IF1204.2 +054300 ELSE IF1204.2 +054400 MOVE WS-NUM TO COMPUTED-N IF1204.2 +054500 MOVE 5 TO CORRECT-N IF1204.2 +054600 PERFORM FAIL. IF1204.2 +054700 GO TO F-MEAN-WRITE-12. IF1204.2 +054800 F-MEAN-DELETE-12. IF1204.2 +054900 PERFORM DE-LETE. IF1204.2 +055000 GO TO F-MEAN-WRITE-12. IF1204.2 +055100 F-MEAN-WRITE-12. IF1204.2 +055200 MOVE "F-MEAN-12" TO PAR-NAME. IF1204.2 +055300 PERFORM PRINT-DETAIL. IF1204.2 +055400*****************TEST (a) - COMPLEX TEST**************** IF1204.2 +055500 F-MEAN-13. IF1204.2 +055600 MOVE ZERO TO WS-NUM. IF1204.2 +055700 MOVE 20.6896 TO MIN-RANGE. IF1204.2 +055800 MOVE 20.6904 TO MAX-RANGE. IF1204.2 +055900 F-MEAN-TEST-13. IF1204.2 +056000 COMPUTE WS-NUM = FUNCTION MEAN(E, 9 * A, 0, B / 2). IF1204.2 +056100 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +056200 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +056300 PERFORM PASS IF1204.2 +056400 ELSE IF1204.2 +056500 MOVE WS-NUM TO COMPUTED-N IF1204.2 +056600 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +056700 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +056800 PERFORM FAIL. IF1204.2 +056900 GO TO F-MEAN-WRITE-13. IF1204.2 +057000 F-MEAN-DELETE-13. IF1204.2 +057100 PERFORM DE-LETE. IF1204.2 +057200 GO TO F-MEAN-WRITE-13. IF1204.2 +057300 F-MEAN-WRITE-13. IF1204.2 +057400 MOVE "F-MEAN-13" TO PAR-NAME. IF1204.2 +057500 PERFORM PRINT-DETAIL. IF1204.2 +057600*****************TEST (b) - COMPLEX TEST**************** IF1204.2 +057700 F-MEAN-14. IF1204.2 +057800 MOVE ZERO TO WS-NUM. IF1204.2 +057900 MOVE 83.9983 TO MIN-RANGE. IF1204.2 +058000 MOVE 84.0017 TO MAX-RANGE. IF1204.2 +058100 F-MEAN-TEST-14. IF1204.2 +058200 COMPUTE WS-NUM = FUNCTION MEAN(A, B) + 78. IF1204.2 +058300 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +058400 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +058500 PERFORM PASS IF1204.2 +058600 ELSE IF1204.2 +058700 MOVE WS-NUM TO COMPUTED-N IF1204.2 +058800 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +058900 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +059000 PERFORM FAIL. IF1204.2 +059100 GO TO F-MEAN-WRITE-14. IF1204.2 +059200 F-MEAN-DELETE-14. IF1204.2 +059300 PERFORM DE-LETE. IF1204.2 +059400 GO TO F-MEAN-WRITE-14. IF1204.2 +059500 F-MEAN-WRITE-14. IF1204.2 +059600 MOVE "F-MEAN-14" TO PAR-NAME. IF1204.2 +059700 PERFORM PRINT-DETAIL. IF1204.2 +059800*****************TEST (c) - COMPLEX TEST**************** IF1204.2 +059900 F-MEAN-15. IF1204.2 +060000 MOVE ZERO TO WS-NUM. IF1204.2 +060100 MOVE 2.49995 TO MIN-RANGE. IF1204.2 +060200 MOVE 2.50005 TO MAX-RANGE. IF1204.2 +060300 F-MEAN-TEST-15. IF1204.2 +060400 COMPUTE WS-NUM = FUNCTION MEAN(A , B) + IF1204.2 +060500 FUNCTION MEAN(-2.6, -4.4). IF1204.2 +060600 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +060700 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +060800 PERFORM PASS IF1204.2 +060900 ELSE IF1204.2 +061000 MOVE WS-NUM TO COMPUTED-N IF1204.2 +061100 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +061200 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +061300 PERFORM FAIL. IF1204.2 +061400 GO TO F-MEAN-WRITE-15. IF1204.2 +061500 F-MEAN-DELETE-15. IF1204.2 +061600 PERFORM DE-LETE. IF1204.2 +061700 GO TO F-MEAN-WRITE-15. IF1204.2 +061800 F-MEAN-WRITE-15. IF1204.2 +061900 MOVE "F-MEAN-15" TO PAR-NAME. IF1204.2 +062000 PERFORM PRINT-DETAIL. IF1204.2 +062100*****************TEST (d) - COMPLEX TEST**************** IF1204.2 +062200 F-MEAN-16. IF1204.2 +062300 MOVE ZERO TO WS-NUM. IF1204.2 +062400 MOVE 4.49991 TO MIN-RANGE. IF1204.2 +062500 MOVE 4.50009 TO MAX-RANGE. IF1204.2 +062600 F-MEAN-TEST-16. IF1204.2 +062700 COMPUTE WS-NUM = FUNCTION MEAN(FUNCTION MEAN(4, 2), 6). IF1204.2 +062800 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +062900 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +063000 PERFORM PASS IF1204.2 +063100 ELSE IF1204.2 +063200 MOVE WS-NUM TO COMPUTED-N IF1204.2 +063300 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +063400 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +063500 PERFORM FAIL. IF1204.2 +063600 GO TO F-MEAN-WRITE-16. IF1204.2 +063700 F-MEAN-DELETE-16. IF1204.2 +063800 PERFORM DE-LETE. IF1204.2 +063900 GO TO F-MEAN-WRITE-16. IF1204.2 +064000 F-MEAN-WRITE-16. IF1204.2 +064100 MOVE "F-MEAN-16" TO PAR-NAME. IF1204.2 +064200 PERFORM PRINT-DETAIL. IF1204.2 +064300*****************TEST (e) - COMPLEX TEST**************** IF1204.2 +064400 F-MEAN-17. IF1204.2 +064500 MOVE ZERO TO WS-NUM. IF1204.2 +064600 MOVE 20.7996 TO MIN-RANGE. IF1204.2 +064700 MOVE 20.8004 TO MAX-RANGE. IF1204.2 +064800 F-MEAN-TEST-17. IF1204.2 +064900 COMPUTE WS-NUM = FUNCTION MEAN(2.6 + 30, 4.5 * 2). IF1204.2 +065000 IF (WS-NUM >= MIN-RANGE) AND IF1204.2 +065100 (WS-NUM <= MAX-RANGE) THEN IF1204.2 +065200 PERFORM PASS IF1204.2 +065300 ELSE IF1204.2 +065400 MOVE WS-NUM TO COMPUTED-N IF1204.2 +065500 MOVE MIN-RANGE TO CORRECT-MIN IF1204.2 +065600 MOVE MAX-RANGE TO CORRECT-MAX IF1204.2 +065700 PERFORM FAIL. IF1204.2 +065800 GO TO F-MEAN-WRITE-17. IF1204.2 +065900 F-MEAN-DELETE-17. IF1204.2 +066000 PERFORM DE-LETE. IF1204.2 +066100 GO TO F-MEAN-WRITE-17. IF1204.2 +066200 F-MEAN-WRITE-17. IF1204.2 +066300 MOVE "F-MEAN-17" TO PAR-NAME. IF1204.2 +066400 PERFORM PRINT-DETAIL. IF1204.2 +066500*****************SPECIAL PERFORM TEST********************** IF1204.2 +066600 F-MEAN-18. IF1204.2 +066700 MOVE ZERO TO WS-NUM. IF1204.2 +066800 PERFORM F-MEAN-TEST-18 IF1204.2 +066900 UNTIL FUNCTION MEAN(ARG1, ARG2) > 8. IF1204.2 +067000 PERFORM PASS. IF1204.2 +067100 GO TO F-MEAN-WRITE-18. IF1204.2 +067200 F-MEAN-TEST-18. IF1204.2 +067300 COMPUTE ARG1 = ARG1 + 1. IF1204.2 +067400 COMPUTE ARG2 = ARG2 + 1. IF1204.2 +067500 F-MEAN-DELETE-18. IF1204.2 +067600 PERFORM DE-LETE. IF1204.2 +067700 GO TO F-MEAN-WRITE-18. IF1204.2 +067800 F-MEAN-WRITE-18. IF1204.2 +067900 MOVE "F-MEAN-18" TO PAR-NAME. IF1204.2 +068000 PERFORM PRINT-DETAIL. IF1204.2 +068100********************END OF TESTS*************** IF1204.2 +068200 CCVS-EXIT SECTION. IF1204.2 +068300 CCVS-999999. IF1204.2 +068400 GO TO CLOSE-FILES. IF1204.2 diff --git a/tests/cobol85/IF/IF121A.CBL b/tests/cobol85/IF/IF121A.CBL new file mode 100755 index 00000000..7700a6b7 --- /dev/null +++ b/tests/cobol85/IF/IF121A.CBL @@ -0,0 +1,680 @@ +000100 IDENTIFICATION DIVISION. IF1214.2 +000200 PROGRAM-ID. IF1214.2 +000300 IF121A. IF1214.2 +000400 IF1214.2 +000500*********************************************************** IF1214.2 +000600* * IF1214.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1214.2 +000800* It contains tests for the Intrinsic Function MEDIAN. * IF1214.2 +000900* * IF1214.2 +001000*********************************************************** IF1214.2 +001100 ENVIRONMENT DIVISION. IF1214.2 +001200 CONFIGURATION SECTION. IF1214.2 +001300 SOURCE-COMPUTER. IF1214.2 +001400 Linux. IF1214.2 +001500 OBJECT-COMPUTER. IF1214.2 +001600 Linux. IF1214.2 +001700 INPUT-OUTPUT SECTION. IF1214.2 +001800 FILE-CONTROL. IF1214.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1214.2 +002000 "report.log". IF1214.2 +002100 DATA DIVISION. IF1214.2 +002200 FILE SECTION. IF1214.2 +002300 FD PRINT-FILE. IF1214.2 +002400 01 PRINT-REC PICTURE X(120). IF1214.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1214.2 +002600 WORKING-STORAGE SECTION. IF1214.2 +002700*********************************************************** IF1214.2 +002800* Variables specific to the Intrinsic Function Test IF121A* IF1214.2 +002900*********************************************************** IF1214.2 +003000 01 A PIC S9(10) VALUE 5. IF1214.2 +003100 01 B PIC S9(10) VALUE 7. IF1214.2 +003200 01 C PIC S9(10) VALUE -4. IF1214.2 +003300 01 D PIC S9(10) VALUE 10. IF1214.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1214.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1214.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1214.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1214.2 +003800 01 M PIC S9(10) VALUE 320000. IF1214.2 +003900 01 N PIC S9(10) VALUE 650000. IF1214.2 +004000 01 O PIC S9(10) VALUE -430000. IF1214.2 +004100 01 P PIC S9(10) VALUE 1. IF1214.2 +004200 01 Q PIC S9(10) VALUE 3. IF1214.2 +004300 01 R PIC S9(10) VALUE 5. IF1214.2 +004400 01 ARG1 PIC S9(10) VALUE 2. IF1214.2 +004500 01 ARG2 PIC S9(10) VALUE 2. IF1214.2 +004600 01 ARR VALUE "40537". IF1214.2 +004700 02 IND OCCURS 5 TIMES PIC 9. IF1214.2 +004800 01 TEMP PIC S9(10)V9(5). IF1214.2 +004900 01 WS-NUM PIC S9(6)V9(7). IF1214.2 +005000 01 MIN-RANGE PIC S9(5)V9(7). IF1214.2 +005100 01 MAX-RANGE PIC S9(5)V9(7). IF1214.2 +005200* IF1214.2 +005300********************************************************** IF1214.2 +005400* IF1214.2 +005500 01 TEST-RESULTS. IF1214.2 +005600 02 FILLER PIC X VALUE SPACE. IF1214.2 +005700 02 FEATURE PIC X(20) VALUE SPACE. IF1214.2 +005800 02 FILLER PIC X VALUE SPACE. IF1214.2 +005900 02 P-OR-F PIC X(5) VALUE SPACE. IF1214.2 +006000 02 FILLER PIC X VALUE SPACE. IF1214.2 +006100 02 PAR-NAME. IF1214.2 +006200 03 FILLER PIC X(19) VALUE SPACE. IF1214.2 +006300 03 PARDOT-X PIC X VALUE SPACE. IF1214.2 +006400 03 DOTVALUE PIC 99 VALUE ZERO. IF1214.2 +006500 02 FILLER PIC X(8) VALUE SPACE. IF1214.2 +006600 02 RE-MARK PIC X(61). IF1214.2 +006700 01 TEST-COMPUTED. IF1214.2 +006800 02 FILLER PIC X(30) VALUE SPACE. IF1214.2 +006900 02 FILLER PIC X(17) VALUE IF1214.2 +007000 " COMPUTED=". IF1214.2 +007100 02 COMPUTED-X. IF1214.2 +007200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1214.2 +007300 03 COMPUTED-N REDEFINES COMPUTED-A IF1214.2 +007400 PIC -9(9).9(9). IF1214.2 +007500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1214.2 +007600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1214.2 +007700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1214.2 +007800 03 CM-18V0 REDEFINES COMPUTED-A. IF1214.2 +007900 04 COMPUTED-18V0 PIC -9(18). IF1214.2 +008000 04 FILLER PIC X. IF1214.2 +008100 03 FILLER PIC X(50) VALUE SPACE. IF1214.2 +008200 01 TEST-CORRECT. IF1214.2 +008300 02 FILLER PIC X(30) VALUE SPACE. IF1214.2 +008400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1214.2 +008500 02 CORRECT-X. IF1214.2 +008600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1214.2 +008700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1214.2 +008800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1214.2 +008900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1214.2 +009000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1214.2 +009100 03 CR-18V0 REDEFINES CORRECT-A. IF1214.2 +009200 04 CORRECT-18V0 PIC -9(18). IF1214.2 +009300 04 FILLER PIC X. IF1214.2 +009400 03 FILLER PIC X(2) VALUE SPACE. IF1214.2 +009500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1214.2 +009600 01 TEST-CORRECT-MIN. IF1214.2 +009700 02 FILLER PIC X(30) VALUE SPACE. IF1214.2 +009800 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1214.2 +009900 02 CORRECTMI-X. IF1214.2 +010000 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1214.2 +010100 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1214.2 +010200 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1214.2 +010300 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1214.2 +010400 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1214.2 +010500 03 CR-18V0 REDEFINES CORRECTMI-A. IF1214.2 +010600 04 CORRECTMI-18V0 PIC -9(18). IF1214.2 +010700 04 FILLER PIC X. IF1214.2 +010800 03 FILLER PIC X(2) VALUE SPACE. IF1214.2 +010900 03 FILLER PIC X(48) VALUE SPACE. IF1214.2 +011000 01 TEST-CORRECT-MAX. IF1214.2 +011100 02 FILLER PIC X(30) VALUE SPACE. IF1214.2 +011200 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1214.2 +011300 02 CORRECTMA-X. IF1214.2 +011400 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1214.2 +011500 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1214.2 +011600 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1214.2 +011700 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1214.2 +011800 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1214.2 +011900 03 CR-18V0 REDEFINES CORRECTMA-A. IF1214.2 +012000 04 CORRECTMA-18V0 PIC -9(18). IF1214.2 +012100 04 FILLER PIC X. IF1214.2 +012200 03 FILLER PIC X(2) VALUE SPACE. IF1214.2 +012300 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1214.2 +012400 01 CCVS-C-1. IF1214.2 +012500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1214.2 +012600- "SS PARAGRAPH-NAME IF1214.2 +012700- " REMARKS". IF1214.2 +012800 02 FILLER PIC X(20) VALUE SPACE. IF1214.2 +012900 01 CCVS-C-2. IF1214.2 +013000 02 FILLER PIC X VALUE SPACE. IF1214.2 +013100 02 FILLER PIC X(6) VALUE "TESTED". IF1214.2 +013200 02 FILLER PIC X(15) VALUE SPACE. IF1214.2 +013300 02 FILLER PIC X(4) VALUE "FAIL". IF1214.2 +013400 02 FILLER PIC X(94) VALUE SPACE. IF1214.2 +013500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1214.2 +013600 01 REC-CT PIC 99 VALUE ZERO. IF1214.2 +013700 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1214.2 +013800 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1214.2 +013900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1214.2 +014000 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1214.2 +014100 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1214.2 +014200 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1214.2 +014300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1214.2 +014400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1214.2 +014500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1214.2 +014600 01 CCVS-H-1. IF1214.2 +014700 02 FILLER PIC X(39) VALUE SPACES. IF1214.2 +014800 02 FILLER PIC X(42) VALUE IF1214.2 +014900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1214.2 +015000 02 FILLER PIC X(39) VALUE SPACES. IF1214.2 +015100 01 CCVS-H-2A. IF1214.2 +015200 02 FILLER PIC X(40) VALUE SPACE. IF1214.2 +015300 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1214.2 +015400 02 FILLER PIC XXXX VALUE IF1214.2 +015500 "4.2 ". IF1214.2 +015600 02 FILLER PIC X(28) VALUE IF1214.2 +015700 " COPY - NOT FOR DISTRIBUTION". IF1214.2 +015800 02 FILLER PIC X(41) VALUE SPACE. IF1214.2 +015900 IF1214.2 +016000 01 CCVS-H-2B. IF1214.2 +016100 02 FILLER PIC X(15) VALUE IF1214.2 +016200 "TEST RESULT OF ". IF1214.2 +016300 02 TEST-ID PIC X(9). IF1214.2 +016400 02 FILLER PIC X(4) VALUE IF1214.2 +016500 " IN ". IF1214.2 +016600 02 FILLER PIC X(12) VALUE IF1214.2 +016700 " HIGH ". IF1214.2 +016800 02 FILLER PIC X(22) VALUE IF1214.2 +016900 " LEVEL VALIDATION FOR ". IF1214.2 +017000 02 FILLER PIC X(58) VALUE IF1214.2 +017100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1214.2 +017200 01 CCVS-H-3. IF1214.2 +017300 02 FILLER PIC X(34) VALUE IF1214.2 +017400 " FOR OFFICIAL USE ONLY ". IF1214.2 +017500 02 FILLER PIC X(58) VALUE IF1214.2 +017600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1214.2 +017700 02 FILLER PIC X(28) VALUE IF1214.2 +017800 " COPYRIGHT 1985 ". IF1214.2 +017900 01 CCVS-E-1. IF1214.2 +018000 02 FILLER PIC X(52) VALUE SPACE. IF1214.2 +018100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1214.2 +018200 02 ID-AGAIN PIC X(9). IF1214.2 +018300 02 FILLER PIC X(45) VALUE SPACES. IF1214.2 +018400 01 CCVS-E-2. IF1214.2 +018500 02 FILLER PIC X(31) VALUE SPACE. IF1214.2 +018600 02 FILLER PIC X(21) VALUE SPACE. IF1214.2 +018700 02 CCVS-E-2-2. IF1214.2 +018800 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1214.2 +018900 03 FILLER PIC X VALUE SPACE. IF1214.2 +019000 03 ENDER-DESC PIC X(44) VALUE IF1214.2 +019100 "ERRORS ENCOUNTERED". IF1214.2 +019200 01 CCVS-E-3. IF1214.2 +019300 02 FILLER PIC X(22) VALUE IF1214.2 +019400 " FOR OFFICIAL USE ONLY". IF1214.2 +019500 02 FILLER PIC X(12) VALUE SPACE. IF1214.2 +019600 02 FILLER PIC X(58) VALUE IF1214.2 +019700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1214.2 +019800 02 FILLER PIC X(13) VALUE SPACE. IF1214.2 +019900 02 FILLER PIC X(15) VALUE IF1214.2 +020000 " COPYRIGHT 1985". IF1214.2 +020100 01 CCVS-E-4. IF1214.2 +020200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1214.2 +020300 02 FILLER PIC X(4) VALUE " OF ". IF1214.2 +020400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1214.2 +020500 02 FILLER PIC X(40) VALUE IF1214.2 +020600 " TESTS WERE EXECUTED SUCCESSFULLY". IF1214.2 +020700 01 XXINFO. IF1214.2 +020800 02 FILLER PIC X(19) VALUE IF1214.2 +020900 "*** INFORMATION ***". IF1214.2 +021000 02 INFO-TEXT. IF1214.2 +021100 04 FILLER PIC X(8) VALUE SPACE. IF1214.2 +021200 04 XXCOMPUTED PIC X(20). IF1214.2 +021300 04 FILLER PIC X(5) VALUE SPACE. IF1214.2 +021400 04 XXCORRECT PIC X(20). IF1214.2 +021500 02 INF-ANSI-REFERENCE PIC X(48). IF1214.2 +021600 01 HYPHEN-LINE. IF1214.2 +021700 02 FILLER PIC IS X VALUE IS SPACE. IF1214.2 +021800 02 FILLER PIC IS X(65) VALUE IS "************************IF1214.2 +021900- "*****************************************". IF1214.2 +022000 02 FILLER PIC IS X(54) VALUE IS "************************IF1214.2 +022100- "******************************". IF1214.2 +022200 01 CCVS-PGM-ID PIC X(9) VALUE IF1214.2 +022300 "IF121A". IF1214.2 +022400 PROCEDURE DIVISION. IF1214.2 +022500 CCVS1 SECTION. IF1214.2 +022600 OPEN-FILES. IF1214.2 +022700 OPEN OUTPUT PRINT-FILE. IF1214.2 +022800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1214.2 +022900 MOVE SPACE TO TEST-RESULTS. IF1214.2 +023000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1214.2 +023100 GO TO CCVS1-EXIT. IF1214.2 +023200 CLOSE-FILES. IF1214.2 +023300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1214.2 +023400 TERMINATE-CCVS. IF1214.2 +023500 STOP RUN. IF1214.2 +023600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1214.2 +023700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1214.2 +023800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1214.2 +023900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1214.2 +024000 MOVE "****TEST DELETED****" TO RE-MARK. IF1214.2 +024100 PRINT-DETAIL. IF1214.2 +024200 IF REC-CT NOT EQUAL TO ZERO IF1214.2 +024300 MOVE "." TO PARDOT-X IF1214.2 +024400 MOVE REC-CT TO DOTVALUE. IF1214.2 +024500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1214.2 +024600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1214.2 +024700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1214.2 +024800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1214.2 +024900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1214.2 +025000 MOVE SPACE TO CORRECT-X. IF1214.2 +025100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1214.2 +025200 MOVE SPACE TO RE-MARK. IF1214.2 +025300 HEAD-ROUTINE. IF1214.2 +025400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +025500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +025600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1214.2 +025700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1214.2 +025800 COLUMN-NAMES-ROUTINE. IF1214.2 +025900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +026000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +026100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +026200 END-ROUTINE. IF1214.2 +026300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1214.2 +026400 END-RTN-EXIT. IF1214.2 +026500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +026600 END-ROUTINE-1. IF1214.2 +026700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1214.2 +026800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1214.2 +026900 ADD PASS-COUNTER TO ERROR-HOLD. IF1214.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1214.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1214.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1214.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1214.2 +027400 END-ROUTINE-12. IF1214.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1214.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO IF1214.2 +027700 MOVE "NO " TO ERROR-TOTAL IF1214.2 +027800 ELSE IF1214.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1214.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1214.2 +028100 PERFORM WRITE-LINE. IF1214.2 +028200 END-ROUTINE-13. IF1214.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO IF1214.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE IF1214.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1214.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1214.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO IF1214.2 +028900 MOVE "NO " TO ERROR-TOTAL IF1214.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1214.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1214.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1214.2 +029400 WRITE-LINE. IF1214.2 +029500 ADD 1 TO RECORD-COUNT. IF1214.2 +029600 IF RECORD-COUNT GREATER 42 IF1214.2 +029700 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1214.2 +029800 MOVE SPACE TO DUMMY-RECORD IF1214.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1214.2 +030000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1214.2 +030100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1214.2 +030200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1214.2 +030300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1214.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1214.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1214.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1214.2 +030700 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1214.2 +030800 MOVE ZERO TO RECORD-COUNT. IF1214.2 +030900 PERFORM WRT-LN. IF1214.2 +031000 WRT-LN. IF1214.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1214.2 +031200 MOVE SPACE TO DUMMY-RECORD. IF1214.2 +031300 BLANK-LINE-PRINT. IF1214.2 +031400 PERFORM WRT-LN. IF1214.2 +031500 FAIL-ROUTINE. IF1214.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE IF1214.2 +031700 GO TO FAIL-ROUTINE-WRITE. IF1214.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1214.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1214.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1214.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1214.2 +032300 GO TO FAIL-ROUTINE-EX. IF1214.2 +032400 FAIL-ROUTINE-WRITE. IF1214.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1214.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1214.2 +032700 CORMA-ANSI-REFERENCE. IF1214.2 +032800 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1214.2 +032900 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1214.2 +033000 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1214.2 +033100 ELSE IF1214.2 +033200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1214.2 +033300 PERFORM WRITE-LINE. IF1214.2 +033400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1214.2 +033500 FAIL-ROUTINE-EX. EXIT. IF1214.2 +033600 BAIL-OUT. IF1214.2 +033700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1214.2 +033800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1214.2 +033900 BAIL-OUT-WRITE. IF1214.2 +034000 MOVE CORRECT-A TO XXCORRECT. IF1214.2 +034100 MOVE COMPUTED-A TO XXCOMPUTED. IF1214.2 +034200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1214.2 +034300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1214.2 +034400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1214.2 +034500 BAIL-OUT-EX. EXIT. IF1214.2 +034600 CCVS1-EXIT. IF1214.2 +034700 EXIT. IF1214.2 +034800******************************************************** IF1214.2 +034900* * IF1214.2 +035000* Intrinsic Function Tests IF121A - MEDIAN * IF1214.2 +035100* * IF1214.2 +035200******************************************************** IF1214.2 +035300 SECT-IF121A SECTION. IF1214.2 +035400 F-MEDIAN-INFO. IF1214.2 +035500 MOVE "See ref. A-54 2.25" TO ANSI-REFERENCE. IF1214.2 +035600 MOVE "MEDIAN Function" TO FEATURE. IF1214.2 +035700*****************TEST (a) - SIMPLE TEST***************** IF1214.2 +035800 F-MEDIAN-01. IF1214.2 +035900 MOVE ZERO TO WS-NUM. IF1214.2 +036000 F-MEDIAN-TEST-01. IF1214.2 +036100 COMPUTE WS-NUM = FUNCTION MEDIAN(5, -2, -14, 0). IF1214.2 +036200 IF WS-NUM = -1 THEN IF1214.2 +036300 PERFORM PASS IF1214.2 +036400 ELSE IF1214.2 +036500 MOVE WS-NUM TO COMPUTED-N IF1214.2 +036600 MOVE -1 TO CORRECT-N IF1214.2 +036700 PERFORM FAIL. IF1214.2 +036800 GO TO F-MEDIAN-WRITE-01. IF1214.2 +036900 F-MEDIAN-DELETE-01. IF1214.2 +037000 PERFORM DE-LETE. IF1214.2 +037100 GO TO F-MEDIAN-WRITE-01. IF1214.2 +037200 F-MEDIAN-WRITE-01. IF1214.2 +037300 MOVE "F-MEDIAN-01" TO PAR-NAME. IF1214.2 +037400 PERFORM PRINT-DETAIL. IF1214.2 +037500*****************TEST (b) - SIMPLE TEST***************** IF1214.2 +037600 F-MEDIAN-02. IF1214.2 +037700 EVALUATE FUNCTION MEDIAN(3.9, -0.3, 8.7, 100.2) IF1214.2 +037800 WHEN 6.29987 THRU 6.30013 IF1214.2 +037900 PERFORM PASS IF1214.2 +038000 WHEN OTHER IF1214.2 +038100 PERFORM FAIL. IF1214.2 +038200 GO TO F-MEDIAN-WRITE-02. IF1214.2 +038300 F-MEDIAN-DELETE-02. IF1214.2 +038400 PERFORM DE-LETE. IF1214.2 +038500 GO TO F-MEDIAN-WRITE-02. IF1214.2 +038600 F-MEDIAN-WRITE-02. IF1214.2 +038700 MOVE "F-MEDIAN-02" TO PAR-NAME. IF1214.2 +038800 PERFORM PRINT-DETAIL. IF1214.2 +038900*****************TEST (c) - SIMPLE TEST***************** IF1214.2 +039000 F-MEDIAN-03. IF1214.2 +039100 IF FUNCTION MEDIAN(A, B, C, D) = 6 THEN IF1214.2 +039200 PERFORM PASS IF1214.2 +039300 ELSE IF1214.2 +039400 PERFORM FAIL. IF1214.2 +039500 GO TO F-MEDIAN-WRITE-03. IF1214.2 +039600 F-MEDIAN-DELETE-03. IF1214.2 +039700 PERFORM DE-LETE. IF1214.2 +039800 GO TO F-MEDIAN-WRITE-03. IF1214.2 +039900 F-MEDIAN-WRITE-03. IF1214.2 +040000 MOVE "F-MEDIAN-03" TO PAR-NAME. IF1214.2 +040100 PERFORM PRINT-DETAIL. IF1214.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1214.2 +040300 F-MEDIAN-04. IF1214.2 +040400 MOVE ZERO TO WS-NUM. IF1214.2 +040500 F-MEDIAN-TEST-04. IF1214.2 +040600 COMPUTE WS-NUM = FUNCTION MEDIAN(E, F, G). IF1214.2 +040700 IF (WS-NUM >= 4.07992) AND IF1214.2 +040800 (WS-NUM <= 4.08008) IF1214.2 +040900 PERFORM PASS IF1214.2 +041000 ELSE IF1214.2 +041100 MOVE WS-NUM TO COMPUTED-N IF1214.2 +041200 MOVE 4.08 TO CORRECT-N IF1214.2 +041300 PERFORM FAIL. IF1214.2 +041400 GO TO F-MEDIAN-WRITE-04. IF1214.2 +041500 F-MEDIAN-DELETE-04. IF1214.2 +041600 PERFORM DE-LETE. IF1214.2 +041700 GO TO F-MEDIAN-WRITE-04. IF1214.2 +041800 F-MEDIAN-WRITE-04. IF1214.2 +041900 MOVE "F-MEDIAN-04" TO PAR-NAME. IF1214.2 +042000 PERFORM PRINT-DETAIL. IF1214.2 +042100*****************TEST (e) - SIMPLE TEST***************** IF1214.2 +042200 F-MEDIAN-05. IF1214.2 +042300 MOVE ZERO TO WS-NUM. IF1214.2 +042400 F-MEDIAN-TEST-05. IF1214.2 +042500 COMPUTE WS-NUM = FUNCTION MEDIAN(10.2, -0.2, 5.6, -15.6). IF1214.2 +042600 IF (WS-NUM >= 2.69995) AND IF1214.2 +042700 (WS-NUM <= 2.70005) IF1214.2 +042800 PERFORM PASS IF1214.2 +042900 ELSE IF1214.2 +043000 MOVE WS-NUM TO COMPUTED-N IF1214.2 +043100 MOVE 2.7 TO CORRECT-N IF1214.2 +043200 PERFORM FAIL. IF1214.2 +043300 GO TO F-MEDIAN-WRITE-05. IF1214.2 +043400 F-MEDIAN-DELETE-05. IF1214.2 +043500 PERFORM DE-LETE. IF1214.2 +043600 GO TO F-MEDIAN-WRITE-05. IF1214.2 +043700 F-MEDIAN-WRITE-05. IF1214.2 +043800 MOVE "F-MEDIAN-05" TO PAR-NAME. IF1214.2 +043900 PERFORM PRINT-DETAIL. IF1214.2 +044000*****************TEST (f) - SIMPLE TEST***************** IF1214.2 +044100 F-MEDIAN-06. IF1214.2 +044200 MOVE ZERO TO WS-NUM. IF1214.2 +044300 F-MEDIAN-TEST-06. IF1214.2 +044400 COMPUTE WS-NUM = FUNCTION MEDIAN(A, B, C, D, E, F, G). IF1214.2 +044500 IF (WS-NUM >= 4.99990) AND IF1214.2 +044600 (WS-NUM <= 5.00010) IF1214.2 +044700 PERFORM PASS IF1214.2 +044800 ELSE IF1214.2 +044900 MOVE WS-NUM TO COMPUTED-N IF1214.2 +045000 MOVE 5 TO CORRECT-N IF1214.2 +045100 PERFORM FAIL. IF1214.2 +045200 GO TO F-MEDIAN-WRITE-06. IF1214.2 +045300 F-MEDIAN-DELETE-06. IF1214.2 +045400 PERFORM DE-LETE. IF1214.2 +045500 GO TO F-MEDIAN-WRITE-06. IF1214.2 +045600 F-MEDIAN-WRITE-06. IF1214.2 +045700 MOVE "F-MEDIAN-06" TO PAR-NAME. IF1214.2 +045800 PERFORM PRINT-DETAIL. IF1214.2 +045900*****************TEST (g) - SIMPLE TEST***************** IF1214.2 +046000 F-MEDIAN-07. IF1214.2 +046100 MOVE ZERO TO WS-NUM. IF1214.2 +046200 F-MEDIAN-TEST-07. IF1214.2 +046300 COMPUTE WS-NUM = FUNCTION MEDIAN(IND(1), IND(2), IND(3)). IF1214.2 +046400 IF WS-NUM = 4 THEN IF1214.2 +046500 PERFORM PASS IF1214.2 +046600 ELSE IF1214.2 +046700 MOVE WS-NUM TO COMPUTED-N IF1214.2 +046800 MOVE 4 TO CORRECT-N IF1214.2 +046900 PERFORM FAIL. IF1214.2 +047000 GO TO F-MEDIAN-WRITE-07. IF1214.2 +047100 F-MEDIAN-DELETE-07. IF1214.2 +047200 PERFORM DE-LETE. IF1214.2 +047300 GO TO F-MEDIAN-WRITE-07. IF1214.2 +047400 F-MEDIAN-WRITE-07. IF1214.2 +047500 MOVE "F-MEDIAN-07" TO PAR-NAME. IF1214.2 +047600 PERFORM PRINT-DETAIL. IF1214.2 +047700*****************TEST (h) - SIMPLE TEST***************** IF1214.2 +047800 F-MEDIAN-08. IF1214.2 +047900 MOVE ZERO TO WS-NUM. IF1214.2 +048000 F-MEDIAN-TEST-08. IF1214.2 +048100 COMPUTE WS-NUM = FUNCTION MEDIAN(IND(P), IND(Q), IND(R)). IF1214.2 +048200 IF1214.2 +048300 IF WS-NUM = 5 THEN IF1214.2 +048400 PERFORM PASS IF1214.2 +048500 ELSE IF1214.2 +048600 MOVE WS-NUM TO COMPUTED-N IF1214.2 +048700 MOVE 5 TO CORRECT-N IF1214.2 +048800 PERFORM FAIL. IF1214.2 +048900 GO TO F-MEDIAN-WRITE-08. IF1214.2 +049000 F-MEDIAN-DELETE-08. IF1214.2 +049100 PERFORM DE-LETE. IF1214.2 +049200 GO TO F-MEDIAN-WRITE-08. IF1214.2 +049300 F-MEDIAN-WRITE-08. IF1214.2 +049400 MOVE "F-MEDIAN-08" TO PAR-NAME. IF1214.2 +049500 PERFORM PRINT-DETAIL. IF1214.2 +049600*****************TEST (i) - SIMPLE TEST***************** IF1214.2 +049700 F-MEDIAN-09. IF1214.2 +049800 MOVE ZERO TO WS-NUM. IF1214.2 +049900 F-MEDIAN-TEST-09. IF1214.2 +rogerw COMPUTE WS-NUM = FUNCTION MEDIAN (4 0 5 3 7). +050100 IF WS-NUM = 4 THEN IF1214.2 +050200 PERFORM PASS IF1214.2 +050300 ELSE IF1214.2 +050400 MOVE WS-NUM TO COMPUTED-N IF1214.2 +050500 MOVE 4 TO CORRECT-N IF1214.2 +050600 PERFORM FAIL. IF1214.2 +050700 GO TO F-MEDIAN-WRITE-09. IF1214.2 +050800 F-MEDIAN-DELETE-09. IF1214.2 +050900 PERFORM DE-LETE. IF1214.2 +051000 GO TO F-MEDIAN-WRITE-09. IF1214.2 +051100 F-MEDIAN-WRITE-09. IF1214.2 +051200 MOVE "F-MEDIAN-09" TO PAR-NAME. IF1214.2 +051300 PERFORM PRINT-DETAIL. IF1214.2 +051400*****************TEST (k) - SIMPLE TEST***************** IF1214.2 +051500 F-MEDIAN-11. IF1214.2 +051600 MOVE ZERO TO WS-NUM. IF1214.2 +051700 F-MEDIAN-TEST-11. IF1214.2 +051800 COMPUTE WS-NUM = FUNCTION MEDIAN(M, N, O). IF1214.2 +051900 IF WS-NUM = 320000 THEN IF1214.2 +052000 PERFORM PASS IF1214.2 +052100 ELSE IF1214.2 +052200 MOVE WS-NUM TO COMPUTED-N IF1214.2 +052300 MOVE 320000 TO CORRECT-N IF1214.2 +052400 PERFORM FAIL. IF1214.2 +052500 GO TO F-MEDIAN-WRITE-11. IF1214.2 +052600 F-MEDIAN-DELETE-11. IF1214.2 +052700 PERFORM DE-LETE. IF1214.2 +052800 GO TO F-MEDIAN-WRITE-11. IF1214.2 +052900 F-MEDIAN-WRITE-11. IF1214.2 +053000 MOVE "F-MEDIAN-11" TO PAR-NAME. IF1214.2 +053100 PERFORM PRINT-DETAIL. IF1214.2 +053200*****************TEST (l) - SIMPLE TEST***************** IF1214.2 +053300 F-MEDIAN-12. IF1214.2 +053400 MOVE ZERO TO WS-NUM. IF1214.2 +053500 F-MEDIAN-TEST-12. IF1214.2 +053600 COMPUTE WS-NUM = FUNCTION MEDIAN(A, 5, A). IF1214.2 +053700 IF WS-NUM = 5 THEN IF1214.2 +053800 PERFORM PASS IF1214.2 +053900 ELSE IF1214.2 +054000 MOVE WS-NUM TO COMPUTED-N IF1214.2 +054100 MOVE 5 TO CORRECT-N IF1214.2 +054200 PERFORM FAIL. IF1214.2 +054300 GO TO F-MEDIAN-WRITE-12. IF1214.2 +054400 F-MEDIAN-DELETE-12. IF1214.2 +054500 PERFORM DE-LETE. IF1214.2 +054600 GO TO F-MEDIAN-WRITE-12. IF1214.2 +054700 F-MEDIAN-WRITE-12. IF1214.2 +054800 MOVE "F-MEDIAN-12" TO PAR-NAME. IF1214.2 +054900 PERFORM PRINT-DETAIL. IF1214.2 +055000*****************TEST (a) - COMPLEX TEST**************** IF1214.2 +055100 F-MEDIAN-13. IF1214.2 +055200 MOVE ZERO TO WS-NUM. IF1214.2 +055300 MOVE 20.7996 TO MIN-RANGE. IF1214.2 +055400 MOVE 20.8004 TO MAX-RANGE. IF1214.2 +055500 F-MEDIAN-TEST-13. IF1214.2 +055600 COMPUTE WS-NUM = FUNCTION MEDIAN(2.6 + 30, 4.5 * 2). IF1214.2 +055700 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +055800 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +055900 PERFORM PASS IF1214.2 +056000 ELSE IF1214.2 +056100 MOVE WS-NUM TO COMPUTED-N IF1214.2 +056200 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +056300 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +056400 PERFORM FAIL. IF1214.2 +056500 GO TO F-MEDIAN-WRITE-13. IF1214.2 +056600 F-MEDIAN-DELETE-13. IF1214.2 +056700 PERFORM DE-LETE. IF1214.2 +056800 GO TO F-MEDIAN-WRITE-13. IF1214.2 +056900 F-MEDIAN-WRITE-13. IF1214.2 +057000 MOVE "F-MEDIAN-13" TO PAR-NAME. IF1214.2 +057100 PERFORM PRINT-DETAIL. IF1214.2 +057200*****************TEST (b) - COMPLEX TEST**************** IF1214.2 +057300 F-MEDIAN-14. IF1214.2 +057400 MOVE ZERO TO WS-NUM. IF1214.2 +057500 MOVE 34.2593 TO MIN-RANGE. IF1214.2 +057600 MOVE 34.2607 TO MAX-RANGE. IF1214.2 +057700 F-MEDIAN-TEST-14. IF1214.2 +057800 COMPUTE WS-NUM = FUNCTION MEDIAN(E, 9 * A, B / 2). IF1214.2 +057900 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +058000 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +058100 PERFORM PASS IF1214.2 +058200 ELSE IF1214.2 +058300 MOVE WS-NUM TO COMPUTED-N IF1214.2 +058400 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +058500 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +058600 PERFORM FAIL. IF1214.2 +058700 GO TO F-MEDIAN-WRITE-14. IF1214.2 +058800 F-MEDIAN-DELETE-14. IF1214.2 +058900 PERFORM DE-LETE. IF1214.2 +059000 GO TO F-MEDIAN-WRITE-14. IF1214.2 +059100 F-MEDIAN-WRITE-14. IF1214.2 +059200 MOVE "F-MEDIAN-14" TO PAR-NAME. IF1214.2 +059300 PERFORM PRINT-DETAIL. IF1214.2 +059400*****************TEST (c) - COMPLEX TEST**************** IF1214.2 +059500 F-MEDIAN-15. IF1214.2 +059600 MOVE ZERO TO WS-NUM. IF1214.2 +059700 MOVE 83.9983 TO MIN-RANGE. IF1214.2 +059800 MOVE 84.0017 TO MAX-RANGE. IF1214.2 +059900 F-MEDIAN-TEST-15. IF1214.2 +060000 COMPUTE WS-NUM = FUNCTION MEDIAN(A, B) + 78. IF1214.2 +060100 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +060200 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +060300 PERFORM PASS IF1214.2 +060400 ELSE IF1214.2 +060500 MOVE WS-NUM TO COMPUTED-N IF1214.2 +060600 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +060700 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +060800 PERFORM FAIL. IF1214.2 +060900 GO TO F-MEDIAN-WRITE-15. IF1214.2 +061000 F-MEDIAN-DELETE-15. IF1214.2 +061100 PERFORM DE-LETE. IF1214.2 +061200 GO TO F-MEDIAN-WRITE-15. IF1214.2 +061300 F-MEDIAN-WRITE-15. IF1214.2 +061400 MOVE "F-MEDIAN-15" TO PAR-NAME. IF1214.2 +061500 PERFORM PRINT-DETAIL. IF1214.2 +061600*****************TEST (d) - COMPLEX TEST**************** IF1214.2 +061700 F-MEDIAN-16. IF1214.2 +061800 MOVE ZERO TO WS-NUM. IF1214.2 +061900 MOVE 3.39932 TO MIN-RANGE. IF1214.2 +062000 MOVE 3.40007 TO MAX-RANGE. IF1214.2 +062100 F-MEDIAN-TEST-16. IF1214.2 +062200 COMPUTE WS-NUM = FUNCTION MEDIAN(A, B) + IF1214.2 +062300 FUNCTION MEDIAN(-2.6, -4.4, 1). IF1214.2 +062400 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +062500 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +062600 PERFORM PASS IF1214.2 +062700 ELSE IF1214.2 +062800 MOVE WS-NUM TO COMPUTED-N IF1214.2 +062900 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +063000 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +063100 PERFORM FAIL. IF1214.2 +063200 GO TO F-MEDIAN-WRITE-16. IF1214.2 +063300 F-MEDIAN-DELETE-16. IF1214.2 +063400 PERFORM DE-LETE. IF1214.2 +063500 GO TO F-MEDIAN-WRITE-16. IF1214.2 +063600 F-MEDIAN-WRITE-16. IF1214.2 +063700 MOVE "F-MEDIAN-16" TO PAR-NAME. IF1214.2 +063800 PERFORM PRINT-DETAIL. IF1214.2 +063900*****************TEST (e) - COMPLEX TEST**************** IF1214.2 +064000 F-MEDIAN-17. IF1214.2 +064100 MOVE ZERO TO WS-NUM. IF1214.2 +064200 MOVE 2.24995 TO MIN-RANGE. IF1214.2 +064300 MOVE 2.25004 TO MAX-RANGE. IF1214.2 +064400 F-MEDIAN-TEST-17. IF1214.2 +064500 COMPUTE WS-NUM = IF1214.2 +064600 FUNCTION MEDIAN(FUNCTION MEDIAN(1, 2), 3). IF1214.2 +064700 IF (WS-NUM >= MIN-RANGE) AND IF1214.2 +064800 (WS-NUM <= MAX-RANGE) THEN IF1214.2 +064900 PERFORM PASS IF1214.2 +065000 ELSE IF1214.2 +065100 MOVE WS-NUM TO COMPUTED-N IF1214.2 +065200 MOVE MIN-RANGE TO CORRECT-MIN IF1214.2 +065300 MOVE MAX-RANGE TO CORRECT-MAX IF1214.2 +065400 PERFORM FAIL. IF1214.2 +065500 GO TO F-MEDIAN-WRITE-17. IF1214.2 +065600 F-MEDIAN-DELETE-17. IF1214.2 +065700 PERFORM DE-LETE. IF1214.2 +065800 GO TO F-MEDIAN-WRITE-17. IF1214.2 +065900 F-MEDIAN-WRITE-17. IF1214.2 +066000 MOVE "F-MEDIAN-17" TO PAR-NAME. IF1214.2 +066100 PERFORM PRINT-DETAIL. IF1214.2 +066200*****************SPECIAL PERFORM TEST********************** IF1214.2 +066300 F-MEDIAN-18. IF1214.2 +066400 PERFORM F-MEDIAN-TEST-18 IF1214.2 +066500 UNTIL FUNCTION MEDIAN(1, ARG1, ARG2, 20) > 10. IF1214.2 +066600 PERFORM PASS. IF1214.2 +066700 GO TO F-MEDIAN-WRITE-18. IF1214.2 +066800 F-MEDIAN-TEST-18. IF1214.2 +066900 COMPUTE ARG1 = ARG1 + 1. IF1214.2 +067000 COMPUTE ARG2 = ARG2 + 1. IF1214.2 +067100 F-MEDIAN-DELETE-18. IF1214.2 +067200 PERFORM DE-LETE. IF1214.2 +067300 GO TO F-MEDIAN-WRITE-18. IF1214.2 +067400 F-MEDIAN-WRITE-18. IF1214.2 +067500 MOVE "F-MEDIAN-18" TO PAR-NAME. IF1214.2 +067600 PERFORM PRINT-DETAIL. IF1214.2 +067700********************END OF TESTS*************** IF1214.2 +067800 CCVS-EXIT SECTION. IF1214.2 +067900 CCVS-999999. IF1214.2 +068000 GO TO CLOSE-FILES. IF1214.2 diff --git a/tests/cobol85/IF/IF122A.CBL b/tests/cobol85/IF/IF122A.CBL new file mode 100755 index 00000000..d4a3f687 --- /dev/null +++ b/tests/cobol85/IF/IF122A.CBL @@ -0,0 +1,680 @@ +000100 IDENTIFICATION DIVISION. IF1224.2 +000200 PROGRAM-ID. IF1224.2 +000300 IF122A. IF1224.2 +000400 IF1224.2 +000500*********************************************************** IF1224.2 +000600* * IF1224.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1224.2 +000800* It contains tests for the Intrinsic Function MIDRANGE * IF1224.2 +000900* * IF1224.2 +001000*********************************************************** IF1224.2 +001100 ENVIRONMENT DIVISION. IF1224.2 +001200 CONFIGURATION SECTION. IF1224.2 +001300 SOURCE-COMPUTER. IF1224.2 +001400 Linux. IF1224.2 +001500 OBJECT-COMPUTER. IF1224.2 +001600 Linux. IF1224.2 +001700 INPUT-OUTPUT SECTION. IF1224.2 +001800 FILE-CONTROL. IF1224.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1224.2 +002000 "report.log". IF1224.2 +002100 DATA DIVISION. IF1224.2 +002200 FILE SECTION. IF1224.2 +002300 FD PRINT-FILE. IF1224.2 +002400 01 PRINT-REC PICTURE X(120). IF1224.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1224.2 +002600 WORKING-STORAGE SECTION. IF1224.2 +002700*********************************************************** IF1224.2 +002800* Variables specific to the Intrinsic Function Test IF122A* IF1224.2 +002900*********************************************************** IF1224.2 +003000 01 A PIC S9(10) VALUE 5. IF1224.2 +003100 01 B PIC S9(10) VALUE 7. IF1224.2 +003200 01 C PIC S9(10) VALUE -4. IF1224.2 +003300 01 D PIC S9(10) VALUE 10. IF1224.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1224.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1224.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1224.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1224.2 +003800 01 M PIC S9(10) VALUE 320000. IF1224.2 +003900 01 N PIC S9(10) VALUE 650000. IF1224.2 +004000 01 O PIC S9(10) VALUE -430000. IF1224.2 +004100 01 P PIC S9(10) VALUE 1. IF1224.2 +004200 01 Q PIC S9(10) VALUE 3. IF1224.2 +004300 01 R PIC S9(10) VALUE 5. IF1224.2 +004400 01 ARG1 PIC S9(10) VALUE 2. IF1224.2 +004500 01 ARR VALUE "40537". IF1224.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1224.2 +004700 01 TEMP PIC S9(10)V9(5). IF1224.2 +004800 01 WS-NUM PIC S9(6)V9(7). IF1224.2 +004900 01 MIN-RANGE PIC S9(5)V9(7). IF1224.2 +005000 01 MAX-RANGE PIC S9(5)V9(7). IF1224.2 +005100* IF1224.2 +005200********************************************************** IF1224.2 +005300* IF1224.2 +005400 01 TEST-RESULTS. IF1224.2 +005500 02 FILLER PIC X VALUE SPACE. IF1224.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IF1224.2 +005700 02 FILLER PIC X VALUE SPACE. IF1224.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IF1224.2 +005900 02 FILLER PIC X VALUE SPACE. IF1224.2 +006000 02 PAR-NAME. IF1224.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IF1224.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IF1224.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IF1224.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IF1224.2 +006500 02 RE-MARK PIC X(61). IF1224.2 +006600 01 TEST-COMPUTED. IF1224.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1224.2 +006800 02 FILLER PIC X(17) VALUE IF1224.2 +006900 " COMPUTED=". IF1224.2 +007000 02 COMPUTED-X. IF1224.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1224.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IF1224.2 +007300 PIC -9(9).9(9). IF1224.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1224.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1224.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1224.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IF1224.2 +007800 04 COMPUTED-18V0 PIC -9(18). IF1224.2 +007900 04 FILLER PIC X. IF1224.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IF1224.2 +008100 01 TEST-CORRECT. IF1224.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IF1224.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1224.2 +008400 02 CORRECT-X. IF1224.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1224.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1224.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1224.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1224.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1224.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IF1224.2 +009100 04 CORRECT-18V0 PIC -9(18). IF1224.2 +009200 04 FILLER PIC X. IF1224.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IF1224.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1224.2 +009500 01 TEST-CORRECT-MIN. IF1224.2 +009600 02 FILLER PIC X(30) VALUE SPACE. IF1224.2 +009700 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1224.2 +009800 02 CORRECTMI-X. IF1224.2 +009900 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1224.2 +010000 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1224.2 +010100 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1224.2 +010200 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1224.2 +010300 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1224.2 +010400 03 CR-18V0 REDEFINES CORRECTMI-A. IF1224.2 +010500 04 CORRECTMI-18V0 PIC -9(18). IF1224.2 +010600 04 FILLER PIC X. IF1224.2 +010700 03 FILLER PIC X(2) VALUE SPACE. IF1224.2 +010800 03 FILLER PIC X(48) VALUE SPACE. IF1224.2 +010900 01 TEST-CORRECT-MAX. IF1224.2 +011000 02 FILLER PIC X(30) VALUE SPACE. IF1224.2 +011100 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1224.2 +011200 02 CORRECTMA-X. IF1224.2 +011300 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1224.2 +011400 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1224.2 +011500 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1224.2 +011600 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1224.2 +011700 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1224.2 +011800 03 CR-18V0 REDEFINES CORRECTMA-A. IF1224.2 +011900 04 CORRECTMA-18V0 PIC -9(18). IF1224.2 +012000 04 FILLER PIC X. IF1224.2 +012100 03 FILLER PIC X(2) VALUE SPACE. IF1224.2 +012200 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1224.2 +012300 01 CCVS-C-1. IF1224.2 +012400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1224.2 +012500- "SS PARAGRAPH-NAME IF1224.2 +012600- " REMARKS". IF1224.2 +012700 02 FILLER PIC X(20) VALUE SPACE. IF1224.2 +012800 01 CCVS-C-2. IF1224.2 +012900 02 FILLER PIC X VALUE SPACE. IF1224.2 +013000 02 FILLER PIC X(6) VALUE "TESTED". IF1224.2 +013100 02 FILLER PIC X(15) VALUE SPACE. IF1224.2 +013200 02 FILLER PIC X(4) VALUE "FAIL". IF1224.2 +013300 02 FILLER PIC X(94) VALUE SPACE. IF1224.2 +013400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1224.2 +013500 01 REC-CT PIC 99 VALUE ZERO. IF1224.2 +013600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1224.2 +013700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1224.2 +013800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1224.2 +013900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1224.2 +014000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1224.2 +014100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1224.2 +014200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1224.2 +014300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1224.2 +014400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1224.2 +014500 01 CCVS-H-1. IF1224.2 +014600 02 FILLER PIC X(39) VALUE SPACES. IF1224.2 +014700 02 FILLER PIC X(42) VALUE IF1224.2 +014800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1224.2 +014900 02 FILLER PIC X(39) VALUE SPACES. IF1224.2 +015000 01 CCVS-H-2A. IF1224.2 +015100 02 FILLER PIC X(40) VALUE SPACE. IF1224.2 +015200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1224.2 +015300 02 FILLER PIC XXXX VALUE IF1224.2 +015400 "4.2 ". IF1224.2 +015500 02 FILLER PIC X(28) VALUE IF1224.2 +015600 " COPY - NOT FOR DISTRIBUTION". IF1224.2 +015700 02 FILLER PIC X(41) VALUE SPACE. IF1224.2 +015800 IF1224.2 +015900 01 CCVS-H-2B. IF1224.2 +016000 02 FILLER PIC X(15) VALUE IF1224.2 +016100 "TEST RESULT OF ". IF1224.2 +016200 02 TEST-ID PIC X(9). IF1224.2 +016300 02 FILLER PIC X(4) VALUE IF1224.2 +016400 " IN ". IF1224.2 +016500 02 FILLER PIC X(12) VALUE IF1224.2 +016600 " HIGH ". IF1224.2 +016700 02 FILLER PIC X(22) VALUE IF1224.2 +016800 " LEVEL VALIDATION FOR ". IF1224.2 +016900 02 FILLER PIC X(58) VALUE IF1224.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1224.2 +017100 01 CCVS-H-3. IF1224.2 +017200 02 FILLER PIC X(34) VALUE IF1224.2 +017300 " FOR OFFICIAL USE ONLY ". IF1224.2 +017400 02 FILLER PIC X(58) VALUE IF1224.2 +017500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1224.2 +017600 02 FILLER PIC X(28) VALUE IF1224.2 +017700 " COPYRIGHT 1985 ". IF1224.2 +017800 01 CCVS-E-1. IF1224.2 +017900 02 FILLER PIC X(52) VALUE SPACE. IF1224.2 +018000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1224.2 +018100 02 ID-AGAIN PIC X(9). IF1224.2 +018200 02 FILLER PIC X(45) VALUE SPACES. IF1224.2 +018300 01 CCVS-E-2. IF1224.2 +018400 02 FILLER PIC X(31) VALUE SPACE. IF1224.2 +018500 02 FILLER PIC X(21) VALUE SPACE. IF1224.2 +018600 02 CCVS-E-2-2. IF1224.2 +018700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1224.2 +018800 03 FILLER PIC X VALUE SPACE. IF1224.2 +018900 03 ENDER-DESC PIC X(44) VALUE IF1224.2 +019000 "ERRORS ENCOUNTERED". IF1224.2 +019100 01 CCVS-E-3. IF1224.2 +019200 02 FILLER PIC X(22) VALUE IF1224.2 +019300 " FOR OFFICIAL USE ONLY". IF1224.2 +019400 02 FILLER PIC X(12) VALUE SPACE. IF1224.2 +019500 02 FILLER PIC X(58) VALUE IF1224.2 +019600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1224.2 +019700 02 FILLER PIC X(13) VALUE SPACE. IF1224.2 +019800 02 FILLER PIC X(15) VALUE IF1224.2 +019900 " COPYRIGHT 1985". IF1224.2 +020000 01 CCVS-E-4. IF1224.2 +020100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1224.2 +020200 02 FILLER PIC X(4) VALUE " OF ". IF1224.2 +020300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1224.2 +020400 02 FILLER PIC X(40) VALUE IF1224.2 +020500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1224.2 +020600 01 XXINFO. IF1224.2 +020700 02 FILLER PIC X(19) VALUE IF1224.2 +020800 "*** INFORMATION ***". IF1224.2 +020900 02 INFO-TEXT. IF1224.2 +021000 04 FILLER PIC X(8) VALUE SPACE. IF1224.2 +021100 04 XXCOMPUTED PIC X(20). IF1224.2 +021200 04 FILLER PIC X(5) VALUE SPACE. IF1224.2 +021300 04 XXCORRECT PIC X(20). IF1224.2 +021400 02 INF-ANSI-REFERENCE PIC X(48). IF1224.2 +021500 01 HYPHEN-LINE. IF1224.2 +021600 02 FILLER PIC IS X VALUE IS SPACE. IF1224.2 +021700 02 FILLER PIC IS X(65) VALUE IS "************************IF1224.2 +021800- "*****************************************". IF1224.2 +021900 02 FILLER PIC IS X(54) VALUE IS "************************IF1224.2 +022000- "******************************". IF1224.2 +022100 01 CCVS-PGM-ID PIC X(9) VALUE IF1224.2 +022200 "IF122A". IF1224.2 +022300 PROCEDURE DIVISION. IF1224.2 +022400 CCVS1 SECTION. IF1224.2 +022500 OPEN-FILES. IF1224.2 +022600 OPEN OUTPUT PRINT-FILE. IF1224.2 +022700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1224.2 +022800 MOVE SPACE TO TEST-RESULTS. IF1224.2 +022900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1224.2 +023000 GO TO CCVS1-EXIT. IF1224.2 +023100 CLOSE-FILES. IF1224.2 +023200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1224.2 +023300 TERMINATE-CCVS. IF1224.2 +023400 STOP RUN. IF1224.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1224.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1224.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1224.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1224.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. IF1224.2 +024000 PRINT-DETAIL. IF1224.2 +024100 IF REC-CT NOT EQUAL TO ZERO IF1224.2 +024200 MOVE "." TO PARDOT-X IF1224.2 +024300 MOVE REC-CT TO DOTVALUE. IF1224.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1224.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1224.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1224.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1224.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1224.2 +024900 MOVE SPACE TO CORRECT-X. IF1224.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1224.2 +025100 MOVE SPACE TO RE-MARK. IF1224.2 +025200 HEAD-ROUTINE. IF1224.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1224.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1224.2 +025700 COLUMN-NAMES-ROUTINE. IF1224.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +026100 END-ROUTINE. IF1224.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1224.2 +026300 END-RTN-EXIT. IF1224.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +026500 END-ROUTINE-1. IF1224.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1224.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1224.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. IF1224.2 +026900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1224.2 +027000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1224.2 +027100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1224.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1224.2 +027300 END-ROUTINE-12. IF1224.2 +027400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1224.2 +027500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1224.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1224.2 +027700 ELSE IF1224.2 +027800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1224.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1224.2 +028000 PERFORM WRITE-LINE. IF1224.2 +028100 END-ROUTINE-13. IF1224.2 +028200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1224.2 +028300 MOVE "NO " TO ERROR-TOTAL ELSE IF1224.2 +028400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1224.2 +028500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1224.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +028700 IF INSPECT-COUNTER EQUAL TO ZERO IF1224.2 +028800 MOVE "NO " TO ERROR-TOTAL IF1224.2 +028900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1224.2 +029000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1224.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +029200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1224.2 +029300 WRITE-LINE. IF1224.2 +029400 ADD 1 TO RECORD-COUNT. IF1224.2 +029500 IF RECORD-COUNT GREATER 42 IF1224.2 +029600 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1224.2 +029700 MOVE SPACE TO DUMMY-RECORD IF1224.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1224.2 +029900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1224.2 +030000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1224.2 +030100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1224.2 +030200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1224.2 +030300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1224.2 +030400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1224.2 +030500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1224.2 +030600 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1224.2 +030700 MOVE ZERO TO RECORD-COUNT. IF1224.2 +030800 PERFORM WRT-LN. IF1224.2 +030900 WRT-LN. IF1224.2 +031000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1224.2 +031100 MOVE SPACE TO DUMMY-RECORD. IF1224.2 +031200 BLANK-LINE-PRINT. IF1224.2 +031300 PERFORM WRT-LN. IF1224.2 +031400 FAIL-ROUTINE. IF1224.2 +031500 IF COMPUTED-X NOT EQUAL TO SPACE IF1224.2 +031600 GO TO FAIL-ROUTINE-WRITE. IF1224.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1224.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1224.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1224.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1224.2 +032200 GO TO FAIL-ROUTINE-EX. IF1224.2 +032300 FAIL-ROUTINE-WRITE. IF1224.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1224.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1224.2 +032600 CORMA-ANSI-REFERENCE. IF1224.2 +032700 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1224.2 +032800 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1224.2 +032900 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1224.2 +033000 ELSE IF1224.2 +033100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1224.2 +033200 PERFORM WRITE-LINE. IF1224.2 +033300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1224.2 +033400 FAIL-ROUTINE-EX. EXIT. IF1224.2 +033500 BAIL-OUT. IF1224.2 +033600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1224.2 +033700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1224.2 +033800 BAIL-OUT-WRITE. IF1224.2 +033900 MOVE CORRECT-A TO XXCORRECT. IF1224.2 +034000 MOVE COMPUTED-A TO XXCOMPUTED. IF1224.2 +034100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1224.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1224.2 +034300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1224.2 +034400 BAIL-OUT-EX. EXIT. IF1224.2 +034500 CCVS1-EXIT. IF1224.2 +034600 EXIT. IF1224.2 +034700******************************************************** IF1224.2 +034800* * IF1224.2 +034900* Intrinsic Function Tests IF122A - MIDRANGE * IF1224.2 +035000* * IF1224.2 +035100******************************************************** IF1224.2 +035200 SECT-IF122A SECTION. IF1224.2 +035300 F-MIDRANGE-INFO. IF1224.2 +035400 MOVE "See ref. A-55 2.26" TO ANSI-REFERENCE. IF1224.2 +035500 MOVE "MIDRANGE Function" TO FEATURE. IF1224.2 +035600*****************TEST (a) - SIMPLE TEST***************** IF1224.2 +035700 F-MIDRANGE-01. IF1224.2 +035800 MOVE ZERO TO WS-NUM. IF1224.2 +035900 F-MIDRANGE-TEST-01. IF1224.2 +036000 COMPUTE WS-NUM = FUNCTION MIDRANGE(5, -2, -14, 0). IF1224.2 +036100 IF (WS-NUM >= -4.50009) AND IF1224.2 +036200 (WS-NUM <= -4.49991) IF1224.2 +036300 PERFORM PASS IF1224.2 +036400 ELSE IF1224.2 +036500 MOVE WS-NUM TO COMPUTED-N IF1224.2 +036600 MOVE -4.5 TO CORRECT-N IF1224.2 +036700 PERFORM FAIL. IF1224.2 +036800 GO TO F-MIDRANGE-WRITE-01. IF1224.2 +036900 F-MIDRANGE-DELETE-01. IF1224.2 +037000 PERFORM DE-LETE. IF1224.2 +037100 GO TO F-MIDRANGE-WRITE-01. IF1224.2 +037200 F-MIDRANGE-WRITE-01. IF1224.2 +037300 MOVE "F-MIDRANGE-01" TO PAR-NAME. IF1224.2 +037400 PERFORM PRINT-DETAIL. IF1224.2 +037500*****************TEST (b) - SIMPLE TEST***************** IF1224.2 +037600 F-MIDRANGE-02. IF1224.2 +037700 EVALUATE FUNCTION MIDRANGE(3.9, -0.3, 8.7, 100.2) IF1224.2 +037800 WHEN 49.9490 THRU 49.9510 IF1224.2 +037900 PERFORM PASS IF1224.2 +038000 WHEN OTHER IF1224.2 +038100 PERFORM FAIL. IF1224.2 +038200 GO TO F-MIDRANGE-WRITE-02. IF1224.2 +038300 F-MIDRANGE-DELETE-02. IF1224.2 +038400 PERFORM DE-LETE. IF1224.2 +038500 GO TO F-MIDRANGE-WRITE-02. IF1224.2 +038600 F-MIDRANGE-WRITE-02. IF1224.2 +038700 MOVE "F-MIDRANGE-02" TO PAR-NAME. IF1224.2 +038800 PERFORM PRINT-DETAIL. IF1224.2 +038900*****************TEST (c) - SIMPLE TEST***************** IF1224.2 +039000 F-MIDRANGE-03. IF1224.2 +039100 IF FUNCTION MIDRANGE(A, B, C, D) = 3 THEN IF1224.2 +039200 PERFORM PASS IF1224.2 +039300 ELSE IF1224.2 +039400 PERFORM FAIL. IF1224.2 +039500 GO TO F-MIDRANGE-WRITE-03. IF1224.2 +039600 F-MIDRANGE-DELETE-03. IF1224.2 +039700 PERFORM DE-LETE. IF1224.2 +039800 GO TO F-MIDRANGE-WRITE-03. IF1224.2 +039900 F-MIDRANGE-WRITE-03. IF1224.2 +040000 MOVE "F-MIDRANGE-03" TO PAR-NAME. IF1224.2 +040100 PERFORM PRINT-DETAIL. IF1224.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1224.2 +040300 F-MIDRANGE-04. IF1224.2 +040400 MOVE ZERO TO WS-NUM. IF1224.2 +040500 F-MIDRANGE-TEST-04. IF1224.2 +040600 COMPUTE WS-NUM = FUNCTION MIDRANGE(E, F, G, H). IF1224.2 +040700 IF (WS-NUM >= 12.9697) AND IF1224.2 +040800 (WS-NUM <= 12.9703) IF1224.2 +040900 PERFORM PASS IF1224.2 +041000 ELSE IF1224.2 +041100 MOVE WS-NUM TO COMPUTED-N IF1224.2 +041200 MOVE 12.97 TO CORRECT-N IF1224.2 +041300 PERFORM FAIL. IF1224.2 +041400 GO TO F-MIDRANGE-WRITE-04. IF1224.2 +041500 F-MIDRANGE-DELETE-04. IF1224.2 +041600 PERFORM DE-LETE. IF1224.2 +041700 GO TO F-MIDRANGE-WRITE-04. IF1224.2 +041800 F-MIDRANGE-WRITE-04. IF1224.2 +041900 MOVE "F-MIDRANGE-04" TO PAR-NAME. IF1224.2 +042000 PERFORM PRINT-DETAIL. IF1224.2 +042100*****************TEST (e) - SIMPLE TEST***************** IF1224.2 +042200 F-MIDRANGE-05. IF1224.2 +042300 MOVE ZERO TO WS-NUM. IF1224.2 +042400 F-MIDRANGE-TEST-05. IF1224.2 +042500 COMPUTE WS-NUM = FUNCTION MIDRANGE(10.2, -0.2, 5.6, -15.6). IF1224.2 +042600 IF (WS-NUM >= -2.70005) AND IF1224.2 +042700 (WS-NUM <= -2.69995) IF1224.2 +042800 PERFORM PASS IF1224.2 +042900 ELSE IF1224.2 +043000 MOVE WS-NUM TO COMPUTED-N IF1224.2 +043100 MOVE -2.7 TO CORRECT-N IF1224.2 +043200 PERFORM FAIL. IF1224.2 +043300 GO TO F-MIDRANGE-WRITE-05. IF1224.2 +043400 F-MIDRANGE-DELETE-05. IF1224.2 +043500 PERFORM DE-LETE. IF1224.2 +043600 GO TO F-MIDRANGE-WRITE-05. IF1224.2 +043700 F-MIDRANGE-WRITE-05. IF1224.2 +043800 MOVE "F-MIDRANGE-05" TO PAR-NAME. IF1224.2 +043900 PERFORM PRINT-DETAIL. IF1224.2 +044000*****************TEST (f) - SIMPLE TEST***************** IF1224.2 +044100 F-MIDRANGE-06. IF1224.2 +044200 MOVE ZERO TO WS-NUM. IF1224.2 +044300 F-MIDRANGE-TEST-06. IF1224.2 +044400 COMPUTE WS-NUM = FUNCTION MIDRANGE(A, B, C, D, E, F, G, H). IF1224.2 +044500 IF (WS-NUM >= 12.9697) AND IF1224.2 +044600 (WS-NUM <= 12.9703) IF1224.2 +044700 PERFORM PASS IF1224.2 +044800 ELSE IF1224.2 +044900 MOVE WS-NUM TO COMPUTED-N IF1224.2 +045000 MOVE 12.97 TO CORRECT-N IF1224.2 +045100 PERFORM FAIL. IF1224.2 +045200 GO TO F-MIDRANGE-WRITE-06. IF1224.2 +045300 F-MIDRANGE-DELETE-06. IF1224.2 +045400 PERFORM DE-LETE. IF1224.2 +045500 GO TO F-MIDRANGE-WRITE-06. IF1224.2 +045600 F-MIDRANGE-WRITE-06. IF1224.2 +045700 MOVE "F-MIDRANGE-06" TO PAR-NAME. IF1224.2 +045800 PERFORM PRINT-DETAIL. IF1224.2 +045900*****************TEST (g) - SIMPLE TEST***************** IF1224.2 +046000 F-MIDRANGE-07. IF1224.2 +046100 MOVE ZERO TO WS-NUM. IF1224.2 +046200 F-MIDRANGE-TEST-07. IF1224.2 +046300 COMPUTE WS-NUM = FUNCTION MIDRANGE(2.6 + 30, 4.5 * 2). IF1224.2 +046400 IF (WS-NUM >= 20.7996) AND IF1224.2 +046500 (WS-NUM <= 20.8004) IF1224.2 +046600 PERFORM PASS IF1224.2 +046700 ELSE IF1224.2 +046800 MOVE WS-NUM TO COMPUTED-N IF1224.2 +046900 MOVE 20.8 TO CORRECT-N IF1224.2 +047000 PERFORM FAIL. IF1224.2 +047100 GO TO F-MIDRANGE-WRITE-07. IF1224.2 +047200 F-MIDRANGE-DELETE-07. IF1224.2 +047300 PERFORM DE-LETE. IF1224.2 +047400 GO TO F-MIDRANGE-WRITE-07. IF1224.2 +047500 F-MIDRANGE-WRITE-07. IF1224.2 +047600 MOVE "F-MIDRANGE-07" TO PAR-NAME. IF1224.2 +047700 PERFORM PRINT-DETAIL. IF1224.2 +047800*****************TEST (h) - SIMPLE TEST***************** IF1224.2 +047900 F-MIDRANGE-08. IF1224.2 +048000 MOVE ZERO TO WS-NUM. IF1224.2 +048100 F-MIDRANGE-TEST-08. IF1224.2 +048200 COMPUTE WS-NUM = FUNCTION MIDRANGE(IND(1), IND(2), IF1224.2 +048300 IND(3)). IF1224.2 +048400 IF (WS-NUM >= 2.49995) AND IF1224.2 +048500 (WS-NUM <= 2.50005) IF1224.2 +048600 PERFORM PASS IF1224.2 +048700 ELSE IF1224.2 +048800 MOVE WS-NUM TO COMPUTED-N IF1224.2 +048900 MOVE 2.5 TO CORRECT-N IF1224.2 +049000 PERFORM FAIL. IF1224.2 +049100 GO TO F-MIDRANGE-WRITE-08. IF1224.2 +049200 F-MIDRANGE-DELETE-08. IF1224.2 +049300 PERFORM DE-LETE. IF1224.2 +049400 GO TO F-MIDRANGE-WRITE-08. IF1224.2 +049500 F-MIDRANGE-WRITE-08. IF1224.2 +049600 MOVE "F-MIDRANGE-08" TO PAR-NAME. IF1224.2 +049700 PERFORM PRINT-DETAIL. IF1224.2 +049800*****************TEST (i) - SIMPLE TEST***************** IF1224.2 +049900 F-MIDRANGE-09. IF1224.2 +050000 MOVE ZERO TO WS-NUM. IF1224.2 +050100 F-MIDRANGE-TEST-09. IF1224.2 +050200 COMPUTE WS-NUM = FUNCTION MIDRANGE(IND(P), IND(Q), IF1224.2 +050300 IND(R)). IF1224.2 +050400 IF (WS-NUM >= 5.49989) AND IF1224.2 +050500 (WS-NUM <= 5.50011) IF1224.2 +050600 PERFORM PASS IF1224.2 +050700 ELSE IF1224.2 +050800 MOVE WS-NUM TO COMPUTED-N IF1224.2 +050900 MOVE 5.5 TO CORRECT-N IF1224.2 +051000 PERFORM FAIL. IF1224.2 +051100 GO TO F-MIDRANGE-WRITE-09. IF1224.2 +051200 F-MIDRANGE-DELETE-09. IF1224.2 +051300 PERFORM DE-LETE. IF1224.2 +051400 GO TO F-MIDRANGE-WRITE-09. IF1224.2 +051500 F-MIDRANGE-WRITE-09. IF1224.2 +051600 MOVE "F-MIDRANGE-09" TO PAR-NAME. IF1224.2 +051700 PERFORM PRINT-DETAIL. IF1224.2 +051800*****************TEST (j) - SIMPLE TEST***************** IF1224.2 +051900 F-MIDRANGE-10. IF1224.2 +052000 MOVE ZERO TO WS-NUM. IF1224.2 +052100 F-MIDRANGE-TEST-10. IF1224.2 +rogerw COMPUTE WS-NUM = FUNCTION MIDRANGE (4 0 5 3 7). +052300 IF (WS-NUM >= 3.49993) AND IF1224.2 +052400 (WS-NUM <= 3.50007) IF1224.2 +052500 PERFORM PASS IF1224.2 +052600 ELSE IF1224.2 +052700 MOVE WS-NUM TO COMPUTED-N IF1224.2 +052800 MOVE 3.5 TO CORRECT-N IF1224.2 +052900 PERFORM FAIL. IF1224.2 +053000 GO TO F-MIDRANGE-WRITE-10. IF1224.2 +053100 F-MIDRANGE-DELETE-10. IF1224.2 +053200 PERFORM DE-LETE. IF1224.2 +053300 GO TO F-MIDRANGE-WRITE-10. IF1224.2 +053400 F-MIDRANGE-WRITE-10. IF1224.2 +053500 MOVE "F-MIDRANGE-10" TO PAR-NAME. IF1224.2 +053600 PERFORM PRINT-DETAIL. IF1224.2 +053700*****************TEST (l) - SIMPLE TEST***************** IF1224.2 +053800 F-MIDRANGE-12. IF1224.2 +053900 MOVE ZERO TO WS-NUM. IF1224.2 +054000 F-MIDRANGE-TEST-12. IF1224.2 +054100 COMPUTE WS-NUM = FUNCTION MIDRANGE(M, N, O). IF1224.2 +054200 IF WS-NUM = 110000 THEN IF1224.2 +054300 PERFORM PASS IF1224.2 +054400 ELSE IF1224.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1224.2 +054600 MOVE 110000 TO CORRECT-N IF1224.2 +054700 PERFORM FAIL. IF1224.2 +054800 GO TO F-MIDRANGE-WRITE-12. IF1224.2 +054900 F-MIDRANGE-DELETE-12. IF1224.2 +055000 PERFORM DE-LETE. IF1224.2 +055100 GO TO F-MIDRANGE-WRITE-12. IF1224.2 +055200 F-MIDRANGE-WRITE-12. IF1224.2 +055300 MOVE "F-MIDRANGE-12" TO PAR-NAME. IF1224.2 +055400 PERFORM PRINT-DETAIL. IF1224.2 +055500*****************TEST (m) - SIMPLE TEST***************** IF1224.2 +055600 F-MIDRANGE-13. IF1224.2 +055700 MOVE ZERO TO WS-NUM. IF1224.2 +055800 F-MIDRANGE-TEST-13. IF1224.2 +055900 COMPUTE WS-NUM = FUNCTION MIDRANGE(A, 5, A). IF1224.2 +056000 IF WS-NUM = 5 THEN IF1224.2 +056100 PERFORM PASS IF1224.2 +056200 ELSE IF1224.2 +056300 MOVE WS-NUM TO COMPUTED-N IF1224.2 +056400 MOVE 5 TO CORRECT-N IF1224.2 +056500 PERFORM FAIL. IF1224.2 +056600 GO TO F-MIDRANGE-WRITE-13. IF1224.2 +056700 F-MIDRANGE-DELETE-13. IF1224.2 +056800 PERFORM DE-LETE. IF1224.2 +056900 GO TO F-MIDRANGE-WRITE-13. IF1224.2 +057000 F-MIDRANGE-WRITE-13. IF1224.2 +057100 MOVE "F-MIDRANGE-13" TO PAR-NAME. IF1224.2 +057200 PERFORM PRINT-DETAIL. IF1224.2 +057300*****************TEST (a) - COMPLEX TEST**************** IF1224.2 +057400 F-MIDRANGE-14. IF1224.2 +057500 MOVE ZERO TO WS-NUM. IF1224.2 +057600 MOVE 22.4995 TO MIN-RANGE. IF1224.2 +057700 MOVE 22.5004 TO MAX-RANGE. IF1224.2 +057800 F-MIDRANGE-TEST-14. IF1224.2 +057900 COMPUTE WS-NUM = FUNCTION MIDRANGE(E, 9 * A, 0, B / 2). IF1224.2 +058000 IF (WS-NUM >= MIN-RANGE) AND IF1224.2 +058100 (WS-NUM <= MAX-RANGE) THEN IF1224.2 +058200 PERFORM PASS IF1224.2 +058300 ELSE IF1224.2 +058400 MOVE WS-NUM TO COMPUTED-N IF1224.2 +058500 MOVE MIN-RANGE TO CORRECT-MIN IF1224.2 +058600 MOVE MAX-RANGE TO CORRECT-MAX IF1224.2 +058700 PERFORM FAIL. IF1224.2 +058800 GO TO F-MIDRANGE-WRITE-14. IF1224.2 +058900 F-MIDRANGE-DELETE-14. IF1224.2 +059000 PERFORM DE-LETE. IF1224.2 +059100 GO TO F-MIDRANGE-WRITE-14. IF1224.2 +059200 F-MIDRANGE-WRITE-14. IF1224.2 +059300 MOVE "F-MIDRANGE-14" TO PAR-NAME. IF1224.2 +059400 PERFORM PRINT-DETAIL. IF1224.2 +059500*****************TEST (b) - COMPLEX TEST**************** IF1224.2 +059600 F-MIDRANGE-15. IF1224.2 +059700 MOVE ZERO TO WS-NUM. IF1224.2 +059800 MOVE 83.9983 TO MIN-RANGE. IF1224.2 +059900 MOVE 84.0017 TO MAX-RANGE. IF1224.2 +060000 F-MIDRANGE-TEST-15. IF1224.2 +060100 COMPUTE WS-NUM = FUNCTION MIDRANGE(A, B) + 78. IF1224.2 +060200 IF (WS-NUM >= MIN-RANGE) AND IF1224.2 +060300 (WS-NUM <= MAX-RANGE) THEN IF1224.2 +060400 PERFORM PASS IF1224.2 +060500 ELSE IF1224.2 +060600 MOVE WS-NUM TO COMPUTED-N IF1224.2 +060700 MOVE MIN-RANGE TO CORRECT-MIN IF1224.2 +060800 MOVE MAX-RANGE TO CORRECT-MAX IF1224.2 +060900 PERFORM FAIL. IF1224.2 +061000 GO TO F-MIDRANGE-WRITE-15. IF1224.2 +061100 F-MIDRANGE-DELETE-15. IF1224.2 +061200 PERFORM DE-LETE. IF1224.2 +061300 GO TO F-MIDRANGE-WRITE-15. IF1224.2 +061400 F-MIDRANGE-WRITE-15. IF1224.2 +061500 MOVE "F-MIDRANGE-15" TO PAR-NAME. IF1224.2 +061600 PERFORM PRINT-DETAIL. IF1224.2 +061700*****************TEST (c) - COMPLEX TEST**************** IF1224.2 +061800 F-MIDRANGE-16. IF1224.2 +061900 MOVE ZERO TO WS-NUM. IF1224.2 +062000 MOVE 2.49995 TO MIN-RANGE. IF1224.2 +062100 MOVE 2.50005 TO MAX-RANGE. IF1224.2 +062200 F-MIDRANGE-TEST-16. IF1224.2 +062300 COMPUTE WS-NUM = FUNCTION MIDRANGE(A, B) + IF1224.2 +062400 FUNCTION MIDRANGE(-2.6, -4.4). IF1224.2 +062500 IF (WS-NUM >= MIN-RANGE) AND IF1224.2 +062600 (WS-NUM <= MAX-RANGE) THEN IF1224.2 +062700 PERFORM PASS IF1224.2 +062800 ELSE IF1224.2 +062900 MOVE WS-NUM TO COMPUTED-N IF1224.2 +063000 MOVE MIN-RANGE TO CORRECT-MIN IF1224.2 +063100 MOVE MAX-RANGE TO CORRECT-MAX IF1224.2 +063200 PERFORM FAIL. IF1224.2 +063300 GO TO F-MIDRANGE-WRITE-16. IF1224.2 +063400 F-MIDRANGE-DELETE-16. IF1224.2 +063500 PERFORM DE-LETE. IF1224.2 +063600 GO TO F-MIDRANGE-WRITE-16. IF1224.2 +063700 F-MIDRANGE-WRITE-16. IF1224.2 +063800 MOVE "F-MIDRANGE-16" TO PAR-NAME. IF1224.2 +063900 PERFORM PRINT-DETAIL. IF1224.2 +064000*****************TEST (d) - COMPLEX TEST**************** IF1224.2 +064100 F-MIDRANGE-17. IF1224.2 +064200 MOVE ZERO TO WS-NUM. IF1224.2 +064300 MOVE 3.49993 TO MIN-RANGE. IF1224.2 +064400 MOVE 3.50007 TO MAX-RANGE. IF1224.2 +064500 F-MIDRANGE-TEST-17. IF1224.2 +064600 COMPUTE WS-NUM = IF1224.2 +064700 FUNCTION MIDRANGE(FUNCTION MIDRANGE(1, 3), 5). IF1224.2 +064800 IF (WS-NUM >= MIN-RANGE) AND IF1224.2 +064900 (WS-NUM <= MAX-RANGE) THEN IF1224.2 +065000 PERFORM PASS IF1224.2 +065100 ELSE IF1224.2 +065200 MOVE WS-NUM TO COMPUTED-N IF1224.2 +065300 MOVE MIN-RANGE TO CORRECT-MIN IF1224.2 +065400 MOVE MAX-RANGE TO CORRECT-MAX IF1224.2 +065500 PERFORM FAIL. IF1224.2 +065600 GO TO F-MIDRANGE-WRITE-17. IF1224.2 +065700 F-MIDRANGE-DELETE-17. IF1224.2 +065800 PERFORM DE-LETE. IF1224.2 +065900 GO TO F-MIDRANGE-WRITE-17. IF1224.2 +066000 F-MIDRANGE-WRITE-17. IF1224.2 +066100 MOVE "F-MIDRANGE-17" TO PAR-NAME. IF1224.2 +066200 PERFORM PRINT-DETAIL. IF1224.2 +066300*****************SPECIAL PERFORM TEST********************** IF1224.2 +066400 F-MIDRANGE-18. IF1224.2 +066500 PERFORM F-MIDRANGE-TEST-18 IF1224.2 +066600 UNTIL FUNCTION MIDRANGE(1, ARG1) > 10. IF1224.2 +066700 PERFORM PASS. IF1224.2 +066800 GO TO F-MIDRANGE-WRITE-18. IF1224.2 +066900 F-MIDRANGE-TEST-18. IF1224.2 +067000 COMPUTE ARG1 = ARG1 + 1. IF1224.2 +067100 F-MIDRANGE-DELETE-18. IF1224.2 +067200 PERFORM DE-LETE. IF1224.2 +067300 GO TO F-MIDRANGE-WRITE-18. IF1224.2 +067400 F-MIDRANGE-WRITE-18. IF1224.2 +067500 MOVE "F-MIDRANGE-18" TO PAR-NAME. IF1224.2 +067600 PERFORM PRINT-DETAIL. IF1224.2 +067700********************END OF TESTS*************** IF1224.2 +067800 CCVS-EXIT SECTION. IF1224.2 +067900 CCVS-999999. IF1224.2 +068000 GO TO CLOSE-FILES. IF1224.2 diff --git a/tests/cobol85/IF/IF123A.CBL b/tests/cobol85/IF/IF123A.CBL new file mode 100755 index 00000000..9b3fcb5e --- /dev/null +++ b/tests/cobol85/IF/IF123A.CBL @@ -0,0 +1,797 @@ +000100 IDENTIFICATION DIVISION. IF1234.2 +000200 PROGRAM-ID. IF1234.2 +000300 IF123A. IF1234.2 +000400 IF1234.2 +000500*********************************************************** IF1234.2 +000600* * IF1234.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1234.2 +000800* It contains tests for the Intrinsic Function MIN. * IF1234.2 +000900* * IF1234.2 +001000*********************************************************** IF1234.2 +001100 ENVIRONMENT DIVISION. IF1234.2 +001200 CONFIGURATION SECTION. IF1234.2 +001300 SOURCE-COMPUTER. IF1234.2 +001400 Linux. IF1234.2 +001500 OBJECT-COMPUTER. IF1234.2 +001600 Linux IF1234.2 +001700 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1234.2 +001800 SPECIAL-NAMES. IF1234.2 +001900 ALPHABET PRG-COLL-SEQ IS IF1234.2 +002000 STANDARD-2. IF1234.2 +002100 INPUT-OUTPUT SECTION. IF1234.2 +002200 FILE-CONTROL. IF1234.2 +002300 SELECT PRINT-FILE ASSIGN TO IF1234.2 +002400 "report.log". IF1234.2 +002500 DATA DIVISION. IF1234.2 +002600 FILE SECTION. IF1234.2 +002700 FD PRINT-FILE. IF1234.2 +002800 01 PRINT-REC PICTURE X(120). IF1234.2 +002900 01 DUMMY-RECORD PICTURE X(120). IF1234.2 +003000 WORKING-STORAGE SECTION. IF1234.2 +003100*********************************************************** IF1234.2 +003200* Variables specific to the Intrinsic Function Test IF123A* IF1234.2 +003300*********************************************************** IF1234.2 +003400 01 A PIC S9(10) VALUE 5. IF1234.2 +003500 01 B PIC S9(10) VALUE 7. IF1234.2 +003600 01 C PIC S9(10) VALUE -4. IF1234.2 +003700 01 D PIC S9(10) VALUE 10. IF1234.2 +003800 01 E PIC S9(5)V9(5) VALUE 34.26. IF1234.2 +003900 01 F PIC S9(5)V9(5) VALUE -8.32. IF1234.2 +004000 01 G PIC S9(5)V9(5) VALUE 4.08. IF1234.2 +004100 01 H PIC S9(5)V9(5) VALUE -5.3. IF1234.2 +004200 01 I PIC X VALUE "R". IF1234.2 +004300 01 J PIC X VALUE "U". IF1234.2 +004400 01 M PIC S9(10) VALUE 1. IF1234.2 +004500 01 N PIC S9(10) VALUE 3. IF1234.2 +004600 01 O PIC S9(10) VALUE 5. IF1234.2 +004700 01 P PIC S9(10) VALUE 1. IF1234.2 +004800 01 Q PIC S9(10) VALUE 3. IF1234.2 +004900 01 R PIC S9(10) VALUE 5. IF1234.2 +005000 01 ARG1 PIC S9(10) VALUE 15. IF1234.2 +005100 01 ARR VALUE "40537". IF1234.2 +005200 02 IND OCCURS 5 TIMES PIC 9. IF1234.2 +005300 01 TEMP PIC S9(10). IF1234.2 +005400 01 WS-NUM PIC S9(5)V9(6). IF1234.2 +005500 01 WS-ANUM PIC X. IF1234.2 +005600 01 MIN-RANGE PIC S9(5)V9(7). IF1234.2 +005700 01 MAX-RANGE PIC S9(5)V9(7). IF1234.2 +005800* IF1234.2 +005900********************************************************** IF1234.2 +006000* IF1234.2 +006100 01 TEST-RESULTS. IF1234.2 +006200 02 FILLER PIC X VALUE SPACE. IF1234.2 +006300 02 FEATURE PIC X(20) VALUE SPACE. IF1234.2 +006400 02 FILLER PIC X VALUE SPACE. IF1234.2 +006500 02 P-OR-F PIC X(5) VALUE SPACE. IF1234.2 +006600 02 FILLER PIC X VALUE SPACE. IF1234.2 +006700 02 PAR-NAME. IF1234.2 +006800 03 FILLER PIC X(19) VALUE SPACE. IF1234.2 +006900 03 PARDOT-X PIC X VALUE SPACE. IF1234.2 +007000 03 DOTVALUE PIC 99 VALUE ZERO. IF1234.2 +007100 02 FILLER PIC X(8) VALUE SPACE. IF1234.2 +007200 02 RE-MARK PIC X(61). IF1234.2 +007300 01 TEST-COMPUTED. IF1234.2 +007400 02 FILLER PIC X(30) VALUE SPACE. IF1234.2 +007500 02 FILLER PIC X(17) VALUE IF1234.2 +007600 " COMPUTED=". IF1234.2 +007700 02 COMPUTED-X. IF1234.2 +007800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1234.2 +007900 03 COMPUTED-N REDEFINES COMPUTED-A IF1234.2 +008000 PIC -9(9).9(9). IF1234.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1234.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1234.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1234.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. IF1234.2 +008500 04 COMPUTED-18V0 PIC -9(18). IF1234.2 +008600 04 FILLER PIC X. IF1234.2 +008700 03 FILLER PIC X(50) VALUE SPACE. IF1234.2 +008800 01 TEST-CORRECT. IF1234.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1234.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1234.2 +009100 02 CORRECT-X. IF1234.2 +009200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1234.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1234.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1234.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1234.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1234.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. IF1234.2 +009800 04 CORRECT-18V0 PIC -9(18). IF1234.2 +009900 04 FILLER PIC X. IF1234.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1234.2 +010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1234.2 +010200 01 TEST-CORRECT-MIN. IF1234.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1234.2 +010400 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1234.2 +010500 02 CORRECTMI-X. IF1234.2 +010600 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1234.2 +010700 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1234.2 +010800 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1234.2 +010900 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1234.2 +011000 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1234.2 +011100 03 CR-18V0 REDEFINES CORRECTMI-A. IF1234.2 +011200 04 CORRECTMI-18V0 PIC -9(18). IF1234.2 +011300 04 FILLER PIC X. IF1234.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1234.2 +011500 03 FILLER PIC X(48) VALUE SPACE. IF1234.2 +011600 01 TEST-CORRECT-MAX. IF1234.2 +011700 02 FILLER PIC X(30) VALUE SPACE. IF1234.2 +011800 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1234.2 +011900 02 CORRECTMA-X. IF1234.2 +012000 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1234.2 +012100 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1234.2 +012200 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1234.2 +012300 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1234.2 +012400 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1234.2 +012500 03 CR-18V0 REDEFINES CORRECTMA-A. IF1234.2 +012600 04 CORRECTMA-18V0 PIC -9(18). IF1234.2 +012700 04 FILLER PIC X. IF1234.2 +012800 03 FILLER PIC X(2) VALUE SPACE. IF1234.2 +012900 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1234.2 +013000 01 CCVS-C-1. IF1234.2 +013100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1234.2 +013200- "SS PARAGRAPH-NAME IF1234.2 +013300- " REMARKS". IF1234.2 +013400 02 FILLER PIC X(20) VALUE SPACE. IF1234.2 +013500 01 CCVS-C-2. IF1234.2 +013600 02 FILLER PIC X VALUE SPACE. IF1234.2 +013700 02 FILLER PIC X(6) VALUE "TESTED". IF1234.2 +013800 02 FILLER PIC X(15) VALUE SPACE. IF1234.2 +013900 02 FILLER PIC X(4) VALUE "FAIL". IF1234.2 +014000 02 FILLER PIC X(94) VALUE SPACE. IF1234.2 +014100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1234.2 +014200 01 REC-CT PIC 99 VALUE ZERO. IF1234.2 +014300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1234.2 +014400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1234.2 +014500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1234.2 +014600 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1234.2 +014700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1234.2 +014800 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1234.2 +014900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1234.2 +015000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1234.2 +015100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1234.2 +015200 01 CCVS-H-1. IF1234.2 +015300 02 FILLER PIC X(39) VALUE SPACES. IF1234.2 +015400 02 FILLER PIC X(42) VALUE IF1234.2 +015500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1234.2 +015600 02 FILLER PIC X(39) VALUE SPACES. IF1234.2 +015700 01 CCVS-H-2A. IF1234.2 +015800 02 FILLER PIC X(40) VALUE SPACE. IF1234.2 +015900 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1234.2 +016000 02 FILLER PIC XXXX VALUE IF1234.2 +016100 "4.2 ". IF1234.2 +016200 02 FILLER PIC X(28) VALUE IF1234.2 +016300 " COPY - NOT FOR DISTRIBUTION". IF1234.2 +016400 02 FILLER PIC X(41) VALUE SPACE. IF1234.2 +016500 IF1234.2 +016600 01 CCVS-H-2B. IF1234.2 +016700 02 FILLER PIC X(15) VALUE IF1234.2 +016800 "TEST RESULT OF ". IF1234.2 +016900 02 TEST-ID PIC X(9). IF1234.2 +017000 02 FILLER PIC X(4) VALUE IF1234.2 +017100 " IN ". IF1234.2 +017200 02 FILLER PIC X(12) VALUE IF1234.2 +017300 " HIGH ". IF1234.2 +017400 02 FILLER PIC X(22) VALUE IF1234.2 +017500 " LEVEL VALIDATION FOR ". IF1234.2 +017600 02 FILLER PIC X(58) VALUE IF1234.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1234.2 +017800 01 CCVS-H-3. IF1234.2 +017900 02 FILLER PIC X(34) VALUE IF1234.2 +018000 " FOR OFFICIAL USE ONLY ". IF1234.2 +018100 02 FILLER PIC X(58) VALUE IF1234.2 +018200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1234.2 +018300 02 FILLER PIC X(28) VALUE IF1234.2 +018400 " COPYRIGHT 1985 ". IF1234.2 +018500 01 CCVS-E-1. IF1234.2 +018600 02 FILLER PIC X(52) VALUE SPACE. IF1234.2 +018700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1234.2 +018800 02 ID-AGAIN PIC X(9). IF1234.2 +018900 02 FILLER PIC X(45) VALUE SPACES. IF1234.2 +019000 01 CCVS-E-2. IF1234.2 +019100 02 FILLER PIC X(31) VALUE SPACE. IF1234.2 +019200 02 FILLER PIC X(21) VALUE SPACE. IF1234.2 +019300 02 CCVS-E-2-2. IF1234.2 +019400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1234.2 +019500 03 FILLER PIC X VALUE SPACE. IF1234.2 +019600 03 ENDER-DESC PIC X(44) VALUE IF1234.2 +019700 "ERRORS ENCOUNTERED". IF1234.2 +019800 01 CCVS-E-3. IF1234.2 +019900 02 FILLER PIC X(22) VALUE IF1234.2 +020000 " FOR OFFICIAL USE ONLY". IF1234.2 +020100 02 FILLER PIC X(12) VALUE SPACE. IF1234.2 +020200 02 FILLER PIC X(58) VALUE IF1234.2 +020300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1234.2 +020400 02 FILLER PIC X(13) VALUE SPACE. IF1234.2 +020500 02 FILLER PIC X(15) VALUE IF1234.2 +020600 " COPYRIGHT 1985". IF1234.2 +020700 01 CCVS-E-4. IF1234.2 +020800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1234.2 +020900 02 FILLER PIC X(4) VALUE " OF ". IF1234.2 +021000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1234.2 +021100 02 FILLER PIC X(40) VALUE IF1234.2 +021200 " TESTS WERE EXECUTED SUCCESSFULLY". IF1234.2 +021300 01 XXINFO. IF1234.2 +021400 02 FILLER PIC X(19) VALUE IF1234.2 +021500 "*** INFORMATION ***". IF1234.2 +021600 02 INFO-TEXT. IF1234.2 +021700 04 FILLER PIC X(8) VALUE SPACE. IF1234.2 +021800 04 XXCOMPUTED PIC X(20). IF1234.2 +021900 04 FILLER PIC X(5) VALUE SPACE. IF1234.2 +022000 04 XXCORRECT PIC X(20). IF1234.2 +022100 02 INF-ANSI-REFERENCE PIC X(48). IF1234.2 +022200 01 HYPHEN-LINE. IF1234.2 +022300 02 FILLER PIC IS X VALUE IS SPACE. IF1234.2 +022400 02 FILLER PIC IS X(65) VALUE IS "************************IF1234.2 +022500- "*****************************************". IF1234.2 +022600 02 FILLER PIC IS X(54) VALUE IS "************************IF1234.2 +022700- "******************************". IF1234.2 +022800 01 CCVS-PGM-ID PIC X(9) VALUE IF1234.2 +022900 "IF123A". IF1234.2 +023000 PROCEDURE DIVISION. IF1234.2 +023100 CCVS1 SECTION. IF1234.2 +023200 OPEN-FILES. IF1234.2 +023300 OPEN OUTPUT PRINT-FILE. IF1234.2 +023400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1234.2 +023500 MOVE SPACE TO TEST-RESULTS. IF1234.2 +023600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1234.2 +023700 GO TO CCVS1-EXIT. IF1234.2 +023800 CLOSE-FILES. IF1234.2 +023900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1234.2 +024000 TERMINATE-CCVS. IF1234.2 +024100 STOP RUN. IF1234.2 +024200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1234.2 +024300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1234.2 +024400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1234.2 +024500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1234.2 +024600 MOVE "****TEST DELETED****" TO RE-MARK. IF1234.2 +024700 PRINT-DETAIL. IF1234.2 +024800 IF REC-CT NOT EQUAL TO ZERO IF1234.2 +024900 MOVE "." TO PARDOT-X IF1234.2 +025000 MOVE REC-CT TO DOTVALUE. IF1234.2 +025100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1234.2 +025200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1234.2 +025300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1234.2 +025400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1234.2 +025500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1234.2 +025600 MOVE SPACE TO CORRECT-X. IF1234.2 +025700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1234.2 +025800 MOVE SPACE TO RE-MARK. IF1234.2 +025900 HEAD-ROUTINE. IF1234.2 +026000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +026100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +026200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1234.2 +026300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1234.2 +026400 COLUMN-NAMES-ROUTINE. IF1234.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +026800 END-ROUTINE. IF1234.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1234.2 +027000 END-RTN-EXIT. IF1234.2 +027100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +027200 END-ROUTINE-1. IF1234.2 +027300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1234.2 +027400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1234.2 +027500 ADD PASS-COUNTER TO ERROR-HOLD. IF1234.2 +027600 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1234.2 +027700 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1234.2 +027800 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1234.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1234.2 +028000 END-ROUTINE-12. IF1234.2 +028100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1234.2 +028200 IF ERROR-COUNTER IS EQUAL TO ZERO IF1234.2 +028300 MOVE "NO " TO ERROR-TOTAL IF1234.2 +028400 ELSE IF1234.2 +028500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1234.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1234.2 +028700 PERFORM WRITE-LINE. IF1234.2 +028800 END-ROUTINE-13. IF1234.2 +028900 IF DELETE-COUNTER IS EQUAL TO ZERO IF1234.2 +029000 MOVE "NO " TO ERROR-TOTAL ELSE IF1234.2 +029100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1234.2 +029200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1234.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +029400 IF INSPECT-COUNTER EQUAL TO ZERO IF1234.2 +029500 MOVE "NO " TO ERROR-TOTAL IF1234.2 +029600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1234.2 +029700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1234.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +029900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1234.2 +030000 WRITE-LINE. IF1234.2 +030100 ADD 1 TO RECORD-COUNT. IF1234.2 +030200 IF RECORD-COUNT GREATER 42 IF1234.2 +030300 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1234.2 +030400 MOVE SPACE TO DUMMY-RECORD IF1234.2 +030500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1234.2 +030600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1234.2 +030700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1234.2 +030800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1234.2 +030900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1234.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1234.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1234.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1234.2 +031300 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1234.2 +031400 MOVE ZERO TO RECORD-COUNT. IF1234.2 +031500 PERFORM WRT-LN. IF1234.2 +031600 WRT-LN. IF1234.2 +031700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1234.2 +031800 MOVE SPACE TO DUMMY-RECORD. IF1234.2 +031900 BLANK-LINE-PRINT. IF1234.2 +032000 PERFORM WRT-LN. IF1234.2 +032100 FAIL-ROUTINE. IF1234.2 +032200 IF COMPUTED-X NOT EQUAL TO SPACE IF1234.2 +032300 GO TO FAIL-ROUTINE-WRITE. IF1234.2 +032400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1234.2 +032500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1234.2 +032600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1234.2 +032700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +032800 MOVE SPACES TO INF-ANSI-REFERENCE. IF1234.2 +032900 GO TO FAIL-ROUTINE-EX. IF1234.2 +033000 FAIL-ROUTINE-WRITE. IF1234.2 +033100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1234.2 +033200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1234.2 +033300 CORMA-ANSI-REFERENCE. IF1234.2 +033400 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1234.2 +033500 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1234.2 +033600 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1234.2 +033700 ELSE IF1234.2 +033800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1234.2 +033900 PERFORM WRITE-LINE. IF1234.2 +034000 MOVE SPACES TO COR-ANSI-REFERENCE. IF1234.2 +034100 FAIL-ROUTINE-EX. EXIT. IF1234.2 +034200 BAIL-OUT. IF1234.2 +034300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1234.2 +034400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1234.2 +034500 BAIL-OUT-WRITE. IF1234.2 +034600 MOVE CORRECT-A TO XXCORRECT. IF1234.2 +034700 MOVE COMPUTED-A TO XXCOMPUTED. IF1234.2 +034800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1234.2 +034900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1234.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1234.2 +035100 BAIL-OUT-EX. EXIT. IF1234.2 +035200 CCVS1-EXIT. IF1234.2 +035300 EXIT. IF1234.2 +035400******************************************************** IF1234.2 +035500* * IF1234.2 +035600* Intrinsic Function Tests IF123A - MIN * IF1234.2 +035700* * IF1234.2 +035800******************************************************** IF1234.2 +035900 SECT-IF123A SECTION. IF1234.2 +036000 F-MIN-INFO. IF1234.2 +036100 MOVE "See ref. A-56 2.27" TO ANSI-REFERENCE. IF1234.2 +036200 MOVE "MIN Function" TO FEATURE. IF1234.2 +036300*****************TEST (a) - SIMPLE TEST***************** IF1234.2 +036400 F-MIN-01. IF1234.2 +036500 MOVE ZERO TO WS-NUM. IF1234.2 +036600 F-MIN-TEST-01. IF1234.2 +036700 COMPUTE WS-NUM = FUNCTION MIN(5, 6, 10, 3, 7). IF1234.2 +036800 IF WS-NUM = 3 THEN IF1234.2 +036900 PERFORM PASS IF1234.2 +037000 ELSE IF1234.2 +037100 MOVE WS-NUM TO COMPUTED-N IF1234.2 +037200 MOVE 3 TO CORRECT-N IF1234.2 +037300 PERFORM FAIL. IF1234.2 +037400 GO TO F-MIN-WRITE-01. IF1234.2 +037500 F-MIN-DELETE-01. IF1234.2 +037600 PERFORM DE-LETE. IF1234.2 +037700 GO TO F-MIN-WRITE-01. IF1234.2 +037800 F-MIN-WRITE-01. IF1234.2 +037900 MOVE "F-MIN-01" TO PAR-NAME. IF1234.2 +038000 PERFORM PRINT-DETAIL. IF1234.2 +038100*****************TEST (b) - SIMPLE TEST***************** IF1234.2 +038200 F-MIN-02. IF1234.2 +038300 EVALUATE FUNCTION MIN(-4, 7, 2304, 3, -8) IF1234.2 +038400 WHEN -8 IF1234.2 +038500 PERFORM PASS IF1234.2 +038600 WHEN OTHER IF1234.2 +038700 PERFORM FAIL. IF1234.2 +038800 GO TO F-MIN-WRITE-02. IF1234.2 +038900 F-MIN-DELETE-02. IF1234.2 +039000 PERFORM DE-LETE. IF1234.2 +039100 GO TO F-MIN-WRITE-02. IF1234.2 +039200 F-MIN-WRITE-02. IF1234.2 +039300 MOVE "F-MIN-02" TO PAR-NAME. IF1234.2 +039400 PERFORM PRINT-DETAIL. IF1234.2 +039500*****************TEST (c) - SIMPLE TEST***************** IF1234.2 +039600 F-MIN-03. IF1234.2 +039700 IF (FUNCTION MIN(4.3, 2.6, 7.3, 9.1) >= 2.59995) AND IF1234.2 +039800 (FUNCTION MIN(4.3, 2.6, 7.3, 9.1) <= 2.60005) THEN IF1234.2 +039900 PERFORM PASS IF1234.2 +040000 ELSE IF1234.2 +040100 PERFORM FAIL. IF1234.2 +040200 GO TO F-MIN-WRITE-03. IF1234.2 +040300 F-MIN-DELETE-03. IF1234.2 +040400 PERFORM DE-LETE. IF1234.2 +040500 GO TO F-MIN-WRITE-03. IF1234.2 +040600 F-MIN-WRITE-03. IF1234.2 +040700 MOVE "F-MIN-03" TO PAR-NAME. IF1234.2 +040800 PERFORM PRINT-DETAIL. IF1234.2 +040900*****************TEST (d) - SIMPLE TEST***************** IF1234.2 +041000 F-MIN-04. IF1234.2 +041100 MOVE ZERO TO WS-NUM. IF1234.2 +041200 F-MIN-TEST-04. IF1234.2 +041300 COMPUTE WS-NUM = FUNCTION MIN(-4.3, 10.2, -0.7, 3.9). IF1234.2 +041400 IF (WS-NUM >= -4.30009) AND IF1234.2 +041500 (WS-NUM <= -4.29991) IF1234.2 +041600 PERFORM PASS IF1234.2 +041700 ELSE IF1234.2 +041800 MOVE WS-NUM TO COMPUTED-N IF1234.2 +041900 MOVE -4.3 TO CORRECT-N IF1234.2 +042000 PERFORM FAIL. IF1234.2 +042100 GO TO F-MIN-WRITE-04. IF1234.2 +042200 F-MIN-DELETE-04. IF1234.2 +042300 PERFORM DE-LETE. IF1234.2 +042400 GO TO F-MIN-WRITE-04. IF1234.2 +042500 F-MIN-WRITE-04. IF1234.2 +042600 MOVE "F-MIN-04" TO PAR-NAME. IF1234.2 +042700 PERFORM PRINT-DETAIL. IF1234.2 +042800*****************TEST (e) - SIMPLE TEST***************** IF1234.2 +042900 F-MIN-05. IF1234.2 +043000 MOVE ZERO TO WS-NUM. IF1234.2 +043100 F-MIN-TEST-05. IF1234.2 +043200 COMPUTE WS-NUM = FUNCTION MIN(A, B, D). IF1234.2 +043300 IF WS-NUM = 5 THEN IF1234.2 +043400 PERFORM PASS IF1234.2 +043500 ELSE IF1234.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1234.2 +043700 MOVE 5 TO CORRECT-N IF1234.2 +043800 PERFORM FAIL. IF1234.2 +043900 GO TO F-MIN-WRITE-05. IF1234.2 +044000 F-MIN-DELETE-05. IF1234.2 +044100 PERFORM DE-LETE. IF1234.2 +044200 GO TO F-MIN-WRITE-05. IF1234.2 +044300 F-MIN-WRITE-05. IF1234.2 +044400 MOVE "F-MIN-05" TO PAR-NAME. IF1234.2 +044500 PERFORM PRINT-DETAIL. IF1234.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1234.2 +044700 F-MIN-06. IF1234.2 +044800 MOVE ZERO TO WS-NUM. IF1234.2 +044900 F-MIN-TEST-06. IF1234.2 +045000 COMPUTE WS-NUM = FUNCTION MIN(A, B, C, D). IF1234.2 +045100 IF WS-NUM = -4 THEN IF1234.2 +045200 PERFORM PASS IF1234.2 +045300 ELSE IF1234.2 +045400 MOVE WS-NUM TO COMPUTED-N IF1234.2 +045500 MOVE -4 TO CORRECT-N IF1234.2 +045600 PERFORM FAIL. IF1234.2 +045700 GO TO F-MIN-WRITE-06. IF1234.2 +045800 F-MIN-DELETE-06. IF1234.2 +045900 PERFORM DE-LETE. IF1234.2 +046000 GO TO F-MIN-WRITE-06. IF1234.2 +046100 F-MIN-WRITE-06. IF1234.2 +046200 MOVE "F-MIN-06" TO PAR-NAME. IF1234.2 +046300 PERFORM PRINT-DETAIL. IF1234.2 +046400*****************TEST (g) - SIMPLE TEST***************** IF1234.2 +046500 F-MIN-07. IF1234.2 +046600 MOVE ZERO TO WS-NUM. IF1234.2 +046700 F-MIN-TEST-07. IF1234.2 +046800 COMPUTE WS-NUM = FUNCTION MIN(E, G). IF1234.2 +046900 IF (WS-NUM >= 4.07992) AND IF1234.2 +047000 (WS-NUM <= 4.08008) IF1234.2 +047100 PERFORM PASS IF1234.2 +047200 ELSE IF1234.2 +047300 MOVE WS-NUM TO COMPUTED-N IF1234.2 +047400 MOVE 4.08 TO CORRECT-N IF1234.2 +047500 PERFORM FAIL. IF1234.2 +047600 GO TO F-MIN-WRITE-07. IF1234.2 +047700 F-MIN-DELETE-07. IF1234.2 +047800 PERFORM DE-LETE. IF1234.2 +047900 GO TO F-MIN-WRITE-07. IF1234.2 +048000 F-MIN-WRITE-07. IF1234.2 +048100 MOVE "F-MIN-07" TO PAR-NAME. IF1234.2 +048200 PERFORM PRINT-DETAIL. IF1234.2 +048300*****************TEST (h) - SIMPLE TEST***************** IF1234.2 +048400 F-MIN-08. IF1234.2 +048500 MOVE ZERO TO WS-NUM. IF1234.2 +048600 F-MIN-TEST-08. IF1234.2 +048700 COMPUTE WS-NUM = FUNCTION MIN(E, F, G, H). IF1234.2 +048800 IF (WS-NUM >= -8.32017) AND IF1234.2 +048900 (WS-NUM <= -8.31983) IF1234.2 +049000 PERFORM PASS IF1234.2 +049100 ELSE IF1234.2 +049200 MOVE WS-NUM TO COMPUTED-N IF1234.2 +049300 MOVE -8.32 TO CORRECT-N IF1234.2 +049400 PERFORM FAIL. IF1234.2 +049500 GO TO F-MIN-WRITE-08. IF1234.2 +049600 F-MIN-DELETE-08. IF1234.2 +049700 PERFORM DE-LETE. IF1234.2 +049800 GO TO F-MIN-WRITE-08. IF1234.2 +049900 F-MIN-WRITE-08. IF1234.2 +050000 MOVE "F-MIN-08" TO PAR-NAME. IF1234.2 +050100 PERFORM PRINT-DETAIL. IF1234.2 +050200*****************TEST (i) - SIMPLE TEST***************** IF1234.2 +050300 F-MIN-09. IF1234.2 +050400 MOVE ZERO TO WS-NUM. IF1234.2 +050500 F-MIN-TEST-09. IF1234.2 +050600 COMPUTE WS-NUM = FUNCTION MIN(A, 4, 8, -10, C, 0). IF1234.2 +050700 IF WS-NUM = -10 THEN IF1234.2 +050800 PERFORM PASS IF1234.2 +050900 ELSE IF1234.2 +051000 MOVE WS-NUM TO COMPUTED-N IF1234.2 +051100 MOVE -10 TO CORRECT-N IF1234.2 +051200 PERFORM FAIL. IF1234.2 +051300 GO TO F-MIN-WRITE-09. IF1234.2 +051400 F-MIN-DELETE-09. IF1234.2 +051500 PERFORM DE-LETE. IF1234.2 +051600 GO TO F-MIN-WRITE-09. IF1234.2 +051700 F-MIN-WRITE-09. IF1234.2 +051800 MOVE "F-MIN-09" TO PAR-NAME. IF1234.2 +051900 PERFORM PRINT-DETAIL. IF1234.2 +052000*****************TEST (j) - SIMPLE TEST***************** IF1234.2 +052100 F-MIN-10. IF1234.2 +052200 MOVE ZERO TO WS-NUM. IF1234.2 +052300 F-MIN-TEST-10. IF1234.2 +052400 COMPUTE WS-NUM = FUNCTION MIN(4, D, E, 6.3, -2.0). IF1234.2 +052500 IF (WS-NUM >= -2.00004) AND IF1234.2 +052600 (WS-NUM <= -1.99996) IF1234.2 +052700 PERFORM PASS IF1234.2 +052800 ELSE IF1234.2 +052900 MOVE WS-NUM TO COMPUTED-N IF1234.2 +053000 MOVE -2.0 TO CORRECT-N IF1234.2 +053100 PERFORM FAIL. IF1234.2 +053200 GO TO F-MIN-WRITE-10. IF1234.2 +053300 F-MIN-DELETE-10. IF1234.2 +053400 PERFORM DE-LETE. IF1234.2 +053500 GO TO F-MIN-WRITE-10. IF1234.2 +053600 F-MIN-WRITE-10. IF1234.2 +053700 MOVE "F-MIN-10" TO PAR-NAME. IF1234.2 +053800 PERFORM PRINT-DETAIL. IF1234.2 +053900*****************TEST (k) - SIMPLE TEST***************** IF1234.2 +054000 F-MIN-11. IF1234.2 +054100 MOVE SPACES TO WS-ANUM. IF1234.2 +054200 F-MIN-TEST-11. IF1234.2 +054300 MOVE FUNCTION MIN("R", I, "I", "a") TO WS-ANUM. IF1234.2 +054400 IF WS-ANUM = "I" THEN IF1234.2 +054500 PERFORM PASS IF1234.2 +054600 ELSE IF1234.2 +054700 MOVE WS-ANUM TO COMPUTED-A IF1234.2 +054800 MOVE "I" TO CORRECT-A IF1234.2 +054900 PERFORM FAIL. IF1234.2 +055000 GO TO F-MIN-WRITE-11. IF1234.2 +055100 F-MIN-DELETE-11. IF1234.2 +055200 PERFORM DE-LETE. IF1234.2 +055300 GO TO F-MIN-WRITE-11. IF1234.2 +055400 F-MIN-WRITE-11. IF1234.2 +055500 MOVE "F-MIN-11" TO PAR-NAME. IF1234.2 +055600 PERFORM PRINT-DETAIL. IF1234.2 +055700*****************TEST (l) - SIMPLE TEST***************** IF1234.2 +055800 F-MIN-12. IF1234.2 +055900 MOVE ZERO TO WS-NUM. IF1234.2 +056000 F-MIN-TEST-12. IF1234.2 +056100 MOVE FUNCTION MIN("a", J, "J") TO WS-ANUM. IF1234.2 +056200 IF WS-ANUM = "J" THEN IF1234.2 +056300 PERFORM PASS IF1234.2 +056400 ELSE IF1234.2 +056500 MOVE WS-ANUM TO COMPUTED-A IF1234.2 +056600 MOVE "J" TO CORRECT-A IF1234.2 +056700 PERFORM FAIL. IF1234.2 +056800 GO TO F-MIN-WRITE-12. IF1234.2 +056900 F-MIN-DELETE-12. IF1234.2 +057000 PERFORM DE-LETE. IF1234.2 +057100 GO TO F-MIN-WRITE-12. IF1234.2 +057200 F-MIN-WRITE-12. IF1234.2 +057300 MOVE "F-MIN-12" TO PAR-NAME. IF1234.2 +057400 PERFORM PRINT-DETAIL. IF1234.2 +057500*****************TEST (m) - SIMPLE TEST***************** IF1234.2 +057600 F-MIN-13. IF1234.2 +057700 MOVE ZERO TO WS-NUM. IF1234.2 +057800 F-MIN-TEST-13. IF1234.2 +057900 COMPUTE WS-NUM = FUNCTION MIN(IND(1), IND(2), IND(3)). IF1234.2 +058000 IF WS-NUM = 0 THEN IF1234.2 +058100 PERFORM PASS IF1234.2 +058200 ELSE IF1234.2 +058300 MOVE WS-NUM TO COMPUTED-N IF1234.2 +058400 MOVE 0 TO CORRECT-N IF1234.2 +058500 PERFORM FAIL. IF1234.2 +058600 GO TO F-MIN-WRITE-13. IF1234.2 +058700 F-MIN-DELETE-13. IF1234.2 +058800 PERFORM DE-LETE. IF1234.2 +058900 GO TO F-MIN-WRITE-13. IF1234.2 +059000 F-MIN-WRITE-13. IF1234.2 +059100 MOVE "F-MIN-13" TO PAR-NAME. IF1234.2 +059200 PERFORM PRINT-DETAIL. IF1234.2 +059300*****************TEST (n) - SIMPLE TEST***************** IF1234.2 +059400 F-MIN-14. IF1234.2 +059500 MOVE ZERO TO WS-NUM. IF1234.2 +059600 F-MIN-TEST-14. IF1234.2 +059700 COMPUTE WS-NUM = FUNCTION MIN(IND(P), IND(Q), IND(R)). IF1234.2 +059800 IF WS-NUM = 4 THEN IF1234.2 +059900 PERFORM PASS IF1234.2 +060000 ELSE IF1234.2 +060100 MOVE WS-NUM TO COMPUTED-N IF1234.2 +060200 MOVE 4 TO CORRECT-N IF1234.2 +060300 PERFORM FAIL. IF1234.2 +060400 GO TO F-MIN-WRITE-14. IF1234.2 +060500 F-MIN-DELETE-14. IF1234.2 +060600 PERFORM DE-LETE. IF1234.2 +060700 GO TO F-MIN-WRITE-14. IF1234.2 +060800 F-MIN-WRITE-14. IF1234.2 +060900 MOVE "F-MIN-14" TO PAR-NAME. IF1234.2 +061000 PERFORM PRINT-DETAIL. IF1234.2 +061100*****************TEST (o) - SIMPLE TEST***************** IF1234.2 +061200 F-MIN-15. IF1234.2 +061300 MOVE ZERO TO WS-NUM. IF1234.2 +061400 F-MIN-TEST-15. IF1234.2 +rogerw COMPUTE WS-NUM = FUNCTION MIN (4 0 5 3 7). +061600 IF WS-NUM = 0 THEN IF1234.2 +061700 PERFORM PASS IF1234.2 +061800 ELSE IF1234.2 +061900 MOVE WS-NUM TO COMPUTED-N IF1234.2 +062000 MOVE 0 TO CORRECT-N IF1234.2 +062100 PERFORM FAIL. IF1234.2 +062200 GO TO F-MIN-WRITE-15. IF1234.2 +062300 F-MIN-DELETE-15. IF1234.2 +062400 PERFORM DE-LETE. IF1234.2 +062500 GO TO F-MIN-WRITE-15. IF1234.2 +062600 F-MIN-WRITE-15. IF1234.2 +062700 MOVE "F-MIN-15" TO PAR-NAME. IF1234.2 +062800 PERFORM PRINT-DETAIL. IF1234.2 +062900*****************TEST (q) - SIMPLE TEST***************** IF1234.2 +063000 F-MIN-17. IF1234.2 +063100 MOVE ZERO TO WS-NUM. IF1234.2 +063200 F-MIN-TEST-17. IF1234.2 +063300 COMPUTE WS-NUM = IF1234.2 +063400 FUNCTION MIN(31000, 310001, 78000, 29000, 12000). IF1234.2 +063500 IF WS-NUM = 12000 THEN IF1234.2 +063600 PERFORM PASS IF1234.2 +063700 ELSE IF1234.2 +063800 MOVE WS-NUM TO COMPUTED-N IF1234.2 +063900 MOVE 1200 TO CORRECT-N IF1234.2 +064000 PERFORM FAIL. IF1234.2 +064100 GO TO F-MIN-WRITE-17. IF1234.2 +064200 F-MIN-DELETE-17. IF1234.2 +064300 PERFORM DE-LETE. IF1234.2 +064400 GO TO F-MIN-WRITE-17. IF1234.2 +064500 F-MIN-WRITE-17. IF1234.2 +064600 MOVE "F-MIN-17" TO PAR-NAME. IF1234.2 +064700 PERFORM PRINT-DETAIL. IF1234.2 +064800*****************TEST (a) - COMPLEX TEST**************** IF1234.2 +064900 F-MIN-18. IF1234.2 +065000 MOVE ZERO TO WS-NUM. IF1234.2 +065100 MOVE 1.99996 TO MIN-RANGE. IF1234.2 +065200 MOVE 2.00004 TO MAX-RANGE. IF1234.2 +065300 F-MIN-TEST-18. IF1234.2 +065400 COMPUTE WS-NUM = FUNCTION MIN(A * B, (3 + 1) / 2, 3 + 4). IF1234.2 +065500 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +065600 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +065700 PERFORM PASS IF1234.2 +065800 ELSE IF1234.2 +065900 MOVE WS-NUM TO COMPUTED-N IF1234.2 +066000 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +066100 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +066200 PERFORM FAIL. IF1234.2 +066300 GO TO F-MIN-WRITE-18. IF1234.2 +066400 F-MIN-DELETE-18. IF1234.2 +066500 PERFORM DE-LETE. IF1234.2 +066600 GO TO F-MIN-WRITE-18. IF1234.2 +066700 F-MIN-WRITE-18. IF1234.2 +066800 MOVE "F-MIN-18" TO PAR-NAME. IF1234.2 +066900 PERFORM PRINT-DETAIL. IF1234.2 +067000*****************TEST (b) - COMPLEX TEST**************** IF1234.2 +067100 F-MIN-19. IF1234.2 +067200 MOVE ZERO TO WS-NUM. IF1234.2 +067300 MOVE -10.6002 TO MIN-RANGE. IF1234.2 +067400 MOVE -10.5998 TO MAX-RANGE. IF1234.2 +067500 F-MIN-TEST-19. IF1234.2 +067600 COMPUTE WS-NUM = FUNCTION MIN(E + 4, H * 2, 5 + A). IF1234.2 +067700 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +067800 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +067900 PERFORM PASS IF1234.2 +068000 ELSE IF1234.2 +068100 MOVE WS-NUM TO COMPUTED-N IF1234.2 +068200 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +068300 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +068400 PERFORM FAIL. IF1234.2 +068500 GO TO F-MIN-WRITE-19. IF1234.2 +068600 F-MIN-DELETE-19. IF1234.2 +068700 PERFORM DE-LETE. IF1234.2 +068800 GO TO F-MIN-WRITE-19. IF1234.2 +068900 F-MIN-WRITE-19. IF1234.2 +069000 MOVE "F-MIN-19" TO PAR-NAME. IF1234.2 +069100 PERFORM PRINT-DETAIL. IF1234.2 +069200*****************TEST (c) - COMPLEX TEST**************** IF1234.2 +069300 F-MIN-20. IF1234.2 +069400 MOVE ZERO TO WS-NUM. IF1234.2 +069500 MOVE -7.00014 TO MIN-RANGE. IF1234.2 +069600 MOVE -6.99986 TO MAX-RANGE. IF1234.2 +069700 F-MIN-TEST-20. IF1234.2 +069800 COMPUTE WS-NUM = FUNCTION MIN(-7, -9 + 2, (- B)). IF1234.2 +069900 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +070000 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +070100 PERFORM PASS IF1234.2 +070200 ELSE IF1234.2 +070300 MOVE WS-NUM TO COMPUTED-N IF1234.2 +070400 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +070500 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +070600 PERFORM FAIL. IF1234.2 +070700 GO TO F-MIN-WRITE-20. IF1234.2 +070800 F-MIN-DELETE-20. IF1234.2 +070900 PERFORM DE-LETE. IF1234.2 +071000 GO TO F-MIN-WRITE-20. IF1234.2 +071100 F-MIN-WRITE-20. IF1234.2 +071200 MOVE "F-MIN-20" TO PAR-NAME. IF1234.2 +071300 PERFORM PRINT-DETAIL. IF1234.2 +071400*****************TEST (d) - COMPLEX TEST**************** IF1234.2 +071500 F-MIN-21. IF1234.2 +071600 MOVE ZERO TO WS-NUM. IF1234.2 +071700 MOVE 4.99990 TO MIN-RANGE. IF1234.2 +071800 MOVE 5.00010 TO MAX-RANGE. IF1234.2 +071900 F-MIN-TEST-21. IF1234.2 +072000 COMPUTE WS-NUM = FUNCTION MIN(FUNCTION MIN(14, A), E, 50). IF1234.2 +072100 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +072200 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +072300 PERFORM PASS IF1234.2 +072400 ELSE IF1234.2 +072500 MOVE WS-NUM TO COMPUTED-N IF1234.2 +072600 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +072700 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +072800 PERFORM FAIL. IF1234.2 +072900 GO TO F-MIN-WRITE-21. IF1234.2 +073000 F-MIN-DELETE-21. IF1234.2 +073100 PERFORM DE-LETE. IF1234.2 +073200 GO TO F-MIN-WRITE-21. IF1234.2 +073300 F-MIN-WRITE-21. IF1234.2 +073400 MOVE "F-MIN-21" TO PAR-NAME. IF1234.2 +073500 PERFORM PRINT-DETAIL. IF1234.2 +073600*****************TEST (e) - COMPLEX TEST**************** IF1234.2 +073700 F-MIN-22. IF1234.2 +073800 MOVE ZERO TO WS-NUM. IF1234.2 +073900 MOVE 8.99982 TO MIN-RANGE. IF1234.2 +074000 MOVE 9.00018 TO MAX-RANGE. IF1234.2 +074100 F-MIN-TEST-22. IF1234.2 +074200 COMPUTE WS-NUM = FUNCTION MIN(4, B, E) + A. IF1234.2 +074300 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +074400 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +074500 PERFORM PASS IF1234.2 +074600 ELSE IF1234.2 +074700 MOVE WS-NUM TO COMPUTED-N IF1234.2 +074800 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +074900 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +075000 PERFORM FAIL. IF1234.2 +075100 GO TO F-MIN-WRITE-22. IF1234.2 +075200 F-MIN-DELETE-22. IF1234.2 +075300 PERFORM DE-LETE. IF1234.2 +075400 GO TO F-MIN-WRITE-22. IF1234.2 +075500 F-MIN-WRITE-22. IF1234.2 +075600 MOVE "F-MIN-22" TO PAR-NAME. IF1234.2 +075700 PERFORM PRINT-DETAIL. IF1234.2 +075800*****************TEST (f) - COMPLEX TEST**************** IF1234.2 +075900 F-MIN-23. IF1234.2 +076000 MOVE ZERO TO WS-NUM. IF1234.2 +076100 MOVE 4.99990 TO MIN-RANGE. IF1234.2 +076200 MOVE 5.00010 TO MAX-RANGE. IF1234.2 +076300 F-MIN-TEST-23. IF1234.2 +076400 COMPUTE WS-NUM = FUNCTION MIN(A, E) + FUNCTION MIN(B, 0). IF1234.2 +076500 IF (WS-NUM >= MIN-RANGE) AND IF1234.2 +076600 (WS-NUM <= MAX-RANGE) THEN IF1234.2 +076700 PERFORM PASS IF1234.2 +076800 ELSE IF1234.2 +076900 MOVE WS-NUM TO COMPUTED-N IF1234.2 +077000 MOVE MIN-RANGE TO CORRECT-MIN IF1234.2 +077100 MOVE MAX-RANGE TO CORRECT-MAX IF1234.2 +077200 PERFORM FAIL. IF1234.2 +077300 GO TO F-MIN-WRITE-23. IF1234.2 +077400 F-MIN-DELETE-23. IF1234.2 +077500 PERFORM DE-LETE. IF1234.2 +077600 GO TO F-MIN-WRITE-23. IF1234.2 +077700 F-MIN-WRITE-23. IF1234.2 +077800 MOVE "F-MIN-23" TO PAR-NAME. IF1234.2 +077900 PERFORM PRINT-DETAIL. IF1234.2 +078000*****************SPECIAL PERFORM TEST********************** IF1234.2 +078100 F-MIN-24. IF1234.2 +078200 PERFORM F-MIN-TEST-24 IF1234.2 +078300 UNTIL FUNCTION MIN(ARG1, 20) < 10. IF1234.2 +078400 PERFORM PASS. IF1234.2 +078500 GO TO F-MIN-WRITE-24. IF1234.2 +078600 F-MIN-TEST-24. IF1234.2 +078700 COMPUTE ARG1 = ARG1 - 1. IF1234.2 +078800 F-MIN-DELETE-24. IF1234.2 +078900 PERFORM DE-LETE. IF1234.2 +079000 GO TO F-MIN-WRITE-24. IF1234.2 +079100 F-MIN-WRITE-24. IF1234.2 +079200 MOVE "F-MIN-24" TO PAR-NAME. IF1234.2 +079300 PERFORM PRINT-DETAIL. IF1234.2 +079400********************END OF TESTS*************** IF1234.2 +079500 CCVS-EXIT SECTION. IF1234.2 +079600 CCVS-999999. IF1234.2 +079700 GO TO CLOSE-FILES. IF1234.2 diff --git a/tests/cobol85/IF/IF124A.CBL b/tests/cobol85/IF/IF124A.CBL new file mode 100755 index 00000000..fc0599b4 --- /dev/null +++ b/tests/cobol85/IF/IF124A.CBL @@ -0,0 +1,761 @@ +000100 IDENTIFICATION DIVISION. IF1244.2 +000200 PROGRAM-ID. IF1244.2 +000300 IF124A. IF1244.2 +000400 IF1244.2 +000500*********************************************************** IF1244.2 +000600* * IF1244.2 +000700* This program is intended to form part of the CCVS85 * IF1244.2 +000800* COBOL Test Suite. It contains tests for the * IF1244.2 +000900* Intrinsic Function MOD. * IF1244.2 +001000* * IF1244.2 +001100*********************************************************** IF1244.2 +001200 ENVIRONMENT DIVISION. IF1244.2 +001300 CONFIGURATION SECTION. IF1244.2 +001400 SOURCE-COMPUTER. IF1244.2 +001500 Linux. IF1244.2 +001600 OBJECT-COMPUTER. IF1244.2 +001700 Linux. IF1244.2 +001800 INPUT-OUTPUT SECTION. IF1244.2 +001900 FILE-CONTROL. IF1244.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1244.2 +002100 "report.log". IF1244.2 +002200 DATA DIVISION. IF1244.2 +002300 FILE SECTION. IF1244.2 +002400 FD PRINT-FILE. IF1244.2 +002500 01 PRINT-REC PICTURE X(120). IF1244.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1244.2 +002700 WORKING-STORAGE SECTION. IF1244.2 +002800*********************************************************** IF1244.2 +002900* Variables specific to the Intrinsic Function Test IF124A* IF1244.2 +003000*********************************************************** IF1244.2 +003100 01 A PIC S9(10) VALUE 5. IF1244.2 +003200 01 B PIC S9(10) VALUE 7. IF1244.2 +003300 01 C PIC S9(10) VALUE -4. IF1244.2 +003400 01 ARG2 PIC S9(10) VALUE 1. IF1244.2 +003500 01 TEMP PIC S9(10). IF1244.2 +003600 01 WS-NUM PIC S9(5)V9(6). IF1244.2 +003700 01 MIN-RANGE PIC S9(5)V9(7). IF1244.2 +003800 01 MAX-RANGE PIC S9(5)V9(7). IF1244.2 +003900* IF1244.2 +004000*********************************************************** IF1244.2 +004100* IF1244.2 +004200 01 TEST-RESULTS. IF1244.2 +004300 02 FILLER PIC X VALUE SPACE. IF1244.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1244.2 +004500 02 FILLER PIC X VALUE SPACE. IF1244.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1244.2 +004700 02 FILLER PIC X VALUE SPACE. IF1244.2 +004800 02 PAR-NAME. IF1244.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1244.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1244.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1244.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1244.2 +005300 02 RE-MARK PIC X(61). IF1244.2 +005400 01 TEST-COMPUTED. IF1244.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1244.2 +005600 02 FILLER PIC X(17) VALUE IF1244.2 +005700 " COMPUTED=". IF1244.2 +005800 02 COMPUTED-X. IF1244.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1244.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1244.2 +006100 PIC -9(9).9(9). IF1244.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1244.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1244.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1244.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1244.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1244.2 +006700 04 FILLER PIC X. IF1244.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1244.2 +006900 01 TEST-CORRECT. IF1244.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1244.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1244.2 +007200 02 CORRECT-X. IF1244.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1244.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1244.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1244.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1244.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1244.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1244.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1244.2 +008000 04 FILLER PIC X. IF1244.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1244.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1244.2 +008300 01 TEST-CORRECT-MIN. IF1244.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IF1244.2 +008500 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1244.2 +008600 02 CORRECTMI-X. IF1244.2 +008700 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1244.2 +008800 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1244.2 +008900 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1244.2 +009000 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1244.2 +009100 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1244.2 +009200 03 CR-18V0 REDEFINES CORRECTMI-A. IF1244.2 +009300 04 CORRECTMI-18V0 PIC -9(18). IF1244.2 +009400 04 FILLER PIC X. IF1244.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IF1244.2 +009600 03 FILLER PIC X(48) VALUE SPACE. IF1244.2 +009700 01 TEST-CORRECT-MAX. IF1244.2 +009800 02 FILLER PIC X(30) VALUE SPACE. IF1244.2 +009900 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1244.2 +010000 02 CORRECTMA-X. IF1244.2 +010100 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1244.2 +010200 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1244.2 +010300 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1244.2 +010400 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1244.2 +010500 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1244.2 +010600 03 CR-18V0 REDEFINES CORRECTMA-A. IF1244.2 +010700 04 CORRECTMA-18V0 PIC -9(18). IF1244.2 +010800 04 FILLER PIC X. IF1244.2 +010900 03 FILLER PIC X(2) VALUE SPACE. IF1244.2 +011000 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1244.2 +011100 01 CCVS-C-1. IF1244.2 +011200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1244.2 +011300- "SS PARAGRAPH-NAME IF1244.2 +011400- " REMARKS". IF1244.2 +011500 02 FILLER PIC X(20) VALUE SPACE. IF1244.2 +011600 01 CCVS-C-2. IF1244.2 +011700 02 FILLER PIC X VALUE SPACE. IF1244.2 +011800 02 FILLER PIC X(6) VALUE "TESTED". IF1244.2 +011900 02 FILLER PIC X(15) VALUE SPACE. IF1244.2 +012000 02 FILLER PIC X(4) VALUE "FAIL". IF1244.2 +012100 02 FILLER PIC X(94) VALUE SPACE. IF1244.2 +012200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1244.2 +012300 01 REC-CT PIC 99 VALUE ZERO. IF1244.2 +012400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1244.2 +012500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1244.2 +012600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1244.2 +012700 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1244.2 +012800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1244.2 +012900 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1244.2 +013000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1244.2 +013100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1244.2 +013200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1244.2 +013300 01 CCVS-H-1. IF1244.2 +013400 02 FILLER PIC X(39) VALUE SPACES. IF1244.2 +013500 02 FILLER PIC X(42) VALUE IF1244.2 +013600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1244.2 +013700 02 FILLER PIC X(39) VALUE SPACES. IF1244.2 +013800 01 CCVS-H-2A. IF1244.2 +013900 02 FILLER PIC X(40) VALUE SPACE. IF1244.2 +014000 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1244.2 +014100 02 FILLER PIC XXXX VALUE IF1244.2 +014200 "4.2 ". IF1244.2 +014300 02 FILLER PIC X(28) VALUE IF1244.2 +014400 " COPY - NOT FOR DISTRIBUTION". IF1244.2 +014500 02 FILLER PIC X(41) VALUE SPACE. IF1244.2 +014600 IF1244.2 +014700 01 CCVS-H-2B. IF1244.2 +014800 02 FILLER PIC X(15) VALUE IF1244.2 +014900 "TEST RESULT OF ". IF1244.2 +015000 02 TEST-ID PIC X(9). IF1244.2 +015100 02 FILLER PIC X(4) VALUE IF1244.2 +015200 " IN ". IF1244.2 +015300 02 FILLER PIC X(12) VALUE IF1244.2 +015400 " HIGH ". IF1244.2 +015500 02 FILLER PIC X(22) VALUE IF1244.2 +015600 " LEVEL VALIDATION FOR ". IF1244.2 +015700 02 FILLER PIC X(58) VALUE IF1244.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1244.2 +015900 01 CCVS-H-3. IF1244.2 +016000 02 FILLER PIC X(34) VALUE IF1244.2 +016100 " FOR OFFICIAL USE ONLY ". IF1244.2 +016200 02 FILLER PIC X(58) VALUE IF1244.2 +016300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1244.2 +016400 02 FILLER PIC X(28) VALUE IF1244.2 +016500 " COPYRIGHT 1985 ". IF1244.2 +016600 01 CCVS-E-1. IF1244.2 +016700 02 FILLER PIC X(52) VALUE SPACE. IF1244.2 +016800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1244.2 +016900 02 ID-AGAIN PIC X(9). IF1244.2 +017000 02 FILLER PIC X(45) VALUE SPACES. IF1244.2 +017100 01 CCVS-E-2. IF1244.2 +017200 02 FILLER PIC X(31) VALUE SPACE. IF1244.2 +017300 02 FILLER PIC X(21) VALUE SPACE. IF1244.2 +017400 02 CCVS-E-2-2. IF1244.2 +017500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1244.2 +017600 03 FILLER PIC X VALUE SPACE. IF1244.2 +017700 03 ENDER-DESC PIC X(44) VALUE IF1244.2 +017800 "ERRORS ENCOUNTERED". IF1244.2 +017900 01 CCVS-E-3. IF1244.2 +018000 02 FILLER PIC X(22) VALUE IF1244.2 +018100 " FOR OFFICIAL USE ONLY". IF1244.2 +018200 02 FILLER PIC X(12) VALUE SPACE. IF1244.2 +018300 02 FILLER PIC X(58) VALUE IF1244.2 +018400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1244.2 +018500 02 FILLER PIC X(13) VALUE SPACE. IF1244.2 +018600 02 FILLER PIC X(15) VALUE IF1244.2 +018700 " COPYRIGHT 1985". IF1244.2 +018800 01 CCVS-E-4. IF1244.2 +018900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1244.2 +019000 02 FILLER PIC X(4) VALUE " OF ". IF1244.2 +019100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1244.2 +019200 02 FILLER PIC X(40) VALUE IF1244.2 +019300 " TESTS WERE EXECUTED SUCCESSFULLY". IF1244.2 +019400 01 XXINFO. IF1244.2 +019500 02 FILLER PIC X(19) VALUE IF1244.2 +019600 "*** INFORMATION ***". IF1244.2 +019700 02 INFO-TEXT. IF1244.2 +019800 04 FILLER PIC X(8) VALUE SPACE. IF1244.2 +019900 04 XXCOMPUTED PIC X(20). IF1244.2 +020000 04 FILLER PIC X(5) VALUE SPACE. IF1244.2 +020100 04 XXCORRECT PIC X(20). IF1244.2 +020200 02 INF-ANSI-REFERENCE PIC X(48). IF1244.2 +020300 01 HYPHEN-LINE. IF1244.2 +020400 02 FILLER PIC IS X VALUE IS SPACE. IF1244.2 +020500 02 FILLER PIC IS X(65) VALUE IS "************************IF1244.2 +020600- "*****************************************". IF1244.2 +020700 02 FILLER PIC IS X(54) VALUE IS "************************IF1244.2 +020800- "******************************". IF1244.2 +020900 01 CCVS-PGM-ID PIC X(9) VALUE IF1244.2 +021000 "IF124A". IF1244.2 +021100 PROCEDURE DIVISION. IF1244.2 +021200 CCVS1 SECTION. IF1244.2 +021300 OPEN-FILES. IF1244.2 +021400 OPEN OUTPUT PRINT-FILE. IF1244.2 +021500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1244.2 +021600 MOVE SPACE TO TEST-RESULTS. IF1244.2 +021700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1244.2 +021800 GO TO CCVS1-EXIT. IF1244.2 +021900 CLOSE-FILES. IF1244.2 +022000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1244.2 +022100 TERMINATE-CCVS. IF1244.2 +022200 STOP RUN. IF1244.2 +022300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1244.2 +022400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1244.2 +022500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1244.2 +022600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1244.2 +022700 MOVE "****TEST DELETED****" TO RE-MARK. IF1244.2 +022800 PRINT-DETAIL. IF1244.2 +022900 IF REC-CT NOT EQUAL TO ZERO IF1244.2 +023000 MOVE "." TO PARDOT-X IF1244.2 +023100 MOVE REC-CT TO DOTVALUE. IF1244.2 +023200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1244.2 +023300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1244.2 +023400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1244.2 +023500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1244.2 +023600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1244.2 +023700 MOVE SPACE TO CORRECT-X. IF1244.2 +023800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1244.2 +023900 MOVE SPACE TO RE-MARK. IF1244.2 +024000 HEAD-ROUTINE. IF1244.2 +024100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +024200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +024300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1244.2 +024400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1244.2 +024500 COLUMN-NAMES-ROUTINE. IF1244.2 +024600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +024700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +024900 END-ROUTINE. IF1244.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1244.2 +025100 END-RTN-EXIT. IF1244.2 +025200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +025300 END-ROUTINE-1. IF1244.2 +025400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1244.2 +025500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1244.2 +025600 ADD PASS-COUNTER TO ERROR-HOLD. IF1244.2 +025700 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1244.2 +025800 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1244.2 +025900 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1244.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1244.2 +026100 END-ROUTINE-12. IF1244.2 +026200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1244.2 +026300 IF ERROR-COUNTER IS EQUAL TO ZERO IF1244.2 +026400 MOVE "NO " TO ERROR-TOTAL IF1244.2 +026500 ELSE IF1244.2 +026600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1244.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1244.2 +026800 PERFORM WRITE-LINE. IF1244.2 +026900 END-ROUTINE-13. IF1244.2 +027000 IF DELETE-COUNTER IS EQUAL TO ZERO IF1244.2 +027100 MOVE "NO " TO ERROR-TOTAL ELSE IF1244.2 +027200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1244.2 +027300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1244.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +027500 IF INSPECT-COUNTER EQUAL TO ZERO IF1244.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1244.2 +027700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1244.2 +027800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1244.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +028000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1244.2 +028100 WRITE-LINE. IF1244.2 +028200 ADD 1 TO RECORD-COUNT. IF1244.2 +028300 IF RECORD-COUNT GREATER 42 IF1244.2 +028400 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1244.2 +028500 MOVE SPACE TO DUMMY-RECORD IF1244.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1244.2 +028700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1244.2 +028800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1244.2 +028900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1244.2 +029000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1244.2 +029100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1244.2 +029200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1244.2 +029300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1244.2 +029400 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1244.2 +029500 MOVE ZERO TO RECORD-COUNT. IF1244.2 +029600 PERFORM WRT-LN. IF1244.2 +029700 WRT-LN. IF1244.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1244.2 +029900 MOVE SPACE TO DUMMY-RECORD. IF1244.2 +030000 BLANK-LINE-PRINT. IF1244.2 +030100 PERFORM WRT-LN. IF1244.2 +030200 FAIL-ROUTINE. IF1244.2 +030300 IF COMPUTED-X NOT EQUAL TO SPACE IF1244.2 +030400 GO TO FAIL-ROUTINE-WRITE. IF1244.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1244.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1244.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1244.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1244.2 +031000 GO TO FAIL-ROUTINE-EX. IF1244.2 +031100 FAIL-ROUTINE-WRITE. IF1244.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1244.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1244.2 +031400 CORMA-ANSI-REFERENCE. IF1244.2 +031500 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1244.2 +031600 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1244.2 +031700 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1244.2 +031800 ELSE IF1244.2 +031900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1244.2 +032000 PERFORM WRITE-LINE. IF1244.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1244.2 +032200 FAIL-ROUTINE-EX. EXIT. IF1244.2 +032300 BAIL-OUT. IF1244.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1244.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1244.2 +032600 BAIL-OUT-WRITE. IF1244.2 +032700 MOVE CORRECT-A TO XXCORRECT. IF1244.2 +032800 MOVE COMPUTED-A TO XXCOMPUTED. IF1244.2 +032900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1244.2 +033000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1244.2 +033100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1244.2 +033200 BAIL-OUT-EX. EXIT. IF1244.2 +033300 CCVS1-EXIT. IF1244.2 +033400 EXIT. IF1244.2 +033500******************************************************** IF1244.2 +033600* * IF1244.2 +033700* Intrinsic Function Tests IF124A - MOD * IF1244.2 +033800* * IF1244.2 +033900******************************************************** IF1244.2 +034000 SECT-IF124A SECTION. IF1244.2 +034100 F-MOD-INFO. IF1244.2 +034200 MOVE "See ref. A-58 2.28" TO ANSI-REFERENCE. IF1244.2 +034300 MOVE "MOD Function" TO FEATURE. IF1244.2 +034400*****************TEST (a) - SIMPLE TEST***************** IF1244.2 +034500 F-MOD-01. IF1244.2 +034600 MOVE ZERO TO WS-NUM. IF1244.2 +034700 F-MOD-TEST-01. IF1244.2 +034800 COMPUTE WS-NUM = FUNCTION MOD(6, 6). IF1244.2 +034900 IF WS-NUM = 0 THEN IF1244.2 +035000 PERFORM PASS IF1244.2 +035100 ELSE IF1244.2 +035200 MOVE WS-NUM TO COMPUTED-N IF1244.2 +035300 MOVE 0 TO CORRECT-N IF1244.2 +035400 PERFORM FAIL. IF1244.2 +035500 GO TO F-MOD-WRITE-01. IF1244.2 +035600 F-MOD-DELETE-01. IF1244.2 +035700 PERFORM DE-LETE. IF1244.2 +035800 GO TO F-MOD-WRITE-01. IF1244.2 +035900 F-MOD-WRITE-01. IF1244.2 +036000 MOVE "F-MOD-01" TO PAR-NAME. IF1244.2 +036100 PERFORM PRINT-DETAIL. IF1244.2 +036200*****************TEST (b) - SIMPLE TEST***************** IF1244.2 +036300 F-MOD-02. IF1244.2 +036400 EVALUATE FUNCTION MOD(11, 5) IF1244.2 +036500 WHEN 1 IF1244.2 +036600 PERFORM PASS IF1244.2 +036700 WHEN OTHER IF1244.2 +036800 PERFORM FAIL. IF1244.2 +036900 GO TO F-MOD-WRITE-02. IF1244.2 +037000 F-MOD-DELETE-02. IF1244.2 +037100 PERFORM DE-LETE. IF1244.2 +037200 GO TO F-MOD-WRITE-02. IF1244.2 +037300 F-MOD-WRITE-02. IF1244.2 +037400 MOVE "F-MOD-02" TO PAR-NAME. IF1244.2 +037500 PERFORM PRINT-DETAIL. IF1244.2 +037600*****************TEST (c) - SIMPLE TEST***************** IF1244.2 +037700 F-MOD-03. IF1244.2 +037800 IF FUNCTION MOD(10, 20) = 10 THEN IF1244.2 +037900 PERFORM PASS IF1244.2 +038000 ELSE IF1244.2 +038100 PERFORM FAIL. IF1244.2 +038200 GO TO F-MOD-WRITE-03. IF1244.2 +038300 F-MOD-DELETE-03. IF1244.2 +038400 PERFORM DE-LETE. IF1244.2 +038500 GO TO F-MOD-WRITE-03. IF1244.2 +038600 F-MOD-WRITE-03. IF1244.2 +038700 MOVE "F-MOD-03" TO PAR-NAME. IF1244.2 +038800 PERFORM PRINT-DETAIL. IF1244.2 +038900*****************TEST (d) - SIMPLE TEST***************** IF1244.2 +039000 F-MOD-04. IF1244.2 +039100 MOVE ZERO TO WS-NUM. IF1244.2 +039200 F-MOD-TEST-04. IF1244.2 +039300 COMPUTE WS-NUM = FUNCTION MOD(A, B). IF1244.2 +039400 IF WS-NUM = 5 THEN IF1244.2 +039500 PERFORM PASS IF1244.2 +039600 ELSE IF1244.2 +039700 MOVE WS-NUM TO COMPUTED-N IF1244.2 +039800 MOVE 5 TO CORRECT-N IF1244.2 +039900 PERFORM FAIL. IF1244.2 +040000 GO TO F-MOD-WRITE-04. IF1244.2 +040100 F-MOD-DELETE-04. IF1244.2 +040200 PERFORM DE-LETE. IF1244.2 +040300 GO TO F-MOD-WRITE-04. IF1244.2 +040400 F-MOD-WRITE-04. IF1244.2 +040500 MOVE "F-MOD-04" TO PAR-NAME. IF1244.2 +040600 PERFORM PRINT-DETAIL. IF1244.2 +040700*****************TEST (e) - SIMPLE TEST***************** IF1244.2 +040800 F-MOD-05. IF1244.2 +040900 MOVE ZERO TO WS-NUM. IF1244.2 +041000 F-MOD-TEST-05. IF1244.2 +041100 COMPUTE WS-NUM = FUNCTION MOD(A, -3). IF1244.2 +041200 IF WS-NUM = -1 THEN IF1244.2 +041300 PERFORM PASS IF1244.2 +041400 ELSE IF1244.2 +041500 MOVE WS-NUM TO COMPUTED-N IF1244.2 +041600 MOVE -1 TO CORRECT-N IF1244.2 +041700 PERFORM FAIL. IF1244.2 +041800 GO TO F-MOD-WRITE-05. IF1244.2 +041900 F-MOD-DELETE-05. IF1244.2 +042000 PERFORM DE-LETE. IF1244.2 +042100 GO TO F-MOD-WRITE-05. IF1244.2 +042200 F-MOD-WRITE-05. IF1244.2 +042300 MOVE "F-MOD-05" TO PAR-NAME. IF1244.2 +042400 PERFORM PRINT-DETAIL. IF1244.2 +042500*****************TEST (f) - SIMPLE TEST***************** IF1244.2 +042600 F-MOD-06. IF1244.2 +042700 MOVE ZERO TO WS-NUM. IF1244.2 +042800 F-MOD-TEST-06. IF1244.2 +042900 COMPUTE WS-NUM = FUNCTION MOD(23, B). IF1244.2 +043000 IF WS-NUM = 2 THEN IF1244.2 +043100 PERFORM PASS IF1244.2 +043200 ELSE IF1244.2 +043300 MOVE WS-NUM TO COMPUTED-N IF1244.2 +043400 MOVE 2 TO CORRECT-N IF1244.2 +043500 PERFORM FAIL. IF1244.2 +043600 GO TO F-MOD-WRITE-06. IF1244.2 +043700 F-MOD-DELETE-06. IF1244.2 +043800 PERFORM DE-LETE. IF1244.2 +043900 GO TO F-MOD-WRITE-06. IF1244.2 +044000 F-MOD-WRITE-06. IF1244.2 +044100 MOVE "F-MOD-06" TO PAR-NAME. IF1244.2 +044200 PERFORM PRINT-DETAIL. IF1244.2 +044300*****************TEST (g) - SIMPLE TEST***************** IF1244.2 +044400 F-MOD-07. IF1244.2 +044500 MOVE ZERO TO WS-NUM. IF1244.2 +044600 F-MOD-TEST-07. IF1244.2 +044700 COMPUTE WS-NUM = FUNCTION MOD(-11, -5). IF1244.2 +044800 IF WS-NUM = -1 THEN IF1244.2 +044900 PERFORM PASS IF1244.2 +045000 ELSE IF1244.2 +045100 MOVE WS-NUM TO COMPUTED-N IF1244.2 +045200 MOVE -1 TO CORRECT-N IF1244.2 +045300 PERFORM FAIL. IF1244.2 +045400 GO TO F-MOD-WRITE-07. IF1244.2 +045500 F-MOD-DELETE-07. IF1244.2 +045600 PERFORM DE-LETE. IF1244.2 +045700 GO TO F-MOD-WRITE-07. IF1244.2 +045800 F-MOD-WRITE-07. IF1244.2 +045900 MOVE "F-MOD-07" TO PAR-NAME. IF1244.2 +046000 PERFORM PRINT-DETAIL. IF1244.2 +046100*****************TEST (h) - SIMPLE TEST***************** IF1244.2 +046200 F-MOD-08. IF1244.2 +046300 MOVE ZERO TO WS-NUM. IF1244.2 +046400 F-MOD-TEST-08. IF1244.2 +046500 COMPUTE WS-NUM = FUNCTION MOD(11, -5). IF1244.2 +046600 IF WS-NUM = -4 THEN IF1244.2 +046700 PERFORM PASS IF1244.2 +046800 ELSE IF1244.2 +046900 MOVE WS-NUM TO COMPUTED-N IF1244.2 +047000 MOVE -4 TO CORRECT-N IF1244.2 +047100 PERFORM FAIL. IF1244.2 +047200 GO TO F-MOD-WRITE-08. IF1244.2 +047300 F-MOD-DELETE-08. IF1244.2 +047400 PERFORM DE-LETE. IF1244.2 +047500 GO TO F-MOD-WRITE-08. IF1244.2 +047600 F-MOD-WRITE-08. IF1244.2 +047700 MOVE "F-MOD-08" TO PAR-NAME. IF1244.2 +047800 PERFORM PRINT-DETAIL. IF1244.2 +047900*****************TEST (i) - SIMPLE TEST***************** IF1244.2 +048000 F-MOD-09. IF1244.2 +048100 MOVE ZERO TO WS-NUM. IF1244.2 +048200 F-MOD-TEST-09. IF1244.2 +048300 COMPUTE WS-NUM = FUNCTION MOD(-11, 5). IF1244.2 +048400 IF WS-NUM = 4 THEN IF1244.2 +048500 PERFORM PASS IF1244.2 +048600 ELSE IF1244.2 +048700 MOVE WS-NUM TO COMPUTED-N IF1244.2 +048800 MOVE 4 TO CORRECT-N IF1244.2 +048900 PERFORM FAIL. IF1244.2 +049000 GO TO F-MOD-WRITE-09. IF1244.2 +049100 F-MOD-DELETE-09. IF1244.2 +049200 PERFORM DE-LETE. IF1244.2 +049300 GO TO F-MOD-WRITE-09. IF1244.2 +049400 F-MOD-WRITE-09. IF1244.2 +049500 MOVE "F-MOD-09" TO PAR-NAME. IF1244.2 +049600 PERFORM PRINT-DETAIL. IF1244.2 +049700*****************TEST (a) - COMPLEX TEST**************** IF1244.2 +049800 F-MOD-11. IF1244.2 +049900 MOVE ZERO TO WS-NUM. IF1244.2 +050000 MOVE -0.000020 TO MIN-RANGE. IF1244.2 +050100 MOVE 0.000020 TO MAX-RANGE. IF1244.2 +050200 F-MOD-TEST-11. IF1244.2 +050300 COMPUTE WS-NUM = FUNCTION MOD(35, FUNCTION INTEGER(A * B)). IF1244.2 +050400 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +050500 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +050600 PERFORM PASS IF1244.2 +050700 ELSE IF1244.2 +050800 MOVE WS-NUM TO COMPUTED-N IF1244.2 +050900 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +051000 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +051100 PERFORM FAIL. IF1244.2 +051200 GO TO F-MOD-WRITE-11. IF1244.2 +051300 F-MOD-DELETE-11. IF1244.2 +051400 PERFORM DE-LETE. IF1244.2 +051500 GO TO F-MOD-WRITE-11. IF1244.2 +051600 F-MOD-WRITE-11. IF1244.2 +051700 MOVE "F-MOD-11" TO PAR-NAME. IF1244.2 +051800 PERFORM PRINT-DETAIL. IF1244.2 +051900*****************TEST (b) - COMPLEX TEST**************** IF1244.2 +052000 F-MOD-12. IF1244.2 +052100 MOVE ZERO TO WS-NUM. IF1244.2 +052200 MOVE 0.999980 TO MIN-RANGE. IF1244.2 +052300 MOVE 1.00002 TO MAX-RANGE. IF1244.2 +052400 F-MOD-TEST-12. IF1244.2 +052500 COMPUTE WS-NUM = FUNCTION MOD(A, FUNCTION INTEGER(B - 5)). IF1244.2 +052600 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +052700 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +052800 PERFORM PASS IF1244.2 +052900 ELSE IF1244.2 +053000 MOVE WS-NUM TO COMPUTED-N IF1244.2 +053100 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +053200 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +053300 PERFORM FAIL. IF1244.2 +053400 GO TO F-MOD-WRITE-12. IF1244.2 +053500 F-MOD-DELETE-12. IF1244.2 +053600 PERFORM DE-LETE. IF1244.2 +053700 GO TO F-MOD-WRITE-12. IF1244.2 +053800 F-MOD-WRITE-12. IF1244.2 +053900 MOVE "F-MOD-12" TO PAR-NAME. IF1244.2 +054000 PERFORM PRINT-DETAIL. IF1244.2 +054100*****************TEST (c) - COMPLEX TEST**************** IF1244.2 +054200 F-MOD-13. IF1244.2 +054300 MOVE ZERO TO WS-NUM. IF1244.2 +054400 MOVE 6.99986 TO MIN-RANGE. IF1244.2 +054500 MOVE 7.00014 TO MAX-RANGE. IF1244.2 +054600 F-MOD-TEST-13. IF1244.2 +054700 COMPUTE WS-NUM = FUNCTION MOD(FUNCTION INTEGER(A - B), 9). IF1244.2 +054800 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +054900 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +055000 PERFORM PASS IF1244.2 +055100 ELSE IF1244.2 +055200 MOVE WS-NUM TO COMPUTED-N IF1244.2 +055300 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +055400 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +055500 PERFORM FAIL. IF1244.2 +055600 GO TO F-MOD-WRITE-13. IF1244.2 +055700 F-MOD-DELETE-13. IF1244.2 +055800 PERFORM DE-LETE. IF1244.2 +055900 GO TO F-MOD-WRITE-13. IF1244.2 +056000 F-MOD-WRITE-13. IF1244.2 +056100 MOVE "F-MOD-13" TO PAR-NAME. IF1244.2 +056200 PERFORM PRINT-DETAIL. IF1244.2 +056300*****************TEST (d) - COMPLEX TEST**************** IF1244.2 +056400 F-MOD-14. IF1244.2 +056500 MOVE ZERO TO WS-NUM. IF1244.2 +056600 MOVE -2.00004 TO MIN-RANGE. IF1244.2 +056700 MOVE -1.99996 TO MAX-RANGE. IF1244.2 +056800 F-MOD-TEST-14. IF1244.2 +056900 COMPUTE WS-NUM = FUNCTION MOD( IF1244.2 +057000 FUNCTION INTEGER((A + B) / -2), -4). IF1244.2 +057100 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +057200 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +057300 PERFORM PASS IF1244.2 +057400 ELSE IF1244.2 +057500 MOVE WS-NUM TO COMPUTED-N IF1244.2 +057600 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +057700 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +057800 PERFORM FAIL. IF1244.2 +057900 GO TO F-MOD-WRITE-14. IF1244.2 +058000 F-MOD-DELETE-14. IF1244.2 +058100 PERFORM DE-LETE. IF1244.2 +058200 GO TO F-MOD-WRITE-14. IF1244.2 +058300 F-MOD-WRITE-14. IF1244.2 +058400 MOVE "F-MOD-14" TO PAR-NAME. IF1244.2 +058500 PERFORM PRINT-DETAIL. IF1244.2 +058600*****************TEST (e) - COMPLEX TEST**************** IF1244.2 +058700 F-MOD-15. IF1244.2 +058800 MOVE ZERO TO WS-NUM. IF1244.2 +058900 MOVE 0.999980 TO MIN-RANGE. IF1244.2 +059000 MOVE 1.00002 TO MAX-RANGE. IF1244.2 +059100 F-MOD-TEST-15. IF1244.2 +059200 COMPUTE WS-NUM = FUNCTION MOD(FUNCTION INTEGER(A * B), IF1244.2 +059300 FUNCTION INTEGER(B - A)). IF1244.2 +059400 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +059500 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +059600 PERFORM PASS IF1244.2 +059700 ELSE IF1244.2 +059800 MOVE WS-NUM TO COMPUTED-N IF1244.2 +059900 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +060000 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +060100 PERFORM FAIL. IF1244.2 +060200 GO TO F-MOD-WRITE-15. IF1244.2 +060300 F-MOD-DELETE-15. IF1244.2 +060400 PERFORM DE-LETE. IF1244.2 +060500 GO TO F-MOD-WRITE-15. IF1244.2 +060600 F-MOD-WRITE-15. IF1244.2 +060700 MOVE "F-MOD-15" TO PAR-NAME. IF1244.2 +060800 PERFORM PRINT-DETAIL. IF1244.2 +060900*****************TEST (f) - COMPLEX TEST**************** IF1244.2 +061000 F-MOD-16. IF1244.2 +061100 MOVE ZERO TO WS-NUM. IF1244.2 +061200 MOVE 1.99996 TO MIN-RANGE. IF1244.2 +061300 MOVE 2.00004 TO MAX-RANGE. IF1244.2 +061400 F-MOD-TEST-16. IF1244.2 +061500 COMPUTE WS-NUM = FUNCTION MOD( IF1244.2 +061600 FUNCTION MOD(B, A), A). IF1244.2 +061700 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +061800 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +061900 PERFORM PASS IF1244.2 +062000 ELSE IF1244.2 +062100 MOVE WS-NUM TO COMPUTED-N IF1244.2 +062200 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +062300 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +062400 PERFORM FAIL. IF1244.2 +062500 GO TO F-MOD-WRITE-16. IF1244.2 +062600 F-MOD-DELETE-16. IF1244.2 +062700 PERFORM DE-LETE. IF1244.2 +062800 GO TO F-MOD-WRITE-16. IF1244.2 +062900 F-MOD-WRITE-16. IF1244.2 +063000 MOVE "F-MOD-16" TO PAR-NAME. IF1244.2 +063100 PERFORM PRINT-DETAIL. IF1244.2 +063200*****************TEST (g) - COMPLEX TEST**************** IF1244.2 +063300 F-MOD-17. IF1244.2 +063400 MOVE ZERO TO WS-NUM. IF1244.2 +063500 MOVE 1.99996 TO MIN-RANGE. IF1244.2 +063600 MOVE 2.00004 TO MAX-RANGE. IF1244.2 +063700 F-MOD-TEST-17. IF1244.2 +063800 COMPUTE WS-NUM = FUNCTION MOD(C, FUNCTION MOD(C, B)). IF1244.2 +063900 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +064000 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +064100 PERFORM PASS IF1244.2 +064200 ELSE IF1244.2 +064300 MOVE WS-NUM TO COMPUTED-N IF1244.2 +064400 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +064500 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +064600 PERFORM FAIL. IF1244.2 +064700 GO TO F-MOD-WRITE-17. IF1244.2 +064800 F-MOD-DELETE-17. IF1244.2 +064900 PERFORM DE-LETE. IF1244.2 +065000 GO TO F-MOD-WRITE-17. IF1244.2 +065100 F-MOD-WRITE-17. IF1244.2 +065200 MOVE "F-MOD-17" TO PAR-NAME. IF1244.2 +065300 PERFORM PRINT-DETAIL. IF1244.2 +065400*****************TEST (h) - COMPLEX TEST**************** IF1244.2 +065500 F-MOD-18. IF1244.2 +065600 MOVE ZERO TO WS-NUM. IF1244.2 +065700 MOVE 0.999980 TO MIN-RANGE. IF1244.2 +065800 MOVE 1.00002 TO MAX-RANGE. IF1244.2 +065900 F-MOD-TEST-18. IF1244.2 +066000 COMPUTE WS-NUM = FUNCTION MOD(FUNCTION MOD(9, 5), IF1244.2 +066100 FUNCTION MOD(B, 4)). IF1244.2 +066200 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +066300 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +066400 PERFORM PASS IF1244.2 +066500 ELSE IF1244.2 +066600 MOVE WS-NUM TO COMPUTED-N IF1244.2 +066700 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +066800 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +066900 PERFORM FAIL. IF1244.2 +067000 GO TO F-MOD-WRITE-18. IF1244.2 +067100 F-MOD-DELETE-18. IF1244.2 +067200 PERFORM DE-LETE. IF1244.2 +067300 GO TO F-MOD-WRITE-18. IF1244.2 +067400 F-MOD-WRITE-18. IF1244.2 +067500 MOVE "F-MOD-18" TO PAR-NAME. IF1244.2 +067600 PERFORM PRINT-DETAIL. IF1244.2 +067700*****************TEST (i) - COMPLEX TEST**************** IF1244.2 +067800 F-MOD-19. IF1244.2 +067900 MOVE ZERO TO WS-NUM. IF1244.2 +068000 MOVE 6.99986 TO MIN-RANGE. IF1244.2 +068100 MOVE 7.00014 TO MAX-RANGE. IF1244.2 +068200 F-MOD-TEST-19. IF1244.2 +068300 COMPUTE WS-NUM = FUNCTION MOD(23, B) + A. IF1244.2 +068400 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +068500 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +068600 PERFORM PASS IF1244.2 +068700 ELSE IF1244.2 +068800 MOVE WS-NUM TO COMPUTED-N IF1244.2 +068900 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +069000 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +069100 PERFORM FAIL. IF1244.2 +069200 GO TO F-MOD-WRITE-19. IF1244.2 +069300 F-MOD-DELETE-19. IF1244.2 +069400 PERFORM DE-LETE. IF1244.2 +069500 GO TO F-MOD-WRITE-19. IF1244.2 +069600 F-MOD-WRITE-19. IF1244.2 +069700 MOVE "F-MOD-19" TO PAR-NAME. IF1244.2 +069800 PERFORM PRINT-DETAIL. IF1244.2 +069900*****************TEST (j) - COMPLEX TEST**************** IF1244.2 +070000 F-MOD-20. IF1244.2 +070100 MOVE ZERO TO WS-NUM. IF1244.2 +070200 MOVE -0.000020 TO MIN-RANGE. IF1244.2 +070300 MOVE 0.000020 TO MAX-RANGE. IF1244.2 +070400 F-MOD-TEST-20. IF1244.2 +070500 COMPUTE WS-NUM = FUNCTION MOD(FUNCTION MOD(5, 2), 1). IF1244.2 +070600 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +070700 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +070800 PERFORM PASS IF1244.2 +070900 ELSE IF1244.2 +071000 MOVE WS-NUM TO COMPUTED-N IF1244.2 +071100 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +071200 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +071300 PERFORM FAIL. IF1244.2 +071400 GO TO F-MOD-WRITE-20. IF1244.2 +071500 F-MOD-DELETE-20. IF1244.2 +071600 PERFORM DE-LETE. IF1244.2 +071700 GO TO F-MOD-WRITE-20. IF1244.2 +071800 F-MOD-WRITE-20. IF1244.2 +071900 MOVE "F-MOD-20" TO PAR-NAME. IF1244.2 +072000 PERFORM PRINT-DETAIL. IF1244.2 +072100*****************TEST (k) - COMPLEX TEST**************** IF1244.2 +072200 F-MOD-21. IF1244.2 +072300 MOVE ZERO TO WS-NUM. IF1244.2 +072400 MOVE 0.999980 TO MIN-RANGE. IF1244.2 +072500 MOVE 1.00002 TO MAX-RANGE. IF1244.2 +072600 F-MOD-TEST-21. IF1244.2 +072700 COMPUTE WS-NUM = FUNCTION MOD(25, C) + IF1244.2 +072800 FUNCTION MOD(-11, 5). IF1244.2 +072900 IF (WS-NUM >= MIN-RANGE) AND IF1244.2 +073000 (WS-NUM <= MAX-RANGE) THEN IF1244.2 +073100 PERFORM PASS IF1244.2 +073200 ELSE IF1244.2 +073300 MOVE WS-NUM TO COMPUTED-N IF1244.2 +073400 MOVE MIN-RANGE TO CORRECT-MIN IF1244.2 +073500 MOVE MAX-RANGE TO CORRECT-MAX IF1244.2 +073600 PERFORM FAIL. IF1244.2 +073700 GO TO F-MOD-WRITE-21. IF1244.2 +073800 F-MOD-DELETE-21. IF1244.2 +073900 PERFORM DE-LETE. IF1244.2 +074000 GO TO F-MOD-WRITE-21. IF1244.2 +074100 F-MOD-WRITE-21. IF1244.2 +074200 MOVE "F-MOD-21" TO PAR-NAME. IF1244.2 +074300 PERFORM PRINT-DETAIL. IF1244.2 +074400*****************SPECIAL PERFORM TEST********************** IF1244.2 +074500 F-MOD-22. IF1244.2 +074600 PERFORM F-MOD-TEST-22 IF1244.2 +074700 UNTIL FUNCTION MOD(5, ARG2) >= 2. IF1244.2 +074800 PERFORM PASS. IF1244.2 +074900 GO TO F-MOD-WRITE-22. IF1244.2 +075000 F-MOD-TEST-22. IF1244.2 +075100 COMPUTE ARG2 = ARG2 + 1. IF1244.2 +075200 F-MOD-DELETE-22. IF1244.2 +075300 PERFORM DE-LETE. IF1244.2 +075400 GO TO F-MOD-WRITE-22. IF1244.2 +075500 F-MOD-WRITE-22. IF1244.2 +075600 MOVE "F-MOD-22" TO PAR-NAME. IF1244.2 +075700 PERFORM PRINT-DETAIL. IF1244.2 +075800********************END OF TESTS*************** IF1244.2 +075900 CCVS-EXIT SECTION. IF1244.2 +076000 CCVS-999999. IF1244.2 +076100 GO TO CLOSE-FILES. IF1244.2 diff --git a/tests/cobol85/IF/IF125A.CBL b/tests/cobol85/IF/IF125A.CBL new file mode 100755 index 00000000..5451c3c8 --- /dev/null +++ b/tests/cobol85/IF/IF125A.CBL @@ -0,0 +1,686 @@ +000100 IDENTIFICATION DIVISION. IF1254.2 +000200 PROGRAM-ID. IF1254.2 +000300 IF125A. IF1254.2 +000400 IF1254.2 +000500*********************************************************** IF1254.2 +000600* * IF1254.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1254.2 +000800* It contains tests for the Intrinsic Function NUMVAL. * IF1254.2 +000900* * IF1254.2 +001000* * IF1254.2 +001100*********************************************************** IF1254.2 +001200 ENVIRONMENT DIVISION. IF1254.2 +001300 CONFIGURATION SECTION. IF1254.2 +001400 SOURCE-COMPUTER. IF1254.2 +001500 Linux. IF1254.2 +001600 OBJECT-COMPUTER. IF1254.2 +001700 Linux. IF1254.2 +001800 INPUT-OUTPUT SECTION. IF1254.2 +001900 FILE-CONTROL. IF1254.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1254.2 +002100 "report.log". IF1254.2 +002200 DATA DIVISION. IF1254.2 +002300 FILE SECTION. IF1254.2 +002400 FD PRINT-FILE. IF1254.2 +002500 01 PRINT-REC PICTURE X(120). IF1254.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1254.2 +002700 WORKING-STORAGE SECTION. IF1254.2 +002800*********************************************************** IF1254.2 +002900* Variables specific to the Intrinsic Function Test IF125A* IF1254.2 +003000*********************************************************** IF1254.2 +003100 01 A PIC X(1) VALUE "4". IF1254.2 +003200 01 B PIC X(5) VALUE "203". IF1254.2 +003300 01 C PIC X(4) VALUE ".429". IF1254.2 +003400 01 D PIC X(7) VALUE "928.344". IF1254.2 +003500 01 E PIC X(9) VALUE "-042.3240". IF1254.2 +003600 01 F PIC X(7) VALUE " 23.000". IF1254.2 +003700 01 G PIC X(8) VALUE "-92924.3". IF1254.2 +003800 01 H PIC X(6) VALUE "93.21+". IF1254.2 +003900 01 I PIC X(9) VALUE " 92.92 -". IF1254.2 +004000 01 TEMP PIC S9(5)V9(5). IF1254.2 +004100 IF1254.2 +004200* IF1254.2 +004300********************************************************** IF1254.2 +004400* IF1254.2 +004500 01 TEST-RESULTS. IF1254.2 +004600 02 FILLER PIC X VALUE SPACE. IF1254.2 +004700 02 FEATURE PIC X(20) VALUE SPACE. IF1254.2 +004800 02 FILLER PIC X VALUE SPACE. IF1254.2 +004900 02 P-OR-F PIC X(5) VALUE SPACE. IF1254.2 +005000 02 FILLER PIC X VALUE SPACE. IF1254.2 +005100 02 PAR-NAME. IF1254.2 +005200 03 FILLER PIC X(19) VALUE SPACE. IF1254.2 +005300 03 PARDOT-X PIC X VALUE SPACE. IF1254.2 +005400 03 DOTVALUE PIC 99 VALUE ZERO. IF1254.2 +005500 02 FILLER PIC X(8) VALUE SPACE. IF1254.2 +005600 02 RE-MARK PIC X(61). IF1254.2 +005700 01 TEST-COMPUTED. IF1254.2 +005800 02 FILLER PIC X(30) VALUE SPACE. IF1254.2 +005900 02 FILLER PIC X(17) VALUE IF1254.2 +006000 " COMPUTED=". IF1254.2 +006100 02 COMPUTED-X. IF1254.2 +006200 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1254.2 +006300 03 COMPUTED-N REDEFINES COMPUTED-A IF1254.2 +006400 PIC -9(9).9(9). IF1254.2 +006500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1254.2 +006600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1254.2 +006700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1254.2 +006800 03 CM-18V0 REDEFINES COMPUTED-A. IF1254.2 +006900 04 COMPUTED-18V0 PIC -9(18). IF1254.2 +007000 04 FILLER PIC X. IF1254.2 +007100 03 FILLER PIC X(50) VALUE SPACE. IF1254.2 +007200 01 TEST-CORRECT. IF1254.2 +007300 02 FILLER PIC X(30) VALUE SPACE. IF1254.2 +007400 02 FILLER PIC X(17) VALUE " CORRECT =". IF1254.2 +007500 02 CORRECT-X. IF1254.2 +007600 03 CORRECT-A PIC X(20) VALUE SPACE. IF1254.2 +007700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1254.2 +007800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1254.2 +007900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1254.2 +008000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1254.2 +008100 03 CR-18V0 REDEFINES CORRECT-A. IF1254.2 +008200 04 CORRECT-18V0 PIC -9(18). IF1254.2 +008300 04 FILLER PIC X. IF1254.2 +008400 03 FILLER PIC X(2) VALUE SPACE. IF1254.2 +008500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1254.2 +008600 01 CCVS-C-1. IF1254.2 +008700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1254.2 +008800- "SS PARAGRAPH-NAME IF1254.2 +008900- " REMARKS". IF1254.2 +009000 02 FILLER PIC X(20) VALUE SPACE. IF1254.2 +009100 01 CCVS-C-2. IF1254.2 +009200 02 FILLER PIC X VALUE SPACE. IF1254.2 +009300 02 FILLER PIC X(6) VALUE "TESTED". IF1254.2 +009400 02 FILLER PIC X(15) VALUE SPACE. IF1254.2 +009500 02 FILLER PIC X(4) VALUE "FAIL". IF1254.2 +009600 02 FILLER PIC X(94) VALUE SPACE. IF1254.2 +009700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1254.2 +009800 01 REC-CT PIC 99 VALUE ZERO. IF1254.2 +009900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1254.2 +010000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1254.2 +010100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1254.2 +010200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1254.2 +010300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1254.2 +010400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1254.2 +010500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1254.2 +010600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1254.2 +010700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1254.2 +010800 01 CCVS-H-1. IF1254.2 +010900 02 FILLER PIC X(39) VALUE SPACES. IF1254.2 +011000 02 FILLER PIC X(42) VALUE IF1254.2 +011100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1254.2 +011200 02 FILLER PIC X(39) VALUE SPACES. IF1254.2 +011300 01 CCVS-H-2A. IF1254.2 +011400 02 FILLER PIC X(40) VALUE SPACE. IF1254.2 +011500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1254.2 +011600 02 FILLER PIC XXXX VALUE IF1254.2 +011700 "4.2 ". IF1254.2 +011800 02 FILLER PIC X(28) VALUE IF1254.2 +011900 " COPY - NOT FOR DISTRIBUTION". IF1254.2 +012000 02 FILLER PIC X(41) VALUE SPACE. IF1254.2 +012100 IF1254.2 +012200 01 CCVS-H-2B. IF1254.2 +012300 02 FILLER PIC X(15) VALUE IF1254.2 +012400 "TEST RESULT OF ". IF1254.2 +012500 02 TEST-ID PIC X(9). IF1254.2 +012600 02 FILLER PIC X(4) VALUE IF1254.2 +012700 " IN ". IF1254.2 +012800 02 FILLER PIC X(12) VALUE IF1254.2 +012900 " HIGH ". IF1254.2 +013000 02 FILLER PIC X(22) VALUE IF1254.2 +013100 " LEVEL VALIDATION FOR ". IF1254.2 +013200 02 FILLER PIC X(58) VALUE IF1254.2 +013300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1254.2 +013400 01 CCVS-H-3. IF1254.2 +013500 02 FILLER PIC X(34) VALUE IF1254.2 +013600 " FOR OFFICIAL USE ONLY ". IF1254.2 +013700 02 FILLER PIC X(58) VALUE IF1254.2 +013800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1254.2 +013900 02 FILLER PIC X(28) VALUE IF1254.2 +014000 " COPYRIGHT 1985 ". IF1254.2 +014100 01 CCVS-E-1. IF1254.2 +014200 02 FILLER PIC X(52) VALUE SPACE. IF1254.2 +014300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1254.2 +014400 02 ID-AGAIN PIC X(9). IF1254.2 +014500 02 FILLER PIC X(45) VALUE SPACES. IF1254.2 +014600 01 CCVS-E-2. IF1254.2 +014700 02 FILLER PIC X(31) VALUE SPACE. IF1254.2 +014800 02 FILLER PIC X(21) VALUE SPACE. IF1254.2 +014900 02 CCVS-E-2-2. IF1254.2 +015000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1254.2 +015100 03 FILLER PIC X VALUE SPACE. IF1254.2 +015200 03 ENDER-DESC PIC X(44) VALUE IF1254.2 +015300 "ERRORS ENCOUNTERED". IF1254.2 +015400 01 CCVS-E-3. IF1254.2 +015500 02 FILLER PIC X(22) VALUE IF1254.2 +015600 " FOR OFFICIAL USE ONLY". IF1254.2 +015700 02 FILLER PIC X(12) VALUE SPACE. IF1254.2 +015800 02 FILLER PIC X(58) VALUE IF1254.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1254.2 +016000 02 FILLER PIC X(13) VALUE SPACE. IF1254.2 +016100 02 FILLER PIC X(15) VALUE IF1254.2 +016200 " COPYRIGHT 1985". IF1254.2 +016300 01 CCVS-E-4. IF1254.2 +016400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1254.2 +016500 02 FILLER PIC X(4) VALUE " OF ". IF1254.2 +016600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1254.2 +016700 02 FILLER PIC X(40) VALUE IF1254.2 +016800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1254.2 +016900 01 XXINFO. IF1254.2 +017000 02 FILLER PIC X(19) VALUE IF1254.2 +017100 "*** INFORMATION ***". IF1254.2 +017200 02 INFO-TEXT. IF1254.2 +017300 04 FILLER PIC X(8) VALUE SPACE. IF1254.2 +017400 04 XXCOMPUTED PIC X(20). IF1254.2 +017500 04 FILLER PIC X(5) VALUE SPACE. IF1254.2 +017600 04 XXCORRECT PIC X(20). IF1254.2 +017700 02 INF-ANSI-REFERENCE PIC X(48). IF1254.2 +017800 01 HYPHEN-LINE. IF1254.2 +017900 02 FILLER PIC IS X VALUE IS SPACE. IF1254.2 +018000 02 FILLER PIC IS X(65) VALUE IS "************************IF1254.2 +018100- "*****************************************". IF1254.2 +018200 02 FILLER PIC IS X(54) VALUE IS "************************IF1254.2 +018300- "******************************". IF1254.2 +018400 01 CCVS-PGM-ID PIC X(9) VALUE IF1254.2 +018500 "IF125A". IF1254.2 +018600 PROCEDURE DIVISION. IF1254.2 +018700 CCVS1 SECTION. IF1254.2 +018800 OPEN-FILES. IF1254.2 +018900 OPEN OUTPUT PRINT-FILE. IF1254.2 +019000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1254.2 +019100 MOVE SPACE TO TEST-RESULTS. IF1254.2 +019200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1254.2 +019300 GO TO CCVS1-EXIT. IF1254.2 +019400 CLOSE-FILES. IF1254.2 +019500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1254.2 +019600 TERMINATE-CCVS. IF1254.2 +019700 STOP RUN. IF1254.2 +019800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1254.2 +019900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1254.2 +020000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1254.2 +020100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1254.2 +020200 MOVE "****TEST DELETED****" TO RE-MARK. IF1254.2 +020300 PRINT-DETAIL. IF1254.2 +020400 IF REC-CT NOT EQUAL TO ZERO IF1254.2 +020500 MOVE "." TO PARDOT-X IF1254.2 +020600 MOVE REC-CT TO DOTVALUE. IF1254.2 +020700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1254.2 +020800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1254.2 +020900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1254.2 +021000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1254.2 +021100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1254.2 +021200 MOVE SPACE TO CORRECT-X. IF1254.2 +021300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1254.2 +021400 MOVE SPACE TO RE-MARK. IF1254.2 +021500 HEAD-ROUTINE. IF1254.2 +021600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +021700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +021800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1254.2 +021900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1254.2 +022000 COLUMN-NAMES-ROUTINE. IF1254.2 +022100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +022200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +022300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +022400 END-ROUTINE. IF1254.2 +022500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1254.2 +022600 END-RTN-EXIT. IF1254.2 +022700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +022800 END-ROUTINE-1. IF1254.2 +022900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1254.2 +023000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1254.2 +023100 ADD PASS-COUNTER TO ERROR-HOLD. IF1254.2 +023200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1254.2 +023300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1254.2 +023400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1254.2 +023500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1254.2 +023600 END-ROUTINE-12. IF1254.2 +023700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1254.2 +023800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1254.2 +023900 MOVE "NO " TO ERROR-TOTAL IF1254.2 +024000 ELSE IF1254.2 +024100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1254.2 +024200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1254.2 +024300 PERFORM WRITE-LINE. IF1254.2 +024400 END-ROUTINE-13. IF1254.2 +024500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1254.2 +024600 MOVE "NO " TO ERROR-TOTAL ELSE IF1254.2 +024700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1254.2 +024800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1254.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +025000 IF INSPECT-COUNTER EQUAL TO ZERO IF1254.2 +025100 MOVE "NO " TO ERROR-TOTAL IF1254.2 +025200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1254.2 +025300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1254.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +025500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1254.2 +025600 WRITE-LINE. IF1254.2 +025700 ADD 1 TO RECORD-COUNT. IF1254.2 +025800 IF RECORD-COUNT GREATER 42 IF1254.2 +025900 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1254.2 +026000 MOVE SPACE TO DUMMY-RECORD IF1254.2 +026100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1254.2 +026200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1254.2 +026300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1254.2 +026400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1254.2 +026500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1254.2 +026600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1254.2 +026700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1254.2 +026800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1254.2 +026900 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1254.2 +027000 MOVE ZERO TO RECORD-COUNT. IF1254.2 +027100 PERFORM WRT-LN. IF1254.2 +027200 WRT-LN. IF1254.2 +027300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1254.2 +027400 MOVE SPACE TO DUMMY-RECORD. IF1254.2 +027500 BLANK-LINE-PRINT. IF1254.2 +027600 PERFORM WRT-LN. IF1254.2 +027700 FAIL-ROUTINE. IF1254.2 +027800 IF COMPUTED-X NOT EQUAL TO SPACE IF1254.2 +027900 GO TO FAIL-ROUTINE-WRITE. IF1254.2 +028000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1254.2 +028100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1254.2 +028200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1254.2 +028300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +028400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1254.2 +028500 GO TO FAIL-ROUTINE-EX. IF1254.2 +028600 FAIL-ROUTINE-WRITE. IF1254.2 +028700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1254.2 +028800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1254.2 +028900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1254.2 +029000 MOVE SPACES TO COR-ANSI-REFERENCE. IF1254.2 +029100 FAIL-ROUTINE-EX. EXIT. IF1254.2 +029200 BAIL-OUT. IF1254.2 +029300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1254.2 +029400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1254.2 +029500 BAIL-OUT-WRITE. IF1254.2 +029600 MOVE CORRECT-A TO XXCORRECT. IF1254.2 +029700 MOVE COMPUTED-A TO XXCOMPUTED. IF1254.2 +029800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1254.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1254.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1254.2 +030100 BAIL-OUT-EX. EXIT. IF1254.2 +030200 CCVS1-EXIT. IF1254.2 +030300 EXIT. IF1254.2 +030400******************************************************** IF1254.2 +030500* * IF1254.2 +030600* Intrinsic Function Tests IF125A - NUMVAL * IF1254.2 +030700* * IF1254.2 +030800******************************************************** IF1254.2 +030900 SECT-IF125A SECTION. IF1254.2 +031000 F-NUMVAL-INFO. IF1254.2 +031100 MOVE "See ref. A-58 2.29" TO ANSI-REFERENCE. IF1254.2 +031200 MOVE "NUMVAL Function" TO FEATURE. IF1254.2 +031300*****************TEST (a) ****************************** IF1254.2 +031400 F-NUMVAL-01. IF1254.2 +031500 MOVE ZERO TO TEMP. IF1254.2 +031600 F-NUMVAL-TEST-01. IF1254.2 +031700 COMPUTE TEMP = FUNCTION NUMVAL ("9"). IF1254.2 +031800 IF TEMP = 9 THEN IF1254.2 +031900 PERFORM PASS IF1254.2 +032000 ELSE IF1254.2 +032100 MOVE 9 TO CORRECT-N IF1254.2 +032200 MOVE TEMP TO COMPUTED-N IF1254.2 +032300 PERFORM FAIL. IF1254.2 +032400 GO TO F-NUMVAL-WRITE-01. IF1254.2 +032500 F-NUMVAL-DELETE-01. IF1254.2 +032600 PERFORM DE-LETE. IF1254.2 +032700 GO TO F-NUMVAL-WRITE-01. IF1254.2 +032800 F-NUMVAL-WRITE-01. IF1254.2 +032900 MOVE "F-NUMVAL-01" TO PAR-NAME. IF1254.2 +033000 PERFORM PRINT-DETAIL. IF1254.2 +033100*****************TEST (b) ****************************** IF1254.2 +033200 F-NUMVAL-02. IF1254.2 +033300 MOVE 77 TO TEMP. IF1254.2 +033400 F-NUMVAL-TEST-02. IF1254.2 +033500 EVALUATE FUNCTION NUMVAL ("4738") IF1254.2 +033600 ALSO ( TEMP + 96 ) * 2 IF1254.2 +033700 WHEN 4738 IF1254.2 +033800 ALSO 346 IF1254.2 +033900 PERFORM PASS IF1254.2 +034000 GO TO F-NUMVAL-WRITE-02. IF1254.2 +034100 PERFORM FAIL. IF1254.2 +034200 GO TO F-NUMVAL-WRITE-02. IF1254.2 +034300 F-NUMVAL-DELETE-02. IF1254.2 +034400 PERFORM DE-LETE. IF1254.2 +034500 GO TO F-NUMVAL-WRITE-02. IF1254.2 +034600 F-NUMVAL-WRITE-02. IF1254.2 +034700 MOVE "F-NUMVAL-02" TO PAR-NAME. IF1254.2 +034800 PERFORM PRINT-DETAIL. IF1254.2 +034900*****************TEST (c) ****************************** IF1254.2 +035000 F-NUMVAL-TEST-03. IF1254.2 +035100 IF (FUNCTION NUMVAL (".935") >= 0.934981) AND IF1254.2 +035200 (FUNCTION NUMVAL (".935") <= 0.935019) IF1254.2 +035300 PERFORM PASS IF1254.2 +035400 ELSE IF1254.2 +035500 PERFORM FAIL. IF1254.2 +035600 GO TO F-NUMVAL-WRITE-03. IF1254.2 +035700 F-NUMVAL-DELETE-03. IF1254.2 +035800 PERFORM DE-LETE. IF1254.2 +035900 GO TO F-NUMVAL-WRITE-03. IF1254.2 +036000 F-NUMVAL-WRITE-03. IF1254.2 +036100 MOVE "F-NUMVAL-03" TO PAR-NAME. IF1254.2 +036200 PERFORM PRINT-DETAIL. IF1254.2 +036300*****************TEST (d) ****************************** IF1254.2 +036400 F-NUMVAL-04. IF1254.2 +036500 MOVE ZERO TO TEMP. IF1254.2 +036600 F-NUMVAL-TEST-04. IF1254.2 +036700 COMPUTE TEMP = FUNCTION NUMVAL ("385.93"). IF1254.2 +036800 IF (TEMP >= 385.922) AND IF1254.2 +036900 (TEMP <= 385.938) IF1254.2 +037000 PERFORM PASS IF1254.2 +037100 ELSE IF1254.2 +037200 MOVE 385.93 TO CORRECT-N IF1254.2 +037300 MOVE TEMP TO COMPUTED-N IF1254.2 +037400 PERFORM FAIL. IF1254.2 +037500 GO TO F-NUMVAL-WRITE-04. IF1254.2 +037600 F-NUMVAL-DELETE-04. IF1254.2 +037700 PERFORM DE-LETE. IF1254.2 +037800 GO TO F-NUMVAL-WRITE-04. IF1254.2 +037900 F-NUMVAL-WRITE-04. IF1254.2 +038000 MOVE "F-NUMVAL-04" TO PAR-NAME. IF1254.2 +038100 PERFORM PRINT-DETAIL. IF1254.2 +038200*****************TEST (e) ****************************** IF1254.2 +038300 F-NUMVAL-05. IF1254.2 +038400 MOVE ZERO TO TEMP. IF1254.2 +038500 F-NUMVAL-TEST-05. IF1254.2 +038600 COMPUTE TEMP = FUNCTION NUMVAL ("+394.2"). IF1254.2 +038700 IF (TEMP >= 394.192) AND IF1254.2 +038800 (TEMP <= 394.208) IF1254.2 +038900 PERFORM PASS IF1254.2 +039000 ELSE IF1254.2 +039100 MOVE 394.2 TO CORRECT-N IF1254.2 +039200 MOVE TEMP TO COMPUTED-N IF1254.2 +039300 PERFORM FAIL. IF1254.2 +039400 GO TO F-NUMVAL-WRITE-05. IF1254.2 +039500 F-NUMVAL-DELETE-05. IF1254.2 +039600 PERFORM DE-LETE. IF1254.2 +039700 GO TO F-NUMVAL-WRITE-05. IF1254.2 +039800 F-NUMVAL-WRITE-05. IF1254.2 +039900 MOVE "F-NUMVAL-05" TO PAR-NAME. IF1254.2 +040000 PERFORM PRINT-DETAIL. IF1254.2 +040100*****************TEST (f) ****************************** IF1254.2 +040200 F-NUMVAL-06. IF1254.2 +040300 MOVE ZERO TO TEMP. IF1254.2 +040400 F-NUMVAL-TEST-06. IF1254.2 +040500 COMPUTE TEMP = FUNCTION NUMVAL (" 939.83"). IF1254.2 +040600 IF (TEMP >= 939.811) AND IF1254.2 +040700 (TEMP <= 939.849) IF1254.2 +040800 PERFORM PASS IF1254.2 +040900 ELSE IF1254.2 +041000 MOVE 939.83 TO CORRECT-N IF1254.2 +041100 MOVE TEMP TO COMPUTED-N IF1254.2 +041200 PERFORM FAIL. IF1254.2 +041300 GO TO F-NUMVAL-WRITE-06. IF1254.2 +041400 F-NUMVAL-DELETE-06. IF1254.2 +041500 PERFORM DE-LETE. IF1254.2 +041600 GO TO F-NUMVAL-WRITE-06. IF1254.2 +041700 F-NUMVAL-WRITE-06. IF1254.2 +041800 MOVE "F-NUMVAL-06" TO PAR-NAME. IF1254.2 +041900 PERFORM PRINT-DETAIL. IF1254.2 +042000*****************TEST (g) ****************************** IF1254.2 +042100 F-NUMVAL-07. IF1254.2 +042200 MOVE ZERO TO TEMP. IF1254.2 +042300 F-NUMVAL-TEST-07. IF1254.2 +042400 COMPUTE TEMP = FUNCTION NUMVAL (" - 4929.0323"). IF1254.2 +042500 IF (TEMP >= -4929.1309) AND IF1254.2 +042600 (TEMP <= -4928.9337) IF1254.2 +042700 PERFORM PASS IF1254.2 +042800 ELSE IF1254.2 +042900 MOVE -4929.0323 TO CORRECT-N IF1254.2 +043000 MOVE TEMP TO COMPUTED-N IF1254.2 +043100 PERFORM FAIL. IF1254.2 +043200 GO TO F-NUMVAL-WRITE-07. IF1254.2 +043300 F-NUMVAL-DELETE-07. IF1254.2 +043400 PERFORM DE-LETE. IF1254.2 +043500 GO TO F-NUMVAL-WRITE-07. IF1254.2 +043600 F-NUMVAL-WRITE-07. IF1254.2 +043700 MOVE "F-NUMVAL-07" TO PAR-NAME. IF1254.2 +043800 PERFORM PRINT-DETAIL. IF1254.2 +043900*****************TEST (h) ****************************** IF1254.2 +044000 F-NUMVAL-08. IF1254.2 +044100 MOVE ZERO TO TEMP. IF1254.2 +044200 F-NUMVAL-TEST-08. IF1254.2 +044300 COMPUTE TEMP = FUNCTION NUMVAL ("82.9312+"). IF1254.2 +044400 IF (TEMP >= 82.9295) AND IF1254.2 +044500 (TEMP <= 82.9329) IF1254.2 +044600 PERFORM PASS IF1254.2 +044700 ELSE IF1254.2 +044800 MOVE 82.9312 TO CORRECT-N IF1254.2 +044900 MOVE TEMP TO COMPUTED-N IF1254.2 +045000 PERFORM FAIL. IF1254.2 +045100 GO TO F-NUMVAL-WRITE-08. IF1254.2 +045200 F-NUMVAL-DELETE-08. IF1254.2 +045300 PERFORM DE-LETE. IF1254.2 +045400 GO TO F-NUMVAL-WRITE-08. IF1254.2 +045500 F-NUMVAL-WRITE-08. IF1254.2 +045600 MOVE "F-NUMVAL-08" TO PAR-NAME. IF1254.2 +045700 PERFORM PRINT-DETAIL. IF1254.2 +045800*****************TEST (i) ****************************** IF1254.2 +045900 F-NUMVAL-09. IF1254.2 +046000 MOVE ZERO TO TEMP. IF1254.2 +046100 F-NUMVAL-TEST-09. IF1254.2 +046200 COMPUTE TEMP = FUNCTION NUMVAL (" 200.0002 - "). IF1254.2 +046300 IF (TEMP >= -200.0042) AND IF1254.2 +046400 (TEMP <= -199.9962) IF1254.2 +046500 PERFORM PASS IF1254.2 +046600 ELSE IF1254.2 +046700 MOVE -200.0002 TO CORRECT-N IF1254.2 +046800 MOVE TEMP TO COMPUTED-N IF1254.2 +046900 PERFORM FAIL. IF1254.2 +047000 GO TO F-NUMVAL-WRITE-09. IF1254.2 +047100 F-NUMVAL-DELETE-09. IF1254.2 +047200 PERFORM DE-LETE. IF1254.2 +047300 GO TO F-NUMVAL-WRITE-09. IF1254.2 +047400 F-NUMVAL-WRITE-09. IF1254.2 +047500 MOVE "F-NUMVAL-09" TO PAR-NAME. IF1254.2 +047600 PERFORM PRINT-DETAIL. IF1254.2 +047700*****************TEST (j) ****************************** IF1254.2 +047800 F-NUMVAL-10. IF1254.2 +047900 MOVE ZERO TO TEMP. IF1254.2 +048000 F-NUMVAL-TEST-10. IF1254.2 +048100 COMPUTE TEMP = FUNCTION NUMVAL (A). IF1254.2 +048200 IF TEMP = 4 THEN IF1254.2 +048300 PERFORM PASS IF1254.2 +048400 ELSE IF1254.2 +048500 MOVE 4 TO CORRECT-N IF1254.2 +048600 MOVE TEMP TO COMPUTED-N IF1254.2 +048700 PERFORM FAIL. IF1254.2 +048800 GO TO F-NUMVAL-WRITE-10. IF1254.2 +048900 F-NUMVAL-DELETE-10. IF1254.2 +049000 PERFORM DE-LETE. IF1254.2 +049100 GO TO F-NUMVAL-WRITE-10. IF1254.2 +049200 F-NUMVAL-WRITE-10. IF1254.2 +049300 MOVE "F-NUMVAL-10" TO PAR-NAME. IF1254.2 +049400 PERFORM PRINT-DETAIL. IF1254.2 +049500*****************TEST (k) ****************************** IF1254.2 +049600 F-NUMVAL-11. IF1254.2 +049700 MOVE ZERO TO TEMP. IF1254.2 +049800 F-NUMVAL-TEST-11. IF1254.2 +049900 COMPUTE TEMP = FUNCTION NUMVAL (B). IF1254.2 +050000 IF TEMP = 203 THEN IF1254.2 +050100 PERFORM PASS IF1254.2 +050200 ELSE IF1254.2 +050300 MOVE 203 TO CORRECT-N IF1254.2 +050400 MOVE TEMP TO COMPUTED-N IF1254.2 +050500 PERFORM FAIL. IF1254.2 +050600 GO TO F-NUMVAL-WRITE-11. IF1254.2 +050700 F-NUMVAL-DELETE-11. IF1254.2 +050800 PERFORM DE-LETE. IF1254.2 +050900 GO TO F-NUMVAL-WRITE-11. IF1254.2 +051000 F-NUMVAL-WRITE-11. IF1254.2 +051100 MOVE "F-NUMVAL-11" TO PAR-NAME. IF1254.2 +051200 PERFORM PRINT-DETAIL. IF1254.2 +051300*****************TEST (l) ****************************** IF1254.2 +051400 F-NUMVAL-12. IF1254.2 +051500 MOVE ZERO TO TEMP. IF1254.2 +051600 F-NUMVAL-TEST-12. IF1254.2 +051700 COMPUTE TEMP = FUNCTION NUMVAL (C). IF1254.2 +051800 IF (TEMP >= 0.428991) AND IF1254.2 +051900 (TEMP <= 0.429009) IF1254.2 +052000 PERFORM PASS IF1254.2 +052100 ELSE IF1254.2 +052200 MOVE 0.429 TO CORRECT-N IF1254.2 +052300 MOVE TEMP TO COMPUTED-N IF1254.2 +052400 PERFORM FAIL. IF1254.2 +052500 GO TO F-NUMVAL-WRITE-12. IF1254.2 +052600 F-NUMVAL-DELETE-12. IF1254.2 +052700 PERFORM DE-LETE. IF1254.2 +052800 GO TO F-NUMVAL-WRITE-12. IF1254.2 +052900 F-NUMVAL-WRITE-12. IF1254.2 +053000 MOVE "F-NUMVAL-12" TO PAR-NAME. IF1254.2 +053100 PERFORM PRINT-DETAIL. IF1254.2 +053200*****************TEST (m) ****************************** IF1254.2 +053300 F-NUMVAL-13. IF1254.2 +053400 MOVE ZERO TO TEMP. IF1254.2 +053500 F-NUMVAL-TEST-13. IF1254.2 +053600 COMPUTE TEMP = FUNCTION NUMVAL (D). IF1254.2 +053700 IF (TEMP >= 928.325) AND IF1254.2 +053800 (TEMP <= 928.363) IF1254.2 +053900 PERFORM PASS IF1254.2 +054000 ELSE IF1254.2 +054100 MOVE 928.344 TO CORRECT-N IF1254.2 +054200 MOVE TEMP TO COMPUTED-N IF1254.2 +054300 PERFORM FAIL. IF1254.2 +054400 GO TO F-NUMVAL-WRITE-13. IF1254.2 +054500 F-NUMVAL-DELETE-13. IF1254.2 +054600 PERFORM DE-LETE. IF1254.2 +054700 GO TO F-NUMVAL-WRITE-13. IF1254.2 +054800 F-NUMVAL-WRITE-13. IF1254.2 +054900 MOVE "F-NUMVAL-13" TO PAR-NAME. IF1254.2 +055000 PERFORM PRINT-DETAIL. IF1254.2 +055100*****************TEST (n) ****************************** IF1254.2 +055200 F-NUMVAL-14. IF1254.2 +055300 MOVE ZERO TO TEMP. IF1254.2 +055400 F-NUMVAL-TEST-14. IF1254.2 +055500 COMPUTE TEMP = FUNCTION NUMVAL (E). IF1254.2 +055600 IF (TEMP >= -42.3248) AND IF1254.2 +055700 (TEMP <= -42.3232) IF1254.2 +055800 PERFORM PASS IF1254.2 +055900 ELSE IF1254.2 +056000 MOVE -42.324 TO CORRECT-N IF1254.2 +056100 MOVE TEMP TO COMPUTED-N IF1254.2 +056200 PERFORM FAIL. IF1254.2 +056300 GO TO F-NUMVAL-WRITE-14. IF1254.2 +056400 F-NUMVAL-DELETE-14. IF1254.2 +056500 PERFORM DE-LETE. IF1254.2 +056600 GO TO F-NUMVAL-WRITE-14. IF1254.2 +056700 F-NUMVAL-WRITE-14. IF1254.2 +056800 MOVE "F-NUMVAL-14" TO PAR-NAME. IF1254.2 +056900 PERFORM PRINT-DETAIL. IF1254.2 +057000*****************TEST (o) ****************************** IF1254.2 +057100 F-NUMVAL-15. IF1254.2 +057200 MOVE ZERO TO TEMP. IF1254.2 +057300 F-NUMVAL-TEST-15. IF1254.2 +057400 COMPUTE TEMP = FUNCTION NUMVAL (F). IF1254.2 +057500 IF (TEMP >= 22.9995) AND IF1254.2 +057600 (TEMP <= 23.0005) IF1254.2 +057700 PERFORM PASS IF1254.2 +057800 ELSE IF1254.2 +057900 MOVE 23.0 TO CORRECT-N IF1254.2 +058000 MOVE TEMP TO COMPUTED-N IF1254.2 +058100 PERFORM FAIL. IF1254.2 +058200 GO TO F-NUMVAL-WRITE-15. IF1254.2 +058300 F-NUMVAL-DELETE-15. IF1254.2 +058400 PERFORM DE-LETE. IF1254.2 +058500 GO TO F-NUMVAL-WRITE-15. IF1254.2 +058600 F-NUMVAL-WRITE-15. IF1254.2 +058700 MOVE "F-NUMVAL-15" TO PAR-NAME. IF1254.2 +058800 PERFORM PRINT-DETAIL. IF1254.2 +058900*****************TEST (p) ****************************** IF1254.2 +059000 F-NUMVAL-16. IF1254.2 +059100 MOVE ZERO TO TEMP. IF1254.2 +059200 F-NUMVAL-TEST-16. IF1254.2 +059300 COMPUTE TEMP = FUNCTION NUMVAL (G). IF1254.2 +059400 IF (TEMP >= -92926.16) AND IF1254.2 +059500 (TEMP <= -92922.44) IF1254.2 +059600 PERFORM PASS IF1254.2 +059700 ELSE IF1254.2 +059800 MOVE -92924.3 TO CORRECT-N IF1254.2 +059900 MOVE TEMP TO COMPUTED-N IF1254.2 +060000 PERFORM FAIL. IF1254.2 +060100 GO TO F-NUMVAL-WRITE-16. IF1254.2 +060200 F-NUMVAL-DELETE-16. IF1254.2 +060300 PERFORM DE-LETE. IF1254.2 +060400 GO TO F-NUMVAL-WRITE-16. IF1254.2 +060500 F-NUMVAL-WRITE-16. IF1254.2 +060600 MOVE "F-NUMVAL-16" TO PAR-NAME. IF1254.2 +060700 PERFORM PRINT-DETAIL. IF1254.2 +060800*****************TEST (q) ****************************** IF1254.2 +060900 F-NUMVAL-17. IF1254.2 +061000 MOVE ZERO TO TEMP. IF1254.2 +061100 F-NUMVAL-TEST-17. IF1254.2 +061200 COMPUTE TEMP = FUNCTION NUMVAL (H). IF1254.2 +061300 IF (TEMP >= 93.2081) AND IF1254.2 +061400 (TEMP <= 93.2119) IF1254.2 +061500 PERFORM PASS IF1254.2 +061600 ELSE IF1254.2 +061700 MOVE 93.21 TO CORRECT-N IF1254.2 +061800 MOVE TEMP TO COMPUTED-N IF1254.2 +061900 PERFORM FAIL. IF1254.2 +062000 GO TO F-NUMVAL-WRITE-17. IF1254.2 +062100 F-NUMVAL-DELETE-17. IF1254.2 +062200 PERFORM DE-LETE. IF1254.2 +062300 GO TO F-NUMVAL-WRITE-17. IF1254.2 +062400 F-NUMVAL-WRITE-17. IF1254.2 +062500 MOVE "F-NUMVAL-17" TO PAR-NAME. IF1254.2 +062600 PERFORM PRINT-DETAIL. IF1254.2 +062700*****************TEST (r) ****************************** IF1254.2 +062800 F-NUMVAL-18. IF1254.2 +062900 MOVE ZERO TO TEMP. IF1254.2 +063000 F-NUMVAL-TEST-18. IF1254.2 +063100 COMPUTE TEMP = FUNCTION NUMVAL (I). IF1254.2 +063200 IF (TEMP >= -92.9219) AND IF1254.2 +063300 (TEMP <= -92.9181) IF1254.2 +063400 PERFORM PASS IF1254.2 +063500 ELSE IF1254.2 +063600 MOVE -92.92 TO CORRECT-N IF1254.2 +063700 MOVE TEMP TO COMPUTED-N IF1254.2 +063800 PERFORM FAIL. IF1254.2 +063900 GO TO F-NUMVAL-WRITE-18. IF1254.2 +064000 F-NUMVAL-DELETE-18. IF1254.2 +064100 PERFORM DE-LETE. IF1254.2 +064200 GO TO F-NUMVAL-WRITE-18. IF1254.2 +064300 F-NUMVAL-WRITE-18. IF1254.2 +064400 MOVE "F-NUMVAL-18" TO PAR-NAME. IF1254.2 +064500 PERFORM PRINT-DETAIL. IF1254.2 +064600*****************TEST (s) ****************************** IF1254.2 +064700 F-NUMVAL-19. IF1254.2 +064800 MOVE ZERO TO TEMP. IF1254.2 +064900 F-NUMVAL-TEST-19. IF1254.2 +065000 COMPUTE TEMP = (FUNCTION NUMVAL ("90") + 10). IF1254.2 +065100 IF TEMP = 100 THEN IF1254.2 +065200 PERFORM PASS IF1254.2 +065300 ELSE IF1254.2 +065400 MOVE 100 TO CORRECT-N IF1254.2 +065500 MOVE TEMP TO COMPUTED-N IF1254.2 +065600 PERFORM FAIL. IF1254.2 +065700 GO TO F-NUMVAL-WRITE-19. IF1254.2 +065800 F-NUMVAL-DELETE-19. IF1254.2 +065900 PERFORM DE-LETE. IF1254.2 +066000 GO TO F-NUMVAL-WRITE-19. IF1254.2 +066100 F-NUMVAL-WRITE-19. IF1254.2 +066200 MOVE "F-NUMVAL-19" TO PAR-NAME. IF1254.2 +066300 PERFORM PRINT-DETAIL. IF1254.2 +066400*****************TEST (t) ****************************** IF1254.2 +066500 F-NUMVAL-20. IF1254.2 +066600 MOVE ZERO TO TEMP. IF1254.2 +066700 F-NUMVAL-TEST-20. IF1254.2 +066800 COMPUTE TEMP = (FUNCTION NUMVAL ("2") + IF1254.2 +066900 FUNCTION NUMVAL ("8") ). IF1254.2 +067000 IF TEMP = 10 THEN IF1254.2 +067100 PERFORM PASS IF1254.2 +067200 ELSE IF1254.2 +067300 MOVE 10 TO CORRECT-N IF1254.2 +067400 MOVE TEMP TO COMPUTED-N IF1254.2 +067500 PERFORM FAIL. IF1254.2 +067600 GO TO F-NUMVAL-WRITE-20. IF1254.2 +067700 F-NUMVAL-DELETE-20. IF1254.2 +067800 PERFORM DE-LETE. IF1254.2 +067900 GO TO F-NUMVAL-WRITE-20. IF1254.2 +068000 F-NUMVAL-WRITE-20. IF1254.2 +068100 MOVE "F-NUMVAL-20" TO PAR-NAME. IF1254.2 +068200 PERFORM PRINT-DETAIL. IF1254.2 +068300*******************END OF TESTS************************** IF1254.2 +068400 CCVS-EXIT SECTION. IF1254.2 +068500 CCVS-999999. IF1254.2 +068600 GO TO CLOSE-FILES. IF1254.2 diff --git a/tests/cobol85/IF/IF126A.CBL b/tests/cobol85/IF/IF126A.CBL new file mode 100755 index 00000000..cfe6d8dc --- /dev/null +++ b/tests/cobol85/IF/IF126A.CBL @@ -0,0 +1,886 @@ +000100 IDENTIFICATION DIVISION. IF1264.2 +000200 PROGRAM-ID. IF1264.2 +000300 IF126A. IF1264.2 +000400 IF1264.2 +000500*********************************************************** IF1264.2 +000600* * IF1264.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1264.2 +000800* It contains tests for the Intrinsic Function * IF1264.2 +000900* NUMVAL-C. * IF1264.2 +001000* * IF1264.2 +001100* * IF1264.2 +001200*********************************************************** IF1264.2 +001300 ENVIRONMENT DIVISION. IF1264.2 +001400 CONFIGURATION SECTION. IF1264.2 +001500 SOURCE-COMPUTER. IF1264.2 +001600 Linux. IF1264.2 +001700 OBJECT-COMPUTER. IF1264.2 +001800 Linux. IF1264.2 +001900 INPUT-OUTPUT SECTION. IF1264.2 +002000 FILE-CONTROL. IF1264.2 +002100 SELECT PRINT-FILE ASSIGN TO IF1264.2 +002200 "report.log". IF1264.2 +002300 DATA DIVISION. IF1264.2 +002400 FILE SECTION. IF1264.2 +002500 FD PRINT-FILE. IF1264.2 +002600 01 PRINT-REC PICTURE X(120). IF1264.2 +002700 01 DUMMY-RECORD PICTURE X(120). IF1264.2 +002800 WORKING-STORAGE SECTION. IF1264.2 +002900*********************************************************** IF1264.2 +003000* Variables specific to the Intrinsic Function Test IF126A* IF1264.2 +003100*********************************************************** IF1264.2 +003200 01 A PIC X(1) VALUE "4". IF1264.2 +003300 01 B PIC X(5) VALUE "203". IF1264.2 +003400 01 C PIC X(4) VALUE ".429". IF1264.2 +003500 01 D PIC X(7) VALUE "928.344". IF1264.2 +003600 01 E PIC X(9) VALUE "-042.3240". IF1264.2 +003700 01 F PIC X(7) VALUE " 23.000". IF1264.2 +003800 01 G PIC X(8) VALUE "-92924.3". IF1264.2 +003900 01 H PIC X(6) VALUE "93.21+". IF1264.2 +004000 01 I PIC X(9) VALUE " 92.92 -". IF1264.2 +004100 01 J PIC X(9) VALUE "8,848.934". IF1264.2 +004200 01 K PIC X(12) VALUE "4,825,293.92". IF1264.2 +004300 01 L PIC X(12) VALUE " - 5,555.55 ". IF1264.2 +004400 01 M PIC X(9) VALUE "5,555.55-". IF1264.2 +004500 01 N PIC X(13) VALUE " 77,777.77 + ". IF1264.2 +004600 01 O PIC X(3) VALUE "$33". IF1264.2 +004700 01 P PIC X(5) VALUE "$0.11". IF1264.2 +004800 01 Q PIC X(9) VALUE "$4,000.00". IF1264.2 +004900 01 R PIC X(14) VALUE "$1,000,000.50". IF1264.2 +005000 01 S PIC X(14) VALUE " $ 3,900.21". IF1264.2 +005100 01 T PIC X(14) VALUE " + $ 9,000.99". IF1264.2 +005200 01 U PIC X(15) VALUE " $ 3,890.20 + ". IF1264.2 +005300 01 TEMP PIC S9(7)V9(5). IF1264.2 +005400 IF1264.2 +005500* IF1264.2 +005600********************************************************** IF1264.2 +005700* IF1264.2 +005800 01 TEST-RESULTS. IF1264.2 +005900 02 FILLER PIC X VALUE SPACE. IF1264.2 +006000 02 FEATURE PIC X(20) VALUE SPACE. IF1264.2 +006100 02 FILLER PIC X VALUE SPACE. IF1264.2 +006200 02 P-OR-F PIC X(5) VALUE SPACE. IF1264.2 +006300 02 FILLER PIC X VALUE SPACE. IF1264.2 +006400 02 PAR-NAME. IF1264.2 +006500 03 FILLER PIC X(19) VALUE SPACE. IF1264.2 +006600 03 PARDOT-X PIC X VALUE SPACE. IF1264.2 +006700 03 DOTVALUE PIC 99 VALUE ZERO. IF1264.2 +006800 02 FILLER PIC X(8) VALUE SPACE. IF1264.2 +006900 02 RE-MARK PIC X(61). IF1264.2 +007000 01 TEST-COMPUTED. IF1264.2 +007100 02 FILLER PIC X(30) VALUE SPACE. IF1264.2 +007200 02 FILLER PIC X(17) VALUE IF1264.2 +007300 " COMPUTED=". IF1264.2 +007400 02 COMPUTED-X. IF1264.2 +007500 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1264.2 +007600 03 COMPUTED-N REDEFINES COMPUTED-A IF1264.2 +007700 PIC -9(9).9(9). IF1264.2 +007800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1264.2 +007900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1264.2 +008000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1264.2 +008100 03 CM-18V0 REDEFINES COMPUTED-A. IF1264.2 +008200 04 COMPUTED-18V0 PIC -9(18). IF1264.2 +008300 04 FILLER PIC X. IF1264.2 +008400 03 FILLER PIC X(50) VALUE SPACE. IF1264.2 +008500 01 TEST-CORRECT. IF1264.2 +008600 02 FILLER PIC X(30) VALUE SPACE. IF1264.2 +008700 02 FILLER PIC X(17) VALUE " CORRECT =". IF1264.2 +008800 02 CORRECT-X. IF1264.2 +008900 03 CORRECT-A PIC X(20) VALUE SPACE. IF1264.2 +009000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1264.2 +009100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1264.2 +009200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1264.2 +009300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1264.2 +009400 03 CR-18V0 REDEFINES CORRECT-A. IF1264.2 +009500 04 CORRECT-18V0 PIC -9(18). IF1264.2 +009600 04 FILLER PIC X. IF1264.2 +009700 03 FILLER PIC X(2) VALUE SPACE. IF1264.2 +009800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1264.2 +009900 01 CCVS-C-1. IF1264.2 +010000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1264.2 +010100- "SS PARAGRAPH-NAME IF1264.2 +010200- " REMARKS". IF1264.2 +010300 02 FILLER PIC X(20) VALUE SPACE. IF1264.2 +010400 01 CCVS-C-2. IF1264.2 +010500 02 FILLER PIC X VALUE SPACE. IF1264.2 +010600 02 FILLER PIC X(6) VALUE "TESTED". IF1264.2 +010700 02 FILLER PIC X(15) VALUE SPACE. IF1264.2 +010800 02 FILLER PIC X(4) VALUE "FAIL". IF1264.2 +010900 02 FILLER PIC X(94) VALUE SPACE. IF1264.2 +011000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1264.2 +011100 01 REC-CT PIC 99 VALUE ZERO. IF1264.2 +011200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1264.2 +011300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1264.2 +011400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1264.2 +011500 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1264.2 +011600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1264.2 +011700 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1264.2 +011800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1264.2 +011900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1264.2 +012000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1264.2 +012100 01 CCVS-H-1. IF1264.2 +012200 02 FILLER PIC X(39) VALUE SPACES. IF1264.2 +012300 02 FILLER PIC X(42) VALUE IF1264.2 +012400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1264.2 +012500 02 FILLER PIC X(39) VALUE SPACES. IF1264.2 +012600 01 CCVS-H-2A. IF1264.2 +012700 02 FILLER PIC X(40) VALUE SPACE. IF1264.2 +012800 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1264.2 +012900 02 FILLER PIC XXXX VALUE IF1264.2 +013000 "4.2 ". IF1264.2 +013100 02 FILLER PIC X(28) VALUE IF1264.2 +013200 " COPY - NOT FOR DISTRIBUTION". IF1264.2 +013300 02 FILLER PIC X(41) VALUE SPACE. IF1264.2 +013400 IF1264.2 +013500 01 CCVS-H-2B. IF1264.2 +013600 02 FILLER PIC X(15) VALUE IF1264.2 +013700 "TEST RESULT OF ". IF1264.2 +013800 02 TEST-ID PIC X(9). IF1264.2 +013900 02 FILLER PIC X(4) VALUE IF1264.2 +014000 " IN ". IF1264.2 +014100 02 FILLER PIC X(12) VALUE IF1264.2 +014200 " HIGH ". IF1264.2 +014300 02 FILLER PIC X(22) VALUE IF1264.2 +014400 " LEVEL VALIDATION FOR ". IF1264.2 +014500 02 FILLER PIC X(58) VALUE IF1264.2 +014600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1264.2 +014700 01 CCVS-H-3. IF1264.2 +014800 02 FILLER PIC X(34) VALUE IF1264.2 +014900 " FOR OFFICIAL USE ONLY ". IF1264.2 +015000 02 FILLER PIC X(58) VALUE IF1264.2 +015100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1264.2 +015200 02 FILLER PIC X(28) VALUE IF1264.2 +015300 " COPYRIGHT 1985 ". IF1264.2 +015400 01 CCVS-E-1. IF1264.2 +015500 02 FILLER PIC X(52) VALUE SPACE. IF1264.2 +015600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1264.2 +015700 02 ID-AGAIN PIC X(9). IF1264.2 +015800 02 FILLER PIC X(45) VALUE SPACES. IF1264.2 +015900 01 CCVS-E-2. IF1264.2 +016000 02 FILLER PIC X(31) VALUE SPACE. IF1264.2 +016100 02 FILLER PIC X(21) VALUE SPACE. IF1264.2 +016200 02 CCVS-E-2-2. IF1264.2 +016300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1264.2 +016400 03 FILLER PIC X VALUE SPACE. IF1264.2 +016500 03 ENDER-DESC PIC X(44) VALUE IF1264.2 +016600 "ERRORS ENCOUNTERED". IF1264.2 +016700 01 CCVS-E-3. IF1264.2 +016800 02 FILLER PIC X(22) VALUE IF1264.2 +016900 " FOR OFFICIAL USE ONLY". IF1264.2 +017000 02 FILLER PIC X(12) VALUE SPACE. IF1264.2 +017100 02 FILLER PIC X(58) VALUE IF1264.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1264.2 +017300 02 FILLER PIC X(13) VALUE SPACE. IF1264.2 +017400 02 FILLER PIC X(15) VALUE IF1264.2 +017500 " COPYRIGHT 1985". IF1264.2 +017600 01 CCVS-E-4. IF1264.2 +017700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1264.2 +017800 02 FILLER PIC X(4) VALUE " OF ". IF1264.2 +017900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1264.2 +018000 02 FILLER PIC X(40) VALUE IF1264.2 +018100 " TESTS WERE EXECUTED SUCCESSFULLY". IF1264.2 +018200 01 XXINFO. IF1264.2 +018300 02 FILLER PIC X(19) VALUE IF1264.2 +018400 "*** INFORMATION ***". IF1264.2 +018500 02 INFO-TEXT. IF1264.2 +018600 04 FILLER PIC X(8) VALUE SPACE. IF1264.2 +018700 04 XXCOMPUTED PIC X(20). IF1264.2 +018800 04 FILLER PIC X(5) VALUE SPACE. IF1264.2 +018900 04 XXCORRECT PIC X(20). IF1264.2 +019000 02 INF-ANSI-REFERENCE PIC X(48). IF1264.2 +019100 01 HYPHEN-LINE. IF1264.2 +019200 02 FILLER PIC IS X VALUE IS SPACE. IF1264.2 +019300 02 FILLER PIC IS X(65) VALUE IS "************************IF1264.2 +019400- "*****************************************". IF1264.2 +019500 02 FILLER PIC IS X(54) VALUE IS "************************IF1264.2 +019600- "******************************". IF1264.2 +019700 01 CCVS-PGM-ID PIC X(9) VALUE IF1264.2 +019800 "IF126A". IF1264.2 +019900 PROCEDURE DIVISION. IF1264.2 +020000 CCVS1 SECTION. IF1264.2 +020100 OPEN-FILES. IF1264.2 +020200 OPEN OUTPUT PRINT-FILE. IF1264.2 +020300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1264.2 +020400 MOVE SPACE TO TEST-RESULTS. IF1264.2 +020500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1264.2 +020600 GO TO CCVS1-EXIT. IF1264.2 +020700 CLOSE-FILES. IF1264.2 +020800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1264.2 +020900 TERMINATE-CCVS. IF1264.2 +021000 STOP RUN. IF1264.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1264.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1264.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1264.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1264.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. IF1264.2 +021600 PRINT-DETAIL. IF1264.2 +021700 IF REC-CT NOT EQUAL TO ZERO IF1264.2 +021800 MOVE "." TO PARDOT-X IF1264.2 +021900 MOVE REC-CT TO DOTVALUE. IF1264.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1264.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1264.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1264.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1264.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1264.2 +022500 MOVE SPACE TO CORRECT-X. IF1264.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1264.2 +022700 MOVE SPACE TO RE-MARK. IF1264.2 +022800 HEAD-ROUTINE. IF1264.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1264.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1264.2 +023300 COLUMN-NAMES-ROUTINE. IF1264.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +023700 END-ROUTINE. IF1264.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1264.2 +023900 END-RTN-EXIT. IF1264.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +024100 END-ROUTINE-1. IF1264.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1264.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1264.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. IF1264.2 +024500 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1264.2 +024600 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1264.2 +024700 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1264.2 +024800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1264.2 +024900 END-ROUTINE-12. IF1264.2 +025000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1264.2 +025100 IF ERROR-COUNTER IS EQUAL TO ZERO IF1264.2 +025200 MOVE "NO " TO ERROR-TOTAL IF1264.2 +025300 ELSE IF1264.2 +025400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1264.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1264.2 +025600 PERFORM WRITE-LINE. IF1264.2 +025700 END-ROUTINE-13. IF1264.2 +025800 IF DELETE-COUNTER IS EQUAL TO ZERO IF1264.2 +025900 MOVE "NO " TO ERROR-TOTAL ELSE IF1264.2 +026000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1264.2 +026100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1264.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +026300 IF INSPECT-COUNTER EQUAL TO ZERO IF1264.2 +026400 MOVE "NO " TO ERROR-TOTAL IF1264.2 +026500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1264.2 +026600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1264.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +026800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1264.2 +026900 WRITE-LINE. IF1264.2 +027000 ADD 1 TO RECORD-COUNT. IF1264.2 +027100 IF RECORD-COUNT GREATER 42 IF1264.2 +027200 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1264.2 +027300 MOVE SPACE TO DUMMY-RECORD IF1264.2 +027400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1264.2 +027500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1264.2 +027600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1264.2 +027700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1264.2 +027800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1264.2 +027900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1264.2 +028000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1264.2 +028100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1264.2 +028200 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1264.2 +028300 MOVE ZERO TO RECORD-COUNT. IF1264.2 +028400 PERFORM WRT-LN. IF1264.2 +028500 WRT-LN. IF1264.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1264.2 +028700 MOVE SPACE TO DUMMY-RECORD. IF1264.2 +028800 BLANK-LINE-PRINT. IF1264.2 +028900 PERFORM WRT-LN. IF1264.2 +029000 FAIL-ROUTINE. IF1264.2 +029100 IF COMPUTED-X NOT EQUAL TO SPACE IF1264.2 +029200 GO TO FAIL-ROUTINE-WRITE. IF1264.2 +029300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1264.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1264.2 +029500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1264.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1264.2 +029800 GO TO FAIL-ROUTINE-EX. IF1264.2 +029900 FAIL-ROUTINE-WRITE. IF1264.2 +030000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1264.2 +030100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1264.2 +030200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1264.2 +030300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1264.2 +030400 FAIL-ROUTINE-EX. EXIT. IF1264.2 +030500 BAIL-OUT. IF1264.2 +030600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1264.2 +030700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1264.2 +030800 BAIL-OUT-WRITE. IF1264.2 +030900 MOVE CORRECT-A TO XXCORRECT. IF1264.2 +031000 MOVE COMPUTED-A TO XXCOMPUTED. IF1264.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1264.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1264.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1264.2 +031400 BAIL-OUT-EX. EXIT. IF1264.2 +031500 CCVS1-EXIT. IF1264.2 +031600 EXIT. IF1264.2 +031700******************************************************** IF1264.2 +031800* * IF1264.2 +031900* Intrinsic Function Tests IF126A - NUMVAL-C * IF1264.2 +032000* * IF1264.2 +032100******************************************************** IF1264.2 +032200 SECT-IF126A SECTION. IF1264.2 +032300 F-NUMVALC-INFO. IF1264.2 +032400 MOVE "See ref. A-59 2.30" TO ANSI-REFERENCE. IF1264.2 +032500 MOVE "NUMVAL-C Function" TO FEATURE. IF1264.2 +032600*****************TEST (a) ****************************** IF1264.2 +032700 F-NUMVALC-01. IF1264.2 +032800 MOVE ZERO TO TEMP. IF1264.2 +032900 F-NUMVALC-TEST-01. IF1264.2 +033000 COMPUTE TEMP = FUNCTION NUMVAL-C ("9"). IF1264.2 +033100 IF TEMP = 9 THEN IF1264.2 +033200 PERFORM PASS IF1264.2 +033300 ELSE IF1264.2 +033400 MOVE 9 TO CORRECT-N IF1264.2 +033500 MOVE TEMP TO COMPUTED-N IF1264.2 +033600 PERFORM FAIL. IF1264.2 +033700 GO TO F-NUMVALC-WRITE-01. IF1264.2 +033800 F-NUMVALC-DELETE-01. IF1264.2 +033900 PERFORM DE-LETE. IF1264.2 +034000 GO TO F-NUMVALC-WRITE-01. IF1264.2 +034100 F-NUMVALC-WRITE-01. IF1264.2 +034200 MOVE "F-NUMVALC-01" TO PAR-NAME. IF1264.2 +034300 PERFORM PRINT-DETAIL. IF1264.2 +034400*****************TEST (b) ******************************* IF1264.2 +034500 F-NUMVALC-02. IF1264.2 +034600 MOVE 77 TO TEMP. IF1264.2 +034700 F-NUMVALC-TEST-02. IF1264.2 +034800 EVALUATE FUNCTION NUMVAL-C (B) IF1264.2 +034900 ALSO ( TEMP + 96 ) * 2 IF1264.2 +035000 WHEN 203 IF1264.2 +035100 ALSO 346 IF1264.2 +035200 PERFORM PASS IF1264.2 +035300 GO TO F-NUMVALC-WRITE-02. IF1264.2 +035400 PERFORM FAIL. IF1264.2 +035500 GO TO F-NUMVALC-WRITE-02. IF1264.2 +035600 F-NUMVALC-DELETE-02. IF1264.2 +035700 PERFORM DE-LETE. IF1264.2 +035800 GO TO F-NUMVALC-WRITE-02. IF1264.2 +035900 F-NUMVALC-WRITE-02. IF1264.2 +036000 MOVE "F-NUMVALC-02" TO PAR-NAME. IF1264.2 +036100 PERFORM PRINT-DETAIL. IF1264.2 +036200*****************TEST (c) ****************************** IF1264.2 +036300 F-NUMVALC-TEST-03. IF1264.2 +036400 IF FUNCTION NUMVAL-C ("92,483") = 92483 THEN IF1264.2 +036500 PERFORM PASS IF1264.2 +036600 ELSE IF1264.2 +036700 PERFORM FAIL. IF1264.2 +036800 GO TO F-NUMVALC-WRITE-03. IF1264.2 +036900 F-NUMVALC-DELETE-03. IF1264.2 +037000 PERFORM DE-LETE. IF1264.2 +037100 GO TO F-NUMVALC-WRITE-03. IF1264.2 +037200 F-NUMVALC-WRITE-03. IF1264.2 +037300 MOVE "F-NUMVALC-03" TO PAR-NAME. IF1264.2 +037400 PERFORM PRINT-DETAIL. IF1264.2 +037500*****************TEST (d) ****************************** IF1264.2 +037600 F-NUMVALC-04. IF1264.2 +037700 MOVE ZERO TO TEMP. IF1264.2 +037800 F-NUMVALC-TEST-04. IF1264.2 +037900 COMPUTE TEMP = FUNCTION NUMVAL-C (C). IF1264.2 +038000 IF (TEMP >= 0.428991) AND IF1264.2 +038100 (TEMP <= 0.429009) IF1264.2 +038200 PERFORM PASS IF1264.2 +038300 ELSE IF1264.2 +038400 MOVE 0.429 TO CORRECT-N IF1264.2 +038500 MOVE TEMP TO COMPUTED-N IF1264.2 +038600 PERFORM FAIL. IF1264.2 +038700 GO TO F-NUMVALC-WRITE-04. IF1264.2 +038800 F-NUMVALC-DELETE-04. IF1264.2 +038900 PERFORM DE-LETE. IF1264.2 +039000 GO TO F-NUMVALC-WRITE-04. IF1264.2 +039100 F-NUMVALC-WRITE-04. IF1264.2 +039200 MOVE "F-NUMVALC-04" TO PAR-NAME. IF1264.2 +039300 PERFORM PRINT-DETAIL. IF1264.2 +039400*****************TEST (e) ****************************** IF1264.2 +039500 F-NUMVALC-05. IF1264.2 +039600 MOVE ZERO TO TEMP. IF1264.2 +039700 F-NUMVALC-TEST-05. IF1264.2 +039800 COMPUTE TEMP = FUNCTION NUMVAL-C ("385.93"). IF1264.2 +039900 IF (TEMP >= 385.922) AND IF1264.2 +040000 (TEMP <= 385.938) IF1264.2 +040100 PERFORM PASS IF1264.2 +040200 ELSE IF1264.2 +040300 MOVE 385.93 TO CORRECT-N IF1264.2 +040400 MOVE TEMP TO COMPUTED-N IF1264.2 +040500 PERFORM FAIL. IF1264.2 +040600 GO TO F-NUMVALC-WRITE-05. IF1264.2 +040700 F-NUMVALC-DELETE-05. IF1264.2 +040800 PERFORM DE-LETE. IF1264.2 +040900 GO TO F-NUMVALC-WRITE-05. IF1264.2 +041000 F-NUMVALC-WRITE-05. IF1264.2 +041100 MOVE "F-NUMVALC-05" TO PAR-NAME. IF1264.2 +041200 PERFORM PRINT-DETAIL. IF1264.2 +041300*****************TEST (f) ****************************** IF1264.2 +041400 F-NUMVALC-06. IF1264.2 +041500 MOVE ZERO TO TEMP. IF1264.2 +041600 F-NUMVALC-TEST-06. IF1264.2 +041700 COMPUTE TEMP = FUNCTION NUMVAL-C (J). IF1264.2 +041800 IF (TEMP >= 8848.76) AND IF1264.2 +041900 (TEMP <= 8849.11) IF1264.2 +042000 PERFORM PASS IF1264.2 +042100 ELSE IF1264.2 +042200 MOVE 8848.934 TO CORRECT-N IF1264.2 +042300 MOVE TEMP TO COMPUTED-N IF1264.2 +042400 PERFORM FAIL. IF1264.2 +042500 GO TO F-NUMVALC-WRITE-06. IF1264.2 +042600 F-NUMVALC-DELETE-06. IF1264.2 +042700 PERFORM DE-LETE. IF1264.2 +042800 GO TO F-NUMVALC-WRITE-06. IF1264.2 +042900 F-NUMVALC-WRITE-06. IF1264.2 +043000 MOVE "F-NUMVALC-06" TO PAR-NAME. IF1264.2 +043100 PERFORM PRINT-DETAIL. IF1264.2 +043200*****************TEST (g) ****************************** IF1264.2 +043300 F-NUMVALC-07. IF1264.2 +043400 MOVE ZERO TO TEMP. IF1264.2 +043500 F-NUMVALC-TEST-07. IF1264.2 +043600 COMPUTE TEMP = FUNCTION NUMVAL-C ("+394.2 "). IF1264.2 +043700 IF (TEMP >= 394.192) AND IF1264.2 +043800 (TEMP <= 394.208) IF1264.2 +043900 PERFORM PASS IF1264.2 +044000 ELSE IF1264.2 +044100 MOVE 394.2 TO CORRECT-N IF1264.2 +044200 MOVE TEMP TO COMPUTED-N IF1264.2 +044300 PERFORM FAIL. IF1264.2 +044400 GO TO F-NUMVALC-WRITE-07. IF1264.2 +044500 F-NUMVALC-DELETE-07. IF1264.2 +044600 PERFORM DE-LETE. IF1264.2 +044700 GO TO F-NUMVALC-WRITE-07. IF1264.2 +044800 F-NUMVALC-WRITE-07. IF1264.2 +044900 MOVE "F-NUMVALC-07" TO PAR-NAME. IF1264.2 +045000 PERFORM PRINT-DETAIL. IF1264.2 +045100*****************TEST (h) ****************************** IF1264.2 +045200 F-NUMVALC-08. IF1264.2 +045300 MOVE ZERO TO TEMP. IF1264.2 +045400 F-NUMVALC-TEST-08. IF1264.2 +045500 COMPUTE TEMP = FUNCTION NUMVAL-C (" 939.83"). IF1264.2 +045600 IF (TEMP >= 939.811) AND IF1264.2 +045700 (TEMP <= 939.849) IF1264.2 +045800 PERFORM PASS IF1264.2 +045900 ELSE IF1264.2 +046000 MOVE 939.83 TO CORRECT-N IF1264.2 +046100 MOVE TEMP TO COMPUTED-N IF1264.2 +046200 PERFORM FAIL. IF1264.2 +046300 GO TO F-NUMVALC-WRITE-08. IF1264.2 +046400 F-NUMVALC-DELETE-08. IF1264.2 +046500 PERFORM DE-LETE. IF1264.2 +046600 GO TO F-NUMVALC-WRITE-08. IF1264.2 +046700 F-NUMVALC-WRITE-08. IF1264.2 +046800 MOVE "F-NUMVALC-08" TO PAR-NAME. IF1264.2 +046900 PERFORM PRINT-DETAIL. IF1264.2 +047000*****************TEST (i) ****************************** IF1264.2 +047100 F-NUMVALC-09. IF1264.2 +047200 MOVE ZERO TO TEMP. IF1264.2 +047300 F-NUMVALC-TEST-09. IF1264.2 +047400 COMPUTE TEMP = FUNCTION NUMVAL-C (" - 4929.0323"). IF1264.2 +047500 IF (TEMP >= -4929.1309) AND IF1264.2 +047600 (TEMP <= -4928.9337) IF1264.2 +047700 PERFORM PASS IF1264.2 +047800 ELSE IF1264.2 +047900 MOVE -4929.0323 TO CORRECT-N IF1264.2 +048000 MOVE TEMP TO COMPUTED-N IF1264.2 +048100 PERFORM FAIL. IF1264.2 +048200 GO TO F-NUMVALC-WRITE-09. IF1264.2 +048300 F-NUMVALC-DELETE-09. IF1264.2 +048400 PERFORM DE-LETE. IF1264.2 +048500 GO TO F-NUMVALC-WRITE-09. IF1264.2 +048600 F-NUMVALC-WRITE-09. IF1264.2 +048700 MOVE "F-NUMVALC-09" TO PAR-NAME. IF1264.2 +048800 PERFORM PRINT-DETAIL. IF1264.2 +048900*****************TEST (j) ****************************** IF1264.2 +049000 F-NUMVALC-10. IF1264.2 +049100 MOVE ZERO TO TEMP. IF1264.2 +049200 F-NUMVALC-TEST-10. IF1264.2 +049300 COMPUTE TEMP = FUNCTION NUMVAL-C (K). IF1264.2 +049400 IF (TEMP >= 4825197.41) AND IF1264.2 +049500 (TEMP <= 4825390.43) IF1264.2 +049600 PERFORM PASS IF1264.2 +049700 ELSE IF1264.2 +049800 MOVE 4825293.92 TO CORRECT-N IF1264.2 +049900 MOVE TEMP TO COMPUTED-N IF1264.2 +050000 PERFORM FAIL. IF1264.2 +050100 GO TO F-NUMVALC-WRITE-10. IF1264.2 +050200 F-NUMVALC-DELETE-10. IF1264.2 +050300 PERFORM DE-LETE. IF1264.2 +050400 GO TO F-NUMVALC-WRITE-10. IF1264.2 +050500 F-NUMVALC-WRITE-10. IF1264.2 +050600 MOVE "F-NUMVALC-10" TO PAR-NAME. IF1264.2 +050700 PERFORM PRINT-DETAIL. IF1264.2 +050800*****************TEST (k) ****************************** IF1264.2 +050900 F-NUMVALC-11. IF1264.2 +051000 MOVE ZERO TO TEMP. IF1264.2 +051100 F-NUMVALC-TEST-11. IF1264.2 +051200 COMPUTE TEMP = FUNCTION NUMVAL-C (L). IF1264.2 +051300 IF (TEMP >= -5555.66) AND IF1264.2 +051400 (TEMP <= -5555.44) IF1264.2 +051500 PERFORM PASS IF1264.2 +051600 ELSE IF1264.2 +051700 MOVE -5555.55 TO CORRECT-N IF1264.2 +051800 MOVE TEMP TO COMPUTED-N IF1264.2 +051900 PERFORM FAIL. IF1264.2 +052000 GO TO F-NUMVALC-WRITE-11. IF1264.2 +052100 F-NUMVALC-DELETE-11. IF1264.2 +052200 PERFORM DE-LETE. IF1264.2 +052300 GO TO F-NUMVALC-WRITE-11. IF1264.2 +052400 F-NUMVALC-WRITE-11. IF1264.2 +052500 MOVE "F-NUMVALC-11" TO PAR-NAME. IF1264.2 +052600 PERFORM PRINT-DETAIL. IF1264.2 +052700*****************TEST (l) ****************************** IF1264.2 +052800 F-NUMVALC-12. IF1264.2 +052900 MOVE ZERO TO TEMP. IF1264.2 +053000 F-NUMVALC-TEST-12. IF1264.2 +053100 COMPUTE TEMP = FUNCTION NUMVAL-C ("82.9312+"). IF1264.2 +053200 IF (TEMP >= 82.9295) AND IF1264.2 +053300 (TEMP <= 82.9329) IF1264.2 +053400 PERFORM PASS IF1264.2 +053500 ELSE IF1264.2 +053600 MOVE 82.9312 TO CORRECT-N IF1264.2 +053700 MOVE TEMP TO COMPUTED-N IF1264.2 +053800 PERFORM FAIL. IF1264.2 +053900 GO TO F-NUMVALC-WRITE-12. IF1264.2 +054000 F-NUMVALC-DELETE-12. IF1264.2 +054100 PERFORM DE-LETE. IF1264.2 +054200 GO TO F-NUMVALC-WRITE-12. IF1264.2 +054300 F-NUMVALC-WRITE-12. IF1264.2 +054400 MOVE "F-NUMVALC-12" TO PAR-NAME. IF1264.2 +054500 PERFORM PRINT-DETAIL. IF1264.2 +054600*****************TEST (m) ****************************** IF1264.2 +054700 F-NUMVALC-13. IF1264.2 +054800 MOVE ZERO TO TEMP. IF1264.2 +054900 F-NUMVALC-TEST-13. IF1264.2 +055000 COMPUTE TEMP = FUNCTION NUMVAL-C (M). IF1264.2 +055100 IF (TEMP >= -5555.66) AND IF1264.2 +055200 (TEMP <= -5555.44) IF1264.2 +055300 PERFORM PASS IF1264.2 +055400 ELSE IF1264.2 +055500 MOVE -5555.55 TO CORRECT-N IF1264.2 +055600 MOVE TEMP TO COMPUTED-N IF1264.2 +055700 PERFORM FAIL. IF1264.2 +055800 GO TO F-NUMVALC-WRITE-13. IF1264.2 +055900 F-NUMVALC-DELETE-13. IF1264.2 +056000 PERFORM DE-LETE. IF1264.2 +056100 GO TO F-NUMVALC-WRITE-13. IF1264.2 +056200 F-NUMVALC-WRITE-13. IF1264.2 +056300 MOVE "F-NUMVALC-13" TO PAR-NAME. IF1264.2 +056400 PERFORM PRINT-DETAIL. IF1264.2 +056500*****************TEST (n) ****************************** IF1264.2 +056600 F-NUMVALC-14. IF1264.2 +056700 MOVE ZERO TO TEMP. IF1264.2 +056800 F-NUMVALC-TEST-14. IF1264.2 +056900 COMPUTE TEMP = FUNCTION NUMVAL-C (" 200.0002 - "). IF1264.2 +057000 IF (TEMP >= -200.0042) AND IF1264.2 +057100 (TEMP <= -199.9962) IF1264.2 +057200 PERFORM PASS IF1264.2 +057300 ELSE IF1264.2 +057400 MOVE -200.0002 TO CORRECT-N IF1264.2 +057500 MOVE TEMP TO COMPUTED-N IF1264.2 +057600 PERFORM FAIL. IF1264.2 +057700 GO TO F-NUMVALC-WRITE-14. IF1264.2 +057800 F-NUMVALC-DELETE-14. IF1264.2 +057900 PERFORM DE-LETE. IF1264.2 +058000 GO TO F-NUMVALC-WRITE-14. IF1264.2 +058100 F-NUMVALC-WRITE-14. IF1264.2 +058200 MOVE "F-NUMVALC-14" TO PAR-NAME. IF1264.2 +058300 PERFORM PRINT-DETAIL. IF1264.2 +058400*****************TEST (o) ****************************** IF1264.2 +058500 F-NUMVALC-15. IF1264.2 +058600 MOVE ZERO TO TEMP. IF1264.2 +058700 F-NUMVALC-TEST-15. IF1264.2 +058800 COMPUTE TEMP = FUNCTION NUMVAL-C (N). IF1264.2 +058900 IF (TEMP >= 77776.21) AND IF1264.2 +059000 (TEMP <= 77779.33) IF1264.2 +059100 PERFORM PASS IF1264.2 +059200 ELSE IF1264.2 +059300 MOVE 77777.77 TO CORRECT-N IF1264.2 +059400 MOVE TEMP TO COMPUTED-N IF1264.2 +059500 PERFORM FAIL. IF1264.2 +059600 GO TO F-NUMVALC-WRITE-15. IF1264.2 +059700 F-NUMVALC-DELETE-15. IF1264.2 +059800 PERFORM DE-LETE. IF1264.2 +059900 GO TO F-NUMVALC-WRITE-15. IF1264.2 +060000 F-NUMVALC-WRITE-15. IF1264.2 +060100 MOVE "F-NUMVALC-15" TO PAR-NAME. IF1264.2 +060200 PERFORM PRINT-DETAIL. IF1264.2 +060300*****************TEST (p) ****************************** IF1264.2 +060400 F-NUMVALC-16. IF1264.2 +060500 MOVE ZERO TO TEMP. IF1264.2 +060600 F-NUMVALC-TEST-16. IF1264.2 +060700 COMPUTE TEMP = FUNCTION NUMVAL-C ("$5", "$"). IF1264.2 +060800 IF TEMP = 5 THEN IF1264.2 +060900 PERFORM PASS IF1264.2 +061000 ELSE IF1264.2 +061100 MOVE 5 TO CORRECT-N IF1264.2 +061200 MOVE TEMP TO COMPUTED-N IF1264.2 +061300 PERFORM FAIL. IF1264.2 +061400 GO TO F-NUMVALC-WRITE-16. IF1264.2 +061500 F-NUMVALC-DELETE-16. IF1264.2 +061600 PERFORM DE-LETE. IF1264.2 +061700 GO TO F-NUMVALC-WRITE-16. IF1264.2 +061800 F-NUMVALC-WRITE-16. IF1264.2 +061900 MOVE "F-NUMVALC-16" TO PAR-NAME. IF1264.2 +062000 PERFORM PRINT-DETAIL. IF1264.2 +062100*****************TEST (q) ****************************** IF1264.2 +062200 F-NUMVALC-17. IF1264.2 +062300 MOVE ZERO TO TEMP. IF1264.2 +062400 F-NUMVALC-TEST-17. IF1264.2 +062500 COMPUTE TEMP = FUNCTION NUMVAL-C (O, "$"). IF1264.2 +062600 IF TEMP = 33 THEN IF1264.2 +062700 PERFORM PASS IF1264.2 +062800 ELSE IF1264.2 +062900 MOVE 33 TO CORRECT-N IF1264.2 +063000 MOVE TEMP TO COMPUTED-N IF1264.2 +063100 PERFORM FAIL. IF1264.2 +063200 GO TO F-NUMVALC-WRITE-17. IF1264.2 +063300 F-NUMVALC-DELETE-17. IF1264.2 +063400 PERFORM DE-LETE. IF1264.2 +063500 GO TO F-NUMVALC-WRITE-17. IF1264.2 +063600 F-NUMVALC-WRITE-17. IF1264.2 +063700 MOVE "F-NUMVALC-17" TO PAR-NAME. IF1264.2 +063800 PERFORM PRINT-DETAIL. IF1264.2 +063900*****************TEST (r) ****************************** IF1264.2 +064000 F-NUMVALC-18. IF1264.2 +064100 MOVE ZERO TO TEMP. IF1264.2 +064200 F-NUMVALC-TEST-18. IF1264.2 +064300 COMPUTE TEMP = FUNCTION NUMVAL-C ("$93,021", "$"). IF1264.2 +064400 IF TEMP = 93021 THEN IF1264.2 +064500 PERFORM PASS IF1264.2 +064600 ELSE IF1264.2 +064700 MOVE 93021 TO CORRECT-N IF1264.2 +064800 MOVE TEMP TO COMPUTED-N IF1264.2 +064900 PERFORM FAIL. IF1264.2 +065000 GO TO F-NUMVALC-WRITE-18. IF1264.2 +065100 F-NUMVALC-DELETE-18. IF1264.2 +065200 PERFORM DE-LETE. IF1264.2 +065300 GO TO F-NUMVALC-WRITE-18. IF1264.2 +065400 F-NUMVALC-WRITE-18. IF1264.2 +065500 MOVE "F-NUMVALC-18" TO PAR-NAME. IF1264.2 +065600 PERFORM PRINT-DETAIL. IF1264.2 +065700*****************TEST (t) ****************************** IF1264.2 +065800 F-NUMVALC-20. IF1264.2 +065900 MOVE ZERO TO TEMP. IF1264.2 +066000 F-NUMVALC-TEST-20. IF1264.2 +066100 COMPUTE TEMP = FUNCTION NUMVAL-C ("$924.93", "$"). IF1264.2 +066200 IF (TEMP >= 924.912) AND IF1264.2 +066300 (TEMP <= 924.948) IF1264.2 +066400 PERFORM PASS IF1264.2 +066500 ELSE IF1264.2 +066600 MOVE 924.93 TO CORRECT-N IF1264.2 +066700 MOVE TEMP TO COMPUTED-N IF1264.2 +066800 PERFORM FAIL. IF1264.2 +066900 GO TO F-NUMVALC-WRITE-20. IF1264.2 +067000 F-NUMVALC-DELETE-20. IF1264.2 +067100 PERFORM DE-LETE. IF1264.2 +067200 GO TO F-NUMVALC-WRITE-20. IF1264.2 +067300 F-NUMVALC-WRITE-20. IF1264.2 +067400 MOVE "F-NUMVALC-20" TO PAR-NAME. IF1264.2 +067500 PERFORM PRINT-DETAIL. IF1264.2 +067600*****************TEST (u) ****************************** IF1264.2 +067700 F-NUMVALC-21. IF1264.2 +067800 MOVE ZERO TO TEMP. IF1264.2 +067900 F-NUMVALC-TEST-21. IF1264.2 +068000 COMPUTE TEMP = FUNCTION NUMVAL-C (Q, "$"). IF1264.2 +068100 IF TEMP = 4000 THEN IF1264.2 +068200 PERFORM PASS IF1264.2 +068300 ELSE IF1264.2 +068400 MOVE 4000 TO CORRECT-N IF1264.2 +068500 MOVE TEMP TO COMPUTED-N IF1264.2 +068600 PERFORM FAIL. IF1264.2 +068700 GO TO F-NUMVALC-WRITE-21. IF1264.2 +068800 F-NUMVALC-DELETE-21. IF1264.2 +068900 PERFORM DE-LETE. IF1264.2 +069000 GO TO F-NUMVALC-WRITE-21. IF1264.2 +069100 F-NUMVALC-WRITE-21. IF1264.2 +069200 MOVE "F-NUMVALC-21" TO PAR-NAME. IF1264.2 +069300 PERFORM PRINT-DETAIL. IF1264.2 +069400*****************TEST (v) ****************************** IF1264.2 +069500 F-NUMVALC-22. IF1264.2 +069600 MOVE ZERO TO TEMP. IF1264.2 +069700 F-NUMVALC-TEST-22. IF1264.2 +069800 COMPUTE TEMP = FUNCTION NUMVAL-C ("-$34.03", "$"). IF1264.2 +069900 IF (TEMP >= -34.0307) AND IF1264.2 +070000 (TEMP <= -34.0293) IF1264.2 +070100 PERFORM PASS IF1264.2 +070200 ELSE IF1264.2 +070300 MOVE -34.03 TO CORRECT-N IF1264.2 +070400 MOVE TEMP TO COMPUTED-N IF1264.2 +070500 PERFORM FAIL. IF1264.2 +070600 GO TO F-NUMVALC-WRITE-22. IF1264.2 +070700 F-NUMVALC-DELETE-22. IF1264.2 +070800 PERFORM DE-LETE. IF1264.2 +070900 GO TO F-NUMVALC-WRITE-22. IF1264.2 +071000 F-NUMVALC-WRITE-22. IF1264.2 +071100 MOVE "F-NUMVALC-22" TO PAR-NAME. IF1264.2 +071200 PERFORM PRINT-DETAIL. IF1264.2 +071300*****************TEST (w) ****************************** IF1264.2 +071400 F-NUMVALC-23. IF1264.2 +071500 MOVE ZERO TO TEMP. IF1264.2 +071600 F-NUMVALC-TEST-23. IF1264.2 +071700 COMPUTE TEMP = FUNCTION NUMVAL-C (R, "$"). IF1264.2 +071800 IF (TEMP >= 999980.5) AND IF1264.2 +071900 (TEMP <= 1000020.5) IF1264.2 +072000 PERFORM PASS IF1264.2 +072100 ELSE IF1264.2 +072200 MOVE 1000000.5 TO CORRECT-N IF1264.2 +072300 MOVE TEMP TO COMPUTED-N IF1264.2 +072400 PERFORM FAIL. IF1264.2 +072500 GO TO F-NUMVALC-WRITE-23. IF1264.2 +072600 F-NUMVALC-DELETE-23. IF1264.2 +072700 PERFORM DE-LETE. IF1264.2 +072800 GO TO F-NUMVALC-WRITE-23. IF1264.2 +072900 F-NUMVALC-WRITE-23. IF1264.2 +073000 MOVE "F-NUMVALC-23" TO PAR-NAME. IF1264.2 +073100 PERFORM PRINT-DETAIL. IF1264.2 +073200*****************TEST (x) ****************************** IF1264.2 +073300 F-NUMVALC-24. IF1264.2 +073400 MOVE ZERO TO TEMP. IF1264.2 +073500 F-NUMVALC-TEST-24. IF1264.2 +073600 COMPUTE TEMP = FUNCTION NUMVAL-C (" $ 89.01", "$"). IF1264.2 +073700 IF (TEMP >= 89.0082) AND IF1264.2 +073800 (TEMP <= 89.0118) IF1264.2 +073900 PERFORM PASS IF1264.2 +074000 ELSE IF1264.2 +074100 MOVE 89.01 TO CORRECT-N IF1264.2 +074200 MOVE TEMP TO COMPUTED-N IF1264.2 +074300 PERFORM FAIL. IF1264.2 +074400 GO TO F-NUMVALC-WRITE-24. IF1264.2 +074500 F-NUMVALC-DELETE-24. IF1264.2 +074600 PERFORM DE-LETE. IF1264.2 +074700 GO TO F-NUMVALC-WRITE-24. IF1264.2 +074800 F-NUMVALC-WRITE-24. IF1264.2 +074900 MOVE "F-NUMVALC-24" TO PAR-NAME. IF1264.2 +075000 PERFORM PRINT-DETAIL. IF1264.2 +075100*****************TEST (y) ****************************** IF1264.2 +075200 F-NUMVALC-25. IF1264.2 +075300 MOVE ZERO TO TEMP. IF1264.2 +075400 F-NUMVALC-TEST-25. IF1264.2 +075500 COMPUTE TEMP = FUNCTION NUMVAL-C (S, "$"). IF1264.2 +075600 IF (TEMP >= 3900.13) AND IF1264.2 +075700 (TEMP <= 3900.29) IF1264.2 +075800 PERFORM PASS IF1264.2 +075900 ELSE IF1264.2 +076000 MOVE 3900.21 TO CORRECT-N IF1264.2 +076100 MOVE TEMP TO COMPUTED-N IF1264.2 +076200 PERFORM FAIL. IF1264.2 +076300 GO TO F-NUMVALC-WRITE-25. IF1264.2 +076400 F-NUMVALC-DELETE-25. IF1264.2 +076500 PERFORM DE-LETE. IF1264.2 +076600 GO TO F-NUMVALC-WRITE-25. IF1264.2 +076700 F-NUMVALC-WRITE-25. IF1264.2 +076800 MOVE "F-NUMVALC-25" TO PAR-NAME. IF1264.2 +076900 PERFORM PRINT-DETAIL. IF1264.2 +077000*****************TEST (z) ****************************** IF1264.2 +077100 F-NUMVALC-26. IF1264.2 +077200 MOVE ZERO TO TEMP. IF1264.2 +077300 F-NUMVALC-TEST-26. IF1264.2 +077400 COMPUTE TEMP = FUNCTION NUMVAL-C ("- $ 890.21", "$"). IF1264.2 +077500 IF (TEMP >= -890.228) AND IF1264.2 +077600 (TEMP <= -890.192) IF1264.2 +077700 PERFORM PASS IF1264.2 +077800 ELSE IF1264.2 +077900 MOVE -890.21 TO CORRECT-N IF1264.2 +078000 MOVE TEMP TO COMPUTED-N IF1264.2 +078100 PERFORM FAIL. IF1264.2 +078200 GO TO F-NUMVALC-WRITE-26. IF1264.2 +078300 F-NUMVALC-DELETE-26. IF1264.2 +078400 PERFORM DE-LETE. IF1264.2 +078500 GO TO F-NUMVALC-WRITE-26. IF1264.2 +078600 F-NUMVALC-WRITE-26. IF1264.2 +078700 MOVE "F-NUMVALC-26" TO PAR-NAME. IF1264.2 +078800 PERFORM PRINT-DETAIL. IF1264.2 +078900*****************TEST (aa) ****************************** IF1264.2 +079000 F-NUMVALC-27. IF1264.2 +079100 MOVE ZERO TO TEMP. IF1264.2 +079200 F-NUMVALC-TEST-27. IF1264.2 +079300 COMPUTE TEMP = FUNCTION NUMVAL-C (T, "$"). IF1264.2 +079400 IF (TEMP >= 9000.81) AND IF1264.2 +079500 (TEMP <= 9001.17) IF1264.2 +079600 PERFORM PASS IF1264.2 +079700 ELSE IF1264.2 +079800 MOVE 9000.99 TO CORRECT-N IF1264.2 +079900 MOVE TEMP TO COMPUTED-N IF1264.2 +080000 PERFORM FAIL. IF1264.2 +080100 GO TO F-NUMVALC-WRITE-27. IF1264.2 +080200 F-NUMVALC-DELETE-27. IF1264.2 +080300 PERFORM DE-LETE. IF1264.2 +080400 GO TO F-NUMVALC-WRITE-27. IF1264.2 +080500 F-NUMVALC-WRITE-27. IF1264.2 +080600 MOVE "F-NUMVALC-27" TO PAR-NAME. IF1264.2 +080700 PERFORM PRINT-DETAIL. IF1264.2 +080800*****************TEST (bb) ****************************** IF1264.2 +080900 F-NUMVALC-28. IF1264.2 +081000 MOVE ZERO TO TEMP. IF1264.2 +081100 F-NUMVALC-TEST-28. IF1264.2 +081200 COMPUTE TEMP = FUNCTION NUMVAL-C (" $ 90.54 - ", "$"). IF1264.2 +081300 IF (TEMP >= -90.5418) AND IF1264.2 +081400 (TEMP <= -90.5382) IF1264.2 +081500 PERFORM PASS IF1264.2 +081600 ELSE IF1264.2 +081700 MOVE -90.54 TO CORRECT-N IF1264.2 +081800 MOVE TEMP TO COMPUTED-N IF1264.2 +081900 PERFORM FAIL. IF1264.2 +082000 GO TO F-NUMVALC-WRITE-28. IF1264.2 +082100 F-NUMVALC-DELETE-28. IF1264.2 +082200 PERFORM DE-LETE. IF1264.2 +082300 GO TO F-NUMVALC-WRITE-28. IF1264.2 +082400 F-NUMVALC-WRITE-28. IF1264.2 +082500 MOVE "F-NUMVALC-28" TO PAR-NAME. IF1264.2 +082600 PERFORM PRINT-DETAIL. IF1264.2 +082700*****************TEST (cc) ****************************** IF1264.2 +082800 F-NUMVALC-29. IF1264.2 +082900 MOVE ZERO TO TEMP. IF1264.2 +083000 F-NUMVALC-TEST-29. IF1264.2 +083100 COMPUTE TEMP = FUNCTION NUMVAL-C (U, "$"). IF1264.2 +083200 IF (TEMP >= 3890.12) AND IF1264.2 +083300 (TEMP <= 3890.28) IF1264.2 +083400 PERFORM PASS IF1264.2 +083500 ELSE IF1264.2 +083600 MOVE 3890.2 TO CORRECT-N IF1264.2 +083700 MOVE TEMP TO COMPUTED-N IF1264.2 +083800 PERFORM FAIL. IF1264.2 +083900 GO TO F-NUMVALC-WRITE-29. IF1264.2 +084000 F-NUMVALC-DELETE-29. IF1264.2 +084100 PERFORM DE-LETE. IF1264.2 +084200 GO TO F-NUMVALC-WRITE-29. IF1264.2 +084300 F-NUMVALC-WRITE-29. IF1264.2 +084400 MOVE "F-NUMVALC-29" TO PAR-NAME. IF1264.2 +084500 PERFORM PRINT-DETAIL. IF1264.2 +084600*****************TEST (dd) ****************************** IF1264.2 +084700 F-NUMVALC-30. IF1264.2 +084800 MOVE ZERO TO TEMP. IF1264.2 +084900 F-NUMVALC-TEST-30. IF1264.2 +085000 COMPUTE TEMP = FUNCTION NUMVAL-C ("90") + 10. IF1264.2 +085100 IF TEMP = 100 THEN IF1264.2 +085200 PERFORM PASS IF1264.2 +085300 ELSE IF1264.2 +085400 MOVE 100 TO CORRECT-N IF1264.2 +085500 MOVE TEMP TO COMPUTED-N IF1264.2 +085600 PERFORM FAIL. IF1264.2 +085700 GO TO F-NUMVALC-WRITE-30. IF1264.2 +085800 F-NUMVALC-DELETE-30. IF1264.2 +085900 PERFORM DE-LETE. IF1264.2 +086000 GO TO F-NUMVALC-WRITE-30. IF1264.2 +086100 F-NUMVALC-WRITE-30. IF1264.2 +086200 MOVE "F-NUMVALC-30" TO PAR-NAME. IF1264.2 +086300 PERFORM PRINT-DETAIL. IF1264.2 +086400*****************TEST (ee) ****************************** IF1264.2 +086500 F-NUMVALC-31. IF1264.2 +086600 MOVE ZERO TO TEMP. IF1264.2 +086700 F-NUMVALC-TEST-31. IF1264.2 +086800 COMPUTE TEMP = FUNCTION NUMVAL-C ("2") + IF1264.2 +086900 FUNCTION NUMVAL-C ("8"). IF1264.2 +087000 IF TEMP = 10 THEN IF1264.2 +087100 PERFORM PASS IF1264.2 +087200 ELSE IF1264.2 +087300 MOVE 10 TO CORRECT-N IF1264.2 +087400 MOVE TEMP TO COMPUTED-N IF1264.2 +087500 PERFORM FAIL. IF1264.2 +087600 GO TO F-NUMVALC-WRITE-31. IF1264.2 +087700 F-NUMVALC-DELETE-31. IF1264.2 +087800 PERFORM DE-LETE. IF1264.2 +087900 GO TO F-NUMVALC-WRITE-31. IF1264.2 +088000 F-NUMVALC-WRITE-31. IF1264.2 +088100 MOVE "F-NUMVALC-31" TO PAR-NAME. IF1264.2 +088200 PERFORM PRINT-DETAIL. IF1264.2 +088300*******************END OF TESTS************************** IF1264.2 +088400 CCVS-EXIT SECTION. IF1264.2 +088500 CCVS-999999. IF1264.2 +088600 GO TO CLOSE-FILES. IF1264.2 diff --git a/tests/cobol85/IF/IF127A.CBL b/tests/cobol85/IF/IF127A.CBL new file mode 100755 index 00000000..6d4918be --- /dev/null +++ b/tests/cobol85/IF/IF127A.CBL @@ -0,0 +1,505 @@ +000100 IDENTIFICATION DIVISION. IF1274.2 +000200 PROGRAM-ID. IF1274.2 +000300 IF127A. IF1274.2 +000400 IF1274.2 +000500*********************************************************** IF1274.2 +000600* * IF1274.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1274.2 +000800* It contains tests for the Intrinsic Function ORD. * IF1274.2 +000900* * IF1274.2 +001000* * IF1274.2 +001100*********************************************************** IF1274.2 +001200 ENVIRONMENT DIVISION. IF1274.2 +001300 CONFIGURATION SECTION. IF1274.2 +001400 SOURCE-COMPUTER. IF1274.2 +001500 Linux. IF1274.2 +001600 OBJECT-COMPUTER. IF1274.2 +001700 Linux IF1274.2 +001800 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1274.2 +001900 SPECIAL-NAMES. IF1274.2 +002000 ALPHABET PRG-COLL-SEQ IS IF1274.2 +002100 STANDARD-2. IF1274.2 +002200 INPUT-OUTPUT SECTION. IF1274.2 +002300 FILE-CONTROL. IF1274.2 +002400 SELECT PRINT-FILE ASSIGN TO IF1274.2 +002500 "report.log". IF1274.2 +002600 DATA DIVISION. IF1274.2 +002700 FILE SECTION. IF1274.2 +002800 FD PRINT-FILE. IF1274.2 +002900 01 PRINT-REC PICTURE X(120). IF1274.2 +003000 01 DUMMY-RECORD PICTURE X(120). IF1274.2 +003100 WORKING-STORAGE SECTION. IF1274.2 +003200*********************************************************** IF1274.2 +003300* Variables specific to the Intrinsic Function Test IF127A* IF1274.2 +003400*********************************************************** IF1274.2 +003500 01 A PIC X VALUE "F". IF1274.2 +003600 01 B PIC X VALUE "d". IF1274.2 +003700 01 C PIC X VALUE "3". IF1274.2 +003800 01 ARG1 PIC X VALUE "A". IF1274.2 +003900 01 TEMP PIC S9(10). IF1274.2 +004000 01 WS-INT PIC S9(10). IF1274.2 +004100* IF1274.2 +004200********************************************************** IF1274.2 +004300* IF1274.2 +004400 01 TEST-RESULTS. IF1274.2 +004500 02 FILLER PIC X VALUE SPACE. IF1274.2 +004600 02 FEATURE PIC X(20) VALUE SPACE. IF1274.2 +004700 02 FILLER PIC X VALUE SPACE. IF1274.2 +004800 02 P-OR-F PIC X(5) VALUE SPACE. IF1274.2 +004900 02 FILLER PIC X VALUE SPACE. IF1274.2 +005000 02 PAR-NAME. IF1274.2 +005100 03 FILLER PIC X(19) VALUE SPACE. IF1274.2 +005200 03 PARDOT-X PIC X VALUE SPACE. IF1274.2 +005300 03 DOTVALUE PIC 99 VALUE ZERO. IF1274.2 +005400 02 FILLER PIC X(8) VALUE SPACE. IF1274.2 +005500 02 RE-MARK PIC X(61). IF1274.2 +005600 01 TEST-COMPUTED. IF1274.2 +005700 02 FILLER PIC X(30) VALUE SPACE. IF1274.2 +005800 02 FILLER PIC X(17) VALUE IF1274.2 +005900 " COMPUTED=". IF1274.2 +006000 02 COMPUTED-X. IF1274.2 +006100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1274.2 +006200 03 COMPUTED-N REDEFINES COMPUTED-A IF1274.2 +006300 PIC -9(9).9(9). IF1274.2 +006400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1274.2 +006500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1274.2 +006600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1274.2 +006700 03 CM-18V0 REDEFINES COMPUTED-A. IF1274.2 +006800 04 COMPUTED-18V0 PIC -9(18). IF1274.2 +006900 04 FILLER PIC X. IF1274.2 +007000 03 FILLER PIC X(50) VALUE SPACE. IF1274.2 +007100 01 TEST-CORRECT. IF1274.2 +007200 02 FILLER PIC X(30) VALUE SPACE. IF1274.2 +007300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1274.2 +007400 02 CORRECT-X. IF1274.2 +007500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1274.2 +007600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1274.2 +007700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1274.2 +007800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1274.2 +007900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1274.2 +008000 03 CR-18V0 REDEFINES CORRECT-A. IF1274.2 +008100 04 CORRECT-18V0 PIC -9(18). IF1274.2 +008200 04 FILLER PIC X. IF1274.2 +008300 03 FILLER PIC X(2) VALUE SPACE. IF1274.2 +008400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1274.2 +008500 01 TEST-CORRECT-MIN. IF1274.2 +008600 02 FILLER PIC X(30) VALUE SPACE. IF1274.2 +008700 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1274.2 +008800 02 CORRECTMI-X. IF1274.2 +008900 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1274.2 +009000 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1274.2 +009100 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1274.2 +009200 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1274.2 +009300 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1274.2 +009400 03 CR-18V0 REDEFINES CORRECTMI-A. IF1274.2 +009500 04 CORRECTMI-18V0 PIC -9(18). IF1274.2 +009600 04 FILLER PIC X. IF1274.2 +009700 03 FILLER PIC X(2) VALUE SPACE. IF1274.2 +009800 03 FILLER PIC X(48) VALUE SPACE. IF1274.2 +009900 01 TEST-CORRECT-MAX. IF1274.2 +010000 02 FILLER PIC X(30) VALUE SPACE. IF1274.2 +010100 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1274.2 +010200 02 CORRECTMA-X. IF1274.2 +010300 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1274.2 +010400 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1274.2 +010500 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1274.2 +010600 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1274.2 +010700 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1274.2 +010800 03 CR-18V0 REDEFINES CORRECTMA-A. IF1274.2 +010900 04 CORRECTMA-18V0 PIC -9(18). IF1274.2 +011000 04 FILLER PIC X. IF1274.2 +011100 03 FILLER PIC X(2) VALUE SPACE. IF1274.2 +011200 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1274.2 +011300 01 CCVS-C-1. IF1274.2 +011400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1274.2 +011500- "SS PARAGRAPH-NAME IF1274.2 +011600- " REMARKS". IF1274.2 +011700 02 FILLER PIC X(20) VALUE SPACE. IF1274.2 +011800 01 CCVS-C-2. IF1274.2 +011900 02 FILLER PIC X VALUE SPACE. IF1274.2 +012000 02 FILLER PIC X(6) VALUE "TESTED". IF1274.2 +012100 02 FILLER PIC X(15) VALUE SPACE. IF1274.2 +012200 02 FILLER PIC X(4) VALUE "FAIL". IF1274.2 +012300 02 FILLER PIC X(94) VALUE SPACE. IF1274.2 +012400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1274.2 +012500 01 REC-CT PIC 99 VALUE ZERO. IF1274.2 +012600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1274.2 +012700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1274.2 +012800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1274.2 +012900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1274.2 +013000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1274.2 +013100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1274.2 +013200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1274.2 +013300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1274.2 +013400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1274.2 +013500 01 CCVS-H-1. IF1274.2 +013600 02 FILLER PIC X(39) VALUE SPACES. IF1274.2 +013700 02 FILLER PIC X(42) VALUE IF1274.2 +013800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1274.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1274.2 +014000 01 CCVS-H-2A. IF1274.2 +014100 02 FILLER PIC X(40) VALUE SPACE. IF1274.2 +014200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1274.2 +014300 02 FILLER PIC XXXX VALUE IF1274.2 +014400 "4.2 ". IF1274.2 +014500 02 FILLER PIC X(28) VALUE IF1274.2 +014600 " COPY - NOT FOR DISTRIBUTION". IF1274.2 +014700 02 FILLER PIC X(41) VALUE SPACE. IF1274.2 +014800 IF1274.2 +014900 01 CCVS-H-2B. IF1274.2 +015000 02 FILLER PIC X(15) VALUE IF1274.2 +015100 "TEST RESULT OF ". IF1274.2 +015200 02 TEST-ID PIC X(9). IF1274.2 +015300 02 FILLER PIC X(4) VALUE IF1274.2 +015400 " IN ". IF1274.2 +015500 02 FILLER PIC X(12) VALUE IF1274.2 +015600 " HIGH ". IF1274.2 +015700 02 FILLER PIC X(22) VALUE IF1274.2 +015800 " LEVEL VALIDATION FOR ". IF1274.2 +015900 02 FILLER PIC X(58) VALUE IF1274.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1274.2 +016100 01 CCVS-H-3. IF1274.2 +016200 02 FILLER PIC X(34) VALUE IF1274.2 +016300 " FOR OFFICIAL USE ONLY ". IF1274.2 +016400 02 FILLER PIC X(58) VALUE IF1274.2 +016500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1274.2 +016600 02 FILLER PIC X(28) VALUE IF1274.2 +016700 " COPYRIGHT 1985 ". IF1274.2 +016800 01 CCVS-E-1. IF1274.2 +016900 02 FILLER PIC X(52) VALUE SPACE. IF1274.2 +017000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1274.2 +017100 02 ID-AGAIN PIC X(9). IF1274.2 +017200 02 FILLER PIC X(45) VALUE SPACES. IF1274.2 +017300 01 CCVS-E-2. IF1274.2 +017400 02 FILLER PIC X(31) VALUE SPACE. IF1274.2 +017500 02 FILLER PIC X(21) VALUE SPACE. IF1274.2 +017600 02 CCVS-E-2-2. IF1274.2 +017700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1274.2 +017800 03 FILLER PIC X VALUE SPACE. IF1274.2 +017900 03 ENDER-DESC PIC X(44) VALUE IF1274.2 +018000 "ERRORS ENCOUNTERED". IF1274.2 +018100 01 CCVS-E-3. IF1274.2 +018200 02 FILLER PIC X(22) VALUE IF1274.2 +018300 " FOR OFFICIAL USE ONLY". IF1274.2 +018400 02 FILLER PIC X(12) VALUE SPACE. IF1274.2 +018500 02 FILLER PIC X(58) VALUE IF1274.2 +018600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1274.2 +018700 02 FILLER PIC X(13) VALUE SPACE. IF1274.2 +018800 02 FILLER PIC X(15) VALUE IF1274.2 +018900 " COPYRIGHT 1985". IF1274.2 +019000 01 CCVS-E-4. IF1274.2 +019100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1274.2 +019200 02 FILLER PIC X(4) VALUE " OF ". IF1274.2 +019300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1274.2 +019400 02 FILLER PIC X(40) VALUE IF1274.2 +019500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1274.2 +019600 01 XXINFO. IF1274.2 +019700 02 FILLER PIC X(19) VALUE IF1274.2 +019800 "*** INFORMATION ***". IF1274.2 +019900 02 INFO-TEXT. IF1274.2 +020000 04 FILLER PIC X(8) VALUE SPACE. IF1274.2 +020100 04 XXCOMPUTED PIC X(20). IF1274.2 +020200 04 FILLER PIC X(5) VALUE SPACE. IF1274.2 +020300 04 XXCORRECT PIC X(20). IF1274.2 +020400 02 INF-ANSI-REFERENCE PIC X(48). IF1274.2 +020500 01 HYPHEN-LINE. IF1274.2 +020600 02 FILLER PIC IS X VALUE IS SPACE. IF1274.2 +020700 02 FILLER PIC IS X(65) VALUE IS "************************IF1274.2 +020800- "*****************************************". IF1274.2 +020900 02 FILLER PIC IS X(54) VALUE IS "************************IF1274.2 +021000- "******************************". IF1274.2 +021100 01 CCVS-PGM-ID PIC X(9) VALUE IF1274.2 +021200 "IF127A". IF1274.2 +021300 PROCEDURE DIVISION. IF1274.2 +021400 CCVS1 SECTION. IF1274.2 +021500 OPEN-FILES. IF1274.2 +021600 OPEN OUTPUT PRINT-FILE. IF1274.2 +021700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1274.2 +021800 MOVE SPACE TO TEST-RESULTS. IF1274.2 +021900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1274.2 +022000 GO TO CCVS1-EXIT. IF1274.2 +022100 CLOSE-FILES. IF1274.2 +022200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1274.2 +022300 TERMINATE-CCVS. IF1274.2 +022400 STOP RUN. IF1274.2 +022500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1274.2 +022600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1274.2 +022700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1274.2 +022800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1274.2 +022900 MOVE "****TEST DELETED****" TO RE-MARK. IF1274.2 +023000 PRINT-DETAIL. IF1274.2 +023100 IF REC-CT NOT EQUAL TO ZERO IF1274.2 +023200 MOVE "." TO PARDOT-X IF1274.2 +023300 MOVE REC-CT TO DOTVALUE. IF1274.2 +023400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1274.2 +023500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1274.2 +023600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1274.2 +023700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1274.2 +023800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1274.2 +023900 MOVE SPACE TO CORRECT-X. IF1274.2 +024000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1274.2 +024100 MOVE SPACE TO RE-MARK. IF1274.2 +024200 HEAD-ROUTINE. IF1274.2 +024300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +024400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +024500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1274.2 +024600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1274.2 +024700 COLUMN-NAMES-ROUTINE. IF1274.2 +024800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +024900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +025100 END-ROUTINE. IF1274.2 +025200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1274.2 +025300 END-RTN-EXIT. IF1274.2 +025400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +025500 END-ROUTINE-1. IF1274.2 +025600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1274.2 +025700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1274.2 +025800 ADD PASS-COUNTER TO ERROR-HOLD. IF1274.2 +025900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1274.2 +026000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1274.2 +026100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1274.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1274.2 +026300 END-ROUTINE-12. IF1274.2 +026400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1274.2 +026500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1274.2 +026600 MOVE "NO " TO ERROR-TOTAL IF1274.2 +026700 ELSE IF1274.2 +026800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1274.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1274.2 +027000 PERFORM WRITE-LINE. IF1274.2 +027100 END-ROUTINE-13. IF1274.2 +027200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1274.2 +027300 MOVE "NO " TO ERROR-TOTAL ELSE IF1274.2 +027400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1274.2 +027500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1274.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +027700 IF INSPECT-COUNTER EQUAL TO ZERO IF1274.2 +027800 MOVE "NO " TO ERROR-TOTAL IF1274.2 +027900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1274.2 +028000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1274.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +028200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1274.2 +028300 WRITE-LINE. IF1274.2 +028400 ADD 1 TO RECORD-COUNT. IF1274.2 +028500 IF RECORD-COUNT GREATER 42 IF1274.2 +028600 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1274.2 +028700 MOVE SPACE TO DUMMY-RECORD IF1274.2 +028800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1274.2 +028900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1274.2 +029000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1274.2 +029100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1274.2 +029200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1274.2 +029300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1274.2 +029400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1274.2 +029500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1274.2 +029600 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1274.2 +029700 MOVE ZERO TO RECORD-COUNT. IF1274.2 +029800 PERFORM WRT-LN. IF1274.2 +029900 WRT-LN. IF1274.2 +030000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1274.2 +030100 MOVE SPACE TO DUMMY-RECORD. IF1274.2 +030200 BLANK-LINE-PRINT. IF1274.2 +030300 PERFORM WRT-LN. IF1274.2 +030400 FAIL-ROUTINE. IF1274.2 +030500 IF COMPUTED-X NOT EQUAL TO SPACE IF1274.2 +030600 GO TO FAIL-ROUTINE-WRITE. IF1274.2 +030700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1274.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1274.2 +030900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1274.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1274.2 +031200 GO TO FAIL-ROUTINE-EX. IF1274.2 +031300 FAIL-ROUTINE-WRITE. IF1274.2 +031400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1274.2 +031500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1274.2 +031600 CORMA-ANSI-REFERENCE. IF1274.2 +031700 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1274.2 +031800 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1274.2 +031900 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1274.2 +032000 ELSE IF1274.2 +032100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1274.2 +032200 PERFORM WRITE-LINE. IF1274.2 +032300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1274.2 +032400 FAIL-ROUTINE-EX. EXIT. IF1274.2 +032500 BAIL-OUT. IF1274.2 +032600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1274.2 +032700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1274.2 +032800 BAIL-OUT-WRITE. IF1274.2 +032900 MOVE CORRECT-A TO XXCORRECT. IF1274.2 +033000 MOVE COMPUTED-A TO XXCOMPUTED. IF1274.2 +033100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1274.2 +033200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1274.2 +033300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1274.2 +033400 BAIL-OUT-EX. EXIT. IF1274.2 +033500 CCVS1-EXIT. IF1274.2 +033600 EXIT. IF1274.2 +033700******************************************************** IF1274.2 +033800* * IF1274.2 +033900* Intrinsic Function Tests IF127A - ORD * IF1274.2 +034000* * IF1274.2 +034100******************************************************** IF1274.2 +034200 SECT-IF127A SECTION. IF1274.2 +034300 F-ORD-INFO. IF1274.2 +034400 MOVE "See ref. A-60 2.31" TO ANSI-REFERENCE. IF1274.2 +034500 MOVE "ORD Function" TO FEATURE. IF1274.2 +034600*****************TEST (a) ****************************** IF1274.2 +034700 F-ORD-01. IF1274.2 +034800 MOVE ZERO TO WS-INT. IF1274.2 +034900 F-ORD-TEST-01. IF1274.2 +035000 COMPUTE WS-INT = FUNCTION ORD("A"). IF1274.2 +035100 IF WS-INT = 66 THEN IF1274.2 +035200 PERFORM PASS IF1274.2 +035300 ELSE IF1274.2 +035400 MOVE 66 TO CORRECT-N IF1274.2 +035500 MOVE WS-INT TO COMPUTED-N IF1274.2 +035600 PERFORM FAIL. IF1274.2 +035700 GO TO F-ORD-WRITE-01. IF1274.2 +035800 F-ORD-DELETE-01. IF1274.2 +035900 PERFORM DE-LETE. IF1274.2 +036000 GO TO F-ORD-WRITE-01. IF1274.2 +036100 F-ORD-WRITE-01. IF1274.2 +036200 MOVE "F-ORD-01" TO PAR-NAME. IF1274.2 +036300 PERFORM PRINT-DETAIL. IF1274.2 +036400*****************TEST (b) ****************************** IF1274.2 +036500 F-ORD-TEST-02. IF1274.2 +036600 EVALUATE FUNCTION ORD("m") IF1274.2 +036700 WHEN 110 IF1274.2 +036800 PERFORM PASS IF1274.2 +036900 GO TO F-ORD-WRITE-02. IF1274.2 +037000 PERFORM FAIL. IF1274.2 +037100 GO TO F-ORD-WRITE-02. IF1274.2 +037200 F-ORD-DELETE-02. IF1274.2 +037300 PERFORM DE-LETE. IF1274.2 +037400 GO TO F-ORD-WRITE-02. IF1274.2 +037500 F-ORD-WRITE-02. IF1274.2 +037600 MOVE "F-ORD-02" TO PAR-NAME. IF1274.2 +037700 PERFORM PRINT-DETAIL. IF1274.2 +037800*****************TEST (c) ****************************** IF1274.2 +037900 F-ORD-03. IF1274.2 +038000 MOVE ZERO TO WS-INT. IF1274.2 +038100 F-ORD-TEST-03. IF1274.2 +038200 IF FUNCTION ORD("5") = 54 THEN IF1274.2 +038300 PERFORM PASS IF1274.2 +038400 ELSE IF1274.2 +038500 PERFORM FAIL. IF1274.2 +038600 GO TO F-ORD-WRITE-03. IF1274.2 +038700 F-ORD-DELETE-03. IF1274.2 +038800 PERFORM DE-LETE. IF1274.2 +038900 GO TO F-ORD-WRITE-03. IF1274.2 +039000 F-ORD-WRITE-03. IF1274.2 +039100 MOVE "F-ORD-03" TO PAR-NAME. IF1274.2 +039200 PERFORM PRINT-DETAIL. IF1274.2 +039300*****************TEST (d) ****************************** IF1274.2 +039400 F-ORD-04. IF1274.2 +039500 MOVE ZERO TO WS-INT. IF1274.2 +039600 F-ORD-TEST-04. IF1274.2 +039700 COMPUTE WS-INT = FUNCTION ORD(A). IF1274.2 +039800 IF WS-INT = 71 THEN IF1274.2 +039900 PERFORM PASS IF1274.2 +040000 ELSE IF1274.2 +040100 MOVE 71 TO CORRECT-N IF1274.2 +040200 MOVE WS-INT TO COMPUTED-N IF1274.2 +040300 PERFORM FAIL. IF1274.2 +040400 GO TO F-ORD-WRITE-04. IF1274.2 +040500 F-ORD-DELETE-04. IF1274.2 +040600 PERFORM DE-LETE. IF1274.2 +040700 GO TO F-ORD-WRITE-04. IF1274.2 +040800 F-ORD-WRITE-04. IF1274.2 +040900 MOVE "F-ORD-04" TO PAR-NAME. IF1274.2 +041000 PERFORM PRINT-DETAIL. IF1274.2 +041100*****************TEST (e) ****************************** IF1274.2 +041200 F-ORD-05. IF1274.2 +041300 MOVE ZERO TO WS-INT. IF1274.2 +041400 F-ORD-TEST-05. IF1274.2 +041500 COMPUTE WS-INT = FUNCTION ORD(B). IF1274.2 +041600 IF WS-INT = 101 THEN IF1274.2 +041700 PERFORM PASS IF1274.2 +041800 ELSE IF1274.2 +041900 MOVE 101 TO CORRECT-N IF1274.2 +042000 MOVE WS-INT TO COMPUTED-N IF1274.2 +042100 PERFORM FAIL. IF1274.2 +042200 GO TO F-ORD-WRITE-05. IF1274.2 +042300 F-ORD-DELETE-05. IF1274.2 +042400 PERFORM DE-LETE. IF1274.2 +042500 GO TO F-ORD-WRITE-05. IF1274.2 +042600 F-ORD-WRITE-05. IF1274.2 +042700 MOVE "F-ORD-05" TO PAR-NAME. IF1274.2 +042800 PERFORM PRINT-DETAIL. IF1274.2 +042900*****************TEST (f) ****************************** IF1274.2 +043000 F-ORD-06. IF1274.2 +043100 MOVE ZERO TO WS-INT. IF1274.2 +043200 F-ORD-TEST-06. IF1274.2 +043300 COMPUTE WS-INT = FUNCTION ORD(C). IF1274.2 +043400 IF WS-INT = 52 THEN IF1274.2 +043500 PERFORM PASS IF1274.2 +043600 ELSE IF1274.2 +043700 MOVE 52 TO CORRECT-N IF1274.2 +043800 MOVE WS-INT TO COMPUTED-N IF1274.2 +043900 PERFORM FAIL. IF1274.2 +044000 GO TO F-ORD-WRITE-06. IF1274.2 +044100 F-ORD-DELETE-06. IF1274.2 +044200 PERFORM DE-LETE. IF1274.2 +044300 GO TO F-ORD-WRITE-06. IF1274.2 +044400 F-ORD-WRITE-06. IF1274.2 +044500 MOVE "F-ORD-06" TO PAR-NAME. IF1274.2 +044600 PERFORM PRINT-DETAIL. IF1274.2 +044700*****************TEST (g) ****************************** IF1274.2 +044800 F-ORD-07. IF1274.2 +044900 MOVE ZERO TO WS-INT. IF1274.2 +045000 F-ORD-TEST-07. IF1274.2 +045100 COMPUTE WS-INT = FUNCTION ORD("g") + 1. IF1274.2 +045200 IF WS-INT = 105 THEN IF1274.2 +045300 PERFORM PASS IF1274.2 +045400 ELSE IF1274.2 +045500 MOVE 105 TO CORRECT-N IF1274.2 +045600 MOVE WS-INT TO COMPUTED-N IF1274.2 +045700 PERFORM FAIL. IF1274.2 +045800 GO TO F-ORD-WRITE-07. IF1274.2 +045900 F-ORD-DELETE-07. IF1274.2 +046000 PERFORM DE-LETE. IF1274.2 +046100 GO TO F-ORD-WRITE-07. IF1274.2 +046200 F-ORD-WRITE-07. IF1274.2 +046300 MOVE "F-ORD-07" TO PAR-NAME. IF1274.2 +046400 PERFORM PRINT-DETAIL. IF1274.2 +046500*****************TEST (h) ****************************** IF1274.2 +046600 F-ORD-08. IF1274.2 +046700 MOVE ZERO TO WS-INT. IF1274.2 +046800 F-ORD-TEST-08. IF1274.2 +046900 COMPUTE WS-INT = FUNCTION ORD("A") + IF1274.2 +047000 FUNCTION ORD(A). IF1274.2 +047100 IF WS-INT = 137 THEN IF1274.2 +047200 PERFORM PASS IF1274.2 +047300 ELSE IF1274.2 +047400 MOVE 137 TO CORRECT-N IF1274.2 +047500 MOVE WS-INT TO COMPUTED-N IF1274.2 +047600 PERFORM FAIL. IF1274.2 +047700 GO TO F-ORD-WRITE-08. IF1274.2 +047800 F-ORD-DELETE-08. IF1274.2 +047900 PERFORM DE-LETE. IF1274.2 +048000 GO TO F-ORD-WRITE-08. IF1274.2 +048100 F-ORD-WRITE-08. IF1274.2 +048200 MOVE "F-ORD-08" TO PAR-NAME. IF1274.2 +048300 PERFORM PRINT-DETAIL. IF1274.2 +048400*****************SPECIAL TEST 1****************************** IF1274.2 +048500 F-ORD-09. IF1274.2 +048600 PERFORM F-ORD-TEST-09 UNTIL FUNCTION ORD(ARG1) = 67. IF1274.2 +048700 IF ARG1 = "B" THEN IF1274.2 +048800 PERFORM PASS IF1274.2 +048900 ELSE IF1274.2 +049000 PERFORM FAIL. IF1274.2 +049100 GO TO F-ORD-WRITE-09. IF1274.2 +049200* IF1274.2 +049300 F-ORD-TEST-09. IF1274.2 +049400 MOVE "B" TO ARG1. IF1274.2 +049500* IF1274.2 +049600 F-ORD-DELETE-09. IF1274.2 +049700 PERFORM DE-LETE. IF1274.2 +049800 GO TO F-ORD-WRITE-09. IF1274.2 +049900 F-ORD-WRITE-09. IF1274.2 +050000 MOVE "F-ORD-09" TO PAR-NAME. IF1274.2 +050100 PERFORM PRINT-DETAIL. IF1274.2 +050200*******************END OF TESTS************************** IF1274.2 +050300 CCVS-EXIT SECTION. IF1274.2 +050400 CCVS-999999. IF1274.2 +050500 GO TO CLOSE-FILES. IF1274.2 diff --git a/tests/cobol85/IF/IF128A.CBL b/tests/cobol85/IF/IF128A.CBL new file mode 100755 index 00000000..1bc49825 --- /dev/null +++ b/tests/cobol85/IF/IF128A.CBL @@ -0,0 +1,647 @@ +000100 IDENTIFICATION DIVISION. IF1284.2 +000200 PROGRAM-ID. IF1284.2 +000300 IF128A. IF1284.2 +000400 IF1284.2 +000500*********************************************************** IF1284.2 +000600* * IF1284.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1284.2 +000800* It contains tests for the Intrinsic Function ORD-MAX. * IF1284.2 +000900* * IF1284.2 +001000* * IF1284.2 +001100*********************************************************** IF1284.2 +001200 ENVIRONMENT DIVISION. IF1284.2 +001300 CONFIGURATION SECTION. IF1284.2 +001400 SOURCE-COMPUTER. IF1284.2 +001500 Linux. IF1284.2 +001600 OBJECT-COMPUTER. IF1284.2 +001700 Linux IF1284.2 +001800 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1284.2 +001900 SPECIAL-NAMES. IF1284.2 +002000 ALPHABET PRG-COLL-SEQ IS IF1284.2 +002100 STANDARD-2. IF1284.2 +002200 INPUT-OUTPUT SECTION. IF1284.2 +002300 FILE-CONTROL. IF1284.2 +002400 SELECT PRINT-FILE ASSIGN TO IF1284.2 +002500 "report.log". IF1284.2 +002600 DATA DIVISION. IF1284.2 +002700 FILE SECTION. IF1284.2 +002800 FD PRINT-FILE. IF1284.2 +002900 01 PRINT-REC PICTURE X(120). IF1284.2 +003000 01 DUMMY-RECORD PICTURE X(120). IF1284.2 +003100 WORKING-STORAGE SECTION. IF1284.2 +003200*********************************************************** IF1284.2 +003300* Variables specific to the Intrinsic Function Test IF128A* IF1284.2 +003400*********************************************************** IF1284.2 +003500 01 A PIC S9(10) VALUE 5. IF1284.2 +003600 01 B PIC S9(10) VALUE 7. IF1284.2 +003700 01 C PIC S9(10) VALUE 4. IF1284.2 +003800 01 D PIC S9(10) VALUE 10. IF1284.2 +003900 01 I PIC X(4) VALUE "R". IF1284.2 +004000 01 J PIC X(4) VALUE "U". IF1284.2 +004100 01 P PIC S9(10) VALUE 1. IF1284.2 +004200 01 Q PIC S9(10) VALUE 3. IF1284.2 +004300 01 R PIC S9(10) VALUE 5. IF1284.2 +004400 01 ARG1 PIC S9(10) VALUE 1. IF1284.2 +004500 01 ARR VALUE "40537". IF1284.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1284.2 +004700 01 TEMP PIC S9(10). IF1284.2 +004800 01 WS-INT PIC S9(10). IF1284.2 +004900* IF1284.2 +005000********************************************************** IF1284.2 +005100* IF1284.2 +005200 01 TEST-RESULTS. IF1284.2 +005300 02 FILLER PIC X VALUE SPACE. IF1284.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. IF1284.2 +005500 02 FILLER PIC X VALUE SPACE. IF1284.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. IF1284.2 +005700 02 FILLER PIC X VALUE SPACE. IF1284.2 +005800 02 PAR-NAME. IF1284.2 +005900 03 FILLER PIC X(19) VALUE SPACE. IF1284.2 +006000 03 PARDOT-X PIC X VALUE SPACE. IF1284.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. IF1284.2 +006200 02 FILLER PIC X(8) VALUE SPACE. IF1284.2 +006300 02 RE-MARK PIC X(61). IF1284.2 +006400 01 TEST-COMPUTED. IF1284.2 +006500 02 FILLER PIC X(30) VALUE SPACE. IF1284.2 +006600 02 FILLER PIC X(17) VALUE IF1284.2 +006700 " COMPUTED=". IF1284.2 +006800 02 COMPUTED-X. IF1284.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1284.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A IF1284.2 +007100 PIC -9(9).9(9). IF1284.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1284.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1284.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1284.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. IF1284.2 +007600 04 COMPUTED-18V0 PIC -9(18). IF1284.2 +007700 04 FILLER PIC X. IF1284.2 +007800 03 FILLER PIC X(50) VALUE SPACE. IF1284.2 +007900 01 TEST-CORRECT. IF1284.2 +008000 02 FILLER PIC X(30) VALUE SPACE. IF1284.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1284.2 +008200 02 CORRECT-X. IF1284.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1284.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1284.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1284.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1284.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1284.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. IF1284.2 +008900 04 CORRECT-18V0 PIC -9(18). IF1284.2 +009000 04 FILLER PIC X. IF1284.2 +009100 03 FILLER PIC X(2) VALUE SPACE. IF1284.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1284.2 +009300 01 TEST-CORRECT-MIN. IF1284.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IF1284.2 +009500 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1284.2 +009600 02 CORRECTMI-X. IF1284.2 +009700 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1284.2 +009800 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1284.2 +009900 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1284.2 +010000 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1284.2 +010100 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1284.2 +010200 03 CR-18V0 REDEFINES CORRECTMI-A. IF1284.2 +010300 04 CORRECTMI-18V0 PIC -9(18). IF1284.2 +010400 04 FILLER PIC X. IF1284.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IF1284.2 +010600 03 FILLER PIC X(48) VALUE SPACE. IF1284.2 +010700 01 TEST-CORRECT-MAX. IF1284.2 +010800 02 FILLER PIC X(30) VALUE SPACE. IF1284.2 +010900 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1284.2 +011000 02 CORRECTMA-X. IF1284.2 +011100 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1284.2 +011200 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1284.2 +011300 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1284.2 +011400 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1284.2 +011500 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1284.2 +011600 03 CR-18V0 REDEFINES CORRECTMA-A. IF1284.2 +011700 04 CORRECTMA-18V0 PIC -9(18). IF1284.2 +011800 04 FILLER PIC X. IF1284.2 +011900 03 FILLER PIC X(2) VALUE SPACE. IF1284.2 +012000 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1284.2 +012100 01 CCVS-C-1. IF1284.2 +012200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1284.2 +012300- "SS PARAGRAPH-NAME IF1284.2 +012400- " REMARKS". IF1284.2 +012500 02 FILLER PIC X(20) VALUE SPACE. IF1284.2 +012600 01 CCVS-C-2. IF1284.2 +012700 02 FILLER PIC X VALUE SPACE. IF1284.2 +012800 02 FILLER PIC X(6) VALUE "TESTED". IF1284.2 +012900 02 FILLER PIC X(15) VALUE SPACE. IF1284.2 +013000 02 FILLER PIC X(4) VALUE "FAIL". IF1284.2 +013100 02 FILLER PIC X(94) VALUE SPACE. IF1284.2 +013200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1284.2 +013300 01 REC-CT PIC 99 VALUE ZERO. IF1284.2 +013400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1284.2 +013500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1284.2 +013600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1284.2 +013700 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1284.2 +013800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1284.2 +013900 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1284.2 +014000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1284.2 +014100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1284.2 +014200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1284.2 +014300 01 CCVS-H-1. IF1284.2 +014400 02 FILLER PIC X(39) VALUE SPACES. IF1284.2 +014500 02 FILLER PIC X(42) VALUE IF1284.2 +014600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1284.2 +014700 02 FILLER PIC X(39) VALUE SPACES. IF1284.2 +014800 01 CCVS-H-2A. IF1284.2 +014900 02 FILLER PIC X(40) VALUE SPACE. IF1284.2 +015000 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1284.2 +015100 02 FILLER PIC XXXX VALUE IF1284.2 +015200 "4.2 ". IF1284.2 +015300 02 FILLER PIC X(28) VALUE IF1284.2 +015400 " COPY - NOT FOR DISTRIBUTION". IF1284.2 +015500 02 FILLER PIC X(41) VALUE SPACE. IF1284.2 +015600 IF1284.2 +015700 01 CCVS-H-2B. IF1284.2 +015800 02 FILLER PIC X(15) VALUE IF1284.2 +015900 "TEST RESULT OF ". IF1284.2 +016000 02 TEST-ID PIC X(9). IF1284.2 +016100 02 FILLER PIC X(4) VALUE IF1284.2 +016200 " IN ". IF1284.2 +016300 02 FILLER PIC X(12) VALUE IF1284.2 +016400 " HIGH ". IF1284.2 +016500 02 FILLER PIC X(22) VALUE IF1284.2 +016600 " LEVEL VALIDATION FOR ". IF1284.2 +016700 02 FILLER PIC X(58) VALUE IF1284.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1284.2 +016900 01 CCVS-H-3. IF1284.2 +017000 02 FILLER PIC X(34) VALUE IF1284.2 +017100 " FOR OFFICIAL USE ONLY ". IF1284.2 +017200 02 FILLER PIC X(58) VALUE IF1284.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1284.2 +017400 02 FILLER PIC X(28) VALUE IF1284.2 +017500 " COPYRIGHT 1985 ". IF1284.2 +017600 01 CCVS-E-1. IF1284.2 +017700 02 FILLER PIC X(52) VALUE SPACE. IF1284.2 +017800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1284.2 +017900 02 ID-AGAIN PIC X(9). IF1284.2 +018000 02 FILLER PIC X(45) VALUE SPACES. IF1284.2 +018100 01 CCVS-E-2. IF1284.2 +018200 02 FILLER PIC X(31) VALUE SPACE. IF1284.2 +018300 02 FILLER PIC X(21) VALUE SPACE. IF1284.2 +018400 02 CCVS-E-2-2. IF1284.2 +018500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1284.2 +018600 03 FILLER PIC X VALUE SPACE. IF1284.2 +018700 03 ENDER-DESC PIC X(44) VALUE IF1284.2 +018800 "ERRORS ENCOUNTERED". IF1284.2 +018900 01 CCVS-E-3. IF1284.2 +019000 02 FILLER PIC X(22) VALUE IF1284.2 +019100 " FOR OFFICIAL USE ONLY". IF1284.2 +019200 02 FILLER PIC X(12) VALUE SPACE. IF1284.2 +019300 02 FILLER PIC X(58) VALUE IF1284.2 +019400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1284.2 +019500 02 FILLER PIC X(13) VALUE SPACE. IF1284.2 +019600 02 FILLER PIC X(15) VALUE IF1284.2 +019700 " COPYRIGHT 1985". IF1284.2 +019800 01 CCVS-E-4. IF1284.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1284.2 +020000 02 FILLER PIC X(4) VALUE " OF ". IF1284.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1284.2 +020200 02 FILLER PIC X(40) VALUE IF1284.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". IF1284.2 +020400 01 XXINFO. IF1284.2 +020500 02 FILLER PIC X(19) VALUE IF1284.2 +020600 "*** INFORMATION ***". IF1284.2 +020700 02 INFO-TEXT. IF1284.2 +020800 04 FILLER PIC X(8) VALUE SPACE. IF1284.2 +020900 04 XXCOMPUTED PIC X(20). IF1284.2 +021000 04 FILLER PIC X(5) VALUE SPACE. IF1284.2 +021100 04 XXCORRECT PIC X(20). IF1284.2 +021200 02 INF-ANSI-REFERENCE PIC X(48). IF1284.2 +021300 01 HYPHEN-LINE. IF1284.2 +021400 02 FILLER PIC IS X VALUE IS SPACE. IF1284.2 +021500 02 FILLER PIC IS X(65) VALUE IS "************************IF1284.2 +021600- "*****************************************". IF1284.2 +021700 02 FILLER PIC IS X(54) VALUE IS "************************IF1284.2 +021800- "******************************". IF1284.2 +021900 01 CCVS-PGM-ID PIC X(9) VALUE IF1284.2 +022000 "IF128A". IF1284.2 +022100 PROCEDURE DIVISION. IF1284.2 +022200 CCVS1 SECTION. IF1284.2 +022300 OPEN-FILES. IF1284.2 +022400 OPEN OUTPUT PRINT-FILE. IF1284.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1284.2 +022600 MOVE SPACE TO TEST-RESULTS. IF1284.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1284.2 +022800 GO TO CCVS1-EXIT. IF1284.2 +022900 CLOSE-FILES. IF1284.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1284.2 +023100 TERMINATE-CCVS. IF1284.2 +023200 STOP RUN. IF1284.2 +023300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1284.2 +023400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1284.2 +023500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1284.2 +023600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1284.2 +023700 MOVE "****TEST DELETED****" TO RE-MARK. IF1284.2 +023800 PRINT-DETAIL. IF1284.2 +023900 IF REC-CT NOT EQUAL TO ZERO IF1284.2 +024000 MOVE "." TO PARDOT-X IF1284.2 +024100 MOVE REC-CT TO DOTVALUE. IF1284.2 +024200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1284.2 +024300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1284.2 +024400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1284.2 +024500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1284.2 +024600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1284.2 +024700 MOVE SPACE TO CORRECT-X. IF1284.2 +024800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1284.2 +024900 MOVE SPACE TO RE-MARK. IF1284.2 +025000 HEAD-ROUTINE. IF1284.2 +025100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +025200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +025300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1284.2 +025400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1284.2 +025500 COLUMN-NAMES-ROUTINE. IF1284.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +025900 END-ROUTINE. IF1284.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1284.2 +026100 END-RTN-EXIT. IF1284.2 +026200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +026300 END-ROUTINE-1. IF1284.2 +026400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1284.2 +026500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1284.2 +026600 ADD PASS-COUNTER TO ERROR-HOLD. IF1284.2 +026700 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1284.2 +026800 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1284.2 +026900 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1284.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1284.2 +027100 END-ROUTINE-12. IF1284.2 +027200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1284.2 +027300 IF ERROR-COUNTER IS EQUAL TO ZERO IF1284.2 +027400 MOVE "NO " TO ERROR-TOTAL IF1284.2 +027500 ELSE IF1284.2 +027600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1284.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1284.2 +027800 PERFORM WRITE-LINE. IF1284.2 +027900 END-ROUTINE-13. IF1284.2 +028000 IF DELETE-COUNTER IS EQUAL TO ZERO IF1284.2 +028100 MOVE "NO " TO ERROR-TOTAL ELSE IF1284.2 +028200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1284.2 +028300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1284.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +028500 IF INSPECT-COUNTER EQUAL TO ZERO IF1284.2 +028600 MOVE "NO " TO ERROR-TOTAL IF1284.2 +028700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1284.2 +028800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1284.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +029000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1284.2 +029100 WRITE-LINE. IF1284.2 +029200 ADD 1 TO RECORD-COUNT. IF1284.2 +029300 IF RECORD-COUNT GREATER 42 IF1284.2 +029400 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1284.2 +029500 MOVE SPACE TO DUMMY-RECORD IF1284.2 +029600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1284.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1284.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1284.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1284.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1284.2 +030100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1284.2 +030200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1284.2 +030300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1284.2 +030400 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1284.2 +030500 MOVE ZERO TO RECORD-COUNT. IF1284.2 +030600 PERFORM WRT-LN. IF1284.2 +030700 WRT-LN. IF1284.2 +030800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1284.2 +030900 MOVE SPACE TO DUMMY-RECORD. IF1284.2 +031000 BLANK-LINE-PRINT. IF1284.2 +031100 PERFORM WRT-LN. IF1284.2 +031200 FAIL-ROUTINE. IF1284.2 +031300 IF COMPUTED-X NOT EQUAL TO SPACE IF1284.2 +031400 GO TO FAIL-ROUTINE-WRITE. IF1284.2 +031500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1284.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1284.2 +031700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1284.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1284.2 +032000 GO TO FAIL-ROUTINE-EX. IF1284.2 +032100 FAIL-ROUTINE-WRITE. IF1284.2 +032200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1284.2 +032300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1284.2 +032400 CORMA-ANSI-REFERENCE. IF1284.2 +032500 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1284.2 +032600 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1284.2 +032700 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1284.2 +032800 ELSE IF1284.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1284.2 +033000 PERFORM WRITE-LINE. IF1284.2 +033100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1284.2 +033200 FAIL-ROUTINE-EX. EXIT. IF1284.2 +033300 BAIL-OUT. IF1284.2 +033400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1284.2 +033500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1284.2 +033600 BAIL-OUT-WRITE. IF1284.2 +033700 MOVE CORRECT-A TO XXCORRECT. IF1284.2 +033800 MOVE COMPUTED-A TO XXCOMPUTED. IF1284.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1284.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1284.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1284.2 +034200 BAIL-OUT-EX. EXIT. IF1284.2 +034300 CCVS1-EXIT. IF1284.2 +034400 EXIT. IF1284.2 +034500******************************************************** IF1284.2 +034600* * IF1284.2 +034700* Intrinsic Function Tests IF128A - ORD-MAX * IF1284.2 +034800* * IF1284.2 +034900******************************************************** IF1284.2 +035000 SECT-IF128A SECTION. IF1284.2 +035100 F-ORD-MAX-INFO. IF1284.2 +035200 MOVE "See ref. A-61 2.32" TO ANSI-REFERENCE. IF1284.2 +035300 MOVE "ORD-MAX Function" TO FEATURE. IF1284.2 +035400*****************TEST (a) ****************************** IF1284.2 +035500 F-ORD-MAX-01. IF1284.2 +035600 MOVE ZERO TO WS-INT. IF1284.2 +035700 F-ORD-MAX-TEST-01. IF1284.2 +035800 COMPUTE WS-INT = FUNCTION ORD-MAX(5, 3, 2, 8, 3, 1). IF1284.2 +035900 IF WS-INT = 4 THEN IF1284.2 +036000 PERFORM PASS IF1284.2 +036100 ELSE IF1284.2 +036200 MOVE 4 TO CORRECT-N IF1284.2 +036300 MOVE WS-INT TO COMPUTED-N IF1284.2 +036400 PERFORM FAIL. IF1284.2 +036500 GO TO F-ORD-MAX-WRITE-01. IF1284.2 +036600 F-ORD-MAX-DELETE-01. IF1284.2 +036700 PERFORM DE-LETE. IF1284.2 +036800 GO TO F-ORD-MAX-WRITE-01. IF1284.2 +036900 F-ORD-MAX-WRITE-01. IF1284.2 +037000 MOVE "F-ORD-MAX-01" TO PAR-NAME. IF1284.2 +037100 PERFORM PRINT-DETAIL. IF1284.2 +037200*****************TEST (b) ****************************** IF1284.2 +037300 F-ORD-MAX-TEST-02. IF1284.2 +037400 EVALUATE FUNCTION ORD-MAX(3, 2, 7, 1, 5) IF1284.2 +037500 WHEN 3 IF1284.2 +037600 PERFORM PASS IF1284.2 +037700 GO TO F-ORD-MAX-WRITE-02. IF1284.2 +037800 PERFORM FAIL. IF1284.2 +037900 GO TO F-ORD-MAX-WRITE-02. IF1284.2 +038000 F-ORD-MAX-DELETE-02. IF1284.2 +038100 PERFORM DE-LETE. IF1284.2 +038200 GO TO F-ORD-MAX-WRITE-02. IF1284.2 +038300 F-ORD-MAX-WRITE-02. IF1284.2 +038400 MOVE "F-ORD-MAX-02" TO PAR-NAME. IF1284.2 +038500 PERFORM PRINT-DETAIL. IF1284.2 +038600*****************TEST (c) ****************************** IF1284.2 +038700 F-ORD-MAX-03. IF1284.2 +038800 MOVE ZERO TO WS-INT. IF1284.2 +038900 F-ORD-MAX-TEST-03. IF1284.2 +039000 IF FUNCTION ORD-MAX(A, B, D) = 3 THEN IF1284.2 +039100 PERFORM PASS IF1284.2 +039200 ELSE IF1284.2 +039300 PERFORM FAIL. IF1284.2 +039400 GO TO F-ORD-MAX-WRITE-03. IF1284.2 +039500 F-ORD-MAX-DELETE-03. IF1284.2 +039600 PERFORM DE-LETE. IF1284.2 +039700 GO TO F-ORD-MAX-WRITE-03. IF1284.2 +039800 F-ORD-MAX-WRITE-03. IF1284.2 +039900 MOVE "F-ORD-MAX-03" TO PAR-NAME. IF1284.2 +040000 PERFORM PRINT-DETAIL. IF1284.2 +040100*****************TEST (d) ****************************** IF1284.2 +040200 F-ORD-MAX-04. IF1284.2 +040300 MOVE ZERO TO WS-INT. IF1284.2 +040400 F-ORD-MAX-TEST-04. IF1284.2 +040500 COMPUTE WS-INT = FUNCTION ORD-MAX(A, B, C). IF1284.2 +040600 IF WS-INT = 2 THEN IF1284.2 +040700 PERFORM PASS IF1284.2 +040800 ELSE IF1284.2 +040900 MOVE 2 TO CORRECT-N IF1284.2 +041000 MOVE WS-INT TO COMPUTED-N IF1284.2 +041100 PERFORM FAIL. IF1284.2 +041200 GO TO F-ORD-MAX-WRITE-04. IF1284.2 +041300 F-ORD-MAX-DELETE-04. IF1284.2 +041400 PERFORM DE-LETE. IF1284.2 +041500 GO TO F-ORD-MAX-WRITE-04. IF1284.2 +041600 F-ORD-MAX-WRITE-04. IF1284.2 +041700 MOVE "F-ORD-MAX-04" TO PAR-NAME. IF1284.2 +041800 PERFORM PRINT-DETAIL. IF1284.2 +041900*****************TEST (e) ****************************** IF1284.2 +042000 F-ORD-MAX-05. IF1284.2 +042100 MOVE ZERO TO WS-INT. IF1284.2 +042200 F-ORD-MAX-TEST-05. IF1284.2 +042300 COMPUTE WS-INT = FUNCTION ORD-MAX(A, 4, B, 7, C, 9). IF1284.2 +042400 IF WS-INT = 6 THEN IF1284.2 +042500 PERFORM PASS IF1284.2 +042600 ELSE IF1284.2 +042700 MOVE 6 TO CORRECT-N IF1284.2 +042800 MOVE WS-INT TO COMPUTED-N IF1284.2 +042900 PERFORM FAIL. IF1284.2 +043000 GO TO F-ORD-MAX-WRITE-05. IF1284.2 +043100 F-ORD-MAX-DELETE-05. IF1284.2 +043200 PERFORM DE-LETE. IF1284.2 +043300 GO TO F-ORD-MAX-WRITE-05. IF1284.2 +043400 F-ORD-MAX-WRITE-05. IF1284.2 +043500 MOVE "F-ORD-MAX-05" TO PAR-NAME. IF1284.2 +043600 PERFORM PRINT-DETAIL. IF1284.2 +043700*****************TEST (f) ****************************** IF1284.2 +043800 F-ORD-MAX-06. IF1284.2 +043900 MOVE ZERO TO WS-INT. IF1284.2 +044000 F-ORD-MAX-TEST-06. IF1284.2 +044100 COMPUTE WS-INT = FUNCTION ORD-MAX(4, 9, A, 3). IF1284.2 +044200 IF WS-INT = 2 THEN IF1284.2 +044300 PERFORM PASS IF1284.2 +044400 ELSE IF1284.2 +044500 MOVE 2 TO CORRECT-N IF1284.2 +044600 MOVE WS-INT TO COMPUTED-N IF1284.2 +044700 PERFORM FAIL. IF1284.2 +044800 GO TO F-ORD-MAX-WRITE-06. IF1284.2 +044900 F-ORD-MAX-DELETE-06. IF1284.2 +045000 PERFORM DE-LETE. IF1284.2 +045100 GO TO F-ORD-MAX-WRITE-06. IF1284.2 +045200 F-ORD-MAX-WRITE-06. IF1284.2 +045300 MOVE "F-ORD-MAX-06" TO PAR-NAME. IF1284.2 +045400 PERFORM PRINT-DETAIL. IF1284.2 +045500*****************TEST (g) ****************************** IF1284.2 +045600 F-ORD-MAX-07. IF1284.2 +045700 MOVE ZERO TO WS-INT. IF1284.2 +045800 F-ORD-MAX-TEST-07. IF1284.2 +045900 COMPUTE WS-INT = FUNCTION ORD-MAX("A", I, "P"). IF1284.2 +046000 IF WS-INT = 2 THEN IF1284.2 +046100 PERFORM PASS IF1284.2 +046200 ELSE IF1284.2 +046300 MOVE 2 TO CORRECT-N IF1284.2 +046400 MOVE WS-INT TO COMPUTED-N IF1284.2 +046500 PERFORM FAIL. IF1284.2 +046600 GO TO F-ORD-MAX-WRITE-07. IF1284.2 +046700 F-ORD-MAX-DELETE-07. IF1284.2 +046800 PERFORM DE-LETE. IF1284.2 +046900 GO TO F-ORD-MAX-WRITE-07. IF1284.2 +047000 F-ORD-MAX-WRITE-07. IF1284.2 +047100 MOVE "F-ORD-MAX-07" TO PAR-NAME. IF1284.2 +047200 PERFORM PRINT-DETAIL. IF1284.2 +047300*****************TEST (h) ****************************** IF1284.2 +047400 F-ORD-MAX-08. IF1284.2 +047500 MOVE ZERO TO WS-INT. IF1284.2 +047600 F-ORD-MAX-TEST-08. IF1284.2 +047700 COMPUTE WS-INT = FUNCTION ORD-MAX("S", "D", J). IF1284.2 +047800 IF WS-INT = 3 THEN IF1284.2 +047900 PERFORM PASS IF1284.2 +048000 ELSE IF1284.2 +048100 MOVE 3 TO CORRECT-N IF1284.2 +048200 MOVE WS-INT TO COMPUTED-N IF1284.2 +048300 PERFORM FAIL. IF1284.2 +048400 GO TO F-ORD-MAX-WRITE-08. IF1284.2 +048500 F-ORD-MAX-DELETE-08. IF1284.2 +048600 PERFORM DE-LETE. IF1284.2 +048700 GO TO F-ORD-MAX-WRITE-08. IF1284.2 +048800 F-ORD-MAX-WRITE-08. IF1284.2 +048900 MOVE "F-ORD-MAX-08" TO PAR-NAME. IF1284.2 +049000 PERFORM PRINT-DETAIL. IF1284.2 +049100*****************TEST (i) ****************************** IF1284.2 +049200 F-ORD-MAX-09. IF1284.2 +049300 MOVE ZERO TO WS-INT. IF1284.2 +049400 F-ORD-MAX-TEST-09. IF1284.2 +049500 COMPUTE WS-INT = FUNCTION ORD-MAX(A, 5, 5, A). IF1284.2 +049600 IF WS-INT = 1 THEN IF1284.2 +049700 PERFORM PASS IF1284.2 +049800 ELSE IF1284.2 +049900 MOVE 1 TO CORRECT-N IF1284.2 +050000 MOVE WS-INT TO COMPUTED-N IF1284.2 +050100 PERFORM FAIL. IF1284.2 +050200 GO TO F-ORD-MAX-WRITE-09. IF1284.2 +050300 F-ORD-MAX-DELETE-09. IF1284.2 +050400 PERFORM DE-LETE. IF1284.2 +050500 GO TO F-ORD-MAX-WRITE-09. IF1284.2 +050600 F-ORD-MAX-WRITE-09. IF1284.2 +050700 MOVE "F-ORD-MAX-09" TO PAR-NAME. IF1284.2 +050800 PERFORM PRINT-DETAIL. IF1284.2 +050900*****************TEST (j) ****************************** IF1284.2 +051000 F-ORD-MAX-10. IF1284.2 +051100 MOVE ZERO TO WS-INT. IF1284.2 +051200 F-ORD-MAX-TEST-10. IF1284.2 +051300 COMPUTE WS-INT = FUNCTION ORD-MAX(IND(1), IND(2), IND(3)). IF1284.2 +051400 IF WS-INT = 3 THEN IF1284.2 +051500 PERFORM PASS IF1284.2 +051600 ELSE IF1284.2 +051700 MOVE 3 TO CORRECT-N IF1284.2 +051800 MOVE WS-INT TO COMPUTED-N IF1284.2 +051900 PERFORM FAIL. IF1284.2 +052000 GO TO F-ORD-MAX-WRITE-10. IF1284.2 +052100 F-ORD-MAX-DELETE-10. IF1284.2 +052200 PERFORM DE-LETE. IF1284.2 +052300 GO TO F-ORD-MAX-WRITE-10. IF1284.2 +052400 F-ORD-MAX-WRITE-10. IF1284.2 +052500 MOVE "F-ORD-MAX-10" TO PAR-NAME. IF1284.2 +052600 PERFORM PRINT-DETAIL. IF1284.2 +052700*****************TEST (k) ****************************** IF1284.2 +052800 F-ORD-MAX-11. IF1284.2 +052900 MOVE ZERO TO WS-INT. IF1284.2 +053000 F-ORD-MAX-TEST-11. IF1284.2 +053100 COMPUTE WS-INT = FUNCTION ORD-MAX(IND(R), IND(P), IND(Q)). IF1284.2 +053200 IF WS-INT = 1 THEN IF1284.2 +053300 PERFORM PASS IF1284.2 +053400 ELSE IF1284.2 +053500 MOVE 1 TO CORRECT-N IF1284.2 +053600 MOVE WS-INT TO COMPUTED-N IF1284.2 +053700 PERFORM FAIL. IF1284.2 +053800 GO TO F-ORD-MAX-WRITE-11. IF1284.2 +053900 F-ORD-MAX-DELETE-11. IF1284.2 +054000 PERFORM DE-LETE. IF1284.2 +054100 GO TO F-ORD-MAX-WRITE-11. IF1284.2 +054200 F-ORD-MAX-WRITE-11. IF1284.2 +054300 MOVE "F-ORD-MAX-11" TO PAR-NAME. IF1284.2 +054400 PERFORM PRINT-DETAIL. IF1284.2 +054500*****************TEST (l) ****************************** IF1284.2 +054600 F-ORD-MAX-12. IF1284.2 +054700 MOVE ZERO TO WS-INT. IF1284.2 +054800 F-ORD-MAX-TEST-12. IF1284.2 +rogerw COMPUTE WS-INT = FUNCTION ORD-MAX (4 0 5 3 7). +055000 IF WS-INT = 5 THEN IF1284.2 +055100 PERFORM PASS IF1284.2 +055200 ELSE IF1284.2 +055300 MOVE 5 TO CORRECT-N IF1284.2 +055400 MOVE WS-INT TO COMPUTED-N IF1284.2 +055500 PERFORM FAIL. IF1284.2 +055600 GO TO F-ORD-MAX-WRITE-12. IF1284.2 +055700 F-ORD-MAX-DELETE-12. IF1284.2 +055800 PERFORM DE-LETE. IF1284.2 +055900 GO TO F-ORD-MAX-WRITE-12. IF1284.2 +056000 F-ORD-MAX-WRITE-12. IF1284.2 +056100 MOVE "F-ORD-MAX-12" TO PAR-NAME. IF1284.2 +056200 PERFORM PRINT-DETAIL. IF1284.2 +056300*****************TEST (m) ****************************** IF1284.2 +056400 F-ORD-MAX-13. IF1284.2 +056500 MOVE ZERO TO WS-INT. IF1284.2 +056600 F-ORD-MAX-TEST-13. IF1284.2 +056700 COMPUTE WS-INT = FUNCTION ORD-MAX( IF1284.2 +056800 FUNCTION ORD-MAX(1, 4), 3, 1). IF1284.2 +056900 IF WS-INT = 2 THEN IF1284.2 +057000 PERFORM PASS IF1284.2 +057100 ELSE IF1284.2 +057200 MOVE 2 TO CORRECT-N IF1284.2 +057300 MOVE WS-INT TO COMPUTED-N IF1284.2 +057400 PERFORM FAIL. IF1284.2 +057500 GO TO F-ORD-MAX-WRITE-13. IF1284.2 +057600 F-ORD-MAX-DELETE-13. IF1284.2 +057700 PERFORM DE-LETE. IF1284.2 +057800 GO TO F-ORD-MAX-WRITE-13. IF1284.2 +057900 F-ORD-MAX-WRITE-13. IF1284.2 +058000 MOVE "F-ORD-MAX-13" TO PAR-NAME. IF1284.2 +058100 PERFORM PRINT-DETAIL. IF1284.2 +058200*****************TEST (n) ****************************** IF1284.2 +058300 F-ORD-MAX-14. IF1284.2 +058400 MOVE ZERO TO WS-INT. IF1284.2 +058500 F-ORD-MAX-TEST-14. IF1284.2 +058600 COMPUTE WS-INT = FUNCTION ORD-MAX(2, 3, C) + A. IF1284.2 +058700 IF WS-INT = 8 THEN IF1284.2 +058800 PERFORM PASS IF1284.2 +058900 ELSE IF1284.2 +059000 MOVE 8 TO CORRECT-N IF1284.2 +059100 MOVE WS-INT TO COMPUTED-N IF1284.2 +059200 PERFORM FAIL. IF1284.2 +059300 GO TO F-ORD-MAX-WRITE-14. IF1284.2 +059400 F-ORD-MAX-DELETE-14. IF1284.2 +059500 PERFORM DE-LETE. IF1284.2 +059600 GO TO F-ORD-MAX-WRITE-14. IF1284.2 +059700 F-ORD-MAX-WRITE-14. IF1284.2 +059800 MOVE "F-ORD-MAX-14" TO PAR-NAME. IF1284.2 +059900 PERFORM PRINT-DETAIL. IF1284.2 +060000*****************TEST (o) ****************************** IF1284.2 +060100 F-ORD-MAX-15. IF1284.2 +060200 MOVE ZERO TO WS-INT. IF1284.2 +060300 F-ORD-MAX-TEST-15. IF1284.2 +060400 COMPUTE WS-INT = FUNCTION ORD-MAX(2, 3, A) + IF1284.2 +060500 FUNCTION ORD-MAX(1, 1). IF1284.2 +060600 IF WS-INT = 4 THEN IF1284.2 +060700 PERFORM PASS IF1284.2 +060800 ELSE IF1284.2 +060900 MOVE 4 TO CORRECT-N IF1284.2 +061000 MOVE WS-INT TO COMPUTED-N IF1284.2 +061100 PERFORM FAIL. IF1284.2 +061200 GO TO F-ORD-MAX-WRITE-15. IF1284.2 +061300 F-ORD-MAX-DELETE-15. IF1284.2 +061400 PERFORM DE-LETE. IF1284.2 +061500 GO TO F-ORD-MAX-WRITE-15. IF1284.2 +061600 F-ORD-MAX-WRITE-15. IF1284.2 +061700 MOVE "F-ORD-MAX-15" TO PAR-NAME. IF1284.2 +061800 PERFORM PRINT-DETAIL. IF1284.2 +061900*****************SPECIAL TEST 1****************************** IF1284.2 +062000 F-ORD-MAX-16. IF1284.2 +062100 MOVE 1 TO ARG1 IF1284.2 +062200 PERFORM F-ORD-MAX-TEST-16 IF1284.2 +062300 UNTIL FUNCTION ORD-MAX (5, ARG1) = 2. IF1284.2 +062400* IF1284.2 +062500** when ARG1 = 6 , ORD-MAX(5,ARG1) = 2 IF1284.2 +062600* IF1284.2 +062700 IF ARG1 = 6 THEN IF1284.2 +062800 PERFORM PASS IF1284.2 +062900 ELSE IF1284.2 +063000 MOVE 6 TO CORRECT-N IF1284.2 +063100 MOVE WS-INT TO COMPUTED-N IF1284.2 +063200 PERFORM FAIL. IF1284.2 +063300 GO TO F-ORD-MAX-WRITE-16. IF1284.2 +063400* IF1284.2 +063500 F-ORD-MAX-TEST-16. IF1284.2 +063600 COMPUTE ARG1 = ARG1 + 1. IF1284.2 +063700* IF1284.2 +063800 F-ORD-MAX-DELETE-16. IF1284.2 +063900 PERFORM DE-LETE. IF1284.2 +064000 GO TO F-ORD-MAX-WRITE-16. IF1284.2 +064100 F-ORD-MAX-WRITE-16. IF1284.2 +064200 MOVE "F-ORD-MAX-16" TO PAR-NAME. IF1284.2 +064300 PERFORM PRINT-DETAIL. IF1284.2 +064400*******************END OF TESTS************************** IF1284.2 +064500 CCVS-EXIT SECTION. IF1284.2 +064600 CCVS-999999. IF1284.2 +064700 GO TO CLOSE-FILES. IF1284.2 diff --git a/tests/cobol85/IF/IF129A.CBL b/tests/cobol85/IF/IF129A.CBL new file mode 100755 index 00000000..8686606e --- /dev/null +++ b/tests/cobol85/IF/IF129A.CBL @@ -0,0 +1,632 @@ +000100 IDENTIFICATION DIVISION. IF1294.2 +000200 PROGRAM-ID. IF1294.2 +000300 IF129A. IF1294.2 +000400 IF1294.2 +000500*********************************************************** IF1294.2 +000600* * IF1294.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1294.2 +000800* It contains tests for the Intrinsic Function ORD-MIN. * IF1294.2 +000900* * IF1294.2 +001000* * IF1294.2 +001100*********************************************************** IF1294.2 +001200 ENVIRONMENT DIVISION. IF1294.2 +001300 CONFIGURATION SECTION. IF1294.2 +001400 SOURCE-COMPUTER. IF1294.2 +001500 Linux. IF1294.2 +001600 OBJECT-COMPUTER. IF1294.2 +001700 Linux IF1294.2 +001800 PROGRAM COLLATING SEQUENCE IS PRG-COLL-SEQ. IF1294.2 +001900 SPECIAL-NAMES. IF1294.2 +002000 ALPHABET PRG-COLL-SEQ IS IF1294.2 +002100 STANDARD-2. IF1294.2 +002200 INPUT-OUTPUT SECTION. IF1294.2 +002300 FILE-CONTROL. IF1294.2 +002400 SELECT PRINT-FILE ASSIGN TO IF1294.2 +002500 "report.log". IF1294.2 +002600 DATA DIVISION. IF1294.2 +002700 FILE SECTION. IF1294.2 +002800 FD PRINT-FILE. IF1294.2 +002900 01 PRINT-REC PICTURE X(120). IF1294.2 +003000 01 DUMMY-RECORD PICTURE X(120). IF1294.2 +003100 WORKING-STORAGE SECTION. IF1294.2 +003200*********************************************************** IF1294.2 +003300* Variables specific to the Intrinsic Function Test IF129A* IF1294.2 +003400*********************************************************** IF1294.2 +003500 01 A PIC S9(10) VALUE 5. IF1294.2 +003600 01 B PIC S9(10) VALUE 7. IF1294.2 +003700 01 C PIC S9(10) VALUE 4. IF1294.2 +003800 01 D PIC S9(10) VALUE 10. IF1294.2 +003900 01 I PIC X(4) VALUE "R". IF1294.2 +004000 01 J PIC X(4) VALUE "U". IF1294.2 +004100 01 P PIC S9(10) VALUE 1. IF1294.2 +004200 01 Q PIC S9(10) VALUE 3. IF1294.2 +004300 01 R PIC S9(10) VALUE 5. IF1294.2 +004400 01 ARG1 PIC S9(10) VALUE 10. IF1294.2 +004500 01 ARR VALUE "40537". IF1294.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1294.2 +004700 01 TEMP PIC S9(10). IF1294.2 +004800 01 WS-INT PIC S9(10). IF1294.2 +004900* IF1294.2 +005000********************************************************** IF1294.2 +005100* IF1294.2 +005200 01 TEST-RESULTS. IF1294.2 +005300 02 FILLER PIC X VALUE SPACE. IF1294.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. IF1294.2 +005500 02 FILLER PIC X VALUE SPACE. IF1294.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. IF1294.2 +005700 02 FILLER PIC X VALUE SPACE. IF1294.2 +005800 02 PAR-NAME. IF1294.2 +005900 03 FILLER PIC X(19) VALUE SPACE. IF1294.2 +006000 03 PARDOT-X PIC X VALUE SPACE. IF1294.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. IF1294.2 +006200 02 FILLER PIC X(8) VALUE SPACE. IF1294.2 +006300 02 RE-MARK PIC X(61). IF1294.2 +006400 01 TEST-COMPUTED. IF1294.2 +006500 02 FILLER PIC X(30) VALUE SPACE. IF1294.2 +006600 02 FILLER PIC X(17) VALUE IF1294.2 +006700 " COMPUTED=". IF1294.2 +006800 02 COMPUTED-X. IF1294.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1294.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A IF1294.2 +007100 PIC -9(9).9(9). IF1294.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1294.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1294.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1294.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. IF1294.2 +007600 04 COMPUTED-18V0 PIC -9(18). IF1294.2 +007700 04 FILLER PIC X. IF1294.2 +007800 03 FILLER PIC X(50) VALUE SPACE. IF1294.2 +007900 01 TEST-CORRECT. IF1294.2 +008000 02 FILLER PIC X(30) VALUE SPACE. IF1294.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1294.2 +008200 02 CORRECT-X. IF1294.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1294.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1294.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1294.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1294.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1294.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. IF1294.2 +008900 04 CORRECT-18V0 PIC -9(18). IF1294.2 +009000 04 FILLER PIC X. IF1294.2 +009100 03 FILLER PIC X(2) VALUE SPACE. IF1294.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1294.2 +009300 01 CCVS-C-1. IF1294.2 +009400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1294.2 +009500- "SS PARAGRAPH-NAME IF1294.2 +009600- " REMARKS". IF1294.2 +009700 02 FILLER PIC X(20) VALUE SPACE. IF1294.2 +009800 01 CCVS-C-2. IF1294.2 +009900 02 FILLER PIC X VALUE SPACE. IF1294.2 +010000 02 FILLER PIC X(6) VALUE "TESTED". IF1294.2 +010100 02 FILLER PIC X(15) VALUE SPACE. IF1294.2 +010200 02 FILLER PIC X(4) VALUE "FAIL". IF1294.2 +010300 02 FILLER PIC X(94) VALUE SPACE. IF1294.2 +010400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1294.2 +010500 01 REC-CT PIC 99 VALUE ZERO. IF1294.2 +010600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1294.2 +010700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1294.2 +010800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1294.2 +010900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1294.2 +011000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1294.2 +011100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1294.2 +011200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1294.2 +011300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1294.2 +011400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1294.2 +011500 01 CCVS-H-1. IF1294.2 +011600 02 FILLER PIC X(39) VALUE SPACES. IF1294.2 +011700 02 FILLER PIC X(42) VALUE IF1294.2 +011800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1294.2 +011900 02 FILLER PIC X(39) VALUE SPACES. IF1294.2 +012000 01 CCVS-H-2A. IF1294.2 +012100 02 FILLER PIC X(40) VALUE SPACE. IF1294.2 +012200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1294.2 +012300 02 FILLER PIC XXXX VALUE IF1294.2 +012400 "4.2 ". IF1294.2 +012500 02 FILLER PIC X(28) VALUE IF1294.2 +012600 " COPY - NOT FOR DISTRIBUTION". IF1294.2 +012700 02 FILLER PIC X(41) VALUE SPACE. IF1294.2 +012800 IF1294.2 +012900 01 CCVS-H-2B. IF1294.2 +013000 02 FILLER PIC X(15) VALUE IF1294.2 +013100 "TEST RESULT OF ". IF1294.2 +013200 02 TEST-ID PIC X(9). IF1294.2 +013300 02 FILLER PIC X(4) VALUE IF1294.2 +013400 " IN ". IF1294.2 +013500 02 FILLER PIC X(12) VALUE IF1294.2 +013600 " HIGH ". IF1294.2 +013700 02 FILLER PIC X(22) VALUE IF1294.2 +013800 " LEVEL VALIDATION FOR ". IF1294.2 +013900 02 FILLER PIC X(58) VALUE IF1294.2 +014000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1294.2 +014100 01 CCVS-H-3. IF1294.2 +014200 02 FILLER PIC X(34) VALUE IF1294.2 +014300 " FOR OFFICIAL USE ONLY ". IF1294.2 +014400 02 FILLER PIC X(58) VALUE IF1294.2 +014500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1294.2 +014600 02 FILLER PIC X(28) VALUE IF1294.2 +014700 " COPYRIGHT 1985 ". IF1294.2 +014800 01 CCVS-E-1. IF1294.2 +014900 02 FILLER PIC X(52) VALUE SPACE. IF1294.2 +015000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1294.2 +015100 02 ID-AGAIN PIC X(9). IF1294.2 +015200 02 FILLER PIC X(45) VALUE SPACES. IF1294.2 +015300 01 CCVS-E-2. IF1294.2 +015400 02 FILLER PIC X(31) VALUE SPACE. IF1294.2 +015500 02 FILLER PIC X(21) VALUE SPACE. IF1294.2 +015600 02 CCVS-E-2-2. IF1294.2 +015700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1294.2 +015800 03 FILLER PIC X VALUE SPACE. IF1294.2 +015900 03 ENDER-DESC PIC X(44) VALUE IF1294.2 +016000 "ERRORS ENCOUNTERED". IF1294.2 +016100 01 CCVS-E-3. IF1294.2 +016200 02 FILLER PIC X(22) VALUE IF1294.2 +016300 " FOR OFFICIAL USE ONLY". IF1294.2 +016400 02 FILLER PIC X(12) VALUE SPACE. IF1294.2 +016500 02 FILLER PIC X(58) VALUE IF1294.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1294.2 +016700 02 FILLER PIC X(13) VALUE SPACE. IF1294.2 +016800 02 FILLER PIC X(15) VALUE IF1294.2 +016900 " COPYRIGHT 1985". IF1294.2 +017000 01 CCVS-E-4. IF1294.2 +017100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1294.2 +017200 02 FILLER PIC X(4) VALUE " OF ". IF1294.2 +017300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1294.2 +017400 02 FILLER PIC X(40) VALUE IF1294.2 +017500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1294.2 +017600 01 XXINFO. IF1294.2 +017700 02 FILLER PIC X(19) VALUE IF1294.2 +017800 "*** INFORMATION ***". IF1294.2 +017900 02 INFO-TEXT. IF1294.2 +018000 04 FILLER PIC X(8) VALUE SPACE. IF1294.2 +018100 04 XXCOMPUTED PIC X(20). IF1294.2 +018200 04 FILLER PIC X(5) VALUE SPACE. IF1294.2 +018300 04 XXCORRECT PIC X(20). IF1294.2 +018400 02 INF-ANSI-REFERENCE PIC X(48). IF1294.2 +018500 01 HYPHEN-LINE. IF1294.2 +018600 02 FILLER PIC IS X VALUE IS SPACE. IF1294.2 +018700 02 FILLER PIC IS X(65) VALUE IS "************************IF1294.2 +018800- "*****************************************". IF1294.2 +018900 02 FILLER PIC IS X(54) VALUE IS "************************IF1294.2 +019000- "******************************". IF1294.2 +019100 01 CCVS-PGM-ID PIC X(9) VALUE IF1294.2 +019200 "IF129A". IF1294.2 +019300 PROCEDURE DIVISION. IF1294.2 +019400 CCVS1 SECTION. IF1294.2 +019500 OPEN-FILES. IF1294.2 +019600 OPEN OUTPUT PRINT-FILE. IF1294.2 +019700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1294.2 +019800 MOVE SPACE TO TEST-RESULTS. IF1294.2 +019900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1294.2 +020000 GO TO CCVS1-EXIT. IF1294.2 +020100 CLOSE-FILES. IF1294.2 +020200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1294.2 +020300 TERMINATE-CCVS. IF1294.2 +020400 STOP RUN. IF1294.2 +020500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1294.2 +020600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1294.2 +020700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1294.2 +020800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1294.2 +020900 MOVE "****TEST DELETED****" TO RE-MARK. IF1294.2 +021000 PRINT-DETAIL. IF1294.2 +021100 IF REC-CT NOT EQUAL TO ZERO IF1294.2 +021200 MOVE "." TO PARDOT-X IF1294.2 +021300 MOVE REC-CT TO DOTVALUE. IF1294.2 +021400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1294.2 +021500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1294.2 +021600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1294.2 +021700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1294.2 +021800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1294.2 +021900 MOVE SPACE TO CORRECT-X. IF1294.2 +022000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1294.2 +022100 MOVE SPACE TO RE-MARK. IF1294.2 +022200 HEAD-ROUTINE. IF1294.2 +022300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +022400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +022500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1294.2 +022600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1294.2 +022700 COLUMN-NAMES-ROUTINE. IF1294.2 +022800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +022900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +023000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +023100 END-ROUTINE. IF1294.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1294.2 +023300 END-RTN-EXIT. IF1294.2 +023400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +023500 END-ROUTINE-1. IF1294.2 +023600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1294.2 +023700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1294.2 +023800 ADD PASS-COUNTER TO ERROR-HOLD. IF1294.2 +023900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1294.2 +024000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1294.2 +024100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1294.2 +024200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1294.2 +024300 END-ROUTINE-12. IF1294.2 +024400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1294.2 +024500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1294.2 +024600 MOVE "NO " TO ERROR-TOTAL IF1294.2 +024700 ELSE IF1294.2 +024800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1294.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1294.2 +025000 PERFORM WRITE-LINE. IF1294.2 +025100 END-ROUTINE-13. IF1294.2 +025200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1294.2 +025300 MOVE "NO " TO ERROR-TOTAL ELSE IF1294.2 +025400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1294.2 +025500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1294.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +025700 IF INSPECT-COUNTER EQUAL TO ZERO IF1294.2 +025800 MOVE "NO " TO ERROR-TOTAL IF1294.2 +025900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1294.2 +026000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1294.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +026200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1294.2 +026300 WRITE-LINE. IF1294.2 +026400 ADD 1 TO RECORD-COUNT. IF1294.2 +026500 IF RECORD-COUNT GREATER 42 IF1294.2 +026600 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1294.2 +026700 MOVE SPACE TO DUMMY-RECORD IF1294.2 +026800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1294.2 +026900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1294.2 +027000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1294.2 +027100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1294.2 +027200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1294.2 +027300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1294.2 +027400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1294.2 +027500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1294.2 +027600 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1294.2 +027700 MOVE ZERO TO RECORD-COUNT. IF1294.2 +027800 PERFORM WRT-LN. IF1294.2 +027900 WRT-LN. IF1294.2 +028000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1294.2 +028100 MOVE SPACE TO DUMMY-RECORD. IF1294.2 +028200 BLANK-LINE-PRINT. IF1294.2 +028300 PERFORM WRT-LN. IF1294.2 +028400 FAIL-ROUTINE. IF1294.2 +028500 IF COMPUTED-X NOT EQUAL TO SPACE IF1294.2 +028600 GO TO FAIL-ROUTINE-WRITE. IF1294.2 +028700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1294.2 +028800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1294.2 +028900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1294.2 +029000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +029100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1294.2 +029200 GO TO FAIL-ROUTINE-EX. IF1294.2 +029300 FAIL-ROUTINE-WRITE. IF1294.2 +029400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1294.2 +029500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1294.2 +029600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1294.2 +029700 MOVE SPACES TO COR-ANSI-REFERENCE. IF1294.2 +029800 FAIL-ROUTINE-EX. EXIT. IF1294.2 +029900 BAIL-OUT. IF1294.2 +030000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1294.2 +030100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1294.2 +030200 BAIL-OUT-WRITE. IF1294.2 +030300 MOVE CORRECT-A TO XXCORRECT. IF1294.2 +030400 MOVE COMPUTED-A TO XXCOMPUTED. IF1294.2 +030500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1294.2 +030600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1294.2 +030700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1294.2 +030800 BAIL-OUT-EX. EXIT. IF1294.2 +030900 CCVS1-EXIT. IF1294.2 +031000 EXIT. IF1294.2 +031100******************************************************** IF1294.2 +031200* * IF1294.2 +031300* Intrinsic Function Tests IF129A - ORD-MIN * IF1294.2 +031400* * IF1294.2 +031500******************************************************** IF1294.2 +031600 SECT-IF129A SECTION. IF1294.2 +031700 F-ORD-MIN-INFO. IF1294.2 +031800 MOVE "See ref. A-62 2.33" TO ANSI-REFERENCE. IF1294.2 +031900 MOVE "ORD-MIN Function" TO FEATURE. IF1294.2 +032000*****************TEST (a) ****************************** IF1294.2 +032100 F-ORD-MIN-01. IF1294.2 +032200 MOVE ZERO TO WS-INT. IF1294.2 +032300 F-ORD-MIN-TEST-01. IF1294.2 +032400 COMPUTE WS-INT = FUNCTION ORD-MIN(5, 3, 2, 8, 3, 1). IF1294.2 +032500 IF WS-INT = 6 THEN IF1294.2 +032600 PERFORM PASS IF1294.2 +032700 ELSE IF1294.2 +032800 MOVE 6 TO CORRECT-N IF1294.2 +032900 MOVE WS-INT TO COMPUTED-N IF1294.2 +033000 PERFORM FAIL. IF1294.2 +033100 GO TO F-ORD-MIN-WRITE-01. IF1294.2 +033200 F-ORD-MIN-DELETE-01. IF1294.2 +033300 PERFORM DE-LETE. IF1294.2 +033400 GO TO F-ORD-MIN-WRITE-01. IF1294.2 +033500 F-ORD-MIN-WRITE-01. IF1294.2 +033600 MOVE "F-ORD-MIN-01" TO PAR-NAME. IF1294.2 +033700 PERFORM PRINT-DETAIL. IF1294.2 +033800*****************TEST (b) ****************************** IF1294.2 +033900 F-ORD-MIN-TEST-02. IF1294.2 +034000 EVALUATE FUNCTION ORD-MIN(3, 2, 7, 1, 5) IF1294.2 +034100 WHEN 4 IF1294.2 +034200 PERFORM PASS IF1294.2 +034300 GO TO F-ORD-MIN-WRITE-02. IF1294.2 +034400 PERFORM FAIL. IF1294.2 +034500 GO TO F-ORD-MIN-WRITE-02. IF1294.2 +034600 F-ORD-MIN-DELETE-02. IF1294.2 +034700 PERFORM DE-LETE. IF1294.2 +034800 GO TO F-ORD-MIN-WRITE-02. IF1294.2 +034900 F-ORD-MIN-WRITE-02. IF1294.2 +035000 MOVE "F-ORD-MIN-02" TO PAR-NAME. IF1294.2 +035100 PERFORM PRINT-DETAIL. IF1294.2 +035200*****************TEST (c) ****************************** IF1294.2 +035300 F-ORD-MIN-03. IF1294.2 +035400 MOVE ZERO TO WS-INT. IF1294.2 +035500 F-ORD-MIN-TEST-03. IF1294.2 +035600 IF FUNCTION ORD-MIN(5, 4, 3, 6, 2, 8) = 5 IF1294.2 +035700 PERFORM PASS IF1294.2 +035800 ELSE IF1294.2 +035900 PERFORM FAIL. IF1294.2 +036000 GO TO F-ORD-MIN-WRITE-03. IF1294.2 +036100 F-ORD-MIN-DELETE-03. IF1294.2 +036200 PERFORM DE-LETE. IF1294.2 +036300 GO TO F-ORD-MIN-WRITE-03. IF1294.2 +036400 F-ORD-MIN-WRITE-03. IF1294.2 +036500 MOVE "F-ORD-MIN-03" TO PAR-NAME. IF1294.2 +036600 PERFORM PRINT-DETAIL. IF1294.2 +036700*****************TEST (d) ****************************** IF1294.2 +036800 F-ORD-MIN-04. IF1294.2 +036900 MOVE ZERO TO WS-INT. IF1294.2 +037000 F-ORD-MIN-TEST-04. IF1294.2 +037100 COMPUTE WS-INT = FUNCTION ORD-MIN(A, B, C). IF1294.2 +037200 IF WS-INT = 3 THEN IF1294.2 +037300 PERFORM PASS IF1294.2 +037400 ELSE IF1294.2 +037500 MOVE 3 TO CORRECT-N IF1294.2 +037600 MOVE WS-INT TO COMPUTED-N IF1294.2 +037700 PERFORM FAIL. IF1294.2 +037800 GO TO F-ORD-MIN-WRITE-04. IF1294.2 +037900 F-ORD-MIN-DELETE-04. IF1294.2 +038000 PERFORM DE-LETE. IF1294.2 +038100 GO TO F-ORD-MIN-WRITE-04. IF1294.2 +038200 F-ORD-MIN-WRITE-04. IF1294.2 +038300 MOVE "F-ORD-MIN-04" TO PAR-NAME. IF1294.2 +038400 PERFORM PRINT-DETAIL. IF1294.2 +038500*****************TEST (e) ****************************** IF1294.2 +038600 F-ORD-MIN-05. IF1294.2 +038700 MOVE ZERO TO WS-INT. IF1294.2 +038800 F-ORD-MIN-TEST-05. IF1294.2 +038900 COMPUTE WS-INT = FUNCTION ORD-MIN(A, B, D). IF1294.2 +039000 IF WS-INT = 1 THEN IF1294.2 +039100 PERFORM PASS IF1294.2 +039200 ELSE IF1294.2 +039300 MOVE 1 TO CORRECT-N IF1294.2 +039400 MOVE WS-INT TO COMPUTED-N IF1294.2 +039500 PERFORM FAIL. IF1294.2 +039600 GO TO F-ORD-MIN-WRITE-05. IF1294.2 +039700 F-ORD-MIN-DELETE-05. IF1294.2 +039800 PERFORM DE-LETE. IF1294.2 +039900 GO TO F-ORD-MIN-WRITE-05. IF1294.2 +040000 F-ORD-MIN-WRITE-05. IF1294.2 +040100 MOVE "F-ORD-MIN-05" TO PAR-NAME. IF1294.2 +040200 PERFORM PRINT-DETAIL. IF1294.2 +040300*****************TEST (f) ****************************** IF1294.2 +040400 F-ORD-MIN-06. IF1294.2 +040500 MOVE ZERO TO WS-INT. IF1294.2 +040600 F-ORD-MIN-TEST-06. IF1294.2 +040700 COMPUTE WS-INT = FUNCTION ORD-MIN(A, 4, B, 7, 1, 9). IF1294.2 +040800 IF WS-INT = 5 THEN IF1294.2 +040900 PERFORM PASS IF1294.2 +041000 ELSE IF1294.2 +041100 MOVE 5 TO CORRECT-N IF1294.2 +041200 MOVE WS-INT TO COMPUTED-N IF1294.2 +041300 PERFORM FAIL. IF1294.2 +041400 GO TO F-ORD-MIN-WRITE-06. IF1294.2 +041500 F-ORD-MIN-DELETE-06. IF1294.2 +041600 PERFORM DE-LETE. IF1294.2 +041700 GO TO F-ORD-MIN-WRITE-06. IF1294.2 +041800 F-ORD-MIN-WRITE-06. IF1294.2 +041900 MOVE "F-ORD-MIN-06" TO PAR-NAME. IF1294.2 +042000 PERFORM PRINT-DETAIL. IF1294.2 +042100*****************TEST (g) ****************************** IF1294.2 +042200 F-ORD-MIN-07. IF1294.2 +042300 MOVE ZERO TO WS-INT. IF1294.2 +042400 F-ORD-MIN-TEST-07. IF1294.2 +042500 COMPUTE WS-INT = FUNCTION ORD-MIN(4, 1, A, 3). IF1294.2 +042600 IF WS-INT = 2 THEN IF1294.2 +042700 PERFORM PASS IF1294.2 +042800 ELSE IF1294.2 +042900 MOVE 2 TO CORRECT-N IF1294.2 +043000 MOVE WS-INT TO COMPUTED-N IF1294.2 +043100 PERFORM FAIL. IF1294.2 +043200 GO TO F-ORD-MIN-WRITE-07. IF1294.2 +043300 F-ORD-MIN-DELETE-07. IF1294.2 +043400 PERFORM DE-LETE. IF1294.2 +043500 GO TO F-ORD-MIN-WRITE-07. IF1294.2 +043600 F-ORD-MIN-WRITE-07. IF1294.2 +043700 MOVE "F-ORD-MIN-07" TO PAR-NAME. IF1294.2 +043800 PERFORM PRINT-DETAIL. IF1294.2 +043900*****************TEST (h) ****************************** IF1294.2 +044000 F-ORD-MIN-08. IF1294.2 +044100 MOVE ZERO TO WS-INT. IF1294.2 +044200 F-ORD-MIN-TEST-08. IF1294.2 +044300 COMPUTE WS-INT = FUNCTION ORD-MIN("A", I, "P"). IF1294.2 +044400 IF WS-INT = 1 THEN IF1294.2 +044500 PERFORM PASS IF1294.2 +044600 ELSE IF1294.2 +044700 MOVE 1 TO CORRECT-N IF1294.2 +044800 MOVE WS-INT TO COMPUTED-N IF1294.2 +044900 PERFORM FAIL. IF1294.2 +045000 GO TO F-ORD-MIN-WRITE-08. IF1294.2 +045100 F-ORD-MIN-DELETE-08. IF1294.2 +045200 PERFORM DE-LETE. IF1294.2 +045300 GO TO F-ORD-MIN-WRITE-08. IF1294.2 +045400 F-ORD-MIN-WRITE-08. IF1294.2 +045500 MOVE "F-ORD-MIN-08" TO PAR-NAME. IF1294.2 +045600 PERFORM PRINT-DETAIL. IF1294.2 +045700*****************TEST (i) ****************************** IF1294.2 +045800 F-ORD-MIN-09. IF1294.2 +045900 MOVE ZERO TO WS-INT. IF1294.2 +046000 F-ORD-MIN-TEST-09. IF1294.2 +046100 COMPUTE WS-INT = FUNCTION ORD-MIN("S", "D", J). IF1294.2 +046200 IF WS-INT = 2 THEN IF1294.2 +046300 PERFORM PASS IF1294.2 +046400 ELSE IF1294.2 +046500 MOVE 2 TO CORRECT-N IF1294.2 +046600 MOVE WS-INT TO COMPUTED-N IF1294.2 +046700 PERFORM FAIL. IF1294.2 +046800 GO TO F-ORD-MIN-WRITE-09. IF1294.2 +046900 F-ORD-MIN-DELETE-09. IF1294.2 +047000 PERFORM DE-LETE. IF1294.2 +047100 GO TO F-ORD-MIN-WRITE-09. IF1294.2 +047200 F-ORD-MIN-WRITE-09. IF1294.2 +047300 MOVE "F-ORD-MIN-09" TO PAR-NAME. IF1294.2 +047400 PERFORM PRINT-DETAIL. IF1294.2 +047500*****************TEST (j) ****************************** IF1294.2 +047600 F-ORD-MIN-10. IF1294.2 +047700 MOVE ZERO TO WS-INT. IF1294.2 +047800 F-ORD-MIN-TEST-10. IF1294.2 +047900 COMPUTE WS-INT = FUNCTION ORD-MIN(A, 5, 5, A). IF1294.2 +048000 IF WS-INT = 1 THEN IF1294.2 +048100 PERFORM PASS IF1294.2 +048200 ELSE IF1294.2 +048300 MOVE 1 TO CORRECT-N IF1294.2 +048400 MOVE WS-INT TO COMPUTED-N IF1294.2 +048500 PERFORM FAIL. IF1294.2 +048600 GO TO F-ORD-MIN-WRITE-10. IF1294.2 +048700 F-ORD-MIN-DELETE-10. IF1294.2 +048800 PERFORM DE-LETE. IF1294.2 +048900 GO TO F-ORD-MIN-WRITE-10. IF1294.2 +049000 F-ORD-MIN-WRITE-10. IF1294.2 +049100 MOVE "F-ORD-MIN-10" TO PAR-NAME. IF1294.2 +049200 PERFORM PRINT-DETAIL. IF1294.2 +049300*****************TEST (k) ****************************** IF1294.2 +049400 F-ORD-MIN-11. IF1294.2 +049500 MOVE ZERO TO WS-INT. IF1294.2 +049600 F-ORD-MIN-TEST-11. IF1294.2 +049700 COMPUTE WS-INT = FUNCTION ORD-MIN(IND(1), IND(2), IND(3)). IF1294.2 +049800 IF WS-INT = 2 THEN IF1294.2 +049900 PERFORM PASS IF1294.2 +050000 ELSE IF1294.2 +050100 MOVE 2 TO CORRECT-N IF1294.2 +050200 MOVE WS-INT TO COMPUTED-N IF1294.2 +050300 PERFORM FAIL. IF1294.2 +050400 GO TO F-ORD-MIN-WRITE-11. IF1294.2 +050500 F-ORD-MIN-DELETE-11. IF1294.2 +050600 PERFORM DE-LETE. IF1294.2 +050700 GO TO F-ORD-MIN-WRITE-11. IF1294.2 +050800 F-ORD-MIN-WRITE-11. IF1294.2 +050900 MOVE "F-ORD-MIN-11" TO PAR-NAME. IF1294.2 +051000 PERFORM PRINT-DETAIL. IF1294.2 +051100*****************TEST (l) ****************************** IF1294.2 +051200 F-ORD-MIN-12. IF1294.2 +051300 MOVE ZERO TO WS-INT. IF1294.2 +051400 F-ORD-MIN-TEST-12. IF1294.2 +051500 COMPUTE WS-INT = FUNCTION ORD-MIN(IND(P), IND(Q), IND(R)). IF1294.2 +051600 IF WS-INT = 1 THEN IF1294.2 +051700 PERFORM PASS IF1294.2 +051800 ELSE IF1294.2 +051900 MOVE 1 TO CORRECT-N IF1294.2 +052000 MOVE WS-INT TO COMPUTED-N IF1294.2 +052100 PERFORM FAIL. IF1294.2 +052200 GO TO F-ORD-MIN-WRITE-12. IF1294.2 +052300 F-ORD-MIN-DELETE-12. IF1294.2 +052400 PERFORM DE-LETE. IF1294.2 +052500 GO TO F-ORD-MIN-WRITE-12. IF1294.2 +052600 F-ORD-MIN-WRITE-12. IF1294.2 +052700 MOVE "F-ORD-MIN-12" TO PAR-NAME. IF1294.2 +052800 PERFORM PRINT-DETAIL. IF1294.2 +052900*****************TEST (m) ****************************** IF1294.2 +053000 F-ORD-MIN-13. IF1294.2 +053100 MOVE ZERO TO WS-INT. IF1294.2 +053200 F-ORD-MIN-TEST-13. IF1294.2 +053300 COMPUTE WS-INT = FUNCTION ORD-MIN( IF1294.2 +053400 FUNCTION ORD-MIN(1, 4), 3, 7). IF1294.2 +053500 IF WS-INT = 1 THEN IF1294.2 +053600 PERFORM PASS IF1294.2 +053700 ELSE IF1294.2 +053800 MOVE 1 TO CORRECT-N IF1294.2 +053900 MOVE WS-INT TO COMPUTED-N IF1294.2 +054000 PERFORM FAIL. IF1294.2 +054100 GO TO F-ORD-MIN-WRITE-13. IF1294.2 +054200 F-ORD-MIN-DELETE-13. IF1294.2 +054300 PERFORM DE-LETE. IF1294.2 +054400 GO TO F-ORD-MIN-WRITE-13. IF1294.2 +054500 F-ORD-MIN-WRITE-13. IF1294.2 +054600 MOVE "F-ORD-MIN-13" TO PAR-NAME. IF1294.2 +054700 PERFORM PRINT-DETAIL. IF1294.2 +054800*****************TEST (n) ****************************** IF1294.2 +054900 F-ORD-MIN-14. IF1294.2 +055000 MOVE ZERO TO WS-INT. IF1294.2 +055100 F-ORD-MIN-TEST-14. IF1294.2 +rogerw COMPUTE WS-INT = FUNCTION ORD-MIN (4 0 5 3 7). +055300 IF WS-INT = 2 THEN IF1294.2 +055400 PERFORM PASS IF1294.2 +055500 ELSE IF1294.2 +055600 MOVE 2 TO CORRECT-N IF1294.2 +055700 MOVE WS-INT TO COMPUTED-N IF1294.2 +055800 PERFORM FAIL. IF1294.2 +055900 GO TO F-ORD-MIN-WRITE-14. IF1294.2 +056000 F-ORD-MIN-DELETE-14. IF1294.2 +056100 PERFORM DE-LETE. IF1294.2 +056200 GO TO F-ORD-MIN-WRITE-14. IF1294.2 +056300 F-ORD-MIN-WRITE-14. IF1294.2 +056400 MOVE "F-ORD-MIN-14" TO PAR-NAME. IF1294.2 +056500 PERFORM PRINT-DETAIL. IF1294.2 +056600*****************TEST (o) ****************************** IF1294.2 +056700 F-ORD-MIN-15. IF1294.2 +056800 MOVE ZERO TO WS-INT. IF1294.2 +056900 F-ORD-MIN-TEST-15. IF1294.2 +057000 COMPUTE WS-INT = FUNCTION ORD-MIN(2, 3, C) + A. IF1294.2 +057100 IF WS-INT = 6 THEN IF1294.2 +057200 PERFORM PASS IF1294.2 +057300 ELSE IF1294.2 +057400 MOVE 6 TO CORRECT-N IF1294.2 +057500 MOVE WS-INT TO COMPUTED-N IF1294.2 +057600 PERFORM FAIL. IF1294.2 +057700 GO TO F-ORD-MIN-WRITE-15. IF1294.2 +057800 F-ORD-MIN-DELETE-15. IF1294.2 +057900 PERFORM DE-LETE. IF1294.2 +058000 GO TO F-ORD-MIN-WRITE-15. IF1294.2 +058100 F-ORD-MIN-WRITE-15. IF1294.2 +058200 MOVE "F-ORD-MIN-15" TO PAR-NAME. IF1294.2 +058300 PERFORM PRINT-DETAIL. IF1294.2 +058400*****************TEST (p) ****************************** IF1294.2 +058500 F-ORD-MIN-16. IF1294.2 +058600 MOVE ZERO TO WS-INT. IF1294.2 +058700 F-ORD-MIN-TEST-16. IF1294.2 +058800 COMPUTE WS-INT = FUNCTION ORD-MIN(9, 3, A) + IF1294.2 +058900 FUNCTION ORD-MIN(1, 1). IF1294.2 +059000 IF WS-INT = 3 THEN IF1294.2 +059100 PERFORM PASS IF1294.2 +059200 ELSE IF1294.2 +059300 MOVE 3 TO CORRECT-N IF1294.2 +059400 MOVE WS-INT TO COMPUTED-N IF1294.2 +059500 PERFORM FAIL. IF1294.2 +059600 GO TO F-ORD-MIN-WRITE-16. IF1294.2 +059700 F-ORD-MIN-DELETE-16. IF1294.2 +059800 PERFORM DE-LETE. IF1294.2 +059900 GO TO F-ORD-MIN-WRITE-16. IF1294.2 +060000 F-ORD-MIN-WRITE-16. IF1294.2 +060100 MOVE "F-ORD-MIN-16" TO PAR-NAME. IF1294.2 +060200 PERFORM PRINT-DETAIL. IF1294.2 +060300*****************SPECIAL TEST 1****************************** IF1294.2 +060400 F-ORD-MIN-17. IF1294.2 +060500 MOVE 10 TO ARG1 IF1294.2 +060600 PERFORM F-ORD-MIN-TEST-17 IF1294.2 +060700 UNTIL FUNCTION ORD-MIN(2, ARG1) > 1. IF1294.2 +060800* IF1294.2 +060900** when ARG1 = 10 .. 2 ORD-MIN(2,ARG1) = 1 IF1294.2 +061000** when ARG1 = 1 , ORD-MIN(5,ARG1) = 2 IF1294.2 +061100* IF1294.2 +061200 IF ARG1 = 1 THEN IF1294.2 +061300 PERFORM PASS IF1294.2 +061400 ELSE IF1294.2 +061500 MOVE 1 TO CORRECT-N IF1294.2 +061600 MOVE ARG1 TO COMPUTED-N IF1294.2 +061700 PERFORM FAIL. IF1294.2 +061800 GO TO F-ORD-MIN-WRITE-17. IF1294.2 +061900* IF1294.2 +062000 F-ORD-MIN-TEST-17. IF1294.2 +062100 COMPUTE ARG1 = ARG1 - 1. IF1294.2 +062200* IF1294.2 +062300 F-ORD-MIN-DELETE-17. IF1294.2 +062400 PERFORM DE-LETE. IF1294.2 +062500 GO TO F-ORD-MIN-WRITE-17. IF1294.2 +062600 F-ORD-MIN-WRITE-17. IF1294.2 +062700 MOVE "F-ORD-MIN-17" TO PAR-NAME. IF1294.2 +062800 PERFORM PRINT-DETAIL. IF1294.2 +062900*******************END OF TESTS************************** IF1294.2 +063000 CCVS-EXIT SECTION. IF1294.2 +063100 CCVS-999999. IF1294.2 +063200 GO TO CLOSE-FILES. IF1294.2 diff --git a/tests/cobol85/IF/IF130A.CBL b/tests/cobol85/IF/IF130A.CBL new file mode 100755 index 00000000..e9e9ad96 --- /dev/null +++ b/tests/cobol85/IF/IF130A.CBL @@ -0,0 +1,818 @@ +000100 IDENTIFICATION DIVISION. IF1304.2 +000200 PROGRAM-ID. IF1304.2 +000300 IF130A. IF1304.2 +000400 IF1304.2 +000500*********************************************************** IF1304.2 +000600* * IF1304.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1304.2 +000800* It contains tests for the Intrinsic Function * IF1304.2 +000900* PRESENT-VALUE. * IF1304.2 +001000* * IF1304.2 +001100*********************************************************** IF1304.2 +001200 ENVIRONMENT DIVISION. IF1304.2 +001300 CONFIGURATION SECTION. IF1304.2 +001400 SOURCE-COMPUTER. IF1304.2 +001500 Linux. IF1304.2 +001600 OBJECT-COMPUTER. IF1304.2 +001700 Linux. IF1304.2 +001800 INPUT-OUTPUT SECTION. IF1304.2 +001900 FILE-CONTROL. IF1304.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1304.2 +002100 "report.log". IF1304.2 +002200 DATA DIVISION. IF1304.2 +002300 FILE SECTION. IF1304.2 +002400 FD PRINT-FILE. IF1304.2 +002500 01 PRINT-REC PICTURE X(120). IF1304.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1304.2 +002700 WORKING-STORAGE SECTION. IF1304.2 +002800*********************************************************** IF1304.2 +002900* Variables specific to the Intrinsic Function Test IF130A* IF1304.2 +003000*********************************************************** IF1304.2 +003100 01 A PIC S9(10) VALUE 5. IF1304.2 +003200 01 B PIC S9(10) VALUE 7. IF1304.2 +003300 01 C PIC S9(10) VALUE -4. IF1304.2 +003400 01 D PIC S9(10) VALUE 10. IF1304.2 +003500 01 E PIC S9(5)V9(5) VALUE 34.26. IF1304.2 +003600 01 F PIC S9(5)V9(5) VALUE -8.32. IF1304.2 +003700 01 G PIC S9(5)V9(5) VALUE 4.08. IF1304.2 +003800 01 H PIC S9(5)V9(5) VALUE 5.3. IF1304.2 +003900 01 I PIC S9(5)V9(5) VALUE 0.0009. IF1304.2 +004000 01 J PIC S9(5)V9(5) VALUE 0.0008. IF1304.2 +004100 01 K PIC S9(10) VALUE 23000. IF1304.2 +004200 01 L PIC S9(10) VALUE -23000. IF1304.2 +004300 01 P PIC S9(10) VALUE 1. IF1304.2 +004400 01 Q PIC S9(10) VALUE 3. IF1304.2 +004500 01 R PIC S9(10) VALUE 5. IF1304.2 +004600 01 ARG1 PIC S9(10) VALUE 0. IF1304.2 +004700 01 ARR VALUE "40537". IF1304.2 +004800 02 IND OCCURS 5 TIMES PIC 9. IF1304.2 +004900 01 TEMP PIC S9(10)V9(5). IF1304.2 +005000 01 WS-NUM PIC S9(5)V9(6). IF1304.2 +005100 01 MIN-RANGE PIC S9(5)V9(7). IF1304.2 +005200 01 MAX-RANGE PIC S9(5)V9(7). IF1304.2 +005300* IF1304.2 +005400********************************************************** IF1304.2 +005500* IF1304.2 +005600 01 TEST-RESULTS. IF1304.2 +005700 02 FILLER PIC X VALUE SPACE. IF1304.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. IF1304.2 +005900 02 FILLER PIC X VALUE SPACE. IF1304.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. IF1304.2 +006100 02 FILLER PIC X VALUE SPACE. IF1304.2 +006200 02 PAR-NAME. IF1304.2 +006300 03 FILLER PIC X(19) VALUE SPACE. IF1304.2 +006400 03 PARDOT-X PIC X VALUE SPACE. IF1304.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. IF1304.2 +006600 02 FILLER PIC X(8) VALUE SPACE. IF1304.2 +006700 02 RE-MARK PIC X(61). IF1304.2 +006800 01 TEST-COMPUTED. IF1304.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1304.2 +007000 02 FILLER PIC X(17) VALUE IF1304.2 +007100 " COMPUTED=". IF1304.2 +007200 02 COMPUTED-X. IF1304.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1304.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A IF1304.2 +007500 PIC -9(9).9(9). IF1304.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1304.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1304.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1304.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. IF1304.2 +008000 04 COMPUTED-18V0 PIC -9(18). IF1304.2 +008100 04 FILLER PIC X. IF1304.2 +008200 03 FILLER PIC X(50) VALUE SPACE. IF1304.2 +008300 01 TEST-CORRECT. IF1304.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IF1304.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". IF1304.2 +008600 02 CORRECT-X. IF1304.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. IF1304.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1304.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1304.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1304.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1304.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. IF1304.2 +009300 04 CORRECT-18V0 PIC -9(18). IF1304.2 +009400 04 FILLER PIC X. IF1304.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IF1304.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1304.2 +009700 01 TEST-CORRECT-MIN. IF1304.2 +009800 02 FILLER PIC X(30) VALUE SPACE. IF1304.2 +009900 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1304.2 +010000 02 CORRECTMI-X. IF1304.2 +010100 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1304.2 +010200 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1304.2 +010300 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1304.2 +010400 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1304.2 +010500 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1304.2 +010600 03 CR-18V0 REDEFINES CORRECTMI-A. IF1304.2 +010700 04 CORRECTMI-18V0 PIC -9(18). IF1304.2 +010800 04 FILLER PIC X. IF1304.2 +010900 03 FILLER PIC X(2) VALUE SPACE. IF1304.2 +011000 03 FILLER PIC X(48) VALUE SPACE. IF1304.2 +011100 01 TEST-CORRECT-MAX. IF1304.2 +011200 02 FILLER PIC X(30) VALUE SPACE. IF1304.2 +011300 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1304.2 +011400 02 CORRECTMA-X. IF1304.2 +011500 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1304.2 +011600 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1304.2 +011700 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1304.2 +011800 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1304.2 +011900 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1304.2 +012000 03 CR-18V0 REDEFINES CORRECTMA-A. IF1304.2 +012100 04 CORRECTMA-18V0 PIC -9(18). IF1304.2 +012200 04 FILLER PIC X. IF1304.2 +012300 03 FILLER PIC X(2) VALUE SPACE. IF1304.2 +012400 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1304.2 +012500 01 CCVS-C-1. IF1304.2 +012600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1304.2 +012700- "SS PARAGRAPH-NAME IF1304.2 +012800- " REMARKS". IF1304.2 +012900 02 FILLER PIC X(20) VALUE SPACE. IF1304.2 +013000 01 CCVS-C-2. IF1304.2 +013100 02 FILLER PIC X VALUE SPACE. IF1304.2 +013200 02 FILLER PIC X(6) VALUE "TESTED". IF1304.2 +013300 02 FILLER PIC X(15) VALUE SPACE. IF1304.2 +013400 02 FILLER PIC X(4) VALUE "FAIL". IF1304.2 +013500 02 FILLER PIC X(94) VALUE SPACE. IF1304.2 +013600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1304.2 +013700 01 REC-CT PIC 99 VALUE ZERO. IF1304.2 +013800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1304.2 +013900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1304.2 +014000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1304.2 +014100 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1304.2 +014200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1304.2 +014300 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1304.2 +014400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1304.2 +014500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1304.2 +014600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1304.2 +014700 01 CCVS-H-1. IF1304.2 +014800 02 FILLER PIC X(39) VALUE SPACES. IF1304.2 +014900 02 FILLER PIC X(42) VALUE IF1304.2 +015000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1304.2 +015100 02 FILLER PIC X(39) VALUE SPACES. IF1304.2 +015200 01 CCVS-H-2A. IF1304.2 +015300 02 FILLER PIC X(40) VALUE SPACE. IF1304.2 +015400 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1304.2 +015500 02 FILLER PIC XXXX VALUE IF1304.2 +015600 "4.2 ". IF1304.2 +015700 02 FILLER PIC X(28) VALUE IF1304.2 +015800 " COPY - NOT FOR DISTRIBUTION". IF1304.2 +015900 02 FILLER PIC X(41) VALUE SPACE. IF1304.2 +016000 IF1304.2 +016100 01 CCVS-H-2B. IF1304.2 +016200 02 FILLER PIC X(15) VALUE IF1304.2 +016300 "TEST RESULT OF ". IF1304.2 +016400 02 TEST-ID PIC X(9). IF1304.2 +016500 02 FILLER PIC X(4) VALUE IF1304.2 +016600 " IN ". IF1304.2 +016700 02 FILLER PIC X(12) VALUE IF1304.2 +016800 " HIGH ". IF1304.2 +016900 02 FILLER PIC X(22) VALUE IF1304.2 +017000 " LEVEL VALIDATION FOR ". IF1304.2 +017100 02 FILLER PIC X(58) VALUE IF1304.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1304.2 +017300 01 CCVS-H-3. IF1304.2 +017400 02 FILLER PIC X(34) VALUE IF1304.2 +017500 " FOR OFFICIAL USE ONLY ". IF1304.2 +017600 02 FILLER PIC X(58) VALUE IF1304.2 +017700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1304.2 +017800 02 FILLER PIC X(28) VALUE IF1304.2 +017900 " COPYRIGHT 1985 ". IF1304.2 +018000 01 CCVS-E-1. IF1304.2 +018100 02 FILLER PIC X(52) VALUE SPACE. IF1304.2 +018200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1304.2 +018300 02 ID-AGAIN PIC X(9). IF1304.2 +018400 02 FILLER PIC X(45) VALUE SPACES. IF1304.2 +018500 01 CCVS-E-2. IF1304.2 +018600 02 FILLER PIC X(31) VALUE SPACE. IF1304.2 +018700 02 FILLER PIC X(21) VALUE SPACE. IF1304.2 +018800 02 CCVS-E-2-2. IF1304.2 +018900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1304.2 +019000 03 FILLER PIC X VALUE SPACE. IF1304.2 +019100 03 ENDER-DESC PIC X(44) VALUE IF1304.2 +019200 "ERRORS ENCOUNTERED". IF1304.2 +019300 01 CCVS-E-3. IF1304.2 +019400 02 FILLER PIC X(22) VALUE IF1304.2 +019500 " FOR OFFICIAL USE ONLY". IF1304.2 +019600 02 FILLER PIC X(12) VALUE SPACE. IF1304.2 +019700 02 FILLER PIC X(58) VALUE IF1304.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1304.2 +019900 02 FILLER PIC X(13) VALUE SPACE. IF1304.2 +020000 02 FILLER PIC X(15) VALUE IF1304.2 +020100 " COPYRIGHT 1985". IF1304.2 +020200 01 CCVS-E-4. IF1304.2 +020300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1304.2 +020400 02 FILLER PIC X(4) VALUE " OF ". IF1304.2 +020500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1304.2 +020600 02 FILLER PIC X(40) VALUE IF1304.2 +020700 " TESTS WERE EXECUTED SUCCESSFULLY". IF1304.2 +020800 01 XXINFO. IF1304.2 +020900 02 FILLER PIC X(19) VALUE IF1304.2 +021000 "*** INFORMATION ***". IF1304.2 +021100 02 INFO-TEXT. IF1304.2 +021200 04 FILLER PIC X(8) VALUE SPACE. IF1304.2 +021300 04 XXCOMPUTED PIC X(20). IF1304.2 +021400 04 FILLER PIC X(5) VALUE SPACE. IF1304.2 +021500 04 XXCORRECT PIC X(20). IF1304.2 +021600 02 INF-ANSI-REFERENCE PIC X(48). IF1304.2 +021700 01 HYPHEN-LINE. IF1304.2 +021800 02 FILLER PIC IS X VALUE IS SPACE. IF1304.2 +021900 02 FILLER PIC IS X(65) VALUE IS "************************IF1304.2 +022000- "*****************************************". IF1304.2 +022100 02 FILLER PIC IS X(54) VALUE IS "************************IF1304.2 +022200- "******************************". IF1304.2 +022300 01 CCVS-PGM-ID PIC X(9) VALUE IF1304.2 +022400 "IF130A". IF1304.2 +022500 PROCEDURE DIVISION. IF1304.2 +022600 CCVS1 SECTION. IF1304.2 +022700 OPEN-FILES. IF1304.2 +022800 OPEN OUTPUT PRINT-FILE. IF1304.2 +022900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1304.2 +023000 MOVE SPACE TO TEST-RESULTS. IF1304.2 +023100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1304.2 +023200 GO TO CCVS1-EXIT. IF1304.2 +023300 CLOSE-FILES. IF1304.2 +023400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1304.2 +023500 TERMINATE-CCVS. IF1304.2 +023600 STOP RUN. IF1304.2 +023700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1304.2 +023800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1304.2 +023900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1304.2 +024000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1304.2 +024100 MOVE "****TEST DELETED****" TO RE-MARK. IF1304.2 +024200 PRINT-DETAIL. IF1304.2 +024300 IF REC-CT NOT EQUAL TO ZERO IF1304.2 +024400 MOVE "." TO PARDOT-X IF1304.2 +024500 MOVE REC-CT TO DOTVALUE. IF1304.2 +024600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1304.2 +024700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1304.2 +024800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1304.2 +024900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1304.2 +025000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1304.2 +025100 MOVE SPACE TO CORRECT-X. IF1304.2 +025200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1304.2 +025300 MOVE SPACE TO RE-MARK. IF1304.2 +025400 HEAD-ROUTINE. IF1304.2 +025500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +025600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +025700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1304.2 +025800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1304.2 +025900 COLUMN-NAMES-ROUTINE. IF1304.2 +026000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +026100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +026300 END-ROUTINE. IF1304.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1304.2 +026500 END-RTN-EXIT. IF1304.2 +026600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +026700 END-ROUTINE-1. IF1304.2 +026800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1304.2 +026900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1304.2 +027000 ADD PASS-COUNTER TO ERROR-HOLD. IF1304.2 +027100 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1304.2 +027200 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1304.2 +027300 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1304.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1304.2 +027500 END-ROUTINE-12. IF1304.2 +027600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1304.2 +027700 IF ERROR-COUNTER IS EQUAL TO ZERO IF1304.2 +027800 MOVE "NO " TO ERROR-TOTAL IF1304.2 +027900 ELSE IF1304.2 +028000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1304.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1304.2 +028200 PERFORM WRITE-LINE. IF1304.2 +028300 END-ROUTINE-13. IF1304.2 +028400 IF DELETE-COUNTER IS EQUAL TO ZERO IF1304.2 +028500 MOVE "NO " TO ERROR-TOTAL ELSE IF1304.2 +028600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1304.2 +028700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1304.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +028900 IF INSPECT-COUNTER EQUAL TO ZERO IF1304.2 +029000 MOVE "NO " TO ERROR-TOTAL IF1304.2 +029100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1304.2 +029200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1304.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +029400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1304.2 +029500 WRITE-LINE. IF1304.2 +029600 ADD 1 TO RECORD-COUNT. IF1304.2 +029700 IF RECORD-COUNT GREATER 42 IF1304.2 +029800 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1304.2 +029900 MOVE SPACE TO DUMMY-RECORD IF1304.2 +030000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1304.2 +030100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1304.2 +030200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1304.2 +030300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1304.2 +030400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1304.2 +030500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1304.2 +030600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1304.2 +030700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1304.2 +030800 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1304.2 +030900 MOVE ZERO TO RECORD-COUNT. IF1304.2 +031000 PERFORM WRT-LN. IF1304.2 +031100 WRT-LN. IF1304.2 +031200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1304.2 +031300 MOVE SPACE TO DUMMY-RECORD. IF1304.2 +031400 BLANK-LINE-PRINT. IF1304.2 +031500 PERFORM WRT-LN. IF1304.2 +031600 FAIL-ROUTINE. IF1304.2 +031700 IF COMPUTED-X NOT EQUAL TO SPACE IF1304.2 +031800 GO TO FAIL-ROUTINE-WRITE. IF1304.2 +031900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1304.2 +032000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1304.2 +032100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1304.2 +032200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +032300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1304.2 +032400 GO TO FAIL-ROUTINE-EX. IF1304.2 +032500 FAIL-ROUTINE-WRITE. IF1304.2 +032600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1304.2 +032700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1304.2 +032800 CORMA-ANSI-REFERENCE. IF1304.2 +032900 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1304.2 +033000 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1304.2 +033100 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1304.2 +033200 ELSE IF1304.2 +033300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1304.2 +033400 PERFORM WRITE-LINE. IF1304.2 +033500 MOVE SPACES TO COR-ANSI-REFERENCE. IF1304.2 +033600 FAIL-ROUTINE-EX. EXIT. IF1304.2 +033700 BAIL-OUT. IF1304.2 +033800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1304.2 +033900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1304.2 +034000 BAIL-OUT-WRITE. IF1304.2 +034100 MOVE CORRECT-A TO XXCORRECT. IF1304.2 +034200 MOVE COMPUTED-A TO XXCOMPUTED. IF1304.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1304.2 +034400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1304.2 +034500 MOVE SPACES TO INF-ANSI-REFERENCE. IF1304.2 +034600 BAIL-OUT-EX. EXIT. IF1304.2 +034700 CCVS1-EXIT. IF1304.2 +034800 EXIT. IF1304.2 +034900******************************************************** IF1304.2 +035000* * IF1304.2 +035100* Intrinsic Function Tests IF130A - PRESENT-VALUE * IF1304.2 +035200* * IF1304.2 +035300******************************************************** IF1304.2 +035400 SECT-IF130A SECTION. IF1304.2 +035500 F-PRES-VAL-INFO. IF1304.2 +035600 MOVE "See ref. A-63 2.34" TO ANSI-REFERENCE. IF1304.2 +035700 MOVE "PRESENT-VALUE Function" TO FEATURE. IF1304.2 +035800*****************TEST (a) - SIMPLE TEST***************** IF1304.2 +035900 F-PRES-VAL-01. IF1304.2 +036000 MOVE ZERO TO WS-NUM. IF1304.2 +036100 MOVE 43.9991 TO MIN-RANGE. IF1304.2 +036200 MOVE 44.0009 TO MAX-RANGE. IF1304.2 +036300 F-PRES-VAL-TEST-01. IF1304.2 +036400 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(0, 23, 12, 9). IF1304.2 +036500 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +036600 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +036700 PERFORM PASS IF1304.2 +036800 ELSE IF1304.2 +036900 MOVE WS-NUM TO COMPUTED-N IF1304.2 +037000 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +037100 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +037200 PERFORM FAIL. IF1304.2 +037300 GO TO F-PRES-VAL-WRITE-01. IF1304.2 +037400 F-PRES-VAL-DELETE-01. IF1304.2 +037500 PERFORM DE-LETE. IF1304.2 +037600 GO TO F-PRES-VAL-WRITE-01. IF1304.2 +037700 F-PRES-VAL-WRITE-01. IF1304.2 +037800 MOVE "F-PRES-VAL-01" TO PAR-NAME. IF1304.2 +037900 PERFORM PRINT-DETAIL. IF1304.2 +038000*****************TEST (b) - SIMPLE TEST***************** IF1304.2 +038100 F-PRES-VAL-02. IF1304.2 +038200 EVALUATE FUNCTION PRESENT-VALUE(1, 10, 20, 10, 5) IF1304.2 +038300 WHEN 11.5623 THRU 11.5627 IF1304.2 +038400 PERFORM PASS IF1304.2 +038500 WHEN OTHER IF1304.2 +038600 PERFORM FAIL. IF1304.2 +038700 GO TO F-PRES-VAL-WRITE-02. IF1304.2 +038800 F-PRES-VAL-DELETE-02. IF1304.2 +038900 PERFORM DE-LETE. IF1304.2 +039000 GO TO F-PRES-VAL-WRITE-02. IF1304.2 +039100 F-PRES-VAL-WRITE-02. IF1304.2 +039200 MOVE "F-PRES-VAL-02" TO PAR-NAME. IF1304.2 +039300 PERFORM PRINT-DETAIL. IF1304.2 +039400*****************TEST (c) - SIMPLE TEST***************** IF1304.2 +039500 F-PRES-VAL-03. IF1304.2 +039600 MOVE 9.53314 TO MIN-RANGE. IF1304.2 +039700 MOVE 9.53352 TO MAX-RANGE. IF1304.2 +039800 F-PRES-VAL-TEST-03. IF1304.2 +039900 IF (FUNCTION PRESENT-VALUE(.5, 8.3, 2.4, 9.9) IF1304.2 +040000 >= MIN-RANGE) AND IF1304.2 +040100 (FUNCTION PRESENT-VALUE(.5, 8.3, 2.4, 9.9) IF1304.2 +040200 <= MAX-RANGE) THEN IF1304.2 +040300 PERFORM PASS IF1304.2 +040400 ELSE IF1304.2 +040500 PERFORM FAIL. IF1304.2 +040600 GO TO F-PRES-VAL-WRITE-03. IF1304.2 +040700 F-PRES-VAL-DELETE-03. IF1304.2 +040800 PERFORM DE-LETE. IF1304.2 +040900 GO TO F-PRES-VAL-WRITE-03. IF1304.2 +041000 F-PRES-VAL-WRITE-03. IF1304.2 +041100 MOVE "F-PRES-VAL-03" TO PAR-NAME. IF1304.2 +041200 PERFORM PRINT-DETAIL. IF1304.2 +041300*****************TEST (d) - SIMPLE TEST***************** IF1304.2 +041400 F-PRES-VAL-04. IF1304.2 +041500 MOVE ZERO TO WS-NUM. IF1304.2 +041600 MOVE 22.6274 TO MIN-RANGE. IF1304.2 +041700 MOVE 22.6283 TO MAX-RANGE. IF1304.2 +041800 F-PRES-VAL-TEST-04. IF1304.2 +041900 COMPUTE WS-NUM = IF1304.2 +042000 FUNCTION PRESENT-VALUE(.1, 5, 4, 2.8, 3.1, 17). IF1304.2 +042100 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +042200 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +042300 PERFORM PASS IF1304.2 +042400 ELSE IF1304.2 +042500 MOVE WS-NUM TO COMPUTED-N IF1304.2 +042600 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +042700 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +042800 PERFORM FAIL. IF1304.2 +042900 GO TO F-PRES-VAL-WRITE-04. IF1304.2 +043000 F-PRES-VAL-DELETE-04. IF1304.2 +043100 PERFORM DE-LETE. IF1304.2 +043200 GO TO F-PRES-VAL-WRITE-04. IF1304.2 +043300 F-PRES-VAL-WRITE-04. IF1304.2 +043400 MOVE "F-PRES-VAL-04" TO PAR-NAME. IF1304.2 +043500 PERFORM PRINT-DETAIL. IF1304.2 +043600*****************TEST (e) - SIMPLE TEST***************** IF1304.2 +043700 F-PRES-VAL-05. IF1304.2 +043800 MOVE ZERO TO WS-NUM. IF1304.2 +043900 MOVE 20.1691 TO MIN-RANGE. IF1304.2 +044000 MOVE 20.1699 TO MAX-RANGE. IF1304.2 +044100 F-PRES-VAL-TEST-05. IF1304.2 +044200 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.04, A, B, D). IF1304.2 +044300 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +044400 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +044500 PERFORM PASS IF1304.2 +044600 ELSE IF1304.2 +044700 MOVE WS-NUM TO COMPUTED-N IF1304.2 +044800 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +044900 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +045000 PERFORM FAIL. IF1304.2 +045100 GO TO F-PRES-VAL-WRITE-05. IF1304.2 +045200 F-PRES-VAL-DELETE-05. IF1304.2 +045300 PERFORM DE-LETE. IF1304.2 +045400 GO TO F-PRES-VAL-WRITE-05. IF1304.2 +045500 F-PRES-VAL-WRITE-05. IF1304.2 +045600 MOVE "F-PRES-VAL-05" TO PAR-NAME. IF1304.2 +045700 PERFORM PRINT-DETAIL. IF1304.2 +045800*****************TEST (f) - SIMPLE TEST***************** IF1304.2 +045900 F-PRES-VAL-06. IF1304.2 +046000 MOVE ZERO TO WS-NUM. IF1304.2 +046100 MOVE 33.3113 TO MIN-RANGE. IF1304.2 +046200 MOVE 33.3127 TO MAX-RANGE. IF1304.2 +046300 F-PRES-VAL-TEST-06. IF1304.2 +046400 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.08, E, G, H, F). IF1304.2 +046500 IF1304.2 +046600 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +046700 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +046800 PERFORM PASS IF1304.2 +046900 ELSE IF1304.2 +047000 MOVE WS-NUM TO COMPUTED-N IF1304.2 +047100 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +047200 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +047300 PERFORM FAIL. IF1304.2 +047400 GO TO F-PRES-VAL-WRITE-06. IF1304.2 +047500 F-PRES-VAL-DELETE-06. IF1304.2 +047600 PERFORM DE-LETE. IF1304.2 +047700 GO TO F-PRES-VAL-WRITE-06. IF1304.2 +047800 F-PRES-VAL-WRITE-06. IF1304.2 +047900 MOVE "F-PRES-VAL-06" TO PAR-NAME. IF1304.2 +048000 PERFORM PRINT-DETAIL. IF1304.2 +048100*****************TEST (g) - SIMPLE TEST***************** IF1304.2 +048200 F-PRES-VAL-07. IF1304.2 +048300 MOVE ZERO TO WS-NUM. IF1304.2 +048400 MOVE 5.76505 TO MIN-RANGE. IF1304.2 +048500 MOVE 5.76528 TO MAX-RANGE. IF1304.2 +048600 F-PRES-VAL-TEST-07. IF1304.2 +048700 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.2, C, A, 5, 4, 2). IF1304.2 +048800 IF1304.2 +048900 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +049000 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +049100 PERFORM PASS IF1304.2 +049200 ELSE IF1304.2 +049300 MOVE WS-NUM TO COMPUTED-N IF1304.2 +049400 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +049500 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +049600 PERFORM FAIL. IF1304.2 +049700 GO TO F-PRES-VAL-WRITE-07. IF1304.2 +049800 F-PRES-VAL-DELETE-07. IF1304.2 +049900 PERFORM DE-LETE. IF1304.2 +050000 GO TO F-PRES-VAL-WRITE-07. IF1304.2 +050100 F-PRES-VAL-WRITE-07. IF1304.2 +050200 MOVE "F-PRES-VAL-07" TO PAR-NAME. IF1304.2 +050300 PERFORM PRINT-DETAIL. IF1304.2 +050400*****************TEST (h) - SIMPLE TEST***************** IF1304.2 +050500 F-PRES-VAL-08. IF1304.2 +050600 MOVE ZERO TO WS-NUM. IF1304.2 +050700 MOVE 0.361674 TO MIN-RANGE. IF1304.2 +050800 MOVE 0.361689 TO MAX-RANGE. IF1304.2 +050900 F-PRES-VAL-TEST-08. IF1304.2 +051000 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.3, A, H, .07, -19). IF1304.2 +051100 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +051200 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +051300 PERFORM PASS IF1304.2 +051400 ELSE IF1304.2 +051500 MOVE WS-NUM TO COMPUTED-N IF1304.2 +051600 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +051700 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +051800 PERFORM FAIL. IF1304.2 +051900 GO TO F-PRES-VAL-WRITE-08. IF1304.2 +052000 F-PRES-VAL-DELETE-08. IF1304.2 +052100 PERFORM DE-LETE. IF1304.2 +052200 GO TO F-PRES-VAL-WRITE-08. IF1304.2 +052300 F-PRES-VAL-WRITE-08. IF1304.2 +052400 MOVE "F-PRES-VAL-08" TO PAR-NAME. IF1304.2 +052500 PERFORM PRINT-DETAIL. IF1304.2 +052600*****************TEST (i) - SIMPLE TEST***************** IF1304.2 +052700 F-PRES-VAL-09. IF1304.2 +052800 MOVE ZERO TO WS-NUM. IF1304.2 +052900 MOVE -0.001500 TO MIN-RANGE. IF1304.2 +053000 MOVE -0.001498 TO MAX-RANGE. IF1304.2 +053100 F-PRES-VAL-TEST-09. IF1304.2 +053200 COMPUTE WS-NUM = IF1304.2 +053300 FUNCTION PRESENT-VALUE(.09, -.0009, -.0008). IF1304.2 +053400 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +053500 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +053600 PERFORM PASS IF1304.2 +053700 ELSE IF1304.2 +053800 MOVE WS-NUM TO COMPUTED-N IF1304.2 +053900 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +054000 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +054100 PERFORM FAIL. IF1304.2 +054200 GO TO F-PRES-VAL-WRITE-09. IF1304.2 +054300 F-PRES-VAL-DELETE-09. IF1304.2 +054400 PERFORM DE-LETE. IF1304.2 +054500 GO TO F-PRES-VAL-WRITE-09. IF1304.2 +054600 F-PRES-VAL-WRITE-09. IF1304.2 +054700 MOVE "F-PRES-VAL-09" TO PAR-NAME. IF1304.2 +054800 PERFORM PRINT-DETAIL. IF1304.2 +054900*****************TEST (k) - SIMPLE TEST***************** IF1304.2 +055000 F-PRES-VAL-11. IF1304.2 +055100 MOVE ZERO TO WS-NUM. IF1304.2 +055200 MOVE 57454.07 TO MIN-RANGE. IF1304.2 +055300 MOVE 57456.37 TO MAX-RANGE. IF1304.2 +055400 F-PRES-VAL-TEST-11. IF1304.2 +055500 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.4, 30000, 40000, IF1304.2 +055600 100000, -80000). IF1304.2 +055700 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +055800 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +055900 PERFORM PASS IF1304.2 +056000 ELSE IF1304.2 +056100 MOVE WS-NUM TO COMPUTED-N IF1304.2 +056200 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +056300 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +056400 PERFORM FAIL. IF1304.2 +056500 GO TO F-PRES-VAL-WRITE-11. IF1304.2 +056600 F-PRES-VAL-DELETE-11. IF1304.2 +056700 PERFORM DE-LETE. IF1304.2 +056800 GO TO F-PRES-VAL-WRITE-11. IF1304.2 +056900 F-PRES-VAL-WRITE-11. IF1304.2 +057000 MOVE "F-PRES-VAL-11" TO PAR-NAME. IF1304.2 +057100 PERFORM PRINT-DETAIL. IF1304.2 +057200*****************TEST (l) - SIMPLE TEST***************** IF1304.2 +057300 F-PRES-VAL-12. IF1304.2 +057400 MOVE ZERO TO WS-NUM. IF1304.2 +057500 MOVE -1406.26 TO MIN-RANGE. IF1304.2 +057600 MOVE -1406.21 TO MAX-RANGE. IF1304.2 +057700 F-PRES-VAL-TEST-12. IF1304.2 +057800 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.07, L, K). IF1304.2 +057900 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +058000 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +058100 PERFORM PASS IF1304.2 +058200 ELSE IF1304.2 +058300 MOVE WS-NUM TO COMPUTED-N IF1304.2 +058400 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +058500 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +058600 PERFORM FAIL. IF1304.2 +058700 GO TO F-PRES-VAL-WRITE-12. IF1304.2 +058800 F-PRES-VAL-DELETE-12. IF1304.2 +058900 PERFORM DE-LETE. IF1304.2 +059000 GO TO F-PRES-VAL-WRITE-12. IF1304.2 +059100 F-PRES-VAL-WRITE-12. IF1304.2 +059200 MOVE "F-PRES-VAL-12" TO PAR-NAME. IF1304.2 +059300 PERFORM PRINT-DETAIL. IF1304.2 +059400*****************TEST (m) - SIMPLE TEST***************** IF1304.2 +059500 F-PRES-VAL-13. IF1304.2 +059600 MOVE ZERO TO WS-NUM. IF1304.2 +059700 MOVE 6.76570 TO MIN-RANGE. IF1304.2 +059800 MOVE 6.76597 TO MAX-RANGE. IF1304.2 +059900 F-PRES-VAL-TEST-13. IF1304.2 +060000 COMPUTE WS-NUM = IF1304.2 +060100 FUNCTION PRESENT-VALUE(.15, IND(1), IND(2), IF1304.2 +060200 IND(3)). IF1304.2 +060300 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +060400 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +060500 PERFORM PASS IF1304.2 +060600 ELSE IF1304.2 +060700 MOVE WS-NUM TO COMPUTED-N IF1304.2 +060800 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +060900 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +061000 PERFORM FAIL. IF1304.2 +061100 GO TO F-PRES-VAL-WRITE-13. IF1304.2 +061200 F-PRES-VAL-DELETE-13. IF1304.2 +061300 PERFORM DE-LETE. IF1304.2 +061400 GO TO F-PRES-VAL-WRITE-13. IF1304.2 +061500 F-PRES-VAL-WRITE-13. IF1304.2 +061600 MOVE "F-PRES-VAL-13" TO PAR-NAME. IF1304.2 +061700 PERFORM PRINT-DETAIL. IF1304.2 +061800*****************TEST (n) - SIMPLE TEST***************** IF1304.2 +061900 F-PRES-VAL-14. IF1304.2 +062000 MOVE ZERO TO WS-NUM. IF1304.2 +062100 MOVE 12.3066 TO MIN-RANGE. IF1304.2 +062200 MOVE 12.3071 TO MAX-RANGE. IF1304.2 +062300 F-PRES-VAL-TEST-14. IF1304.2 +062400 COMPUTE WS-NUM = IF1304.2 +062500 FUNCTION PRESENT-VALUE(.13, IND(P), IND(Q), IND(R)). IF1304.2 +062600 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +062700 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +062800 PERFORM PASS IF1304.2 +062900 ELSE IF1304.2 +063000 MOVE WS-NUM TO COMPUTED-N IF1304.2 +063100 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +063200 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +063300 PERFORM FAIL. IF1304.2 +063400 GO TO F-PRES-VAL-WRITE-14. IF1304.2 +063500 F-PRES-VAL-DELETE-14. IF1304.2 +063600 PERFORM DE-LETE. IF1304.2 +063700 GO TO F-PRES-VAL-WRITE-14. IF1304.2 +063800 F-PRES-VAL-WRITE-14. IF1304.2 +063900 MOVE "F-PRES-VAL-14" TO PAR-NAME. IF1304.2 +064000 PERFORM PRINT-DETAIL. IF1304.2 +064100*****************TEST (o) - SIMPLE TEST***************** IF1304.2 +064200 F-PRES-VAL-15. IF1304.2 +064300 MOVE ZERO TO WS-NUM. IF1304.2 +064400 MOVE 37.9070 TO MIN-RANGE. IF1304.2 +064500 MOVE 37.9085 TO MAX-RANGE. IF1304.2 +064600 F-PRES-VAL-TEST-15. IF1304.2 +064700 COMPUTE WS-NUM = IF1304.2 +064800 FUNCTION PRESENT-VALUE(.1, 10, 10, 10, 10, 10). IF1304.2 +064900 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +065000 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +065100 PERFORM PASS IF1304.2 +065200 ELSE IF1304.2 +065300 MOVE WS-NUM TO COMPUTED-N IF1304.2 +065400 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +065500 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +065600 PERFORM FAIL. IF1304.2 +065700 GO TO F-PRES-VAL-WRITE-15. IF1304.2 +065800 F-PRES-VAL-DELETE-15. IF1304.2 +065900 PERFORM DE-LETE. IF1304.2 +066000 GO TO F-PRES-VAL-WRITE-15. IF1304.2 +066100 F-PRES-VAL-WRITE-15. IF1304.2 +066200 MOVE "F-PRES-VAL-15" TO PAR-NAME. IF1304.2 +066300 PERFORM PRINT-DETAIL. IF1304.2 +066400*****************TEST (a) - COMPLEX TEST**************** IF1304.2 +066500 F-PRES-VAL-16. IF1304.2 +066600 MOVE ZERO TO WS-NUM. IF1304.2 +066700 MOVE 65.9974 TO MIN-RANGE. IF1304.2 +066800 MOVE 66.0026 TO MAX-RANGE. IF1304.2 +066900 F-PRES-VAL-TEST-16. IF1304.2 +067000 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE IF1304.2 +067100 (-.5, (2 + 3), (6 / 3), (9 - 3)). IF1304.2 +067200 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +067300 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +067400 PERFORM PASS IF1304.2 +067500 ELSE IF1304.2 +067600 MOVE WS-NUM TO COMPUTED-N IF1304.2 +067700 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +067800 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +067900 PERFORM FAIL. IF1304.2 +068000 GO TO F-PRES-VAL-WRITE-16. IF1304.2 +068100 F-PRES-VAL-DELETE-16. IF1304.2 +068200 PERFORM DE-LETE. IF1304.2 +068300 GO TO F-PRES-VAL-WRITE-16. IF1304.2 +068400 F-PRES-VAL-WRITE-16. IF1304.2 +068500 MOVE "F-PRES-VAL-16" TO PAR-NAME. IF1304.2 +068600 PERFORM PRINT-DETAIL. IF1304.2 +068700*****************TEST (b) - COMPLEX TEST**************** IF1304.2 +068800 F-PRES-VAL-17. IF1304.2 +068900 MOVE ZERO TO WS-NUM. IF1304.2 +069000 MOVE 44.4513 TO MIN-RANGE. IF1304.2 +069100 MOVE 44.4549 TO MAX-RANGE. IF1304.2 +069200 F-PRES-VAL-TEST-17. IF1304.2 +069300 COMPUTE WS-NUM = IF1304.2 +069400 FUNCTION PRESENT-VALUE(-.2, 5 / 4, 3.3 * 4, 9.4 + 2). IF1304.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +069700 PERFORM PASS IF1304.2 +069800 ELSE IF1304.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1304.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +070200 PERFORM FAIL. IF1304.2 +070300 GO TO F-PRES-VAL-WRITE-17. IF1304.2 +070400 F-PRES-VAL-DELETE-17. IF1304.2 +070500 PERFORM DE-LETE. IF1304.2 +070600 GO TO F-PRES-VAL-WRITE-17. IF1304.2 +070700 F-PRES-VAL-WRITE-17. IF1304.2 +070800 MOVE "F-PRES-VAL-17" TO PAR-NAME. IF1304.2 +070900 PERFORM PRINT-DETAIL. IF1304.2 +071000*****************TEST (c) - COMPLEX TEST**************** IF1304.2 +071100 F-PRES-VAL-18. IF1304.2 +071200 MOVE ZERO TO WS-NUM. IF1304.2 +071300 MOVE 7.91943 TO MIN-RANGE. IF1304.2 +071400 MOVE 7.92007 TO MAX-RANGE. IF1304.2 +071500 F-PRES-VAL-TEST-18. IF1304.2 +071600 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE IF1304.2 +071700 (.5, A + 2, 4.5 / C, 8, B). IF1304.2 +071800 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +071900 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +072000 PERFORM PASS IF1304.2 +072100 ELSE IF1304.2 +072200 MOVE WS-NUM TO COMPUTED-N IF1304.2 +072300 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +072400 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +072500 PERFORM FAIL. IF1304.2 +072600 GO TO F-PRES-VAL-WRITE-18. IF1304.2 +072700 F-PRES-VAL-DELETE-18. IF1304.2 +072800 PERFORM DE-LETE. IF1304.2 +072900 GO TO F-PRES-VAL-WRITE-18. IF1304.2 +073000 F-PRES-VAL-WRITE-18. IF1304.2 +073100 MOVE "F-PRES-VAL-18" TO PAR-NAME. IF1304.2 +073200 PERFORM PRINT-DETAIL. IF1304.2 +073300*****************TEST (d) - COMPLEX TEST**************** IF1304.2 +073400 F-PRES-VAL-19. IF1304.2 +073500 MOVE ZERO TO WS-NUM. IF1304.2 +073600 MOVE 22.4229 TO MIN-RANGE. IF1304.2 +073700 MOVE 22.4247 TO MAX-RANGE. IF1304.2 +073800 F-PRES-VAL-TEST-19. IF1304.2 +073900 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.08, 2, 3) + 18. IF1304.2 +074000 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +074100 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +074200 PERFORM PASS IF1304.2 +074300 ELSE IF1304.2 +074400 MOVE WS-NUM TO COMPUTED-N IF1304.2 +074500 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +074600 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +074700 PERFORM FAIL. IF1304.2 +074800 GO TO F-PRES-VAL-WRITE-19. IF1304.2 +074900 F-PRES-VAL-DELETE-19. IF1304.2 +075000 PERFORM DE-LETE. IF1304.2 +075100 GO TO F-PRES-VAL-WRITE-19. IF1304.2 +075200 F-PRES-VAL-WRITE-19. IF1304.2 +075300 MOVE "F-PRES-VAL-19" TO PAR-NAME. IF1304.2 +075400 PERFORM PRINT-DETAIL. IF1304.2 +075500*****************TEST (e) - COMPLEX TEST**************** IF1304.2 +075600 F-PRES-VAL-20. IF1304.2 +075700 MOVE ZERO TO WS-NUM. IF1304.2 +075800 MOVE -2.09570 TO MIN-RANGE. IF1304.2 +075900 MOVE -2.09554 TO MAX-RANGE. IF1304.2 +076000 F-PRES-VAL-TEST-20. IF1304.2 +076100 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE(.03, -6, -4) + IF1304.2 +076200 FUNCTION PRESENT-VALUE(.2, 9). IF1304.2 +076300 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +076400 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +076500 PERFORM PASS IF1304.2 +076600 ELSE IF1304.2 +076700 MOVE WS-NUM TO COMPUTED-N IF1304.2 +076800 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +076900 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +077000 PERFORM FAIL. IF1304.2 +077100 GO TO F-PRES-VAL-WRITE-20. IF1304.2 +077200 F-PRES-VAL-DELETE-20. IF1304.2 +077300 PERFORM DE-LETE. IF1304.2 +077400 GO TO F-PRES-VAL-WRITE-20. IF1304.2 +077500 F-PRES-VAL-WRITE-20. IF1304.2 +077600 MOVE "F-PRES-VAL-20" TO PAR-NAME. IF1304.2 +077700 PERFORM PRINT-DETAIL. IF1304.2 +077800*****************TEST (f) - COMPLEX TEST**************** IF1304.2 +077900 F-PRES-VAL-21. IF1304.2 +078000 MOVE ZERO TO WS-NUM. IF1304.2 +078100 MOVE 1.49994 TO MIN-RANGE. IF1304.2 +078200 MOVE 1.50006 TO MAX-RANGE. IF1304.2 +078300 F-PRES-VAL-TEST-21. IF1304.2 +078400 COMPUTE WS-NUM = FUNCTION PRESENT-VALUE( IF1304.2 +078500 FUNCTION PRESENT-VALUE(1, 2), 3). IF1304.2 +078600 IF (WS-NUM >= MIN-RANGE) AND IF1304.2 +078700 (WS-NUM <= MAX-RANGE) THEN IF1304.2 +078800 PERFORM PASS IF1304.2 +078900 ELSE IF1304.2 +079000 MOVE WS-NUM TO COMPUTED-N IF1304.2 +079100 MOVE MIN-RANGE TO CORRECT-MIN IF1304.2 +079200 MOVE MAX-RANGE TO CORRECT-MAX IF1304.2 +079300 PERFORM FAIL. IF1304.2 +079400 GO TO F-PRES-VAL-WRITE-21. IF1304.2 +079500 F-PRES-VAL-DELETE-21. IF1304.2 +079600 PERFORM DE-LETE. IF1304.2 +079700 GO TO F-PRES-VAL-WRITE-21. IF1304.2 +079800 F-PRES-VAL-WRITE-21. IF1304.2 +079900 MOVE "F-PRES-VAL-21" TO PAR-NAME. IF1304.2 +080000 PERFORM PRINT-DETAIL. IF1304.2 +080100*****************SPECIAL PERFORM TEST********************** IF1304.2 +080200 F-PRES-VAL-22. IF1304.2 +080300 PERFORM F-PRES-VAL-TEST-22 IF1304.2 +080400 UNTIL FUNCTION PRESENT-VALUE(ARG1, 2) < 0.5. IF1304.2 +080500 PERFORM PASS. IF1304.2 +080600 GO TO F-PRES-VAL-WRITE-22. IF1304.2 +080700 F-PRES-VAL-TEST-22. IF1304.2 +080800 COMPUTE ARG1 = ARG1 + 1. IF1304.2 +080900 F-PRES-VAL-DELETE-22. IF1304.2 +081000 PERFORM DE-LETE. IF1304.2 +081100 GO TO F-PRES-VAL-WRITE-22. IF1304.2 +081200 F-PRES-VAL-WRITE-22. IF1304.2 +081300 MOVE "F-PRES-VAL-22" TO PAR-NAME. IF1304.2 +081400 PERFORM PRINT-DETAIL. IF1304.2 +081500********************END OF TESTS*************** IF1304.2 +081600 CCVS-EXIT SECTION. IF1304.2 +081700 CCVS-999999. IF1304.2 +081800 GO TO CLOSE-FILES. IF1304.2 diff --git a/tests/cobol85/IF/IF131A.CBL b/tests/cobol85/IF/IF131A.CBL new file mode 100755 index 00000000..92095b30 --- /dev/null +++ b/tests/cobol85/IF/IF131A.CBL @@ -0,0 +1,512 @@ +000100 IDENTIFICATION DIVISION. IF1314.2 +000200 PROGRAM-ID. IF1314.2 +000300 IF131A. IF1314.2 +000400 IF1314.2 +000500*********************************************************** IF1314.2 +000600* * IF1314.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1314.2 +000800* It contains tests for the Intrinsic Function * IF1314.2 +000900* RANDOM. * IF1314.2 +001000* * IF1314.2 +001100*********************************************************** IF1314.2 +001200 ENVIRONMENT DIVISION. IF1314.2 +001300 CONFIGURATION SECTION. IF1314.2 +001400 SOURCE-COMPUTER. IF1314.2 +001500 Linux. IF1314.2 +001600 OBJECT-COMPUTER. IF1314.2 +001700 Linux. IF1314.2 +001800 INPUT-OUTPUT SECTION. IF1314.2 +001900 FILE-CONTROL. IF1314.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1314.2 +002100 "report.log". IF1314.2 +002200 DATA DIVISION. IF1314.2 +002300 FILE SECTION. IF1314.2 +002400 FD PRINT-FILE. IF1314.2 +002500 01 PRINT-REC PICTURE X(120). IF1314.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1314.2 +002700 WORKING-STORAGE SECTION. IF1314.2 +002800*********************************************************** IF1314.2 +002900* Variables specific to the Intrinsic Function Test IF131A* IF1314.2 +003000*********************************************************** IF1314.2 +003100 01 A PIC S9(10) VALUE 4. IF1314.2 +003200 01 Q PIC S9(10) VALUE 3. IF1314.2 +003300 01 ARR VALUE "40537". IF1314.2 +003400 02 IND OCCURS 5 TIMES PIC 9. IF1314.2 +003500 01 TEMP PIC S9(8)V9(8). IF1314.2 +003600 01 WS-NUM PIC S9(5)V9(6). IF1314.2 +003700 01 MIN-RANGE PIC S9(5)V9(7). IF1314.2 +003800 01 MAX-RANGE PIC S9(5)V9(7). IF1314.2 +003900* IF1314.2 +004000********************************************************** IF1314.2 +004100* IF1314.2 +004200 01 TEST-RESULTS. IF1314.2 +004300 02 FILLER PIC X VALUE SPACE. IF1314.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. IF1314.2 +004500 02 FILLER PIC X VALUE SPACE. IF1314.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. IF1314.2 +004700 02 FILLER PIC X VALUE SPACE. IF1314.2 +004800 02 PAR-NAME. IF1314.2 +004900 03 FILLER PIC X(19) VALUE SPACE. IF1314.2 +005000 03 PARDOT-X PIC X VALUE SPACE. IF1314.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. IF1314.2 +005200 02 FILLER PIC X(8) VALUE SPACE. IF1314.2 +005300 02 RE-MARK PIC X(61). IF1314.2 +005400 01 TEST-COMPUTED. IF1314.2 +005500 02 FILLER PIC X(30) VALUE SPACE. IF1314.2 +005600 02 FILLER PIC X(17) VALUE IF1314.2 +005700 " COMPUTED=". IF1314.2 +005800 02 COMPUTED-X. IF1314.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1314.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A IF1314.2 +006100 PIC -9(9).9(9). IF1314.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1314.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1314.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1314.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. IF1314.2 +006600 04 COMPUTED-18V0 PIC -9(18). IF1314.2 +006700 04 FILLER PIC X. IF1314.2 +006800 03 FILLER PIC X(50) VALUE SPACE. IF1314.2 +006900 01 TEST-CORRECT. IF1314.2 +007000 02 FILLER PIC X(30) VALUE SPACE. IF1314.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1314.2 +007200 02 CORRECT-X. IF1314.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1314.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1314.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1314.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1314.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1314.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. IF1314.2 +007900 04 CORRECT-18V0 PIC -9(18). IF1314.2 +008000 04 FILLER PIC X. IF1314.2 +008100 03 FILLER PIC X(2) VALUE SPACE. IF1314.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1314.2 +008300 01 TEST-CORRECT-MIN. IF1314.2 +008400 02 FILLER PIC X(30) VALUE SPACE. IF1314.2 +008500 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1314.2 +008600 02 CORRECTMI-X. IF1314.2 +008700 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1314.2 +008800 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1314.2 +008900 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1314.2 +009000 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1314.2 +009100 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1314.2 +009200 03 CR-18V0 REDEFINES CORRECTMI-A. IF1314.2 +009300 04 CORRECTMI-18V0 PIC -9(18). IF1314.2 +009400 04 FILLER PIC X. IF1314.2 +009500 03 FILLER PIC X(2) VALUE SPACE. IF1314.2 +009600 03 FILLER PIC X(48) VALUE SPACE. IF1314.2 +009700 01 TEST-CORRECT-MAX. IF1314.2 +009800 02 FILLER PIC X(30) VALUE SPACE. IF1314.2 +009900 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1314.2 +010000 02 CORRECTMA-X. IF1314.2 +010100 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1314.2 +010200 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1314.2 +010300 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1314.2 +010400 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1314.2 +010500 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1314.2 +010600 03 CR-18V0 REDEFINES CORRECTMA-A. IF1314.2 +010700 04 CORRECTMA-18V0 PIC -9(18). IF1314.2 +010800 04 FILLER PIC X. IF1314.2 +010900 03 FILLER PIC X(2) VALUE SPACE. IF1314.2 +011000 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1314.2 +011100 01 CCVS-C-1. IF1314.2 +011200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1314.2 +011300- "SS PARAGRAPH-NAME IF1314.2 +011400- " REMARKS". IF1314.2 +011500 02 FILLER PIC X(20) VALUE SPACE. IF1314.2 +011600 01 CCVS-C-2. IF1314.2 +011700 02 FILLER PIC X VALUE SPACE. IF1314.2 +011800 02 FILLER PIC X(6) VALUE "TESTED". IF1314.2 +011900 02 FILLER PIC X(15) VALUE SPACE. IF1314.2 +012000 02 FILLER PIC X(4) VALUE "FAIL". IF1314.2 +012100 02 FILLER PIC X(94) VALUE SPACE. IF1314.2 +012200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1314.2 +012300 01 REC-CT PIC 99 VALUE ZERO. IF1314.2 +012400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1314.2 +012500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1314.2 +012600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1314.2 +012700 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1314.2 +012800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1314.2 +012900 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1314.2 +013000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1314.2 +013100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1314.2 +013200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1314.2 +013300 01 CCVS-H-1. IF1314.2 +013400 02 FILLER PIC X(39) VALUE SPACES. IF1314.2 +013500 02 FILLER PIC X(42) VALUE IF1314.2 +013600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1314.2 +013700 02 FILLER PIC X(39) VALUE SPACES. IF1314.2 +013800 01 CCVS-H-2A. IF1314.2 +013900 02 FILLER PIC X(40) VALUE SPACE. IF1314.2 +014000 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1314.2 +014100 02 FILLER PIC XXXX VALUE IF1314.2 +014200 "4.2 ". IF1314.2 +014300 02 FILLER PIC X(28) VALUE IF1314.2 +014400 " COPY - NOT FOR DISTRIBUTION". IF1314.2 +014500 02 FILLER PIC X(41) VALUE SPACE. IF1314.2 +014600 IF1314.2 +014700 01 CCVS-H-2B. IF1314.2 +014800 02 FILLER PIC X(15) VALUE IF1314.2 +014900 "TEST RESULT OF ". IF1314.2 +015000 02 TEST-ID PIC X(9). IF1314.2 +015100 02 FILLER PIC X(4) VALUE IF1314.2 +015200 " IN ". IF1314.2 +015300 02 FILLER PIC X(12) VALUE IF1314.2 +015400 " HIGH ". IF1314.2 +015500 02 FILLER PIC X(22) VALUE IF1314.2 +015600 " LEVEL VALIDATION FOR ". IF1314.2 +015700 02 FILLER PIC X(58) VALUE IF1314.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1314.2 +015900 01 CCVS-H-3. IF1314.2 +016000 02 FILLER PIC X(34) VALUE IF1314.2 +016100 " FOR OFFICIAL USE ONLY ". IF1314.2 +016200 02 FILLER PIC X(58) VALUE IF1314.2 +016300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1314.2 +016400 02 FILLER PIC X(28) VALUE IF1314.2 +016500 " COPYRIGHT 1985 ". IF1314.2 +016600 01 CCVS-E-1. IF1314.2 +016700 02 FILLER PIC X(52) VALUE SPACE. IF1314.2 +016800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1314.2 +016900 02 ID-AGAIN PIC X(9). IF1314.2 +017000 02 FILLER PIC X(45) VALUE SPACES. IF1314.2 +017100 01 CCVS-E-2. IF1314.2 +017200 02 FILLER PIC X(31) VALUE SPACE. IF1314.2 +017300 02 FILLER PIC X(21) VALUE SPACE. IF1314.2 +017400 02 CCVS-E-2-2. IF1314.2 +017500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1314.2 +017600 03 FILLER PIC X VALUE SPACE. IF1314.2 +017700 03 ENDER-DESC PIC X(44) VALUE IF1314.2 +017800 "ERRORS ENCOUNTERED". IF1314.2 +017900 01 CCVS-E-3. IF1314.2 +018000 02 FILLER PIC X(22) VALUE IF1314.2 +018100 " FOR OFFICIAL USE ONLY". IF1314.2 +018200 02 FILLER PIC X(12) VALUE SPACE. IF1314.2 +018300 02 FILLER PIC X(58) VALUE IF1314.2 +018400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1314.2 +018500 02 FILLER PIC X(13) VALUE SPACE. IF1314.2 +018600 02 FILLER PIC X(15) VALUE IF1314.2 +018700 " COPYRIGHT 1985". IF1314.2 +018800 01 CCVS-E-4. IF1314.2 +018900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1314.2 +019000 02 FILLER PIC X(4) VALUE " OF ". IF1314.2 +019100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1314.2 +019200 02 FILLER PIC X(40) VALUE IF1314.2 +019300 " TESTS WERE EXECUTED SUCCESSFULLY". IF1314.2 +019400 01 XXINFO. IF1314.2 +019500 02 FILLER PIC X(19) VALUE IF1314.2 +019600 "*** INFORMATION ***". IF1314.2 +019700 02 INFO-TEXT. IF1314.2 +019800 04 FILLER PIC X(8) VALUE SPACE. IF1314.2 +019900 04 XXCOMPUTED PIC X(20). IF1314.2 +020000 04 FILLER PIC X(5) VALUE SPACE. IF1314.2 +020100 04 XXCORRECT PIC X(20). IF1314.2 +020200 02 INF-ANSI-REFERENCE PIC X(48). IF1314.2 +020300 01 HYPHEN-LINE. IF1314.2 +020400 02 FILLER PIC IS X VALUE IS SPACE. IF1314.2 +020500 02 FILLER PIC IS X(65) VALUE IS "************************IF1314.2 +020600- "*****************************************". IF1314.2 +020700 02 FILLER PIC IS X(54) VALUE IS "************************IF1314.2 +020800- "******************************". IF1314.2 +020900 01 CCVS-PGM-ID PIC X(9) VALUE IF1314.2 +021000 "IF131A". IF1314.2 +021100 PROCEDURE DIVISION. IF1314.2 +021200 CCVS1 SECTION. IF1314.2 +021300 OPEN-FILES. IF1314.2 +021400 OPEN OUTPUT PRINT-FILE. IF1314.2 +021500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1314.2 +021600 MOVE SPACE TO TEST-RESULTS. IF1314.2 +021700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1314.2 +021800 GO TO CCVS1-EXIT. IF1314.2 +021900 CLOSE-FILES. IF1314.2 +022000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1314.2 +022100 TERMINATE-CCVS. IF1314.2 +022200 STOP RUN. IF1314.2 +022300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1314.2 +022400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1314.2 +022500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1314.2 +022600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1314.2 +022700 MOVE "****TEST DELETED****" TO RE-MARK. IF1314.2 +022800 PRINT-DETAIL. IF1314.2 +022900 IF REC-CT NOT EQUAL TO ZERO IF1314.2 +023000 MOVE "." TO PARDOT-X IF1314.2 +023100 MOVE REC-CT TO DOTVALUE. IF1314.2 +023200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1314.2 +023300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1314.2 +023400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1314.2 +023500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1314.2 +023600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1314.2 +023700 MOVE SPACE TO CORRECT-X. IF1314.2 +023800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1314.2 +023900 MOVE SPACE TO RE-MARK. IF1314.2 +024000 HEAD-ROUTINE. IF1314.2 +024100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +024200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +024300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1314.2 +024400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1314.2 +024500 COLUMN-NAMES-ROUTINE. IF1314.2 +024600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +024700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +024900 END-ROUTINE. IF1314.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1314.2 +025100 END-RTN-EXIT. IF1314.2 +025200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +025300 END-ROUTINE-1. IF1314.2 +025400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1314.2 +025500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1314.2 +025600 ADD PASS-COUNTER TO ERROR-HOLD. IF1314.2 +025700 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1314.2 +025800 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1314.2 +025900 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1314.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1314.2 +026100 END-ROUTINE-12. IF1314.2 +026200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1314.2 +026300 IF ERROR-COUNTER IS EQUAL TO ZERO IF1314.2 +026400 MOVE "NO " TO ERROR-TOTAL IF1314.2 +026500 ELSE IF1314.2 +026600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1314.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1314.2 +026800 PERFORM WRITE-LINE. IF1314.2 +026900 END-ROUTINE-13. IF1314.2 +027000 IF DELETE-COUNTER IS EQUAL TO ZERO IF1314.2 +027100 MOVE "NO " TO ERROR-TOTAL ELSE IF1314.2 +027200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1314.2 +027300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1314.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +027500 IF INSPECT-COUNTER EQUAL TO ZERO IF1314.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1314.2 +027700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1314.2 +027800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1314.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +028000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1314.2 +028100 WRITE-LINE. IF1314.2 +028200 ADD 1 TO RECORD-COUNT. IF1314.2 +028300 IF RECORD-COUNT GREATER 42 IF1314.2 +028400 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1314.2 +028500 MOVE SPACE TO DUMMY-RECORD IF1314.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1314.2 +028700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1314.2 +028800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1314.2 +028900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1314.2 +029000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1314.2 +029100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1314.2 +029200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1314.2 +029300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1314.2 +029400 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1314.2 +029500 MOVE ZERO TO RECORD-COUNT. IF1314.2 +029600 PERFORM WRT-LN. IF1314.2 +029700 WRT-LN. IF1314.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1314.2 +029900 MOVE SPACE TO DUMMY-RECORD. IF1314.2 +030000 BLANK-LINE-PRINT. IF1314.2 +030100 PERFORM WRT-LN. IF1314.2 +030200 FAIL-ROUTINE. IF1314.2 +030300 IF COMPUTED-X NOT EQUAL TO SPACE IF1314.2 +030400 GO TO FAIL-ROUTINE-WRITE. IF1314.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1314.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1314.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1314.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1314.2 +031000 GO TO FAIL-ROUTINE-EX. IF1314.2 +031100 FAIL-ROUTINE-WRITE. IF1314.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1314.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1314.2 +031400 CORMA-ANSI-REFERENCE. IF1314.2 +031500 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1314.2 +031600 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1314.2 +031700 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1314.2 +031800 ELSE IF1314.2 +031900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1314.2 +032000 PERFORM WRITE-LINE. IF1314.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1314.2 +032200 FAIL-ROUTINE-EX. EXIT. IF1314.2 +032300 BAIL-OUT. IF1314.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1314.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1314.2 +032600 BAIL-OUT-WRITE. IF1314.2 +032700 MOVE CORRECT-A TO XXCORRECT. IF1314.2 +032800 MOVE COMPUTED-A TO XXCOMPUTED. IF1314.2 +032900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1314.2 +033000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1314.2 +033100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1314.2 +033200 BAIL-OUT-EX. EXIT. IF1314.2 +033300 CCVS1-EXIT. IF1314.2 +033400 EXIT. IF1314.2 +033500******************************************************** IF1314.2 +033600* * IF1314.2 +033700* Intrinsic Function Tests IF131A - RANDOM * IF1314.2 +033800* * IF1314.2 +033900******************************************************** IF1314.2 +034000 SECT-IF131A SECTION. IF1314.2 +034100 F-RANDOM-INFO. IF1314.2 +034200 MOVE "See ref. A-64 2.35" TO ANSI-REFERENCE. IF1314.2 +034300 MOVE "RANDOM Function" TO FEATURE. IF1314.2 +034400*****************TEST (a) ****************************** IF1314.2 +034500 F-RANDOM-01. IF1314.2 +034600 MOVE ZERO TO WS-NUM. IF1314.2 +034700 MOVE 0 TO MIN-RANGE. IF1314.2 +034800 MOVE 1 TO MAX-RANGE. IF1314.2 +034900 F-RANDOM-TEST-01. IF1314.2 +035000 COMPUTE WS-NUM = FUNCTION RANDOM. IF1314.2 +035100 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +035200 (WS-NUM < MAX-RANGE) THEN IF1314.2 +035300 PERFORM PASS IF1314.2 +035400 ELSE IF1314.2 +035500 MOVE WS-NUM TO COMPUTED-N IF1314.2 +035600 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +035700 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +035800 PERFORM FAIL. IF1314.2 +035900 GO TO F-RANDOM-WRITE-01. IF1314.2 +036000 F-RANDOM-DELETE-01. IF1314.2 +036100 PERFORM DE-LETE. IF1314.2 +036200 GO TO F-RANDOM-WRITE-01. IF1314.2 +036300 F-RANDOM-WRITE-01. IF1314.2 +036400 MOVE "F-RANDOM-01" TO PAR-NAME. IF1314.2 +036500 PERFORM PRINT-DETAIL. IF1314.2 +036600*****************TEST (b) ****************************** IF1314.2 +036700 F-RANDOM-02. IF1314.2 +036800 EVALUATE FUNCTION RANDOM(3) IF1314.2 +036900 WHEN 0 THRU 1 IF1314.2 +037000 PERFORM PASS IF1314.2 +037100 WHEN OTHER IF1314.2 +037200 PERFORM FAIL. IF1314.2 +037300 GO TO F-RANDOM-WRITE-02. IF1314.2 +037400 F-RANDOM-DELETE-02. IF1314.2 +037500 PERFORM DE-LETE. IF1314.2 +037600 GO TO F-RANDOM-WRITE-02. IF1314.2 +037700 F-RANDOM-WRITE-02. IF1314.2 +037800 MOVE "F-RANDOM-02" TO PAR-NAME. IF1314.2 +037900 PERFORM PRINT-DETAIL. IF1314.2 +038000*****************TEST (c) ****************************** IF1314.2 +038100 F-RANDOM-03. IF1314.2 +038200 MOVE 0 TO MIN-RANGE. IF1314.2 +038300 MOVE 1 TO MAX-RANGE. IF1314.2 +038400 F-RANDOM-TEST-03. IF1314.2 +038500 IF (FUNCTION RANDOM(Q) >= MIN-RANGE) AND IF1314.2 +038600 (FUNCTION RANDOM(Q) < MAX-RANGE) THEN IF1314.2 +038700 PERFORM PASS IF1314.2 +038800 ELSE IF1314.2 +038900 PERFORM FAIL. IF1314.2 +039000 GO TO F-RANDOM-WRITE-03. IF1314.2 +039100 F-RANDOM-DELETE-03. IF1314.2 +039200 PERFORM DE-LETE. IF1314.2 +039300 GO TO F-RANDOM-WRITE-03. IF1314.2 +039400 F-RANDOM-WRITE-03. IF1314.2 +039500 MOVE "F-RANDOM-03" TO PAR-NAME. IF1314.2 +039600 PERFORM PRINT-DETAIL. IF1314.2 +039700*****************TEST (d) ****************************** IF1314.2 +039800 F-RANDOM-04. IF1314.2 +039900 MOVE ZERO TO WS-NUM. IF1314.2 +040000 MOVE 0 TO MIN-RANGE. IF1314.2 +040100 MOVE 1 TO MAX-RANGE. IF1314.2 +040200 F-RANDOM-TEST-04. IF1314.2 +040300 COMPUTE WS-NUM = FUNCTION RANDOM(IND(4)). IF1314.2 +040400 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +040500 (WS-NUM < MAX-RANGE) THEN IF1314.2 +040600 PERFORM PASS IF1314.2 +040700 ELSE IF1314.2 +040800 MOVE WS-NUM TO COMPUTED-N IF1314.2 +040900 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +041000 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +041100 PERFORM FAIL. IF1314.2 +041200 GO TO F-RANDOM-WRITE-04. IF1314.2 +041300 F-RANDOM-DELETE-04. IF1314.2 +041400 PERFORM DE-LETE. IF1314.2 +041500 GO TO F-RANDOM-WRITE-04. IF1314.2 +041600 F-RANDOM-WRITE-04. IF1314.2 +041700 MOVE "F-RANDOM-04" TO PAR-NAME. IF1314.2 +041800 PERFORM PRINT-DETAIL. IF1314.2 +041900*****************TEST (e) ****************************** IF1314.2 +042000 F-RANDOM-05. IF1314.2 +042100 MOVE ZERO TO WS-NUM. IF1314.2 +042200 MOVE 0 TO MIN-RANGE. IF1314.2 +042300 MOVE 1 TO MAX-RANGE. IF1314.2 +042400 F-RANDOM-TEST-05. IF1314.2 +042500 COMPUTE WS-NUM = FUNCTION RANDOM(IND(A)). IF1314.2 +042600 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +042700 (WS-NUM < MAX-RANGE) THEN IF1314.2 +042800 PERFORM PASS IF1314.2 +042900 ELSE IF1314.2 +043000 MOVE WS-NUM TO COMPUTED-N IF1314.2 +043100 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +043200 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +043300 PERFORM FAIL. IF1314.2 +043400 GO TO F-RANDOM-WRITE-05. IF1314.2 +043500 F-RANDOM-DELETE-05. IF1314.2 +043600 PERFORM DE-LETE. IF1314.2 +043700 GO TO F-RANDOM-WRITE-05. IF1314.2 +043800 F-RANDOM-WRITE-05. IF1314.2 +043900 MOVE "F-RANDOM-05" TO PAR-NAME. IF1314.2 +044000 PERFORM PRINT-DETAIL. IF1314.2 +044100*****************TEST (f) ****************************** IF1314.2 +044200 F-RANDOM-06. IF1314.2 +044300 MOVE ZERO TO WS-NUM. IF1314.2 +044400 MOVE 1 TO MIN-RANGE. IF1314.2 +044500 MOVE 2 TO MAX-RANGE. IF1314.2 +044600 F-RANDOM-TEST-06. IF1314.2 +044700 COMPUTE WS-NUM = FUNCTION RANDOM(2) + 1. IF1314.2 +044800 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +044900 (WS-NUM < MAX-RANGE) THEN IF1314.2 +045000 PERFORM PASS IF1314.2 +045100 ELSE IF1314.2 +045200 MOVE WS-NUM TO COMPUTED-N IF1314.2 +045300 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +045400 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +045500 PERFORM FAIL. IF1314.2 +045600 GO TO F-RANDOM-WRITE-06. IF1314.2 +045700 F-RANDOM-DELETE-06. IF1314.2 +045800 PERFORM DE-LETE. IF1314.2 +045900 GO TO F-RANDOM-WRITE-06. IF1314.2 +046000 F-RANDOM-WRITE-06. IF1314.2 +046100 MOVE "F-RANDOM-06" TO PAR-NAME. IF1314.2 +046200 PERFORM PRINT-DETAIL. IF1314.2 +046300*****************TEST (g) ****************************** IF1314.2 +046400 F-RANDOM-07. IF1314.2 +046500 MOVE ZERO TO WS-NUM. IF1314.2 +046600 MOVE 0 TO MIN-RANGE. IF1314.2 +046700 MOVE 2 TO MAX-RANGE. IF1314.2 +046800 F-RANDOM-TEST-07. IF1314.2 +046900 COMPUTE WS-NUM = FUNCTION RANDOM(1) + IF1314.2 +047000 FUNCTION RANDOM(2). IF1314.2 +047100 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +047200 (WS-NUM < MAX-RANGE) THEN IF1314.2 +047300 PERFORM PASS IF1314.2 +047400 ELSE IF1314.2 +047500 MOVE WS-NUM TO COMPUTED-N IF1314.2 +047600 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +047700 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +047800 PERFORM FAIL. IF1314.2 +047900 GO TO F-RANDOM-WRITE-07. IF1314.2 +048000 F-RANDOM-DELETE-07. IF1314.2 +048100 PERFORM DE-LETE. IF1314.2 +048200 GO TO F-RANDOM-WRITE-07. IF1314.2 +048300 F-RANDOM-WRITE-07. IF1314.2 +048400 MOVE "F-RANDOM-07" TO PAR-NAME. IF1314.2 +048500 PERFORM PRINT-DETAIL. IF1314.2 +048600*****************TEST (h) ****************************** IF1314.2 +048700 F-RANDOM-08. IF1314.2 +048800 MOVE ZERO TO WS-NUM. IF1314.2 +048900 MOVE 0 TO MIN-RANGE. IF1314.2 +049000 MOVE 1 TO MAX-RANGE. IF1314.2 +049100 F-RANDOM-TEST-08. IF1314.2 +049200 COMPUTE WS-NUM = FUNCTION RANDOM( IF1314.2 +049300 FUNCTION INTEGER(100 * FUNCTION RANDOM(1))). IF1314.2 +049400 IF (WS-NUM >= MIN-RANGE) AND IF1314.2 +049500 (WS-NUM < MAX-RANGE) THEN IF1314.2 +049600 PERFORM PASS IF1314.2 +049700 ELSE IF1314.2 +049800 MOVE WS-NUM TO COMPUTED-N IF1314.2 +049900 MOVE MIN-RANGE TO CORRECT-MIN IF1314.2 +050000 MOVE MAX-RANGE TO CORRECT-MAX IF1314.2 +050100 PERFORM FAIL. IF1314.2 +050200 GO TO F-RANDOM-WRITE-08. IF1314.2 +050300 F-RANDOM-DELETE-08. IF1314.2 +050400 PERFORM DE-LETE. IF1314.2 +050500 GO TO F-RANDOM-WRITE-08. IF1314.2 +050600 F-RANDOM-WRITE-08. IF1314.2 +050700 MOVE "F-RANDOM-08" TO PAR-NAME. IF1314.2 +050800 PERFORM PRINT-DETAIL. IF1314.2 +050900********************END OF TESTS*************** IF1314.2 +051000 CCVS-EXIT SECTION. IF1314.2 +051100 CCVS-999999. IF1314.2 +051200 GO TO CLOSE-FILES. IF1314.2 diff --git a/tests/cobol85/IF/IF132A.CBL b/tests/cobol85/IF/IF132A.CBL new file mode 100755 index 00000000..7f9c6bab --- /dev/null +++ b/tests/cobol85/IF/IF132A.CBL @@ -0,0 +1,633 @@ +000100 IDENTIFICATION DIVISION. IF1324.2 +000200 PROGRAM-ID. IF1324.2 +000300 IF132A. IF1324.2 +000400 IF1324.2 +000500*********************************************************** IF1324.2 +000600* * IF1324.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1324.2 +000800* It contains tests for the Intrinsic Function RANGE. * IF1324.2 +000900* * IF1324.2 +001000*********************************************************** IF1324.2 +001100 ENVIRONMENT DIVISION. IF1324.2 +001200 CONFIGURATION SECTION. IF1324.2 +001300 SOURCE-COMPUTER. IF1324.2 +001400 Linux. IF1324.2 +001500 OBJECT-COMPUTER. IF1324.2 +001600 Linux. IF1324.2 +001700 INPUT-OUTPUT SECTION. IF1324.2 +001800 FILE-CONTROL. IF1324.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1324.2 +002000 "report.log". IF1324.2 +002100 DATA DIVISION. IF1324.2 +002200 FILE SECTION. IF1324.2 +002300 FD PRINT-FILE. IF1324.2 +002400 01 PRINT-REC PICTURE X(120). IF1324.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1324.2 +002600 WORKING-STORAGE SECTION. IF1324.2 +002700*********************************************************** IF1324.2 +002800* Variables specific to the Intrinsic Function Test IF132A* IF1324.2 +002900*********************************************************** IF1324.2 +003000 01 A PIC S9(10) VALUE 5. IF1324.2 +003100 01 B PIC S9(10) VALUE 7. IF1324.2 +003200 01 C PIC S9(10) VALUE -4. IF1324.2 +003300 01 D PIC S9(10) VALUE 10. IF1324.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1324.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1324.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1324.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1324.2 +003800 01 M PIC S9(10) VALUE 320000. IF1324.2 +003900 01 N PIC S9(10) VALUE 650000. IF1324.2 +004000 01 O PIC S9(10) VALUE -430000. IF1324.2 +004100 01 P PIC S9(10) VALUE 1. IF1324.2 +004200 01 Q PIC S9(10) VALUE 3. IF1324.2 +004300 01 R PIC S9(10) VALUE 5. IF1324.2 +004400 01 ARG1 PIC S9(10) VALUE 2. IF1324.2 +004500 01 ARR VALUE "40537". IF1324.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1324.2 +004700 01 TEMP PIC S9(10). IF1324.2 +004800 01 WS-NUM PIC S9(7)V9(7). IF1324.2 +004900 01 MIN-RANGE PIC S9(5)V9(7). IF1324.2 +005000 01 MAX-RANGE PIC S9(5)V9(7). IF1324.2 +005100* IF1324.2 +005200********************************************************** IF1324.2 +005300* IF1324.2 +005400 01 TEST-RESULTS. IF1324.2 +005500 02 FILLER PIC X VALUE SPACE. IF1324.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IF1324.2 +005700 02 FILLER PIC X VALUE SPACE. IF1324.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IF1324.2 +005900 02 FILLER PIC X VALUE SPACE. IF1324.2 +006000 02 PAR-NAME. IF1324.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IF1324.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IF1324.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IF1324.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IF1324.2 +006500 02 RE-MARK PIC X(61). IF1324.2 +006600 01 TEST-COMPUTED. IF1324.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1324.2 +006800 02 FILLER PIC X(17) VALUE IF1324.2 +006900 " COMPUTED=". IF1324.2 +007000 02 COMPUTED-X. IF1324.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1324.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IF1324.2 +007300 PIC -9(9).9(9). IF1324.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1324.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1324.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1324.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IF1324.2 +007800 04 COMPUTED-18V0 PIC -9(18). IF1324.2 +007900 04 FILLER PIC X. IF1324.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IF1324.2 +008100 01 TEST-CORRECT. IF1324.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IF1324.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1324.2 +008400 02 CORRECT-X. IF1324.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1324.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1324.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1324.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1324.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1324.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IF1324.2 +009100 04 CORRECT-18V0 PIC -9(18). IF1324.2 +009200 04 FILLER PIC X. IF1324.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IF1324.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1324.2 +009500 01 TEST-CORRECT-MIN. IF1324.2 +009600 02 FILLER PIC X(30) VALUE SPACE. IF1324.2 +009700 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1324.2 +009800 02 CORRECTMI-X. IF1324.2 +009900 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1324.2 +010000 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1324.2 +010100 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1324.2 +010200 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1324.2 +010300 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1324.2 +010400 03 CR-18V0 REDEFINES CORRECTMI-A. IF1324.2 +010500 04 CORRECTMI-18V0 PIC -9(18). IF1324.2 +010600 04 FILLER PIC X. IF1324.2 +010700 03 FILLER PIC X(2) VALUE SPACE. IF1324.2 +010800 03 FILLER PIC X(48) VALUE SPACE. IF1324.2 +010900 01 TEST-CORRECT-MAX. IF1324.2 +011000 02 FILLER PIC X(30) VALUE SPACE. IF1324.2 +011100 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1324.2 +011200 02 CORRECTMA-X. IF1324.2 +011300 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1324.2 +011400 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1324.2 +011500 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1324.2 +011600 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1324.2 +011700 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1324.2 +011800 03 CR-18V0 REDEFINES CORRECTMA-A. IF1324.2 +011900 04 CORRECTMA-18V0 PIC -9(18). IF1324.2 +012000 04 FILLER PIC X. IF1324.2 +012100 03 FILLER PIC X(2) VALUE SPACE. IF1324.2 +012200 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1324.2 +012300 01 CCVS-C-1. IF1324.2 +012400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1324.2 +012500- "SS PARAGRAPH-NAME IF1324.2 +012600- " REMARKS". IF1324.2 +012700 02 FILLER PIC X(20) VALUE SPACE. IF1324.2 +012800 01 CCVS-C-2. IF1324.2 +012900 02 FILLER PIC X VALUE SPACE. IF1324.2 +013000 02 FILLER PIC X(6) VALUE "TESTED". IF1324.2 +013100 02 FILLER PIC X(15) VALUE SPACE. IF1324.2 +013200 02 FILLER PIC X(4) VALUE "FAIL". IF1324.2 +013300 02 FILLER PIC X(94) VALUE SPACE. IF1324.2 +013400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1324.2 +013500 01 REC-CT PIC 99 VALUE ZERO. IF1324.2 +013600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1324.2 +013700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1324.2 +013800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1324.2 +013900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1324.2 +014000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1324.2 +014100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1324.2 +014200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1324.2 +014300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1324.2 +014400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1324.2 +014500 01 CCVS-H-1. IF1324.2 +014600 02 FILLER PIC X(39) VALUE SPACES. IF1324.2 +014700 02 FILLER PIC X(42) VALUE IF1324.2 +014800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1324.2 +014900 02 FILLER PIC X(39) VALUE SPACES. IF1324.2 +015000 01 CCVS-H-2A. IF1324.2 +015100 02 FILLER PIC X(40) VALUE SPACE. IF1324.2 +015200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1324.2 +015300 02 FILLER PIC XXXX VALUE IF1324.2 +015400 "4.2 ". IF1324.2 +015500 02 FILLER PIC X(28) VALUE IF1324.2 +015600 " COPY - NOT FOR DISTRIBUTION". IF1324.2 +015700 02 FILLER PIC X(41) VALUE SPACE. IF1324.2 +015800 IF1324.2 +015900 01 CCVS-H-2B. IF1324.2 +016000 02 FILLER PIC X(15) VALUE IF1324.2 +016100 "TEST RESULT OF ". IF1324.2 +016200 02 TEST-ID PIC X(9). IF1324.2 +016300 02 FILLER PIC X(4) VALUE IF1324.2 +016400 " IN ". IF1324.2 +016500 02 FILLER PIC X(12) VALUE IF1324.2 +016600 " HIGH ". IF1324.2 +016700 02 FILLER PIC X(22) VALUE IF1324.2 +016800 " LEVEL VALIDATION FOR ". IF1324.2 +016900 02 FILLER PIC X(58) VALUE IF1324.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1324.2 +017100 01 CCVS-H-3. IF1324.2 +017200 02 FILLER PIC X(34) VALUE IF1324.2 +017300 " FOR OFFICIAL USE ONLY ". IF1324.2 +017400 02 FILLER PIC X(58) VALUE IF1324.2 +017500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1324.2 +017600 02 FILLER PIC X(28) VALUE IF1324.2 +017700 " COPYRIGHT 1985 ". IF1324.2 +017800 01 CCVS-E-1. IF1324.2 +017900 02 FILLER PIC X(52) VALUE SPACE. IF1324.2 +018000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1324.2 +018100 02 ID-AGAIN PIC X(9). IF1324.2 +018200 02 FILLER PIC X(45) VALUE SPACES. IF1324.2 +018300 01 CCVS-E-2. IF1324.2 +018400 02 FILLER PIC X(31) VALUE SPACE. IF1324.2 +018500 02 FILLER PIC X(21) VALUE SPACE. IF1324.2 +018600 02 CCVS-E-2-2. IF1324.2 +018700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1324.2 +018800 03 FILLER PIC X VALUE SPACE. IF1324.2 +018900 03 ENDER-DESC PIC X(44) VALUE IF1324.2 +019000 "ERRORS ENCOUNTERED". IF1324.2 +019100 01 CCVS-E-3. IF1324.2 +019200 02 FILLER PIC X(22) VALUE IF1324.2 +019300 " FOR OFFICIAL USE ONLY". IF1324.2 +019400 02 FILLER PIC X(12) VALUE SPACE. IF1324.2 +019500 02 FILLER PIC X(58) VALUE IF1324.2 +019600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1324.2 +019700 02 FILLER PIC X(13) VALUE SPACE. IF1324.2 +019800 02 FILLER PIC X(15) VALUE IF1324.2 +019900 " COPYRIGHT 1985". IF1324.2 +020000 01 CCVS-E-4. IF1324.2 +020100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1324.2 +020200 02 FILLER PIC X(4) VALUE " OF ". IF1324.2 +020300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1324.2 +020400 02 FILLER PIC X(40) VALUE IF1324.2 +020500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1324.2 +020600 01 XXINFO. IF1324.2 +020700 02 FILLER PIC X(19) VALUE IF1324.2 +020800 "*** INFORMATION ***". IF1324.2 +020900 02 INFO-TEXT. IF1324.2 +021000 04 FILLER PIC X(8) VALUE SPACE. IF1324.2 +021100 04 XXCOMPUTED PIC X(20). IF1324.2 +021200 04 FILLER PIC X(5) VALUE SPACE. IF1324.2 +021300 04 XXCORRECT PIC X(20). IF1324.2 +021400 02 INF-ANSI-REFERENCE PIC X(48). IF1324.2 +021500 01 HYPHEN-LINE. IF1324.2 +021600 02 FILLER PIC IS X VALUE IS SPACE. IF1324.2 +021700 02 FILLER PIC IS X(65) VALUE IS "************************IF1324.2 +021800- "*****************************************". IF1324.2 +021900 02 FILLER PIC IS X(54) VALUE IS "************************IF1324.2 +022000- "******************************". IF1324.2 +022100 01 CCVS-PGM-ID PIC X(9) VALUE IF1324.2 +022200 "IF132A". IF1324.2 +022300 PROCEDURE DIVISION. IF1324.2 +022400 CCVS1 SECTION. IF1324.2 +022500 OPEN-FILES. IF1324.2 +022600 OPEN OUTPUT PRINT-FILE. IF1324.2 +022700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1324.2 +022800 MOVE SPACE TO TEST-RESULTS. IF1324.2 +022900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1324.2 +023000 GO TO CCVS1-EXIT. IF1324.2 +023100 CLOSE-FILES. IF1324.2 +023200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1324.2 +023300 TERMINATE-CCVS. IF1324.2 +023400 STOP RUN. IF1324.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1324.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1324.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1324.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1324.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. IF1324.2 +024000 PRINT-DETAIL. IF1324.2 +024100 IF REC-CT NOT EQUAL TO ZERO IF1324.2 +024200 MOVE "." TO PARDOT-X IF1324.2 +024300 MOVE REC-CT TO DOTVALUE. IF1324.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1324.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1324.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1324.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1324.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1324.2 +024900 MOVE SPACE TO CORRECT-X. IF1324.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1324.2 +025100 MOVE SPACE TO RE-MARK. IF1324.2 +025200 HEAD-ROUTINE. IF1324.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1324.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1324.2 +025700 COLUMN-NAMES-ROUTINE. IF1324.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +026100 END-ROUTINE. IF1324.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1324.2 +026300 END-RTN-EXIT. IF1324.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +026500 END-ROUTINE-1. IF1324.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1324.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1324.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. IF1324.2 +026900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1324.2 +027000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1324.2 +027100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1324.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1324.2 +027300 END-ROUTINE-12. IF1324.2 +027400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1324.2 +027500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1324.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1324.2 +027700 ELSE IF1324.2 +027800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1324.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1324.2 +028000 PERFORM WRITE-LINE. IF1324.2 +028100 END-ROUTINE-13. IF1324.2 +028200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1324.2 +028300 MOVE "NO " TO ERROR-TOTAL ELSE IF1324.2 +028400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1324.2 +028500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1324.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +028700 IF INSPECT-COUNTER EQUAL TO ZERO IF1324.2 +028800 MOVE "NO " TO ERROR-TOTAL IF1324.2 +028900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1324.2 +029000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1324.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +029200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1324.2 +029300 WRITE-LINE. IF1324.2 +029400 ADD 1 TO RECORD-COUNT. IF1324.2 +029500 IF RECORD-COUNT GREATER 42 IF1324.2 +029600 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1324.2 +029700 MOVE SPACE TO DUMMY-RECORD IF1324.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1324.2 +029900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1324.2 +030000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1324.2 +030100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1324.2 +030200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1324.2 +030300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1324.2 +030400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1324.2 +030500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1324.2 +030600 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1324.2 +030700 MOVE ZERO TO RECORD-COUNT. IF1324.2 +030800 PERFORM WRT-LN. IF1324.2 +030900 WRT-LN. IF1324.2 +031000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1324.2 +031100 MOVE SPACE TO DUMMY-RECORD. IF1324.2 +031200 BLANK-LINE-PRINT. IF1324.2 +031300 PERFORM WRT-LN. IF1324.2 +031400 FAIL-ROUTINE. IF1324.2 +031500 IF COMPUTED-X NOT EQUAL TO SPACE IF1324.2 +031600 GO TO FAIL-ROUTINE-WRITE. IF1324.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1324.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1324.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1324.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1324.2 +032200 GO TO FAIL-ROUTINE-EX. IF1324.2 +032300 FAIL-ROUTINE-WRITE. IF1324.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1324.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1324.2 +032600 CORMA-ANSI-REFERENCE. IF1324.2 +032700 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1324.2 +032800 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1324.2 +032900 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1324.2 +033000 ELSE IF1324.2 +033100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1324.2 +033200 PERFORM WRITE-LINE. IF1324.2 +033300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1324.2 +033400 FAIL-ROUTINE-EX. EXIT. IF1324.2 +033500 BAIL-OUT. IF1324.2 +033600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1324.2 +033700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1324.2 +033800 BAIL-OUT-WRITE. IF1324.2 +033900 MOVE CORRECT-A TO XXCORRECT. IF1324.2 +034000 MOVE COMPUTED-A TO XXCOMPUTED. IF1324.2 +034100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1324.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1324.2 +034300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1324.2 +034400 BAIL-OUT-EX. EXIT. IF1324.2 +034500 CCVS1-EXIT. IF1324.2 +034600 EXIT. IF1324.2 +034700******************************************************** IF1324.2 +034800* * IF1324.2 +034900* Intrinsic Function Tests IF132A - RANGE * IF1324.2 +035000* * IF1324.2 +035100******************************************************** IF1324.2 +035200 SECT-IF132A SECTION. IF1324.2 +035300 F-RANGE-INFO. IF1324.2 +035400 MOVE "See ref. A-65 2.65" TO ANSI-REFERENCE. IF1324.2 +035500 MOVE "RANGE Function" TO FEATURE. IF1324.2 +035600*****************TEST (a) - SIMPLE TEST***************** IF1324.2 +035700 F-RANGE-01. IF1324.2 +035800 MOVE ZERO TO WS-NUM. IF1324.2 +035900 F-RANGE-TEST-01. IF1324.2 +036000 COMPUTE WS-NUM = FUNCTION RANGE(5, -2, -14, 0). IF1324.2 +036100 IF WS-NUM = 19 THEN IF1324.2 +036200 PERFORM PASS IF1324.2 +036300 ELSE IF1324.2 +036400 MOVE WS-NUM TO COMPUTED-N IF1324.2 +036500 MOVE 19 TO CORRECT-N IF1324.2 +036600 PERFORM FAIL. IF1324.2 +036700 GO TO F-RANGE-WRITE-01. IF1324.2 +036800 F-RANGE-DELETE-01. IF1324.2 +036900 PERFORM DE-LETE. IF1324.2 +037000 GO TO F-RANGE-WRITE-01. IF1324.2 +037100 F-RANGE-WRITE-01. IF1324.2 +037200 MOVE "F-RANGE-01" TO PAR-NAME. IF1324.2 +037300 PERFORM PRINT-DETAIL. IF1324.2 +037400*****************TEST (b) - SIMPLE TEST***************** IF1324.2 +037500 F-RANGE-02. IF1324.2 +037600 EVALUATE FUNCTION RANGE(3.9, -0.3, 8.7, 100.2) IF1324.2 +037700 WHEN 100.498 THRU 100.502 IF1324.2 +037800 PERFORM PASS IF1324.2 +037900 WHEN OTHER IF1324.2 +038000 PERFORM FAIL. IF1324.2 +038100 GO TO F-RANGE-WRITE-02. IF1324.2 +038200 F-RANGE-DELETE-02. IF1324.2 +038300 PERFORM DE-LETE. IF1324.2 +038400 GO TO F-RANGE-WRITE-02. IF1324.2 +038500 F-RANGE-WRITE-02. IF1324.2 +038600 MOVE "F-RANGE-02" TO PAR-NAME. IF1324.2 +038700 PERFORM PRINT-DETAIL. IF1324.2 +038800*****************TEST (c) - SIMPLE TEST***************** IF1324.2 +038900 F-RANGE-03. IF1324.2 +039000 IF FUNCTION RANGE(A, B, C, D) = 14 THEN IF1324.2 +039100 PERFORM PASS IF1324.2 +039200 ELSE IF1324.2 +039300 PERFORM FAIL. IF1324.2 +039400 GO TO F-RANGE-WRITE-03. IF1324.2 +039500 F-RANGE-DELETE-03. IF1324.2 +039600 PERFORM DE-LETE. IF1324.2 +039700 GO TO F-RANGE-WRITE-03. IF1324.2 +039800 F-RANGE-WRITE-03. IF1324.2 +039900 MOVE "F-RANGE-03" TO PAR-NAME. IF1324.2 +040000 PERFORM PRINT-DETAIL. IF1324.2 +040100*****************TEST (d) - SIMPLE TEST***************** IF1324.2 +040200 F-RANGE-04. IF1324.2 +040300 MOVE ZERO TO WS-NUM. IF1324.2 +040400 F-RANGE-TEST-04. IF1324.2 +040500 COMPUTE WS-NUM = FUNCTION RANGE(E, F, G). IF1324.2 +040600 IF (WS-NUM >= 42.5791) AND IF1324.2 +040700 (WS-NUM <= 42.5809) IF1324.2 +040800 PERFORM PASS IF1324.2 +040900 ELSE IF1324.2 +041000 MOVE WS-NUM TO COMPUTED-N IF1324.2 +041100 MOVE 42.58 TO CORRECT-N IF1324.2 +041200 PERFORM FAIL. IF1324.2 +041300 GO TO F-RANGE-WRITE-04. IF1324.2 +041400 F-RANGE-DELETE-04. IF1324.2 +041500 PERFORM DE-LETE. IF1324.2 +041600 GO TO F-RANGE-WRITE-04. IF1324.2 +041700 F-RANGE-WRITE-04. IF1324.2 +041800 MOVE "F-RANGE-04" TO PAR-NAME. IF1324.2 +041900 PERFORM PRINT-DETAIL. IF1324.2 +042000*****************TEST (e) - SIMPLE TEST***************** IF1324.2 +042100 F-RANGE-05. IF1324.2 +042200 MOVE ZERO TO WS-NUM. IF1324.2 +042300 F-RANGE-TEST-05. IF1324.2 +042400 COMPUTE WS-NUM = FUNCTION RANGE(10.2 -0.2, 5.6, -15.6). IF1324.2 +042500 IF (WS-NUM >= 25.7995) AND IF1324.2 +042600 (WS-NUM <= 25.8005) IF1324.2 +042700 PERFORM PASS IF1324.2 +042800 ELSE IF1324.2 +042900 MOVE WS-NUM TO COMPUTED-N IF1324.2 +043000 MOVE 25.8 TO CORRECT-N IF1324.2 +043100 PERFORM FAIL. IF1324.2 +043200 GO TO F-RANGE-WRITE-05. IF1324.2 +043300 F-RANGE-DELETE-05. IF1324.2 +043400 PERFORM DE-LETE. IF1324.2 +043500 GO TO F-RANGE-WRITE-05. IF1324.2 +043600 F-RANGE-WRITE-05. IF1324.2 +043700 MOVE "F-RANGE-05" TO PAR-NAME. IF1324.2 +043800 PERFORM PRINT-DETAIL. IF1324.2 +043900*****************TEST (f) - SIMPLE TEST***************** IF1324.2 +044000 F-RANGE-06. IF1324.2 +044100 MOVE ZERO TO WS-NUM. IF1324.2 +044200 F-RANGE-TEST-06. IF1324.2 +044300 COMPUTE WS-NUM = FUNCTION RANGE(A, B, C, D, E, F, G). IF1324.2 +044400 IF (WS-NUM >= 42.5791) AND IF1324.2 +044500 (WS-NUM <= 42.5809) IF1324.2 +044600 PERFORM PASS IF1324.2 +044700 ELSE IF1324.2 +044800 MOVE WS-NUM TO COMPUTED-N IF1324.2 +044900 MOVE 42.58 TO CORRECT-N IF1324.2 +045000 PERFORM FAIL. IF1324.2 +045100 GO TO F-RANGE-WRITE-06. IF1324.2 +045200 F-RANGE-DELETE-06. IF1324.2 +045300 PERFORM DE-LETE. IF1324.2 +045400 GO TO F-RANGE-WRITE-06. IF1324.2 +045500 F-RANGE-WRITE-06. IF1324.2 +045600 MOVE "F-RANGE-06" TO PAR-NAME. IF1324.2 +045700 PERFORM PRINT-DETAIL. IF1324.2 +045800*****************TEST (g) - SIMPLE TEST***************** IF1324.2 +045900 F-RANGE-07. IF1324.2 +046000 MOVE ZERO TO WS-NUM. IF1324.2 +046100 F-RANGE-TEST-07. IF1324.2 +046200 COMPUTE WS-NUM = FUNCTION RANGE(IND(1), IND(2), IND(3)). IF1324.2 +046300 IF WS-NUM = 5 THEN IF1324.2 +046400 PERFORM PASS IF1324.2 +046500 ELSE IF1324.2 +046600 MOVE WS-NUM TO COMPUTED-N IF1324.2 +046700 MOVE 5 TO CORRECT-N IF1324.2 +046800 PERFORM FAIL. IF1324.2 +046900 GO TO F-RANGE-WRITE-07. IF1324.2 +047000 F-RANGE-DELETE-07. IF1324.2 +047100 PERFORM DE-LETE. IF1324.2 +047200 GO TO F-RANGE-WRITE-07. IF1324.2 +047300 F-RANGE-WRITE-07. IF1324.2 +047400 MOVE "F-RANGE-07" TO PAR-NAME. IF1324.2 +047500 PERFORM PRINT-DETAIL. IF1324.2 +047600*****************TEST (h) - SIMPLE TEST***************** IF1324.2 +047700 F-RANGE-08. IF1324.2 +047800 MOVE ZERO TO WS-NUM. IF1324.2 +047900 F-RANGE-TEST-08. IF1324.2 +048000 COMPUTE WS-NUM = FUNCTION RANGE(IND(P), IND(Q), IND(R)). IF1324.2 +048100 IF WS-NUM = 3 THEN IF1324.2 +048200 PERFORM PASS IF1324.2 +048300 ELSE IF1324.2 +048400 MOVE WS-NUM TO COMPUTED-N IF1324.2 +048500 MOVE 3 TO CORRECT-N IF1324.2 +048600 PERFORM FAIL. IF1324.2 +048700 GO TO F-RANGE-WRITE-08. IF1324.2 +048800 F-RANGE-DELETE-08. IF1324.2 +048900 PERFORM DE-LETE. IF1324.2 +049000 GO TO F-RANGE-WRITE-08. IF1324.2 +049100 F-RANGE-WRITE-08. IF1324.2 +049200 MOVE "F-RANGE-08" TO PAR-NAME. IF1324.2 +049300 PERFORM PRINT-DETAIL. IF1324.2 +049400*****************TEST (i) - SIMPLE TEST***************** IF1324.2 +049500 F-RANGE-09. IF1324.2 +049600 MOVE ZERO TO WS-NUM. IF1324.2 +049700 F-RANGE-TEST-09. IF1324.2 +rogerw COMPUTE WS-NUM = FUNCTION RANGE (4 0 5 3 7). +049900 IF WS-NUM = 7 THEN IF1324.2 +050000 PERFORM PASS IF1324.2 +050100 ELSE IF1324.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1324.2 +050300 MOVE 7 TO CORRECT-N IF1324.2 +050400 PERFORM FAIL. IF1324.2 +050500 GO TO F-RANGE-WRITE-09. IF1324.2 +050600 F-RANGE-DELETE-09. IF1324.2 +050700 PERFORM DE-LETE. IF1324.2 +050800 GO TO F-RANGE-WRITE-09. IF1324.2 +050900 F-RANGE-WRITE-09. IF1324.2 +051000 MOVE "F-RANGE-09" TO PAR-NAME. IF1324.2 +051100 PERFORM PRINT-DETAIL. IF1324.2 +051200*****************TEST (k) - SIMPLE TEST***************** IF1324.2 +051300 F-RANGE-11. IF1324.2 +051400 MOVE ZERO TO WS-NUM. IF1324.2 +051500 F-RANGE-TEST-11. IF1324.2 +051600 COMPUTE WS-NUM = FUNCTION RANGE(M, N, O). IF1324.2 +051700 IF WS-NUM = 1080000 THEN IF1324.2 +051800 PERFORM PASS IF1324.2 +051900 ELSE IF1324.2 +052000 MOVE WS-NUM TO COMPUTED-N IF1324.2 +052100 MOVE 1080000 TO CORRECT-N IF1324.2 +052200 PERFORM FAIL. IF1324.2 +052300 GO TO F-RANGE-WRITE-11. IF1324.2 +052400 F-RANGE-DELETE-11. IF1324.2 +052500 PERFORM DE-LETE. IF1324.2 +052600 GO TO F-RANGE-WRITE-11. IF1324.2 +052700 F-RANGE-WRITE-11. IF1324.2 +052800 MOVE "F-RANGE-11" TO PAR-NAME. IF1324.2 +052900 PERFORM PRINT-DETAIL. IF1324.2 +053000*****************TEST (l) - SIMPLE TEST***************** IF1324.2 +053100 F-RANGE-12. IF1324.2 +053200 MOVE ZERO TO WS-NUM. IF1324.2 +053300 F-RANGE-TEST-12. IF1324.2 +053400 COMPUTE WS-NUM = FUNCTION RANGE(A, 5, A). IF1324.2 +053500 IF WS-NUM = 0 THEN IF1324.2 +053600 PERFORM PASS IF1324.2 +053700 ELSE IF1324.2 +053800 MOVE WS-NUM TO COMPUTED-N IF1324.2 +053900 MOVE 0 TO CORRECT-N IF1324.2 +054000 PERFORM FAIL. IF1324.2 +054100 GO TO F-RANGE-WRITE-12. IF1324.2 +054200 F-RANGE-DELETE-12. IF1324.2 +054300 PERFORM DE-LETE. IF1324.2 +054400 GO TO F-RANGE-WRITE-12. IF1324.2 +054500 F-RANGE-WRITE-12. IF1324.2 +054600 MOVE "F-RANGE-12" TO PAR-NAME. IF1324.2 +054700 PERFORM PRINT-DETAIL. IF1324.2 +054800*****************TEST (a) - COMPLEX TEST**************** IF1324.2 +054900 F-RANGE-13. IF1324.2 +055000 MOVE ZERO TO WS-NUM. IF1324.2 +055100 MOVE 79.9984 TO MIN-RANGE. IF1324.2 +055200 MOVE 80.0160 TO MAX-RANGE. IF1324.2 +055300 F-RANGE-TEST-13. IF1324.2 +055400 COMPUTE WS-NUM = FUNCTION RANGE(A, B) + 78. IF1324.2 +055500 IF (WS-NUM >= MIN-RANGE) AND IF1324.2 +055600 (WS-NUM <= MAX-RANGE) THEN IF1324.2 +055700 PERFORM PASS IF1324.2 +055800 ELSE IF1324.2 +055900 MOVE WS-NUM TO COMPUTED-N IF1324.2 +056000 MOVE MIN-RANGE TO CORRECT-MIN IF1324.2 +056100 MOVE MAX-RANGE TO CORRECT-MAX IF1324.2 +056200 PERFORM FAIL. IF1324.2 +056300 GO TO F-RANGE-WRITE-13. IF1324.2 +056400 F-RANGE-DELETE-13. IF1324.2 +056500 PERFORM DE-LETE. IF1324.2 +056600 GO TO F-RANGE-WRITE-13. IF1324.2 +056700 F-RANGE-WRITE-13. IF1324.2 +056800 MOVE "F-RANGE-13" TO PAR-NAME. IF1324.2 +056900 PERFORM PRINT-DETAIL. IF1324.2 +057000*****************TEST (b) - COMPLEX TEST**************** IF1324.2 +057100 F-RANGE-14. IF1324.2 +057200 MOVE ZERO TO WS-NUM. IF1324.2 +057300 MOVE 7.39985 TO MIN-RANGE. IF1324.2 +057400 MOVE 7.40015 TO MAX-RANGE. IF1324.2 +057500 F-RANGE-TEST-14. IF1324.2 +057600 COMPUTE WS-NUM = FUNCTION RANGE(A, B) + IF1324.2 +057700 FUNCTION RANGE(-2.6, -4.4, 1). IF1324.2 +057800 IF (WS-NUM >= MIN-RANGE) AND IF1324.2 +057900 (WS-NUM <= MAX-RANGE) THEN IF1324.2 +058000 PERFORM PASS IF1324.2 +058100 ELSE IF1324.2 +058200 MOVE WS-NUM TO COMPUTED-N IF1324.2 +058300 MOVE MIN-RANGE TO CORRECT-MIN IF1324.2 +058400 MOVE MAX-RANGE TO CORRECT-MAX IF1324.2 +058500 PERFORM FAIL. IF1324.2 +058600 GO TO F-RANGE-WRITE-14. IF1324.2 +058700 F-RANGE-DELETE-14. IF1324.2 +058800 PERFORM DE-LETE. IF1324.2 +058900 GO TO F-RANGE-WRITE-14. IF1324.2 +059000 F-RANGE-WRITE-14. IF1324.2 +059100 MOVE "F-RANGE-14" TO PAR-NAME. IF1324.2 +059200 PERFORM PRINT-DETAIL. IF1324.2 +059300*****************TEST (c) - COMPLEX TEST**************** IF1324.2 +059400 F-RANGE-15. IF1324.2 +059500 MOVE ZERO TO WS-NUM. IF1324.2 +059600 MOVE 9.59981 TO MIN-RANGE. IF1324.2 +059700 MOVE 9.60019 TO MAX-RANGE. IF1324.2 +059800 F-RANGE-TEST-15. IF1324.2 +059900 COMPUTE WS-NUM = IF1324.2 +060000 FUNCTION RANGE(FUNCTION RANGE(6.8, -6.8), 4). IF1324.2 +060100 IF (WS-NUM >= MIN-RANGE) AND IF1324.2 +060200 (WS-NUM <= MAX-RANGE) THEN IF1324.2 +060300 PERFORM PASS IF1324.2 +060400 ELSE IF1324.2 +060500 MOVE WS-NUM TO COMPUTED-N IF1324.2 +060600 MOVE MIN-RANGE TO CORRECT-MIN IF1324.2 +060700 MOVE MAX-RANGE TO CORRECT-MAX IF1324.2 +060800 PERFORM FAIL. IF1324.2 +060900 GO TO F-RANGE-WRITE-15. IF1324.2 +061000 F-RANGE-DELETE-15. IF1324.2 +061100 PERFORM DE-LETE. IF1324.2 +061200 GO TO F-RANGE-WRITE-15. IF1324.2 +061300 F-RANGE-WRITE-15. IF1324.2 +061400 MOVE "F-RANGE-15" TO PAR-NAME. IF1324.2 +061500 PERFORM PRINT-DETAIL. IF1324.2 +061600*****************SPECIAL PERFORM TEST********************** IF1324.2 +061700 F-RANGE-16. IF1324.2 +061800 PERFORM F-RANGE-TEST-16 IF1324.2 +061900 UNTIL FUNCTION RANGE(ARG1, 1) > 10. IF1324.2 +062000 PERFORM PASS. IF1324.2 +062100 GO TO F-RANGE-WRITE-16. IF1324.2 +062200 F-RANGE-TEST-16. IF1324.2 +062300 COMPUTE ARG1 = ARG1 + 1. IF1324.2 +062400 F-RANGE-DELETE-16. IF1324.2 +062500 PERFORM DE-LETE. IF1324.2 +062600 GO TO F-RANGE-WRITE-16. IF1324.2 +062700 F-RANGE-WRITE-16. IF1324.2 +062800 MOVE "F-RANGE-16" TO PAR-NAME. IF1324.2 +062900 PERFORM PRINT-DETAIL. IF1324.2 +063000********************END OF TESTS*************** IF1324.2 +063100 CCVS-EXIT SECTION. IF1324.2 +063200 CCVS-999999. IF1324.2 +063300 GO TO CLOSE-FILES. IF1324.2 diff --git a/tests/cobol85/IF/IF133A.CBL b/tests/cobol85/IF/IF133A.CBL new file mode 100755 index 00000000..1f1d8a7e --- /dev/null +++ b/tests/cobol85/IF/IF133A.CBL @@ -0,0 +1,678 @@ +000100 IDENTIFICATION DIVISION. IF1334.2 +000200 PROGRAM-ID. IF1334.2 +000300 IF133A. IF1334.2 +000400 IF1334.2 +000500*********************************************************** IF1334.2 +000600* * IF1334.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1334.2 +000800* It contains tests for the Intrinsic Function * IF1334.2 +000900* REM. * IF1334.2 +001000* * IF1334.2 +001100*********************************************************** IF1334.2 +001200 ENVIRONMENT DIVISION. IF1334.2 +001300 CONFIGURATION SECTION. IF1334.2 +001400 SOURCE-COMPUTER. IF1334.2 +001500 Linux. IF1334.2 +001600 OBJECT-COMPUTER. IF1334.2 +001700 Linux. IF1334.2 +001800 INPUT-OUTPUT SECTION. IF1334.2 +001900 FILE-CONTROL. IF1334.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1334.2 +002100 "report.log". IF1334.2 +002200 DATA DIVISION. IF1334.2 +002300 FILE SECTION. IF1334.2 +002400 FD PRINT-FILE. IF1334.2 +002500 01 PRINT-REC PICTURE X(120). IF1334.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1334.2 +002700 WORKING-STORAGE SECTION. IF1334.2 +002800*********************************************************** IF1334.2 +002900* Variables specific to the Intrinsic Function Test IF133A* IF1334.2 +003000*********************************************************** IF1334.2 +003100 01 A PIC S9(10) VALUE 5. IF1334.2 +003200 01 B PIC S9(5)V9(5) VALUE 7.36. IF1334.2 +003300 01 C PIC S9(10) VALUE -4. IF1334.2 +003400 01 D PIC S9(10) VALUE 7. IF1334.2 +003500 01 ARG2 PIC S9(10) VALUE 1. IF1334.2 +003600 01 TEMP PIC S9(10). IF1334.2 +003700 01 WS-NUM PIC S9(5)V9(6). IF1334.2 +003800 01 MIN-RANGE PIC S9(5)V9(7). IF1334.2 +003900 01 MAX-RANGE PIC S9(5)V9(7). IF1334.2 +004000* IF1334.2 +004100********************************************************** IF1334.2 +004200* IF1334.2 +004300 01 TEST-RESULTS. IF1334.2 +004400 02 FILLER PIC X VALUE SPACE. IF1334.2 +004500 02 FEATURE PIC X(20) VALUE SPACE. IF1334.2 +004600 02 FILLER PIC X VALUE SPACE. IF1334.2 +004700 02 P-OR-F PIC X(5) VALUE SPACE. IF1334.2 +004800 02 FILLER PIC X VALUE SPACE. IF1334.2 +004900 02 PAR-NAME. IF1334.2 +005000 03 FILLER PIC X(19) VALUE SPACE. IF1334.2 +005100 03 PARDOT-X PIC X VALUE SPACE. IF1334.2 +005200 03 DOTVALUE PIC 99 VALUE ZERO. IF1334.2 +005300 02 FILLER PIC X(8) VALUE SPACE. IF1334.2 +005400 02 RE-MARK PIC X(61). IF1334.2 +005500 01 TEST-COMPUTED. IF1334.2 +005600 02 FILLER PIC X(30) VALUE SPACE. IF1334.2 +005700 02 FILLER PIC X(17) VALUE IF1334.2 +005800 " COMPUTED=". IF1334.2 +005900 02 COMPUTED-X. IF1334.2 +006000 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1334.2 +006100 03 COMPUTED-N REDEFINES COMPUTED-A IF1334.2 +006200 PIC -9(9).9(9). IF1334.2 +006300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1334.2 +006400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1334.2 +006500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1334.2 +006600 03 CM-18V0 REDEFINES COMPUTED-A. IF1334.2 +006700 04 COMPUTED-18V0 PIC -9(18). IF1334.2 +006800 04 FILLER PIC X. IF1334.2 +006900 03 FILLER PIC X(50) VALUE SPACE. IF1334.2 +007000 01 TEST-CORRECT. IF1334.2 +007100 02 FILLER PIC X(30) VALUE SPACE. IF1334.2 +007200 02 FILLER PIC X(17) VALUE " CORRECT =". IF1334.2 +007300 02 CORRECT-X. IF1334.2 +007400 03 CORRECT-A PIC X(20) VALUE SPACE. IF1334.2 +007500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1334.2 +007600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1334.2 +007700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1334.2 +007800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1334.2 +007900 03 CR-18V0 REDEFINES CORRECT-A. IF1334.2 +008000 04 CORRECT-18V0 PIC -9(18). IF1334.2 +008100 04 FILLER PIC X. IF1334.2 +008200 03 FILLER PIC X(2) VALUE SPACE. IF1334.2 +008300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1334.2 +008400 01 TEST-CORRECT-MIN. IF1334.2 +008500 02 FILLER PIC X(30) VALUE SPACE. IF1334.2 +008600 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1334.2 +008700 02 CORRECTMI-X. IF1334.2 +008800 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1334.2 +008900 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1334.2 +009000 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1334.2 +009100 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1334.2 +009200 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1334.2 +009300 03 CR-18V0 REDEFINES CORRECTMI-A. IF1334.2 +009400 04 CORRECTMI-18V0 PIC -9(18). IF1334.2 +009500 04 FILLER PIC X. IF1334.2 +009600 03 FILLER PIC X(2) VALUE SPACE. IF1334.2 +009700 03 FILLER PIC X(48) VALUE SPACE. IF1334.2 +009800 01 TEST-CORRECT-MAX. IF1334.2 +009900 02 FILLER PIC X(30) VALUE SPACE. IF1334.2 +010000 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1334.2 +010100 02 CORRECTMA-X. IF1334.2 +010200 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1334.2 +010300 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1334.2 +010400 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1334.2 +010500 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1334.2 +010600 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1334.2 +010700 03 CR-18V0 REDEFINES CORRECTMA-A. IF1334.2 +010800 04 CORRECTMA-18V0 PIC -9(18). IF1334.2 +010900 04 FILLER PIC X. IF1334.2 +011000 03 FILLER PIC X(2) VALUE SPACE. IF1334.2 +011100 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1334.2 +011200 01 CCVS-C-1. IF1334.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1334.2 +011400- "SS PARAGRAPH-NAME IF1334.2 +011500- " REMARKS". IF1334.2 +011600 02 FILLER PIC X(20) VALUE SPACE. IF1334.2 +011700 01 CCVS-C-2. IF1334.2 +011800 02 FILLER PIC X VALUE SPACE. IF1334.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". IF1334.2 +012000 02 FILLER PIC X(15) VALUE SPACE. IF1334.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". IF1334.2 +012200 02 FILLER PIC X(94) VALUE SPACE. IF1334.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1334.2 +012400 01 REC-CT PIC 99 VALUE ZERO. IF1334.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1334.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1334.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1334.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1334.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1334.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1334.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1334.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1334.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1334.2 +013400 01 CCVS-H-1. IF1334.2 +013500 02 FILLER PIC X(39) VALUE SPACES. IF1334.2 +013600 02 FILLER PIC X(42) VALUE IF1334.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1334.2 +013800 02 FILLER PIC X(39) VALUE SPACES. IF1334.2 +013900 01 CCVS-H-2A. IF1334.2 +014000 02 FILLER PIC X(40) VALUE SPACE. IF1334.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1334.2 +014200 02 FILLER PIC XXXX VALUE IF1334.2 +014300 "4.2 ". IF1334.2 +014400 02 FILLER PIC X(28) VALUE IF1334.2 +014500 " COPY - NOT FOR DISTRIBUTION". IF1334.2 +014600 02 FILLER PIC X(41) VALUE SPACE. IF1334.2 +014700 IF1334.2 +014800 01 CCVS-H-2B. IF1334.2 +014900 02 FILLER PIC X(15) VALUE IF1334.2 +015000 "TEST RESULT OF ". IF1334.2 +015100 02 TEST-ID PIC X(9). IF1334.2 +015200 02 FILLER PIC X(4) VALUE IF1334.2 +015300 " IN ". IF1334.2 +015400 02 FILLER PIC X(12) VALUE IF1334.2 +015500 " HIGH ". IF1334.2 +015600 02 FILLER PIC X(22) VALUE IF1334.2 +015700 " LEVEL VALIDATION FOR ". IF1334.2 +015800 02 FILLER PIC X(58) VALUE IF1334.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1334.2 +016000 01 CCVS-H-3. IF1334.2 +016100 02 FILLER PIC X(34) VALUE IF1334.2 +016200 " FOR OFFICIAL USE ONLY ". IF1334.2 +016300 02 FILLER PIC X(58) VALUE IF1334.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1334.2 +016500 02 FILLER PIC X(28) VALUE IF1334.2 +016600 " COPYRIGHT 1985 ". IF1334.2 +016700 01 CCVS-E-1. IF1334.2 +016800 02 FILLER PIC X(52) VALUE SPACE. IF1334.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1334.2 +017000 02 ID-AGAIN PIC X(9). IF1334.2 +017100 02 FILLER PIC X(45) VALUE SPACES. IF1334.2 +017200 01 CCVS-E-2. IF1334.2 +017300 02 FILLER PIC X(31) VALUE SPACE. IF1334.2 +017400 02 FILLER PIC X(21) VALUE SPACE. IF1334.2 +017500 02 CCVS-E-2-2. IF1334.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1334.2 +017700 03 FILLER PIC X VALUE SPACE. IF1334.2 +017800 03 ENDER-DESC PIC X(44) VALUE IF1334.2 +017900 "ERRORS ENCOUNTERED". IF1334.2 +018000 01 CCVS-E-3. IF1334.2 +018100 02 FILLER PIC X(22) VALUE IF1334.2 +018200 " FOR OFFICIAL USE ONLY". IF1334.2 +018300 02 FILLER PIC X(12) VALUE SPACE. IF1334.2 +018400 02 FILLER PIC X(58) VALUE IF1334.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1334.2 +018600 02 FILLER PIC X(13) VALUE SPACE. IF1334.2 +018700 02 FILLER PIC X(15) VALUE IF1334.2 +018800 " COPYRIGHT 1985". IF1334.2 +018900 01 CCVS-E-4. IF1334.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1334.2 +019100 02 FILLER PIC X(4) VALUE " OF ". IF1334.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1334.2 +019300 02 FILLER PIC X(40) VALUE IF1334.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1334.2 +019500 01 XXINFO. IF1334.2 +019600 02 FILLER PIC X(19) VALUE IF1334.2 +019700 "*** INFORMATION ***". IF1334.2 +019800 02 INFO-TEXT. IF1334.2 +019900 04 FILLER PIC X(8) VALUE SPACE. IF1334.2 +020000 04 XXCOMPUTED PIC X(20). IF1334.2 +020100 04 FILLER PIC X(5) VALUE SPACE. IF1334.2 +020200 04 XXCORRECT PIC X(20). IF1334.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). IF1334.2 +020400 01 HYPHEN-LINE. IF1334.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. IF1334.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************IF1334.2 +020700- "*****************************************". IF1334.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************IF1334.2 +020900- "******************************". IF1334.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE IF1334.2 +021100 "IF133A". IF1334.2 +021200 PROCEDURE DIVISION. IF1334.2 +021300 CCVS1 SECTION. IF1334.2 +021400 OPEN-FILES. IF1334.2 +021500 OPEN OUTPUT PRINT-FILE. IF1334.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1334.2 +021700 MOVE SPACE TO TEST-RESULTS. IF1334.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1334.2 +021900 GO TO CCVS1-EXIT. IF1334.2 +022000 CLOSE-FILES. IF1334.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1334.2 +022200 TERMINATE-CCVS. IF1334.2 +022300 STOP RUN. IF1334.2 +022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1334.2 +022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1334.2 +022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1334.2 +022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1334.2 +022800 MOVE "****TEST DELETED****" TO RE-MARK. IF1334.2 +022900 PRINT-DETAIL. IF1334.2 +023000 IF REC-CT NOT EQUAL TO ZERO IF1334.2 +023100 MOVE "." TO PARDOT-X IF1334.2 +023200 MOVE REC-CT TO DOTVALUE. IF1334.2 +023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1334.2 +023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1334.2 +023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1334.2 +023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1334.2 +023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1334.2 +023800 MOVE SPACE TO CORRECT-X. IF1334.2 +023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1334.2 +024000 MOVE SPACE TO RE-MARK. IF1334.2 +024100 HEAD-ROUTINE. IF1334.2 +024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1334.2 +024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1334.2 +024600 COLUMN-NAMES-ROUTINE. IF1334.2 +024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +025000 END-ROUTINE. IF1334.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1334.2 +025200 END-RTN-EXIT. IF1334.2 +025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +025400 END-ROUTINE-1. IF1334.2 +025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1334.2 +025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1334.2 +025700 ADD PASS-COUNTER TO ERROR-HOLD. IF1334.2 +025800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1334.2 +025900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1334.2 +026000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1334.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1334.2 +026200 END-ROUTINE-12. IF1334.2 +026300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1334.2 +026400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1334.2 +026500 MOVE "NO " TO ERROR-TOTAL IF1334.2 +026600 ELSE IF1334.2 +026700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1334.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1334.2 +026900 PERFORM WRITE-LINE. IF1334.2 +027000 END-ROUTINE-13. IF1334.2 +027100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1334.2 +027200 MOVE "NO " TO ERROR-TOTAL ELSE IF1334.2 +027300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1334.2 +027400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1334.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +027600 IF INSPECT-COUNTER EQUAL TO ZERO IF1334.2 +027700 MOVE "NO " TO ERROR-TOTAL IF1334.2 +027800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1334.2 +027900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1334.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +028100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1334.2 +028200 WRITE-LINE. IF1334.2 +028300 ADD 1 TO RECORD-COUNT. IF1334.2 +028400 IF RECORD-COUNT GREATER 42 IF1334.2 +028500 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1334.2 +028600 MOVE SPACE TO DUMMY-RECORD IF1334.2 +028700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1334.2 +028800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1334.2 +028900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1334.2 +029000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1334.2 +029100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1334.2 +029200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1334.2 +029300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1334.2 +029400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1334.2 +029500 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1334.2 +029600 MOVE ZERO TO RECORD-COUNT. IF1334.2 +029700 PERFORM WRT-LN. IF1334.2 +029800 WRT-LN. IF1334.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1334.2 +030000 MOVE SPACE TO DUMMY-RECORD. IF1334.2 +030100 BLANK-LINE-PRINT. IF1334.2 +030200 PERFORM WRT-LN. IF1334.2 +030300 FAIL-ROUTINE. IF1334.2 +030400 IF COMPUTED-X NOT EQUAL TO SPACE IF1334.2 +030500 GO TO FAIL-ROUTINE-WRITE. IF1334.2 +030600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1334.2 +030700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1334.2 +030800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1334.2 +030900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +031000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1334.2 +031100 GO TO FAIL-ROUTINE-EX. IF1334.2 +031200 FAIL-ROUTINE-WRITE. IF1334.2 +031300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1334.2 +031400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1334.2 +031500 CORMA-ANSI-REFERENCE. IF1334.2 +031600 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1334.2 +031700 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1334.2 +031800 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1334.2 +031900 ELSE IF1334.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1334.2 +032100 PERFORM WRITE-LINE. IF1334.2 +032200 MOVE SPACES TO COR-ANSI-REFERENCE. IF1334.2 +032300 FAIL-ROUTINE-EX. EXIT. IF1334.2 +032400 BAIL-OUT. IF1334.2 +032500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1334.2 +032600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1334.2 +032700 BAIL-OUT-WRITE. IF1334.2 +032800 MOVE CORRECT-A TO XXCORRECT. IF1334.2 +032900 MOVE COMPUTED-A TO XXCOMPUTED. IF1334.2 +033000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1334.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1334.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. IF1334.2 +033300 BAIL-OUT-EX. EXIT. IF1334.2 +033400 CCVS1-EXIT. IF1334.2 +033500 EXIT. IF1334.2 +033600******************************************************** IF1334.2 +033700* * IF1334.2 +033800* Intrinsic Function Tests IF133A - REM * IF1334.2 +033900* * IF1334.2 +034000******************************************************** IF1334.2 +034100 SECT-IF133A SECTION. IF1334.2 +034200 F-REM-INFO. IF1334.2 +034300 MOVE "See ref. A-66 2.37" TO ANSI-REFERENCE. IF1334.2 +034400 MOVE "REM Function" TO FEATURE. IF1334.2 +034500*****************TEST (a) - SIMPLE TEST***************** IF1334.2 +034600 F-REM-01. IF1334.2 +034700 MOVE ZERO TO WS-NUM. IF1334.2 +034800 F-REM-TEST-01. IF1334.2 +034900 COMPUTE WS-NUM = FUNCTION REM(0, 20). IF1334.2 +035000 IF WS-NUM = 0 THEN IF1334.2 +035100 PERFORM PASS IF1334.2 +035200 ELSE IF1334.2 +035300 MOVE WS-NUM TO COMPUTED-N IF1334.2 +035400 MOVE 0 TO CORRECT-N IF1334.2 +035500 PERFORM FAIL. IF1334.2 +035600 GO TO F-REM-WRITE-01. IF1334.2 +035700 F-REM-DELETE-01. IF1334.2 +035800 PERFORM DE-LETE. IF1334.2 +035900 GO TO F-REM-WRITE-01. IF1334.2 +036000 F-REM-WRITE-01. IF1334.2 +036100 MOVE "F-REM-01" TO PAR-NAME. IF1334.2 +036200 PERFORM PRINT-DETAIL. IF1334.2 +036300*****************TEST (b) - SIMPLE TEST***************** IF1334.2 +036400 F-REM-02. IF1334.2 +036500 EVALUATE FUNCTION REM(10.674, 10.674) IF1334.2 +036600 WHEN -0.000020 THRU 0.000020 IF1334.2 +036700 PERFORM PASS IF1334.2 +036800 WHEN OTHER IF1334.2 +036900 PERFORM FAIL. IF1334.2 +037000 GO TO F-REM-WRITE-02. IF1334.2 +037100 F-REM-DELETE-02. IF1334.2 +037200 PERFORM DE-LETE. IF1334.2 +037300 GO TO F-REM-WRITE-02. IF1334.2 +037400 F-REM-WRITE-02. IF1334.2 +037500 MOVE "F-REM-02" TO PAR-NAME. IF1334.2 +037600 PERFORM PRINT-DETAIL. IF1334.2 +037700*****************TEST (c) - SIMPLE TEST***************** IF1334.2 +037800 F-REM-03. IF1334.2 +037900 IF (FUNCTION REM(2.5, A) >= 2.49995) AND IF1334.2 +038000 (FUNCTION REM(2.5, A) <= 2.50005) IF1334.2 +038100 PERFORM PASS IF1334.2 +038200 ELSE IF1334.2 +038300 PERFORM FAIL. IF1334.2 +038400 GO TO F-REM-WRITE-03. IF1334.2 +038500 F-REM-DELETE-03. IF1334.2 +038600 PERFORM DE-LETE. IF1334.2 +038700 GO TO F-REM-WRITE-03. IF1334.2 +038800 F-REM-WRITE-03. IF1334.2 +038900 MOVE "F-REM-03" TO PAR-NAME. IF1334.2 +039000 PERFORM PRINT-DETAIL. IF1334.2 +039100*****************TEST (d) - SIMPLE TEST***************** IF1334.2 +039200 F-REM-04. IF1334.2 +039300 MOVE ZERO TO WS-NUM. IF1334.2 +039400 F-REM-TEST-04. IF1334.2 +039500 COMPUTE WS-NUM = FUNCTION REM(A, 2). IF1334.2 +039600 IF WS-NUM = 1 THEN IF1334.2 +039700 PERFORM PASS IF1334.2 +039800 ELSE IF1334.2 +039900 MOVE WS-NUM TO COMPUTED-N IF1334.2 +040000 MOVE 1 TO CORRECT-N IF1334.2 +040100 PERFORM FAIL. IF1334.2 +040200 GO TO F-REM-WRITE-04. IF1334.2 +040300 F-REM-DELETE-04. IF1334.2 +040400 PERFORM DE-LETE. IF1334.2 +040500 GO TO F-REM-WRITE-04. IF1334.2 +040600 F-REM-WRITE-04. IF1334.2 +040700 MOVE "F-REM-04" TO PAR-NAME. IF1334.2 +040800 PERFORM PRINT-DETAIL. IF1334.2 +040900*****************TEST (e) - SIMPLE TEST***************** IF1334.2 +041000 F-REM-05. IF1334.2 +041100 MOVE ZERO TO WS-NUM. IF1334.2 +041200 F-REM-TEST-05. IF1334.2 +041300 COMPUTE WS-NUM = FUNCTION REM(B, A). IF1334.2 +041400 IF (WS-NUM >= 2.35995) AND IF1334.2 +041500 (WS-NUM <= 2.36005) IF1334.2 +041600 PERFORM PASS IF1334.2 +041700 ELSE IF1334.2 +041800 MOVE WS-NUM TO COMPUTED-N IF1334.2 +041900 MOVE 2.36 TO CORRECT-N IF1334.2 +042000 PERFORM FAIL. IF1334.2 +042100 GO TO F-REM-WRITE-05. IF1334.2 +042200 F-REM-DELETE-05. IF1334.2 +042300 PERFORM DE-LETE. IF1334.2 +042400 GO TO F-REM-WRITE-05. IF1334.2 +042500 F-REM-WRITE-05. IF1334.2 +042600 MOVE "F-REM-05" TO PAR-NAME. IF1334.2 +042700 PERFORM PRINT-DETAIL. IF1334.2 +042800*****************TEST (f) - SIMPLE TEST***************** IF1334.2 +042900 F-REM-06. IF1334.2 +043000 MOVE ZERO TO WS-NUM. IF1334.2 +043100 F-REM-TEST-06. IF1334.2 +043200 COMPUTE WS-NUM = FUNCTION REM(-11, -5). IF1334.2 +043300 IF WS-NUM = -1 THEN IF1334.2 +043400 PERFORM PASS IF1334.2 +043500 ELSE IF1334.2 +043600 MOVE WS-NUM TO COMPUTED-N IF1334.2 +043700 MOVE -1 TO CORRECT-N IF1334.2 +043800 PERFORM FAIL. IF1334.2 +043900 GO TO F-REM-WRITE-06. IF1334.2 +044000 F-REM-DELETE-06. IF1334.2 +044100 PERFORM DE-LETE. IF1334.2 +044200 GO TO F-REM-WRITE-06. IF1334.2 +044300 F-REM-WRITE-06. IF1334.2 +044400 MOVE "F-REM-06" TO PAR-NAME. IF1334.2 +044500 PERFORM PRINT-DETAIL. IF1334.2 +044600*****************TEST (g) - SIMPLE TEST***************** IF1334.2 +044700 F-REM-07. IF1334.2 +044800 MOVE ZERO TO WS-NUM. IF1334.2 +044900 F-REM-TEST-07. IF1334.2 +045000 COMPUTE WS-NUM = FUNCTION REM(11, -5). IF1334.2 +045100 IF WS-NUM = 1 THEN IF1334.2 +045200 PERFORM PASS IF1334.2 +045300 ELSE IF1334.2 +045400 MOVE WS-NUM TO COMPUTED-N IF1334.2 +045500 MOVE 1 TO CORRECT-N IF1334.2 +045600 PERFORM FAIL. IF1334.2 +045700 GO TO F-REM-WRITE-07. IF1334.2 +045800 F-REM-DELETE-07. IF1334.2 +045900 PERFORM DE-LETE. IF1334.2 +046000 GO TO F-REM-WRITE-07. IF1334.2 +046100 F-REM-WRITE-07. IF1334.2 +046200 MOVE "F-REM-07" TO PAR-NAME. IF1334.2 +046300 PERFORM PRINT-DETAIL. IF1334.2 +046400*****************TEST (h) - SIMPLE TEST***************** IF1334.2 +046500 F-REM-08. IF1334.2 +046600 MOVE ZERO TO WS-NUM. IF1334.2 +046700 F-REM-TEST-08. IF1334.2 +046800 COMPUTE WS-NUM = FUNCTION REM(-11, 5). IF1334.2 +046900 IF WS-NUM = -1 THEN IF1334.2 +047000 PERFORM PASS IF1334.2 +047100 ELSE IF1334.2 +047200 MOVE WS-NUM TO COMPUTED-N IF1334.2 +047300 MOVE -1 TO CORRECT-N IF1334.2 +047400 PERFORM FAIL. IF1334.2 +047500 GO TO F-REM-WRITE-08. IF1334.2 +047600 F-REM-DELETE-08. IF1334.2 +047700 PERFORM DE-LETE. IF1334.2 +047800 GO TO F-REM-WRITE-08. IF1334.2 +047900 F-REM-WRITE-08. IF1334.2 +048000 MOVE "F-REM-08" TO PAR-NAME. IF1334.2 +048100 PERFORM PRINT-DETAIL. IF1334.2 +048200*****************TEST (a) - COMPLEX TEST**************** IF1334.2 +048300 F-REM-09. IF1334.2 +048400 MOVE ZERO TO WS-NUM. IF1334.2 +048500 MOVE 0.889982 TO MIN-RANGE. IF1334.2 +048600 MOVE 0.890018 TO MAX-RANGE. IF1334.2 +048700 F-REM-TEST-09. IF1334.2 +048800 COMPUTE WS-NUM = FUNCTION REM(0.89, B + 1). IF1334.2 +048900 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +049000 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +049100 PERFORM PASS IF1334.2 +049200 ELSE IF1334.2 +049300 MOVE WS-NUM TO COMPUTED-N IF1334.2 +049400 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +049500 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +049600 PERFORM FAIL. IF1334.2 +049700 GO TO F-REM-WRITE-09. IF1334.2 +049800 F-REM-DELETE-09. IF1334.2 +049900 PERFORM DE-LETE. IF1334.2 +050000 GO TO F-REM-WRITE-09. IF1334.2 +050100 F-REM-WRITE-09. IF1334.2 +050200 MOVE "F-REM-09" TO PAR-NAME. IF1334.2 +050300 PERFORM PRINT-DETAIL. IF1334.2 +050400*****************TEST (b) - COMPLEX TEST**************** IF1334.2 +050500 F-REM-10. IF1334.2 +050600 MOVE ZERO TO WS-NUM. IF1334.2 +050700 MOVE 0.159997 TO MIN-RANGE. IF1334.2 +050800 MOVE 0.160003 TO MAX-RANGE. IF1334.2 +050900 F-REM-TEST-10. IF1334.2 +051000 COMPUTE WS-NUM = FUNCTION REM(B, C + 2.2). IF1334.2 +051100 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +051200 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +051300 PERFORM PASS IF1334.2 +051400 ELSE IF1334.2 +051500 MOVE WS-NUM TO COMPUTED-N IF1334.2 +051600 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +051700 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +051800 PERFORM FAIL. IF1334.2 +051900 GO TO F-REM-WRITE-10. IF1334.2 +052000 F-REM-DELETE-10. IF1334.2 +052100 PERFORM DE-LETE. IF1334.2 +052200 GO TO F-REM-WRITE-10. IF1334.2 +052300 F-REM-WRITE-10. IF1334.2 +052400 MOVE "F-REM-10" TO PAR-NAME. IF1334.2 +052500 PERFORM PRINT-DETAIL. IF1334.2 +052600*****************TEST (c) - COMPLEX TEST**************** IF1334.2 +052700 F-REM-11. IF1334.2 +052800 MOVE ZERO TO WS-NUM. IF1334.2 +052900 MOVE -0.000020 TO MIN-RANGE. IF1334.2 +053000 MOVE 0.000020 TO MAX-RANGE. IF1334.2 +053100 F-REM-TEST-11. IF1334.2 +053200 COMPUTE WS-NUM = FUNCTION REM(3 / 2, .75). IF1334.2 +053300 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +053400 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +053500 PERFORM PASS IF1334.2 +053600 ELSE IF1334.2 +053700 MOVE WS-NUM TO COMPUTED-N IF1334.2 +053800 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +053900 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +054000 PERFORM FAIL. IF1334.2 +054100 GO TO F-REM-WRITE-11. IF1334.2 +054200 F-REM-DELETE-11. IF1334.2 +054300 PERFORM DE-LETE. IF1334.2 +054400 GO TO F-REM-WRITE-11. IF1334.2 +054500 F-REM-WRITE-11. IF1334.2 +054600 MOVE "F-REM-11" TO PAR-NAME. IF1334.2 +054700 PERFORM PRINT-DETAIL. IF1334.2 +054800*****************TEST (d) - COMPLEX TEST**************** IF1334.2 +054900 F-REM-12. IF1334.2 +055000 MOVE ZERO TO WS-NUM. IF1334.2 +055100 MOVE 6.63987 TO MIN-RANGE. IF1334.2 +055200 MOVE 6.64013 TO MAX-RANGE. IF1334.2 +055300 F-REM-TEST-12. IF1334.2 +055400 COMPUTE WS-NUM = FUNCTION REM(8 + 6, B). IF1334.2 +055500 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +055600 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +055700 PERFORM PASS IF1334.2 +055800 ELSE IF1334.2 +055900 MOVE WS-NUM TO COMPUTED-N IF1334.2 +056000 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +056100 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +056200 PERFORM FAIL. IF1334.2 +056300 GO TO F-REM-WRITE-12. IF1334.2 +056400 F-REM-DELETE-12. IF1334.2 +056500 PERFORM DE-LETE. IF1334.2 +056600 GO TO F-REM-WRITE-12. IF1334.2 +056700 F-REM-WRITE-12. IF1334.2 +056800 MOVE "F-REM-12" TO PAR-NAME. IF1334.2 +056900 PERFORM PRINT-DETAIL. IF1334.2 +057000*****************TEST (e) - COMPLEX TEST**************** IF1334.2 +057100 F-REM-13. IF1334.2 +057200 MOVE ZERO TO WS-NUM. IF1334.2 +057300 MOVE -1.00002 TO MIN-RANGE. IF1334.2 +057400 MOVE -0.999980 TO MAX-RANGE. IF1334.2 +057500 F-REM-TEST-13. IF1334.2 +057600 COMPUTE WS-NUM = FUNCTION REM(C + 1, 2). IF1334.2 +057700 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +057800 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +057900 PERFORM PASS IF1334.2 +058000 ELSE IF1334.2 +058100 MOVE WS-NUM TO COMPUTED-N IF1334.2 +058200 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +058300 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +058400 PERFORM FAIL. IF1334.2 +058500 GO TO F-REM-WRITE-13. IF1334.2 +058600 F-REM-DELETE-13. IF1334.2 +058700 PERFORM DE-LETE. IF1334.2 +058800 GO TO F-REM-WRITE-13. IF1334.2 +058900 F-REM-WRITE-13. IF1334.2 +059000 MOVE "F-REM-13" TO PAR-NAME. IF1334.2 +059100 PERFORM PRINT-DETAIL. IF1334.2 +059200*****************TEST (f) - COMPLEX TEST**************** IF1334.2 +059300 F-REM-14. IF1334.2 +059400 MOVE ZERO TO WS-NUM. IF1334.2 +059500 MOVE 1.99996 TO MIN-RANGE. IF1334.2 +059600 MOVE 2.00004 TO MAX-RANGE. IF1334.2 +059700 F-REM-TEST-14. IF1334.2 +059800 COMPUTE WS-NUM = FUNCTION REM( IF1334.2 +059900 FUNCTION REM(D, A), A). IF1334.2 +060000 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +060100 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +060200 PERFORM PASS IF1334.2 +060300 ELSE IF1334.2 +060400 MOVE WS-NUM TO COMPUTED-N IF1334.2 +060500 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +060600 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +060700 PERFORM FAIL. IF1334.2 +060800 GO TO F-REM-WRITE-14. IF1334.2 +060900 F-REM-DELETE-14. IF1334.2 +061000 PERFORM DE-LETE. IF1334.2 +061100 GO TO F-REM-WRITE-14. IF1334.2 +061200 F-REM-WRITE-14. IF1334.2 +061300 MOVE "F-REM-14" TO PAR-NAME. IF1334.2 +061400 PERFORM PRINT-DETAIL. IF1334.2 +061500*****************TEST (g) - COMPLEX TEST**************** IF1334.2 +061600 F-REM-15. IF1334.2 +061700 MOVE ZERO TO WS-NUM. IF1334.2 +061800 MOVE -0.000020 TO MIN-RANGE. IF1334.2 +061900 MOVE 0.000020 TO MAX-RANGE. IF1334.2 +062000 F-REM-TEST-15. IF1334.2 +062100 COMPUTE WS-NUM = FUNCTION REM(C, IF1334.2 +062200 FUNCTION REM(C, D)). IF1334.2 +062300 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +062400 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +062500 PERFORM PASS IF1334.2 +062600 ELSE IF1334.2 +062700 MOVE WS-NUM TO COMPUTED-N IF1334.2 +062800 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +062900 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +063000 PERFORM FAIL. IF1334.2 +063100 GO TO F-REM-WRITE-15. IF1334.2 +063200 F-REM-DELETE-15. IF1334.2 +063300 PERFORM DE-LETE. IF1334.2 +063400 GO TO F-REM-WRITE-15. IF1334.2 +063500 F-REM-WRITE-15. IF1334.2 +063600 MOVE "F-REM-15" TO PAR-NAME. IF1334.2 +063700 PERFORM PRINT-DETAIL. IF1334.2 +063800*****************TEST (h) - COMPLEX TEST**************** IF1334.2 +063900 F-REM-16. IF1334.2 +064000 MOVE ZERO TO WS-NUM. IF1334.2 +064100 MOVE 0.999980 TO MIN-RANGE. IF1334.2 +064200 MOVE 1.00002 TO MAX-RANGE. IF1334.2 +064300 F-REM-TEST-16. IF1334.2 +064400 COMPUTE WS-NUM = FUNCTION REM( FUNCTION REM(9, 5), IF1334.2 +064500 FUNCTION REM(D, 4)). IF1334.2 +064600 IF (WS-NUM >= MIN-RANGE) AND IF1334.2 +064700 (WS-NUM <= MAX-RANGE) THEN IF1334.2 +064800 PERFORM PASS IF1334.2 +064900 ELSE IF1334.2 +065000 MOVE WS-NUM TO COMPUTED-N IF1334.2 +065100 MOVE MIN-RANGE TO CORRECT-MIN IF1334.2 +065200 MOVE MAX-RANGE TO CORRECT-MAX IF1334.2 +065300 PERFORM FAIL. IF1334.2 +065400 GO TO F-REM-WRITE-16. IF1334.2 +065500 F-REM-DELETE-16. IF1334.2 +065600 PERFORM DE-LETE. IF1334.2 +065700 GO TO F-REM-WRITE-16. IF1334.2 +065800 F-REM-WRITE-16. IF1334.2 +065900 MOVE "F-REM-16" TO PAR-NAME. IF1334.2 +066000 PERFORM PRINT-DETAIL. IF1334.2 +066100*****************SPECIAL PERFORM TEST********************** IF1334.2 +066200 F-REM-17. IF1334.2 +066300 PERFORM F-REM-TEST-17 IF1334.2 +066400 UNTIL FUNCTION REM(5, ARG2) >= 2. IF1334.2 +066500 PERFORM PASS. IF1334.2 +066600 GO TO F-REM-WRITE-17. IF1334.2 +066700 F-REM-TEST-17. IF1334.2 +066800 COMPUTE ARG2 = ARG2 + 1. IF1334.2 +066900 F-REM-DELETE-17. IF1334.2 +067000 PERFORM DE-LETE. IF1334.2 +067100 GO TO F-REM-WRITE-17. IF1334.2 +067200 F-REM-WRITE-17. IF1334.2 +067300 MOVE "F-REM-17" TO PAR-NAME. IF1334.2 +067400 PERFORM PRINT-DETAIL. IF1334.2 +067500********************END OF TESTS*************** IF1334.2 +067600 CCVS-EXIT SECTION. IF1334.2 +067700 CCVS-999999. IF1334.2 +067800 GO TO CLOSE-FILES. IF1334.2 diff --git a/tests/cobol85/IF/IF134A.CBL b/tests/cobol85/IF/IF134A.CBL new file mode 100755 index 00000000..848f46ee --- /dev/null +++ b/tests/cobol85/IF/IF134A.CBL @@ -0,0 +1,546 @@ +000100 IDENTIFICATION DIVISION. IF1344.2 +000200 PROGRAM-ID. IF1344.2 +000300 IF134A. IF1344.2 +000400 IF1344.2 +000500*********************************************************** IF1344.2 +000600* * IF1344.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1344.2 +000800* It contains tests for the Intrinsic Function REVERSE. * IF1344.2 +000900* * IF1344.2 +001000*********************************************************** IF1344.2 +001100 ENVIRONMENT DIVISION. IF1344.2 +001200 CONFIGURATION SECTION. IF1344.2 +001300 SOURCE-COMPUTER. IF1344.2 +001400 Linux. IF1344.2 +001500 OBJECT-COMPUTER. IF1344.2 +001600 Linux. IF1344.2 +001700 INPUT-OUTPUT SECTION. IF1344.2 +001800 FILE-CONTROL. IF1344.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1344.2 +002000 "report.log". IF1344.2 +002100 DATA DIVISION. IF1344.2 +002200 FILE SECTION. IF1344.2 +002300 FD PRINT-FILE. IF1344.2 +002400 01 PRINT-REC PICTURE X(120). IF1344.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1344.2 +002600 WORKING-STORAGE SECTION. IF1344.2 +002700*********************************************************** IF1344.2 +002800* Variables specific to the Intrinsic Function Test IF134A* IF1344.2 +002900*********************************************************** IF1344.2 +003000 01 A PIC A(10) VALUE "tumble". IF1344.2 +003100 01 B PIC A(10) VALUE "WEED". IF1344.2 +003200 01 C PIC X(10) VALUE "Was". IF1344.2 +003300 01 D PIC X(10) VALUE "4". IF1344.2 +003400 01 E PIC X(10) VALUE "And4". IF1344.2 +003500 01 TEMP1 PIC X(7) VALUE "giZZard". IF1344.2 +003600 01 TEMP PIC S9(10). IF1344.2 +003700 01 WS-ANUM PIC X(10). IF1344.2 +003800* IF1344.2 +003900********************************************************** IF1344.2 +004000* IF1344.2 +004100 01 TEST-RESULTS. IF1344.2 +004200 02 FILLER PIC X VALUE SPACE. IF1344.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. IF1344.2 +004400 02 FILLER PIC X VALUE SPACE. IF1344.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. IF1344.2 +004600 02 FILLER PIC X VALUE SPACE. IF1344.2 +004700 02 PAR-NAME. IF1344.2 +004800 03 FILLER PIC X(19) VALUE SPACE. IF1344.2 +004900 03 PARDOT-X PIC X VALUE SPACE. IF1344.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. IF1344.2 +005100 02 FILLER PIC X(8) VALUE SPACE. IF1344.2 +005200 02 RE-MARK PIC X(61). IF1344.2 +005300 01 TEST-COMPUTED. IF1344.2 +005400 02 FILLER PIC X(30) VALUE SPACE. IF1344.2 +005500 02 FILLER PIC X(17) VALUE IF1344.2 +005600 " COMPUTED=". IF1344.2 +005700 02 COMPUTED-X. IF1344.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1344.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A IF1344.2 +006000 PIC -9(9).9(9). IF1344.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1344.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1344.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1344.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. IF1344.2 +006500 04 COMPUTED-18V0 PIC -9(18). IF1344.2 +006600 04 FILLER PIC X. IF1344.2 +006700 03 FILLER PIC X(50) VALUE SPACE. IF1344.2 +006800 01 TEST-CORRECT. IF1344.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1344.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1344.2 +007100 02 CORRECT-X. IF1344.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1344.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1344.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1344.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1344.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1344.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. IF1344.2 +007800 04 CORRECT-18V0 PIC -9(18). IF1344.2 +007900 04 FILLER PIC X. IF1344.2 +008000 03 FILLER PIC X(2) VALUE SPACE. IF1344.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1344.2 +008200 01 CCVS-C-1. IF1344.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1344.2 +008400- "SS PARAGRAPH-NAME IF1344.2 +008500- " REMARKS". IF1344.2 +008600 02 FILLER PIC X(20) VALUE SPACE. IF1344.2 +008700 01 CCVS-C-2. IF1344.2 +008800 02 FILLER PIC X VALUE SPACE. IF1344.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". IF1344.2 +009000 02 FILLER PIC X(15) VALUE SPACE. IF1344.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". IF1344.2 +009200 02 FILLER PIC X(94) VALUE SPACE. IF1344.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1344.2 +009400 01 REC-CT PIC 99 VALUE ZERO. IF1344.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1344.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1344.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1344.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1344.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1344.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1344.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1344.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1344.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1344.2 +010400 01 CCVS-H-1. IF1344.2 +010500 02 FILLER PIC X(39) VALUE SPACES. IF1344.2 +010600 02 FILLER PIC X(42) VALUE IF1344.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1344.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IF1344.2 +010900 01 CCVS-H-2A. IF1344.2 +011000 02 FILLER PIC X(40) VALUE SPACE. IF1344.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1344.2 +011200 02 FILLER PIC XXXX VALUE IF1344.2 +011300 "4.2 ". IF1344.2 +011400 02 FILLER PIC X(28) VALUE IF1344.2 +011500 " COPY - NOT FOR DISTRIBUTION". IF1344.2 +011600 02 FILLER PIC X(41) VALUE SPACE. IF1344.2 +011700 IF1344.2 +011800 01 CCVS-H-2B. IF1344.2 +011900 02 FILLER PIC X(15) VALUE IF1344.2 +012000 "TEST RESULT OF ". IF1344.2 +012100 02 TEST-ID PIC X(9). IF1344.2 +012200 02 FILLER PIC X(4) VALUE IF1344.2 +012300 " IN ". IF1344.2 +012400 02 FILLER PIC X(12) VALUE IF1344.2 +012500 " HIGH ". IF1344.2 +012600 02 FILLER PIC X(22) VALUE IF1344.2 +012700 " LEVEL VALIDATION FOR ". IF1344.2 +012800 02 FILLER PIC X(58) VALUE IF1344.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1344.2 +013000 01 CCVS-H-3. IF1344.2 +013100 02 FILLER PIC X(34) VALUE IF1344.2 +013200 " FOR OFFICIAL USE ONLY ". IF1344.2 +013300 02 FILLER PIC X(58) VALUE IF1344.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1344.2 +013500 02 FILLER PIC X(28) VALUE IF1344.2 +013600 " COPYRIGHT 1985 ". IF1344.2 +013700 01 CCVS-E-1. IF1344.2 +013800 02 FILLER PIC X(52) VALUE SPACE. IF1344.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1344.2 +014000 02 ID-AGAIN PIC X(9). IF1344.2 +014100 02 FILLER PIC X(45) VALUE SPACES. IF1344.2 +014200 01 CCVS-E-2. IF1344.2 +014300 02 FILLER PIC X(31) VALUE SPACE. IF1344.2 +014400 02 FILLER PIC X(21) VALUE SPACE. IF1344.2 +014500 02 CCVS-E-2-2. IF1344.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1344.2 +014700 03 FILLER PIC X VALUE SPACE. IF1344.2 +014800 03 ENDER-DESC PIC X(44) VALUE IF1344.2 +014900 "ERRORS ENCOUNTERED". IF1344.2 +015000 01 CCVS-E-3. IF1344.2 +015100 02 FILLER PIC X(22) VALUE IF1344.2 +015200 " FOR OFFICIAL USE ONLY". IF1344.2 +015300 02 FILLER PIC X(12) VALUE SPACE. IF1344.2 +015400 02 FILLER PIC X(58) VALUE IF1344.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1344.2 +015600 02 FILLER PIC X(13) VALUE SPACE. IF1344.2 +015700 02 FILLER PIC X(15) VALUE IF1344.2 +015800 " COPYRIGHT 1985". IF1344.2 +015900 01 CCVS-E-4. IF1344.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1344.2 +016100 02 FILLER PIC X(4) VALUE " OF ". IF1344.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1344.2 +016300 02 FILLER PIC X(40) VALUE IF1344.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1344.2 +016500 01 XXINFO. IF1344.2 +016600 02 FILLER PIC X(19) VALUE IF1344.2 +016700 "*** INFORMATION ***". IF1344.2 +016800 02 INFO-TEXT. IF1344.2 +016900 04 FILLER PIC X(8) VALUE SPACE. IF1344.2 +017000 04 XXCOMPUTED PIC X(20). IF1344.2 +017100 04 FILLER PIC X(5) VALUE SPACE. IF1344.2 +017200 04 XXCORRECT PIC X(20). IF1344.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). IF1344.2 +017400 01 HYPHEN-LINE. IF1344.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. IF1344.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************IF1344.2 +017700- "*****************************************". IF1344.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************IF1344.2 +017900- "******************************". IF1344.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE IF1344.2 +018100 "IF134A". IF1344.2 +018200 PROCEDURE DIVISION. IF1344.2 +018300 CCVS1 SECTION. IF1344.2 +018400 OPEN-FILES. IF1344.2 +018500 OPEN OUTPUT PRINT-FILE. IF1344.2 +018600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1344.2 +018700 MOVE SPACE TO TEST-RESULTS. IF1344.2 +018800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1344.2 +018900 GO TO CCVS1-EXIT. IF1344.2 +019000 CLOSE-FILES. IF1344.2 +019100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1344.2 +019200 TERMINATE-CCVS. IF1344.2 +019300 STOP RUN. IF1344.2 +019400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1344.2 +019500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1344.2 +019600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1344.2 +019700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1344.2 +019800 MOVE "****TEST DELETED****" TO RE-MARK. IF1344.2 +019900 PRINT-DETAIL. IF1344.2 +020000 IF REC-CT NOT EQUAL TO ZERO IF1344.2 +020100 MOVE "." TO PARDOT-X IF1344.2 +020200 MOVE REC-CT TO DOTVALUE. IF1344.2 +020300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1344.2 +020400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1344.2 +020500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1344.2 +020600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1344.2 +020700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1344.2 +020800 MOVE SPACE TO CORRECT-X. IF1344.2 +020900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1344.2 +021000 MOVE SPACE TO RE-MARK. IF1344.2 +021100 HEAD-ROUTINE. IF1344.2 +021200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +021300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +021400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1344.2 +021500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1344.2 +021600 COLUMN-NAMES-ROUTINE. IF1344.2 +021700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +021800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +022000 END-ROUTINE. IF1344.2 +022100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1344.2 +022200 END-RTN-EXIT. IF1344.2 +022300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +022400 END-ROUTINE-1. IF1344.2 +022500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1344.2 +022600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1344.2 +022700 ADD PASS-COUNTER TO ERROR-HOLD. IF1344.2 +022800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1344.2 +022900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1344.2 +023000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1344.2 +023100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1344.2 +023200 END-ROUTINE-12. IF1344.2 +023300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1344.2 +023400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1344.2 +023500 MOVE "NO " TO ERROR-TOTAL IF1344.2 +023600 ELSE IF1344.2 +023700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1344.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1344.2 +023900 PERFORM WRITE-LINE. IF1344.2 +024000 END-ROUTINE-13. IF1344.2 +024100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1344.2 +024200 MOVE "NO " TO ERROR-TOTAL ELSE IF1344.2 +024300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1344.2 +024400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1344.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +024600 IF INSPECT-COUNTER EQUAL TO ZERO IF1344.2 +024700 MOVE "NO " TO ERROR-TOTAL IF1344.2 +024800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1344.2 +024900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1344.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +025100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1344.2 +025200 WRITE-LINE. IF1344.2 +025300 ADD 1 TO RECORD-COUNT. IF1344.2 +025400 IF RECORD-COUNT GREATER 42 IF1344.2 +025500 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1344.2 +025600 MOVE SPACE TO DUMMY-RECORD IF1344.2 +025700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1344.2 +025800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1344.2 +025900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1344.2 +026000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1344.2 +026100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1344.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1344.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1344.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1344.2 +026500 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1344.2 +026600 MOVE ZERO TO RECORD-COUNT. IF1344.2 +026700 PERFORM WRT-LN. IF1344.2 +026800 WRT-LN. IF1344.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1344.2 +027000 MOVE SPACE TO DUMMY-RECORD. IF1344.2 +027100 BLANK-LINE-PRINT. IF1344.2 +027200 PERFORM WRT-LN. IF1344.2 +027300 FAIL-ROUTINE. IF1344.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE IF1344.2 +027500 GO TO FAIL-ROUTINE-WRITE. IF1344.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1344.2 +027700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1344.2 +027800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1344.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +028000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1344.2 +028100 GO TO FAIL-ROUTINE-EX. IF1344.2 +028200 FAIL-ROUTINE-WRITE. IF1344.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1344.2 +028400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1344.2 +028500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1344.2 +028600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1344.2 +028700 FAIL-ROUTINE-EX. EXIT. IF1344.2 +028800 BAIL-OUT. IF1344.2 +028900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1344.2 +029000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1344.2 +029100 BAIL-OUT-WRITE. IF1344.2 +029200 MOVE CORRECT-A TO XXCORRECT. IF1344.2 +029300 MOVE COMPUTED-A TO XXCOMPUTED. IF1344.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1344.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1344.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1344.2 +029700 BAIL-OUT-EX. EXIT. IF1344.2 +029800 CCVS1-EXIT. IF1344.2 +029900 EXIT. IF1344.2 +030000******************************************************** IF1344.2 +030100* * IF1344.2 +030200* Intrinsic Function Tests IF134A - REVERSE * IF1344.2 +030300* * IF1344.2 +030400******************************************************** IF1344.2 +030500 SECT-IF134A SECTION. IF1344.2 +030600 F-REVERSE-INFO. IF1344.2 +030700 MOVE "See ref. A-67 2.38" TO ANSI-REFERENCE. IF1344.2 +030800 MOVE "REVERSE Function" TO FEATURE. IF1344.2 +030900*****************TEST (a) ****************************** IF1344.2 +031000 F-REVERSE-01. IF1344.2 +031100 MOVE SPACES TO WS-ANUM. IF1344.2 +031200 F-REVERSE-TEST-01. IF1344.2 +031300 MOVE FUNCTION REVERSE("figure") TO WS-ANUM. IF1344.2 +031400 IF WS-ANUM = "erugif" THEN IF1344.2 +031500 PERFORM PASS IF1344.2 +031600 ELSE IF1344.2 +031700 MOVE "erugif" TO CORRECT-A IF1344.2 +031800 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +031900 PERFORM FAIL. IF1344.2 +032000 GO TO F-REVERSE-WRITE-01. IF1344.2 +032100 F-REVERSE-DELETE-01. IF1344.2 +032200 PERFORM DE-LETE. IF1344.2 +032300 GO TO F-REVERSE-WRITE-01. IF1344.2 +032400 F-REVERSE-WRITE-01. IF1344.2 +032500 MOVE "F-REVERSE-01" TO PAR-NAME. IF1344.2 +032600 PERFORM PRINT-DETAIL. IF1344.2 +032700*****************TEST (b) ****************************** IF1344.2 +032800 F-REVERSE-02. IF1344.2 +032900 MOVE SPACES TO WS-ANUM. IF1344.2 +033000 F-REVERSE-TEST-02. IF1344.2 +033100 IF FUNCTION REVERSE("CAPS") = "SPAC" THEN IF1344.2 +033200 PERFORM PASS IF1344.2 +033300 ELSE IF1344.2 +033400 MOVE "SPAC" TO CORRECT-A IF1344.2 +033500 PERFORM FAIL. IF1344.2 +033600 GO TO F-REVERSE-WRITE-02. IF1344.2 +033700 F-REVERSE-DELETE-02. IF1344.2 +033800 PERFORM DE-LETE. IF1344.2 +033900 GO TO F-REVERSE-WRITE-02. IF1344.2 +034000 F-REVERSE-WRITE-02. IF1344.2 +034100 MOVE "F-REVERSE-02" TO PAR-NAME. IF1344.2 +034200 PERFORM PRINT-DETAIL. IF1344.2 +034300*****************TEST (c) ****************************** IF1344.2 +034400 F-REVERSE-03. IF1344.2 +034500 MOVE SPACES TO WS-ANUM. IF1344.2 +034600 F-REVERSE-TEST-03. IF1344.2 +034700 MOVE FUNCTION REVERSE("highnLOW") TO WS-ANUM. IF1344.2 +034800 IF WS-ANUM = "WOLnhgih" THEN IF1344.2 +034900 PERFORM PASS IF1344.2 +035000 ELSE IF1344.2 +035100 MOVE "WOLnhgih" TO CORRECT-A IF1344.2 +035200 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +035300 PERFORM FAIL. IF1344.2 +035400 GO TO F-REVERSE-WRITE-03. IF1344.2 +035500 F-REVERSE-DELETE-03. IF1344.2 +035600 PERFORM DE-LETE. IF1344.2 +035700 GO TO F-REVERSE-WRITE-03. IF1344.2 +035800 F-REVERSE-WRITE-03. IF1344.2 +035900 MOVE "F-REVERSE-03" TO PAR-NAME. IF1344.2 +036000 PERFORM PRINT-DETAIL. IF1344.2 +036100*****************TEST (d) ****************************** IF1344.2 +036200 F-REVERSE-04. IF1344.2 +036300 MOVE SPACES TO WS-ANUM. IF1344.2 +036400 F-REVERSE-TEST-04. IF1344.2 +036500 MOVE FUNCTION REVERSE("95") TO WS-ANUM. IF1344.2 +036600 IF WS-ANUM = "59" THEN IF1344.2 +036700 PERFORM PASS IF1344.2 +036800 ELSE IF1344.2 +036900 MOVE "59" TO CORRECT-A IF1344.2 +037000 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +037100 PERFORM FAIL. IF1344.2 +037200 GO TO F-REVERSE-WRITE-04. IF1344.2 +037300 F-REVERSE-DELETE-04. IF1344.2 +037400 PERFORM DE-LETE. IF1344.2 +037500 GO TO F-REVERSE-WRITE-04. IF1344.2 +037600 F-REVERSE-WRITE-04. IF1344.2 +037700 MOVE "F-REVERSE-04" TO PAR-NAME. IF1344.2 +037800 PERFORM PRINT-DETAIL. IF1344.2 +037900*****************TEST (e) ****************************** IF1344.2 +038000 F-REVERSE-05. IF1344.2 +038100 MOVE SPACES TO WS-ANUM. IF1344.2 +038200 F-REVERSE-TEST-05. IF1344.2 +038300 MOVE FUNCTION REVERSE("8isaNUMBER") TO WS-ANUM. IF1344.2 +038400 IF WS-ANUM = "REBMUNasi8" THEN IF1344.2 +038500 PERFORM PASS IF1344.2 +038600 ELSE IF1344.2 +038700 MOVE "REBMUNasi8" TO CORRECT-A IF1344.2 +038800 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +038900 PERFORM FAIL. IF1344.2 +039000 GO TO F-REVERSE-WRITE-05. IF1344.2 +039100 F-REVERSE-DELETE-05. IF1344.2 +039200 PERFORM DE-LETE. IF1344.2 +039300 GO TO F-REVERSE-WRITE-05. IF1344.2 +039400 F-REVERSE-WRITE-05. IF1344.2 +039500 MOVE "F-REVERSE-05" TO PAR-NAME. IF1344.2 +039600 PERFORM PRINT-DETAIL. IF1344.2 +039700*****************TEST (f) ****************************** IF1344.2 +039800 F-REVERSE-06. IF1344.2 +039900 MOVE SPACES TO WS-ANUM. IF1344.2 +040000 F-REVERSE-TEST-06. IF1344.2 +040100 MOVE FUNCTION REVERSE(A) TO WS-ANUM. IF1344.2 +040200 IF WS-ANUM = " elbmut" THEN IF1344.2 +040300 PERFORM PASS IF1344.2 +040400 ELSE IF1344.2 +040500 MOVE " elbmut" TO CORRECT-A IF1344.2 +040600 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +040700 PERFORM FAIL. IF1344.2 +040800 GO TO F-REVERSE-WRITE-06. IF1344.2 +040900 F-REVERSE-DELETE-06. IF1344.2 +041000 PERFORM DE-LETE. IF1344.2 +041100 GO TO F-REVERSE-WRITE-06. IF1344.2 +041200 F-REVERSE-WRITE-06. IF1344.2 +041300 MOVE "F-REVERSE-06" TO PAR-NAME. IF1344.2 +041400 PERFORM PRINT-DETAIL. IF1344.2 +041500*****************TEST (g) ****************************** IF1344.2 +041600 F-REVERSE-07. IF1344.2 +041700 MOVE SPACES TO WS-ANUM. IF1344.2 +041800 F-REVERSE-TEST-07. IF1344.2 +041900 MOVE FUNCTION REVERSE(B) TO WS-ANUM. IF1344.2 +042000 IF WS-ANUM = " DEEW" THEN IF1344.2 +042100 PERFORM PASS IF1344.2 +042200 ELSE IF1344.2 +042300 MOVE " DEEW" TO CORRECT-A IF1344.2 +042400 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +042500 PERFORM FAIL. IF1344.2 +042600 GO TO F-REVERSE-WRITE-07. IF1344.2 +042700 F-REVERSE-DELETE-07. IF1344.2 +042800 PERFORM DE-LETE. IF1344.2 +042900 GO TO F-REVERSE-WRITE-07. IF1344.2 +043000 F-REVERSE-WRITE-07. IF1344.2 +043100 MOVE "F-REVERSE-07" TO PAR-NAME. IF1344.2 +043200 PERFORM PRINT-DETAIL. IF1344.2 +043300*****************TEST (h) ****************************** IF1344.2 +043400 F-REVERSE-08. IF1344.2 +043500 MOVE SPACES TO WS-ANUM. IF1344.2 +043600 F-REVERSE-TEST-08. IF1344.2 +043700 MOVE FUNCTION REVERSE(C) TO WS-ANUM. IF1344.2 +043800 IF WS-ANUM = " saW" THEN IF1344.2 +043900 PERFORM PASS IF1344.2 +044000 ELSE IF1344.2 +044100 MOVE " saW" TO CORRECT-A IF1344.2 +044200 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +044300 PERFORM FAIL. IF1344.2 +044400 GO TO F-REVERSE-WRITE-08. IF1344.2 +044500 F-REVERSE-DELETE-08. IF1344.2 +044600 PERFORM DE-LETE. IF1344.2 +044700 GO TO F-REVERSE-WRITE-08. IF1344.2 +044800 F-REVERSE-WRITE-08. IF1344.2 +044900 MOVE "F-REVERSE-08" TO PAR-NAME. IF1344.2 +045000 PERFORM PRINT-DETAIL. IF1344.2 +045100*****************TEST (i) ****************************** IF1344.2 +045200 F-REVERSE-09. IF1344.2 +045300 MOVE SPACES TO WS-ANUM. IF1344.2 +045400 F-REVERSE-TEST-09. IF1344.2 +045500 MOVE FUNCTION REVERSE(D) TO WS-ANUM. IF1344.2 +045600 IF WS-ANUM = " 4" THEN IF1344.2 +045700 PERFORM PASS IF1344.2 +045800 ELSE IF1344.2 +045900 MOVE " 4" TO CORRECT-A IF1344.2 +046000 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +046100 PERFORM FAIL. IF1344.2 +046200 GO TO F-REVERSE-WRITE-09. IF1344.2 +046300 F-REVERSE-DELETE-09. IF1344.2 +046400 PERFORM DE-LETE. IF1344.2 +046500 GO TO F-REVERSE-WRITE-09. IF1344.2 +046600 F-REVERSE-WRITE-09. IF1344.2 +046700 MOVE "F-REVERSE-09" TO PAR-NAME. IF1344.2 +046800 PERFORM PRINT-DETAIL. IF1344.2 +046900*****************TEST (j) ****************************** IF1344.2 +047000 F-REVERSE-10. IF1344.2 +047100 MOVE SPACES TO WS-ANUM. IF1344.2 +047200 F-REVERSE-TEST-10. IF1344.2 +047300 MOVE FUNCTION REVERSE(E) TO WS-ANUM. IF1344.2 +047400 IF WS-ANUM = " 4dnA" THEN IF1344.2 +047500 PERFORM PASS IF1344.2 +047600 ELSE IF1344.2 +047700 MOVE " 4dnA" TO CORRECT-A IF1344.2 +047800 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +047900 PERFORM FAIL. IF1344.2 +048000 GO TO F-REVERSE-WRITE-10. IF1344.2 +048100 F-REVERSE-DELETE-10. IF1344.2 +048200 PERFORM DE-LETE. IF1344.2 +048300 GO TO F-REVERSE-WRITE-10. IF1344.2 +048400 F-REVERSE-WRITE-10. IF1344.2 +048500 MOVE "F-REVERSE-10" TO PAR-NAME. IF1344.2 +048600 PERFORM PRINT-DETAIL. IF1344.2 +048700*****************TEST (k) ****************************** IF1344.2 +048800 F-REVERSE-11. IF1344.2 +048900 MOVE ZERO TO TEMP. IF1344.2 +049000 F-REVERSE-TEST-11. IF1344.2 +049100 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION REVERSE("Homer")). IF1344.2 +049200 IF TEMP = 5 THEN IF1344.2 +049300 PERFORM PASS IF1344.2 +049400 ELSE IF1344.2 +049500 MOVE 5 TO CORRECT-N IF1344.2 +049600 MOVE TEMP TO COMPUTED-N IF1344.2 +049700 PERFORM FAIL. IF1344.2 +049800 GO TO F-REVERSE-WRITE-11. IF1344.2 +049900 F-REVERSE-DELETE-11. IF1344.2 +050000 PERFORM DE-LETE. IF1344.2 +050100 GO TO F-REVERSE-WRITE-11. IF1344.2 +050200 F-REVERSE-WRITE-11. IF1344.2 +050300 MOVE "F-REVERSE-11" TO PAR-NAME. IF1344.2 +050400 PERFORM PRINT-DETAIL. IF1344.2 +050500*****************TEST (l) ****************************** IF1344.2 +050600 F-REVERSE-12. IF1344.2 +050700 MOVE SPACES TO WS-ANUM. IF1344.2 +050800 F-REVERSE-TEST-12. IF1344.2 +050900 MOVE FUNCTION REVERSE(FUNCTION REVERSE("giZZard")) IF1344.2 +051000 TO WS-ANUM. IF1344.2 +051100 IF WS-ANUM = "giZZard" THEN IF1344.2 +051200 PERFORM PASS IF1344.2 +051300 ELSE IF1344.2 +051400 MOVE "giZZard" TO CORRECT-A IF1344.2 +051500 MOVE WS-ANUM TO COMPUTED-A IF1344.2 +051600 PERFORM FAIL. IF1344.2 +051700 GO TO F-REVERSE-WRITE-12. IF1344.2 +051800 F-REVERSE-DELETE-12. IF1344.2 +051900 PERFORM DE-LETE. IF1344.2 +052000 GO TO F-REVERSE-WRITE-12. IF1344.2 +052100 F-REVERSE-WRITE-12. IF1344.2 +052200 MOVE "F-REVERSE-12" TO PAR-NAME. IF1344.2 +052300 PERFORM PRINT-DETAIL. IF1344.2 +052400*****************TEST (m) ****************************** IF1344.2 +052500 F-REVERSE-13. IF1344.2 +052600 MOVE ZERO TO TEMP. IF1344.2 +052700 F-REVERSE-TEST-13. IF1344.2 +052800 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION REVERSE("HOMER")) + IF1344.2 +052900 FUNCTION LENGTH(FUNCTION REVERSE("Gizzard")). IF1344.2 +053000 IF TEMP = 12 THEN IF1344.2 +053100 PERFORM PASS IF1344.2 +053200 ELSE IF1344.2 +053300 MOVE 12 TO CORRECT-N IF1344.2 +053400 MOVE TEMP TO COMPUTED-N IF1344.2 +053500 PERFORM FAIL. IF1344.2 +053600 GO TO F-REVERSE-WRITE-13. IF1344.2 +053700 F-REVERSE-DELETE-13. IF1344.2 +053800 PERFORM DE-LETE. IF1344.2 +053900 GO TO F-REVERSE-WRITE-13. IF1344.2 +054000 F-REVERSE-WRITE-13. IF1344.2 +054100 MOVE "F-REVERSE-13" TO PAR-NAME. IF1344.2 +054200 PERFORM PRINT-DETAIL. IF1344.2 +054300*******************END OF TESTS************************** IF1344.2 +054400 CCVS-EXIT SECTION. IF1344.2 +054500 CCVS-999999. IF1344.2 +054600 GO TO CLOSE-FILES. IF1344.2 diff --git a/tests/cobol85/IF/IF135A.CBL b/tests/cobol85/IF/IF135A.CBL new file mode 100755 index 00000000..d499d9e8 --- /dev/null +++ b/tests/cobol85/IF/IF135A.CBL @@ -0,0 +1,1036 @@ +000100 IDENTIFICATION DIVISION. IF1354.2 +000200 PROGRAM-ID. IF1354.2 +000300 IF135A. IF1354.2 +000400 IF1354.2 +000500*********************************************************** IF1354.2 +000600* * IF1354.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1354.2 +000800* It contains tests for the Intrinsic Function SIN. * IF1354.2 +000900* * IF1354.2 +001000*********************************************************** IF1354.2 +001100 ENVIRONMENT DIVISION. IF1354.2 +001200 CONFIGURATION SECTION. IF1354.2 +001300 SOURCE-COMPUTER. IF1354.2 +001400 Linux. IF1354.2 +001500 OBJECT-COMPUTER. IF1354.2 +001600 Linux. IF1354.2 +001700 INPUT-OUTPUT SECTION. IF1354.2 +001800 FILE-CONTROL. IF1354.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1354.2 +002000 "report.log". IF1354.2 +002100 DATA DIVISION. IF1354.2 +002200 FILE SECTION. IF1354.2 +002300 FD PRINT-FILE. IF1354.2 +002400 01 PRINT-REC PICTURE X(120). IF1354.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1354.2 +002600 WORKING-STORAGE SECTION. IF1354.2 +002700*********************************************************** IF1354.2 +002800* Variables specific to the Intrinsic Function Test IF135A* IF1354.2 +002900*********************************************************** IF1354.2 +003000 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1354.2 +003100 01 B PIC S9(5)V9(5) VALUE 14000.105. IF1354.2 +003200 01 C PIC S9(10) VALUE 100000. IF1354.2 +003300 01 D PIC S9(10) VALUE 1000. IF1354.2 +003400 01 PI PIC S9V9(17) VALUE 3.141592654. IF1354.2 +003500 01 MINUSPI PIC S9V9(17) VALUE -3.141592654. IF1354.2 +003600 01 P PIC S9(10) VALUE 1. IF1354.2 +003700 01 ARG1 PIC S9(10) VALUE 3. IF1354.2 +003800 01 ARR VALUE "40537". IF1354.2 +003900 02 IND OCCURS 5 TIMES PIC 9. IF1354.2 +004000 01 TEMP PIC S9(5)V9(5). IF1354.2 +004100 01 WS-NUM PIC S9(5)V9(6). IF1354.2 +004200 01 MIN-RANGE PIC S9(5)V9(7). IF1354.2 +004300 01 MAX-RANGE PIC S9(5)V9(7). IF1354.2 +004400* IF1354.2 +004500********************************************************** IF1354.2 +004600* IF1354.2 +004700 01 TEST-RESULTS. IF1354.2 +004800 02 FILLER PIC X VALUE SPACE. IF1354.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1354.2 +005000 02 FILLER PIC X VALUE SPACE. IF1354.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1354.2 +005200 02 FILLER PIC X VALUE SPACE. IF1354.2 +005300 02 PAR-NAME. IF1354.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1354.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1354.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1354.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1354.2 +005800 02 RE-MARK PIC X(61). IF1354.2 +005900 01 TEST-COMPUTED. IF1354.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1354.2 +006100 02 FILLER PIC X(17) VALUE IF1354.2 +006200 " COMPUTED=". IF1354.2 +006300 02 COMPUTED-X. IF1354.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1354.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1354.2 +006600 PIC -9(9).9(9). IF1354.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1354.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1354.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1354.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1354.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1354.2 +007200 04 FILLER PIC X. IF1354.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1354.2 +007400 01 TEST-CORRECT. IF1354.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1354.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1354.2 +007700 02 CORRECT-X. IF1354.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1354.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1354.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1354.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1354.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1354.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1354.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1354.2 +008500 04 FILLER PIC X. IF1354.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1354.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1354.2 +008800 01 TEST-CORRECT-MIN. IF1354.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1354.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1354.2 +009100 02 CORRECTMI-X. IF1354.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1354.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1354.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1354.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1354.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1354.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1354.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1354.2 +009900 04 FILLER PIC X. IF1354.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1354.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1354.2 +010200 01 TEST-CORRECT-MAX. IF1354.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1354.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1354.2 +010500 02 CORRECTMA-X. IF1354.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1354.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1354.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1354.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1354.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1354.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1354.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1354.2 +011300 04 FILLER PIC X. IF1354.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1354.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1354.2 +011600 01 CCVS-C-1. IF1354.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1354.2 +011800- "SS PARAGRAPH-NAME IF1354.2 +011900- " REMARKS". IF1354.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1354.2 +012100 01 CCVS-C-2. IF1354.2 +012200 02 FILLER PIC X VALUE SPACE. IF1354.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1354.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1354.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1354.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1354.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1354.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1354.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1354.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1354.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1354.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1354.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1354.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1354.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1354.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1354.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1354.2 +013800 01 CCVS-H-1. IF1354.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1354.2 +014000 02 FILLER PIC X(42) VALUE IF1354.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1354.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1354.2 +014300 01 CCVS-H-2A. IF1354.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1354.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1354.2 +014600 02 FILLER PIC XXXX VALUE IF1354.2 +014700 "4.2 ". IF1354.2 +014800 02 FILLER PIC X(28) VALUE IF1354.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1354.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1354.2 +015100 IF1354.2 +015200 01 CCVS-H-2B. IF1354.2 +015300 02 FILLER PIC X(15) VALUE IF1354.2 +015400 "TEST RESULT OF ". IF1354.2 +015500 02 TEST-ID PIC X(9). IF1354.2 +015600 02 FILLER PIC X(4) VALUE IF1354.2 +015700 " IN ". IF1354.2 +015800 02 FILLER PIC X(12) VALUE IF1354.2 +015900 " HIGH ". IF1354.2 +016000 02 FILLER PIC X(22) VALUE IF1354.2 +016100 " LEVEL VALIDATION FOR ". IF1354.2 +016200 02 FILLER PIC X(58) VALUE IF1354.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1354.2 +016400 01 CCVS-H-3. IF1354.2 +016500 02 FILLER PIC X(34) VALUE IF1354.2 +016600 " FOR OFFICIAL USE ONLY ". IF1354.2 +016700 02 FILLER PIC X(58) VALUE IF1354.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1354.2 +016900 02 FILLER PIC X(28) VALUE IF1354.2 +017000 " COPYRIGHT 1985 ". IF1354.2 +017100 01 CCVS-E-1. IF1354.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1354.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1354.2 +017400 02 ID-AGAIN PIC X(9). IF1354.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1354.2 +017600 01 CCVS-E-2. IF1354.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1354.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1354.2 +017900 02 CCVS-E-2-2. IF1354.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1354.2 +018100 03 FILLER PIC X VALUE SPACE. IF1354.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1354.2 +018300 "ERRORS ENCOUNTERED". IF1354.2 +018400 01 CCVS-E-3. IF1354.2 +018500 02 FILLER PIC X(22) VALUE IF1354.2 +018600 " FOR OFFICIAL USE ONLY". IF1354.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1354.2 +018800 02 FILLER PIC X(58) VALUE IF1354.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1354.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1354.2 +019100 02 FILLER PIC X(15) VALUE IF1354.2 +019200 " COPYRIGHT 1985". IF1354.2 +019300 01 CCVS-E-4. IF1354.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1354.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1354.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1354.2 +019700 02 FILLER PIC X(40) VALUE IF1354.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1354.2 +019900 01 XXINFO. IF1354.2 +020000 02 FILLER PIC X(19) VALUE IF1354.2 +020100 "*** INFORMATION ***". IF1354.2 +020200 02 INFO-TEXT. IF1354.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1354.2 +020400 04 XXCOMPUTED PIC X(20). IF1354.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1354.2 +020600 04 XXCORRECT PIC X(20). IF1354.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1354.2 +020800 01 HYPHEN-LINE. IF1354.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1354.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1354.2 +021100- "*****************************************". IF1354.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1354.2 +021300- "******************************". IF1354.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1354.2 +021500 "IF135A". IF1354.2 +021600 PROCEDURE DIVISION. IF1354.2 +021700 CCVS1 SECTION. IF1354.2 +021800 OPEN-FILES. IF1354.2 +021900 OPEN OUTPUT PRINT-FILE. IF1354.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1354.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1354.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1354.2 +022300 GO TO CCVS1-EXIT. IF1354.2 +022400 CLOSE-FILES. IF1354.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1354.2 +022600 TERMINATE-CCVS. IF1354.2 +022700 STOP RUN. IF1354.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1354.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1354.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1354.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1354.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1354.2 +023300 PRINT-DETAIL. IF1354.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1354.2 +023500 MOVE "." TO PARDOT-X IF1354.2 +023600 MOVE REC-CT TO DOTVALUE. IF1354.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1354.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1354.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1354.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1354.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1354.2 +024200 MOVE SPACE TO CORRECT-X. IF1354.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1354.2 +024400 MOVE SPACE TO RE-MARK. IF1354.2 +024500 HEAD-ROUTINE. IF1354.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1354.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1354.2 +025000 COLUMN-NAMES-ROUTINE. IF1354.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +025400 END-ROUTINE. IF1354.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1354.2 +025600 END-RTN-EXIT. IF1354.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +025800 END-ROUTINE-1. IF1354.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1354.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1354.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1354.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1354.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1354.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1354.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1354.2 +026600 END-ROUTINE-12. IF1354.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1354.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1354.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1354.2 +027000 ELSE IF1354.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1354.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1354.2 +027300 PERFORM WRITE-LINE. IF1354.2 +027400 END-ROUTINE-13. IF1354.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1354.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1354.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1354.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1354.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1354.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1354.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1354.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1354.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1354.2 +028600 WRITE-LINE. IF1354.2 +028700 ADD 1 TO RECORD-COUNT. IF1354.2 +028800 IF RECORD-COUNT GREATER 42 IF1354.2 +028900 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1354.2 +029000 MOVE SPACE TO DUMMY-RECORD IF1354.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1354.2 +029200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1354.2 +029300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1354.2 +029400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1354.2 +029500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1354.2 +029600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1354.2 +029700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1354.2 +029800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1354.2 +029900 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1354.2 +030000 MOVE ZERO TO RECORD-COUNT. IF1354.2 +030100 PERFORM WRT-LN. IF1354.2 +030200 WRT-LN. IF1354.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1354.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1354.2 +030500 BLANK-LINE-PRINT. IF1354.2 +030600 PERFORM WRT-LN. IF1354.2 +030700 FAIL-ROUTINE. IF1354.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1354.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1354.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1354.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1354.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1354.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1354.2 +031500 GO TO FAIL-ROUTINE-EX. IF1354.2 +031600 FAIL-ROUTINE-WRITE. IF1354.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1354.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1354.2 +031900 CORMA-ANSI-REFERENCE. IF1354.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1354.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1354.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1354.2 +032300 ELSE IF1354.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1354.2 +032500 PERFORM WRITE-LINE. IF1354.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1354.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1354.2 +032800 BAIL-OUT. IF1354.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1354.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1354.2 +033100 BAIL-OUT-WRITE. IF1354.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1354.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1354.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1354.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1354.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1354.2 +033700 BAIL-OUT-EX. EXIT. IF1354.2 +033800 CCVS1-EXIT. IF1354.2 +033900 EXIT. IF1354.2 +034000******************************************************** IF1354.2 +034100* * IF1354.2 +034200* Intrinsic Function Tests IF135A - SIN * IF1354.2 +034300* * IF1354.2 +034400******************************************************** IF1354.2 +034500 SECT-IF135A SECTION. IF1354.2 +034600 F-SIN-INFO. IF1354.2 +034700 MOVE "See ref. A-68 2.39" TO ANSI-REFERENCE. IF1354.2 +034800 MOVE "SIN Function" TO FEATURE. IF1354.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1354.2 +035000 F-SIN-01. IF1354.2 +035100 MOVE ZERO TO WS-NUM. IF1354.2 +035200 MOVE -0.000020 TO MIN-RANGE. IF1354.2 +035300 MOVE 0.000020 TO MAX-RANGE. IF1354.2 +035400 F-SIN-TEST-01. IF1354.2 +035500 COMPUTE WS-NUM = FUNCTION SIN(0). IF1354.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +035800 PERFORM PASS IF1354.2 +035900 ELSE IF1354.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1354.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +036300 PERFORM FAIL. IF1354.2 +036400 GO TO F-SIN-WRITE-01. IF1354.2 +036500 F-SIN-DELETE-01. IF1354.2 +036600 PERFORM DE-LETE. IF1354.2 +036700 GO TO F-SIN-WRITE-01. IF1354.2 +036800 F-SIN-WRITE-01. IF1354.2 +036900 MOVE "F-SIN-01" TO PAR-NAME. IF1354.2 +037000 PERFORM PRINT-DETAIL. IF1354.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1354.2 +037200 F-SIN-02. IF1354.2 +037300 EVALUATE FUNCTION SIN(PI) IF1354.2 +037400 WHEN -0.000020 THRU 0.000020 IF1354.2 +037500 PERFORM PASS IF1354.2 +037600 WHEN OTHER IF1354.2 +037700 PERFORM FAIL. IF1354.2 +037800 GO TO F-SIN-WRITE-02. IF1354.2 +037900 F-SIN-DELETE-02. IF1354.2 +038000 PERFORM DE-LETE. IF1354.2 +038100 GO TO F-SIN-WRITE-02. IF1354.2 +038200 F-SIN-WRITE-02. IF1354.2 +038300 MOVE "F-SIN-02" TO PAR-NAME. IF1354.2 +038400 PERFORM PRINT-DETAIL. IF1354.2 +038500*****************TEST (c) - SIMPLE TEST***************** IF1354.2 +038600 F-SIN-03. IF1354.2 +038700 MOVE -0.000020 TO MIN-RANGE. IF1354.2 +038800 MOVE 0.000020 TO MAX-RANGE. IF1354.2 +038900 F-SIN-TEST-03. IF1354.2 +039000 IF (FUNCTION SIN(MINUSPI) >= MIN-RANGE) AND IF1354.2 +039100 (FUNCTION SIN(MINUSPI) <= MAX-RANGE) THEN IF1354.2 +039200 PERFORM PASS IF1354.2 +039300 ELSE IF1354.2 +039400 PERFORM FAIL. IF1354.2 +039500 GO TO F-SIN-WRITE-03. IF1354.2 +039600 F-SIN-DELETE-03. IF1354.2 +039700 PERFORM DE-LETE. IF1354.2 +039800 GO TO F-SIN-WRITE-03. IF1354.2 +039900 F-SIN-WRITE-03. IF1354.2 +040000 MOVE "F-SIN-03" TO PAR-NAME. IF1354.2 +040100 PERFORM PRINT-DETAIL. IF1354.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1354.2 +040300 F-SIN-04. IF1354.2 +040400 MOVE ZERO TO WS-NUM. IF1354.2 +040500 MOVE 0.000999 TO MIN-RANGE. IF1354.2 +040600 MOVE 0.001000 TO MAX-RANGE. IF1354.2 +040700 F-SIN-TEST-04. IF1354.2 +040800 COMPUTE WS-NUM = FUNCTION SIN(0.001). IF1354.2 +040900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +041000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +041100 PERFORM PASS IF1354.2 +041200 ELSE IF1354.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +041400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +041500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +041600 PERFORM FAIL. IF1354.2 +041700 GO TO F-SIN-WRITE-04. IF1354.2 +041800 F-SIN-DELETE-04. IF1354.2 +041900 PERFORM DE-LETE. IF1354.2 +042000 GO TO F-SIN-WRITE-04. IF1354.2 +042100 F-SIN-WRITE-04. IF1354.2 +042200 MOVE "F-SIN-04" TO PAR-NAME. IF1354.2 +042300 PERFORM PRINT-DETAIL. IF1354.2 +042400*****************TEST (e) - SIMPLE TEST***************** IF1354.2 +042500 F-SIN-05. IF1354.2 +042600 MOVE ZERO TO WS-NUM. IF1354.2 +042700 MOVE 0.000089 TO MIN-RANGE. IF1354.2 +042800 MOVE 0.000090 TO MAX-RANGE. IF1354.2 +042900 F-SIN-TEST-05. IF1354.2 +043000 COMPUTE WS-NUM = FUNCTION SIN(.00009). IF1354.2 +043100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +043200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +043300 PERFORM PASS IF1354.2 +043400 ELSE IF1354.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +043600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +043700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +043800 PERFORM FAIL. IF1354.2 +043900 GO TO F-SIN-WRITE-05. IF1354.2 +044000 F-SIN-DELETE-05. IF1354.2 +044100 PERFORM DE-LETE. IF1354.2 +044200 GO TO F-SIN-WRITE-05. IF1354.2 +044300 F-SIN-WRITE-05. IF1354.2 +044400 MOVE "F-SIN-05" TO PAR-NAME. IF1354.2 +044500 PERFORM PRINT-DETAIL. IF1354.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1354.2 +044700 F-SIN-06. IF1354.2 +044800 MOVE ZERO TO WS-NUM. IF1354.2 +044900 MOVE -0.000040 TO MIN-RANGE. IF1354.2 +045000 MOVE -0.000039 TO MAX-RANGE. IF1354.2 +045100 F-SIN-TEST-06. IF1354.2 +045200 COMPUTE WS-NUM = FUNCTION SIN(A). IF1354.2 +045300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +045400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +045500 PERFORM PASS IF1354.2 +045600 ELSE IF1354.2 +045700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +045800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +045900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +046000 PERFORM FAIL. IF1354.2 +046100 GO TO F-SIN-WRITE-06. IF1354.2 +046200 F-SIN-DELETE-06. IF1354.2 +046300 PERFORM DE-LETE. IF1354.2 +046400 GO TO F-SIN-WRITE-06. IF1354.2 +046500 F-SIN-WRITE-06. IF1354.2 +046600 MOVE "F-SIN-06" TO PAR-NAME. IF1354.2 +046700 PERFORM PRINT-DETAIL. IF1354.2 +046800*****************TEST (g) - SIMPLE TEST***************** IF1354.2 +046900 F-SIN-07. IF1354.2 +047000 MOVE ZERO TO WS-NUM. IF1354.2 +047100 MOVE -0.756817 TO MIN-RANGE. IF1354.2 +047200 MOVE -0.756787 TO MAX-RANGE. IF1354.2 +047300 F-SIN-TEST-07. IF1354.2 +047400 COMPUTE WS-NUM = FUNCTION SIN(IND(P)). IF1354.2 +047500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +047600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +047700 PERFORM PASS IF1354.2 +047800 ELSE IF1354.2 +047900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +048000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +048100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +048200 PERFORM FAIL. IF1354.2 +048300 GO TO F-SIN-WRITE-07. IF1354.2 +048400 F-SIN-DELETE-07. IF1354.2 +048500 PERFORM DE-LETE. IF1354.2 +048600 GO TO F-SIN-WRITE-07. IF1354.2 +048700 F-SIN-WRITE-07. IF1354.2 +048800 MOVE "F-SIN-07" TO PAR-NAME. IF1354.2 +048900 PERFORM PRINT-DETAIL. IF1354.2 +049000*****************TEST (h) - SIMPLE TEST***************** IF1354.2 +049100 F-SIN-08. IF1354.2 +049200 MOVE ZERO TO WS-NUM. IF1354.2 +049300 MOVE 0.141117 TO MIN-RANGE. IF1354.2 +049400 MOVE 0.141123 TO MAX-RANGE. IF1354.2 +049500 F-SIN-TEST-08. IF1354.2 +049600 COMPUTE WS-NUM = FUNCTION SIN(IND(4)). IF1354.2 +049700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +049800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +049900 PERFORM PASS IF1354.2 +050000 ELSE IF1354.2 +050100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +050200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +050300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +050400 PERFORM FAIL. IF1354.2 +050500 GO TO F-SIN-WRITE-08. IF1354.2 +050600 F-SIN-DELETE-08. IF1354.2 +050700 PERFORM DE-LETE. IF1354.2 +050800 GO TO F-SIN-WRITE-08. IF1354.2 +050900 F-SIN-WRITE-08. IF1354.2 +051000 MOVE "F-SIN-08" TO PAR-NAME. IF1354.2 +051100 PERFORM PRINT-DETAIL. IF1354.2 +051200*****************TEST (a) - COMPLEX TEST**************** IF1354.2 +051300 F-SIN-09. IF1354.2 +051400 MOVE ZERO TO WS-NUM. IF1354.2 +051500 MOVE 0.865990 TO MIN-RANGE. IF1354.2 +051600 MOVE 0.866060 TO MAX-RANGE. IF1354.2 +051700 F-SIN-TEST-09. IF1354.2 +051800 COMPUTE WS-NUM = FUNCTION SIN(PI / 3). IF1354.2 +051900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +052000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +052100 PERFORM PASS IF1354.2 +052200 ELSE IF1354.2 +052300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +052400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +052500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +052600 PERFORM FAIL. IF1354.2 +052700 GO TO F-SIN-WRITE-09. IF1354.2 +052800 F-SIN-DELETE-09. IF1354.2 +052900 PERFORM DE-LETE. IF1354.2 +053000 GO TO F-SIN-WRITE-09. IF1354.2 +053100 F-SIN-WRITE-09. IF1354.2 +053200 MOVE "F-SIN-09" TO PAR-NAME. IF1354.2 +053300 PERFORM PRINT-DETAIL. IF1354.2 +053400*****************TEST (b) - COMPLEX TEST**************** IF1354.2 +053500 F-SIN-10. IF1354.2 +053600 MOVE ZERO TO WS-NUM. IF1354.2 +053700 MOVE 0.999960 TO MIN-RANGE. IF1354.2 +053800 MOVE 1.00000 TO MAX-RANGE. IF1354.2 +053900 F-SIN-TEST-10. IF1354.2 +054000 COMPUTE WS-NUM = FUNCTION SIN(PI / 2). IF1354.2 +054100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +054200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +054300 PERFORM PASS IF1354.2 +054400 ELSE IF1354.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +054600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +054700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +054800 PERFORM FAIL. IF1354.2 +054900 GO TO F-SIN-WRITE-10. IF1354.2 +055000 F-SIN-DELETE-10. IF1354.2 +055100 PERFORM DE-LETE. IF1354.2 +055200 GO TO F-SIN-WRITE-10. IF1354.2 +055300 F-SIN-WRITE-10. IF1354.2 +055400 MOVE "F-SIN-10" TO PAR-NAME. IF1354.2 +055500 PERFORM PRINT-DETAIL. IF1354.2 +055600*****************TEST (c) - COMPLEX TEST**************** IF1354.2 +055700 F-SIN-11. IF1354.2 +055800 MOVE ZERO TO WS-NUM. IF1354.2 +055900 MOVE -1.00000 TO MIN-RANGE. IF1354.2 +056000 MOVE -0.999960 TO MAX-RANGE. IF1354.2 +056100 F-SIN-TEST-11. IF1354.2 +056200 COMPUTE WS-NUM = FUNCTION SIN((3 * PI) / 2). IF1354.2 +056300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +056400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +056500 PERFORM PASS IF1354.2 +056600 ELSE IF1354.2 +056700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +056800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +056900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +057000 PERFORM FAIL. IF1354.2 +057100 GO TO F-SIN-WRITE-11. IF1354.2 +057200 F-SIN-DELETE-11. IF1354.2 +057300 PERFORM DE-LETE. IF1354.2 +057400 GO TO F-SIN-WRITE-11. IF1354.2 +057500 F-SIN-WRITE-11. IF1354.2 +057600 MOVE "F-SIN-11" TO PAR-NAME. IF1354.2 +057700 PERFORM PRINT-DETAIL. IF1354.2 +057800*****************TEST (d) - COMPLEX TEST**************** IF1354.2 +057900 F-SIN-12. IF1354.2 +058000 MOVE ZERO TO WS-NUM. IF1354.2 +058100 MOVE -0.866060 TO MIN-RANGE. IF1354.2 +058200 MOVE -0.865990 TO MAX-RANGE. IF1354.2 +058300 F-SIN-TEST-12. IF1354.2 +058400 COMPUTE WS-NUM = FUNCTION SIN(MINUSPI / 3). IF1354.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +058700 PERFORM PASS IF1354.2 +058800 ELSE IF1354.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +059200 PERFORM FAIL. IF1354.2 +059300 GO TO F-SIN-WRITE-12. IF1354.2 +059400 F-SIN-DELETE-12. IF1354.2 +059500 PERFORM DE-LETE. IF1354.2 +059600 GO TO F-SIN-WRITE-12. IF1354.2 +059700 F-SIN-WRITE-12. IF1354.2 +059800 MOVE "F-SIN-12" TO PAR-NAME. IF1354.2 +059900 PERFORM PRINT-DETAIL. IF1354.2 +060000*****************TEST (e) - COMPLEX TEST**************** IF1354.2 +060100 F-SIN-13. IF1354.2 +060200 MOVE ZERO TO WS-NUM. IF1354.2 +060300 MOVE -1.00000 TO MIN-RANGE. IF1354.2 +060400 MOVE -0.999960 TO MAX-RANGE. IF1354.2 +060500 F-SIN-TEST-13. IF1354.2 +060600 COMPUTE WS-NUM = FUNCTION SIN(MINUSPI / 2). IF1354.2 +060700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +060800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +060900 PERFORM PASS IF1354.2 +061000 ELSE IF1354.2 +061100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +061200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +061300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +061400 PERFORM FAIL. IF1354.2 +061500 GO TO F-SIN-WRITE-13. IF1354.2 +061600 F-SIN-DELETE-13. IF1354.2 +061700 PERFORM DE-LETE. IF1354.2 +061800 GO TO F-SIN-WRITE-13. IF1354.2 +061900 F-SIN-WRITE-13. IF1354.2 +062000 MOVE "F-SIN-13" TO PAR-NAME. IF1354.2 +062100 PERFORM PRINT-DETAIL. IF1354.2 +062200*****************TEST (f) - COMPLEX TEST**************** IF1354.2 +062300 F-SIN-14. IF1354.2 +062400 MOVE ZERO TO WS-NUM. IF1354.2 +062500 MOVE 0.999960 TO MIN-RANGE. IF1354.2 +062600 MOVE 1.00000 TO MAX-RANGE. IF1354.2 +062700 F-SIN-TEST-14. IF1354.2 +062800 COMPUTE WS-NUM = FUNCTION SIN((3 * MINUSPI) / 2). IF1354.2 +062900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +063000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +063100 PERFORM PASS IF1354.2 +063200 ELSE IF1354.2 +063300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +063400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +063500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +063600 PERFORM FAIL. IF1354.2 +063700 GO TO F-SIN-WRITE-14. IF1354.2 +063800 F-SIN-DELETE-14. IF1354.2 +063900 PERFORM DE-LETE. IF1354.2 +064000 GO TO F-SIN-WRITE-14. IF1354.2 +064100 F-SIN-WRITE-14. IF1354.2 +064200 MOVE "F-SIN-14" TO PAR-NAME. IF1354.2 +064300 PERFORM PRINT-DETAIL. IF1354.2 +064400*****************TEST (g) - COMPLEX TEST**************** IF1354.2 +064500 F-SIN-15. IF1354.2 +064600 MOVE ZERO TO WS-NUM. IF1354.2 +064700 MOVE 0.999960 TO MIN-RANGE. IF1354.2 +064800 MOVE 1.00000 TO MAX-RANGE. IF1354.2 +064900 F-SIN-TEST-15. IF1354.2 +065000 COMPUTE WS-NUM = FUNCTION SIN((PI / 2) - 0.001). IF1354.2 +065100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +065200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +065300 PERFORM PASS IF1354.2 +065400 ELSE IF1354.2 +065500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +065600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +065700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +065800 PERFORM FAIL. IF1354.2 +065900 GO TO F-SIN-WRITE-15. IF1354.2 +066000 F-SIN-DELETE-15. IF1354.2 +066100 PERFORM DE-LETE. IF1354.2 +066200 GO TO F-SIN-WRITE-15. IF1354.2 +066300 F-SIN-WRITE-15. IF1354.2 +066400 MOVE "F-SIN-15" TO PAR-NAME. IF1354.2 +066500 PERFORM PRINT-DETAIL. IF1354.2 +066600*****************TEST (h) - COMPLEX TEST**************** IF1354.2 +066700 F-SIN-16. IF1354.2 +066800 MOVE ZERO TO WS-NUM. IF1354.2 +066900 MOVE 0.866489 TO MIN-RANGE. IF1354.2 +067000 MOVE 0.866559 TO MAX-RANGE. IF1354.2 +067100 F-SIN-TEST-16. IF1354.2 +067200 COMPUTE WS-NUM = FUNCTION SIN((PI / 3) + 0.001). IF1354.2 +067300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +067400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +067500 PERFORM PASS IF1354.2 +067600 ELSE IF1354.2 +067700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +067800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +067900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +068000 PERFORM FAIL. IF1354.2 +068100 GO TO F-SIN-WRITE-16. IF1354.2 +068200 F-SIN-DELETE-16. IF1354.2 +068300 PERFORM DE-LETE. IF1354.2 +068400 GO TO F-SIN-WRITE-16. IF1354.2 +068500 F-SIN-WRITE-16. IF1354.2 +068600 MOVE "F-SIN-16" TO PAR-NAME. IF1354.2 +068700 PERFORM PRINT-DETAIL. IF1354.2 +068800*****************TEST (i) - COMPLEX TEST**************** IF1354.2 +068900 F-SIN-17. IF1354.2 +069000 MOVE ZERO TO WS-NUM. IF1354.2 +069100 MOVE 0.000999 TO MIN-RANGE. IF1354.2 +069200 MOVE 0.001000 TO MAX-RANGE. IF1354.2 +069300 F-SIN-TEST-17. IF1354.2 +069400 COMPUTE WS-NUM = FUNCTION SIN(PI - 0.001). IF1354.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +069700 PERFORM PASS IF1354.2 +069800 ELSE IF1354.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +070200 PERFORM FAIL. IF1354.2 +070300 GO TO F-SIN-WRITE-17. IF1354.2 +070400 F-SIN-DELETE-17. IF1354.2 +070500 PERFORM DE-LETE. IF1354.2 +070600 GO TO F-SIN-WRITE-17. IF1354.2 +070700 F-SIN-WRITE-17. IF1354.2 +070800 MOVE "F-SIN-17" TO PAR-NAME. IF1354.2 +070900 PERFORM PRINT-DETAIL. IF1354.2 +071000*****************TEST (j) - COMPLEX TEST**************** IF1354.2 +071100 F-SIN-18. IF1354.2 +071200 MOVE ZERO TO WS-NUM. IF1354.2 +071300 MOVE -1.00000 TO MIN-RANGE. IF1354.2 +071400 MOVE -0.999960 TO MAX-RANGE. IF1354.2 +071500 F-SIN-TEST-18. IF1354.2 +071600 COMPUTE WS-NUM = FUNCTION SIN(((3 * PI) / 2) + 0.001). IF1354.2 +071700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +071800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +071900 PERFORM PASS IF1354.2 +072000 ELSE IF1354.2 +072100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +072200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +072300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +072400 PERFORM FAIL. IF1354.2 +072500 GO TO F-SIN-WRITE-18. IF1354.2 +072600 F-SIN-DELETE-18. IF1354.2 +072700 PERFORM DE-LETE. IF1354.2 +072800 GO TO F-SIN-WRITE-18. IF1354.2 +072900 F-SIN-WRITE-18. IF1354.2 +073000 MOVE "F-SIN-18" TO PAR-NAME. IF1354.2 +073100 PERFORM PRINT-DETAIL. IF1354.2 +073200*****************TEST (k) - COMPLEX TEST**************** IF1354.2 +073300 F-SIN-19. IF1354.2 +073400 MOVE ZERO TO WS-NUM. IF1354.2 +073500 MOVE 0.034898 TO MIN-RANGE. IF1354.2 +073600 MOVE 0.034900 TO MAX-RANGE. IF1354.2 +073700 F-SIN-TEST-19. IF1354.2 +073800 COMPUTE WS-NUM = FUNCTION SIN( PI * (4 - 2) / 180). IF1354.2 +073900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +074000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +074100 PERFORM PASS IF1354.2 +074200 ELSE IF1354.2 +074300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +074400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +074500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +074600 PERFORM FAIL. IF1354.2 +074700 GO TO F-SIN-WRITE-19. IF1354.2 +074800 F-SIN-DELETE-19. IF1354.2 +074900 PERFORM DE-LETE. IF1354.2 +075000 GO TO F-SIN-WRITE-19. IF1354.2 +075100 F-SIN-WRITE-19. IF1354.2 +075200 MOVE "F-SIN-19" TO PAR-NAME. IF1354.2 +075300 PERFORM PRINT-DETAIL. IF1354.2 +075400*****************TEST (l) - COMPLEX TEST**************** IF1354.2 +075500 F-SIN-20. IF1354.2 +075600 MOVE ZERO TO WS-NUM. IF1354.2 +075700 MOVE 0.999807 TO MIN-RANGE. IF1354.2 +075800 MOVE 0.999887 TO MAX-RANGE. IF1354.2 +075900 F-SIN-TEST-20. IF1354.2 +076000 COMPUTE WS-NUM = FUNCTION SIN( (PI / 2) - (PI / 180)). IF1354.2 +076100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +076200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +076300 PERFORM PASS IF1354.2 +076400 ELSE IF1354.2 +076500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +076600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +076700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +076800 PERFORM FAIL. IF1354.2 +076900 GO TO F-SIN-WRITE-20. IF1354.2 +077000 F-SIN-DELETE-20. IF1354.2 +077100 PERFORM DE-LETE. IF1354.2 +077200 GO TO F-SIN-WRITE-20. IF1354.2 +077300 F-SIN-WRITE-20. IF1354.2 +077400 MOVE "F-SIN-20" TO PAR-NAME. IF1354.2 +077500 PERFORM PRINT-DETAIL. IF1354.2 +077600*****************TEST (m) - COMPLEX TEST**************** IF1354.2 +077700 F-SIN-21. IF1354.2 +077800 MOVE ZERO TO WS-NUM. IF1354.2 +077900 MOVE 0.857132 TO MIN-RANGE. IF1354.2 +078000 MOVE 0.857201 TO MAX-RANGE. IF1354.2 +078100 F-SIN-TEST-21. IF1354.2 +078200 COMPUTE WS-NUM = FUNCTION SIN((PI / 3) - (PI / 180)). IF1354.2 +078300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +078400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +078500 PERFORM PASS IF1354.2 +078600 ELSE IF1354.2 +078700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +078800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +078900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +079000 PERFORM FAIL. IF1354.2 +079100 GO TO F-SIN-WRITE-21. IF1354.2 +079200 F-SIN-DELETE-21. IF1354.2 +079300 PERFORM DE-LETE. IF1354.2 +079400 GO TO F-SIN-WRITE-21. IF1354.2 +079500 F-SIN-WRITE-21. IF1354.2 +079600 MOVE "F-SIN-21" TO PAR-NAME. IF1354.2 +079700 PERFORM PRINT-DETAIL. IF1354.2 +079800*****************TEST (n) - COMPLEX TEST**************** IF1354.2 +079900 F-SIN-22. IF1354.2 +080000 MOVE ZERO TO WS-NUM. IF1354.2 +080100 MOVE -0.017453 TO MIN-RANGE. IF1354.2 +080200 MOVE -0.017451 TO MAX-RANGE. IF1354.2 +080300 F-SIN-TEST-22. IF1354.2 +080400 COMPUTE WS-NUM = FUNCTION SIN(PI + (PI / 180)). IF1354.2 +080500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +080600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +080700 PERFORM PASS IF1354.2 +080800 ELSE IF1354.2 +080900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +081000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +081100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +081200 PERFORM FAIL. IF1354.2 +081300 GO TO F-SIN-WRITE-22. IF1354.2 +081400 F-SIN-DELETE-22. IF1354.2 +081500 PERFORM DE-LETE. IF1354.2 +081600 GO TO F-SIN-WRITE-22. IF1354.2 +081700 F-SIN-WRITE-22. IF1354.2 +081800 MOVE "F-SIN-22" TO PAR-NAME. IF1354.2 +081900 PERFORM PRINT-DETAIL. IF1354.2 +082000*****************TEST (o) - COMPLEX TEST**************** IF1354.2 +082100 F-SIN-23. IF1354.2 +082200 MOVE ZERO TO WS-NUM. IF1354.2 +082300 MOVE -0.999430 TO MIN-RANGE. IF1354.2 +082400 MOVE -0.999350 TO MAX-RANGE. IF1354.2 +082500 F-SIN-TEST-23. IF1354.2 +082600 COMPUTE WS-NUM = FUNCTION SIN((PI * 272) / 180). IF1354.2 +082700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +082800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +082900 PERFORM PASS IF1354.2 +083000 ELSE IF1354.2 +083100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +083200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +083300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +083400 PERFORM FAIL. IF1354.2 +083500 GO TO F-SIN-WRITE-23. IF1354.2 +083600 F-SIN-DELETE-23. IF1354.2 +083700 PERFORM DE-LETE. IF1354.2 +083800 GO TO F-SIN-WRITE-23. IF1354.2 +083900 F-SIN-WRITE-23. IF1354.2 +084000 MOVE "F-SIN-23" TO PAR-NAME. IF1354.2 +084100 PERFORM PRINT-DETAIL. IF1354.2 +084200*****************TEST (p) - COMPLEX TEST**************** IF1354.2 +084300 F-SIN-24. IF1354.2 +084400 MOVE ZERO TO WS-NUM. IF1354.2 +084500 MOVE 0.909261 TO MIN-RANGE. IF1354.2 +084600 MOVE 0.909333 TO MAX-RANGE. IF1354.2 +084700 F-SIN-TEST-24. IF1354.2 +084800 COMPUTE WS-NUM = FUNCTION SIN(4 / 2). IF1354.2 +084900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +085000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +085100 PERFORM PASS IF1354.2 +085200 ELSE IF1354.2 +085300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +085400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +085500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +085600 PERFORM FAIL. IF1354.2 +085700 GO TO F-SIN-WRITE-24. IF1354.2 +085800 F-SIN-DELETE-24. IF1354.2 +085900 PERFORM DE-LETE. IF1354.2 +086000 GO TO F-SIN-WRITE-24. IF1354.2 +086100 F-SIN-WRITE-24. IF1354.2 +086200 MOVE "F-SIN-24" TO PAR-NAME. IF1354.2 +086300 PERFORM PRINT-DETAIL. IF1354.2 +086400*****************TEST (q) - COMPLEX TEST**************** IF1354.2 +086500 F-SIN-25. IF1354.2 +086600 MOVE ZERO TO WS-NUM. IF1354.2 +086700 MOVE 0.997454 TO MIN-RANGE. IF1354.2 +086800 MOVE 0.997534 TO MAX-RANGE. IF1354.2 +086900 F-SIN-TEST-25. IF1354.2 +087000 COMPUTE WS-NUM = FUNCTION SIN(3 / 2). IF1354.2 +087100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +087200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +087300 PERFORM PASS IF1354.2 +087400 ELSE IF1354.2 +087500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +087600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +087700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +087800 PERFORM FAIL. IF1354.2 +087900 GO TO F-SIN-WRITE-25. IF1354.2 +088000 F-SIN-DELETE-25. IF1354.2 +088100 PERFORM DE-LETE. IF1354.2 +088200 GO TO F-SIN-WRITE-25. IF1354.2 +088300 F-SIN-WRITE-25. IF1354.2 +088400 MOVE "F-SIN-25" TO PAR-NAME. IF1354.2 +088500 PERFORM PRINT-DETAIL. IF1354.2 +088600*****************TEST (r) - COMPLEX TEST**************** IF1354.2 +088700 F-SIN-26. IF1354.2 +088800 MOVE ZERO TO WS-NUM. IF1354.2 +088900 MOVE -0.000040 TO MIN-RANGE. IF1354.2 +089000 MOVE -0.000039 TO MAX-RANGE. IF1354.2 +089100 F-SIN-TEST-26. IF1354.2 +089200 COMPUTE WS-NUM = FUNCTION SIN(PI - A). IF1354.2 +089300 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +089400 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +089500 PERFORM PASS IF1354.2 +089600 ELSE IF1354.2 +089700 MOVE WS-NUM TO COMPUTED-N IF1354.2 +089800 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +089900 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +090000 PERFORM FAIL. IF1354.2 +090100 GO TO F-SIN-WRITE-26. IF1354.2 +090200 F-SIN-DELETE-26. IF1354.2 +090300 PERFORM DE-LETE. IF1354.2 +090400 GO TO F-SIN-WRITE-26. IF1354.2 +090500 F-SIN-WRITE-26. IF1354.2 +090600 MOVE "F-SIN-26" TO PAR-NAME. IF1354.2 +090700 PERFORM PRINT-DETAIL. IF1354.2 +090800*****************TEST (s) - COMPLEX TEST**************** IF1354.2 +090900 F-SIN-27. IF1354.2 +091000 MOVE ZERO TO WS-NUM. IF1354.2 +091100 MOVE -0.544043 TO MIN-RANGE. IF1354.2 +091200 MOVE -0.543999 TO MAX-RANGE. IF1354.2 +091300 F-SIN-TEST-27. IF1354.2 +091400 COMPUTE WS-NUM = FUNCTION SIN(D / 100). IF1354.2 +091500 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +091600 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +091700 PERFORM PASS IF1354.2 +091800 ELSE IF1354.2 +091900 MOVE WS-NUM TO COMPUTED-N IF1354.2 +092000 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +092100 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +092200 PERFORM FAIL. IF1354.2 +092300 GO TO F-SIN-WRITE-27. IF1354.2 +092400 F-SIN-DELETE-27. IF1354.2 +092500 PERFORM DE-LETE. IF1354.2 +092600 GO TO F-SIN-WRITE-27. IF1354.2 +092700 F-SIN-WRITE-27. IF1354.2 +092800 MOVE "F-SIN-27" TO PAR-NAME. IF1354.2 +092900 PERFORM PRINT-DETAIL. IF1354.2 +093000*****************TEST (t) - COMPLEX TEST**************** IF1354.2 +093100 F-SIN-28. IF1354.2 +093200 MOVE ZERO TO WS-NUM. IF1354.2 +093300 MOVE 0.017451 TO MIN-RANGE. IF1354.2 +093400 MOVE 0.017453 TO MAX-RANGE. IF1354.2 +093500 F-SIN-TEST-28. IF1354.2 +093600 COMPUTE WS-NUM = FUNCTION SIN(PI / 180). IF1354.2 +093700 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +093800 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +093900 PERFORM PASS IF1354.2 +094000 ELSE IF1354.2 +094100 MOVE WS-NUM TO COMPUTED-N IF1354.2 +094200 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +094300 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +094400 PERFORM FAIL. IF1354.2 +094500 GO TO F-SIN-WRITE-28. IF1354.2 +094600 F-SIN-DELETE-28. IF1354.2 +094700 PERFORM DE-LETE. IF1354.2 +094800 GO TO F-SIN-WRITE-28. IF1354.2 +094900 F-SIN-WRITE-28. IF1354.2 +095000 MOVE "F-SIN-28" TO PAR-NAME. IF1354.2 +095100 PERFORM PRINT-DETAIL. IF1354.2 +095200*****************TEST (u) - COMPLEX TEST**************** IF1354.2 +095300 F-SIN-29. IF1354.2 +095400 MOVE ZERO TO WS-NUM. IF1354.2 +095500 MOVE 0.999960 TO MIN-RANGE. IF1354.2 +095600 MOVE 1.00000 TO MAX-RANGE. IF1354.2 +095700 F-SIN-TEST-29. IF1354.2 +095800 COMPUTE WS-NUM = FUNCTION SIN(PI) + 1. IF1354.2 +095900 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +096000 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +096100 PERFORM PASS IF1354.2 +096200 ELSE IF1354.2 +096300 MOVE WS-NUM TO COMPUTED-N IF1354.2 +096400 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +096500 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +096600 PERFORM FAIL. IF1354.2 +096700 GO TO F-SIN-WRITE-29. IF1354.2 +096800 F-SIN-DELETE-29. IF1354.2 +096900 PERFORM DE-LETE. IF1354.2 +097000 GO TO F-SIN-WRITE-29. IF1354.2 +097100 F-SIN-WRITE-29. IF1354.2 +097200 MOVE "F-SIN-29" TO PAR-NAME. IF1354.2 +097300 PERFORM PRINT-DETAIL. IF1354.2 +097400*****************TEST (v) - COMPLEX TEST**************** IF1354.2 +097500 F-SIN-30. IF1354.2 +097600 MOVE ZERO TO WS-NUM. IF1354.2 +097700 MOVE 0.789040 TO MIN-RANGE. IF1354.2 +097800 MOVE 0.789104 TO MAX-RANGE. IF1354.2 +097900 F-SIN-TEST-30. IF1354.2 +098000 COMPUTE WS-NUM = FUNCTION SIN(FUNCTION SIN(2)). IF1354.2 +098100 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +098200 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +098300 PERFORM PASS IF1354.2 +098400 ELSE IF1354.2 +098500 MOVE WS-NUM TO COMPUTED-N IF1354.2 +098600 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +098700 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +098800 PERFORM FAIL. IF1354.2 +098900 GO TO F-SIN-WRITE-30. IF1354.2 +099000 F-SIN-DELETE-30. IF1354.2 +099100 PERFORM DE-LETE. IF1354.2 +099200 GO TO F-SIN-WRITE-30. IF1354.2 +099300 F-SIN-WRITE-30. IF1354.2 +099400 MOVE "F-SIN-30" TO PAR-NAME. IF1354.2 +099500 PERFORM PRINT-DETAIL. IF1354.2 +099600*****************TEST (w) - COMPLEX TEST**************** IF1354.2 +099700 F-SIN-31. IF1354.2 +099800 MOVE ZERO TO WS-NUM. IF1354.2 +099900 MOVE -0.000040 TO MIN-RANGE. IF1354.2 +100000 MOVE 0.000040 TO MAX-RANGE. IF1354.2 +100100 F-SIN-TEST-31. IF1354.2 +100200 COMPUTE WS-NUM = FUNCTION SIN(PI / 3) + IF1354.2 +100300 FUNCTION SIN(MINUSPI / 3). IF1354.2 +100400 IF (WS-NUM >= MIN-RANGE) AND IF1354.2 +100500 (WS-NUM <= MAX-RANGE) THEN IF1354.2 +100600 PERFORM PASS IF1354.2 +100700 ELSE IF1354.2 +100800 MOVE WS-NUM TO COMPUTED-N IF1354.2 +100900 MOVE MIN-RANGE TO CORRECT-MIN IF1354.2 +101000 MOVE MAX-RANGE TO CORRECT-MAX IF1354.2 +101100 PERFORM FAIL. IF1354.2 +101200 GO TO F-SIN-WRITE-31. IF1354.2 +101300 F-SIN-DELETE-31. IF1354.2 +101400 PERFORM DE-LETE. IF1354.2 +101500 GO TO F-SIN-WRITE-31. IF1354.2 +101600 F-SIN-WRITE-31. IF1354.2 +101700 MOVE "F-SIN-31" TO PAR-NAME. IF1354.2 +101800 PERFORM PRINT-DETAIL. IF1354.2 +101900*****************SPECIAL PERFORM TEST********************** IF1354.2 +102000 F-SIN-32. IF1354.2 +102100 PERFORM F-SIN-TEST-32 IF1354.2 +102200 UNTIL FUNCTION SIN(ARG1) < 0. IF1354.2 +102300 PERFORM PASS. IF1354.2 +102400 GO TO F-SIN-WRITE-32. IF1354.2 +102500 F-SIN-TEST-32. IF1354.2 +102600 COMPUTE ARG1 = ARG1 - 1. IF1354.2 +102700 F-SIN-DELETE-32. IF1354.2 +102800 PERFORM DE-LETE. IF1354.2 +102900 GO TO F-SIN-WRITE-32. IF1354.2 +103000 F-SIN-WRITE-32. IF1354.2 +103100 MOVE "F-SIN-32" TO PAR-NAME. IF1354.2 +103200 PERFORM PRINT-DETAIL. IF1354.2 +103300********************END OF TESTS*************** IF1354.2 +103400 CCVS-EXIT SECTION. IF1354.2 +103500 CCVS-999999. IF1354.2 +103600 GO TO CLOSE-FILES. IF1354.2 diff --git a/tests/cobol85/IF/IF136A.CBL b/tests/cobol85/IF/IF136A.CBL new file mode 100755 index 00000000..f28924f4 --- /dev/null +++ b/tests/cobol85/IF/IF136A.CBL @@ -0,0 +1,904 @@ +000100 IDENTIFICATION DIVISION. IF1364.2 +000200 PROGRAM-ID. IF1364.2 +000300 IF136A. IF1364.2 +000400 IF1364.2 +000500*********************************************************** IF1364.2 +000600* * IF1364.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1364.2 +000800* It contains tests for the Intrinsic Function SQRT. * IF1364.2 +000900* * IF1364.2 +001000*********************************************************** IF1364.2 +001100 ENVIRONMENT DIVISION. IF1364.2 +001200 CONFIGURATION SECTION. IF1364.2 +001300 SOURCE-COMPUTER. IF1364.2 +001400 Linux. IF1364.2 +001500 OBJECT-COMPUTER. IF1364.2 +001600 Linux. IF1364.2 +001700 INPUT-OUTPUT SECTION. IF1364.2 +001800 FILE-CONTROL. IF1364.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1364.2 +002000 "report.log". IF1364.2 +002100 DATA DIVISION. IF1364.2 +002200 FILE SECTION. IF1364.2 +002300 FD PRINT-FILE. IF1364.2 +002400 01 PRINT-REC PICTURE X(120). IF1364.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1364.2 +002600 WORKING-STORAGE SECTION. IF1364.2 +002700*********************************************************** IF1364.2 +002800* Variables specific to the Intrinsic Function Test IF136A* IF1364.2 +002900*********************************************************** IF1364.2 +003000 01 A PIC S9(5)V9(5) VALUE 0.00004. IF1364.2 +003100 01 B PIC S9(5)V9(5) VALUE 14000.105. IF1364.2 +003200 01 C PIC S9(10) VALUE 100000. IF1364.2 +003300 01 D PIC S9(10) VALUE 1000. IF1364.2 +003400 01 E PIC S9(10) VALUE 7. IF1364.2 +003500 01 F PIC S9(10) VALUE 6. IF1364.2 +003600 01 P PIC S9(10) VALUE 1. IF1364.2 +003700 01 ARG1 PIC S9(10) VALUE 10. IF1364.2 +003800 01 ARR VALUE "40537". IF1364.2 +003900 02 IND OCCURS 5 TIMES PIC 9. IF1364.2 +004000 01 TEMP PIC S9(5)V9(5). IF1364.2 +004100 01 WS-NUM PIC S9(5)V9(7). IF1364.2 +004200 01 MIN-RANGE PIC S9(5)V9(7). IF1364.2 +004300 01 MAX-RANGE PIC S9(5)V9(7). IF1364.2 +004400* IF1364.2 +004500********************************************************** IF1364.2 +004600* IF1364.2 +004700 01 TEST-RESULTS. IF1364.2 +004800 02 FILLER PIC X VALUE SPACE. IF1364.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1364.2 +005000 02 FILLER PIC X VALUE SPACE. IF1364.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1364.2 +005200 02 FILLER PIC X VALUE SPACE. IF1364.2 +005300 02 PAR-NAME. IF1364.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1364.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1364.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1364.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1364.2 +005800 02 RE-MARK PIC X(61). IF1364.2 +005900 01 TEST-COMPUTED. IF1364.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1364.2 +006100 02 FILLER PIC X(17) VALUE IF1364.2 +006200 " COMPUTED=". IF1364.2 +006300 02 COMPUTED-X. IF1364.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1364.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1364.2 +006600 PIC -9(9).9(9). IF1364.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1364.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1364.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1364.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1364.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1364.2 +007200 04 FILLER PIC X. IF1364.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1364.2 +007400 01 TEST-CORRECT. IF1364.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1364.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1364.2 +007700 02 CORRECT-X. IF1364.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1364.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1364.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1364.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1364.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1364.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1364.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1364.2 +008500 04 FILLER PIC X. IF1364.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1364.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1364.2 +008800 01 TEST-CORRECT-MIN. IF1364.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1364.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1364.2 +009100 02 CORRECTMI-X. IF1364.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1364.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1364.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1364.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1364.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1364.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1364.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1364.2 +009900 04 FILLER PIC X. IF1364.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1364.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1364.2 +010200 01 TEST-CORRECT-MAX. IF1364.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1364.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1364.2 +010500 02 CORRECTMA-X. IF1364.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1364.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1364.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1364.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1364.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1364.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1364.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1364.2 +011300 04 FILLER PIC X. IF1364.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1364.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1364.2 +011600 01 CCVS-C-1. IF1364.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1364.2 +011800- "SS PARAGRAPH-NAME IF1364.2 +011900- " REMARKS". IF1364.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1364.2 +012100 01 CCVS-C-2. IF1364.2 +012200 02 FILLER PIC X VALUE SPACE. IF1364.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1364.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1364.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1364.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1364.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1364.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1364.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1364.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1364.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1364.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1364.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1364.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1364.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1364.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1364.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1364.2 +013800 01 CCVS-H-1. IF1364.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1364.2 +014000 02 FILLER PIC X(42) VALUE IF1364.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1364.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1364.2 +014300 01 CCVS-H-2A. IF1364.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1364.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1364.2 +014600 02 FILLER PIC XXXX VALUE IF1364.2 +014700 "4.2 ". IF1364.2 +014800 02 FILLER PIC X(28) VALUE IF1364.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1364.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1364.2 +015100 IF1364.2 +015200 01 CCVS-H-2B. IF1364.2 +015300 02 FILLER PIC X(15) VALUE IF1364.2 +015400 "TEST RESULT OF ". IF1364.2 +015500 02 TEST-ID PIC X(9). IF1364.2 +015600 02 FILLER PIC X(4) VALUE IF1364.2 +015700 " IN ". IF1364.2 +015800 02 FILLER PIC X(12) VALUE IF1364.2 +015900 " HIGH ". IF1364.2 +016000 02 FILLER PIC X(22) VALUE IF1364.2 +016100 " LEVEL VALIDATION FOR ". IF1364.2 +016200 02 FILLER PIC X(58) VALUE IF1364.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1364.2 +016400 01 CCVS-H-3. IF1364.2 +016500 02 FILLER PIC X(34) VALUE IF1364.2 +016600 " FOR OFFICIAL USE ONLY ". IF1364.2 +016700 02 FILLER PIC X(58) VALUE IF1364.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1364.2 +016900 02 FILLER PIC X(28) VALUE IF1364.2 +017000 " COPYRIGHT 1985 ". IF1364.2 +017100 01 CCVS-E-1. IF1364.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1364.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1364.2 +017400 02 ID-AGAIN PIC X(9). IF1364.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1364.2 +017600 01 CCVS-E-2. IF1364.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1364.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1364.2 +017900 02 CCVS-E-2-2. IF1364.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1364.2 +018100 03 FILLER PIC X VALUE SPACE. IF1364.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1364.2 +018300 "ERRORS ENCOUNTERED". IF1364.2 +018400 01 CCVS-E-3. IF1364.2 +018500 02 FILLER PIC X(22) VALUE IF1364.2 +018600 " FOR OFFICIAL USE ONLY". IF1364.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1364.2 +018800 02 FILLER PIC X(58) VALUE IF1364.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1364.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1364.2 +019100 02 FILLER PIC X(15) VALUE IF1364.2 +019200 " COPYRIGHT 1985". IF1364.2 +019300 01 CCVS-E-4. IF1364.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1364.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1364.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1364.2 +019700 02 FILLER PIC X(40) VALUE IF1364.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1364.2 +019900 01 XXINFO. IF1364.2 +020000 02 FILLER PIC X(19) VALUE IF1364.2 +020100 "*** INFORMATION ***". IF1364.2 +020200 02 INFO-TEXT. IF1364.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1364.2 +020400 04 XXCOMPUTED PIC X(20). IF1364.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1364.2 +020600 04 XXCORRECT PIC X(20). IF1364.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1364.2 +020800 01 HYPHEN-LINE. IF1364.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1364.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1364.2 +021100- "*****************************************". IF1364.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1364.2 +021300- "******************************". IF1364.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1364.2 +021500 "IF136A". IF1364.2 +021600 PROCEDURE DIVISION. IF1364.2 +021700 CCVS1 SECTION. IF1364.2 +021800 OPEN-FILES. IF1364.2 +021900 OPEN OUTPUT PRINT-FILE. IF1364.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1364.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1364.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1364.2 +022300 GO TO CCVS1-EXIT. IF1364.2 +022400 CLOSE-FILES. IF1364.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1364.2 +022600 TERMINATE-CCVS. IF1364.2 +022700 STOP RUN. IF1364.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1364.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1364.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1364.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1364.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1364.2 +023300 PRINT-DETAIL. IF1364.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1364.2 +023500 MOVE "." TO PARDOT-X IF1364.2 +023600 MOVE REC-CT TO DOTVALUE. IF1364.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1364.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1364.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1364.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1364.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1364.2 +024200 MOVE SPACE TO CORRECT-X. IF1364.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1364.2 +024400 MOVE SPACE TO RE-MARK. IF1364.2 +024500 HEAD-ROUTINE. IF1364.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1364.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1364.2 +025000 COLUMN-NAMES-ROUTINE. IF1364.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +025400 END-ROUTINE. IF1364.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1364.2 +025600 END-RTN-EXIT. IF1364.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +025800 END-ROUTINE-1. IF1364.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1364.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1364.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1364.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1364.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1364.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1364.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1364.2 +026600 END-ROUTINE-12. IF1364.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1364.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1364.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1364.2 +027000 ELSE IF1364.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1364.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1364.2 +027300 PERFORM WRITE-LINE. IF1364.2 +027400 END-ROUTINE-13. IF1364.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1364.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1364.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1364.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1364.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1364.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1364.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1364.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1364.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1364.2 +028600 WRITE-LINE. IF1364.2 +028700 ADD 1 TO RECORD-COUNT. IF1364.2 +028800 IF RECORD-COUNT GREATER 42 IF1364.2 +028900 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1364.2 +029000 MOVE SPACE TO DUMMY-RECORD IF1364.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1364.2 +029200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1364.2 +029300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1364.2 +029400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1364.2 +029500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1364.2 +029600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1364.2 +029700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1364.2 +029800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1364.2 +029900 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1364.2 +030000 MOVE ZERO TO RECORD-COUNT. IF1364.2 +030100 PERFORM WRT-LN. IF1364.2 +030200 WRT-LN. IF1364.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1364.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1364.2 +030500 BLANK-LINE-PRINT. IF1364.2 +030600 PERFORM WRT-LN. IF1364.2 +030700 FAIL-ROUTINE. IF1364.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1364.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1364.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1364.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1364.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1364.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1364.2 +031500 GO TO FAIL-ROUTINE-EX. IF1364.2 +031600 FAIL-ROUTINE-WRITE. IF1364.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1364.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1364.2 +031900 CORMA-ANSI-REFERENCE. IF1364.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1364.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1364.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1364.2 +032300 ELSE IF1364.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1364.2 +032500 PERFORM WRITE-LINE. IF1364.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1364.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1364.2 +032800 BAIL-OUT. IF1364.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1364.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1364.2 +033100 BAIL-OUT-WRITE. IF1364.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1364.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1364.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1364.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1364.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1364.2 +033700 BAIL-OUT-EX. EXIT. IF1364.2 +033800 CCVS1-EXIT. IF1364.2 +033900 EXIT. IF1364.2 +034000******************************************************** IF1364.2 +034100* * IF1364.2 +034200* Intrinsic Function Tests IF136A - SQRT * IF1364.2 +034300* * IF1364.2 +034400******************************************************** IF1364.2 +034500 SECT-IF136A SECTION. IF1364.2 +034600 F-SQRT-INFO. IF1364.2 +034700 MOVE "See ref. A-69 2.40" TO ANSI-REFERENCE. IF1364.2 +034800 MOVE "SQRT Function" TO FEATURE. IF1364.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1364.2 +035000 F-SQRT-01. IF1364.2 +035100 MOVE ZERO TO WS-NUM. IF1364.2 +035200 MOVE 0.000000 TO MIN-RANGE. IF1364.2 +035300 MOVE 0.000020 TO MAX-RANGE. IF1364.2 +035400 F-SQRT-TEST-01. IF1364.2 +035500 COMPUTE WS-NUM = FUNCTION SQRT(0). IF1364.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +035800 PERFORM PASS IF1364.2 +035900 ELSE IF1364.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1364.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +036300 PERFORM FAIL. IF1364.2 +036400 GO TO F-SQRT-WRITE-01. IF1364.2 +036500 F-SQRT-DELETE-01. IF1364.2 +036600 PERFORM DE-LETE. IF1364.2 +036700 GO TO F-SQRT-WRITE-01. IF1364.2 +036800 F-SQRT-WRITE-01. IF1364.2 +036900 MOVE "F-SQRT-01" TO PAR-NAME. IF1364.2 +037000 PERFORM PRINT-DETAIL. IF1364.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1364.2 +037200 F-SQRT-02. IF1364.2 +037300 EVALUATE FUNCTION SQRT(1) IF1364.2 +037400 WHEN 0.999980 THRU 1.00002 IF1364.2 +037500 PERFORM PASS IF1364.2 +037600 WHEN OTHER IF1364.2 +037700 PERFORM FAIL. IF1364.2 +037800 GO TO F-SQRT-WRITE-02. IF1364.2 +037900 F-SQRT-DELETE-02. IF1364.2 +038000 PERFORM DE-LETE. IF1364.2 +038100 GO TO F-SQRT-WRITE-02. IF1364.2 +038200 F-SQRT-WRITE-02. IF1364.2 +038300 MOVE "F-SQRT-02" TO PAR-NAME. IF1364.2 +038400 PERFORM PRINT-DETAIL. IF1364.2 +038500*****************TEST (c) - SIMPLE TEST***************** IF1364.2 +038600 F-SQRT-03. IF1364.2 +038700 MOVE 1.99996 TO MIN-RANGE. IF1364.2 +038800 MOVE 2.00004 TO MAX-RANGE. IF1364.2 +038900 F-SQRT-TEST-03. IF1364.2 +039000 IF (FUNCTION SQRT(4) >= MIN-RANGE) AND IF1364.2 +039100 (FUNCTION SQRT(4) <= MAX-RANGE) THEN IF1364.2 +039200 PERFORM PASS IF1364.2 +039300 ELSE IF1364.2 +039400 PERFORM FAIL. IF1364.2 +039500 GO TO F-SQRT-WRITE-03. IF1364.2 +039600 F-SQRT-DELETE-03. IF1364.2 +039700 PERFORM DE-LETE. IF1364.2 +039800 GO TO F-SQRT-WRITE-03. IF1364.2 +039900 F-SQRT-WRITE-03. IF1364.2 +040000 MOVE "F-SQRT-03" TO PAR-NAME. IF1364.2 +040100 PERFORM PRINT-DETAIL. IF1364.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1364.2 +040300 F-SQRT-04. IF1364.2 +040400 MOVE ZERO TO WS-NUM. IF1364.2 +040500 MOVE 0.031621 TO MIN-RANGE. IF1364.2 +040600 MOVE 0.031623 TO MAX-RANGE. IF1364.2 +040700 F-SQRT-TEST-04. IF1364.2 +040800 COMPUTE WS-NUM = FUNCTION SQRT(.001). IF1364.2 +040900 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +041000 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +041100 PERFORM PASS IF1364.2 +041200 ELSE IF1364.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1364.2 +041400 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +041500 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +041600 PERFORM FAIL. IF1364.2 +041700 GO TO F-SQRT-WRITE-04. IF1364.2 +041800 F-SQRT-DELETE-04. IF1364.2 +041900 PERFORM DE-LETE. IF1364.2 +042000 GO TO F-SQRT-WRITE-04. IF1364.2 +042100 F-SQRT-WRITE-04. IF1364.2 +042200 MOVE "F-SQRT-04" TO PAR-NAME. IF1364.2 +042300 PERFORM PRINT-DETAIL. IF1364.2 +042400*****************TEST (e) - SIMPLE TEST***************** IF1364.2 +042500 F-SQRT-05. IF1364.2 +042600 MOVE ZERO TO WS-NUM. IF1364.2 +042700 MOVE 0.999479 TO MIN-RANGE. IF1364.2 +042800 MOVE 0.999519 TO MAX-RANGE. IF1364.2 +042900 F-SQRT-TEST-05. IF1364.2 +043000 COMPUTE WS-NUM = FUNCTION SQRT(.999). IF1364.2 +043100 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +043200 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +043300 PERFORM PASS IF1364.2 +043400 ELSE IF1364.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1364.2 +043600 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +043700 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +043800 PERFORM FAIL. IF1364.2 +043900 GO TO F-SQRT-WRITE-05. IF1364.2 +044000 F-SQRT-DELETE-05. IF1364.2 +044100 PERFORM DE-LETE. IF1364.2 +044200 GO TO F-SQRT-WRITE-05. IF1364.2 +044300 F-SQRT-WRITE-05. IF1364.2 +044400 MOVE "F-SQRT-05" TO PAR-NAME. IF1364.2 +044500 PERFORM PRINT-DETAIL. IF1364.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1364.2 +044700 F-SQRT-06. IF1364.2 +044800 MOVE ZERO TO WS-NUM. IF1364.2 +044900 MOVE 2.00246 TO MIN-RANGE. IF1364.2 +045000 MOVE 2.00254 TO MAX-RANGE. IF1364.2 +045100 F-SQRT-TEST-06. IF1364.2 +045200 COMPUTE WS-NUM = FUNCTION SQRT(4.01). IF1364.2 +045300 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +045400 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +045500 PERFORM PASS IF1364.2 +045600 ELSE IF1364.2 +045700 MOVE WS-NUM TO COMPUTED-N IF1364.2 +045800 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +045900 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +046000 PERFORM FAIL. IF1364.2 +046100 GO TO F-SQRT-WRITE-06. IF1364.2 +046200 F-SQRT-DELETE-06. IF1364.2 +046300 PERFORM DE-LETE. IF1364.2 +046400 GO TO F-SQRT-WRITE-06. IF1364.2 +046500 F-SQRT-WRITE-06. IF1364.2 +046600 MOVE "F-SQRT-06" TO PAR-NAME. IF1364.2 +046700 PERFORM PRINT-DETAIL. IF1364.2 +046800*****************TEST (g) - SIMPLE TEST***************** IF1364.2 +046900 F-SQRT-07. IF1364.2 +047000 MOVE ZERO TO WS-NUM. IF1364.2 +047100 MOVE 177.224 TO MIN-RANGE. IF1364.2 +047200 MOVE 177.231 TO MAX-RANGE. IF1364.2 +047300 F-SQRT-TEST-07. IF1364.2 +047400 COMPUTE WS-NUM = FUNCTION SQRT(31409.84). IF1364.2 +047500 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +047600 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +047700 PERFORM PASS IF1364.2 +047800 ELSE IF1364.2 +047900 MOVE WS-NUM TO COMPUTED-N IF1364.2 +048000 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +048100 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +048200 PERFORM FAIL. IF1364.2 +048300 GO TO F-SQRT-WRITE-07. IF1364.2 +048400 F-SQRT-DELETE-07. IF1364.2 +048500 PERFORM DE-LETE. IF1364.2 +048600 GO TO F-SQRT-WRITE-07. IF1364.2 +048700 F-SQRT-WRITE-07. IF1364.2 +048800 MOVE "F-SQRT-07" TO PAR-NAME. IF1364.2 +048900 PERFORM PRINT-DETAIL. IF1364.2 +049000*****************TEST (h) - SIMPLE TEST***************** IF1364.2 +049100 F-SQRT-08. IF1364.2 +049200 MOVE ZERO TO WS-NUM. IF1364.2 +049300 MOVE 927.342 TO MIN-RANGE. IF1364.2 +049400 MOVE 927.379 TO MAX-RANGE. IF1364.2 +049500 F-SQRT-TEST-08. IF1364.2 +049600 COMPUTE WS-NUM = FUNCTION SQRT(860000). IF1364.2 +049700 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +049800 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +049900 PERFORM PASS IF1364.2 +050000 ELSE IF1364.2 +050100 MOVE WS-NUM TO COMPUTED-N IF1364.2 +050200 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +050300 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +050400 PERFORM FAIL. IF1364.2 +050500 GO TO F-SQRT-WRITE-08. IF1364.2 +050600 F-SQRT-DELETE-08. IF1364.2 +050700 PERFORM DE-LETE. IF1364.2 +050800 GO TO F-SQRT-WRITE-08. IF1364.2 +050900 F-SQRT-WRITE-08. IF1364.2 +051000 MOVE "F-SQRT-08" TO PAR-NAME. IF1364.2 +051100 PERFORM PRINT-DETAIL. IF1364.2 +051200*****************TEST (i) - SIMPLE TEST***************** IF1364.2 +051300 F-SQRT-09. IF1364.2 +051400 MOVE ZERO TO WS-NUM. IF1364.2 +051500 MOVE 0.0094866 TO MIN-RANGE. IF1364.2 +051600 MOVE 0.0094870 TO MAX-RANGE. IF1364.2 +051700 F-SQRT-TEST-09. IF1364.2 +051800 COMPUTE WS-NUM = FUNCTION SQRT(.00009). IF1364.2 +051900 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +052000 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +052100 PERFORM PASS IF1364.2 +052200 ELSE IF1364.2 +052300 MOVE WS-NUM TO COMPUTED-N IF1364.2 +052400 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +052500 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +052600 PERFORM FAIL. IF1364.2 +052700 GO TO F-SQRT-WRITE-09. IF1364.2 +052800 F-SQRT-DELETE-09. IF1364.2 +052900 PERFORM DE-LETE. IF1364.2 +053000 GO TO F-SQRT-WRITE-09. IF1364.2 +053100 F-SQRT-WRITE-09. IF1364.2 +053200 MOVE "F-SQRT-09" TO PAR-NAME. IF1364.2 +053300 PERFORM PRINT-DETAIL. IF1364.2 +053400*****************TEST (j) - SIMPLE TEST***************** IF1364.2 +053500 F-SQRT-10. IF1364.2 +053600 MOVE ZERO TO WS-NUM. IF1364.2 +053700 MOVE 118.320 TO MIN-RANGE. IF1364.2 +053800 MOVE 118.324 TO MAX-RANGE. IF1364.2 +053900 F-SQRT-TEST-10. IF1364.2 +054000 COMPUTE WS-NUM = FUNCTION SQRT(B). IF1364.2 +054100 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +054200 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +054300 PERFORM PASS IF1364.2 +054400 ELSE IF1364.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1364.2 +054600 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +054700 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +054800 PERFORM FAIL. IF1364.2 +054900 GO TO F-SQRT-WRITE-10. IF1364.2 +055000 F-SQRT-DELETE-10. IF1364.2 +055100 PERFORM DE-LETE. IF1364.2 +055200 GO TO F-SQRT-WRITE-10. IF1364.2 +055300 F-SQRT-WRITE-10. IF1364.2 +055400 MOVE "F-SQRT-10" TO PAR-NAME. IF1364.2 +055500 PERFORM PRINT-DETAIL. IF1364.2 +055600*****************TEST (k) - SIMPLE TEST***************** IF1364.2 +055700 F-SQRT-11. IF1364.2 +055800 MOVE ZERO TO WS-NUM. IF1364.2 +055900 MOVE 316.222 TO MIN-RANGE. IF1364.2 +056000 MOVE 316.234 TO MAX-RANGE. IF1364.2 +056100 F-SQRT-TEST-11. IF1364.2 +056200 COMPUTE WS-NUM = FUNCTION SQRT(C). IF1364.2 +056300 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +056400 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +056500 PERFORM PASS IF1364.2 +056600 ELSE IF1364.2 +056700 MOVE WS-NUM TO COMPUTED-N IF1364.2 +056800 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +056900 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +057000 PERFORM FAIL. IF1364.2 +057100 GO TO F-SQRT-WRITE-11. IF1364.2 +057200 F-SQRT-DELETE-11. IF1364.2 +057300 PERFORM DE-LETE. IF1364.2 +057400 GO TO F-SQRT-WRITE-11. IF1364.2 +057500 F-SQRT-WRITE-11. IF1364.2 +057600 MOVE "F-SQRT-11" TO PAR-NAME. IF1364.2 +057700 PERFORM PRINT-DETAIL. IF1364.2 +057800*****************TEST (l) - SIMPLE TEST***************** IF1364.2 +057900 F-SQRT-12. IF1364.2 +058000 MOVE ZERO TO WS-NUM. IF1364.2 +058100 MOVE 0.0063244 TO MIN-RANGE. IF1364.2 +058200 MOVE 0.0063246 TO MAX-RANGE. IF1364.2 +058300 F-SQRT-TEST-12. IF1364.2 +058400 COMPUTE WS-NUM = FUNCTION SQRT(A). IF1364.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +058700 PERFORM PASS IF1364.2 +058800 ELSE IF1364.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1364.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +059200 PERFORM FAIL. IF1364.2 +059300 GO TO F-SQRT-WRITE-12. IF1364.2 +059400 F-SQRT-DELETE-12. IF1364.2 +059500 PERFORM DE-LETE. IF1364.2 +059600 GO TO F-SQRT-WRITE-12. IF1364.2 +059700 F-SQRT-WRITE-12. IF1364.2 +059800 MOVE "F-SQRT-12" TO PAR-NAME. IF1364.2 +059900 PERFORM PRINT-DETAIL. IF1364.2 +060000*****************TEST (m) - SIMPLE TEST***************** IF1364.2 +060100 F-SQRT-13. IF1364.2 +060200 MOVE ZERO TO WS-NUM. IF1364.2 +060300 MOVE 1.99996 TO MIN-RANGE. IF1364.2 +060400 MOVE 2.00004 TO MAX-RANGE. IF1364.2 +060500 F-SQRT-TEST-13. IF1364.2 +060600 COMPUTE WS-NUM = FUNCTION SQRT(IND(P)). IF1364.2 +060700 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +060800 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +060900 PERFORM PASS IF1364.2 +061000 ELSE IF1364.2 +061100 MOVE WS-NUM TO COMPUTED-N IF1364.2 +061200 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +061300 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +061400 PERFORM FAIL. IF1364.2 +061500 GO TO F-SQRT-WRITE-13. IF1364.2 +061600 F-SQRT-DELETE-13. IF1364.2 +061700 PERFORM DE-LETE. IF1364.2 +061800 GO TO F-SQRT-WRITE-13. IF1364.2 +061900 F-SQRT-WRITE-13. IF1364.2 +062000 MOVE "F-SQRT-13" TO PAR-NAME. IF1364.2 +062100 PERFORM PRINT-DETAIL. IF1364.2 +062200*****************TEST (n) - SIMPLE TEST***************** IF1364.2 +062300 F-SQRT-14. IF1364.2 +062400 MOVE ZERO TO WS-NUM. IF1364.2 +062500 MOVE 2.23601 TO MIN-RANGE. IF1364.2 +062600 MOVE 2.23610 TO MAX-RANGE. IF1364.2 +062700 F-SQRT-TEST-14. IF1364.2 +062800 COMPUTE WS-NUM = FUNCTION SQRT(IND(3)). IF1364.2 +062900 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +063000 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +063100 PERFORM PASS IF1364.2 +063200 ELSE IF1364.2 +063300 MOVE WS-NUM TO COMPUTED-N IF1364.2 +063400 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +063500 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +063600 PERFORM FAIL. IF1364.2 +063700 GO TO F-SQRT-WRITE-14. IF1364.2 +063800 F-SQRT-DELETE-14. IF1364.2 +063900 PERFORM DE-LETE. IF1364.2 +064000 GO TO F-SQRT-WRITE-14. IF1364.2 +064100 F-SQRT-WRITE-14. IF1364.2 +064200 MOVE "F-SQRT-14" TO PAR-NAME. IF1364.2 +064300 PERFORM PRINT-DETAIL. IF1364.2 +064400*****************TEST (a) - COMPLEX TEST**************** IF1364.2 +064500 F-SQRT-15. IF1364.2 +064600 MOVE ZERO TO WS-NUM. IF1364.2 +064700 MOVE 0.316214 TO MIN-RANGE. IF1364.2 +064800 MOVE 0.316240 TO MAX-RANGE. IF1364.2 +064900 F-SQRT-TEST-15. IF1364.2 +065000 COMPUTE WS-NUM = FUNCTION SQRT(9 - 8.9). IF1364.2 +065100 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +065200 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +065300 PERFORM PASS IF1364.2 +065400 ELSE IF1364.2 +065500 MOVE WS-NUM TO COMPUTED-N IF1364.2 +065600 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +065700 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +065800 PERFORM FAIL. IF1364.2 +065900 GO TO F-SQRT-WRITE-15. IF1364.2 +066000 F-SQRT-DELETE-15. IF1364.2 +066100 PERFORM DE-LETE. IF1364.2 +066200 GO TO F-SQRT-WRITE-15. IF1364.2 +066300 F-SQRT-WRITE-15. IF1364.2 +066400 MOVE "F-SQRT-15" TO PAR-NAME. IF1364.2 +066500 PERFORM PRINT-DETAIL. IF1364.2 +066600*****************TEST (b) - COMPLEX TEST**************** IF1364.2 +066700 F-SQRT-16. IF1364.2 +066800 MOVE ZERO TO WS-NUM. IF1364.2 +066900 MOVE 1.95172 TO MIN-RANGE. IF1364.2 +067000 MOVE 1.95188 TO MAX-RANGE. IF1364.2 +067100 F-SQRT-TEST-16. IF1364.2 +067200 COMPUTE WS-NUM = FUNCTION SQRT(8 / 2.1). IF1364.2 +067300 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +067400 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +067500 PERFORM PASS IF1364.2 +067600 ELSE IF1364.2 +067700 MOVE WS-NUM TO COMPUTED-N IF1364.2 +067800 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +067900 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +068000 PERFORM FAIL. IF1364.2 +068100 GO TO F-SQRT-WRITE-16. IF1364.2 +068200 F-SQRT-DELETE-16. IF1364.2 +068300 PERFORM DE-LETE. IF1364.2 +068400 GO TO F-SQRT-WRITE-16. IF1364.2 +068500 F-SQRT-WRITE-16. IF1364.2 +068600 MOVE "F-SQRT-16" TO PAR-NAME. IF1364.2 +068700 PERFORM PRINT-DETAIL. IF1364.2 +068800*****************TEST (c) - COMPLEX TEST**************** IF1364.2 +068900 F-SQRT-17. IF1364.2 +069000 MOVE ZERO TO WS-NUM. IF1364.2 +069100 MOVE 17.7475 TO MIN-RANGE. IF1364.2 +069200 MOVE 17.7489 TO MAX-RANGE. IF1364.2 +069300 F-SQRT-TEST-17. IF1364.2 +069400 COMPUTE WS-NUM = FUNCTION SQRT(35 * 9). IF1364.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +069700 PERFORM PASS IF1364.2 +069800 ELSE IF1364.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1364.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +070200 PERFORM FAIL. IF1364.2 +070300 GO TO F-SQRT-WRITE-17. IF1364.2 +070400 F-SQRT-DELETE-17. IF1364.2 +070500 PERFORM DE-LETE. IF1364.2 +070600 GO TO F-SQRT-WRITE-17. IF1364.2 +070700 F-SQRT-WRITE-17. IF1364.2 +070800 MOVE "F-SQRT-17" TO PAR-NAME. IF1364.2 +070900 PERFORM PRINT-DETAIL. IF1364.2 +071000*****************TEST (d) - COMPLEX TEST**************** IF1364.2 +071100 F-SQRT-18. IF1364.2 +071200 MOVE ZERO TO WS-NUM. IF1364.2 +071300 MOVE 1.13384 TO MIN-RANGE. IF1364.2 +071400 MOVE 1.13393 TO MAX-RANGE. IF1364.2 +071500 F-SQRT-TEST-18. IF1364.2 +071600 COMPUTE WS-NUM = FUNCTION SQRT(9 / 7). IF1364.2 +071700 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +071800 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +071900 PERFORM PASS IF1364.2 +072000 ELSE IF1364.2 +072100 MOVE WS-NUM TO COMPUTED-N IF1364.2 +072200 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +072300 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +072400 PERFORM FAIL. IF1364.2 +072500 GO TO F-SQRT-WRITE-18. IF1364.2 +072600 F-SQRT-DELETE-18. IF1364.2 +072700 PERFORM DE-LETE. IF1364.2 +072800 GO TO F-SQRT-WRITE-18. IF1364.2 +072900 F-SQRT-WRITE-18. IF1364.2 +073000 MOVE "F-SQRT-18" TO PAR-NAME. IF1364.2 +073100 PERFORM PRINT-DETAIL. IF1364.2 +073200*****************TEST (e) - COMPLEX TEST**************** IF1364.2 +073300 F-SQRT-19. IF1364.2 +073400 MOVE ZERO TO WS-NUM. IF1364.2 +073500 MOVE 3.60541 TO MIN-RANGE. IF1364.2 +073600 MOVE 3.60569 TO MAX-RANGE. IF1364.2 +073700 F-SQRT-TEST-19. IF1364.2 +073800 COMPUTE WS-NUM = FUNCTION SQRT(E + F). IF1364.2 +073900 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +074000 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +074100 PERFORM PASS IF1364.2 +074200 ELSE IF1364.2 +074300 MOVE WS-NUM TO COMPUTED-N IF1364.2 +074400 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +074500 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +074600 PERFORM FAIL. IF1364.2 +074700 GO TO F-SQRT-WRITE-19. IF1364.2 +074800 F-SQRT-DELETE-19. IF1364.2 +074900 PERFORM DE-LETE. IF1364.2 +075000 GO TO F-SQRT-WRITE-19. IF1364.2 +075100 F-SQRT-WRITE-19. IF1364.2 +075200 MOVE "F-SQRT-19" TO PAR-NAME. IF1364.2 +075300 PERFORM PRINT-DETAIL. IF1364.2 +075400*****************TEST (f) - COMPLEX TEST**************** IF1364.2 +075500 F-SQRT-20. IF1364.2 +075600 MOVE ZERO TO WS-NUM. IF1364.2 +075700 MOVE 11.9517 TO MIN-RANGE. IF1364.2 +075800 MOVE 11.9527 TO MAX-RANGE. IF1364.2 +075900 F-SQRT-TEST-20. IF1364.2 +076000 COMPUTE WS-NUM = FUNCTION SQRT(D / E). IF1364.2 +076100 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +076200 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +076300 PERFORM PASS IF1364.2 +076400 ELSE IF1364.2 +076500 MOVE WS-NUM TO COMPUTED-N IF1364.2 +076600 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +076700 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +076800 PERFORM FAIL. IF1364.2 +076900 GO TO F-SQRT-WRITE-20. IF1364.2 +077000 F-SQRT-DELETE-20. IF1364.2 +077100 PERFORM DE-LETE. IF1364.2 +077200 GO TO F-SQRT-WRITE-20. IF1364.2 +077300 F-SQRT-WRITE-20. IF1364.2 +077400 MOVE "F-SQRT-20" TO PAR-NAME. IF1364.2 +077500 PERFORM PRINT-DETAIL. IF1364.2 +077600*****************TEST (g) - COMPLEX TEST**************** IF1364.2 +077700 F-SQRT-21. IF1364.2 +077800 MOVE ZERO TO WS-NUM. IF1364.2 +077900 MOVE 1.73198 TO MIN-RANGE. IF1364.2 +078000 MOVE 1.73212 TO MAX-RANGE. IF1364.2 +078100 F-SQRT-TEST-21. IF1364.2 +078200 COMPUTE WS-NUM = FUNCTION SQRT(F - 3). IF1364.2 +078300 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +078400 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +078500 PERFORM PASS IF1364.2 +078600 ELSE IF1364.2 +078700 MOVE WS-NUM TO COMPUTED-N IF1364.2 +078800 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +078900 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +079000 PERFORM FAIL. IF1364.2 +079100 GO TO F-SQRT-WRITE-21. IF1364.2 +079200 F-SQRT-DELETE-21. IF1364.2 +079300 PERFORM DE-LETE. IF1364.2 +079400 GO TO F-SQRT-WRITE-21. IF1364.2 +079500 F-SQRT-WRITE-21. IF1364.2 +079600 MOVE "F-SQRT-21" TO PAR-NAME. IF1364.2 +079700 PERFORM PRINT-DETAIL. IF1364.2 +079800*****************TEST (h) - COMPLEX TEST**************** IF1364.2 +079900 F-SQRT-22. IF1364.2 +080000 MOVE ZERO TO WS-NUM. IF1364.2 +080100 MOVE 4.01232 TO MIN-RANGE. IF1364.2 +080200 MOVE 4.01264 TO MAX-RANGE. IF1364.2 +080300 F-SQRT-TEST-22. IF1364.2 +080400 COMPUTE WS-NUM = FUNCTION SQRT(E * 2.3). IF1364.2 +080500 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +080600 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +080700 PERFORM PASS IF1364.2 +080800 ELSE IF1364.2 +080900 MOVE WS-NUM TO COMPUTED-N IF1364.2 +081000 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +081100 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +081200 PERFORM FAIL. IF1364.2 +081300 GO TO F-SQRT-WRITE-22. IF1364.2 +081400 F-SQRT-DELETE-22. IF1364.2 +081500 PERFORM DE-LETE. IF1364.2 +081600 GO TO F-SQRT-WRITE-22. IF1364.2 +081700 F-SQRT-WRITE-22. IF1364.2 +081800 MOVE "F-SQRT-22" TO PAR-NAME. IF1364.2 +081900 PERFORM PRINT-DETAIL. IF1364.2 +082000*****************TEST (i) - COMPLEX TEST**************** IF1364.2 +082100 F-SQRT-23. IF1364.2 +082200 MOVE ZERO TO WS-NUM. IF1364.2 +082300 MOVE 1.56502 TO MIN-RANGE. IF1364.2 +082400 MOVE 1.56514 TO MAX-RANGE. IF1364.2 +082500 F-SQRT-TEST-23. IF1364.2 +082600 COMPUTE WS-NUM = FUNCTION SQRT(FUNCTION SQRT(F)). IF1364.2 +082700 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +082800 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +082900 PERFORM PASS IF1364.2 +083000 ELSE IF1364.2 +083100 MOVE WS-NUM TO COMPUTED-N IF1364.2 +083200 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +083300 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +083400 PERFORM FAIL. IF1364.2 +083500 GO TO F-SQRT-WRITE-23. IF1364.2 +083600 F-SQRT-DELETE-23. IF1364.2 +083700 PERFORM DE-LETE. IF1364.2 +083800 GO TO F-SQRT-WRITE-23. IF1364.2 +083900 F-SQRT-WRITE-23. IF1364.2 +084000 MOVE "F-SQRT-23" TO PAR-NAME. IF1364.2 +084100 PERFORM PRINT-DETAIL. IF1364.2 +084200*****************TEST (j) - COMPLEX TEST**************** IF1364.2 +084300 F-SQRT-24. IF1364.2 +084400 MOVE ZERO TO WS-NUM. IF1364.2 +084500 MOVE 4.87309 TO MIN-RANGE. IF1364.2 +084600 MOVE 4.87348 TO MAX-RANGE. IF1364.2 +084700 F-SQRT-TEST-24. IF1364.2 +084800 COMPUTE WS-NUM = FUNCTION SQRT(6.5) + IF1364.2 +084900 FUNCTION SQRT(5.4). IF1364.2 +085000 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +085100 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +085200 PERFORM PASS IF1364.2 +085300 ELSE IF1364.2 +085400 MOVE WS-NUM TO COMPUTED-N IF1364.2 +085500 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +085600 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +085700 PERFORM FAIL. IF1364.2 +085800 GO TO F-SQRT-WRITE-24. IF1364.2 +085900 F-SQRT-DELETE-24. IF1364.2 +086000 PERFORM DE-LETE. IF1364.2 +086100 GO TO F-SQRT-WRITE-24. IF1364.2 +086200 F-SQRT-WRITE-24. IF1364.2 +086300 MOVE "F-SQRT-24" TO PAR-NAME. IF1364.2 +086400 PERFORM PRINT-DETAIL. IF1364.2 +086500*****************TEST (k) - COMPLEX TEST**************** IF1364.2 +086600 F-SQRT-25. IF1364.2 +086700 MOVE ZERO TO WS-NUM. IF1364.2 +086800 MOVE 9.99960 TO MIN-RANGE. IF1364.2 +086900 MOVE 10.0004 TO MAX-RANGE. IF1364.2 +087000 F-SQRT-TEST-25. IF1364.2 +087100 COMPUTE WS-NUM = FUNCTION SQRT(10) ** 2. IF1364.2 +087200 IF (WS-NUM >= MIN-RANGE) AND IF1364.2 +087300 (WS-NUM <= MAX-RANGE) THEN IF1364.2 +087400 PERFORM PASS IF1364.2 +087500 ELSE IF1364.2 +087600 MOVE WS-NUM TO COMPUTED-N IF1364.2 +087700 MOVE MIN-RANGE TO CORRECT-MIN IF1364.2 +087800 MOVE MAX-RANGE TO CORRECT-MAX IF1364.2 +087900 PERFORM FAIL. IF1364.2 +088000 GO TO F-SQRT-WRITE-25. IF1364.2 +088100 F-SQRT-DELETE-25. IF1364.2 +088200 PERFORM DE-LETE. IF1364.2 +088300 GO TO F-SQRT-WRITE-25. IF1364.2 +088400 F-SQRT-WRITE-25. IF1364.2 +088500 MOVE "F-SQRT-25" TO PAR-NAME. IF1364.2 +088600 PERFORM PRINT-DETAIL. IF1364.2 +088700*****************SPECIAL PERFORM TEST********************** IF1364.2 +088800 F-SQRT-26. IF1364.2 +088900 PERFORM F-SQRT-TEST-26 IF1364.2 +089000 UNTIL FUNCTION SQRT(ARG1) < 2.0. IF1364.2 +089100 PERFORM PASS. IF1364.2 +089200 GO TO F-SQRT-WRITE-26. IF1364.2 +089300 F-SQRT-TEST-26. IF1364.2 +089400 COMPUTE ARG1 = ARG1 - 1. IF1364.2 +089500 F-SQRT-DELETE-26. IF1364.2 +089600 PERFORM DE-LETE. IF1364.2 +089700 GO TO F-SQRT-WRITE-26. IF1364.2 +089800 F-SQRT-WRITE-26. IF1364.2 +089900 MOVE "F-SQRT-26" TO PAR-NAME. IF1364.2 +090000 PERFORM PRINT-DETAIL. IF1364.2 +090100********************END OF TESTS*************** IF1364.2 +090200 CCVS-EXIT SECTION. IF1364.2 +090300 CCVS-999999. IF1364.2 +090400 GO TO CLOSE-FILES. IF1364.2 diff --git a/tests/cobol85/IF/IF137A.CBL b/tests/cobol85/IF/IF137A.CBL new file mode 100755 index 00000000..654e624b --- /dev/null +++ b/tests/cobol85/IF/IF137A.CBL @@ -0,0 +1,725 @@ +000100 IDENTIFICATION DIVISION. IF1374.2 +000200 PROGRAM-ID. IF1374.2 +000300 IF137A. IF1374.2 +000400 IF1374.2 +000500*********************************************************** IF1374.2 +000600* * IF1374.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1374.2 +000800* It contains tests for the Intrinsic Function * IF1374.2 +000900* STANDARD-DEVIATION. * IF1374.2 +001000* * IF1374.2 +001100*********************************************************** IF1374.2 +001200 ENVIRONMENT DIVISION. IF1374.2 +001300 CONFIGURATION SECTION. IF1374.2 +001400 SOURCE-COMPUTER. IF1374.2 +001500 Linux. IF1374.2 +001600 OBJECT-COMPUTER. IF1374.2 +001700 Linux. IF1374.2 +001800 INPUT-OUTPUT SECTION. IF1374.2 +001900 FILE-CONTROL. IF1374.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1374.2 +002100 "report.log". IF1374.2 +002200 DATA DIVISION. IF1374.2 +002300 FILE SECTION. IF1374.2 +002400 FD PRINT-FILE. IF1374.2 +002500 01 PRINT-REC PICTURE X(120). IF1374.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1374.2 +002700 WORKING-STORAGE SECTION. IF1374.2 +002800*********************************************************** IF1374.2 +002900* Variables specific to the Intrinsic Function Test IF137A* IF1374.2 +003000*********************************************************** IF1374.2 +003100 01 A PIC S9(10) VALUE 5. IF1374.2 +003200 01 B PIC S9(10) VALUE 7. IF1374.2 +003300 01 C PIC S9(10) VALUE -4. IF1374.2 +003400 01 D PIC S9(10) VALUE 10. IF1374.2 +003500 01 E PIC S9(5)V9(5) VALUE 34.26. IF1374.2 +003600 01 F PIC S9(5)V9(5) VALUE -8.32. IF1374.2 +003700 01 G PIC S9(5)V9(5) VALUE 4.08. IF1374.2 +003800 01 H PIC S9(5)V9(5) VALUE -5.3. IF1374.2 +003900 01 P PIC S9(10) VALUE 4. IF1374.2 +004000 01 Q PIC S9(10) VALUE 3. IF1374.2 +004100 01 R PIC S9(10) VALUE 5. IF1374.2 +004200 01 ARG3 PIC S9(10) VALUE 2. IF1374.2 +004300 01 ARR VALUE "40537". IF1374.2 +004400 02 IND OCCURS 5 TIMES PIC 9. IF1374.2 +004500 01 TEMP PIC S9(10). IF1374.2 +004600 01 WS-NUM PIC S9(5)V9(6). IF1374.2 +004700 01 MIN-RANGE PIC S9(5)V9(7). IF1374.2 +004800 01 MAX-RANGE PIC S9(5)V9(7). IF1374.2 +004900* IF1374.2 +005000********************************************************** IF1374.2 +005100* IF1374.2 +005200 01 TEST-RESULTS. IF1374.2 +005300 02 FILLER PIC X VALUE SPACE. IF1374.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. IF1374.2 +005500 02 FILLER PIC X VALUE SPACE. IF1374.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. IF1374.2 +005700 02 FILLER PIC X VALUE SPACE. IF1374.2 +005800 02 PAR-NAME. IF1374.2 +005900 03 FILLER PIC X(19) VALUE SPACE. IF1374.2 +006000 03 PARDOT-X PIC X VALUE SPACE. IF1374.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. IF1374.2 +006200 02 FILLER PIC X(8) VALUE SPACE. IF1374.2 +006300 02 RE-MARK PIC X(61). IF1374.2 +006400 01 TEST-COMPUTED. IF1374.2 +006500 02 FILLER PIC X(30) VALUE SPACE. IF1374.2 +006600 02 FILLER PIC X(17) VALUE IF1374.2 +006700 " COMPUTED=". IF1374.2 +006800 02 COMPUTED-X. IF1374.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1374.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A IF1374.2 +007100 PIC -9(9).9(9). IF1374.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1374.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1374.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1374.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. IF1374.2 +007600 04 COMPUTED-18V0 PIC -9(18). IF1374.2 +007700 04 FILLER PIC X. IF1374.2 +007800 03 FILLER PIC X(50) VALUE SPACE. IF1374.2 +007900 01 TEST-CORRECT. IF1374.2 +008000 02 FILLER PIC X(30) VALUE SPACE. IF1374.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". IF1374.2 +008200 02 CORRECT-X. IF1374.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. IF1374.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1374.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1374.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1374.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1374.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. IF1374.2 +008900 04 CORRECT-18V0 PIC -9(18). IF1374.2 +009000 04 FILLER PIC X. IF1374.2 +009100 03 FILLER PIC X(2) VALUE SPACE. IF1374.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1374.2 +009300 01 TEST-CORRECT-MIN. IF1374.2 +009400 02 FILLER PIC X(30) VALUE SPACE. IF1374.2 +009500 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1374.2 +009600 02 CORRECTMI-X. IF1374.2 +009700 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1374.2 +009800 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1374.2 +009900 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1374.2 +010000 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1374.2 +010100 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1374.2 +010200 03 CR-18V0 REDEFINES CORRECTMI-A. IF1374.2 +010300 04 CORRECTMI-18V0 PIC -9(18). IF1374.2 +010400 04 FILLER PIC X. IF1374.2 +010500 03 FILLER PIC X(2) VALUE SPACE. IF1374.2 +010600 03 FILLER PIC X(48) VALUE SPACE. IF1374.2 +010700 01 TEST-CORRECT-MAX. IF1374.2 +010800 02 FILLER PIC X(30) VALUE SPACE. IF1374.2 +010900 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1374.2 +011000 02 CORRECTMA-X. IF1374.2 +011100 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1374.2 +011200 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1374.2 +011300 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1374.2 +011400 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1374.2 +011500 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1374.2 +011600 03 CR-18V0 REDEFINES CORRECTMA-A. IF1374.2 +011700 04 CORRECTMA-18V0 PIC -9(18). IF1374.2 +011800 04 FILLER PIC X. IF1374.2 +011900 03 FILLER PIC X(2) VALUE SPACE. IF1374.2 +012000 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1374.2 +012100 01 CCVS-C-1. IF1374.2 +012200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1374.2 +012300- "SS PARAGRAPH-NAME IF1374.2 +012400- " REMARKS". IF1374.2 +012500 02 FILLER PIC X(20) VALUE SPACE. IF1374.2 +012600 01 CCVS-C-2. IF1374.2 +012700 02 FILLER PIC X VALUE SPACE. IF1374.2 +012800 02 FILLER PIC X(6) VALUE "TESTED". IF1374.2 +012900 02 FILLER PIC X(15) VALUE SPACE. IF1374.2 +013000 02 FILLER PIC X(4) VALUE "FAIL". IF1374.2 +013100 02 FILLER PIC X(94) VALUE SPACE. IF1374.2 +013200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1374.2 +013300 01 REC-CT PIC 99 VALUE ZERO. IF1374.2 +013400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1374.2 +013500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1374.2 +013600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1374.2 +013700 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1374.2 +013800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1374.2 +013900 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1374.2 +014000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1374.2 +014100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1374.2 +014200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1374.2 +014300 01 CCVS-H-1. IF1374.2 +014400 02 FILLER PIC X(39) VALUE SPACES. IF1374.2 +014500 02 FILLER PIC X(42) VALUE IF1374.2 +014600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1374.2 +014700 02 FILLER PIC X(39) VALUE SPACES. IF1374.2 +014800 01 CCVS-H-2A. IF1374.2 +014900 02 FILLER PIC X(40) VALUE SPACE. IF1374.2 +015000 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1374.2 +015100 02 FILLER PIC XXXX VALUE IF1374.2 +015200 "4.2 ". IF1374.2 +015300 02 FILLER PIC X(28) VALUE IF1374.2 +015400 " COPY - NOT FOR DISTRIBUTION". IF1374.2 +015500 02 FILLER PIC X(41) VALUE SPACE. IF1374.2 +015600 IF1374.2 +015700 01 CCVS-H-2B. IF1374.2 +015800 02 FILLER PIC X(15) VALUE IF1374.2 +015900 "TEST RESULT OF ". IF1374.2 +016000 02 TEST-ID PIC X(9). IF1374.2 +016100 02 FILLER PIC X(4) VALUE IF1374.2 +016200 " IN ". IF1374.2 +016300 02 FILLER PIC X(12) VALUE IF1374.2 +016400 " HIGH ". IF1374.2 +016500 02 FILLER PIC X(22) VALUE IF1374.2 +016600 " LEVEL VALIDATION FOR ". IF1374.2 +016700 02 FILLER PIC X(58) VALUE IF1374.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1374.2 +016900 01 CCVS-H-3. IF1374.2 +017000 02 FILLER PIC X(34) VALUE IF1374.2 +017100 " FOR OFFICIAL USE ONLY ". IF1374.2 +017200 02 FILLER PIC X(58) VALUE IF1374.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1374.2 +017400 02 FILLER PIC X(28) VALUE IF1374.2 +017500 " COPYRIGHT 1985 ". IF1374.2 +017600 01 CCVS-E-1. IF1374.2 +017700 02 FILLER PIC X(52) VALUE SPACE. IF1374.2 +017800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1374.2 +017900 02 ID-AGAIN PIC X(9). IF1374.2 +018000 02 FILLER PIC X(45) VALUE SPACES. IF1374.2 +018100 01 CCVS-E-2. IF1374.2 +018200 02 FILLER PIC X(31) VALUE SPACE. IF1374.2 +018300 02 FILLER PIC X(21) VALUE SPACE. IF1374.2 +018400 02 CCVS-E-2-2. IF1374.2 +018500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1374.2 +018600 03 FILLER PIC X VALUE SPACE. IF1374.2 +018700 03 ENDER-DESC PIC X(44) VALUE IF1374.2 +018800 "ERRORS ENCOUNTERED". IF1374.2 +018900 01 CCVS-E-3. IF1374.2 +019000 02 FILLER PIC X(22) VALUE IF1374.2 +019100 " FOR OFFICIAL USE ONLY". IF1374.2 +019200 02 FILLER PIC X(12) VALUE SPACE. IF1374.2 +019300 02 FILLER PIC X(58) VALUE IF1374.2 +019400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1374.2 +019500 02 FILLER PIC X(13) VALUE SPACE. IF1374.2 +019600 02 FILLER PIC X(15) VALUE IF1374.2 +019700 " COPYRIGHT 1985". IF1374.2 +019800 01 CCVS-E-4. IF1374.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1374.2 +020000 02 FILLER PIC X(4) VALUE " OF ". IF1374.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1374.2 +020200 02 FILLER PIC X(40) VALUE IF1374.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". IF1374.2 +020400 01 XXINFO. IF1374.2 +020500 02 FILLER PIC X(19) VALUE IF1374.2 +020600 "*** INFORMATION ***". IF1374.2 +020700 02 INFO-TEXT. IF1374.2 +020800 04 FILLER PIC X(8) VALUE SPACE. IF1374.2 +020900 04 XXCOMPUTED PIC X(20). IF1374.2 +021000 04 FILLER PIC X(5) VALUE SPACE. IF1374.2 +021100 04 XXCORRECT PIC X(20). IF1374.2 +021200 02 INF-ANSI-REFERENCE PIC X(48). IF1374.2 +021300 01 HYPHEN-LINE. IF1374.2 +021400 02 FILLER PIC IS X VALUE IS SPACE. IF1374.2 +021500 02 FILLER PIC IS X(65) VALUE IS "************************IF1374.2 +021600- "*****************************************". IF1374.2 +021700 02 FILLER PIC IS X(54) VALUE IS "************************IF1374.2 +021800- "******************************". IF1374.2 +021900 01 CCVS-PGM-ID PIC X(9) VALUE IF1374.2 +022000 "IF137A". IF1374.2 +022100 PROCEDURE DIVISION. IF1374.2 +022200 CCVS1 SECTION. IF1374.2 +022300 OPEN-FILES. IF1374.2 +022400 OPEN OUTPUT PRINT-FILE. IF1374.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1374.2 +022600 MOVE SPACE TO TEST-RESULTS. IF1374.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1374.2 +022800 GO TO CCVS1-EXIT. IF1374.2 +022900 CLOSE-FILES. IF1374.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1374.2 +023100 TERMINATE-CCVS. IF1374.2 +023200 STOP RUN. IF1374.2 +023300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1374.2 +023400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1374.2 +023500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1374.2 +023600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1374.2 +023700 MOVE "****TEST DELETED****" TO RE-MARK. IF1374.2 +023800 PRINT-DETAIL. IF1374.2 +023900 IF REC-CT NOT EQUAL TO ZERO IF1374.2 +024000 MOVE "." TO PARDOT-X IF1374.2 +024100 MOVE REC-CT TO DOTVALUE. IF1374.2 +024200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1374.2 +024300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1374.2 +024400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1374.2 +024500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1374.2 +024600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1374.2 +024700 MOVE SPACE TO CORRECT-X. IF1374.2 +024800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1374.2 +024900 MOVE SPACE TO RE-MARK. IF1374.2 +025000 HEAD-ROUTINE. IF1374.2 +025100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +025200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +025300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1374.2 +025400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1374.2 +025500 COLUMN-NAMES-ROUTINE. IF1374.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +025900 END-ROUTINE. IF1374.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1374.2 +026100 END-RTN-EXIT. IF1374.2 +026200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +026300 END-ROUTINE-1. IF1374.2 +026400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1374.2 +026500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1374.2 +026600 ADD PASS-COUNTER TO ERROR-HOLD. IF1374.2 +026700 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1374.2 +026800 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1374.2 +026900 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1374.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1374.2 +027100 END-ROUTINE-12. IF1374.2 +027200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1374.2 +027300 IF ERROR-COUNTER IS EQUAL TO ZERO IF1374.2 +027400 MOVE "NO " TO ERROR-TOTAL IF1374.2 +027500 ELSE IF1374.2 +027600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1374.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1374.2 +027800 PERFORM WRITE-LINE. IF1374.2 +027900 END-ROUTINE-13. IF1374.2 +028000 IF DELETE-COUNTER IS EQUAL TO ZERO IF1374.2 +028100 MOVE "NO " TO ERROR-TOTAL ELSE IF1374.2 +028200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1374.2 +028300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1374.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +028500 IF INSPECT-COUNTER EQUAL TO ZERO IF1374.2 +028600 MOVE "NO " TO ERROR-TOTAL IF1374.2 +028700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1374.2 +028800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1374.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +029000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1374.2 +029100 WRITE-LINE. IF1374.2 +029200 ADD 1 TO RECORD-COUNT. IF1374.2 +029300 IF RECORD-COUNT GREATER 42 IF1374.2 +029400 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1374.2 +029500 MOVE SPACE TO DUMMY-RECORD IF1374.2 +029600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1374.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1374.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1374.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1374.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1374.2 +030100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1374.2 +030200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1374.2 +030300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1374.2 +030400 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1374.2 +030500 MOVE ZERO TO RECORD-COUNT. IF1374.2 +030600 PERFORM WRT-LN. IF1374.2 +030700 WRT-LN. IF1374.2 +030800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1374.2 +030900 MOVE SPACE TO DUMMY-RECORD. IF1374.2 +031000 BLANK-LINE-PRINT. IF1374.2 +031100 PERFORM WRT-LN. IF1374.2 +031200 FAIL-ROUTINE. IF1374.2 +031300 IF COMPUTED-X NOT EQUAL TO SPACE IF1374.2 +031400 GO TO FAIL-ROUTINE-WRITE. IF1374.2 +031500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1374.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1374.2 +031700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1374.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1374.2 +032000 GO TO FAIL-ROUTINE-EX. IF1374.2 +032100 FAIL-ROUTINE-WRITE. IF1374.2 +032200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1374.2 +032300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1374.2 +032400 CORMA-ANSI-REFERENCE. IF1374.2 +032500 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1374.2 +032600 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1374.2 +032700 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1374.2 +032800 ELSE IF1374.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1374.2 +033000 PERFORM WRITE-LINE. IF1374.2 +033100 MOVE SPACES TO COR-ANSI-REFERENCE. IF1374.2 +033200 FAIL-ROUTINE-EX. EXIT. IF1374.2 +033300 BAIL-OUT. IF1374.2 +033400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1374.2 +033500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1374.2 +033600 BAIL-OUT-WRITE. IF1374.2 +033700 MOVE CORRECT-A TO XXCORRECT. IF1374.2 +033800 MOVE COMPUTED-A TO XXCOMPUTED. IF1374.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1374.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1374.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1374.2 +034200 BAIL-OUT-EX. EXIT. IF1374.2 +034300 CCVS1-EXIT. IF1374.2 +034400 EXIT. IF1374.2 +034500******************************************************** IF1374.2 +034600* * IF1374.2 +034700* Intrinsic Function Tests IF137A - STANDARD-DEVIATION * IF1374.2 +034800* * IF1374.2 +034900******************************************************** IF1374.2 +035000 SECT-IF137A SECTION. IF1374.2 +035100 F-STD-DEV-INFO. IF1374.2 +035200 MOVE "See ref. A-70 2.41" TO ANSI-REFERENCE. IF1374.2 +035300 MOVE "STANDARD-DEVIATION" TO FEATURE. IF1374.2 +035400*****************TEST (a) - SIMPLE TEST***************** IF1374.2 +035500 F-STD-DEV-01. IF1374.2 +035600 MOVE ZERO TO WS-NUM. IF1374.2 +035700 MOVE 6.97750 TO MIN-RANGE. IF1374.2 +035800 MOVE 6.97778 TO MAX-RANGE. IF1374.2 +035900 F-STD-DEV-TEST-01. IF1374.2 +036000 COMPUTE WS-NUM = IF1374.2 +036100 FUNCTION STANDARD-DEVIATION(5, -2, -14, 0). IF1374.2 +036200 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +036300 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +036400 PERFORM PASS IF1374.2 +036500 ELSE IF1374.2 +036600 MOVE WS-NUM TO COMPUTED-N IF1374.2 +036700 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +036800 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +036900 PERFORM FAIL. IF1374.2 +037000 GO TO F-STD-DEV-WRITE-01. IF1374.2 +037100 F-STD-DEV-DELETE-01. IF1374.2 +037200 PERFORM DE-LETE. IF1374.2 +037300 GO TO F-STD-DEV-WRITE-01. IF1374.2 +037400 F-STD-DEV-WRITE-01. IF1374.2 +037500 MOVE "F-STD-DEV-01" TO PAR-NAME. IF1374.2 +037600 PERFORM PRINT-DETAIL. IF1374.2 +037700*****************TEST (b) - SIMPLE TEST***************** IF1374.2 +037800 F-STD-DEV-02. IF1374.2 +037900 EVALUATE FUNCTION STANDARD-DEVIATION(3.9, -0.3, 8.7, 100.2) IF1374.2 +038000 WHEN 41.7333 THRU 41.7350 IF1374.2 +038100 PERFORM PASS IF1374.2 +038200 WHEN OTHER IF1374.2 +038300 PERFORM FAIL. IF1374.2 +038400 GO TO F-STD-DEV-WRITE-02. IF1374.2 +038500 F-STD-DEV-DELETE-02. IF1374.2 +038600 PERFORM DE-LETE. IF1374.2 +038700 GO TO F-STD-DEV-WRITE-02. IF1374.2 +038800 F-STD-DEV-WRITE-02. IF1374.2 +038900 MOVE "F-STD-DEV-02" TO PAR-NAME. IF1374.2 +039000 PERFORM PRINT-DETAIL. IF1374.2 +039100*****************TEST (c) - SIMPLE TEST***************** IF1374.2 +039200 F-STD-DEV-03. IF1374.2 +039300 MOVE 5.22005 TO MIN-RANGE. IF1374.2 +039400 MOVE 5.22025 TO MAX-RANGE. IF1374.2 +039500 F-STD-DEV-TEST-03. IF1374.2 +039600 IF (FUNCTION STANDARD-DEVIATION(A, B, C, D) IF1374.2 +039700 >= MIN-RANGE) AND IF1374.2 +039800 (FUNCTION STANDARD-DEVIATION(A, B, C, D) IF1374.2 +039900 <= MAX-RANGE) THEN IF1374.2 +040000 PERFORM PASS IF1374.2 +040100 ELSE IF1374.2 +040200 PERFORM FAIL. IF1374.2 +040300 GO TO F-STD-DEV-WRITE-03. IF1374.2 +040400 F-STD-DEV-DELETE-03. IF1374.2 +040500 PERFORM DE-LETE. IF1374.2 +040600 GO TO F-STD-DEV-WRITE-03. IF1374.2 +040700 F-STD-DEV-WRITE-03. IF1374.2 +040800 MOVE "F-STD-DEV-03" TO PAR-NAME. IF1374.2 +040900 PERFORM PRINT-DETAIL. IF1374.2 +041000*****************TEST (d) - SIMPLE TEST***************** IF1374.2 +041100 F-STD-DEV-04. IF1374.2 +041200 MOVE ZERO TO WS-NUM. IF1374.2 +041300 MOVE 16.8440 TO MIN-RANGE. IF1374.2 +041400 MOVE 16.8447 TO MAX-RANGE. IF1374.2 +041500 F-STD-DEV-TEST-04. IF1374.2 +041600 COMPUTE WS-NUM = IF1374.2 +041700 FUNCTION STANDARD-DEVIATION(E, F, G, H). IF1374.2 +041800 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +041900 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +042000 PERFORM PASS IF1374.2 +042100 ELSE IF1374.2 +042200 MOVE WS-NUM TO COMPUTED-N IF1374.2 +042300 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +042400 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +042500 PERFORM FAIL. IF1374.2 +042600 GO TO F-STD-DEV-WRITE-04. IF1374.2 +042700 F-STD-DEV-DELETE-04. IF1374.2 +042800 PERFORM DE-LETE. IF1374.2 +042900 GO TO F-STD-DEV-WRITE-04. IF1374.2 +043000 F-STD-DEV-WRITE-04. IF1374.2 +043100 MOVE "F-STD-DEV-04" TO PAR-NAME. IF1374.2 +043200 PERFORM PRINT-DETAIL. IF1374.2 +043300*****************TEST (e) - SIMPLE TEST***************** IF1374.2 +043400 F-STD-DEV-05. IF1374.2 +043500 MOVE ZERO TO WS-NUM. IF1374.2 +043600 MOVE 9.73119 TO MIN-RANGE. IF1374.2 +043700 MOVE 9.73158 TO MAX-RANGE. IF1374.2 +043800 F-STD-DEV-TEST-05. IF1374.2 +043900 COMPUTE WS-NUM = IF1374.2 +044000 FUNCTION STANDARD-DEVIATION(10.2, -0.2, 5.6, -15.6). IF1374.2 +044100 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +044200 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +044300 PERFORM PASS IF1374.2 +044400 ELSE IF1374.2 +044500 MOVE WS-NUM TO COMPUTED-N IF1374.2 +044600 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +044700 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +044800 PERFORM FAIL. IF1374.2 +044900 GO TO F-STD-DEV-WRITE-05. IF1374.2 +045000 F-STD-DEV-DELETE-05. IF1374.2 +045100 PERFORM DE-LETE. IF1374.2 +045200 GO TO F-STD-DEV-WRITE-05. IF1374.2 +045300 F-STD-DEV-WRITE-05. IF1374.2 +045400 MOVE "F-STD-DEV-05" TO PAR-NAME. IF1374.2 +045500 PERFORM PRINT-DETAIL. IF1374.2 +045600*****************TEST (f) - SIMPLE TEST***************** IF1374.2 +045700 F-STD-DEV-06. IF1374.2 +045800 MOVE ZERO TO WS-NUM. IF1374.2 +045900 MOVE 12.4976 TO MIN-RANGE. IF1374.2 +046000 MOVE 12.4981 TO MAX-RANGE. IF1374.2 +046100 F-STD-DEV-TEST-06. IF1374.2 +046200 COMPUTE WS-NUM = IF1374.2 +046300 FUNCTION STANDARD-DEVIATION(A, B, C, D, E, F, G, H). IF1374.2 +046400 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +046500 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +046600 PERFORM PASS IF1374.2 +046700 ELSE IF1374.2 +046800 MOVE WS-NUM TO COMPUTED-N IF1374.2 +046900 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +047000 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +047100 PERFORM FAIL. IF1374.2 +047200 GO TO F-STD-DEV-WRITE-06. IF1374.2 +047300 F-STD-DEV-DELETE-06. IF1374.2 +047400 PERFORM DE-LETE. IF1374.2 +047500 GO TO F-STD-DEV-WRITE-06. IF1374.2 +047600 F-STD-DEV-WRITE-06. IF1374.2 +047700 MOVE "F-STD-DEV-06" TO PAR-NAME. IF1374.2 +047800 PERFORM PRINT-DETAIL. IF1374.2 +047900*****************TEST (g) - SIMPLE TEST***************** IF1374.2 +048000 F-STD-DEV-07. IF1374.2 +048100 MOVE ZERO TO WS-NUM. IF1374.2 +048200 MOVE 2.16020 TO MIN-RANGE. IF1374.2 +048300 MOVE 2.16028 TO MAX-RANGE. IF1374.2 +048400 F-STD-DEV-TEST-07. IF1374.2 +048500 COMPUTE WS-NUM = IF1374.2 +048600 FUNCTION STANDARD-DEVIATION(IND(1), IND(2), IND(3)). IF1374.2 +048700 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +048800 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +048900 PERFORM PASS IF1374.2 +049000 ELSE IF1374.2 +049100 MOVE WS-NUM TO COMPUTED-N IF1374.2 +049200 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +049300 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +049400 PERFORM FAIL. IF1374.2 +049500 GO TO F-STD-DEV-WRITE-07. IF1374.2 +049600 F-STD-DEV-DELETE-07. IF1374.2 +049700 PERFORM DE-LETE. IF1374.2 +049800 GO TO F-STD-DEV-WRITE-07. IF1374.2 +049900 F-STD-DEV-WRITE-07. IF1374.2 +050000 MOVE "F-STD-DEV-07" TO PAR-NAME. IF1374.2 +050100 PERFORM PRINT-DETAIL. IF1374.2 +050200*****************TEST (h) - SIMPLE TEST***************** IF1374.2 +050300 F-STD-DEV-08. IF1374.2 +050400 MOVE ZERO TO WS-NUM. IF1374.2 +050500 MOVE 1.63296 TO MIN-RANGE. IF1374.2 +050600 MOVE 1.63302 TO MAX-RANGE. IF1374.2 +050700 F-STD-DEV-TEST-08. IF1374.2 +050800 COMPUTE WS-NUM = IF1374.2 +050900 FUNCTION STANDARD-DEVIATION(IND(P), IND(Q), IND(R)). IF1374.2 +051000 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +051100 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +051200 PERFORM PASS IF1374.2 +051300 ELSE IF1374.2 +051400 MOVE WS-NUM TO COMPUTED-N IF1374.2 +051500 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +051600 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +051700 PERFORM FAIL. IF1374.2 +051800 GO TO F-STD-DEV-WRITE-08. IF1374.2 +051900 F-STD-DEV-DELETE-08. IF1374.2 +052000 PERFORM DE-LETE. IF1374.2 +052100 GO TO F-STD-DEV-WRITE-08. IF1374.2 +052200 F-STD-DEV-WRITE-08. IF1374.2 +052300 MOVE "F-STD-DEV-08" TO PAR-NAME. IF1374.2 +052400 PERFORM PRINT-DETAIL. IF1374.2 +052500*****************TEST (i) - SIMPLE TEST***************** IF1374.2 +052600 F-STD-DEV-09. IF1374.2 +052700 MOVE ZERO TO WS-NUM. IF1374.2 +052800 MOVE 2.31511 TO MIN-RANGE. IF1374.2 +052900 MOVE 2.31521 TO MAX-RANGE. IF1374.2 +053000 F-STD-DEV-TEST-09. IF1374.2 +rogerw COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION (4 0 5 3 7). +053200 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +053300 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +053400 PERFORM PASS IF1374.2 +053500 ELSE IF1374.2 +053600 MOVE WS-NUM TO COMPUTED-N IF1374.2 +053700 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +053800 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +053900 PERFORM FAIL. IF1374.2 +054000 GO TO F-STD-DEV-WRITE-09. IF1374.2 +054100 F-STD-DEV-DELETE-09. IF1374.2 +054200 PERFORM DE-LETE. IF1374.2 +054300 GO TO F-STD-DEV-WRITE-09. IF1374.2 +054400 F-STD-DEV-WRITE-09. IF1374.2 +054500 MOVE "F-STD-DEV-09" TO PAR-NAME. IF1374.2 +054600 PERFORM PRINT-DETAIL. IF1374.2 +054700*****************TEST (j) - SIMPLE TEST***************** IF1374.2 +054800 F-STD-DEV-10. IF1374.2 +054900 MOVE ZERO TO WS-NUM. IF1374.2 +055000 MOVE 0.028559 TO MIN-RANGE. IF1374.2 +055100 MOVE 0.028561 TO MAX-RANGE. IF1374.2 +055200 F-STD-DEV-TEST-10. IF1374.2 +055300 COMPUTE WS-NUM = IF1374.2 +055400 FUNCTION STANDARD-DEVIATION(0.00032, 0.00019, IF1374.2 +055500 0.00014, -0.06574). IF1374.2 +055600 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +055700 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +055800 PERFORM PASS IF1374.2 +055900 ELSE IF1374.2 +056000 MOVE WS-NUM TO COMPUTED-N IF1374.2 +056100 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +056200 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +056300 PERFORM FAIL. IF1374.2 +056400 GO TO F-STD-DEV-WRITE-10. IF1374.2 +056500 F-STD-DEV-DELETE-10. IF1374.2 +056600 PERFORM DE-LETE. IF1374.2 +056700 GO TO F-STD-DEV-WRITE-10. IF1374.2 +056800 F-STD-DEV-WRITE-10. IF1374.2 +056900 MOVE "F-STD-DEV-10" TO PAR-NAME. IF1374.2 +057000 PERFORM PRINT-DETAIL. IF1374.2 +057100*****************TEST (k) - SIMPLE TEST***************** IF1374.2 +057200 F-STD-DEV-11. IF1374.2 +057300 MOVE ZERO TO WS-NUM. IF1374.2 +057400 MOVE -0.000020 TO MIN-RANGE. IF1374.2 +057500 MOVE 0.000020 TO MAX-RANGE. IF1374.2 +057600 F-STD-DEV-TEST-11. IF1374.2 +057700 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION(A, 5, A). IF1374.2 +057800 IF1374.2 +057900 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +058000 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +058100 PERFORM PASS IF1374.2 +058200 ELSE IF1374.2 +058300 MOVE WS-NUM TO COMPUTED-N IF1374.2 +058400 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +058500 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +058600 PERFORM FAIL. IF1374.2 +058700 GO TO F-STD-DEV-WRITE-11. IF1374.2 +058800 F-STD-DEV-DELETE-11. IF1374.2 +058900 PERFORM DE-LETE. IF1374.2 +059000 GO TO F-STD-DEV-WRITE-11. IF1374.2 +059100 F-STD-DEV-WRITE-11. IF1374.2 +059200 MOVE "F-STD-DEV-11" TO PAR-NAME. IF1374.2 +059300 PERFORM PRINT-DETAIL. IF1374.2 +059400*****************TEST (a) - COMPLEX TEST**************** IF1374.2 +059500 F-STD-DEV-12. IF1374.2 +059600 MOVE ZERO TO WS-NUM. IF1374.2 +059700 MOVE 11.7995 TO MIN-RANGE. IF1374.2 +059800 MOVE 11.8005 TO MAX-RANGE. IF1374.2 +059900 F-STD-DEV-TEST-12. IF1374.2 +060000 COMPUTE WS-NUM = IF1374.2 +060100 FUNCTION STANDARD-DEVIATION(2.6 + 30, 4.5 * 2). IF1374.2 +060200 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +060300 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +060400 PERFORM PASS IF1374.2 +060500 ELSE IF1374.2 +060600 MOVE WS-NUM TO COMPUTED-N IF1374.2 +060700 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +060800 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +060900 PERFORM FAIL. IF1374.2 +061000 GO TO F-STD-DEV-WRITE-12. IF1374.2 +061100 F-STD-DEV-DELETE-12. IF1374.2 +061200 PERFORM DE-LETE. IF1374.2 +061300 GO TO F-STD-DEV-WRITE-12. IF1374.2 +061400 F-STD-DEV-WRITE-12. IF1374.2 +061500 MOVE "F-STD-DEV-12" TO PAR-NAME. IF1374.2 +061600 PERFORM PRINT-DETAIL. IF1374.2 +061700*****************TEST (b) - COMPLEX TEST**************** IF1374.2 +061800 F-STD-DEV-13. IF1374.2 +061900 MOVE ZERO TO WS-NUM. IF1374.2 +062000 MOVE 19.3556 TO MIN-RANGE. IF1374.2 +062100 MOVE 19.3572 TO MAX-RANGE. IF1374.2 +062200 F-STD-DEV-TEST-13. IF1374.2 +062300 COMPUTE WS-NUM = IF1374.2 +062400 FUNCTION STANDARD-DEVIATION(E, 9 * A, 0, B / 2). IF1374.2 +062500 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +062600 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +062700 PERFORM PASS IF1374.2 +062800 ELSE IF1374.2 +062900 MOVE WS-NUM TO COMPUTED-N IF1374.2 +063000 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +063100 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +063200 PERFORM FAIL. IF1374.2 +063300 GO TO F-STD-DEV-WRITE-13. IF1374.2 +063400 F-STD-DEV-DELETE-13. IF1374.2 +063500 PERFORM DE-LETE. IF1374.2 +063600 GO TO F-STD-DEV-WRITE-13. IF1374.2 +063700 F-STD-DEV-WRITE-13. IF1374.2 +063800 MOVE "F-STD-DEV-13" TO PAR-NAME. IF1374.2 +063900 PERFORM PRINT-DETAIL. IF1374.2 +064000*****************TEST (c) - COMPLEX TEST**************** IF1374.2 +064100 F-STD-DEV-14. IF1374.2 +064200 MOVE ZERO TO WS-NUM. IF1374.2 +064300 MOVE 77.9969 TO MIN-RANGE. IF1374.2 +064400 MOVE 78.0031 TO MAX-RANGE. IF1374.2 +064500 F-STD-DEV-TEST-14. IF1374.2 +064600 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION(A) + 78. IF1374.2 +064700 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +064800 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +064900 PERFORM PASS IF1374.2 +065000 ELSE IF1374.2 +065100 MOVE WS-NUM TO COMPUTED-N IF1374.2 +065200 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +065300 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +065400 PERFORM FAIL. IF1374.2 +065500 GO TO F-STD-DEV-WRITE-14. IF1374.2 +065600 F-STD-DEV-DELETE-14. IF1374.2 +065700 PERFORM DE-LETE. IF1374.2 +065800 GO TO F-STD-DEV-WRITE-14. IF1374.2 +065900 F-STD-DEV-WRITE-14. IF1374.2 +066000 MOVE "F-STD-DEV-14" TO PAR-NAME. IF1374.2 +066100 PERFORM PRINT-DETAIL. IF1374.2 +066200*****************TEST (d) - COMPLEX TEST**************** IF1374.2 +066300 F-STD-DEV-15. IF1374.2 +066400 MOVE ZERO TO WS-NUM. IF1374.2 +066500 MOVE 0.99996 TO MIN-RANGE. IF1374.2 +066600 MOVE 1.00004 TO MAX-RANGE. IF1374.2 +066700 F-STD-DEV-TEST-15. IF1374.2 +066800 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION(A, B) + IF1374.2 +066900 FUNCTION STANDARD-DEVIATION(1, 1). IF1374.2 +067000 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +067100 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +067200 PERFORM PASS IF1374.2 +067300 ELSE IF1374.2 +067400 MOVE WS-NUM TO COMPUTED-N IF1374.2 +067500 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +067600 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +067700 PERFORM FAIL. IF1374.2 +067800 GO TO F-STD-DEV-WRITE-15. IF1374.2 +067900 F-STD-DEV-DELETE-15. IF1374.2 +068000 PERFORM DE-LETE. IF1374.2 +068100 GO TO F-STD-DEV-WRITE-15. IF1374.2 +068200 F-STD-DEV-WRITE-15. IF1374.2 +068300 MOVE "F-STD-DEV-15" TO PAR-NAME. IF1374.2 +068400 PERFORM PRINT-DETAIL. IF1374.2 +068500*****************TEST (e) - COMPLEX TEST**************** IF1374.2 +068600 F-STD-DEV-16. IF1374.2 +068700 MOVE ZERO TO WS-NUM. IF1374.2 +068800 MOVE -0.000040 TO MIN-RANGE. IF1374.2 +068900 MOVE 0.000040 TO MAX-RANGE. IF1374.2 +069000 F-STD-DEV-TEST-16. IF1374.2 +069100 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION( IF1374.2 +069200 FUNCTION STANDARD-DEVIATION(0, 0)). IF1374.2 +069300 IF (WS-NUM >= MIN-RANGE) AND IF1374.2 +069400 (WS-NUM <= MAX-RANGE) THEN IF1374.2 +069500 PERFORM PASS IF1374.2 +069600 ELSE IF1374.2 +069700 MOVE WS-NUM TO COMPUTED-N IF1374.2 +069800 MOVE MIN-RANGE TO CORRECT-MIN IF1374.2 +069900 MOVE MAX-RANGE TO CORRECT-MAX IF1374.2 +070000 PERFORM FAIL. IF1374.2 +070100 GO TO F-STD-DEV-WRITE-16. IF1374.2 +070200 F-STD-DEV-DELETE-16. IF1374.2 +070300 PERFORM DE-LETE. IF1374.2 +070400 GO TO F-STD-DEV-WRITE-16. IF1374.2 +070500 F-STD-DEV-WRITE-16. IF1374.2 +070600 MOVE "F-STD-DEV-16" TO PAR-NAME. IF1374.2 +070700 PERFORM PRINT-DETAIL. IF1374.2 +070800*****************SPECIAL PERFORM TEST********************** IF1374.2 +070900 F-STD-DEV-17. IF1374.2 +071000 PERFORM F-STD-DEV-TEST-17 IF1374.2 +071100 UNTIL FUNCTION STANDARD-DEVIATION(1, 1, ARG3) > 1. IF1374.2 +071200 PERFORM PASS. IF1374.2 +071300 GO TO F-STD-DEV-WRITE-17. IF1374.2 +071400 F-STD-DEV-TEST-17. IF1374.2 +071500 COMPUTE ARG3 = ARG3 + 1. IF1374.2 +071600 F-STD-DEV-DELETE-17. IF1374.2 +071700 PERFORM DE-LETE. IF1374.2 +071800 GO TO F-STD-DEV-WRITE-17. IF1374.2 +071900 F-STD-DEV-WRITE-17. IF1374.2 +072000 MOVE "F-STD-DEV-17" TO PAR-NAME. IF1374.2 +072100 PERFORM PRINT-DETAIL. IF1374.2 +072200********************END OF TESTS*************** IF1374.2 +072300 CCVS-EXIT SECTION. IF1374.2 +072400 CCVS-999999. IF1374.2 +072500 GO TO CLOSE-FILES. IF1374.2 diff --git a/tests/cobol85/IF/IF138A.CBL b/tests/cobol85/IF/IF138A.CBL new file mode 100755 index 00000000..56ccfd4e --- /dev/null +++ b/tests/cobol85/IF/IF138A.CBL @@ -0,0 +1,659 @@ +000100 IDENTIFICATION DIVISION. IF1384.2 +000200 PROGRAM-ID. IF1384.2 +000300 IF138A. IF1384.2 +000400 IF1384.2 +000500*********************************************************** IF1384.2 +000600* * IF1384.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1384.2 +000800* It contains tests for the Intrinsic Function SUM . * IF1384.2 +000900* * IF1384.2 +001000*********************************************************** IF1384.2 +001100 ENVIRONMENT DIVISION. IF1384.2 +001200 CONFIGURATION SECTION. IF1384.2 +001300 SOURCE-COMPUTER. IF1384.2 +001400 Linux. IF1384.2 +001500 OBJECT-COMPUTER. IF1384.2 +001600 Linux. IF1384.2 +001700 INPUT-OUTPUT SECTION. IF1384.2 +001800 FILE-CONTROL. IF1384.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1384.2 +002000 "report.log". IF1384.2 +002100 DATA DIVISION. IF1384.2 +002200 FILE SECTION. IF1384.2 +002300 FD PRINT-FILE. IF1384.2 +002400 01 PRINT-REC PICTURE X(120). IF1384.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1384.2 +002600 WORKING-STORAGE SECTION. IF1384.2 +002700*********************************************************** IF1384.2 +002800* Variables specific to the Intrinsic Function Test IF138A* IF1384.2 +002900*********************************************************** IF1384.2 +003000 01 A PIC S9(10) VALUE 5. IF1384.2 +003100 01 B PIC S9(10) VALUE 7. IF1384.2 +003200 01 C PIC S9(10) VALUE -4. IF1384.2 +003300 01 D PIC S9(10) VALUE 10. IF1384.2 +003400 01 E PIC S9(5)V9(5) VALUE 34.26. IF1384.2 +003500 01 F PIC S9(5)V9(5) VALUE -8.32. IF1384.2 +003600 01 G PIC S9(5)V9(5) VALUE 4.08. IF1384.2 +003700 01 H PIC S9(5)V9(5) VALUE -5.3. IF1384.2 +003800 01 M PIC S9(10) VALUE 320000. IF1384.2 +003900 01 N PIC S9(10) VALUE 650000. IF1384.2 +004000 01 O PIC S9(10) VALUE -430000. IF1384.2 +004100 01 P PIC S9(10) VALUE 1. IF1384.2 +004200 01 Q PIC S9(10) VALUE 3. IF1384.2 +004300 01 R PIC S9(10) VALUE 5. IF1384.2 +004400 01 ARG1 PIC S9(10) VALUE 1. IF1384.2 +004500 01 ARR VALUE "40537". IF1384.2 +004600 02 IND OCCURS 5 TIMES PIC 9. IF1384.2 +004700 01 TEMP PIC S9(10)V9(5). IF1384.2 +004800 01 WS-NUM PIC S9(6)V9(7). IF1384.2 +004900 01 MIN-RANGE PIC S9(5)V9(7). IF1384.2 +005000 01 MAX-RANGE PIC S9(5)V9(7). IF1384.2 +005100* IF1384.2 +005200********************************************************** IF1384.2 +005300* IF1384.2 +005400 01 TEST-RESULTS. IF1384.2 +005500 02 FILLER PIC X VALUE SPACE. IF1384.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IF1384.2 +005700 02 FILLER PIC X VALUE SPACE. IF1384.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IF1384.2 +005900 02 FILLER PIC X VALUE SPACE. IF1384.2 +006000 02 PAR-NAME. IF1384.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IF1384.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IF1384.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IF1384.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IF1384.2 +006500 02 RE-MARK PIC X(61). IF1384.2 +006600 01 TEST-COMPUTED. IF1384.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1384.2 +006800 02 FILLER PIC X(17) VALUE IF1384.2 +006900 " COMPUTED=". IF1384.2 +007000 02 COMPUTED-X. IF1384.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1384.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IF1384.2 +007300 PIC -9(9).9(9). IF1384.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1384.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1384.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1384.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IF1384.2 +007800 04 COMPUTED-18V0 PIC -9(18). IF1384.2 +007900 04 FILLER PIC X. IF1384.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IF1384.2 +008100 01 TEST-CORRECT. IF1384.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IF1384.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1384.2 +008400 02 CORRECT-X. IF1384.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1384.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1384.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1384.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1384.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1384.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IF1384.2 +009100 04 CORRECT-18V0 PIC -9(18). IF1384.2 +009200 04 FILLER PIC X. IF1384.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IF1384.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1384.2 +009500 01 TEST-CORRECT-MIN. IF1384.2 +009600 02 FILLER PIC X(30) VALUE SPACE. IF1384.2 +009700 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1384.2 +009800 02 CORRECTMI-X. IF1384.2 +009900 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1384.2 +010000 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1384.2 +010100 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1384.2 +010200 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1384.2 +010300 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1384.2 +010400 03 CR-18V0 REDEFINES CORRECTMI-A. IF1384.2 +010500 04 CORRECTMI-18V0 PIC -9(18). IF1384.2 +010600 04 FILLER PIC X. IF1384.2 +010700 03 FILLER PIC X(2) VALUE SPACE. IF1384.2 +010800 03 FILLER PIC X(48) VALUE SPACE. IF1384.2 +010900 01 TEST-CORRECT-MAX. IF1384.2 +011000 02 FILLER PIC X(30) VALUE SPACE. IF1384.2 +011100 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1384.2 +011200 02 CORRECTMA-X. IF1384.2 +011300 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1384.2 +011400 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1384.2 +011500 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1384.2 +011600 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1384.2 +011700 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1384.2 +011800 03 CR-18V0 REDEFINES CORRECTMA-A. IF1384.2 +011900 04 CORRECTMA-18V0 PIC -9(18). IF1384.2 +012000 04 FILLER PIC X. IF1384.2 +012100 03 FILLER PIC X(2) VALUE SPACE. IF1384.2 +012200 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1384.2 +012300 01 CCVS-C-1. IF1384.2 +012400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1384.2 +012500- "SS PARAGRAPH-NAME IF1384.2 +012600- " REMARKS". IF1384.2 +012700 02 FILLER PIC X(20) VALUE SPACE. IF1384.2 +012800 01 CCVS-C-2. IF1384.2 +012900 02 FILLER PIC X VALUE SPACE. IF1384.2 +013000 02 FILLER PIC X(6) VALUE "TESTED". IF1384.2 +013100 02 FILLER PIC X(15) VALUE SPACE. IF1384.2 +013200 02 FILLER PIC X(4) VALUE "FAIL". IF1384.2 +013300 02 FILLER PIC X(94) VALUE SPACE. IF1384.2 +013400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1384.2 +013500 01 REC-CT PIC 99 VALUE ZERO. IF1384.2 +013600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1384.2 +013700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1384.2 +013800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1384.2 +013900 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1384.2 +014000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1384.2 +014100 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1384.2 +014200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1384.2 +014300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1384.2 +014400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1384.2 +014500 01 CCVS-H-1. IF1384.2 +014600 02 FILLER PIC X(39) VALUE SPACES. IF1384.2 +014700 02 FILLER PIC X(42) VALUE IF1384.2 +014800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1384.2 +014900 02 FILLER PIC X(39) VALUE SPACES. IF1384.2 +015000 01 CCVS-H-2A. IF1384.2 +015100 02 FILLER PIC X(40) VALUE SPACE. IF1384.2 +015200 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1384.2 +015300 02 FILLER PIC XXXX VALUE IF1384.2 +015400 "4.2 ". IF1384.2 +015500 02 FILLER PIC X(28) VALUE IF1384.2 +015600 " COPY - NOT FOR DISTRIBUTION". IF1384.2 +015700 02 FILLER PIC X(41) VALUE SPACE. IF1384.2 +015800 IF1384.2 +015900 01 CCVS-H-2B. IF1384.2 +016000 02 FILLER PIC X(15) VALUE IF1384.2 +016100 "TEST RESULT OF ". IF1384.2 +016200 02 TEST-ID PIC X(9). IF1384.2 +016300 02 FILLER PIC X(4) VALUE IF1384.2 +016400 " IN ". IF1384.2 +016500 02 FILLER PIC X(12) VALUE IF1384.2 +016600 " HIGH ". IF1384.2 +016700 02 FILLER PIC X(22) VALUE IF1384.2 +016800 " LEVEL VALIDATION FOR ". IF1384.2 +016900 02 FILLER PIC X(58) VALUE IF1384.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1384.2 +017100 01 CCVS-H-3. IF1384.2 +017200 02 FILLER PIC X(34) VALUE IF1384.2 +017300 " FOR OFFICIAL USE ONLY ". IF1384.2 +017400 02 FILLER PIC X(58) VALUE IF1384.2 +017500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1384.2 +017600 02 FILLER PIC X(28) VALUE IF1384.2 +017700 " COPYRIGHT 1985 ". IF1384.2 +017800 01 CCVS-E-1. IF1384.2 +017900 02 FILLER PIC X(52) VALUE SPACE. IF1384.2 +018000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1384.2 +018100 02 ID-AGAIN PIC X(9). IF1384.2 +018200 02 FILLER PIC X(45) VALUE SPACES. IF1384.2 +018300 01 CCVS-E-2. IF1384.2 +018400 02 FILLER PIC X(31) VALUE SPACE. IF1384.2 +018500 02 FILLER PIC X(21) VALUE SPACE. IF1384.2 +018600 02 CCVS-E-2-2. IF1384.2 +018700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1384.2 +018800 03 FILLER PIC X VALUE SPACE. IF1384.2 +018900 03 ENDER-DESC PIC X(44) VALUE IF1384.2 +019000 "ERRORS ENCOUNTERED". IF1384.2 +019100 01 CCVS-E-3. IF1384.2 +019200 02 FILLER PIC X(22) VALUE IF1384.2 +019300 " FOR OFFICIAL USE ONLY". IF1384.2 +019400 02 FILLER PIC X(12) VALUE SPACE. IF1384.2 +019500 02 FILLER PIC X(58) VALUE IF1384.2 +019600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1384.2 +019700 02 FILLER PIC X(13) VALUE SPACE. IF1384.2 +019800 02 FILLER PIC X(15) VALUE IF1384.2 +019900 " COPYRIGHT 1985". IF1384.2 +020000 01 CCVS-E-4. IF1384.2 +020100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1384.2 +020200 02 FILLER PIC X(4) VALUE " OF ". IF1384.2 +020300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1384.2 +020400 02 FILLER PIC X(40) VALUE IF1384.2 +020500 " TESTS WERE EXECUTED SUCCESSFULLY". IF1384.2 +020600 01 XXINFO. IF1384.2 +020700 02 FILLER PIC X(19) VALUE IF1384.2 +020800 "*** INFORMATION ***". IF1384.2 +020900 02 INFO-TEXT. IF1384.2 +021000 04 FILLER PIC X(8) VALUE SPACE. IF1384.2 +021100 04 XXCOMPUTED PIC X(20). IF1384.2 +021200 04 FILLER PIC X(5) VALUE SPACE. IF1384.2 +021300 04 XXCORRECT PIC X(20). IF1384.2 +021400 02 INF-ANSI-REFERENCE PIC X(48). IF1384.2 +021500 01 HYPHEN-LINE. IF1384.2 +021600 02 FILLER PIC IS X VALUE IS SPACE. IF1384.2 +021700 02 FILLER PIC IS X(65) VALUE IS "************************IF1384.2 +021800- "*****************************************". IF1384.2 +021900 02 FILLER PIC IS X(54) VALUE IS "************************IF1384.2 +022000- "******************************". IF1384.2 +022100 01 CCVS-PGM-ID PIC X(9) VALUE IF1384.2 +022200 "IF138A". IF1384.2 +022300 PROCEDURE DIVISION. IF1384.2 +022400 CCVS1 SECTION. IF1384.2 +022500 OPEN-FILES. IF1384.2 +022600 OPEN OUTPUT PRINT-FILE. IF1384.2 +022700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1384.2 +022800 MOVE SPACE TO TEST-RESULTS. IF1384.2 +022900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1384.2 +023000 GO TO CCVS1-EXIT. IF1384.2 +023100 CLOSE-FILES. IF1384.2 +023200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1384.2 +023300 TERMINATE-CCVS. IF1384.2 +023400 STOP RUN. IF1384.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1384.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1384.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1384.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1384.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. IF1384.2 +024000 PRINT-DETAIL. IF1384.2 +024100 IF REC-CT NOT EQUAL TO ZERO IF1384.2 +024200 MOVE "." TO PARDOT-X IF1384.2 +024300 MOVE REC-CT TO DOTVALUE. IF1384.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1384.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1384.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1384.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1384.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1384.2 +024900 MOVE SPACE TO CORRECT-X. IF1384.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1384.2 +025100 MOVE SPACE TO RE-MARK. IF1384.2 +025200 HEAD-ROUTINE. IF1384.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1384.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1384.2 +025700 COLUMN-NAMES-ROUTINE. IF1384.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +026100 END-ROUTINE. IF1384.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1384.2 +026300 END-RTN-EXIT. IF1384.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +026500 END-ROUTINE-1. IF1384.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1384.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1384.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. IF1384.2 +026900 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1384.2 +027000 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1384.2 +027100 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1384.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1384.2 +027300 END-ROUTINE-12. IF1384.2 +027400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1384.2 +027500 IF ERROR-COUNTER IS EQUAL TO ZERO IF1384.2 +027600 MOVE "NO " TO ERROR-TOTAL IF1384.2 +027700 ELSE IF1384.2 +027800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1384.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1384.2 +028000 PERFORM WRITE-LINE. IF1384.2 +028100 END-ROUTINE-13. IF1384.2 +028200 IF DELETE-COUNTER IS EQUAL TO ZERO IF1384.2 +028300 MOVE "NO " TO ERROR-TOTAL ELSE IF1384.2 +028400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1384.2 +028500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1384.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +028700 IF INSPECT-COUNTER EQUAL TO ZERO IF1384.2 +028800 MOVE "NO " TO ERROR-TOTAL IF1384.2 +028900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1384.2 +029000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1384.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +029200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1384.2 +029300 WRITE-LINE. IF1384.2 +029400 ADD 1 TO RECORD-COUNT. IF1384.2 +029500 IF RECORD-COUNT GREATER 42 IF1384.2 +029600 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1384.2 +029700 MOVE SPACE TO DUMMY-RECORD IF1384.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1384.2 +029900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1384.2 +030000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1384.2 +030100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1384.2 +030200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1384.2 +030300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1384.2 +030400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1384.2 +030500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1384.2 +030600 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1384.2 +030700 MOVE ZERO TO RECORD-COUNT. IF1384.2 +030800 PERFORM WRT-LN. IF1384.2 +030900 WRT-LN. IF1384.2 +031000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1384.2 +031100 MOVE SPACE TO DUMMY-RECORD. IF1384.2 +031200 BLANK-LINE-PRINT. IF1384.2 +031300 PERFORM WRT-LN. IF1384.2 +031400 FAIL-ROUTINE. IF1384.2 +031500 IF COMPUTED-X NOT EQUAL TO SPACE IF1384.2 +031600 GO TO FAIL-ROUTINE-WRITE. IF1384.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1384.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1384.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1384.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. IF1384.2 +032200 GO TO FAIL-ROUTINE-EX. IF1384.2 +032300 FAIL-ROUTINE-WRITE. IF1384.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1384.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1384.2 +032600 CORMA-ANSI-REFERENCE. IF1384.2 +032700 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1384.2 +032800 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1384.2 +032900 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1384.2 +033000 ELSE IF1384.2 +033100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1384.2 +033200 PERFORM WRITE-LINE. IF1384.2 +033300 MOVE SPACES TO COR-ANSI-REFERENCE. IF1384.2 +033400 FAIL-ROUTINE-EX. EXIT. IF1384.2 +033500 BAIL-OUT. IF1384.2 +033600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1384.2 +033700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1384.2 +033800 BAIL-OUT-WRITE. IF1384.2 +033900 MOVE CORRECT-A TO XXCORRECT. IF1384.2 +034000 MOVE COMPUTED-A TO XXCOMPUTED. IF1384.2 +034100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1384.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1384.2 +034300 MOVE SPACES TO INF-ANSI-REFERENCE. IF1384.2 +034400 BAIL-OUT-EX. EXIT. IF1384.2 +034500 CCVS1-EXIT. IF1384.2 +034600 EXIT. IF1384.2 +034700******************************************************** IF1384.2 +034800* * IF1384.2 +034900* Intrinsic Function Tests IF138A - SUM * IF1384.2 +035000* * IF1384.2 +035100******************************************************** IF1384.2 +035200 SECT-IF138A SECTION. IF1384.2 +035300 F-SUM-INFO. IF1384.2 +035400 MOVE "See ref. A-69 2.40" TO ANSI-REFERENCE. IF1384.2 +035500 MOVE "SUM Function" TO FEATURE. IF1384.2 +035600*****************TEST (a) - SIMPLE TEST***************** IF1384.2 +035700 F-SUM-01. IF1384.2 +035800 MOVE ZERO TO WS-NUM. IF1384.2 +035900 F-SUM-TEST-01. IF1384.2 +036000 COMPUTE WS-NUM = FUNCTION SUM(5, -2, -14, 0). IF1384.2 +036100 IF WS-NUM = -11 THEN IF1384.2 +036200 PERFORM PASS IF1384.2 +036300 ELSE IF1384.2 +036400 MOVE WS-NUM TO COMPUTED-N IF1384.2 +036500 MOVE -11 TO CORRECT-N IF1384.2 +036600 PERFORM FAIL. IF1384.2 +036700 GO TO F-SUM-WRITE-01. IF1384.2 +036800 F-SUM-DELETE-01. IF1384.2 +036900 PERFORM DE-LETE. IF1384.2 +037000 GO TO F-SUM-WRITE-01. IF1384.2 +037100 F-SUM-WRITE-01. IF1384.2 +037200 MOVE "F-SUM-01" TO PAR-NAME. IF1384.2 +037300 PERFORM PRINT-DETAIL. IF1384.2 +037400*****************TEST (b) - SIMPLE TEST***************** IF1384.2 +037500 F-SUM-02. IF1384.2 +037600 EVALUATE FUNCTION SUM(3.9, -0.3, 8.7, 100.2) IF1384.2 +037700 WHEN 112.498 THRU 122.502 IF1384.2 +037800 PERFORM PASS IF1384.2 +037900 WHEN OTHER IF1384.2 +038000 PERFORM FAIL. IF1384.2 +038100 GO TO F-SUM-WRITE-02. IF1384.2 +038200 F-SUM-DELETE-02. IF1384.2 +038300 PERFORM DE-LETE. IF1384.2 +038400 GO TO F-SUM-WRITE-02. IF1384.2 +038500 F-SUM-WRITE-02. IF1384.2 +038600 MOVE "F-SUM-02" TO PAR-NAME. IF1384.2 +038700 PERFORM PRINT-DETAIL. IF1384.2 +038800*****************TEST (c) - SIMPLE TEST***************** IF1384.2 +038900 F-SUM-03. IF1384.2 +039000 IF FUNCTION SUM(A, B, C, D) = 18 THEN IF1384.2 +039100 PERFORM PASS IF1384.2 +039200 ELSE IF1384.2 +039300 PERFORM FAIL. IF1384.2 +039400 GO TO F-SUM-WRITE-03. IF1384.2 +039500 F-SUM-DELETE-03. IF1384.2 +039600 PERFORM DE-LETE. IF1384.2 +039700 GO TO F-SUM-WRITE-03. IF1384.2 +039800 F-SUM-WRITE-03. IF1384.2 +039900 MOVE "F-SUM-03" TO PAR-NAME. IF1384.2 +040000 PERFORM PRINT-DETAIL. IF1384.2 +040100*****************TEST (d) - SIMPLE TEST***************** IF1384.2 +040200 F-SUM-04. IF1384.2 +040300 MOVE ZERO TO WS-NUM. IF1384.2 +040400 F-SUM-TEST-04. IF1384.2 +040500 COMPUTE WS-NUM = FUNCTION SUM(E, F, G, H). IF1384.2 +040600 IF (WS-NUM >= 24.7195) AND IF1384.2 +040700 (WS-NUM <= 24.7205) IF1384.2 +040800 PERFORM PASS IF1384.2 +040900 ELSE IF1384.2 +041000 MOVE WS-NUM TO COMPUTED-N IF1384.2 +041100 MOVE 24.72 TO CORRECT-N IF1384.2 +041200 PERFORM FAIL. IF1384.2 +041300 GO TO F-SUM-WRITE-04. IF1384.2 +041400 F-SUM-DELETE-04. IF1384.2 +041500 PERFORM DE-LETE. IF1384.2 +041600 GO TO F-SUM-WRITE-04. IF1384.2 +041700 F-SUM-WRITE-04. IF1384.2 +041800 MOVE "F-SUM-04" TO PAR-NAME. IF1384.2 +041900 PERFORM PRINT-DETAIL. IF1384.2 +042000*****************TEST (e) - SIMPLE TEST***************** IF1384.2 +042100 F-SUM-05. IF1384.2 +042200 MOVE ZERO TO WS-NUM. IF1384.2 +042300 F-SUM-TEST-05. IF1384.2 +042400 COMPUTE WS-NUM = FUNCTION SUM(10.2, -0.2, 5.6, -15.6). IF1384.2 +042500 IF (WS-NUM >= -0.000020) AND IF1384.2 +042600 (WS-NUM <= 0.000020) IF1384.2 +042700 PERFORM PASS IF1384.2 +042800 ELSE IF1384.2 +042900 MOVE WS-NUM TO COMPUTED-N IF1384.2 +043000 MOVE 0 TO CORRECT-N IF1384.2 +043100 PERFORM FAIL. IF1384.2 +043200 GO TO F-SUM-WRITE-05. IF1384.2 +043300 F-SUM-DELETE-05. IF1384.2 +043400 PERFORM DE-LETE. IF1384.2 +043500 GO TO F-SUM-WRITE-05. IF1384.2 +043600 F-SUM-WRITE-05. IF1384.2 +043700 MOVE "F-SUM-05" TO PAR-NAME. IF1384.2 +043800 PERFORM PRINT-DETAIL. IF1384.2 +043900*****************TEST (f) - SIMPLE TEST***************** IF1384.2 +044000 F-SUM-06. IF1384.2 +044100 MOVE ZERO TO WS-NUM. IF1384.2 +044200 F-SUM-TEST-06. IF1384.2 +044300 COMPUTE WS-NUM = FUNCTION SUM(A, B, C, D, E, F, G, H). IF1384.2 +044400 IF (WS-NUM >= 42.7191) AND IF1384.2 +044500 (WS-NUM <= 42.7209) IF1384.2 +044600 PERFORM PASS IF1384.2 +044700 ELSE IF1384.2 +044800 MOVE WS-NUM TO COMPUTED-N IF1384.2 +044900 MOVE 42.72 TO CORRECT-N IF1384.2 +045000 PERFORM FAIL. IF1384.2 +045100 GO TO F-SUM-WRITE-06. IF1384.2 +045200 F-SUM-DELETE-06. IF1384.2 +045300 PERFORM DE-LETE. IF1384.2 +045400 GO TO F-SUM-WRITE-06. IF1384.2 +045500 F-SUM-WRITE-06. IF1384.2 +045600 MOVE "F-SUM-06" TO PAR-NAME. IF1384.2 +045700 PERFORM PRINT-DETAIL. IF1384.2 +045800*****************TEST (g) - SIMPLE TEST***************** IF1384.2 +045900 F-SUM-07. IF1384.2 +046000 MOVE ZERO TO WS-NUM. IF1384.2 +046100 F-SUM-TEST-07. IF1384.2 +046200 COMPUTE WS-NUM = FUNCTION SUM(IND(1), IND(2), IND(3)). IF1384.2 +046300 IF WS-NUM = 9 THEN IF1384.2 +046400 PERFORM PASS IF1384.2 +046500 ELSE IF1384.2 +046600 MOVE WS-NUM TO COMPUTED-N IF1384.2 +046700 MOVE 9 TO CORRECT-N IF1384.2 +046800 PERFORM FAIL. IF1384.2 +046900 GO TO F-SUM-WRITE-07. IF1384.2 +047000 F-SUM-DELETE-07. IF1384.2 +047100 PERFORM DE-LETE. IF1384.2 +047200 GO TO F-SUM-WRITE-07. IF1384.2 +047300 F-SUM-WRITE-07. IF1384.2 +047400 MOVE "F-SUM-07" TO PAR-NAME. IF1384.2 +047500 PERFORM PRINT-DETAIL. IF1384.2 +047600*****************TEST (h) - SIMPLE TEST***************** IF1384.2 +047700 F-SUM-08. IF1384.2 +047800 MOVE ZERO TO WS-NUM. IF1384.2 +047900 F-SUM-TEST-08. IF1384.2 +048000 COMPUTE WS-NUM = FUNCTION SUM(IND(P), IND(Q), IND(R)). IF1384.2 +048100 IF WS-NUM = 16 THEN IF1384.2 +048200 PERFORM PASS IF1384.2 +048300 ELSE IF1384.2 +048400 MOVE WS-NUM TO COMPUTED-N IF1384.2 +048500 MOVE 16 TO CORRECT-N IF1384.2 +048600 PERFORM FAIL. IF1384.2 +048700 GO TO F-SUM-WRITE-08. IF1384.2 +048800 F-SUM-DELETE-08. IF1384.2 +048900 PERFORM DE-LETE. IF1384.2 +049000 GO TO F-SUM-WRITE-08. IF1384.2 +049100 F-SUM-WRITE-08. IF1384.2 +049200 MOVE "F-SUM-08" TO PAR-NAME. IF1384.2 +049300 PERFORM PRINT-DETAIL. IF1384.2 +049400*****************TEST (i) - SIMPLE TEST***************** IF1384.2 +049500 F-SUM-09. IF1384.2 +049600 MOVE ZERO TO WS-NUM. IF1384.2 +049700 F-SUM-TEST-09. IF1384.2 +rogerw COMPUTE WS-NUM = FUNCTION SUM (4 0 5 3 7). +049900 IF WS-NUM = 19 THEN IF1384.2 +050000 PERFORM PASS IF1384.2 +050100 ELSE IF1384.2 +050200 MOVE WS-NUM TO COMPUTED-N IF1384.2 +050300 MOVE 19 TO CORRECT-N IF1384.2 +050400 PERFORM FAIL. IF1384.2 +050500 GO TO F-SUM-WRITE-09. IF1384.2 +050600 F-SUM-DELETE-09. IF1384.2 +050700 PERFORM DE-LETE. IF1384.2 +050800 GO TO F-SUM-WRITE-09. IF1384.2 +050900 F-SUM-WRITE-09. IF1384.2 +051000 MOVE "F-SUM-09" TO PAR-NAME. IF1384.2 +051100 PERFORM PRINT-DETAIL. IF1384.2 +051200*****************TEST (k) - SIMPLE TEST***************** IF1384.2 +051300 F-SUM-11. IF1384.2 +051400 MOVE ZERO TO WS-NUM. IF1384.2 +051500 F-SUM-TEST-11. IF1384.2 +051600 COMPUTE WS-NUM = FUNCTION SUM(M, N, O). IF1384.2 +051700 IF WS-NUM = 540000 THEN IF1384.2 +051800 PERFORM PASS IF1384.2 +051900 ELSE IF1384.2 +052000 MOVE WS-NUM TO COMPUTED-N IF1384.2 +052100 MOVE 540000 TO CORRECT-N IF1384.2 +052200 PERFORM FAIL. IF1384.2 +052300 GO TO F-SUM-WRITE-11. IF1384.2 +052400 F-SUM-DELETE-11. IF1384.2 +052500 PERFORM DE-LETE. IF1384.2 +052600 GO TO F-SUM-WRITE-11. IF1384.2 +052700 F-SUM-WRITE-11. IF1384.2 +052800 MOVE "F-SUM-11" TO PAR-NAME. IF1384.2 +052900 PERFORM PRINT-DETAIL. IF1384.2 +053000*****************TEST (a) - COMPLEX TEST**************** IF1384.2 +053100 F-SUM-12. IF1384.2 +053200 MOVE ZERO TO WS-NUM. IF1384.2 +053300 MOVE 41.5992 TO MIN-RANGE. IF1384.2 +053400 MOVE 41.6008 TO MAX-RANGE. IF1384.2 +053500 F-SUM-TEST-12. IF1384.2 +053600 COMPUTE WS-NUM = FUNCTION SUM(2.6 + 30, 4.5 * 2). IF1384.2 +053700 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +053800 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +053900 PERFORM PASS IF1384.2 +054000 ELSE IF1384.2 +054100 MOVE WS-NUM TO COMPUTED-N IF1384.2 +054200 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +054300 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +054400 PERFORM FAIL. IF1384.2 +054500 GO TO F-SUM-WRITE-12. IF1384.2 +054600 F-SUM-DELETE-12. IF1384.2 +054700 PERFORM DE-LETE. IF1384.2 +054800 GO TO F-SUM-WRITE-12. IF1384.2 +054900 F-SUM-WRITE-12. IF1384.2 +055000 MOVE "F-SUM-12" TO PAR-NAME. IF1384.2 +055100 PERFORM PRINT-DETAIL. IF1384.2 +055200*****************TEST (b) - COMPLEX TEST**************** IF1384.2 +055300 F-SUM-13. IF1384.2 +055400 MOVE ZERO TO WS-NUM. IF1384.2 +055500 MOVE 82.7583 TO MIN-RANGE. IF1384.2 +055600 MOVE 82.7616 TO MAX-RANGE. IF1384.2 +055700 F-SUM-TEST-13. IF1384.2 +055800 COMPUTE WS-NUM = FUNCTION SUM(E, 9 * A, B / 2). IF1384.2 +055900 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +056000 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +056100 PERFORM PASS IF1384.2 +056200 ELSE IF1384.2 +056300 MOVE WS-NUM TO COMPUTED-N IF1384.2 +056400 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +056500 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +056600 PERFORM FAIL. IF1384.2 +056700 GO TO F-SUM-WRITE-13. IF1384.2 +056800 F-SUM-DELETE-13. IF1384.2 +056900 PERFORM DE-LETE. IF1384.2 +057000 GO TO F-SUM-WRITE-13. IF1384.2 +057100 F-SUM-WRITE-13. IF1384.2 +057200 MOVE "F-SUM-13" TO PAR-NAME. IF1384.2 +057300 PERFORM PRINT-DETAIL. IF1384.2 +057400*****************TEST (c) - COMPLEX TEST**************** IF1384.2 +057500 F-SUM-14. IF1384.2 +057600 MOVE ZERO TO WS-NUM. IF1384.2 +057700 MOVE 89.9982 TO MIN-RANGE. IF1384.2 +057800 MOVE 90.0018 TO MAX-RANGE. IF1384.2 +057900 F-SUM-TEST-14. IF1384.2 +058000 COMPUTE WS-NUM = FUNCTION SUM(A, B) + 78. IF1384.2 +058100 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +058200 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +058300 PERFORM PASS IF1384.2 +058400 ELSE IF1384.2 +058500 MOVE WS-NUM TO COMPUTED-N IF1384.2 +058600 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +058700 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +058800 PERFORM FAIL. IF1384.2 +058900 GO TO F-SUM-WRITE-14. IF1384.2 +059000 F-SUM-DELETE-14. IF1384.2 +059100 PERFORM DE-LETE. IF1384.2 +059200 GO TO F-SUM-WRITE-14. IF1384.2 +059300 F-SUM-WRITE-14. IF1384.2 +059400 MOVE "F-SUM-14" TO PAR-NAME. IF1384.2 +059500 PERFORM PRINT-DETAIL. IF1384.2 +059600*****************TEST (d) - COMPLEX TEST**************** IF1384.2 +059700 F-SUM-15. IF1384.2 +059800 MOVE ZERO TO WS-NUM. IF1384.2 +059900 MOVE 4.99990 TO MIN-RANGE. IF1384.2 +060000 MOVE 5.00010 TO MAX-RANGE. IF1384.2 +060100 F-SUM-TEST-15. IF1384.2 +060200 COMPUTE WS-NUM = FUNCTION SUM(A, B) + IF1384.2 +060300 FUNCTION SUM(-2.6, -4.4). IF1384.2 +060400 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +060500 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +060600 PERFORM PASS IF1384.2 +060700 ELSE IF1384.2 +060800 MOVE WS-NUM TO COMPUTED-N IF1384.2 +060900 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +061000 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +061100 PERFORM FAIL. IF1384.2 +061200 GO TO F-SUM-WRITE-15. IF1384.2 +061300 F-SUM-DELETE-15. IF1384.2 +061400 PERFORM DE-LETE. IF1384.2 +061500 GO TO F-SUM-WRITE-15. IF1384.2 +061600 F-SUM-WRITE-15. IF1384.2 +061700 MOVE "F-SUM-15" TO PAR-NAME. IF1384.2 +061800 PERFORM PRINT-DETAIL. IF1384.2 +061900*****************TEST (e) - COMPLEX TEST**************** IF1384.2 +062000 F-SUM-16. IF1384.2 +062100 MOVE ZERO TO WS-NUM. IF1384.2 +062200 MOVE 3.99992 TO MIN-RANGE. IF1384.2 +062300 MOVE 4.00008 TO MAX-RANGE. IF1384.2 +062400 F-SUM-TEST-16. IF1384.2 +062500 COMPUTE WS-NUM = IF1384.2 +062600 FUNCTION SUM(FUNCTION SUM(6.8, -6.8), 4). IF1384.2 +062700 IF (WS-NUM >= MIN-RANGE) AND IF1384.2 +062800 (WS-NUM <= MAX-RANGE) THEN IF1384.2 +062900 PERFORM PASS IF1384.2 +063000 ELSE IF1384.2 +063100 MOVE WS-NUM TO COMPUTED-N IF1384.2 +063200 MOVE MIN-RANGE TO CORRECT-MIN IF1384.2 +063300 MOVE MAX-RANGE TO CORRECT-MAX IF1384.2 +063400 PERFORM FAIL. IF1384.2 +063500 GO TO F-SUM-WRITE-16. IF1384.2 +063600 F-SUM-DELETE-16. IF1384.2 +063700 PERFORM DE-LETE. IF1384.2 +063800 GO TO F-SUM-WRITE-16. IF1384.2 +063900 F-SUM-WRITE-16. IF1384.2 +064000 MOVE "F-SUM-16" TO PAR-NAME. IF1384.2 +064100 PERFORM PRINT-DETAIL. IF1384.2 +064200*****************SPECIAL PERFORM TEST********************** IF1384.2 +064300 F-SUM-17. IF1384.2 +064400 PERFORM F-SUM-TEST-17 IF1384.2 +064500 UNTIL FUNCTION SUM(ARG1, 1) > 10. IF1384.2 +064600 PERFORM PASS. IF1384.2 +064700 GO TO F-SUM-WRITE-17. IF1384.2 +064800 F-SUM-TEST-17. IF1384.2 +064900 COMPUTE ARG1 = ARG1 + 1. IF1384.2 +065000 F-SUM-DELETE-17. IF1384.2 +065100 PERFORM DE-LETE. IF1384.2 +065200 GO TO F-SUM-WRITE-17. IF1384.2 +065300 F-SUM-WRITE-17. IF1384.2 +065400 MOVE "F-SUM-17" TO PAR-NAME. IF1384.2 +065500 PERFORM PRINT-DETAIL. IF1384.2 +065600********************END OF TESTS*************** IF1384.2 +065700 CCVS-EXIT SECTION. IF1384.2 +065800 CCVS-999999. IF1384.2 +065900 GO TO CLOSE-FILES. IF1384.2 diff --git a/tests/cobol85/IF/IF139A.CBL b/tests/cobol85/IF/IF139A.CBL new file mode 100755 index 00000000..d22da6c1 --- /dev/null +++ b/tests/cobol85/IF/IF139A.CBL @@ -0,0 +1,992 @@ +000100 IDENTIFICATION DIVISION. IF1394.2 +000200 PROGRAM-ID. IF1394.2 +000300 IF139A. IF1394.2 +000400 IF1394.2 +000500*********************************************************** IF1394.2 +000600* * IF1394.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1394.2 +000800* It contains tests for the Intrinsic Function TAN. * IF1394.2 +000900* * IF1394.2 +001000*********************************************************** IF1394.2 +001100 ENVIRONMENT DIVISION. IF1394.2 +001200 CONFIGURATION SECTION. IF1394.2 +001300 SOURCE-COMPUTER. IF1394.2 +001400 Linux. IF1394.2 +001500 OBJECT-COMPUTER. IF1394.2 +001600 Linux. IF1394.2 +001700 INPUT-OUTPUT SECTION. IF1394.2 +001800 FILE-CONTROL. IF1394.2 +001900 SELECT PRINT-FILE ASSIGN TO IF1394.2 +002000 "report.log". IF1394.2 +002100 DATA DIVISION. IF1394.2 +002200 FILE SECTION. IF1394.2 +002300 FD PRINT-FILE. IF1394.2 +002400 01 PRINT-REC PICTURE X(120). IF1394.2 +002500 01 DUMMY-RECORD PICTURE X(120). IF1394.2 +002600 WORKING-STORAGE SECTION. IF1394.2 +002700*********************************************************** IF1394.2 +002800* Variables specific to the Intrinsic Function Test IF139A* IF1394.2 +002900*********************************************************** IF1394.2 +003000 01 A PIC S9(5)V9(5) VALUE -0.00004. IF1394.2 +003100 01 B PIC S9(5)V9(5) VALUE 14000.105. IF1394.2 +003200 01 C PIC S9(10) VALUE 100000. IF1394.2 +003300 01 D PIC S9(10) VALUE 1000. IF1394.2 +003400 01 PI PIC S9V9(17) VALUE 3.141592654. IF1394.2 +003500 01 MINUSPI PIC S9V9(17) VALUE -3.141592654. IF1394.2 +003600 01 P PIC S9(10) VALUE 1. IF1394.2 +003700 01 ARR VALUE "40537". IF1394.2 +003800 02 IND OCCURS 5 TIMES PIC 9. IF1394.2 +003900 01 TEMP PIC S9(5)V9(5). IF1394.2 +004000 01 WS-NUM PIC S9(5)V9(7). IF1394.2 +004100 01 MIN-RANGE PIC S9(5)V9(7). IF1394.2 +004200 01 MAX-RANGE PIC S9(5)V9(7). IF1394.2 +004300 01 ARG1 PIC S9(5)V9(2) VALUE 1. IF1394.2 +004400* IF1394.2 +004500********************************************************** IF1394.2 +004600* IF1394.2 +004700 01 TEST-RESULTS. IF1394.2 +004800 02 FILLER PIC X VALUE SPACE. IF1394.2 +004900 02 FEATURE PIC X(20) VALUE SPACE. IF1394.2 +005000 02 FILLER PIC X VALUE SPACE. IF1394.2 +005100 02 P-OR-F PIC X(5) VALUE SPACE. IF1394.2 +005200 02 FILLER PIC X VALUE SPACE. IF1394.2 +005300 02 PAR-NAME. IF1394.2 +005400 03 FILLER PIC X(19) VALUE SPACE. IF1394.2 +005500 03 PARDOT-X PIC X VALUE SPACE. IF1394.2 +005600 03 DOTVALUE PIC 99 VALUE ZERO. IF1394.2 +005700 02 FILLER PIC X(8) VALUE SPACE. IF1394.2 +005800 02 RE-MARK PIC X(61). IF1394.2 +005900 01 TEST-COMPUTED. IF1394.2 +006000 02 FILLER PIC X(30) VALUE SPACE. IF1394.2 +006100 02 FILLER PIC X(17) VALUE IF1394.2 +006200 " COMPUTED=". IF1394.2 +006300 02 COMPUTED-X. IF1394.2 +006400 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1394.2 +006500 03 COMPUTED-N REDEFINES COMPUTED-A IF1394.2 +006600 PIC -9(9).9(9). IF1394.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1394.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1394.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1394.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. IF1394.2 +007100 04 COMPUTED-18V0 PIC -9(18). IF1394.2 +007200 04 FILLER PIC X. IF1394.2 +007300 03 FILLER PIC X(50) VALUE SPACE. IF1394.2 +007400 01 TEST-CORRECT. IF1394.2 +007500 02 FILLER PIC X(30) VALUE SPACE. IF1394.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". IF1394.2 +007700 02 CORRECT-X. IF1394.2 +007800 03 CORRECT-A PIC X(20) VALUE SPACE. IF1394.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1394.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1394.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1394.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1394.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. IF1394.2 +008400 04 CORRECT-18V0 PIC -9(18). IF1394.2 +008500 04 FILLER PIC X. IF1394.2 +008600 03 FILLER PIC X(2) VALUE SPACE. IF1394.2 +008700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1394.2 +008800 01 TEST-CORRECT-MIN. IF1394.2 +008900 02 FILLER PIC X(30) VALUE SPACE. IF1394.2 +009000 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1394.2 +009100 02 CORRECTMI-X. IF1394.2 +009200 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1394.2 +009300 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1394.2 +009400 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1394.2 +009500 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1394.2 +009600 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1394.2 +009700 03 CR-18V0 REDEFINES CORRECTMI-A. IF1394.2 +009800 04 CORRECTMI-18V0 PIC -9(18). IF1394.2 +009900 04 FILLER PIC X. IF1394.2 +010000 03 FILLER PIC X(2) VALUE SPACE. IF1394.2 +010100 03 FILLER PIC X(48) VALUE SPACE. IF1394.2 +010200 01 TEST-CORRECT-MAX. IF1394.2 +010300 02 FILLER PIC X(30) VALUE SPACE. IF1394.2 +010400 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1394.2 +010500 02 CORRECTMA-X. IF1394.2 +010600 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1394.2 +010700 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1394.2 +010800 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1394.2 +010900 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1394.2 +011000 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1394.2 +011100 03 CR-18V0 REDEFINES CORRECTMA-A. IF1394.2 +011200 04 CORRECTMA-18V0 PIC -9(18). IF1394.2 +011300 04 FILLER PIC X. IF1394.2 +011400 03 FILLER PIC X(2) VALUE SPACE. IF1394.2 +011500 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1394.2 +011600 01 CCVS-C-1. IF1394.2 +011700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1394.2 +011800- "SS PARAGRAPH-NAME IF1394.2 +011900- " REMARKS". IF1394.2 +012000 02 FILLER PIC X(20) VALUE SPACE. IF1394.2 +012100 01 CCVS-C-2. IF1394.2 +012200 02 FILLER PIC X VALUE SPACE. IF1394.2 +012300 02 FILLER PIC X(6) VALUE "TESTED". IF1394.2 +012400 02 FILLER PIC X(15) VALUE SPACE. IF1394.2 +012500 02 FILLER PIC X(4) VALUE "FAIL". IF1394.2 +012600 02 FILLER PIC X(94) VALUE SPACE. IF1394.2 +012700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1394.2 +012800 01 REC-CT PIC 99 VALUE ZERO. IF1394.2 +012900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1394.2 +013000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1394.2 +013100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1394.2 +013200 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1394.2 +013300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1394.2 +013400 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1394.2 +013500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1394.2 +013600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1394.2 +013700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1394.2 +013800 01 CCVS-H-1. IF1394.2 +013900 02 FILLER PIC X(39) VALUE SPACES. IF1394.2 +014000 02 FILLER PIC X(42) VALUE IF1394.2 +014100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1394.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1394.2 +014300 01 CCVS-H-2A. IF1394.2 +014400 02 FILLER PIC X(40) VALUE SPACE. IF1394.2 +014500 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1394.2 +014600 02 FILLER PIC XXXX VALUE IF1394.2 +014700 "4.2 ". IF1394.2 +014800 02 FILLER PIC X(28) VALUE IF1394.2 +014900 " COPY - NOT FOR DISTRIBUTION". IF1394.2 +015000 02 FILLER PIC X(41) VALUE SPACE. IF1394.2 +015100 IF1394.2 +015200 01 CCVS-H-2B. IF1394.2 +015300 02 FILLER PIC X(15) VALUE IF1394.2 +015400 "TEST RESULT OF ". IF1394.2 +015500 02 TEST-ID PIC X(9). IF1394.2 +015600 02 FILLER PIC X(4) VALUE IF1394.2 +015700 " IN ". IF1394.2 +015800 02 FILLER PIC X(12) VALUE IF1394.2 +015900 " HIGH ". IF1394.2 +016000 02 FILLER PIC X(22) VALUE IF1394.2 +016100 " LEVEL VALIDATION FOR ". IF1394.2 +016200 02 FILLER PIC X(58) VALUE IF1394.2 +016300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1394.2 +016400 01 CCVS-H-3. IF1394.2 +016500 02 FILLER PIC X(34) VALUE IF1394.2 +016600 " FOR OFFICIAL USE ONLY ". IF1394.2 +016700 02 FILLER PIC X(58) VALUE IF1394.2 +016800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1394.2 +016900 02 FILLER PIC X(28) VALUE IF1394.2 +017000 " COPYRIGHT 1985 ". IF1394.2 +017100 01 CCVS-E-1. IF1394.2 +017200 02 FILLER PIC X(52) VALUE SPACE. IF1394.2 +017300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1394.2 +017400 02 ID-AGAIN PIC X(9). IF1394.2 +017500 02 FILLER PIC X(45) VALUE SPACES. IF1394.2 +017600 01 CCVS-E-2. IF1394.2 +017700 02 FILLER PIC X(31) VALUE SPACE. IF1394.2 +017800 02 FILLER PIC X(21) VALUE SPACE. IF1394.2 +017900 02 CCVS-E-2-2. IF1394.2 +018000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1394.2 +018100 03 FILLER PIC X VALUE SPACE. IF1394.2 +018200 03 ENDER-DESC PIC X(44) VALUE IF1394.2 +018300 "ERRORS ENCOUNTERED". IF1394.2 +018400 01 CCVS-E-3. IF1394.2 +018500 02 FILLER PIC X(22) VALUE IF1394.2 +018600 " FOR OFFICIAL USE ONLY". IF1394.2 +018700 02 FILLER PIC X(12) VALUE SPACE. IF1394.2 +018800 02 FILLER PIC X(58) VALUE IF1394.2 +018900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1394.2 +019000 02 FILLER PIC X(13) VALUE SPACE. IF1394.2 +019100 02 FILLER PIC X(15) VALUE IF1394.2 +019200 " COPYRIGHT 1985". IF1394.2 +019300 01 CCVS-E-4. IF1394.2 +019400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1394.2 +019500 02 FILLER PIC X(4) VALUE " OF ". IF1394.2 +019600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1394.2 +019700 02 FILLER PIC X(40) VALUE IF1394.2 +019800 " TESTS WERE EXECUTED SUCCESSFULLY". IF1394.2 +019900 01 XXINFO. IF1394.2 +020000 02 FILLER PIC X(19) VALUE IF1394.2 +020100 "*** INFORMATION ***". IF1394.2 +020200 02 INFO-TEXT. IF1394.2 +020300 04 FILLER PIC X(8) VALUE SPACE. IF1394.2 +020400 04 XXCOMPUTED PIC X(20). IF1394.2 +020500 04 FILLER PIC X(5) VALUE SPACE. IF1394.2 +020600 04 XXCORRECT PIC X(20). IF1394.2 +020700 02 INF-ANSI-REFERENCE PIC X(48). IF1394.2 +020800 01 HYPHEN-LINE. IF1394.2 +020900 02 FILLER PIC IS X VALUE IS SPACE. IF1394.2 +021000 02 FILLER PIC IS X(65) VALUE IS "************************IF1394.2 +021100- "*****************************************". IF1394.2 +021200 02 FILLER PIC IS X(54) VALUE IS "************************IF1394.2 +021300- "******************************". IF1394.2 +021400 01 CCVS-PGM-ID PIC X(9) VALUE IF1394.2 +021500 "IF139A". IF1394.2 +021600 PROCEDURE DIVISION. IF1394.2 +021700 CCVS1 SECTION. IF1394.2 +021800 OPEN-FILES. IF1394.2 +021900 OPEN OUTPUT PRINT-FILE. IF1394.2 +022000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1394.2 +022100 MOVE SPACE TO TEST-RESULTS. IF1394.2 +022200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1394.2 +022300 GO TO CCVS1-EXIT. IF1394.2 +022400 CLOSE-FILES. IF1394.2 +022500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1394.2 +022600 TERMINATE-CCVS. IF1394.2 +022700 STOP RUN. IF1394.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1394.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1394.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1394.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1394.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. IF1394.2 +023300 PRINT-DETAIL. IF1394.2 +023400 IF REC-CT NOT EQUAL TO ZERO IF1394.2 +023500 MOVE "." TO PARDOT-X IF1394.2 +023600 MOVE REC-CT TO DOTVALUE. IF1394.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1394.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1394.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1394.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1394.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1394.2 +024200 MOVE SPACE TO CORRECT-X. IF1394.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1394.2 +024400 MOVE SPACE TO RE-MARK. IF1394.2 +024500 HEAD-ROUTINE. IF1394.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1394.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1394.2 +025000 COLUMN-NAMES-ROUTINE. IF1394.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +025400 END-ROUTINE. IF1394.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1394.2 +025600 END-RTN-EXIT. IF1394.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +025800 END-ROUTINE-1. IF1394.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1394.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1394.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. IF1394.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1394.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1394.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1394.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1394.2 +026600 END-ROUTINE-12. IF1394.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1394.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1394.2 +026900 MOVE "NO " TO ERROR-TOTAL IF1394.2 +027000 ELSE IF1394.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1394.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1394.2 +027300 PERFORM WRITE-LINE. IF1394.2 +027400 END-ROUTINE-13. IF1394.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1394.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE IF1394.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1394.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1394.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO IF1394.2 +028100 MOVE "NO " TO ERROR-TOTAL IF1394.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1394.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1394.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1394.2 +028600 WRITE-LINE. IF1394.2 +028700 ADD 1 TO RECORD-COUNT. IF1394.2 +028800 IF RECORD-COUNT GREATER 42 IF1394.2 +028900 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1394.2 +029000 MOVE SPACE TO DUMMY-RECORD IF1394.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1394.2 +029200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1394.2 +029300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1394.2 +029400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1394.2 +029500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1394.2 +029600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1394.2 +029700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1394.2 +029800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1394.2 +029900 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1394.2 +030000 MOVE ZERO TO RECORD-COUNT. IF1394.2 +030100 PERFORM WRT-LN. IF1394.2 +030200 WRT-LN. IF1394.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1394.2 +030400 MOVE SPACE TO DUMMY-RECORD. IF1394.2 +030500 BLANK-LINE-PRINT. IF1394.2 +030600 PERFORM WRT-LN. IF1394.2 +030700 FAIL-ROUTINE. IF1394.2 +030800 IF COMPUTED-X NOT EQUAL TO SPACE IF1394.2 +030900 GO TO FAIL-ROUTINE-WRITE. IF1394.2 +031000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1394.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1394.2 +031200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1394.2 +031300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +031400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1394.2 +031500 GO TO FAIL-ROUTINE-EX. IF1394.2 +031600 FAIL-ROUTINE-WRITE. IF1394.2 +031700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1394.2 +031800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1394.2 +031900 CORMA-ANSI-REFERENCE. IF1394.2 +032000 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1394.2 +032100 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1394.2 +032200 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1394.2 +032300 ELSE IF1394.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1394.2 +032500 PERFORM WRITE-LINE. IF1394.2 +032600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1394.2 +032700 FAIL-ROUTINE-EX. EXIT. IF1394.2 +032800 BAIL-OUT. IF1394.2 +032900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1394.2 +033000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1394.2 +033100 BAIL-OUT-WRITE. IF1394.2 +033200 MOVE CORRECT-A TO XXCORRECT. IF1394.2 +033300 MOVE COMPUTED-A TO XXCOMPUTED. IF1394.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1394.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1394.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1394.2 +033700 BAIL-OUT-EX. EXIT. IF1394.2 +033800 CCVS1-EXIT. IF1394.2 +033900 EXIT. IF1394.2 +034000******************************************************** IF1394.2 +034100* * IF1394.2 +034200* Intrinsic Function Tests IF139A - TAN * IF1394.2 +034300* * IF1394.2 +034400******************************************************** IF1394.2 +034500 SECT-IF139A SECTION. IF1394.2 +034600 F-TAN-INFO. IF1394.2 +034700 MOVE "See ref. A-71 2.43" TO ANSI-REFERENCE. IF1394.2 +034800 MOVE "TAN Function" TO FEATURE. IF1394.2 +034900*****************TEST (a) - SIMPLE TEST***************** IF1394.2 +035000 F-TAN-01. IF1394.2 +035100 MOVE ZERO TO WS-NUM. IF1394.2 +035200 MOVE -0.000020 TO MIN-RANGE. IF1394.2 +035300 MOVE 0.000020 TO MAX-RANGE. IF1394.2 +035400 F-TAN-TEST-01. IF1394.2 +035500 COMPUTE WS-NUM = FUNCTION TAN(0). IF1394.2 +035600 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +035700 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +035800 PERFORM PASS IF1394.2 +035900 ELSE IF1394.2 +036000 MOVE WS-NUM TO COMPUTED-N IF1394.2 +036100 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +036200 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +036300 PERFORM FAIL. IF1394.2 +036400 GO TO F-TAN-WRITE-01. IF1394.2 +036500 F-TAN-DELETE-01. IF1394.2 +036600 PERFORM DE-LETE. IF1394.2 +036700 GO TO F-TAN-WRITE-01. IF1394.2 +036800 F-TAN-WRITE-01. IF1394.2 +036900 MOVE "F-TAN-01" TO PAR-NAME. IF1394.2 +037000 PERFORM PRINT-DETAIL. IF1394.2 +037100*****************TEST (b) - SIMPLE TEST***************** IF1394.2 +037200 F-TAN-02. IF1394.2 +037300 EVALUATE FUNCTION TAN(PI) IF1394.2 +037400 WHEN -0.000020 THRU 0.000020 IF1394.2 +037500 PERFORM PASS IF1394.2 +037600 WHEN OTHER IF1394.2 +037700 PERFORM FAIL. IF1394.2 +037800 GO TO F-TAN-WRITE-02. IF1394.2 +037900 F-TAN-DELETE-02. IF1394.2 +038000 PERFORM DE-LETE. IF1394.2 +038100 GO TO F-TAN-WRITE-02. IF1394.2 +038200 F-TAN-WRITE-02. IF1394.2 +038300 MOVE "F-TAN-02" TO PAR-NAME. IF1394.2 +038400 PERFORM PRINT-DETAIL. IF1394.2 +038500*****************TEST (c) - SIMPLE TEST***************** IF1394.2 +038600 F-TAN-03. IF1394.2 +038700 MOVE -0.000020 TO MIN-RANGE. IF1394.2 +038800 MOVE 0.000020 TO MAX-RANGE. IF1394.2 +038900 F-TAN-TEST-03. IF1394.2 +039000 IF (FUNCTION TAN(MINUSPI) >= MIN-RANGE) AND IF1394.2 +039100 (FUNCTION TAN(MINUSPI) <= MAX-RANGE) THEN IF1394.2 +039200 PERFORM PASS IF1394.2 +039300 ELSE IF1394.2 +039400 PERFORM FAIL. IF1394.2 +039500 GO TO F-TAN-WRITE-03. IF1394.2 +039600 F-TAN-DELETE-03. IF1394.2 +039700 PERFORM DE-LETE. IF1394.2 +039800 GO TO F-TAN-WRITE-03. IF1394.2 +039900 F-TAN-WRITE-03. IF1394.2 +040000 MOVE "F-TAN-03" TO PAR-NAME. IF1394.2 +040100 PERFORM PRINT-DETAIL. IF1394.2 +040200*****************TEST (d) - SIMPLE TEST***************** IF1394.2 +040300 F-TAN-04. IF1394.2 +040400 MOVE ZERO TO WS-NUM. IF1394.2 +040500 MOVE 0.000999 TO MIN-RANGE. IF1394.2 +040600 MOVE 0.001000 TO MAX-RANGE. IF1394.2 +040700 F-TAN-TEST-04. IF1394.2 +040800 COMPUTE WS-NUM = FUNCTION TAN(.001). IF1394.2 +040900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +041000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +041100 PERFORM PASS IF1394.2 +041200 ELSE IF1394.2 +041300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +041400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +041500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +041600 PERFORM FAIL. IF1394.2 +041700 GO TO F-TAN-WRITE-04. IF1394.2 +041800 F-TAN-DELETE-04. IF1394.2 +041900 PERFORM DE-LETE. IF1394.2 +042000 GO TO F-TAN-WRITE-04. IF1394.2 +042100 F-TAN-WRITE-04. IF1394.2 +042200 MOVE "F-TAN-04" TO PAR-NAME. IF1394.2 +042300 PERFORM PRINT-DETAIL. IF1394.2 +042400*****************TEST (e) - SIMPLE TEST***************** IF1394.2 +042500 F-TAN-05. IF1394.2 +042600 MOVE ZERO TO WS-NUM. IF1394.2 +042700 MOVE 0.000089 TO MIN-RANGE. IF1394.2 +042800 MOVE 0.000090 TO MAX-RANGE. IF1394.2 +042900 F-TAN-TEST-05. IF1394.2 +043000 COMPUTE WS-NUM = FUNCTION TAN(.00009). IF1394.2 +043100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +043200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +043300 PERFORM PASS IF1394.2 +043400 ELSE IF1394.2 +043500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +043600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +043700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +043800 PERFORM FAIL. IF1394.2 +043900 GO TO F-TAN-WRITE-05. IF1394.2 +044000 F-TAN-DELETE-05. IF1394.2 +044100 PERFORM DE-LETE. IF1394.2 +044200 GO TO F-TAN-WRITE-05. IF1394.2 +044300 F-TAN-WRITE-05. IF1394.2 +044400 MOVE "F-TAN-05" TO PAR-NAME. IF1394.2 +044500 PERFORM PRINT-DETAIL. IF1394.2 +044600*****************TEST (f) - SIMPLE TEST***************** IF1394.2 +044700 F-TAN-06. IF1394.2 +044800 MOVE ZERO TO WS-NUM. IF1394.2 +044900 MOVE -0.000040 TO MIN-RANGE. IF1394.2 +045000 MOVE -0.000039 TO MAX-RANGE. IF1394.2 +045100 F-TAN-TEST-06. IF1394.2 +045200 COMPUTE WS-NUM = FUNCTION TAN(A). IF1394.2 +045300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +045400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +045500 PERFORM PASS IF1394.2 +045600 ELSE IF1394.2 +045700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +045800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +045900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +046000 PERFORM FAIL. IF1394.2 +046100 GO TO F-TAN-WRITE-06. IF1394.2 +046200 F-TAN-DELETE-06. IF1394.2 +046300 PERFORM DE-LETE. IF1394.2 +046400 GO TO F-TAN-WRITE-06. IF1394.2 +046500 F-TAN-WRITE-06. IF1394.2 +046600 MOVE "F-TAN-06" TO PAR-NAME. IF1394.2 +046700 PERFORM PRINT-DETAIL. IF1394.2 +046800*****************TEST (g) - SIMPLE TEST***************** IF1394.2 +046900 F-TAN-07. IF1394.2 +047000 MOVE ZERO TO WS-NUM. IF1394.2 +047100 MOVE 1.15780 TO MIN-RANGE. IF1394.2 +047200 MOVE 1.15784 TO MAX-RANGE. IF1394.2 +047300 F-TAN-TEST-07. IF1394.2 +047400 COMPUTE WS-NUM = FUNCTION TAN(IND(P)). IF1394.2 +047500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +047600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +047700 PERFORM PASS IF1394.2 +047800 ELSE IF1394.2 +047900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +048000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +048100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +048200 PERFORM FAIL. IF1394.2 +048300 GO TO F-TAN-WRITE-07. IF1394.2 +048400 F-TAN-DELETE-07. IF1394.2 +048500 PERFORM DE-LETE. IF1394.2 +048600 GO TO F-TAN-WRITE-07. IF1394.2 +048700 F-TAN-WRITE-07. IF1394.2 +048800 MOVE "F-TAN-07" TO PAR-NAME. IF1394.2 +048900 PERFORM PRINT-DETAIL. IF1394.2 +049000*****************TEST (h) - SIMPLE TEST***************** IF1394.2 +049100 F-TAN-08. IF1394.2 +049200 MOVE ZERO TO WS-NUM. IF1394.2 +049300 MOVE 0.871430 TO MIN-RANGE. IF1394.2 +049400 MOVE 0.871464 TO MAX-RANGE. IF1394.2 +049500 F-TAN-TEST-08. IF1394.2 +049600 COMPUTE WS-NUM = FUNCTION TAN(IND(5)). IF1394.2 +049700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +049800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +049900 PERFORM PASS IF1394.2 +050000 ELSE IF1394.2 +050100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +050200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +050300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +050400 PERFORM FAIL. IF1394.2 +050500 GO TO F-TAN-WRITE-08. IF1394.2 +050600 F-TAN-DELETE-08. IF1394.2 +050700 PERFORM DE-LETE. IF1394.2 +050800 GO TO F-TAN-WRITE-08. IF1394.2 +050900 F-TAN-WRITE-08. IF1394.2 +051000 MOVE "F-TAN-08" TO PAR-NAME. IF1394.2 +051100 PERFORM PRINT-DETAIL. IF1394.2 +051200*****************TEST (a) - COMPLEX TEST**************** IF1394.2 +051300 F-TAN-09. IF1394.2 +051400 MOVE ZERO TO WS-NUM. IF1394.2 +051500 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +051600 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +051700 F-TAN-TEST-09. IF1394.2 +051800 COMPUTE WS-NUM = FUNCTION TAN(PI / 4). IF1394.2 +051900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +052000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +052100 PERFORM PASS IF1394.2 +052200 ELSE IF1394.2 +052300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +052400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +052500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +052600 PERFORM FAIL. IF1394.2 +052700 GO TO F-TAN-WRITE-09. IF1394.2 +052800 F-TAN-DELETE-09. IF1394.2 +052900 PERFORM DE-LETE. IF1394.2 +053000 GO TO F-TAN-WRITE-09. IF1394.2 +053100 F-TAN-WRITE-09. IF1394.2 +053200 MOVE "F-TAN-09" TO PAR-NAME. IF1394.2 +053300 PERFORM PRINT-DETAIL. IF1394.2 +053400*****************TEST (b) - COMPLEX TEST**************** IF1394.2 +053500 F-TAN-10. IF1394.2 +053600 MOVE ZERO TO WS-NUM. IF1394.2 +053700 MOVE -1.00004 TO MIN-RANGE. IF1394.2 +053800 MOVE -0.999960 TO MAX-RANGE. IF1394.2 +053900 F-TAN-TEST-10. IF1394.2 +054000 COMPUTE WS-NUM = FUNCTION TAN((3 * PI) / 4). IF1394.2 +054100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +054200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +054300 PERFORM PASS IF1394.2 +054400 ELSE IF1394.2 +054500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +054600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +054700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +054800 PERFORM FAIL. IF1394.2 +054900 GO TO F-TAN-WRITE-10. IF1394.2 +055000 F-TAN-DELETE-10. IF1394.2 +055100 PERFORM DE-LETE. IF1394.2 +055200 GO TO F-TAN-WRITE-10. IF1394.2 +055300 F-TAN-WRITE-10. IF1394.2 +055400 MOVE "F-TAN-10" TO PAR-NAME. IF1394.2 +055500 PERFORM PRINT-DETAIL. IF1394.2 +055600*****************TEST (c) - COMPLEX TEST**************** IF1394.2 +055700 F-TAN-11. IF1394.2 +055800 MOVE ZERO TO WS-NUM. IF1394.2 +055900 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +056000 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +056100 F-TAN-TEST-11. IF1394.2 +056200 COMPUTE WS-NUM = FUNCTION TAN((5 * PI) / 4). IF1394.2 +056300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +056400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +056500 PERFORM PASS IF1394.2 +056600 ELSE IF1394.2 +056700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +056800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +056900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +057000 PERFORM FAIL. IF1394.2 +057100 GO TO F-TAN-WRITE-11. IF1394.2 +057200 F-TAN-DELETE-11. IF1394.2 +057300 PERFORM DE-LETE. IF1394.2 +057400 GO TO F-TAN-WRITE-11. IF1394.2 +057500 F-TAN-WRITE-11. IF1394.2 +057600 MOVE "F-TAN-11" TO PAR-NAME. IF1394.2 +057700 PERFORM PRINT-DETAIL. IF1394.2 +057800*****************TEST (d) - COMPLEX TEST**************** IF1394.2 +057900 F-TAN-12. IF1394.2 +058000 MOVE ZERO TO WS-NUM. IF1394.2 +058100 MOVE -1.00004 TO MIN-RANGE. IF1394.2 +058200 MOVE -0.999960 TO MAX-RANGE. IF1394.2 +058300 F-TAN-TEST-12. IF1394.2 +058400 COMPUTE WS-NUM = FUNCTION TAN((7 * PI) / 4). IF1394.2 +058500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +058600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +058700 PERFORM PASS IF1394.2 +058800 ELSE IF1394.2 +058900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +059000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +059100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +059200 PERFORM FAIL. IF1394.2 +059300 GO TO F-TAN-WRITE-12. IF1394.2 +059400 F-TAN-DELETE-12. IF1394.2 +059500 PERFORM DE-LETE. IF1394.2 +059600 GO TO F-TAN-WRITE-12. IF1394.2 +059700 F-TAN-WRITE-12. IF1394.2 +059800 MOVE "F-TAN-12" TO PAR-NAME. IF1394.2 +059900 PERFORM PRINT-DETAIL. IF1394.2 +060000*****************TEST (e) - COMPLEX TEST**************** IF1394.2 +060100 F-TAN-13. IF1394.2 +060200 MOVE ZERO TO WS-NUM. IF1394.2 +060300 MOVE -1.00004 TO MIN-RANGE. IF1394.2 +060400 MOVE -0.999960 TO MAX-RANGE. IF1394.2 +060500 F-TAN-TEST-13. IF1394.2 +060600 COMPUTE WS-NUM = FUNCTION TAN(MINUSPI / 4). IF1394.2 +060700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +060800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +060900 PERFORM PASS IF1394.2 +061000 ELSE IF1394.2 +061100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +061200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +061300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +061400 PERFORM FAIL. IF1394.2 +061500 GO TO F-TAN-WRITE-13. IF1394.2 +061600 F-TAN-DELETE-13. IF1394.2 +061700 PERFORM DE-LETE. IF1394.2 +061800 GO TO F-TAN-WRITE-13. IF1394.2 +061900 F-TAN-WRITE-13. IF1394.2 +062000 MOVE "F-TAN-13" TO PAR-NAME. IF1394.2 +062100 PERFORM PRINT-DETAIL. IF1394.2 +062200*****************TEST (f) - COMPLEX TEST**************** IF1394.2 +062300 F-TAN-14. IF1394.2 +062400 MOVE ZERO TO WS-NUM. IF1394.2 +062500 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +062600 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +062700 F-TAN-TEST-14. IF1394.2 +062800 COMPUTE WS-NUM = FUNCTION TAN((3 * MINUSPI) / 4). IF1394.2 +062900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +063000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +063100 PERFORM PASS IF1394.2 +063200 ELSE IF1394.2 +063300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +063400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +063500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +063600 PERFORM FAIL. IF1394.2 +063700 GO TO F-TAN-WRITE-14. IF1394.2 +063800 F-TAN-DELETE-14. IF1394.2 +063900 PERFORM DE-LETE. IF1394.2 +064000 GO TO F-TAN-WRITE-14. IF1394.2 +064100 F-TAN-WRITE-14. IF1394.2 +064200 MOVE "F-TAN-14" TO PAR-NAME. IF1394.2 +064300 PERFORM PRINT-DETAIL. IF1394.2 +064400*****************TEST (g) - COMPLEX TEST**************** IF1394.2 +064500 F-TAN-15. IF1394.2 +064600 MOVE ZERO TO WS-NUM. IF1394.2 +064700 MOVE -1.00004 TO MIN-RANGE. IF1394.2 +064800 MOVE -0.999960 TO MAX-RANGE. IF1394.2 +064900 F-TAN-TEST-15. IF1394.2 +065000 COMPUTE WS-NUM = FUNCTION TAN((5 * MINUSPI) / 4). IF1394.2 +065100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +065200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +065300 PERFORM PASS IF1394.2 +065400 ELSE IF1394.2 +065500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +065600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +065700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +065800 PERFORM FAIL. IF1394.2 +065900 GO TO F-TAN-WRITE-15. IF1394.2 +066000 F-TAN-DELETE-15. IF1394.2 +066100 PERFORM DE-LETE. IF1394.2 +066200 GO TO F-TAN-WRITE-15. IF1394.2 +066300 F-TAN-WRITE-15. IF1394.2 +066400 MOVE "F-TAN-15" TO PAR-NAME. IF1394.2 +066500 PERFORM PRINT-DETAIL. IF1394.2 +066600*****************TEST (h) - COMPLEX TEST**************** IF1394.2 +066700 F-TAN-16. IF1394.2 +066800 MOVE ZERO TO WS-NUM. IF1394.2 +066900 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +067000 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +067100 F-TAN-TEST-16. IF1394.2 +067200 COMPUTE WS-NUM = FUNCTION TAN((7 * MINUSPI) / 4). IF1394.2 +067300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +067400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +067500 PERFORM PASS IF1394.2 +067600 ELSE IF1394.2 +067700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +067800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +067900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +068000 PERFORM FAIL. IF1394.2 +068100 GO TO F-TAN-WRITE-16. IF1394.2 +068200 F-TAN-DELETE-16. IF1394.2 +068300 PERFORM DE-LETE. IF1394.2 +068400 GO TO F-TAN-WRITE-16. IF1394.2 +068500 F-TAN-WRITE-16. IF1394.2 +068600 MOVE "F-TAN-16" TO PAR-NAME. IF1394.2 +068700 PERFORM PRINT-DETAIL. IF1394.2 +068800*****************TEST (i) - COMPLEX TEST**************** IF1394.2 +068900 F-TAN-17. IF1394.2 +069000 MOVE ZERO TO WS-NUM. IF1394.2 +069100 MOVE 0.997961 TO MIN-RANGE. IF1394.2 +069200 MOVE 0.998041 TO MAX-RANGE. IF1394.2 +069300 F-TAN-TEST-17. IF1394.2 +069400 COMPUTE WS-NUM = FUNCTION TAN((PI / 4) - .001). IF1394.2 +069500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +069600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +069700 PERFORM PASS IF1394.2 +069800 ELSE IF1394.2 +069900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +070000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +070100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +070200 PERFORM FAIL. IF1394.2 +070300 GO TO F-TAN-WRITE-17. IF1394.2 +070400 F-TAN-DELETE-17. IF1394.2 +070500 PERFORM DE-LETE. IF1394.2 +070600 GO TO F-TAN-WRITE-17. IF1394.2 +070700 F-TAN-WRITE-17. IF1394.2 +070800 MOVE "F-TAN-17" TO PAR-NAME. IF1394.2 +070900 PERFORM PRINT-DETAIL. IF1394.2 +071000*****************TEST (k) - COMPLEX TEST**************** IF1394.2 +071100 F-TAN-19. IF1394.2 +071200 MOVE ZERO TO WS-NUM. IF1394.2 +071300 MOVE 0.0055554 TO MIN-RANGE. IF1394.2 +071400 MOVE 0.0055558 TO MAX-RANGE. IF1394.2 +071500 F-TAN-TEST-19. IF1394.2 +071600 COMPUTE WS-NUM = FUNCTION TAN(1 / 180). IF1394.2 +071700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +071800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +071900 PERFORM PASS IF1394.2 +072000 ELSE IF1394.2 +072100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +072200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +072300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +072400 PERFORM FAIL. IF1394.2 +072500 GO TO F-TAN-WRITE-19. IF1394.2 +072600 F-TAN-DELETE-19. IF1394.2 +072700 PERFORM DE-LETE. IF1394.2 +072800 GO TO F-TAN-WRITE-19. IF1394.2 +072900 F-TAN-WRITE-19. IF1394.2 +073000 MOVE "F-TAN-19" TO PAR-NAME. IF1394.2 +073100 PERFORM PRINT-DETAIL. IF1394.2 +073200*****************TEST (l) - COMPLEX TEST**************** IF1394.2 +073300 F-TAN-20. IF1394.2 +073400 MOVE ZERO TO WS-NUM. IF1394.2 +073500 MOVE 0.965649 TO MIN-RANGE. IF1394.2 +073600 MOVE 0.965727 TO MAX-RANGE. IF1394.2 +073700 F-TAN-TEST-20. IF1394.2 +073800 COMPUTE WS-NUM = FUNCTION TAN((PI / 4) - (PI / 180)). IF1394.2 +073900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +074000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +074100 PERFORM PASS IF1394.2 +074200 ELSE IF1394.2 +074300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +074400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +074500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +074600 PERFORM FAIL. IF1394.2 +074700 GO TO F-TAN-WRITE-20. IF1394.2 +074800 F-TAN-DELETE-20. IF1394.2 +074900 PERFORM DE-LETE. IF1394.2 +075000 GO TO F-TAN-WRITE-20. IF1394.2 +075100 F-TAN-WRITE-20. IF1394.2 +075200 MOVE "F-TAN-20" TO PAR-NAME. IF1394.2 +075300 PERFORM PRINT-DETAIL. IF1394.2 +075400*****************TEST (m) - COMPLEX TEST**************** IF1394.2 +075500 F-TAN-21. IF1394.2 +075600 MOVE ZERO TO WS-NUM. IF1394.2 +075700 MOVE 0.034919 TO MIN-RANGE. IF1394.2 +075800 MOVE 0.034921 TO MAX-RANGE. IF1394.2 +075900 F-TAN-TEST-21. IF1394.2 +076000 COMPUTE WS-NUM = FUNCTION TAN(PI + ((2 * PI) / 180)). IF1394.2 +076100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +076200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +076300 PERFORM PASS IF1394.2 +076400 ELSE IF1394.2 +076500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +076600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +076700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +076800 PERFORM FAIL. IF1394.2 +076900 GO TO F-TAN-WRITE-21. IF1394.2 +077000 F-TAN-DELETE-21. IF1394.2 +077100 PERFORM DE-LETE. IF1394.2 +077200 GO TO F-TAN-WRITE-21. IF1394.2 +077300 F-TAN-WRITE-21. IF1394.2 +077400 MOVE "F-TAN-21" TO PAR-NAME. IF1394.2 +077500 PERFORM PRINT-DETAIL. IF1394.2 +077600*****************TEST (n) - COMPLEX TEST**************** IF1394.2 +077700 F-TAN-22. IF1394.2 +077800 MOVE ZERO TO WS-NUM. IF1394.2 +077900 MOVE -0.988990 TO MIN-RANGE. IF1394.2 +078000 MOVE -0.988910 TO MAX-RANGE. IF1394.2 +078100 F-TAN-TEST-22. IF1394.2 +078200 COMPUTE WS-NUM = FUNCTION TAN(((PI * 3) / 4) + (1 / 180)). IF1394.2 +078300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +078400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +078500 PERFORM PASS IF1394.2 +078600 ELSE IF1394.2 +078700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +078800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +078900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +079000 PERFORM FAIL. IF1394.2 +079100 GO TO F-TAN-WRITE-22. IF1394.2 +079200 F-TAN-DELETE-22. IF1394.2 +079300 PERFORM DE-LETE. IF1394.2 +079400 GO TO F-TAN-WRITE-22. IF1394.2 +079500 F-TAN-WRITE-22. IF1394.2 +079600 MOVE "F-TAN-22" TO PAR-NAME. IF1394.2 +079700 PERFORM PRINT-DETAIL. IF1394.2 +079800*****************TEST (o) - COMPLEX TEST**************** IF1394.2 +079900 F-TAN-23. IF1394.2 +080000 MOVE ZERO TO WS-NUM. IF1394.2 +080100 MOVE 0.977982 TO MIN-RANGE. IF1394.2 +080200 MOVE 0.978060 TO MAX-RANGE. IF1394.2 +080300 F-TAN-TEST-23. IF1394.2 +080400 COMPUTE WS-NUM = FUNCTION TAN(((PI * 5) / 4) - (2 / 180)). IF1394.2 +080500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +080600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +080700 PERFORM PASS IF1394.2 +080800 ELSE IF1394.2 +080900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +081000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +081100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +081200 PERFORM FAIL. IF1394.2 +081300 GO TO F-TAN-WRITE-23. IF1394.2 +081400 F-TAN-DELETE-23. IF1394.2 +081500 PERFORM DE-LETE. IF1394.2 +081600 GO TO F-TAN-WRITE-23. IF1394.2 +081700 F-TAN-WRITE-23. IF1394.2 +081800 MOVE "F-TAN-23" TO PAR-NAME. IF1394.2 +081900 PERFORM PRINT-DETAIL. IF1394.2 +082000*****************TEST (p) - COMPLEX TEST**************** IF1394.2 +082100 F-TAN-24. IF1394.2 +082200 MOVE ZERO TO WS-NUM. IF1394.2 +082300 MOVE -2.18512 TO MIN-RANGE. IF1394.2 +082400 MOVE -2.18494 TO MAX-RANGE. IF1394.2 +082500 F-TAN-TEST-24. IF1394.2 +082600 COMPUTE WS-NUM = FUNCTION TAN(4 / 2). IF1394.2 +082700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +082800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +082900 PERFORM PASS IF1394.2 +083000 ELSE IF1394.2 +083100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +083200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +083300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +083400 PERFORM FAIL. IF1394.2 +083500 GO TO F-TAN-WRITE-24. IF1394.2 +083600 F-TAN-DELETE-24. IF1394.2 +083700 PERFORM DE-LETE. IF1394.2 +083800 GO TO F-TAN-WRITE-24. IF1394.2 +083900 F-TAN-WRITE-24. IF1394.2 +084000 MOVE "F-TAN-24" TO PAR-NAME. IF1394.2 +084100 PERFORM PRINT-DETAIL. IF1394.2 +084200*****************TEST (q) - COMPLEX TEST**************** IF1394.2 +084300 F-TAN-25. IF1394.2 +084400 MOVE ZERO TO WS-NUM. IF1394.2 +084500 MOVE 14.1008 TO MIN-RANGE. IF1394.2 +084600 MOVE 14.1020 TO MAX-RANGE. IF1394.2 +084700 F-TAN-TEST-25. IF1394.2 +084800 COMPUTE WS-NUM = FUNCTION TAN(3 / 2). IF1394.2 +084900 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +085000 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +085100 PERFORM PASS IF1394.2 +085200 ELSE IF1394.2 +085300 MOVE WS-NUM TO COMPUTED-N IF1394.2 +085400 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +085500 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +085600 PERFORM FAIL. IF1394.2 +085700 GO TO F-TAN-WRITE-25. IF1394.2 +085800 F-TAN-DELETE-25. IF1394.2 +085900 PERFORM DE-LETE. IF1394.2 +086000 GO TO F-TAN-WRITE-25. IF1394.2 +086100 F-TAN-WRITE-25. IF1394.2 +086200 MOVE "F-TAN-25" TO PAR-NAME. IF1394.2 +086300 PERFORM PRINT-DETAIL. IF1394.2 +086400*****************TEST (s) - COMPLEX TEST**************** IF1394.2 +086500 F-TAN-27. IF1394.2 +086600 MOVE ZERO TO WS-NUM. IF1394.2 +086700 MOVE 0.648334 TO MIN-RANGE. IF1394.2 +086800 MOVE 0.648386 TO MAX-RANGE. IF1394.2 +086900 F-TAN-TEST-27. IF1394.2 +087000 COMPUTE WS-NUM = FUNCTION TAN(D / 100). IF1394.2 +087100 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +087200 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +087300 PERFORM PASS IF1394.2 +087400 ELSE IF1394.2 +087500 MOVE WS-NUM TO COMPUTED-N IF1394.2 +087600 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +087700 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +087800 PERFORM FAIL. IF1394.2 +087900 GO TO F-TAN-WRITE-27. IF1394.2 +088000 F-TAN-DELETE-27. IF1394.2 +088100 PERFORM DE-LETE. IF1394.2 +088200 GO TO F-TAN-WRITE-27. IF1394.2 +088300 F-TAN-WRITE-27. IF1394.2 +088400 MOVE "F-TAN-27" TO PAR-NAME. IF1394.2 +088500 PERFORM PRINT-DETAIL. IF1394.2 +088600*****************TEST (t) - COMPLEX TEST**************** IF1394.2 +088700 F-TAN-28. IF1394.2 +088800 MOVE ZERO TO WS-NUM. IF1394.2 +088900 MOVE 0.017454 TO MIN-RANGE. IF1394.2 +089000 MOVE 0.017456 TO MAX-RANGE. IF1394.2 +089100 F-TAN-TEST-28. IF1394.2 +089200 COMPUTE WS-NUM = FUNCTION TAN(PI / 180). IF1394.2 +089300 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +089400 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +089500 PERFORM PASS IF1394.2 +089600 ELSE IF1394.2 +089700 MOVE WS-NUM TO COMPUTED-N IF1394.2 +089800 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +089900 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +090000 PERFORM FAIL. IF1394.2 +090100 GO TO F-TAN-WRITE-28. IF1394.2 +090200 F-TAN-DELETE-28. IF1394.2 +090300 PERFORM DE-LETE. IF1394.2 +090400 GO TO F-TAN-WRITE-28. IF1394.2 +090500 F-TAN-WRITE-28. IF1394.2 +090600 MOVE "F-TAN-28" TO PAR-NAME. IF1394.2 +090700 PERFORM PRINT-DETAIL. IF1394.2 +090800*****************TEST (u) - COMPLEX TEST**************** IF1394.2 +090900 F-TAN-29. IF1394.2 +091000 MOVE ZERO TO WS-NUM. IF1394.2 +091100 MOVE 0.999960 TO MIN-RANGE. IF1394.2 +091200 MOVE 1.00004 TO MAX-RANGE. IF1394.2 +091300 F-TAN-TEST-29. IF1394.2 +091400 COMPUTE WS-NUM = FUNCTION TAN(PI) + 1. IF1394.2 +091500 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +091600 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +091700 PERFORM PASS IF1394.2 +091800 ELSE IF1394.2 +091900 MOVE WS-NUM TO COMPUTED-N IF1394.2 +092000 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +092100 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +092200 PERFORM FAIL. IF1394.2 +092300 GO TO F-TAN-WRITE-29. IF1394.2 +092400 F-TAN-DELETE-29. IF1394.2 +092500 PERFORM DE-LETE. IF1394.2 +092600 GO TO F-TAN-WRITE-29. IF1394.2 +092700 F-TAN-WRITE-29. IF1394.2 +092800 MOVE "F-TAN-29" TO PAR-NAME. IF1394.2 +092900 PERFORM PRINT-DETAIL. IF1394.2 +093000*****************TEST (v) - COMPLEX TEST**************** IF1394.2 +093100 F-TAN-30. IF1394.2 +093200 MOVE ZERO TO WS-NUM. IF1394.2 +093300 MOVE 1.41786 TO MIN-RANGE. IF1394.2 +093400 MOVE 1.41798 TO MAX-RANGE. IF1394.2 +093500 F-TAN-TEST-30. IF1394.2 +093600 COMPUTE WS-NUM = FUNCTION TAN(FUNCTION TAN(2)). IF1394.2 +093700 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +093800 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +093900 PERFORM PASS IF1394.2 +094000 ELSE IF1394.2 +094100 MOVE WS-NUM TO COMPUTED-N IF1394.2 +094200 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +094300 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +094400 PERFORM FAIL. IF1394.2 +094500 GO TO F-TAN-WRITE-30. IF1394.2 +094600 F-TAN-DELETE-30. IF1394.2 +094700 PERFORM DE-LETE. IF1394.2 +094800 GO TO F-TAN-WRITE-30. IF1394.2 +094900 F-TAN-WRITE-30. IF1394.2 +095000 MOVE "F-TAN-30" TO PAR-NAME. IF1394.2 +095100 PERFORM PRINT-DETAIL. IF1394.2 +095200*****************TEST (w) - COMPLEX TEST**************** IF1394.2 +095300 F-TAN-31. IF1394.2 +095400 MOVE ZERO TO WS-NUM. IF1394.2 +095500 MOVE -0.000040 TO MIN-RANGE. IF1394.2 +095600 MOVE 0.000040 TO MAX-RANGE. IF1394.2 +095700 F-TAN-TEST-31. IF1394.2 +095800 COMPUTE WS-NUM = FUNCTION TAN(PI / 3) + IF1394.2 +095900 FUNCTION TAN(MINUSPI / 3). IF1394.2 +096000 IF (WS-NUM >= MIN-RANGE) AND IF1394.2 +096100 (WS-NUM <= MAX-RANGE) THEN IF1394.2 +096200 PERFORM PASS IF1394.2 +096300 ELSE IF1394.2 +096400 MOVE WS-NUM TO COMPUTED-N IF1394.2 +096500 MOVE MIN-RANGE TO CORRECT-MIN IF1394.2 +096600 MOVE MAX-RANGE TO CORRECT-MAX IF1394.2 +096700 PERFORM FAIL. IF1394.2 +096800 GO TO F-TAN-WRITE-31. IF1394.2 +096900 F-TAN-DELETE-31. IF1394.2 +097000 PERFORM DE-LETE. IF1394.2 +097100 GO TO F-TAN-WRITE-31. IF1394.2 +097200 F-TAN-WRITE-31. IF1394.2 +097300 MOVE "F-TAN-31" TO PAR-NAME. IF1394.2 +097400 PERFORM PRINT-DETAIL. IF1394.2 +097500*****************SPECIAL PERFORM TEST********************** IF1394.2 +097600 F-TAN-32. IF1394.2 +097700 PERFORM F-TAN-TEST-32 IF1394.2 +097800 UNTIL FUNCTION TAN(ARG1) < 0. IF1394.2 +097900 PERFORM PASS. IF1394.2 +098000 GO TO F-TAN-WRITE-32. IF1394.2 +098100 F-TAN-TEST-32. IF1394.2 +098200 COMPUTE ARG1 = ARG1 - 0.25. IF1394.2 +098300 F-TAN-DELETE-32. IF1394.2 +098400 PERFORM DE-LETE. IF1394.2 +098500 GO TO F-TAN-WRITE-32. IF1394.2 +098600 F-TAN-WRITE-32. IF1394.2 +098700 MOVE "F-TAN-32" TO PAR-NAME. IF1394.2 +098800 PERFORM PRINT-DETAIL. IF1394.2 +098900********************END OF TESTS*************** IF1394.2 +099000 CCVS-EXIT SECTION. IF1394.2 +099100 CCVS-999999. IF1394.2 +099200 GO TO CLOSE-FILES. IF1394.2 diff --git a/tests/cobol85/IF/IF140A.CBL b/tests/cobol85/IF/IF140A.CBL new file mode 100755 index 00000000..9908fc1c --- /dev/null +++ b/tests/cobol85/IF/IF140A.CBL @@ -0,0 +1,543 @@ +000100 IDENTIFICATION DIVISION. IF1404.2 +000200 PROGRAM-ID. IF1404.2 +000300 IF140A. IF1404.2 +000400 IF1404.2 +000500*********************************************************** IF1404.2 +000600* * IF1404.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1404.2 +000800* It contains tests for the Intrinsic Function * IF1404.2 +000900* UPPER-CASE. * IF1404.2 +001000* * IF1404.2 +001100*********************************************************** IF1404.2 +001200 ENVIRONMENT DIVISION. IF1404.2 +001300 CONFIGURATION SECTION. IF1404.2 +001400 SOURCE-COMPUTER. IF1404.2 +001500 Linux. IF1404.2 +001600 OBJECT-COMPUTER. IF1404.2 +001700 Linux. IF1404.2 +001800 INPUT-OUTPUT SECTION. IF1404.2 +001900 FILE-CONTROL. IF1404.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1404.2 +002100 "report.log". IF1404.2 +002200 DATA DIVISION. IF1404.2 +002300 FILE SECTION. IF1404.2 +002400 FD PRINT-FILE. IF1404.2 +002500 01 PRINT-REC PICTURE X(120). IF1404.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1404.2 +002700 WORKING-STORAGE SECTION. IF1404.2 +002800*********************************************************** IF1404.2 +002900* Variables specific to the Intrinsic Function Test IF140A* IF1404.2 +003000*********************************************************** IF1404.2 +003100 01 A PIC A(10) VALUE "tumble". IF1404.2 +003200 01 B PIC A(10) VALUE "WEED". IF1404.2 +003300 01 C PIC X(10) VALUE "Was". IF1404.2 +003400 01 D PIC X(10) VALUE "4". IF1404.2 +003500 01 E PIC X(10) VALUE "And4". IF1404.2 +003600 01 TEMP PIC S9(10). IF1404.2 +003700 01 WS-ANUM PIC X(10). IF1404.2 +003800* IF1404.2 +003900********************************************************** IF1404.2 +004000* IF1404.2 +004100 01 TEST-RESULTS. IF1404.2 +004200 02 FILLER PIC X VALUE SPACE. IF1404.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. IF1404.2 +004400 02 FILLER PIC X VALUE SPACE. IF1404.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. IF1404.2 +004600 02 FILLER PIC X VALUE SPACE. IF1404.2 +004700 02 PAR-NAME. IF1404.2 +004800 03 FILLER PIC X(19) VALUE SPACE. IF1404.2 +004900 03 PARDOT-X PIC X VALUE SPACE. IF1404.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. IF1404.2 +005100 02 FILLER PIC X(8) VALUE SPACE. IF1404.2 +005200 02 RE-MARK PIC X(61). IF1404.2 +005300 01 TEST-COMPUTED. IF1404.2 +005400 02 FILLER PIC X(30) VALUE SPACE. IF1404.2 +005500 02 FILLER PIC X(17) VALUE IF1404.2 +005600 " COMPUTED=". IF1404.2 +005700 02 COMPUTED-X. IF1404.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1404.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A IF1404.2 +006000 PIC -9(9).9(9). IF1404.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1404.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1404.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1404.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. IF1404.2 +006500 04 COMPUTED-18V0 PIC -9(18). IF1404.2 +006600 04 FILLER PIC X. IF1404.2 +006700 03 FILLER PIC X(50) VALUE SPACE. IF1404.2 +006800 01 TEST-CORRECT. IF1404.2 +006900 02 FILLER PIC X(30) VALUE SPACE. IF1404.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". IF1404.2 +007100 02 CORRECT-X. IF1404.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. IF1404.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1404.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1404.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1404.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1404.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. IF1404.2 +007800 04 CORRECT-18V0 PIC -9(18). IF1404.2 +007900 04 FILLER PIC X. IF1404.2 +008000 03 FILLER PIC X(2) VALUE SPACE. IF1404.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1404.2 +008200 01 CCVS-C-1. IF1404.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1404.2 +008400- "SS PARAGRAPH-NAME IF1404.2 +008500- " REMARKS". IF1404.2 +008600 02 FILLER PIC X(20) VALUE SPACE. IF1404.2 +008700 01 CCVS-C-2. IF1404.2 +008800 02 FILLER PIC X VALUE SPACE. IF1404.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". IF1404.2 +009000 02 FILLER PIC X(15) VALUE SPACE. IF1404.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". IF1404.2 +009200 02 FILLER PIC X(94) VALUE SPACE. IF1404.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1404.2 +009400 01 REC-CT PIC 99 VALUE ZERO. IF1404.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1404.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1404.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1404.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1404.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1404.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1404.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1404.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1404.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1404.2 +010400 01 CCVS-H-1. IF1404.2 +010500 02 FILLER PIC X(39) VALUE SPACES. IF1404.2 +010600 02 FILLER PIC X(42) VALUE IF1404.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1404.2 +010800 02 FILLER PIC X(39) VALUE SPACES. IF1404.2 +010900 01 CCVS-H-2A. IF1404.2 +011000 02 FILLER PIC X(40) VALUE SPACE. IF1404.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1404.2 +011200 02 FILLER PIC XXXX VALUE IF1404.2 +011300 "4.2 ". IF1404.2 +011400 02 FILLER PIC X(28) VALUE IF1404.2 +011500 " COPY - NOT FOR DISTRIBUTION". IF1404.2 +011600 02 FILLER PIC X(41) VALUE SPACE. IF1404.2 +011700 IF1404.2 +011800 01 CCVS-H-2B. IF1404.2 +011900 02 FILLER PIC X(15) VALUE IF1404.2 +012000 "TEST RESULT OF ". IF1404.2 +012100 02 TEST-ID PIC X(9). IF1404.2 +012200 02 FILLER PIC X(4) VALUE IF1404.2 +012300 " IN ". IF1404.2 +012400 02 FILLER PIC X(12) VALUE IF1404.2 +012500 " HIGH ". IF1404.2 +012600 02 FILLER PIC X(22) VALUE IF1404.2 +012700 " LEVEL VALIDATION FOR ". IF1404.2 +012800 02 FILLER PIC X(58) VALUE IF1404.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1404.2 +013000 01 CCVS-H-3. IF1404.2 +013100 02 FILLER PIC X(34) VALUE IF1404.2 +013200 " FOR OFFICIAL USE ONLY ". IF1404.2 +013300 02 FILLER PIC X(58) VALUE IF1404.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1404.2 +013500 02 FILLER PIC X(28) VALUE IF1404.2 +013600 " COPYRIGHT 1985 ". IF1404.2 +013700 01 CCVS-E-1. IF1404.2 +013800 02 FILLER PIC X(52) VALUE SPACE. IF1404.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1404.2 +014000 02 ID-AGAIN PIC X(9). IF1404.2 +014100 02 FILLER PIC X(45) VALUE SPACES. IF1404.2 +014200 01 CCVS-E-2. IF1404.2 +014300 02 FILLER PIC X(31) VALUE SPACE. IF1404.2 +014400 02 FILLER PIC X(21) VALUE SPACE. IF1404.2 +014500 02 CCVS-E-2-2. IF1404.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1404.2 +014700 03 FILLER PIC X VALUE SPACE. IF1404.2 +014800 03 ENDER-DESC PIC X(44) VALUE IF1404.2 +014900 "ERRORS ENCOUNTERED". IF1404.2 +015000 01 CCVS-E-3. IF1404.2 +015100 02 FILLER PIC X(22) VALUE IF1404.2 +015200 " FOR OFFICIAL USE ONLY". IF1404.2 +015300 02 FILLER PIC X(12) VALUE SPACE. IF1404.2 +015400 02 FILLER PIC X(58) VALUE IF1404.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1404.2 +015600 02 FILLER PIC X(13) VALUE SPACE. IF1404.2 +015700 02 FILLER PIC X(15) VALUE IF1404.2 +015800 " COPYRIGHT 1985". IF1404.2 +015900 01 CCVS-E-4. IF1404.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1404.2 +016100 02 FILLER PIC X(4) VALUE " OF ". IF1404.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1404.2 +016300 02 FILLER PIC X(40) VALUE IF1404.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". IF1404.2 +016500 01 XXINFO. IF1404.2 +016600 02 FILLER PIC X(19) VALUE IF1404.2 +016700 "*** INFORMATION ***". IF1404.2 +016800 02 INFO-TEXT. IF1404.2 +016900 04 FILLER PIC X(8) VALUE SPACE. IF1404.2 +017000 04 XXCOMPUTED PIC X(20). IF1404.2 +017100 04 FILLER PIC X(5) VALUE SPACE. IF1404.2 +017200 04 XXCORRECT PIC X(20). IF1404.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). IF1404.2 +017400 01 HYPHEN-LINE. IF1404.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. IF1404.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************IF1404.2 +017700- "*****************************************". IF1404.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************IF1404.2 +017900- "******************************". IF1404.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE IF1404.2 +018100 "IF140A". IF1404.2 +018200 PROCEDURE DIVISION. IF1404.2 +018300 CCVS1 SECTION. IF1404.2 +018400 OPEN-FILES. IF1404.2 +018500 OPEN OUTPUT PRINT-FILE. IF1404.2 +018600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1404.2 +018700 MOVE SPACE TO TEST-RESULTS. IF1404.2 +018800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1404.2 +018900 GO TO CCVS1-EXIT. IF1404.2 +019000 CLOSE-FILES. IF1404.2 +019100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1404.2 +019200 TERMINATE-CCVS. IF1404.2 +019300 STOP RUN. IF1404.2 +019400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1404.2 +019500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1404.2 +019600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1404.2 +019700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1404.2 +019800 MOVE "****TEST DELETED****" TO RE-MARK. IF1404.2 +019900 PRINT-DETAIL. IF1404.2 +020000 IF REC-CT NOT EQUAL TO ZERO IF1404.2 +020100 MOVE "." TO PARDOT-X IF1404.2 +020200 MOVE REC-CT TO DOTVALUE. IF1404.2 +020300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1404.2 +020400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1404.2 +020500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1404.2 +020600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1404.2 +020700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1404.2 +020800 MOVE SPACE TO CORRECT-X. IF1404.2 +020900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1404.2 +021000 MOVE SPACE TO RE-MARK. IF1404.2 +021100 HEAD-ROUTINE. IF1404.2 +021200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +021300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +021400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1404.2 +021500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1404.2 +021600 COLUMN-NAMES-ROUTINE. IF1404.2 +021700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +021800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +022000 END-ROUTINE. IF1404.2 +022100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1404.2 +022200 END-RTN-EXIT. IF1404.2 +022300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +022400 END-ROUTINE-1. IF1404.2 +022500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1404.2 +022600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1404.2 +022700 ADD PASS-COUNTER TO ERROR-HOLD. IF1404.2 +022800 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1404.2 +022900 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1404.2 +023000 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1404.2 +023100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1404.2 +023200 END-ROUTINE-12. IF1404.2 +023300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1404.2 +023400 IF ERROR-COUNTER IS EQUAL TO ZERO IF1404.2 +023500 MOVE "NO " TO ERROR-TOTAL IF1404.2 +023600 ELSE IF1404.2 +023700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1404.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1404.2 +023900 PERFORM WRITE-LINE. IF1404.2 +024000 END-ROUTINE-13. IF1404.2 +024100 IF DELETE-COUNTER IS EQUAL TO ZERO IF1404.2 +024200 MOVE "NO " TO ERROR-TOTAL ELSE IF1404.2 +024300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1404.2 +024400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1404.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +024600 IF INSPECT-COUNTER EQUAL TO ZERO IF1404.2 +024700 MOVE "NO " TO ERROR-TOTAL IF1404.2 +024800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1404.2 +024900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1404.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +025100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1404.2 +025200 WRITE-LINE. IF1404.2 +025300 ADD 1 TO RECORD-COUNT. IF1404.2 +025400 IF RECORD-COUNT GREATER 42 IF1404.2 +025500 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1404.2 +025600 MOVE SPACE TO DUMMY-RECORD IF1404.2 +025700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1404.2 +025800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1404.2 +025900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1404.2 +026000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1404.2 +026100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1404.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1404.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1404.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1404.2 +026500 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1404.2 +026600 MOVE ZERO TO RECORD-COUNT. IF1404.2 +026700 PERFORM WRT-LN. IF1404.2 +026800 WRT-LN. IF1404.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1404.2 +027000 MOVE SPACE TO DUMMY-RECORD. IF1404.2 +027100 BLANK-LINE-PRINT. IF1404.2 +027200 PERFORM WRT-LN. IF1404.2 +027300 FAIL-ROUTINE. IF1404.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE IF1404.2 +027500 GO TO FAIL-ROUTINE-WRITE. IF1404.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1404.2 +027700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1404.2 +027800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1404.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +028000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1404.2 +028100 GO TO FAIL-ROUTINE-EX. IF1404.2 +028200 FAIL-ROUTINE-WRITE. IF1404.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1404.2 +028400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1404.2 +028500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1404.2 +028600 MOVE SPACES TO COR-ANSI-REFERENCE. IF1404.2 +028700 FAIL-ROUTINE-EX. EXIT. IF1404.2 +028800 BAIL-OUT. IF1404.2 +028900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1404.2 +029000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1404.2 +029100 BAIL-OUT-WRITE. IF1404.2 +029200 MOVE CORRECT-A TO XXCORRECT. IF1404.2 +029300 MOVE COMPUTED-A TO XXCOMPUTED. IF1404.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1404.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1404.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. IF1404.2 +029700 BAIL-OUT-EX. EXIT. IF1404.2 +029800 CCVS1-EXIT. IF1404.2 +029900 EXIT. IF1404.2 +030000******************************************************** IF1404.2 +030100* * IF1404.2 +030200* Intrinsic Function Tests IF140A - UPCASE * IF1404.2 +030300* * IF1404.2 +030400******************************************************** IF1404.2 +030500 SECT-IF140A SECTION. IF1404.2 +030600 F-UPCASE-INFO. IF1404.2 +030700 MOVE "See ref. A-73 2.44" TO ANSI-REFERENCE. IF1404.2 +030800 MOVE "UPPER-CASE Function" TO FEATURE. IF1404.2 +030900*****************TEST (a) ****************************** IF1404.2 +031000 F-UPCASE-01. IF1404.2 +031100 MOVE SPACES TO WS-ANUM. IF1404.2 +031200 F-UPCASE-TEST-01. IF1404.2 +031300 MOVE FUNCTION UPPER-CASE("figure") TO WS-ANUM. IF1404.2 +031400 IF WS-ANUM = "FIGURE" THEN IF1404.2 +031500 PERFORM PASS IF1404.2 +031600 ELSE IF1404.2 +031700 MOVE "FIGURE" TO CORRECT-A IF1404.2 +031800 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +031900 PERFORM FAIL. IF1404.2 +032000 GO TO F-UPCASE-WRITE-01. IF1404.2 +032100 F-UPCASE-DELETE-01. IF1404.2 +032200 PERFORM DE-LETE. IF1404.2 +032300 GO TO F-UPCASE-WRITE-01. IF1404.2 +032400 F-UPCASE-WRITE-01. IF1404.2 +032500 MOVE "F-UPCASE-01" TO PAR-NAME. IF1404.2 +032600 PERFORM PRINT-DETAIL. IF1404.2 +032700*****************TEST (b) ****************************** IF1404.2 +032800 F-UPCASE-TEST-02. IF1404.2 +032900 IF FUNCTION UPPER-CASE("CAPS") = "CAPS" THEN IF1404.2 +033000 PERFORM PASS IF1404.2 +033100 ELSE IF1404.2 +033200 PERFORM FAIL. IF1404.2 +033300 GO TO F-UPCASE-WRITE-02. IF1404.2 +033400 F-UPCASE-DELETE-02. IF1404.2 +033500 PERFORM DE-LETE. IF1404.2 +033600 GO TO F-UPCASE-WRITE-02. IF1404.2 +033700 F-UPCASE-WRITE-02. IF1404.2 +033800 MOVE "F-UPCASE-02" TO PAR-NAME. IF1404.2 +033900 PERFORM PRINT-DETAIL. IF1404.2 +034000*****************TEST (c) ****************************** IF1404.2 +034100 F-UPCASE-03. IF1404.2 +034200 MOVE SPACES TO WS-ANUM. IF1404.2 +034300 F-UPCASE-TEST-03. IF1404.2 +034400 MOVE FUNCTION UPPER-CASE("highnLOW") TO WS-ANUM. IF1404.2 +034500 IF WS-ANUM = "HIGHNLOW" THEN IF1404.2 +034600 PERFORM PASS IF1404.2 +034700 ELSE IF1404.2 +034800 MOVE "HIGHNLOW" TO CORRECT-A IF1404.2 +034900 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +035000 PERFORM FAIL. IF1404.2 +035100 GO TO F-UPCASE-WRITE-03. IF1404.2 +035200 F-UPCASE-DELETE-03. IF1404.2 +035300 PERFORM DE-LETE. IF1404.2 +035400 GO TO F-UPCASE-WRITE-03. IF1404.2 +035500 F-UPCASE-WRITE-03. IF1404.2 +035600 MOVE "F-UPCASE-03" TO PAR-NAME. IF1404.2 +035700 PERFORM PRINT-DETAIL. IF1404.2 +035800*****************TEST (d) ****************************** IF1404.2 +035900 F-UPCASE-04. IF1404.2 +036000 MOVE SPACES TO WS-ANUM. IF1404.2 +036100 F-UPCASE-TEST-04. IF1404.2 +036200 MOVE FUNCTION UPPER-CASE("95") TO WS-ANUM. IF1404.2 +036300 IF WS-ANUM = "95" THEN IF1404.2 +036400 PERFORM PASS IF1404.2 +036500 ELSE IF1404.2 +036600 MOVE "95" TO CORRECT-A IF1404.2 +036700 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +036800 PERFORM FAIL. IF1404.2 +036900 GO TO F-UPCASE-WRITE-04. IF1404.2 +037000 F-UPCASE-DELETE-04. IF1404.2 +037100 PERFORM DE-LETE. IF1404.2 +037200 GO TO F-UPCASE-WRITE-04. IF1404.2 +037300 F-UPCASE-WRITE-04. IF1404.2 +037400 MOVE "F-UPCASE-04" TO PAR-NAME. IF1404.2 +037500 PERFORM PRINT-DETAIL. IF1404.2 +037600*****************TEST (e) ****************************** IF1404.2 +037700 F-UPCASE-05. IF1404.2 +037800 MOVE SPACES TO WS-ANUM. IF1404.2 +037900 F-UPCASE-TEST-05. IF1404.2 +038000 MOVE FUNCTION UPPER-CASE("8isaNUMBER") TO WS-ANUM. IF1404.2 +038100 IF WS-ANUM = "8ISANUMBER" THEN IF1404.2 +038200 PERFORM PASS IF1404.2 +038300 ELSE IF1404.2 +038400 MOVE "8ISANUMBER" TO CORRECT-A IF1404.2 +038500 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +038600 PERFORM FAIL. IF1404.2 +038700 GO TO F-UPCASE-WRITE-05. IF1404.2 +038800 F-UPCASE-DELETE-05. IF1404.2 +038900 PERFORM DE-LETE. IF1404.2 +039000 GO TO F-UPCASE-WRITE-05. IF1404.2 +039100 F-UPCASE-WRITE-05. IF1404.2 +039200 MOVE "F-UPCASE-05" TO PAR-NAME. IF1404.2 +039300 PERFORM PRINT-DETAIL. IF1404.2 +039400*****************TEST (f) ****************************** IF1404.2 +039500 F-UPCASE-06. IF1404.2 +039600 MOVE SPACES TO WS-ANUM. IF1404.2 +039700 F-UPCASE-TEST-06. IF1404.2 +039800 MOVE FUNCTION UPPER-CASE(A) TO WS-ANUM. IF1404.2 +039900 IF WS-ANUM = "TUMBLE" THEN IF1404.2 +040000 PERFORM PASS IF1404.2 +040100 ELSE IF1404.2 +040200 MOVE "TUMBLE" TO CORRECT-A IF1404.2 +040300 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +040400 PERFORM FAIL. IF1404.2 +040500 GO TO F-UPCASE-WRITE-06. IF1404.2 +040600 F-UPCASE-DELETE-06. IF1404.2 +040700 PERFORM DE-LETE. IF1404.2 +040800 GO TO F-UPCASE-WRITE-06. IF1404.2 +040900 F-UPCASE-WRITE-06. IF1404.2 +041000 MOVE "F-UPCASE-06" TO PAR-NAME. IF1404.2 +041100 PERFORM PRINT-DETAIL. IF1404.2 +041200*****************TEST (g) ****************************** IF1404.2 +041300 F-UPCASE-07. IF1404.2 +041400 MOVE SPACES TO WS-ANUM. IF1404.2 +041500 F-UPCASE-TEST-07. IF1404.2 +041600 MOVE FUNCTION UPPER-CASE(B) TO WS-ANUM. IF1404.2 +041700 IF WS-ANUM = "WEED" THEN IF1404.2 +041800 PERFORM PASS IF1404.2 +041900 ELSE IF1404.2 +042000 MOVE "WEED" TO CORRECT-A IF1404.2 +042100 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +042200 PERFORM FAIL. IF1404.2 +042300 GO TO F-UPCASE-WRITE-07. IF1404.2 +042400 F-UPCASE-DELETE-07. IF1404.2 +042500 PERFORM DE-LETE. IF1404.2 +042600 GO TO F-UPCASE-WRITE-07. IF1404.2 +042700 F-UPCASE-WRITE-07. IF1404.2 +042800 MOVE "F-UPCASE-07" TO PAR-NAME. IF1404.2 +042900 PERFORM PRINT-DETAIL. IF1404.2 +043000*****************TEST (h) ****************************** IF1404.2 +043100 F-UPCASE-08. IF1404.2 +043200 MOVE SPACES TO WS-ANUM. IF1404.2 +043300 F-UPCASE-TEST-08. IF1404.2 +043400 MOVE FUNCTION UPPER-CASE(C) TO WS-ANUM. IF1404.2 +043500 IF WS-ANUM = "WAS" THEN IF1404.2 +043600 PERFORM PASS IF1404.2 +043700 ELSE IF1404.2 +043800 MOVE "WAS" TO CORRECT-A IF1404.2 +043900 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +044000 PERFORM FAIL. IF1404.2 +044100 GO TO F-UPCASE-WRITE-08. IF1404.2 +044200 F-UPCASE-DELETE-08. IF1404.2 +044300 PERFORM DE-LETE. IF1404.2 +044400 GO TO F-UPCASE-WRITE-08. IF1404.2 +044500 F-UPCASE-WRITE-08. IF1404.2 +044600 MOVE "F-UPCASE-08" TO PAR-NAME. IF1404.2 +044700 PERFORM PRINT-DETAIL. IF1404.2 +044800*****************TEST (i) ****************************** IF1404.2 +044900 F-UPCASE-09. IF1404.2 +045000 MOVE SPACES TO WS-ANUM. IF1404.2 +045100 F-UPCASE-TEST-09. IF1404.2 +045200 MOVE FUNCTION UPPER-CASE(D) TO WS-ANUM. IF1404.2 +045300 IF WS-ANUM = "4" THEN IF1404.2 +045400 PERFORM PASS IF1404.2 +045500 ELSE IF1404.2 +045600 MOVE "4" TO CORRECT-A IF1404.2 +045700 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +045800 PERFORM FAIL. IF1404.2 +045900 GO TO F-UPCASE-WRITE-09. IF1404.2 +046000 F-UPCASE-DELETE-09. IF1404.2 +046100 PERFORM DE-LETE. IF1404.2 +046200 GO TO F-UPCASE-WRITE-09. IF1404.2 +046300 F-UPCASE-WRITE-09. IF1404.2 +046400 MOVE "F-UPCASE-09" TO PAR-NAME. IF1404.2 +046500 PERFORM PRINT-DETAIL. IF1404.2 +046600*****************TEST (j) ****************************** IF1404.2 +046700 F-UPCASE-10. IF1404.2 +046800 MOVE SPACES TO WS-ANUM. IF1404.2 +046900 F-UPCASE-TEST-10. IF1404.2 +047000 MOVE FUNCTION UPPER-CASE(E) TO WS-ANUM. IF1404.2 +047100 IF WS-ANUM = "AND4" THEN IF1404.2 +047200 PERFORM PASS IF1404.2 +047300 ELSE IF1404.2 +047400 MOVE "AND4" TO CORRECT-A IF1404.2 +047500 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +047600 PERFORM FAIL. IF1404.2 +047700 GO TO F-UPCASE-WRITE-10. IF1404.2 +047800 F-UPCASE-DELETE-10. IF1404.2 +047900 PERFORM DE-LETE. IF1404.2 +048000 GO TO F-UPCASE-WRITE-10. IF1404.2 +048100 F-UPCASE-WRITE-10. IF1404.2 +048200 MOVE "F-UPCASE-10" TO PAR-NAME. IF1404.2 +048300 PERFORM PRINT-DETAIL. IF1404.2 +048400*****************TEST (k) ****************************** IF1404.2 +048500 F-UPCASE-11. IF1404.2 +048600 MOVE ZERO TO TEMP. IF1404.2 +048700 F-UPCASE-TEST-11. IF1404.2 +048800 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION UPPER-CASE("Homer")).IF1404.2 +048900 IF TEMP = 5 THEN IF1404.2 +049000 PERFORM PASS IF1404.2 +049100 ELSE IF1404.2 +049200 MOVE 5 TO CORRECT-N IF1404.2 +049300 MOVE TEMP TO COMPUTED-N IF1404.2 +049400 PERFORM FAIL. IF1404.2 +049500 GO TO F-UPCASE-WRITE-11. IF1404.2 +049600 F-UPCASE-DELETE-11. IF1404.2 +049700 PERFORM DE-LETE. IF1404.2 +049800 GO TO F-UPCASE-WRITE-11. IF1404.2 +049900 F-UPCASE-WRITE-11. IF1404.2 +050000 MOVE "F-UPCASE-11" TO PAR-NAME. IF1404.2 +050100 PERFORM PRINT-DETAIL. IF1404.2 +050200*****************TEST (l) ****************************** IF1404.2 +050300 F-UPCASE-12. IF1404.2 +050400 MOVE SPACES TO WS-ANUM. IF1404.2 +050500 F-UPCASE-TEST-12. IF1404.2 +050600 MOVE FUNCTION UPPER-CASE(FUNCTION UPPER-CASE("giZZard")) IF1404.2 +050700 TO WS-ANUM. IF1404.2 +050800 IF WS-ANUM = "GIZZARD" THEN IF1404.2 +050900 PERFORM PASS IF1404.2 +051000 ELSE IF1404.2 +051100 MOVE "GIZZARD" TO CORRECT-A IF1404.2 +051200 MOVE WS-ANUM TO COMPUTED-A IF1404.2 +051300 PERFORM FAIL. IF1404.2 +051400 GO TO F-UPCASE-WRITE-12. IF1404.2 +051500 F-UPCASE-DELETE-12. IF1404.2 +051600 PERFORM DE-LETE. IF1404.2 +051700 GO TO F-UPCASE-WRITE-12. IF1404.2 +051800 F-UPCASE-WRITE-12. IF1404.2 +051900 MOVE "F-UPCASE-12" TO PAR-NAME. IF1404.2 +052000 PERFORM PRINT-DETAIL. IF1404.2 +052100*****************TEST (m) ****************************** IF1404.2 +052200 F-UPCASE-13. IF1404.2 +052300 MOVE ZERO TO TEMP. IF1404.2 +052400 F-UPCASE-TEST-13. IF1404.2 +052500 COMPUTE TEMP = FUNCTION LENGTH(FUNCTION UPPER-CASE("HOMER")) IF1404.2 +052600 + FUNCTION LENGTH(FUNCTION UPPER-CASE("Gizzard")).IF1404.2 +052700 IF TEMP = 12 THEN IF1404.2 +052800 PERFORM PASS IF1404.2 +052900 ELSE IF1404.2 +053000 MOVE 12 TO CORRECT-N IF1404.2 +053100 MOVE TEMP TO COMPUTED-N IF1404.2 +053200 PERFORM FAIL. IF1404.2 +053300 GO TO F-UPCASE-WRITE-13. IF1404.2 +053400 F-UPCASE-DELETE-13. IF1404.2 +053500 PERFORM DE-LETE. IF1404.2 +053600 GO TO F-UPCASE-WRITE-13. IF1404.2 +053700 F-UPCASE-WRITE-13. IF1404.2 +053800 MOVE "F-UPCASE-13" TO PAR-NAME. IF1404.2 +053900 PERFORM PRINT-DETAIL. IF1404.2 +054000*******************END OF TESTS************************** IF1404.2 +054100 CCVS-EXIT SECTION. IF1404.2 +054200 CCVS-999999. IF1404.2 +054300 GO TO CLOSE-FILES. IF1404.2 diff --git a/tests/cobol85/IF/IF141A.CBL b/tests/cobol85/IF/IF141A.CBL new file mode 100755 index 00000000..95926808 --- /dev/null +++ b/tests/cobol85/IF/IF141A.CBL @@ -0,0 +1,692 @@ +000100 IDENTIFICATION DIVISION. IF1414.2 +000200 PROGRAM-ID. IF1414.2 +000300 IF141A. IF1414.2 +000400*********************************************************** IF1414.2 +000500* * IF1414.2 +000600* This program forms part of the CCVS85 COBOL Test Suite. * IF1414.2 +000700* It contains tests for the Intrinsic Function VARIANCE * IF1414.2 +000800* * IF1414.2 +000900*********************************************************** IF1414.2 +001000 ENVIRONMENT DIVISION. IF1414.2 +001100 CONFIGURATION SECTION. IF1414.2 +001200 SOURCE-COMPUTER. IF1414.2 +001300 Linux. IF1414.2 +001400 OBJECT-COMPUTER. IF1414.2 +001500 Linux. IF1414.2 +001600 INPUT-OUTPUT SECTION. IF1414.2 +001700 FILE-CONTROL. IF1414.2 +001800 SELECT PRINT-FILE ASSIGN TO IF1414.2 +001900 "report.log". IF1414.2 +002000 DATA DIVISION. IF1414.2 +002100 FILE SECTION. IF1414.2 +002200 FD PRINT-FILE. IF1414.2 +002300 01 PRINT-REC PICTURE X(120). IF1414.2 +002400 01 DUMMY-RECORD PICTURE X(120). IF1414.2 +002500 WORKING-STORAGE SECTION. IF1414.2 +002600*********************************************************** IF1414.2 +002700* Variables specific to the Intrinsic Function Test IF141A* IF1414.2 +002800*********************************************************** IF1414.2 +002900 01 A PIC S9(10) VALUE 5. IF1414.2 +003000 01 B PIC S9(10) VALUE 7. IF1414.2 +003100 01 C PIC S9(10) VALUE -4. IF1414.2 +003200 01 D PIC S9(10) VALUE 10. IF1414.2 +003300 01 E PIC S9(5)V9(5) VALUE 34.26. IF1414.2 +003400 01 F PIC S9(5)V9(5) VALUE -8.32. IF1414.2 +003500 01 G PIC S9(5)V9(5) VALUE 4.08. IF1414.2 +003600 01 H PIC S9(5)V9(5) VALUE -5.3. IF1414.2 +003700 01 P PIC S9(10) VALUE 4. IF1414.2 +003800 01 Q PIC S9(10) VALUE 3. IF1414.2 +003900 01 R PIC S9(10) VALUE 5. IF1414.2 +004000 01 ARG3 PIC S9(10) VALUE 2. IF1414.2 +004100 01 ARR VALUE "40537". IF1414.2 +004200 02 IND OCCURS 5 TIMES PIC 9. IF1414.2 +004300 01 TEMP PIC S9(10). IF1414.2 +004400 01 WS-NUM PIC S9(5)V9(6). IF1414.2 +004500 01 MIN-RANGE PIC S9(5)V9(7). IF1414.2 +004600 01 MAX-RANGE PIC S9(5)V9(7). IF1414.2 +004700* IF1414.2 +004800********************************************************** IF1414.2 +004900* IF1414.2 +005000 01 TEST-RESULTS. IF1414.2 +005100 02 FILLER PIC X VALUE SPACE. IF1414.2 +005200 02 FEATURE PIC X(20) VALUE SPACE. IF1414.2 +005300 02 FILLER PIC X VALUE SPACE. IF1414.2 +005400 02 P-OR-F PIC X(5) VALUE SPACE. IF1414.2 +005500 02 FILLER PIC X VALUE SPACE. IF1414.2 +005600 02 PAR-NAME. IF1414.2 +005700 03 FILLER PIC X(19) VALUE SPACE. IF1414.2 +005800 03 PARDOT-X PIC X VALUE SPACE. IF1414.2 +005900 03 DOTVALUE PIC 99 VALUE ZERO. IF1414.2 +006000 02 FILLER PIC X(8) VALUE SPACE. IF1414.2 +006100 02 RE-MARK PIC X(61). IF1414.2 +006200 01 TEST-COMPUTED. IF1414.2 +006300 02 FILLER PIC X(30) VALUE SPACE. IF1414.2 +006400 02 FILLER PIC X(17) VALUE IF1414.2 +006500 " COMPUTED=". IF1414.2 +006600 02 COMPUTED-X. IF1414.2 +006700 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1414.2 +006800 03 COMPUTED-N REDEFINES COMPUTED-A IF1414.2 +006900 PIC -9(9).9(9). IF1414.2 +007000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1414.2 +007100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1414.2 +007200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1414.2 +007300 03 CM-18V0 REDEFINES COMPUTED-A. IF1414.2 +007400 04 COMPUTED-18V0 PIC -9(18). IF1414.2 +007500 04 FILLER PIC X. IF1414.2 +007600 03 FILLER PIC X(50) VALUE SPACE. IF1414.2 +007700 01 TEST-CORRECT. IF1414.2 +007800 02 FILLER PIC X(30) VALUE SPACE. IF1414.2 +007900 02 FILLER PIC X(17) VALUE " CORRECT =". IF1414.2 +008000 02 CORRECT-X. IF1414.2 +008100 03 CORRECT-A PIC X(20) VALUE SPACE. IF1414.2 +008200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1414.2 +008300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1414.2 +008400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1414.2 +008500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1414.2 +008600 03 CR-18V0 REDEFINES CORRECT-A. IF1414.2 +008700 04 CORRECT-18V0 PIC -9(18). IF1414.2 +008800 04 FILLER PIC X. IF1414.2 +008900 03 FILLER PIC X(2) VALUE SPACE. IF1414.2 +009000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1414.2 +009100 01 TEST-CORRECT-MIN. IF1414.2 +009200 02 FILLER PIC X(30) VALUE SPACE. IF1414.2 +009300 02 FILLER PIC X(17) VALUE " MIN VALUE =". IF1414.2 +009400 02 CORRECTMI-X. IF1414.2 +009500 03 CORRECTMI-A PIC X(20) VALUE SPACE. IF1414.2 +009600 03 CORRECT-MIN REDEFINES CORRECTMI-A PIC -9(9).9(9). IF1414.2 +009700 03 CORRECTMI-0V18 REDEFINES CORRECTMI-A PIC -.9(18). IF1414.2 +009800 03 CORRECTMI-4V14 REDEFINES CORRECTMI-A PIC -9(4).9(14). IF1414.2 +009900 03 CORRECTMI-14V4 REDEFINES CORRECTMI-A PIC -9(14).9(4). IF1414.2 +010000 03 CR-18V0 REDEFINES CORRECTMI-A. IF1414.2 +010100 04 CORRECTMI-18V0 PIC -9(18). IF1414.2 +010200 04 FILLER PIC X. IF1414.2 +010300 03 FILLER PIC X(2) VALUE SPACE. IF1414.2 +010400 03 FILLER PIC X(48) VALUE SPACE. IF1414.2 +010500 01 TEST-CORRECT-MAX. IF1414.2 +010600 02 FILLER PIC X(30) VALUE SPACE. IF1414.2 +010700 02 FILLER PIC X(17) VALUE " MAX VALUE =". IF1414.2 +010800 02 CORRECTMA-X. IF1414.2 +010900 03 CORRECTMA-A PIC X(20) VALUE SPACE. IF1414.2 +011000 03 CORRECT-MAX REDEFINES CORRECTMA-A PIC -9(9).9(9). IF1414.2 +011100 03 CORRECTMA-0V18 REDEFINES CORRECTMA-A PIC -.9(18). IF1414.2 +011200 03 CORRECTMA-4V14 REDEFINES CORRECTMA-A PIC -9(4).9(14). IF1414.2 +011300 03 CORRECTMA-14V4 REDEFINES CORRECTMA-A PIC -9(14).9(4). IF1414.2 +011400 03 CR-18V0 REDEFINES CORRECTMA-A. IF1414.2 +011500 04 CORRECTMA-18V0 PIC -9(18). IF1414.2 +011600 04 FILLER PIC X. IF1414.2 +011700 03 FILLER PIC X(2) VALUE SPACE. IF1414.2 +011800 03 CORMA-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1414.2 +011900 01 CCVS-C-1. IF1414.2 +012000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1414.2 +012100- "SS PARAGRAPH-NAME IF1414.2 +012200- " REMARKS". IF1414.2 +012300 02 FILLER PIC X(20) VALUE SPACE. IF1414.2 +012400 01 CCVS-C-2. IF1414.2 +012500 02 FILLER PIC X VALUE SPACE. IF1414.2 +012600 02 FILLER PIC X(6) VALUE "TESTED". IF1414.2 +012700 02 FILLER PIC X(15) VALUE SPACE. IF1414.2 +012800 02 FILLER PIC X(4) VALUE "FAIL". IF1414.2 +012900 02 FILLER PIC X(94) VALUE SPACE. IF1414.2 +013000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1414.2 +013100 01 REC-CT PIC 99 VALUE ZERO. IF1414.2 +013200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1414.2 +013300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1414.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1414.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1414.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1414.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1414.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1414.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1414.2 +014000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1414.2 +014100 01 CCVS-H-1. IF1414.2 +014200 02 FILLER PIC X(39) VALUE SPACES. IF1414.2 +014300 02 FILLER PIC X(42) VALUE IF1414.2 +014400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1414.2 +014500 02 FILLER PIC X(39) VALUE SPACES. IF1414.2 +014600 01 CCVS-H-2A. IF1414.2 +014700 02 FILLER PIC X(40) VALUE SPACE. IF1414.2 +014800 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1414.2 +014900 02 FILLER PIC XXXX VALUE IF1414.2 +015000 "4.2 ". IF1414.2 +015100 02 FILLER PIC X(28) VALUE IF1414.2 +015200 " COPY - NOT FOR DISTRIBUTION". IF1414.2 +015300 02 FILLER PIC X(41) VALUE SPACE. IF1414.2 +015400 IF1414.2 +015500 01 CCVS-H-2B. IF1414.2 +015600 02 FILLER PIC X(15) VALUE IF1414.2 +015700 "TEST RESULT OF ". IF1414.2 +015800 02 TEST-ID PIC X(9). IF1414.2 +015900 02 FILLER PIC X(4) VALUE IF1414.2 +016000 " IN ". IF1414.2 +016100 02 FILLER PIC X(12) VALUE IF1414.2 +016200 " HIGH ". IF1414.2 +016300 02 FILLER PIC X(22) VALUE IF1414.2 +016400 " LEVEL VALIDATION FOR ". IF1414.2 +016500 02 FILLER PIC X(58) VALUE IF1414.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1414.2 +016700 01 CCVS-H-3. IF1414.2 +016800 02 FILLER PIC X(34) VALUE IF1414.2 +016900 " FOR OFFICIAL USE ONLY ". IF1414.2 +017000 02 FILLER PIC X(58) VALUE IF1414.2 +017100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1414.2 +017200 02 FILLER PIC X(28) VALUE IF1414.2 +017300 " COPYRIGHT 1985 ". IF1414.2 +017400 01 CCVS-E-1. IF1414.2 +017500 02 FILLER PIC X(52) VALUE SPACE. IF1414.2 +017600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1414.2 +017700 02 ID-AGAIN PIC X(9). IF1414.2 +017800 02 FILLER PIC X(45) VALUE SPACES. IF1414.2 +017900 01 CCVS-E-2. IF1414.2 +018000 02 FILLER PIC X(31) VALUE SPACE. IF1414.2 +018100 02 FILLER PIC X(21) VALUE SPACE. IF1414.2 +018200 02 CCVS-E-2-2. IF1414.2 +018300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1414.2 +018400 03 FILLER PIC X VALUE SPACE. IF1414.2 +018500 03 ENDER-DESC PIC X(44) VALUE IF1414.2 +018600 "ERRORS ENCOUNTERED". IF1414.2 +018700 01 CCVS-E-3. IF1414.2 +018800 02 FILLER PIC X(22) VALUE IF1414.2 +018900 " FOR OFFICIAL USE ONLY". IF1414.2 +019000 02 FILLER PIC X(12) VALUE SPACE. IF1414.2 +019100 02 FILLER PIC X(58) VALUE IF1414.2 +019200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1414.2 +019300 02 FILLER PIC X(13) VALUE SPACE. IF1414.2 +019400 02 FILLER PIC X(15) VALUE IF1414.2 +019500 " COPYRIGHT 1985". IF1414.2 +019600 01 CCVS-E-4. IF1414.2 +019700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1414.2 +019800 02 FILLER PIC X(4) VALUE " OF ". IF1414.2 +019900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1414.2 +020000 02 FILLER PIC X(40) VALUE IF1414.2 +020100 " TESTS WERE EXECUTED SUCCESSFULLY". IF1414.2 +020200 01 XXINFO. IF1414.2 +020300 02 FILLER PIC X(19) VALUE IF1414.2 +020400 "*** INFORMATION ***". IF1414.2 +020500 02 INFO-TEXT. IF1414.2 +020600 04 FILLER PIC X(8) VALUE SPACE. IF1414.2 +020700 04 XXCOMPUTED PIC X(20). IF1414.2 +020800 04 FILLER PIC X(5) VALUE SPACE. IF1414.2 +020900 04 XXCORRECT PIC X(20). IF1414.2 +021000 02 INF-ANSI-REFERENCE PIC X(48). IF1414.2 +021100 01 HYPHEN-LINE. IF1414.2 +021200 02 FILLER PIC IS X VALUE IS SPACE. IF1414.2 +021300 02 FILLER PIC IS X(65) VALUE IS "************************IF1414.2 +021400- "*****************************************". IF1414.2 +021500 02 FILLER PIC IS X(54) VALUE IS "************************IF1414.2 +021600- "******************************". IF1414.2 +021700 01 CCVS-PGM-ID PIC X(9) VALUE IF1414.2 +021800 "IF141A". IF1414.2 +021900 PROCEDURE DIVISION. IF1414.2 +022000 CCVS1 SECTION. IF1414.2 +022100 OPEN-FILES. IF1414.2 +022200 OPEN OUTPUT PRINT-FILE. IF1414.2 +022300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1414.2 +022400 MOVE SPACE TO TEST-RESULTS. IF1414.2 +022500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1414.2 +022600 GO TO CCVS1-EXIT. IF1414.2 +022700 CLOSE-FILES. IF1414.2 +022800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1414.2 +022900 TERMINATE-CCVS. IF1414.2 +023000 STOP RUN. IF1414.2 +023100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1414.2 +023200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1414.2 +023300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1414.2 +023400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1414.2 +023500 MOVE "****TEST DELETED****" TO RE-MARK. IF1414.2 +023600 PRINT-DETAIL. IF1414.2 +023700 IF REC-CT NOT EQUAL TO ZERO IF1414.2 +023800 MOVE "." TO PARDOT-X IF1414.2 +023900 MOVE REC-CT TO DOTVALUE. IF1414.2 +024000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1414.2 +024100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1414.2 +024200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1414.2 +024300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1414.2 +024400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1414.2 +024500 MOVE SPACE TO CORRECT-X. IF1414.2 +024600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1414.2 +024700 MOVE SPACE TO RE-MARK. IF1414.2 +024800 HEAD-ROUTINE. IF1414.2 +024900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +025000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +025100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1414.2 +025200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1414.2 +025300 COLUMN-NAMES-ROUTINE. IF1414.2 +025400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +025500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +025700 END-ROUTINE. IF1414.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1414.2 +025900 END-RTN-EXIT. IF1414.2 +026000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +026100 END-ROUTINE-1. IF1414.2 +026200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1414.2 +026300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1414.2 +026400 ADD PASS-COUNTER TO ERROR-HOLD. IF1414.2 +026500 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1414.2 +026600 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1414.2 +026700 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1414.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1414.2 +026900 END-ROUTINE-12. IF1414.2 +027000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1414.2 +027100 IF ERROR-COUNTER IS EQUAL TO ZERO IF1414.2 +027200 MOVE "NO " TO ERROR-TOTAL IF1414.2 +027300 ELSE IF1414.2 +027400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1414.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1414.2 +027600 PERFORM WRITE-LINE. IF1414.2 +027700 END-ROUTINE-13. IF1414.2 +027800 IF DELETE-COUNTER IS EQUAL TO ZERO IF1414.2 +027900 MOVE "NO " TO ERROR-TOTAL ELSE IF1414.2 +028000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1414.2 +028100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1414.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +028300 IF INSPECT-COUNTER EQUAL TO ZERO IF1414.2 +028400 MOVE "NO " TO ERROR-TOTAL IF1414.2 +028500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1414.2 +028600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1414.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +028800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1414.2 +028900 WRITE-LINE. IF1414.2 +029000 ADD 1 TO RECORD-COUNT. IF1414.2 +029100 IF RECORD-COUNT GREATER 42 IF1414.2 +029200 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1414.2 +029300 MOVE SPACE TO DUMMY-RECORD IF1414.2 +029400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1414.2 +029500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1414.2 +029600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1414.2 +029700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1414.2 +029800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1414.2 +029900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1414.2 +030000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1414.2 +030100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1414.2 +030200 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1414.2 +030300 MOVE ZERO TO RECORD-COUNT. IF1414.2 +030400 PERFORM WRT-LN. IF1414.2 +030500 WRT-LN. IF1414.2 +030600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1414.2 +030700 MOVE SPACE TO DUMMY-RECORD. IF1414.2 +030800 BLANK-LINE-PRINT. IF1414.2 +030900 PERFORM WRT-LN. IF1414.2 +031000 FAIL-ROUTINE. IF1414.2 +031100 IF COMPUTED-X NOT EQUAL TO SPACE IF1414.2 +031200 GO TO FAIL-ROUTINE-WRITE. IF1414.2 +031300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1414.2 +031400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1414.2 +031500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1414.2 +031600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +031700 MOVE SPACES TO INF-ANSI-REFERENCE. IF1414.2 +031800 GO TO FAIL-ROUTINE-EX. IF1414.2 +031900 FAIL-ROUTINE-WRITE. IF1414.2 +032000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE. IF1414.2 +032100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE IF1414.2 +032200 CORMA-ANSI-REFERENCE. IF1414.2 +032300 IF CORRECT-MIN NOT EQUAL TO SPACES THEN IF1414.2 +032400 MOVE TEST-CORRECT-MIN TO PRINT-REC PERFORM WRITE-LINE IF1414.2 +032500 MOVE TEST-CORRECT-MAX TO PRINT-REC PERFORM WRITE-LINE IF1414.2 +032600 ELSE IF1414.2 +032700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE. IF1414.2 +032800 PERFORM WRITE-LINE. IF1414.2 +032900 MOVE SPACES TO COR-ANSI-REFERENCE. IF1414.2 +033000 FAIL-ROUTINE-EX. EXIT. IF1414.2 +033100 BAIL-OUT. IF1414.2 +033200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1414.2 +033300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1414.2 +033400 BAIL-OUT-WRITE. IF1414.2 +033500 MOVE CORRECT-A TO XXCORRECT. IF1414.2 +033600 MOVE COMPUTED-A TO XXCOMPUTED. IF1414.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1414.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1414.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. IF1414.2 +034000 BAIL-OUT-EX. EXIT. IF1414.2 +034100 CCVS1-EXIT. IF1414.2 +034200 EXIT. IF1414.2 +034300******************************************************** IF1414.2 +034400* * IF1414.2 +034500* Intrinsic Function Tests IF141A - VARIANCE * IF1414.2 +034600* * IF1414.2 +034700******************************************************** IF1414.2 +034800 SECT-IF141A SECTION. IF1414.2 +034900 F-VARIANCE-INFO. IF1414.2 +035000 MOVE "See ref. A-74 2.45" TO ANSI-REFERENCE. IF1414.2 +035100 MOVE "VARIANCE Function" TO FEATURE. IF1414.2 +035200*****************TEST (a) - SIMPLE TEST***************** IF1414.2 +035300 F-VARIANCE-01. IF1414.2 +035400 MOVE ZERO TO WS-NUM. IF1414.2 +035500 MOVE 48.6865 TO MIN-RANGE. IF1414.2 +035600 MOVE 48.6885 TO MAX-RANGE. IF1414.2 +035700 F-VARIANCE-TEST-01. IF1414.2 +035800 COMPUTE WS-NUM = FUNCTION VARIANCE(5, -2, -14, 0). IF1414.2 +035900 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +036000 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +036100 PERFORM PASS IF1414.2 +036200 ELSE IF1414.2 +036300 MOVE WS-NUM TO COMPUTED-N IF1414.2 +036400 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +036500 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +036600 PERFORM FAIL. IF1414.2 +036700 GO TO F-VARIANCE-WRITE-01. IF1414.2 +036800 F-VARIANCE-DELETE-01. IF1414.2 +036900 PERFORM DE-LETE. IF1414.2 +037000 GO TO F-VARIANCE-WRITE-01. IF1414.2 +037100 F-VARIANCE-WRITE-01. IF1414.2 +037200 MOVE "F-VARIANCE-01" TO PAR-NAME. IF1414.2 +037300 PERFORM PRINT-DETAIL. IF1414.2 +037400*****************TEST (b) - SIMPLE TEST***************** IF1414.2 +037500 F-VARIANCE-02. IF1414.2 +037600 EVALUATE FUNCTION VARIANCE(3.9, -0.3, 8.7, 100.2) IF1414.2 +037700 WHEN 1741.70 THRU 1741.77 IF1414.2 +037800 PERFORM PASS IF1414.2 +037900 WHEN OTHER IF1414.2 +038000 PERFORM FAIL. IF1414.2 +038100 GO TO F-VARIANCE-WRITE-02. IF1414.2 +038200 F-VARIANCE-DELETE-02. IF1414.2 +038300 PERFORM DE-LETE. IF1414.2 +038400 GO TO F-VARIANCE-WRITE-02. IF1414.2 +038500 F-VARIANCE-WRITE-02. IF1414.2 +038600 MOVE "F-VARIANCE-02" TO PAR-NAME. IF1414.2 +038700 PERFORM PRINT-DETAIL. IF1414.2 +038800*****************TEST (c) - SIMPLE TEST***************** IF1414.2 +038900 F-VARIANCE-03. IF1414.2 +039000 MOVE 27.2494 TO MIN-RANGE. IF1414.2 +039100 MOVE 27.2505 TO MAX-RANGE. IF1414.2 +039200 F-VARIANCE-TEST-03. IF1414.2 +039300 IF (FUNCTION VARIANCE(A, B, C, D) >= MIN-RANGE) AND IF1414.2 +039400 (FUNCTION VARIANCE(A, B, C, D) <= MAX-RANGE) THEN IF1414.2 +039500 PERFORM PASS IF1414.2 +039600 ELSE IF1414.2 +039700 PERFORM FAIL. IF1414.2 +039800 GO TO F-VARIANCE-WRITE-03. IF1414.2 +039900 F-VARIANCE-DELETE-03. IF1414.2 +040000 PERFORM DE-LETE. IF1414.2 +040100 GO TO F-VARIANCE-WRITE-03. IF1414.2 +040200 F-VARIANCE-WRITE-03. IF1414.2 +040300 MOVE "F-VARIANCE-03" TO PAR-NAME. IF1414.2 +040400 PERFORM PRINT-DETAIL. IF1414.2 +040500*****************TEST (d) - SIMPLE TEST***************** IF1414.2 +040600 F-VARIANCE-04. IF1414.2 +040700 MOVE ZERO TO WS-NUM. IF1414.2 +040800 MOVE 283.728 TO MIN-RANGE. IF1414.2 +040900 MOVE 283.740 TO MAX-RANGE. IF1414.2 +041000 F-VARIANCE-TEST-04. IF1414.2 +041100 COMPUTE WS-NUM = FUNCTION VARIANCE(E, F, G, H). IF1414.2 +041200 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +041300 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +041400 PERFORM PASS IF1414.2 +041500 ELSE IF1414.2 +041600 MOVE WS-NUM TO COMPUTED-N IF1414.2 +041700 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +041800 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +041900 PERFORM FAIL. IF1414.2 +042000 GO TO F-VARIANCE-WRITE-04. IF1414.2 +042100 F-VARIANCE-DELETE-04. IF1414.2 +042200 PERFORM DE-LETE. IF1414.2 +042300 GO TO F-VARIANCE-WRITE-04. IF1414.2 +042400 F-VARIANCE-WRITE-04. IF1414.2 +042500 MOVE "F-VARIANCE-04" TO PAR-NAME. IF1414.2 +042600 PERFORM PRINT-DETAIL. IF1414.2 +042700*****************TEST (e) - SIMPLE TEST***************** IF1414.2 +042800 F-VARIANCE-05. IF1414.2 +042900 MOVE ZERO TO WS-NUM. IF1414.2 +043000 MOVE 94.6981 TO MIN-RANGE. IF1414.2 +043100 MOVE 94.7019 TO MAX-RANGE. IF1414.2 +043200 F-VARIANCE-TEST-05. IF1414.2 +043300 COMPUTE WS-NUM = IF1414.2 +043400 FUNCTION VARIANCE(10.2, -0.2, 5.6, -15.6). IF1414.2 +043500 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +043600 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +043700 PERFORM PASS IF1414.2 +043800 ELSE IF1414.2 +043900 MOVE WS-NUM TO COMPUTED-N IF1414.2 +044000 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +044100 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +044200 PERFORM FAIL. IF1414.2 +044300 GO TO F-VARIANCE-WRITE-05. IF1414.2 +044400 F-VARIANCE-DELETE-05. IF1414.2 +044500 PERFORM DE-LETE. IF1414.2 +044600 GO TO F-VARIANCE-WRITE-05. IF1414.2 +044700 F-VARIANCE-WRITE-05. IF1414.2 +044800 MOVE "F-VARIANCE-05" TO PAR-NAME. IF1414.2 +044900 PERFORM PRINT-DETAIL. IF1414.2 +045000*****************TEST (f) - SIMPLE TEST***************** IF1414.2 +045100 F-VARIANCE-06. IF1414.2 +045200 MOVE ZERO TO WS-NUM. IF1414.2 +045300 MOVE 156.194 TO MIN-RANGE. IF1414.2 +045400 MOVE 156.200 TO MAX-RANGE. IF1414.2 +045500 F-VARIANCE-TEST-06. IF1414.2 +045600 COMPUTE WS-NUM = IF1414.2 +045700 FUNCTION VARIANCE(A, B, C, D, E, F, G, H). IF1414.2 +045800 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +045900 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +046000 PERFORM PASS IF1414.2 +046100 ELSE IF1414.2 +046200 MOVE WS-NUM TO COMPUTED-N IF1414.2 +046300 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +046400 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +046500 PERFORM FAIL. IF1414.2 +046600 GO TO F-VARIANCE-WRITE-06. IF1414.2 +046700 F-VARIANCE-DELETE-06. IF1414.2 +046800 PERFORM DE-LETE. IF1414.2 +046900 GO TO F-VARIANCE-WRITE-06. IF1414.2 +047000 F-VARIANCE-WRITE-06. IF1414.2 +047100 MOVE "F-VARIANCE-06" TO PAR-NAME. IF1414.2 +047200 PERFORM PRINT-DETAIL. IF1414.2 +047300*****************TEST (g) - SIMPLE TEST***************** IF1414.2 +047400 F-VARIANCE-07. IF1414.2 +047500 MOVE ZERO TO WS-NUM. IF1414.2 +047600 MOVE 4.66657 TO MIN-RANGE. IF1414.2 +047700 MOVE 4.66675 TO MAX-RANGE. IF1414.2 +047800 F-VARIANCE-TEST-07. IF1414.2 +047900 COMPUTE WS-NUM = IF1414.2 +048000 FUNCTION VARIANCE(IND(1), IND(2), IND(3)). IF1414.2 +048100 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +048200 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +048300 PERFORM PASS IF1414.2 +048400 ELSE IF1414.2 +048500 MOVE WS-NUM TO COMPUTED-N IF1414.2 +048600 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +048700 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +048800 PERFORM FAIL. IF1414.2 +048900 GO TO F-VARIANCE-WRITE-07. IF1414.2 +049000 F-VARIANCE-DELETE-07. IF1414.2 +049100 PERFORM DE-LETE. IF1414.2 +049200 GO TO F-VARIANCE-WRITE-07. IF1414.2 +049300 F-VARIANCE-WRITE-07. IF1414.2 +049400 MOVE "F-VARIANCE-07" TO PAR-NAME. IF1414.2 +049500 PERFORM PRINT-DETAIL. IF1414.2 +049600*****************TEST (h) - SIMPLE TEST***************** IF1414.2 +049700 F-VARIANCE-08. IF1414.2 +049800 MOVE ZERO TO WS-NUM. IF1414.2 +049900 MOVE 2.66661 TO MIN-RANGE. IF1414.2 +050000 MOVE 2.66671 TO MAX-RANGE. IF1414.2 +050100 F-VARIANCE-TEST-08. IF1414.2 +050200 COMPUTE WS-NUM = IF1414.2 +050300 FUNCTION VARIANCE(IND(P), IND(Q), IND(R)). IF1414.2 +050400 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +050500 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +050600 PERFORM PASS IF1414.2 +050700 ELSE IF1414.2 +050800 MOVE WS-NUM TO COMPUTED-N IF1414.2 +050900 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +051000 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +051100 PERFORM FAIL. IF1414.2 +051200 GO TO F-VARIANCE-WRITE-08. IF1414.2 +051300 F-VARIANCE-DELETE-08. IF1414.2 +051400 PERFORM DE-LETE. IF1414.2 +051500 GO TO F-VARIANCE-WRITE-08. IF1414.2 +051600 F-VARIANCE-WRITE-08. IF1414.2 +051700 MOVE "F-VARIANCE-08" TO PAR-NAME. IF1414.2 +051800 PERFORM PRINT-DETAIL. IF1414.2 +051900*****************TEST (i) - SIMPLE TEST***************** IF1414.2 +052000 F-VARIANCE-09. IF1414.2 +052100 MOVE ZERO TO WS-NUM. IF1414.2 +052200 MOVE 5.35989 TO MIN-RANGE. IF1414.2 +052300 MOVE 5.36011 TO MAX-RANGE. IF1414.2 +052400 F-VARIANCE-TEST-09. IF1414.2 +rogerw COMPUTE WS-NUM = FUNCTION VARIANCE (4 0 5 3 7). +052600 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +052700 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +052800 PERFORM PASS IF1414.2 +052900 ELSE IF1414.2 +053000 MOVE WS-NUM TO COMPUTED-N IF1414.2 +053100 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +053200 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +053300 PERFORM FAIL. IF1414.2 +053400 GO TO F-VARIANCE-WRITE-09. IF1414.2 +053500 F-VARIANCE-DELETE-09. IF1414.2 +053600 PERFORM DE-LETE. IF1414.2 +053700 GO TO F-VARIANCE-WRITE-09. IF1414.2 +053800 F-VARIANCE-WRITE-09. IF1414.2 +053900 MOVE "F-VARIANCE-09" TO PAR-NAME. IF1414.2 +054000 PERFORM PRINT-DETAIL. IF1414.2 +054100*****************TEST (k) - SIMPLE TEST***************** IF1414.2 +054200 F-VARIANCE-11. IF1414.2 +054300 MOVE ZERO TO WS-NUM. IF1414.2 +054400 MOVE -0.000020 TO MIN-RANGE. IF1414.2 +054500 MOVE 0.000020 TO MAX-RANGE. IF1414.2 +054600 F-VARIANCE-TEST-11. IF1414.2 +054700 COMPUTE WS-NUM = FUNCTION VARIANCE(A, 5, A). IF1414.2 +054800 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +054900 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +055000 PERFORM PASS IF1414.2 +055100 ELSE IF1414.2 +055200 MOVE WS-NUM TO COMPUTED-N IF1414.2 +055300 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +055400 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +055500 PERFORM FAIL. IF1414.2 +055600 GO TO F-VARIANCE-WRITE-11. IF1414.2 +055700 F-VARIANCE-DELETE-11. IF1414.2 +055800 PERFORM DE-LETE. IF1414.2 +055900 GO TO F-VARIANCE-WRITE-11. IF1414.2 +056000 F-VARIANCE-WRITE-11. IF1414.2 +056100 MOVE "F-VARIANCE-11" TO PAR-NAME. IF1414.2 +056200 PERFORM PRINT-DETAIL. IF1414.2 +056300*****************TEST (a) - COMPLEX TEST**************** IF1414.2 +056400 F-VARIANCE-12. IF1414.2 +056500 MOVE ZERO TO WS-NUM. IF1414.2 +056600 MOVE 78.9968 TO MIN-RANGE. IF1414.2 +056700 MOVE 79.0031 TO MAX-RANGE. IF1414.2 +056800 F-VARIANCE-TEST-12. IF1414.2 +056900 COMPUTE WS-NUM = FUNCTION VARIANCE(A, B) + 78. IF1414.2 +057000 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +057100 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +057200 PERFORM PASS IF1414.2 +057300 ELSE IF1414.2 +057400 MOVE WS-NUM TO COMPUTED-N IF1414.2 +057500 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +057600 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +057700 PERFORM FAIL. IF1414.2 +057800 GO TO F-VARIANCE-WRITE-12. IF1414.2 +057900 F-VARIANCE-DELETE-12. IF1414.2 +058000 PERFORM DE-LETE. IF1414.2 +058100 GO TO F-VARIANCE-WRITE-12. IF1414.2 +058200 F-VARIANCE-WRITE-12. IF1414.2 +058300 MOVE "F-VARIANCE-12" TO PAR-NAME. IF1414.2 +058400 PERFORM PRINT-DETAIL. IF1414.2 +058500*****************TEST (b) - COMPLEX TEST**************** IF1414.2 +058600 F-VARIANCE-13. IF1414.2 +058700 MOVE ZERO TO WS-NUM. IF1414.2 +058800 MOVE 139.234 TO MIN-RANGE. IF1414.2 +058900 MOVE 139.245 TO MAX-RANGE. IF1414.2 +059000 F-VARIANCE-TEST-13. IF1414.2 +059100 COMPUTE WS-NUM = FUNCTION VARIANCE(2.6 + 30, 4.5 * 2). IF1414.2 +059200 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +059300 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +059400 PERFORM PASS IF1414.2 +059500 ELSE IF1414.2 +059600 MOVE WS-NUM TO COMPUTED-N IF1414.2 +059700 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +059800 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +059900 PERFORM FAIL. IF1414.2 +060000 GO TO F-VARIANCE-WRITE-13. IF1414.2 +060100 F-VARIANCE-DELETE-13. IF1414.2 +060200 PERFORM DE-LETE. IF1414.2 +060300 GO TO F-VARIANCE-WRITE-13. IF1414.2 +060400 F-VARIANCE-WRITE-13. IF1414.2 +060500 MOVE "F-VARIANCE-13" TO PAR-NAME. IF1414.2 +060600 PERFORM PRINT-DETAIL. IF1414.2 +060700*****************TEST (c) - COMPLEX TEST**************** IF1414.2 +060800 F-VARIANCE-14. IF1414.2 +060900 MOVE ZERO TO WS-NUM. IF1414.2 +061000 MOVE 374.658 TO MIN-RANGE. IF1414.2 +061100 MOVE 374.688 TO MAX-RANGE. IF1414.2 +061200 F-VARIANCE-TEST-14. IF1414.2 +061300 COMPUTE WS-NUM = FUNCTION VARIANCE(E, 9 * A, 0, B / 2). IF1414.2 +061400 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +061500 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +061600 PERFORM PASS IF1414.2 +061700 ELSE IF1414.2 +061800 MOVE WS-NUM TO COMPUTED-N IF1414.2 +061900 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +062000 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +062100 PERFORM FAIL. IF1414.2 +062200 GO TO F-VARIANCE-WRITE-14. IF1414.2 +062300 F-VARIANCE-DELETE-14. IF1414.2 +062400 PERFORM DE-LETE. IF1414.2 +062500 GO TO F-VARIANCE-WRITE-14. IF1414.2 +062600 F-VARIANCE-WRITE-14. IF1414.2 +062700 MOVE "F-VARIANCE-14" TO PAR-NAME. IF1414.2 +062800 PERFORM PRINT-DETAIL. IF1414.2 +062900*****************TEST (d) - COMPLEX TEST**************** IF1414.2 +063000 F-VARIANCE-15. IF1414.2 +063100 MOVE ZERO TO WS-NUM. IF1414.2 +063200 MOVE 0.999960 TO MIN-RANGE. IF1414.2 +063300 MOVE 1.00004 TO MAX-RANGE. IF1414.2 +063400 F-VARIANCE-TEST-15. IF1414.2 +063500 COMPUTE WS-NUM = FUNCTION VARIANCE(A, B) + IF1414.2 +063600 FUNCTION VARIANCE(1, 1). IF1414.2 +063700 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +063800 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +063900 PERFORM PASS IF1414.2 +064000 ELSE IF1414.2 +064100 MOVE WS-NUM TO COMPUTED-N IF1414.2 +064200 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +064300 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +064400 PERFORM FAIL. IF1414.2 +064500 GO TO F-VARIANCE-WRITE-15. IF1414.2 +064600 F-VARIANCE-DELETE-15. IF1414.2 +064700 PERFORM DE-LETE. IF1414.2 +064800 GO TO F-VARIANCE-WRITE-15. IF1414.2 +064900 F-VARIANCE-WRITE-15. IF1414.2 +065000 MOVE "F-VARIANCE-15" TO PAR-NAME. IF1414.2 +065100 PERFORM PRINT-DETAIL. IF1414.2 +065200*****************TEST (e) - COMPLEX TEST**************** IF1414.2 +065300 F-VARIANCE-16. IF1414.2 +065400 MOVE ZERO TO WS-NUM. IF1414.2 +065500 MOVE -0.000040 TO MIN-RANGE. IF1414.2 +065600 MOVE 0.000040 TO MAX-RANGE. IF1414.2 +065700 F-VARIANCE-TEST-16. IF1414.2 +065800 COMPUTE WS-NUM = FUNCTION VARIANCE( IF1414.2 +065900 FUNCTION VARIANCE(0), 0). IF1414.2 +066000 IF (WS-NUM >= MIN-RANGE) AND IF1414.2 +066100 (WS-NUM <= MAX-RANGE) THEN IF1414.2 +066200 PERFORM PASS IF1414.2 +066300 ELSE IF1414.2 +066400 MOVE WS-NUM TO COMPUTED-N IF1414.2 +066500 MOVE MIN-RANGE TO CORRECT-MIN IF1414.2 +066600 MOVE MAX-RANGE TO CORRECT-MAX IF1414.2 +066700 PERFORM FAIL. IF1414.2 +066800 GO TO F-VARIANCE-WRITE-16. IF1414.2 +066900 F-VARIANCE-DELETE-16. IF1414.2 +067000 PERFORM DE-LETE. IF1414.2 +067100 GO TO F-VARIANCE-WRITE-16. IF1414.2 +067200 F-VARIANCE-WRITE-16. IF1414.2 +067300 MOVE "F-VARIANCE-16" TO PAR-NAME. IF1414.2 +067400 PERFORM PRINT-DETAIL. IF1414.2 +067500*****************SPECIAL PERFORM TEST********************** IF1414.2 +067600 F-VARIANCE-17. IF1414.2 +067700 PERFORM F-VARIANCE-TEST-17 IF1414.2 +067800 UNTIL FUNCTION VARIANCE(1, 1, ARG3) > 3. IF1414.2 +067900 PERFORM PASS. IF1414.2 +068000 GO TO F-VARIANCE-WRITE-17. IF1414.2 +068100 F-VARIANCE-TEST-17. IF1414.2 +068200 COMPUTE ARG3 = ARG3 + 1. IF1414.2 +068300 F-VARIANCE-DELETE-17. IF1414.2 +068400 PERFORM DE-LETE. IF1414.2 +068500 GO TO F-VARIANCE-WRITE-17. IF1414.2 +068600 F-VARIANCE-WRITE-17. IF1414.2 +068700 MOVE "F-VARIANCE-17" TO PAR-NAME. IF1414.2 +068800 PERFORM PRINT-DETAIL. IF1414.2 +068900********************END OF TESTS*************** IF1414.2 +069000 CCVS-EXIT SECTION. IF1414.2 +069100 CCVS-999999. IF1414.2 +069200 GO TO CLOSE-FILES. IF1414.2 diff --git a/tests/cobol85/IF/IF142A.CBL b/tests/cobol85/IF/IF142A.CBL new file mode 100755 index 00000000..a4966b63 --- /dev/null +++ b/tests/cobol85/IF/IF142A.CBL @@ -0,0 +1,367 @@ +000100 IDENTIFICATION DIVISION. IF1424.2 +000200 PROGRAM-ID. IF1424.2 +000300 IF142A. IF1424.2 +000400 IF1424.2 +000500*********************************************************** IF1424.2 +000600* * IF1424.2 +000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1424.2 +000800* It contains tests for the Intrinsic Function * IF1424.2 +000900* WHEN-COMPILED. * IF1424.2 +001000* * IF1424.2 +001100*********************************************************** IF1424.2 +001200 ENVIRONMENT DIVISION. IF1424.2 +001300 CONFIGURATION SECTION. IF1424.2 +001400 SOURCE-COMPUTER. IF1424.2 +001500 Linux. IF1424.2 +001600 OBJECT-COMPUTER. IF1424.2 +001700 Linux. IF1424.2 +001800 INPUT-OUTPUT SECTION. IF1424.2 +001900 FILE-CONTROL. IF1424.2 +002000 SELECT PRINT-FILE ASSIGN TO IF1424.2 +002100 "report.log". IF1424.2 +002200 DATA DIVISION. IF1424.2 +002300 FILE SECTION. IF1424.2 +002400 FD PRINT-FILE. IF1424.2 +002500 01 PRINT-REC PICTURE X(120). IF1424.2 +002600 01 DUMMY-RECORD PICTURE X(120). IF1424.2 +002700 WORKING-STORAGE SECTION. IF1424.2 +002800*********************************************************** IF1424.2 +002900* Variables specific to the Intrinsic Function Test IF142A* IF1424.2 +003000*********************************************************** IF1424.2 +003100 01 TEMP1 PIC X(21). IF1424.2 +003200 01 WS-DATE. IF1424.2 +003300 02 WS-YEAR PIC 9999. IF1424.2 +003400 88 CON-YEAR VALUE 1990 THRU 9999. IF1424.2 +003500 02 WS-MONTH PIC 99. IF1424.2 +003600 88 CON-MONTH VALUE 01 THRU 12. IF1424.2 +003700 02 WS-DAY PIC 99. IF1424.2 +003800 88 CON-DAY VALUE 01 THRU 31. IF1424.2 +003900 02 WS-HOUR PIC 99. IF1424.2 +004000 88 CON-HOUR VALUE 00 THRU 23. IF1424.2 +004100 02 WS-MIN PIC 99. IF1424.2 +004200 88 CON-MIN VALUE 00 THRU 59. IF1424.2 +004300 02 WS-SECOND PIC 99. IF1424.2 +004400 88 CON-SEC VALUE 00 THRU 59. IF1424.2 +004500 02 WS-HUNDSEC PIC 99. IF1424.2 +004600 88 CON-HUNDSEC VALUE 00 THRU 99. IF1424.2 +004700 02 WS-GREENW PIC X. IF1424.2 +004800 88 CON-GREENW VALUE "-", "+", "0". IF1424.2 +004900 02 WS-OFFSET PIC 99. IF1424.2 +005000 88 CON-OFFSET VALUE 00 THRU 13. IF1424.2 +005100* IF1424.2 +005200********************************************************** IF1424.2 +005300* IF1424.2 +005400 01 TEST-RESULTS. IF1424.2 +005500 02 FILLER PIC X VALUE SPACE. IF1424.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. IF1424.2 +005700 02 FILLER PIC X VALUE SPACE. IF1424.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. IF1424.2 +005900 02 FILLER PIC X VALUE SPACE. IF1424.2 +006000 02 PAR-NAME. IF1424.2 +006100 03 FILLER PIC X(19) VALUE SPACE. IF1424.2 +006200 03 PARDOT-X PIC X VALUE SPACE. IF1424.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. IF1424.2 +006400 02 FILLER PIC X(8) VALUE SPACE. IF1424.2 +006500 02 RE-MARK PIC X(61). IF1424.2 +006600 01 TEST-COMPUTED. IF1424.2 +006700 02 FILLER PIC X(30) VALUE SPACE. IF1424.2 +006800 02 FILLER PIC X(17) VALUE IF1424.2 +006900 " COMPUTED=". IF1424.2 +007000 02 COMPUTED-X. IF1424.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1424.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A IF1424.2 +007300 PIC -9(9).9(9). IF1424.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1424.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1424.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1424.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. IF1424.2 +007800 04 COMPUTED-18V0 PIC -9(18). IF1424.2 +007900 04 FILLER PIC X. IF1424.2 +008000 03 FILLER PIC X(50) VALUE SPACE. IF1424.2 +008100 01 TEST-CORRECT. IF1424.2 +008200 02 FILLER PIC X(30) VALUE SPACE. IF1424.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". IF1424.2 +008400 02 CORRECT-X. IF1424.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. IF1424.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1424.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1424.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1424.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1424.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. IF1424.2 +009100 04 CORRECT-18V0 PIC -9(18). IF1424.2 +009200 04 FILLER PIC X. IF1424.2 +009300 03 FILLER PIC X(2) VALUE SPACE. IF1424.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1424.2 +009500 01 CCVS-C-1. IF1424.2 +009600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1424.2 +009700- "SS PARAGRAPH-NAME IF1424.2 +009800- " REMARKS". IF1424.2 +009900 02 FILLER PIC X(20) VALUE SPACE. IF1424.2 +010000 01 CCVS-C-2. IF1424.2 +010100 02 FILLER PIC X VALUE SPACE. IF1424.2 +010200 02 FILLER PIC X(6) VALUE "TESTED". IF1424.2 +010300 02 FILLER PIC X(15) VALUE SPACE. IF1424.2 +010400 02 FILLER PIC X(4) VALUE "FAIL". IF1424.2 +010500 02 FILLER PIC X(94) VALUE SPACE. IF1424.2 +010600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1424.2 +010700 01 REC-CT PIC 99 VALUE ZERO. IF1424.2 +010800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1424.2 +010900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1424.2 +011000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1424.2 +011100 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1424.2 +011200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1424.2 +011300 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1424.2 +011400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1424.2 +011500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1424.2 +011600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1424.2 +011700 01 CCVS-H-1. IF1424.2 +011800 02 FILLER PIC X(39) VALUE SPACES. IF1424.2 +011900 02 FILLER PIC X(42) VALUE IF1424.2 +012000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1424.2 +012100 02 FILLER PIC X(39) VALUE SPACES. IF1424.2 +012200 01 CCVS-H-2A. IF1424.2 +012300 02 FILLER PIC X(40) VALUE SPACE. IF1424.2 +012400 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1424.2 +012500 02 FILLER PIC XXXX VALUE IF1424.2 +012600 "4.2 ". IF1424.2 +012700 02 FILLER PIC X(28) VALUE IF1424.2 +012800 " COPY - NOT FOR DISTRIBUTION". IF1424.2 +012900 02 FILLER PIC X(41) VALUE SPACE. IF1424.2 +013000 IF1424.2 +013100 01 CCVS-H-2B. IF1424.2 +013200 02 FILLER PIC X(15) VALUE IF1424.2 +013300 "TEST RESULT OF ". IF1424.2 +013400 02 TEST-ID PIC X(9). IF1424.2 +013500 02 FILLER PIC X(4) VALUE IF1424.2 +013600 " IN ". IF1424.2 +013700 02 FILLER PIC X(12) VALUE IF1424.2 +013800 " HIGH ". IF1424.2 +013900 02 FILLER PIC X(22) VALUE IF1424.2 +014000 " LEVEL VALIDATION FOR ". IF1424.2 +014100 02 FILLER PIC X(58) VALUE IF1424.2 +014200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1424.2 +014300 01 CCVS-H-3. IF1424.2 +014400 02 FILLER PIC X(34) VALUE IF1424.2 +014500 " FOR OFFICIAL USE ONLY ". IF1424.2 +014600 02 FILLER PIC X(58) VALUE IF1424.2 +014700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1424.2 +014800 02 FILLER PIC X(28) VALUE IF1424.2 +014900 " COPYRIGHT 1985 ". IF1424.2 +015000 01 CCVS-E-1. IF1424.2 +015100 02 FILLER PIC X(52) VALUE SPACE. IF1424.2 +015200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1424.2 +015300 02 ID-AGAIN PIC X(9). IF1424.2 +015400 02 FILLER PIC X(45) VALUE SPACES. IF1424.2 +015500 01 CCVS-E-2. IF1424.2 +015600 02 FILLER PIC X(31) VALUE SPACE. IF1424.2 +015700 02 FILLER PIC X(21) VALUE SPACE. IF1424.2 +015800 02 CCVS-E-2-2. IF1424.2 +015900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1424.2 +016000 03 FILLER PIC X VALUE SPACE. IF1424.2 +016100 03 ENDER-DESC PIC X(44) VALUE IF1424.2 +016200 "ERRORS ENCOUNTERED". IF1424.2 +016300 01 CCVS-E-3. IF1424.2 +016400 02 FILLER PIC X(22) VALUE IF1424.2 +016500 " FOR OFFICIAL USE ONLY". IF1424.2 +016600 02 FILLER PIC X(12) VALUE SPACE. IF1424.2 +016700 02 FILLER PIC X(58) VALUE IF1424.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1424.2 +016900 02 FILLER PIC X(13) VALUE SPACE. IF1424.2 +017000 02 FILLER PIC X(15) VALUE IF1424.2 +017100 " COPYRIGHT 1985". IF1424.2 +017200 01 CCVS-E-4. IF1424.2 +017300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1424.2 +017400 02 FILLER PIC X(4) VALUE " OF ". IF1424.2 +017500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1424.2 +017600 02 FILLER PIC X(40) VALUE IF1424.2 +017700 " TESTS WERE EXECUTED SUCCESSFULLY". IF1424.2 +017800 01 XXINFO. IF1424.2 +017900 02 FILLER PIC X(19) VALUE IF1424.2 +018000 "*** INFORMATION ***". IF1424.2 +018100 02 INFO-TEXT. IF1424.2 +018200 04 FILLER PIC X(8) VALUE SPACE. IF1424.2 +018300 04 XXCOMPUTED PIC X(20). IF1424.2 +018400 04 FILLER PIC X(5) VALUE SPACE. IF1424.2 +018500 04 XXCORRECT PIC X(20). IF1424.2 +018600 02 INF-ANSI-REFERENCE PIC X(48). IF1424.2 +018700 01 HYPHEN-LINE. IF1424.2 +018800 02 FILLER PIC IS X VALUE IS SPACE. IF1424.2 +018900 02 FILLER PIC IS X(65) VALUE IS "************************IF1424.2 +019000- "*****************************************". IF1424.2 +019100 02 FILLER PIC IS X(54) VALUE IS "************************IF1424.2 +019200- "******************************". IF1424.2 +019300 01 CCVS-PGM-ID PIC X(9) VALUE IF1424.2 +019400 "IF142A". IF1424.2 +019500 PROCEDURE DIVISION. IF1424.2 +019600 CCVS1 SECTION. IF1424.2 +019700 OPEN-FILES. IF1424.2 +019800 OPEN OUTPUT PRINT-FILE. IF1424.2 +019900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1424.2 +020000 MOVE SPACE TO TEST-RESULTS. IF1424.2 +020100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1424.2 +020200 GO TO CCVS1-EXIT. IF1424.2 +020300 CLOSE-FILES. IF1424.2 +020400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1424.2 +020500 TERMINATE-CCVS. IF1424.2 +020600 STOP RUN. IF1424.2 +020700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1424.2 +020800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1424.2 +020900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1424.2 +021000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1424.2 +021100 MOVE "****TEST DELETED****" TO RE-MARK. IF1424.2 +021200 PRINT-DETAIL. IF1424.2 +021300 IF REC-CT NOT EQUAL TO ZERO IF1424.2 +021400 MOVE "." TO PARDOT-X IF1424.2 +021500 MOVE REC-CT TO DOTVALUE. IF1424.2 +021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1424.2 +021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1424.2 +021800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1424.2 +021900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1424.2 +022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1424.2 +022100 MOVE SPACE TO CORRECT-X. IF1424.2 +022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1424.2 +022300 MOVE SPACE TO RE-MARK. IF1424.2 +022400 HEAD-ROUTINE. IF1424.2 +022500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +022600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +022700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1424.2 +022800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1424.2 +022900 COLUMN-NAMES-ROUTINE. IF1424.2 +023000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +023100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +023300 END-ROUTINE. IF1424.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 IF1424.2 +023500 TIMES. IF1424.2 +023600 END-RTN-EXIT. IF1424.2 +023700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +023800 END-ROUTINE-1. IF1424.2 +023900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1424.2 +024000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1424.2 +024100 ADD PASS-COUNTER TO ERROR-HOLD. IF1424.2 +024200 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1424.2 +024300 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1424.2 +024400 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1424.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1424.2 +024600 END-ROUTINE-12. IF1424.2 +024700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1424.2 +024800 IF ERROR-COUNTER IS EQUAL TO ZERO IF1424.2 +024900 MOVE "NO " TO ERROR-TOTAL IF1424.2 +025000 ELSE IF1424.2 +025100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1424.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1424.2 +025300 PERFORM WRITE-LINE. IF1424.2 +025400 END-ROUTINE-13. IF1424.2 +025500 IF DELETE-COUNTER IS EQUAL TO ZERO IF1424.2 +025600 MOVE "NO " TO ERROR-TOTAL ELSE IF1424.2 +025700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1424.2 +025800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1424.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +026000 IF INSPECT-COUNTER EQUAL TO ZERO IF1424.2 +026100 MOVE "NO " TO ERROR-TOTAL IF1424.2 +026200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1424.2 +026300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1424.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +026500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1424.2 +026600 WRITE-LINE. IF1424.2 +026700 ADD 1 TO RECORD-COUNT. IF1424.2 +026800 IF RECORD-COUNT GREATER 42 IF1424.2 +026900 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1424.2 +027000 MOVE SPACE TO DUMMY-RECORD IF1424.2 +027100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1424.2 +027200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1424.2 +027300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1424.2 +027400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1424.2 +027500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1424.2 +027600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1424.2 +027700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1424.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1424.2 +027900 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1424.2 +028000 MOVE ZERO TO RECORD-COUNT. IF1424.2 +028100 PERFORM WRT-LN. IF1424.2 +028200 WRT-LN. IF1424.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1424.2 +028400 MOVE SPACE TO DUMMY-RECORD. IF1424.2 +028500 BLANK-LINE-PRINT. IF1424.2 +028600 PERFORM WRT-LN. IF1424.2 +028700 FAIL-ROUTINE. IF1424.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE IF1424.2 +028900 GO TO FAIL-ROUTINE-WRITE. IF1424.2 +029000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1424.2 +029100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1424.2 +029200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1424.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1424.2 +029500 GO TO FAIL-ROUTINE-EX. IF1424.2 +029600 FAIL-ROUTINE-WRITE. IF1424.2 +029700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1424.2 +029800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1424.2 +029900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1424.2 +030000 MOVE SPACES TO COR-ANSI-REFERENCE. IF1424.2 +030100 FAIL-ROUTINE-EX. EXIT. IF1424.2 +030200 BAIL-OUT. IF1424.2 +030300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1424.2 +030400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1424.2 +030500 BAIL-OUT-WRITE. IF1424.2 +030600 MOVE CORRECT-A TO XXCORRECT. IF1424.2 +030700 MOVE COMPUTED-A TO XXCOMPUTED. IF1424.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1424.2 +030900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1424.2 +031000 MOVE SPACES TO INF-ANSI-REFERENCE. IF1424.2 +031100 BAIL-OUT-EX. EXIT. IF1424.2 +031200 CCVS1-EXIT. IF1424.2 +031300 EXIT. IF1424.2 +031400******************************************************** IF1424.2 +031500* * IF1424.2 +031600* Intrinsic Function Tests IF142A - WHEN-COMPILED * IF1424.2 +031700* * IF1424.2 +031800******************************************************** IF1424.2 +031900 SECT-IF142A SECTION. IF1424.2 +032000 F-WHENCOMP-INFO. IF1424.2 +032100 MOVE "See ref. A-75 2.46" TO ANSI-REFERENCE. IF1424.2 +032200 MOVE "WHEN-COMPILED" TO FEATURE. IF1424.2 +032300*****************TEST (a) ****************************** IF1424.2 +032400 F-WHENCOMP-01. IF1424.2 +032500 MOVE SPACES TO TEMP1. IF1424.2 +032600 MOVE SPACES TO WS-DATE. IF1424.2 +032700 F-WHENCOMP-TEST-01. IF1424.2 +032800 MOVE FUNCTION WHEN-COMPILED TO TEMP1. IF1424.2 +032900 MOVE TEMP1 TO WS-DATE. IF1424.2 +033000 IF CON-YEAR AND IF1424.2 +033100 CON-MONTH AND IF1424.2 +033200 CON-DAY AND IF1424.2 +033300 CON-HOUR AND IF1424.2 +033400 CON-MIN AND IF1424.2 +033500 CON-SEC AND IF1424.2 +033600 CON-HUNDSEC AND IF1424.2 +033700 CON-GREENW AND IF1424.2 +033800 CON-OFFSET THEN IF1424.2 +033900 PERFORM PASS IF1424.2 +034000 ELSE IF1424.2 +034100 MOVE TEMP1 TO COMPUTED-A IF1424.2 +034200 MOVE "Date & Time value " TO CORRECT-X IF1424.2 +034300 PERFORM FAIL. IF1424.2 +034400 GO TO F-WHENCOMP-WRITE-01. IF1424.2 +034500 F-WHENCOMP-DELETE-01. IF1424.2 +034600 PERFORM DE-LETE. IF1424.2 +034700 GO TO F-WHENCOMP-WRITE-01. IF1424.2 +034800 F-WHENCOMP-WRITE-01. IF1424.2 +034900 MOVE "F-WHENCOMP-01" TO PAR-NAME. IF1424.2 +035000 PERFORM PRINT-DETAIL. IF1424.2 +035100*****************TEST (b) ****************************** IF1424.2 +035200 F-WHENCOMP-TEST-02. IF1424.2 +035300 IF FUNCTION WHEN-COMPILED >= TEMP1 THEN IF1424.2 +035400 PERFORM PASS IF1424.2 +035500 ELSE IF1424.2 +035600 PERFORM FAIL. IF1424.2 +035700 GO TO F-WHENCOMP-WRITE-02. IF1424.2 +035800 F-WHENCOMP-DELETE-02. IF1424.2 +035900 PERFORM DE-LETE. IF1424.2 +036000 GO TO F-WHENCOMP-WRITE-02. IF1424.2 +036100 F-WHENCOMP-WRITE-02. IF1424.2 +036200 MOVE "F-WHENCOMP-02" TO PAR-NAME. IF1424.2 +036300 PERFORM PRINT-DETAIL. IF1424.2 +036400*******************END OF TESTS************************** IF1424.2 +036500 CCVS-EXIT SECTION. IF1424.2 +036600 CCVS-999999. IF1424.2 +036700 GO TO CLOSE-FILES. IF1424.2 diff --git a/tests/cobol85/IF/IF401M.CBL b/tests/cobol85/IF/IF401M.CBL new file mode 100755 index 00000000..430f0f6e --- /dev/null +++ b/tests/cobol85/IF/IF401M.CBL @@ -0,0 +1,104 @@ +000100 IDENTIFICATION DIVISION. IF4014.2 +000200 PROGRAM-ID. IF4014.2 +000300 IF401M. IF4014.2 +000400 IF4014.2 +000500 IF4014.2 +000600*THIS PROGRAM TESTS THE FLAGGING OF HIGH SUBSET INTRINSIC FUNCTIONIF4014.2 +000700*FEATURES. IF4014.2 +000800******************************************************************IF4014.2 +000900* THIS PROGRAMS CONTAINS TESTS FOR THE FOLLOWING INTRINSIC *IF4014.2 +001000* FUNCTIONS: ACOS, ANNUITY, ASIN, ATAN, CHAR, COS, *IF4014.2 +001100* CURRENT-DATE, DATE-OF-INTEGER, DAY-OF-INTEGER, *IF4014.2 +001200* FACTORIAL, INTEGER, INTEGER-OF-DATE, *IF4014.2 +001300* INTEGER-OF-DAY AND INTEGER-PART. *IF4014.2 +001400******************************************************************IF4014.2 +001500 IF4014.2 +001600 ENVIRONMENT DIVISION. IF4014.2 +001700 CONFIGURATION SECTION. IF4014.2 +001800 SOURCE-COMPUTER. IF4014.2 +001900 Linux. IF4014.2 +002000 OBJECT-COMPUTER. IF4014.2 +002100 Linux. IF4014.2 +002200 IF4014.2 +002300 DATA DIVISION. IF4014.2 +002400 FILE SECTION. IF4014.2 +002500 WORKING-STORAGE SECTION. IF4014.2 +002600 01 TEMP1 PICTURE X(21). IF4014.2 +002700 01 WS-ANUM PICTURE X. IF4014.2 +002800 IF4014.2 +002900 PROCEDURE DIVISION. IF4014.2 +003000 IF401M-ACOS. IF4014.2 +003100 IF FUNCTION ACOS (1.0) = FUNCTION ACOS (1.0) IF4014.2 +003200 CONTINUE. IF4014.2 +003300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +003400 IF4014.2 +003500 IF401M-ANNUITY. IF4014.2 +003600 IF FUNCTION ANNUITY (0, 4) = FUNCTION ANNUITY (0, 4) IF4014.2 +003700 CONTINUE. IF4014.2 +003800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +003900 IF4014.2 +004000 IF401M-ASIN. IF4014.2 +004100 IF FUNCTION ASIN (1.0) = FUNCTION ASIN (1.0) IF4014.2 +004200 CONTINUE. IF4014.2 +004300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +004400 IF4014.2 +004500 IF401M-ATAN. IF4014.2 +004600 IF FUNCTION ATAN (1.0) = FUNCTION ATAN (1.0) IF4014.2 +004700 CONTINUE. IF4014.2 +004800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +004900 IF4014.2 +005000 IF401M-CHAR. IF4014.2 +005100 MOVE FUNCTION CHAR (37) TO WS-ANUM. IF4014.2 +005200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +005300 IF4014.2 +005400 IF401M-COS. IF4014.2 +005500 IF FUNCTION COS (1.0) = FUNCTION COS (1.0) IF4014.2 +005600 CONTINUE. IF4014.2 +005700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +005800 IF4014.2 +005900 IF401M-CURRENT-DATE. IF4014.2 +006000 MOVE FUNCTION CURRENT-DATE TO TEMP1. IF4014.2 +006100*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +006200 IF4014.2 +006300 IF401M-DATE-OF-INTEGER. IF4014.2 +006400 IF FUNCTION DATE-OF-INTEGER (1) = IF4014.2 +006500 FUNCTION DATE-OF-INTEGER (1) IF4014.2 +006600 CONTINUE. IF4014.2 +006700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +006800 IF4014.2 +006900 IF401M-DAY-OF-INTEGER. IF4014.2 +007000 IF FUNCTION DAY-OF-INTEGER (1) = FUNCTION DAY-OF-INTEGER (1) IF4014.2 +007100 CONTINUE. IF4014.2 +007200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +007300 IF4014.2 +007400 IF401M-FACTORIAL. IF4014.2 +007500 IF FUNCTION FACTORIAL (1) = FUNCTION FACTORIAL (1) IF4014.2 +007600 CONTINUE. IF4014.2 +007700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +007800 IF4014.2 +007900 IF401M-INTEGER. IF4014.2 +008000 IF FUNCTION INTEGER (1.0) = FUNCTION INTEGER (1.0) IF4014.2 +008100 CONTINUE. IF4014.2 +008200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +008300 IF4014.2 +008400 IF401M-INTEGER-OF-DATE. IF4014.2 +008500 IF FUNCTION INTEGER-OF-DATE (16010101) = IF4014.2 +008600 FUNCTION INTEGER-OF-DATE (16010101) IF4014.2 +008700 CONTINUE. IF4014.2 +008800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +008900 IF4014.2 +009000 IF401M-INTEGER-OF-DAY. IF4014.2 +009100 IF FUNCTION INTEGER-OF-DAY (1601001) = IF4014.2 +009200 FUNCTION INTEGER-OF-DAY (1601001) IF4014.2 +009300 CONTINUE. IF4014.2 +009400*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +009500 IF4014.2 +009600 IF401M-INTEGER-PART. IF4014.2 +009700 IF FUNCTION INTEGER-PART (4.578) = IF4014.2 +009800 FUNCTION INTEGER-PART (4.578) IF4014.2 +009900 CONTINUE. IF4014.2 +010000*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4014.2 +010100 IF4014.2 +010200 IF401M-END. IF4014.2 +010300 IF4014.2 +010400*TOTAL NUMBER OF FLAGS EXPECTED = 14. IF4014.2 diff --git a/tests/cobol85/IF/IF402M.CBL b/tests/cobol85/IF/IF402M.CBL new file mode 100755 index 00000000..4e5ba1f8 --- /dev/null +++ b/tests/cobol85/IF/IF402M.CBL @@ -0,0 +1,124 @@ +000100 IDENTIFICATION DIVISION. IF4024.2 +000200 PROGRAM-ID. IF4024.2 +000300 IF402M. IF4024.2 +000400 IF4024.2 +000500 IF4024.2 +000600*THIS PROGRAM TESTS THE FLAGGING OF HIGH SUBSET INTRINSIC FUNCTIONIF4024.2 +000700*FEATURES. IF4024.2 +000800******************************************************************IF4024.2 +000900* THIS PROGRAMS CONTAINS TESTS FOR THE FOLLOWING INTRINSIC *IF4024.2 +001000* FUNCTIONS: LENGTH, LOG, LOG10, LOWER-CASE, MAX, MEAN, *IF4024.2 +001100* MEDIAN, MIDRANGE, MIN, MOD, NUMVAL, NUMVAL-C, *IF4024.2 +001200* ORD, ORD-MAX AND ORD-MIN. *IF4024.2 +001300******************************************************************IF4024.2 +001400 IF4024.2 +001500 ENVIRONMENT DIVISION. IF4024.2 +001600 CONFIGURATION SECTION. IF4024.2 +001700 SOURCE-COMPUTER. IF4024.2 +001800 Linux. IF4024.2 +001900 OBJECT-COMPUTER. IF4024.2 +002000 Linux. IF4024.2 +002100 IF4024.2 +002200 DATA DIVISION. IF4024.2 +002300 FILE SECTION. IF4024.2 +002400 WORKING-STORAGE SECTION. IF4024.2 +002500 01 WS-AN-TEMP PICTURE X(3). IF4024.2 +002600 01 WS-TABLE-VALUE PICTURE X(27) IF4024.2 +002700 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ ". IF4024.2 +002800 01 WS-TABLE-TOTAL REDEFINES WS-TABLE-VALUE. IF4024.2 +002900 05 WS-TABLE-LV3 OCCURS 3 TIMES. IF4024.2 +003000 10 WS-TABLE-LV2 OCCURS 3 TIMES. IF4024.2 +003100 15 WS-TABLE PICTURE X OCCURS 3 TIMES. IF4024.2 +003200 IF4024.2 +003300 PROCEDURE DIVISION. IF4024.2 +003400 IF402M-LENGTH. IF4024.2 +003500 IF FUNCTION LENGTH ("ABC") = FUNCTION LENGTH ("ABC") IF4024.2 +003600 CONTINUE. IF4024.2 +003700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +003800 IF4024.2 +003900 IF402M-LOG. IF4024.2 +004000 IF FUNCTION LOG (1.0) = FUNCTION LOG (1.0) IF4024.2 +004100 CONTINUE. IF4024.2 +004200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +004300 IF4024.2 +004400 IF402M-LOG10. IF4024.2 +004500 IF FUNCTION LOG10 (1.0) = FUNCTION LOG10 (1.0) IF4024.2 +004600 CONTINUE. IF4024.2 +004700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +004800 IF4024.2 +004900 IF402M-LOWER-CASE. IF4024.2 +005000 MOVE FUNCTION LOWER-CASE ("ABC") TO WS-AN-TEMP. IF4024.2 +005100*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +005200 IF4024.2 +005300 IF402M-MAX. IF4024.2 +005400 IF FUNCTION MAX (5, 6, 10, 3, 7) = IF4024.2 +005500 FUNCTION MAX (5, 6, 10, 3, 7) IF4024.2 +005600 CONTINUE. IF4024.2 +005700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +005800 IF4024.2 +005900 MOVE FUNCTION MAX (WS-TABLE (ALL, ALL, ALL)) TO WS-AN-TEMP. IF4024.2 +006000*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +006100 IF4024.2 +006200 IF402M-MEAN. IF4024.2 +006300 IF FUNCTION MEAN (5, -2, -14, 0) = IF4024.2 +006400 FUNCTION MEAN (5, -2, -14, 0) IF4024.2 +006500 CONTINUE. IF4024.2 +006600*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +006700 IF4024.2 +006800 IF402M-MEDIAN. IF4024.2 +006900 IF FUNCTION MEDIAN (5, -2, -14, 0) = IF4024.2 +007000 FUNCTION MEDIAN (5, -2, -14, 0) IF4024.2 +007100 CONTINUE. IF4024.2 +007200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +007300 IF4024.2 +007400 IF402M-MIDRANGE. IF4024.2 +007500 IF FUNCTION MIDRANGE (5, -2, -14, 0) = IF4024.2 +007600 FUNCTION MIDRANGE (5, -2, -14, 0) IF4024.2 +007700 CONTINUE. IF4024.2 +007800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +007900 IF4024.2 +008000 IF402M-MIN. IF4024.2 +008100 IF FUNCTION MIN (5, 6, 10, 3, 7) = IF4024.2 +008200 FUNCTION MIN (5, 6, 10, 3, 7) IF4024.2 +008300 CONTINUE. IF4024.2 +008400*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +008500 IF4024.2 +008600 MOVE FUNCTION MIN (WS-TABLE (ALL, ALL, ALL)) TO WS-AN-TEMP. IF4024.2 +008700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +008800 IF4024.2 +008900 IF402M-MOD. IF4024.2 +009000 IF FUNCTION MOD (6, 6) = FUNCTION MOD (6, 6) IF4024.2 +009100 CONTINUE. IF4024.2 +009200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +009300 IF4024.2 +009400 IF402M-NUMVAL. IF4024.2 +009500 IF FUNCTION NUMVAL ("4738") = FUNCTION NUMVAL ("4738") IF4024.2 +009600 CONTINUE. IF4024.2 +009700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +009800 IF4024.2 +009900 IF402M-NUMVAL-C. IF4024.2 +010000 IF FUNCTION NUMVAL-C ("-$1,234.56") = IF4024.2 +010100 FUNCTION NUMVAL-C ("-$1,234.56") IF4024.2 +010200 CONTINUE. IF4024.2 +010300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +010400 IF4024.2 +010500 IF402M-ORD. IF4024.2 +010600 IF FUNCTION ORD ("A") = FUNCTION ORD ("A") IF4024.2 +010700 CONTINUE. IF4024.2 +010800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +010900 IF4024.2 +011000 IF402M-ORD-MAX. IF4024.2 +011100 IF FUNCTION ORD-MAX (5, 3, 2, 8, 3, 1) = IF4024.2 +011200 FUNCTION ORD-MAX (5, 3, 2, 8, 3, 1) IF4024.2 +011300 CONTINUE. IF4024.2 +011400*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +011500 IF4024.2 +011600 IF402M-ORD-MIN. IF4024.2 +011700 IF FUNCTION ORD-MIN (5, 3, 2, 8, 3, 1) = IF4024.2 +011800 FUNCTION ORD-MIN (5, 3, 2, 8, 3, 1) IF4024.2 +011900 CONTINUE. IF4024.2 +012000*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4024.2 +012100 IF4024.2 +012200 IF402M-END. IF4024.2 +012300 IF4024.2 +012400*TOTAL NUMBER OF FLAGS EXPECTED = 17. IF4024.2 diff --git a/tests/cobol85/IF/IF403M.CBL b/tests/cobol85/IF/IF403M.CBL new file mode 100755 index 00000000..f2c0d497 --- /dev/null +++ b/tests/cobol85/IF/IF403M.CBL @@ -0,0 +1,97 @@ +000100 IDENTIFICATION DIVISION. IF4034.2 +000200 PROGRAM-ID. IF4034.2 +000300 IF403M. IF4034.2 +000400 IF4034.2 +000500 IF4034.2 +000600*THIS PROGRAM TESTS THE FLAGGING OF HIGH SUBSET INTRINSIC FUNCTIONIF4034.2 +000700*FEATURES. IF4034.2 +000800******************************************************************IF4034.2 +000900* THIS PROGRAMS CONTAINS TESTS FOR THE FOLLOWING INTRINSIC *IF4034.2 +001000* FUNCTIONS: PRESENT-VALUE, RANDOM, RANGE, REM, REVERSE, *IF4034.2 +001100* SIN, SQRT, STANDARD-DEVIATION, SUM, TAN, *IF4034.2 +001200* UPPER-CASE, VARIANCE AND WHEN-COMPILED. *IF4034.2 +001300******************************************************************IF4034.2 +001400 IF4034.2 +001500 ENVIRONMENT DIVISION. IF4034.2 +001600 CONFIGURATION SECTION. IF4034.2 +001700 SOURCE-COMPUTER. IF4034.2 +001800 Linux. IF4034.2 +001900 OBJECT-COMPUTER. IF4034.2 +002000 Linux. IF4034.2 +002100 IF4034.2 +002200 DATA DIVISION. IF4034.2 +002300 FILE SECTION. IF4034.2 +002400 WORKING-STORAGE SECTION. IF4034.2 +002500 01 WS-AN-TEMP PICTURE X(21). IF4034.2 +002600 IF4034.2 +002700 PROCEDURE DIVISION. IF4034.2 +002800 IF403M-PRESENT-VALUE. IF4034.2 +002900 IF FUNCTION PRESENT-VALUE (0, 23, 12, 9) = IF4034.2 +003000 FUNCTION PRESENT-VALUE (0, 23, 12, 9) IF4034.2 +003100 CONTINUE. IF4034.2 +003200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +003300 IF4034.2 +003400 IF403M-RANDOM. IF4034.2 +003500 IF FUNCTION RANDOM (1) = FUNCTION RANDOM (1) IF4034.2 +003600 CONTINUE. IF4034.2 +003700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +003800 IF4034.2 +003900 IF403M-RANGE. IF4034.2 +004000 IF FUNCTION RANGE (5, -2, -14, 0) = IF4034.2 +004100 FUNCTION RANGE (5, -2, -14, 0) IF4034.2 +004200 CONTINUE. IF4034.2 +004300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +004400 IF4034.2 +004500 IF403M-REM. IF4034.2 +004600 IF FUNCTION REM (0, 20) = FUNCTION REM (0, 20) IF4034.2 +004700 CONTINUE. IF4034.2 +004800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +004900 IF4034.2 +005000 IF403M-REVERSE. IF4034.2 +005100 MOVE FUNCTION REVERSE ("ABC") TO WS-AN-TEMP. IF4034.2 +005200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +005300 IF4034.2 +005400 IF403M-SIN. IF4034.2 +005500 IF FUNCTION SIN (1.0) = FUNCTION SIN (1.0) IF4034.2 +005600 CONTINUE. IF4034.2 +005700*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +005800 IF4034.2 +005900 IF403M-SQRT. IF4034.2 +006000 IF FUNCTION SQRT (0) = FUNCTION SQRT (0) IF4034.2 +006100 CONTINUE. IF4034.2 +006200*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +006300 IF4034.2 +006400 IF403M-STANDARD-DEVIATION. IF4034.2 +006500 IF FUNCTION STANDARD-DEVIATION (5, -2, -14, 0) = IF4034.2 +006600 FUNCTION STANDARD-DEVIATION (5, -2, -14, 0) IF4034.2 +006700 CONTINUE. IF4034.2 +006800*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +006900 IF4034.2 +007000 IF403M-SUM. IF4034.2 +007100 IF FUNCTION SUM (5, -2, -14, 0) = IF4034.2 +007200 FUNCTION SUM (5, -2, -14, 0) IF4034.2 +007300 CONTINUE. IF4034.2 +007400*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +007500 IF4034.2 +007600 IF403M-TAN. IF4034.2 +007700 IF FUNCTION TAN (1.0) = FUNCTION TAN (1.0) IF4034.2 +007800 CONTINUE. IF4034.2 +007900*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +008000 IF4034.2 +008100 IF403M-UPPER-CASE. IF4034.2 +008200 MOVE FUNCTION UPPER-CASE ("abc") TO WS-AN-TEMP. IF4034.2 +008300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +008400 IF4034.2 +008500 IF403M-VARIANCE. IF4034.2 +008600 IF FUNCTION VARIANCE (5, -2, -14, 0) = IF4034.2 +008700 FUNCTION VARIANCE (5, -2, -14, 0) IF4034.2 +008800 CONTINUE. IF4034.2 +008900*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +009000 IF4034.2 +009100 IF403M-WHEN-COMPILED. IF4034.2 +009200 MOVE FUNCTION WHEN-COMPILED TO WS-AN-TEMP. IF4034.2 +009300*MESSAGE EXPECTED FOR ABOVE STATEMENT: NON-CONFORMING STANDARD IF4034.2 +009400 IF4034.2 +009500 IF403M-END. IF4034.2 +009600 IF4034.2 +009700*TOTAL NUMBER OF FLAGS EXPECTED = 13. IF4034.2 diff --git a/tests/cobol85/IX.txt b/tests/cobol85/IX.txt deleted file mode 100644 index aee01e4d..00000000 --- a/tests/cobol85/IX.txt +++ /dev/null @@ -1,52 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -IX101A.CBL 2 2 0 0 0 OK -IX102A.SUB 11 11 0 0 0 OK -IX103A.SUB 12 12 0 0 0 OK -IX104A.CBL 13 13 0 0 0 OK -IX105A.CBL 9 9 0 0 0 OK -IX106A.CBL 10 10 0 0 0 OK -IX107A.CBL 14 14 0 0 0 OK -IX108A.CBL 32 32 0 0 0 OK -IX109A.CBL 13 13 0 0 0 OK -IX110A.SUB 4 4 0 0 0 OK -IX111A.SUB 1 1 0 0 0 OK -IX112A.CBL 7 7 0 0 0 OK -IX113A.CBL 4 4 0 0 0 OK -IX114A.SUB 3 3 0 0 0 OK -IX115A.SUB 3 3 0 0 0 OK -IX116A.SUB 3 3 0 0 0 OK -IX117A.SUB 3 3 0 0 0 OK -IX118A.SUB 3 3 0 0 0 OK -IX119A.SUB 3 3 0 0 0 OK -IX120A.SUB 2 2 0 0 0 OK -IX121A.CBL 3 3 0 0 0 OK -IX201A.CBL 2 2 0 0 0 OK -IX202A.SUB 11 11 0 0 0 OK -IX203A.SUB 12 12 0 0 0 OK -IX204A.CBL 13 13 0 0 0 OK -IX205A.CBL 12 12 0 0 0 OK -IX206A.CBL 10 10 0 0 0 OK -IX207A.CBL 8 8 0 0 0 OK -IX208A.CBL 29 29 0 0 0 OK -IX209A.CBL 56 56 0 0 0 OK -IX210A.CBL 39 39 0 0 0 OK -IX211A.CBL 17 17 0 0 0 OK -IX212A.CBL 24 24 0 0 0 OK -IX213A.CBL 21 21 0 0 0 OK -IX214A.CBL 39 39 0 0 0 OK -IX215A.CBL 33 33 0 0 0 OK -IX216A.CBL 15 14 0 1 0 OK -IX217A.CBL 6 6 0 0 0 OK -IX218A.CBL 6 6 0 0 0 OK -IX301M.CBL ----- test skipped ----- -IX302M.CBL ----- test skipped ----- -IX401M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 508 507 0 1 0 -% 100.0 99.8 0.0 0.2 0.0 - -Number of programs: 39 -Successfully executed: 39 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/IX/IX101A.CBL b/tests/cobol85/IX/IX101A.CBL new file mode 100755 index 00000000..8b8d27a1 --- /dev/null +++ b/tests/cobol85/IX/IX101A.CBL @@ -0,0 +1,507 @@ +000100 IDENTIFICATION DIVISION. IX1014.2 +000200 PROGRAM-ID. IX1014.2 +000300 IX101A. IX1014.2 +000400**************************************************************** IX1014.2 +000500* * IX1014.2 +000600* VALIDATION FOR:- * IX1014.2 +000700* * IX1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1014.2 +000900* * IX1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1014.2 +001100* * IX1014.2 +001200**************************************************************** IX1014.2 +001300* THIS PROGRAM IS THE FIRST OF A SERIES WHICH PROCESSES AN IX1014.2 +001400* INDEXED FILE. THE FUNCTION OF THIS PROGRAM IS TO CREATE AN IX1014.2 +001500* INDEXED FILE SEQUENTIALLY (ACCESS MODE SEQUENTIAL) AND VERIFYIX1014.2 +001600* THAT IT WAS CREATED AS EXPECTED. THE FILE IS IDENTIFIED AS IX1014.2 +001700* "IX-FS1" AND IS PASSED TO PROGRAM IX102 FOR PROCESSING. IX1014.2 +001800* IX1014.2 +001900* IX1014.2 +002000* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1014.2 +002100* IX1014.2 +002200* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1014.2 +002300* CLAUSE FOR DATA FILE IX-FS1 IX1014.2 +002400* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1014.2 +002500* CLAUSE FOR INDEX FILE IX-FS1 IX1014.2 +002600* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1014.2 +002700* X-62 IMPLEMENTOR-NAME FOR RAW-DATA (OPTIONAL) IX1014.2 +002800* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1014.2 +002900* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1014.2 +003000* IX1014.2 +003100* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX1014.2 +003200* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1014.2 +003300* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1014.2 +003400* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1014.2 +003500* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1014.2 +003600* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1014.2 +003700* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1014.2 +003800* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1014.2 +003900* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1014.2 +004000* THEY ARE AS FOLLOWS IX1014.2 +004100* IX1014.2 +004200* J SELECTS X-CARD 44 IX1014.2 +004300* IX1014.2 +004400****************************************************** IX1014.2 +004500 ENVIRONMENT DIVISION. IX1014.2 +004600 CONFIGURATION SECTION. IX1014.2 +004700 SOURCE-COMPUTER. IX1014.2 +004800 Linux. IX1014.2 +004900 OBJECT-COMPUTER. IX1014.2 +005000 Linux. IX1014.2 +005100 INPUT-OUTPUT SECTION. IX1014.2 +005200 FILE-CONTROL. IX1014.2 +005300*P SELECT RAW-DATA ASSIGN TO IX1014.2 +005400*P "XXXXX062" IX1014.2 +005500*P ORGANIZATION IS INDEXED IX1014.2 +005600*P ACCESS MODE IS RANDOM IX1014.2 +005700*P RECORD KEY IS RAW-DATA-KEY. IX1014.2 +005800 SELECT PRINT-FILE ASSIGN TO IX1014.2 +005900 "report.log". IX1014.2 +006000 SELECT IX-FS1 ASSIGN TO IX1014.2 +006100 "XXXXX024" IX1014.2 +006200*J **** X-CARD UNDEFINED **** IX1014.2 +006300 ORGANIZATION IS INDEXED IX1014.2 +006400 RECORD KEY IS IX-FS1-KEY IX1014.2 +006500 ACCESS MODE IS SEQUENTIAL. IX1014.2 +006600 DATA DIVISION. IX1014.2 +006700 FILE SECTION. IX1014.2 +006800*P IX1014.2 +006900*PD RAW-DATA. IX1014.2 +007000*P IX1014.2 +007100*P1 RAW-DATA-SATZ. IX1014.2 +007200*P 05 RAW-DATA-KEY PIC X(6). IX1014.2 +007300*P 05 C-DATE PIC 9(6). IX1014.2 +007400*P 05 C-TIME PIC 9(8). IX1014.2 +007500*P 05 C-NO-OF-TESTS PIC 99. IX1014.2 +007600*P 05 C-OK PIC 999. IX1014.2 +007700*P 05 C-ALL PIC 999. IX1014.2 +007800*P 05 C-FAIL PIC 999. IX1014.2 +007900*P 05 C-DELETED PIC 999. IX1014.2 +008000*P 05 C-INSPECT PIC 999. IX1014.2 +008100*P 05 C-NOTE PIC X(13). IX1014.2 +008200*P 05 C-INDENT PIC X. IX1014.2 +008300*P 05 C-ABORT PIC X(8). IX1014.2 +008400 FD PRINT-FILE. IX1014.2 +008500 01 PRINT-REC PICTURE X(120). IX1014.2 +008600 01 DUMMY-RECORD PICTURE X(120). IX1014.2 +008700 FD IX-FS1 IX1014.2 +008800*C LABEL RECORD IS STANDARD IX1014.2 +008900*C DATA RECORD IS IX-FS1R1-F-G-240 IX1014.2 +009000 BLOCK CONTAINS 1 RECORDS IX1014.2 +009100 RECORD CONTAINS 240 CHARACTERS. IX1014.2 +009200 01 IX-FS1R1-F-G-240. IX1014.2 +009300 03 IX-FS1-WRK-120 PIC X(120). IX1014.2 +009400 03 IX-FS1-GRP-120. IX1014.2 +009500 05 FILLER PIC X(8). IX1014.2 +009600 05 IX-FS1-KEY PIC X(29). IX1014.2 +009700 05 FILLER PIC X(83). IX1014.2 +009800 WORKING-STORAGE SECTION. IX1014.2 +009900 01 GRP-0101. IX1014.2 +010000 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX1014.2 +010100 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX1014.2 +010200 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX1014.2 +010300 01 FILE-RECORD-INFORMATION-REC. IX1014.2 +010400 03 FILE-RECORD-INFO-SKELETON. IX1014.2 +010500 05 FILLER PICTURE X(48) VALUE IX1014.2 +010600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1014.2 +010700 05 FILLER PICTURE X(46) VALUE IX1014.2 +010800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1014.2 +010900 05 FILLER PICTURE X(26) VALUE IX1014.2 +011000 ",LFIL=000000,ORG= ,LBLR= ". IX1014.2 +011100 05 FILLER PICTURE X(37) VALUE IX1014.2 +011200 ",RECKEY= ". IX1014.2 +011300 05 FILLER PICTURE X(38) VALUE IX1014.2 +011400 ",ALTKEY1= ". IX1014.2 +011500 05 FILLER PICTURE X(38) VALUE IX1014.2 +011600 ",ALTKEY2= ". IX1014.2 +011700 05 FILLER PICTURE X(7) VALUE SPACE.IX1014.2 +011800 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1014.2 +011900 05 FILE-RECORD-INFO-P1-120. IX1014.2 +012000 07 FILLER PIC X(5). IX1014.2 +012100 07 XFILE-NAME PIC X(6). IX1014.2 +012200 07 FILLER PIC X(8). IX1014.2 +012300 07 XRECORD-NAME PIC X(6). IX1014.2 +012400 07 FILLER PIC X(1). IX1014.2 +012500 07 REELUNIT-NUMBER PIC 9(1). IX1014.2 +012600 07 FILLER PIC X(7). IX1014.2 +012700 07 XRECORD-NUMBER PIC 9(6). IX1014.2 +012800 07 FILLER PIC X(6). IX1014.2 +012900 07 UPDATE-NUMBER PIC 9(2). IX1014.2 +013000 07 FILLER PIC X(5). IX1014.2 +013100 07 ODO-NUMBER PIC 9(4). IX1014.2 +013200 07 FILLER PIC X(5). IX1014.2 +013300 07 XPROGRAM-NAME PIC X(5). IX1014.2 +013400 07 FILLER PIC X(7). IX1014.2 +013500 07 XRECORD-LENGTH PIC 9(6). IX1014.2 +013600 07 FILLER PIC X(7). IX1014.2 +013700 07 CHARS-OR-RECORDS PIC X(2). IX1014.2 +013800 07 FILLER PIC X(1). IX1014.2 +013900 07 XBLOCK-SIZE PIC 9(4). IX1014.2 +014000 07 FILLER PIC X(6). IX1014.2 +014100 07 RECORDS-IN-FILE PIC 9(6). IX1014.2 +014200 07 FILLER PIC X(5). IX1014.2 +014300 07 XFILE-ORGANIZATION PIC X(2). IX1014.2 +014400 07 FILLER PIC X(6). IX1014.2 +014500 07 XLABEL-TYPE PIC X(1). IX1014.2 +014600 05 FILE-RECORD-INFO-P121-240. IX1014.2 +014700 07 FILLER PIC X(8). IX1014.2 +014800 07 XRECORD-KEY PIC X(29). IX1014.2 +014900 07 FILLER PIC X(9). IX1014.2 +015000 07 ALTERNATE-KEY1 PIC X(29). IX1014.2 +015100 07 FILLER PIC X(9). IX1014.2 +015200 07 ALTERNATE-KEY2 PIC X(29). IX1014.2 +015300 07 FILLER PIC X(7). IX1014.2 +015400 01 TEST-RESULTS. IX1014.2 +015500 02 FILLER PIC X VALUE SPACE. IX1014.2 +015600 02 FEATURE PIC X(20) VALUE SPACE. IX1014.2 +015700 02 FILLER PIC X VALUE SPACE. IX1014.2 +015800 02 P-OR-F PIC X(5) VALUE SPACE. IX1014.2 +015900 02 FILLER PIC X VALUE SPACE. IX1014.2 +016000 02 PAR-NAME. IX1014.2 +016100 03 FILLER PIC X(19) VALUE SPACE. IX1014.2 +016200 03 PARDOT-X PIC X VALUE SPACE. IX1014.2 +016300 03 DOTVALUE PIC 99 VALUE ZERO. IX1014.2 +016400 02 FILLER PIC X(8) VALUE SPACE. IX1014.2 +016500 02 RE-MARK PIC X(61). IX1014.2 +016600 01 TEST-COMPUTED. IX1014.2 +016700 02 FILLER PIC X(30) VALUE SPACE. IX1014.2 +016800 02 FILLER PIC X(17) VALUE IX1014.2 +016900 " COMPUTED=". IX1014.2 +017000 02 COMPUTED-X. IX1014.2 +017100 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1014.2 +017200 03 COMPUTED-N REDEFINES COMPUTED-A IX1014.2 +017300 PIC -9(9).9(9). IX1014.2 +017400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1014.2 +017500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1014.2 +017600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1014.2 +017700 03 CM-18V0 REDEFINES COMPUTED-A. IX1014.2 +017800 04 COMPUTED-18V0 PIC -9(18). IX1014.2 +017900 04 FILLER PIC X. IX1014.2 +018000 03 FILLER PIC X(50) VALUE SPACE. IX1014.2 +018100 01 TEST-CORRECT. IX1014.2 +018200 02 FILLER PIC X(30) VALUE SPACE. IX1014.2 +018300 02 FILLER PIC X(17) VALUE " CORRECT =". IX1014.2 +018400 02 CORRECT-X. IX1014.2 +018500 03 CORRECT-A PIC X(20) VALUE SPACE. IX1014.2 +018600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1014.2 +018700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1014.2 +018800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1014.2 +018900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1014.2 +019000 03 CR-18V0 REDEFINES CORRECT-A. IX1014.2 +019100 04 CORRECT-18V0 PIC -9(18). IX1014.2 +019200 04 FILLER PIC X. IX1014.2 +019300 03 FILLER PIC X(2) VALUE SPACE. IX1014.2 +019400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1014.2 +019500 01 CCVS-C-1. IX1014.2 +019600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1014.2 +019700- "SS PARAGRAPH-NAME IX1014.2 +019800- " REMARKS". IX1014.2 +019900 02 FILLER PIC X(20) VALUE SPACE. IX1014.2 +020000 01 CCVS-C-2. IX1014.2 +020100 02 FILLER PIC X VALUE SPACE. IX1014.2 +020200 02 FILLER PIC X(6) VALUE "TESTED". IX1014.2 +020300 02 FILLER PIC X(15) VALUE SPACE. IX1014.2 +020400 02 FILLER PIC X(4) VALUE "FAIL". IX1014.2 +020500 02 FILLER PIC X(94) VALUE SPACE. IX1014.2 +020600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1014.2 +020700 01 REC-CT PIC 99 VALUE ZERO. IX1014.2 +020800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1014.2 +020900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1014.2 +021000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1014.2 +021100 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1014.2 +021200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1014.2 +021300 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1014.2 +021400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1014.2 +021500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1014.2 +021600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1014.2 +021700 01 CCVS-H-1. IX1014.2 +021800 02 FILLER PIC X(39) VALUE SPACES. IX1014.2 +021900 02 FILLER PIC X(42) VALUE IX1014.2 +022000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1014.2 +022100 02 FILLER PIC X(39) VALUE SPACES. IX1014.2 +022200 01 CCVS-H-2A. IX1014.2 +022300 02 FILLER PIC X(40) VALUE SPACE. IX1014.2 +022400 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1014.2 +022500 02 FILLER PIC XXXX VALUE IX1014.2 +022600 "4.2 ". IX1014.2 +022700 02 FILLER PIC X(28) VALUE IX1014.2 +022800 " COPY - NOT FOR DISTRIBUTION". IX1014.2 +022900 02 FILLER PIC X(41) VALUE SPACE. IX1014.2 +023000 IX1014.2 +023100 01 CCVS-H-2B. IX1014.2 +023200 02 FILLER PIC X(15) VALUE IX1014.2 +023300 "TEST RESULT OF ". IX1014.2 +023400 02 TEST-ID PIC X(9). IX1014.2 +023500 02 FILLER PIC X(4) VALUE IX1014.2 +023600 " IN ". IX1014.2 +023700 02 FILLER PIC X(12) VALUE IX1014.2 +023800 " HIGH ". IX1014.2 +023900 02 FILLER PIC X(22) VALUE IX1014.2 +024000 " LEVEL VALIDATION FOR ". IX1014.2 +024100 02 FILLER PIC X(58) VALUE IX1014.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1014.2 +024300 01 CCVS-H-3. IX1014.2 +024400 02 FILLER PIC X(34) VALUE IX1014.2 +024500 " FOR OFFICIAL USE ONLY ". IX1014.2 +024600 02 FILLER PIC X(58) VALUE IX1014.2 +024700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1014.2 +024800 02 FILLER PIC X(28) VALUE IX1014.2 +024900 " COPYRIGHT 1985 ". IX1014.2 +025000 01 CCVS-E-1. IX1014.2 +025100 02 FILLER PIC X(52) VALUE SPACE. IX1014.2 +025200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1014.2 +025300 02 ID-AGAIN PIC X(9). IX1014.2 +025400 02 FILLER PIC X(45) VALUE SPACES. IX1014.2 +025500 01 CCVS-E-2. IX1014.2 +025600 02 FILLER PIC X(31) VALUE SPACE. IX1014.2 +025700 02 FILLER PIC X(21) VALUE SPACE. IX1014.2 +025800 02 CCVS-E-2-2. IX1014.2 +025900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1014.2 +026000 03 FILLER PIC X VALUE SPACE. IX1014.2 +026100 03 ENDER-DESC PIC X(44) VALUE IX1014.2 +026200 "ERRORS ENCOUNTERED". IX1014.2 +026300 01 CCVS-E-3. IX1014.2 +026400 02 FILLER PIC X(22) VALUE IX1014.2 +026500 " FOR OFFICIAL USE ONLY". IX1014.2 +026600 02 FILLER PIC X(12) VALUE SPACE. IX1014.2 +026700 02 FILLER PIC X(58) VALUE IX1014.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1014.2 +026900 02 FILLER PIC X(13) VALUE SPACE. IX1014.2 +027000 02 FILLER PIC X(15) VALUE IX1014.2 +027100 " COPYRIGHT 1985". IX1014.2 +027200 01 CCVS-E-4. IX1014.2 +027300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1014.2 +027400 02 FILLER PIC X(4) VALUE " OF ". IX1014.2 +027500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1014.2 +027600 02 FILLER PIC X(40) VALUE IX1014.2 +027700 " TESTS WERE EXECUTED SUCCESSFULLY". IX1014.2 +027800 01 XXINFO. IX1014.2 +027900 02 FILLER PIC X(19) VALUE IX1014.2 +028000 "*** INFORMATION ***". IX1014.2 +028100 02 INFO-TEXT. IX1014.2 +028200 04 FILLER PIC X(8) VALUE SPACE. IX1014.2 +028300 04 XXCOMPUTED PIC X(20). IX1014.2 +028400 04 FILLER PIC X(5) VALUE SPACE. IX1014.2 +028500 04 XXCORRECT PIC X(20). IX1014.2 +028600 02 INF-ANSI-REFERENCE PIC X(48). IX1014.2 +028700 01 HYPHEN-LINE. IX1014.2 +028800 02 FILLER PIC IS X VALUE IS SPACE. IX1014.2 +028900 02 FILLER PIC IS X(65) VALUE IS "************************IX1014.2 +029000- "*****************************************". IX1014.2 +029100 02 FILLER PIC IS X(54) VALUE IS "************************IX1014.2 +029200- "******************************". IX1014.2 +029300 01 CCVS-PGM-ID PIC X(9) VALUE IX1014.2 +029400 "IX101A". IX1014.2 +029500 PROCEDURE DIVISION. IX1014.2 +029600 CCVS1 SECTION. IX1014.2 +029700 OPEN-FILES. IX1014.2 +029800*P OPEN I-O RAW-DATA. IX1014.2 +029900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1014.2 +030000*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1014.2 +030100*P MOVE "ABORTED " TO C-ABORT. IX1014.2 +030200*P ADD 1 TO C-NO-OF-TESTS. IX1014.2 +030300*P ACCEPT C-DATE FROM DATE. IX1014.2 +030400*P ACCEPT C-TIME FROM TIME. IX1014.2 +030500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1014.2 +030600*PND-E-1. IX1014.2 +030700*P CLOSE RAW-DATA. IX1014.2 +030800 OPEN OUTPUT PRINT-FILE. IX1014.2 +030900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1014.2 +031000 MOVE SPACE TO TEST-RESULTS. IX1014.2 +031100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1014.2 +031200 MOVE ZERO TO REC-SKL-SUB. IX1014.2 +031300 PERFORM CCVS-INIT-FILE 9 TIMES. IX1014.2 +031400 CCVS-INIT-FILE. IX1014.2 +031500 ADD 1 TO REC-SKL-SUB. IX1014.2 +031600 MOVE FILE-RECORD-INFO-SKELETON IX1014.2 +031700 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1014.2 +031800 CCVS-INIT-EXIT. IX1014.2 +031900 GO TO CCVS1-EXIT. IX1014.2 +032000 CLOSE-FILES. IX1014.2 +032100*P OPEN I-O RAW-DATA. IX1014.2 +032200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1014.2 +032300*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1014.2 +032400*P MOVE "OK. " TO C-ABORT. IX1014.2 +032500*P MOVE PASS-COUNTER TO C-OK. IX1014.2 +032600*P MOVE ERROR-HOLD TO C-ALL. IX1014.2 +032700*P MOVE ERROR-COUNTER TO C-FAIL. IX1014.2 +032800*P MOVE DELETE-COUNTER TO C-DELETED. IX1014.2 +032900*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1014.2 +033000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1014.2 +033100*PND-E-2. IX1014.2 +033200*P CLOSE RAW-DATA. IX1014.2 +033300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1014.2 +033400 TERMINATE-CCVS. IX1014.2 +033500*S EXIT PROGRAM. IX1014.2 +033600*SERMINATE-CALL. IX1014.2 +033700 STOP RUN. IX1014.2 +033800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1014.2 +033900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1014.2 +034000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1014.2 +034100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1014.2 +034200 MOVE "****TEST DELETED****" TO RE-MARK. IX1014.2 +034300 PRINT-DETAIL. IX1014.2 +034400 IF REC-CT NOT EQUAL TO ZERO IX1014.2 +034500 MOVE "." TO PARDOT-X IX1014.2 +034600 MOVE REC-CT TO DOTVALUE. IX1014.2 +034700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1014.2 +034800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1014.2 +034900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1014.2 +035000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1014.2 +035100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1014.2 +035200 MOVE SPACE TO CORRECT-X. IX1014.2 +035300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1014.2 +035400 MOVE SPACE TO RE-MARK. IX1014.2 +035500 HEAD-ROUTINE. IX1014.2 +035600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +035700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +035800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1014.2 +035900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1014.2 +036000 COLUMN-NAMES-ROUTINE. IX1014.2 +036100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +036200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +036300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +036400 END-ROUTINE. IX1014.2 +036500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1014.2 +036600 END-RTN-EXIT. IX1014.2 +036700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +036800 END-ROUTINE-1. IX1014.2 +036900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1014.2 +037000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1014.2 +037100 ADD PASS-COUNTER TO ERROR-HOLD. IX1014.2 +037200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1014.2 +037300 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1014.2 +037400 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1014.2 +037500 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1014.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1014.2 +037700 END-ROUTINE-12. IX1014.2 +037800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1014.2 +037900 IF ERROR-COUNTER IS EQUAL TO ZERO IX1014.2 +038000 MOVE "NO " TO ERROR-TOTAL IX1014.2 +038100 ELSE IX1014.2 +038200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1014.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1014.2 +038400 PERFORM WRITE-LINE. IX1014.2 +038500 END-ROUTINE-13. IX1014.2 +038600 IF DELETE-COUNTER IS EQUAL TO ZERO IX1014.2 +038700 MOVE "NO " TO ERROR-TOTAL ELSE IX1014.2 +038800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1014.2 +038900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1014.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +039100 IF INSPECT-COUNTER EQUAL TO ZERO IX1014.2 +039200 MOVE "NO " TO ERROR-TOTAL IX1014.2 +039300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1014.2 +039400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1014.2 +039500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +039600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1014.2 +039700 WRITE-LINE. IX1014.2 +039800 ADD 1 TO RECORD-COUNT. IX1014.2 +039900 IF RECORD-COUNT GREATER 42 IX1014.2 +040000 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1014.2 +040100 MOVE SPACE TO DUMMY-RECORD IX1014.2 +040200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1014.2 +040300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1014.2 +040400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1014.2 +040500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1014.2 +040600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1014.2 +040700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1014.2 +040800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1014.2 +040900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1014.2 +041000 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1014.2 +041100 MOVE ZERO TO RECORD-COUNT. IX1014.2 +041200 PERFORM WRT-LN. IX1014.2 +041300 WRT-LN. IX1014.2 +041400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1014.2 +041500 MOVE SPACE TO DUMMY-RECORD. IX1014.2 +041600 BLANK-LINE-PRINT. IX1014.2 +041700 PERFORM WRT-LN. IX1014.2 +041800 FAIL-ROUTINE. IX1014.2 +041900 IF COMPUTED-X NOT EQUAL TO SPACE IX1014.2 +042000 GO TO FAIL-ROUTINE-WRITE. IX1014.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1014.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1014.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1014.2 +042400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +042500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1014.2 +042600 GO TO FAIL-ROUTINE-EX. IX1014.2 +042700 FAIL-ROUTINE-WRITE. IX1014.2 +042800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1014.2 +042900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1014.2 +043000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1014.2 +043100 MOVE SPACES TO COR-ANSI-REFERENCE. IX1014.2 +043200 FAIL-ROUTINE-EX. EXIT. IX1014.2 +043300 BAIL-OUT. IX1014.2 +043400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1014.2 +043500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1014.2 +043600 BAIL-OUT-WRITE. IX1014.2 +043700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1014.2 +043800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1014.2 +043900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1014.2 +044000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1014.2 +044100 BAIL-OUT-EX. EXIT. IX1014.2 +044200 CCVS1-EXIT. IX1014.2 +044300 EXIT. IX1014.2 +044400 SECT-IX-01-001 SECTION. IX1014.2 +044500 WRITE-INIT-GF-01. IX1014.2 +044600 MOVE "FILE CREATE IX-FS1" TO FEATURE. IX1014.2 +044700 OPEN OUTPUT IX-FS1. IX1014.2 +044800 MOVE "IX-FS1" TO XFILE-NAME (1). IX1014.2 +044900 MOVE "IX-F-G" TO XRECORD-NAME (1). IX1014.2 +045000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1014.2 +045100 MOVE 000240 TO XRECORD-LENGTH (1). IX1014.2 +045200 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1014.2 +045300 MOVE 0001 TO XBLOCK-SIZE (1). IX1014.2 +045400 MOVE 000500 TO RECORDS-IN-FILE (1). IX1014.2 +045500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1014.2 +045600 MOVE "S" TO XLABEL-TYPE (1). IX1014.2 +045700 MOVE 000001 TO XRECORD-NUMBER (1). IX1014.2 +045800 WRITE-TEST-GF-01. IX1014.2 +045900 MOVE XRECORD-NUMBER (1) TO WRK-DU-09V00-001. IX1014.2 +046000 MOVE GRP-0101 TO XRECORD-KEY (1). IX1014.2 +046100 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX1014.2 +046200 WRITE IX-FS1R1-F-G-240 IX1014.2 +046300 INVALID KEY GO TO WRITE-FAIL-GF-01. IX1014.2 +046400 IF XRECORD-NUMBER (1) EQUAL TO 500 IX1014.2 +046500 GO TO WRITE-PASS-GF-01. IX1014.2 +046600 ADD 000001 TO XRECORD-NUMBER (1). IX1014.2 +046700 GO TO WRITE-TEST-GF-01. IX1014.2 +046800 WRITE-FAIL-GF-01. IX1014.2 +046900 MOVE "IX-41 4.9.2 " TO RE-MARK. IX1014.2 +047000 PERFORM FAIL. IX1014.2 +047100 GO TO WRITE-WRITE-GF-01. IX1014.2 +047200 WRITE-PASS-GF-01. IX1014.2 +047300 PERFORM PASS. IX1014.2 +047400 WRITE-WRITE-GF-01. IX1014.2 +047500 MOVE "WRITE-TEST-GF-01" TO PAR-NAME IX1014.2 +047600 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. IX1014.2 +047700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX1014.2 +047800 PERFORM PRINT-DETAIL. IX1014.2 +047900 CLOSE IX-FS1. IX1014.2 +048000 READ-INIT-GF-01. IX1014.2 +048100 OPEN INPUT IX-FS1. IX1014.2 +048200 MOVE ZERO TO WRK-DU-09V00-001. IX1014.2 +048300 READ-TEST-GF-01. IX1014.2 +048400 READ IX-FS1 IX1014.2 +048500 AT END GO TO READ-TEST-GF-01-1. IX1014.2 +048600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1014.2 +048700 ADD 1 TO WRK-DU-09V00-001. IX1014.2 +048800 IF WRK-DU-09V00-001 GREATER 500 IX1014.2 +048900 MOVE "MORE THAN 500 RECORDS" TO RE-MARK IX1014.2 +049000 GO TO READ-TEST-GF-01-1. IX1014.2 +049100 GO TO READ-TEST-GF-01. IX1014.2 +049200 READ-TEST-GF-01-1. IX1014.2 +049300 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 IX1014.2 +049400 MOVE "IX-28 4.5.2 " TO RE-MARK IX1014.2 +049500 PERFORM FAIL IX1014.2 +049600 ELSE IX1014.2 +049700 PERFORM PASS. IX1014.2 +049800 GO TO READ-WRITE-GF-01. IX1014.2 +049900 READ-WRITE-GF-01. IX1014.2 +050000 MOVE "READ-TEST-GF-01" TO PAR-NAME. IX1014.2 +050100 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. IX1014.2 +050200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX1014.2 +050300 PERFORM PRINT-DETAIL. IX1014.2 +050400 CLOSE IX-FS1. IX1014.2 +050500 CCVS-EXIT SECTION. IX1014.2 +050600 CCVS-999999. IX1014.2 +050700 GO TO CLOSE-FILES. IX1014.2 diff --git a/tests/cobol85/IX/IX102A.SUB b/tests/cobol85/IX/IX102A.SUB new file mode 100755 index 00000000..bc2f4ded --- /dev/null +++ b/tests/cobol85/IX/IX102A.SUB @@ -0,0 +1,701 @@ +000100 IDENTIFICATION DIVISION. IX1024.2 +000200 PROGRAM-ID. IX1024.2 +000300 IX102A. IX1024.2 +000400**************************************************************** IX1024.2 +000500* * IX1024.2 +000600* VALIDATION FOR:- * IX1024.2 +000700* * IX1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1024.2 +000900* * IX1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1024.2 +001100* * IX1024.2 +001200**************************************************************** IX1024.2 +001300* IX1024.2 +001400* NEW TEST: IX1024.2 +001500* SELECT ... ASSIGN TO ... IX1024.2 +001600* IX1024.2 +001700* NOTE: WILL BE ASSIGNED BY THE X-CARD X-24. IX1024.2 +001800* X-24 SHOULD ASSIGN A } IX1024.2 +001900* IX1024.2 +002000* IX1024.2 +002100* THE FUNCTION OF THIS PROGRAM IS TO PROCESS AN INDEXED FILE IX1024.2 +002200* RANDOMLY (ACCESS MODE IS RANDOM). THE FILE USED AS INPUT IS IX1024.2 +002300* THAT CREATED BY IX101. IX1024.2 +002400* IX1024.2 +002500* FIRST THE FILE IS VERIFIED AS TO THE EXISTANCE AND ACCURACY IX1024.2 +002600* OF THE 500 RECORDS CREATED IN IX101. SECONDLY, RECORDS IX1024.2 +002700* OF THE FILE ARE SELECTIVELY UPDATED; AND THIRDLY, THE IX1024.2 +002800* ACCURACY OF EACH RECORD IN THE FILE IS AGAIN VERIFIED. IX1024.2 +002900* IX1024.2 +003000* IX1024.2 +003100* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1024.2 +003200* IX1024.2 +003300* X-24 INDEXED FILE IN ASSGN TO IX1024.2 +003400* CLAUSE FOR DATA FILE IX-FS1 IX1024.2 +003500* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1024.2 +003600* CLAUSE FOR INDEX FILE IX-FS1 IX1024.2 +003700* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1024.2 +003800* X-62 IMPLEMENTOR-NAME FOR RAW-DATA IX1024.2 +003900* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1024.2 +004000* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1024.2 +004100* IX1024.2 +004200* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX1024.2 +004300* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1024.2 +004400* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1024.2 +004500* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1024.2 +004600* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1024.2 +004700* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1024.2 +004800* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1024.2 +004900* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1024.2 +005000* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1024.2 +005100* THEY ARE AS FOLLOWS IX1024.2 +005200* IX1024.2 +005300* J SELECTS X-CARD 44 IX1024.2 +005400* P SELECTS X-CARD 62 IX1024.2 +005500* IX1024.2 +005600****************************************************** IX1024.2 +005700 ENVIRONMENT DIVISION. IX1024.2 +005800 CONFIGURATION SECTION. IX1024.2 +005900 SOURCE-COMPUTER. IX1024.2 +006000 Linux. IX1024.2 +006100 OBJECT-COMPUTER. IX1024.2 +006200 Linux. IX1024.2 +006300 INPUT-OUTPUT SECTION. IX1024.2 +006400 FILE-CONTROL. IX1024.2 +006500*P SELECT RAW-DATA ASSIGN TO IX1024.2 +006600*P "XXXXX062" IX1024.2 +006700*P ORGANIZATION IS INDEXED IX1024.2 +006800*P ACCESS MODE IS RANDOM IX1024.2 +006900*P RECORD KEY IS RAW-DATA-KEY. IX1024.2 +007000 SELECT PRINT-FILE ASSIGN TO IX1024.2 +007100 "report.log". IX1024.2 +007200 SELECT IX-FS1 ASSIGN IX1024.2 +007300 "XXXXX024" IX1024.2 +007400*J **** X-CARD UNDEFINED **** IX1024.2 +007500 ACCESS MODE IS RANDOM IX1024.2 +007600 ORGANIZATION INDEXED IX1024.2 +007700 RECORD KEY IX-FS1-KEY. IX1024.2 +007800 DATA DIVISION. IX1024.2 +007900 FILE SECTION. IX1024.2 +008000*P IX1024.2 +008100*PD RAW-DATA. IX1024.2 +008200*P IX1024.2 +008300*P1 RAW-DATA-SATZ. IX1024.2 +008400*P 05 RAW-DATA-KEY PIC X(6). IX1024.2 +008500*P 05 C-DATE PIC 9(6). IX1024.2 +008600*P 05 C-TIME PIC 9(8). IX1024.2 +008700*P 05 C-NO-OF-TESTS PIC 99. IX1024.2 +008800*P 05 C-OK PIC 999. IX1024.2 +008900*P 05 C-ALL PIC 999. IX1024.2 +009000*P 05 C-FAIL PIC 999. IX1024.2 +009100*P 05 C-DELETED PIC 999. IX1024.2 +009200*P 05 C-INSPECT PIC 999. IX1024.2 +009300*P 05 C-NOTE PIC X(13). IX1024.2 +009400*P 05 C-INDENT PIC X. IX1024.2 +009500*P 05 C-ABORT PIC X(8). IX1024.2 +009600 FD PRINT-FILE. IX1024.2 +009700 01 PRINT-REC PICTURE X(120). IX1024.2 +009800 01 DUMMY-RECORD PICTURE X(120). IX1024.2 +009900 FD IX-FS1 IX1024.2 +010000*C LABEL RECORDS STANDARD IX1024.2 +010100*C ; DATA RECORD IX-FS1R1-F-G-240 IX1024.2 +010200 BLOCK 1 RECORDS IX1024.2 +010300 RECORD 240 CHARACTERS. IX1024.2 +010400 01 IX-FS1R1-F-G-240. IX1024.2 +010500 05 IX-FS1-REC-120 PIC X(120). IX1024.2 +010600 05 IX-FS1-REC-120-240. IX1024.2 +010700 10 FILLER PIC X(8). IX1024.2 +010800 10 IX-FS1-KEY PIC X(29). IX1024.2 +010900 10 FILLER PIC X(83). IX1024.2 +011000 WORKING-STORAGE SECTION. IX1024.2 +011100 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011200 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. IX1024.2 +011300 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011400 01 I-O-ERROR-IX-FS1 PIC X(3) VALUE "NO ". IX1024.2 +011500 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011600 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011700 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. IX1024.2 +011800 01 IX-WRK-KEY. IX1024.2 +011900 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX1024.2 +012000 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX1024.2 +012100 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX1024.2 +012200 01 DUMMY-WRK-REC. IX1024.2 +012300 02 DUMMY-WRK1 PIC X(120). IX1024.2 +012400 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX1024.2 +012500 03 FILLER PIC X(5). IX1024.2 +012600 03 DUMMY-WRK-INDENT-5 PIC X(115). IX1024.2 +012700 01 FILE-RECORD-INFORMATION-REC. IX1024.2 +012800 03 FILE-RECORD-INFO-SKELETON. IX1024.2 +012900 05 FILLER PICTURE X(48) VALUE IX1024.2 +013000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1024.2 +013100 05 FILLER PICTURE X(46) VALUE IX1024.2 +013200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1024.2 +013300 05 FILLER PICTURE X(26) VALUE IX1024.2 +013400 ",LFIL=000000,ORG= ,LBLR= ". IX1024.2 +013500 05 FILLER PICTURE X(37) VALUE IX1024.2 +013600 ",RECKEY= ". IX1024.2 +013700 05 FILLER PICTURE X(38) VALUE IX1024.2 +013800 ",ALTKEY1= ". IX1024.2 +013900 05 FILLER PICTURE X(38) VALUE IX1024.2 +014000 ",ALTKEY2= ". IX1024.2 +014100 05 FILLER PICTURE X(7) VALUE SPACE.IX1024.2 +014200 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1024.2 +014300 05 FILE-RECORD-INFO-P1-120. IX1024.2 +014400 07 FILLER PIC X(5). IX1024.2 +014500 07 XFILE-NAME PIC X(6). IX1024.2 +014600 07 FILLER PIC X(8). IX1024.2 +014700 07 XRECORD-NAME PIC X(6). IX1024.2 +014800 07 FILLER PIC X(1). IX1024.2 +014900 07 REELUNIT-NUMBER PIC 9(1). IX1024.2 +015000 07 FILLER PIC X(7). IX1024.2 +015100 07 XRECORD-NUMBER PIC 9(6). IX1024.2 +015200 07 FILLER PIC X(6). IX1024.2 +015300 07 UPDATE-NUMBER PIC 9(2). IX1024.2 +015400 07 FILLER PIC X(5). IX1024.2 +015500 07 ODO-NUMBER PIC 9(4). IX1024.2 +015600 07 FILLER PIC X(5). IX1024.2 +015700 07 XPROGRAM-NAME PIC X(5). IX1024.2 +015800 07 FILLER PIC X(7). IX1024.2 +015900 07 XRECORD-LENGTH PIC 9(6). IX1024.2 +016000 07 FILLER PIC X(7). IX1024.2 +016100 07 CHARS-OR-RECORDS PIC X(2). IX1024.2 +016200 07 FILLER PIC X(1). IX1024.2 +016300 07 XBLOCK-SIZE PIC 9(4). IX1024.2 +016400 07 FILLER PIC X(6). IX1024.2 +016500 07 RECORDS-IN-FILE PIC 9(6). IX1024.2 +016600 07 FILLER PIC X(5). IX1024.2 +016700 07 XFILE-ORGANIZATION PIC X(2). IX1024.2 +016800 07 FILLER PIC X(6). IX1024.2 +016900 07 XLABEL-TYPE PIC X(1). IX1024.2 +017000 05 FILE-RECORD-INFO-P121-240. IX1024.2 +017100 07 FILLER PIC X(8). IX1024.2 +017200 07 XRECORD-KEY PIC X(29). IX1024.2 +017300 07 FILLER PIC X(9). IX1024.2 +017400 07 ALTERNATE-KEY1 PIC X(29). IX1024.2 +017500 07 FILLER PIC X(9). IX1024.2 +017600 07 ALTERNATE-KEY2 PIC X(29). IX1024.2 +017700 07 FILLER PIC X(7). IX1024.2 +017800 01 TEST-RESULTS. IX1024.2 +017900 02 FILLER PIC X VALUE SPACE. IX1024.2 +018000 02 FEATURE PIC X(20) VALUE SPACE. IX1024.2 +018100 02 FILLER PIC X VALUE SPACE. IX1024.2 +018200 02 P-OR-F PIC X(5) VALUE SPACE. IX1024.2 +018300 02 FILLER PIC X VALUE SPACE. IX1024.2 +018400 02 PAR-NAME. IX1024.2 +018500 03 FILLER PIC X(19) VALUE SPACE. IX1024.2 +018600 03 PARDOT-X PIC X VALUE SPACE. IX1024.2 +018700 03 DOTVALUE PIC 99 VALUE ZERO. IX1024.2 +018800 02 FILLER PIC X(8) VALUE SPACE. IX1024.2 +018900 02 RE-MARK PIC X(61). IX1024.2 +019000 01 TEST-COMPUTED. IX1024.2 +019100 02 FILLER PIC X(30) VALUE SPACE. IX1024.2 +019200 02 FILLER PIC X(17) VALUE IX1024.2 +019300 " COMPUTED=". IX1024.2 +019400 02 COMPUTED-X. IX1024.2 +019500 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1024.2 +019600 03 COMPUTED-N REDEFINES COMPUTED-A IX1024.2 +019700 PIC -9(9).9(9). IX1024.2 +019800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1024.2 +019900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1024.2 +020000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1024.2 +020100 03 CM-18V0 REDEFINES COMPUTED-A. IX1024.2 +020200 04 COMPUTED-18V0 PIC -9(18). IX1024.2 +020300 04 FILLER PIC X. IX1024.2 +020400 03 FILLER PIC X(50) VALUE SPACE. IX1024.2 +020500 01 TEST-CORRECT. IX1024.2 +020600 02 FILLER PIC X(30) VALUE SPACE. IX1024.2 +020700 02 FILLER PIC X(17) VALUE " CORRECT =". IX1024.2 +020800 02 CORRECT-X. IX1024.2 +020900 03 CORRECT-A PIC X(20) VALUE SPACE. IX1024.2 +021000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1024.2 +021100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1024.2 +021200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1024.2 +021300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1024.2 +021400 03 CR-18V0 REDEFINES CORRECT-A. IX1024.2 +021500 04 CORRECT-18V0 PIC -9(18). IX1024.2 +021600 04 FILLER PIC X. IX1024.2 +021700 03 FILLER PIC X(2) VALUE SPACE. IX1024.2 +021800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1024.2 +021900 01 CCVS-C-1. IX1024.2 +022000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1024.2 +022100- "SS PARAGRAPH-NAME IX1024.2 +022200- " REMARKS". IX1024.2 +022300 02 FILLER PIC X(20) VALUE SPACE. IX1024.2 +022400 01 CCVS-C-2. IX1024.2 +022500 02 FILLER PIC X VALUE SPACE. IX1024.2 +022600 02 FILLER PIC X(6) VALUE "TESTED". IX1024.2 +022700 02 FILLER PIC X(15) VALUE SPACE. IX1024.2 +022800 02 FILLER PIC X(4) VALUE "FAIL". IX1024.2 +022900 02 FILLER PIC X(94) VALUE SPACE. IX1024.2 +023000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1024.2 +023100 01 REC-CT PIC 99 VALUE ZERO. IX1024.2 +023200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1024.2 +023300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1024.2 +023400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1024.2 +023500 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1024.2 +023600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1024.2 +023700 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1024.2 +023800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1024.2 +023900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1024.2 +024000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1024.2 +024100 01 CCVS-H-1. IX1024.2 +024200 02 FILLER PIC X(39) VALUE SPACES. IX1024.2 +024300 02 FILLER PIC X(42) VALUE IX1024.2 +024400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1024.2 +024500 02 FILLER PIC X(39) VALUE SPACES. IX1024.2 +024600 01 CCVS-H-2A. IX1024.2 +024700 02 FILLER PIC X(40) VALUE SPACE. IX1024.2 +024800 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1024.2 +024900 02 FILLER PIC XXXX VALUE IX1024.2 +025000 "4.2 ". IX1024.2 +025100 02 FILLER PIC X(28) VALUE IX1024.2 +025200 " COPY - NOT FOR DISTRIBUTION". IX1024.2 +025300 02 FILLER PIC X(41) VALUE SPACE. IX1024.2 +025400 IX1024.2 +025500 01 CCVS-H-2B. IX1024.2 +025600 02 FILLER PIC X(15) VALUE IX1024.2 +025700 "TEST RESULT OF ". IX1024.2 +025800 02 TEST-ID PIC X(9). IX1024.2 +025900 02 FILLER PIC X(4) VALUE IX1024.2 +026000 " IN ". IX1024.2 +026100 02 FILLER PIC X(12) VALUE IX1024.2 +026200 " HIGH ". IX1024.2 +026300 02 FILLER PIC X(22) VALUE IX1024.2 +026400 " LEVEL VALIDATION FOR ". IX1024.2 +026500 02 FILLER PIC X(58) VALUE IX1024.2 +026600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1024.2 +026700 01 CCVS-H-3. IX1024.2 +026800 02 FILLER PIC X(34) VALUE IX1024.2 +026900 " FOR OFFICIAL USE ONLY ". IX1024.2 +027000 02 FILLER PIC X(58) VALUE IX1024.2 +027100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1024.2 +027200 02 FILLER PIC X(28) VALUE IX1024.2 +027300 " COPYRIGHT 1985 ". IX1024.2 +027400 01 CCVS-E-1. IX1024.2 +027500 02 FILLER PIC X(52) VALUE SPACE. IX1024.2 +027600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1024.2 +027700 02 ID-AGAIN PIC X(9). IX1024.2 +027800 02 FILLER PIC X(45) VALUE SPACES. IX1024.2 +027900 01 CCVS-E-2. IX1024.2 +028000 02 FILLER PIC X(31) VALUE SPACE. IX1024.2 +028100 02 FILLER PIC X(21) VALUE SPACE. IX1024.2 +028200 02 CCVS-E-2-2. IX1024.2 +028300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1024.2 +028400 03 FILLER PIC X VALUE SPACE. IX1024.2 +028500 03 ENDER-DESC PIC X(44) VALUE IX1024.2 +028600 "ERRORS ENCOUNTERED". IX1024.2 +028700 01 CCVS-E-3. IX1024.2 +028800 02 FILLER PIC X(22) VALUE IX1024.2 +028900 " FOR OFFICIAL USE ONLY". IX1024.2 +029000 02 FILLER PIC X(12) VALUE SPACE. IX1024.2 +029100 02 FILLER PIC X(58) VALUE IX1024.2 +029200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1024.2 +029300 02 FILLER PIC X(13) VALUE SPACE. IX1024.2 +029400 02 FILLER PIC X(15) VALUE IX1024.2 +029500 " COPYRIGHT 1985". IX1024.2 +029600 01 CCVS-E-4. IX1024.2 +029700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1024.2 +029800 02 FILLER PIC X(4) VALUE " OF ". IX1024.2 +029900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1024.2 +030000 02 FILLER PIC X(40) VALUE IX1024.2 +030100 " TESTS WERE EXECUTED SUCCESSFULLY". IX1024.2 +030200 01 XXINFO. IX1024.2 +030300 02 FILLER PIC X(19) VALUE IX1024.2 +030400 "*** INFORMATION ***". IX1024.2 +030500 02 INFO-TEXT. IX1024.2 +030600 04 FILLER PIC X(8) VALUE SPACE. IX1024.2 +030700 04 XXCOMPUTED PIC X(20). IX1024.2 +030800 04 FILLER PIC X(5) VALUE SPACE. IX1024.2 +030900 04 XXCORRECT PIC X(20). IX1024.2 +031000 02 INF-ANSI-REFERENCE PIC X(48). IX1024.2 +031100 01 HYPHEN-LINE. IX1024.2 +031200 02 FILLER PIC IS X VALUE IS SPACE. IX1024.2 +031300 02 FILLER PIC IS X(65) VALUE IS "************************IX1024.2 +031400- "*****************************************". IX1024.2 +031500 02 FILLER PIC IS X(54) VALUE IS "************************IX1024.2 +031600- "******************************". IX1024.2 +031700 01 CCVS-PGM-ID PIC X(9) VALUE IX1024.2 +031800 "IX102A". IX1024.2 +031900 PROCEDURE DIVISION. IX1024.2 +032000 CCVS1 SECTION. IX1024.2 +032100 OPEN-FILES. IX1024.2 +032200*P OPEN I-O RAW-DATA. IX1024.2 +032300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1024.2 +032400*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1024.2 +032500*P MOVE "ABORTED " TO C-ABORT. IX1024.2 +032600*P ADD 1 TO C-NO-OF-TESTS. IX1024.2 +032700*P ACCEPT C-DATE FROM DATE. IX1024.2 +032800*P ACCEPT C-TIME FROM TIME. IX1024.2 +032900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1024.2 +033000*PND-E-1. IX1024.2 +033100*P CLOSE RAW-DATA. IX1024.2 +033200 OPEN OUTPUT PRINT-FILE. IX1024.2 +033300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1024.2 +033400 MOVE SPACE TO TEST-RESULTS. IX1024.2 +033500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1024.2 +033600 MOVE ZERO TO REC-SKL-SUB. IX1024.2 +033700 PERFORM CCVS-INIT-FILE 9 TIMES. IX1024.2 +033800 CCVS-INIT-FILE. IX1024.2 +033900 ADD 1 TO REC-SKL-SUB. IX1024.2 +034000 MOVE FILE-RECORD-INFO-SKELETON IX1024.2 +034100 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1024.2 +034200 CCVS-INIT-EXIT. IX1024.2 +034300 GO TO CCVS1-EXIT. IX1024.2 +034400 CLOSE-FILES. IX1024.2 +034500*P OPEN I-O RAW-DATA. IX1024.2 +034600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1024.2 +034700*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1024.2 +034800*P MOVE "OK. " TO C-ABORT. IX1024.2 +034900*P MOVE PASS-COUNTER TO C-OK. IX1024.2 +035000*P MOVE ERROR-HOLD TO C-ALL. IX1024.2 +035100*P MOVE ERROR-COUNTER TO C-FAIL. IX1024.2 +035200*P MOVE DELETE-COUNTER TO C-DELETED. IX1024.2 +035300*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1024.2 +035400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1024.2 +035500*PND-E-2. IX1024.2 +035600*P CLOSE RAW-DATA. IX1024.2 +035700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1024.2 +035800 TERMINATE-CCVS. IX1024.2 +035900*S EXIT PROGRAM. IX1024.2 +036000*SERMINATE-CALL. IX1024.2 +036100 STOP RUN. IX1024.2 +036200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1024.2 +036300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1024.2 +036400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1024.2 +036500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1024.2 +036600 MOVE "****TEST DELETED****" TO RE-MARK. IX1024.2 +036700 PRINT-DETAIL. IX1024.2 +036800 IF REC-CT NOT EQUAL TO ZERO IX1024.2 +036900 MOVE "." TO PARDOT-X IX1024.2 +037000 MOVE REC-CT TO DOTVALUE. IX1024.2 +037100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1024.2 +037200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1024.2 +037300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1024.2 +037400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1024.2 +037500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1024.2 +037600 MOVE SPACE TO CORRECT-X. IX1024.2 +037700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1024.2 +037800 MOVE SPACE TO RE-MARK. IX1024.2 +037900 HEAD-ROUTINE. IX1024.2 +038000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +038100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +038200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1024.2 +038300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1024.2 +038400 COLUMN-NAMES-ROUTINE. IX1024.2 +038500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +038600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +038800 END-ROUTINE. IX1024.2 +038900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1024.2 +039000 END-RTN-EXIT. IX1024.2 +039100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +039200 END-ROUTINE-1. IX1024.2 +039300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1024.2 +039400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1024.2 +039500 ADD PASS-COUNTER TO ERROR-HOLD. IX1024.2 +039600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1024.2 +039700 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1024.2 +039800 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1024.2 +039900 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1024.2 +040000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1024.2 +040100 END-ROUTINE-12. IX1024.2 +040200 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1024.2 +040300 IF ERROR-COUNTER IS EQUAL TO ZERO IX1024.2 +040400 MOVE "NO " TO ERROR-TOTAL IX1024.2 +040500 ELSE IX1024.2 +040600 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1024.2 +040700 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1024.2 +040800 PERFORM WRITE-LINE. IX1024.2 +040900 END-ROUTINE-13. IX1024.2 +041000 IF DELETE-COUNTER IS EQUAL TO ZERO IX1024.2 +041100 MOVE "NO " TO ERROR-TOTAL ELSE IX1024.2 +041200 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1024.2 +041300 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1024.2 +041400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +041500 IF INSPECT-COUNTER EQUAL TO ZERO IX1024.2 +041600 MOVE "NO " TO ERROR-TOTAL IX1024.2 +041700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1024.2 +041800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1024.2 +041900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +042000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1024.2 +042100 WRITE-LINE. IX1024.2 +042200 ADD 1 TO RECORD-COUNT. IX1024.2 +042300 IF RECORD-COUNT GREATER 42 IX1024.2 +042400 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1024.2 +042500 MOVE SPACE TO DUMMY-RECORD IX1024.2 +042600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1024.2 +042700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1024.2 +042800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1024.2 +042900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1024.2 +043000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1024.2 +043100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1024.2 +043200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1024.2 +043300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1024.2 +043400 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1024.2 +043500 MOVE ZERO TO RECORD-COUNT. IX1024.2 +043600 PERFORM WRT-LN. IX1024.2 +043700 WRT-LN. IX1024.2 +043800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1024.2 +043900 MOVE SPACE TO DUMMY-RECORD. IX1024.2 +044000 BLANK-LINE-PRINT. IX1024.2 +044100 PERFORM WRT-LN. IX1024.2 +044200 FAIL-ROUTINE. IX1024.2 +044300 IF COMPUTED-X NOT EQUAL TO SPACE IX1024.2 +044400 GO TO FAIL-ROUTINE-WRITE. IX1024.2 +044500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1024.2 +044600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1024.2 +044700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1024.2 +044800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +044900 MOVE SPACES TO INF-ANSI-REFERENCE. IX1024.2 +045000 GO TO FAIL-ROUTINE-EX. IX1024.2 +045100 FAIL-ROUTINE-WRITE. IX1024.2 +045200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1024.2 +045300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1024.2 +045400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1024.2 +045500 MOVE SPACES TO COR-ANSI-REFERENCE. IX1024.2 +045600 FAIL-ROUTINE-EX. EXIT. IX1024.2 +045700 BAIL-OUT. IX1024.2 +045800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1024.2 +045900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1024.2 +046000 BAIL-OUT-WRITE. IX1024.2 +046100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1024.2 +046200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1024.2 +046300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1024.2 +046400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1024.2 +046500 BAIL-OUT-EX. EXIT. IX1024.2 +046600 CCVS1-EXIT. IX1024.2 +046700 EXIT. IX1024.2 +046800 SECT-IX-02-001 SECTION. IX1024.2 +046900 READ-INIT-F2-01. IX1024.2 +047000* IX1024.2 +047100* TEST 1 IX1024.2 +047200* IX1024.2 +047300 OPEN INPUT IX-FS1. IX1024.2 +047400 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX1024.2 +047500 MOVE ZERO TO WRK-DU-09V00-001. IX1024.2 +047600 MOVE IX-WRK-KEY TO IX-FS1-KEY. IX1024.2 +047700 MOVE ZERO TO WRK-CS-09V00-002 IX1024.2 +047800 MOVE ZERO TO WRK-DU-09V00-001 IX1024.2 +047900 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +048000 READ-TEST-F2-01. IX1024.2 +048100 ADD 1 TO WRK-DU-09V00-001 IX1024.2 +048200 MOVE IX-WRK-KEY TO IX-FS1-KEY. IX1024.2 +048300 IF WRK-DU-09V00-001 GREATER 501 IX1024.2 +048400 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A IX1024.2 +048500 MOVE WRK-DU-09V00-001 TO CORRECT-18V0 IX1024.2 +048600 PERFORM FAIL IX1024.2 +048700 PERFORM PRINT-DETAIL IX1024.2 +048800 GO TO READ-WRITE-F2-01. IX1024.2 +048900 READ IX-FS1 IX1024.2 +049000 INVALID KEY GO TO READ-WRITE-F2-01. IX1024.2 +049100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1024.2 +049200 IF XRECORD-NUMBER (1) EQUAL TO WRK-DU-09V00-001 IX1024.2 +049300 GO TO READ-TEST-F2-01. IX1024.2 +049400 MOVE "YES" TO I-O-ERROR-IX-FS1. IX1024.2 +049500 ADD 1 TO WRK-CS-09V00-002 IX1024.2 +049600 GO TO READ-TEST-F2-01. IX1024.2 +049700 READ-WRITE-F2-01. IX1024.2 +049800 IF WRK-DU-09V00-001 NOT EQUAL TO 501 IX1024.2 +049900 MOVE "WRONG KEY/NOT 500" TO CORRECT-A IX1024.2 +050000 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX1024.2 +050100 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +050200 PERFORM FAIL IX1024.2 +050300 ELSE IX1024.2 +050400 PERFORM PASS. IX1024.2 +050500 PERFORM PRINT-DETAIL. IX1024.2 +050600 READ-TEST-F2-02. IX1024.2 +050700 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX1024.2 +050800 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +050900* IX1024.2 +051000* TEST 2 IX1024.2 +051100* IX1024.2 +051200 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 IX1024.2 +051300 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A IX1024.2 +051400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX1024.2 +051500 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +051600 PERFORM FAIL IX1024.2 +051700 ELSE IX1024.2 +051800 PERFORM PASS. IX1024.2 +051900 PERFORM PRINT-DETAIL. IX1024.2 +052000 READ-TEST-F2-03. IX1024.2 +052100 MOVE "READ-TEST-F2-03" TO PAR-NAME. IX1024.2 +052200 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +052300* IX1024.2 +052400* TEST 3 IX1024.2 +052500* IX1024.2 +052600 IF WRK-DU-09V00-001 NOT EQUAL TO 501 IX1024.2 +052700 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX1024.2 +052800 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX1024.2 +052900 MOVE 501 TO CORRECT-18V0 IX1024.2 +053000 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +053100 PERFORM FAIL IX1024.2 +053200 ELSE IX1024.2 +053300 PERFORM PASS. IX1024.2 +053400 PERFORM PRINT-DETAIL. IX1024.2 +053500 READ-TEST-F2-04. IX1024.2 +053600 MOVE "READ-TEST-F2-04" TO PAR-NAME. IX1024.2 +053700 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +053800* IX1024.2 +053900* TEST 4 IX1024.2 +054000* IX1024.2 +054100 IF I-O-ERROR-IX-FS1 EQUAL TO "YES" IX1024.2 +054200 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 IX1024.2 +054300 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK IX1024.2 +054400 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +054500 PERFORM FAIL IX1024.2 +054600 ELSE IX1024.2 +054700 PERFORM PASS. IX1024.2 +054800 PERFORM PRINT-DETAIL. IX1024.2 +054900 CLOSE IX-FS1. IX1024.2 +055000 REWRITE-INIT-F2-01. IX1024.2 +055100 MOVE "REWRITE-TEST-F2-01" TO PAR-NAME. IX1024.2 +055200 OPEN I-O IX-FS1. IX1024.2 +055300 MOVE ZERO TO IX-FS1-KEY. IX1024.2 +055400 MOVE ZERO TO WRK-CS-09V00-002. IX1024.2 +055500 MOVE ZERO TO WRK-DU-09V00-001. IX1024.2 +055600 MOVE "REWRITE ... INVALID" TO FEATURE. IX1024.2 +055700 MOVE SPACE TO FILE-RECORD-INFO (1). IX1024.2 +055800 REWRITE-TEST-F2-01. IX1024.2 +055900* IX1024.2 +056000* REWRITE TEST 1 IX1024.2 +056100* IX1024.2 +056200 ADD 5 TO WRK-DU-09V00-001. IX1024.2 +056300 MOVE IX-WRK-KEY TO IX-FS1-KEY. IX1024.2 +056400 IF WRK-DU-09V00-001 GREATER 505 IX1024.2 +056500 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A IX1024.2 +056600 MOVE WRK-DU-09V00-001 TO CORRECT-18V0 IX1024.2 +056700 PERFORM FAIL IX1024.2 +056800 PERFORM PRINT-DETAIL IX1024.2 +056900 GO TO REWRITE-TEST-F2-01-3. IX1024.2 +057000 READ IX-FS1 IX1024.2 +057100 INVALID KEY GO TO REWRITE-TEST-F2-01-1. IX1024.2 +057200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1) IX1024.2 +057300 ADD 01 TO UPDATE-NUMBER (1). IX1024.2 +057400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1024.2 +057500 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX1024.2 +057600 REWRITE IX-FS1R1-F-G-240 IX1024.2 +057700 INVALID KEY GO TO REWRITE-TEST-F2-01-2. IX1024.2 +057800 GO TO REWRITE-TEST-F2-01. IX1024.2 +057900 REWRITE-TEST-F2-01-1. IX1024.2 +058000 IF WRK-DU-09V00-001 LESS THAN 501 IX1024.2 +058100 ADD 1 TO WRK-CS-09V00-004 IX1024.2 +058200 GO TO REWRITE-TEST-F2-01. IX1024.2 +058300 PERFORM PASS. IX1024.2 +058400 PERFORM PRINT-DETAIL. IX1024.2 +058500 REWRITE-TEST-F2-02. IX1024.2 +058600 MOVE "REWRITE-TEST-F2-02" TO PAR-NAME. IX1024.2 +058700 MOVE "REWRITE ... INVALID" TO FEATURE. IX1024.2 +058800* IX1024.2 +058900* REWRITE TEST 2 IX1024.2 +059000* IX1024.2 +059100 GO TO REWRITE-TEST-F2-01-3. IX1024.2 +059200 REWRITE-TEST-F2-01-2. IX1024.2 +059300 ADD 1 TO WRK-CS-09V00-005. IX1024.2 +059400 IF WRK-DU-09V00-001 LESS THAN 501 IX1024.2 +059500 GO TO REWRITE-TEST-F2-01. IX1024.2 +059600 REWRITE-TEST-F2-01-3. IX1024.2 +059700 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO IX1024.2 +059800 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX1024.2 +059900 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 IX1024.2 +060000 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +060100 PERFORM FAIL IX1024.2 +060200 ELSE IX1024.2 +060300 PERFORM PASS. IX1024.2 +060400 PERFORM PRINT-DETAIL. IX1024.2 +060500 REWRITE-TEST-F2-03. IX1024.2 +060600 MOVE "REWRITE-TEST-F2-03" TO PAR-NAME. IX1024.2 +060700 MOVE "REWRITE ... INVALID" TO FEATURE. IX1024.2 +060800* IX1024.2 +060900* REWRITE TEST 3 IX1024.2 +061000* IX1024.2 +061100 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO IX1024.2 +061200 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A IX1024.2 +061300 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 IX1024.2 +061400 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +061500 PERFORM FAIL IX1024.2 +061600 ELSE IX1024.2 +061700 PERFORM PASS. IX1024.2 +061800 PERFORM PRINT-DETAIL. IX1024.2 +061900 CLOSE IX-FS1. IX1024.2 +062000 READ-INIT-F2-05. IX1024.2 +062100 MOVE "READ-TEST-F2-05" TO PAR-NAME. IX1024.2 +062200 OPEN INPUT IX-FS1. IX1024.2 +062300 MOVE 501 TO WRK-DU-09V00-001. IX1024.2 +062400 MOVE ZERO TO WRK-CS-09V00-004. IX1024.2 +062500 MOVE ZERO TO WRK-CS-09V00-005. IX1024.2 +062600 MOVE ZERO TO WRK-CS-09V00-002. IX1024.2 +062700 MOVE SPACE TO FILE-RECORD-INFO (1). IX1024.2 +062800 MOVE "READ ... INVALID " TO FEATURE. IX1024.2 +062900 READ-TEST-F2-05. IX1024.2 +063000 IF WRK-DU-09V00-001 EQUAL TO ZERO IX1024.2 +063100 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A IX1024.2 +063200 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX1024.2 +063300 MOVE ZERO TO CORRECT-18V0 IX1024.2 +063400 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +063500 PERFORM FAIL IX1024.2 +063600 PERFORM PRINT-DETAIL IX1024.2 +063700 GO TO READ-TEST-F2-05. IX1024.2 +063800 SUBTRACT 1 FROM WRK-DU-09V00-001. IX1024.2 +063900 MOVE IX-WRK-KEY TO IX-FS1-KEY. IX1024.2 +064000 READ IX-FS1 IX1024.2 +064100 INVALID KEY GO TO READ-TEST-F2-05-1. IX1024.2 +064200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1024.2 +064300 IF UPDATE-NUMBER (1) EQUAL TO 00 IX1024.2 +064400 ADD 1 TO WRK-CS-09V00-004. IX1024.2 +064500 IF UPDATE-NUMBER (1) EQUAL TO 01 IX1024.2 +064600 ADD 1 TO WRK-CS-09V00-005. IX1024.2 +064700 GO TO READ-TEST-F2-05. IX1024.2 +064800 READ-TEST-F2-05-1. IX1024.2 +064900 IF WRK-DU-09V00-001 GREATER ZERO IX1024.2 +065000 ADD 1 TO WRK-CS-09V00-002 IX1024.2 +065100 GO TO READ-TEST-F2-05. IX1024.2 +065200 PERFORM PASS. IX1024.2 +065300 PERFORM PRINT-DETAIL. IX1024.2 +065400 READ-TEST-F2-06. IX1024.2 +065500 MOVE "READ-TEST-F2-06" TO PAR-NAME. IX1024.2 +065600 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +065700* IX1024.2 +065800* TEST 6 IX1024.2 +065900* IX1024.2 +066000 IF WRK-CS-09V00-004 NOT EQUAL TO 400 IX1024.2 +066100 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A IX1024.2 +066200 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 IX1024.2 +066300 MOVE "SHOULD BE 400" TO RE-MARK IX1024.2 +066400 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +066500 PERFORM FAIL IX1024.2 +066600 ELSE IX1024.2 +066700 PERFORM PASS. IX1024.2 +066800 PERFORM PRINT-DETAIL. IX1024.2 +066900 READ-TEST-F2-07. IX1024.2 +067000 MOVE "READ-TEST-F2-07" TO PAR-NAME. IX1024.2 +067100 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +067200* IX1024.2 +067300* TEST 7 IX1024.2 +067400* IX1024.2 +067500 IF WRK-CS-09V00-005 NOT EQUAL TO 100 IX1024.2 +067600 MOVE "UPDATED RECORDS" TO COMPUTED-A IX1024.2 +067700 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 IX1024.2 +067800 MOVE "SHOULD BE 100" TO RE-MARK IX1024.2 +067900 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +068000 PERFORM FAIL IX1024.2 +068100 ELSE IX1024.2 +068200 PERFORM PASS. IX1024.2 +068300 PERFORM PRINT-DETAIL. IX1024.2 +068400 READ-TEST-F2-08. IX1024.2 +068500 MOVE "READ-TEST-F2-08" TO PAR-NAME. IX1024.2 +068600 MOVE "READ ... INVALID" TO FEATURE. IX1024.2 +068700* IX1024.2 +068800* TEST 8 IX1024.2 +068900* IX1024.2 +069000 IF WRK-CS-09V00-002 GREATER 1 IX1024.2 +069100 MOVE WRK-CS-09V00-002 TO COMPUTED-N IX1024.2 +069200 MOVE "INVALID KEY/READS" TO CORRECT-A IX1024.2 +069300 MOVE "IX-28 4.5.2 " TO RE-MARKIX1024.2 +069400 PERFORM FAIL IX1024.2 +069500 ELSE IX1024.2 +069600 PERFORM PASS. IX1024.2 +069700 PERFORM PRINT-DETAIL. IX1024.2 +069800 CLOSE IX-FS1. IX1024.2 +069900 CCVS-EXIT SECTION. IX1024.2 +070000 CCVS-999999. IX1024.2 +070100 GO TO CLOSE-FILES. IX1024.2 diff --git a/tests/cobol85/IX/IX103A.SUB b/tests/cobol85/IX/IX103A.SUB new file mode 100755 index 00000000..59415de6 --- /dev/null +++ b/tests/cobol85/IX/IX103A.SUB @@ -0,0 +1,757 @@ +000100 IDENTIFICATION DIVISION. IX1034.2 +000200 PROGRAM-ID. IX1034.2 +000300 IX103A. IX1034.2 +000400**************************************************************** IX1034.2 +000500* * IX1034.2 +000600* VALIDATION FOR:- * IX1034.2 +000700* * IX1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1034.2 +000900* * IX1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1034.2 +001100* * IX1034.2 +001200**************************************************************** IX1034.2 +001300* IX1034.2 +001400* NEW TEST: IX1034.2 +001500* SELECT ... INDEXED ... IX1034.2 +001600* (WITHOUT THE OPTIONAL WORD ) IX1034.2 +001700* IX1034.2 +001800* THIS PROGRAM IS THE THIRD OF A SERIES. ITS FUNCTION IX1034.2 +001900* IS TO PROCESS THE FILE SEQUENTIALLY (ACCESS MODE IS IX1034.2 +002000* SEQUENTIAL). THE FILE USED IS THAT RESULTING FROM IX102. IX1034.2 +002100* IX1034.2 +002200* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RECORDS. IX1034.2 +002300* SECONDLY, RECORDS OF THE FILE ARE SELECTIVELY DELETED AND IX1034.2 +002400* THIRDLY THE ACCURACY OF EACH RECORD IN THE FILE IS AGAIN IX1034.2 +002500* VERIFIED. IX1034.2 +002600* IX1034.2 +002700* IX1034.2 +002800* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1034.2 +002900* IX1034.2 +003000* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1034.2 +003100* CLAUSE FOR DATA FILE IX-FS1 IX1034.2 +003200* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1034.2 +003300* CLAUSE FOR INDEX FILE IX-FS1 IX1034.2 +003400* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1034.2 +003500* X-62 IMPLEMENTOR-NAME FOR RAW-DATA IX1034.2 +003600* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1034.2 +003700* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1034.2 +003800* IX1034.2 +003900* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX1034.2 +004000* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1034.2 +004100* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1034.2 +004200* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1034.2 +004300* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1034.2 +004400* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1034.2 +004500* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1034.2 +004600* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1034.2 +004700* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1034.2 +004800* THEY ARE AS FOLLOWS IX1034.2 +004900* IX1034.2 +005000* J SELECTS X-CARD 44 IX1034.2 +005100* P SELECTS X-CARD 62 IX1034.2 +005200* IX1034.2 +005300****************************************************** IX1034.2 +005400 ENVIRONMENT DIVISION. IX1034.2 +005500 CONFIGURATION SECTION. IX1034.2 +005600 SOURCE-COMPUTER. IX1034.2 +005700 Linux. IX1034.2 +005800 OBJECT-COMPUTER. IX1034.2 +005900 Linux. IX1034.2 +006000 INPUT-OUTPUT SECTION. IX1034.2 +006100 FILE-CONTROL. IX1034.2 +006200*P SELECT RAW-DATA ASSIGN TO IX1034.2 +006300*P "XXXXX062" IX1034.2 +006400*P ORGANIZATION IS INDEXED IX1034.2 +006500*P ACCESS MODE IS RANDOM IX1034.2 +006600*P RECORD KEY IS RAW-DATA-KEY. IX1034.2 +006700 SELECT PRINT-FILE ASSIGN TO IX1034.2 +006800 "report.log". IX1034.2 +006900 SELECT IX-FS1 ASSIGN TO IX1034.2 +007000 "XXXXX024" IX1034.2 +007100*J **** X-CARD UNDEFINED **** IX1034.2 +007200 INDEXED IX1034.2 +007300 RECORD IX-FS1-KEY. IX1034.2 +007400* THE ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH IX1034.2 +007500* SEQUENTIAL HAD BEEN SPECIFIED. IX1034.2 +007600 DATA DIVISION. IX1034.2 +007700 FILE SECTION. IX1034.2 +007800*P IX1034.2 +007900*PD RAW-DATA. IX1034.2 +008000*P IX1034.2 +008100*P1 RAW-DATA-SATZ. IX1034.2 +008200*P 05 RAW-DATA-KEY PIC X(6). IX1034.2 +008300*P 05 C-DATE PIC 9(6). IX1034.2 +008400*P 05 C-TIME PIC 9(8). IX1034.2 +008500*P 05 C-NO-OF-TESTS PIC 99. IX1034.2 +008600*P 05 C-OK PIC 999. IX1034.2 +008700*P 05 C-ALL PIC 999. IX1034.2 +008800*P 05 C-FAIL PIC 999. IX1034.2 +008900*P 05 C-DELETED PIC 999. IX1034.2 +009000*P 05 C-INSPECT PIC 999. IX1034.2 +009100*P 05 C-NOTE PIC X(13). IX1034.2 +009200*P 05 C-INDENT PIC X. IX1034.2 +009300*P 05 C-ABORT PIC X(8). IX1034.2 +009400 FD PRINT-FILE. IX1034.2 +009500 01 PRINT-REC PICTURE X(120). IX1034.2 +009600 01 DUMMY-RECORD PICTURE X(120). IX1034.2 +009700 FD IX-FS1 IX1034.2 +009800*C LABEL RECORD STANDARD IX1034.2 +009900*C DATA RECORDS ARE IX-FS1R1-F-G-240 IX1034.2 +010000 ; BLOCK CONTAINS 01 RECORDS IX1034.2 +010100 RECORD CONTAINS 240. IX1034.2 +010200 01 IX-FS1R1-F-G-240. IX1034.2 +010300 05 IX-FS1-REC-120 PIC X(120). IX1034.2 +010400 05 IX-FS1-REC-120-240. IX1034.2 +010500 10 FILLER PIC X(8). IX1034.2 +010600 10 IX-FS1-KEY PIC X(29). IX1034.2 +010700 10 FILLER PIC X(83). IX1034.2 +010800 WORKING-STORAGE SECTION. IX1034.2 +010900 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011000 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011100 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011200 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011300 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011400 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. IX1034.2 +011500 01 I-O-ERROR-IX-FS1 PIC X(3) VALUE "NO ". IX1034.2 +011600 01 IX-WRK-KEY. IX1034.2 +011700 03 FILLER PIC X(10). IX1034.2 +011800 03 WRK-DU-09V00-001 PIC 9(9). IX1034.2 +011900 03 FILLER PIC X(10). IX1034.2 +012000 01 DUMMY-WRK-REC. IX1034.2 +012100 02 DUMMY-WRK1 PIC X(120). IX1034.2 +012200 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX1034.2 +012300 03 FILLER PIC X(5). IX1034.2 +012400 03 DUMMY-WRK-INDENT-5 PIC X(115). IX1034.2 +012500 01 FILE-RECORD-INFORMATION-REC. IX1034.2 +012600 03 FILE-RECORD-INFO-SKELETON. IX1034.2 +012700 05 FILLER PICTURE X(48) VALUE IX1034.2 +012800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1034.2 +012900 05 FILLER PICTURE X(46) VALUE IX1034.2 +013000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1034.2 +013100 05 FILLER PICTURE X(26) VALUE IX1034.2 +013200 ",LFIL=000000,ORG= ,LBLR= ". IX1034.2 +013300 05 FILLER PICTURE X(37) VALUE IX1034.2 +013400 ",RECKEY= ". IX1034.2 +013500 05 FILLER PICTURE X(38) VALUE IX1034.2 +013600 ",ALTKEY1= ". IX1034.2 +013700 05 FILLER PICTURE X(38) VALUE IX1034.2 +013800 ",ALTKEY2= ". IX1034.2 +013900 05 FILLER PICTURE X(7) VALUE SPACE.IX1034.2 +014000 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1034.2 +014100 05 FILE-RECORD-INFO-P1-120. IX1034.2 +014200 07 FILLER PIC X(5). IX1034.2 +014300 07 XFILE-NAME PIC X(6). IX1034.2 +014400 07 FILLER PIC X(8). IX1034.2 +014500 07 XRECORD-NAME PIC X(6). IX1034.2 +014600 07 FILLER PIC X(1). IX1034.2 +014700 07 REELUNIT-NUMBER PIC 9(1). IX1034.2 +014800 07 FILLER PIC X(7). IX1034.2 +014900 07 XRECORD-NUMBER PIC 9(6). IX1034.2 +015000 07 FILLER PIC X(6). IX1034.2 +015100 07 UPDATE-NUMBER PIC 9(2). IX1034.2 +015200 07 FILLER PIC X(5). IX1034.2 +015300 07 ODO-NUMBER PIC 9(4). IX1034.2 +015400 07 FILLER PIC X(5). IX1034.2 +015500 07 XPROGRAM-NAME PIC X(5). IX1034.2 +015600 07 FILLER PIC X(7). IX1034.2 +015700 07 XRECORD-LENGTH PIC 9(6). IX1034.2 +015800 07 FILLER PIC X(7). IX1034.2 +015900 07 CHARS-OR-RECORDS PIC X(2). IX1034.2 +016000 07 FILLER PIC X(1). IX1034.2 +016100 07 XBLOCK-SIZE PIC 9(4). IX1034.2 +016200 07 FILLER PIC X(6). IX1034.2 +016300 07 RECORDS-IN-FILE PIC 9(6). IX1034.2 +016400 07 FILLER PIC X(5). IX1034.2 +016500 07 XFILE-ORGANIZATION PIC X(2). IX1034.2 +016600 07 FILLER PIC X(6). IX1034.2 +016700 07 XLABEL-TYPE PIC X(1). IX1034.2 +016800 05 FILE-RECORD-INFO-P121-240. IX1034.2 +016900 07 FILLER PIC X(8). IX1034.2 +017000 07 XRECORD-KEY PIC X(29). IX1034.2 +017100 07 FILLER PIC X(9). IX1034.2 +017200 07 ALTERNATE-KEY1 PIC X(29). IX1034.2 +017300 07 FILLER PIC X(9). IX1034.2 +017400 07 ALTERNATE-KEY2 PIC X(29). IX1034.2 +017500 07 FILLER PIC X(7). IX1034.2 +017600 01 TEST-RESULTS. IX1034.2 +017700 02 FILLER PIC X VALUE SPACE. IX1034.2 +017800 02 FEATURE PIC X(20) VALUE SPACE. IX1034.2 +017900 02 FILLER PIC X VALUE SPACE. IX1034.2 +018000 02 P-OR-F PIC X(5) VALUE SPACE. IX1034.2 +018100 02 FILLER PIC X VALUE SPACE. IX1034.2 +018200 02 PAR-NAME. IX1034.2 +018300 03 FILLER PIC X(19) VALUE SPACE. IX1034.2 +018400 03 PARDOT-X PIC X VALUE SPACE. IX1034.2 +018500 03 DOTVALUE PIC 99 VALUE ZERO. IX1034.2 +018600 02 FILLER PIC X(8) VALUE SPACE. IX1034.2 +018700 02 RE-MARK PIC X(61). IX1034.2 +018800 01 TEST-COMPUTED. IX1034.2 +018900 02 FILLER PIC X(30) VALUE SPACE. IX1034.2 +019000 02 FILLER PIC X(17) VALUE IX1034.2 +019100 " COMPUTED=". IX1034.2 +019200 02 COMPUTED-X. IX1034.2 +019300 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1034.2 +019400 03 COMPUTED-N REDEFINES COMPUTED-A IX1034.2 +019500 PIC -9(9).9(9). IX1034.2 +019600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1034.2 +019700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1034.2 +019800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1034.2 +019900 03 CM-18V0 REDEFINES COMPUTED-A. IX1034.2 +020000 04 COMPUTED-18V0 PIC -9(18). IX1034.2 +020100 04 FILLER PIC X. IX1034.2 +020200 03 FILLER PIC X(50) VALUE SPACE. IX1034.2 +020300 01 TEST-CORRECT. IX1034.2 +020400 02 FILLER PIC X(30) VALUE SPACE. IX1034.2 +020500 02 FILLER PIC X(17) VALUE " CORRECT =". IX1034.2 +020600 02 CORRECT-X. IX1034.2 +020700 03 CORRECT-A PIC X(20) VALUE SPACE. IX1034.2 +020800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1034.2 +020900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1034.2 +021000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1034.2 +021100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1034.2 +021200 03 CR-18V0 REDEFINES CORRECT-A. IX1034.2 +021300 04 CORRECT-18V0 PIC -9(18). IX1034.2 +021400 04 FILLER PIC X. IX1034.2 +021500 03 FILLER PIC X(2) VALUE SPACE. IX1034.2 +021600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1034.2 +021700 01 CCVS-C-1. IX1034.2 +021800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1034.2 +021900- "SS PARAGRAPH-NAME IX1034.2 +022000- " REMARKS". IX1034.2 +022100 02 FILLER PIC X(20) VALUE SPACE. IX1034.2 +022200 01 CCVS-C-2. IX1034.2 +022300 02 FILLER PIC X VALUE SPACE. IX1034.2 +022400 02 FILLER PIC X(6) VALUE "TESTED". IX1034.2 +022500 02 FILLER PIC X(15) VALUE SPACE. IX1034.2 +022600 02 FILLER PIC X(4) VALUE "FAIL". IX1034.2 +022700 02 FILLER PIC X(94) VALUE SPACE. IX1034.2 +022800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1034.2 +022900 01 REC-CT PIC 99 VALUE ZERO. IX1034.2 +023000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1034.2 +023100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1034.2 +023200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1034.2 +023300 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1034.2 +023400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1034.2 +023500 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1034.2 +023600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1034.2 +023700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1034.2 +023800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1034.2 +023900 01 CCVS-H-1. IX1034.2 +024000 02 FILLER PIC X(39) VALUE SPACES. IX1034.2 +024100 02 FILLER PIC X(42) VALUE IX1034.2 +024200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1034.2 +024300 02 FILLER PIC X(39) VALUE SPACES. IX1034.2 +024400 01 CCVS-H-2A. IX1034.2 +024500 02 FILLER PIC X(40) VALUE SPACE. IX1034.2 +024600 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1034.2 +024700 02 FILLER PIC XXXX VALUE IX1034.2 +024800 "4.2 ". IX1034.2 +024900 02 FILLER PIC X(28) VALUE IX1034.2 +025000 " COPY - NOT FOR DISTRIBUTION". IX1034.2 +025100 02 FILLER PIC X(41) VALUE SPACE. IX1034.2 +025200 IX1034.2 +025300 01 CCVS-H-2B. IX1034.2 +025400 02 FILLER PIC X(15) VALUE IX1034.2 +025500 "TEST RESULT OF ". IX1034.2 +025600 02 TEST-ID PIC X(9). IX1034.2 +025700 02 FILLER PIC X(4) VALUE IX1034.2 +025800 " IN ". IX1034.2 +025900 02 FILLER PIC X(12) VALUE IX1034.2 +026000 " HIGH ". IX1034.2 +026100 02 FILLER PIC X(22) VALUE IX1034.2 +026200 " LEVEL VALIDATION FOR ". IX1034.2 +026300 02 FILLER PIC X(58) VALUE IX1034.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1034.2 +026500 01 CCVS-H-3. IX1034.2 +026600 02 FILLER PIC X(34) VALUE IX1034.2 +026700 " FOR OFFICIAL USE ONLY ". IX1034.2 +026800 02 FILLER PIC X(58) VALUE IX1034.2 +026900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1034.2 +027000 02 FILLER PIC X(28) VALUE IX1034.2 +027100 " COPYRIGHT 1985 ". IX1034.2 +027200 01 CCVS-E-1. IX1034.2 +027300 02 FILLER PIC X(52) VALUE SPACE. IX1034.2 +027400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1034.2 +027500 02 ID-AGAIN PIC X(9). IX1034.2 +027600 02 FILLER PIC X(45) VALUE SPACES. IX1034.2 +027700 01 CCVS-E-2. IX1034.2 +027800 02 FILLER PIC X(31) VALUE SPACE. IX1034.2 +027900 02 FILLER PIC X(21) VALUE SPACE. IX1034.2 +028000 02 CCVS-E-2-2. IX1034.2 +028100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1034.2 +028200 03 FILLER PIC X VALUE SPACE. IX1034.2 +028300 03 ENDER-DESC PIC X(44) VALUE IX1034.2 +028400 "ERRORS ENCOUNTERED". IX1034.2 +028500 01 CCVS-E-3. IX1034.2 +028600 02 FILLER PIC X(22) VALUE IX1034.2 +028700 " FOR OFFICIAL USE ONLY". IX1034.2 +028800 02 FILLER PIC X(12) VALUE SPACE. IX1034.2 +028900 02 FILLER PIC X(58) VALUE IX1034.2 +029000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1034.2 +029100 02 FILLER PIC X(13) VALUE SPACE. IX1034.2 +029200 02 FILLER PIC X(15) VALUE IX1034.2 +029300 " COPYRIGHT 1985". IX1034.2 +029400 01 CCVS-E-4. IX1034.2 +029500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1034.2 +029600 02 FILLER PIC X(4) VALUE " OF ". IX1034.2 +029700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1034.2 +029800 02 FILLER PIC X(40) VALUE IX1034.2 +029900 " TESTS WERE EXECUTED SUCCESSFULLY". IX1034.2 +030000 01 XXINFO. IX1034.2 +030100 02 FILLER PIC X(19) VALUE IX1034.2 +030200 "*** INFORMATION ***". IX1034.2 +030300 02 INFO-TEXT. IX1034.2 +030400 04 FILLER PIC X(8) VALUE SPACE. IX1034.2 +030500 04 XXCOMPUTED PIC X(20). IX1034.2 +030600 04 FILLER PIC X(5) VALUE SPACE. IX1034.2 +030700 04 XXCORRECT PIC X(20). IX1034.2 +030800 02 INF-ANSI-REFERENCE PIC X(48). IX1034.2 +030900 01 HYPHEN-LINE. IX1034.2 +031000 02 FILLER PIC IS X VALUE IS SPACE. IX1034.2 +031100 02 FILLER PIC IS X(65) VALUE IS "************************IX1034.2 +031200- "*****************************************". IX1034.2 +031300 02 FILLER PIC IS X(54) VALUE IS "************************IX1034.2 +031400- "******************************". IX1034.2 +031500 01 CCVS-PGM-ID PIC X(9) VALUE IX1034.2 +031600 "IX103A". IX1034.2 +031700 PROCEDURE DIVISION. IX1034.2 +031800 DECLARATIVES. IX1034.2 +031900 USE-IX103-TEST SECTION. IX1034.2 +032000 USE AFTER STANDARD EXCEPTION PROCEDURE IX1034.2 +032100 IX-FS1. IX1034.2 +032200 USE-PAR-001. IX1034.2 +032300 ADD 1 TO WRK-CS-09V00-009. IX1034.2 +032400 USE-PAR-EXIT. IX1034.2 +032500 EXIT. IX1034.2 +032600 END DECLARATIVES. IX1034.2 +032700 CCVS1 SECTION. IX1034.2 +032800 OPEN-FILES. IX1034.2 +032900*P OPEN I-O RAW-DATA. IX1034.2 +033000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1034.2 +033100*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1034.2 +033200*P MOVE "ABORTED " TO C-ABORT. IX1034.2 +033300*P ADD 1 TO C-NO-OF-TESTS. IX1034.2 +033400*P ACCEPT C-DATE FROM DATE. IX1034.2 +033500*P ACCEPT C-TIME FROM TIME. IX1034.2 +033600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1034.2 +033700*PND-E-1. IX1034.2 +033800*P CLOSE RAW-DATA. IX1034.2 +033900 OPEN OUTPUT PRINT-FILE. IX1034.2 +034000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1034.2 +034100 MOVE SPACE TO TEST-RESULTS. IX1034.2 +034200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1034.2 +034300 MOVE ZERO TO REC-SKL-SUB. IX1034.2 +034400 PERFORM CCVS-INIT-FILE 9 TIMES. IX1034.2 +034500 CCVS-INIT-FILE. IX1034.2 +034600 ADD 1 TO REC-SKL-SUB. IX1034.2 +034700 MOVE FILE-RECORD-INFO-SKELETON IX1034.2 +034800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1034.2 +034900 CCVS-INIT-EXIT. IX1034.2 +035000 GO TO CCVS1-EXIT. IX1034.2 +035100 CLOSE-FILES. IX1034.2 +035200*P OPEN I-O RAW-DATA. IX1034.2 +035300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1034.2 +035400*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1034.2 +035500*P MOVE "OK. " TO C-ABORT. IX1034.2 +035600*P MOVE PASS-COUNTER TO C-OK. IX1034.2 +035700*P MOVE ERROR-HOLD TO C-ALL. IX1034.2 +035800*P MOVE ERROR-COUNTER TO C-FAIL. IX1034.2 +035900*P MOVE DELETE-COUNTER TO C-DELETED. IX1034.2 +036000*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1034.2 +036100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1034.2 +036200*PND-E-2. IX1034.2 +036300*P CLOSE RAW-DATA. IX1034.2 +036400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1034.2 +036500 TERMINATE-CCVS. IX1034.2 +036600*S EXIT PROGRAM. IX1034.2 +036700*SERMINATE-CALL. IX1034.2 +036800 STOP RUN. IX1034.2 +036900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1034.2 +037000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1034.2 +037100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1034.2 +037200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1034.2 +037300 MOVE "****TEST DELETED****" TO RE-MARK. IX1034.2 +037400 PRINT-DETAIL. IX1034.2 +037500 IF REC-CT NOT EQUAL TO ZERO IX1034.2 +037600 MOVE "." TO PARDOT-X IX1034.2 +037700 MOVE REC-CT TO DOTVALUE. IX1034.2 +037800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1034.2 +037900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1034.2 +038000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1034.2 +038100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1034.2 +038200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1034.2 +038300 MOVE SPACE TO CORRECT-X. IX1034.2 +038400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1034.2 +038500 MOVE SPACE TO RE-MARK. IX1034.2 +038600 HEAD-ROUTINE. IX1034.2 +038700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +038800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +038900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1034.2 +039000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1034.2 +039100 COLUMN-NAMES-ROUTINE. IX1034.2 +039200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +039300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +039400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +039500 END-ROUTINE. IX1034.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1034.2 +039700 END-RTN-EXIT. IX1034.2 +039800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +039900 END-ROUTINE-1. IX1034.2 +040000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1034.2 +040100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1034.2 +040200 ADD PASS-COUNTER TO ERROR-HOLD. IX1034.2 +040300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1034.2 +040400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1034.2 +040500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1034.2 +040600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1034.2 +040700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1034.2 +040800 END-ROUTINE-12. IX1034.2 +040900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1034.2 +041000 IF ERROR-COUNTER IS EQUAL TO ZERO IX1034.2 +041100 MOVE "NO " TO ERROR-TOTAL IX1034.2 +041200 ELSE IX1034.2 +041300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1034.2 +041400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1034.2 +041500 PERFORM WRITE-LINE. IX1034.2 +041600 END-ROUTINE-13. IX1034.2 +041700 IF DELETE-COUNTER IS EQUAL TO ZERO IX1034.2 +041800 MOVE "NO " TO ERROR-TOTAL ELSE IX1034.2 +041900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1034.2 +042000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1034.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +042200 IF INSPECT-COUNTER EQUAL TO ZERO IX1034.2 +042300 MOVE "NO " TO ERROR-TOTAL IX1034.2 +042400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1034.2 +042500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1034.2 +042600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +042700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1034.2 +042800 WRITE-LINE. IX1034.2 +042900 ADD 1 TO RECORD-COUNT. IX1034.2 +043000 IF RECORD-COUNT GREATER 42 IX1034.2 +043100 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1034.2 +043200 MOVE SPACE TO DUMMY-RECORD IX1034.2 +043300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1034.2 +043400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1034.2 +043500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1034.2 +043600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1034.2 +043700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1034.2 +043800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1034.2 +043900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1034.2 +044000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1034.2 +044100 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1034.2 +044200 MOVE ZERO TO RECORD-COUNT. IX1034.2 +044300 PERFORM WRT-LN. IX1034.2 +044400 WRT-LN. IX1034.2 +044500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1034.2 +044600 MOVE SPACE TO DUMMY-RECORD. IX1034.2 +044700 BLANK-LINE-PRINT. IX1034.2 +044800 PERFORM WRT-LN. IX1034.2 +044900 FAIL-ROUTINE. IX1034.2 +045000 IF COMPUTED-X NOT EQUAL TO SPACE IX1034.2 +045100 GO TO FAIL-ROUTINE-WRITE. IX1034.2 +045200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1034.2 +045300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1034.2 +045400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1034.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1034.2 +045700 GO TO FAIL-ROUTINE-EX. IX1034.2 +045800 FAIL-ROUTINE-WRITE. IX1034.2 +045900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1034.2 +046000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1034.2 +046100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1034.2 +046200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1034.2 +046300 FAIL-ROUTINE-EX. EXIT. IX1034.2 +046400 BAIL-OUT. IX1034.2 +046500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1034.2 +046600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1034.2 +046700 BAIL-OUT-WRITE. IX1034.2 +046800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1034.2 +046900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1034.2 +047000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1034.2 +047100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1034.2 +047200 BAIL-OUT-EX. EXIT. IX1034.2 +047300 CCVS1-EXIT. IX1034.2 +047400 EXIT. IX1034.2 +047500 SECT-IX-03-001 SECTION. IX1034.2 +047600 INX-INIT-006. IX1034.2 +047700* THIS FILE "IX-FS1" IS ACCESSED SEQUENTIALLY AND HAS IX1034.2 +047800* ASSOCIATED WITH IT A RECORD KEY WHICH AT ALL TIMES SHOULD IX1034.2 +047900* CONTAIN THE INDEX OF THE RECORD PREVIOUSLY READ. IX1034.2 +048000 OPEN INPUT IX-FS1. IX1034.2 +048100 MOVE "INX-TEST-006" TO PAR-NAME. IX1034.2 +048200 MOVE ZERO TO WRK-CS-09V00-006. IX1034.2 +048300 MOVE ZERO TO WRK-CS-09V00-007. IX1034.2 +048400 MOVE ZERO TO WRK-CS-09V00-008. IX1034.2 +048500 MOVE ZERO TO WRK-CS-09V00-009. IX1034.2 +048600 MOVE ZERO TO WRK-CS-09V00-010. IX1034.2 +048700 MOVE ZERO TO WRK-CS-09V00-011. IX1034.2 +048800 MOVE SPACE TO FILE-RECORD-INFO (1). IX1034.2 +048900 MOVE ZERO TO WRK-DU-09V00-001. IX1034.2 +049000 MOVE IX-FS1-KEY TO COMPUTED-A. IX1034.2 +049100 MOVE SPACE TO P-OR-F. IX1034.2 +049200 MOVE "INFORMATION" TO CORRECT-A. IX1034.2 +049300 MOVE "KEY AFTER OPEN" TO RE-MARK. IX1034.2 +049400 MOVE "RECORD KEY ON OPEN" TO FEATURE. IX1034.2 +049500 PERFORM PRINT-DETAIL. IX1034.2 +049600 MOVE "INX-TEST-006" TO PAR-NAME. IX1034.2 +049700 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +049800 INX-TEST-006-R. IX1034.2 +049900 ADD 1 TO WRK-CS-09V00-006. IX1034.2 +050000 READ IX-FS1 IX1034.2 +050100 AT END GO TO READ-TEST-F1-01. IX1034.2 +050200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1034.2 +050300 IF UPDATE-NUMBER (1) EQUAL TO 00 IX1034.2 +050400 ADD 1 TO WRK-CS-09V00-007 IX1034.2 +050500 GO TO INX-TEST-006-2. IX1034.2 +050600 IF UPDATE-NUMBER (1) EQUAL TO 01 IX1034.2 +050700 ADD 1 TO WRK-CS-09V00-008 IX1034.2 +050800 GO TO INX-TEST-006-2. IX1034.2 +050900 ADD 1 TO WRK-CS-09V00-009. IX1034.2 +051000 INX-TEST-006-2. IX1034.2 +051100 MOVE XRECORD-KEY (1) TO IX-WRK-KEY. IX1034.2 +051200 IF WRK-DU-09V00-001 NOT EQUAL TO XRECORD-NUMBER (1) IX1034.2 +051300 ADD 1 TO WRK-CS-09V00-010. IX1034.2 +051400 IF WRK-CS-09V00-006 GREATER 501 IX1034.2 +051500 GO TO READ-TEST-F1-01. IX1034.2 +051600 GO TO INX-TEST-006-R. IX1034.2 +051700 READ-TEST-F1-01. IX1034.2 +051800 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX1034.2 +051900 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +052000* IX1034.2 +052100* TEST 1 IX1034.2 +052200* IX1034.2 +052300 IF WRK-CS-09V00-006 NOT EQUAL TO 501 IX1034.2 +052400 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX1034.2 +052500 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX1034.2 +052600 MOVE 500 TO CORRECT-18V0 IX1034.2 +052700 MOVE "IX-28 4.5.2 " TO RE-MARKIX1034.2 +052800 PERFORM FAIL IX1034.2 +052900 ELSE IX1034.2 +053000 PERFORM PASS. IX1034.2 +053100 PERFORM PRINT-DETAIL. IX1034.2 +053200 READ-TEST-F1-02. IX1034.2 +053300 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX1034.2 +053400 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +053500* IX1034.2 +053600* TEST 2 IX1034.2 +053700* IX1034.2 +053800 IF WRK-CS-09V00-007 EQUAL TO 400 IX1034.2 +053900 PERFORM PASS IX1034.2 +054000 ELSE IX1034.2 +054100 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A IX1034.2 +054200 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 IX1034.2 +054300 MOVE "SHOULD BE 400; IX-28 4.5.2" TO RE-MARK IX1034.2 +054400 PERFORM FAIL. IX1034.2 +054500 PERFORM PRINT-DETAIL. IX1034.2 +054600 READ-TEST-F1-03. IX1034.2 +054700 MOVE "READ-TEST-F1-03" TO PAR-NAME. IX1034.2 +054800 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +054900* IX1034.2 +055000* TEST 3 IX1034.2 +055100* IX1034.2 +055200 IF WRK-CS-09V00-008 EQUAL TO 100 IX1034.2 +055300 PERFORM PASS IX1034.2 +055400 ELSE IX1034.2 +055500 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 IX1034.2 +055600 MOVE 100 TO CORRECT-18V0 IX1034.2 +055700 MOVE "IX-28 4.5.2 " TO RE-MARKIX1034.2 +055800 PERFORM FAIL. IX1034.2 +055900 PERFORM PRINT-DETAIL. IX1034.2 +056000 READ-TEST-F1-04. IX1034.2 +056100 MOVE "READ-TEST-F1-04" TO PAR-NAME. IX1034.2 +056200 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +056300* IX1034.2 +056400* TEST 4 IX1034.2 +056500* IX1034.2 +056600 IF WRK-CS-09V00-009 EQUAL TO ZERO IX1034.2 +056700 PERFORM PASS IX1034.2 +056800 ELSE IX1034.2 +056900 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX1034.2 +057000 MOVE ZERO TO CORRECT-18V0 IX1034.2 +057100 MOVE "BAD-UPDATES" TO RE-MARK IX1034.2 +057200 PERFORM FAIL. IX1034.2 +057300 PERFORM PRINT-DETAIL. IX1034.2 +057400 READ-TEST-F1-05. IX1034.2 +057500 MOVE "READ-TEST-F1-05" TO PAR-NAME. IX1034.2 +057600 MOVE "READ SEQUENTIAL " TO FEATURE. IX1034.2 +057700* IX1034.2 +057800* TEST 5 IX1034.2 +057900* IX1034.2 +058000 IF WRK-CS-09V00-010 EQUAL TO ZERO IX1034.2 +058100 PERFORM PASS IX1034.2 +058200 ELSE IX1034.2 +058300 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 IX1034.2 +058400 MOVE ZERO TO CORRECT-18V0 IX1034.2 +058500 MOVE "KEY VS RECORD; IX-28" TO RE-MARK IX1034.2 +058600 PERFORM FAIL. IX1034.2 +058700 PERFORM PRINT-DETAIL. IX1034.2 +058800 CLOSE IX-FS1. IX1034.2 +058900 DELETE-INIT-GF-01. IX1034.2 +059000* IX1034.2 +059100* TEST 1 IX1034.2 +059200* IX1034.2 +059300 MOVE "DELETE-TEST-GF-01" TO PAR-NAME IX1034.2 +059400 OPEN I-O IX-FS1. IX1034.2 +059500 MOVE ZERO TO WRK-CS-09V00-006 IX1034.2 +059600 MOVE ZERO TO WRK-CS-09V00-007 IX1034.2 +059700 MOVE ZERO TO WRK-CS-09V00-008 IX1034.2 +059800 MOVE ZERO TO WRK-CS-09V00-009 IX1034.2 +059900 MOVE ZERO TO WRK-CS-09V00-010 IX1034.2 +060000 MOVE ZERO TO WRK-CS-09V00-011 IX1034.2 +060100 MOVE SPACE TO FILE-RECORD-INFO (1). IX1034.2 +060200 MOVE "DELETE " TO FEATURE. IX1034.2 +060300 DELETE-TEST-GF-01. IX1034.2 +060400 ADD 1 TO WRK-CS-09V00-006 IX1034.2 +060500 ADD 1 TO WRK-CS-09V00-007. IX1034.2 +060600 READ IX-FS1 IX1034.2 +060700 AT END IX1034.2 +060800 MOVE "AT END PATH TAKEN" TO RE-MARK IX1034.2 +060900 GO TO DELETE-TEST-GF-01-3. IX1034.2 +061000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1034.2 +061100 IF WRK-CS-09V00-007 EQUAL TO 4 IX1034.2 +061200 GO TO DELETE-TEST-GF-01-2. IX1034.2 +061300 IF WRK-CS-09V00-006 GREATER 501 IX1034.2 +061400 MOVE "AT END NOT TAKEN" TO RE-MARK IX1034.2 +061500 GO TO DELETE-TEST-GF-01-3. IX1034.2 +061600 GO TO DELETE-TEST-GF-01. IX1034.2 +061700 DELETE-TEST-GF-01-2. IX1034.2 +061800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1034.2 +061900 MOVE 99 TO UPDATE-NUMBER (1). IX1034.2 +062000 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX1034.2 +062100 DELETE IX-FS1. IX1034.2 +062200 MOVE ZERO TO WRK-CS-09V00-007. IX1034.2 +062300 ADD 1 TO WRK-CS-09V00-008 IX1034.2 +062400 GO TO DELETE-TEST-GF-01. IX1034.2 +062500 DELETE-TEST-GF-01-3. IX1034.2 +062600 IF WRK-CS-09V00-006 NOT EQUAL TO 501 IX1034.2 +062700 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX1034.2 +062800 MOVE 501 TO CORRECT-18V0 IX1034.2 +062900 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +063000 PERFORM FAIL IX1034.2 +063100 ELSE IX1034.2 +063200 PERFORM PASS. IX1034.2 +063300 PERFORM PRINT-DETAIL. IX1034.2 +063400 DELETE-TEST-GF-02. IX1034.2 +063500 MOVE "DELETE-TEST-GF-02" TO PAR-NAME IX1034.2 +063600 MOVE "DELETE " TO FEATURE. IX1034.2 +063700* IX1034.2 +063800* TEST 2 IX1034.2 +063900* IX1034.2 +064000 IF WRK-CS-09V00-008 NOT EQUAL TO 125 IX1034.2 +064100 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 IX1034.2 +064200 MOVE 125 TO CORRECT-18V0 IX1034.2 +064300 MOVE "DELETED RECORDS" TO RE-MARK IX1034.2 +064400 PERFORM FAIL IX1034.2 +064500 ELSE IX1034.2 +064600 PERFORM PASS. IX1034.2 +064700 PERFORM PRINT-DETAIL. IX1034.2 +064800 DELETE-TEST-GF-03. IX1034.2 +064900 MOVE "DELETE-TEST-GF-03" TO PAR-NAME IX1034.2 +065000 MOVE "DELETE " TO FEATURE. IX1034.2 +065100* IX1034.2 +065200* TEST 3 IX1034.2 +065300* IX1034.2 +065400 IF WRK-CS-09V00-009 EQUAL TO ZERO IX1034.2 +065500 PERFORM PASS IX1034.2 +065600 ELSE IX1034.2 +065700 PERFORM FAIL IX1034.2 +065800 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX1034.2 +065900 MOVE ZERO TO CORRECT-18V0 IX1034.2 +066000 MOVE "INVALID KEY" TO RE-MARK. IX1034.2 +066100 PERFORM PRINT-DETAIL. IX1034.2 +066200 CLOSE IX-FS1. IX1034.2 +066300 DELETE-INIT-GF-04. IX1034.2 +066400 MOVE "DELETE-TEST-GF-04" TO PAR-NAME IX1034.2 +066500 MOVE "DELETE " TO FEATURE. IX1034.2 +066600* IX1034.2 +066700* TEST 4 IX1034.2 +066800* IX1034.2 +066900 MOVE "DELETE-TEST-GF-04" TO PAR-NAME. IX1034.2 +067000 MOVE ZERO TO WRK-CS-09V00-006 IX1034.2 +067100 MOVE ZERO TO WRK-CS-09V00-007 IX1034.2 +067200 MOVE ZERO TO WRK-CS-09V00-008 IX1034.2 +067300 MOVE ZERO TO WRK-CS-09V00-009 IX1034.2 +067400 MOVE ZERO TO WRK-CS-09V00-010 IX1034.2 +067500 MOVE ZERO TO WRK-CS-09V00-011 IX1034.2 +067600 MOVE SPACE TO FILE-RECORD-INFO (1). IX1034.2 +067700 MOVE ZERO TO WRK-DU-09V00-001. IX1034.2 +067800 OPEN INPUT IX-FS1. IX1034.2 +067900 DELETE-TEST-GF-04. IX1034.2 +068000 ADD 1 TO WRK-CS-09V00-006. IX1034.2 +068100 ADD 1 TO WRK-CS-09V00-007. IX1034.2 +068200 ADD 1 TO WRK-CS-09V00-008. IX1034.2 +068300 READ IX-FS1 AT END GO TO DELETE-TEST-GF-04-3. IX1034.2 +068400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1034.2 +068500 IF UPDATE-NUMBER (1) EQUAL TO 99 IX1034.2 +068600 ADD 1 TO WRK-CS-09V00-009. IX1034.2 +068700 IF WRK-CS-09V00-007 EQUAL TO 4 IX1034.2 +068800 MOVE 01 TO WRK-CS-09V00-007 IX1034.2 +068900 ADD 1 TO WRK-CS-09V00-008. IX1034.2 +069000 MOVE XRECORD-KEY (1) TO IX-WRK-KEY. IX1034.2 +069100 MOVE WRK-CS-09V00-008 TO WRK-DU-09V00-001. IX1034.2 +069200 IF IX-WRK-KEY EQUAL TO IX-FS1-KEY IX1034.2 +069300 ADD 1 TO WRK-CS-09V00-010. IX1034.2 +069400 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 IX1034.2 +069500 ADD 1 TO WRK-CS-09V00-011. IX1034.2 +069600 IF WRK-CS-09V00-006 GREATER 501 IX1034.2 +069700 GO TO DELETE-TEST-GF-04-3. IX1034.2 +069800 GO TO DELETE-TEST-GF-04. IX1034.2 +069900 DELETE-TEST-GF-04-3. IX1034.2 +070000 IF WRK-CS-09V00-006 NOT EQUAL TO 376 IX1034.2 +070100 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX1034.2 +070200 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX1034.2 +070300 MOVE 376 TO CORRECT-18V0 IX1034.2 +070400 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +070500 PERFORM FAIL IX1034.2 +070600 ELSE IX1034.2 +070700 PERFORM PASS. IX1034.2 +070800 PERFORM PRINT-DETAIL. IX1034.2 +070900 DELETE-TEST-GF-05. IX1034.2 +071000 MOVE "DELETE-TEST-GF-05" TO PAR-NAME IX1034.2 +071100 MOVE "DELETE " TO FEATURE. IX1034.2 +071200* IX1034.2 +071300* TEST 5 IX1034.2 +071400* IX1034.2 +071500 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO IX1034.2 +071600 MOVE ZERO TO CORRECT-18V0 IX1034.2 +071700 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX1034.2 +071800 MOVE "DELETED RECORDS" TO RE-MARK IX1034.2 +071900 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +072000 PERFORM FAIL IX1034.2 +072100 ELSE IX1034.2 +072200 PERFORM PASS. IX1034.2 +072300 PERFORM PRINT-DETAIL. IX1034.2 +072400 DELETE-TEST-GF-06. IX1034.2 +072500 MOVE "DELETE-TEST-GF-06" TO PAR-NAME IX1034.2 +072600 MOVE "DELETE " TO FEATURE. IX1034.2 +072700* IX1034.2 +072800* TEST 6 IX1034.2 +072900* IX1034.2 +073000 IF WRK-CS-09V00-010 NOT EQUAL TO 375 IX1034.2 +073100 MOVE 375 TO CORRECT-18V0 IX1034.2 +073200 MOVE "KEY MISMATCH" TO RE-MARK IX1034.2 +073300 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 IX1034.2 +073400 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +073500 PERFORM FAIL IX1034.2 +073600 ELSE IX1034.2 +073700 PERFORM PASS. IX1034.2 +073800 PERFORM PRINT-DETAIL. IX1034.2 +073900 DELETE-TEST-GF-07. IX1034.2 +074000 MOVE "DELETE-TEST-GF-07" TO PAR-NAME IX1034.2 +074100 MOVE "DELETE " TO FEATURE. IX1034.2 +074200* IX1034.2 +074300* TEST 7 IX1034.2 +074400* IX1034.2 +074500 IF WRK-CS-09V00-011 NOT EQUAL TO 375 IX1034.2 +074600 MOVE 375 TO CORRECT-18V0 IX1034.2 +074700 MOVE "INCORRECT RECORD FOUND" TO RE-MARK IX1034.2 +074800 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 IX1034.2 +074900 MOVE "IX-21 4.3.2 " TO RE-MARKIX1034.2 +075000 PERFORM FAIL IX1034.2 +075100 ELSE IX1034.2 +075200 PERFORM PASS. IX1034.2 +075300 PERFORM PRINT-DETAIL. IX1034.2 +075400 CLOSE IX-FS1. IX1034.2 +075500 CCVS-EXIT SECTION. IX1034.2 +075600 CCVS-999999. IX1034.2 +075700 GO TO CLOSE-FILES. IX1034.2 diff --git a/tests/cobol85/IX/IX104A.CBL b/tests/cobol85/IX/IX104A.CBL new file mode 100755 index 00000000..727f90e9 --- /dev/null +++ b/tests/cobol85/IX/IX104A.CBL @@ -0,0 +1,729 @@ +000100 IDENTIFICATION DIVISION. IX1044.2 +000200 PROGRAM-ID. IX1044.2 +000300 IX104A. IX1044.2 +000400**************************************************************** IX1044.2 +000500* * IX1044.2 +000600* VALIDATION FOR:- * IX1044.2 +000700* * IX1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1044.2 +000900* * IX1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1044.2 +001100* * IX1044.2 +001200**************************************************************** IX1044.2 +001300* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND SEMANTIC IX1044.2 +001400* ACTIONS ASSOCIATED WITH THE FOLLOWING ELEMENTS: IX1044.2 +001500* IX1044.2 +001600* (1) FILE STATUS IX1044.2 +001700* (2) USE AFTER EXCEPTION USING FILE-NAME IX1044.2 +001800* (3) READ IX1044.2 +001900* (4) WRITE IX1044.2 +002000* (5) REWRITE IX1044.2 +002100* (6) RECORD KEY IX1044.2 +002200* (7) ACCESS IX1044.2 +002300* IX1044.2 +002400* THIS PROGRAM CREATES AN INDEXED FILE SEQUENTIALLY (ACCESS IX1044.2 +002500* MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RECORDS OF THE IX1044.2 +002600* FILE. THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR IX1044.2 +002700* ACCURACY FOR EACH OPEN, CLOSE, READ AND REWRITE STATEMENT IX1044.2 +002800* USED. THE READ, WRITE AND REWRITE STATEMENTS ARE USED IX1044.2 +002900* WITHOUT THE APPROPRIATE AT END OR INVALID KEY PHRASES. THE IX1044.2 +003000* OMISSION OF THESE PHRASES ARE PERMITTED IF AN APPLICABLE USE IX1044.2 +003100* PROCEDURE HAS BEEN SPECIFIED. IX1044.2 +003200* IX1044.2 +003300* IX1044.2 +003400* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1044.2 +003500* IX1044.2 +003600* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1044.2 +003700* CLAUSE FOR DATA FILE IX-FD2 IX1044.2 +003800* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1044.2 +003900* CLAUSE FOR INDEX FILE IX-FD2 IX1044.2 +004000* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1044.2 +004100* X-62 FOR RAW-DATA IX1044.2 +004200* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1044.2 +004300* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1044.2 +004400* IX1044.2 +004500* NOTE: X-CARDS 45 AND 62 ARE OPTIONAL IX1044.2 +004600* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1044.2 +004700* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1044.2 +004800* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1044.2 +004900* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1044.2 +005000* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1044.2 +005100* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1044.2 +005200* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1044.2 +005300* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1044.2 +005400* THEY ARE AS FOLLOWS IX1044.2 +005500* IX1044.2 +005600* J SELECTS X-CARD 45 IX1044.2 +005700* IX1044.2 +005800****************************************************** IX1044.2 +005900 ENVIRONMENT DIVISION. IX1044.2 +006000 CONFIGURATION SECTION. IX1044.2 +006100 SOURCE-COMPUTER. IX1044.2 +006200 Linux. IX1044.2 +006300 OBJECT-COMPUTER. IX1044.2 +006400 Linux. IX1044.2 +006500 INPUT-OUTPUT SECTION. IX1044.2 +006600 FILE-CONTROL. IX1044.2 +006700*P SELECT RAW-DATA ASSIGN TO IX1044.2 +006800*P "XXXXX062" IX1044.2 +006900*P ORGANIZATION IS INDEXED IX1044.2 +007000*P ACCESS MODE IS RANDOM IX1044.2 +007100*P RECORD KEY IS RAW-DATA-KEY. IX1044.2 +007200 SELECT PRINT-FILE ASSIGN TO IX1044.2 +007300 "report.log". IX1044.2 +007400 SELECT IX-FS2 ASSIGN IX1044.2 +007500 "XXXXX025" IX1044.2 +007600*J **** X-CARD UNDEFINED **** IX1044.2 +007700 ORGANIZATION IS INDEXED IX1044.2 +007800 ACCESS SEQUENTIAL IX1044.2 +007900 FILE STATUS IS IX-FS2-STATUS IX1044.2 +008000 RECORD IX-FS2-KEY. IX1044.2 +008100 DATA DIVISION. IX1044.2 +008200 FILE SECTION. IX1044.2 +008300*P IX1044.2 +008400*PD RAW-DATA. IX1044.2 +008500*P IX1044.2 +008600*P1 RAW-DATA-SATZ. IX1044.2 +008700*P 05 RAW-DATA-KEY PIC X(6). IX1044.2 +008800*P 05 C-DATE PIC 9(6). IX1044.2 +008900*P 05 C-TIME PIC 9(8). IX1044.2 +009000*P 05 C-NO-OF-TESTS PIC 99. IX1044.2 +009100*P 05 C-OK PIC 999. IX1044.2 +009200*P 05 C-ALL PIC 999. IX1044.2 +009300*P 05 C-FAIL PIC 999. IX1044.2 +009400*P 05 C-DELETED PIC 999. IX1044.2 +009500*P 05 C-INSPECT PIC 999. IX1044.2 +009600*P 05 C-NOTE PIC X(13). IX1044.2 +009700*P 05 C-INDENT PIC X. IX1044.2 +009800*P 05 C-ABORT PIC X(8). IX1044.2 +009900 FD PRINT-FILE. IX1044.2 +010000 01 PRINT-REC PICTURE X(120). IX1044.2 +010100 01 DUMMY-RECORD PICTURE X(120). IX1044.2 +010200 FD IX-FS2 IX1044.2 +010300*C LABEL RECORDS ARE STANDARD IX1044.2 +010400*C DATA RECORDS IX-FS2R1-F-G-240 IX1044.2 +010500 BLOCK CONTAINS 480 IX1044.2 +010600 RECORD CONTAINS 240 CHARACTERS. IX1044.2 +010700 01 IX-FS2R1-F-G-240. IX1044.2 +010800 05 IX-FS2-REC-120 PIC X(120). IX1044.2 +010900 05 IX-FS2-REC-120-240. IX1044.2 +011000 10 FILLER PICTURE X(8). IX1044.2 +011100 10 IX-FS2-KEY PIC X(29). IX1044.2 +011200 10 FILLER PIC X(83). IX1044.2 +011300 WORKING-STORAGE SECTION. IX1044.2 +011400 01 GRP-0101. IX1044.2 +011500 02 FILLER PIC X(10) VALUE "ABCD921XYZ". IX1044.2 +011600 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX1044.2 +011700 02 FILLER PIC X(10) VALUE "Z2F()$+-AB". IX1044.2 +011800 01 GRP-0001. IX1044.2 +011900 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012000 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012100 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012200 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012300 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012400 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012500 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. IX1044.2 +012600 05 IX-FS2-STATUS PIC XX VALUE SPACE. IX1044.2 +012700 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. IX1044.2 +012800 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. IX1044.2 +012900 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. IX1044.2 +013000 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. IX1044.2 +013100 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. IX1044.2 +013200 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. IX1044.2 +013300 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. IX1044.2 +013400 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. IX1044.2 +013500 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. IX1044.2 +013600 01 DUMMY-WRK-REC. IX1044.2 +013700 02 DUMMY-WRK1 PIC X(120). IX1044.2 +013800 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX1044.2 +013900 03 FILLER PIC X(5). IX1044.2 +014000 03 DUMMY-WRK-INDENT-5 PIC X(115). IX1044.2 +014100 01 FILE-RECORD-INFORMATION-REC. IX1044.2 +014200 03 FILE-RECORD-INFO-SKELETON. IX1044.2 +014300 05 FILLER PICTURE X(48) VALUE IX1044.2 +014400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1044.2 +014500 05 FILLER PICTURE X(46) VALUE IX1044.2 +014600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1044.2 +014700 05 FILLER PICTURE X(26) VALUE IX1044.2 +014800 ",LFIL=000000,ORG= ,LBLR= ". IX1044.2 +014900 05 FILLER PICTURE X(37) VALUE IX1044.2 +015000 ",RECKEY= ". IX1044.2 +015100 05 FILLER PICTURE X(38) VALUE IX1044.2 +015200 ",ALTKEY1= ". IX1044.2 +015300 05 FILLER PICTURE X(38) VALUE IX1044.2 +015400 ",ALTKEY2= ". IX1044.2 +015500 05 FILLER PICTURE X(7) VALUE SPACE.IX1044.2 +015600 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1044.2 +015700 05 FILE-RECORD-INFO-P1-120. IX1044.2 +015800 07 FILLER PIC X(5). IX1044.2 +015900 07 XFILE-NAME PIC X(6). IX1044.2 +016000 07 FILLER PIC X(8). IX1044.2 +016100 07 XRECORD-NAME PIC X(6). IX1044.2 +016200 07 FILLER PIC X(1). IX1044.2 +016300 07 REELUNIT-NUMBER PIC 9(1). IX1044.2 +016400 07 FILLER PIC X(7). IX1044.2 +016500 07 XRECORD-NUMBER PIC 9(6). IX1044.2 +016600 07 FILLER PIC X(6). IX1044.2 +016700 07 UPDATE-NUMBER PIC 9(2). IX1044.2 +016800 07 FILLER PIC X(5). IX1044.2 +016900 07 ODO-NUMBER PIC 9(4). IX1044.2 +017000 07 FILLER PIC X(5). IX1044.2 +017100 07 XPROGRAM-NAME PIC X(5). IX1044.2 +017200 07 FILLER PIC X(7). IX1044.2 +017300 07 XRECORD-LENGTH PIC 9(6). IX1044.2 +017400 07 FILLER PIC X(7). IX1044.2 +017500 07 CHARS-OR-RECORDS PIC X(2). IX1044.2 +017600 07 FILLER PIC X(1). IX1044.2 +017700 07 XBLOCK-SIZE PIC 9(4). IX1044.2 +017800 07 FILLER PIC X(6). IX1044.2 +017900 07 RECORDS-IN-FILE PIC 9(6). IX1044.2 +018000 07 FILLER PIC X(5). IX1044.2 +018100 07 XFILE-ORGANIZATION PIC X(2). IX1044.2 +018200 07 FILLER PIC X(6). IX1044.2 +018300 07 XLABEL-TYPE PIC X(1). IX1044.2 +018400 05 FILE-RECORD-INFO-P121-240. IX1044.2 +018500 07 FILLER PIC X(8). IX1044.2 +018600 07 XRECORD-KEY PIC X(29). IX1044.2 +018700 07 FILLER PIC X(9). IX1044.2 +018800 07 ALTERNATE-KEY1 PIC X(29). IX1044.2 +018900 07 FILLER PIC X(9). IX1044.2 +019000 07 ALTERNATE-KEY2 PIC X(29). IX1044.2 +019100 07 FILLER PIC X(7). IX1044.2 +019200 01 TEST-RESULTS. IX1044.2 +019300 02 FILLER PIC X VALUE SPACE. IX1044.2 +019400 02 FEATURE PIC X(20) VALUE SPACE. IX1044.2 +019500 02 FILLER PIC X VALUE SPACE. IX1044.2 +019600 02 P-OR-F PIC X(5) VALUE SPACE. IX1044.2 +019700 02 FILLER PIC X VALUE SPACE. IX1044.2 +019800 02 PAR-NAME. IX1044.2 +019900 03 FILLER PIC X(19) VALUE SPACE. IX1044.2 +020000 03 PARDOT-X PIC X VALUE SPACE. IX1044.2 +020100 03 DOTVALUE PIC 99 VALUE ZERO. IX1044.2 +020200 02 FILLER PIC X(8) VALUE SPACE. IX1044.2 +020300 02 RE-MARK PIC X(61). IX1044.2 +020400 01 TEST-COMPUTED. IX1044.2 +020500 02 FILLER PIC X(30) VALUE SPACE. IX1044.2 +020600 02 FILLER PIC X(17) VALUE IX1044.2 +020700 " COMPUTED=". IX1044.2 +020800 02 COMPUTED-X. IX1044.2 +020900 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1044.2 +021000 03 COMPUTED-N REDEFINES COMPUTED-A IX1044.2 +021100 PIC -9(9).9(9). IX1044.2 +021200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1044.2 +021300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1044.2 +021400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1044.2 +021500 03 CM-18V0 REDEFINES COMPUTED-A. IX1044.2 +021600 04 COMPUTED-18V0 PIC -9(18). IX1044.2 +021700 04 FILLER PIC X. IX1044.2 +021800 03 FILLER PIC X(50) VALUE SPACE. IX1044.2 +021900 01 TEST-CORRECT. IX1044.2 +022000 02 FILLER PIC X(30) VALUE SPACE. IX1044.2 +022100 02 FILLER PIC X(17) VALUE " CORRECT =". IX1044.2 +022200 02 CORRECT-X. IX1044.2 +022300 03 CORRECT-A PIC X(20) VALUE SPACE. IX1044.2 +022400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1044.2 +022500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1044.2 +022600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1044.2 +022700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1044.2 +022800 03 CR-18V0 REDEFINES CORRECT-A. IX1044.2 +022900 04 CORRECT-18V0 PIC -9(18). IX1044.2 +023000 04 FILLER PIC X. IX1044.2 +023100 03 FILLER PIC X(2) VALUE SPACE. IX1044.2 +023200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1044.2 +023300 01 CCVS-C-1. IX1044.2 +023400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1044.2 +023500- "SS PARAGRAPH-NAME IX1044.2 +023600- " REMARKS". IX1044.2 +023700 02 FILLER PIC X(20) VALUE SPACE. IX1044.2 +023800 01 CCVS-C-2. IX1044.2 +023900 02 FILLER PIC X VALUE SPACE. IX1044.2 +024000 02 FILLER PIC X(6) VALUE "TESTED". IX1044.2 +024100 02 FILLER PIC X(15) VALUE SPACE. IX1044.2 +024200 02 FILLER PIC X(4) VALUE "FAIL". IX1044.2 +024300 02 FILLER PIC X(94) VALUE SPACE. IX1044.2 +024400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1044.2 +024500 01 REC-CT PIC 99 VALUE ZERO. IX1044.2 +024600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1044.2 +024700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1044.2 +024800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1044.2 +024900 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1044.2 +025000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1044.2 +025100 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1044.2 +025200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1044.2 +025300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1044.2 +025400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1044.2 +025500 01 CCVS-H-1. IX1044.2 +025600 02 FILLER PIC X(39) VALUE SPACES. IX1044.2 +025700 02 FILLER PIC X(42) VALUE IX1044.2 +025800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1044.2 +025900 02 FILLER PIC X(39) VALUE SPACES. IX1044.2 +026000 01 CCVS-H-2A. IX1044.2 +026100 02 FILLER PIC X(40) VALUE SPACE. IX1044.2 +026200 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1044.2 +026300 02 FILLER PIC XXXX VALUE IX1044.2 +026400 "4.2 ". IX1044.2 +026500 02 FILLER PIC X(28) VALUE IX1044.2 +026600 " COPY - NOT FOR DISTRIBUTION". IX1044.2 +026700 02 FILLER PIC X(41) VALUE SPACE. IX1044.2 +026800 IX1044.2 +026900 01 CCVS-H-2B. IX1044.2 +027000 02 FILLER PIC X(15) VALUE IX1044.2 +027100 "TEST RESULT OF ". IX1044.2 +027200 02 TEST-ID PIC X(9). IX1044.2 +027300 02 FILLER PIC X(4) VALUE IX1044.2 +027400 " IN ". IX1044.2 +027500 02 FILLER PIC X(12) VALUE IX1044.2 +027600 " HIGH ". IX1044.2 +027700 02 FILLER PIC X(22) VALUE IX1044.2 +027800 " LEVEL VALIDATION FOR ". IX1044.2 +027900 02 FILLER PIC X(58) VALUE IX1044.2 +028000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1044.2 +028100 01 CCVS-H-3. IX1044.2 +028200 02 FILLER PIC X(34) VALUE IX1044.2 +028300 " FOR OFFICIAL USE ONLY ". IX1044.2 +028400 02 FILLER PIC X(58) VALUE IX1044.2 +028500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1044.2 +028600 02 FILLER PIC X(28) VALUE IX1044.2 +028700 " COPYRIGHT 1985 ". IX1044.2 +028800 01 CCVS-E-1. IX1044.2 +028900 02 FILLER PIC X(52) VALUE SPACE. IX1044.2 +029000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1044.2 +029100 02 ID-AGAIN PIC X(9). IX1044.2 +029200 02 FILLER PIC X(45) VALUE SPACES. IX1044.2 +029300 01 CCVS-E-2. IX1044.2 +029400 02 FILLER PIC X(31) VALUE SPACE. IX1044.2 +029500 02 FILLER PIC X(21) VALUE SPACE. IX1044.2 +029600 02 CCVS-E-2-2. IX1044.2 +029700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1044.2 +029800 03 FILLER PIC X VALUE SPACE. IX1044.2 +029900 03 ENDER-DESC PIC X(44) VALUE IX1044.2 +030000 "ERRORS ENCOUNTERED". IX1044.2 +030100 01 CCVS-E-3. IX1044.2 +030200 02 FILLER PIC X(22) VALUE IX1044.2 +030300 " FOR OFFICIAL USE ONLY". IX1044.2 +030400 02 FILLER PIC X(12) VALUE SPACE. IX1044.2 +030500 02 FILLER PIC X(58) VALUE IX1044.2 +030600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1044.2 +030700 02 FILLER PIC X(13) VALUE SPACE. IX1044.2 +030800 02 FILLER PIC X(15) VALUE IX1044.2 +030900 " COPYRIGHT 1985". IX1044.2 +031000 01 CCVS-E-4. IX1044.2 +031100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1044.2 +031200 02 FILLER PIC X(4) VALUE " OF ". IX1044.2 +031300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1044.2 +031400 02 FILLER PIC X(40) VALUE IX1044.2 +031500 " TESTS WERE EXECUTED SUCCESSFULLY". IX1044.2 +031600 01 XXINFO. IX1044.2 +031700 02 FILLER PIC X(19) VALUE IX1044.2 +031800 "*** INFORMATION ***". IX1044.2 +031900 02 INFO-TEXT. IX1044.2 +032000 04 FILLER PIC X(8) VALUE SPACE. IX1044.2 +032100 04 XXCOMPUTED PIC X(20). IX1044.2 +032200 04 FILLER PIC X(5) VALUE SPACE. IX1044.2 +032300 04 XXCORRECT PIC X(20). IX1044.2 +032400 02 INF-ANSI-REFERENCE PIC X(48). IX1044.2 +032500 01 HYPHEN-LINE. IX1044.2 +032600 02 FILLER PIC IS X VALUE IS SPACE. IX1044.2 +032700 02 FILLER PIC IS X(65) VALUE IS "************************IX1044.2 +032800- "*****************************************". IX1044.2 +032900 02 FILLER PIC IS X(54) VALUE IS "************************IX1044.2 +033000- "******************************". IX1044.2 +033100 01 CCVS-PGM-ID PIC X(9) VALUE IX1044.2 +033200 "IX104A". IX1044.2 +033300 PROCEDURE DIVISION. IX1044.2 +033400 DECLARATIVES. IX1044.2 +033500 IX-FS2-01 SECTION. IX1044.2 +033600 USE AFTER STANDARD ERROR PROCEDURE ON IX-FS2. IX1044.2 +033700 IX-FS2-01-01. IX1044.2 +033800 ADD 1 TO WRK-CS-09V00-013. IX1044.2 +033900 GO TO IX-FS2-01-03 IX1044.2 +034000 IX-FS2-01-05 IX1044.2 +034100 DEPENDING ON WRK-CS-09V00-012. IX1044.2 +034200 GO TO IX-FS2-01-EXIT. IX1044.2 +034300 IX-FS2-01-03. IX1044.2 +034400*ENTRY FROM SEGMENT INX-TEST-001. IX1044.2 +034500* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX1044.2 +034600 ADD 1 TO WRK-CS-09V00-014. IX1044.2 +034700 IX-FS2-01-05. IX1044.2 +034800 ADD 1 TO WRK-CS-09V00-017. IX1044.2 +034900 IF XRECORD-NUMBER (2) EQUAL TO 500 IX1044.2 +035000 MOVE IX-FS2-STATUS TO WRK-XN-0002-002 IX1044.2 +035100 MOVE "10" TO WRK-XN-0002-003. IX1044.2 +035200 IX-FS2-01-EXIT. IX1044.2 +035300 EXIT. IX1044.2 +035400 END DECLARATIVES. IX1044.2 +035500 CCVS1 SECTION. IX1044.2 +035600 OPEN-FILES. IX1044.2 +035700*P OPEN I-O RAW-DATA. IX1044.2 +035800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1044.2 +035900*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1044.2 +036000*P MOVE "ABORTED " TO C-ABORT. IX1044.2 +036100*P ADD 1 TO C-NO-OF-TESTS. IX1044.2 +036200*P ACCEPT C-DATE FROM DATE. IX1044.2 +036300*P ACCEPT C-TIME FROM TIME. IX1044.2 +036400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1044.2 +036500*PND-E-1. IX1044.2 +036600*P CLOSE RAW-DATA. IX1044.2 +036700 OPEN OUTPUT PRINT-FILE. IX1044.2 +036800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1044.2 +036900 MOVE SPACE TO TEST-RESULTS. IX1044.2 +037000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1044.2 +037100 MOVE ZERO TO REC-SKL-SUB. IX1044.2 +037200 PERFORM CCVS-INIT-FILE 9 TIMES. IX1044.2 +037300 CCVS-INIT-FILE. IX1044.2 +037400 ADD 1 TO REC-SKL-SUB. IX1044.2 +037500 MOVE FILE-RECORD-INFO-SKELETON IX1044.2 +037600 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1044.2 +037700 CCVS-INIT-EXIT. IX1044.2 +037800 GO TO CCVS1-EXIT. IX1044.2 +037900 CLOSE-FILES. IX1044.2 +038000*P OPEN I-O RAW-DATA. IX1044.2 +038100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1044.2 +038200*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1044.2 +038300*P MOVE "OK. " TO C-ABORT. IX1044.2 +038400*P MOVE PASS-COUNTER TO C-OK. IX1044.2 +038500*P MOVE ERROR-HOLD TO C-ALL. IX1044.2 +038600*P MOVE ERROR-COUNTER TO C-FAIL. IX1044.2 +038700*P MOVE DELETE-COUNTER TO C-DELETED. IX1044.2 +038800*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1044.2 +038900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1044.2 +039000*PND-E-2. IX1044.2 +039100*P CLOSE RAW-DATA. IX1044.2 +039200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1044.2 +039300 TERMINATE-CCVS. IX1044.2 +039400*S EXIT PROGRAM. IX1044.2 +039500*SERMINATE-CALL. IX1044.2 +039600 STOP RUN. IX1044.2 +039700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1044.2 +039800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1044.2 +039900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1044.2 +040000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1044.2 +040100 MOVE "****TEST DELETED****" TO RE-MARK. IX1044.2 +040200 PRINT-DETAIL. IX1044.2 +040300 IF REC-CT NOT EQUAL TO ZERO IX1044.2 +040400 MOVE "." TO PARDOT-X IX1044.2 +040500 MOVE REC-CT TO DOTVALUE. IX1044.2 +040600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1044.2 +040700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1044.2 +040800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1044.2 +040900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1044.2 +041000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1044.2 +041100 MOVE SPACE TO CORRECT-X. IX1044.2 +041200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1044.2 +041300 MOVE SPACE TO RE-MARK. IX1044.2 +041400 HEAD-ROUTINE. IX1044.2 +041500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +041600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +041700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1044.2 +041800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1044.2 +041900 COLUMN-NAMES-ROUTINE. IX1044.2 +042000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +042100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +042200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +042300 END-ROUTINE. IX1044.2 +042400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1044.2 +042500 END-RTN-EXIT. IX1044.2 +042600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +042700 END-ROUTINE-1. IX1044.2 +042800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1044.2 +042900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1044.2 +043000 ADD PASS-COUNTER TO ERROR-HOLD. IX1044.2 +043100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1044.2 +043200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1044.2 +043300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1044.2 +043400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1044.2 +043500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1044.2 +043600 END-ROUTINE-12. IX1044.2 +043700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1044.2 +043800 IF ERROR-COUNTER IS EQUAL TO ZERO IX1044.2 +043900 MOVE "NO " TO ERROR-TOTAL IX1044.2 +044000 ELSE IX1044.2 +044100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1044.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1044.2 +044300 PERFORM WRITE-LINE. IX1044.2 +044400 END-ROUTINE-13. IX1044.2 +044500 IF DELETE-COUNTER IS EQUAL TO ZERO IX1044.2 +044600 MOVE "NO " TO ERROR-TOTAL ELSE IX1044.2 +044700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1044.2 +044800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1044.2 +044900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +045000 IF INSPECT-COUNTER EQUAL TO ZERO IX1044.2 +045100 MOVE "NO " TO ERROR-TOTAL IX1044.2 +045200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1044.2 +045300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1044.2 +045400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +045500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1044.2 +045600 WRITE-LINE. IX1044.2 +045700 ADD 1 TO RECORD-COUNT. IX1044.2 +045800 IF RECORD-COUNT GREATER 42 IX1044.2 +045900 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1044.2 +046000 MOVE SPACE TO DUMMY-RECORD IX1044.2 +046100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1044.2 +046200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1044.2 +046300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1044.2 +046400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1044.2 +046500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1044.2 +046600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1044.2 +046700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1044.2 +046800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1044.2 +046900 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1044.2 +047000 MOVE ZERO TO RECORD-COUNT. IX1044.2 +047100 PERFORM WRT-LN. IX1044.2 +047200 WRT-LN. IX1044.2 +047300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1044.2 +047400 MOVE SPACE TO DUMMY-RECORD. IX1044.2 +047500 BLANK-LINE-PRINT. IX1044.2 +047600 PERFORM WRT-LN. IX1044.2 +047700 FAIL-ROUTINE. IX1044.2 +047800 IF COMPUTED-X NOT EQUAL TO SPACE IX1044.2 +047900 GO TO FAIL-ROUTINE-WRITE. IX1044.2 +048000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1044.2 +048100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1044.2 +048200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1044.2 +048300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +048400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1044.2 +048500 GO TO FAIL-ROUTINE-EX. IX1044.2 +048600 FAIL-ROUTINE-WRITE. IX1044.2 +048700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1044.2 +048800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1044.2 +048900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1044.2 +049000 MOVE SPACES TO COR-ANSI-REFERENCE. IX1044.2 +049100 FAIL-ROUTINE-EX. EXIT. IX1044.2 +049200 BAIL-OUT. IX1044.2 +049300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1044.2 +049400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1044.2 +049500 BAIL-OUT-WRITE. IX1044.2 +049600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1044.2 +049700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1044.2 +049800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1044.2 +049900 MOVE SPACES TO INF-ANSI-REFERENCE. IX1044.2 +050000 BAIL-OUT-EX. EXIT. IX1044.2 +050100 CCVS1-EXIT. IX1044.2 +050200 EXIT. IX1044.2 +050300 SECT-IX-04-001 SECTION. IX1044.2 +050400 WRITE-INIT-GF-01. IX1044.2 +050500 MOVE "CREATE IX-FS2" TO FEATURE IX1044.2 +050600 MOVE "IX-FS2" TO XFILE-NAME (2). IX1044.2 +050700 MOVE "R1-F-G" TO XRECORD-NAME (2). IX1044.2 +050800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX1044.2 +050900 MOVE 000240 TO XRECORD-LENGTH (2). IX1044.2 +051000 MOVE "RC" TO CHARS-OR-RECORDS (2). IX1044.2 +051100 MOVE 0001 TO XBLOCK-SIZE (2). IX1044.2 +051200 MOVE 000500 TO RECORDS-IN-FILE (2). IX1044.2 +051300 MOVE "IX" TO XFILE-ORGANIZATION (2). IX1044.2 +051400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1044.2 +051500 MOVE "S" TO XLABEL-TYPE (2). IX1044.2 +051600 MOVE 000001 TO XRECORD-NUMBER (2). IX1044.2 +051700*INITIALIZE RECORD WORK AREA NUMBER 2. IX1044.2 +051800 MOVE 1 TO WRK-CS-09V00-012. IX1044.2 +051900 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX1044.2 +052000 WRK-CS-09V00-015 WRK-CS-09V00-016 IX1044.2 +052100 WRK-CS-09V00-017 WRK-CS-09V00-018. IX1044.2 +052200 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +052300 MOVE ZERO TO WRK-DU-09V00-001. IX1044.2 +052400 OPEN OUTPUT IX-FS2. IX1044.2 +052500 MOVE GRP-0101 TO IX-FS2-KEY. IX1044.2 +052600 MOVE IX-FS2-STATUS TO WRK-XN-0002-001. IX1044.2 +052700*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. IX1044.2 +052800 WRITE-TEST-GF-01. IX1044.2 +052900 MOVE "99" TO IX-FS2-STATUS. IX1044.2 +053000 MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX1044.2 +053100 MOVE GRP-0101 TO XRECORD-KEY (2). IX1044.2 +053200 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX1044.2 +053300 WRITE IX-FS2R1-F-G-240. IX1044.2 +053400 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +053500 ADD 1 TO WRK-CS-09V00-016. IX1044.2 +053600 IF XRECORD-NUMBER (2) EQUAL TO 500 IX1044.2 +053700 GO TO WRITE-TEST-GF-01-2. IX1044.2 +053800 ADD 01 TO XRECORD-NUMBER (2). IX1044.2 +053900 GO TO WRITE-TEST-GF-01. IX1044.2 +054000 WRITE-TEST-GF-01-2. IX1044.2 +054100 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX1044.2 +054200 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK IX1044.2 +054300 MOVE ZERO TO CORRECT-18V0 IX1044.2 +054400 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX1044.2 +054500 MOVE "IX-41 4.9.2 " TO RE-MARKIX1044.2 +054600 PERFORM FAIL IX1044.2 +054700 ELSE IX1044.2 +054800 PERFORM PASS. IX1044.2 +054900 PERFORM PRINT-DETAIL. IX1044.2 +055000 WRITE-TEST-GF-02. IX1044.2 +055100 MOVE "CREATE IX-FS2" TO FEATURE IX1044.2 +055200 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1044.2 +055300 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 IX1044.2 +055400 MOVE "INCORRECT COUNT" TO RE-MARK IX1044.2 +055500 MOVE 500 TO CORRECT-18V0 IX1044.2 +055600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX1044.2 +055700 MOVE "IX-41 4.9.2 " TO RE-MARKIX1044.2 +055800 PERFORM FAIL IX1044.2 +055900 ELSE IX1044.2 +056000 PERFORM PASS. IX1044.2 +056100 PERFORM PRINT-DETAIL. IX1044.2 +056200 WRITE-TEST-GF-03. IX1044.2 +056300 MOVE "OPEN: 00 EXP. " TO FEATURE. IX1044.2 +056400 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX1044.2 +056500 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX1044.2 +056600 MOVE WRK-XN-0002-001 TO COMPUTED-A IX1044.2 +056700 MOVE "00" TO CORRECT-A IX1044.2 +056800 MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2 +056900 PERFORM FAIL IX1044.2 +057000 ELSE IX1044.2 +057100 PERFORM PASS. IX1044.2 +057200 PERFORM PRINT-DETAIL. IX1044.2 +057300 WRITE-TEST-GF-04. IX1044.2 +057400 MOVE "WRITE: 00 EXP." TO FEATURE. IX1044.2 +057500 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. IX1044.2 +057600 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +057700 MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2 +057800 MOVE "00" TO CORRECT-A IX1044.2 +057900 MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2 +058000 PERFORM FAIL IX1044.2 +058100 ELSE IX1044.2 +058200 PERFORM PASS. IX1044.2 +058300 PERFORM PRINT-DETAIL. IX1044.2 +058400 WRITE-TEST-GF-05. IX1044.2 +058500 MOVE "WRITE: 00 EXP. " TO FEATURE. IX1044.2 +058600 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. IX1044.2 +058700 IF WRK-CS-09V00-016 NOT EQUAL TO ZERO IX1044.2 +058800 MOVE ZERO TO CORRECT-18V0 IX1044.2 +058900 MOVE WRK-CS-09V00-016 TO COMPUTED-18V0 IX1044.2 +059000 MOVE "IX-41 4.9.2; IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2 +059100 PERFORM FAIL IX1044.2 +059200 ELSE IX1044.2 +059300 PERFORM PASS. IX1044.2 +059400 PERFORM PRINT-DETAIL. IX1044.2 +059500 WRITE-TEST-GF-06. IX1044.2 +059600 MOVE "CLOSE: 00 EXP. " TO FEATURE. IX1044.2 +059700 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. IX1044.2 +059800 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +059900 CLOSE IX-FS2. IX1044.2 +060000 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +060100 MOVE "CLOSE/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX1044.2 +060200 MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2 +060300 MOVE "00" TO CORRECT-A IX1044.2 +060400 PERFORM FAIL IX1044.2 +060500 ELSE IX1044.2 +060600 PERFORM PASS. IX1044.2 +060700 PERFORM PRINT-DETAIL. IX1044.2 +060800 READ-INIT-F1-01. IX1044.2 +060900 MOVE 2 TO WRK-CS-09V00-012. IX1044.2 +061000 MOVE ZERO TO WRK-CS-09V00-013. IX1044.2 +061100 MOVE ZERO TO WRK-CS-09V00-014. IX1044.2 +061200 MOVE ZERO TO WRK-CS-09V00-015. IX1044.2 +061300 MOVE ZERO TO WRK-CS-09V00-016. IX1044.2 +061400 MOVE ZERO TO WRK-CS-09V00-017. IX1044.2 +061500 MOVE ZERO TO WRK-CS-09V00-018. IX1044.2 +061600 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +061700 OPEN I-O IX-FS2. IX1044.2 +061800 MOVE SPACE TO WRK-XN-0002-002 IX1044.2 +061900 MOVE SPACE TO WRK-XN-0002-003 IX1044.2 +062000 MOVE SPACE TO WRK-XN-0002-004 IX1044.2 +062100 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1044.2 +062200 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +062300*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. IX1044.2 +062400 READ-TEST-F1-01. IX1044.2 +062500 ADD 1 TO WRK-CS-09V00-014. IX1044.2 +062600 ADD 1 TO WRK-CS-09V00-015. IX1044.2 +062700 READ IX-FS2. IX1044.2 +062800 IF IX-FS2-STATUS EQUAL TO "10" IX1044.2 +062900 GO TO READ-TEST-F1-01-3. IX1044.2 +063000 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX1044.2 +063100 IF WRK-CS-09V00-015 EQUAL TO 5 IX1044.2 +063200 ADD 01 TO UPDATE-NUMBER (2) IX1044.2 +063300 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240 IX1044.2 +063400 PERFORM READ-010-UPDATE IX1044.2 +063500 MOVE ZERO TO WRK-CS-09V00-015 IX1044.2 +063600 GO TO READ-TEST-F1-01-2. IX1044.2 +063700 IF WRK-CS-09V00-014 GREATER 500 IX1044.2 +063800 GO TO READ-TEST-F1-01-3. IX1044.2 +063900 GO TO READ-TEST-F1-01. IX1044.2 +064000 READ-010-UPDATE. IX1044.2 +064100 REWRITE IX-FS2R1-F-G-240. IX1044.2 +064200 READ-TEST-F1-01-2. IX1044.2 +064300 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +064400 ADD 1 TO WRK-CS-09V00-016. IX1044.2 +064500 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +064600 GO TO READ-TEST-F1-01. IX1044.2 +064700 READ-TEST-F1-01-3. IX1044.2 +064800 MOVE "READ: 10 EXP. " TO FEATURE. IX1044.2 +064900 MOVE "READ-TEST-F1-01-3" TO PAR-NAME. IX1044.2 +065000 IF WRK-CS-09V00-013 NOT EQUAL TO 1 IX1044.2 +065100 MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2 +065200 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 IX1044.2 +065300 MOVE 1 TO CORRECT-18V0 IX1044.2 +065400 PERFORM FAIL IX1044.2 +065500 ELSE IX1044.2 +065600 PERFORM PASS. IX1044.2 +065700 PERFORM PRINT-DETAIL. IX1044.2 +065800 READ-TEST-F1-02. IX1044.2 +065900 MOVE "READ " TO FEATURE. IX1044.2 +066000 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX1044.2 +066100 IF WRK-CS-09V00-014 NOT EQUAL TO 501 IX1044.2 +066200 MOVE "INCORRECT COUNT IX-28 4.5.2" TO RE-MARK IX1044.2 +066300 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX1044.2 +066400 MOVE 501 TO CORRECT-18V0 IX1044.2 +066500 PERFORM FAIL IX1044.2 +066600 ELSE IX1044.2 +066700 PERFORM PASS. IX1044.2 +066800 PERFORM PRINT-DETAIL. IX1044.2 +066900 READ-TEST-F1-03. IX1044.2 +067000 MOVE "OPEN: 00 EXP. " TO FEATURE. IX1044.2 +067100 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX1044.2 +067200 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX1044.2 +067300 MOVE "IX-3 1.3.4 (1) A " TO RE-MARKIX1044.2 +067400 MOVE WRK-XN-0002-001 TO COMPUTED-A IX1044.2 +067500 MOVE "00" TO CORRECT-A IX1044.2 +067600 PERFORM FAIL IX1044.2 +067700 ELSE IX1044.2 +067800 PERFORM PASS. IX1044.2 +067900 PERFORM PRINT-DETAIL. IX1044.2 +068000 READ-TEST-F1-04. IX1044.2 +068100 MOVE "READ AT END: 10 EXP." TO FEATURE. IX1044.2 +068200 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX1044.2 +068300 IF IX-FS2-STATUS NOT EQUAL TO "10" IX1044.2 +068400 MOVE "ATEND/STATUS" TO RE-MARK IX1044.2 +068500 MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2 +068600 MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2 +068700 MOVE "10" TO CORRECT-A IX1044.2 +068800 PERFORM FAIL IX1044.2 +068900 ELSE IX1044.2 +069000 PERFORM PASS. IX1044.2 +069100 PERFORM PRINT-DETAIL. IX1044.2 +069200 READ-TEST-F1-05. IX1044.2 +069300 MOVE "READ: 10 EXP. " TO FEATURE. IX1044.2 +069400 MOVE "READ-TEST-F1-05 " TO PAR-NAME. IX1044.2 +069500 IF WRK-XN-0002-002 NOT EQUAL TO "10" IX1044.2 +069600 MOVE "IX-4 1.3.4 (2) A " TO RE-MARKIX1044.2 +069700 MOVE WRK-XN-0002-002 TO COMPUTED-A IX1044.2 +069800 MOVE "10" TO CORRECT-A IX1044.2 +069900 PERFORM FAIL IX1044.2 +070000 ELSE IX1044.2 +070100 PERFORM PASS. IX1044.2 +070200 PERFORM PRINT-DETAIL. IX1044.2 +070300 READ-TEST-F1-06. IX1044.2 +070400 MOVE "READ NO EXCEPTION 10" TO FEATURE. IX1044.2 +070500 MOVE "READ-TEST-F1-06 " TO PAR-NAME. IX1044.2 +070600 IF WRK-XN-0002-003 NOT EQUAL TO "10" IX1044.2 +070700 MOVE "NO/EXCEPTION IX-4 1.3.4 (2) A" TO RE-MARK IX1044.2 +070800 MOVE WRK-XN-0002-003 TO COMPUTED-A IX1044.2 +070900 MOVE "10" TO CORRECT-A IX1044.2 +071000 PERFORM FAIL IX1044.2 +071100 ELSE IX1044.2 +071200 PERFORM PASS. IX1044.2 +071300 PERFORM PRINT-DETAIL. IX1044.2 +071400 READ-TEST-F1-07. IX1044.2 +071500 MOVE "CLOSE: 00 EXP. " TO FEATURE. IX1044.2 +071600 MOVE "READ-TEST-F1-07 " TO PAR-NAME. IX1044.2 +071700 MOVE SPACE TO IX-FS2-STATUS. IX1044.2 +071800 CLOSE IX-FS2 IX1044.2 +071900 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1044.2 +072000 MOVE "CLOSE/STATUS IX-3 1.3.4 (1) A" TO RE-MARK IX1044.2 +072100 MOVE IX-FS2-STATUS TO COMPUTED-A IX1044.2 +072200 MOVE "00" TO CORRECT-A IX1044.2 +072300 PERFORM FAIL IX1044.2 +072400 ELSE IX1044.2 +072500 PERFORM PASS. IX1044.2 +072600 PERFORM PRINT-DETAIL. IX1044.2 +072700 CCVS-EXIT SECTION. IX1044.2 +072800 CCVS-999999. IX1044.2 +072900 GO TO CLOSE-FILES. IX1044.2 diff --git a/tests/cobol85/IX/IX105A.CBL b/tests/cobol85/IX/IX105A.CBL new file mode 100755 index 00000000..36e0e2c2 --- /dev/null +++ b/tests/cobol85/IX/IX105A.CBL @@ -0,0 +1,875 @@ +000100 IDENTIFICATION DIVISION. IX1054.2 +000200 PROGRAM-ID. IX1054.2 +000300 IX105A. IX1054.2 +000400**************************************************************** IX1054.2 +000500* * IX1054.2 +000600* VALIDATION FOR:- * IX1054.2 +000700* * IX1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1054.2 +000900* * IX1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1054.2 +001100* * IX1054.2 +001200**************************************************************** IX1054.2 +001300*GENERAL: THIS PROGRAM PROCESSES THREE INDEXED I-O FILES IX1054.2 +001400* IDENTIFIED AS IX-FR1,IX-FR2 AND IX-FR3. THE FUNCTIONIX1054.2 +001500* OF THIS PROGRAM IS TO CREATE THREE INDEXED FILES IX1054.2 +001600* RANDOMLLY (ACCESS MODE RANDOM) AND VERIFY THAT THEY IX1054.2 +001700* WERE CREATED CORRECTLY. THE FILES PROCESSED IX1054.2 +001800* CONTAIN VARIABLE LENGTH RECORDS. IX1054.2 +001900* IX1054.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS IX1054.2 +002100* PROGRAM ARE: IX1054.2 +002200* IX1054.2 +002300* X-24 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1054.2 +002400* INDEXED I-O DATA FILE-1 IX1054.2 +002500* X-25 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1054.2 +002600* INDEXED I-O DATA FILE-2 IX1054.2 +002700* X-26 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1054.2 +002800* INDEXED I-O DATA FILE-3 IX1054.2 +002900* X-55 SYSTEM PRINTER IX1054.2 +003000* X-62 FOR RAW-DATA IX1054.2 +003100* X-82 SOURCE-COMPUTER IX1054.2 +003200* X-83 OBJECT-COMPUTER. IX1054.2 +003300* IX1054.2 +003400* THIS PROGRAM SHOULD BE RUN ONLY WHEN AN IMPLEMENTATION * IX1054.2 +003500* PROVIDES VARIABLE-LENGTH RECORDS FOR THE RECORD CONTAINS * IX1054.2 +003600* INTEGER TO INTEGER CLAUSE. * IX1054.2 +003700* * IX1054.2 +003800*************************************************** IX1054.2 +003900 ENVIRONMENT DIVISION. IX1054.2 +004000 CONFIGURATION SECTION. IX1054.2 +004100 SOURCE-COMPUTER. IX1054.2 +004200 Linux. IX1054.2 +004300 OBJECT-COMPUTER. IX1054.2 +004400 Linux. IX1054.2 +004500 INPUT-OUTPUT SECTION. IX1054.2 +004600 FILE-CONTROL. IX1054.2 +004700 SELECT PRINT-FILE ASSIGN TO IX1054.2 +004800 "report.log". IX1054.2 +004900 SELECT IX-FR1 ASSIGN TO IX1054.2 +005000 "XXXXX024" IX1054.2 +005100 ORGANIZATION IS INDEXED IX1054.2 +005200 ACCESS MODE IS RANDOM IX1054.2 +005300 RECORD KEY IS IX-FR1-KEY. IX1054.2 +005400 SELECT IX-FR2 ASSIGN TO IX1054.2 +005500 "XXXXX025" IX1054.2 +005600 ORGANIZATION IS INDEXED IX1054.2 +005700 ACCESS MODE IS RANDOM IX1054.2 +005800 RECORD KEY IS IX-FR2-KEY. IX1054.2 +005900 SELECT IX-FR3 ASSIGN TO IX1054.2 +006000 "XXXXX026" IX1054.2 +006100 ORGANIZATION IS INDEXED IX1054.2 +006200 ACCESS MODE IS RANDOM IX1054.2 +006300 RECORD KEY IS IX-FR3-KEY. IX1054.2 +006400 I-O-CONTROL. IX1054.2 +006500 SAME IX-FR2 IX-FR3. IX1054.2 +006600 DATA DIVISION. IX1054.2 +006700 FILE SECTION. IX1054.2 +006800 FD PRINT-FILE. IX1054.2 +006900 01 PRINT-REC PICTURE X(120). IX1054.2 +007000 01 DUMMY-RECORD PICTURE X(120). IX1054.2 +007100 FD IX-FR1 IX1054.2 +007200*C LABEL RECORDS ARE STANDARD IX1054.2 +007300*C DATA RECORDS ARE GRP-1SEQ-RECORD-1A GRP-1SEQ-RECORD-1B IX1054.2 +007400 RECORD CONTAINS 56 TO 100 CHARACTERS. IX1054.2 +007500 01 GRP-1SEQ-RECORD-1A. IX1054.2 +007600 02 IX-FR1-KEY PICTURE X(8). IX1054.2 +007700 02 FILLER-1A PICTURE X(48). IX1054.2 +007800 01 GRP-1SEQ-RECORD-1B. IX1054.2 +007900 02 FILLER-1B PICTURE X(56). IX1054.2 +008000 02 LONG-REC-1B. IX1054.2 +008100 03 FILLER PICTURE X(15). IX1054.2 +008200 03 REC-NUMBER-1B PICTURE XXX. IX1054.2 +008300 03 FILLER PICTURE X(26). IX1054.2 +008400 FD IX-FR2 IX1054.2 +008500*C DATA RECORDS GRP-1SEQ-RECORD-2A GRP-1SEQ-RECORD-2B IX1054.2 +008600*C LABEL RECORDS ARE STANDARD IX1054.2 +008700 RECORD CONTAINS 56 TO 101 CHARACTERS. IX1054.2 +008800 01 GRP-1SEQ-RECORD-2A. IX1054.2 +008900 02 IX-FR2-KEY PICTURE X(8). IX1054.2 +009000 02 FILLER-2A PICTURE X(48). IX1054.2 +009100 01 GRP-1SEQ-RECORD-2B. IX1054.2 +009200 02 FILLER-2B PICTURE X(56). IX1054.2 +009300 02 LONG-REC-2B. IX1054.2 +009400 03 FILLER PICTURE X(15). IX1054.2 +009500 03 REC-NUMBER-2B PICTURE XXX. IX1054.2 +009600 03 FILLER PICTURE X(27). IX1054.2 +009700 FD IX-FR3 IX1054.2 +009800*C LABEL RECORD STANDARD IX1054.2 +009900*C DATA RECORD GRP-1SEQ-RECORD-3A GRP-1SEQ-RECORD-3B IX1054.2 +010000 BLOCK 3 RECORDS IX1054.2 +010100 RECORD CONTAINS 56 TO 102 CHARACTERS. IX1054.2 +010200 01 GRP-1SEQ-RECORD-3A. IX1054.2 +010300 02 IX-FR3-KEY PICTURE X(8). IX1054.2 +010400 02 FILLER-3A PICTURE X(48). IX1054.2 +010500 01 GRP-1SEQ-RECORD-3B. IX1054.2 +010600 02 FILLER-3B PICTURE X(56). IX1054.2 +010700 02 LONG-REC-3B. IX1054.2 +010800 03 FILLER PICTURE X(15). IX1054.2 +010900 03 REC-NUMBER-3B PICTURE XXX. IX1054.2 +011000 02 FILLER PICTURE X(28). IX1054.2 +011100 WORKING-STORAGE SECTION. IX1054.2 +011200 01 SHORT-SW PICTURE 9 VALUE ZERO. IX1054.2 +011300 01 RECORD-BUILD. IX1054.2 +011400 02 KEY-BUILD. IX1054.2 +011500 03 KEY-NAME PICTURE X(3) VALUE "KEY". IX1054.2 +011600 03 KEY-VALUE PICTURE 9(5) VALUE ZERO. IX1054.2 +011700 02 FILLER PICTURE X(6) VALUE " FILE ". IX1054.2 +011800 02 FILE-NO PICTURE 99 VALUE ZERO. IX1054.2 +011900 02 FILLER PICTURE X(14) VALUE IX1054.2 +012000 " RECORD TYPE ". IX1054.2 +012100 02 RECORD-LONG-OR-SHORT PICTURE X(5) VALUE "SHORT". IX1054.2 +012200 02 FILLER PICTURE X(21) VALUE SPACE. IX1054.2 +012300 02 RECORD-LONG-ONLY. IX1054.2 +012400 03 FILLER PICTURE X(15) VALUE IX1054.2 +012500 " RECORD NUMBER ". IX1054.2 +012600 03 THREE-POS-NUM PICTURE 999 VALUE ZERO. IX1054.2 +012700 03 FILLER-LONG PICTURE X(28) VALUE IX1054.2 +012800 " AREA USED FOR LONG RECORD ". IX1054.2 +012900 01 FILE-RECORD-INFORMATION-REC. IX1054.2 +013000 03 FILE-RECORD-INFO-SKELETON. IX1054.2 +013100 05 FILLER PICTURE X(48) VALUE IX1054.2 +013200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1054.2 +013300 05 FILLER PICTURE X(46) VALUE IX1054.2 +013400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1054.2 +013500 05 FILLER PICTURE X(26) VALUE IX1054.2 +013600 ",LFIL=000000,ORG= ,LBLR= ". IX1054.2 +013700 05 FILLER PICTURE X(37) VALUE IX1054.2 +013800 ",RECKEY= ". IX1054.2 +013900 05 FILLER PICTURE X(38) VALUE IX1054.2 +014000 ",ALTKEY1= ". IX1054.2 +014100 05 FILLER PICTURE X(38) VALUE IX1054.2 +014200 ",ALTKEY2= ". IX1054.2 +014300 05 FILLER PICTURE X(7) VALUE SPACE.IX1054.2 +014400 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1054.2 +014500 05 FILE-RECORD-INFO-P1-120. IX1054.2 +014600 07 FILLER PIC X(5). IX1054.2 +014700 07 XFILE-NAME PIC X(6). IX1054.2 +014800 07 FILLER PIC X(8). IX1054.2 +014900 07 XRECORD-NAME PIC X(6). IX1054.2 +015000 07 FILLER PIC X(1). IX1054.2 +015100 07 REELUNIT-NUMBER PIC 9(1). IX1054.2 +015200 07 FILLER PIC X(7). IX1054.2 +015300 07 XRECORD-NUMBER PIC 9(6). IX1054.2 +015400 07 FILLER PIC X(6). IX1054.2 +015500 07 UPDATE-NUMBER PIC 9(2). IX1054.2 +015600 07 FILLER PIC X(5). IX1054.2 +015700 07 ODO-NUMBER PIC 9(4). IX1054.2 +015800 07 FILLER PIC X(5). IX1054.2 +015900 07 XPROGRAM-NAME PIC X(5). IX1054.2 +016000 07 FILLER PIC X(7). IX1054.2 +016100 07 XRECORD-LENGTH PIC 9(6). IX1054.2 +016200 07 FILLER PIC X(7). IX1054.2 +016300 07 CHARS-OR-RECORDS PIC X(2). IX1054.2 +016400 07 FILLER PIC X(1). IX1054.2 +016500 07 XBLOCK-SIZE PIC 9(4). IX1054.2 +016600 07 FILLER PIC X(6). IX1054.2 +016700 07 RECORDS-IN-FILE PIC 9(6). IX1054.2 +016800 07 FILLER PIC X(5). IX1054.2 +016900 07 XFILE-ORGANIZATION PIC X(2). IX1054.2 +017000 07 FILLER PIC X(6). IX1054.2 +017100 07 XLABEL-TYPE PIC X(1). IX1054.2 +017200 05 FILE-RECORD-INFO-P121-240. IX1054.2 +017300 07 FILLER PIC X(8). IX1054.2 +017400 07 XRECORD-KEY PIC X(29). IX1054.2 +017500 07 FILLER PIC X(9). IX1054.2 +017600 07 ALTERNATE-KEY1 PIC X(29). IX1054.2 +017700 07 FILLER PIC X(9). IX1054.2 +017800 07 ALTERNATE-KEY2 PIC X(29). IX1054.2 +017900 07 FILLER PIC X(7). IX1054.2 +018000 01 TEST-RESULTS. IX1054.2 +018100 02 FILLER PIC X VALUE SPACE. IX1054.2 +018200 02 FEATURE PIC X(20) VALUE SPACE. IX1054.2 +018300 02 FILLER PIC X VALUE SPACE. IX1054.2 +018400 02 P-OR-F PIC X(5) VALUE SPACE. IX1054.2 +018500 02 FILLER PIC X VALUE SPACE. IX1054.2 +018600 02 PAR-NAME. IX1054.2 +018700 03 FILLER PIC X(19) VALUE SPACE. IX1054.2 +018800 03 PARDOT-X PIC X VALUE SPACE. IX1054.2 +018900 03 DOTVALUE PIC 99 VALUE ZERO. IX1054.2 +019000 02 FILLER PIC X(8) VALUE SPACE. IX1054.2 +019100 02 RE-MARK PIC X(61). IX1054.2 +019200 01 TEST-COMPUTED. IX1054.2 +019300 02 FILLER PIC X(30) VALUE SPACE. IX1054.2 +019400 02 FILLER PIC X(17) VALUE IX1054.2 +019500 " COMPUTED=". IX1054.2 +019600 02 COMPUTED-X. IX1054.2 +019700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1054.2 +019800 03 COMPUTED-N REDEFINES COMPUTED-A IX1054.2 +019900 PIC -9(9).9(9). IX1054.2 +020000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1054.2 +020100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1054.2 +020200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1054.2 +020300 03 CM-18V0 REDEFINES COMPUTED-A. IX1054.2 +020400 04 COMPUTED-18V0 PIC -9(18). IX1054.2 +020500 04 FILLER PIC X. IX1054.2 +020600 03 FILLER PIC X(50) VALUE SPACE. IX1054.2 +020700 01 TEST-CORRECT. IX1054.2 +020800 02 FILLER PIC X(30) VALUE SPACE. IX1054.2 +020900 02 FILLER PIC X(17) VALUE " CORRECT =". IX1054.2 +021000 02 CORRECT-X. IX1054.2 +021100 03 CORRECT-A PIC X(20) VALUE SPACE. IX1054.2 +021200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1054.2 +021300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1054.2 +021400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1054.2 +021500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1054.2 +021600 03 CR-18V0 REDEFINES CORRECT-A. IX1054.2 +021700 04 CORRECT-18V0 PIC -9(18). IX1054.2 +021800 04 FILLER PIC X. IX1054.2 +021900 03 FILLER PIC X(2) VALUE SPACE. IX1054.2 +022000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1054.2 +022100 01 CCVS-C-1. IX1054.2 +022200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1054.2 +022300- "SS PARAGRAPH-NAME IX1054.2 +022400- " REMARKS". IX1054.2 +022500 02 FILLER PIC X(20) VALUE SPACE. IX1054.2 +022600 01 CCVS-C-2. IX1054.2 +022700 02 FILLER PIC X VALUE SPACE. IX1054.2 +022800 02 FILLER PIC X(6) VALUE "TESTED". IX1054.2 +022900 02 FILLER PIC X(15) VALUE SPACE. IX1054.2 +023000 02 FILLER PIC X(4) VALUE "FAIL". IX1054.2 +023100 02 FILLER PIC X(94) VALUE SPACE. IX1054.2 +023200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1054.2 +023300 01 REC-CT PIC 99 VALUE ZERO. IX1054.2 +023400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1054.2 +023500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1054.2 +023600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1054.2 +023700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1054.2 +023800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1054.2 +023900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1054.2 +024000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1054.2 +024100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1054.2 +024200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1054.2 +024300 01 CCVS-H-1. IX1054.2 +024400 02 FILLER PIC X(39) VALUE SPACES. IX1054.2 +024500 02 FILLER PIC X(42) VALUE IX1054.2 +024600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1054.2 +024700 02 FILLER PIC X(39) VALUE SPACES. IX1054.2 +024800 01 CCVS-H-2A. IX1054.2 +024900 02 FILLER PIC X(40) VALUE SPACE. IX1054.2 +025000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1054.2 +025100 02 FILLER PIC XXXX VALUE IX1054.2 +025200 "4.2 ". IX1054.2 +025300 02 FILLER PIC X(28) VALUE IX1054.2 +025400 " COPY - NOT FOR DISTRIBUTION". IX1054.2 +025500 02 FILLER PIC X(41) VALUE SPACE. IX1054.2 +025600 IX1054.2 +025700 01 CCVS-H-2B. IX1054.2 +025800 02 FILLER PIC X(15) VALUE IX1054.2 +025900 "TEST RESULT OF ". IX1054.2 +026000 02 TEST-ID PIC X(9). IX1054.2 +026100 02 FILLER PIC X(4) VALUE IX1054.2 +026200 " IN ". IX1054.2 +026300 02 FILLER PIC X(12) VALUE IX1054.2 +026400 " HIGH ". IX1054.2 +026500 02 FILLER PIC X(22) VALUE IX1054.2 +026600 " LEVEL VALIDATION FOR ". IX1054.2 +026700 02 FILLER PIC X(58) VALUE IX1054.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1054.2 +026900 01 CCVS-H-3. IX1054.2 +027000 02 FILLER PIC X(34) VALUE IX1054.2 +027100 " FOR OFFICIAL USE ONLY ". IX1054.2 +027200 02 FILLER PIC X(58) VALUE IX1054.2 +027300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1054.2 +027400 02 FILLER PIC X(28) VALUE IX1054.2 +027500 " COPYRIGHT 1985 ". IX1054.2 +027600 01 CCVS-E-1. IX1054.2 +027700 02 FILLER PIC X(52) VALUE SPACE. IX1054.2 +027800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1054.2 +027900 02 ID-AGAIN PIC X(9). IX1054.2 +028000 02 FILLER PIC X(45) VALUE SPACES. IX1054.2 +028100 01 CCVS-E-2. IX1054.2 +028200 02 FILLER PIC X(31) VALUE SPACE. IX1054.2 +028300 02 FILLER PIC X(21) VALUE SPACE. IX1054.2 +028400 02 CCVS-E-2-2. IX1054.2 +028500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1054.2 +028600 03 FILLER PIC X VALUE SPACE. IX1054.2 +028700 03 ENDER-DESC PIC X(44) VALUE IX1054.2 +028800 "ERRORS ENCOUNTERED". IX1054.2 +028900 01 CCVS-E-3. IX1054.2 +029000 02 FILLER PIC X(22) VALUE IX1054.2 +029100 " FOR OFFICIAL USE ONLY". IX1054.2 +029200 02 FILLER PIC X(12) VALUE SPACE. IX1054.2 +029300 02 FILLER PIC X(58) VALUE IX1054.2 +029400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1054.2 +029500 02 FILLER PIC X(13) VALUE SPACE. IX1054.2 +029600 02 FILLER PIC X(15) VALUE IX1054.2 +029700 " COPYRIGHT 1985". IX1054.2 +029800 01 CCVS-E-4. IX1054.2 +029900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1054.2 +030000 02 FILLER PIC X(4) VALUE " OF ". IX1054.2 +030100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1054.2 +030200 02 FILLER PIC X(40) VALUE IX1054.2 +030300 " TESTS WERE EXECUTED SUCCESSFULLY". IX1054.2 +030400 01 XXINFO. IX1054.2 +030500 02 FILLER PIC X(19) VALUE IX1054.2 +030600 "*** INFORMATION ***". IX1054.2 +030700 02 INFO-TEXT. IX1054.2 +030800 04 FILLER PIC X(8) VALUE SPACE. IX1054.2 +030900 04 XXCOMPUTED PIC X(20). IX1054.2 +031000 04 FILLER PIC X(5) VALUE SPACE. IX1054.2 +031100 04 XXCORRECT PIC X(20). IX1054.2 +031200 02 INF-ANSI-REFERENCE PIC X(48). IX1054.2 +031300 01 HYPHEN-LINE. IX1054.2 +031400 02 FILLER PIC IS X VALUE IS SPACE. IX1054.2 +031500 02 FILLER PIC IS X(65) VALUE IS "************************IX1054.2 +031600- "*****************************************". IX1054.2 +031700 02 FILLER PIC IS X(54) VALUE IS "************************IX1054.2 +031800- "******************************". IX1054.2 +031900 01 CCVS-PGM-ID PIC X(9) VALUE IX1054.2 +032000 "IX105A". IX1054.2 +032100 PROCEDURE DIVISION. IX1054.2 +032200 CCVS1 SECTION. IX1054.2 +032300 OPEN-FILES. IX1054.2 +032400 OPEN OUTPUT PRINT-FILE. IX1054.2 +032500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1054.2 +032600 MOVE SPACE TO TEST-RESULTS. IX1054.2 +032700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1054.2 +032800 MOVE ZERO TO REC-SKL-SUB. IX1054.2 +032900 PERFORM CCVS-INIT-FILE 9 TIMES. IX1054.2 +033000 CCVS-INIT-FILE. IX1054.2 +033100 ADD 1 TO REC-SKL-SUB. IX1054.2 +033200 MOVE FILE-RECORD-INFO-SKELETON IX1054.2 +033300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1054.2 +033400 CCVS-INIT-EXIT. IX1054.2 +033500 GO TO CCVS1-EXIT. IX1054.2 +033600 CLOSE-FILES. IX1054.2 +033700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1054.2 +033800 TERMINATE-CCVS. IX1054.2 +033900 STOP RUN. IX1054.2 +034000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1054.2 +034100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1054.2 +034200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1054.2 +034300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1054.2 +034400 MOVE "****TEST DELETED****" TO RE-MARK. IX1054.2 +034500 PRINT-DETAIL. IX1054.2 +034600 IF REC-CT NOT EQUAL TO ZERO IX1054.2 +034700 MOVE "." TO PARDOT-X IX1054.2 +034800 MOVE REC-CT TO DOTVALUE. IX1054.2 +034900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1054.2 +035000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1054.2 +035100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1054.2 +035200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1054.2 +035300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1054.2 +035400 MOVE SPACE TO CORRECT-X. IX1054.2 +035500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1054.2 +035600 MOVE SPACE TO RE-MARK. IX1054.2 +035700 HEAD-ROUTINE. IX1054.2 +035800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +035900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +036000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1054.2 +036100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1054.2 +036200 COLUMN-NAMES-ROUTINE. IX1054.2 +036300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +036400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +036500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +036600 END-ROUTINE. IX1054.2 +036700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1054.2 +036800 END-RTN-EXIT. IX1054.2 +036900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +037000 END-ROUTINE-1. IX1054.2 +037100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1054.2 +037200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1054.2 +037300 ADD PASS-COUNTER TO ERROR-HOLD. IX1054.2 +037400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1054.2 +037500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1054.2 +037600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1054.2 +037700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1054.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1054.2 +037900 END-ROUTINE-12. IX1054.2 +038000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1054.2 +038100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1054.2 +038200 MOVE "NO " TO ERROR-TOTAL IX1054.2 +038300 ELSE IX1054.2 +038400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1054.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1054.2 +038600 PERFORM WRITE-LINE. IX1054.2 +038700 END-ROUTINE-13. IX1054.2 +038800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1054.2 +038900 MOVE "NO " TO ERROR-TOTAL ELSE IX1054.2 +039000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1054.2 +039100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1054.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +039300 IF INSPECT-COUNTER EQUAL TO ZERO IX1054.2 +039400 MOVE "NO " TO ERROR-TOTAL IX1054.2 +039500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1054.2 +039600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1054.2 +039700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +039800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1054.2 +039900 WRITE-LINE. IX1054.2 +040000 ADD 1 TO RECORD-COUNT. IX1054.2 +040100 IF RECORD-COUNT GREATER 42 IX1054.2 +040200 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1054.2 +040300 MOVE SPACE TO DUMMY-RECORD IX1054.2 +040400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1054.2 +040500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1054.2 +040600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1054.2 +040700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1054.2 +040800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1054.2 +040900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1054.2 +041000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1054.2 +041100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1054.2 +041200 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1054.2 +041300 MOVE ZERO TO RECORD-COUNT. IX1054.2 +041400 PERFORM WRT-LN. IX1054.2 +041500 WRT-LN. IX1054.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1054.2 +041700 MOVE SPACE TO DUMMY-RECORD. IX1054.2 +041800 BLANK-LINE-PRINT. IX1054.2 +041900 PERFORM WRT-LN. IX1054.2 +042000 FAIL-ROUTINE. IX1054.2 +042100 IF COMPUTED-X NOT EQUAL TO SPACE IX1054.2 +042200 GO TO FAIL-ROUTINE-WRITE. IX1054.2 +042300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1054.2 +042400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1054.2 +042500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1054.2 +042600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +042700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1054.2 +042800 GO TO FAIL-ROUTINE-EX. IX1054.2 +042900 FAIL-ROUTINE-WRITE. IX1054.2 +043000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1054.2 +043100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1054.2 +043200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1054.2 +043300 MOVE SPACES TO COR-ANSI-REFERENCE. IX1054.2 +043400 FAIL-ROUTINE-EX. EXIT. IX1054.2 +043500 BAIL-OUT. IX1054.2 +043600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1054.2 +043700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1054.2 +043800 BAIL-OUT-WRITE. IX1054.2 +043900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1054.2 +044000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1054.2 +044100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1054.2 +044200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1054.2 +044300 BAIL-OUT-EX. EXIT. IX1054.2 +044400 CCVS1-EXIT. IX1054.2 +044500 EXIT. IX1054.2 +044600 SECT-RC-02-001 SECTION. IX1054.2 +044700 WRITE-INIT-GF-01. IX1054.2 +044800 MOVE "WRITE SHORT & LONG " TO FEATURE. IX1054.2 +044900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1054.2 +045000 WRITE-TEST-GF-01. IX1054.2 +045100* CREATE AN INDEXED FILE OF 180 RECORDS. THE RECORDS SIZE IS IX1054.2 +045200* VARIABLE LENGTH (056 TO 100 CHARACTERS). IX1054.2 +045300 MOVE 1 TO FILE-NO. IX1054.2 +045400 OPEN OUTPUT IX-FR1. IX1054.2 +045500 PERFORM WRITE-TEST-GF-01-SHORT-REC 20 TIMES. IX1054.2 +045600 PERFORM WRITE-TEST-GF-01-LONG-REC 45 TIMES. IX1054.2 +045700 PERFORM WRITE-TEST-GF-01-SHORT-REC 50 TIMES. IX1054.2 +045800 PERFORM WRITE-TEST-GF-01-LONG-REC 29 TIMES. IX1054.2 +045900 PERFORM WRITE-TEST-GF-01-SHORT-REC 35 TIMES. IX1054.2 +046000 PERFORM WRITE-TEST-GF-01-LONG-REC. IX1054.2 +046100 IF THREE-POS-NUM EQUAL 180 IX1054.2 +046200 PERFORM PASS IX1054.2 +046300 MOVE "FILE IX-FR1 CREATED (180 RECORDS)" TO RE-MARK IX1054.2 +046400 GO TO WRITE-TEST-GF-01-WRITE. IX1054.2 +046500 MOVE "WRONG NUMBER OF RECORDS WRITTEN" TO RE-MARK. IX1054.2 +046600 GO TO WRITE-TEST-GF-01-FAIL. IX1054.2 +046700 WRITE-DELETE-GF-01. IX1054.2 +046800 PERFORM DE-LETE. IX1054.2 +046900* NOTE IX-FR1 IS NOT CREATED SO SKIP TO WRITE-TEST-5. IX1054.2 +047000 PERFORM PRINT-DETAIL. IX1054.2 +047100 GO TO WRITE-INIT-GF-02. IX1054.2 +047200 WRITE-TEST-GF-01-LONG-REC. IX1054.2 +047300 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +047400 MOVE "LONG " TO RECORD-LONG-OR-SHORT. IX1054.2 +047500 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-1B. IX1054.2 +047600 WRITE GRP-1SEQ-RECORD-1B INVALID KEY IX1054.2 +047700 MOVE "INVALID KEY ON WRITE (LONG)" TO RE-MARK IX1054.2 +047800 GO TO WRITE-TEST-GF-01-FAIL. IX1054.2 +047900 WRITE-TEST-GF-01-SHORT-REC. IX1054.2 +048000 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +048100 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. IX1054.2 +048200 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-1B. IX1054.2 +048300 WRITE GRP-1SEQ-RECORD-1A INVALID KEY IX1054.2 +048400 MOVE "INVALID KEY ON WRITE (SHORT)" TO RE-MARK IX1054.2 +048500 GO TO WRITE-TEST-GF-01-FAIL. IX1054.2 +048600 WRITE-TEST-GF-01-FAIL. IX1054.2 +048700 MOVE "IX-41 4.9.2 WRONG NUMBER OF RECORDS WRITTEN" TO RE-MARKIX1054.2 +048800 PERFORM FAIL. IX1054.2 +048900 MOVE 180 TO CORRECT-18V0. IX1054.2 +049000 MOVE THREE-POS-NUM TO COMPUTED-18V0. IX1054.2 +049100 WRITE-TEST-GF-01-WRITE. IX1054.2 +049200 MOVE SPACE TO GRP-1SEQ-RECORD-1B. IX1054.2 +049300 PERFORM PRINT-DETAIL. IX1054.2 +049400 CLOSE IX-FR1. IX1054.2 +049500 READ-INIT-F2-01. IX1054.2 +049600 MOVE "READ TO VERIFY " TO FEATURE. IX1054.2 +049700 MOVE "READ-TEST-F2-01 " TO PAR-NAME. IX1054.2 +049800* VERIFY NUMBER OF RECORDS IN FILE. IX1054.2 +049900 OPEN INPUT IX-FR1. IX1054.2 +050000 MOVE 1 TO KEY-VALUE. IX1054.2 +050100 MOVE KEY-BUILD TO IX-FR1-KEY. IX1054.2 +050200 READ-TEST-F2-01. IX1054.2 +050300 READ IX-FR1 INVALID KEY IX1054.2 +050400 GO TO COMPARE-FOR-TEST-F2-01. IX1054.2 +050500 ADD 1 TO KEY-VALUE. IX1054.2 +050600 MOVE KEY-BUILD TO IX-FR1-KEY. IX1054.2 +050700 IF KEY-VALUE GREATER THAN 181 IX1054.2 +050800 GO TO READ-FAIL-F2-01. IX1054.2 +050900 GO TO READ-TEST-F2-01. IX1054.2 +051000 COMPARE-FOR-TEST-F2-01. IX1054.2 +051100 IF KEY-VALUE EQUAL 181 IX1054.2 +051200 PERFORM PASS IX1054.2 +051300 MOVE "180 RECORDS VERIFIED" TO RE-MARK IX1054.2 +051400 GO TO READ-WRITE-F2-01. IX1054.2 +051500 READ-FAIL-F2-01. IX1054.2 +051600 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1054.2 +051700 PERFORM FAIL. IX1054.2 +051800 MOVE 180 TO CORRECT-18V0. IX1054.2 +051900 SUBTRACT 1 FROM KEY-VALUE. IX1054.2 +052000 MOVE KEY-VALUE TO COMPUTED-18V0. IX1054.2 +052100 MOVE "INCORRECT NUMBER OF RECORDS" TO RE-MARK. IX1054.2 +052200 READ-WRITE-F2-01. IX1054.2 +052300 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX1054.2 +052400 PERFORM PRINT-DETAIL. IX1054.2 +052500 CLOSE IX-FR1. IX1054.2 +052600 READ-INIT-F2-02. IX1054.2 +052700 OPEN INPUT IX-FR1. IX1054.2 +052800 MOVE 10 TO KEY-VALUE. IX1054.2 +052900 MOVE KEY-BUILD TO IX-FR1-KEY. IX1054.2 +053000 MOVE "READ SHORT RECORDS" TO FEATURE. IX1054.2 +053100 MOVE "READ-TEST-GF-02 " TO PAR-NAME. IX1054.2 +053200 READ-TEST-F2-02. IX1054.2 +053300* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +053400* SHORT RECORD. IX1054.2 +053500 READ IX-FR1 INVALID KEY IX1054.2 +053600 PERFORM FAIL IX1054.2 +053700 MOVE "KEY00010" TO CORRECT-A IX1054.2 +053800 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +053900 MOVE "INVALID KEY IX-FR1 IX-28 4.5.2" TO RE-MARK IX1054.2 +054000 GO TO READ-TEST-F2-02-WRITE. IX1054.2 +054100* NOTE *** IF REC-NUMBER-1B CONTAINS THE RECORD NUMBER IX1054.2 +054200* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD IX1054.2 +054300* OF VARIABLE LENGTH RECORDS. IX1054.2 +054400* NOTE CHECK LENGTH OF RECORD 10. IX1054.2 +054500 COMPARE-FOR-TEST-F2-02. IX1054.2 +054600 IF REC-NUMBER-1B EQUAL TO "010" IX1054.2 +054700 MOVE "LONG RECORD CREATED" TO COMPUTED-A IX1054.2 +054800 ELSE MOVE "SHORT RECORD CREATED" TO COMPUTED-A IX1054.2 +054900 MOVE 1 TO SHORT-SW. IX1054.2 +055000 MOVE "EXPECT SHORT RECORD" TO CORRECT-A. IX1054.2 +055100 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. IX1054.2 +055200 READ-TEST-F2-02-WRITE. IX1054.2 +055300 PERFORM PRINT-DETAIL. IX1054.2 +055400 CLOSE IX-FR1. IX1054.2 +055500 READ-INIT-F2-03. IX1054.2 +055600* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +055700* LONG RECORD. IX1054.2 +055800 OPEN INPUT IX-FR1. IX1054.2 +055900 MOVE 144 TO KEY-VALUE. IX1054.2 +056000 MOVE KEY-BUILD TO IX-FR1-KEY. IX1054.2 +056100 MOVE "READ LONG RECORDS" TO FEATURE. IX1054.2 +056200 MOVE "READ-TEST-F2-03 " TO PAR-NAME. IX1054.2 +056300 READ-TEST-F2-03. IX1054.2 +056400 READ IX-FR1 INVALID KEY IX1054.2 +056500 PERFORM FAIL IX1054.2 +056600 MOVE "KEY00144" TO CORRECT-A IX1054.2 +056700 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +056800 MOVE "INVAILD KEY IX-FR1" TO RE-MARK IX1054.2 +056900 GO TO READ-WRITE-F2-03. IX1054.2 +057000* NOTE *** IF REC-NUMBER-1B CONTAINS THE RECORD NUMBER IX1054.2 +057100* THEN LONG RECORDS WERE WRITTEN. IX1054.2 +057200 COMPARE-FOR-TEST-F2-03. IX1054.2 +057300 IF REC-NUMBER-1B NOT EQUAL TO "144" GO TO READ-FAIL-F2-03. IX1054.2 +057400 PERFORM PASS. IX1054.2 +057500 PERFORM READ-WRITE-F2-03. IX1054.2 +057600 MOVE "EXPECT VARIABLE LTH" TO CORRECT-A. IX1054.2 +057700 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. IX1054.2 +057800 IF SHORT-SW EQUAL TO ZERO IX1054.2 +057900 MOVE "FIXED RECORD CREATED" TO COMPUTED-A IX1054.2 +058000 ELSE MOVE "VARIABLE LTH CREATED" TO COMPUTED-A. IX1054.2 +058100 GO TO READ-WRITE-F2-03. IX1054.2 +058200 READ-FAIL-F2-03. IX1054.2 +058300 PERFORM FAIL. IX1054.2 +058400 MOVE "KEY00144" TO CORRECT-A. IX1054.2 +058500 MOVE IX-FR1-KEY TO COMPUTED-A. IX1054.2 +058600 MOVE "WRONG LENGTH OR WRONG RECORD IX-28 4.5.2" TO RE-MARK. IX1054.2 +058700 READ-WRITE-F2-03. IX1054.2 +058800 PERFORM PRINT-DETAIL. IX1054.2 +058900 READ-TEST-F2-03-EXIT. IX1054.2 +059000 CLOSE IX-FR1. IX1054.2 +059100 WRITE-INIT-GF-02. IX1054.2 +059200 MOVE "WRITE IX-FS2 " TO FEATURE. IX1054.2 +059300 MOVE "WRITE-TEST-GF-02 " TO PAR-NAME. IX1054.2 +059400* CREATE AN INDEXED FILE OF 101 RECORDS. THE RECORD SIZE IS IX1054.2 +059500* VARIABLE LENGTH (056 TO 101 CHARACTERS). IX1054.2 +059600 MOVE ZERO TO KEY-VALUE THREE-POS-NUM SHORT-SW. IX1054.2 +059700 MOVE 2 TO FILE-NO. IX1054.2 +059800 OPEN OUTPUT IX-FR2. IX1054.2 +059900 WRITE-TEST-GF-02. IX1054.2 +060000 PERFORM WRITE-TEST-GF-02-SHORT-REC 11 TIMES. IX1054.2 +060100 PERFORM WRITE-TEST-GF-02-LONG-REC 29 TIMES. IX1054.2 +060200 PERFORM WRITE-TEST-GF-02-SHORT-REC 20 TIMES. IX1054.2 +060300 PERFORM WRITE-TEST-GF-02-LONG-REC 20 TIMES. IX1054.2 +060400 PERFORM WRITE-TEST-GF-02-SHORT-REC 20 TIMES. IX1054.2 +060500 PERFORM WRITE-TEST-GF-02-LONG-REC. IX1054.2 +060600 IF THREE-POS-NUM EQUAL 101 IX1054.2 +060700 PERFORM PASS IX1054.2 +060800 MOVE "FILE IX-FR2 CREATED (101 RECORDS)" TO RE-MARK IX1054.2 +060900 GO TO WRITE-TEST-GF-02-WRITE. IX1054.2 +061000 MOVE "WRONG NUMBER OF RECORDS WRITTEN IX-41 4.9.2" TO RE-MARKIX1054.2 +061100 GO TO WRITE-TEST-GF-02-FAIL. IX1054.2 +061200 WRITE-DELETE-GF-02. IX1054.2 +061300 PERFORM DE-LETE. IX1054.2 +061400* NOTE IX-FR2 IS NOT CREATED SO SKIP TO WRITE-TEST-9. IX1054.2 +061500 PERFORM PRINT-DETAIL. IX1054.2 +061600 GO TO WRITE-INIT-GF-03. IX1054.2 +061700 WRITE-TEST-GF-02-LONG-REC. IX1054.2 +061800 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +061900 MOVE "LONG " TO RECORD-LONG-OR-SHORT. IX1054.2 +062000 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-2B. IX1054.2 +062100 WRITE GRP-1SEQ-RECORD-2B INVALID KEY IX1054.2 +062200 MOVE "INVALID KEY ON WRITE (LONG)" TO RE-MARK IX1054.2 +062300 GO TO WRITE-TEST-GF-02-FAIL. IX1054.2 +062400 WRITE-TEST-GF-02-SHORT-REC. IX1054.2 +062500 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +062600 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. IX1054.2 +062700 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-2B. IX1054.2 +062800 WRITE GRP-1SEQ-RECORD-2A INVALID KEY IX1054.2 +062900 MOVE "INVALID KEY ON WRITE (SHORT)" TO RE-MARK IX1054.2 +063000 GO TO WRITE-TEST-GF-02-FAIL. IX1054.2 +063100 WRITE-TEST-GF-02-FAIL. IX1054.2 +063200 PERFORM FAIL. IX1054.2 +063300 MOVE 101 TO CORRECT-18V0. IX1054.2 +063400 MOVE THREE-POS-NUM TO COMPUTED-18V0. IX1054.2 +063500 WRITE-TEST-GF-02-WRITE. IX1054.2 +063600 MOVE SPACE TO GRP-1SEQ-RECORD-2B. IX1054.2 +063700 PERFORM PRINT-DETAIL. IX1054.2 +063800 CLOSE IX-FR2. IX1054.2 +063900 READ-INIT-F2-05. IX1054.2 +064000* VERIFY NUMBER OF RECORDS IN FILE. IX1054.2 +064100 MOVE "READ IX-FS2 VERIFY " TO FEATURE. IX1054.2 +064200 MOVE "READ-TEST-F2-05 " TO PAR-NAME. IX1054.2 +064300 OPEN INPUT IX-FR2. IX1054.2 +064400 MOVE 1 TO KEY-VALUE. IX1054.2 +064500 MOVE KEY-BUILD TO IX-FR2-KEY. IX1054.2 +064600 READ-TEST-F2-05. IX1054.2 +064700 READ IX-FR2 INVALID KEY IX1054.2 +064800 GO TO COMPARE-FOR-TEST-F2-05. IX1054.2 +064900 ADD 1 TO KEY-VALUE. IX1054.2 +065000 MOVE KEY-BUILD TO IX-FR2-KEY. IX1054.2 +065100 IF KEY-VALUE GREATER THAN 102 IX1054.2 +065200 GO TO READ-TEST-F2-05-FAIL. IX1054.2 +065300 GO TO READ-TEST-F2-05. IX1054.2 +065400 COMPARE-FOR-TEST-F2-05. IX1054.2 +065500 IF KEY-VALUE EQUAL 102 IX1054.2 +065600 PERFORM PASS IX1054.2 +065700 MOVE "101 RECORDS VERIFIED" TO RE-MARK IX1054.2 +065800 GO TO READ-TEST-F2-05-WRITE. IX1054.2 +065900 READ-TEST-F2-05-FAIL. IX1054.2 +066000 PERFORM FAIL. IX1054.2 +066100 MOVE 101 TO CORRECT-18V0. IX1054.2 +066200 SUBTRACT 1 FROM KEY-VALUE. IX1054.2 +066300 MOVE KEY-VALUE TO COMPUTED-18V0. IX1054.2 +066400 MOVE "INCORRECT NUMBER OF RECORDS IX-28 4.5.2" TO RE-MARK. IX1054.2 +066500 READ-TEST-F2-05-WRITE. IX1054.2 +066600 PERFORM PRINT-DETAIL. IX1054.2 +066700 READ-INIT-F2-06. IX1054.2 +066800* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +066900* SHORT RECORD. IX1054.2 +067000 MOVE "READ " TO FEATURE. IX1054.2 +067100 MOVE "READ-TEST-F2-06 " TO PAR-NAME. IX1054.2 +067200 MOVE 100 TO KEY-VALUE. IX1054.2 +067300 MOVE KEY-BUILD TO IX-FR2-KEY. IX1054.2 +067400 READ-TEST-F2-06. IX1054.2 +067500 READ IX-FR2 INVALID KEY IX1054.2 +067600 PERFORM FAIL IX1054.2 +067700 MOVE "KEY00100" TO CORRECT-A IX1054.2 +067800 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +067900 MOVE "INVAILD KEY IX-FR2 IX-28 4.5.2 " TO RE-MARK IX1054.2 +068000 GO TO READ-TEST-F2-06-WRITE. IX1054.2 +068100* NOTE *** IF REC-NUMBER-2B CONTAINS THE RECORD NUMBER IX1054.2 +068200* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD IX1054.2 +068300* OF VARIABLE LENGTH RECORDS. IX1054.2 +068400* NOTE CHECK LENGTH OF RECORD 100. IX1054.2 +068500 COMPARE-FOR-TEST-F2-06. IX1054.2 +068600 IF REC-NUMBER-2B EQUAL TO "100" IX1054.2 +068700 MOVE "LONG RECORD CREATED" TO COMPUTED-A IX1054.2 +068800 ELSE MOVE "SHORT RECORD CREATED" TO COMPUTED-A IX1054.2 +068900 MOVE 1 TO SHORT-SW. IX1054.2 +069000 MOVE "EXPECT SHORT RECORD" TO CORRECT-A. IX1054.2 +069100 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. IX1054.2 +069200 READ-TEST-F2-06-WRITE. IX1054.2 +069300 PERFORM PRINT-DETAIL. IX1054.2 +069400 READ-INIT-F2-07. IX1054.2 +069500* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +069600* LONG RECORD. IX1054.2 +069700 MOVE "READ " TO FEATURE. IX1054.2 +069800 MOVE "READ-TEST-F2-07 " TO PAR-NAME. IX1054.2 +069900 MOVE 12 TO KEY-VALUE. IX1054.2 +070000 MOVE KEY-BUILD TO IX-FR2-KEY. IX1054.2 +070100 READ-TEST-F2-07. IX1054.2 +070200 READ IX-FR2 INVALID KEY IX1054.2 +070300 PERFORM FAIL IX1054.2 +070400 MOVE "KEY00012" TO CORRECT-A IX1054.2 +070500 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +070600 MOVE "INVALID KEY IX-FR2 IX-28 4.5.2" TO RE-MARK IX1054.2 +070700 GO TO READ-TEST-F2-07-WRITE. IX1054.2 +070800* NOTE ** IF REC-NUMBER-1B CONTAINS THE RECORD NUMBER IX1054.2 +070900* THEN LONG RECORDS WERE WRITTEN. IX1054.2 +071000 COMPARE-FOR-TEST-F2-07. IX1054.2 +071100 IF REC-NUMBER-2B EQUAL TO "012" IX1054.2 +071200 PERFORM PASS IX1054.2 +071300 PERFORM READ-TEST-F2-07-WRITE IX1054.2 +071400 MOVE "EXPECT VARIABLE LTH" TO CORRECT-A IX1054.2 +071500 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK IX1054.2 +071600 IF SHORT-SW EQUAL TO ZERO IX1054.2 +071700 MOVE "FIXED RECORD CREATED" TO COMPUTED-A IX1054.2 +071800 GO TO READ-TEST-F2-07-WRITE IX1054.2 +071900 ELSE MOVE "VARIABLE LTH CREATED" TO COMPUTED-A IX1054.2 +072000 GO TO READ-TEST-F2-07-WRITE. IX1054.2 +072100 PERFORM FAIL. IX1054.2 +072200 MOVE "KEY00012" TO CORRECT-A. IX1054.2 +072300 MOVE IX-FR2-KEY TO COMPUTED-A. IX1054.2 +072400 MOVE "WRONG LENGTH OR WRONG RECORD" TO RE-MARK. IX1054.2 +072500 READ-TEST-F2-07-WRITE. IX1054.2 +072600 PERFORM PRINT-DETAIL. IX1054.2 +072700 READ-TEST-F2-07-EXIT. IX1054.2 +072800 CLOSE IX-FR2. IX1054.2 +072900 WRITE-INIT-GF-03. IX1054.2 +073000* CREATE AN INDEXED FILE OF 120 RECORDS. THE RECORD SIZE IS IX1054.2 +073100* VARIABLE LENGTH (056-102 CHARACTERS). IX1054.2 +073200 MOVE "WRITE IX-FS3 " TO FEATURE. IX1054.2 +073300 MOVE "WRITE-TEST-GF-03 " TO PAR-NAME. IX1054.2 +073400 MOVE ZERO TO KEY-VALUE THREE-POS-NUM SHORT-SW. IX1054.2 +073500 MOVE 3 TO FILE-NO. IX1054.2 +073600 OPEN OUTPUT IX-FR3. IX1054.2 +073700 WRITE-TEST-GF-03. IX1054.2 +073800 PERFORM WRITE-TEST-GF-03-SHORT-REC. IX1054.2 +073900 PERFORM WRITE-TEST-GF-03-LONG-REC 15 TIMES. IX1054.2 +074000 PERFORM WRITE-TEST-GF-03-SHORT-REC 20 TIMES. IX1054.2 +074100 PERFORM WRITE-TEST-GF-03-LONG-REC 12 TIMES. IX1054.2 +074200 PERFORM WRITE-TEST-GF-03-SHORT-REC 23 TIMES. IX1054.2 +074300 PERFORM WRITE-TEST-GF-03-LONG-REC 23 TIMES. IX1054.2 +074400 PERFORM WRITE-TEST-GF-03-SHORT-REC 25 TIMES. IX1054.2 +074500 PERFORM WRITE-TEST-GF-03-LONG-REC. IX1054.2 +074600 IF THREE-POS-NUM EQUAL 120 IX1054.2 +074700 PERFORM PASS IX1054.2 +074800 MOVE "FILE IX-FR3 CREATED (120 RECORDS)" TO RE-MARK IX1054.2 +074900 GO TO WRITE-TEST-GF-03-WRITE. IX1054.2 +075000 MOVE "WRONG NUMBER OF RECORDS WRITTEN IX-41 4.9.2" TO RE-MARKIX1054.2 +075100 GO TO WRITE-TEST-GF-03-FAIL. IX1054.2 +075200 WRITE-DELETE-GF-03. IX1054.2 +075300 PERFORM DE-LETE. IX1054.2 +075400* NOTE IX-FR3 IS NOT CREATED SO SKIP TO END-PARAGRAPH. IX1054.2 +075500 PERFORM PRINT-DETAIL. IX1054.2 +075600 GO TO CCVS-EXIT. IX1054.2 +075700 WRITE-TEST-GF-03-LONG-REC. IX1054.2 +075800 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +075900 MOVE "LONG " TO RECORD-LONG-OR-SHORT. IX1054.2 +076000 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-3B. IX1054.2 +076100 WRITE GRP-1SEQ-RECORD-3B INVALID KEY IX1054.2 +076200 MOVE "INVALID KEY ON WRITE (LONG)" TO RE-MARK IX1054.2 +076300 GO TO WRITE-TEST-GF-03-FAIL. IX1054.2 +076400 WRITE-TEST-GF-03-SHORT-REC. IX1054.2 +076500 ADD 1 TO KEY-VALUE THREE-POS-NUM. IX1054.2 +076600 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. IX1054.2 +076700 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-3B. IX1054.2 +076800 WRITE GRP-1SEQ-RECORD-3A INVALID KEY IX1054.2 +076900 MOVE "INVALID KEY ON WRITE (SHORT)" TO RE-MARK IX1054.2 +077000 GO TO WRITE-TEST-GF-03-FAIL. IX1054.2 +077100 WRITE-TEST-GF-03-FAIL. IX1054.2 +077200 PERFORM FAIL. IX1054.2 +077300 MOVE 120 TO CORRECT-18V0. IX1054.2 +077400 MOVE THREE-POS-NUM TO COMPUTED-18V0. IX1054.2 +077500 WRITE-TEST-GF-03-WRITE. IX1054.2 +077600 MOVE SPACE TO GRP-1SEQ-RECORD-3B. IX1054.2 +077700 PERFORM PRINT-DETAIL. IX1054.2 +077800 CLOSE IX-FR3. IX1054.2 +077900 READ-INIT-F2-08. IX1054.2 +078000* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +078100* LONG RECORD. IX1054.2 +078200 MOVE "READ IX-FS3 VERIFY " TO FEATURE. IX1054.2 +078300 MOVE "READ-TEST-F2-08 " TO PAR-NAME. IX1054.2 +078400 OPEN INPUT IX-FR3. IX1054.2 +078500 MOVE 1 TO KEY-VALUE. IX1054.2 +078600 MOVE KEY-BUILD TO IX-FR3-KEY. IX1054.2 +078700 READ-TEST-F2-08. IX1054.2 +078800 READ IX-FR3 INVALID KEY IX1054.2 +078900 PERFORM FAIL IX1054.2 +079000 MOVE "KEY00016" TO CORRECT-A IX1054.2 +079100 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +079200 MOVE "INVAILD KEY IX-FR3" TO RE-MARK IX1054.2 +079300 GO TO READ-TEST-F2-08-WRITE. IX1054.2 +079400 IF KEY-VALUE NOT EQUAL TO 16 IX1054.2 +079500 ADD 1 TO KEY-VALUE IX1054.2 +079600 MOVE KEY-BUILD TO IX-FR3-KEY IX1054.2 +079700 GO TO READ-TEST-F2-08. IX1054.2 +079800* NOTE *** IF REC-NUMBER-3B CONTAINS THE RECORD NUMBER IX1054.2 +079900* THEN LONG RECORDS WERE WRITTEN. IX1054.2 +080000 COMPARE-FOR-TEST-F2-08. IX1054.2 +080100 IF REC-NUMBER-3B EQUAL TO "016" IX1054.2 +080200 PERFORM PASS IX1054.2 +080300 GO TO READ-TEST-F2-08-WRITE. IX1054.2 +080400 PERFORM FAIL. IX1054.2 +080500 MOVE "KEY00016" TO CORRECT-A. IX1054.2 +080600 MOVE IX-FR3-KEY TO COMPUTED-A. IX1054.2 +080700 MOVE "WRONG LENGTH OR WRONG RECORD IX-28 4.5.2" TO RE-MARK. IX1054.2 +080800 READ-TEST-F2-08-WRITE. IX1054.2 +080900 PERFORM PRINT-DETAIL. IX1054.2 +081000 READ-INIT-09. IX1054.2 +081100* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +081200* SHORT RECORD. IX1054.2 +081300 MOVE "READ SHORT RECORDS" TO FEATURE. IX1054.2 +081400 MOVE "READ-TEST-F2-09 " TO PAR-NAME. IX1054.2 +081500 MOVE 71 TO KEY-VALUE. IX1054.2 +081600 MOVE KEY-BUILD TO IX-FR3-KEY. IX1054.2 +081700 READ-TEST-F2-09. IX1054.2 +081800 READ IX-FR3 INVALID KEY IX1054.2 +081900 PERFORM FAIL IX1054.2 +082000 MOVE "KEY00071" TO CORRECT-A IX1054.2 +082100 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +082200 MOVE "INVAILD KEY IX-FR3 IX-28 4.5.2" TO RE-MARK IX1054.2 +082300 GO TO READ-TEST-F2-09-WRITE. IX1054.2 +082400* NOTE *** IF REC-NUMBER-1B CONTAINS THE RECORD NUMBER IX1054.2 +082500* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD IX1054.2 +082600* OF VARIABLE LENGTH RECORDS. IX1054.2 +082700* NOTE CHECK LENGTH OF RECORD 71. IX1054.2 +082800 COMPARE-FOR-TEST-F2-09. IX1054.2 +082900 IF REC-NUMBER-3B EQUAL TO "071" IX1054.2 +083000 MOVE "LONG RECORD CREATED" TO COMPUTED-A IX1054.2 +083100 ELSE MOVE "SHORT RECORD CREATED" TO COMPUTED-A IX1054.2 +083200 MOVE 1 TO SHORT-SW. IX1054.2 +083300 MOVE "EXPECT SHORT RECORD" TO CORRECT-A. IX1054.2 +083400 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. IX1054.2 +083500 READ-TEST-F2-09-WRITE. IX1054.2 +083600 PERFORM PRINT-DETAIL. IX1054.2 +083700 READ-INIT-F2-10. IX1054.2 +083800* VERIFY VARIABLE LENGTH RECORDS WERE CREATED BY TESTING IX1054.2 +083900* LONG RECORD. IX1054.2 +084000 MOVE "READ LONG RECORDS" TO FEATURE. IX1054.2 +084100 MOVE "READ-TEST-F2-10 " TO PAR-NAME. IX1054.2 +084200 MOVE 120 TO KEY-VALUE. IX1054.2 +084300 MOVE KEY-BUILD TO IX-FR3-KEY. IX1054.2 +084400 READ-TEST-F2-10. IX1054.2 +084500 READ IX-FR3 INVALID KEY IX1054.2 +084600 PERFORM FAIL IX1054.2 +084700 MOVE "KEY00120" TO CORRECT-A IX1054.2 +084800 MOVE "***INVALID KEY***" TO COMPUTED-A IX1054.2 +084900 MOVE "INVAILD KEY IX-FR3 IX-28 4.5.2" TO RE-MARK IX1054.2 +085000 GO TO READ-TEST-F2-10-WRITE. IX1054.2 +085100* NOTE *** IF REC-NUMBER-3B CONTAINS THE RECORD NUMBER IX1054.2 +085200* THEN LONG RECORDS WERE WITTEN. IX1054.2 +085300 COMPARE-FOR-TEST-F2-10. IX1054.2 +085400 IF REC-NUMBER-3B EQUAL TO "120" IX1054.2 +085500 PERFORM PASS IX1054.2 +085600 PERFORM READ-TEST-F2-10-WRITE IX1054.2 +085700 MOVE "EXPECT VARIABLE LTH" TO CORRECT-A IX1054.2 +085800 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK IX1054.2 +085900 IF SHORT-SW EQUAL TO ZERO IX1054.2 +086000 MOVE "FIXED RECORD CREATED" TO COMPUTED-A IX1054.2 +086100 GO TO READ-TEST-F2-10-WRITE IX1054.2 +086200 ELSE MOVE "VARIABLE LTH CREATED" TO COMPUTED-A IX1054.2 +086300 GO TO READ-TEST-F2-10-WRITE. IX1054.2 +086400 PERFORM FAIL. IX1054.2 +086500 MOVE "KEY00120" TO CORRECT-A. IX1054.2 +086600 MOVE IX-FR3-KEY TO COMPUTED-A. IX1054.2 +086700 MOVE "WRONG LENGTH OR WRONG RECORD IX-28 4.5.2" TO RE-MARK. IX1054.2 +086800 READ-TEST-F2-10-WRITE. IX1054.2 +086900 MOVE "READ-TEST-012" TO PAR-NAME. IX1054.2 +087000 PERFORM PRINT-DETAIL. IX1054.2 +087100 READ-TEST-F2-10-EXIT. IX1054.2 +087200 CLOSE IX-FR3. IX1054.2 +087300 CCVS-EXIT SECTION. IX1054.2 +087400 CCVS-999999. IX1054.2 +087500 GO TO CLOSE-FILES. IX1054.2 diff --git a/tests/cobol85/IX/IX106A.CBL b/tests/cobol85/IX/IX106A.CBL new file mode 100755 index 00000000..e9edecee --- /dev/null +++ b/tests/cobol85/IX/IX106A.CBL @@ -0,0 +1,1233 @@ +000100 IDENTIFICATION DIVISION. IX1064.2 +000200 PROGRAM-ID. IX1064.2 +000300 IX106A. IX1064.2 +000400**************************************************************** IX1064.2 +000500* * IX1064.2 +000600* VALIDATION FOR:- * IX1064.2 +000700* * IX1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1064.2 +000900* * IX1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1064.2 +001100* * IX1064.2 +001200**************************************************************** IX1064.2 +001300* THE PURPOSE OF THIS PROGRAM IS TO TEST THE ABILITY TO IX1064.2 +001400* USE THE THREE DIFFERENT TYPES OF FILES (SEQUENTIAL , IX1064.2 +001500* INDEXED , AND RELATIVE) IN ONE PROGRAM . THE PROGRAM IX1064.2 +001600* IS BROKEN INTO FIVE SECTIONS . THE FIRST SECTION TESTS IX1064.2 +001700* THE ABILITY TO CREATE A RELATIVE FILE RANDOMLY . THE IX1064.2 +001800* SECOND SECTION TESTS THE ABILITY TO USE ALL THREE FILE IX1064.2 +001900* TYPES , READING IN THE RELATIVE FILE AND WRITING OUT THE IX1064.2 +002000* SEQUENTIAL AND INDEXED FILES . THE THIRD SECTION FURTHER IX1064.2 +002100* TESTS THE ABILITY TO USE THE THREE FILE TYPES . THE FOURTH IX1064.2 +002200* SECTION TESTS THE ABILITY TO DELETE RECORDS FROM THE IX1064.2 +002300* DIFFERENT FILE TYPES . THE FIFTH SECTION TESTS THE ABILITY IX1064.2 +002400* TO REWRITE RECORDS TO EACH OF THE FILE TYPES . IX1064.2 +002500* IX1064.2 +002600* X-CARDS WHICH MUST BE RELACED WITH IMPLEMENTORS NAMES' IN IX1064.2 +002700* THIS PROGRAM ARE : IX1064.2 +002800* IX1064.2 +002900* X-14 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1064.2 +003000* SEQUENTIAL FILE . IX1064.2 +003100* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1064.2 +003200* RELATIVE FILE-1 , FILE-2 . IX1064.2 +003300* X-24 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX1064.2 +003400* INDEXED FILE . IX1064.2 +003500* X-44 SYSTEM-NAME IN ASSIGN CLAUSE FOR IX1064.2 +003600* INDEXED FILE . IX1064.2 +003700* X-55 SYSTEM PRINTER . IX1064.2 +003800* X-62 FOR RAW-DATA IX1064.2 +003900* X-82 SOURCE-COMPUTER . IX1064.2 +004000* X-83 OBJECT-COMPUTER . IX1064.2 +004100* C X-84 PRINTE-FILE LABELS IX1064.2 +004200**************************************************************** IX1064.2 +004300 ENVIRONMENT DIVISION. IX1064.2 +004400 CONFIGURATION SECTION. IX1064.2 +004500 SOURCE-COMPUTER. IX1064.2 +004600 Linux. IX1064.2 +004700 OBJECT-COMPUTER. IX1064.2 +004800 Linux. IX1064.2 +004900 INPUT-OUTPUT SECTION. IX1064.2 +005000 FILE-CONTROL. IX1064.2 +005100*P SELECT RAW-DATA ASSIGN TO IX1064.2 +005200*P "XXXXX062" IX1064.2 +005300*P ORGANIZATION IS INDEXED IX1064.2 +005400*P ACCESS MODE IS RANDOM IX1064.2 +005500*P RECORD KEY IS RAW-DATA-KEY. IX1064.2 +005600 SELECT PRINT-FILE ASSIGN TO IX1064.2 +005700 "report.log". IX1064.2 +005800 SELECT RL-FR1 IX1064.2 +005900 ASSIGN TO IX1064.2 +006000 "XXXXX021" IX1064.2 +006100 ACCESS MODE IS RANDOM IX1064.2 +006200 RELATIVE KEY IS RL-KEY IX1064.2 +006300 ORGANIZATION IS RELATIVE IX1064.2 +006400 FILE STATUS IS FR1-STATUS. IX1064.2 +006500 SELECT IX-FS1 IX1064.2 +006600 ASSIGN TO IX1064.2 +006700 "XXXXX024" IX1064.2 +006800*J **** X-CARD UNDEFINED **** IX1064.2 +006900 ACCESS MODE IS RANDOM IX1064.2 +007000 ORGANIZATION IS INDEXED IX1064.2 +007100 RECORD KEY IS IX-FS1-KEY-11-13 IX1064.2 +007200 FILE STATUS IS FS1-STATUS-IX. IX1064.2 +007300 SELECT SQ-FS1 IX1064.2 +007400 ASSIGN TO IX1064.2 +007500 "XXXXX014" IX1064.2 +007600 ACCESS MODE IS SEQUENTIAL IX1064.2 +007700 ORGANIZATION IS SEQUENTIAL IX1064.2 +007800 FILE STATUS IS FS1-STATUS-SQ. IX1064.2 +007900 DATA DIVISION. IX1064.2 +008000 FILE SECTION. IX1064.2 +008100*P IX1064.2 +008200*PD RAW-DATA. IX1064.2 +008300*P IX1064.2 +008400*P1 RAW-DATA-SATZ. IX1064.2 +008500*P 05 RAW-DATA-KEY PIC X(6). IX1064.2 +008600*P 05 C-DATE PIC 9(6). IX1064.2 +008700*P 05 C-TIME PIC 9(8). IX1064.2 +008800*P 05 C-NO-OF-TESTS PIC 99. IX1064.2 +008900*P 05 C-OK PIC 999. IX1064.2 +009000*P 05 C-ALL PIC 999. IX1064.2 +009100*P 05 C-FAIL PIC 999. IX1064.2 +009200*P 05 C-DELETED PIC 999. IX1064.2 +009300*P 05 C-INSPECT PIC 999. IX1064.2 +009400*P 05 C-NOTE PIC X(13). IX1064.2 +009500*P 05 C-INDENT PIC X. IX1064.2 +009600*P 05 C-ABORT PIC X(8). IX1064.2 +009700 FD PRINT-FILE. IX1064.2 +009800 01 PRINT-REC PICTURE X(120). IX1064.2 +009900 01 DUMMY-RECORD PICTURE X(120). IX1064.2 +010000 FD RL-FR1 IX1064.2 +010100*C LABEL RECORDS ARE STANDARD IX1064.2 +010200*C DATA RECORD IS RL-FR1R1-F-G-241 IX1064.2 +010300 RECORD CONTAINS 241 CHARACTERS. IX1064.2 +010400 01 RL-FR1R1-F-G-241. IX1064.2 +010500 05 RL-FR1-REC-120 PICTURE X(120). IX1064.2 +010600 05 RL-FR1-REC-121-241. IX1064.2 +010700 10 FILLER PICTURE X(8). IX1064.2 +010800 10 RL-REC-KEY-AREA. IX1064.2 +010900 15 RL-FR1-KEY. IX1064.2 +011000 20 RL-FR1-KEY-1-10. IX1064.2 +011100 25 RL-FR1-KEY-1-5 PICTURE X(5). IX1064.2 +011200 25 RL-FR1-KEY-6-10 PICTURE X(5). IX1064.2 +011300 20 RL-FR1-KEY-11-13 PICTURE 9(3). IX1064.2 +011400 15 RL-REDF-RECKEY REDEFINES RL-FR1-KEY. IX1064.2 +011500 20 R-RECKEY-1-7 PICTURE X(7). IX1064.2 +011600 20 R-RECKEY-8-13 PICTURE X(6). IX1064.2 +011700 15 FILLER PICTURE X(16). IX1064.2 +011800 10 FILLER PICTURE X(9). IX1064.2 +011900 10 RL-ALT-KEY1-AREA. IX1064.2 +012000 15 RL-FR1-ALTKEY1. IX1064.2 +012100 20 RL-FR1-ALTKEY1-1-10. IX1064.2 +012200 25 RL-FR1-ALTKEY1-1-5 PICTURE X(5). IX1064.2 +012300 25 RL-FR1-ALTKEY1-6-10 PICTURE X(5). IX1064.2 +012400 20 RL-FR1-ALTKEY1-11-13 PICTURE X(3). IX1064.2 +012500 20 RL-FR1-ALTKEY1-14-20 PICTURE X(7). IX1064.2 +012600 15 RL-REDF-ALTKEY1 REDEFINES RL-FR1-ALTKEY1. IX1064.2 +012700 20 R-ALTKEY1-1-6 PICTURE X(6). IX1064.2 +012800 20 R-ALTKEY1-7-10 PICTURE X(4). IX1064.2 +012900 20 R-ALTKEY1-11-20 PICTURE X(10). IX1064.2 +013000 15 FILLER PICTURE X(9). IX1064.2 +013100 10 FILLER PICTURE X(9). IX1064.2 +013200 10 RL-ALT-KEY2-AREA. IX1064.2 +013300 15 RL-FR1-ALTKEY2. IX1064.2 +013400 20 RL-FR1-ALTKEY2-1-10. IX1064.2 +013500 25 RL-FR1-ALTKEY2-1-5 PICTURE X(5). IX1064.2 +013600 25 RL-FR1-ALTKEY2-6-10 PICTURE X(5). IX1064.2 +013700 20 RL-FR1-ALTKEY2-11-13 PICTURE X(3). IX1064.2 +013800 20 RL-FR1-ALTKEY2-14-20 PICTURE X(7). IX1064.2 +013900 15 FILLER PICTURE X(9). IX1064.2 +014000 10 FILLER PICTURE X(8). IX1064.2 +014100 FD IX-FS1 IX1064.2 +014200*C LABEL RECORDS ARE STANDARD IX1064.2 +014300*C DATA RECORD IS IX-FS1R1-F-G-241 IX1064.2 +014400 RECORD CONTAINS 241 CHARACTERS. IX1064.2 +014500 01 IX-FS1R1-F-G-241. IX1064.2 +014600 05 IX-FS1-REC-120 PICTURE X(120). IX1064.2 +014700 05 IX-FS1-REC-121-241. IX1064.2 +014800 10 FILLER PICTURE X(8). IX1064.2 +014900 10 IX-REC-KEY-AREA. IX1064.2 +015000 15 IX-FS1-KEY. IX1064.2 +015100 20 IX-FS1-KEY-1-10. IX1064.2 +015200 25 IX-FS1-KEY-1-5 PICTURE X(5). IX1064.2 +015300 25 IX-FS1-KEY-6-10 PICTURE X(5). IX1064.2 +015400 20 IX-FS1-KEY-11-13 PICTURE X(3). IX1064.2 +015500 15 IX-REDF-RECKEY REDEFINES IX-FS1-KEY. IX1064.2 +015600 20 I-RECKEY-1-7 PICTURE X(7). IX1064.2 +015700 20 I-RECKEY-8-13 PICTURE X(6). IX1064.2 +015800 15 FILLER PICTURE X(16). IX1064.2 +015900 10 FILLER PICTURE X(9). IX1064.2 +016000 10 IX-ALT-KEY1-AREA. IX1064.2 +016100 15 IX-FS1-ALTKEY1. IX1064.2 +016200 20 IX-FS1-ALTKEY1-1-10. IX1064.2 +016300 25 IX-FS1-ALTKEY1-1-5 PICTURE X(5). IX1064.2 +016400 25 IX-FS1-ALTKEY1-6-10 PICTURE X(5). IX1064.2 +016500 20 IX-FS1-ALTKEY1-11-13 PICTURE X(3). IX1064.2 +016600 20 IX-FS1-ALTKEY1-14-20 PICTURE X(7). IX1064.2 +016700 15 IX-REDF-ALTKEY1 REDEFINES IX-FS1-ALTKEY1. IX1064.2 +016800 20 I-ALTKEY1-1-6 PICTURE X(6). IX1064.2 +016900 20 I-ALTKEY1-7-10 PICTURE X(4). IX1064.2 +017000 20 I-ALTKEY1-11-20 PICTURE X(10). IX1064.2 +017100 15 FILLER PICTURE X(9). IX1064.2 +017200 10 FILLER PICTURE X(9). IX1064.2 +017300 10 IX-ALT-KEY2-AREA. IX1064.2 +017400 15 IX-FS1-ALTKEY2. IX1064.2 +017500 20 IX-FS1-ALTKEY2-1-10. IX1064.2 +017600 25 IX-FR1-ALTKEY2-1-5 PICTURE X(5). IX1064.2 +017700 25 IX-FR1-ALTKEY2-6-10 PICTURE X(5). IX1064.2 +017800 20 IX-FS1-ALTKEY2-11-13 PICTURE X(3). IX1064.2 +017900 20 IX-FS1-ALTKEY2-14-20 PICTURE X(7). IX1064.2 +018000 15 FILLER PICTURE X(9). IX1064.2 +018100 10 FILLER PICTURE X(8). IX1064.2 +018200 FD SQ-FS1 IX1064.2 +018300*C LABEL RECORDS ARE STANDARD IX1064.2 +018400*C DATA RECORD IS SQ-FS1R1-F-G-241 IX1064.2 +018500 RECORD CONTAINS 241 CHARACTERS. IX1064.2 +018600 01 SQ-FS1R1-F-G-241. IX1064.2 +018700 05 SQ-FS1-REC-120 PICTURE X(120). IX1064.2 +018800 05 SQ-FS1-REC-121-241. IX1064.2 +018900 10 FILLER PICTURE X(8). IX1064.2 +019000 10 SQ-REC-KEY-AREA. IX1064.2 +019100 15 SQ-FS1-KEY. IX1064.2 +019200 20 SQ-FS1-KEY-1-10. IX1064.2 +019300 25 SQ-FS1-KEY-1-5 PICTURE X(5). IX1064.2 +019400 25 SQ-FS1-KEY-6-10 PICTURE X(5). IX1064.2 +019500 20 SQ-FS1-KEY-11-13 PICTURE 9(3). IX1064.2 +019600 15 SQ-REDF-RECKEY REDEFINES SQ-FS1-KEY. IX1064.2 +019700 20 S-RECKEY-1-7 PICTURE X(7). IX1064.2 +019800 20 S-RECKEY-8-13 PICTURE X(6). IX1064.2 +019900 15 FILLER PICTURE X(16). IX1064.2 +020000 10 FILLER PICTURE X(9). IX1064.2 +020100 10 SQ-ALT-KEY1-AREA. IX1064.2 +020200 15 SQ-FS1-ALTKEY1. IX1064.2 +020300 20 SQ-FS1-ALTKEY1-1-10. IX1064.2 +020400 25 SQ-FS1-ALTKEY1-1-5 PICTURE X(5). IX1064.2 +020500 25 SQ-FS1-ALTKEY1-6-10 PICTURE X(5). IX1064.2 +020600 20 SQ-FS1-ALTKEY1-11-13 PICTURE X(3). IX1064.2 +020700 20 SQ-FS1-ALTKEY1-14-20 PICTURE X(7). IX1064.2 +020800 15 SQ-REDF-ALTKEY1 REDEFINES SQ-FS1-ALTKEY1. IX1064.2 +020900 20 S-ALTKEY1-1-6 PICTURE X(6). IX1064.2 +021000 20 S-ALTKEY1-7-10 PICTURE X(4). IX1064.2 +021100 20 S-ALTKEY1-11-20 PICTURE X(10). IX1064.2 +021200 15 FILLER PICTURE X(9). IX1064.2 +021300 10 FILLER PICTURE X(9). IX1064.2 +021400 10 SQ-ALT-KEY2-AREA. IX1064.2 +021500 15 SQ-FS1-ALTKEY2. IX1064.2 +021600 20 SQ-FS1-ALTKEY2-1-10. IX1064.2 +021700 25 SQ-FS1-ALTKEY2-1-5 PICTURE X(5). IX1064.2 +021800 25 SQ-FS1-ALTKEY2-6-10 PICTURE X(5). IX1064.2 +021900 20 SQ-FS1-ALTKEY2-11-13 PICTURE X(3). IX1064.2 +022000 20 SQ-FS1-ALTKEY2-14-20 PICTURE X(7). IX1064.2 +022100 15 FILLER PICTURE X(9). IX1064.2 +022200 10 FILLER PICTURE X(8). IX1064.2 +022300 WORKING-STORAGE SECTION. IX1064.2 +022400 01 WRK-DS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. IX1064.2 +022500 01 WRK-DS-09V00-002 PIC 9(3) VALUE ZERO. IX1064.2 +022600 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. IX1064.2 +022700 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. IX1064.2 +022800 01 RL-KEY PIC 9(3). IX1064.2 +022900 01 RL-KEY2 PIC 9(3). IX1064.2 +023000* IX1064.2 +023100 01 WRK-FR1-RECKEY. IX1064.2 +023200 05 FR1-RECKEY-1-13. IX1064.2 +023300 10 FR1-RECKEY-1-10 PICTURE X(10). IX1064.2 +023400 10 FR1-RECKEY-11-13 PICTURE 9(3). IX1064.2 +023500 05 FILLER PICTURE X(16) VALUE SPACE. IX1064.2 +023600 01 WRK-FR1-ALTKEY1. IX1064.2 +023700 05 FR1-ALTKEY1-1-20. IX1064.2 +023800 10 FR1-ALTKEY1-1-10. IX1064.2 +023900 15 FR1-ALTKEY1-1-5 PICTURE X(5). IX1064.2 +024000 15 FR1-ALTKEY1-6-10 PICTURE X(5). IX1064.2 +024100 10 FR1-ALTKEY1-11-13 PICTURE 9(3). IX1064.2 +024200 10 FR1-ALTKEY1-14-20 PICTURE X(7). IX1064.2 +024300 05 FILLER PICTURE X(9) VALUE SPACE. IX1064.2 +024400 01 WRK-FR1-ALTKEY2. IX1064.2 +024500 05 FR1-ALTKEY2-1-20. IX1064.2 +024600 10 FR1-ALTKEY2-1-10. IX1064.2 +024700 15 FR1-ALTKEY2-1-5 PICTURE X(5). IX1064.2 +024800 15 FR1-ALTKEY2-6-10 PICTURE X(5). IX1064.2 +024900 10 FR1-ALTKEY2-11-13 PICTURE 9(3). IX1064.2 +025000 10 FR1-ALTKEY2-14-20 PICTURE X(7). IX1064.2 +025100 05 FILLER PICTURE X(9) VALUE SPACE. IX1064.2 +025200 01 RECNO PICTURE 9(5) VALUE ZERO. IX1064.2 +025300 01 FR1-STATUS PICTURE XX VALUE SPACE. IX1064.2 +025400 01 FS1-STATUS-IX PIC XX VALUE SPACE. IX1064.2 +025500 01 FS1-STATUS-SQ PIC XX VALUE SPACE. IX1064.2 +025600 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX1064.2 +025700 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX1064.2 +025800 01 INVKEY-COUNTER-RL PICTURE 9(3) COMPUTATIONAL. IX1064.2 +025900 01 INVKEY-COUNTER-IX PICTURE 9(3) COMPUTATIONAL. IX1064.2 +026000 01 RECORDS-WRITTEN PICTURE 9(3). IX1064.2 +026100 01 RECKEY-NUM PICTURE 9(3). IX1064.2 +026200 01 ALTKEY1-NUM PICTURE 9(3). IX1064.2 +026300 01 ALTKEY2-NUM PICTURE 9(3). IX1064.2 +026400 01 RECORD-KEY-CONTENT. IX1064.2 +026500 05 FILLER PIC X(53) VALUE IX1064.2 +026600 "BBBBBBBBBC225EEEEEEEEEF001ALTKEY1WWWWWWWWWV076ALTKEY2".IX1064.2 +026700 05 FILLER PIC X(53) VALUE IX1064.2 +026800 "BBBBBBBBCC224EEEEEEEEFF002ALTKEY1WWWWWWWWVV077ALTKEY2".IX1064.2 +026900 05 FILLER PIC X(53) VALUE IX1064.2 +027000 "BBBBBBBCCC223EEEEEEEFFF003ALTKEY1WWWWWWWVVV078ALTKEY2".IX1064.2 +027100 05 FILLER PIC X(53) VALUE IX1064.2 +027200 "BBBBBBCCCC222EEEEEEFFFF004ALTKEY1WWWWWWVVVV079ALTKEY2".IX1064.2 +027300 05 FILLER PIC X(53) VALUE IX1064.2 +027400 "BBBBBCCCCC221EEEEEFFFFF005ALTKEY1WWWWWVVVVV080ALTKEY2".IX1064.2 +027500 05 FILLER PIC X(53) VALUE IX1064.2 +027600 "BBBBCCCCCC220EEEEFFFFFF006ALTKEY1WWWWVVVVVV081ALTKEY2".IX1064.2 +027700 05 FILLER PIC X(53) VALUE IX1064.2 +027800 "BBBCCCCCCC219EEEFFFFFFF007ALTKEY1WWWVVVVVVV082ALTKEY2".IX1064.2 +027900 05 FILLER PIC X(53) VALUE IX1064.2 +028000 "BBCCCCCCCC218EEFFFFFFFF008ALTKEY1WWVVVVVVVV083ALTKEY2".IX1064.2 +028100 05 FILLER PIC X(53) VALUE IX1064.2 +028200 "BCCCCCCCCC217EFFFFFFFFF009ALTKEY1WVVVVVVVVV084ALTKEY2".IX1064.2 +028300 05 FILLER PIC X(53) VALUE IX1064.2 +028400 "CCCCCCCCCC216FFFFFFFFFF010ALTKEY1VVVVVVVVVV085ALTKEY2".IX1064.2 +028500 05 FILLER PIC X(53) VALUE IX1064.2 +028600 "CCCCCCCCCD215FFFFFFFFFG011ALTKEY1VVVVVVVVVV086ALTKEY2".IX1064.2 +028700 05 FILLER PIC X(53) VALUE IX1064.2 +028800 "CCCCCCCCDD214FFFFFFFFGG012ALTKEY1VVVVVVVVUU087ALTKEY2".IX1064.2 +028900 05 FILLER PIC X(53) VALUE IX1064.2 +029000 "CCCCCCCDDD213FFFFFFFGGG013ALTKEY1VVVVVVVUUU088ALTKEY2".IX1064.2 +029100 05 FILLER PIC X(53) VALUE IX1064.2 +029200 "CCCCCCDDDD212FFFFFFGGGG014ALTKEY1VVVVVVUUUU089ALTKEY2".IX1064.2 +029300 05 FILLER PIC X(53) VALUE IX1064.2 +029400 "CCCCCDDDDD211FFFFFGGGGG015ALTKEY1VVVVVUUUUU090ALTKEY2".IX1064.2 +029500 05 FILLER PIC X(53) VALUE IX1064.2 +029600 "CCCCDDDDDD210FFFFGGGGGG016ALTKEY1VVVVUUUUUU091ALTKEY2".IX1064.2 +029700 05 FILLER PIC X(53) VALUE IX1064.2 +029800 "CCCDDDDDDD209FFFGGGGGGG017ALTKEY1VVVUUUUUUU092ALTKEY2".IX1064.2 +029900 05 FILLER PIC X(53) VALUE IX1064.2 +030000 "CCDDDDDDDD208FFGGGGGGGG018ALTKEY1VVUUUUUUUU093ALTKEY2".IX1064.2 +030100 05 FILLER PIC X(53) VALUE IX1064.2 +030200 "CDDDDDDDDD207FGGGGGGGGG019ALTKEY1VUUUUUUUUU094ALTKEY2".IX1064.2 +030300 05 FILLER PIC X(53) VALUE IX1064.2 +030400 "DDDDDDDDDD206GGGGGGGGGG020ALTKEY1UUUUUUUUUU095ALTKEY2".IX1064.2 +030500 05 FILLER PIC X(53) VALUE IX1064.2 +030600 "DDDDDDDDDE205GGGGGGGGGH021ALTKEY1UUUUUUUUUU096ALTKEY2".IX1064.2 +030700 05 FILLER PIC X(53) VALUE IX1064.2 +030800 "DDDDDDDDEE204GGGGGGGGHH022ALTKEY1UUUUUUUUTT097ALTKEY2".IX1064.2 +030900 05 FILLER PIC X(53) VALUE IX1064.2 +031000 "DDDDDDDEEE203GGGGGGGHHH023ALTKEY1UUUUUUUTTT098ALTKEY2".IX1064.2 +031100 05 FILLER PIC X(53) VALUE IX1064.2 +031200 "DDDDDDEEEE202GGGGGGHHHH024ALTKEY1UUUUUUTTTT099ALTKEY2".IX1064.2 +031300 05 FILLER PIC X(53) VALUE IX1064.2 +031400 "DDDDDEEEEE201GGGGGHHHHH025ALTKEY1UUUUUTTTTT100ALTKEY2".IX1064.2 +031500 05 FILLER PIC X(53) VALUE IX1064.2 +031600 "DDDDEEEEEE200GGGGHHHHHH026ALTKEY1UUUUTTTTTT101ALTKEY2".IX1064.2 +031700 05 FILLER PIC X(53) VALUE IX1064.2 +031800 "DDDEEEEEEE199GGGHHHHHHH027ALTKEY1UUUTTTTTTT102ALTKEY2".IX1064.2 +031900 05 FILLER PIC X(53) VALUE IX1064.2 +032000 "DDEEEEEEEE198GGHHHHHHHH028ALTKEY1UUTTTTTTTT103ALTKEY2".IX1064.2 +032100 05 FILLER PIC X(53) VALUE IX1064.2 +032200 "DEEEEEEEEE197GHHHHHHHHH029ALTKEY1UTTTTTTTTT104ALTKEY2".IX1064.2 +032300 05 FILLER PIC X(53) VALUE IX1064.2 +032400 "EEEEEEEEEE196HHHHHHHHHH030ALTKEY1TTTTTTTTTT105ALTKEY2".IX1064.2 +032500 05 FILLER PIC X(53) VALUE IX1064.2 +032600 "EEEEEEEEEF195HHHHHHHHHI031ALTKEY1TTTTTTTTTT106ALTKEY2".IX1064.2 +032700 05 FILLER PIC X(53) VALUE IX1064.2 +032800 "EEEEEEEEFF194HHHHHHHHII032ALTKEY1TTTTTTTTSS107ALTKEY2".IX1064.2 +032900 05 FILLER PIC X(53) VALUE IX1064.2 +033000 "EEEEEEEFFF193HHHHHHHIII033ALTKEY1TTTTTTTSSS108ALTKEY2".IX1064.2 +033100 05 FILLER PIC X(53) VALUE IX1064.2 +033200 "EEEEEEFFFF192HHHHHHIIII034ALTKEY1TTTTTTSSSS109ALTKEY2".IX1064.2 +033300 05 FILLER PIC X(53) VALUE IX1064.2 +033400 "EEEEEFFFFF191HHHHHIIIII035ALTKEY1TTTTTSSSSS110ALTKEY2".IX1064.2 +033500 05 FILLER PIC X(53) VALUE IX1064.2 +033600 "EEEEFFFFFF190HHHHIIIIII036ALTKEY1TTTTSSSSSS111ALTKEY2".IX1064.2 +033700 05 FILLER PIC X(53) VALUE IX1064.2 +033800 "EEEFFFFFFF189HHHIIIIIII037ALTKEY1TTTSSSSSSS112ALTKEY2".IX1064.2 +033900 05 FILLER PIC X(53) VALUE IX1064.2 +034000 "EEFFFFFFFF188HHIIIIIIII038ALTKEY1TTSSSSSSSS113ALTKEY2".IX1064.2 +034100 05 FILLER PIC X(53) VALUE IX1064.2 +034200 "EFFFFFFFFF187HIIIIIIIII039ALTKEY1TSSSSSSSSS114ALTKEY2".IX1064.2 +034300 05 FILLER PIC X(53) VALUE IX1064.2 +034400 "FFFFFFFFFF186IIIIIIIIII040ALTKEY1SSSSSSSSSS115ALTKEY2".IX1064.2 +034500 05 FILLER PIC X(53) VALUE IX1064.2 +034600 "FFFFFFFFFG185IIIIIIIIIJ041ALTKEY1SSSSSSSSSS116ALTKEY2".IX1064.2 +034700 05 FILLER PIC X(53) VALUE IX1064.2 +034800 "FFFFFFFFGG184IIIIIIIIJJ042ALTKEY1SSSSSSSSRR117ALTKEY2".IX1064.2 +034900 05 FILLER PIC X(53) VALUE IX1064.2 +035000 "FFFFFFFGGG183IIIIIIIJJJ043ALTKEY1SSSSSSSRRR118ALTKEY2".IX1064.2 +035100 05 FILLER PIC X(53) VALUE IX1064.2 +035200 "FFFFFFGGGG182IIIIIIJJJJ044ALTKEY1SSSSSSRRRR119ALTKEY2".IX1064.2 +035300 05 FILLER PIC X(53) VALUE IX1064.2 +035400 "FFFFFGGGGG181IIIIIJJJJJ045ALTKEY1SSSSSRRRRR120ALTKEY2".IX1064.2 +035500 05 FILLER PIC X(53) VALUE IX1064.2 +035600 "FFFFGGGGGG180IIIIJJJJJJ046ALTKEY1SSSSRRRRRR121ALTKEY2".IX1064.2 +035700 05 FILLER PIC X(53) VALUE IX1064.2 +035800 "FFFGGGGGGG179IIIJJJJJJJ047ALTKEY1SSSRRRRRRR122ALTKEY2".IX1064.2 +035900 05 FILLER PIC X(53) VALUE IX1064.2 +036000 "FFGGGGGGGG178IIJJJJJJJJ048ALTKEY1SSRRRRRRRR123ALTKEY2".IX1064.2 +036100 05 FILLER PIC X(53) VALUE IX1064.2 +036200 "FGGGGGGGGG177IJJJJJJJJJ049ALTKEY1SRRRRRRRRR124ALTKEY2".IX1064.2 +036300 05 FILLER PIC X(53) VALUE IX1064.2 +036400 "GGGGGGGGGG176JJJJJJJJJJ050ALTKEY1RRRRRRRRRR125ALTKEY2".IX1064.2 +036500 05 FILLER PIC X(53) VALUE IX1064.2 +036600 "RRRRSSSSSS175VVVVWWWWWW051ALTKEY1GGGGFFFFFF126ALTKEY2".IX1064.2 +036700 05 FILLER PIC X(53) VALUE IX1064.2 +036800 "RRRSSSSSSS174VVVWWWWWWW052ALTKEY1GGGFFFFFFF127ALTKEY2".IX1064.2 +036900 05 FILLER PIC X(53) VALUE IX1064.2 +037000 "RRSSSSSSSS173VVWWWWWWWW053ALTKEY1GGFFFFFFFF128ALTKEY2".IX1064.2 +037100 05 FILLER PIC X(53) VALUE IX1064.2 +037200 "RSSSSSSSSS172VWWWWWWWWW054ALTKEY1GFFFFFFFFF129ALTKEY2".IX1064.2 +037300 05 FILLER PIC X(53) VALUE IX1064.2 +037400 "SSSSSSSSSS171WWWWWWWWWW055ALTKEY1FFFFFFFFFF130ALTKEY2".IX1064.2 +037500 05 FILLER PIC X(53) VALUE IX1064.2 +037600 "SSSSSSSSST170WWWWWWWWWX056ALTKEY1FFFFFFFFFF131ALTKEY2".IX1064.2 +037700 05 FILLER PIC X(53) VALUE IX1064.2 +037800 "SSSSSSSSTT169WWWWWWWWXX057ALTKEY1FFFFFFFFEE132ALTKEY2".IX1064.2 +037900 05 FILLER PIC X(53) VALUE IX1064.2 +038000 "SSSSSSSTTT168WWWWWWWXXX058ALTKEY1FFFFFFFEEE133ALTKEY2".IX1064.2 +038100 05 FILLER PIC X(53) VALUE IX1064.2 +038200 "SSSSSSTTTT167WWWWWWXXXX059ALTKEY1FFFFFFEEEE134ALTKEY2".IX1064.2 +038300 05 FILLER PIC X(53) VALUE IX1064.2 +038400 "SSSSSTTTTT166WWWWWXXXXX060ALTKEY1FFFFFEEEEE135ALTKEY2".IX1064.2 +038500 05 FILLER PIC X(53) VALUE IX1064.2 +038600 "SSSSTTTTTT165WWWWXXXXXX061ALTKEY1FFFFEEEEEE136ALTKEY2".IX1064.2 +038700 05 FILLER PIC X(53) VALUE IX1064.2 +038800 "SSSTTTTTTT164WWWXXXXXXX062ALTKEY1FFFEEEEEEE137ALTKEY2".IX1064.2 +038900 05 FILLER PIC X(53) VALUE IX1064.2 +039000 "SSTTTTTTTT163WWXXXXXXXX063ALTKEY1FFEEEEEEEE138ALTKEY2".IX1064.2 +039100 05 FILLER PIC X(53) VALUE IX1064.2 +039200 "STTTTTTTTT162WXXXXXXXXX064ALTKEY1FEEEEEEEEE139ALTKEY2".IX1064.2 +039300 05 FILLER PIC X(53) VALUE IX1064.2 +039400 "TTTTTTTTTT161XXXXXXXXXX065ALTKEY1EEEEEEEEEE140ALTKEY2".IX1064.2 +039500 05 FILLER PIC X(53) VALUE IX1064.2 +039600 "TTTTTTTTTU160XXXXXXXXXY066ALTKEY1EEEEEEEEEE141ALTKEY2".IX1064.2 +039700 05 FILLER PIC X(53) VALUE IX1064.2 +039800 "TTTTTTTTUU159XXXXXXXXYY067ALTKEY1EEEEEEEEDD142ALTKEY2".IX1064.2 +039900 05 FILLER PIC X(53) VALUE IX1064.2 +040000 "TTTTTTTUUU158XXXXXXXYYY068ALTKEY1EEEEEEEDDD143ALTKEY2".IX1064.2 +040100 05 FILLER PIC X(53) VALUE IX1064.2 +040200 "TTTTTTUUUU157XXXXXXYYYY069ALTKEY1EEEEEEDDDD144ALTKEY2".IX1064.2 +040300 05 FILLER PIC X(53) VALUE IX1064.2 +040400 "TTTTTUUUUU156XXXXXYYYYY070ALTKEY1EEEEEDDDDD145ALTKEY2".IX1064.2 +040500 05 FILLER PIC X(53) VALUE IX1064.2 +040600 "TTTTUUUUUU155XXXXYYYYYY071ALTKEY1EEEEDDDDDD146ALTKEY2".IX1064.2 +040700 05 FILLER PIC X(53) VALUE IX1064.2 +040800 "TTTUUUUUUU154XXXYYYYYYY072ALTKEY1EEEDDDDDDD147ALTKEY2".IX1064.2 +040900 05 FILLER PIC X(53) VALUE IX1064.2 +041000 "TTUUUUUUUU153XXYYYYYYYY073ALTKEY1EEDDDDDDDD148ALTKEY2".IX1064.2 +041100 05 FILLER PIC X(53) VALUE IX1064.2 +041200 "TUUUUUUUUU152XYYYYYYYYY074ALTKEY1EDDDDDDDDD149ALTKEY2".IX1064.2 +041300 05 FILLER PIC X(53) VALUE IX1064.2 +041400 "UUUUUUUUUU151YYYYYYYYYY075ALTKEY1DDDDDDDDDD150ALTKEY2".IX1064.2 +041500 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX1064.2 +041600 05 KEY-VALUES OCCURS 75 TIMES. IX1064.2 +041700 10 RECKEY-VALUE PICTURE X(13). IX1064.2 +041800 10 ALTKEY1-VALUE PICTURE X(20). IX1064.2 +041900 10 ALTKEY2-VALUE PICTURE X(20). IX1064.2 +042000 01 INIT-FLAG PICTURE 9. IX1064.2 +042100 01 HOLD-FILESTATUS-RECORD. IX1064.2 +042200 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX1064.2 +042300 IX1064.2 +042400 01 FILE-RECORD-INFORMATION-REC. IX1064.2 +042500 03 FILE-RECORD-INFO-SKELETON. IX1064.2 +042600 05 FILLER PICTURE X(48) VALUE IX1064.2 +042700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1064.2 +042800 05 FILLER PICTURE X(46) VALUE IX1064.2 +042900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1064.2 +043000 05 FILLER PICTURE X(26) VALUE IX1064.2 +043100 ",LFIL=000000,ORG= ,LBLR= ". IX1064.2 +043200 05 FILLER PICTURE X(37) VALUE IX1064.2 +043300 ",RECKEY= ". IX1064.2 +043400 05 FILLER PICTURE X(38) VALUE IX1064.2 +043500 ",ALTKEY1= ". IX1064.2 +043600 05 FILLER PICTURE X(38) VALUE IX1064.2 +043700 ",ALTKEY2= ". IX1064.2 +043800 05 FILLER PICTURE X(7) VALUE SPACE.IX1064.2 +043900 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1064.2 +044000 05 FILE-RECORD-INFO-P1-120. IX1064.2 +044100 07 FILLER PIC X(5). IX1064.2 +044200 07 XFILE-NAME PIC X(6). IX1064.2 +044300 07 FILLER PIC X(8). IX1064.2 +044400 07 XRECORD-NAME PIC X(6). IX1064.2 +044500 07 FILLER PIC X(1). IX1064.2 +044600 07 REELUNIT-NUMBER PIC 9(1). IX1064.2 +044700 07 FILLER PIC X(7). IX1064.2 +044800 07 XRECORD-NUMBER PIC 9(6). IX1064.2 +044900 07 FILLER PIC X(6). IX1064.2 +045000 07 UPDATE-NUMBER PIC 9(2). IX1064.2 +045100 07 FILLER PIC X(5). IX1064.2 +045200 07 ODO-NUMBER PIC 9(4). IX1064.2 +045300 07 FILLER PIC X(5). IX1064.2 +045400 07 XPROGRAM-NAME PIC X(5). IX1064.2 +045500 07 FILLER PIC X(7). IX1064.2 +045600 07 XRECORD-LENGTH PIC 9(6). IX1064.2 +045700 07 FILLER PIC X(7). IX1064.2 +045800 07 CHARS-OR-RECORDS PIC X(2). IX1064.2 +045900 07 FILLER PIC X(1). IX1064.2 +046000 07 XBLOCK-SIZE PIC 9(4). IX1064.2 +046100 07 FILLER PIC X(6). IX1064.2 +046200 07 RECORDS-IN-FILE PIC 9(6). IX1064.2 +046300 07 FILLER PIC X(5). IX1064.2 +046400 07 XFILE-ORGANIZATION PIC X(2). IX1064.2 +046500 07 FILLER PIC X(6). IX1064.2 +046600 07 XLABEL-TYPE PIC X(1). IX1064.2 +046700 05 FILE-RECORD-INFO-P121-240. IX1064.2 +046800 07 FILLER PIC X(8). IX1064.2 +046900 07 XRECORD-KEY PIC X(29). IX1064.2 +047000 07 FILLER PIC X(9). IX1064.2 +047100 07 ALTERNATE-KEY1 PIC X(29). IX1064.2 +047200 07 FILLER PIC X(9). IX1064.2 +047300 07 ALTERNATE-KEY2 PIC X(29). IX1064.2 +047400 07 FILLER PIC X(7). IX1064.2 +047500 IX1064.2 +047600 01 TEST-RESULTS. IX1064.2 +047700 02 FILLER PIC X VALUE SPACE. IX1064.2 +047800 02 FEATURE PIC X(20) VALUE SPACE. IX1064.2 +047900 02 FILLER PIC X VALUE SPACE. IX1064.2 +048000 02 P-OR-F PIC X(5) VALUE SPACE. IX1064.2 +048100 02 FILLER PIC X VALUE SPACE. IX1064.2 +048200 02 PAR-NAME. IX1064.2 +048300 03 FILLER PIC X(19) VALUE SPACE. IX1064.2 +048400 03 PARDOT-X PIC X VALUE SPACE. IX1064.2 +048500 03 DOTVALUE PIC 99 VALUE ZERO. IX1064.2 +048600 02 FILLER PIC X(8) VALUE SPACE. IX1064.2 +048700 02 RE-MARK PIC X(61). IX1064.2 +048800 01 TEST-COMPUTED. IX1064.2 +048900 02 FILLER PIC X(30) VALUE SPACE. IX1064.2 +049000 02 FILLER PIC X(17) VALUE IX1064.2 +049100 " COMPUTED=". IX1064.2 +049200 02 COMPUTED-X. IX1064.2 +049300 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1064.2 +049400 03 COMPUTED-N REDEFINES COMPUTED-A IX1064.2 +049500 PIC -9(9).9(9). IX1064.2 +049600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1064.2 +049700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1064.2 +049800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1064.2 +049900 03 CM-18V0 REDEFINES COMPUTED-A. IX1064.2 +050000 04 COMPUTED-18V0 PIC -9(18). IX1064.2 +050100 04 FILLER PIC X. IX1064.2 +050200 03 FILLER PIC X(50) VALUE SPACE. IX1064.2 +050300 01 TEST-CORRECT. IX1064.2 +050400 02 FILLER PIC X(30) VALUE SPACE. IX1064.2 +050500 02 FILLER PIC X(17) VALUE " CORRECT =". IX1064.2 +050600 02 CORRECT-X. IX1064.2 +050700 03 CORRECT-A PIC X(20) VALUE SPACE. IX1064.2 +050800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1064.2 +050900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1064.2 +051000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1064.2 +051100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1064.2 +051200 03 CR-18V0 REDEFINES CORRECT-A. IX1064.2 +051300 04 CORRECT-18V0 PIC -9(18). IX1064.2 +051400 04 FILLER PIC X. IX1064.2 +051500 03 FILLER PIC X(2) VALUE SPACE. IX1064.2 +051600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1064.2 +051700 01 CCVS-C-1. IX1064.2 +051800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1064.2 +051900- "SS PARAGRAPH-NAME IX1064.2 +052000- " REMARKS". IX1064.2 +052100 02 FILLER PIC X(20) VALUE SPACE. IX1064.2 +052200 01 CCVS-C-2. IX1064.2 +052300 02 FILLER PIC X VALUE SPACE. IX1064.2 +052400 02 FILLER PIC X(6) VALUE "TESTED". IX1064.2 +052500 02 FILLER PIC X(15) VALUE SPACE. IX1064.2 +052600 02 FILLER PIC X(4) VALUE "FAIL". IX1064.2 +052700 02 FILLER PIC X(94) VALUE SPACE. IX1064.2 +052800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1064.2 +052900 01 REC-CT PIC 99 VALUE ZERO. IX1064.2 +053000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1064.2 +053100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1064.2 +053200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1064.2 +053300 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1064.2 +053400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1064.2 +053500 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1064.2 +053600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1064.2 +053700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1064.2 +053800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1064.2 +053900 01 CCVS-H-1. IX1064.2 +054000 02 FILLER PIC X(39) VALUE SPACES. IX1064.2 +054100 02 FILLER PIC X(42) VALUE IX1064.2 +054200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1064.2 +054300 02 FILLER PIC X(39) VALUE SPACES. IX1064.2 +054400 01 CCVS-H-2A. IX1064.2 +054500 02 FILLER PIC X(40) VALUE SPACE. IX1064.2 +054600 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1064.2 +054700 02 FILLER PIC XXXX VALUE IX1064.2 +054800 "4.2 ". IX1064.2 +054900 02 FILLER PIC X(28) VALUE IX1064.2 +055000 " COPY - NOT FOR DISTRIBUTION". IX1064.2 +055100 02 FILLER PIC X(41) VALUE SPACE. IX1064.2 +055200 IX1064.2 +055300 01 CCVS-H-2B. IX1064.2 +055400 02 FILLER PIC X(15) VALUE IX1064.2 +055500 "TEST RESULT OF ". IX1064.2 +055600 02 TEST-ID PIC X(9). IX1064.2 +055700 02 FILLER PIC X(4) VALUE IX1064.2 +055800 " IN ". IX1064.2 +055900 02 FILLER PIC X(12) VALUE IX1064.2 +056000 " HIGH ". IX1064.2 +056100 02 FILLER PIC X(22) VALUE IX1064.2 +056200 " LEVEL VALIDATION FOR ". IX1064.2 +056300 02 FILLER PIC X(58) VALUE IX1064.2 +056400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1064.2 +056500 01 CCVS-H-3. IX1064.2 +056600 02 FILLER PIC X(34) VALUE IX1064.2 +056700 " FOR OFFICIAL USE ONLY ". IX1064.2 +056800 02 FILLER PIC X(58) VALUE IX1064.2 +056900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1064.2 +057000 02 FILLER PIC X(28) VALUE IX1064.2 +057100 " COPYRIGHT 1985 ". IX1064.2 +057200 01 CCVS-E-1. IX1064.2 +057300 02 FILLER PIC X(52) VALUE SPACE. IX1064.2 +057400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1064.2 +057500 02 ID-AGAIN PIC X(9). IX1064.2 +057600 02 FILLER PIC X(45) VALUE SPACES. IX1064.2 +057700 01 CCVS-E-2. IX1064.2 +057800 02 FILLER PIC X(31) VALUE SPACE. IX1064.2 +057900 02 FILLER PIC X(21) VALUE SPACE. IX1064.2 +058000 02 CCVS-E-2-2. IX1064.2 +058100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1064.2 +058200 03 FILLER PIC X VALUE SPACE. IX1064.2 +058300 03 ENDER-DESC PIC X(44) VALUE IX1064.2 +058400 "ERRORS ENCOUNTERED". IX1064.2 +058500 01 CCVS-E-3. IX1064.2 +058600 02 FILLER PIC X(22) VALUE IX1064.2 +058700 " FOR OFFICIAL USE ONLY". IX1064.2 +058800 02 FILLER PIC X(12) VALUE SPACE. IX1064.2 +058900 02 FILLER PIC X(58) VALUE IX1064.2 +059000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1064.2 +059100 02 FILLER PIC X(13) VALUE SPACE. IX1064.2 +059200 02 FILLER PIC X(15) VALUE IX1064.2 +059300 " COPYRIGHT 1985". IX1064.2 +059400 01 CCVS-E-4. IX1064.2 +059500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1064.2 +059600 02 FILLER PIC X(4) VALUE " OF ". IX1064.2 +059700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1064.2 +059800 02 FILLER PIC X(40) VALUE IX1064.2 +059900 " TESTS WERE EXECUTED SUCCESSFULLY". IX1064.2 +060000 01 XXINFO. IX1064.2 +060100 02 FILLER PIC X(19) VALUE IX1064.2 +060200 "*** INFORMATION ***". IX1064.2 +060300 02 INFO-TEXT. IX1064.2 +060400 04 FILLER PIC X(8) VALUE SPACE. IX1064.2 +060500 04 XXCOMPUTED PIC X(20). IX1064.2 +060600 04 FILLER PIC X(5) VALUE SPACE. IX1064.2 +060700 04 XXCORRECT PIC X(20). IX1064.2 +060800 02 INF-ANSI-REFERENCE PIC X(48). IX1064.2 +060900 01 HYPHEN-LINE. IX1064.2 +061000 02 FILLER PIC IS X VALUE IS SPACE. IX1064.2 +061100 02 FILLER PIC IS X(65) VALUE IS "************************IX1064.2 +061200- "*****************************************". IX1064.2 +061300 02 FILLER PIC IS X(54) VALUE IS "************************IX1064.2 +061400- "******************************". IX1064.2 +061500 01 CCVS-PGM-ID PIC X(9) VALUE IX1064.2 +061600 "IX106A". IX1064.2 +061700 PROCEDURE DIVISION. IX1064.2 +061800 CCVS1 SECTION. IX1064.2 +061900 OPEN-FILES. IX1064.2 +062000*P OPEN I-O RAW-DATA. IX1064.2 +062100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1064.2 +062200*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1064.2 +062300*P MOVE "ABORTED " TO C-ABORT. IX1064.2 +062400*P ADD 1 TO C-NO-OF-TESTS. IX1064.2 +062500*P ACCEPT C-DATE FROM DATE. IX1064.2 +062600*P ACCEPT C-TIME FROM TIME. IX1064.2 +062700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1064.2 +062800*PND-E-1. IX1064.2 +062900*P CLOSE RAW-DATA. IX1064.2 +063000 OPEN OUTPUT PRINT-FILE. IX1064.2 +063100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1064.2 +063200 MOVE SPACE TO TEST-RESULTS. IX1064.2 +063300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1064.2 +063400 MOVE ZERO TO REC-SKL-SUB. IX1064.2 +063500 PERFORM CCVS-INIT-FILE 9 TIMES. IX1064.2 +063600 CCVS-INIT-FILE. IX1064.2 +063700 ADD 1 TO REC-SKL-SUB. IX1064.2 +063800 MOVE FILE-RECORD-INFO-SKELETON IX1064.2 +063900 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1064.2 +064000 CCVS-INIT-EXIT. IX1064.2 +064100 GO TO CCVS1-EXIT. IX1064.2 +064200 CLOSE-FILES. IX1064.2 +064300*P OPEN I-O RAW-DATA. IX1064.2 +064400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1064.2 +064500*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1064.2 +064600*P MOVE "OK. " TO C-ABORT. IX1064.2 +064700*P MOVE PASS-COUNTER TO C-OK. IX1064.2 +064800*P MOVE ERROR-HOLD TO C-ALL. IX1064.2 +064900*P MOVE ERROR-COUNTER TO C-FAIL. IX1064.2 +065000*P MOVE DELETE-COUNTER TO C-DELETED. IX1064.2 +065100*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1064.2 +065200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1064.2 +065300*PND-E-2. IX1064.2 +065400*P CLOSE RAW-DATA. IX1064.2 +065500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1064.2 +065600 TERMINATE-CCVS. IX1064.2 +065700*S EXIT PROGRAM. IX1064.2 +065800*SERMINATE-CALL. IX1064.2 +065900 STOP RUN. IX1064.2 +066000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1064.2 +066100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1064.2 +066200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1064.2 +066300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1064.2 +066400 MOVE "****TEST DELETED****" TO RE-MARK. IX1064.2 +066500 PRINT-DETAIL. IX1064.2 +066600 IF REC-CT NOT EQUAL TO ZERO IX1064.2 +066700 MOVE "." TO PARDOT-X IX1064.2 +066800 MOVE REC-CT TO DOTVALUE. IX1064.2 +066900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1064.2 +067000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1064.2 +067100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1064.2 +067200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1064.2 +067300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1064.2 +067400 MOVE SPACE TO CORRECT-X. IX1064.2 +067500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1064.2 +067600 MOVE SPACE TO RE-MARK. IX1064.2 +067700 HEAD-ROUTINE. IX1064.2 +067800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +067900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +068000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1064.2 +068100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1064.2 +068200 COLUMN-NAMES-ROUTINE. IX1064.2 +068300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +068400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +068500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +068600 END-ROUTINE. IX1064.2 +068700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1064.2 +068800 END-RTN-EXIT. IX1064.2 +068900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +069000 END-ROUTINE-1. IX1064.2 +069100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1064.2 +069200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1064.2 +069300 ADD PASS-COUNTER TO ERROR-HOLD. IX1064.2 +069400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1064.2 +069500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1064.2 +069600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1064.2 +069700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1064.2 +069800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1064.2 +069900 END-ROUTINE-12. IX1064.2 +070000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1064.2 +070100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1064.2 +070200 MOVE "NO " TO ERROR-TOTAL IX1064.2 +070300 ELSE IX1064.2 +070400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1064.2 +070500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1064.2 +070600 PERFORM WRITE-LINE. IX1064.2 +070700 END-ROUTINE-13. IX1064.2 +070800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1064.2 +070900 MOVE "NO " TO ERROR-TOTAL ELSE IX1064.2 +071000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1064.2 +071100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1064.2 +071200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +071300 IF INSPECT-COUNTER EQUAL TO ZERO IX1064.2 +071400 MOVE "NO " TO ERROR-TOTAL IX1064.2 +071500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1064.2 +071600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1064.2 +071700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +071800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1064.2 +071900 WRITE-LINE. IX1064.2 +072000 ADD 1 TO RECORD-COUNT. IX1064.2 +072100 IF RECORD-COUNT GREATER 42 IX1064.2 +072200 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1064.2 +072300 MOVE SPACE TO DUMMY-RECORD IX1064.2 +072400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1064.2 +072500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1064.2 +072600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1064.2 +072700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1064.2 +072800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1064.2 +072900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1064.2 +073000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1064.2 +073100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1064.2 +073200 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1064.2 +073300 MOVE ZERO TO RECORD-COUNT. IX1064.2 +073400 PERFORM WRT-LN. IX1064.2 +073500 WRT-LN. IX1064.2 +073600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1064.2 +073700 MOVE SPACE TO DUMMY-RECORD. IX1064.2 +073800 BLANK-LINE-PRINT. IX1064.2 +073900 PERFORM WRT-LN. IX1064.2 +074000 FAIL-ROUTINE. IX1064.2 +074100 IF COMPUTED-X NOT EQUAL TO SPACE IX1064.2 +074200 GO TO FAIL-ROUTINE-WRITE. IX1064.2 +074300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1064.2 +074400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1064.2 +074500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1064.2 +074600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +074700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1064.2 +074800 GO TO FAIL-ROUTINE-EX. IX1064.2 +074900 FAIL-ROUTINE-WRITE. IX1064.2 +075000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1064.2 +075100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1064.2 +075200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1064.2 +075300 MOVE SPACES TO COR-ANSI-REFERENCE. IX1064.2 +075400 FAIL-ROUTINE-EX. EXIT. IX1064.2 +075500 BAIL-OUT. IX1064.2 +075600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1064.2 +075700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1064.2 +075800 BAIL-OUT-WRITE. IX1064.2 +075900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1064.2 +076000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1064.2 +076100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1064.2 +076200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1064.2 +076300 BAIL-OUT-EX. EXIT. IX1064.2 +076400 CCVS1-EXIT. IX1064.2 +076500 EXIT. IX1064.2 +076600******************************************************************IX1064.2 +076700 SECT-0001-RIS101 SECTION. IX1064.2 +076800* IX1064.2 +076900* THIS SECTION CREATES A RELATIVE FILE RANDOMLY. IX1064.2 +077000* IX1064.2 +077100 WRITE-INT-GF-01. IX1064.2 +077200 OPEN OUTPUT RL-FR1. IX1064.2 +077300 MOVE "RL-FR1" TO XFILE-NAME (1). IX1064.2 +077400 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1064.2 +077500 MOVE ZERO TO XRECORD-NUMBER (1). IX1064.2 +077600 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1064.2 +077700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1064.2 +077800 MOVE 241 TO XRECORD-LENGTH (1). IX1064.2 +077900 MOVE 001 TO XBLOCK-SIZE (1). IX1064.2 +078000 MOVE "RL" TO XFILE-ORGANIZATION (1). IX1064.2 +078100 MOVE "S" TO XLABEL-TYPE (1). IX1064.2 +078200 MOVE 225 TO RECORDS-IN-FILE (1). IX1064.2 +078300 MOVE "WRITE RL-FR1 " TO FEATURE. IX1064.2 +078400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1064.2 +078500 MOVE ZERO TO KEYSUB. IX1064.2 +078600 MOVE ZERO TO INVKEY-COUNTER-RL. IX1064.2 +078700 WRITE-INIT-GF-01-01. IX1064.2 +078800 PERFORM WRITE-TEST-GF-01-R1 75 TIMES. IX1064.2 +078900 GO TO WRITE-TEST-GF-01. IX1064.2 +079000 WRITE-TEST-GF-01-R1. IX1064.2 +079100* IX1064.2 +079200* WRITE-TEST-GF-01-R1 - WRITES THREE RECORDS FOR EACH PASS THRU . IX1064.2 +079300* 1) FOR THE FIRST RECORD CREATED RL-KEY IS IX1064.2 +079400* SET TO FR1-RECKEY-11-13 . IX1064.2 +079500* 2) FOR THE SECOND RECORD CREATED RL-KEY IS IX1064.2 +079600* SET TO FR1-ALTKEY1-11-13 . IX1064.2 +079700* 3) FOR THE THIRD RECORD CREATED RL-KEY IS IX1064.2 +079800* SET TO FR1-ALTKEY2-11-13 . IX1064.2 +079900* THESE RECORD KEYS ARE IN THREE DIFFERENT IX1064.2 +080000* ORDERINGS. IX1064.2 +080100* 1) FR1-RECKEY-11-13 ARE THE NUMBERS FROM IX1064.2 +080200* 225 TO 151 DECENDING . IX1064.2 +080300* 2) FR1-ALTKEY1-11-13 ARE THE NUMBERS FROM IX1064.2 +080400* 1 TO 75 ASCENDING . IX1064.2 +080500* 3) FR1-ALTKEY-11-13 ARE THE NUMBERS FROM IX1064.2 +080600* 76 TO 151 ASCENDING . IX1064.2 +080700* IX1064.2 +080800 ADD 001 TO XRECORD-NUMBER (1). IX1064.2 +080900 ADD 001 TO KEYSUB. IX1064.2 +081000 MOVE RECKEY-VALUE (KEYSUB) TO FR1-RECKEY-1-13. IX1064.2 +081100 MOVE ALTKEY1-VALUE (KEYSUB) TO FR1-ALTKEY1-1-20. IX1064.2 +081200 MOVE ALTKEY2-VALUE (KEYSUB) TO FR1-ALTKEY2-1-20. IX1064.2 +081300 MOVE WRK-FR1-RECKEY TO XRECORD-KEY (1). IX1064.2 +081400 MOVE WRK-FR1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX1064.2 +081500 MOVE WRK-FR1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX1064.2 +081600 MOVE FILE-RECORD-INFO (1) TO RL-FR1R1-F-G-241. IX1064.2 +081700 MOVE FR1-RECKEY-11-13 TO RL-KEY. IX1064.2 +081800 WRITE RL-FR1R1-F-G-241 IX1064.2 +081900 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +082000 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +082100 ADD 001 TO XRECORD-NUMBER (1). IX1064.2 +082200 MOVE FR1-ALTKEY1-11-13 TO FR1-RECKEY-11-13. IX1064.2 +082300 MOVE WRK-FR1-RECKEY TO XRECORD-KEY (1). IX1064.2 +082400 MOVE FR1-RECKEY-11-13 TO RL-KEY. IX1064.2 +082500 MOVE FILE-RECORD-INFO (1) TO RL-FR1R1-F-G-241. IX1064.2 +082600 WRITE RL-FR1R1-F-G-241 IX1064.2 +082700 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +082800 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +082900 ADD 001 TO XRECORD-NUMBER (1). IX1064.2 +083000 MOVE FR1-ALTKEY2-11-13 TO FR1-RECKEY-11-13. IX1064.2 +083100 MOVE WRK-FR1-RECKEY TO XRECORD-KEY (1). IX1064.2 +083200 MOVE FR1-RECKEY-11-13 TO RL-KEY. IX1064.2 +083300 MOVE FILE-RECORD-INFO (1) TO RL-FR1R1-F-G-241. IX1064.2 +083400 WRITE RL-FR1R1-F-G-241 IX1064.2 +083500 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +083600 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +083700 WRITE-TEST-GF-01. IX1064.2 +083800 SUBTRACT INVKEY-COUNTER-RL FROM EXCUT-COUNTER-06V00 IX1064.2 +083900 GIVING RECORDS-WRITTEN. IX1064.2 +084000 WRITE-TEST-CHECK. IX1064.2 +084100 MOVE 225 TO CORRECT-18V0. IX1064.2 +084200 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX1064.2 +084300 IF RECORDS-WRITTEN EQUAL TO 225 IX1064.2 +084400 PERFORM PASS IX1064.2 +084500 ELSE IX1064.2 +084600 MOVE "VIII-37 4.9.2 " TO RE-MARK IX1064.2 +084700 PERFORM FAIL. IX1064.2 +084800 PERFORM PRINT-DETAIL. IX1064.2 +084900 WRITE-TEST-GF-01-END. IX1064.2 +085000 CLOSE RL-FR1. IX1064.2 +085100******************************************************************IX1064.2 +085200 SECT-0002-RIS101 SECTION. IX1064.2 +085300* IX1064.2 +085400* THIS SECTION CREATES A SEQUENTIAL AND AN INDEXED FILE USING THE IX1064.2 +085500* RELATIVE FILE CREATED IN THE PREVIOUS SECTION AS INPUT . IX1064.2 +085600* IX1064.2 +085700 WRITE-INIT-GF-02. IX1064.2 +085800 OPEN OUTPUT IX-FS1 SQ-FS1. IX1064.2 +085900 OPEN INPUT RL-FR1. IX1064.2 +086000 MOVE ZERO TO RL-KEY. IX1064.2 +086100 MOVE ZERO TO INVKEY-COUNTER-RL. IX1064.2 +086200 MOVE ZERO TO INVKEY-COUNTER-IX. IX1064.2 +086300 MOVE ZERO TO EXCUT-COUNTER-06V00. IX1064.2 +086400 PERFORM WRITE-TEST-GF-02-01 75 TIMES. IX1064.2 +086500 PERFORM WRITE-TEST-GF-02-02 75 TIMES. IX1064.2 +086600 PERFORM WRITE-TEST-GF-02-03 75 TIMES. IX1064.2 +086700 GO TO WRITE-TEST-GF-02-END. IX1064.2 +086800 WRITE-INT-GF-02-IX. IX1064.2 +086900 MOVE "WRITE IX-FS1 " TO FEATURE. IX1064.2 +087000 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +087100 WRITE-INT-GF-02-SQ. IX1064.2 +087200 MOVE "WRITE SQ-FS1 " TO FEATURE. IX1064.2 +087300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +087400 WRITE-TEST-GF-02-01. IX1064.2 +087500* IX1064.2 +087600* WRITE-TEST-GF-02-01 - READS IN THE RELATIVE FILE IN SEQUENCE , IX1064.2 +087700* MOVES RL-FR1-ALTKEY1-11-13 TO IX1064.2 +087800* RL-FR1-ALTKEY2-11-13 SO THAT ALL THE IX1064.2 +087900* KEYS ON THE RECORD ARE THE SAME , THEN IX1064.2 +088000* WRITES A SEQUENTIAL RECORD AND AN INDEXED IX1064.2 +088100* FILE RECORD . IX1064.2 +088200* IX1064.2 +088300 ADD 001 TO RL-KEY. IX1064.2 +088400 READ RL-FR1 IX1064.2 +088500 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +088600 MOVE RL-FR1-REC-120 TO FILE-RECORD-INFO-P1-120(1). IX1064.2 +088700 MOVE RL-FR1-ALTKEY1-11-13 TO RL-FR1-ALTKEY2-11-13. IX1064.2 +088800 MOVE RL-FR1R1-F-G-241 TO SQ-FS1R1-F-G-241. IX1064.2 +088900 MOVE SQ-FS1R1-F-G-241 TO IX-FS1R1-F-G-241. IX1064.2 +089000 MOVE "SQ-FS1" TO XFILE-NAME (1). IX1064.2 +089100 MOVE "SQ" TO XFILE-ORGANIZATION (1). IX1064.2 +089200 MOVE "WRITE SQ-FS1 " TO FEATURE. IX1064.2 +089300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +089400 MOVE FILE-RECORD-INFO-P1-120(1) TO SQ-FS1-REC-120. IX1064.2 +089500 WRITE SQ-FS1R1-F-G-241. IX1064.2 +089600 MOVE "IX-FS1" TO XFILE-NAME (1). IX1064.2 +089700 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1064.2 +089800 MOVE "WRITE IX-FS1 " TO FEATURE. IX1064.2 +089900 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +090000 MOVE FILE-RECORD-INFO-P1-120(1) TO IX-FS1-REC-120. IX1064.2 +090100 WRITE IX-FS1R1-F-G-241 IX1064.2 +090200 INVALID KEY ADD 001 TO INVKEY-COUNTER-IX. IX1064.2 +090300 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +090400 WRITE-TEST-GF-02-02. IX1064.2 +090500* IX1064.2 +090600* WRITE-TEST-GF-02-02 - READS IN THE RELATIVE FILE IN SEQUENCE IX1064.2 +090700* STARTING AT NUMBER 76 WHERE WRITE-TEST-GF-02-01 IX1064.2 +090800* LEFT OFF . MOVES RL-FR1-ALTKEY2-11-13 TO IX1064.2 +090900* RL-FR1-ALTKEY1-11-13 SO THAT ALL THE KEYS IX1064.2 +091000* IN THE RECORD ARE THE SAME . WRITES A IX1064.2 +091100* SEQUENTIAL AND AN INDEXED FILE RECORD . IX1064.2 +091200* IX1064.2 +091300 ADD 001 TO RL-KEY. IX1064.2 +091400 READ RL-FR1 IX1064.2 +091500 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +091600 MOVE RL-FR1-REC-120 TO FILE-RECORD-INFO-P1-120(1). IX1064.2 +091700 MOVE RL-FR1-ALTKEY2-11-13 TO RL-FR1-ALTKEY1-11-13. IX1064.2 +091800 MOVE RL-FR1R1-F-G-241 TO SQ-FS1R1-F-G-241. IX1064.2 +091900 MOVE SQ-FS1R1-F-G-241 TO IX-FS1R1-F-G-241. IX1064.2 +092000 MOVE "SQ-FS1" TO XFILE-NAME (1). IX1064.2 +092100 MOVE "SQ" TO XFILE-ORGANIZATION (1). IX1064.2 +092200 MOVE FILE-RECORD-INFO-P1-120(1) TO SQ-FS1-REC-120. IX1064.2 +092300 WRITE SQ-FS1R1-F-G-241. IX1064.2 +092400 MOVE "IX-FS1" TO XFILE-NAME (1). IX1064.2 +092500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1064.2 +092600 MOVE FILE-RECORD-INFO-P1-120(1) TO IX-FS1-REC-120. IX1064.2 +092700 WRITE IX-FS1R1-F-G-241 IX1064.2 +092800 INVALID KEY ADD 001 TO INVKEY-COUNTER-IX. IX1064.2 +092900 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +093000 WRITE-TEST-GF-02-03. IX1064.2 +093100* IX1064.2 +093200* WRITE-TEST-GF-02-03 - READS IN THE RELATIVE FILE IN SEQUENCE IX1064.2 +093300* STARTING AT NUMBER 151 WHERE WRITE-TEST-GF-02-02 IX1064.2 +093400* LEFT OFF . MOVES RL-FR1-KEY-11-13 TO IX1064.2 +093500* RL-FR1-ALTKEY1-11-13 AND RL-ALTKEY2-11-13 IX1064.2 +093600* SO THAT ALL THE KEYS IN THE RECORD ARE IX1064.2 +093700* THE SAME . WRITES A SEQUENTIAL AND AN IX1064.2 +093800* INDEXED FILE RECORD . IX1064.2 +093900* IX1064.2 +094000 ADD 001 TO RL-KEY. IX1064.2 +094100 READ RL-FR1 IX1064.2 +094200 INVALID KEY ADD 001 TO INVKEY-COUNTER-RL. IX1064.2 +094300 MOVE RL-FR1-REC-120 TO FILE-RECORD-INFO-P1-120(1). IX1064.2 +094400 MOVE RL-FR1-KEY-11-13 TO RL-FR1-ALTKEY1-11-13. IX1064.2 +094500 MOVE RL-FR1-ALTKEY1-11-13 TO RL-FR1-ALTKEY2-11-13. IX1064.2 +094600 MOVE RL-FR1R1-F-G-241 TO SQ-FS1R1-F-G-241. IX1064.2 +094700 MOVE SQ-FS1R1-F-G-241 TO IX-FS1R1-F-G-241. IX1064.2 +094800 MOVE "SQ-FS1" TO XFILE-NAME (1). IX1064.2 +094900 MOVE "SQ" TO XFILE-ORGANIZATION (1). IX1064.2 +095000 MOVE FILE-RECORD-INFO-P1-120(1) TO SQ-FS1-REC-120. IX1064.2 +095100 WRITE SQ-FS1R1-F-G-241. IX1064.2 +095200 MOVE "IX-FS1" TO XFILE-NAME (1). IX1064.2 +095300 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1064.2 +095400 MOVE FILE-RECORD-INFO-P1-120(1) TO IX-FS1-REC-120. IX1064.2 +095500 WRITE IX-FS1R1-F-G-241 IX1064.2 +095600 INVALID KEY ADD 001 TO INVKEY-COUNTER-IX. IX1064.2 +095700 ADD 001 TO EXCUT-COUNTER-06V00. IX1064.2 +095800 WRITE-TEST-GF-02-END. IX1064.2 +095900 CLOSE RL-FR1. IX1064.2 +096000 CLOSE SQ-FS1. IX1064.2 +096100 CLOSE IX-FS1. IX1064.2 +096200 MOVE "READ RL-FR1 " TO FEATURE. IX1064.2 +096300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1064.2 +096400 PERFORM WRITE-TEST-GF-01 THRU WRITE-TEST-CHECK. IX1064.2 +096500 SUBTRACT INVKEY-COUNTER-IX FROM EXCUT-COUNTER-06V00 IX1064.2 +096600 GIVING RECORDS-WRITTEN. IX1064.2 +096700 WRITE-TEST-GF-02-2. IX1064.2 +096800 PERFORM WRITE-INT-GF-02-IX. IX1064.2 +096900 MOVE "WRITE-TEST-GF-02-2" TO PAR-NAME. IX1064.2 +097000 PERFORM WRITE-TEST-CHECK. IX1064.2 +097100 WRITE-TEST-GF-02-3. IX1064.2 +097200 PERFORM WRITE-INT-GF-02-SQ. IX1064.2 +097300 MOVE "WRITE-TEST-GF-02-3" TO PAR-NAME. IX1064.2 +097400 PERFORM WRITE-TEST-CHECK. IX1064.2 +097500******************************************************************IX1064.2 +097600 SECT-0003-RIS101 SECTION. IX1064.2 +097700* IX1064.2 +097800* THIS SECTION TESTS THE ABILITY TO HAVE ALL THREE DIFFERNT FILE IX1064.2 +097900* TYPES OPENED AND USED AT THE SAME TIME . IX1064.2 +098000* IX1064.2 +098100 READ-TEST-F2-01-01. IX1064.2 +098200 MOVE ZEROES TO REC-CT. IX1064.2 +098300 OPEN INPUT RL-FR1. IX1064.2 +098400 OPEN INPUT IX-FS1. IX1064.2 +098500 OPEN INPUT SQ-FS1. IX1064.2 +098600 MOVE "OPEN ALL - SEPARATE" TO FEATURE. IX1064.2 +098700 MOVE "READ-TEST-F2-01-02" TO PAR-NAME. IX1064.2 +098800 READ-TEST-F2-01-02. IX1064.2 +098900* IX1064.2 +099000* READ-TEST-F2-01-02 - THIS TESTS THE ABILITY TO READ ALL THREE IX1064.2 +099100* TYPES OF FILES IN ANY ORDER WITH ALL OF THEIX1064.2 +099200* FILES OPEN AT ONCE . IX1064.2 +099300* IX1064.2 +099400 MOVE ZERO TO RL-KEY. IX1064.2 +099500 ADD 001 TO RL-KEY. IX1064.2 +099600 READ SQ-FS1 INTO IX-FS1R1-F-G-241 AT END GO TEST-FINISH-EXIT.IX1064.2 +099700 READ IX-FS1 IX1064.2 +099800 INVALID KEY IX1064.2 +099900 MOVE "1ST IX-FS1 READ - KEY SHOULD BE 001" TO RE-MARK IX1064.2 +100000 PERFORM FAIL IX1064.2 +100100 PERFORM PRINT-DETAIL IX1064.2 +100200 GO TO READ-TEST-F2-01-02-END. IX1064.2 +100300 READ RL-FR1 IX1064.2 +100400 INVALID KEY IX1064.2 +100500 MOVE "1ST RL-FS1 READ - KEY SHOULD BE 001" TO RE-MARK IX1064.2 +100600 PERFORM FAIL IX1064.2 +100700 PERFORM PRINT-DETAIL IX1064.2 +100800 GO TO READ-TEST-F2-01-02-END. IX1064.2 +100900 READ SQ-FS1 AT END GO TO TEST-FINISH-EXIT. IX1064.2 +101000 READ SQ-FS1 AT END GO TO TEST-FINISH-EXIT. IX1064.2 +101100 READ RL-FR1 IX1064.2 +101200 INVALID KEY IX1064.2 +101300 MOVE "2ND IX-FS1 READ - KEY SHOULD BE 001" TO RE-MARK IX1064.2 +101400 PERFORM FAIL IX1064.2 +101500 PERFORM PRINT-DETAIL IX1064.2 +101600 GO TO READ-TEST-F2-01-02-END. IX1064.2 +101700 READ IX-FS1 IX1064.2 +101800 INVALID KEY IX1064.2 +101900 MOVE "2ND RL-FR1 READ - KEY SHOULD BE 001" TO RE-MARK IX1064.2 +102000 PERFORM FAIL IX1064.2 +102100 PERFORM PRINT-DETAIL IX1064.2 +102200 GO TO READ-TEST-F2-01-02-END. IX1064.2 +102300 READ SQ-FS1 AT END GO TO TEST-FINISH-EXIT. IX1064.2 +102400 PERFORM PASS. IX1064.2 +102500 PERFORM PRINT-DETAIL. IX1064.2 +102600 READ-TEST-F2-01-02-END. IX1064.2 +102700 CLOSE RL-FR1. IX1064.2 +102800 CLOSE IX-FS1. IX1064.2 +102900 CLOSE SQ-FS1. IX1064.2 +103000 READ-INIT-F2-02. IX1064.2 +103100 OPEN I-O IX-FS1 SQ-FS1 RL-FR1. IX1064.2 +103200 READ-TEST-F2-02. IX1064.2 +103300 READ SQ-FS1 AT END GO TO TEST-FINISH-EXIT. IX1064.2 +103400 READ-WRITE-F2-02. IX1064.2 +103500 CLOSE RL-FR1 IX-FS1 SQ-FS1. IX1064.2 +103600 MOVE "R-I-S " TO XFILE-NAME (1). IX1064.2 +103700 MOVE ZERO TO XRECORD-NUMBER (1). IX1064.2 +103800 MOVE "AL" TO XFILE-ORGANIZATION (1). IX1064.2 +103900 MOVE "OPEN ALL 3 IN 1 LINE" TO FEATURE. IX1064.2 +104000 MOVE "READ-TEST-F2-02 " TO PAR-NAME. IX1064.2 +104100 PERFORM PASS. IX1064.2 +104200 PERFORM PRINT-DETAIL. IX1064.2 +104300******************************************************************IX1064.2 +104400 SECT-0004-RIS101 SECTION. IX1064.2 +104500* IX1064.2 +104600* THIS SECTION TESTS THE ABILITY TO DELETE RECORDS FROM ONE FILE IX1064.2 +104700* TYPE WHILE HAVING THE OTHER FILES OPEN . IX1064.2 +104800* IX1064.2 +104900 DELETE-TEST-GF-01. IX1064.2 +105000* IX1064.2 +105100* DELETE-TEST-GF-01-01 -IN THIS TEST RECORD NUMBER 121 IS DELETED IX1064.2 +105200* THE RELATIVE FILE . THE FILE IS THEN CLOSED . IX1064.2 +105300* THE RELATIVE FILE IS THEN RE-OPENED AND IX1064.2 +105400* READ EXPECTING TO FIND 122 VALID RECORDS IX1064.2 +105500* AND AN INVALID KEY FOR WHAT USED TO BE IX1064.2 +105600* THE 122ND RECORD. RL-FR1-RECKEY-11-13 IX1064.2 +105700* IS CHECKED TO SEE IF RECORD 123 IS READ IX1064.2 +105800* AS IT SHOULD BE. IX1064.2 +105900* IX1064.2 +106000 OPEN I-O IX-FS1 RL-FR1 SQ-FS1. IX1064.2 +106100 MOVE ZERO TO IX-FS1-KEY-11-13. IX1064.2 +106200 MOVE ZERO TO RL-KEY. IX1064.2 +106300 MOVE ZERO TO INVKEY-COUNTER-RL. IX1064.2 +106400 MOVE ZERO TO INVKEY-COUNTER-IX. IX1064.2 +106500 MOVE 121 TO IX-FS1-KEY-11-13. IX1064.2 +106600 READ IX-FS1 IX1064.2 +106700 INVALID KEY ADD 001 TO INVKEY-COUNTER-IX. IX1064.2 +106800 ADD 121 TO RL-KEY. IX1064.2 +106900 MOVE "R-I-S " TO XFILE-NAME (1) IX1064.2 +107000 MOVE ZERO TO XRECORD-NUMBER (1) IX1064.2 +107100 MOVE "RL" TO XFILE-ORGANIZATION (1) IX1064.2 +107200 MOVE "DELETE RL RECORD" TO FEATURE IX1064.2 +107300 MOVE "DELETE-TEST-GF-01 " TO PAR-NAME IX1064.2 +107400 DELETE RL-FR1 IX1064.2 +107500 INVALID KEY PERFORM FAIL IX1064.2 +107600 PERFORM PRINT-DETAIL IX1064.2 +107700 GO TO DELETE-TEST-GF-01-END. IX1064.2 +107800 CLOSE RL-FR1. IX1064.2 +107900 OPEN INPUT RL-FR1. IX1064.2 +108000 MOVE ZERO TO RL-KEY. IX1064.2 +108100 PERFORM DELETE-TEST-GF-01-02-R2 122 TIMES. IX1064.2 +108200 DELETE-TEST-GF-01-02-R2. IX1064.2 +108300 ADD 1 TO RL-KEY. IX1064.2 +108400 READ RL-FR1 INVALID KEY IX1064.2 +108500 ADD 1 TO INVKEY-COUNTER-RL. IX1064.2 +108600 DELETE-TEST-GF-01-02-CK. IX1064.2 +108700 IF RL-FR1-KEY-11-13 EQUAL TO 123 IX1064.2 +108800 ADD 1 TO INVKEY-COUNTER-RL. IX1064.2 +108900 IF IX1064.2 +109000 INVKEY-COUNTER-RL EQUAL TO 2 IX1064.2 +109100 PERFORM PASS ELSE IX1064.2 +109200 MOVE "VII-19 4.3.2 " TO RE-MARK IX1064.2 +109300 PERFORM FAIL. IX1064.2 +109400 PERFORM PRINT-DETAIL. IX1064.2 +109500 DELETE-TEST-GF-01-END. IX1064.2 +109600 CLOSE RL-FR1 IX-FS1 SQ-FS1. IX1064.2 +109700******************************************************************IX1064.2 +109800 SECT-TEST-005-RIS101 SECTION. IX1064.2 +109900* IX1064.2 +110000* THIS SECTION TESTS THE ABILITY TO REWRITE A FILE WHILE OTHER IX1064.2 +110100* FILES ARE BEING MANIPULATED . IX1064.2 +110200* IX1064.2 +110300 REWRITE-INIT-GF-01. IX1064.2 +110400 OPEN I-O SQ-FS1 IX-FS1 RL-FR1. IX1064.2 +110500 MOVE ZEROES TO RL-KEY. IX1064.2 +110600 ADD 003 TO RL-KEY. IX1064.2 +110700 MOVE ZERO TO INVKEY-COUNTER-RL. IX1064.2 +110800 MOVE ZERO TO INVKEY-COUNTER-IX. IX1064.2 +110900 REWRITE-TEST-GF-01. IX1064.2 +111000* IX1064.2 +111100* REWRITE-TEST-GF-01:TESTS THE ABILITY TO REWRITE A RELATIVE FILE IX1064.2 +111200* WHILE ALSO MANIPULATING DATA FROM AN INEXED IX1064.2 +111300* FILE . IX1064.2 +111400* IX1064.2 +111500 READ-INIT-RL. IX1064.2 +111600 READ RL-FR1 IX1064.2 +111700 INVALID KEY IX1064.2 +111800 MOVE "READ RL RECORD" TO FEATURE IX1064.2 +111900 MOVE "READ-INIT-RL " TO PAR-NAME IX1064.2 +112000 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +112100 MOVE RL-FR1-ALTKEY2-11-13 TO IX-FS1-KEY-11-13. IX1064.2 +112200 READ-INIT-IX. IX1064.2 +112300 READ IX-FS1 IX1064.2 +112400 INVALID KEY IX1064.2 +112500 MOVE "READ IX RECORD" TO FEATURE IX1064.2 +112600 MOVE "READ-INIT-IX. " TO PAR-NAME IX1064.2 +112700 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +112800 MOVE RL-FR1-ALTKEY2-11-13 TO IX-FS1-KEY-11-13. IX1064.2 +112900 MOVE IX-FS1R1-F-G-241 TO RL-FR1R1-F-G-241. IX1064.2 +113000 REWRITE RL-FR1R1-F-G-241 IX1064.2 +113100 INVALID KEY IX1064.2 +113200 MOVE "REWRITE RL RECORD" TO FEATURE IX1064.2 +113300 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME IX1064.2 +113400 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +113500 REWRITE-TEST-005-01-1. IX1064.2 +113600 READ RL-FR1 IX1064.2 +113700 INVALID KEY IX1064.2 +113800 MOVE "READ RL RECORD" TO FEATURE IX1064.2 +113900 MOVE "REWRITE-TEST-005-01-1" TO PAR-NAME IX1064.2 +114000 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +114100 REWRITE-TEST-01. IX1064.2 +114200 MOVE "REWRITE RL RECORD" TO FEATURE IX1064.2 +114300 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME. IX1064.2 +114400 IF RL-FR1-KEY-11-13 NOT EQUAL 78 IX1064.2 +114500 PERFORM FAIL IX1064.2 +114600 MOVE RL-FR1-KEY-11-13 TO COMPUTED-A IX1064.2 +114700 MOVE "78" TO CORRECT-A IX1064.2 +114800 PERFORM PRINT-DETAIL IX1064.2 +114900 MOVE RL-FR1-REC-120 TO DUMMY-RECORD IX1064.2 +115000 PERFORM WRITE-LINE IX1064.2 +115100 MOVE RL-FR1-REC-121-241 TO DUMMY-RECORD IX1064.2 +115200 PERFORM WRITE-LINE IX1064.2 +115300 ELSE IX1064.2 +115400 PERFORM PASS. IX1064.2 +115500 PERFORM PRINT-DETAIL. IX1064.2 +115600*************************************************************** IX1064.2 +115700 REWRITE-TEST-GF-02. IX1064.2 +115800* IX1064.2 +115900* REWRITE-TEST-GF-02 TESTS THE ABILITY TO REWRITE A SEQUENTIAL IX1064.2 +116000* FILE WHILE WORKING WITH A RELATIVE ALSO . IX1064.2 +116100* IX1064.2 +116200 PERFORM READ-TEST-F2-02 9 TIMES. IX1064.2 +116300 MOVE 15 TO RL-KEY. IX1064.2 +116400 READ RL-FR1 INTO SQ-FS1R1-F-G-241 IX1064.2 +116500 INVALID KEY IX1064.2 +116600 MOVE "RL INTO SQ" TO FEATURE IX1064.2 +116700 MOVE "REWRITE-TEST-GF-02I" TO PAR-NAME IX1064.2 +116800 MOVE "VIII-26 4.5.2 " TO RE-MARK IX1064.2 +116900 PERFORM FAIL IX1064.2 +117000 PERFORM PRINT-DETAIL IX1064.2 +117100 GO TEST-FINISH-EXIT. IX1064.2 +117200 MOVE "REWRITE-TEST-GF-02 " TO PAR-NAME. IX1064.2 +117300 MOVE "REWRITE SQ" TO FEATURE. IX1064.2 +117400 REWRITE SQ-FS1R1-F-G-241. IX1064.2 +117500 CLOSE SQ-FS1. IX1064.2 +117600 OPEN I-O SQ-FS1. IX1064.2 +117700 PERFORM READ-TEST-F2-02 9 TIMES. IX1064.2 +117800 IF SQ-FS1-ALTKEY2-11-13 EQUAL TO "090" IX1064.2 +117900 PERFORM PASS IX1064.2 +118000 ELSE IX1064.2 +118100 PERFORM FAIL IX1064.2 +118200 MOVE "90" TO CORRECT-A IX1064.2 +118300 MOVE SQ-FS1-KEY-11-13 TO COMPUTED-A. IX1064.2 +118400 PERFORM PRINT-DETAIL. IX1064.2 +118500********* END OF 005-02 REWRITE SQ RECORD ************************IX1064.2 +118600 REWRITE-TEST-GF-03. IX1064.2 +118700* IX1064.2 +118800* REWRITE-TEST-GF-03 TESTS THE ABILITY TO REWRITE AN INDEXED FILEIX1064.2 +118900* WHILE ALSO READING A RELATIVE FILE . IX1064.2 +119000* IX1064.2 +119100 MOVE 15 TO RL-KEY. IX1064.2 +119200 MOVE "077" TO IX-FS1-KEY-11-13. IX1064.2 +119300 MOVE "REWRITE-TEST-GF-03 " TO PAR-NAME. IX1064.2 +119400 MOVE "REWRITE IX" TO FEATURE. IX1064.2 +119500 READ IX-FS1 IX1064.2 +119600 INVALID KEY IX1064.2 +119700 MOVE "READ IX RECORD" TO FEATURE IX1064.2 +119800 PERFORM FAIL PERFORM PRINT-DETAIL GO REWRITE-TEST-005-END. IX1064.2 +119900 READ RL-FR1 IX1064.2 +120000 INVALID KEY IX1064.2 +120100 MOVE "READ RL TO PASS TO IX" TO RE-MARK IX1064.2 +120200 PERFORM FAIL IX1064.2 +120300 PERFORM PRINT-DETAIL IX1064.2 +120400 GO REWRITE-TEST-005-END. IX1064.2 +120500 REWRITE IX-FS1R1-F-G-241 FROM RL-FR1R1-F-G-241 IX1064.2 +120600 INVALID KEY IX1064.2 +120700 MOVE "REWRITE IX STATEMENT" TO RE-MARK IX1064.2 +120800 PERFORM FAIL IX1064.2 +120900 PERFORM PRINT-DETAIL IX1064.2 +121000 GO TO REWRITE-TEST-005-END. IX1064.2 +121100 MOVE "015" TO IX-FS1-KEY-11-13. IX1064.2 +121200 READ IX-FS1 IX1064.2 +121300 INVALID KEY IX1064.2 +121400 MOVE "RE-READ IX FOR CHECK" TO RE-MARK IX1064.2 +121500 PERFORM FAIL IX1064.2 +121600 PERFORM PRINT-DETAIL IX1064.2 +121700 GO REWRITE-TEST-005-END. IX1064.2 +121800 IF IX-FS1-ALTKEY2-11-13 EQUAL TO "090" IX1064.2 +121900 PERFORM PASS IX1064.2 +122000 ELSE IX1064.2 +122100 MOVE IX-FS1-REC-120 TO DUMMY-RECORD IX1064.2 +122200 PERFORM WRITE-LINE IX1064.2 +122300 MOVE IX-FS1-REC-121-241 TO DUMMY-RECORD IX1064.2 +122400 PERFORM WRITE-LINE IX1064.2 +122500 PERFORM FAIL. IX1064.2 +122600 PERFORM PRINT-DETAIL. IX1064.2 +122700 REWRITE-TEST-005-END. IX1064.2 +122800 CLOSE SQ-FS1 IX-FS1 RL-FR1. IX1064.2 +122900 TEST-FINISH-EXIT. IX1064.2 +123000 EXIT. IX1064.2 +123100 CCVS-EXIT SECTION. IX1064.2 +123200 CCVS-999999. IX1064.2 +123300 GO TO CLOSE-FILES. IX1064.2 diff --git a/tests/cobol85/IX/IX107A.CBL b/tests/cobol85/IX/IX107A.CBL new file mode 100755 index 00000000..82b45672 --- /dev/null +++ b/tests/cobol85/IX/IX107A.CBL @@ -0,0 +1,982 @@ +000100 IDENTIFICATION DIVISION. IX1074.2 +000200 PROGRAM-ID. IX1074.2 +000300 IX107A. IX1074.2 +000400**************************************************************** IX1074.2 +000500* * IX1074.2 +000600* VALIDATION FOR:- * IX1074.2 +000700* * IX1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1074.2 +000900* * IX1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1074.2 +001100* * IX1074.2 +001200**************************************************************** IX1074.2 +001300* IX1074.2 +001400* THIS ROUTINE TESTS THE FOLLOWING COBOL ELEMENTS FOR PROPERIX1074.2 +001500* SYNTAX WHEN USING AN INDEXED SEQUENTIAL I-O FILE. IX1074.2 +001600* IX1074.2 +001700* SAME AREA FILE-NAME-1 FILE-NAME-2 IX1074.2 +001800* READ .... RECORD AT END .... IX1074.2 +001900* READ .... RECORD END ... IX1074.2 +002000* READ .... AT END .... IX1074.2 +002100* READ .... END .... IX1074.2 +002200* READ .... RECORD INVALID KEY ... IX1074.2 +002300* READ .... INVALID KEY ... IX1074.2 +002400* READ .... RECORD INVALID ... IX1074.2 +002500* READ .... INVALID ... IX1074.2 +002600* IX1074.2 +002700* THERE ARE TWO FILES USED IN THIS ROUTINE. FOLLOWING IX1074.2 +002800* CREATION OF EACH FILE THE ROUTINE READS AND VERIFIES THE FILEIX1074.2 +002900* BEFORE ANY OF THE ABOVE TESTS ARE MADE. ONE FILE SPECIFIES IX1074.2 +003000* AN ACCESS MODE AS RANDOM AND THE OTHER FILE SPECIFIES AN IX1074.2 +003100* ACCESS MODE AS SEQUENTIAL. THE FILES REFERENCED IN THE SAME IX1074.2 +003200* CLAUSE NEED NOT HAVE THE SAME ACCESS MODE. IX1074.2 +003300* IX1074.2 +003400* REFERENCES: SECTION IX-15, SEE VII-19 2.13.3 (4) SAME IX1074.2 +003500* AREA IX1074.2 +003600* IX1074.2 +003700* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1074.2 +003800* IX1074.2 +003900* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1074.2 +004000* CLAUSE FOR DATA FILE IX-FS1 IX1074.2 +004100* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1074.2 +004200* CLAUSE FOR DATA FILE IX-FD2 IX1074.2 +004300* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX1074.2 +004400* CLAUSE FOR INDEX FILE IX-FS1 IX1074.2 +004500* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1074.2 +004600* CLAUSE FOR INDEX FILE IX-FD2 IX1074.2 +004700* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1074.2 +004800* X-62 FOR RAW-DATA IX1074.2 +004900* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1074.2 +005000* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX1074.2 +005100* X-84 PRINTER-FILE LABELS (OPTIONAL) C IX1074.2 +005200* IX1074.2 +005300* NOTE: X-CARDS 44,45, 62 AND 84 ARE OPTIONAL IX1074.2 +005400* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1074.2 +005500* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1074.2 +005600* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1074.2 +005700* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1074.2 +005800* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1074.2 +005900* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1074.2 +006000* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1074.2 +006100* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1074.2 +006200* THEY ARE AS FOLLOWS IX1074.2 +006300* IX1074.2 +006400* C SELECTS OBSOLETE FEATURES (E.G. LABEL ..) IX1074.2 +006500* J SELECTS X-CARDS 44 AND 45 IX1074.2 +006600* IX1074.2 +006700* NOTE: THERE IS OPTIONAL SOURCE CODE IN THIS PROGRAM IX1074.2 +006800* FOR THE CONVENIENCE OF THE USER. THIS OPTIONAL IX1074.2 +006900* CODE IS IDENTIFIED BY THE LETTER T OR U IN IX1074.2 +007000* POSITION 7 OF THE SOURCE LINE. FOR CODE IX1074.2 +007100* WITH LETTERS T OR U ONLY ONE SHOULD BE SELECTED. IX1074.2 +007200* EITHER THE T"S OR THE U"S SHOULD BE USED EXCLU- IX1074.2 +007300* SIVELY, NOT BOTH. THE T"S PROVIDE A 29 CHARACTER IX1074.2 +007400* INDEXED KEY SIZE FOR THE FILE AND THE U"S PROVIDE IX1074.2 +007500* AN INDEXED KEY NOT GREATER THAN 8 CHARACTERS. IX1074.2 +007600* IF THE VP-ROUTINE IS USED THE APPROPRIATE IX1074.2 +007700* SOURCE CODE MAY BE SELECTED BY SPECIFYING THE IX1074.2 +007800* RESPECTIVE LETTER IN THE "*OPT" VP-ROUTINE CONTROLIX1074.2 +007900* CARD. IX1074.2 +008000* IX1074.2 +008100****************************************************** IX1074.2 +008200 ENVIRONMENT DIVISION. IX1074.2 +008300 CONFIGURATION SECTION. IX1074.2 +008400 SOURCE-COMPUTER. IX1074.2 +008500 Linux. IX1074.2 +008600 OBJECT-COMPUTER. IX1074.2 +008700 Linux. IX1074.2 +008800 INPUT-OUTPUT SECTION. IX1074.2 +008900 FILE-CONTROL. IX1074.2 +009000*P SELECT RAW-DATA ASSIGN TO IX1074.2 +009100*P "XXXXX062" IX1074.2 +009200*P ORGANIZATION IS INDEXED IX1074.2 +009300*P ACCESS MODE IS RANDOM IX1074.2 +009400*P RECORD KEY IS RAW-DATA-KEY. IX1074.2 +009500 SELECT PRINT-FILE ASSIGN TO IX1074.2 +009600 "report.log". IX1074.2 +009700 SELECT IX-FS1 ASSIGN TO IX1074.2 +009800 "XXXXX024" IX1074.2 +009900*J **** X-CARD UNDEFINED **** IX1074.2 +010000 RECORD KEY IS IX-FS1-KEY IX1074.2 +010100 ORGANIZATION IS INDEXED IX1074.2 +010200 ACCESS MODE IS SEQUENTIAL. IX1074.2 +010300 SELECT IX-FD2 ASSIGN TO IX1074.2 +010400 "XXXXX025" IX1074.2 +010500*J **** X-CARD UNDEFINED **** IX1074.2 +010600 RECORD KEY IS IX-FD2-KEY IX1074.2 +010700 ORGANIZATION IS INDEXED IX1074.2 +010800 ACCESS MODE IS RANDOM. IX1074.2 +010900 I-O-CONTROL. IX1074.2 +011000 SAME AREA IX-FS1 IX-FD2. IX1074.2 +011100 DATA DIVISION. IX1074.2 +011200 FILE SECTION. IX1074.2 +011300*P IX1074.2 +011400*PD RAW-DATA. IX1074.2 +011500*P IX1074.2 +011600*P1 RAW-DATA-SATZ. IX1074.2 +011700*P 05 RAW-DATA-KEY PIC X(6). IX1074.2 +011800*P 05 C-DATE PIC 9(6). IX1074.2 +011900*P 05 C-TIME PIC 9(8). IX1074.2 +012000*P 05 C-NO-OF-TESTS PIC 99. IX1074.2 +012100*P 05 C-OK PIC 999. IX1074.2 +012200*P 05 C-ALL PIC 999. IX1074.2 +012300*P 05 C-FAIL PIC 999. IX1074.2 +012400*P 05 C-DELETED PIC 999. IX1074.2 +012500*P 05 C-INSPECT PIC 999. IX1074.2 +012600*P 05 C-NOTE PIC X(13). IX1074.2 +012700*P 05 C-INDENT PIC X. IX1074.2 +012800*P 05 C-ABORT PIC X(8). IX1074.2 +012900 FD PRINT-FILE. IX1074.2 +013000 01 PRINT-REC PICTURE X(120). IX1074.2 +013100 01 DUMMY-RECORD PICTURE X(120). IX1074.2 +013200 FD IX-FS1 IX1074.2 +013300*C LABEL RECORD IS STANDARD IX1074.2 +013400*C DATA RECORD IS IX-FS1R1-F-G-240 IX1074.2 +013500 BLOCK CONTAINS 1 RECORDS IX1074.2 +013600 RECORD CONTAINS 240 CHARACTERS. IX1074.2 +013700 01 IX-FS1R1-F-G-240. IX1074.2 +013800 03 IX-FS1-REC-120 PIC X(120). IX1074.2 +013900 03 IX-FS1-REC-121-240. IX1074.2 +014000 05 FILLER PIC X(8). IX1074.2 +014100 05 IX-FS1-KEY. IX1074.2 +014200 10 IX-FS1-KEYNUM PIC 9(5). IX1074.2 +014300 10 FILLER PIC X(24). IX1074.2 +014400*U 05 FILLER PIC X(24). IX1074.2 +014500 05 FILLER PIC X(83). IX1074.2 +014600 FD IX-FD2 IX1074.2 +014700*C LABEL RECORD IS STANDARD IX1074.2 +014800*C DATA RECORD IS IX-FD2R1-F-G-240 IX1074.2 +014900 BLOCK CONTAINS 5 RECORDS IX1074.2 +015000 RECORD CONTAINS 240 CHARACTERS. IX1074.2 +015100 01 IX-FD2R1-F-G-240. IX1074.2 +015200 03 IX-FD2-REC-120 PIC X(120). IX1074.2 +015300 03 IX-FD2-REC-121-240. IX1074.2 +015400 05 FILLER PIC X(8). IX1074.2 +015500 05 IX-FD2-KEY. IX1074.2 +015600 10 IX-FD2-KEYNUM PIC 9(5). IX1074.2 +015700 10 FILLER PIC X(24). IX1074.2 +015800*U 05 FILLER PIC X(24). IX1074.2 +015900 05 FILLER PIC X(83). IX1074.2 +016000 WORKING-STORAGE SECTION. IX1074.2 +016100 01 WRK-FS1-RECKEY. IX1074.2 +016200 03 WRK-DU-05V00-001 PIC 9(5) VALUE ZERO. IX1074.2 +016300 03 WRK-XN-24V00-001 PIC X(24) VALUE IX1074.2 +016400 "123456789012345678901234". IX1074.2 +016500 01 WRK-FD2-RECKEY. IX1074.2 +016600 03 WRK-DU-05V00-002 PIC 9(5) VALUE ZERO. IX1074.2 +016700 03 WRK-XN-24V00-002 PIC X(24) VALUE IX1074.2 +016800 "123456789012345678901234". IX1074.2 +016900 01 WRK-CS-09V00-001 PIC S9(9) COMP VALUE ZERO. IX1074.2 +017000 01 FS1-FILE-SIZE PIC 9(6) VALUE 750. IX1074.2 +017100 01 FD2-FILE-SIZE PIC 9(6) VALUE 649. IX1074.2 +017200 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. IX1074.2 +017300 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. IX1074.2 +017400 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1074.2 +017500 01 EOF-FLAG PICTURE 9 VALUE ZERO. IX1074.2 +017600 01 FILE-RECORD-INFORMATION-REC. IX1074.2 +017700 03 FILE-RECORD-INFO-SKELETON. IX1074.2 +017800 05 FILLER PICTURE X(48) VALUE IX1074.2 +017900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1074.2 +018000 05 FILLER PICTURE X(46) VALUE IX1074.2 +018100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1074.2 +018200 05 FILLER PICTURE X(26) VALUE IX1074.2 +018300 ",LFIL=000000,ORG= ,LBLR= ". IX1074.2 +018400 05 FILLER PICTURE X(37) VALUE IX1074.2 +018500 ",RECKEY= ". IX1074.2 +018600 05 FILLER PICTURE X(38) VALUE IX1074.2 +018700 ",ALTKEY1= ". IX1074.2 +018800 05 FILLER PICTURE X(38) VALUE IX1074.2 +018900 ",ALTKEY2= ". IX1074.2 +019000 05 FILLER PICTURE X(7) VALUE SPACE.IX1074.2 +019100 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1074.2 +019200 05 FILE-RECORD-INFO-P1-120. IX1074.2 +019300 07 FILLER PIC X(5). IX1074.2 +019400 07 XFILE-NAME PIC X(6). IX1074.2 +019500 07 FILLER PIC X(8). IX1074.2 +019600 07 XRECORD-NAME PIC X(6). IX1074.2 +019700 07 FILLER PIC X(1). IX1074.2 +019800 07 REELUNIT-NUMBER PIC 9(1). IX1074.2 +019900 07 FILLER PIC X(7). IX1074.2 +020000 07 XRECORD-NUMBER PIC 9(6). IX1074.2 +020100 07 FILLER PIC X(6). IX1074.2 +020200 07 UPDATE-NUMBER PIC 9(2). IX1074.2 +020300 07 FILLER PIC X(5). IX1074.2 +020400 07 ODO-NUMBER PIC 9(4). IX1074.2 +020500 07 FILLER PIC X(5). IX1074.2 +020600 07 XPROGRAM-NAME PIC X(5). IX1074.2 +020700 07 FILLER PIC X(7). IX1074.2 +020800 07 XRECORD-LENGTH PIC 9(6). IX1074.2 +020900 07 FILLER PIC X(7). IX1074.2 +021000 07 CHARS-OR-RECORDS PIC X(2). IX1074.2 +021100 07 FILLER PIC X(1). IX1074.2 +021200 07 XBLOCK-SIZE PIC 9(4). IX1074.2 +021300 07 FILLER PIC X(6). IX1074.2 +021400 07 RECORDS-IN-FILE PIC 9(6). IX1074.2 +021500 07 FILLER PIC X(5). IX1074.2 +021600 07 XFILE-ORGANIZATION PIC X(2). IX1074.2 +021700 07 FILLER PIC X(6). IX1074.2 +021800 07 XLABEL-TYPE PIC X(1). IX1074.2 +021900 05 FILE-RECORD-INFO-P121-240. IX1074.2 +022000 07 FILLER PIC X(8). IX1074.2 +022100 07 XRECORD-KEY PIC X(29). IX1074.2 +022200 07 FILLER PIC X(9). IX1074.2 +022300 07 ALTERNATE-KEY1 PIC X(29). IX1074.2 +022400 07 FILLER PIC X(9). IX1074.2 +022500 07 ALTERNATE-KEY2 PIC X(29). IX1074.2 +022600 07 FILLER PIC X(7). IX1074.2 +022700 01 TEST-RESULTS. IX1074.2 +022800 02 FILLER PIC X VALUE SPACE. IX1074.2 +022900 02 FEATURE PIC X(20) VALUE SPACE. IX1074.2 +023000 02 FILLER PIC X VALUE SPACE. IX1074.2 +023100 02 P-OR-F PIC X(5) VALUE SPACE. IX1074.2 +023200 02 FILLER PIC X VALUE SPACE. IX1074.2 +023300 02 PAR-NAME. IX1074.2 +023400 03 FILLER PIC X(19) VALUE SPACE. IX1074.2 +023500 03 PARDOT-X PIC X VALUE SPACE. IX1074.2 +023600 03 DOTVALUE PIC 99 VALUE ZERO. IX1074.2 +023700 02 FILLER PIC X(8) VALUE SPACE. IX1074.2 +023800 02 RE-MARK PIC X(61). IX1074.2 +023900 01 TEST-COMPUTED. IX1074.2 +024000 02 FILLER PIC X(30) VALUE SPACE. IX1074.2 +024100 02 FILLER PIC X(17) VALUE IX1074.2 +024200 " COMPUTED=". IX1074.2 +024300 02 COMPUTED-X. IX1074.2 +024400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1074.2 +024500 03 COMPUTED-N REDEFINES COMPUTED-A IX1074.2 +024600 PIC -9(9).9(9). IX1074.2 +024700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1074.2 +024800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1074.2 +024900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1074.2 +025000 03 CM-18V0 REDEFINES COMPUTED-A. IX1074.2 +025100 04 COMPUTED-18V0 PIC -9(18). IX1074.2 +025200 04 FILLER PIC X. IX1074.2 +025300 03 FILLER PIC X(50) VALUE SPACE. IX1074.2 +025400 01 TEST-CORRECT. IX1074.2 +025500 02 FILLER PIC X(30) VALUE SPACE. IX1074.2 +025600 02 FILLER PIC X(17) VALUE " CORRECT =". IX1074.2 +025700 02 CORRECT-X. IX1074.2 +025800 03 CORRECT-A PIC X(20) VALUE SPACE. IX1074.2 +025900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1074.2 +026000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1074.2 +026100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1074.2 +026200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1074.2 +026300 03 CR-18V0 REDEFINES CORRECT-A. IX1074.2 +026400 04 CORRECT-18V0 PIC -9(18). IX1074.2 +026500 04 FILLER PIC X. IX1074.2 +026600 03 FILLER PIC X(2) VALUE SPACE. IX1074.2 +026700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1074.2 +026800 01 CCVS-C-1. IX1074.2 +026900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1074.2 +027000- "SS PARAGRAPH-NAME IX1074.2 +027100- " REMARKS". IX1074.2 +027200 02 FILLER PIC X(20) VALUE SPACE. IX1074.2 +027300 01 CCVS-C-2. IX1074.2 +027400 02 FILLER PIC X VALUE SPACE. IX1074.2 +027500 02 FILLER PIC X(6) VALUE "TESTED". IX1074.2 +027600 02 FILLER PIC X(15) VALUE SPACE. IX1074.2 +027700 02 FILLER PIC X(4) VALUE "FAIL". IX1074.2 +027800 02 FILLER PIC X(94) VALUE SPACE. IX1074.2 +027900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1074.2 +028000 01 REC-CT PIC 99 VALUE ZERO. IX1074.2 +028100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1074.2 +028200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1074.2 +028300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1074.2 +028400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1074.2 +028500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1074.2 +028600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1074.2 +028700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1074.2 +028800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1074.2 +028900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1074.2 +029000 01 CCVS-H-1. IX1074.2 +029100 02 FILLER PIC X(39) VALUE SPACES. IX1074.2 +029200 02 FILLER PIC X(42) VALUE IX1074.2 +029300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1074.2 +029400 02 FILLER PIC X(39) VALUE SPACES. IX1074.2 +029500 01 CCVS-H-2A. IX1074.2 +029600 02 FILLER PIC X(40) VALUE SPACE. IX1074.2 +029700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1074.2 +029800 02 FILLER PIC XXXX VALUE IX1074.2 +029900 "4.2 ". IX1074.2 +030000 02 FILLER PIC X(28) VALUE IX1074.2 +030100 " COPY - NOT FOR DISTRIBUTION". IX1074.2 +030200 02 FILLER PIC X(41) VALUE SPACE. IX1074.2 +030300 IX1074.2 +030400 01 CCVS-H-2B. IX1074.2 +030500 02 FILLER PIC X(15) VALUE IX1074.2 +030600 "TEST RESULT OF ". IX1074.2 +030700 02 TEST-ID PIC X(9). IX1074.2 +030800 02 FILLER PIC X(4) VALUE IX1074.2 +030900 " IN ". IX1074.2 +031000 02 FILLER PIC X(12) VALUE IX1074.2 +031100 " HIGH ". IX1074.2 +031200 02 FILLER PIC X(22) VALUE IX1074.2 +031300 " LEVEL VALIDATION FOR ". IX1074.2 +031400 02 FILLER PIC X(58) VALUE IX1074.2 +031500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1074.2 +031600 01 CCVS-H-3. IX1074.2 +031700 02 FILLER PIC X(34) VALUE IX1074.2 +031800 " FOR OFFICIAL USE ONLY ". IX1074.2 +031900 02 FILLER PIC X(58) VALUE IX1074.2 +032000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1074.2 +032100 02 FILLER PIC X(28) VALUE IX1074.2 +032200 " COPYRIGHT 1985 ". IX1074.2 +032300 01 CCVS-E-1. IX1074.2 +032400 02 FILLER PIC X(52) VALUE SPACE. IX1074.2 +032500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1074.2 +032600 02 ID-AGAIN PIC X(9). IX1074.2 +032700 02 FILLER PIC X(45) VALUE SPACES. IX1074.2 +032800 01 CCVS-E-2. IX1074.2 +032900 02 FILLER PIC X(31) VALUE SPACE. IX1074.2 +033000 02 FILLER PIC X(21) VALUE SPACE. IX1074.2 +033100 02 CCVS-E-2-2. IX1074.2 +033200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1074.2 +033300 03 FILLER PIC X VALUE SPACE. IX1074.2 +033400 03 ENDER-DESC PIC X(44) VALUE IX1074.2 +033500 "ERRORS ENCOUNTERED". IX1074.2 +033600 01 CCVS-E-3. IX1074.2 +033700 02 FILLER PIC X(22) VALUE IX1074.2 +033800 " FOR OFFICIAL USE ONLY". IX1074.2 +033900 02 FILLER PIC X(12) VALUE SPACE. IX1074.2 +034000 02 FILLER PIC X(58) VALUE IX1074.2 +034100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1074.2 +034200 02 FILLER PIC X(13) VALUE SPACE. IX1074.2 +034300 02 FILLER PIC X(15) VALUE IX1074.2 +034400 " COPYRIGHT 1985". IX1074.2 +034500 01 CCVS-E-4. IX1074.2 +034600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1074.2 +034700 02 FILLER PIC X(4) VALUE " OF ". IX1074.2 +034800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1074.2 +034900 02 FILLER PIC X(40) VALUE IX1074.2 +035000 " TESTS WERE EXECUTED SUCCESSFULLY". IX1074.2 +035100 01 XXINFO. IX1074.2 +035200 02 FILLER PIC X(19) VALUE IX1074.2 +035300 "*** INFORMATION ***". IX1074.2 +035400 02 INFO-TEXT. IX1074.2 +035500 04 FILLER PIC X(8) VALUE SPACE. IX1074.2 +035600 04 XXCOMPUTED PIC X(20). IX1074.2 +035700 04 FILLER PIC X(5) VALUE SPACE. IX1074.2 +035800 04 XXCORRECT PIC X(20). IX1074.2 +035900 02 INF-ANSI-REFERENCE PIC X(48). IX1074.2 +036000 01 HYPHEN-LINE. IX1074.2 +036100 02 FILLER PIC IS X VALUE IS SPACE. IX1074.2 +036200 02 FILLER PIC IS X(65) VALUE IS "************************IX1074.2 +036300- "*****************************************". IX1074.2 +036400 02 FILLER PIC IS X(54) VALUE IS "************************IX1074.2 +036500- "******************************". IX1074.2 +036600 01 CCVS-PGM-ID PIC X(9) VALUE IX1074.2 +036700 "IX107A". IX1074.2 +036800 PROCEDURE DIVISION. IX1074.2 +036900 CCVS1 SECTION. IX1074.2 +037000 OPEN-FILES. IX1074.2 +037100*P OPEN I-O RAW-DATA. IX1074.2 +037200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1074.2 +037300*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1074.2 +037400*P MOVE "ABORTED " TO C-ABORT. IX1074.2 +037500*P ADD 1 TO C-NO-OF-TESTS. IX1074.2 +037600*P ACCEPT C-DATE FROM DATE. IX1074.2 +037700*P ACCEPT C-TIME FROM TIME. IX1074.2 +037800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1074.2 +037900*PND-E-1. IX1074.2 +038000*P CLOSE RAW-DATA. IX1074.2 +038100 OPEN OUTPUT PRINT-FILE. IX1074.2 +038200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1074.2 +038300 MOVE SPACE TO TEST-RESULTS. IX1074.2 +038400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1074.2 +038500 MOVE ZERO TO REC-SKL-SUB. IX1074.2 +038600 PERFORM CCVS-INIT-FILE 9 TIMES. IX1074.2 +038700 CCVS-INIT-FILE. IX1074.2 +038800 ADD 1 TO REC-SKL-SUB. IX1074.2 +038900 MOVE FILE-RECORD-INFO-SKELETON IX1074.2 +039000 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1074.2 +039100 CCVS-INIT-EXIT. IX1074.2 +039200 GO TO CCVS1-EXIT. IX1074.2 +039300 CLOSE-FILES. IX1074.2 +039400*P OPEN I-O RAW-DATA. IX1074.2 +039500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1074.2 +039600*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1074.2 +039700*P MOVE "OK. " TO C-ABORT. IX1074.2 +039800*P MOVE PASS-COUNTER TO C-OK. IX1074.2 +039900*P MOVE ERROR-HOLD TO C-ALL. IX1074.2 +040000*P MOVE ERROR-COUNTER TO C-FAIL. IX1074.2 +040100*P MOVE DELETE-COUNTER TO C-DELETED. IX1074.2 +040200*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1074.2 +040300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1074.2 +040400*PND-E-2. IX1074.2 +040500*P CLOSE RAW-DATA. IX1074.2 +040600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1074.2 +040700 TERMINATE-CCVS. IX1074.2 +040800*S EXIT PROGRAM. IX1074.2 +040900*SERMINATE-CALL. IX1074.2 +041000 STOP RUN. IX1074.2 +041100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1074.2 +041200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1074.2 +041300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1074.2 +041400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1074.2 +041500 MOVE "****TEST DELETED****" TO RE-MARK. IX1074.2 +041600 PRINT-DETAIL. IX1074.2 +041700 IF REC-CT NOT EQUAL TO ZERO IX1074.2 +041800 MOVE "." TO PARDOT-X IX1074.2 +041900 MOVE REC-CT TO DOTVALUE. IX1074.2 +042000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1074.2 +042100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1074.2 +042200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1074.2 +042300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1074.2 +042400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1074.2 +042500 MOVE SPACE TO CORRECT-X. IX1074.2 +042600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1074.2 +042700 MOVE SPACE TO RE-MARK. IX1074.2 +042800 HEAD-ROUTINE. IX1074.2 +042900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +043000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +043100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1074.2 +043200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1074.2 +043300 COLUMN-NAMES-ROUTINE. IX1074.2 +043400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +043500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +043600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +043700 END-ROUTINE. IX1074.2 +043800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1074.2 +043900 END-RTN-EXIT. IX1074.2 +044000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +044100 END-ROUTINE-1. IX1074.2 +044200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1074.2 +044300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1074.2 +044400 ADD PASS-COUNTER TO ERROR-HOLD. IX1074.2 +044500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1074.2 +044600 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1074.2 +044700 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1074.2 +044800 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1074.2 +044900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1074.2 +045000 END-ROUTINE-12. IX1074.2 +045100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1074.2 +045200 IF ERROR-COUNTER IS EQUAL TO ZERO IX1074.2 +045300 MOVE "NO " TO ERROR-TOTAL IX1074.2 +045400 ELSE IX1074.2 +045500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1074.2 +045600 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1074.2 +045700 PERFORM WRITE-LINE. IX1074.2 +045800 END-ROUTINE-13. IX1074.2 +045900 IF DELETE-COUNTER IS EQUAL TO ZERO IX1074.2 +046000 MOVE "NO " TO ERROR-TOTAL ELSE IX1074.2 +046100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1074.2 +046200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1074.2 +046300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +046400 IF INSPECT-COUNTER EQUAL TO ZERO IX1074.2 +046500 MOVE "NO " TO ERROR-TOTAL IX1074.2 +046600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1074.2 +046700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1074.2 +046800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +046900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1074.2 +047000 WRITE-LINE. IX1074.2 +047100 ADD 1 TO RECORD-COUNT. IX1074.2 +047200 IF RECORD-COUNT GREATER 42 IX1074.2 +047300 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1074.2 +047400 MOVE SPACE TO DUMMY-RECORD IX1074.2 +047500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1074.2 +047600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1074.2 +047700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1074.2 +047800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1074.2 +047900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1074.2 +048000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1074.2 +048100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1074.2 +048200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1074.2 +048300 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1074.2 +048400 MOVE ZERO TO RECORD-COUNT. IX1074.2 +048500 PERFORM WRT-LN. IX1074.2 +048600 WRT-LN. IX1074.2 +048700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1074.2 +048800 MOVE SPACE TO DUMMY-RECORD. IX1074.2 +048900 BLANK-LINE-PRINT. IX1074.2 +049000 PERFORM WRT-LN. IX1074.2 +049100 FAIL-ROUTINE. IX1074.2 +049200 IF COMPUTED-X NOT EQUAL TO SPACE IX1074.2 +049300 GO TO FAIL-ROUTINE-WRITE. IX1074.2 +049400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1074.2 +049500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1074.2 +049600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1074.2 +049700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +049800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1074.2 +049900 GO TO FAIL-ROUTINE-EX. IX1074.2 +050000 FAIL-ROUTINE-WRITE. IX1074.2 +050100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1074.2 +050200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1074.2 +050300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1074.2 +050400 MOVE SPACES TO COR-ANSI-REFERENCE. IX1074.2 +050500 FAIL-ROUTINE-EX. EXIT. IX1074.2 +050600 BAIL-OUT. IX1074.2 +050700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1074.2 +050800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1074.2 +050900 BAIL-OUT-WRITE. IX1074.2 +051000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1074.2 +051100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1074.2 +051200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1074.2 +051300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1074.2 +051400 BAIL-OUT-EX. EXIT. IX1074.2 +051500 CCVS1-EXIT. IX1074.2 +051600 EXIT. IX1074.2 +051700 SECT-IX107A-001 SECTION. IX1074.2 +051800 WRITE-INIT-GF-01. IX1074.2 +051900 OPEN OUTPUT IX-FS1. IX1074.2 +052000 MOVE ZERO TO WRK-CS-09V00-001. IX1074.2 +052100 MOVE ZERO TO WRK-DU-05V00-001. IX1074.2 +052200 MOVE "IX-FS1" TO XFILE-NAME (1). IX1074.2 +052300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1074.2 +052400 MOVE 00001 TO XRECORD-NUMBER (1). IX1074.2 +052500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1074.2 +052600 MOVE 750 TO RECORDS-IN-FILE (1). IX1074.2 +052700 MOVE 240 TO XRECORD-LENGTH (1). IX1074.2 +052800 MOVE 0001 TO XBLOCK-SIZE (1). IX1074.2 +052900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1074.2 +053000 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1074.2 +053100 MOVE "S" TO XLABEL-TYPE (1). IX1074.2 +053200 MOVE "FILE CREATED" TO RE-MARK. IX1074.2 +053300 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1074.2 +053400 MOVE "WRITE SEQUENTIAL" TO FEATURE. IX1074.2 +053500 MOVE ZERO TO REC-CT. IX1074.2 +053600 WRITE-TEST-GF-01-R. IX1074.2 +053700 MOVE XRECORD-NUMBER (1) TO WRK-DU-05V00-001. IX1074.2 +053800 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX1074.2 +053900 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX1074.2 +054000 WRITE IX-FS1R1-F-G-240 IX1074.2 +054100 INVALID KEY GO TO WRITE-TEST-GF-01-1. IX1074.2 +054200 IF XRECORD-NUMBER (1) NOT LESS THAN FS1-FILE-SIZE IX1074.2 +054300 GO TO WRITE-TEST-GF-01-1. IX1074.2 +054400 ADD 0001 TO XRECORD-NUMBER (1). IX1074.2 +054500 GO TO WRITE-TEST-GF-01-R. IX1074.2 +054600 WRITE-TEST-GF-01-1. IX1074.2 +054700 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX1074.2 +054800 MOVE FS1-FILE-SIZE TO CORRECT-18V0. IX1074.2 +054900 IF XRECORD-NUMBER (1) EQUAL TO FS1-FILE-SIZE IX1074.2 +055000 PERFORM PASS IX1074.2 +055100 ELSE IX1074.2 +055200 MOVE "IX-41 4.9.2 " TO RE-MARK IX1074.2 +055300 PERFORM FAIL. IX1074.2 +055400 PERFORM PRINT-DETAIL. IX1074.2 +055500 CLOSE IX-FS1. IX1074.2 +055600 READ-INIT-F1-01. IX1074.2 +055700 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +055800* THIS TEST READS AND CHECKS THE FILE CREATED IN IX1074.2 +055900* READ-TEST-001. IX1074.2 +056000 OPEN INPUT IX-FS1. IX1074.2 +056100 READ-TEST-F1-01. IX1074.2 +056200 READ IX-FS1 IX1074.2 +056300 AT END GO TO READ-TEST-F1-01-1. IX1074.2 +056400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1074.2 +056500 ADD 1 TO WRK-CS-09V00. IX1074.2 +056600 IF WRK-CS-09V00 GREATER THAN 750 IX1074.2 +056700 MOVE "MORE THAN 750 RECORDS" TO RE-MARK IX1074.2 +056800 GO TO READ-FAIL-F1-01. IX1074.2 +056900 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) IX1074.2 +057000 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +057100 GO TO READ-TEST-F1-01. IX1074.2 +057200 IF XFILE-NAME (1) NOT EQUAL TO "IX-FS1" IX1074.2 +057300 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +057400 GO TO READ-TEST-F1-01. IX1074.2 +057500 IF XLABEL-TYPE (1) NOT EQUAL TO "S" IX1074.2 +057600 ADD 1 TO RECORDS-IN-ERROR. IX1074.2 +057700 GO TO READ-TEST-F1-01. IX1074.2 +057800 READ-TEST-F1-01-1. IX1074.2 +057900 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1074.2 +058000 GO TO READ-PASS-F1-01. IX1074.2 +058100 MOVE "ERRORS IN READING IX-FS1" TO RE-MARK. IX1074.2 +058200 READ-FAIL-F1-01. IX1074.2 +058300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. IX1074.2 +058400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IX1074.2 +058500 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +058600 PERFORM FAIL. IX1074.2 +058700 GO TO READ-WRITE-F1-01. IX1074.2 +058800 READ-PASS-F1-01. IX1074.2 +058900 PERFORM PASS. IX1074.2 +059000 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IX1074.2 +059100 MOVE WRK-CS-09V00 TO CORRECT-18V0. IX1074.2 +059200 READ-WRITE-F1-01. IX1074.2 +059300 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX1074.2 +059400 MOVE "READ TO VERIFY " TO FEATURE. IX1074.2 +059500 PERFORM PRINT-DETAIL. IX1074.2 +059600 READ-CLOSE-F1-01. IX1074.2 +059700 CLOSE IX-FS1. IX1074.2 +059800 READ-INIT-F1-02. IX1074.2 +059900 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +060000 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +060100 OPEN INPUT IX-FS1. IX1074.2 +060200* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED IX1074.2 +060300* IN THIS SERIES OF TESTS. IX1074.2 +060400 MOVE "READ...RECORD AT END ..." TO FEATURE. IX1074.2 +060500 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX1074.2 +060600 MOVE ZERO TO ERROR-FLAG. IX1074.2 +060700 READ-TEST-F1-02. IX1074.2 +060800 READ IX-FS1 RECORD AT END IX1074.2 +060900 MOVE "UNEXPECTED EOF" TO COMPUTED-A IX1074.2 +061000 MOVE 1 TO EOF-FLAG IX1074.2 +061100 GO TO READ-FAIL-F1-02. IX1074.2 +061200 PERFORM RECORD-CHECK. IX1074.2 +061300 IF WRK-CS-09V00 EQUAL TO 200 IX1074.2 +061400 GO TO READ-TEST-F1-02-1. IX1074.2 +061500 GO TO READ-TEST-F1-02. IX1074.2 +061600 RECORD-CHECK. IX1074.2 +061700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX1074.2 +061800 ADD 1 TO WRK-CS-09V00. IX1074.2 +061900 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) IX1074.2 +062000 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +062100 MOVE 1 TO ERROR-FLAG. IX1074.2 +062200 READ-TEST-F1-02-1. IX1074.2 +062300 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +062400 GO TO READ-PASS-F1-02. IX1074.2 +062500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +062600 READ-FAIL-F1-02. IX1074.2 +062700 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +062800 PERFORM FAIL. IX1074.2 +062900 GO TO READ-WRITE-F1-02. IX1074.2 +063000 READ-PASS-F1-02. IX1074.2 +063100 PERFORM PASS. IX1074.2 +063200 READ-WRITE-F1-02. IX1074.2 +063300 PERFORM PRINT-DETAIL. IX1074.2 +063400 READ-INIT-F1-03. IX1074.2 +063500 IF EOF-FLAG EQUAL TO 1 IX1074.2 +063600 GO TO READ-EOF-F1-06. IX1074.2 +063700 MOVE ZERO TO ERROR-FLAG. IX1074.2 +063800 MOVE "READ...AT END..." TO FEATURE. IX1074.2 +063900 MOVE "READ-TEST-F1-03" TO PAR-NAME. IX1074.2 +064000 READ-TEST-F1-03. IX1074.2 +064100 READ IX-FS1 AT END IX1074.2 +064200 MOVE "UNEXPECTED EOF" TO COMPUTED-A IX1074.2 +064300 MOVE 1 TO EOF-FLAG IX1074.2 +064400 GO TO READ-FAIL-F1-03. IX1074.2 +064500 PERFORM RECORD-CHECK. IX1074.2 +064600 IF WRK-CS-09V00 EQUAL TO 400 IX1074.2 +064700 GO TO READ-TEST-F1-03-1. IX1074.2 +064800 GO TO READ-TEST-F1-03. IX1074.2 +064900 READ-TEST-F1-03-1. IX1074.2 +065000 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +065100 GO TO READ-PASS-F1-03. IX1074.2 +065200 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +065300 READ-FAIL-F1-03. IX1074.2 +065400 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +065500 PERFORM FAIL. IX1074.2 +065600 GO TO READ-WRITE-F1-03. IX1074.2 +065700 READ-PASS-F1-03. IX1074.2 +065800 PERFORM PASS. IX1074.2 +065900 READ-WRITE-F1-03. IX1074.2 +066000 PERFORM PRINT-DETAIL. IX1074.2 +066100 READ-INIT-F1-04. IX1074.2 +066200 IF EOF-FLAG EQUAL TO 1 IX1074.2 +066300 GO TO READ-EOF-F1-06. IX1074.2 +066400 MOVE ZERO TO ERROR-FLAG. IX1074.2 +066500 MOVE "READ...RECORD END..." TO FEATURE. IX1074.2 +066600 MOVE "READ-TEST-F1-04" TO PAR-NAME. IX1074.2 +066700 READ-TEST-F1-04. IX1074.2 +066800 READ IX-FS1 RECORD END IX1074.2 +066900 MOVE "UNEXPECTED EOF" TO COMPUTED-A IX1074.2 +067000 MOVE 1 TO EOF-FLAG IX1074.2 +067100 GO TO READ-FAIL-F1-04. IX1074.2 +067200 PERFORM RECORD-CHECK. IX1074.2 +067300 IF WRK-CS-09V00 EQUAL TO 600 IX1074.2 +067400 GO TO READ-TEST-F1-04-1. IX1074.2 +067500 GO TO READ-TEST-F1-04. IX1074.2 +067600 READ-TEST-F1-04-1. IX1074.2 +067700 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +067800 GO TO READ-PASS-F1-04. IX1074.2 +067900 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +068000 READ-FAIL-F1-04. IX1074.2 +068100 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +068200 PERFORM FAIL. IX1074.2 +068300 GO TO READ-WRITE-F1-04. IX1074.2 +068400 READ-PASS-F1-04. IX1074.2 +068500 PERFORM PASS. IX1074.2 +068600 READ-WRITE-F1-04. IX1074.2 +068700 PERFORM PRINT-DETAIL. IX1074.2 +068800 READ-INIT-F1-05. IX1074.2 +068900 IF EOF-FLAG EQUAL TO 1 IX1074.2 +069000 GO TO READ-EOF-F1-06. IX1074.2 +069100 MOVE ZERO TO ERROR-FLAG. IX1074.2 +069200 MOVE "READ...END..." TO RE-MARK. IX1074.2 +069300 MOVE "READ-TEST-F1-05" TO PAR-NAME. IX1074.2 +069400 READ-TEST-F1-05. IX1074.2 +069500 READ IX-FS1 END GO TO READ-TEST-F1-05-1. IX1074.2 +069600 PERFORM RECORD-CHECK. IX1074.2 +069700 IF WRK-CS-09V00 GREATER THAN 750 IX1074.2 +069800 GO TO READ-TEST-F1-05-1. IX1074.2 +069900 GO TO READ-TEST-F1-05. IX1074.2 +070000 READ-TEST-F1-05-1. IX1074.2 +070100 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +070200 GO TO READ-PASS-F1-05. IX1074.2 +070300 READ-FAIL-F1-05. IX1074.2 +070400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +070500 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +070600 PERFORM FAIL. IX1074.2 +070700 GO TO READ-WRITE-F1-05. IX1074.2 +070800 READ-PASS-F1-05. IX1074.2 +070900 PERFORM PASS. IX1074.2 +071000 READ-WRITE-F1-05. IX1074.2 +071100 PERFORM PRINT-DETAIL. IX1074.2 +071200 READ-TEST-F1-06. IX1074.2 +071300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO IX1074.2 +071400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A IX1074.2 +071500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 IX1074.2 +071600 GO TO READ-FAIL-F1-06. IX1074.2 +071700 IF WRK-CS-09V00 GREATER THAN 750 IX1074.2 +071800 MOVE "MORE THAN 750 RECORDS" TO RE-MARK IX1074.2 +071900 GO TO READ-FAIL-F1-06. IX1074.2 +072000 READ-PASS-F1-06. IX1074.2 +072100 PERFORM PASS. IX1074.2 +072200 GO TO READ-WRITE-F1-06. IX1074.2 +072300 READ-EOF-F1-06. IX1074.2 +072400 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. IX1074.2 +072500 MOVE "RECORDS READ =" TO COMPUTED-A. IX1074.2 +072600 MOVE WRK-CS-09V00 TO CORRECT-18V0. IX1074.2 +072700 READ-FAIL-F1-06. IX1074.2 +072800 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +072900 PERFORM FAIL. IX1074.2 +073000 READ-WRITE-F1-06. IX1074.2 +073100 MOVE "READ-TEST-F1-06" TO PAR-NAME. IX1074.2 +073200 MOVE "READ IX-FS1 750R" TO FEATURE. IX1074.2 +073300 PERFORM PRINT-DETAIL. IX1074.2 +073400 READ-CLOSE-F1-06. IX1074.2 +073500 CLOSE IX-FS1. IX1074.2 +073600 SECT-IX107A-002 SECTION. IX1074.2 +073700 WRITE-INIT-GF-02. IX1074.2 +073800 OPEN OUTPUT IX-FD2. IX1074.2 +073900 MOVE ZERO TO WRK-CS-09V00-001. IX1074.2 +074000 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +074100 MOVE "IX-FD2" TO XFILE-NAME (2). IX1074.2 +074200 MOVE "R1-F-G" TO XRECORD-NAME (2). IX1074.2 +074300 MOVE 00001 TO XRECORD-NUMBER (2). IX1074.2 +074400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX1074.2 +074500 MOVE 649 TO RECORDS-IN-FILE (2). IX1074.2 +074600 MOVE 240 TO XRECORD-LENGTH (2). IX1074.2 +074700 MOVE 0005 TO XBLOCK-SIZE (2). IX1074.2 +074800 MOVE "RC" TO CHARS-OR-RECORDS (2). IX1074.2 +074900 MOVE "IX" TO XFILE-ORGANIZATION (2). IX1074.2 +075000 MOVE "S" TO XLABEL-TYPE (2). IX1074.2 +075100 MOVE "FILE CREATED" TO RE-MARK. IX1074.2 +075200 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1074.2 +075300 MOVE "WRITE RANDOM MODE" TO FEATURE. IX1074.2 +075400 MOVE ZERO TO REC-CT. IX1074.2 +075500 WRITE-TEST-GF-02-R. IX1074.2 +075600 MOVE XRECORD-NUMBER (2) TO WRK-DU-05V00-002. IX1074.2 +075700 MOVE WRK-FD2-RECKEY TO XRECORD-KEY (2). IX1074.2 +075800 MOVE FILE-RECORD-INFO (2) TO IX-FD2R1-F-G-240. IX1074.2 +075900 WRITE IX-FD2R1-F-G-240 IX1074.2 +076000 INVALID KEY GO TO WRITE-TEST-GF-02-1. IX1074.2 +076100 IF XRECORD-NUMBER (2) NOT LESS THAN FD2-FILE-SIZE IX1074.2 +076200 GO TO WRITE-TEST-GF-02-1. IX1074.2 +076300 ADD 0001 TO XRECORD-NUMBER (2). IX1074.2 +076400 GO TO WRITE-TEST-GF-02-R. IX1074.2 +076500 WRITE-TEST-GF-02-1. IX1074.2 +076600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0. IX1074.2 +076700 MOVE FD2-FILE-SIZE TO CORRECT-18V0. IX1074.2 +076800 IF XRECORD-NUMBER (2) EQUAL TO FD2-FILE-SIZE IX1074.2 +076900 PERFORM PASS IX1074.2 +077000 ELSE IX1074.2 +077100 MOVE "IX-41 4.9.2 " TO RE-MARK IX1074.2 +077200 PERFORM FAIL. IX1074.2 +077300 PERFORM PRINT-DETAIL. IX1074.2 +077400 CLOSE IX-FD2. IX1074.2 +077500 READ-INIT-F2-07. IX1074.2 +077600 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +077700 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +077800 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +077900* THIS TEST READS AND CHECKS THE FILE CREATED IN IX1074.2 +078000* READ-TEST-GF-02. IX1074.2 +078100 OPEN INPUT IX-FD2. IX1074.2 +078200 READ-TEST-F2-07. IX1074.2 +078300 ADD 00001 TO WRK-DU-05V00-002. IX1074.2 +078400 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +078500 READ IX-FD2 RECORD IX1074.2 +078600 INVALID KEY GO TO READ-TEST-F2-07-1. IX1074.2 +078700 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX1074.2 +078800 ADD 1 TO WRK-CS-09V00. IX1074.2 +078900 IF WRK-CS-09V00 GREATER THAN 649 IX1074.2 +079000 MOVE "MORE THAN 649 RECORDS" TO RE-MARK IX1074.2 +079100 GO TO READ-FAIL-F2-07. IX1074.2 +079200 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (2) IX1074.2 +079300 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +079400 GO TO READ-TEST-F2-07. IX1074.2 +079500 IF XFILE-NAME (2) NOT EQUAL TO "IX-FD2" IX1074.2 +079600 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +079700 GO TO READ-TEST-F2-07. IX1074.2 +079800 IF XLABEL-TYPE (2) NOT EQUAL TO "S" IX1074.2 +079900 ADD 1 TO RECORDS-IN-ERROR. IX1074.2 +080000 GO TO READ-TEST-F2-07. IX1074.2 +080100 READ-TEST-F2-07-1. IX1074.2 +080200 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1074.2 +080300 GO TO READ-PASS-F2-07. IX1074.2 +080400 MOVE "ERRORS IN READING IX-FD2" TO RE-MARK. IX1074.2 +080500 READ-FAIL-F2-07. IX1074.2 +080600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IX1074.2 +080700 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +080800 PERFORM FAIL. IX1074.2 +080900 GO TO READ-READ-F2-07. IX1074.2 +081000 READ-PASS-F2-07. IX1074.2 +081100 PERFORM PASS. IX1074.2 +081200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IX1074.2 +081300 MOVE WRK-CS-09V00 TO CORRECT-18V0. IX1074.2 +081400 READ-READ-F2-07. IX1074.2 +081500 MOVE "READ-TEST-F2-07" TO PAR-NAME. IX1074.2 +081600 MOVE "VERIFY FILE IX-FD2" TO FEATURE. IX1074.2 +081700 PERFORM PRINT-DETAIL. IX1074.2 +081800 READ-CLOSE-F2-07. IX1074.2 +081900 CLOSE IX-FD2. IX1074.2 +082000 READ-INIT-F2-08. IX1074.2 +082100 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +082200 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +082300 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +082400 OPEN INPUT IX-FD2. IX1074.2 +082500* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED IX1074.2 +082600* IN THIS SERIES OF TESTS. IX1074.2 +082700 MOVE "LEV 1 READ STATEMENT" TO FEATURE. IX1074.2 +082800 MOVE ZERO TO EOF-FLAG. IX1074.2 +082900 MOVE "READ...RECORD INVALID KEY ..." TO FEATURE. IX1074.2 +083000 MOVE "READ-TEST-F2-08" TO PAR-NAME. IX1074.2 +083100 MOVE ZERO TO ERROR-FLAG. IX1074.2 +083200 READ-TEST-F2-08. IX1074.2 +083300 ADD 0001 TO WRK-DU-05V00-002. IX1074.2 +083400 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +083500 READ IX-FD2 RECORD IX1074.2 +083600 INVALID KEY MOVE "INVALID KEY" TO COMPUTED-A IX1074.2 +083700 MOVE 1 TO EOF-FLAG IX1074.2 +083800 GO TO READ-FAIL-F2-08. IX1074.2 +083900 PERFORM RECORD-CHECK-1. IX1074.2 +084000 IF WRK-CS-09V00 EQUAL TO 50 IX1074.2 +084100 GO TO READ-TEST-F2-08-1. IX1074.2 +084200 GO TO READ-TEST-F2-08. IX1074.2 +084300 RECORD-CHECK-1. IX1074.2 +084400 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX1074.2 +084500 ADD 1 TO WRK-CS-09V00. IX1074.2 +084600 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (2) IX1074.2 +084700 ADD 1 TO RECORDS-IN-ERROR IX1074.2 +084800 MOVE 1 TO ERROR-FLAG. IX1074.2 +084900 READ-TEST-F2-08-1. IX1074.2 +085000 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +085100 GO TO READ-PASS-F2-08. IX1074.2 +085200 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +085300 READ-FAIL-F2-08. IX1074.2 +085400 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +085500 PERFORM FAIL. IX1074.2 +085600 GO TO READ-WRITE-F2-08. IX1074.2 +085700 READ-PASS-F2-08. IX1074.2 +085800 PERFORM PASS. IX1074.2 +085900 READ-WRITE-F2-08. IX1074.2 +086000 PERFORM PRINT-DETAIL. IX1074.2 +086100 READ-INIT-F2-09. IX1074.2 +086200 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +086300 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +086400 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +086500 IF EOF-FLAG EQUAL TO 1 IX1074.2 +086600 GO TO READ-EOF-F2-12. IX1074.2 +086700 MOVE ZERO TO ERROR-FLAG. IX1074.2 +086800 MOVE "READ...INVALID KEY..." TO FEATURE. IX1074.2 +086900 MOVE "READ-TEST-F2-09" TO PAR-NAME. IX1074.2 +087000 READ-TEST-F2-09. IX1074.2 +087100 ADD 00001 TO WRK-DU-05V00-002. IX1074.2 +087200 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +087300 READ IX-FD2 INVALID KEY IX1074.2 +087400 MOVE "INVALID KEY" TO COMPUTED-A IX1074.2 +087500 MOVE 1 TO EOF-FLAG IX1074.2 +087600 GO TO READ-FAIL-F2-09. IX1074.2 +087700 PERFORM RECORD-CHECK-1. IX1074.2 +087800 IF WRK-CS-09V00 EQUAL TO 200 IX1074.2 +087900 GO TO READ-TEST-F2-09-1. IX1074.2 +088000 GO TO READ-TEST-F2-09. IX1074.2 +088100 READ-TEST-F2-09-1. IX1074.2 +088200 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +088300 GO TO READ-PASS-F2-09. IX1074.2 +088400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +088500 READ-FAIL-F2-09. IX1074.2 +088600 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +088700 PERFORM FAIL. IX1074.2 +088800 GO TO READ-WRITE-F2-09. IX1074.2 +088900 READ-PASS-F2-09. IX1074.2 +089000 PERFORM PASS. IX1074.2 +089100 READ-WRITE-F2-09. IX1074.2 +089200 PERFORM PRINT-DETAIL. IX1074.2 +089300 READ-INIT-F2-10. IX1074.2 +089400 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +089500 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +089600 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +089700 IF EOF-FLAG EQUAL TO 1 IX1074.2 +089800 GO TO READ-EOF-F2-12. IX1074.2 +089900 MOVE ZERO TO ERROR-FLAG. IX1074.2 +090000 MOVE "READ...RECORD INVALID..." TO FEATURE. IX1074.2 +090100 MOVE "READ-TEST-F2-10" TO PAR-NAME. IX1074.2 +090200 READ-TEST-F2-10. IX1074.2 +090300 ADD 0001 TO WRK-DU-05V00-002. IX1074.2 +090400 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +090500 READ IX-FD2 RECORD INVALID IX1074.2 +090600 MOVE "INVALID KEY" TO COMPUTED-A IX1074.2 +090700 MOVE 1 TO EOF-FLAG IX1074.2 +090800 GO TO READ-FAIL-F2-10. IX1074.2 +090900 PERFORM RECORD-CHECK-1. IX1074.2 +091000 IF WRK-CS-09V00 EQUAL TO 499 IX1074.2 +091100 GO TO READ-TEST-F2-10-1. IX1074.2 +091200 GO TO READ-TEST-F2-10. IX1074.2 +091300 READ-TEST-F2-10-1. IX1074.2 +091400 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +091500 GO TO READ-PASS-F2-10. IX1074.2 +091600 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +091700 READ-FAIL-F2-10. IX1074.2 +091800 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +091900 PERFORM FAIL. IX1074.2 +092000 GO TO READ-WRITE-F2-10. IX1074.2 +092100 READ-PASS-F2-10. IX1074.2 +092200 PERFORM PASS. IX1074.2 +092300 READ-WRITE-F2-10. IX1074.2 +092400 PERFORM PRINT-DETAIL. IX1074.2 +092500 READ-INIT-F2-11. IX1074.2 +092600 MOVE ZERO TO WRK-DU-05V00-002. IX1074.2 +092700 MOVE ZERO TO WRK-CS-09V00. IX1074.2 +092800 MOVE ZERO TO RECORDS-IN-ERROR. IX1074.2 +092900 IF EOF-FLAG EQUAL TO 1 IX1074.2 +093000 GO TO READ-EOF-F2-12. IX1074.2 +093100 MOVE ZERO TO ERROR-FLAG. IX1074.2 +093200 MOVE "READ...INVALID..." TO FEATURE. IX1074.2 +093300 MOVE "READ-TEST-F2-11" TO PAR-NAME. IX1074.2 +093400 READ-TEST-F2-11. IX1074.2 +093500 ADD 0001 TO WRK-DU-05V00-002. IX1074.2 +093600 MOVE WRK-FD2-RECKEY TO IX-FD2-KEY. IX1074.2 +093700 READ IX-FD2 INVALID IX1074.2 +093800 GO TO READ-TEST-F2-11-1. IX1074.2 +093900 PERFORM RECORD-CHECK-1. IX1074.2 +094000 IF WRK-CS-09V00 GREATER THAN 649 IX1074.2 +094100 GO TO READ-TEST-F2-11-1. IX1074.2 +094200 GO TO READ-TEST-F2-11. IX1074.2 +094300 READ-TEST-F2-11-1. IX1074.2 +094400 IF ERROR-FLAG EQUAL TO ZERO IX1074.2 +094500 GO TO READ-PASS-F2-11. IX1074.2 +094600 READ-FAIL-F2-11. IX1074.2 +094700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. IX1074.2 +094800 MOVE "IX-28 4.5.2 " TO RE-MARK.IX1074.2 +094900 PERFORM FAIL. IX1074.2 +095000 GO TO READ-WRITE-F2-11. IX1074.2 +095100 READ-PASS-F2-11. IX1074.2 +095200 PERFORM PASS. IX1074.2 +095300 READ-WRITE-F2-11. IX1074.2 +095400 PERFORM PRINT-DETAIL. IX1074.2 +095500 READ-TEST-F2-12. IX1074.2 +095600 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO IX1074.2 +095700 MOVE "RECORDS IN ERROR =" TO COMPUTED-A IX1074.2 +095800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 IX1074.2 +095900 GO TO READ-FAIL-F2-12. IX1074.2 +096000 IF WRK-CS-09V00 GREATER THAN 649 IX1074.2 +096100 MOVE "MORE THAN 649 RECORDS" TO RE-MARK IX1074.2 +096200 GO TO READ-FAIL-F2-12. IX1074.2 +096300 READ-PASS-F2-12. IX1074.2 +096400 PERFORM PASS IX1074.2 +096500 GO TO READ-WRITE-F2-12. IX1074.2 +096600 READ-EOF-F2-12. IX1074.2 +096700 MOVE "LESS THAN 649 RECORDS" TO RE-MARK. IX1074.2 +096800 MOVE "RECORDS READ =" TO COMPUTED-A. IX1074.2 +096900 MOVE WRK-CS-09V00 TO CORRECT-18V0. IX1074.2 +097000 READ-FAIL-F2-12. IX1074.2 +097100 PERFORM FAIL. IX1074.2 +097200 READ-WRITE-F2-12. IX1074.2 +097300 MOVE "READ-TEST-F2-12" TO PAR-NAME. IX1074.2 +097400 MOVE "READ IX-FS2 VERIFY" TO FEATURE. IX1074.2 +097500 PERFORM PRINT-DETAIL. IX1074.2 +097600 READ-CLOSE-F2-12. IX1074.2 +097700 CLOSE IX-FD2. IX1074.2 +097800 TERMINATE-ROUTINE. IX1074.2 +097900 EXIT. IX1074.2 +098000 CCVS-EXIT SECTION. IX1074.2 +098100 CCVS-999999. IX1074.2 +098200 GO TO CLOSE-FILES. IX1074.2 diff --git a/tests/cobol85/IX/IX108A.CBL b/tests/cobol85/IX/IX108A.CBL new file mode 100755 index 00000000..3ca3e1da --- /dev/null +++ b/tests/cobol85/IX/IX108A.CBL @@ -0,0 +1,1458 @@ +000100 IDENTIFICATION DIVISION. IX1084.2 +000200 PROGRAM-ID. IX1084.2 +000300 IX108A. IX1084.2 +000400**************************************************************** IX1084.2 +000500* * IX1084.2 +000600* VALIDATION FOR:- * IX1084.2 +000700* * IX1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1084.2 +000900* * IX1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1084.2 +001100* * IX1084.2 +001200**************************************************************** IX1084.2 +001300* IX1084.2 +001400* NEW TESTS: IX1084.2 +001500* IX1084.2 +001600* READ STATEMENT WITH THE PHRASES: IX1084.2 +001700* READ ... NOT AT END AND END-READ IX1084.2 +001800* FOR FORMAT 1 AND 2 OF THE READ STATEMENT IX1084.2 +001900* IX1084.2 +002000* DELETE STATEMENT WITH THE PHRASES: IX1084.2 +002100* DELETE ... NOT INVALID AND END-DELETE IX1084.2 +002200* IX1084.2 +002300* REWRITE STATEMENT WITH THE PHRASES: IX1084.2 +002400* REWRITE ... NOT INVALID KEY AND END-REWRITE IX1084.2 +002500* IX1084.2 +002600* WRITE STATEMENT WITH THE PHRASES: IX1084.2 +002700* WRITE ... NOT INVALID KEY AND END-WRITE IX1084.2 +002800* IX1084.2 +002900* IX1084.2 +003000* IX1084.2 +003100* IX1084.2 +003200* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX1084.2 +003300* IX1084.2 +003400* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1084.2 +003500* CLAUSE FOR DATA FILE IX-FD1 IX1084.2 +003600* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1084.2 +003700* CLAUSE FOR INDEX FILE IX-FD1 IX1084.2 +003800* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1084.2 +003900* CLAUSE FOR DATA FILE IX-FD2 IX1084.2 +004000* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX1084.2 +004100* CLAUSE FOR INDEX FILE IX-FD2 IX1084.2 +004200* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX1084.2 +004300* X-62 FOR RAW-DATA IX1084.2 +004400* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX1084.2 +004500* X-84 LABEL RECORDS OF PRINT-FILE IX1084.2 +004600* IX1084.2 +004700* NOTE: X-CARDS 45, 62 AND 84 ARE OPTIONAL IX1084.2 +004800* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX1084.2 +004900* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX1084.2 +005000* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX1084.2 +005100* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX1084.2 +005200* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX1084.2 +005300* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX1084.2 +005400* CONTROL CARD. THE LETTER CORRESPONDS TO A IX1084.2 +005500* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX1084.2 +005600* THEY ARE AS FOLLOWS IX1084.2 +005700* IX1084.2 +005800* J SELECTS X-CARD 45 IX1084.2 +005900* IX1084.2 +006000****************************************************** IX1084.2 +006100 ENVIRONMENT DIVISION. IX1084.2 +006200 CONFIGURATION SECTION. IX1084.2 +006300 SOURCE-COMPUTER. IX1084.2 +006400 Linux. IX1084.2 +006500 OBJECT-COMPUTER. IX1084.2 +006600 Linux. IX1084.2 +006700 INPUT-OUTPUT SECTION. IX1084.2 +006800 FILE-CONTROL. IX1084.2 +006900*P SELECT RAW-DATA ASSIGN TO IX1084.2 +007000*P "XXXXX062" IX1084.2 +007100*P ORGANIZATION IS INDEXED IX1084.2 +007200*P ACCESS MODE IS RANDOM IX1084.2 +007300*P RECORD KEY IS RAW-DATA-KEY. IX1084.2 +007400 SELECT PRINT-FILE ASSIGN TO IX1084.2 +007500 "report.log". IX1084.2 +007600 SELECT IX-FS1 ASSIGN IX1084.2 +007700 "XXXXX024" IX1084.2 +007800*J **** X-CARD UNDEFINED **** IX1084.2 +007900 ORGANIZATION IS INDEXED IX1084.2 +008000 ACCESS SEQUENTIAL IX1084.2 +008100 FILE STATUS IS IX-FS1-STATUS IX1084.2 +008200 RECORD IX-FS1-KEY. IX1084.2 +008300 SELECT IX-FS2 ASSIGN IX1084.2 +008400 "XXXXX025" IX1084.2 +008500*J **** X-CARD UNDEFINED **** IX1084.2 +008600 ORGANIZATION IS INDEXED IX1084.2 +008700 ACCESS RANDOM IX1084.2 +008800 FILE STATUS IS IX-FS2-STATUS IX1084.2 +008900 RECORD IX-FS2-KEY. IX1084.2 +009000 DATA DIVISION. IX1084.2 +009100 FILE SECTION. IX1084.2 +009200*P IX1084.2 +009300*PD RAW-DATA. IX1084.2 +009400*P IX1084.2 +009500*P1 RAW-DATA-SATZ. IX1084.2 +009600*P 05 RAW-DATA-KEY PIC X(6). IX1084.2 +009700*P 05 C-DATE PIC 9(6). IX1084.2 +009800*P 05 C-TIME PIC 9(8). IX1084.2 +009900*P 05 C-NO-OF-TESTS PIC 99. IX1084.2 +010000*P 05 C-OK PIC 999. IX1084.2 +010100*P 05 C-ALL PIC 999. IX1084.2 +010200*P 05 C-FAIL PIC 999. IX1084.2 +010300*P 05 C-DELETED PIC 999. IX1084.2 +010400*P 05 C-INSPECT PIC 999. IX1084.2 +010500*P 05 C-NOTE PIC X(13). IX1084.2 +010600*P 05 C-INDENT PIC X. IX1084.2 +010700*P 05 C-ABORT PIC X(8). IX1084.2 +010800 FD PRINT-FILE. IX1084.2 +010900 01 PRINT-REC PICTURE X(120). IX1084.2 +011000 01 DUMMY-RECORD PICTURE X(120). IX1084.2 +011100 FD IX-FS1 IX1084.2 +011200*C LABEL RECORDS ARE STANDARD IX1084.2 +011300*C DATA RECORDS IX-FS1R1-F-G-240 IX1084.2 +011400 BLOCK CONTAINS 480. IX1084.2 +011500 IX1084.2 +011600 01 IX-FS1R1-F-G-240. IX1084.2 +011700 05 IX-FS1-REC-120 PIC X(120). IX1084.2 +011800 05 IX-FS1-REC-120-240. IX1084.2 +011900 10 FILLER PICTURE X(8). IX1084.2 +012000 10 IX-FS1-KEY PIC X(29). IX1084.2 +012100 10 FILLER PIC X(83). IX1084.2 +012200 IX1084.2 +012300 FD IX-FS2 IX1084.2 +012400*C LABEL RECORDS ARE STANDARD IX1084.2 +012500*C DATA RECORDS IX-FS2R1-F-G-240 IX1084.2 +012600 BLOCK CONTAINS 480. IX1084.2 +012700 IX1084.2 +012800 01 IX-FS2R1-F-G-240. IX1084.2 +012900 05 IX-FS2-REC-120 PIC X(120). IX1084.2 +013000 05 IX-FS2-REC-120-240. IX1084.2 +013100 10 FILLER PICTURE X(8). IX1084.2 +013200 10 IX-FS2-KEY PIC X(29). IX1084.2 +013300 10 FILLER PIC X(83). IX1084.2 +013400 WORKING-STORAGE SECTION. IX1084.2 +013500 01 SWITCHES-FOR-TEST. IX1084.2 +013600 05 SWITCH-NOT-INVALID PIC 9 VALUE ZERO. IX1084.2 +013700 05 SWITCH-END-XXX PIC 9 VALUE ZERO. IX1084.2 +013800 05 SWITCH-END-X9X PIC 9 VALUE ZERO. IX1084.2 +013900 05 SWITCH-IF PIC 9 VALUE ZERO. IX1084.2 +014000 01 GRP-0101. IX1084.2 +014100 02 FILLER PIC X(10) VALUE "ABCD921XYZ". IX1084.2 +014200 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX1084.2 +014300 02 FILLER PIC X(10) VALUE "Z2F()$+-AB". IX1084.2 +014400 01 GRP-0001. IX1084.2 +014500 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +014600 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +014700 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +014800 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +014900 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +015000 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +015100 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. IX1084.2 +015200 05 IX-FS1-STATUS PIC XX VALUE SPACE. IX1084.2 +015300 05 IX-FS2-STATUS PIC XX VALUE SPACE. IX1084.2 +015400 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. IX1084.2 +015500 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. IX1084.2 +015600 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. IX1084.2 +015700 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. IX1084.2 +015800 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. IX1084.2 +015900 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. IX1084.2 +016000 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. IX1084.2 +016100 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. IX1084.2 +016200 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. IX1084.2 +016300 01 DUMMY-WRK-REC. IX1084.2 +016400 02 DUMMY-WRK1 PIC X(120). IX1084.2 +016500 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX1084.2 +016600 03 FILLER PIC X(5). IX1084.2 +016700 03 DUMMY-WRK-INDENT-5 PIC X(115). IX1084.2 +016800 01 FILE-RECORD-INFORMATION-REC. IX1084.2 +016900 03 FILE-RECORD-INFO-SKELETON. IX1084.2 +017000 05 FILLER PICTURE X(48) VALUE IX1084.2 +017100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1084.2 +017200 05 FILLER PICTURE X(46) VALUE IX1084.2 +017300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1084.2 +017400 05 FILLER PICTURE X(26) VALUE IX1084.2 +017500 ",LFIL=000000,ORG= ,LBLR= ". IX1084.2 +017600 05 FILLER PICTURE X(37) VALUE IX1084.2 +017700 ",RECKEY= ". IX1084.2 +017800 05 FILLER PICTURE X(38) VALUE IX1084.2 +017900 ",ALTKEY1= ". IX1084.2 +018000 05 FILLER PICTURE X(38) VALUE IX1084.2 +018100 ",ALTKEY2= ". IX1084.2 +018200 05 FILLER PICTURE X(7) VALUE SPACE.IX1084.2 +018300 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX1084.2 +018400 05 FILE-RECORD-INFO-P1-120. IX1084.2 +018500 07 FILLER PIC X(5). IX1084.2 +018600 07 XFILE-NAME PIC X(6). IX1084.2 +018700 07 FILLER PIC X(8). IX1084.2 +018800 07 XRECORD-NAME PIC X(6). IX1084.2 +018900 07 FILLER PIC X(1). IX1084.2 +019000 07 REELUNIT-NUMBER PIC 9(1). IX1084.2 +019100 07 FILLER PIC X(7). IX1084.2 +019200 07 XRECORD-NUMBER PIC 9(6). IX1084.2 +019300 07 FILLER PIC X(6). IX1084.2 +019400 07 UPDATE-NUMBER PIC 9(2). IX1084.2 +019500 07 FILLER PIC X(5). IX1084.2 +019600 07 ODO-NUMBER PIC 9(4). IX1084.2 +019700 07 FILLER PIC X(5). IX1084.2 +019800 07 XPROGRAM-NAME PIC X(5). IX1084.2 +019900 07 FILLER PIC X(7). IX1084.2 +020000 07 XRECORD-LENGTH PIC 9(6). IX1084.2 +020100 07 FILLER PIC X(7). IX1084.2 +020200 07 CHARS-OR-RECORDS PIC X(2). IX1084.2 +020300 07 FILLER PIC X(1). IX1084.2 +020400 07 XBLOCK-SIZE PIC 9(4). IX1084.2 +020500 07 FILLER PIC X(6). IX1084.2 +020600 07 RECORDS-IN-FILE PIC 9(6). IX1084.2 +020700 07 FILLER PIC X(5). IX1084.2 +020800 07 XFILE-ORGANIZATION PIC X(2). IX1084.2 +020900 07 FILLER PIC X(6). IX1084.2 +021000 07 XLABEL-TYPE PIC X(1). IX1084.2 +021100 05 FILE-RECORD-INFO-P121-240. IX1084.2 +021200 07 FILLER PIC X(8). IX1084.2 +021300 07 XRECORD-KEY PIC X(29). IX1084.2 +021400 07 FILLER PIC X(9). IX1084.2 +021500 07 ALTERNATE-KEY1 PIC X(29). IX1084.2 +021600 07 FILLER PIC X(9). IX1084.2 +021700 07 ALTERNATE-KEY2 PIC X(29). IX1084.2 +021800 07 FILLER PIC X(7). IX1084.2 +021900 01 TEST-RESULTS. IX1084.2 +022000 02 FILLER PIC X VALUE SPACE. IX1084.2 +022100 02 FEATURE PIC X(20) VALUE SPACE. IX1084.2 +022200 02 FILLER PIC X VALUE SPACE. IX1084.2 +022300 02 P-OR-F PIC X(5) VALUE SPACE. IX1084.2 +022400 02 FILLER PIC X VALUE SPACE. IX1084.2 +022500 02 PAR-NAME. IX1084.2 +022600 03 FILLER PIC X(19) VALUE SPACE. IX1084.2 +022700 03 PARDOT-X PIC X VALUE SPACE. IX1084.2 +022800 03 DOTVALUE PIC 99 VALUE ZERO. IX1084.2 +022900 02 FILLER PIC X(8) VALUE SPACE. IX1084.2 +023000 02 RE-MARK PIC X(61). IX1084.2 +023100 01 TEST-COMPUTED. IX1084.2 +023200 02 FILLER PIC X(30) VALUE SPACE. IX1084.2 +023300 02 FILLER PIC X(17) VALUE IX1084.2 +023400 " COMPUTED=". IX1084.2 +023500 02 COMPUTED-X. IX1084.2 +023600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1084.2 +023700 03 COMPUTED-N REDEFINES COMPUTED-A IX1084.2 +023800 PIC -9(9).9(9). IX1084.2 +023900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1084.2 +024000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1084.2 +024100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1084.2 +024200 03 CM-18V0 REDEFINES COMPUTED-A. IX1084.2 +024300 04 COMPUTED-18V0 PIC -9(18). IX1084.2 +024400 04 FILLER PIC X. IX1084.2 +024500 03 FILLER PIC X(50) VALUE SPACE. IX1084.2 +024600 01 TEST-CORRECT. IX1084.2 +024700 02 FILLER PIC X(30) VALUE SPACE. IX1084.2 +024800 02 FILLER PIC X(17) VALUE " CORRECT =". IX1084.2 +024900 02 CORRECT-X. IX1084.2 +025000 03 CORRECT-A PIC X(20) VALUE SPACE. IX1084.2 +025100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1084.2 +025200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1084.2 +025300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1084.2 +025400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1084.2 +025500 03 CR-18V0 REDEFINES CORRECT-A. IX1084.2 +025600 04 CORRECT-18V0 PIC -9(18). IX1084.2 +025700 04 FILLER PIC X. IX1084.2 +025800 03 FILLER PIC X(2) VALUE SPACE. IX1084.2 +025900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1084.2 +026000 01 CCVS-C-1. IX1084.2 +026100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1084.2 +026200- "SS PARAGRAPH-NAME IX1084.2 +026300- " REMARKS". IX1084.2 +026400 02 FILLER PIC X(20) VALUE SPACE. IX1084.2 +026500 01 CCVS-C-2. IX1084.2 +026600 02 FILLER PIC X VALUE SPACE. IX1084.2 +026700 02 FILLER PIC X(6) VALUE "TESTED". IX1084.2 +026800 02 FILLER PIC X(15) VALUE SPACE. IX1084.2 +026900 02 FILLER PIC X(4) VALUE "FAIL". IX1084.2 +027000 02 FILLER PIC X(94) VALUE SPACE. IX1084.2 +027100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1084.2 +027200 01 REC-CT PIC 99 VALUE ZERO. IX1084.2 +027300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1084.2 +027400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1084.2 +027500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1084.2 +027600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1084.2 +027700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1084.2 +027800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1084.2 +027900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1084.2 +028000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1084.2 +028100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1084.2 +028200 01 CCVS-H-1. IX1084.2 +028300 02 FILLER PIC X(39) VALUE SPACES. IX1084.2 +028400 02 FILLER PIC X(42) VALUE IX1084.2 +028500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1084.2 +028600 02 FILLER PIC X(39) VALUE SPACES. IX1084.2 +028700 01 CCVS-H-2A. IX1084.2 +028800 02 FILLER PIC X(40) VALUE SPACE. IX1084.2 +028900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1084.2 +029000 02 FILLER PIC XXXX VALUE IX1084.2 +029100 "4.2 ". IX1084.2 +029200 02 FILLER PIC X(28) VALUE IX1084.2 +029300 " COPY - NOT FOR DISTRIBUTION". IX1084.2 +029400 02 FILLER PIC X(41) VALUE SPACE. IX1084.2 +029500 IX1084.2 +029600 01 CCVS-H-2B. IX1084.2 +029700 02 FILLER PIC X(15) VALUE IX1084.2 +029800 "TEST RESULT OF ". IX1084.2 +029900 02 TEST-ID PIC X(9). IX1084.2 +030000 02 FILLER PIC X(4) VALUE IX1084.2 +030100 " IN ". IX1084.2 +030200 02 FILLER PIC X(12) VALUE IX1084.2 +030300 " HIGH ". IX1084.2 +030400 02 FILLER PIC X(22) VALUE IX1084.2 +030500 " LEVEL VALIDATION FOR ". IX1084.2 +030600 02 FILLER PIC X(58) VALUE IX1084.2 +030700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1084.2 +030800 01 CCVS-H-3. IX1084.2 +030900 02 FILLER PIC X(34) VALUE IX1084.2 +031000 " FOR OFFICIAL USE ONLY ". IX1084.2 +031100 02 FILLER PIC X(58) VALUE IX1084.2 +031200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1084.2 +031300 02 FILLER PIC X(28) VALUE IX1084.2 +031400 " COPYRIGHT 1985 ". IX1084.2 +031500 01 CCVS-E-1. IX1084.2 +031600 02 FILLER PIC X(52) VALUE SPACE. IX1084.2 +031700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1084.2 +031800 02 ID-AGAIN PIC X(9). IX1084.2 +031900 02 FILLER PIC X(45) VALUE SPACES. IX1084.2 +032000 01 CCVS-E-2. IX1084.2 +032100 02 FILLER PIC X(31) VALUE SPACE. IX1084.2 +032200 02 FILLER PIC X(21) VALUE SPACE. IX1084.2 +032300 02 CCVS-E-2-2. IX1084.2 +032400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1084.2 +032500 03 FILLER PIC X VALUE SPACE. IX1084.2 +032600 03 ENDER-DESC PIC X(44) VALUE IX1084.2 +032700 "ERRORS ENCOUNTERED". IX1084.2 +032800 01 CCVS-E-3. IX1084.2 +032900 02 FILLER PIC X(22) VALUE IX1084.2 +033000 " FOR OFFICIAL USE ONLY". IX1084.2 +033100 02 FILLER PIC X(12) VALUE SPACE. IX1084.2 +033200 02 FILLER PIC X(58) VALUE IX1084.2 +033300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1084.2 +033400 02 FILLER PIC X(13) VALUE SPACE. IX1084.2 +033500 02 FILLER PIC X(15) VALUE IX1084.2 +033600 " COPYRIGHT 1985". IX1084.2 +033700 01 CCVS-E-4. IX1084.2 +033800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1084.2 +033900 02 FILLER PIC X(4) VALUE " OF ". IX1084.2 +034000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1084.2 +034100 02 FILLER PIC X(40) VALUE IX1084.2 +034200 " TESTS WERE EXECUTED SUCCESSFULLY". IX1084.2 +034300 01 XXINFO. IX1084.2 +034400 02 FILLER PIC X(19) VALUE IX1084.2 +034500 "*** INFORMATION ***". IX1084.2 +034600 02 INFO-TEXT. IX1084.2 +034700 04 FILLER PIC X(8) VALUE SPACE. IX1084.2 +034800 04 XXCOMPUTED PIC X(20). IX1084.2 +034900 04 FILLER PIC X(5) VALUE SPACE. IX1084.2 +035000 04 XXCORRECT PIC X(20). IX1084.2 +035100 02 INF-ANSI-REFERENCE PIC X(48). IX1084.2 +035200 01 HYPHEN-LINE. IX1084.2 +035300 02 FILLER PIC IS X VALUE IS SPACE. IX1084.2 +035400 02 FILLER PIC IS X(65) VALUE IS "************************IX1084.2 +035500- "*****************************************". IX1084.2 +035600 02 FILLER PIC IS X(54) VALUE IS "************************IX1084.2 +035700- "******************************". IX1084.2 +035800 01 CCVS-PGM-ID PIC X(9) VALUE IX1084.2 +035900 "IX108A". IX1084.2 +036000 PROCEDURE DIVISION. IX1084.2 +036100 DECLARATIVES. IX1084.2 +036200 IX-FS2-01 SECTION. IX1084.2 +036300 USE AFTER STANDARD ERROR PROCEDURE ON IX-FS2. IX1084.2 +036400 IX-FS2-01-01. IX1084.2 +036500 ADD 1 TO WRK-CS-09V00-013. IX1084.2 +036600 GO TO IX-FS2-01-03 IX1084.2 +036700 IX-FS2-01-05 IX1084.2 +036800 DEPENDING ON WRK-CS-09V00-012. IX1084.2 +036900 GO TO IX-FS2-01-EXIT. IX1084.2 +037000 IX-FS2-01-03. IX1084.2 +037100*ENTRY FROM SEGMENT INX-TEST-001. IX1084.2 +037200* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX1084.2 +037300 ADD 1 TO WRK-CS-09V00-014. IX1084.2 +037400 IX-FS2-01-05. IX1084.2 +037500 ADD 1 TO WRK-CS-09V00-017. IX1084.2 +037600 IF XRECORD-NUMBER (2) EQUAL TO 500 IX1084.2 +037700 MOVE IX-FS2-STATUS TO WRK-XN-0002-002 IX1084.2 +037800 MOVE "10" TO WRK-XN-0002-003. IX1084.2 +037900 IX-FS2-01-EXIT. IX1084.2 +038000 EXIT. IX1084.2 +038100 END DECLARATIVES. IX1084.2 +038200 CCVS1 SECTION. IX1084.2 +038300 OPEN-FILES. IX1084.2 +038400*P OPEN I-O RAW-DATA. IX1084.2 +038500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1084.2 +038600*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1084.2 +038700*P MOVE "ABORTED " TO C-ABORT. IX1084.2 +038800*P ADD 1 TO C-NO-OF-TESTS. IX1084.2 +038900*P ACCEPT C-DATE FROM DATE. IX1084.2 +039000*P ACCEPT C-TIME FROM TIME. IX1084.2 +039100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1084.2 +039200*PND-E-1. IX1084.2 +039300*P CLOSE RAW-DATA. IX1084.2 +039400 OPEN OUTPUT PRINT-FILE. IX1084.2 +039500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1084.2 +039600 MOVE SPACE TO TEST-RESULTS. IX1084.2 +039700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1084.2 +039800 MOVE ZERO TO REC-SKL-SUB. IX1084.2 +039900 PERFORM CCVS-INIT-FILE 9 TIMES. IX1084.2 +040000 CCVS-INIT-FILE. IX1084.2 +040100 ADD 1 TO REC-SKL-SUB. IX1084.2 +040200 MOVE FILE-RECORD-INFO-SKELETON IX1084.2 +040300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1084.2 +040400 CCVS-INIT-EXIT. IX1084.2 +040500 GO TO CCVS1-EXIT. IX1084.2 +040600 CLOSE-FILES. IX1084.2 +040700*P OPEN I-O RAW-DATA. IX1084.2 +040800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1084.2 +040900*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1084.2 +041000*P MOVE "OK. " TO C-ABORT. IX1084.2 +041100*P MOVE PASS-COUNTER TO C-OK. IX1084.2 +041200*P MOVE ERROR-HOLD TO C-ALL. IX1084.2 +041300*P MOVE ERROR-COUNTER TO C-FAIL. IX1084.2 +041400*P MOVE DELETE-COUNTER TO C-DELETED. IX1084.2 +041500*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1084.2 +041600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1084.2 +041700*PND-E-2. IX1084.2 +041800*P CLOSE RAW-DATA. IX1084.2 +041900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1084.2 +042000 TERMINATE-CCVS. IX1084.2 +042100*S EXIT PROGRAM. IX1084.2 +042200*SERMINATE-CALL. IX1084.2 +042300 STOP RUN. IX1084.2 +042400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1084.2 +042500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1084.2 +042600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1084.2 +042700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1084.2 +042800 MOVE "****TEST DELETED****" TO RE-MARK. IX1084.2 +042900 PRINT-DETAIL. IX1084.2 +043000 IF REC-CT NOT EQUAL TO ZERO IX1084.2 +043100 MOVE "." TO PARDOT-X IX1084.2 +043200 MOVE REC-CT TO DOTVALUE. IX1084.2 +043300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1084.2 +043400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1084.2 +043500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1084.2 +043600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1084.2 +043700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1084.2 +043800 MOVE SPACE TO CORRECT-X. IX1084.2 +043900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1084.2 +044000 MOVE SPACE TO RE-MARK. IX1084.2 +044100 HEAD-ROUTINE. IX1084.2 +044200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +044300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +044400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1084.2 +044500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1084.2 +044600 COLUMN-NAMES-ROUTINE. IX1084.2 +044700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +044800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +044900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +045000 END-ROUTINE. IX1084.2 +045100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1084.2 +045200 END-RTN-EXIT. IX1084.2 +045300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +045400 END-ROUTINE-1. IX1084.2 +045500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1084.2 +045600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1084.2 +045700 ADD PASS-COUNTER TO ERROR-HOLD. IX1084.2 +045800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1084.2 +045900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1084.2 +046000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1084.2 +046100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1084.2 +046200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1084.2 +046300 END-ROUTINE-12. IX1084.2 +046400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1084.2 +046500 IF ERROR-COUNTER IS EQUAL TO ZERO IX1084.2 +046600 MOVE "NO " TO ERROR-TOTAL IX1084.2 +046700 ELSE IX1084.2 +046800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1084.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1084.2 +047000 PERFORM WRITE-LINE. IX1084.2 +047100 END-ROUTINE-13. IX1084.2 +047200 IF DELETE-COUNTER IS EQUAL TO ZERO IX1084.2 +047300 MOVE "NO " TO ERROR-TOTAL ELSE IX1084.2 +047400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1084.2 +047500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1084.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +047700 IF INSPECT-COUNTER EQUAL TO ZERO IX1084.2 +047800 MOVE "NO " TO ERROR-TOTAL IX1084.2 +047900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1084.2 +048000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1084.2 +048100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +048200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1084.2 +048300 WRITE-LINE. IX1084.2 +048400 ADD 1 TO RECORD-COUNT. IX1084.2 +048500 IF RECORD-COUNT GREATER 42 IX1084.2 +048600 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1084.2 +048700 MOVE SPACE TO DUMMY-RECORD IX1084.2 +048800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1084.2 +048900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1084.2 +049000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1084.2 +049100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1084.2 +049200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1084.2 +049300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1084.2 +049400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1084.2 +049500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1084.2 +049600 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1084.2 +049700 MOVE ZERO TO RECORD-COUNT. IX1084.2 +049800 PERFORM WRT-LN. IX1084.2 +049900 WRT-LN. IX1084.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1084.2 +050100 MOVE SPACE TO DUMMY-RECORD. IX1084.2 +050200 BLANK-LINE-PRINT. IX1084.2 +050300 PERFORM WRT-LN. IX1084.2 +050400 FAIL-ROUTINE. IX1084.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE IX1084.2 +050600 GO TO FAIL-ROUTINE-WRITE. IX1084.2 +050700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1084.2 +050800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1084.2 +050900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1084.2 +051000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +051100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1084.2 +051200 GO TO FAIL-ROUTINE-EX. IX1084.2 +051300 FAIL-ROUTINE-WRITE. IX1084.2 +051400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1084.2 +051500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1084.2 +051600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1084.2 +051700 MOVE SPACES TO COR-ANSI-REFERENCE. IX1084.2 +051800 FAIL-ROUTINE-EX. EXIT. IX1084.2 +051900 BAIL-OUT. IX1084.2 +052000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1084.2 +052100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1084.2 +052200 BAIL-OUT-WRITE. IX1084.2 +052300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1084.2 +052400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1084.2 +052500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1084.2 +052600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1084.2 +052700 BAIL-OUT-EX. EXIT. IX1084.2 +052800 CCVS1-EXIT. IX1084.2 +052900 EXIT. IX1084.2 +053000 SECT-IX-04-001 SECTION. IX1084.2 +053100******************************************************************IX1084.2 +053200* *IX1084.2 +053300* TEST 1 CREATE INDEXED FILE IX-FS2 *IX1084.2 +053400* *IX1084.2 +053500******************************************************************IX1084.2 +053600 WRITE-INIT-GF-01. IX1084.2 +053700 MOVE "WRITE NOT INVALID END-" TO FEATURE. IX1084.2 +053800 MOVE "IX-FS2" TO XFILE-NAME (2). IX1084.2 +053900 MOVE "R1-F-G" TO XRECORD-NAME (2). IX1084.2 +054000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX1084.2 +054100 MOVE 000240 TO XRECORD-LENGTH (2). IX1084.2 +054200 MOVE "RC" TO CHARS-OR-RECORDS (2). IX1084.2 +054300 MOVE 0001 TO XBLOCK-SIZE (2). IX1084.2 +054400 MOVE 000500 TO RECORDS-IN-FILE (2). IX1084.2 +054500 MOVE "IX" TO XFILE-ORGANIZATION (2). IX1084.2 +054600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX1084.2 +054700 MOVE "S" TO XLABEL-TYPE (2). IX1084.2 +054800 MOVE 000001 TO XRECORD-NUMBER (2). IX1084.2 +054900 MOVE 1 TO WRK-CS-09V00-012. IX1084.2 +055000 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX1084.2 +055100 WRK-CS-09V00-015 WRK-CS-09V00-016 IX1084.2 +055200 WRK-CS-09V00-017 WRK-CS-09V00-018. IX1084.2 +055300 MOVE SPACE TO IX-FS1-STATUS. IX1084.2 +055400 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +055500 MOVE ZERO TO WRK-DU-09V00-001. IX1084.2 +055600 OPEN OUTPUT IX-FS1. IX1084.2 +055700 OPEN OUTPUT IX-FS2. IX1084.2 +055800 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +055900 MOVE IX-FS2-STATUS TO WRK-XN-0002-001. IX1084.2 +056000 WRITE-TEST-GF-01. IX1084.2 +056100 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +056200 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +056300 MOVE ZERO TO SWITCH-END-X9X. IX1084.2 +056400 MOVE "99" TO IX-FS2-STATUS. IX1084.2 +056500 MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX1084.2 +056600 MOVE GRP-0101 TO XRECORD-KEY (2). IX1084.2 +056700 MOVE "IX-FS2" TO XFILE-NAME (2). IX1084.2 +056800 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX1084.2 +056900 WRITE-TEST-GF-01-1. IX1084.2 +057000 WRITE IX-FS2R1-F-G-240 IX1084.2 +057100 NOT INVALID IX1084.2 +057200 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +057300 IF SWITCH-NOT-INVALID = 1 IX1084.2 +057400 MOVE 0 TO SWITCH-NOT-INVALID IX1084.2 +057500 ELSE IX1084.2 +057600 MOVE "WRITE NOT INVALID" TO FEATURE IX1084.2 +057700 PERFORM FAIL IX1084.2 +057800 MOVE "FILE IX-FS2 CANNOT BE CREATED CORRECTLY; IX-41" IX1084.2 +057900 TO RE-MARK IX1084.2 +058000 GO TO CCVS-EXIT. IX1084.2 +058100 WRITE-TEST-GF-01-2. IX1084.2 +058200 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +058300 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +058400 MOVE ZERO TO SWITCH-END-X9X. IX1084.2 +058500 MOVE "IX-FS1" TO XFILE-NAME (2). IX1084.2 +058600 WRITE IX-FS1R1-F-G-240 FROM FILE-RECORD-INFO (2) IX1084.2 +058700 INVALID KEY GO TO WRITE-TEST-GF-01-2-1 IX1084.2 +058800 NOT INVALID IX1084.2 +058900 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +059000 END-WRITE. IX1084.2 +059100 WRITE-TEST-GF-01-2-1. IX1084.2 +059200 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +059300 IF SWITCH-NOT-INVALID = 1 IX1084.2 +059400 MOVE 0 TO SWITCH-NOT-INVALID IX1084.2 +059500 ELSE IX1084.2 +059600 MOVE "WRITE NOT INVALID" TO FEATURE IX1084.2 +059700 PERFORM FAIL IX1084.2 +059800 MOVE "FILE IX-FS1 CANNOT BE CREATED CORRECTLY; IX-41" IX1084.2 +059900 TO RE-MARK IX1084.2 +060000 GO TO CCVS-EXIT. IX1084.2 +060100 IF SWITCH-END-XXX = 1 IX1084.2 +060200 MOVE 0 TO SWITCH-END-XXX IX1084.2 +060300 ELSE IX1084.2 +060400 MOVE "WRITE .. END-WRITE" TO FEATURE IX1084.2 +060500 MOVE "FILE IX-FS1 CANNOT BE CREATED CORRECTLY; IX-41" IX1084.2 +060600 TO RE-MARK IX1084.2 +060700 PERFORM FAIL IX1084.2 +060800 GO TO CCVS-EXIT. IX1084.2 +060900 IF IX-FS2-STATUS NOT EQUAL TO "00" IX1084.2 +061000 ADD 1 TO WRK-CS-09V00-016. IX1084.2 +061100 IF IX-FS1-STATUS NOT EQUAL TO "00" IX1084.2 +061200 ADD 1 TO WRK-CS-09V00-016. IX1084.2 +061300 IF XRECORD-NUMBER (2) EQUAL TO 100 IX1084.2 +061400 GO TO WRITE-TEST-GF-01-3. IX1084.2 +061500 ADD 01 TO XRECORD-NUMBER (2). IX1084.2 +061600 GO TO WRITE-TEST-GF-01. IX1084.2 +061700 WRITE-TEST-GF-01-3. IX1084.2 +061800 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX1084.2 +061900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK IX1084.2 +062000 MOVE ZERO TO CORRECT-18V0 IX1084.2 +062100 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX1084.2 +062200 MOVE "IX-41 4.9.2 " TO RE-MARKIX1084.2 +062300 PERFORM FAIL IX1084.2 +062400 ELSE IX1084.2 +062500 PERFORM PASS. IX1084.2 +062600 PERFORM PRINT-DETAIL. IX1084.2 +062700 WRITE-TEST-GF-02. IX1084.2 +062800 MOVE "CREATE IX-FS2" TO FEATURE IX1084.2 +062900 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX1084.2 +063000 IF XRECORD-NUMBER (2) NOT EQUAL TO 100 IX1084.2 +063100 MOVE "INCORRECT COUNT" TO RE-MARK IX1084.2 +063200 MOVE 500 TO CORRECT-18V0 IX1084.2 +063300 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX1084.2 +063400 MOVE "IX-41 4.9.2 " TO RE-MARKIX1084.2 +063500 PERFORM FAIL IX1084.2 +063600 ELSE IX1084.2 +063700 PERFORM PASS. IX1084.2 +063800 PERFORM PRINT-DETAIL. IX1084.2 +063900 IX1084.2 +064000 CLOSE IX-FS1 IX-FS2. IX1084.2 +064100 IX1084.2 +064200******************************************************************IX1084.2 +064300* *IX1084.2 +064400* TESTS: R E A D NOT INVALID END-READ *IX1084.2 +064500* *IX1084.2 +064600******************************************************************IX1084.2 +064700 READ-INIT-F1-01. IX1084.2 +064800 OPEN INPUT IX-FS1. IX1084.2 +064900 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX1084.2 +065000 MOVE "READ NOT AT END " TO FEATURE. IX1084.2 +065100 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +065200 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +065300 READ-TEST-F1-01-0. IX1084.2 +065400 READ IX-FS1 AT END IX1084.2 +065500 GO TO READ-FAIL-F1-01 IX1084.2 +065600 NOT AT END IX1084.2 +065700 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +065800 READ-TEST-F1-01. IX1084.2 +065900 IF SWITCH-NOT-INVALID = 1 IX1084.2 +066000 GO TO READ-PASS-F1-01. IX1084.2 +066100 READ-FAIL-F1-01. IX1084.2 +066200 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +066300 PERFORM FAIL. IX1084.2 +066400 GO TO READ-WRITE-F1-01. IX1084.2 +066500 READ-PASS-F1-01. IX1084.2 +066600 PERFORM PASS. IX1084.2 +066700 READ-WRITE-F1-01. IX1084.2 +066800 PERFORM PRINT-DETAIL. IX1084.2 +066900 IX1084.2 +067000******************************************************************IX1084.2 +067100* TEST READ .. NOT AT END ... END-READ. *IX1084.2 +067200* *IX1084.2 +067300* IX-28, 4.5.4 *IX1084.2 +067400******************************************************************IX1084.2 +067500 READ-INIT-F1-02. IX1084.2 +067600 MOVE "READ-TEST-F1-02-1" TO PAR-NAME. IX1084.2 +067700 MOVE "READ . NOT INV. . END-" TO FEATURE. IX1084.2 +067800 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +067900 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +068000 READ-TEST-F1-02. IX1084.2 +068100 READ IX-FS1 AT END IX1084.2 +068200 GO TO READ-FAIL-F1-02-1 IX1084.2 +068300 NOT END IX1084.2 +068400 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +068500 END-READ. IX1084.2 +068600 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +068700 READ-TEST-F1-02-1. IX1084.2 +068800 IF SWITCH-NOT-INVALID = 1 IX1084.2 +068900 GO TO READ-PASS-F1-02-1. IX1084.2 +069000 READ-FAIL-F1-02-1. IX1084.2 +069100 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +069200 PERFORM FAIL. IX1084.2 +069300 GO TO READ-WRITE-F1-02-1. IX1084.2 +069400 READ-PASS-F1-02-1. IX1084.2 +069500 PERFORM PASS. IX1084.2 +069600 READ-WRITE-F1-02-1. IX1084.2 +069700 PERFORM PRINT-DETAIL. IX1084.2 +069800 IX1084.2 +069900 READ-TEST-F1-02-2. IX1084.2 +070000 MOVE "READ-TEST-F1-02-2" TO PAR-NAME. IX1084.2 +070100 MOVE "END-READ. " TO FEATURE. IX1084.2 +070200 IF SWITCH-END-XXX = 1 IX1084.2 +070300 GO TO READ-PASS-F1-02-2. IX1084.2 +070400 READ-FAIL-F1-02-2. IX1084.2 +070500 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +070600 PERFORM FAIL. IX1084.2 +070700 GO TO READ-WRITE-F1-02-2. IX1084.2 +070800 READ-PASS-F1-02-2. IX1084.2 +070900 PERFORM PASS. IX1084.2 +071000 READ-WRITE-F1-02-2. IX1084.2 +071100 PERFORM PRINT-DETAIL. IX1084.2 +071200 IX1084.2 +071300******************************************************************IX1084.2 +071400* TEST: IF READ .. NOT AT END ... END-READ ... . *IX1084.2 +071500* *IX1084.2 +071600* IX-28, 4.5.4 *IX1084.2 +071700******************************************************************IX1084.2 +071800 READ-INIT-F1-03. IX1084.2 +071900 MOVE "READ-TEST-F1-03-1" TO PAR-NAME. IX1084.2 +072000 MOVE "IF . READ . NOT INV. . END-" TO FEATURE. IX1084.2 +072100 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +072200 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +072300 MOVE 1 TO SWITCH-IF. IX1084.2 +072400 READ-TEST-F1-03. IX1084.2 +072500 IF SWITCH-IF = 1 IX1084.2 +072600 READ IX-FS1 AT END IX1084.2 +072700 GO TO READ-FAIL-F1-03-1 IX1084.2 +072800 NOT END IX1084.2 +072900 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +073000 END-READ IX1084.2 +073100 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +073200 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +073300 READ-TEST-F1-03-1. IX1084.2 +073400 IF SWITCH-NOT-INVALID = 1 IX1084.2 +073500 GO TO READ-PASS-F1-03-1. IX1084.2 +073600 READ-FAIL-F1-03-1. IX1084.2 +073700 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +073800 PERFORM FAIL. IX1084.2 +073900 GO TO READ-WRITE-F1-03-1. IX1084.2 +074000 READ-PASS-F1-03-1. IX1084.2 +074100 PERFORM PASS. IX1084.2 +074200 READ-WRITE-F1-03-1. IX1084.2 +074300 PERFORM PRINT-DETAIL. IX1084.2 +074400 IX1084.2 +074500 READ-TEST-F1-03-2. IX1084.2 +074600 MOVE "READ-TEST-F1-03-2" TO PAR-NAME. IX1084.2 +074700 IF SWITCH-END-XXX = 1 IX1084.2 +074800 GO TO READ-PASS-F1-03-2. IX1084.2 +074900 READ-FAIL-F1-03-2. IX1084.2 +075000 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +075100 PERFORM FAIL. IX1084.2 +075200 GO TO READ-WRITE-F1-03-2. IX1084.2 +075300 READ-PASS-F1-03-2. IX1084.2 +075400 PERFORM PASS. IX1084.2 +075500 READ-WRITE-F1-03-2. IX1084.2 +075600 PERFORM PRINT-DETAIL. IX1084.2 +075700 IX1084.2 +075800 READ-TEST-F1-03-3. IX1084.2 +075900 MOVE "READ-TEST-F1-03-3" TO PAR-NAME. IX1084.2 +076000 IF SWITCH-END-X9X = 9 IX1084.2 +076100 GO TO READ-PASS-F1-03-3. IX1084.2 +076200 READ-FAIL-F1-03-3. IX1084.2 +076300 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +076400 PERFORM FAIL. IX1084.2 +076500 GO TO READ-WRITE-F1-03-3. IX1084.2 +076600 READ-PASS-F1-03-3. IX1084.2 +076700 PERFORM PASS. IX1084.2 +076800 READ-WRITE-F1-03-3. IX1084.2 +076900 PERFORM PRINT-DETAIL. IX1084.2 +077000 IX1084.2 +077100 CLOSE IX-FS1. IX1084.2 +077200 IX1084.2 +077300******************************************************************IX1084.2 +077400* TEST READ NOT INVALID *IX1084.2 +077500* *IX1084.2 +077600* IX-28, 4.5.4 *IX1084.2 +077700******************************************************************IX1084.2 +077800 READ-INIT-F2-01. IX1084.2 +077900 MOVE 2 TO WRK-CS-09V00-012. IX1084.2 +078000 MOVE ZERO TO WRK-CS-09V00-013. IX1084.2 +078100 MOVE ZERO TO WRK-CS-09V00-014. IX1084.2 +078200 MOVE ZERO TO WRK-CS-09V00-015. IX1084.2 +078300 MOVE ZERO TO WRK-CS-09V00-016. IX1084.2 +078400 MOVE ZERO TO WRK-CS-09V00-017. IX1084.2 +078500 MOVE ZERO TO WRK-CS-09V00-018. IX1084.2 +078600 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +078700 OPEN I-O IX-FS2. IX1084.2 +078800 MOVE SPACE TO WRK-XN-0002-002 IX1084.2 +078900 MOVE SPACE TO WRK-XN-0002-003 IX1084.2 +079000 MOVE SPACE TO WRK-XN-0002-004 IX1084.2 +079100 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +079200 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +079300 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +079400 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX1084.2 +079500 MOVE "READ NOT INVALID." TO FEATURE. IX1084.2 +079600 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +079700 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +079800 READ-TEST-F2-01-0. IX1084.2 +079900 MOVE 1 TO WRK-DU-09V00-001. IX1084.2 +080000 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +080100 READ IX-FS2 INVALID IX1084.2 +080200 GO TO READ-FAIL-F2-01 IX1084.2 +080300 NOT INVALID IX1084.2 +080400 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +080500 READ-TEST-F2-01. IX1084.2 +080600 IF SWITCH-NOT-INVALID = 1 IX1084.2 +080700 GO TO READ-PASS-F2-01. IX1084.2 +080800 READ-FAIL-F2-01. IX1084.2 +080900 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +081000 PERFORM FAIL. IX1084.2 +081100 GO TO READ-WRITE-F2-01. IX1084.2 +081200 READ-PASS-F2-01. IX1084.2 +081300 PERFORM PASS. IX1084.2 +081400 READ-WRITE-F2-01. IX1084.2 +081500 PERFORM PRINT-DETAIL. IX1084.2 +081600 IX1084.2 +081700******************************************************************IX1084.2 +081800* TEST READ .. NOT INVALID ... END-READ. *IX1084.2 +081900* *IX1084.2 +082000* IX-28, 4.5.4 *IX1084.2 +082100******************************************************************IX1084.2 +082200 READ-INIT-F2-02. IX1084.2 +082300 MOVE "READ-TEST-F2-02-1" TO PAR-NAME. IX1084.2 +082400 MOVE "READ . NOT INV. . END-" TO FEATURE. IX1084.2 +082500 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +082600 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +082700 READ-TEST-F2-02. IX1084.2 +082800 MOVE 2 TO WRK-DU-09V00-001. IX1084.2 +082900 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +083000 READ IX-FS2 INVALID KEY IX1084.2 +083100 GO TO READ-FAIL-F2-02-1 IX1084.2 +083200 NOT INVALID KEY IX1084.2 +083300 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +083400 END-READ. IX1084.2 +083500 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +083600 READ-TEST-F2-02-1. IX1084.2 +083700 IF SWITCH-NOT-INVALID = 1 IX1084.2 +083800 GO TO READ-PASS-F2-02-1. IX1084.2 +083900 READ-FAIL-F2-02-1. IX1084.2 +084000 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +084100 PERFORM FAIL. IX1084.2 +084200 GO TO READ-WRITE-F2-02-1. IX1084.2 +084300 READ-PASS-F2-02-1. IX1084.2 +084400 PERFORM PASS. IX1084.2 +084500 READ-WRITE-F2-02-1. IX1084.2 +084600 PERFORM PRINT-DETAIL. IX1084.2 +084700 IX1084.2 +084800 READ-TEST-F2-02-2. IX1084.2 +084900 MOVE "READ-TEST-F2-02-2" TO PAR-NAME. IX1084.2 +085000 MOVE "END-READ. " TO FEATURE. IX1084.2 +085100 IF SWITCH-END-XXX = 1 IX1084.2 +085200 GO TO READ-PASS-F2-02-2. IX1084.2 +085300 READ-FAIL-F2-02-2. IX1084.2 +085400 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +085500 PERFORM FAIL. IX1084.2 +085600 GO TO READ-WRITE-F2-02-2. IX1084.2 +085700 READ-PASS-F2-02-2. IX1084.2 +085800 PERFORM PASS. IX1084.2 +085900 READ-WRITE-F2-02-2. IX1084.2 +086000 PERFORM PRINT-DETAIL. IX1084.2 +086100 IX1084.2 +086200******************************************************************IX1084.2 +086300* TEST: IF READ .. NOT INVALID ... END-READ ... . *IX1084.2 +086400* *IX1084.2 +086500* IX-28, 4.5.4 *IX1084.2 +086600******************************************************************IX1084.2 +086700 READ-INIT-F2-03. IX1084.2 +086800 MOVE "READ-TEST-F2-03-1" TO PAR-NAME. IX1084.2 +086900 MOVE "IF . READ . NOT INV. . END-" TO FEATURE. IX1084.2 +087000 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +087100 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +087200 MOVE 1 TO SWITCH-IF. IX1084.2 +087300 READ-TEST-F2-03. IX1084.2 +087400 MOVE 3 TO WRK-DU-09V00-001. IX1084.2 +087500 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +087600 IF SWITCH-IF = 1 IX1084.2 +087700 READ IX-FS2 INVALID KEY IX1084.2 +087800 GO TO READ-FAIL-F2-03-1 IX1084.2 +087900 NOT INVALID KEY IX1084.2 +088000 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +088100 END-READ IX1084.2 +088200 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +088300 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +088400 READ-TEST-F2-03-1. IX1084.2 +088500 IF SWITCH-NOT-INVALID = 1 IX1084.2 +088600 GO TO READ-PASS-F2-03-1. IX1084.2 +088700 READ-FAIL-F2-03-1. IX1084.2 +088800 MOVE "IX-28 4.5.4 (11) C " TO RE-MARK.IX1084.2 +088900 PERFORM FAIL. IX1084.2 +089000 GO TO READ-WRITE-F2-03-1. IX1084.2 +089100 READ-PASS-F2-03-1. IX1084.2 +089200 PERFORM PASS. IX1084.2 +089300 READ-WRITE-F2-03-1. IX1084.2 +089400 PERFORM PRINT-DETAIL. IX1084.2 +089500 IX1084.2 +089600 READ-TEST-F2-03-2. IX1084.2 +089700 MOVE "READ-TEST-F2-03-2" TO PAR-NAME. IX1084.2 +089800 IF SWITCH-END-XXX = 1 IX1084.2 +089900 GO TO READ-PASS-F2-03-2. IX1084.2 +090000 READ-FAIL-F2-03-2. IX1084.2 +090100 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +090200 PERFORM FAIL. IX1084.2 +090300 GO TO READ-WRITE-F2-03-2. IX1084.2 +090400 READ-PASS-F2-03-2. IX1084.2 +090500 PERFORM PASS. IX1084.2 +090600 READ-WRITE-F2-03-2. IX1084.2 +090700 PERFORM PRINT-DETAIL. IX1084.2 +090800 IX1084.2 +090900 READ-TEST-F2-03-3. IX1084.2 +091000 MOVE "READ-TEST-F2-03-3" TO PAR-NAME. IX1084.2 +091100 IF SWITCH-END-X9X = 9 IX1084.2 +091200 GO TO READ-PASS-F2-03-3. IX1084.2 +091300 READ-FAIL-F2-03-3. IX1084.2 +091400 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +091500 PERFORM FAIL. IX1084.2 +091600 GO TO READ-WRITE-F2-03-3. IX1084.2 +091700 READ-PASS-F2-03-3. IX1084.2 +091800 PERFORM PASS. IX1084.2 +091900 READ-WRITE-F2-03-3. IX1084.2 +092000 PERFORM PRINT-DETAIL. IX1084.2 +092100 IX1084.2 +092200 CLOSE IX-FS2. IX1084.2 +092300 IX1084.2 +092400******************************************************************IX1084.2 +092500* *IX1084.2 +092600* TESTS: D E L E T E NOT INVALID END-DELETE *IX1084.2 +092700* FOR A FILE WHICH IS IN RANDOM ACCESS MODE *IX1084.2 +092800* *IX1084.2 +092900* *IX1084.2 +093000* TEST DELETE NOT INVALID *IX1084.2 +093100* *IX1084.2 +093200* IX-21, 4.3.2 *IX1084.2 +093300******************************************************************IX1084.2 +093400 DELETE-INIT-GF-01. IX1084.2 +093500 MOVE 2 TO WRK-CS-09V00-012. IX1084.2 +093600 MOVE ZERO TO WRK-CS-09V00-013. IX1084.2 +093700 MOVE ZERO TO WRK-CS-09V00-014. IX1084.2 +093800 MOVE ZERO TO WRK-CS-09V00-015. IX1084.2 +093900 MOVE ZERO TO WRK-CS-09V00-016. IX1084.2 +094000 MOVE ZERO TO WRK-CS-09V00-017. IX1084.2 +094100 MOVE ZERO TO WRK-CS-09V00-018. IX1084.2 +094200 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +094300 OPEN I-O IX-FS2. IX1084.2 +094400 MOVE SPACE TO WRK-XN-0002-002 IX1084.2 +094500 MOVE SPACE TO WRK-XN-0002-003 IX1084.2 +094600 MOVE SPACE TO WRK-XN-0002-004 IX1084.2 +094700 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +094800 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +094900 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +095000 MOVE "DELETE-TEST-GF-01" TO PAR-NAME. IX1084.2 +095100 MOVE "DELETE NOT INVALID." TO FEATURE. IX1084.2 +095200 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +095300 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +095400 DELETE-TEST-GF-01-0. IX1084.2 +095500 MOVE 1 TO WRK-DU-09V00-001. IX1084.2 +095600 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +095700 READ IX-FS2 INVALID KEY IX1084.2 +095800 MOVE " READ FAILED " TO RE-MARK IX1084.2 +095900 PERFORM FAIL IX1084.2 +096000 GO TO DELETE-WRITE-GF-01. IX1084.2 +096100 DELETE IX-FS2 RECORD IX1084.2 +096200 INVALID KEY MOVE "DELETE IS INVALID" TO RE-MARK IX1084.2 +096300 PERFORM FAIL IX1084.2 +096400 GO TO DELETE-WRITE-GF-01 IX1084.2 +096500 NOT INVALID KEY IX1084.2 +096600 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +096700 DELETE-TEST-GF-01. IX1084.2 +096800 IF SWITCH-NOT-INVALID = 1 IX1084.2 +096900 GO TO DELETE-PASS-GF-01. IX1084.2 +097000 DELETE-FAIL-GF-01. IX1084.2 +097100 MOVE "IX-21, 4.3.2 " TO RE-MARK.IX1084.2 +097200 PERFORM FAIL. IX1084.2 +097300 GO TO DELETE-WRITE-GF-01. IX1084.2 +097400 DELETE-PASS-GF-01. IX1084.2 +097500 PERFORM PASS. IX1084.2 +097600 DELETE-WRITE-GF-01. IX1084.2 +097700 PERFORM PRINT-DETAIL. IX1084.2 +097800 IX1084.2 +097900******************************************************************IX1084.2 +098000* TEST DELETE NOT INVALID ... END-DELETE. *IX1084.2 +098100* *IX1084.2 +098200* IX-21, 4.3.2 *IX1084.2 +098300******************************************************************IX1084.2 +098400 DELETE-INIT-GF-02. IX1084.2 +098500 MOVE "DELETE-TEST-GF-02-1" TO PAR-NAME. IX1084.2 +098600 MOVE "DELETE NOT INV. . END-" TO FEATURE. IX1084.2 +098700 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +098800 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +098900 DELETE-TEST-GF-02. IX1084.2 +099000 MOVE 2 TO WRK-DU-09V00-001. IX1084.2 +099100 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +099200 READ IX-FS2 INVALID KEY IX1084.2 +099300 MOVE "READ FAILED " TO RE-MARK IX1084.2 +099400 PERFORM FAIL IX1084.2 +099500 GO TO DELETE-WRITE-GF-02-1. IX1084.2 +099600 DELETE IX-FS2 RECORD IX1084.2 +099700 INVALID MOVE "DELETE IS INVALID" TO RE-MARK IX1084.2 +099800 PERFORM FAIL IX1084.2 +099900 GO TO DELETE-WRITE-GF-02-1 IX1084.2 +100000 NOT INVALID IX1084.2 +100100 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +100200 END-DELETE. IX1084.2 +100300 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +100400 DELETE-TEST-GF-02-1. IX1084.2 +100500 IF SWITCH-NOT-INVALID = 1 IX1084.2 +100600 GO TO DELETE-PASS-GF-02-1. IX1084.2 +100700 DELETE-FAIL-GF-02-1. IX1084.2 +100800 MOVE "IX-21, 4.3.2 " TO RE-MARK.IX1084.2 +100900 PERFORM FAIL. IX1084.2 +101000 GO TO DELETE-WRITE-GF-02-1. IX1084.2 +101100 DELETE-PASS-GF-02-1. IX1084.2 +101200 PERFORM PASS. IX1084.2 +101300 DELETE-WRITE-GF-02-1. IX1084.2 +101400 PERFORM PRINT-DETAIL. IX1084.2 +101500 IX1084.2 +101600 DELETE-TEST-GF-02-2. IX1084.2 +101700 MOVE "DELETE-TEST-GF-02-2" TO PAR-NAME. IX1084.2 +101800 MOVE "END-DELETE. " TO FEATURE. IX1084.2 +101900 IF SWITCH-END-XXX = 1 IX1084.2 +102000 GO TO DELETE-PASS-GF-02-2. IX1084.2 +102100 DELETE-FAIL-GF-02-2. IX1084.2 +102200 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +102300 PERFORM FAIL. IX1084.2 +102400 GO TO DELETE-WRITE-GF-02-2. IX1084.2 +102500 DELETE-PASS-GF-02-2. IX1084.2 +102600 PERFORM PASS. IX1084.2 +102700 DELETE-WRITE-GF-02-2. IX1084.2 +102800 PERFORM PRINT-DETAIL. IX1084.2 +102900 IX1084.2 +103000******************************************************************IX1084.2 +103100* TEST: IF DELETE. NOT INVALID ... END-DELETE ... . *IX1084.2 +103200* *IX1084.2 +103300* IX-21, 4.3.2 *IX1084.2 +103400******************************************************************IX1084.2 +103500 DELETE-INIT-GF-03. IX1084.2 +103600 MOVE "DELETE-TEST-GF-03-1" TO PAR-NAME. IX1084.2 +103700 MOVE "IF .DELETE. NOT INV. . END-" TO FEATURE. IX1084.2 +103800 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +103900 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +104000 MOVE 1 TO SWITCH-IF. IX1084.2 +104100 DELETE-TEST-GF-03. IX1084.2 +104200 MOVE 3 TO WRK-DU-09V00-001. IX1084.2 +104300 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +104400 READ IX-FS2 INVALID KEY IX1084.2 +104500 MOVE "READ FAILED " TO RE-MARK IX1084.2 +104600 PERFORM FAIL IX1084.2 +104700 GO TO DELETE-WRITE-GF-03-1. IX1084.2 +104800 IF SWITCH-IF = 1 IX1084.2 +104900 DELETE IX-FS2 RECORD IX1084.2 +105000 INVALID KEY MOVE "DELETE IS INVALID" TO RE-MARK IX1084.2 +105100 PERFORM FAIL IX1084.2 +105200 GO TO DELETE-WRITE-GF-03-1 IX1084.2 +105300 NOT INVALID KEY IX1084.2 +105400 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +105500 END-DELETE IX1084.2 +105600 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +105700 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +105800 DELETE-TEST-GF-03-1. IX1084.2 +105900 IF SWITCH-NOT-INVALID = 1 IX1084.2 +106000 GO TO DELETE-PASS-GF-03-1. IX1084.2 +106100 DELETE-FAIL-GF-03-1. IX1084.2 +106200 MOVE "IX-21, 4.3.2 " TO RE-MARK.IX1084.2 +106300 PERFORM FAIL. IX1084.2 +106400 GO TO DELETE-WRITE-GF-03-1. IX1084.2 +106500 DELETE-PASS-GF-03-1. IX1084.2 +106600 PERFORM PASS. IX1084.2 +106700 DELETE-WRITE-GF-03-1. IX1084.2 +106800 PERFORM PRINT-DETAIL. IX1084.2 +106900 IX1084.2 +107000 DELETE-TEST-GF-03-2. IX1084.2 +107100 MOVE "END-DELETE" TO FEATURE. IX1084.2 +107200 MOVE "DELETE-TEST-GF-03-2" TO PAR-NAME. IX1084.2 +107300 IF SWITCH-END-XXX = 1 IX1084.2 +107400 GO TO DELETE-PASS-GF-03-2. IX1084.2 +107500 DELETE-FAIL-GF-03-2. IX1084.2 +107600 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +107700 PERFORM FAIL. IX1084.2 +107800 GO TO DELETE-WRITE-GF-03-2. IX1084.2 +107900 DELETE-PASS-GF-03-2. IX1084.2 +108000 PERFORM PASS. IX1084.2 +108100 DELETE-WRITE-GF-03-2. IX1084.2 +108200 PERFORM PRINT-DETAIL. IX1084.2 +108300 IX1084.2 +108400 DELETE-TEST-GF-03-3. IX1084.2 +108500 MOVE "DELETE-TEST-GF-03-3" TO PAR-NAME. IX1084.2 +108600 IF SWITCH-END-X9X = 9 IX1084.2 +108700 GO TO DELETE-PASS-GF-03-3. IX1084.2 +108800 DELETE-FAIL-GF-03-3. IX1084.2 +108900 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +109000 PERFORM FAIL. IX1084.2 +109100 GO TO DELETE-WRITE-GF-03-3. IX1084.2 +109200 DELETE-PASS-GF-03-3. IX1084.2 +109300 PERFORM PASS. IX1084.2 +109400 DELETE-WRITE-GF-03-3. IX1084.2 +109500 PERFORM PRINT-DETAIL. IX1084.2 +109600 IX1084.2 +109700 CLOSE IX-FS2. IX1084.2 +109800 IX1084.2 +109900******************************************************************IX1084.2 +110000* *IX1084.2 +110100* TESTS: R E W R I T E NOT INVALID END-REWRITE *IX1084.2 +110200* FOR A FILE WHICH IS IN RANDOM ACCESS MODE *IX1084.2 +110300* *IX1084.2 +110400* *IX1084.2 +110500* TEST REWRITE NOT INVALID *IX1084.2 +110600* *IX1084.2 +110700* IX-33, 4.6.2 *IX1084.2 +110800******************************************************************IX1084.2 +110900 REWRITE-INIT-GF-01. IX1084.2 +111000 MOVE 2 TO WRK-CS-09V00-012. IX1084.2 +111100 MOVE ZERO TO WRK-CS-09V00-013. IX1084.2 +111200 MOVE ZERO TO WRK-CS-09V00-014. IX1084.2 +111300 MOVE ZERO TO WRK-CS-09V00-015. IX1084.2 +111400 MOVE ZERO TO WRK-CS-09V00-016. IX1084.2 +111500 MOVE ZERO TO WRK-CS-09V00-017. IX1084.2 +111600 MOVE ZERO TO WRK-CS-09V00-018. IX1084.2 +111700 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +111800 OPEN I-O IX-FS2. IX1084.2 +111900 MOVE SPACE TO WRK-XN-0002-002 IX1084.2 +112000 MOVE SPACE TO WRK-XN-0002-003 IX1084.2 +112100 MOVE SPACE TO WRK-XN-0002-004 IX1084.2 +112200 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +112300 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX1084.2 +112400 MOVE SPACE TO IX-FS2-STATUS. IX1084.2 +112500 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME. IX1084.2 +112600 MOVE "REWRITE NOT INVALID." TO FEATURE. IX1084.2 +112700 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +112800 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +112900 REWRITE-TEST-GF-01-0. IX1084.2 +113000 MOVE 5 TO WRK-DU-09V00-001. IX1084.2 +113100 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +113200 READ IX-FS2 INVALID KEY IX1084.2 +113300 MOVE " READ FAILED " TO RE-MARK IX1084.2 +113400 PERFORM FAIL IX1084.2 +113500 GO TO REWRITE-WRITE-GF-01. IX1084.2 +113600 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS2-REC-120IX1084.2 +113700 REWRITE IX-FS2R1-F-G-240 IX1084.2 +113800 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +113900 PERFORM FAIL IX1084.2 +114000 GO TO REWRITE-WRITE-GF-01 IX1084.2 +114100 NOT INVALID KEY IX1084.2 +114200 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +114300 REWRITE-TEST-GF-01. IX1084.2 +114400 IF SWITCH-NOT-INVALID = 1 IX1084.2 +114500 GO TO REWRITE-PASS-GF-01. IX1084.2 +114600 REWRITE-FAIL-GF-01. IX1084.2 +114700 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +114800 PERFORM FAIL. IX1084.2 +114900 GO TO REWRITE-WRITE-GF-01. IX1084.2 +115000 REWRITE-PASS-GF-01. IX1084.2 +115100 PERFORM PASS. IX1084.2 +115200 REWRITE-WRITE-GF-01. IX1084.2 +115300 PERFORM PRINT-DETAIL. IX1084.2 +115400 IX1084.2 +115500******************************************************************IX1084.2 +115600* TEST REWRITE NOT INVALID ... END-DELETE. *IX1084.2 +115700* *IX1084.2 +115800* IX-33, 4.6.2 *IX1084.2 +115900******************************************************************IX1084.2 +116000 REWRITE-INIT-GF-02. IX1084.2 +116100 MOVE "REWRITE-TEST-GF-02-1" TO PAR-NAME. IX1084.2 +116200 MOVE "REWRITE NOT INV. . END-" TO FEATURE. IX1084.2 +116300 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +116400 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +116500 REWRITE-TEST-GF-02. IX1084.2 +116600 MOVE 6 TO WRK-DU-09V00-001. IX1084.2 +116700 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +116800 READ IX-FS2 INVALID KEY IX1084.2 +116900 MOVE "READ FAILED " TO RE-MARK IX1084.2 +117000 PERFORM FAIL IX1084.2 +117100 GO TO REWRITE-WRITE-GF-02-1. IX1084.2 +117200 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS2-REC-120IX1084.2 +117300 REWRITE IX-FS2R1-F-G-240 IX1084.2 +117400 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +117500 PERFORM FAIL IX1084.2 +117600 GO TO REWRITE-WRITE-GF-02-1 IX1084.2 +117700 NOT INVALID IX1084.2 +117800 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +117900 END-REWRITE. IX1084.2 +118000 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +118100 REWRITE-TEST-GF-02-1. IX1084.2 +118200 IF SWITCH-NOT-INVALID = 1 IX1084.2 +118300 GO TO REWRITE-PASS-GF-02-1. IX1084.2 +118400 REWRITE-FAIL-GF-02-1. IX1084.2 +118500 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +118600 PERFORM FAIL. IX1084.2 +118700 GO TO REWRITE-WRITE-GF-02-1. IX1084.2 +118800 REWRITE-PASS-GF-02-1. IX1084.2 +118900 PERFORM PASS. IX1084.2 +119000 REWRITE-WRITE-GF-02-1. IX1084.2 +119100 PERFORM PRINT-DETAIL. IX1084.2 +119200 IX1084.2 +119300 REWRITE-TEST-GF-02-2. IX1084.2 +119400 MOVE "REWRITE-TEST-GF-02-2" TO PAR-NAME. IX1084.2 +119500 MOVE "END-REWRITE. " TO FEATURE. IX1084.2 +119600 IF SWITCH-END-XXX = 1 IX1084.2 +119700 GO TO REWRITE-PASS-GF-02-2. IX1084.2 +119800 REWRITE-FAIL-GF-02-2. IX1084.2 +119900 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +120000 PERFORM FAIL. IX1084.2 +120100 GO TO REWRITE-WRITE-GF-02-2. IX1084.2 +120200 REWRITE-PASS-GF-02-2. IX1084.2 +120300 PERFORM PASS. IX1084.2 +120400 REWRITE-WRITE-GF-02-2. IX1084.2 +120500 PERFORM PRINT-DETAIL. IX1084.2 +120600 IX1084.2 +120700******************************************************************IX1084.2 +120800* TEST: IF REWRITE. NOT INVALID ... END-DELETE ... . *IX1084.2 +120900* *IX1084.2 +121000* IX-33, 4.6.2 *IX1084.2 +121100******************************************************************IX1084.2 +121200 REWRITE-INIT-GF-03. IX1084.2 +121300 MOVE "REWRITE-TEST-GF-03-1" TO PAR-NAME. IX1084.2 +121400 MOVE "IF .REWRITE. NOT INV. . END-" TO FEATURE. IX1084.2 +121500 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +121600 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +121700 MOVE 1 TO SWITCH-IF. IX1084.2 +121800 REWRITE-TEST-GF-03. IX1084.2 +121900 MOVE 7 TO WRK-DU-09V00-001. IX1084.2 +122000 MOVE GRP-0101 TO IX-FS2-KEY. IX1084.2 +122100 READ IX-FS2 INVALID KEY IX1084.2 +122200 MOVE "READ FAILED " TO RE-MARK IX1084.2 +122300 PERFORM FAIL IX1084.2 +122400 GO TO REWRITE-WRITE-GF-03-1. IX1084.2 +122500 IF SWITCH-IF = 1 IX1084.2 +122600 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS2-REC-120IX1084.2 +122700 REWRITE IX-FS2R1-F-G-240 IX1084.2 +122800 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +122900 PERFORM FAIL IX1084.2 +123000 GO TO REWRITE-WRITE-GF-03-1 IX1084.2 +123100 NOT INVALID KEY IX1084.2 +123200 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +123300 END-REWRITE IX1084.2 +123400 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +123500 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +123600 REWRITE-TEST-GF-03-1. IX1084.2 +123700 IF SWITCH-NOT-INVALID = 1 IX1084.2 +123800 GO TO REWRITE-PASS-GF-03-1. IX1084.2 +123900 REWRITE-FAIL-GF-03-1. IX1084.2 +124000 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +124100 PERFORM FAIL. IX1084.2 +124200 GO TO REWRITE-WRITE-GF-03-1. IX1084.2 +124300 REWRITE-PASS-GF-03-1. IX1084.2 +124400 PERFORM PASS. IX1084.2 +124500 REWRITE-WRITE-GF-03-1. IX1084.2 +124600 PERFORM PRINT-DETAIL. IX1084.2 +124700 IX1084.2 +124800 REWRITE-TEST-GF-03-2. IX1084.2 +124900 MOVE "END-REWRITE" TO FEATURE. IX1084.2 +125000 MOVE "REWRITE-TEST-GF-03-2" TO PAR-NAME. IX1084.2 +125100 IF SWITCH-END-XXX = 1 IX1084.2 +125200 GO TO REWRITE-PASS-GF-03-2. IX1084.2 +125300 REWRITE-FAIL-GF-03-2. IX1084.2 +125400 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +125500 PERFORM FAIL. IX1084.2 +125600 GO TO REWRITE-WRITE-GF-03-2. IX1084.2 +125700 REWRITE-PASS-GF-03-2. IX1084.2 +125800 PERFORM PASS. IX1084.2 +125900 REWRITE-WRITE-GF-03-2. IX1084.2 +126000 PERFORM PRINT-DETAIL. IX1084.2 +126100 IX1084.2 +126200 REWRITE-TEST-GF-03-3. IX1084.2 +126300 MOVE "REWRITE-TEST-GF-03-3" TO PAR-NAME. IX1084.2 +126400 IF SWITCH-END-X9X = 9 IX1084.2 +126500 GO TO REWRITE-PASS-GF-03-3. IX1084.2 +126600 REWRITE-FAIL-GF-03-3. IX1084.2 +126700 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +126800 PERFORM FAIL. IX1084.2 +126900 GO TO REWRITE-WRITE-GF-03-3. IX1084.2 +127000 REWRITE-PASS-GF-03-3. IX1084.2 +127100 PERFORM PASS. IX1084.2 +127200 REWRITE-WRITE-GF-03-3. IX1084.2 +127300 PERFORM PRINT-DETAIL. IX1084.2 +127400 IX1084.2 +127500 CLOSE IX-FS2. IX1084.2 +127600 IX1084.2 +127700 IX1084.2 +127800******************************************************************IX1084.2 +127900* *IX1084.2 +128000* TESTS: R E W R I T E NOT INVALID END-REWRITE *IX1084.2 +128100* FOR A FILE WHICH IS IN SEQUENTIAL ACCESS MODE *IX1084.2 +128200* *IX1084.2 +128300* *IX1084.2 +128400* TEST REWRITE NOT INVALID *IX1084.2 +128500* *IX1084.2 +128600* IX-33, 4.6.2 *IX1084.2 +128700******************************************************************IX1084.2 +128800 RWR-SEQ-INIT-GF-01. IX1084.2 +128900 MOVE 2 TO WRK-CS-09V00-012. IX1084.2 +129000 MOVE ZERO TO WRK-CS-09V00-013. IX1084.2 +129100 MOVE ZERO TO WRK-CS-09V00-014. IX1084.2 +129200 MOVE ZERO TO WRK-CS-09V00-015. IX1084.2 +129300 MOVE ZERO TO WRK-CS-09V00-016. IX1084.2 +129400 MOVE ZERO TO WRK-CS-09V00-017. IX1084.2 +129500 MOVE ZERO TO WRK-CS-09V00-018. IX1084.2 +129600 MOVE SPACE TO IX-FS1-STATUS. IX1084.2 +129700 OPEN I-O IX-FS1. IX1084.2 +129800 MOVE SPACE TO WRK-XN-0002-002 IX1084.2 +129900 MOVE SPACE TO WRK-XN-0002-003 IX1084.2 +130000 MOVE SPACE TO WRK-XN-0002-004 IX1084.2 +130100 MOVE IX-FS1-STATUS TO WRK-XN-0002-001 IX1084.2 +130200 MOVE IX-FS1-STATUS TO WRK-XN-0002-001 IX1084.2 +130300 MOVE SPACE TO IX-FS1-STATUS. IX1084.2 +130400 MOVE "RWR-SEQ-TEST-GF-01" TO PAR-NAME. IX1084.2 +130500 MOVE "REWRITE NOT INVALID." TO FEATURE. IX1084.2 +130600 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +130700 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +130800 RWR-SEQ-TEST-GF-01-0. IX1084.2 +130900******************************************************************IX1084.2 +131000* *IX1084.2 +131100* READ AND REWRITE THE FIRST THREE RECORDS *IX1084.2 +131200* *IX1084.2 +131300******************************************************************IX1084.2 +131400 READ IX-FS1 AT END IX1084.2 +131500 MOVE " READ FAILED " TO RE-MARK IX1084.2 +131600 PERFORM FAIL IX1084.2 +131700 GO TO RWR-SEQ-WRITE-GF-01. IX1084.2 +131800 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS1-REC-120IX1084.2 +131900 REWRITE IX-FS1R1-F-G-240 IX1084.2 +132000 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +132100 PERFORM FAIL IX1084.2 +132200 GO TO RWR-SEQ-WRITE-GF-01 IX1084.2 +132300 NOT INVALID KEY IX1084.2 +132400 MOVE 1 TO SWITCH-NOT-INVALID. IX1084.2 +132500 RWR-SEQ-TEST-GF-01. IX1084.2 +132600 IF SWITCH-NOT-INVALID = 1 IX1084.2 +132700 GO TO RWR-SEQ-PASS-GF-01. IX1084.2 +132800 RWR-SEQ-FAIL-GF-01. IX1084.2 +132900 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +133000 PERFORM FAIL. IX1084.2 +133100 GO TO RWR-SEQ-WRITE-GF-01. IX1084.2 +133200 RWR-SEQ-PASS-GF-01. IX1084.2 +133300 PERFORM PASS. IX1084.2 +133400 RWR-SEQ-WRITE-GF-01. IX1084.2 +133500 PERFORM PRINT-DETAIL. IX1084.2 +133600 IX1084.2 +133700******************************************************************IX1084.2 +133800* TEST REWRITE NOT INVALID ... END-DELETE. *IX1084.2 +133900* *IX1084.2 +134000* IX-33, 4.6.2 *IX1084.2 +134100******************************************************************IX1084.2 +134200 RWR-SEQ-INIT-GF-02. IX1084.2 +134300 MOVE "RWR-SEQ-TEST-GF-02-1" TO PAR-NAME. IX1084.2 +134400 MOVE "REWRITE NOT INV. . END-" TO FEATURE. IX1084.2 +134500 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +134600 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +134700 RWR-SEQ-TEST-GF-02. IX1084.2 +134800 READ IX-FS1 AT END IX1084.2 +134900 MOVE "READ FAILED " TO RE-MARK IX1084.2 +135000 PERFORM FAIL IX1084.2 +135100 GO TO RWR-SEQ-WRITE-GF-02-1. IX1084.2 +135200 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS1-REC-120IX1084.2 +135300 REWRITE IX-FS1R1-F-G-240 IX1084.2 +135400 INVALID MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +135500 PERFORM FAIL IX1084.2 +135600 GO TO RWR-SEQ-WRITE-GF-02-1 IX1084.2 +135700 NOT INVALID IX1084.2 +135800 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +135900 END-REWRITE. IX1084.2 +136000 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +136100 RWR-SEQ-TEST-GF-02-1. IX1084.2 +136200 IF SWITCH-NOT-INVALID = 1 IX1084.2 +136300 GO TO RWR-SEQ-PASS-GF-02-1. IX1084.2 +136400 RWR-SEQ-FAIL-GF-02-1. IX1084.2 +136500 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +136600 PERFORM FAIL. IX1084.2 +136700 GO TO RWR-SEQ-WRITE-GF-02-1. IX1084.2 +136800 RWR-SEQ-PASS-GF-02-1. IX1084.2 +136900 PERFORM PASS. IX1084.2 +137000 RWR-SEQ-WRITE-GF-02-1. IX1084.2 +137100 PERFORM PRINT-DETAIL. IX1084.2 +137200 IX1084.2 +137300 RWR-SEQ-TEST-GF-02-2. IX1084.2 +137400 MOVE "RWR-SEQ-TEST-GF-02-2" TO PAR-NAME. IX1084.2 +137500 MOVE "END-REWRITE. " TO FEATURE. IX1084.2 +137600 IF SWITCH-END-XXX = 1 IX1084.2 +137700 GO TO RWR-SEQ-PASS-GF-02-2. IX1084.2 +137800 RWR-SEQ-FAIL-GF-02-2. IX1084.2 +137900 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +138000 PERFORM FAIL. IX1084.2 +138100 GO TO RWR-SEQ-WRITE-GF-02-2. IX1084.2 +138200 RWR-SEQ-PASS-GF-02-2. IX1084.2 +138300 PERFORM PASS. IX1084.2 +138400 RWR-SEQ-WRITE-GF-02-2. IX1084.2 +138500 PERFORM PRINT-DETAIL. IX1084.2 +138600 IX1084.2 +138700******************************************************************IX1084.2 +138800* TEST: IF REWRITE. NOT INVALID ... END-DELETE ... . *IX1084.2 +138900* *IX1084.2 +139000* IX-33, 4.6.2 *IX1084.2 +139100******************************************************************IX1084.2 +139200 RWR-SEQ-INIT-GF-03. IX1084.2 +139300 MOVE "RWR-SEQ-TEST-GF-03-1" TO PAR-NAME. IX1084.2 +139400 MOVE "IF .REWRITE. NOT INV. . END-" TO FEATURE. IX1084.2 +139500 MOVE ZERO TO SWITCH-NOT-INVALID. IX1084.2 +139600 MOVE ZERO TO SWITCH-END-XXX. IX1084.2 +139700 MOVE 1 TO SWITCH-IF. IX1084.2 +139800 RWR-SEQ-TEST-GF-03. IX1084.2 +139900 READ IX-FS1 END IX1084.2 +140000 MOVE "READ FAILED " TO RE-MARK IX1084.2 +140100 PERFORM FAIL IX1084.2 +140200 GO TO RWR-SEQ-WRITE-GF-03-1. IX1084.2 +140300 IF SWITCH-IF = 1 IX1084.2 +140400 MOVE "RECORD REPLACED BY REWRITE STATEMENT" TO IX-FS1-REC-120IX1084.2 +140500 REWRITE IX-FS1R1-F-G-240 IX1084.2 +140600 INVALID KEY MOVE "REWRITE IS INVALID" TO RE-MARK IX1084.2 +140700 PERFORM FAIL IX1084.2 +140800 GO TO RWR-SEQ-WRITE-GF-03-1 IX1084.2 +140900 NOT INVALID KEY IX1084.2 +141000 MOVE 1 TO SWITCH-NOT-INVALID IX1084.2 +141100 END-REWRITE IX1084.2 +141200 MOVE 1 TO SWITCH-END-XXX. IX1084.2 +141300 MOVE 9 TO SWITCH-END-X9X. IX1084.2 +141400 RWR-SEQ-TEST-GF-03-1. IX1084.2 +141500 IF SWITCH-NOT-INVALID = 1 IX1084.2 +141600 GO TO RWR-SEQ-PASS-GF-03-1. IX1084.2 +141700 RWR-SEQ-FAIL-GF-03-1. IX1084.2 +141800 MOVE "IX-33, 4.6.2 " TO RE-MARK.IX1084.2 +141900 PERFORM FAIL. IX1084.2 +142000 GO TO RWR-SEQ-WRITE-GF-03-1. IX1084.2 +142100 RWR-SEQ-PASS-GF-03-1. IX1084.2 +142200 PERFORM PASS. IX1084.2 +142300 RWR-SEQ-WRITE-GF-03-1. IX1084.2 +142400 PERFORM PRINT-DETAIL. IX1084.2 +142500 IX1084.2 +142600 RWR-SEQ-TEST-GF-03-2. IX1084.2 +142700 MOVE "END-REWRITE" TO FEATURE. IX1084.2 +142800 MOVE "RWR-SEQ-TEST-GF-03-2" TO PAR-NAME. IX1084.2 +142900 IF SWITCH-END-XXX = 1 IX1084.2 +143000 GO TO RWR-SEQ-PASS-GF-03-2. IX1084.2 +143100 RWR-SEQ-FAIL-GF-03-2. IX1084.2 +143200 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +143300 PERFORM FAIL. IX1084.2 +143400 GO TO RWR-SEQ-WRITE-GF-03-2. IX1084.2 +143500 RWR-SEQ-PASS-GF-03-2. IX1084.2 +143600 PERFORM PASS. IX1084.2 +143700 RWR-SEQ-WRITE-GF-03-2. IX1084.2 +143800 PERFORM PRINT-DETAIL. IX1084.2 +143900 IX1084.2 +144000 RWR-SEQ-TEST-GF-03-3. IX1084.2 +144100 MOVE "RWR-SEQ-TEST-GF-03-3" TO PAR-NAME. IX1084.2 +144200 IF SWITCH-END-X9X = 9 IX1084.2 +144300 GO TO RWR-SEQ-PASS-GF-03-3. IX1084.2 +144400 RWR-SEQ-FAIL-GF-03-3. IX1084.2 +144500 MOVE "IX-32 4.5.4 (19) " TO RE-MARK.IX1084.2 +144600 PERFORM FAIL. IX1084.2 +144700 GO TO RWR-SEQ-WRITE-GF-03-3. IX1084.2 +144800 RWR-SEQ-PASS-GF-03-3. IX1084.2 +144900 PERFORM PASS. IX1084.2 +145000 RWR-SEQ-WRITE-GF-03-3. IX1084.2 +145100 PERFORM PRINT-DETAIL. IX1084.2 +145200 IX1084.2 +145300 CLOSE IX-FS1. IX1084.2 +145400 IX1084.2 +145500 IX1084.2 +145600 CCVS-EXIT SECTION. IX1084.2 +145700 CCVS-999999. IX1084.2 +145800 GO TO CLOSE-FILES. IX1084.2 diff --git a/tests/cobol85/IX/IX109A.CBL b/tests/cobol85/IX/IX109A.CBL new file mode 100755 index 00000000..590e2247 --- /dev/null +++ b/tests/cobol85/IX/IX109A.CBL @@ -0,0 +1,1071 @@ +000100 IDENTIFICATION DIVISION. IX1094.2 +000200 PROGRAM-ID. IX1094.2 +000300 IX109A. IX1094.2 +000400**************************************************************** IX1094.2 +000500* * IX1094.2 +000600* VALIDATION FOR:- * IX1094.2 +000700* * IX1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1094.2 +000900* * IX1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1094.2 +001100* * IX1094.2 +001200**************************************************************** IX1094.2 +001300* IX1094.2 +001400* 1. THE ROUTINE CREATES THE MASS STORAGE FILE IX-FS3 IX1094.2 +001500* CONTAINING 50 RECORDS. EACH BLOCK CONTAINS 2 RECORDS, IX1094.2 +001600* EACH RECORD CONTAINS 240 CHARACTERS, ORGANIZATION IS IX1094.2 +001700* INDEXED, ACCESS IS SEQUENTIAL. THIS ROUTINE CHECKS AS IX1094.2 +001800* MANY FILE STATUS CODES AS POSSIBLE. HOWEVER, IT IS NOT IX1094.2 +001900* POSSIBLE TO CHECK ALL CODES NEITHER IN THAT PROGRAM NOR IX1094.2 +002000* IN THE FOLLOWING ONE. IX1094.2 +002100* IX1094.2 +002200* 2. THE ROUTINE READS THE CREATED FILE,VERIFIES IT AND *IX1094.2 +002300* CHECKS THE FILE STATUS CODES: IX1094.2 +002400* 00 - AFTER OPEN OUTPUT IX1094.2 +002500* 00 - AFTER WRITE IX1094.2 +002600* 21 - AFTER WRITE (VIOLATE ASCENDING SEQUENCE) IX1094.2 +002700* 00 - AFTER CLOSE OUTPUT IX1094.2 +002800* 00 - AFTER OPEN INPUT IX1094.2 +002900* 00 - AFTER READ (WITHOUT AT END) IX1094.2 +003000* 10 - AFTER READ (SEE IX-4, 1.3.4, (2) A) IX1094.2 +003100* 00 - AFTER CLOSE INPUT IX1094.2 +003200* 00 - AFTER OPEN INPUT IX1094.2 +003300* 00 - AFTER READ ... END ... IX1094.2 +003400* 10 - AFTER READ ... END ... IX1094.2 +003500* 46 - AFTER READ ... END ... IX1094.2 +003600* IX1094.2 +003700* 4. X-CARDS USED IN THIS PROGRAM: IX1094.2 +003800* IX1094.2 +003900* XXXXX024 IX1094.2 +004000* XXXXX055. IX1094.2 +004100* P XXXXX062. IX1094.2 +004200* XXXXX082. IX1094.2 +004300* XXXXX083. IX1094.2 +004400* C XXXXX084 IX1094.2 +004500* IX1094.2 +004600* IX1094.2 +004700 ENVIRONMENT DIVISION. IX1094.2 +004800 CONFIGURATION SECTION. IX1094.2 +004900 SOURCE-COMPUTER. IX1094.2 +005000 Linux. IX1094.2 +005100 OBJECT-COMPUTER. IX1094.2 +005200 Linux. IX1094.2 +005300 INPUT-OUTPUT SECTION. IX1094.2 +005400 FILE-CONTROL. IX1094.2 +005500*P SELECT RAW-DATA ASSIGN TO IX1094.2 +005600*P "XXXXX062" IX1094.2 +005700*P ORGANIZATION IS INDEXED IX1094.2 +005800*P ACCESS MODE IS RANDOM IX1094.2 +005900*P RECORD KEY IS RAW-DATA-KEY. IX1094.2 +006000* IX1094.2 +006100 SELECT PRINT-FILE ASSIGN TO IX1094.2 +006200 "report.log". IX1094.2 +006300* IX1094.2 +006400 SELECT IX-FS3 ASSIGN IX1094.2 +006500 "XXXXX024" IX1094.2 +006600 ORGANIZATION IS INDEXED IX1094.2 +006700 ACCESS MODE IS SEQUENTIAL IX1094.2 +006800 RECORD KEY IS IX-FS3-KEY IX1094.2 +006900 FILE STATUS IS IX-FS3-STATUS. IX1094.2 +007000 IX1094.2 +007100 DATA DIVISION. IX1094.2 +007200 IX1094.2 +007300 FILE SECTION. IX1094.2 +007400*P IX1094.2 +007500*PD RAW-DATA. IX1094.2 +007600*P IX1094.2 +007700*P1 RAW-DATA-SATZ. IX1094.2 +007800*P 05 RAW-DATA-KEY PIC X(6). IX1094.2 +007900*P 05 C-DATE PIC 9(6). IX1094.2 +008000*P 05 C-TIME PIC 9(8). IX1094.2 +008100*P 05 C-NO-OF-TESTS PIC 99. IX1094.2 +008200*P 05 C-OK PIC 999. IX1094.2 +008300*P 05 C-ALL PIC 999. IX1094.2 +008400*P 05 C-FAIL PIC 999. IX1094.2 +008500*P 05 C-DELETED PIC 999. IX1094.2 +008600*P 05 C-INSPECT PIC 999. IX1094.2 +008700*P 05 C-NOTE PIC X(13). IX1094.2 +008800*P 05 C-INDENT PIC X. IX1094.2 +008900*P 05 C-ABORT PIC X(8). IX1094.2 +009000 IX1094.2 +009100 FD PRINT-FILE. IX1094.2 +009200 IX1094.2 +009300 01 PRINT-REC PIC X(120). IX1094.2 +009400 IX1094.2 +009500 01 DUMMY-RECORD PIC X(120). IX1094.2 +009600 IX1094.2 +009700 FD IX-FS3 IX1094.2 +009800*C DATA RECORDS IX-FS3R1-F-G-240 IX1094.2 +009900*C LABEL RECORD STANDARD IX1094.2 +010000 RECORD 240 IX1094.2 +010100 BLOCK CONTAINS 2 RECORDS. IX1094.2 +010200 IX1094.2 +010300 01 IX-FS3R1-F-G-240. IX1094.2 +010400 05 IX-FS3-REC-120 PIC X(120). IX1094.2 +010500 05 IX-FS3-REC-120-240. IX1094.2 +010600 10 FILLER PIC X(8). IX1094.2 +010700 10 IX-FS3-KEY PIC X(29). IX1094.2 +010800 10 FILLER PIC X(9). IX1094.2 +010900 10 IX-FS3-ALTER-KEY PIC X(29). IX1094.2 +011000 10 FILLER PIC X(45). IX1094.2 +011100 IX1094.2 +011200 IX1094.2 +011300 WORKING-STORAGE SECTION. IX1094.2 +011400 IX1094.2 +011500 01 GRP-0101. IX1094.2 +011600 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1094.2 +011700 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1094.2 +011800 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1094.2 +011900 IX1094.2 +012000 01 GRP-0102. IX1094.2 +012100 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1094.2 +012200 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1094.2 +012300 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1094.2 +012400 IX1094.2 +012500 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1094.2 +012600 IX1094.2 +012700 01 EOF-FLAG PIC 9 VALUE ZERO. IX1094.2 +012800 IX1094.2 +012900 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1094.2 +013000 IX1094.2 +013100 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1094.2 +013200 IX1094.2 +013300 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1094.2 +013400 IX1094.2 +013500 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1094.2 +013600 IX1094.2 +013700 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1094.2 +013800 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1094.2 +013900 IX1094.2 +014000 01 IX-FS3-STATUS. IX1094.2 +014100 05 IX-FS3-STAT1 PIC X. IX1094.2 +014200 05 IX-FS3-STAT2 PIC X. IX1094.2 +014300 IX1094.2 +014400 01 COUNT-OF-RECS PIC 9(5). IX1094.2 +014500 IX1094.2 +014600 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1094.2 +014700 IX1094.2 +014800 01 FILE-RECORD-INFORMATION-REC. IX1094.2 +014900 05 FILE-RECORD-INFO-SKELETON. IX1094.2 +015000 10 FILLER PIC X(48) VALUE IX1094.2 +015100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1094.2 +015200 10 FILLER PIC X(46) VALUE IX1094.2 +015300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1094.2 +015400 10 FILLER PIC X(26) VALUE IX1094.2 +015500 ",LFIL=000000,ORG= ,LBLR= ". IX1094.2 +015600 10 FILLER PIC X(37) VALUE IX1094.2 +015700 ",RECKEY= ". IX1094.2 +015800 10 FILLER PIC X(38) VALUE IX1094.2 +015900 ",ALTKEY1= ". IX1094.2 +016000 10 FILLER PIC X(38) VALUE IX1094.2 +016100 ",ALTKEY2= ". IX1094.2 +016200 10 FILLER PIC X(7) VALUE SPACE. IX1094.2 +016300 05 FILE-RECORD-INFO OCCURS 10. IX1094.2 +016400 10 FILE-RECORD-INFO-P1-120. IX1094.2 +016500 15 FILLER PIC X(5). IX1094.2 +016600 15 XFILE-NAME PIC X(6). IX1094.2 +016700 15 FILLER PIC X(8). IX1094.2 +016800 15 XRECORD-NAME PIC X(6). IX1094.2 +016900 15 FILLER PIC X(1). IX1094.2 +017000 15 REELUNIT-NUMBER PIC 9(1). IX1094.2 +017100 15 FILLER PIC X(7). IX1094.2 +017200 15 XRECORD-NUMBER PIC 9(6). IX1094.2 +017300 15 FILLER PIC X(6). IX1094.2 +017400 15 UPDATE-NUMBER PIC 9(2). IX1094.2 +017500 15 FILLER PIC X(5). IX1094.2 +017600 15 ODO-NUMBER PIC 9(4). IX1094.2 +017700 15 FILLER PIC X(5). IX1094.2 +017800 15 XPROGRAM-NAME PIC X(5). IX1094.2 +017900 15 FILLER PIC X(7). IX1094.2 +018000 15 XRECORD-LENGTH PIC 9(6). IX1094.2 +018100 15 FILLER PIC X(7). IX1094.2 +018200 15 CHARS-OR-RECORDS PIC X(2). IX1094.2 +018300 15 FILLER PIC X(1). IX1094.2 +018400 15 XBLOCK-SIZE PIC 9(4). IX1094.2 +018500 15 FILLER PIC X(6). IX1094.2 +018600 15 RECORDS-IN-FILE PIC 9(6). IX1094.2 +018700 15 FILLER PIC X(5). IX1094.2 +018800 15 XFILE-ORGANIZATION PIC X(2). IX1094.2 +018900 15 FILLER PIC X(6). IX1094.2 +019000 15 XLABEL-TYPE PIC X(1). IX1094.2 +019100 10 FILE-RECORD-INFO-P121-240. IX1094.2 +019200 15 FILLER PIC X(8). IX1094.2 +019300 15 XRECORD-KEY PIC X(29). IX1094.2 +019400 15 FILLER PIC X(9). IX1094.2 +019500 15 ALTERNATE-KEY1 PIC X(29). IX1094.2 +019600 15 FILLER PIC X(9). IX1094.2 +019700 15 ALTERNATE-KEY2 PIC X(29). IX1094.2 +019800 15 FILLER PIC X(7). IX1094.2 +019900 IX1094.2 +020000 01 TEST-RESULTS. IX1094.2 +020100 02 FILLER PIC X VALUE SPACE. IX1094.2 +020200 02 FEATURE PIC X(20) VALUE SPACE. IX1094.2 +020300 02 FILLER PIC X VALUE SPACE. IX1094.2 +020400 02 P-OR-F PIC X(5) VALUE SPACE. IX1094.2 +020500 02 FILLER PIC X VALUE SPACE. IX1094.2 +020600 02 PAR-NAME. IX1094.2 +020700 03 FILLER PIC X(19) VALUE SPACE. IX1094.2 +020800 03 PARDOT-X PIC X VALUE SPACE. IX1094.2 +020900 03 DOTVALUE PIC 99 VALUE ZERO. IX1094.2 +021000 02 FILLER PIC X(8) VALUE SPACE. IX1094.2 +021100 02 RE-MARK PIC X(61). IX1094.2 +021200 01 TEST-COMPUTED. IX1094.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX1094.2 +021400 02 FILLER PIC X(17) VALUE IX1094.2 +021500 " COMPUTED=". IX1094.2 +021600 02 COMPUTED-X. IX1094.2 +021700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1094.2 +021800 03 COMPUTED-N REDEFINES COMPUTED-A IX1094.2 +021900 PIC -9(9).9(9). IX1094.2 +022000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1094.2 +022100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1094.2 +022200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1094.2 +022300 03 CM-18V0 REDEFINES COMPUTED-A. IX1094.2 +022400 04 COMPUTED-18V0 PIC -9(18). IX1094.2 +022500 04 FILLER PIC X. IX1094.2 +022600 03 FILLER PIC X(50) VALUE SPACE. IX1094.2 +022700 01 TEST-CORRECT. IX1094.2 +022800 02 FILLER PIC X(30) VALUE SPACE. IX1094.2 +022900 02 FILLER PIC X(17) VALUE " CORRECT =". IX1094.2 +023000 02 CORRECT-X. IX1094.2 +023100 03 CORRECT-A PIC X(20) VALUE SPACE. IX1094.2 +023200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1094.2 +023300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1094.2 +023400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1094.2 +023500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1094.2 +023600 03 CR-18V0 REDEFINES CORRECT-A. IX1094.2 +023700 04 CORRECT-18V0 PIC -9(18). IX1094.2 +023800 04 FILLER PIC X. IX1094.2 +023900 03 FILLER PIC X(2) VALUE SPACE. IX1094.2 +024000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1094.2 +024100 01 CCVS-C-1. IX1094.2 +024200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1094.2 +024300- "SS PARAGRAPH-NAME IX1094.2 +024400- " REMARKS". IX1094.2 +024500 02 FILLER PIC X(20) VALUE SPACE. IX1094.2 +024600 01 CCVS-C-2. IX1094.2 +024700 02 FILLER PIC X VALUE SPACE. IX1094.2 +024800 02 FILLER PIC X(6) VALUE "TESTED". IX1094.2 +024900 02 FILLER PIC X(15) VALUE SPACE. IX1094.2 +025000 02 FILLER PIC X(4) VALUE "FAIL". IX1094.2 +025100 02 FILLER PIC X(94) VALUE SPACE. IX1094.2 +025200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1094.2 +025300 01 REC-CT PIC 99 VALUE ZERO. IX1094.2 +025400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1094.2 +025500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1094.2 +025600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1094.2 +025700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1094.2 +025800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1094.2 +025900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1094.2 +026000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1094.2 +026100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1094.2 +026200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1094.2 +026300 01 CCVS-H-1. IX1094.2 +026400 02 FILLER PIC X(39) VALUE SPACES. IX1094.2 +026500 02 FILLER PIC X(42) VALUE IX1094.2 +026600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1094.2 +026700 02 FILLER PIC X(39) VALUE SPACES. IX1094.2 +026800 01 CCVS-H-2A. IX1094.2 +026900 02 FILLER PIC X(40) VALUE SPACE. IX1094.2 +027000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1094.2 +027100 02 FILLER PIC XXXX VALUE IX1094.2 +027200 "4.2 ". IX1094.2 +027300 02 FILLER PIC X(28) VALUE IX1094.2 +027400 " COPY - NOT FOR DISTRIBUTION". IX1094.2 +027500 02 FILLER PIC X(41) VALUE SPACE. IX1094.2 +027600 IX1094.2 +027700 01 CCVS-H-2B. IX1094.2 +027800 02 FILLER PIC X(15) VALUE IX1094.2 +027900 "TEST RESULT OF ". IX1094.2 +028000 02 TEST-ID PIC X(9). IX1094.2 +028100 02 FILLER PIC X(4) VALUE IX1094.2 +028200 " IN ". IX1094.2 +028300 02 FILLER PIC X(12) VALUE IX1094.2 +028400 " HIGH ". IX1094.2 +028500 02 FILLER PIC X(22) VALUE IX1094.2 +028600 " LEVEL VALIDATION FOR ". IX1094.2 +028700 02 FILLER PIC X(58) VALUE IX1094.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1094.2 +028900 01 CCVS-H-3. IX1094.2 +029000 02 FILLER PIC X(34) VALUE IX1094.2 +029100 " FOR OFFICIAL USE ONLY ". IX1094.2 +029200 02 FILLER PIC X(58) VALUE IX1094.2 +029300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1094.2 +029400 02 FILLER PIC X(28) VALUE IX1094.2 +029500 " COPYRIGHT 1985 ". IX1094.2 +029600 01 CCVS-E-1. IX1094.2 +029700 02 FILLER PIC X(52) VALUE SPACE. IX1094.2 +029800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1094.2 +029900 02 ID-AGAIN PIC X(9). IX1094.2 +030000 02 FILLER PIC X(45) VALUE SPACES. IX1094.2 +030100 01 CCVS-E-2. IX1094.2 +030200 02 FILLER PIC X(31) VALUE SPACE. IX1094.2 +030300 02 FILLER PIC X(21) VALUE SPACE. IX1094.2 +030400 02 CCVS-E-2-2. IX1094.2 +030500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1094.2 +030600 03 FILLER PIC X VALUE SPACE. IX1094.2 +030700 03 ENDER-DESC PIC X(44) VALUE IX1094.2 +030800 "ERRORS ENCOUNTERED". IX1094.2 +030900 01 CCVS-E-3. IX1094.2 +031000 02 FILLER PIC X(22) VALUE IX1094.2 +031100 " FOR OFFICIAL USE ONLY". IX1094.2 +031200 02 FILLER PIC X(12) VALUE SPACE. IX1094.2 +031300 02 FILLER PIC X(58) VALUE IX1094.2 +031400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1094.2 +031500 02 FILLER PIC X(13) VALUE SPACE. IX1094.2 +031600 02 FILLER PIC X(15) VALUE IX1094.2 +031700 " COPYRIGHT 1985". IX1094.2 +031800 01 CCVS-E-4. IX1094.2 +031900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1094.2 +032000 02 FILLER PIC X(4) VALUE " OF ". IX1094.2 +032100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1094.2 +032200 02 FILLER PIC X(40) VALUE IX1094.2 +032300 " TESTS WERE EXECUTED SUCCESSFULLY". IX1094.2 +032400 01 XXINFO. IX1094.2 +032500 02 FILLER PIC X(19) VALUE IX1094.2 +032600 "*** INFORMATION ***". IX1094.2 +032700 02 INFO-TEXT. IX1094.2 +032800 04 FILLER PIC X(8) VALUE SPACE. IX1094.2 +032900 04 XXCOMPUTED PIC X(20). IX1094.2 +033000 04 FILLER PIC X(5) VALUE SPACE. IX1094.2 +033100 04 XXCORRECT PIC X(20). IX1094.2 +033200 02 INF-ANSI-REFERENCE PIC X(48). IX1094.2 +033300 01 HYPHEN-LINE. IX1094.2 +033400 02 FILLER PIC IS X VALUE IS SPACE. IX1094.2 +033500 02 FILLER PIC IS X(65) VALUE IS "************************IX1094.2 +033600- "*****************************************". IX1094.2 +033700 02 FILLER PIC IS X(54) VALUE IS "************************IX1094.2 +033800- "******************************". IX1094.2 +033900 01 TEST-NO PIC 99. IX1094.2 +034000 01 CCVS-PGM-ID PIC X(9) VALUE IX1094.2 +034100 "IX109A". IX1094.2 +034200 PROCEDURE DIVISION. IX1094.2 +034300 DECLARATIVES. IX1094.2 +034400 IX1094.2 +034500 SECT-IX109-0002 SECTION. IX1094.2 +034600 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1094.2 +034700 INPUT-PROCESS. IX1094.2 +034800 IF TEST-NO = 13 IX1094.2 +034900 GO TO D-R-TEST-F1-06-1. IX1094.2 +035000 IF STATUS-TEST-10 EQUAL TO 1 IX1094.2 +035100 IF IX-FS3-STAT1 EQUAL TO "1" IX1094.2 +035200 MOVE 1 TO EOF-FLAG IX1094.2 +035300 ELSE IX1094.2 +035400 IF IX-FS3-STAT1 GREATER THAN "1" IX1094.2 +035500 MOVE 1 TO PERM-ERRORS. IX1094.2 +035600 GO TO DECL-EXIT. IX1094.2 +035700 D-R-TEST-F1-06-1. IX1094.2 +035800 IF IX-FS3-STATUS EQUAL TO "46" IX1094.2 +035900 GO TO D-R-PASS-F1-06-0. IX1094.2 +036000 D-R-FAIL-F1-06-0. IX1094.2 +036100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +036200 MOVE "46" TO CORRECT-X. IX1094.2 +036300 MOVE "IX-5, 1.3.4, (5) E 3)" TO RE-MARK. IX1094.2 +036400 PERFORM D-FAIL. IX1094.2 +036500 GO TO D-R-WRITE-F1-06-0. IX1094.2 +036600 D-R-PASS-F1-06-0. IX1094.2 +036700 PERFORM D-PASS. IX1094.2 +036800 D-R-WRITE-F1-06-0. IX1094.2 +036900 MOVE "READ. 46 EXP." TO FEATURE. IX1094.2 +037000 MOVE "REA-TEST-F1-06-0" TO PAR-NAME. IX1094.2 +037100 PERFORM D-PRINT-DETAIL. IX1094.2 +037200 D-CLOSE-FILES. IX1094.2 +037300 CLOSE IX-FS3. IX1094.2 +037400*P OPEN I-O RAW-DATA. IX1094.2 +037500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1094.2 +037600*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1094.2 +037700*P MOVE "OK. " TO C-ABORT. IX1094.2 +037800*P MOVE PASS-COUNTER TO C-OK. IX1094.2 +037900*P MOVE ERROR-HOLD TO C-ALL. IX1094.2 +038000*P MOVE ERROR-COUNTER TO C-FAIL. IX1094.2 +038100*P MOVE DELETE-COUNTER TO C-DELETED. IX1094.2 +038200*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1094.2 +038300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1094.2 +038400*P-END-E-2. IX1094.2 +038500*P CLOSE RAW-DATA. IX1094.2 +038600 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1094.2 +038700 CLOSE PRINT-FILE. IX1094.2 +038800 D-TERMINATE-CCVS. IX1094.2 +038900*S EXIT PROGRAM. IX1094.2 +039000*S-TERMINATE-CALL. IX1094.2 +039100 STOP RUN. IX1094.2 +039200 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1094.2 +039300 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1094.2 +039400 D-PRINT-DETAIL. IX1094.2 +039500 IF REC-CT NOT EQUAL TO ZERO IX1094.2 +039600 MOVE "." TO PARDOT-X IX1094.2 +039700 MOVE REC-CT TO DOTVALUE. IX1094.2 +039800 MOVE TEST-RESULTS TO PRINT-REC. IX1094.2 +039900 PERFORM D-WRITE-LINE. IX1094.2 +040000 IF P-OR-F EQUAL TO "FAIL*" IX1094.2 +040100 PERFORM D-WRITE-LINE IX1094.2 +040200 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1094.2 +040300 ELSE IX1094.2 +040400 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1094.2 +040500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1094.2 +040600 MOVE SPACE TO CORRECT-X. IX1094.2 +040700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1094.2 +040800 MOVE SPACE TO RE-MARK. IX1094.2 +040900 D-END-ROUTINE. IX1094.2 +041000 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1094.2 +041100 PERFORM D-WRITE-LINE 5 TIMES. IX1094.2 +041200 D-END-RTN-EXIT. IX1094.2 +041300 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1094.2 +041400 PERFORM D-WRITE-LINE 2 TIMES. IX1094.2 +041500 D-END-ROUTINE-1. IX1094.2 +041600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1094.2 +041700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1094.2 +041800 ADD PASS-COUNTER TO ERROR-HOLD. IX1094.2 +041900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1094.2 +042000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1094.2 +042100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1094.2 +042200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1094.2 +042300 D-END-ROUTINE-12. IX1094.2 +042400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1094.2 +042500 IF ERROR-COUNTER IS EQUAL TO ZERO IX1094.2 +042600 MOVE "NO " TO ERROR-TOTAL IX1094.2 +042700 ELSE IX1094.2 +042800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1094.2 +042900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1094.2 +043000 PERFORM D-WRITE-LINE. IX1094.2 +043100 D-END-ROUTINE-13. IX1094.2 +043200 IF DELETE-COUNTER IS EQUAL TO ZERO IX1094.2 +043300 MOVE "NO " TO ERROR-TOTAL ELSE IX1094.2 +043400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1094.2 +043500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1094.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1094.2 +043700 PERFORM D-WRITE-LINE. IX1094.2 +043800 IF INSPECT-COUNTER EQUAL TO ZERO IX1094.2 +043900 MOVE "NO " TO ERROR-TOTAL IX1094.2 +044000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1094.2 +044100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1094.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1094.2 +044300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1094.2 +044400 D-WRITE-LINE. IX1094.2 +044500 ADD 1 TO RECORD-COUNT. IX1094.2 +044600 IF RECORD-COUNT GREATER 42 IX1094.2 +044700 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1094.2 +044800 MOVE SPACE TO DUMMY-RECORD IX1094.2 +044900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1094.2 +045000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1094.2 +045100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1094.2 +045200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1094.2 +045300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1094.2 +045400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1094.2 +045500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1094.2 +045600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1094.2 +045700 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1094.2 +045800 MOVE ZERO TO RECORD-COUNT. IX1094.2 +045900 PERFORM D-WRT-LN. IX1094.2 +046000 D-WRT-LN. IX1094.2 +046100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1094.2 +046200 MOVE SPACE TO DUMMY-RECORD. IX1094.2 +046300 D-FAIL-ROUTINE. IX1094.2 +046400 IF COMPUTED-X NOT EQUAL TO SPACE IX1094.2 +046500 GO TO D-FAIL-ROUTINE-WRITE. IX1094.2 +046600 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1094.2 +046700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1094.2 +046800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1094.2 +046900 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1094.2 +047000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1094.2 +047100 GO TO D-FAIL-ROUTINE-EX. IX1094.2 +047200 D-FAIL-ROUTINE-WRITE. IX1094.2 +047300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1094.2 +047400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1094.2 +047500 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1094.2 +047600 MOVE SPACES TO COR-ANSI-REFERENCE. IX1094.2 +047700 D-FAIL-ROUTINE-EX. EXIT. IX1094.2 +047800 D-BAIL-OUT. IX1094.2 +047900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1094.2 +048000 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1094.2 +048100 D-BAIL-OUT-WRITE. IX1094.2 +048200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1094.2 +048300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1094.2 +048400 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1094.2 +048500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1094.2 +048600 D-BAIL-OUT-EX. EXIT. IX1094.2 +048700 DECL-EXIT. EXIT. IX1094.2 +048800 END DECLARATIVES. IX1094.2 +048900 IX1094.2 +049000 IX1094.2 +049100 CCVS1 SECTION. IX1094.2 +049200 OPEN-FILES. IX1094.2 +049300*P OPEN I-O RAW-DATA. IX1094.2 +049400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1094.2 +049500*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1094.2 +049600*P MOVE "ABORTED " TO C-ABORT. IX1094.2 +049700*P ADD 1 TO C-NO-OF-TESTS. IX1094.2 +049800*P ACCEPT C-DATE FROM DATE. IX1094.2 +049900*P ACCEPT C-TIME FROM TIME. IX1094.2 +050000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1094.2 +050100*PND-E-1. IX1094.2 +050200*P CLOSE RAW-DATA. IX1094.2 +050300 OPEN OUTPUT PRINT-FILE. IX1094.2 +050400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1094.2 +050500 MOVE SPACE TO TEST-RESULTS. IX1094.2 +050600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1094.2 +050700 MOVE ZERO TO REC-SKL-SUB. IX1094.2 +050800 PERFORM CCVS-INIT-FILE 9 TIMES. IX1094.2 +050900 CCVS-INIT-FILE. IX1094.2 +051000 ADD 1 TO REC-SKL-SUB. IX1094.2 +051100 MOVE FILE-RECORD-INFO-SKELETON IX1094.2 +051200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1094.2 +051300 CCVS-INIT-EXIT. IX1094.2 +051400 GO TO CCVS1-EXIT. IX1094.2 +051500 CLOSE-FILES. IX1094.2 +051600*P OPEN I-O RAW-DATA. IX1094.2 +051700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1094.2 +051800*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1094.2 +051900*P MOVE "OK. " TO C-ABORT. IX1094.2 +052000*P MOVE PASS-COUNTER TO C-OK. IX1094.2 +052100*P MOVE ERROR-HOLD TO C-ALL. IX1094.2 +052200*P MOVE ERROR-COUNTER TO C-FAIL. IX1094.2 +052300*P MOVE DELETE-COUNTER TO C-DELETED. IX1094.2 +052400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1094.2 +052500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1094.2 +052600*PND-E-2. IX1094.2 +052700*P CLOSE RAW-DATA. IX1094.2 +052800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1094.2 +052900 TERMINATE-CCVS. IX1094.2 +053000*S EXIT PROGRAM. IX1094.2 +053100*SERMINATE-CALL. IX1094.2 +053200 STOP RUN. IX1094.2 +053300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1094.2 +053400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1094.2 +053500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1094.2 +053600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1094.2 +053700 MOVE "****TEST DELETED****" TO RE-MARK. IX1094.2 +053800 PRINT-DETAIL. IX1094.2 +053900 IF REC-CT NOT EQUAL TO ZERO IX1094.2 +054000 MOVE "." TO PARDOT-X IX1094.2 +054100 MOVE REC-CT TO DOTVALUE. IX1094.2 +054200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1094.2 +054300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1094.2 +054400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1094.2 +054500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1094.2 +054600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1094.2 +054700 MOVE SPACE TO CORRECT-X. IX1094.2 +054800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1094.2 +054900 MOVE SPACE TO RE-MARK. IX1094.2 +055000 HEAD-ROUTINE. IX1094.2 +055100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +055200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +055300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1094.2 +055400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1094.2 +055500 COLUMN-NAMES-ROUTINE. IX1094.2 +055600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +055700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +055800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +055900 END-ROUTINE. IX1094.2 +056000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1094.2 +056100 END-RTN-EXIT. IX1094.2 +056200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +056300 END-ROUTINE-1. IX1094.2 +056400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1094.2 +056500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1094.2 +056600 ADD PASS-COUNTER TO ERROR-HOLD. IX1094.2 +056700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1094.2 +056800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1094.2 +056900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1094.2 +057000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1094.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1094.2 +057200 END-ROUTINE-12. IX1094.2 +057300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1094.2 +057400 IF ERROR-COUNTER IS EQUAL TO ZERO IX1094.2 +057500 MOVE "NO " TO ERROR-TOTAL IX1094.2 +057600 ELSE IX1094.2 +057700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1094.2 +057800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1094.2 +057900 PERFORM WRITE-LINE. IX1094.2 +058000 END-ROUTINE-13. IX1094.2 +058100 IF DELETE-COUNTER IS EQUAL TO ZERO IX1094.2 +058200 MOVE "NO " TO ERROR-TOTAL ELSE IX1094.2 +058300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1094.2 +058400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1094.2 +058500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +058600 IF INSPECT-COUNTER EQUAL TO ZERO IX1094.2 +058700 MOVE "NO " TO ERROR-TOTAL IX1094.2 +058800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1094.2 +058900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1094.2 +059000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +059100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1094.2 +059200 WRITE-LINE. IX1094.2 +059300 ADD 1 TO RECORD-COUNT. IX1094.2 +059400 IF RECORD-COUNT GREATER 42 IX1094.2 +059500 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1094.2 +059600 MOVE SPACE TO DUMMY-RECORD IX1094.2 +059700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1094.2 +059800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1094.2 +059900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1094.2 +060000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1094.2 +060100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1094.2 +060200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1094.2 +060300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1094.2 +060400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1094.2 +060500 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1094.2 +060600 MOVE ZERO TO RECORD-COUNT. IX1094.2 +060700 PERFORM WRT-LN. IX1094.2 +060800 WRT-LN. IX1094.2 +060900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1094.2 +061000 MOVE SPACE TO DUMMY-RECORD. IX1094.2 +061100 BLANK-LINE-PRINT. IX1094.2 +061200 PERFORM WRT-LN. IX1094.2 +061300 FAIL-ROUTINE. IX1094.2 +061400 IF COMPUTED-X NOT EQUAL TO SPACE IX1094.2 +061500 GO TO FAIL-ROUTINE-WRITE. IX1094.2 +061600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1094.2 +061700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1094.2 +061800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1094.2 +061900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +062000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1094.2 +062100 GO TO FAIL-ROUTINE-EX. IX1094.2 +062200 FAIL-ROUTINE-WRITE. IX1094.2 +062300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1094.2 +062400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1094.2 +062500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1094.2 +062600 MOVE SPACES TO COR-ANSI-REFERENCE. IX1094.2 +062700 FAIL-ROUTINE-EX. EXIT. IX1094.2 +062800 BAIL-OUT. IX1094.2 +062900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1094.2 +063000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1094.2 +063100 BAIL-OUT-WRITE. IX1094.2 +063200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1094.2 +063300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1094.2 +063400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1094.2 +063500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1094.2 +063600 BAIL-OUT-EX. EXIT. IX1094.2 +063700 CCVS1-EXIT. IX1094.2 +063800 EXIT. IX1094.2 +063900 IX1094.2 +064000 SECT-IX109A-0003 SECTION. IX1094.2 +064100 SEQ-INIT-010. IX1094.2 +064200 MOVE ZERO TO TEST-NO. IX1094.2 +064300 MOVE "IX-FS3" TO XFILE-NAME (1). IX1094.2 +064400 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1094.2 +064500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1094.2 +064600 MOVE 000240 TO XRECORD-LENGTH (1). IX1094.2 +064700 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1094.2 +064800 MOVE 0002 TO XBLOCK-SIZE (1). IX1094.2 +064900 MOVE 000050 TO RECORDS-IN-FILE (1). IX1094.2 +065000 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1094.2 +065100 MOVE "S" TO XLABEL-TYPE (1). IX1094.2 +065200 MOVE 000001 TO XRECORD-NUMBER (1). IX1094.2 +065300 MOVE 0 TO COUNT-OF-RECS. IX1094.2 +065400 IX1094.2 +065500******************************************************************IX1094.2 +065600* TEST 1 *IX1094.2 +065700* OPEN OUTPUT ... 00 EXPECTED *IX1094.2 +065800* IX-3, 1.3.4 (1) A *IX1094.2 +065900* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1094.2 +066000* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1094.2 +066100******************************************************************IX1094.2 +066200 OPN-INIT-GF-01-0. IX1094.2 +066300 MOVE 1 TO STATUS-TEST-00. IX1094.2 +066400 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +066500 MOVE "OPEN OUTPUT: 00 EXP." TO FEATURE. IX1094.2 +066600 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1094.2 +066700 OPEN IX1094.2 +066800 OUTPUT IX-FS3. IX1094.2 +066900 IF IX-FS3-STATUS EQUAL TO "00" IX1094.2 +067000 GO TO OPN-PASS-GF-01-0. IX1094.2 +067100 OPN-FAIL-GF-01-0. IX1094.2 +067200 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +067300 PERFORM FAIL. IX1094.2 +067400 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +067500 MOVE "00" TO CORRECT-X. IX1094.2 +067600 GO TO OPN-WRITE-GF-01-0. IX1094.2 +067700 OPN-PASS-GF-01-0. IX1094.2 +067800 PERFORM PASS. IX1094.2 +067900 OPN-WRITE-GF-01-0. IX1094.2 +068000 PERFORM PRINT-DETAIL. IX1094.2 +068100******************************************************************IX1094.2 +068200* TEST 2 *IX1094.2 +068300* WRITE 00 EXPECTED *IX1094.2 +068400* IX-3, 1.3.4 (1) A *IX1094.2 +068500* CREATING A INDEXED FILE WITH 50 RECORDS *IX1094.2 +068600* KEY: FROM 000000001 TO 000000050 *IX1094.2 +068700******************************************************************IX1094.2 +068800 WRI-INIT-GF-01-0. IX1094.2 +068900 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +069000 MOVE 0 TO STATUS-TEST-00. IX1094.2 +069100 MOVE "WRITE: 00 EXPECTED" TO FEATURE. IX1094.2 +069200 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1094.2 +069300 WRI-TEST-GF-01-0. IX1094.2 +069400 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY. IX1094.2 +069500 MOVE GRP-0101 TO XRECORD-KEY (1). IX1094.2 +069600 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1094.2 +069700* THE VALUE OF THE ALTERNATE KEY IS 50 TIMES UNCHANGED *IX1094.2 +069800 MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1094.2 +069900 WRITE IX-FS3R1-F-G-240. IX1094.2 +070000 IF IX-FS3-STATUS NOT = "00" IX1094.2 +070100 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +070200 ELSE IX1094.2 +070300 ADD 1 TO COUNT-OF-RECS. IX1094.2 +070400 IF XRECORD-NUMBER (1) EQUAL TO 50 IX1094.2 +070500 GO TO WRI-TEST-GF-01-1. IX1094.2 +070600 ADD 1 TO XRECORD-NUMBER (1). IX1094.2 +070700 GO TO WRI-TEST-GF-01-0. IX1094.2 +070800 WRI-TEST-GF-01-1. IX1094.2 +070900 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1094.2 +071000 GO TO WRI-PASS-GF-01-0. IX1094.2 +071100 WRI-FAIL-GF-01-0. IX1094.2 +071200 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +071300 PERFORM FAIL. IX1094.2 +071400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. IX1094.2 +071500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IX1094.2 +071600 GO TO WRI-WRITE-GF-01-0. IX1094.2 +071700 WRI-PASS-GF-01-0. IX1094.2 +071800 PERFORM PASS. IX1094.2 +071900 WRI-WRITE-GF-01-0. IX1094.2 +072000 PERFORM PRINT-DETAIL. IX1094.2 +072100 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IX1094.2 +072200 MOVE "CREATE FILE IX-FS3" TO FEATURE. IX1094.2 +072300 MOVE "WRI-TEST-GF-01-1" TO PAR-NAME. IX1094.2 +072400 MOVE COUNT-OF-RECS TO CORRECT-18V0. IX1094.2 +072500 PERFORM PRINT-DETAIL. IX1094.2 +072600 IX1094.2 +072700******************************************************************IX1094.2 +072800* TEST 3 *IX1094.2 +072900* WRITE (WRONG SEQUENCE) 21 EXPECTED *IX1094.2 +073000* IX-4, 1.3.4 (3) A *IX1094.2 +073100* KEY: 000000049 *IX1094.2 +073200******************************************************************IX1094.2 +073300 WRI-INIT-GF-02-0. IX1094.2 +073400 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +073500 MOVE 0 TO STATUS-TEST-00. IX1094.2 +073600 MOVE "WRITE: 21 EXP." TO FEATURE. IX1094.2 +073700 MOVE "WRI-TEST-GF-02-0" TO PAR-NAME. IX1094.2 +073800 MOVE 49 TO XRECORD-NUMBER (1). IX1094.2 +073900 WRI-TEST-GF-02-0. IX1094.2 +074000 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY. IX1094.2 +074100 MOVE GRP-0101 TO XRECORD-KEY (1). IX1094.2 +074200 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1094.2 +074300 MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1094.2 +074400 WRITE IX-FS3R1-F-G-240 INVALID KEY GO TO WRI-TEST-GF-02-1. IX1094.2 +074500 WRI-TEST-GF-02-1. IX1094.2 +074600 IF IX-FS3-STATUS = "21" IX1094.2 +074700 GO TO WRI-PASS-GF-02-0. IX1094.2 +074800 WRI-FAIL-GF-02-0. IX1094.2 +074900 MOVE "IX-4, 1.3.4, (3) A. " TO RE-MARK. IX1094.2 +075000 PERFORM FAIL. IX1094.2 +075100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +075200 MOVE "21" TO CORRECT-X. IX1094.2 +075300 GO TO WRI-WRITE-GF-02-0. IX1094.2 +075400 WRI-PASS-GF-02-0. IX1094.2 +075500 PERFORM PASS. IX1094.2 +075600 WRI-WRITE-GF-02-0. IX1094.2 +075700 PERFORM PRINT-DETAIL. IX1094.2 +075800 IX1094.2 +075900******************************************************************IX1094.2 +076000* TEST 4 *IX1094.2 +076100* CLOSE OUTPUT 00 EXPECTED *IX1094.2 +076200* IX-3, 1.3.4 (1) A *IX1094.2 +076300******************************************************************IX1094.2 +076400 CLO-INIT-GF-01-0. IX1094.2 +076500 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +076600 MOVE "CLOSE OUTPUT:00 EXP." TO FEATURE. IX1094.2 +076700 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1094.2 +076800 CLO-TEST-GF-01-0. IX1094.2 +076900 CLOSE IX-FS3. IX1094.2 +077000 IF IX-FS3-STATUS = "00" IX1094.2 +077100 GO TO CLO-PASS-GF-01-0. IX1094.2 +077200 CLO-FAIL-GF-01-0. IX1094.2 +077300 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +077400 PERFORM FAIL. IX1094.2 +077500 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +077600 MOVE "00" TO CORRECT-X. IX1094.2 +077700 GO TO CLO-WRITE-GF-01-0. IX1094.2 +077800 CLO-PASS-GF-01-0. IX1094.2 +077900 PERFORM PASS. IX1094.2 +078000 CLO-WRITE-GF-01-0. IX1094.2 +078100 PERFORM PRINT-DETAIL. IX1094.2 +078200 IX1094.2 +078300******************************************************************IX1094.2 +078400* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1094.2 +078500******************************************************************IX1094.2 +078600 IX1094.2 +078700******************************************************************IX1094.2 +078800* TEST 5 *IX1094.2 +078900* OPEN INPUT 00 EXPECTED *IX1094.2 +079000* IX-3, 1.3.4 (1) A *IX1094.2 +079100******************************************************************IX1094.2 +079200 OPN-INIT-GF-02-0. IX1094.2 +079300 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +079400 MOVE "OPEN INPUT: 00 EXP." TO FEATURE. IX1094.2 +079500 MOVE "OPN-TEST-GF-02-0" TO PAR-NAME. IX1094.2 +079600 OPN-TEST-GF-02-0. IX1094.2 +079700 OPEN IX1094.2 +079800 INPUT IX-FS3. IX1094.2 +079900 IF IX-FS3-STATUS EQUAL TO "00" IX1094.2 +080000 GO TO OPN-PASS-GF-02-0. IX1094.2 +080100 OPN-FAIL-GF-02-0. IX1094.2 +080200 MOVE "IX-3, 1.3.4, (1) A." TO RE-MARK. IX1094.2 +080300 PERFORM FAIL. IX1094.2 +080400 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +080500 MOVE "00" TO CORRECT-X. IX1094.2 +080600 GO TO OPN-WRITE-GF-02-0. IX1094.2 +080700 OPN-PASS-GF-02-0. IX1094.2 +080800 PERFORM PASS. IX1094.2 +080900 OPN-WRITE-GF-02-0. IX1094.2 +081000 PERFORM PRINT-DETAIL. IX1094.2 +081100******************************************************************IX1094.2 +081200* STATUS 10 CHECK ON INPUT FILE IX-FS3. *IX1094.2 +081300* THIS TEST READS AND VERIFIES THE RECORDS WRITTEN IN *IX1094.2 +081400* INX-TEST-004. THE USE ON INPUT PROCESSES THE AT END *IX1094.2 +081500* CONDITION. THERE IS NO AT END PHRASE IN THE READ STATEMENT. *IX1094.2 +081600******************************************************************IX1094.2 +081700 REA-INIT-F1-01-0. IX1094.2 +081800 MOVE 1 TO STATUS-TEST-10. IX1094.2 +081900 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +082000 MOVE ZERO TO COUNT-OF-RECS. IX1094.2 +082100 MOVE ZERO TO RECORDS-IN-ERROR. IX1094.2 +082200 MOVE ZERO TO PERM-ERRORS. IX1094.2 +082300 MOVE ZERO TO EOF-FLAG. IX1094.2 +082400 REA-TEST-F1-01-0. IX1094.2 +082500 READ IX-FS3. IX1094.2 +082600 IF EOF-FLAG EQUAL TO 1 IX1094.2 +082700 GO TO REA-TEST-F1-01-1. IX1094.2 +082800 MOVE IX-FS3R1-F-G-240 TO FILE-RECORD-INFO (1). IX1094.2 +082900 ADD 1 TO COUNT-OF-RECS. IX1094.2 +083000 IF COUNT-OF-RECS GREATER THAN 50 IX1094.2 +083100 MOVE "MORE THAN 50 RECORDS" TO RE-MARK IX1094.2 +083200 GO TO REA-FAIL-F1-01-0. IX1094.2 +083300 IF COUNT-OF-RECS LESS THAN 51 IX1094.2 +083400 IF IX-FS3-STATUS NOT = "00" IX1094.2 +083500 MOVE 1 TO STATUS-TEST-READ. IX1094.2 +083600 IF PERM-ERRORS EQUAL TO 1 IX1094.2 +083700 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +083800 GO TO REA-TEST-F1-01-1. IX1094.2 +083900 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) IX1094.2 +084000 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +084100 GO TO REA-TEST-F1-01-1. IX1094.2 +084200 IF XFILE-NAME (1) NOT EQUAL TO "IX-FS3" IX1094.2 +084300 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +084400 GO TO REA-TEST-F1-01-1. IX1094.2 +084500 MOVE XRECORD-KEY (1) TO GRP-0101. IX1094.2 +084600 IF GRP-0101-KEY NOT EQUAL TO COUNT-OF-RECS IX1094.2 +084700 ADD 1 TO RECORDS-IN-ERROR. IX1094.2 +084800 GO TO REA-TEST-F1-01-0. IX1094.2 +084900 REA-TEST-F1-01-1. IX1094.2 +085000******************************************************************IX1094.2 +085100* TEST 6 *IX1094.2 +085200* READ ... . (WITHOUT AT END) 00 EXPECTED *IX1094.2 +085300* IX-3, 1.3.4 (1) A *IX1094.2 +085400******************************************************************IX1094.2 +085500 MOVE "REA-TEST-F1-01-0" TO PAR-NAME. IX1094.2 +085600 MOVE "READ (USE): 00 EXP." TO FEATURE. IX1094.2 +085700 IF STATUS-TEST-READ = 0 IX1094.2 +085800 GO TO REA-PASS-F1-01-0. IX1094.2 +085900 REA-FAIL-F1-01-0. IX1094.2 +086000 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +086100 MOVE "I-O STATUS IS NOT 00" TO COMPUTED-A. IX1094.2 +086200 MOVE "00" TO CORRECT-X. IX1094.2 +086300 PERFORM FAIL. IX1094.2 +086400 GO TO REA-WRITE-F1-01-0. IX1094.2 +086500 REA-PASS-F1-01-0. IX1094.2 +086600 PERFORM PASS. IX1094.2 +086700 REA-WRITE-F1-01-0. IX1094.2 +086800 PERFORM PRINT-DETAIL. IX1094.2 +086900* IX1094.2 +087000 REA-INIT-GF-02-0. IX1094.2 +087100******************************************************************IX1094.2 +087200* TEST 7 *IX1094.2 +087300* VERIFY FILE *IX1094.2 +087400******************************************************************IX1094.2 +087500 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1094.2 +087600 GO TO REA-TEST-F1-02-0. IX1094.2 +087700 MOVE "ERRORS IN READING IX-FS3" TO RE-MARK. IX1094.2 +087800 REA-FAIL-F1-02-0. IX1094.2 +087900 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. IX1094.2 +088000 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. IX1094.2 +088100 GO TO REA-FAIL-F1-02-1. IX1094.2 +088200 REA-TEST-F1-02-0. IX1094.2 +088300 IF COUNT-OF-RECORDS EQUAL TO 50 IX1094.2 +088400 GO TO REA-PASS-F1-02-0. IX1094.2 +088500 MOVE "UNEXPECTED EOF" TO RE-MARK. IX1094.2 +088600 MOVE "RECORDS READ =" TO COMPUTED-A. IX1094.2 +088700 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IX1094.2 +088800 REA-FAIL-F1-02-1. IX1094.2 +088900 PERFORM FAIL. IX1094.2 +089000 GO TO REA-WRITE-F1-02-0. IX1094.2 +089100 REA-PASS-F1-02-0. IX1094.2 +089200 PERFORM PASS. IX1094.2 +089300 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. IX1094.2 +089400 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. IX1094.2 +089500 REA-WRITE-F1-02-0. IX1094.2 +089600 MOVE "REA-TEST-F1-02-0" TO PAR-NAME. IX1094.2 +089700 MOVE "VERIFY FILE IX-FS3" TO FEATURE. IX1094.2 +089800 PERFORM PRINT-DETAIL. IX1094.2 +089900******************************************************************IX1094.2 +090000* TEST 8 *IX1094.2 +090100* READ. (WITHOUT AT END) 10 EXPECTED *IX1094.2 +090200* IX-4, 1.3.4 (2) A *IX1094.2 +090300******************************************************************IX1094.2 +090400 REA-INIT-F1-03-0. IX1094.2 +090500 IF IX-FS3-STATUS EQUAL TO "10" IX1094.2 +090600 GO TO REA-PASS-F1-03-0. IX1094.2 +090700 REA-FAIL-F1-03-0. IX1094.2 +090800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +090900 MOVE "10" TO CORRECT-X. IX1094.2 +091000 MOVE "IX-4, 1.3.4, (2) A." TO RE-MARK. IX1094.2 +091100 PERFORM FAIL. IX1094.2 +091200 GO TO REA-WRITE-F1-03-0. IX1094.2 +091300 REA-PASS-F1-03-0. IX1094.2 +091400 PERFORM PASS. IX1094.2 +091500 REA-WRITE-F1-03-0. IX1094.2 +091600 MOVE "READ : 10 EXP." TO FEATURE. IX1094.2 +091700 MOVE "REA-TEST-F1-03-0" TO PAR-NAME. IX1094.2 +091800 PERFORM PRINT-DETAIL. IX1094.2 +091900******************************************************************IX1094.2 +092000* TEST 9 *IX1094.2 +092100* CLOSE INPUT 00 EXPECTED *IX1094.2 +092200* IX-3, 1.3.4 (1) A *IX1094.2 +092300******************************************************************IX1094.2 +092400 CLO-TEST-GF-02-0. IX1094.2 +092500 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +092600 MOVE "CLOSE INPUT: 00 EXP." TO FEATURE. IX1094.2 +092700 MOVE "CLO-TEST-GF-02-0" TO PAR-NAME. IX1094.2 +092800 CLOSE IX-FS3. IX1094.2 +092900 IF IX-FS3-STATUS = "00" IX1094.2 +093000 GO TO CLO-PASS-GF-02-0. IX1094.2 +093100 CLO-FAIL-GF-02-0. IX1094.2 +093200 MOVE "IX-3, 1.3.4, (1) A " TO RE-MARK. IX1094.2 +093300 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +093400 MOVE "00" TO CORRECT-X. IX1094.2 +093500 PERFORM FAIL. IX1094.2 +093600 GO TO CLO-WRITE-GF-02-0. IX1094.2 +093700 CLO-PASS-GF-02-0. IX1094.2 +093800 PERFORM PASS. IX1094.2 +093900 CLO-WRITE-GF-02-0. IX1094.2 +094000 PERFORM PRINT-DETAIL. IX1094.2 +094100 IX1094.2 +094200******************************************************************IX1094.2 +094300* TEST 10 *IX1094.2 +094400* OPEN INPUT (FOR READ ... AT END) 00 EXPECTED *IX1094.2 +094500* IX-3, 1.3.4 (1) A *IX1094.2 +094600******************************************************************IX1094.2 +094700 OPN-INIT-GF-03-0. IX1094.2 +094800 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +094900 MOVE "OPEN INPUT: 00 EXP." TO FEATURE. IX1094.2 +095000 MOVE "OPN-TEST-GF-03-0" TO PAR-NAME. IX1094.2 +095100 OPN-TEST-GF-03-0. IX1094.2 +095200 OPEN IX1094.2 +095300 INPUT IX-FS3. IX1094.2 +095400 IF IX-FS3-STATUS EQUAL TO "00" IX1094.2 +095500 GO TO OPN-PASS-GF-03-0. IX1094.2 +095600 OPN-FAIL-GF-03-0. IX1094.2 +095700 MOVE "IX-3, 1.3.4, (1) A." TO RE-MARK. IX1094.2 +095800 PERFORM FAIL. IX1094.2 +095900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +096000 MOVE "00" TO CORRECT-X. IX1094.2 +096100 GO TO OPN-WRITE-GF-03-0. IX1094.2 +096200 OPN-PASS-GF-03-0. IX1094.2 +096300 PERFORM PASS. IX1094.2 +096400 OPN-WRITE-GF-03-0. IX1094.2 +096500 PERFORM PRINT-DETAIL. IX1094.2 +096600******************************************************************IX1094.2 +096700* STATUS IO CHECK ON INPUT FILE IX-FS3. *IX1094.2 +096800* THIS TEST READS AND VERIFIES THE RECORDS WRITTEN IN *IX1094.2 +096900* TEST 2. THE USE ON INPUT PROCESSES THE AT END *IX1094.2 +097000* CONDITION. IX1094.2 +097100******************************************************************IX1094.2 +097200 REA-INIT-F1-04-0. IX1094.2 +097300 MOVE 1 TO STATUS-TEST-10. IX1094.2 +097400 MOVE ZERO TO STATUS-TEST-READ. IX1094.2 +097500 MOVE SPACES TO IX-FS3-STATUS. IX1094.2 +097600 MOVE ZERO TO COUNT-OF-RECS. IX1094.2 +097700 MOVE ZERO TO PERM-ERRORS. IX1094.2 +097800 MOVE ZERO TO EOF-FLAG. IX1094.2 +097900 REA-TEST-F1-04-0. IX1094.2 +098000 READ IX-FS3 AT END MOVE 1 TO EOF-FLAG. IX1094.2 +098100 IF EOF-FLAG EQUAL TO 1 IX1094.2 +098200 GO TO REA-TEST-F1-04-1. IX1094.2 +098300 MOVE IX-FS3R1-F-G-240 TO FILE-RECORD-INFO (1). IX1094.2 +098400 ADD 1 TO COUNT-OF-RECS. IX1094.2 +098500 IF COUNT-OF-RECS LESS THAN 51 IX1094.2 +098600 IF IX-FS3-STATUS NOT = "00" IX1094.2 +098700 MOVE 1 TO STATUS-TEST-READ. IX1094.2 +098800 IF PERM-ERRORS EQUAL TO 1 IX1094.2 +098900 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +099000 GO TO REA-TEST-F1-04-1. IX1094.2 +099100 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) IX1094.2 +099200 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +099300 GO TO REA-TEST-F1-04-1. IX1094.2 +099400 IF XFILE-NAME (1) NOT EQUAL TO "IX-FS3" IX1094.2 +099500 ADD 1 TO RECORDS-IN-ERROR IX1094.2 +099600 GO TO REA-TEST-F1-04-1. IX1094.2 +099700 MOVE XRECORD-KEY (1) TO GRP-0101. IX1094.2 +099800 IF GRP-0101-KEY NOT EQUAL TO COUNT-OF-RECS IX1094.2 +099900 ADD 1 TO RECORDS-IN-ERROR. IX1094.2 +100000 GO TO REA-TEST-F1-04-0. IX1094.2 +100100 REA-TEST-F1-04-1. IX1094.2 +100200******************************************************************IX1094.2 +100300* TEST 11 *IX1094.2 +100400* READ ... AT END 00 EXPECTED *IX1094.2 +100500* IX-3, 1.3.4 (1) A *IX1094.2 +100600******************************************************************IX1094.2 +100700 MOVE "REA-TEST-F1-04-0" TO PAR-NAME. IX1094.2 +100800 MOVE "READ...END: 00 EXP." TO FEATURE. IX1094.2 +100900 IF STATUS-TEST-READ = 0 IX1094.2 +101000 GO TO REA-PASS-F1-04-0. IX1094.2 +101100 REA-FAIL-F1-04-0. IX1094.2 +101200 MOVE "I-O STATUS IS NOT 00" TO COMPUTED-A. IX1094.2 +101300 MOVE "00" TO CORRECT-X. IX1094.2 +101400 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1094.2 +101500 PERFORM FAIL. IX1094.2 +101600 GO TO REA-WRITE-F1-04-0. IX1094.2 +101700 REA-PASS-F1-04-0. IX1094.2 +101800 PERFORM PASS. IX1094.2 +101900 REA-WRITE-F1-04-0. IX1094.2 +102000 PERFORM PRINT-DETAIL. IX1094.2 +102100* IX1094.2 +102200 REA-TEST-F1-05-0. IX1094.2 +102300******************************************************************IX1094.2 +102400* TEST 12 *IX1094.2 +102500* READ ... AT END 10 EXPECTED *IX1094.2 +102600* IX-4, 1.3.4 (2) A 1) *IX1094.2 +102700******************************************************************IX1094.2 +102800 IF IX-FS3-STATUS EQUAL TO "10" IX1094.2 +102900 GO TO REA-PASS-F1-05-0. IX1094.2 +103000 REA-FAIL-F1-05-0. IX1094.2 +103100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +103200 MOVE "10" TO CORRECT-X. IX1094.2 +103300 MOVE "IX-4, 1.3.4, (2) A 1)" TO RE-MARK. IX1094.2 +103400 PERFORM FAIL. IX1094.2 +103500 GO TO REA-WRITE-F1-05-0. IX1094.2 +103600 REA-PASS-F1-05-0. IX1094.2 +103700 PERFORM PASS. IX1094.2 +103800 REA-WRITE-F1-05-0. IX1094.2 +103900 MOVE "READ...END: 10 EXP." TO FEATURE. IX1094.2 +104000 MOVE "REA-TEST-F1-05-0" TO PAR-NAME. IX1094.2 +104100 PERFORM PRINT-DETAIL. IX1094.2 +104200******************************************************************IX1094.2 +104300* TEST 13 *IX1094.2 +104400* READ ... (AFTER AT END) 46 EXPECTED *IX1094.2 +104500* IX-5, 1.3.4 (5) E 3) *IX1094.2 +104600******************************************************************IX1094.2 +104700 REA-TEST-F1-06-0. IX1094.2 +104800 MOVE 13 TO TEST-NO. IX1094.2 +104900 READ IX-FS3 AT END GO TO REA-TEST-F1-06-1. IX1094.2 +105000 REA-TEST-F1-06-1. IX1094.2 +105100 IF IX-FS3-STATUS EQUAL TO "46" IX1094.2 +105200 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1094.2 +105300 TO RE-MARK IX1094.2 +105400 GO TO REA-WRITE-F1-06-0. IX1094.2 +105500 REA-FAIL-F1-06-0. IX1094.2 +105600 MOVE "IX-5, 1.3.4, (5) E 3)" TO RE-MARK. IX1094.2 +105700 REA-WRITE-F1-06-0. IX1094.2 +105800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1094.2 +105900 MOVE "46" TO CORRECT-X. IX1094.2 +106000 PERFORM FAIL. IX1094.2 +106100 MOVE "READ. 46 EXP." TO FEATURE. IX1094.2 +106200 MOVE "REA-TEST-F1-06-0" TO PAR-NAME. IX1094.2 +106300 PERFORM PRINT-DETAIL. IX1094.2 +106400 CLOSE IX-FS3. IX1094.2 +106500 IX1094.2 +106600 TERMINATE-ROUTINE. IX1094.2 +106700 EXIT. IX1094.2 +106800 IX1094.2 +106900 CCVS-EXIT SECTION. IX1094.2 +107000 CCVS-999999. IX1094.2 +107100 GO TO CLOSE-FILES. IX1094.2 diff --git a/tests/cobol85/IX/IX110A.SUB b/tests/cobol85/IX/IX110A.SUB new file mode 100755 index 00000000..2109eeb9 --- /dev/null +++ b/tests/cobol85/IX/IX110A.SUB @@ -0,0 +1,620 @@ +000100 IDENTIFICATION DIVISION. IX1104.2 +000200 PROGRAM-ID. IX1104.2 +000300 IX110A. IX1104.2 +000400**************************************************************** IX1104.2 +000500* * IX1104.2 +000600* VALIDATION FOR:- * IX1104.2 +000700* * IX1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1104.2 +000900* * IX1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1104.2 +001100* * IX1104.2 +001200**************************************************************** IX1104.2 +001300* IX1104.2 +001400* 1. THE ROUTINE USES THE FILE IX-FS3 WHICH HAS BEEN CREATED IX1104.2 +001500* BY IX109. THIS FILE IS OPENED IN I-O MODE. IX1104.2 +001600 IX1104.2 +001700* 2. THE ROUTINE CHECKS THE FILE STATUS CODES: IX1104.2 +001800* 00 - AFTER OPEN I-O IX1104.2 +001900* 22 - AFTER WRITE (DUPLIACATE PRIMARY RECORD KEY) IX1104.2 +002000* 00 OR 22 - AFTER REWRITE (DUPLIACATE PRIMARY RECORD KEY) IX1104.2 +002100* 23 - AFTER READ (A NOT EXISTING RECORD KEY) IX1104.2 +002200 IX1104.2 +002300* 3. X-CARDS USED IN THIS PROGRAM (WITH THE OPT CODE): IX1104.2 +002400* IX1104.2 +002500* XXXXX024 IX1104.2 +002600* XXXXX055. IX1104.2 +002700* P XXXXX062. IX1104.2 +002800* XXXXX082. IX1104.2 +002900* XXXXX083. IX1104.2 +003000* XXXXX084 IX1104.2 +003100* IX1104.2 +003200* IX1104.2 +003300 ENVIRONMENT DIVISION. IX1104.2 +003400 CONFIGURATION SECTION. IX1104.2 +003500 SOURCE-COMPUTER. IX1104.2 +003600 Linux. IX1104.2 +003700 OBJECT-COMPUTER. IX1104.2 +003800 Linux. IX1104.2 +003900 INPUT-OUTPUT SECTION. IX1104.2 +004000 FILE-CONTROL. IX1104.2 +004100*P SELECT RAW-DATA ASSIGN TO IX1104.2 +004200*P "XXXXX062" IX1104.2 +004300*P ORGANIZATION IS INDEXED IX1104.2 +004400*P ACCESS MODE IS RANDOM IX1104.2 +004500*P RECORD KEY IS RAW-DATA-KEY. IX1104.2 +004600* IX1104.2 +004700 SELECT PRINT-FILE ASSIGN TO IX1104.2 +004800 "report.log". IX1104.2 +004900* IX1104.2 +005000 SELECT IX-FS3 ASSIGN IX1104.2 +005100 "XXXXX024" IX1104.2 +005200 ORGANIZATION IS INDEXED IX1104.2 +005300 ACCESS MODE IS RANDOM IX1104.2 +005400 RECORD KEY IS IX-FS3-KEY IX1104.2 +005500 FILE STATUS IS IX-FS3-STATUS. IX1104.2 +005600 IX1104.2 +005700 DATA DIVISION. IX1104.2 +005800 IX1104.2 +005900 FILE SECTION. IX1104.2 +006000*P IX1104.2 +006100*PD RAW-DATA. IX1104.2 +006200*P IX1104.2 +006300*P1 RAW-DATA-SATZ. IX1104.2 +006400*P 05 RAW-DATA-KEY PIC X(6). IX1104.2 +006500*P 05 C-DATE PIC 9(6). IX1104.2 +006600*P 05 C-TIME PIC 9(8). IX1104.2 +006700*P 05 C-NO-OF-TESTS PIC 99. IX1104.2 +006800*P 05 C-OK PIC 999. IX1104.2 +006900*P 05 C-ALL PIC 999. IX1104.2 +007000*P 05 C-FAIL PIC 999. IX1104.2 +007100*P 05 C-DELETED PIC 999. IX1104.2 +007200*P 05 C-INSPECT PIC 999. IX1104.2 +007300*P 05 C-NOTE PIC X(13). IX1104.2 +007400*P 05 C-INDENT PIC X. IX1104.2 +007500*P 05 C-ABORT PIC X(8). IX1104.2 +007600 IX1104.2 +007700 FD PRINT-FILE. IX1104.2 +007800 IX1104.2 +007900 01 PRINT-REC PIC X(120). IX1104.2 +008000 IX1104.2 +008100 01 DUMMY-RECORD PIC X(120). IX1104.2 +008200 IX1104.2 +008300 FD IX-FS3 IX1104.2 +008400*C DATA RECORDS IX-FS3R1-F-G-240 IX1104.2 +008500*C LABEL RECORD STANDARD IX1104.2 +008600 RECORD 240 IX1104.2 +008700 BLOCK CONTAINS 2 RECORDS. IX1104.2 +008800 IX1104.2 +008900 01 IX-FS3R1-F-G-240. IX1104.2 +009000 05 IX-FS3-REC-120 PIC X(120). IX1104.2 +009100 05 IX-FS3-REC-120-240. IX1104.2 +009200 10 FILLER PIC X(8). IX1104.2 +009300 10 IX-FS3-KEY PIC X(29). IX1104.2 +009400 10 FILLER PIC X(9). IX1104.2 +009500 10 IX-FS3-ALTER-KEY PIC X(29). IX1104.2 +009600 10 FILLER PIC X(45). IX1104.2 +009700 IX1104.2 +009800 IX1104.2 +009900 WORKING-STORAGE SECTION. IX1104.2 +010000 IX1104.2 +010100 01 GRP-0101. IX1104.2 +010200 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1104.2 +010300 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1104.2 +010400 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1104.2 +010500 IX1104.2 +010600 01 GRP-0102. IX1104.2 +010700 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1104.2 +010800 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1104.2 +010900 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1104.2 +011000 IX1104.2 +011100 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1104.2 +011200 IX1104.2 +011300 01 EOF-FLAG PIC 9 VALUE ZERO. IX1104.2 +011400 IX1104.2 +011500 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1104.2 +011600 IX1104.2 +011700 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1104.2 +011800 IX1104.2 +011900 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1104.2 +012000 IX1104.2 +012100 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1104.2 +012200 IX1104.2 +rogerw 01 STATUS-TEST-10 PIC 9 VALUE ZERO. +012300 IX1104.2 +012400 01 IX-FS3-STATUS. IX1104.2 +012500 05 IX-FS3-STAT1 PIC X. IX1104.2 +012600 05 IX-FS3-STAT2 PIC X. IX1104.2 +012700 IX1104.2 +012800 01 COUNT-OF-RECS PIC 9(5). IX1104.2 +012900 IX1104.2 +013000 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1104.2 +013100 IX1104.2 +013200 01 FILE-RECORD-INFORMATION-REC. IX1104.2 +013300 05 FILE-RECORD-INFO-SKELETON. IX1104.2 +013400 10 FILLER PIC X(48) VALUE IX1104.2 +013500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1104.2 +013600 10 FILLER PIC X(46) VALUE IX1104.2 +013700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1104.2 +013800 10 FILLER PIC X(26) VALUE IX1104.2 +013900 ",LFIL=000000,ORG= ,LBLR= ". IX1104.2 +014000 10 FILLER PIC X(37) VALUE IX1104.2 +014100 ",RECKEY= ". IX1104.2 +014200 10 FILLER PIC X(38) VALUE IX1104.2 +014300 ",ALTKEY1= ". IX1104.2 +014400 10 FILLER PIC X(38) VALUE IX1104.2 +014500 ",ALTKEY2= ". IX1104.2 +014600 10 FILLER PIC X(7) VALUE SPACE. IX1104.2 +014700 05 FILE-RECORD-INFO OCCURS 10. IX1104.2 +014800 10 FILE-RECORD-INFO-P1-120. IX1104.2 +014900 15 FILLER PIC X(5). IX1104.2 +015000 15 XFILE-NAME PIC X(6). IX1104.2 +015100 15 FILLER PIC X(8). IX1104.2 +015200 15 XRECORD-NAME PIC X(6). IX1104.2 +015300 15 FILLER PIC X(1). IX1104.2 +015400 15 REELUNIT-NUMBER PIC 9(1). IX1104.2 +015500 15 FILLER PIC X(7). IX1104.2 +015600 15 XRECORD-NUMBER PIC 9(6). IX1104.2 +015700 15 FILLER PIC X(6). IX1104.2 +015800 15 UPDATE-NUMBER PIC 9(2). IX1104.2 +015900 15 FILLER PIC X(5). IX1104.2 +016000 15 ODO-NUMBER PIC 9(4). IX1104.2 +016100 15 FILLER PIC X(5). IX1104.2 +016200 15 XPROGRAM-NAME PIC X(5). IX1104.2 +016300 15 FILLER PIC X(7). IX1104.2 +016400 15 XRECORD-LENGTH PIC 9(6). IX1104.2 +016500 15 FILLER PIC X(7). IX1104.2 +016600 15 CHARS-OR-RECORDS PIC X(2). IX1104.2 +016700 15 FILLER PIC X(1). IX1104.2 +016800 15 XBLOCK-SIZE PIC 9(4). IX1104.2 +016900 15 FILLER PIC X(6). IX1104.2 +017000 15 RECORDS-IN-FILE PIC 9(6). IX1104.2 +017100 15 FILLER PIC X(5). IX1104.2 +017200 15 XFILE-ORGANIZATION PIC X(2). IX1104.2 +017300 15 FILLER PIC X(6). IX1104.2 +017400 15 XLABEL-TYPE PIC X(1). IX1104.2 +017500 10 FILE-RECORD-INFO-P121-240. IX1104.2 +017600 15 FILLER PIC X(8). IX1104.2 +017700 15 XRECORD-KEY PIC X(29). IX1104.2 +017800 15 FILLER PIC X(9). IX1104.2 +017900 15 ALTERNATE-KEY1 PIC X(29). IX1104.2 +018000 15 FILLER PIC X(9). IX1104.2 +018100 15 ALTERNATE-KEY2 PIC X(29). IX1104.2 +018200 15 FILLER PIC X(7). IX1104.2 +018300 IX1104.2 +018400 01 TEST-RESULTS. IX1104.2 +018500 02 FILLER PIC X VALUE SPACE. IX1104.2 +018600 02 FEATURE PIC X(20) VALUE SPACE. IX1104.2 +018700 02 FILLER PIC X VALUE SPACE. IX1104.2 +018800 02 P-OR-F PIC X(5) VALUE SPACE. IX1104.2 +018900 02 FILLER PIC X VALUE SPACE. IX1104.2 +019000 02 PAR-NAME. IX1104.2 +019100 03 FILLER PIC X(19) VALUE SPACE. IX1104.2 +019200 03 PARDOT-X PIC X VALUE SPACE. IX1104.2 +019300 03 DOTVALUE PIC 99 VALUE ZERO. IX1104.2 +019400 02 FILLER PIC X(8) VALUE SPACE. IX1104.2 +019500 02 RE-MARK PIC X(61). IX1104.2 +019600 01 TEST-COMPUTED. IX1104.2 +019700 02 FILLER PIC X(30) VALUE SPACE. IX1104.2 +019800 02 FILLER PIC X(17) VALUE IX1104.2 +019900 " COMPUTED=". IX1104.2 +020000 02 COMPUTED-X. IX1104.2 +020100 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1104.2 +020200 03 COMPUTED-N REDEFINES COMPUTED-A IX1104.2 +020300 PIC -9(9).9(9). IX1104.2 +020400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1104.2 +020500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1104.2 +020600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1104.2 +020700 03 CM-18V0 REDEFINES COMPUTED-A. IX1104.2 +020800 04 COMPUTED-18V0 PIC -9(18). IX1104.2 +020900 04 FILLER PIC X. IX1104.2 +021000 03 FILLER PIC X(50) VALUE SPACE. IX1104.2 +021100 01 TEST-CORRECT. IX1104.2 +021200 02 FILLER PIC X(30) VALUE SPACE. IX1104.2 +021300 02 FILLER PIC X(17) VALUE " CORRECT =". IX1104.2 +021400 02 CORRECT-X. IX1104.2 +021500 03 CORRECT-A PIC X(20) VALUE SPACE. IX1104.2 +021600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1104.2 +021700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1104.2 +021800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1104.2 +021900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1104.2 +022000 03 CR-18V0 REDEFINES CORRECT-A. IX1104.2 +022100 04 CORRECT-18V0 PIC -9(18). IX1104.2 +022200 04 FILLER PIC X. IX1104.2 +022300 03 FILLER PIC X(2) VALUE SPACE. IX1104.2 +022400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1104.2 +022500 01 CCVS-C-1. IX1104.2 +022600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1104.2 +022700- "SS PARAGRAPH-NAME IX1104.2 +022800- " REMARKS". IX1104.2 +022900 02 FILLER PIC X(20) VALUE SPACE. IX1104.2 +023000 01 CCVS-C-2. IX1104.2 +023100 02 FILLER PIC X VALUE SPACE. IX1104.2 +023200 02 FILLER PIC X(6) VALUE "TESTED". IX1104.2 +023300 02 FILLER PIC X(15) VALUE SPACE. IX1104.2 +023400 02 FILLER PIC X(4) VALUE "FAIL". IX1104.2 +023500 02 FILLER PIC X(94) VALUE SPACE. IX1104.2 +023600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1104.2 +023700 01 REC-CT PIC 99 VALUE ZERO. IX1104.2 +023800 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1104.2 +023900 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1104.2 +024000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1104.2 +024100 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1104.2 +024200 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1104.2 +024300 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1104.2 +024400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1104.2 +024500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1104.2 +024600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1104.2 +024700 01 CCVS-H-1. IX1104.2 +024800 02 FILLER PIC X(39) VALUE SPACES. IX1104.2 +024900 02 FILLER PIC X(42) VALUE IX1104.2 +025000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1104.2 +025100 02 FILLER PIC X(39) VALUE SPACES. IX1104.2 +025200 01 CCVS-H-2A. IX1104.2 +025300 02 FILLER PIC X(40) VALUE SPACE. IX1104.2 +025400 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1104.2 +025500 02 FILLER PIC XXXX VALUE IX1104.2 +025600 "4.2 ". IX1104.2 +025700 02 FILLER PIC X(28) VALUE IX1104.2 +025800 " COPY - NOT FOR DISTRIBUTION". IX1104.2 +025900 02 FILLER PIC X(41) VALUE SPACE. IX1104.2 +026000 IX1104.2 +026100 01 CCVS-H-2B. IX1104.2 +026200 02 FILLER PIC X(15) VALUE IX1104.2 +026300 "TEST RESULT OF ". IX1104.2 +026400 02 TEST-ID PIC X(9). IX1104.2 +026500 02 FILLER PIC X(4) VALUE IX1104.2 +026600 " IN ". IX1104.2 +026700 02 FILLER PIC X(12) VALUE IX1104.2 +026800 " HIGH ". IX1104.2 +026900 02 FILLER PIC X(22) VALUE IX1104.2 +027000 " LEVEL VALIDATION FOR ". IX1104.2 +027100 02 FILLER PIC X(58) VALUE IX1104.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1104.2 +027300 01 CCVS-H-3. IX1104.2 +027400 02 FILLER PIC X(34) VALUE IX1104.2 +027500 " FOR OFFICIAL USE ONLY ". IX1104.2 +027600 02 FILLER PIC X(58) VALUE IX1104.2 +027700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1104.2 +027800 02 FILLER PIC X(28) VALUE IX1104.2 +027900 " COPYRIGHT 1985 ". IX1104.2 +028000 01 CCVS-E-1. IX1104.2 +028100 02 FILLER PIC X(52) VALUE SPACE. IX1104.2 +028200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1104.2 +028300 02 ID-AGAIN PIC X(9). IX1104.2 +028400 02 FILLER PIC X(45) VALUE SPACES. IX1104.2 +028500 01 CCVS-E-2. IX1104.2 +028600 02 FILLER PIC X(31) VALUE SPACE. IX1104.2 +028700 02 FILLER PIC X(21) VALUE SPACE. IX1104.2 +028800 02 CCVS-E-2-2. IX1104.2 +028900 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1104.2 +029000 03 FILLER PIC X VALUE SPACE. IX1104.2 +029100 03 ENDER-DESC PIC X(44) VALUE IX1104.2 +029200 "ERRORS ENCOUNTERED". IX1104.2 +029300 01 CCVS-E-3. IX1104.2 +029400 02 FILLER PIC X(22) VALUE IX1104.2 +029500 " FOR OFFICIAL USE ONLY". IX1104.2 +029600 02 FILLER PIC X(12) VALUE SPACE. IX1104.2 +029700 02 FILLER PIC X(58) VALUE IX1104.2 +029800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1104.2 +029900 02 FILLER PIC X(13) VALUE SPACE. IX1104.2 +030000 02 FILLER PIC X(15) VALUE IX1104.2 +030100 " COPYRIGHT 1985". IX1104.2 +030200 01 CCVS-E-4. IX1104.2 +030300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1104.2 +030400 02 FILLER PIC X(4) VALUE " OF ". IX1104.2 +030500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1104.2 +030600 02 FILLER PIC X(40) VALUE IX1104.2 +030700 " TESTS WERE EXECUTED SUCCESSFULLY". IX1104.2 +030800 01 XXINFO. IX1104.2 +030900 02 FILLER PIC X(19) VALUE IX1104.2 +031000 "*** INFORMATION ***". IX1104.2 +031100 02 INFO-TEXT. IX1104.2 +031200 04 FILLER PIC X(8) VALUE SPACE. IX1104.2 +031300 04 XXCOMPUTED PIC X(20). IX1104.2 +031400 04 FILLER PIC X(5) VALUE SPACE. IX1104.2 +031500 04 XXCORRECT PIC X(20). IX1104.2 +031600 02 INF-ANSI-REFERENCE PIC X(48). IX1104.2 +031700 01 HYPHEN-LINE. IX1104.2 +031800 02 FILLER PIC IS X VALUE IS SPACE. IX1104.2 +031900 02 FILLER PIC IS X(65) VALUE IS "************************IX1104.2 +032000- "*****************************************". IX1104.2 +032100 02 FILLER PIC IS X(54) VALUE IS "************************IX1104.2 +032200- "******************************". IX1104.2 +032300 01 CCVS-PGM-ID PIC X(9) VALUE IX1104.2 +032400 "IX110A". IX1104.2 +032500 PROCEDURE DIVISION. IX1104.2 +032600 DECLARATIVES. IX1104.2 +032700 IX1104.2 +032800 SECT-IX110-0002 SECTION. IX1104.2 +032900 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1104.2 +033000 INPUT-PROCESS. IX1104.2 +033100 IF STATUS-TEST-10 EQUAL TO 1 IX1104.2 +033200 GO TO FINAL-CHECK IX1104.2 +033300 ELSE IX1104.2 +033400 GO TO DECL-EXIT. IX1104.2 +033500 FINAL-CHECK. IX1104.2 +033600 IF IX-FS3-STAT1 EQUAL TO "1" IX1104.2 +033700 MOVE 1 TO EOF-FLAG. IX1104.2 +033800 IF IX1104.2 +033900 IX-FS3-STAT1 GREATER THAN "1" IX1104.2 +034000 MOVE 1 TO PERM-ERRORS. IX1104.2 +034100 DECL-EXIT. IX1104.2 +034200 END DECLARATIVES. IX1104.2 +034300 IX1104.2 +034400 IX1104.2 +034500 CCVS1 SECTION. IX1104.2 +034600 OPEN-FILES. IX1104.2 +034700*P OPEN I-O RAW-DATA. IX1104.2 +034800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1104.2 +034900*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1104.2 +035000*P MOVE "ABORTED " TO C-ABORT. IX1104.2 +035100*P ADD 1 TO C-NO-OF-TESTS. IX1104.2 +035200*P ACCEPT C-DATE FROM DATE. IX1104.2 +035300*P ACCEPT C-TIME FROM TIME. IX1104.2 +035400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1104.2 +035500*PND-E-1. IX1104.2 +035600*P CLOSE RAW-DATA. IX1104.2 +035700 OPEN OUTPUT PRINT-FILE. IX1104.2 +035800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1104.2 +035900 MOVE SPACE TO TEST-RESULTS. IX1104.2 +036000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1104.2 +036100 MOVE ZERO TO REC-SKL-SUB. IX1104.2 +036200 PERFORM CCVS-INIT-FILE 9 TIMES. IX1104.2 +036300 CCVS-INIT-FILE. IX1104.2 +036400 ADD 1 TO REC-SKL-SUB. IX1104.2 +036500 MOVE FILE-RECORD-INFO-SKELETON IX1104.2 +036600 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1104.2 +036700 CCVS-INIT-EXIT. IX1104.2 +036800 GO TO CCVS1-EXIT. IX1104.2 +036900 CLOSE-FILES. IX1104.2 +037000*P OPEN I-O RAW-DATA. IX1104.2 +037100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1104.2 +037200*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1104.2 +037300*P MOVE "OK. " TO C-ABORT. IX1104.2 +037400*P MOVE PASS-COUNTER TO C-OK. IX1104.2 +037500*P MOVE ERROR-HOLD TO C-ALL. IX1104.2 +037600*P MOVE ERROR-COUNTER TO C-FAIL. IX1104.2 +037700*P MOVE DELETE-COUNTER TO C-DELETED. IX1104.2 +037800*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1104.2 +037900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1104.2 +038000*PND-E-2. IX1104.2 +038100*P CLOSE RAW-DATA. IX1104.2 +038200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1104.2 +038300 TERMINATE-CCVS. IX1104.2 +038400*S EXIT PROGRAM. IX1104.2 +038500*SERMINATE-CALL. IX1104.2 +038600 STOP RUN. IX1104.2 +038700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1104.2 +038800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1104.2 +038900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1104.2 +039000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1104.2 +039100 MOVE "****TEST DELETED****" TO RE-MARK. IX1104.2 +039200 PRINT-DETAIL. IX1104.2 +039300 IF REC-CT NOT EQUAL TO ZERO IX1104.2 +039400 MOVE "." TO PARDOT-X IX1104.2 +039500 MOVE REC-CT TO DOTVALUE. IX1104.2 +039600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1104.2 +039700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1104.2 +039800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1104.2 +039900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1104.2 +040000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1104.2 +040100 MOVE SPACE TO CORRECT-X. IX1104.2 +040200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1104.2 +040300 MOVE SPACE TO RE-MARK. IX1104.2 +040400 HEAD-ROUTINE. IX1104.2 +040500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +040600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +040700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1104.2 +040800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1104.2 +040900 COLUMN-NAMES-ROUTINE. IX1104.2 +041000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +041100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +041200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +041300 END-ROUTINE. IX1104.2 +041400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1104.2 +041500 END-RTN-EXIT. IX1104.2 +041600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +041700 END-ROUTINE-1. IX1104.2 +041800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1104.2 +041900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1104.2 +042000 ADD PASS-COUNTER TO ERROR-HOLD. IX1104.2 +042100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1104.2 +042200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1104.2 +042300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1104.2 +042400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1104.2 +042500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1104.2 +042600 END-ROUTINE-12. IX1104.2 +042700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1104.2 +042800 IF ERROR-COUNTER IS EQUAL TO ZERO IX1104.2 +042900 MOVE "NO " TO ERROR-TOTAL IX1104.2 +043000 ELSE IX1104.2 +043100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1104.2 +043200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1104.2 +043300 PERFORM WRITE-LINE. IX1104.2 +043400 END-ROUTINE-13. IX1104.2 +043500 IF DELETE-COUNTER IS EQUAL TO ZERO IX1104.2 +043600 MOVE "NO " TO ERROR-TOTAL ELSE IX1104.2 +043700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1104.2 +043800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1104.2 +043900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +044000 IF INSPECT-COUNTER EQUAL TO ZERO IX1104.2 +044100 MOVE "NO " TO ERROR-TOTAL IX1104.2 +044200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1104.2 +044300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1104.2 +044400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +044500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1104.2 +044600 WRITE-LINE. IX1104.2 +044700 ADD 1 TO RECORD-COUNT. IX1104.2 +044800 IF RECORD-COUNT GREATER 42 IX1104.2 +044900 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1104.2 +045000 MOVE SPACE TO DUMMY-RECORD IX1104.2 +045100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1104.2 +045200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1104.2 +045300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1104.2 +045400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1104.2 +045500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1104.2 +045600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1104.2 +045700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1104.2 +045800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1104.2 +045900 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1104.2 +046000 MOVE ZERO TO RECORD-COUNT. IX1104.2 +046100 PERFORM WRT-LN. IX1104.2 +046200 WRT-LN. IX1104.2 +046300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1104.2 +046400 MOVE SPACE TO DUMMY-RECORD. IX1104.2 +046500 BLANK-LINE-PRINT. IX1104.2 +046600 PERFORM WRT-LN. IX1104.2 +046700 FAIL-ROUTINE. IX1104.2 +046800 IF COMPUTED-X NOT EQUAL TO SPACE IX1104.2 +046900 GO TO FAIL-ROUTINE-WRITE. IX1104.2 +047000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1104.2 +047100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1104.2 +047200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1104.2 +047300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +047400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1104.2 +047500 GO TO FAIL-ROUTINE-EX. IX1104.2 +047600 FAIL-ROUTINE-WRITE. IX1104.2 +047700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1104.2 +047800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1104.2 +047900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1104.2 +048000 MOVE SPACES TO COR-ANSI-REFERENCE. IX1104.2 +048100 FAIL-ROUTINE-EX. EXIT. IX1104.2 +048200 BAIL-OUT. IX1104.2 +048300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1104.2 +048400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1104.2 +048500 BAIL-OUT-WRITE. IX1104.2 +048600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1104.2 +048700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1104.2 +048800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1104.2 +048900 MOVE SPACES TO INF-ANSI-REFERENCE. IX1104.2 +049000 BAIL-OUT-EX. EXIT. IX1104.2 +049100 CCVS1-EXIT. IX1104.2 +049200 EXIT. IX1104.2 +049300 IX1104.2 +049400 SECT-IX110A-0003 SECTION. IX1104.2 +049500 SEQ-INIT-010. IX1104.2 +049600 IX1104.2 +049700******************************************************************IX1104.2 +049800* TEST 1 *IX1104.2 +049900* OPEN I-O 00 EXPECTED *IX1104.2 +050000* IX-3, 1.3.4 (1) a *IX1104.2 +050100* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1104.2 +050200* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1104.2 +050300******************************************************************IX1104.2 +050400 OPN-INIT-GF-01-0. IX1104.2 +050500 MOVE 1 TO STATUS-TEST-00. IX1104.2 +050600 MOVE SPACES TO IX-FS3-STATUS. IX1104.2 +050700 MOVE "OPEN I-O: 00 EXP." TO FEATURE. IX1104.2 +050800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1104.2 +050900 OPEN IX1104.2 +051000 I-O IX-FS3. IX1104.2 +051100 IF IX-FS3-STATUS EQUAL TO "00" IX1104.2 +051200 GO TO OPN-PASS-GF-01-0. IX1104.2 +051300 OPN-FAIL-GF-01-0. IX1104.2 +051400 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1104.2 +051500 PERFORM FAIL. IX1104.2 +051600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1104.2 +051700 MOVE "00" TO CORRECT-X. IX1104.2 +051800 GO TO OPN-WRITE-GF-01-0. IX1104.2 +051900 OPN-PASS-GF-01-0. IX1104.2 +052000 PERFORM PASS. IX1104.2 +052100 OPN-WRITE-GF-01-0. IX1104.2 +052200 PERFORM PRINT-DETAIL. IX1104.2 +052300 IX1104.2 +052400******************************************************************IX1104.2 +052500* TEST 2 *IX1104.2 +052600* WRITE (DUPLICATE PRIME RECORD KEY) 22 EXPECTED *IX1104.2 +052700* IX-4, 1.3.4 (3) b *IX1104.2 +052800*EXISTING KEYS: FROM 000000001 TO 000000050; WRITE: 000000010 *IX1104.2 +052900******************************************************************IX1104.2 +053000 WRI-INIT-GF-01-0. IX1104.2 +053100 MOVE SPACES TO IX-FS3-STATUS. IX1104.2 +053200 MOVE 0 TO STATUS-TEST-00. IX1104.2 +053300 MOVE "WRITE: (DUP) 22 EXP." TO FEATURE. IX1104.2 +053400 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1104.2 +053500 WRI-TEST-GF-01-0. IX1104.2 +053600 MOVE SPACES TO IX-FS3-REC-120-240. IX1104.2 +053700 MOVE "RECORD-KEY000000010END-OF-KEY" TO IX-FS3-KEY. IX1104.2 +053800 WRITE IX-FS3R1-F-G-240. IX1104.2 +053900 IF IX-FS3-STATUS = "22" IX1104.2 +054000 MOVE 1 TO STATUS-TEST-00 IX1104.2 +054100 GO TO WRI-PASS-GF-01-0. IX1104.2 +054200 WRI-FAIL-GF-01-0. IX1104.2 +054300 MOVE "IX-4, 1.3.4, (3) b. " TO RE-MARK. IX1104.2 +054400 PERFORM FAIL. IX1104.2 +054500 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1104.2 +054600 MOVE "22" TO CORRECT-X. IX1104.2 +054700 GO TO WRI-WRITE-GF-01-0. IX1104.2 +054800 WRI-PASS-GF-01-0. IX1104.2 +054900 PERFORM PASS. IX1104.2 +055000 WRI-WRITE-GF-01-0. IX1104.2 +055100 PERFORM PRINT-DETAIL. IX1104.2 +055200 IX1104.2 +055300******************************************************************IX1104.2 +055400* TEST 3 *IX1104.2 +055500* REWRITE (DUPLICATE PRIMARY RECORD KEY) 22 EXPECTED *IX1104.2 +055600* IX-4, 1.3.4 (3) b *IX1104.2 +055700* KEY: 000000049 *IX1104.2 +055800******************************************************************IX1104.2 +055900 RWR-INIT-GF-01-0. IX1104.2 +056000 MOVE SPACES TO IX-FS3-STATUS. IX1104.2 +056100 MOVE ZERO TO STATUS-TEST-00. IX1104.2 +056200 MOVE "REWRITE:00 / 22 EXP." TO FEATURE. IX1104.2 +056300 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1104.2 +056400 MOVE "RECORD-KEY000000049END-OF-KEY" TO IX-FS3-KEY. IX1104.2 +056500 RWR-TEST-GF-01-0. IX1104.2 +056600 READ IX-FS3 INVALID KEY GO TO RWR-TEST-GF-01-1. IX1104.2 +056700 MOVE SPACES TO IX-FS3-REC-120-240. IX1104.2 +056800 MOVE "RECORD-KEY000000039END-OF-KEY" TO IX-FS3-KEY. IX1104.2 +056900 REWRITE IX-FS3R1-F-G-240 INVALID KEY GO TO RWR-TEST-GF-01-1. IX1104.2 +057000 RWR-TEST-GF-01-1. IX1104.2 +057100 IF IX-FS3-STATUS = "00" IX1104.2 +057200 GO TO RWR-PASS-GF-01-0. IX1104.2 +057300 IF IX-FS3-STATUS = "22" IX1104.2 +057400 GO TO RWR-PASS-GF-01-0. IX1104.2 +057500 RWR-FAIL-GF-01-0. IX1104.2 +057600 MOVE "IX-4, 1.3.4, (3) b. " TO RE-MARK. IX1104.2 +057700 PERFORM FAIL. IX1104.2 +057800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1104.2 +057900 MOVE "00 OR 22" TO CORRECT-X. IX1104.2 +058000 GO TO RWR-WRITE-GF-01-0. IX1104.2 +058100 RWR-PASS-GF-01-0. IX1104.2 +058200 PERFORM PASS. IX1104.2 +058300 RWR-WRITE-GF-01-0. IX1104.2 +058400 PERFORM PRINT-DETAIL. IX1104.2 +058500 IX1104.2 +058600******************************************************************IX1104.2 +058700* TEST 4 *IX1104.2 +058800* READ (A RECORD THAT DOES NOT EXIST) 23 EXPECTED *IX1104.2 +058900* IX-4, 1.3.4 (3) c 1) KEY: 000000100 *IX1104.2 +059000******************************************************************IX1104.2 +059100 REA-INIT-GF-01-0. IX1104.2 +059200 MOVE SPACES TO IX-FS3-STATUS. IX1104.2 +059300 MOVE "READ: 23 EXP." TO FEATURE. IX1104.2 +059400 MOVE "REA-TEST-GF-01-0" TO PAR-NAME. IX1104.2 +059500 REA-TEST-GF-01-0. IX1104.2 +059600 MOVE "RECORD-KEY000000100END-OF-KEY" TO IX-FS3-KEY. IX1104.2 +059700 READ IX-FS3 INVALID KEY GO TO REA-TEST-GF-01-1. IX1104.2 +059800 REA-TEST-GF-01-1. IX1104.2 +059900 IF IX-FS3-STATUS = "23" IX1104.2 +060000 GO TO REA-PASS-GF-01-0. IX1104.2 +060100 REA-FAIL-GF-01-0. IX1104.2 +060200 MOVE "IX-3, 1.3.4, (3) c 1)" TO RE-MARK. IX1104.2 +060300 PERFORM FAIL. IX1104.2 +060400 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1104.2 +060500 MOVE "23" TO CORRECT-X. IX1104.2 +060600 GO TO REA-WRITE-GF-01-0. IX1104.2 +060700 REA-PASS-GF-01-0. IX1104.2 +060800 PERFORM PASS. IX1104.2 +060900 REA-WRITE-GF-01-0. IX1104.2 +061000 PERFORM PRINT-DETAIL. IX1104.2 +061100 IX1104.2 +061200 CLOSE IX-FS3. IX1104.2 +061300 IX1104.2 +061400 TERMINATE-ROUTINE. IX1104.2 +061500 EXIT. IX1104.2 +061600 IX1104.2 +061700 CCVS-EXIT SECTION. IX1104.2 +061800 CCVS-999999. IX1104.2 +061900 GO TO CLOSE-FILES. IX1104.2 diff --git a/tests/cobol85/IX/IX111A.SUB b/tests/cobol85/IX/IX111A.SUB new file mode 100755 index 00000000..87594f30 --- /dev/null +++ b/tests/cobol85/IX/IX111A.SUB @@ -0,0 +1,444 @@ +000100 IDENTIFICATION DIVISION. IX1114.2 +000200 PROGRAM-ID. IX1114.2 +000300 IX111A. IX1114.2 +000400**************************************************************** IX1114.2 +000500* * IX1114.2 +000600* VALIDATION FOR:- * IX1114.2 +000700* * IX1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1114.2 +000900* * IX1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1114.2 +001100* * IX1114.2 +001200**************************************************************** IX1114.2 +001300* IX1114.2 +001400* 1. THE ROUTINE CHECKS THE PERMANENT ERROR CONDITIONS WITH IX1114.2 +001500* UNSUCCESSFUL COMPLETION FOR AN OPEN STATEMENT FOR A FILE IX1114.2 +001600* WHICH IS NOT PRESENT (STATUS CODE 35 EXPECTED). IX1114.2 +001700* THIS PROGRAM USES THE FILE IX-NOP WHICH DOES NOT EXIST. IX1114.2 +001800* IX1114.2 +001900* 2. THE ROUTINE CHECKS THE FILE STATUS CODES: IX1114.2 +002000* 35 - AFTER OPEN INPUT (NOT EXISTING FILE) IX1114.2 +002100 IX1114.2 +002200* 3. X-CARDS USED IN THIS PROGRAM (WITH THE OPT CODE): IX1114.2 +002300* IX1114.2 +002400* XXXXX025 (FOR THE NON EXISTING IX-NOP) IX1114.2 +002500* XXXXX055. IX1114.2 +002600* XXXXX082. IX1114.2 +002700* XXXXX083. IX1114.2 +002800* IX1114.2 +002900* IX1114.2 +003000 ENVIRONMENT DIVISION. IX1114.2 +003100 CONFIGURATION SECTION. IX1114.2 +003200 SOURCE-COMPUTER. IX1114.2 +003300 Linux. IX1114.2 +003400 OBJECT-COMPUTER. IX1114.2 +003500 Linux. IX1114.2 +003600 INPUT-OUTPUT SECTION. IX1114.2 +003700 FILE-CONTROL. IX1114.2 +003800 SELECT PRINT-FILE ASSIGN TO IX1114.2 +003900 "report.log". IX1114.2 +004000* IX1114.2 +004100 SELECT IX-NOP ASSIGN IX1114.2 +004200 "XXXXX025" IX1114.2 +004300 ORGANIZATION IS INDEXED IX1114.2 +004400 ACCESS MODE IS SEQUENTIAL IX1114.2 +004500 RECORD KEY IS IX-NOP-KEY IX1114.2 +004600 FILE STATUS IS IX-NOP-STATUS. IX1114.2 +004700 IX1114.2 +004800 IX1114.2 +004900 DATA DIVISION. IX1114.2 +005000 IX1114.2 +005100 FILE SECTION. IX1114.2 +005200 IX1114.2 +005300 FD PRINT-FILE. IX1114.2 +005400 IX1114.2 +005500 01 PRINT-REC PIC X(120). IX1114.2 +005600 IX1114.2 +005700 01 DUMMY-RECORD PIC X(120). IX1114.2 +005800 IX1114.2 +005900 FD IX-NOP IX1114.2 +006000*C LABEL RECORD STANDARD IX1114.2 +006100*C DATA RECORDS IX-NOPR1-F-G-240 IX1114.2 +006200 RECORD 240 IX1114.2 +006300 BLOCK CONTAINS 2 RECORDS. IX1114.2 +006400 IX1114.2 +006500 01 IX-NOPR1-F-G-240. IX1114.2 +006600 05 IX-NOP-REC-120 PIC X(120). IX1114.2 +006700 05 IX-NOP-REC-120-240. IX1114.2 +006800 10 FILLER PIC X(8). IX1114.2 +006900 10 IX-NOP-KEY PIC X(29). IX1114.2 +007000 10 FILLER PIC X(9). IX1114.2 +007100 10 IX-NOP-ALTER-KEY PIC X(29). IX1114.2 +007200 10 FILLER PIC X(45). IX1114.2 +007300 IX1114.2 +007400 IX1114.2 +007500 WORKING-STORAGE SECTION. IX1114.2 +007600 IX1114.2 +007700 01 IX-NOP-STATUS PIC XX. IX1114.2 +007800 IX1114.2 +007900 01 TEST-RESULTS. IX1114.2 +008000 02 FILLER PIC X VALUE SPACE. IX1114.2 +008100 02 FEATURE PIC X(20) VALUE SPACE. IX1114.2 +008200 02 FILLER PIC X VALUE SPACE. IX1114.2 +008300 02 P-OR-F PIC X(5) VALUE SPACE. IX1114.2 +008400 02 FILLER PIC X VALUE SPACE. IX1114.2 +008500 02 PAR-NAME. IX1114.2 +008600 03 FILLER PIC X(19) VALUE SPACE. IX1114.2 +008700 03 PARDOT-X PIC X VALUE SPACE. IX1114.2 +008800 03 DOTVALUE PIC 99 VALUE ZERO. IX1114.2 +008900 02 FILLER PIC X(8) VALUE SPACE. IX1114.2 +009000 02 RE-MARK PIC X(61). IX1114.2 +009100 01 TEST-COMPUTED. IX1114.2 +009200 02 FILLER PIC X(30) VALUE SPACE. IX1114.2 +009300 02 FILLER PIC X(17) VALUE IX1114.2 +009400 " COMPUTED=". IX1114.2 +009500 02 COMPUTED-X. IX1114.2 +009600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1114.2 +009700 03 COMPUTED-N REDEFINES COMPUTED-A IX1114.2 +009800 PIC -9(9).9(9). IX1114.2 +009900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1114.2 +010000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1114.2 +010100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1114.2 +010200 03 CM-18V0 REDEFINES COMPUTED-A. IX1114.2 +010300 04 COMPUTED-18V0 PIC -9(18). IX1114.2 +010400 04 FILLER PIC X. IX1114.2 +010500 03 FILLER PIC X(50) VALUE SPACE. IX1114.2 +010600 01 TEST-CORRECT. IX1114.2 +010700 02 FILLER PIC X(30) VALUE SPACE. IX1114.2 +010800 02 FILLER PIC X(17) VALUE " CORRECT =". IX1114.2 +010900 02 CORRECT-X. IX1114.2 +011000 03 CORRECT-A PIC X(20) VALUE SPACE. IX1114.2 +011100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1114.2 +011200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1114.2 +011300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1114.2 +011400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1114.2 +011500 03 CR-18V0 REDEFINES CORRECT-A. IX1114.2 +011600 04 CORRECT-18V0 PIC -9(18). IX1114.2 +011700 04 FILLER PIC X. IX1114.2 +011800 03 FILLER PIC X(2) VALUE SPACE. IX1114.2 +011900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1114.2 +012000 01 CCVS-C-1. IX1114.2 +012100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1114.2 +012200- "SS PARAGRAPH-NAME IX1114.2 +012300- " REMARKS". IX1114.2 +012400 02 FILLER PIC X(20) VALUE SPACE. IX1114.2 +012500 01 CCVS-C-2. IX1114.2 +012600 02 FILLER PIC X VALUE SPACE. IX1114.2 +012700 02 FILLER PIC X(6) VALUE "TESTED". IX1114.2 +012800 02 FILLER PIC X(15) VALUE SPACE. IX1114.2 +012900 02 FILLER PIC X(4) VALUE "FAIL". IX1114.2 +013000 02 FILLER PIC X(94) VALUE SPACE. IX1114.2 +013100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1114.2 +013200 01 REC-CT PIC 99 VALUE ZERO. IX1114.2 +013300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1114.2 +013400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1114.2 +013500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1114.2 +013600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1114.2 +013700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1114.2 +013800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1114.2 +013900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1114.2 +014000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1114.2 +014100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1114.2 +014200 01 CCVS-H-1. IX1114.2 +014300 02 FILLER PIC X(39) VALUE SPACES. IX1114.2 +014400 02 FILLER PIC X(42) VALUE IX1114.2 +014500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1114.2 +014600 02 FILLER PIC X(39) VALUE SPACES. IX1114.2 +014700 01 CCVS-H-2A. IX1114.2 +014800 02 FILLER PIC X(40) VALUE SPACE. IX1114.2 +014900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1114.2 +015000 02 FILLER PIC XXXX VALUE IX1114.2 +015100 "4.2 ". IX1114.2 +015200 02 FILLER PIC X(28) VALUE IX1114.2 +015300 " COPY - NOT FOR DISTRIBUTION". IX1114.2 +015400 02 FILLER PIC X(41) VALUE SPACE. IX1114.2 +015500 IX1114.2 +015600 01 CCVS-H-2B. IX1114.2 +015700 02 FILLER PIC X(15) VALUE IX1114.2 +015800 "TEST RESULT OF ". IX1114.2 +015900 02 TEST-ID PIC X(9). IX1114.2 +016000 02 FILLER PIC X(4) VALUE IX1114.2 +016100 " IN ". IX1114.2 +016200 02 FILLER PIC X(12) VALUE IX1114.2 +016300 " HIGH ". IX1114.2 +016400 02 FILLER PIC X(22) VALUE IX1114.2 +016500 " LEVEL VALIDATION FOR ". IX1114.2 +016600 02 FILLER PIC X(58) VALUE IX1114.2 +016700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1114.2 +016800 01 CCVS-H-3. IX1114.2 +016900 02 FILLER PIC X(34) VALUE IX1114.2 +017000 " FOR OFFICIAL USE ONLY ". IX1114.2 +017100 02 FILLER PIC X(58) VALUE IX1114.2 +017200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1114.2 +017300 02 FILLER PIC X(28) VALUE IX1114.2 +017400 " COPYRIGHT 1985 ". IX1114.2 +017500 01 CCVS-E-1. IX1114.2 +017600 02 FILLER PIC X(52) VALUE SPACE. IX1114.2 +017700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1114.2 +017800 02 ID-AGAIN PIC X(9). IX1114.2 +017900 02 FILLER PIC X(45) VALUE SPACES. IX1114.2 +018000 01 CCVS-E-2. IX1114.2 +018100 02 FILLER PIC X(31) VALUE SPACE. IX1114.2 +018200 02 FILLER PIC X(21) VALUE SPACE. IX1114.2 +018300 02 CCVS-E-2-2. IX1114.2 +018400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1114.2 +018500 03 FILLER PIC X VALUE SPACE. IX1114.2 +018600 03 ENDER-DESC PIC X(44) VALUE IX1114.2 +018700 "ERRORS ENCOUNTERED". IX1114.2 +018800 01 CCVS-E-3. IX1114.2 +018900 02 FILLER PIC X(22) VALUE IX1114.2 +019000 " FOR OFFICIAL USE ONLY". IX1114.2 +019100 02 FILLER PIC X(12) VALUE SPACE. IX1114.2 +019200 02 FILLER PIC X(58) VALUE IX1114.2 +019300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1114.2 +019400 02 FILLER PIC X(13) VALUE SPACE. IX1114.2 +019500 02 FILLER PIC X(15) VALUE IX1114.2 +019600 " COPYRIGHT 1985". IX1114.2 +019700 01 CCVS-E-4. IX1114.2 +019800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1114.2 +019900 02 FILLER PIC X(4) VALUE " OF ". IX1114.2 +020000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1114.2 +020100 02 FILLER PIC X(40) VALUE IX1114.2 +020200 " TESTS WERE EXECUTED SUCCESSFULLY". IX1114.2 +020300 01 XXINFO. IX1114.2 +020400 02 FILLER PIC X(19) VALUE IX1114.2 +020500 "*** INFORMATION ***". IX1114.2 +020600 02 INFO-TEXT. IX1114.2 +020700 04 FILLER PIC X(8) VALUE SPACE. IX1114.2 +020800 04 XXCOMPUTED PIC X(20). IX1114.2 +020900 04 FILLER PIC X(5) VALUE SPACE. IX1114.2 +021000 04 XXCORRECT PIC X(20). IX1114.2 +021100 02 INF-ANSI-REFERENCE PIC X(48). IX1114.2 +021200 01 HYPHEN-LINE. IX1114.2 +021300 02 FILLER PIC IS X VALUE IS SPACE. IX1114.2 +021400 02 FILLER PIC IS X(65) VALUE IS "************************IX1114.2 +021500- "*****************************************". IX1114.2 +021600 02 FILLER PIC IS X(54) VALUE IS "************************IX1114.2 +021700- "******************************". IX1114.2 +021800 01 CCVS-PGM-ID PIC X(9) VALUE IX1114.2 +021900 "IX111A". IX1114.2 +022000 PROCEDURE DIVISION. IX1114.2 +022100 DECLARATIVES. IX1114.2 +022200 IX1114.2 +022300 SECT-IX111-0001 SECTION. IX1114.2 +022400 USE AFTER EXCEPTION PROCEDURE ON IX-NOP. IX1114.2 +022500 INPUT-PROCESS. IX1114.2 +022600 IF IX-NOP-STATUS = "35" IX1114.2 +022700 PERFORM PASS-DECL IX1114.2 +022800 GO TO ABNORMAL-TERM-DECL IX1114.2 +022900 ELSE IX1114.2 +023000 MOVE "35" TO CORRECT-A IX1114.2 +023100 MOVE IX-NOP-STATUS TO COMPUTED-A IX1114.2 +023200 MOVE "STATUS FOR OPEN INPUT OF FILE THAT IS NOT IX1114.2 +023300- "PRESENT INCORRECT" TO RE-MARK IX1114.2 +023400 MOVE "IX-2, FILE STATUS" TO ANSI-REFERENCE IX1114.2 +023500 PERFORM FAIL-DECL IX1114.2 +023600 GO TO ABNORMAL-TERM-DECL IX1114.2 +023700 END-IF. IX1114.2 +023800 IX1114.2 +023900 PASS-DECL. IX1114.2 +024000 MOVE "PASS " TO P-OR-F. IX1114.2 +024100 ADD 1 TO PASS-COUNTER. IX1114.2 +024200 PERFORM PRINT-DETAIL-DECL. IX1114.2 +024300* IX1114.2 +024400 FAIL-DECL. IX1114.2 +024500 MOVE "FAIL*" TO P-OR-F. IX1114.2 +024600 ADD 1 TO ERROR-COUNTER. IX1114.2 +024700 PERFORM PRINT-DETAIL-DECL. IX1114.2 +024800* IX1114.2 +024900 PRINT-DETAIL-DECL. IX1114.2 +025000 IF REC-CT NOT EQUAL TO ZERO IX1114.2 +025100 MOVE "." TO PARDOT-X IX1114.2 +025200 MOVE REC-CT TO DOTVALUE. IX1114.2 +025300 MOVE TEST-RESULTS TO PRINT-REC. IX1114.2 +025400 PERFORM WRITE-LINE-DECL. IX1114.2 +025500 IF P-OR-F EQUAL TO "FAIL*" IX1114.2 +025600 PERFORM WRITE-LINE-DECL IX1114.2 +025700 PERFORM FAIL-ROUTINE-DECL THRU FAIL-ROUTINE-EX-DECL IX1114.2 +025800 ELSE IX1114.2 +025900 PERFORM BAIL-OUT-DECL THRU BAIL-OUT-EX-DECL. IX1114.2 +026000 MOVE SPACE TO P-OR-F. IX1114.2 +026100 MOVE SPACE TO COMPUTED-X. IX1114.2 +026200 MOVE SPACE TO CORRECT-X. IX1114.2 +026300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1114.2 +026400 MOVE SPACE TO RE-MARK. IX1114.2 +026500* IX1114.2 +026600 WRITE-LINE-DECL. IX1114.2 +026700 ADD 1 TO RECORD-COUNT. IX1114.2 +026800 PERFORM WRT-LN-DECL. IX1114.2 +026900* IX1114.2 +027000 WRT-LN-DECL. IX1114.2 +027100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1114.2 +027200 MOVE SPACE TO DUMMY-RECORD. IX1114.2 +027300 BLANK-LINE-PRINT-DECL. IX1114.2 +027400 PERFORM WRT-LN-DECL. IX1114.2 +027500 FAIL-ROUTINE-DECL. IX1114.2 +027600 IF COMPUTED-X NOT EQUAL TO SPACE IX1114.2 +027700 GO TO FAIL-ROUTINE-WRITE-DECL. IX1114.2 +027800 IF CORRECT-X NOT EQUAL TO SPACE IX1114.2 +027900 GO TO FAIL-ROUTINE-WRITE-DECL. IX1114.2 +028000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1114.2 +028100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1114.2 +028200 MOVE XXINFO TO DUMMY-RECORD. IX1114.2 +028300 PERFORM WRITE-LINE-DECL 2 TIMES. IX1114.2 +028400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1114.2 +028500 GO TO FAIL-ROUTINE-EX-DECL. IX1114.2 +028600 FAIL-ROUTINE-WRITE-DECL. IX1114.2 +028700 MOVE TEST-COMPUTED TO PRINT-REC IX1114.2 +028800 PERFORM WRITE-LINE-DECL IX1114.2 +028900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1114.2 +029000 MOVE TEST-CORRECT TO PRINT-REC IX1114.2 +029100 PERFORM WRITE-LINE-DECL 2 TIMES. IX1114.2 +029200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1114.2 +029300 FAIL-ROUTINE-EX-DECL. IX1114.2 +029400 EXIT. IX1114.2 +029500 BAIL-OUT-DECL. IX1114.2 +029600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-DECL. IX1114.2 +029700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-DECL. IX1114.2 +029800 BAIL-OUT-WRITE-DECL. IX1114.2 +029900 MOVE CORRECT-A TO XXCORRECT. IX1114.2 +030000 MOVE COMPUTED-A TO XXCOMPUTED. IX1114.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1114.2 +030200 MOVE XXINFO TO DUMMY-RECORD. IX1114.2 +030300 PERFORM WRITE-LINE-DECL 2 TIMES. IX1114.2 +030400 MOVE SPACES TO INF-ANSI-REFERENCE. IX1114.2 +030500 BAIL-OUT-EX-DECL. IX1114.2 +030600 EXIT. IX1114.2 +030700* IX1114.2 +030800 ABNORMAL-TERM-DECL. IX1114.2 +030900 MOVE SPACE TO DUMMY-RECORD. IX1114.2 +031000 PERFORM WRITE-LINE-DECL. IX1114.2 +031100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" IX1114.2 +031200 TO DUMMY-RECORD. IX1114.2 +031300 PERFORM WRITE-LINE-DECL 3 TIMES. IX1114.2 +031400* IX1114.2 +031500 EXIT-DECL. IX1114.2 +031600 EXIT. IX1114.2 +031700 END DECLARATIVES. IX1114.2 +031800 IX1114.2 +031900 IX1114.2 +032000 CCVS1 SECTION. IX1114.2 +032100 OPEN-FILES. IX1114.2 +032200 OPEN OUTPUT PRINT-FILE. IX1114.2 +032300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1114.2 +032400 MOVE SPACE TO TEST-RESULTS. IX1114.2 +032500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1114.2 +032600 MOVE ZERO TO REC-SKL-SUB. IX1114.2 +032700 CCVS-INIT-EXIT. IX1114.2 +032800 GO TO CCVS1-EXIT. IX1114.2 +032900 CLOSE-FILES. IX1114.2 +033000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1114.2 +033100 TERMINATE-CCVS. IX1114.2 +033200 STOP RUN. IX1114.2 +033300 HEAD-ROUTINE. IX1114.2 +033400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +033500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +033600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1114.2 +033700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1114.2 +033800 COLUMN-NAMES-ROUTINE. IX1114.2 +033900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +034000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +034200 END-ROUTINE. IX1114.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1114.2 +034400 END-RTN-EXIT. IX1114.2 +034500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +034600 END-ROUTINE-1. IX1114.2 +034700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1114.2 +034800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1114.2 +034900 ADD PASS-COUNTER TO ERROR-HOLD. IX1114.2 +035000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1114.2 +035100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1114.2 +035200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1114.2 +035300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1114.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1114.2 +035500 END-ROUTINE-12. IX1114.2 +035600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1114.2 +035700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1114.2 +035800 MOVE "NO " TO ERROR-TOTAL IX1114.2 +035900 ELSE IX1114.2 +036000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1114.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1114.2 +036200 PERFORM WRITE-LINE. IX1114.2 +036300 END-ROUTINE-13. IX1114.2 +036400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1114.2 +036500 MOVE "NO " TO ERROR-TOTAL ELSE IX1114.2 +036600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1114.2 +036700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1114.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +036900 IF INSPECT-COUNTER EQUAL TO ZERO IX1114.2 +037000 MOVE "NO " TO ERROR-TOTAL IX1114.2 +037100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1114.2 +037200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1114.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +037400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1114.2 +037500 WRITE-LINE. IX1114.2 +037600 ADD 1 TO RECORD-COUNT. IX1114.2 +037700 IF RECORD-COUNT GREATER 42 IX1114.2 +037800 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1114.2 +037900 MOVE SPACE TO DUMMY-RECORD IX1114.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1114.2 +038100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1114.2 +038200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1114.2 +038300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1114.2 +038400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1114.2 +038500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1114.2 +038600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1114.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1114.2 +038800 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1114.2 +038900 MOVE ZERO TO RECORD-COUNT. IX1114.2 +039000 PERFORM WRT-LN. IX1114.2 +039100 WRT-LN. IX1114.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1114.2 +039300 MOVE SPACE TO DUMMY-RECORD. IX1114.2 +039400 BLANK-LINE-PRINT. IX1114.2 +039500 PERFORM WRT-LN. IX1114.2 +039600 FAIL-ROUTINE. IX1114.2 +039700 IF COMPUTED-X NOT EQUAL TO SPACE IX1114.2 +039800 GO TO FAIL-ROUTINE-WRITE. IX1114.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1114.2 +040000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1114.2 +040100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1114.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +040300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1114.2 +040400 GO TO FAIL-ROUTINE-EX. IX1114.2 +040500 FAIL-ROUTINE-WRITE. IX1114.2 +040600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1114.2 +040700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1114.2 +040800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1114.2 +040900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1114.2 +041000 FAIL-ROUTINE-EX. EXIT. IX1114.2 +041100 BAIL-OUT. IX1114.2 +041200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1114.2 +041300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1114.2 +041400 BAIL-OUT-WRITE. IX1114.2 +041500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1114.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1114.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1114.2 +041800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1114.2 +041900 BAIL-OUT-EX. EXIT. IX1114.2 +042000 CCVS1-EXIT. IX1114.2 +042100 EXIT. IX1114.2 +042200 IX1114.2 +042300 SECT-IX111A-0003 SECTION. IX1114.2 +042400 SEQ-INIT-010. IX1114.2 +042500 IX1114.2 +042600******************************************************************IX1114.2 +042700* TEST 1 *IX1114.2 +042800* OPEN INPUT (FILE DOES NOT EXIST) 35 EXPECTED *IX1114.2 +042900* IX-4, 1.3.4 (4) B *IX1114.2 +043000******************************************************************IX1114.2 +043100 OPN-INIT-GF-01-0. IX1114.2 +043200 MOVE SPACES TO IX-NOP-STATUS. IX1114.2 +043300 MOVE "OPEN INPUT 35 EXP." TO FEATURE. IX1114.2 +043400 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1114.2 +043500 OPN-TEST-GF-01-0. IX1114.2 +043600 OPEN IX1114.2 +043700 INPUT IX-NOP. IX1114.2 +043800 IX1114.2 +043900 TERMINATE-ROUTINE. IX1114.2 +044000 EXIT. IX1114.2 +044100 IX1114.2 +044200 CCVS-EXIT SECTION. IX1114.2 +044300 CCVS-999999. IX1114.2 +044400 GO TO CLOSE-FILES. IX1114.2 diff --git a/tests/cobol85/IX/IX112A.CBL b/tests/cobol85/IX/IX112A.CBL new file mode 100755 index 00000000..739eb144 --- /dev/null +++ b/tests/cobol85/IX/IX112A.CBL @@ -0,0 +1,876 @@ +000100 IDENTIFICATION DIVISION. IX1124.2 +000200 PROGRAM-ID. IX1124.2 +000300 IX112A. IX1124.2 +000400**************************************************************** IX1124.2 +000500* * IX1124.2 +000600* VALIDATION FOR:- * IX1124.2 +000700* * IX1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1124.2 +000900* * IX1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1124.2 +001100* * IX1124.2 +001200**************************************************************** IX1124.2 +001300* IX1124.2 +001400* 1. THE ROUTINE CREATES THE MASS STORAGE FILE IX-VS2 IX1124.2 +001500* CONTAINING 50 RECORDS. EACH BLOCK CONTAINS 2 RECORDS, IX1124.2 +001600* EACH RECORD CONTAINS 240 CHARACTERS, ORGANIZATION IS IX1124.2 +001700* INDEXED, ACCESS IS SEQUENTIAL. THEN THE FILE IS OPENED IX1124.2 +001800* AS I-O AND IT IS ATTEMTED TO REWRITE A RECORD WITH A IX1124.2 +001900* WRONG RECORD LENGTH. IX1124.2 +002000* IX1124.2 +002100* 2. THE ROUTINE READS THE CREATED FILE, VERIFIES IT AND IX1124.2 +002200* CHECKS THE FILE STATUS CODE: IX1124.2 +002300* 44 - AFTER REWRITE (WITH WRONG RECORD LENGTH) IX1124.2 +002400* IX1124.2 +002500* 3. X-CARDS USED IN THIS PROGRAM: IX1124.2 +002600* IX1124.2 +002700* XXXXX024 IX1124.2 +002800* XXXXX055. IX1124.2 +002900* XXXXX062. IX1124.2 +003000* XXXXX082. IX1124.2 +003100* XXXXX083. IX1124.2 +003200* XXXXX084 IX1124.2 +003300* IX1124.2 +003400* IX1124.2 +003500 ENVIRONMENT DIVISION. IX1124.2 +003600 CONFIGURATION SECTION. IX1124.2 +003700 SOURCE-COMPUTER. IX1124.2 +003800 Linux. IX1124.2 +003900 OBJECT-COMPUTER. IX1124.2 +004000 Linux. IX1124.2 +004100 INPUT-OUTPUT SECTION. IX1124.2 +004200 FILE-CONTROL. IX1124.2 +004300*P SELECT RAW-DATA ASSIGN TO IX1124.2 +004400*P "XXXXX062" IX1124.2 +004500*P ORGANIZATION IS INDEXED IX1124.2 +004600*P ACCESS MODE IS RANDOM IX1124.2 +004700*P RECORD KEY IS RAW-DATA-KEY. IX1124.2 +004800* IX1124.2 +004900 SELECT PRINT-FILE ASSIGN TO IX1124.2 +005000 "report.log". IX1124.2 +005100* IX1124.2 +005200 SELECT IX-VS2 ASSIGN IX1124.2 +005300 "XXXXX024" IX1124.2 +005400 ORGANIZATION IS INDEXED IX1124.2 +005500 ACCESS MODE IS SEQUENTIAL IX1124.2 +005600 RECORD KEY IS IX-VS2-KEY IX1124.2 +005700 FILE STATUS IS IX-VS2-STATUS. IX1124.2 +005800 IX1124.2 +005900 DATA DIVISION. IX1124.2 +006000 IX1124.2 +006100 FILE SECTION. IX1124.2 +006200*P IX1124.2 +006300*PD RAW-DATA. IX1124.2 +006400*P IX1124.2 +006500*P1 RAW-DATA-SATZ. IX1124.2 +006600*P 05 RAW-DATA-KEY PIC X(6). IX1124.2 +006700*P 05 C-DATE PIC 9(6). IX1124.2 +006800*P 05 C-TIME PIC 9(8). IX1124.2 +006900*P 05 C-NO-OF-TESTS PIC 99. IX1124.2 +007000*P 05 C-OK PIC 999. IX1124.2 +007100*P 05 C-ALL PIC 999. IX1124.2 +007200*P 05 C-FAIL PIC 999. IX1124.2 +007300*P 05 C-DELETED PIC 999. IX1124.2 +007400*P 05 C-INSPECT PIC 999. IX1124.2 +007500*P 05 C-NOTE PIC X(13). IX1124.2 +007600*P 05 C-INDENT PIC X. IX1124.2 +007700*P 05 C-ABORT PIC X(8). IX1124.2 +007800 IX1124.2 +007900 FD PRINT-FILE. IX1124.2 +008000 IX1124.2 +008100 01 PRINT-REC PIC X(120). IX1124.2 +008200 IX1124.2 +008300 01 DUMMY-RECORD PIC X(120). IX1124.2 +008400 IX1124.2 +008500 FD IX-VS2 IX1124.2 +008600*C DATA RECORDS IX-VS2R1-F-G-240 IX-VS2R1-F-G-200 IX1124.2 +008700*C IX-VS2R1-F-G-280 IX1124.2 +008800*C LABEL RECORD STANDARD IX1124.2 +008900 RECORD 200 TO 280 IX1124.2 +009000 BLOCK CONTAINS 2 RECORDS. IX1124.2 +009100 IX1124.2 +009200 01 IX-VS2R1-F-G-240. IX1124.2 +009300 05 IX-VS2-REC-120 PIC X(120). IX1124.2 +009400 05 IX-VS2-REC-120-240. IX1124.2 +009500 10 FILLER PIC X(8). IX1124.2 +009600 10 IX-VS2-KEY PIC X(29). IX1124.2 +009700 10 FILLER PIC X(9). IX1124.2 +009800 10 IX-VS2-ALTER-KEY PIC X(29). IX1124.2 +009900 10 FILLER PIC X(45). IX1124.2 +010000 IX1124.2 +010100 01 IX-VS2R1-F-G-200. IX1124.2 +010200 05 IX-VS2-REC-SHORT PIC X(120). IX1124.2 +010300 05 IX-VS2-REC-120-200 PIC X(80). IX1124.2 +010400 IX1124.2 +010500 01 IX-VS2R1-F-G-280. IX1124.2 +010600 05 IX-VS2-REC-LONG PIC X(120). IX1124.2 +010700 05 IX-VS2-REC-120-239 PIC X(120). IX1124.2 +010800 05 IX-VS2-REC-240-280 PIC X(40). IX1124.2 +010900 IX1124.2 +011000 WORKING-STORAGE SECTION. IX1124.2 +011100 IX1124.2 +011200 01 GRP-0101. IX1124.2 +011300 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1124.2 +011400 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1124.2 +011500 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1124.2 +011600 IX1124.2 +011700 01 GRP-0102. IX1124.2 +011800 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1124.2 +011900 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1124.2 +012000 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1124.2 +012100 IX1124.2 +012200 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1124.2 +012300 IX1124.2 +012400 01 EOF-FLAG PIC 9 VALUE ZERO. IX1124.2 +012500 IX1124.2 +012600 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1124.2 +012700 IX1124.2 +012800 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1124.2 +012900 IX1124.2 +013000 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1124.2 +013100 IX1124.2 +013200 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1124.2 +013300 IX1124.2 +013400 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1124.2 +013500 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1124.2 +013600 IX1124.2 +013700 01 IX-VS2-STATUS. IX1124.2 +013800 05 IX-VS2-STAT1 PIC X. IX1124.2 +013900 05 IX-VS2-STAT2 PIC X. IX1124.2 +014000 IX1124.2 +014100 01 COUNT-OF-RECS PIC 9(5). IX1124.2 +014200 IX1124.2 +014300 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1124.2 +014400 IX1124.2 +014500 01 FILE-RECORD-INFORMATION-REC. IX1124.2 +014600 05 FILE-RECORD-INFO-SKELETON. IX1124.2 +014700 10 FILLER PIC X(48) VALUE IX1124.2 +014800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1124.2 +014900 10 FILLER PIC X(46) VALUE IX1124.2 +015000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1124.2 +015100 10 FILLER PIC X(26) VALUE IX1124.2 +015200 ",LFIL=000000,ORG= ,LBLR= ". IX1124.2 +015300 10 FILLER PIC X(37) VALUE IX1124.2 +015400 ",RECKEY= ". IX1124.2 +015500 10 FILLER PIC X(38) VALUE IX1124.2 +015600 ",ALTKEY1= ". IX1124.2 +015700 10 FILLER PIC X(38) VALUE IX1124.2 +015800 ",ALTKEY2= ". IX1124.2 +015900 10 FILLER PIC X(7) VALUE SPACE. IX1124.2 +016000 05 FILE-RECORD-INFO OCCURS 10. IX1124.2 +016100 10 FILE-RECORD-INFO-P1-120. IX1124.2 +016200 15 FILLER PIC X(5). IX1124.2 +016300 15 XFILE-NAME PIC X(6). IX1124.2 +016400 15 FILLER PIC X(8). IX1124.2 +016500 15 XRECORD-NAME PIC X(6). IX1124.2 +016600 15 FILLER PIC X(1). IX1124.2 +016700 15 REELUNIT-NUMBER PIC 9(1). IX1124.2 +016800 15 FILLER PIC X(7). IX1124.2 +016900 15 XRECORD-NUMBER PIC 9(6). IX1124.2 +017000 15 FILLER PIC X(6). IX1124.2 +017100 15 UPDATE-NUMBER PIC 9(2). IX1124.2 +017200 15 FILLER PIC X(5). IX1124.2 +017300 15 ODO-NUMBER PIC 9(4). IX1124.2 +017400 15 FILLER PIC X(5). IX1124.2 +017500 15 XPROGRAM-NAME PIC X(5). IX1124.2 +017600 15 FILLER PIC X(7). IX1124.2 +017700 15 XRECORD-LENGTH PIC 9(6). IX1124.2 +017800 15 FILLER PIC X(7). IX1124.2 +017900 15 CHARS-OR-RECORDS PIC X(2). IX1124.2 +018000 15 FILLER PIC X(1). IX1124.2 +018100 15 XBLOCK-SIZE PIC 9(4). IX1124.2 +018200 15 FILLER PIC X(6). IX1124.2 +018300 15 RECORDS-IN-FILE PIC 9(6). IX1124.2 +018400 15 FILLER PIC X(5). IX1124.2 +018500 15 XFILE-ORGANIZATION PIC X(2). IX1124.2 +018600 15 FILLER PIC X(6). IX1124.2 +018700 15 XLABEL-TYPE PIC X(1). IX1124.2 +018800 10 FILE-RECORD-INFO-P121-240. IX1124.2 +018900 15 FILLER PIC X(8). IX1124.2 +019000 15 XRECORD-KEY PIC X(29). IX1124.2 +019100 15 FILLER PIC X(9). IX1124.2 +019200 15 ALTERNATE-KEY1 PIC X(29). IX1124.2 +019300 15 FILLER PIC X(9). IX1124.2 +019400 15 ALTERNATE-KEY2 PIC X(29). IX1124.2 +019500 15 FILLER PIC X(7). IX1124.2 +019600 IX1124.2 +019700 01 TEST-RESULTS. IX1124.2 +019800 02 FILLER PIC X VALUE SPACE. IX1124.2 +019900 02 FEATURE PIC X(20) VALUE SPACE. IX1124.2 +020000 02 FILLER PIC X VALUE SPACE. IX1124.2 +020100 02 P-OR-F PIC X(5) VALUE SPACE. IX1124.2 +020200 02 FILLER PIC X VALUE SPACE. IX1124.2 +020300 02 PAR-NAME. IX1124.2 +020400 03 FILLER PIC X(19) VALUE SPACE. IX1124.2 +020500 03 PARDOT-X PIC X VALUE SPACE. IX1124.2 +020600 03 DOTVALUE PIC 99 VALUE ZERO. IX1124.2 +020700 02 FILLER PIC X(8) VALUE SPACE. IX1124.2 +020800 02 RE-MARK PIC X(61). IX1124.2 +020900 01 TEST-COMPUTED. IX1124.2 +021000 02 FILLER PIC X(30) VALUE SPACE. IX1124.2 +021100 02 FILLER PIC X(17) VALUE IX1124.2 +021200 " COMPUTED=". IX1124.2 +021300 02 COMPUTED-X. IX1124.2 +021400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1124.2 +021500 03 COMPUTED-N REDEFINES COMPUTED-A IX1124.2 +021600 PIC -9(9).9(9). IX1124.2 +021700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1124.2 +021800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1124.2 +021900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1124.2 +022000 03 CM-18V0 REDEFINES COMPUTED-A. IX1124.2 +022100 04 COMPUTED-18V0 PIC -9(18). IX1124.2 +022200 04 FILLER PIC X. IX1124.2 +022300 03 FILLER PIC X(50) VALUE SPACE. IX1124.2 +022400 01 TEST-CORRECT. IX1124.2 +022500 02 FILLER PIC X(30) VALUE SPACE. IX1124.2 +022600 02 FILLER PIC X(17) VALUE " CORRECT =". IX1124.2 +022700 02 CORRECT-X. IX1124.2 +022800 03 CORRECT-A PIC X(20) VALUE SPACE. IX1124.2 +022900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1124.2 +023000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1124.2 +023100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1124.2 +023200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1124.2 +023300 03 CR-18V0 REDEFINES CORRECT-A. IX1124.2 +023400 04 CORRECT-18V0 PIC -9(18). IX1124.2 +023500 04 FILLER PIC X. IX1124.2 +023600 03 FILLER PIC X(2) VALUE SPACE. IX1124.2 +023700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1124.2 +023800 01 CCVS-C-1. IX1124.2 +023900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1124.2 +024000- "SS PARAGRAPH-NAME IX1124.2 +024100- " REMARKS". IX1124.2 +024200 02 FILLER PIC X(20) VALUE SPACE. IX1124.2 +024300 01 CCVS-C-2. IX1124.2 +024400 02 FILLER PIC X VALUE SPACE. IX1124.2 +024500 02 FILLER PIC X(6) VALUE "TESTED". IX1124.2 +024600 02 FILLER PIC X(15) VALUE SPACE. IX1124.2 +024700 02 FILLER PIC X(4) VALUE "FAIL". IX1124.2 +024800 02 FILLER PIC X(94) VALUE SPACE. IX1124.2 +024900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1124.2 +025000 01 REC-CT PIC 99 VALUE ZERO. IX1124.2 +025100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1124.2 +025200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1124.2 +025300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1124.2 +025400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1124.2 +025500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1124.2 +025600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1124.2 +025700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1124.2 +025800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1124.2 +025900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1124.2 +026000 01 CCVS-H-1. IX1124.2 +026100 02 FILLER PIC X(39) VALUE SPACES. IX1124.2 +026200 02 FILLER PIC X(42) VALUE IX1124.2 +026300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1124.2 +026400 02 FILLER PIC X(39) VALUE SPACES. IX1124.2 +026500 01 CCVS-H-2A. IX1124.2 +026600 02 FILLER PIC X(40) VALUE SPACE. IX1124.2 +026700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1124.2 +026800 02 FILLER PIC XXXX VALUE IX1124.2 +026900 "4.2 ". IX1124.2 +027000 02 FILLER PIC X(28) VALUE IX1124.2 +027100 " COPY - NOT FOR DISTRIBUTION". IX1124.2 +027200 02 FILLER PIC X(41) VALUE SPACE. IX1124.2 +027300 IX1124.2 +027400 01 CCVS-H-2B. IX1124.2 +027500 02 FILLER PIC X(15) VALUE IX1124.2 +027600 "TEST RESULT OF ". IX1124.2 +027700 02 TEST-ID PIC X(9). IX1124.2 +027800 02 FILLER PIC X(4) VALUE IX1124.2 +027900 " IN ". IX1124.2 +028000 02 FILLER PIC X(12) VALUE IX1124.2 +028100 " HIGH ". IX1124.2 +028200 02 FILLER PIC X(22) VALUE IX1124.2 +028300 " LEVEL VALIDATION FOR ". IX1124.2 +028400 02 FILLER PIC X(58) VALUE IX1124.2 +028500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1124.2 +028600 01 CCVS-H-3. IX1124.2 +028700 02 FILLER PIC X(34) VALUE IX1124.2 +028800 " FOR OFFICIAL USE ONLY ". IX1124.2 +028900 02 FILLER PIC X(58) VALUE IX1124.2 +029000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1124.2 +029100 02 FILLER PIC X(28) VALUE IX1124.2 +029200 " COPYRIGHT 1985 ". IX1124.2 +029300 01 CCVS-E-1. IX1124.2 +029400 02 FILLER PIC X(52) VALUE SPACE. IX1124.2 +029500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1124.2 +029600 02 ID-AGAIN PIC X(9). IX1124.2 +029700 02 FILLER PIC X(45) VALUE SPACES. IX1124.2 +029800 01 CCVS-E-2. IX1124.2 +029900 02 FILLER PIC X(31) VALUE SPACE. IX1124.2 +030000 02 FILLER PIC X(21) VALUE SPACE. IX1124.2 +030100 02 CCVS-E-2-2. IX1124.2 +030200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1124.2 +030300 03 FILLER PIC X VALUE SPACE. IX1124.2 +030400 03 ENDER-DESC PIC X(44) VALUE IX1124.2 +030500 "ERRORS ENCOUNTERED". IX1124.2 +030600 01 CCVS-E-3. IX1124.2 +030700 02 FILLER PIC X(22) VALUE IX1124.2 +030800 " FOR OFFICIAL USE ONLY". IX1124.2 +030900 02 FILLER PIC X(12) VALUE SPACE. IX1124.2 +031000 02 FILLER PIC X(58) VALUE IX1124.2 +031100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1124.2 +031200 02 FILLER PIC X(13) VALUE SPACE. IX1124.2 +031300 02 FILLER PIC X(15) VALUE IX1124.2 +031400 " COPYRIGHT 1985". IX1124.2 +031500 01 CCVS-E-4. IX1124.2 +031600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1124.2 +031700 02 FILLER PIC X(4) VALUE " OF ". IX1124.2 +031800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1124.2 +031900 02 FILLER PIC X(40) VALUE IX1124.2 +032000 " TESTS WERE EXECUTED SUCCESSFULLY". IX1124.2 +032100 01 XXINFO. IX1124.2 +032200 02 FILLER PIC X(19) VALUE IX1124.2 +032300 "*** INFORMATION ***". IX1124.2 +032400 02 INFO-TEXT. IX1124.2 +032500 04 FILLER PIC X(8) VALUE SPACE. IX1124.2 +032600 04 XXCOMPUTED PIC X(20). IX1124.2 +032700 04 FILLER PIC X(5) VALUE SPACE. IX1124.2 +032800 04 XXCORRECT PIC X(20). IX1124.2 +032900 02 INF-ANSI-REFERENCE PIC X(48). IX1124.2 +033000 01 HYPHEN-LINE. IX1124.2 +033100 02 FILLER PIC IS X VALUE IS SPACE. IX1124.2 +033200 02 FILLER PIC IS X(65) VALUE IS "************************IX1124.2 +033300- "*****************************************". IX1124.2 +033400 02 FILLER PIC IS X(54) VALUE IS "************************IX1124.2 +033500- "******************************". IX1124.2 +033600 01 CCVS-PGM-ID PIC X(9) VALUE IX1124.2 +033700 "IX112A". IX1124.2 +033800 01 TEST-NUMBER PIC 9 VALUE ZERO. IX1124.2 +033900 IX1124.2 +034000 PROCEDURE DIVISION. IX1124.2 +034100 DECLARATIVES. IX1124.2 +034200 IX1124.2 +034300 SECT-IX105-0002 SECTION. IX1124.2 +034400 USE AFTER EXCEPTION PROCEDURE ON IX-VS2. IX1124.2 +034500 INPUT-PROCESS. IX1124.2 +034600 MOVE 1 TO PERM-ERRORS. IX1124.2 +034700 IF TEST-NUMBER NOT = 7 GO TO END-DECL. IX1124.2 +034800 D-RWR-TEST-GF-01-1. IX1124.2 +034900 IF IX-VS2-STATUS = "00" IX1124.2 +035000 GO TO D-RWR-PASS-GF-01-0. IX1124.2 +035100 IF IX-VS2-STATUS = "44" IX1124.2 +035200 GO TO D-RWR-PASS-GF-01-0. IX1124.2 +035300 D-RWR-FAIL-GF-01-0. IX1124.2 +035400 MOVE "IX-5, 1.3.4, (5) d 1 & 2; SHORT RECORD" TO RE-MARK. IX1124.2 +035500 PERFORM D-FAIL. IX1124.2 +035600 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +035700 MOVE "00 OR 44" TO CORRECT-X. IX1124.2 +035800 GO TO D-RWR-WRITE-GF-01-0. IX1124.2 +035900 D-RWR-PASS-GF-01-0. IX1124.2 +036000 PERFORM D-PASS. IX1124.2 +036100 D-RWR-WRITE-GF-01-0. IX1124.2 +036200 PERFORM D-PRINT-DETAIL. IX1124.2 +036300 D-CLOSE-FILES. IX1124.2 +036400*P OPEN I-O RAW-DATA. IX1124.2 +036500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1124.2 +036600*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1124.2 +036700*P MOVE "OK. " TO C-ABORT. IX1124.2 +036800*P MOVE PASS-COUNTER TO C-OK. IX1124.2 +036900*P MOVE ERROR-HOLD TO C-ALL. IX1124.2 +037000*P MOVE ERROR-COUNTER TO C-FAIL. IX1124.2 +037100*P MOVE DELETE-COUNTER TO C-DELETED. IX1124.2 +037200*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1124.2 +037300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1124.2 +037400*P-END-E-2. IX1124.2 +037500*P CLOSE RAW-DATA. IX1124.2 +037600 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1124.2 +037700 CLOSE PRINT-FILE. IX1124.2 +037800 D-TERMINATE-CCVS. IX1124.2 +037900*S EXIT PROGRAM. IX1124.2 +038000*S-TERMINATE-CALL. IX1124.2 +038100 STOP RUN. IX1124.2 +038200 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1124.2 +038300 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1124.2 +038400 D-PRINT-DETAIL. IX1124.2 +038500 IF REC-CT NOT EQUAL TO ZERO IX1124.2 +038600 MOVE "." TO PARDOT-X IX1124.2 +038700 MOVE REC-CT TO DOTVALUE. IX1124.2 +038800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D-WRITE-LINE. IX1124.2 +038900 IF P-OR-F EQUAL TO "FAIL*" PERFORM D-WRITE-LINE IX1124.2 +039000 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1124.2 +039100 ELSE PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1124.2 +039200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1124.2 +039300 MOVE SPACE TO CORRECT-X. IX1124.2 +039400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1124.2 +039500 MOVE SPACE TO RE-MARK. IX1124.2 +039600 D-END-ROUTINE. IX1124.2 +039700 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1124.2 +039800 PERFORM D-WRITE-LINE 5 TIMES. IX1124.2 +039900 D-END-RTN-EXIT. IX1124.2 +040000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1124.2 +040100 D-END-ROUTINE-1. IX1124.2 +040200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1124.2 +040300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1124.2 +040400 ADD PASS-COUNTER TO ERROR-HOLD. IX1124.2 +040500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1124.2 +040600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1124.2 +040700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1124.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1124.2 +040900 D-END-ROUTINE-12. IX1124.2 +041000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1124.2 +041100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1124.2 +041200 MOVE "NO " TO ERROR-TOTAL IX1124.2 +041300 ELSE IX1124.2 +041400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1124.2 +041500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1124.2 +041600 PERFORM D-WRITE-LINE. IX1124.2 +041700 D-END-ROUTINE-13. IX1124.2 +041800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1124.2 +041900 MOVE "NO " TO ERROR-TOTAL ELSE IX1124.2 +042000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1124.2 +042100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1124.2 +042200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1124.2 +042300 IF INSPECT-COUNTER EQUAL TO ZERO IX1124.2 +042400 MOVE "NO " TO ERROR-TOTAL IX1124.2 +042500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1124.2 +042600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1124.2 +042700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1124.2 +042800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1124.2 +042900 D-WRITE-LINE. IX1124.2 +043000 ADD 1 TO RECORD-COUNT. IX1124.2 +043100 IF RECORD-COUNT GREATER 42 IX1124.2 +043200 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1124.2 +043300 MOVE SPACE TO DUMMY-RECORD IX1124.2 +043400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1124.2 +043500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1124.2 +043600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1124.2 +043700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1124.2 +043800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1124.2 +043900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1124.2 +044000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1124.2 +044100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1124.2 +044200 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1124.2 +044300 MOVE ZERO TO RECORD-COUNT. IX1124.2 +044400 PERFORM D-WRT-LN. IX1124.2 +044500 D-WRT-LN. IX1124.2 +044600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1124.2 +044700 MOVE SPACE TO DUMMY-RECORD. IX1124.2 +044800 D-BLANK-LINE-PRINT. IX1124.2 +044900 PERFORM D-WRT-LN. IX1124.2 +045000 D-FAIL-ROUTINE. IX1124.2 +045100 IF COMPUTED-X NOT EQUAL TO SPACE IX1124.2 +045200 GO TO D-FAIL-ROUTINE-WRITE. IX1124.2 +045300 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE. IX1124.2 +045400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1124.2 +045500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1124.2 +045600 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1124.2 +045700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1124.2 +045800 GO TO D-FAIL-ROUTINE-EX. IX1124.2 +045900 D-FAIL-ROUTINE-WRITE. IX1124.2 +046000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1124.2 +046100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1124.2 +046200 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1124.2 +046300 MOVE SPACES TO COR-ANSI-REFERENCE. IX1124.2 +046400 D-FAIL-ROUTINE-EX. EXIT. IX1124.2 +046500 D-BAIL-OUT. IX1124.2 +046600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1124.2 +046700 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1124.2 +046800 D-BAIL-OUT-WRITE. IX1124.2 +046900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1124.2 +047000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1124.2 +047100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1124.2 +047200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1124.2 +047300 D-BAIL-OUT-EX. EXIT. IX1124.2 +047400 IX1124.2 +047500 END-DECL. IX1124.2 +047600 END DECLARATIVES. IX1124.2 +047700 IX1124.2 +047800 IX1124.2 +047900 CCVS1 SECTION. IX1124.2 +048000 OPEN-FILES. IX1124.2 +048100*P OPEN I-O RAW-DATA. IX1124.2 +048200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1124.2 +048300*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1124.2 +048400*P MOVE "ABORTED " TO C-ABORT. IX1124.2 +048500*P ADD 1 TO C-NO-OF-TESTS. IX1124.2 +048600*P ACCEPT C-DATE FROM DATE. IX1124.2 +048700*P ACCEPT C-TIME FROM TIME. IX1124.2 +048800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1124.2 +048900*PND-E-1. IX1124.2 +049000*P CLOSE RAW-DATA. IX1124.2 +049100 OPEN OUTPUT PRINT-FILE. IX1124.2 +049200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1124.2 +049300 MOVE SPACE TO TEST-RESULTS. IX1124.2 +049400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1124.2 +049500 MOVE ZERO TO REC-SKL-SUB. IX1124.2 +049600 PERFORM CCVS-INIT-FILE 9 TIMES. IX1124.2 +049700 CCVS-INIT-FILE. IX1124.2 +049800 ADD 1 TO REC-SKL-SUB. IX1124.2 +049900 MOVE FILE-RECORD-INFO-SKELETON IX1124.2 +050000 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1124.2 +050100 CCVS-INIT-EXIT. IX1124.2 +050200 GO TO CCVS1-EXIT. IX1124.2 +050300 CLOSE-FILES. IX1124.2 +050400*P OPEN I-O RAW-DATA. IX1124.2 +050500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1124.2 +050600*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1124.2 +050700*P MOVE "OK. " TO C-ABORT. IX1124.2 +050800*P MOVE PASS-COUNTER TO C-OK. IX1124.2 +050900*P MOVE ERROR-HOLD TO C-ALL. IX1124.2 +051000*P MOVE ERROR-COUNTER TO C-FAIL. IX1124.2 +051100*P MOVE DELETE-COUNTER TO C-DELETED. IX1124.2 +051200*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1124.2 +051300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1124.2 +051400*PND-E-2. IX1124.2 +051500*P CLOSE RAW-DATA. IX1124.2 +051600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1124.2 +051700 TERMINATE-CCVS. IX1124.2 +051800*S EXIT PROGRAM. IX1124.2 +051900*SERMINATE-CALL. IX1124.2 +052000 STOP RUN. IX1124.2 +052100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1124.2 +052200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1124.2 +052300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1124.2 +052400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1124.2 +052500 MOVE "****TEST DELETED****" TO RE-MARK. IX1124.2 +052600 PRINT-DETAIL. IX1124.2 +052700 IF REC-CT NOT EQUAL TO ZERO IX1124.2 +052800 MOVE "." TO PARDOT-X IX1124.2 +052900 MOVE REC-CT TO DOTVALUE. IX1124.2 +053000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1124.2 +053100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1124.2 +053200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1124.2 +053300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1124.2 +053400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1124.2 +053500 MOVE SPACE TO CORRECT-X. IX1124.2 +053600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1124.2 +053700 MOVE SPACE TO RE-MARK. IX1124.2 +053800 HEAD-ROUTINE. IX1124.2 +053900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +054000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +054100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1124.2 +054200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1124.2 +054300 COLUMN-NAMES-ROUTINE. IX1124.2 +054400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +054500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +054700 END-ROUTINE. IX1124.2 +054800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1124.2 +054900 END-RTN-EXIT. IX1124.2 +055000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +055100 END-ROUTINE-1. IX1124.2 +055200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1124.2 +055300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1124.2 +055400 ADD PASS-COUNTER TO ERROR-HOLD. IX1124.2 +055500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1124.2 +055600 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1124.2 +055700 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1124.2 +055800 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1124.2 +055900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1124.2 +056000 END-ROUTINE-12. IX1124.2 +056100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1124.2 +056200 IF ERROR-COUNTER IS EQUAL TO ZERO IX1124.2 +056300 MOVE "NO " TO ERROR-TOTAL IX1124.2 +056400 ELSE IX1124.2 +056500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1124.2 +056600 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1124.2 +056700 PERFORM WRITE-LINE. IX1124.2 +056800 END-ROUTINE-13. IX1124.2 +056900 IF DELETE-COUNTER IS EQUAL TO ZERO IX1124.2 +057000 MOVE "NO " TO ERROR-TOTAL ELSE IX1124.2 +057100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1124.2 +057200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1124.2 +057300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +057400 IF INSPECT-COUNTER EQUAL TO ZERO IX1124.2 +057500 MOVE "NO " TO ERROR-TOTAL IX1124.2 +057600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1124.2 +057700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1124.2 +057800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +057900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1124.2 +058000 WRITE-LINE. IX1124.2 +058100 ADD 1 TO RECORD-COUNT. IX1124.2 +058200 IF RECORD-COUNT GREATER 42 IX1124.2 +058300 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1124.2 +058400 MOVE SPACE TO DUMMY-RECORD IX1124.2 +058500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1124.2 +058600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1124.2 +058700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1124.2 +058800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1124.2 +058900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1124.2 +059000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1124.2 +059100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1124.2 +059200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1124.2 +059300 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1124.2 +059400 MOVE ZERO TO RECORD-COUNT. IX1124.2 +059500 PERFORM WRT-LN. IX1124.2 +059600 WRT-LN. IX1124.2 +059700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1124.2 +059800 MOVE SPACE TO DUMMY-RECORD. IX1124.2 +059900 BLANK-LINE-PRINT. IX1124.2 +060000 PERFORM WRT-LN. IX1124.2 +060100 FAIL-ROUTINE. IX1124.2 +060200 IF COMPUTED-X NOT EQUAL TO SPACE IX1124.2 +060300 GO TO FAIL-ROUTINE-WRITE. IX1124.2 +060400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1124.2 +060500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1124.2 +060600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1124.2 +060700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +060800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1124.2 +060900 GO TO FAIL-ROUTINE-EX. IX1124.2 +061000 FAIL-ROUTINE-WRITE. IX1124.2 +061100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1124.2 +061200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1124.2 +061300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1124.2 +061400 MOVE SPACES TO COR-ANSI-REFERENCE. IX1124.2 +061500 FAIL-ROUTINE-EX. EXIT. IX1124.2 +061600 BAIL-OUT. IX1124.2 +061700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1124.2 +061800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1124.2 +061900 BAIL-OUT-WRITE. IX1124.2 +062000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1124.2 +062100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1124.2 +062200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1124.2 +062300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1124.2 +062400 BAIL-OUT-EX. EXIT. IX1124.2 +062500 CCVS1-EXIT. IX1124.2 +062600 EXIT. IX1124.2 +062700 IX1124.2 +062800 SECT-IX112A-0003 SECTION. IX1124.2 +062900 SEQ-INIT-010. IX1124.2 +063000 MOVE "IX-VS2" TO XFILE-NAME (1). IX1124.2 +063100 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1124.2 +063200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1124.2 +063300 MOVE 000240 TO XRECORD-LENGTH (1). IX1124.2 +063400 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1124.2 +063500 MOVE 0002 TO XBLOCK-SIZE (1). IX1124.2 +063600 MOVE 000050 TO RECORDS-IN-FILE (1). IX1124.2 +063700 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1124.2 +063800 MOVE "S" TO XLABEL-TYPE (1). IX1124.2 +063900 MOVE 000001 TO XRECORD-NUMBER (1). IX1124.2 +064000 MOVE 0 TO COUNT-OF-RECS. IX1124.2 +064100 IX1124.2 +064200******************************************************************IX1124.2 +064300* TEST 1 *IX1124.2 +064400* OPEN OUTPUT ... 00 EXPECTED *IX1124.2 +064500* IX-3, 1.3.4 (1) a *IX1124.2 +064600* STATUS 00 CHECK ON OUTPUT FILE IX-VS2 *IX1124.2 +064700* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1124.2 +064800******************************************************************IX1124.2 +064900 OPN-INIT-GF-01-0. IX1124.2 +065000 ADD 1 TO TEST-NUMBER. IX1124.2 +065100 MOVE 1 TO STATUS-TEST-00. IX1124.2 +065200 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +065300 MOVE "OPEN OUTPUT: 00 EXP." TO FEATURE. IX1124.2 +065400 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1124.2 +065500 OPEN IX1124.2 +065600 OUTPUT IX-VS2. IX1124.2 +065700 IF IX-VS2-STATUS EQUAL TO "00" IX1124.2 +065800 GO TO OPN-PASS-GF-01-0. IX1124.2 +065900 OPN-FAIL-GF-01-0. IX1124.2 +066000 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1124.2 +066100 PERFORM FAIL. IX1124.2 +066200 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +066300 MOVE "00" TO CORRECT-X. IX1124.2 +066400 GO TO OPN-WRITE-GF-01-0. IX1124.2 +066500 OPN-PASS-GF-01-0. IX1124.2 +066600 PERFORM PASS. IX1124.2 +066700 OPN-WRITE-GF-01-0. IX1124.2 +066800 PERFORM PRINT-DETAIL. IX1124.2 +066900******************************************************************IX1124.2 +067000* TEST 2 *IX1124.2 +067100* WRITE 00 EXPECTED *IX1124.2 +067200* IX-3, 1.3.4 (1) a *IX1124.2 +067300* CREATING A INDEXED FILE WITH 50 RECORDS *IX1124.2 +067400* KEY: FROM 000000001 TO 000000050 *IX1124.2 +067500******************************************************************IX1124.2 +067600 WRI-INIT-GF-01-0. IX1124.2 +067700 ADD 1 TO TEST-NUMBER. IX1124.2 +067800 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +067900 MOVE 0 TO STATUS-TEST-00. IX1124.2 +068000 MOVE "WRITE: 00 EXPECTED" TO FEATURE. IX1124.2 +068100 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1124.2 +068200 WRI-TEST-GF-01-0. IX1124.2 +068300 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1124.2 +068400 MOVE GRP-0101 TO XRECORD-KEY (1). IX1124.2 +068500 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1124.2 +068600* THE VALUE OF THE ALTERNATE KEY IS 50 TIMES UNCHANGED *IX1124.2 +068700 MOVE FILE-RECORD-INFO (1) TO IX-VS2R1-F-G-240. IX1124.2 +068800 WRITE IX-VS2R1-F-G-240. IX1124.2 +068900 IF IX-VS2-STATUS NOT = "00" IX1124.2 +069000 MOVE 1 TO STATUS-TEST-00 IX1124.2 +069100 GO TO WRI-FAIL-GF-01-0. IX1124.2 +069200 IF XRECORD-NUMBER (1) EQUAL TO 50 IX1124.2 +069300 GO TO WRI-TEST-GF-01-1. IX1124.2 +069400 ADD 1 TO XRECORD-NUMBER (1). IX1124.2 +069500 GO TO WRI-TEST-GF-01-0. IX1124.2 +069600 WRI-TEST-GF-01-1. IX1124.2 +069700 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1124.2 +069800 GO TO WRI-PASS-GF-01-0. IX1124.2 +069900 MOVE "ERROR IN CREATING FILE" TO RE-MARK. IX1124.2 +070000 WRI-FAIL-GF-01-0. IX1124.2 +070100 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1124.2 +070200 PERFORM FAIL. IX1124.2 +070300 MOVE "RECORDS WRITTEN =" TO COMPUTED-A. IX1124.2 +070400 GO TO WRI-WRITE-GF-01-0. IX1124.2 +070500 WRI-PASS-GF-01-0. IX1124.2 +070600 PERFORM PASS. IX1124.2 +070700 WRI-WRITE-GF-01-0. IX1124.2 +070800 PERFORM PRINT-DETAIL. IX1124.2 +070900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IX1124.2 +071000 MOVE "CREATE FILE IX-VS2" TO FEATURE. IX1124.2 +071100 MOVE "WRI-TEST-GF-01-1" TO PAR-NAME. IX1124.2 +071200 MOVE COUNT-OF-RECS TO CORRECT-18V0. IX1124.2 +071300 PERFORM PRINT-DETAIL. IX1124.2 +071400 IX1124.2 +071500******************************************************************IX1124.2 +071600* TEST 3 *IX1124.2 +071700* WRITE (WRONG SEQUENCE) 21 EXPECTED *IX1124.2 +071800* IX-4, 1.3.4 (3) a *IX1124.2 +071900* KEY: 000000049 *IX1124.2 +072000******************************************************************IX1124.2 +072100 WRI-INIT-GF-02-0. IX1124.2 +072200 ADD 1 TO TEST-NUMBER. IX1124.2 +072300 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +072400 MOVE 0 TO STATUS-TEST-00. IX1124.2 +072500 MOVE "WRITE:WRONG SEQ 21EX" TO FEATURE. IX1124.2 +072600 MOVE "WRI-TEST-GF-02-0" TO PAR-NAME. IX1124.2 +072700 MOVE 49 TO XRECORD-NUMBER (1). IX1124.2 +072800 WRI-TEST-GF-02-0. IX1124.2 +072900 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1124.2 +073000 MOVE GRP-0101 TO XRECORD-KEY (1). IX1124.2 +073100 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1124.2 +073200 MOVE FILE-RECORD-INFO (1) TO IX-VS2R1-F-G-240. IX1124.2 +073300 WRITE IX-VS2R1-F-G-240 INVALID KEY GO TO WRI-TEST-GF-02-1. IX1124.2 +073400 WRI-TEST-GF-02-1. IX1124.2 +073500 IF IX-VS2-STATUS = "21" IX1124.2 +073600 GO TO WRI-PASS-GF-02-0. IX1124.2 +073700 WRI-FAIL-GF-02-0. IX1124.2 +073800 MOVE "IX-4, 1.3.4, (3) a. " TO RE-MARK. IX1124.2 +073900 PERFORM FAIL. IX1124.2 +074000 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +074100 MOVE "21" TO CORRECT-X. IX1124.2 +074200 GO TO WRI-WRITE-GF-02-0. IX1124.2 +074300 WRI-PASS-GF-02-0. IX1124.2 +074400 PERFORM PASS. IX1124.2 +074500 WRI-WRITE-GF-02-0. IX1124.2 +074600 PERFORM PRINT-DETAIL. IX1124.2 +074700 IX1124.2 +074800******************************************************************IX1124.2 +074900* TEST 4 *IX1124.2 +075000* CLOSE OUTPUT 00 EXPECTED *IX1124.2 +075100* IX-3, 1.3.4 (1) a *IX1124.2 +075200******************************************************************IX1124.2 +075300 CLO-INIT-GF-01-0. IX1124.2 +075400 ADD 1 TO TEST-NUMBER. IX1124.2 +075500 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +075600 MOVE "CLOSE OUTPUT:00 EXP." TO FEATURE. IX1124.2 +075700 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1124.2 +075800 CLO-TEST-GF-01-0. IX1124.2 +075900 CLOSE IX-VS2. IX1124.2 +076000 IF IX-VS2-STATUS = "00" IX1124.2 +076100 GO TO CLO-PASS-GF-01-0. IX1124.2 +076200 CLO-FAIL-GF-01-0. IX1124.2 +076300 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1124.2 +076400 PERFORM FAIL. IX1124.2 +076500 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +076600 MOVE "00" TO CORRECT-X. IX1124.2 +076700 GO TO CLO-WRITE-GF-01-0. IX1124.2 +076800 CLO-PASS-GF-01-0. IX1124.2 +076900 PERFORM PASS. IX1124.2 +077000 CLO-WRITE-GF-01-0. IX1124.2 +077100 PERFORM PRINT-DETAIL. IX1124.2 +077200 IX1124.2 +077300******************************************************************IX1124.2 +077400* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1124.2 +077500******************************************************************IX1124.2 +077600 IX1124.2 +077700******************************************************************IX1124.2 +077800* TEST 5 *IX1124.2 +077900* OPEN INPUT 00 EXPECTED *IX1124.2 +078000* IX-3, 1.3.4 (1) a *IX1124.2 +078100******************************************************************IX1124.2 +078200 OPN-INIT-GF-02-0. IX1124.2 +078300 ADD 1 TO TEST-NUMBER. IX1124.2 +078400 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +078500 MOVE "OPEN INPUT: 00 EXP." TO FEATURE. IX1124.2 +078600 MOVE "OPN-TEST-GF-02-0" TO PAR-NAME. IX1124.2 +078700 OPN-TEST-GF-02-0. IX1124.2 +078800 OPEN IX1124.2 +078900 INPUT IX-VS2. IX1124.2 +079000 IF IX-VS2-STATUS EQUAL TO "00" IX1124.2 +079100 GO TO OPN-PASS-GF-02-0. IX1124.2 +079200 OPN-FAIL-GF-02-0. IX1124.2 +079300 MOVE "IX-3, 1.3.4, (1) a." TO RE-MARK. IX1124.2 +079400 PERFORM FAIL. IX1124.2 +079500 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +079600 MOVE "00" TO CORRECT-X. IX1124.2 +079700 GO TO OPN-WRITE-GF-02-0. IX1124.2 +079800 OPN-PASS-GF-02-0. IX1124.2 +079900 PERFORM PASS. IX1124.2 +080000 OPN-WRITE-GF-02-0. IX1124.2 +080100 PERFORM PRINT-DETAIL. IX1124.2 +080200 IX1124.2 +080300******************************************************************IX1124.2 +080400* TEST 6 *IX1124.2 +080500* READ OO EXPECTED *IX1124.2 +080600* IX-3, 1.3.4 (1) a *IX1124.2 +080700******************************************************************IX1124.2 +080800 REA-INIT-F1-01-0. IX1124.2 +080900 ADD 1 TO TEST-NUMBER. IX1124.2 +081000 MOVE 1 TO STATUS-TEST-10. IX1124.2 +081100 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +081200 MOVE ZERO TO COUNT-OF-RECS. IX1124.2 +081300 MOVE ZERO TO PERM-ERRORS. IX1124.2 +081400 MOVE ZERO TO EOF-FLAG. IX1124.2 +081500 REA-TEST-F1-01-0. IX1124.2 +081600 READ IX-VS2. IX1124.2 +081700 MOVE "REA-TEST-F1-01-0" TO PAR-NAME. IX1124.2 +081800 MOVE "READ (USE): 00 EXP." TO FEATURE. IX1124.2 +081900 IF IX-VS2-STATUS = "00" IX1124.2 +082000 GO TO REA-PASS-F1-01-0. IX1124.2 +082100 REA-FAIL-F1-01-0. IX1124.2 +082200 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1124.2 +082300 MOVE "I-O STATUS IS NOT 00" TO COMPUTED-A. IX1124.2 +082400 MOVE "00" TO CORRECT-X. IX1124.2 +082500 PERFORM FAIL. IX1124.2 +082600 GO TO REA-WRITE-F1-01-0. IX1124.2 +082700 REA-PASS-F1-01-0. IX1124.2 +082800 PERFORM PASS. IX1124.2 +082900 REA-WRITE-F1-01-0. IX1124.2 +083000 PERFORM PRINT-DETAIL. IX1124.2 +083100 IX1124.2 +083200******************************************************************IX1124.2 +083300* TEST 7 *IX1124.2 +083400* REWRITE (WITH WRONG RECORD LENGTH (SHORTER)) *IX1124.2 +083500* IX-5, 1.3.4 (5) d 1 & 2 *IX1124.2 +083600* FILE STATUS 00 OR 44 EXPECTED *IX1124.2 +083700* KEY: 000000005 *IX1124.2 +083800******************************************************************IX1124.2 +083900 RWR-INIT-GF-01-0. IX1124.2 +084000 ADD 1 TO TEST-NUMBER. IX1124.2 +084100 CLOSE IX-VS2. IX1124.2 +084200 OPEN I-O IX-VS2. IX1124.2 +084300 MOVE SPACES TO IX-VS2-STATUS. IX1124.2 +084400 MOVE 0 TO STATUS-TEST-00. IX1124.2 +084500 MOVE "RWRTE SH. 00/44 EXP." TO FEATURE. IX1124.2 +084600 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1124.2 +084700 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +084800 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +084900 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +085000 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +085100 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1124.2 +085200 RWR-TEST-GF-01-0. IX1124.2 +085300 MOVE "WRONG RECORD LENGTH ( SHORTER)" TO IX-VS2-REC-LONG. IX1124.2 +085400 REWRITE IX-VS2R1-F-G-200. IX1124.2 +085500 RWR-TEST-GF-01-1. IX1124.2 +085600 IF IX-VS2-STATUS = "00" IX1124.2 +085700 GO TO RWR-PASS-GF-01-0. IX1124.2 +085800 IF IX-VS2-STATUS = "44" IX1124.2 +085900 GO TO RWR-PASS-GF-01-0. IX1124.2 +086000 RWR-FAIL-GF-01-0. IX1124.2 +086100 MOVE "IX-5, 1.3.4, (5) d 1 & 2; SHORT RECORD" TO RE-MARK. IX1124.2 +086200 PERFORM FAIL. IX1124.2 +086300 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1124.2 +086400 MOVE "00 OR 44" TO CORRECT-X. IX1124.2 +086500 GO TO RWR-WRITE-GF-01-0. IX1124.2 +086600 RWR-PASS-GF-01-0. IX1124.2 +086700 PERFORM PASS. IX1124.2 +086800 RWR-WRITE-GF-01-0. IX1124.2 +086900 PERFORM PRINT-DETAIL. IX1124.2 +087000 IX1124.2 +087100 TERMINATE-ROUTINE. IX1124.2 +087200 EXIT. IX1124.2 +087300 IX1124.2 +087400 CCVS-EXIT SECTION. IX1124.2 +087500 CCVS-999999. IX1124.2 +087600 GO TO CLOSE-FILES. IX1124.2 diff --git a/tests/cobol85/IX/IX113A.CBL b/tests/cobol85/IX/IX113A.CBL new file mode 100755 index 00000000..c8d6dab6 --- /dev/null +++ b/tests/cobol85/IX/IX113A.CBL @@ -0,0 +1,769 @@ +000100 IDENTIFICATION DIVISION. IX1134.2 +000200 PROGRAM-ID. IX1134.2 +000300 IX113A. IX1134.2 +000400**************************************************************** IX1134.2 +000500* * IX1134.2 +000600* VALIDATION FOR:- * IX1134.2 +000700* * IX1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1134.2 +000900* * IX1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1134.2 +001100* * IX1134.2 +001200**************************************************************** IX1134.2 +001300* IX1134.2 +001400* 1. THE ROUTINE CREATES THE MASS STORAGE FILE IX-FS3 IX1134.2 +001500* CONTAINING 50 RECORDS. EACH BLOCK CONTAINS 2 RECORDS, IX1134.2 +001600* EACH RECORD CONTAINS 240 CHARACTERS, ORGANIZATION IS IX1134.2 +001700* INDEXED, ACCESS IS SEQUENTIAL. IX1134.2 +001800* IX1134.2 +001900* 2. THE ROUTINE READS THE CREATED FILE,VERIFIES IT AND *IX1134.2 +002000* CHECKS THE FILE STATUS CODES: IX1134.2 +002100* 00 - AFTER OPEN OUTPUT IX1134.2 +002200* 00 - AFTER WRITE IX1134.2 +002300* 00 - AFTER CLOSE OUTPUT IX1134.2 +002400* 42 - AFTER CLOSE OUTPUT IX1134.2 +002500* IX1134.2 +002600* 4. X-CARDS USED IN THIS PROGRAM: IX1134.2 +002700* IX1134.2 +002800* XXXXX024 IX1134.2 +002900* XXXXX055. IX1134.2 +003000* P XXXXX062. IX1134.2 +003100* XXXXX082. IX1134.2 +003200* XXXXX083. IX1134.2 +003300* C XXXXX084 IX1134.2 +003400* IX1134.2 +003500* IX1134.2 +003600 ENVIRONMENT DIVISION. IX1134.2 +003700 CONFIGURATION SECTION. IX1134.2 +003800 SOURCE-COMPUTER. IX1134.2 +003900 Linux. IX1134.2 +004000 OBJECT-COMPUTER. IX1134.2 +004100 Linux. IX1134.2 +004200 INPUT-OUTPUT SECTION. IX1134.2 +004300 FILE-CONTROL. IX1134.2 +004400*P SELECT RAW-DATA ASSIGN TO IX1134.2 +004500*P "XXXXX062" IX1134.2 +004600*P ORGANIZATION IS INDEXED IX1134.2 +004700*P ACCESS MODE IS RANDOM IX1134.2 +004800*P RECORD KEY IS RAW-DATA-KEY. IX1134.2 +004900* IX1134.2 +005000 SELECT PRINT-FILE ASSIGN TO IX1134.2 +005100 "report.log". IX1134.2 +005200* IX1134.2 +005300 SELECT IX-FS3 ASSIGN IX1134.2 +005400 "XXXXX024" IX1134.2 +005500 ORGANIZATION IS INDEXED IX1134.2 +005600 ACCESS MODE IS SEQUENTIAL IX1134.2 +005700 RECORD KEY IS IX-FS3-KEY IX1134.2 +005800 FILE STATUS IS IX-FS3-STATUS. IX1134.2 +005900 IX1134.2 +006000 DATA DIVISION. IX1134.2 +006100 IX1134.2 +006200 FILE SECTION. IX1134.2 +006300*P IX1134.2 +006400*PD RAW-DATA. IX1134.2 +006500*P IX1134.2 +006600*P1 RAW-DATA-SATZ. IX1134.2 +006700*P 05 RAW-DATA-KEY PIC X(6). IX1134.2 +006800*P 05 C-DATE PIC 9(6). IX1134.2 +006900*P 05 C-TIME PIC 9(8). IX1134.2 +007000*P 05 C-NO-OF-TESTS PIC 99. IX1134.2 +007100*P 05 C-OK PIC 999. IX1134.2 +007200*P 05 C-ALL PIC 999. IX1134.2 +007300*P 05 C-FAIL PIC 999. IX1134.2 +007400*P 05 C-DELETED PIC 999. IX1134.2 +007500*P 05 C-INSPECT PIC 999. IX1134.2 +007600*P 05 C-NOTE PIC X(13). IX1134.2 +007700*P 05 C-INDENT PIC X. IX1134.2 +007800*P 05 C-ABORT PIC X(8). IX1134.2 +007900 IX1134.2 +008000 FD PRINT-FILE. IX1134.2 +008100 IX1134.2 +008200 01 PRINT-REC PIC X(120). IX1134.2 +008300 IX1134.2 +008400 01 DUMMY-RECORD PIC X(120). IX1134.2 +008500 IX1134.2 +008600 FD IX-FS3 IX1134.2 +008700*C DATA RECORDS IX-FS3R1-F-G-240 IX1134.2 +008800*C LABEL RECORD STANDARD IX1134.2 +008900 RECORD 240 IX1134.2 +009000 BLOCK CONTAINS 2 RECORDS. IX1134.2 +009100 IX1134.2 +009200 01 IX-FS3R1-F-G-240. IX1134.2 +009300 05 IX-FS3-REC-120 PIC X(120). IX1134.2 +009400 05 IX-FS3-REC-120-240. IX1134.2 +009500 10 FILLER PIC X(8). IX1134.2 +009600 10 IX-FS3-KEY PIC X(29). IX1134.2 +009700 10 FILLER PIC X(9). IX1134.2 +009800 10 IX-FS3-ALTER-KEY PIC X(29). IX1134.2 +009900 10 FILLER PIC X(45). IX1134.2 +010000 IX1134.2 +010100 IX1134.2 +010200 WORKING-STORAGE SECTION. IX1134.2 +010300 IX1134.2 +010400 01 GRP-0101. IX1134.2 +010500 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1134.2 +010600 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1134.2 +010700 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1134.2 +010800 IX1134.2 +010900 01 GRP-0102. IX1134.2 +011000 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1134.2 +011100 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1134.2 +011200 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1134.2 +011300 IX1134.2 +011400 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1134.2 +011500 IX1134.2 +011600 01 EOF-FLAG PIC 9 VALUE ZERO. IX1134.2 +011700 IX1134.2 +011800 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1134.2 +011900 IX1134.2 +012000 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1134.2 +012100 IX1134.2 +012200 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1134.2 +012300 IX1134.2 +012400 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1134.2 +012500 IX1134.2 +012600 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1134.2 +012700 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1134.2 +012800 IX1134.2 +012900 01 IX-FS3-STATUS. IX1134.2 +013000 05 IX-FS3-STAT1 PIC X. IX1134.2 +013100 05 IX-FS3-STAT2 PIC X. IX1134.2 +013200 IX1134.2 +013300 01 COUNT-OF-RECS PIC 9(5). IX1134.2 +013400 IX1134.2 +013500 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1134.2 +013600 IX1134.2 +013700 01 FILE-RECORD-INFORMATION-REC. IX1134.2 +013800 05 FILE-RECORD-INFO-SKELETON. IX1134.2 +013900 10 FILLER PIC X(48) VALUE IX1134.2 +014000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1134.2 +014100 10 FILLER PIC X(46) VALUE IX1134.2 +014200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1134.2 +014300 10 FILLER PIC X(26) VALUE IX1134.2 +014400 ",LFIL=000000,ORG= ,LBLR= ". IX1134.2 +014500 10 FILLER PIC X(37) VALUE IX1134.2 +014600 ",RECKEY= ". IX1134.2 +014700 10 FILLER PIC X(38) VALUE IX1134.2 +014800 ",ALTKEY1= ". IX1134.2 +014900 10 FILLER PIC X(38) VALUE IX1134.2 +015000 ",ALTKEY2= ". IX1134.2 +015100 10 FILLER PIC X(7) VALUE SPACE. IX1134.2 +015200 05 FILE-RECORD-INFO OCCURS 10. IX1134.2 +015300 10 FILE-RECORD-INFO-P1-120. IX1134.2 +015400 15 FILLER PIC X(5). IX1134.2 +015500 15 XFILE-NAME PIC X(6). IX1134.2 +015600 15 FILLER PIC X(8). IX1134.2 +015700 15 XRECORD-NAME PIC X(6). IX1134.2 +015800 15 FILLER PIC X(1). IX1134.2 +015900 15 REELUNIT-NUMBER PIC 9(1). IX1134.2 +016000 15 FILLER PIC X(7). IX1134.2 +016100 15 XRECORD-NUMBER PIC 9(6). IX1134.2 +016200 15 FILLER PIC X(6). IX1134.2 +016300 15 UPDATE-NUMBER PIC 9(2). IX1134.2 +016400 15 FILLER PIC X(5). IX1134.2 +016500 15 ODO-NUMBER PIC 9(4). IX1134.2 +016600 15 FILLER PIC X(5). IX1134.2 +016700 15 XPROGRAM-NAME PIC X(5). IX1134.2 +016800 15 FILLER PIC X(7). IX1134.2 +016900 15 XRECORD-LENGTH PIC 9(6). IX1134.2 +017000 15 FILLER PIC X(7). IX1134.2 +017100 15 CHARS-OR-RECORDS PIC X(2). IX1134.2 +017200 15 FILLER PIC X(1). IX1134.2 +017300 15 XBLOCK-SIZE PIC 9(4). IX1134.2 +017400 15 FILLER PIC X(6). IX1134.2 +017500 15 RECORDS-IN-FILE PIC 9(6). IX1134.2 +017600 15 FILLER PIC X(5). IX1134.2 +017700 15 XFILE-ORGANIZATION PIC X(2). IX1134.2 +017800 15 FILLER PIC X(6). IX1134.2 +017900 15 XLABEL-TYPE PIC X(1). IX1134.2 +018000 10 FILE-RECORD-INFO-P121-240. IX1134.2 +018100 15 FILLER PIC X(8). IX1134.2 +018200 15 XRECORD-KEY PIC X(29). IX1134.2 +018300 15 FILLER PIC X(9). IX1134.2 +018400 15 ALTERNATE-KEY1 PIC X(29). IX1134.2 +018500 15 FILLER PIC X(9). IX1134.2 +018600 15 ALTERNATE-KEY2 PIC X(29). IX1134.2 +018700 15 FILLER PIC X(7). IX1134.2 +018800 IX1134.2 +018900 01 TEST-RESULTS. IX1134.2 +019000 02 FILLER PIC X VALUE SPACE. IX1134.2 +019100 02 FEATURE PIC X(20) VALUE SPACE. IX1134.2 +019200 02 FILLER PIC X VALUE SPACE. IX1134.2 +019300 02 P-OR-F PIC X(5) VALUE SPACE. IX1134.2 +019400 02 FILLER PIC X VALUE SPACE. IX1134.2 +019500 02 PAR-NAME. IX1134.2 +019600 03 FILLER PIC X(19) VALUE SPACE. IX1134.2 +019700 03 PARDOT-X PIC X VALUE SPACE. IX1134.2 +019800 03 DOTVALUE PIC 99 VALUE ZERO. IX1134.2 +019900 02 FILLER PIC X(8) VALUE SPACE. IX1134.2 +020000 02 RE-MARK PIC X(61). IX1134.2 +020100 01 TEST-COMPUTED. IX1134.2 +020200 02 FILLER PIC X(30) VALUE SPACE. IX1134.2 +020300 02 FILLER PIC X(17) VALUE IX1134.2 +020400 " COMPUTED=". IX1134.2 +020500 02 COMPUTED-X. IX1134.2 +020600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1134.2 +020700 03 COMPUTED-N REDEFINES COMPUTED-A IX1134.2 +020800 PIC -9(9).9(9). IX1134.2 +020900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1134.2 +021000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1134.2 +021100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1134.2 +021200 03 CM-18V0 REDEFINES COMPUTED-A. IX1134.2 +021300 04 COMPUTED-18V0 PIC -9(18). IX1134.2 +021400 04 FILLER PIC X. IX1134.2 +021500 03 FILLER PIC X(50) VALUE SPACE. IX1134.2 +021600 01 TEST-CORRECT. IX1134.2 +021700 02 FILLER PIC X(30) VALUE SPACE. IX1134.2 +021800 02 FILLER PIC X(17) VALUE " CORRECT =". IX1134.2 +021900 02 CORRECT-X. IX1134.2 +022000 03 CORRECT-A PIC X(20) VALUE SPACE. IX1134.2 +022100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1134.2 +022200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1134.2 +022300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1134.2 +022400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1134.2 +022500 03 CR-18V0 REDEFINES CORRECT-A. IX1134.2 +022600 04 CORRECT-18V0 PIC -9(18). IX1134.2 +022700 04 FILLER PIC X. IX1134.2 +022800 03 FILLER PIC X(2) VALUE SPACE. IX1134.2 +022900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1134.2 +023000 01 CCVS-C-1. IX1134.2 +023100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1134.2 +023200- "SS PARAGRAPH-NAME IX1134.2 +023300- " REMARKS". IX1134.2 +023400 02 FILLER PIC X(20) VALUE SPACE. IX1134.2 +023500 01 CCVS-C-2. IX1134.2 +023600 02 FILLER PIC X VALUE SPACE. IX1134.2 +023700 02 FILLER PIC X(6) VALUE "TESTED". IX1134.2 +023800 02 FILLER PIC X(15) VALUE SPACE. IX1134.2 +023900 02 FILLER PIC X(4) VALUE "FAIL". IX1134.2 +024000 02 FILLER PIC X(94) VALUE SPACE. IX1134.2 +024100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1134.2 +024200 01 REC-CT PIC 99 VALUE ZERO. IX1134.2 +024300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1134.2 +024400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1134.2 +024500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1134.2 +024600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1134.2 +024700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1134.2 +024800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1134.2 +024900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1134.2 +025000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1134.2 +025100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1134.2 +025200 01 CCVS-H-1. IX1134.2 +025300 02 FILLER PIC X(39) VALUE SPACES. IX1134.2 +025400 02 FILLER PIC X(42) VALUE IX1134.2 +025500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1134.2 +025600 02 FILLER PIC X(39) VALUE SPACES. IX1134.2 +025700 01 CCVS-H-2A. IX1134.2 +025800 02 FILLER PIC X(40) VALUE SPACE. IX1134.2 +025900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1134.2 +026000 02 FILLER PIC XXXX VALUE IX1134.2 +026100 "4.2 ". IX1134.2 +026200 02 FILLER PIC X(28) VALUE IX1134.2 +026300 " COPY - NOT FOR DISTRIBUTION". IX1134.2 +026400 02 FILLER PIC X(41) VALUE SPACE. IX1134.2 +026500 IX1134.2 +026600 01 CCVS-H-2B. IX1134.2 +026700 02 FILLER PIC X(15) VALUE IX1134.2 +026800 "TEST RESULT OF ". IX1134.2 +026900 02 TEST-ID PIC X(9). IX1134.2 +027000 02 FILLER PIC X(4) VALUE IX1134.2 +027100 " IN ". IX1134.2 +027200 02 FILLER PIC X(12) VALUE IX1134.2 +027300 " HIGH ". IX1134.2 +027400 02 FILLER PIC X(22) VALUE IX1134.2 +027500 " LEVEL VALIDATION FOR ". IX1134.2 +027600 02 FILLER PIC X(58) VALUE IX1134.2 +027700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1134.2 +027800 01 CCVS-H-3. IX1134.2 +027900 02 FILLER PIC X(34) VALUE IX1134.2 +028000 " FOR OFFICIAL USE ONLY ". IX1134.2 +028100 02 FILLER PIC X(58) VALUE IX1134.2 +028200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1134.2 +028300 02 FILLER PIC X(28) VALUE IX1134.2 +028400 " COPYRIGHT 1985 ". IX1134.2 +028500 01 CCVS-E-1. IX1134.2 +028600 02 FILLER PIC X(52) VALUE SPACE. IX1134.2 +028700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1134.2 +028800 02 ID-AGAIN PIC X(9). IX1134.2 +028900 02 FILLER PIC X(45) VALUE SPACES. IX1134.2 +029000 01 CCVS-E-2. IX1134.2 +029100 02 FILLER PIC X(31) VALUE SPACE. IX1134.2 +029200 02 FILLER PIC X(21) VALUE SPACE. IX1134.2 +029300 02 CCVS-E-2-2. IX1134.2 +029400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1134.2 +029500 03 FILLER PIC X VALUE SPACE. IX1134.2 +029600 03 ENDER-DESC PIC X(44) VALUE IX1134.2 +029700 "ERRORS ENCOUNTERED". IX1134.2 +029800 01 CCVS-E-3. IX1134.2 +029900 02 FILLER PIC X(22) VALUE IX1134.2 +030000 " FOR OFFICIAL USE ONLY". IX1134.2 +030100 02 FILLER PIC X(12) VALUE SPACE. IX1134.2 +030200 02 FILLER PIC X(58) VALUE IX1134.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1134.2 +030400 02 FILLER PIC X(13) VALUE SPACE. IX1134.2 +030500 02 FILLER PIC X(15) VALUE IX1134.2 +030600 " COPYRIGHT 1985". IX1134.2 +030700 01 CCVS-E-4. IX1134.2 +030800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1134.2 +030900 02 FILLER PIC X(4) VALUE " OF ". IX1134.2 +031000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1134.2 +031100 02 FILLER PIC X(40) VALUE IX1134.2 +031200 " TESTS WERE EXECUTED SUCCESSFULLY". IX1134.2 +031300 01 XXINFO. IX1134.2 +031400 02 FILLER PIC X(19) VALUE IX1134.2 +031500 "*** INFORMATION ***". IX1134.2 +031600 02 INFO-TEXT. IX1134.2 +031700 04 FILLER PIC X(8) VALUE SPACE. IX1134.2 +031800 04 XXCOMPUTED PIC X(20). IX1134.2 +031900 04 FILLER PIC X(5) VALUE SPACE. IX1134.2 +032000 04 XXCORRECT PIC X(20). IX1134.2 +032100 02 INF-ANSI-REFERENCE PIC X(48). IX1134.2 +032200 01 HYPHEN-LINE. IX1134.2 +032300 02 FILLER PIC IS X VALUE IS SPACE. IX1134.2 +032400 02 FILLER PIC IS X(65) VALUE IS "************************IX1134.2 +032500- "*****************************************". IX1134.2 +032600 02 FILLER PIC IS X(54) VALUE IS "************************IX1134.2 +032700- "******************************". IX1134.2 +032800 01 TEST-NO PIC 99. IX1134.2 +032900 01 CCVS-PGM-ID PIC X(9) VALUE IX1134.2 +033000 "IX113A". IX1134.2 +033100 PROCEDURE DIVISION. IX1134.2 +033200 DECLARATIVES. IX1134.2 +033300 IX1134.2 +033400 SECT-IX105-0002 SECTION. IX1134.2 +033500 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1134.2 +033600 INPUT-PROCESS. IX1134.2 +033700 IF TEST-NO = 5 IX1134.2 +033800 GO TO D-C-TEST-GF-02-1. IX1134.2 +033900 IF STATUS-TEST-10 EQUAL TO 1 IX1134.2 +034000 IF IX-FS3-STAT1 EQUAL TO "1" IX1134.2 +034100 MOVE 1 TO EOF-FLAG IX1134.2 +034200 ELSE IX1134.2 +034300 IF IX-FS3-STAT1 GREATER THAN "1" IX1134.2 +034400 MOVE 1 TO PERM-ERRORS. IX1134.2 +034500 GO TO DECL-EXIT. IX1134.2 +034600 D-C-TEST-GF-02-1. IX1134.2 +034700 IF IX-FS3-STATUS EQUAL TO "42" IX1134.2 +034800 GO TO D-C-PASS-GF-02-0. IX1134.2 +034900 D-C-FAIL-GF-02-0. IX1134.2 +035000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1134.2 +035100 MOVE "42" TO CORRECT-X. IX1134.2 +035200 MOVE "IX-5, 1.3.4, (5) B" TO RE-MARK. IX1134.2 +035300 PERFORM D-FAIL. IX1134.2 +035400 GO TO D-C-WRITE-GF-02-0. IX1134.2 +035500 D-C-PASS-GF-02-0. IX1134.2 +035600 PERFORM D-PASS. IX1134.2 +035700 D-C-WRITE-GF-02-0. IX1134.2 +035800 PERFORM D-PRINT-DETAIL. IX1134.2 +035900 D-CLOSE-FILES. IX1134.2 +036000*P OPEN I-O RAW-DATA. IX1134.2 +036100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1134.2 +036200*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1134.2 +036300*P MOVE "OK. " TO C-ABORT. IX1134.2 +036400*P MOVE PASS-COUNTER TO C-OK. IX1134.2 +036500*P MOVE ERROR-HOLD TO C-ALL. IX1134.2 +036600*P MOVE ERROR-COUNTER TO C-FAIL. IX1134.2 +036700*P MOVE DELETE-COUNTER TO C-DELETED. IX1134.2 +036800*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1134.2 +036900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1134.2 +037000*P-END-E-2. IX1134.2 +037100*P CLOSE RAW-DATA. IX1134.2 +037200 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1134.2 +037300 CLOSE PRINT-FILE. IX1134.2 +037400 D-TERMINATE-CCVS. IX1134.2 +037500*S EXIT PROGRAM. IX1134.2 +037600*S-TERMINATE-CALL. IX1134.2 +037700 STOP RUN. IX1134.2 +037800 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1134.2 +037900 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1134.2 +038000 D-PRINT-DETAIL. IX1134.2 +038100 IF REC-CT NOT EQUAL TO ZERO IX1134.2 +038200 MOVE "." TO PARDOT-X IX1134.2 +038300 MOVE REC-CT TO DOTVALUE. IX1134.2 +038400 MOVE TEST-RESULTS TO PRINT-REC. IX1134.2 +038500 PERFORM D-WRITE-LINE. IX1134.2 +038600 IF P-OR-F EQUAL TO "FAIL*" IX1134.2 +038700 PERFORM D-WRITE-LINE IX1134.2 +038800 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1134.2 +038900 ELSE IX1134.2 +039000 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1134.2 +039100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1134.2 +039200 MOVE SPACE TO CORRECT-X. IX1134.2 +039300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1134.2 +039400 MOVE SPACE TO RE-MARK. IX1134.2 +039500 D-END-ROUTINE. IX1134.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1134.2 +039700 PERFORM D-WRITE-LINE 5 TIMES. IX1134.2 +039800 D-END-RTN-EXIT. IX1134.2 +039900 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1134.2 +040000 PERFORM D-WRITE-LINE 2 TIMES. IX1134.2 +040100 D-END-ROUTINE-1. IX1134.2 +040200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1134.2 +040300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1134.2 +040400 ADD PASS-COUNTER TO ERROR-HOLD. IX1134.2 +040500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1134.2 +040600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1134.2 +040700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1134.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1134.2 +040900 D-END-ROUTINE-12. IX1134.2 +041000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1134.2 +041100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1134.2 +041200 MOVE "NO " TO ERROR-TOTAL IX1134.2 +041300 ELSE IX1134.2 +041400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1134.2 +041500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1134.2 +041600 PERFORM D-WRITE-LINE. IX1134.2 +041700 D-END-ROUTINE-13. IX1134.2 +041800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1134.2 +041900 MOVE "NO " TO ERROR-TOTAL ELSE IX1134.2 +042000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1134.2 +042100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1134.2 +042200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1134.2 +042300 PERFORM D-WRITE-LINE. IX1134.2 +042400 IF INSPECT-COUNTER EQUAL TO ZERO IX1134.2 +042500 MOVE "NO " TO ERROR-TOTAL IX1134.2 +042600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1134.2 +042700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1134.2 +042800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1134.2 +042900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1134.2 +043000 D-WRITE-LINE. IX1134.2 +043100 ADD 1 TO RECORD-COUNT. IX1134.2 +043200 IF RECORD-COUNT GREATER 42 IX1134.2 +043300 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1134.2 +043400 MOVE SPACE TO DUMMY-RECORD IX1134.2 +043500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1134.2 +043600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1134.2 +043700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1134.2 +043800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1134.2 +043900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1134.2 +044000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1134.2 +044100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1134.2 +044200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1134.2 +044300 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1134.2 +044400 MOVE ZERO TO RECORD-COUNT. IX1134.2 +044500 PERFORM D-WRT-LN. IX1134.2 +044600 D-WRT-LN. IX1134.2 +044700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1134.2 +044800 MOVE SPACE TO DUMMY-RECORD. IX1134.2 +044900 D-FAIL-ROUTINE. IX1134.2 +045000 IF COMPUTED-X NOT EQUAL TO SPACE IX1134.2 +045100 GO TO D-FAIL-ROUTINE-WRITE. IX1134.2 +045200 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1134.2 +045300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1134.2 +045400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1134.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1134.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1134.2 +045700 GO TO D-FAIL-ROUTINE-EX. IX1134.2 +045800 D-FAIL-ROUTINE-WRITE. IX1134.2 +045900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1134.2 +046000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1134.2 +046100 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1134.2 +046200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1134.2 +046300 D-FAIL-ROUTINE-EX. EXIT. IX1134.2 +046400 D-BAIL-OUT. IX1134.2 +046500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1134.2 +046600 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1134.2 +046700 D-BAIL-OUT-WRITE. IX1134.2 +046800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1134.2 +046900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1134.2 +047000 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1134.2 +047100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1134.2 +047200 D-BAIL-OUT-EX. EXIT. IX1134.2 +047300 DECL-EXIT. EXIT. IX1134.2 +047400 END DECLARATIVES. IX1134.2 +047500 IX1134.2 +047600 IX1134.2 +047700 CCVS1 SECTION. IX1134.2 +047800 OPEN-FILES. IX1134.2 +047900*P OPEN I-O RAW-DATA. IX1134.2 +048000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1134.2 +048100*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1134.2 +048200*P MOVE "ABORTED " TO C-ABORT. IX1134.2 +048300*P ADD 1 TO C-NO-OF-TESTS. IX1134.2 +048400*P ACCEPT C-DATE FROM DATE. IX1134.2 +048500*P ACCEPT C-TIME FROM TIME. IX1134.2 +048600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1134.2 +048700*PND-E-1. IX1134.2 +048800*P CLOSE RAW-DATA. IX1134.2 +048900 OPEN OUTPUT PRINT-FILE. IX1134.2 +049000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1134.2 +049100 MOVE SPACE TO TEST-RESULTS. IX1134.2 +049200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1134.2 +049300 MOVE ZERO TO REC-SKL-SUB. IX1134.2 +049400 PERFORM CCVS-INIT-FILE 9 TIMES. IX1134.2 +049500 CCVS-INIT-FILE. IX1134.2 +049600 ADD 1 TO REC-SKL-SUB. IX1134.2 +049700 MOVE FILE-RECORD-INFO-SKELETON IX1134.2 +049800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1134.2 +049900 CCVS-INIT-EXIT. IX1134.2 +050000 GO TO CCVS1-EXIT. IX1134.2 +050100 CLOSE-FILES. IX1134.2 +050200*P OPEN I-O RAW-DATA. IX1134.2 +050300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1134.2 +050400*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1134.2 +050500*P MOVE "OK. " TO C-ABORT. IX1134.2 +050600*P MOVE PASS-COUNTER TO C-OK. IX1134.2 +050700*P MOVE ERROR-HOLD TO C-ALL. IX1134.2 +050800*P MOVE ERROR-COUNTER TO C-FAIL. IX1134.2 +050900*P MOVE DELETE-COUNTER TO C-DELETED. IX1134.2 +051000*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1134.2 +051100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1134.2 +051200*PND-E-2. IX1134.2 +051300*P CLOSE RAW-DATA. IX1134.2 +051400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1134.2 +051500 TERMINATE-CCVS. IX1134.2 +051600*S EXIT PROGRAM. IX1134.2 +051700*SERMINATE-CALL. IX1134.2 +051800 STOP RUN. IX1134.2 +051900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1134.2 +052000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1134.2 +052100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1134.2 +052200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1134.2 +052300 MOVE "****TEST DELETED****" TO RE-MARK. IX1134.2 +052400 PRINT-DETAIL. IX1134.2 +052500 IF REC-CT NOT EQUAL TO ZERO IX1134.2 +052600 MOVE "." TO PARDOT-X IX1134.2 +052700 MOVE REC-CT TO DOTVALUE. IX1134.2 +052800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1134.2 +052900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1134.2 +053000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1134.2 +053100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1134.2 +053200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1134.2 +053300 MOVE SPACE TO CORRECT-X. IX1134.2 +053400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1134.2 +053500 MOVE SPACE TO RE-MARK. IX1134.2 +053600 HEAD-ROUTINE. IX1134.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1134.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1134.2 +054100 COLUMN-NAMES-ROUTINE. IX1134.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +054500 END-ROUTINE. IX1134.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1134.2 +054700 END-RTN-EXIT. IX1134.2 +054800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +054900 END-ROUTINE-1. IX1134.2 +055000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1134.2 +055100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1134.2 +055200 ADD PASS-COUNTER TO ERROR-HOLD. IX1134.2 +055300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1134.2 +055400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1134.2 +055500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1134.2 +055600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1134.2 +055700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1134.2 +055800 END-ROUTINE-12. IX1134.2 +055900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1134.2 +056000 IF ERROR-COUNTER IS EQUAL TO ZERO IX1134.2 +056100 MOVE "NO " TO ERROR-TOTAL IX1134.2 +056200 ELSE IX1134.2 +056300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1134.2 +056400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1134.2 +056500 PERFORM WRITE-LINE. IX1134.2 +056600 END-ROUTINE-13. IX1134.2 +056700 IF DELETE-COUNTER IS EQUAL TO ZERO IX1134.2 +056800 MOVE "NO " TO ERROR-TOTAL ELSE IX1134.2 +056900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1134.2 +057000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1134.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +057200 IF INSPECT-COUNTER EQUAL TO ZERO IX1134.2 +057300 MOVE "NO " TO ERROR-TOTAL IX1134.2 +057400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1134.2 +057500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1134.2 +057600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +057700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1134.2 +057800 WRITE-LINE. IX1134.2 +057900 ADD 1 TO RECORD-COUNT. IX1134.2 +058000 IF RECORD-COUNT GREATER 42 IX1134.2 +058100 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1134.2 +058200 MOVE SPACE TO DUMMY-RECORD IX1134.2 +058300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1134.2 +058400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1134.2 +058500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1134.2 +058600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1134.2 +058700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1134.2 +058800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1134.2 +058900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1134.2 +059000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1134.2 +059100 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1134.2 +059200 MOVE ZERO TO RECORD-COUNT. IX1134.2 +059300 PERFORM WRT-LN. IX1134.2 +059400 WRT-LN. IX1134.2 +059500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1134.2 +059600 MOVE SPACE TO DUMMY-RECORD. IX1134.2 +059700 BLANK-LINE-PRINT. IX1134.2 +059800 PERFORM WRT-LN. IX1134.2 +059900 FAIL-ROUTINE. IX1134.2 +060000 IF COMPUTED-X NOT EQUAL TO SPACE IX1134.2 +060100 GO TO FAIL-ROUTINE-WRITE. IX1134.2 +060200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1134.2 +060300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1134.2 +060400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1134.2 +060500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +060600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1134.2 +060700 GO TO FAIL-ROUTINE-EX. IX1134.2 +060800 FAIL-ROUTINE-WRITE. IX1134.2 +060900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1134.2 +061000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1134.2 +061100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1134.2 +061200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1134.2 +061300 FAIL-ROUTINE-EX. EXIT. IX1134.2 +061400 BAIL-OUT. IX1134.2 +061500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1134.2 +061600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1134.2 +061700 BAIL-OUT-WRITE. IX1134.2 +061800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1134.2 +061900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1134.2 +062000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1134.2 +062100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1134.2 +062200 BAIL-OUT-EX. EXIT. IX1134.2 +062300 CCVS1-EXIT. IX1134.2 +062400 EXIT. IX1134.2 +062500 IX1134.2 +062600 SECT-IX113A-0003 SECTION. IX1134.2 +062700 SEQ-INIT-010. IX1134.2 +062800 MOVE ZERO TO TEST-NO. IX1134.2 +062900 MOVE "IX-FS3" TO XFILE-NAME (1). IX1134.2 +063000 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1134.2 +063100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1134.2 +063200 MOVE 000240 TO XRECORD-LENGTH (1). IX1134.2 +063300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1134.2 +063400 MOVE 0002 TO XBLOCK-SIZE (1). IX1134.2 +063500 MOVE 000050 TO RECORDS-IN-FILE (1). IX1134.2 +063600 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1134.2 +063700 MOVE "S" TO XLABEL-TYPE (1). IX1134.2 +063800 MOVE 000001 TO XRECORD-NUMBER (1). IX1134.2 +063900 MOVE 0 TO COUNT-OF-RECS. IX1134.2 +064000 IX1134.2 +064100******************************************************************IX1134.2 +064200* TEST 1 *IX1134.2 +064300* OPEN OUTPUT ... 00 EXPECTED *IX1134.2 +064400* IX-3, 1.3.4 (1) A *IX1134.2 +064500* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1134.2 +064600* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1134.2 +064700******************************************************************IX1134.2 +064800 OPN-INIT-GF-01-0. IX1134.2 +064900 MOVE 1 TO STATUS-TEST-00. IX1134.2 +065000 MOVE SPACES TO IX-FS3-STATUS. IX1134.2 +065100 MOVE "OPEN OUTPUT: 00 EXP." TO FEATURE. IX1134.2 +065200 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1134.2 +065300 OPEN IX1134.2 +065400 OUTPUT IX-FS3. IX1134.2 +065500 IF IX-FS3-STATUS EQUAL TO "00" IX1134.2 +065600 GO TO OPN-PASS-GF-01-0. IX1134.2 +065700 OPN-FAIL-GF-01-0. IX1134.2 +065800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1134.2 +065900 PERFORM FAIL. IX1134.2 +066000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1134.2 +066100 MOVE "00" TO CORRECT-X. IX1134.2 +066200 GO TO OPN-WRITE-GF-01-0. IX1134.2 +066300 OPN-PASS-GF-01-0. IX1134.2 +066400 PERFORM PASS. IX1134.2 +066500 OPN-WRITE-GF-01-0. IX1134.2 +066600 PERFORM PRINT-DETAIL. IX1134.2 +066700******************************************************************IX1134.2 +066800* TEST 2 *IX1134.2 +066900* WRITE 00 EXPECTED *IX1134.2 +067000* IX-3, 1.3.4 (1) A *IX1134.2 +067100* CREATING A INDEXED FILE WITH 50 RECORDS *IX1134.2 +067200* KEY: FROM 000000001 TO 000000050 *IX1134.2 +067300******************************************************************IX1134.2 +067400 WRI-INIT-GF-01-0. IX1134.2 +067500 MOVE SPACES TO IX-FS3-STATUS. IX1134.2 +067600 MOVE 0 TO STATUS-TEST-00. IX1134.2 +067700 MOVE "WRITE: 00 EXPECTED" TO FEATURE. IX1134.2 +067800 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1134.2 +067900 WRI-TEST-GF-01-0. IX1134.2 +068000 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1134.2 +068100 MOVE GRP-0101 TO XRECORD-KEY (1). IX1134.2 +068200 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1134.2 +068300* THE VALUE OF THE ALTERNATE KEY IS 50 TIMES UNCHANGED *IX1134.2 +068400 MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1134.2 +068500 WRITE IX-FS3R1-F-G-240. IX1134.2 +068600 IF IX-FS3-STATUS NOT = "00" IX1134.2 +068700 MOVE 1 TO STATUS-TEST-00 IX1134.2 +068800 GO TO WRI-FAIL-GF-01-0. IX1134.2 +068900 IF XRECORD-NUMBER (1) EQUAL TO 50 IX1134.2 +069000 GO TO WRI-TEST-GF-01-1. IX1134.2 +069100 ADD 1 TO XRECORD-NUMBER (1). IX1134.2 +069200 GO TO WRI-TEST-GF-01-0. IX1134.2 +069300 WRI-TEST-GF-01-1. IX1134.2 +069400 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1134.2 +069500 GO TO WRI-PASS-GF-01-0. IX1134.2 +069600 MOVE "ERROR IN CREATING FILE" TO RE-MARK. IX1134.2 +069700 WRI-FAIL-GF-01-0. IX1134.2 +069800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1134.2 +069900 PERFORM FAIL. IX1134.2 +070000 MOVE "RECORDS WRITTEN =" TO COMPUTED-A. IX1134.2 +070100 GO TO WRI-WRITE-GF-01-0. IX1134.2 +070200 WRI-PASS-GF-01-0. IX1134.2 +070300 PERFORM PASS. IX1134.2 +070400 WRI-WRITE-GF-01-0. IX1134.2 +070500 PERFORM PRINT-DETAIL. IX1134.2 +070600 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IX1134.2 +070700 MOVE "CREATE FILE IX-FS3" TO FEATURE. IX1134.2 +070800 MOVE "WRI-TEST-GF-01-1" TO PAR-NAME. IX1134.2 +070900 MOVE COUNT-OF-RECS TO CORRECT-18V0. IX1134.2 +071000 PERFORM PRINT-DETAIL. IX1134.2 +071100 IX1134.2 +071200******************************************************************IX1134.2 +071300* TEST 4 *IX1134.2 +071400* CLOSE OUTPUT 00 EXPECTED *IX1134.2 +071500* IX-3, 1.3.4 (1) A *IX1134.2 +071600******************************************************************IX1134.2 +071700 CLO-INIT-GF-01-0. IX1134.2 +071800 MOVE SPACES TO IX-FS3-STATUS. IX1134.2 +071900 MOVE "CLOSE OUTPUT:00 EXP." TO FEATURE. IX1134.2 +072000 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1134.2 +072100 CLO-TEST-GF-01-0. IX1134.2 +072200 CLOSE IX-FS3. IX1134.2 +072300 IF IX-FS3-STATUS = "00" IX1134.2 +072400 GO TO CLO-PASS-GF-01-0. IX1134.2 +072500 CLO-FAIL-GF-01-0. IX1134.2 +072600 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1134.2 +072700 PERFORM FAIL. IX1134.2 +072800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1134.2 +072900 MOVE "00" TO CORRECT-X. IX1134.2 +073000 GO TO CLO-WRITE-GF-01-0. IX1134.2 +073100 CLO-PASS-GF-01-0. IX1134.2 +073200 PERFORM PASS. IX1134.2 +073300 CLO-WRITE-GF-01-0. IX1134.2 +073400 PERFORM PRINT-DETAIL. IX1134.2 +073500 IX1134.2 +073600******************************************************************IX1134.2 +073700* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1134.2 +073800******************************************************************IX1134.2 +073900 IX1134.2 +074000******************************************************************IX1134.2 +074100* TEST 5 *IX1134.2 +074200* CLOSE FOR A FILE NOT IN THE OPEN MODE *IX1134.2 +074300* FILE STATUS 42 EXPECTED IX-5, 1.3.4 (5) B *IX1134.2 +074400******************************************************************IX1134.2 +074500 CLO-TEST-GF-02-0. IX1134.2 +074600 MOVE 5 TO TEST-NO. IX1134.2 +074700 MOVE SPACES TO IX-FS3-STATUS. IX1134.2 +074800 MOVE "CLOSE-INPUT: 42 EXP." TO FEATURE IX1134.2 +074900 MOVE "CLO-TEST-GF-02-0" TO PAR-NAME. IX1134.2 +075000 CLOSE IX-FS3. IX1134.2 +075100 CLO-TEST-GF-02-1. IX1134.2 +075200 IF IX-FS3-STATUS EQUAL TO "42" IX1134.2 +075300 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1134.2 +075400 TO RE-MARK IX1134.2 +075500 GO TO CLO-WRITE-GF-02-0. IX1134.2 +075600 CLO-FAIL-GF-02-0. IX1134.2 +075700 MOVE "IX-5, 1.3.4, (5) B" TO RE-MARK. IX1134.2 +075800 CLO-WRITE-GF-02-0. IX1134.2 +075900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1134.2 +076000 MOVE "42" TO CORRECT-X. IX1134.2 +076100 PERFORM FAIL. IX1134.2 +076200 PERFORM PRINT-DETAIL. IX1134.2 +076300 IX1134.2 +076400 TERMINATE-ROUTINE. IX1134.2 +076500 EXIT. IX1134.2 +076600 IX1134.2 +076700 CCVS-EXIT SECTION. IX1134.2 +076800 CCVS-999999. IX1134.2 +076900 GO TO CLOSE-FILES. IX1134.2 diff --git a/tests/cobol85/IX/IX114A.SUB b/tests/cobol85/IX/IX114A.SUB new file mode 100755 index 00000000..b817edf6 --- /dev/null +++ b/tests/cobol85/IX/IX114A.SUB @@ -0,0 +1,720 @@ +000100 IDENTIFICATION DIVISION. IX1144.2 +000200 PROGRAM-ID. IX1144.2 +000300 IX114A. IX1144.2 +000400**************************************************************** IX1144.2 +000500* * IX1144.2 +000600* VALIDATION FOR:- * IX1144.2 +000700* * IX1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1144.2 +000900* * IX1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1144.2 +001100* * IX1144.2 +001200**************************************************************** IX1144.2 +001300* IX1144.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1144.2 +001500* IX113A. IX1144.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED) IX1144.2 +001700* THEN CLOSED AND THE STATUS CHECKED (00 EXPECTED). AN IX1144.2 +001800* ATTEMPT IS THEN MADE TO READ A RECORD AT WHICH POINT THE IX1144.2 +001900* DECLARATIVES SHOULD BE ACTIONED AND THE STATUS SHOULD BE *IX1144.2 +002000* 47 (IX-5, 1.3.4 (5) F). IX1144.2 +002100* IX1144.2 +002200* 4. X-CARDS USED IN THIS PROGRAM: IX1144.2 +002300* IX1144.2 +002400* XXXXX024 IX1144.2 +002500* XXXXX055. IX1144.2 +002600* P XXXXX062. IX1144.2 +002700* XXXXX082. IX1144.2 +002800* XXXXX083. IX1144.2 +002900* C XXXXX084 IX1144.2 +003000* IX1144.2 +003100* IX1144.2 +003200 ENVIRONMENT DIVISION. IX1144.2 +003300 CONFIGURATION SECTION. IX1144.2 +003400 SOURCE-COMPUTER. IX1144.2 +003500 Linux. IX1144.2 +003600 OBJECT-COMPUTER. IX1144.2 +003700 Linux. IX1144.2 +003800 INPUT-OUTPUT SECTION. IX1144.2 +003900 FILE-CONTROL. IX1144.2 +004000*P SELECT RAW-DATA ASSIGN TO IX1144.2 +004100*P "XXXXX062" IX1144.2 +004200*P ORGANIZATION IS INDEXED IX1144.2 +004300*P ACCESS MODE IS RANDOM IX1144.2 +004400*P RECORD KEY IS RAW-DATA-KEY. IX1144.2 +004500* IX1144.2 +004600 SELECT PRINT-FILE ASSIGN TO IX1144.2 +004700 "report.log". IX1144.2 +004800* IX1144.2 +004900 SELECT IX-FS3 ASSIGN IX1144.2 +005000 "XXXXX024" IX1144.2 +005100 ORGANIZATION IS INDEXED IX1144.2 +005200 ACCESS MODE IS SEQUENTIAL IX1144.2 +005300 RECORD KEY IS IX-FS3-KEY IX1144.2 +005400 FILE STATUS IS IX-FS3-STATUS. IX1144.2 +005500 IX1144.2 +005600 DATA DIVISION. IX1144.2 +005700 IX1144.2 +005800 FILE SECTION. IX1144.2 +005900*P IX1144.2 +006000*PD RAW-DATA. IX1144.2 +006100*P IX1144.2 +006200*P1 RAW-DATA-SATZ. IX1144.2 +006300*P 05 RAW-DATA-KEY PIC X(6). IX1144.2 +006400*P 05 C-DATE PIC 9(6). IX1144.2 +006500*P 05 C-TIME PIC 9(8). IX1144.2 +006600*P 05 C-NO-OF-TESTS PIC 99. IX1144.2 +006700*P 05 C-OK PIC 999. IX1144.2 +006800*P 05 C-ALL PIC 999. IX1144.2 +006900*P 05 C-FAIL PIC 999. IX1144.2 +007000*P 05 C-DELETED PIC 999. IX1144.2 +007100*P 05 C-INSPECT PIC 999. IX1144.2 +007200*P 05 C-NOTE PIC X(13). IX1144.2 +007300*P 05 C-INDENT PIC X. IX1144.2 +007400*P 05 C-ABORT PIC X(8). IX1144.2 +007500 IX1144.2 +007600 FD PRINT-FILE. IX1144.2 +007700 IX1144.2 +007800 01 PRINT-REC PIC X(120). IX1144.2 +007900 IX1144.2 +008000 01 DUMMY-RECORD PIC X(120). IX1144.2 +008100 IX1144.2 +008200 FD IX-FS3 IX1144.2 +008300*C DATA RECORDS IX-FS3R1-F-G-240 IX1144.2 +008400*C LABEL RECORD STANDARD IX1144.2 +008500 RECORD 240 IX1144.2 +008600 BLOCK CONTAINS 2 RECORDS. IX1144.2 +008700 IX1144.2 +008800 01 IX-FS3R1-F-G-240. IX1144.2 +008900 05 IX-FS3-REC-120 PIC X(120). IX1144.2 +009000 05 IX-FS3-REC-120-240. IX1144.2 +009100 10 FILLER PIC X(8). IX1144.2 +009200 10 IX-FS3-KEY PIC X(29). IX1144.2 +009300 10 FILLER PIC X(9). IX1144.2 +009400 10 IX-FS3-ALTER-KEY PIC X(29). IX1144.2 +009500 10 FILLER PIC X(45). IX1144.2 +009600 IX1144.2 +009700 IX1144.2 +009800 WORKING-STORAGE SECTION. IX1144.2 +009900 IX1144.2 +010000 01 GRP-0101. IX1144.2 +010100 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1144.2 +010200 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1144.2 +010300 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1144.2 +010400 IX1144.2 +010500 01 GRP-0102. IX1144.2 +010600 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1144.2 +010700 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1144.2 +010800 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1144.2 +010900 IX1144.2 +011000 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1144.2 +011100 IX1144.2 +011200 01 EOF-FLAG PIC 9 VALUE ZERO. IX1144.2 +011300 IX1144.2 +011400 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1144.2 +011500 IX1144.2 +011600 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1144.2 +011700 IX1144.2 +011800 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1144.2 +011900 IX1144.2 +012000 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1144.2 +012100 IX1144.2 +012200 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1144.2 +012300 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1144.2 +012400 IX1144.2 +012500 01 IX-FS3-STATUS. IX1144.2 +012600 05 IX-FS3-STAT1 PIC X. IX1144.2 +012700 05 IX-FS3-STAT2 PIC X. IX1144.2 +012800 IX1144.2 +012900 01 COUNT-OF-RECS PIC 9(5). IX1144.2 +013000 IX1144.2 +013100 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1144.2 +013200 IX1144.2 +013300 01 FILE-RECORD-INFORMATION-REC. IX1144.2 +013400 05 FILE-RECORD-INFO-SKELETON. IX1144.2 +013500 10 FILLER PIC X(48) VALUE IX1144.2 +013600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1144.2 +013700 10 FILLER PIC X(46) VALUE IX1144.2 +013800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1144.2 +013900 10 FILLER PIC X(26) VALUE IX1144.2 +014000 ",LFIL=000000,ORG= ,LBLR= ". IX1144.2 +014100 10 FILLER PIC X(37) VALUE IX1144.2 +014200 ",RECKEY= ". IX1144.2 +014300 10 FILLER PIC X(38) VALUE IX1144.2 +014400 ",ALTKEY1= ". IX1144.2 +014500 10 FILLER PIC X(38) VALUE IX1144.2 +014600 ",ALTKEY2= ". IX1144.2 +014700 10 FILLER PIC X(7) VALUE SPACE. IX1144.2 +014800 05 FILE-RECORD-INFO OCCURS 10. IX1144.2 +014900 10 FILE-RECORD-INFO-P1-120. IX1144.2 +015000 15 FILLER PIC X(5). IX1144.2 +015100 15 XFILE-NAME PIC X(6). IX1144.2 +015200 15 FILLER PIC X(8). IX1144.2 +015300 15 XRECORD-NAME PIC X(6). IX1144.2 +015400 15 FILLER PIC X(1). IX1144.2 +015500 15 REELUNIT-NUMBER PIC 9(1). IX1144.2 +015600 15 FILLER PIC X(7). IX1144.2 +015700 15 XRECORD-NUMBER PIC 9(6). IX1144.2 +015800 15 FILLER PIC X(6). IX1144.2 +015900 15 UPDATE-NUMBER PIC 9(2). IX1144.2 +016000 15 FILLER PIC X(5). IX1144.2 +016100 15 ODO-NUMBER PIC 9(4). IX1144.2 +016200 15 FILLER PIC X(5). IX1144.2 +016300 15 XPROGRAM-NAME PIC X(5). IX1144.2 +016400 15 FILLER PIC X(7). IX1144.2 +016500 15 XRECORD-LENGTH PIC 9(6). IX1144.2 +016600 15 FILLER PIC X(7). IX1144.2 +016700 15 CHARS-OR-RECORDS PIC X(2). IX1144.2 +016800 15 FILLER PIC X(1). IX1144.2 +016900 15 XBLOCK-SIZE PIC 9(4). IX1144.2 +017000 15 FILLER PIC X(6). IX1144.2 +017100 15 RECORDS-IN-FILE PIC 9(6). IX1144.2 +017200 15 FILLER PIC X(5). IX1144.2 +017300 15 XFILE-ORGANIZATION PIC X(2). IX1144.2 +017400 15 FILLER PIC X(6). IX1144.2 +017500 15 XLABEL-TYPE PIC X(1). IX1144.2 +017600 10 FILE-RECORD-INFO-P121-240. IX1144.2 +017700 15 FILLER PIC X(8). IX1144.2 +017800 15 XRECORD-KEY PIC X(29). IX1144.2 +017900 15 FILLER PIC X(9). IX1144.2 +018000 15 ALTERNATE-KEY1 PIC X(29). IX1144.2 +018100 15 FILLER PIC X(9). IX1144.2 +018200 15 ALTERNATE-KEY2 PIC X(29). IX1144.2 +018300 15 FILLER PIC X(7). IX1144.2 +018400 IX1144.2 +018500 01 TEST-RESULTS. IX1144.2 +018600 02 FILLER PIC X VALUE SPACE. IX1144.2 +018700 02 FEATURE PIC X(20) VALUE SPACE. IX1144.2 +018800 02 FILLER PIC X VALUE SPACE. IX1144.2 +018900 02 P-OR-F PIC X(5) VALUE SPACE. IX1144.2 +019000 02 FILLER PIC X VALUE SPACE. IX1144.2 +019100 02 PAR-NAME. IX1144.2 +019200 03 FILLER PIC X(19) VALUE SPACE. IX1144.2 +019300 03 PARDOT-X PIC X VALUE SPACE. IX1144.2 +019400 03 DOTVALUE PIC 99 VALUE ZERO. IX1144.2 +019500 02 FILLER PIC X(8) VALUE SPACE. IX1144.2 +019600 02 RE-MARK PIC X(61). IX1144.2 +019700 01 TEST-COMPUTED. IX1144.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX1144.2 +019900 02 FILLER PIC X(17) VALUE IX1144.2 +020000 " COMPUTED=". IX1144.2 +020100 02 COMPUTED-X. IX1144.2 +020200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1144.2 +020300 03 COMPUTED-N REDEFINES COMPUTED-A IX1144.2 +020400 PIC -9(9).9(9). IX1144.2 +020500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1144.2 +020600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1144.2 +020700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1144.2 +020800 03 CM-18V0 REDEFINES COMPUTED-A. IX1144.2 +020900 04 COMPUTED-18V0 PIC -9(18). IX1144.2 +021000 04 FILLER PIC X. IX1144.2 +021100 03 FILLER PIC X(50) VALUE SPACE. IX1144.2 +021200 01 TEST-CORRECT. IX1144.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX1144.2 +021400 02 FILLER PIC X(17) VALUE " CORRECT =". IX1144.2 +021500 02 CORRECT-X. IX1144.2 +021600 03 CORRECT-A PIC X(20) VALUE SPACE. IX1144.2 +021700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1144.2 +021800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1144.2 +021900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1144.2 +022000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1144.2 +022100 03 CR-18V0 REDEFINES CORRECT-A. IX1144.2 +022200 04 CORRECT-18V0 PIC -9(18). IX1144.2 +022300 04 FILLER PIC X. IX1144.2 +022400 03 FILLER PIC X(2) VALUE SPACE. IX1144.2 +022500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1144.2 +022600 01 CCVS-C-1. IX1144.2 +022700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1144.2 +022800- "SS PARAGRAPH-NAME IX1144.2 +022900- " REMARKS". IX1144.2 +023000 02 FILLER PIC X(20) VALUE SPACE. IX1144.2 +023100 01 CCVS-C-2. IX1144.2 +023200 02 FILLER PIC X VALUE SPACE. IX1144.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". IX1144.2 +023400 02 FILLER PIC X(15) VALUE SPACE. IX1144.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". IX1144.2 +023600 02 FILLER PIC X(94) VALUE SPACE. IX1144.2 +023700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1144.2 +023800 01 REC-CT PIC 99 VALUE ZERO. IX1144.2 +023900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1144.2 +024000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1144.2 +024100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1144.2 +024200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1144.2 +024300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1144.2 +024400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1144.2 +024500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1144.2 +024600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1144.2 +024700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1144.2 +024800 01 CCVS-H-1. IX1144.2 +024900 02 FILLER PIC X(39) VALUE SPACES. IX1144.2 +025000 02 FILLER PIC X(42) VALUE IX1144.2 +025100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1144.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX1144.2 +025300 01 CCVS-H-2A. IX1144.2 +025400 02 FILLER PIC X(40) VALUE SPACE. IX1144.2 +025500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1144.2 +025600 02 FILLER PIC XXXX VALUE IX1144.2 +025700 "4.2 ". IX1144.2 +025800 02 FILLER PIC X(28) VALUE IX1144.2 +025900 " COPY - NOT FOR DISTRIBUTION". IX1144.2 +026000 02 FILLER PIC X(41) VALUE SPACE. IX1144.2 +026100 IX1144.2 +026200 01 CCVS-H-2B. IX1144.2 +026300 02 FILLER PIC X(15) VALUE IX1144.2 +026400 "TEST RESULT OF ". IX1144.2 +026500 02 TEST-ID PIC X(9). IX1144.2 +026600 02 FILLER PIC X(4) VALUE IX1144.2 +026700 " IN ". IX1144.2 +026800 02 FILLER PIC X(12) VALUE IX1144.2 +026900 " HIGH ". IX1144.2 +027000 02 FILLER PIC X(22) VALUE IX1144.2 +027100 " LEVEL VALIDATION FOR ". IX1144.2 +027200 02 FILLER PIC X(58) VALUE IX1144.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1144.2 +027400 01 CCVS-H-3. IX1144.2 +027500 02 FILLER PIC X(34) VALUE IX1144.2 +027600 " FOR OFFICIAL USE ONLY ". IX1144.2 +027700 02 FILLER PIC X(58) VALUE IX1144.2 +027800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1144.2 +027900 02 FILLER PIC X(28) VALUE IX1144.2 +028000 " COPYRIGHT 1985 ". IX1144.2 +028100 01 CCVS-E-1. IX1144.2 +028200 02 FILLER PIC X(52) VALUE SPACE. IX1144.2 +028300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1144.2 +028400 02 ID-AGAIN PIC X(9). IX1144.2 +028500 02 FILLER PIC X(45) VALUE SPACES. IX1144.2 +028600 01 CCVS-E-2. IX1144.2 +028700 02 FILLER PIC X(31) VALUE SPACE. IX1144.2 +028800 02 FILLER PIC X(21) VALUE SPACE. IX1144.2 +028900 02 CCVS-E-2-2. IX1144.2 +029000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1144.2 +029100 03 FILLER PIC X VALUE SPACE. IX1144.2 +029200 03 ENDER-DESC PIC X(44) VALUE IX1144.2 +029300 "ERRORS ENCOUNTERED". IX1144.2 +029400 01 CCVS-E-3. IX1144.2 +029500 02 FILLER PIC X(22) VALUE IX1144.2 +029600 " FOR OFFICIAL USE ONLY". IX1144.2 +029700 02 FILLER PIC X(12) VALUE SPACE. IX1144.2 +029800 02 FILLER PIC X(58) VALUE IX1144.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1144.2 +030000 02 FILLER PIC X(13) VALUE SPACE. IX1144.2 +030100 02 FILLER PIC X(15) VALUE IX1144.2 +030200 " COPYRIGHT 1985". IX1144.2 +030300 01 CCVS-E-4. IX1144.2 +030400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1144.2 +030500 02 FILLER PIC X(4) VALUE " OF ". IX1144.2 +030600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1144.2 +030700 02 FILLER PIC X(40) VALUE IX1144.2 +030800 " TESTS WERE EXECUTED SUCCESSFULLY". IX1144.2 +030900 01 XXINFO. IX1144.2 +031000 02 FILLER PIC X(19) VALUE IX1144.2 +031100 "*** INFORMATION ***". IX1144.2 +031200 02 INFO-TEXT. IX1144.2 +031300 04 FILLER PIC X(8) VALUE SPACE. IX1144.2 +031400 04 XXCOMPUTED PIC X(20). IX1144.2 +031500 04 FILLER PIC X(5) VALUE SPACE. IX1144.2 +031600 04 XXCORRECT PIC X(20). IX1144.2 +031700 02 INF-ANSI-REFERENCE PIC X(48). IX1144.2 +031800 01 HYPHEN-LINE. IX1144.2 +031900 02 FILLER PIC IS X VALUE IS SPACE. IX1144.2 +032000 02 FILLER PIC IS X(65) VALUE IS "************************IX1144.2 +032100- "*****************************************". IX1144.2 +032200 02 FILLER PIC IS X(54) VALUE IS "************************IX1144.2 +032300- "******************************". IX1144.2 +032400 01 TEST-NO PIC 99. IX1144.2 +032500 01 CCVS-PGM-ID PIC X(9) VALUE IX1144.2 +032600 "IX114A". IX1144.2 +032700 PROCEDURE DIVISION. IX1144.2 +032800 DECLARATIVES. IX1144.2 +032900 IX1144.2 +033000 SECT-IX105-0002 SECTION. IX1144.2 +033100 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1144.2 +033200 INPUT-PROCESS. IX1144.2 +033300 IF TEST-NO = 5 IX1144.2 +033400 GO TO D-C-TEST-GF-01-1. IX1144.2 +033500 IF STATUS-TEST-10 EQUAL TO 1 IX1144.2 +033600 IF IX-FS3-STAT1 EQUAL TO "1" IX1144.2 +033700 MOVE 1 TO EOF-FLAG IX1144.2 +033800 ELSE IX1144.2 +033900 IF IX-FS3-STAT1 GREATER THAN "1" IX1144.2 +034000 MOVE 1 TO PERM-ERRORS. IX1144.2 +034100 GO TO DECL-EXIT. IX1144.2 +034200 D-C-TEST-GF-01-1. IX1144.2 +034300 IF IX-FS3-STATUS EQUAL TO "47" IX1144.2 +034400 GO TO D-C-PASS-GF-01-0. IX1144.2 +034500 D-C-FAIL-GF-01-0. IX1144.2 +034600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1144.2 +034700 MOVE "47" TO CORRECT-X. IX1144.2 +034800 MOVE "IX-5, 1.3.4, (5) F" TO RE-MARK. IX1144.2 +034900 PERFORM D-FAIL. IX1144.2 +035000 GO TO D-C-WRITE-GF-01-0. IX1144.2 +035100 D-C-PASS-GF-01-0. IX1144.2 +035200 PERFORM D-PASS. IX1144.2 +035300 D-C-WRITE-GF-01-0. IX1144.2 +035400 PERFORM D-PRINT-DETAIL. IX1144.2 +035500 D-CLOSE-FILES. IX1144.2 +035600*P OPEN I-O RAW-DATA. IX1144.2 +035700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1144.2 +035800*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1144.2 +035900*P MOVE "OK. " TO C-ABORT. IX1144.2 +036000*P MOVE PASS-COUNTER TO C-OK. IX1144.2 +036100*P MOVE ERROR-HOLD TO C-ALL. IX1144.2 +036200*P MOVE ERROR-COUNTER TO C-FAIL. IX1144.2 +036300*P MOVE DELETE-COUNTER TO C-DELETED. IX1144.2 +036400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1144.2 +036500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1144.2 +036600*P-END-E-2. IX1144.2 +036700*P CLOSE RAW-DATA. IX1144.2 +036800 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1144.2 +036900 CLOSE PRINT-FILE. IX1144.2 +037000 D-TERMINATE-CCVS. IX1144.2 +037100*S EXIT PROGRAM. IX1144.2 +037200*S-TERMINATE-CALL. IX1144.2 +037300 STOP RUN. IX1144.2 +037400 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1144.2 +037500 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1144.2 +037600 D-PRINT-DETAIL. IX1144.2 +037700 IF REC-CT NOT EQUAL TO ZERO IX1144.2 +037800 MOVE "." TO PARDOT-X IX1144.2 +037900 MOVE REC-CT TO DOTVALUE. IX1144.2 +038000 MOVE TEST-RESULTS TO PRINT-REC. IX1144.2 +038100 PERFORM D-WRITE-LINE. IX1144.2 +038200 IF P-OR-F EQUAL TO "FAIL*" IX1144.2 +038300 PERFORM D-WRITE-LINE IX1144.2 +038400 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1144.2 +038500 ELSE IX1144.2 +038600 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1144.2 +038700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1144.2 +038800 MOVE SPACE TO CORRECT-X. IX1144.2 +038900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1144.2 +039000 MOVE SPACE TO RE-MARK. IX1144.2 +039100 D-END-ROUTINE. IX1144.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1144.2 +039300 PERFORM D-WRITE-LINE 5 TIMES. IX1144.2 +039400 D-END-RTN-EXIT. IX1144.2 +039500 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1144.2 +039600 PERFORM D-WRITE-LINE 2 TIMES. IX1144.2 +039700 D-END-ROUTINE-1. IX1144.2 +039800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1144.2 +039900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1144.2 +040000 ADD PASS-COUNTER TO ERROR-HOLD. IX1144.2 +040100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1144.2 +040200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1144.2 +040300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1144.2 +040400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1144.2 +040500 D-END-ROUTINE-12. IX1144.2 +040600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1144.2 +040700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1144.2 +040800 MOVE "NO " TO ERROR-TOTAL IX1144.2 +040900 ELSE IX1144.2 +041000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1144.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1144.2 +041200 PERFORM D-WRITE-LINE. IX1144.2 +041300 D-END-ROUTINE-13. IX1144.2 +041400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1144.2 +041500 MOVE "NO " TO ERROR-TOTAL ELSE IX1144.2 +041600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1144.2 +041700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1144.2 +041800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1144.2 +041900 PERFORM D-WRITE-LINE. IX1144.2 +042000 IF INSPECT-COUNTER EQUAL TO ZERO IX1144.2 +042100 MOVE "NO " TO ERROR-TOTAL IX1144.2 +042200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1144.2 +042300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1144.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1144.2 +042500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1144.2 +042600 D-WRITE-LINE. IX1144.2 +042700 ADD 1 TO RECORD-COUNT. IX1144.2 +042800 IF RECORD-COUNT GREATER 42 IX1144.2 +042900 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1144.2 +043000 MOVE SPACE TO DUMMY-RECORD IX1144.2 +043100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1144.2 +043200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1144.2 +043300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1144.2 +043400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1144.2 +043500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1144.2 +043600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1144.2 +043700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1144.2 +043800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1144.2 +043900 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1144.2 +044000 MOVE ZERO TO RECORD-COUNT. IX1144.2 +044100 PERFORM D-WRT-LN. IX1144.2 +044200 D-WRT-LN. IX1144.2 +044300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1144.2 +044400 MOVE SPACE TO DUMMY-RECORD. IX1144.2 +044500 D-FAIL-ROUTINE. IX1144.2 +044600 IF COMPUTED-X NOT EQUAL TO SPACE IX1144.2 +044700 GO TO D-FAIL-ROUTINE-WRITE. IX1144.2 +044800 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1144.2 +044900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1144.2 +045000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1144.2 +045100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1144.2 +045200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1144.2 +045300 GO TO D-FAIL-ROUTINE-EX. IX1144.2 +045400 D-FAIL-ROUTINE-WRITE. IX1144.2 +045500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1144.2 +045600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1144.2 +045700 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1144.2 +045800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1144.2 +045900 D-FAIL-ROUTINE-EX. EXIT. IX1144.2 +046000 D-BAIL-OUT. IX1144.2 +046100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1144.2 +046200 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1144.2 +046300 D-BAIL-OUT-WRITE. IX1144.2 +046400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1144.2 +046500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1144.2 +046600 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1144.2 +046700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1144.2 +046800 D-BAIL-OUT-EX. EXIT. IX1144.2 +046900 DECL-EXIT. EXIT. IX1144.2 +047000 END DECLARATIVES. IX1144.2 +047100 IX1144.2 +047200 IX1144.2 +047300 CCVS1 SECTION. IX1144.2 +047400 OPEN-FILES. IX1144.2 +047500*P OPEN I-O RAW-DATA. IX1144.2 +047600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1144.2 +047700*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1144.2 +047800*P MOVE "ABORTED " TO C-ABORT. IX1144.2 +047900*P ADD 1 TO C-NO-OF-TESTS. IX1144.2 +048000*P ACCEPT C-DATE FROM DATE. IX1144.2 +048100*P ACCEPT C-TIME FROM TIME. IX1144.2 +048200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1144.2 +048300*PND-E-1. IX1144.2 +048400*P CLOSE RAW-DATA. IX1144.2 +048500 OPEN OUTPUT PRINT-FILE. IX1144.2 +048600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1144.2 +048700 MOVE SPACE TO TEST-RESULTS. IX1144.2 +048800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1144.2 +048900 MOVE ZERO TO REC-SKL-SUB. IX1144.2 +049000 PERFORM CCVS-INIT-FILE 9 TIMES. IX1144.2 +049100 CCVS-INIT-FILE. IX1144.2 +049200 ADD 1 TO REC-SKL-SUB. IX1144.2 +049300 MOVE FILE-RECORD-INFO-SKELETON IX1144.2 +049400 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1144.2 +049500 CCVS-INIT-EXIT. IX1144.2 +049600 GO TO CCVS1-EXIT. IX1144.2 +049700 CLOSE-FILES. IX1144.2 +049800*P OPEN I-O RAW-DATA. IX1144.2 +049900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1144.2 +050000*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1144.2 +050100*P MOVE "OK. " TO C-ABORT. IX1144.2 +050200*P MOVE PASS-COUNTER TO C-OK. IX1144.2 +050300*P MOVE ERROR-HOLD TO C-ALL. IX1144.2 +050400*P MOVE ERROR-COUNTER TO C-FAIL. IX1144.2 +050500*P MOVE DELETE-COUNTER TO C-DELETED. IX1144.2 +050600*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1144.2 +050700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1144.2 +050800*PND-E-2. IX1144.2 +050900*P CLOSE RAW-DATA. IX1144.2 +051000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1144.2 +051100 TERMINATE-CCVS. IX1144.2 +051200*S EXIT PROGRAM. IX1144.2 +051300*SERMINATE-CALL. IX1144.2 +051400 STOP RUN. IX1144.2 +051500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1144.2 +051600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1144.2 +051700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1144.2 +051800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1144.2 +051900 MOVE "****TEST DELETED****" TO RE-MARK. IX1144.2 +052000 PRINT-DETAIL. IX1144.2 +052100 IF REC-CT NOT EQUAL TO ZERO IX1144.2 +052200 MOVE "." TO PARDOT-X IX1144.2 +052300 MOVE REC-CT TO DOTVALUE. IX1144.2 +052400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1144.2 +052500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1144.2 +052600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1144.2 +052700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1144.2 +052800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1144.2 +052900 MOVE SPACE TO CORRECT-X. IX1144.2 +053000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1144.2 +053100 MOVE SPACE TO RE-MARK. IX1144.2 +053200 HEAD-ROUTINE. IX1144.2 +053300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +053400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +053500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1144.2 +053600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1144.2 +053700 COLUMN-NAMES-ROUTINE. IX1144.2 +053800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +053900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +054000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +054100 END-ROUTINE. IX1144.2 +054200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1144.2 +054300 END-RTN-EXIT. IX1144.2 +054400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +054500 END-ROUTINE-1. IX1144.2 +054600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1144.2 +054700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1144.2 +054800 ADD PASS-COUNTER TO ERROR-HOLD. IX1144.2 +054900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1144.2 +055000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1144.2 +055100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1144.2 +055200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1144.2 +055300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1144.2 +055400 END-ROUTINE-12. IX1144.2 +055500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1144.2 +055600 IF ERROR-COUNTER IS EQUAL TO ZERO IX1144.2 +055700 MOVE "NO " TO ERROR-TOTAL IX1144.2 +055800 ELSE IX1144.2 +055900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1144.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1144.2 +056100 PERFORM WRITE-LINE. IX1144.2 +056200 END-ROUTINE-13. IX1144.2 +056300 IF DELETE-COUNTER IS EQUAL TO ZERO IX1144.2 +056400 MOVE "NO " TO ERROR-TOTAL ELSE IX1144.2 +056500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1144.2 +056600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1144.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +056800 IF INSPECT-COUNTER EQUAL TO ZERO IX1144.2 +056900 MOVE "NO " TO ERROR-TOTAL IX1144.2 +057000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1144.2 +057100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1144.2 +057200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +057300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1144.2 +057400 WRITE-LINE. IX1144.2 +057500 ADD 1 TO RECORD-COUNT. IX1144.2 +057600 IF RECORD-COUNT GREATER 42 IX1144.2 +057700 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1144.2 +057800 MOVE SPACE TO DUMMY-RECORD IX1144.2 +057900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1144.2 +058000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1144.2 +058100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1144.2 +058200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1144.2 +058300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1144.2 +058400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1144.2 +058500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1144.2 +058600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1144.2 +058700 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1144.2 +058800 MOVE ZERO TO RECORD-COUNT. IX1144.2 +058900 PERFORM WRT-LN. IX1144.2 +059000 WRT-LN. IX1144.2 +059100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1144.2 +059200 MOVE SPACE TO DUMMY-RECORD. IX1144.2 +059300 BLANK-LINE-PRINT. IX1144.2 +059400 PERFORM WRT-LN. IX1144.2 +059500 FAIL-ROUTINE. IX1144.2 +059600 IF COMPUTED-X NOT EQUAL TO SPACE IX1144.2 +059700 GO TO FAIL-ROUTINE-WRITE. IX1144.2 +059800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1144.2 +059900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1144.2 +060000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1144.2 +060100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +060200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1144.2 +060300 GO TO FAIL-ROUTINE-EX. IX1144.2 +060400 FAIL-ROUTINE-WRITE. IX1144.2 +060500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1144.2 +060600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1144.2 +060700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1144.2 +060800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1144.2 +060900 FAIL-ROUTINE-EX. EXIT. IX1144.2 +061000 BAIL-OUT. IX1144.2 +061100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1144.2 +061200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1144.2 +061300 BAIL-OUT-WRITE. IX1144.2 +061400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1144.2 +061500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1144.2 +061600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1144.2 +061700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1144.2 +061800 BAIL-OUT-EX. EXIT. IX1144.2 +061900 CCVS1-EXIT. IX1144.2 +062000 EXIT. IX1144.2 +062100 IX1144.2 +062200 SECT-IX114A-0003 SECTION. IX1144.2 +062300 SEQ-INIT-010. IX1144.2 +062400 MOVE ZERO TO TEST-NO. IX1144.2 +062500 MOVE "IX-FS3" TO XFILE-NAME (1). IX1144.2 +062600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1144.2 +062700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1144.2 +062800 MOVE 000240 TO XRECORD-LENGTH (1). IX1144.2 +062900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1144.2 +063000 MOVE 0002 TO XBLOCK-SIZE (1). IX1144.2 +063100 MOVE 000050 TO RECORDS-IN-FILE (1). IX1144.2 +063200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1144.2 +063300 MOVE "S" TO XLABEL-TYPE (1). IX1144.2 +063400 MOVE 000001 TO XRECORD-NUMBER (1). IX1144.2 +063500 MOVE 0 TO COUNT-OF-RECS. IX1144.2 +063600 IX1144.2 +063700******************************************************************IX1144.2 +063800* TEST 1 *IX1144.2 +063900* OPEN OUTPUT ... 00 EXPECTED *IX1144.2 +064000* IX-3, 1.3.4 (1) A *IX1144.2 +064100* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1144.2 +064200* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1144.2 +064300******************************************************************IX1144.2 +064400 OPN-INIT-GF-01-0. IX1144.2 +064500 MOVE 1 TO STATUS-TEST-00. IX1144.2 +064600 MOVE SPACES TO IX-FS3-STATUS. IX1144.2 +064700 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1144.2 +064800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1144.2 +064900 OPEN IX1144.2 +065000 I-O IX-FS3. IX1144.2 +065100 IF IX-FS3-STATUS EQUAL TO "00" IX1144.2 +065200 GO TO OPN-PASS-GF-01-0. IX1144.2 +065300 OPN-FAIL-GF-01-0. IX1144.2 +065400 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1144.2 +065500 PERFORM FAIL. IX1144.2 +065600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1144.2 +065700 MOVE "00" TO CORRECT-X. IX1144.2 +065800 GO TO OPN-WRITE-GF-01-0. IX1144.2 +065900 OPN-PASS-GF-01-0. IX1144.2 +066000 PERFORM PASS. IX1144.2 +066100 OPN-WRITE-GF-01-0. IX1144.2 +066200 PERFORM PRINT-DETAIL. IX1144.2 +066300******************************************************************IX1144.2 +066400* TEST 4 *IX1144.2 +066500* CLOSE I-O 00 EXPECTED *IX1144.2 +066600* IX-3, 1.3.4 (1) A *IX1144.2 +066700******************************************************************IX1144.2 +066800 CLO-INIT-GF-01-0. IX1144.2 +066900 MOVE SPACES TO IX-FS3-STATUS. IX1144.2 +067000 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1144.2 +067100 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1144.2 +067200 CLO-TEST-GF-01-0. IX1144.2 +067300 CLOSE IX-FS3. IX1144.2 +067400 IF IX-FS3-STATUS = "00" IX1144.2 +067500 GO TO CLO-PASS-GF-01-0. IX1144.2 +067600 CLO-FAIL-GF-01-0. IX1144.2 +067700 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1144.2 +067800 PERFORM FAIL. IX1144.2 +067900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1144.2 +068000 MOVE "00" TO CORRECT-X. IX1144.2 +068100 GO TO CLO-WRITE-GF-01-0. IX1144.2 +068200 CLO-PASS-GF-01-0. IX1144.2 +068300 PERFORM PASS. IX1144.2 +068400 CLO-WRITE-GF-01-0. IX1144.2 +068500 PERFORM PRINT-DETAIL. IX1144.2 +068600 IX1144.2 +068700******************************************************************IX1144.2 +068800* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1144.2 +068900******************************************************************IX1144.2 +069000 IX1144.2 +069100******************************************************************IX1144.2 +069200* TEST 5 *IX1144.2 +069300* READ ... A FILE NOT IN THE OPEN MODE *IX1144.2 +069400* FILE STATUS 47 EXPECTED IX-5, 1.3.4 (5) F *IX1144.2 +069500******************************************************************IX1144.2 +069600 REA-TEST-GF-01-0. IX1144.2 +069700 MOVE 5 TO TEST-NO. IX1144.2 +069800 MOVE SPACES TO IX-FS3-STATUS. IX1144.2 +069900 MOVE "READ. 47 EXP." TO FEATURE IX1144.2 +070000 MOVE "REA-TEST-GF-01-0" TO PAR-NAME. IX1144.2 +070100 READ IX-FS3 AT END GO TO REA-TEST-GF-01-1. IX1144.2 +070200 REA-TEST-GF-01-1. IX1144.2 +070300 IF IX-FS3-STATUS EQUAL TO "47" IX1144.2 +070400 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1144.2 +070500 TO RE-MARK IX1144.2 +070600 GO TO REA-WRITE-GF-01-0. IX1144.2 +070700 REA-FAIL-GF-01-0. IX1144.2 +070800 MOVE "IX-5, 1.3.4, (5) F" TO RE-MARK. IX1144.2 +070900 REA-WRITE-GF-01-0. IX1144.2 +071000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1144.2 +071100 MOVE "47" TO CORRECT-X. IX1144.2 +071200 PERFORM FAIL. IX1144.2 +071300 PERFORM PRINT-DETAIL. IX1144.2 +071400 IX1144.2 +071500 TERMINATE-ROUTINE. IX1144.2 +071600 EXIT. IX1144.2 +071700 IX1144.2 +071800 CCVS-EXIT SECTION. IX1144.2 +071900 CCVS-999999. IX1144.2 +072000 GO TO CLOSE-FILES. IX1144.2 diff --git a/tests/cobol85/IX/IX115A.SUB b/tests/cobol85/IX/IX115A.SUB new file mode 100755 index 00000000..92ddf6fa --- /dev/null +++ b/tests/cobol85/IX/IX115A.SUB @@ -0,0 +1,721 @@ +000100 IDENTIFICATION DIVISION. IX1154.2 +000200 PROGRAM-ID. IX1154.2 +000300 IX115A. IX1154.2 +000400**************************************************************** IX1154.2 +000500* * IX1154.2 +000600* VALIDATION FOR:- * IX1154.2 +000700* * IX1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1154.2 +000900* * IX1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1154.2 +001100* * IX1154.2 +001200**************************************************************** IX1154.2 +001300* IX1154.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1154.2 +001500* IX113A. IX1154.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED) IX1154.2 +001700* THEN CLOSED AND THE STATUS CHECKED AGAIN (00 EXPECTED). AN IX1154.2 +001800* ATTEMPT IS THEN MADE TO WRITE A RECORD TO THE CLOSED FILE IX1154.2 +001900* AT WHICH POINT THE USE AFTER STANDARD EXCEPTION PROCEDURE *IX1154.2 +002000* STATEMENTS IN THE DECLARATIVES SHOULD BE EXECUTED AND THE IX1154.2 +002100* FILE STATUS SHOULD BE 48 (IX-5, 1.3.4 (5) G. IX1154.2 +002200* IX1154.2 +002300* 4. X-CARDS USED IN THIS PROGRAM: IX1154.2 +002400* IX1154.2 +002500* XXXXX024 IX1154.2 +002600* XXXXX055. IX1154.2 +002700* P XXXXX062. IX1154.2 +002800* XXXXX082. IX1154.2 +002900* XXXXX083. IX1154.2 +003000* C XXXXX084 IX1154.2 +003100* IX1154.2 +003200* IX1154.2 +003300 ENVIRONMENT DIVISION. IX1154.2 +003400 CONFIGURATION SECTION. IX1154.2 +003500 SOURCE-COMPUTER. IX1154.2 +003600 Linux. IX1154.2 +003700 OBJECT-COMPUTER. IX1154.2 +003800 Linux. IX1154.2 +003900 INPUT-OUTPUT SECTION. IX1154.2 +004000 FILE-CONTROL. IX1154.2 +004100*P SELECT RAW-DATA ASSIGN TO IX1154.2 +004200*P "XXXXX062" IX1154.2 +004300*P ORGANIZATION IS INDEXED IX1154.2 +004400*P ACCESS MODE IS RANDOM IX1154.2 +004500*P RECORD KEY IS RAW-DATA-KEY. IX1154.2 +004600* IX1154.2 +004700 SELECT PRINT-FILE ASSIGN TO IX1154.2 +004800 "report.log". IX1154.2 +004900* IX1154.2 +005000 SELECT IX-FS3 ASSIGN IX1154.2 +005100 "XXXXX024" IX1154.2 +005200 ORGANIZATION IS INDEXED IX1154.2 +005300 ACCESS MODE IS SEQUENTIAL IX1154.2 +005400 RECORD KEY IS IX-FS3-KEY IX1154.2 +005500 FILE STATUS IS IX-FS3-STATUS. IX1154.2 +005600 IX1154.2 +005700 DATA DIVISION. IX1154.2 +005800 IX1154.2 +005900 FILE SECTION. IX1154.2 +006000*P IX1154.2 +006100*PD RAW-DATA. IX1154.2 +006200*P IX1154.2 +006300*P1 RAW-DATA-SATZ. IX1154.2 +006400*P 05 RAW-DATA-KEY PIC X(6). IX1154.2 +006500*P 05 C-DATE PIC 9(6). IX1154.2 +006600*P 05 C-TIME PIC 9(8). IX1154.2 +006700*P 05 C-NO-OF-TESTS PIC 99. IX1154.2 +006800*P 05 C-OK PIC 999. IX1154.2 +006900*P 05 C-ALL PIC 999. IX1154.2 +007000*P 05 C-FAIL PIC 999. IX1154.2 +007100*P 05 C-DELETED PIC 999. IX1154.2 +007200*P 05 C-INSPECT PIC 999. IX1154.2 +007300*P 05 C-NOTE PIC X(13). IX1154.2 +007400*P 05 C-INDENT PIC X. IX1154.2 +007500*P 05 C-ABORT PIC X(8). IX1154.2 +007600 IX1154.2 +007700 FD PRINT-FILE. IX1154.2 +007800 IX1154.2 +007900 01 PRINT-REC PIC X(120). IX1154.2 +008000 IX1154.2 +008100 01 DUMMY-RECORD PIC X(120). IX1154.2 +008200 IX1154.2 +008300 FD IX-FS3 IX1154.2 +008400*C DATA RECORDS IX-FS3R1-F-G-240 IX1154.2 +008500*C LABEL RECORD STANDARD IX1154.2 +008600 RECORD 240 IX1154.2 +008700 BLOCK CONTAINS 2 RECORDS. IX1154.2 +008800 IX1154.2 +008900 01 IX-FS3R1-F-G-240. IX1154.2 +009000 05 IX-FS3-REC-120 PIC X(120). IX1154.2 +009100 05 IX-FS3-REC-120-240. IX1154.2 +009200 10 FILLER PIC X(8). IX1154.2 +009300 10 IX-FS3-KEY PIC X(29). IX1154.2 +009400 10 FILLER PIC X(9). IX1154.2 +009500 10 IX-FS3-ALTER-KEY PIC X(29). IX1154.2 +009600 10 FILLER PIC X(45). IX1154.2 +009700 IX1154.2 +009800 IX1154.2 +009900 WORKING-STORAGE SECTION. IX1154.2 +010000 IX1154.2 +010100 01 GRP-0101. IX1154.2 +010200 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1154.2 +010300 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1154.2 +010400 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1154.2 +010500 IX1154.2 +010600 01 GRP-0102. IX1154.2 +010700 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1154.2 +010800 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1154.2 +010900 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1154.2 +011000 IX1154.2 +011100 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1154.2 +011200 IX1154.2 +011300 01 EOF-FLAG PIC 9 VALUE ZERO. IX1154.2 +011400 IX1154.2 +011500 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1154.2 +011600 IX1154.2 +011700 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1154.2 +011800 IX1154.2 +011900 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1154.2 +012000 IX1154.2 +012100 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1154.2 +012200 IX1154.2 +012300 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1154.2 +012400 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1154.2 +012500 IX1154.2 +012600 01 IX-FS3-STATUS. IX1154.2 +012700 05 IX-FS3-STAT1 PIC X. IX1154.2 +012800 05 IX-FS3-STAT2 PIC X. IX1154.2 +012900 IX1154.2 +013000 01 COUNT-OF-RECS PIC 9(5). IX1154.2 +013100 IX1154.2 +013200 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1154.2 +013300 IX1154.2 +013400 01 FILE-RECORD-INFORMATION-REC. IX1154.2 +013500 05 FILE-RECORD-INFO-SKELETON. IX1154.2 +013600 10 FILLER PIC X(48) VALUE IX1154.2 +013700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1154.2 +013800 10 FILLER PIC X(46) VALUE IX1154.2 +013900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1154.2 +014000 10 FILLER PIC X(26) VALUE IX1154.2 +014100 ",LFIL=000000,ORG= ,LBLR= ". IX1154.2 +014200 10 FILLER PIC X(37) VALUE IX1154.2 +014300 ",RECKEY= ". IX1154.2 +014400 10 FILLER PIC X(38) VALUE IX1154.2 +014500 ",ALTKEY1= ". IX1154.2 +014600 10 FILLER PIC X(38) VALUE IX1154.2 +014700 ",ALTKEY2= ". IX1154.2 +014800 10 FILLER PIC X(7) VALUE SPACE. IX1154.2 +014900 05 FILE-RECORD-INFO OCCURS 10. IX1154.2 +015000 10 FILE-RECORD-INFO-P1-120. IX1154.2 +015100 15 FILLER PIC X(5). IX1154.2 +015200 15 XFILE-NAME PIC X(6). IX1154.2 +015300 15 FILLER PIC X(8). IX1154.2 +015400 15 XRECORD-NAME PIC X(6). IX1154.2 +015500 15 FILLER PIC X(1). IX1154.2 +015600 15 REELUNIT-NUMBER PIC 9(1). IX1154.2 +015700 15 FILLER PIC X(7). IX1154.2 +015800 15 XRECORD-NUMBER PIC 9(6). IX1154.2 +015900 15 FILLER PIC X(6). IX1154.2 +016000 15 UPDATE-NUMBER PIC 9(2). IX1154.2 +016100 15 FILLER PIC X(5). IX1154.2 +016200 15 ODO-NUMBER PIC 9(4). IX1154.2 +016300 15 FILLER PIC X(5). IX1154.2 +016400 15 XPROGRAM-NAME PIC X(5). IX1154.2 +016500 15 FILLER PIC X(7). IX1154.2 +016600 15 XRECORD-LENGTH PIC 9(6). IX1154.2 +016700 15 FILLER PIC X(7). IX1154.2 +016800 15 CHARS-OR-RECORDS PIC X(2). IX1154.2 +016900 15 FILLER PIC X(1). IX1154.2 +017000 15 XBLOCK-SIZE PIC 9(4). IX1154.2 +017100 15 FILLER PIC X(6). IX1154.2 +017200 15 RECORDS-IN-FILE PIC 9(6). IX1154.2 +017300 15 FILLER PIC X(5). IX1154.2 +017400 15 XFILE-ORGANIZATION PIC X(2). IX1154.2 +017500 15 FILLER PIC X(6). IX1154.2 +017600 15 XLABEL-TYPE PIC X(1). IX1154.2 +017700 10 FILE-RECORD-INFO-P121-240. IX1154.2 +017800 15 FILLER PIC X(8). IX1154.2 +017900 15 XRECORD-KEY PIC X(29). IX1154.2 +018000 15 FILLER PIC X(9). IX1154.2 +018100 15 ALTERNATE-KEY1 PIC X(29). IX1154.2 +018200 15 FILLER PIC X(9). IX1154.2 +018300 15 ALTERNATE-KEY2 PIC X(29). IX1154.2 +018400 15 FILLER PIC X(7). IX1154.2 +018500 IX1154.2 +018600 01 TEST-RESULTS. IX1154.2 +018700 02 FILLER PIC X VALUE SPACE. IX1154.2 +018800 02 FEATURE PIC X(20) VALUE SPACE. IX1154.2 +018900 02 FILLER PIC X VALUE SPACE. IX1154.2 +019000 02 P-OR-F PIC X(5) VALUE SPACE. IX1154.2 +019100 02 FILLER PIC X VALUE SPACE. IX1154.2 +019200 02 PAR-NAME. IX1154.2 +019300 03 FILLER PIC X(19) VALUE SPACE. IX1154.2 +019400 03 PARDOT-X PIC X VALUE SPACE. IX1154.2 +019500 03 DOTVALUE PIC 99 VALUE ZERO. IX1154.2 +019600 02 FILLER PIC X(8) VALUE SPACE. IX1154.2 +019700 02 RE-MARK PIC X(61). IX1154.2 +019800 01 TEST-COMPUTED. IX1154.2 +019900 02 FILLER PIC X(30) VALUE SPACE. IX1154.2 +020000 02 FILLER PIC X(17) VALUE IX1154.2 +020100 " COMPUTED=". IX1154.2 +020200 02 COMPUTED-X. IX1154.2 +020300 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1154.2 +020400 03 COMPUTED-N REDEFINES COMPUTED-A IX1154.2 +020500 PIC -9(9).9(9). IX1154.2 +020600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1154.2 +020700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1154.2 +020800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1154.2 +020900 03 CM-18V0 REDEFINES COMPUTED-A. IX1154.2 +021000 04 COMPUTED-18V0 PIC -9(18). IX1154.2 +021100 04 FILLER PIC X. IX1154.2 +021200 03 FILLER PIC X(50) VALUE SPACE. IX1154.2 +021300 01 TEST-CORRECT. IX1154.2 +021400 02 FILLER PIC X(30) VALUE SPACE. IX1154.2 +021500 02 FILLER PIC X(17) VALUE " CORRECT =". IX1154.2 +021600 02 CORRECT-X. IX1154.2 +021700 03 CORRECT-A PIC X(20) VALUE SPACE. IX1154.2 +021800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1154.2 +021900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1154.2 +022000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1154.2 +022100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1154.2 +022200 03 CR-18V0 REDEFINES CORRECT-A. IX1154.2 +022300 04 CORRECT-18V0 PIC -9(18). IX1154.2 +022400 04 FILLER PIC X. IX1154.2 +022500 03 FILLER PIC X(2) VALUE SPACE. IX1154.2 +022600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1154.2 +022700 01 CCVS-C-1. IX1154.2 +022800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1154.2 +022900- "SS PARAGRAPH-NAME IX1154.2 +023000- " REMARKS". IX1154.2 +023100 02 FILLER PIC X(20) VALUE SPACE. IX1154.2 +023200 01 CCVS-C-2. IX1154.2 +023300 02 FILLER PIC X VALUE SPACE. IX1154.2 +023400 02 FILLER PIC X(6) VALUE "TESTED". IX1154.2 +023500 02 FILLER PIC X(15) VALUE SPACE. IX1154.2 +023600 02 FILLER PIC X(4) VALUE "FAIL". IX1154.2 +023700 02 FILLER PIC X(94) VALUE SPACE. IX1154.2 +023800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1154.2 +023900 01 REC-CT PIC 99 VALUE ZERO. IX1154.2 +024000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1154.2 +024100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1154.2 +024200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1154.2 +024300 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1154.2 +024400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1154.2 +024500 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1154.2 +024600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1154.2 +024700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1154.2 +024800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1154.2 +024900 01 CCVS-H-1. IX1154.2 +025000 02 FILLER PIC X(39) VALUE SPACES. IX1154.2 +025100 02 FILLER PIC X(42) VALUE IX1154.2 +025200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1154.2 +025300 02 FILLER PIC X(39) VALUE SPACES. IX1154.2 +025400 01 CCVS-H-2A. IX1154.2 +025500 02 FILLER PIC X(40) VALUE SPACE. IX1154.2 +025600 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1154.2 +025700 02 FILLER PIC XXXX VALUE IX1154.2 +025800 "4.2 ". IX1154.2 +025900 02 FILLER PIC X(28) VALUE IX1154.2 +026000 " COPY - NOT FOR DISTRIBUTION". IX1154.2 +026100 02 FILLER PIC X(41) VALUE SPACE. IX1154.2 +026200 IX1154.2 +026300 01 CCVS-H-2B. IX1154.2 +026400 02 FILLER PIC X(15) VALUE IX1154.2 +026500 "TEST RESULT OF ". IX1154.2 +026600 02 TEST-ID PIC X(9). IX1154.2 +026700 02 FILLER PIC X(4) VALUE IX1154.2 +026800 " IN ". IX1154.2 +026900 02 FILLER PIC X(12) VALUE IX1154.2 +027000 " HIGH ". IX1154.2 +027100 02 FILLER PIC X(22) VALUE IX1154.2 +027200 " LEVEL VALIDATION FOR ". IX1154.2 +027300 02 FILLER PIC X(58) VALUE IX1154.2 +027400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1154.2 +027500 01 CCVS-H-3. IX1154.2 +027600 02 FILLER PIC X(34) VALUE IX1154.2 +027700 " FOR OFFICIAL USE ONLY ". IX1154.2 +027800 02 FILLER PIC X(58) VALUE IX1154.2 +027900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1154.2 +028000 02 FILLER PIC X(28) VALUE IX1154.2 +028100 " COPYRIGHT 1985 ". IX1154.2 +028200 01 CCVS-E-1. IX1154.2 +028300 02 FILLER PIC X(52) VALUE SPACE. IX1154.2 +028400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1154.2 +028500 02 ID-AGAIN PIC X(9). IX1154.2 +028600 02 FILLER PIC X(45) VALUE SPACES. IX1154.2 +028700 01 CCVS-E-2. IX1154.2 +028800 02 FILLER PIC X(31) VALUE SPACE. IX1154.2 +028900 02 FILLER PIC X(21) VALUE SPACE. IX1154.2 +029000 02 CCVS-E-2-2. IX1154.2 +029100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1154.2 +029200 03 FILLER PIC X VALUE SPACE. IX1154.2 +029300 03 ENDER-DESC PIC X(44) VALUE IX1154.2 +029400 "ERRORS ENCOUNTERED". IX1154.2 +029500 01 CCVS-E-3. IX1154.2 +029600 02 FILLER PIC X(22) VALUE IX1154.2 +029700 " FOR OFFICIAL USE ONLY". IX1154.2 +029800 02 FILLER PIC X(12) VALUE SPACE. IX1154.2 +029900 02 FILLER PIC X(58) VALUE IX1154.2 +030000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1154.2 +030100 02 FILLER PIC X(13) VALUE SPACE. IX1154.2 +030200 02 FILLER PIC X(15) VALUE IX1154.2 +030300 " COPYRIGHT 1985". IX1154.2 +030400 01 CCVS-E-4. IX1154.2 +030500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1154.2 +030600 02 FILLER PIC X(4) VALUE " OF ". IX1154.2 +030700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1154.2 +030800 02 FILLER PIC X(40) VALUE IX1154.2 +030900 " TESTS WERE EXECUTED SUCCESSFULLY". IX1154.2 +031000 01 XXINFO. IX1154.2 +031100 02 FILLER PIC X(19) VALUE IX1154.2 +031200 "*** INFORMATION ***". IX1154.2 +031300 02 INFO-TEXT. IX1154.2 +031400 04 FILLER PIC X(8) VALUE SPACE. IX1154.2 +031500 04 XXCOMPUTED PIC X(20). IX1154.2 +031600 04 FILLER PIC X(5) VALUE SPACE. IX1154.2 +031700 04 XXCORRECT PIC X(20). IX1154.2 +031800 02 INF-ANSI-REFERENCE PIC X(48). IX1154.2 +031900 01 HYPHEN-LINE. IX1154.2 +032000 02 FILLER PIC IS X VALUE IS SPACE. IX1154.2 +032100 02 FILLER PIC IS X(65) VALUE IS "************************IX1154.2 +032200- "*****************************************". IX1154.2 +032300 02 FILLER PIC IS X(54) VALUE IS "************************IX1154.2 +032400- "******************************". IX1154.2 +032500 01 TEST-NO PIC 99. IX1154.2 +032600 01 CCVS-PGM-ID PIC X(9) VALUE IX1154.2 +032700 "IX115A". IX1154.2 +032800 PROCEDURE DIVISION. IX1154.2 +032900 DECLARATIVES. IX1154.2 +033000 IX1154.2 +033100 SECT-IX105-0002 SECTION. IX1154.2 +033200 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1154.2 +033300 INPUT-PROCESS. IX1154.2 +033400 IF TEST-NO = 5 IX1154.2 +033500 GO TO D-C-TEST-GF-01-1. IX1154.2 +033600 IF STATUS-TEST-10 EQUAL TO 1 IX1154.2 +033700 IF IX-FS3-STAT1 EQUAL TO "1" IX1154.2 +033800 MOVE 1 TO EOF-FLAG IX1154.2 +033900 ELSE IX1154.2 +034000 IF IX-FS3-STAT1 GREATER THAN "1" IX1154.2 +034100 MOVE 1 TO PERM-ERRORS. IX1154.2 +034200 GO TO DECL-EXIT. IX1154.2 +034300 D-C-TEST-GF-01-1. IX1154.2 +034400 IF IX-FS3-STATUS EQUAL TO "48" IX1154.2 +034500 GO TO D-C-PASS-GF-01-0. IX1154.2 +034600 D-C-FAIL-GF-01-0. IX1154.2 +034700 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1154.2 +034800 MOVE "48" TO CORRECT-X. IX1154.2 +034900 MOVE "IX-5, 1.3.4, (5) G" TO RE-MARK. IX1154.2 +035000 PERFORM D-FAIL. IX1154.2 +035100 GO TO D-C-WRITE-GF-01-0. IX1154.2 +035200 D-C-PASS-GF-01-0. IX1154.2 +035300 PERFORM D-PASS. IX1154.2 +035400 D-C-WRITE-GF-01-0. IX1154.2 +035500 PERFORM D-PRINT-DETAIL. IX1154.2 +035600 D-CLOSE-FILES. IX1154.2 +035700*P OPEN I-O RAW-DATA. IX1154.2 +035800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1154.2 +035900*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1154.2 +036000*P MOVE "OK. " TO C-ABORT. IX1154.2 +036100*P MOVE PASS-COUNTER TO C-OK. IX1154.2 +036200*P MOVE ERROR-HOLD TO C-ALL. IX1154.2 +036300*P MOVE ERROR-COUNTER TO C-FAIL. IX1154.2 +036400*P MOVE DELETE-COUNTER TO C-DELETED. IX1154.2 +036500*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1154.2 +036600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1154.2 +036700*P-END-E-2. IX1154.2 +036800*P CLOSE RAW-DATA. IX1154.2 +036900 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1154.2 +037000 CLOSE PRINT-FILE. IX1154.2 +037100 D-TERMINATE-CCVS. IX1154.2 +037200*S EXIT PROGRAM. IX1154.2 +037300*S-TERMINATE-CALL. IX1154.2 +037400 STOP RUN. IX1154.2 +037500 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1154.2 +037600 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1154.2 +037700 D-PRINT-DETAIL. IX1154.2 +037800 IF REC-CT NOT EQUAL TO ZERO IX1154.2 +037900 MOVE "." TO PARDOT-X IX1154.2 +038000 MOVE REC-CT TO DOTVALUE. IX1154.2 +038100 MOVE TEST-RESULTS TO PRINT-REC. IX1154.2 +038200 PERFORM D-WRITE-LINE. IX1154.2 +038300 IF P-OR-F EQUAL TO "FAIL*" IX1154.2 +038400 PERFORM D-WRITE-LINE IX1154.2 +038500 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1154.2 +038600 ELSE IX1154.2 +038700 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1154.2 +038800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1154.2 +038900 MOVE SPACE TO CORRECT-X. IX1154.2 +039000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1154.2 +039100 MOVE SPACE TO RE-MARK. IX1154.2 +039200 D-END-ROUTINE. IX1154.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1154.2 +039400 PERFORM D-WRITE-LINE 5 TIMES. IX1154.2 +039500 D-END-RTN-EXIT. IX1154.2 +039600 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1154.2 +039700 PERFORM D-WRITE-LINE 2 TIMES. IX1154.2 +039800 D-END-ROUTINE-1. IX1154.2 +039900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1154.2 +040000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1154.2 +040100 ADD PASS-COUNTER TO ERROR-HOLD. IX1154.2 +040200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1154.2 +040300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1154.2 +040400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1154.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1154.2 +040600 D-END-ROUTINE-12. IX1154.2 +040700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1154.2 +040800 IF ERROR-COUNTER IS EQUAL TO ZERO IX1154.2 +040900 MOVE "NO " TO ERROR-TOTAL IX1154.2 +041000 ELSE IX1154.2 +041100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1154.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1154.2 +041300 PERFORM D-WRITE-LINE. IX1154.2 +041400 D-END-ROUTINE-13. IX1154.2 +041500 IF DELETE-COUNTER IS EQUAL TO ZERO IX1154.2 +041600 MOVE "NO " TO ERROR-TOTAL ELSE IX1154.2 +041700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1154.2 +041800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1154.2 +041900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1154.2 +042000 PERFORM D-WRITE-LINE. IX1154.2 +042100 IF INSPECT-COUNTER EQUAL TO ZERO IX1154.2 +042200 MOVE "NO " TO ERROR-TOTAL IX1154.2 +042300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1154.2 +042400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1154.2 +042500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1154.2 +042600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1154.2 +042700 D-WRITE-LINE. IX1154.2 +042800 ADD 1 TO RECORD-COUNT. IX1154.2 +042900 IF RECORD-COUNT GREATER 42 IX1154.2 +043000 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1154.2 +043100 MOVE SPACE TO DUMMY-RECORD IX1154.2 +043200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1154.2 +043300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1154.2 +043400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1154.2 +043500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1154.2 +043600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1154.2 +043700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1154.2 +043800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1154.2 +043900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1154.2 +044000 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1154.2 +044100 MOVE ZERO TO RECORD-COUNT. IX1154.2 +044200 PERFORM D-WRT-LN. IX1154.2 +044300 D-WRT-LN. IX1154.2 +044400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1154.2 +044500 MOVE SPACE TO DUMMY-RECORD. IX1154.2 +044600 D-FAIL-ROUTINE. IX1154.2 +044700 IF COMPUTED-X NOT EQUAL TO SPACE IX1154.2 +044800 GO TO D-FAIL-ROUTINE-WRITE. IX1154.2 +044900 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1154.2 +045000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1154.2 +045100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1154.2 +045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1154.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1154.2 +045400 GO TO D-FAIL-ROUTINE-EX. IX1154.2 +045500 D-FAIL-ROUTINE-WRITE. IX1154.2 +045600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1154.2 +045700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1154.2 +045800 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1154.2 +045900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1154.2 +046000 D-FAIL-ROUTINE-EX. EXIT. IX1154.2 +046100 D-BAIL-OUT. IX1154.2 +046200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1154.2 +046300 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1154.2 +046400 D-BAIL-OUT-WRITE. IX1154.2 +046500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1154.2 +046600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1154.2 +046700 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1154.2 +046800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1154.2 +046900 D-BAIL-OUT-EX. EXIT. IX1154.2 +047000 DECL-EXIT. EXIT. IX1154.2 +047100 END DECLARATIVES. IX1154.2 +047200 IX1154.2 +047300 IX1154.2 +047400 CCVS1 SECTION. IX1154.2 +047500 OPEN-FILES. IX1154.2 +047600*P OPEN I-O RAW-DATA. IX1154.2 +047700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1154.2 +047800*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1154.2 +047900*P MOVE "ABORTED " TO C-ABORT. IX1154.2 +048000*P ADD 1 TO C-NO-OF-TESTS. IX1154.2 +048100*P ACCEPT C-DATE FROM DATE. IX1154.2 +048200*P ACCEPT C-TIME FROM TIME. IX1154.2 +048300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1154.2 +048400*PND-E-1. IX1154.2 +048500*P CLOSE RAW-DATA. IX1154.2 +048600 OPEN OUTPUT PRINT-FILE. IX1154.2 +048700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1154.2 +048800 MOVE SPACE TO TEST-RESULTS. IX1154.2 +048900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1154.2 +049000 MOVE ZERO TO REC-SKL-SUB. IX1154.2 +049100 PERFORM CCVS-INIT-FILE 9 TIMES. IX1154.2 +049200 CCVS-INIT-FILE. IX1154.2 +049300 ADD 1 TO REC-SKL-SUB. IX1154.2 +049400 MOVE FILE-RECORD-INFO-SKELETON IX1154.2 +049500 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1154.2 +049600 CCVS-INIT-EXIT. IX1154.2 +049700 GO TO CCVS1-EXIT. IX1154.2 +049800 CLOSE-FILES. IX1154.2 +049900*P OPEN I-O RAW-DATA. IX1154.2 +050000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1154.2 +050100*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1154.2 +050200*P MOVE "OK. " TO C-ABORT. IX1154.2 +050300*P MOVE PASS-COUNTER TO C-OK. IX1154.2 +050400*P MOVE ERROR-HOLD TO C-ALL. IX1154.2 +050500*P MOVE ERROR-COUNTER TO C-FAIL. IX1154.2 +050600*P MOVE DELETE-COUNTER TO C-DELETED. IX1154.2 +050700*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1154.2 +050800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1154.2 +050900*PND-E-2. IX1154.2 +051000*P CLOSE RAW-DATA. IX1154.2 +051100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1154.2 +051200 TERMINATE-CCVS. IX1154.2 +051300*S EXIT PROGRAM. IX1154.2 +051400*SERMINATE-CALL. IX1154.2 +051500 STOP RUN. IX1154.2 +051600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1154.2 +051700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1154.2 +051800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1154.2 +051900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1154.2 +052000 MOVE "****TEST DELETED****" TO RE-MARK. IX1154.2 +052100 PRINT-DETAIL. IX1154.2 +052200 IF REC-CT NOT EQUAL TO ZERO IX1154.2 +052300 MOVE "." TO PARDOT-X IX1154.2 +052400 MOVE REC-CT TO DOTVALUE. IX1154.2 +052500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1154.2 +052600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1154.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1154.2 +052800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1154.2 +052900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1154.2 +053000 MOVE SPACE TO CORRECT-X. IX1154.2 +053100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1154.2 +053200 MOVE SPACE TO RE-MARK. IX1154.2 +053300 HEAD-ROUTINE. IX1154.2 +053400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +053500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +053600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1154.2 +053700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1154.2 +053800 COLUMN-NAMES-ROUTINE. IX1154.2 +053900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +054000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +054200 END-ROUTINE. IX1154.2 +054300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1154.2 +054400 END-RTN-EXIT. IX1154.2 +054500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +054600 END-ROUTINE-1. IX1154.2 +054700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1154.2 +054800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1154.2 +054900 ADD PASS-COUNTER TO ERROR-HOLD. IX1154.2 +055000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1154.2 +055100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1154.2 +055200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1154.2 +055300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1154.2 +055400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1154.2 +055500 END-ROUTINE-12. IX1154.2 +055600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1154.2 +055700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1154.2 +055800 MOVE "NO " TO ERROR-TOTAL IX1154.2 +055900 ELSE IX1154.2 +056000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1154.2 +056100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1154.2 +056200 PERFORM WRITE-LINE. IX1154.2 +056300 END-ROUTINE-13. IX1154.2 +056400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1154.2 +056500 MOVE "NO " TO ERROR-TOTAL ELSE IX1154.2 +056600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1154.2 +056700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1154.2 +056800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +056900 IF INSPECT-COUNTER EQUAL TO ZERO IX1154.2 +057000 MOVE "NO " TO ERROR-TOTAL IX1154.2 +057100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1154.2 +057200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1154.2 +057300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +057400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1154.2 +057500 WRITE-LINE. IX1154.2 +057600 ADD 1 TO RECORD-COUNT. IX1154.2 +057700 IF RECORD-COUNT GREATER 42 IX1154.2 +057800 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1154.2 +057900 MOVE SPACE TO DUMMY-RECORD IX1154.2 +058000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1154.2 +058100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1154.2 +058200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1154.2 +058300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1154.2 +058400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1154.2 +058500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1154.2 +058600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1154.2 +058700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1154.2 +058800 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1154.2 +058900 MOVE ZERO TO RECORD-COUNT. IX1154.2 +059000 PERFORM WRT-LN. IX1154.2 +059100 WRT-LN. IX1154.2 +059200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1154.2 +059300 MOVE SPACE TO DUMMY-RECORD. IX1154.2 +059400 BLANK-LINE-PRINT. IX1154.2 +059500 PERFORM WRT-LN. IX1154.2 +059600 FAIL-ROUTINE. IX1154.2 +059700 IF COMPUTED-X NOT EQUAL TO SPACE IX1154.2 +059800 GO TO FAIL-ROUTINE-WRITE. IX1154.2 +059900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1154.2 +060000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1154.2 +060100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1154.2 +060200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +060300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1154.2 +060400 GO TO FAIL-ROUTINE-EX. IX1154.2 +060500 FAIL-ROUTINE-WRITE. IX1154.2 +060600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1154.2 +060700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1154.2 +060800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1154.2 +060900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1154.2 +061000 FAIL-ROUTINE-EX. EXIT. IX1154.2 +061100 BAIL-OUT. IX1154.2 +061200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1154.2 +061300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1154.2 +061400 BAIL-OUT-WRITE. IX1154.2 +061500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1154.2 +061600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1154.2 +061700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1154.2 +061800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1154.2 +061900 BAIL-OUT-EX. EXIT. IX1154.2 +062000 CCVS1-EXIT. IX1154.2 +062100 EXIT. IX1154.2 +062200 IX1154.2 +062300 SECT-IX115A-0003 SECTION. IX1154.2 +062400 SEQ-INIT-010. IX1154.2 +062500 MOVE ZERO TO TEST-NO. IX1154.2 +062600 MOVE "IX-FS3" TO XFILE-NAME (1). IX1154.2 +062700 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1154.2 +062800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1154.2 +062900 MOVE 000240 TO XRECORD-LENGTH (1). IX1154.2 +063000 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1154.2 +063100 MOVE 0002 TO XBLOCK-SIZE (1). IX1154.2 +063200 MOVE 000050 TO RECORDS-IN-FILE (1). IX1154.2 +063300 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1154.2 +063400 MOVE "S" TO XLABEL-TYPE (1). IX1154.2 +063500 MOVE 000001 TO XRECORD-NUMBER (1). IX1154.2 +063600 MOVE 0 TO COUNT-OF-RECS. IX1154.2 +063700 IX1154.2 +063800******************************************************************IX1154.2 +063900* TEST 1 *IX1154.2 +064000* OPEN I-O IX1154.2 +064100* IX-3, 1.3.4 (1) A *IX1154.2 +064200* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1154.2 +064300* THE OPEN STATEMENT IS SUCCESSFULLY EXECUTED *IX1154.2 +064400******************************************************************IX1154.2 +064500 OPN-INIT-GF-01-0. IX1154.2 +064600 MOVE 1 TO STATUS-TEST-00. IX1154.2 +064700 MOVE SPACES TO IX-FS3-STATUS. IX1154.2 +064800 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1154.2 +064900 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1154.2 +065000 OPEN IX1154.2 +065100 I-O IX-FS3. IX1154.2 +065200 IF IX-FS3-STATUS EQUAL TO "00" IX1154.2 +065300 GO TO OPN-PASS-GF-01-0. IX1154.2 +065400 OPN-FAIL-GF-01-0. IX1154.2 +065500 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1154.2 +065600 PERFORM FAIL. IX1154.2 +065700 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1154.2 +065800 MOVE "00" TO CORRECT-X. IX1154.2 +065900 GO TO OPN-WRITE-GF-01-0. IX1154.2 +066000 OPN-PASS-GF-01-0. IX1154.2 +066100 PERFORM PASS. IX1154.2 +066200 OPN-WRITE-GF-01-0. IX1154.2 +066300 PERFORM PRINT-DETAIL. IX1154.2 +066400******************************************************************IX1154.2 +066500* TEST 4 *IX1154.2 +066600* CLOSE I-O 00 EXPECTED *IX1154.2 +066700* IX-3, 1.3.4 (1) A *IX1154.2 +066800******************************************************************IX1154.2 +066900 CLO-INIT-GF-01-0. IX1154.2 +067000 MOVE SPACES TO IX-FS3-STATUS. IX1154.2 +067100 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1154.2 +067200 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1154.2 +067300 CLO-TEST-GF-01-0. IX1154.2 +067400 CLOSE IX-FS3. IX1154.2 +067500 IF IX-FS3-STATUS = "00" IX1154.2 +067600 GO TO CLO-PASS-GF-01-0. IX1154.2 +067700 CLO-FAIL-GF-01-0. IX1154.2 +067800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1154.2 +067900 PERFORM FAIL. IX1154.2 +068000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1154.2 +068100 MOVE "00" TO CORRECT-X. IX1154.2 +068200 GO TO CLO-WRITE-GF-01-0. IX1154.2 +068300 CLO-PASS-GF-01-0. IX1154.2 +068400 PERFORM PASS. IX1154.2 +068500 CLO-WRITE-GF-01-0. IX1154.2 +068600 PERFORM PRINT-DETAIL. IX1154.2 +068700 IX1154.2 +068800******************************************************************IX1154.2 +068900* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1154.2 +069000******************************************************************IX1154.2 +069100 IX1154.2 +069200******************************************************************IX1154.2 +069300* TEST 5 *IX1154.2 +069400* WRITE... A FILE NOT IN THE OPEN MODE *IX1154.2 +069500* FILE STATUS 48 EXPECTED IX-5, 1.3.4 (5) G *IX1154.2 +069600******************************************************************IX1154.2 +069700 WRI-TEST-GF-01-0. IX1154.2 +069800 MOVE 5 TO TEST-NO. IX1154.2 +069900 MOVE SPACES TO IX-FS3-STATUS. IX1154.2 +070000 MOVE "WRITE. 48 EXP." TO FEATURE IX1154.2 +070100 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1154.2 +070200 WRITE IX-FS3R1-F-G-240. IX1154.2 +070300 WRI-TEST-GF-01-1. IX1154.2 +070400 IF IX-FS3-STATUS EQUAL TO "48" IX1154.2 +070500 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1154.2 +070600 TO RE-MARK IX1154.2 +070700 GO TO WRI-WRITE-GF-01-0. IX1154.2 +070800 WRI-FAIL-GF-01-0. IX1154.2 +070900 MOVE "IX-5, 1.3.4, (5) G" TO RE-MARK. IX1154.2 +071000 WRI-WRITE-GF-01-0. IX1154.2 +071100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1154.2 +071200 MOVE "48" TO CORRECT-X. IX1154.2 +071300 PERFORM FAIL. IX1154.2 +071400 PERFORM PRINT-DETAIL. IX1154.2 +071500 IX1154.2 +071600 TERMINATE-ROUTINE. IX1154.2 +071700 EXIT. IX1154.2 +071800 IX1154.2 +071900 CCVS-EXIT SECTION. IX1154.2 +072000 CCVS-999999. IX1154.2 +072100 GO TO CLOSE-FILES. IX1154.2 diff --git a/tests/cobol85/IX/IX116A.SUB b/tests/cobol85/IX/IX116A.SUB new file mode 100755 index 00000000..35e6373a --- /dev/null +++ b/tests/cobol85/IX/IX116A.SUB @@ -0,0 +1,721 @@ +000100 IDENTIFICATION DIVISION. IX1164.2 +000200 PROGRAM-ID. IX1164.2 +000300 IX116A. IX1164.2 +000400**************************************************************** IX1164.2 +000500* * IX1164.2 +000600* VALIDATION FOR:- * IX1164.2 +000700* * IX1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1164.2 +000900* * IX1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1164.2 +001100* * IX1164.2 +001200**************************************************************** IX1164.2 +001300* IX1164.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1164.2 +001500* IX113A. IX1164.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1164.2 +001700* CLOSED AND THE STATUS CHECKED (00 EXPECTED) THEN AN ATTEMPT IX1164.2 +001800* IS MADE TO DELETE A RECORD, AT WHICH POINT THE DECLARATIVES IX1164.2 +001900* SHOULD BE ACTIONED AND THE FILE STATUS SHOULD BE 49 . IX1164.2 +002000* IX1164.2 +002100* STANDARD REFERENCE IX-5, 1.3.4 (5) H IX1164.2 +002200* IX1164.2 +002300* X-CARDS USED IN THIS PROGRAM: IX1164.2 +002400* IX1164.2 +002500* XXXXX024 IX1164.2 +002600* XXXXX055. IX1164.2 +002700* P XXXXX062. IX1164.2 +002800* XXXXX082. IX1164.2 +002900* XXXXX083. IX1164.2 +003000* C XXXXX084 IX1164.2 +003100* IX1164.2 +003200* IX1164.2 +003300 ENVIRONMENT DIVISION. IX1164.2 +003400 CONFIGURATION SECTION. IX1164.2 +003500 SOURCE-COMPUTER. IX1164.2 +003600 Linux. IX1164.2 +003700 OBJECT-COMPUTER. IX1164.2 +003800 Linux. IX1164.2 +003900 INPUT-OUTPUT SECTION. IX1164.2 +004000 FILE-CONTROL. IX1164.2 +004100*P SELECT RAW-DATA ASSIGN TO IX1164.2 +004200*P "XXXXX062" IX1164.2 +004300*P ORGANIZATION IS INDEXED IX1164.2 +004400*P ACCESS MODE IS RANDOM IX1164.2 +004500*P RECORD KEY IS RAW-DATA-KEY. IX1164.2 +004600* IX1164.2 +004700 SELECT PRINT-FILE ASSIGN TO IX1164.2 +004800 "report.log". IX1164.2 +004900* IX1164.2 +005000 SELECT IX-FS3 ASSIGN IX1164.2 +005100 "XXXXX024" IX1164.2 +005200 ORGANIZATION IS INDEXED IX1164.2 +005300 ACCESS MODE IS SEQUENTIAL IX1164.2 +005400 RECORD KEY IS IX-FS3-KEY IX1164.2 +005500 FILE STATUS IS IX-FS3-STATUS. IX1164.2 +005600 IX1164.2 +005700 DATA DIVISION. IX1164.2 +005800 IX1164.2 +005900 FILE SECTION. IX1164.2 +006000*P IX1164.2 +006100*PD RAW-DATA. IX1164.2 +006200*P IX1164.2 +006300*P1 RAW-DATA-SATZ. IX1164.2 +006400*P 05 RAW-DATA-KEY PIC X(6). IX1164.2 +006500*P 05 C-DATE PIC 9(6). IX1164.2 +006600*P 05 C-TIME PIC 9(8). IX1164.2 +006700*P 05 C-NO-OF-TESTS PIC 99. IX1164.2 +006800*P 05 C-OK PIC 999. IX1164.2 +006900*P 05 C-ALL PIC 999. IX1164.2 +007000*P 05 C-FAIL PIC 999. IX1164.2 +007100*P 05 C-DELETED PIC 999. IX1164.2 +007200*P 05 C-INSPECT PIC 999. IX1164.2 +007300*P 05 C-NOTE PIC X(13). IX1164.2 +007400*P 05 C-INDENT PIC X. IX1164.2 +007500*P 05 C-ABORT PIC X(8). IX1164.2 +007600 IX1164.2 +007700 FD PRINT-FILE. IX1164.2 +007800 IX1164.2 +007900 01 PRINT-REC PIC X(120). IX1164.2 +008000 IX1164.2 +008100 01 DUMMY-RECORD PIC X(120). IX1164.2 +008200 IX1164.2 +008300 FD IX-FS3 IX1164.2 +008400*C DATA RECORDS IX-FS3R1-F-G-240 IX1164.2 +008500*C LABEL RECORD STANDARD IX1164.2 +008600 RECORD 240 IX1164.2 +008700 BLOCK CONTAINS 2 RECORDS. IX1164.2 +008800 IX1164.2 +008900 01 IX-FS3R1-F-G-240. IX1164.2 +009000 05 IX-FS3-REC-120 PIC X(120). IX1164.2 +009100 05 IX-FS3-REC-120-240. IX1164.2 +009200 10 FILLER PIC X(8). IX1164.2 +009300 10 IX-FS3-KEY PIC X(29). IX1164.2 +009400 10 FILLER PIC X(9). IX1164.2 +009500 10 IX-FS3-ALTER-KEY PIC X(29). IX1164.2 +009600 10 FILLER PIC X(45). IX1164.2 +009700 IX1164.2 +009800 IX1164.2 +009900 WORKING-STORAGE SECTION. IX1164.2 +010000 IX1164.2 +010100 01 GRP-0101. IX1164.2 +010200 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1164.2 +010300 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1164.2 +010400 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1164.2 +010500 IX1164.2 +010600 01 GRP-0102. IX1164.2 +010700 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1164.2 +010800 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1164.2 +010900 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1164.2 +011000 IX1164.2 +011100 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1164.2 +011200 IX1164.2 +011300 01 EOF-FLAG PIC 9 VALUE ZERO. IX1164.2 +011400 IX1164.2 +011500 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1164.2 +011600 IX1164.2 +011700 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1164.2 +011800 IX1164.2 +011900 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1164.2 +012000 IX1164.2 +012100 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1164.2 +012200 IX1164.2 +012300 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1164.2 +012400 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1164.2 +012500 IX1164.2 +012600 01 IX-FS3-STATUS. IX1164.2 +012700 05 IX-FS3-STAT1 PIC X. IX1164.2 +012800 05 IX-FS3-STAT2 PIC X. IX1164.2 +012900 IX1164.2 +013000 01 COUNT-OF-RECS PIC 9(5). IX1164.2 +013100 IX1164.2 +013200 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1164.2 +013300 IX1164.2 +013400 01 FILE-RECORD-INFORMATION-REC. IX1164.2 +013500 05 FILE-RECORD-INFO-SKELETON. IX1164.2 +013600 10 FILLER PIC X(48) VALUE IX1164.2 +013700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1164.2 +013800 10 FILLER PIC X(46) VALUE IX1164.2 +013900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1164.2 +014000 10 FILLER PIC X(26) VALUE IX1164.2 +014100 ",LFIL=000000,ORG= ,LBLR= ". IX1164.2 +014200 10 FILLER PIC X(37) VALUE IX1164.2 +014300 ",RECKEY= ". IX1164.2 +014400 10 FILLER PIC X(38) VALUE IX1164.2 +014500 ",ALTKEY1= ". IX1164.2 +014600 10 FILLER PIC X(38) VALUE IX1164.2 +014700 ",ALTKEY2= ". IX1164.2 +014800 10 FILLER PIC X(7) VALUE SPACE. IX1164.2 +014900 05 FILE-RECORD-INFO OCCURS 10. IX1164.2 +015000 10 FILE-RECORD-INFO-P1-120. IX1164.2 +015100 15 FILLER PIC X(5). IX1164.2 +015200 15 XFILE-NAME PIC X(6). IX1164.2 +015300 15 FILLER PIC X(8). IX1164.2 +015400 15 XRECORD-NAME PIC X(6). IX1164.2 +015500 15 FILLER PIC X(1). IX1164.2 +015600 15 REELUNIT-NUMBER PIC 9(1). IX1164.2 +015700 15 FILLER PIC X(7). IX1164.2 +015800 15 XRECORD-NUMBER PIC 9(6). IX1164.2 +015900 15 FILLER PIC X(6). IX1164.2 +016000 15 UPDATE-NUMBER PIC 9(2). IX1164.2 +016100 15 FILLER PIC X(5). IX1164.2 +016200 15 ODO-NUMBER PIC 9(4). IX1164.2 +016300 15 FILLER PIC X(5). IX1164.2 +016400 15 XPROGRAM-NAME PIC X(5). IX1164.2 +016500 15 FILLER PIC X(7). IX1164.2 +016600 15 XRECORD-LENGTH PIC 9(6). IX1164.2 +016700 15 FILLER PIC X(7). IX1164.2 +016800 15 CHARS-OR-RECORDS PIC X(2). IX1164.2 +016900 15 FILLER PIC X(1). IX1164.2 +017000 15 XBLOCK-SIZE PIC 9(4). IX1164.2 +017100 15 FILLER PIC X(6). IX1164.2 +017200 15 RECORDS-IN-FILE PIC 9(6). IX1164.2 +017300 15 FILLER PIC X(5). IX1164.2 +017400 15 XFILE-ORGANIZATION PIC X(2). IX1164.2 +017500 15 FILLER PIC X(6). IX1164.2 +017600 15 XLABEL-TYPE PIC X(1). IX1164.2 +017700 10 FILE-RECORD-INFO-P121-240. IX1164.2 +017800 15 FILLER PIC X(8). IX1164.2 +017900 15 XRECORD-KEY PIC X(29). IX1164.2 +018000 15 FILLER PIC X(9). IX1164.2 +018100 15 ALTERNATE-KEY1 PIC X(29). IX1164.2 +018200 15 FILLER PIC X(9). IX1164.2 +018300 15 ALTERNATE-KEY2 PIC X(29). IX1164.2 +018400 15 FILLER PIC X(7). IX1164.2 +018500 IX1164.2 +018600 01 TEST-RESULTS. IX1164.2 +018700 02 FILLER PIC X VALUE SPACE. IX1164.2 +018800 02 FEATURE PIC X(20) VALUE SPACE. IX1164.2 +018900 02 FILLER PIC X VALUE SPACE. IX1164.2 +019000 02 P-OR-F PIC X(5) VALUE SPACE. IX1164.2 +019100 02 FILLER PIC X VALUE SPACE. IX1164.2 +019200 02 PAR-NAME. IX1164.2 +019300 03 FILLER PIC X(19) VALUE SPACE. IX1164.2 +019400 03 PARDOT-X PIC X VALUE SPACE. IX1164.2 +019500 03 DOTVALUE PIC 99 VALUE ZERO. IX1164.2 +019600 02 FILLER PIC X(8) VALUE SPACE. IX1164.2 +019700 02 RE-MARK PIC X(61). IX1164.2 +019800 01 TEST-COMPUTED. IX1164.2 +019900 02 FILLER PIC X(30) VALUE SPACE. IX1164.2 +020000 02 FILLER PIC X(17) VALUE IX1164.2 +020100 " COMPUTED=". IX1164.2 +020200 02 COMPUTED-X. IX1164.2 +020300 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1164.2 +020400 03 COMPUTED-N REDEFINES COMPUTED-A IX1164.2 +020500 PIC -9(9).9(9). IX1164.2 +020600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1164.2 +020700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1164.2 +020800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1164.2 +020900 03 CM-18V0 REDEFINES COMPUTED-A. IX1164.2 +021000 04 COMPUTED-18V0 PIC -9(18). IX1164.2 +021100 04 FILLER PIC X. IX1164.2 +021200 03 FILLER PIC X(50) VALUE SPACE. IX1164.2 +021300 01 TEST-CORRECT. IX1164.2 +021400 02 FILLER PIC X(30) VALUE SPACE. IX1164.2 +021500 02 FILLER PIC X(17) VALUE " CORRECT =". IX1164.2 +021600 02 CORRECT-X. IX1164.2 +021700 03 CORRECT-A PIC X(20) VALUE SPACE. IX1164.2 +021800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1164.2 +021900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1164.2 +022000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1164.2 +022100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1164.2 +022200 03 CR-18V0 REDEFINES CORRECT-A. IX1164.2 +022300 04 CORRECT-18V0 PIC -9(18). IX1164.2 +022400 04 FILLER PIC X. IX1164.2 +022500 03 FILLER PIC X(2) VALUE SPACE. IX1164.2 +022600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1164.2 +022700 01 CCVS-C-1. IX1164.2 +022800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1164.2 +022900- "SS PARAGRAPH-NAME IX1164.2 +023000- " REMARKS". IX1164.2 +023100 02 FILLER PIC X(20) VALUE SPACE. IX1164.2 +023200 01 CCVS-C-2. IX1164.2 +023300 02 FILLER PIC X VALUE SPACE. IX1164.2 +023400 02 FILLER PIC X(6) VALUE "TESTED". IX1164.2 +023500 02 FILLER PIC X(15) VALUE SPACE. IX1164.2 +023600 02 FILLER PIC X(4) VALUE "FAIL". IX1164.2 +023700 02 FILLER PIC X(94) VALUE SPACE. IX1164.2 +023800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1164.2 +023900 01 REC-CT PIC 99 VALUE ZERO. IX1164.2 +024000 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1164.2 +024100 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1164.2 +024200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1164.2 +024300 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1164.2 +024400 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1164.2 +024500 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1164.2 +024600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1164.2 +024700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1164.2 +024800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1164.2 +024900 01 CCVS-H-1. IX1164.2 +025000 02 FILLER PIC X(39) VALUE SPACES. IX1164.2 +025100 02 FILLER PIC X(42) VALUE IX1164.2 +025200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1164.2 +025300 02 FILLER PIC X(39) VALUE SPACES. IX1164.2 +025400 01 CCVS-H-2A. IX1164.2 +025500 02 FILLER PIC X(40) VALUE SPACE. IX1164.2 +025600 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1164.2 +025700 02 FILLER PIC XXXX VALUE IX1164.2 +025800 "4.2 ". IX1164.2 +025900 02 FILLER PIC X(28) VALUE IX1164.2 +026000 " COPY - NOT FOR DISTRIBUTION". IX1164.2 +026100 02 FILLER PIC X(41) VALUE SPACE. IX1164.2 +026200 IX1164.2 +026300 01 CCVS-H-2B. IX1164.2 +026400 02 FILLER PIC X(15) VALUE IX1164.2 +026500 "TEST RESULT OF ". IX1164.2 +026600 02 TEST-ID PIC X(9). IX1164.2 +026700 02 FILLER PIC X(4) VALUE IX1164.2 +026800 " IN ". IX1164.2 +026900 02 FILLER PIC X(12) VALUE IX1164.2 +027000 " HIGH ". IX1164.2 +027100 02 FILLER PIC X(22) VALUE IX1164.2 +027200 " LEVEL VALIDATION FOR ". IX1164.2 +027300 02 FILLER PIC X(58) VALUE IX1164.2 +027400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1164.2 +027500 01 CCVS-H-3. IX1164.2 +027600 02 FILLER PIC X(34) VALUE IX1164.2 +027700 " FOR OFFICIAL USE ONLY ". IX1164.2 +027800 02 FILLER PIC X(58) VALUE IX1164.2 +027900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1164.2 +028000 02 FILLER PIC X(28) VALUE IX1164.2 +028100 " COPYRIGHT 1985 ". IX1164.2 +028200 01 CCVS-E-1. IX1164.2 +028300 02 FILLER PIC X(52) VALUE SPACE. IX1164.2 +028400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1164.2 +028500 02 ID-AGAIN PIC X(9). IX1164.2 +028600 02 FILLER PIC X(45) VALUE SPACES. IX1164.2 +028700 01 CCVS-E-2. IX1164.2 +028800 02 FILLER PIC X(31) VALUE SPACE. IX1164.2 +028900 02 FILLER PIC X(21) VALUE SPACE. IX1164.2 +029000 02 CCVS-E-2-2. IX1164.2 +029100 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1164.2 +029200 03 FILLER PIC X VALUE SPACE. IX1164.2 +029300 03 ENDER-DESC PIC X(44) VALUE IX1164.2 +029400 "ERRORS ENCOUNTERED". IX1164.2 +029500 01 CCVS-E-3. IX1164.2 +029600 02 FILLER PIC X(22) VALUE IX1164.2 +029700 " FOR OFFICIAL USE ONLY". IX1164.2 +029800 02 FILLER PIC X(12) VALUE SPACE. IX1164.2 +029900 02 FILLER PIC X(58) VALUE IX1164.2 +030000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1164.2 +030100 02 FILLER PIC X(13) VALUE SPACE. IX1164.2 +030200 02 FILLER PIC X(15) VALUE IX1164.2 +030300 " COPYRIGHT 1985". IX1164.2 +030400 01 CCVS-E-4. IX1164.2 +030500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1164.2 +030600 02 FILLER PIC X(4) VALUE " OF ". IX1164.2 +030700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1164.2 +030800 02 FILLER PIC X(40) VALUE IX1164.2 +030900 " TESTS WERE EXECUTED SUCCESSFULLY". IX1164.2 +031000 01 XXINFO. IX1164.2 +031100 02 FILLER PIC X(19) VALUE IX1164.2 +031200 "*** INFORMATION ***". IX1164.2 +031300 02 INFO-TEXT. IX1164.2 +031400 04 FILLER PIC X(8) VALUE SPACE. IX1164.2 +031500 04 XXCOMPUTED PIC X(20). IX1164.2 +031600 04 FILLER PIC X(5) VALUE SPACE. IX1164.2 +031700 04 XXCORRECT PIC X(20). IX1164.2 +031800 02 INF-ANSI-REFERENCE PIC X(48). IX1164.2 +031900 01 HYPHEN-LINE. IX1164.2 +032000 02 FILLER PIC IS X VALUE IS SPACE. IX1164.2 +032100 02 FILLER PIC IS X(65) VALUE IS "************************IX1164.2 +032200- "*****************************************". IX1164.2 +032300 02 FILLER PIC IS X(54) VALUE IS "************************IX1164.2 +032400- "******************************". IX1164.2 +032500 01 TEST-NO PIC 99. IX1164.2 +032600 01 CCVS-PGM-ID PIC X(9) VALUE IX1164.2 +032700 "IX116A". IX1164.2 +032800 PROCEDURE DIVISION. IX1164.2 +032900 DECLARATIVES. IX1164.2 +033000 IX1164.2 +033100 SECT-IX105-0002 SECTION. IX1164.2 +033200 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1164.2 +033300 INPUT-PROCESS. IX1164.2 +033400 IF TEST-NO = 5 IX1164.2 +033500 GO TO D-C-TEST-GF-01-1. IX1164.2 +033600 IF STATUS-TEST-10 EQUAL TO 1 IX1164.2 +033700 IF IX-FS3-STAT1 EQUAL TO "1" IX1164.2 +033800 MOVE 1 TO EOF-FLAG IX1164.2 +033900 ELSE IX1164.2 +034000 IF IX-FS3-STAT1 GREATER THAN "1" IX1164.2 +034100 MOVE 1 TO PERM-ERRORS. IX1164.2 +034200 GO TO DECL-EXIT. IX1164.2 +034300 D-C-TEST-GF-01-1. IX1164.2 +034400 IF IX-FS3-STATUS EQUAL TO "49" IX1164.2 +034500 GO TO D-C-PASS-GF-01-0. IX1164.2 +034600 D-C-FAIL-GF-01-0. IX1164.2 +034700 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1164.2 +034800 MOVE "49" TO CORRECT-X. IX1164.2 +034900 MOVE "IX-5, 1.3.4, (5) H" TO RE-MARK. IX1164.2 +035000 PERFORM D-FAIL. IX1164.2 +035100 GO TO D-C-WRITE-GF-01-0. IX1164.2 +035200 D-C-PASS-GF-01-0. IX1164.2 +035300 PERFORM D-PASS. IX1164.2 +035400 D-C-WRITE-GF-01-0. IX1164.2 +035500 PERFORM D-PRINT-DETAIL. IX1164.2 +035600 D-CLOSE-FILES. IX1164.2 +035700*P OPEN I-O RAW-DATA. IX1164.2 +035800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1164.2 +035900*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1164.2 +036000*P MOVE "OK. " TO C-ABORT. IX1164.2 +036100*P MOVE PASS-COUNTER TO C-OK. IX1164.2 +036200*P MOVE ERROR-HOLD TO C-ALL. IX1164.2 +036300*P MOVE ERROR-COUNTER TO C-FAIL. IX1164.2 +036400*P MOVE DELETE-COUNTER TO C-DELETED. IX1164.2 +036500*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1164.2 +036600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1164.2 +036700*P-END-E-2. IX1164.2 +036800*P CLOSE RAW-DATA. IX1164.2 +036900 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1164.2 +037000 CLOSE PRINT-FILE. IX1164.2 +037100 D-TERMINATE-CCVS. IX1164.2 +037200*S EXIT PROGRAM. IX1164.2 +037300*S-TERMINATE-CALL. IX1164.2 +037400 STOP RUN. IX1164.2 +037500 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1164.2 +037600 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1164.2 +037700 D-PRINT-DETAIL. IX1164.2 +037800 IF REC-CT NOT EQUAL TO ZERO IX1164.2 +037900 MOVE "." TO PARDOT-X IX1164.2 +038000 MOVE REC-CT TO DOTVALUE. IX1164.2 +038100 MOVE TEST-RESULTS TO PRINT-REC. IX1164.2 +038200 PERFORM D-WRITE-LINE. IX1164.2 +038300 IF P-OR-F EQUAL TO "FAIL*" IX1164.2 +038400 PERFORM D-WRITE-LINE IX1164.2 +038500 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1164.2 +038600 ELSE IX1164.2 +038700 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1164.2 +038800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1164.2 +038900 MOVE SPACE TO CORRECT-X. IX1164.2 +039000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1164.2 +039100 MOVE SPACE TO RE-MARK. IX1164.2 +039200 D-END-ROUTINE. IX1164.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1164.2 +039400 PERFORM D-WRITE-LINE 5 TIMES. IX1164.2 +039500 D-END-RTN-EXIT. IX1164.2 +039600 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1164.2 +039700 PERFORM D-WRITE-LINE 2 TIMES. IX1164.2 +039800 D-END-ROUTINE-1. IX1164.2 +039900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1164.2 +040000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1164.2 +040100 ADD PASS-COUNTER TO ERROR-HOLD. IX1164.2 +040200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1164.2 +040300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1164.2 +040400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1164.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1164.2 +040600 D-END-ROUTINE-12. IX1164.2 +040700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1164.2 +040800 IF ERROR-COUNTER IS EQUAL TO ZERO IX1164.2 +040900 MOVE "NO " TO ERROR-TOTAL IX1164.2 +041000 ELSE IX1164.2 +041100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1164.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1164.2 +041300 PERFORM D-WRITE-LINE. IX1164.2 +041400 D-END-ROUTINE-13. IX1164.2 +041500 IF DELETE-COUNTER IS EQUAL TO ZERO IX1164.2 +041600 MOVE "NO " TO ERROR-TOTAL ELSE IX1164.2 +041700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1164.2 +041800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1164.2 +041900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1164.2 +042000 PERFORM D-WRITE-LINE. IX1164.2 +042100 IF INSPECT-COUNTER EQUAL TO ZERO IX1164.2 +042200 MOVE "NO " TO ERROR-TOTAL IX1164.2 +042300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1164.2 +042400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1164.2 +042500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1164.2 +042600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1164.2 +042700 D-WRITE-LINE. IX1164.2 +042800 ADD 1 TO RECORD-COUNT. IX1164.2 +042900 IF RECORD-COUNT GREATER 42 IX1164.2 +043000 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1164.2 +043100 MOVE SPACE TO DUMMY-RECORD IX1164.2 +043200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1164.2 +043300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1164.2 +043400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1164.2 +043500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1164.2 +043600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1164.2 +043700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1164.2 +043800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1164.2 +043900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1164.2 +044000 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1164.2 +044100 MOVE ZERO TO RECORD-COUNT. IX1164.2 +044200 PERFORM D-WRT-LN. IX1164.2 +044300 D-WRT-LN. IX1164.2 +044400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1164.2 +044500 MOVE SPACE TO DUMMY-RECORD. IX1164.2 +044600 D-FAIL-ROUTINE. IX1164.2 +044700 IF COMPUTED-X NOT EQUAL TO SPACE IX1164.2 +044800 GO TO D-FAIL-ROUTINE-WRITE. IX1164.2 +044900 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1164.2 +045000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1164.2 +045100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1164.2 +045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1164.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1164.2 +045400 GO TO D-FAIL-ROUTINE-EX. IX1164.2 +045500 D-FAIL-ROUTINE-WRITE. IX1164.2 +045600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1164.2 +045700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1164.2 +045800 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1164.2 +045900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1164.2 +046000 D-FAIL-ROUTINE-EX. EXIT. IX1164.2 +046100 D-BAIL-OUT. IX1164.2 +046200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1164.2 +046300 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1164.2 +046400 D-BAIL-OUT-WRITE. IX1164.2 +046500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1164.2 +046600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1164.2 +046700 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1164.2 +046800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1164.2 +046900 D-BAIL-OUT-EX. EXIT. IX1164.2 +047000 DECL-EXIT. EXIT. IX1164.2 +047100 END DECLARATIVES. IX1164.2 +047200 IX1164.2 +047300 IX1164.2 +047400 CCVS1 SECTION. IX1164.2 +047500 OPEN-FILES. IX1164.2 +047600*P OPEN I-O RAW-DATA. IX1164.2 +047700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1164.2 +047800*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1164.2 +047900*P MOVE "ABORTED " TO C-ABORT. IX1164.2 +048000*P ADD 1 TO C-NO-OF-TESTS. IX1164.2 +048100*P ACCEPT C-DATE FROM DATE. IX1164.2 +048200*P ACCEPT C-TIME FROM TIME. IX1164.2 +048300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1164.2 +048400*PND-E-1. IX1164.2 +048500*P CLOSE RAW-DATA. IX1164.2 +048600 OPEN OUTPUT PRINT-FILE. IX1164.2 +048700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1164.2 +048800 MOVE SPACE TO TEST-RESULTS. IX1164.2 +048900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1164.2 +049000 MOVE ZERO TO REC-SKL-SUB. IX1164.2 +049100 PERFORM CCVS-INIT-FILE 9 TIMES. IX1164.2 +049200 CCVS-INIT-FILE. IX1164.2 +049300 ADD 1 TO REC-SKL-SUB. IX1164.2 +049400 MOVE FILE-RECORD-INFO-SKELETON IX1164.2 +049500 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1164.2 +049600 CCVS-INIT-EXIT. IX1164.2 +049700 GO TO CCVS1-EXIT. IX1164.2 +049800 CLOSE-FILES. IX1164.2 +049900*P OPEN I-O RAW-DATA. IX1164.2 +050000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1164.2 +050100*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1164.2 +050200*P MOVE "OK. " TO C-ABORT. IX1164.2 +050300*P MOVE PASS-COUNTER TO C-OK. IX1164.2 +050400*P MOVE ERROR-HOLD TO C-ALL. IX1164.2 +050500*P MOVE ERROR-COUNTER TO C-FAIL. IX1164.2 +050600*P MOVE DELETE-COUNTER TO C-DELETED. IX1164.2 +050700*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1164.2 +050800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1164.2 +050900*PND-E-2. IX1164.2 +051000*P CLOSE RAW-DATA. IX1164.2 +051100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1164.2 +051200 TERMINATE-CCVS. IX1164.2 +051300*S EXIT PROGRAM. IX1164.2 +051400*SERMINATE-CALL. IX1164.2 +051500 STOP RUN. IX1164.2 +051600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1164.2 +051700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1164.2 +051800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1164.2 +051900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1164.2 +052000 MOVE "****TEST DELETED****" TO RE-MARK. IX1164.2 +052100 PRINT-DETAIL. IX1164.2 +052200 IF REC-CT NOT EQUAL TO ZERO IX1164.2 +052300 MOVE "." TO PARDOT-X IX1164.2 +052400 MOVE REC-CT TO DOTVALUE. IX1164.2 +052500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1164.2 +052600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1164.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1164.2 +052800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1164.2 +052900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1164.2 +053000 MOVE SPACE TO CORRECT-X. IX1164.2 +053100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1164.2 +053200 MOVE SPACE TO RE-MARK. IX1164.2 +053300 HEAD-ROUTINE. IX1164.2 +053400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +053500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +053600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1164.2 +053700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1164.2 +053800 COLUMN-NAMES-ROUTINE. IX1164.2 +053900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +054000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +054200 END-ROUTINE. IX1164.2 +054300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1164.2 +054400 END-RTN-EXIT. IX1164.2 +054500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +054600 END-ROUTINE-1. IX1164.2 +054700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1164.2 +054800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1164.2 +054900 ADD PASS-COUNTER TO ERROR-HOLD. IX1164.2 +055000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1164.2 +055100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1164.2 +055200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1164.2 +055300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1164.2 +055400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1164.2 +055500 END-ROUTINE-12. IX1164.2 +055600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1164.2 +055700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1164.2 +055800 MOVE "NO " TO ERROR-TOTAL IX1164.2 +055900 ELSE IX1164.2 +056000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1164.2 +056100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1164.2 +056200 PERFORM WRITE-LINE. IX1164.2 +056300 END-ROUTINE-13. IX1164.2 +056400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1164.2 +056500 MOVE "NO " TO ERROR-TOTAL ELSE IX1164.2 +056600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1164.2 +056700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1164.2 +056800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +056900 IF INSPECT-COUNTER EQUAL TO ZERO IX1164.2 +057000 MOVE "NO " TO ERROR-TOTAL IX1164.2 +057100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1164.2 +057200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1164.2 +057300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +057400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1164.2 +057500 WRITE-LINE. IX1164.2 +057600 ADD 1 TO RECORD-COUNT. IX1164.2 +057700 IF RECORD-COUNT GREATER 42 IX1164.2 +057800 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1164.2 +057900 MOVE SPACE TO DUMMY-RECORD IX1164.2 +058000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1164.2 +058100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1164.2 +058200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1164.2 +058300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1164.2 +058400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1164.2 +058500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1164.2 +058600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1164.2 +058700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1164.2 +058800 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1164.2 +058900 MOVE ZERO TO RECORD-COUNT. IX1164.2 +059000 PERFORM WRT-LN. IX1164.2 +059100 WRT-LN. IX1164.2 +059200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1164.2 +059300 MOVE SPACE TO DUMMY-RECORD. IX1164.2 +059400 BLANK-LINE-PRINT. IX1164.2 +059500 PERFORM WRT-LN. IX1164.2 +059600 FAIL-ROUTINE. IX1164.2 +059700 IF COMPUTED-X NOT EQUAL TO SPACE IX1164.2 +059800 GO TO FAIL-ROUTINE-WRITE. IX1164.2 +059900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1164.2 +060000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1164.2 +060100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1164.2 +060200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +060300 MOVE SPACES TO INF-ANSI-REFERENCE. IX1164.2 +060400 GO TO FAIL-ROUTINE-EX. IX1164.2 +060500 FAIL-ROUTINE-WRITE. IX1164.2 +060600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1164.2 +060700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1164.2 +060800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1164.2 +060900 MOVE SPACES TO COR-ANSI-REFERENCE. IX1164.2 +061000 FAIL-ROUTINE-EX. EXIT. IX1164.2 +061100 BAIL-OUT. IX1164.2 +061200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1164.2 +061300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1164.2 +061400 BAIL-OUT-WRITE. IX1164.2 +061500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1164.2 +061600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1164.2 +061700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1164.2 +061800 MOVE SPACES TO INF-ANSI-REFERENCE. IX1164.2 +061900 BAIL-OUT-EX. EXIT. IX1164.2 +062000 CCVS1-EXIT. IX1164.2 +062100 EXIT. IX1164.2 +062200 IX1164.2 +062300 SECT-IX116A-0003 SECTION. IX1164.2 +062400 SEQ-INIT-010. IX1164.2 +062500 MOVE ZERO TO TEST-NO. IX1164.2 +062600 MOVE "IX-FS3" TO XFILE-NAME (1). IX1164.2 +062700 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1164.2 +062800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1164.2 +062900 MOVE 000240 TO XRECORD-LENGTH (1). IX1164.2 +063000 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1164.2 +063100 MOVE 0002 TO XBLOCK-SIZE (1). IX1164.2 +063200 MOVE 000050 TO RECORDS-IN-FILE (1). IX1164.2 +063300 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1164.2 +063400 MOVE "S" TO XLABEL-TYPE (1). IX1164.2 +063500 MOVE 000001 TO XRECORD-NUMBER (1). IX1164.2 +063600 MOVE 0 TO COUNT-OF-RECS. IX1164.2 +063700 IX1164.2 +063800******************************************************************IX1164.2 +063900* TEST 1 *IX1164.2 +064000* OPEN OUTPUT ... 00 EXPECTED *IX1164.2 +064100* IX-3, 1.3.4 (1) A *IX1164.2 +064200* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1164.2 +064300* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1164.2 +064400******************************************************************IX1164.2 +064500 OPN-INIT-GF-01-0. IX1164.2 +064600 MOVE 1 TO STATUS-TEST-00. IX1164.2 +064700 MOVE SPACES TO IX-FS3-STATUS. IX1164.2 +064800 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1164.2 +064900 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1164.2 +065000 OPEN IX1164.2 +065100 I-O IX-FS3. IX1164.2 +065200 IF IX-FS3-STATUS EQUAL TO "00" IX1164.2 +065300 GO TO OPN-PASS-GF-01-0. IX1164.2 +065400 OPN-FAIL-GF-01-0. IX1164.2 +065500 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1164.2 +065600 PERFORM FAIL. IX1164.2 +065700 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1164.2 +065800 MOVE "00" TO CORRECT-X. IX1164.2 +065900 GO TO OPN-WRITE-GF-01-0. IX1164.2 +066000 OPN-PASS-GF-01-0. IX1164.2 +066100 PERFORM PASS. IX1164.2 +066200 OPN-WRITE-GF-01-0. IX1164.2 +066300 PERFORM PRINT-DETAIL. IX1164.2 +066400******************************************************************IX1164.2 +066500* TEST 4 *IX1164.2 +066600* CLOSE I-O 00 EXPECTED *IX1164.2 +066700* IX-3, 1.3.4 (1) A *IX1164.2 +066800******************************************************************IX1164.2 +066900 CLO-INIT-GF-01-0. IX1164.2 +067000 MOVE SPACES TO IX-FS3-STATUS. IX1164.2 +067100 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1164.2 +067200 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1164.2 +067300 CLO-TEST-GF-01-0. IX1164.2 +067400 CLOSE IX-FS3. IX1164.2 +067500 IF IX-FS3-STATUS = "00" IX1164.2 +067600 GO TO CLO-PASS-GF-01-0. IX1164.2 +067700 CLO-FAIL-GF-01-0. IX1164.2 +067800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1164.2 +067900 PERFORM FAIL. IX1164.2 +068000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1164.2 +068100 MOVE "00" TO CORRECT-X. IX1164.2 +068200 GO TO CLO-WRITE-GF-01-0. IX1164.2 +068300 CLO-PASS-GF-01-0. IX1164.2 +068400 PERFORM PASS. IX1164.2 +068500 CLO-WRITE-GF-01-0. IX1164.2 +068600 PERFORM PRINT-DETAIL. IX1164.2 +068700 IX1164.2 +068800******************************************************************IX1164.2 +068900* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1164.2 +069000******************************************************************IX1164.2 +069100 IX1164.2 +069200******************************************************************IX1164.2 +069300* TEST 5 *IX1164.2 +069400* DELETE.... FILE NOT IN THE OPEN MODE *IX1164.2 +069500* FILE STATUS 49 EXPECTED IX-5, 1.3.4 (5) H *IX1164.2 +069600******************************************************************IX1164.2 +069700 DEL-TEST-GF-01-0. IX1164.2 +069800 MOVE 5 TO TEST-NO. IX1164.2 +069900 MOVE SPACES TO IX-FS3-STATUS. IX1164.2 +070000 MOVE "DELETE 49 EXP." TO FEATURE IX1164.2 +070100 MOVE "DEL-TEST-GF-01-0" TO PAR-NAME. IX1164.2 +070200 DELETE IX-FS3 RECORD. IX1164.2 +070300 DEL-TEST-GF-01-1. IX1164.2 +070400 IF IX-FS3-STATUS EQUAL TO "49" IX1164.2 +070500 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1164.2 +070600 TO RE-MARK IX1164.2 +070700 GO TO DEL-WRITE-GF-01-0. IX1164.2 +070800 DEL-FAIL-GF-01-0. IX1164.2 +070900 MOVE "IX-5, 1.3.4, (5) H" TO RE-MARK. IX1164.2 +071000 DEL-WRITE-GF-01-0. IX1164.2 +071100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1164.2 +071200 MOVE "49" TO CORRECT-X. IX1164.2 +071300 PERFORM FAIL. IX1164.2 +071400 PERFORM PRINT-DETAIL. IX1164.2 +071500 IX1164.2 +071600 TERMINATE-ROUTINE. IX1164.2 +071700 EXIT. IX1164.2 +071800 IX1164.2 +071900 CCVS-EXIT SECTION. IX1164.2 +072000 CCVS-999999. IX1164.2 +072100 GO TO CLOSE-FILES. IX1164.2 diff --git a/tests/cobol85/IX/IX117A.SUB b/tests/cobol85/IX/IX117A.SUB new file mode 100755 index 00000000..d931d626 --- /dev/null +++ b/tests/cobol85/IX/IX117A.SUB @@ -0,0 +1,720 @@ +000100 IDENTIFICATION DIVISION. IX1174.2 +000200 PROGRAM-ID. IX1174.2 +000300 IX117A. IX1174.2 +000400**************************************************************** IX1174.2 +000500* * IX1174.2 +000600* VALIDATION FOR:- * IX1174.2 +000700* * IX1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1174.2 +000900* * IX1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1174.2 +001100* * IX1174.2 +001200**************************************************************** IX1174.2 +001300* IX1174.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1174.2 +001500* IX113A. IX1174.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1174.2 +001700* CLOSED AND THE STATUS CHECKED (00 EXPECTED) THEN AN ATTEMPT IX1174.2 +001800* IS MADE TO REWRITE A RECORD, AT WHICH POINT THE DECLARATIVES IX1174.2 +001900* SECTION SHOULD BE ACTIONED AND THE FILE STATUES SHOULD BE 49 IX1174.2 +002000* IX1174.2 +002100* IX1174.2 +002200* 4. X-CARDS USED IN THIS PROGRAM: IX1174.2 +002300* IX1174.2 +002400* XXXXX024 IX1174.2 +002500* XXXXX055. IX1174.2 +002600* P XXXXX062. IX1174.2 +002700* XXXXX082. IX1174.2 +002800* XXXXX083. IX1174.2 +002900* C XXXXX084 IX1174.2 +003000* IX1174.2 +003100* IX1174.2 +003200 ENVIRONMENT DIVISION. IX1174.2 +003300 CONFIGURATION SECTION. IX1174.2 +003400 SOURCE-COMPUTER. IX1174.2 +003500 Linux. IX1174.2 +003600 OBJECT-COMPUTER. IX1174.2 +003700 Linux. IX1174.2 +003800 INPUT-OUTPUT SECTION. IX1174.2 +003900 FILE-CONTROL. IX1174.2 +004000*P SELECT RAW-DATA ASSIGN TO IX1174.2 +004100*P "XXXXX062" IX1174.2 +004200*P ORGANIZATION IS INDEXED IX1174.2 +004300*P ACCESS MODE IS RANDOM IX1174.2 +004400*P RECORD KEY IS RAW-DATA-KEY. IX1174.2 +004500* IX1174.2 +004600 SELECT PRINT-FILE ASSIGN TO IX1174.2 +004700 "report.log". IX1174.2 +004800* IX1174.2 +004900 SELECT IX-FS3 ASSIGN IX1174.2 +005000 "XXXXX024" IX1174.2 +005100 ORGANIZATION IS INDEXED IX1174.2 +005200 ACCESS MODE IS SEQUENTIAL IX1174.2 +005300 RECORD KEY IS IX-FS3-KEY IX1174.2 +005400 FILE STATUS IS IX-FS3-STATUS. IX1174.2 +005500 IX1174.2 +005600 DATA DIVISION. IX1174.2 +005700 IX1174.2 +005800 FILE SECTION. IX1174.2 +005900*P IX1174.2 +006000*PD RAW-DATA. IX1174.2 +006100*P IX1174.2 +006200*P1 RAW-DATA-SATZ. IX1174.2 +006300*P 05 RAW-DATA-KEY PIC X(6). IX1174.2 +006400*P 05 C-DATE PIC 9(6). IX1174.2 +006500*P 05 C-TIME PIC 9(8). IX1174.2 +006600*P 05 C-NO-OF-TESTS PIC 99. IX1174.2 +006700*P 05 C-OK PIC 999. IX1174.2 +006800*P 05 C-ALL PIC 999. IX1174.2 +006900*P 05 C-FAIL PIC 999. IX1174.2 +007000*P 05 C-DELETED PIC 999. IX1174.2 +007100*P 05 C-INSPECT PIC 999. IX1174.2 +007200*P 05 C-NOTE PIC X(13). IX1174.2 +007300*P 05 C-INDENT PIC X. IX1174.2 +007400*P 05 C-ABORT PIC X(8). IX1174.2 +007500 IX1174.2 +007600 FD PRINT-FILE. IX1174.2 +007700 IX1174.2 +007800 01 PRINT-REC PIC X(120). IX1174.2 +007900 IX1174.2 +008000 01 DUMMY-RECORD PIC X(120). IX1174.2 +008100 IX1174.2 +008200 FD IX-FS3 IX1174.2 +008300*C DATA RECORDS IX-FS3R1-F-G-240 IX1174.2 +008400*C LABEL RECORD STANDARD IX1174.2 +008500 RECORD 240 IX1174.2 +008600 BLOCK CONTAINS 2 RECORDS. IX1174.2 +008700 IX1174.2 +008800 01 IX-FS3R1-F-G-240. IX1174.2 +008900 05 IX-FS3-REC-120 PIC X(120). IX1174.2 +009000 05 IX-FS3-REC-120-240. IX1174.2 +009100 10 FILLER PIC X(8). IX1174.2 +009200 10 IX-FS3-KEY PIC X(29). IX1174.2 +009300 10 FILLER PIC X(9). IX1174.2 +009400 10 IX-FS3-ALTER-KEY PIC X(29). IX1174.2 +009500 10 FILLER PIC X(45). IX1174.2 +009600 IX1174.2 +009700 IX1174.2 +009800 WORKING-STORAGE SECTION. IX1174.2 +009900 IX1174.2 +010000 01 GRP-0101. IX1174.2 +010100 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1174.2 +010200 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1174.2 +010300 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1174.2 +010400 IX1174.2 +010500 01 GRP-0102. IX1174.2 +010600 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1174.2 +010700 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1174.2 +010800 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1174.2 +010900 IX1174.2 +011000 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1174.2 +011100 IX1174.2 +011200 01 EOF-FLAG PIC 9 VALUE ZERO. IX1174.2 +011300 IX1174.2 +011400 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1174.2 +011500 IX1174.2 +011600 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1174.2 +011700 IX1174.2 +011800 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1174.2 +011900 IX1174.2 +012000 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1174.2 +012100 IX1174.2 +012200 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1174.2 +012300 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1174.2 +012400 IX1174.2 +012500 01 IX-FS3-STATUS. IX1174.2 +012600 05 IX-FS3-STAT1 PIC X. IX1174.2 +012700 05 IX-FS3-STAT2 PIC X. IX1174.2 +012800 IX1174.2 +012900 01 COUNT-OF-RECS PIC 9(5). IX1174.2 +013000 IX1174.2 +013100 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1174.2 +013200 IX1174.2 +013300 01 FILE-RECORD-INFORMATION-REC. IX1174.2 +013400 05 FILE-RECORD-INFO-SKELETON. IX1174.2 +013500 10 FILLER PIC X(48) VALUE IX1174.2 +013600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1174.2 +013700 10 FILLER PIC X(46) VALUE IX1174.2 +013800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1174.2 +013900 10 FILLER PIC X(26) VALUE IX1174.2 +014000 ",LFIL=000000,ORG= ,LBLR= ". IX1174.2 +014100 10 FILLER PIC X(37) VALUE IX1174.2 +014200 ",RECKEY= ". IX1174.2 +014300 10 FILLER PIC X(38) VALUE IX1174.2 +014400 ",ALTKEY1= ". IX1174.2 +014500 10 FILLER PIC X(38) VALUE IX1174.2 +014600 ",ALTKEY2= ". IX1174.2 +014700 10 FILLER PIC X(7) VALUE SPACE. IX1174.2 +014800 05 FILE-RECORD-INFO OCCURS 10. IX1174.2 +014900 10 FILE-RECORD-INFO-P1-120. IX1174.2 +015000 15 FILLER PIC X(5). IX1174.2 +015100 15 XFILE-NAME PIC X(6). IX1174.2 +015200 15 FILLER PIC X(8). IX1174.2 +015300 15 XRECORD-NAME PIC X(6). IX1174.2 +015400 15 FILLER PIC X(1). IX1174.2 +015500 15 REELUNIT-NUMBER PIC 9(1). IX1174.2 +015600 15 FILLER PIC X(7). IX1174.2 +015700 15 XRECORD-NUMBER PIC 9(6). IX1174.2 +015800 15 FILLER PIC X(6). IX1174.2 +015900 15 UPDATE-NUMBER PIC 9(2). IX1174.2 +016000 15 FILLER PIC X(5). IX1174.2 +016100 15 ODO-NUMBER PIC 9(4). IX1174.2 +016200 15 FILLER PIC X(5). IX1174.2 +016300 15 XPROGRAM-NAME PIC X(5). IX1174.2 +016400 15 FILLER PIC X(7). IX1174.2 +016500 15 XRECORD-LENGTH PIC 9(6). IX1174.2 +016600 15 FILLER PIC X(7). IX1174.2 +016700 15 CHARS-OR-RECORDS PIC X(2). IX1174.2 +016800 15 FILLER PIC X(1). IX1174.2 +016900 15 XBLOCK-SIZE PIC 9(4). IX1174.2 +017000 15 FILLER PIC X(6). IX1174.2 +017100 15 RECORDS-IN-FILE PIC 9(6). IX1174.2 +017200 15 FILLER PIC X(5). IX1174.2 +017300 15 XFILE-ORGANIZATION PIC X(2). IX1174.2 +017400 15 FILLER PIC X(6). IX1174.2 +017500 15 XLABEL-TYPE PIC X(1). IX1174.2 +017600 10 FILE-RECORD-INFO-P121-240. IX1174.2 +017700 15 FILLER PIC X(8). IX1174.2 +017800 15 XRECORD-KEY PIC X(29). IX1174.2 +017900 15 FILLER PIC X(9). IX1174.2 +018000 15 ALTERNATE-KEY1 PIC X(29). IX1174.2 +018100 15 FILLER PIC X(9). IX1174.2 +018200 15 ALTERNATE-KEY2 PIC X(29). IX1174.2 +018300 15 FILLER PIC X(7). IX1174.2 +018400 IX1174.2 +018500 01 TEST-RESULTS. IX1174.2 +018600 02 FILLER PIC X VALUE SPACE. IX1174.2 +018700 02 FEATURE PIC X(20) VALUE SPACE. IX1174.2 +018800 02 FILLER PIC X VALUE SPACE. IX1174.2 +018900 02 P-OR-F PIC X(5) VALUE SPACE. IX1174.2 +019000 02 FILLER PIC X VALUE SPACE. IX1174.2 +019100 02 PAR-NAME. IX1174.2 +019200 03 FILLER PIC X(19) VALUE SPACE. IX1174.2 +019300 03 PARDOT-X PIC X VALUE SPACE. IX1174.2 +019400 03 DOTVALUE PIC 99 VALUE ZERO. IX1174.2 +019500 02 FILLER PIC X(8) VALUE SPACE. IX1174.2 +019600 02 RE-MARK PIC X(61). IX1174.2 +019700 01 TEST-COMPUTED. IX1174.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX1174.2 +019900 02 FILLER PIC X(17) VALUE IX1174.2 +020000 " COMPUTED=". IX1174.2 +020100 02 COMPUTED-X. IX1174.2 +020200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1174.2 +020300 03 COMPUTED-N REDEFINES COMPUTED-A IX1174.2 +020400 PIC -9(9).9(9). IX1174.2 +020500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1174.2 +020600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1174.2 +020700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1174.2 +020800 03 CM-18V0 REDEFINES COMPUTED-A. IX1174.2 +020900 04 COMPUTED-18V0 PIC -9(18). IX1174.2 +021000 04 FILLER PIC X. IX1174.2 +021100 03 FILLER PIC X(50) VALUE SPACE. IX1174.2 +021200 01 TEST-CORRECT. IX1174.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX1174.2 +021400 02 FILLER PIC X(17) VALUE " CORRECT =". IX1174.2 +021500 02 CORRECT-X. IX1174.2 +021600 03 CORRECT-A PIC X(20) VALUE SPACE. IX1174.2 +021700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1174.2 +021800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1174.2 +021900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1174.2 +022000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1174.2 +022100 03 CR-18V0 REDEFINES CORRECT-A. IX1174.2 +022200 04 CORRECT-18V0 PIC -9(18). IX1174.2 +022300 04 FILLER PIC X. IX1174.2 +022400 03 FILLER PIC X(2) VALUE SPACE. IX1174.2 +022500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1174.2 +022600 01 CCVS-C-1. IX1174.2 +022700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1174.2 +022800- "SS PARAGRAPH-NAME IX1174.2 +022900- " REMARKS". IX1174.2 +023000 02 FILLER PIC X(20) VALUE SPACE. IX1174.2 +023100 01 CCVS-C-2. IX1174.2 +023200 02 FILLER PIC X VALUE SPACE. IX1174.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". IX1174.2 +023400 02 FILLER PIC X(15) VALUE SPACE. IX1174.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". IX1174.2 +023600 02 FILLER PIC X(94) VALUE SPACE. IX1174.2 +023700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1174.2 +023800 01 REC-CT PIC 99 VALUE ZERO. IX1174.2 +023900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1174.2 +024000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1174.2 +024100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1174.2 +024200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1174.2 +024300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1174.2 +024400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1174.2 +024500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1174.2 +024600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1174.2 +024700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1174.2 +024800 01 CCVS-H-1. IX1174.2 +024900 02 FILLER PIC X(39) VALUE SPACES. IX1174.2 +025000 02 FILLER PIC X(42) VALUE IX1174.2 +025100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1174.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX1174.2 +025300 01 CCVS-H-2A. IX1174.2 +025400 02 FILLER PIC X(40) VALUE SPACE. IX1174.2 +025500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1174.2 +025600 02 FILLER PIC XXXX VALUE IX1174.2 +025700 "4.2 ". IX1174.2 +025800 02 FILLER PIC X(28) VALUE IX1174.2 +025900 " COPY - NOT FOR DISTRIBUTION". IX1174.2 +026000 02 FILLER PIC X(41) VALUE SPACE. IX1174.2 +026100 IX1174.2 +026200 01 CCVS-H-2B. IX1174.2 +026300 02 FILLER PIC X(15) VALUE IX1174.2 +026400 "TEST RESULT OF ". IX1174.2 +026500 02 TEST-ID PIC X(9). IX1174.2 +026600 02 FILLER PIC X(4) VALUE IX1174.2 +026700 " IN ". IX1174.2 +026800 02 FILLER PIC X(12) VALUE IX1174.2 +026900 " HIGH ". IX1174.2 +027000 02 FILLER PIC X(22) VALUE IX1174.2 +027100 " LEVEL VALIDATION FOR ". IX1174.2 +027200 02 FILLER PIC X(58) VALUE IX1174.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1174.2 +027400 01 CCVS-H-3. IX1174.2 +027500 02 FILLER PIC X(34) VALUE IX1174.2 +027600 " FOR OFFICIAL USE ONLY ". IX1174.2 +027700 02 FILLER PIC X(58) VALUE IX1174.2 +027800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1174.2 +027900 02 FILLER PIC X(28) VALUE IX1174.2 +028000 " COPYRIGHT 1985 ". IX1174.2 +028100 01 CCVS-E-1. IX1174.2 +028200 02 FILLER PIC X(52) VALUE SPACE. IX1174.2 +028300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1174.2 +028400 02 ID-AGAIN PIC X(9). IX1174.2 +028500 02 FILLER PIC X(45) VALUE SPACES. IX1174.2 +028600 01 CCVS-E-2. IX1174.2 +028700 02 FILLER PIC X(31) VALUE SPACE. IX1174.2 +028800 02 FILLER PIC X(21) VALUE SPACE. IX1174.2 +028900 02 CCVS-E-2-2. IX1174.2 +029000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1174.2 +029100 03 FILLER PIC X VALUE SPACE. IX1174.2 +029200 03 ENDER-DESC PIC X(44) VALUE IX1174.2 +029300 "ERRORS ENCOUNTERED". IX1174.2 +029400 01 CCVS-E-3. IX1174.2 +029500 02 FILLER PIC X(22) VALUE IX1174.2 +029600 " FOR OFFICIAL USE ONLY". IX1174.2 +029700 02 FILLER PIC X(12) VALUE SPACE. IX1174.2 +029800 02 FILLER PIC X(58) VALUE IX1174.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1174.2 +030000 02 FILLER PIC X(13) VALUE SPACE. IX1174.2 +030100 02 FILLER PIC X(15) VALUE IX1174.2 +030200 " COPYRIGHT 1985". IX1174.2 +030300 01 CCVS-E-4. IX1174.2 +030400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1174.2 +030500 02 FILLER PIC X(4) VALUE " OF ". IX1174.2 +030600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1174.2 +030700 02 FILLER PIC X(40) VALUE IX1174.2 +030800 " TESTS WERE EXECUTED SUCCESSFULLY". IX1174.2 +030900 01 XXINFO. IX1174.2 +031000 02 FILLER PIC X(19) VALUE IX1174.2 +031100 "*** INFORMATION ***". IX1174.2 +031200 02 INFO-TEXT. IX1174.2 +031300 04 FILLER PIC X(8) VALUE SPACE. IX1174.2 +031400 04 XXCOMPUTED PIC X(20). IX1174.2 +031500 04 FILLER PIC X(5) VALUE SPACE. IX1174.2 +031600 04 XXCORRECT PIC X(20). IX1174.2 +031700 02 INF-ANSI-REFERENCE PIC X(48). IX1174.2 +031800 01 HYPHEN-LINE. IX1174.2 +031900 02 FILLER PIC IS X VALUE IS SPACE. IX1174.2 +032000 02 FILLER PIC IS X(65) VALUE IS "************************IX1174.2 +032100- "*****************************************". IX1174.2 +032200 02 FILLER PIC IS X(54) VALUE IS "************************IX1174.2 +032300- "******************************". IX1174.2 +032400 01 TEST-NO PIC 99. IX1174.2 +032500 01 CCVS-PGM-ID PIC X(9) VALUE IX1174.2 +032600 "IX117A". IX1174.2 +032700 PROCEDURE DIVISION. IX1174.2 +032800 DECLARATIVES. IX1174.2 +032900 IX1174.2 +033000 SECT-IX105-0002 SECTION. IX1174.2 +033100 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1174.2 +033200 INPUT-PROCESS. IX1174.2 +033300 IF TEST-NO = 5 IX1174.2 +033400 GO TO D-C-TEST-GF-01-1. IX1174.2 +033500 IF STATUS-TEST-10 EQUAL TO 1 IX1174.2 +033600 IF IX-FS3-STAT1 EQUAL TO "1" IX1174.2 +033700 MOVE 1 TO EOF-FLAG IX1174.2 +033800 ELSE IX1174.2 +033900 IF IX-FS3-STAT1 GREATER THAN "1" IX1174.2 +034000 MOVE 1 TO PERM-ERRORS. IX1174.2 +034100 GO TO DECL-EXIT. IX1174.2 +034200 D-C-TEST-GF-01-1. IX1174.2 +034300 IF IX-FS3-STATUS EQUAL TO "49" IX1174.2 +034400 GO TO D-C-PASS-GF-01-0. IX1174.2 +034500 D-C-FAIL-GF-01-0. IX1174.2 +034600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1174.2 +034700 MOVE "49" TO CORRECT-X. IX1174.2 +034800 MOVE "IX-5, 1.3.4, (5) H" TO RE-MARK. IX1174.2 +034900 PERFORM D-FAIL. IX1174.2 +035000 GO TO D-C-WRITE-GF-01-0. IX1174.2 +035100 D-C-PASS-GF-01-0. IX1174.2 +035200 PERFORM D-PASS. IX1174.2 +035300 D-C-WRITE-GF-01-0. IX1174.2 +035400 PERFORM D-PRINT-DETAIL. IX1174.2 +035500 D-CLOSE-FILES. IX1174.2 +035600*P OPEN I-O RAW-DATA. IX1174.2 +035700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1174.2 +035800*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1174.2 +035900*P MOVE "OK. " TO C-ABORT. IX1174.2 +036000*P MOVE PASS-COUNTER TO C-OK. IX1174.2 +036100*P MOVE ERROR-HOLD TO C-ALL. IX1174.2 +036200*P MOVE ERROR-COUNTER TO C-FAIL. IX1174.2 +036300*P MOVE DELETE-COUNTER TO C-DELETED. IX1174.2 +036400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1174.2 +036500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1174.2 +036600*P-END-E-2. IX1174.2 +036700*P CLOSE RAW-DATA. IX1174.2 +036800 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1174.2 +036900 CLOSE PRINT-FILE. IX1174.2 +037000 D-TERMINATE-CCVS. IX1174.2 +037100*S EXIT PROGRAM. IX1174.2 +037200*S-TERMINATE-CALL. IX1174.2 +037300 STOP RUN. IX1174.2 +037400 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1174.2 +037500 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1174.2 +037600 D-PRINT-DETAIL. IX1174.2 +037700 IF REC-CT NOT EQUAL TO ZERO IX1174.2 +037800 MOVE "." TO PARDOT-X IX1174.2 +037900 MOVE REC-CT TO DOTVALUE. IX1174.2 +038000 MOVE TEST-RESULTS TO PRINT-REC. IX1174.2 +038100 PERFORM D-WRITE-LINE. IX1174.2 +038200 IF P-OR-F EQUAL TO "FAIL*" IX1174.2 +038300 PERFORM D-WRITE-LINE IX1174.2 +038400 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1174.2 +038500 ELSE IX1174.2 +038600 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1174.2 +038700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1174.2 +038800 MOVE SPACE TO CORRECT-X. IX1174.2 +038900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1174.2 +039000 MOVE SPACE TO RE-MARK. IX1174.2 +039100 D-END-ROUTINE. IX1174.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1174.2 +039300 PERFORM D-WRITE-LINE 5 TIMES. IX1174.2 +039400 D-END-RTN-EXIT. IX1174.2 +039500 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1174.2 +039600 PERFORM D-WRITE-LINE 2 TIMES. IX1174.2 +039700 D-END-ROUTINE-1. IX1174.2 +039800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1174.2 +039900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1174.2 +040000 ADD PASS-COUNTER TO ERROR-HOLD. IX1174.2 +040100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1174.2 +040200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1174.2 +040300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1174.2 +040400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1174.2 +040500 D-END-ROUTINE-12. IX1174.2 +040600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1174.2 +040700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1174.2 +040800 MOVE "NO " TO ERROR-TOTAL IX1174.2 +040900 ELSE IX1174.2 +041000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1174.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1174.2 +041200 PERFORM D-WRITE-LINE. IX1174.2 +041300 D-END-ROUTINE-13. IX1174.2 +041400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1174.2 +041500 MOVE "NO " TO ERROR-TOTAL ELSE IX1174.2 +041600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1174.2 +041700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1174.2 +041800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1174.2 +041900 PERFORM D-WRITE-LINE. IX1174.2 +042000 IF INSPECT-COUNTER EQUAL TO ZERO IX1174.2 +042100 MOVE "NO " TO ERROR-TOTAL IX1174.2 +042200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1174.2 +042300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1174.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1174.2 +042500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1174.2 +042600 D-WRITE-LINE. IX1174.2 +042700 ADD 1 TO RECORD-COUNT. IX1174.2 +042800 IF RECORD-COUNT GREATER 42 IX1174.2 +042900 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1174.2 +043000 MOVE SPACE TO DUMMY-RECORD IX1174.2 +043100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1174.2 +043200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1174.2 +043300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1174.2 +043400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1174.2 +043500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1174.2 +043600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1174.2 +043700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1174.2 +043800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1174.2 +043900 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1174.2 +044000 MOVE ZERO TO RECORD-COUNT. IX1174.2 +044100 PERFORM D-WRT-LN. IX1174.2 +044200 D-WRT-LN. IX1174.2 +044300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1174.2 +044400 MOVE SPACE TO DUMMY-RECORD. IX1174.2 +044500 D-FAIL-ROUTINE. IX1174.2 +044600 IF COMPUTED-X NOT EQUAL TO SPACE IX1174.2 +044700 GO TO D-FAIL-ROUTINE-WRITE. IX1174.2 +044800 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1174.2 +044900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1174.2 +045000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1174.2 +045100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1174.2 +045200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1174.2 +045300 GO TO D-FAIL-ROUTINE-EX. IX1174.2 +045400 D-FAIL-ROUTINE-WRITE. IX1174.2 +045500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1174.2 +045600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1174.2 +045700 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1174.2 +045800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1174.2 +045900 D-FAIL-ROUTINE-EX. EXIT. IX1174.2 +046000 D-BAIL-OUT. IX1174.2 +046100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1174.2 +046200 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1174.2 +046300 D-BAIL-OUT-WRITE. IX1174.2 +046400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1174.2 +046500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1174.2 +046600 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1174.2 +046700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1174.2 +046800 D-BAIL-OUT-EX. EXIT. IX1174.2 +046900 DECL-EXIT. EXIT. IX1174.2 +047000 END DECLARATIVES. IX1174.2 +047100 IX1174.2 +047200 IX1174.2 +047300 CCVS1 SECTION. IX1174.2 +047400 OPEN-FILES. IX1174.2 +047500*P OPEN I-O RAW-DATA. IX1174.2 +047600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1174.2 +047700*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1174.2 +047800*P MOVE "ABORTED " TO C-ABORT. IX1174.2 +047900*P ADD 1 TO C-NO-OF-TESTS. IX1174.2 +048000*P ACCEPT C-DATE FROM DATE. IX1174.2 +048100*P ACCEPT C-TIME FROM TIME. IX1174.2 +048200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1174.2 +048300*PND-E-1. IX1174.2 +048400*P CLOSE RAW-DATA. IX1174.2 +048500 OPEN OUTPUT PRINT-FILE. IX1174.2 +048600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1174.2 +048700 MOVE SPACE TO TEST-RESULTS. IX1174.2 +048800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1174.2 +048900 MOVE ZERO TO REC-SKL-SUB. IX1174.2 +049000 PERFORM CCVS-INIT-FILE 9 TIMES. IX1174.2 +049100 CCVS-INIT-FILE. IX1174.2 +049200 ADD 1 TO REC-SKL-SUB. IX1174.2 +049300 MOVE FILE-RECORD-INFO-SKELETON IX1174.2 +049400 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1174.2 +049500 CCVS-INIT-EXIT. IX1174.2 +049600 GO TO CCVS1-EXIT. IX1174.2 +049700 CLOSE-FILES. IX1174.2 +049800*P OPEN I-O RAW-DATA. IX1174.2 +049900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1174.2 +050000*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1174.2 +050100*P MOVE "OK. " TO C-ABORT. IX1174.2 +050200*P MOVE PASS-COUNTER TO C-OK. IX1174.2 +050300*P MOVE ERROR-HOLD TO C-ALL. IX1174.2 +050400*P MOVE ERROR-COUNTER TO C-FAIL. IX1174.2 +050500*P MOVE DELETE-COUNTER TO C-DELETED. IX1174.2 +050600*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1174.2 +050700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1174.2 +050800*PND-E-2. IX1174.2 +050900*P CLOSE RAW-DATA. IX1174.2 +051000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1174.2 +051100 TERMINATE-CCVS. IX1174.2 +051200*S EXIT PROGRAM. IX1174.2 +051300*SERMINATE-CALL. IX1174.2 +051400 STOP RUN. IX1174.2 +051500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1174.2 +051600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1174.2 +051700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1174.2 +051800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1174.2 +051900 MOVE "****TEST DELETED****" TO RE-MARK. IX1174.2 +052000 PRINT-DETAIL. IX1174.2 +052100 IF REC-CT NOT EQUAL TO ZERO IX1174.2 +052200 MOVE "." TO PARDOT-X IX1174.2 +052300 MOVE REC-CT TO DOTVALUE. IX1174.2 +052400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1174.2 +052500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1174.2 +052600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1174.2 +052700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1174.2 +052800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1174.2 +052900 MOVE SPACE TO CORRECT-X. IX1174.2 +053000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1174.2 +053100 MOVE SPACE TO RE-MARK. IX1174.2 +053200 HEAD-ROUTINE. IX1174.2 +053300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +053400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +053500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1174.2 +053600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1174.2 +053700 COLUMN-NAMES-ROUTINE. IX1174.2 +053800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +053900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +054000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +054100 END-ROUTINE. IX1174.2 +054200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1174.2 +054300 END-RTN-EXIT. IX1174.2 +054400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +054500 END-ROUTINE-1. IX1174.2 +054600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1174.2 +054700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1174.2 +054800 ADD PASS-COUNTER TO ERROR-HOLD. IX1174.2 +054900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1174.2 +055000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1174.2 +055100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1174.2 +055200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1174.2 +055300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1174.2 +055400 END-ROUTINE-12. IX1174.2 +055500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1174.2 +055600 IF ERROR-COUNTER IS EQUAL TO ZERO IX1174.2 +055700 MOVE "NO " TO ERROR-TOTAL IX1174.2 +055800 ELSE IX1174.2 +055900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1174.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1174.2 +056100 PERFORM WRITE-LINE. IX1174.2 +056200 END-ROUTINE-13. IX1174.2 +056300 IF DELETE-COUNTER IS EQUAL TO ZERO IX1174.2 +056400 MOVE "NO " TO ERROR-TOTAL ELSE IX1174.2 +056500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1174.2 +056600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1174.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +056800 IF INSPECT-COUNTER EQUAL TO ZERO IX1174.2 +056900 MOVE "NO " TO ERROR-TOTAL IX1174.2 +057000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1174.2 +057100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1174.2 +057200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +057300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1174.2 +057400 WRITE-LINE. IX1174.2 +057500 ADD 1 TO RECORD-COUNT. IX1174.2 +057600 IF RECORD-COUNT GREATER 42 IX1174.2 +057700 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1174.2 +057800 MOVE SPACE TO DUMMY-RECORD IX1174.2 +057900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1174.2 +058000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1174.2 +058100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1174.2 +058200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1174.2 +058300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1174.2 +058400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1174.2 +058500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1174.2 +058600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1174.2 +058700 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1174.2 +058800 MOVE ZERO TO RECORD-COUNT. IX1174.2 +058900 PERFORM WRT-LN. IX1174.2 +059000 WRT-LN. IX1174.2 +059100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1174.2 +059200 MOVE SPACE TO DUMMY-RECORD. IX1174.2 +059300 BLANK-LINE-PRINT. IX1174.2 +059400 PERFORM WRT-LN. IX1174.2 +059500 FAIL-ROUTINE. IX1174.2 +059600 IF COMPUTED-X NOT EQUAL TO SPACE IX1174.2 +059700 GO TO FAIL-ROUTINE-WRITE. IX1174.2 +059800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1174.2 +059900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1174.2 +060000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1174.2 +060100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +060200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1174.2 +060300 GO TO FAIL-ROUTINE-EX. IX1174.2 +060400 FAIL-ROUTINE-WRITE. IX1174.2 +060500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1174.2 +060600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1174.2 +060700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1174.2 +060800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1174.2 +060900 FAIL-ROUTINE-EX. EXIT. IX1174.2 +061000 BAIL-OUT. IX1174.2 +061100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1174.2 +061200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1174.2 +061300 BAIL-OUT-WRITE. IX1174.2 +061400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1174.2 +061500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1174.2 +061600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1174.2 +061700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1174.2 +061800 BAIL-OUT-EX. EXIT. IX1174.2 +061900 CCVS1-EXIT. IX1174.2 +062000 EXIT. IX1174.2 +062100 IX1174.2 +062200 SECT-IX117A-0003 SECTION. IX1174.2 +062300 SEQ-INIT-010. IX1174.2 +062400 MOVE ZERO TO TEST-NO. IX1174.2 +062500 MOVE "IX-FS3" TO XFILE-NAME (1). IX1174.2 +062600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1174.2 +062700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1174.2 +062800 MOVE 000240 TO XRECORD-LENGTH (1). IX1174.2 +062900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1174.2 +063000 MOVE 0002 TO XBLOCK-SIZE (1). IX1174.2 +063100 MOVE 000050 TO RECORDS-IN-FILE (1). IX1174.2 +063200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1174.2 +063300 MOVE "S" TO XLABEL-TYPE (1). IX1174.2 +063400 MOVE 000001 TO XRECORD-NUMBER (1). IX1174.2 +063500 MOVE 0 TO COUNT-OF-RECS. IX1174.2 +063600 IX1174.2 +063700******************************************************************IX1174.2 +063800* TEST 1 *IX1174.2 +063900* OPEN OUTPUT ... 00 EXPECTED *IX1174.2 +064000* IX-3, 1.3.4 (1) A *IX1174.2 +064100* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1174.2 +064200* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1174.2 +064300******************************************************************IX1174.2 +064400 OPN-INIT-GF-01-0. IX1174.2 +064500 MOVE 1 TO STATUS-TEST-00. IX1174.2 +064600 MOVE SPACES TO IX-FS3-STATUS. IX1174.2 +064700 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1174.2 +064800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1174.2 +064900 OPEN IX1174.2 +065000 I-O IX-FS3. IX1174.2 +065100 IF IX-FS3-STATUS EQUAL TO "00" IX1174.2 +065200 GO TO OPN-PASS-GF-01-0. IX1174.2 +065300 OPN-FAIL-GF-01-0. IX1174.2 +065400 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1174.2 +065500 PERFORM FAIL. IX1174.2 +065600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1174.2 +065700 MOVE "00" TO CORRECT-X. IX1174.2 +065800 GO TO OPN-WRITE-GF-01-0. IX1174.2 +065900 OPN-PASS-GF-01-0. IX1174.2 +066000 PERFORM PASS. IX1174.2 +066100 OPN-WRITE-GF-01-0. IX1174.2 +066200 PERFORM PRINT-DETAIL. IX1174.2 +066300******************************************************************IX1174.2 +066400* TEST 4 *IX1174.2 +066500* CLOSE I-O 00 EXPECTED *IX1174.2 +066600* IX-3, 1.3.4 (1) A *IX1174.2 +066700******************************************************************IX1174.2 +066800 CLO-INIT-GF-01-0. IX1174.2 +066900 MOVE SPACES TO IX-FS3-STATUS. IX1174.2 +067000 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1174.2 +067100 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1174.2 +067200 CLO-TEST-GF-01-0. IX1174.2 +067300 CLOSE IX-FS3. IX1174.2 +067400 IF IX-FS3-STATUS = "00" IX1174.2 +067500 GO TO CLO-PASS-GF-01-0. IX1174.2 +067600 CLO-FAIL-GF-01-0. IX1174.2 +067700 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1174.2 +067800 PERFORM FAIL. IX1174.2 +067900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1174.2 +068000 MOVE "00" TO CORRECT-X. IX1174.2 +068100 GO TO CLO-WRITE-GF-01-0. IX1174.2 +068200 CLO-PASS-GF-01-0. IX1174.2 +068300 PERFORM PASS. IX1174.2 +068400 CLO-WRITE-GF-01-0. IX1174.2 +068500 PERFORM PRINT-DETAIL. IX1174.2 +068600 IX1174.2 +068700******************************************************************IX1174.2 +068800* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1174.2 +068900******************************************************************IX1174.2 +069000 IX1174.2 +069100******************************************************************IX1174.2 +069200* TEST 5 *IX1174.2 +069300* REWRITE... FILE NOT IN THE OPEN MODE *IX1174.2 +069400* FILE STATUS 49 EXPECTED IX-5, 1.3.4 (5) H *IX1174.2 +069500******************************************************************IX1174.2 +069600 RWR-TEST-GF-01-0. IX1174.2 +069700 MOVE 5 TO TEST-NO. IX1174.2 +069800 MOVE SPACES TO IX-FS3-STATUS. IX1174.2 +069900 MOVE "REWRITE 49 EXP." TO FEATURE IX1174.2 +070000 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1174.2 +070100 REWRITE IX-FS3R1-F-G-240. IX1174.2 +070200 RWR-TEST-GF-01-1. IX1174.2 +070300 IF IX-FS3-STATUS EQUAL TO "49" IX1174.2 +070400 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1174.2 +070500 TO RE-MARK IX1174.2 +070600 GO TO RWR-WRITE-GF-01-0. IX1174.2 +070700 RWR-FAIL-GF-01-0. IX1174.2 +070800 MOVE "IX-5, 1.3.4, (5) H" TO RE-MARK. IX1174.2 +070900 RWR-WRITE-GF-01-0. IX1174.2 +071000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1174.2 +071100 MOVE "49" TO CORRECT-X. IX1174.2 +071200 PERFORM FAIL. IX1174.2 +071300 PERFORM PRINT-DETAIL. IX1174.2 +071400 IX1174.2 +071500 TERMINATE-ROUTINE. IX1174.2 +071600 EXIT. IX1174.2 +071700 IX1174.2 +071800 CCVS-EXIT SECTION. IX1174.2 +071900 CCVS-999999. IX1174.2 +072000 GO TO CLOSE-FILES. IX1174.2 diff --git a/tests/cobol85/IX/IX118A.SUB b/tests/cobol85/IX/IX118A.SUB new file mode 100755 index 00000000..b5dab5ef --- /dev/null +++ b/tests/cobol85/IX/IX118A.SUB @@ -0,0 +1,722 @@ +000100 IDENTIFICATION DIVISION. IX1184.2 +000200 PROGRAM-ID. IX1184.2 +000300 IX118A. IX1184.2 +000400**************************************************************** IX1184.2 +000500* * IX1184.2 +000600* VALIDATION FOR:- * IX1184.2 +000700* * IX1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1184.2 +000900* * IX1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1184.2 +001100* * IX1184.2 +001200**************************************************************** IX1184.2 +001300* IX1184.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1184.2 +001500* IX113A. IX1184.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1184.2 +001700* CLOSED AND THE STATUS CHECKED (00 EXPECTED) THEN THE FILE IS IX1184.2 +001800* OPENED TWICE, AT WHICH POINT THE DECLARATIVES IX1184.2 +001900* SECTION SHOULD BE ACTIONED AND THE FILE STATUS SHOULD BE 41 IX1184.2 +002000* STANDARD REF. IX-5 1.3.4 (5) A IX1184.2 +002100* IX1184.2 +002200* X-CARDS USED IN THIS PROGRAM: IX1184.2 +002300* IX1184.2 +002400* XXXXX024 IX1184.2 +002500* XXXXX055. IX1184.2 +002600* P XXXXX062. IX1184.2 +002700* XXXXX082. IX1184.2 +002800* XXXXX083. IX1184.2 +002900* C XXXXX084 IX1184.2 +003000* IX1184.2 +003100* IX1184.2 +003200 ENVIRONMENT DIVISION. IX1184.2 +003300 CONFIGURATION SECTION. IX1184.2 +003400 SOURCE-COMPUTER. IX1184.2 +003500 Linux. IX1184.2 +003600 OBJECT-COMPUTER. IX1184.2 +003700 Linux. IX1184.2 +003800 INPUT-OUTPUT SECTION. IX1184.2 +003900 FILE-CONTROL. IX1184.2 +004000*P SELECT RAW-DATA ASSIGN TO IX1184.2 +004100*P "XXXXX062" IX1184.2 +004200*P ORGANIZATION IS INDEXED IX1184.2 +004300*P ACCESS MODE IS RANDOM IX1184.2 +004400*P RECORD KEY IS RAW-DATA-KEY. IX1184.2 +004500* IX1184.2 +004600 SELECT PRINT-FILE ASSIGN TO IX1184.2 +004700 "report.log". IX1184.2 +004800* IX1184.2 +004900 SELECT IX-FS3 ASSIGN IX1184.2 +005000 "XXXXX024" IX1184.2 +005100 ORGANIZATION IS INDEXED IX1184.2 +005200 ACCESS MODE IS SEQUENTIAL IX1184.2 +005300 RECORD KEY IS IX-FS3-KEY IX1184.2 +005400 FILE STATUS IS IX-FS3-STATUS. IX1184.2 +005500 IX1184.2 +005600 DATA DIVISION. IX1184.2 +005700 IX1184.2 +005800 FILE SECTION. IX1184.2 +005900*P IX1184.2 +006000*PD RAW-DATA. IX1184.2 +006100*P IX1184.2 +006200*P1 RAW-DATA-SATZ. IX1184.2 +006300*P 05 RAW-DATA-KEY PIC X(6). IX1184.2 +006400*P 05 C-DATE PIC 9(6). IX1184.2 +006500*P 05 C-TIME PIC 9(8). IX1184.2 +006600*P 05 C-NO-OF-TESTS PIC 99. IX1184.2 +006700*P 05 C-OK PIC 999. IX1184.2 +006800*P 05 C-ALL PIC 999. IX1184.2 +006900*P 05 C-FAIL PIC 999. IX1184.2 +007000*P 05 C-DELETED PIC 999. IX1184.2 +007100*P 05 C-INSPECT PIC 999. IX1184.2 +007200*P 05 C-NOTE PIC X(13). IX1184.2 +007300*P 05 C-INDENT PIC X. IX1184.2 +007400*P 05 C-ABORT PIC X(8). IX1184.2 +007500 IX1184.2 +007600 FD PRINT-FILE. IX1184.2 +007700 IX1184.2 +007800 01 PRINT-REC PIC X(120). IX1184.2 +007900 IX1184.2 +008000 01 DUMMY-RECORD PIC X(120). IX1184.2 +008100 IX1184.2 +008200 FD IX-FS3 IX1184.2 +008300*C DATA RECORDS IX-FS3R1-F-G-240 IX1184.2 +008400*C LABEL RECORD STANDARD IX1184.2 +008500 RECORD 240 IX1184.2 +008600 BLOCK CONTAINS 2 RECORDS. IX1184.2 +008700 IX1184.2 +008800 01 IX-FS3R1-F-G-240. IX1184.2 +008900 05 IX-FS3-REC-120 PIC X(120). IX1184.2 +009000 05 IX-FS3-REC-120-240. IX1184.2 +009100 10 FILLER PIC X(8). IX1184.2 +009200 10 IX-FS3-KEY PIC X(29). IX1184.2 +009300 10 FILLER PIC X(9). IX1184.2 +009400 10 IX-FS3-ALTER-KEY PIC X(29). IX1184.2 +009500 10 FILLER PIC X(45). IX1184.2 +009600 IX1184.2 +009700 IX1184.2 +009800 WORKING-STORAGE SECTION. IX1184.2 +009900 IX1184.2 +010000 01 GRP-0101. IX1184.2 +010100 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1184.2 +010200 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1184.2 +010300 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1184.2 +010400 IX1184.2 +010500 01 GRP-0102. IX1184.2 +010600 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1184.2 +010700 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1184.2 +010800 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1184.2 +010900 IX1184.2 +011000 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1184.2 +011100 IX1184.2 +011200 01 EOF-FLAG PIC 9 VALUE ZERO. IX1184.2 +011300 IX1184.2 +011400 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1184.2 +011500 IX1184.2 +011600 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1184.2 +011700 IX1184.2 +011800 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1184.2 +011900 IX1184.2 +012000 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1184.2 +012100 IX1184.2 +012200 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1184.2 +012300 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1184.2 +012400 IX1184.2 +012500 01 IX-FS3-STATUS. IX1184.2 +012600 05 IX-FS3-STAT1 PIC X. IX1184.2 +012700 05 IX-FS3-STAT2 PIC X. IX1184.2 +012800 IX1184.2 +012900 01 COUNT-OF-RECS PIC 9(5). IX1184.2 +013000 IX1184.2 +013100 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1184.2 +013200 IX1184.2 +013300 01 FILE-RECORD-INFORMATION-REC. IX1184.2 +013400 05 FILE-RECORD-INFO-SKELETON. IX1184.2 +013500 10 FILLER PIC X(48) VALUE IX1184.2 +013600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1184.2 +013700 10 FILLER PIC X(46) VALUE IX1184.2 +013800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1184.2 +013900 10 FILLER PIC X(26) VALUE IX1184.2 +014000 ",LFIL=000000,ORG= ,LBLR= ". IX1184.2 +014100 10 FILLER PIC X(37) VALUE IX1184.2 +014200 ",RECKEY= ". IX1184.2 +014300 10 FILLER PIC X(38) VALUE IX1184.2 +014400 ",ALTKEY1= ". IX1184.2 +014500 10 FILLER PIC X(38) VALUE IX1184.2 +014600 ",ALTKEY2= ". IX1184.2 +014700 10 FILLER PIC X(7) VALUE SPACE. IX1184.2 +014800 05 FILE-RECORD-INFO OCCURS 10. IX1184.2 +014900 10 FILE-RECORD-INFO-P1-120. IX1184.2 +015000 15 FILLER PIC X(5). IX1184.2 +015100 15 XFILE-NAME PIC X(6). IX1184.2 +015200 15 FILLER PIC X(8). IX1184.2 +015300 15 XRECORD-NAME PIC X(6). IX1184.2 +015400 15 FILLER PIC X(1). IX1184.2 +015500 15 REELUNIT-NUMBER PIC 9(1). IX1184.2 +015600 15 FILLER PIC X(7). IX1184.2 +015700 15 XRECORD-NUMBER PIC 9(6). IX1184.2 +015800 15 FILLER PIC X(6). IX1184.2 +015900 15 UPDATE-NUMBER PIC 9(2). IX1184.2 +016000 15 FILLER PIC X(5). IX1184.2 +016100 15 ODO-NUMBER PIC 9(4). IX1184.2 +016200 15 FILLER PIC X(5). IX1184.2 +016300 15 XPROGRAM-NAME PIC X(5). IX1184.2 +016400 15 FILLER PIC X(7). IX1184.2 +016500 15 XRECORD-LENGTH PIC 9(6). IX1184.2 +016600 15 FILLER PIC X(7). IX1184.2 +016700 15 CHARS-OR-RECORDS PIC X(2). IX1184.2 +016800 15 FILLER PIC X(1). IX1184.2 +016900 15 XBLOCK-SIZE PIC 9(4). IX1184.2 +017000 15 FILLER PIC X(6). IX1184.2 +017100 15 RECORDS-IN-FILE PIC 9(6). IX1184.2 +017200 15 FILLER PIC X(5). IX1184.2 +017300 15 XFILE-ORGANIZATION PIC X(2). IX1184.2 +017400 15 FILLER PIC X(6). IX1184.2 +017500 15 XLABEL-TYPE PIC X(1). IX1184.2 +017600 10 FILE-RECORD-INFO-P121-240. IX1184.2 +017700 15 FILLER PIC X(8). IX1184.2 +017800 15 XRECORD-KEY PIC X(29). IX1184.2 +017900 15 FILLER PIC X(9). IX1184.2 +018000 15 ALTERNATE-KEY1 PIC X(29). IX1184.2 +018100 15 FILLER PIC X(9). IX1184.2 +018200 15 ALTERNATE-KEY2 PIC X(29). IX1184.2 +018300 15 FILLER PIC X(7). IX1184.2 +018400 IX1184.2 +018500 01 TEST-RESULTS. IX1184.2 +018600 02 FILLER PIC X VALUE SPACE. IX1184.2 +018700 02 FEATURE PIC X(20) VALUE SPACE. IX1184.2 +018800 02 FILLER PIC X VALUE SPACE. IX1184.2 +018900 02 P-OR-F PIC X(5) VALUE SPACE. IX1184.2 +019000 02 FILLER PIC X VALUE SPACE. IX1184.2 +019100 02 PAR-NAME. IX1184.2 +019200 03 FILLER PIC X(19) VALUE SPACE. IX1184.2 +019300 03 PARDOT-X PIC X VALUE SPACE. IX1184.2 +019400 03 DOTVALUE PIC 99 VALUE ZERO. IX1184.2 +019500 02 FILLER PIC X(8) VALUE SPACE. IX1184.2 +019600 02 RE-MARK PIC X(61). IX1184.2 +019700 01 TEST-COMPUTED. IX1184.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX1184.2 +019900 02 FILLER PIC X(17) VALUE IX1184.2 +020000 " COMPUTED=". IX1184.2 +020100 02 COMPUTED-X. IX1184.2 +020200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1184.2 +020300 03 COMPUTED-N REDEFINES COMPUTED-A IX1184.2 +020400 PIC -9(9).9(9). IX1184.2 +020500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1184.2 +020600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1184.2 +020700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1184.2 +020800 03 CM-18V0 REDEFINES COMPUTED-A. IX1184.2 +020900 04 COMPUTED-18V0 PIC -9(18). IX1184.2 +021000 04 FILLER PIC X. IX1184.2 +021100 03 FILLER PIC X(50) VALUE SPACE. IX1184.2 +021200 01 TEST-CORRECT. IX1184.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX1184.2 +021400 02 FILLER PIC X(17) VALUE " CORRECT =". IX1184.2 +021500 02 CORRECT-X. IX1184.2 +021600 03 CORRECT-A PIC X(20) VALUE SPACE. IX1184.2 +021700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1184.2 +021800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1184.2 +021900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1184.2 +022000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1184.2 +022100 03 CR-18V0 REDEFINES CORRECT-A. IX1184.2 +022200 04 CORRECT-18V0 PIC -9(18). IX1184.2 +022300 04 FILLER PIC X. IX1184.2 +022400 03 FILLER PIC X(2) VALUE SPACE. IX1184.2 +022500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1184.2 +022600 01 CCVS-C-1. IX1184.2 +022700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1184.2 +022800- "SS PARAGRAPH-NAME IX1184.2 +022900- " REMARKS". IX1184.2 +023000 02 FILLER PIC X(20) VALUE SPACE. IX1184.2 +023100 01 CCVS-C-2. IX1184.2 +023200 02 FILLER PIC X VALUE SPACE. IX1184.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". IX1184.2 +023400 02 FILLER PIC X(15) VALUE SPACE. IX1184.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". IX1184.2 +023600 02 FILLER PIC X(94) VALUE SPACE. IX1184.2 +023700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1184.2 +023800 01 REC-CT PIC 99 VALUE ZERO. IX1184.2 +023900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1184.2 +024000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1184.2 +024100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1184.2 +024200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1184.2 +024300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1184.2 +024400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1184.2 +024500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1184.2 +024600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1184.2 +024700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1184.2 +024800 01 CCVS-H-1. IX1184.2 +024900 02 FILLER PIC X(39) VALUE SPACES. IX1184.2 +025000 02 FILLER PIC X(42) VALUE IX1184.2 +025100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1184.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX1184.2 +025300 01 CCVS-H-2A. IX1184.2 +025400 02 FILLER PIC X(40) VALUE SPACE. IX1184.2 +025500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1184.2 +025600 02 FILLER PIC XXXX VALUE IX1184.2 +025700 "4.2 ". IX1184.2 +025800 02 FILLER PIC X(28) VALUE IX1184.2 +025900 " COPY - NOT FOR DISTRIBUTION". IX1184.2 +026000 02 FILLER PIC X(41) VALUE SPACE. IX1184.2 +026100 IX1184.2 +026200 01 CCVS-H-2B. IX1184.2 +026300 02 FILLER PIC X(15) VALUE IX1184.2 +026400 "TEST RESULT OF ". IX1184.2 +026500 02 TEST-ID PIC X(9). IX1184.2 +026600 02 FILLER PIC X(4) VALUE IX1184.2 +026700 " IN ". IX1184.2 +026800 02 FILLER PIC X(12) VALUE IX1184.2 +026900 " HIGH ". IX1184.2 +027000 02 FILLER PIC X(22) VALUE IX1184.2 +027100 " LEVEL VALIDATION FOR ". IX1184.2 +027200 02 FILLER PIC X(58) VALUE IX1184.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1184.2 +027400 01 CCVS-H-3. IX1184.2 +027500 02 FILLER PIC X(34) VALUE IX1184.2 +027600 " FOR OFFICIAL USE ONLY ". IX1184.2 +027700 02 FILLER PIC X(58) VALUE IX1184.2 +027800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1184.2 +027900 02 FILLER PIC X(28) VALUE IX1184.2 +028000 " COPYRIGHT 1985 ". IX1184.2 +028100 01 CCVS-E-1. IX1184.2 +028200 02 FILLER PIC X(52) VALUE SPACE. IX1184.2 +028300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1184.2 +028400 02 ID-AGAIN PIC X(9). IX1184.2 +028500 02 FILLER PIC X(45) VALUE SPACES. IX1184.2 +028600 01 CCVS-E-2. IX1184.2 +028700 02 FILLER PIC X(31) VALUE SPACE. IX1184.2 +028800 02 FILLER PIC X(21) VALUE SPACE. IX1184.2 +028900 02 CCVS-E-2-2. IX1184.2 +029000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1184.2 +029100 03 FILLER PIC X VALUE SPACE. IX1184.2 +029200 03 ENDER-DESC PIC X(44) VALUE IX1184.2 +029300 "ERRORS ENCOUNTERED". IX1184.2 +029400 01 CCVS-E-3. IX1184.2 +029500 02 FILLER PIC X(22) VALUE IX1184.2 +029600 " FOR OFFICIAL USE ONLY". IX1184.2 +029700 02 FILLER PIC X(12) VALUE SPACE. IX1184.2 +029800 02 FILLER PIC X(58) VALUE IX1184.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1184.2 +030000 02 FILLER PIC X(13) VALUE SPACE. IX1184.2 +030100 02 FILLER PIC X(15) VALUE IX1184.2 +030200 " COPYRIGHT 1985". IX1184.2 +030300 01 CCVS-E-4. IX1184.2 +030400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1184.2 +030500 02 FILLER PIC X(4) VALUE " OF ". IX1184.2 +030600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1184.2 +030700 02 FILLER PIC X(40) VALUE IX1184.2 +030800 " TESTS WERE EXECUTED SUCCESSFULLY". IX1184.2 +030900 01 XXINFO. IX1184.2 +031000 02 FILLER PIC X(19) VALUE IX1184.2 +031100 "*** INFORMATION ***". IX1184.2 +031200 02 INFO-TEXT. IX1184.2 +031300 04 FILLER PIC X(8) VALUE SPACE. IX1184.2 +031400 04 XXCOMPUTED PIC X(20). IX1184.2 +031500 04 FILLER PIC X(5) VALUE SPACE. IX1184.2 +031600 04 XXCORRECT PIC X(20). IX1184.2 +031700 02 INF-ANSI-REFERENCE PIC X(48). IX1184.2 +031800 01 HYPHEN-LINE. IX1184.2 +031900 02 FILLER PIC IS X VALUE IS SPACE. IX1184.2 +032000 02 FILLER PIC IS X(65) VALUE IS "************************IX1184.2 +032100- "*****************************************". IX1184.2 +032200 02 FILLER PIC IS X(54) VALUE IS "************************IX1184.2 +032300- "******************************". IX1184.2 +032400 01 TEST-NO PIC 99. IX1184.2 +032500 01 CCVS-PGM-ID PIC X(9) VALUE IX1184.2 +032600 "IX118A". IX1184.2 +032700 PROCEDURE DIVISION. IX1184.2 +032800 DECLARATIVES. IX1184.2 +032900 IX1184.2 +033000 SECT-IX105-0002 SECTION. IX1184.2 +033100 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1184.2 +033200 INPUT-PROCESS. IX1184.2 +033300 IF TEST-NO = 5 IX1184.2 +033400 GO TO D-C-TEST-GF-01-1. IX1184.2 +033500 IF STATUS-TEST-10 EQUAL TO 1 IX1184.2 +033600 IF IX-FS3-STAT1 EQUAL TO "1" IX1184.2 +033700 MOVE 1 TO EOF-FLAG IX1184.2 +033800 ELSE IX1184.2 +033900 IF IX-FS3-STAT1 GREATER THAN "1" IX1184.2 +034000 MOVE 1 TO PERM-ERRORS. IX1184.2 +034100 GO TO DECL-EXIT. IX1184.2 +034200 D-C-TEST-GF-01-1. IX1184.2 +034300 IF IX-FS3-STATUS EQUAL TO "41" IX1184.2 +034400 GO TO D-C-PASS-GF-01-0. IX1184.2 +034500 D-C-FAIL-GF-01-0. IX1184.2 +034600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1184.2 +034700 MOVE "41" TO CORRECT-X. IX1184.2 +034800 MOVE "IX-5, 1.3.4, (5) A" TO RE-MARK. IX1184.2 +034900 PERFORM D-FAIL. IX1184.2 +035000 GO TO D-C-WRITE-GF-01-0. IX1184.2 +035100 D-C-PASS-GF-01-0. IX1184.2 +035200 PERFORM D-PASS. IX1184.2 +035300 D-C-WRITE-GF-01-0. IX1184.2 +035400 PERFORM D-PRINT-DETAIL. IX1184.2 +035500 D-CLOSE-FILES. IX1184.2 +035600*P OPEN I-O RAW-DATA. IX1184.2 +035700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1184.2 +035800*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1184.2 +035900*P MOVE "OK. " TO C-ABORT. IX1184.2 +036000*P MOVE PASS-COUNTER TO C-OK. IX1184.2 +036100*P MOVE ERROR-HOLD TO C-ALL. IX1184.2 +036200*P MOVE ERROR-COUNTER TO C-FAIL. IX1184.2 +036300*P MOVE DELETE-COUNTER TO C-DELETED. IX1184.2 +036400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1184.2 +036500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1184.2 +036600*P-END-E-2. IX1184.2 +036700*P CLOSE RAW-DATA. IX1184.2 +036800 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1184.2 +036900 CLOSE PRINT-FILE. IX1184.2 +037000 D-TERMINATE-CCVS. IX1184.2 +037100*S EXIT PROGRAM. IX1184.2 +037200*S-TERMINATE-CALL. IX1184.2 +037300 STOP RUN. IX1184.2 +037400 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1184.2 +037500 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1184.2 +037600 D-PRINT-DETAIL. IX1184.2 +037700 IF REC-CT NOT EQUAL TO ZERO IX1184.2 +037800 MOVE "." TO PARDOT-X IX1184.2 +037900 MOVE REC-CT TO DOTVALUE. IX1184.2 +038000 MOVE TEST-RESULTS TO PRINT-REC. IX1184.2 +038100 PERFORM D-WRITE-LINE. IX1184.2 +038200 IF P-OR-F EQUAL TO "FAIL*" IX1184.2 +038300 PERFORM D-WRITE-LINE IX1184.2 +038400 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1184.2 +038500 ELSE IX1184.2 +038600 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1184.2 +038700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1184.2 +038800 MOVE SPACE TO CORRECT-X. IX1184.2 +038900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1184.2 +039000 MOVE SPACE TO RE-MARK. IX1184.2 +039100 D-END-ROUTINE. IX1184.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1184.2 +039300 PERFORM D-WRITE-LINE 5 TIMES. IX1184.2 +039400 D-END-RTN-EXIT. IX1184.2 +039500 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1184.2 +039600 PERFORM D-WRITE-LINE 2 TIMES. IX1184.2 +039700 D-END-ROUTINE-1. IX1184.2 +039800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1184.2 +039900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1184.2 +040000 ADD PASS-COUNTER TO ERROR-HOLD. IX1184.2 +040100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1184.2 +040200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1184.2 +040300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1184.2 +040400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1184.2 +040500 D-END-ROUTINE-12. IX1184.2 +040600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1184.2 +040700 IF ERROR-COUNTER IS EQUAL TO ZERO IX1184.2 +040800 MOVE "NO " TO ERROR-TOTAL IX1184.2 +040900 ELSE IX1184.2 +041000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1184.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1184.2 +041200 PERFORM D-WRITE-LINE. IX1184.2 +041300 D-END-ROUTINE-13. IX1184.2 +041400 IF DELETE-COUNTER IS EQUAL TO ZERO IX1184.2 +041500 MOVE "NO " TO ERROR-TOTAL ELSE IX1184.2 +041600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1184.2 +041700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1184.2 +041800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1184.2 +041900 PERFORM D-WRITE-LINE. IX1184.2 +042000 IF INSPECT-COUNTER EQUAL TO ZERO IX1184.2 +042100 MOVE "NO " TO ERROR-TOTAL IX1184.2 +042200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1184.2 +042300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1184.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1184.2 +042500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1184.2 +042600 D-WRITE-LINE. IX1184.2 +042700 ADD 1 TO RECORD-COUNT. IX1184.2 +042800 IF RECORD-COUNT GREATER 42 IX1184.2 +042900 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1184.2 +043000 MOVE SPACE TO DUMMY-RECORD IX1184.2 +043100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1184.2 +043200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1184.2 +043300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1184.2 +043400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1184.2 +043500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1184.2 +043600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1184.2 +043700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1184.2 +043800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1184.2 +043900 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1184.2 +044000 MOVE ZERO TO RECORD-COUNT. IX1184.2 +044100 PERFORM D-WRT-LN. IX1184.2 +044200 D-WRT-LN. IX1184.2 +044300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1184.2 +044400 MOVE SPACE TO DUMMY-RECORD. IX1184.2 +044500 D-FAIL-ROUTINE. IX1184.2 +044600 IF COMPUTED-X NOT EQUAL TO SPACE IX1184.2 +044700 GO TO D-FAIL-ROUTINE-WRITE. IX1184.2 +044800 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1184.2 +044900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1184.2 +045000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1184.2 +045100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1184.2 +045200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1184.2 +045300 GO TO D-FAIL-ROUTINE-EX. IX1184.2 +045400 D-FAIL-ROUTINE-WRITE. IX1184.2 +045500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1184.2 +045600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1184.2 +045700 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1184.2 +045800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1184.2 +045900 D-FAIL-ROUTINE-EX. EXIT. IX1184.2 +046000 D-BAIL-OUT. IX1184.2 +046100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1184.2 +046200 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1184.2 +046300 D-BAIL-OUT-WRITE. IX1184.2 +046400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1184.2 +046500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1184.2 +046600 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1184.2 +046700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1184.2 +046800 D-BAIL-OUT-EX. EXIT. IX1184.2 +046900 DECL-EXIT. EXIT. IX1184.2 +047000 END DECLARATIVES. IX1184.2 +047100 IX1184.2 +047200 IX1184.2 +047300 CCVS1 SECTION. IX1184.2 +047400 OPEN-FILES. IX1184.2 +047500*P OPEN I-O RAW-DATA. IX1184.2 +047600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1184.2 +047700*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1184.2 +047800*P MOVE "ABORTED " TO C-ABORT. IX1184.2 +047900*P ADD 1 TO C-NO-OF-TESTS. IX1184.2 +048000*P ACCEPT C-DATE FROM DATE. IX1184.2 +048100*P ACCEPT C-TIME FROM TIME. IX1184.2 +048200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1184.2 +048300*PND-E-1. IX1184.2 +048400*P CLOSE RAW-DATA. IX1184.2 +048500 OPEN OUTPUT PRINT-FILE. IX1184.2 +048600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1184.2 +048700 MOVE SPACE TO TEST-RESULTS. IX1184.2 +048800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1184.2 +048900 MOVE ZERO TO REC-SKL-SUB. IX1184.2 +049000 PERFORM CCVS-INIT-FILE 9 TIMES. IX1184.2 +049100 CCVS-INIT-FILE. IX1184.2 +049200 ADD 1 TO REC-SKL-SUB. IX1184.2 +049300 MOVE FILE-RECORD-INFO-SKELETON IX1184.2 +049400 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1184.2 +049500 CCVS-INIT-EXIT. IX1184.2 +049600 GO TO CCVS1-EXIT. IX1184.2 +049700 CLOSE-FILES. IX1184.2 +049800*P OPEN I-O RAW-DATA. IX1184.2 +049900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1184.2 +050000*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1184.2 +050100*P MOVE "OK. " TO C-ABORT. IX1184.2 +050200*P MOVE PASS-COUNTER TO C-OK. IX1184.2 +050300*P MOVE ERROR-HOLD TO C-ALL. IX1184.2 +050400*P MOVE ERROR-COUNTER TO C-FAIL. IX1184.2 +050500*P MOVE DELETE-COUNTER TO C-DELETED. IX1184.2 +050600*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1184.2 +050700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1184.2 +050800*PND-E-2. IX1184.2 +050900*P CLOSE RAW-DATA. IX1184.2 +051000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1184.2 +051100 TERMINATE-CCVS. IX1184.2 +051200*S EXIT PROGRAM. IX1184.2 +051300*SERMINATE-CALL. IX1184.2 +051400 STOP RUN. IX1184.2 +051500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1184.2 +051600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1184.2 +051700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1184.2 +051800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1184.2 +051900 MOVE "****TEST DELETED****" TO RE-MARK. IX1184.2 +052000 PRINT-DETAIL. IX1184.2 +052100 IF REC-CT NOT EQUAL TO ZERO IX1184.2 +052200 MOVE "." TO PARDOT-X IX1184.2 +052300 MOVE REC-CT TO DOTVALUE. IX1184.2 +052400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1184.2 +052500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1184.2 +052600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1184.2 +052700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1184.2 +052800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1184.2 +052900 MOVE SPACE TO CORRECT-X. IX1184.2 +053000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1184.2 +053100 MOVE SPACE TO RE-MARK. IX1184.2 +053200 HEAD-ROUTINE. IX1184.2 +053300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +053400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +053500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1184.2 +053600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1184.2 +053700 COLUMN-NAMES-ROUTINE. IX1184.2 +053800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +053900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +054000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +054100 END-ROUTINE. IX1184.2 +054200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1184.2 +054300 END-RTN-EXIT. IX1184.2 +054400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +054500 END-ROUTINE-1. IX1184.2 +054600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1184.2 +054700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1184.2 +054800 ADD PASS-COUNTER TO ERROR-HOLD. IX1184.2 +054900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1184.2 +055000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1184.2 +055100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1184.2 +055200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1184.2 +055300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1184.2 +055400 END-ROUTINE-12. IX1184.2 +055500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1184.2 +055600 IF ERROR-COUNTER IS EQUAL TO ZERO IX1184.2 +055700 MOVE "NO " TO ERROR-TOTAL IX1184.2 +055800 ELSE IX1184.2 +055900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1184.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1184.2 +056100 PERFORM WRITE-LINE. IX1184.2 +056200 END-ROUTINE-13. IX1184.2 +056300 IF DELETE-COUNTER IS EQUAL TO ZERO IX1184.2 +056400 MOVE "NO " TO ERROR-TOTAL ELSE IX1184.2 +056500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1184.2 +056600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1184.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +056800 IF INSPECT-COUNTER EQUAL TO ZERO IX1184.2 +056900 MOVE "NO " TO ERROR-TOTAL IX1184.2 +057000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1184.2 +057100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1184.2 +057200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +057300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1184.2 +057400 WRITE-LINE. IX1184.2 +057500 ADD 1 TO RECORD-COUNT. IX1184.2 +057600 IF RECORD-COUNT GREATER 42 IX1184.2 +057700 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1184.2 +057800 MOVE SPACE TO DUMMY-RECORD IX1184.2 +057900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1184.2 +058000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1184.2 +058100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1184.2 +058200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1184.2 +058300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1184.2 +058400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1184.2 +058500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1184.2 +058600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1184.2 +058700 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1184.2 +058800 MOVE ZERO TO RECORD-COUNT. IX1184.2 +058900 PERFORM WRT-LN. IX1184.2 +059000 WRT-LN. IX1184.2 +059100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1184.2 +059200 MOVE SPACE TO DUMMY-RECORD. IX1184.2 +059300 BLANK-LINE-PRINT. IX1184.2 +059400 PERFORM WRT-LN. IX1184.2 +059500 FAIL-ROUTINE. IX1184.2 +059600 IF COMPUTED-X NOT EQUAL TO SPACE IX1184.2 +059700 GO TO FAIL-ROUTINE-WRITE. IX1184.2 +059800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1184.2 +059900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1184.2 +060000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1184.2 +060100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +060200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1184.2 +060300 GO TO FAIL-ROUTINE-EX. IX1184.2 +060400 FAIL-ROUTINE-WRITE. IX1184.2 +060500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1184.2 +060600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1184.2 +060700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1184.2 +060800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1184.2 +060900 FAIL-ROUTINE-EX. EXIT. IX1184.2 +061000 BAIL-OUT. IX1184.2 +061100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1184.2 +061200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1184.2 +061300 BAIL-OUT-WRITE. IX1184.2 +061400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1184.2 +061500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1184.2 +061600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1184.2 +061700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1184.2 +061800 BAIL-OUT-EX. EXIT. IX1184.2 +061900 CCVS1-EXIT. IX1184.2 +062000 EXIT. IX1184.2 +062100 IX1184.2 +062200 SECT-IX118A-0003 SECTION. IX1184.2 +062300 SEQ-INIT-010. IX1184.2 +062400 MOVE ZERO TO TEST-NO. IX1184.2 +062500 MOVE "IX-FS3" TO XFILE-NAME (1). IX1184.2 +062600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1184.2 +062700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1184.2 +062800 MOVE 000240 TO XRECORD-LENGTH (1). IX1184.2 +062900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1184.2 +063000 MOVE 0002 TO XBLOCK-SIZE (1). IX1184.2 +063100 MOVE 000050 TO RECORDS-IN-FILE (1). IX1184.2 +063200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1184.2 +063300 MOVE "S" TO XLABEL-TYPE (1). IX1184.2 +063400 MOVE 000001 TO XRECORD-NUMBER (1). IX1184.2 +063500 MOVE 0 TO COUNT-OF-RECS. IX1184.2 +063600 IX1184.2 +063700******************************************************************IX1184.2 +063800* TEST 1 *IX1184.2 +063900* OPEN OUTPUT ... 00 EXPECTED *IX1184.2 +064000* IX-3, 1.3.4 (1) A *IX1184.2 +064100* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1184.2 +064200* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1184.2 +064300******************************************************************IX1184.2 +064400 OPN-INIT-GF-01-0. IX1184.2 +064500 MOVE 1 TO STATUS-TEST-00. IX1184.2 +064600 MOVE SPACES TO IX-FS3-STATUS. IX1184.2 +064700 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1184.2 +064800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1184.2 +064900 OPEN IX1184.2 +065000 I-O IX-FS3. IX1184.2 +065100 IF IX-FS3-STATUS EQUAL TO "00" IX1184.2 +065200 GO TO OPN-PASS-GF-01-0. IX1184.2 +065300 OPN-FAIL-GF-01-0. IX1184.2 +065400 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1184.2 +065500 PERFORM FAIL. IX1184.2 +065600 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1184.2 +065700 MOVE "00" TO CORRECT-X. IX1184.2 +065800 GO TO OPN-WRITE-GF-01-0. IX1184.2 +065900 OPN-PASS-GF-01-0. IX1184.2 +066000 PERFORM PASS. IX1184.2 +066100 OPN-WRITE-GF-01-0. IX1184.2 +066200 PERFORM PRINT-DETAIL. IX1184.2 +066300******************************************************************IX1184.2 +066400* TEST 4 *IX1184.2 +066500* CLOSE I-O 00 EXPECTED *IX1184.2 +066600* IX-3, 1.3.4 (1) A *IX1184.2 +066700******************************************************************IX1184.2 +066800 CLO-INIT-GF-01-0. IX1184.2 +066900 MOVE SPACES TO IX-FS3-STATUS. IX1184.2 +067000 MOVE "CLOSE I-O :00 EXP." TO FEATURE. IX1184.2 +067100 MOVE "CLO-TEST-GF-01-0" TO PAR-NAME. IX1184.2 +067200 CLO-TEST-GF-01-0. IX1184.2 +067300 CLOSE IX-FS3. IX1184.2 +067400 IF IX-FS3-STATUS = "00" IX1184.2 +067500 GO TO CLO-PASS-GF-01-0. IX1184.2 +067600 CLO-FAIL-GF-01-0. IX1184.2 +067700 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1184.2 +067800 PERFORM FAIL. IX1184.2 +067900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1184.2 +068000 MOVE "00" TO CORRECT-X. IX1184.2 +068100 GO TO CLO-WRITE-GF-01-0. IX1184.2 +068200 CLO-PASS-GF-01-0. IX1184.2 +068300 PERFORM PASS. IX1184.2 +068400 CLO-WRITE-GF-01-0. IX1184.2 +068500 PERFORM PRINT-DETAIL. IX1184.2 +068600 IX1184.2 +068700******************************************************************IX1184.2 +068800* A INDEXED FILE WITH 50 RECORDS HAS BEEN CREATED. *IX1184.2 +068900******************************************************************IX1184.2 +069000 IX1184.2 +069100******************************************************************IX1184.2 +069200* TEST 5 *IX1184.2 +069300* OPEN FOR A FILE ALREADY IN OPEN MODE *IX1184.2 +069400* FILE STATUS 41 EXPECTED IX-5, 1.3.4 (5) A *IX1184.2 +069500******************************************************************IX1184.2 +069600 OPN-TEST-GF-02-0. IX1184.2 +069700 MOVE 5 TO TEST-NO. IX1184.2 +069800 MOVE SPACES TO IX-FS3-STATUS. IX1184.2 +069900 MOVE "OPEN 41 EXP." TO FEATURE IX1184.2 +070000 MOVE "OPN-TEST-GF-02-0" TO PAR-NAME. IX1184.2 +070100 OPEN INPUT IX-FS3. IX1184.2 +070200 OPEN INPUT IX-FS3. IX1184.2 +070300 OPN-TEST-GF-02-1. IX1184.2 +070400 IF IX-FS3-STATUS EQUAL TO "41" IX1184.2 +070500 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1184.2 +070600 TO RE-MARK IX1184.2 +070700 GO TO OPN-WRITE-GF-02-0. IX1184.2 +070800 OPN-FAIL-GF-02-0. IX1184.2 +070900 MOVE "IX-5, 1.3.4, (5) A" TO RE-MARK. IX1184.2 +071000 OPN-WRITE-GF-02-0. IX1184.2 +071100 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1184.2 +071200 MOVE "41" TO CORRECT-X. IX1184.2 +071300 PERFORM FAIL. IX1184.2 +071400 PERFORM PRINT-DETAIL. IX1184.2 +071500 CLOSE IX-FS3. IX1184.2 +071600 IX1184.2 +071700 TERMINATE-ROUTINE. IX1184.2 +071800 EXIT. IX1184.2 +071900 IX1184.2 +072000 CCVS-EXIT SECTION. IX1184.2 +072100 CCVS-999999. IX1184.2 +072200 GO TO CLOSE-FILES. IX1184.2 diff --git a/tests/cobol85/IX/IX119A.SUB b/tests/cobol85/IX/IX119A.SUB new file mode 100755 index 00000000..3eab8981 --- /dev/null +++ b/tests/cobol85/IX/IX119A.SUB @@ -0,0 +1,731 @@ +000100 IDENTIFICATION DIVISION. IX1194.2 +000200 PROGRAM-ID. IX1194.2 +000300 IX119A. IX1194.2 +000400**************************************************************** IX1194.2 +000500* * IX1194.2 +000600* VALIDATION FOR:- * IX1194.2 +000700* * IX1194.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1194.2 +000900* * IX1194.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1194.2 +001100* * IX1194.2 +001200**************************************************************** IX1194.2 +001300* IX1194.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1194.2 +001500* IX113A. IX1194.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1194.2 +001700* THEN AN ATTEMPT IS MADE TO REWRITE A RECORD WITH THE WRONG IX1194.2 +001800* PRIME RECORD KEY (STATUS 21 EXPECTED). THEN AN ATTEMPT IX1194.2 +001900* IS MADE TO DELETE A RECORD, AT WHICH POINT THE DECLARATIVES IX1194.2 +002000* SHOULD BE ACTIONED AND THE FILE STATUS SHOULD BE 43 . IX1194.2 +002100* IX1194.2 +002200* STANDARD REFERENCE IX-5, 1.3.4 (3) A IX1194.2 +002300* STANDARD REFERENCE IX-5, 1.3.4 (5) C IX1194.2 +002400* IX1194.2 +002500* X-CARDS USED IN THIS PROGRAM: IX1194.2 +002600* IX1194.2 +002700* XXXXX024 IX1194.2 +002800* XXXXX055. IX1194.2 +002900* P XXXXX062. IX1194.2 +003000* XXXXX082. IX1194.2 +003100* XXXXX083. IX1194.2 +003200* C XXXXX084 IX1194.2 +003300* IX1194.2 +003400* IX1194.2 +003500 ENVIRONMENT DIVISION. IX1194.2 +003600 CONFIGURATION SECTION. IX1194.2 +003700 SOURCE-COMPUTER. IX1194.2 +003800 Linux. IX1194.2 +003900 OBJECT-COMPUTER. IX1194.2 +004000 Linux. IX1194.2 +004100 INPUT-OUTPUT SECTION. IX1194.2 +004200 FILE-CONTROL. IX1194.2 +004300*P SELECT RAW-DATA ASSIGN TO IX1194.2 +004400*P "XXXXX062" IX1194.2 +004500*P ORGANIZATION IS INDEXED IX1194.2 +004600*P ACCESS MODE IS RANDOM IX1194.2 +004700*P RECORD KEY IS RAW-DATA-KEY. IX1194.2 +004800* IX1194.2 +004900 SELECT PRINT-FILE ASSIGN TO IX1194.2 +005000 "report.log". IX1194.2 +005100* IX1194.2 +005200 SELECT IX-FS3 ASSIGN IX1194.2 +005300 "XXXXX024" IX1194.2 +005400 ORGANIZATION IS INDEXED IX1194.2 +005500 ACCESS MODE IS SEQUENTIAL IX1194.2 +005600 RECORD KEY IS IX-FS3-KEY IX1194.2 +005700 FILE STATUS IS IX-FS3-STATUS. IX1194.2 +005800 IX1194.2 +005900 DATA DIVISION. IX1194.2 +006000 IX1194.2 +006100 FILE SECTION. IX1194.2 +006200*P IX1194.2 +006300*PD RAW-DATA. IX1194.2 +006400*P IX1194.2 +006500*P1 RAW-DATA-SATZ. IX1194.2 +006600*P 05 RAW-DATA-KEY PIC X(6). IX1194.2 +006700*P 05 C-DATE PIC 9(6). IX1194.2 +006800*P 05 C-TIME PIC 9(8). IX1194.2 +006900*P 05 C-NO-OF-TESTS PIC 99. IX1194.2 +007000*P 05 C-OK PIC 999. IX1194.2 +007100*P 05 C-ALL PIC 999. IX1194.2 +007200*P 05 C-FAIL PIC 999. IX1194.2 +007300*P 05 C-DELETED PIC 999. IX1194.2 +007400*P 05 C-INSPECT PIC 999. IX1194.2 +007500*P 05 C-NOTE PIC X(13). IX1194.2 +007600*P 05 C-INDENT PIC X. IX1194.2 +007700*P 05 C-ABORT PIC X(8). IX1194.2 +007800 IX1194.2 +007900 FD PRINT-FILE. IX1194.2 +008000 IX1194.2 +008100 01 PRINT-REC PIC X(120). IX1194.2 +008200 IX1194.2 +008300 01 DUMMY-RECORD PIC X(120). IX1194.2 +008400 IX1194.2 +008500 FD IX-FS3 IX1194.2 +008600*C DATA RECORDS IX-FS3R1-F-G-240 IX1194.2 +008700*C LABEL RECORD STANDARD IX1194.2 +008800 RECORD 240 IX1194.2 +008900 BLOCK CONTAINS 2 RECORDS. IX1194.2 +009000 IX1194.2 +009100 01 IX-FS3R1-F-G-240. IX1194.2 +009200 05 IX-FS3-REC-120 PIC X(120). IX1194.2 +009300 05 IX-FS3-REC-120-240. IX1194.2 +009400 10 FILLER PIC X(8). IX1194.2 +009500 10 IX-FS3-KEY PIC X(29). IX1194.2 +009600 10 FILLER PIC X(9). IX1194.2 +009700 10 IX-FS3-ALTER-KEY PIC X(29). IX1194.2 +009800 10 FILLER PIC X(45). IX1194.2 +009900 IX1194.2 +010000 IX1194.2 +010100 WORKING-STORAGE SECTION. IX1194.2 +010200 IX1194.2 +010300 01 GRP-0101. IX1194.2 +010400 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1194.2 +010500 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1194.2 +010600 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1194.2 +010700 IX1194.2 +010800 01 GRP-0102. IX1194.2 +010900 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1194.2 +011000 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1194.2 +011100 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1194.2 +011200 IX1194.2 +011300 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1194.2 +011400 IX1194.2 +011500 01 EOF-FLAG PIC 9 VALUE ZERO. IX1194.2 +011600 IX1194.2 +011700 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1194.2 +011800 IX1194.2 +011900 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1194.2 +012000 IX1194.2 +012100 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1194.2 +012200 IX1194.2 +012300 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1194.2 +012400 IX1194.2 +012500 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1194.2 +012600 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1194.2 +012700 IX1194.2 +012800 01 IX-FS3-STATUS. IX1194.2 +012900 05 IX-FS3-STAT1 PIC X. IX1194.2 +013000 05 IX-FS3-STAT2 PIC X. IX1194.2 +013100 IX1194.2 +013200 01 COUNT-OF-RECS PIC 9(5). IX1194.2 +013300 IX1194.2 +013400 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1194.2 +013500 IX1194.2 +013600 01 FILE-RECORD-INFORMATION-REC. IX1194.2 +013700 05 FILE-RECORD-INFO-SKELETON. IX1194.2 +013800 10 FILLER PIC X(48) VALUE IX1194.2 +013900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1194.2 +014000 10 FILLER PIC X(46) VALUE IX1194.2 +014100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1194.2 +014200 10 FILLER PIC X(26) VALUE IX1194.2 +014300 ",LFIL=000000,ORG= ,LBLR= ". IX1194.2 +014400 10 FILLER PIC X(37) VALUE IX1194.2 +014500 ",RECKEY= ". IX1194.2 +014600 10 FILLER PIC X(38) VALUE IX1194.2 +014700 ",ALTKEY1= ". IX1194.2 +014800 10 FILLER PIC X(38) VALUE IX1194.2 +014900 ",ALTKEY2= ". IX1194.2 +015000 10 FILLER PIC X(7) VALUE SPACE. IX1194.2 +015100 05 FILE-RECORD-INFO OCCURS 10. IX1194.2 +015200 10 FILE-RECORD-INFO-P1-120. IX1194.2 +015300 15 FILLER PIC X(5). IX1194.2 +015400 15 XFILE-NAME PIC X(6). IX1194.2 +015500 15 FILLER PIC X(8). IX1194.2 +015600 15 XRECORD-NAME PIC X(6). IX1194.2 +015700 15 FILLER PIC X(1). IX1194.2 +015800 15 REELUNIT-NUMBER PIC 9(1). IX1194.2 +015900 15 FILLER PIC X(7). IX1194.2 +016000 15 XRECORD-NUMBER PIC 9(6). IX1194.2 +016100 15 FILLER PIC X(6). IX1194.2 +016200 15 UPDATE-NUMBER PIC 9(2). IX1194.2 +016300 15 FILLER PIC X(5). IX1194.2 +016400 15 ODO-NUMBER PIC 9(4). IX1194.2 +016500 15 FILLER PIC X(5). IX1194.2 +016600 15 XPROGRAM-NAME PIC X(5). IX1194.2 +016700 15 FILLER PIC X(7). IX1194.2 +016800 15 XRECORD-LENGTH PIC 9(6). IX1194.2 +016900 15 FILLER PIC X(7). IX1194.2 +017000 15 CHARS-OR-RECORDS PIC X(2). IX1194.2 +017100 15 FILLER PIC X(1). IX1194.2 +017200 15 XBLOCK-SIZE PIC 9(4). IX1194.2 +017300 15 FILLER PIC X(6). IX1194.2 +017400 15 RECORDS-IN-FILE PIC 9(6). IX1194.2 +017500 15 FILLER PIC X(5). IX1194.2 +017600 15 XFILE-ORGANIZATION PIC X(2). IX1194.2 +017700 15 FILLER PIC X(6). IX1194.2 +017800 15 XLABEL-TYPE PIC X(1). IX1194.2 +017900 10 FILE-RECORD-INFO-P121-240. IX1194.2 +018000 15 FILLER PIC X(8). IX1194.2 +018100 15 XRECORD-KEY PIC X(29). IX1194.2 +018200 15 FILLER PIC X(9). IX1194.2 +018300 15 ALTERNATE-KEY1 PIC X(29). IX1194.2 +018400 15 FILLER PIC X(9). IX1194.2 +018500 15 ALTERNATE-KEY2 PIC X(29). IX1194.2 +018600 15 FILLER PIC X(7). IX1194.2 +018700 IX1194.2 +018800 01 TEST-RESULTS. IX1194.2 +018900 02 FILLER PIC X VALUE SPACE. IX1194.2 +019000 02 FEATURE PIC X(20) VALUE SPACE. IX1194.2 +019100 02 FILLER PIC X VALUE SPACE. IX1194.2 +019200 02 P-OR-F PIC X(5) VALUE SPACE. IX1194.2 +019300 02 FILLER PIC X VALUE SPACE. IX1194.2 +019400 02 PAR-NAME. IX1194.2 +019500 03 FILLER PIC X(19) VALUE SPACE. IX1194.2 +019600 03 PARDOT-X PIC X VALUE SPACE. IX1194.2 +019700 03 DOTVALUE PIC 99 VALUE ZERO. IX1194.2 +019800 02 FILLER PIC X(8) VALUE SPACE. IX1194.2 +019900 02 RE-MARK PIC X(61). IX1194.2 +020000 01 TEST-COMPUTED. IX1194.2 +020100 02 FILLER PIC X(30) VALUE SPACE. IX1194.2 +020200 02 FILLER PIC X(17) VALUE IX1194.2 +020300 " COMPUTED=". IX1194.2 +020400 02 COMPUTED-X. IX1194.2 +020500 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1194.2 +020600 03 COMPUTED-N REDEFINES COMPUTED-A IX1194.2 +020700 PIC -9(9).9(9). IX1194.2 +020800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1194.2 +020900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1194.2 +021000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1194.2 +021100 03 CM-18V0 REDEFINES COMPUTED-A. IX1194.2 +021200 04 COMPUTED-18V0 PIC -9(18). IX1194.2 +021300 04 FILLER PIC X. IX1194.2 +021400 03 FILLER PIC X(50) VALUE SPACE. IX1194.2 +021500 01 TEST-CORRECT. IX1194.2 +021600 02 FILLER PIC X(30) VALUE SPACE. IX1194.2 +021700 02 FILLER PIC X(17) VALUE " CORRECT =". IX1194.2 +021800 02 CORRECT-X. IX1194.2 +021900 03 CORRECT-A PIC X(20) VALUE SPACE. IX1194.2 +022000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1194.2 +022100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1194.2 +022200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1194.2 +022300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1194.2 +022400 03 CR-18V0 REDEFINES CORRECT-A. IX1194.2 +022500 04 CORRECT-18V0 PIC -9(18). IX1194.2 +022600 04 FILLER PIC X. IX1194.2 +022700 03 FILLER PIC X(2) VALUE SPACE. IX1194.2 +022800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1194.2 +022900 01 CCVS-C-1. IX1194.2 +023000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1194.2 +023100- "SS PARAGRAPH-NAME IX1194.2 +023200- " REMARKS". IX1194.2 +023300 02 FILLER PIC X(20) VALUE SPACE. IX1194.2 +023400 01 CCVS-C-2. IX1194.2 +023500 02 FILLER PIC X VALUE SPACE. IX1194.2 +023600 02 FILLER PIC X(6) VALUE "TESTED". IX1194.2 +023700 02 FILLER PIC X(15) VALUE SPACE. IX1194.2 +023800 02 FILLER PIC X(4) VALUE "FAIL". IX1194.2 +023900 02 FILLER PIC X(94) VALUE SPACE. IX1194.2 +024000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1194.2 +024100 01 REC-CT PIC 99 VALUE ZERO. IX1194.2 +024200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1194.2 +024300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1194.2 +024400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1194.2 +024500 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1194.2 +024600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1194.2 +024700 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1194.2 +024800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1194.2 +024900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1194.2 +025000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1194.2 +025100 01 CCVS-H-1. IX1194.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX1194.2 +025300 02 FILLER PIC X(42) VALUE IX1194.2 +025400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1194.2 +025500 02 FILLER PIC X(39) VALUE SPACES. IX1194.2 +025600 01 CCVS-H-2A. IX1194.2 +025700 02 FILLER PIC X(40) VALUE SPACE. IX1194.2 +025800 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1194.2 +025900 02 FILLER PIC XXXX VALUE IX1194.2 +026000 "4.2 ". IX1194.2 +026100 02 FILLER PIC X(28) VALUE IX1194.2 +026200 " COPY - NOT FOR DISTRIBUTION". IX1194.2 +026300 02 FILLER PIC X(41) VALUE SPACE. IX1194.2 +026400 IX1194.2 +026500 01 CCVS-H-2B. IX1194.2 +026600 02 FILLER PIC X(15) VALUE IX1194.2 +026700 "TEST RESULT OF ". IX1194.2 +026800 02 TEST-ID PIC X(9). IX1194.2 +026900 02 FILLER PIC X(4) VALUE IX1194.2 +027000 " IN ". IX1194.2 +027100 02 FILLER PIC X(12) VALUE IX1194.2 +027200 " HIGH ". IX1194.2 +027300 02 FILLER PIC X(22) VALUE IX1194.2 +027400 " LEVEL VALIDATION FOR ". IX1194.2 +027500 02 FILLER PIC X(58) VALUE IX1194.2 +027600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1194.2 +027700 01 CCVS-H-3. IX1194.2 +027800 02 FILLER PIC X(34) VALUE IX1194.2 +027900 " FOR OFFICIAL USE ONLY ". IX1194.2 +028000 02 FILLER PIC X(58) VALUE IX1194.2 +028100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1194.2 +028200 02 FILLER PIC X(28) VALUE IX1194.2 +028300 " COPYRIGHT 1985 ". IX1194.2 +028400 01 CCVS-E-1. IX1194.2 +028500 02 FILLER PIC X(52) VALUE SPACE. IX1194.2 +028600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1194.2 +028700 02 ID-AGAIN PIC X(9). IX1194.2 +028800 02 FILLER PIC X(45) VALUE SPACES. IX1194.2 +028900 01 CCVS-E-2. IX1194.2 +029000 02 FILLER PIC X(31) VALUE SPACE. IX1194.2 +029100 02 FILLER PIC X(21) VALUE SPACE. IX1194.2 +029200 02 CCVS-E-2-2. IX1194.2 +029300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1194.2 +029400 03 FILLER PIC X VALUE SPACE. IX1194.2 +029500 03 ENDER-DESC PIC X(44) VALUE IX1194.2 +029600 "ERRORS ENCOUNTERED". IX1194.2 +029700 01 CCVS-E-3. IX1194.2 +029800 02 FILLER PIC X(22) VALUE IX1194.2 +029900 " FOR OFFICIAL USE ONLY". IX1194.2 +030000 02 FILLER PIC X(12) VALUE SPACE. IX1194.2 +030100 02 FILLER PIC X(58) VALUE IX1194.2 +030200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1194.2 +030300 02 FILLER PIC X(13) VALUE SPACE. IX1194.2 +030400 02 FILLER PIC X(15) VALUE IX1194.2 +030500 " COPYRIGHT 1985". IX1194.2 +030600 01 CCVS-E-4. IX1194.2 +030700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1194.2 +030800 02 FILLER PIC X(4) VALUE " OF ". IX1194.2 +030900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1194.2 +031000 02 FILLER PIC X(40) VALUE IX1194.2 +031100 " TESTS WERE EXECUTED SUCCESSFULLY". IX1194.2 +031200 01 XXINFO. IX1194.2 +031300 02 FILLER PIC X(19) VALUE IX1194.2 +031400 "*** INFORMATION ***". IX1194.2 +031500 02 INFO-TEXT. IX1194.2 +031600 04 FILLER PIC X(8) VALUE SPACE. IX1194.2 +031700 04 XXCOMPUTED PIC X(20). IX1194.2 +031800 04 FILLER PIC X(5) VALUE SPACE. IX1194.2 +031900 04 XXCORRECT PIC X(20). IX1194.2 +032000 02 INF-ANSI-REFERENCE PIC X(48). IX1194.2 +032100 01 HYPHEN-LINE. IX1194.2 +032200 02 FILLER PIC IS X VALUE IS SPACE. IX1194.2 +032300 02 FILLER PIC IS X(65) VALUE IS "************************IX1194.2 +032400- "*****************************************". IX1194.2 +032500 02 FILLER PIC IS X(54) VALUE IS "************************IX1194.2 +032600- "******************************". IX1194.2 +032700 01 TEST-NO PIC 99. IX1194.2 +032800 01 CCVS-PGM-ID PIC X(9) VALUE IX1194.2 +032900 "IX119A". IX1194.2 +033000 PROCEDURE DIVISION. IX1194.2 +033100 DECLARATIVES. IX1194.2 +033200 IX1194.2 +033300 SECT-IX105-0002 SECTION. IX1194.2 +033400 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1194.2 +033500 INPUT-PROCESS. IX1194.2 +033600 IF TEST-NO = 5 IX1194.2 +033700 GO TO D-C-TEST-GF-01-1. IX1194.2 +033800 IF STATUS-TEST-10 EQUAL TO 1 IX1194.2 +033900 IF IX-FS3-STAT1 EQUAL TO "1" IX1194.2 +034000 MOVE 1 TO EOF-FLAG IX1194.2 +034100 ELSE IX1194.2 +034200 IF IX-FS3-STAT1 GREATER THAN "1" IX1194.2 +034300 MOVE 1 TO PERM-ERRORS. IX1194.2 +034400 GO TO DECL-EXIT. IX1194.2 +034500 D-C-TEST-GF-01-1. IX1194.2 +034600 IF IX-FS3-STATUS EQUAL TO "43" IX1194.2 +034700 GO TO D-C-PASS-GF-01-0. IX1194.2 +034800 D-C-FAIL-GF-01-0. IX1194.2 +034900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1194.2 +035000 MOVE "43" TO CORRECT-X. IX1194.2 +035100 MOVE "IX-5, 1.3.4, (5) C" TO RE-MARK. IX1194.2 +035200 PERFORM D-FAIL. IX1194.2 +035300 GO TO D-C-WRITE-GF-01-0. IX1194.2 +035400 D-C-PASS-GF-01-0. IX1194.2 +035500 PERFORM D-PASS. IX1194.2 +035600 D-C-WRITE-GF-01-0. IX1194.2 +035700 PERFORM D-PRINT-DETAIL. IX1194.2 +035800 D-CLOSE-FILES. IX1194.2 +035900 CLOSE IX-FS3. IX1194.2 +036000*P OPEN I-O RAW-DATA. IX1194.2 +036100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1194.2 +036200*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1194.2 +036300*P MOVE "OK. " TO C-ABORT. IX1194.2 +036400*P MOVE PASS-COUNTER TO C-OK. IX1194.2 +036500*P MOVE ERROR-HOLD TO C-ALL. IX1194.2 +036600*P MOVE ERROR-COUNTER TO C-FAIL. IX1194.2 +036700*P MOVE DELETE-COUNTER TO C-DELETED. IX1194.2 +036800*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1194.2 +036900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1194.2 +037000*P-END-E-2. IX1194.2 +037100*P CLOSE RAW-DATA. IX1194.2 +037200 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1194.2 +037300 CLOSE PRINT-FILE. IX1194.2 +037400 D-TERMINATE-CCVS. IX1194.2 +037500*S EXIT PROGRAM. IX1194.2 +037600*S-TERMINATE-CALL. IX1194.2 +037700 STOP RUN. IX1194.2 +037800 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1194.2 +037900 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1194.2 +038000 D-PRINT-DETAIL. IX1194.2 +038100 IF REC-CT NOT EQUAL TO ZERO IX1194.2 +038200 MOVE "." TO PARDOT-X IX1194.2 +038300 MOVE REC-CT TO DOTVALUE. IX1194.2 +038400 MOVE TEST-RESULTS TO PRINT-REC. IX1194.2 +038500 PERFORM D-WRITE-LINE. IX1194.2 +038600 IF P-OR-F EQUAL TO "FAIL*" IX1194.2 +038700 PERFORM D-WRITE-LINE IX1194.2 +038800 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1194.2 +038900 ELSE IX1194.2 +039000 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1194.2 +039100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1194.2 +039200 MOVE SPACE TO CORRECT-X. IX1194.2 +039300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1194.2 +039400 MOVE SPACE TO RE-MARK. IX1194.2 +039500 D-END-ROUTINE. IX1194.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1194.2 +039700 PERFORM D-WRITE-LINE 5 TIMES. IX1194.2 +039800 D-END-RTN-EXIT. IX1194.2 +039900 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1194.2 +040000 PERFORM D-WRITE-LINE 2 TIMES. IX1194.2 +040100 D-END-ROUTINE-1. IX1194.2 +040200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1194.2 +040300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1194.2 +040400 ADD PASS-COUNTER TO ERROR-HOLD. IX1194.2 +040500 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1194.2 +040600 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1194.2 +040700 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1194.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1194.2 +040900 D-END-ROUTINE-12. IX1194.2 +041000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1194.2 +041100 IF ERROR-COUNTER IS EQUAL TO ZERO IX1194.2 +041200 MOVE "NO " TO ERROR-TOTAL IX1194.2 +041300 ELSE IX1194.2 +041400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1194.2 +041500 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1194.2 +041600 PERFORM D-WRITE-LINE. IX1194.2 +041700 D-END-ROUTINE-13. IX1194.2 +041800 IF DELETE-COUNTER IS EQUAL TO ZERO IX1194.2 +041900 MOVE "NO " TO ERROR-TOTAL ELSE IX1194.2 +042000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1194.2 +042100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1194.2 +042200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1194.2 +042300 PERFORM D-WRITE-LINE. IX1194.2 +042400 IF INSPECT-COUNTER EQUAL TO ZERO IX1194.2 +042500 MOVE "NO " TO ERROR-TOTAL IX1194.2 +042600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1194.2 +042700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1194.2 +042800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1194.2 +042900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1194.2 +043000 D-WRITE-LINE. IX1194.2 +043100 ADD 1 TO RECORD-COUNT. IX1194.2 +043200 IF RECORD-COUNT GREATER 42 IX1194.2 +043300 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1194.2 +043400 MOVE SPACE TO DUMMY-RECORD IX1194.2 +043500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1194.2 +043600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1194.2 +043700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1194.2 +043800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1194.2 +043900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1194.2 +044000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1194.2 +044100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1194.2 +044200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1194.2 +044300 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1194.2 +044400 MOVE ZERO TO RECORD-COUNT. IX1194.2 +044500 PERFORM D-WRT-LN. IX1194.2 +044600 D-WRT-LN. IX1194.2 +044700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1194.2 +044800 MOVE SPACE TO DUMMY-RECORD. IX1194.2 +044900 D-FAIL-ROUTINE. IX1194.2 +045000 IF COMPUTED-X NOT EQUAL TO SPACE IX1194.2 +045100 GO TO D-FAIL-ROUTINE-WRITE. IX1194.2 +045200 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1194.2 +045300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1194.2 +045400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1194.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1194.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1194.2 +045700 GO TO D-FAIL-ROUTINE-EX. IX1194.2 +045800 D-FAIL-ROUTINE-WRITE. IX1194.2 +045900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1194.2 +046000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1194.2 +046100 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1194.2 +046200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1194.2 +046300 D-FAIL-ROUTINE-EX. EXIT. IX1194.2 +046400 D-BAIL-OUT. IX1194.2 +046500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1194.2 +046600 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1194.2 +046700 D-BAIL-OUT-WRITE. IX1194.2 +046800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1194.2 +046900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1194.2 +047000 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1194.2 +047100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1194.2 +047200 D-BAIL-OUT-EX. EXIT. IX1194.2 +047300 DECL-EXIT. EXIT. IX1194.2 +047400 END DECLARATIVES. IX1194.2 +047500 IX1194.2 +047600 IX1194.2 +047700 CCVS1 SECTION. IX1194.2 +047800 OPEN-FILES. IX1194.2 +047900*P OPEN I-O RAW-DATA. IX1194.2 +048000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1194.2 +048100*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1194.2 +048200*P MOVE "ABORTED " TO C-ABORT. IX1194.2 +048300*P ADD 1 TO C-NO-OF-TESTS. IX1194.2 +048400*P ACCEPT C-DATE FROM DATE. IX1194.2 +048500*P ACCEPT C-TIME FROM TIME. IX1194.2 +048600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1194.2 +048700*PND-E-1. IX1194.2 +048800*P CLOSE RAW-DATA. IX1194.2 +048900 OPEN OUTPUT PRINT-FILE. IX1194.2 +049000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1194.2 +049100 MOVE SPACE TO TEST-RESULTS. IX1194.2 +049200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1194.2 +049300 MOVE ZERO TO REC-SKL-SUB. IX1194.2 +049400 PERFORM CCVS-INIT-FILE 9 TIMES. IX1194.2 +049500 CCVS-INIT-FILE. IX1194.2 +049600 ADD 1 TO REC-SKL-SUB. IX1194.2 +049700 MOVE FILE-RECORD-INFO-SKELETON IX1194.2 +049800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1194.2 +049900 CCVS-INIT-EXIT. IX1194.2 +050000 GO TO CCVS1-EXIT. IX1194.2 +050100 CLOSE-FILES. IX1194.2 +050200*P OPEN I-O RAW-DATA. IX1194.2 +050300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1194.2 +050400*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1194.2 +050500*P MOVE "OK. " TO C-ABORT. IX1194.2 +050600*P MOVE PASS-COUNTER TO C-OK. IX1194.2 +050700*P MOVE ERROR-HOLD TO C-ALL. IX1194.2 +050800*P MOVE ERROR-COUNTER TO C-FAIL. IX1194.2 +050900*P MOVE DELETE-COUNTER TO C-DELETED. IX1194.2 +051000*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1194.2 +051100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1194.2 +051200*PND-E-2. IX1194.2 +051300*P CLOSE RAW-DATA. IX1194.2 +051400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1194.2 +051500 TERMINATE-CCVS. IX1194.2 +051600*S EXIT PROGRAM. IX1194.2 +051700*SERMINATE-CALL. IX1194.2 +051800 STOP RUN. IX1194.2 +051900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1194.2 +052000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1194.2 +052100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1194.2 +052200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1194.2 +052300 MOVE "****TEST DELETED****" TO RE-MARK. IX1194.2 +052400 PRINT-DETAIL. IX1194.2 +052500 IF REC-CT NOT EQUAL TO ZERO IX1194.2 +052600 MOVE "." TO PARDOT-X IX1194.2 +052700 MOVE REC-CT TO DOTVALUE. IX1194.2 +052800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1194.2 +052900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1194.2 +053000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1194.2 +053100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1194.2 +053200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1194.2 +053300 MOVE SPACE TO CORRECT-X. IX1194.2 +053400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1194.2 +053500 MOVE SPACE TO RE-MARK. IX1194.2 +053600 HEAD-ROUTINE. IX1194.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1194.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1194.2 +054100 COLUMN-NAMES-ROUTINE. IX1194.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +054500 END-ROUTINE. IX1194.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1194.2 +054700 END-RTN-EXIT. IX1194.2 +054800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +054900 END-ROUTINE-1. IX1194.2 +055000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1194.2 +055100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1194.2 +055200 ADD PASS-COUNTER TO ERROR-HOLD. IX1194.2 +055300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1194.2 +055400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1194.2 +055500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1194.2 +055600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1194.2 +055700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1194.2 +055800 END-ROUTINE-12. IX1194.2 +055900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1194.2 +056000 IF ERROR-COUNTER IS EQUAL TO ZERO IX1194.2 +056100 MOVE "NO " TO ERROR-TOTAL IX1194.2 +056200 ELSE IX1194.2 +056300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1194.2 +056400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1194.2 +056500 PERFORM WRITE-LINE. IX1194.2 +056600 END-ROUTINE-13. IX1194.2 +056700 IF DELETE-COUNTER IS EQUAL TO ZERO IX1194.2 +056800 MOVE "NO " TO ERROR-TOTAL ELSE IX1194.2 +056900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1194.2 +057000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1194.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +057200 IF INSPECT-COUNTER EQUAL TO ZERO IX1194.2 +057300 MOVE "NO " TO ERROR-TOTAL IX1194.2 +057400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1194.2 +057500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1194.2 +057600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +057700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1194.2 +057800 WRITE-LINE. IX1194.2 +057900 ADD 1 TO RECORD-COUNT. IX1194.2 +058000 IF RECORD-COUNT GREATER 42 IX1194.2 +058100 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1194.2 +058200 MOVE SPACE TO DUMMY-RECORD IX1194.2 +058300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1194.2 +058400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1194.2 +058500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1194.2 +058600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1194.2 +058700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1194.2 +058800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1194.2 +058900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1194.2 +059000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1194.2 +059100 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1194.2 +059200 MOVE ZERO TO RECORD-COUNT. IX1194.2 +059300 PERFORM WRT-LN. IX1194.2 +059400 WRT-LN. IX1194.2 +059500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1194.2 +059600 MOVE SPACE TO DUMMY-RECORD. IX1194.2 +059700 BLANK-LINE-PRINT. IX1194.2 +059800 PERFORM WRT-LN. IX1194.2 +059900 FAIL-ROUTINE. IX1194.2 +060000 IF COMPUTED-X NOT EQUAL TO SPACE IX1194.2 +060100 GO TO FAIL-ROUTINE-WRITE. IX1194.2 +060200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1194.2 +060300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1194.2 +060400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1194.2 +060500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +060600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1194.2 +060700 GO TO FAIL-ROUTINE-EX. IX1194.2 +060800 FAIL-ROUTINE-WRITE. IX1194.2 +060900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1194.2 +061000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1194.2 +061100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1194.2 +061200 MOVE SPACES TO COR-ANSI-REFERENCE. IX1194.2 +061300 FAIL-ROUTINE-EX. EXIT. IX1194.2 +061400 BAIL-OUT. IX1194.2 +061500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1194.2 +061600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1194.2 +061700 BAIL-OUT-WRITE. IX1194.2 +061800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1194.2 +061900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1194.2 +062000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1194.2 +062100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1194.2 +062200 BAIL-OUT-EX. EXIT. IX1194.2 +062300 CCVS1-EXIT. IX1194.2 +062400 EXIT. IX1194.2 +062500 IX1194.2 +062600 SECT-IX119A-0003 SECTION. IX1194.2 +062700 SEQ-INIT-010. IX1194.2 +062800 MOVE ZERO TO TEST-NO. IX1194.2 +062900 MOVE "IX-FS3" TO XFILE-NAME (1). IX1194.2 +063000 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1194.2 +063100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1194.2 +063200 MOVE 000240 TO XRECORD-LENGTH (1). IX1194.2 +063300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1194.2 +063400 MOVE 0002 TO XBLOCK-SIZE (1). IX1194.2 +063500 MOVE 000050 TO RECORDS-IN-FILE (1). IX1194.2 +063600 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1194.2 +063700 MOVE "S" TO XLABEL-TYPE (1). IX1194.2 +063800 MOVE 000001 TO XRECORD-NUMBER (1). IX1194.2 +063900 MOVE 0 TO COUNT-OF-RECS. IX1194.2 +064000 IX1194.2 +064100******************************************************************IX1194.2 +064200* TEST 1 *IX1194.2 +064300* OPEN OUTPUT ... 00 EXPECTED *IX1194.2 +064400* IX-3, 1.3.4 (1) A *IX1194.2 +064500* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1194.2 +064600* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1194.2 +064700******************************************************************IX1194.2 +064800 OPN-INIT-GF-01-0. IX1194.2 +064900 MOVE 1 TO STATUS-TEST-00. IX1194.2 +065000 MOVE SPACES TO IX-FS3-STATUS. IX1194.2 +065100 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1194.2 +065200 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1194.2 +065300 OPEN IX1194.2 +065400 I-O IX-FS3. IX1194.2 +065500 IF IX-FS3-STATUS EQUAL TO "00" IX1194.2 +065600 GO TO OPN-PASS-GF-01-0. IX1194.2 +065700 OPN-FAIL-GF-01-0. IX1194.2 +065800 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1194.2 +065900 PERFORM FAIL. IX1194.2 +066000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1194.2 +066100 MOVE "00" TO CORRECT-X. IX1194.2 +066200 GO TO OPN-WRITE-GF-01-0. IX1194.2 +066300 OPN-PASS-GF-01-0. IX1194.2 +066400 PERFORM PASS. IX1194.2 +066500 OPN-WRITE-GF-01-0. IX1194.2 +066600 PERFORM PRINT-DETAIL. IX1194.2 +066700******************************************************************IX1194.2 +066800* TEST 4 *IX1194.2 +066900* REWRITE PRIME RECORD SHOULD BE CHANGED 21 OR 22 EXPECTED IX1194.2 +067000* IX-3, 1.3.4 (3) A *IX1194.2 +067100******************************************************************IX1194.2 +067200 RWR-INIT-GF-01-0. IX1194.2 +067300 MOVE SPACES TO IX-FS3-STATUS. IX1194.2 +067400 MOVE 0 TO STATUS-TEST-00. IX1194.2 +067500 MOVE "REWRITE: 21/22 EXP." TO FEATURE. IX1194.2 +067600 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1194.2 +067700 READ IX-FS3 AT END MOVE 0 TO IX-FS3-KEY. IX1194.2 +067800 MOVE 9 TO XRECORD-NUMBER (1). IX1194.2 +067900 RWR-TEST-GF-01-0. IX1194.2 +068000 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1194.2 +068100 MOVE GRP-0101 TO XRECORD-KEY (1). IX1194.2 +068200 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1194.2 +068300 MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1194.2 +068400 REWRITE IX-FS3R1-F-G-240 INVALID KEY GO TO RWR-TEST-GF-01-1. IX1194.2 +068500 RWR-TEST-GF-01-1. IX1194.2 +068600 IF IX-FS3-STATUS = "21" IX1194.2 +068700 GO TO RWR-PASS-GF-01-0. IX1194.2 +068800 IF IX-FS3-STATUS = "22" IX1194.2 +068900 GO TO RWR-PASS-GF-01-0. IX1194.2 +069000 RWR-FAIL-GF-01-0. IX1194.2 +069100 MOVE "IX-3, 1.3.4, (3) A. " TO RE-MARK. IX1194.2 +069200 PERFORM FAIL. IX1194.2 +069300 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1194.2 +069400 MOVE "21" TO CORRECT-X. IX1194.2 +069500 GO TO RWR-WRITE-GF-01-0. IX1194.2 +069600 RWR-PASS-GF-01-0. IX1194.2 +069700 PERFORM PASS. IX1194.2 +069800 RWR-WRITE-GF-01-0. IX1194.2 +069900 PERFORM PRINT-DETAIL. IX1194.2 +070000 IX1194.2 +070100******************************************************************IX1194.2 +070200* TEST 5 *IX1194.2 +070300* DELETE.... STATUS 43 EXPECTED IX1194.2 +070400* IX-5, 1.3.4 (5) C IX1194.2 +070500******************************************************************IX1194.2 +070600 DEL-TEST-GF-01-0. IX1194.2 +070700 MOVE 5 TO TEST-NO. IX1194.2 +070800 MOVE SPACES TO IX-FS3-STATUS. IX1194.2 +070900 MOVE "DELETE 43 EXP." TO FEATURE IX1194.2 +071000 MOVE "DEL-TEST-GF-01-0" TO PAR-NAME. IX1194.2 +071100 DELETE IX-FS3 RECORD. IX1194.2 +071200 DEL-TEST-GF-01-1. IX1194.2 +071300 IF IX-FS3-STATUS EQUAL TO "43" IX1194.2 +071400 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1194.2 +071500 TO RE-MARK IX1194.2 +071600 GO TO DEL-WRITE-GF-01-0. IX1194.2 +071700 DEL-FAIL-GF-01-0. IX1194.2 +071800 MOVE "IX-5, 1.3.4, (5) C" TO RE-MARK. IX1194.2 +071900 DEL-WRITE-GF-01-0. IX1194.2 +072000 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1194.2 +072100 MOVE "43" TO CORRECT-X. IX1194.2 +072200 PERFORM FAIL. IX1194.2 +072300 PERFORM PRINT-DETAIL. IX1194.2 +072400 CLOSE IX-FS3. IX1194.2 +072500 IX1194.2 +072600 TERMINATE-ROUTINE. IX1194.2 +072700 EXIT. IX1194.2 +072800 IX1194.2 +072900 CCVS-EXIT SECTION. IX1194.2 +073000 CCVS-999999. IX1194.2 +073100 GO TO CLOSE-FILES. IX1194.2 diff --git a/tests/cobol85/IX/IX120A.SUB b/tests/cobol85/IX/IX120A.SUB new file mode 100755 index 00000000..7859e26f --- /dev/null +++ b/tests/cobol85/IX/IX120A.SUB @@ -0,0 +1,705 @@ +000100 IDENTIFICATION DIVISION. IX1204.2 +000200 PROGRAM-ID. IX1204.2 +000300 IX120A. IX1204.2 +000400**************************************************************** IX1204.2 +000500* * IX1204.2 +000600* VALIDATION FOR:- * IX1204.2 +000700* * IX1204.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1204.2 +000900* * IX1204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1204.2 +001100* * IX1204.2 +001200**************************************************************** IX1204.2 +001300* IX1204.2 +001400* THIS ROUTINE USES THE MASS STORAGE FILE IX-FS3 CREATED IN IX1204.2 +001500* IX113A. IX1204.2 +001600* THE FILE IS OPENED I-O AND THE STATUS CHECKED (00 EXPECTED), IX1204.2 +001700* THE FILE IS THEN READ UNTIL THE AT END CONDITION IS REACHED IX1204.2 +001800* AND THEN READ ONCE MORE. AN ATTEMPT IS THEN MADE TO REWRITE IX1204.2 +001900* A RECORD, AT WHICH POINT THE DECLARATIVES IX1204.2 +002000* SHOULD BE ACTIONED AND THE FILE STATUS SHOULD BE 43 . IX1204.2 +002100* IX1204.2 +002200* STANDARD REFERENCE IX-5, 1.3.4 (5) C IX1204.2 +002300* IX1204.2 +002400* X-CARDS USED IN THIS PROGRAM: IX1204.2 +002500* IX1204.2 +002600* XXXXX024 IX1204.2 +002700* XXXXX055. IX1204.2 +002800* P XXXXX062. IX1204.2 +002900* XXXXX082. IX1204.2 +003000* XXXXX083. IX1204.2 +003100* C XXXXX084 IX1204.2 +003200* IX1204.2 +003300* IX1204.2 +003400 ENVIRONMENT DIVISION. IX1204.2 +003500 CONFIGURATION SECTION. IX1204.2 +003600 SOURCE-COMPUTER. IX1204.2 +003700 Linux. IX1204.2 +003800 OBJECT-COMPUTER. IX1204.2 +003900 Linux. IX1204.2 +004000 INPUT-OUTPUT SECTION. IX1204.2 +004100 FILE-CONTROL. IX1204.2 +004200*P SELECT RAW-DATA ASSIGN TO IX1204.2 +004300*P "XXXXX062" IX1204.2 +004400*P ORGANIZATION IS INDEXED IX1204.2 +004500*P ACCESS MODE IS RANDOM IX1204.2 +004600*P RECORD KEY IS RAW-DATA-KEY. IX1204.2 +004700* IX1204.2 +004800 SELECT PRINT-FILE ASSIGN TO IX1204.2 +004900 "report.log". IX1204.2 +005000* IX1204.2 +005100 SELECT IX-FS3 ASSIGN IX1204.2 +005200 "XXXXX024" IX1204.2 +005300 ORGANIZATION IS INDEXED IX1204.2 +005400 ACCESS MODE IS SEQUENTIAL IX1204.2 +005500 RECORD KEY IS IX-FS3-KEY IX1204.2 +005600 FILE STATUS IS IX-FS3-STATUS. IX1204.2 +005700 IX1204.2 +005800 DATA DIVISION. IX1204.2 +005900 IX1204.2 +006000 FILE SECTION. IX1204.2 +006100*P IX1204.2 +006200*PD RAW-DATA. IX1204.2 +006300*P IX1204.2 +006400*P1 RAW-DATA-SATZ. IX1204.2 +006500*P 05 RAW-DATA-KEY PIC X(6). IX1204.2 +006600*P 05 C-DATE PIC 9(6). IX1204.2 +006700*P 05 C-TIME PIC 9(8). IX1204.2 +006800*P 05 C-NO-OF-TESTS PIC 99. IX1204.2 +006900*P 05 C-OK PIC 999. IX1204.2 +007000*P 05 C-ALL PIC 999. IX1204.2 +007100*P 05 C-FAIL PIC 999. IX1204.2 +007200*P 05 C-DELETED PIC 999. IX1204.2 +007300*P 05 C-INSPECT PIC 999. IX1204.2 +007400*P 05 C-NOTE PIC X(13). IX1204.2 +007500*P 05 C-INDENT PIC X. IX1204.2 +007600*P 05 C-ABORT PIC X(8). IX1204.2 +007700 IX1204.2 +007800 FD PRINT-FILE. IX1204.2 +007900 IX1204.2 +008000 01 PRINT-REC PIC X(120). IX1204.2 +008100 IX1204.2 +008200 01 DUMMY-RECORD PIC X(120). IX1204.2 +008300 IX1204.2 +008400 FD IX-FS3 IX1204.2 +008500*C DATA RECORDS IX-FS3R1-F-G-240 IX1204.2 +008600*C LABEL RECORD STANDARD IX1204.2 +008700 RECORD 240 IX1204.2 +008800 BLOCK CONTAINS 2 RECORDS. IX1204.2 +008900 IX1204.2 +009000 01 IX-FS3R1-F-G-240. IX1204.2 +009100 05 IX-FS3-REC-120 PIC X(120). IX1204.2 +009200 05 IX-FS3-REC-120-240. IX1204.2 +009300 10 FILLER PIC X(8). IX1204.2 +009400 10 IX-FS3-KEY PIC X(29). IX1204.2 +009500 10 FILLER PIC X(9). IX1204.2 +009600 10 IX-FS3-ALTER-KEY PIC X(29). IX1204.2 +009700 10 FILLER PIC X(45). IX1204.2 +009800 IX1204.2 +009900 IX1204.2 +010000 WORKING-STORAGE SECTION. IX1204.2 +010100 IX1204.2 +010200 01 GRP-0101. IX1204.2 +010300 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1204.2 +010400 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1204.2 +010500 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1204.2 +010600 IX1204.2 +010700 01 GRP-0102. IX1204.2 +010800 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1204.2 +010900 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1204.2 +011000 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1204.2 +011100 IX1204.2 +011200 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1204.2 +011300 IX1204.2 +011400 01 EOF-FLAG PIC 9 VALUE ZERO. IX1204.2 +011500 IX1204.2 +011600 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1204.2 +011700 IX1204.2 +011800 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1204.2 +011900 IX1204.2 +012000 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1204.2 +012100 IX1204.2 +012200 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1204.2 +012300 IX1204.2 +012400 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1204.2 +012500 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1204.2 +012600 IX1204.2 +012700 01 IX-FS3-STATUS. IX1204.2 +012800 05 IX-FS3-STAT1 PIC X. IX1204.2 +012900 05 IX-FS3-STAT2 PIC X. IX1204.2 +013000 IX1204.2 +013100 01 COUNT-OF-RECS PIC 9(5). IX1204.2 +013200 IX1204.2 +013300 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1204.2 +013400 IX1204.2 +013500 01 FILE-RECORD-INFORMATION-REC. IX1204.2 +013600 05 FILE-RECORD-INFO-SKELETON. IX1204.2 +013700 10 FILLER PIC X(48) VALUE IX1204.2 +013800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1204.2 +013900 10 FILLER PIC X(46) VALUE IX1204.2 +014000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1204.2 +014100 10 FILLER PIC X(26) VALUE IX1204.2 +014200 ",LFIL=000000,ORG= ,LBLR= ". IX1204.2 +014300 10 FILLER PIC X(37) VALUE IX1204.2 +014400 ",RECKEY= ". IX1204.2 +014500 10 FILLER PIC X(38) VALUE IX1204.2 +014600 ",ALTKEY1= ". IX1204.2 +014700 10 FILLER PIC X(38) VALUE IX1204.2 +014800 ",ALTKEY2= ". IX1204.2 +014900 10 FILLER PIC X(7) VALUE SPACE. IX1204.2 +015000 05 FILE-RECORD-INFO OCCURS 10. IX1204.2 +015100 10 FILE-RECORD-INFO-P1-120. IX1204.2 +015200 15 FILLER PIC X(5). IX1204.2 +015300 15 XFILE-NAME PIC X(6). IX1204.2 +015400 15 FILLER PIC X(8). IX1204.2 +015500 15 XRECORD-NAME PIC X(6). IX1204.2 +015600 15 FILLER PIC X(1). IX1204.2 +015700 15 REELUNIT-NUMBER PIC 9(1). IX1204.2 +015800 15 FILLER PIC X(7). IX1204.2 +015900 15 XRECORD-NUMBER PIC 9(6). IX1204.2 +016000 15 FILLER PIC X(6). IX1204.2 +016100 15 UPDATE-NUMBER PIC 9(2). IX1204.2 +016200 15 FILLER PIC X(5). IX1204.2 +016300 15 ODO-NUMBER PIC 9(4). IX1204.2 +016400 15 FILLER PIC X(5). IX1204.2 +016500 15 XPROGRAM-NAME PIC X(5). IX1204.2 +016600 15 FILLER PIC X(7). IX1204.2 +016700 15 XRECORD-LENGTH PIC 9(6). IX1204.2 +016800 15 FILLER PIC X(7). IX1204.2 +016900 15 CHARS-OR-RECORDS PIC X(2). IX1204.2 +017000 15 FILLER PIC X(1). IX1204.2 +017100 15 XBLOCK-SIZE PIC 9(4). IX1204.2 +017200 15 FILLER PIC X(6). IX1204.2 +017300 15 RECORDS-IN-FILE PIC 9(6). IX1204.2 +017400 15 FILLER PIC X(5). IX1204.2 +017500 15 XFILE-ORGANIZATION PIC X(2). IX1204.2 +017600 15 FILLER PIC X(6). IX1204.2 +017700 15 XLABEL-TYPE PIC X(1). IX1204.2 +017800 10 FILE-RECORD-INFO-P121-240. IX1204.2 +017900 15 FILLER PIC X(8). IX1204.2 +018000 15 XRECORD-KEY PIC X(29). IX1204.2 +018100 15 FILLER PIC X(9). IX1204.2 +018200 15 ALTERNATE-KEY1 PIC X(29). IX1204.2 +018300 15 FILLER PIC X(9). IX1204.2 +018400 15 ALTERNATE-KEY2 PIC X(29). IX1204.2 +018500 15 FILLER PIC X(7). IX1204.2 +018600 IX1204.2 +018700 01 TEST-RESULTS. IX1204.2 +018800 02 FILLER PIC X VALUE SPACE. IX1204.2 +018900 02 FEATURE PIC X(20) VALUE SPACE. IX1204.2 +019000 02 FILLER PIC X VALUE SPACE. IX1204.2 +019100 02 P-OR-F PIC X(5) VALUE SPACE. IX1204.2 +019200 02 FILLER PIC X VALUE SPACE. IX1204.2 +019300 02 PAR-NAME. IX1204.2 +019400 03 FILLER PIC X(19) VALUE SPACE. IX1204.2 +019500 03 PARDOT-X PIC X VALUE SPACE. IX1204.2 +019600 03 DOTVALUE PIC 99 VALUE ZERO. IX1204.2 +019700 02 FILLER PIC X(8) VALUE SPACE. IX1204.2 +019800 02 RE-MARK PIC X(61). IX1204.2 +019900 01 TEST-COMPUTED. IX1204.2 +020000 02 FILLER PIC X(30) VALUE SPACE. IX1204.2 +020100 02 FILLER PIC X(17) VALUE IX1204.2 +020200 " COMPUTED=". IX1204.2 +020300 02 COMPUTED-X. IX1204.2 +020400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1204.2 +020500 03 COMPUTED-N REDEFINES COMPUTED-A IX1204.2 +020600 PIC -9(9).9(9). IX1204.2 +020700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1204.2 +020800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1204.2 +020900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1204.2 +021000 03 CM-18V0 REDEFINES COMPUTED-A. IX1204.2 +021100 04 COMPUTED-18V0 PIC -9(18). IX1204.2 +021200 04 FILLER PIC X. IX1204.2 +021300 03 FILLER PIC X(50) VALUE SPACE. IX1204.2 +021400 01 TEST-CORRECT. IX1204.2 +021500 02 FILLER PIC X(30) VALUE SPACE. IX1204.2 +021600 02 FILLER PIC X(17) VALUE " CORRECT =". IX1204.2 +021700 02 CORRECT-X. IX1204.2 +021800 03 CORRECT-A PIC X(20) VALUE SPACE. IX1204.2 +021900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1204.2 +022000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1204.2 +022100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1204.2 +022200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1204.2 +022300 03 CR-18V0 REDEFINES CORRECT-A. IX1204.2 +022400 04 CORRECT-18V0 PIC -9(18). IX1204.2 +022500 04 FILLER PIC X. IX1204.2 +022600 03 FILLER PIC X(2) VALUE SPACE. IX1204.2 +022700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1204.2 +022800 01 CCVS-C-1. IX1204.2 +022900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1204.2 +023000- "SS PARAGRAPH-NAME IX1204.2 +023100- " REMARKS". IX1204.2 +023200 02 FILLER PIC X(20) VALUE SPACE. IX1204.2 +023300 01 CCVS-C-2. IX1204.2 +023400 02 FILLER PIC X VALUE SPACE. IX1204.2 +023500 02 FILLER PIC X(6) VALUE "TESTED". IX1204.2 +023600 02 FILLER PIC X(15) VALUE SPACE. IX1204.2 +023700 02 FILLER PIC X(4) VALUE "FAIL". IX1204.2 +023800 02 FILLER PIC X(94) VALUE SPACE. IX1204.2 +023900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1204.2 +024000 01 REC-CT PIC 99 VALUE ZERO. IX1204.2 +024100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1204.2 +024200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1204.2 +024300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1204.2 +024400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1204.2 +024500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1204.2 +024600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1204.2 +024700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1204.2 +024800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1204.2 +024900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1204.2 +025000 01 CCVS-H-1. IX1204.2 +025100 02 FILLER PIC X(39) VALUE SPACES. IX1204.2 +025200 02 FILLER PIC X(42) VALUE IX1204.2 +025300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1204.2 +025400 02 FILLER PIC X(39) VALUE SPACES. IX1204.2 +025500 01 CCVS-H-2A. IX1204.2 +025600 02 FILLER PIC X(40) VALUE SPACE. IX1204.2 +025700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1204.2 +025800 02 FILLER PIC XXXX VALUE IX1204.2 +025900 "4.2 ". IX1204.2 +026000 02 FILLER PIC X(28) VALUE IX1204.2 +026100 " COPY - NOT FOR DISTRIBUTION". IX1204.2 +026200 02 FILLER PIC X(41) VALUE SPACE. IX1204.2 +026300 IX1204.2 +026400 01 CCVS-H-2B. IX1204.2 +026500 02 FILLER PIC X(15) VALUE IX1204.2 +026600 "TEST RESULT OF ". IX1204.2 +026700 02 TEST-ID PIC X(9). IX1204.2 +026800 02 FILLER PIC X(4) VALUE IX1204.2 +026900 " IN ". IX1204.2 +027000 02 FILLER PIC X(12) VALUE IX1204.2 +027100 " HIGH ". IX1204.2 +027200 02 FILLER PIC X(22) VALUE IX1204.2 +027300 " LEVEL VALIDATION FOR ". IX1204.2 +027400 02 FILLER PIC X(58) VALUE IX1204.2 +027500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1204.2 +027600 01 CCVS-H-3. IX1204.2 +027700 02 FILLER PIC X(34) VALUE IX1204.2 +027800 " FOR OFFICIAL USE ONLY ". IX1204.2 +027900 02 FILLER PIC X(58) VALUE IX1204.2 +028000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1204.2 +028100 02 FILLER PIC X(28) VALUE IX1204.2 +028200 " COPYRIGHT 1985 ". IX1204.2 +028300 01 CCVS-E-1. IX1204.2 +028400 02 FILLER PIC X(52) VALUE SPACE. IX1204.2 +028500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1204.2 +028600 02 ID-AGAIN PIC X(9). IX1204.2 +028700 02 FILLER PIC X(45) VALUE SPACES. IX1204.2 +028800 01 CCVS-E-2. IX1204.2 +028900 02 FILLER PIC X(31) VALUE SPACE. IX1204.2 +029000 02 FILLER PIC X(21) VALUE SPACE. IX1204.2 +029100 02 CCVS-E-2-2. IX1204.2 +029200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1204.2 +029300 03 FILLER PIC X VALUE SPACE. IX1204.2 +029400 03 ENDER-DESC PIC X(44) VALUE IX1204.2 +029500 "ERRORS ENCOUNTERED". IX1204.2 +029600 01 CCVS-E-3. IX1204.2 +029700 02 FILLER PIC X(22) VALUE IX1204.2 +029800 " FOR OFFICIAL USE ONLY". IX1204.2 +029900 02 FILLER PIC X(12) VALUE SPACE. IX1204.2 +030000 02 FILLER PIC X(58) VALUE IX1204.2 +030100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1204.2 +030200 02 FILLER PIC X(13) VALUE SPACE. IX1204.2 +030300 02 FILLER PIC X(15) VALUE IX1204.2 +030400 " COPYRIGHT 1985". IX1204.2 +030500 01 CCVS-E-4. IX1204.2 +030600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1204.2 +030700 02 FILLER PIC X(4) VALUE " OF ". IX1204.2 +030800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1204.2 +030900 02 FILLER PIC X(40) VALUE IX1204.2 +031000 " TESTS WERE EXECUTED SUCCESSFULLY". IX1204.2 +031100 01 XXINFO. IX1204.2 +031200 02 FILLER PIC X(19) VALUE IX1204.2 +031300 "*** INFORMATION ***". IX1204.2 +031400 02 INFO-TEXT. IX1204.2 +031500 04 FILLER PIC X(8) VALUE SPACE. IX1204.2 +031600 04 XXCOMPUTED PIC X(20). IX1204.2 +031700 04 FILLER PIC X(5) VALUE SPACE. IX1204.2 +031800 04 XXCORRECT PIC X(20). IX1204.2 +031900 02 INF-ANSI-REFERENCE PIC X(48). IX1204.2 +032000 01 HYPHEN-LINE. IX1204.2 +032100 02 FILLER PIC IS X VALUE IS SPACE. IX1204.2 +032200 02 FILLER PIC IS X(65) VALUE IS "************************IX1204.2 +032300- "*****************************************". IX1204.2 +032400 02 FILLER PIC IS X(54) VALUE IS "************************IX1204.2 +032500- "******************************". IX1204.2 +032600 01 TEST-NO PIC 99. IX1204.2 +032700 01 CCVS-PGM-ID PIC X(9) VALUE IX1204.2 +032800 "IX120A". IX1204.2 +032900 PROCEDURE DIVISION. IX1204.2 +033000 DECLARATIVES. IX1204.2 +033100 IX1204.2 +033200 SECT-IX105-0002 SECTION. IX1204.2 +033300 USE AFTER EXCEPTION PROCEDURE ON IX-FS3. IX1204.2 +033400 INPUT-PROCESS. IX1204.2 +033500 IF TEST-NO = 5 IX1204.2 +033600 GO TO D-C-TEST-GF-01-1. IX1204.2 +033700 IF STATUS-TEST-10 EQUAL TO 1 IX1204.2 +033800 IF IX-FS3-STAT1 EQUAL TO "1" IX1204.2 +033900 MOVE 1 TO EOF-FLAG IX1204.2 +034000 ELSE IX1204.2 +034100 IF IX-FS3-STAT1 GREATER THAN "1" IX1204.2 +034200 MOVE 1 TO PERM-ERRORS. IX1204.2 +034300 GO TO DECL-EXIT. IX1204.2 +034400 D-C-TEST-GF-01-1. IX1204.2 +034500 IF IX-FS3-STATUS EQUAL TO "43" IX1204.2 +034600 GO TO D-C-PASS-GF-01-0. IX1204.2 +034700 D-C-FAIL-GF-01-0. IX1204.2 +034800 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1204.2 +034900 MOVE "43" TO CORRECT-X. IX1204.2 +035000 MOVE "IX-5, 1.3.4, (5) C" TO RE-MARK. IX1204.2 +035100 PERFORM D-FAIL. IX1204.2 +035200 GO TO D-C-WRITE-GF-01-0. IX1204.2 +035300 D-C-PASS-GF-01-0. IX1204.2 +035400 PERFORM D-PASS. IX1204.2 +035500 D-C-WRITE-GF-01-0. IX1204.2 +035600 PERFORM D-PRINT-DETAIL. IX1204.2 +035700 D-CLOSE-FILES. IX1204.2 +035800 CLOSE IX-FS3. IX1204.2 +035900*P OPEN I-O RAW-DATA. IX1204.2 +036000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1204.2 +036100*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1204.2 +036200*P MOVE "OK. " TO C-ABORT. IX1204.2 +036300*P MOVE PASS-COUNTER TO C-OK. IX1204.2 +036400*P MOVE ERROR-HOLD TO C-ALL. IX1204.2 +036500*P MOVE ERROR-COUNTER TO C-FAIL. IX1204.2 +036600*P MOVE DELETE-COUNTER TO C-DELETED. IX1204.2 +036700*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1204.2 +036800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1204.2 +036900*P-END-E-2. IX1204.2 +037000*P CLOSE RAW-DATA. IX1204.2 +037100 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1204.2 +037200 CLOSE PRINT-FILE. IX1204.2 +037300 D-TERMINATE-CCVS. IX1204.2 +037400*S EXIT PROGRAM. IX1204.2 +037500*S-TERMINATE-CALL. IX1204.2 +037600 STOP RUN. IX1204.2 +037700 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1204.2 +037800 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1204.2 +037900 D-PRINT-DETAIL. IX1204.2 +038000 IF REC-CT NOT EQUAL TO ZERO IX1204.2 +038100 MOVE "." TO PARDOT-X IX1204.2 +038200 MOVE REC-CT TO DOTVALUE. IX1204.2 +038300 MOVE TEST-RESULTS TO PRINT-REC. IX1204.2 +038400 PERFORM D-WRITE-LINE. IX1204.2 +038500 IF P-OR-F EQUAL TO "FAIL*" IX1204.2 +038600 PERFORM D-WRITE-LINE IX1204.2 +038700 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1204.2 +038800 ELSE IX1204.2 +038900 PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1204.2 +039000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1204.2 +039100 MOVE SPACE TO CORRECT-X. IX1204.2 +039200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1204.2 +039300 MOVE SPACE TO RE-MARK. IX1204.2 +039400 D-END-ROUTINE. IX1204.2 +039500 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1204.2 +039600 PERFORM D-WRITE-LINE 5 TIMES. IX1204.2 +039700 D-END-RTN-EXIT. IX1204.2 +039800 MOVE CCVS-E-1 TO DUMMY-RECORD. IX1204.2 +039900 PERFORM D-WRITE-LINE 2 TIMES. IX1204.2 +040000 D-END-ROUTINE-1. IX1204.2 +040100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1204.2 +040200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1204.2 +040300 ADD PASS-COUNTER TO ERROR-HOLD. IX1204.2 +040400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1204.2 +040500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1204.2 +040600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1204.2 +040700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1204.2 +040800 D-END-ROUTINE-12. IX1204.2 +040900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1204.2 +041000 IF ERROR-COUNTER IS EQUAL TO ZERO IX1204.2 +041100 MOVE "NO " TO ERROR-TOTAL IX1204.2 +041200 ELSE IX1204.2 +041300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1204.2 +041400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1204.2 +041500 PERFORM D-WRITE-LINE. IX1204.2 +041600 D-END-ROUTINE-13. IX1204.2 +041700 IF DELETE-COUNTER IS EQUAL TO ZERO IX1204.2 +041800 MOVE "NO " TO ERROR-TOTAL ELSE IX1204.2 +041900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1204.2 +042000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1204.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1204.2 +042200 PERFORM D-WRITE-LINE. IX1204.2 +042300 IF INSPECT-COUNTER EQUAL TO ZERO IX1204.2 +042400 MOVE "NO " TO ERROR-TOTAL IX1204.2 +042500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1204.2 +042600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1204.2 +042700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1204.2 +042800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1204.2 +042900 D-WRITE-LINE. IX1204.2 +043000 ADD 1 TO RECORD-COUNT. IX1204.2 +043100 IF RECORD-COUNT GREATER 42 IX1204.2 +043200 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1204.2 +043300 MOVE SPACE TO DUMMY-RECORD IX1204.2 +043400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1204.2 +043500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1204.2 +043600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1204.2 +043700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1204.2 +043800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1204.2 +043900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1204.2 +044000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1204.2 +044100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1204.2 +044200 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1204.2 +044300 MOVE ZERO TO RECORD-COUNT. IX1204.2 +044400 PERFORM D-WRT-LN. IX1204.2 +044500 D-WRT-LN. IX1204.2 +044600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1204.2 +044700 MOVE SPACE TO DUMMY-RECORD. IX1204.2 +044800 D-FAIL-ROUTINE. IX1204.2 +044900 IF COMPUTED-X NOT EQUAL TO SPACE IX1204.2 +045000 GO TO D-FAIL-ROUTINE-WRITE. IX1204.2 +045100 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE.IX1204.2 +045200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1204.2 +045300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1204.2 +045400 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1204.2 +045500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1204.2 +045600 GO TO D-FAIL-ROUTINE-EX. IX1204.2 +045700 D-FAIL-ROUTINE-WRITE. IX1204.2 +045800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1204.2 +045900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1204.2 +046000 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1204.2 +046100 MOVE SPACES TO COR-ANSI-REFERENCE. IX1204.2 +046200 D-FAIL-ROUTINE-EX. EXIT. IX1204.2 +046300 D-BAIL-OUT. IX1204.2 +046400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1204.2 +046500 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1204.2 +046600 D-BAIL-OUT-WRITE. IX1204.2 +046700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1204.2 +046800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1204.2 +046900 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1204.2 +047000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1204.2 +047100 D-BAIL-OUT-EX. EXIT. IX1204.2 +047200 DECL-EXIT. EXIT. IX1204.2 +047300 END DECLARATIVES. IX1204.2 +047400 IX1204.2 +047500 IX1204.2 +047600 CCVS1 SECTION. IX1204.2 +047700 OPEN-FILES. IX1204.2 +047800*P OPEN I-O RAW-DATA. IX1204.2 +047900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1204.2 +048000*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1204.2 +048100*P MOVE "ABORTED " TO C-ABORT. IX1204.2 +048200*P ADD 1 TO C-NO-OF-TESTS. IX1204.2 +048300*P ACCEPT C-DATE FROM DATE. IX1204.2 +048400*P ACCEPT C-TIME FROM TIME. IX1204.2 +048500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1204.2 +048600*PND-E-1. IX1204.2 +048700*P CLOSE RAW-DATA. IX1204.2 +048800 OPEN OUTPUT PRINT-FILE. IX1204.2 +048900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1204.2 +049000 MOVE SPACE TO TEST-RESULTS. IX1204.2 +049100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1204.2 +049200 MOVE ZERO TO REC-SKL-SUB. IX1204.2 +049300 PERFORM CCVS-INIT-FILE 9 TIMES. IX1204.2 +049400 CCVS-INIT-FILE. IX1204.2 +049500 ADD 1 TO REC-SKL-SUB. IX1204.2 +049600 MOVE FILE-RECORD-INFO-SKELETON IX1204.2 +049700 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1204.2 +049800 CCVS-INIT-EXIT. IX1204.2 +049900 GO TO CCVS1-EXIT. IX1204.2 +050000 CLOSE-FILES. IX1204.2 +050100*P OPEN I-O RAW-DATA. IX1204.2 +050200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1204.2 +050300*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1204.2 +050400*P MOVE "OK. " TO C-ABORT. IX1204.2 +050500*P MOVE PASS-COUNTER TO C-OK. IX1204.2 +050600*P MOVE ERROR-HOLD TO C-ALL. IX1204.2 +050700*P MOVE ERROR-COUNTER TO C-FAIL. IX1204.2 +050800*P MOVE DELETE-COUNTER TO C-DELETED. IX1204.2 +050900*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1204.2 +051000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1204.2 +051100*PND-E-2. IX1204.2 +051200*P CLOSE RAW-DATA. IX1204.2 +051300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1204.2 +051400 TERMINATE-CCVS. IX1204.2 +051500*S EXIT PROGRAM. IX1204.2 +051600*SERMINATE-CALL. IX1204.2 +051700 STOP RUN. IX1204.2 +051800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1204.2 +051900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1204.2 +052000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1204.2 +052100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1204.2 +052200 MOVE "****TEST DELETED****" TO RE-MARK. IX1204.2 +052300 PRINT-DETAIL. IX1204.2 +052400 IF REC-CT NOT EQUAL TO ZERO IX1204.2 +052500 MOVE "." TO PARDOT-X IX1204.2 +052600 MOVE REC-CT TO DOTVALUE. IX1204.2 +052700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1204.2 +052800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1204.2 +052900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1204.2 +053000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1204.2 +053100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1204.2 +053200 MOVE SPACE TO CORRECT-X. IX1204.2 +053300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1204.2 +053400 MOVE SPACE TO RE-MARK. IX1204.2 +053500 HEAD-ROUTINE. IX1204.2 +053600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +053700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +053800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1204.2 +053900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1204.2 +054000 COLUMN-NAMES-ROUTINE. IX1204.2 +054100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +054200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +054300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +054400 END-ROUTINE. IX1204.2 +054500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1204.2 +054600 END-RTN-EXIT. IX1204.2 +054700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +054800 END-ROUTINE-1. IX1204.2 +054900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1204.2 +055000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1204.2 +055100 ADD PASS-COUNTER TO ERROR-HOLD. IX1204.2 +055200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1204.2 +055300 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1204.2 +055400 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1204.2 +055500 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1204.2 +055600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1204.2 +055700 END-ROUTINE-12. IX1204.2 +055800 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1204.2 +055900 IF ERROR-COUNTER IS EQUAL TO ZERO IX1204.2 +056000 MOVE "NO " TO ERROR-TOTAL IX1204.2 +056100 ELSE IX1204.2 +056200 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1204.2 +056300 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1204.2 +056400 PERFORM WRITE-LINE. IX1204.2 +056500 END-ROUTINE-13. IX1204.2 +056600 IF DELETE-COUNTER IS EQUAL TO ZERO IX1204.2 +056700 MOVE "NO " TO ERROR-TOTAL ELSE IX1204.2 +056800 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1204.2 +056900 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1204.2 +057000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +057100 IF INSPECT-COUNTER EQUAL TO ZERO IX1204.2 +057200 MOVE "NO " TO ERROR-TOTAL IX1204.2 +057300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1204.2 +057400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1204.2 +057500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +057600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1204.2 +057700 WRITE-LINE. IX1204.2 +057800 ADD 1 TO RECORD-COUNT. IX1204.2 +057900 IF RECORD-COUNT GREATER 42 IX1204.2 +058000 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1204.2 +058100 MOVE SPACE TO DUMMY-RECORD IX1204.2 +058200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1204.2 +058300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1204.2 +058400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1204.2 +058500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1204.2 +058600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1204.2 +058700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1204.2 +058800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1204.2 +058900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1204.2 +059000 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1204.2 +059100 MOVE ZERO TO RECORD-COUNT. IX1204.2 +059200 PERFORM WRT-LN. IX1204.2 +059300 WRT-LN. IX1204.2 +059400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1204.2 +059500 MOVE SPACE TO DUMMY-RECORD. IX1204.2 +059600 BLANK-LINE-PRINT. IX1204.2 +059700 PERFORM WRT-LN. IX1204.2 +059800 FAIL-ROUTINE. IX1204.2 +059900 IF COMPUTED-X NOT EQUAL TO SPACE IX1204.2 +060000 GO TO FAIL-ROUTINE-WRITE. IX1204.2 +060100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1204.2 +060200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1204.2 +060300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1204.2 +060400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +060500 MOVE SPACES TO INF-ANSI-REFERENCE. IX1204.2 +060600 GO TO FAIL-ROUTINE-EX. IX1204.2 +060700 FAIL-ROUTINE-WRITE. IX1204.2 +060800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1204.2 +060900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1204.2 +061000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1204.2 +061100 MOVE SPACES TO COR-ANSI-REFERENCE. IX1204.2 +061200 FAIL-ROUTINE-EX. EXIT. IX1204.2 +061300 BAIL-OUT. IX1204.2 +061400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1204.2 +061500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1204.2 +061600 BAIL-OUT-WRITE. IX1204.2 +061700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1204.2 +061800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1204.2 +061900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1204.2 +062000 MOVE SPACES TO INF-ANSI-REFERENCE. IX1204.2 +062100 BAIL-OUT-EX. EXIT. IX1204.2 +062200 CCVS1-EXIT. IX1204.2 +062300 EXIT. IX1204.2 +062400 IX1204.2 +062500 SECT-IX120A-0003 SECTION. IX1204.2 +062600 SEQ-INIT-010. IX1204.2 +062700 MOVE ZERO TO TEST-NO. IX1204.2 +062800 MOVE "IX-FS3" TO XFILE-NAME (1). IX1204.2 +062900 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1204.2 +063000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1204.2 +063100 MOVE 000240 TO XRECORD-LENGTH (1). IX1204.2 +063200 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1204.2 +063300 MOVE 0002 TO XBLOCK-SIZE (1). IX1204.2 +063400 MOVE 000050 TO RECORDS-IN-FILE (1). IX1204.2 +063500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1204.2 +063600 MOVE "S" TO XLABEL-TYPE (1). IX1204.2 +063700 MOVE 000001 TO XRECORD-NUMBER (1). IX1204.2 +063800 MOVE 0 TO COUNT-OF-RECS. IX1204.2 +063900 IX1204.2 +064000******************************************************************IX1204.2 +064100* TEST 1 *IX1204.2 +064200* OPEN OUTPUT ... 00 EXPECTED *IX1204.2 +064300* IX-3, 1.3.4 (1) A *IX1204.2 +064400* STATUS 00 CHECK ON OUTPUT FILE IX-FS3 *IX1204.2 +064500* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1204.2 +064600******************************************************************IX1204.2 +064700 OPN-INIT-GF-01-0. IX1204.2 +064800 MOVE 1 TO STATUS-TEST-00. IX1204.2 +064900 MOVE SPACES TO IX-FS3-STATUS. IX1204.2 +065000 MOVE "OPEN I-O : 00 EXP." TO FEATURE. IX1204.2 +065100 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1204.2 +065200 OPEN IX1204.2 +065300 I-O IX-FS3. IX1204.2 +065400 IF IX-FS3-STATUS EQUAL TO "00" IX1204.2 +065500 GO TO OPN-PASS-GF-01-0. IX1204.2 +065600 OPN-FAIL-GF-01-0. IX1204.2 +065700 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX1204.2 +065800 PERFORM FAIL. IX1204.2 +065900 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1204.2 +066000 MOVE "00" TO CORRECT-X. IX1204.2 +066100 GO TO OPN-WRITE-GF-01-0. IX1204.2 +066200 OPN-PASS-GF-01-0. IX1204.2 +066300 PERFORM PASS. IX1204.2 +066400 OPN-WRITE-GF-01-0. IX1204.2 +066500 PERFORM PRINT-DETAIL. IX1204.2 +066600******************************************************************IX1204.2 +066700* TEST 5 *IX1204.2 +066800* REWRITE WHERE THE LAST EXECUTED I-O STATEMENT PRIOR TO *IX1204.2 +066900* THE REWRITE WAS NOT A SUCCESSFULLY EXECUTED READ IX1204.2 +067000* STATEMENT. STATUS 43 EXPECTED. IX1204.2 +067100* IX-3, 1.3.4 (3) A *IX1204.2 +067200******************************************************************IX1204.2 +067300 RWR-INIT-GF-01-0. IX1204.2 +067400 MOVE 5 TO TEST-NO. IX1204.2 +067500 MOVE SPACES TO IX-FS3-STATUS. IX1204.2 +067600 MOVE 0 TO STATUS-TEST-00. IX1204.2 +067700 MOVE "REWRITE: 43 EXP." TO FEATURE. IX1204.2 +067800 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1204.2 +067900*RWR-READ-GF-01-0. IX1204.2 +068000* READ IX-FS3 AT END GO TO RWR-TEST-GF-01-0. IX1204.2 +068100* GO TO RWR-READ-GF-01-0. IX1204.2 +068200*RWR-TEST-GF-01-0. IX1204.2 +068300* READ IX-FS3 AT END GO TO RWR-TEST-GF-01-1. IX1204.2 +068400* MOVE FILE-RECORD-INFO (1) TO IX-FS3R1-F-G-240. IX1204.2 +068500 RWR-TEST-GF-01-1. IX1204.2 +068600 REWRITE IX-FS3R1-F-G-240. IX1204.2 +068700 IF IX-FS3-STATUS EQUAL TO "43" IX1204.2 +068800 MOVE "SHOULD HAVE EXECUTED DECLARATIVES IX-3,1.3.4(4)" IX1204.2 +068900 TO RE-MARK IX1204.2 +069000 GO TO RWR-WRITE-GF-01-0. IX1204.2 +069100 RWR-FAIL-GF-01-0. IX1204.2 +069200 MOVE "IX-5, 1.3.4, (5) C" TO RE-MARK. IX1204.2 +069300 RWR-WRITE-GF-01-0. IX1204.2 +069400 MOVE IX-FS3-STATUS TO COMPUTED-A. IX1204.2 +069500 MOVE "43" TO CORRECT-X. IX1204.2 +069600 PERFORM FAIL. IX1204.2 +069700 PERFORM PRINT-DETAIL. IX1204.2 +069800 CLOSE IX-FS3. IX1204.2 +069900 IX1204.2 +070000 TERMINATE-ROUTINE. IX1204.2 +070100 EXIT. IX1204.2 +070200 IX1204.2 +070300 CCVS-EXIT SECTION. IX1204.2 +070400 CCVS-999999. IX1204.2 +070500 GO TO CLOSE-FILES. IX1204.2 diff --git a/tests/cobol85/IX/IX121A.CBL b/tests/cobol85/IX/IX121A.CBL new file mode 100755 index 00000000..9f603753 --- /dev/null +++ b/tests/cobol85/IX/IX121A.CBL @@ -0,0 +1,762 @@ +000100 IDENTIFICATION DIVISION. IX1214.2 +000200 PROGRAM-ID. IX1214.2 +000300 IX121A. IX1214.2 +000400**************************************************************** IX1214.2 +000500* * IX1214.2 +000600* VALIDATION FOR:- * IX1214.2 +000700* * IX1214.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1214.2 +000900* * IX1214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1214.2 +001100* * IX1214.2 +001200**************************************************************** IX1214.2 +001300* IX1214.2 +001400* 1. THE ROUTINE CREATES THE MASS STORAGE FILE IX-VS2 IX1214.2 +001500* CONTAINING 50 RECORDS. EACH BLOCK CONTAINS 2 RECORDS, IX1214.2 +001600* EACH RECORD CONTAINS 240 CHARACTERS, ORGANIZATION IS IX1214.2 +001700* INDEXED, ACCESS IS SEQUENTIAL. THEN THE FILE IS OPENED IX1214.2 +001800* AS I-O AND IT IS ATTEMTED TO REWRITE A RECORD WITH A IX1214.2 +001900* WRONG RECORD LENGTH. THE RECORD REWRITTEN IS LONGER IX1214.2 +002000* THAN THE RECORD READ. IX1214.2 +002100* IX1214.2 +002200* NOTE: THIS PROGRAM IS A SUPPLEMENT TO PROGRAM IX112A, WHICH IX1214.2 +002300* REWRITES A RECORD SHORTER THAN THE RECORD READ. IX1214.2 +002400* IX1214.2 +002500* 2. THE ROUTINE READS THE CREATED FILE, VERIFIES IT AND IX1214.2 +002600* CHECKS THE FILE STATUS CODE: IX1214.2 +002700* 44 - AFTER REWRITE (WITH WRONG RECORD LENGTH) IX1214.2 +002800* IX1214.2 +002900* 3. X-CARDS USED IN THIS PROGRAM: IX1214.2 +003000* IX1214.2 +003100* XXXXX024 IX1214.2 +003200* XXXXX055. IX1214.2 +003300* XXXXX062. IX1214.2 +003400* XXXXX082. IX1214.2 +003500* XXXXX083. IX1214.2 +003600* XXXXX084 IX1214.2 +003700* IX1214.2 +003800* IX1214.2 +003900 ENVIRONMENT DIVISION. IX1214.2 +004000 CONFIGURATION SECTION. IX1214.2 +004100 SOURCE-COMPUTER. IX1214.2 +004200 Linux. IX1214.2 +004300 OBJECT-COMPUTER. IX1214.2 +004400 Linux. IX1214.2 +004500 INPUT-OUTPUT SECTION. IX1214.2 +004600 FILE-CONTROL. IX1214.2 +004700*P SELECT RAW-DATA ASSIGN TO IX1214.2 +004800*P "XXXXX062" IX1214.2 +004900*P ORGANIZATION IS INDEXED IX1214.2 +005000*P ACCESS MODE IS RANDOM IX1214.2 +005100*P RECORD KEY IS RAW-DATA-KEY. IX1214.2 +005200* IX1214.2 +005300 SELECT PRINT-FILE ASSIGN TO IX1214.2 +005400 "report.log". IX1214.2 +005500* IX1214.2 +005600 SELECT IX-VS2 ASSIGN IX1214.2 +005700 "XXXXX024" IX1214.2 +005800 ORGANIZATION IS INDEXED IX1214.2 +005900 ACCESS MODE IS SEQUENTIAL IX1214.2 +006000 RECORD KEY IS IX-VS2-KEY IX1214.2 +006100 FILE STATUS IS IX-VS2-STATUS. IX1214.2 +006200 IX1214.2 +006300 DATA DIVISION. IX1214.2 +006400 IX1214.2 +006500 FILE SECTION. IX1214.2 +006600*P IX1214.2 +006700*PD RAW-DATA. IX1214.2 +006800*P IX1214.2 +006900*P1 RAW-DATA-SATZ. IX1214.2 +007000*P 05 RAW-DATA-KEY PIC X(6). IX1214.2 +007100*P 05 C-DATE PIC 9(6). IX1214.2 +007200*P 05 C-TIME PIC 9(8). IX1214.2 +007300*P 05 C-NO-OF-TESTS PIC 99. IX1214.2 +007400*P 05 C-OK PIC 999. IX1214.2 +007500*P 05 C-ALL PIC 999. IX1214.2 +007600*P 05 C-FAIL PIC 999. IX1214.2 +007700*P 05 C-DELETED PIC 999. IX1214.2 +007800*P 05 C-INSPECT PIC 999. IX1214.2 +007900*P 05 C-NOTE PIC X(13). IX1214.2 +008000*P 05 C-INDENT PIC X. IX1214.2 +008100*P 05 C-ABORT PIC X(8). IX1214.2 +008200 IX1214.2 +008300 FD PRINT-FILE. IX1214.2 +008400 IX1214.2 +008500 01 PRINT-REC PIC X(120). IX1214.2 +008600 IX1214.2 +008700 01 DUMMY-RECORD PIC X(120). IX1214.2 +008800 IX1214.2 +008900 FD IX-VS2 IX1214.2 +009000*C DATA RECORDS IX-VS2R1-F-G-240 IX-VS2R1-F-G-200 IX1214.2 +009100*C IX-VS2R1-F-G-280 IX1214.2 +009200*C LABEL RECORD STANDARD IX1214.2 +009300 RECORD 200 TO 280 IX1214.2 +009400 BLOCK CONTAINS 2 RECORDS. IX1214.2 +009500 IX1214.2 +009600 01 IX-VS2R1-F-G-240. IX1214.2 +009700 05 IX-VS2-REC-120 PIC X(120). IX1214.2 +009800 05 IX-VS2-REC-120-240. IX1214.2 +009900 10 FILLER PIC X(8). IX1214.2 +010000 10 IX-VS2-KEY PIC X(29). IX1214.2 +010100 10 FILLER PIC X(9). IX1214.2 +010200 10 IX-VS2-ALTER-KEY PIC X(29). IX1214.2 +010300 10 FILLER PIC X(45). IX1214.2 +010400 IX1214.2 +010500 01 IX-VS2R1-F-G-200. IX1214.2 +010600 05 IX-VS2-REC-SHORT PIC X(120). IX1214.2 +010700 05 IX-VS2-REC-120-200 PIC X(80). IX1214.2 +010800 IX1214.2 +010900 01 IX-VS2R1-F-G-280. IX1214.2 +011000 05 IX-VS2-REC-LONG PIC X(120). IX1214.2 +011100 05 IX-VS2-REC-120-239 PIC X(120). IX1214.2 +011200 05 IX-VS2-REC-240-280 PIC X(40). IX1214.2 +011300 IX1214.2 +011400 WORKING-STORAGE SECTION. IX1214.2 +011500 IX1214.2 +011600 01 GRP-0101. IX1214.2 +011700 05 FILLER PIC X(10) VALUE "RECORD-KEY". IX1214.2 +011800 05 GRP-0101-KEY PIC 9(9) VALUE ZERO. IX1214.2 +011900 05 FILLER PIC X(10) VALUE "END-OF-KEY". IX1214.2 +012000 IX1214.2 +012100 01 GRP-0102. IX1214.2 +012200 05 FILLER PIC X(10) VALUE "ALTERN-KEY". IX1214.2 +012300 05 GRP-0102-KEY PIC 9(9) VALUE ZERO. IX1214.2 +012400 05 FILLER PIC X(10) VALUE "END-AL-KEY". IX1214.2 +012500 IX1214.2 +012600 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. IX1214.2 +012700 IX1214.2 +012800 01 EOF-FLAG PIC 9 VALUE ZERO. IX1214.2 +012900 IX1214.2 +013000 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. IX1214.2 +013100 IX1214.2 +013200 01 ERROR-FLAG PIC 9 VALUE ZERO. IX1214.2 +013300 IX1214.2 +013400 01 PERM-ERRORS PIC S9(5) COMP VALUE ZERO. IX1214.2 +013500 IX1214.2 +013600 01 STATUS-TEST-00 PIC 9 VALUE ZERO. IX1214.2 +013700 IX1214.2 +013800 01 STATUS-TEST-10 PIC 9 VALUE ZERO. IX1214.2 +013900 01 STATUS-TEST-READ PIC 9 VALUE ZERO. IX1214.2 +014000 IX1214.2 +014100 01 IX-VS2-STATUS. IX1214.2 +014200 05 IX-VS2-STAT1 PIC X. IX1214.2 +014300 05 IX-VS2-STAT2 PIC X. IX1214.2 +014400 IX1214.2 +014500 01 COUNT-OF-RECS PIC 9(5). IX1214.2 +014600 IX1214.2 +014700 01 COUNT-OF-RECORDS REDEFINES COUNT-OF-RECS PIC 9(5). IX1214.2 +014800 IX1214.2 +014900 01 FILE-RECORD-INFORMATION-REC. IX1214.2 +015000 05 FILE-RECORD-INFO-SKELETON. IX1214.2 +015100 10 FILLER PIC X(48) VALUE IX1214.2 +015200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX1214.2 +015300 10 FILLER PIC X(46) VALUE IX1214.2 +015400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX1214.2 +015500 10 FILLER PIC X(26) VALUE IX1214.2 +015600 ",LFIL=000000,ORG= ,LBLR= ". IX1214.2 +015700 10 FILLER PIC X(37) VALUE IX1214.2 +015800 ",RECKEY= ". IX1214.2 +015900 10 FILLER PIC X(38) VALUE IX1214.2 +016000 ",ALTKEY1= ". IX1214.2 +016100 10 FILLER PIC X(38) VALUE IX1214.2 +016200 ",ALTKEY2= ". IX1214.2 +016300 10 FILLER PIC X(7) VALUE SPACE. IX1214.2 +016400 05 FILE-RECORD-INFO OCCURS 10. IX1214.2 +016500 10 FILE-RECORD-INFO-P1-120. IX1214.2 +016600 15 FILLER PIC X(5). IX1214.2 +016700 15 XFILE-NAME PIC X(6). IX1214.2 +016800 15 FILLER PIC X(8). IX1214.2 +016900 15 XRECORD-NAME PIC X(6). IX1214.2 +017000 15 FILLER PIC X(1). IX1214.2 +017100 15 REELUNIT-NUMBER PIC 9(1). IX1214.2 +017200 15 FILLER PIC X(7). IX1214.2 +017300 15 XRECORD-NUMBER PIC 9(6). IX1214.2 +017400 15 FILLER PIC X(6). IX1214.2 +017500 15 UPDATE-NUMBER PIC 9(2). IX1214.2 +017600 15 FILLER PIC X(5). IX1214.2 +017700 15 ODO-NUMBER PIC 9(4). IX1214.2 +017800 15 FILLER PIC X(5). IX1214.2 +017900 15 XPROGRAM-NAME PIC X(5). IX1214.2 +018000 15 FILLER PIC X(7). IX1214.2 +018100 15 XRECORD-LENGTH PIC 9(6). IX1214.2 +018200 15 FILLER PIC X(7). IX1214.2 +018300 15 CHARS-OR-RECORDS PIC X(2). IX1214.2 +018400 15 FILLER PIC X(1). IX1214.2 +018500 15 XBLOCK-SIZE PIC 9(4). IX1214.2 +018600 15 FILLER PIC X(6). IX1214.2 +018700 15 RECORDS-IN-FILE PIC 9(6). IX1214.2 +018800 15 FILLER PIC X(5). IX1214.2 +018900 15 XFILE-ORGANIZATION PIC X(2). IX1214.2 +019000 15 FILLER PIC X(6). IX1214.2 +019100 15 XLABEL-TYPE PIC X(1). IX1214.2 +019200 10 FILE-RECORD-INFO-P121-240. IX1214.2 +019300 15 FILLER PIC X(8). IX1214.2 +019400 15 XRECORD-KEY PIC X(29). IX1214.2 +019500 15 FILLER PIC X(9). IX1214.2 +019600 15 ALTERNATE-KEY1 PIC X(29). IX1214.2 +019700 15 FILLER PIC X(9). IX1214.2 +019800 15 ALTERNATE-KEY2 PIC X(29). IX1214.2 +019900 15 FILLER PIC X(7). IX1214.2 +020000 IX1214.2 +020100 01 TEST-RESULTS. IX1214.2 +020200 02 FILLER PIC X VALUE SPACE. IX1214.2 +020300 02 FEATURE PIC X(20) VALUE SPACE. IX1214.2 +020400 02 FILLER PIC X VALUE SPACE. IX1214.2 +020500 02 P-OR-F PIC X(5) VALUE SPACE. IX1214.2 +020600 02 FILLER PIC X VALUE SPACE. IX1214.2 +020700 02 PAR-NAME. IX1214.2 +020800 03 FILLER PIC X(19) VALUE SPACE. IX1214.2 +020900 03 PARDOT-X PIC X VALUE SPACE. IX1214.2 +021000 03 DOTVALUE PIC 99 VALUE ZERO. IX1214.2 +021100 02 FILLER PIC X(8) VALUE SPACE. IX1214.2 +021200 02 RE-MARK PIC X(61). IX1214.2 +021300 01 TEST-COMPUTED. IX1214.2 +021400 02 FILLER PIC X(30) VALUE SPACE. IX1214.2 +021500 02 FILLER PIC X(17) VALUE IX1214.2 +021600 " COMPUTED=". IX1214.2 +021700 02 COMPUTED-X. IX1214.2 +021800 03 COMPUTED-A PIC X(20) VALUE SPACE. IX1214.2 +021900 03 COMPUTED-N REDEFINES COMPUTED-A IX1214.2 +022000 PIC -9(9).9(9). IX1214.2 +022100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX1214.2 +022200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX1214.2 +022300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX1214.2 +022400 03 CM-18V0 REDEFINES COMPUTED-A. IX1214.2 +022500 04 COMPUTED-18V0 PIC -9(18). IX1214.2 +022600 04 FILLER PIC X. IX1214.2 +022700 03 FILLER PIC X(50) VALUE SPACE. IX1214.2 +022800 01 TEST-CORRECT. IX1214.2 +022900 02 FILLER PIC X(30) VALUE SPACE. IX1214.2 +023000 02 FILLER PIC X(17) VALUE " CORRECT =". IX1214.2 +023100 02 CORRECT-X. IX1214.2 +023200 03 CORRECT-A PIC X(20) VALUE SPACE. IX1214.2 +023300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX1214.2 +023400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX1214.2 +023500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX1214.2 +023600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX1214.2 +023700 03 CR-18V0 REDEFINES CORRECT-A. IX1214.2 +023800 04 CORRECT-18V0 PIC -9(18). IX1214.2 +023900 04 FILLER PIC X. IX1214.2 +024000 03 FILLER PIC X(2) VALUE SPACE. IX1214.2 +024100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX1214.2 +024200 01 CCVS-C-1. IX1214.2 +024300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX1214.2 +024400- "SS PARAGRAPH-NAME IX1214.2 +024500- " REMARKS". IX1214.2 +024600 02 FILLER PIC X(20) VALUE SPACE. IX1214.2 +024700 01 CCVS-C-2. IX1214.2 +024800 02 FILLER PIC X VALUE SPACE. IX1214.2 +024900 02 FILLER PIC X(6) VALUE "TESTED". IX1214.2 +025000 02 FILLER PIC X(15) VALUE SPACE. IX1214.2 +025100 02 FILLER PIC X(4) VALUE "FAIL". IX1214.2 +025200 02 FILLER PIC X(94) VALUE SPACE. IX1214.2 +025300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX1214.2 +025400 01 REC-CT PIC 99 VALUE ZERO. IX1214.2 +025500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX1214.2 +025600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX1214.2 +025700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX1214.2 +025800 01 PASS-COUNTER PIC 999 VALUE ZERO. IX1214.2 +025900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX1214.2 +026000 01 ERROR-HOLD PIC 999 VALUE ZERO. IX1214.2 +026100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX1214.2 +026200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX1214.2 +026300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX1214.2 +026400 01 CCVS-H-1. IX1214.2 +026500 02 FILLER PIC X(39) VALUE SPACES. IX1214.2 +026600 02 FILLER PIC X(42) VALUE IX1214.2 +026700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX1214.2 +026800 02 FILLER PIC X(39) VALUE SPACES. IX1214.2 +026900 01 CCVS-H-2A. IX1214.2 +027000 02 FILLER PIC X(40) VALUE SPACE. IX1214.2 +027100 02 FILLER PIC X(7) VALUE "CCVS85 ". IX1214.2 +027200 02 FILLER PIC XXXX VALUE IX1214.2 +027300 "4.2 ". IX1214.2 +027400 02 FILLER PIC X(28) VALUE IX1214.2 +027500 " COPY - NOT FOR DISTRIBUTION". IX1214.2 +027600 02 FILLER PIC X(41) VALUE SPACE. IX1214.2 +027700 IX1214.2 +027800 01 CCVS-H-2B. IX1214.2 +027900 02 FILLER PIC X(15) VALUE IX1214.2 +028000 "TEST RESULT OF ". IX1214.2 +028100 02 TEST-ID PIC X(9). IX1214.2 +028200 02 FILLER PIC X(4) VALUE IX1214.2 +028300 " IN ". IX1214.2 +028400 02 FILLER PIC X(12) VALUE IX1214.2 +028500 " HIGH ". IX1214.2 +028600 02 FILLER PIC X(22) VALUE IX1214.2 +028700 " LEVEL VALIDATION FOR ". IX1214.2 +028800 02 FILLER PIC X(58) VALUE IX1214.2 +028900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1214.2 +029000 01 CCVS-H-3. IX1214.2 +029100 02 FILLER PIC X(34) VALUE IX1214.2 +029200 " FOR OFFICIAL USE ONLY ". IX1214.2 +029300 02 FILLER PIC X(58) VALUE IX1214.2 +029400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX1214.2 +029500 02 FILLER PIC X(28) VALUE IX1214.2 +029600 " COPYRIGHT 1985 ". IX1214.2 +029700 01 CCVS-E-1. IX1214.2 +029800 02 FILLER PIC X(52) VALUE SPACE. IX1214.2 +029900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX1214.2 +030000 02 ID-AGAIN PIC X(9). IX1214.2 +030100 02 FILLER PIC X(45) VALUE SPACES. IX1214.2 +030200 01 CCVS-E-2. IX1214.2 +030300 02 FILLER PIC X(31) VALUE SPACE. IX1214.2 +030400 02 FILLER PIC X(21) VALUE SPACE. IX1214.2 +030500 02 CCVS-E-2-2. IX1214.2 +030600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX1214.2 +030700 03 FILLER PIC X VALUE SPACE. IX1214.2 +030800 03 ENDER-DESC PIC X(44) VALUE IX1214.2 +030900 "ERRORS ENCOUNTERED". IX1214.2 +031000 01 CCVS-E-3. IX1214.2 +031100 02 FILLER PIC X(22) VALUE IX1214.2 +031200 " FOR OFFICIAL USE ONLY". IX1214.2 +031300 02 FILLER PIC X(12) VALUE SPACE. IX1214.2 +031400 02 FILLER PIC X(58) VALUE IX1214.2 +031500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX1214.2 +031600 02 FILLER PIC X(13) VALUE SPACE. IX1214.2 +031700 02 FILLER PIC X(15) VALUE IX1214.2 +031800 " COPYRIGHT 1985". IX1214.2 +031900 01 CCVS-E-4. IX1214.2 +032000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX1214.2 +032100 02 FILLER PIC X(4) VALUE " OF ". IX1214.2 +032200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX1214.2 +032300 02 FILLER PIC X(40) VALUE IX1214.2 +032400 " TESTS WERE EXECUTED SUCCESSFULLY". IX1214.2 +032500 01 XXINFO. IX1214.2 +032600 02 FILLER PIC X(19) VALUE IX1214.2 +032700 "*** INFORMATION ***". IX1214.2 +032800 02 INFO-TEXT. IX1214.2 +032900 04 FILLER PIC X(8) VALUE SPACE. IX1214.2 +033000 04 XXCOMPUTED PIC X(20). IX1214.2 +033100 04 FILLER PIC X(5) VALUE SPACE. IX1214.2 +033200 04 XXCORRECT PIC X(20). IX1214.2 +033300 02 INF-ANSI-REFERENCE PIC X(48). IX1214.2 +033400 01 HYPHEN-LINE. IX1214.2 +033500 02 FILLER PIC IS X VALUE IS SPACE. IX1214.2 +033600 02 FILLER PIC IS X(65) VALUE IS "************************IX1214.2 +033700- "*****************************************". IX1214.2 +033800 02 FILLER PIC IS X(54) VALUE IS "************************IX1214.2 +033900- "******************************". IX1214.2 +034000 01 CCVS-PGM-ID PIC X(9) VALUE IX1214.2 +034100 "IX121A". IX1214.2 +034200 01 TEST-NUMBER PIC 9 VALUE ZERO. IX1214.2 +034300 IX1214.2 +034400 PROCEDURE DIVISION. IX1214.2 +034500 DECLARATIVES. IX1214.2 +034600 IX1214.2 +034700 SECT-IX105-0002 SECTION. IX1214.2 +034800 USE AFTER EXCEPTION PROCEDURE ON IX-VS2. IX1214.2 +034900 INPUT-PROCESS. IX1214.2 +035000 MOVE 1 TO PERM-ERRORS. IX1214.2 +035100 IF TEST-NUMBER NOT = 3 GO TO END-DECL. IX1214.2 +035200 D-RWR-TEST-GF-01-1. IX1214.2 +035300 IF IX-VS2-STATUS = "00" IX1214.2 +035400 GO TO D-RWR-PASS-GF-01-0. IX1214.2 +035500 IF IX-VS2-STATUS = "44" IX1214.2 +035600 GO TO D-RWR-PASS-GF-01-0. IX1214.2 +035700 D-RWR-FAIL-GF-01-0. IX1214.2 +035800 MOVE "IX-5, 1.3.4, (5) d 1 & 2; SHORT RECORD" TO RE-MARK. IX1214.2 +035900 PERFORM D-FAIL. IX1214.2 +036000 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1214.2 +036100 MOVE "00 OR 44" TO CORRECT-X. IX1214.2 +036200 GO TO D-RWR-WRITE-GF-01-0. IX1214.2 +036300 D-RWR-PASS-GF-01-0. IX1214.2 +036400 PERFORM D-PASS. IX1214.2 +036500 D-RWR-WRITE-GF-01-0. IX1214.2 +036600 PERFORM D-PRINT-DETAIL. IX1214.2 +036700 D-CLOSE-FILES. IX1214.2 +036800*P OPEN I-O RAW-DATA. IX1214.2 +036900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1214.2 +037000*P READ RAW-DATA INVALID KEY GO TO D-END-E-2. IX1214.2 +037100*P MOVE "OK. " TO C-ABORT. IX1214.2 +037200*P MOVE PASS-COUNTER TO C-OK. IX1214.2 +037300*P MOVE ERROR-HOLD TO C-ALL. IX1214.2 +037400*P MOVE ERROR-COUNTER TO C-FAIL. IX1214.2 +037500*P MOVE DELETE-COUNTER TO C-DELETED. IX1214.2 +037600*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1214.2 +037700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO D-END-E-2. IX1214.2 +037800*P-END-E-2. IX1214.2 +037900*P CLOSE RAW-DATA. IX1214.2 +038000 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. IX1214.2 +038100 CLOSE PRINT-FILE. IX1214.2 +038200 D-TERMINATE-CCVS. IX1214.2 +038300*S EXIT PROGRAM. IX1214.2 +038400*S-TERMINATE-CALL. IX1214.2 +038500 STOP RUN. IX1214.2 +038600 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1214.2 +038700 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1214.2 +038800 D-PRINT-DETAIL. IX1214.2 +038900 IF REC-CT NOT EQUAL TO ZERO IX1214.2 +039000 MOVE "." TO PARDOT-X IX1214.2 +039100 MOVE REC-CT TO DOTVALUE. IX1214.2 +039200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D-WRITE-LINE. IX1214.2 +039300 IF P-OR-F EQUAL TO "FAIL*" PERFORM D-WRITE-LINE IX1214.2 +039400 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX IX1214.2 +039500 ELSE PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. IX1214.2 +039600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1214.2 +039700 MOVE SPACE TO CORRECT-X. IX1214.2 +039800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1214.2 +039900 MOVE SPACE TO RE-MARK. IX1214.2 +040000 D-END-ROUTINE. IX1214.2 +040100 MOVE HYPHEN-LINE TO DUMMY-RECORD. IX1214.2 +040200 PERFORM D-WRITE-LINE 5 TIMES. IX1214.2 +040300 D-END-RTN-EXIT. IX1214.2 +040400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1214.2 +040500 D-END-ROUTINE-1. IX1214.2 +040600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1214.2 +040700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1214.2 +040800 ADD PASS-COUNTER TO ERROR-HOLD. IX1214.2 +040900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1214.2 +041000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1214.2 +041100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1214.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. IX1214.2 +041300 D-END-ROUTINE-12. IX1214.2 +041400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1214.2 +041500 IF ERROR-COUNTER IS EQUAL TO ZERO IX1214.2 +041600 MOVE "NO " TO ERROR-TOTAL IX1214.2 +041700 ELSE IX1214.2 +041800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1214.2 +041900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1214.2 +042000 PERFORM D-WRITE-LINE. IX1214.2 +042100 D-END-ROUTINE-13. IX1214.2 +042200 IF DELETE-COUNTER IS EQUAL TO ZERO IX1214.2 +042300 MOVE "NO " TO ERROR-TOTAL ELSE IX1214.2 +042400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1214.2 +042500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1214.2 +042600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1214.2 +042700 IF INSPECT-COUNTER EQUAL TO ZERO IX1214.2 +042800 MOVE "NO " TO ERROR-TOTAL IX1214.2 +042900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1214.2 +043000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1214.2 +043100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1214.2 +043200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. IX1214.2 +043300 D-WRITE-LINE. IX1214.2 +043400 ADD 1 TO RECORD-COUNT. IX1214.2 +043500 IF RECORD-COUNT GREATER 42 IX1214.2 +043600 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1214.2 +043700 MOVE SPACE TO DUMMY-RECORD IX1214.2 +043800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1214.2 +043900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1214.2 +044000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES IX1214.2 +044100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1214.2 +044200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM D-WRT-LN 3 TIMES IX1214.2 +044300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN IX1214.2 +044400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN IX1214.2 +044500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN IX1214.2 +044600 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1214.2 +044700 MOVE ZERO TO RECORD-COUNT. IX1214.2 +044800 PERFORM D-WRT-LN. IX1214.2 +044900 D-WRT-LN. IX1214.2 +045000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1214.2 +045100 MOVE SPACE TO DUMMY-RECORD. IX1214.2 +045200 D-BLANK-LINE-PRINT. IX1214.2 +045300 PERFORM D-WRT-LN. IX1214.2 +045400 D-FAIL-ROUTINE. IX1214.2 +045500 IF COMPUTED-X NOT EQUAL TO SPACE IX1214.2 +045600 GO TO D-FAIL-ROUTINE-WRITE. IX1214.2 +045700 IF CORRECT-X NOT EQUAL TO SPACE GO TO D-FAIL-ROUTINE-WRITE. IX1214.2 +045800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1214.2 +045900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1214.2 +046000 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1214.2 +046100 MOVE SPACES TO INF-ANSI-REFERENCE. IX1214.2 +046200 GO TO D-FAIL-ROUTINE-EX. IX1214.2 +046300 D-FAIL-ROUTINE-WRITE. IX1214.2 +046400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE IX1214.2 +046500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1214.2 +046600 MOVE TEST-CORRECT TO PRINT-REC PERFORM D-WRITE-LINE 2 TIMES. IX1214.2 +046700 MOVE SPACES TO COR-ANSI-REFERENCE. IX1214.2 +046800 D-FAIL-ROUTINE-EX. EXIT. IX1214.2 +046900 D-BAIL-OUT. IX1214.2 +047000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. IX1214.2 +047100 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. IX1214.2 +047200 D-BAIL-OUT-WRITE. IX1214.2 +047300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1214.2 +047400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1214.2 +047500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. IX1214.2 +047600 MOVE SPACES TO INF-ANSI-REFERENCE. IX1214.2 +047700 D-BAIL-OUT-EX. EXIT. IX1214.2 +047800 IX1214.2 +047900 END-DECL. IX1214.2 +048000 END DECLARATIVES. IX1214.2 +048100 IX1214.2 +048200 IX1214.2 +048300 CCVS1 SECTION. IX1214.2 +048400 OPEN-FILES. IX1214.2 +048500*P OPEN I-O RAW-DATA. IX1214.2 +048600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1214.2 +048700*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX1214.2 +048800*P MOVE "ABORTED " TO C-ABORT. IX1214.2 +048900*P ADD 1 TO C-NO-OF-TESTS. IX1214.2 +049000*P ACCEPT C-DATE FROM DATE. IX1214.2 +049100*P ACCEPT C-TIME FROM TIME. IX1214.2 +049200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX1214.2 +049300*PND-E-1. IX1214.2 +049400*P CLOSE RAW-DATA. IX1214.2 +049500 OPEN OUTPUT PRINT-FILE. IX1214.2 +049600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX1214.2 +049700 MOVE SPACE TO TEST-RESULTS. IX1214.2 +049800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX1214.2 +049900 MOVE ZERO TO REC-SKL-SUB. IX1214.2 +050000 PERFORM CCVS-INIT-FILE 9 TIMES. IX1214.2 +050100 CCVS-INIT-FILE. IX1214.2 +050200 ADD 1 TO REC-SKL-SUB. IX1214.2 +050300 MOVE FILE-RECORD-INFO-SKELETON IX1214.2 +050400 TO FILE-RECORD-INFO (REC-SKL-SUB). IX1214.2 +050500 CCVS-INIT-EXIT. IX1214.2 +050600 GO TO CCVS1-EXIT. IX1214.2 +050700 CLOSE-FILES. IX1214.2 +050800*P OPEN I-O RAW-DATA. IX1214.2 +050900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX1214.2 +051000*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX1214.2 +051100*P MOVE "OK. " TO C-ABORT. IX1214.2 +051200*P MOVE PASS-COUNTER TO C-OK. IX1214.2 +051300*P MOVE ERROR-HOLD TO C-ALL. IX1214.2 +051400*P MOVE ERROR-COUNTER TO C-FAIL. IX1214.2 +051500*P MOVE DELETE-COUNTER TO C-DELETED. IX1214.2 +051600*P MOVE INSPECT-COUNTER TO C-INSPECT. IX1214.2 +051700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX1214.2 +051800*PND-E-2. IX1214.2 +051900*P CLOSE RAW-DATA. IX1214.2 +052000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX1214.2 +052100 TERMINATE-CCVS. IX1214.2 +052200*S EXIT PROGRAM. IX1214.2 +052300*SERMINATE-CALL. IX1214.2 +052400 STOP RUN. IX1214.2 +052500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX1214.2 +052600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX1214.2 +052700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX1214.2 +052800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX1214.2 +052900 MOVE "****TEST DELETED****" TO RE-MARK. IX1214.2 +053000 PRINT-DETAIL. IX1214.2 +053100 IF REC-CT NOT EQUAL TO ZERO IX1214.2 +053200 MOVE "." TO PARDOT-X IX1214.2 +053300 MOVE REC-CT TO DOTVALUE. IX1214.2 +053400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX1214.2 +053500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX1214.2 +053600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX1214.2 +053700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX1214.2 +053800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX1214.2 +053900 MOVE SPACE TO CORRECT-X. IX1214.2 +054000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX1214.2 +054100 MOVE SPACE TO RE-MARK. IX1214.2 +054200 HEAD-ROUTINE. IX1214.2 +054300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +054400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +054500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1214.2 +054600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX1214.2 +054700 COLUMN-NAMES-ROUTINE. IX1214.2 +054800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +054900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +055000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +055100 END-ROUTINE. IX1214.2 +055200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX1214.2 +055300 END-RTN-EXIT. IX1214.2 +055400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +055500 END-ROUTINE-1. IX1214.2 +055600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX1214.2 +055700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX1214.2 +055800 ADD PASS-COUNTER TO ERROR-HOLD. IX1214.2 +055900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX1214.2 +056000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX1214.2 +056100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX1214.2 +056200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX1214.2 +056300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX1214.2 +056400 END-ROUTINE-12. IX1214.2 +056500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX1214.2 +056600 IF ERROR-COUNTER IS EQUAL TO ZERO IX1214.2 +056700 MOVE "NO " TO ERROR-TOTAL IX1214.2 +056800 ELSE IX1214.2 +056900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX1214.2 +057000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX1214.2 +057100 PERFORM WRITE-LINE. IX1214.2 +057200 END-ROUTINE-13. IX1214.2 +057300 IF DELETE-COUNTER IS EQUAL TO ZERO IX1214.2 +057400 MOVE "NO " TO ERROR-TOTAL ELSE IX1214.2 +057500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX1214.2 +057600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX1214.2 +057700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +057800 IF INSPECT-COUNTER EQUAL TO ZERO IX1214.2 +057900 MOVE "NO " TO ERROR-TOTAL IX1214.2 +058000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX1214.2 +058100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX1214.2 +058200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +058300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX1214.2 +058400 WRITE-LINE. IX1214.2 +058500 ADD 1 TO RECORD-COUNT. IX1214.2 +058600 IF RECORD-COUNT GREATER 42 IX1214.2 +058700 MOVE DUMMY-RECORD TO DUMMY-HOLD IX1214.2 +058800 MOVE SPACE TO DUMMY-RECORD IX1214.2 +058900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX1214.2 +059000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1214.2 +059100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX1214.2 +059200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1214.2 +059300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX1214.2 +059400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX1214.2 +059500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX1214.2 +059600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX1214.2 +059700 MOVE DUMMY-HOLD TO DUMMY-RECORD IX1214.2 +059800 MOVE ZERO TO RECORD-COUNT. IX1214.2 +059900 PERFORM WRT-LN. IX1214.2 +060000 WRT-LN. IX1214.2 +060100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX1214.2 +060200 MOVE SPACE TO DUMMY-RECORD. IX1214.2 +060300 BLANK-LINE-PRINT. IX1214.2 +060400 PERFORM WRT-LN. IX1214.2 +060500 FAIL-ROUTINE. IX1214.2 +060600 IF COMPUTED-X NOT EQUAL TO SPACE IX1214.2 +060700 GO TO FAIL-ROUTINE-WRITE. IX1214.2 +060800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX1214.2 +060900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1214.2 +061000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX1214.2 +061100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +061200 MOVE SPACES TO INF-ANSI-REFERENCE. IX1214.2 +061300 GO TO FAIL-ROUTINE-EX. IX1214.2 +061400 FAIL-ROUTINE-WRITE. IX1214.2 +061500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX1214.2 +061600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX1214.2 +061700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX1214.2 +061800 MOVE SPACES TO COR-ANSI-REFERENCE. IX1214.2 +061900 FAIL-ROUTINE-EX. EXIT. IX1214.2 +062000 BAIL-OUT. IX1214.2 +062100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX1214.2 +062200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX1214.2 +062300 BAIL-OUT-WRITE. IX1214.2 +062400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX1214.2 +062500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX1214.2 +062600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX1214.2 +062700 MOVE SPACES TO INF-ANSI-REFERENCE. IX1214.2 +062800 BAIL-OUT-EX. EXIT. IX1214.2 +062900 CCVS1-EXIT. IX1214.2 +063000 EXIT. IX1214.2 +063100 IX1214.2 +063200 SECT-IX121A-0003 SECTION. IX1214.2 +063300 SEQ-INIT-010. IX1214.2 +063400 MOVE "IX-VS2" TO XFILE-NAME (1). IX1214.2 +063500 MOVE "R1-F-G" TO XRECORD-NAME (1). IX1214.2 +063600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX1214.2 +063700 MOVE 000240 TO XRECORD-LENGTH (1). IX1214.2 +063800 MOVE "RC" TO CHARS-OR-RECORDS (1). IX1214.2 +063900 MOVE 0002 TO XBLOCK-SIZE (1). IX1214.2 +064000 MOVE 000050 TO RECORDS-IN-FILE (1). IX1214.2 +064100 MOVE "IX" TO XFILE-ORGANIZATION (1). IX1214.2 +064200 MOVE "S" TO XLABEL-TYPE (1). IX1214.2 +064300 MOVE 000001 TO XRECORD-NUMBER (1). IX1214.2 +064400 MOVE 0 TO COUNT-OF-RECS. IX1214.2 +064500 IX1214.2 +064600******************************************************************IX1214.2 +064700* TEST 1 *IX1214.2 +064800* OPEN OUTPUT ... 00 EXPECTED *IX1214.2 +064900* IX-3, 1.3.4 (1) a *IX1214.2 +065000* STATUS 00 CHECK ON OUTPUT FILE IX-VS2 *IX1214.2 +065100* THE OUTPUT STATEMENT IS SUCCESSFULLY EXECUTED *IX1214.2 +065200******************************************************************IX1214.2 +065300 OPN-INIT-GF-01-0. IX1214.2 +065400 ADD 1 TO TEST-NUMBER. IX1214.2 +065500 MOVE 1 TO STATUS-TEST-00. IX1214.2 +065600 MOVE SPACES TO IX-VS2-STATUS. IX1214.2 +065700 MOVE "OPEN OUTPUT: 00 EXP." TO FEATURE. IX1214.2 +065800 MOVE "OPN-TEST-GF-01-0" TO PAR-NAME. IX1214.2 +065900 OPEN IX1214.2 +066000 OUTPUT IX-VS2. IX1214.2 +066100 IF IX-VS2-STATUS EQUAL TO "00" IX1214.2 +066200 GO TO OPN-PASS-GF-01-0. IX1214.2 +066300 OPN-FAIL-GF-01-0. IX1214.2 +066400 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1214.2 +066500 PERFORM FAIL. IX1214.2 +066600 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1214.2 +066700 MOVE "00" TO CORRECT-X. IX1214.2 +066800 GO TO OPN-WRITE-GF-01-0. IX1214.2 +066900 OPN-PASS-GF-01-0. IX1214.2 +067000 PERFORM PASS. IX1214.2 +067100 OPN-WRITE-GF-01-0. IX1214.2 +067200 PERFORM PRINT-DETAIL. IX1214.2 +067300******************************************************************IX1214.2 +067400* TEST 2 *IX1214.2 +067500* WRITE 00 EXPECTED *IX1214.2 +067600* IX-3, 1.3.4 (1) a *IX1214.2 +067700* CREATING A INDEXED FILE WITH 50 RECORDS *IX1214.2 +067800* KEY: FROM 000000001 TO 000000050 *IX1214.2 +067900******************************************************************IX1214.2 +068000 WRI-INIT-GF-01-0. IX1214.2 +068100 ADD 1 TO TEST-NUMBER. IX1214.2 +068200 MOVE SPACES TO IX-VS2-STATUS. IX1214.2 +068300 MOVE 0 TO STATUS-TEST-00. IX1214.2 +068400 MOVE "WRITE: 00 EXPECTED" TO FEATURE. IX1214.2 +068500 MOVE "WRI-TEST-GF-01-0" TO PAR-NAME. IX1214.2 +068600 WRI-TEST-GF-01-0. IX1214.2 +068700 MOVE XRECORD-NUMBER (1) TO GRP-0101-KEY, COUNT-OF-RECS. IX1214.2 +068800 MOVE GRP-0101 TO XRECORD-KEY (1). IX1214.2 +068900 MOVE GRP-0102 TO ALTERNATE-KEY1 (1). IX1214.2 +069000* THE VALUE OF THE ALTERNATE KEY IS 50 TIMES UNCHANGED *IX1214.2 +069100 MOVE FILE-RECORD-INFO (1) TO IX-VS2R1-F-G-240. IX1214.2 +069200 WRITE IX-VS2R1-F-G-240. IX1214.2 +069300 IF IX-VS2-STATUS NOT = "00" IX1214.2 +069400 MOVE 1 TO STATUS-TEST-00 IX1214.2 +069500 GO TO WRI-FAIL-GF-01-0. IX1214.2 +069600 IF XRECORD-NUMBER (1) EQUAL TO 50 IX1214.2 +069700 GO TO WRI-TEST-GF-01-1. IX1214.2 +069800 ADD 1 TO XRECORD-NUMBER (1). IX1214.2 +069900 GO TO WRI-TEST-GF-01-0. IX1214.2 +070000 WRI-TEST-GF-01-1. IX1214.2 +070100 IF RECORDS-IN-ERROR EQUAL TO ZERO IX1214.2 +070200 GO TO WRI-PASS-GF-01-0. IX1214.2 +070300 MOVE "ERROR IN CREATING FILE" TO RE-MARK. IX1214.2 +070400 WRI-FAIL-GF-01-0. IX1214.2 +070500 MOVE "IX-3, 1.3.4, (1) a. " TO RE-MARK. IX1214.2 +070600 PERFORM FAIL. IX1214.2 +070700 MOVE "RECORDS WRITTEN =" TO COMPUTED-A. IX1214.2 +070800 GO TO WRI-WRITE-GF-01-0. IX1214.2 +070900 WRI-PASS-GF-01-0. IX1214.2 +071000 PERFORM PASS. IX1214.2 +071100 WRI-WRITE-GF-01-0. IX1214.2 +071200 PERFORM PRINT-DETAIL. IX1214.2 +071300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. IX1214.2 +071400 MOVE "CREATE FILE IX-VS2" TO FEATURE. IX1214.2 +071500 MOVE "WRI-TEST-GF-01-1" TO PAR-NAME. IX1214.2 +071600 MOVE COUNT-OF-RECS TO CORRECT-18V0. IX1214.2 +071700 PERFORM PRINT-DETAIL. IX1214.2 +071800******************************************************************IX1214.2 +071900* TEST 3 *IX1214.2 +072000* REWRITE (WITH WRONG RECORD LENGTH (SHORTER)) *IX1214.2 +072100* IX-5, 1.3.4 (5) d 1 & 2 *IX1214.2 +072200* FILE STATUS 00 OR 44 EXPECTED *IX1214.2 +072300* KEY: 000000005 *IX1214.2 +072400******************************************************************IX1214.2 +072500 RWR-INIT-GF-01-0. IX1214.2 +072600 ADD 1 TO TEST-NUMBER. IX1214.2 +072700 CLOSE IX-VS2. IX1214.2 +072800 OPEN I-O IX-VS2. IX1214.2 +072900 MOVE SPACES TO IX-VS2-STATUS. IX1214.2 +073000 MOVE 0 TO STATUS-TEST-00. IX1214.2 +073100 MOVE "RWRTE LG. 00/44 EXP." TO FEATURE. IX1214.2 +073200 MOVE "RWR-TEST-GF-01-0" TO PAR-NAME. IX1214.2 +073300 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073400 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073500 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073600 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073700 READ IX-VS2 AT END GO TO RWR-TEST-GF-01-0. IX1214.2 +073800 RWR-TEST-GF-01-0. IX1214.2 +073900 MOVE "WRONG RECORD LENGTH ( LONGER )" TO IX-VS2-REC-LONG. IX1214.2 +074000 REWRITE IX-VS2R1-F-G-280. IX1214.2 +074100 RWR-TEST-GF-01-1. IX1214.2 +074200 IF IX-VS2-STATUS = "00" IX1214.2 +074300 GO TO RWR-PASS-GF-01-0. IX1214.2 +074400 IF IX-VS2-STATUS = "44" IX1214.2 +074500 GO TO RWR-PASS-GF-01-0. IX1214.2 +074600 RWR-FAIL-GF-01-0. IX1214.2 +074700 MOVE "IX-5, 1.3.4, (5) D 1 & 2; LONG RECORD" TO RE-MARK. IX1214.2 +074800 PERFORM FAIL. IX1214.2 +074900 MOVE IX-VS2-STATUS TO COMPUTED-A. IX1214.2 +075000 MOVE "00 OR 44" TO CORRECT-X. IX1214.2 +075100 GO TO RWR-WRITE-GF-01-0. IX1214.2 +075200 RWR-PASS-GF-01-0. IX1214.2 +075300 PERFORM PASS. IX1214.2 +075400 RWR-WRITE-GF-01-0. IX1214.2 +075500 PERFORM PRINT-DETAIL. IX1214.2 +075600 IX1214.2 +075700 TERMINATE-ROUTINE. IX1214.2 +075800 EXIT. IX1214.2 +075900 IX1214.2 +076000 CCVS-EXIT SECTION. IX1214.2 +076100 CCVS-999999. IX1214.2 +076200 GO TO CLOSE-FILES. IX1214.2 diff --git a/tests/cobol85/IX/IX201A.CBL b/tests/cobol85/IX/IX201A.CBL new file mode 100755 index 00000000..924cc4e1 --- /dev/null +++ b/tests/cobol85/IX/IX201A.CBL @@ -0,0 +1,506 @@ +000100 IDENTIFICATION DIVISION. IX2014.2 +000200 PROGRAM-ID. IX2014.2 +000300 IX201A. IX2014.2 +000400**************************************************************** IX2014.2 +000500* * IX2014.2 +000600* VALIDATION FOR:- * IX2014.2 +000700* * IX2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2014.2 +000900* * IX2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2014.2 +001100* * IX2014.2 +001200**************************************************************** IX2014.2 +001300* THIS PROGRAM IS THE FIRST OF A SERIES WHICH PROCESSES AN IX2014.2 +001400* INDEXED FILE. THE FUNCTION OF THIS PROGRAM IS TO CREATE AN IX2014.2 +001500* INDEXED FILE SEQUENTIALLY (ACCESS MODE SEQUENTIAL) AND VERIFYIX2014.2 +001600* THAT IT WAS CREATED CORRECTLY. THE FILE IS IDENTIFIED AS IX2014.2 +001700* "IX-FS1" AND IS PASSED TO IX202 FOR PROCESSING. IX2014.2 +001800* IX2014.2 +001900* IX2014.2 +002000* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2014.2 +002100* IX2014.2 +002200* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2014.2 +002300* CLAUSE FOR DATA FILE IX-FS1 IX2014.2 +002400* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2014.2 +002500* CLAUSE FOR INDEX FILE IX-FS1 IX2014.2 +002600* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2014.2 +002700* X-62 FOR RAW-DATA IX2014.2 +002800* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2014.2 +002900* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2014.2 +003000* IX2014.2 +003100* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX2014.2 +003200* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2014.2 +003300* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2014.2 +003400* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2014.2 +003500* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2014.2 +003600* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2014.2 +003700* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2014.2 +003800* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2014.2 +003900* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2014.2 +004000* THEY ARE AS FOLLOWS IX2014.2 +004100* IX2014.2 +004200* P SELECTS X-CARDS 62 IX2014.2 +004300* J SELECTS X-CARD 44 IX2014.2 +004400* IX2014.2 +004500****************************************************** IX2014.2 +004600 ENVIRONMENT DIVISION. IX2014.2 +004700 CONFIGURATION SECTION. IX2014.2 +004800 SOURCE-COMPUTER. IX2014.2 +004900 Linux. IX2014.2 +005000 OBJECT-COMPUTER. IX2014.2 +005100 Linux. IX2014.2 +005200 INPUT-OUTPUT SECTION. IX2014.2 +005300 FILE-CONTROL. IX2014.2 +005400*P SELECT RAW-DATA ASSIGN TO IX2014.2 +005500*P "XXXXX062" IX2014.2 +005600*P ORGANIZATION IS INDEXED IX2014.2 +005700*P ACCESS MODE IS RANDOM IX2014.2 +005800*P RECORD KEY IS RAW-DATA-KEY. IX2014.2 +005900 SELECT PRINT-FILE ASSIGN TO IX2014.2 +006000 "report.log". IX2014.2 +006100 SELECT IX-FS1 ASSIGN TO IX2014.2 +006200 "XXXXX024" IX2014.2 +006300*J **** X-CARD UNDEFINED **** IX2014.2 +006400 ORGANIZATION IS INDEXED IX2014.2 +006500 RECORD KEY IS IX-FS1-KEY IX2014.2 +006600 ACCESS MODE IS SEQUENTIAL. IX2014.2 +006700 DATA DIVISION. IX2014.2 +006800 FILE SECTION. IX2014.2 +006900*P IX2014.2 +007000*PD RAW-DATA. IX2014.2 +007100*P IX2014.2 +007200*P1 RAW-DATA-SATZ. IX2014.2 +007300*P 05 RAW-DATA-KEY PIC X(6). IX2014.2 +007400*P 05 C-DATE PIC 9(6). IX2014.2 +007500*P 05 C-TIME PIC 9(8). IX2014.2 +007600*P 05 C-NO-OF-TESTS PIC 99. IX2014.2 +007700*P 05 C-OK PIC 999. IX2014.2 +007800*P 05 C-ALL PIC 999. IX2014.2 +007900*P 05 C-FAIL PIC 999. IX2014.2 +008000*P 05 C-DELETED PIC 999. IX2014.2 +008100*P 05 C-INSPECT PIC 999. IX2014.2 +008200*P 05 C-NOTE PIC X(13). IX2014.2 +008300*P 05 C-INDENT PIC X. IX2014.2 +008400*P 05 C-ABORT PIC X(8). IX2014.2 +008500 FD PRINT-FILE. IX2014.2 +008600 01 PRINT-REC PICTURE X(120). IX2014.2 +008700 01 DUMMY-RECORD PICTURE X(120). IX2014.2 +008800 FD IX-FS1 IX2014.2 +008900*C LABEL RECORD IS STANDARD IX2014.2 +009000*C DATA RECORD IS IX-FS1R1-F-G-240 IX2014.2 +009100 BLOCK CONTAINS 1 RECORDS IX2014.2 +009200 RECORD CONTAINS 240 CHARACTERS. IX2014.2 +009300 01 IX-FS1R1-F-G-240. IX2014.2 +009400 03 IX-FS1-WRK-120 PIC X(120). IX2014.2 +009500 03 IX-FS1-GRP-120. IX2014.2 +009600 05 FILLER PIC X(8). IX2014.2 +009700 05 IX-FS1-KEY PIC X(29). IX2014.2 +009800 05 FILLER PIC X(83). IX2014.2 +009900 WORKING-STORAGE SECTION. IX2014.2 +010000 01 GRP-0101. IX2014.2 +010100 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX2014.2 +010200 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2014.2 +010300 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX2014.2 +010400 01 FILE-RECORD-INFORMATION-REC. IX2014.2 +010500 03 FILE-RECORD-INFO-SKELETON. IX2014.2 +010600 05 FILLER PICTURE X(48) VALUE IX2014.2 +010700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2014.2 +010800 05 FILLER PICTURE X(46) VALUE IX2014.2 +010900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2014.2 +011000 05 FILLER PICTURE X(26) VALUE IX2014.2 +011100 ",LFIL=000000,ORG= ,LBLR= ". IX2014.2 +011200 05 FILLER PICTURE X(37) VALUE IX2014.2 +011300 ",RECKEY= ". IX2014.2 +011400 05 FILLER PICTURE X(38) VALUE IX2014.2 +011500 ",ALTKEY1= ". IX2014.2 +011600 05 FILLER PICTURE X(38) VALUE IX2014.2 +011700 ",ALTKEY2= ". IX2014.2 +011800 05 FILLER PICTURE X(7) VALUE SPACE.IX2014.2 +011900 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2014.2 +012000 05 FILE-RECORD-INFO-P1-120. IX2014.2 +012100 07 FILLER PIC X(5). IX2014.2 +012200 07 XFILE-NAME PIC X(6). IX2014.2 +012300 07 FILLER PIC X(8). IX2014.2 +012400 07 XRECORD-NAME PIC X(6). IX2014.2 +012500 07 FILLER PIC X(1). IX2014.2 +012600 07 REELUNIT-NUMBER PIC 9(1). IX2014.2 +012700 07 FILLER PIC X(7). IX2014.2 +012800 07 XRECORD-NUMBER PIC 9(6). IX2014.2 +012900 07 FILLER PIC X(6). IX2014.2 +013000 07 UPDATE-NUMBER PIC 9(2). IX2014.2 +013100 07 FILLER PIC X(5). IX2014.2 +013200 07 ODO-NUMBER PIC 9(4). IX2014.2 +013300 07 FILLER PIC X(5). IX2014.2 +013400 07 XPROGRAM-NAME PIC X(5). IX2014.2 +013500 07 FILLER PIC X(7). IX2014.2 +013600 07 XRECORD-LENGTH PIC 9(6). IX2014.2 +013700 07 FILLER PIC X(7). IX2014.2 +013800 07 CHARS-OR-RECORDS PIC X(2). IX2014.2 +013900 07 FILLER PIC X(1). IX2014.2 +014000 07 XBLOCK-SIZE PIC 9(4). IX2014.2 +014100 07 FILLER PIC X(6). IX2014.2 +014200 07 RECORDS-IN-FILE PIC 9(6). IX2014.2 +014300 07 FILLER PIC X(5). IX2014.2 +014400 07 XFILE-ORGANIZATION PIC X(2). IX2014.2 +014500 07 FILLER PIC X(6). IX2014.2 +014600 07 XLABEL-TYPE PIC X(1). IX2014.2 +014700 05 FILE-RECORD-INFO-P121-240. IX2014.2 +014800 07 FILLER PIC X(8). IX2014.2 +014900 07 XRECORD-KEY PIC X(29). IX2014.2 +015000 07 FILLER PIC X(9). IX2014.2 +015100 07 ALTERNATE-KEY1 PIC X(29). IX2014.2 +015200 07 FILLER PIC X(9). IX2014.2 +015300 07 ALTERNATE-KEY2 PIC X(29). IX2014.2 +015400 07 FILLER PIC X(7). IX2014.2 +015500 01 TEST-RESULTS. IX2014.2 +015600 02 FILLER PIC X VALUE SPACE. IX2014.2 +015700 02 FEATURE PIC X(20) VALUE SPACE. IX2014.2 +015800 02 FILLER PIC X VALUE SPACE. IX2014.2 +015900 02 P-OR-F PIC X(5) VALUE SPACE. IX2014.2 +016000 02 FILLER PIC X VALUE SPACE. IX2014.2 +016100 02 PAR-NAME. IX2014.2 +016200 03 FILLER PIC X(19) VALUE SPACE. IX2014.2 +016300 03 PARDOT-X PIC X VALUE SPACE. IX2014.2 +016400 03 DOTVALUE PIC 99 VALUE ZERO. IX2014.2 +016500 02 FILLER PIC X(8) VALUE SPACE. IX2014.2 +016600 02 RE-MARK PIC X(61). IX2014.2 +016700 01 TEST-COMPUTED. IX2014.2 +016800 02 FILLER PIC X(30) VALUE SPACE. IX2014.2 +016900 02 FILLER PIC X(17) VALUE IX2014.2 +017000 " COMPUTED=". IX2014.2 +017100 02 COMPUTED-X. IX2014.2 +017200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2014.2 +017300 03 COMPUTED-N REDEFINES COMPUTED-A IX2014.2 +017400 PIC -9(9).9(9). IX2014.2 +017500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2014.2 +017600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2014.2 +017700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2014.2 +017800 03 CM-18V0 REDEFINES COMPUTED-A. IX2014.2 +017900 04 COMPUTED-18V0 PIC -9(18). IX2014.2 +018000 04 FILLER PIC X. IX2014.2 +018100 03 FILLER PIC X(50) VALUE SPACE. IX2014.2 +018200 01 TEST-CORRECT. IX2014.2 +018300 02 FILLER PIC X(30) VALUE SPACE. IX2014.2 +018400 02 FILLER PIC X(17) VALUE " CORRECT =". IX2014.2 +018500 02 CORRECT-X. IX2014.2 +018600 03 CORRECT-A PIC X(20) VALUE SPACE. IX2014.2 +018700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2014.2 +018800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2014.2 +018900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2014.2 +019000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2014.2 +019100 03 CR-18V0 REDEFINES CORRECT-A. IX2014.2 +019200 04 CORRECT-18V0 PIC -9(18). IX2014.2 +019300 04 FILLER PIC X. IX2014.2 +019400 03 FILLER PIC X(2) VALUE SPACE. IX2014.2 +019500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2014.2 +019600 01 CCVS-C-1. IX2014.2 +019700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2014.2 +019800- "SS PARAGRAPH-NAME IX2014.2 +019900- " REMARKS". IX2014.2 +020000 02 FILLER PIC X(20) VALUE SPACE. IX2014.2 +020100 01 CCVS-C-2. IX2014.2 +020200 02 FILLER PIC X VALUE SPACE. IX2014.2 +020300 02 FILLER PIC X(6) VALUE "TESTED". IX2014.2 +020400 02 FILLER PIC X(15) VALUE SPACE. IX2014.2 +020500 02 FILLER PIC X(4) VALUE "FAIL". IX2014.2 +020600 02 FILLER PIC X(94) VALUE SPACE. IX2014.2 +020700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2014.2 +020800 01 REC-CT PIC 99 VALUE ZERO. IX2014.2 +020900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2014.2 +021000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2014.2 +021100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2014.2 +021200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2014.2 +021300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2014.2 +021400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2014.2 +021500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2014.2 +021600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2014.2 +021700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2014.2 +021800 01 CCVS-H-1. IX2014.2 +021900 02 FILLER PIC X(39) VALUE SPACES. IX2014.2 +022000 02 FILLER PIC X(42) VALUE IX2014.2 +022100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2014.2 +022200 02 FILLER PIC X(39) VALUE SPACES. IX2014.2 +022300 01 CCVS-H-2A. IX2014.2 +022400 02 FILLER PIC X(40) VALUE SPACE. IX2014.2 +022500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2014.2 +022600 02 FILLER PIC XXXX VALUE IX2014.2 +022700 "4.2 ". IX2014.2 +022800 02 FILLER PIC X(28) VALUE IX2014.2 +022900 " COPY - NOT FOR DISTRIBUTION". IX2014.2 +023000 02 FILLER PIC X(41) VALUE SPACE. IX2014.2 +023100 IX2014.2 +023200 01 CCVS-H-2B. IX2014.2 +023300 02 FILLER PIC X(15) VALUE IX2014.2 +023400 "TEST RESULT OF ". IX2014.2 +023500 02 TEST-ID PIC X(9). IX2014.2 +023600 02 FILLER PIC X(4) VALUE IX2014.2 +023700 " IN ". IX2014.2 +023800 02 FILLER PIC X(12) VALUE IX2014.2 +023900 " HIGH ". IX2014.2 +024000 02 FILLER PIC X(22) VALUE IX2014.2 +024100 " LEVEL VALIDATION FOR ". IX2014.2 +024200 02 FILLER PIC X(58) VALUE IX2014.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2014.2 +024400 01 CCVS-H-3. IX2014.2 +024500 02 FILLER PIC X(34) VALUE IX2014.2 +024600 " FOR OFFICIAL USE ONLY ". IX2014.2 +024700 02 FILLER PIC X(58) VALUE IX2014.2 +024800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2014.2 +024900 02 FILLER PIC X(28) VALUE IX2014.2 +025000 " COPYRIGHT 1985 ". IX2014.2 +025100 01 CCVS-E-1. IX2014.2 +025200 02 FILLER PIC X(52) VALUE SPACE. IX2014.2 +025300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2014.2 +025400 02 ID-AGAIN PIC X(9). IX2014.2 +025500 02 FILLER PIC X(45) VALUE SPACES. IX2014.2 +025600 01 CCVS-E-2. IX2014.2 +025700 02 FILLER PIC X(31) VALUE SPACE. IX2014.2 +025800 02 FILLER PIC X(21) VALUE SPACE. IX2014.2 +025900 02 CCVS-E-2-2. IX2014.2 +026000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2014.2 +026100 03 FILLER PIC X VALUE SPACE. IX2014.2 +026200 03 ENDER-DESC PIC X(44) VALUE IX2014.2 +026300 "ERRORS ENCOUNTERED". IX2014.2 +026400 01 CCVS-E-3. IX2014.2 +026500 02 FILLER PIC X(22) VALUE IX2014.2 +026600 " FOR OFFICIAL USE ONLY". IX2014.2 +026700 02 FILLER PIC X(12) VALUE SPACE. IX2014.2 +026800 02 FILLER PIC X(58) VALUE IX2014.2 +026900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2014.2 +027000 02 FILLER PIC X(13) VALUE SPACE. IX2014.2 +027100 02 FILLER PIC X(15) VALUE IX2014.2 +027200 " COPYRIGHT 1985". IX2014.2 +027300 01 CCVS-E-4. IX2014.2 +027400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2014.2 +027500 02 FILLER PIC X(4) VALUE " OF ". IX2014.2 +027600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2014.2 +027700 02 FILLER PIC X(40) VALUE IX2014.2 +027800 " TESTS WERE EXECUTED SUCCESSFULLY". IX2014.2 +027900 01 XXINFO. IX2014.2 +028000 02 FILLER PIC X(19) VALUE IX2014.2 +028100 "*** INFORMATION ***". IX2014.2 +028200 02 INFO-TEXT. IX2014.2 +028300 04 FILLER PIC X(8) VALUE SPACE. IX2014.2 +028400 04 XXCOMPUTED PIC X(20). IX2014.2 +028500 04 FILLER PIC X(5) VALUE SPACE. IX2014.2 +028600 04 XXCORRECT PIC X(20). IX2014.2 +028700 02 INF-ANSI-REFERENCE PIC X(48). IX2014.2 +028800 01 HYPHEN-LINE. IX2014.2 +028900 02 FILLER PIC IS X VALUE IS SPACE. IX2014.2 +029000 02 FILLER PIC IS X(65) VALUE IS "************************IX2014.2 +029100- "*****************************************". IX2014.2 +029200 02 FILLER PIC IS X(54) VALUE IS "************************IX2014.2 +029300- "******************************". IX2014.2 +029400 01 CCVS-PGM-ID PIC X(9) VALUE IX2014.2 +029500 "IX201A". IX2014.2 +029600 PROCEDURE DIVISION. IX2014.2 +029700 CCVS1 SECTION. IX2014.2 +029800 OPEN-FILES. IX2014.2 +029900*P OPEN I-O RAW-DATA. IX2014.2 +030000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2014.2 +030100*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2014.2 +030200*P MOVE "ABORTED " TO C-ABORT. IX2014.2 +030300*P ADD 1 TO C-NO-OF-TESTS. IX2014.2 +030400*P ACCEPT C-DATE FROM DATE. IX2014.2 +030500*P ACCEPT C-TIME FROM TIME. IX2014.2 +030600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2014.2 +030700*PND-E-1. IX2014.2 +030800*P CLOSE RAW-DATA. IX2014.2 +030900 OPEN OUTPUT PRINT-FILE. IX2014.2 +031000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2014.2 +031100 MOVE SPACE TO TEST-RESULTS. IX2014.2 +031200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2014.2 +031300 MOVE ZERO TO REC-SKL-SUB. IX2014.2 +031400 PERFORM CCVS-INIT-FILE 9 TIMES. IX2014.2 +031500 CCVS-INIT-FILE. IX2014.2 +031600 ADD 1 TO REC-SKL-SUB. IX2014.2 +031700 MOVE FILE-RECORD-INFO-SKELETON IX2014.2 +031800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2014.2 +031900 CCVS-INIT-EXIT. IX2014.2 +032000 GO TO CCVS1-EXIT. IX2014.2 +032100 CLOSE-FILES. IX2014.2 +032200*P OPEN I-O RAW-DATA. IX2014.2 +032300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2014.2 +032400*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2014.2 +032500*P MOVE "OK. " TO C-ABORT. IX2014.2 +032600*P MOVE PASS-COUNTER TO C-OK. IX2014.2 +032700*P MOVE ERROR-HOLD TO C-ALL. IX2014.2 +032800*P MOVE ERROR-COUNTER TO C-FAIL. IX2014.2 +032900*P MOVE DELETE-COUNTER TO C-DELETED. IX2014.2 +033000*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2014.2 +033100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2014.2 +033200*PND-E-2. IX2014.2 +033300*P CLOSE RAW-DATA. IX2014.2 +033400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2014.2 +033500 TERMINATE-CCVS. IX2014.2 +033600*S EXIT PROGRAM. IX2014.2 +033700*SERMINATE-CALL. IX2014.2 +033800 STOP RUN. IX2014.2 +033900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2014.2 +034000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2014.2 +034100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2014.2 +034200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2014.2 +034300 MOVE "****TEST DELETED****" TO RE-MARK. IX2014.2 +034400 PRINT-DETAIL. IX2014.2 +034500 IF REC-CT NOT EQUAL TO ZERO IX2014.2 +034600 MOVE "." TO PARDOT-X IX2014.2 +034700 MOVE REC-CT TO DOTVALUE. IX2014.2 +034800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2014.2 +034900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2014.2 +035000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2014.2 +035100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2014.2 +035200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2014.2 +035300 MOVE SPACE TO CORRECT-X. IX2014.2 +035400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2014.2 +035500 MOVE SPACE TO RE-MARK. IX2014.2 +035600 HEAD-ROUTINE. IX2014.2 +035700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +035800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +035900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2014.2 +036000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2014.2 +036100 COLUMN-NAMES-ROUTINE. IX2014.2 +036200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +036300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +036400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +036500 END-ROUTINE. IX2014.2 +036600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2014.2 +036700 END-RTN-EXIT. IX2014.2 +036800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +036900 END-ROUTINE-1. IX2014.2 +037000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2014.2 +037100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2014.2 +037200 ADD PASS-COUNTER TO ERROR-HOLD. IX2014.2 +037300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2014.2 +037400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2014.2 +037500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2014.2 +037600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2014.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2014.2 +037800 END-ROUTINE-12. IX2014.2 +037900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2014.2 +038000 IF ERROR-COUNTER IS EQUAL TO ZERO IX2014.2 +038100 MOVE "NO " TO ERROR-TOTAL IX2014.2 +038200 ELSE IX2014.2 +038300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2014.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2014.2 +038500 PERFORM WRITE-LINE. IX2014.2 +038600 END-ROUTINE-13. IX2014.2 +038700 IF DELETE-COUNTER IS EQUAL TO ZERO IX2014.2 +038800 MOVE "NO " TO ERROR-TOTAL ELSE IX2014.2 +038900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2014.2 +039000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2014.2 +039100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +039200 IF INSPECT-COUNTER EQUAL TO ZERO IX2014.2 +039300 MOVE "NO " TO ERROR-TOTAL IX2014.2 +039400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2014.2 +039500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2014.2 +039600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +039700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2014.2 +039800 WRITE-LINE. IX2014.2 +039900 ADD 1 TO RECORD-COUNT. IX2014.2 +040000 IF RECORD-COUNT GREATER 42 IX2014.2 +040100 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2014.2 +040200 MOVE SPACE TO DUMMY-RECORD IX2014.2 +040300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2014.2 +040400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2014.2 +040500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2014.2 +040600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2014.2 +040700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2014.2 +040800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2014.2 +040900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2014.2 +041000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2014.2 +041100 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2014.2 +041200 MOVE ZERO TO RECORD-COUNT. IX2014.2 +041300 PERFORM WRT-LN. IX2014.2 +041400 WRT-LN. IX2014.2 +041500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2014.2 +041600 MOVE SPACE TO DUMMY-RECORD. IX2014.2 +041700 BLANK-LINE-PRINT. IX2014.2 +041800 PERFORM WRT-LN. IX2014.2 +041900 FAIL-ROUTINE. IX2014.2 +042000 IF COMPUTED-X NOT EQUAL TO SPACE IX2014.2 +042100 GO TO FAIL-ROUTINE-WRITE. IX2014.2 +042200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2014.2 +042300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2014.2 +042400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2014.2 +042500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +042600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2014.2 +042700 GO TO FAIL-ROUTINE-EX. IX2014.2 +042800 FAIL-ROUTINE-WRITE. IX2014.2 +042900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2014.2 +043000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2014.2 +043100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2014.2 +043200 MOVE SPACES TO COR-ANSI-REFERENCE. IX2014.2 +043300 FAIL-ROUTINE-EX. EXIT. IX2014.2 +043400 BAIL-OUT. IX2014.2 +043500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2014.2 +043600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2014.2 +043700 BAIL-OUT-WRITE. IX2014.2 +043800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2014.2 +043900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2014.2 +044000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2014.2 +044100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2014.2 +044200 BAIL-OUT-EX. EXIT. IX2014.2 +044300 CCVS1-EXIT. IX2014.2 +044400 EXIT. IX2014.2 +044500 SECT-IX-01-001 SECTION. IX2014.2 +044600 WRITE-INIT-GF-01. IX2014.2 +044700 MOVE "WRITE IX-FS1" TO FEATURE. IX2014.2 +044800 OPEN OUTPUT IX-FS1. IX2014.2 +044900 MOVE "IX-FS1" TO XFILE-NAME (1). IX2014.2 +045000 MOVE "IX-F-G" TO XRECORD-NAME (1). IX2014.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2014.2 +045200 MOVE 000240 TO XRECORD-LENGTH (1). IX2014.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2014.2 +045400 MOVE 0001 TO XBLOCK-SIZE (1). IX2014.2 +045500 MOVE 000500 TO RECORDS-IN-FILE (1). IX2014.2 +045600 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2014.2 +045700 MOVE "S" TO XLABEL-TYPE (1). IX2014.2 +045800 MOVE 000001 TO XRECORD-NUMBER (1). IX2014.2 +045900 WRITE-TEST-GF-01. IX2014.2 +046000 MOVE XRECORD-NUMBER (1) TO WRK-DU-09V00-001. IX2014.2 +046100 MOVE GRP-0101 TO XRECORD-KEY (1). IX2014.2 +046200 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2014.2 +046300 WRITE IX-FS1R1-F-G-240 IX2014.2 +046400 INVALID KEY GO TO WRITE-FAIL-GF-01. IX2014.2 +046500 IF XRECORD-NUMBER (1) EQUAL TO 500 IX2014.2 +046600 PERFORM PASS IX2014.2 +046700 GO TO WRITE-WRITE-GF-01. IX2014.2 +046800 ADD 000001 TO XRECORD-NUMBER (1). IX2014.2 +046900 GO TO WRITE-TEST-GF-01. IX2014.2 +047000 WRITE-FAIL-GF-01. IX2014.2 +047100 MOVE "BOUNDARY VIOLATION. WRITE FAILED; IX-41" TO RE-MARK. IX2014.2 +047200 PERFORM FAIL. IX2014.2 +047300 WRITE-WRITE-GF-01. IX2014.2 +047400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME IX2014.2 +047500 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. IX2014.2 +047600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX2014.2 +047700 PERFORM PRINT-DETAIL. IX2014.2 +047800 CLOSE IX-FS1. IX2014.2 +047900 READ-INIT-F1-01. IX2014.2 +048000 OPEN INPUT IX-FS1. IX2014.2 +048100 MOVE ZERO TO WRK-DU-09V00-001. IX2014.2 +048200 READ-TEST-F1-01. IX2014.2 +048300 READ IX-FS1 IX2014.2 +048400 AT END GO TO READ-TEST-F1-01-1. IX2014.2 +048500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2014.2 +048600 ADD 1 TO WRK-DU-09V00-001. IX2014.2 +048700 IF WRK-DU-09V00-001 GREATER 500 IX2014.2 +048800 MOVE "MORE THAN 500 RECORDS" TO RE-MARK IX2014.2 +048900 GO TO READ-TEST-F1-01-1. IX2014.2 +049000 GO TO READ-TEST-F1-01. IX2014.2 +049100 READ-TEST-F1-01-1. IX2014.2 +049200 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 IX2014.2 +049300 MOVE "READ FAILED; IX-28, 4.5.2" TO RE-MARK IX2014.2 +049400 PERFORM FAIL IX2014.2 +049500 ELSE IX2014.2 +049600 PERFORM PASS. IX2014.2 +049700 READ-WRITE-F1-01. IX2014.2 +049800 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2014.2 +049900 MOVE "READ TO VERIFY " TO FEATURE. IX2014.2 +050000 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. IX2014.2 +050100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX2014.2 +050200 PERFORM PRINT-DETAIL. IX2014.2 +050300 CLOSE IX-FS1. IX2014.2 +050400 CCVS-EXIT SECTION. IX2014.2 +050500 CCVS-999999. IX2014.2 +050600 GO TO CLOSE-FILES. IX2014.2 diff --git a/tests/cobol85/IX/IX202A.SUB b/tests/cobol85/IX/IX202A.SUB new file mode 100755 index 00000000..92a0d7a6 --- /dev/null +++ b/tests/cobol85/IX/IX202A.SUB @@ -0,0 +1,664 @@ +000100 IDENTIFICATION DIVISION. IX2024.2 +000200 PROGRAM-ID. IX2024.2 +000300 IX202A. IX2024.2 +000400**************************************************************** IX2024.2 +000500* * IX2024.2 +000600* VALIDATION FOR:- * IX2024.2 +000700* * IX2024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2024.2 +000900* * IX2024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2024.2 +001100* * IX2024.2 +001200**************************************************************** IX2024.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO PROCESS AN INDEXED FILE IX2024.2 +001400* RANDOMLY USING THE ACCESS MODE IS DYNAMIC CLAUSE. THE FILE IX2024.2 +001500* USED AS INPUT IS THAT CREATED BY IX201A. IX2024.2 +001600* IX2024.2 +001700* FIRST THE FILE IS VERIFIED AS TO THE EXISTANCE AND ACCURACY IX2024.2 +001800* OF THE 500 RECORDS CREATED IN THE FIRST RUN UNIT. SECONDLY, IX2024.2 +001900* RECORDS OF THE FILE ARE SELECTIVELY UPDATED; AND THIRDLY, THEIX2024.2 +002000* ACCURACY OF EACH RECORD IN THE FILE IS AGAIN VERIFIED. IX2024.2 +002100* IX2024.2 +002200* IX2024.2 +002300* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2024.2 +002400* IX2024.2 +002500* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2024.2 +002600* CLAUSE FOR DATA FILE IX-FS1 IX2024.2 +002700* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2024.2 +002800* CLAUSE FOR INDEX FILE IX-FS1 IX2024.2 +002900* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2024.2 +003000* X-62 FOR RAW-DATA IX2024.2 +003100* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2024.2 +003200* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2024.2 +003300* IX2024.2 +003400* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX2024.2 +003500* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2024.2 +003600* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2024.2 +003700* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2024.2 +003800* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2024.2 +003900* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2024.2 +004000* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2024.2 +004100* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2024.2 +004200* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2024.2 +004300* THEY ARE AS FOLLOWS IX2024.2 +004400* IX2024.2 +004500* P SELECTS X-CARDS 62 IX2024.2 +004600* J SELECTS X-CARD 44 IX2024.2 +004700* IX2024.2 +004800****************************************************** IX2024.2 +004900 ENVIRONMENT DIVISION. IX2024.2 +005000 CONFIGURATION SECTION. IX2024.2 +005100 SOURCE-COMPUTER. IX2024.2 +005200 Linux. IX2024.2 +005300 OBJECT-COMPUTER. IX2024.2 +005400 Linux. IX2024.2 +005500 INPUT-OUTPUT SECTION. IX2024.2 +005600 FILE-CONTROL. IX2024.2 +005700*P SELECT RAW-DATA ASSIGN TO IX2024.2 +005800*P "XXXXX062" IX2024.2 +005900*P ORGANIZATION IS INDEXED IX2024.2 +006000*P ACCESS MODE IS RANDOM IX2024.2 +006100*P RECORD KEY IS RAW-DATA-KEY. IX2024.2 +006200 SELECT PRINT-FILE ASSIGN TO IX2024.2 +006300 "report.log". IX2024.2 +006400 SELECT IX-FD1 ASSIGN IX2024.2 +006500 "XXXXX024" IX2024.2 +006600*J **** X-CARD UNDEFINED **** IX2024.2 +006700 ACCESS MODE IS DYNAMIC IX2024.2 +006800 ; ORGANIZATION INDEXED IX2024.2 +006900 RECORD KEY IX-FD1-KEY. IX2024.2 +007000 DATA DIVISION. IX2024.2 +007100 FILE SECTION. IX2024.2 +007200*P IX2024.2 +007300*PD RAW-DATA. IX2024.2 +007400*P IX2024.2 +007500*P1 RAW-DATA-SATZ. IX2024.2 +007600*P 05 RAW-DATA-KEY PIC X(6). IX2024.2 +007700*P 05 C-DATE PIC 9(6). IX2024.2 +007800*P 05 C-TIME PIC 9(8). IX2024.2 +007900*P 05 C-NO-OF-TESTS PIC 99. IX2024.2 +008000*P 05 C-OK PIC 999. IX2024.2 +008100*P 05 C-ALL PIC 999. IX2024.2 +008200*P 05 C-FAIL PIC 999. IX2024.2 +008300*P 05 C-DELETED PIC 999. IX2024.2 +008400*P 05 C-INSPECT PIC 999. IX2024.2 +008500*P 05 C-NOTE PIC X(13). IX2024.2 +008600*P 05 C-INDENT PIC X. IX2024.2 +008700*P 05 C-ABORT PIC X(8). IX2024.2 +008800 FD PRINT-FILE. IX2024.2 +008900 01 PRINT-REC PICTURE X(120). IX2024.2 +009000 01 DUMMY-RECORD PICTURE X(120). IX2024.2 +009100 FD IX-FD1 IX2024.2 +009200*C LABEL RECORDS STANDARD IX2024.2 +009300*C DATA RECORD IX-FS1R1-F-G-240 IX2024.2 +009400 BLOCK 1 RECORDS IX2024.2 +009500 RECORD 240 CHARACTERS. IX2024.2 +009600 01 IX-FS1R1-F-G-240. IX2024.2 +009700 05 IX-FD1-REC-120 PIC X(120). IX2024.2 +009800 05 IX-FD1-REC-120-240. IX2024.2 +009900 10 FILLER PIC X(8). IX2024.2 +010000 10 IX-FD1-KEY PIC X(29). IX2024.2 +010100 10 FILLER PIC X(83). IX2024.2 +010200 WORKING-STORAGE SECTION. IX2024.2 +010300 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +010400 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. IX2024.2 +010500 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +010600 01 I-O-ERROR-IX-FD1 PIC X(3) VALUE "NO ". IX2024.2 +010700 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +010800 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +010900 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. IX2024.2 +011000 01 IX-WRK-KEY. IX2024.2 +011100 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX2024.2 +011200 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2024.2 +011300 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX2024.2 +011400 01 DUMMY-WRK-REC. IX2024.2 +011500 02 DUMMY-WRK1 PIC X(120). IX2024.2 +011600 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX2024.2 +011700 03 FILLER PIC X(5). IX2024.2 +011800 03 DUMMY-WRK-INDENT-5 PIC X(115). IX2024.2 +011900 01 FILE-RECORD-INFORMATION-REC. IX2024.2 +012000 03 FILE-RECORD-INFO-SKELETON. IX2024.2 +012100 05 FILLER PICTURE X(48) VALUE IX2024.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2024.2 +012300 05 FILLER PICTURE X(46) VALUE IX2024.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2024.2 +012500 05 FILLER PICTURE X(26) VALUE IX2024.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". IX2024.2 +012700 05 FILLER PICTURE X(37) VALUE IX2024.2 +012800 ",RECKEY= ". IX2024.2 +012900 05 FILLER PICTURE X(38) VALUE IX2024.2 +013000 ",ALTKEY1= ". IX2024.2 +013100 05 FILLER PICTURE X(38) VALUE IX2024.2 +013200 ",ALTKEY2= ". IX2024.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.IX2024.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2024.2 +013500 05 FILE-RECORD-INFO-P1-120. IX2024.2 +013600 07 FILLER PIC X(5). IX2024.2 +013700 07 XFILE-NAME PIC X(6). IX2024.2 +013800 07 FILLER PIC X(8). IX2024.2 +013900 07 XRECORD-NAME PIC X(6). IX2024.2 +014000 07 FILLER PIC X(1). IX2024.2 +014100 07 REELUNIT-NUMBER PIC 9(1). IX2024.2 +014200 07 FILLER PIC X(7). IX2024.2 +014300 07 XRECORD-NUMBER PIC 9(6). IX2024.2 +014400 07 FILLER PIC X(6). IX2024.2 +014500 07 UPDATE-NUMBER PIC 9(2). IX2024.2 +014600 07 FILLER PIC X(5). IX2024.2 +014700 07 ODO-NUMBER PIC 9(4). IX2024.2 +014800 07 FILLER PIC X(5). IX2024.2 +014900 07 XPROGRAM-NAME PIC X(5). IX2024.2 +015000 07 FILLER PIC X(7). IX2024.2 +015100 07 XRECORD-LENGTH PIC 9(6). IX2024.2 +015200 07 FILLER PIC X(7). IX2024.2 +015300 07 CHARS-OR-RECORDS PIC X(2). IX2024.2 +015400 07 FILLER PIC X(1). IX2024.2 +015500 07 XBLOCK-SIZE PIC 9(4). IX2024.2 +015600 07 FILLER PIC X(6). IX2024.2 +015700 07 RECORDS-IN-FILE PIC 9(6). IX2024.2 +015800 07 FILLER PIC X(5). IX2024.2 +015900 07 XFILE-ORGANIZATION PIC X(2). IX2024.2 +016000 07 FILLER PIC X(6). IX2024.2 +016100 07 XLABEL-TYPE PIC X(1). IX2024.2 +016200 05 FILE-RECORD-INFO-P121-240. IX2024.2 +016300 07 FILLER PIC X(8). IX2024.2 +016400 07 XRECORD-KEY PIC X(29). IX2024.2 +016500 07 FILLER PIC X(9). IX2024.2 +016600 07 ALTERNATE-KEY1 PIC X(29). IX2024.2 +016700 07 FILLER PIC X(9). IX2024.2 +016800 07 ALTERNATE-KEY2 PIC X(29). IX2024.2 +016900 07 FILLER PIC X(7). IX2024.2 +017000 01 TEST-RESULTS. IX2024.2 +017100 02 FILLER PIC X VALUE SPACE. IX2024.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. IX2024.2 +017300 02 FILLER PIC X VALUE SPACE. IX2024.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. IX2024.2 +017500 02 FILLER PIC X VALUE SPACE. IX2024.2 +017600 02 PAR-NAME. IX2024.2 +017700 03 FILLER PIC X(19) VALUE SPACE. IX2024.2 +017800 03 PARDOT-X PIC X VALUE SPACE. IX2024.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. IX2024.2 +018000 02 FILLER PIC X(8) VALUE SPACE. IX2024.2 +018100 02 RE-MARK PIC X(61). IX2024.2 +018200 01 TEST-COMPUTED. IX2024.2 +018300 02 FILLER PIC X(30) VALUE SPACE. IX2024.2 +018400 02 FILLER PIC X(17) VALUE IX2024.2 +018500 " COMPUTED=". IX2024.2 +018600 02 COMPUTED-X. IX2024.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2024.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A IX2024.2 +018900 PIC -9(9).9(9). IX2024.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2024.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2024.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2024.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. IX2024.2 +019400 04 COMPUTED-18V0 PIC -9(18). IX2024.2 +019500 04 FILLER PIC X. IX2024.2 +019600 03 FILLER PIC X(50) VALUE SPACE. IX2024.2 +019700 01 TEST-CORRECT. IX2024.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX2024.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". IX2024.2 +020000 02 CORRECT-X. IX2024.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. IX2024.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2024.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2024.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2024.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2024.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. IX2024.2 +020700 04 CORRECT-18V0 PIC -9(18). IX2024.2 +020800 04 FILLER PIC X. IX2024.2 +020900 03 FILLER PIC X(2) VALUE SPACE. IX2024.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2024.2 +021100 01 CCVS-C-1. IX2024.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2024.2 +021300- "SS PARAGRAPH-NAME IX2024.2 +021400- " REMARKS". IX2024.2 +021500 02 FILLER PIC X(20) VALUE SPACE. IX2024.2 +021600 01 CCVS-C-2. IX2024.2 +021700 02 FILLER PIC X VALUE SPACE. IX2024.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". IX2024.2 +021900 02 FILLER PIC X(15) VALUE SPACE. IX2024.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". IX2024.2 +022100 02 FILLER PIC X(94) VALUE SPACE. IX2024.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2024.2 +022300 01 REC-CT PIC 99 VALUE ZERO. IX2024.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2024.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2024.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2024.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2024.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2024.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2024.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2024.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2024.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2024.2 +023300 01 CCVS-H-1. IX2024.2 +023400 02 FILLER PIC X(39) VALUE SPACES. IX2024.2 +023500 02 FILLER PIC X(42) VALUE IX2024.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2024.2 +023700 02 FILLER PIC X(39) VALUE SPACES. IX2024.2 +023800 01 CCVS-H-2A. IX2024.2 +023900 02 FILLER PIC X(40) VALUE SPACE. IX2024.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2024.2 +024100 02 FILLER PIC XXXX VALUE IX2024.2 +024200 "4.2 ". IX2024.2 +024300 02 FILLER PIC X(28) VALUE IX2024.2 +024400 " COPY - NOT FOR DISTRIBUTION". IX2024.2 +024500 02 FILLER PIC X(41) VALUE SPACE. IX2024.2 +024600 IX2024.2 +024700 01 CCVS-H-2B. IX2024.2 +024800 02 FILLER PIC X(15) VALUE IX2024.2 +024900 "TEST RESULT OF ". IX2024.2 +025000 02 TEST-ID PIC X(9). IX2024.2 +025100 02 FILLER PIC X(4) VALUE IX2024.2 +025200 " IN ". IX2024.2 +025300 02 FILLER PIC X(12) VALUE IX2024.2 +025400 " HIGH ". IX2024.2 +025500 02 FILLER PIC X(22) VALUE IX2024.2 +025600 " LEVEL VALIDATION FOR ". IX2024.2 +025700 02 FILLER PIC X(58) VALUE IX2024.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2024.2 +025900 01 CCVS-H-3. IX2024.2 +026000 02 FILLER PIC X(34) VALUE IX2024.2 +026100 " FOR OFFICIAL USE ONLY ". IX2024.2 +026200 02 FILLER PIC X(58) VALUE IX2024.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2024.2 +026400 02 FILLER PIC X(28) VALUE IX2024.2 +026500 " COPYRIGHT 1985 ". IX2024.2 +026600 01 CCVS-E-1. IX2024.2 +026700 02 FILLER PIC X(52) VALUE SPACE. IX2024.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2024.2 +026900 02 ID-AGAIN PIC X(9). IX2024.2 +027000 02 FILLER PIC X(45) VALUE SPACES. IX2024.2 +027100 01 CCVS-E-2. IX2024.2 +027200 02 FILLER PIC X(31) VALUE SPACE. IX2024.2 +027300 02 FILLER PIC X(21) VALUE SPACE. IX2024.2 +027400 02 CCVS-E-2-2. IX2024.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2024.2 +027600 03 FILLER PIC X VALUE SPACE. IX2024.2 +027700 03 ENDER-DESC PIC X(44) VALUE IX2024.2 +027800 "ERRORS ENCOUNTERED". IX2024.2 +027900 01 CCVS-E-3. IX2024.2 +028000 02 FILLER PIC X(22) VALUE IX2024.2 +028100 " FOR OFFICIAL USE ONLY". IX2024.2 +028200 02 FILLER PIC X(12) VALUE SPACE. IX2024.2 +028300 02 FILLER PIC X(58) VALUE IX2024.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2024.2 +028500 02 FILLER PIC X(13) VALUE SPACE. IX2024.2 +028600 02 FILLER PIC X(15) VALUE IX2024.2 +028700 " COPYRIGHT 1985". IX2024.2 +028800 01 CCVS-E-4. IX2024.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2024.2 +029000 02 FILLER PIC X(4) VALUE " OF ". IX2024.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2024.2 +029200 02 FILLER PIC X(40) VALUE IX2024.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". IX2024.2 +029400 01 XXINFO. IX2024.2 +029500 02 FILLER PIC X(19) VALUE IX2024.2 +029600 "*** INFORMATION ***". IX2024.2 +029700 02 INFO-TEXT. IX2024.2 +029800 04 FILLER PIC X(8) VALUE SPACE. IX2024.2 +029900 04 XXCOMPUTED PIC X(20). IX2024.2 +030000 04 FILLER PIC X(5) VALUE SPACE. IX2024.2 +030100 04 XXCORRECT PIC X(20). IX2024.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). IX2024.2 +030300 01 HYPHEN-LINE. IX2024.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. IX2024.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************IX2024.2 +030600- "*****************************************". IX2024.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************IX2024.2 +030800- "******************************". IX2024.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE IX2024.2 +031000 "IX202A". IX2024.2 +031100 PROCEDURE DIVISION. IX2024.2 +031200 CCVS1 SECTION. IX2024.2 +031300 OPEN-FILES. IX2024.2 +031400*P OPEN I-O RAW-DATA. IX2024.2 +031500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2024.2 +031600*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2024.2 +031700*P MOVE "ABORTED " TO C-ABORT. IX2024.2 +031800*P ADD 1 TO C-NO-OF-TESTS. IX2024.2 +031900*P ACCEPT C-DATE FROM DATE. IX2024.2 +032000*P ACCEPT C-TIME FROM TIME. IX2024.2 +032100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2024.2 +032200*PND-E-1. IX2024.2 +032300*P CLOSE RAW-DATA. IX2024.2 +032400 OPEN OUTPUT PRINT-FILE. IX2024.2 +032500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2024.2 +032600 MOVE SPACE TO TEST-RESULTS. IX2024.2 +032700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2024.2 +032800 MOVE ZERO TO REC-SKL-SUB. IX2024.2 +032900 PERFORM CCVS-INIT-FILE 9 TIMES. IX2024.2 +033000 CCVS-INIT-FILE. IX2024.2 +033100 ADD 1 TO REC-SKL-SUB. IX2024.2 +033200 MOVE FILE-RECORD-INFO-SKELETON IX2024.2 +033300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2024.2 +033400 CCVS-INIT-EXIT. IX2024.2 +033500 GO TO CCVS1-EXIT. IX2024.2 +033600 CLOSE-FILES. IX2024.2 +033700*P OPEN I-O RAW-DATA. IX2024.2 +033800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2024.2 +033900*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2024.2 +034000*P MOVE "OK. " TO C-ABORT. IX2024.2 +034100*P MOVE PASS-COUNTER TO C-OK. IX2024.2 +034200*P MOVE ERROR-HOLD TO C-ALL. IX2024.2 +034300*P MOVE ERROR-COUNTER TO C-FAIL. IX2024.2 +034400*P MOVE DELETE-COUNTER TO C-DELETED. IX2024.2 +034500*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2024.2 +034600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2024.2 +034700*PND-E-2. IX2024.2 +034800*P CLOSE RAW-DATA. IX2024.2 +034900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2024.2 +035000 TERMINATE-CCVS. IX2024.2 +035100*S EXIT PROGRAM. IX2024.2 +035200*SERMINATE-CALL. IX2024.2 +035300 STOP RUN. IX2024.2 +035400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2024.2 +035500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2024.2 +035600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2024.2 +035700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2024.2 +035800 MOVE "****TEST DELETED****" TO RE-MARK. IX2024.2 +035900 PRINT-DETAIL. IX2024.2 +036000 IF REC-CT NOT EQUAL TO ZERO IX2024.2 +036100 MOVE "." TO PARDOT-X IX2024.2 +036200 MOVE REC-CT TO DOTVALUE. IX2024.2 +036300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2024.2 +036400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2024.2 +036500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2024.2 +036600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2024.2 +036700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2024.2 +036800 MOVE SPACE TO CORRECT-X. IX2024.2 +036900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2024.2 +037000 MOVE SPACE TO RE-MARK. IX2024.2 +037100 HEAD-ROUTINE. IX2024.2 +037200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +037300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +037400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2024.2 +037500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2024.2 +037600 COLUMN-NAMES-ROUTINE. IX2024.2 +037700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +037800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +037900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +038000 END-ROUTINE. IX2024.2 +038100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2024.2 +038200 END-RTN-EXIT. IX2024.2 +038300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +038400 END-ROUTINE-1. IX2024.2 +038500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2024.2 +038600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2024.2 +038700 ADD PASS-COUNTER TO ERROR-HOLD. IX2024.2 +038800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2024.2 +038900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2024.2 +039000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2024.2 +039100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2024.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2024.2 +039300 END-ROUTINE-12. IX2024.2 +039400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2024.2 +039500 IF ERROR-COUNTER IS EQUAL TO ZERO IX2024.2 +039600 MOVE "NO " TO ERROR-TOTAL IX2024.2 +039700 ELSE IX2024.2 +039800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2024.2 +039900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2024.2 +040000 PERFORM WRITE-LINE. IX2024.2 +040100 END-ROUTINE-13. IX2024.2 +040200 IF DELETE-COUNTER IS EQUAL TO ZERO IX2024.2 +040300 MOVE "NO " TO ERROR-TOTAL ELSE IX2024.2 +040400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2024.2 +040500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2024.2 +040600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +040700 IF INSPECT-COUNTER EQUAL TO ZERO IX2024.2 +040800 MOVE "NO " TO ERROR-TOTAL IX2024.2 +040900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2024.2 +041000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2024.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +041200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2024.2 +041300 WRITE-LINE. IX2024.2 +041400 ADD 1 TO RECORD-COUNT. IX2024.2 +041500 IF RECORD-COUNT GREATER 42 IX2024.2 +041600 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2024.2 +041700 MOVE SPACE TO DUMMY-RECORD IX2024.2 +041800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2024.2 +041900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2024.2 +042000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2024.2 +042100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2024.2 +042200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2024.2 +042300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2024.2 +042400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2024.2 +042500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2024.2 +042600 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2024.2 +042700 MOVE ZERO TO RECORD-COUNT. IX2024.2 +042800 PERFORM WRT-LN. IX2024.2 +042900 WRT-LN. IX2024.2 +043000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2024.2 +043100 MOVE SPACE TO DUMMY-RECORD. IX2024.2 +043200 BLANK-LINE-PRINT. IX2024.2 +043300 PERFORM WRT-LN. IX2024.2 +043400 FAIL-ROUTINE. IX2024.2 +043500 IF COMPUTED-X NOT EQUAL TO SPACE IX2024.2 +043600 GO TO FAIL-ROUTINE-WRITE. IX2024.2 +043700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2024.2 +043800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2024.2 +043900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2024.2 +044000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +044100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2024.2 +044200 GO TO FAIL-ROUTINE-EX. IX2024.2 +044300 FAIL-ROUTINE-WRITE. IX2024.2 +044400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2024.2 +044500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2024.2 +044600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2024.2 +044700 MOVE SPACES TO COR-ANSI-REFERENCE. IX2024.2 +044800 FAIL-ROUTINE-EX. EXIT. IX2024.2 +044900 BAIL-OUT. IX2024.2 +045000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2024.2 +045100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2024.2 +045200 BAIL-OUT-WRITE. IX2024.2 +045300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2024.2 +045400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2024.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2024.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2024.2 +045700 BAIL-OUT-EX. EXIT. IX2024.2 +045800 CCVS1-EXIT. IX2024.2 +045900 EXIT. IX2024.2 +046000 SECT-IX-02-001 SECTION. IX2024.2 +046100 READ-INIT-F2-01. IX2024.2 +046200 OPEN INPUT IX-FD1. IX2024.2 +046300 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX2024.2 +046400 MOVE ZERO TO WRK-DU-09V00-001. IX2024.2 +046500 MOVE IX-WRK-KEY TO IX-FD1-KEY. IX2024.2 +046600 MOVE ZERO TO WRK-CS-09V00-002 IX2024.2 +046700 MOVE ZERO TO WRK-DU-09V00-001 IX2024.2 +046800 MOVE "READ RANDOM " TO FEATURE. IX2024.2 +046900 READ-TEST-F2-01-R. IX2024.2 +047000 ADD 1 TO WRK-DU-09V00-001 IX2024.2 +047100 MOVE IX-WRK-KEY TO IX-FD1-KEY. IX2024.2 +047200 IF WRK-DU-09V00-001 GREATER 501 IX2024.2 +047300 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +047400 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A IX2024.2 +047500 MOVE WRK-DU-09V00-001 TO CORRECT-18V0 IX2024.2 +047600 PERFORM FAIL IX2024.2 +047700 PERFORM PRINT-DETAIL IX2024.2 +047800 GO TO READ-WRITE-F2-01. IX2024.2 +047900 READ IX-FD1 IX2024.2 +048000 INVALID KEY GO TO READ-WRITE-F2-01. IX2024.2 +048100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2024.2 +048200 IF XRECORD-NUMBER (1) EQUAL TO WRK-DU-09V00-001 IX2024.2 +048300 GO TO READ-TEST-F2-01-R. IX2024.2 +048400 MOVE "YES" TO I-O-ERROR-IX-FD1. IX2024.2 +048500 ADD 1 TO WRK-CS-09V00-002 IX2024.2 +048600 GO TO READ-TEST-F2-01-R. IX2024.2 +048700 READ-WRITE-F2-01. IX2024.2 +048800 IF WRK-DU-09V00-001 NOT EQUAL TO 501 IX2024.2 +048900 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +049000 MOVE "WRONG KEY/NOT 500" TO CORRECT-A IX2024.2 +049100 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX2024.2 +049200 PERFORM FAIL IX2024.2 +049300 ELSE IX2024.2 +049400 PERFORM PASS. IX2024.2 +049500 PERFORM PRINT-DETAIL. IX2024.2 +049600 READ-TEST-F2-01-1. IX2024.2 +049700 MOVE "READ-TEST-F2-01-1" TO PAR-NAME. IX2024.2 +049800 MOVE "READ TOO LESS RECORDS" TO RE-MARK. IX2024.2 +049900 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 IX2024.2 +050000 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +050100 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A IX2024.2 +050200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2024.2 +050300 PERFORM FAIL IX2024.2 +050400 ELSE IX2024.2 +050500 PERFORM PASS. IX2024.2 +050600 PERFORM PRINT-DETAIL. IX2024.2 +050700 READ-TEST-F2-01-2. IX2024.2 +050800 MOVE "READ-TEST-F2-01-2" TO PAR-NAME. IX2024.2 +050900 MOVE "READ TOO MUCH RECORDS" TO RE-MARK. IX2024.2 +051000 IF WRK-DU-09V00-001 NOT EQUAL TO 501 IX2024.2 +051100 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +051200 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX2024.2 +051300 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX2024.2 +051400 MOVE 501 TO CORRECT-18V0 IX2024.2 +051500 PERFORM FAIL IX2024.2 +051600 ELSE IX2024.2 +051700 PERFORM PASS. IX2024.2 +051800 PERFORM PRINT-DETAIL. IX2024.2 +051900 READ-TEST-F2-01-3. IX2024.2 +052000 MOVE "READ-TEST-F2-01-3" TO PAR-NAME. IX2024.2 +052100 MOVE "READ WRONG RECORDS" TO RE-MARK. IX2024.2 +052200 IF I-O-ERROR-IX-FD1 EQUAL TO "YES" IX2024.2 +052300 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +052400 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 IX2024.2 +052500 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK IX2024.2 +052600 PERFORM FAIL IX2024.2 +052700 ELSE IX2024.2 +052800 PERFORM PASS. IX2024.2 +052900 PERFORM PRINT-DETAIL. IX2024.2 +053000 CLOSE IX-FD1. IX2024.2 +053100* IX2024.2 +053200* U P D A T E READ & REWRITE IX2024.2 +053300* IX2024.2 +053400 RWRT-INIT-GF-01-R . IX2024.2 +053500 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. IX2024.2 +053600 MOVE "REWRITE " TO FEATURE. IX2024.2 +053700 OPEN I-O IX-FD1. IX2024.2 +053800 MOVE ZERO TO IX-FD1-KEY. IX2024.2 +053900 MOVE ZERO TO WRK-CS-09V00-002. IX2024.2 +054000 MOVE ZERO TO WRK-DU-09V00-001. IX2024.2 +054100 MOVE SPACE TO FILE-RECORD-INFO (1). IX2024.2 +054200 RWRT-TEST-GF-01-R. IX2024.2 +054300 ADD 5 TO WRK-DU-09V00-001. IX2024.2 +054400 MOVE IX-WRK-KEY TO IX-FD1-KEY. IX2024.2 +054500 IF WRK-DU-09V00-001 GREATER 505 IX2024.2 +054600 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A IX2024.2 +054700 MOVE WRK-DU-09V00-001 TO CORRECT-18V0 IX2024.2 +054800 PERFORM FAIL IX2024.2 +054900 PERFORM PRINT-DETAIL IX2024.2 +055000 GO TO RWRT-TEST-GF-01-3. IX2024.2 +055100 READ IX-FD1 IX2024.2 +055200 INVALID KEY GO TO RWRT-TEST-GF-01-1. IX2024.2 +055300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1) IX2024.2 +055400 ADD 01 TO UPDATE-NUMBER (1). IX2024.2 +055500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2024.2 +055600 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2024.2 +055700 REWRITE IX-FS1R1-F-G-240 IX2024.2 +055800 INVALID KEY GO TO RWRT-TEST-GF-01-2. IX2024.2 +055900 GO TO RWRT-TEST-GF-01-R. IX2024.2 +056000 RWRT-TEST-GF-01-1. IX2024.2 +056100 MOVE "RWRT-TEST-GF-01-1" TO PAR-NAME. IX2024.2 +056200 MOVE "READ INVALID" TO FEATURE. IX2024.2 +056300 IF WRK-DU-09V00-001 LESS THAN 501 IX2024.2 +056400 ADD 1 TO WRK-CS-09V00-001 IX2024.2 +056500 GO TO RWRT-TEST-GF-01-R. IX2024.2 +056600 PERFORM PASS. IX2024.2 +056700 PERFORM PRINT-DETAIL. IX2024.2 +056800 GO TO RWRT-TEST-GF-01-3. IX2024.2 +056900 RWRT-TEST-GF-01-2. IX2024.2 +057000 ADD 1 TO WRK-CS-09V00-005. IX2024.2 +057100 IF WRK-DU-09V00-001 LESS THAN 501 IX2024.2 +057200 GO TO RWRT-TEST-GF-01-R. IX2024.2 +057300 RWRT-TEST-GF-01-3. IX2024.2 +057400 MOVE "RWRT-TEST-GF-03-1" TO PAR-NAME. IX2024.2 +057500 MOVE "READ INVALID" TO FEATURE. IX2024.2 +057600 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO IX2024.2 +057700 MOVE "IX-28; FORMAT 2 " TO RE-MARK IX2024.2 +057800 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2024.2 +057900 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 IX2024.2 +058000 PERFORM FAIL IX2024.2 +058100 ELSE IX2024.2 +058200 PERFORM PASS. IX2024.2 +058300 PERFORM PRINT-DETAIL. IX2024.2 +058400 RWRT-TEST-GF-02-1. IX2024.2 +058500 MOVE "RWRT-TEST-GF-02-1" TO PAR-NAME. IX2024.2 +058600 MOVE "REWRITE " TO FEATURE. IX2024.2 +058700 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO IX2024.2 +058800 MOVE "IX-33; 4.6.2 " TO RE-MARK IX2024.2 +058900 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A IX2024.2 +059000 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 IX2024.2 +059100 PERFORM FAIL IX2024.2 +059200 ELSE IX2024.2 +059300 PERFORM PASS. IX2024.2 +059400 PERFORM PRINT-DETAIL. IX2024.2 +059500 CLOSE IX-FD1. IX2024.2 +059600 READ-INIT-F2-02. IX2024.2 +059700 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX2024.2 +059800 MOVE "READ " TO FEATURE. IX2024.2 +059900 OPEN INPUT IX-FD1. IX2024.2 +060000 MOVE 501 TO WRK-DU-09V00-001. IX2024.2 +060100 MOVE ZERO TO WRK-CS-09V00-004. IX2024.2 +060200 MOVE ZERO TO WRK-CS-09V00-005. IX2024.2 +060300 MOVE ZERO TO WRK-CS-09V00-002. IX2024.2 +060400 MOVE SPACE TO FILE-RECORD-INFO (1). IX2024.2 +060500 READ-TEST-F2-02-R. IX2024.2 +060600 IF WRK-DU-09V00-001 EQUAL TO ZERO IX2024.2 +060700 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A IX2024.2 +060800 MOVE WRK-DU-09V00-001 TO COMPUTED-18V0 IX2024.2 +060900 MOVE ZERO TO CORRECT-18V0 IX2024.2 +061000 PERFORM FAIL IX2024.2 +061100 PERFORM PRINT-DETAIL IX2024.2 +061200 GO TO READ-TEST-F2-02-1-0. IX2024.2 +061300 SUBTRACT 1 FROM WRK-DU-09V00-001. IX2024.2 +061400 MOVE IX-WRK-KEY TO IX-FD1-KEY. IX2024.2 +061500 READ IX-FD1 IX2024.2 +061600 INVALID KEY GO TO READ-TEST-F2-02-1. IX2024.2 +061700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2024.2 +061800 IF UPDATE-NUMBER (1) EQUAL TO 00 IX2024.2 +061900 ADD 1 TO WRK-CS-09V00-004. IX2024.2 +062000 IF UPDATE-NUMBER (1) EQUAL TO 01 IX2024.2 +062100 ADD 1 TO WRK-CS-09V00-005. IX2024.2 +062200 GO TO READ-TEST-F2-02-R. IX2024.2 +062300 READ-TEST-F2-02-1. IX2024.2 +062400 IF WRK-DU-09V00-001 GREATER ZERO IX2024.2 +062500 ADD 1 TO WRK-CS-09V00-002 IX2024.2 +062600 GO TO READ-TEST-F2-02-R. IX2024.2 +062700 PERFORM PASS. IX2024.2 +062800 PERFORM PRINT-DETAIL. IX2024.2 +062900 READ-TEST-F2-02-1-0. IX2024.2 +063000 MOVE "READ-TEST-F2-02-1 " TO PAR-NAME. IX2024.2 +063100 MOVE "READ " TO FEATURE. IX2024.2 +063200 IF WRK-CS-09V00-004 NOT EQUAL TO 400 IX2024.2 +063300 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A IX2024.2 +063400 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 IX2024.2 +063500 MOVE "SHOULD BE 400" TO RE-MARK IX2024.2 +063600 PERFORM FAIL IX2024.2 +063700 ELSE IX2024.2 +063800 PERFORM PASS. IX2024.2 +063900 PERFORM PRINT-DETAIL. IX2024.2 +064000 READ-TEST-F2-02-2. IX2024.2 +064100 MOVE "READ-TEST-F2-02-2" TO PAR-NAME. IX2024.2 +064200 MOVE "READ " TO FEATURE. IX2024.2 +064300 IF WRK-CS-09V00-005 NOT EQUAL TO 100 IX2024.2 +064400 MOVE "UPDATED RECORDS" TO COMPUTED-A IX2024.2 +064500 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 IX2024.2 +064600 MOVE "SHOULD BE 100" TO RE-MARK IX2024.2 +064700 PERFORM FAIL IX2024.2 +064800 ELSE IX2024.2 +064900 PERFORM PASS. IX2024.2 +065000 PERFORM PRINT-DETAIL. IX2024.2 +065100 READ-TEST-F2-02-3. IX2024.2 +065200 MOVE "READ-TEST-F2-02-3" TO PAR-NAME. IX2024.2 +065300 MOVE "READ " TO FEATURE. IX2024.2 +065400 IF WRK-CS-09V00-002 GREATER 1 IX2024.2 +065500 MOVE WRK-CS-09V00-002 TO COMPUTED-N IX2024.2 +065600 MOVE "INVALID KEY/READS" TO CORRECT-A IX2024.2 +065700 PERFORM FAIL IX2024.2 +065800 ELSE IX2024.2 +065900 PERFORM PASS. IX2024.2 +066000 PERFORM PRINT-DETAIL. IX2024.2 +066100 CLOSE IX-FD1. IX2024.2 +066200 CCVS-EXIT SECTION. IX2024.2 +066300 CCVS-999999. IX2024.2 +066400 GO TO CLOSE-FILES. IX2024.2 diff --git a/tests/cobol85/IX/IX203A.SUB b/tests/cobol85/IX/IX203A.SUB new file mode 100755 index 00000000..e52d5838 --- /dev/null +++ b/tests/cobol85/IX/IX203A.SUB @@ -0,0 +1,735 @@ +000100 IDENTIFICATION DIVISION. IX2034.2 +000200 PROGRAM-ID. IX2034.2 +000300 IX203A. IX2034.2 +000400**************************************************************** IX2034.2 +000500* * IX2034.2 +000600* VALIDATION FOR:- * IX2034.2 +000700* * IX2034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2034.2 +000900* * IX2034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2034.2 +001100* * IX2034.2 +001200**************************************************************** IX2034.2 +001300* THIS PROGRAM IS THE THIRD OF A SERIES. ITS FUNCTION IX2034.2 +001400* IS TO PROCESS THE FILE SEQUENTIALLY USING THE ACCESS MODE IS IX2034.2 +001500* DYNAMIC CLAUSE. THE FILE USED IS THAT RESULTING FROM IX202. IX2034.2 +001600* IX2034.2 +001700* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RECORDS. IX2034.2 +001800* SECONDLY, RECORDS OF THE FILE ARE SELECTIVELY DELETED AND IX2034.2 +001900* THIRDLY THE ACCURACY OF EACH RECORD IN THE FILE IS AGAIN IX2034.2 +002000* VERIFIED. IX2034.2 +002100* IX2034.2 +002200* IX2034.2 +002300* IX2034.2 +002400* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2034.2 +002500* IX2034.2 +002600* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2034.2 +002700* CLAUSE FOR DATA FILE IX-FS1 IX2034.2 +002800* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2034.2 +002900* CLAUSE FOR INDEX FILE IX-FS1 IX2034.2 +003000* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2034.2 +003100* X-62 FOR RAW-DATA IX2034.2 +003200* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2034.2 +003300* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2034.2 +003400* IX2034.2 +003500* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX2034.2 +003600* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2034.2 +003700* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2034.2 +003800* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2034.2 +003900* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2034.2 +004000* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2034.2 +004100* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2034.2 +004200* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2034.2 +004300* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2034.2 +004400* THEY ARE AS FOLLOWS IX2034.2 +004500* IX2034.2 +004600* P SELECTS X-CARDS 62 IX2034.2 +004700* J SELECTS X-CARD 44 IX2034.2 +004800* IX2034.2 +004900 ENVIRONMENT DIVISION. IX2034.2 +005000 CONFIGURATION SECTION. IX2034.2 +005100 SOURCE-COMPUTER. IX2034.2 +005200 Linux. IX2034.2 +005300 OBJECT-COMPUTER. IX2034.2 +005400 Linux. IX2034.2 +005500 INPUT-OUTPUT SECTION. IX2034.2 +005600 FILE-CONTROL. IX2034.2 +005700*P SELECT RAW-DATA ASSIGN TO IX2034.2 +005800*P "XXXXX062" IX2034.2 +005900*P ORGANIZATION IS INDEXED IX2034.2 +006000*P ACCESS MODE IS RANDOM IX2034.2 +006100*P RECORD KEY IS RAW-DATA-KEY. IX2034.2 +006200 SELECT PRINT-FILE ASSIGN TO IX2034.2 +006300 "report.log". IX2034.2 +006400 SELECT IX-FD1 ASSIGN TO IX2034.2 +006500 "XXXXX024" IX2034.2 +006600*J **** X-CARD UNDEFINED **** IX2034.2 +006700 ACCESS MODE IS DYNAMIC IX2034.2 +006800 ORGANIZATION IS INDEXED IX2034.2 +006900 RECORD IX-FD1-KEY. IX2034.2 +007000 DATA DIVISION. IX2034.2 +007100 FILE SECTION. IX2034.2 +007200*P IX2034.2 +007300*PD RAW-DATA. IX2034.2 +007400*P IX2034.2 +007500*P1 RAW-DATA-SATZ. IX2034.2 +007600*P 05 RAW-DATA-KEY PIC X(6). IX2034.2 +007700*P 05 C-DATE PIC 9(6). IX2034.2 +007800*P 05 C-TIME PIC 9(8). IX2034.2 +007900*P 05 C-NO-OF-TESTS PIC 99. IX2034.2 +008000*P 05 C-OK PIC 999. IX2034.2 +008100*P 05 C-ALL PIC 999. IX2034.2 +008200*P 05 C-FAIL PIC 999. IX2034.2 +008300*P 05 C-DELETED PIC 999. IX2034.2 +008400*P 05 C-INSPECT PIC 999. IX2034.2 +008500*P 05 C-NOTE PIC X(13). IX2034.2 +008600*P 05 C-INDENT PIC X. IX2034.2 +008700*P 05 C-ABORT PIC X(8). IX2034.2 +008800 FD PRINT-FILE. IX2034.2 +008900 01 PRINT-REC PICTURE X(120). IX2034.2 +009000 01 DUMMY-RECORD PICTURE X(120). IX2034.2 +009100 FD IX-FD1 IX2034.2 +009200*C LABEL RECORD STANDARD IX2034.2 +009300*C DATA RECORDS ARE IX-FD1R1-F-G-240 IX2034.2 +009400 BLOCK CONTAINS 01 RECORDS IX2034.2 +009500 RECORD CONTAINS 240. IX2034.2 +009600 01 IX-FD1R1-F-G-240. IX2034.2 +009700 05 IX-FD1-REC-120 PIC X(120). IX2034.2 +009800 05 IX-FD1-REC-120-240. IX2034.2 +009900 10 FILLER PIC X(8). IX2034.2 +010000 10 IX-FD1-KEY PIC X(29). IX2034.2 +010100 10 FILLER PIC X(83). IX2034.2 +010200 WORKING-STORAGE SECTION. IX2034.2 +010300 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010400 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010500 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010600 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010700 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010800 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. IX2034.2 +010900 01 I-O-ERROR-IX-FD1 PIC X(3) VALUE "NO ". IX2034.2 +011000 01 IX-WRK-KEY. IX2034.2 +011100 03 FILLER PIC X(10). IX2034.2 +011200 03 WRK-DU-09V00-001 PIC 9(9). IX2034.2 +011300 03 FILLER PIC X(10). IX2034.2 +011400 01 DUMMY-WRK-REC. IX2034.2 +011500 02 DUMMY-WRK1 PIC X(120). IX2034.2 +011600 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX2034.2 +011700 03 FILLER PIC X(5). IX2034.2 +011800 03 DUMMY-WRK-INDENT-5 PIC X(115). IX2034.2 +011900 01 FILE-RECORD-INFORMATION-REC. IX2034.2 +012000 03 FILE-RECORD-INFO-SKELETON. IX2034.2 +012100 05 FILLER PICTURE X(48) VALUE IX2034.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2034.2 +012300 05 FILLER PICTURE X(46) VALUE IX2034.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2034.2 +012500 05 FILLER PICTURE X(26) VALUE IX2034.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". IX2034.2 +012700 05 FILLER PICTURE X(37) VALUE IX2034.2 +012800 ",RECKEY= ". IX2034.2 +012900 05 FILLER PICTURE X(38) VALUE IX2034.2 +013000 ",ALTKEY1= ". IX2034.2 +013100 05 FILLER PICTURE X(38) VALUE IX2034.2 +013200 ",ALTKEY2= ". IX2034.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.IX2034.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2034.2 +013500 05 FILE-RECORD-INFO-P1-120. IX2034.2 +013600 07 FILLER PIC X(5). IX2034.2 +013700 07 XFILE-NAME PIC X(6). IX2034.2 +013800 07 FILLER PIC X(8). IX2034.2 +013900 07 XRECORD-NAME PIC X(6). IX2034.2 +014000 07 FILLER PIC X(1). IX2034.2 +014100 07 REELUNIT-NUMBER PIC 9(1). IX2034.2 +014200 07 FILLER PIC X(7). IX2034.2 +014300 07 XRECORD-NUMBER PIC 9(6). IX2034.2 +014400 07 FILLER PIC X(6). IX2034.2 +014500 07 UPDATE-NUMBER PIC 9(2). IX2034.2 +014600 07 FILLER PIC X(5). IX2034.2 +014700 07 ODO-NUMBER PIC 9(4). IX2034.2 +014800 07 FILLER PIC X(5). IX2034.2 +014900 07 XPROGRAM-NAME PIC X(5). IX2034.2 +015000 07 FILLER PIC X(7). IX2034.2 +015100 07 XRECORD-LENGTH PIC 9(6). IX2034.2 +015200 07 FILLER PIC X(7). IX2034.2 +015300 07 CHARS-OR-RECORDS PIC X(2). IX2034.2 +015400 07 FILLER PIC X(1). IX2034.2 +015500 07 XBLOCK-SIZE PIC 9(4). IX2034.2 +015600 07 FILLER PIC X(6). IX2034.2 +015700 07 RECORDS-IN-FILE PIC 9(6). IX2034.2 +015800 07 FILLER PIC X(5). IX2034.2 +015900 07 XFILE-ORGANIZATION PIC X(2). IX2034.2 +016000 07 FILLER PIC X(6). IX2034.2 +016100 07 XLABEL-TYPE PIC X(1). IX2034.2 +016200 05 FILE-RECORD-INFO-P121-240. IX2034.2 +016300 07 FILLER PIC X(8). IX2034.2 +016400 07 XRECORD-KEY PIC X(29). IX2034.2 +016500 07 FILLER PIC X(9). IX2034.2 +016600 07 ALTERNATE-KEY1 PIC X(29). IX2034.2 +016700 07 FILLER PIC X(9). IX2034.2 +016800 07 ALTERNATE-KEY2 PIC X(29). IX2034.2 +016900 07 FILLER PIC X(7). IX2034.2 +017000 01 TEST-RESULTS. IX2034.2 +017100 02 FILLER PIC X VALUE SPACE. IX2034.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. IX2034.2 +017300 02 FILLER PIC X VALUE SPACE. IX2034.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. IX2034.2 +017500 02 FILLER PIC X VALUE SPACE. IX2034.2 +017600 02 PAR-NAME. IX2034.2 +017700 03 FILLER PIC X(19) VALUE SPACE. IX2034.2 +017800 03 PARDOT-X PIC X VALUE SPACE. IX2034.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. IX2034.2 +018000 02 FILLER PIC X(8) VALUE SPACE. IX2034.2 +018100 02 RE-MARK PIC X(61). IX2034.2 +018200 01 TEST-COMPUTED. IX2034.2 +018300 02 FILLER PIC X(30) VALUE SPACE. IX2034.2 +018400 02 FILLER PIC X(17) VALUE IX2034.2 +018500 " COMPUTED=". IX2034.2 +018600 02 COMPUTED-X. IX2034.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2034.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A IX2034.2 +018900 PIC -9(9).9(9). IX2034.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2034.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2034.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2034.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. IX2034.2 +019400 04 COMPUTED-18V0 PIC -9(18). IX2034.2 +019500 04 FILLER PIC X. IX2034.2 +019600 03 FILLER PIC X(50) VALUE SPACE. IX2034.2 +019700 01 TEST-CORRECT. IX2034.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX2034.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". IX2034.2 +020000 02 CORRECT-X. IX2034.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. IX2034.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2034.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2034.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2034.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2034.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. IX2034.2 +020700 04 CORRECT-18V0 PIC -9(18). IX2034.2 +020800 04 FILLER PIC X. IX2034.2 +020900 03 FILLER PIC X(2) VALUE SPACE. IX2034.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2034.2 +021100 01 CCVS-C-1. IX2034.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2034.2 +021300- "SS PARAGRAPH-NAME IX2034.2 +021400- " REMARKS". IX2034.2 +021500 02 FILLER PIC X(20) VALUE SPACE. IX2034.2 +021600 01 CCVS-C-2. IX2034.2 +021700 02 FILLER PIC X VALUE SPACE. IX2034.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". IX2034.2 +021900 02 FILLER PIC X(15) VALUE SPACE. IX2034.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". IX2034.2 +022100 02 FILLER PIC X(94) VALUE SPACE. IX2034.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2034.2 +022300 01 REC-CT PIC 99 VALUE ZERO. IX2034.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2034.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2034.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2034.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2034.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2034.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2034.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2034.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2034.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2034.2 +023300 01 CCVS-H-1. IX2034.2 +023400 02 FILLER PIC X(39) VALUE SPACES. IX2034.2 +023500 02 FILLER PIC X(42) VALUE IX2034.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2034.2 +023700 02 FILLER PIC X(39) VALUE SPACES. IX2034.2 +023800 01 CCVS-H-2A. IX2034.2 +023900 02 FILLER PIC X(40) VALUE SPACE. IX2034.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2034.2 +024100 02 FILLER PIC XXXX VALUE IX2034.2 +024200 "4.2 ". IX2034.2 +024300 02 FILLER PIC X(28) VALUE IX2034.2 +024400 " COPY - NOT FOR DISTRIBUTION". IX2034.2 +024500 02 FILLER PIC X(41) VALUE SPACE. IX2034.2 +024600 IX2034.2 +024700 01 CCVS-H-2B. IX2034.2 +024800 02 FILLER PIC X(15) VALUE IX2034.2 +024900 "TEST RESULT OF ". IX2034.2 +025000 02 TEST-ID PIC X(9). IX2034.2 +025100 02 FILLER PIC X(4) VALUE IX2034.2 +025200 " IN ". IX2034.2 +025300 02 FILLER PIC X(12) VALUE IX2034.2 +025400 " HIGH ". IX2034.2 +025500 02 FILLER PIC X(22) VALUE IX2034.2 +025600 " LEVEL VALIDATION FOR ". IX2034.2 +025700 02 FILLER PIC X(58) VALUE IX2034.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2034.2 +025900 01 CCVS-H-3. IX2034.2 +026000 02 FILLER PIC X(34) VALUE IX2034.2 +026100 " FOR OFFICIAL USE ONLY ". IX2034.2 +026200 02 FILLER PIC X(58) VALUE IX2034.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2034.2 +026400 02 FILLER PIC X(28) VALUE IX2034.2 +026500 " COPYRIGHT 1985 ". IX2034.2 +026600 01 CCVS-E-1. IX2034.2 +026700 02 FILLER PIC X(52) VALUE SPACE. IX2034.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2034.2 +026900 02 ID-AGAIN PIC X(9). IX2034.2 +027000 02 FILLER PIC X(45) VALUE SPACES. IX2034.2 +027100 01 CCVS-E-2. IX2034.2 +027200 02 FILLER PIC X(31) VALUE SPACE. IX2034.2 +027300 02 FILLER PIC X(21) VALUE SPACE. IX2034.2 +027400 02 CCVS-E-2-2. IX2034.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2034.2 +027600 03 FILLER PIC X VALUE SPACE. IX2034.2 +027700 03 ENDER-DESC PIC X(44) VALUE IX2034.2 +027800 "ERRORS ENCOUNTERED". IX2034.2 +027900 01 CCVS-E-3. IX2034.2 +028000 02 FILLER PIC X(22) VALUE IX2034.2 +028100 " FOR OFFICIAL USE ONLY". IX2034.2 +028200 02 FILLER PIC X(12) VALUE SPACE. IX2034.2 +028300 02 FILLER PIC X(58) VALUE IX2034.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2034.2 +028500 02 FILLER PIC X(13) VALUE SPACE. IX2034.2 +028600 02 FILLER PIC X(15) VALUE IX2034.2 +028700 " COPYRIGHT 1985". IX2034.2 +028800 01 CCVS-E-4. IX2034.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2034.2 +029000 02 FILLER PIC X(4) VALUE " OF ". IX2034.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2034.2 +029200 02 FILLER PIC X(40) VALUE IX2034.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". IX2034.2 +029400 01 XXINFO. IX2034.2 +029500 02 FILLER PIC X(19) VALUE IX2034.2 +029600 "*** INFORMATION ***". IX2034.2 +029700 02 INFO-TEXT. IX2034.2 +029800 04 FILLER PIC X(8) VALUE SPACE. IX2034.2 +029900 04 XXCOMPUTED PIC X(20). IX2034.2 +030000 04 FILLER PIC X(5) VALUE SPACE. IX2034.2 +030100 04 XXCORRECT PIC X(20). IX2034.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). IX2034.2 +030300 01 HYPHEN-LINE. IX2034.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. IX2034.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************IX2034.2 +030600- "*****************************************". IX2034.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************IX2034.2 +030800- "******************************". IX2034.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE IX2034.2 +031000 "IX203A". IX2034.2 +031100 PROCEDURE DIVISION. IX2034.2 +031200 CCVS1 SECTION. IX2034.2 +031300 OPEN-FILES. IX2034.2 +031400*P OPEN I-O RAW-DATA. IX2034.2 +031500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2034.2 +031600*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2034.2 +031700*P MOVE "ABORTED " TO C-ABORT. IX2034.2 +031800*P ADD 1 TO C-NO-OF-TESTS. IX2034.2 +031900*P ACCEPT C-DATE FROM DATE. IX2034.2 +032000*P ACCEPT C-TIME FROM TIME. IX2034.2 +032100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2034.2 +032200*PND-E-1. IX2034.2 +032300*P CLOSE RAW-DATA. IX2034.2 +032400 OPEN OUTPUT PRINT-FILE. IX2034.2 +032500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2034.2 +032600 MOVE SPACE TO TEST-RESULTS. IX2034.2 +032700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2034.2 +032800 MOVE ZERO TO REC-SKL-SUB. IX2034.2 +032900 PERFORM CCVS-INIT-FILE 9 TIMES. IX2034.2 +033000 CCVS-INIT-FILE. IX2034.2 +033100 ADD 1 TO REC-SKL-SUB. IX2034.2 +033200 MOVE FILE-RECORD-INFO-SKELETON IX2034.2 +033300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2034.2 +033400 CCVS-INIT-EXIT. IX2034.2 +033500 GO TO CCVS1-EXIT. IX2034.2 +033600 CLOSE-FILES. IX2034.2 +033700*P OPEN I-O RAW-DATA. IX2034.2 +033800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2034.2 +033900*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2034.2 +034000*P MOVE "OK. " TO C-ABORT. IX2034.2 +034100*P MOVE PASS-COUNTER TO C-OK. IX2034.2 +034200*P MOVE ERROR-HOLD TO C-ALL. IX2034.2 +034300*P MOVE ERROR-COUNTER TO C-FAIL. IX2034.2 +034400*P MOVE DELETE-COUNTER TO C-DELETED. IX2034.2 +034500*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2034.2 +034600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2034.2 +034700*PND-E-2. IX2034.2 +034800*P CLOSE RAW-DATA. IX2034.2 +034900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2034.2 +035000 TERMINATE-CCVS. IX2034.2 +035100*S EXIT PROGRAM. IX2034.2 +035200*SERMINATE-CALL. IX2034.2 +035300 STOP RUN. IX2034.2 +035400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2034.2 +035500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2034.2 +035600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2034.2 +035700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2034.2 +035800 MOVE "****TEST DELETED****" TO RE-MARK. IX2034.2 +035900 PRINT-DETAIL. IX2034.2 +036000 IF REC-CT NOT EQUAL TO ZERO IX2034.2 +036100 MOVE "." TO PARDOT-X IX2034.2 +036200 MOVE REC-CT TO DOTVALUE. IX2034.2 +036300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2034.2 +036400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2034.2 +036500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2034.2 +036600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2034.2 +036700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2034.2 +036800 MOVE SPACE TO CORRECT-X. IX2034.2 +036900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2034.2 +037000 MOVE SPACE TO RE-MARK. IX2034.2 +037100 HEAD-ROUTINE. IX2034.2 +037200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +037300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +037400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2034.2 +037500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2034.2 +037600 COLUMN-NAMES-ROUTINE. IX2034.2 +037700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +037800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +037900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +038000 END-ROUTINE. IX2034.2 +038100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2034.2 +038200 END-RTN-EXIT. IX2034.2 +038300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +038400 END-ROUTINE-1. IX2034.2 +038500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2034.2 +038600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2034.2 +038700 ADD PASS-COUNTER TO ERROR-HOLD. IX2034.2 +038800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2034.2 +038900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2034.2 +039000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2034.2 +039100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2034.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2034.2 +039300 END-ROUTINE-12. IX2034.2 +039400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2034.2 +039500 IF ERROR-COUNTER IS EQUAL TO ZERO IX2034.2 +039600 MOVE "NO " TO ERROR-TOTAL IX2034.2 +039700 ELSE IX2034.2 +039800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2034.2 +039900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2034.2 +040000 PERFORM WRITE-LINE. IX2034.2 +040100 END-ROUTINE-13. IX2034.2 +040200 IF DELETE-COUNTER IS EQUAL TO ZERO IX2034.2 +040300 MOVE "NO " TO ERROR-TOTAL ELSE IX2034.2 +040400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2034.2 +040500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2034.2 +040600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +040700 IF INSPECT-COUNTER EQUAL TO ZERO IX2034.2 +040800 MOVE "NO " TO ERROR-TOTAL IX2034.2 +040900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2034.2 +041000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2034.2 +041100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +041200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2034.2 +041300 WRITE-LINE. IX2034.2 +041400 ADD 1 TO RECORD-COUNT. IX2034.2 +041500 IF RECORD-COUNT GREATER 42 IX2034.2 +041600 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2034.2 +041700 MOVE SPACE TO DUMMY-RECORD IX2034.2 +041800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2034.2 +041900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2034.2 +042000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2034.2 +042100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2034.2 +042200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2034.2 +042300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2034.2 +042400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2034.2 +042500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2034.2 +042600 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2034.2 +042700 MOVE ZERO TO RECORD-COUNT. IX2034.2 +042800 PERFORM WRT-LN. IX2034.2 +042900 WRT-LN. IX2034.2 +043000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2034.2 +043100 MOVE SPACE TO DUMMY-RECORD. IX2034.2 +043200 BLANK-LINE-PRINT. IX2034.2 +043300 PERFORM WRT-LN. IX2034.2 +043400 FAIL-ROUTINE. IX2034.2 +043500 IF COMPUTED-X NOT EQUAL TO SPACE IX2034.2 +043600 GO TO FAIL-ROUTINE-WRITE. IX2034.2 +043700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2034.2 +043800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2034.2 +043900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2034.2 +044000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +044100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2034.2 +044200 GO TO FAIL-ROUTINE-EX. IX2034.2 +044300 FAIL-ROUTINE-WRITE. IX2034.2 +044400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2034.2 +044500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2034.2 +044600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2034.2 +044700 MOVE SPACES TO COR-ANSI-REFERENCE. IX2034.2 +044800 FAIL-ROUTINE-EX. EXIT. IX2034.2 +044900 BAIL-OUT. IX2034.2 +045000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2034.2 +045100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2034.2 +045200 BAIL-OUT-WRITE. IX2034.2 +045300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2034.2 +045400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2034.2 +045500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2034.2 +045600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2034.2 +045700 BAIL-OUT-EX. EXIT. IX2034.2 +045800 CCVS1-EXIT. IX2034.2 +045900 EXIT. IX2034.2 +046000 SECT-IX-03-001 SECTION. IX2034.2 +046100 READ-INIT-F1-01. IX2034.2 +046200* THIS FILE "IX-FD1" IS ACCESSED SEQUENTIALLY AND HAS IX2034.2 +046300* ASSOCIATED WITH IT A RECORD KEY WHICH AT ALL TIMES SHOULD IX2034.2 +046400* CONTAIN THE INDEX OF THE RECORD PREVIOUSLY READ. IX2034.2 +046500 OPEN INPUT IX-FD1. IX2034.2 +046600 MOVE ZERO TO WRK-CS-09V00-006. IX2034.2 +046700 MOVE ZERO TO WRK-CS-09V00-007. IX2034.2 +046800 MOVE ZERO TO WRK-CS-09V00-008. IX2034.2 +046900 MOVE ZERO TO WRK-CS-09V00-009. IX2034.2 +047000 MOVE ZERO TO WRK-CS-09V00-010. IX2034.2 +047100 MOVE ZERO TO WRK-CS-09V00-011. IX2034.2 +047200 MOVE SPACE TO FILE-RECORD-INFO (1). IX2034.2 +047300 MOVE ZERO TO WRK-DU-09V00-001. IX2034.2 +047400 MOVE IX-FD1-KEY TO COMPUTED-A. IX2034.2 +047500 MOVE SPACE TO P-OR-F. IX2034.2 +047600 MOVE "INFORMATION" TO CORRECT-A. IX2034.2 +047700 MOVE "KEY AFTER OPEN" TO RE-MARK. IX2034.2 +047800 MOVE "RECORD KEY ON OPEN" TO FEATURE. IX2034.2 +047900 MOVE "READ-INIT-F1-01" TO PAR-NAME. IX2034.2 +048000 PERFORM PRINT-DETAIL. IX2034.2 +048100* IX2034.2 +048200* IX2034.2 +048300* IX2034.2 +048400 READ-INIT-F1-01-0. IX2034.2 +048500 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2034.2 +048600 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +048700 READ-TEST-F1-01-R. IX2034.2 +048800 ADD 1 TO WRK-CS-09V00-006. IX2034.2 +048900 READ IX-FD1 NEXT RECORD IX2034.2 +049000 AT END GO TO READ-TEST-F1-01. IX2034.2 +049100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2034.2 +049200 IF UPDATE-NUMBER (1) EQUAL TO 00 IX2034.2 +049300 ADD 1 TO WRK-CS-09V00-007 IX2034.2 +049400 GO TO READ-TEST-F1-01-2. IX2034.2 +049500 IF UPDATE-NUMBER (1) EQUAL TO 01 IX2034.2 +049600 ADD 1 TO WRK-CS-09V00-008 IX2034.2 +049700 GO TO READ-TEST-F1-01-2. IX2034.2 +049800 ADD 1 TO WRK-CS-09V00-009. IX2034.2 +049900 READ-TEST-F1-01-2. IX2034.2 +050000 MOVE XRECORD-KEY (1) TO IX-WRK-KEY. IX2034.2 +050100 IF WRK-DU-09V00-001 NOT EQUAL TO XRECORD-NUMBER (1) IX2034.2 +050200 ADD 1 TO WRK-CS-09V00-010. IX2034.2 +050300 IF WRK-CS-09V00-006 GREATER 501 IX2034.2 +050400 GO TO READ-TEST-F1-01. IX2034.2 +050500 GO TO READ-TEST-F1-01-R. IX2034.2 +050600 READ-TEST-F1-01. IX2034.2 +050700 IF WRK-CS-09V00-006 NOT EQUAL TO 501 IX2034.2 +050800 MOVE "INCORRECT RECORD COUNT" TO RE-MARK IX2034.2 +050900 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX2034.2 +051000 MOVE 500 TO CORRECT-18V0 IX2034.2 +051100 MOVE "IX-28; 4.5.2 FORMAT 1 " TO RE-MARK IX2034.2 +051200 PERFORM FAIL IX2034.2 +051300 ELSE IX2034.2 +051400 PERFORM PASS. IX2034.2 +051500 PERFORM PRINT-DETAIL. IX2034.2 +051600* IX2034.2 +051700* IX2034.2 +051800* IX2034.2 +051900 READ-TEST-F1-02. IX2034.2 +052000 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX2034.2 +052100 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +052200 IF WRK-CS-09V00-007 EQUAL TO 400 IX2034.2 +052300 PERFORM PASS IX2034.2 +052400 ELSE IX2034.2 +052500 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A IX2034.2 +052600 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 IX2034.2 +052700 MOVE "SHOULD BE 400; IX-28; 4.5.2 FORMAT 1 " IX2034.2 +052800 TO RE-MARK IX2034.2 +052900 PERFORM FAIL. IX2034.2 +053000 PERFORM PRINT-DETAIL. IX2034.2 +053100* IX2034.2 +053200* IX2034.2 +053300* IX2034.2 +053400 READ-TEST-F1-03. IX2034.2 +053500 MOVE "READ-TEST-F1-03" TO PAR-NAME. IX2034.2 +053600 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +053700 IF WRK-CS-09V00-008 EQUAL TO 100 IX2034.2 +053800 PERFORM PASS IX2034.2 +053900 ELSE IX2034.2 +054000 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 IX2034.2 +054100 MOVE 100 TO CORRECT-18V0 IX2034.2 +054200 MOVE "IX-28; 4.5.2 FORMAT 1 " TO RE-MARK IX2034.2 +054300 PERFORM FAIL. IX2034.2 +054400 PERFORM PRINT-DETAIL. IX2034.2 +054500* IX2034.2 +054600 READ-TEST-F1-04. IX2034.2 +054700 MOVE "READ-TEST-F1-04" TO PAR-NAME. IX2034.2 +054800 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +054900 IF WRK-CS-09V00-009 EQUAL TO ZERO IX2034.2 +055000 PERFORM PASS IX2034.2 +055100 ELSE IX2034.2 +055200 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX2034.2 +055300 MOVE ZERO TO CORRECT-18V0 IX2034.2 +055400 MOVE "BAD UPDATES; IX-28; 4.5.2 FORMAT 1 " IX2034.2 +055500 TO RE-MARK IX2034.2 +055600 PERFORM FAIL. IX2034.2 +055700 PERFORM PRINT-DETAIL. IX2034.2 +055800* IX2034.2 +055900 READ-TEST-F1-05. IX2034.2 +056000 MOVE "READ-TEST-F1-05" TO PAR-NAME. IX2034.2 +056100 MOVE "READ NEXT RECORD" TO FEATURE. IX2034.2 +056200 IF WRK-CS-09V00-010 EQUAL TO ZERO IX2034.2 +056300 PERFORM PASS IX2034.2 +056400 ELSE IX2034.2 +056500 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 IX2034.2 +056600 MOVE ZERO TO CORRECT-18V0 IX2034.2 +056700 MOVE "IX-28; 4.5.2 FORMAT 1; KEY VS RECORD" IX2034.2 +056800 TO RE-MARK IX2034.2 +056900 PERFORM FAIL. IX2034.2 +057000 PERFORM PRINT-DETAIL. IX2034.2 +057100 CLOSE IX-FD1. IX2034.2 +057200* IX2034.2 +057300* R E A D NEXT RECORD IX2034.2 +057400* IX2034.2 +057500 DELETE-INIT-GF-01. IX2034.2 +057600 OPEN I-O IX-FD1. IX2034.2 +057700 MOVE ZERO TO WRK-CS-09V00-006 IX2034.2 +057800 MOVE ZERO TO WRK-CS-09V00-007 IX2034.2 +057900 MOVE ZERO TO WRK-CS-09V00-008 IX2034.2 +058000 MOVE ZERO TO WRK-CS-09V00-009 IX2034.2 +058100 MOVE ZERO TO WRK-CS-09V00-010 IX2034.2 +058200 MOVE ZERO TO WRK-CS-09V00-011 IX2034.2 +058300 IX2034.2 +058400 MOVE SPACE TO FILE-RECORD-INFO (1). IX2034.2 +058500 MOVE "DELETE " TO FEATURE. IX2034.2 +058600 MOVE "DELETE-TEST-GF-01" TO PAR-NAME. IX2034.2 +058700 DELETE-TEST-GF-01-R. IX2034.2 +058800 ADD 1 TO WRK-CS-09V00-006 IX2034.2 +058900 ADD 1 TO WRK-CS-09V00-007. IX2034.2 +059000 READ IX-FD1 NEXT RECORD IX2034.2 +059100 AT END IX2034.2 +059200 MOVE "AT END PATH TAKEN " TO RE-MARK IX2034.2 +059300 GO TO DELETE-TEST-GF-01. IX2034.2 +059400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2034.2 +059500 IF WRK-CS-09V00-007 EQUAL TO 4 IX2034.2 +059600 GO TO DELETE-TEST-GF-01-2. IX2034.2 +059700 IF WRK-CS-09V00-006 GREATER 501 IX2034.2 +059800 MOVE "AT END NOT TAKEN" TO RE-MARK IX2034.2 +059900 GO TO DELETE-TEST-GF-01. IX2034.2 +060000 GO TO DELETE-TEST-GF-01-R. IX2034.2 +060100 DELETE-TEST-GF-01-2. IX2034.2 +060200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2034.2 +060300 MOVE 99 TO UPDATE-NUMBER (1). IX2034.2 +060400 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2034.2 +060500 DELETE IX-FD1 INVALID KEY IX2034.2 +060600 ADD 1 TO WRK-CS-09V00-009 IX2034.2 +060700 MOVE ZERO TO WRK-CS-09V00-007 IX2034.2 +060800 GO TO DELETE-TEST-GF-01-R. IX2034.2 +060900 MOVE ZERO TO WRK-CS-09V00-007. IX2034.2 +061000 ADD 1 TO WRK-CS-09V00-008 IX2034.2 +061100 GO TO DELETE-TEST-GF-01-R. IX2034.2 +061200 DELETE-TEST-GF-01. IX2034.2 +061300 IF WRK-CS-09V00-006 NOT EQUAL TO 501 IX2034.2 +061400 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX2034.2 +061500 MOVE 501 TO CORRECT-18V0 IX2034.2 +061600 MOVE "IX-21; 4.3.2 " TO RE-MARK IX2034.2 +061700 PERFORM FAIL IX2034.2 +061800 ELSE IX2034.2 +061900 PERFORM PASS. IX2034.2 +062000 PERFORM PRINT-DETAIL. IX2034.2 +062100* IX2034.2 +062200* IX2034.2 +062300* IX2034.2 +062400 DELETE-TEST-GF-02. IX2034.2 +062500 MOVE "DELETE " TO FEATURE. IX2034.2 +062600 MOVE "DELETE-TEST-GF-02" TO PAR-NAME IX2034.2 +062700 IF WRK-CS-09V00-008 NOT EQUAL TO 125 IX2034.2 +062800 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 IX2034.2 +062900 MOVE 125 TO CORRECT-18V0 IX2034.2 +063000 MOVE "DELETED RECORDS; IX-21; 4.3.2 " TO RE-MARK IX2034.2 +063100 PERFORM FAIL IX2034.2 +063200 ELSE IX2034.2 +063300 PERFORM PASS. IX2034.2 +063400 PERFORM PRINT-DETAIL. IX2034.2 +063500* IX2034.2 +063600* IX2034.2 +063700* IX2034.2 +063800 DELETE-TEST-GF-03. IX2034.2 +063900 MOVE "DELETE " TO FEATURE. IX2034.2 +064000 MOVE "DELETE-TEST-GF-03" TO PAR-NAME. IX2034.2 +064100 IF WRK-CS-09V00-009 EQUAL TO ZERO IX2034.2 +064200 PERFORM PASS IX2034.2 +064300 ELSE IX2034.2 +064400 PERFORM FAIL IX2034.2 +064500 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX2034.2 +064600 MOVE ZERO TO CORRECT-18V0 IX2034.2 +064700 MOVE "INVALID KEY; IX-21; 4.3.2 " TO RE-MARK. IX2034.2 +064800 PERFORM PRINT-DETAIL. IX2034.2 +064900 CLOSE IX-FD1. IX2034.2 +065000* IX2034.2 +065100* IX2034.2 +065200* IX2034.2 +065300 DELETE-INIT-GF-04. IX2034.2 +065400 MOVE "DELETE-TEST-GF-04" TO PAR-NAME. IX2034.2 +065500 MOVE ZERO TO WRK-CS-09V00-006 IX2034.2 +065600 MOVE ZERO TO WRK-CS-09V00-007 IX2034.2 +065700 MOVE ZERO TO WRK-CS-09V00-008 IX2034.2 +065800 MOVE ZERO TO WRK-CS-09V00-009 IX2034.2 +065900 MOVE ZERO TO WRK-CS-09V00-010 IX2034.2 +066000 MOVE ZERO TO WRK-CS-09V00-011 IX2034.2 +066100 MOVE SPACE TO FILE-RECORD-INFO (1). IX2034.2 +066200 MOVE ZERO TO WRK-DU-09V00-001. IX2034.2 +066300 OPEN INPUT IX-FD1. IX2034.2 +066400 DELETE-TEST-GF-04-R. IX2034.2 +066500 ADD 1 TO WRK-CS-09V00-006. IX2034.2 +066600 ADD 1 TO WRK-CS-09V00-007. IX2034.2 +066700 ADD 1 TO WRK-CS-09V00-008. IX2034.2 +066800 READ IX-FD1 NEXT RECORD AT END GO TO DELETE-TEST-GF-04. IX2034.2 +066900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2034.2 +067000 IF UPDATE-NUMBER (1) EQUAL TO 99 IX2034.2 +067100 ADD 1 TO WRK-CS-09V00-009. IX2034.2 +067200 IF WRK-CS-09V00-007 EQUAL TO 4 IX2034.2 +067300 MOVE 01 TO WRK-CS-09V00-007 IX2034.2 +067400 ADD 1 TO WRK-CS-09V00-008. IX2034.2 +067500 MOVE XRECORD-KEY (1) TO IX-WRK-KEY. IX2034.2 +067600 MOVE WRK-CS-09V00-008 TO WRK-DU-09V00-001. IX2034.2 +067700 IF IX-WRK-KEY EQUAL TO IX-FD1-KEY IX2034.2 +067800 ADD 1 TO WRK-CS-09V00-010. IX2034.2 +067900 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 IX2034.2 +068000 ADD 1 TO WRK-CS-09V00-011. IX2034.2 +068100 IF WRK-CS-09V00-006 GREATER 501 IX2034.2 +068200 GO TO DELETE-TEST-GF-04. IX2034.2 +068300 GO TO DELETE-TEST-GF-04-R. IX2034.2 +068400 DELETE-TEST-GF-04. IX2034.2 +068500 IF WRK-CS-09V00-006 NOT EQUAL TO 376 IX2034.2 +068600 MOVE "IX-21; 4.3.2; INCORRECT RECORD COUNT" IX2034.2 +068700 TO RE-MARK IX2034.2 +068800 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 IX2034.2 +068900 MOVE 376 TO CORRECT-18V0 IX2034.2 +069000 PERFORM FAIL IX2034.2 +069100 ELSE IX2034.2 +069200 PERFORM PASS. IX2034.2 +069300 PERFORM PRINT-DETAIL. IX2034.2 +069400* IX2034.2 +069500 DELETE-TEST-GF-05. IX2034.2 +069600 MOVE "DELETE " TO FEATURE. IX2034.2 +069700 MOVE "DELETE-TEST-GF-05" TO PAR-NAME IX2034.2 +069800 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO IX2034.2 +069900 MOVE ZERO TO CORRECT-18V0 IX2034.2 +070000 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 IX2034.2 +070100 MOVE "IX-21; 4.3.2; DELETED RECORDDS" TO RE-MARK IX2034.2 +070200 PERFORM FAIL IX2034.2 +070300 ELSE IX2034.2 +070400 PERFORM PASS. IX2034.2 +070500 PERFORM PRINT-DETAIL. IX2034.2 +070600* IX2034.2 +070700 DELETE-TEST-GF-06. IX2034.2 +070800 MOVE "DELETE " TO FEATURE. IX2034.2 +070900 MOVE "DELETE-TEST-GF-06" TO PAR-NAME IX2034.2 +071000 IF WRK-CS-09V00-010 NOT EQUAL TO 375 IX2034.2 +071100 MOVE 375 TO CORRECT-18V0 IX2034.2 +071200 MOVE "IX-21; 4.3.2; KEY MISMATCH" TO RE-MARK IX2034.2 +071300 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 IX2034.2 +071400 PERFORM FAIL IX2034.2 +071500 ELSE IX2034.2 +071600 PERFORM PASS. IX2034.2 +071700 PERFORM PRINT-DETAIL. IX2034.2 +071800* IX2034.2 +071900 DELETE-TEST-GF-07. IX2034.2 +072000 MOVE "DELETE " TO FEATURE. IX2034.2 +072100 MOVE "DELETE-TEST-GF-07" TO PAR-NAME IX2034.2 +072200 IF WRK-CS-09V00-011 NOT EQUAL TO 375 IX2034.2 +072300 MOVE 375 TO CORRECT-18V0 IX2034.2 +072400 MOVE "INCORRECT RECORD FOUND; IX-21, 4.3.2" IX2034.2 +072500 TO RE-MARK IX2034.2 +072600 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 IX2034.2 +072700 PERFORM FAIL IX2034.2 +072800 ELSE IX2034.2 +072900 PERFORM PASS. IX2034.2 +073000 PERFORM PRINT-DETAIL. IX2034.2 +073100 CLOSE IX-FD1. IX2034.2 +073200 IX2034.2 +073300 IX2034.2 +073400 CCVS-999999. IX2034.2 +073500 GO TO CLOSE-FILES. IX2034.2 diff --git a/tests/cobol85/IX/IX204A.CBL b/tests/cobol85/IX/IX204A.CBL new file mode 100755 index 00000000..ed935da1 --- /dev/null +++ b/tests/cobol85/IX/IX204A.CBL @@ -0,0 +1,739 @@ +000100 IDENTIFICATION DIVISION. IX2044.2 +000200 PROGRAM-ID. IX2044.2 +000300 IX204A. IX2044.2 +000400**************************************************************** IX2044.2 +000500* * IX2044.2 +000600* VALIDATION FOR:- * IX2044.2 +000700* * IX2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2044.2 +000900* * IX2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2044.2 +001100* * IX2044.2 +001200**************************************************************** IX2044.2 +001300*IX204A IX2044.2 +001400******************************************************************IX2044.2 +001500* IX2044.2 +001600* NEW TESTS: IX2044.2 +001700* CLOSE ... IX2044.2 +001800* IX2044.2 +001900* IX2044.2 +002000* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND SEMANTIC IX2044.2 +002100* ACTIONS ASSOCIATED WITH THE FOLLOWING ELEMENTS: IX2044.2 +002200* IX2044.2 +002300* (1) FILE STATUS (ONLY 00 & 10) IX2044.2 +002400* (2) USE AFTER ERROR PROCEDURE ON FILE-NAME IX2044.2 +002500* (3) READ IX2044.2 +002600* (4) WRITE IX2044.2 +002700* (5) REWRITE IX2044.2 +002800* (6) RECORD KEY IX2044.2 +002900* (7) ACCESS IX2044.2 +003000* IX2044.2 +003100* THIS PROGRAM CREATES AN INDEXED FILE SEQUENTIALLY (ACCESS IX2044.2 +003200* MODE DYMANIC) AND THEN UPDATES SELECTIVE RECORDS OF THE FILE.IX2044.2 +003300* THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR ACCURACYIX2044.2 +003400* FOR EACH OPEN, CLOSE, READ AND REWRITE STATEMENT USED. THE IX2044.2 +003500* READ, WRITE AND REWRITE STATEMENTS ARE USED WITHOUT THE IX2044.2 +003600* APPROPRIATE AT END OR INVALID KEY PHRASES. THE OMISSION OF IX2044.2 +003700* THESE PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE IX2044.2 +003800* HAS BEEN SPECIFIED. IX2044.2 +003900* IX2044.2 +004000* IX2044.2 +004100* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2044.2 +004200* IX2044.2 +004300* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2044.2 +004400* CLAUSE FOR DATA FILE IX-FD2 IX2044.2 +004500* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2044.2 +004600* CLAUSE FOR INDEX FILE IX-FD2 IX2044.2 +004700* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2044.2 +004800* X-62 IMPLEMENTOR-NAME FOR RAW-DATA IX2044.2 +004900* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2044.2 +005000* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2044.2 +005100* X-84 LABEL RECORDS FOR PRINT-FILEPUTER IX2044.2 +005200* IX2044.2 +005300* NOTE: X-CARDS 45, 62 AND 84 ARE OPTIONAL IX2044.2 +005400* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2044.2 +005500* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2044.2 +005600* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2044.2 +005700* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2044.2 +005800* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2044.2 +005900* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2044.2 +006000* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2044.2 +006100* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2044.2 +006200* THEY ARE AS FOLLOWS IX2044.2 +006300* IX2044.2 +006400* P SELECTS X-CARDS 62 IX2044.2 +006500* J SELECTS X-CARD 45 IX2044.2 +006600* C SELECTS X-CARD 84 IX2044.2 +006700* IX2044.2 +006800****************************************************** IX2044.2 +006900 ENVIRONMENT DIVISION. IX2044.2 +007000 CONFIGURATION SECTION. IX2044.2 +007100 SOURCE-COMPUTER. IX2044.2 +007200 Linux. IX2044.2 +007300 OBJECT-COMPUTER. IX2044.2 +007400 Linux. IX2044.2 +007500 INPUT-OUTPUT SECTION. IX2044.2 +007600 FILE-CONTROL. IX2044.2 +007700*P SELECT RAW-DATA ASSIGN TO IX2044.2 +007800*P "XXXXX062" IX2044.2 +007900*P ORGANIZATION IS INDEXED IX2044.2 +008000*P ACCESS MODE IS RANDOM IX2044.2 +008100*P RECORD KEY IS RAW-DATA-KEY. IX2044.2 +008200 SELECT PRINT-FILE ASSIGN TO IX2044.2 +008300 "report.log". IX2044.2 +008400 SELECT IX-FD2 ASSIGN IX2044.2 +008500 "XXXXX025" IX2044.2 +008600*J **** X-CARD UNDEFINED **** IX2044.2 +008700 ORGANIZATION IS INDEXED IX2044.2 +008800 ACCESS DYNAMIC IX2044.2 +008900 FILE STATUS IS IX-FD2-STATUS IX2044.2 +009000 RECORD IX-FD2-KEY. IX2044.2 +009100 DATA DIVISION. IX2044.2 +009200 FILE SECTION. IX2044.2 +009300*P IX2044.2 +009400*PD RAW-DATA. IX2044.2 +009500*P IX2044.2 +009600*P1 RAW-DATA-SATZ. IX2044.2 +009700*P 05 RAW-DATA-KEY PIC X(6). IX2044.2 +009800*P 05 C-DATE PIC 9(6). IX2044.2 +009900*P 05 C-TIME PIC 9(8). IX2044.2 +010000*P 05 C-NO-OF-TESTS PIC 99. IX2044.2 +010100*P 05 C-OK PIC 999. IX2044.2 +010200*P 05 C-ALL PIC 999. IX2044.2 +010300*P 05 C-FAIL PIC 999. IX2044.2 +010400*P 05 C-DELETED PIC 999. IX2044.2 +010500*P 05 C-INSPECT PIC 999. IX2044.2 +010600*P 05 C-NOTE PIC X(13). IX2044.2 +010700*P 05 C-INDENT PIC X. IX2044.2 +010800*P 05 C-ABORT PIC X(8). IX2044.2 +010900 FD PRINT-FILE. IX2044.2 +011000 01 PRINT-REC PICTURE X(120). IX2044.2 +011100 01 DUMMY-RECORD PICTURE X(120). IX2044.2 +011200 FD IX-FD2 IX2044.2 +011300*C LABEL RECORDS ARE STANDARD IX2044.2 +011400*C DATA RECORDS IX-FD2R1-F-G-240 IX2044.2 +011500 BLOCK CONTAINS 480 IX2044.2 +011600 RECORD CONTAINS 240 CHARACTERS. IX2044.2 +011700 01 IX-FD2R1-F-G-240. IX2044.2 +011800 05 IX-FD2-REC-120 PIC X(120). IX2044.2 +011900 05 IX-FD2-REC-120-240. IX2044.2 +012000 10 FILLER PICTURE X(8). IX2044.2 +012100 10 IX-FD2-KEY PIC X(29). IX2044.2 +012200 10 FILLER PIC X(83). IX2044.2 +012300 WORKING-STORAGE SECTION. IX2044.2 +012400 01 GRP-0101. IX2044.2 +012500 02 FILLER PIC X(10) VALUE "ABCD921XYZ". IX2044.2 +012600 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2044.2 +012700 02 FILLER PIC X(10) VALUE "Z2F()$+-AB". IX2044.2 +012800 01 GRP-0001. IX2044.2 +012900 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013000 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013100 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013200 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013300 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013400 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013500 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. IX2044.2 +013600 05 IX-FD2-STATUS PIC XX VALUE SPACE. IX2044.2 +013700 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. IX2044.2 +013800 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. IX2044.2 +013900 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. IX2044.2 +014000 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. IX2044.2 +014100 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. IX2044.2 +014200 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. IX2044.2 +014300 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. IX2044.2 +014400 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. IX2044.2 +014500 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. IX2044.2 +014600 01 DUMMY-WRK-REC. IX2044.2 +014700 02 DUMMY-WRK1 PIC X(120). IX2044.2 +014800 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX2044.2 +014900 03 FILLER PIC X(5). IX2044.2 +015000 03 DUMMY-WRK-INDENT-5 PIC X(115). IX2044.2 +015100 01 FILE-RECORD-INFORMATION-REC. IX2044.2 +015200 03 FILE-RECORD-INFO-SKELETON. IX2044.2 +015300 05 FILLER PICTURE X(48) VALUE IX2044.2 +015400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2044.2 +015500 05 FILLER PICTURE X(46) VALUE IX2044.2 +015600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2044.2 +015700 05 FILLER PICTURE X(26) VALUE IX2044.2 +015800 ",LFIL=000000,ORG= ,LBLR= ". IX2044.2 +015900 05 FILLER PICTURE X(37) VALUE IX2044.2 +016000 ",RECKEY= ". IX2044.2 +016100 05 FILLER PICTURE X(38) VALUE IX2044.2 +016200 ",ALTKEY1= ". IX2044.2 +016300 05 FILLER PICTURE X(38) VALUE IX2044.2 +016400 ",ALTKEY2= ". IX2044.2 +016500 05 FILLER PICTURE X(7) VALUE SPACE.IX2044.2 +016600 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2044.2 +016700 05 FILE-RECORD-INFO-P1-120. IX2044.2 +016800 07 FILLER PIC X(5). IX2044.2 +016900 07 XFILE-NAME PIC X(6). IX2044.2 +017000 07 FILLER PIC X(8). IX2044.2 +017100 07 XRECORD-NAME PIC X(6). IX2044.2 +017200 07 FILLER PIC X(1). IX2044.2 +017300 07 REELUNIT-NUMBER PIC 9(1). IX2044.2 +017400 07 FILLER PIC X(7). IX2044.2 +017500 07 XRECORD-NUMBER PIC 9(6). IX2044.2 +017600 07 FILLER PIC X(6). IX2044.2 +017700 07 UPDATE-NUMBER PIC 9(2). IX2044.2 +017800 07 FILLER PIC X(5). IX2044.2 +017900 07 ODO-NUMBER PIC 9(4). IX2044.2 +018000 07 FILLER PIC X(5). IX2044.2 +018100 07 XPROGRAM-NAME PIC X(5). IX2044.2 +018200 07 FILLER PIC X(7). IX2044.2 +018300 07 XRECORD-LENGTH PIC 9(6). IX2044.2 +018400 07 FILLER PIC X(7). IX2044.2 +018500 07 CHARS-OR-RECORDS PIC X(2). IX2044.2 +018600 07 FILLER PIC X(1). IX2044.2 +018700 07 XBLOCK-SIZE PIC 9(4). IX2044.2 +018800 07 FILLER PIC X(6). IX2044.2 +018900 07 RECORDS-IN-FILE PIC 9(6). IX2044.2 +019000 07 FILLER PIC X(5). IX2044.2 +019100 07 XFILE-ORGANIZATION PIC X(2). IX2044.2 +019200 07 FILLER PIC X(6). IX2044.2 +019300 07 XLABEL-TYPE PIC X(1). IX2044.2 +019400 05 FILE-RECORD-INFO-P121-240. IX2044.2 +019500 07 FILLER PIC X(8). IX2044.2 +019600 07 XRECORD-KEY PIC X(29). IX2044.2 +019700 07 FILLER PIC X(9). IX2044.2 +019800 07 ALTERNATE-KEY1 PIC X(29). IX2044.2 +019900 07 FILLER PIC X(9). IX2044.2 +020000 07 ALTERNATE-KEY2 PIC X(29). IX2044.2 +020100 07 FILLER PIC X(7). IX2044.2 +020200 01 TEST-RESULTS. IX2044.2 +020300 02 FILLER PIC X VALUE SPACE. IX2044.2 +020400 02 FEATURE PIC X(20) VALUE SPACE. IX2044.2 +020500 02 FILLER PIC X VALUE SPACE. IX2044.2 +020600 02 P-OR-F PIC X(5) VALUE SPACE. IX2044.2 +020700 02 FILLER PIC X VALUE SPACE. IX2044.2 +020800 02 PAR-NAME. IX2044.2 +020900 03 FILLER PIC X(19) VALUE SPACE. IX2044.2 +021000 03 PARDOT-X PIC X VALUE SPACE. IX2044.2 +021100 03 DOTVALUE PIC 99 VALUE ZERO. IX2044.2 +021200 02 FILLER PIC X(8) VALUE SPACE. IX2044.2 +021300 02 RE-MARK PIC X(61). IX2044.2 +021400 01 TEST-COMPUTED. IX2044.2 +021500 02 FILLER PIC X(30) VALUE SPACE. IX2044.2 +021600 02 FILLER PIC X(17) VALUE IX2044.2 +021700 " COMPUTED=". IX2044.2 +021800 02 COMPUTED-X. IX2044.2 +021900 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2044.2 +022000 03 COMPUTED-N REDEFINES COMPUTED-A IX2044.2 +022100 PIC -9(9).9(9). IX2044.2 +022200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2044.2 +022300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2044.2 +022400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2044.2 +022500 03 CM-18V0 REDEFINES COMPUTED-A. IX2044.2 +022600 04 COMPUTED-18V0 PIC -9(18). IX2044.2 +022700 04 FILLER PIC X. IX2044.2 +022800 03 FILLER PIC X(50) VALUE SPACE. IX2044.2 +022900 01 TEST-CORRECT. IX2044.2 +023000 02 FILLER PIC X(30) VALUE SPACE. IX2044.2 +023100 02 FILLER PIC X(17) VALUE " CORRECT =". IX2044.2 +023200 02 CORRECT-X. IX2044.2 +023300 03 CORRECT-A PIC X(20) VALUE SPACE. IX2044.2 +023400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2044.2 +023500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2044.2 +023600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2044.2 +023700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2044.2 +023800 03 CR-18V0 REDEFINES CORRECT-A. IX2044.2 +023900 04 CORRECT-18V0 PIC -9(18). IX2044.2 +024000 04 FILLER PIC X. IX2044.2 +024100 03 FILLER PIC X(2) VALUE SPACE. IX2044.2 +024200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2044.2 +024300 01 CCVS-C-1. IX2044.2 +024400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2044.2 +024500- "SS PARAGRAPH-NAME IX2044.2 +024600- " REMARKS". IX2044.2 +024700 02 FILLER PIC X(20) VALUE SPACE. IX2044.2 +024800 01 CCVS-C-2. IX2044.2 +024900 02 FILLER PIC X VALUE SPACE. IX2044.2 +025000 02 FILLER PIC X(6) VALUE "TESTED". IX2044.2 +025100 02 FILLER PIC X(15) VALUE SPACE. IX2044.2 +025200 02 FILLER PIC X(4) VALUE "FAIL". IX2044.2 +025300 02 FILLER PIC X(94) VALUE SPACE. IX2044.2 +025400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2044.2 +025500 01 REC-CT PIC 99 VALUE ZERO. IX2044.2 +025600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2044.2 +025700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2044.2 +025800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2044.2 +025900 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2044.2 +026000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2044.2 +026100 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2044.2 +026200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2044.2 +026300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2044.2 +026400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2044.2 +026500 01 CCVS-H-1. IX2044.2 +026600 02 FILLER PIC X(39) VALUE SPACES. IX2044.2 +026700 02 FILLER PIC X(42) VALUE IX2044.2 +026800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2044.2 +026900 02 FILLER PIC X(39) VALUE SPACES. IX2044.2 +027000 01 CCVS-H-2A. IX2044.2 +027100 02 FILLER PIC X(40) VALUE SPACE. IX2044.2 +027200 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2044.2 +027300 02 FILLER PIC XXXX VALUE IX2044.2 +027400 "4.2 ". IX2044.2 +027500 02 FILLER PIC X(28) VALUE IX2044.2 +027600 " COPY - NOT FOR DISTRIBUTION". IX2044.2 +027700 02 FILLER PIC X(41) VALUE SPACE. IX2044.2 +027800 IX2044.2 +027900 01 CCVS-H-2B. IX2044.2 +028000 02 FILLER PIC X(15) VALUE IX2044.2 +028100 "TEST RESULT OF ". IX2044.2 +028200 02 TEST-ID PIC X(9). IX2044.2 +028300 02 FILLER PIC X(4) VALUE IX2044.2 +028400 " IN ". IX2044.2 +028500 02 FILLER PIC X(12) VALUE IX2044.2 +028600 " HIGH ". IX2044.2 +028700 02 FILLER PIC X(22) VALUE IX2044.2 +028800 " LEVEL VALIDATION FOR ". IX2044.2 +028900 02 FILLER PIC X(58) VALUE IX2044.2 +029000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2044.2 +029100 01 CCVS-H-3. IX2044.2 +029200 02 FILLER PIC X(34) VALUE IX2044.2 +029300 " FOR OFFICIAL USE ONLY ". IX2044.2 +029400 02 FILLER PIC X(58) VALUE IX2044.2 +029500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2044.2 +029600 02 FILLER PIC X(28) VALUE IX2044.2 +029700 " COPYRIGHT 1985 ". IX2044.2 +029800 01 CCVS-E-1. IX2044.2 +029900 02 FILLER PIC X(52) VALUE SPACE. IX2044.2 +030000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2044.2 +030100 02 ID-AGAIN PIC X(9). IX2044.2 +030200 02 FILLER PIC X(45) VALUE SPACES. IX2044.2 +030300 01 CCVS-E-2. IX2044.2 +030400 02 FILLER PIC X(31) VALUE SPACE. IX2044.2 +030500 02 FILLER PIC X(21) VALUE SPACE. IX2044.2 +030600 02 CCVS-E-2-2. IX2044.2 +030700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2044.2 +030800 03 FILLER PIC X VALUE SPACE. IX2044.2 +030900 03 ENDER-DESC PIC X(44) VALUE IX2044.2 +031000 "ERRORS ENCOUNTERED". IX2044.2 +031100 01 CCVS-E-3. IX2044.2 +031200 02 FILLER PIC X(22) VALUE IX2044.2 +031300 " FOR OFFICIAL USE ONLY". IX2044.2 +031400 02 FILLER PIC X(12) VALUE SPACE. IX2044.2 +031500 02 FILLER PIC X(58) VALUE IX2044.2 +031600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2044.2 +031700 02 FILLER PIC X(13) VALUE SPACE. IX2044.2 +031800 02 FILLER PIC X(15) VALUE IX2044.2 +031900 " COPYRIGHT 1985". IX2044.2 +032000 01 CCVS-E-4. IX2044.2 +032100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2044.2 +032200 02 FILLER PIC X(4) VALUE " OF ". IX2044.2 +032300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2044.2 +032400 02 FILLER PIC X(40) VALUE IX2044.2 +032500 " TESTS WERE EXECUTED SUCCESSFULLY". IX2044.2 +032600 01 XXINFO. IX2044.2 +032700 02 FILLER PIC X(19) VALUE IX2044.2 +032800 "*** INFORMATION ***". IX2044.2 +032900 02 INFO-TEXT. IX2044.2 +033000 04 FILLER PIC X(8) VALUE SPACE. IX2044.2 +033100 04 XXCOMPUTED PIC X(20). IX2044.2 +033200 04 FILLER PIC X(5) VALUE SPACE. IX2044.2 +033300 04 XXCORRECT PIC X(20). IX2044.2 +033400 02 INF-ANSI-REFERENCE PIC X(48). IX2044.2 +033500 01 HYPHEN-LINE. IX2044.2 +033600 02 FILLER PIC IS X VALUE IS SPACE. IX2044.2 +033700 02 FILLER PIC IS X(65) VALUE IS "************************IX2044.2 +033800- "*****************************************". IX2044.2 +033900 02 FILLER PIC IS X(54) VALUE IS "************************IX2044.2 +034000- "******************************". IX2044.2 +034100 01 CCVS-PGM-ID PIC X(9) VALUE IX2044.2 +034200 "IX204A". IX2044.2 +034300 PROCEDURE DIVISION. IX2044.2 +034400 DECLARATIVES. IX2044.2 +034500 IX-FD2-01 SECTION. IX2044.2 +034600 USE AFTER STANDARD ERROR PROCEDURE ON IX-FD2. IX2044.2 +034700 IX-FD2-01-01. IX2044.2 +034800 ADD 1 TO WRK-CS-09V00-013. IX2044.2 +034900 GO TO IX-FD2-01-03 IX2044.2 +035000 IX-FD2-01-05 IX2044.2 +035100 DEPENDING ON WRK-CS-09V00-012. IX2044.2 +035200 GO TO IX-FD2-01-EXIT. IX2044.2 +035300 IX-FD2-01-03. IX2044.2 +035400*ENTRY FROM SEGMENT INX-TEST-001. IX2044.2 +035500* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX2044.2 +035600 ADD 1 TO WRK-CS-09V00-014. IX2044.2 +035700 IX-FD2-01-05. IX2044.2 +035800 ADD 1 TO WRK-CS-09V00-017. IX2044.2 +035900 IF XRECORD-NUMBER (2) EQUAL TO 500 IX2044.2 +036000 MOVE IX-FD2-STATUS TO WRK-XN-0002-002 IX2044.2 +036100 MOVE "10" TO WRK-XN-0002-003. IX2044.2 +036200 IX-FD2-01-EXIT. IX2044.2 +036300 EXIT. IX2044.2 +036400 END DECLARATIVES. IX2044.2 +036500 CCVS1 SECTION. IX2044.2 +036600 OPEN-FILES. IX2044.2 +036700*P OPEN I-O RAW-DATA. IX2044.2 +036800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2044.2 +036900*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2044.2 +037000*P MOVE "ABORTED " TO C-ABORT. IX2044.2 +037100*P ADD 1 TO C-NO-OF-TESTS. IX2044.2 +037200*P ACCEPT C-DATE FROM DATE. IX2044.2 +037300*P ACCEPT C-TIME FROM TIME. IX2044.2 +037400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2044.2 +037500*PND-E-1. IX2044.2 +037600*P CLOSE RAW-DATA. IX2044.2 +037700 OPEN OUTPUT PRINT-FILE. IX2044.2 +037800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2044.2 +037900 MOVE SPACE TO TEST-RESULTS. IX2044.2 +038000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2044.2 +038100 MOVE ZERO TO REC-SKL-SUB. IX2044.2 +038200 PERFORM CCVS-INIT-FILE 9 TIMES. IX2044.2 +038300 CCVS-INIT-FILE. IX2044.2 +038400 ADD 1 TO REC-SKL-SUB. IX2044.2 +038500 MOVE FILE-RECORD-INFO-SKELETON IX2044.2 +038600 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2044.2 +038700 CCVS-INIT-EXIT. IX2044.2 +038800 GO TO CCVS1-EXIT. IX2044.2 +038900 CLOSE-FILES. IX2044.2 +039000*P OPEN I-O RAW-DATA. IX2044.2 +039100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2044.2 +039200*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2044.2 +039300*P MOVE "OK. " TO C-ABORT. IX2044.2 +039400*P MOVE PASS-COUNTER TO C-OK. IX2044.2 +039500*P MOVE ERROR-HOLD TO C-ALL. IX2044.2 +039600*P MOVE ERROR-COUNTER TO C-FAIL. IX2044.2 +039700*P MOVE DELETE-COUNTER TO C-DELETED. IX2044.2 +039800*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2044.2 +039900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2044.2 +040000*PND-E-2. IX2044.2 +040100*P CLOSE RAW-DATA. IX2044.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2044.2 +040300 TERMINATE-CCVS. IX2044.2 +040400*S EXIT PROGRAM. IX2044.2 +040500*SERMINATE-CALL. IX2044.2 +040600 STOP RUN. IX2044.2 +040700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2044.2 +040800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2044.2 +040900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2044.2 +041000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2044.2 +041100 MOVE "****TEST DELETED****" TO RE-MARK. IX2044.2 +041200 PRINT-DETAIL. IX2044.2 +041300 IF REC-CT NOT EQUAL TO ZERO IX2044.2 +041400 MOVE "." TO PARDOT-X IX2044.2 +041500 MOVE REC-CT TO DOTVALUE. IX2044.2 +041600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2044.2 +041700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2044.2 +041800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2044.2 +041900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2044.2 +042000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2044.2 +042100 MOVE SPACE TO CORRECT-X. IX2044.2 +042200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2044.2 +042300 MOVE SPACE TO RE-MARK. IX2044.2 +042400 HEAD-ROUTINE. IX2044.2 +042500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +042600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +042700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2044.2 +042800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2044.2 +042900 COLUMN-NAMES-ROUTINE. IX2044.2 +043000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +043100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +043200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +043300 END-ROUTINE. IX2044.2 +043400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2044.2 +043500 END-RTN-EXIT. IX2044.2 +043600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +043700 END-ROUTINE-1. IX2044.2 +043800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2044.2 +043900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2044.2 +044000 ADD PASS-COUNTER TO ERROR-HOLD. IX2044.2 +044100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2044.2 +044200 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2044.2 +044300 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2044.2 +044400 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2044.2 +044500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2044.2 +044600 END-ROUTINE-12. IX2044.2 +044700 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2044.2 +044800 IF ERROR-COUNTER IS EQUAL TO ZERO IX2044.2 +044900 MOVE "NO " TO ERROR-TOTAL IX2044.2 +045000 ELSE IX2044.2 +045100 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2044.2 +045200 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2044.2 +045300 PERFORM WRITE-LINE. IX2044.2 +045400 END-ROUTINE-13. IX2044.2 +045500 IF DELETE-COUNTER IS EQUAL TO ZERO IX2044.2 +045600 MOVE "NO " TO ERROR-TOTAL ELSE IX2044.2 +045700 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2044.2 +045800 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2044.2 +045900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +046000 IF INSPECT-COUNTER EQUAL TO ZERO IX2044.2 +046100 MOVE "NO " TO ERROR-TOTAL IX2044.2 +046200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2044.2 +046300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2044.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +046500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2044.2 +046600 WRITE-LINE. IX2044.2 +046700 ADD 1 TO RECORD-COUNT. IX2044.2 +046800 IF RECORD-COUNT GREATER 42 IX2044.2 +046900 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2044.2 +047000 MOVE SPACE TO DUMMY-RECORD IX2044.2 +047100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2044.2 +047200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2044.2 +047300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2044.2 +047400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2044.2 +047500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2044.2 +047600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2044.2 +047700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2044.2 +047800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2044.2 +047900 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2044.2 +048000 MOVE ZERO TO RECORD-COUNT. IX2044.2 +048100 PERFORM WRT-LN. IX2044.2 +048200 WRT-LN. IX2044.2 +048300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2044.2 +048400 MOVE SPACE TO DUMMY-RECORD. IX2044.2 +048500 BLANK-LINE-PRINT. IX2044.2 +048600 PERFORM WRT-LN. IX2044.2 +048700 FAIL-ROUTINE. IX2044.2 +048800 IF COMPUTED-X NOT EQUAL TO SPACE IX2044.2 +048900 GO TO FAIL-ROUTINE-WRITE. IX2044.2 +049000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2044.2 +049100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2044.2 +049200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2044.2 +049300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +049400 MOVE SPACES TO INF-ANSI-REFERENCE. IX2044.2 +049500 GO TO FAIL-ROUTINE-EX. IX2044.2 +049600 FAIL-ROUTINE-WRITE. IX2044.2 +049700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2044.2 +049800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2044.2 +049900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2044.2 +050000 MOVE SPACES TO COR-ANSI-REFERENCE. IX2044.2 +050100 FAIL-ROUTINE-EX. EXIT. IX2044.2 +050200 BAIL-OUT. IX2044.2 +050300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2044.2 +050400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2044.2 +050500 BAIL-OUT-WRITE. IX2044.2 +050600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2044.2 +050700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2044.2 +050800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2044.2 +050900 MOVE SPACES TO INF-ANSI-REFERENCE. IX2044.2 +051000 BAIL-OUT-EX. EXIT. IX2044.2 +051100 CCVS1-EXIT. IX2044.2 +051200 EXIT. IX2044.2 +051300 SECT-IX-04-001 SECTION. IX2044.2 +051400 WRITE-INIT-GF-01. IX2044.2 +051500 MOVE "CREATE IX-FD2" TO FEATURE IX2044.2 +051600 MOVE "WRITE-TEST-001" TO PAR-NAME. IX2044.2 +051700 MOVE "IX-FD2" TO XFILE-NAME (2). IX2044.2 +051800 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2044.2 +051900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2044.2 +052000 MOVE 000240 TO XRECORD-LENGTH (2). IX2044.2 +052100 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2044.2 +052200 MOVE 0001 TO XBLOCK-SIZE (2). IX2044.2 +052300 MOVE 000500 TO RECORDS-IN-FILE (2). IX2044.2 +052400 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2044.2 +052500 MOVE "S" TO XLABEL-TYPE (2). IX2044.2 +052600 MOVE 000001 TO XRECORD-NUMBER (2). IX2044.2 +052700*INITIALIZE RECORD WORK AREA NUMBER 2. IX2044.2 +052800 MOVE 1 TO WRK-CS-09V00-012. IX2044.2 +052900 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX2044.2 +053000 WRK-CS-09V00-015 WRK-CS-09V00-016 IX2044.2 +053100 WRK-CS-09V00-017 WRK-CS-09V00-018. IX2044.2 +053200 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +053300 MOVE ZERO TO WRK-DU-09V00-001. IX2044.2 +053400 OPEN OUTPUT IX-FD2. IX2044.2 +053500 MOVE GRP-0101 TO IX-FD2-KEY. IX2044.2 +053600 MOVE IX-FD2-STATUS TO WRK-XN-0002-001. IX2044.2 +053700*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. IX2044.2 +053800 WRITE-TEST-GF-01-R. IX2044.2 +053900 MOVE "99" TO IX-FD2-STATUS. IX2044.2 +054000 MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX2044.2 +054100 MOVE GRP-0101 TO XRECORD-KEY (2). IX2044.2 +054200 MOVE FILE-RECORD-INFO (2) TO IX-FD2R1-F-G-240. IX2044.2 +054300 WRITE IX-FD2R1-F-G-240. IX2044.2 +054400 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +054500 ADD 1 TO WRK-CS-09V00-016. IX2044.2 +054600 IF XRECORD-NUMBER (2) EQUAL TO 500 IX2044.2 +054700 GO TO WRITE-TEST-GF-01. IX2044.2 +054800 ADD 01 TO XRECORD-NUMBER (2). IX2044.2 +054900 GO TO WRITE-TEST-GF-01-R. IX2044.2 +055000 WRITE-TEST-GF-01. IX2044.2 +055100 MOVE "WRITE IX-FD2." TO FEATURE. IX2044.2 +055200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2044.2 +055300 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX2044.2 +055400 MOVE "EXCEPTIONS/ERRORS; IX-41 4.9.2" TO RE-MARK IX2044.2 +055500 MOVE ZERO TO CORRECT-18V0 IX2044.2 +055600 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX2044.2 +055700 PERFORM FAIL IX2044.2 +055800 ELSE IX2044.2 +055900 PERFORM PASS. IX2044.2 +056000 PERFORM PRINT-DETAIL. IX2044.2 +056100 WRITE-TEST-GF-02. IX2044.2 +056200 MOVE "WRITE IX-FD2." TO FEATURE. IX2044.2 +056300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2044.2 +056400 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 IX2044.2 +056500 MOVE "INCORRECT COUNT; IX-41 4.9.2" TO RE-MARK IX2044.2 +056600 MOVE 500 TO CORRECT-18V0 IX2044.2 +056700 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX2044.2 +056800 PERFORM FAIL IX2044.2 +056900 ELSE IX2044.2 +057000 PERFORM PASS. IX2044.2 +057100 PERFORM PRINT-DETAIL. IX2044.2 +057200 WRITE-TEST-GF-03. IX2044.2 +057300 MOVE "OPEN OUTPUT 00" TO FEATURE. IX2044.2 +057400 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX2044.2 +057500 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX2044.2 +057600 MOVE "STATUS/OPEN; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +057700 MOVE WRK-XN-0002-001 TO COMPUTED-A IX2044.2 +057800 MOVE "00" TO CORRECT-A IX2044.2 +057900 PERFORM FAIL IX2044.2 +058000 ELSE IX2044.2 +058100 PERFORM PASS. IX2044.2 +058200 PERFORM PRINT-DETAIL. IX2044.2 +058300 WRITE-TEST-GF-04. IX2044.2 +058400 MOVE "WRITE STATUS 00" TO FEATURE. IX2044.2 +058500 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. IX2044.2 +058600 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +058700 MOVE "STATUS/WRITE; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +058800 MOVE IX-FD2-STATUS TO COMPUTED-A IX2044.2 +058900 MOVE "00" TO CORRECT-A IX2044.2 +059000 PERFORM FAIL IX2044.2 +059100 ELSE IX2044.2 +059200 PERFORM PASS. IX2044.2 +059300 PERFORM PRINT-DETAIL. IX2044.2 +059400 WRITE-TEST-GF-05. IX2044.2 +059500 MOVE "WRITE STATUS 00" TO FEATURE. IX2044.2 +059600 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. IX2044.2 +059700 IF WRK-CS-09V00-016 NOT EQUAL TO ZERO IX2044.2 +059800 MOVE "STATUS/WRITE; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +059900 MOVE ZERO TO CORRECT-18V0 IX2044.2 +060000 MOVE WRK-CS-09V00-016 TO COMPUTED-18V0 IX2044.2 +060100 PERFORM FAIL IX2044.2 +060200 ELSE IX2044.2 +060300 PERFORM PASS. IX2044.2 +060400 PERFORM PRINT-DETAIL. IX2044.2 +060500 WRITE-TEST-GF-06. IX2044.2 +060600 MOVE "CLOSE: STATUS: 00" TO FEATURE. IX2044.2 +060700 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. IX2044.2 +060800 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +060900 CLOSE IX-FD2. IX2044.2 +061000 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +061100 MOVE "CLOSE/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +061200 MOVE IX-FD2-STATUS TO COMPUTED-18V0 IX2044.2 +061300 MOVE "00" TO CORRECT-A IX2044.2 +061400 PERFORM FAIL IX2044.2 +061500 ELSE IX2044.2 +061600 PERFORM PASS. IX2044.2 +061700 PERFORM PRINT-DETAIL. IX2044.2 +061800 RWRT-INIT-GF-01. IX2044.2 +061900 MOVE 2 TO WRK-CS-09V00-012. IX2044.2 +062000 MOVE ZERO TO WRK-CS-09V00-013. IX2044.2 +062100 MOVE ZERO TO WRK-CS-09V00-014. IX2044.2 +062200 MOVE ZERO TO WRK-CS-09V00-015. IX2044.2 +062300 MOVE ZERO TO WRK-CS-09V00-016. IX2044.2 +062400 MOVE ZERO TO WRK-CS-09V00-017. IX2044.2 +062500 MOVE ZERO TO WRK-CS-09V00-018. IX2044.2 +062600 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +062700 OPEN I-O IX-FD2. IX2044.2 +062800 MOVE SPACE TO WRK-XN-0002-002 IX2044.2 +062900 MOVE SPACE TO WRK-XN-0002-003 IX2044.2 +063000 MOVE SPACE TO WRK-XN-0002-004 IX2044.2 +063100 MOVE IX-FD2-STATUS TO WRK-XN-0002-001 IX2044.2 +063200 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +063300*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. IX2044.2 +063400 RWRT-TEST-GF-01-R. IX2044.2 +063500 ADD 1 TO WRK-CS-09V00-014. IX2044.2 +063600 ADD 1 TO WRK-CS-09V00-015. IX2044.2 +063700 READ IX-FD2 NEXT RECORD. IX2044.2 +063800 IF IX-FD2-STATUS EQUAL TO "10" IX2044.2 +063900 GO TO RWRT-TEST-GF-01. IX2044.2 +064000 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2044.2 +064100 IF WRK-CS-09V00-015 EQUAL TO 5 IX2044.2 +064200 ADD 01 TO UPDATE-NUMBER (2) IX2044.2 +064300 MOVE FILE-RECORD-INFO (2) TO IX-FD2R1-F-G-240 IX2044.2 +064400 PERFORM RWRT-010-UPDATE IX2044.2 +064500 MOVE ZERO TO WRK-CS-09V00-015 IX2044.2 +064600 GO TO RWRT-TEST-GF-01-2. IX2044.2 +064700 IF WRK-CS-09V00-014 GREATER 500 IX2044.2 +064800 GO TO RWRT-TEST-GF-01. IX2044.2 +064900 GO TO RWRT-TEST-GF-01-R. IX2044.2 +065000 RWRT-010-UPDATE. IX2044.2 +065100 REWRITE IX-FD2R1-F-G-240. IX2044.2 +065200 RWRT-TEST-GF-01-2. IX2044.2 +065300 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +065400 ADD 1 TO WRK-CS-09V00-016. IX2044.2 +065500 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +065600 GO TO RWRT-TEST-GF-01-R. IX2044.2 +065700 RWRT-TEST-GF-01. IX2044.2 +065800 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. IX2044.2 +065900 MOVE "REWRITE IX-FD2" TO FEATURE. IX2044.2 +066000 IF WRK-CS-09V00-013 NOT EQUAL TO 1 IX2044.2 +066100 MOVE "EXCEPTIONS/ERRORS; IX-33 4.6.2" TO RE-MARK IX2044.2 +066200 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 IX2044.2 +066300 MOVE 1 TO CORRECT-18V0 IX2044.2 +066400 PERFORM FAIL IX2044.2 +066500 ELSE IX2044.2 +066600 PERFORM PASS. IX2044.2 +066700 PERFORM PRINT-DETAIL. IX2044.2 +066800 RWRT-TEST-GF-02. IX2044.2 +066900 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. IX2044.2 +067000 MOVE "UPDATE IX-FD2" TO FEATURE. IX2044.2 +067100 IF WRK-CS-09V00-014 NOT EQUAL TO 501 IX2044.2 +067200 MOVE "INCORRECT COUNT; IX-33 4.6.2" TO RE-MARK IX2044.2 +067300 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX2044.2 +067400 MOVE 501 TO CORRECT-18V0 IX2044.2 +067500 PERFORM FAIL IX2044.2 +067600 ELSE IX2044.2 +067700 PERFORM PASS. IX2044.2 +067800 PERFORM PRINT-DETAIL. IX2044.2 +067900 RWRT-TEST-GF-03. IX2044.2 +068000 MOVE "RWRT-TEST-GF-03" TO PAR-NAME. IX2044.2 +068100 MOVE "OPEN I-O STATUS: 00" TO FEATURE. IX2044.2 +068200 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX2044.2 +068300 MOVE "OPEN/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +068400 MOVE WRK-XN-0002-001 TO COMPUTED-A IX2044.2 +068500 MOVE "00" TO CORRECT-A IX2044.2 +068600 PERFORM FAIL IX2044.2 +068700 ELSE IX2044.2 +068800 PERFORM PASS. IX2044.2 +068900 PERFORM PRINT-DETAIL. IX2044.2 +069000 RWRT-TEST-GF-04. IX2044.2 +069100 MOVE "RWRT-TEST-GF-04" TO PAR-NAME. IX2044.2 +069200 MOVE "READ I-O STATUS 10" TO FEATURE. IX2044.2 +069300 IF IX-FD2-STATUS NOT EQUAL TO "10" IX2044.2 +069400 MOVE "AT END/STATUS; IX-4 1.3.4 (2) A" TO RE-MARK IX2044.2 +069500 MOVE IX-FD2-STATUS TO COMPUTED-A IX2044.2 +069600 MOVE "10" TO CORRECT-A IX2044.2 +069700 PERFORM FAIL IX2044.2 +069800 ELSE IX2044.2 +069900 PERFORM PASS. IX2044.2 +070000 PERFORM PRINT-DETAIL. IX2044.2 +070100 RWRT-TEST-GF-05. IX2044.2 +070200 MOVE "RWRT-TEST-GF-05" TO PAR-NAME. IX2044.2 +070300 MOVE "UPDATE IX-FD2" TO FEATURE. IX2044.2 +070400 IF WRK-XN-0002-002 NOT EQUAL TO "10" IX2044.2 +070500 MOVE "EXCEPTIN/STATUS; IX-4 1.3.4 (2) A" TO RE-MARKIX2044.2 +070600 MOVE WRK-XN-0002-002 TO COMPUTED-A IX2044.2 +070700 MOVE "10" TO CORRECT-A IX2044.2 +070800 PERFORM FAIL IX2044.2 +070900 ELSE IX2044.2 +071000 PERFORM PASS. IX2044.2 +071100 PERFORM PRINT-DETAIL. IX2044.2 +071200 RWRT-TEST-GF-06. IX2044.2 +071300 MOVE "RWRT-TEST-GF-06" TO PAR-NAME. IX2044.2 +071400 MOVE "STATUS: 10 " TO FEATURE. IX2044.2 +071500 IF WRK-XN-0002-003 NOT EQUAL TO "10" IX2044.2 +071600 MOVE "NO/EXCEPTION; IX-4 1.3.4 (2) A" TO RE-MARK IX2044.2 +071700 MOVE WRK-XN-0002-003 TO COMPUTED-A IX2044.2 +071800 MOVE "10" TO CORRECT-A IX2044.2 +071900 PERFORM FAIL IX2044.2 +072000 ELSE IX2044.2 +072100 PERFORM PASS. IX2044.2 +072200 PERFORM PRINT-DETAIL. IX2044.2 +072300 RWRT-TEST-GF-07. IX2044.2 +072400 MOVE "RWRT-TEST-GF-07" TO PAR-NAME. IX2044.2 +072500 MOVE "CLOSE . LOCK: 00" TO FEATURE. IX2044.2 +072600 MOVE SPACE TO IX-FD2-STATUS. IX2044.2 +072700 CLOSE IX-FD2 WITH LOCK. IX2044.2 +072800 IF IX-FD2-STATUS NOT EQUAL TO "00" IX2044.2 +072900 MOVE "CLOSE/STATUS; IX-3 1.3.4 (1) A" TO RE-MARK IX2044.2 +073000 MOVE IX-FD2-STATUS TO COMPUTED-A IX2044.2 +073100 MOVE "00" TO CORRECT-A IX2044.2 +073200 PERFORM FAIL IX2044.2 +073300 ELSE IX2044.2 +073400 PERFORM PASS. IX2044.2 +073500 PERFORM PRINT-DETAIL. IX2044.2 +073600 IX2044.2 +073700 CCVS-EXIT SECTION. IX2044.2 +073800 CCVS-999999. IX2044.2 +073900 GO TO CLOSE-FILES. IX2044.2 diff --git a/tests/cobol85/IX/IX205A.CBL b/tests/cobol85/IX/IX205A.CBL new file mode 100755 index 00000000..0657a388 --- /dev/null +++ b/tests/cobol85/IX/IX205A.CBL @@ -0,0 +1,973 @@ +000100 IDENTIFICATION DIVISION. IX2054.2 +000200 PROGRAM-ID. IX2054.2 +000300 IX205A. IX2054.2 +000400**************************************************************** IX2054.2 +000500* * IX2054.2 +000600* VALIDATION FOR:- * IX2054.2 +000700* * IX2054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2054.2 +000900* * IX2054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2054.2 +001100* * IX2054.2 +001200**************************************************************** IX2054.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLE IX2054.2 +001400* SYNTACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH IX2054.2 +001500* LEVEL 2 OF INDEXED I-O. THE ELEMENTS TESTED IN THIS ROU- IX2054.2 +001600* TINE ARE: IX2054.2 +001700* IX2054.2 +001800* (1) ACCESS MODE DYNAMIC; IX2054.2 +001900* (2) ALTERNATE RECORD KEY WITHOUT THE DUPLICATES OPTION; IX2054.2 +002000* (3) RESERVE CLAUSE; IX2054.2 +002100* (4) SAME CLAUSE; IX2054.2 +002200* (5) BLOCK CONTAINS INTEGER-1 TO INTEGER-2 CLAUSE; IX2054.2 +002300* (6) VALUE OF IMPLEMENTOR-NAME. IX2054.2 +002400* IX2054.2 +002500* NEW TEST: START ... IX2054.2 +002600* KEY IS GREATER THAN OR EQUAL TO ... IX2054.2 +002700* IX2054.2 +002800* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS IX2054.2 +002900* ROUTINE. FILES ARE CREATED AND ACCESSED USING THE ACCESS IX2054.2 +003000* MODE IS DYNAMIC. IX2054.2 +003100* IX2054.2 +003200* IX2054.2 +003300* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2054.2 +003400* IX2054.2 +003500* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2054.2 +003600* CLAUSE FOR DATA FILE IX-FS1 IX2054.2 +003700* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2054.2 +003800* CLAUSE FOR DATA FILE IX-FD2 IX2054.2 +003900* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2054.2 +004000* CLAUSE FOR INDEX FILE IX-FS1 IX2054.2 +004100* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2054.2 +004200* CLAUSE FOR INDEX FILE IX-FD2 IX2054.2 +004300* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2054.2 +004400* X-62 FOR RAW-DATA IX2054.2 +004500* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2054.2 +004600* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2054.2 +004700* X-84 LABEL RECORDS FOR PRINT-FILE IX2054.2 +004800* IX2054.2 +004900* NOTE: X-CARDS 44, 45, 62 AND 84 ARE OPTIONAL IX2054.2 +005000* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2054.2 +005100* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2054.2 +005200* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2054.2 +005300* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2054.2 +005400* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2054.2 +005500* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2054.2 +005600* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2054.2 +005700* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2054.2 +005800* THEY ARE AS FOLLOWS IX2054.2 +005900* IX2054.2 +006000* P SELECTS X-CARDS 62 IX2054.2 +006100* J SELECTS X-CARDS 44 AND 45 IX2054.2 +006200* C SELECTS X-CARDS 84 IX2054.2 +006300* IX2054.2 +006400****************************************************** IX2054.2 +006500 ENVIRONMENT DIVISION. IX2054.2 +006600 CONFIGURATION SECTION. IX2054.2 +006700 SOURCE-COMPUTER. IX2054.2 +006800 Linux. IX2054.2 +006900 OBJECT-COMPUTER. IX2054.2 +007000 Linux. IX2054.2 +007100 INPUT-OUTPUT SECTION. IX2054.2 +007200 FILE-CONTROL. IX2054.2 +007300*P SELECT RAW-DATA ASSIGN TO IX2054.2 +007400*P "XXXXX062" IX2054.2 +007500*P ORGANIZATION IS INDEXED IX2054.2 +007600*P ACCESS MODE IS RANDOM IX2054.2 +007700*P RECORD KEY IS RAW-DATA-KEY. IX2054.2 +007800 SELECT PRINT-FILE ASSIGN TO IX2054.2 +007900 "report.log". IX2054.2 +008000 SELECT IX-FD1 ASSIGN TO IX2054.2 +008100 "XXXXX024" IX2054.2 +008200*J **** X-CARD UNDEFINED **** IX2054.2 +008300 RESERVE 3 AREA IX2054.2 +008400 ORGANIZATION IS INDEXED IX2054.2 +008500 ACCESS MODE IS DYNAMIC IX2054.2 +008600 RECORD KEY IS IX-FD1-KEY IX2054.2 +008700 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY1. IX2054.2 +008800 SELECT IX-FD2 ASSIGN TO IX2054.2 +008900 "XXXXX025" IX2054.2 +009000*J **** X-CARD UNDEFINED **** IX2054.2 +009100 RESERVE 2 AREAS IX2054.2 +009200 ACCESS MODE DYNAMIC IX2054.2 +009300 ORGANIZATION INDEXED IX2054.2 +009400 RECORD KEY IX-FD2-KEY IX2054.2 +009500 ALTERNATE RECORD IX-FD2-ALTKEY1. IX2054.2 +009600 I-O-CONTROL. IX2054.2 +009700 SAME RECORD IX-FD1 IX-FD2. IX2054.2 +009800 DATA DIVISION. IX2054.2 +009900 FILE SECTION. IX2054.2 +010000*P IX2054.2 +010100*PD RAW-DATA. IX2054.2 +010200*P IX2054.2 +010300*P1 RAW-DATA-SATZ. IX2054.2 +010400*P 05 RAW-DATA-KEY PIC X(6). IX2054.2 +010500*P 05 C-DATE PIC 9(6). IX2054.2 +010600*P 05 C-TIME PIC 9(8). IX2054.2 +010700*P 05 C-NO-OF-TESTS PIC 99. IX2054.2 +010800*P 05 C-OK PIC 999. IX2054.2 +010900*P 05 C-ALL PIC 999. IX2054.2 +011000*P 05 C-FAIL PIC 999. IX2054.2 +011100*P 05 C-DELETED PIC 999. IX2054.2 +011200*P 05 C-INSPECT PIC 999. IX2054.2 +011300*P 05 C-NOTE PIC X(13). IX2054.2 +011400*P 05 C-INDENT PIC X. IX2054.2 +011500*P 05 C-ABORT PIC X(8). IX2054.2 +011600 FD PRINT-FILE. IX2054.2 +011700 01 PRINT-REC PICTURE X(120). IX2054.2 +011800 01 DUMMY-RECORD PICTURE X(120). IX2054.2 +011900 FD IX-FD1 IX2054.2 +012000*C LABEL RECORDS ARE STANDARD IX2054.2 +012100 RECORD CONTAINS 240 CHARACTERS. IX2054.2 +012200 01 IX-FD1R1-F-G-240. IX2054.2 +012300 05 IX-FD1-REC-120 PIC X(120). IX2054.2 +012400 05 IX-FD1-REC-120-240. IX2054.2 +012500 10 FILLER PIC X(8). IX2054.2 +012600 10 IX-FD1-REC-KEY. IX2054.2 +012700 15 FILLER PIC X(19). IX2054.2 +012800 15 IX-FD1-KEY PIC X(10). IX2054.2 +012900 10 FILLER PIC X(9). IX2054.2 +013000 10 IX-FD1-ALT1-KEY. IX2054.2 +013100 15 FILLER PIC X(19). IX2054.2 +013200 15 IX-FD1-ALTKEY1 PIC X(10). IX2054.2 +013300 10 FILLER PIC X(45). IX2054.2 +013400 FD IX-FD2 IX2054.2 +013500*C LABEL RECORDS ARE STANDARD IX2054.2 +013600 BLOCK CONTAINS 5 TO 25 RECORDS IX2054.2 +013700 RECORD CONTAINS 240 CHARACTERS. IX2054.2 +013800 01 IX-FD2R1-F-G-240. IX2054.2 +013900 05 IX-FD2-REC-120 PIC X(120). IX2054.2 +014000 05 IX-FD2-REC-120-240. IX2054.2 +014100 10 FILLER PIC X(8). IX2054.2 +014200 10 IX-FD2-REC-KEY. IX2054.2 +014300 15 FILLER PIC X(19). IX2054.2 +014400 15 IX-FD2-KEY PIC X(10). IX2054.2 +014500 10 FILLER PIC X(9). IX2054.2 +014600 10 IX-FD2-ALT1-KEY. IX2054.2 +014700 15 FILLER PIC X(19). IX2054.2 +014800 15 IX-FD2-ALTKEY1 PIC X(10). IX2054.2 +014900 10 FILLER PIC X(45). IX2054.2 +015000 WORKING-STORAGE SECTION. IX2054.2 +015100*01 IX-FD2-ID IX2054.2 +015200* **** X-CARD UNDEFINED ****. IX2054.2 +015300 01 WRK-CS-09V00-001 PIC S9(9) COMPUTATIONAL. IX2054.2 +015400 01 WRK-REC-KEY-FD1. IX2054.2 +015500 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +015600 03 WRK-DU-10V00-001 PIC 9(10) VALUE ZERO. IX2054.2 +015700 01 WRK-ALT1-KEY-FD1. IX2054.2 +015800 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +015900 03 WRK-DU-10V00-002 PIC 9(10) VALUE ZERO. IX2054.2 +016000 01 FD1-FILE-SIZE PIC 9(10) VALUE 200. IX2054.2 +016100 01 WRK-REC-KEY-FD2. IX2054.2 +016200 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +016300 03 WRK-DU-10V00-003 PIC 9(10) VALUE ZERO. IX2054.2 +016400 01 WRK-ALT1-KEY-FD2. IX2054.2 +016500 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +016600 03 WRK-DU-10V00-004 PIC 9(10) VALUE ZERO. IX2054.2 +016700 01 FD2-FILE-SIZE PIC 9(10) VALUE 200. IX2054.2 +016800 01 FILE-RECORD-INFORMATION-REC. IX2054.2 +016900 03 FILE-RECORD-INFO-SKELETON. IX2054.2 +017000 05 FILLER PICTURE X(48) VALUE IX2054.2 +017100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2054.2 +017200 05 FILLER PICTURE X(46) VALUE IX2054.2 +017300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2054.2 +017400 05 FILLER PICTURE X(26) VALUE IX2054.2 +017500 ",LFIL=000000,ORG= ,LBLR= ". IX2054.2 +017600 05 FILLER PICTURE X(37) VALUE IX2054.2 +017700 ",RECKEY= ". IX2054.2 +017800 05 FILLER PICTURE X(38) VALUE IX2054.2 +017900 ",ALTKEY1= ". IX2054.2 +018000 05 FILLER PICTURE X(38) VALUE IX2054.2 +018100 ",ALTKEY2= ". IX2054.2 +018200 05 FILLER PICTURE X(7) VALUE SPACE.IX2054.2 +018300 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2054.2 +018400 05 FILE-RECORD-INFO-P1-120. IX2054.2 +018500 07 FILLER PIC X(5). IX2054.2 +018600 07 XFILE-NAME PIC X(6). IX2054.2 +018700 07 FILLER PIC X(8). IX2054.2 +018800 07 XRECORD-NAME PIC X(6). IX2054.2 +018900 07 FILLER PIC X(1). IX2054.2 +019000 07 REELUNIT-NUMBER PIC 9(1). IX2054.2 +019100 07 FILLER PIC X(7). IX2054.2 +019200 07 XRECORD-NUMBER PIC 9(6). IX2054.2 +019300 07 FILLER PIC X(6). IX2054.2 +019400 07 UPDATE-NUMBER PIC 9(2). IX2054.2 +019500 07 FILLER PIC X(5). IX2054.2 +019600 07 ODO-NUMBER PIC 9(4). IX2054.2 +019700 07 FILLER PIC X(5). IX2054.2 +019800 07 XPROGRAM-NAME PIC X(5). IX2054.2 +019900 07 FILLER PIC X(7). IX2054.2 +020000 07 XRECORD-LENGTH PIC 9(6). IX2054.2 +020100 07 FILLER PIC X(7). IX2054.2 +020200 07 CHARS-OR-RECORDS PIC X(2). IX2054.2 +020300 07 FILLER PIC X(1). IX2054.2 +020400 07 XBLOCK-SIZE PIC 9(4). IX2054.2 +020500 07 FILLER PIC X(6). IX2054.2 +020600 07 RECORDS-IN-FILE PIC 9(6). IX2054.2 +020700 07 FILLER PIC X(5). IX2054.2 +020800 07 XFILE-ORGANIZATION PIC X(2). IX2054.2 +020900 07 FILLER PIC X(6). IX2054.2 +021000 07 XLABEL-TYPE PIC X(1). IX2054.2 +021100 05 FILE-RECORD-INFO-P121-240. IX2054.2 +021200 07 FILLER PIC X(8). IX2054.2 +021300 07 XRECORD-KEY PIC X(29). IX2054.2 +021400 07 FILLER PIC X(9). IX2054.2 +021500 07 ALTERNATE-KEY1 PIC X(29). IX2054.2 +021600 07 FILLER PIC X(9). IX2054.2 +021700 07 ALTERNATE-KEY2 PIC X(29). IX2054.2 +021800 07 FILLER PIC X(7). IX2054.2 +021900 01 TEST-RESULTS. IX2054.2 +022000 02 FILLER PIC X VALUE SPACE. IX2054.2 +022100 02 FEATURE PIC X(20) VALUE SPACE. IX2054.2 +022200 02 FILLER PIC X VALUE SPACE. IX2054.2 +022300 02 P-OR-F PIC X(5) VALUE SPACE. IX2054.2 +022400 02 FILLER PIC X VALUE SPACE. IX2054.2 +022500 02 PAR-NAME. IX2054.2 +022600 03 FILLER PIC X(19) VALUE SPACE. IX2054.2 +022700 03 PARDOT-X PIC X VALUE SPACE. IX2054.2 +022800 03 DOTVALUE PIC 99 VALUE ZERO. IX2054.2 +022900 02 FILLER PIC X(8) VALUE SPACE. IX2054.2 +023000 02 RE-MARK PIC X(61). IX2054.2 +023100 01 TEST-COMPUTED. IX2054.2 +023200 02 FILLER PIC X(30) VALUE SPACE. IX2054.2 +023300 02 FILLER PIC X(17) VALUE IX2054.2 +023400 " COMPUTED=". IX2054.2 +023500 02 COMPUTED-X. IX2054.2 +023600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2054.2 +023700 03 COMPUTED-N REDEFINES COMPUTED-A IX2054.2 +023800 PIC -9(9).9(9). IX2054.2 +023900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2054.2 +024000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2054.2 +024100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2054.2 +024200 03 CM-18V0 REDEFINES COMPUTED-A. IX2054.2 +024300 04 COMPUTED-18V0 PIC -9(18). IX2054.2 +024400 04 FILLER PIC X. IX2054.2 +024500 03 FILLER PIC X(50) VALUE SPACE. IX2054.2 +024600 01 TEST-CORRECT. IX2054.2 +024700 02 FILLER PIC X(30) VALUE SPACE. IX2054.2 +024800 02 FILLER PIC X(17) VALUE " CORRECT =". IX2054.2 +024900 02 CORRECT-X. IX2054.2 +025000 03 CORRECT-A PIC X(20) VALUE SPACE. IX2054.2 +025100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2054.2 +025200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2054.2 +025300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2054.2 +025400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2054.2 +025500 03 CR-18V0 REDEFINES CORRECT-A. IX2054.2 +025600 04 CORRECT-18V0 PIC -9(18). IX2054.2 +025700 04 FILLER PIC X. IX2054.2 +025800 03 FILLER PIC X(2) VALUE SPACE. IX2054.2 +025900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2054.2 +026000 01 CCVS-C-1. IX2054.2 +026100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2054.2 +026200- "SS PARAGRAPH-NAME IX2054.2 +026300- " REMARKS". IX2054.2 +026400 02 FILLER PIC X(20) VALUE SPACE. IX2054.2 +026500 01 CCVS-C-2. IX2054.2 +026600 02 FILLER PIC X VALUE SPACE. IX2054.2 +026700 02 FILLER PIC X(6) VALUE "TESTED". IX2054.2 +026800 02 FILLER PIC X(15) VALUE SPACE. IX2054.2 +026900 02 FILLER PIC X(4) VALUE "FAIL". IX2054.2 +027000 02 FILLER PIC X(94) VALUE SPACE. IX2054.2 +027100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2054.2 +027200 01 REC-CT PIC 99 VALUE ZERO. IX2054.2 +027300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2054.2 +027400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2054.2 +027500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2054.2 +027600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2054.2 +027700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2054.2 +027800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2054.2 +027900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2054.2 +028000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2054.2 +028100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2054.2 +028200 01 CCVS-H-1. IX2054.2 +028300 02 FILLER PIC X(39) VALUE SPACES. IX2054.2 +028400 02 FILLER PIC X(42) VALUE IX2054.2 +028500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2054.2 +028600 02 FILLER PIC X(39) VALUE SPACES. IX2054.2 +028700 01 CCVS-H-2A. IX2054.2 +028800 02 FILLER PIC X(40) VALUE SPACE. IX2054.2 +028900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2054.2 +029000 02 FILLER PIC XXXX VALUE IX2054.2 +029100 "4.2 ". IX2054.2 +029200 02 FILLER PIC X(28) VALUE IX2054.2 +029300 " COPY - NOT FOR DISTRIBUTION". IX2054.2 +029400 02 FILLER PIC X(41) VALUE SPACE. IX2054.2 +029500 IX2054.2 +029600 01 CCVS-H-2B. IX2054.2 +029700 02 FILLER PIC X(15) VALUE IX2054.2 +029800 "TEST RESULT OF ". IX2054.2 +029900 02 TEST-ID PIC X(9). IX2054.2 +030000 02 FILLER PIC X(4) VALUE IX2054.2 +030100 " IN ". IX2054.2 +030200 02 FILLER PIC X(12) VALUE IX2054.2 +030300 " HIGH ". IX2054.2 +030400 02 FILLER PIC X(22) VALUE IX2054.2 +030500 " LEVEL VALIDATION FOR ". IX2054.2 +030600 02 FILLER PIC X(58) VALUE IX2054.2 +030700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2054.2 +030800 01 CCVS-H-3. IX2054.2 +030900 02 FILLER PIC X(34) VALUE IX2054.2 +031000 " FOR OFFICIAL USE ONLY ". IX2054.2 +031100 02 FILLER PIC X(58) VALUE IX2054.2 +031200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2054.2 +031300 02 FILLER PIC X(28) VALUE IX2054.2 +031400 " COPYRIGHT 1985 ". IX2054.2 +031500 01 CCVS-E-1. IX2054.2 +031600 02 FILLER PIC X(52) VALUE SPACE. IX2054.2 +031700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2054.2 +031800 02 ID-AGAIN PIC X(9). IX2054.2 +031900 02 FILLER PIC X(45) VALUE SPACES. IX2054.2 +032000 01 CCVS-E-2. IX2054.2 +032100 02 FILLER PIC X(31) VALUE SPACE. IX2054.2 +032200 02 FILLER PIC X(21) VALUE SPACE. IX2054.2 +032300 02 CCVS-E-2-2. IX2054.2 +032400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2054.2 +032500 03 FILLER PIC X VALUE SPACE. IX2054.2 +032600 03 ENDER-DESC PIC X(44) VALUE IX2054.2 +032700 "ERRORS ENCOUNTERED". IX2054.2 +032800 01 CCVS-E-3. IX2054.2 +032900 02 FILLER PIC X(22) VALUE IX2054.2 +033000 " FOR OFFICIAL USE ONLY". IX2054.2 +033100 02 FILLER PIC X(12) VALUE SPACE. IX2054.2 +033200 02 FILLER PIC X(58) VALUE IX2054.2 +033300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2054.2 +033400 02 FILLER PIC X(13) VALUE SPACE. IX2054.2 +033500 02 FILLER PIC X(15) VALUE IX2054.2 +033600 " COPYRIGHT 1985". IX2054.2 +033700 01 CCVS-E-4. IX2054.2 +033800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2054.2 +033900 02 FILLER PIC X(4) VALUE " OF ". IX2054.2 +034000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2054.2 +034100 02 FILLER PIC X(40) VALUE IX2054.2 +034200 " TESTS WERE EXECUTED SUCCESSFULLY". IX2054.2 +034300 01 XXINFO. IX2054.2 +034400 02 FILLER PIC X(19) VALUE IX2054.2 +034500 "*** INFORMATION ***". IX2054.2 +034600 02 INFO-TEXT. IX2054.2 +034700 04 FILLER PIC X(8) VALUE SPACE. IX2054.2 +034800 04 XXCOMPUTED PIC X(20). IX2054.2 +034900 04 FILLER PIC X(5) VALUE SPACE. IX2054.2 +035000 04 XXCORRECT PIC X(20). IX2054.2 +035100 02 INF-ANSI-REFERENCE PIC X(48). IX2054.2 +035200 01 HYPHEN-LINE. IX2054.2 +035300 02 FILLER PIC IS X VALUE IS SPACE. IX2054.2 +035400 02 FILLER PIC IS X(65) VALUE IS "************************IX2054.2 +035500- "*****************************************". IX2054.2 +035600 02 FILLER PIC IS X(54) VALUE IS "************************IX2054.2 +035700- "******************************". IX2054.2 +035800 01 CCVS-PGM-ID PIC X(9) VALUE IX2054.2 +035900 "IX205A". IX2054.2 +036000 PROCEDURE DIVISION. IX2054.2 +036100 CCVS1 SECTION. IX2054.2 +036200 OPEN-FILES. IX2054.2 +036300*P OPEN I-O RAW-DATA. IX2054.2 +036400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2054.2 +036500*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2054.2 +036600*P MOVE "ABORTED " TO C-ABORT. IX2054.2 +036700*P ADD 1 TO C-NO-OF-TESTS. IX2054.2 +036800*P ACCEPT C-DATE FROM DATE. IX2054.2 +036900*P ACCEPT C-TIME FROM TIME. IX2054.2 +037000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2054.2 +037100*PND-E-1. IX2054.2 +037200*P CLOSE RAW-DATA. IX2054.2 +037300 OPEN OUTPUT PRINT-FILE. IX2054.2 +037400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2054.2 +037500 MOVE SPACE TO TEST-RESULTS. IX2054.2 +037600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2054.2 +037700 MOVE ZERO TO REC-SKL-SUB. IX2054.2 +037800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2054.2 +037900 CCVS-INIT-FILE. IX2054.2 +038000 ADD 1 TO REC-SKL-SUB. IX2054.2 +038100 MOVE FILE-RECORD-INFO-SKELETON IX2054.2 +038200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2054.2 +038300 CCVS-INIT-EXIT. IX2054.2 +038400 GO TO CCVS1-EXIT. IX2054.2 +038500 CLOSE-FILES. IX2054.2 +038600*P OPEN I-O RAW-DATA. IX2054.2 +038700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2054.2 +038800*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2054.2 +038900*P MOVE "OK. " TO C-ABORT. IX2054.2 +039000*P MOVE PASS-COUNTER TO C-OK. IX2054.2 +039100*P MOVE ERROR-HOLD TO C-ALL. IX2054.2 +039200*P MOVE ERROR-COUNTER TO C-FAIL. IX2054.2 +039300*P MOVE DELETE-COUNTER TO C-DELETED. IX2054.2 +039400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2054.2 +039500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2054.2 +039600*PND-E-2. IX2054.2 +039700*P CLOSE RAW-DATA. IX2054.2 +039800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2054.2 +039900 TERMINATE-CCVS. IX2054.2 +040000*S EXIT PROGRAM. IX2054.2 +040100*SERMINATE-CALL. IX2054.2 +040200 STOP RUN. IX2054.2 +040300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2054.2 +040400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2054.2 +040500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2054.2 +040600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2054.2 +040700 MOVE "****TEST DELETED****" TO RE-MARK. IX2054.2 +040800 PRINT-DETAIL. IX2054.2 +040900 IF REC-CT NOT EQUAL TO ZERO IX2054.2 +041000 MOVE "." TO PARDOT-X IX2054.2 +041100 MOVE REC-CT TO DOTVALUE. IX2054.2 +041200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2054.2 +041300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2054.2 +041400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2054.2 +041500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2054.2 +041600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2054.2 +041700 MOVE SPACE TO CORRECT-X. IX2054.2 +041800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2054.2 +041900 MOVE SPACE TO RE-MARK. IX2054.2 +042000 HEAD-ROUTINE. IX2054.2 +042100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +042200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +042300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2054.2 +042400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2054.2 +042500 COLUMN-NAMES-ROUTINE. IX2054.2 +042600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +042700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +042800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +042900 END-ROUTINE. IX2054.2 +043000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2054.2 +043100 END-RTN-EXIT. IX2054.2 +043200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +043300 END-ROUTINE-1. IX2054.2 +043400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2054.2 +043500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2054.2 +043600 ADD PASS-COUNTER TO ERROR-HOLD. IX2054.2 +043700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2054.2 +043800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2054.2 +043900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2054.2 +044000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2054.2 +044100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2054.2 +044200 END-ROUTINE-12. IX2054.2 +044300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2054.2 +044400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2054.2 +044500 MOVE "NO " TO ERROR-TOTAL IX2054.2 +044600 ELSE IX2054.2 +044700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2054.2 +044800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2054.2 +044900 PERFORM WRITE-LINE. IX2054.2 +045000 END-ROUTINE-13. IX2054.2 +045100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2054.2 +045200 MOVE "NO " TO ERROR-TOTAL ELSE IX2054.2 +045300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2054.2 +045400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2054.2 +045500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +045600 IF INSPECT-COUNTER EQUAL TO ZERO IX2054.2 +045700 MOVE "NO " TO ERROR-TOTAL IX2054.2 +045800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2054.2 +045900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2054.2 +046000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +046100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2054.2 +046200 WRITE-LINE. IX2054.2 +046300 ADD 1 TO RECORD-COUNT. IX2054.2 +046400 IF RECORD-COUNT GREATER 42 IX2054.2 +046500 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2054.2 +046600 MOVE SPACE TO DUMMY-RECORD IX2054.2 +046700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2054.2 +046800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2054.2 +046900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2054.2 +047000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2054.2 +047100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2054.2 +047200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2054.2 +047300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2054.2 +047400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2054.2 +047500 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2054.2 +047600 MOVE ZERO TO RECORD-COUNT. IX2054.2 +047700 PERFORM WRT-LN. IX2054.2 +047800 WRT-LN. IX2054.2 +047900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2054.2 +048000 MOVE SPACE TO DUMMY-RECORD. IX2054.2 +048100 BLANK-LINE-PRINT. IX2054.2 +048200 PERFORM WRT-LN. IX2054.2 +048300 FAIL-ROUTINE. IX2054.2 +048400 IF COMPUTED-X NOT EQUAL TO SPACE IX2054.2 +048500 GO TO FAIL-ROUTINE-WRITE. IX2054.2 +048600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2054.2 +048700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2054.2 +048800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2054.2 +048900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +049000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2054.2 +049100 GO TO FAIL-ROUTINE-EX. IX2054.2 +049200 FAIL-ROUTINE-WRITE. IX2054.2 +049300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2054.2 +049400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2054.2 +049500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2054.2 +049600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2054.2 +049700 FAIL-ROUTINE-EX. EXIT. IX2054.2 +049800 BAIL-OUT. IX2054.2 +049900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2054.2 +050000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2054.2 +050100 BAIL-OUT-WRITE. IX2054.2 +050200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2054.2 +050300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2054.2 +050400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2054.2 +050500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2054.2 +050600 BAIL-OUT-EX. EXIT. IX2054.2 +050700 CCVS1-EXIT. IX2054.2 +050800 EXIT. IX2054.2 +050900 SECT-IX-01-001 SECTION. IX2054.2 +051000 WRITE-INIT-GF-01. IX2054.2 +051100 OPEN OUTPUT IX-FD1. IX2054.2 +051200 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +051300 MOVE ZERO TO WRK-DU-10V00-001. IX2054.2 +051400 MOVE "IX-FD1" TO XFILE-NAME (1). IX2054.2 +051500 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2054.2 +051600 MOVE 000001 TO XRECORD-NUMBER (1). IX2054.2 +051700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2054.2 +051800 MOVE 200 TO RECORDS-IN-FILE (1). IX2054.2 +051900 MOVE 240 TO XRECORD-LENGTH (1). IX2054.2 +052000 MOVE 0001 TO XBLOCK-SIZE (1). IX2054.2 +052100 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2054.2 +052200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2054.2 +052300 MOVE "S" TO XLABEL-TYPE (1). IX2054.2 +052400 MOVE 000200 TO WRK-DU-10V00-002 IX2054.2 +052500 MOVE "FILE CREATED" TO RE-MARK. IX2054.2 +052600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2054.2 +052700 MOVE "WRITE DYNAMIC MODE " TO FEATURE. IX2054.2 +052800 WRITE-TEST-GF-01-R. IX2054.2 +052900 MOVE XRECORD-NUMBER (1) TO WRK-DU-10V00-001. IX2054.2 +053000 MOVE WRK-REC-KEY-FD1 TO XRECORD-KEY (1). IX2054.2 +053100 MOVE WRK-ALT1-KEY-FD1 TO ALTERNATE-KEY1 (1). IX2054.2 +053200 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2054.2 +053300 WRITE IX-FD1R1-F-G-240 IX2054.2 +053400 INVALID KEY GO TO WRITE-TEST-GF-01. IX2054.2 +053500 IF XRECORD-NUMBER (1) NOT LESS THAN FD1-FILE-SIZE IX2054.2 +053600 GO TO WRITE-TEST-GF-01. IX2054.2 +053700 ADD 000001 TO XRECORD-NUMBER (1). IX2054.2 +053800 SUBTRACT 000001 FROM WRK-DU-10V00-002. IX2054.2 +053900 GO TO WRITE-TEST-GF-01-R. IX2054.2 +054000 WRITE-TEST-GF-01. IX2054.2 +054100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2054.2 +054200 MOVE FD1-FILE-SIZE TO CORRECT-18V0. IX2054.2 +054300 IF XRECORD-NUMBER (1) EQUAL TO FD1-FILE-SIZE IX2054.2 +054400 PERFORM PASS IX2054.2 +054500 ELSE IX2054.2 +054600 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2054.2 +054700 PERFORM FAIL. IX2054.2 +054800 PERFORM PRINT-DETAIL. IX2054.2 +054900* IX2054.2 +055000* 01 IX2054.2 +055100* IX2054.2 +055200 CLOSE IX-FD1. IX2054.2 +055300 READ-INIT-F1-01. IX2054.2 +055400 OPEN INPUT IX-FD1. IX2054.2 +055500 MOVE ZERO TO WRK-DU-10V00-001. IX2054.2 +055600 MOVE ZERO TO WRK-DU-10V00-002. IX2054.2 +055700 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +055800 MOVE "READ-TEST-F1-01 " TO PAR-NAME. IX2054.2 +055900 MOVE "READ NEXT RECORD " TO FEATURE. IX2054.2 +056000 READ-TEST-F1-01-3. IX2054.2 +056100 ADD 1 TO WRK-DU-10V00-001. IX2054.2 +056200 READ IX-FD1 IX2054.2 +056300 NEXT RECORD IX2054.2 +056400 AT END IX2054.2 +056500 ADD 1000 TO WRK-DU-10V00-002. IX2054.2 +056600* IX2054.2 +056700* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +056800* HAS BEEN TAKEN. IX2054.2 +056900* IX2054.2 +057000 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +057100 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2054.2 +057200 ADD 1 TO WRK-DU-10V00-002. IX2054.2 +057300* IX2054.2 +057400* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT THE IX2054.2 +057500* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +057600* IX2054.2 +057700 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +057800 IF WRK-CS-09V00-001 GREATER THAN 24 IX2054.2 +057900 NEXT SENTENCE ELSE IX2054.2 +058000 GO TO READ-TEST-F1-01-3. IX2054.2 +058100 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2054.2 +058200 PERFORM FAIL IX2054.2 +058300 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2054.2 +058400 MOVE ZERO TO CORRECT-18V0 IX2054.2 +058500 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +058600 ELSE PERFORM PASS. IX2054.2 +058700 PERFORM PRINT-DETAIL. IX2054.2 +058800* IX2054.2 +058900* 02 IX2054.2 +059000* IX2054.2 +059100 READ-INIT-F2-02. IX2054.2 +059200 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX2054.2 +059300 MOVE "READ . RECORD INVALID" TO FEATURE. IX2054.2 +059400 MOVE ZERO TO WRK-DU-10V00-001. IX2054.2 +059500 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +059600 MOVE ZERO TO WRK-DU-10V00-002. IX2054.2 +059700 READ-TEST-F1-02-5. IX2054.2 +059800 ADD 10 TO WRK-DU-10V00-001. IX2054.2 +059900 MOVE WRK-DU-10V00-001 TO IX-FD1-KEY IX2054.2 +060000 READ IX-FD1 RECORD IX2054.2 +060100 INVALID KEY IX2054.2 +060200 ADD 1000 TO WRK-DU-10V00-002. IX2054.2 +060300* IX2054.2 +060400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2054.2 +060500* PATH HAS BEEN TAKEN. IX2054.2 +060600* IX2054.2 +060700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +060800 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2054.2 +060900 ADD 1 TO WRK-DU-10V00-002. IX2054.2 +061000* IX2054.2 +061100* COMPUTED RESULTS IN INCREMENTS OF 1 INDICAT THAT THE IX2054.2 +061200* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +061300* IX2054.2 +061400 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +061500 IF WRK-CS-09V00-001 GREATER THAN 10 IX2054.2 +061600 NEXT SENTENCE ELSE IX2054.2 +061700 GO TO READ-TEST-F1-02-5. IX2054.2 +061800 READ-TEST-F1-02. IX2054.2 +061900 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2054.2 +062000 PERFORM FAIL IX2054.2 +062100 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2054.2 +062200 MOVE ZERO TO CORRECT-18V0 IX2054.2 +062300 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +062400 ELSE PERFORM PASS. IX2054.2 +062500 PERFORM PRINT-DETAIL. IX2054.2 +062600* IX2054.2 +062700* 03 IX2054.2 +062800* IX2054.2 +062900 READ-INIT-GF-03. IX2054.2 +063000 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX2054.2 +063100 MOVE "START = READ ALTERN." TO FEATURE. IX2054.2 +063200 MOVE 0000000200 TO WRK-DU-10V00-001. IX2054.2 +063300 MOVE WRK-REC-KEY-FD1 TO IX-FD1-REC-KEY. IX2054.2 +063400 MOVE FD1-FILE-SIZE TO WRK-DU-10V00-001. IX2054.2 +063500 MOVE 0000000001 TO WRK-DU-10V00-002. IX2054.2 +063600 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +063700 MOVE WRK-ALT1-KEY-FD1 TO IX-FD1-ALT1-KEY. IX2054.2 +063800 MOVE ZERO TO WRK-DU-10V00-002. IX2054.2 +063900 START IX-FD1 IX2054.2 +064000 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2054.2 +064100 INVALID KEY IX2054.2 +064200 ADD 1000000 TO WRK-DU-10V00-002. IX2054.2 +064300* IX2054.2 +064400* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2054.2 +064500* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2054.2 +064600* IX2054.2 +064700 READ-TEST-F1-03. IX2054.2 +064800 READ IX-FD1 IX2054.2 +064900 NEXT RECORD IX2054.2 +065000 AT END IX2054.2 +065100 ADD 1000 TO WRK-DU-10V00-002. IX2054.2 +065200* IX2054.2 +065300* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +065400* HAS BEEN TAKEN ON THE READ STATEMENT. IX2054.2 +065500* IX2054.2 +065600 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +065700 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2054.2 +065800 ADD 1 TO WRK-DU-10V00-002. IX2054.2 +065900* IX2054.2 +066000* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2054.2 +066100* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +066200* IX2054.2 +066300 SUBTRACT 1 FROM WRK-DU-10V00-001. IX2054.2 +066400 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +066500 IF WRK-CS-09V00-001 GREATER THAN 25 IX2054.2 +066600 NEXT SENTENCE ELSE IX2054.2 +066700 GO TO READ-TEST-F1-03. IX2054.2 +066800 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2054.2 +066900 PERFORM FAIL IX2054.2 +067000 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2054.2 +067100 MOVE ZERO TO CORRECT-18V0 IX2054.2 +067200 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +067300 ELSE PERFORM PASS. IX2054.2 +067400 PERFORM PRINT-DETAIL. IX2054.2 +067500* IX2054.2 +067600* 04 IX2054.2 +067700* IX2054.2 +067800 READ-INIT-GF-04. IX2054.2 +067900 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX2054.2 +068000 MOVE "START >= READ ALTERN." TO FEATURE. IX2054.2 +068100 MOVE 0000000200 TO WRK-DU-10V00-001. IX2054.2 +068200 MOVE WRK-REC-KEY-FD1 TO IX-FD1-REC-KEY. IX2054.2 +068300 MOVE FD1-FILE-SIZE TO WRK-DU-10V00-001. IX2054.2 +068400 MOVE 0000000001 TO WRK-DU-10V00-002. IX2054.2 +068500 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +068600 MOVE WRK-ALT1-KEY-FD1 TO IX-FD1-ALT1-KEY. IX2054.2 +068700 MOVE ZERO TO WRK-DU-10V00-002. IX2054.2 +068800 START IX-FD1 IX2054.2 +068900 KEY IS GREATER THAN OR EQUAL TO IX-FD1-ALTKEY1 IX2054.2 +069000 INVALID KEY IX2054.2 +069100 ADD 1000000 TO WRK-DU-10V00-002. IX2054.2 +069200* IX2054.2 +069300* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2054.2 +069400* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2054.2 +069500* IX2054.2 +069600 READ-TEST-F1-04. IX2054.2 +069700 READ IX-FD1 IX2054.2 +069800 NEXT RECORD IX2054.2 +069900 AT END IX2054.2 +070000 ADD 1000 TO WRK-DU-10V00-002. IX2054.2 +070100* IX2054.2 +070200* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +070300* HAS BEEN TAKEN ON THE READ STATEMENT. IX2054.2 +070400* IX2054.2 +070500 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +070600 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2054.2 +070700 ADD 1 TO WRK-DU-10V00-002. IX2054.2 +070800* IX2054.2 +070900* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2054.2 +071000* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +071100* IX2054.2 +071200 SUBTRACT 1 FROM WRK-DU-10V00-001. IX2054.2 +071300 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +071400 IF WRK-CS-09V00-001 GREATER THAN 25 IX2054.2 +071500 NEXT SENTENCE ELSE IX2054.2 +071600 GO TO READ-TEST-F1-04. IX2054.2 +071700 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2054.2 +071800 PERFORM FAIL IX2054.2 +071900 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2054.2 +072000 MOVE ZERO TO CORRECT-18V0 IX2054.2 +072100 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +072200 ELSE PERFORM PASS. IX2054.2 +072300 PERFORM PRINT-DETAIL. IX2054.2 +072400 CLOSE IX-FD1. IX2054.2 +072500 READ-EXIT-F1. IX2054.2 +072600 EXIT. IX2054.2 +072700 SECT-IX-01-002 SECTION. IX2054.2 +072800 WRITE-INIT-GF-02. IX2054.2 +072900 OPEN OUTPUT IX-FD2. IX2054.2 +073000 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +073100 MOVE ZERO TO WRK-DU-10V00-003. IX2054.2 +073200 MOVE "IX-FD2" TO XFILE-NAME (2). IX2054.2 +073300 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2054.2 +073400 MOVE 000001 TO XRECORD-NUMBER (2). IX2054.2 +073500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2054.2 +073600 MOVE 000240 TO XRECORD-LENGTH (2). IX2054.2 +073700 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2054.2 +073800 MOVE 0025 TO XBLOCK-SIZE (2). IX2054.2 +073900 MOVE 0000200 TO RECORDS-IN-FILE (2). IX2054.2 +074000 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2054.2 +074100 MOVE "S" TO XLABEL-TYPE (2). IX2054.2 +074200 MOVE 000200 TO WRK-DU-10V00-004. IX2054.2 +074300 MOVE "FILE CREATED" TO RE-MARK. IX2054.2 +074400 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2054.2 +074500 MOVE "DYNAMIC MODE" TO FEATURE. IX2054.2 +074600 WRITE-TEST-GF-02-R. IX2054.2 +074700 MOVE XRECORD-NUMBER (2) TO WRK-DU-10V00-003. IX2054.2 +074800 MOVE WRK-REC-KEY-FD2 TO XRECORD-KEY (2). IX2054.2 +074900 MOVE WRK-ALT1-KEY-FD2 TO ALTERNATE-KEY1 (2). IX2054.2 +075000 MOVE FILE-RECORD-INFO (2) TO IX-FD2R1-F-G-240. IX2054.2 +075100 WRITE IX-FD2R1-F-G-240 IX2054.2 +075200 INVALID KEY GO TO WRITE-TEST-GF-02. IX2054.2 +075300 IF XRECORD-NUMBER (2) NOT LESS THAN FD2-FILE-SIZE IX2054.2 +075400 GO TO WRITE-TEST-GF-02. IX2054.2 +075500 ADD 000001 TO XRECORD-NUMBER (2). IX2054.2 +075600 SUBTRACT 000001 FROM WRK-DU-10V00-004. IX2054.2 +075700 GO TO WRITE-TEST-GF-02-R. IX2054.2 +075800 WRITE-TEST-GF-02. IX2054.2 +075900 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0. IX2054.2 +076000 MOVE FD2-FILE-SIZE TO CORRECT-18V0. IX2054.2 +076100 IF XRECORD-NUMBER (2) EQUAL TO FD2-FILE-SIZE IX2054.2 +076200 PERFORM PASS IX2054.2 +076300 ELSE IX2054.2 +076400 MOVE "FILE CREATION PREMATURE; IX-41" TO RE-MARK IX2054.2 +076500 PERFORM FAIL. IX2054.2 +076600 PERFORM PRINT-DETAIL. IX2054.2 +076700* IX2054.2 +076800* 02 IX2054.2 +076900* IX2054.2 +077000 CLOSE IX-FD2. IX2054.2 +077100 READ-INIT-F1-05. IX2054.2 +077200 OPEN INPUT IX-FD2. IX2054.2 +077300 MOVE ZERO TO WRK-DU-10V00-003. IX2054.2 +077400 MOVE ZERO TO WRK-DU-10V00-004. IX2054.2 +077500 MOVE " READ SEQUENTIAL" TO FEATURE. IX2054.2 +077600 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +077700 READ-TEST-F1-05-3. IX2054.2 +077800 ADD 1 TO WRK-DU-10V00-003. IX2054.2 +077900 READ IX-FD2 IX2054.2 +078000 NEXT RECORD IX2054.2 +078100 AT END IX2054.2 +078200 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +078300* IX2054.2 +078400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +078500* HAS BEEN TAKEN. IX2054.2 +078600* IX2054.2 +078700 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2054.2 +078800 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2054.2 +078900 ADD 1 TO WRK-DU-10V00-004. IX2054.2 +079000* IX2054.2 +079100* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT THE IX2054.2 +079200* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +079300* IX2054.2 +079400 ADD 000000001 TO WRK-CS-09V00-001. IX2054.2 +079500 IF WRK-CS-09V00-001 GREATER THAN 24 IX2054.2 +079600 NEXT SENTENCE ELSE IX2054.2 +079700 GO TO READ-TEST-F1-05-3. IX2054.2 +079800 READ-TEST-F1-05. IX2054.2 +079900 MOVE "READ-TEST-F1-05" TO PAR-NAME. IX2054.2 +080000 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2054.2 +080100 MOVE "RETRIEVED A NOT EXPECTED RECORD " TO RE-MARK IX2054.2 +080200 PERFORM FAIL IX2054.2 +080300 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2054.2 +080400 MOVE ZERO TO CORRECT-18V0 IX2054.2 +080500 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +080600 ELSE PERFORM PASS. IX2054.2 +080700 PERFORM PRINT-DETAIL. IX2054.2 +080800* IX2054.2 +080900* 06 IX2054.2 +081000* IX2054.2 +081100 READ-TEST-F1-06-4. IX2054.2 +081200 MOVE ZERO TO WRK-DU-10V00-003. IX2054.2 +081300 MOVE ZERO TO WRK-DU-10V00-004. IX2054.2 +081400 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +081500 MOVE " READ RANDOM" TO FEATURE. IX2054.2 +081600 READ-TEST-F1-06-5. IX2054.2 +081700 ADD 10 TO WRK-DU-10V00-003. IX2054.2 +081800 MOVE WRK-DU-10V00-003 TO IX-FD2-KEY IX2054.2 +081900 READ IX-FD2 RECORD IX2054.2 +082000 INVALID KEY IX2054.2 +082100 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +082200* IX2054.2 +082300* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2054.2 +082400* PATH HAS BEEN TAKEN. IX2054.2 +082500* IX2054.2 +082600 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2054.2 +082700 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2054.2 +082800 ADD 1 TO WRK-DU-10V00-004. IX2054.2 +082900* IX2054.2 +083000* COMPUTED RESULTS IN INCREMENTS OF 1 INDICAT THAT THE IX2054.2 +083100* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +083200* IX2054.2 +083300 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +083400 IF WRK-CS-09V00-001 GREATER THAN 10 IX2054.2 +083500 NEXT SENTENCE ELSE IX2054.2 +083600 GO TO READ-TEST-F1-06-5. IX2054.2 +083700 READ-TEST-F1-06. IX2054.2 +083800 MOVE "READ-TEST-F1-06" TO PAR-NAME. IX2054.2 +083900 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2054.2 +084000 MOVE "RETRIEVED A NOT EXPECTED RECORD " TO RE-MARK IX2054.2 +084100 PERFORM FAIL IX2054.2 +084200 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2054.2 +084300 MOVE ZERO TO CORRECT-18V0 IX2054.2 +084400 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +084500 ELSE PERFORM PASS. IX2054.2 +084600 PERFORM PRINT-DETAIL. IX2054.2 +084700* IX2054.2 +084800* 07 IX2054.2 +084900* IX2054.2 +085000 READ-TEST-F1-07-6. IX2054.2 +085100 MOVE 00000200 TO WRK-DU-10V00-003. IX2054.2 +085200 MOVE WRK-REC-KEY-FD2 TO IX-FD2-REC-KEY. IX2054.2 +085300 MOVE FD2-FILE-SIZE TO WRK-DU-10V00-003. IX2054.2 +085400 MOVE 000000001 TO WRK-DU-10V00-004. IX2054.2 +085500 MOVE ZERO TO WRK-CS-09V00-001. IX2054.2 +085600 MOVE WRK-ALT1-KEY-FD2 TO IX-FD2-ALT1-KEY. IX2054.2 +085700 MOVE " READ ALTERNATE KEY" TO FEATURE. IX2054.2 +085800 MOVE ZERO TO WRK-DU-10V00-004. IX2054.2 +085900 START IX-FD2 IX2054.2 +086000 KEY IS EQUAL TO IX-FD2-ALTKEY1 IX2054.2 +086100 INVALID KEY ADD 1000000 TO WRK-DU-10V00-004. IX2054.2 +086200* IX2054.2 +086300* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2054.2 +086400* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2054.2 +086500* IX2054.2 +086600 READ-TEST-F1-07-7. IX2054.2 +086700 READ IX-FD2 IX2054.2 +086800 NEXT RECORD IX2054.2 +086900 AT END IX2054.2 +087000 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +087100* IX2054.2 +087200* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2054.2 +087300* HAS BEEN TAKEN. IX2054.2 +087400* IX2054.2 +087500 MOVE IX-FD2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2054.2 +087600 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2054.2 +087700 ADD 1 TO WRK-DU-10V00-004. IX2054.2 +087800* IX2054.2 +087900* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2054.2 +088000* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2054.2 +088100* IX2054.2 +088200 SUBTRACT 1 FROM WRK-DU-10V00-003. IX2054.2 +088300 ADD 1 TO WRK-CS-09V00-001. IX2054.2 +088400 IF WRK-CS-09V00-001 GREATER THAN 25 IX2054.2 +088500 NEXT SENTENCE ELSE IX2054.2 +088600 GO TO READ-TEST-F1-07-7. IX2054.2 +088700 READ-TEST-F1-07. IX2054.2 +088800 MOVE "READ-TEST-F1-07" TO PAR-NAME. IX2054.2 +088900 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2054.2 +089000 PERFORM FAIL IX2054.2 +089100 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2054.2 +089200 MOVE ZERO TO CORRECT-18V0 IX2054.2 +089300 MOVE "SEE PROGRAM" TO RE-MARK IX2054.2 +089400 ELSE PERFORM PASS. IX2054.2 +089500 PERFORM PRINT-DETAIL. IX2054.2 +089600 CLOSE IX-FD2. IX2054.2 +089700 INX-EXIT-002. IX2054.2 +089800 EXIT. IX2054.2 +089900 READ-INIT-F1-08. IX2054.2 +090000 OPEN INPUT IX-FD1. IX2054.2 +090100 OPEN INPUT IX-FD2. IX2054.2 +090200 MOVE SPACE TO FILE-RECORD-INFO (9). IX2054.2 +090300 MOVE SPACE TO FILE-RECORD-INFO (1). IX2054.2 +090400 MOVE ZERO TO WRK-DU-10V00-004. IX2054.2 +090500 MOVE SPACES TO IX-FD1R1-F-G-240. IX2054.2 +090600 MOVE SPACES TO IX-FD2R1-F-G-240. IX2054.2 +090700 MOVE "SAME AREA" TO FEATURE. IX2054.2 +090800 READ-TEST-F1-08-1. IX2054.2 +090900 READ IX-FD1 IX2054.2 +091000 NEXT RECORD IX2054.2 +091100 AT END IX2054.2 +091200 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +091300 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2054.2 +091400 READ-TEST-F1-08. IX2054.2 +091500 MOVE "READ-TEST-F1-08" TO PAR-NAME. IX2054.2 +091600 IF XFILE-NAME (1) EQUAL TO "IX-FD1" IX2054.2 +091700 PERFORM PASS IX2054.2 +091800 ELSE IX2054.2 +091900 MOVE "RETRIEVED A RECORD NOT EXPECTED " TO RE-MARK IX2054.2 +092000 PERFORM FAIL IX2054.2 +092100 MOVE XFILE-NAME (1) TO COMPUTED-A IX2054.2 +092200 MOVE "IX-FD1" TO CORRECT-A. IX2054.2 +092300 PERFORM PRINT-DETAIL. IX2054.2 +092400* IX2054.2 +092500* 09 IX2054.2 +092600* IX2054.2 +092700 READ IX-FD2 IX2054.2 +092800 NEXT RECORD IX2054.2 +092900 AT END IX2054.2 +093000 ADD 1000 TO WRK-DU-10V00-004. IX2054.2 +093100* IX2054.2 +093200* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2054.2 +093300* PATH HAS BEEN TAKEN. IX2054.2 +093400* IX2054.2 +093500 READ-TEST-F1-09. IX2054.2 +093600 MOVE "READ-TEST-F1-09" TO PAR-NAME. IX2054.2 +093700 IF WRK-DU-10V00-004 EQUAL TO ZERO IX2054.2 +093800 PERFORM PASS IX2054.2 +093900 ELSE IX2054.2 +094000 MOVE "RETRIEVED A RECORD NOT EXPECTED " TO RE-MARK IX2054.2 +094100 PERFORM FAIL IX2054.2 +094200 MOVE WRK-DU-10V00-004 TO COMPUTED-A IX2054.2 +094300 MOVE ZERO TO CORRECT-A IX2054.2 +094400 MOVE "SEE PROGRAM" TO RE-MARK. IX2054.2 +094500 PERFORM PRINT-DETAIL. IX2054.2 +094600* IX2054.2 +094700* 10 IX2054.2 +094800* IX2054.2 +094900 READ-TEST-F1-10. IX2054.2 +095000 MOVE "READ-TEST-F1-10" TO PAR-NAME. IX2054.2 +095100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (9). IX2054.2 +095200* IX2054.2 +095300* NOTE IN TESTING THE SAME AREA CLAUSE THE RECORD AREA IX2054.2 +095400* SHOULD BE SHARED BY BOTH FILES IX-FD1 AND IX-FD2, IX2054.2 +095500* THEREFORE FILE IX-FD2 IS READ AND THE RECORD IX2054.2 +095600* IDENTIFIED FOR IX-FD1 IS ACCESSED AND TESTED FOR IX2054.2 +095700* EXPECTED PRESENCE OF IX-FD2 FILE RECORD CONTENTS. IX2054.2 +095800* IX2054.2 +095900 IF XFILE-NAME (9) EQUAL TO "IX-FD2" IX2054.2 +096000 PERFORM PASS IX2054.2 +096100 ELSE IX2054.2 +096200 PERFORM FAIL IX2054.2 +096300 MOVE XFILE-NAME (9) TO COMPUTED-A IX2054.2 +096400 MOVE "IX-FD2" TO CORRECT-A IX2054.2 +096500 MOVE "SEE PROGRAM" TO RE-MARK. IX2054.2 +096600 PERFORM PRINT-DETAIL. IX2054.2 +096700 CLOSE IX-FD2. IX2054.2 +096800 CLOSE IX-FD1. IX2054.2 +096900 INX-EXIT-003. IX2054.2 +097000 EXIT. IX2054.2 +097100 CCVS-EXIT SECTION. IX2054.2 +097200 CCVS-999999. IX2054.2 +097300 GO TO CLOSE-FILES. IX2054.2 diff --git a/tests/cobol85/IX/IX206A.CBL b/tests/cobol85/IX/IX206A.CBL new file mode 100755 index 00000000..119f4b00 --- /dev/null +++ b/tests/cobol85/IX/IX206A.CBL @@ -0,0 +1,892 @@ +000100 IDENTIFICATION DIVISION. IX2064.2 +000200 PROGRAM-ID. IX2064.2 +000300 IX206A. IX2064.2 +000400**************************************************************** IX2064.2 +000500* * IX2064.2 +000600* VALIDATION FOR:- * IX2064.2 +000700* * IX2064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2064.2 +000900* * IX2064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2064.2 +001100* * IX2064.2 +001200*IX206A IX2064.2 +001300******************************************************************IX2064.2 +001400* THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLE IX2064.2 +001500* SYNTACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH IX2064.2 +001600* LEVEL 2 OF INDEXED I-O. IX2064.2 +001700* THE ELEMENTS TESTED IN THIS PROGRAM ARE: IX2064.2 +001800* IX2064.2 +001900* (1) ACCESS MODE DYNAMIC IX2064.2 +002000* (2) ALTERNATE RECORD KEY WITHOUT THE DUPLICATES OPTION IX2064.2 +002100* (3) RESERVE CLAUSE IX2064.2 +002200* (4) SAME CLAUSE IX2064.2 +002300* (5) BLOCK CONTAINS INTEGER-1 TO INTEGER-2 CLAUSE IX2064.2 +002400* (6) VALUE OF IMPLEMENTOR-NAME SERIES. IX2064.2 +002500* IX2064.2 +002600* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS IX2064.2 +002700* ROUTINE. ONE FILE IS CREATED AND ACCESSED IN THE DYNAMIC IX2064.2 +002800* ACCESS MODE AND THE 2ND FILE IS CREATED 2ND ACCESSED IN THE IX2064.2 +002900* SEQUENTIAL ACCESS MODE. IX2064.2 +003000* IX2064.2 +003100* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2064.2 +003200* IX2064.2 +003300* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2064.2 +003400* CLAUSE FOR DATA FILE IX-FS1 IX2064.2 +003500* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2064.2 +003600* CLAUSE FOR DATA FILE IX-FD2 IX2064.2 +003700* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2064.2 +003800* CLAUSE FOR INDEX FILE IX-FS1 IX2064.2 +003900* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2064.2 +004000* CLAUSE FOR INDEX FILE IX-FD2 IX2064.2 +004100* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2064.2 +004200* X-62 FOR RAW-DATA IX2064.2 +004300* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2064.2 +004400* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2064.2 +004500* X-84 LABEL RECORDS FOR PRINT-FILE IX2064.2 +004600* IX2064.2 +004700* NOTE: X-CARDS 44, 45, 62 AND 84 ARE OPTIONAL IX2064.2 +004800* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2064.2 +004900* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2064.2 +005000* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2064.2 +005100* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2064.2 +005200* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2064.2 +005300* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2064.2 +005400* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2064.2 +005500* THEY ARE AS FOLLOWS IX2064.2 +005600* IX2064.2 +005700* P SELECTS X-CARDS 62 IX2064.2 +005800* J SELECTS X-CARDS 44 & 45 IX2064.2 +005900* C SELECTS X-CARDS 84 IX2064.2 +006000* IX2064.2 +006100****************************************************** IX2064.2 +006200 ENVIRONMENT DIVISION. IX2064.2 +006300 CONFIGURATION SECTION. IX2064.2 +006400 SOURCE-COMPUTER. IX2064.2 +006500 Linux. IX2064.2 +006600 OBJECT-COMPUTER. IX2064.2 +006700 Linux. IX2064.2 +006800 INPUT-OUTPUT SECTION. IX2064.2 +006900 FILE-CONTROL. IX2064.2 +007000*P SELECT RAW-DATA ASSIGN TO IX2064.2 +007100*P "XXXXX062" IX2064.2 +007200*P ORGANIZATION IS INDEXED IX2064.2 +007300*P ACCESS MODE IS RANDOM IX2064.2 +007400*P RECORD KEY IS RAW-DATA-KEY. IX2064.2 +007500 SELECT PRINT-FILE ASSIGN TO IX2064.2 +007600 "report.log". IX2064.2 +007700 SELECT IX-FD1 ASSIGN TO IX2064.2 +007800 "XXXXX024" IX2064.2 +007900*J **** X-CARD UNDEFINED **** IX2064.2 +008000 RESERVE 3 IX2064.2 +008100 ORGANIZATION IS INDEXED IX2064.2 +008200 ACCESS DYNAMIC IX2064.2 +008300 RECORD KEY IS IX-FD1-KEY IX2064.2 +008400 ALTERNATE RECORD IS IX-FD1-ALTKEY1. IX2064.2 +008500 SELECT IX-FS1 ASSIGN TO IX2064.2 +008600 "XXXXX025" IX2064.2 +008700*J **** X-CARD UNDEFINED **** IX2064.2 +008800 ; RESERVE 4 AREAS IX2064.2 +008900 ; ACCESS MODE IS SEQUENTIAL IX2064.2 +009000 ORGANIZATION INDEXED IX2064.2 +009100 RECORD KEY IX-FS1-KEY IX2064.2 +009200 ; ALTERNATE RECORD KEY IX-FS1-ALTKEY1. IX2064.2 +009300 I-O-CONTROL. IX2064.2 +009400 SAME RECORD FOR IX-FD1, IX-FS1. IX2064.2 +009500 DATA DIVISION. IX2064.2 +009600 FILE SECTION. IX2064.2 +009700*P IX2064.2 +009800*PD RAW-DATA. IX2064.2 +009900*P IX2064.2 +010000*P1 RAW-DATA-SATZ. IX2064.2 +010100*P 05 RAW-DATA-KEY PIC X(6). IX2064.2 +010200*P 05 C-DATE PIC 9(6). IX2064.2 +010300*P 05 C-TIME PIC 9(8). IX2064.2 +010400*P 05 C-NO-OF-TESTS PIC 99. IX2064.2 +010500*P 05 C-OK PIC 999. IX2064.2 +010600*P 05 C-ALL PIC 999. IX2064.2 +010700*P 05 C-FAIL PIC 999. IX2064.2 +010800*P 05 C-DELETED PIC 999. IX2064.2 +010900*P 05 C-INSPECT PIC 999. IX2064.2 +011000*P 05 C-NOTE PIC X(13). IX2064.2 +011100*P 05 C-INDENT PIC X. IX2064.2 +011200*P 05 C-ABORT PIC X(8). IX2064.2 +011300 FD PRINT-FILE. IX2064.2 +011400 01 PRINT-REC PICTURE X(120). IX2064.2 +011500 01 DUMMY-RECORD PICTURE X(120). IX2064.2 +011600 FD IX-FD1 IX2064.2 +011700*C LABEL RECORDS ARE STANDARD IX2064.2 +011800 BLOCK 10 TO 20 RECORDS IX2064.2 +011900 RECORD CONTAINS 240 CHARACTERS. IX2064.2 +012000 01 IX-FD1R1-F-G-240. IX2064.2 +012100 05 IX-FD1-REC-120 PIC X(120). IX2064.2 +012200 05 IX-FD1-REC-120-240. IX2064.2 +012300 10 FILLER PIC X(8). IX2064.2 +012400 10 IX-FD1-REC-KEY. IX2064.2 +012500 15 FILLER PIC X(19). IX2064.2 +012600 15 IX-FD1-KEY PIC X(10). IX2064.2 +012700 10 FILLER PIC X(9). IX2064.2 +012800 10 IX-FD1-ALT1-KEY. IX2064.2 +012900 15 FILLER PIC X(19). IX2064.2 +013000 15 IX-FD1-ALTKEY1 PIC X(10). IX2064.2 +013100 10 FILLER PIC X(45). IX2064.2 +013200 FD IX-FS1 IX2064.2 +013300*C LABEL RECORDS ARE STANDARD IX2064.2 +013400 RECORD CONTAINS 240 CHARACTERS. IX2064.2 +013500 01 IX-FS1R1-F-G-240. IX2064.2 +013600 05 IX-FS1-REC-120 PIC X(120). IX2064.2 +013700 05 IX-FS1-REC-120-240. IX2064.2 +013800 10 FILLER PIC X(8). IX2064.2 +013900 10 IX-FS1-REC-KEY. IX2064.2 +014000 15 FILLER PIC X(19). IX2064.2 +014100 15 IX-FS1-KEY PIC X(10). IX2064.2 +014200 10 FILLER PIC X(9). IX2064.2 +014300 10 IX-FS1-ALT1-KEY. IX2064.2 +014400 15 FILLER PIC X(19). IX2064.2 +014500 15 IX-FS1-ALTKEY1 PIC X(10). IX2064.2 +014600 10 FILLER PIC X(45). IX2064.2 +014700 WORKING-STORAGE SECTION. IX2064.2 +014800 01 WRK-CS-09V00-001 PIC S9(9) COMPUTATIONAL. IX2064.2 +014900 01 WRK-REC-KEY-FD1. IX2064.2 +015000 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +015100 03 WRK-DU-10V00-001 PIC 9(10) VALUE ZERO. IX2064.2 +015200 01 WRK-ALT1-KEY-FD1. IX2064.2 +015300 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +015400 03 WRK-DU-10V00-002 PIC 9(10) VALUE ZERO. IX2064.2 +015500 01 FD1-FILE-SIZE PIC 9(10) VALUE 200. IX2064.2 +015600 01 WRK-REC-KEY-FS1. IX2064.2 +015700 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +015800 03 WRK-DU-10V00-003 PIC 9(10) VALUE ZERO. IX2064.2 +015900 01 WRK-ALT1-KEY-FS1. IX2064.2 +016000 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +016100 03 WRK-DU-10V00-004 PIC 9(10) VALUE ZERO. IX2064.2 +016200 01 FS1-FILE-SIZE PIC 9(10) VALUE 200. IX2064.2 +016300*C1 IX-FD1-ID1 IX2064.2 +016400*C **** X-CARD UNDEFINED ****. IX2064.2 +016500*C1 IX-FD1-ID2 IX2064.2 +016600*C **** X-CARD UNDEFINED ****. IX2064.2 +016700*C1 IX-FS1-ID2 IX2064.2 +016800*C **** X-CARD UNDEFINED ****. IX2064.2 +016900 01 FILE-RECORD-INFORMATION-REC. IX2064.2 +017000 03 FILE-RECORD-INFO-SKELETON. IX2064.2 +017100 05 FILLER PICTURE X(48) VALUE IX2064.2 +017200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2064.2 +017300 05 FILLER PICTURE X(46) VALUE IX2064.2 +017400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2064.2 +017500 05 FILLER PICTURE X(26) VALUE IX2064.2 +017600 ",LFIL=000000,ORG= ,LBLR= ". IX2064.2 +017700 05 FILLER PICTURE X(37) VALUE IX2064.2 +017800 ",RECKEY= ". IX2064.2 +017900 05 FILLER PICTURE X(38) VALUE IX2064.2 +018000 ",ALTKEY1= ". IX2064.2 +018100 05 FILLER PICTURE X(38) VALUE IX2064.2 +018200 ",ALTKEY2= ". IX2064.2 +018300 05 FILLER PICTURE X(7) VALUE SPACE.IX2064.2 +018400 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2064.2 +018500 05 FILE-RECORD-INFO-P1-120. IX2064.2 +018600 07 FILLER PIC X(5). IX2064.2 +018700 07 XFILE-NAME PIC X(6). IX2064.2 +018800 07 FILLER PIC X(8). IX2064.2 +018900 07 XRECORD-NAME PIC X(6). IX2064.2 +019000 07 FILLER PIC X(1). IX2064.2 +019100 07 REELUNIT-NUMBER PIC 9(1). IX2064.2 +019200 07 FILLER PIC X(7). IX2064.2 +019300 07 XRECORD-NUMBER PIC 9(6). IX2064.2 +019400 07 FILLER PIC X(6). IX2064.2 +019500 07 UPDATE-NUMBER PIC 9(2). IX2064.2 +019600 07 FILLER PIC X(5). IX2064.2 +019700 07 ODO-NUMBER PIC 9(4). IX2064.2 +019800 07 FILLER PIC X(5). IX2064.2 +019900 07 XPROGRAM-NAME PIC X(5). IX2064.2 +020000 07 FILLER PIC X(7). IX2064.2 +020100 07 XRECORD-LENGTH PIC 9(6). IX2064.2 +020200 07 FILLER PIC X(7). IX2064.2 +020300 07 CHARS-OR-RECORDS PIC X(2). IX2064.2 +020400 07 FILLER PIC X(1). IX2064.2 +020500 07 XBLOCK-SIZE PIC 9(4). IX2064.2 +020600 07 FILLER PIC X(6). IX2064.2 +020700 07 RECORDS-IN-FILE PIC 9(6). IX2064.2 +020800 07 FILLER PIC X(5). IX2064.2 +020900 07 XFILE-ORGANIZATION PIC X(2). IX2064.2 +021000 07 FILLER PIC X(6). IX2064.2 +021100 07 XLABEL-TYPE PIC X(1). IX2064.2 +021200 05 FILE-RECORD-INFO-P121-240. IX2064.2 +021300 07 FILLER PIC X(8). IX2064.2 +021400 07 XRECORD-KEY PIC X(29). IX2064.2 +021500 07 FILLER PIC X(9). IX2064.2 +021600 07 ALTERNATE-KEY1 PIC X(29). IX2064.2 +021700 07 FILLER PIC X(9). IX2064.2 +021800 07 ALTERNATE-KEY2 PIC X(29). IX2064.2 +021900 07 FILLER PIC X(7). IX2064.2 +022000 01 TEST-RESULTS. IX2064.2 +022100 02 FILLER PIC X VALUE SPACE. IX2064.2 +022200 02 FEATURE PIC X(20) VALUE SPACE. IX2064.2 +022300 02 FILLER PIC X VALUE SPACE. IX2064.2 +022400 02 P-OR-F PIC X(5) VALUE SPACE. IX2064.2 +022500 02 FILLER PIC X VALUE SPACE. IX2064.2 +022600 02 PAR-NAME. IX2064.2 +022700 03 FILLER PIC X(19) VALUE SPACE. IX2064.2 +022800 03 PARDOT-X PIC X VALUE SPACE. IX2064.2 +022900 03 DOTVALUE PIC 99 VALUE ZERO. IX2064.2 +023000 02 FILLER PIC X(8) VALUE SPACE. IX2064.2 +023100 02 RE-MARK PIC X(61). IX2064.2 +023200 01 TEST-COMPUTED. IX2064.2 +023300 02 FILLER PIC X(30) VALUE SPACE. IX2064.2 +023400 02 FILLER PIC X(17) VALUE IX2064.2 +023500 " COMPUTED=". IX2064.2 +023600 02 COMPUTED-X. IX2064.2 +023700 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2064.2 +023800 03 COMPUTED-N REDEFINES COMPUTED-A IX2064.2 +023900 PIC -9(9).9(9). IX2064.2 +024000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2064.2 +024100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2064.2 +024200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2064.2 +024300 03 CM-18V0 REDEFINES COMPUTED-A. IX2064.2 +024400 04 COMPUTED-18V0 PIC -9(18). IX2064.2 +024500 04 FILLER PIC X. IX2064.2 +024600 03 FILLER PIC X(50) VALUE SPACE. IX2064.2 +024700 01 TEST-CORRECT. IX2064.2 +024800 02 FILLER PIC X(30) VALUE SPACE. IX2064.2 +024900 02 FILLER PIC X(17) VALUE " CORRECT =". IX2064.2 +025000 02 CORRECT-X. IX2064.2 +025100 03 CORRECT-A PIC X(20) VALUE SPACE. IX2064.2 +025200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2064.2 +025300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2064.2 +025400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2064.2 +025500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2064.2 +025600 03 CR-18V0 REDEFINES CORRECT-A. IX2064.2 +025700 04 CORRECT-18V0 PIC -9(18). IX2064.2 +025800 04 FILLER PIC X. IX2064.2 +025900 03 FILLER PIC X(2) VALUE SPACE. IX2064.2 +026000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2064.2 +026100 01 CCVS-C-1. IX2064.2 +026200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2064.2 +026300- "SS PARAGRAPH-NAME IX2064.2 +026400- " REMARKS". IX2064.2 +026500 02 FILLER PIC X(20) VALUE SPACE. IX2064.2 +026600 01 CCVS-C-2. IX2064.2 +026700 02 FILLER PIC X VALUE SPACE. IX2064.2 +026800 02 FILLER PIC X(6) VALUE "TESTED". IX2064.2 +026900 02 FILLER PIC X(15) VALUE SPACE. IX2064.2 +027000 02 FILLER PIC X(4) VALUE "FAIL". IX2064.2 +027100 02 FILLER PIC X(94) VALUE SPACE. IX2064.2 +027200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2064.2 +027300 01 REC-CT PIC 99 VALUE ZERO. IX2064.2 +027400 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2064.2 +027500 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2064.2 +027600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2064.2 +027700 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2064.2 +027800 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2064.2 +027900 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2064.2 +028000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2064.2 +028100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2064.2 +028200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2064.2 +028300 01 CCVS-H-1. IX2064.2 +028400 02 FILLER PIC X(39) VALUE SPACES. IX2064.2 +028500 02 FILLER PIC X(42) VALUE IX2064.2 +028600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2064.2 +028700 02 FILLER PIC X(39) VALUE SPACES. IX2064.2 +028800 01 CCVS-H-2A. IX2064.2 +028900 02 FILLER PIC X(40) VALUE SPACE. IX2064.2 +029000 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2064.2 +029100 02 FILLER PIC XXXX VALUE IX2064.2 +029200 "4.2 ". IX2064.2 +029300 02 FILLER PIC X(28) VALUE IX2064.2 +029400 " COPY - NOT FOR DISTRIBUTION". IX2064.2 +029500 02 FILLER PIC X(41) VALUE SPACE. IX2064.2 +029600 IX2064.2 +029700 01 CCVS-H-2B. IX2064.2 +029800 02 FILLER PIC X(15) VALUE IX2064.2 +029900 "TEST RESULT OF ". IX2064.2 +030000 02 TEST-ID PIC X(9). IX2064.2 +030100 02 FILLER PIC X(4) VALUE IX2064.2 +030200 " IN ". IX2064.2 +030300 02 FILLER PIC X(12) VALUE IX2064.2 +030400 " HIGH ". IX2064.2 +030500 02 FILLER PIC X(22) VALUE IX2064.2 +030600 " LEVEL VALIDATION FOR ". IX2064.2 +030700 02 FILLER PIC X(58) VALUE IX2064.2 +030800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2064.2 +030900 01 CCVS-H-3. IX2064.2 +031000 02 FILLER PIC X(34) VALUE IX2064.2 +031100 " FOR OFFICIAL USE ONLY ". IX2064.2 +031200 02 FILLER PIC X(58) VALUE IX2064.2 +031300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2064.2 +031400 02 FILLER PIC X(28) VALUE IX2064.2 +031500 " COPYRIGHT 1985 ". IX2064.2 +031600 01 CCVS-E-1. IX2064.2 +031700 02 FILLER PIC X(52) VALUE SPACE. IX2064.2 +031800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2064.2 +031900 02 ID-AGAIN PIC X(9). IX2064.2 +032000 02 FILLER PIC X(45) VALUE SPACES. IX2064.2 +032100 01 CCVS-E-2. IX2064.2 +032200 02 FILLER PIC X(31) VALUE SPACE. IX2064.2 +032300 02 FILLER PIC X(21) VALUE SPACE. IX2064.2 +032400 02 CCVS-E-2-2. IX2064.2 +032500 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2064.2 +032600 03 FILLER PIC X VALUE SPACE. IX2064.2 +032700 03 ENDER-DESC PIC X(44) VALUE IX2064.2 +032800 "ERRORS ENCOUNTERED". IX2064.2 +032900 01 CCVS-E-3. IX2064.2 +033000 02 FILLER PIC X(22) VALUE IX2064.2 +033100 " FOR OFFICIAL USE ONLY". IX2064.2 +033200 02 FILLER PIC X(12) VALUE SPACE. IX2064.2 +033300 02 FILLER PIC X(58) VALUE IX2064.2 +033400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2064.2 +033500 02 FILLER PIC X(13) VALUE SPACE. IX2064.2 +033600 02 FILLER PIC X(15) VALUE IX2064.2 +033700 " COPYRIGHT 1985". IX2064.2 +033800 01 CCVS-E-4. IX2064.2 +033900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2064.2 +034000 02 FILLER PIC X(4) VALUE " OF ". IX2064.2 +034100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2064.2 +034200 02 FILLER PIC X(40) VALUE IX2064.2 +034300 " TESTS WERE EXECUTED SUCCESSFULLY". IX2064.2 +034400 01 XXINFO. IX2064.2 +034500 02 FILLER PIC X(19) VALUE IX2064.2 +034600 "*** INFORMATION ***". IX2064.2 +034700 02 INFO-TEXT. IX2064.2 +034800 04 FILLER PIC X(8) VALUE SPACE. IX2064.2 +034900 04 XXCOMPUTED PIC X(20). IX2064.2 +035000 04 FILLER PIC X(5) VALUE SPACE. IX2064.2 +035100 04 XXCORRECT PIC X(20). IX2064.2 +035200 02 INF-ANSI-REFERENCE PIC X(48). IX2064.2 +035300 01 HYPHEN-LINE. IX2064.2 +035400 02 FILLER PIC IS X VALUE IS SPACE. IX2064.2 +035500 02 FILLER PIC IS X(65) VALUE IS "************************IX2064.2 +035600- "*****************************************". IX2064.2 +035700 02 FILLER PIC IS X(54) VALUE IS "************************IX2064.2 +035800- "******************************". IX2064.2 +035900 01 CCVS-PGM-ID PIC X(9) VALUE IX2064.2 +036000 "IX206A". IX2064.2 +036100 PROCEDURE DIVISION. IX2064.2 +036200 CCVS1 SECTION. IX2064.2 +036300 OPEN-FILES. IX2064.2 +036400*P OPEN I-O RAW-DATA. IX2064.2 +036500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2064.2 +036600*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2064.2 +036700*P MOVE "ABORTED " TO C-ABORT. IX2064.2 +036800*P ADD 1 TO C-NO-OF-TESTS. IX2064.2 +036900*P ACCEPT C-DATE FROM DATE. IX2064.2 +037000*P ACCEPT C-TIME FROM TIME. IX2064.2 +037100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2064.2 +037200*PND-E-1. IX2064.2 +037300*P CLOSE RAW-DATA. IX2064.2 +037400 OPEN OUTPUT PRINT-FILE. IX2064.2 +037500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2064.2 +037600 MOVE SPACE TO TEST-RESULTS. IX2064.2 +037700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2064.2 +037800 MOVE ZERO TO REC-SKL-SUB. IX2064.2 +037900 PERFORM CCVS-INIT-FILE 9 TIMES. IX2064.2 +038000 CCVS-INIT-FILE. IX2064.2 +038100 ADD 1 TO REC-SKL-SUB. IX2064.2 +038200 MOVE FILE-RECORD-INFO-SKELETON IX2064.2 +038300 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2064.2 +038400 CCVS-INIT-EXIT. IX2064.2 +038500 GO TO CCVS1-EXIT. IX2064.2 +038600 CLOSE-FILES. IX2064.2 +038700*P OPEN I-O RAW-DATA. IX2064.2 +038800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2064.2 +038900*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2064.2 +039000*P MOVE "OK. " TO C-ABORT. IX2064.2 +039100*P MOVE PASS-COUNTER TO C-OK. IX2064.2 +039200*P MOVE ERROR-HOLD TO C-ALL. IX2064.2 +039300*P MOVE ERROR-COUNTER TO C-FAIL. IX2064.2 +039400*P MOVE DELETE-COUNTER TO C-DELETED. IX2064.2 +039500*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2064.2 +039600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2064.2 +039700*PND-E-2. IX2064.2 +039800*P CLOSE RAW-DATA. IX2064.2 +039900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2064.2 +040000 TERMINATE-CCVS. IX2064.2 +040100*S EXIT PROGRAM. IX2064.2 +040200*SERMINATE-CALL. IX2064.2 +040300 STOP RUN. IX2064.2 +040400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2064.2 +040500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2064.2 +040600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2064.2 +040700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2064.2 +040800 MOVE "****TEST DELETED****" TO RE-MARK. IX2064.2 +040900 PRINT-DETAIL. IX2064.2 +041000 IF REC-CT NOT EQUAL TO ZERO IX2064.2 +041100 MOVE "." TO PARDOT-X IX2064.2 +041200 MOVE REC-CT TO DOTVALUE. IX2064.2 +041300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2064.2 +041400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2064.2 +041500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2064.2 +041600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2064.2 +041700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2064.2 +041800 MOVE SPACE TO CORRECT-X. IX2064.2 +041900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2064.2 +042000 MOVE SPACE TO RE-MARK. IX2064.2 +042100 HEAD-ROUTINE. IX2064.2 +042200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +042300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +042400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2064.2 +042500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2064.2 +042600 COLUMN-NAMES-ROUTINE. IX2064.2 +042700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +042800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +042900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +043000 END-ROUTINE. IX2064.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2064.2 +043200 END-RTN-EXIT. IX2064.2 +043300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +043400 END-ROUTINE-1. IX2064.2 +043500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2064.2 +043600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2064.2 +043700 ADD PASS-COUNTER TO ERROR-HOLD. IX2064.2 +043800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2064.2 +043900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2064.2 +044000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2064.2 +044100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2064.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2064.2 +044300 END-ROUTINE-12. IX2064.2 +044400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2064.2 +044500 IF ERROR-COUNTER IS EQUAL TO ZERO IX2064.2 +044600 MOVE "NO " TO ERROR-TOTAL IX2064.2 +044700 ELSE IX2064.2 +044800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2064.2 +044900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2064.2 +045000 PERFORM WRITE-LINE. IX2064.2 +045100 END-ROUTINE-13. IX2064.2 +045200 IF DELETE-COUNTER IS EQUAL TO ZERO IX2064.2 +045300 MOVE "NO " TO ERROR-TOTAL ELSE IX2064.2 +045400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2064.2 +045500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2064.2 +045600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +045700 IF INSPECT-COUNTER EQUAL TO ZERO IX2064.2 +045800 MOVE "NO " TO ERROR-TOTAL IX2064.2 +045900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2064.2 +046000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2064.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +046200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2064.2 +046300 WRITE-LINE. IX2064.2 +046400 ADD 1 TO RECORD-COUNT. IX2064.2 +046500 IF RECORD-COUNT GREATER 42 IX2064.2 +046600 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2064.2 +046700 MOVE SPACE TO DUMMY-RECORD IX2064.2 +046800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2064.2 +046900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2064.2 +047000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2064.2 +047100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2064.2 +047200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2064.2 +047300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2064.2 +047400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2064.2 +047500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2064.2 +047600 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2064.2 +047700 MOVE ZERO TO RECORD-COUNT. IX2064.2 +047800 PERFORM WRT-LN. IX2064.2 +047900 WRT-LN. IX2064.2 +048000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2064.2 +048100 MOVE SPACE TO DUMMY-RECORD. IX2064.2 +048200 BLANK-LINE-PRINT. IX2064.2 +048300 PERFORM WRT-LN. IX2064.2 +048400 FAIL-ROUTINE. IX2064.2 +048500 IF COMPUTED-X NOT EQUAL TO SPACE IX2064.2 +048600 GO TO FAIL-ROUTINE-WRITE. IX2064.2 +048700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2064.2 +048800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2064.2 +048900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2064.2 +049000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +049100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2064.2 +049200 GO TO FAIL-ROUTINE-EX. IX2064.2 +049300 FAIL-ROUTINE-WRITE. IX2064.2 +049400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2064.2 +049500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2064.2 +049600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2064.2 +049700 MOVE SPACES TO COR-ANSI-REFERENCE. IX2064.2 +049800 FAIL-ROUTINE-EX. EXIT. IX2064.2 +049900 BAIL-OUT. IX2064.2 +050000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2064.2 +050100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2064.2 +050200 BAIL-OUT-WRITE. IX2064.2 +050300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2064.2 +050400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2064.2 +050500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2064.2 +050600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2064.2 +050700 BAIL-OUT-EX. EXIT. IX2064.2 +050800 CCVS1-EXIT. IX2064.2 +050900 EXIT. IX2064.2 +051000 SECT-IX-01-001 SECTION. IX2064.2 +051100 WRITE-INIT-GF-01. IX2064.2 +051200 OPEN OUTPUT IX-FD1. IX2064.2 +051300 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +051400 MOVE ZERO TO WRK-DU-10V00-001. IX2064.2 +051500 MOVE "IX-FD1" TO XFILE-NAME (1). IX2064.2 +051600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2064.2 +051700 MOVE 000001 TO XRECORD-NUMBER (1). IX2064.2 +051800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2064.2 +051900 MOVE 200 TO RECORDS-IN-FILE (1). IX2064.2 +052000 MOVE 240 TO XRECORD-LENGTH (1). IX2064.2 +052100 MOVE 0020 TO XBLOCK-SIZE (1). IX2064.2 +052200 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2064.2 +052300 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2064.2 +052400 MOVE "S" TO XLABEL-TYPE (1). IX2064.2 +052500 MOVE 000200 TO WRK-DU-10V00-002 IX2064.2 +052600 MOVE "FILE CREATED" TO RE-MARK. IX2064.2 +052700 WRITE-TEST-GF-01-R. IX2064.2 +052800 MOVE XRECORD-NUMBER (1) TO WRK-DU-10V00-001. IX2064.2 +052900 MOVE WRK-REC-KEY-FD1 TO XRECORD-KEY (1). IX2064.2 +053000 MOVE WRK-ALT1-KEY-FD1 TO ALTERNATE-KEY1 (1). IX2064.2 +053100 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2064.2 +053200 WRITE IX-FD1R1-F-G-240 IX2064.2 +053300 INVALID KEY GO TO WRITE-TEST-GF-01. IX2064.2 +053400 IF XRECORD-NUMBER (1) NOT LESS THAN FD1-FILE-SIZE IX2064.2 +053500 GO TO WRITE-TEST-GF-01. IX2064.2 +053600 ADD 000001 TO XRECORD-NUMBER (1). IX2064.2 +053700 SUBTRACT 000001 FROM WRK-DU-10V00-002. IX2064.2 +053800 GO TO WRITE-TEST-GF-01-R. IX2064.2 +053900 WRITE-TEST-GF-01. IX2064.2 +054000 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2064.2 +054100 MOVE "WRITE IX-FD1" TO FEATURE. IX2064.2 +054200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2064.2 +054300 MOVE FD1-FILE-SIZE TO CORRECT-18V0. IX2064.2 +054400 IF XRECORD-NUMBER (1) EQUAL TO FD1-FILE-SIZE IX2064.2 +054500 PERFORM PASS IX2064.2 +054600 ELSE IX2064.2 +054700 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +054800 PERFORM FAIL. IX2064.2 +054900 PERFORM PRINT-DETAIL. IX2064.2 +055000* IX2064.2 +055100* IX2064.2 +055200 CLOSE IX-FD1. IX2064.2 +055300 READ-INIT-F1-01. IX2064.2 +055400 OPEN INPUT IX-FD1. IX2064.2 +055500 MOVE ZERO TO WRK-DU-10V00-001. IX2064.2 +055600 MOVE ZERO TO WRK-DU-10V00-002. IX2064.2 +055700 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +055800 READ-TEST-F1-01-3. IX2064.2 +055900 ADD 1 TO WRK-DU-10V00-001. IX2064.2 +056000 READ IX-FD1 IX2064.2 +056100 NEXT RECORD IX2064.2 +056200 AT END IX2064.2 +056300 ADD 1000 TO WRK-DU-10V00-002. IX2064.2 +056400* IX2064.2 +056500* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2064.2 +056600* HAS BEEN TAKEN. IX2064.2 +056700* IX2064.2 +056800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2064.2 +056900 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2064.2 +057000 ADD 1 TO WRK-DU-10V00-002. IX2064.2 +057100* IX2064.2 +057200* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT THE IX2064.2 +057300* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +057400* IX2064.2 +057500 ADD 1 TO WRK-CS-09V00-001. IX2064.2 +057600 IF WRK-CS-09V00-001 GREATER THAN 24 IX2064.2 +057700 GO TO READ-TEST-F1-01. IX2064.2 +057800 GO TO READ-TEST-F1-01-3. IX2064.2 +057900 READ-TEST-F1-01. IX2064.2 +058000 MOVE "READ-TEST-F1-01 " TO PAR-NAME. IX2064.2 +058100 MOVE "READ SEQUENTIAL" TO FEATURE. IX2064.2 +058200 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2064.2 +058300 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +058400 PERFORM FAIL IX2064.2 +058500 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2064.2 +058600 MOVE ZERO TO CORRECT-18V0 IX2064.2 +058700 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +058800 ELSE IX2064.2 +058900 PERFORM PASS. IX2064.2 +059000 PERFORM PRINT-DETAIL. IX2064.2 +059100* IX2064.2 +059200* IX2064.2 +059300 READ-INIT-F2-02. IX2064.2 +059400 MOVE ZERO TO WRK-DU-10V00-001. IX2064.2 +059500 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +059600 MOVE ZERO TO WRK-DU-10V00-002. IX2064.2 +059700 READ-TEST-F2-02-5. IX2064.2 +059800 ADD 10 TO WRK-DU-10V00-001. IX2064.2 +059900 MOVE WRK-DU-10V00-001 TO IX-FD1-KEY IX2064.2 +060000 READ IX-FD1 RECORD IX2064.2 +060100 INVALID KEY IX2064.2 +060200 ADD 1000 TO WRK-DU-10V00-002. IX2064.2 +060300* IX2064.2 +060400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2064.2 +060500* PATH HAS BEEN TAKEN. IX2064.2 +060600* IX2064.2 +060700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2064.2 +060800 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2064.2 +060900 ADD 1 TO WRK-DU-10V00-002. IX2064.2 +061000* IX2064.2 +061100* COMPUTED RESULTS IN INCREMENTS OF 1 INDICAT THAT THE IX2064.2 +061200* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +061300* IX2064.2 +061400 ADD 1 TO WRK-CS-09V00-001. IX2064.2 +061500 IF WRK-CS-09V00-001 GREATER THAN 10 IX2064.2 +061600 NEXT SENTENCE ELSE IX2064.2 +061700 GO TO READ-TEST-F2-02-5. IX2064.2 +061800 READ-TEST-F2-02. IX2064.2 +061900 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX2064.2 +062000 MOVE "READ RANDOM " TO FEATURE. IX2064.2 +062100 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2064.2 +062200 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +062300 PERFORM FAIL IX2064.2 +062400 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2064.2 +062500 MOVE ZERO TO CORRECT-18V0 IX2064.2 +062600 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +062700 ELSE IX2064.2 +062800 PERFORM PASS. IX2064.2 +062900 PERFORM PRINT-DETAIL. IX2064.2 +063000* IX2064.2 +063100* IX2064.2 +063200 READ-INIT-F2-03. IX2064.2 +063300 MOVE 0000000200 TO WRK-DU-10V00-001. IX2064.2 +063400 MOVE WRK-REC-KEY-FD1 TO IX-FD1-REC-KEY. IX2064.2 +063500 MOVE FD1-FILE-SIZE TO WRK-DU-10V00-001. IX2064.2 +063600 MOVE 0000000001 TO WRK-DU-10V00-002. IX2064.2 +063700 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +063800 MOVE WRK-ALT1-KEY-FD1 TO IX-FD1-ALT1-KEY. IX2064.2 +063900 MOVE ZERO TO WRK-DU-10V00-002. IX2064.2 +064000 START IX-FD1 IX2064.2 +064100 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2064.2 +064200 INVALID KEY IX2064.2 +064300 ADD 1000000 TO WRK-DU-10V00-002. IX2064.2 +064400* IX2064.2 +064500* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2064.2 +064600* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2064.2 +064700* IX2064.2 +064800 READ-TEST-F2-03-7. IX2064.2 +064900 READ IX-FD1 IX2064.2 +065000 NEXT RECORD IX2064.2 +065100 AT END IX2064.2 +065200 ADD 1000 TO WRK-DU-10V00-002. IX2064.2 +065300* IX2064.2 +065400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2064.2 +065500* HAS BEEN TAKEN ON THE READ STATEMENT. IX2064.2 +065600* IX2064.2 +065700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2064.2 +065800 IF XRECORD-NUMBER (1) NOT EQUAL TO WRK-DU-10V00-001 IX2064.2 +065900 ADD 1 TO WRK-DU-10V00-002. IX2064.2 +066000* IX2064.2 +066100* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2064.2 +066200* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +066300* IX2064.2 +066400 SUBTRACT 1 FROM WRK-DU-10V00-001. IX2064.2 +066500 ADD 1 TO WRK-CS-09V00-001. IX2064.2 +066600 IF WRK-CS-09V00-001 GREATER THAN 25 IX2064.2 +066700 NEXT SENTENCE ELSE IX2064.2 +066800 GO TO READ-TEST-F2-03-7. IX2064.2 +066900 READ-TEST-F2-03. IX2064.2 +067000 MOVE "READ-TEST-F2-03" TO PAR-NAME. IX2064.2 +067100 MOVE "READ ALTERNATE KEY " TO FEATURE. IX2064.2 +067200 IF WRK-DU-10V00-002 GREATER THAN ZERO IX2064.2 +067300 PERFORM FAIL IX2064.2 +067400 MOVE WRK-DU-10V00-002 TO COMPUTED-18V0 IX2064.2 +067500 MOVE ZERO TO CORRECT-18V0 IX2064.2 +067600 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +067700 ELSE IX2064.2 +067800 PERFORM PASS. IX2064.2 +067900 PERFORM PRINT-DETAIL. IX2064.2 +068000 CLOSE IX-FD1. IX2064.2 +068100 INX-EXIT-001. IX2064.2 +068200 EXIT. IX2064.2 +068300 SECT-IX-01-002 SECTION. IX2064.2 +068400 WRITE-INIT-GF-02. IX2064.2 +068500 OPEN OUTPUT IX-FS1. IX2064.2 +068600 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +068700 MOVE ZERO TO WRK-DU-10V00-003. IX2064.2 +068800 MOVE "IX-FS1" TO XFILE-NAME (2). IX2064.2 +068900 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2064.2 +069000 MOVE 000001 TO XRECORD-NUMBER (2). IX2064.2 +069100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2064.2 +069200 MOVE 000240 TO XRECORD-LENGTH (2). IX2064.2 +069300 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2064.2 +069400 MOVE 0001 TO XBLOCK-SIZE (2). IX2064.2 +069500 MOVE 0000200 TO RECORDS-IN-FILE (2). IX2064.2 +069600 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2064.2 +069700 MOVE "S" TO XLABEL-TYPE (2). IX2064.2 +069800 MOVE 000200 TO WRK-DU-10V00-004. IX2064.2 +069900 MOVE "FILE CREATED" TO RE-MARK. IX2064.2 +070000 MOVE "SEQUENTIAL MODE" TO FEATURE. IX2064.2 +070100 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2064.2 +070200 WRITE-TEST-GF-02-R. IX2064.2 +070300 MOVE XRECORD-NUMBER (2) TO WRK-DU-10V00-003. IX2064.2 +070400 MOVE WRK-REC-KEY-FS1 TO XRECORD-KEY (2). IX2064.2 +070500 MOVE WRK-ALT1-KEY-FS1 TO ALTERNATE-KEY1 (2). IX2064.2 +070600 MOVE FILE-RECORD-INFO (2) TO IX-FS1R1-F-G-240. IX2064.2 +070700 WRITE IX-FS1R1-F-G-240 IX2064.2 +070800 INVALID KEY GO TO WRITE-TEST-GF-02. IX2064.2 +070900 IF XRECORD-NUMBER (2) NOT LESS THAN FS1-FILE-SIZE IX2064.2 +071000 GO TO WRITE-TEST-GF-02. IX2064.2 +071100 ADD 000001 TO XRECORD-NUMBER (2). IX2064.2 +071200 SUBTRACT 000001 FROM WRK-DU-10V00-004. IX2064.2 +071300 GO TO WRITE-TEST-GF-02-R. IX2064.2 +071400 WRITE-TEST-GF-02. IX2064.2 +071500 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0. IX2064.2 +071600 MOVE FS1-FILE-SIZE TO CORRECT-18V0. IX2064.2 +071700 IF XRECORD-NUMBER (2) EQUAL TO FS1-FILE-SIZE IX2064.2 +071800 PERFORM PASS IX2064.2 +071900 ELSE IX2064.2 +072000 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +072100 PERFORM FAIL. IX2064.2 +072200 PERFORM PRINT-DETAIL. IX2064.2 +072300* IX2064.2 +072400* IX2064.2 +072500 CLOSE IX-FS1. IX2064.2 +072600 READ-INIT-F1-04. IX2064.2 +072700 OPEN INPUT IX-FS1. IX2064.2 +072800 MOVE ZERO TO WRK-DU-10V00-003. IX2064.2 +072900 MOVE ZERO TO WRK-DU-10V00-004. IX2064.2 +073000 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +073100 READ-TEST-F1-04-3. IX2064.2 +073200 ADD 1 TO WRK-DU-10V00-003. IX2064.2 +073300 READ IX-FS1 IX2064.2 +073400 AT END IX2064.2 +073500 ADD 1000 TO WRK-DU-10V00-004. IX2064.2 +073600* IX2064.2 +073700* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2064.2 +073800* HAS BEEN TAKEN. IX2064.2 +073900* IX2064.2 +074000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (2). IX2064.2 +074100 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2064.2 +074200 ADD 1 TO WRK-DU-10V00-004. IX2064.2 +074300* IX2064.2 +074400* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT THE IX2064.2 +074500* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +074600* IX2064.2 +074700 ADD 000000001 TO WRK-CS-09V00-001. IX2064.2 +074800 IF WRK-CS-09V00-001 GREATER THAN 24 IX2064.2 +074900 NEXT SENTENCE ELSE IX2064.2 +075000 GO TO READ-TEST-F1-04-3. IX2064.2 +075100 READ-TEST-F1-04. IX2064.2 +075200 MOVE "READE-TEST-F1-04" TO PAR-NAME. IX2064.2 +075300 MOVE "READ SEQUENTIAL " TO FEATURE. IX2064.2 +075400 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2064.2 +075500 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +075600 PERFORM FAIL IX2064.2 +075700 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2064.2 +075800 MOVE ZERO TO CORRECT-18V0 IX2064.2 +075900 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +076000 ELSE IX2064.2 +076100 PERFORM PASS. IX2064.2 +076200 PERFORM PRINT-DETAIL. IX2064.2 +076300* IX2064.2 +076400* IX2064.2 +076500 READ-TEST-F2-05-4. IX2064.2 +076600 MOVE ZERO TO WRK-DU-10V00-003. IX2064.2 +076700 MOVE ZERO TO WRK-DU-10V00-004. IX2064.2 +076800 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +076900 READ-TEST-F2-05-5. IX2064.2 +077000 MOVE 00000200 TO WRK-DU-10V00-003. IX2064.2 +077100 MOVE WRK-REC-KEY-FS1 TO IX-FS1-REC-KEY. IX2064.2 +077200 MOVE FS1-FILE-SIZE TO WRK-DU-10V00-003. IX2064.2 +077300 MOVE 000000001 TO WRK-DU-10V00-004. IX2064.2 +077400 MOVE ZERO TO WRK-CS-09V00-001. IX2064.2 +077500 MOVE WRK-ALT1-KEY-FS1 TO IX-FS1-ALT1-KEY. IX2064.2 +077600 MOVE ZERO TO WRK-DU-10V00-004. IX2064.2 +077700 START IX-FS1 IX2064.2 +077800 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2064.2 +077900 INVALID KEY ADD 1000000 TO WRK-DU-10V00-004. IX2064.2 +078000* IX2064.2 +078100* COMPUTED RESULTS VALUE IN INCREMENTS OF 1000000 INDICATE IX2064.2 +078200* INVALID KEY PATH HAS BEEN TAKEN ON START STATEMENT. IX2064.2 +078300* IX2064.2 +078400 READ-TEST-F2-05-6. IX2064.2 +078500 READ IX-FS1 IX2064.2 +078600 AT END IX2064.2 +078700 ADD 1000 TO WRK-DU-10V00-004. IX2064.2 +078800* IX2064.2 +078900* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE AT END PATH IX2064.2 +079000* HAS BEEN TAKEN. IX2064.2 +079100* IX2064.2 +079200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (2). IX2064.2 +079300 IF XRECORD-NUMBER (2) NOT EQUAL TO WRK-DU-10V00-003 IX2064.2 +079400 ADD 1 TO WRK-DU-10V00-004. IX2064.2 +079500* IX2064.2 +079600* COMPUTED RESULTS IN INCREMENTS OF 1 INDICATE THAT IX2064.2 +079700* RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2064.2 +079800* IX2064.2 +079900 SUBTRACT 1 FROM WRK-DU-10V00-003. IX2064.2 +080000 ADD 1 TO WRK-CS-09V00-001. IX2064.2 +080100 IF WRK-CS-09V00-001 GREATER THAN 25 IX2064.2 +080200 NEXT SENTENCE ELSE IX2064.2 +080300 GO TO READ-TEST-F2-05-6. IX2064.2 +080400 READ-TEST-F2-05. IX2064.2 +080500 MOVE "READ-TEST-F2-05" TO PAR-NAME. IX2064.2 +080600 MOVE "READ ALTERNATE KEY " TO FEATURE. IX2064.2 +080700 IF WRK-DU-10V00-004 GREATER THAN ZERO IX2064.2 +080800 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +080900 PERFORM FAIL IX2064.2 +081000 MOVE WRK-DU-10V00-004 TO COMPUTED-18V0 IX2064.2 +081100 MOVE ZERO TO CORRECT-18V0 IX2064.2 +081200 MOVE "SEE PROGRAM" TO RE-MARK IX2064.2 +081300 ELSE IX2064.2 +081400 PERFORM PASS. IX2064.2 +081500 PERFORM PRINT-DETAIL. IX2064.2 +081600 CLOSE IX-FS1. IX2064.2 +081700 INX-EXIT-002. IX2064.2 +081800 EXIT. IX2064.2 +081900 READ-INIT-F1-06. IX2064.2 +082000 OPEN INPUT IX-FD1. IX2064.2 +082100 OPEN INPUT IX-FS1. IX2064.2 +082200 MOVE SPACE TO FILE-RECORD-INFO (9). IX2064.2 +082300 MOVE SPACE TO FILE-RECORD-INFO (1). IX2064.2 +082400 MOVE ZERO TO WRK-DU-10V00-004. IX2064.2 +082500 MOVE SPACES TO IX-FD1R1-F-G-240. IX2064.2 +082600 MOVE SPACES TO IX-FS1R1-F-G-240. IX2064.2 +082700 MOVE "READ-TEST-F1-06" TO PAR-NAME. IX2064.2 +082800 MOVE "SAME AREA" TO FEATURE. IX2064.2 +082900 READ-TEST-F1-06. IX2064.2 +083000 READ IX-FD1 IX2064.2 +083100 NEXT RECORD IX2064.2 +083200 AT END IX2064.2 +083300 ADD 1000 TO WRK-DU-10V00-004. IX2064.2 +083400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2064.2 +083500 IF XFILE-NAME (1) EQUAL TO "IX-FD1" IX2064.2 +083600 PERFORM PASS IX2064.2 +083700 ELSE IX2064.2 +083800 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +083900 PERFORM FAIL IX2064.2 +084000 MOVE XFILE-NAME (1) TO COMPUTED-A IX2064.2 +084100 MOVE "IX-FD1" TO CORRECT-A. IX2064.2 +084200 PERFORM PRINT-DETAIL. IX2064.2 +084300* IX2064.2 +084400* IX2064.2 +084500 READ-TEST-F1-07. IX2064.2 +084600 MOVE "READ-TEST-F1-07 " TO PAR-NAME. IX2064.2 +084700 MOVE "SAME AREA " TO FEATURE. IX2064.2 +084800 READ IX-FS1 IX2064.2 +084900 AT END IX2064.2 +085000 ADD 1000 TO WRK-DU-10V00-004. IX2064.2 +085100* IX2064.2 +085200* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATE INVALID KEY IX2064.2 +085300* PATH HAS BEEN TAKEN. IX2064.2 +085400* IX2064.2 +085500 IF WRK-DU-10V00-004 EQUAL TO ZERO IX2064.2 +085600 PERFORM PASS IX2064.2 +085700 ELSE IX2064.2 +085800 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +085900 PERFORM FAIL IX2064.2 +086000 MOVE WRK-DU-10V00-004 TO COMPUTED-A IX2064.2 +086100 MOVE ZERO TO CORRECT-A IX2064.2 +086200 MOVE "SEE PROGRAM" TO RE-MARK. IX2064.2 +086300 PERFORM PRINT-DETAIL. IX2064.2 +086400* IX2064.2 +086500* IX2064.2 +086600 READ-TEST-F1-08. IX2064.2 +086700 MOVE "READ-TEST-F1-08 " TO PAR-NAME. IX2064.2 +086800 MOVE "SAME AREA " TO FEATURE. IX2064.2 +086900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (9). IX2064.2 +087000* IX2064.2 +087100* NOTE IN TESTING THE SAME AREA CLAUSE THE RECORD AREA IX2064.2 +087200* SHOULD BE SHARED BY BOTH FILES IX-FD1 AND IX-FS1, IX2064.2 +087300* THEREFORE FILE IX-FS1 IS READ AND THE RECORD IX2064.2 +087400* IDENTIFIED FOR IX-FD1 IS ACCESSED AND TESTED FOR IX2064.2 +087500* EXPECTED PRESENCE OF IX-FS1 FILE RECORD CONTENTS. IX2064.2 +087600* IX2064.2 +087700 IF XFILE-NAME (9) EQUAL TO "IX-FS1" IX2064.2 +087800 PERFORM PASS IX2064.2 +087900 ELSE IX2064.2 +088000 MOVE "FILE CREATION PREMATURE" TO RE-MARK IX2064.2 +088100 PERFORM FAIL IX2064.2 +088200 MOVE XFILE-NAME (9) TO COMPUTED-A IX2064.2 +088300 MOVE "IX-FS1" TO CORRECT-A IX2064.2 +088400 MOVE "SEE PROGRAM" TO RE-MARK. IX2064.2 +088500 PERFORM PRINT-DETAIL. IX2064.2 +088600 CLOSE IX-FS1. IX2064.2 +088700 CLOSE IX-FD1. IX2064.2 +088800 INX-EXIT-003. IX2064.2 +088900 EXIT. IX2064.2 +089000 CCVS-EXIT SECTION. IX2064.2 +089100 CCVS-999999. IX2064.2 +089200 GO TO CLOSE-FILES. IX2064.2 diff --git a/tests/cobol85/IX/IX207A.CBL b/tests/cobol85/IX/IX207A.CBL new file mode 100755 index 00000000..d1148e3b --- /dev/null +++ b/tests/cobol85/IX/IX207A.CBL @@ -0,0 +1,1081 @@ +000100 IDENTIFICATION DIVISION. IX2074.2 +000200 PROGRAM-ID. IX2074.2 +000300 IX207A. IX2074.2 +000400**************************************************************** IX2074.2 +000500* * IX2074.2 +000600* VALIDATION FOR:- * IX2074.2 +000700* * IX2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2074.2 +000900* * IX2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2074.2 +001100* * IX2074.2 +001200**************************************************************** IX2074.2 +001300*IX207A IX2074.2 +001400******************************************************************IX2074.2 +001500*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLEIX2074.2 +001600* SYNTACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH IX2074.2 +001700* LEVEL 2 OF INDEXED I-O. THE ELEMENTS TESTED IN THIS IX2074.2 +001800* ROUTINE ARE: IX2074.2 +001900* IX2074.2 +002000* (1) ORDERING OF CLAUSES IN FILE-CONTROL-ENTRY; IX2074.2 +002100* (2) ALTERNATE RECORD KEY WITH THE DUPLICATES OPTION; IX2074.2 +002200* (3) USE AFTER STANDARD EXCEPTION FILE-NAME-1, FILE-NAME-2; IX2074.2 +002300* (4) FILE STATUS. IX2074.2 +002400* IX2074.2 +002500* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS IX2074.2 +002600* ROUTINE. FILES ARE CREATED AND ACCESSED IN THE SEQUENTIAL IX2074.2 +002700* ACCESS MODE. IX2074.2 +002800* IX2074.2 +002900* IX2074.2 +003000* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2074.2 +003100* IX2074.2 +003200* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2074.2 +003300* CLAUSE FOR DATA FILE IX-FS1 IX2074.2 +003400* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2074.2 +003500* CLAUSE FOR DATA FILE IX-FD2 IX2074.2 +003600* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2074.2 +003700* CLAUSE FOR INDEX FILE IX-FS1 IX2074.2 +003800* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2074.2 +003900* CLAUSE FOR INDEX FILE IX-FD2 IX2074.2 +004000* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2074.2 +004100* X-62 FOR RAW-DATA IX2074.2 +004200* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2074.2 +004300* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2074.2 +004400* X-84 LABEL RECORDS FOR PRINT-FILE IX2074.2 +004500* IX2074.2 +004600* NOTE: X-CARDS 44, 45, 62 AND 84 ARE OPTIONAL IX2074.2 +004700* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2074.2 +004800* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2074.2 +004900* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2074.2 +005000* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2074.2 +005100* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2074.2 +005200* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2074.2 +005300* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2074.2 +005400* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2074.2 +005500* THEY ARE AS FOLLOWS IX2074.2 +005600* IX2074.2 +005700* P SELECTS X-CARDS 62 IX2074.2 +005800* C SELECTS X-CARDS 84 IX2074.2 +005900* IX2074.2 +006000* NOTE: THERE IS OPTIONAL SOURCE CODE IN THIS PROGRAM IX2074.2 +006100* FOR THE CONVENIENCE OF THE USER. THIS OPTIONAL IX2074.2 +006200* CODE IS IDENTIFIED BY THE LETTER T,U OR X IN IX2074.2 +006300* POSITION 7 OF THE SOURCE LINE. USE OF IX2074.2 +006400* SOURCE CODE WITH LETTER X WILL PRINT THE CONTENTS IX2074.2 +006500* OF THE FILES AFTER THE TEST REPORT. FOR CODE IX2074.2 +006600* WITH LETTERS T OR U ONLY ONE SHOULD BE SELECTED. IX2074.2 +006700* EITHER THE T"S OR THE U"S SHOULD BE USED EXCLU- IX2074.2 +006800* SIVELY, NOT BOTH. THE T"S PROVIDE A 29 CHARACTER IX2074.2 +006900* INDEXED KEY SIZE FOR THE FILE AND THE U"S PROVIDE IX2074.2 +007000* AN INDEXED KEY NO GREATER THAN 8 CHARACTERS. IX2074.2 +007100* IF THE VP-ROUTINE IS USED THE APPROPRIATE IX2074.2 +007200* SOURCE CODE MAY BE SELECTED BY SPECIFYING THE IX2074.2 +007300* RESPECTIVE LETTER IN THE "*OPT" VP-ROUTINE CONTROLIX2074.2 +007400* CARD. IX2074.2 +007500* IX2074.2 +007600****************************************************** IX2074.2 +007700 ENVIRONMENT DIVISION. IX2074.2 +007800 CONFIGURATION SECTION. IX2074.2 +007900 SOURCE-COMPUTER. IX2074.2 +008000 Linux. IX2074.2 +008100 OBJECT-COMPUTER. IX2074.2 +008200 Linux. IX2074.2 +008300 INPUT-OUTPUT SECTION. IX2074.2 +008400 FILE-CONTROL. IX2074.2 +008500*P SELECT RAW-DATA ASSIGN TO IX2074.2 +008600*P "XXXXX062" IX2074.2 +008700*P ORGANIZATION IS INDEXED IX2074.2 +008800*P ACCESS MODE IS RANDOM IX2074.2 +008900*P RECORD KEY IS RAW-DATA-KEY. IX2074.2 +009000 SELECT PRINT-FILE ASSIGN TO IX2074.2 +009100 "report.log". IX2074.2 +009200 IX2074.2 +009300 SELECT IX-FS1 IX2074.2 +009400 ACCESS MODE IS SEQUENTIAL IX2074.2 +009500 ALTERNATE RECORD IX-FS1-ALTKEY1 IX2074.2 +009600 WITH DUPLICATES IX2074.2 +009700 FILE STATUS FS1-STATUS IX2074.2 +009800 RECORD KEY IS IX-FS1-KEY IX2074.2 +009900 ORGANIZATION IS INDEXED IX2074.2 +010000 ASSIGN TO IX2074.2 +010100*J **** X-CARD UNDEFINED **** IX2074.2 +010200 "XXXXX024". IX2074.2 +010300 IX2074.2 +010400 SELECT IX-FS2 IX2074.2 +010500 ASSIGN TO IX2074.2 +010600 "XXXXX025" IX2074.2 +010700*J **** X-CARD UNDEFINED **** IX2074.2 +010800 ORGANIZATION IS INDEXED IX2074.2 +010900 ALTERNATE RECORD KEY IX-FS2-ALTKEY1 IX2074.2 +011000 DUPLICATES IX2074.2 +011100 RECORD KEY IS IX-FS2-KEY. IX2074.2 +011200 IX2074.2 +011300 DATA DIVISION. IX2074.2 +011400 FILE SECTION. IX2074.2 +011500*P IX2074.2 +011600*PD RAW-DATA. IX2074.2 +011700*P IX2074.2 +011800*P1 RAW-DATA-SATZ. IX2074.2 +011900*P 05 RAW-DATA-KEY PIC X(6). IX2074.2 +012000*P 05 C-DATE PIC 9(6). IX2074.2 +012100*P 05 C-TIME PIC 9(8). IX2074.2 +012200*P 05 C-NO-OF-TESTS PIC 99. IX2074.2 +012300*P 05 C-OK PIC 999. IX2074.2 +012400*P 05 C-ALL PIC 999. IX2074.2 +012500*P 05 C-FAIL PIC 999. IX2074.2 +012600*P 05 C-DELETED PIC 999. IX2074.2 +012700*P 05 C-INSPECT PIC 999. IX2074.2 +012800*P 05 C-NOTE PIC X(13). IX2074.2 +012900*P 05 C-INDENT PIC X. IX2074.2 +013000*P 05 C-ABORT PIC X(8). IX2074.2 +013100 FD PRINT-FILE. IX2074.2 +013200 01 PRINT-REC PICTURE X(120). IX2074.2 +013300 01 DUMMY-RECORD PICTURE X(120). IX2074.2 +013400 FD IX-FS1 IX2074.2 +013500*C LABEL RECORD IS STANDARD IX2074.2 +013600*C DATA RECORD IS IX-FS1R1-F-G-240 IX2074.2 +013700 RECORD CONTAINS 240 CHARACTERS. IX2074.2 +013800 01 IX-FS1R1-F-G-240. IX2074.2 +013900 05 IX-FS1-REC-120 PIC X(120). IX2074.2 +014000 05 IX-FS1-REC-121-240. IX2074.2 +014100 10 FILLER PIC X(8). IX2074.2 +014200 10 IX-FS1-KEY. IX2074.2 +014300 15 IX-FS1-KEYNUM PIC 9(5). IX2074.2 +014400 15 FILLER PIC X(24). IX2074.2 +014500*U 10 FILLER PIC X(24). IX2074.2 +014600 10 FILLER PIC X(9). IX2074.2 +014700 10 IX-FS1-ALTKEY1. IX2074.2 +014800 15 FILLER PIC X(24). IX2074.2 +014900 15 IX-FS1-ALTKEY1NUM PIC 9(5). IX2074.2 +015000*U 10 FILLER PIC X(24). IX2074.2 +015100 10 FILLER PIC X(45). IX2074.2 +015200 FD IX-FS2 IX2074.2 +015300*C LABEL RECORDS ARE STANDARD IX2074.2 +015400*C DATA RECORD IS IX-FS2R1-F-G-240 IX2074.2 +015500 RECORD CONTAINS 240 CHARACTERS. IX2074.2 +015600 01 IX-FS2R1-F-G-240. IX2074.2 +015700 05 IX-FS2-REC-120 PIC X(120). IX2074.2 +015800 05 IX-FS2-REC-121-240. IX2074.2 +015900 10 FILLER PIC X(8). IX2074.2 +016000 10 IX-FS2-KEY. IX2074.2 +016100 15 IX-FS2-KEYNUM PIC 9(5). IX2074.2 +016200 15 FILLER PIC A(24). IX2074.2 +016300*U 10 FILLER PIC X(24). IX2074.2 +016400 10 FILLER PIC X(9). IX2074.2 +016500 10 IX-FS2-ALTKEY1. IX2074.2 +016600 15 FILLER PIC X(24). IX2074.2 +016700 15 IX-FS2-ALTKEY1NUM PIC 9(5). IX2074.2 +016800*U 10 FILLER PIC X(24). IX2074.2 +016900 10 FILLER PIC X(45). IX2074.2 +017000 WORKING-STORAGE SECTION. IX2074.2 +017100 01 IX-FS1-FILESIZE PIC 9(6) VALUE 300. IX2074.2 +017200 01 IX-FS2-FILESIZE PIC 9(6) VALUE 300. IX2074.2 +017300 01 WRK-FS1-RECKEY. IX2074.2 +017400 03 WRK-DU-05V00-001 PIC 9(5) VALUE ZERO. IX2074.2 +017500 03 WRK-XN-24V00-001 PIC X(24) VALUE IX2074.2 +017600 "123456789009876543211234". IX2074.2 +017700 01 WRK-FS2-RECKEY. IX2074.2 +017800 03 WRK-DU-05V00-002 PIC 9(5) VALUE ZERO. IX2074.2 +017900 03 WRK-XN-24V00-002 PIC A(24) VALUE IX2074.2 +018000 "ABCDEFGHIJKLMNOPQRSTUVWX". IX2074.2 +018100 01 WRK-FS1-ALTKEY. IX2074.2 +018200 03 WRK-XN-24V00-003 PIC X(24) VALUE IX2074.2 +018300 "+-*/=$,;.(()><""<>()).;,$". IX2074.2 +018400* IX2074.2 +018500* THE ALPHNUMERIC POSITIONS OF THE DATA ITEM ABOVE CONTAINS A IX2074.2 +018600* LITERAL VALUE WITH INBEDDED QUOTES. IX2074.2 +018700* IX2074.2 +018800 03 WRK-DU-05V00-003 PIC 9(5) VALUE ZERO. IX2074.2 +018900 01 WRK-FS2-ALTKEY. IX2074.2 +019000 03 WRK-XN-24V00-003 PIC X(24) VALUE IX2074.2 +019100 "AB12CD34EF56GH78IJ90KL*,". IX2074.2 +019200 03 WRK-DU-05V00-004 PIC 9(5) VALUE ZERO. IX2074.2 +019300 01 WRK-DS-05V00-005 PIC S9(5) VALUE ZERO. IX2074.2 +019400 01 WRK-DS-05V00-006 PIC S9(5) VALUE ZERO. IX2074.2 +019500 01 WRK-DS-05V00-007 PIC S9(5) VALUE ZERO. IX2074.2 +019600 01 WRK-DS-05V00-008 PIC S9(5) VALUE ZERO. IX2074.2 +019700 01 WRK-DS-04V00-001 PIC S9(4) VALUE ZERO. IX2074.2 +019800 01 WRK-DS-04V00-002 PIC S9(4) VALUE ZERO. IX2074.2 +019900 01 FS1-STATUS PIC XX VALUE SPACE. IX2074.2 +020000 01 FILE-RECORD-INFORMATION-REC. IX2074.2 +020100 03 FILE-RECORD-INFO-SKELETON. IX2074.2 +020200 05 FILLER PICTURE X(48) VALUE IX2074.2 +020300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2074.2 +020400 05 FILLER PICTURE X(46) VALUE IX2074.2 +020500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2074.2 +020600 05 FILLER PICTURE X(26) VALUE IX2074.2 +020700 ",LFIL=000000,ORG= ,LBLR= ". IX2074.2 +020800 05 FILLER PICTURE X(37) VALUE IX2074.2 +020900 ",RECKEY= ". IX2074.2 +021000 05 FILLER PICTURE X(38) VALUE IX2074.2 +021100 ",ALTKEY1= ". IX2074.2 +021200 05 FILLER PICTURE X(38) VALUE IX2074.2 +021300 ",ALTKEY2= ". IX2074.2 +021400 05 FILLER PICTURE X(7) VALUE SPACE.IX2074.2 +021500 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2074.2 +021600 05 FILE-RECORD-INFO-P1-120. IX2074.2 +021700 07 FILLER PIC X(5). IX2074.2 +021800 07 XFILE-NAME PIC X(6). IX2074.2 +021900 07 FILLER PIC X(8). IX2074.2 +022000 07 XRECORD-NAME PIC X(6). IX2074.2 +022100 07 FILLER PIC X(1). IX2074.2 +022200 07 REELUNIT-NUMBER PIC 9(1). IX2074.2 +022300 07 FILLER PIC X(7). IX2074.2 +022400 07 XRECORD-NUMBER PIC 9(6). IX2074.2 +022500 07 FILLER PIC X(6). IX2074.2 +022600 07 UPDATE-NUMBER PIC 9(2). IX2074.2 +022700 07 FILLER PIC X(5). IX2074.2 +022800 07 ODO-NUMBER PIC 9(4). IX2074.2 +022900 07 FILLER PIC X(5). IX2074.2 +023000 07 XPROGRAM-NAME PIC X(5). IX2074.2 +023100 07 FILLER PIC X(7). IX2074.2 +023200 07 XRECORD-LENGTH PIC 9(6). IX2074.2 +023300 07 FILLER PIC X(7). IX2074.2 +023400 07 CHARS-OR-RECORDS PIC X(2). IX2074.2 +023500 07 FILLER PIC X(1). IX2074.2 +023600 07 XBLOCK-SIZE PIC 9(4). IX2074.2 +023700 07 FILLER PIC X(6). IX2074.2 +023800 07 RECORDS-IN-FILE PIC 9(6). IX2074.2 +023900 07 FILLER PIC X(5). IX2074.2 +024000 07 XFILE-ORGANIZATION PIC X(2). IX2074.2 +024100 07 FILLER PIC X(6). IX2074.2 +024200 07 XLABEL-TYPE PIC X(1). IX2074.2 +024300 05 FILE-RECORD-INFO-P121-240. IX2074.2 +024400 07 FILLER PIC X(8). IX2074.2 +024500 07 XRECORD-KEY PIC X(29). IX2074.2 +024600 07 FILLER PIC X(9). IX2074.2 +024700 07 ALTERNATE-KEY1 PIC X(29). IX2074.2 +024800 07 FILLER PIC X(9). IX2074.2 +024900 07 ALTERNATE-KEY2 PIC X(29). IX2074.2 +025000 07 FILLER PIC X(7). IX2074.2 +025100 01 TEST-RESULTS. IX2074.2 +025200 02 FILLER PIC X VALUE SPACE. IX2074.2 +025300 02 FEATURE PIC X(20) VALUE SPACE. IX2074.2 +025400 02 FILLER PIC X VALUE SPACE. IX2074.2 +025500 02 P-OR-F PIC X(5) VALUE SPACE. IX2074.2 +025600 02 FILLER PIC X VALUE SPACE. IX2074.2 +025700 02 PAR-NAME. IX2074.2 +025800 03 FILLER PIC X(19) VALUE SPACE. IX2074.2 +025900 03 PARDOT-X PIC X VALUE SPACE. IX2074.2 +026000 03 DOTVALUE PIC 99 VALUE ZERO. IX2074.2 +026100 02 FILLER PIC X(8) VALUE SPACE. IX2074.2 +026200 02 RE-MARK PIC X(61). IX2074.2 +026300 01 TEST-COMPUTED. IX2074.2 +026400 02 FILLER PIC X(30) VALUE SPACE. IX2074.2 +026500 02 FILLER PIC X(17) VALUE IX2074.2 +026600 " COMPUTED=". IX2074.2 +026700 02 COMPUTED-X. IX2074.2 +026800 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2074.2 +026900 03 COMPUTED-N REDEFINES COMPUTED-A IX2074.2 +027000 PIC -9(9).9(9). IX2074.2 +027100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2074.2 +027200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2074.2 +027300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2074.2 +027400 03 CM-18V0 REDEFINES COMPUTED-A. IX2074.2 +027500 04 COMPUTED-18V0 PIC -9(18). IX2074.2 +027600 04 FILLER PIC X. IX2074.2 +027700 03 FILLER PIC X(50) VALUE SPACE. IX2074.2 +027800 01 TEST-CORRECT. IX2074.2 +027900 02 FILLER PIC X(30) VALUE SPACE. IX2074.2 +028000 02 FILLER PIC X(17) VALUE " CORRECT =". IX2074.2 +028100 02 CORRECT-X. IX2074.2 +028200 03 CORRECT-A PIC X(20) VALUE SPACE. IX2074.2 +028300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2074.2 +028400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2074.2 +028500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2074.2 +028600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2074.2 +028700 03 CR-18V0 REDEFINES CORRECT-A. IX2074.2 +028800 04 CORRECT-18V0 PIC -9(18). IX2074.2 +028900 04 FILLER PIC X. IX2074.2 +029000 03 FILLER PIC X(2) VALUE SPACE. IX2074.2 +029100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2074.2 +029200 01 CCVS-C-1. IX2074.2 +029300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2074.2 +029400- "SS PARAGRAPH-NAME IX2074.2 +029500- " REMARKS". IX2074.2 +029600 02 FILLER PIC X(20) VALUE SPACE. IX2074.2 +029700 01 CCVS-C-2. IX2074.2 +029800 02 FILLER PIC X VALUE SPACE. IX2074.2 +029900 02 FILLER PIC X(6) VALUE "TESTED". IX2074.2 +030000 02 FILLER PIC X(15) VALUE SPACE. IX2074.2 +030100 02 FILLER PIC X(4) VALUE "FAIL". IX2074.2 +030200 02 FILLER PIC X(94) VALUE SPACE. IX2074.2 +030300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2074.2 +030400 01 REC-CT PIC 99 VALUE ZERO. IX2074.2 +030500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2074.2 +030600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2074.2 +030700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2074.2 +030800 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2074.2 +030900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2074.2 +031000 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2074.2 +031100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2074.2 +031200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2074.2 +031300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2074.2 +031400 01 CCVS-H-1. IX2074.2 +031500 02 FILLER PIC X(39) VALUE SPACES. IX2074.2 +031600 02 FILLER PIC X(42) VALUE IX2074.2 +031700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2074.2 +031800 02 FILLER PIC X(39) VALUE SPACES. IX2074.2 +031900 01 CCVS-H-2A. IX2074.2 +032000 02 FILLER PIC X(40) VALUE SPACE. IX2074.2 +032100 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2074.2 +032200 02 FILLER PIC XXXX VALUE IX2074.2 +032300 "4.2 ". IX2074.2 +032400 02 FILLER PIC X(28) VALUE IX2074.2 +032500 " COPY - NOT FOR DISTRIBUTION". IX2074.2 +032600 02 FILLER PIC X(41) VALUE SPACE. IX2074.2 +032700 IX2074.2 +032800 01 CCVS-H-2B. IX2074.2 +032900 02 FILLER PIC X(15) VALUE IX2074.2 +033000 "TEST RESULT OF ". IX2074.2 +033100 02 TEST-ID PIC X(9). IX2074.2 +033200 02 FILLER PIC X(4) VALUE IX2074.2 +033300 " IN ". IX2074.2 +033400 02 FILLER PIC X(12) VALUE IX2074.2 +033500 " HIGH ". IX2074.2 +033600 02 FILLER PIC X(22) VALUE IX2074.2 +033700 " LEVEL VALIDATION FOR ". IX2074.2 +033800 02 FILLER PIC X(58) VALUE IX2074.2 +033900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2074.2 +034000 01 CCVS-H-3. IX2074.2 +034100 02 FILLER PIC X(34) VALUE IX2074.2 +034200 " FOR OFFICIAL USE ONLY ". IX2074.2 +034300 02 FILLER PIC X(58) VALUE IX2074.2 +034400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2074.2 +034500 02 FILLER PIC X(28) VALUE IX2074.2 +034600 " COPYRIGHT 1985 ". IX2074.2 +034700 01 CCVS-E-1. IX2074.2 +034800 02 FILLER PIC X(52) VALUE SPACE. IX2074.2 +034900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2074.2 +035000 02 ID-AGAIN PIC X(9). IX2074.2 +035100 02 FILLER PIC X(45) VALUE SPACES. IX2074.2 +035200 01 CCVS-E-2. IX2074.2 +035300 02 FILLER PIC X(31) VALUE SPACE. IX2074.2 +035400 02 FILLER PIC X(21) VALUE SPACE. IX2074.2 +035500 02 CCVS-E-2-2. IX2074.2 +035600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2074.2 +035700 03 FILLER PIC X VALUE SPACE. IX2074.2 +035800 03 ENDER-DESC PIC X(44) VALUE IX2074.2 +035900 "ERRORS ENCOUNTERED". IX2074.2 +036000 01 CCVS-E-3. IX2074.2 +036100 02 FILLER PIC X(22) VALUE IX2074.2 +036200 " FOR OFFICIAL USE ONLY". IX2074.2 +036300 02 FILLER PIC X(12) VALUE SPACE. IX2074.2 +036400 02 FILLER PIC X(58) VALUE IX2074.2 +036500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2074.2 +036600 02 FILLER PIC X(13) VALUE SPACE. IX2074.2 +036700 02 FILLER PIC X(15) VALUE IX2074.2 +036800 " COPYRIGHT 1985". IX2074.2 +036900 01 CCVS-E-4. IX2074.2 +037000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2074.2 +037100 02 FILLER PIC X(4) VALUE " OF ". IX2074.2 +037200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2074.2 +037300 02 FILLER PIC X(40) VALUE IX2074.2 +037400 " TESTS WERE EXECUTED SUCCESSFULLY". IX2074.2 +037500 01 XXINFO. IX2074.2 +037600 02 FILLER PIC X(19) VALUE IX2074.2 +037700 "*** INFORMATION ***". IX2074.2 +037800 02 INFO-TEXT. IX2074.2 +037900 04 FILLER PIC X(8) VALUE SPACE. IX2074.2 +038000 04 XXCOMPUTED PIC X(20). IX2074.2 +038100 04 FILLER PIC X(5) VALUE SPACE. IX2074.2 +038200 04 XXCORRECT PIC X(20). IX2074.2 +038300 02 INF-ANSI-REFERENCE PIC X(48). IX2074.2 +038400 01 HYPHEN-LINE. IX2074.2 +038500 02 FILLER PIC IS X VALUE IS SPACE. IX2074.2 +038600 02 FILLER PIC IS X(65) VALUE IS "************************IX2074.2 +038700- "*****************************************". IX2074.2 +038800 02 FILLER PIC IS X(54) VALUE IS "************************IX2074.2 +038900- "******************************". IX2074.2 +039000 01 CCVS-PGM-ID PIC X(9) VALUE IX2074.2 +039100 "IX207A". IX2074.2 +039200 PROCEDURE DIVISION. IX2074.2 +039300 DECLARATIVES. IX2074.2 +039400 USE-IX207A-TEST SECTION. IX2074.2 +039500 USE AFTER STANDARD EXCEPTION PROCEDURE IX2074.2 +039600 IX-FS1, IX-FS2. IX2074.2 +039700 USE-PAR-001. IX2074.2 +039800 ADD 00001 TO WRK-DS-05V00-006. IX2074.2 +039900 IF WRK-DS-05V00-005 LESS THAN 301 IX2074.2 +040000 GO TO USE-PAR-EXIT. IX2074.2 +040100 USE-PAR-002. IX2074.2 +040200 IF WRK-DS-05V00-006 EQUAL TO 0001 IX2074.2 +040300 MOVE "PASS" TO P-OR-F. IX2074.2 +040400 ADD 1 TO DOTVALUE. IX2074.2 +040500 MOVE "EXCEPTION PROCEDURE EXECUTED" TO RE-MARK. IX2074.2 +040600 MOVE TEST-RESULTS TO PRINT-REC. IX2074.2 +040700 WRITE PRINT-REC. IX2074.2 +040800 USE-PAR-EXIT. IX2074.2 +040900 EXIT. IX2074.2 +041000 END DECLARATIVES. IX2074.2 +041100 CCVS1 SECTION. IX2074.2 +041200 OPEN-FILES. IX2074.2 +041300*P OPEN I-O RAW-DATA. IX2074.2 +041400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2074.2 +041500*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2074.2 +041600*P MOVE "ABORTED " TO C-ABORT. IX2074.2 +041700*P ADD 1 TO C-NO-OF-TESTS. IX2074.2 +041800*P ACCEPT C-DATE FROM DATE. IX2074.2 +041900*P ACCEPT C-TIME FROM TIME. IX2074.2 +042000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2074.2 +042100*PND-E-1. IX2074.2 +042200*P CLOSE RAW-DATA. IX2074.2 +042300 OPEN OUTPUT PRINT-FILE. IX2074.2 +042400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2074.2 +042500 MOVE SPACE TO TEST-RESULTS. IX2074.2 +042600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2074.2 +042700 MOVE ZERO TO REC-SKL-SUB. IX2074.2 +042800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2074.2 +042900 CCVS-INIT-FILE. IX2074.2 +043000 ADD 1 TO REC-SKL-SUB. IX2074.2 +043100 MOVE FILE-RECORD-INFO-SKELETON IX2074.2 +043200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2074.2 +043300 CCVS-INIT-EXIT. IX2074.2 +043400 GO TO CCVS1-EXIT. IX2074.2 +043500 CLOSE-FILES. IX2074.2 +043600*P OPEN I-O RAW-DATA. IX2074.2 +043700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2074.2 +043800*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2074.2 +043900*P MOVE "OK. " TO C-ABORT. IX2074.2 +044000*P MOVE PASS-COUNTER TO C-OK. IX2074.2 +044100*P MOVE ERROR-HOLD TO C-ALL. IX2074.2 +044200*P MOVE ERROR-COUNTER TO C-FAIL. IX2074.2 +044300*P MOVE DELETE-COUNTER TO C-DELETED. IX2074.2 +044400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2074.2 +044500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2074.2 +044600*PND-E-2. IX2074.2 +044700*P CLOSE RAW-DATA. IX2074.2 +044800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2074.2 +044900 TERMINATE-CCVS. IX2074.2 +045000*S EXIT PROGRAM. IX2074.2 +045100*SERMINATE-CALL. IX2074.2 +045200 STOP RUN. IX2074.2 +045300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2074.2 +045400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2074.2 +045500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2074.2 +045600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2074.2 +045700 MOVE "****TEST DELETED****" TO RE-MARK. IX2074.2 +045800 PRINT-DETAIL. IX2074.2 +045900 IF REC-CT NOT EQUAL TO ZERO IX2074.2 +046000 MOVE "." TO PARDOT-X IX2074.2 +046100 MOVE REC-CT TO DOTVALUE. IX2074.2 +046200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +046300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2074.2 +046400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2074.2 +046500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2074.2 +046600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2074.2 +046700 MOVE SPACE TO CORRECT-X. IX2074.2 +046800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2074.2 +046900 MOVE SPACE TO RE-MARK. IX2074.2 +047000 HEAD-ROUTINE. IX2074.2 +047100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +047200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +047300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2074.2 +047400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2074.2 +047500 COLUMN-NAMES-ROUTINE. IX2074.2 +047600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +047700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +047800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +047900 END-ROUTINE. IX2074.2 +048000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2074.2 +048100 END-RTN-EXIT. IX2074.2 +048200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +048300 END-ROUTINE-1. IX2074.2 +048400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2074.2 +048500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2074.2 +048600 ADD PASS-COUNTER TO ERROR-HOLD. IX2074.2 +048700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2074.2 +048800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2074.2 +048900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2074.2 +049000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2074.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2074.2 +049200 END-ROUTINE-12. IX2074.2 +049300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2074.2 +049400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2074.2 +049500 MOVE "NO " TO ERROR-TOTAL IX2074.2 +049600 ELSE IX2074.2 +049700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2074.2 +049800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2074.2 +049900 PERFORM WRITE-LINE. IX2074.2 +050000 END-ROUTINE-13. IX2074.2 +050100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2074.2 +050200 MOVE "NO " TO ERROR-TOTAL ELSE IX2074.2 +050300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2074.2 +050400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2074.2 +050500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +050600 IF INSPECT-COUNTER EQUAL TO ZERO IX2074.2 +050700 MOVE "NO " TO ERROR-TOTAL IX2074.2 +050800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2074.2 +050900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2074.2 +051000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +051100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2074.2 +051200 WRITE-LINE. IX2074.2 +051300 ADD 1 TO RECORD-COUNT. IX2074.2 +051400 IF RECORD-COUNT GREATER 42 IX2074.2 +051500 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2074.2 +051600 MOVE SPACE TO DUMMY-RECORD IX2074.2 +051700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2074.2 +051800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2074.2 +051900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2074.2 +052000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2074.2 +052100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2074.2 +052200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2074.2 +052300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2074.2 +052400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2074.2 +052500 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2074.2 +052600 MOVE ZERO TO RECORD-COUNT. IX2074.2 +052700 PERFORM WRT-LN. IX2074.2 +052800 WRT-LN. IX2074.2 +052900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2074.2 +053000 MOVE SPACE TO DUMMY-RECORD. IX2074.2 +053100 BLANK-LINE-PRINT. IX2074.2 +053200 PERFORM WRT-LN. IX2074.2 +053300 FAIL-ROUTINE. IX2074.2 +053400 IF COMPUTED-X NOT EQUAL TO SPACE IX2074.2 +053500 GO TO FAIL-ROUTINE-WRITE. IX2074.2 +053600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2074.2 +053700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2074.2 +053800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2074.2 +053900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +054000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2074.2 +054100 GO TO FAIL-ROUTINE-EX. IX2074.2 +054200 FAIL-ROUTINE-WRITE. IX2074.2 +054300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2074.2 +054400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2074.2 +054500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2074.2 +054600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2074.2 +054700 FAIL-ROUTINE-EX. EXIT. IX2074.2 +054800 BAIL-OUT. IX2074.2 +054900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2074.2 +055000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2074.2 +055100 BAIL-OUT-WRITE. IX2074.2 +055200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2074.2 +055300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2074.2 +055400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2074.2 +055500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2074.2 +055600 BAIL-OUT-EX. EXIT. IX2074.2 +055700 CCVS1-EXIT. IX2074.2 +055800 EXIT. IX2074.2 +055900 SECT-IX207A-0001 SECTION. IX2074.2 +056000 WRITE-INT-GF-01. IX2074.2 +056100 OPEN OUTPUT IX-FS1. IX2074.2 +056200 MOVE "IX-FS1" TO XFILE-NAME (1). IX2074.2 +056300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2074.2 +056400 MOVE ZERO TO XRECORD-NUMBER (1). IX2074.2 +056500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2074.2 +056600 MOVE 000240 TO XRECORD-LENGTH (1). IX2074.2 +056700 MOVE 0001 TO XBLOCK-SIZE (1). IX2074.2 +056800 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2074.2 +056900 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2074.2 +057000 MOVE "S" TO XLABEL-TYPE (1). IX2074.2 +057100 MOVE 000300 TO IX-FS1-FILESIZE IX2074.2 +057200 MOVE 000300 TO RECORDS-IN-FILE (1). IX2074.2 +057300 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +057400 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +057500 MOVE ZERO TO WRK-DS-04V00-002. IX2074.2 +057600 MOVE 00001 TO WRK-DU-05V00-001. IX2074.2 +057700 MOVE IX-FS1-FILESIZE TO WRK-DU-05V00-003. IX2074.2 +057800 MOVE ZERO TO WRK-DS-05V00-006. IX2074.2 +057900 MOVE 00001 TO WRK-DS-05V00-007. IX2074.2 +058000 MOVE "TESTED FEATURES: "IX2074.2 +058100 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +058200 MOVE "ORDERING OF CLAUSES IN SELECT STATEMENT IX-8 2.3.3 (1)"IX2074.2 +058300 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +058400 MOVE "ALERNATE RECORD KEY WITH DUPLICATES; IX-11 "IX2074.2 +058500 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +058600 MOVE "USE AFTER STANDARD EXECPTION; IX-39 "IX2074.2 +058700 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +058800 MOVE "FILE STATUS; IX-3 "IX2074.2 +058900 TO PRINT-REC. PERFORM WRITE-LINE. IX2074.2 +059000 PERFORM BLANK-LINE-PRINT. IX2074.2 +059100* IX2074.2 +059200* WRK-DS-05V00-005 = COUNTS THE NUMBER OF TIMES READ/WRITE IX2074.2 +059300* WAS EXECUTED. IX2074.2 +059400* IX2074.2 +059500* WRK-DS-04V00-001 = THIS COUNTER IS INCREMENTED EACH TIME IX2074.2 +059600* A WRITE STATEMENT IS ENCOUNTERED IX2074.2 +059700* THE COUNTER IS DECREMENTED EACH TIME AN IX2074.2 +059800* INVALID KEY CONDITION OCCURS ON THE WRITEIX2074.2 +059900* WRK-DU-05V00-001 = NUMERIC FIELD ENBEDDED IN RECORD KEY IX2074.2 +060000* WHICH MAKES THE KEY UNIQUE. IX2074.2 +060100* IX2074.2 +060200* WRK-DU-05V00-003 = NUMERIC FIELD ENBEDDED IN ALTERNATE KEY IX2074.2 +060300* WHICH MAKES THE KEY UNIQUE. IX2074.2 +060400* IX2074.2 +060500* WRK-DS-05V00-006 = COUNTER IS INCREMENTED EACH TIME A RECORDIX2074.2 +060600* RETRIEVED IS NOT THE ONE EXPECTED. IX2074.2 +060700* IX2074.2 +060800* WRK-DS-05V00-007 = THIS COUNTER IS USED TO CREATE A IX2074.2 +060900* DUPLICATE ALTERNATE KEY - I.E., EVERY IX2074.2 +061000* 50TH RECORD. IX2074.2 +061100* IX2074.2 +061200* WRK-DS-05V00-008 = COUNTER CONTAINING THE RECORD NUMBER IX2074.2 +061300* WHICH IS EXPECTED TO BE FOUND. IX2074.2 +061400* IX2074.2 +061500* NOTE - RECORDS OF THE FILE ARE CREATED SEQUENTIALLY IX2074.2 +061600* BY RECORD KEY VALUE . THE ALTERNATE RECORD KEY IX2074.2 +061700* VALUES ARE CREATED INVERSE TO TO THE RECORD IX2074.2 +061800* CREATION SEQUENCE OF THE FILE. IX2074.2 +061900* IX2074.2 +062000* FOLLOWING IS AN EXAMPLE OF THE SEQUENTIAL ORDER OF THE IX2074.2 +062100* RECORDS AS CREATED. IX2074.2 +062200* IX2074.2 +062300* RECORD RECORD ALTERNATE IX2074.2 +062400* NUMBER KEY KEY IX2074.2 +062500* IX2074.2 +062600* 001 001 300 IX2074.2 +062700* 002 002 299 IX2074.2 +062800* 003 003 298 IX2074.2 +062900* . . . IX2074.2 +063000* . . . IX2074.2 +063100* . . . IX2074.2 +063200* 50 050 251 IX2074.2 +063300* 51 051 251 IX2074.2 +063400* 52 052 249 IX2074.2 +063500* IX2074.2 +063600* IX2074.2 +063700 WRITE-TEST-GF-01-R1. IX2074.2 +063800 ADD 000001 TO XRECORD-NUMBER (1). IX2074.2 +063900 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2074.2 +064000 MOVE WRK-FS1-ALTKEY TO ALTERNATE-KEY1 (1). IX2074.2 +064100 WRITE IX-FS1R1-F-G-240 FROM FILE-RECORD-INFO (1) IX2074.2 +064200 INVALID KEY IX2074.2 +064300 SUBTRACT 0001 FROM WRK-DS-04V00-001. IX2074.2 +064400 ADD 0001 TO WRK-DS-04V00-001. IX2074.2 +064500 ADD 0001 TO WRK-DS-05V00-005. IX2074.2 +064600 ADD 00001 TO WRK-DS-05V00-007. IX2074.2 +064700 IF WRK-DS-05V00-007 GREATER THAN 50 IX2074.2 +064800 MOVE 0001 TO WRK-DS-05V00-007 IX2074.2 +064900 ELSE IX2074.2 +065000 SUBTRACT WRK-DU-05V00-001 FROM IX-FS1-FILESIZE IX2074.2 +065100 GIVING WRK-DU-05V00-003. IX2074.2 +065200* IX2074.2 +065300* EVERY 50TH AND 51ST ALTERNATE KEY VALUE WILL BE EQUAL. IX2074.2 +065400* IX2074.2 +065500 ADD 00001 TO WRK-DU-05V00-001. IX2074.2 +065600 IF WRK-DS-05V00-005 LESS THAN IX-FS1-FILESIZE IX2074.2 +065700 GO TO WRITE-TEST-GF-01-R1. IX2074.2 +065800 CLOSE IX-FS1. IX2074.2 +065900 WRITE-TEST-GF-01. IX2074.2 +066000 MOVE "WRITE" TO FEATURE. IX2074.2 +066100 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2074.2 +066200 IF WRK-DS-04V00-001 NOT EQUAL TO IX-FS1-FILESIZE IX2074.2 +066300 PERFORM FAIL IX2074.2 +066400 MOVE WRK-DS-04V00-001 TO COMPUTED-N IX2074.2 +066500 MOVE IX-FS1-FILESIZE TO CORRECT-N IX2074.2 +066600 ELSE IX2074.2 +066700 PERFORM PASS. IX2074.2 +066800 PERFORM PRINT-DETAIL. IX2074.2 +066900* IX2074.2 +067000* IX2074.2 +067100 READ-INIT-F1-01. IX2074.2 +067200 MOVE 001 TO WRK-DS-05V00-008. IX2074.2 +067300 MOVE ZERO TO WRK-DS-05V00-006. IX2074.2 +067400 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +067500 OPEN INPUT IX-FS1. IX2074.2 +067600 READ-TEST-F1-01-R2. IX2074.2 +067700 READ IX-FS1 RECORD AT END IX2074.2 +067800 GO TO READ-TEST-F1-01. IX2074.2 +067900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2074.2 +068000 ADD 0001 TO WRK-DS-05V00-005. IX2074.2 +068100 IF WRK-DS-05V00-008 NOT EQUAL TO XRECORD-NUMBER (1) IX2074.2 +068200 ADD 00001 TO WRK-DS-05V00-006. IX2074.2 +068300 ADD 00001 TO WRK-DS-05V00-008. IX2074.2 +068400 IF WRK-DS-05V00-005 LESS THAN IX-FS1-FILESIZE IX2074.2 +068500 GO TO READ-TEST-F1-01-R2. IX2074.2 +068600 READ-TEST-F1-01. IX2074.2 +068700 MOVE "READ RECORD KEY " TO FEATURE. IX2074.2 +068800 MOVE "READ-TEST-F1-01 " TO PAR-NAME. IX2074.2 +068900 CLOSE IX-FS1. IX2074.2 +069000 SUBTRACT IX-FS1-FILESIZE FROM WRK-DS-05V00-005. IX2074.2 +069100 ADD WRK-DS-05V00-005 TO WRK-DS-05V00-006. IX2074.2 +069200 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +069300 PERFORM FAIL IX2074.2 +069400 MOVE ZERO TO CORRECT-N IX2074.2 +069500 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +069600 ELSE IX2074.2 +069700 PERFORM PASS. IX2074.2 +069800 PERFORM PRINT-DETAIL. IX2074.2 +069900* IX2074.2 +070000* IX2074.2 +070100 READ-INT-F1-02. IX2074.2 +070200 MOVE 00020 TO WRK-DS-05V00-006. IX2074.2 +070300 MOVE 00241 TO WRK-DS-05V00-008. IX2074.2 +070400 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +070500 MOVE 00060 TO WRK-DU-05V00-003. IX2074.2 +070600 OPEN INPUT IX-FS1. IX2074.2 +070700 MOVE WRK-FS1-ALTKEY TO IX-FS1-ALTKEY1. IX2074.2 +070800 START IX-FS1 KEY IS EQUAL TO IX2074.2 +070900 IX-FS1-ALTKEY1 IX2074.2 +071000 INVALID KEY IX2074.2 +071100 ADD 1000 TO WRK-DS-05V00-006. IX2074.2 +071200 READ-TEST-F1-02-R3. IX2074.2 +071300 READ IX-FS1 RECORD AT END IX2074.2 +071400 ADD 10000 TO WRK-DS-05V00-006 IX2074.2 +071500 GO TO READ-TEST-F1-02. IX2074.2 +071600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2074.2 +071700 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +071800 IF WRK-DS-05V00-008 EQUAL TO XRECORD-NUMBER (1) IX2074.2 +071900 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +072000 IF WRK-DS-05V00-005 LESS THAN 20 IX2074.2 +072100 SUBTRACT 00001 FROM WRK-DS-05V00-008 IX2074.2 +072200 GO TO READ-TEST-F1-02-R3. IX2074.2 +072300 READ-TEST-F1-02. IX2074.2 +072400 MOVE "READ ALTERNATE KEY " TO FEATURE. IX2074.2 +072500 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX2074.2 +072600 CLOSE IX-FS1. IX2074.2 +072700 MOVE "READ ALTERNATE KEY" TO FEATURE. IX2074.2 +072800 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +072900 PERFORM FAIL IX2074.2 +073000 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +073100 MOVE ZERO TO CORRECT-N IX2074.2 +073200 MOVE "SEE PROGRAM" TO RE-MARK IX2074.2 +073300 ELSE IX2074.2 +073400 PERFORM PASS. IX2074.2 +073500* IX2074.2 +073600* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATES THAT IX2074.2 +073700* AN INVALID KEY CONDITION OCCURRED ON THE START IX2074.2 +073800* STATEMENT - SEE PARAGRAPH INX-INIT-001-3. IX2074.2 +073900* IX2074.2 +074000* COMPUTED RESULTS IN INCREMENTS OF 10000 INDICATE THAT THE IX2074.2 +074100* AT END PATH ON THE READ WAS TAKEN. IX2074.2 +074200* IX2074.2 +074300* COMPUTED RESULTS IN INCREMENTS OF 00001 INDICATE THAT THE IX2074.2 +074400* RECORD MADE AVAILABLE AS A RESULT OF THE READ IX2074.2 +074500* WAS NOT THE ONE EXPECTED. IX2074.2 +074600* IX2074.2 +074700 PERFORM PRINT-DETAIL. IX2074.2 +074800* IX2074.2 +074900* 03 IX2074.2 +075000* IX2074.2 +075100 READ-INIT-F1-03. IX2074.2 +075200 MOVE 00060 TO WRK-DS-05V00-006. IX2074.2 +075300 MOVE 00001 TO WRK-DU-05V00-003. IX2074.2 +075400 MOVE 00300 TO WRK-DS-05V00-008. IX2074.2 +075500 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +075600 OPEN INPUT IX-FS1. IX2074.2 +075700 MOVE WRK-FS1-ALTKEY TO IX-FS1-ALTKEY1. IX2074.2 +075800 START IX-FS1 KEY IS EQUAL TO IX2074.2 +075900 IX-FS1-ALTKEY1 IX2074.2 +076000 INVALID KEY IX2074.2 +076100 ADD 01000 TO WRK-DS-05V00-006. IX2074.2 +076200 READ-TEST-F1-03-R4. IX2074.2 +076300 READ IX-FS1 RECORD AT END IX2074.2 +076400 ADD 10000 TO WRK-DS-05V00-006 IX2074.2 +076500 GO TO READ-TEST-F1-03. IX2074.2 +076600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2074.2 +076700 IF WRK-DS-05V00-008 EQUAL TO XRECORD-NUMBER (1) IX2074.2 +076800 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +076900 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +077000 IF WRK-DS-05V00-005 EQUAL TO 50 AND IX2074.2 +077100 XRECORD-NUMBER (1) EQUAL TO 250 IX2074.2 +077200 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +077300 IF WRK-DS-05V00-005 EQUAL TO 51 AND IX2074.2 +077400 XRECORD-NUMBER (1) EQUAL TO 251 IX2074.2 +077500 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +077600 SUBTRACT 00001 FROM WRK-DS-05V00-008. IX2074.2 +077700 IF WRK-DS-05V00-005 LESS THAN 60 IX2074.2 +077800 GO TO READ-TEST-F1-03-R4. IX2074.2 +077900 READ-TEST-F1-03. IX2074.2 +078000 MOVE "READ DUPLICATE KEY " TO FEATURE. IX2074.2 +078100 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX2074.2 +078200 CLOSE IX-FS1. IX2074.2 +078300 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +078400 PERFORM FAIL IX2074.2 +078500 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +078600 MOVE ZERO TO CORRECT-N IX2074.2 +078700 MOVE "SEE PROGRAM" TO RE-MARK IX2074.2 +078800 ELSE IX2074.2 +078900 PERFORM PASS. IX2074.2 +079000* IX2074.2 +079100* WITH THE GIVEN SYNTACTICAL COBOL ENTRIES IN THE FILE-CONTROL IX2074.2 +079200* PARAGRAPH THIS TEST VERIFIES THAT RECORDS WITH DUPLICATE IX2074.2 +079300* KEYS CAN BE ACCESSED WHEN THE FILE IS READ IX2074.2 +079400* SEQUENTIALLY. THE START STATEMENT ESTABLISHES THE ALTERNATE IX2074.2 +079500* KEY AS THE KEY OF REFERENCE AND POSITIONS THE CURRENT IX2074.2 +079600* RECORD POINTER TO THE LAST RECORD IN THE FILE (ALTERNATE IX2074.2 +079700* KEY VALUE OF 1). SIXTY RECORDS ARE READ SEQUENTIALLY USING IX2074.2 +079800* THE ALTERNATE KEY - THE FILE IS BEING READ INVERSE TO ITS IX2074.2 +079900* CREATION. ON THE 50 TH AND 51 ST READ (RECORD NUMBERS 250 IX2074.2 +080000* AND 251) THESE RECORDS SHOULD CONTAIN ALTERNATE KEYS IX2074.2 +080100* WHICH ARE THE SAME. RECORDS WITH LIKE KEYS SHOULD BE MADE IX2074.2 +080200* AVAILABLE IN THE SEQUENCE IN WHICH THEY ARE CREATED, IX2074.2 +080300* THEREFORE RECORD NUMBER 250 SHOULD BE READ BEFORE RECORD IX2074.2 +080400* NUMBER 251. IX2074.2 +080500* IX2074.2 +080600* COMPUTE RESULTS IN INCREMENTS OF 1000 INDICATES THAT IX2074.2 +080700* AN INVALID KEY CONDITION OCCURRED ON THE START IX2074.2 +080800* STATEMENT - SEE PARAGRAPH READ-INIT-001-4. IX2074.2 +080900* IX2074.2 +081000* COMPUTED RESULTS IN INCREMENTS OF 10000 INDICATE THAT THE IX2074.2 +081100* AT END PATH ON THE READ WAS TAKEN. IX2074.2 +081200* IX2074.2 +081300* COMPUTED RESULTS IN INCREMENTS OF 00001 INDICATE THAT THE IX2074.2 +081400* RECORD MADE AVAILABLE AS A RESULT OF THE READ IX2074.2 +081500* WAS NOT THE ONE EXPECTED. IX2074.2 +081600* IX2074.2 +081700* IX2074.2 +081800 PERFORM PRINT-DETAIL. IX2074.2 +081900* IX2074.2 +082000* IX2074.2 +082100 READ-INIT-F1-04. IX2074.2 +082200 MOVE 20300 TO WRK-DS-05V00-006. IX2074.2 +082300 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +082400 MOVE 00001 TO WRK-DU-05V00-003. IX2074.2 +082500 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +082600 MOVE ZERO TO WRK-DS-04V00-002 IX2074.2 +082700 OPEN INPUT IX-FS1. IX2074.2 +082800 MOVE WRK-FS1-ALTKEY TO IX-FS1-ALTKEY1. IX2074.2 +082900 START IX-FS1 KEY IS EQUAL TO IX2074.2 +083000 IX-FS1-ALTKEY1 IX2074.2 +083100 INVALID KEY IX2074.2 +083200 ADD 01000 TO WRK-DS-05V00-006. IX2074.2 +083300 MOVE IX-FS1-FILESIZE TO WRK-DS-05V00-008. IX2074.2 +083400 MOVE "44" TO FS1-STATUS. IX2074.2 +083500* IX2074.2 +083600* WRK-DS-04V00-001 = A COUNTER WHICH IS INCREMENTED BY 1 EACH IX2074.2 +083700* TIME A FILE STATUS VALUE "00" (SUCCESS- IX2074.2 +083800* FUL READ) WAS ENCOUNTERED DURING THE READIX2074.2 +083900* OF THE FILE. IX2074.2 +084000* IX2074.2 +084100* WRK-DS-04V00-002 = A COUNTER WHICH IS INCREMENTED BY 1 IX2074.2 +084200* EACH TIME A FILE STATUS OF "02" (DUP- IX2074.2 +084300* LICATE KEY) IS ENCOUNTERED DURING A READ.IX2074.2 +084400* IX2074.2 +084500 READ-TEST-F1-04-R5. IX2074.2 +084600 READ IX-FS1 RECORD AT END IX2074.2 +084700 SUBTRACT 20000 FROM WRK-DS-05V00-006 IX2074.2 +084800 GO TO READ-TEST-F1-04. IX2074.2 +084900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2074.2 +085000 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +085100 IF FS1-STATUS EQUAL TO "00" IX2074.2 +085200 ADD 0001 TO WRK-DS-04V00-001. IX2074.2 +085300 IF FS1-STATUS EQUAL TO "02" IX2074.2 +085400 ADD 1 TO WRK-DS-04V00-002. IX2074.2 +085500 IF WRK-DS-05V00-005 GREATER THAN WRK-DS-05V00-008 IX2074.2 +085600 ADD 00001 TO WRK-DS-05V00-006 IX2074.2 +085700 ELSE IX2074.2 +085800 GO TO READ-TEST-F1-04-R5. IX2074.2 +085900 READ-TEST-F1-04. IX2074.2 +086000 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX2074.2 +086100 MOVE "FILE STATUS" TO FEATURE. IX2074.2 +086200 IF FS1-STATUS NOT EQUAL TO "10" IX2074.2 +086300 ADD 10000 TO WRK-DS-05V00-006. IX2074.2 +086400 SUBTRACT WRK-DS-04V00-001 FROM WRK-DS-05V00-006. IX2074.2 +086500 SUBTRACT WRK-DS-04V00-002 FROM WRK-DS-05V00-006. IX2074.2 +086600 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +086700 PERFORM FAIL IX2074.2 +086800 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +086900 MOVE ZERO TO CORRECT-N IX2074.2 +087000 MOVE "SEE PROGRAM" TO RE-MARK IX2074.2 +087100 ELSE IX2074.2 +087200 PERFORM PASS. IX2074.2 +087300* IX2074.2 +087400* COMPUTED RESULT INDICATED IX2074.2 +087500* INCREMENTS ACTION IX2074.2 +087600* IX2074.2 +087700* 10000 FILE STATUS NOT UPDATED ON EOF IX2074.2 +087800* 20000 AT END PATH OF READ NOT TAKEN IX2074.2 +087900* 01000 INVALID KEY ON START STATEMENT. IX2074.2 +088000* 00001 FILE STATUS DID NOT REFLECT IX2074.2 +088100* APPROPRIATE STATUS CONTENTS OF A IX2074.2 +088200* SUCCESSFUL READ IX2074.2 +088300* IX2074.2 +088400 PERFORM PRINT-DETAIL. IX2074.2 +088500 CLOSE IX-FS1. IX2074.2 +088600* IX2074.2 +088700* IX2074.2 +088800 SECTION-IX207A-0002 SECTION. IX2074.2 +088900 WRITE-INIT-GF-02. IX2074.2 +089000 OPEN OUTPUT IX-FS2. IX2074.2 +089100 MOVE "IX-FS2" TO XFILE-NAME (2). IX2074.2 +089200 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2074.2 +089300 MOVE ZERO TO XRECORD-NUMBER (2). IX2074.2 +089400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2074.2 +089500 MOVE 000240 TO XRECORD-LENGTH (2). IX2074.2 +089600 MOVE 0001 TO XBLOCK-SIZE (2). IX2074.2 +089700 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2074.2 +089800 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2074.2 +089900 MOVE "S" TO XLABEL-TYPE (2). IX2074.2 +090000 MOVE 000300 TO RECORDS-IN-FILE (2). IX2074.2 +090100 MOVE 000300 TO IX-FS2-FILESIZE. IX2074.2 +090200 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +090300 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +090400 MOVE ZERO TO WRK-DS-04V00-002. IX2074.2 +090500 MOVE 00001 TO WRK-DU-05V00-002. IX2074.2 +090600 MOVE IX-FS2-FILESIZE TO WRK-DU-05V00-004. IX2074.2 +090700 MOVE ZERO TO WRK-DS-05V00-006. IX2074.2 +090800 MOVE 00001 TO WRK-DS-05V00-007. IX2074.2 +090900* IX2074.2 +091000* WRK-DU-05V00-002 = NUMERIC FIELD EMBEDDED IN RECORD KEY IX2074.2 +091100* WHICH MAKES THE KEY UNIQUE. IX2074.2 +091200* IX2074.2 +091300* WRK-DU-05V00-004 = NUMERIC FIELD EMBEDDED IN ALTERNATE KEY IX2074.2 +091400* WHICH MAKES THE KEY UNIQUE. IX2074.2 +091500* IX2074.2 +091600* WRK-DS-05V00-005 = COUNTS THE NUMBER OF TIMES A READ/WRITE IX2074.2 +091700* WAS EXECUTED. IX2074.2 +091800* IX2074.2 +091900* WRK-DS-05V00-006 = ERROR COUNTER WHICH IS INCREMENTED EACH IX2074.2 +092000* TIME AN UNEXPECTED CONDITION OCCURS. IX2074.2 +092100* IX2074.2 +092200* IX2074.2 +092300* WRK-DS-05V00-007 = THIS COUNTERIS USED TO CREATE A DUPLICATEIX2074.2 +092400* ALTERNATE KEY - I.E., EVERY 50TH RECORD. IX2074.2 +092500* IX2074.2 +092600* WRK-DS-05V00-008 = COUNTER CONTAINING THE RECORD NUMBER IX2074.2 +092700* WHICH IS EXPECTED TO BE FOUND. IX2074.2 +092800* IX2074.2 +092900* WRK-DS-04V00-001 = THIS COUNTER IS INCREMENTED EACH TIME IX2074.2 +093000* AN INVALID KEY CONDITION OCCURS ON THE IX2074.2 +093100* WRITE. IX2074.2 +093200* IX2074.2 +093300 PERFORM BLANK-LINE-PRINT. IX2074.2 +093400 MOVE "SELECT ENTRY - ACCESS MODE NOT PRESENT - ACCESS IX2074.2 +093500- "MODE SEQUENTIAL IS ASSUMED" TO PRINT-REC. IX2074.2 +093600 PERFORM WRITE-LINE. IX2074.2 +093700 PERFORM BLANK-LINE-PRINT. IX2074.2 +093800 WRITE-TEST-GF-02-R1. IX2074.2 +093900 ADD 000001 TO XRECORD-NUMBER (2). IX2074.2 +094000 MOVE WRK-FS2-RECKEY TO XRECORD-KEY (2). IX2074.2 +094100 MOVE WRK-FS2-ALTKEY TO ALTERNATE-KEY1 (2). IX2074.2 +094200 WRITE IX-FS2R1-F-G-240 FROM FILE-RECORD-INFO (2) IX2074.2 +094300 INVALID KEY IX2074.2 +094400 ADD 0001 TO WRK-DS-04V00-001. IX2074.2 +094500 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +094600* INCREMENT RECORD KEY VALUE. IX2074.2 +094700 ADD 00001 TO WRK-DS-05V00-007. IX2074.2 +094800 IF WRK-DS-05V00-007 GREATER THAN 50 IX2074.2 +094900 MOVE 00001 TO WRK-DS-05V00-007 IX2074.2 +095000 ELSE IX2074.2 +095100 SUBTRACT WRK-DU-05V00-002 FROM IX-FS2-FILESIZE IX2074.2 +095200 GIVING WRK-DU-05V00-004. IX2074.2 +095300* IX2074.2 +095400* EVERY 50TH AND 51ST ALTERNATE KEY VALUE WILL BE EQUAL. IX2074.2 +095500* IX2074.2 +095600 ADD 00001 TO WRK-DU-05V00-002. IX2074.2 +095700 IF WRK-DS-05V00-005 LESS THAN IX-FS2-FILESIZE IX2074.2 +095800 GO TO WRITE-TEST-GF-02-R1. IX2074.2 +095900 WRITE-TEST-GF-02. IX2074.2 +096000 MOVE "WRITE IX-FS2 " TO FEATURE. IX2074.2 +096100 MOVE "WRITE-TEST-GF-02 " TO PAR-NAME. IX2074.2 +096200 CLOSE IX-FS2. IX2074.2 +096300 ADD WRK-DS-04V00-001 WRK-DS-05V00-005 IX2074.2 +096400 GIVING WRK-DS-05V00-006. IX2074.2 +096500 IF WRK-DS-05V00-006 NOT EQUAL TO 00300 IX2074.2 +096600 PERFORM FAIL IX2074.2 +096700 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +096800 MOVE 300 TO CORRECT-N IX2074.2 +096900 ELSE IX2074.2 +097000 PERFORM PASS. IX2074.2 +097100 PERFORM PRINT-DETAIL. IX2074.2 +097200* IX2074.2 +097300* IX2074.2 +097400 READ-INIT-F1-04. IX2074.2 +097500 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +097600 MOVE ZERO TO WRK-DS-04V00-002. IX2074.2 +097700 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +097800 MOVE 00120 TO WRK-DS-05V00-006. IX2074.2 +097900 MOVE ZERO TO WRK-DS-05V00-007. IX2074.2 +098000 MOVE 300 TO WRK-DS-05V00-008. IX2074.2 +098100 MOVE 0001 TO WRK-DU-05V00-004. IX2074.2 +098200 OPEN INPUT IX-FS2. IX2074.2 +098300 MOVE WRK-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2074.2 +098400 START IX-FS2 KEY IS EQUAL TO IX2074.2 +098500 IX-FS2-ALTKEY1 IX2074.2 +098600 INVALID KEY IX2074.2 +098700 ADD 01000 TO WRK-DS-05V00-006. IX2074.2 +098800 READ-TEST-F1-04-R2. IX2074.2 +098900 READ IX-FS2 RECORD AT END IX2074.2 +099000 ADD 10000 TO WRK-DS-05V00-006 IX2074.2 +099100 GO TO READ-TEST-F1-04-R3. IX2074.2 +099200 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2074.2 +099300 ADD 00001 TO WRK-DS-05V00-005. IX2074.2 +099400 IF WRK-DS-05V00-005 EQUAL TO 50 AND IX2074.2 +099500 XRECORD-NUMBER (2) EQUAL TO 250 IX2074.2 +099600 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +099700 IF WRK-DS-05V00-005 EQUAL TO 51 AND IX2074.2 +099800 XRECORD-NUMBER (2) EQUAL TO 251 IX2074.2 +099900 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +100000 IF WRK-DS-05V00-005 EQUAL TO 100 AND IX2074.2 +100100 XRECORD-NUMBER (2) EQUAL TO 200 IX2074.2 +100200 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +100300 IF WRK-DS-05V00-005 EQUAL TO 101 AND IX2074.2 +100400 XRECORD-NUMBER (2) EQUAL TO 201 IX2074.2 +100500 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +100600* IX2074.2 +100700* THE PRECEEDING 4 IF STATEMENTS CHECK THOSE RECORDS WHICH HAVEIX2074.2 +100800* LIKE ALTERNATE RECORD KEYS (DUPLICATE KEYS). THE FILE WAS IX2074.2 +100900* CREATED SEQUENTIALLY BY RECORD KEY VALUE HOWEVER THE IX2074.2 +101000* ALTERNATE RECORD KEY SEQUENCE IS INVERSE TO THE FILE IX2074.2 +101100* CREATION SEQUENCE WITH DUPLICATE ALTERNATE KEYS ESTABLISHED IX2074.2 +101200* IN RECORD KEY SEQUENCE. THE TEST EXPECTS THE RECORDS WHICH IX2074.2 +101300* HAVE LIKE KEYS TO BE PROVIDED IN THE ORDER IN WHICH THEY WEREIX2074.2 +101400* WRITTEN WHEN THE FILE IS SEQUENTIALLY READ BY THE ALTERNATE IX2074.2 +101500* RECORD KEY . IX2074.2 +101600* IX2074.2 +101700 IF WRK-DS-05V00-008 EQUAL TO XRECORD-NUMBER (2) IX2074.2 +101800 SUBTRACT 00001 FROM WRK-DS-05V00-006. IX2074.2 +101900 SUBTRACT 00001 FROM WRK-DS-05V00-008. IX2074.2 +102000 IF WRK-DS-05V00-005 LESS THAN 120 IX2074.2 +102100 GO TO READ-TEST-F1-04-R2. IX2074.2 +102200 READ-TEST-F1-04-R3. IX2074.2 +102300 MOVE "READ ALTERNATE KEY " TO FEATURE. IX2074.2 +102400 MOVE "READ-TEST-F1-04-R3. " TO PAR-NAME. IX2074.2 +102500 CLOSE IX-FS2. IX2074.2 +102600 IF WRK-DS-05V00-006 NOT EQUAL TO ZERO IX2074.2 +102700 PERFORM FAIL IX2074.2 +102800 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +102900 MOVE ZERO TO CORRECT-N IX2074.2 +103000 MOVE "SEE PROGRAM" TO RE-MARK IX2074.2 +103100 ELSE IX2074.2 +103200 PERFORM PASS. IX2074.2 +103300* IX2074.2 +103400* COMPUTED RESULTS IN INCREMENTS OF 1000 INDICATES AN INVALID KEYIX2074.2 +103500* CONDITION OCCURRED ON THE START STATEMENT - SEE IX2074.2 +103600* PARAGRAPH READ-INIT-F1-04-2; INCREMENTS OF 10000 IX2074.2 +103700* INDICATES THAT AN UNEXPECTED AT END PATH ON THE IX2074.2 +103800* READ WAS TAKEN; INCREMENTS OF 00001 INDICATES THAT IX2074.2 +103900* THE RECORD RETRIEVED WAS NOT THE ONE EXPECTED. IX2074.2 +104000* IX2074.2 +104100 PERFORM PRINT-DETAIL. IX2074.2 +104200* IX2074.2 +104300* IX2074.2 +104400 READ-INIT-F1-05. IX2074.2 +104500 MOVE 00301 TO WRK-DS-05V00-006. IX2074.2 +104600 MOVE ZERO TO WRK-DS-05V00-005. IX2074.2 +104700 MOVE ZERO TO WRK-DS-05V00-007. IX2074.2 +104800 MOVE ZERO TO WRK-DS-05V00-008. IX2074.2 +104900 MOVE ZERO TO WRK-DS-04V00-001. IX2074.2 +105000 MOVE ZERO TO WRK-DS-04V00-002. IX2074.2 +105100 OPEN INPUT IX-FS1. IX2074.2 +105200 OPEN INPUT IX-FS2. IX2074.2 +105300 READ-TEST-F1-05-R3. IX2074.2 +105400 READ IX-FS1. IX2074.2 +105500 READ IX-FS2. IX2074.2 +105600 ADD 0001 TO WRK-DS-05V00-005. IX2074.2 +105700 IF WRK-DS-05V00-005 LESS THAN 301 IX2074.2 +105800 GO TO READ-TEST-F1-05-R3. IX2074.2 +105900 READ-TEST-F1-05. IX2074.2 +106000 MOVE "USE " TO FEATURE. IX2074.2 +106100 MOVE "READ-TEST-F1-05 " TO PAR-NAME. IX2074.2 +106200 CLOSE IX-FS1. IX2074.2 +106300 SUBTRACT WRK-DS-05V00-005 FROM WRK-DS-05V00-006. IX2074.2 +106400 IF WRK-DS-05V00-006 NOT EQUAL TO 00002 IX2074.2 +106500 PERFORM FAIL IX2074.2 +106600 MOVE WRK-DS-05V00-006 TO COMPUTED-N IX2074.2 +106700 MOVE 00002 TO CORRECT-N IX2074.2 +106800 ELSE IX2074.2 +106900 PERFORM PASS. IX2074.2 +107000* IX2074.2 +107100* USE PROCEDURE SHOULD BE EXECUTED ONCE FOR EACH FILE. IX2074.2 +107200* IX2074.2 +107300 PERFORM PRINT-DETAIL. IX2074.2 +107400* IX2074.2 +107500* IX2074.2 +107600 CLOSE IX-FS2. IX2074.2 +107700 IX2074.2 +107800 IX2074.2 +107900 CCVS-EXIT SECTION. IX2074.2 +108000 CCVS-999999. IX2074.2 +108100 GO TO CLOSE-FILES. IX2074.2 diff --git a/tests/cobol85/IX/IX208A.CBL b/tests/cobol85/IX/IX208A.CBL new file mode 100755 index 00000000..f5414660 --- /dev/null +++ b/tests/cobol85/IX/IX208A.CBL @@ -0,0 +1,1525 @@ +000100 IDENTIFICATION DIVISION. IX2084.2 +000200 PROGRAM-ID. IX2084.2 +000300 IX208A. IX2084.2 +000400**************************************************************** IX2084.2 +000500* * IX2084.2 +000600* VALIDATION FOR:- * IX2084.2 +000700* * IX2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2084.2 +000900* * IX2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2084.2 +001100* * IX2084.2 +001200**************************************************************** IX2084.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLE SYN- IX2084.2 +001400* TACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH LEVEL 2IX2084.2 +001500* OF THE INDEXED I-O MODULE. THE ELEMENTS TESTED IN THIS IX2084.2 +001600* ROUTINE ARE: IX2084.2 +001700* IX2084.2 +001800* (1) READ STATEMENT; IX2084.2 +001900* (2) START STATEMENT; IX2084.2 +002000* (3) USE STATEMENT. IX2084.2 +002100* IX2084.2 +002200* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS IX2084.2 +002300* ROUTINE. IX2084.2 +002400* IX2084.2 +002500* IX2084.2 +002600* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2084.2 +002700* IX2084.2 +002800* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2084.2 +002900* CLAUSE FOR DATA FILE IX-FS1 IX2084.2 +003000* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2084.2 +003100* CLAUSE FOR DATA FILE IX-FD2 IX2084.2 +003200* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2084.2 +003300* CLAUSE FOR INDEX FILE IX-FS1 IX2084.2 +003400* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2084.2 +003500* CLAUSE FOR INDEX FILE IX-FD2 IX2084.2 +003600* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2084.2 +003700* X-69 ADDITIONAL VALUE OF PHRASES IX2084.2 +003800* X-74 VALUE OF IMPLEMENTOR-NAME IX2084.2 +003900* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE IX-FS1 IX2084.2 +004000* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE IX-FD2 IX2084.2 +004100* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2084.2 +004200* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2084.2 +004300* IX2084.2 +004400* NOTE: X-CARDS 44,45,69,74,75 AND 76 ARE OPTIONAL IX2084.2 +004500* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2084.2 +004600* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2084.2 +004700* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2084.2 +004800* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2084.2 +004900* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2084.2 +005000* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2084.2 +005100* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2084.2 +005200* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2084.2 +005300* THEY ARE AS FOLLOWS IX2084.2 +005400* IX2084.2 +005500* C SELECTS X-CARDS 74,75 AND 76 IX2084.2 +005600* G SELECTS X-CARDS 69 IX2084.2 +005700* J SELECTS X-CARDS 44 AND 45 IX2084.2 +005800* IX2084.2 +005900* NOTE: THERE IS OPTIONAL SOURCE CODE IN THIS PROGRAM IX2084.2 +006000* FOR THE CONVENIENCE OF THE USER. THIS OPTIONAL IX2084.2 +006100* CODE IS IDENTIFIED BY THE LETTER T,U OR X IN IX2084.2 +006200* POSITION 7 OF THE SOURCE LINE. USE OF IX2084.2 +006300* SOURCE CODE WITH LETTER X WILL PRINT THE CONTENTS IX2084.2 +006400* OF THE FILES AFTER THE TEST REPORT. FOR CODE IX2084.2 +006500* WITH LETTERS T OR U ONLY ONE SHOULD BE SELECTED. IX2084.2 +006600* EITHER THE T"S OR THE U"S SHOULD BE USED EXCLU- IX2084.2 +006700* SIVELY, NOT BOTH. THE T"S PROVIDE A 29 CHARACTER IX2084.2 +006800* INDEXED KEY SIZE FOR THE FILE AND THE U"S PROVIDE IX2084.2 +006900* AN INDEXED KEY NO GREATER THAN 8 CHARACTERS. IX2084.2 +007000* IF THE VP-ROUTINE IS USED THE APPROPRIATE IX2084.2 +007100* SOURCE CODE MAY BE SELECTED BY SPECIFYING THE IX2084.2 +007200* RESPECTIVE LETTER IN THE "*OPT" VP-ROUTINE CONTROLIX2084.2 +007300* CARD. IX2084.2 +007400* IX2084.2 +007500****************************************************** IX2084.2 +007600 ENVIRONMENT DIVISION. IX2084.2 +007700 CONFIGURATION SECTION. IX2084.2 +007800 SOURCE-COMPUTER. IX2084.2 +007900 Linux. IX2084.2 +008000 OBJECT-COMPUTER. IX2084.2 +008100 Linux. IX2084.2 +008200 INPUT-OUTPUT SECTION. IX2084.2 +008300 FILE-CONTROL. IX2084.2 +008400*P SELECT RAW-DATA ASSIGN TO IX2084.2 +008500*P "XXXXX062" IX2084.2 +008600*P ORGANIZATION IS INDEXED IX2084.2 +008700*P ACCESS MODE IS RANDOM IX2084.2 +008800*P RECORD KEY IS RAW-DATA-KEY. IX2084.2 +008900 SELECT PRINT-FILE ASSIGN TO IX2084.2 +009000 "report.log". IX2084.2 +009100 SELECT IX-FD1 IX2084.2 +009200 ASSIGN TO IX2084.2 +009300 "XXXXX024" IX2084.2 +009400*J **** X-CARD UNDEFINED **** IX2084.2 +009500 ORGANIZATION IS INDEXED IX2084.2 +009600 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY1 IX2084.2 +009700 RECORD KEY IS IX-FD1-KEY IX2084.2 +009800 ACCESS MODE IS DYNAMIC. IX2084.2 +009900 SELECT IX-FS2 IX2084.2 +010000 ASSIGN TO IX2084.2 +010100 "XXXXX025" IX2084.2 +010200*J **** X-CARD UNDEFINED **** IX2084.2 +010300 RECORD KEY IS IX-FS2-KEY IX2084.2 +010400 ALTERNATE RECORD KEY IS IX-FS2-ALTKEY1 IX2084.2 +010500 ACCESS MODE IS SEQUENTIAL IX2084.2 +010600 ORGANIZATION IS INDEXED. IX2084.2 +010700 DATA DIVISION. IX2084.2 +010800 FILE SECTION. IX2084.2 +010900*P IX2084.2 +011000*PD RAW-DATA. IX2084.2 +011100*P IX2084.2 +011200*P1 RAW-DATA-SATZ. IX2084.2 +011300*P 05 RAW-DATA-KEY PIC X(6). IX2084.2 +011400*P 05 C-DATE PIC 9(6). IX2084.2 +011500*P 05 C-TIME PIC 9(8). IX2084.2 +011600*P 05 C-NO-OF-TESTS PIC 99. IX2084.2 +011700*P 05 C-OK PIC 999. IX2084.2 +011800*P 05 C-ALL PIC 999. IX2084.2 +011900*P 05 C-FAIL PIC 999. IX2084.2 +012000*P 05 C-DELETED PIC 999. IX2084.2 +012100*P 05 C-INSPECT PIC 999. IX2084.2 +012200*P 05 C-NOTE PIC X(13). IX2084.2 +012300*P 05 C-INDENT PIC X. IX2084.2 +012400*P 05 C-ABORT PIC X(8). IX2084.2 +012500 FD PRINT-FILE. IX2084.2 +012600 01 PRINT-REC PICTURE X(120). IX2084.2 +012700 01 DUMMY-RECORD PICTURE X(120). IX2084.2 +012800 FD IX-FD1 IX2084.2 +012900*C LABEL RECORD IS STANDARD IX2084.2 +013000*C DATA RECORD IS IX-FD1R1-F-G-240 IX2084.2 +013100 RECORD CONTAINS 240 CHARACTERS. IX2084.2 +013200 01 IX-FD1R1-F-G-240. IX2084.2 +013300 05 IX-FD1-REC-001-120 PICTURE X(120). IX2084.2 +013400 05 IX-FD1-REC-121-240. IX2084.2 +013500 10 FILLER PICTURE X(8). IX2084.2 +013600 10 IX-FD1-KEY. IX2084.2 +013700 15 IX-FS1-KEYNUM PICTURE 9(5). IX2084.2 +013800 15 FILLER PICTURE 9(5). IX2084.2 +013900*U 10 FILLER PICTURE X(5). IX2084.2 +014000 10 FILLER PICTURE X(19). IX2084.2 +014100 10 FILLER PICTURE X(9). IX2084.2 +014200 10 IX-FD1-ALTKEY1. IX2084.2 +014300 15 FILLER PICTURE 9(5). IX2084.2 +014400 15 IX-FD1-ALTKEY1NUM PICTURE 9(5). IX2084.2 +014500*U 10 FILLER PICTURE 9(5). IX2084.2 +014600 10 FILLER PICTURE X(19). IX2084.2 +014700 10 FILLER PICTURE X(45). IX2084.2 +014800 FD IX-FS2 IX2084.2 +014900*C LABEL RECORDS ARE STANDARD IX2084.2 +015000*C DATA RECORD IS IX-FS2R1-F-G-240 IX2084.2 +015100 . IX2084.2 +015200 01 IX-FS2R1-F-G-240. IX2084.2 +015300 05 IX-FS2-REC-001-120 PICTURE X(120). IX2084.2 +015400 05 IX-FS2-REC-121-240. IX2084.2 +015500 10 FILLER PICTURE X(8). IX2084.2 +015600 10 IX-FS2-KEY. IX2084.2 +015700 15 IX-FS2-KEYNUM PICTURE 9(5). IX2084.2 +015800 15 FILLER PICTURE 9(5). IX2084.2 +015900*U 10 FILLER PICTURE 9(5). IX2084.2 +016000 10 FILLER PICTURE X(19). IX2084.2 +016100 10 FILLER PICTURE X(9). IX2084.2 +016200 10 IX-FS2-ALTKEY1. IX2084.2 +016300 15 FILLER PICTURE 9(5). IX2084.2 +016400 15 IX-FS2-ALTKEY1NUM PICTURE 9(5). IX2084.2 +016500*U 10 FILLER PICTURE 9(5). IX2084.2 +016600 10 FILLER PICTURE X(19). IX2084.2 +016700 10 FILLER PICTURE X(45). IX2084.2 +016800 WORKING-STORAGE SECTION. IX2084.2 +016900 01 IX-FD1-FILESIZE PICTURE 9(6) VALUE 300. IX2084.2 +017000 01 IX-FS2-FILESIZE PICTURE 9(6) VALUE 300. IX2084.2 +017100 01 WRK-IX-FD1-RECKEY. IX2084.2 +017200 03 WRK-DU-05V00-001 PICTURE 9(5) VALUE ZERO. IX2084.2 +017300 03 FILLER PICTURE 9(5) VALUE ZERO. IX2084.2 +017400 01 WRK-IX-FS2-RECKEY. IX2084.2 +017500 03 WRK-DU-05V00-003 PICTURE 9(5) VALUE ZERO. IX2084.2 +017600 03 FILLER PICTURE 9(5) VALUE ZERO. IX2084.2 +017700 01 WRK-IX-FD1-ALTKEY. IX2084.2 +017800 03 FILLER PICTURE 9(5) VALUE ZERO. IX2084.2 +017900 03 WRK-DU-05V00-002 PICTURE 9(5) VALUE ZERO. IX2084.2 +018000 01 WRK-IX-FS2-ALTKEY. IX2084.2 +018100 03 FILLER PICTURE 9(5) VALUE ZERO. IX2084.2 +018200 03 WRK-DU-05V00-004 PICTURE 9(5) VALUE ZERO. IX2084.2 +018300 01 EXCUT-COUNTER-06V00 PICTURE S9(6) VALUE ZERO. IX2084.2 +018400 01 INV-KEY-COUNTER PICTURE S9(6) VALUE ZERO. IX2084.2 +018500 01 LOGICAL-FILE-REC PICTURE S9(6) VALUE ZERO. IX2084.2 +018600 01 ERROR-COUNTER-06V00 PICTURE S9(6) VALUE ZERO. IX2084.2 +018700 01 ASCEND-DESEND-SWITCH PICTURE XX VALUE "UP". IX2084.2 +018800 88 ASCEND VALUE "UP". IX2084.2 +018900 88 DSCEND VALUE "DN". IX2084.2 +019000 01 FILE-RECORD-INFORMATION-REC. IX2084.2 +019100 03 FILE-RECORD-INFO-SKELETON. IX2084.2 +019200 05 FILLER PICTURE X(48) VALUE IX2084.2 +019300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2084.2 +019400 05 FILLER PICTURE X(46) VALUE IX2084.2 +019500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2084.2 +019600 05 FILLER PICTURE X(26) VALUE IX2084.2 +019700 ",LFIL=000000,ORG= ,LBLR= ". IX2084.2 +019800 05 FILLER PICTURE X(37) VALUE IX2084.2 +019900 ",RECKEY= ". IX2084.2 +020000 05 FILLER PICTURE X(38) VALUE IX2084.2 +020100 ",ALTKEY1= ". IX2084.2 +020200 05 FILLER PICTURE X(38) VALUE IX2084.2 +020300 ",ALTKEY2= ". IX2084.2 +020400 05 FILLER PICTURE X(7) VALUE SPACE.IX2084.2 +020500 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2084.2 +020600 05 FILE-RECORD-INFO-P1-120. IX2084.2 +020700 07 FILLER PIC X(5). IX2084.2 +020800 07 XFILE-NAME PIC X(6). IX2084.2 +020900 07 FILLER PIC X(8). IX2084.2 +021000 07 XRECORD-NAME PIC X(6). IX2084.2 +021100 07 FILLER PIC X(1). IX2084.2 +021200 07 REELUNIT-NUMBER PIC 9(1). IX2084.2 +021300 07 FILLER PIC X(7). IX2084.2 +021400 07 XRECORD-NUMBER PIC 9(6). IX2084.2 +021500 07 FILLER PIC X(6). IX2084.2 +021600 07 UPDATE-NUMBER PIC 9(2). IX2084.2 +021700 07 FILLER PIC X(5). IX2084.2 +021800 07 ODO-NUMBER PIC 9(4). IX2084.2 +021900 07 FILLER PIC X(5). IX2084.2 +022000 07 XPROGRAM-NAME PIC X(5). IX2084.2 +022100 07 FILLER PIC X(7). IX2084.2 +022200 07 XRECORD-LENGTH PIC 9(6). IX2084.2 +022300 07 FILLER PIC X(7). IX2084.2 +022400 07 CHARS-OR-RECORDS PIC X(2). IX2084.2 +022500 07 FILLER PIC X(1). IX2084.2 +022600 07 XBLOCK-SIZE PIC 9(4). IX2084.2 +022700 07 FILLER PIC X(6). IX2084.2 +022800 07 RECORDS-IN-FILE PIC 9(6). IX2084.2 +022900 07 FILLER PIC X(5). IX2084.2 +023000 07 XFILE-ORGANIZATION PIC X(2). IX2084.2 +023100 07 FILLER PIC X(6). IX2084.2 +023200 07 XLABEL-TYPE PIC X(1). IX2084.2 +023300 05 FILE-RECORD-INFO-P121-240. IX2084.2 +023400 07 FILLER PIC X(8). IX2084.2 +023500 07 XRECORD-KEY PIC X(29). IX2084.2 +023600 07 FILLER PIC X(9). IX2084.2 +023700 07 ALTERNATE-KEY1 PIC X(29). IX2084.2 +023800 07 FILLER PIC X(9). IX2084.2 +023900 07 ALTERNATE-KEY2 PIC X(29). IX2084.2 +024000 07 FILLER PIC X(7). IX2084.2 +024100 01 TEST-RESULTS. IX2084.2 +024200 02 FILLER PIC X VALUE SPACE. IX2084.2 +024300 02 FEATURE PIC X(20) VALUE SPACE. IX2084.2 +024400 02 FILLER PIC X VALUE SPACE. IX2084.2 +024500 02 P-OR-F PIC X(5) VALUE SPACE. IX2084.2 +024600 02 FILLER PIC X VALUE SPACE. IX2084.2 +024700 02 PAR-NAME. IX2084.2 +024800 03 FILLER PIC X(19) VALUE SPACE. IX2084.2 +024900 03 PARDOT-X PIC X VALUE SPACE. IX2084.2 +025000 03 DOTVALUE PIC 99 VALUE ZERO. IX2084.2 +025100 02 FILLER PIC X(8) VALUE SPACE. IX2084.2 +025200 02 RE-MARK PIC X(61). IX2084.2 +025300 01 TEST-COMPUTED. IX2084.2 +025400 02 FILLER PIC X(30) VALUE SPACE. IX2084.2 +025500 02 FILLER PIC X(17) VALUE IX2084.2 +025600 " COMPUTED=". IX2084.2 +025700 02 COMPUTED-X. IX2084.2 +025800 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2084.2 +025900 03 COMPUTED-N REDEFINES COMPUTED-A IX2084.2 +026000 PIC -9(9).9(9). IX2084.2 +026100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2084.2 +026200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2084.2 +026300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2084.2 +026400 03 CM-18V0 REDEFINES COMPUTED-A. IX2084.2 +026500 04 COMPUTED-18V0 PIC -9(18). IX2084.2 +026600 04 FILLER PIC X. IX2084.2 +026700 03 FILLER PIC X(50) VALUE SPACE. IX2084.2 +026800 01 TEST-CORRECT. IX2084.2 +026900 02 FILLER PIC X(30) VALUE SPACE. IX2084.2 +027000 02 FILLER PIC X(17) VALUE " CORRECT =". IX2084.2 +027100 02 CORRECT-X. IX2084.2 +027200 03 CORRECT-A PIC X(20) VALUE SPACE. IX2084.2 +027300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2084.2 +027400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2084.2 +027500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2084.2 +027600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2084.2 +027700 03 CR-18V0 REDEFINES CORRECT-A. IX2084.2 +027800 04 CORRECT-18V0 PIC -9(18). IX2084.2 +027900 04 FILLER PIC X. IX2084.2 +028000 03 FILLER PIC X(2) VALUE SPACE. IX2084.2 +028100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2084.2 +028200 01 CCVS-C-1. IX2084.2 +028300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2084.2 +028400- "SS PARAGRAPH-NAME IX2084.2 +028500- " REMARKS". IX2084.2 +028600 02 FILLER PIC X(20) VALUE SPACE. IX2084.2 +028700 01 CCVS-C-2. IX2084.2 +028800 02 FILLER PIC X VALUE SPACE. IX2084.2 +028900 02 FILLER PIC X(6) VALUE "TESTED". IX2084.2 +029000 02 FILLER PIC X(15) VALUE SPACE. IX2084.2 +029100 02 FILLER PIC X(4) VALUE "FAIL". IX2084.2 +029200 02 FILLER PIC X(94) VALUE SPACE. IX2084.2 +029300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2084.2 +029400 01 REC-CT PIC 99 VALUE ZERO. IX2084.2 +029500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2084.2 +029600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2084.2 +029700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2084.2 +029800 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2084.2 +029900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2084.2 +030000 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2084.2 +030100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2084.2 +030200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2084.2 +030300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2084.2 +030400 01 CCVS-H-1. IX2084.2 +030500 02 FILLER PIC X(39) VALUE SPACES. IX2084.2 +030600 02 FILLER PIC X(42) VALUE IX2084.2 +030700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2084.2 +030800 02 FILLER PIC X(39) VALUE SPACES. IX2084.2 +030900 01 CCVS-H-2A. IX2084.2 +031000 02 FILLER PIC X(40) VALUE SPACE. IX2084.2 +031100 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2084.2 +031200 02 FILLER PIC XXXX VALUE IX2084.2 +031300 "4.2 ". IX2084.2 +031400 02 FILLER PIC X(28) VALUE IX2084.2 +031500 " COPY - NOT FOR DISTRIBUTION". IX2084.2 +031600 02 FILLER PIC X(41) VALUE SPACE. IX2084.2 +031700 IX2084.2 +031800 01 CCVS-H-2B. IX2084.2 +031900 02 FILLER PIC X(15) VALUE IX2084.2 +032000 "TEST RESULT OF ". IX2084.2 +032100 02 TEST-ID PIC X(9). IX2084.2 +032200 02 FILLER PIC X(4) VALUE IX2084.2 +032300 " IN ". IX2084.2 +032400 02 FILLER PIC X(12) VALUE IX2084.2 +032500 " HIGH ". IX2084.2 +032600 02 FILLER PIC X(22) VALUE IX2084.2 +032700 " LEVEL VALIDATION FOR ". IX2084.2 +032800 02 FILLER PIC X(58) VALUE IX2084.2 +032900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2084.2 +033000 01 CCVS-H-3. IX2084.2 +033100 02 FILLER PIC X(34) VALUE IX2084.2 +033200 " FOR OFFICIAL USE ONLY ". IX2084.2 +033300 02 FILLER PIC X(58) VALUE IX2084.2 +033400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2084.2 +033500 02 FILLER PIC X(28) VALUE IX2084.2 +033600 " COPYRIGHT 1985 ". IX2084.2 +033700 01 CCVS-E-1. IX2084.2 +033800 02 FILLER PIC X(52) VALUE SPACE. IX2084.2 +033900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2084.2 +034000 02 ID-AGAIN PIC X(9). IX2084.2 +034100 02 FILLER PIC X(45) VALUE SPACES. IX2084.2 +034200 01 CCVS-E-2. IX2084.2 +034300 02 FILLER PIC X(31) VALUE SPACE. IX2084.2 +034400 02 FILLER PIC X(21) VALUE SPACE. IX2084.2 +034500 02 CCVS-E-2-2. IX2084.2 +034600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2084.2 +034700 03 FILLER PIC X VALUE SPACE. IX2084.2 +034800 03 ENDER-DESC PIC X(44) VALUE IX2084.2 +034900 "ERRORS ENCOUNTERED". IX2084.2 +035000 01 CCVS-E-3. IX2084.2 +035100 02 FILLER PIC X(22) VALUE IX2084.2 +035200 " FOR OFFICIAL USE ONLY". IX2084.2 +035300 02 FILLER PIC X(12) VALUE SPACE. IX2084.2 +035400 02 FILLER PIC X(58) VALUE IX2084.2 +035500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2084.2 +035600 02 FILLER PIC X(13) VALUE SPACE. IX2084.2 +035700 02 FILLER PIC X(15) VALUE IX2084.2 +035800 " COPYRIGHT 1985". IX2084.2 +035900 01 CCVS-E-4. IX2084.2 +036000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2084.2 +036100 02 FILLER PIC X(4) VALUE " OF ". IX2084.2 +036200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2084.2 +036300 02 FILLER PIC X(40) VALUE IX2084.2 +036400 " TESTS WERE EXECUTED SUCCESSFULLY". IX2084.2 +036500 01 XXINFO. IX2084.2 +036600 02 FILLER PIC X(19) VALUE IX2084.2 +036700 "*** INFORMATION ***". IX2084.2 +036800 02 INFO-TEXT. IX2084.2 +036900 04 FILLER PIC X(8) VALUE SPACE. IX2084.2 +037000 04 XXCOMPUTED PIC X(20). IX2084.2 +037100 04 FILLER PIC X(5) VALUE SPACE. IX2084.2 +037200 04 XXCORRECT PIC X(20). IX2084.2 +037300 02 INF-ANSI-REFERENCE PIC X(48). IX2084.2 +037400 01 HYPHEN-LINE. IX2084.2 +037500 02 FILLER PIC IS X VALUE IS SPACE. IX2084.2 +037600 02 FILLER PIC IS X(65) VALUE IS "************************IX2084.2 +037700- "*****************************************". IX2084.2 +037800 02 FILLER PIC IS X(54) VALUE IS "************************IX2084.2 +037900- "******************************". IX2084.2 +038000 01 CCVS-PGM-ID PIC X(9) VALUE IX2084.2 +038100 "IX208A". IX2084.2 +038200 PROCEDURE DIVISION. IX2084.2 +038300 DECLARATIVES. IX2084.2 +038400 USE-IX208A-TEST SECTION. IX2084.2 +038500 USE AFTER ERROR PROCEDURE IX-FD1 IX-FS2. IX2084.2 +038600 USE-PAR-001. IX2084.2 +038700 ADD 010000 TO ERROR-COUNTER-06V00. IX2084.2 +038800 USE-PAR-EXIT. IX2084.2 +038900 EXIT. IX2084.2 +039000 END DECLARATIVES. IX2084.2 +039100 CCVS1 SECTION. IX2084.2 +039200 OPEN-FILES. IX2084.2 +039300*P OPEN I-O RAW-DATA. IX2084.2 +039400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2084.2 +039500*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2084.2 +039600*P MOVE "ABORTED " TO C-ABORT. IX2084.2 +039700*P ADD 1 TO C-NO-OF-TESTS. IX2084.2 +039800*P ACCEPT C-DATE FROM DATE. IX2084.2 +039900*P ACCEPT C-TIME FROM TIME. IX2084.2 +040000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2084.2 +040100*PND-E-1. IX2084.2 +040200*P CLOSE RAW-DATA. IX2084.2 +040300 OPEN OUTPUT PRINT-FILE. IX2084.2 +040400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2084.2 +040500 MOVE SPACE TO TEST-RESULTS. IX2084.2 +040600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2084.2 +040700 MOVE ZERO TO REC-SKL-SUB. IX2084.2 +040800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2084.2 +040900 CCVS-INIT-FILE. IX2084.2 +041000 ADD 1 TO REC-SKL-SUB. IX2084.2 +041100 MOVE FILE-RECORD-INFO-SKELETON IX2084.2 +041200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2084.2 +041300 CCVS-INIT-EXIT. IX2084.2 +041400 GO TO CCVS1-EXIT. IX2084.2 +041500 CLOSE-FILES. IX2084.2 +041600*P OPEN I-O RAW-DATA. IX2084.2 +041700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2084.2 +041800*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2084.2 +041900*P MOVE "OK. " TO C-ABORT. IX2084.2 +042000*P MOVE PASS-COUNTER TO C-OK. IX2084.2 +042100*P MOVE ERROR-HOLD TO C-ALL. IX2084.2 +042200*P MOVE ERROR-COUNTER TO C-FAIL. IX2084.2 +042300*P MOVE DELETE-COUNTER TO C-DELETED. IX2084.2 +042400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2084.2 +042500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2084.2 +042600*PND-E-2. IX2084.2 +042700*P CLOSE RAW-DATA. IX2084.2 +042800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2084.2 +042900 TERMINATE-CCVS. IX2084.2 +043000*S EXIT PROGRAM. IX2084.2 +043100*SERMINATE-CALL. IX2084.2 +043200 STOP RUN. IX2084.2 +043300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2084.2 +043400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2084.2 +043500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2084.2 +043600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2084.2 +043700 MOVE "****TEST DELETED****" TO RE-MARK. IX2084.2 +043800 PRINT-DETAIL. IX2084.2 +043900 IF REC-CT NOT EQUAL TO ZERO IX2084.2 +044000 MOVE "." TO PARDOT-X IX2084.2 +044100 MOVE REC-CT TO DOTVALUE. IX2084.2 +044200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2084.2 +044300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2084.2 +044400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2084.2 +044500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2084.2 +044600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2084.2 +044700 MOVE SPACE TO CORRECT-X. IX2084.2 +044800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2084.2 +044900 MOVE SPACE TO RE-MARK. IX2084.2 +045000 HEAD-ROUTINE. IX2084.2 +045100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +045200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +045300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2084.2 +045400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2084.2 +045500 COLUMN-NAMES-ROUTINE. IX2084.2 +045600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +045700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +045800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +045900 END-ROUTINE. IX2084.2 +046000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2084.2 +046100 END-RTN-EXIT. IX2084.2 +046200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +046300 END-ROUTINE-1. IX2084.2 +046400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2084.2 +046500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2084.2 +046600 ADD PASS-COUNTER TO ERROR-HOLD. IX2084.2 +046700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2084.2 +046800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2084.2 +046900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2084.2 +047000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2084.2 +047100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2084.2 +047200 END-ROUTINE-12. IX2084.2 +047300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2084.2 +047400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2084.2 +047500 MOVE "NO " TO ERROR-TOTAL IX2084.2 +047600 ELSE IX2084.2 +047700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2084.2 +047800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2084.2 +047900 PERFORM WRITE-LINE. IX2084.2 +048000 END-ROUTINE-13. IX2084.2 +048100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2084.2 +048200 MOVE "NO " TO ERROR-TOTAL ELSE IX2084.2 +048300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2084.2 +048400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2084.2 +048500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO IX2084.2 +048700 MOVE "NO " TO ERROR-TOTAL IX2084.2 +048800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2084.2 +048900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2084.2 +049000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +049100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2084.2 +049200 WRITE-LINE. IX2084.2 +049300 ADD 1 TO RECORD-COUNT. IX2084.2 +049400 IF RECORD-COUNT GREATER 42 IX2084.2 +049500 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2084.2 +049600 MOVE SPACE TO DUMMY-RECORD IX2084.2 +049700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2084.2 +049800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2084.2 +049900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2084.2 +050000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2084.2 +050100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2084.2 +050200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2084.2 +050300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2084.2 +050400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2084.2 +050500 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2084.2 +050600 MOVE ZERO TO RECORD-COUNT. IX2084.2 +050700 PERFORM WRT-LN. IX2084.2 +050800 WRT-LN. IX2084.2 +050900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2084.2 +051000 MOVE SPACE TO DUMMY-RECORD. IX2084.2 +051100 BLANK-LINE-PRINT. IX2084.2 +051200 PERFORM WRT-LN. IX2084.2 +051300 FAIL-ROUTINE. IX2084.2 +051400 IF COMPUTED-X NOT EQUAL TO SPACE IX2084.2 +051500 GO TO FAIL-ROUTINE-WRITE. IX2084.2 +051600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2084.2 +051700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2084.2 +051800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2084.2 +051900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +052000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2084.2 +052100 GO TO FAIL-ROUTINE-EX. IX2084.2 +052200 FAIL-ROUTINE-WRITE. IX2084.2 +052300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2084.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2084.2 +052500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2084.2 +052600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2084.2 +052700 FAIL-ROUTINE-EX. EXIT. IX2084.2 +052800 BAIL-OUT. IX2084.2 +052900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2084.2 +053000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2084.2 +053100 BAIL-OUT-WRITE. IX2084.2 +053200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2084.2 +053300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2084.2 +053400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2084.2 +053500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2084.2 +053600 BAIL-OUT-EX. EXIT. IX2084.2 +053700 CCVS1-EXIT. IX2084.2 +053800 EXIT. IX2084.2 +053900 SECT-IX208A-0001 SECTION. IX2084.2 +054000 WRITE-INIT-GF-01. IX2084.2 +054100 OPEN OUTPUT IX-FD1. IX2084.2 +054200 OPEN OUTPUT IX-FS2. IX2084.2 +054300 MOVE "IX-FD1" TO XFILE-NAME (1). IX2084.2 +054400 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2084.2 +054500 MOVE ZERO TO XRECORD-NUMBER (1). IX2084.2 +054600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2084.2 +054700 MOVE 000240 TO XRECORD-LENGTH (1). IX2084.2 +054800 MOVE 0001 TO XBLOCK-SIZE (1). IX2084.2 +054900 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2084.2 +055000 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2084.2 +055100 MOVE "S" TO XLABEL-TYPE (1). IX2084.2 +055200 MOVE 000300 TO IX-FD1-FILESIZE. IX2084.2 +055300 MOVE 000300 TO RECORDS-IN-FILE (1). IX2084.2 +055400 MOVE 00001 TO WRK-DU-05V00-001. IX2084.2 +055500 MOVE 00300 TO WRK-DU-05V00-002. IX2084.2 +055600 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2084.2 +055700 MOVE ZERO TO INV-KEY-COUNTER. IX2084.2 +055800 MOVE "WRITE-INIT-GF-01" TO PAR-NAME. IX2084.2 +055900 MOVE "IX-FS2" TO XFILE-NAME (2). IX2084.2 +056000 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2084.2 +056100 MOVE ZERO TO XRECORD-NUMBER (2). IX2084.2 +056200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2084.2 +056300 MOVE 000240 TO XRECORD-LENGTH (2). IX2084.2 +056400 MOVE 0001 TO XBLOCK-SIZE (2). IX2084.2 +056500 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2084.2 +056600 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2084.2 +056700 MOVE "S" TO XLABEL-TYPE (2). IX2084.2 +056800 MOVE 00300 TO IX-FS2-FILESIZE. IX2084.2 +056900 MOVE 00300 TO RECORDS-IN-FILE (2). IX2084.2 +057000 MOVE 00001 TO WRK-DU-05V00-003. IX2084.2 +057100 MOVE 00300 TO WRK-DU-05V00-004. IX2084.2 +057200 WRITE-TEST-GF-00. IX2084.2 +057300 ADD 0001 TO XRECORD-NUMBER (1). IX2084.2 +057400 MOVE WRK-IX-FD1-RECKEY TO XRECORD-KEY (1). IX2084.2 +057500 MOVE WRK-IX-FD1-ALTKEY TO ALTERNATE-KEY1 (1). IX2084.2 +057600 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2084.2 +057700 WRITE IX-FD1R1-F-G-240 IX2084.2 +057800 INVALID KEY IX2084.2 +057900 ADD 000001 TO INV-KEY-COUNTER. IX2084.2 +058000 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +058100 ADD 00001 TO WRK-DU-05V00-001. IX2084.2 +058200 SUBTRACT 00001 FROM WRK-DU-05V00-002. IX2084.2 +058300 IF XRECORD-NUMBER (1) LESS THAN IX-FD1-FILESIZE IX2084.2 +058400 GO TO WRITE-TEST-GF-00. IX2084.2 +058500 CLOSE IX-FD1. IX2084.2 +058600 WRITE-TEST-GF-01. IX2084.2 +058700 MOVE "CREATE FILE IX-FD1" TO FEATURE. IX2084.2 +058800 IF EXCUT-COUNTER-06V00 NOT EQUAL TO IX-FD1-FILESIZE IX2084.2 +058900 PERFORM FAIL IX2084.2 +059000 MOVE IX-FD1-FILESIZE TO CORRECT-N IX2084.2 +059100 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-N IX2084.2 +059200 MOVE "INCORRECT NUMBER OF WRITES; IX-41" TO RE-MARK IX2084.2 +059300 PERFORM PRINT-DETAIL IX2084.2 +059400 GO TO WRITE-INIT-GF-02. IX2084.2 +059500 IF INV-KEY-COUNTER NOT EQUAL TO ZERO IX2084.2 +059600 PERFORM FAIL IX2084.2 +059700 MOVE INV-KEY-COUNTER TO COMPUTED-N IX2084.2 +059800 MOVE ZERO TO CORRECT-N IX2084.2 +059900 MOVE "INVALID KEY ON WRITE; IX-41" TO RE-MARK IX2084.2 +060000 PERFORM PRINT-DETAIL IX2084.2 +060100 GO TO WRITE-INIT-GF-02. IX2084.2 +060200* IX2084.2 +060300* 01 IX2084.2 +060400* IX2084.2 +060500 PERFORM PASS. IX2084.2 +060600 PERFORM PRINT-DETAIL. IX2084.2 +060700 WRITE-INIT-GF-02. IX2084.2 +060800 MOVE ZERO TO INV-KEY-COUNTER. IX2084.2 +060900 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2084.2 +061000 WRITE-TEST-GF-02-1. IX2084.2 +061100 ADD 0001 TO XRECORD-NUMBER (2). IX2084.2 +061200 MOVE WRK-IX-FS2-RECKEY TO XRECORD-KEY (2). IX2084.2 +061300 MOVE WRK-IX-FS2-ALTKEY TO ALTERNATE-KEY1 (2). IX2084.2 +061400 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX2084.2 +061500 WRITE IX-FS2R1-F-G-240 IX2084.2 +061600 INVALID KEY IX2084.2 +061700 ADD 000001 TO INV-KEY-COUNTER. IX2084.2 +061800 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +061900 ADD 00001 TO WRK-DU-05V00-003. IX2084.2 +062000 SUBTRACT 00001 FROM WRK-DU-05V00-004. IX2084.2 +062100 IF XRECORD-NUMBER (2) LESS THAN IX-FS2-FILESIZE IX2084.2 +062200 GO TO WRITE-TEST-GF-02-1. IX2084.2 +062300 CLOSE IX-FS2. IX2084.2 +062400 WRITE-TEST-GF-02. IX2084.2 +062500 MOVE "CREATE FILE IX-FS2" TO FEATURE. IX2084.2 +062600 MOVE "WRITE-TEST-GF-02 " TO PAR-NAME. IX2084.2 +062700 IF EXCUT-COUNTER-06V00 NOT EQUAL TO IX-FS2-FILESIZE IX2084.2 +062800 PERFORM FAIL IX2084.2 +062900 MOVE IX-FS2-FILESIZE TO CORRECT-N IX2084.2 +063000 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-N IX2084.2 +063100 MOVE "INCORRECT NUMBER OF WRITES; IX-41" TO RE-MARK IX2084.2 +063200 PERFORM PRINT-DETAIL IX2084.2 +063300 GO TO READ-INIT-F1-01. IX2084.2 +063400* IX2084.2 +063500* 02 IX2084.2 +063600* IX2084.2 +063700 IF INV-KEY-COUNTER NOT EQUAL TO ZERO IX2084.2 +063800 PERFORM FAIL IX2084.2 +063900 MOVE INV-KEY-COUNTER TO COMPUTED-N IX2084.2 +064000 MOVE ZERO TO CORRECT-N IX2084.2 +064100 MOVE "INVALID KEY ON WRITE; IX-41" TO RE-MARK IX2084.2 +064200 PERFORM PRINT-DETAIL IX2084.2 +064300 GO TO READ-INIT-F1-01. IX2084.2 +064400 PERFORM PASS. IX2084.2 +064500 PERFORM PRINT-DETAIL. IX2084.2 +064600 READ-INIT-F1-01. IX2084.2 +064700 PERFORM BLANK-LINE-PRINT. IX2084.2 +064800 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINED AS IX2084.2 +064900- "ACCESS MODE IS DYNAMIC." TO PRINT-REC. IX2084.2 +065000 PERFORM WRITE-LINE. IX2084.2 +065100 PERFORM BLANK-LINE-PRINT. IX2084.2 +065200 MOVE "READ NEXT" TO FEATURE. IX2084.2 +065300 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2084.2 +065400 READ-INIT-F1-01-R1. IX2084.2 +065500 OPEN INPUT IX-FD1. IX2084.2 +065600 PERFORM INX-INIT-002-R. IX2084.2 +065700 READ-TEST-F1-01-1. IX2084.2 +065800 READ IX-FD1 NEXT. IX2084.2 +065900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +066000 PERFORM INX-VERIFY-002. IX2084.2 +066100 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +066200 GO TO READ-TEST-F1-01-1. IX2084.2 +066300 CLOSE IX-FD1. IX2084.2 +066400 READ-TEST-F1-01. IX2084.2 +066500 PERFORM INX-TEST-002. IX2084.2 +066600 GO TO READ-INIT-F1-02. IX2084.2 +066700* IX2084.2 +066800* 01 IX2084.2 +066900* IX2084.2 +067000 READ-DELETE-F1-01. IX2084.2 +067100 PERFORM DE-LETE. IX2084.2 +067200 PERFORM PRINT-DETAIL. IX2084.2 +067300 READ-INIT-F1-02. IX2084.2 +067400 PERFORM INX-INIT-002-R. IX2084.2 +067500 OPEN INPUT IX-FD1. IX2084.2 +067600 READ-TEST-F1-02. IX2084.2 +067700 MOVE SPACE TO FILE-RECORD-INFO (9). IX2084.2 +067800 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +067900 READ IX-FD1 NEXT RECORD IX2084.2 +068000 INTO FILE-RECORD-INFO (9). IX2084.2 +068100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +068200 PERFORM INX-VERIFY-002. IX2084.2 +068300 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC IX2084.2 +068400 ADD 000100 TO ERROR-COUNTER-06V00. IX2084.2 +068500 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +068600 GO TO READ-TEST-F1-02. IX2084.2 +068700 CLOSE IX-FD1. IX2084.2 +068800 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX2084.2 +068900 MOVE "READ . NEXT INTO" TO FEATURE. IX2084.2 +069000 PERFORM INX-TEST-002. IX2084.2 +069100* IX2084.2 +069200* 02 IX2084.2 +069300* IX2084.2 +069400 GO TO READ-INIT-F1-03. IX2084.2 +069500 READ-DELETE-F1-02. IX2084.2 +069600 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX2084.2 +069700 MOVE "READ ... INTO " TO FEATURE. IX2084.2 +069800 PERFORM DE-LETE. IX2084.2 +069900 PERFORM PRINT-DETAIL. IX2084.2 +070000 READ-INIT-F1-03. IX2084.2 +070100 OPEN INPUT IX-FD1. IX2084.2 +070200 PERFORM INX-INIT-002-R. IX2084.2 +070300 READ-TEST-F1-03. IX2084.2 +070400 MOVE SPACE TO FILE-RECORD-INFO (9). IX2084.2 +070500 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +070600 READ IX-FD1 NEXT IX2084.2 +070700 INTO FILE-RECORD-INFO (9). IX2084.2 +070800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +070900 PERFORM INX-VERIFY-002. IX2084.2 +071000 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC IX2084.2 +071100 ADD 000100 TO ERROR-COUNTER-06V00. IX2084.2 +071200 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +071300 GO TO READ-TEST-F1-03. IX2084.2 +071400 CLOSE IX-FD1. IX2084.2 +071500 READ-TEST-F1-03-1. IX2084.2 +071600 MOVE "READ-TEST-F1-03" TO PAR-NAME. IX2084.2 +071700 MOVE "READ . NEXT INTO" TO FEATURE. IX2084.2 +071800 PERFORM INX-TEST-002. IX2084.2 +071900* IX2084.2 +072000* 03 IX2084.2 +072100* IX2084.2 +072200 GO TO READ-INIT-F1-04. IX2084.2 +072300 READ-DELETE-TEST-F1-03. IX2084.2 +072400 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX2084.2 +072500 PERFORM DE-LETE. IX2084.2 +072600 PERFORM PRINT-DETAIL. IX2084.2 +072700 READ-INIT-F1-04. IX2084.2 +072800 OPEN INPUT IX-FD1. IX2084.2 +072900 PERFORM INX-INIT-002-R. IX2084.2 +073000 MOVE IX-FD1-FILESIZE TO ERROR-COUNTER-06V00. IX2084.2 +073100 ADD 000001 TO ERROR-COUNTER-06V00. IX2084.2 +073200 MOVE "READ-TEST-F1-04" TO PAR-NAME. IX2084.2 +073300 MOVE "READ . NEXT INTO" TO FEATURE. IX2084.2 +073400 READ-TEST-F1-04. IX2084.2 +073500 MOVE SPACE TO FILE-RECORD-INFO (9). IX2084.2 +073600 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +073700 READ IX-FD1 NEXT INTO FILE-RECORD-INFO (9) AT END IX2084.2 +073800 SUBTRACT 000001 FROM ERROR-COUNTER-06V00 IX2084.2 +073900 GO TO READ-TEST-F1-04-1. IX2084.2 +074000 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +074100 PERFORM INX-VERIFY-002. IX2084.2 +074200 IF EXCUT-COUNTER-06V00 GREATER THAN IX-FD1-FILESIZE IX2084.2 +074300 NEXT SENTENCE IX2084.2 +074400 ELSE IX2084.2 +074500 GO TO READ-TEST-F1-04. IX2084.2 +074600* IX2084.2 +074700* TEST READ-TEST-F1-04 TESTS THE COBOL CONSTRUCT "READ FILE- IX2084.2 +074800* NAME NEXT INTO IDENTIFIER AT END". THE TEST READS THE FILE IX2084.2 +074900* SEQUENTIALY VIA THE RECORD KEY (RECORD KEY IS THE KEY OF IX2084.2 +075000* REFERENCE) UNTIL AN END-OF-FILE CONDITION OCCURS. A CHECK IX2084.2 +075100* IS MADE TO VERIFY THAT THE PROPER RECORDS WERE RETRIVED AND IX2084.2 +075200* THE AT END PATH WAS TAKEN ON THE 301 ST READ. IX2084.2 +075300* IX2084.2 +075400 READ-TEST-F1-04-1. IX2084.2 +075500 CLOSE IX-FD1. IX2084.2 +075600 PERFORM INX-TEST-002. IX2084.2 +075700* .04 IX2084.2 +075800 GO TO READ-INIT-F2-01. IX2084.2 +075900 READ-DELETE-F1-04. IX2084.2 +076000 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX2084.2 +076100 PERFORM DE-LETE. IX2084.2 +076200 PERFORM PRINT-DETAIL. IX2084.2 +076300 READ-INIT-F2-01. IX2084.2 +076400 OPEN INPUT IX-FD1. IX2084.2 +076500 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX2084.2 +076600 MOVE "READ . KEY IS .." TO FEATURE. IX2084.2 +076700 PERFORM INX-INIT-002-R. IX2084.2 +076800 MOVE ZERO TO WRK-DU-05V00-001. IX2084.2 +076900 READ-TEST-F2-01. IX2084.2 +077000 ADD 00005 TO WRK-DU-05V00-001. IX2084.2 +077100 ADD 000004 TO LOGICAL-FILE-REC. IX2084.2 +077200 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +077300 READ IX-FD1 IX2084.2 +077400 KEY IS IX-FD1-KEY. IX2084.2 +077500 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +077600 PERFORM INX-VERIFY-002. IX2084.2 +077700 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +077800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +077900 GO TO READ-TEST-F2-01. IX2084.2 +078000 CLOSE IX-FD1. IX2084.2 +078100 PERFORM INX-TEST-002. IX2084.2 +078200* .05 IX2084.2 +078300 GO TO READ-INIT-F2-02. IX2084.2 +078400 READ-DELETE-F2-01. IX2084.2 +078500 MOVE "READ-TEST-F2-01 " TO PAR-NAME. IX2084.2 +078600 PERFORM DE-LETE. IX2084.2 +078700 PERFORM PRINT-DETAIL. IX2084.2 +078800 READ-INIT-F2-02. IX2084.2 +078900 MOVE "READ-TEST-F2-02 " TO PAR-NAME. IX2084.2 +079000 MOVE "READ ... INTO " TO FEATURE. IX2084.2 +079100 OPEN INPUT IX-FD1. IX2084.2 +079200 PERFORM INX-INIT-002-R. IX2084.2 +079300 MOVE ZERO TO WRK-DU-05V00-001. IX2084.2 +079400 READ-TEST-F2-02. IX2084.2 +079500 MOVE SPACE TO FILE-RECORD-INFO (9). IX2084.2 +079600 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +079700 ADD 00005 TO WRK-DU-05V00-001. IX2084.2 +079800 ADD 000004 TO LOGICAL-FILE-REC. IX2084.2 +079900 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +080000 READ IX-FD1 INTO FILE-RECORD-INFO (9) IX2084.2 +080100 KEY IS IX-FD1-KEY. IX2084.2 +080200 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +080300 PERFORM INX-VERIFY-002. IX2084.2 +080400 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-RECIX2084.2 +080500 ADD 000100 TO ERROR-COUNTER-06V00. IX2084.2 +080600 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +080700 GO TO READ-TEST-F2-02. IX2084.2 +080800 CLOSE IX-FD1. IX2084.2 +080900 PERFORM INX-TEST-002. IX2084.2 +081000* .06 IX2084.2 +081100 GO TO READ-INIT-F2-03. IX2084.2 +081200 READ-DELETE-F2-02. IX2084.2 +081300 MOVE "READ-TEST-F2-02 " TO PAR-NAME. IX2084.2 +081400 PERFORM DE-LETE. IX2084.2 +081500 PERFORM PRINT-DETAIL. IX2084.2 +081600 READ-INIT-F2-03. IX2084.2 +081700 MOVE "READ-TEST-F2-03 " TO PAR-NAME. IX2084.2 +081800 MOVE "READ . KEY ALTERNATE" TO FEATURE. IX2084.2 +081900 OPEN INPUT IX-FD1. IX2084.2 +082000 PERFORM INX-INIT-002-R. IX2084.2 +082100 MOVE ZERO TO WRK-DU-05V00-002. IX2084.2 +082200 MOVE 301 TO LOGICAL-FILE-REC. IX2084.2 +082300 READ-TEST-F2-03. IX2084.2 +082400 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +082500 ADD 00005 TO WRK-DU-05V00-002. IX2084.2 +082600 SUBTRACT 00006 FROM LOGICAL-FILE-REC. IX2084.2 +082700 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +082800 READ IX-FD1 RECORD IX2084.2 +082900 KEY IX-FD1-ALTKEY1. IX2084.2 +083000 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +083100 PERFORM INX-VERIFY-002. IX2084.2 +083200 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +083300 GO TO READ-TEST-F2-03. IX2084.2 +083400 CLOSE IX-FD1. IX2084.2 +083500 PERFORM INX-TEST-002. IX2084.2 +083600* .07 IX2084.2 +083700 GO TO READ-INIT-F2-04. IX2084.2 +083800 READ-DELETE-F2-03. IX2084.2 +083900 MOVE "READ-TEST-F2-03 " TO PAR-NAME. IX2084.2 +084000 PERFORM DE-LETE. IX2084.2 +084100 PERFORM PRINT-DETAIL. IX2084.2 +084200 READ-INIT-F2-04. IX2084.2 +084300 MOVE "READ-TEST-F2-04 " TO PAR-NAME. IX2084.2 +084400 MOVE "READ .RECORD KEY ..." TO FEATURE. IX2084.2 +084500 OPEN INPUT IX-FD1. IX2084.2 +084600 PERFORM INX-INIT-002-R. IX2084.2 +084700 MOVE 00301 TO WRK-DU-05V00-001. IX2084.2 +084800 MOVE SPACE TO IX-FD1R1-F-G-240. IX2084.2 +084900 READ-TEST-F2-04. IX2084.2 +085000 ADD 00005 TO WRK-DU-05V00-001. IX2084.2 +085100 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +085200 READ IX-FD1 RECORD IX2084.2 +085300 KEY IX-FD1-KEY IX2084.2 +085400 INVALID SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +085500 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +085600 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +085700 GO TO READ-TEST-F2-04. IX2084.2 +085800 CLOSE IX-FD1. IX2084.2 +085900 PERFORM INX-TEST-002. IX2084.2 +086000* .08 IX2084.2 +086100 GO TO READ-INIT-F2-05. IX2084.2 +086200 READ-DELETE-F2-04. IX2084.2 +086300 MOVE "READ-TEST-F2-04 " TO PAR-NAME. IX2084.2 +086400 PERFORM DE-LETE. IX2084.2 +086500 PERFORM PRINT-DETAIL. IX2084.2 +086600 READ-INIT-F2-05. IX2084.2 +086700 MOVE "READ-TEST-F2-05 " TO PAR-NAME. IX2084.2 +086800 MOVE "READ RECORD KEY IS A" TO FEATURE. IX2084.2 +086900 OPEN INPUT IX-FD1. IX2084.2 +087000 PERFORM INX-INIT-002-R. IX2084.2 +087100 MOVE 00010 TO WRK-DU-05V00-001. IX2084.2 +087200 MOVE 00301 TO WRK-DU-05V00-002. IX2084.2 +087300 MOVE SPACE TO IX-FD1R1-F-G-240. IX2084.2 +087400 READ-TEST-F2-05. IX2084.2 +087500 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +087600 MOVE SPACE TO FILE-RECORD-INFO (1). IX2084.2 +087700 ADD 00005 TO WRK-DU-05V00-002. IX2084.2 +087800 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +087900 READ IX-FD1 RECORD IX2084.2 +088000 KEY IS IX-FD1-ALTKEY1 IX2084.2 +088100 INVALID KEY SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +088200 ADD 00001 TO EXCUT-COUNTER-06V00. IX2084.2 +088300 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +088400 GO TO READ-TEST-F2-05. IX2084.2 +088500 CLOSE IX-FD1. IX2084.2 +088600 PERFORM INX-TEST-002. IX2084.2 +088700* .09 IX2084.2 +088800 GO TO START-INIT-GF-01. IX2084.2 +088900 READ-DELETE-F2-05. IX2084.2 +089000 MOVE "READ-TEST-F2-05 " TO PAR-NAME. IX2084.2 +089100 PERFORM DE-LETE. IX2084.2 +089200 PERFORM PRINT-DETAIL. IX2084.2 +089300 INX-INIT-002-R. IX2084.2 +089400 MOVE 00010 TO ERROR-COUNTER-06V00. IX2084.2 +089500 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2084.2 +089600 MOVE ZERO TO INV-KEY-COUNTER. IX2084.2 +089700 MOVE ZERO TO LOGICAL-FILE-REC. IX2084.2 +089800 INX-VERIFY-002. IX2084.2 +089900 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +090000 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +090100 IF XRECORD-NUMBER (1) EQUAL TO LOGICAL-FILE-REC IX2084.2 +090200 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +090300 INX-TEST-002. IX2084.2 +090400 IF ERROR-COUNTER-06V00 EQUAL TO ZERO IX2084.2 +090500 PERFORM PASS IX2084.2 +090600 ELSE IX2084.2 +090700 PERFORM FAIL IX2084.2 +090800 MOVE ZERO TO CORRECT-N IX2084.2 +090900 MOVE ERROR-COUNTER-06V00 TO COMPUTED-N IX2084.2 +091000 MOVE "SEE PROGRAM (READ-TEST- ; IX-28)" TO RE-MARK. IX2084.2 +091100 PERFORM PRINT-DETAIL. IX2084.2 +091200* IX2084.2 +091300* EACH TEST IS EXECUTED 10 TIMES EXCEPT FOR INX-TEST-002-04IX2084.2 +091400* WHICH IS EXECUTED 300 TIMES. FOLLOWING THE LAST IX2084.2 +091500* EXECUTION A TEST IS MADE ON ERROR-COUNTER-06V00 WHICH IS IX2084.2 +091600* EXPECTED TO BE ZERO. IF ERROR-COUNTER-06V00 IS NOT ZERO IX2084.2 +091700* THE VALUE IN THE COUNTER INDICATES HOW THE EXECUTION FAILED IX2084.2 +091800* AND THE NUMBER OF TIMES THE UNEXPECTED ACTION OCCURRED IX2084.2 +091900* DURING THE TEST. BEFORE THE TEST BEGINS ERROR-COUNTER-06V00 IX2084.2 +092000* IS INITIALIZED WITH A VALUE. EACH TIME THE CORRECT RECORD IX2084.2 +092100* WAS MADE AVAILABLE FOLLOWING THE READ, OR AN INVALID KEY IX2084.2 +092200* CONDITION OCCURRED THAT WAS EXPECTED FOLLOWING A READ OR IX2084.2 +092300* START, ERROR-COUNTER-06V00 IS DECREMENTED BY 1. IX2084.2 +092400* FOR EACH EXECUTION THAT DID NOT PRODUCE THE EXPECTED IX2084.2 +092500* RESULTS THE ERROR-COUNTER-06V00 IS INCREMENTED BY THE VALUE IX2084.2 +092600* FOR THE ACTION LISTED BELOW, E.G., VALUE 20003 WOULD INDICATEIX2084.2 +092700* THAT OF THE 10 EXECUTIONS DURING THE TEST (READING LEFT TO IX2084.2 +092800* RIGHT) 2 INVALID KEY CONDITIONS AND 3 RECORDS RETRIEVED IX2084.2 +092900* AS A RESULT OF THE READ OR START WAS NOT-AS EXPECTED. IX2084.2 +093000* IX2084.2 +093100* IX2084.2 +093200* IX2084.2 +093300* COMPUTED RESULT INDICATED IX2084.2 +093400* INCREMENTS ACTION IX2084.2 +093500* IX2084.2 +093600* 000100 THE RECORD FOUND IN THE IDENTIFIER IX2084.2 +093700* SPECIFIED IN THE INTO PHRASE OF THE IX2084.2 +093800* READ STATEMENT WAS NOT THE RECORD IX2084.2 +093900* EXPECTED FOLLOWING EXECUTION OF THE IX2084.2 +094000* READ. IX2084.2 +094100* IX2084.2 +094200* 000001 THE RECORD RETREIVED FROM THE FILE IX2084.2 +094300* FOLLOWING THE READ WAS NOT THE ONE IX2084.2 +094400* EXPECTED. IX2084.2 +094500* IX2084.2 +094600* 010000 AN UNEXPECTED INVALID KEY OR AT END IX2084.2 +094700* CONDITION OCCURRED. NOTE - ASSUMPTION IX2084.2 +094800* IS THAT THE "USE" STATEMENT IS ONLY IX2084.2 +094900* EXECUTED WHEN AN INVALID KEY OR AT END IX2084.2 +095000* CONDITION OCCURS AND THE INVALID KEY OR IX2084.2 +095100* AT END PHRASE HAS NOT BEEN SPECIFIED. IX2084.2 +095200* IX2084.2 +095300 START-INIT-GF-01. IX2084.2 +095400 OPEN INPUT IX-FD1. IX2084.2 +095500 OPEN INPUT IX-FS2. IX2084.2 +095600 PERFORM BLANK-LINE-PRINT. IX2084.2 +095700 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINE AS IX2084.2 +095800- "ACCESS MODE IS SEQUENTIAL" TO PRINT-REC. IX2084.2 +095900 PERFORM WRITE-LINE. IX2084.2 +096000 PERFORM BLANK-LINE-PRINT. IX2084.2 +096100 MOVE "START-TEST-GF-01 " TO PAR-NAME. IX2084.2 +096200 MOVE "START EQUAL TO" TO FEATURE. IX2084.2 +096300 PERFORM INX-INIT-003-R. IX2084.2 +096400 START-TEST-GF-01. IX2084.2 +096500 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +096600 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +096700 START IX-FS2. IX2084.2 +096800 READ IX-FS2 RECORD AT END IX2084.2 +096900 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +097000 GO TO START-TEST-GF-01-1. IX2084.2 +097100 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +097200 PERFORM INX-VERIFY-003A. IX2084.2 +097300 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +097400 GO TO START-TEST-GF-01. IX2084.2 +097500 START-TEST-GF-01-1. IX2084.2 +097600 PERFORM INX-TEST-003. IX2084.2 +097700* .01 IX2084.2 +097800 GO TO START-INIT-GF-02. IX2084.2 +097900 INX-DELETE-003-01. IX2084.2 +098000 MOVE "START-TEST-GF-01 " TO PAR-NAME. IX2084.2 +098100 PERFORM DE-LETE. IX2084.2 +098200 PERFORM PRINT-DETAIL. IX2084.2 +098300 START-INIT-GF-02. IX2084.2 +098400 PERFORM INX-INIT-003-R. IX2084.2 +098500 START-TEST-GF-02. IX2084.2 +098600 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +098700 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +098800 START IX-FS2 IX2084.2 +098900 KEY EQUAL TO IX-FS2-KEY. IX2084.2 +099000 READ IX-FS2 RECORD AT END IX2084.2 +099100 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +099200 GO TO START-TEST-GF-02-1. IX2084.2 +099300 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +099400 PERFORM INX-VERIFY-003A. IX2084.2 +099500 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +099600 GO TO START-TEST-GF-02. IX2084.2 +099700 START-TEST-GF-02-1. IX2084.2 +099800 MOVE "START-TEST-GF-02 " TO PAR-NAME. IX2084.2 +099900 MOVE "START KEY EQUAL TO " TO FEATURE. IX2084.2 +100000 PERFORM INX-TEST-003. IX2084.2 +100100* .02 IX2084.2 +100200 GO TO START-INIT-GF-03. IX2084.2 +100300 START-DELETE-GF-02. IX2084.2 +100400 MOVE "START-TEST-GF-02 " TO PAR-NAME. IX2084.2 +100500 PERFORM DE-LETE. IX2084.2 +100600 PERFORM PRINT-DETAIL. IX2084.2 +100700 START-INIT-GF-03. IX2084.2 +100800 PERFORM INX-INIT-003-R. IX2084.2 +100900 START-TEST-GF-03. IX2084.2 +101000 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +101100 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +101200 START IX-FS2 IX2084.2 +101300 KEY IS EQUAL TO IX-FS2-KEY. IX2084.2 +101400 READ IX-FS2 RECORD AT END IX2084.2 +101500 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +101600 GO TO START-TEST-GF-03-1. IX2084.2 +101700 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +101800 PERFORM INX-VERIFY-003A. IX2084.2 +101900 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +102000 GO TO START-TEST-GF-03. IX2084.2 +102100 START-TEST-GF-03-1. IX2084.2 +102200 MOVE "START-TEST-GF-03 " TO PAR-NAME. IX2084.2 +102300 MOVE "START KEY IS EQUAL " TO FEATURE. IX2084.2 +102400 PERFORM INX-TEST-003. IX2084.2 +102500* .03 IX2084.2 +102600 GO TO START-INIT-GF-04. IX2084.2 +102700 START-DELETE-GF-03. IX2084.2 +102800 MOVE "START-TEST-GF-03 " TO PAR-NAME. IX2084.2 +102900 MOVE "START KEY IS EQUAL " TO FEATURE. IX2084.2 +103000 PERFORM DE-LETE. IX2084.2 +103100 PERFORM PRINT-DETAIL. IX2084.2 +103200 START-INIT-GF-04. IX2084.2 +103300 PERFORM INX-INIT-003-R. IX2084.2 +103400 START-TEST-GF-04. IX2084.2 +103500 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +103600 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +103700 START IX-FS2 IX2084.2 +103800 KEY IS EQUAL IX-FS2-KEY. IX2084.2 +103900 READ IX-FS2 RECORD AT END IX2084.2 +104000 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +104100 GO TO START-TEST-GF-04-1. IX2084.2 +104200 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +104300 PERFORM INX-VERIFY-003A. IX2084.2 +104400 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +104500 GO TO START-TEST-GF-04. IX2084.2 +104600 START-TEST-GF-04-1. IX2084.2 +104700 MOVE "START-TEST-GF-04 " TO PAR-NAME. IX2084.2 +104800 MOVE "START KEY IS EQUAL " TO FEATURE. IX2084.2 +104900 PERFORM INX-TEST-003. IX2084.2 +105000* .04 IX2084.2 +105100 GO TO START-INIT-GF-05. IX2084.2 +105200 INX-DELETE-003-04. IX2084.2 +105300 MOVE "START-TEST-GF-04 " TO PAR-NAME. IX2084.2 +105400 PERFORM DE-LETE. IX2084.2 +105500 PERFORM PRINT-DETAIL. IX2084.2 +105600 START-INIT-GF-05. IX2084.2 +105700 PERFORM INX-INIT-003-R. IX2084.2 +105800 START-TEST-GF-05. IX2084.2 +105900 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +106000 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +106100 START IX-FS2 IX2084.2 +106200 KEY IS = IX-FS2-KEY. IX2084.2 +106300 READ IX-FS2 RECORD AT END IX2084.2 +106400 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +106500 GO TO START-TEST-GF-05-1. IX2084.2 +106600 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +106700 PERFORM INX-VERIFY-003A. IX2084.2 +106800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +106900 GO TO START-TEST-GF-05. IX2084.2 +107000 START-TEST-GF-05-1. IX2084.2 +107100 MOVE "START-TEST-GF-05 " TO PAR-NAME. IX2084.2 +107200 MOVE "START KEY IS = ... " TO FEATURE. IX2084.2 +107300 PERFORM INX-TEST-003. IX2084.2 +107400* .05 IX2084.2 +107500 GO TO START-INIT-GF-06. IX2084.2 +107600 START-DELETE-GF-05. IX2084.2 +107700 MOVE "START-TEST-GF-05 " TO PAR-NAME. IX2084.2 +107800 PERFORM DE-LETE. IX2084.2 +107900 PERFORM PRINT-DETAIL. IX2084.2 +108000 START-INIT-GF-06. IX2084.2 +108100 PERFORM INX-INIT-003-R. IX2084.2 +108200 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +108300 START-TEST-GF-06. IX2084.2 +108400 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +108500 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +108600 START IX-FS2 IX2084.2 +108700 KEY IS GREATER THAN IX-FS2-KEY. IX2084.2 +108800 READ IX-FS2 RECORD AT END IX2084.2 +108900 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +109000 GO TO START-TEST-GF-06-1. IX2084.2 +109100 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +109200 PERFORM INX-VERIFY-003A. IX2084.2 +109300 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +109400 GO TO START-TEST-GF-06. IX2084.2 +109500 START-TEST-GF-06-1. IX2084.2 +109600 MOVE "START-TEST-GF-06 " TO PAR-NAME. IX2084.2 +109700 MOVE "START GREATER THAN" TO FEATURE. IX2084.2 +109800 PERFORM INX-TEST-003. IX2084.2 +109900* .06 IX2084.2 +110000 GO TO START-INIT-GF-07. IX2084.2 +110100 START-DELETE-GF-06. IX2084.2 +110200 MOVE "START-TEST-GF-06 " TO PAR-NAME. IX2084.2 +110300 PERFORM DE-LETE. IX2084.2 +110400 PERFORM PRINT-DETAIL. IX2084.2 +110500 START-INIT-GF-07. IX2084.2 +110600 PERFORM INX-INIT-003-R. IX2084.2 +110700 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +110800 START-TEST-GF-07. IX2084.2 +110900 ADD 00003 TO WRK-DU-05V00-003. IX2084.2 +111000 MOVE WRK-IX-FS2-RECKEY TO IX-FS2-KEY. IX2084.2 +111100 START IX-FS2 IX2084.2 +111200 KEY GREATER THAN IX-FS2-KEY. IX2084.2 +111300 READ IX-FS2 RECORD AT END IX2084.2 +111400 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +111500 GO TO START-TEST-GF-07-1. IX2084.2 +111600 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +111700 PERFORM INX-VERIFY-003A. IX2084.2 +111800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +111900 GO TO START-TEST-GF-07. IX2084.2 +112000 START-TEST-GF-07-1. IX2084.2 +112100 MOVE "START-TEST-GF-07 " TO PAR-NAME. IX2084.2 +112200 MOVE "START KEY GREATER THAN" TO FEATURE. IX2084.2 +112300* .07 IX2084.2 +112400 GO TO START-INIT-GF-08. IX2084.2 +112500 START-DELETE-GF-07. IX2084.2 +112600 MOVE "START-TEST-GF-07 " TO PAR-NAME. IX2084.2 +112700 PERFORM DE-LETE. IX2084.2 +112800 PERFORM PRINT-DETAIL. IX2084.2 +112900 START-INIT-GF-08. IX2084.2 +113000 PERFORM INX-INIT-003-R. IX2084.2 +113100 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +113200 GIVING LOGICAL-FILE-REC. IX2084.2 +113300 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +113400 START-TEST-GF-08. IX2084.2 +113500 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +113600 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +113700 START IX-FS2 IX2084.2 +113800 KEY IS GREATER IX-FS2-ALTKEY1. IX2084.2 +113900 READ IX-FS2 RECORD AT END IX2084.2 +114000 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +114100 GO TO START-TEST-GF-08-1. IX2084.2 +114200 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +114300 PERFORM INX-VERIFY-003A. IX2084.2 +114400 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +114500 GO TO START-TEST-GF-08. IX2084.2 +114600 START-TEST-GF-08-1. IX2084.2 +114700 MOVE "START-TEST-GF-08 " TO PAR-NAME. IX2084.2 +114800 MOVE "START KEY IS GREATER" TO FEATURE. IX2084.2 +114900 PERFORM INX-TEST-003. IX2084.2 +115000* .08 IX2084.2 +115100 GO TO START-INIT-GF-09. IX2084.2 +115200 START-DELETE-GF-08. IX2084.2 +115300 MOVE "START-TEST-GF-08 " TO PAR-NAME. IX2084.2 +115400 PERFORM DE-LETE. IX2084.2 +115500 PERFORM PRINT-DETAIL. IX2084.2 +115600 START-INIT-GF-09. IX2084.2 +115700 PERFORM INX-INIT-003-R. IX2084.2 +115800 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +115900 GIVING LOGICAL-FILE-REC. IX2084.2 +116000 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +116100 START-TEST-GF-09. IX2084.2 +116200 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +116300 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +116400 START IX-FS2 IX2084.2 +116500 KEY IS > IX-FS2-ALTKEY1. IX2084.2 +116600 READ IX-FS2 RECORD AT END IX2084.2 +116700 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +116800 GO TO START-TEST-GF-09-1. IX2084.2 +116900 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +117000 PERFORM INX-VERIFY-003A. IX2084.2 +117100 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +117200 GO TO START-TEST-GF-09. IX2084.2 +117300 START-TEST-GF-09-1. IX2084.2 +117400 MOVE "START-TEST-GF-09 " TO PAR-NAME. IX2084.2 +117500 MOVE "START KEY IS > ... " TO FEATURE. IX2084.2 +117600 PERFORM INX-TEST-003. IX2084.2 +117700* .09 IX2084.2 +117800 GO TO START-INIT-GF-10. IX2084.2 +117900 START-DELETE-GF-09. IX2084.2 +118000 MOVE "START-TEST-GF-09 " TO PAR-NAME. IX2084.2 +118100 PERFORM DE-LETE. IX2084.2 +118200 PERFORM PRINT-DETAIL. IX2084.2 +118300 START-INIT-GF-10. IX2084.2 +118400 PERFORM INX-INIT-003-R. IX2084.2 +118500 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +118600 GIVING LOGICAL-FILE-REC. IX2084.2 +118700 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +118800 START-TEST-GF-10. IX2084.2 +118900 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +119000 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +119100 START IX-FS2 IX2084.2 +119200 KEY > IX-FS2-ALTKEY1. IX2084.2 +119300 READ IX-FS2 RECORD AT END IX2084.2 +119400 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +119500 GO TO START-TEST-GF-10-1. IX2084.2 +119600 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +119700 PERFORM INX-VERIFY-003A. IX2084.2 +119800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +119900 GO TO START-TEST-GF-10. IX2084.2 +120000 START-TEST-GF-10-1. IX2084.2 +120100 MOVE "START-TEST-GF-10 " TO PAR-NAME. IX2084.2 +120200 MOVE "START ... KEY > ... " TO FEATURE. IX2084.2 +120300 PERFORM INX-TEST-003. IX2084.2 +120400* .10 IX2084.2 +120500 GO TO START-INIT-GF-11. IX2084.2 +120600 START-DELETE-GF-10. IX2084.2 +120700 MOVE "START-TEST-GF-10 " TO PAR-NAME. IX2084.2 +120800 PERFORM DE-LETE. IX2084.2 +120900 PERFORM PRINT-DETAIL. IX2084.2 +121000 START-INIT-GF-11. IX2084.2 +121100 MOVE "START NOT LESS THAN" TO FEATURE. IX2084.2 +121200 PERFORM INX-INIT-003-R. IX2084.2 +121300 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +121400 GIVING LOGICAL-FILE-REC. IX2084.2 +121500 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +121600 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +121700 START-TEST-GF-11. IX2084.2 +121800 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +121900 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +122000 START IX-FS2 IX2084.2 +122100 KEY IS NOT LESS THAN IX-FS2-ALTKEY1. IX2084.2 +122200 READ IX-FS2 RECORD AT END IX2084.2 +122300 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +122400 GO TO START-TEST-GF-11-1. IX2084.2 +122500 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +122600 PERFORM INX-VERIFY-003A. IX2084.2 +122700 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +122800 GO TO START-TEST-GF-11. IX2084.2 +122900 START-TEST-GF-11-1. IX2084.2 +123000 MOVE "START-TEST-GF-11 " TO PAR-NAME. IX2084.2 +123100 MOVE "START KEY IS NOT LESS THAN" TO FEATURE. IX2084.2 +123200 PERFORM INX-TEST-003. IX2084.2 +123300* .11 IX2084.2 +123400 GO TO START-INIT-GF-12. IX2084.2 +123500 START-DELETE-GF-22. IX2084.2 +123600 MOVE "START-TEST-GF-11 " TO PAR-NAME. IX2084.2 +123700 PERFORM DE-LETE. IX2084.2 +123800 PERFORM PRINT-DETAIL. IX2084.2 +123900 START-INIT-GF-12. IX2084.2 +124000 PERFORM INX-INIT-003-R. IX2084.2 +124100 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +124200 GIVING LOGICAL-FILE-REC. IX2084.2 +124300 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +124400 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +124500 START-TEST-GF-12. IX2084.2 +124600 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +124700 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +124800 START IX-FS2 IX2084.2 +124900 KEY IS NOT LESS IX-FS2-ALTKEY1. IX2084.2 +125000 READ IX-FS2 RECORD AT END IX2084.2 +125100 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +125200 GO TO START-TEST-GF-12-1. IX2084.2 +125300 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +125400 PERFORM INX-VERIFY-003A. IX2084.2 +125500 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +125600 GO TO START-TEST-GF-12. IX2084.2 +125700 START-TEST-GF-12-1. IX2084.2 +125800 MOVE "START-TEST-GF-12 " TO PAR-NAME. IX2084.2 +125900 MOVE "START KEY IS NOT LESS" TO FEATURE. IX2084.2 +126000 PERFORM INX-TEST-003. IX2084.2 +126100* .12 IX2084.2 +126200 GO TO START-INIT-GF-13. IX2084.2 +126300 START-DELETE-GF-12. IX2084.2 +126400 MOVE "START-TEST-GF-12 " TO PAR-NAME. IX2084.2 +126500 PERFORM DE-LETE. IX2084.2 +126600 PERFORM PRINT-DETAIL. IX2084.2 +126700 START-INIT-GF-13. IX2084.2 +126800 PERFORM INX-INIT-003-R. IX2084.2 +126900 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +127000 GIVING LOGICAL-FILE-REC. IX2084.2 +127100 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +127200 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +127300 START-TEST-GF-13. IX2084.2 +127400 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +127500 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +127600 START IX-FS2 IX2084.2 +127700 KEY NOT LESS THAN IX-FS2-ALTKEY1. IX2084.2 +127800 READ IX-FS2 RECORD AT END IX2084.2 +127900 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +128000 GO TO START-TEST-GF-13-1. IX2084.2 +128100 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +128200 PERFORM INX-VERIFY-003A. IX2084.2 +128300 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +128400 GO TO START-TEST-GF-13. IX2084.2 +128500 START-TEST-GF-13-1. IX2084.2 +128600 MOVE "START-TEST-GF-13 " TO PAR-NAME. IX2084.2 +128700 MOVE "START KEY NOT LESS THAN " TO FEATURE. IX2084.2 +128800 PERFORM INX-TEST-003. IX2084.2 +128900* .13 IX2084.2 +129000 GO TO START-INIT-GF-14. IX2084.2 +129100 START-DELETE-GF-13. IX2084.2 +129200 MOVE "START-TEST-GF-13 " TO PAR-NAME. IX2084.2 +129300 PERFORM DE-LETE. IX2084.2 +129400 PERFORM PRINT-DETAIL. IX2084.2 +129500 START-INIT-GF-14. IX2084.2 +129600 PERFORM INX-INIT-003-R. IX2084.2 +129700 SUBTRACT WRK-DU-05V00-004 FROM IX-FS2-FILESIZE IX2084.2 +129800 GIVING LOGICAL-FILE-REC. IX2084.2 +129900 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +130000 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +130100 START-TEST-GF-14. IX2084.2 +130200 ADD 00003 TO WRK-DU-05V00-004. IX2084.2 +130300 MOVE WRK-IX-FS2-ALTKEY TO IX-FS2-ALTKEY1. IX2084.2 +130400 START IX-FS2 IX2084.2 +130500 KEY IS NOT < IX-FS2-ALTKEY1. IX2084.2 +130600 READ IX-FS2 RECORD AT END IX2084.2 +130700 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +130800 GO TO START-TEST-GF-14-1. IX2084.2 +130900 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2084.2 +131000 PERFORM INX-VERIFY-003A. IX2084.2 +131100 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +131200 GO TO START-TEST-GF-14. IX2084.2 +131300 START-TEST-GF-14-1. IX2084.2 +131400 MOVE "START-TEST-GF-14 " TO PAR-NAME. IX2084.2 +131500 MOVE "START KEY IS NOT < " TO FEATURE. IX2084.2 +131600 PERFORM INX-TEST-003. IX2084.2 +131700* .14 IX2084.2 +131800 GO TO START-INIT-GF-15. IX2084.2 +131900 START-DELETE-GF-14. IX2084.2 +132000 MOVE "START-TEST-GF-14 " TO PAR-NAME. IX2084.2 +132100 PERFORM DE-LETE. IX2084.2 +132200 PERFORM PRINT-DETAIL. IX2084.2 +132300 START-INIT-GF-15. IX2084.2 +132400 PERFORM BLANK-LINE-PRINT. IX2084.2 +132500 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINED AS IX2084.2 +132600- "ACCESS MODE IS DYNAMIC" TO PRINT-REC. IX2084.2 +132700 PERFORM WRITE-LINE. IX2084.2 +132800 PERFORM BLANK-LINE-PRINT. IX2084.2 +132900 MOVE "START EQUAL TO " TO FEATURE. IX2084.2 +133000 PERFORM INX-INIT-003-R. IX2084.2 +133100 SUBTRACT WRK-DU-05V00-002 FROM IX-FD1-FILESIZE IX2084.2 +133200 GIVING LOGICAL-FILE-REC. IX2084.2 +133300 ADD 000001 TO LOGICAL-FILE-REC. IX2084.2 +133400 MOVE "DN" TO ASCEND-DESEND-SWITCH. IX2084.2 +133500 START-TEST-GF-15. IX2084.2 +133600 ADD 000002 TO WRK-DU-05V00-002. IX2084.2 +133700 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +133800 START IX-FD1 IX2084.2 +133900 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2084.2 +134000 INVALID KEY ADD 010000 TO ERROR-COUNTER-06V00. IX2084.2 +134100 READ IX-FD1 NEXT RECORD AT END IX2084.2 +134200 ADD 010000 TO ERROR-COUNTER-06V00 IX2084.2 +134300 GO TO START-TEST-GF-15-1. IX2084.2 +134400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2084.2 +134500 PERFORM INX-VERIFY-003B. IX2084.2 +134600 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +134700 GO TO START-TEST-GF-15. IX2084.2 +134800 START-TEST-GF-15-1. IX2084.2 +134900 MOVE "START-TEST-GF-15 " TO PAR-NAME. IX2084.2 +135000 MOVE "START KEY IS EQUAL TO" TO FEATURE. IX2084.2 +135100 PERFORM INX-TEST-003. IX2084.2 +135200* .15 IX2084.2 +135300 GO TO START-INIT-GF-16. IX2084.2 +135400 START-DELETE-GF-15. IX2084.2 +135500 MOVE "START-TEST-GF-15 " TO PAR-NAME. IX2084.2 +135600 PERFORM DE-LETE. IX2084.2 +135700 PERFORM PRINT-DETAIL. IX2084.2 +135800 START-INIT-GF-16. IX2084.2 +135900 MOVE 00055 TO WRK-DU-05V00-001. IX2084.2 +136000 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +136100 MOVE "START INVALID KEY" TO FEATURE. IX2084.2 +136200 PERFORM INX-INIT-003-R. IX2084.2 +136300 MOVE IX-FD1-FILESIZE TO LOGICAL-FILE-REC. IX2084.2 +136400 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-002. IX2084.2 +136500 START-TEST-GF-16. IX2084.2 +136600 ADD 000002 TO WRK-DU-05V00-002. IX2084.2 +136700 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +136800 START IX-FD1 IX2084.2 +136900 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2084.2 +137000 INVALID SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +137100 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +137200 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +137300 GO TO START-TEST-GF-16. IX2084.2 +137400 MOVE "START-TEST-GF-16 " TO PAR-NAME. IX2084.2 +137500 PERFORM INX-TEST-003. IX2084.2 +137600* .16 IX2084.2 +137700 GO TO START-INIT-GF-17. IX2084.2 +137800 START-DELETE-GF-16. IX2084.2 +137900 MOVE "START-TEST-GF-16 " TO PAR-NAME. IX2084.2 +138000 PERFORM DE-LETE. IX2084.2 +138100 PERFORM PRINT-DETAIL. IX2084.2 +138200 START-INIT-GF-17. IX2084.2 +138300 MOVE 00055 TO WRK-DU-05V00-002. IX2084.2 +138400 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +138500 PERFORM INX-INIT-003-R. IX2084.2 +138600 MOVE IX-FD1-FILESIZE TO LOGICAL-FILE-REC. IX2084.2 +138700 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-001. IX2084.2 +138800 START-TEST-GF-17. IX2084.2 +138900 ADD 00003 TO WRK-DU-05V00-001. IX2084.2 +139000 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +139100 START IX-FD1 INVALID KEY IX2084.2 +139200 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +139300 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +139400 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +139500 GO TO START-TEST-GF-17. IX2084.2 +139600 MOVE "START-TEST-GF-17 " TO PAR-NAME. IX2084.2 +139700 PERFORM INX-TEST-003. IX2084.2 +139800* .17 IX2084.2 +139900 GO TO START-INIT-GF-18. IX2084.2 +140000 START-DELETE-GF-17. IX2084.2 +140100 MOVE "START-TEST-GF-17 " TO PAR-NAME. IX2084.2 +140200 PERFORM DE-LETE. IX2084.2 +140300 PERFORM PRINT-DETAIL. IX2084.2 +140400 START-INIT-GF-18. IX2084.2 +140500 MOVE 00055 TO WRK-DU-05V00-002. IX2084.2 +140600 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +140700 PERFORM INX-INIT-003-R. IX2084.2 +140800 MOVE IX-FD1-FILESIZE TO LOGICAL-FILE-REC. IX2084.2 +140900 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-001. IX2084.2 +141000 START-TEST-GF-18. IX2084.2 +141100 ADD 00003 TO WRK-DU-05V00-001. IX2084.2 +141200 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +141300 START IX-FD1 ; INVALID KEY IX2084.2 +141400 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +141500 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +141600 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +141700 GO TO START-TEST-GF-18. IX2084.2 +141800 MOVE "START-TEST-GF-18 " TO PAR-NAME. IX2084.2 +141900 PERFORM INX-TEST-003. IX2084.2 +142000* .18 IX2084.2 +142100 GO TO START-INIT-GF-19. IX2084.2 +142200 START-DELETE-GF-18. IX2084.2 +142300 MOVE "START-TEST-GF-18 " TO PAR-NAME. IX2084.2 +142400 PERFORM DE-LETE. IX2084.2 +142500 PERFORM PRINT-DETAIL. IX2084.2 +142600 START-INIT-GF-19. IX2084.2 +142700 PERFORM INX-INIT-003-R. IX2084.2 +142800 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-001. IX2084.2 +142900 MOVE WRK-IX-FD1-RECKEY TO IX-FD1-KEY. IX2084.2 +143000 MOVE IX-FD1-FILESIZE TO WRK-DU-05V00-002. IX2084.2 +143100 START-TEST-GF-19. IX2084.2 +143200 ADD 000002 TO WRK-DU-05V00-002. IX2084.2 +143300 MOVE WRK-IX-FD1-ALTKEY TO IX-FD1-ALTKEY1. IX2084.2 +143400 START IX-FD1 IX2084.2 +143500 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2084.2 +143600 ; INVALID KEY SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +143700 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +143800 IF EXCUT-COUNTER-06V00 LESS THAN 10 IX2084.2 +143900 GO TO START-TEST-GF-19. IX2084.2 +144000 MOVE "START-TEST-GF-19 " TO PAR-NAME. IX2084.2 +144100 PERFORM INX-TEST-003. IX2084.2 +144200* .19 IX2084.2 +144300 GO TO START-END. IX2084.2 +144400 START-DELETE-GF-19. IX2084.2 +144500 MOVE "START-TEST-GF-19 " TO PAR-NAME. IX2084.2 +144600 PERFORM DE-LETE. IX2084.2 +144700 PERFORM PRINT-DETAIL. IX2084.2 +144800 INX-INIT-003-R. IX2084.2 +144900 MOVE ZERO TO LOGICAL-FILE-REC. IX2084.2 +145000 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2084.2 +145100 MOVE 00055 TO WRK-DU-05V00-002. IX2084.2 +145200 MOVE 00050 TO WRK-DU-05V00-004. IX2084.2 +145300 MOVE ZERO TO WRK-DU-05V00-003. IX2084.2 +145400 MOVE 10 TO ERROR-COUNTER-06V00. IX2084.2 +145500 INX-VERIFY-003A. IX2084.2 +145600 IF ASCEND IX2084.2 +145700 ADD 000003 TO LOGICAL-FILE-REC IX2084.2 +145800 ELSE IX2084.2 +145900 SUBTRACT 000003 FROM LOGICAL-FILE-REC. IX2084.2 +146000 IF LOGICAL-FILE-REC EQUAL TO XRECORD-NUMBER (2) IX2084.2 +146100 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +146200 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +146300 INX-VERIFY-003B. IX2084.2 +146400 IF ASCEND IX2084.2 +146500 ADD 000002 TO LOGICAL-FILE-REC IX2084.2 +146600 ELSE IX2084.2 +146700 SUBTRACT 000002 FROM LOGICAL-FILE-REC. IX2084.2 +146800 IF LOGICAL-FILE-REC EQUAL TO XRECORD-NUMBER (1) IX2084.2 +146900 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. IX2084.2 +147000 ADD 000001 TO EXCUT-COUNTER-06V00. IX2084.2 +147100 INX-TEST-003. IX2084.2 +147200 IF EXCUT-COUNTER-06V00 NOT EQUAL TO 000010 IX2084.2 +147300 MULTIPLY 100 BY EXCUT-COUNTER-06V00 IX2084.2 +147400 ADD EXCUT-COUNTER-06V00 TO ERROR-COUNTER-06V00. IX2084.2 +147500 IF ERROR-COUNTER-06V00 EQUAL TO ZERO IX2084.2 +147600 PERFORM PASS IX2084.2 +147700 ELSE IX2084.2 +147800 PERFORM FAIL IX2084.2 +147900 MOVE ZERO TO CORRECT-N IX2084.2 +148000 MOVE ERROR-COUNTER-06V00 TO COMPUTED-N IX2084.2 +148100 MOVE "SEE PROGRAM (START-TEST- ); IX-36" TO RE-MARK.IX2084.2 +148200 PERFORM PRINT-DETAIL. IX2084.2 +148300* IX2084.2 +148400* EACH TEST IS EXECUTED 10 TIMES. FOLLOWING THE 10TH IX2084.2 +148500* EXECUTION A TEST IS MADE ON ERROR-COUNTER-06V00 WHICH IS IX2084.2 +148600* EXPECTED TO BE ZERO. IF ERROR-COUNTER-06V00 IS NOT ZERO IX2084.2 +148700* THE VALUE IN THE COUNTER INDICATES HOW THE EXECUTION FAILED IX2084.2 +148800* AND THE NUMBER OF TIMES THE UNEXPECTED ACTION OCCURRED IX2084.2 +148900* DURING THE TEST. BEFORE THE TEST BEGINS ERROR-COUNTER-06V00 IX2084.2 +149000* IS LOADED WITH THE VALUE 10. EACH TIME THE CORRECT RECORD IX2084.2 +149100* WAS MADE AVAILABLE FOLLOWING THE READ, OR AN INVALID KEY IX2084.2 +149200* CONDITION OCCURRED THAT WAS EXPECTED FOLLOWING A READ OR IX2084.2 +149300* START, ERROR-COUNTER-06V00 IS DECREMENTED BY 1. IX2084.2 +149400* FOR EACH ACTION THAT DID NOT OCCUR AS IX2084.2 +149500* EXPECTED THE ERROR-COUNTER-06V00 IS INCREMENTED BY THE VALUE IX2084.2 +149600* FOR THE ACTION LISTED BELOW, E.G., VALUE 20003 WOULD INDICATEIX2084.2 +149700* THAT OF THE 10 EXECUTIONS DURING THE TEST (READING LEFT TO IX2084.2 +149800* RIGHT) 2 INVALID KEY CONDITIONS AND 3 RECORDS RETRIEVED IX2084.2 +149900* AS A RESULT OF THE READ OR START WAS NOT AS EXPECTED. IX2084.2 +150000* IX2084.2 +150100* COMPUTED RESULT INDICATED IX2084.2 +150200* INCREMENTS ACTION IX2084.2 +150300* IX2084.2 +150400* 000001 THE RECORD RETREIVED FROM THE FILE IX2084.2 +150500* FOLLOWING THE READ WAS NOT THE ONE IX2084.2 +150600* EXPECTED. IX2084.2 +150700* IX2084.2 +150800* 000100 INDICATES,BY 10"S THE NUMBER OF TIMES THE IX2084.2 +150900* TEST WAS EXECUTED. IX2084.2 +151000* IX2084.2 +151100* 010000 AN UNEXPECTED INVALID KEY OR AT END IX2084.2 +151200* CONDITION OCCURRED. NOTE - ASSUMPTION IX2084.2 +151300* IS THAT THE "USE" STATEMENT IS ONLY IX2084.2 +151400* EXECUTED WHEN AN INVALID KEY OR AT END IX2084.2 +151500* CONDITION OCCURS AND THE INVALID KEY OR IX2084.2 +151600* AT END PHRASE HAS NOT BEEN SPECIFIED. IX2084.2 +151700* IX2084.2 +151800 START-END. IX2084.2 +151900 CLOSE IX-FD1. IX2084.2 +152000 CLOSE IX-FS2. IX2084.2 +152100 INX-EXIT-003. IX2084.2 +152200 EXIT. IX2084.2 +152300 CCVS-EXIT SECTION. IX2084.2 +152400 CCVS-999999. IX2084.2 +152500 GO TO CLOSE-FILES. IX2084.2 diff --git a/tests/cobol85/IX/IX209A.CBL b/tests/cobol85/IX/IX209A.CBL new file mode 100755 index 00000000..f44ccaf3 --- /dev/null +++ b/tests/cobol85/IX/IX209A.CBL @@ -0,0 +1,2859 @@ +000100 IDENTIFICATION DIVISION. IX2094.2 +000200 PROGRAM-ID. IX2094.2 +000300 IX209A. IX2094.2 +000400**************************************************************** IX2094.2 +000500* * IX2094.2 +000600* VALIDATION FOR:- * IX2094.2 +000700* * IX2094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2094.2 +000900* * IX2094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2094.2 +001100* * IX2094.2 +001200**************************************************************** IX2094.2 +001300* * IX2094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2094.2 +001500* * IX2094.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2094.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2094.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2094.2 +001900* * IX2094.2 +002000**************************************************************** IX2094.2 +002100* "IX209A" IX2094.2 +002200******************************************************************IX2094.2 +002300* THE PURPOSE OF THIS PROGRAM IS TO TEST USE OF THE IX2094.2 +002400* START --- EQUAL TO --- STATEMENT USING FIRST THE PRIME IX2094.2 +002500* RECORD KEY AND THEN WITH EACH OF THE ALTERNATE RECORD KEYS IX2094.2 +002600* AS THE KEY OF REFERENCE. THE START STATEMENT NAMES, IX2094.2 +002700* IN ITS CONSTRUCT , EITHER THE DATA NAME SPECIFIED IN THE IX2094.2 +002800* KEY CLAUSE OR A DATA ITEM THAT IS SUBORDINATE TO THE IX2094.2 +002900* KEY NAME. DIFFERENT KEY VALUES ARE USED FOR TESTING. IX2094.2 +003000* IF A KEY VALUE IS PROVIDED WHICH MATCHES A RECORD IN THE FILEIX2094.2 +003100* WHEN THE START IS EXECUTED THEN THE RECORD IS EXPECTED TO IX2094.2 +003200* MADE AVAILABLE BY THE SUBSEQUENT READ STATEMENT. IF A KEY IX2094.2 +003300* VALUE IS PROVIDED WHICH DOES NOT MATCH ANY RECORD IN THE IX2094.2 +003400* FILE THEN THE INVALID KEY PATH IS EXPECTED TO BE TAKEN. IX2094.2 +003500* THE FILE STATUS CONTENTS RESULTING FROM EXECUTION OF THE IX2094.2 +003600* START TESTS ARE SAVED AND CHECKED IN LATER TESTS. IX2094.2 +003700* IX2094.2 +003800* REFERENCE AMERICAN NATIONAL STANDARD IX2094.2 +003900* PROGRAMMING LANGUAGE COBOL, X3.23-198X. IX2094.2 +004000* SECTION IX, INDEX I-O, THE START IX2094.2 +004100* STATEMENT. PARAGRAPHS 4.7.3 (3), (4); IX2094.2 +004200* 4.7.4 (1), (4), (5)IX2094.2 +004300* AND IX2094.2 +004400* THE FILE STATUS PARAGRAPH 1.3.4 IX2094.2 +004500* IX2094.2 +004600* BEFORE EXECUTION OF THE START IN EACH TEST, A RECORD IS MADE IX2094.2 +004700* AVAILABLE FROM THE FILE THAT IS DIFFERENT THAN WILL RESULT IX2094.2 +004800* FROM THE TEST, AND THE RECORD KEY IS LOADED WITH A KEY VALUE.IX2094.2 +004900* DEPENDING ON THE NATURE OF THE TEST THE KEY VALUE MAY OR IX2094.2 +005000* MAY NOT BE A VALID KEY FOR THE FILE. IX2094.2 +005100* IX2094.2 +005200* THIS PROGRAM FIRST CREATES AN INDEXED SEQUENTIAL FILE IX2094.2 +005300* CONTAINING TWO ALTERNATE KEYS AND THE ONE REQUIRED RECORD IX2094.2 +005400* KEY FOR THE FILE. IMMEDIATELY FOLLOWING FILE CREATION THE IX2094.2 +005500* FILE IS READ AND THE RECORDS OF THE FILE VERIFIED FOR IX2094.2 +005600* ACCURACY. NEXT THE TESTS ARE EXECUTED USING THE START --- IX2094.2 +005700* EQUAL TO --- STATEMENT. IX2094.2 +005800* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2094.2 +005900* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA IX2094.2 +006000* CONTENTS FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN IX2094.2 +006100* THE FILE. IX2094.2 +006200* IX2094.2 +006300* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2094.2 +006400* ------ ---------- --------------- --------------- IX2094.2 +006500* 001 BBBBBBBBBC002 EEEEEEEEEF000ALTKEY1 WWWWWWWWWV398ALTKEY2IX2094.2 +006600* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2094.2 +006700* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2094.2 +006800* . . . . IX2094.2 +006900* . . . . IX2094.2 +007000* . . . . IX2094.2 +007100* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2094.2 +007200* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2094.2 +007300* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2094.2 +007400* . . . . IX2094.2 +007500* . . . . IX2094.2 +007600* . . . . IX2094.2 +007700* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEY2IX2094.2 +007800* IX2094.2 +007900* NOTE 1 - ALTERNATE KEY NUMBER 2 CONTAINS DUPLICATE KEYS IX2094.2 +008000* EVERY 10TH AND 11TH RECORDS. IX2094.2 +008100* IX2094.2 +008200* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE IX2094.2 +008300* FILE FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE MIDDLEIX2094.2 +008400* 125 RECORDS ONLY THE NUMBER PART OF THE KEYS ARE VARIED IX2094.2 +008500* AND VARIED IN THE SEQUENCE SHOWN ABOVE. THAT IS, RECORD-KEY IX2094.2 +008600* AND ALTERNATE-KEY-1 ARE INCREMENTED BY 2 AND THE ALTERNATE- IX2094.2 +008700* KEY-2 IS DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO IX2094.2 +008800* THE FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO THAT IX2094.2 +008900* AN I-O OPERATION IS REQUIRED FOR EACH RECORD ACCESSED FROM IX2094.2 +009000* THE FILE. IX2094.2 +009100* IX2094.2 +009200* FILE CHARACTERISTICS ARE: FILE SIZE = 200 RECORDS IX2094.2 +009300* RECORD SIZE = 240 CHARS. IX2094.2 +009400* RECORD KEY SIZE = 13 CHARS. IX2094.2 +009500* ALTERNATE KEY 1 SIZE = 20 CHARS. IX2094.2 +009600* ALTERNATE KEY 2 SIZE = 20 CHARS. IX2094.2 +009700* ACCESS MODE = SEQUENTIAL IX2094.2 +009800* IX2094.2 +009900* A LIST OF COBOL ELEMENTS WITH THE PARAGRAPH NAME IN PARENTH- IX2094.2 +010000* ESIS THAT TESTS THE ELEMENT AND A SHORT DESCRIPTION OF THE IX2094.2 +010100* TEST FOLLOWS. IX2094.2 +010200* IX2094.2 +010300* WRITE --- INVALID KEY---. (INX-TEST-001) - THIS TEST CREATEIX2094.2 +010400* A FILE OF 200 RECORDS CONTAINING ONE RECORD KEY AND IX2094.2 +010500* TWO ALTERNATE KEYS. IX2094.2 +010600* READ ---AT END ---. (INX-TEST-002) - THIS TEST READS THE IX2094.2 +010700* FILE CREATED IN INX-TEST-001 AND VERIFIES THAT THE IX2094.2 +010800* FILE WAS CREATED CORRECTLY. IX2094.2 +010900* START --- KEY IS EQUAL TO RECORD-KEY INVALID KEY ---. (INX-IX2094.2 +011000* TEST-003.01 THRU INX-TEST-003.04) - THE START IX2094.2 +011100* STATEMENT IS EXECUTED USING THE RECORD-KEY FOR THE IX2094.2 +011200* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +011300* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2094.2 +011400* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2094.2 +011500* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2094.2 +011600* FILE (.04). IX2094.2 +011700* START --- KEY IS EQUAL TO DATA-ITEM INVALID KEY ---. (INX-IX2094.2 +011800* TEST-003.05 THRU INX-TEST-003.09) - THE START IX2094.2 +011900* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2094.2 +012000* SUBORDINATE TO THE RECORD-KEY NAME OF THE FILE IX2094.2 +012100* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +012200* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2094.2 +012300* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2094.2 +012400* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2094.2 +012500* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2094.2 +012600* THE LAST RECORD IN THE FILE (.09. IX2094.2 +012700* FILE STATUS. (INX-TEST-004.01 THRU INX-TEST-004.09) - THESEIX2094.2 +012800* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2094.2 +012900* FROM THE START IN INX-TEST-003.01 THRU IX2094.2 +013000* INX-TEST-003.09. IX2094.2 +013100* START --- KEY IS EQUAL TO ALTNATE-KEY INVALID KEY --. (INX-IX2094.2 +013200* TEST-005.01 THRU INX-TEST-005.04) - THE START IX2094.2 +013300* STATEMENT IS EXECUTED USING THE ALTERNATE-KEY FOR THEIX2094.2 +013400* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +013500* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2094.2 +013600* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2094.2 +013700* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2094.2 +013800* FILE (.04). IX2094.2 +013900* START --- KEY IS EQUAL TO DATA-ITEM INVALID KEY ---. (INX-IX2094.2 +014000* TEST-005.05 THRU INX-TEST-005.09) - THE START IX2094.2 +014100* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2094.2 +014200* SUBORDINATE TO THE ALTERNATE-KEY NAME OF THE FILE IX2094.2 +014300* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +014400* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2094.2 +014500* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2094.2 +014600* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2094.2 +014700* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2094.2 +014800* THE LAST RECORD IN THE FILE (.09. IX2094.2 +014900* FILE STATUS. (INX-TEST-006.01 THRU INX-TEST-006.09) - THESEIX2094.2 +015000* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2094.2 +015100* FROM THE START IN INX-TEST-005.01 THRU IX2094.2 +015200* INX-TEST-005.09. IX2094.2 +015300* START --- KEY IS EQUAL TO ALTNATE-KEY INVALID KEY --. (INX-IX2094.2 +015400* TEST-007.01 THRU INX-TEST-007.04) - THE START IX2094.2 +015500* STATEMENT IS EXECUTED USING THE ALTERNATE-KEY IX2094.2 +015600* WHICH SPECIFIES THE DUPLICATES OPTION FOR THE FILE IX2094.2 +015700* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +015800* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2094.2 +015900* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2094.2 +016000* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2094.2 +016100* FILE (.04). IX2094.2 +016200* START --- KEY IS EQUAL TO DATA-ITEM INVALID KEY ---. (INX-IX2094.2 +016300* TEST-007.05 THRU INX-TEST-007.09) - THE START IX2094.2 +016400* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2094.2 +016500* SUBORDINATE TO THE ALTERNATE-KEY W/DUP FOR THE FILE IX2094.2 +016600* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2094.2 +016700* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2094.2 +016800* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2094.2 +016900* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2094.2 +017000* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2094.2 +017100* THE LAST RECORD IN THE FILE (.09. IX2094.2 +017200* FILE STATUS. (INX-TEST-008.01 THRU INX-TEST-008.09) - THESEIX2094.2 +017300* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2094.2 +017400* FROM THE START IN INX-TEST-007.01 THRU IX2094.2 +017500* INX-TEST-007.09. IX2094.2 +017600* IX2094.2 +017700******************************************************************IX2094.2 +017800 ENVIRONMENT DIVISION. IX2094.2 +017900 CONFIGURATION SECTION. IX2094.2 +018000 SOURCE-COMPUTER. IX2094.2 +018100 Linux. IX2094.2 +018200 OBJECT-COMPUTER. IX2094.2 +018300 Linux. IX2094.2 +018400 INPUT-OUTPUT SECTION. IX2094.2 +018500 FILE-CONTROL. IX2094.2 +018600*P SELECT RAW-DATA ASSIGN TO IX2094.2 +018700*P "XXXXX062" IX2094.2 +018800*P ORGANIZATION IS INDEXED IX2094.2 +018900*P ACCESS MODE IS RANDOM IX2094.2 +019000*P RECORD KEY IS RAW-DATA-KEY. IX2094.2 +019100 SELECT PRINT-FILE ASSIGN TO IX2094.2 +019200 "report.log". IX2094.2 +019300 SELECT IX-FS1 IX2094.2 +019400 ASSIGN TO IX2094.2 +019500 "XXXXX024" IX2094.2 +019600*J **** X-CARD UNDEFINED **** IX2094.2 +019700 ACCESS MODE IS SEQUENTIAL IX2094.2 +019800 ORGANIZATION IS INDEXED IX2094.2 +019900 RECORD KEY IS IX-FS1-KEY IX2094.2 +020000 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY1 IX2094.2 +020100 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY2 WITH DUPLICATES IX2094.2 +020200 FILE STATUS IS FS1-STATUS. IX2094.2 +020300 DATA DIVISION. IX2094.2 +020400 FILE SECTION. IX2094.2 +020500*P IX2094.2 +020600*PD RAW-DATA. IX2094.2 +020700*P IX2094.2 +020800*P1 RAW-DATA-SATZ. IX2094.2 +020900*P 05 RAW-DATA-KEY PIC X(6). IX2094.2 +021000*P 05 C-DATE PIC 9(6). IX2094.2 +021100*P 05 C-TIME PIC 9(8). IX2094.2 +021200*P 05 C-NO-OF-TESTS PIC 99. IX2094.2 +021300*P 05 C-OK PIC 999. IX2094.2 +021400*P 05 C-ALL PIC 999. IX2094.2 +021500*P 05 C-FAIL PIC 999. IX2094.2 +021600*P 05 C-DELETED PIC 999. IX2094.2 +021700*P 05 C-INSPECT PIC 999. IX2094.2 +021800*P 05 C-NOTE PIC X(13). IX2094.2 +021900*P 05 C-INDENT PIC X. IX2094.2 +022000*P 05 C-ABORT PIC X(8). IX2094.2 +022100 FD PRINT-FILE. IX2094.2 +022200 01 PRINT-REC PICTURE X(120). IX2094.2 +022300 01 DUMMY-RECORD PICTURE X(120). IX2094.2 +022400 FD IX-FS1 IX2094.2 +022500*C LABEL RECORDS ARE STANDARD IX2094.2 +022600*C DATA RECORD IS IX-FS1R1-F-G-240 IX2094.2 +022700 RECORD CONTAINS 240 CHARACTERS. IX2094.2 +022800 01 IX-FS1R1-F-G-240. IX2094.2 +022900 05 IX-FS1-REC-120 PICTURE X(120). IX2094.2 +023000 05 IX-FS1-REC-121-240. IX2094.2 +023100 10 FILLER PICTURE X(8). IX2094.2 +023200 10 IX-REC-KEY-AREA. IX2094.2 +023300 15 IX-FS1-KEY. IX2094.2 +023400 20 IX-FS1-KEY-1-10. IX2094.2 +023500 25 IX-FS1-KEY-1-5 PICTURE X(5). IX2094.2 +023600 25 IX-FS1-KEY-6-10 PICTURE X(5). IX2094.2 +023700 20 IX-FS1-KEY-11-13 PICTURE X(3). IX2094.2 +023800 15 FILLER PICTURE X(16). IX2094.2 +023900 10 FILLER PICTURE X(9). IX2094.2 +024000 10 IX-ALT-KEY1-AREA. IX2094.2 +024100 15 IX-FS1-ALTKEY1. IX2094.2 +024200 20 IX-FS1-ALTKEY1-1-10. IX2094.2 +024300 25 IX-FS1-ALTKEY1-1-5 PICTURE X(5). IX2094.2 +024400 25 IX-FS1-ALTKEY1-6-10 PICTURE X(5). IX2094.2 +024500 20 IX-FS1-ALTKEY1-11-13 PICTURE X(3). IX2094.2 +024600 20 IX-FS1-ALTKEY1-14-20 PICTURE X(7). IX2094.2 +024700 15 FILLER PICTURE X(9). IX2094.2 +024800 10 FILLER PICTURE X(9). IX2094.2 +024900 10 IX-ALT-KEY2-AREA. IX2094.2 +025000 15 IX-FS1-ALTKEY2. IX2094.2 +025100 20 IX-FS1-ALTKEY2-1-10. IX2094.2 +025200 25 IX-FS1-ALTKEY2-1-5 PICTURE X(5). IX2094.2 +025300 25 IX-FS1-ALTKEY2-6-10 PICTURE X(5). IX2094.2 +025400 20 IX-FS1-ALTKEY2-11-13 PICTURE X(3). IX2094.2 +025500 20 IX-FS1-ALTKEY2-14-20 PICTURE X(7). IX2094.2 +025600 15 FILLER PICTURE X(9). IX2094.2 +025700 10 FILLER PICTURE X(7). IX2094.2 +025800 WORKING-STORAGE SECTION. IX2094.2 +025900 01 WRK-FS1-RECKEY. IX2094.2 +026000 05 FS1-RECKEY-1-13. IX2094.2 +026100 10 FS1-RECKEY-1-10 PICTURE X(10). IX2094.2 +026200 10 FS1-RECKEY-11-13 PICTURE 9(3). IX2094.2 +026300 05 FILLER PICTURE X(16) VALUE SPACE. IX2094.2 +026400 01 WRK-FS1-ALTKEY1. IX2094.2 +026500 05 FS1-ALTKEY1-1-20. IX2094.2 +026600 10 FS1-ALTKEY1-1-10. IX2094.2 +026700 15 FS1-ALTKEY1-1-5 PICTURE X(5). IX2094.2 +026800 15 FS1-ALTKEY1-6-10 PICTURE X(5). IX2094.2 +026900 10 FS1-ALTKEY1-11-13 PICTURE 9(3). IX2094.2 +027000 10 FS1-ALTKEY1-14-20 PICTURE X(7). IX2094.2 +027100 05 FILLER PICTURE X(9) VALUE SPACE. IX2094.2 +027200 01 WRK-FS1-ALTKEY2. IX2094.2 +027300 05 FS1-ALTKEY2-1-20. IX2094.2 +027400 10 FS1-ALTKEY2-1-10. IX2094.2 +027500 15 FS1-ALTKEY2-1-5 PICTURE X(5). IX2094.2 +027600 15 FS1-ALTKEY2-6-10 PICTURE X(5). IX2094.2 +027700 10 FS1-ALTKEY2-11-13 PICTURE 9(3). IX2094.2 +027800 10 FS1-ALTKEY2-14-20 PICTURE X(7). IX2094.2 +027900 05 FILLER PICTURE X(9) VALUE SPACE. IX2094.2 +028000 01 RECNO PICTURE 9(5) VALUE ZERO. IX2094.2 +028100 01 FS1-STATUS PICTURE XX VALUE SPACE. IX2094.2 +028200 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2094.2 +028300 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2094.2 +028400 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2094.2 +028500 01 RECORDS-WRITTEN PICTURE 9(3). IX2094.2 +028600 01 RECKEY-NUM PICTURE 9(3). IX2094.2 +028700 01 ALTKEY1-NUM PICTURE 9(3). IX2094.2 +028800 01 ALTKEY2-NUM PICTURE 9(3). IX2094.2 +028900 01 RECORD-KEY-CONTENT. IX2094.2 +029000 05 FILLER PIC X(53) VALUE IX2094.2 +029100 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2094.2 +029200 05 FILLER PIC X(53) VALUE IX2094.2 +029300 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2094.2 +029400 05 FILLER PIC X(53) VALUE IX2094.2 +029500 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2094.2 +029600 05 FILLER PIC X(53) VALUE IX2094.2 +029700 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2094.2 +029800 05 FILLER PIC X(53) VALUE IX2094.2 +029900 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2094.2 +030000 05 FILLER PIC X(53) VALUE IX2094.2 +030100 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2094.2 +030200 05 FILLER PIC X(53) VALUE IX2094.2 +030300 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2094.2 +030400 05 FILLER PIC X(53) VALUE IX2094.2 +030500 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2094.2 +030600 05 FILLER PIC X(53) VALUE IX2094.2 +030700 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2094.2 +030800 05 FILLER PIC X(53) VALUE IX2094.2 +030900 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2094.2 +031000 05 FILLER PIC X(53) VALUE IX2094.2 +031100 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2094.2 +031200 05 FILLER PIC X(53) VALUE IX2094.2 +031300 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2094.2 +031400 05 FILLER PIC X(53) VALUE IX2094.2 +031500 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2094.2 +031600 05 FILLER PIC X(53) VALUE IX2094.2 +031700 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2094.2 +031800 05 FILLER PIC X(53) VALUE IX2094.2 +031900 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2094.2 +032000 05 FILLER PIC X(53) VALUE IX2094.2 +032100 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2094.2 +032200 05 FILLER PIC X(53) VALUE IX2094.2 +032300 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2094.2 +032400 05 FILLER PIC X(53) VALUE IX2094.2 +032500 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2094.2 +032600 05 FILLER PIC X(53) VALUE IX2094.2 +032700 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2094.2 +032800 05 FILLER PIC X(53) VALUE IX2094.2 +032900 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2094.2 +033000 05 FILLER PIC X(53) VALUE IX2094.2 +033100 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2094.2 +033200 05 FILLER PIC X(53) VALUE IX2094.2 +033300 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2094.2 +033400 05 FILLER PIC X(53) VALUE IX2094.2 +033500 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2094.2 +033600 05 FILLER PIC X(53) VALUE IX2094.2 +033700 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2094.2 +033800 05 FILLER PIC X(53) VALUE IX2094.2 +033900 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2094.2 +034000 05 FILLER PIC X(53) VALUE IX2094.2 +034100 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2094.2 +034200 05 FILLER PIC X(53) VALUE IX2094.2 +034300 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2094.2 +034400 05 FILLER PIC X(53) VALUE IX2094.2 +034500 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2094.2 +034600 05 FILLER PIC X(53) VALUE IX2094.2 +034700 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2094.2 +034800 05 FILLER PIC X(53) VALUE IX2094.2 +034900 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2094.2 +035000 05 FILLER PIC X(53) VALUE IX2094.2 +035100 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2094.2 +035200 05 FILLER PIC X(53) VALUE IX2094.2 +035300 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2094.2 +035400 05 FILLER PIC X(53) VALUE IX2094.2 +035500 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2094.2 +035600 05 FILLER PIC X(53) VALUE IX2094.2 +035700 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2094.2 +035800 05 FILLER PIC X(53) VALUE IX2094.2 +035900 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2094.2 +036000 05 FILLER PIC X(53) VALUE IX2094.2 +036100 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2094.2 +036200 05 FILLER PIC X(53) VALUE IX2094.2 +036300 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2094.2 +036400 05 FILLER PIC X(53) VALUE IX2094.2 +036500 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2094.2 +036600 05 FILLER PIC X(53) VALUE IX2094.2 +036700 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2094.2 +036800 05 FILLER PIC X(53) VALUE IX2094.2 +036900 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2094.2 +037000 05 FILLER PIC X(53) VALUE IX2094.2 +037100 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2094.2 +037200 05 FILLER PIC X(53) VALUE IX2094.2 +037300 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2094.2 +037400 05 FILLER PIC X(53) VALUE IX2094.2 +037500 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2094.2 +037600 05 FILLER PIC X(53) VALUE IX2094.2 +037700 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2094.2 +037800 05 FILLER PIC X(53) VALUE IX2094.2 +037900 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2094.2 +038000 05 FILLER PIC X(53) VALUE IX2094.2 +038100 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2094.2 +038200 05 FILLER PIC X(53) VALUE IX2094.2 +038300 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2094.2 +038400 05 FILLER PIC X(53) VALUE IX2094.2 +038500 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2094.2 +038600 05 FILLER PIC X(53) VALUE IX2094.2 +038700 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2094.2 +038800 05 FILLER PIC X(53) VALUE IX2094.2 +038900 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2094.2 +039000 05 FILLER PIC X(53) VALUE IX2094.2 +039100 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2094.2 +039200 05 FILLER PIC X(53) VALUE IX2094.2 +039300 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2094.2 +039400 05 FILLER PIC X(53) VALUE IX2094.2 +039500 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2094.2 +039600 05 FILLER PIC X(53) VALUE IX2094.2 +039700 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2094.2 +039800 05 FILLER PIC X(53) VALUE IX2094.2 +039900 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2094.2 +040000 05 FILLER PIC X(53) VALUE IX2094.2 +040100 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2094.2 +040200 05 FILLER PIC X(53) VALUE IX2094.2 +040300 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2094.2 +040400 05 FILLER PIC X(53) VALUE IX2094.2 +040500 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2094.2 +040600 05 FILLER PIC X(53) VALUE IX2094.2 +040700 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2094.2 +040800 05 FILLER PIC X(53) VALUE IX2094.2 +040900 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2094.2 +041000 05 FILLER PIC X(53) VALUE IX2094.2 +041100 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2094.2 +041200 05 FILLER PIC X(53) VALUE IX2094.2 +041300 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2094.2 +041400 05 FILLER PIC X(53) VALUE IX2094.2 +041500 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2094.2 +041600 05 FILLER PIC X(53) VALUE IX2094.2 +041700 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2094.2 +041800 05 FILLER PIC X(53) VALUE IX2094.2 +041900 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2094.2 +042000 05 FILLER PIC X(53) VALUE IX2094.2 +042100 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2094.2 +042200 05 FILLER PIC X(53) VALUE IX2094.2 +042300 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2094.2 +042400 05 FILLER PIC X(53) VALUE IX2094.2 +042500 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2094.2 +042600 05 FILLER PIC X(53) VALUE IX2094.2 +042700 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2094.2 +042800 05 FILLER PIC X(53) VALUE IX2094.2 +042900 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2094.2 +043000 05 FILLER PIC X(53) VALUE IX2094.2 +043100 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2094.2 +043200 05 FILLER PIC X(53) VALUE IX2094.2 +043300 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2094.2 +043400 05 FILLER PIC X(53) VALUE IX2094.2 +043500 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2094.2 +043600 05 FILLER PIC X(53) VALUE IX2094.2 +043700 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2094.2 +043800 05 FILLER PIC X(53) VALUE IX2094.2 +043900 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2094.2 +044000 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2094.2 +044100 05 KEY-VALUES OCCURS 75 TIMES. IX2094.2 +044200 10 RECKEY-VALUE PICTURE X(13). IX2094.2 +044300 10 ALTKEY1-VALUE PICTURE X(20). IX2094.2 +044400 10 ALTKEY2-VALUE PICTURE X(20). IX2094.2 +044500 01 INIT-FLAG PICTURE 9. IX2094.2 +044600 01 HOLD-FILESTATUS-RECORD. IX2094.2 +044700 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX2094.2 +044800 01 FILE-RECORD-INFORMATION-REC. IX2094.2 +044900 03 FILE-RECORD-INFO-SKELETON. IX2094.2 +045000 05 FILLER PICTURE X(48) VALUE IX2094.2 +045100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2094.2 +045200 05 FILLER PICTURE X(46) VALUE IX2094.2 +045300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2094.2 +045400 05 FILLER PICTURE X(26) VALUE IX2094.2 +045500 ",LFIL=000000,ORG= ,LBLR= ". IX2094.2 +045600 05 FILLER PICTURE X(37) VALUE IX2094.2 +045700 ",RECKEY= ". IX2094.2 +045800 05 FILLER PICTURE X(38) VALUE IX2094.2 +045900 ",ALTKEY1= ". IX2094.2 +046000 05 FILLER PICTURE X(38) VALUE IX2094.2 +046100 ",ALTKEY2= ". IX2094.2 +046200 05 FILLER PICTURE X(7) VALUE SPACE.IX2094.2 +046300 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2094.2 +046400 05 FILE-RECORD-INFO-P1-120. IX2094.2 +046500 07 FILLER PIC X(5). IX2094.2 +046600 07 XFILE-NAME PIC X(6). IX2094.2 +046700 07 FILLER PIC X(8). IX2094.2 +046800 07 XRECORD-NAME PIC X(6). IX2094.2 +046900 07 FILLER PIC X(1). IX2094.2 +047000 07 REELUNIT-NUMBER PIC 9(1). IX2094.2 +047100 07 FILLER PIC X(7). IX2094.2 +047200 07 XRECORD-NUMBER PIC 9(6). IX2094.2 +047300 07 FILLER PIC X(6). IX2094.2 +047400 07 UPDATE-NUMBER PIC 9(2). IX2094.2 +047500 07 FILLER PIC X(5). IX2094.2 +047600 07 ODO-NUMBER PIC 9(4). IX2094.2 +047700 07 FILLER PIC X(5). IX2094.2 +047800 07 XPROGRAM-NAME PIC X(5). IX2094.2 +047900 07 FILLER PIC X(7). IX2094.2 +048000 07 XRECORD-LENGTH PIC 9(6). IX2094.2 +048100 07 FILLER PIC X(7). IX2094.2 +048200 07 CHARS-OR-RECORDS PIC X(2). IX2094.2 +048300 07 FILLER PIC X(1). IX2094.2 +048400 07 XBLOCK-SIZE PIC 9(4). IX2094.2 +048500 07 FILLER PIC X(6). IX2094.2 +048600 07 RECORDS-IN-FILE PIC 9(6). IX2094.2 +048700 07 FILLER PIC X(5). IX2094.2 +048800 07 XFILE-ORGANIZATION PIC X(2). IX2094.2 +048900 07 FILLER PIC X(6). IX2094.2 +049000 07 XLABEL-TYPE PIC X(1). IX2094.2 +049100 05 FILE-RECORD-INFO-P121-240. IX2094.2 +049200 07 FILLER PIC X(8). IX2094.2 +049300 07 XRECORD-KEY PIC X(29). IX2094.2 +049400 07 FILLER PIC X(9). IX2094.2 +049500 07 ALTERNATE-KEY1 PIC X(29). IX2094.2 +049600 07 FILLER PIC X(9). IX2094.2 +049700 07 ALTERNATE-KEY2 PIC X(29). IX2094.2 +049800 07 FILLER PIC X(7). IX2094.2 +049900 01 TEST-RESULTS. IX2094.2 +050000 02 FILLER PIC X VALUE SPACE. IX2094.2 +050100 02 FEATURE PIC X(20) VALUE SPACE. IX2094.2 +050200 02 FILLER PIC X VALUE SPACE. IX2094.2 +050300 02 P-OR-F PIC X(5) VALUE SPACE. IX2094.2 +050400 02 FILLER PIC X VALUE SPACE. IX2094.2 +050500 02 PAR-NAME. IX2094.2 +050600 03 FILLER PIC X(19) VALUE SPACE. IX2094.2 +050700 03 PARDOT-X PIC X VALUE SPACE. IX2094.2 +050800 03 DOTVALUE PIC 99 VALUE ZERO. IX2094.2 +050900 02 FILLER PIC X(8) VALUE SPACE. IX2094.2 +051000 02 RE-MARK PIC X(61). IX2094.2 +051100 01 TEST-COMPUTED. IX2094.2 +051200 02 FILLER PIC X(30) VALUE SPACE. IX2094.2 +051300 02 FILLER PIC X(17) VALUE IX2094.2 +051400 " COMPUTED=". IX2094.2 +051500 02 COMPUTED-X. IX2094.2 +051600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2094.2 +051700 03 COMPUTED-N REDEFINES COMPUTED-A IX2094.2 +051800 PIC -9(9).9(9). IX2094.2 +051900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2094.2 +052000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2094.2 +052100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2094.2 +052200 03 CM-18V0 REDEFINES COMPUTED-A. IX2094.2 +052300 04 COMPUTED-18V0 PIC -9(18). IX2094.2 +052400 04 FILLER PIC X. IX2094.2 +052500 03 FILLER PIC X(50) VALUE SPACE. IX2094.2 +052600 01 TEST-CORRECT. IX2094.2 +052700 02 FILLER PIC X(30) VALUE SPACE. IX2094.2 +052800 02 FILLER PIC X(17) VALUE " CORRECT =". IX2094.2 +052900 02 CORRECT-X. IX2094.2 +053000 03 CORRECT-A PIC X(20) VALUE SPACE. IX2094.2 +053100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2094.2 +053200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2094.2 +053300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2094.2 +053400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2094.2 +053500 03 CR-18V0 REDEFINES CORRECT-A. IX2094.2 +053600 04 CORRECT-18V0 PIC -9(18). IX2094.2 +053700 04 FILLER PIC X. IX2094.2 +053800 03 FILLER PIC X(2) VALUE SPACE. IX2094.2 +053900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2094.2 +054000 01 CCVS-C-1. IX2094.2 +054100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2094.2 +054200- "SS PARAGRAPH-NAME IX2094.2 +054300- " REMARKS". IX2094.2 +054400 02 FILLER PIC X(20) VALUE SPACE. IX2094.2 +054500 01 CCVS-C-2. IX2094.2 +054600 02 FILLER PIC X VALUE SPACE. IX2094.2 +054700 02 FILLER PIC X(6) VALUE "TESTED". IX2094.2 +054800 02 FILLER PIC X(15) VALUE SPACE. IX2094.2 +054900 02 FILLER PIC X(4) VALUE "FAIL". IX2094.2 +055000 02 FILLER PIC X(94) VALUE SPACE. IX2094.2 +055100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2094.2 +055200 01 REC-CT PIC 99 VALUE ZERO. IX2094.2 +055300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2094.2 +055400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2094.2 +055500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2094.2 +055600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2094.2 +055700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2094.2 +055800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2094.2 +055900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2094.2 +056000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2094.2 +056100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2094.2 +056200 01 CCVS-H-1. IX2094.2 +056300 02 FILLER PIC X(39) VALUE SPACES. IX2094.2 +056400 02 FILLER PIC X(42) VALUE IX2094.2 +056500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2094.2 +056600 02 FILLER PIC X(39) VALUE SPACES. IX2094.2 +056700 01 CCVS-H-2A. IX2094.2 +056800 02 FILLER PIC X(40) VALUE SPACE. IX2094.2 +056900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2094.2 +057000 02 FILLER PIC XXXX VALUE IX2094.2 +057100 "4.2 ". IX2094.2 +057200 02 FILLER PIC X(28) VALUE IX2094.2 +057300 " COPY - NOT FOR DISTRIBUTION". IX2094.2 +057400 02 FILLER PIC X(41) VALUE SPACE. IX2094.2 +057500 IX2094.2 +057600 01 CCVS-H-2B. IX2094.2 +057700 02 FILLER PIC X(15) VALUE IX2094.2 +057800 "TEST RESULT OF ". IX2094.2 +057900 02 TEST-ID PIC X(9). IX2094.2 +058000 02 FILLER PIC X(4) VALUE IX2094.2 +058100 " IN ". IX2094.2 +058200 02 FILLER PIC X(12) VALUE IX2094.2 +058300 " HIGH ". IX2094.2 +058400 02 FILLER PIC X(22) VALUE IX2094.2 +058500 " LEVEL VALIDATION FOR ". IX2094.2 +058600 02 FILLER PIC X(58) VALUE IX2094.2 +058700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2094.2 +058800 01 CCVS-H-3. IX2094.2 +058900 02 FILLER PIC X(34) VALUE IX2094.2 +059000 " FOR OFFICIAL USE ONLY ". IX2094.2 +059100 02 FILLER PIC X(58) VALUE IX2094.2 +059200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2094.2 +059300 02 FILLER PIC X(28) VALUE IX2094.2 +059400 " COPYRIGHT 1985 ". IX2094.2 +059500 01 CCVS-E-1. IX2094.2 +059600 02 FILLER PIC X(52) VALUE SPACE. IX2094.2 +059700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2094.2 +059800 02 ID-AGAIN PIC X(9). IX2094.2 +059900 02 FILLER PIC X(45) VALUE SPACES. IX2094.2 +060000 01 CCVS-E-2. IX2094.2 +060100 02 FILLER PIC X(31) VALUE SPACE. IX2094.2 +060200 02 FILLER PIC X(21) VALUE SPACE. IX2094.2 +060300 02 CCVS-E-2-2. IX2094.2 +060400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2094.2 +060500 03 FILLER PIC X VALUE SPACE. IX2094.2 +060600 03 ENDER-DESC PIC X(44) VALUE IX2094.2 +060700 "ERRORS ENCOUNTERED". IX2094.2 +060800 01 CCVS-E-3. IX2094.2 +060900 02 FILLER PIC X(22) VALUE IX2094.2 +061000 " FOR OFFICIAL USE ONLY". IX2094.2 +061100 02 FILLER PIC X(12) VALUE SPACE. IX2094.2 +061200 02 FILLER PIC X(58) VALUE IX2094.2 +061300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2094.2 +061400 02 FILLER PIC X(13) VALUE SPACE. IX2094.2 +061500 02 FILLER PIC X(15) VALUE IX2094.2 +061600 " COPYRIGHT 1985". IX2094.2 +061700 01 CCVS-E-4. IX2094.2 +061800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2094.2 +061900 02 FILLER PIC X(4) VALUE " OF ". IX2094.2 +062000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2094.2 +062100 02 FILLER PIC X(40) VALUE IX2094.2 +062200 " TESTS WERE EXECUTED SUCCESSFULLY". IX2094.2 +062300 01 XXINFO. IX2094.2 +062400 02 FILLER PIC X(19) VALUE IX2094.2 +062500 "*** INFORMATION ***". IX2094.2 +062600 02 INFO-TEXT. IX2094.2 +062700 04 FILLER PIC X(8) VALUE SPACE. IX2094.2 +062800 04 XXCOMPUTED PIC X(20). IX2094.2 +062900 04 FILLER PIC X(5) VALUE SPACE. IX2094.2 +063000 04 XXCORRECT PIC X(20). IX2094.2 +063100 02 INF-ANSI-REFERENCE PIC X(48). IX2094.2 +063200 01 HYPHEN-LINE. IX2094.2 +063300 02 FILLER PIC IS X VALUE IS SPACE. IX2094.2 +063400 02 FILLER PIC IS X(65) VALUE IS "************************IX2094.2 +063500- "*****************************************". IX2094.2 +063600 02 FILLER PIC IS X(54) VALUE IS "************************IX2094.2 +063700- "******************************". IX2094.2 +063800 01 CCVS-PGM-ID PIC X(9) VALUE IX2094.2 +063900 "IX209A". IX2094.2 +064000 PROCEDURE DIVISION. IX2094.2 +064100 CCVS1 SECTION. IX2094.2 +064200 OPEN-FILES. IX2094.2 +064300*P OPEN I-O RAW-DATA. IX2094.2 +064400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2094.2 +064500*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2094.2 +064600*P MOVE "ABORTED " TO C-ABORT. IX2094.2 +064700*P ADD 1 TO C-NO-OF-TESTS. IX2094.2 +064800*P ACCEPT C-DATE FROM DATE. IX2094.2 +064900*P ACCEPT C-TIME FROM TIME. IX2094.2 +065000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2094.2 +065100*PND-E-1. IX2094.2 +065200*P CLOSE RAW-DATA. IX2094.2 +065300 OPEN OUTPUT PRINT-FILE. IX2094.2 +065400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2094.2 +065500 MOVE SPACE TO TEST-RESULTS. IX2094.2 +065600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2094.2 +065700 MOVE ZERO TO REC-SKL-SUB. IX2094.2 +065800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2094.2 +065900 CCVS-INIT-FILE. IX2094.2 +066000 ADD 1 TO REC-SKL-SUB. IX2094.2 +066100 MOVE FILE-RECORD-INFO-SKELETON IX2094.2 +066200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2094.2 +066300 CCVS-INIT-EXIT. IX2094.2 +066400 GO TO CCVS1-EXIT. IX2094.2 +066500 CLOSE-FILES. IX2094.2 +066600*P OPEN I-O RAW-DATA. IX2094.2 +066700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2094.2 +066800*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2094.2 +066900*P MOVE "OK. " TO C-ABORT. IX2094.2 +067000*P MOVE PASS-COUNTER TO C-OK. IX2094.2 +067100*P MOVE ERROR-HOLD TO C-ALL. IX2094.2 +067200*P MOVE ERROR-COUNTER TO C-FAIL. IX2094.2 +067300*P MOVE DELETE-COUNTER TO C-DELETED. IX2094.2 +067400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2094.2 +067500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2094.2 +067600*PND-E-2. IX2094.2 +067700*P CLOSE RAW-DATA. IX2094.2 +067800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2094.2 +067900 TERMINATE-CCVS. IX2094.2 +068000*S EXIT PROGRAM. IX2094.2 +068100*SERMINATE-CALL. IX2094.2 +068200 STOP RUN. IX2094.2 +068300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2094.2 +068400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2094.2 +068500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2094.2 +068600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2094.2 +068700 MOVE "****TEST DELETED****" TO RE-MARK. IX2094.2 +068800 PRINT-DETAIL. IX2094.2 +068900 IF REC-CT NOT EQUAL TO ZERO IX2094.2 +069000 MOVE "." TO PARDOT-X IX2094.2 +069100 MOVE REC-CT TO DOTVALUE. IX2094.2 +069200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2094.2 +069300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2094.2 +069400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2094.2 +069500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2094.2 +069600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2094.2 +069700 MOVE SPACE TO CORRECT-X. IX2094.2 +069800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2094.2 +069900 MOVE SPACE TO RE-MARK. IX2094.2 +070000 HEAD-ROUTINE. IX2094.2 +070100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +070200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +070300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2094.2 +070400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2094.2 +070500 COLUMN-NAMES-ROUTINE. IX2094.2 +070600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +070700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +070800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +070900 END-ROUTINE. IX2094.2 +071000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2094.2 +071100 END-RTN-EXIT. IX2094.2 +071200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +071300 END-ROUTINE-1. IX2094.2 +071400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2094.2 +071500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2094.2 +071600 ADD PASS-COUNTER TO ERROR-HOLD. IX2094.2 +071700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2094.2 +071800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2094.2 +071900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2094.2 +072000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2094.2 +072100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2094.2 +072200 END-ROUTINE-12. IX2094.2 +072300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2094.2 +072400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2094.2 +072500 MOVE "NO " TO ERROR-TOTAL IX2094.2 +072600 ELSE IX2094.2 +072700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2094.2 +072800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2094.2 +072900 PERFORM WRITE-LINE. IX2094.2 +073000 END-ROUTINE-13. IX2094.2 +073100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2094.2 +073200 MOVE "NO " TO ERROR-TOTAL ELSE IX2094.2 +073300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2094.2 +073400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2094.2 +073500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +073600 IF INSPECT-COUNTER EQUAL TO ZERO IX2094.2 +073700 MOVE "NO " TO ERROR-TOTAL IX2094.2 +073800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2094.2 +073900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2094.2 +074000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +074100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2094.2 +074200 WRITE-LINE. IX2094.2 +074300 ADD 1 TO RECORD-COUNT. IX2094.2 +074400 IF RECORD-COUNT GREATER 42 IX2094.2 +074500 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2094.2 +074600 MOVE SPACE TO DUMMY-RECORD IX2094.2 +074700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2094.2 +074800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2094.2 +074900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2094.2 +075000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2094.2 +075100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2094.2 +075200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2094.2 +075300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2094.2 +075400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2094.2 +075500 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2094.2 +075600 MOVE ZERO TO RECORD-COUNT. IX2094.2 +075700 PERFORM WRT-LN. IX2094.2 +075800 WRT-LN. IX2094.2 +075900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2094.2 +076000 MOVE SPACE TO DUMMY-RECORD. IX2094.2 +076100 BLANK-LINE-PRINT. IX2094.2 +076200 PERFORM WRT-LN. IX2094.2 +076300 FAIL-ROUTINE. IX2094.2 +076400 IF COMPUTED-X NOT EQUAL TO SPACE IX2094.2 +076500 GO TO FAIL-ROUTINE-WRITE. IX2094.2 +076600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2094.2 +076700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2094.2 +076800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2094.2 +076900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +077000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2094.2 +077100 GO TO FAIL-ROUTINE-EX. IX2094.2 +077200 FAIL-ROUTINE-WRITE. IX2094.2 +077300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2094.2 +077400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2094.2 +077500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2094.2 +077600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2094.2 +077700 FAIL-ROUTINE-EX. EXIT. IX2094.2 +077800 BAIL-OUT. IX2094.2 +077900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2094.2 +078000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2094.2 +078100 BAIL-OUT-WRITE. IX2094.2 +078200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2094.2 +078300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2094.2 +078400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2094.2 +078500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2094.2 +078600 BAIL-OUT-EX. EXIT. IX2094.2 +078700 CCVS1-EXIT. IX2094.2 +078800 EXIT. IX2094.2 +078900 SECT-0001-IX209A SECTION. IX2094.2 +079000 WRITE-INT-GF-01. IX2094.2 +079100 OPEN OUTPUT IX-FS1. IX2094.2 +079200 MOVE "IX-FS1" TO XFILE-NAME (1). IX2094.2 +079300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2094.2 +079400 MOVE ZERO TO XRECORD-NUMBER (1). IX2094.2 +079500 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2094.2 +079600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2094.2 +079700 MOVE 240 TO XRECORD-LENGTH (1). IX2094.2 +079800 MOVE 001 TO XBLOCK-SIZE (1). IX2094.2 +079900 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2094.2 +080000 MOVE "S" TO XLABEL-TYPE (1). IX2094.2 +080100 MOVE 200 TO RECORDS-IN-FILE (1). IX2094.2 +080200 MOVE "CREATE-FILE-FS1" TO FEATURE. IX2094.2 +080300 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2094.2 +080400 MOVE ZERO TO KEYSUB. IX2094.2 +080500 MOVE ZERO TO INVKEY-COUNTER. IX2094.2 +080600 WRITE-INIT-GF-01-01. IX2094.2 +080700 PERFORM WRITE-TEST-GF-01-1 50 TIMES. IX2094.2 +080800 PERFORM WRITE-TEST-GF-01-2 125 TIMES. IX2094.2 +080900 PERFORM WRITE-TEST-GF-01-1 25 TIMES. IX2094.2 +081000 GO TO WRITE-TEST-GF-01. IX2094.2 +081100 WRITE-TEST-GF-01-1. IX2094.2 +081200 ADD 001 TO XRECORD-NUMBER (1). IX2094.2 +081300 ADD 001 TO KEYSUB. IX2094.2 +081400 MOVE RECKEY-VALUE (KEYSUB) TO FS1-RECKEY-1-13. IX2094.2 +081500 MOVE ALTKEY1-VALUE (KEYSUB) TO FS1-ALTKEY1-1-20. IX2094.2 +081600 MOVE ALTKEY2-VALUE (KEYSUB) TO FS1-ALTKEY2-1-20. IX2094.2 +081700 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2094.2 +081800 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2094.2 +081900 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2094.2 +082000 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2094.2 +082100 WRITE IX-FS1R1-F-G-240 IX2094.2 +082200 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2094.2 +082300 ADD 001 TO EXCUT-COUNTER-06V00. IX2094.2 +082400 WRITE-TEST-GF-01-2. IX2094.2 +082500 ADD 002 TO FS1-RECKEY-11-13. IX2094.2 +082600 ADD 002 TO FS1-ALTKEY1-11-13. IX2094.2 +082700 SUBTRACT 002 FROM FS1-ALTKEY2-11-13. IX2094.2 +082800 ADD 001 TO XRECORD-NUMBER (1). IX2094.2 +082900 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2094.2 +083000 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2094.2 +083100 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2094.2 +083200 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2094.2 +083300 WRITE IX-FS1R1-F-G-240 IX2094.2 +083400 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2094.2 +083500 ADD 001 TO EXCUT-COUNTER-06V00. IX2094.2 +083600 WRITE-TEST-GF-01. IX2094.2 +083700 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2094.2 +083800 GIVING RECORDS-WRITTEN. IX2094.2 +083900 MOVE 200 TO CORRECT-18V0. IX2094.2 +084000 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2094.2 +084100 IF RECORDS-WRITTEN EQUAL TO 200 IX2094.2 +084200 PERFORM PASS IX2094.2 +084300 ELSE IX2094.2 +084400 PERFORM FAIL. IX2094.2 +084500 MOVE "RECORDS IN FILE" TO RE-MARK. IX2094.2 +084600 PERFORM PRINT-DETAIL. IX2094.2 +084700 GO TO WRITE-TEST-GF-01-END. IX2094.2 +084800 WRITE-DELETE-GF-01. IX2094.2 +084900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2094.2 +085000 PERFORM DE-LETE. IX2094.2 +085100 PERFORM PRINT-DETAIL. IX2094.2 +085200 WRITE-TEST-GF-01-END. IX2094.2 +085300 CLOSE IX-FS1. IX2094.2 +085400 READ-INIT-F1-01. IX2094.2 +085500 OPEN INPUT IX-FS1. IX2094.2 +085600 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2094.2 +085700 MOVE "READ FILE IX-FS1" TO FEATURE. IX2094.2 +085800 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2094.2 +085900 MOVE 02 TO RECKEY-NUM. IX2094.2 +086000 MOVE 002 TO ALTKEY1-NUM. IX2094.2 +086100 READ-TEST-F1-01-R1. IX2094.2 +086200 READ IX-FS1 AT END GO TO READ-TEST-F1-01. IX2094.2 +086300 MOVE IX-REC-KEY-AREA TO WRK-FS1-RECKEY. IX2094.2 +086400 MOVE IX-ALT-KEY1-AREA TO WRK-FS1-ALTKEY1. IX2094.2 +086500 IF FS1-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2094.2 +086600 AND FS1-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2094.2 +086700 NEXT SENTENCE IX2094.2 +086800 ELSE IX2094.2 +086900 PERFORM READ-FAIL-F1-01. IX2094.2 +087000 ADD 001 TO EXCUT-COUNTER-06V00. IX2094.2 +087100 ADD 002 TO RECKEY-NUM IX2094.2 +087200 ADD 002 TO ALTKEY1-NUM. IX2094.2 +087300 GO TO READ-TEST-F1-01-R1. IX2094.2 +087400 READ-TEST-F1-01. IX2094.2 +087500 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2094.2 +087600 PERFORM PASS ELSE IX2094.2 +087700 MOVE "IX-28; 4.5.2 OR IX-41; 4.9.2 NOT COORECTLY EXECUTED" IX2094.2 +087800 TO RE-MARK IX2094.2 +087900 PERFORM FAIL. IX2094.2 +088000 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2094.2 +088100 MOVE 200 TO CORRECT-18V0. IX2094.2 +088200 MOVE "RECORDS IN FILE" TO RE-MARK. IX2094.2 +088300 PERFORM PRINT-DETAIL. IX2094.2 +088400 GO TO READ-EXIT-F1-01. IX2094.2 +088500 READ-FAIL-F1-01. IX2094.2 +088600 PERFORM FAIL. IX2094.2 +088700 MOVE FS1-RECKEY-11-13 TO COMPUTED-18V0. IX2094.2 +088800 MOVE RECKEY-NUM TO CORRECT-18V0. IX2094.2 +088900 MOVE "NUM EMBEDDED IN RECKEY" TO RE-MARK. IX2094.2 +089000 PERFORM PRINT-DETAIL. IX2094.2 +089100 READ-EXIT-F1-01. IX2094.2 +089200 CLOSE IX-FS1. IX2094.2 +089300 START-INIT-GF-01. IX2094.2 +089400 OPEN INPUT IX-FS1. IX2094.2 +089500 MOVE "START EQ TO RECKEY" TO FEATURE. IX2094.2 +089600 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2094.2 +089700 MOVE "********************" TO HOLD-FILESTATUS-RECORD. IX2094.2 +089800* IX2094.2 +089900* THIS TEST TESTS THE "START -- EQUAL TO" FOR PROPER POSITIONING IX2094.2 +090000* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2094.2 +090100* START-TEST-GF-01 USE ONLY THE PRIME RECORD KEY FOR ESTABLISHING IX2094.2 +090200* THE CURRENT RECORD POINTER FOR THE FILE. THE FOLLOWING IS A IX2094.2 +090300* SUMMARY OF THE TEST CONDITIONS AND THE EXPECTED ACTION TO BE IX2094.2 +090400* TAKEN FOR THE TESTS. IX2094.2 +090500* IX2094.2 +090600* CONDITIONS (CONTENTS OF KEY) / ACTION IX2094.2 +090700* IX2094.2 +090800* START-TEST-GF-01 - EQUAL A RECORD IN FILE / RECORD FOUND IX2094.2 +090900* START-TEST-GF-02 - BETWEEN 2 EXISTING KEY VALUES / INVALID KEYIX2094.2 +091000* START-TEST-GF-03 - LESS THAN FIRST FILE RECORD / INVALID KEY IX2094.2 +091100* START-TEST-GF-04 - GREATER THAN LAST FILE RECORD / INVALID KEYIX2094.2 +091200* START-TEST-GF-05 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2094.2 +091300* START-TEST-GF-06 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2094.2 +091400* START-TEST-GF-07 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2094.2 +091500* START-TEST-GF-08 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2094.2 +091600* START-TEST-GF-09 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2094.2 +091700* IX2094.2 +091800* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2094.2 +091900* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2094.2 +092000* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2094.2 +092100* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2094.2 +092200* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2094.2 +092300* MATCH RECORDS IN THE FILE. IF KEY MATCH IS EXPECTED FROM IX2094.2 +092400* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2094.2 +092500* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2094.2 +092600* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2094.2 +092700* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2094.2 +092800* IX2094.2 +092900 START-INIT-GF-01-01. IX2094.2 +093000 PERFORM START-INITIALIZE-RECORD. IX2094.2 +093100 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2094.2 +093200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +093300 MOVE "**" TO FILESTATUS (1) IX2094.2 +093400 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +093500 GO TO START-DELETE-GF-01. IX2094.2 +093600 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2094.2 +093700 MOVE "EEEEEFFFFF022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +093800 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +093900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +094000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +094100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +094200 START-TEST-GF-01. IX2094.2 +094300* IX2094.2 +094400* START-TEST-GF-01 - THE START SHOULD FIND A RECORD IN THE FILE IX2094.2 +094500* WHICH HAS A RECORD KEY VALUE OF IX2094.2 +094600* CCCCCCCCCD022 (RECORD NUMBER 11). IX2094.2 +094700* IX2094.2 +094800 START IX-FS1 IX2094.2 +094900 KEY IS EQUAL TO IX-FS1-KEY IX2094.2 +095000 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2094.2 +095100 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +095200 GO TO START-FAIL-GF-01. IX2094.2 +095300 MOVE FS1-STATUS TO FILESTATUS (1). IX2094.2 +095400 READ IX-FS1 AT END IX2094.2 +095500 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +095600 GO TO START-FAIL-GF-01. IX2094.2 +095700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +095800 IF XRECORD-NUMBER (1) EQUAL TO 11 IX2094.2 +095900 PERFORM PASS IX2094.2 +096000 MOVE SPACE TO RE-MARK IX2094.2 +096100 GO TO START-WRITE-GF-01. IX2094.2 +096200 MOVE 11 TO RECNO. IX2094.2 +096300 PERFORM DISPLAY-RECORD-KEYS. IX2094.2 +096400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +096500 START-FAIL-GF-01. IX2094.2 +096600 PERFORM FAIL. IX2094.2 +096700 MOVE 11 TO CORRECT-18V0. IX2094.2 +096800 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +096900 GO TO START-WRITE-GF-01. IX2094.2 +097000 START-DELETE-GF-01. IX2094.2 +097100 PERFORM DE-LETE. IX2094.2 +097200 START-WRITE-GF-01. IX2094.2 +097300 PERFORM PRINT-DETAIL. IX2094.2 +097400 START-INIT-GF-02. IX2094.2 +097500 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2094.2 +097600 PERFORM START-INITIALIZE-RECORD. IX2094.2 +097700 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +097800 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +097900 MOVE "**" TO FILESTATUS (2) IX2094.2 +098000 GO TO START-DELETE-GF-02. IX2094.2 +098100 MOVE "EEEEEEEFFF067" TO FS1-RECKEY-1-13. IX2094.2 +098200 MOVE "HHHHHHHIII066ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +098300 MOVE "TTTTTTTSSS334ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +098400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +098500 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +098600 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +098700 START-TEST-GF-02. IX2094.2 +098800* IX2094.2 +098900* START-TEST-GF-02 - THE START SHOULD NOT FIND A RECORD IN THE IX2094.2 +099000* FILE WHICH HAS A RECORD KEY VALUE OF IX2094.2 +099100* "EEEEEEEFFF067". THIS KEY VALUE IS IX2094.2 +099200* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2094.2 +099300* EXISTING RECORD KEYS IN THE FILE. IX2094.2 +099400* IX2094.2 +099500 START IX-FS1 IX2094.2 +099600 KEY IS EQUAL TO IX-FS1-KEY IX2094.2 +099700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2094.2 +099800 GO TO START-PASS-GF-02. IX2094.2 +099900 MOVE FS1-STATUS TO FILESTATUS (2). IX2094.2 +100000 READ IX-FS1 AT END IX2094.2 +100100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +100200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +100300 PERFORM FAIL. IX2094.2 +100400 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +100500 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +100600 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +100700 GO TO START-WRITE-GF-02. IX2094.2 +100800 START-PASS-GF-02. IX2094.2 +100900 PERFORM PASS. IX2094.2 +101000 GO TO START-WRITE-GF-02. IX2094.2 +101100 START-DELETE-GF-02. IX2094.2 +101200 PERFORM DE-LETE. IX2094.2 +101300 START-WRITE-GF-02. IX2094.2 +101400 PERFORM PRINT-DETAIL. IX2094.2 +101500 START-INIT-GF-03. IX2094.2 +101600 PERFORM START-INITIALIZE-RECORD. IX2094.2 +101700 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2094.2 +101800 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +101900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +102000 MOVE "**" TO FILESTATUS (3) IX2094.2 +102100 GO TO START-DELETE-GF-03. IX2094.2 +102200 MOVE "BBBBBBBBBC001" TO FS1-RECKEY-1-13. IX2094.2 +102300 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +102400 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +102500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +102600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +102700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +102800 START-TEST-GF-03. IX2094.2 +102900* IX2094.2 +103000* START-TEST-GF-03 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +103100* RECORD IN THE FILE WHICH HAS A RECORD IX2094.2 +103200* KEY VALUE OF "BBBBBBBBBC001". THIS KEY IX2094.2 +103300* VALUE IS SEQUENTIALLY LOWER THAN ANY IX2094.2 +103400* CURRENTLY EXISTING KEY IN THE FILE. IX2094.2 +103500* IX2094.2 +103600 START IX-FS1 IX2094.2 +103700 KEY IS EQUAL TO IX-FS1-KEY IX2094.2 +103800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2094.2 +103900 GO TO START-PASS-GF-03. IX2094.2 +104000 MOVE FS1-STATUS TO FILESTATUS (3). IX2094.2 +104100 READ IX-FS1 AT END IX2094.2 +104200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +104300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +104400 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +104500 PERFORM FAIL. IX2094.2 +104600 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +104700 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +104800 GO TO START-WRITE-GF-03. IX2094.2 +104900 START-PASS-GF-03. IX2094.2 +105000 PERFORM PASS. IX2094.2 +105100 GO TO START-WRITE-GF-03. IX2094.2 +105200 START-DELETE-GF-03. IX2094.2 +105300 PERFORM DE-LETE. IX2094.2 +105400 START-WRITE-GF-03. IX2094.2 +105500 PERFORM PRINT-DETAIL. IX2094.2 +105600 START-INIT-GF-04. IX2094.2 +105700 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2094.2 +105800 PERFORM START-INITIALIZE-RECORD. IX2094.2 +105900 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +106000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +106100 MOVE "**" TO FILESTATUS (4) IX2094.2 +106200 GO TO START-DELETE-GF-04. IX2094.2 +106300 MOVE "UUUUUUUUUU401" TO FS1-RECKEY-1-13. IX2094.2 +106400 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +106500 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +106600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +106700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +106800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +106900 START-TEST-GF-04. IX2094.2 +107000* IX2094.2 +107100* START-TEST-GF-04 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +107200* RECORD IN THE FILE WHICH HAS A RECORD IX2094.2 +107300* KEY VALUE OF "UUUUUUUUUU401". THIS IX2094.2 +107400* VALUE IS SEQUENTIALLY ONE GREATER THAN IX2094.2 +107500* ANY RECORD KEY CURRENTLY EXISTING IN IX2094.2 +107600* THE FILE. AN INVALID KEY CONDITION IX2094.2 +107700* IS EXPECTED WHEN THE START IS EXECUTED. IX2094.2 +107800* IX2094.2 +107900 START IX-FS1 IX2094.2 +108000 KEY IS EQUAL TO IX-FS1-KEY IX2094.2 +108100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2094.2 +108200 GO TO START-PASS-GF-04. IX2094.2 +108300 MOVE FS1-STATUS TO FILESTATUS (4). IX2094.2 +108400 READ IX-FS1 AT END IX2094.2 +108500 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +108600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +108700 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +108800 PERFORM FAIL. IX2094.2 +108900 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +109000 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +109100 GO TO START-WRITE-GF-04. IX2094.2 +109200 START-PASS-GF-04. IX2094.2 +109300 PERFORM PASS. IX2094.2 +109400 GO TO START-WRITE-GF-04. IX2094.2 +109500 START-DELETE-GF-04. IX2094.2 +109600 PERFORM DE-LETE. IX2094.2 +109700 START-WRITE-GF-04. IX2094.2 +109800 PERFORM PRINT-DETAIL. IX2094.2 +109900 START-INIT-GF-05. IX2094.2 +110000 MOVE "START-TEST-GF-05" TO PAR-NAME. IX2094.2 +110100 PERFORM START-INITIALIZE-RECORD. IX2094.2 +110200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +110300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +110400 MOVE "**" TO FILESTATUS (5) IX2094.2 +110500 GO TO START-DELETE-GF-05. IX2094.2 +110600 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2094.2 +110700 MOVE "IIIIIIIIJJ083ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +110800 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +110900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +111000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +111100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +111200 START-TEST-GF-05. IX2094.2 +111300* START-TEST-GF-05 - THE START STATEMENT USES AN OPERAND IX2094.2 +111400* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2094.2 +111500* OF A RECORD KEY BUT IS THE NAME OF A IX2094.2 +111600* DATA ITEM WHICH IS SUBORDINATE TO THE IX2094.2 +111700* RECORD KEY. THE CONTENTS OF THE DATA ITEM IX2094.2 +111800* (POSITIONS 1 THRU 5 OF THE RECORD KEY) IX2094.2 +111900* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2094.2 +112000* BALANCE OF THE KEY (POSITIONS 6 THRU 13) IS IX2094.2 +112100* NOT A VALID KEY VALUE FOR THE FILE. THE IX2094.2 +112200* RECORD WITH THE RECORD KEY "CDDDDDDDDD038" IX2094.2 +112300* (RECORD NUMBER 19) IS EXPECTED TO BE FOUND. IX2094.2 +112400* IX2094.2 +112500 START IX-FS1 IX2094.2 +112600 KEY IS EQUAL TO IX-FS1-KEY-1-5 IX2094.2 +112700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2094.2 +112800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +112900 GO TO START-FAIL-GF-05. IX2094.2 +113000 MOVE FS1-STATUS TO FILESTATUS (5). IX2094.2 +113100 READ IX-FS1 AT END IX2094.2 +113200 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +113300 GO TO START-FAIL-GF-05. IX2094.2 +113400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +113500 IF XRECORD-NUMBER (1) EQUAL TO 19 IX2094.2 +113600 PERFORM PASS IX2094.2 +113700 GO TO START-WRITE-GF-05. IX2094.2 +113800 MOVE 19 TO RECNO. IX2094.2 +113900 PERFORM DISPLAY-RECORD-KEYS. IX2094.2 +114000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +114100 START-FAIL-GF-05. IX2094.2 +114200 PERFORM FAIL. IX2094.2 +114300 MOVE 19 TO CORRECT-18V0. IX2094.2 +114400 MOVE "IX-36; 4.7.2 ETC.; SUBORDINATE D-I OF KEY" TO RE-MARK. IX2094.2 +114500 GO TO START-WRITE-GF-05. IX2094.2 +114600 START-DELETE-GF-05. IX2094.2 +114700 PERFORM DE-LETE. IX2094.2 +114800 START-WRITE-GF-05. IX2094.2 +114900 PERFORM PRINT-DETAIL. IX2094.2 +115000 START-INIT-GF-06. IX2094.2 +115100 MOVE "START-TEST-GF-06" TO PAR-NAME. IX2094.2 +115200 PERFORM START-INITIALIZE-RECORD. IX2094.2 +115300 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +115400 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +115500 MOVE "**" TO FILESTATUS (6) IX2094.2 +115600 GO TO START-DELETE-GF-06. IX2094.2 +115700 MOVE "TTTTTUUUUU390" TO FS1-RECKEY-1-13. IX2094.2 +115800 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +115900 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +116000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +116100 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +116200 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +116300 START-TEST-GF-06. IX2094.2 +116400* IX2094.2 +116500* START-TEST-GF-06 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +116600* KEY PHRASE WHICH IS NOT THE NAME OF A RECORD IX2094.2 +116700* KEY BUT IS THE NAME OF A DATA ITEM THAT IS IX2094.2 +116800* SUBORDINATE TO THE RECORD KEY. THE CONTENTS IX2094.2 +116900* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2094.2 +117000* RECORD KEY) IS A DUPLICATE OF THE FIRST IX2094.2 +117100* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2094.2 +117200* THIS TEST EXPECTS THE RECORD POINTER IX2094.2 +117300* TO BE POSITIONED TO RECORD KEY TTTTTTTTTT380 IX2094.2 +117400* (RECORD NUMBER 190) WHICH WAS THE IX2094.2 +117500* FIRST RECORD WRITTEN TO THE FILE THAT IX2094.2 +117600* CONTAINS TTTTT IN THE FIRST 5 POSITIONS OF IX2094.2 +117700* THE KEY. THE RECORD KEY WAS LOADED WITH THE IX2094.2 +117800* VALUE "TTTTTUUUUU390" (KEY FOR RECORD NUMBER IX2094.2 +117900* 195) BEFORE THE START WAS EXECUTED. IX2094.2 +118000* IX2094.2 +118100 START IX-FS1 IX2094.2 +118200 KEY IS EQUAL TO IX-FS1-KEY-1-5 IX2094.2 +118300 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2094.2 +118400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +118500 GO TO START-FAIL-GF-06. IX2094.2 +118600 MOVE FS1-STATUS TO FILESTATUS (6). IX2094.2 +118700 READ IX-FS1 AT END IX2094.2 +118800 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +118900 GO TO START-FAIL-GF-06. IX2094.2 +119000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +119100 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2094.2 +119200 PERFORM PASS IX2094.2 +119300 GO TO START-WRITE-GF-06. IX2094.2 +119400 MOVE 65 TO RECNO. IX2094.2 +119500 PERFORM DISPLAY-RECORD-KEYS. IX2094.2 +119600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +119700 START-FAIL-GF-06. IX2094.2 +119800 MOVE "IX-36; 4.7.2 ETC.; SUBORDINATE D-I OF KEY" TO RE-MARK. IX2094.2 +119900 PERFORM FAIL. IX2094.2 +120000 MOVE 190 TO CORRECT-18V0. IX2094.2 +120100 GO TO START-WRITE-GF-06. IX2094.2 +120200 START-DELETE-GF-06. IX2094.2 +120300 PERFORM DE-LETE. IX2094.2 +120400 START-WRITE-GF-06. IX2094.2 +120500 PERFORM PRINT-DETAIL. IX2094.2 +120600 START-INIT-GF-07. IX2094.2 +120700 MOVE "START-TEST-GF-07" TO PAR-NAME. IX2094.2 +120800 PERFORM START-INITIALIZE-RECORD. IX2094.2 +120900 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +121000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +121100 MOVE "**" TO FILESTATUS (7) IX2094.2 +121200 GO TO START-DELETE-GF-07. IX2094.2 +121300 MOVE "CCCCCCD022 " TO FS1-RECKEY-1-13. IX2094.2 +121400 MOVE "FFFFFFFFFG022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +121500 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +121600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +121700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +121800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +121900 START-TEST-GF-07. IX2094.2 +122000* IX2094.2 +122100* START-TEST-GF-07 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +122200* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +122300* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2094.2 +122400* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +122500* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IX2094.2 +122600* IS LOADED WITH "CCCCCCD022". NO SUCH RECORD IX2094.2 +122700* SHOULD BE IN THE FILE. IF IN THE COMPARSION,IX2094.2 +122800* THE LONGER OPERAND IS TRUNCATED ON THE LEFT IX2094.2 +122900* INSTEAD OF ON THE RIGHT THE CONTENTS OF IX2094.2 +123000* THE DATA ITEM WILL MATCH A RECORD IN THE IX2094.2 +123100* FILE. THIS TEST EXPECTS THE LONGER OPERAND IX2094.2 +123200* TO BE TRUNCATED ON THE RIGHT CAUSING NO IX2094.2 +123300* DATA ITEM MATCH AND RESULTING IN AN INVALID IX2094.2 +123400* KEY CONDITION WHEN THE START IS EXECUTED. IX2094.2 +123500* IX2094.2 +123600 START IX-FS1 IX2094.2 +123700 KEY IS EQUAL TO IX-FS1-KEY-1-10 IX2094.2 +123800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2094.2 +123900 GO TO START-PASS-GF-07. IX2094.2 +124000 MOVE FS1-STATUS TO FILESTATUS (7). IX2094.2 +124100 READ IX-FS1 AT END IX2094.2 +124200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +124300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +124400 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +124500 PERFORM FAIL. IX2094.2 +124600 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +124700 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +124800 GO TO START-WRITE-GF-07. IX2094.2 +124900 START-PASS-GF-07. IX2094.2 +125000 PERFORM PASS. IX2094.2 +125100 GO TO START-WRITE-GF-07. IX2094.2 +125200 START-DELETE-GF-07. IX2094.2 +125300 PERFORM DE-LETE. IX2094.2 +125400 START-WRITE-GF-07. IX2094.2 +125500 PERFORM PRINT-DETAIL. IX2094.2 +125600 START-INIT-GF-08. IX2094.2 +125700 MOVE "START-TEST-GF-08" TO PAR-NAME. IX2094.2 +125800 PERFORM START-INITIALIZE-RECORD. IX2094.2 +125900 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +126000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +126100 MOVE "**" TO FILESTATUS (8) IX2094.2 +126200 GO TO START-DELETE-GF-08. IX2094.2 +126300 MOVE "ABBBBBBBBC002" TO FS1-RECKEY-1-13. IX2094.2 +126400 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +126500 MOVE "WWWWWWWWWW400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +126600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +126700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +126800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +126900 START-TEST-GF-08. IX2094.2 +127000* IX2094.2 +127100* START-TEST-GF-08 - THIS TEST USES AN OPERAND IN THE IX2094.2 +127200* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +127300* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2094.2 +127400* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +127500* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2094.2 +127600* LOADED WITH "ABBBBBBBBC". THIS KEY VALUE IX2094.2 +127700* IS LOWER THAN ANY RECORD KEY VALUE IN IX2094.2 +127800* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +127900* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +128000* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +128100* EXECUTED. IX2094.2 +128200* IX2094.2 +128300 START IX-FS1 IX2094.2 +128400 KEY IS EQUAL TO IX-FS1-KEY-1-10 IX2094.2 +128500 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2094.2 +128600 GO TO START-PASS-GF-08. IX2094.2 +128700 MOVE FS1-STATUS TO FILESTATUS (8). IX2094.2 +128800 READ IX-FS1 AT END IX2094.2 +128900 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +129000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +129100 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +129200 PERFORM FAIL. IX2094.2 +129300 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +129400 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +129500 GO TO START-WRITE-GF-08. IX2094.2 +129600 START-PASS-GF-08. IX2094.2 +129700 PERFORM PASS. IX2094.2 +129800 GO TO START-WRITE-GF-08. IX2094.2 +129900 START-DELETE-GF-08. IX2094.2 +130000 PERFORM DE-LETE. IX2094.2 +130100 START-WRITE-GF-08. IX2094.2 +130200 PERFORM PRINT-DETAIL. IX2094.2 +130300 START-INIT-GF-09. IX2094.2 +130400 MOVE "START-TEST-GF-09" TO PAR-NAME. IX2094.2 +130500 PERFORM START-INITIALIZE-RECORD. IX2094.2 +130600 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +130700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +130800 MOVE "**" TO FILESTATUS (9) IX2094.2 +130900 GO TO START-DELETE-GF-09. IX2094.2 +131000 MOVE "UUUUUUUUUV400" TO FS1-RECKEY-1-13. IX2094.2 +131100 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +131200 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +131300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +131400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +131500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +131600 START-TEST-GF-09. IX2094.2 +131700* IX2094.2 +131800* START-TEST-GF-09 - THIS TEST USES AN OPERAND IN THE IX2094.2 +131900* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +132000* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2094.2 +132100* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +132200* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2094.2 +132300* LOADED WITH "UUUUUUUUUV". THIS KEY VALUE IX2094.2 +132400* IS GREATER THAN ANY RECORD KEY VALUE IN IX2094.2 +132500* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +132600* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +132700* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +132800* EXECUTED. IX2094.2 +132900* IX2094.2 +133000 START IX-FS1 IX2094.2 +133100 KEY IS EQUAL TO IX-FS1-KEY-1-10 IX2094.2 +133200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2094.2 +133300 GO TO START-PASS-GF-09. IX2094.2 +133400 MOVE FS1-STATUS TO FILESTATUS (9). IX2094.2 +133500 READ IX-FS1 AT END IX2094.2 +133600 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +133700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +133800 MOVE "IX-36; 4.7.2 ETC." TO RE-MARK. IX2094.2 +133900 PERFORM FAIL. IX2094.2 +134000 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +134100 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +134200 GO TO START-WRITE-GF-09. IX2094.2 +134300 START-PASS-GF-09. IX2094.2 +134400 PERFORM PASS. IX2094.2 +134500 GO TO START-WRITE-GF-09. IX2094.2 +134600 START-DELETE-GF-09. IX2094.2 +134700 PERFORM DE-LETE. IX2094.2 +134800 START-WRITE-GF-09. IX2094.2 +134900 PERFORM PRINT-DETAIL. IX2094.2 +135000 CLOSE IX-FS1. IX2094.2 +135100 START-INIT-GF-FILE-STATUS. IX2094.2 +135200 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +135300 MOVE "START-TEST-GF-10" TO PAR-NAME. IX2094.2 +135400* IX2094.2 +135500* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2094.2 +135600* IX2094.2 +135700 START-TEST-GF-10. IX2094.2 +135800 IF FILESTATUS (1) EQUAL TO "**" IX2094.2 +135900 PERFORM DE-LETE IX2094.2 +136000 GO TO START-WRITE-GF-10. IX2094.2 +136100* IX2094.2 +136200* START-TEST-GF-10 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +136300* RESULTING FROM START-TEST-GF-01. THE FILE IX2094.2 +136400* STATUS CONTENTS IS EXPECTED TO BE "00". IX2094.2 +136500* IX2094.2 +136600 IF FILESTATUS (1) EQUAL TO "00" IX2094.2 +136700 PERFORM PASS IX2094.2 +136800 ELSE IX2094.2 +136900 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-01 " TO RE-MARK IX2094.2 +137000 PERFORM FAIL IX2094.2 +137100 MOVE "00" TO CORRECT-A IX2094.2 +137200 MOVE FILESTATUS (1) TO COMPUTED-A. IX2094.2 +137300 START-WRITE-GF-10. IX2094.2 +137400 PERFORM PRINT-DETAIL. IX2094.2 +137500 START-TEST-GF-11. IX2094.2 +137600 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +137700 MOVE "START-TEST-GF-11" TO PAR-NAME. IX2094.2 +137800 IF FILESTATUS (2) EQUAL TO "**" IX2094.2 +137900 PERFORM DE-LETE IX2094.2 +138000 GO TO START-WRITE-GF-11. IX2094.2 +138100* IX2094.2 +138200* START-TEST-GF-11 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +138300* RESULTING FROM START-TEST-GF-02. THE FILE IX2094.2 +138400* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +138500* IX2094.2 +138600 IF FILESTATUS (2) EQUAL TO "23" IX2094.2 +138700 PERFORM PASS IX2094.2 +138800 ELSE PERFORM FAIL IX2094.2 +138900 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-02 " TO RE-MARK IX2094.2 +139000 MOVE "23" TO CORRECT-A IX2094.2 +139100 MOVE FILESTATUS (2) TO COMPUTED-A. IX2094.2 +139200 START-WRITE-GF-11. IX2094.2 +139300 PERFORM PRINT-DETAIL. IX2094.2 +139400 START-TEST-GF-12. IX2094.2 +139500 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +139600 MOVE "START-TEST-GF-12" TO PAR-NAME. IX2094.2 +139700 IF FILESTATUS (3) EQUAL TO "**" IX2094.2 +139800 PERFORM DE-LETE IX2094.2 +139900 GO TO START-WRITE-GF-12. IX2094.2 +140000* IX2094.2 +140100* START-TEST-GF-12 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +140200* RESULTING FROM START-TEST-GF-03. THE FILE IX2094.2 +140300* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +140400* IX2094.2 +140500 IF FILESTATUS (3) EQUAL TO "23" IX2094.2 +140600 PERFORM PASS IX2094.2 +140700 ELSE PERFORM FAIL IX2094.2 +140800 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-03 " TO RE-MARK IX2094.2 +140900 MOVE "23" TO CORRECT-A IX2094.2 +141000 MOVE FILESTATUS (3) TO COMPUTED-A. IX2094.2 +141100 START-WRITE-GF-12. IX2094.2 +141200 PERFORM PRINT-DETAIL. IX2094.2 +141300 START-TEST-GF-13. IX2094.2 +141400 MOVE "START-TEST-GF-13" TO PAR-NAME. IX2094.2 +141500 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +141600 IF FILESTATUS (4) EQUAL TO "**" IX2094.2 +141700 PERFORM DE-LETE IX2094.2 +141800 GO TO START-WRITE-GF-13. IX2094.2 +141900* IX2094.2 +142000* START-TEST-GF-13 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +142100* RESULTING FROM START-TEST-GF-04. THE FILE IX2094.2 +142200* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +142300* IX2094.2 +142400 IF FILESTATUS (4) EQUAL TO "23" IX2094.2 +142500 PERFORM PASS IX2094.2 +142600 ELSE PERFORM FAIL IX2094.2 +142700 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-04 " TO RE-MARK IX2094.2 +142800 MOVE "23" TO CORRECT-A IX2094.2 +142900 MOVE FILESTATUS (4) TO COMPUTED-A. IX2094.2 +143000 START-WRITE-GF-13. IX2094.2 +143100 PERFORM PRINT-DETAIL. IX2094.2 +143200 START-TEST-GF-14. IX2094.2 +143300 MOVE "START-TEST-GF-14" TO PAR-NAME. IX2094.2 +143400 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +143500 IF FILESTATUS (5) EQUAL TO "**" IX2094.2 +143600 PERFORM DE-LETE IX2094.2 +143700 GO TO START-WRITE-GF-14. IX2094.2 +143800* IX2094.2 +143900* START-TEST-GF-14 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +144000* RESULTING FROM START-TEST-GF-05. THE FILE IX2094.2 +144100* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +144200* IX2094.2 +144300 IF FILESTATUS (5) EQUAL TO "00" IX2094.2 +144400 PERFORM PASS IX2094.2 +144500 ELSE PERFORM FAIL IX2094.2 +144600 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-05 " TO RE-MARKIX2094.2 +144700 MOVE "00" TO CORRECT-A IX2094.2 +144800 MOVE FILESTATUS (5) TO COMPUTED-A. IX2094.2 +144900 START-WRITE-GF-14. IX2094.2 +145000 PERFORM PRINT-DETAIL. IX2094.2 +145100 START-TEST-GF-15. IX2094.2 +145200 MOVE "START-TEST-GF-15" TO PAR-NAME. IX2094.2 +145300 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +145400 IF FILESTATUS (6) EQUAL TO "**" IX2094.2 +145500 PERFORM DE-LETE IX2094.2 +145600 GO TO START-WRITE-GF-15. IX2094.2 +145700* IX2094.2 +145800* START-TEST-GF-15 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +145900* RESULTING FROM START-TEST-GF-06. THE FILE IX2094.2 +146000* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +146100* IX2094.2 +146200 IF FILESTATUS (6) EQUAL TO "00" IX2094.2 +146300 PERFORM PASS IX2094.2 +146400 ELSE PERFORM FAIL IX2094.2 +146500 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-06 " TO RE-MARKIX2094.2 +146600 MOVE "00" TO CORRECT-A IX2094.2 +146700 MOVE FILESTATUS (6) TO COMPUTED-A. IX2094.2 +146800 START-WRITE-GF-15. IX2094.2 +146900 PERFORM PRINT-DETAIL. IX2094.2 +147000 START-TEST-GGF-16. IX2094.2 +147100 MOVE "START-TEST-GF-16" TO PAR-NAME. IX2094.2 +147200 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +147300 IF FILESTATUS (7) EQUAL TO "**" IX2094.2 +147400 PERFORM DE-LETE IX2094.2 +147500 GO TO START-WRITE-GF-16. IX2094.2 +147600* IX2094.2 +147700* START-TEST-GF-16 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +147800* RESULTING FROM START-TEST-GF-07. THE FILE IX2094.2 +147900* STATUS CONTENTS IS EXPECTED TO BE "23" IX2094.2 +148000* IX2094.2 +148100 IF FILESTATUS (7) EQUAL TO "23" IX2094.2 +148200 PERFORM PASS IX2094.2 +148300 ELSE PERFORM FAIL IX2094.2 +148400 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-07 " TO RE-MARKIX2094.2 +148500 MOVE "23" TO CORRECT-A IX2094.2 +148600 MOVE FILESTATUS (7) TO COMPUTED-A. IX2094.2 +148700 START-WRITE-GF-16. IX2094.2 +148800 PERFORM PRINT-DETAIL. IX2094.2 +148900 START-TEST-GF-17. IX2094.2 +149000 MOVE "START-TEST-GF-17" TO PAR-NAME. IX2094.2 +149100 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +149200 IF FILESTATUS (8) EQUAL TO "**" IX2094.2 +149300 PERFORM DE-LETE IX2094.2 +149400 GO TO START-WRITE-GF-17. IX2094.2 +149500* IX2094.2 +149600* START-TEST-GF-07 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +149700* RESULTING FROM START-TEST-GF-08. THE FILE IX2094.2 +149800* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +149900* IX2094.2 +150000 IF FILESTATUS (8) EQUAL TO "23" IX2094.2 +150100 PERFORM PASS IX2094.2 +150200 ELSE PERFORM FAIL IX2094.2 +150300 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-08 " TO RE-MARKIX2094.2 +150400 MOVE "23" TO CORRECT-A IX2094.2 +150500 MOVE FILESTATUS (8) TO COMPUTED-A. IX2094.2 +150600 START-WRITE-GF-17. IX2094.2 +150700 PERFORM PRINT-DETAIL. IX2094.2 +150800 START-TEST-GF-18. IX2094.2 +150900 MOVE "START-TEST-GF-18" TO PAR-NAME. IX2094.2 +151000 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +151100 IF FILESTATUS (9) EQUAL TO "**" IX2094.2 +151200 PERFORM DE-LETE IX2094.2 +151300 GO TO START-WRITE-GF-18. IX2094.2 +151400* IX2094.2 +151500* START-TEST-GF-18 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +151600* RESULTING FROM START-TEST-GF-09. THE FILE IX2094.2 +151700* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +151800* IX2094.2 +151900 IF FILESTATUS (9) EQUAL TO "23" IX2094.2 +152000 PERFORM PASS IX2094.2 +152100 ELSE PERFORM FAIL IX2094.2 +152200 MOVE "IX-3; 1.3.4 (1) A; FROM START-TEST-GF-09 " TO RE-MARKIX2094.2 +152300 MOVE "23" TO CORRECT-A IX2094.2 +152400 MOVE FILESTATUS (9) TO COMPUTED-A. IX2094.2 +152500 START-WRITE-GF-18. IX2094.2 +152600 PERFORM PRINT-DETAIL. IX2094.2 +152700******************************************************************IX2094.2 +152800 IX2094.2 +152900 START-INIT-005. IX2094.2 +153000 OPEN INPUT IX-FS1. IX2094.2 +153100 MOVE "STR EQ ALTKY W/O DUP" TO FEATURE. IX2094.2 +153200 MOVE "START-TEST-GF-19" TO PAR-NAME. IX2094.2 +153300 MOVE "********************" TO HOLD-FILESTATUS-RECORD. IX2094.2 +153400* IX2094.2 +153500* THIS TEST TESTS THE "START -- EQUAL TO" FOR PROPER POSITIONING IX2094.2 +153600* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2094.2 +153700* START-TEST-GF-19/27 USES ONLY THE ALTERNATE RECORD KEY WITHOUT IX2094.2 +153800* THE DUPLICATES OPTION FOR ESTABLISHING THE CURRENT RECORD IX2094.2 +153900* POINTER FOR THE FILE. THE FOLLOWING IS A SUMMARY OF THE TEST IX2094.2 +154000* CONDITIONS AND THE EXPECTED ACTION TO BE TAKEN FOR THE TESTS. IX2094.2 +154100* IX2094.2 +154200* CONDITIONS (CONTENTS OF KEY) / ACTION IX2094.2 +154300* IX2094.2 +154400* START-TEST-GF-19 - EQUAL A RECORD IN FILE / RECORD FOUND IX2094.2 +154500* START-TEST-GF-20 - BETWEEN 2 EXISTING KEY VALUES / INVALID KEIX2094.2 +154600* START-TEST-GF-21 - LESS THAN FIRST FILE RECORD / INVALID KEY IX2094.2 +154700* START-TEST-GF-22 - GREATER THAN LAST FILE RECORD / INVALID KEIX2094.2 +154800* START-TEST-GF-23 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUIX2094.2 +154900* START-TEST-GF-24 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUIX2094.2 +155000* START-TEST-GF-25 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEIX2094.2 +155100* START-TEST-GF-26 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEIX2094.2 +155200* START-TEST-GF-27 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEYIX2094.2 +155300* IX2094.2 +155400* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2094.2 +155500* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2094.2 +155600* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2094.2 +155700* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2094.2 +155800* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2094.2 +155900* MATCH RECORDS IN THE FILE. IF KEY MATCH IS EXPECTED FROM IX2094.2 +156000* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2094.2 +156100* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2094.2 +156200* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2094.2 +156300* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2094.2 +156400* IX2094.2 +156500 START-INIT-GF-19. IX2094.2 +156600 PERFORM START-INITIALIZE-RECORD. IX2094.2 +156700 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +156800 MOVE "**" TO FILESTATUS (1) IX2094.2 +156900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +157000 GO TO START-DELETE-GF-19. IX2094.2 +157100 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2094.2 +157200 MOVE "XXXXXXXXXY382ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +157300 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +157400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +157500 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +157600 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +157700 START-TEST-GF-19. IX2094.2 +157800* IX2094.2 +157900* START-TEST-GF-19 - THE START SHOULD FIND A RECORD IN THE FILE IX2094.2 +158000* WHICH HAS AN ALTERNATE KEY VALUE OF IX2094.2 +158100* XXXXXXXXXY382ALTKEY1 (RECORD NUMBER 191). IX2094.2 +158200* IX2094.2 +158300 START IX-FS1 IX2094.2 +158400 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2094.2 +158500 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2094.2 +158600 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +158700 GO TO START-FAIL-GF-19. IX2094.2 +158800 MOVE FS1-STATUS TO FILESTATUS (1). IX2094.2 +158900 READ IX-FS1 AT END IX2094.2 +159000 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +159100 GO TO START-FAIL-GF-19. IX2094.2 +159200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +159300 IF XRECORD-NUMBER (1) EQUAL TO 191 IX2094.2 +159400 PERFORM PASS IX2094.2 +159500 MOVE SPACE TO RE-MARK IX2094.2 +159600 GO TO START-WRITE-GF-19. IX2094.2 +159700 MOVE 66 TO RECNO. IX2094.2 +159800 PERFORM DISPLAY-ALTERNATE-KEY1. IX2094.2 +159900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +160000 START-FAIL-GF-19. IX2094.2 +160100 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +160200 PERFORM FAIL. IX2094.2 +160300 MOVE 191 TO CORRECT-18V0. IX2094.2 +160400 GO TO START-WRITE-GF-19. IX2094.2 +160500 START-DELETE-GF-19. IX2094.2 +160600 PERFORM DE-LETE. IX2094.2 +160700 START-WRITE-GF-19. IX2094.2 +160800 PERFORM PRINT-DETAIL. IX2094.2 +160900 START-INIT-GF-20. IX2094.2 +161000 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2094.2 +161100 PERFORM START-INITIALIZE-RECORD. IX2094.2 +161200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +161300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +161400 MOVE "**" TO FILESTATUS (2) IX2094.2 +161500 GO TO START-DELETE-GF-20. IX2094.2 +161600 MOVE "EEEEEEEFFF066" TO FS1-RECKEY-1-13. IX2094.2 +161700 MOVE "HHHHHHHIII067ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +161800 MOVE "TTTTTTTSSS334ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +161900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +162000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +162100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +162200 START-TEST-GF-20. IX2094.2 +162300* IX2094.2 +162400* START-TEST-GF.02 - THE START SHOULD NOT FIND A RECORD IN THE IX2094.2 +162500* FILE WHICH HAS AN ALTERNATE KEY VALUE OF IX2094.2 +162600* HHHHHHHIII067ALTKEY1. THIS KEY VALUE IS IX2094.2 +162700* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2094.2 +162800* EXISTING ALTERNATE KEYS IN THE FILE. IX2094.2 +162900* IX2094.2 +163000 START IX-FS1 IX2094.2 +163100 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2094.2 +163200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2094.2 +163300 GO TO START-PASS-GF-20. IX2094.2 +163400 MOVE FS1-STATUS TO FILESTATUS (2). IX2094.2 +163500 READ IX-FS1 AT END IX2094.2 +163600 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +163700 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +163800 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +163900 PERFORM FAIL. IX2094.2 +164000 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2094.2 +164100 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +164200 GO TO START-WRITE-GF-20. IX2094.2 +164300 START-PASS-GF-20. IX2094.2 +164400 PERFORM PASS. IX2094.2 +164500 MOVE "INVALID KEY" TO RE-MARK. IX2094.2 +164600 GO TO START-WRITE-GF-20. IX2094.2 +164700 START-DELETE-GF-20. IX2094.2 +164800 PERFORM DE-LETE. IX2094.2 +164900 START-WRITE-GF-20. IX2094.2 +165000 PERFORM PRINT-DETAIL. IX2094.2 +165100 START-INIT-GF-21. IX2094.2 +165200 MOVE "START-TEST-GF-21" TO PAR-NAME. IX2094.2 +165300 PERFORM START-INITIALIZE-RECORD. IX2094.2 +165400 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +165500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +165600 MOVE "**" TO FILESTATUS (3) IX2094.2 +165700 GO TO START-DELETE-GF-21. IX2094.2 +165800 MOVE "BBBBBBBBBC002" TO FS1-RECKEY-1-13. IX2094.2 +165900 MOVE "EEEEEEEEEF001ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +166000 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +166100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +166200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +166300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +166400 START-TEST-GF-21. IX2094.2 +166500* IX2094.2 +166600* START-TEST-GF-21 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +166700* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2094.2 +166800* KEY VALUE OF EEEEEEEEEF001ALTKEY1. THIS KEY IX2094.2 +166900* VALUE IS SEQUENTIALLY LOWER THAN ANY IX2094.2 +167000* CURRENTLY EXISTING KEY IN THE FILE. IX2094.2 +167100* IX2094.2 +167200 START IX-FS1 IX2094.2 +167300 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2094.2 +167400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2094.2 +167500 GO TO START-PASS-GF-21. IX2094.2 +167600 MOVE FS1-STATUS TO FILESTATUS (3). IX2094.2 +167700 READ IX-FS1 AT END IX2094.2 +167800 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +167900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +168000 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +168100 PERFORM FAIL. IX2094.2 +168200 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2094.2 +168300 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +168400 GO TO START-WRITE-GF-21. IX2094.2 +168500 START-PASS-GF-21. IX2094.2 +168600 PERFORM PASS. IX2094.2 +168700 MOVE "INVALID KEY" TO RE-MARK. IX2094.2 +168800 GO TO START-WRITE-GF-21. IX2094.2 +168900 START-DELETE-GF-21. IX2094.2 +169000 PERFORM DE-LETE. IX2094.2 +169100 START-WRITE-GF-21. IX2094.2 +169200 PERFORM PRINT-DETAIL. IX2094.2 +169300 START-INIT-GF-22. IX2094.2 +169400 MOVE "START-TEST-GF-22" TO PAR-NAME. IX2094.2 +169500 PERFORM START-INITIALIZE-RECORD. IX2094.2 +169600 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +169700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +169800 MOVE "**" TO FILESTATUS (4) IX2094.2 +169900 GO TO START-DELETE-GF-22. IX2094.2 +170000 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +170100 MOVE "YYYYYYYYYY401ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +170200 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +170300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +170400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +170500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +170600 START-TEST-GF-22. IX2094.2 +170700* IX2094.2 +170800* START-TEST-GF-22 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +170900* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2094.2 +171000* KEY VALUE OF YYYYYYYYYY401ALTKEY1. THIS IX2094.2 +171100* VALUE IS SEQUENTIALLY GREATER THAN IX2094.2 +171200* ANY ALTERNATE KEY CURRENTLY EXISTING IN IX2094.2 +171300* THE FILE. AN INVALID KEY CONDITION IX2094.2 +171400* IS EXPECTED WHEN THE START IS EXECUTED. IX2094.2 +171500* IX2094.2 +171600 START IX-FS1 IX2094.2 +171700 KEY IS EQUAL TO IX-FS1-ALTKEY1 IX2094.2 +171800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2094.2 +171900 GO TO START-PASS-GF-22. IX2094.2 +172000 MOVE FS1-STATUS TO FILESTATUS (4). IX2094.2 +172100 READ IX-FS1 AT END IX2094.2 +172200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +172300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +172400 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +172500 PERFORM FAIL. IX2094.2 +172600 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2094.2 +172700 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +172800 GO TO START-WRITE-GF-22. IX2094.2 +172900 START-PASS-GF-22. IX2094.2 +173000 PERFORM PASS. IX2094.2 +173100 GO TO START-WRITE-GF-22. IX2094.2 +173200 START-DELETE-GF-22. IX2094.2 +173300 PERFORM DE-LETE. IX2094.2 +173400 START-WRITE-GF-22. IX2094.2 +173500 PERFORM PRINT-DETAIL. IX2094.2 +173600 START-INIT-GF-23. IX2094.2 +173700 MOVE "START-TEST-GF-23" TO PAR-NAME. IX2094.2 +173800 PERFORM START-INITIALIZE-RECORD. IX2094.2 +173900 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +174000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +174100 MOVE "**" TO FILESTATUS (5) IX2094.2 +174200 GO TO START-DELETE-GF-23. IX2094.2 +174300 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2094.2 +174400 MOVE "GGGGHXXXXX052ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +174500 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +174600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +174700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +174800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +174900 START-TEST-GF-23. IX2094.2 +175000* START-TEST-GF-23 - THE START STATEMENT USES AN OPERAND IX2094.2 +175100* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2094.2 +175200* OF AN ALTERNATE KEY BUT IS THE NAME OF A IX2094.2 +175300* DATA ITEM WHICH IS SUBORDINATE TO THE IX2094.2 +175400* ALTERNATE KEY. THE CONTENTS OF THE DATA ITEMIX2094.2 +175500* (POSITIONS 1 THRU 5 OF THE ALTERNATE KEY) IX2094.2 +175600* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2094.2 +175700* BALANCE OF THE KEY (POSITIONS 6 THRU 13 OF IX2094.2 +175800* THE ALTERNATE KEY IS NOT A VALID KEY VALUE IX2094.2 +175900* FOR THE FILE. THE IX2094.2 +176000* RECORD WITH THE ALTERNATE KEY "GGGGHHHHHH052 IX2094.2 +176100* ALTKEY1 (RECORD NUMBER 26) IS EXPECTED TO IX2094.2 +176200* BE FOUND. IX2094.2 +176300* IX2094.2 +176400 START IX-FS1 IX2094.2 +176500 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-5 IX2094.2 +176600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2094.2 +176700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +176800 GO TO START-FAIL-GF-23. IX2094.2 +176900 MOVE FS1-STATUS TO FILESTATUS (5). IX2094.2 +177000 READ IX-FS1 AT END IX2094.2 +177100 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +177200 GO TO START-FAIL-GF-23. IX2094.2 +177300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +177400 IF XRECORD-NUMBER (1) EQUAL TO 26 IX2094.2 +177500 PERFORM PASS IX2094.2 +177600 GO TO START-WRITE-GF-23. IX2094.2 +177700 MOVE 26 TO RECNO. IX2094.2 +177800 PERFORM DISPLAY-ALTERNATE-KEY1. IX2094.2 +177900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +178000 START-FAIL-GF-23. IX2094.2 +178100 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +178200 PERFORM FAIL. IX2094.2 +178300 MOVE 26 TO CORRECT-18V0. IX2094.2 +178400 GO TO START-WRITE-GF-23. IX2094.2 +178500 START-DELETE-GF-23. IX2094.2 +178600 PERFORM DE-LETE. IX2094.2 +178700 START-WRITE-GF-23. IX2094.2 +178800 PERFORM PRINT-DETAIL. IX2094.2 +178900 START-INIT-GF-24. IX2094.2 +179000 MOVE "START-TEST-GF-24" TO PAR-NAME. IX2094.2 +179100 PERFORM START-INITIALIZE-RECORD. IX2094.2 +179200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +179300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +179400 MOVE "**" TO FILESTATUS (6) IX2094.2 +179500 GO TO START-DELETE-GF-24. IX2094.2 +179600 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2094.2 +179700 MOVE "XXXXXYYYYY390ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +179800 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +179900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +180000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +180100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +180200 START-TEST-GF-24. IX2094.2 +180300* IX2094.2 +180400* START-TEST-GF-24 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +180500* KEY PHRASE WHICH IS NOT THE NAME OF AN IX2094.2 +180600* ALTERNATE KEY BUT IS THE NAME OF A DATA ITEM IX2094.2 +180700* THAT IS SUBORDINATE TO THE KEY. THE CONTENTSIX2094.2 +180800* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2094.2 +180900* ALTERNATE KEY) IS A DUPLICATE OF THE FIRST IX2094.2 +181000* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2094.2 +181100* THIS TEST EXPECTS THE RECORD POINTER IX2094.2 +181200* TO BE POSITIONED TO RECORD KEY XXXXXXXXXX380 IX2094.2 +181300* ALTKEY1 (RECORD NUMBER 190) WHICH WAS THE IX2094.2 +181400* FIRST RECORD WRITTEN TO THE FILE THAT IX2094.2 +181500* CONTAINS XXXXX IN THE FIRST 5 POSITIONS OF IX2094.2 +181600* THE KEY. THE ALTERNATE KEY WAS LOADED WITH THEIX2094.2 +181700* VALUE XXXXXYYYYY390ALTKEY1 (KEY FOR RECORD IX2094.2 +181800* NUMBER 195) BEFORE THE START WAS EXECUTED. IX2094.2 +181900* IX2094.2 +182000 START IX-FS1 IX2094.2 +182100 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-5 IX2094.2 +182200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2094.2 +182300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +182400 GO TO START-FAIL-GF-24. IX2094.2 +182500 MOVE FS1-STATUS TO FILESTATUS (6). IX2094.2 +182600 READ IX-FS1 AT END IX2094.2 +182700 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +182800 GO TO START-FAIL-GF-24. IX2094.2 +182900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +183000 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2094.2 +183100 PERFORM PASS IX2094.2 +183200 GO TO START-WRITE-GF-24. IX2094.2 +183300 MOVE 65 TO RECNO. IX2094.2 +183400 PERFORM DISPLAY-ALTERNATE-KEY1. IX2094.2 +183500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +183600 START-FAIL-GF-24. IX2094.2 +183700 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +183800 PERFORM FAIL. IX2094.2 +183900 MOVE 190 TO CORRECT-18V0. IX2094.2 +184000 GO TO START-WRITE-GF-24. IX2094.2 +184100 START-DELETE-GF-24. IX2094.2 +184200 PERFORM DE-LETE. IX2094.2 +184300 START-WRITE-GF-24. IX2094.2 +184400 PERFORM PRINT-DETAIL. IX2094.2 +184500 START-INIT-GF-25. IX2094.2 +184600 MOVE "START-TEST-GF-25" TO PAR-NAME. IX2094.2 +184700 PERFORM START-INITIALIZE-RECORD. IX2094.2 +184800 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +184900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +185000 MOVE "**" TO FILESTATUS (7) IX2094.2 +185100 GO TO START-DELETE-GF-25. IX2094.2 +185200 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2094.2 +185300 MOVE "022ALTKEY1 " TO FS1-ALTKEY1-1-20. IX2094.2 +185400 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +185500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +185600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +185700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +185800 START-TEST-GF-25. IX2094.2 +185900* IX2094.2 +186000* START-TEST-GF-25 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +186100* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +186200* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +186300* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +186400* POSITIONS 1 THRU 10 OF THE ALTERNATE KEY) IX2094.2 +186500* IS LOADED WITH "022ALTKEY1". NO SUCH RECORD IX2094.2 +186600* SHOULD BE IN THE FILE. IF IN THE COMPARSION,IX2094.2 +186700* THE LONGER OPERAND IS TRUNCATED ON THE LEFT IX2094.2 +186800* INSTEAD OF ON THE RIGHT THE CONTENTS OF IX2094.2 +186900* THE DATA ITEM WILL MATCH A RECORD IN THE IX2094.2 +187000* FILE. THIS TEST EXPECTS THE LONGER OPERAND IX2094.2 +187100* TO BE TRUNCATED ON THE RIGHT CAUSING NO IX2094.2 +187200* DATA ITEM MATCH AND RESULTING IN AN INVALID IX2094.2 +187300* KEY CONDITION WHEN THE START IS EXECUTED. IX2094.2 +187400* IX2094.2 +187500 START IX-FS1 IX2094.2 +187600 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-10 IX2094.2 +187700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2094.2 +187800 GO TO START-PASS-GF-25. IX2094.2 +187900 MOVE FS1-STATUS TO FILESTATUS (7). IX2094.2 +188000 READ IX-FS1 AT END IX2094.2 +188100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +188200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +188300 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +188400 PERFORM FAIL. IX2094.2 +188500 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +188600 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +188700 GO TO START-WRITE-GF-25. IX2094.2 +188800 START-PASS-GF-25. IX2094.2 +188900 PERFORM PASS. IX2094.2 +189000 GO TO START-WRITE-GF-25. IX2094.2 +189100 START-DELETE-GF-25. IX2094.2 +189200 PERFORM DE-LETE. IX2094.2 +189300 START-WRITE-GF-25. IX2094.2 +189400 PERFORM PRINT-DETAIL. IX2094.2 +189500 START-INIT-GF-26. IX2094.2 +189600 MOVE "START-TEST-GF-26" TO PAR-NAME. IX2094.2 +189700 PERFORM START-INITIALIZE-RECORD. IX2094.2 +189800 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +189900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +190000 MOVE "**" TO FILESTATUS (8) IX2094.2 +190100 GO TO START-DELETE-GF-26. IX2094.2 +190200 MOVE "BBBBBBBBBC002" TO FS1-RECKEY-1-13. IX2094.2 +190300 MOVE "EEEEEEEEEE002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +190400 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +190500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +190600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +190700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +190800 START-TEST-GF-26. IX2094.2 +190900* IX2094.2 +191000* START-TEST-GF-26 - THIS TEST USES AN OPERAND IN THE IX2094.2 +191100* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +191200* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +191300* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +191400* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2094.2 +191500* LOADED WITH "EEEEEEEEEE". THIS KEY VALUE IX2094.2 +191600* IS LOWER THAN ANY ALTERNATE KEY VALUE IN IX2094.2 +191700* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +191800* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +191900* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +192000* EXECUTED. IX2094.2 +192100* IX2094.2 +192200 START IX-FS1 IX2094.2 +192300 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-10 IX2094.2 +192400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2094.2 +192500 GO TO START-PASS-GF-26. IX2094.2 +192600 MOVE FS1-STATUS TO FILESTATUS (8). IX2094.2 +192700 READ IX-FS1 AT END IX2094.2 +192800 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +192900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +193000 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +193100 PERFORM FAIL. IX2094.2 +193200 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +193300 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +193400 GO TO START-WRITE-GF-26. IX2094.2 +193500 START-PASS-GF-26. IX2094.2 +193600 PERFORM PASS. IX2094.2 +193700 GO TO START-WRITE-GF-26. IX2094.2 +193800 START-DELETE-GF-26. IX2094.2 +193900 PERFORM DE-LETE. IX2094.2 +194000 START-WRITE-GF-26. IX2094.2 +194100 PERFORM PRINT-DETAIL. IX2094.2 +194200 START-INIT-GF-27. IX2094.2 +194300 MOVE "START-TEST-GF-27" TO PAR-NAME. IX2094.2 +194400 PERFORM START-INITIALIZE-RECORD. IX2094.2 +194500 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +194600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +194700 MOVE "**" TO FILESTATUS (9) IX2094.2 +194800 GO TO START-DELETE-GF-27. IX2094.2 +194900 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +195000 MOVE "YYYYYZYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +195100 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +195200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +195300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +195400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +195500 START-TEST-GF-27. IX2094.2 +195600* IX2094.2 +195700* START-TEST-GF-27 - THIS TEST USES AN OPERAND IN THE IX2094.2 +195800* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +195900* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +196000* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +196100* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2094.2 +196200* LOADED WITH "YYYYYZYYYY". THIS KEY VALUE IX2094.2 +196300* IS GREATER THAN ANY ALTERNATE KEY VALUE IN IX2094.2 +196400* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +196500* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +196600* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +196700* EXECUTED. IX2094.2 +196800* IX2094.2 +196900 START IX-FS1 IX2094.2 +197000 KEY IS EQUAL TO IX-FS1-ALTKEY1-1-10 IX2094.2 +197100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2094.2 +197200 GO TO START-PASS-GF-27. IX2094.2 +197300 MOVE FS1-STATUS TO FILESTATUS (9). IX2094.2 +197400 READ IX-FS1 AT END IX2094.2 +197500 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +197600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +197700 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +197800 PERFORM FAIL. IX2094.2 +197900 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +198000 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +198100 GO TO START-WRITE-GF-27. IX2094.2 +198200 START-PASS-GF-27. IX2094.2 +198300 PERFORM PASS. IX2094.2 +198400 GO TO START-WRITE-GF-27. IX2094.2 +198500 START-DELETE-GF-27. IX2094.2 +198600 PERFORM DE-LETE. IX2094.2 +198700 START-WRITE-GF-27. IX2094.2 +198800 PERFORM PRINT-DETAIL. IX2094.2 +198900 IX2094.2 +199000 CLOSE IX-FS1. IX2094.2 +199100 IX2094.2 +199200 START-INIT-FILE-STATUS-2. IX2094.2 +199300 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +199400 MOVE "START-TEST-GF-28" TO PAR-NAME. IX2094.2 +199500* IX2094.2 +199600* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2094.2 +199700* CAPTURED FROM THE LAST NINE TSTS. IX2094.2 +199800* IX2094.2 +199900 START-TEST-GF-28. IX2094.2 +200000 IF FILESTATUS (1) EQUAL TO "**" IX2094.2 +200100 PERFORM DE-LETE IX2094.2 +200200 GO TO START-WRITE-GF-28. IX2094.2 +200300* IX2094.2 +200400* START-TEST-GF-28 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +200500* RESULTING FROM START-TEST-GF-19. THE FILE IX2094.2 +200600* STATUS CONTENTS IS EXPECTED TO BE "00". IX2094.2 +200700* IX2094.2 +200800 IF FILESTATUS (1) EQUAL TO "00" IX2094.2 +200900 PERFORM PASS IX2094.2 +201000 ELSE IX2094.2 +201100 MOVE "IX-3; 1.3.4 (1) A FROM START-TEST-GF-19 " TO RE-MARKIX2094.2 +201200 PERFORM FAIL IX2094.2 +201300 MOVE "00" TO CORRECT-A IX2094.2 +201400 MOVE FILESTATUS (1) TO COMPUTED-A. IX2094.2 +201500 START-WRITE-GF-28. IX2094.2 +201600 PERFORM PRINT-DETAIL. IX2094.2 +201700 START-TEST-GF-29. IX2094.2 +201800 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +201900 MOVE "START-TEST-GF-29" TO PAR-NAME. IX2094.2 +202000 IF FILESTATUS (2) EQUAL TO "**" IX2094.2 +202100 PERFORM DE-LETE IX2094.2 +202200 GO TO START-WRITE-GF-29. IX2094.2 +202300* IX2094.2 +202400* START-TEST-GF-29 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +202500* RESULTING FROM START-TEST-GF-20. THE FILE IX2094.2 +202600* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +202700* IX2094.2 +202800 IF FILESTATUS (2) EQUAL TO "23" IX2094.2 +202900 PERFORM PASS IX2094.2 +203000 ELSE PERFORM FAIL IX2094.2 +203100 MOVE "IX-4; 1.3.4 (3) C ; SEE START-TEST-GF-20 " TO RE-MARKIX2094.2 +203200 MOVE "23" TO CORRECT-A IX2094.2 +203300 MOVE FILESTATUS (2) TO COMPUTED-A. IX2094.2 +203400 START-WRITE-GF-29. IX2094.2 +203500 PERFORM PRINT-DETAIL. IX2094.2 +203600 START-TEST-GF-30. IX2094.2 +203700 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +203800 MOVE "START-TEST-GF-30" TO PAR-NAME. IX2094.2 +203900 IF FILESTATUS (3) EQUAL TO "**" IX2094.2 +204000 PERFORM DE-LETE IX2094.2 +204100 GO TO START-WRITE-GF-30. IX2094.2 +204200* IX2094.2 +204300* START-TEST-GF-30 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +204400* RESULTING FROM START-TEST-GF-21. THE FILE IX2094.2 +204500* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +204600* IX2094.2 +204700 IF FILESTATUS (3) EQUAL TO "23" IX2094.2 +204800 PERFORM PASS IX2094.2 +204900 ELSE PERFORM FAIL IX2094.2 +205000 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-21 " TO RE-MARKIX2094.2 +205100 MOVE "23" TO CORRECT-A IX2094.2 +205200 MOVE FILESTATUS (3) TO COMPUTED-A. IX2094.2 +205300 START-WRITE-GF-30. IX2094.2 +205400 PERFORM PRINT-DETAIL. IX2094.2 +205500 START-TEST-GF-31. IX2094.2 +205600 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +205700 MOVE "START-TEST-GF-31" TO PAR-NAME. IX2094.2 +205800 IF FILESTATUS (4) EQUAL TO "**" IX2094.2 +205900 PERFORM DE-LETE IX2094.2 +206000 GO TO START-WRITE-GF-31. IX2094.2 +206100* IX2094.2 +206200* START-TEST-GF-31 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +206300* RESULTING FROM START-TEST-GF-22. THE FILE IX2094.2 +206400* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +206500* IX2094.2 +206600 IF FILESTATUS (4) EQUAL TO "23" IX2094.2 +206700 PERFORM PASS IX2094.2 +206800 ELSE PERFORM FAIL IX2094.2 +206900 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-22 " TO RE-MARKIX2094.2 +207000 MOVE "23" TO CORRECT-A IX2094.2 +207100 MOVE FILESTATUS (4) TO COMPUTED-A. IX2094.2 +207200 START-WRITE-GF-31. IX2094.2 +207300 PERFORM PRINT-DETAIL. IX2094.2 +207400 START-TEST-GF-32. IX2094.2 +207500 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +207600 MOVE "START-TEST-GF-32" TO PAR-NAME. IX2094.2 +207700 IF FILESTATUS (5) EQUAL TO "**" IX2094.2 +207800 PERFORM DE-LETE IX2094.2 +207900 GO TO START-WRITE-GF-32. IX2094.2 +208000* IX2094.2 +208100* START-TEST-GF.05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +208200* RESULTING FROM START-TEST-GF-23. THE FILE IX2094.2 +208300* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +208400* IX2094.2 +208500 IF FILESTATUS (5) EQUAL TO "00" IX2094.2 +208600 PERFORM PASS IX2094.2 +208700 ELSE PERFORM FAIL IX2094.2 +208800 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-23 " TO RE-MARKIX2094.2 +208900 MOVE "00" TO CORRECT-A IX2094.2 +209000 MOVE FILESTATUS (5) TO COMPUTED-A. IX2094.2 +209100 START-WRITE-GF-32. IX2094.2 +209200 PERFORM PRINT-DETAIL. IX2094.2 +209300 START-TEST-GF-33. IX2094.2 +209400 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +209500 MOVE "START-TEST-GF-33" TO PAR-NAME. IX2094.2 +209600 IF FILESTATUS (6) EQUAL TO "**" IX2094.2 +209700 PERFORM DE-LETE IX2094.2 +209800 GO TO START-WRITE-GF-33. IX2094.2 +209900* IX2094.2 +210000* START-TEST-GF-33 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +210100* RESULTING FROM START-TEST-GF-24. THE FILE IX2094.2 +210200* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +210300* IX2094.2 +210400 IF FILESTATUS (6) EQUAL TO "00" IX2094.2 +210500 PERFORM PASS IX2094.2 +210600 ELSE PERFORM FAIL IX2094.2 +210700 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-24 " TO RE-MARKIX2094.2 +210800 MOVE "00" TO CORRECT-A IX2094.2 +210900 MOVE FILESTATUS (6) TO COMPUTED-A. IX2094.2 +211000 START-WRITE-GF-33. IX2094.2 +211100 PERFORM PRINT-DETAIL. IX2094.2 +211200 START-TEST-GF-34. IX2094.2 +211300 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +211400 MOVE "START-TEST-GF-34" TO PAR-NAME. IX2094.2 +211500 IF FILESTATUS (7) EQUAL TO "**" IX2094.2 +211600 PERFORM DE-LETE IX2094.2 +211700 GO TO START-WRITE-GF-34. IX2094.2 +211800* IX2094.2 +211900* START-TEST-GF-34 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +212000* RESULTING FROM START-TEST-GF-25. THE FILE IX2094.2 +212100* STATUS CONTENTS IS EXPECTED TO BE "23" IX2094.2 +212200* IX2094.2 +212300 IF FILESTATUS (7) EQUAL TO "23" IX2094.2 +212400 PERFORM PASS IX2094.2 +212500 ELSE PERFORM FAIL IX2094.2 +212600 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-25 " TO RE-MARKIX2094.2 +212700 MOVE "23" TO CORRECT-A IX2094.2 +212800 MOVE FILESTATUS (7) TO COMPUTED-A. IX2094.2 +212900 START-WRITE-GF-34. IX2094.2 +213000 PERFORM PRINT-DETAIL. IX2094.2 +213100 START-TEST-GF-35. IX2094.2 +213200 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +213300 MOVE "START-TEST-GF-35" TO PAR-NAME. IX2094.2 +213400 IF FILESTATUS (8) EQUAL TO "**" IX2094.2 +213500 PERFORM DE-LETE IX2094.2 +213600 GO TO START-WRITE-GF-35. IX2094.2 +213700* IX2094.2 +213800* START-TEST-GF-35 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +213900* RESULTING FROM START-TEST-GF-26. THE FILE IX2094.2 +214000* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +214100* IX2094.2 +214200 IF FILESTATUS (8) EQUAL TO "23" IX2094.2 +214300 PERFORM PASS IX2094.2 +214400 ELSE PERFORM FAIL IX2094.2 +214500 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-26 " TO RE-MARKIX2094.2 +214600 MOVE "23" TO CORRECT-A IX2094.2 +214700 MOVE FILESTATUS (8) TO COMPUTED-A. IX2094.2 +214800 START-WRITE-GF-35. IX2094.2 +214900 PERFORM PRINT-DETAIL. IX2094.2 +215000 START-TEST-GF-36. IX2094.2 +215100 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +215200 MOVE "START-TEST-GF-36" TO PAR-NAME. IX2094.2 +215300 IF FILESTATUS (9) EQUAL TO "**" IX2094.2 +215400 PERFORM DE-LETE IX2094.2 +215500 GO TO START-WRITE-GF-36. IX2094.2 +215600* IX2094.2 +215700* START-TEST-GF-36 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +215800* RESULTING FROM START-TEST-GF-27. THE FILE IX2094.2 +215900* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +216000* IX2094.2 +216100 IF FILESTATUS (9) EQUAL TO "23" IX2094.2 +216200 PERFORM PASS IX2094.2 +216300 ELSE PERFORM FAIL IX2094.2 +216400 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-27 " TO RE-MARKIX2094.2 +216500 MOVE "23" TO CORRECT-A IX2094.2 +216600 MOVE FILESTATUS (9) TO COMPUTED-A. IX2094.2 +216700 START-WRITE-GF-36. IX2094.2 +216800 PERFORM PRINT-DETAIL. IX2094.2 +216900 IX2094.2 +217000 IX2094.2 +217100 START-INIT-GF-37-ETC. IX2094.2 +217200 OPEN INPUT IX-FS1. IX2094.2 +217300 MOVE "STRT EQ ALTKY W/DUP" TO FEATURE. IX2094.2 +217400 MOVE "START-TEST-GF-37" TO PAR-NAME. IX2094.2 +217500 MOVE "********************" TO HOLD-FILESTATUS-RECORD. IX2094.2 +217600* IX2094.2 +217700* THIS TEST TESTS THE "START -- EQUAL TO" FOR PROPER POSITIONING IX2094.2 +217800* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2094.2 +217900* START-TEST-007 USES ONLY THE ALTERNATE RECORD KEY WITH DUPLI- IX2094.2 +218000* CATES OPTION (ALTERNATE-KEY2) FOR ESTABLISHING IX2094.2 +218100* THE CURRENT RECORD POINTER FOR THE FILE. THE FOLLOWING IS A IX2094.2 +218200* SUMMARY OF THE TEST CONDITIONS AND THE EXPECTED ACTION TO BE IX2094.2 +218300* TAKEN FOR THE TESTS. IX2094.2 +218400* IX2094.2 +218500* CONDITIONS (CONTENTS OF KEY) / ACTION IX2094.2 +218600* IX2094.2 +218700* START-TEST-GF-37 - EQUAL A RECORD IN FILE / RECORD FOUND IX2094.2 +218800* START-TEST-GF-38 - BETWEEN 2 EXISTING KEY VALUES / INVALID KEYIX2094.2 +218900* START-TEST-GF-39 - LESS THAN FIRST FILE RECORD / INVALID KEY IX2094.2 +219000* START-TEST-GF-40 - GREATER THAN LAST FILE RECORD / INVALID KEYIX2094.2 +219100* START-TEST-GF-41 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2094.2 +219200* START-TEST-GF-42 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2094.2 +219300* START-TEST-GF-43 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2094.2 +219400* START-TEST-GF-44 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2094.2 +219500* START-TEST-GF-45 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2094.2 +219600* IX2094.2 +219700* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2094.2 +219800* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2094.2 +219900* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2094.2 +220000* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2094.2 +220100* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD MATCH IX2094.2 +220200* RECORDS IN THE FILE. IF A KEY MATCH IS EXPECTED FROM IX2094.2 +220300* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2094.2 +220400* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2094.2 +220500* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2094.2 +220600* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2094.2 +220700* IX2094.2 +220800 START-INIT-GF-37. IX2094.2 +220900 MOVE "START-TEST-GF-37" TO PAR-NAME. IX2094.2 +221000 PERFORM START-INITIALIZE-RECORD. IX2094.2 +221100 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +221200 MOVE "**" TO FILESTATUS (1) IX2094.2 +221300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +221400 GO TO START-DELETE-GF-37. IX2094.2 +221500 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2094.2 +221600 MOVE "EEEEEFFFFF022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +221700 MOVE "VVVVVVVVUU376ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +221800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +221900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +222000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +222100 START-TEST-GF-37. IX2094.2 +222200* IX2094.2 +222300* START-TEST-GF-37 - THE START SHOULD FIND A RECORD IN THE FILE IX2094.2 +222400* WHICH HAS AN ALTERNATE RECORD KEY VALUE OF IX2094.2 +222500* VVVVVVVVUU376ALTKEY2 (RECORD NUMBER 12). IX2094.2 +222600* IX2094.2 +222700 START IX-FS1 IX2094.2 +222800 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2094.2 +222900 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2094.2 +223000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +223100 GO TO START-FAIL-GF-37. IX2094.2 +223200 MOVE FS1-STATUS TO FILESTATUS (1). IX2094.2 +223300 READ IX-FS1 AT END IX2094.2 +223400 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +223500 GO TO START-FAIL-GF-37. IX2094.2 +223600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +223700 IF XRECORD-NUMBER (1) EQUAL TO 12 IX2094.2 +223800 PERFORM PASS IX2094.2 +223900 MOVE SPACE TO RE-MARK IX2094.2 +224000 GO TO START-WRITE-GF-37. IX2094.2 +224100 MOVE 12 TO RECNO. IX2094.2 +224200 PERFORM DISPLAY-ALTERNATE-KEY2. IX2094.2 +224300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +224400 START-FAIL-GF-37. IX2094.2 +224500 PERFORM FAIL. IX2094.2 +224600 MOVE 12 TO CORRECT-18V0. IX2094.2 +224700 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +224800 GO TO START-WRITE-GF-37. IX2094.2 +224900 START-DELETE-GF-37. IX2094.2 +225000 PERFORM DE-LETE. IX2094.2 +225100 START-WRITE-GF-37. IX2094.2 +225200 PERFORM PRINT-DETAIL. IX2094.2 +225300 START-INIT-GF-38. IX2094.2 +225400 MOVE "START-TEST-GF-38" TO PAR-NAME. IX2094.2 +225500 PERFORM START-INITIALIZE-RECORD. IX2094.2 +225600 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +225700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +225800 MOVE "**" TO FILESTATUS (2) IX2094.2 +225900 GO TO START-DELETE-GF-38. IX2094.2 +226000 MOVE "EEEEEEEEFF064" TO FS1-RECKEY-1-13. IX2094.2 +226100 MOVE "HHHHHHHIII066ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +226200 MOVE "TTTTTTTSSS335ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +226300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +226400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +226500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +226600 START-TEST-GF-38. IX2094.2 +226700* IX2094.2 +226800* START-TEST-GF-38- THE START SHOULD NOT FIND A RECORD IN THE IX2094.2 +226900* FILE WHICH HAS AN ALTERNATE RECORD KEY VALUE IX2094.2 +227000* OF TTTTTTTSSS335ALTKEY2. THIS KEY VALUE IS IX2094.2 +227100* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2094.2 +227200* EXISTING ALTERNATE KEYS IN THE FILE. IX2094.2 +227300* IX2094.2 +227400 START IX-FS1 IX2094.2 +227500 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2094.2 +227600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2094.2 +227700 GO TO START-PASS-GF-38. IX2094.2 +227800 MOVE FS1-STATUS TO FILESTATUS (2). IX2094.2 +227900 READ IX-FS1 AT END IX2094.2 +228000 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +228100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +228200 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +228300 PERFORM FAIL. IX2094.2 +228400 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +228500 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +228600 GO TO START-WRITE-GF-38. IX2094.2 +228700 START-PASS-GF-38. IX2094.2 +228800 PERFORM PASS. IX2094.2 +228900 GO TO START-WRITE-GF-38. IX2094.2 +229000 START-DELETE-GF-38. IX2094.2 +229100 PERFORM DE-LETE. IX2094.2 +229200 START-WRITE-GF-38. IX2094.2 +229300 PERFORM PRINT-DETAIL. IX2094.2 +229400 START-INIT-GF-39. IX2094.2 +229500 MOVE "START-TEST-GF-39" TO PAR-NAME. IX2094.2 +229600 PERFORM START-INITIALIZE-RECORD. IX2094.2 +229700 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +229800 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +229900 MOVE "**" TO FILESTATUS (3) IX2094.2 +230000 GO TO START-DELETE-GF-39. IX2094.2 +230100 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +230200 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +230300 MOVE "DDDDDDDDDC000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +230400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +230500 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +230600 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +230700 START-TEST-GF-39. IX2094.2 +230800* IX2094.2 +230900* START-TEST-GF-39 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +231000* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2094.2 +231100* KEY VALUE OF DDDDDDDDDC000ALTKEY2. THIS KEY IX2094.2 +231200* VALUE IS SEQUENTIALLY LOWER THAN ANY IX2094.2 +231300* CURRENTLY EXISTING KEY IN THE FILE. IX2094.2 +231400* IX2094.2 +231500 START IX-FS1 IX2094.2 +231600 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2094.2 +231700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2094.2 +231800 GO TO START-PASS-GF-39. IX2094.2 +231900 MOVE FS1-STATUS TO FILESTATUS (3). IX2094.2 +232000 READ IX-FS1 AT END IX2094.2 +232100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +232200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +232300 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +232400 PERFORM FAIL. IX2094.2 +232500 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +232600 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +232700 GO TO START-WRITE-GF-39. IX2094.2 +232800 START-PASS-GF-39. IX2094.2 +232900 PERFORM PASS. IX2094.2 +233000 GO TO START-WRITE-GF-39. IX2094.2 +233100 START-DELETE-GF-39. IX2094.2 +233200 PERFORM DE-LETE. IX2094.2 +233300 START-WRITE-GF-39. IX2094.2 +233400 PERFORM PRINT-DETAIL. IX2094.2 +233500 START-INIT-GF-40. IX2094.2 +233600 MOVE "START-TEST-GF-40" TO PAR-NAME. IX2094.2 +233700 PERFORM START-INITIALIZE-RECORD. IX2094.2 +233800 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +233900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +234000 MOVE "**" TO FILESTATUS (4) IX2094.2 +234100 GO TO START-DELETE-GF-40. IX2094.2 +234200 MOVE "BBBBBBBBBC002" TO FS1-RECKEY-1-13. IX2094.2 +234300 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +234400 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +234500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +234600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +234700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +234800 START-TEST-GF-40. IX2094.2 +234900* IX2094.2 +235000* START-TEST-GF-40 - THE START STATEMENT SHOULD NOT FIND A IX2094.2 +235100* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2094.2 +235200* KEY VALUE OF WWWWWWWWWV399ALTKEY2. THIS IX2094.2 +235300* VALUE IS SEQUENTIALLY ONE GREATER THAN IX2094.2 +235400* ANY ALTERNATE KEY CURRENTLY EXISTING IN IX2094.2 +235500* THE FILE. AN INVALID KEY CONDITION IX2094.2 +235600* IS EXPECTED WHEN THE START IS EXECUTED. IX2094.2 +235700* IX2094.2 +235800 START IX-FS1 IX2094.2 +235900 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2094.2 +236000 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2094.2 +236100 GO TO START-PASS-GF-40. IX2094.2 +236200 MOVE FS1-STATUS TO FILESTATUS (4). IX2094.2 +236300 READ IX-FS1 AT END IX2094.2 +236400 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +236500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +236600 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +236700 PERFORM FAIL. IX2094.2 +236800 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +236900 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +237000 GO TO START-WRITE-GF-40. IX2094.2 +237100 START-PASS-GF-40. IX2094.2 +237200 PERFORM PASS. IX2094.2 +237300 GO TO START-WRITE-GF-40. IX2094.2 +237400 START-DELETE-GF-40. IX2094.2 +237500 PERFORM DE-LETE. IX2094.2 +237600 START-WRITE-GF-40. IX2094.2 +237700 PERFORM PRINT-DETAIL. IX2094.2 +237800 START-INIT-GF-41. IX2094.2 +237900 MOVE "START-TEST-GF-41" TO PAR-NAME. IX2094.2 +238000 PERFORM START-INITIALIZE-RECORD. IX2094.2 +238100 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +238200 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +238300 MOVE "**" TO FILESTATUS (5) IX2094.2 +238400 GO TO START-DELETE-GF-41. IX2094.2 +238500 MOVE "CCCCCCCCCC038" TO FS1-RECKEY-1-13. IX2094.2 +238600 MOVE "IIIIIIIIJJ083ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +238700 MOVE "VUUUUVVVVV362ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +238800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +238900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +239000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +239100 START-TEST-GF-41. IX2094.2 +239200* IX2094.2 +239300* START-TEST-GF-41 - THE START STATEMENT USES AN OPERAND IX2094.2 +239400* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2094.2 +239500* OF AN ALTERNATE KEY BUT IS THE NAME OF A IX2094.2 +239600* DATA ITEM WHICH IS SUBORDINATE TO THE IX2094.2 +239700* ALTERNATE KEY. THE CONTENTS OF THE DATA ITEMIX2094.2 +239800* (POSITIONS 1 THRU 5 OF THE ALTERNATE KEY) IX2094.2 +239900* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2094.2 +240000* BALANCE OF THE ALTERNATE KEY (POSITIONS 6 IX2094.2 +240100* THRU 20) IN NOT A VALID KEY VALUE FOR THE IX2094.2 +240200* FILE. THE IX2094.2 +240300* RECORD WITH THE ALTERNATE KEY IX2094.2 +240400* VUUUUUUUUU362ALTKEY2 (RECORD NUMBER 19) IS IX2094.2 +240500* EXPECTED TO BE FOUND. IX2094.2 +240600* IX2094.2 +240700 START IX-FS1 IX2094.2 +240800 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-5 IX2094.2 +240900 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2094.2 +241000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +241100 GO TO START-FAIL-GF-41. IX2094.2 +241200 MOVE FS1-STATUS TO FILESTATUS (5). IX2094.2 +241300 READ IX-FS1 AT END IX2094.2 +241400 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +241500 GO TO START-FAIL-GF-41. IX2094.2 +241600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +241700 IF XRECORD-NUMBER (1) EQUAL TO 19 IX2094.2 +241800 PERFORM PASS IX2094.2 +241900 GO TO START-WRITE-GF-41. IX2094.2 +242000 MOVE 19 TO RECNO. IX2094.2 +242100 PERFORM DISPLAY-ALTERNATE-KEY2. IX2094.2 +242200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +242300 START-FAIL-GF-41. IX2094.2 +242400 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +242500 PERFORM FAIL. IX2094.2 +242600 MOVE 19 TO CORRECT-18V0. IX2094.2 +242700 GO TO START-WRITE-GF-41. IX2094.2 +242800 START-DELETE-GF-41. IX2094.2 +242900 PERFORM DE-LETE. IX2094.2 +243000 START-WRITE-GF-41. IX2094.2 +243100 PERFORM PRINT-DETAIL. IX2094.2 +243200 START-INIT-GF-42. IX2094.2 +243300 MOVE "START-TEST-GF-42" TO PAR-NAME. IX2094.2 +243400 PERFORM START-INITIALIZE-RECORD. IX2094.2 +243500 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +243600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +243700 MOVE "**" TO FILESTATUS (6) IX2094.2 +243800 GO TO START-DELETE-GF-42. IX2094.2 +243900 MOVE "TTTTTTTTTT390" TO FS1-RECKEY-1-13. IX2094.2 +244000 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +244100 MOVE "EEEEEDDDDD010ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +244200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +244300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +244400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +244500 START-TEST-GF-42. IX2094.2 +244600* IX2094.2 +244700* START-TEST-GF-42 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +244800* KEY PHRASE WHICH IS NOT THE NAME OF AN ALTER-IX2094.2 +244900* NATE KEY BUT IS THE NAME OF A DATA ITEM THAT IX2094.2 +245000* SUBORDINATE TO THE ALTERNATE KEY. THE CONTENTIX2094.2 +245100* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2094.2 +245200* ALTERNATE KEY) IS A DUPLICATE OF THE FIRST IX2094.2 +245300* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2094.2 +245400* THIS TEST EXPECTS THE RECORD POINTER IX2094.2 +245500* TO BE POSITIONED TO ALTERNATE KEY IX2094.2 +245600* EEEEEDDDDD020ALTKEY2 (RECORD NO 195) WHICH IX2094.2 +245700* IS THE FIRST RECORD ALPHABETICALLY IN THE IX2094.2 +245800* FILE THAT CONTAINS EEEEE IN THE FIRST 5 IX2094.2 +245900* POSITIONS OF THE KEY. NOTE THIS IS ALSO IX2094.2 +246000* A RECORD IN WHICH THE VALUE OF THE FULL IX2094.2 +246100* 20 POSITION KEY IS A DUPLICATE OF ANOTHER IX2094.2 +246200* RECORD (RECORD NUMBER 191). THE ALTERNATE IX2094.2 +246300* KEY WAS LOADED WITH THE VALUE IX2094.2 +246400* EEEEEDDDDD010ALTKEY2 (KEY FOR RECORD NUMBER IX2094.2 +246500* 195) BEFORE THE START WAS EXECUTED. IX2094.2 +246600* IX2094.2 +246700 START IX-FS1 IX2094.2 +246800 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-5 IX2094.2 +246900 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2094.2 +247000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2094.2 +247100 GO TO START-FAIL-GF-42. IX2094.2 +247200 MOVE FS1-STATUS TO FILESTATUS (6). IX2094.2 +247300 READ IX-FS1 AT END IX2094.2 +247400 MOVE "AT END ON READ" TO COMPUTED-A IX2094.2 +247500 GO TO START-FAIL-GF-42. IX2094.2 +247600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +247700 IF XRECORD-NUMBER (1) EQUAL TO 195 IX2094.2 +247800 PERFORM PASS IX2094.2 +247900 GO TO START-WRITE-GF-42. IX2094.2 +248000 MOVE 65 TO RECNO. IX2094.2 +248100 PERFORM DISPLAY-ALTERNATE-KEY2. IX2094.2 +248200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2094.2 +248300 START-FAIL-GF-42. IX2094.2 +248400 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +248500 PERFORM FAIL. IX2094.2 +248600 MOVE 195 TO CORRECT-18V0. IX2094.2 +248700 GO TO START-WRITE-GF-42. IX2094.2 +248800 START-DELETE-GF-42. IX2094.2 +248900 PERFORM DE-LETE. IX2094.2 +249000 START-WRITE-GF-42. IX2094.2 +249100 PERFORM PRINT-DETAIL. IX2094.2 +249200 START-INIT-GF-43. IX2094.2 +249300 MOVE "START-TEST-GF-43" TO PAR-NAME. IX2094.2 +249400 PERFORM START-INITIALIZE-RECORD. IX2094.2 +249500 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +249600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +249700 MOVE "**" TO FILESTATUS (7) IX2094.2 +249800 GO TO START-DELETE-GF-43. IX2094.2 +249900 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2094.2 +250000 MOVE "FFFFFFFFFG022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +250100 MOVE "380ALTKEY2 " TO FS1-ALTKEY2-1-20. IX2094.2 +250200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +250300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +250400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +250500 START-TEST-GF-43. IX2094.2 +250600* IX2094.2 +250700* START-TEST-GF-43 - THE START STATEMENT USES AN OPERAND IN THE IX2094.2 +250800* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +250900* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +251000* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +251100* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IX2094.2 +251200* IS LOADED WITH "380ALTKEY2". NO SUCH RECORD IX2094.2 +251300* SHOULD BE IN THE FILE. IF IN THE COMPARSION,IX2094.2 +251400* THE LONGER OPERAND IS TRUNCATED ON THE LEFT IX2094.2 +251500* INSTEAD OF ON THE RIGHT THE CONTENTS OF IX2094.2 +251600* THE DATA ITEM WILL MATCH A RECORD IN THE IX2094.2 +251700* FILE. THIS TEST EXPECTS THE LONGER OPERAND IX2094.2 +251800* TO BE TRUNCATED ON THE RIGHT CAUSING NO IX2094.2 +251900* DATA ITEM MATCH AND RESULTING IN AN INVALID IX2094.2 +252000* KEY CONDITION WHEN THE START IS EXECUTED. IX2094.2 +252100* IX2094.2 +252200 START IX-FS1 IX2094.2 +252300 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-10 IX2094.2 +252400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2094.2 +252500 GO TO START-PASS-GF-43. IX2094.2 +252600 MOVE FS1-STATUS TO FILESTATUS (7). IX2094.2 +252700 READ IX-FS1 AT END IX2094.2 +252800 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +252900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +253000 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +253100 PERFORM FAIL. IX2094.2 +253200 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +253300 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +253400 GO TO START-WRITE-GF-43. IX2094.2 +253500 START-PASS-GF-43. IX2094.2 +253600 PERFORM PASS. IX2094.2 +253700 GO TO START-WRITE-GF-43. IX2094.2 +253800 START-DELETE-GF-43. IX2094.2 +253900 PERFORM DE-LETE. IX2094.2 +254000 START-WRITE-GF-43. IX2094.2 +254100 PERFORM PRINT-DETAIL. IX2094.2 +254200 START-INIT-GF-44. IX2094.2 +254300 MOVE "START-TEST-GF-44" TO PAR-NAME. IX2094.2 +254400 PERFORM START-INITIALIZE-RECORD. IX2094.2 +254500 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +254600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +254700 MOVE "**" TO FILESTATUS (8) IX2094.2 +254800 GO TO START-DELETE-GF-44. IX2094.2 +254900 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +255000 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +255100 MOVE "DDDDDDDDDC000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +255200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +255300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +255400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +255500 START-TEST-GF-44. IX2094.2 +255600* IX2094.2 +255700* START-TEST-GF-44 - THIS TEST USES AN OPERAND IN THE IX2094.2 +255800* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +255900* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +256000* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +256100* (POSITIONS 1 THRU 10 OF THE ALTERNATE KEY) ISIX2094.2 +256200* LOADED WITH "DDDDDDDDDC". THIS KEY VALUE IX2094.2 +256300* IS LOWER THAN ANY ALTERNATE KEY VALUE IN IX2094.2 +256400* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +256500* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +256600* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +256700* EXECUTED. IX2094.2 +256800* IX2094.2 +256900 START IX-FS1 IX2094.2 +257000 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-10 IX2094.2 +257100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2094.2 +257200 GO TO START-PASS-GF-44. IX2094.2 +257300 MOVE FS1-STATUS TO FILESTATUS (8). IX2094.2 +257400 READ IX-FS1 AT END IX2094.2 +257500 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +257600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +257700 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +257800 PERFORM FAIL. IX2094.2 +257900 MOVE ALTERNATE-KEY2 (1) TO COMPUTED-A. IX2094.2 +258000 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +258100 GO TO START-WRITE-GF-44. IX2094.2 +258200 START-PASS-GF-44. IX2094.2 +258300 PERFORM PASS. IX2094.2 +258400 GO TO START-WRITE-GF-44. IX2094.2 +258500 START-DELETE-GF-44. IX2094.2 +258600 PERFORM DE-LETE. IX2094.2 +258700 START-WRITE-GF-44. IX2094.2 +258800 PERFORM PRINT-DETAIL. IX2094.2 +258900 START-INIT-GF-45. IX2094.2 +259000 MOVE "START-TEST-GF-45" TO PAR-NAME. IX2094.2 +259100 PERFORM START-INITIALIZE-RECORD. IX2094.2 +259200 IF INIT-FLAG NOT EQUAL TO ZERO IX2094.2 +259300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2094.2 +259400 MOVE "**" TO FILESTATUS (9) IX2094.2 +259500 GO TO START-DELETE-GF-45. IX2094.2 +259600 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2094.2 +259700 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2094.2 +259800 MOVE "WWWWWWWWWW400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2094.2 +259900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +260000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2094.2 +260100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2094.2 +260200 START-TEST-GF-45. IX2094.2 +260300* IX2094.2 +260400* START-TEST-GF-45 - THIS TEST USES AN OPERAND IN THE IX2094.2 +260500* KEY PHRASE OF THE START STATEMENT WHICH IS IX2094.2 +260600* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2094.2 +260700* NAME. THE CONTENTS OF THE DATA ITEM IX2094.2 +260800* (POSITIONS 1 THRU 10 OF THE ALTERNATE KEY) ISIX2094.2 +260900* LOADED WITH "WWWWWWWWWW". THIS KEY VALUE IX2094.2 +261000* IS GREATER THAN ANY ALTERNATE KEY VALUE IN IX2094.2 +261100* POSITION 1 THRU 10 EXISTING IN THE FILE IX2094.2 +261200* THEREFORE AN INVALID KEY CONDITION IS IX2094.2 +261300* EXPECTED WHEN THE START STATEMENT IS IX2094.2 +261400* EXECUTED. IX2094.2 +261500* IX2094.2 +261600 START IX-FS1 IX2094.2 +261700 KEY IS EQUAL TO IX-FS1-ALTKEY2-1-10 IX2094.2 +261800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2094.2 +261900 GO TO START-PASS-GF-45. IX2094.2 +262000 MOVE FS1-STATUS TO FILESTATUS (9). IX2094.2 +262100 READ IX-FS1 AT END IX2094.2 +262200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2094.2 +262300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2094.2 +262400 MOVE "IX-36; 4.7.2 ETC. " TO RE-MARKIX2094.2 +262500 PERFORM FAIL. IX2094.2 +262600 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2094.2 +262700 MOVE "INVALID KEY" TO CORRECT-A. IX2094.2 +262800 GO TO START-WRITE-GF-45. IX2094.2 +262900 START-PASS-GF-45. IX2094.2 +263000 PERFORM PASS. IX2094.2 +263100 GO TO START-WRITE-GF-45. IX2094.2 +263200 START-DELETE-GF-45. IX2094.2 +263300 PERFORM DE-LETE. IX2094.2 +263400 START-WRITE-GF-45. IX2094.2 +263500 PERFORM PRINT-DETAIL. IX2094.2 +263600 IX2094.2 +263700 CLOSE IX-FS1. IX2094.2 +263800 IX2094.2 +263900 START-INIT-FILE-STATUS-03. IX2094.2 +264000 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +264100 MOVE "START-TEST-GF-46" TO PAR-NAME. IX2094.2 +264200* IX2094.2 +264300* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2094.2 +264400* CAPTURED FROM THE NINE TESTS BEFORE. IX2094.2 +264500* IX2094.2 +264600 START-TEST-GF-46. IX2094.2 +264700 IF FILESTATUS (1) EQUAL TO "**" IX2094.2 +264800 PERFORM DE-LETE IX2094.2 +264900 GO TO START-WRITE-GF-46. IX2094.2 +265000* IX2094.2 +265100* START-TEST-GF-046 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +265200* RESULTING FROM START-TEST-GF-37. THE FILE IX2094.2 +265300* STATUS CONTENTS IS EXPECTED TO BE "00". IX2094.2 +265400* IX2094.2 +265500 IF FILESTATUS (1) EQUAL TO "00" IX2094.2 +265600 PERFORM PASS IX2094.2 +265700 ELSE IX2094.2 +265800 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-37 " TO RE-MARKIX2094.2 +265900 PERFORM FAIL IX2094.2 +266000 MOVE "00" TO CORRECT-A IX2094.2 +266100 MOVE FILESTATUS (1) TO COMPUTED-A. IX2094.2 +266200 START-WRITE-GF-46. IX2094.2 +266300 PERFORM PRINT-DETAIL. IX2094.2 +266400 START-TEST-GF-47. IX2094.2 +266500 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +266600 MOVE "START-TEST-GF-47" TO PAR-NAME. IX2094.2 +266700 IF FILESTATUS (2) EQUAL TO "**" IX2094.2 +266800 PERFORM DE-LETE IX2094.2 +266900 GO TO START-WRITE-GF-47. IX2094.2 +267000* IX2094.2 +267100* START-TEST-GF-47 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +267200* RESULTING FROM START-TEST-GF-38. THE FILE IX2094.2 +267300* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +267400* IX2094.2 +267500 IF FILESTATUS (2) EQUAL TO "23" IX2094.2 +267600 PERFORM PASS IX2094.2 +267700 ELSE PERFORM FAIL IX2094.2 +267800 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-38 " TO RE-MARKIX2094.2 +267900 MOVE "23" TO CORRECT-A IX2094.2 +268000 MOVE FILESTATUS (2) TO COMPUTED-A. IX2094.2 +268100 START-WRITE-GF-47. IX2094.2 +268200 PERFORM PRINT-DETAIL. IX2094.2 +268300 START-TEST-GF-48. IX2094.2 +268400 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +268500 MOVE "START-TEST-GF-48" TO PAR-NAME. IX2094.2 +268600 IF FILESTATUS (3) EQUAL TO "**" IX2094.2 +268700 PERFORM DE-LETE IX2094.2 +268800 GO TO START-WRITE-GF-48. IX2094.2 +268900* IX2094.2 +269000* START-TEST-GF-48 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +269100* RESULTING FROM START-TEST-GF-39. THE FILE IX2094.2 +269200* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +269300* IX2094.2 +269400 IF FILESTATUS (3) EQUAL TO "23" IX2094.2 +269500 PERFORM PASS IX2094.2 +269600 ELSE PERFORM FAIL IX2094.2 +269700 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-39 " TO RE-MARKIX2094.2 +269800 MOVE "23" TO CORRECT-A IX2094.2 +269900 MOVE FILESTATUS (3) TO COMPUTED-A. IX2094.2 +270000 START-WRITE-GF-48. IX2094.2 +270100 PERFORM PRINT-DETAIL. IX2094.2 +270200 START-TEST-GF-49. IX2094.2 +270300 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +270400 MOVE "START-TEST-GF-49" TO PAR-NAME. IX2094.2 +270500 IF FILESTATUS (4) EQUAL TO "**" IX2094.2 +270600 PERFORM DE-LETE IX2094.2 +270700 GO TO START-WRITE-GF-49. IX2094.2 +270800* IX2094.2 +270900* START-TEST-GF-49 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +271000* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +271100* RESULTING FROM START-TEST-GF-40. THE FILE IX2094.2 +271200* IX2094.2 +271300 IF FILESTATUS (4) EQUAL TO "23" IX2094.2 +271400 PERFORM PASS IX2094.2 +271500 ELSE PERFORM FAIL IX2094.2 +271600 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-40 " TO RE-MARKIX2094.2 +271700 MOVE "23" TO CORRECT-A IX2094.2 +271800 MOVE FILESTATUS (4) TO COMPUTED-A. IX2094.2 +271900 START-WRITE-GF-49. IX2094.2 +272000 PERFORM PRINT-DETAIL. IX2094.2 +272100 START-TEST-GF-50. IX2094.2 +272200 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +272300 MOVE "START-TEST-GF-50" TO PAR-NAME. IX2094.2 +272400 IF FILESTATUS (5) EQUAL TO "**" IX2094.2 +272500 PERFORM DE-LETE IX2094.2 +272600 GO TO START-WRITE-GF-50. IX2094.2 +272700* IX2094.2 +272800* START-TEST-GF-50 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +272900* RESULTING FROM START-TEST-GF-41. THE FILE IX2094.2 +273000* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +273100* IX2094.2 +273200 IF FILESTATUS (5) EQUAL TO "00" IX2094.2 +273300 PERFORM PASS IX2094.2 +273400 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-41 " TO RE-MARKIX2094.2 +273500 ELSE PERFORM FAIL IX2094.2 +273600 MOVE "00" TO CORRECT-A IX2094.2 +273700 MOVE FILESTATUS (5) TO COMPUTED-A. IX2094.2 +273800 START-WRITE-GF-50. IX2094.2 +273900 MOVE "FROM START-TEST-007.05" TO RE-MARK. IX2094.2 +274000 PERFORM PRINT-DETAIL. IX2094.2 +274100 START-TEST-GF-51. IX2094.2 +274200 MOVE "FILE STATUS START:00" TO FEATURE. IX2094.2 +274300 MOVE "START-TEST-GF-51" TO PAR-NAME. IX2094.2 +274400 IF FILESTATUS (6) EQUAL TO "**" IX2094.2 +274500 PERFORM DE-LETE IX2094.2 +274600 GO TO START-WRITE-GF-51. IX2094.2 +274700* IX2094.2 +274800* START-TEST-GF-51 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +274900* RESULTING FROM START-TEST-GF-42. THE FILE IX2094.2 +275000* STATUS CONTENTS IS EXPECTED TO BE "00" IX2094.2 +275100* IX2094.2 +275200 IF FILESTATUS (6) EQUAL TO "00" IX2094.2 +275300 PERFORM PASS IX2094.2 +275400 ELSE PERFORM FAIL IX2094.2 +275500 MOVE "IX-3; 1.3.4 (1) A; SEE START-TEST-GF-42 " TO RE-MARKIX2094.2 +275600 MOVE "00" TO CORRECT-A IX2094.2 +275700 MOVE FILESTATUS (6) TO COMPUTED-A. IX2094.2 +275800 START-WRITE-GF-51. IX2094.2 +275900 PERFORM PRINT-DETAIL. IX2094.2 +276000 START-TEST-GF-52. IX2094.2 +276100 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +276200 MOVE "START-TEST-GF-52" TO PAR-NAME. IX2094.2 +276300 IF FILESTATUS (7) EQUAL TO "**" IX2094.2 +276400 PERFORM DE-LETE IX2094.2 +276500 GO TO START-WRITE-GF-52. IX2094.2 +276600* IX2094.2 +276700* START-TEST-GF-52 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +276800* RESULTING FROM START-TEST-GF-43. THE FILE IX2094.2 +276900* STATUS CONTENTS IS EXPECTED TO BE "23" IX2094.2 +277000* IX2094.2 +277100 IF FILESTATUS (7) EQUAL TO "23" IX2094.2 +277200 PERFORM PASS IX2094.2 +277300 ELSE PERFORM FAIL IX2094.2 +277400 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-43 " TO RE-MARKIX2094.2 +277500 MOVE "23" TO CORRECT-A IX2094.2 +277600 MOVE FILESTATUS (7) TO COMPUTED-A. IX2094.2 +277700 START-WRITE-GF-52. IX2094.2 +277800 PERFORM PRINT-DETAIL. IX2094.2 +277900 START-TEST-GF-53. IX2094.2 +278000 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +278100 MOVE "START-TEST-GF-53" TO PAR-NAME. IX2094.2 +278200 IF FILESTATUS (8) EQUAL TO "**" IX2094.2 +278300 PERFORM DE-LETE IX2094.2 +278400 GO TO START-WRITE-GF-53. IX2094.2 +278500* IX2094.2 +278600* START-TEST-GF-53 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +278700* RESULTING FROM START-TEST-GF-44. THE FILE IX2094.2 +278800* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +278900* IX2094.2 +279000 IF FILESTATUS (8) EQUAL TO "23" IX2094.2 +279100 PERFORM PASS IX2094.2 +279200 ELSE PERFORM FAIL IX2094.2 +279300 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-44 " TO RE-MARKIX2094.2 +279400 MOVE "23" TO CORRECT-A IX2094.2 +279500 MOVE FILESTATUS (8) TO COMPUTED-A. IX2094.2 +279600 START-WRITE-GF-53. IX2094.2 +279700 PERFORM PRINT-DETAIL. IX2094.2 +279800 START-TEST-GF-54. IX2094.2 +279900 MOVE "FILE STATUS START:23" TO FEATURE. IX2094.2 +280000 MOVE "START-TEST-GF-54" TO PAR-NAME. IX2094.2 +280100 IF FILESTATUS (9) EQUAL TO "**" IX2094.2 +280200 PERFORM DE-LETE IX2094.2 +280300 GO TO START-WRITE-GF-54. IX2094.2 +280400* IX2094.2 +280500* START-TEST-GF-54 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2094.2 +280600* RESULTING FROM START-TEST-GF-45. THE FILE IX2094.2 +280700* STATUS CONTENTS IS EXPECTED TO BE "23". IX2094.2 +280800* IX2094.2 +280900 IF FILESTATUS (9) EQUAL TO "23" IX2094.2 +281000 PERFORM PASS IX2094.2 +281100 ELSE PERFORM FAIL IX2094.2 +281200 MOVE "IX-4; 1.3.4 (3) C; SEE START-TEST-GF-45 " TO RE-MARKIX2094.2 +281300 MOVE "23" TO CORRECT-A IX2094.2 +281400 MOVE FILESTATUS (9) TO COMPUTED-A. IX2094.2 +281500 START-WRITE-GF-54. IX2094.2 +281600 PERFORM PRINT-DETAIL. IX2094.2 +281700*START-WRITE-008. IX2094.2 +281800 GO TO START-TEST-COMPLETE. IX2094.2 +281900*START-CLOSE-FILES. IX2094.2 +282000* GO TO START-TEST-COMPLETE. IX2094.2 +282100 START-INITIALIZE-RECORD. IX2094.2 +282200 MOVE "GGGGGGGGGG200" TO FS1-RECKEY-1-13. IX2094.2 +282300 MOVE ZERO TO INIT-FLAG. IX2094.2 +282400 MOVE 9999 TO XRECORD-NUMBER (1). IX2094.2 +282500 MOVE SPACE TO IX-FS1R1-F-G-240. IX2094.2 +282600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2094.2 +282700 START IX-FS1 KEY IS EQUAL TO IX-FS1-KEY INVALID KEY IX2094.2 +282800 MOVE 1 TO INIT-FLAG. IX2094.2 +282900 READ IX-FS1 INTO FILE-RECORD-INFO (1) IX2094.2 +283000 AT END MOVE 1 TO INIT-FLAG. IX2094.2 +283100 IF XRECORD-NUMBER (1) NOT EQUAL TO 100 IX2094.2 +283200 MOVE 1 TO INIT-FLAG. IX2094.2 +283300 MOVE "**" TO FS1-STATUS. IX2094.2 +283400 DISPLAY-RECORD-KEYS. IX2094.2 +283500 MOVE XRECORD-KEY (1) TO WRK-FS1-RECKEY. IX2094.2 +283600 MOVE FS1-RECKEY-1-13 TO COMPUTED-A. IX2094.2 +283700 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2094.2 +283800 MOVE SPACE TO P-OR-F. IX2094.2 +283900 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2094.2 +284000 PERFORM PRINT-DETAIL. IX2094.2 +284100 DISPLAY-ALTERNATE-KEY1. IX2094.2 +284200 MOVE ALTERNATE-KEY1 (1) TO WRK-FS1-ALTKEY1. IX2094.2 +284300 MOVE FS1-ALTKEY1-1-20 TO COMPUTED-A. IX2094.2 +284400 MOVE ALTKEY1-VALUE (RECNO) TO CORRECT-A. IX2094.2 +284500 MOVE SPACE TO P-OR-F. IX2094.2 +284600 MOVE "ALTERNATE RECORD KEY1 VALUES" TO RE-MARK. IX2094.2 +284700 PERFORM PRINT-DETAIL. IX2094.2 +284800 DISPLAY-ALTERNATE-KEY2. IX2094.2 +284900 MOVE ALTERNATE-KEY2 (1) TO WRK-FS1-ALTKEY2. IX2094.2 +285000 MOVE FS1-ALTKEY2-1-20 TO COMPUTED-A. IX2094.2 +285100 MOVE ALTKEY2-VALUE (RECNO) TO CORRECT-A. IX2094.2 +285200 MOVE SPACE TO P-OR-F. IX2094.2 +285300 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2094.2 +285400 PERFORM PRINT-DETAIL. IX2094.2 +285500 START-TEST-COMPLETE. IX2094.2 +285600 EXIT. IX2094.2 +285700 CCVS-EXIT SECTION. IX2094.2 +285800 CCVS-999999. IX2094.2 +285900 GO TO CLOSE-FILES. IX2094.2 diff --git a/tests/cobol85/IX/IX210A.CBL b/tests/cobol85/IX/IX210A.CBL new file mode 100755 index 00000000..0d996619 --- /dev/null +++ b/tests/cobol85/IX/IX210A.CBL @@ -0,0 +1,2333 @@ +000100 IDENTIFICATION DIVISION. IX2104.2 +000200 PROGRAM-ID. IX2104.2 +000300 IX210A. IX2104.2 +000400**************************************************************** IX2104.2 +000500* * IX2104.2 +000600* VALIDATION FOR:- * IX2104.2 +000700* * IX2104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2104.2 +000900* * IX2104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2104.2 +001100* * IX2104.2 +001200**************************************************************** IX2104.2 +001300* * IX2104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2104.2 +001500* * IX2104.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2104.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2104.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2104.2 +001900* * IX2104.2 +002000**************************************************************** IX2104.2 +002100* THE PURPOSE OF THE PROGRAM IS TO TEST USE OF THE IX2104.2 +002200* START --- GREATER THAN --- STATEMENT USING FIRST THE PRIME IX2104.2 +002300* RECORD KEY AND THEN WITH AN ALTERNATE RECORD KEY IX2104.2 +002400* AS THE KEY OF REFERENCE. THE START STATEMENT NAMES, IX2104.2 +002500* IN ITS CONSTRUCT , EITHER THE DATA NAME SPECIFIED IN THE IX2104.2 +002600* KEY CLAUSE OR A DATA ITEM THAT IS SUBORDINATE TO THE IX2104.2 +002700* KEY NAME. DIFFERENT KEY VALUES ARE USED FOR TESTING. IX2104.2 +002800* IF A KEY VALUE IS PROVIDED WHICH MATCHES A RECORD IN THE FILEIX2104.2 +002900* WHEN THE START IS EXECUTED THEN THE RECORD IS EXPECTED TO IX2104.2 +003000* MADE AVAILABLE BY THE SUBSEQUENT READ STATEMENT. IF A KEY IX2104.2 +003100* VALUE IS PROVIDED WHICH DOES NOT MATCH ANY RECORD IN THE IX2104.2 +003200* FILE THEN THE INVALID KEY PATH IS EXPECTED TO BE TAKEN. IX2104.2 +003300* THE FILE STATUS CONTENTS RESULTING FROM EXECUTION OF THE IX2104.2 +003400* START TESTS ARE SAVED AND CHECKED IN LATER TESTS. IX2104.2 +003500* IX2104.2 +003600* REFERENCE AMERICAN NATIONAL STANDARD IX2104.2 +003700* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IX2104.2 +003800* SECTION IX, INDEX I-O, THE START IX2104.2 +003900* STATEMENT. PARAGRAPHS 4.7.3 (3); IX2104.2 +004000* 4.7.4 (1), (4), (4)IX2104.2 +004100* AND IX2104.2 +004200* THE FILE STATUS PARAGRAPH 1.3.4 IX2104.2 +004300* IX2104.2 +004400* BEFORE EXECUTION OF THE START IN EACH TEST, A RECORD IS MADE IX2104.2 +004500* AVAILABLE FROM THE FILE THAT IS DIFFERENT THAN WILL RESULT IX2104.2 +004600* FROM THE TEST, AND THE RECORD KEY IS LOADED WITH A KEY VALUE.IX2104.2 +004700* DEPENDING ON THE NATURE OF THE TEST THE KEY VALUE MAY OR IX2104.2 +004800* MAY NOT BE A VALID KEY FOR THE FILE. IX2104.2 +004900* IX2104.2 +005000* THIS PROGRAM FIRST CREATES AN INDEXED SEQUENTIAL FILE IX2104.2 +005100* CONTAINING TWO ALTERNATE KEYS AND THE ONE REQUIRED RECORD IX2104.2 +005200* KEY FOR THE FILE. IMMEDIATELY FOLLOWING FILE CREATION THE IX2104.2 +005300* FILE IS READ AND THE RECORDS OF THE FILE VERIFIED FOR IX2104.2 +005400* ACCURACY. NEXT THE TESTS ARE EXECUTED USING THE START --- IX2104.2 +005500* GREATER THAN ---STATEMENT. IX2104.2 +005600* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2104.2 +005700* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA IX2104.2 +005800* CONTENTS FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN IX2104.2 +005900* THE FILE. IX2104.2 +006000* IX2104.2 +006100* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2104.2 +006200* ------ ---------- --------------- --------------- IX2104.2 +006300* 001 BBBBBBBBBC002 EEEEEEEEEF000ALTKEY1 WWWWWWWWWV398ALTKEY2IX2104.2 +006400* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2104.2 +006500* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2104.2 +006600* . . . . IX2104.2 +006700* . . . . IX2104.2 +006800* . . . . IX2104.2 +006900* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2104.2 +007000* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2104.2 +007100* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2104.2 +007200* . . . . IX2104.2 +007300* . . . . IX2104.2 +007400* . . . . IX2104.2 +007500* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEY2IX2104.2 +007600* IX2104.2 +007700* NOTE 1 - ALTERNATE KEY NUMBER 2 CONTAINS DUPLICATE KEYS IX2104.2 +007800* EVERY 10TH AND 11TH RECORDS. IX2104.2 +007900* IX2104.2 +008000* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE IX2104.2 +008100* FILE FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE MIDDLEIX2104.2 +008200* 125 RECORDS ONLY THE NUMBER PART OF THE KEYS ARE VARIED IX2104.2 +008300* AND VARIED IN THE SEQUENCE SHOWN ABOVE. THAT IS, RECORD-KEY IX2104.2 +008400* AND ALTERNATE-KEY-1 ARE INCREMENTED BY 2 AND THE ALTERNATE- IX2104.2 +008500* KEY-2 IS DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO IX2104.2 +008600* THE FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO THAT IX2104.2 +008700* AN I-O OPERATION IS REQUIRED FOR EACH RECORD ACCESSED FROM IX2104.2 +008800* THE FILE. IX2104.2 +008900* IX2104.2 +009000* FILE CHARACTERISTICS ARE: FILE SIZE = 200 RECORDS IX2104.2 +009100* RECORD SIZE = 240 CHARS. IX2104.2 +009200* RECORD KEY SIZE = 13 CHARS. IX2104.2 +009300* ALTERNATE KEY 1 SIZE = 20 CHARS. IX2104.2 +009400* ALTERNATE KEY 2 SIZE = 20 CHARS. IX2104.2 +009500* ACCESS MODE = SEQUENTIAL IX2104.2 +009600* IX2104.2 +009700* A LIST OF COBOL ELEMENTS WITH THE PARAGRAPH NAME IN PARENTH- IX2104.2 +009800* ESIS THAT TESTS THE ELEMENT AND A SHORT DESCRIPTION OF THE IX2104.2 +009900* TEST FOLLOWS. IX2104.2 +010000* IX2104.2 +010100* PROGRAM COLLATING SEQUENCE CLAUSE. (ALL START TESTS) - IX2104.2 +010200* THE PROGRAM COLLATING SEQUENCE CLAUSE SHOULD HAVE NO IX2104.2 +010300* EFFECT ON THE COMARAISIONS ASSOCIATED WITH THE START IX2104.2 +010400* STATEMENT. THIS PROGRAM ASSUMES THAT THE PROGRAM IX2104.2 +010500* COLLATING SEQUENCE CLAUSE ALSO DOES NOT IN ANY WAY IX2104.2 +010600* EFFECT THE SEQUENTIAL ORDER OF RECORDS ACCESSED IX2104.2 +010700* FROM OR WRITTEN TO THE FILE. IX2104.2 +010800* WRITE --- INVALID KEY---. (INX-TEST-001) - THIS TEST CREATEIX2104.2 +010900* A FILE OF 200 RECORDS CONTAINING ONE RECORD KEY AND IX2104.2 +011000* TWO ALTERNATE KEYS. IX2104.2 +011100* READ ---AT END ---. (INX-TEST-002) - THIS TEST READS THE IX2104.2 +011200* FILE CREATED IN INX-TEST-001 AND VERIFIES THAT THE IX2104.2 +011300* FILE WAS CREATED CORRECTLY. IX2104.2 +011400* START ---KEY GREATER THAN RECORD-KEY INVALID KEY ---. (INX-IX2104.2 +011500* TEST-003.01 THRU INX-TEST-003.04) - THE START IX2104.2 +011600* STATEMENT IS EXECUTED USING THE RECORD-KEY FOR THE IX2104.2 +011700* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2104.2 +011800* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2104.2 +011900* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2104.2 +012000* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2104.2 +012100* FILE (.04). IX2104.2 +012200* START ---KEY GREATER THAN DATA-ITEM INVALID KEY ---. (INX-IX2104.2 +012300* TEST-003.05 THRU INX-TEST-003.09) - THE START IX2104.2 +012400* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2104.2 +012500* SUBORDINATE TO THE RECORD-KEY NAME OF THE FILE IX2104.2 +012600* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2104.2 +012700* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2104.2 +012800* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2104.2 +012900* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2104.2 +013000* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2104.2 +013100* THE LAST RECORD IN THE FILE (.09. IX2104.2 +013200* IX2104.2 +013300* NOTE -- IN SOME OF THE TESTS THE DATA ITEM SPECIFIED IX2104.2 +013400* IS AN ENTRY SUBORDINATE TO A REDEFINES IX2104.2 +013500* ENTRY WHICH USES AS ITS OBJECT THE KEY IX2104.2 +013600* NAMED BY THE RECORD KEY CLAUSE. IX2104.2 +013700* IX2104.2 +013800* FILE STATUS. (INX-TEST-004.01 THRU INX-TEST-004.09) - THESEIX2104.2 +013900* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2104.2 +014000* FROM THE START IN INX-TEST-003.01 THRU IX2104.2 +014100* INX-TEST-003.09. IX2104.2 +014200* START ---KEY GREATER THAN ALTNATE-KEY INVALID KEY --. (INX-IX2104.2 +014300* TEST-005.01 THRU INX-TEST-005.04) - THE START IX2104.2 +014400* STATEMENT IS EXECUTED USING THE ALTERNATE-KEY FOR THEIX2104.2 +014500* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2104.2 +014600* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2104.2 +014700* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2104.2 +014800* (.03) AND GREATER THAN THAN THE LAST RECORD IN THE IX2104.2 +014900* FILE (.04). IX2104.2 +015000* START ---KEY GREATER THAN DATA-ITEM INVALID KEY --. (INX-IX2104.2 +015100* TEST-005.05 THRU INX-TEST-005.09) - THE START IX2104.2 +015200* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2104.2 +015300* SUBORDINATE TO THE ALTERNATE-KEY NAME OF THE FILE IX2104.2 +015400* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2104.2 +015500* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2104.2 +015600* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2104.2 +015700* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2104.2 +015800* THE FIRST RECORD IN THE FILE (.08) AND GREATER THAN IX2104.2 +015900* THE LAST RECORD IN THE FILE (.09. IX2104.2 +016000* IX2104.2 +016100* NOTE -- IN SOME OF THE TESTS THE DATA ITEM SPECIFIED IX2104.2 +016200* IS AN ENTRY SUBORDINATE TO A REDEFINES IX2104.2 +016300* ENTRY WHICH USES AS ITS OBJECT THE KEY IX2104.2 +016400* NAMED BY THE RECORD KEY CLAUSE. IX2104.2 +016500* IX2104.2 +016600* FILE STATUS. (INX-TEST-006.01 THRU INX-TEST-006.09) - THESEIX2104.2 +016700* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2104.2 +016800* FROM THE START IN INX-TEST-005.01 THRU IX2104.2 +016900* INX-TEST-005.09. IX2104.2 +017000* MULTIPLE STARTS. (INX-TEST-007) - THIS TEST EXECUTES IX2104.2 +017100* SEVERAL START STATEMENTS FOLLOWED BY A READ STATEMENTIX2104.2 +017200* AND EXPECTS THE RECORD DESIGNATED BY THE LAST IX2104.2 +017300* START BE MADE AVAILABLE. IX2104.2 +017400* IX2104.2 +017500******************************************************************IX2104.2 +017600* IX2104.2 +017700 ENVIRONMENT DIVISION. IX2104.2 +017800 CONFIGURATION SECTION. IX2104.2 +017900 SOURCE-COMPUTER. IX2104.2 +018000 Linux. IX2104.2 +018100 OBJECT-COMPUTER. IX2104.2 +018200 Linux IX2104.2 +018300 PROGRAM COLLATING SEQUENCE IS FOR-INX-START-TEST. IX2104.2 +018400 SPECIAL-NAMES. IX2104.2 +018500 ALPHABET IX2104.2 +018600 FOR-INX-START-TEST IS "WVUTSRJIHGFEDCB". IX2104.2 +018700 INPUT-OUTPUT SECTION. IX2104.2 +018800 FILE-CONTROL. IX2104.2 +018900*P SELECT RAW-DATA ASSIGN TO IX2104.2 +019000*P "XXXXX062" IX2104.2 +019100*P ORGANIZATION IS INDEXED IX2104.2 +019200*P ACCESS MODE IS RANDOM IX2104.2 +019300*P RECORD KEY IS RAW-DATA-KEY. IX2104.2 +019400 SELECT PRINT-FILE ASSIGN TO IX2104.2 +019500 "report.log". IX2104.2 +019600 SELECT IX-FS1 IX2104.2 +019700 ASSIGN TO IX2104.2 +019800 "XXXXX024" IX2104.2 +019900*J **** X-CARD UNDEFINED **** IX2104.2 +020000 ACCESS MODE IS SEQUENTIAL IX2104.2 +020100 ORGANIZATION IS INDEXED IX2104.2 +020200 RECORD KEY IS IX-FS1-KEY IX2104.2 +020300 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY1 IX2104.2 +020400 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY2 WITH DUPLICATES IX2104.2 +020500 FILE STATUS IS FS1-STATUS. IX2104.2 +020600 DATA DIVISION. IX2104.2 +020700 FILE SECTION. IX2104.2 +020800*P IX2104.2 +020900*PD RAW-DATA. IX2104.2 +021000*P IX2104.2 +021100*P1 RAW-DATA-SATZ. IX2104.2 +021200*P 05 RAW-DATA-KEY PIC X(6). IX2104.2 +021300*P 05 C-DATE PIC 9(6). IX2104.2 +021400*P 05 C-TIME PIC 9(8). IX2104.2 +021500*P 05 C-NO-OF-TESTS PIC 99. IX2104.2 +021600*P 05 C-OK PIC 999. IX2104.2 +021700*P 05 C-ALL PIC 999. IX2104.2 +021800*P 05 C-FAIL PIC 999. IX2104.2 +021900*P 05 C-DELETED PIC 999. IX2104.2 +022000*P 05 C-INSPECT PIC 999. IX2104.2 +022100*P 05 C-NOTE PIC X(13). IX2104.2 +022200*P 05 C-INDENT PIC X. IX2104.2 +022300*P 05 C-ABORT PIC X(8). IX2104.2 +022400 FD PRINT-FILE. IX2104.2 +022500 01 PRINT-REC PICTURE X(120). IX2104.2 +022600 01 DUMMY-RECORD PICTURE X(120). IX2104.2 +022700 FD IX-FS1 IX2104.2 +022800*C LABEL RECORDS ARE STANDARD IX2104.2 +022900*C DATA RECORD IS IX-FS1R1-F-G-240 IX2104.2 +023000 RECORD CONTAINS 240 CHARACTERS. IX2104.2 +023100 01 IX-FS1R1-F-G-240. IX2104.2 +023200 05 IX-FS1-REC-120 PICTURE X(120). IX2104.2 +023300 05 IX-FS1-REC-121-240. IX2104.2 +023400 10 FILLER PICTURE X(8). IX2104.2 +023500 10 IX-REC-KEY-AREA. IX2104.2 +023600 15 IX-FS1-KEY. IX2104.2 +023700 20 IX-FS1-KEY-1-10. IX2104.2 +023800 25 IX-FS1-KEY-1-5 PICTURE X(5). IX2104.2 +023900 25 IX-FS1-KEY-6-10 PICTURE X(5). IX2104.2 +024000 20 IX-FS1-KEY-11-13 PICTURE X(3). IX2104.2 +024100 15 IX-REDF-RECKEY REDEFINES IX-FS1-KEY. IX2104.2 +024200 20 R-RECKEY-1-7 PICTURE X(7). IX2104.2 +024300 20 R-RECKEY-8-13 PICTURE X(6). IX2104.2 +024400 15 FILLER PICTURE X(16). IX2104.2 +024500 10 FILLER PICTURE X(9). IX2104.2 +024600 10 IX-ALT-KEY1-AREA. IX2104.2 +024700 15 IX-FS1-ALTKEY1. IX2104.2 +024800 20 IX-FS1-ALTKEY1-1-10. IX2104.2 +024900 25 IX-FS1-ALTKEY1-1-5 PICTURE X(5). IX2104.2 +025000 25 IX-FS1-ALTKEY1-6-10 PICTURE X(5). IX2104.2 +025100 20 IX-FS1-ALTKEY1-11-13 PICTURE X(3). IX2104.2 +025200 20 IX-FS1-ALTKEY1-14-20 PICTURE X(7). IX2104.2 +025300 15 IX-REDF-ALTKEY1 REDEFINES IX-FS1-ALTKEY1. IX2104.2 +025400 20 R-ALTKEY1-1-6 PICTURE X(6). IX2104.2 +025500 20 R-ALTKEY1-7-10 PICTURE X(4). IX2104.2 +025600 20 R-ALTKEY1-11-20 PICTURE X(10). IX2104.2 +025700 15 FILLER PICTURE X(9). IX2104.2 +025800 10 FILLER PICTURE X(9). IX2104.2 +025900 10 IX-ALT-KEY2-AREA. IX2104.2 +026000 15 IX-FS1-ALTKEY2. IX2104.2 +026100 20 IX-FS1-ALTKEY2-1-10. IX2104.2 +026200 25 IX-FS1-ALTKEY2-1-5 PICTURE X(5). IX2104.2 +026300 25 IX-FS1-ALTKEY2-6-10 PICTURE X(5). IX2104.2 +026400 20 IX-FS1-ALTKEY2-11-13 PICTURE X(3). IX2104.2 +026500 20 IX-FS1-ALTKEY2-14-20 PICTURE X(7). IX2104.2 +026600 15 FILLER PICTURE X(9). IX2104.2 +026700 10 FILLER PICTURE X(7). IX2104.2 +026800 WORKING-STORAGE SECTION. IX2104.2 +026900 01 WRK-FS1-RECKEY. IX2104.2 +027000 05 FS1-RECKEY-1-13. IX2104.2 +027100 10 FS1-RECKEY-1-10 PICTURE X(10). IX2104.2 +027200 10 FS1-RECKEY-11-13 PICTURE 9(3). IX2104.2 +027300 05 FILLER PICTURE X(16) VALUE SPACE. IX2104.2 +027400 01 WRK-FS1-ALTKEY1. IX2104.2 +027500 05 FS1-ALTKEY1-1-20. IX2104.2 +027600 10 FS1-ALTKEY1-1-10. IX2104.2 +027700 15 FS1-ALTKEY1-1-5 PICTURE X(5). IX2104.2 +027800 15 FS1-ALTKEY1-6-10 PICTURE X(5). IX2104.2 +027900 10 FS1-ALTKEY1-11-13 PICTURE 9(3). IX2104.2 +028000 10 FS1-ALTKEY1-14-20 PICTURE X(7). IX2104.2 +028100 05 FILLER PICTURE X(9) VALUE SPACE. IX2104.2 +028200 01 WRK-FS1-ALTKEY2. IX2104.2 +028300 05 FS1-ALTKEY2-1-20. IX2104.2 +028400 10 FS1-ALTKEY2-1-10. IX2104.2 +028500 15 FS1-ALTKEY2-1-5 PICTURE X(5). IX2104.2 +028600 15 FS1-ALTKEY2-6-10 PICTURE X(5). IX2104.2 +028700 10 FS1-ALTKEY2-11-13 PICTURE 9(3). IX2104.2 +028800 10 FS1-ALTKEY2-14-20 PICTURE X(7). IX2104.2 +028900 05 FILLER PICTURE X(9) VALUE SPACE. IX2104.2 +029000 01 RECNO PICTURE 9(5) VALUE ZERO. IX2104.2 +029100 01 FS1-STATUS PICTURE XX VALUE SPACE. IX2104.2 +029200 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2104.2 +029300 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2104.2 +029400 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2104.2 +029500 01 RECORDS-WRITTEN PICTURE 9(3). IX2104.2 +029600 01 RECKEY-NUM PICTURE 9(3). IX2104.2 +029700 01 ALTKEY1-NUM PICTURE 9(3). IX2104.2 +029800 01 ALTKEY2-NUM PICTURE 9(3). IX2104.2 +029900 01 RECORD-KEY-CONTENT. IX2104.2 +030000 05 FILLER PIC X(53) VALUE IX2104.2 +030100 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2104.2 +030200 05 FILLER PIC X(53) VALUE IX2104.2 +030300 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2104.2 +030400 05 FILLER PIC X(53) VALUE IX2104.2 +030500 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2104.2 +030600 05 FILLER PIC X(53) VALUE IX2104.2 +030700 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2104.2 +030800 05 FILLER PIC X(53) VALUE IX2104.2 +030900 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2104.2 +031000 05 FILLER PIC X(53) VALUE IX2104.2 +031100 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2104.2 +031200 05 FILLER PIC X(53) VALUE IX2104.2 +031300 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2104.2 +031400 05 FILLER PIC X(53) VALUE IX2104.2 +031500 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2104.2 +031600 05 FILLER PIC X(53) VALUE IX2104.2 +031700 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2104.2 +031800 05 FILLER PIC X(53) VALUE IX2104.2 +031900 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2104.2 +032000 05 FILLER PIC X(53) VALUE IX2104.2 +032100 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2104.2 +032200 05 FILLER PIC X(53) VALUE IX2104.2 +032300 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2104.2 +032400 05 FILLER PIC X(53) VALUE IX2104.2 +032500 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2104.2 +032600 05 FILLER PIC X(53) VALUE IX2104.2 +032700 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2104.2 +032800 05 FILLER PIC X(53) VALUE IX2104.2 +032900 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2104.2 +033000 05 FILLER PIC X(53) VALUE IX2104.2 +033100 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2104.2 +033200 05 FILLER PIC X(53) VALUE IX2104.2 +033300 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2104.2 +033400 05 FILLER PIC X(53) VALUE IX2104.2 +033500 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2104.2 +033600 05 FILLER PIC X(53) VALUE IX2104.2 +033700 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2104.2 +033800 05 FILLER PIC X(53) VALUE IX2104.2 +033900 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2104.2 +034000 05 FILLER PIC X(53) VALUE IX2104.2 +034100 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2104.2 +034200 05 FILLER PIC X(53) VALUE IX2104.2 +034300 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2104.2 +034400 05 FILLER PIC X(53) VALUE IX2104.2 +034500 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2104.2 +034600 05 FILLER PIC X(53) VALUE IX2104.2 +034700 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2104.2 +034800 05 FILLER PIC X(53) VALUE IX2104.2 +034900 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2104.2 +035000 05 FILLER PIC X(53) VALUE IX2104.2 +035100 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2104.2 +035200 05 FILLER PIC X(53) VALUE IX2104.2 +035300 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2104.2 +035400 05 FILLER PIC X(53) VALUE IX2104.2 +035500 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2104.2 +035600 05 FILLER PIC X(53) VALUE IX2104.2 +035700 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2104.2 +035800 05 FILLER PIC X(53) VALUE IX2104.2 +035900 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2104.2 +036000 05 FILLER PIC X(53) VALUE IX2104.2 +036100 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2104.2 +036200 05 FILLER PIC X(53) VALUE IX2104.2 +036300 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2104.2 +036400 05 FILLER PIC X(53) VALUE IX2104.2 +036500 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2104.2 +036600 05 FILLER PIC X(53) VALUE IX2104.2 +036700 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2104.2 +036800 05 FILLER PIC X(53) VALUE IX2104.2 +036900 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2104.2 +037000 05 FILLER PIC X(53) VALUE IX2104.2 +037100 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2104.2 +037200 05 FILLER PIC X(53) VALUE IX2104.2 +037300 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2104.2 +037400 05 FILLER PIC X(53) VALUE IX2104.2 +037500 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2104.2 +037600 05 FILLER PIC X(53) VALUE IX2104.2 +037700 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2104.2 +037800 05 FILLER PIC X(53) VALUE IX2104.2 +037900 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2104.2 +038000 05 FILLER PIC X(53) VALUE IX2104.2 +038100 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2104.2 +038200 05 FILLER PIC X(53) VALUE IX2104.2 +038300 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2104.2 +038400 05 FILLER PIC X(53) VALUE IX2104.2 +038500 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2104.2 +038600 05 FILLER PIC X(53) VALUE IX2104.2 +038700 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2104.2 +038800 05 FILLER PIC X(53) VALUE IX2104.2 +038900 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2104.2 +039000 05 FILLER PIC X(53) VALUE IX2104.2 +039100 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2104.2 +039200 05 FILLER PIC X(53) VALUE IX2104.2 +039300 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2104.2 +039400 05 FILLER PIC X(53) VALUE IX2104.2 +039500 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2104.2 +039600 05 FILLER PIC X(53) VALUE IX2104.2 +039700 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2104.2 +039800 05 FILLER PIC X(53) VALUE IX2104.2 +039900 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2104.2 +040000 05 FILLER PIC X(53) VALUE IX2104.2 +040100 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2104.2 +040200 05 FILLER PIC X(53) VALUE IX2104.2 +040300 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2104.2 +040400 05 FILLER PIC X(53) VALUE IX2104.2 +040500 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2104.2 +040600 05 FILLER PIC X(53) VALUE IX2104.2 +040700 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2104.2 +040800 05 FILLER PIC X(53) VALUE IX2104.2 +040900 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2104.2 +041000 05 FILLER PIC X(53) VALUE IX2104.2 +041100 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2104.2 +041200 05 FILLER PIC X(53) VALUE IX2104.2 +041300 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2104.2 +041400 05 FILLER PIC X(53) VALUE IX2104.2 +041500 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2104.2 +041600 05 FILLER PIC X(53) VALUE IX2104.2 +041700 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2104.2 +041800 05 FILLER PIC X(53) VALUE IX2104.2 +041900 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2104.2 +042000 05 FILLER PIC X(53) VALUE IX2104.2 +042100 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2104.2 +042200 05 FILLER PIC X(53) VALUE IX2104.2 +042300 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2104.2 +042400 05 FILLER PIC X(53) VALUE IX2104.2 +042500 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2104.2 +042600 05 FILLER PIC X(53) VALUE IX2104.2 +042700 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2104.2 +042800 05 FILLER PIC X(53) VALUE IX2104.2 +042900 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2104.2 +043000 05 FILLER PIC X(53) VALUE IX2104.2 +043100 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2104.2 +043200 05 FILLER PIC X(53) VALUE IX2104.2 +043300 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2104.2 +043400 05 FILLER PIC X(53) VALUE IX2104.2 +043500 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2104.2 +043600 05 FILLER PIC X(53) VALUE IX2104.2 +043700 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2104.2 +043800 05 FILLER PIC X(53) VALUE IX2104.2 +043900 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2104.2 +044000 05 FILLER PIC X(53) VALUE IX2104.2 +044100 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2104.2 +044200 05 FILLER PIC X(53) VALUE IX2104.2 +044300 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2104.2 +044400 05 FILLER PIC X(53) VALUE IX2104.2 +044500 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2104.2 +044600 05 FILLER PIC X(53) VALUE IX2104.2 +044700 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2104.2 +044800 05 FILLER PIC X(53) VALUE IX2104.2 +044900 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2104.2 +045000 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2104.2 +045100 05 KEY-VALUES OCCURS 75 TIMES. IX2104.2 +045200 10 RECKEY-VALUE PICTURE X(13). IX2104.2 +045300 10 ALTKEY1-VALUE PICTURE X(20). IX2104.2 +045400 10 ALTKEY2-VALUE PICTURE X(20). IX2104.2 +045500 01 INIT-FLAG PICTURE 9. IX2104.2 +045600 01 HOLD-FILESTATUS-RECORD. IX2104.2 +045700 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX2104.2 +045800 01 FILE-RECORD-INFORMATION-REC. IX2104.2 +045900 03 FILE-RECORD-INFO-SKELETON. IX2104.2 +046000 05 FILLER PICTURE X(48) VALUE IX2104.2 +046100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2104.2 +046200 05 FILLER PICTURE X(46) VALUE IX2104.2 +046300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2104.2 +046400 05 FILLER PICTURE X(26) VALUE IX2104.2 +046500 ",LFIL=000000,ORG= ,LBLR= ". IX2104.2 +046600 05 FILLER PICTURE X(37) VALUE IX2104.2 +046700 ",RECKEY= ". IX2104.2 +046800 05 FILLER PICTURE X(38) VALUE IX2104.2 +046900 ",ALTKEY1= ". IX2104.2 +047000 05 FILLER PICTURE X(38) VALUE IX2104.2 +047100 ",ALTKEY2= ". IX2104.2 +047200 05 FILLER PICTURE X(7) VALUE SPACE.IX2104.2 +047300 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2104.2 +047400 05 FILE-RECORD-INFO-P1-120. IX2104.2 +047500 07 FILLER PIC X(5). IX2104.2 +047600 07 XFILE-NAME PIC X(6). IX2104.2 +047700 07 FILLER PIC X(8). IX2104.2 +047800 07 XRECORD-NAME PIC X(6). IX2104.2 +047900 07 FILLER PIC X(1). IX2104.2 +048000 07 REELUNIT-NUMBER PIC 9(1). IX2104.2 +048100 07 FILLER PIC X(7). IX2104.2 +048200 07 XRECORD-NUMBER PIC 9(6). IX2104.2 +048300 07 FILLER PIC X(6). IX2104.2 +048400 07 UPDATE-NUMBER PIC 9(2). IX2104.2 +048500 07 FILLER PIC X(5). IX2104.2 +048600 07 ODO-NUMBER PIC 9(4). IX2104.2 +048700 07 FILLER PIC X(5). IX2104.2 +048800 07 XPROGRAM-NAME PIC X(5). IX2104.2 +048900 07 FILLER PIC X(7). IX2104.2 +049000 07 XRECORD-LENGTH PIC 9(6). IX2104.2 +049100 07 FILLER PIC X(7). IX2104.2 +049200 07 CHARS-OR-RECORDS PIC X(2). IX2104.2 +049300 07 FILLER PIC X(1). IX2104.2 +049400 07 XBLOCK-SIZE PIC 9(4). IX2104.2 +049500 07 FILLER PIC X(6). IX2104.2 +049600 07 RECORDS-IN-FILE PIC 9(6). IX2104.2 +049700 07 FILLER PIC X(5). IX2104.2 +049800 07 XFILE-ORGANIZATION PIC X(2). IX2104.2 +049900 07 FILLER PIC X(6). IX2104.2 +050000 07 XLABEL-TYPE PIC X(1). IX2104.2 +050100 05 FILE-RECORD-INFO-P121-240. IX2104.2 +050200 07 FILLER PIC X(8). IX2104.2 +050300 07 XRECORD-KEY PIC X(29). IX2104.2 +050400 07 FILLER PIC X(9). IX2104.2 +050500 07 ALTERNATE-KEY1 PIC X(29). IX2104.2 +050600 07 FILLER PIC X(9). IX2104.2 +050700 07 ALTERNATE-KEY2 PIC X(29). IX2104.2 +050800 07 FILLER PIC X(7). IX2104.2 +050900 01 TEST-RESULTS. IX2104.2 +051000 02 FILLER PIC X VALUE SPACE. IX2104.2 +051100 02 FEATURE PIC X(20) VALUE SPACE. IX2104.2 +051200 02 FILLER PIC X VALUE SPACE. IX2104.2 +051300 02 P-OR-F PIC X(5) VALUE SPACE. IX2104.2 +051400 02 FILLER PIC X VALUE SPACE. IX2104.2 +051500 02 PAR-NAME. IX2104.2 +051600 03 FILLER PIC X(19) VALUE SPACE. IX2104.2 +051700 03 PARDOT-X PIC X VALUE SPACE. IX2104.2 +051800 03 DOTVALUE PIC 99 VALUE ZERO. IX2104.2 +051900 02 FILLER PIC X(8) VALUE SPACE. IX2104.2 +052000 02 RE-MARK PIC X(61). IX2104.2 +052100 01 TEST-COMPUTED. IX2104.2 +052200 02 FILLER PIC X(30) VALUE SPACE. IX2104.2 +052300 02 FILLER PIC X(17) VALUE IX2104.2 +052400 " COMPUTED=". IX2104.2 +052500 02 COMPUTED-X. IX2104.2 +052600 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2104.2 +052700 03 COMPUTED-N REDEFINES COMPUTED-A IX2104.2 +052800 PIC -9(9).9(9). IX2104.2 +052900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2104.2 +053000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2104.2 +053100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2104.2 +053200 03 CM-18V0 REDEFINES COMPUTED-A. IX2104.2 +053300 04 COMPUTED-18V0 PIC -9(18). IX2104.2 +053400 04 FILLER PIC X. IX2104.2 +053500 03 FILLER PIC X(50) VALUE SPACE. IX2104.2 +053600 01 TEST-CORRECT. IX2104.2 +053700 02 FILLER PIC X(30) VALUE SPACE. IX2104.2 +053800 02 FILLER PIC X(17) VALUE " CORRECT =". IX2104.2 +053900 02 CORRECT-X. IX2104.2 +054000 03 CORRECT-A PIC X(20) VALUE SPACE. IX2104.2 +054100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2104.2 +054200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2104.2 +054300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2104.2 +054400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2104.2 +054500 03 CR-18V0 REDEFINES CORRECT-A. IX2104.2 +054600 04 CORRECT-18V0 PIC -9(18). IX2104.2 +054700 04 FILLER PIC X. IX2104.2 +054800 03 FILLER PIC X(2) VALUE SPACE. IX2104.2 +054900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2104.2 +055000 01 CCVS-C-1. IX2104.2 +055100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2104.2 +055200- "SS PARAGRAPH-NAME IX2104.2 +055300- " REMARKS". IX2104.2 +055400 02 FILLER PIC X(20) VALUE SPACE. IX2104.2 +055500 01 CCVS-C-2. IX2104.2 +055600 02 FILLER PIC X VALUE SPACE. IX2104.2 +055700 02 FILLER PIC X(6) VALUE "TESTED". IX2104.2 +055800 02 FILLER PIC X(15) VALUE SPACE. IX2104.2 +055900 02 FILLER PIC X(4) VALUE "FAIL". IX2104.2 +056000 02 FILLER PIC X(94) VALUE SPACE. IX2104.2 +056100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2104.2 +056200 01 REC-CT PIC 99 VALUE ZERO. IX2104.2 +056300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2104.2 +056400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2104.2 +056500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2104.2 +056600 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2104.2 +056700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2104.2 +056800 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2104.2 +056900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2104.2 +057000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2104.2 +057100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2104.2 +057200 01 CCVS-H-1. IX2104.2 +057300 02 FILLER PIC X(39) VALUE SPACES. IX2104.2 +057400 02 FILLER PIC X(42) VALUE IX2104.2 +057500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2104.2 +057600 02 FILLER PIC X(39) VALUE SPACES. IX2104.2 +057700 01 CCVS-H-2A. IX2104.2 +057800 02 FILLER PIC X(40) VALUE SPACE. IX2104.2 +057900 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2104.2 +058000 02 FILLER PIC XXXX VALUE IX2104.2 +058100 "4.2 ". IX2104.2 +058200 02 FILLER PIC X(28) VALUE IX2104.2 +058300 " COPY - NOT FOR DISTRIBUTION". IX2104.2 +058400 02 FILLER PIC X(41) VALUE SPACE. IX2104.2 +058500 IX2104.2 +058600 01 CCVS-H-2B. IX2104.2 +058700 02 FILLER PIC X(15) VALUE IX2104.2 +058800 "TEST RESULT OF ". IX2104.2 +058900 02 TEST-ID PIC X(9). IX2104.2 +059000 02 FILLER PIC X(4) VALUE IX2104.2 +059100 " IN ". IX2104.2 +059200 02 FILLER PIC X(12) VALUE IX2104.2 +059300 " HIGH ". IX2104.2 +059400 02 FILLER PIC X(22) VALUE IX2104.2 +059500 " LEVEL VALIDATION FOR ". IX2104.2 +059600 02 FILLER PIC X(58) VALUE IX2104.2 +059700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2104.2 +059800 01 CCVS-H-3. IX2104.2 +059900 02 FILLER PIC X(34) VALUE IX2104.2 +060000 " FOR OFFICIAL USE ONLY ". IX2104.2 +060100 02 FILLER PIC X(58) VALUE IX2104.2 +060200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2104.2 +060300 02 FILLER PIC X(28) VALUE IX2104.2 +060400 " COPYRIGHT 1985 ". IX2104.2 +060500 01 CCVS-E-1. IX2104.2 +060600 02 FILLER PIC X(52) VALUE SPACE. IX2104.2 +060700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2104.2 +060800 02 ID-AGAIN PIC X(9). IX2104.2 +060900 02 FILLER PIC X(45) VALUE SPACES. IX2104.2 +061000 01 CCVS-E-2. IX2104.2 +061100 02 FILLER PIC X(31) VALUE SPACE. IX2104.2 +061200 02 FILLER PIC X(21) VALUE SPACE. IX2104.2 +061300 02 CCVS-E-2-2. IX2104.2 +061400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2104.2 +061500 03 FILLER PIC X VALUE SPACE. IX2104.2 +061600 03 ENDER-DESC PIC X(44) VALUE IX2104.2 +061700 "ERRORS ENCOUNTERED". IX2104.2 +061800 01 CCVS-E-3. IX2104.2 +061900 02 FILLER PIC X(22) VALUE IX2104.2 +062000 " FOR OFFICIAL USE ONLY". IX2104.2 +062100 02 FILLER PIC X(12) VALUE SPACE. IX2104.2 +062200 02 FILLER PIC X(58) VALUE IX2104.2 +062300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2104.2 +062400 02 FILLER PIC X(13) VALUE SPACE. IX2104.2 +062500 02 FILLER PIC X(15) VALUE IX2104.2 +062600 " COPYRIGHT 1985". IX2104.2 +062700 01 CCVS-E-4. IX2104.2 +062800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2104.2 +062900 02 FILLER PIC X(4) VALUE " OF ". IX2104.2 +063000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2104.2 +063100 02 FILLER PIC X(40) VALUE IX2104.2 +063200 " TESTS WERE EXECUTED SUCCESSFULLY". IX2104.2 +063300 01 XXINFO. IX2104.2 +063400 02 FILLER PIC X(19) VALUE IX2104.2 +063500 "*** INFORMATION ***". IX2104.2 +063600 02 INFO-TEXT. IX2104.2 +063700 04 FILLER PIC X(8) VALUE SPACE. IX2104.2 +063800 04 XXCOMPUTED PIC X(20). IX2104.2 +063900 04 FILLER PIC X(5) VALUE SPACE. IX2104.2 +064000 04 XXCORRECT PIC X(20). IX2104.2 +064100 02 INF-ANSI-REFERENCE PIC X(48). IX2104.2 +064200 01 HYPHEN-LINE. IX2104.2 +064300 02 FILLER PIC IS X VALUE IS SPACE. IX2104.2 +064400 02 FILLER PIC IS X(65) VALUE IS "************************IX2104.2 +064500- "*****************************************". IX2104.2 +064600 02 FILLER PIC IS X(54) VALUE IS "************************IX2104.2 +064700- "******************************". IX2104.2 +064800 01 CCVS-PGM-ID PIC X(9) VALUE IX2104.2 +064900 "IX210A". IX2104.2 +065000 PROCEDURE DIVISION. IX2104.2 +065100 CCVS1 SECTION. IX2104.2 +065200 OPEN-FILES. IX2104.2 +065300*P OPEN I-O RAW-DATA. IX2104.2 +065400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2104.2 +065500*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2104.2 +065600*P MOVE "ABORTED " TO C-ABORT. IX2104.2 +065700*P ADD 1 TO C-NO-OF-TESTS. IX2104.2 +065800*P ACCEPT C-DATE FROM DATE. IX2104.2 +065900*P ACCEPT C-TIME FROM TIME. IX2104.2 +066000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2104.2 +066100*PND-E-1. IX2104.2 +066200*P CLOSE RAW-DATA. IX2104.2 +066300 OPEN OUTPUT PRINT-FILE. IX2104.2 +066400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2104.2 +066500 MOVE SPACE TO TEST-RESULTS. IX2104.2 +066600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2104.2 +066700 MOVE ZERO TO REC-SKL-SUB. IX2104.2 +066800 PERFORM CCVS-INIT-FILE 9 TIMES. IX2104.2 +066900 CCVS-INIT-FILE. IX2104.2 +067000 ADD 1 TO REC-SKL-SUB. IX2104.2 +067100 MOVE FILE-RECORD-INFO-SKELETON IX2104.2 +067200 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2104.2 +067300 CCVS-INIT-EXIT. IX2104.2 +067400 GO TO CCVS1-EXIT. IX2104.2 +067500 CLOSE-FILES. IX2104.2 +067600*P OPEN I-O RAW-DATA. IX2104.2 +067700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2104.2 +067800*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2104.2 +067900*P MOVE "OK. " TO C-ABORT. IX2104.2 +068000*P MOVE PASS-COUNTER TO C-OK. IX2104.2 +068100*P MOVE ERROR-HOLD TO C-ALL. IX2104.2 +068200*P MOVE ERROR-COUNTER TO C-FAIL. IX2104.2 +068300*P MOVE DELETE-COUNTER TO C-DELETED. IX2104.2 +068400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2104.2 +068500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2104.2 +068600*PND-E-2. IX2104.2 +068700*P CLOSE RAW-DATA. IX2104.2 +068800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2104.2 +068900 TERMINATE-CCVS. IX2104.2 +069000*S EXIT PROGRAM. IX2104.2 +069100*SERMINATE-CALL. IX2104.2 +069200 STOP RUN. IX2104.2 +069300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2104.2 +069400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2104.2 +069500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2104.2 +069600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2104.2 +069700 MOVE "****TEST DELETED****" TO RE-MARK. IX2104.2 +069800 PRINT-DETAIL. IX2104.2 +069900 IF REC-CT NOT EQUAL TO ZERO IX2104.2 +070000 MOVE "." TO PARDOT-X IX2104.2 +070100 MOVE REC-CT TO DOTVALUE. IX2104.2 +070200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2104.2 +070300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2104.2 +070400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2104.2 +070500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2104.2 +070600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2104.2 +070700 MOVE SPACE TO CORRECT-X. IX2104.2 +070800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2104.2 +070900 MOVE SPACE TO RE-MARK. IX2104.2 +071000 HEAD-ROUTINE. IX2104.2 +071100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +071200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +071300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2104.2 +071400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2104.2 +071500 COLUMN-NAMES-ROUTINE. IX2104.2 +071600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +071700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +071800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +071900 END-ROUTINE. IX2104.2 +072000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2104.2 +072100 END-RTN-EXIT. IX2104.2 +072200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +072300 END-ROUTINE-1. IX2104.2 +072400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2104.2 +072500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2104.2 +072600 ADD PASS-COUNTER TO ERROR-HOLD. IX2104.2 +072700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2104.2 +072800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2104.2 +072900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2104.2 +073000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2104.2 +073100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2104.2 +073200 END-ROUTINE-12. IX2104.2 +073300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2104.2 +073400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2104.2 +073500 MOVE "NO " TO ERROR-TOTAL IX2104.2 +073600 ELSE IX2104.2 +073700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2104.2 +073800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2104.2 +073900 PERFORM WRITE-LINE. IX2104.2 +074000 END-ROUTINE-13. IX2104.2 +074100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2104.2 +074200 MOVE "NO " TO ERROR-TOTAL ELSE IX2104.2 +074300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2104.2 +074400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2104.2 +074500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +074600 IF INSPECT-COUNTER EQUAL TO ZERO IX2104.2 +074700 MOVE "NO " TO ERROR-TOTAL IX2104.2 +074800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2104.2 +074900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2104.2 +075000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +075100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2104.2 +075200 WRITE-LINE. IX2104.2 +075300 ADD 1 TO RECORD-COUNT. IX2104.2 +075400 IF RECORD-COUNT GREATER 42 IX2104.2 +075500 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2104.2 +075600 MOVE SPACE TO DUMMY-RECORD IX2104.2 +075700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2104.2 +075800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2104.2 +075900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2104.2 +076000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2104.2 +076100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2104.2 +076200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2104.2 +076300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2104.2 +076400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2104.2 +076500 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2104.2 +076600 MOVE ZERO TO RECORD-COUNT. IX2104.2 +076700 PERFORM WRT-LN. IX2104.2 +076800 WRT-LN. IX2104.2 +076900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2104.2 +077000 MOVE SPACE TO DUMMY-RECORD. IX2104.2 +077100 BLANK-LINE-PRINT. IX2104.2 +077200 PERFORM WRT-LN. IX2104.2 +077300 FAIL-ROUTINE. IX2104.2 +077400 IF COMPUTED-X NOT EQUAL TO SPACE IX2104.2 +077500 GO TO FAIL-ROUTINE-WRITE. IX2104.2 +077600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2104.2 +077700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2104.2 +077800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2104.2 +077900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +078000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2104.2 +078100 GO TO FAIL-ROUTINE-EX. IX2104.2 +078200 FAIL-ROUTINE-WRITE. IX2104.2 +078300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2104.2 +078400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2104.2 +078500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2104.2 +078600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2104.2 +078700 FAIL-ROUTINE-EX. EXIT. IX2104.2 +078800 BAIL-OUT. IX2104.2 +078900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2104.2 +079000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2104.2 +079100 BAIL-OUT-WRITE. IX2104.2 +079200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2104.2 +079300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2104.2 +079400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2104.2 +079500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2104.2 +079600 BAIL-OUT-EX. EXIT. IX2104.2 +079700 CCVS1-EXIT. IX2104.2 +079800 EXIT. IX2104.2 +079900 SECT-0001-IX210A SECTION. IX2104.2 +080000 WRITE-INT-GF. IX2104.2 +080100 OPEN OUTPUT IX-FS1. IX2104.2 +080200 MOVE "IX-FS1" TO XFILE-NAME (1). IX2104.2 +080300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2104.2 +080400 MOVE ZERO TO XRECORD-NUMBER (1). IX2104.2 +080500 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2104.2 +080600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2104.2 +080700 MOVE 240 TO XRECORD-LENGTH (1). IX2104.2 +080800 MOVE 001 TO XBLOCK-SIZE (1). IX2104.2 +080900 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2104.2 +081000 MOVE "S" TO XLABEL-TYPE (1). IX2104.2 +081100 MOVE 200 TO RECORDS-IN-FILE (1). IX2104.2 +081200 MOVE "CREATE-FILE-FS1" TO FEATURE. IX2104.2 +081300 MOVE "WRITE-TEST-GF-1" TO PAR-NAME. IX2104.2 +081400 MOVE ZERO TO KEYSUB. IX2104.2 +081500 MOVE ZERO TO INVKEY-COUNTER. IX2104.2 +081600 WRITE-INIT-GF-01. IX2104.2 +081700 PERFORM WRITE-TEST-GF-01 50 TIMES. IX2104.2 +081800 PERFORM WRITE-TEST-GF-02 125 TIMES. IX2104.2 +081900 PERFORM WRITE-TEST-GF-01 25 TIMES. IX2104.2 +082000 GO TO WRITE-TEST-GF-1. IX2104.2 +082100 WRITE-TEST-GF-01. IX2104.2 +082200 ADD 001 TO XRECORD-NUMBER (1). IX2104.2 +082300 ADD 001 TO KEYSUB. IX2104.2 +082400 MOVE RECKEY-VALUE (KEYSUB) TO FS1-RECKEY-1-13. IX2104.2 +082500 MOVE ALTKEY1-VALUE (KEYSUB) TO FS1-ALTKEY1-1-20. IX2104.2 +082600 MOVE ALTKEY2-VALUE (KEYSUB) TO FS1-ALTKEY2-1-20. IX2104.2 +082700 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2104.2 +082800 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2104.2 +082900 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2104.2 +083000 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2104.2 +083100 WRITE IX-FS1R1-F-G-240 IX2104.2 +083200 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2104.2 +083300 ADD 001 TO EXCUT-COUNTER-06V00. IX2104.2 +083400 WRITE-TEST-GF-02. IX2104.2 +083500 ADD 002 TO FS1-RECKEY-11-13. IX2104.2 +083600 ADD 002 TO FS1-ALTKEY1-11-13. IX2104.2 +083700 SUBTRACT 002 FROM FS1-ALTKEY2-11-13. IX2104.2 +083800 ADD 001 TO XRECORD-NUMBER (1). IX2104.2 +083900 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2104.2 +084000 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2104.2 +084100 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2104.2 +084200 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2104.2 +084300 WRITE IX-FS1R1-F-G-240 IX2104.2 +084400 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2104.2 +084500 ADD 001 TO EXCUT-COUNTER-06V00. IX2104.2 +084600 WRITE-TEST-GF-1. IX2104.2 +084700 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2104.2 +084800 GIVING RECORDS-WRITTEN. IX2104.2 +084900 MOVE 200 TO CORRECT-18V0. IX2104.2 +085000 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2104.2 +085100 IF RECORDS-WRITTEN EQUAL TO 200 IX2104.2 +085200 PERFORM PASS IX2104.2 +085300 ELSE IX2104.2 +085400 PERFORM FAIL. IX2104.2 +085500 MOVE "RECORDS IN FILE" TO RE-MARK. IX2104.2 +085600 GO TO WRITE-TEST-GF-END. IX2104.2 +085700 WRITE-DELETE-GF-1. IX2104.2 +085800 PERFORM DE-LETE. IX2104.2 +085900 WRITE-TEST-GF-END. IX2104.2 +086000 PERFORM PRINT-DETAIL. IX2104.2 +086100 CLOSE IX-FS1. IX2104.2 +086200 READ-INIT-F1. IX2104.2 +086300 OPEN INPUT IX-FS1. IX2104.2 +086400 MOVE "READ FILE IX-FS1" TO FEATURE. IX2104.2 +086500 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2104.2 +086600 MOVE 02 TO RECKEY-NUM. IX2104.2 +086700 MOVE 002 TO ALTKEY1-NUM. IX2104.2 +086800 READ-TEST-F1-R1. IX2104.2 +086900 READ IX-FS1 AT END GO TO READ-TEST-F1. IX2104.2 +087000 MOVE IX-REC-KEY-AREA TO WRK-FS1-RECKEY. IX2104.2 +087100 MOVE IX-ALT-KEY1-AREA TO WRK-FS1-ALTKEY1. IX2104.2 +087200 IF FS1-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2104.2 +087300 AND FS1-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2104.2 +087400 NEXT SENTENCE IX2104.2 +087500 ELSE IX2104.2 +087600 PERFORM READ-FAIL-F1. IX2104.2 +087700 IF EXCUT-COUNTER-06V00 GREATER THAN 200 IX2104.2 +087800 GO TO READ-TEST-F1. IX2104.2 +087900 ADD 001 TO EXCUT-COUNTER-06V00. IX2104.2 +088000 ADD 002 TO RECKEY-NUM IX2104.2 +088100 ADD 002 TO ALTKEY1-NUM. IX2104.2 +088200 GO TO READ-TEST-F1-R1. IX2104.2 +088300 READ-TEST-F1. IX2104.2 +088400 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2104.2 +088500 PERFORM PASS ELSE IX2104.2 +088600 PERFORM FAIL. IX2104.2 +088700 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2104.2 +088800 MOVE 200 TO CORRECT-18V0. IX2104.2 +088900 MOVE "RECORDS IN FILE" TO RE-MARK. IX2104.2 +089000 GO TO READ-EXIT-F1. IX2104.2 +089100 READ-FAIL-F1. IX2104.2 +089200 PERFORM FAIL. IX2104.2 +089300 MOVE FS1-RECKEY-11-13 TO COMPUTED-18V0. IX2104.2 +089400 MOVE RECKEY-NUM TO CORRECT-18V0. IX2104.2 +089500 MOVE "NUM EMBEDDED IN RECKEY; IX-41 & IX-28" TO RE-MARK. IX2104.2 +089600 READ-EXIT-F1. IX2104.2 +089700 PERFORM PRINT-DETAIL. IX2104.2 +089800 CLOSE IX-FS1. IX2104.2 +089900 START-INIT. IX2104.2 +090000 OPEN INPUT IX-FS1. IX2104.2 +090100 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +090200 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2104.2 +090300 MOVE SPACE TO HOLD-FILESTATUS-RECORD. IX2104.2 +090400* IX2104.2 +090500* THE "START -- GREATER THAN--" IS CHECKED FOR PROPER POSITIONING IX2104.2 +090600* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2104.2 +090700* START-TEST-GF USE ONLY THE PRIME RECORD KEY FOR ESTABLISHING IX2104.2 +090800* THE CURRENT RECORD POINTER FOR THE FILE. THE FOLLOWING IS A IX2104.2 +090900* SUMMARY OF THE TEST CONDITIONS AND THE EXPECTED ACTION TO BE IX2104.2 +091000* TAKEN FOR THE TESTS. IX2104.2 +091100* IX2104.2 +091200* CONDITIONS (CONTENTS OF KEY) / ACTION IX2104.2 +091300* IX2104.2 +091400* START-TEST-GF-01 - EQUAL A RECORD IN FILE / RECORD FOUND IX2104.2 +091500* START-TEST-GF-02 - BETWEEN 2 KEY VALUES / RECORD FOUND IX2104.2 +091600* START-TEST-GF-03 - LESS THAN FIRST FILE REC. / REC. FOUND IX2104.2 +091700* START-TEST-GF-04 - GREATER THAN LAST FILE RECORD / INVALID KEYIX2104.2 +091800* START-TEST-GF-05 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2104.2 +091900* START-TEST-GF-06 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2104.2 +092000* START-TEST-GF-07 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2104.2 +092100* START-TEST-GF-08 - UNEQUAL SIZE OPERANDS (UNEQUAL) / REC FOUNDIX2104.2 +092200* START-TEST-GF-09 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2104.2 +092300* IX2104.2 +092400* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2104.2 +092500* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2104.2 +092600* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2104.2 +092700* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2104.2 +092800* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2104.2 +092900* MATCH RECORDS IN THE FILE. IF KEY MATCH IS EXPECTED FROM IX2104.2 +093000* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2104.2 +093100* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2104.2 +093200* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2104.2 +093300* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2104.2 +093400* IX2104.2 +093500 START-INIT-GF-01. IX2104.2 +093600 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2104.2 +093700 PERFORM START-INITIALIZE-RECORD. IX2104.2 +093800 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +093900 MOVE "**" TO FILESTATUS (1) IX2104.2 +094000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +094100 GO TO START-DELETE-GF-01. IX2104.2 +094200 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2104.2 +094300 MOVE "EEEEEFFFFF022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +094400 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +094500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +094600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +094700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +094800 START-TEST-GF-01. IX2104.2 +094900* IX2104.2 +095000* START-TEST-GF-01 - THE START SHOULD FIND A RECORD IN THE FILE IX2104.2 +095100* WHICH HAS A RECORD KEY VALUE OF IX2104.2 +095200* CCCCCCCCDD024 (RECORD NUMBER 12). IX2104.2 +095300* IX2104.2 +095400 START IX-FS1 IX2104.2 +095500 KEY IS GREATER THAN IX-FS1-KEY IX2104.2 +095600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2104.2 +095700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +095800 GO TO START-FAIL-GF-01. IX2104.2 +095900 MOVE FS1-STATUS TO FILESTATUS (1). IX2104.2 +096000 READ IX-FS1 AT END IX2104.2 +096100 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +096200 GO TO START-FAIL-GF-01. IX2104.2 +096300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +096400 IF XRECORD-NUMBER (1) EQUAL TO 12 IX2104.2 +096500 PERFORM PASS IX2104.2 +096600 MOVE SPACE TO RE-MARK IX2104.2 +096700 GO TO START-EXIT-GF-01. IX2104.2 +096800 MOVE 12 TO RECNO. IX2104.2 +096900 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +097000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +097100 START-FAIL-GF-01. IX2104.2 +097200 PERFORM FAIL. IX2104.2 +097300 MOVE 12 TO CORRECT-18V0. IX2104.2 +097400 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +097500 GO TO START-EXIT-GF-01. IX2104.2 +097600 START-DELETE-GF-01. IX2104.2 +097700 PERFORM DE-LETE. IX2104.2 +097800 START-EXIT-GF-01. IX2104.2 +097900 PERFORM PRINT-DETAIL. IX2104.2 +098000 START-INIT-GF-02. IX2104.2 +098100 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +098200 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2104.2 +098300 PERFORM START-INITIALIZE-RECORD. IX2104.2 +098400 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +098500 MOVE "**" TO FILESTATUS (2) IX2104.2 +098600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +098700 GO TO START-DELETE-GF-02. IX2104.2 +098800 MOVE "EEEEEEEFFF067" TO FS1-RECKEY-1-13. IX2104.2 +098900 MOVE "HHHHHHHHII064ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +099000 MOVE "TTTTTTTTSS336ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +099100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +099200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +099300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +099400 START-TEST-GF-02. IX2104.2 +099500* IX2104.2 +099600* START-TEST-GF-02 - THE START SHOULD FIND A RECORD IN THE FILE IX2104.2 +099700* WHICH HAS A RECORD KEY VALUE OF EEEEEEFFFF068IX2104.2 +099800* (RECORD NUMBER 34). THIS KEY VALUE IS IX2104.2 +099900* SEQUENTIALLY A LOGICAL RECORD HIGHER THAN IX2104.2 +100000* THE RECORD CONTAINING THE KEY VALUE LOADED IX2104.2 +100100* INTO THE RECORD KEY BEFORE THE START WAS IX2104.2 +100200* EXECUTED. THE KEY VALUE INITIALLY LOADED IX2104.2 +100300* WAS A VALUE BETWEEN TWO EXISTING KEY VALUES. IX2104.2 +100400* IX2104.2 +100500 START IX-FS1 IX2104.2 +100600 KEY GREATER THAN OR EQUAL TO IX-FS1-KEY IX2104.2 +100700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2104.2 +100800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +100900 GO TO START-FAIL-GF-02. IX2104.2 +101000 MOVE FS1-STATUS TO FILESTATUS (2). IX2104.2 +101100 READ IX-FS1 AT END IX2104.2 +101200 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +101300 GO TO START-FAIL-GF-02. IX2104.2 +101400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +101500 IF XRECORD-NUMBER (1) EQUAL TO 34 IX2104.2 +101600 PERFORM PASS IX2104.2 +101700 MOVE SPACE TO RE-MARK IX2104.2 +101800 GO TO START-EXIT-GF-02. IX2104.2 +101900 MOVE 34 TO RECNO. IX2104.2 +102000 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +102100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +102200 START-FAIL-GF-02. IX2104.2 +102300 PERFORM FAIL. IX2104.2 +102400 MOVE 34 TO CORRECT-18V0. IX2104.2 +102500 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +102600 GO TO START-EXIT-GF-02. IX2104.2 +102700 START-DELETE-GF-02. IX2104.2 +102800 PERFORM DE-LETE. IX2104.2 +102900 START-EXIT-GF-02. IX2104.2 +103000 PERFORM PRINT-DETAIL. IX2104.2 +103100 START-INIT-GF-03. IX2104.2 +103200 PERFORM START-INITIALIZE-RECORD. IX2104.2 +103300 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +103400 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2104.2 +103500 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +103600 MOVE "**" TO FILESTATUS (3) IX2104.2 +103700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +103800 GO TO START-DELETE-GF-03. IX2104.2 +103900 MOVE "BBBBBBBBBC001" TO FS1-RECKEY-1-13. IX2104.2 +104000 MOVE "EEEEEEEEEF003ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +104100 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +104200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +104300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +104400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +104500 START-TEST-GF-03. IX2104.2 +104600* IX2104.2 +104700* START-TEST-GF-03 - THE START STATEMENT SHOULD FIND A IX2104.2 +104800* RECORD IN THE FILE WHICH HAS A RECORD KEY IX2104.2 +104900* VALUE OF "BBBBBBBBBC002" (RECORD NUMBER 1). IX2104.2 +105000* THE KEY WAS LOADED BEFORE THE START IS IX2104.2 +105100* EXECUTED WITH THE VALUE THAT IS SEQUENTIALLY IX2104.2 +105200* LOWER THAN ANY CURRENTLY EXISTING KEY IN IX2104.2 +105300* THE FILE. IX2104.2 +105400* IX2104.2 +105500 START IX-FS1 IX2104.2 +105600 KEY IS GREATER THAN IX-FS1-KEY IX2104.2 +105700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2104.2 +105800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +105900 GO TO START-FAIL-GF-03 IX2104.2 +106000 END-START. IX2104.2 +106100 MOVE FS1-STATUS TO FILESTATUS (3). IX2104.2 +106200 READ IX-FS1 AT END IX2104.2 +106300 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +106400 GO TO START-FAIL-GF-03. IX2104.2 +106500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +106600 IF XRECORD-NUMBER (1) EQUAL TO 01 IX2104.2 +106700 PERFORM PASS IX2104.2 +106800 MOVE SPACE TO RE-MARK IX2104.2 +106900 GO TO START-EXIT-GF-03. IX2104.2 +107000 MOVE 01 TO RECNO. IX2104.2 +107100 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +107200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +107300 START-FAIL-GF-03. IX2104.2 +107400 PERFORM FAIL. IX2104.2 +107500 MOVE 01 TO CORRECT-18V0. IX2104.2 +107600 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +107700 GO TO START-EXIT-GF-03. IX2104.2 +107800 START-DELETE-GF-03. IX2104.2 +107900 PERFORM DE-LETE. IX2104.2 +108000 START-EXIT-GF-03. IX2104.2 +108100 PERFORM PRINT-DETAIL. IX2104.2 +108200 START-INIT-GF-04. IX2104.2 +108300 PERFORM START-INITIALIZE-RECORD. IX2104.2 +108400 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +108500 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2104.2 +108600 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +108700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +108800 MOVE "**" TO FILESTATUS (4) IX2104.2 +108900 GO TO START-DELETE-GF-04. IX2104.2 +109000 MOVE "UUUUUUUUUU401" TO FS1-RECKEY-1-13. IX2104.2 +109100 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +109200 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +109300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +109400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +109500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +109600 START-TEST-GF-04. IX2104.2 +109700* IX2104.2 +109800* START-TEST-GF-04 - THE START STATEMENT SHOULD NOT FIND A IX2104.2 +109900* RECORD IN THE FILE WHICH HAS A RECORD IX2104.2 +110000* KEY VALUE GREATER THAN "UUUUUUUUUU401". THIS IX2104.2 +110100* VALUE IS SEQUENTIALLY GREATER THAN IX2104.2 +110200* ANY RECORD KEY CURRENTLY EXISTING IN IX2104.2 +110300* THE FILE. AN INVALID KEY CONDITION IX2104.2 +110400* IS EXPECTED WHEN THE START IS EXECUTED. IX2104.2 +110500* IX2104.2 +110600 START IX-FS1 IX2104.2 +110700 KEY IS GREATER THAN IX-FS1-KEY IX2104.2 +110800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2104.2 +110900 GO TO START-PASS-GF-04. IX2104.2 +111000 MOVE FS1-STATUS TO FILESTATUS (4). IX2104.2 +111100 READ IX-FS1 AT END IX2104.2 +111200 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +111300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +111400 PERFORM FAIL. IX2104.2 +111500 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +111600 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +111700 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +111800 GO TO START-EXIT-GF-04. IX2104.2 +111900 START-PASS-GF-04. IX2104.2 +112000 PERFORM PASS. IX2104.2 +112100 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +112200 GO TO START-EXIT-GF-04. IX2104.2 +112300 START-DELETE-GF-04. IX2104.2 +112400 PERFORM DE-LETE. IX2104.2 +112500 START-EXIT-GF-04. IX2104.2 +112600 PERFORM PRINT-DETAIL. IX2104.2 +112700 START-INIT-GF-05. IX2104.2 +112800 PERFORM START-INITIALIZE-RECORD. IX2104.2 +112900 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +113000 MOVE "START-TEST-GF-05" TO PAR-NAME. IX2104.2 +113100 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +113200 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +113300 MOVE "**" TO FILESTATUS (5) IX2104.2 +113400 GO TO START-DELETE-GF-05. IX2104.2 +113500 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2104.2 +113600 MOVE "IIIIIIIIJJ083ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +113700 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +113800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +113900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +114000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +114100 START-TEST-GF-05. IX2104.2 +114200* START-TEST-GF-05 - THE START STATEMENT USES AN OPERAND IX2104.2 +114300* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2104.2 +114400* OF A RECORD KEY BUT IS THE NAME OF A IX2104.2 +114500* DATA ITEM WHICH IS SUBORDINATE TO THE IX2104.2 +114600* RECORD KEY. THE CONTENTS OF THE DATA ITEM IX2104.2 +114700* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IX2104.2 +114800* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2104.2 +114900* BALANCE OF THE KEY (POSITIONS 8 THRU 13) IS IX2104.2 +115000* NOT A VALID KEY VALUE FOR THE FILE. THE IX2104.2 +115100* RECORD WITH THE RECORD KEY "DDDDDDDDDD040" IX2104.2 +115200* (RECORD NUMBER 20) IS EXPECTED TO BE FOUND. IX2104.2 +115300* IX2104.2 +115400 START IX-FS1 IX2104.2 +115500 KEY IS GREATER THAN R-RECKEY-1-7 IX2104.2 +115600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2104.2 +115700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +115800 GO TO START-FAIL-GF-05. IX2104.2 +115900 MOVE FS1-STATUS TO FILESTATUS (5). IX2104.2 +116000 READ IX-FS1 AT END IX2104.2 +116100 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +116200 GO TO START-FAIL-GF-05. IX2104.2 +116300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +116400 IF XRECORD-NUMBER (1) EQUAL TO 20 IX2104.2 +116500 PERFORM PASS IX2104.2 +116600 MOVE "SUBORDINATE DATA ITEM OF KEY" TO RE-MARK IX2104.2 +116700 GO TO START-EXIT-GF-05. IX2104.2 +116800 MOVE 20 TO RECNO. IX2104.2 +116900 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +117000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +117100 START-FAIL-GF-05. IX2104.2 +117200 PERFORM FAIL. IX2104.2 +117300 MOVE 20 TO CORRECT-18V0. IX2104.2 +117400 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +117500 GO TO START-EXIT-GF-05. IX2104.2 +117600 START-DELETE-GF-05. IX2104.2 +117700 PERFORM DE-LETE. IX2104.2 +117800 START-EXIT-GF-05. IX2104.2 +117900 PERFORM PRINT-DETAIL. IX2104.2 +118000 START-INIT-GF-06. IX2104.2 +118100 PERFORM START-INITIALIZE-RECORD. IX2104.2 +118200 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +118300 MOVE "START-TEST-GF-06" TO PAR-NAME. IX2104.2 +118400 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +118500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +118600 MOVE "**" TO FILESTATUS (6) IX2104.2 +118700 GO TO START-DELETE-GF-06. IX2104.2 +118800 MOVE "TTTTTTTTTT380" TO FS1-RECKEY-1-13. IX2104.2 +118900 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +119000 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +119100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +119200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +119300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +119400 START-TEST-GF-06. IX2104.2 +119500* IX2104.2 +119600* START-TEST-GF-06 - THE START STATEMENT USES AN OPERAND IN THE IX2104.2 +119700* KEY PHRASE WHICH IS NOT THE NAME OF A RECORD IX2104.2 +119800* KEY BUT IS THE NAME OF A DATA ITEM THAT IS IX2104.2 +119900* SUBORDINATE TO THE RECORD KEY. THE CONTENTS IX2104.2 +120000* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2104.2 +120100* RECORD KEY) IS A DUPLICATE OF THE FIRST IX2104.2 +120200* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2104.2 +120300* THIS TEST EXPECTS THE RECORD POINTER IX2104.2 +120400* TO BE POSITIONED TO RECORD KEY TTTTUUUUUU392 IX2104.2 +120500* (RECORD NUMBER 196) WHICH WAS THE RECORD IX2104.2 +120600* WRITTEN TO THE FILE AFTER THE LAST RECORD IX2104.2 +120700* THAT CONTAINS TTTTT IN THE FIRST 5 POSITIONS IX2104.2 +120800* OF THE KEY. THE RECORD KEY WAS LOADED WITH IX2104.2 +120900* THE VALUE "TTTTTTTTTT380" (KEY FOR RECORD IX2104.2 +121000* NUMBER 190) BEFORE THE START WAS EXECUTED. IX2104.2 +121100* IX2104.2 +121200 START IX-FS1 IX2104.2 +121300 KEY IS GREATER THAN IX-FS1-KEY-1-5 IX2104.2 +121400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2104.2 +121500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +121600 GO TO START-FAIL-GF-06. IX2104.2 +121700 MOVE FS1-STATUS TO FILESTATUS (6). IX2104.2 +121800 READ IX-FS1 AT END IX2104.2 +121900 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +122000 GO TO START-FAIL-GF-06. IX2104.2 +122100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +122200 IF XRECORD-NUMBER (1) EQUAL TO 196 IX2104.2 +122300 PERFORM PASS IX2104.2 +122400 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2104.2 +122500 GO TO START-EXIT-GF-06. IX2104.2 +122600 MOVE 71 TO RECNO. IX2104.2 +122700 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +122800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +122900 START-FAIL-GF-06. IX2104.2 +123000 PERFORM FAIL. IX2104.2 +123100 MOVE 196 TO CORRECT-18V0. IX2104.2 +123200 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +123300 GO TO START-EXIT-GF-06. IX2104.2 +123400 START-DELETE-GF-06. IX2104.2 +123500 PERFORM DE-LETE. IX2104.2 +123600 START-EXIT-GF-06. IX2104.2 +123700 PERFORM PRINT-DETAIL. IX2104.2 +123800 START-INIT-GF-07. IX2104.2 +123900 PERFORM START-INITIALIZE-RECORD. IX2104.2 +124000 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +124100 MOVE "START-TEST-GF-07" TO PAR-NAME. IX2104.2 +124200 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +124300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +124400 MOVE "**" TO FILESTATUS (7) IX2104.2 +124500 GO TO START-DELETE-GF-07. IX2104.2 +124600 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2104.2 +124700 MOVE "FFFFFFFFFG022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +124800 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +124900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +125000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +125100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +125200 START-TEST-GF-07. IX2104.2 +125300* IX2104.2 +125400* START-TEST-GF-07 - THE START STATEMENT USES AN OPERAND IN THE IX2104.2 +125500* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +125600* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2104.2 +125700* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +125800* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IX2104.2 +125900* IS LOADED WITH "UUUUUUU" WHICH IS THE IX2104.2 +126000* KEY VALUE OF THE LAST RECORD IN THE FILE. IX2104.2 +126100* THERE SHOULD BE NO RECORD IN THE FILE GREATERIX2104.2 +126200* THAN THIS KEY VALUE THUS AND INVALID KEY IX2104.2 +126300* IS EXPECTED WHEN THE START IS EXECUTED. IX2104.2 +126400* IX2104.2 +126500 START IX-FS1 IX2104.2 +126600 KEY IS GREATER THAN R-RECKEY-1-7 IX2104.2 +126700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2104.2 +126800 GO TO START-PASS-GF-07. IX2104.2 +126900 MOVE FS1-STATUS TO FILESTATUS (7). IX2104.2 +127000 READ IX-FS1 AT END IX2104.2 +127100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +127200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +127300 PERFORM FAIL. IX2104.2 +127400 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +127500 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +127600 MOVE "AT END PATH TAKEN & IX-36 ETC " TO RE-MARK. IX2104.2 +127700 GO TO START-EXIT-GF-07. IX2104.2 +127800 START-PASS-GF-07. IX2104.2 +127900 PERFORM PASS. IX2104.2 +128000 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +128100 GO TO START-EXIT-GF-07. IX2104.2 +128200 START-DELETE-GF-07. IX2104.2 +128300 PERFORM DE-LETE. IX2104.2 +128400 START-EXIT-GF-07. IX2104.2 +128500 PERFORM PRINT-DETAIL. IX2104.2 +128600 START-INIT-GF-08. IX2104.2 +128700 PERFORM START-INITIALIZE-RECORD. IX2104.2 +128800 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +128900 MOVE "START-TEST-GF-08" TO PAR-NAME. IX2104.2 +129000 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +129100 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +129200 MOVE "**" TO FILESTATUS (8) IX2104.2 +129300 GO TO START-DELETE-GF-08. IX2104.2 +129400 MOVE "ABBBBBBBBC002" TO FS1-RECKEY-1-13. IX2104.2 +129500 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +129600 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +129700 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +129800 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +129900 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +130000 START-TEST-GF-08. IX2104.2 +130100* IX2104.2 +130200* START-TEST-GF-08 - THIS TEST USES AN OPERAND IN THE KEY IX2104.2 +130300* PHRASE OF THE START STATEMENT WHICH IS A DATAIX2104.2 +130400* ITEM SUBORDINATE TO THE RECORD KEY NAME. THEIX2104.2 +130500* CONTENTS OF THE DATA ITEM (POSITIONS 1 THRU IX2104.2 +130600* 7 OF THE RECORD KEY) IS LOADED WITH "ABBBBBBBIX2104.2 +130700* BC". THIS KEY VALUE IS LOWER THAN ANY RECORDIX2104.2 +130800* KEY VALUE IN POSITIONS 1 THRU 7 EXISTING IX2104.2 +130900* IN THE FILE. THE START STATEMENT WITH THE IX2104.2 +131000* KEY IS GREATER THAN PHRASE IS EXECUTED AND IX2104.2 +131100* SHOULD FIND THE RECORD WITH THE KEY VALUE IX2104.2 +131200* "BBBBBBBBBC002" (RECORD NUMBER 01). IX2104.2 +131300* IX2104.2 +131400 START IX-FS1 IX2104.2 +131500 KEY IS GREATER THAN R-RECKEY-1-7 IX2104.2 +131600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2104.2 +131700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +131800 GO TO START-FAIL-GF-08. IX2104.2 +131900 MOVE FS1-STATUS TO FILESTATUS (8). IX2104.2 +132000 READ IX-FS1 AT END IX2104.2 +132100 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +132200 GO TO START-FAIL-GF-08. IX2104.2 +132300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +132400 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2104.2 +132500 PERFORM PASS IX2104.2 +132600 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2104.2 +132700 GO TO START-EXIT-GF-08. IX2104.2 +132800 MOVE 01 TO RECNO. IX2104.2 +132900 PERFORM DISPLAY-RECORD-KEYS. IX2104.2 +133000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +133100 START-FAIL-GF-08. IX2104.2 +133200 PERFORM FAIL. IX2104.2 +133300 MOVE 001 TO CORRECT-18V0. IX2104.2 +133400 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +133500 GO TO START-EXIT-GF-08. IX2104.2 +133600 START-DELETE-GF-08. IX2104.2 +133700 PERFORM DE-LETE. IX2104.2 +133800 START-EXIT-GF-08. IX2104.2 +133900 PERFORM PRINT-DETAIL. IX2104.2 +134000 START-INIT-GF-09. IX2104.2 +134100 PERFORM START-INITIALIZE-RECORD. IX2104.2 +134200 MOVE "START GT RECKEY " TO FEATURE. IX2104.2 +134300 MOVE "START-TEST-GF-09" TO PAR-NAME. IX2104.2 +134400 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +134500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +134600 MOVE "**" TO FILESTATUS (9) IX2104.2 +134700 GO TO START-DELETE-GF-09. IX2104.2 +134800 MOVE "UUUUUUVVVV400" TO FS1-RECKEY-1-13. IX2104.2 +134900 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +135000 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +135100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +135200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +135300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +135400 START-TEST-GF-09. IX2104.2 +135500* IX2104.2 +135600* START-TEST-GF-09 - THIS TEST USES AN OPERAND IN THE IX2104.2 +135700* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +135800* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2104.2 +135900* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +136000* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IS IX2104.2 +136100* LOADED WITH "UUUUUUV". THIS KEY VALUE IX2104.2 +136200* IS GREATER THAN ANY RECORD KEY VALUE IN IX2104.2 +136300* POSITION 1 THRU 7 EXISTING IN THE FILE IX2104.2 +136400* THEREFORE AN INVALID KEY CONDITION IS IX2104.2 +136500* EXPECTED WHEN THE START STATEMENT IS IX2104.2 +136600* EXECUTED. IX2104.2 +136700* IX2104.2 +136800 START IX-FS1 IX2104.2 +136900 KEY IS GREATER THAN R-RECKEY-1-7 IX2104.2 +137000 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2104.2 +137100 GO TO START-PASS-GF-09. IX2104.2 +137200 MOVE FS1-STATUS TO FILESTATUS (9). IX2104.2 +137300 READ IX-FS1 AT END IX2104.2 +137400 MOVE "IX-36 ETS & AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +137500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +137600 PERFORM FAIL. IX2104.2 +137700 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +137800 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +137900 GO TO START-EXIT-GF-09. IX2104.2 +138000 START-PASS-GF-09. IX2104.2 +138100 PERFORM PASS. IX2104.2 +138200 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +138300 GO TO START-EXIT-GF-09. IX2104.2 +138400 START-DELETE-GF-09. IX2104.2 +138500 PERFORM DE-LETE. IX2104.2 +138600 START-EXIT-GF-09. IX2104.2 +138700 PERFORM PRINT-DETAIL. IX2104.2 +138800 START-TERM-GF. IX2104.2 +138900 CLOSE IX-FS1. IX2104.2 +139000 START-INIT-GF-10. IX2104.2 +139100 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +139200 MOVE "START-TEST-GF-10" TO PAR-NAME. IX2104.2 +139300* IX2104.2 +139400* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2104.2 +139500* CAPTURED FROM THE TESTS IN START-TEST-GF-01 TO -09 IX2104.2 +139600* IX2104.2 +139700 START-TEST-GF-10. IX2104.2 +139800 IF FILESTATUS (1) EQUAL TO "**" IX2104.2 +139900 PERFORM DE-LETE IX2104.2 +140000 GO TO START-WRITE-GF-10. IX2104.2 +140100* IX2104.2 +140200* START-TEST-GF-10 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +140300* RESULTING FROM START-TEST-GF-01. THE FILE IX2104.2 +140400* STATUS CONTENTS IS EXPECTED TO BE "00". IX2104.2 +140500* IX2104.2 +140600 IF FILESTATUS (1) EQUAL TO "00" IX2104.2 +140700 PERFORM PASS IX2104.2 +140800 ELSE IX2104.2 +140900 MOVE "FROM START-TEST-GF-01; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +141000 PERFORM FAIL IX2104.2 +141100 MOVE "00" TO CORRECT-A IX2104.2 +141200 MOVE FILESTATUS (1) TO COMPUTED-A. IX2104.2 +141300 START-WRITE-GF-10. IX2104.2 +141400 PERFORM PRINT-DETAIL. IX2104.2 +141500 START-TEST-GF-11. IX2104.2 +141600 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +141700 MOVE "START-TEST-GF-11" TO PAR-NAME. IX2104.2 +141800 IF FILESTATUS (2) EQUAL TO "**" IX2104.2 +141900 PERFORM DE-LETE IX2104.2 +142000 GO TO START-WRITE-GF-11. IX2104.2 +142100* IX2104.2 +142200* START-TEST-GF-02 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +142300* RESULTING FROM START-TEST-003.02. THE FILE IX2104.2 +142400* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +142500* IX2104.2 +142600 IF FILESTATUS (2) EQUAL TO "00" IX2104.2 +142700 PERFORM PASS IX2104.2 +142800 ELSE PERFORM FAIL IX2104.2 +142900 MOVE "FROM START-TEST-GF-02; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +143000 MOVE "00" TO CORRECT-A IX2104.2 +143100 MOVE FILESTATUS (2) TO COMPUTED-A. IX2104.2 +143200 START-WRITE-GF-11. IX2104.2 +143300 PERFORM PRINT-DETAIL. IX2104.2 +143400 START-TEST-GF-12. IX2104.2 +143500 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +143600 MOVE "START-TEST-GF-12" TO PAR-NAME. IX2104.2 +143700 IF FILESTATUS (3) EQUAL TO "**" IX2104.2 +143800 PERFORM DE-LETE IX2104.2 +143900 GO TO START-WRITE-GF-12. IX2104.2 +144000* IX2104.2 +144100* START-TEST-GF-03 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +144200* RESULTING FROM START-TEST-003.03. THE FILE IX2104.2 +144300* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +144400* IX2104.2 +144500 IF FILESTATUS (3) EQUAL TO "00" IX2104.2 +144600 PERFORM PASS IX2104.2 +144700 ELSE PERFORM FAIL IX2104.2 +144800 MOVE "FROM START-TEST-GF-03; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +144900 MOVE "00" TO CORRECT-A IX2104.2 +145000 MOVE FILESTATUS (3) TO COMPUTED-A. IX2104.2 +145100 START-WRITE-GF-12. IX2104.2 +145200 PERFORM PRINT-DETAIL. IX2104.2 +145300 START-TEST-GF-13. IX2104.2 +145400 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +145500 MOVE "START-TEST-GF-13" TO PAR-NAME. IX2104.2 +145600 IF FILESTATUS (4) EQUAL TO "**" IX2104.2 +145700 PERFORM DE-LETE IX2104.2 +145800 GO TO START-WRITE-GF-13. IX2104.2 +145900* IX2104.2 +146000* START-TEST-GF-04 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +146100* RESULTING FROM START-TEST-003.04. THE FILE IX2104.2 +146200* STATUS CONTENTS IS EXPECTED TO BE "23". IX2104.2 +146300* IX2104.2 +146400 IF FILESTATUS (4) EQUAL TO "23" IX2104.2 +146500 PERFORM PASS IX2104.2 +146600 ELSE PERFORM FAIL IX2104.2 +146700 MOVE "FROM START-TEST-GF-04; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +146800 MOVE "23" TO CORRECT-A IX2104.2 +146900 MOVE FILESTATUS (4) TO COMPUTED-A. IX2104.2 +147000 START-WRITE-GF-13. IX2104.2 +147100 PERFORM PRINT-DETAIL. IX2104.2 +147200 START-TEST-GF-14. IX2104.2 +147300 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +147400 MOVE "START-TEST-GF-14" TO PAR-NAME. IX2104.2 +147500 IF FILESTATUS (5) EQUAL TO "**" IX2104.2 +147600 PERFORM DE-LETE IX2104.2 +147700 GO TO START-WRITE-GF-14. IX2104.2 +147800* IX2104.2 +147900* START-TEST-GF-05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +148000* RESULTING FROM START-TEST-GF-05. THE FILE IX2104.2 +148100* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +148200* IX2104.2 +148300 IF FILESTATUS (5) EQUAL TO "00" IX2104.2 +148400 PERFORM PASS IX2104.2 +148500 ELSE PERFORM FAIL IX2104.2 +148600 MOVE "FROM START-TEST-GF-05; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +148700 MOVE "00" TO CORRECT-A IX2104.2 +148800 MOVE FILESTATUS (5) TO COMPUTED-A. IX2104.2 +148900 START-WRITE-GF-14. IX2104.2 +149000 PERFORM PRINT-DETAIL. IX2104.2 +149100 START-TEST-GF-15. IX2104.2 +149200 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +149300 MOVE "START-TEST-GF-15" TO PAR-NAME. IX2104.2 +149400 IF FILESTATUS (6) EQUAL TO "**" IX2104.2 +149500 PERFORM DE-LETE IX2104.2 +149600 GO TO START-WRITE-GF-15. IX2104.2 +149700* IX2104.2 +149800* START-TEST-GF-15 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +149900* RESULTING FROM START-TEST-GF-06. THE FILE IX2104.2 +150000* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +150100* IX2104.2 +150200 IF FILESTATUS (6) EQUAL TO "00" IX2104.2 +150300 PERFORM PASS IX2104.2 +150400 ELSE PERFORM FAIL IX2104.2 +150500 MOVE "FROM START-TEST-GF-01; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +150600 MOVE "00" TO CORRECT-A IX2104.2 +150700 MOVE FILESTATUS (6) TO COMPUTED-A. IX2104.2 +150800 START-WRITE-GF-15. IX2104.2 +150900 PERFORM PRINT-DETAIL. IX2104.2 +151000 START-TEST-GF-16. IX2104.2 +151100 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +151200 MOVE "START-TEST-GF-16" TO PAR-NAME. IX2104.2 +151300 IF FILESTATUS (7) EQUAL TO "**" IX2104.2 +151400 PERFORM DE-LETE IX2104.2 +151500 GO TO START-WRITE-GF-16. IX2104.2 +151600* IX2104.2 +151700* START-TEST-GF-16 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +151800* RESULTING FROM START-TEST-GF-07. THE FILE IX2104.2 +151900* STATUS CONTENTS IS EXPECTED TO BE "23" IX2104.2 +152000* IX2104.2 +152100 IF FILESTATUS (7) EQUAL TO "23" IX2104.2 +152200 PERFORM PASS IX2104.2 +152300 ELSE PERFORM FAIL IX2104.2 +152400 MOVE "FROM START-TEST-GF-07; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +152500 MOVE "23" TO CORRECT-A IX2104.2 +152600 MOVE FILESTATUS (7) TO COMPUTED-A. IX2104.2 +152700 START-WRITE-GF-16. IX2104.2 +152800 PERFORM PRINT-DETAIL. IX2104.2 +152900 START-TEST-GF-17. IX2104.2 +153000 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +153100 MOVE "START-TEST-GF-17" TO PAR-NAME. IX2104.2 +153200 IF FILESTATUS (8) EQUAL TO "**" IX2104.2 +153300 PERFORM DE-LETE IX2104.2 +153400 GO TO START-WRITE-GF-17. IX2104.2 +153500* IX2104.2 +153600* START-TEST-GF-17 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +153700* RESULTING FROM START-TEST-GF-08. THE FILE IX2104.2 +153800* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +153900* IX2104.2 +154000 IF FILESTATUS (8) EQUAL TO "00" IX2104.2 +154100 PERFORM PASS IX2104.2 +154200 ELSE PERFORM FAIL IX2104.2 +154300 MOVE "FROM START-TEST-GF-08; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +154400 MOVE "00" TO CORRECT-A IX2104.2 +154500 MOVE FILESTATUS (8) TO COMPUTED-A. IX2104.2 +154600 START-WRITE-GF-17. IX2104.2 +154700 PERFORM PRINT-DETAIL. IX2104.2 +154800 START-TEST-GF-18. IX2104.2 +154900 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +155000 MOVE "START-TEST-GF-18" TO PAR-NAME. IX2104.2 +155100 IF FILESTATUS (9) EQUAL TO "**" IX2104.2 +155200 PERFORM DE-LETE IX2104.2 +155300 GO TO START-WRITE-GF-18. IX2104.2 +155400* IX2104.2 +155500* START-WRITE-GF-18 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +155600* RESULTING FROM START-TEST-GF-09. THE FILE IX2104.2 +155700* STATUS CONTENTS IS EXPECTED TO BE "23". IX2104.2 +155800* IX2104.2 +155900 IF FILESTATUS (9) EQUAL TO "23" IX2104.2 +156000 PERFORM PASS IX2104.2 +156100 ELSE PERFORM FAIL IX2104.2 +156200 MOVE "FROM START-TEST-GF-09; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +156300 MOVE "23" TO CORRECT-A IX2104.2 +156400 MOVE FILESTATUS (9) TO COMPUTED-A. IX2104.2 +156500 START-WRITE-GF-18. IX2104.2 +156600 PERFORM PRINT-DETAIL. IX2104.2 +156700 IX2104.2 +156800 IX2104.2 +156900 START-INIT-GF-19-0. IX2104.2 +157000 OPEN INPUT IX-FS1. IX2104.2 +157100 MOVE SPACE TO HOLD-FILESTATUS-RECORD. IX2104.2 +157200* IX2104.2 +157300* THE "START -- GREATER THAN--" IS CHECKED FOR PROPER POSITIONING IX2104.2 +157400* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2104.2 +157500* START-TEST-GF USES ONLY THE ALTERNATE RECORD KEY WITHOUT THE IX2104.2 +157600* THE DUPLICATES OPTION FOR ESTABLISHING THE CURRENT RECORD IX2104.2 +157700* POINTER FOR THE FILE. THE FOLLOWING IS A SUMMARY OF THE TEST IX2104.2 +157800* CONDITIONS AND THE EXPECTED ACTION TO BE TAKEN FOR THE TESTS. IX2104.2 +157900* IX2104.2 +158000* CONDITIONS (CONTENTS OF KEY) / ACTION IX2104.2 +158100* IX2104.2 +158200* START-TEST-GF-01 - EQUAL A RECORD IN FILE / RECORD FOUND IX2104.2 +158300* START-TEST-GF-02 - BETWEEN 2 KEY VALUES / RECORD FOUND IX2104.2 +158400* START-TEST-GF-03 - LESS THAN FIRST FILE REC. / REC. FOUND IX2104.2 +158500* START-TEST-GF-04 - GREATER THAN LAST FILE RECORD / INVALID KEIX2104.2 +158600* START-TEST-GF-05 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2104.2 +158700* START-TEST-GF-06 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2104.2 +158800* START-TEST-GF-07 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2104.2 +158900* START-TEST-GF-08 - UNEQUAL SIZE OPERANDS (UNEQUAL) / REC FOUNDIX2104.2 +159000* START-TEST-GF-09 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2104.2 +159100* IX2104.2 +159200* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2104.2 +159300* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2104.2 +159400* IF AN INVALID KEY IS EXPECTED FROM THE TEST, THE KEYS IX2104.2 +159500* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2104.2 +159600* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2104.2 +159700* MATCH RECORDS IN THE FILE. IF KEY MATCH IS EXPECTED FROM IX2104.2 +159800* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2104.2 +159900* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2104.2 +160000* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2104.2 +160100* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2104.2 +160200* IX2104.2 +160300 START-INIT-GF-19. IX2104.2 +160400 PERFORM START-INITIALIZE-RECORD. IX2104.2 +160500 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +160600 MOVE "START-TEST-GF-19" TO PAR-NAME. IX2104.2 +160700 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +160800 MOVE "**" TO FILESTATUS (1) IX2104.2 +160900 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +161000 GO TO START-DELETE-GF-19. IX2104.2 +161100 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2104.2 +161200 MOVE "XXXXXXXXXY382ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +161300 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +161400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +161500 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +161600 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +161700 START-TEST-19. IX2104.2 +161800* IX2104.2 +161900* START-TEST-GF-19 - THE START SHOULD FIND A RECORD IN THE FILE IX2104.2 +162000* WHICH HAS AN ALTERNATE KEY VALUE OF IX2104.2 +162100* XXXXXXXXYY384ALTKEY1 (RECORD NUMBER 192). IX2104.2 +162200* IX2104.2 +162300 START IX-FS1 IX2104.2 +162400 KEY IS GREATER THAN IX-FS1-ALTKEY1 IX2104.2 +162500 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2104.2 +162600 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +162700 GO TO START-FAIL-GF-19. IX2104.2 +162800 MOVE FS1-STATUS TO FILESTATUS (1). IX2104.2 +162900 READ IX-FS1 AT END IX2104.2 +163000 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +163100 GO TO START-FAIL-GF-19. IX2104.2 +163200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +163300 IF XRECORD-NUMBER (1) EQUAL TO 192 IX2104.2 +163400 PERFORM PASS IX2104.2 +163500 MOVE SPACE TO RE-MARK IX2104.2 +163600 GO TO START-EXIT-GF-19. IX2104.2 +163700 MOVE 67 TO RECNO. IX2104.2 +163800 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +163900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +164000 START-FAIL-GF-19. IX2104.2 +164100 PERFORM FAIL. IX2104.2 +164200 MOVE 192 TO CORRECT-18V0. IX2104.2 +164300 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +164400 GO TO START-EXIT-GF-19. IX2104.2 +164500 START-DELETE-GF-19. IX2104.2 +164600 PERFORM DE-LETE. IX2104.2 +164700 START-EXIT-GF-19. IX2104.2 +164800 PERFORM PRINT-DETAIL. IX2104.2 +164900 START-INIT-GF-20. IX2104.2 +165000 PERFORM START-INITIALIZE-RECORD. IX2104.2 +165100 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +165200 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2104.2 +165300 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +165400 MOVE "**" TO FILESTATUS (2) IX2104.2 +165500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +165600 GO TO START-DELETE-GF-20. IX2104.2 +165700 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2104.2 +165800 MOVE "HHHHHHHIII67ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +165900 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +166000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +166100 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +166200 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +166300 START-TEST-GF-20. IX2104.2 +166400* IX2104.2 +166500* START-TEST-GF-20 - THE START SHOULD FIND A RECORD IN THE FILE IX2104.2 +166600* WHICH HAS AN ALTERNATE KEY VALUE OF IX2104.2 +166700* HHHHHHIIII068ALTKEY1 (RECORD NUMBER 34). IX2104.2 +166800* THE DATA ITEM WAS LOADED WITH A KEY VALUE IX2104.2 +166900* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2104.2 +167000* EXISTING ALTERNATE KEYS IN THE FILE. IX2104.2 +167100* IX2104.2 +167200 START IX-FS1 IX2104.2 +167300 KEY IS GREATER THAN IX-FS1-ALTKEY1 IX2104.2 +167400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2104.2 +167500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +167600 GO TO START-FAIL-GF-20. IX2104.2 +167700 MOVE FS1-STATUS TO FILESTATUS (2). IX2104.2 +167800 READ IX-FS1 AT END IX2104.2 +167900 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +168000 GO TO START-FAIL-GF-20. IX2104.2 +168100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +168200 IF XRECORD-NUMBER (1) EQUAL TO 034 IX2104.2 +168300 PERFORM PASS IX2104.2 +168400 MOVE SPACE TO RE-MARK IX2104.2 +168500 GO TO START-EXIT-GF-20. IX2104.2 +168600 MOVE 34 TO RECNO. IX2104.2 +168700 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +168800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +168900 START-FAIL-GF-20. IX2104.2 +169000 PERFORM FAIL. IX2104.2 +169100 MOVE 034 TO CORRECT-18V0. IX2104.2 +169200 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +169300 GO TO START-EXIT-GF-20. IX2104.2 +169400 START-DELETE-GF-20. IX2104.2 +169500 PERFORM DE-LETE. IX2104.2 +169600 START-EXIT-GF-20. IX2104.2 +169700 PERFORM PRINT-DETAIL. IX2104.2 +169800 START-INIT-GF-21. IX2104.2 +169900 PERFORM START-INITIALIZE-RECORD. IX2104.2 +170000 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +170100 MOVE "START-TEST-GF-21" TO PAR-NAME. IX2104.2 +170200 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +170300 MOVE "**" TO FILESTATUS (3) IX2104.2 +170400 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +170500 GO TO START-DELETE-GF-21. IX2104.2 +170600 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2104.2 +170700 MOVE "EEEEEEEEEF001ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +170800 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +170900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +171000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +171100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +171200 START-TEST-GF-21. IX2104.2 +171300* IX2104.2 +171400* START-TEST-GF-21 - THE START STATEMENT SHOULD FIND A IX2104.2 +171500* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2104.2 +171600* KEY VALUE OF EEEEEEEEEF002ALTKEY1 (RECORD IX2104.2 +171700* NUMBER 01). THE ALTERNATE KEY WAS LOADED IX2104.2 +171800* WITH A VALUE THAT IS SEQUENTIALLY LOWER IX2104.2 +171900* THAN ANY CURRENTLY EXISTNNG KEY IN THE FILE IX2104.2 +172000* BEFORE THE START WAS EXECUTED. IX2104.2 +172100* IX2104.2 +172200 START IX-FS1 IX2104.2 +172300 KEY IS GREATER THAN IX-FS1-ALTKEY1 IX2104.2 +172400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2104.2 +172500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +172600 GO TO START-FAIL-GF-21. IX2104.2 +172700 MOVE FS1-STATUS TO FILESTATUS (3). IX2104.2 +172800 READ IX-FS1 AT END IX2104.2 +172900 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +173000 GO TO START-FAIL-GF-21. IX2104.2 +173100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +173200 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2104.2 +173300 PERFORM PASS IX2104.2 +173400 MOVE SPACE TO RE-MARK IX2104.2 +173500 GO TO START-EXIT-GF-21. IX2104.2 +173600 MOVE 01 TO RECNO. IX2104.2 +173700 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +173800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +173900 START-FAIL-GF-21. IX2104.2 +174000 PERFORM FAIL. IX2104.2 +174100 MOVE 001 TO CORRECT-18V0. IX2104.2 +174200 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +174300 GO TO START-EXIT-GF-21. IX2104.2 +174400 START-DELETE-GF-21. IX2104.2 +174500 PERFORM DE-LETE. IX2104.2 +174600 START-EXIT-GF-21. IX2104.2 +174700 PERFORM PRINT-DETAIL. IX2104.2 +174800 START-INIT-GF-22. IX2104.2 +174900 PERFORM START-INITIALIZE-RECORD. IX2104.2 +175000 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +175100 MOVE "START-TEST-GF-22" TO PAR-NAME. IX2104.2 +175200 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +175300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +175400 MOVE "**" TO FILESTATUS (4) IX2104.2 +175500 GO TO START-DELETE-GF-22. IX2104.2 +175600 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2104.2 +175700 MOVE "YYYYYYYYYY401ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +175800 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +175900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +176000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +176100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +176200 START-TEST-GF-22. IX2104.2 +176300* IX2104.2 +176400* START-TEST-GF-04 - THE START STATEMENT SHOULD NOT FIND A IX2104.2 +176500* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2104.2 +176600* KEY VALUE OF YYYYYYYYYY401ALTKEY1. THIS IX2104.2 +176700* VALUE IS SEQUENTIALLY GREATER THAN IX2104.2 +176800* ANY ALTERNATE KEY CURRENTLY EXISTING IN IX2104.2 +176900* THE FILE. AN INVALID KEY CONDITION IX2104.2 +177000* IS EXPECTED WHEN THE START IS EXECUTED. IX2104.2 +177100* IX2104.2 +177200 START IX-FS1 IX2104.2 +177300 KEY IS GREATER THAN IX-FS1-ALTKEY1 IX2104.2 +177400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2104.2 +177500 GO TO START-PASS-GF-22. IX2104.2 +177600 MOVE FS1-STATUS TO FILESTATUS (4). IX2104.2 +177700 READ IX-FS1 AT END IX2104.2 +177800 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +177900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +178000 PERFORM FAIL. IX2104.2 +178100 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2104.2 +178200 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +178300 GO TO START-EXIT-GF-22. IX2104.2 +178400 START-PASS-GF-22. IX2104.2 +178500 PERFORM PASS. IX2104.2 +178600 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +178700 GO TO START-EXIT-GF-22. IX2104.2 +178800 START-DELETE-GF-22. IX2104.2 +178900 PERFORM DE-LETE. IX2104.2 +179000 START-EXIT-GF-22. IX2104.2 +179100 PERFORM PRINT-DETAIL. IX2104.2 +179200 START-INIT-GF-23. IX2104.2 +179300 PERFORM START-INITIALIZE-RECORD. IX2104.2 +179400 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +179500 MOVE "START-TEST-GF-23" TO PAR-NAME. IX2104.2 +179600 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +179700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +179800 MOVE "**" TO FILESTATUS (5) IX2104.2 +179900 GO TO START-DELETE-GF-23. IX2104.2 +180000 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2104.2 +180100 MOVE "GGGGHHHHHH100ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +180200 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +180300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +180400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +180500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +180600 START-TEST-GF-23. IX2104.2 +180700* IX2104.2 +180800* START-TEST-GF-23 - THE START STATEMENT USES AN OPERAND IX2104.2 +180900* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2104.2 +181000* OF AN ALTERNATE KEY BUT IS THE NAME OF A IX2104.2 +181100* DATA ITEM WHICH IS SUBORDINATE TO THE IX2104.2 +181200* ALTERNATE KEY. THE CONTENTS OF THE DATA ITEMIX2104.2 +181300* (POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IX2104.2 +181400* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2104.2 +181500* BALANCE OF THE KEY (POSITIONS 7 THRU 20 OF IX2104.2 +181600* THE ALTERNATE KEY IS NOT A VALID KEY VALUE IX2104.2 +181700* FOR THE FILE. THE IX2104.2 +181800* RECORD WITH THE ALTERNATE KEY "GGGHHHHHHH054 IX2104.2 +181900* ALTKEY1 (RECORD NUMBER 27) IS EXPECTED TO IX2104.2 +182000* BE FOUND. IX2104.2 +182100* IX2104.2 +182200 START IX-FS1 IX2104.2 +182300 KEY IS GREATER THAN R-ALTKEY1-1-6 IX2104.2 +182400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2104.2 +182500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +182600 GO TO START-FAIL-GF-23. IX2104.2 +182700 MOVE FS1-STATUS TO FILESTATUS (5). IX2104.2 +182800 READ IX-FS1 AT END IX2104.2 +182900 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +183000 GO TO START-FAIL-GF-23. IX2104.2 +183100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +183200 IF XRECORD-NUMBER (1) EQUAL TO 27 IX2104.2 +183300 PERFORM PASS IX2104.2 +183400 MOVE "SUBORDINATE DATA ITEM OF KEY" TO RE-MARK IX2104.2 +183500 GO TO START-EXIT-GF-23. IX2104.2 +183600 MOVE 27 TO RECNO. IX2104.2 +183700 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +183800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +183900 START-FAIL-GF-23. IX2104.2 +184000 PERFORM FAIL. IX2104.2 +184100 MOVE 27 TO CORRECT-18V0. IX2104.2 +184200 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +184300 GO TO START-EXIT-GF-23. IX2104.2 +184400 START-DELETE-GF-23. IX2104.2 +184500 PERFORM DE-LETE. IX2104.2 +184600 START-EXIT-GF-23. IX2104.2 +184700 PERFORM PRINT-DETAIL. IX2104.2 +184800 START-INIT-GF-24. IX2104.2 +184900 PERFORM START-INITIALIZE-RECORD. IX2104.2 +185000 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +185100 MOVE "START-TEST-GF-24" TO PAR-NAME. IX2104.2 +185200 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +185300 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +185400 MOVE "**" TO FILESTATUS (6) IX2104.2 +185500 GO TO START-DELETE-GF-24. IX2104.2 +185600 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2104.2 +185700 MOVE "XXXXXXXXXX380ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +185800 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +185900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +186000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +186100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +186200 START-TEST-GF-24. IX2104.2 +186300* IX2104.2 +186400* START-TEST-GF-24 - THE START STATEMENT USES AN OPERAND IN THE IX2104.2 +186500* KEY PHRASE WHICH IS NOT THE NAME OF AN IX2104.2 +186600* ALTERNATE KEY BUT IS THE NAME OF A DATA ITEM IX2104.2 +186700* THAT IS SUBORDINATE TO THE KEY. THE CONTENTSIX2104.2 +186800* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2104.2 +186900* ALTERNATE KEY) IS A DUPLICATE OF THE FIRST IX2104.2 +187000* 5 POSITIONS OF 5 OTHER RECORDS IN THE FILE. IX2104.2 +187100* THIS TEST EXPECTS THE RECORD POINTER IX2104.2 +187200* TO BE POSITIONED TO RECORD KEY XXXXYYYYYY392 IX2104.2 +187300* ALTKEY1 (RECORD NUMBER 196) WHICH WAS THE IX2104.2 +187400* RECORD WRITTEN AFTER THE LAST RECORD THAT IX2104.2 +187500* CONTAINS XXXXX IN THE FIRST 5 POSITIONS OF IX2104.2 +187600* THE KEY. THE ALTERNATE KEY WAS LOADED WITH THEIX2104.2 +187700* VALUE XXXXXXXXXX380ALTKEY1 (KEY FOR RECORD IX2104.2 +187800* NUMBER 190) BEFORE THE START WAS EXECUTED. IX2104.2 +187900* IX2104.2 +188000 START IX-FS1 IX2104.2 +188100 KEY IS GREATER THAN IX-FS1-ALTKEY1-1-5 IX2104.2 +188200 INVALID KEY IX2104.2 +188300 MOVE FS1-STATUS TO FILESTATUS (6) IX2104.2 +188400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +188500 GO TO START-FAIL-GF-24. IX2104.2 +188600 MOVE FS1-STATUS TO FILESTATUS (6). IX2104.2 +188700 READ IX-FS1 AT END IX2104.2 +188800 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +188900 GO TO START-FAIL-GF-24. IX2104.2 +189000 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +189100 IF XRECORD-NUMBER (1) EQUAL TO 196 IX2104.2 +189200 PERFORM PASS IX2104.2 +189300 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2104.2 +189400 GO TO START-EXIT-GF-24. IX2104.2 +189500 MOVE 71 TO RECNO. IX2104.2 +189600 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +189700 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +189800 START-FAIL-GF-24. IX2104.2 +189900 PERFORM FAIL. IX2104.2 +190000 MOVE 196 TO CORRECT-18V0. IX2104.2 +190100 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +190200 GO TO START-EXIT-GF-24. IX2104.2 +190300 START-DELETE-GF-24. IX2104.2 +190400 PERFORM DE-LETE. IX2104.2 +190500 START-EXIT-GF-24. IX2104.2 +190600 PERFORM PRINT-DETAIL. IX2104.2 +190700 START-INIT-GF-25. IX2104.2 +190800 PERFORM START-INITIALIZE-RECORD. IX2104.2 +190900 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +191000 MOVE "START-TEST-GF-25" TO PAR-NAME. IX2104.2 +191100 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +191200 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +191300 MOVE "**" TO FILESTATUS (7) IX2104.2 +191400 GO TO START-DELETE-GF-25. IX2104.2 +191500 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2104.2 +191600 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +191700 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +191800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +191900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +192000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +192100 START-TEST-GF-25. IX2104.2 +192200* IX2104.2 +192300* START-TEST-GF-25 - THE START STATEMENT USES AN OPERAND IN THE IX2104.2 +192400* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +192500* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2104.2 +192600* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +192700* POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IX2104.2 +192800* IS LOADED WITH YYYYYY WHICH IS THE KEY VALUE IX2104.2 +192900* OF THE LAST RECORD IN THE FILE. THERE SHOULDIX2104.2 +193000* BE NO RECORD IN THE FILE WITH A KEY VALUE IX2104.2 +193100* GREATER THUS AN INVALID KEY IS EXPECTED IX2104.2 +193200* WHEN THE START IS EXECUTED. IX2104.2 +193300* IX2104.2 +193400 START IX-FS1 IX2104.2 +193500 KEY IS GREATER THAN R-ALTKEY1-1-6 IX2104.2 +193600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2104.2 +193700 GO TO START-PASS-GF-25. IX2104.2 +193800 MOVE FS1-STATUS TO FILESTATUS (7). IX2104.2 +193900 READ IX-FS1 AT END IX2104.2 +194000 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +194100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +194200 PERFORM FAIL. IX2104.2 +194300 MOVE "AT END PATH AND IX-36 ETC " TO RE-MARK. IX2104.2 +194400 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +194500 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +194600 GO TO START-EXIT-GF-25. IX2104.2 +194700 START-PASS-GF-25. IX2104.2 +194800 PERFORM PASS. IX2104.2 +194900 MOVE "INVALID KEY" TO RE-MARK. IX2104.2 +195000 GO TO START-EXIT-GF-25. IX2104.2 +195100 START-DELETE-GF-25. IX2104.2 +195200 PERFORM DE-LETE. IX2104.2 +195300 START-EXIT-GF-25. IX2104.2 +195400 PERFORM PRINT-DETAIL. IX2104.2 +195500 START-INIT-GF-26. IX2104.2 +195600 PERFORM START-INITIALIZE-RECORD. IX2104.2 +195700 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +195800 MOVE "START-TEST-GF-26" TO PAR-NAME. IX2104.2 +195900 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +196000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +196100 MOVE "**" TO FILESTATUS (8) IX2104.2 +196200 GO TO START-DELETE-GF-26. IX2104.2 +196300 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2104.2 +196400 MOVE "EEEEDEEEEE002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +196500 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +196600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +196700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +196800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +196900 START-TEST-GF-26. IX2104.2 +197000* IX2104.2 +197100* START-TEST-GF-26 - THIS TEST USES AN OPERAND IN THE IX2104.2 +197200* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +197300* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2104.2 +197400* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +197500* (POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IS IX2104.2 +197600* LOADED WITH "EEEEDE". THIS KEY VALUE IX2104.2 +197700* IS LOWER THAN ANY ALTERNATE KEY VALUE IN IX2104.2 +197800* POSITION 1 THRU 6 EXISTING IN THE FILE IX2104.2 +197900* THE START STATEMENT WITH THE KEY IS GREATER IX2104.2 +198000* THAN PHRASE IS EXECUTED AND SHOULD FIND A IX2104.2 +198100* RECORD WITH THE KEY VALUE "EEEEEEEEEF002 IX2104.2 +198200* ALTKEY1 (RECORD NUMBER 01). IX2104.2 +198300* IX2104.2 +198400 START IX-FS1 IX2104.2 +198500 KEY IS GREATER THAN R-ALTKEY1-1-6 IX2104.2 +198600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2104.2 +198700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2104.2 +198800 GO TO START-FAIL-GF-26. IX2104.2 +198900 MOVE FS1-STATUS TO FILESTATUS (8). IX2104.2 +199000 READ IX-FS1 AT END IX2104.2 +199100 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +199200 GO TO START-FAIL-GF-26. IX2104.2 +199300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +199400 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2104.2 +199500 PERFORM PASS IX2104.2 +199600 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2104.2 +199700 GO TO START-EXIT-GF-26. IX2104.2 +199800 MOVE 01 TO RECNO. IX2104.2 +199900 PERFORM DISPLAY-ALTERNATE-KEY1. IX2104.2 +200000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2104.2 +200100 START-FAIL-GF-26. IX2104.2 +200200 PERFORM FAIL. IX2104.2 +200300 MOVE 001 TO CORRECT-18V0. IX2104.2 +200400 MOVE "RECORD NUMBER; IX-36 ETC " TO RE-MARK. IX2104.2 +200500 GO TO START-EXIT-GF-26. IX2104.2 +200600 START-DELETE-GF-26. IX2104.2 +200700 PERFORM DE-LETE. IX2104.2 +200800 START-EXIT-GF-26. IX2104.2 +200900 PERFORM PRINT-DETAIL. IX2104.2 +201000 START-INIT-GF-27. IX2104.2 +201100 PERFORM START-INITIALIZE-RECORD. IX2104.2 +201200 MOVE "STR GT ALTKY W/O DUP" TO FEATURE. IX2104.2 +201300 MOVE "START-TEST-GF-27" TO PAR-NAME. IX2104.2 +201400 IF INIT-FLAG NOT EQUAL TO ZERO IX2104.2 +201500 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK IX2104.2 +201600 MOVE "**" TO FILESTATUS (9) IX2104.2 +201700 GO TO START-DELETE-GF-27. IX2104.2 +201800 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2104.2 +201900 MOVE "YYYYYZYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +202000 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +202100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +202200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +202300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +202400 START-TEST-GF-27. IX2104.2 +202500* IX2104.2 +202600* START-TEST-GF-27 - THIS TEST USES AN OPERAND IN THE IX2104.2 +202700* KEY PHRASE OF THE START STATEMENT WHICH IS IX2104.2 +202800* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2104.2 +202900* NAME. THE CONTENTS OF THE DATA ITEM IX2104.2 +203000* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2104.2 +203100* LOADED WITH "YYYYYZYYYY". THIS KEY VALUE IX2104.2 +203200* IS GREATER THAN ANY ALTERNATE KEY VALUE IN IX2104.2 +203300* POSITION 1 THRU 10 EXISTING IN THE FILE IX2104.2 +203400* THEREFORE AN INVALID KEY CONDITION IS IX2104.2 +203500* EXPECTED WHEN THE START STATEMENT IS IX2104.2 +203600* EXECUTED. IX2104.2 +203700* IX2104.2 +203800 START IX-FS1 IX2104.2 +203900 KEY IS GREATER THAN IX-FS1-ALTKEY1-1-10 IX2104.2 +204000 INVALID KEY IX2104.2 +204100 MOVE FS1-STATUS TO FILESTATUS (9) IX2104.2 +204200 GO TO START-PASS-GF-27. IX2104.2 +204300 MOVE FS1-STATUS TO FILESTATUS (9). IX2104.2 +204400 READ IX-FS1 AT END IX2104.2 +204500 MOVE "IX-36 ETC.; AT END PATH TAKEN ON READ" TO RE-MARK.IX2104.2 +204600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +204700 PERFORM FAIL. IX2104.2 +204800 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2104.2 +204900 MOVE "INVALID KEY" TO CORRECT-A. IX2104.2 +205000 GO TO START-EXIT-GF-27. IX2104.2 +205100 START-PASS-GF-27. IX2104.2 +205200 PERFORM PASS. IX2104.2 +205300 MOVE "INVALID KEY OK." TO RE-MARK. IX2104.2 +205400 GO TO START-EXIT-GF-27. IX2104.2 +205500 START-DELETE-GF-27. IX2104.2 +205600 PERFORM DE-LETE. IX2104.2 +205700 START-EXIT-GF-27. IX2104.2 +205800 PERFORM PRINT-DETAIL. IX2104.2 +205900 IX2104.2 +206000 CLOSE IX-FS1. IX2104.2 +206100 IX2104.2 +206200* IX2104.2 +206300* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2104.2 +206400* CAPTURED FROM THE TESTS IN START-TEST-005. IX2104.2 +206500* IX2104.2 +206600 START-TEST-GF-28. IX2104.2 +206700 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +206800 MOVE "START-TEST-GF-28" TO PAR-NAME. IX2104.2 +206900 IF FILESTATUS (1) EQUAL TO "**" IX2104.2 +207000 PERFORM DE-LETE IX2104.2 +207100 GO TO START-WRITE-GF-28. IX2104.2 +207200* IX2104.2 +207300* START-TEST-GF-28 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +207400* RESULTING FROM START-TEST-GF-19. THE FILE IX2104.2 +207500* STATUS CONTENTS IS EXPECTED TO BE "00". IX2104.2 +207600* IX2104.2 +207700 IF FILESTATUS (1) EQUAL TO "00" IX2104.2 +207800 PERFORM PASS IX2104.2 +207900 ELSE IX2104.2 +208000 MOVE "FROM START-TEST-GF-19; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +208100 PERFORM FAIL IX2104.2 +208200 MOVE "00" TO CORRECT-A IX2104.2 +208300 MOVE FILESTATUS (1) TO COMPUTED-A. IX2104.2 +208400 START-WRITE-GF-28. IX2104.2 +208500 PERFORM PRINT-DETAIL. IX2104.2 +208600 START-TEST-GF-29. IX2104.2 +208700 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +208800 MOVE "START-TEST-GF-29" TO PAR-NAME. IX2104.2 +208900 IF FILESTATUS (2) EQUAL TO "**" IX2104.2 +209000 PERFORM DE-LETE IX2104.2 +209100 GO TO START-WRITE-GF-29. IX2104.2 +209200* IX2104.2 +209300* START-TEST-GF-29 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +209400* RESULTING FROM START-TEST-GF-20. THE FILE IX2104.2 +209500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +209600* IX2104.2 +209700 IF FILESTATUS (2) EQUAL TO "00" IX2104.2 +209800 PERFORM PASS IX2104.2 +209900 ELSE PERFORM FAIL IX2104.2 +210000 MOVE "FROM START-TEST-GF-20; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +210100 MOVE "00" TO CORRECT-A IX2104.2 +210200 MOVE FILESTATUS (2) TO COMPUTED-A. IX2104.2 +210300 START-WRITE-GF-29. IX2104.2 +210400 PERFORM PRINT-DETAIL. IX2104.2 +210500 START-TEST-GF-30. IX2104.2 +210600 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +210700 MOVE "START-TEST-GF-30" TO PAR-NAME. IX2104.2 +210800 IF FILESTATUS (3) EQUAL TO "**" IX2104.2 +210900 PERFORM DE-LETE IX2104.2 +211000 GO TO START-WRITE-GF-30. IX2104.2 +211100* IX2104.2 +211200* START-TEST-GF-30 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +211300* RESULTING FROM START-TEST-GF-21. THE FILE IX2104.2 +211400* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +211500* IX2104.2 +211600 IF FILESTATUS (3) EQUAL TO "00" IX2104.2 +211700 PERFORM PASS IX2104.2 +211800 ELSE PERFORM FAIL IX2104.2 +211900 MOVE "FROM START-TEST-GF-21; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +212000 MOVE "00" TO CORRECT-A IX2104.2 +212100 MOVE FILESTATUS (3) TO COMPUTED-A. IX2104.2 +212200 START-WRITE-GF-30. IX2104.2 +212300 PERFORM PRINT-DETAIL. IX2104.2 +212400 START-TEST-GF-31. IX2104.2 +212500 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +212600 MOVE "START-TEST-GF-31" TO PAR-NAME. IX2104.2 +212700 IF FILESTATUS (4) EQUAL TO "**" IX2104.2 +212800 PERFORM DE-LETE IX2104.2 +212900 GO TO START-WRITE-GF-31. IX2104.2 +213000* IX2104.2 +213100* START-TEST-GF-31 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +213200* RESULTING FROM START-TEST-GF-22. THE FILE IX2104.2 +213300* STATUS CONTENTS IS EXPECTED TO BE "23". IX2104.2 +213400* IX2104.2 +213500 IF FILESTATUS (4) EQUAL TO "23" IX2104.2 +213600 PERFORM PASS IX2104.2 +213700 ELSE PERFORM FAIL IX2104.2 +213800 MOVE "FROM START-TEST-GF-22; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +213900 MOVE "23" TO CORRECT-A IX2104.2 +214000 MOVE FILESTATUS (4) TO COMPUTED-A. IX2104.2 +214100 START-WRITE-GF-31. IX2104.2 +214200 PERFORM PRINT-DETAIL. IX2104.2 +214300 START-TEST-GF-32. IX2104.2 +214400 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +214500 MOVE "START-TEST-GF-32" TO PAR-NAME. IX2104.2 +214600 IF FILESTATUS (5) EQUAL TO "**" IX2104.2 +214700 PERFORM DE-LETE IX2104.2 +214800 GO TO START-WRITE-GF-32. IX2104.2 +214900* IX2104.2 +215000* START-TEST-GF.05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +215100* RESULTING FROM START-TEST-GF-23. THE FILE IX2104.2 +215200* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +215300* IX2104.2 +215400 IF FILESTATUS (5) EQUAL TO "00" IX2104.2 +215500 PERFORM PASS IX2104.2 +215600 ELSE PERFORM FAIL IX2104.2 +215700 MOVE "FROM START-TEST-GF-23; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +215800 MOVE "00" TO CORRECT-A IX2104.2 +215900 MOVE FILESTATUS (5) TO COMPUTED-A. IX2104.2 +216000 START-WRITE-GF-32. IX2104.2 +216100 PERFORM PRINT-DETAIL. IX2104.2 +216200 START-TEST-GF-33. IX2104.2 +216300 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +216400 MOVE "START-TEST-GF-33" TO PAR-NAME. IX2104.2 +216500 IF FILESTATUS (6) EQUAL TO "**" IX2104.2 +216600 PERFORM DE-LETE IX2104.2 +216700 GO TO START-WRITE-GF-33. IX2104.2 +216800* IX2104.2 +216900* START-TEST-GF-33 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +217000* RESULTING FROM START-TEST-GF-24. THE FILE IX2104.2 +217100* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +217200* IX2104.2 +217300 IF FILESTATUS (6) EQUAL TO "00" IX2104.2 +217400 PERFORM PASS IX2104.2 +217500 ELSE PERFORM FAIL IX2104.2 +217600 MOVE "FROM START-TEST-GF-24; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +217700 MOVE "00" TO CORRECT-A IX2104.2 +217800 MOVE FILESTATUS (6) TO COMPUTED-A. IX2104.2 +217900 START-WRITE-GF-33. IX2104.2 +218000 PERFORM PRINT-DETAIL. IX2104.2 +218100 START-TEST-GF-34. IX2104.2 +218200 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +218300 MOVE "START-TEST-GF-34" TO PAR-NAME. IX2104.2 +218400 IF FILESTATUS (7) EQUAL TO "**" IX2104.2 +218500 PERFORM DE-LETE IX2104.2 +218600 GO TO START-WRITE-GF-34. IX2104.2 +218700* IX2104.2 +218800* START-TEST-GF-34 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +218900* RESULTING FROM START-TEST-GF-25. THE FILE IX2104.2 +219000* STATUS CONTENTS IS EXPECTED TO BE "23" IX2104.2 +219100* IX2104.2 +219200 IF FILESTATUS (7) EQUAL TO "23" IX2104.2 +219300 PERFORM PASS IX2104.2 +219400 ELSE PERFORM FAIL IX2104.2 +219500 MOVE "FROM START-TEST-GF-25; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +219600 MOVE "23" TO CORRECT-A IX2104.2 +219700 MOVE FILESTATUS (7) TO COMPUTED-A. IX2104.2 +219800 START-WRITE-GF-34. IX2104.2 +219900 PERFORM PRINT-DETAIL. IX2104.2 +220000 START-TEST-GF-35. IX2104.2 +220100 MOVE "FILE STATUS START:00" TO FEATURE. IX2104.2 +220200 MOVE "START-TEST-GF-35" TO PAR-NAME. IX2104.2 +220300 IF FILESTATUS (8) EQUAL TO "**" IX2104.2 +220400 PERFORM DE-LETE IX2104.2 +220500 GO TO START-WRITE-GF-35. IX2104.2 +220600* IX2104.2 +220700* START-TEST-GF-35 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +220800* RESULTING FROM START-TEST-GF-26. THE FILE IX2104.2 +220900* STATUS CONTENTS IS EXPECTED TO BE "00" IX2104.2 +221000* IX2104.2 +221100 IF FILESTATUS (8) EQUAL TO "00" IX2104.2 +221200 PERFORM PASS IX2104.2 +221300 ELSE PERFORM FAIL IX2104.2 +221400 MOVE "FROM START-TEST-GF-26; IX-3 1.3.4 (1) A" TO RE-MARKIX2104.2 +221500 MOVE "00" TO CORRECT-A IX2104.2 +221600 MOVE FILESTATUS (8) TO COMPUTED-A. IX2104.2 +221700 START-WRITE-GF-35. IX2104.2 +221800 PERFORM PRINT-DETAIL. IX2104.2 +221900 START-TEST-GF-36. IX2104.2 +222000 MOVE "FILE STATUS START:23" TO FEATURE. IX2104.2 +222100 MOVE "START-TEST-GF-36" TO PAR-NAME. IX2104.2 +222200 IF FILESTATUS (9) EQUAL TO "**" IX2104.2 +222300 PERFORM DE-LETE IX2104.2 +222400 GO TO START-WRITE-GF-36. IX2104.2 +222500* IX2104.2 +222600* START-TEST-GF-36 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2104.2 +222700* RESULTING FROM START-TEST-GF-27. THE FILE IX2104.2 +222800* STATUS CONTENTS IS EXPECTED TO BE "23". IX2104.2 +222900* IX2104.2 +223000 IF FILESTATUS (9) EQUAL TO "23" IX2104.2 +223100 PERFORM PASS IX2104.2 +223200 ELSE PERFORM FAIL IX2104.2 +223300 MOVE "FROM START-TEST-GF-27; IX-4 1.3.4 (3) C" TO RE-MARKIX2104.2 +223400 MOVE "23" TO CORRECT-A IX2104.2 +223500 MOVE FILESTATUS (9) TO COMPUTED-A. IX2104.2 +223600 START-WRITE-GF-36. IX2104.2 +223700 PERFORM PRINT-DETAIL. IX2104.2 +223800 IX2104.2 +223900 IX2104.2 +224000 START-INIT-GF-SERIES. IX2104.2 +224100 OPEN I-O IX-FS1. IX2104.2 +224200 MOVE "START SERIES" TO FEATURE. IX2104.2 +224300 MOVE "START-TEST-GF-37" TO PAR-NAME. IX2104.2 +224400 MOVE ZERO TO INVKEY-COUNTER. IX2104.2 +224500* IX2104.2 +224600* THIS TEST EXECUTES SEVERAL START STATEMENTS USING DIFFERENT IX2104.2 +224700* KEY VALUES. FOLLOWING EXECUTION OF THE LAST START IX2104.2 +224800* STATEMENT THE READ STATEMENT IS EXECUTED. THE START IX2104.2 +224900* STATEMENT SHOULD HAVE POSITION THE RECORD POINTER IX2104.2 +225000* SUCH THAT RECORD NUMBER 49 IS MADE AVAILABLE FOLLOWING IX2104.2 +225100* EXECUTION OF THE READ STATEMENT. THE KEY OF REFERENCE IX2104.2 +225200* SHOULD BE ALTERNATE-KEY-2. IX2104.2 +225300* IX2104.2 +225400 START-TEST-GF-37. IX2104.2 +225500 MOVE "FGGGGGGGGG098" TO FS1-RECKEY-1-13. IX2104.2 +225600 MOVE "WWWWWWWXXX366ALTKEY1" TO FS1-ALTKEY1-1-20. IX2104.2 +225700 MOVE "RRRRRRRRRR300ALTKEY2" TO FS1-ALTKEY2-1-20. IX2104.2 +225800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +225900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2104.2 +226000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2104.2 +226100 START IX-FS1 IX2104.2 +226200 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2104.2 +226300 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2104.2 +226400 START IX-FS1 IX2104.2 +226500 INVALID KEY ADD 01 TO INVKEY-COUNTER. IX2104.2 +226600 START IX-FS1 IX2104.2 +226700 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2104.2 +226800 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2104.2 +226900 START IX-FS1 IX2104.2 +227000 KEY IS GREATER THAN IX-FS1-ALTKEY2-1-5 IX2104.2 +227100 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2104.2 +227200 READ IX-FS1 AT END IX2104.2 +227300 MOVE "AT END ON READ" TO COMPUTED-A IX2104.2 +227400 GO TO START-FAIL-GF-37. IX2104.2 +227500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2104.2 +227600 IF XRECORD-NUMBER (1) EQUAL TO 49 IX2104.2 +227700 PERFORM PASS IX2104.2 +227800 MOVE "MULTIPLE STARTS BEFORE READ " TO RE-MARK IX2104.2 +227900 GO TO START-EXIT-GF-37. IX2104.2 +228000 MOVE 49 TO RECNO. IX2104.2 +228100 PERFORM DISPLAY-ALTERNATE-KEY2. IX2104.2 +228200 START-FAIL-GF-37. IX2104.2 +228300 PERFORM FAIL. IX2104.2 +228400 MOVE 49 TO CORRECT-18V0. IX2104.2 +228500 MOVE "AFTER MULTIPLE STARTS; IX-36 ETC " TO RE-MARK. IX2104.2 +228600 GO TO START-EXIT-GF-37. IX2104.2 +228700 START-DELETE-GF-37. IX2104.2 +228800 PERFORM DE-LETE. IX2104.2 +228900 START-EXIT-GF-37. IX2104.2 +229000 PERFORM PRINT-DETAIL. IX2104.2 +229100 CLOSE IX-FS1. IX2104.2 +229200 START-CLOSE-FILES. IX2104.2 +229300 GO TO START-TEST-COMPLETE. IX2104.2 +229400 START-INITIALIZE-RECORD. IX2104.2 +229500 MOVE "**" TO FS1-STATUS. IX2104.2 +229600 MOVE "GGGGGGGGGG200" TO FS1-RECKEY-1-13. IX2104.2 +229700 MOVE ZERO TO INIT-FLAG. IX2104.2 +229800 MOVE 9999 TO XRECORD-NUMBER (1). IX2104.2 +229900 MOVE SPACE TO IX-FS1R1-F-G-240. IX2104.2 +230000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2104.2 +230100 START IX-FS1 IX2104.2 +230200 KEY IS EQUAL TO IX-FS1-KEY IX2104.2 +230300 INVALID KEY MOVE 1 TO INIT-FLAG. IX2104.2 +230400 READ IX-FS1 INTO FILE-RECORD-INFO (1) IX2104.2 +230500 AT END MOVE 1 TO INIT-FLAG. IX2104.2 +230600 IF XRECORD-NUMBER (1) NOT EQUAL TO 100 IX2104.2 +230700 MOVE 1 TO INIT-FLAG. IX2104.2 +230800 DISPLAY-RECORD-KEYS. IX2104.2 +230900 MOVE XRECORD-KEY (1) TO WRK-FS1-RECKEY. IX2104.2 +231000 MOVE FS1-RECKEY-1-13 TO COMPUTED-A. IX2104.2 +231100 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2104.2 +231200 MOVE SPACE TO P-OR-F. IX2104.2 +231300 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2104.2 +231400 PERFORM PRINT-DETAIL. IX2104.2 +231500 DISPLAY-ALTERNATE-KEY1. IX2104.2 +231600 MOVE ALTERNATE-KEY1 (1) TO WRK-FS1-ALTKEY1. IX2104.2 +231700 MOVE FS1-ALTKEY1-1-20 TO COMPUTED-A. IX2104.2 +231800 MOVE ALTKEY1-VALUE (RECNO) TO CORRECT-A. IX2104.2 +231900 MOVE SPACE TO P-OR-F. IX2104.2 +232000 MOVE "ALTERNATE RECORD KEY1 VALUES" TO RE-MARK. IX2104.2 +232100 PERFORM PRINT-DETAIL. IX2104.2 +232200 DISPLAY-ALTERNATE-KEY2. IX2104.2 +232300 MOVE ALTERNATE-KEY2 (1) TO WRK-FS1-ALTKEY2. IX2104.2 +232400 MOVE FS1-ALTKEY2-1-20 TO COMPUTED-A. IX2104.2 +232500 MOVE ALTKEY2-VALUE (RECNO) TO CORRECT-A. IX2104.2 +232600 MOVE SPACE TO P-OR-F. IX2104.2 +232700 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2104.2 +232800 PERFORM PRINT-DETAIL. IX2104.2 +232900 START-TEST-COMPLETE. IX2104.2 +233000 EXIT. IX2104.2 +233100 CCVS-EXIT SECTION. IX2104.2 +233200 CCVS-999999. IX2104.2 +233300 GO TO CLOSE-FILES. IX2104.2 diff --git a/tests/cobol85/IX/IX211A.CBL b/tests/cobol85/IX/IX211A.CBL new file mode 100755 index 00000000..63200451 --- /dev/null +++ b/tests/cobol85/IX/IX211A.CBL @@ -0,0 +1,1125 @@ +000100 IDENTIFICATION DIVISION. IX2114.2 +000200 PROGRAM-ID. IX2114.2 +000300 IX211A. IX2114.2 +000400**************************************************************** IX2114.2 +000500* * IX2114.2 +000600* VALIDATION FOR:- * IX2114.2 +000700* * IX2114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2114.2 +000900* * IX2114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2114.2 +001100* * IX2114.2 +001200**************************************************************** IX2114.2 +001300* * IX2114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2114.2 +001500* * IX2114.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2114.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2114.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2114.2 +001900* * IX2114.2 +002000**************************************************************** IX2114.2 +002100* "IX211A" IX2114.2 +002200******************************************************************IX2114.2 +002300* IX2114.2 +002400* THIS PROGRAM TESTS THE CAPABILITY TO CHANGE (UPDATE) INDEX IX2114.2 +002500* KEYS OF RECORDS IN AN INDEXED I-O FILE AND THEN RETRIEVE THE IX2114.2 +002600* RECORDS FROM THE FILE IN THE PROPER SEQUENCE. A RECORD IX2114.2 +002700* MODIFICATION FOR THE FILE WILL INVOLVE THE UPDATING IX2114.2 +002800* OF THE UPDATE-NUMBER FIELD, THE RECORD-KEY OR ALTERNATE-KEY, IX2114.2 +002900* AND THE ODO-NUMBER FIELD OF THE RECORD. EACH TIME A GIVEN IX2114.2 +003000* RECORD IS MODIFIED THE UPDATE-NUMBER FIELD WILL BE INCREMENT-IX2114.2 +003100* ED BY ONE. TO KEEP TRACK OF THOSE RECORDS MODIFIED, IX2114.2 +003200* THE ODO-NUMBER FIELD WILL ALWAYS CARRY THE SEQUENTIAL LOC- IX2114.2 +003300* ATION OF THE RECORD WITHIN THE FILE WHICH REFLECTS THE LAST IX2114.2 +003400* KEY VALUE POSITION BEFORE THE RECORD WAS MODIFIED. THIS IX2114.2 +003500* LOCATION NUMBER WILL BE USED FOR VERIFYING THAT THE SEQUENTI-IX2114.2 +003600* AL REORDING OF THE RECORD FOR THE FILE WAS PROPER. ONLY ONE IX2114.2 +003700* OF THE 3 KEYS OF THE RECORD WILLBE MODIFIED FOR ANY GIVEN IX2114.2 +003800* REWIRTE OF THE RECORD. IX2114.2 +003900* FURTHER A TEST IS MADE TO SEE IF THE POSITION INDICATOR IX2114.2 +004000* IS AFFECTED BY EXECUTION OF THE REWRITE STATEMENT. IT SHOULDIX2114.2 +004100* NOT (PARAGRAPH 4.6.4 (7), PAGE IX-34). IX2114.2 +004200* IX2114.2 +004300* REFERENCE AMERICAN NATIONAL STANDARD IX2114.2 +004400* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IX2114.2 +004500* SECTION IX, INDEXED I-O, THE REWRITE IX2114.2 +004600* STATEMENT, PARAGRAPHS 4.6.4 (7),(14), ANDIX2114.2 +004700* (15 B) IX2114.2 +004800* IX2114.2 +004900* IX2114.2 +005000* THIS PROGRAM FIRST CREATES AN INDEXED SEQUENTIAL FILE IX2114.2 +005100* CONTAINING TWO ALTERNATE KEYS AND THE ONE REQUIRED RECORD IX2114.2 +005200* KEY FOR THE FILE. IMMEDIATELY FOLLOWING FILE CREATION THE IX2114.2 +005300* FILE IS READ AND THE RECORDS OF THE FILE VERIFIED FOR IX2114.2 +005400* ACCURACY. IX2114.2 +005500* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2114.2 +005600* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA IX2114.2 +005700* CONTENTS FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN IX2114.2 +005800* THE FILE. IX2114.2 +005900* IX2114.2 +006000* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2114.2 +006100* ------ ---------- --------------- --------------- IX2114.2 +006200* 001 BBBBBBBBBC002 EEEEEEEEEF000ALTKEY1 WWWWWWWWWV398ALTKEY2IX2114.2 +006300* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2114.2 +006400* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2114.2 +006500* . . . . IX2114.2 +006600* . . . . IX2114.2 +006700* . . . . IX2114.2 +006800* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2114.2 +006900* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2114.2 +007000* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2114.2 +007100* . . . . IX2114.2 +007200* . . . . IX2114.2 +007300* . . . . IX2114.2 +007400* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEY2IX2114.2 +007500* IX2114.2 +007600* NOTE 1 - ALTERNATE KEY NUMBER 2 CONTAINS DUPLICATE KEYS IX2114.2 +007700* EVERY 10TH AND 11TH RECORDS. IX2114.2 +007800* IX2114.2 +007900* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE IX2114.2 +008000* FILE FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE MIDDLEIX2114.2 +008100* 125 RECORDS ONLY THE NUMBER PART OF THE KEYS ARE VARIED IX2114.2 +008200* AND VARIED IN THE SEQUENCE SHOWN ABOVE. THAT IS, RECORD-KEY IX2114.2 +008300* AND ALTERNATE-KEY-1 ARE INCREMENTED BY 2 AND THE ALTERNATE- IX2114.2 +008400* KEY-2 IS DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO IX2114.2 +008500* THE FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO THAT IX2114.2 +008600* AN I-O OPERATION IS REQUIRED FOR EACH RECORD ACCESSED FROM IX2114.2 +008700* THE FILE. IX2114.2 +008800* IX2114.2 +008900* FILE CHARACTERISTICS ARE: FILE SIZE = 200 RECORDS IX2114.2 +009000* RECORD SIZE = 240 CHARS. IX2114.2 +009100* RECORD KEY SIZE = 13 CHARS. IX2114.2 +009200* ALTERNATE KEY 1 SIZE = 20 CHARS. IX2114.2 +009300* ALTERNATE KEY 2 SIZE = 20 CHARS. IX2114.2 +009400* ACCESS MODE = DYNAMIC IX2114.2 +009500* IX2114.2 +009600* A LIST OF COBOL ELEMENTS WITH THE PARAGRAPH NAME IN PARENTH- IX2114.2 +009700* ESIS THAT TESTS THE ELEMENT AND A SHORT DESCRIPTION OF THE IX2114.2 +009800* TEST FOLLOWS. IX2114.2 +009900* IX2114.2 +010000* WRITE --- INVALID KEY --. (INX-TEST-001) - THIS TEST IX2114.2 +010100* CREATES A FILE OF 200 RECORDS CONTAINING A RECORD KEYIX2114.2 +010200* AND 2 ALTERNATE KEYS. IX2114.2 +010300* READ --- AT END ---. (INX-TEST-002) - THIS TEST READS THE IX2114.2 +010400* FILE CREATED IN INX-TEST-001 AND VERIFIES THAT THE IX2114.2 +010500* FILE WAS CREATED CORRECTLY. IX2114.2 +010600* START --- KEY IS EQUAL TO ALTERNAT-KEY1 ---. AND IX2114.2 +010700* READ --- NEXT AT END ---. (INX-TEST-003.01) - THIS TEST IX2114.2 +010800* READS A RECORD AND ESTABLISHES THE ALTERNAT-KEY1 AS IX2114.2 +010900* THE KEY OF REFERENCE FOR THE FOLLOWING REWRITE TEST. IX2114.2 +011000* REWRITE --- INVALID KEY ---. (INX-TEST-003-02) - THIS TEST IX2114.2 +011100* MODIFIES THE ALTERNATE-KEY1 KEY OF THE RECORD AND IX2114.2 +011200* REWRITES THE RECORD IX2114.2 +011300* READ --- NEXT AT END ---. (INX-TEST-003.03) - ONE RECORD IX2114.2 +011400* IS READ SEQUENTIALLY FROM THE FILE. THE REWRITE IX2114.2 +011500* IN PREVIOUS TEST SHOULD NOT HAVE AFFECTED THE RECORD IX2114.2 +011600* POINTER FOR THE FILE, THUS THE RECORD MADE AVAILABLE IX2114.2 +011700* SHOULD BE THE NEXT RECORD AS THOUGH THE ALTERNATE KEYIX2114.2 +011800* HAD NOT BEEN MODIFIED. IX2114.2 +011900* READ --- NEXT AT END ---. (INX-TEST-003.04) - THIS TEST IX2114.2 +012000* READS THE NEXT 4 RECORDS SEQUENTIALLY TO SEE IF IX2114.2 +012100* THE REWRITE OF THE RECORD CAUSED SEQUENTIAL IX2114.2 +012200* REORDING OF THE RECORDS. IX2114.2 +012300* IX2114.2 +012400******************************************************************IX2114.2 +012500 ENVIRONMENT DIVISION. IX2114.2 +012600 CONFIGURATION SECTION. IX2114.2 +012700 SOURCE-COMPUTER. IX2114.2 +012800 Linux. IX2114.2 +012900 OBJECT-COMPUTER. IX2114.2 +013000 Linux. IX2114.2 +013100 INPUT-OUTPUT SECTION. IX2114.2 +013200 FILE-CONTROL. IX2114.2 +013300*P SELECT RAW-DATA ASSIGN TO IX2114.2 +013400*P "XXXXX062" IX2114.2 +013500*P ORGANIZATION IS INDEXED IX2114.2 +013600*P ACCESS MODE IS RANDOM IX2114.2 +013700*P RECORD KEY IS RAW-DATA-KEY. IX2114.2 +013800 SELECT PRINT-FILE ASSIGN TO IX2114.2 +013900 "report.log". IX2114.2 +014000 SELECT IX-FD1 IX2114.2 +014100 ASSIGN TO IX2114.2 +014200 "XXXXX024" IX2114.2 +014300*J **** X-CARD UNDEFINED **** IX2114.2 +014400 ACCESS MODE IS DYNAMIC IX2114.2 +014500 ORGANIZATION IS INDEXED IX2114.2 +014600 RECORD KEY IS IX-FD1-KEY IX2114.2 +014700 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY1 IX2114.2 +014800 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY2 WITH DUPLICATES IX2114.2 +014900 FILE STATUS IS FD1-STATUS. IX2114.2 +015000 DATA DIVISION. IX2114.2 +015100 FILE SECTION. IX2114.2 +015200*P IX2114.2 +015300*PD RAW-DATA. IX2114.2 +015400*P IX2114.2 +015500*P1 RAW-DATA-SATZ. IX2114.2 +015600*P 05 RAW-DATA-KEY PIC X(6). IX2114.2 +015700*P 05 C-DATE PIC 9(6). IX2114.2 +015800*P 05 C-TIME PIC 9(8). IX2114.2 +015900*P 05 C-NO-OF-TESTS PIC 99. IX2114.2 +016000*P 05 C-OK PIC 999. IX2114.2 +016100*P 05 C-ALL PIC 999. IX2114.2 +016200*P 05 C-FAIL PIC 999. IX2114.2 +016300*P 05 C-DELETED PIC 999. IX2114.2 +016400*P 05 C-INSPECT PIC 999. IX2114.2 +016500*P 05 C-NOTE PIC X(13). IX2114.2 +016600*P 05 C-INDENT PIC X. IX2114.2 +016700*P 05 C-ABORT PIC X(8). IX2114.2 +016800 FD PRINT-FILE. IX2114.2 +016900 01 PRINT-REC PICTURE X(120). IX2114.2 +017000 01 DUMMY-RECORD PICTURE X(120). IX2114.2 +017100 FD IX-FD1 IX2114.2 +017200*C LABEL RECORDS ARE STANDARD IX2114.2 +017300*C DATA RECORD IS IX-FD1R1-F-G-240 IX2114.2 +017400 RECORD CONTAINS 240 CHARACTERS. IX2114.2 +017500 01 IX-FD1R1-F-G-240. IX2114.2 +017600 05 IX-FD1-REC-120 PICTURE X(120). IX2114.2 +017700 05 IX-FD1-REC-121-240. IX2114.2 +017800 10 FILLER PICTURE X(8). IX2114.2 +017900 10 IX-REC-KEY-AREA. IX2114.2 +018000 15 IX-FD1-KEY. IX2114.2 +018100 20 IX-FD1-KEY-1-10. IX2114.2 +018200 25 IX-FD1-KEY-1-5 PICTURE X(5). IX2114.2 +018300 25 IX-FD1-KEY-6-10 PICTURE X(5). IX2114.2 +018400 20 IX-FD1-KEY-11-13 PICTURE X(3). IX2114.2 +018500 15 FILLER PICTURE X(16). IX2114.2 +018600 10 FILLER PICTURE X(9). IX2114.2 +018700 10 IX-ALT-KEY1-AREA. IX2114.2 +018800 15 IX-FD1-ALTKEY1. IX2114.2 +018900 20 IX-FD1-ALTKEY1-1-10. IX2114.2 +019000 25 IX-FD1-ALTKEY1-1-5 PICTURE X(5). IX2114.2 +019100 25 IX-FD1-ALTKEY1-6-10 PICTURE X(5). IX2114.2 +019200 20 IX-FD1-ALTKEY1-11-13 PICTURE X(3). IX2114.2 +019300 20 IX-FD1-ALTKEY1-14-20 PICTURE X(7). IX2114.2 +019400 15 FILLER PICTURE X(9). IX2114.2 +019500 10 FILLER PICTURE X(9). IX2114.2 +019600 10 IX-ALT-KEY2-AREA. IX2114.2 +019700 15 IX-FD1-ALTKEY2. IX2114.2 +019800 20 IX-FD1-ALTKEY2-1-10. IX2114.2 +019900 25 IX-FD1-ALTKEY2-1-5 PICTURE X(5). IX2114.2 +020000 25 IX-FD1-ALTKEY2-6-10 PICTURE X(5). IX2114.2 +020100 20 IX-FD1-ALTKEY2-11-13 PICTURE X(3). IX2114.2 +020200 20 IX-FD1-ALTKEY2-14-20 PICTURE X(7). IX2114.2 +020300 15 FILLER PICTURE X(9). IX2114.2 +020400 10 FILLER PICTURE X(7). IX2114.2 +020500 WORKING-STORAGE SECTION. IX2114.2 +020600 01 WRK-FD1-RECKEY. IX2114.2 +020700 05 FD1-RECKEY-1-13. IX2114.2 +020800 10 FD1-RECKEY-1-10 PICTURE X(10). IX2114.2 +020900 10 FD1-RECKEY-11-13 PICTURE 9(3). IX2114.2 +021000 05 FILLER PICTURE X(16) VALUE SPACE. IX2114.2 +021100 01 WRK-FD1-ALTKEY1. IX2114.2 +021200 05 FD1-ALTKEY1-1-20. IX2114.2 +021300 10 FD1-ALTKEY1-1-10. IX2114.2 +021400 15 FD1-ALTKEY1-1-5 PICTURE X(5). IX2114.2 +021500 15 FD1-ALTKEY1-6-10 PICTURE X(5). IX2114.2 +021600 10 FD1-ALTKEY1-11-13 PICTURE 9(3). IX2114.2 +021700 10 FD1-ALTKEY1-14-20 PICTURE X(7). IX2114.2 +021800 05 FILLER PICTURE X(9) VALUE SPACE. IX2114.2 +021900 01 WRK-FD1-ALTKEY2. IX2114.2 +022000 05 FD1-ALTKEY2-1-20. IX2114.2 +022100 10 FD1-ALTKEY2-1-10. IX2114.2 +022200 15 FD1-ALTKEY2-1-5 PICTURE X(5). IX2114.2 +022300 15 FD1-ALTKEY2-6-10 PICTURE X(5). IX2114.2 +022400 10 FD1-ALTKEY2-11-13 PICTURE 9(3). IX2114.2 +022500 10 FD1-ALTKEY2-14-20 PICTURE X(7). IX2114.2 +022600 05 FILLER PICTURE X(9) VALUE SPACE. IX2114.2 +022700 01 RECNO PICTURE 9(5) VALUE ZERO. IX2114.2 +022800 01 ADJUSTED-NUM PIC X(8) VALUE "NO". IX2114.2 +022900 01 FD1-STATUS PICTURE XX VALUE SPACE. IX2114.2 +023000 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2114.2 +023100 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2114.2 +023200 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2114.2 +023300 01 RECORDS-WRITTEN PICTURE 9(3). IX2114.2 +023400 01 RECKEY-NUM PICTURE 9(3). IX2114.2 +023500 01 ALTKEY1-NUM PICTURE 9(3). IX2114.2 +023600 01 ALTKEY2-NUM PICTURE 9(3). IX2114.2 +023700 01 RECORD-KEY-CONTENT. IX2114.2 +023800 05 FILLER PIC X(53) VALUE IX2114.2 +023900 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2114.2 +024000 05 FILLER PIC X(53) VALUE IX2114.2 +024100 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2114.2 +024200 05 FILLER PIC X(53) VALUE IX2114.2 +024300 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2114.2 +024400 05 FILLER PIC X(53) VALUE IX2114.2 +024500 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2114.2 +024600 05 FILLER PIC X(53) VALUE IX2114.2 +024700 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2114.2 +024800 05 FILLER PIC X(53) VALUE IX2114.2 +024900 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2114.2 +025000 05 FILLER PIC X(53) VALUE IX2114.2 +025100 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2114.2 +025200 05 FILLER PIC X(53) VALUE IX2114.2 +025300 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2114.2 +025400 05 FILLER PIC X(53) VALUE IX2114.2 +025500 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2114.2 +025600 05 FILLER PIC X(53) VALUE IX2114.2 +025700 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2114.2 +025800 05 FILLER PIC X(53) VALUE IX2114.2 +025900 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2114.2 +026000 05 FILLER PIC X(53) VALUE IX2114.2 +026100 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2114.2 +026200 05 FILLER PIC X(53) VALUE IX2114.2 +026300 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2114.2 +026400 05 FILLER PIC X(53) VALUE IX2114.2 +026500 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2114.2 +026600 05 FILLER PIC X(53) VALUE IX2114.2 +026700 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2114.2 +026800 05 FILLER PIC X(53) VALUE IX2114.2 +026900 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2114.2 +027000 05 FILLER PIC X(53) VALUE IX2114.2 +027100 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2114.2 +027200 05 FILLER PIC X(53) VALUE IX2114.2 +027300 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2114.2 +027400 05 FILLER PIC X(53) VALUE IX2114.2 +027500 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2114.2 +027600 05 FILLER PIC X(53) VALUE IX2114.2 +027700 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2114.2 +027800 05 FILLER PIC X(53) VALUE IX2114.2 +027900 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2114.2 +028000 05 FILLER PIC X(53) VALUE IX2114.2 +028100 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2114.2 +028200 05 FILLER PIC X(53) VALUE IX2114.2 +028300 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2114.2 +028400 05 FILLER PIC X(53) VALUE IX2114.2 +028500 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2114.2 +028600 05 FILLER PIC X(53) VALUE IX2114.2 +028700 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2114.2 +028800 05 FILLER PIC X(53) VALUE IX2114.2 +028900 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2114.2 +029000 05 FILLER PIC X(53) VALUE IX2114.2 +029100 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2114.2 +029200 05 FILLER PIC X(53) VALUE IX2114.2 +029300 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2114.2 +029400 05 FILLER PIC X(53) VALUE IX2114.2 +029500 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2114.2 +029600 05 FILLER PIC X(53) VALUE IX2114.2 +029700 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2114.2 +029800 05 FILLER PIC X(53) VALUE IX2114.2 +029900 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2114.2 +030000 05 FILLER PIC X(53) VALUE IX2114.2 +030100 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2114.2 +030200 05 FILLER PIC X(53) VALUE IX2114.2 +030300 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2114.2 +030400 05 FILLER PIC X(53) VALUE IX2114.2 +030500 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2114.2 +030600 05 FILLER PIC X(53) VALUE IX2114.2 +030700 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2114.2 +030800 05 FILLER PIC X(53) VALUE IX2114.2 +030900 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2114.2 +031000 05 FILLER PIC X(53) VALUE IX2114.2 +031100 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2114.2 +031200 05 FILLER PIC X(53) VALUE IX2114.2 +031300 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2114.2 +031400 05 FILLER PIC X(53) VALUE IX2114.2 +031500 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2114.2 +031600 05 FILLER PIC X(53) VALUE IX2114.2 +031700 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2114.2 +031800 05 FILLER PIC X(53) VALUE IX2114.2 +031900 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2114.2 +032000 05 FILLER PIC X(53) VALUE IX2114.2 +032100 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2114.2 +032200 05 FILLER PIC X(53) VALUE IX2114.2 +032300 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2114.2 +032400 05 FILLER PIC X(53) VALUE IX2114.2 +032500 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2114.2 +032600 05 FILLER PIC X(53) VALUE IX2114.2 +032700 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2114.2 +032800 05 FILLER PIC X(53) VALUE IX2114.2 +032900 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2114.2 +033000 05 FILLER PIC X(53) VALUE IX2114.2 +033100 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2114.2 +033200 05 FILLER PIC X(53) VALUE IX2114.2 +033300 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2114.2 +033400 05 FILLER PIC X(53) VALUE IX2114.2 +033500 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2114.2 +033600 05 FILLER PIC X(53) VALUE IX2114.2 +033700 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2114.2 +033800 05 FILLER PIC X(53) VALUE IX2114.2 +033900 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2114.2 +034000 05 FILLER PIC X(53) VALUE IX2114.2 +034100 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2114.2 +034200 05 FILLER PIC X(53) VALUE IX2114.2 +034300 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2114.2 +034400 05 FILLER PIC X(53) VALUE IX2114.2 +034500 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2114.2 +034600 05 FILLER PIC X(53) VALUE IX2114.2 +034700 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2114.2 +034800 05 FILLER PIC X(53) VALUE IX2114.2 +034900 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2114.2 +035000 05 FILLER PIC X(53) VALUE IX2114.2 +035100 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2114.2 +035200 05 FILLER PIC X(53) VALUE IX2114.2 +035300 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2114.2 +035400 05 FILLER PIC X(53) VALUE IX2114.2 +035500 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2114.2 +035600 05 FILLER PIC X(53) VALUE IX2114.2 +035700 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2114.2 +035800 05 FILLER PIC X(53) VALUE IX2114.2 +035900 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2114.2 +036000 05 FILLER PIC X(53) VALUE IX2114.2 +036100 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2114.2 +036200 05 FILLER PIC X(53) VALUE IX2114.2 +036300 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2114.2 +036400 05 FILLER PIC X(53) VALUE IX2114.2 +036500 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2114.2 +036600 05 FILLER PIC X(53) VALUE IX2114.2 +036700 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2114.2 +036800 05 FILLER PIC X(53) VALUE IX2114.2 +036900 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2114.2 +037000 05 FILLER PIC X(53) VALUE IX2114.2 +037100 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2114.2 +037200 05 FILLER PIC X(53) VALUE IX2114.2 +037300 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2114.2 +037400 05 FILLER PIC X(53) VALUE IX2114.2 +037500 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2114.2 +037600 05 FILLER PIC X(53) VALUE IX2114.2 +037700 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2114.2 +037800 05 FILLER PIC X(53) VALUE IX2114.2 +037900 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2114.2 +038000 05 FILLER PIC X(53) VALUE IX2114.2 +038100 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2114.2 +038200 05 FILLER PIC X(53) VALUE IX2114.2 +038300 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2114.2 +038400 05 FILLER PIC X(53) VALUE IX2114.2 +038500 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2114.2 +038600 05 FILLER PIC X(53) VALUE IX2114.2 +038700 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2114.2 +038800 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2114.2 +038900 05 KEY-VALUES OCCURS 75 TIMES. IX2114.2 +039000 10 RECKEY-VALUE PICTURE X(13). IX2114.2 +039100 10 ALTKEY1-VALUE PICTURE X(20). IX2114.2 +039200 10 ALTKEY2-VALUE PICTURE X(20). IX2114.2 +039300 01 INIT-FLAG PICTURE 9. IX2114.2 +039400 01 HOLD-FILESTATUS-RECORD. IX2114.2 +039500 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX2114.2 +039600 01 FILE-RECORD-INFORMATION-REC. IX2114.2 +039700 03 FILE-RECORD-INFO-SKELETON. IX2114.2 +039800 05 FILLER PICTURE X(48) VALUE IX2114.2 +039900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2114.2 +040000 05 FILLER PICTURE X(46) VALUE IX2114.2 +040100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2114.2 +040200 05 FILLER PICTURE X(26) VALUE IX2114.2 +040300 ",LFIL=000000,ORG= ,LBLR= ". IX2114.2 +040400 05 FILLER PICTURE X(37) VALUE IX2114.2 +040500 ",RECKEY= ". IX2114.2 +040600 05 FILLER PICTURE X(38) VALUE IX2114.2 +040700 ",ALTKEY1= ". IX2114.2 +040800 05 FILLER PICTURE X(38) VALUE IX2114.2 +040900 ",ALTKEY2= ". IX2114.2 +041000 05 FILLER PICTURE X(7) VALUE SPACE.IX2114.2 +041100 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2114.2 +041200 05 FILE-RECORD-INFO-P1-120. IX2114.2 +041300 07 FILLER PIC X(5). IX2114.2 +041400 07 XFILE-NAME PIC X(6). IX2114.2 +041500 07 FILLER PIC X(8). IX2114.2 +041600 07 XRECORD-NAME PIC X(6). IX2114.2 +041700 07 FILLER PIC X(1). IX2114.2 +041800 07 REELUNIT-NUMBER PIC 9(1). IX2114.2 +041900 07 FILLER PIC X(7). IX2114.2 +042000 07 XRECORD-NUMBER PIC 9(6). IX2114.2 +042100 07 FILLER PIC X(6). IX2114.2 +042200 07 UPDATE-NUMBER PIC 9(2). IX2114.2 +042300 07 FILLER PIC X(5). IX2114.2 +042400 07 ODO-NUMBER PIC 9(4). IX2114.2 +042500 07 FILLER PIC X(5). IX2114.2 +042600 07 XPROGRAM-NAME PIC X(5). IX2114.2 +042700 07 FILLER PIC X(7). IX2114.2 +042800 07 XRECORD-LENGTH PIC 9(6). IX2114.2 +042900 07 FILLER PIC X(7). IX2114.2 +043000 07 CHARS-OR-RECORDS PIC X(2). IX2114.2 +043100 07 FILLER PIC X(1). IX2114.2 +043200 07 XBLOCK-SIZE PIC 9(4). IX2114.2 +043300 07 FILLER PIC X(6). IX2114.2 +043400 07 RECORDS-IN-FILE PIC 9(6). IX2114.2 +043500 07 FILLER PIC X(5). IX2114.2 +043600 07 XFILE-ORGANIZATION PIC X(2). IX2114.2 +043700 07 FILLER PIC X(6). IX2114.2 +043800 07 XLABEL-TYPE PIC X(1). IX2114.2 +043900 05 FILE-RECORD-INFO-P121-240. IX2114.2 +044000 07 FILLER PIC X(8). IX2114.2 +044100 07 XRECORD-KEY PIC X(29). IX2114.2 +044200 07 FILLER PIC X(9). IX2114.2 +044300 07 ALTERNATE-KEY1 PIC X(29). IX2114.2 +044400 07 FILLER PIC X(9). IX2114.2 +044500 07 ALTERNATE-KEY2 PIC X(29). IX2114.2 +044600 07 FILLER PIC X(7). IX2114.2 +044700 01 TEST-RESULTS. IX2114.2 +044800 02 FILLER PIC X VALUE SPACE. IX2114.2 +044900 02 FEATURE PIC X(20) VALUE SPACE. IX2114.2 +045000 02 FILLER PIC X VALUE SPACE. IX2114.2 +045100 02 P-OR-F PIC X(5) VALUE SPACE. IX2114.2 +045200 02 FILLER PIC X VALUE SPACE. IX2114.2 +045300 02 PAR-NAME. IX2114.2 +045400 03 FILLER PIC X(19) VALUE SPACE. IX2114.2 +045500 03 PARDOT-X PIC X VALUE SPACE. IX2114.2 +045600 03 DOTVALUE PIC 99 VALUE ZERO. IX2114.2 +045700 02 FILLER PIC X(8) VALUE SPACE. IX2114.2 +045800 02 RE-MARK PIC X(61). IX2114.2 +045900 01 TEST-COMPUTED. IX2114.2 +046000 02 FILLER PIC X(30) VALUE SPACE. IX2114.2 +046100 02 FILLER PIC X(17) VALUE IX2114.2 +046200 " COMPUTED=". IX2114.2 +046300 02 COMPUTED-X. IX2114.2 +046400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2114.2 +046500 03 COMPUTED-N REDEFINES COMPUTED-A IX2114.2 +046600 PIC -9(9).9(9). IX2114.2 +046700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2114.2 +046800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2114.2 +046900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2114.2 +047000 03 CM-18V0 REDEFINES COMPUTED-A. IX2114.2 +047100 04 COMPUTED-18V0 PIC -9(18). IX2114.2 +047200 04 FILLER PIC X. IX2114.2 +047300 03 FILLER PIC X(50) VALUE SPACE. IX2114.2 +047400 01 TEST-CORRECT. IX2114.2 +047500 02 FILLER PIC X(30) VALUE SPACE. IX2114.2 +047600 02 FILLER PIC X(17) VALUE " CORRECT =". IX2114.2 +047700 02 CORRECT-X. IX2114.2 +047800 03 CORRECT-A PIC X(20) VALUE SPACE. IX2114.2 +047900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2114.2 +048000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2114.2 +048100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2114.2 +048200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2114.2 +048300 03 CR-18V0 REDEFINES CORRECT-A. IX2114.2 +048400 04 CORRECT-18V0 PIC -9(18). IX2114.2 +048500 04 FILLER PIC X. IX2114.2 +048600 03 FILLER PIC X(2) VALUE SPACE. IX2114.2 +048700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2114.2 +048800 01 CCVS-C-1. IX2114.2 +048900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2114.2 +049000- "SS PARAGRAPH-NAME IX2114.2 +049100- " REMARKS". IX2114.2 +049200 02 FILLER PIC X(20) VALUE SPACE. IX2114.2 +049300 01 CCVS-C-2. IX2114.2 +049400 02 FILLER PIC X VALUE SPACE. IX2114.2 +049500 02 FILLER PIC X(6) VALUE "TESTED". IX2114.2 +049600 02 FILLER PIC X(15) VALUE SPACE. IX2114.2 +049700 02 FILLER PIC X(4) VALUE "FAIL". IX2114.2 +049800 02 FILLER PIC X(94) VALUE SPACE. IX2114.2 +049900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2114.2 +050000 01 REC-CT PIC 99 VALUE ZERO. IX2114.2 +050100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2114.2 +050200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2114.2 +050300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2114.2 +050400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2114.2 +050500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2114.2 +050600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2114.2 +050700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2114.2 +050800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2114.2 +050900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2114.2 +051000 01 CCVS-H-1. IX2114.2 +051100 02 FILLER PIC X(39) VALUE SPACES. IX2114.2 +051200 02 FILLER PIC X(42) VALUE IX2114.2 +051300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2114.2 +051400 02 FILLER PIC X(39) VALUE SPACES. IX2114.2 +051500 01 CCVS-H-2A. IX2114.2 +051600 02 FILLER PIC X(40) VALUE SPACE. IX2114.2 +051700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2114.2 +051800 02 FILLER PIC XXXX VALUE IX2114.2 +051900 "4.2 ". IX2114.2 +052000 02 FILLER PIC X(28) VALUE IX2114.2 +052100 " COPY - NOT FOR DISTRIBUTION". IX2114.2 +052200 02 FILLER PIC X(41) VALUE SPACE. IX2114.2 +052300 IX2114.2 +052400 01 CCVS-H-2B. IX2114.2 +052500 02 FILLER PIC X(15) VALUE IX2114.2 +052600 "TEST RESULT OF ". IX2114.2 +052700 02 TEST-ID PIC X(9). IX2114.2 +052800 02 FILLER PIC X(4) VALUE IX2114.2 +052900 " IN ". IX2114.2 +053000 02 FILLER PIC X(12) VALUE IX2114.2 +053100 " HIGH ". IX2114.2 +053200 02 FILLER PIC X(22) VALUE IX2114.2 +053300 " LEVEL VALIDATION FOR ". IX2114.2 +053400 02 FILLER PIC X(58) VALUE IX2114.2 +053500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2114.2 +053600 01 CCVS-H-3. IX2114.2 +053700 02 FILLER PIC X(34) VALUE IX2114.2 +053800 " FOR OFFICIAL USE ONLY ". IX2114.2 +053900 02 FILLER PIC X(58) VALUE IX2114.2 +054000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2114.2 +054100 02 FILLER PIC X(28) VALUE IX2114.2 +054200 " COPYRIGHT 1985 ". IX2114.2 +054300 01 CCVS-E-1. IX2114.2 +054400 02 FILLER PIC X(52) VALUE SPACE. IX2114.2 +054500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2114.2 +054600 02 ID-AGAIN PIC X(9). IX2114.2 +054700 02 FILLER PIC X(45) VALUE SPACES. IX2114.2 +054800 01 CCVS-E-2. IX2114.2 +054900 02 FILLER PIC X(31) VALUE SPACE. IX2114.2 +055000 02 FILLER PIC X(21) VALUE SPACE. IX2114.2 +055100 02 CCVS-E-2-2. IX2114.2 +055200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2114.2 +055300 03 FILLER PIC X VALUE SPACE. IX2114.2 +055400 03 ENDER-DESC PIC X(44) VALUE IX2114.2 +055500 "ERRORS ENCOUNTERED". IX2114.2 +055600 01 CCVS-E-3. IX2114.2 +055700 02 FILLER PIC X(22) VALUE IX2114.2 +055800 " FOR OFFICIAL USE ONLY". IX2114.2 +055900 02 FILLER PIC X(12) VALUE SPACE. IX2114.2 +056000 02 FILLER PIC X(58) VALUE IX2114.2 +056100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2114.2 +056200 02 FILLER PIC X(13) VALUE SPACE. IX2114.2 +056300 02 FILLER PIC X(15) VALUE IX2114.2 +056400 " COPYRIGHT 1985". IX2114.2 +056500 01 CCVS-E-4. IX2114.2 +056600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2114.2 +056700 02 FILLER PIC X(4) VALUE " OF ". IX2114.2 +056800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2114.2 +056900 02 FILLER PIC X(40) VALUE IX2114.2 +057000 " TESTS WERE EXECUTED SUCCESSFULLY". IX2114.2 +057100 01 XXINFO. IX2114.2 +057200 02 FILLER PIC X(19) VALUE IX2114.2 +057300 "*** INFORMATION ***". IX2114.2 +057400 02 INFO-TEXT. IX2114.2 +057500 04 FILLER PIC X(8) VALUE SPACE. IX2114.2 +057600 04 XXCOMPUTED PIC X(20). IX2114.2 +057700 04 FILLER PIC X(5) VALUE SPACE. IX2114.2 +057800 04 XXCORRECT PIC X(20). IX2114.2 +057900 02 INF-ANSI-REFERENCE PIC X(48). IX2114.2 +058000 01 HYPHEN-LINE. IX2114.2 +058100 02 FILLER PIC IS X VALUE IS SPACE. IX2114.2 +058200 02 FILLER PIC IS X(65) VALUE IS "************************IX2114.2 +058300- "*****************************************". IX2114.2 +058400 02 FILLER PIC IS X(54) VALUE IS "************************IX2114.2 +058500- "******************************". IX2114.2 +058600 01 CCVS-PGM-ID PIC X(9) VALUE IX2114.2 +058700 "IX211A". IX2114.2 +058800 PROCEDURE DIVISION. IX2114.2 +058900 CCVS1 SECTION. IX2114.2 +059000 OPEN-FILES. IX2114.2 +059100*P OPEN I-O RAW-DATA. IX2114.2 +059200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2114.2 +059300*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2114.2 +059400*P MOVE "ABORTED " TO C-ABORT. IX2114.2 +059500*P ADD 1 TO C-NO-OF-TESTS. IX2114.2 +059600*P ACCEPT C-DATE FROM DATE. IX2114.2 +059700*P ACCEPT C-TIME FROM TIME. IX2114.2 +059800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2114.2 +059900*PND-E-1. IX2114.2 +060000*P CLOSE RAW-DATA. IX2114.2 +060100 OPEN OUTPUT PRINT-FILE. IX2114.2 +060200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2114.2 +060300 MOVE SPACE TO TEST-RESULTS. IX2114.2 +060400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2114.2 +060500 MOVE ZERO TO REC-SKL-SUB. IX2114.2 +060600 PERFORM CCVS-INIT-FILE 9 TIMES. IX2114.2 +060700 CCVS-INIT-FILE. IX2114.2 +060800 ADD 1 TO REC-SKL-SUB. IX2114.2 +060900 MOVE FILE-RECORD-INFO-SKELETON IX2114.2 +061000 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2114.2 +061100 CCVS-INIT-EXIT. IX2114.2 +061200 GO TO CCVS1-EXIT. IX2114.2 +061300 CLOSE-FILES. IX2114.2 +061400*P OPEN I-O RAW-DATA. IX2114.2 +061500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2114.2 +061600*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2114.2 +061700*P MOVE "OK. " TO C-ABORT. IX2114.2 +061800*P MOVE PASS-COUNTER TO C-OK. IX2114.2 +061900*P MOVE ERROR-HOLD TO C-ALL. IX2114.2 +062000*P MOVE ERROR-COUNTER TO C-FAIL. IX2114.2 +062100*P MOVE DELETE-COUNTER TO C-DELETED. IX2114.2 +062200*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2114.2 +062300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2114.2 +062400*PND-E-2. IX2114.2 +062500*P CLOSE RAW-DATA. IX2114.2 +062600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2114.2 +062700 TERMINATE-CCVS. IX2114.2 +062800*S EXIT PROGRAM. IX2114.2 +062900*SERMINATE-CALL. IX2114.2 +063000 STOP RUN. IX2114.2 +063100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2114.2 +063200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2114.2 +063300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2114.2 +063400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2114.2 +063500 MOVE "****TEST DELETED****" TO RE-MARK. IX2114.2 +063600 PRINT-DETAIL. IX2114.2 +063700 IF REC-CT NOT EQUAL TO ZERO IX2114.2 +063800 MOVE "." TO PARDOT-X IX2114.2 +063900 MOVE REC-CT TO DOTVALUE. IX2114.2 +064000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2114.2 +064100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2114.2 +064200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2114.2 +064300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2114.2 +064400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2114.2 +064500 MOVE SPACE TO CORRECT-X. IX2114.2 +064600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2114.2 +064700 MOVE SPACE TO RE-MARK. IX2114.2 +064800 HEAD-ROUTINE. IX2114.2 +064900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +065000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +065100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2114.2 +065200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2114.2 +065300 COLUMN-NAMES-ROUTINE. IX2114.2 +065400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +065500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +065600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +065700 END-ROUTINE. IX2114.2 +065800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2114.2 +065900 END-RTN-EXIT. IX2114.2 +066000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +066100 END-ROUTINE-1. IX2114.2 +066200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2114.2 +066300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2114.2 +066400 ADD PASS-COUNTER TO ERROR-HOLD. IX2114.2 +066500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2114.2 +066600 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2114.2 +066700 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2114.2 +066800 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2114.2 +066900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2114.2 +067000 END-ROUTINE-12. IX2114.2 +067100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2114.2 +067200 IF ERROR-COUNTER IS EQUAL TO ZERO IX2114.2 +067300 MOVE "NO " TO ERROR-TOTAL IX2114.2 +067400 ELSE IX2114.2 +067500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2114.2 +067600 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2114.2 +067700 PERFORM WRITE-LINE. IX2114.2 +067800 END-ROUTINE-13. IX2114.2 +067900 IF DELETE-COUNTER IS EQUAL TO ZERO IX2114.2 +068000 MOVE "NO " TO ERROR-TOTAL ELSE IX2114.2 +068100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2114.2 +068200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2114.2 +068300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +068400 IF INSPECT-COUNTER EQUAL TO ZERO IX2114.2 +068500 MOVE "NO " TO ERROR-TOTAL IX2114.2 +068600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2114.2 +068700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2114.2 +068800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +068900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2114.2 +069000 WRITE-LINE. IX2114.2 +069100 ADD 1 TO RECORD-COUNT. IX2114.2 +069200 IF RECORD-COUNT GREATER 42 IX2114.2 +069300 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2114.2 +069400 MOVE SPACE TO DUMMY-RECORD IX2114.2 +069500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2114.2 +069600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2114.2 +069700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2114.2 +069800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2114.2 +069900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2114.2 +070000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2114.2 +070100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2114.2 +070200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2114.2 +070300 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2114.2 +070400 MOVE ZERO TO RECORD-COUNT. IX2114.2 +070500 PERFORM WRT-LN. IX2114.2 +070600 WRT-LN. IX2114.2 +070700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2114.2 +070800 MOVE SPACE TO DUMMY-RECORD. IX2114.2 +070900 BLANK-LINE-PRINT. IX2114.2 +071000 PERFORM WRT-LN. IX2114.2 +071100 FAIL-ROUTINE. IX2114.2 +071200 IF COMPUTED-X NOT EQUAL TO SPACE IX2114.2 +071300 GO TO FAIL-ROUTINE-WRITE. IX2114.2 +071400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2114.2 +071500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2114.2 +071600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2114.2 +071700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +071800 MOVE SPACES TO INF-ANSI-REFERENCE. IX2114.2 +071900 GO TO FAIL-ROUTINE-EX. IX2114.2 +072000 FAIL-ROUTINE-WRITE. IX2114.2 +072100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2114.2 +072200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2114.2 +072300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2114.2 +072400 MOVE SPACES TO COR-ANSI-REFERENCE. IX2114.2 +072500 FAIL-ROUTINE-EX. EXIT. IX2114.2 +072600 BAIL-OUT. IX2114.2 +072700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2114.2 +072800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2114.2 +072900 BAIL-OUT-WRITE. IX2114.2 +073000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2114.2 +073100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2114.2 +073200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2114.2 +073300 MOVE SPACES TO INF-ANSI-REFERENCE. IX2114.2 +073400 BAIL-OUT-EX. EXIT. IX2114.2 +073500 CCVS1-EXIT. IX2114.2 +073600 EXIT. IX2114.2 +073700 SECT-0001-IX211A SECTION. IX2114.2 +073800 WRITE-INT-GF-01. IX2114.2 +073900 OPEN OUTPUT IX-FD1. IX2114.2 +074000 MOVE "IX-FD1" TO XFILE-NAME (1). IX2114.2 +074100 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2114.2 +074200 MOVE ZERO TO XRECORD-NUMBER (1). IX2114.2 +074300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2114.2 +074400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2114.2 +074500 MOVE 240 TO XRECORD-LENGTH (1). IX2114.2 +074600 MOVE 001 TO XBLOCK-SIZE (1). IX2114.2 +074700 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2114.2 +074800 MOVE "S" TO XLABEL-TYPE (1). IX2114.2 +074900 MOVE 200 TO RECORDS-IN-FILE (1). IX2114.2 +075000 MOVE "CREATE-FILE-FD1" TO FEATURE. IX2114.2 +075100 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2114.2 +075200 MOVE ZERO TO KEYSUB. IX2114.2 +075300 MOVE ZERO TO INVKEY-COUNTER. IX2114.2 +075400 WRITE-INIT-GF-01-01. IX2114.2 +075500 PERFORM WRITE-TEST-GF-01-1 50 TIMES. IX2114.2 +075600 PERFORM WRITE-TEST-GF-01-2 125 TIMES. IX2114.2 +075700 PERFORM WRITE-TEST-GF-01-1 25 TIMES. IX2114.2 +075800 GO TO WRITE-TEST-GF-01. IX2114.2 +075900 WRITE-TEST-GF-01-1. IX2114.2 +076000 ADD 001 TO XRECORD-NUMBER (1). IX2114.2 +076100 ADD 001 TO KEYSUB. IX2114.2 +076200 MOVE RECKEY-VALUE (KEYSUB) TO FD1-RECKEY-1-13. IX2114.2 +076300 MOVE ALTKEY1-VALUE (KEYSUB) TO FD1-ALTKEY1-1-20. IX2114.2 +076400 MOVE ALTKEY2-VALUE (KEYSUB) TO FD1-ALTKEY2-1-20. IX2114.2 +076500 MOVE WRK-FD1-RECKEY TO XRECORD-KEY (1). IX2114.2 +076600 MOVE WRK-FD1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2114.2 +076700 MOVE WRK-FD1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2114.2 +076800 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2114.2 +076900 WRITE IX-FD1R1-F-G-240 IX2114.2 +077000 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2114.2 +077100 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +077200 WRITE-TEST-GF-01-2. IX2114.2 +077300 ADD 002 TO FD1-RECKEY-11-13. IX2114.2 +077400 ADD 002 TO FD1-ALTKEY1-11-13. IX2114.2 +077500 SUBTRACT 002 FROM FD1-ALTKEY2-11-13. IX2114.2 +077600 ADD 001 TO XRECORD-NUMBER (1). IX2114.2 +077700 MOVE WRK-FD1-RECKEY TO XRECORD-KEY (1). IX2114.2 +077800 MOVE WRK-FD1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2114.2 +077900 MOVE WRK-FD1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2114.2 +078000 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2114.2 +078100 WRITE IX-FD1R1-F-G-240 IX2114.2 +078200 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2114.2 +078300 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +078400 WRITE-TEST-GF-01. IX2114.2 +078500 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2114.2 +078600 GIVING RECORDS-WRITTEN. IX2114.2 +078700 MOVE 200 TO CORRECT-18V0. IX2114.2 +078800 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2114.2 +078900 IF RECORDS-WRITTEN EQUAL TO 200 IX2114.2 +079000 PERFORM PASS IX2114.2 +079100 ELSE IX2114.2 +079200 PERFORM FAIL. IX2114.2 +079300 MOVE "RECORDS IN FILE" TO RE-MARK. IX2114.2 +079400 GO TO WRITE-TEST-GF-01-END. IX2114.2 +079500 WRITE-DELETE-GF-01. IX2114.2 +079600 PERFORM DE-LETE. IX2114.2 +079700 WRITE-TEST-GF-01-END. IX2114.2 +079800 PERFORM PRINT-DETAIL. IX2114.2 +079900 CLOSE IX-FD1. IX2114.2 +080000 READ-INIT-F1-01. IX2114.2 +080100 OPEN INPUT IX-FD1. IX2114.2 +080200 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2114.2 +080300 MOVE "READ FILE IX-FD1" TO FEATURE. IX2114.2 +080400 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2114.2 +080500 MOVE 02 TO RECKEY-NUM. IX2114.2 +080600 MOVE 002 TO ALTKEY1-NUM. IX2114.2 +080700 READ-TEST-F1-01-1. IX2114.2 +080800 READ IX-FD1 NEXT IX2114.2 +080900 AT END GO TO READ-TEST-F1-01. IX2114.2 +081000 MOVE IX-REC-KEY-AREA TO WRK-FD1-RECKEY. IX2114.2 +081100 MOVE IX-ALT-KEY1-AREA TO WRK-FD1-ALTKEY1. IX2114.2 +081200 IF FD1-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2114.2 +081300 AND FD1-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2114.2 +081400 NEXT SENTENCE IX2114.2 +081500 ELSE IX2114.2 +081600 PERFORM READ-FAIL-F1-01. IX2114.2 +081700 IF EXCUT-COUNTER-06V00 GREATER THAN 200 IX2114.2 +081800 GO TO READ-TEST-F1-01. IX2114.2 +081900 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +082000 ADD 002 TO RECKEY-NUM IX2114.2 +082100 ADD 002 TO ALTKEY1-NUM. IX2114.2 +082200 GO TO READ-TEST-F1-01-1. IX2114.2 +082300 READ-TEST-F1-01. IX2114.2 +082400 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2114.2 +082500 PERFORM PASS ELSE IX2114.2 +082600 PERFORM FAIL. IX2114.2 +082700 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2114.2 +082800 MOVE 200 TO CORRECT-18V0. IX2114.2 +082900 MOVE "RECORDS IN FILE" TO RE-MARK. IX2114.2 +083000 GO TO READ-EXIT-F1-01. IX2114.2 +083100 READ-FAIL-F1-01. IX2114.2 +083200 PERFORM FAIL. IX2114.2 +083300 MOVE FD1-RECKEY-11-13 TO COMPUTED-18V0. IX2114.2 +083400 MOVE RECKEY-NUM TO CORRECT-18V0. IX2114.2 +083500 MOVE "NUM EMBEDDED IN RECKEY; IX-28 READ; IX-41 WRITE" IX2114.2 +083600 TO RE-MARK. IX2114.2 +083700 READ-EXIT-F1-01. IX2114.2 +083800 PERFORM PRINT-DETAIL. IX2114.2 +083900 CLOSE IX-FD1. IX2114.2 +084000 READ-INIT-F1-02. IX2114.2 +084100 OPEN I-O IX-FD1. IX2114.2 +084200 MOVE "START & READ NEXT " TO FEATURE. IX2114.2 +084300 MOVE "READ-TEST-F1-02 " TO PAR-NAME. IX2114.2 +084400 MOVE "SSSSSSSSTT364" TO FD1-RECKEY-1-13. IX2114.2 +084500 MOVE "WWWWWWWWXX364ALTKEY1" TO FD1-ALTKEY1-1-20. IX2114.2 +084600 MOVE "FFFFFFFFEE036ALTKEY2" TO FD1-ALTKEY2-1-20. IX2114.2 +084700 MOVE WRK-FD1-RECKEY TO IX-REC-KEY-AREA. IX2114.2 +084800 MOVE WRK-FD1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2114.2 +084900 MOVE WRK-FD1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2114.2 +085000 READ-TEST-F1-02. IX2114.2 +085100* IX2114.2 +085200* READ-TEST-F1-02 - THIS TEST READS A RECORD AND CHECKS THE IX2114.2 +085300* RECORD MADE AVAILABLE. THE PURPOSE IS TO IX2114.2 +085400* ESTABLISH IX-FD1-ALTKEY1 AS THE KEY OF REF- IX2114.2 +085500* ERENCE AND TO MAKE A RECORD AVAILABLE IX2114.2 +085600* FOR TESTING THE REWRITE STATEMENT IN THE IX2114.2 +085700* NEXT TEST. RECORD 182 (ALTERNATE KEY IX2114.2 +085800* "WWWWWWWWXX364ALTKEY1") IS EXPECTED TO BE IX2114.2 +085900* RETRIEVED. IX2114.2 +086000* IX2114.2 +086100 START IX-FD1 IX2114.2 +086200 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2114.2 +086300 INVALID KEY MOVE "INVALID KEY ON START" TO COMPUTED-A IX2114.2 +086400 GO TO READ-FAIL-F1-02. IX2114.2 +086500 READ IX-FD1 NEXT AT END IX2114.2 +086600 MOVE "AT END ON READ" TO COMPUTED-A IX2114.2 +086700 GO TO READ-FAIL-F1-02. IX2114.2 +086800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2114.2 +086900 IF XRECORD-NUMBER (1) EQUAL TO 182 IX2114.2 +087000 PERFORM PASS IX2114.2 +087100 GO TO READ-WRITE-F1-02. IX2114.2 +087200 READ-FAIL-F1-02. IX2114.2 +087300 PERFORM FAIL. IX2114.2 +087400 MOVE "RECORD 182 RETRIEVED" TO CORRECT-A. IX2114.2 +087500 MOVE "SEQUENTIAL READ; IX-28 4.5.2" TO RE-MARK. IX2114.2 +087600 READ-WRITE-F1-02. IX2114.2 +087700 PERFORM PRINT-DETAIL. IX2114.2 +087800 RWRT-TEST-GF-01. IX2114.2 +087900 MOVE "REWRITE " TO FEATURE. IX2114.2 +088000 MOVE "RWRT-TEST-GF-01 " TO PAR-NAME. IX2114.2 +088100* IX2114.2 +088200* RWRT-TEST-GF-01 - THE TEST MODIFIES THE CONTENTS OF ALTERNATE- IX2114.2 +088300* KEY1 OF THE RECORD RETRIEVED BY THE TEST IX2114.2 +088400* BEFORE AND REWRITES THE RECORD.THE NEW ALTER-IX2114.2 +088500* NATE KEY VALUE IS "WWWWWWXXXX369ALTKEY1" IX2114.2 +088600* WHICH BECOMES SEQUENTIAL RECORD NUMBER 184. IX2114.2 +088700* THE NEW KEY FOR THE FILE HAS A KEY VALUE IX2114.2 +088800* SEQUENTIALLY GREATER THAN THE RECORD VALUE IX2114.2 +088900* RETRIEVED FROM RECORD. THE SEQUENTIAL RECORD IX2114.2 +089000* RETRIEVED BEFORE THE REWRITE WAS NUMBER IX2114.2 +089100* 182. THE CURRENT RECORD POINTER FOR THE FILEIX2114.2 +089200* IS NOT EXPECTED TO BE MODIFIED BY IX2114.2 +089300* EXECUTION OF THE REWRITE. IX2114.2 +089400* IX2114.2 +089500 MOVE 182 TO ODO-NUMBER (1). IX2114.2 +089600 ADD 01 TO UPDATE-NUMBER (1). IX2114.2 +089700 MOVE "WWWWWWXXXX369ALTKEY1" TO FD1-ALTKEY1-1-20. IX2114.2 +089800 MOVE WRK-FD1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2114.2 +089900 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2114.2 +090000 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2114.2 +090100 MOVE "INVALID KEY REWRITE" TO COMPUTED-A IX2114.2 +090200 GO TO RWRT-FAIL-GF-01. IX2114.2 +090300 PERFORM PASS. IX2114.2 +090400 GO TO RWRT-WRITE-GF-01. IX2114.2 +090500 RWRT-FAIL-GF-01. IX2114.2 +090600 PERFORM FAIL. IX2114.2 +090700 MOVE "IX-33 4.6.2 " TO RE-MARK. IX2114.2 +090800 RWRT-WRITE-GF-01. IX2114.2 +090900 PERFORM PRINT-DETAIL. IX2114.2 +091000 READ-INIT-F1-03. IX2114.2 +091100 MOVE "READ NEXT AT END " TO FEATURE. IX2114.2 +091200 MOVE "READ-TEST-F1-03 " TO PAR-NAME. IX2114.2 +091300 READ-TEST-F1-03. IX2114.2 +091400* IX2114.2 +091500* READ-TEST-F1-03 - THIS TEST PERFORMS A SEQUENTIAL READ AND IX2114.2 +091600* CHECKS THE RECORD MADE AVAILABLE. THE KEY OFIX2114.2 +091700* REFERENCE IS EXPECTED TO BE THAT ESTABLISHED IX2114.2 +091800* BEFORE. THE LOGICAL RECORD IX2114.2 +091900* RETRIEVED IS EXPECTED TO BE THAT RECORD THAT IX2114.2 +092000* WOULD HAVE BEEN RETRIEVED HAD THE ALTERNATE IX2114.2 +092100* KEY NOT BEEN CHANGE BY THE REWRITE IN IX2114.2 +092200* RWRT-TEST-GF-01. IX2114.2 +092300* IX2114.2 +092400 READ IX-FD1 NEXT AT END IX2114.2 +092500 MOVE "AT END ON READ" TO COMPUTED-A IX2114.2 +092600 GO TO READ-FAIL-F1-03. IX2114.2 +092700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2114.2 +092800 IF XRECORD-NUMBER (1) EQUAL TO 183 IX2114.2 +092900 PERFORM PASS IX2114.2 +093000 GO TO READ-WRITE-F1-03. IX2114.2 +093100 MOVE 58 TO RECNO. IX2114.2 +093200 PERFORM DISPLAY-ALTERNATE-KEY1. IX2114.2 +093300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2114.2 +093400 READ-FAIL-F1-03. IX2114.2 +093500 PERFORM FAIL. IX2114.2 +093600 MOVE 183 TO CORRECT-18V0. IX2114.2 +093700 MOVE "RECORD NUMBER; IX-28" TO RE-MARK. IX2114.2 +093800 READ-WRITE-F1-03. IX2114.2 +093900 PERFORM PRINT-DETAIL. IX2114.2 +094000 READ-INIT-F1-04. IX2114.2 +094100 MOVE "READ NEXT 4 RECS " TO FEATURE. IX2114.2 +094200 MOVE "READ-TEST-F1-04 " TO PAR-NAME. IX2114.2 +094300 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2114.2 +094400 MOVE 183 TO RECKEY-NUM. IX2114.2 +094500 READ-TEST-F1-04. IX2114.2 +094600* IX2114.2 +094700* READ-TEST-F1-04 - THE TEST SEQUENTIALLY READS THE NEXT 4 REC- IX2114.2 +094800* ORDS AND CHECKS THE RECORD NUMBER FIELD OF IX2114.2 +094900* EACH RECORD RETRIEVED. THE CONTENTS OF IX2114.2 +095000* THE RECORD NUMBER FIELD IS EXPECTED TO BE IX2114.2 +095100* 184, 182, 185 AND 186 (ALTERNATE KEY VALUES IX2114.2 +095200* WWWWWWXXXX368ALTKEY1 THROUGH WWWXXXXXXX372 IX2114.2 +095300* ALTKEY1 RESPECTIVELY). THE RECORD IN WHICH IX2114.2 +095400* THE ALTERNATE KEY VALUE WAS CHANGED TO IX2114.2 +095500* WWWWWWXXXX369ALTKEY1 (SEQUENTIAL RECORD 184 IX2114.2 +095600* AFTER THE REORDING OCCURS I.E, AS A RESULT OFIX2114.2 +095700* CHANGING THE ALTERNATE KEY VALUE IN IX2114.2 +095800* RWRT-TEST-GF-01) SHOULD BE MADE AVAILABLE. IX2114.2 +095900* IX2114.2 +096000 READ IX-FD1 NEXT AT END IX2114.2 +096100 MOVE "AT END ON READ" TO COMPUTED-A IX2114.2 +096200 MOVE "SUCCESSFUL READ" TO CORRECT-A IX2114.2 +096300 GO TO READ-FAIL-F1-04. IX2114.2 +096400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2114.2 +096500 IF EXCUT-COUNTER-06V00 EQUAL TO 1 IX2114.2 +096600 MOVE 182 TO RECKEY-NUM ELSE IX2114.2 +096700 ADD 001 TO RECKEY-NUM. IX2114.2 +096800 IF XRECORD-NUMBER (1) NOT EQUAL TO RECKEY-NUM IX2114.2 +096900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2114.2 +097000 MOVE RECKEY-NUM TO CORRECT-18V0 IX2114.2 +097100 GO TO READ-FAIL-F1-04. IX2114.2 +097200 IF EXCUT-COUNTER-06V00 EQUAL TO 1 IX2114.2 +097300 MOVE 184 TO RECKEY-NUM. IX2114.2 +097400 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +097500 IF EXCUT-COUNTER-06V00 NOT LESS THAN 4 IX2114.2 +097600 PERFORM PASS IX2114.2 +097700 GO TO READ-WRITE-F1-04. IX2114.2 +097800 GO TO READ-TEST-F1-04. IX2114.2 +097900 READ-FAIL-F1-04. IX2114.2 +098000 PERFORM FAIL. IX2114.2 +098100 MOVE "IX-28, IX-32" TO RE-MARK. IX2114.2 +098200 READ-WRITE-F1-04. IX2114.2 +098300 PERFORM PRINT-DETAIL. IX2114.2 +098400 CLOSE IX-FD1. IX2114.2 +098500 IX2114.2 +098600 IX2114.2 +098700 READ-INIT-F1-004. IX2114.2 +098800 OPEN INPUT IX-FD1. IX2114.2 +098900 MOVE "READ UPDATED ALTKEY" TO FEATURE. IX2114.2 +099000 MOVE "READ-TEST-F1-004" TO PAR-NAME. IX2114.2 +099100 MOVE "SSSSSSSSSS360" TO FD1-RECKEY-1-13. IX2114.2 +099200 MOVE "WWWWWWWWWW360ALTKEY1" TO FD1-ALTKEY1-1-20. IX2114.2 +099300 MOVE "FFFFFFFFFF040ALTKEY2" TO FD1-ALTKEY2-1-20. IX2114.2 +099400 MOVE WRK-FD1-RECKEY TO IX-REC-KEY-AREA. IX2114.2 +099500 MOVE WRK-FD1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2114.2 +099600 MOVE WRK-FD1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2114.2 +099700 MOVE 180 TO RECKEY-NUM. IX2114.2 +099800 START IX-FD1 IX2114.2 +099900 KEY IS EQUAL TO IX-FD1-ALTKEY1 IX2114.2 +100000 INVALID KEY MOVE "INVALID KEY ON START" TO COMPUTED-A IX2114.2 +100100 GO TO READ-FAIL-004. IX2114.2 +100200 MOVE 179 TO RECKEY-NUM. IX2114.2 +100300 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2114.2 +100400 MOVE 4 TO REC-CT. IX2114.2 +100500 READ-TEST-F1. IX2114.2 +100600 ADD 1 TO REC-CT. IX2114.2 +100700 MOVE "READ UPDATED RECS " TO FEATURE. IX2114.2 +100800 MOVE "READ-TEST-F1- " TO PAR-NAME. IX2114.2 +100900* IX2114.2 +101000*READ-TEST-F1-04 - THIS TEST READS THAT SEGMENT OF THE FILE IX2114.2 +101100* UPDATED IN THE FIRST 4 TESTS AND CHECKS THE NEWIX2114.2 +101200* SEQUENTIAL ORDER OF THE RECORDS. THE SEQUENTIALIX2114.2 +101300* RETRIEVAL OF THE RECORDS FROM THE FILE IS IX2114.2 +101400* EXPECTED TO REFLECT THE UPDATED KEY SEQUENCE. IX2114.2 +101500* THE START STATEMENT IX2114.2 +101600* EXTABLISHES ALTERNATE KEY1 AS THE KEY OF REF- IX2114.2 +101700* ERENCE AND CURRENT RECORD POINTER TO POINT TO IX2114.2 +101800* RELATIVE RECORD NUMBER 180 (ALTERNATE-KEY1 IX2114.2 +101900* VALUE WWWWWWWWWW360ALTKEY1 BEFORE THE FILE IX2114.2 +102000* READING BEGINS. IX2114.2 +102100* IX2114.2 +102200 ADD 001 TO RECKEY-NUM. IX2114.2 +102300 READ IX-FD1 NEXT AT END IX2114.2 +102400 MOVE "AT END ON READ" TO COMPUTED-A IX2114.2 +102500 GO TO READ-FAIL-004. IX2114.2 +102600 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2114.2 +102700 IF RECKEY-NUM EQUAL TO 182 IX2114.2 +102800 MOVE "YES" TO ADJUSTED-NUM IX2114.2 +102900 ADD 001 TO RECKEY-NUM. IX2114.2 +103000* IX2114.2 +103100* THE ABOVE IF STATEMENT ADJUSTS THE RECKEY-NUM TO ACCOUNT IX2114.2 +103200* FOR THE VOID LEFT IN THE NUMBERING SEQUENCE WHEN THE RECORD IX2114.2 +103300* WAS REWRITTEN WITH A NEW ALTERNATE KEY. THE RELATIVE IX2114.2 +103400* RETREIVAL POSITION OF THE RECORD IN THE FILE SHOULD HAVE IX2114.2 +103500* CHANGED FROM 182 TO 184. IX2114.2 +103600* IX2114.2 +103700 IF RECKEY-NUM EQUAL TO 185 IX2114.2 +103800 AND ADJUSTED-NUM EQUAL TO "YES" IX2114.2 +103900 MOVE "NO" TO ADJUSTED-NUM IX2114.2 +104000 SUBTRACT 001 FROM RECKEY-NUM IX2114.2 +104100* IX2114.2 +104200* THE SUBTRACT STATEMENT IS TO READJUST RECKEY-NUM FOR IX2114.2 +104300* INSERTED RECORD CAUSED BY UPDATE OF ALTERNATE KEY IN IX2114.2 +104400* THE RECORD. THE SEQUENTIAL RETRIEVAL POSITION OF UPDATED IX2114.2 +104500* RECORD SHOULD BE POSITION NUMBER 184. IX2114.2 +104600* IX2114.2 +104700 PERFORM READ-TEST-004-1 IX2114.2 +104800 ADD 001 TO EXCUT-COUNTER-06V00 IX2114.2 +104900 GO TO READ-TEST-F1. IX2114.2 +105000 IF XRECORD-NUMBER (1) EQUAL TO RECKEY-NUM IX2114.2 +105100 PERFORM READ-PASS-004 IX2114.2 +105200 ELSE IX2114.2 +105300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2114.2 +105400 PERFORM READ-FAIL-004. IX2114.2 +105500 ADD 001 TO EXCUT-COUNTER-06V00. IX2114.2 +105600 IF EXCUT-COUNTER-06V00 LESS THAN 11 IX2114.2 +105700 GO TO READ-TEST-F1. IX2114.2 +105800 GO TO READ-END-004. IX2114.2 +105900 READ-TEST-004-1. IX2114.2 +106000 IF XRECORD-NUMBER (1) EQUAL TO 182 IX2114.2 +106100 PERFORM READ-PASS-004 IX2114.2 +106200 ELSE IX2114.2 +106300 MOVE "WWWWWWXXXX369ALTKEY1" TO CORRECT-A IX2114.2 +106400 MOVE ALTERNATE-KEY1 (1) TO WRK-FD1-ALTKEY1 IX2114.2 +106500 MOVE FD1-ALTKEY1-1-20 TO COMPUTED-A IX2114.2 +106600 MOVE SPACE TO P-OR-F IX2114.2 +106700 MOVE "ALTERNATE RECORD KEY1 VALUES; IX-33" TO RE-MARKIX2114.2 +106800 PERFORM PRINT-DETAIL IX2114.2 +106900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2114.2 +107000 MOVE 182 TO CORRECT-18V0 IX2114.2 +107100 PERFORM FAIL IX2114.2 +107200 PERFORM PRINT-DETAIL. IX2114.2 +107300 READ-PASS-004. IX2114.2 +107400 PERFORM PASS IX2114.2 +107500 PERFORM PRINT-DETAIL. IX2114.2 +107600 READ-FAIL-004. IX2114.2 +107700 PERFORM FAIL. IX2114.2 +107800 MOVE RECKEY-NUM TO CORRECT-18V0. IX2114.2 +107900 MOVE "RECORD NUMBER; IX-28, IX-33 " TO RE-MARK. IX2114.2 +108000 PERFORM PRINT-DETAIL. IX2114.2 +108100 READ-END-004. IX2114.2 +108200 CLOSE IX-FD1. IX2114.2 +108300 IX2114.2 +108400 GO TO CCVS-EXIT. IX2114.2 +108500 IX2114.2 +108600 IX2114.2 +108700 INX-INITIALIZE-RECORD. IX2114.2 +108800 MOVE "GGGGGGGGGG200" TO FD1-RECKEY-1-13. IX2114.2 +108900 MOVE ZERO TO INIT-FLAG. IX2114.2 +109000 MOVE 9999 TO XRECORD-NUMBER (1). IX2114.2 +109100 MOVE SPACE TO IX-FD1R1-F-G-240. IX2114.2 +109200 MOVE WRK-FD1-RECKEY TO IX-REC-KEY-AREA. IX2114.2 +109300 START IX-FD1 IX2114.2 +109400 KEY IS EQUAL TO IX-FD1-KEY IX2114.2 +109500 INVALID KEY MOVE 1 TO INIT-FLAG. IX2114.2 +109600 READ IX-FD1 NEXT INTO FILE-RECORD-INFO (1) IX2114.2 +109700 AT END MOVE 1 TO INIT-FLAG. IX2114.2 +109800 IF XRECORD-NUMBER (1) NOT EQUAL TO 100 IX2114.2 +109900 MOVE 1 TO INIT-FLAG. IX2114.2 +110000 DISPLAY-RECORD-KEYS. IX2114.2 +110100 MOVE XRECORD-KEY (1) TO WRK-FD1-RECKEY. IX2114.2 +110200 MOVE FD1-RECKEY-1-13 TO COMPUTED-A. IX2114.2 +110300 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2114.2 +110400 MOVE SPACE TO P-OR-F. IX2114.2 +110500 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2114.2 +110600 PERFORM PRINT-DETAIL. IX2114.2 +110700 DISPLAY-ALTERNATE-KEY1. IX2114.2 +110800 MOVE ALTERNATE-KEY1 (1) TO WRK-FD1-ALTKEY1. IX2114.2 +110900 MOVE FD1-ALTKEY1-1-20 TO COMPUTED-A. IX2114.2 +111000 MOVE ALTKEY1-VALUE (RECNO) TO CORRECT-A. IX2114.2 +111100 MOVE SPACE TO P-OR-F. IX2114.2 +111200 MOVE "ALTERNATE RECORD KEY1 VALUES" TO RE-MARK. IX2114.2 +111300 PERFORM PRINT-DETAIL. IX2114.2 +111400 DISPLAY-ALTERNATE-KEY2. IX2114.2 +111500 MOVE ALTERNATE-KEY2 (1) TO WRK-FD1-ALTKEY2. IX2114.2 +111600 MOVE FD1-ALTKEY2-1-20 TO COMPUTED-A. IX2114.2 +111700 MOVE ALTKEY2-VALUE (RECNO) TO CORRECT-A. IX2114.2 +111800 MOVE SPACE TO P-OR-F. IX2114.2 +111900 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2114.2 +112000 PERFORM PRINT-DETAIL. IX2114.2 +112100 IX2114.2 +112200 IX2114.2 +112300 CCVS-EXIT SECTION. IX2114.2 +112400 CCVS-999999. IX2114.2 +112500 GO TO CLOSE-FILES. IX2114.2 diff --git a/tests/cobol85/IX/IX212A.CBL b/tests/cobol85/IX/IX212A.CBL new file mode 100755 index 00000000..9efbf1ca --- /dev/null +++ b/tests/cobol85/IX/IX212A.CBL @@ -0,0 +1,1053 @@ +000100 IDENTIFICATION DIVISION. IX2124.2 +000200 PROGRAM-ID. IX2124.2 +000300 IX212A. IX2124.2 +000400**************************************************************** IX2124.2 +000500* * IX2124.2 +000600* VALIDATION FOR:- * IX2124.2 +000700* * IX2124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2124.2 +000900* * IX2124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2124.2 +001100* * IX2124.2 +001200**************************************************************** IX2124.2 +001300* * IX2124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2124.2 +001500* * IX2124.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2124.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2124.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2124.2 +001900* * IX2124.2 +002000**************************************************************** IX2124.2 +002100* * IX2124.2 +002200* THIS IS IX212A. IX2124.2 +002300* THIS PROGRAM CREATES A 100 RECORD FIXED LENGTH INDEXED IX2124.2 +002400* FILE WHOSE ACCESS IS DYNAMIC AND CONTAINS 10 ALTERNATE IX2124.2 +002500* KEYS. THE INDEXED FILE IS MANIPULATED BY THE ALTERNATE KEYS IX2124.2 +002600* USING THE FOLLOWING VERBS: IX2124.2 +002700* . DELETE IX2124.2 +002800* . READ ... NEXT RECORD IX2124.2 +002900* . READ ... RECORD KEY IX2124.2 +003000* . REWRITE IX2124.2 +003100* . START IX2124.2 +003200* IX2124.2 +003300 ENVIRONMENT DIVISION. IX2124.2 +003400 CONFIGURATION SECTION. IX2124.2 +003500 SOURCE-COMPUTER. IX2124.2 +003600 Linux. IX2124.2 +003700 OBJECT-COMPUTER. IX2124.2 +003800 Linux. IX2124.2 +003900 INPUT-OUTPUT SECTION. IX2124.2 +004000 FILE-CONTROL. IX2124.2 +004100*P SELECT RAW-DATA ASSIGN TO IX2124.2 +004200*P "XXXXX062" IX2124.2 +004300*P ORGANIZATION IS INDEXED IX2124.2 +004400*P ACCESS MODE IS RANDOM IX2124.2 +004500*P RECORD KEY IS RAW-DATA-KEY. IX2124.2 +004600 SELECT PRINT-FILE ASSIGN TO IX2124.2 +004700 "report.log". IX2124.2 +004800 SELECT IX-FS1 IX2124.2 +004900 ASSIGN TO IX2124.2 +005000 "XXXXX024" IX2124.2 +005100*J **** X-CARD UNDEFINED **** IX2124.2 +005200 ACCESS MODE IS DYNAMIC IX2124.2 +005300 RECORD KEY IS IX-FS1-KEY IX2124.2 +005400 ALTERNATE RECORD KEY IS IX-FS1-ALT01 IX2124.2 +005500 ALTERNATE RECORD KEY IS IX-FS1-ALT02 IX2124.2 +005600 ALTERNATE RECORD KEY IS IX-FS1-ALT03 IX2124.2 +005700 ALTERNATE RECORD KEY IS IX-FS1-ALT04 IX2124.2 +005800 ALTERNATE RECORD KEY IS IX-FS1-ALT05 IX2124.2 +005900 ALTERNATE RECORD KEY IS IX-FS1-ALT06 IX2124.2 +006000 ALTERNATE RECORD KEY IS IX-FS1-ALT07 IX2124.2 +006100 ALTERNATE RECORD KEY IS IX-FS1-ALT08 IX2124.2 +006200 ALTERNATE RECORD KEY IS IX-FS1-ALT09 IX2124.2 +006300 ALTERNATE RECORD KEY IS IX-FS1-ALT10 IX2124.2 +006400 ORGANIZATION IS INDEXED. IX2124.2 +006500 DATA DIVISION. IX2124.2 +006600 FILE SECTION. IX2124.2 +006700*P IX2124.2 +006800*PD RAW-DATA. IX2124.2 +006900*P IX2124.2 +007000*P1 RAW-DATA-SATZ. IX2124.2 +007100*P 05 RAW-DATA-KEY PIC X(6). IX2124.2 +007200*P 05 C-DATE PIC 9(6). IX2124.2 +007300*P 05 C-TIME PIC 9(8). IX2124.2 +007400*P 05 C-NO-OF-TESTS PIC 99. IX2124.2 +007500*P 05 C-OK PIC 999. IX2124.2 +007600*P 05 C-ALL PIC 999. IX2124.2 +007700*P 05 C-FAIL PIC 999. IX2124.2 +007800*P 05 C-DELETED PIC 999. IX2124.2 +007900*P 05 C-INSPECT PIC 999. IX2124.2 +008000*P 05 C-NOTE PIC X(13). IX2124.2 +008100*P 05 C-INDENT PIC X. IX2124.2 +008200*P 05 C-ABORT PIC X(8). IX2124.2 +008300 FD PRINT-FILE. IX2124.2 +008400 01 PRINT-REC PICTURE X(120). IX2124.2 +008500 01 DUMMY-RECORD PICTURE X(120). IX2124.2 +008600 FD IX-FS1 IX2124.2 +008700*C LABEL RECORDS ARE STANDARD IX2124.2 +008800*C DATA RECORD IS IX-FS1-RECORD IX2124.2 +008900 RECORD CONTAINS 116 CHARACTERS. IX2124.2 +009000 01 IX-FS1-RECORD. IX2124.2 +009100 02 IX-FS1-KEY PIC X(6). IX2124.2 +009200 02 IX-FS1-ALT01 PIC X(11). IX2124.2 +009300 02 IX-FS1-ALT02 PIC X(11). IX2124.2 +009400 02 IX-FS1-ALT03 PIC X(11). IX2124.2 +009500 02 IX-FS1-ALT04 PIC X(11). IX2124.2 +009600 02 IX-FS1-ALT05 PIC X(11). IX2124.2 +009700 02 IX-FS1-ALT06 PIC X(11). IX2124.2 +009800 02 IX-FS1-ALT07 PIC X(11). IX2124.2 +009900 02 IX-FS1-ALT08 PIC X(11). IX2124.2 +010000 02 IX-FS1-ALT09 PIC X(11). IX2124.2 +010100 02 IX-FS1-ALT10 PIC X(11). IX2124.2 +010200 WORKING-STORAGE SECTION. IX2124.2 +010300 01 RECORD-COUNTER PIC 999 VALUE ZEROS. IX2124.2 +010400 01 INVKEY-COUNTER PIC 999 VALUE ZEROS. IX2124.2 +010500 01 WORK-RECORD. IX2124.2 +010600 02 FILLER PIC XXX VALUE "AAA". IX2124.2 +010700 02 COUNTER00 PIC 999. IX2124.2 +010800 02 FILLER PIC XXX VALUE "CCC". IX2124.2 +010900 02 COUNTER01 PIC 999. IX2124.2 +011000 02 FILLER PIC X(5) VALUE "ALT01". IX2124.2 +011100 02 FILLER PIC XXX VALUE "EEE". IX2124.2 +011200 02 COUNTER02 PIC 999. IX2124.2 +011300 02 FILLER PIC X(5) VALUE "ALT02". IX2124.2 +011400 02 FILLER PIC XXX VALUE "GGG". IX2124.2 +011500 02 COUNTER03 PIC 999. IX2124.2 +011600 02 FILLER PIC X(5) VALUE "ALT03". IX2124.2 +011700 02 FILLER PIC XXX VALUE "III". IX2124.2 +011800 02 COUNTER04 PIC 999. IX2124.2 +011900 02 FILLER PIC X(5) VALUE "ALT04". IX2124.2 +012000 02 FILLER PIC XXX VALUE "KKK". IX2124.2 +012100 02 COUNTER05 PIC 999. IX2124.2 +012200 02 FILLER PIC X(5) VALUE "ALT05". IX2124.2 +012300 02 FILLER PIC XXX VALUE "MMM". IX2124.2 +012400 02 COUNTER06 PIC 999. IX2124.2 +012500 02 FILLER PIC X(5) VALUE "ALT06". IX2124.2 +012600 02 FILLER PIC XXX VALUE "OOO". IX2124.2 +012700 02 COUNTER07 PIC 999. IX2124.2 +012800 02 FILLER PIC X(5) VALUE "ALT07". IX2124.2 +012900 02 FILLER PIC XXX VALUE "QQQ". IX2124.2 +013000 02 COUNTER08 PIC 999. IX2124.2 +013100 02 FILLER PIC X(5) VALUE "ALT08". IX2124.2 +013200 02 FILLER PIC XXX VALUE "SSS". IX2124.2 +013300 02 COUNTER09 PIC 999. IX2124.2 +013400 02 FILLER PIC X(5) VALUE "ALT09". IX2124.2 +013500 02 FILLER PIC XXX VALUE "UUU". IX2124.2 +013600 02 COUNTER10 PIC 999. IX2124.2 +013700 02 FILLER PIC X(5) VALUE "ALT10". IX2124.2 +013800 01 TEST-RESULTS. IX2124.2 +013900 02 FILLER PIC X VALUE SPACE. IX2124.2 +014000 02 FEATURE PIC X(20) VALUE SPACE. IX2124.2 +014100 02 FILLER PIC X VALUE SPACE. IX2124.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. IX2124.2 +014300 02 FILLER PIC X VALUE SPACE. IX2124.2 +014400 02 PAR-NAME. IX2124.2 +014500 03 FILLER PIC X(19) VALUE SPACE. IX2124.2 +014600 03 PARDOT-X PIC X VALUE SPACE. IX2124.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. IX2124.2 +014800 02 FILLER PIC X(8) VALUE SPACE. IX2124.2 +014900 02 RE-MARK PIC X(61). IX2124.2 +015000 01 TEST-COMPUTED. IX2124.2 +015100 02 FILLER PIC X(30) VALUE SPACE. IX2124.2 +015200 02 FILLER PIC X(17) VALUE IX2124.2 +015300 " COMPUTED=". IX2124.2 +015400 02 COMPUTED-X. IX2124.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2124.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A IX2124.2 +015700 PIC -9(9).9(9). IX2124.2 +015800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2124.2 +015900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2124.2 +016000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2124.2 +016100 03 CM-18V0 REDEFINES COMPUTED-A. IX2124.2 +016200 04 COMPUTED-18V0 PIC -9(18). IX2124.2 +016300 04 FILLER PIC X. IX2124.2 +016400 03 FILLER PIC X(50) VALUE SPACE. IX2124.2 +016500 01 TEST-CORRECT. IX2124.2 +016600 02 FILLER PIC X(30) VALUE SPACE. IX2124.2 +016700 02 FILLER PIC X(17) VALUE " CORRECT =". IX2124.2 +016800 02 CORRECT-X. IX2124.2 +016900 03 CORRECT-A PIC X(20) VALUE SPACE. IX2124.2 +017000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2124.2 +017100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2124.2 +017200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2124.2 +017300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2124.2 +017400 03 CR-18V0 REDEFINES CORRECT-A. IX2124.2 +017500 04 CORRECT-18V0 PIC -9(18). IX2124.2 +017600 04 FILLER PIC X. IX2124.2 +017700 03 FILLER PIC X(2) VALUE SPACE. IX2124.2 +017800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2124.2 +017900 01 CCVS-C-1. IX2124.2 +018000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2124.2 +018100- "SS PARAGRAPH-NAME IX2124.2 +018200- " REMARKS". IX2124.2 +018300 02 FILLER PIC X(20) VALUE SPACE. IX2124.2 +018400 01 CCVS-C-2. IX2124.2 +018500 02 FILLER PIC X VALUE SPACE. IX2124.2 +018600 02 FILLER PIC X(6) VALUE "TESTED". IX2124.2 +018700 02 FILLER PIC X(15) VALUE SPACE. IX2124.2 +018800 02 FILLER PIC X(4) VALUE "FAIL". IX2124.2 +018900 02 FILLER PIC X(94) VALUE SPACE. IX2124.2 +019000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2124.2 +019100 01 REC-CT PIC 99 VALUE ZERO. IX2124.2 +019200 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2124.2 +019300 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2124.2 +019400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2124.2 +019500 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2124.2 +019600 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2124.2 +019700 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2124.2 +019800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2124.2 +019900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2124.2 +020000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2124.2 +020100 01 CCVS-H-1. IX2124.2 +020200 02 FILLER PIC X(39) VALUE SPACES. IX2124.2 +020300 02 FILLER PIC X(42) VALUE IX2124.2 +020400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2124.2 +020500 02 FILLER PIC X(39) VALUE SPACES. IX2124.2 +020600 01 CCVS-H-2A. IX2124.2 +020700 02 FILLER PIC X(40) VALUE SPACE. IX2124.2 +020800 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2124.2 +020900 02 FILLER PIC XXXX VALUE IX2124.2 +021000 "4.2 ". IX2124.2 +021100 02 FILLER PIC X(28) VALUE IX2124.2 +021200 " COPY - NOT FOR DISTRIBUTION". IX2124.2 +021300 02 FILLER PIC X(41) VALUE SPACE. IX2124.2 +021400 IX2124.2 +021500 01 CCVS-H-2B. IX2124.2 +021600 02 FILLER PIC X(15) VALUE IX2124.2 +021700 "TEST RESULT OF ". IX2124.2 +021800 02 TEST-ID PIC X(9). IX2124.2 +021900 02 FILLER PIC X(4) VALUE IX2124.2 +022000 " IN ". IX2124.2 +022100 02 FILLER PIC X(12) VALUE IX2124.2 +022200 " HIGH ". IX2124.2 +022300 02 FILLER PIC X(22) VALUE IX2124.2 +022400 " LEVEL VALIDATION FOR ". IX2124.2 +022500 02 FILLER PIC X(58) VALUE IX2124.2 +022600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2124.2 +022700 01 CCVS-H-3. IX2124.2 +022800 02 FILLER PIC X(34) VALUE IX2124.2 +022900 " FOR OFFICIAL USE ONLY ". IX2124.2 +023000 02 FILLER PIC X(58) VALUE IX2124.2 +023100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2124.2 +023200 02 FILLER PIC X(28) VALUE IX2124.2 +023300 " COPYRIGHT 1985 ". IX2124.2 +023400 01 CCVS-E-1. IX2124.2 +023500 02 FILLER PIC X(52) VALUE SPACE. IX2124.2 +023600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2124.2 +023700 02 ID-AGAIN PIC X(9). IX2124.2 +023800 02 FILLER PIC X(45) VALUE SPACES. IX2124.2 +023900 01 CCVS-E-2. IX2124.2 +024000 02 FILLER PIC X(31) VALUE SPACE. IX2124.2 +024100 02 FILLER PIC X(21) VALUE SPACE. IX2124.2 +024200 02 CCVS-E-2-2. IX2124.2 +024300 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2124.2 +024400 03 FILLER PIC X VALUE SPACE. IX2124.2 +024500 03 ENDER-DESC PIC X(44) VALUE IX2124.2 +024600 "ERRORS ENCOUNTERED". IX2124.2 +024700 01 CCVS-E-3. IX2124.2 +024800 02 FILLER PIC X(22) VALUE IX2124.2 +024900 " FOR OFFICIAL USE ONLY". IX2124.2 +025000 02 FILLER PIC X(12) VALUE SPACE. IX2124.2 +025100 02 FILLER PIC X(58) VALUE IX2124.2 +025200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2124.2 +025300 02 FILLER PIC X(13) VALUE SPACE. IX2124.2 +025400 02 FILLER PIC X(15) VALUE IX2124.2 +025500 " COPYRIGHT 1985". IX2124.2 +025600 01 CCVS-E-4. IX2124.2 +025700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2124.2 +025800 02 FILLER PIC X(4) VALUE " OF ". IX2124.2 +025900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2124.2 +026000 02 FILLER PIC X(40) VALUE IX2124.2 +026100 " TESTS WERE EXECUTED SUCCESSFULLY". IX2124.2 +026200 01 XXINFO. IX2124.2 +026300 02 FILLER PIC X(19) VALUE IX2124.2 +026400 "*** INFORMATION ***". IX2124.2 +026500 02 INFO-TEXT. IX2124.2 +026600 04 FILLER PIC X(8) VALUE SPACE. IX2124.2 +026700 04 XXCOMPUTED PIC X(20). IX2124.2 +026800 04 FILLER PIC X(5) VALUE SPACE. IX2124.2 +026900 04 XXCORRECT PIC X(20). IX2124.2 +027000 02 INF-ANSI-REFERENCE PIC X(48). IX2124.2 +027100 01 HYPHEN-LINE. IX2124.2 +027200 02 FILLER PIC IS X VALUE IS SPACE. IX2124.2 +027300 02 FILLER PIC IS X(65) VALUE IS "************************IX2124.2 +027400- "*****************************************". IX2124.2 +027500 02 FILLER PIC IS X(54) VALUE IS "************************IX2124.2 +027600- "******************************". IX2124.2 +027700 01 CCVS-PGM-ID PIC X(9) VALUE IX2124.2 +027800 "IX212A". IX2124.2 +027900 PROCEDURE DIVISION. IX2124.2 +028000 CCVS1 SECTION. IX2124.2 +028100 OPEN-FILES. IX2124.2 +028200*P OPEN I-O RAW-DATA. IX2124.2 +028300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2124.2 +028400*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2124.2 +028500*P MOVE "ABORTED " TO C-ABORT. IX2124.2 +028600*P ADD 1 TO C-NO-OF-TESTS. IX2124.2 +028700*P ACCEPT C-DATE FROM DATE. IX2124.2 +028800*P ACCEPT C-TIME FROM TIME. IX2124.2 +028900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2124.2 +029000*PND-E-1. IX2124.2 +029100*P CLOSE RAW-DATA. IX2124.2 +029200 OPEN OUTPUT PRINT-FILE. IX2124.2 +029300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2124.2 +029400 MOVE SPACE TO TEST-RESULTS. IX2124.2 +029500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2124.2 +029600 GO TO CCVS1-EXIT. IX2124.2 +029700 CLOSE-FILES. IX2124.2 +029800*P OPEN I-O RAW-DATA. IX2124.2 +029900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2124.2 +030000*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2124.2 +030100*P MOVE "OK. " TO C-ABORT. IX2124.2 +030200*P MOVE PASS-COUNTER TO C-OK. IX2124.2 +030300*P MOVE ERROR-HOLD TO C-ALL. IX2124.2 +030400*P MOVE ERROR-COUNTER TO C-FAIL. IX2124.2 +030500*P MOVE DELETE-COUNTER TO C-DELETED. IX2124.2 +030600*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2124.2 +030700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2124.2 +030800*PND-E-2. IX2124.2 +030900*P CLOSE RAW-DATA. IX2124.2 +031000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2124.2 +031100 TERMINATE-CCVS. IX2124.2 +031200*S EXIT PROGRAM. IX2124.2 +031300*SERMINATE-CALL. IX2124.2 +031400 STOP RUN. IX2124.2 +031500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2124.2 +031600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2124.2 +031700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2124.2 +031800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2124.2 +031900 MOVE "****TEST DELETED****" TO RE-MARK. IX2124.2 +032000 PRINT-DETAIL. IX2124.2 +032100 IF REC-CT NOT EQUAL TO ZERO IX2124.2 +032200 MOVE "." TO PARDOT-X IX2124.2 +032300 MOVE REC-CT TO DOTVALUE. IX2124.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2124.2 +032500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2124.2 +032600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2124.2 +032700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2124.2 +032800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2124.2 +032900 MOVE SPACE TO CORRECT-X. IX2124.2 +033000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2124.2 +033100 MOVE SPACE TO RE-MARK. IX2124.2 +033200 HEAD-ROUTINE. IX2124.2 +033300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +033400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +033500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2124.2 +033600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2124.2 +033700 COLUMN-NAMES-ROUTINE. IX2124.2 +033800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +033900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +034000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +034100 END-ROUTINE. IX2124.2 +034200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2124.2 +034300 END-RTN-EXIT. IX2124.2 +034400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +034500 END-ROUTINE-1. IX2124.2 +034600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2124.2 +034700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2124.2 +034800 ADD PASS-COUNTER TO ERROR-HOLD. IX2124.2 +034900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2124.2 +035000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2124.2 +035100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2124.2 +035200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2124.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2124.2 +035400 END-ROUTINE-12. IX2124.2 +035500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2124.2 +035600 IF ERROR-COUNTER IS EQUAL TO ZERO IX2124.2 +035700 MOVE "NO " TO ERROR-TOTAL IX2124.2 +035800 ELSE IX2124.2 +035900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2124.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2124.2 +036100 PERFORM WRITE-LINE. IX2124.2 +036200 END-ROUTINE-13. IX2124.2 +036300 IF DELETE-COUNTER IS EQUAL TO ZERO IX2124.2 +036400 MOVE "NO " TO ERROR-TOTAL ELSE IX2124.2 +036500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2124.2 +036600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2124.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +036800 IF INSPECT-COUNTER EQUAL TO ZERO IX2124.2 +036900 MOVE "NO " TO ERROR-TOTAL IX2124.2 +037000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2124.2 +037100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2124.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +037300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2124.2 +037400 WRITE-LINE. IX2124.2 +037500 ADD 1 TO RECORD-COUNT. IX2124.2 +037600 IF RECORD-COUNT GREATER 42 IX2124.2 +037700 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2124.2 +037800 MOVE SPACE TO DUMMY-RECORD IX2124.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2124.2 +038000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2124.2 +038100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2124.2 +038200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2124.2 +038300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2124.2 +038400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2124.2 +038500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2124.2 +038600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2124.2 +038700 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2124.2 +038800 MOVE ZERO TO RECORD-COUNT. IX2124.2 +038900 PERFORM WRT-LN. IX2124.2 +039000 WRT-LN. IX2124.2 +039100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2124.2 +039200 MOVE SPACE TO DUMMY-RECORD. IX2124.2 +039300 BLANK-LINE-PRINT. IX2124.2 +039400 PERFORM WRT-LN. IX2124.2 +039500 FAIL-ROUTINE. IX2124.2 +039600 IF COMPUTED-X NOT EQUAL TO SPACE IX2124.2 +039700 GO TO FAIL-ROUTINE-WRITE. IX2124.2 +039800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2124.2 +039900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2124.2 +040000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2124.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +040200 MOVE SPACES TO INF-ANSI-REFERENCE. IX2124.2 +040300 GO TO FAIL-ROUTINE-EX. IX2124.2 +040400 FAIL-ROUTINE-WRITE. IX2124.2 +040500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2124.2 +040600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2124.2 +040700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2124.2 +040800 MOVE SPACES TO COR-ANSI-REFERENCE. IX2124.2 +040900 FAIL-ROUTINE-EX. EXIT. IX2124.2 +041000 BAIL-OUT. IX2124.2 +041100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2124.2 +041200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2124.2 +041300 BAIL-OUT-WRITE. IX2124.2 +041400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2124.2 +041500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2124.2 +041600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2124.2 +041700 MOVE SPACES TO INF-ANSI-REFERENCE. IX2124.2 +041800 BAIL-OUT-EX. EXIT. IX2124.2 +041900 CCVS1-EXIT. IX2124.2 +042000 EXIT. IX2124.2 +042100 WRITE-INIT-GF-01. IX2124.2 +042200 OPEN OUTPUT IX-FS1. IX2124.2 +042300 PERFORM CREATE-IX-FS1 VARYING RECORD-COUNTER FROM 1 BY 1 IX2124.2 +042400 UNTIL RECORD-COUNTER IS GREATER THAN 100. IX2124.2 +042500 GO TO WRITE-TEST-GF-01. IX2124.2 +042600 CREATE-IX-FS1. IX2124.2 +042700 MOVE RECORD-COUNTER TO COUNTER00, COUNTER01, COUNTER02, IX2124.2 +042800 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2124.2 +042900 COUNTER08, COUNTER09, COUNTER10. IX2124.2 +043000 WRITE IX-FS1-RECORD FROM WORK-RECORD INVALID KEY IX2124.2 +043100 ADD 1 TO INVKEY-COUNTER. IX2124.2 +043200 WRITE-TEST-GF-01. IX2124.2 +043300 MOVE "WRITE INVALID KEY" TO FEATURE. IX2124.2 +043400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2124.2 +043500 MOVE "CREATE IX-FS1" TO RE-MARK. IX2124.2 +043600 IF INVKEY-COUNTER = 0 IX2124.2 +043700 PERFORM PASS IX2124.2 +043800 ELSE GO TO WRITE-FAIL-GF-01. IX2124.2 +043900 GO TO WRITE-WRITE-GF-01. IX2124.2 +044000 WRITE-DELETE-GF-01. IX2124.2 +044100 PERFORM DE-LETE. IX2124.2 +044200 GO TO WRITE-WRITE-GF-01. IX2124.2 +044300 WRITE-FAIL-GF-01. IX2124.2 +044400 MOVE "IX-41; ONE WRITE FAILED AT LEAST" TO RE-MARK. IX2124.2 +044500 PERFORM FAIL. IX2124.2 +044600 MOVE INVKEY-COUNTER TO COMPUTED-18V0. IX2124.2 +044700 MOVE 0 TO CORRECT-18V0. IX2124.2 +044800 WRITE-WRITE-GF-01. IX2124.2 +044900 PERFORM PRINT-DETAIL. IX2124.2 +045000 READ-TEST-F2-01. IX2124.2 +045100 CLOSE IX-FS1. IX2124.2 +045200 OPEN I-O IX-FS1. IX2124.2 +045300 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +045400 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX2124.2 +045500 MOVE "RETRIEVED BY ALTERNATE KEY 1" TO RE-MARK. IX2124.2 +045600 MOVE "CCC012ALT01" TO IX-FS1-ALT01. IX2124.2 +045700 READ IX-FS1 RECORD IX2124.2 +045800 KEY IS IX-FS1-ALT01 IX2124.2 +045900 INVALID KEY GO TO READ-INVALID-F2-01. IX2124.2 +046000 IF IX-FS1-KEY = "AAA012" IX2124.2 +046100 PERFORM PASS IX2124.2 +046200 ELSE GO TO READ-FAIL-F2-01. IX2124.2 +046300 GO TO READ-WRITE-F2-01. IX2124.2 +046400 READ-DELETE-F2-01. IX2124.2 +046500 PERFORM DE-LETE. IX2124.2 +046600 GO TO READ-WRITE-F2-01. IX2124.2 +046700 READ-INVALID-F2-01. IX2124.2 +046800 PERFORM FAIL. IX2124.2 +046900 MOVE "IX-28; INVALID KEY CONDITION (IX-6) EXISTS" TO RE-MARK.IX2124.2 +047000 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +047100 MOVE "CCC012ALT01" TO CORRECT-A. IX2124.2 +047200 GO TO READ-WRITE-F2-01. IX2124.2 +047300 READ-FAIL-F2-01. IX2124.2 +047400 MOVE "IX-28; RETRIEVED BY ALTERENATE KEY 1" TO RE-MARK. IX2124.2 +047500 PERFORM FAIL. IX2124.2 +047600 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +047700 MOVE "AAA012" TO CORRECT-A. IX2124.2 +047800 READ-WRITE-F2-01. IX2124.2 +047900 PERFORM PRINT-DETAIL. IX2124.2 +048000 READ-TEST-F2-02. IX2124.2 +048100 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +048200 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX2124.2 +048300 MOVE "RETRIEVED BY ALTERNATE KEY 8" TO RE-MARK. IX2124.2 +048400 MOVE "QQQ043ALT08" TO IX-FS1-ALT08. IX2124.2 +048500 READ IX-FS1 RECORD IX2124.2 +048600 KEY IS IX-FS1-ALT08 IX2124.2 +048700 INVALID KEY GO TO READ-INVALID-F2-02. IX2124.2 +048800 IF IX-FS1-KEY = "AAA043" IX2124.2 +048900 PERFORM PASS IX2124.2 +049000 ELSE GO TO READ-FAIL-F2-02. IX2124.2 +049100 GO TO READ-WRITE-F2-02. IX2124.2 +049200 READ-DELETE-F2-02. IX2124.2 +049300 PERFORM DE-LETE. IX2124.2 +049400 GO TO READ-WRITE-F2-02. IX2124.2 +049500 READ-INVALID-F2-02. IX2124.2 +049600 PERFORM FAIL. IX2124.2 +049700 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +049800 TO RE-MARK. IX2124.2 +049900 MOVE "QQQ043ALT08" TO CORRECT-A. IX2124.2 +050000 GO TO READ-WRITE-F2-02. IX2124.2 +050100 READ-FAIL-F2-02. IX2124.2 +050200 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +050300 PERFORM FAIL. IX2124.2 +050400 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +050500 MOVE "AAA043" TO CORRECT-A. IX2124.2 +050600 READ-WRITE-F2-02. IX2124.2 +050700 PERFORM PRINT-DETAIL. IX2124.2 +050800 DELETE-TEST-GF-01. IX2124.2 +050900 MOVE "DELETE...RECORD" TO FEATURE. IX2124.2 +051000 MOVE "DELETE-TEST-GF-01" TO PAR-NAME. IX2124.2 +051100 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-02" TO RE-MARK. IX2124.2 +051200 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-INVALID-GF-01. IX2124.2 +051300 PERFORM PASS. IX2124.2 +051400 GO TO DELETE-WRITE-GF-01. IX2124.2 +051500 DELETE-DELETE-GF-01. IX2124.2 +051600 PERFORM DE-LETE. IX2124.2 +051700 GO TO DELETE-WRITE-GF-01. IX2124.2 +051800 DELETE-INVALID-GF-01. IX2124.2 +051900 MOVE "IX-21; 4.3.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +052000 TO RE-MARK. IX2124.2 +052100 PERFORM FAIL. IX2124.2 +052200 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +052300 MOVE "AAA043" TO CORRECT-A. IX2124.2 +052400 DELETE-WRITE-GF-01. IX2124.2 +052500 PERFORM PRINT-DETAIL. IX2124.2 +052600 READ-TEST-F2-03. IX2124.2 +052700 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +052800 MOVE "READ-TEST-F2-03" TO PAR-NAME. IX2124.2 +052900 MOVE "RETRIEVED BY ALTERNATE KEY 4" TO RE-MARK. IX2124.2 +053000 MOVE "III017ALT04" TO IX-FS1-ALT04. IX2124.2 +053100 READ IX-FS1 RECORD IX2124.2 +053200 KEY IS IX-FS1-ALT04 IX2124.2 +053300 INVALID KEY GO TO READ-INVALID-F2-03. IX2124.2 +053400 IF IX-FS1-KEY = "AAA017" IX2124.2 +053500 PERFORM PASS IX2124.2 +053600 ELSE GO TO READ-FAIL-F2-03. IX2124.2 +053700 GO TO READ-WRITE-F2-03. IX2124.2 +053800 READ-DELETE-F2-03. IX2124.2 +053900 PERFORM DE-LETE. IX2124.2 +054000 GO TO READ-WRITE-F2-03. IX2124.2 +054100 READ-INVALID-F2-03. IX2124.2 +054200 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +054300 TO RE-MARK. IX2124.2 +054400 PERFORM FAIL. IX2124.2 +054500 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +054600 MOVE "III017ALT04" TO CORRECT-A. IX2124.2 +054700 GO TO READ-WRITE-F2-03. IX2124.2 +054800 READ-FAIL-F2-03. IX2124.2 +054900 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +055000 PERFORM FAIL. IX2124.2 +055100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +055200 MOVE "AAA017" TO CORRECT-A. IX2124.2 +055300 READ-WRITE-F2-03. IX2124.2 +055400 PERFORM PRINT-DETAIL. IX2124.2 +055500 REWRITE-TEST-GF-01. IX2124.2 +055600 MOVE "REWRITE...INVALID..." TO FEATURE. IX2124.2 +055700 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME. IX2124.2 +055800 MOVE "REWRITES RECORD FOUND IN READ-TEST-F2-03" TO RE-MARK. IX2124.2 +055900 MOVE "III917ALT04" TO IX-FS1-ALT04. IX2124.2 +056000 REWRITE IX-FS1-RECORD INVALID KEY IX2124.2 +056100 GO TO REWRITE-INVALID-GF-01. IX2124.2 +056200 PERFORM PASS. IX2124.2 +056300 GO TO REWRITE-WRITE-GF-01. IX2124.2 +056400 REWRITE-DELETE-GF-01. IX2124.2 +056500 PERFORM DE-LETE. IX2124.2 +056600 GO TO REWRITE-WRITE-GF-01. IX2124.2 +056700 REWRITE-INVALID-GF-01. IX2124.2 +056800 MOVE "IX-33; 4.6.2, INVALID KEY CONDITION (IX-6) " TO RE-MARKIX2124.2 +056900 PERFORM FAIL. IX2124.2 +057000 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +057100 MOVE "III917ALT04" TO CORRECT-A. IX2124.2 +057200 REWRITE-WRITE-GF-01. IX2124.2 +057300 PERFORM PRINT-DETAIL. IX2124.2 +057400 READ-TEST-F2-04. IX2124.2 +057500 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +057600 MOVE "READ-TEST-F2-04" TO PAR-NAME. IX2124.2 +057700 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +057800 MOVE "ZZZ999ALT09" TO IX-FS1-ALT09. IX2124.2 +057900 READ IX-FS1 RECORD IX2124.2 +058000 KEY IS IX-FS1-ALT09 IX2124.2 +058100 INVALID KEY PERFORM PASS IX2124.2 +058200 GO TO READ-WRITE-F2-04. IX2124.2 +058300 GO TO READ-FAIL-F2-04. IX2124.2 +058400 READ-DELETE-F2-04. IX2124.2 +058500 PERFORM DE-LETE. IX2124.2 +058600 GO TO READ-WRITE-F2-04. IX2124.2 +058700 READ-FAIL-F2-04. IX2124.2 +058800 MOVE "IX-28; 4.5.2 F2, INVALID KEY NOT TAKEN (IX-6)" IX2124.2 +058900 TO RE-MARK. IX2124.2 +059000 PERFORM FAIL. IX2124.2 +059100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +059200 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +059300 READ-WRITE-F2-04. IX2124.2 +059400 PERFORM PRINT-DETAIL. IX2124.2 +059500 START-TEST-GF-01. IX2124.2 +059600 MOVE "START...KEY IS EQUAL" TO FEATURE. IX2124.2 +059700 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2124.2 +059800 MOVE "RETRIEVED BY ALTERNATE KEY 3" TO RE-MARK. IX2124.2 +059900 MOVE "GGG058ALT03" TO IX-FS1-ALT03. IX2124.2 +060000 START IX-FS1 IX2124.2 +060100 KEY IS EQUAL TO IX-FS1-ALT03 IX2124.2 +060200 INVALID KEY GO TO START-INVALID-GF-01. IX2124.2 +060300 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-01. IX2124.2 +060400 IF IX-FS1-KEY = "AAA058" IX2124.2 +060500 PERFORM PASS IX2124.2 +060600 ELSE GO TO START-FAIL-GF-01. IX2124.2 +060700 GO TO START-WRITE-GF-01. IX2124.2 +060800 START-DELETE-GF-01. IX2124.2 +060900 PERFORM DE-LETE. IX2124.2 +061000 GO TO START-WRITE-GF-01. IX2124.2 +061100 START-INVALID-GF-01. IX2124.2 +061200 MOVE "IX-36; 4.7.2, INVALID KEY CONDITION (IX-6)" TO RE-MARK.IX2124.2 +061300 PERFORM FAIL. IX2124.2 +061400 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +061500 MOVE "GGG058ALT03" TO CORRECT-A. IX2124.2 +061600 GO TO START-WRITE-GF-01. IX2124.2 +061700 START-END-GF-01. IX2124.2 +061800 MOVE "IX-28; 4.5.2 F1, AT END CONDITION " TO RE-MARK. IX2124.2 +061900 PERFORM FAIL. IX2124.2 +062000 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +062100 MOVE "AAA058" TO CORRECT-A. IX2124.2 +062200 GO TO START-WRITE-GF-01. IX2124.2 +062300 START-FAIL-GF-01. IX2124.2 +062400 MOVE "IX-28; 4.5.2 F1, WRONG KEY OR IX-36 WRONG START " IX2124.2 +062500 TO RE-MARK. IX2124.2 +062600 PERFORM FAIL. IX2124.2 +062700 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +062800 MOVE "AAA058" TO CORRECT-A. IX2124.2 +062900 START-WRITE-GF-01. IX2124.2 +063000 PERFORM PRINT-DETAIL. IX2124.2 +063100 START-TEST-GF-02. IX2124.2 +063200 MOVE "START...KEY >" TO FEATURE. IX2124.2 +063300 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2124.2 +063400 MOVE "RETRIEVED BY ALTERNATE KEY 6" TO RE-MARK. IX2124.2 +063500 MOVE "MMM089ALT06" TO IX-FS1-ALT06. IX2124.2 +063600 START IX-FS1 IX2124.2 +063700 KEY > IX-FS1-ALT06 IX2124.2 +063800 INVALID KEY GO TO START-INVALID-GF-02. IX2124.2 +063900 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-02. IX2124.2 +064000 IF IX-FS1-KEY = "AAA090" IX2124.2 +064100 PERFORM PASS IX2124.2 +064200 ELSE GO TO START-FAIL-GF-02. IX2124.2 +064300 GO TO START-WRITE-GF-02. IX2124.2 +064400 START-DELETE-GF-02. IX2124.2 +064500 PERFORM DE-LETE. IX2124.2 +064600 GO TO START-WRITE-GF-02. IX2124.2 +064700 START-INVALID-GF-02. IX2124.2 +064800 MOVE "IX-36; 4.7.2, INVALID KEY CONDITION (IX-6)" TO RE-MARK.IX2124.2 +064900 PERFORM FAIL. IX2124.2 +065000 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +065100 MOVE "MMM089ALT09" TO CORRECT-A. IX2124.2 +065200 GO TO START-WRITE-GF-02. IX2124.2 +065300 START-END-GF-02. IX2124.2 +065400 MOVE "IX-28; 4.5.2 F1, AT END CONDITION (IX-6)" TO RE-MARK. IX2124.2 +065500 PERFORM FAIL. IX2124.2 +065600 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +065700 MOVE "AAA090" TO CORRECT-A. IX2124.2 +065800 GO TO START-WRITE-GF-02. IX2124.2 +065900 START-FAIL-GF-02. IX2124.2 +066000 MOVE "IX-28; 4.5.2 F1, AT END OR IX-36 START WRONG KEY" IX2124.2 +066100 TO RE-MARK. IX2124.2 +066200 PERFORM FAIL. IX2124.2 +066300 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +066400 MOVE "AAA090" TO CORRECT-A. IX2124.2 +066500 START-WRITE-GF-02. IX2124.2 +066600 PERFORM PRINT-DETAIL. IX2124.2 +066700 START-TEST-GF-03. IX2124.2 +066800 MOVE "START...KEY NOT <" TO FEATURE. IX2124.2 +066900 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2124.2 +067000 MOVE "RETRIEVED BY ALTERNATE KEY 10" TO RE-MARK. IX2124.2 +067100 MOVE "UUU002ALT10" TO IX-FS1-ALT10. IX2124.2 +067200 START IX-FS1 IX2124.2 +067300 KEY NOT < IX-FS1-ALT10 IX2124.2 +067400 INVALID KEY GO TO START-INVALID-GF-03. IX2124.2 +067500 READ IX-FS1 NEXT RECORD IX2124.2 +067600 AT END GO TO START-END-GF-03. IX2124.2 +067700 IF IX-FS1-KEY = "AAA002" IX2124.2 +067800 PERFORM PASS IX2124.2 +067900 ELSE GO TO START-FAIL-GF-03. IX2124.2 +068000 GO TO START-WRITE-GF-03. IX2124.2 +068100 START-DELETE-GF-03. IX2124.2 +068200 PERFORM DE-LETE. IX2124.2 +068300 GO TO START-WRITE-GF-03. IX2124.2 +068400 START-INVALID-GF-03. IX2124.2 +068500 MOVE "IX-36; 4.7.2 F2, INVALID KEY CONDITION (IX-6)" IX2124.2 +068600 TO RE-MARK. IX2124.2 +068700 PERFORM FAIL. IX2124.2 +068800 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +068900 MOVE "UUU002ALT10" TO CORRECT-A. IX2124.2 +069000 GO TO START-WRITE-GF-03. IX2124.2 +069100 START-END-GF-03. IX2124.2 +069200 MOVE "IX-28; 4.5.2 F1, AT END CONDITION (IX-6)" TO RE-MARK. IX2124.2 +069300 PERFORM FAIL. IX2124.2 +069400 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +069500 MOVE "AAA002" TO CORRECT-A. IX2124.2 +069600 GO TO START-WRITE-GF-03. IX2124.2 +069700 START-FAIL-GF-03. IX2124.2 +069800 MOVE "IX-28; 4.5.2 F1, AT END OR IX-36 START WRONG KEY" IX2124.2 +069900 TO RE-MARK. IX2124.2 +070000 PERFORM FAIL. IX2124.2 +070100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +070200 MOVE "AAA002" TO CORRECT-A. IX2124.2 +070300 START-WRITE-GF-03. IX2124.2 +070400 PERFORM PRINT-DETAIL. IX2124.2 +070500 START-TEST-GF-04. IX2124.2 +070600 MOVE "START...KEY >= " TO FEATURE. IX2124.2 +070700 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2124.2 +070800 MOVE "RETRIEVED BY ALTERNATE KEY 10" TO RE-MARK. IX2124.2 +070900 MOVE "UUU002ALT10" TO IX-FS1-ALT10. IX2124.2 +071000 START IX-FS1 IX2124.2 +071100 KEY >= IX-FS1-ALT10 IX2124.2 +071200 INVALID KEY GO TO START-INVALID-GF-04. IX2124.2 +071300 READ IX-FS1 NEXT RECORD IX2124.2 +071400 AT END GO TO START-END-GF-04. IX2124.2 +071500 IF IX-FS1-KEY = "AAA002" IX2124.2 +071600 PERFORM PASS IX2124.2 +071700 ELSE GO TO START-FAIL-GF-04. IX2124.2 +071800 GO TO START-WRITE-GF-04. IX2124.2 +071900 START-DELETE-GF-04. IX2124.2 +072000 PERFORM DE-LETE. IX2124.2 +072100 GO TO START-WRITE-GF-04. IX2124.2 +072200 START-INVALID-GF-04. IX2124.2 +072300 MOVE "IX-36; 4.7.2 F2, INVALID KEY CONDITION (IX-6)" IX2124.2 +072400 TO RE-MARK. IX2124.2 +072500 PERFORM FAIL. IX2124.2 +072600 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +072700 MOVE "UUU002ALT10" TO CORRECT-A. IX2124.2 +072800 GO TO START-WRITE-GF-04. IX2124.2 +072900 START-END-GF-04. IX2124.2 +073000 MOVE "IX-28; 4.5.2 F1, AT END CONDITION (IX-6)" TO RE-MARK. IX2124.2 +073100 PERFORM FAIL. IX2124.2 +073200 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +073300 MOVE "AAA002" TO CORRECT-A. IX2124.2 +073400 GO TO START-WRITE-GF-04. IX2124.2 +073500 START-FAIL-GF-04. IX2124.2 +073600 MOVE "IX-28; 4.5.2 F1, AT END OR IX-36 START WRONG KEY" IX2124.2 +073700 TO RE-MARK. IX2124.2 +073800 PERFORM FAIL. IX2124.2 +073900 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +074000 MOVE "AAA002" TO CORRECT-A. IX2124.2 +074100 START-WRITE-GF-04. IX2124.2 +074200 PERFORM PRINT-DETAIL. IX2124.2 +074300 READ-TEST-F2-05. IX2124.2 +074400 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +074500 MOVE "READ-TEST-F2-05" TO PAR-NAME. IX2124.2 +074600 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +074700 MOVE "QQQ043ALT08" TO IX-FS1-ALT08. IX2124.2 +074800 READ IX-FS1 RECORD IX2124.2 +074900 KEY IS IX-FS1-ALT08 IX2124.2 +075000 INVALID KEY PERFORM PASS IX2124.2 +075100 GO TO READ-WRITE-F2-05. IX2124.2 +075200 GO TO READ-FAIL-F2-05. IX2124.2 +075300 READ-DELETE-F2-05. IX2124.2 +075400 PERFORM DE-LETE. IX2124.2 +075500 GO TO READ-WRITE-F2-05. IX2124.2 +075600 READ-FAIL-F2-05. IX2124.2 +075700 MOVE "IX-28; 4.5.2 F2, INVALID KEY PATH NOT TAKEN (IX-6) " IX2124.2 +075800 TO RE-MARK. IX2124.2 +075900 PERFORM FAIL. IX2124.2 +076000 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +076100 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +076200 READ-WRITE-F2-05. IX2124.2 +076300 PERFORM PRINT-DETAIL. IX2124.2 +076400 READ-TEST-F2-06. IX2124.2 +076500 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +076600 MOVE "READ-TEST-F2-06" TO PAR-NAME. IX2124.2 +076700 MOVE "RETRIEVED BY ALTERNATE KEY 4" TO RE-MARK. IX2124.2 +076800 MOVE "III917ALT04" TO IX-FS1-ALT04. IX2124.2 +076900 READ IX-FS1 RECORD IX2124.2 +077000 KEY IS IX-FS1-ALT04 IX2124.2 +077100 INVALID KEY GO TO READ-INVALID-F2-06. IX2124.2 +077200 IF IX-FS1-KEY = "AAA017" IX2124.2 +077300 PERFORM PASS IX2124.2 +077400 ELSE GO TO READ-FAIL-F2-06. IX2124.2 +077500 GO TO READ-WRITE-F2-06. IX2124.2 +077600 READ-DELETE-F2-06. IX2124.2 +077700 PERFORM DE-LETE. IX2124.2 +077800 GO TO READ-WRITE-F2-06. IX2124.2 +077900 READ-INVALID-F2-06. IX2124.2 +078000 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +078100 TO RE-MARK. IX2124.2 +078200 PERFORM FAIL. IX2124.2 +078300 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +078400 MOVE "III917ALT04" TO CORRECT-A. IX2124.2 +078500 GO TO READ-WRITE-F2-06. IX2124.2 +078600 READ-FAIL-F2-06. IX2124.2 +078700 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +078800 PERFORM FAIL. IX2124.2 +078900 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +079000 MOVE "AAA017" TO CORRECT-A. IX2124.2 +079100 READ-WRITE-F2-06. IX2124.2 +079200 PERFORM PRINT-DETAIL. IX2124.2 +079300 READ-TEST-F2-07. IX2124.2 +079400 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +079500 MOVE "READ-TEST-F2-07" TO PAR-NAME. IX2124.2 +079600 MOVE "RETRIEVED BY PRIMARY KEY" TO RE-MARK. IX2124.2 +079700 MOVE "AAA018" TO IX-FS1-KEY. IX2124.2 +079800 READ IX-FS1 RECORD IX2124.2 +079900 KEY IS IX-FS1-KEY IX2124.2 +080000 INVALID KEY GO TO READ-INVALID-F2-07. IX2124.2 +080100 IF IX-FS1-KEY = "AAA018" IX2124.2 +080200 PERFORM PASS IX2124.2 +080300 ELSE GO TO READ-FAIL-F2-07. IX2124.2 +080400 GO TO READ-WRITE-F2-07. IX2124.2 +080500 READ-DELETE-F2-07. IX2124.2 +080600 PERFORM DE-LETE. IX2124.2 +080700 GO TO READ-WRITE-F2-07. IX2124.2 +080800 READ-INVALID-F2-07. IX2124.2 +080900 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +081000 TO RE-MARK. IX2124.2 +081100 PERFORM FAIL. IX2124.2 +081200 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +081300 MOVE "AAA018" TO CORRECT-A. IX2124.2 +081400 GO TO READ-WRITE-F2-07. IX2124.2 +081500 READ-FAIL-F2-07. IX2124.2 +081600 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +081700 PERFORM FAIL. IX2124.2 +081800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +081900 MOVE "AAA018" TO CORRECT-A. IX2124.2 +082000 READ-WRITE-F2-07. IX2124.2 +082100 PERFORM PRINT-DETAIL. IX2124.2 +082200 DELETE-TEST-GF-02. IX2124.2 +082300 MOVE "DELETE...RECORD" TO FEATURE. IX2124.2 +082400 MOVE "DELETE-TEST-GF-02" TO PAR-NAME. IX2124.2 +082500 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-07" TO RE-MARK. IX2124.2 +082600 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-FAIL-GF-02. IX2124.2 +082700 PERFORM PASS. IX2124.2 +082800 GO TO DELETE-WRITE-GF-02. IX2124.2 +082900 DELETE-DELETE-GF-02. IX2124.2 +083000 PERFORM DE-LETE. IX2124.2 +083100 GO TO DELETE-WRITE-GF-02. IX2124.2 +083200 DELETE-FAIL-GF-02. IX2124.2 +083300 MOVE "IX-21; 4.3.2 INVALID KEY PATH TAKEN (IX-6)" TO RE-MARK.IX2124.2 +083400 PERFORM FAIL. IX2124.2 +083500 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +083600 MOVE "AAA018" TO CORRECT-A. IX2124.2 +083700 DELETE-WRITE-GF-02. IX2124.2 +083800 PERFORM PRINT-DETAIL. IX2124.2 +083900 READ-TEST-F1-08. IX2124.2 +084000 MOVE "READ...NEXT RECORD" TO FEATURE. IX2124.2 +084100 MOVE "READ-TEST-F1-08" TO PAR-NAME. IX2124.2 +084200 MOVE "READS NEXT RECORD" TO RE-MARK. IX2124.2 +084300 READ IX-FS1 NEXT RECORD AT END GO TO READ-END-F1-08. IX2124.2 +084400 IF IX-FS1-KEY = "AAA019" IX2124.2 +084500 PERFORM PASS IX2124.2 +084600 ELSE GO TO READ-FAIL-F1-08. IX2124.2 +084700 GO TO READ-WRITE-F1-08. IX2124.2 +084800 READ-DELETE-F1-08. IX2124.2 +084900 PERFORM DE-LETE. IX2124.2 +085000 GO TO READ-WRITE-F1-08. IX2124.2 +085100 READ-END-F1-08. IX2124.2 +085200 MOVE "IX-28; 4.5.2 F1, AT END CONDITION TAKEN" TO RE-MARK. IX2124.2 +085300 PERFORM FAIL. IX2124.2 +085400 MOVE "FILE IS AT END" TO COMPUTED-A. IX2124.2 +085500 MOVE "AAA019" TO CORRECT-A. IX2124.2 +085600 GO TO READ-WRITE-F1-08. IX2124.2 +085700 READ-FAIL-F1-08. IX2124.2 +085800 MOVE "IX-28; 4.5.2 F1, WRONG KEY " TO RE-MARK. IX2124.2 +085900 PERFORM FAIL. IX2124.2 +086000 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +086100 MOVE "AAA019" TO CORRECT-A. IX2124.2 +086200 READ-WRITE-F1-08. IX2124.2 +086300 PERFORM PRINT-DETAIL. IX2124.2 +086400 REWRITE-TEST-GF-02. IX2124.2 +086500 MOVE "REWRITE...INVALID..." TO FEATURE. IX2124.2 +086600 MOVE "REWRITE-TEST-GF-02" TO PAR-NAME. IX2124.2 +086700 MOVE "REWRITES RECORD FOUND IN READ-TEST-F1-08" TO RE-MARK. IX2124.2 +086800 MOVE "SSSSSSALT09" TO IX-FS1-ALT09. IX2124.2 +086900 REWRITE IX-FS1-RECORD INVALID KEY GO TO REWRITE-FAIL-GF-02. IX2124.2 +087000 PERFORM PASS. IX2124.2 +087100 GO TO REWRITE-WRITE-GF-02. IX2124.2 +087200 REWRITE-DELETE-GF-02. IX2124.2 +087300 PERFORM DE-LETE. IX2124.2 +087400 GO TO REWRITE-WRITE-GF-02. IX2124.2 +087500 REWRITE-FAIL-GF-02. IX2124.2 +087600 MOVE "IX-33; 4.6.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +087700 TO RE-MARK. IX2124.2 +087800 PERFORM FAIL. IX2124.2 +087900 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +088000 MOVE "SSSSSSALT09" TO CORRECT-A. IX2124.2 +088100 REWRITE-WRITE-GF-02. IX2124.2 +088200 PERFORM PRINT-DETAIL. IX2124.2 +088300 READ-TEST-F2-09. IX2124.2 +088400 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +088500 MOVE "READ-TEST-F2-09" TO PAR-NAME. IX2124.2 +088600 MOVE "RETRIEVED BY ALTERNATE KEY 2" TO RE-MARK. IX2124.2 +088700 MOVE "EEE075ALT02" TO IX-FS1-ALT02. IX2124.2 +088800 READ IX-FS1 RECORD IX2124.2 +088900 KEY IS IX-FS1-ALT02 IX2124.2 +089000 INVALID KEY GO TO READ-INVALID-F2-09. IX2124.2 +089100 IF IX-FS1-KEY = "AAA075" IX2124.2 +089200 PERFORM PASS IX2124.2 +089300 ELSE GO TO READ-FAIL-F2-09. IX2124.2 +089400 GO TO READ-WRITE-F2-09. IX2124.2 +089500 READ-DELETE-F2-09. IX2124.2 +089600 PERFORM DE-LETE. IX2124.2 +089700 GO TO READ-WRITE-F2-09. IX2124.2 +089800 READ-INVALID-F2-09. IX2124.2 +089900 MOVE "IX-28; 4.5.2 F2, INVALID KEY CONDITION (IX-6) " IX2124.2 +090000 TO RE-MARK. IX2124.2 +090100 PERFORM FAIL. IX2124.2 +090200 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +090300 MOVE "EEE075ALT02" TO CORRECT-A. IX2124.2 +090400 GO TO READ-WRITE-F2-09. IX2124.2 +090500 READ-FAIL-F2-09. IX2124.2 +090600 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +090700 PERFORM FAIL. IX2124.2 +090800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +090900 MOVE "AAA075" TO CORRECT-A. IX2124.2 +091000 READ-WRITE-F2-09. IX2124.2 +091100 PERFORM PRINT-DETAIL. IX2124.2 +091200 REWRITE-TEST-GF-03. IX2124.2 +091300 MOVE "REWRITE...INVALID..." TO FEATURE. IX2124.2 +091400 MOVE "REWRITE-TEST-GF-03" TO PAR-NAME. IX2124.2 +091500 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +091600 MOVE "EEE076ALT02" TO IX-FS1-ALT02. IX2124.2 +091700 REWRITE IX-FS1-RECORD INVALID KEY IX2124.2 +091800 PERFORM PASS IX2124.2 +091900 GO TO REWRITE-WRITE-GF-03. IX2124.2 +092000 GO TO REWRITE-FAIL-GF-03. IX2124.2 +092100 REWRITE-DELETE-GF-03. IX2124.2 +092200 PERFORM DE-LETE. IX2124.2 +092300 GO TO REWRITE-WRITE-GF-03. IX2124.2 +092400 REWRITE-FAIL-GF-03. IX2124.2 +092500 MOVE "IX-33; 4.6.2 & INVALID KEY CONDITION (IX-6) PATH NOT BEIX2124.2 +092600- " TAKEN" TO RE-MARK. IX2124.2 +092700 PERFORM FAIL. IX2124.2 +092800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +092900 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +093000 REWRITE-WRITE-GF-03. IX2124.2 +093100 PERFORM PRINT-DETAIL. IX2124.2 +093200 READ-TEST-F2-10. IX2124.2 +093300 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +093400 MOVE "READ-TEST-F2-10" TO PAR-NAME. IX2124.2 +093500 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +093600 MOVE "KKK018ALT05" TO IX-FS1-ALT05. IX2124.2 +093700 READ IX-FS1 RECORD IX2124.2 +093800 KEY IS IX-FS1-ALT05 IX2124.2 +093900 INVALID KEY PERFORM PASS IX2124.2 +094000 GO TO READ-WRITE-F2-10. IX2124.2 +094100 GO TO READ-FAIL-F2-10. IX2124.2 +094200 READ-DELETE-F2-10. IX2124.2 +094300 PERFORM DE-LETE. IX2124.2 +094400 GO TO READ-WRITE-F2-10. IX2124.2 +094500 READ-FAIL-F2-10. IX2124.2 +094600 MOVE "IX-28; 4.5.2 & INVALID KEY CONDITION (IX-6) PATH NOT BEIX2124.2 +094700- " TAKEN" TO RE-MARK. IX2124.2 +094800 PERFORM FAIL. IX2124.2 +094900 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +095000 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +095100 READ-WRITE-F2-10. IX2124.2 +095200 PERFORM PRINT-DETAIL. IX2124.2 +095300 READ-TEST-F2-11. IX2124.2 +095400 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +095500 MOVE "READ-TEST-F2-11" TO PAR-NAME. IX2124.2 +095600 MOVE "RETRIEVED BY ALTERNATE KEY 9" TO RE-MARK. IX2124.2 +095700 MOVE "SSSSSSALT09" TO IX-FS1-ALT09. IX2124.2 +095800 READ IX-FS1 RECORD IX2124.2 +095900 KEY IS IX-FS1-ALT09 IX2124.2 +096000 INVALID KEY GO TO READ-INVALID-F2-11. IX2124.2 +096100 IF IX-FS1-KEY = "AAA019" IX2124.2 +096200 PERFORM PASS IX2124.2 +096300 ELSE GO TO READ-FAIL-F2-11. IX2124.2 +096400 GO TO READ-WRITE-F2-11. IX2124.2 +096500 READ-DELETE-F2-11. IX2124.2 +096600 PERFORM DE-LETE. IX2124.2 +096700 GO TO READ-WRITE-F2-11. IX2124.2 +096800 READ-INVALID-F2-11. IX2124.2 +096900 MOVE "IX-28; 4.5.2 & INVALID KEY CONDITION (IX-6) PATH BEIX2124.2 +097000- " TAKEN" TO RE-MARK. IX2124.2 +097100 PERFORM FAIL. IX2124.2 +097200 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +097300 MOVE "SSSSSSALT09" TO CORRECT-A. IX2124.2 +097400 GO TO READ-WRITE-F2-11. IX2124.2 +097500 READ-FAIL-F2-11. IX2124.2 +097600 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +097700 PERFORM FAIL. IX2124.2 +097800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +097900 MOVE "AAA019" TO CORRECT-A. IX2124.2 +098000 READ-WRITE-F2-11. IX2124.2 +098100 PERFORM PRINT-DETAIL. IX2124.2 +098200 READ-TEST-F2-12. IX2124.2 +098300 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +098400 MOVE "READ-TEST-F2-12" TO PAR-NAME. IX2124.2 +098500 MOVE "RETRIEVED BY ALTERNATE KEY 7" TO RE-MARK. IX2124.2 +098600 MOVE "OOO026ALT07" TO IX-FS1-ALT07. IX2124.2 +098700 READ IX-FS1 RECORD IX2124.2 +098800 KEY IS IX-FS1-ALT07 IX2124.2 +098900 INVALID KEY GO TO READ-INVALID-F2-12. IX2124.2 +099000 IF IX-FS1-KEY = "AAA026" IX2124.2 +099100 PERFORM PASS IX2124.2 +099200 ELSE GO TO READ-FAIL-F2-12. IX2124.2 +099300 GO TO READ-WRITE-F2-12. IX2124.2 +099400 READ-DELETE-F2-12. IX2124.2 +099500 PERFORM DE-LETE. IX2124.2 +099600 GO TO READ-WRITE-F2-12. IX2124.2 +099700 READ-INVALID-F2-12. IX2124.2 +099800 MOVE "IX-28; 4.5.2 & INVALID KEY CONDITION (IX-6) PATH BEIX2124.2 +099900- " TAKEN" TO RE-MARK. IX2124.2 +100000 PERFORM FAIL. IX2124.2 +100100 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +100200 MOVE "OOO026ALT07" TO CORRECT-A. IX2124.2 +100300 GO TO READ-WRITE-F2-12. IX2124.2 +100400 READ-FAIL-F2-12. IX2124.2 +100500 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2124.2 +100600 PERFORM FAIL. IX2124.2 +100700 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +100800 MOVE "AAA026" TO CORRECT-A. IX2124.2 +100900 READ-WRITE-F2-12. IX2124.2 +101000 PERFORM PRINT-DETAIL. IX2124.2 +101100 DELETE-TEST-GF-03. IX2124.2 +101200 MOVE "DELETE...RECORD" TO FEATURE. IX2124.2 +101300 MOVE "DELETE-TEST-GF-03" TO PAR-NAME. IX2124.2 +101400 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-12" TO RE-MARK. IX2124.2 +101500 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-FAIL-GF-03. IX2124.2 +101600 PERFORM PASS. IX2124.2 +101700 GO TO DELETE-WRITE-GF-03. IX2124.2 +101800 DELETE-DELETE-GF-03. IX2124.2 +101900 PERFORM DE-LETE. IX2124.2 +102000 GO TO DELETE-WRITE-GF-03. IX2124.2 +102100 DELETE-FAIL-GF-03. IX2124.2 +102200 MOVE "IX-21; 4.3.2 & INVALID KEY CONDITION (IX-6) PATH BEIX2124.2 +102300- " TAKEN" TO RE-MARK. IX2124.2 +102400 PERFORM FAIL. IX2124.2 +102500 MOVE "INVALID KEY" TO COMPUTED-A. IX2124.2 +102600 MOVE "AAA026" TO CORRECT-A. IX2124.2 +102700 DELETE-WRITE-GF-03. IX2124.2 +102800 PERFORM PRINT-DETAIL. IX2124.2 +102900 READ-TEST-F2-13. IX2124.2 +103000 MOVE "READ...RECORD KEY" TO FEATURE. IX2124.2 +103100 MOVE "READ-TEST-F2-13" TO PAR-NAME. IX2124.2 +103200 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2124.2 +103300 MOVE "KKK026ALT05" TO IX-FS1-ALT05. IX2124.2 +103400 READ IX-FS1 RECORD IX2124.2 +103500 KEY IS IX-FS1-ALT05 IX2124.2 +103600 INVALID KEY PERFORM PASS IX2124.2 +103700 GO TO READ-WRITE-F2-13. IX2124.2 +103800 GO TO READ-FAIL-F2-13. IX2124.2 +103900 READ-DELETE-F2-13. IX2124.2 +104000 PERFORM DE-LETE. IX2124.2 +104100 GO TO READ-WRITE-F2-13. IX2124.2 +104200 READ-FAIL-F2-13. IX2124.2 +104300 MOVE "IX-28; 4.5.2 & INVALID KEY CONDITION (IX-6) PATH NOT BEIX2124.2 +104400- " TAKEN" TO RE-MARK. IX2124.2 +104500 PERFORM FAIL. IX2124.2 +104600 MOVE IX-FS1-KEY TO COMPUTED-A. IX2124.2 +104700 MOVE "INVALID KEY" TO CORRECT-A. IX2124.2 +104800 READ-WRITE-F2-13. IX2124.2 +104900 PERFORM PRINT-DETAIL. IX2124.2 +105000 CLOSE IX-FS1. IX2124.2 +105100 CCVS-EXIT SECTION. IX2124.2 +105200 CCVS-999999. IX2124.2 +105300 GO TO CLOSE-FILES. IX2124.2 diff --git a/tests/cobol85/IX/IX213A.CBL b/tests/cobol85/IX/IX213A.CBL new file mode 100755 index 00000000..499baeaa --- /dev/null +++ b/tests/cobol85/IX/IX213A.CBL @@ -0,0 +1,1019 @@ +000100 IDENTIFICATION DIVISION. IX2134.2 +000200 PROGRAM-ID. IX2134.2 +000300 IX213A. IX2134.2 +000400**************************************************************** IX2134.2 +000500* * IX2134.2 +000600* VALIDATION FOR:- * IX2134.2 +000700* * IX2134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2134.2 +000900* * IX2134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2134.2 +001100* * IX2134.2 +001200**************************************************************** IX2134.2 +001300* * IX2134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2134.2 +001500* * IX2134.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2134.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2134.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2134.2 +001900* * IX2134.2 +002000**************************************************************** IX2134.2 +002100* THIS PROGRAM CREATES A 100 RECORD FIXED LENGTH INDEXED FILE IX2134.2 +002200* WHOSE ACCESS MODES IS DYNAMIC AND CONTAINS 100 DUPLICATE IX2134.2 +002300* ALTERNATE KEYS. THE INDEXED FILE IS MANIPULATED BY THE IX2134.2 +002400* DUPLICATE ALTERNATE KEYS USING THE FOLLOWING VERBS: IX2134.2 +002500* IX2134.2 +002600* . DELETE IX2134.2 +002700* . READ ... NEXT RECORD IX2134.2 +002800* . READ ... RECORD KEY IX2134.2 +002900* . REWRITE IX2134.2 +003000* . START IX2134.2 +003100* IX2134.2 +003200 ENVIRONMENT DIVISION. IX2134.2 +003300 CONFIGURATION SECTION. IX2134.2 +003400 SOURCE-COMPUTER. IX2134.2 +003500 Linux. IX2134.2 +003600 OBJECT-COMPUTER. IX2134.2 +003700 Linux. IX2134.2 +003800 INPUT-OUTPUT SECTION. IX2134.2 +003900 FILE-CONTROL. IX2134.2 +004000*P SELECT RAW-DATA ASSIGN TO IX2134.2 +004100*P "XXXXX062" IX2134.2 +004200*P ORGANIZATION IS INDEXED IX2134.2 +004300*P ACCESS MODE IS RANDOM IX2134.2 +004400*P RECORD KEY IS RAW-DATA-KEY. IX2134.2 +004500 SELECT PRINT-FILE ASSIGN TO IX2134.2 +004600 "report.log". IX2134.2 +004700 SELECT IX-FS1 IX2134.2 +004800 ASSIGN TO IX2134.2 +004900 "XXXXX024" IX2134.2 +005000*J **** X-CARD UNDEFINED **** IX2134.2 +005100 ACCESS MODE IS DYNAMIC IX2134.2 +005200 RECORD KEY IS IX-FS1-KEY IX2134.2 +005300 ALTERNATE RECORD KEY IS IX-FS1-ALT01 WITH DUPLICATES IX2134.2 +005400 ALTERNATE RECORD KEY IS IX-FS1-ALT02 WITH DUPLICATES IX2134.2 +005500 ALTERNATE RECORD KEY IS IX-FS1-ALT03 WITH DUPLICATES IX2134.2 +005600 ALTERNATE RECORD KEY IS IX-FS1-ALT04 WITH DUPLICATES IX2134.2 +005700 ALTERNATE RECORD KEY IS IX-FS1-ALT05 WITH DUPLICATES IX2134.2 +005800 ALTERNATE RECORD KEY IS IX-FS1-ALT06 WITH DUPLICATES IX2134.2 +005900 ALTERNATE RECORD KEY IS IX-FS1-ALT07 WITH DUPLICATES IX2134.2 +006000 ALTERNATE RECORD KEY IS IX-FS1-ALT08 WITH DUPLICATES IX2134.2 +006100 ALTERNATE RECORD KEY IS IX-FS1-ALT09 WITH DUPLICATES IX2134.2 +006200 ALTERNATE RECORD KEY IS IX-FS1-ALT10 WITH DUPLICATES IX2134.2 +006300 ORGANIZATION IS INDEXED. IX2134.2 +006400 DATA DIVISION. IX2134.2 +006500 FILE SECTION. IX2134.2 +006600*P IX2134.2 +006700*PD RAW-DATA. IX2134.2 +006800*P IX2134.2 +006900*P1 RAW-DATA-SATZ. IX2134.2 +007000*P 05 RAW-DATA-KEY PIC X(6). IX2134.2 +007100*P 05 C-DATE PIC 9(6). IX2134.2 +007200*P 05 C-TIME PIC 9(8). IX2134.2 +007300*P 05 C-NO-OF-TESTS PIC 99. IX2134.2 +007400*P 05 C-OK PIC 999. IX2134.2 +007500*P 05 C-ALL PIC 999. IX2134.2 +007600*P 05 C-FAIL PIC 999. IX2134.2 +007700*P 05 C-DELETED PIC 999. IX2134.2 +007800*P 05 C-INSPECT PIC 999. IX2134.2 +007900*P 05 C-NOTE PIC X(13). IX2134.2 +008000*P 05 C-INDENT PIC X. IX2134.2 +008100*P 05 C-ABORT PIC X(8). IX2134.2 +008200 FD PRINT-FILE. IX2134.2 +008300 01 PRINT-REC PICTURE X(120). IX2134.2 +008400 01 DUMMY-RECORD PICTURE X(120). IX2134.2 +008500 FD IX-FS1 IX2134.2 +008600*C LABEL RECORDS ARE STANDARD IX2134.2 +008700*C DATA RECORD IS IX-FS1-RECORD IX2134.2 +008800 RECORD CONTAINS 116 CHARACTERS. IX2134.2 +008900 01 IX-FS1-RECORD. IX2134.2 +009000 02 IX-FS1-KEY PIC X(6). IX2134.2 +009100 02 IX-FS1-ALT01 PIC X(11). IX2134.2 +009200 02 IX-FS1-ALT02 PIC X(11). IX2134.2 +009300 02 IX-FS1-ALT03 PIC X(11). IX2134.2 +009400 02 IX-FS1-ALT04 PIC X(11). IX2134.2 +009500 02 IX-FS1-ALT05 PIC X(11). IX2134.2 +009600 02 IX-FS1-ALT06 PIC X(11). IX2134.2 +009700 02 IX-FS1-ALT07 PIC X(11). IX2134.2 +009800 02 IX-FS1-ALT08 PIC X(11). IX2134.2 +009900 02 IX-FS1-ALT09 PIC X(11). IX2134.2 +010000 02 IX-FS1-ALT10 PIC X(11). IX2134.2 +010100 WORKING-STORAGE SECTION. IX2134.2 +010200 01 RECORD-COUNTER PIC 999 VALUE ZEROS. IX2134.2 +010300 01 INVKEY-COUNTER PIC 999 VALUE ZEROS. IX2134.2 +010400 01 WORK-RECORD. IX2134.2 +010500 02 FILLER PIC XXX VALUE "AAA". IX2134.2 +010600 02 COUNTER00 PIC 999. IX2134.2 +010700 02 FILLER PIC XXX VALUE "CCC". IX2134.2 +010800 02 COUNTER01 PIC 999. IX2134.2 +010900 02 FILLER PIC X(5) VALUE "ALT01". IX2134.2 +011000 02 FILLER PIC XXX VALUE "EEE". IX2134.2 +011100 02 COUNTER02 PIC 999. IX2134.2 +011200 02 FILLER PIC X(5) VALUE "ALT02". IX2134.2 +011300 02 FILLER PIC XXX VALUE "GGG". IX2134.2 +011400 02 COUNTER03 PIC 999. IX2134.2 +011500 02 FILLER PIC X(5) VALUE "ALT03". IX2134.2 +011600 02 FILLER PIC XXX VALUE "III". IX2134.2 +011700 02 COUNTER04 PIC 999. IX2134.2 +011800 02 FILLER PIC X(5) VALUE "ALT04". IX2134.2 +011900 02 FILLER PIC XXX VALUE "KKK". IX2134.2 +012000 02 COUNTER05 PIC 999. IX2134.2 +012100 02 FILLER PIC X(5) VALUE "ALT05". IX2134.2 +012200 02 FILLER PIC XXX VALUE "MMM". IX2134.2 +012300 02 COUNTER06 PIC 999. IX2134.2 +012400 02 FILLER PIC X(5) VALUE "ALT06". IX2134.2 +012500 02 FILLER PIC XXX VALUE "OOO". IX2134.2 +012600 02 COUNTER07 PIC 999. IX2134.2 +012700 02 FILLER PIC X(5) VALUE "ALT07". IX2134.2 +012800 02 FILLER PIC XXX VALUE "QQQ". IX2134.2 +012900 02 COUNTER08 PIC 999. IX2134.2 +013000 02 FILLER PIC X(5) VALUE "ALT08". IX2134.2 +013100 02 FILLER PIC XXX VALUE "SSS". IX2134.2 +013200 02 COUNTER09 PIC 999. IX2134.2 +013300 02 FILLER PIC X(5) VALUE "ALT09". IX2134.2 +013400 02 FILLER PIC XXX VALUE "UUU". IX2134.2 +013500 02 COUNTER10 PIC 999. IX2134.2 +013600 02 FILLER PIC X(5) VALUE "ALT10". IX2134.2 +013700 01 TEST-RESULTS. IX2134.2 +013800 02 FILLER PIC X VALUE SPACE. IX2134.2 +013900 02 FEATURE PIC X(20) VALUE SPACE. IX2134.2 +014000 02 FILLER PIC X VALUE SPACE. IX2134.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. IX2134.2 +014200 02 FILLER PIC X VALUE SPACE. IX2134.2 +014300 02 PAR-NAME. IX2134.2 +014400 03 FILLER PIC X(19) VALUE SPACE. IX2134.2 +014500 03 PARDOT-X PIC X VALUE SPACE. IX2134.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. IX2134.2 +014700 02 FILLER PIC X(8) VALUE SPACE. IX2134.2 +014800 02 RE-MARK PIC X(61). IX2134.2 +014900 01 TEST-COMPUTED. IX2134.2 +015000 02 FILLER PIC X(30) VALUE SPACE. IX2134.2 +015100 02 FILLER PIC X(17) VALUE IX2134.2 +015200 " COMPUTED=". IX2134.2 +015300 02 COMPUTED-X. IX2134.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2134.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A IX2134.2 +015600 PIC -9(9).9(9). IX2134.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2134.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2134.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2134.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. IX2134.2 +016100 04 COMPUTED-18V0 PIC -9(18). IX2134.2 +016200 04 FILLER PIC X. IX2134.2 +016300 03 FILLER PIC X(50) VALUE SPACE. IX2134.2 +016400 01 TEST-CORRECT. IX2134.2 +016500 02 FILLER PIC X(30) VALUE SPACE. IX2134.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". IX2134.2 +016700 02 CORRECT-X. IX2134.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. IX2134.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2134.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2134.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2134.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2134.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. IX2134.2 +017400 04 CORRECT-18V0 PIC -9(18). IX2134.2 +017500 04 FILLER PIC X. IX2134.2 +017600 03 FILLER PIC X(2) VALUE SPACE. IX2134.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2134.2 +017800 01 CCVS-C-1. IX2134.2 +017900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2134.2 +018000- "SS PARAGRAPH-NAME IX2134.2 +018100- " REMARKS". IX2134.2 +018200 02 FILLER PIC X(20) VALUE SPACE. IX2134.2 +018300 01 CCVS-C-2. IX2134.2 +018400 02 FILLER PIC X VALUE SPACE. IX2134.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". IX2134.2 +018600 02 FILLER PIC X(15) VALUE SPACE. IX2134.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". IX2134.2 +018800 02 FILLER PIC X(94) VALUE SPACE. IX2134.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2134.2 +019000 01 REC-CT PIC 99 VALUE ZERO. IX2134.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2134.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2134.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2134.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2134.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2134.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2134.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2134.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2134.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2134.2 +020000 01 CCVS-H-1. IX2134.2 +020100 02 FILLER PIC X(39) VALUE SPACES. IX2134.2 +020200 02 FILLER PIC X(42) VALUE IX2134.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2134.2 +020400 02 FILLER PIC X(39) VALUE SPACES. IX2134.2 +020500 01 CCVS-H-2A. IX2134.2 +020600 02 FILLER PIC X(40) VALUE SPACE. IX2134.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2134.2 +020800 02 FILLER PIC XXXX VALUE IX2134.2 +020900 "4.2 ". IX2134.2 +021000 02 FILLER PIC X(28) VALUE IX2134.2 +021100 " COPY - NOT FOR DISTRIBUTION". IX2134.2 +021200 02 FILLER PIC X(41) VALUE SPACE. IX2134.2 +021300 IX2134.2 +021400 01 CCVS-H-2B. IX2134.2 +021500 02 FILLER PIC X(15) VALUE IX2134.2 +021600 "TEST RESULT OF ". IX2134.2 +021700 02 TEST-ID PIC X(9). IX2134.2 +021800 02 FILLER PIC X(4) VALUE IX2134.2 +021900 " IN ". IX2134.2 +022000 02 FILLER PIC X(12) VALUE IX2134.2 +022100 " HIGH ". IX2134.2 +022200 02 FILLER PIC X(22) VALUE IX2134.2 +022300 " LEVEL VALIDATION FOR ". IX2134.2 +022400 02 FILLER PIC X(58) VALUE IX2134.2 +022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2134.2 +022600 01 CCVS-H-3. IX2134.2 +022700 02 FILLER PIC X(34) VALUE IX2134.2 +022800 " FOR OFFICIAL USE ONLY ". IX2134.2 +022900 02 FILLER PIC X(58) VALUE IX2134.2 +023000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2134.2 +023100 02 FILLER PIC X(28) VALUE IX2134.2 +023200 " COPYRIGHT 1985 ". IX2134.2 +023300 01 CCVS-E-1. IX2134.2 +023400 02 FILLER PIC X(52) VALUE SPACE. IX2134.2 +023500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2134.2 +023600 02 ID-AGAIN PIC X(9). IX2134.2 +023700 02 FILLER PIC X(45) VALUE SPACES. IX2134.2 +023800 01 CCVS-E-2. IX2134.2 +023900 02 FILLER PIC X(31) VALUE SPACE. IX2134.2 +024000 02 FILLER PIC X(21) VALUE SPACE. IX2134.2 +024100 02 CCVS-E-2-2. IX2134.2 +024200 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2134.2 +024300 03 FILLER PIC X VALUE SPACE. IX2134.2 +024400 03 ENDER-DESC PIC X(44) VALUE IX2134.2 +024500 "ERRORS ENCOUNTERED". IX2134.2 +024600 01 CCVS-E-3. IX2134.2 +024700 02 FILLER PIC X(22) VALUE IX2134.2 +024800 " FOR OFFICIAL USE ONLY". IX2134.2 +024900 02 FILLER PIC X(12) VALUE SPACE. IX2134.2 +025000 02 FILLER PIC X(58) VALUE IX2134.2 +025100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2134.2 +025200 02 FILLER PIC X(13) VALUE SPACE. IX2134.2 +025300 02 FILLER PIC X(15) VALUE IX2134.2 +025400 " COPYRIGHT 1985". IX2134.2 +025500 01 CCVS-E-4. IX2134.2 +025600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2134.2 +025700 02 FILLER PIC X(4) VALUE " OF ". IX2134.2 +025800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2134.2 +025900 02 FILLER PIC X(40) VALUE IX2134.2 +026000 " TESTS WERE EXECUTED SUCCESSFULLY". IX2134.2 +026100 01 XXINFO. IX2134.2 +026200 02 FILLER PIC X(19) VALUE IX2134.2 +026300 "*** INFORMATION ***". IX2134.2 +026400 02 INFO-TEXT. IX2134.2 +026500 04 FILLER PIC X(8) VALUE SPACE. IX2134.2 +026600 04 XXCOMPUTED PIC X(20). IX2134.2 +026700 04 FILLER PIC X(5) VALUE SPACE. IX2134.2 +026800 04 XXCORRECT PIC X(20). IX2134.2 +026900 02 INF-ANSI-REFERENCE PIC X(48). IX2134.2 +027000 01 HYPHEN-LINE. IX2134.2 +027100 02 FILLER PIC IS X VALUE IS SPACE. IX2134.2 +027200 02 FILLER PIC IS X(65) VALUE IS "************************IX2134.2 +027300- "*****************************************". IX2134.2 +027400 02 FILLER PIC IS X(54) VALUE IS "************************IX2134.2 +027500- "******************************". IX2134.2 +027600 01 CCVS-PGM-ID PIC X(9) VALUE IX2134.2 +027700 "IX213A". IX2134.2 +027800 PROCEDURE DIVISION. IX2134.2 +027900 CCVS1 SECTION. IX2134.2 +028000 OPEN-FILES. IX2134.2 +028100*P OPEN I-O RAW-DATA. IX2134.2 +028200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2134.2 +028300*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2134.2 +028400*P MOVE "ABORTED " TO C-ABORT. IX2134.2 +028500*P ADD 1 TO C-NO-OF-TESTS. IX2134.2 +028600*P ACCEPT C-DATE FROM DATE. IX2134.2 +028700*P ACCEPT C-TIME FROM TIME. IX2134.2 +028800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2134.2 +028900*PND-E-1. IX2134.2 +029000*P CLOSE RAW-DATA. IX2134.2 +029100 OPEN OUTPUT PRINT-FILE. IX2134.2 +029200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2134.2 +029300 MOVE SPACE TO TEST-RESULTS. IX2134.2 +029400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2134.2 +029500 GO TO CCVS1-EXIT. IX2134.2 +029600 CLOSE-FILES. IX2134.2 +029700*P OPEN I-O RAW-DATA. IX2134.2 +029800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2134.2 +029900*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2134.2 +030000*P MOVE "OK. " TO C-ABORT. IX2134.2 +030100*P MOVE PASS-COUNTER TO C-OK. IX2134.2 +030200*P MOVE ERROR-HOLD TO C-ALL. IX2134.2 +030300*P MOVE ERROR-COUNTER TO C-FAIL. IX2134.2 +030400*P MOVE DELETE-COUNTER TO C-DELETED. IX2134.2 +030500*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2134.2 +030600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2134.2 +030700*PND-E-2. IX2134.2 +030800*P CLOSE RAW-DATA. IX2134.2 +030900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2134.2 +031000 TERMINATE-CCVS. IX2134.2 +031100*S EXIT PROGRAM. IX2134.2 +031200*SERMINATE-CALL. IX2134.2 +031300 STOP RUN. IX2134.2 +031400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2134.2 +031500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2134.2 +031600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2134.2 +031700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2134.2 +031800 MOVE "****TEST DELETED****" TO RE-MARK. IX2134.2 +031900 PRINT-DETAIL. IX2134.2 +032000 IF REC-CT NOT EQUAL TO ZERO IX2134.2 +032100 MOVE "." TO PARDOT-X IX2134.2 +032200 MOVE REC-CT TO DOTVALUE. IX2134.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2134.2 +032400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2134.2 +032500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2134.2 +032600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2134.2 +032700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2134.2 +032800 MOVE SPACE TO CORRECT-X. IX2134.2 +032900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2134.2 +033000 MOVE SPACE TO RE-MARK. IX2134.2 +033100 HEAD-ROUTINE. IX2134.2 +033200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +033300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +033400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2134.2 +033500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2134.2 +033600 COLUMN-NAMES-ROUTINE. IX2134.2 +033700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +033800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +034000 END-ROUTINE. IX2134.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2134.2 +034200 END-RTN-EXIT. IX2134.2 +034300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +034400 END-ROUTINE-1. IX2134.2 +034500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2134.2 +034600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2134.2 +034700 ADD PASS-COUNTER TO ERROR-HOLD. IX2134.2 +034800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2134.2 +034900 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2134.2 +035000 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2134.2 +035100 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2134.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2134.2 +035300 END-ROUTINE-12. IX2134.2 +035400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2134.2 +035500 IF ERROR-COUNTER IS EQUAL TO ZERO IX2134.2 +035600 MOVE "NO " TO ERROR-TOTAL IX2134.2 +035700 ELSE IX2134.2 +035800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2134.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2134.2 +036000 PERFORM WRITE-LINE. IX2134.2 +036100 END-ROUTINE-13. IX2134.2 +036200 IF DELETE-COUNTER IS EQUAL TO ZERO IX2134.2 +036300 MOVE "NO " TO ERROR-TOTAL ELSE IX2134.2 +036400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2134.2 +036500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2134.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +036700 IF INSPECT-COUNTER EQUAL TO ZERO IX2134.2 +036800 MOVE "NO " TO ERROR-TOTAL IX2134.2 +036900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2134.2 +037000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2134.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +037200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2134.2 +037300 WRITE-LINE. IX2134.2 +037400 ADD 1 TO RECORD-COUNT. IX2134.2 +037500 IF RECORD-COUNT GREATER 42 IX2134.2 +037600 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2134.2 +037700 MOVE SPACE TO DUMMY-RECORD IX2134.2 +037800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2134.2 +037900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2134.2 +038000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2134.2 +038100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2134.2 +038200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2134.2 +038300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2134.2 +038400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2134.2 +038500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2134.2 +038600 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2134.2 +038700 MOVE ZERO TO RECORD-COUNT. IX2134.2 +038800 PERFORM WRT-LN. IX2134.2 +038900 WRT-LN. IX2134.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2134.2 +039100 MOVE SPACE TO DUMMY-RECORD. IX2134.2 +039200 BLANK-LINE-PRINT. IX2134.2 +039300 PERFORM WRT-LN. IX2134.2 +039400 FAIL-ROUTINE. IX2134.2 +039500 IF COMPUTED-X NOT EQUAL TO SPACE IX2134.2 +039600 GO TO FAIL-ROUTINE-WRITE. IX2134.2 +039700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2134.2 +039800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2134.2 +039900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2134.2 +040000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +040100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2134.2 +040200 GO TO FAIL-ROUTINE-EX. IX2134.2 +040300 FAIL-ROUTINE-WRITE. IX2134.2 +040400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2134.2 +040500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2134.2 +040600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2134.2 +040700 MOVE SPACES TO COR-ANSI-REFERENCE. IX2134.2 +040800 FAIL-ROUTINE-EX. EXIT. IX2134.2 +040900 BAIL-OUT. IX2134.2 +041000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2134.2 +041100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2134.2 +041200 BAIL-OUT-WRITE. IX2134.2 +041300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2134.2 +041400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2134.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2134.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2134.2 +041700 BAIL-OUT-EX. EXIT. IX2134.2 +041800 CCVS1-EXIT. IX2134.2 +041900 EXIT. IX2134.2 +042000 WRITE-INIT-GF-01. IX2134.2 +042100 OPEN OUTPUT IX-FS1. IX2134.2 +042200 PERFORM CREATE-IX-FS1 VARYING RECORD-COUNTER FROM 1 BY 1 IX2134.2 +042300 UNTIL RECORD-COUNTER IS GREATER THAN 100. IX2134.2 +042400 CREATE-IX-FS1. IX2134.2 +042500 MOVE RECORD-COUNTER TO COUNTER00, COUNTER01, COUNTER02, IX2134.2 +042600 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +042700 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +042800 IF RECORD-COUNTER = 011 MOVE 010 TO COUNTER01, COUNTER02, IX2134.2 +042900 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +043000 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +043100 IF RECORD-COUNTER = 021 MOVE 020 TO COUNTER01, COUNTER02, IX2134.2 +043200 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +043300 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +043400 IF RECORD-COUNTER = 031 MOVE 030 TO COUNTER01, COUNTER02, IX2134.2 +043500 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +043600 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +043700 IF RECORD-COUNTER = 041 MOVE 040 TO COUNTER01, COUNTER02, IX2134.2 +043800 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +043900 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +044000 IF RECORD-COUNTER = 051 MOVE 050 TO COUNTER01, COUNTER02, IX2134.2 +044100 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +044200 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +044300 IF RECORD-COUNTER = 061 MOVE 060 TO COUNTER01, COUNTER02, IX2134.2 +044400 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +044500 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +044600 IF RECORD-COUNTER = 071 MOVE 070 TO COUNTER01, COUNTER02, IX2134.2 +044700 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +044800 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +044900 IF RECORD-COUNTER = 081 MOVE 080 TO COUNTER01, COUNTER02, IX2134.2 +045000 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +045100 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +045200 IF RECORD-COUNTER = 091 MOVE 090 TO COUNTER01, COUNTER02, IX2134.2 +045300 COUNTER03, COUNTER04, COUNTER05, COUNTER06, COUNTER07, IX2134.2 +045400 COUNTER08, COUNTER09, COUNTER10. IX2134.2 +045500 WRITE IX-FS1-RECORD FROM WORK-RECORD INVALID KEY IX2134.2 +045600 ADD 1 TO INVKEY-COUNTER. IX2134.2 +045700 WRITE-TEST-GD-01. IX2134.2 +045800 MOVE "WRITE INVALID KEY" TO FEATURE. IX2134.2 +045900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2134.2 +046000 MOVE "CREATE IX-FS1" TO RE-MARK. IX2134.2 +046100 IF INVKEY-COUNTER = 0 IX2134.2 +046200 PERFORM PASS IX2134.2 +046300 ELSE GO TO WRITE-FAIL-GF-01. IX2134.2 +046400 GO TO WRITE-WRITE-GF-01. IX2134.2 +046500 INDEX-DELETE-1. IX2134.2 +046600 PERFORM DE-LETE. IX2134.2 +046700 GO TO WRITE-WRITE-GF-01. IX2134.2 +046800 WRITE-FAIL-GF-01. IX2134.2 +046900 MOVE "IX-41; 4.9.2, FILE NOT CREATED CORRECTLY" TO RE-MARK. IX2134.2 +047000 PERFORM FAIL. IX2134.2 +047100 MOVE INVKEY-COUNTER TO COMPUTED-18V0. IX2134.2 +047200 MOVE 0 TO CORRECT-18V0. IX2134.2 +047300 WRITE-WRITE-GF-01. IX2134.2 +047400 PERFORM PRINT-DETAIL. IX2134.2 +047500 READ-TEST-F2-01. IX2134.2 +047600 CLOSE IX-FS1. IX2134.2 +047700 OPEN I-O IX-FS1. IX2134.2 +047800 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +047900 MOVE "READ-TEST-F2-01" TO PAR-NAME. IX2134.2 +048000 MOVE "RETRIEVED BY ALTERNATE KEY 1" TO RE-MARK. IX2134.2 +048100 MOVE "CCC050ALT01" TO IX-FS1-ALT01. IX2134.2 +048200 READ IX-FS1 RECORD IX2134.2 +048300 KEY IS IX-FS1-ALT01 IX2134.2 +048400 INVALID KEY GO TO READ-INVALID-F2-01. IX2134.2 +048500 IF IX-FS1-KEY = "AAA050" IX2134.2 +048600 PERFORM PASS IX2134.2 +048700 ELSE GO TO READ-FAIL-F2-01. IX2134.2 +048800 GO TO READ-WRITE-F2-01. IX2134.2 +048900 READ-DELETE-F2-01. IX2134.2 +049000 PERFORM DE-LETE. IX2134.2 +049100 GO TO READ-WRITE-F2-01. IX2134.2 +049200 READ-INVALID-F2-01. IX2134.2 +049300 MOVE "IX-28; 4.5.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +049400 TO RE-MARK. IX2134.2 +049500 PERFORM FAIL. IX2134.2 +049600 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +049700 MOVE "CCC050ALT01" TO CORRECT-A. IX2134.2 +049800 GO TO READ-WRITE-F2-01. IX2134.2 +049900 READ-FAIL-F2-01. IX2134.2 +050000 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +050100 PERFORM FAIL. IX2134.2 +050200 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +050300 MOVE "AAA050" TO CORRECT-A. IX2134.2 +050400 READ-WRITE-F2-01. IX2134.2 +050500 PERFORM PRINT-DETAIL. IX2134.2 +050600 READ-TEST-F2-02. IX2134.2 +050700 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +050800 MOVE "READ-TEST-F2-02" TO PAR-NAME. IX2134.2 +050900 MOVE "RETRIEVED BY ALTERNATE KEY 8" TO RE-MARK. IX2134.2 +051000 MOVE "QQQ040ALT08" TO IX-FS1-ALT08. IX2134.2 +051100 READ IX-FS1 RECORD IX2134.2 +051200 KEY IS IX-FS1-ALT08 IX2134.2 +051300 INVALID KEY GO TO READ-INVALID-F2-02. IX2134.2 +051400 IF IX-FS1-KEY = "AAA040" IX2134.2 +051500 PERFORM PASS IX2134.2 +051600 ELSE GO TO READ-FAIL-F2-02. IX2134.2 +051700 GO TO READ-WRITE-F2-02. IX2134.2 +051800 READ-DELETE-F2-02. IX2134.2 +051900 PERFORM DE-LETE. IX2134.2 +052000 GO TO READ-WRITE-F2-02. IX2134.2 +052100 READ-INVALID-F2-02. IX2134.2 +052200 MOVE "IX-28; 4.5.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +052300 TO RE-MARK. IX2134.2 +052400 PERFORM FAIL. IX2134.2 +052500 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +052600 MOVE "QQQ040ALT08" TO CORRECT-A. IX2134.2 +052700 GO TO READ-WRITE-F2-02. IX2134.2 +052800 READ-FAIL-F2-02. IX2134.2 +052900 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +053000 PERFORM FAIL. IX2134.2 +053100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +053200 MOVE "AAA040" TO CORRECT-A. IX2134.2 +053300 READ-WRITE-F2-02. IX2134.2 +053400 PERFORM PRINT-DETAIL. IX2134.2 +053500 DELETE-TEST-GF-01. IX2134.2 +053600 MOVE "DELETE...RECORD" TO FEATURE. IX2134.2 +053700 MOVE "DELETE-TEST-GF-01" TO PAR-NAME. IX2134.2 +053800 MOVE "DELETES RECORD FOUND IN READ-TEST-GF-02" TO RE-MARK. IX2134.2 +053900 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-INVALID-GF-01. IX2134.2 +054000 PERFORM PASS. IX2134.2 +054100 GO TO DELETE-WRITE-GF-01. IX2134.2 +054200 DELETE-DELETE-GF-01. IX2134.2 +054300 PERFORM DE-LETE. IX2134.2 +054400 GO TO DELETE-WRITE-GF-01. IX2134.2 +054500 DELETE-INVALID-GF-01. IX2134.2 +054600 MOVE "IX-21; 4.3.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +054700 TO RE-MARK. IX2134.2 +054800 PERFORM FAIL. IX2134.2 +054900 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +055000 MOVE "AAA040" TO CORRECT-A. IX2134.2 +055100 DELETE-WRITE-GF-01. IX2134.2 +055200 PERFORM PRINT-DETAIL. IX2134.2 +055300 READ-TEST-F2-03. IX2134.2 +055400 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +055500 MOVE "READ-TEST-F2-03" TO PAR-NAME. IX2134.2 +055600 MOVE "RETRIEVED BY ALTERNATE KEY 4" TO RE-MARK. IX2134.2 +055700 MOVE "III030ALT04" TO IX-FS1-ALT04. IX2134.2 +055800 READ IX-FS1 RECORD IX2134.2 +055900 KEY IS IX-FS1-ALT04 IX2134.2 +056000 INVALID KEY GO TO READ-INVALID-F2-03. IX2134.2 +056100 IF IX-FS1-KEY = "AAA030" IX2134.2 +056200 PERFORM PASS IX2134.2 +056300 ELSE GO TO READ-FAIL-F2-03. IX2134.2 +056400 GO TO READ-WRITE-F2-03. IX2134.2 +056500 READ-DELETE-F2-03. IX2134.2 +056600 PERFORM DE-LETE. IX2134.2 +056700 GO TO READ-WRITE-F2-03. IX2134.2 +056800 READ-INVALID-F2-03. IX2134.2 +056900 MOVE "IX-28; 4.5.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +057000 TO RE-MARK. IX2134.2 +057100 PERFORM FAIL. IX2134.2 +057200 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +057300 MOVE "III030ALT04" TO CORRECT-A. IX2134.2 +057400 GO TO READ-WRITE-F2-03. IX2134.2 +057500 READ-FAIL-F2-03. IX2134.2 +057600 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +057700 PERFORM FAIL. IX2134.2 +057800 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +057900 MOVE "AAA030" TO CORRECT-A. IX2134.2 +058000 READ-WRITE-F2-03. IX2134.2 +058100 PERFORM PRINT-DETAIL. IX2134.2 +058200 REWRITE-TEST-GF-01. IX2134.2 +058300 MOVE "REWRITE...INVALID..." TO FEATURE. IX2134.2 +058400 MOVE "REWRITE-TEST-GF-01" TO PAR-NAME. IX2134.2 +058500 MOVE "REWRITE-S RECORD FOUND IN READ-TEST-F2-03" TO RE-MARK. IX2134.2 +058600 MOVE "IIIIIIALT04" TO IX-FS1-ALT04. IX2134.2 +058700 REWRITE IX-FS1-RECORD INVALID KEY IX2134.2 +058800 GO TO REWRITE-INVALID-GF-01. IX2134.2 +058900 PERFORM PASS. IX2134.2 +059000 GO TO REWRITE-WRITE-GF-01. IX2134.2 +059100 REWRITE-DELETE-GF-01. IX2134.2 +059200 PERFORM DE-LETE. IX2134.2 +059300 GO TO REWRITE-WRITE-GF-01. IX2134.2 +059400 REWRITE-INVALID-GF-01. IX2134.2 +059500 MOVE "IX-33; 4.6.2 AND IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +059600 TO RE-MARK. IX2134.2 +059700 PERFORM FAIL. IX2134.2 +059800 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +059900 MOVE "IIIIIIALT04" TO CORRECT-A. IX2134.2 +060000 REWRITE-WRITE-GF-01. IX2134.2 +060100 PERFORM PRINT-DETAIL. IX2134.2 +060200 READ-TEST-F2-04. IX2134.2 +060300 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +060400 MOVE "READ-TEST-F2-04" TO PAR-NAME. IX2134.2 +060500 MOVE "INVALID KEY PATH SHOULD BE TAKEN" TO RE-MARK. IX2134.2 +060600 MOVE "ZZZ999ALT09" TO IX-FS1-ALT09. IX2134.2 +060700 READ IX-FS1 RECORD IX2134.2 +060800 KEY IS IX-FS1-ALT09 IX2134.2 +060900 INVALID KEY PERFORM PASS IX2134.2 +061000 GO TO READ-WRITE-F2-04. IX2134.2 +061100 GO TO READ-FAIL-F2-04. IX2134.2 +061200 READ-DELETE-F2-04. IX2134.2 +061300 PERFORM DE-LETE. IX2134.2 +061400 GO TO READ-WRITE-F2-04. IX2134.2 +061500 READ-FAIL-F2-04. IX2134.2 +061600 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY SHOULD BE TAKEN" IX2134.2 +061700 TO RE-MARK. IX2134.2 +061800 PERFORM FAIL. IX2134.2 +061900 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +062000 MOVE "INVALID KEY" TO CORRECT-A. IX2134.2 +062100 READ-WRITE-F2-04. IX2134.2 +062200 PERFORM PRINT-DETAIL. IX2134.2 +062300 START-TEST-GF-01. IX2134.2 +062400 MOVE "START...KEY IS EQUAL" TO FEATURE. IX2134.2 +062500 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2134.2 +062600 MOVE "RETRIEVED BY ALTERNATE KEY 3" TO RE-MARK. IX2134.2 +062700 MOVE "GGG020ALT03" TO IX-FS1-ALT03. IX2134.2 +062800 START IX-FS1 IX2134.2 +062900 KEY IS EQUAL TO IX-FS1-ALT03 IX2134.2 +063000 INVALID KEY GO TO START-INVALID-GF-01. IX2134.2 +063100 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-01. IX2134.2 +063200 IF IX-FS1-KEY = "AAA020" IX2134.2 +063300 PERFORM PASS IX2134.2 +063400 ELSE GO TO START-FAIL-GF-01. IX2134.2 +063500 GO TO START-WRITE-GF-01. IX2134.2 +063600 START-DELETE-GF-01. IX2134.2 +063700 PERFORM DE-LETE. IX2134.2 +063800 GO TO START-WRITE-GF-01. IX2134.2 +063900 START-INVALID-GF-01. IX2134.2 +064000 MOVE "IX-36; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +064100 TO RE-MARK. IX2134.2 +064200 PERFORM FAIL. IX2134.2 +064300 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +064400 MOVE "GGG020ALT03" TO CORRECT-A. IX2134.2 +064500 GO TO START-WRITE-GF-01. IX2134.2 +064600 START-END-GF-01. IX2134.2 +064700 MOVE "IX-28; 4.5.2 F1, READ AT END NOT EXPECTED" TO RE-MARK. IX2134.2 +064800 PERFORM FAIL. IX2134.2 +064900 MOVE "FILE IS AT END" TO COMPUTED-A. IX2134.2 +065000 MOVE "AAA020" TO CORRECT-A. IX2134.2 +065100 GO TO START-WRITE-GF-01. IX2134.2 +065200 START-FAIL-GF-01. IX2134.2 +065300 PERFORM FAIL. IX2134.2 +065400 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +065500 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +065600 MOVE "AAA020" TO CORRECT-A. IX2134.2 +065700 START-WRITE-GF-01. IX2134.2 +065800 PERFORM PRINT-DETAIL. IX2134.2 +065900 START-TEST-GF-02. IX2134.2 +066000 MOVE "START...KEY >" TO FEATURE. IX2134.2 +066100 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2134.2 +066200 MOVE "RETRIEVED BY ALTERNATE KEY 6" TO RE-MARK. IX2134.2 +066300 MOVE "MMM090ALT06" TO IX-FS1-ALT06. IX2134.2 +066400 START IX-FS1 IX2134.2 +066500 KEY > IX-FS1-ALT06 IX2134.2 +066600 INVALID KEY GO TO START-INVALID-GF-02. IX2134.2 +066700 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-02. IX2134.2 +066800 IF IX-FS1-KEY = "AAA092" IX2134.2 +066900 PERFORM PASS IX2134.2 +067000 ELSE GO TO START-INVALID-GF-02. IX2134.2 +067100 GO TO START-WRITE-GF-02. IX2134.2 +067200 START-DELETE-GF-02. IX2134.2 +067300 PERFORM DE-LETE. IX2134.2 +067400 GO TO START-WRITE-GF-02. IX2134.2 +067500 START-INVALID-GF-02. IX2134.2 +067600 MOVE "IX-36; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +067700 TO RE-MARK. IX2134.2 +067800 PERFORM FAIL. IX2134.2 +067900 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +068000 MOVE "MMM090ALT09" TO CORRECT-A. IX2134.2 +068100 GO TO START-WRITE-GF-02. IX2134.2 +068200 START-END-GF-02. IX2134.2 +068300 MOVE "IX-28; 4.5.2 F1, READ AT END NOT EXPECTED" TO RE-MARK. IX2134.2 +068400 PERFORM FAIL. IX2134.2 +068500 MOVE "FILE IS AT END" TO COMPUTED-A. IX2134.2 +068600 MOVE "AAA092" TO CORRECT-A. IX2134.2 +068700 GO TO START-WRITE-GF-02. IX2134.2 +068800 START-FAIL-GF-02. IX2134.2 +068900 MOVE "IX-28; 4.5.2 F1, WRONG KEY " TO RE-MARK. IX2134.2 +069000 PERFORM FAIL. IX2134.2 +069100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +069200 MOVE "AAA092" TO CORRECT-A. IX2134.2 +069300 START-WRITE-GF-02. IX2134.2 +069400 PERFORM PRINT-DETAIL. IX2134.2 +069500 START-TEST-GF-03. IX2134.2 +069600 MOVE "START...KEY >" TO FEATURE. IX2134.2 +069700 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2134.2 +069800 MOVE "RETRIEVED BY ALTERNATE KEY 10" TO RE-MARK. IX2134.2 +069900 MOVE "UUU080ALT10" TO IX-FS1-ALT10. IX2134.2 +070000 START IX-FS1 IX2134.2 +070100 KEY > IX-FS1-ALT10 IX2134.2 +070200 INVALID KEY GO TO START-INVALID-GF-03. IX2134.2 +070300 READ IX-FS1 NEXT RECORD AT END GO TO START-END-GF-03. IX2134.2 +070400 IF IX-FS1-KEY = "AAA082" IX2134.2 +070500 PERFORM PASS IX2134.2 +070600 ELSE GO TO START-FAIL-GF-03. IX2134.2 +070700 GO TO START-WRITE-GF-03. IX2134.2 +070800 START-DELETE-GF-03. IX2134.2 +070900 PERFORM DE-LETE. IX2134.2 +071000 GO TO START-WRITE-GF-03. IX2134.2 +071100 START-INVALID-GF-03. IX2134.2 +071200 MOVE "IX-36; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +071300 TO RE-MARK. IX2134.2 +071400 PERFORM FAIL. IX2134.2 +071500 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +071600 MOVE "UUU080ALT10" TO CORRECT-A. IX2134.2 +071700 GO TO START-WRITE-GF-03. IX2134.2 +071800 START-END-GF-03. IX2134.2 +071900 MOVE "IX-28; 4.5.2 F1, READ AT END NOT EXPECTED" TO RE-MARK. IX2134.2 +072000 PERFORM FAIL. IX2134.2 +072100 MOVE "FILE IS AT END" TO COMPUTED-A. IX2134.2 +072200 MOVE "AAA082" TO CORRECT-A. IX2134.2 +072300 GO TO START-WRITE-GF-03. IX2134.2 +072400 START-FAIL-GF-03. IX2134.2 +072500 MOVE "IX-28; 4.5.2 F1, WRONG KEY " TO RE-MARK. IX2134.2 +072600 PERFORM FAIL. IX2134.2 +072700 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +072800 MOVE "AAA082" TO CORRECT-A. IX2134.2 +072900 START-WRITE-GF-03. IX2134.2 +073000 PERFORM PRINT-DETAIL. IX2134.2 +073100 READ-TEST-F2-05. IX2134.2 +073200 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +073300 MOVE "READ-TEST-F2-05" TO PAR-NAME. IX2134.2 +073400 MOVE "RETRIEVED BY ALTERNATE KEY 8" TO RE-MARK. IX2134.2 +073500 MOVE "QQQ040ALT08" TO IX-FS1-ALT08. IX2134.2 +073600 READ IX-FS1 RECORD IX2134.2 +073700 KEY IS IX-FS1-ALT08 IX2134.2 +073800 INVALID KEY GO TO READ-INVALID-F2-05. IX2134.2 +073900 IF IX-FS1-KEY = "AAA041" IX2134.2 +074000 PERFORM PASS IX2134.2 +074100 ELSE GO TO READ-FAIL-F2-05. IX2134.2 +074200 GO TO READ-WRITE-F2-05. IX2134.2 +074300 READ-DELETE-F2-05. IX2134.2 +074400 PERFORM DE-LETE. IX2134.2 +074500 GO TO READ-WRITE-F2-05. IX2134.2 +074600 READ-INVALID-F2-05. IX2134.2 +074700 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +074800 TO RE-MARK. IX2134.2 +074900 PERFORM FAIL. IX2134.2 +075000 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +075100 MOVE "QQQ040ALT08" TO CORRECT-A. IX2134.2 +075200 GO TO READ-WRITE-F2-05. IX2134.2 +075300 READ-FAIL-F2-05. IX2134.2 +075400 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +075500 PERFORM FAIL. IX2134.2 +075600 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +075700 MOVE "AAA041" TO CORRECT-A. IX2134.2 +075800 READ-WRITE-F2-05. IX2134.2 +075900 PERFORM PRINT-DETAIL. IX2134.2 +076000 READ-TEST-F2-06. IX2134.2 +076100 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +076200 MOVE "READ-TEST-F2-06" TO PAR-NAME. IX2134.2 +076300 MOVE "RETRIEVED BY ALTERNATE KEY 4" TO RE-MARK. IX2134.2 +076400 MOVE "IIIIIIALT04" TO IX-FS1-ALT04. IX2134.2 +076500 READ IX-FS1 RECORD IX2134.2 +076600 KEY IS IX-FS1-ALT04 IX2134.2 +076700 INVALID KEY GO TO READ-INVALID-F2-06. IX2134.2 +076800 IF IX-FS1-KEY = "AAA030" IX2134.2 +076900 PERFORM PASS IX2134.2 +077000 ELSE GO TO READ-FAIL-F2-06. IX2134.2 +077100 GO TO READ-WRITE-F2-06. IX2134.2 +077200 READ-DELETE-F2-06. IX2134.2 +077300 PERFORM DE-LETE. IX2134.2 +077400 GO TO READ-WRITE-F2-06. IX2134.2 +077500 READ-INVALID-F2-06. IX2134.2 +077600 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +077700 TO RE-MARK. IX2134.2 +077800 PERFORM FAIL. IX2134.2 +077900 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +078000 MOVE "IIIIIIALT04" TO CORRECT-A. IX2134.2 +078100 GO TO READ-WRITE-F2-06. IX2134.2 +078200 READ-FAIL-F2-06. IX2134.2 +078300 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +078400 PERFORM FAIL. IX2134.2 +078500 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +078600 MOVE "AAA030" TO CORRECT-A. IX2134.2 +078700 READ-WRITE-F2-06. IX2134.2 +078800 PERFORM PRINT-DETAIL. IX2134.2 +078900 READ-TEST-F2-07. IX2134.2 +079000 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +079100 MOVE "READ-TEST-F2-07" TO PAR-NAME. IX2134.2 +079200 MOVE "RETRIEVED BY PRIMARY KEY" TO RE-MARK. IX2134.2 +079300 MOVE "AAA011" TO IX-FS1-KEY. IX2134.2 +079400 READ IX-FS1 RECORD IX2134.2 +079500 KEY IS IX-FS1-KEY IX2134.2 +079600 INVALID KEY GO TO READ-INVALID-F2-07. IX2134.2 +079700 IF IX-FS1-KEY = "AAA011" IX2134.2 +079800 PERFORM PASS IX2134.2 +079900 ELSE GO TO READ-FAIL-F2-07. IX2134.2 +080000 GO TO READ-WRITE-F2-07. IX2134.2 +080100 READ-DELETE-F2-07. IX2134.2 +080200 PERFORM DE-LETE. IX2134.2 +080300 GO TO READ-WRITE-F2-07. IX2134.2 +080400 READ-INVALID-F2-07. IX2134.2 +080500 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +080600 TO RE-MARK. IX2134.2 +080700 PERFORM FAIL. IX2134.2 +080800 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +080900 MOVE "AAA011" TO CORRECT-A. IX2134.2 +081000 GO TO READ-WRITE-F2-07. IX2134.2 +081100 READ-FAIL-F2-07. IX2134.2 +081200 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +081300 PERFORM FAIL. IX2134.2 +081400 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +081500 MOVE "AAA011" TO CORRECT-A. IX2134.2 +081600 READ-WRITE-F2-07. IX2134.2 +081700 PERFORM PRINT-DETAIL. IX2134.2 +081800 DELETE-TEST-GF-02. IX2134.2 +081900 MOVE "DELETE...RECORD" TO FEATURE. IX2134.2 +082000 MOVE "DELETE-TEST-GF-02" TO PAR-NAME. IX2134.2 +082100 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-07" TO RE-MARK. IX2134.2 +082200 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-FAIL-GF-02. IX2134.2 +082300 PERFORM PASS. IX2134.2 +082400 GO TO DELETE-WRITE-GF-02. IX2134.2 +082500 DELETE-DELETE-GF-02. IX2134.2 +082600 PERFORM DE-LETE. IX2134.2 +082700 GO TO DELETE-WRITE-GF-02. IX2134.2 +082800 DELETE-FAIL-GF-02. IX2134.2 +082900 MOVE "IX-21; 4.3.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +083000 TO RE-MARK. IX2134.2 +083100 PERFORM FAIL. IX2134.2 +083200 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +083300 MOVE "AAA011" TO CORRECT-A. IX2134.2 +083400 DELETE-WRITE-GF-02. IX2134.2 +083500 PERFORM PRINT-DETAIL. IX2134.2 +083600 READ-TEST-F2-08. IX2134.2 +083700 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +083800 MOVE "READ-TEST-F2-08" TO PAR-NAME. IX2134.2 +083900 MOVE "RETRIEVED BY ALTERNATE KEY 9" TO RE-MARK. IX2134.2 +084000 MOVE "SSS060ALT09" TO IX-FS1-ALT09. IX2134.2 +084100 READ IX-FS1 RECORD IX2134.2 +084200 KEY IS IX-FS1-ALT09 IX2134.2 +084300 INVALID KEY GO TO READ-INVALID-F2-08. IX2134.2 +084400 IF IX-FS1-KEY = "AAA060" IX2134.2 +084500 PERFORM PASS IX2134.2 +084600 ELSE GO TO READ-FAIL-F2-08. IX2134.2 +084700 GO TO READ-WRITE-F2-08. IX2134.2 +084800 READ-DELETE-F2-08. IX2134.2 +084900 PERFORM DE-LETE. IX2134.2 +085000 GO TO READ-WRITE-F2-08. IX2134.2 +085100 READ-INVALID-F2-08. IX2134.2 +085200 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +085300 TO RE-MARK. IX2134.2 +085400 PERFORM FAIL. IX2134.2 +085500 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +085600 MOVE "AAA060" TO CORRECT-A. IX2134.2 +085700 GO TO READ-WRITE-F2-08. IX2134.2 +085800 READ-FAIL-F2-08. IX2134.2 +085900 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +086000 PERFORM FAIL. IX2134.2 +086100 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +086200 MOVE "AAA060" TO CORRECT-A. IX2134.2 +086300 READ-WRITE-F2-08. IX2134.2 +086400 PERFORM PRINT-DETAIL. IX2134.2 +086500 REWRITE-TEST-GF-02. IX2134.2 +086600 MOVE "REWRITE...INVALID..." TO FEATURE. IX2134.2 +086700 MOVE "REWRITE-TEST-GF-02" TO PAR-NAME. IX2134.2 +086800 MOVE "REWRITES RECORD FOUND IN READ-TEST-GF-08" TO RE-MARK. IX2134.2 +086900 MOVE "SSSSSSALT09" TO IX-FS1-ALT09. IX2134.2 +087000 REWRITE IX-FS1-RECORD INVALID KEY GO TO REWRITE-FAIL-GF-02. IX2134.2 +087100 PERFORM PASS. IX2134.2 +087200 GO TO REWRITE-WRITE-GF-02. IX2134.2 +087300 REWRITE-DELETE-GF-02. IX2134.2 +087400 PERFORM DE-LETE. IX2134.2 +087500 GO TO REWRITE-WRITE-GF-02. IX2134.2 +087600 REWRITE-FAIL-GF-02. IX2134.2 +087700 PERFORM FAIL. IX2134.2 +087800 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +087900 MOVE "SSSSSSALT09" TO CORRECT-A. IX2134.2 +088000 REWRITE-WRITE-GF-02. IX2134.2 +088100 PERFORM PRINT-DETAIL. IX2134.2 +088200 READ-TEST-F2-09. IX2134.2 +088300 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +088400 MOVE "READ-TEST-F2-09" TO PAR-NAME. IX2134.2 +088500 MOVE "RETRIEVED BY ALTERNATE KEY 5" TO RE-MARK. IX2134.2 +088600 MOVE "KKK010ALT05" TO IX-FS1-ALT05. IX2134.2 +088700 READ IX-FS1 RECORD IX2134.2 +088800 KEY IS IX-FS1-ALT05 IX2134.2 +088900 INVALID KEY GO TO READ-INVALID-F2-09. IX2134.2 +089000 IF IX-FS1-KEY = "AAA010" IX2134.2 +089100 PERFORM PASS IX2134.2 +089200 ELSE GO TO READ-FAIL-F2-09. IX2134.2 +089300 GO TO READ-WRITE-F2-09. IX2134.2 +089400 READ-DELETE-F2-09. IX2134.2 +089500 PERFORM DE-LETE. IX2134.2 +089600 GO TO READ-WRITE-F2-09. IX2134.2 +089700 READ-INVALID-F2-09. IX2134.2 +089800 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +089900 TO RE-MARK. IX2134.2 +090000 PERFORM FAIL. IX2134.2 +090100 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +090200 MOVE "KKK010ALT05" TO CORRECT-A. IX2134.2 +090300 GO TO READ-WRITE-F2-09. IX2134.2 +090400 READ-FAIL-F2-09. IX2134.2 +090500 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +090600 PERFORM FAIL. IX2134.2 +090700 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +090800 MOVE "AAA010" TO CORRECT-A. IX2134.2 +090900 READ-WRITE-F2-09. IX2134.2 +091000 PERFORM PRINT-DETAIL. IX2134.2 +091100 READ-TEST-F2-10. IX2134.2 +091200 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +091300 MOVE "READ-TEST-F2-10" TO PAR-NAME. IX2134.2 +091400 MOVE "RETRIEVED BY ALTERNATE KEY 9" TO RE-MARK. IX2134.2 +091500 MOVE "SSS060ALT09" TO IX-FS1-ALT09. IX2134.2 +091600 READ IX-FS1 RECORD IX2134.2 +091700 KEY IS IX-FS1-ALT09 IX2134.2 +091800 INVALID KEY GO TO READ-INVALID-F2-10. IX2134.2 +091900 IF IX-FS1-KEY = "AAA061" IX2134.2 +092000 PERFORM PASS IX2134.2 +092100 ELSE GO TO READ-FAIL-F2-10. IX2134.2 +092200 GO TO READ-WRITE-F2-10. IX2134.2 +092300 READ-DELETE-F2-10. IX2134.2 +092400 PERFORM DE-LETE. IX2134.2 +092500 GO TO READ-WRITE-F2-10. IX2134.2 +092600 READ-INVALID-F2-10. IX2134.2 +092700 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +092800 TO RE-MARK. IX2134.2 +092900 PERFORM FAIL. IX2134.2 +093000 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +093100 MOVE "SSS060ALT09" TO CORRECT-A. IX2134.2 +093200 GO TO READ-WRITE-F2-10. IX2134.2 +093300 READ-FAIL-F2-10. IX2134.2 +093400 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +093500 PERFORM FAIL. IX2134.2 +093600 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +093700 MOVE "AAA061" TO CORRECT-A. IX2134.2 +093800 READ-WRITE-F2-10. IX2134.2 +093900 PERFORM PRINT-DETAIL. IX2134.2 +094000 READ-TEST-F2-11. IX2134.2 +094100 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +094200 MOVE "READ-TEST-F2-11" TO PAR-NAME. IX2134.2 +094300 MOVE "RETRIEVED BY ALTERNATE KEY 7" TO RE-MARK. IX2134.2 +094400 MOVE "OOO070ALT07" TO IX-FS1-ALT07. IX2134.2 +094500 READ IX-FS1 RECORD IX2134.2 +094600 KEY IS IX-FS1-ALT07 IX2134.2 +094700 INVALID KEY GO TO READ-INVALID-F2-11. IX2134.2 +094800 IF IX-FS1-KEY = "AAA070" IX2134.2 +094900 PERFORM PASS IX2134.2 +095000 ELSE GO TO READ-FAIL-F2-11. IX2134.2 +095100 GO TO READ-WRITE-F2-11. IX2134.2 +095200 READ-DELETE-F2-11. IX2134.2 +095300 PERFORM DE-LETE. IX2134.2 +095400 GO TO READ-WRITE-F2-11. IX2134.2 +095500 READ-INVALID-F2-11. IX2134.2 +095600 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +095700 TO RE-MARK. IX2134.2 +095800 PERFORM FAIL. IX2134.2 +095900 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +096000 MOVE "OOO070ALT07" TO CORRECT-A. IX2134.2 +096100 GO TO READ-WRITE-F2-11. IX2134.2 +096200 READ-FAIL-F2-11. IX2134.2 +096300 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +096400 PERFORM FAIL. IX2134.2 +096500 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +096600 MOVE "AAA070" TO CORRECT-A. IX2134.2 +096700 READ-WRITE-F2-11. IX2134.2 +096800 PERFORM PRINT-DETAIL. IX2134.2 +096900 DELETE-TEST-GF-03. IX2134.2 +097000 MOVE "DELETE...RECORD" TO FEATURE. IX2134.2 +097100 MOVE "DELETE-TEST-GF-03" TO PAR-NAME. IX2134.2 +097200 MOVE "DELETES RECORD FOUND IN READ-TEST-F2-11" TO RE-MARK. IX2134.2 +097300 DELETE IX-FS1 RECORD INVALID KEY GO TO DELETE-FAIL-GF-03. IX2134.2 +097400 PERFORM PASS. IX2134.2 +097500 GO TO DELETE-WRITE-GF-03. IX2134.2 +097600 DELETE-DELETE-GF-03. IX2134.2 +097700 PERFORM DE-LETE. IX2134.2 +097800 GO TO DELETE-WRITE-GF-03. IX2134.2 +097900 DELETE-FAIL-GF-03. IX2134.2 +098000 MOVE "IX-21; 4.3.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +098100 TO RE-MARK. IX2134.2 +098200 PERFORM FAIL. IX2134.2 +098300 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +098400 MOVE "AAA070" TO CORRECT-A. IX2134.2 +098500 DELETE-WRITE-GF-03. IX2134.2 +098600 PERFORM PRINT-DETAIL. IX2134.2 +098700 READ-TEST-F2-12. IX2134.2 +098800 MOVE "READ...RECORD KEY" TO FEATURE. IX2134.2 +098900 MOVE "READ-TEST-F2-12" TO PAR-NAME. IX2134.2 +099000 MOVE "RETRIEVED BY ALTERNATE KEY 5" TO RE-MARK. IX2134.2 +099100 MOVE "KKK070ALT05" TO IX-FS1-ALT05. IX2134.2 +099200 READ IX-FS1 RECORD IX2134.2 +099300 KEY IS IX-FS1-ALT05 IX2134.2 +099400 INVALID KEY GO TO READ-INVALID-F2-12. IX2134.2 +099500 IF IX-FS1-KEY = "AAA071" IX2134.2 +099600 PERFORM PASS IX2134.2 +099700 ELSE GO TO READ-FAIL-F2-12. IX2134.2 +099800 GO TO READ-WRITE-F2-12. IX2134.2 +099900 READ-DELETE-F2-12. IX2134.2 +100000 PERFORM DE-LETE. IX2134.2 +100100 GO TO READ-WRITE-F2-12. IX2134.2 +100200 READ-INVALID-F2-12. IX2134.2 +100300 MOVE "IX-28; 4.5.2 & IX-6 1.3.5 INVALID KEY PATH TAKEN" IX2134.2 +100400 TO RE-MARK. IX2134.2 +100500 PERFORM FAIL. IX2134.2 +100600 MOVE "INVALID KEY" TO COMPUTED-A. IX2134.2 +100700 MOVE "KKK070ALT05" TO CORRECT-A. IX2134.2 +100800 GO TO READ-WRITE-F2-12. IX2134.2 +100900 READ-FAIL-F2-12. IX2134.2 +101000 MOVE "IX-28; 4.5.2 F2, WRONG KEY " TO RE-MARK. IX2134.2 +101100 PERFORM FAIL. IX2134.2 +101200 MOVE IX-FS1-KEY TO COMPUTED-A. IX2134.2 +101300 MOVE "AAA071" TO CORRECT-A. IX2134.2 +101400 READ-WRITE-F2-12. IX2134.2 +101500 PERFORM PRINT-DETAIL. IX2134.2 +101600 CLOSE IX-FS1. IX2134.2 +101700 CCVS-EXIT SECTION. IX2134.2 +101800 CCVS-999999. IX2134.2 +101900 GO TO CLOSE-FILES. IX2134.2 diff --git a/tests/cobol85/IX/IX214A.CBL b/tests/cobol85/IX/IX214A.CBL new file mode 100755 index 00000000..80facfb8 --- /dev/null +++ b/tests/cobol85/IX/IX214A.CBL @@ -0,0 +1,2358 @@ +000100 IDENTIFICATION DIVISION. IX2144.2 +000200 PROGRAM-ID. IX2144.2 +000300 IX214A. IX2144.2 +000400**************************************************************** IX2144.2 +000500* * IX2144.2 +000600* VALIDATION FOR:- * IX2144.2 +000700* * IX2144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2144.2 +000900* * IX2144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2144.2 +001100* * IX2144.2 +001200**************************************************************** IX2144.2 +001300* * IX2144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * IX2144.2 +001500* * IX2144.2 +001600* X-55 - SYSTEM PRINTER NAME. * IX2144.2 +001700* X-82 - SOURCE COMPUTER NAME. * IX2144.2 +001800* X-83 - OBJECT COMPUTER NAME. * IX2144.2 +001900* * IX2144.2 +002000**************************************************************** IX2144.2 +002100* "IX214A" IX2144.2 +002200******************************************************************IX2144.2 +002300* THE PURPOSE OF THE PROGRAM IS TO TEST USE OF THE IX2144.2 +002400* START --- NOT LESS THAN --- STATEMENT USING FIRST THE PRIME IX2144.2 +002500* RECORD KEY AND THEN WITH AN ALTERNATE RECORD KEY IX2144.2 +002600* AS THE KEY OF REFERENCE. THE START STATEMENT NAMES, IX2144.2 +002700* IN ITS CONSTRUCT , EITHER THE DATA NAME SPECIFIED IN THE IX2144.2 +002800* KEY CLAUSE OR A DATA ITEM THAT IS SUBORDINATE TO THE IX2144.2 +002900* KEY NAME. DIFFERENT KEY VALUES ARE USED FOR TESTING. IX2144.2 +003000* IF A KEY VALUE IS PROVIDED WHICH MATCHES A RECORD IN THE FILEIX2144.2 +003100* WHEN THE START IS EXECUTED THEN THE RECORD IS EXPECTED TO IX2144.2 +003200* MADE AVAILABLE BY THE SUBSEQUENT READ STATEMENT. IF A KEY IX2144.2 +003300* VALUE IS PROVIDED WHICH DOES NOT MATCH ANY RECORD IN THE IX2144.2 +003400* FILE THEN THE INVALID KEY PATH IS EXPECTED TO BE TAKEN. IX2144.2 +003500* THE FILE STATUS CONTENTS RESULTING FROM EXECUTION OF THE IX2144.2 +003600* START TESTS ARE SAVED AND CHECKED IN LATER TESTS. IX2144.2 +003700* IX2144.2 +003800* REFERENCE AMERICAN NATIONAL STANDARD IX2144.2 +003900* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IX2144.2 +004000* SECTION IX, INDEX I-O, THE START IX2144.2 +004100* STATEMENT. PARAGRAPHS 4.7.3 (3), (4); IX2144.2 +004200* 4.7.4 (1), (4), (5)IX2144.2 +004300* AND IX2144.2 +004400* THE FILE STATUS PARAGRAPH 1.3.4 IX2144.2 +004500* IX2144.2 +004600* BEFORE EXECUTION OF THE START IN EACH TEST, A RECORD IS MADE IX2144.2 +004700* AVAILABLE FROM THE FILE THAT IS DIFFERENT THAN WILL RESULT IX2144.2 +004800* FROM THE TEST. IF DURING THIS PROCEDURE AN INVALID KEY OCCURIX2144.2 +004900* THE TEST IS DELETED. ALSO BEFORE EACH TEST THE RECORD KEY ISIX2144.2 +005000* LOADED WITH A KEY VALUE AND DEPENDING ON THE NATURE OF THE TEIX2144.2 +005100* THE KEY VALUE MAY OR MAY NOT BE A VALID KEY FOR THE FILE. IX2144.2 +005200* IX2144.2 +005300* THIS PROGRAM FIRST CREATES AN INDEXED SEQUENTIAL FILE IX2144.2 +005400* CONTAINING TWO ALTERNATE KEYS AND THE ONE REQUIRED RECORD IX2144.2 +005500* KEY FOR THE FILE. IMMEDIATELY FOLLOWING FILE CREATION THE IX2144.2 +005600* FILE IS READ AND THE RECORDS OF THE FILE VERIFIED FOR IX2144.2 +005700* ACCURACY. NEXT THE TESTS ARE EXECUTED USING THE START --- IX2144.2 +005800* NOT LESS THAN ---STATEMENT. IX2144.2 +005900* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2144.2 +006000* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA IX2144.2 +006100* CONTENTS FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN IX2144.2 +006200* THE FILE. IX2144.2 +006300* IX2144.2 +006400* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2144.2 +006500* ------ ---------- --------------- --------------- IX2144.2 +006600* 001 BBBBBBBBBC002 EEEEEEEEEF000ALTKEY1 WWWWWWWWWV398ALTKEY2IX2144.2 +006700* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2144.2 +006800* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2144.2 +006900* . . . . IX2144.2 +007000* . . . . IX2144.2 +007100* . . . . IX2144.2 +007200* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2144.2 +007300* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2144.2 +007400* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2144.2 +007500* . . . . IX2144.2 +007600* . . . . IX2144.2 +007700* . . . . IX2144.2 +007800* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEY2IX2144.2 +007900* IX2144.2 +008000* NOTE 1 - ALTERNATE KEY NUMBER 2 CONTAINS DUPLICATE KEYS IX2144.2 +008100* EVERY 10TH AND 11TH RECORDS. IX2144.2 +008200* IX2144.2 +008300* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE IX2144.2 +008400* FILE FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE MIDDLEIX2144.2 +008500* 125 RECORDS ONLY THE NUMBER PART OF THE KEYS ARE VARIED IX2144.2 +008600* AND VARIED IN THE SEQUENCE SHOWN ABOVE. THAT IS, RECORD-KEY IX2144.2 +008700* AND ALTERNATE-KEY-1 ARE INCREMENTED BY 2 AND THE ALTERNATE- IX2144.2 +008800* KEY-2 IS DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO IX2144.2 +008900* THE FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO THAT IX2144.2 +009000* AN I-O OPERATION IS REQUIRED FOR EACH RECORD ACCESSED FROM IX2144.2 +009100* THE FILE. IX2144.2 +009200* IX2144.2 +009300* FILE CHARACTERISTICS ARE: FILE SIZE = 200 RECORDS IX2144.2 +009400* RECORD SIZE = 240 CHARS. IX2144.2 +009500* RECORD KEY SIZE = 13 CHARS. IX2144.2 +009600* ALTERNATE KEY 1 SIZE = 20 CHARS. IX2144.2 +009700* ALTERNATE KEY 2 SIZE = 20 CHARS. IX2144.2 +009800* ACCESS MODE = SEQUENTIAL IX2144.2 +009900* IX2144.2 +010000* A LIST OF COBOL ELEMENTS WITH THE PARAGRAPH NAME IN PARENTH- IX2144.2 +010100* ESIS THAT TESTS THE ELEMENT AND A SHORT DESCRIPTION OF THE IX2144.2 +010200* TEST FOLLOWS. IX2144.2 +010300* IX2144.2 +010400* PROGRAM COLLATING SEQUENCE CLAUSE. (ALL START TESTS) - IX2144.2 +010500* THE PROGRAM COLLATING SEQUENCE CLAUSE SHOULD HAVE NO IX2144.2 +010600* EFFECT ON THE COMARAISIONS ASSOCIATED WITH THE START IX2144.2 +010700* STATEMENT. THIS PROGRAM ASSUMES THAT THE PROGRAM IX2144.2 +010800* COLLATING SEQUENCE CLAUSE ALSO DOES NOT IN ANY WAY IX2144.2 +010900* EFFECT THE SEQUENTIAL ORDER OF RECORDS ACCESSED IX2144.2 +011000* FROM OR WRITTEN TO THE FILE. IX2144.2 +011100* WRITE --- INVALID KEY---. (INX-TEST-001) - THIS TEST CREATEIX2144.2 +011200* A FILE OF 200 RECORDS CONTAINING ONE RECORD KEY AND IX2144.2 +011300* TWO ALTERNATE KEYS. IX2144.2 +011400* READ ---AT END ---. (INX-TEST-002) - THIS TEST READS THE IX2144.2 +011500* FILE CREATED IN INX-TEST-001 AND VERIFIES THAT THE IX2144.2 +011600* FILE WAS CREATED CORRECTLY. IX2144.2 +011700* START ---KEY NOT LESS THAN RECORD-KEY INVALID KEY ---. (INXIX2144.2 +011800* TEST-003.01 THRU INX-TEST-003.04) - THE START IX2144.2 +011900* STATEMENT IS EXECUTED USING THE RECORD-KEY FOR THE IX2144.2 +012000* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2144.2 +012100* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2144.2 +012200* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2144.2 +012300* (.03) AND NOT LESS THAN THAN THE LAST RECORD IN THE IX2144.2 +012400* FILE (.04). IX2144.2 +012500* START ---KEY NOT LESS THAN DATA-ITEM INVALID KEY ---. (INXIX2144.2 +012600* TEST-003.05 THRU INX-TEST-003.09) - THE START IX2144.2 +012700* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2144.2 +012800* SUBORDINATE TO THE RECORD-KEY NAME OF THE FILE IX2144.2 +012900* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2144.2 +013000* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2144.2 +013100* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2144.2 +013200* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2144.2 +013300* THE FIRST RECORD IN THE FILE (.08) AND NOT LESS THAN IX2144.2 +013400* THE LAST RECORD IN THE FILE (.09. IX2144.2 +013500* IX2144.2 +013600* NOTE -- IN SOME OF THE TESTS THE DATA ITEM SPECIFIED IX2144.2 +013700* IS AN ENTRY SUBORDINATE TO A REDEFINES IX2144.2 +013800* ENTRY WHICH USES AS ITS OBJECT THE KEY IX2144.2 +013900* NAMED BY THE RECORD KEY CLAUSE. IX2144.2 +014000* IX2144.2 +014100* FILE STATUS. (INX-TEST-004.01 THRU INX-TEST-004.09) - THESEIX2144.2 +014200* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2144.2 +014300* FROM THE START IN INX-TEST-003.01 THRU IX2144.2 +014400* INX-TEST-003.09. IX2144.2 +014500* START ---KEY NOT LESS THAN ALTNATE-KEY INVALID KEY --. (INXIX2144.2 +014600* TEST-005.01 THRU INX-TEST-005.04) - THE START IX2144.2 +014700* STATEMENT IS EXECUTED USING THE ALTERNATE-KEY FOR THEIX2144.2 +014800* FILE CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2144.2 +014900* RECORD IN THE FILE (.01), BETWEEN TWO EXISTING KEY IX2144.2 +015000* VALUES (02), LESS THAN THE FIRST RECORD IN THE FILE IX2144.2 +015100* (.03) AND NOT LESS THAN THAN THE LAST RECORD IN THE IX2144.2 +015200* FILE (.04). IX2144.2 +015300* START ---KEY NOT LESS THAN DATA-ITEM INVALID KEY --. (INXIX2144.2 +015400* TEST-005.05 THRU INX-TEST-005.09) - THE START IX2144.2 +015500* STATEMENT IS EXECUTED USING A DATA ITEM WHICH IS IX2144.2 +015600* SUBORDINATE TO THE ALTERNATE-KEY NAME OF THE FILE IX2144.2 +015700* AND CONTAINING KEY VALUES WHICH RESPECTIVELY EQUAL AIX2144.2 +015800* RECORD IN THE FILE (.05), EQUAL A VALUE PRESENT IN IX2144.2 +015900* IN MORE THAN ONE RECORD IN THE FILE (.06), IX2144.2 +016000* NOT EQUAL TO ANY RECORD IN THE FILE (.07, LESS THAN IX2144.2 +016100* THE FIRST RECORD IN THE FILE (.08) AND NOT LESS THAN IX2144.2 +016200* THE LAST RECORD IN THE FILE (.09. IX2144.2 +016300* IX2144.2 +016400* NOTE -- IN SOME OF THE TESTS THE DATA ITEM SPECIFIED IX2144.2 +016500* IS AN ENTRY SUBORDINATE TO A REDEFINES IX2144.2 +016600* ENTRY WHICH USES AS ITS OBJECT THE KEY IX2144.2 +016700* NAMED BY THE RECORD KEY CLAUSE. IX2144.2 +016800* IX2144.2 +016900* FILE STATUS. (INX-TEST-006.01 THRU INX-TEST-006.09) - THESEIX2144.2 +017000* TESTS CHECK THE CONTENTS OF THE FILE STATUS RESULTINGIX2144.2 +017100* FROM THE START IN INX-TEST-005.01 THRU IX2144.2 +017200* INX-TEST-005.09. IX2144.2 +017300* MULTIPLE STARTS. (INX-TEST-007) - THIS TEST EXECUTES IX2144.2 +017400* SEVERAL START STATEMENTS FOLLOWED BY A READ STATEMENTIX2144.2 +017500* AND EXPECTS THE RECORD DESIGNATED BY THE LAST IX2144.2 +017600* START BE MADE AVAILABLE. IX2144.2 +017700* IX2144.2 +017800******************************************************************IX2144.2 +017900* IX2144.2 +018000 ENVIRONMENT DIVISION. IX2144.2 +018100 CONFIGURATION SECTION. IX2144.2 +018200 SOURCE-COMPUTER. IX2144.2 +018300 Linux. IX2144.2 +018400 OBJECT-COMPUTER. IX2144.2 +018500 Linux IX2144.2 +018600 PROGRAM COLLATING SEQUENCE IS FOR-INX-START-TEST. IX2144.2 +018700 SPECIAL-NAMES. IX2144.2 +018800 ALPHABET IX2144.2 +018900 FOR-INX-START-TEST IS "WVUTSRJIHGFEDCB". IX2144.2 +019000 INPUT-OUTPUT SECTION. IX2144.2 +019100 FILE-CONTROL. IX2144.2 +019200*P SELECT RAW-DATA ASSIGN TO IX2144.2 +019300*P "XXXXX062" IX2144.2 +019400*P ORGANIZATION IS INDEXED IX2144.2 +019500*P ACCESS MODE IS RANDOM IX2144.2 +019600*P RECORD KEY IS RAW-DATA-KEY. IX2144.2 +019700 SELECT PRINT-FILE ASSIGN TO IX2144.2 +019800 "report.log". IX2144.2 +019900 SELECT IX-FS1 IX2144.2 +020000 ASSIGN TO IX2144.2 +020100 "XXXXX024" IX2144.2 +020200*J **** X-CARD UNDEFINED **** IX2144.2 +020300 ACCESS MODE IS SEQUENTIAL IX2144.2 +020400 ORGANIZATION IS INDEXED IX2144.2 +020500 RECORD KEY IS IX-FS1-KEY IX2144.2 +020600 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY1 IX2144.2 +020700 ALTERNATE RECORD KEY IS IX-FS1-ALTKEY2 WITH DUPLICATES IX2144.2 +020800 FILE STATUS IS FS1-STATUS. IX2144.2 +020900 DATA DIVISION. IX2144.2 +021000 FILE SECTION. IX2144.2 +021100*P IX2144.2 +021200*PD RAW-DATA. IX2144.2 +021300*P IX2144.2 +021400*P1 RAW-DATA-SATZ. IX2144.2 +021500*P 05 RAW-DATA-KEY PIC X(6). IX2144.2 +021600*P 05 C-DATE PIC 9(6). IX2144.2 +021700*P 05 C-TIME PIC 9(8). IX2144.2 +021800*P 05 C-NO-OF-TESTS PIC 99. IX2144.2 +021900*P 05 C-OK PIC 999. IX2144.2 +022000*P 05 C-ALL PIC 999. IX2144.2 +022100*P 05 C-FAIL PIC 999. IX2144.2 +022200*P 05 C-DELETED PIC 999. IX2144.2 +022300*P 05 C-INSPECT PIC 999. IX2144.2 +022400*P 05 C-NOTE PIC X(13). IX2144.2 +022500*P 05 C-INDENT PIC X. IX2144.2 +022600*P 05 C-ABORT PIC X(8). IX2144.2 +022700 FD PRINT-FILE. IX2144.2 +022800 01 PRINT-REC PICTURE X(120). IX2144.2 +022900 01 DUMMY-RECORD PICTURE X(120). IX2144.2 +023000 FD IX-FS1 IX2144.2 +023100*C LABEL RECORDS ARE STANDARD IX2144.2 +023200*C DATA RECORD IS IX-FS1R1-F-G-240 IX2144.2 +023300 RECORD CONTAINS 240 CHARACTERS. IX2144.2 +023400 01 IX-FS1R1-F-G-240. IX2144.2 +023500 05 IX-FS1-REC-120 PICTURE X(120). IX2144.2 +023600 05 IX-FS1-REC-121-240. IX2144.2 +023700 10 FILLER PICTURE X(8). IX2144.2 +023800 10 IX-REC-KEY-AREA. IX2144.2 +023900 15 IX-FS1-KEY. IX2144.2 +024000 20 IX-FS1-KEY-1-10. IX2144.2 +024100 25 IX-FS1-KEY-1-5 PICTURE X(5). IX2144.2 +024200 25 IX-FS1-KEY-6-10 PICTURE X(5). IX2144.2 +024300 20 IX-FS1-KEY-11-13 PICTURE X(3). IX2144.2 +024400 15 IX-REDF-RECKEY REDEFINES IX-FS1-KEY. IX2144.2 +024500 20 R-RECKEY-1-7 PICTURE X(7). IX2144.2 +024600 20 R-RECKEY-8-13 PICTURE X(6). IX2144.2 +024700 15 FILLER PICTURE X(16). IX2144.2 +024800 10 FILLER PICTURE X(9). IX2144.2 +024900 10 IX-ALT-KEY1-AREA. IX2144.2 +025000 15 IX-FS1-ALTKEY1. IX2144.2 +025100 20 IX-FS1-ALTKEY1-1-10. IX2144.2 +025200 25 IX-FS1-ALTKEY1-1-5 PICTURE X(5). IX2144.2 +025300 25 IX-FS1-ALTKEY1-6-10 PICTURE X(5). IX2144.2 +025400 20 IX-FS1-ALTKEY1-11-13 PICTURE X(3). IX2144.2 +025500 20 IX-FS1-ALTKEY1-14-20 PICTURE X(7). IX2144.2 +025600 15 IX-REDF-ALTKEY1 REDEFINES IX-FS1-ALTKEY1. IX2144.2 +025700 20 R-ALTKEY1-1-6 PICTURE X(6). IX2144.2 +025800 20 R-ALTKEY1-7-10 PICTURE X(4). IX2144.2 +025900 20 R-ALTKEY1-11-20 PICTURE X(10). IX2144.2 +026000 15 FILLER PICTURE X(9). IX2144.2 +026100 10 FILLER PICTURE X(9). IX2144.2 +026200 10 IX-ALT-KEY2-AREA. IX2144.2 +026300 15 IX-FS1-ALTKEY2. IX2144.2 +026400 20 IX-FS1-ALTKEY2-1-10. IX2144.2 +026500 25 IX-FS1-ALTKEY2-1-5 PICTURE X(5). IX2144.2 +026600 25 IX-FS1-ALTKEY2-6-10 PICTURE X(5). IX2144.2 +026700 20 IX-FS1-ALTKEY2-11-13 PICTURE X(3). IX2144.2 +026800 20 IX-FS1-ALTKEY2-14-20 PICTURE X(7). IX2144.2 +026900 15 FILLER PICTURE X(9). IX2144.2 +027000 10 FILLER PICTURE X(7). IX2144.2 +027100 WORKING-STORAGE SECTION. IX2144.2 +027200 01 WRK-FS1-RECKEY. IX2144.2 +027300 05 FS1-RECKEY-1-13. IX2144.2 +027400 10 FS1-RECKEY-1-10 PICTURE X(10). IX2144.2 +027500 10 FS1-RECKEY-11-13 PICTURE 9(3). IX2144.2 +027600 05 FILLER PICTURE X(16) VALUE SPACE. IX2144.2 +027700 01 WRK-FS1-ALTKEY1. IX2144.2 +027800 05 FS1-ALTKEY1-1-20. IX2144.2 +027900 10 FS1-ALTKEY1-1-10. IX2144.2 +028000 15 FS1-ALTKEY1-1-5 PICTURE X(5). IX2144.2 +028100 15 FS1-ALTKEY1-6-10 PICTURE X(5). IX2144.2 +028200 10 FS1-ALTKEY1-11-13 PICTURE 9(3). IX2144.2 +028300 10 FS1-ALTKEY1-14-20 PICTURE X(7). IX2144.2 +028400 05 FILLER PICTURE X(9) VALUE SPACE. IX2144.2 +028500 01 WRK-FS1-ALTKEY2. IX2144.2 +028600 05 FS1-ALTKEY2-1-20. IX2144.2 +028700 10 FS1-ALTKEY2-1-10. IX2144.2 +028800 15 FS1-ALTKEY2-1-5 PICTURE X(5). IX2144.2 +028900 15 FS1-ALTKEY2-6-10 PICTURE X(5). IX2144.2 +029000 10 FS1-ALTKEY2-11-13 PICTURE 9(3). IX2144.2 +029100 10 FS1-ALTKEY2-14-20 PICTURE X(7). IX2144.2 +029200 05 FILLER PICTURE X(9) VALUE SPACE. IX2144.2 +029300 01 RECNO PICTURE 9(5) VALUE ZERO. IX2144.2 +029400 01 FS1-STATUS PICTURE XX VALUE SPACE. IX2144.2 +029500 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2144.2 +029600 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2144.2 +029700 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2144.2 +029800 01 RECORDS-WRITTEN PICTURE 9(3). IX2144.2 +029900 01 RECKEY-NUM PICTURE 9(3). IX2144.2 +030000 01 ALTKEY1-NUM PICTURE 9(3). IX2144.2 +030100 01 ALTKEY2-NUM PICTURE 9(3). IX2144.2 +030200 01 RECORD-KEY-CONTENT. IX2144.2 +030300 05 FILLER PIC X(53) VALUE IX2144.2 +030400 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2144.2 +030500 05 FILLER PIC X(53) VALUE IX2144.2 +030600 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2144.2 +030700 05 FILLER PIC X(53) VALUE IX2144.2 +030800 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2144.2 +030900 05 FILLER PIC X(53) VALUE IX2144.2 +031000 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2144.2 +031100 05 FILLER PIC X(53) VALUE IX2144.2 +031200 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2144.2 +031300 05 FILLER PIC X(53) VALUE IX2144.2 +031400 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2144.2 +031500 05 FILLER PIC X(53) VALUE IX2144.2 +031600 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2144.2 +031700 05 FILLER PIC X(53) VALUE IX2144.2 +031800 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2144.2 +031900 05 FILLER PIC X(53) VALUE IX2144.2 +032000 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2144.2 +032100 05 FILLER PIC X(53) VALUE IX2144.2 +032200 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2144.2 +032300 05 FILLER PIC X(53) VALUE IX2144.2 +032400 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2144.2 +032500 05 FILLER PIC X(53) VALUE IX2144.2 +032600 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2144.2 +032700 05 FILLER PIC X(53) VALUE IX2144.2 +032800 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2144.2 +032900 05 FILLER PIC X(53) VALUE IX2144.2 +033000 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2144.2 +033100 05 FILLER PIC X(53) VALUE IX2144.2 +033200 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2144.2 +033300 05 FILLER PIC X(53) VALUE IX2144.2 +033400 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2144.2 +033500 05 FILLER PIC X(53) VALUE IX2144.2 +033600 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2144.2 +033700 05 FILLER PIC X(53) VALUE IX2144.2 +033800 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2144.2 +033900 05 FILLER PIC X(53) VALUE IX2144.2 +034000 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2144.2 +034100 05 FILLER PIC X(53) VALUE IX2144.2 +034200 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2144.2 +034300 05 FILLER PIC X(53) VALUE IX2144.2 +034400 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2144.2 +034500 05 FILLER PIC X(53) VALUE IX2144.2 +034600 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2144.2 +034700 05 FILLER PIC X(53) VALUE IX2144.2 +034800 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2144.2 +034900 05 FILLER PIC X(53) VALUE IX2144.2 +035000 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2144.2 +035100 05 FILLER PIC X(53) VALUE IX2144.2 +035200 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2144.2 +035300 05 FILLER PIC X(53) VALUE IX2144.2 +035400 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2144.2 +035500 05 FILLER PIC X(53) VALUE IX2144.2 +035600 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2144.2 +035700 05 FILLER PIC X(53) VALUE IX2144.2 +035800 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2144.2 +035900 05 FILLER PIC X(53) VALUE IX2144.2 +036000 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2144.2 +036100 05 FILLER PIC X(53) VALUE IX2144.2 +036200 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2144.2 +036300 05 FILLER PIC X(53) VALUE IX2144.2 +036400 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2144.2 +036500 05 FILLER PIC X(53) VALUE IX2144.2 +036600 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2144.2 +036700 05 FILLER PIC X(53) VALUE IX2144.2 +036800 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2144.2 +036900 05 FILLER PIC X(53) VALUE IX2144.2 +037000 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2144.2 +037100 05 FILLER PIC X(53) VALUE IX2144.2 +037200 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2144.2 +037300 05 FILLER PIC X(53) VALUE IX2144.2 +037400 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2144.2 +037500 05 FILLER PIC X(53) VALUE IX2144.2 +037600 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2144.2 +037700 05 FILLER PIC X(53) VALUE IX2144.2 +037800 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2144.2 +037900 05 FILLER PIC X(53) VALUE IX2144.2 +038000 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2144.2 +038100 05 FILLER PIC X(53) VALUE IX2144.2 +038200 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2144.2 +038300 05 FILLER PIC X(53) VALUE IX2144.2 +038400 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2144.2 +038500 05 FILLER PIC X(53) VALUE IX2144.2 +038600 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2144.2 +038700 05 FILLER PIC X(53) VALUE IX2144.2 +038800 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2144.2 +038900 05 FILLER PIC X(53) VALUE IX2144.2 +039000 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2144.2 +039100 05 FILLER PIC X(53) VALUE IX2144.2 +039200 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2144.2 +039300 05 FILLER PIC X(53) VALUE IX2144.2 +039400 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2144.2 +039500 05 FILLER PIC X(53) VALUE IX2144.2 +039600 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2144.2 +039700 05 FILLER PIC X(53) VALUE IX2144.2 +039800 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2144.2 +039900 05 FILLER PIC X(53) VALUE IX2144.2 +040000 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2144.2 +040100 05 FILLER PIC X(53) VALUE IX2144.2 +040200 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2144.2 +040300 05 FILLER PIC X(53) VALUE IX2144.2 +040400 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2144.2 +040500 05 FILLER PIC X(53) VALUE IX2144.2 +040600 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2144.2 +040700 05 FILLER PIC X(53) VALUE IX2144.2 +040800 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2144.2 +040900 05 FILLER PIC X(53) VALUE IX2144.2 +041000 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2144.2 +041100 05 FILLER PIC X(53) VALUE IX2144.2 +041200 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2144.2 +041300 05 FILLER PIC X(53) VALUE IX2144.2 +041400 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2144.2 +041500 05 FILLER PIC X(53) VALUE IX2144.2 +041600 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2144.2 +041700 05 FILLER PIC X(53) VALUE IX2144.2 +041800 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2144.2 +041900 05 FILLER PIC X(53) VALUE IX2144.2 +042000 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2144.2 +042100 05 FILLER PIC X(53) VALUE IX2144.2 +042200 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2144.2 +042300 05 FILLER PIC X(53) VALUE IX2144.2 +042400 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2144.2 +042500 05 FILLER PIC X(53) VALUE IX2144.2 +042600 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2144.2 +042700 05 FILLER PIC X(53) VALUE IX2144.2 +042800 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2144.2 +042900 05 FILLER PIC X(53) VALUE IX2144.2 +043000 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2144.2 +043100 05 FILLER PIC X(53) VALUE IX2144.2 +043200 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2144.2 +043300 05 FILLER PIC X(53) VALUE IX2144.2 +043400 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2144.2 +043500 05 FILLER PIC X(53) VALUE IX2144.2 +043600 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2144.2 +043700 05 FILLER PIC X(53) VALUE IX2144.2 +043800 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2144.2 +043900 05 FILLER PIC X(53) VALUE IX2144.2 +044000 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2144.2 +044100 05 FILLER PIC X(53) VALUE IX2144.2 +044200 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2144.2 +044300 05 FILLER PIC X(53) VALUE IX2144.2 +044400 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2144.2 +044500 05 FILLER PIC X(53) VALUE IX2144.2 +044600 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2144.2 +044700 05 FILLER PIC X(53) VALUE IX2144.2 +044800 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2144.2 +044900 05 FILLER PIC X(53) VALUE IX2144.2 +045000 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2144.2 +045100 05 FILLER PIC X(53) VALUE IX2144.2 +045200 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2144.2 +045300 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2144.2 +045400 05 KEY-VALUES OCCURS 75 TIMES. IX2144.2 +045500 10 RECKEY-VALUE PICTURE X(13). IX2144.2 +045600 10 ALTKEY1-VALUE PICTURE X(20). IX2144.2 +045700 10 ALTKEY2-VALUE PICTURE X(20). IX2144.2 +045800 01 INIT-FLAG PICTURE 9. IX2144.2 +045900 01 HOLD-FILESTATUS-RECORD. IX2144.2 +046000 05 FILESTATUS PICTURE XX OCCURS 10 TIMES. IX2144.2 +046100 01 FILE-RECORD-INFORMATION-REC. IX2144.2 +046200 03 FILE-RECORD-INFO-SKELETON. IX2144.2 +046300 05 FILLER PICTURE X(48) VALUE IX2144.2 +046400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2144.2 +046500 05 FILLER PICTURE X(46) VALUE IX2144.2 +046600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2144.2 +046700 05 FILLER PICTURE X(26) VALUE IX2144.2 +046800 ",LFIL=000000,ORG= ,LBLR= ". IX2144.2 +046900 05 FILLER PICTURE X(37) VALUE IX2144.2 +047000 ",RECKEY= ". IX2144.2 +047100 05 FILLER PICTURE X(38) VALUE IX2144.2 +047200 ",ALTKEY1= ". IX2144.2 +047300 05 FILLER PICTURE X(38) VALUE IX2144.2 +047400 ",ALTKEY2= ". IX2144.2 +047500 05 FILLER PICTURE X(7) VALUE SPACE.IX2144.2 +047600 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2144.2 +047700 05 FILE-RECORD-INFO-P1-120. IX2144.2 +047800 07 FILLER PIC X(5). IX2144.2 +047900 07 XFILE-NAME PIC X(6). IX2144.2 +048000 07 FILLER PIC X(8). IX2144.2 +048100 07 XRECORD-NAME PIC X(6). IX2144.2 +048200 07 FILLER PIC X(1). IX2144.2 +048300 07 REELUNIT-NUMBER PIC 9(1). IX2144.2 +048400 07 FILLER PIC X(7). IX2144.2 +048500 07 XRECORD-NUMBER PIC 9(6). IX2144.2 +048600 07 FILLER PIC X(6). IX2144.2 +048700 07 UPDATE-NUMBER PIC 9(2). IX2144.2 +048800 07 FILLER PIC X(5). IX2144.2 +048900 07 ODO-NUMBER PIC 9(4). IX2144.2 +049000 07 FILLER PIC X(5). IX2144.2 +049100 07 XPROGRAM-NAME PIC X(5). IX2144.2 +049200 07 FILLER PIC X(7). IX2144.2 +049300 07 XRECORD-LENGTH PIC 9(6). IX2144.2 +049400 07 FILLER PIC X(7). IX2144.2 +049500 07 CHARS-OR-RECORDS PIC X(2). IX2144.2 +049600 07 FILLER PIC X(1). IX2144.2 +049700 07 XBLOCK-SIZE PIC 9(4). IX2144.2 +049800 07 FILLER PIC X(6). IX2144.2 +049900 07 RECORDS-IN-FILE PIC 9(6). IX2144.2 +050000 07 FILLER PIC X(5). IX2144.2 +050100 07 XFILE-ORGANIZATION PIC X(2). IX2144.2 +050200 07 FILLER PIC X(6). IX2144.2 +050300 07 XLABEL-TYPE PIC X(1). IX2144.2 +050400 05 FILE-RECORD-INFO-P121-240. IX2144.2 +050500 07 FILLER PIC X(8). IX2144.2 +050600 07 XRECORD-KEY PIC X(29). IX2144.2 +050700 07 FILLER PIC X(9). IX2144.2 +050800 07 ALTERNATE-KEY1 PIC X(29). IX2144.2 +050900 07 FILLER PIC X(9). IX2144.2 +051000 07 ALTERNATE-KEY2 PIC X(29). IX2144.2 +051100 07 FILLER PIC X(7). IX2144.2 +051200 01 TEST-RESULTS. IX2144.2 +051300 02 FILLER PIC X VALUE SPACE. IX2144.2 +051400 02 FEATURE PIC X(20) VALUE SPACE. IX2144.2 +051500 02 FILLER PIC X VALUE SPACE. IX2144.2 +051600 02 P-OR-F PIC X(5) VALUE SPACE. IX2144.2 +051700 02 FILLER PIC X VALUE SPACE. IX2144.2 +051800 02 PAR-NAME. IX2144.2 +051900 03 FILLER PIC X(19) VALUE SPACE. IX2144.2 +052000 03 PARDOT-X PIC X VALUE SPACE. IX2144.2 +052100 03 DOTVALUE PIC 99 VALUE ZERO. IX2144.2 +052200 02 FILLER PIC X(8) VALUE SPACE. IX2144.2 +052300 02 RE-MARK PIC X(61). IX2144.2 +052400 01 TEST-COMPUTED. IX2144.2 +052500 02 FILLER PIC X(30) VALUE SPACE. IX2144.2 +052600 02 FILLER PIC X(17) VALUE IX2144.2 +052700 " COMPUTED=". IX2144.2 +052800 02 COMPUTED-X. IX2144.2 +052900 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2144.2 +053000 03 COMPUTED-N REDEFINES COMPUTED-A IX2144.2 +053100 PIC -9(9).9(9). IX2144.2 +053200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2144.2 +053300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2144.2 +053400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2144.2 +053500 03 CM-18V0 REDEFINES COMPUTED-A. IX2144.2 +053600 04 COMPUTED-18V0 PIC -9(18). IX2144.2 +053700 04 FILLER PIC X. IX2144.2 +053800 03 FILLER PIC X(50) VALUE SPACE. IX2144.2 +053900 01 TEST-CORRECT. IX2144.2 +054000 02 FILLER PIC X(30) VALUE SPACE. IX2144.2 +054100 02 FILLER PIC X(17) VALUE " CORRECT =". IX2144.2 +054200 02 CORRECT-X. IX2144.2 +054300 03 CORRECT-A PIC X(20) VALUE SPACE. IX2144.2 +054400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2144.2 +054500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2144.2 +054600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2144.2 +054700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2144.2 +054800 03 CR-18V0 REDEFINES CORRECT-A. IX2144.2 +054900 04 CORRECT-18V0 PIC -9(18). IX2144.2 +055000 04 FILLER PIC X. IX2144.2 +055100 03 FILLER PIC X(2) VALUE SPACE. IX2144.2 +055200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2144.2 +055300 01 CCVS-C-1. IX2144.2 +055400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2144.2 +055500- "SS PARAGRAPH-NAME IX2144.2 +055600- " REMARKS". IX2144.2 +055700 02 FILLER PIC X(20) VALUE SPACE. IX2144.2 +055800 01 CCVS-C-2. IX2144.2 +055900 02 FILLER PIC X VALUE SPACE. IX2144.2 +056000 02 FILLER PIC X(6) VALUE "TESTED". IX2144.2 +056100 02 FILLER PIC X(15) VALUE SPACE. IX2144.2 +056200 02 FILLER PIC X(4) VALUE "FAIL". IX2144.2 +056300 02 FILLER PIC X(94) VALUE SPACE. IX2144.2 +056400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2144.2 +056500 01 REC-CT PIC 99 VALUE ZERO. IX2144.2 +056600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2144.2 +056700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2144.2 +056800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2144.2 +056900 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2144.2 +057000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2144.2 +057100 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2144.2 +057200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2144.2 +057300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2144.2 +057400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2144.2 +057500 01 CCVS-H-1. IX2144.2 +057600 02 FILLER PIC X(39) VALUE SPACES. IX2144.2 +057700 02 FILLER PIC X(42) VALUE IX2144.2 +057800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2144.2 +057900 02 FILLER PIC X(39) VALUE SPACES. IX2144.2 +058000 01 CCVS-H-2A. IX2144.2 +058100 02 FILLER PIC X(40) VALUE SPACE. IX2144.2 +058200 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2144.2 +058300 02 FILLER PIC XXXX VALUE IX2144.2 +058400 "4.2 ". IX2144.2 +058500 02 FILLER PIC X(28) VALUE IX2144.2 +058600 " COPY - NOT FOR DISTRIBUTION". IX2144.2 +058700 02 FILLER PIC X(41) VALUE SPACE. IX2144.2 +058800 IX2144.2 +058900 01 CCVS-H-2B. IX2144.2 +059000 02 FILLER PIC X(15) VALUE IX2144.2 +059100 "TEST RESULT OF ". IX2144.2 +059200 02 TEST-ID PIC X(9). IX2144.2 +059300 02 FILLER PIC X(4) VALUE IX2144.2 +059400 " IN ". IX2144.2 +059500 02 FILLER PIC X(12) VALUE IX2144.2 +059600 " HIGH ". IX2144.2 +059700 02 FILLER PIC X(22) VALUE IX2144.2 +059800 " LEVEL VALIDATION FOR ". IX2144.2 +059900 02 FILLER PIC X(58) VALUE IX2144.2 +060000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2144.2 +060100 01 CCVS-H-3. IX2144.2 +060200 02 FILLER PIC X(34) VALUE IX2144.2 +060300 " FOR OFFICIAL USE ONLY ". IX2144.2 +060400 02 FILLER PIC X(58) VALUE IX2144.2 +060500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2144.2 +060600 02 FILLER PIC X(28) VALUE IX2144.2 +060700 " COPYRIGHT 1985 ". IX2144.2 +060800 01 CCVS-E-1. IX2144.2 +060900 02 FILLER PIC X(52) VALUE SPACE. IX2144.2 +061000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2144.2 +061100 02 ID-AGAIN PIC X(9). IX2144.2 +061200 02 FILLER PIC X(45) VALUE SPACES. IX2144.2 +061300 01 CCVS-E-2. IX2144.2 +061400 02 FILLER PIC X(31) VALUE SPACE. IX2144.2 +061500 02 FILLER PIC X(21) VALUE SPACE. IX2144.2 +061600 02 CCVS-E-2-2. IX2144.2 +061700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2144.2 +061800 03 FILLER PIC X VALUE SPACE. IX2144.2 +061900 03 ENDER-DESC PIC X(44) VALUE IX2144.2 +062000 "ERRORS ENCOUNTERED". IX2144.2 +062100 01 CCVS-E-3. IX2144.2 +062200 02 FILLER PIC X(22) VALUE IX2144.2 +062300 " FOR OFFICIAL USE ONLY". IX2144.2 +062400 02 FILLER PIC X(12) VALUE SPACE. IX2144.2 +062500 02 FILLER PIC X(58) VALUE IX2144.2 +062600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2144.2 +062700 02 FILLER PIC X(13) VALUE SPACE. IX2144.2 +062800 02 FILLER PIC X(15) VALUE IX2144.2 +062900 " COPYRIGHT 1985". IX2144.2 +063000 01 CCVS-E-4. IX2144.2 +063100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2144.2 +063200 02 FILLER PIC X(4) VALUE " OF ". IX2144.2 +063300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2144.2 +063400 02 FILLER PIC X(40) VALUE IX2144.2 +063500 " TESTS WERE EXECUTED SUCCESSFULLY". IX2144.2 +063600 01 XXINFO. IX2144.2 +063700 02 FILLER PIC X(19) VALUE IX2144.2 +063800 "*** INFORMATION ***". IX2144.2 +063900 02 INFO-TEXT. IX2144.2 +064000 04 FILLER PIC X(8) VALUE SPACE. IX2144.2 +064100 04 XXCOMPUTED PIC X(20). IX2144.2 +064200 04 FILLER PIC X(5) VALUE SPACE. IX2144.2 +064300 04 XXCORRECT PIC X(20). IX2144.2 +064400 02 INF-ANSI-REFERENCE PIC X(48). IX2144.2 +064500 01 HYPHEN-LINE. IX2144.2 +064600 02 FILLER PIC IS X VALUE IS SPACE. IX2144.2 +064700 02 FILLER PIC IS X(65) VALUE IS "************************IX2144.2 +064800- "*****************************************". IX2144.2 +064900 02 FILLER PIC IS X(54) VALUE IS "************************IX2144.2 +065000- "******************************". IX2144.2 +065100 01 CCVS-PGM-ID PIC X(9) VALUE IX2144.2 +065200 "IX214A". IX2144.2 +065300 PROCEDURE DIVISION. IX2144.2 +065400 CCVS1 SECTION. IX2144.2 +065500 OPEN-FILES. IX2144.2 +065600*P OPEN I-O RAW-DATA. IX2144.2 +065700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2144.2 +065800*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2144.2 +065900*P MOVE "ABORTED " TO C-ABORT. IX2144.2 +066000*P ADD 1 TO C-NO-OF-TESTS. IX2144.2 +066100*P ACCEPT C-DATE FROM DATE. IX2144.2 +066200*P ACCEPT C-TIME FROM TIME. IX2144.2 +066300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2144.2 +066400*PND-E-1. IX2144.2 +066500*P CLOSE RAW-DATA. IX2144.2 +066600 OPEN OUTPUT PRINT-FILE. IX2144.2 +066700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2144.2 +066800 MOVE SPACE TO TEST-RESULTS. IX2144.2 +066900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2144.2 +067000 MOVE ZERO TO REC-SKL-SUB. IX2144.2 +067100 PERFORM CCVS-INIT-FILE 9 TIMES. IX2144.2 +067200 CCVS-INIT-FILE. IX2144.2 +067300 ADD 1 TO REC-SKL-SUB. IX2144.2 +067400 MOVE FILE-RECORD-INFO-SKELETON IX2144.2 +067500 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2144.2 +067600 CCVS-INIT-EXIT. IX2144.2 +067700 GO TO CCVS1-EXIT. IX2144.2 +067800 CLOSE-FILES. IX2144.2 +067900*P OPEN I-O RAW-DATA. IX2144.2 +068000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2144.2 +068100*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2144.2 +068200*P MOVE "OK. " TO C-ABORT. IX2144.2 +068300*P MOVE PASS-COUNTER TO C-OK. IX2144.2 +068400*P MOVE ERROR-HOLD TO C-ALL. IX2144.2 +068500*P MOVE ERROR-COUNTER TO C-FAIL. IX2144.2 +068600*P MOVE DELETE-COUNTER TO C-DELETED. IX2144.2 +068700*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2144.2 +068800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2144.2 +068900*PND-E-2. IX2144.2 +069000*P CLOSE RAW-DATA. IX2144.2 +069100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2144.2 +069200 TERMINATE-CCVS. IX2144.2 +069300*S EXIT PROGRAM. IX2144.2 +069400*SERMINATE-CALL. IX2144.2 +069500 STOP RUN. IX2144.2 +069600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2144.2 +069700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2144.2 +069800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2144.2 +069900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2144.2 +070000 MOVE "****TEST DELETED****" TO RE-MARK. IX2144.2 +070100 PRINT-DETAIL. IX2144.2 +070200 IF REC-CT NOT EQUAL TO ZERO IX2144.2 +070300 MOVE "." TO PARDOT-X IX2144.2 +070400 MOVE REC-CT TO DOTVALUE. IX2144.2 +070500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2144.2 +070600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2144.2 +070700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2144.2 +070800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2144.2 +070900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2144.2 +071000 MOVE SPACE TO CORRECT-X. IX2144.2 +071100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2144.2 +071200 MOVE SPACE TO RE-MARK. IX2144.2 +071300 HEAD-ROUTINE. IX2144.2 +071400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +071500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +071600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2144.2 +071700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2144.2 +071800 COLUMN-NAMES-ROUTINE. IX2144.2 +071900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +072000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +072100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +072200 END-ROUTINE. IX2144.2 +072300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2144.2 +072400 END-RTN-EXIT. IX2144.2 +072500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +072600 END-ROUTINE-1. IX2144.2 +072700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2144.2 +072800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2144.2 +072900 ADD PASS-COUNTER TO ERROR-HOLD. IX2144.2 +073000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2144.2 +073100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2144.2 +073200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2144.2 +073300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2144.2 +073400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2144.2 +073500 END-ROUTINE-12. IX2144.2 +073600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2144.2 +073700 IF ERROR-COUNTER IS EQUAL TO ZERO IX2144.2 +073800 MOVE "NO " TO ERROR-TOTAL IX2144.2 +073900 ELSE IX2144.2 +074000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2144.2 +074100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2144.2 +074200 PERFORM WRITE-LINE. IX2144.2 +074300 END-ROUTINE-13. IX2144.2 +074400 IF DELETE-COUNTER IS EQUAL TO ZERO IX2144.2 +074500 MOVE "NO " TO ERROR-TOTAL ELSE IX2144.2 +074600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2144.2 +074700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2144.2 +074800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +074900 IF INSPECT-COUNTER EQUAL TO ZERO IX2144.2 +075000 MOVE "NO " TO ERROR-TOTAL IX2144.2 +075100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2144.2 +075200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2144.2 +075300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +075400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2144.2 +075500 WRITE-LINE. IX2144.2 +075600 ADD 1 TO RECORD-COUNT. IX2144.2 +075700 IF RECORD-COUNT GREATER 42 IX2144.2 +075800 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2144.2 +075900 MOVE SPACE TO DUMMY-RECORD IX2144.2 +076000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2144.2 +076100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2144.2 +076200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2144.2 +076300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2144.2 +076400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2144.2 +076500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2144.2 +076600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2144.2 +076700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2144.2 +076800 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2144.2 +076900 MOVE ZERO TO RECORD-COUNT. IX2144.2 +077000 PERFORM WRT-LN. IX2144.2 +077100 WRT-LN. IX2144.2 +077200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2144.2 +077300 MOVE SPACE TO DUMMY-RECORD. IX2144.2 +077400 BLANK-LINE-PRINT. IX2144.2 +077500 PERFORM WRT-LN. IX2144.2 +077600 FAIL-ROUTINE. IX2144.2 +077700 IF COMPUTED-X NOT EQUAL TO SPACE IX2144.2 +077800 GO TO FAIL-ROUTINE-WRITE. IX2144.2 +077900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2144.2 +078000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2144.2 +078100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2144.2 +078200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +078300 MOVE SPACES TO INF-ANSI-REFERENCE. IX2144.2 +078400 GO TO FAIL-ROUTINE-EX. IX2144.2 +078500 FAIL-ROUTINE-WRITE. IX2144.2 +078600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2144.2 +078700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2144.2 +078800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2144.2 +078900 MOVE SPACES TO COR-ANSI-REFERENCE. IX2144.2 +079000 FAIL-ROUTINE-EX. EXIT. IX2144.2 +079100 BAIL-OUT. IX2144.2 +079200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2144.2 +079300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2144.2 +079400 BAIL-OUT-WRITE. IX2144.2 +079500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2144.2 +079600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2144.2 +079700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2144.2 +079800 MOVE SPACES TO INF-ANSI-REFERENCE. IX2144.2 +079900 BAIL-OUT-EX. EXIT. IX2144.2 +080000 CCVS1-EXIT. IX2144.2 +080100 EXIT. IX2144.2 +080200 SECT-0001-IX214A SECTION. IX2144.2 +080300 WRITE-INT-GF-01. IX2144.2 +080400 OPEN OUTPUT IX-FS1. IX2144.2 +080500 MOVE "IX-FS1" TO XFILE-NAME (1). IX2144.2 +080600 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2144.2 +080700 MOVE ZERO TO XRECORD-NUMBER (1). IX2144.2 +080800 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2144.2 +080900 MOVE "IX214A" TO XPROGRAM-NAME (1). IX2144.2 +081000 MOVE 240 TO XRECORD-LENGTH (1). IX2144.2 +081100 MOVE 001 TO XBLOCK-SIZE (1). IX2144.2 +081200 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2144.2 +081300 MOVE "S" TO XLABEL-TYPE (1). IX2144.2 +081400 MOVE 200 TO RECORDS-IN-FILE (1). IX2144.2 +081500 MOVE "CREATE-FILE-FS1" TO FEATURE. IX2144.2 +081600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2144.2 +081700 MOVE ZERO TO KEYSUB. IX2144.2 +081800 MOVE ZERO TO INVKEY-COUNTER. IX2144.2 +081900 WRITE-INIT-GF-01-01. IX2144.2 +082000 PERFORM WRITE-TEST-GF-01-R1 50 TIMES. IX2144.2 +082100 PERFORM WRITE-TEST-GF-01-R2 125 TIMES. IX2144.2 +082200 PERFORM WRITE-TEST-GF-01-R1 25 TIMES. IX2144.2 +082300 GO TO WRITE-TEST-GF-01. IX2144.2 +082400 WRITE-TEST-GF-01-R1. IX2144.2 +082500 ADD 001 TO XRECORD-NUMBER (1). IX2144.2 +082600 ADD 001 TO KEYSUB. IX2144.2 +082700 MOVE RECKEY-VALUE (KEYSUB) TO FS1-RECKEY-1-13. IX2144.2 +082800 MOVE ALTKEY1-VALUE (KEYSUB) TO FS1-ALTKEY1-1-20. IX2144.2 +082900 MOVE ALTKEY2-VALUE (KEYSUB) TO FS1-ALTKEY2-1-20. IX2144.2 +083000 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2144.2 +083100 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2144.2 +083200 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2144.2 +083300 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2144.2 +083400 WRITE IX-FS1R1-F-G-240 IX2144.2 +083500 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2144.2 +083600 ADD 001 TO EXCUT-COUNTER-06V00. IX2144.2 +083700 WRITE-TEST-GF-01-R2. IX2144.2 +083800 ADD 002 TO FS1-RECKEY-11-13. IX2144.2 +083900 ADD 002 TO FS1-ALTKEY1-11-13. IX2144.2 +084000 SUBTRACT 002 FROM FS1-ALTKEY2-11-13. IX2144.2 +084100 ADD 001 TO XRECORD-NUMBER (1). IX2144.2 +084200 MOVE WRK-FS1-RECKEY TO XRECORD-KEY (1). IX2144.2 +084300 MOVE WRK-FS1-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2144.2 +084400 MOVE WRK-FS1-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2144.2 +084500 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2144.2 +084600 WRITE IX-FS1R1-F-G-240 IX2144.2 +084700 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2144.2 +084800 ADD 001 TO EXCUT-COUNTER-06V00. IX2144.2 +084900 WRITE-TEST-GF-01. IX2144.2 +085000 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2144.2 +085100 GIVING RECORDS-WRITTEN. IX2144.2 +085200 MOVE 200 TO CORRECT-18V0. IX2144.2 +085300 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2144.2 +085400 IF RECORDS-WRITTEN EQUAL TO 200 IX2144.2 +085500 PERFORM PASS IX2144.2 +085600 ELSE IX2144.2 +085700 PERFORM FAIL. IX2144.2 +085800 MOVE "RECORDS IN FILE" TO RE-MARK. IX2144.2 +085900 GO TO WRITE-TEST-GF-01-END. IX2144.2 +086000 WRITE-DELETE-GF-01. IX2144.2 +086100 PERFORM DE-LETE. IX2144.2 +086200 WRITE-TEST-GF-01-END. IX2144.2 +086300 PERFORM PRINT-DETAIL. IX2144.2 +086400 CLOSE IX-FS1. IX2144.2 +086500 IX2144.2 +086600 IX2144.2 +086700 READ-INIT-F1-01. IX2144.2 +086800 OPEN INPUT IX-FS1. IX2144.2 +086900 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2144.2 +087000 MOVE "READ FILE IX-FS1" TO FEATURE. IX2144.2 +087100 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2144.2 +087200 MOVE 02 TO RECKEY-NUM. IX2144.2 +087300 MOVE 002 TO ALTKEY1-NUM. IX2144.2 +087400 READ-TEST-F1-01-R1. IX2144.2 +087500 READ IX-FS1 AT END GO TO READ-TEST-F1-01. IX2144.2 +087600 MOVE IX-REC-KEY-AREA TO WRK-FS1-RECKEY. IX2144.2 +087700 MOVE IX-ALT-KEY1-AREA TO WRK-FS1-ALTKEY1. IX2144.2 +087800 IF FS1-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2144.2 +087900 AND FS1-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2144.2 +088000 NEXT SENTENCE IX2144.2 +088100 ELSE IX2144.2 +088200 PERFORM READ-FAIL-F1-01. IX2144.2 +088300 IF EXCUT-COUNTER-06V00 NOT LESS THAN 200 IX2144.2 +088400 GO TO READ-TEST-F1-01. IX2144.2 +088500 ADD 001 TO EXCUT-COUNTER-06V00. IX2144.2 +088600 ADD 002 TO RECKEY-NUM IX2144.2 +088700 ADD 002 TO ALTKEY1-NUM. IX2144.2 +088800 GO TO READ-TEST-F1-01-R1. IX2144.2 +088900 READ-TEST-F1-01. IX2144.2 +089000 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2144.2 +089100 PERFORM PASS ELSE IX2144.2 +089200 PERFORM FAIL. IX2144.2 +089300 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2144.2 +089400 MOVE 200 TO CORRECT-18V0. IX2144.2 +089500 MOVE "RECORDS IN FILE" TO RE-MARK. IX2144.2 +089600 GO TO READ-WRITE-F1-01. IX2144.2 +089700 READ-FAIL-F1-01. IX2144.2 +089800 PERFORM FAIL. IX2144.2 +089900 MOVE FS1-RECKEY-11-13 TO COMPUTED-18V0. IX2144.2 +090000 MOVE RECKEY-NUM TO CORRECT-18V0. IX2144.2 +090100 MOVE "NUM EMBEDDED IN RECKEY" TO RE-MARK. IX2144.2 +090200 READ-WRITE-F1-01. IX2144.2 +090300 PERFORM PRINT-DETAIL. IX2144.2 +090400 CLOSE IX-FS1. IX2144.2 +090500 START-INIT. IX2144.2 +090600 OPEN INPUT IX-FS1. IX2144.2 +090700 MOVE "START NLT RECKEY " TO FEATURE. IX2144.2 +090800 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2144.2 +090900 MOVE SPACE TO HOLD-FILESTATUS-RECORD. IX2144.2 +091000* IX2144.2 +091100* THE "START -- NOT LESS THAN--" IS CHECKED FOR PROPER POSITIONINGIX2144.2 +091200* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2144.2 +091300* START-TEST-GF- USE ONLY THE PRIME RECORD KEY FOR ESTABLISHING IX2144.2 +091400* THE CURRENT RECORD POINTER FOR THE FILE. THE FOLLOWING IS A IX2144.2 +091500* SUMMARY OF THE TEST CONDITIONS AND THE EXPECTED ACTION TO BE IX2144.2 +091600* TAKEN FOR THE TESTS. IX2144.2 +091700* IX2144.2 +091800* CONDITIONS (CONTENTS OF KEY) / ACTION IX2144.2 +091900* IX2144.2 +092000* START-TEST-GF-01 - EQUAL A RECORD IN FILE / RECORD FOUND IX2144.2 +092100* START-TEST-GF-02 - BETWEEN 2 KEY VALUES / RECORD FOUND IX2144.2 +092200* START-TEST-GF-03 - LESS THAN FIRST FILE REC. / REC. FOUND IX2144.2 +092300* START-TEST-GF-04 - NOT LESS THAN LAST FILE RECORD / INVALID KEIX2144.2 +092400* START-TEST-GF-05 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2144.2 +092500* START-TEST-GF-06 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUNIX2144.2 +092600* START-TEST-GF-07 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEYIX2144.2 +092700* START-TEST-GF-08 - UNEQUAL SIZE OPERANDS (UNEQUAL) / REC FOUNDIX2144.2 +092800* START-TEST-GF-09 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEY IX2144.2 +092900* IX2144.2 +093000* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2144.2 +093100* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2144.2 +093200* IF DURING THIS INITIALIZATION AN INVALID KEY OCCURS THE TEST IX2144.2 +093300* WILL BE DELETED AND CONTROL WILL BE PASSED TO THE NEXT TEST. IX2144.2 +093400* WHEN TESTING IF AN INVALID KEY IS EXPECTED, THE KEYS IX2144.2 +093500* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2144.2 +093600* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2144.2 +093700* MATCH RECORDS IN THE FILE. BUT IF A KEY MATCH IS EXPECTED FROMIX2144.2 +093800* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2144.2 +093900* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2144.2 +094000* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2144.2 +094100* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2144.2 +094200* IX2144.2 +094300 START-INIT-GF-01. IX2144.2 +094400 PERFORM START-INITIALIZE-RECORD. IX2144.2 +094500 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +094600 PERFORM START-INIT-ERROR IX2144.2 +094700 GO TO START-DELETE-GF-01. IX2144.2 +094800 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2144.2 +094900 MOVE "EEEEEFFFFF022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +095000 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +095100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +095200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +095300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +095400 START-TEST-GF-01. IX2144.2 +095500* IX2144.2 +095600* START-TEST-GF-.01 - THE START SHOULD FIND A RECORD IN THE FILE IX2144.2 +095700* WHICH HAS A RECORD KEY VALUE OF IX2144.2 +095800* CCCCCCCCDD022 (RECORD NUMBER 11). IX2144.2 +095900* IX2144.2 +096000 START IX-FS1 IX2144.2 +096100 KEY IS NOT LESS THAN IX-FS1-KEY IX2144.2 +096200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2144.2 +096300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +096400 GO TO START-FAIL-GF-01. IX2144.2 +096500 MOVE FS1-STATUS TO FILESTATUS (1). IX2144.2 +096600 READ IX-FS1 AT END IX2144.2 +096700 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +096800 GO TO START-FAIL-GF-01. IX2144.2 +096900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +097000 IF XRECORD-NUMBER (1) EQUAL TO 11 IX2144.2 +097100 PERFORM PASS IX2144.2 +097200 MOVE SPACE TO RE-MARK IX2144.2 +097300 GO TO START-WRITE-GF-01. IX2144.2 +097400 MOVE 11 TO RECNO. IX2144.2 +097500 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +097600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +097700 START-FAIL-GF-01. IX2144.2 +097800 PERFORM FAIL. IX2144.2 +097900 MOVE 11 TO CORRECT-18V0. IX2144.2 +098000 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +098100 TO RE-MARK. IX2144.2 +098200 GO TO START-WRITE-GF-01. IX2144.2 +098300 START-DELETE-GF-01. IX2144.2 +098400 PERFORM DE-LETE. IX2144.2 +098500 START-WRITE-GF-01. IX2144.2 +098600 PERFORM PRINT-DETAIL. IX2144.2 +098700 START-INIT-GF-02. IX2144.2 +098800 PERFORM START-INITIALIZE-RECORD. IX2144.2 +098900 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2144.2 +099000 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +099100 PERFORM START-INIT-ERROR IX2144.2 +099200 GO TO START-DELETE-GF-02. IX2144.2 +099300 MOVE "EEEEEEEFFF067" TO FS1-RECKEY-1-13. IX2144.2 +099400 MOVE "HHHHHHHHII064ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +099500 MOVE "TTTTTTTTSS336ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +099600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +099700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +099800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +099900 START-TEST-GF-02. IX2144.2 +100000* IX2144.2 +100100* START-TEST-GF-.02 - THE START SHOULD FIND A RECORD IN THE FILE IX2144.2 +100200* WHICH HAS A RECORD KEY VALUE OF EEEEEEFFFF068IX2144.2 +100300* (RECORD NUMBER 34). THIS KEY VALUE IS IX2144.2 +100400* SEQUENTIALLY A LOGICAL RECORD HIGHER THAN IX2144.2 +100500* THE RECORD CONTAINING THE KEY VALUE LOADED IX2144.2 +100600* INTO THE RECORD KEY BEFORE THE START WAS IX2144.2 +100700* EXECUTED. THE KEY VALUE INITIALLY LOADED IX2144.2 +100800* WAS A VALUE BETWEEN TWO EXISTING KEY VALUES. IX2144.2 +100900* IX2144.2 +101000 START IX-FS1 IX2144.2 +101100 KEY NOT LESS THAN IX-FS1-KEY IX2144.2 +101200 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2144.2 +101300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +101400 GO TO START-FAIL-GF-02. IX2144.2 +101500 MOVE FS1-STATUS TO FILESTATUS (2). IX2144.2 +101600 READ IX-FS1 AT END IX2144.2 +101700 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +101800 GO TO START-FAIL-GF-02. IX2144.2 +101900 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +102000 IF XRECORD-NUMBER (1) EQUAL TO 34 IX2144.2 +102100 PERFORM PASS IX2144.2 +102200 MOVE SPACE TO RE-MARK IX2144.2 +102300 GO TO START-WRITE-GF-02. IX2144.2 +102400 MOVE 34 TO RECNO. IX2144.2 +102500 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +102600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +102700 START-FAIL-GF-02. IX2144.2 +102800 PERFORM FAIL. IX2144.2 +102900 MOVE 34 TO CORRECT-18V0. IX2144.2 +103000 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +103100 TO RE-MARK. IX2144.2 +103200 GO TO START-WRITE-GF-02. IX2144.2 +103300 START-DELETE-GF-02. IX2144.2 +103400 PERFORM DE-LETE. IX2144.2 +103500 START-WRITE-GF-02. IX2144.2 +103600 PERFORM PRINT-DETAIL. IX2144.2 +103700 START-INIT-GF-03. IX2144.2 +103800 PERFORM START-INITIALIZE-RECORD. IX2144.2 +103900 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2144.2 +104000 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +104100 PERFORM START-INIT-ERROR IX2144.2 +104200 GO TO START-DELETE-GF-03. IX2144.2 +104300 MOVE "BBBBBBBBBC001" TO FS1-RECKEY-1-13. IX2144.2 +104400 MOVE "EEEEEEEEEF003ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +104500 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +104600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +104700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +104800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +104900 START-TEST-GF-03. IX2144.2 +105000* IX2144.2 +105100* START-TEST-GF-.03 - THE START STATEMENT SHOULD FIND A IX2144.2 +105200* RECORD IN THE FILE WHICH HAS A RECORD KEY IX2144.2 +105300* VALUE OF "BBBBBBBBBC002" (RECORD NUMBER 1). IX2144.2 +105400* THE KEY WAS LOADED BEFORE THE START IS IX2144.2 +105500* EXECUTED WITH THE VALUE THAT IS SEQUENTIALLY IX2144.2 +105600* LOWER THAN ANY CURRENTLY EXISTING KEY IN IX2144.2 +105700* THE FILE. IX2144.2 +105800* IX2144.2 +105900 START IX-FS1 IX2144.2 +106000 KEY IS NOT LESS THAN IX-FS1-KEY IX2144.2 +106100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2144.2 +106200 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +106300 GO TO START-FAIL-GF-03. IX2144.2 +106400 MOVE FS1-STATUS TO FILESTATUS (3). IX2144.2 +106500 READ IX-FS1 AT END IX2144.2 +106600 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +106700 GO TO START-FAIL-GF-03. IX2144.2 +106800 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +106900 IF XRECORD-NUMBER (1) EQUAL TO 01 IX2144.2 +107000 PERFORM PASS IX2144.2 +107100 MOVE SPACE TO RE-MARK IX2144.2 +107200 GO TO START-WRITE-GF-03. IX2144.2 +107300 MOVE 01 TO RECNO. IX2144.2 +107400 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +107500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +107600 START-FAIL-GF-03. IX2144.2 +107700 PERFORM FAIL. IX2144.2 +107800 MOVE 01 TO CORRECT-18V0. IX2144.2 +107900 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +108000 TO RE-MARK. IX2144.2 +108100 GO TO START-WRITE-GF-03. IX2144.2 +108200 START-DELETE-GF-03. IX2144.2 +108300 PERFORM DE-LETE. IX2144.2 +108400 START-WRITE-GF-03. IX2144.2 +108500 PERFORM PRINT-DETAIL. IX2144.2 +108600 START-INIT-GF-04. IX2144.2 +108700 PERFORM START-INITIALIZE-RECORD. IX2144.2 +108800 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2144.2 +108900 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +109000 PERFORM START-INIT-ERROR IX2144.2 +109100 GO TO START-DELETE-GF-04. IX2144.2 +109200 MOVE "UUUUUUUUUU401" TO FS1-RECKEY-1-13. IX2144.2 +109300 MOVE "YYYYYYYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +109400 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +109500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +109600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +109700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +109800 START-TEST-GF-04. IX2144.2 +109900* IX2144.2 +110000* START-TEST-GF-.04 - THE START STATEMENT SHOULD NOT FIND A IX2144.2 +110100* RECORD IN THE FILE WHICH HAS A RECORD IX2144.2 +110200* KEY VALUE NOT LESS THAN "UUUUUUUUUU401". THISIX2144.2 +110300* VALUE IS SEQUENTIALLY NOT LESS THAN IX2144.2 +110400* ANY RECORD KEY CURRENTLY EXISTING IN IX2144.2 +110500* THE FILE. AN INVALID KEY CONDITION IX2144.2 +110600* IS EXPECTED WHEN THE START IS EXECUTED. IX2144.2 +110700* IX2144.2 +110800 START IX-FS1 IX2144.2 +110900 KEY IS NOT LESS THAN IX-FS1-KEY IX2144.2 +111000 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2144.2 +111100 GO TO START-PASS-GF-04. IX2144.2 +111200 MOVE FS1-STATUS TO FILESTATUS (4). IX2144.2 +111300 READ IX-FS1 AT END IX2144.2 +111400 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +111500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +111600 PERFORM FAIL. IX2144.2 +111700 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +111800 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +111900 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +112000 TO RE-MARK. IX2144.2 +112100 GO TO START-WRITE-GF-04. IX2144.2 +112200 START-PASS-GF-04. IX2144.2 +112300 PERFORM PASS. IX2144.2 +112400 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +112500 GO TO START-WRITE-GF-04. IX2144.2 +112600 START-DELETE-GF-04. IX2144.2 +112700 PERFORM DE-LETE. IX2144.2 +112800 START-WRITE-GF-04. IX2144.2 +112900 PERFORM PRINT-DETAIL. IX2144.2 +113000 START-INIT-GF-05. IX2144.2 +113100 PERFORM START-INITIALIZE-RECORD. IX2144.2 +113200 MOVE "START-TEST-GF-05" TO PAR-NAME. IX2144.2 +113300 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +113400 PERFORM START-INIT-ERROR IX2144.2 +113500 GO TO START-DELETE-GF-05. IX2144.2 +113600 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2144.2 +113700 MOVE "IIIIIIIIJJ083ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +113800 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +113900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +114000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +114100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +114200 START-TEST-GF-05. IX2144.2 +114300* START-TEST-GF-.05 - THE START STATEMENT USES AN OPERAND IX2144.2 +114400* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2144.2 +114500* OF A RECORD KEY BUT IS THE NAME OF A IX2144.2 +114600* DATA ITEM WHICH IS SUBORDINATE TO THE IX2144.2 +114700* RECORD KEY. THE CONTENTS OF THE DATA ITEM IX2144.2 +114800* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IX2144.2 +114900* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2144.2 +115000* BALANCE OF THE KEY (POSITIONS 8 THRU 13) IS IX2144.2 +115100* NOT A VALID KEY VALUE FOR THE FILE. THE IX2144.2 +115200* RECORD WITH THE RECORD KEY "CDDDDDDDDD038" IX2144.2 +115300* (RECORD NUMBER 19) IS EXPECTED TO BE FOUND. IX2144.2 +115400* IX2144.2 +115500 START IX-FS1 IX2144.2 +115600 KEY IS NOT LESS THAN R-RECKEY-1-7 IX2144.2 +115700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2144.2 +115800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +115900 GO TO START-FAIL-GF-05. IX2144.2 +116000 MOVE FS1-STATUS TO FILESTATUS (5). IX2144.2 +116100 READ IX-FS1 AT END IX2144.2 +116200 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +116300 GO TO START-FAIL-GF-05. IX2144.2 +116400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +116500 IF XRECORD-NUMBER (1) EQUAL TO 19 IX2144.2 +116600 PERFORM PASS IX2144.2 +116700 MOVE "SUBORDINATE DATA ITEM OF KEY" TO RE-MARK IX2144.2 +116800 GO TO START-WRITE-GF-05. IX2144.2 +116900 MOVE 19 TO RECNO. IX2144.2 +117000 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +117100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +117200 START-FAIL-GF-05. IX2144.2 +117300 PERFORM FAIL. IX2144.2 +117400 MOVE 19 TO CORRECT-18V0. IX2144.2 +117500 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +117600 TO RE-MARK. IX2144.2 +117700 GO TO START-WRITE-GF-05. IX2144.2 +117800 START-DELETE-GF-05. IX2144.2 +117900 PERFORM DE-LETE. IX2144.2 +118000 START-WRITE-GF-05. IX2144.2 +118100 PERFORM PRINT-DETAIL. IX2144.2 +118200 START-INIT-GF-06. IX2144.2 +118300 PERFORM START-INITIALIZE-RECORD. IX2144.2 +118400 MOVE "START-TEST-GF-06" TO PAR-NAME. IX2144.2 +118500 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +118600 PERFORM START-INIT-ERROR IX2144.2 +118700 GO TO START-DELETE-GF-06. IX2144.2 +118800 MOVE "TTTTTUUUUU390" TO FS1-RECKEY-1-13. IX2144.2 +118900 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +119000 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +119100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +119200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +119300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +119400 START-TEST-GF-06. IX2144.2 +119500* IX2144.2 +119600* START-TEST-GF-.06 - THE START STATEMENT USES AN OPERAND IN THE IX2144.2 +119700* KEY PHRASE WHICH IS NOT THE NAME OF A RECORD IX2144.2 +119800* KEY BUT IS THE NAME OF A DATA ITEM THAT IS IX2144.2 +119900* SUBORDINATE TO THE RECORD KEY. THE CONTENTS IX2144.2 +120000* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2144.2 +120100* RECORD KEY) IS A DUPLICATE OF THE FIRST IX2144.2 +120200* 5 POSITIONS OF 6 OTHER RECORDS IN THE FILE. IX2144.2 +120300* THIS TEST EXPECTS THE RECORD POINTER IX2144.2 +120400* TO BE POSITIONED TO RECORD KEY TTTTTTTTTT380 IX2144.2 +120500* (RECORD NUMBER 190) WHICH WAS THE FIRST IX2144.2 +120600* RECORD WRITTEN TO THE FILE IX2144.2 +120700* THAT CONTAINS TTTTT IN THE FIRST 5 POSITIONS IX2144.2 +120800* OF THE KEY. THE RECORD KEY WAS LOADED WITH IX2144.2 +120900* THE VALUE "TTTTTUUUUU390" (KEY FOR RECORD IX2144.2 +121000* NUMBER 195) BEFORE THE START WAS EXECUTED. IX2144.2 +121100* IX2144.2 +121200 START IX-FS1 IX2144.2 +121300 KEY IS NOT LESS THAN IX-FS1-KEY-1-5 IX2144.2 +121400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (6) IX2144.2 +121500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +121600 GO TO START-FAIL-GF-06. IX2144.2 +121700 MOVE FS1-STATUS TO FILESTATUS (6). IX2144.2 +121800 READ IX-FS1 AT END IX2144.2 +121900 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +122000 GO TO START-FAIL-GF-06. IX2144.2 +122100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +122200 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2144.2 +122300 PERFORM PASS IX2144.2 +122400 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2144.2 +122500 GO TO START-WRITE-GF-06. IX2144.2 +122600 MOVE 65 TO RECNO. IX2144.2 +122700 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +122800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +122900 START-FAIL-GF-06. IX2144.2 +123000 PERFORM FAIL. IX2144.2 +123100 MOVE 190 TO CORRECT-18V0. IX2144.2 +123200 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +123300 TO RE-MARK. IX2144.2 +123400 GO TO START-WRITE-GF-06. IX2144.2 +123500 START-DELETE-GF-06. IX2144.2 +123600 PERFORM DE-LETE. IX2144.2 +123700 START-WRITE-GF-06. IX2144.2 +123800 PERFORM PRINT-DETAIL. IX2144.2 +123900 START-INIT-GF-07. IX2144.2 +124000 PERFORM START-INITIALIZE-RECORD. IX2144.2 +124100 MOVE "START-TEST-GF-07" TO PAR-NAME. IX2144.2 +124200 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +124300 PERFORM START-INIT-ERROR IX2144.2 +124400 GO TO START-DELETE-GF-07. IX2144.2 +124500 MOVE "UUUUUUVUUU410" TO FS1-RECKEY-1-13. IX2144.2 +124600 MOVE "FFFFFFFFFG022ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +124700 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +124800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +124900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +125000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +125100 START-TEST-GF-07. IX2144.2 +125200* IX2144.2 +125300* START-TEST-GF-.07 - THE START STATEMENT USES AN OPERAND IN THE IX2144.2 +125400* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +125500* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2144.2 +125600* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +125700* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IX2144.2 +125800* IS LOADED WITH "UUUUUUV" WHICH IS HIGHER THANIX2144.2 +125900* THE KEY VALUE OF THE LAST RECORD IN THE FILE.IX2144.2 +126000* THERE SHOULD BE NO RECORD IN THE FILE NOT IX2144.2 +126100* LESS THAN THIS KEY VALUE THUS AND INVALID KEYIX2144.2 +126200* IS EXPECTED WHEN THE START IS EXECUTED. IX2144.2 +126300* IX2144.2 +126400 START IX-FS1 IX2144.2 +126500 KEY IS NOT LESS THAN R-RECKEY-1-7 IX2144.2 +126600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2144.2 +126700 GO TO START-PASS-GF-07. IX2144.2 +126800 MOVE FS1-STATUS TO FILESTATUS (7). IX2144.2 +126900 READ IX-FS1 AT END IX2144.2 +127000 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +127100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +127200 PERFORM FAIL. IX2144.2 +127300 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +127400 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +127500 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +127600 TO RE-MARK. IX2144.2 +127700 GO TO START-WRITE-GF-07. IX2144.2 +127800 START-PASS-GF-07. IX2144.2 +127900 PERFORM PASS. IX2144.2 +128000 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +128100 GO TO START-WRITE-GF-07. IX2144.2 +128200 START-DELETE-GF-07. IX2144.2 +128300 PERFORM DE-LETE. IX2144.2 +128400 START-WRITE-GF-07. IX2144.2 +128500 PERFORM PRINT-DETAIL. IX2144.2 +128600 START-INIT-GF-08. IX2144.2 +128700 PERFORM START-INITIALIZE-RECORD. IX2144.2 +128800 MOVE "START-TEST-GF-08" TO PAR-NAME. IX2144.2 +128900 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +129000 PERFORM START-INIT-ERROR IX2144.2 +129100 GO TO START-DELETE-GF-08. IX2144.2 +129200 MOVE "ABBBBBBBBC002" TO FS1-RECKEY-1-13. IX2144.2 +129300 MOVE "XYYYYYYYYY399ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +129400 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +129500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +129600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +129700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +129800 START-TEST-GF-08. IX2144.2 +129900* IX2144.2 +130000* START-TEST-GF-.08 - THIS TEST USES AN OPERAND IN THE KEY IX2144.2 +130100* PHRASE OF THE START STATEMENT WHICH IS A DATAIX2144.2 +130200* ITEM SUBORDINATE TO THE RECORD KEY NAME. THEIX2144.2 +130300* CONTENTS OF THE DATA ITEM (POSITIONS 1 THRU IX2144.2 +130400* 7 OF THE RECORD KEY) IS LOADED WITH "ABBBBBB"IX2144.2 +130500* THIS KEY VALUE IS LOWER THAN ANY RECORD IX2144.2 +130600* KEY VALUE IN POSITIONS 1 THRU 7 EXISTING IX2144.2 +130700* IN THE FILE. THE START STATEMENT WITH THE IX2144.2 +130800* KEY IS NOT LESS THAN PHRASE IS EXECUTED AND IX2144.2 +130900* SHOULD FIND THE RECORD WITH THE KEY VALUE IX2144.2 +131000* "BBBBBBBBBC002" (RECORD NUMBER 01). IX2144.2 +131100* IX2144.2 +131200 START IX-FS1 IX2144.2 +131300 KEY IS NOT LESS THAN R-RECKEY-1-7 IX2144.2 +131400 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2144.2 +131500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +131600 GO TO START-FAIL-GF-08. IX2144.2 +131700 MOVE FS1-STATUS TO FILESTATUS (8). IX2144.2 +131800 READ IX-FS1 AT END IX2144.2 +131900 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +132000 GO TO START-FAIL-GF-08. IX2144.2 +132100 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +132200 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2144.2 +132300 PERFORM PASS IX2144.2 +132400 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2144.2 +132500 GO TO START-WRITE-GF-08. IX2144.2 +132600 MOVE 01 TO RECNO. IX2144.2 +132700 PERFORM DISPLAY-RECORD-KEYS. IX2144.2 +132800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +132900 START-FAIL-GF-08. IX2144.2 +133000 PERFORM FAIL. IX2144.2 +133100 MOVE 001 TO CORRECT-18V0. IX2144.2 +133200 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +133300 TO RE-MARK. IX2144.2 +133400 GO TO START-WRITE-GF-08. IX2144.2 +133500 START-DELETE-GF-08. IX2144.2 +133600 PERFORM DE-LETE. IX2144.2 +133700 START-WRITE-GF-08. IX2144.2 +133800 PERFORM PRINT-DETAIL. IX2144.2 +133900 START-INIT-GF-09. IX2144.2 +134000 PERFORM START-INITIALIZE-RECORD. IX2144.2 +134100 MOVE "START-TEST-GF-09" TO PAR-NAME. IX2144.2 +134200 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +134300 PERFORM START-INIT-ERROR IX2144.2 +134400 GO TO START-DELETE-GF-09. IX2144.2 +134500 MOVE "UUUUUUVVVV400" TO FS1-RECKEY-1-13. IX2144.2 +134600 MOVE "EEEEEEEEEF002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +134700 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +134800 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +134900 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +135000 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +135100 START-TEST-GF-09. IX2144.2 +135200* IX2144.2 +135300* START-TEST-GF-.09 - THIS TEST USES AN OPERAND IN THE IX2144.2 +135400* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +135500* A DATA ITEM SUBORDINATE TO THE RECORD KEY IX2144.2 +135600* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +135700* (POSITIONS 1 THRU 7 OF THE RECORD KEY) IS IX2144.2 +135800* LOADED WITH "UUUUUUV". THIS KEY VALUE IX2144.2 +135900* IS NOT LESS THAN ANY RECORD KEY VALUE IN IX2144.2 +136000* POSITION 1 THRU 7 EXISTING IN THE FILE IX2144.2 +136100* THEREFORE AN INVALID KEY CONDITION IS IX2144.2 +136200* EXPECTED WHEN THE START STATEMENT IS IX2144.2 +136300* EXECUTED. IX2144.2 +136400* IX2144.2 +136500 START IX-FS1 IX2144.2 +136600 KEY IS NOT LESS THAN R-RECKEY-1-7 IX2144.2 +136700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (9) IX2144.2 +136800 GO TO START-PASS-GF-09. IX2144.2 +136900 MOVE FS1-STATUS TO FILESTATUS (9). IX2144.2 +137000 READ IX-FS1 AT END IX2144.2 +137100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +137200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +137300 PERFORM FAIL. IX2144.2 +137400 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +137500 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +137600 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +137700 TO RE-MARK. IX2144.2 +137800 GO TO START-WRITE-GF-09. IX2144.2 +137900 START-PASS-GF-09. IX2144.2 +138000 PERFORM PASS. IX2144.2 +138100 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +138200 GO TO START-WRITE-GF-09. IX2144.2 +138300 START-DELETE-GF-09. IX2144.2 +138400 PERFORM DE-LETE. IX2144.2 +138500 START-WRITE-GF-09. IX2144.2 +138600 PERFORM PRINT-DETAIL. IX2144.2 +138700 CLOSE IX-FS1. IX2144.2 +138800 IX2144.2 +138900* IX2144.2 +139000* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2144.2 +139100* CAPTURED FROM THE TESTS IN START-TEST-GF-. IX2144.2 +139200* IX2144.2 +139300 START-TEST-GF-10. IX2144.2 +139400 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +139500 MOVE "START-TEST-GF-10" TO PAR-NAME. IX2144.2 +139600 IF FILESTATUS (1) EQUAL TO "**" IX2144.2 +139700 PERFORM DE-LETE IX2144.2 +139800 MOVE "FROM START-TEST-GF-01" TO CORRECT-A IX2144.2 +139900 GO TO START-TEST-GF-10A. IX2144.2 +140000* IX2144.2 +140100* START-TEST-004.01 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +140200* RESULTING FROM START-TEST-GF-01. THE FILE IX2144.2 +140300* STATUS CONTENTS IS EXPECTED TO BE "00". IX2144.2 +140400* IX2144.2 +140500 IF FILESTATUS (1) EQUAL TO "00" IX2144.2 +140600 PERFORM PASS IX2144.2 +140700 ELSE IX2144.2 +140800 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-01" TO RE-MARKIX2144.2 +140900 PERFORM FAIL IX2144.2 +141000 MOVE "00" TO CORRECT-A IX2144.2 +141100 MOVE FILESTATUS (1) TO COMPUTED-A. IX2144.2 +141200 START-TEST-GF-10A. IX2144.2 +141300 PERFORM PRINT-DETAIL. IX2144.2 +141400 START-TEST-GF-11. IX2144.2 +141500 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +141600 MOVE "START-TEST-GF-11" TO PAR-NAME. IX2144.2 +141700 IF FILESTATUS (2) EQUAL TO "**" IX2144.2 +141800 PERFORM DE-LETE IX2144.2 +141900 MOVE "FROM START-TEST-GF-02" TO CORRECT-A IX2144.2 +142000 GO TO START-TEST-GF-11A. IX2144.2 +142100* IX2144.2 +142200* START-TEST-004.02 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +142300* RESULTING FROM START-TEST-GF-02. THE FILE IX2144.2 +142400* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +142500* IX2144.2 +142600 IF FILESTATUS (2) EQUAL TO "00" IX2144.2 +142700 PERFORM PASS IX2144.2 +142800 ELSE PERFORM FAIL IX2144.2 +142900 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-02" TO RE-MARKIX2144.2 +143000 MOVE "00" TO CORRECT-A IX2144.2 +143100 MOVE FILESTATUS (2) TO COMPUTED-A. IX2144.2 +143200 START-TEST-GF-11A. IX2144.2 +143300 PERFORM PRINT-DETAIL. IX2144.2 +143400 START-TEST-GF-12. IX2144.2 +143500 MOVE "START-TEST-GF-12" TO PAR-NAME. IX2144.2 +143600 IF FILESTATUS (3) EQUAL TO "**" IX2144.2 +143700 PERFORM DE-LETE IX2144.2 +143800 MOVE "FROM START-TEST-GF-03" TO CORRECT-A IX2144.2 +143900 GO TO START-TEST-GF-12A. IX2144.2 +144000* IX2144.2 +144100* START-TEST-004.03 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +144200* RESULTING FROM START-TEST-GF-03. THE FILE IX2144.2 +144300* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +144400* IX2144.2 +144500 IF FILESTATUS (3) EQUAL TO "00" IX2144.2 +144600 PERFORM PASS IX2144.2 +144700 ELSE PERFORM FAIL IX2144.2 +144800 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-03" TO RE-MARKIX2144.2 +144900 MOVE "00" TO CORRECT-A IX2144.2 +145000 MOVE FILESTATUS (3) TO COMPUTED-A. IX2144.2 +145100 START-TEST-GF-12A. IX2144.2 +145200 PERFORM PRINT-DETAIL. IX2144.2 +145300 START-TEST-GF-13. IX2144.2 +145400 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +145500 MOVE "START-TEST-GF-13" TO PAR-NAME. IX2144.2 +145600 IF FILESTATUS (4) EQUAL TO "**" IX2144.2 +145700 PERFORM DE-LETE IX2144.2 +145800 MOVE "FROM START-TEST-GF-04" TO CORRECT-A IX2144.2 +145900 GO TO START-TEST-GF-13A. IX2144.2 +146000* IX2144.2 +146100* START-TEST-004.04 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +146200* RESULTING FROM START-TEST-GF-04. THE FILE IX2144.2 +146300* STATUS CONTENTS IS EXPECTED TO BE "23". IX2144.2 +146400* IX2144.2 +146500 IF FILESTATUS (4) EQUAL TO "23" IX2144.2 +146600 PERFORM PASS IX2144.2 +146700 ELSE PERFORM FAIL IX2144.2 +146800 MOVE "FROM START-TEST-GF-04; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +146900 MOVE "23" TO CORRECT-A IX2144.2 +147000 MOVE FILESTATUS (4) TO COMPUTED-A. IX2144.2 +147100 START-TEST-GF-13A. IX2144.2 +147200 PERFORM PRINT-DETAIL. IX2144.2 +147300 START-TEST-GF-14. IX2144.2 +147400 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +147500 MOVE "START-TEST-GF-14" TO PAR-NAME. IX2144.2 +147600 IF FILESTATUS (5) EQUAL TO "**" IX2144.2 +147700 PERFORM DE-LETE IX2144.2 +147800 MOVE "FROM START-TEST-GF-05" TO CORRECT-A IX2144.2 +147900 GO TO START-TEST-GF-14A. IX2144.2 +148000* IX2144.2 +148100* START-TEST-004.05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +148200* RESULTING FROM START-TEST-GF-05. THE FILE IX2144.2 +148300* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +148400* IX2144.2 +148500 IF FILESTATUS (5) EQUAL TO "00" IX2144.2 +148600 PERFORM PASS IX2144.2 +148700 ELSE PERFORM FAIL IX2144.2 +148800 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-05" TO RE-MARKIX2144.2 +148900 MOVE "00" TO CORRECT-A IX2144.2 +149000 MOVE FILESTATUS (5) TO COMPUTED-A. IX2144.2 +149100 START-TEST-GF-14A. IX2144.2 +149200 PERFORM PRINT-DETAIL. IX2144.2 +149300 START-TEST-GF-15. IX2144.2 +149400 MOVE "START-TEST-GF-15" TO PAR-NAME. IX2144.2 +149500 IF FILESTATUS (6) EQUAL TO "**" IX2144.2 +149600 PERFORM DE-LETE IX2144.2 +149700 MOVE "FROM START-TEST-GF-06" TO CORRECT-A IX2144.2 +149800 GO TO START-TEST-GF-15A. IX2144.2 +149900* IX2144.2 +150000* START-TEST-004.06 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +150100* RESULTING FROM START-TEST-GF-06. THE FILE IX2144.2 +150200* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +150300* IX2144.2 +150400 IF FILESTATUS (6) EQUAL TO "00" IX2144.2 +150500 PERFORM PASS IX2144.2 +150600 ELSE PERFORM FAIL IX2144.2 +150700 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-06" TO RE-MARKIX2144.2 +150800 MOVE "00" TO CORRECT-A IX2144.2 +150900 MOVE FILESTATUS (6) TO COMPUTED-A. IX2144.2 +151000 START-TEST-GF-15A. IX2144.2 +151100 PERFORM PRINT-DETAIL. IX2144.2 +151200 START-TEST-GF-16. IX2144.2 +151300 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +151400 MOVE "START-TEST-GF-16" TO PAR-NAME. IX2144.2 +151500 IF FILESTATUS (7) EQUAL TO "**" IX2144.2 +151600 PERFORM DE-LETE IX2144.2 +151700 MOVE "FROM START-TEST-GF-07" TO CORRECT-A IX2144.2 +151800 GO TO START-TEST-GF-16A. IX2144.2 +151900* IX2144.2 +152000* START-TEST-004.07 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +152100* RESULTING FROM START-TEST-GF-07. THE FILE IX2144.2 +152200* STATUS CONTENTS IS EXPECTED TO BE "23" IX2144.2 +152300* IX2144.2 +152400 IF FILESTATUS (7) EQUAL TO "23" IX2144.2 +152500 PERFORM PASS IX2144.2 +152600 ELSE PERFORM FAIL IX2144.2 +152700 MOVE "FROM START-TEST-GF-07; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +152800 MOVE "23" TO CORRECT-A IX2144.2 +152900 MOVE FILESTATUS (7) TO COMPUTED-A. IX2144.2 +153000 START-TEST-GF-16A. IX2144.2 +153100 PERFORM PRINT-DETAIL. IX2144.2 +153200 START-TEST-GF-17. IX2144.2 +153300 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +153400 MOVE "START-TEST-GF-17" TO PAR-NAME. IX2144.2 +153500 IF FILESTATUS (8) EQUAL TO "**" IX2144.2 +153600 PERFORM DE-LETE IX2144.2 +153700 MOVE "FROM START-TEST-GF-08" TO CORRECT-A IX2144.2 +153800 GO TO START-TEST-GF-17A. IX2144.2 +153900* IX2144.2 +154000* START-TEST-004.08 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +154100* RESULTING FROM START-TEST-GF-08. THE FILE IX2144.2 +154200* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +154300* IX2144.2 +154400 IF FILESTATUS (8) EQUAL TO "00" IX2144.2 +154500 PERFORM PASS IX2144.2 +154600 ELSE PERFORM FAIL IX2144.2 +154700 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-08" TO RE-MARKIX2144.2 +154800 MOVE "00" TO CORRECT-A IX2144.2 +154900 MOVE FILESTATUS (8) TO COMPUTED-A. IX2144.2 +155000 START-TEST-GF-17A. IX2144.2 +155100 PERFORM PRINT-DETAIL. IX2144.2 +155200 START-TEST-GF-18. IX2144.2 +155300 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +155400 MOVE "START-TEST-GF-18" TO PAR-NAME. IX2144.2 +155500 IF FILESTATUS (9) EQUAL TO "**" IX2144.2 +155600 PERFORM DE-LETE IX2144.2 +155700 MOVE "FROM START-TEST-GF-09" TO CORRECT-A IX2144.2 +155800 GO TO START-TEST-GF-18A. IX2144.2 +155900* IX2144.2 +156000* START-TEST-004.09 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +156100* RESULTING FROM START-TEST-GF-09. THE FILE IX2144.2 +156200* STATUS CONTENTS IS EXPECTED TO BE "23". IX2144.2 +156300* IX2144.2 +156400 IF FILESTATUS (9) EQUAL TO "23" IX2144.2 +156500 PERFORM PASS IX2144.2 +156600 ELSE PERFORM FAIL IX2144.2 +156700 MOVE "FROM START-TEST-GF-09; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +156800 MOVE "23" TO CORRECT-A IX2144.2 +156900 MOVE FILESTATUS (9) TO COMPUTED-A. IX2144.2 +157000 START-TEST-GF-18A. IX2144.2 +157100 PERFORM PRINT-DETAIL. IX2144.2 +157200 IX2144.2 +157300 IX2144.2 +157400*START-INIT-005. IX2144.2 +157500 OPEN INPUT IX-FS1. IX2144.2 +157600 MOVE "STR NLT ALTKY W/O DUP" TO FEATURE. IX2144.2 +157700 MOVE SPACE TO HOLD-FILESTATUS-RECORD. IX2144.2 +157800* IX2144.2 +157900* THE "START - NOT LESS THAN--" IS CHECKED FOR PROPER POSITIONINGIX2144.2 +158000* OF THE RECORD POINTER FOR THE SUBSEQUENT READ STATEMENT. IX2144.2 +158100* START-TEST-GF USES ONLY THE ALTERNATE RECORD KEY WITHOUT THE IX2144.2 +158200* THE DUPLICATES OPTION FOR ESTABLISHING THE CURRENT RECORD IX2144.2 +158300* POINTER FOR THE FILE. THE FOLLOWING IS A SUMMARY OF THE TEST IX2144.2 +158400* CONDITIONS AND THE EXPECTED ACTION TO BE TAKEN FOR THE TESTS. IX2144.2 +158500* IX2144.2 +158600* CONDITIONS (CONTENTS OF KEY) / ACTION IX2144.2 +158700* IX2144.2 +158800* START-TEST-GF-19 - EQUAL A RECORD IN FILE / RECORD FOUND IX2144.2 +158900* START-TEST-GF-20 - BETWEEN 2 KEY VALUES / RECORD FOUND IX2144.2 +159000* START-TEST-GF-21 - LESS THAN FIRST FILE REC. / REC. FOUND IX2144.2 +159100* START-TEST-GF-22 - NOT LESS THAN LAST FILE RECORD / INVALID KIX2144.2 +159200* START-TEST-GF-23 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUIX2144.2 +159300* START-TEST-GF-24 - UNEQUAL SIZE OPERANDS (EQUAL) / RECORD FOUIX2144.2 +159400* START-TEST-GF-25 - UNEQUAL SIZE OPERANDS (UNEQUAL) / INVLD KEIX2144.2 +159500* START-TEST-GF-26 - UNEQUAL SIZE OPERANDS (UNEQUAL) / REC FOUNIX2144.2 +159600* START-TEST-GF-27 - UNEQUAL SIZE OPERANDS (UNEQUAL) /INVLD KEYIX2144.2 +159700* IX2144.2 +159800* BEFORE EACH TEST A RECORD IS MADE AVAILABLE WHICH IS DIFFERENT IX2144.2 +159900* THAN THE ONE WHICH IS EXPECTED TO BE PRESENT FOLLOWING A TEST. IX2144.2 +160000* IF DURING THIS INITIALIZATION AN INVALID KEY OCCURS THE TEST IX2144.2 +160100* WILL BE DELETED AND CONTROL WILL BE PASSED TO THE NEXT TEST. IX2144.2 +160200* WHEN TESTING IF AN INVALID KEY IS EXPECTED, THE KEYS IX2144.2 +160300* ASSOCIATED WITH THE FILE WHICH ARE NOT PARTICIPATING IN THE IX2144.2 +160400* START STATEMENT WILL BE LOADED WITH VALUES WHICH WOULD IX2144.2 +160500* MATCH RECORDS IN THE FILE. BUT IF A KEY MATCH IS EXPECTED FROMIX2144.2 +160600* THE TEST, THE KEYS ASSOCIATED WITH THE FILE WHICH ARE NOT IX2144.2 +160700* PARTICIPATING IN THE START STATEMENT WILL BE LOADED WITH IX2144.2 +160800* VALUES WHICH WOULD NOT MATCH RECORDS IN THE FILE. THE FILE IX2144.2 +160900* STATUS FROM EXECUTION OF EACH START IS CAPTURED FOR LATER TESTSIX2144.2 +161000* IX2144.2 +161100 START-INIT-GF-19. IX2144.2 +161200 PERFORM START-INITIALIZE-RECORD. IX2144.2 +161300 MOVE "START-TEST-GF-19" TO PAR-NAME. IX2144.2 +161400 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +161500 PERFORM START-INIT-ERROR IX2144.2 +161600 GO TO START-DELETE-GF-19. IX2144.2 +161700 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2144.2 +161800 MOVE "XXXXXXXXYY384ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +161900 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +162000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +162100 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +162200 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +162300 START-TEST-GF-19. IX2144.2 +162400* IX2144.2 +162500* START-TEST-GF.01 - THE START SHOULD FIND A RECORD IN THE FILE IX2144.2 +162600* WHICH HAS AN ALTERNATE KEY VALUE OF IX2144.2 +162700* XXXXXXXXYY384ALTKEY1 (RECORD NUMBER 192). IX2144.2 +162800* IX2144.2 +162900 START IX-FS1 IX2144.2 +163000 KEY IS NOT LESS THAN IX-FS1-ALTKEY1 IX2144.2 +163100 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (1) IX2144.2 +163200 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +163300 GO TO START-FAIL-GF-19. IX2144.2 +163400 MOVE FS1-STATUS TO FILESTATUS (1). IX2144.2 +163500 READ IX-FS1 AT END IX2144.2 +163600 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +163700 GO TO START-FAIL-GF-19. IX2144.2 +163800 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +163900 IF XRECORD-NUMBER (1) EQUAL TO 192 IX2144.2 +164000 PERFORM PASS IX2144.2 +164100 MOVE SPACE TO RE-MARK IX2144.2 +164200 GO TO START-WRITE-GF-19. IX2144.2 +164300 MOVE 67 TO RECNO. IX2144.2 +164400 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +164500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +164600 START-FAIL-GF-19. IX2144.2 +164700 PERFORM FAIL. IX2144.2 +164800 MOVE 192 TO CORRECT-18V0. IX2144.2 +164900 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +165000 TO RE-MARK. IX2144.2 +165100 GO TO START-WRITE-GF-19. IX2144.2 +165200 START-DELETE-GF-19. IX2144.2 +165300 PERFORM DE-LETE. IX2144.2 +165400 START-WRITE-GF-19. IX2144.2 +165500 PERFORM PRINT-DETAIL. IX2144.2 +165600 START-INIT-GF-20. IX2144.2 +165700 PERFORM START-INITIALIZE-RECORD. IX2144.2 +165800 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2144.2 +165900 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +166000 PERFORM START-INIT-ERROR IX2144.2 +166100 GO TO START-DELETE-GF-20. IX2144.2 +166200 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2144.2 +166300 MOVE "HHHHHHHIII67ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +166400 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +166500 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +166600 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +166700 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +166800 START-TEST-GF-20. IX2144.2 +166900* IX2144.2 +167000* START-TEST-GF.02 - THE START SHOULD FIND A RECORD IN THE FILE IX2144.2 +167100* WHICH HAS AN ALTERNATE KEY VALUE OF IX2144.2 +167200* HHHHHHIIII068ALTKEY1 (RECORD NUMBER 34). IX2144.2 +167300* THE DATA ITEM WAS LOADED WITH A KEY VALUE IX2144.2 +167400* SEQUENTIALLY LOCATED BETWEEN TWO CURRENTLY IX2144.2 +167500* EXISTING ALTERNATE KEYS IN THE FILE. IX2144.2 +167600* IX2144.2 +167700 START IX-FS1 IX2144.2 +167800 KEY IS NOT LESS THAN IX-FS1-ALTKEY1 IX2144.2 +167900 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (2) IX2144.2 +168000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +168100 GO TO START-FAIL-GF-20. IX2144.2 +168200 MOVE FS1-STATUS TO FILESTATUS (2). IX2144.2 +168300 READ IX-FS1 AT END IX2144.2 +168400 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +168500 GO TO START-FAIL-GF-20. IX2144.2 +168600 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +168700 IF XRECORD-NUMBER (1) EQUAL TO 034 IX2144.2 +168800 PERFORM PASS IX2144.2 +168900 MOVE SPACE TO RE-MARK IX2144.2 +169000 GO TO START-WRITE-GF-20. IX2144.2 +169100 MOVE 34 TO RECNO. IX2144.2 +169200 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +169300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +169400 START-FAIL-GF-20. IX2144.2 +169500 PERFORM FAIL. IX2144.2 +169600 MOVE 034 TO CORRECT-18V0. IX2144.2 +169700 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +169800 TO RE-MARK. IX2144.2 +169900 GO TO START-WRITE-GF-20. IX2144.2 +170000 START-DELETE-GF-20. IX2144.2 +170100 PERFORM DE-LETE. IX2144.2 +170200 START-WRITE-GF-20. IX2144.2 +170300 PERFORM PRINT-DETAIL. IX2144.2 +170400 START-INIT-GF-21. IX2144.2 +170500 PERFORM START-INITIALIZE-RECORD. IX2144.2 +170600 MOVE "START-TEST-GF-21" TO PAR-NAME. IX2144.2 +170700 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +170800 PERFORM START-INIT-ERROR IX2144.2 +170900 GO TO START-DELETE-GF-21. IX2144.2 +171000 MOVE "CCCCCDDDDD022" TO FS1-RECKEY-1-13. IX2144.2 +171100 MOVE "EEEEEEEEEF001ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +171200 MOVE "EEEEEFFFFF022ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +171300 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +171400 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +171500 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +171600 START-TEST-GF-21. IX2144.2 +171700* IX2144.2 +171800* START-TEST-GF.03 - THE START STATEMENT SHOULD FIND A IX2144.2 +171900* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2144.2 +172000* KEY VALUE OF EEEEEEEEEF002ALTKEY1 (RECORD IX2144.2 +172100* NUMBER 01). THE ALTERNATE KEY WAS LOADED IX2144.2 +172200* WITH A VALUE THAT IS SEQUENTIALLY LOWER IX2144.2 +172300* THAN ANY CURRENTLY EXISTNNG KEY IN THE FILE IX2144.2 +172400* BEFORE THE START WAS EXECUTED. IX2144.2 +172500* IX2144.2 +172600 START IX-FS1 IX2144.2 +172700 KEY IS NOT LESS THAN IX-FS1-ALTKEY1 IX2144.2 +172800 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (3) IX2144.2 +172900 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +173000 GO TO START-FAIL-GF-21. IX2144.2 +173100 MOVE FS1-STATUS TO FILESTATUS (3). IX2144.2 +173200 READ IX-FS1 AT END IX2144.2 +173300 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +173400 GO TO START-FAIL-GF-21. IX2144.2 +173500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +173600 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2144.2 +173700 PERFORM PASS IX2144.2 +173800 MOVE SPACE TO RE-MARK IX2144.2 +173900 GO TO START-WRITE-GF-21. IX2144.2 +174000 MOVE 01 TO RECNO. IX2144.2 +174100 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +174200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +174300 START-FAIL-GF-21. IX2144.2 +174400 PERFORM FAIL. IX2144.2 +174500 MOVE 001 TO CORRECT-18V0. IX2144.2 +174600 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +174700 TO RE-MARK. IX2144.2 +174800 GO TO START-WRITE-GF-21. IX2144.2 +174900 START-DELETE-GF-21. IX2144.2 +175000 PERFORM DE-LETE. IX2144.2 +175100 START-WRITE-GF-21. IX2144.2 +175200 PERFORM PRINT-DETAIL. IX2144.2 +175300 START-INIT-GF-22. IX2144.2 +175400 PERFORM START-INITIALIZE-RECORD. IX2144.2 +175500 MOVE "START-TEST-GF-22" TO PAR-NAME. IX2144.2 +175600 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +175700 PERFORM START-INIT-ERROR IX2144.2 +175800 GO TO START-DELETE-GF-22. IX2144.2 +175900 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2144.2 +176000 MOVE "YYYYYYYYYY401ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +176100 MOVE "DDDDDDDDDD000ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +176200 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +176300 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +176400 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +176500 START-TEST-GF-22. IX2144.2 +176600* IX2144.2 +176700* START-TEST-GF.04 - THE START STATEMENT SHOULD NOT FIND A IX2144.2 +176800* RECORD IN THE FILE WHICH HAS AN ALTERNATE IX2144.2 +176900* KEY VALUE OF YYYYYYYYYY401ALTKEY1. THIS IX2144.2 +177000* VALUE IS SEQUENTIALLY NOT LESS THAN IX2144.2 +177100* ANY ALTERNATE KEY CURRENTLY EXISTING IN IX2144.2 +177200* THE FILE. AN INVALID KEY CONDITION IX2144.2 +177300* IS EXPECTED WHEN THE START IS EXECUTED. IX2144.2 +177400* IX2144.2 +177500 START IX-FS1 IX2144.2 +177600 KEY IS NOT LESS THAN IX-FS1-ALTKEY1 IX2144.2 +177700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (4) IX2144.2 +177800 GO TO START-PASS-GF-22. IX2144.2 +177900 MOVE FS1-STATUS TO FILESTATUS (4). IX2144.2 +178000 READ IX-FS1 AT END IX2144.2 +178100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +178200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +178300 PERFORM FAIL. IX2144.2 +178400 MOVE ALTERNATE-KEY1 (1) TO COMPUTED-A. IX2144.2 +178500 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +178600 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +178700 TO RE-MARK. IX2144.2 +178800 GO TO START-WRITE-GF-22. IX2144.2 +178900 START-PASS-GF-22. IX2144.2 +179000 PERFORM PASS. IX2144.2 +179100 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +179200 GO TO START-WRITE-GF-22. IX2144.2 +179300 START-DELETE-GF-22. IX2144.2 +179400 PERFORM DE-LETE. IX2144.2 +179500 START-WRITE-GF-22. IX2144.2 +179600 PERFORM PRINT-DETAIL. IX2144.2 +179700 START-INIT-GF-23. IX2144.2 +179800 PERFORM START-INITIALIZE-RECORD. IX2144.2 +179900 MOVE "START-TEST-GF-23" TO PAR-NAME. IX2144.2 +180000 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +180100 PERFORM START-INIT-ERROR IX2144.2 +180200 GO TO START-DELETE-GF-23. IX2144.2 +180300 MOVE "CDDDDDDDDD039" TO FS1-RECKEY-1-13. IX2144.2 +180400 MOVE "GGGGHHHHHH100ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +180500 MOVE "ABCXXXXXXX400ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +180600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +180700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +180800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +180900 START-TEST-GF-23. IX2144.2 +181000* IX2144.2 +181100* START-TEST-GF.05 - THE START STATEMENT USES AN OPERAND IX2144.2 +181200* IN THE KEY PHRASE WHICH IS NOT THE NAME IX2144.2 +181300* OF AN ALTERNATE KEY BUT IS THE NAME OF A IX2144.2 +181400* DATA ITEM WHICH IS SUBORDINATE TO THE IX2144.2 +181500* ALTERNATE KEY. THE CONTENTS OF THE DATA ITEMIX2144.2 +181600* (POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IX2144.2 +181700* IS A UNIQUE KEY VALUE FOR THE FILE. THE IX2144.2 +181800* BALANCE OF THE KEY (POSITIONS 7 THRU 20 OF IX2144.2 +181900* THE ALTERNATE KEY IS NOT A VALID KEY VALUE IX2144.2 +182000* FOR THE FILE. THE IX2144.2 +182100* RECORD WITH THE ALTERNATE KEY GGGGHHHHHH052 IX2144.2 +182200* ALTKEY1 (RECORD NUMBER 26) IS EXPECTED TO IX2144.2 +182300* BE FOUND. IX2144.2 +182400* IX2144.2 +182500 START IX-FS1 IX2144.2 +182600 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2144.2 +182700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (5) IX2144.2 +182800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +182900 GO TO START-FAIL-GF-23. IX2144.2 +183000 MOVE FS1-STATUS TO FILESTATUS (5). IX2144.2 +183100 READ IX-FS1 AT END IX2144.2 +183200 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +183300 GO TO START-FAIL-GF-23. IX2144.2 +183400 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +183500 IF XRECORD-NUMBER (1) EQUAL TO 26 IX2144.2 +183600 PERFORM PASS IX2144.2 +183700 MOVE "SUBORDINATE DATA ITEM OF KEY" TO RE-MARK IX2144.2 +183800 GO TO START-WRITE-GF-23. IX2144.2 +183900 MOVE 26 TO RECNO. IX2144.2 +184000 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +184100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +184200 START-FAIL-GF-23. IX2144.2 +184300 PERFORM FAIL. IX2144.2 +184400 MOVE 26 TO CORRECT-18V0. IX2144.2 +184500 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +184600 TO RE-MARK. IX2144.2 +184700 GO TO START-WRITE-GF-23. IX2144.2 +184800 START-DELETE-GF-23. IX2144.2 +184900 PERFORM DE-LETE. IX2144.2 +185000 START-WRITE-GF-23. IX2144.2 +185100 PERFORM PRINT-DETAIL. IX2144.2 +185200 START-INIT-GF-24. IX2144.2 +185300 PERFORM START-INITIALIZE-RECORD. IX2144.2 +185400 MOVE "START-TEST-GF-24" TO PAR-NAME. IX2144.2 +185500 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +185600 PERFORM START-INIT-ERROR IX2144.2 +185700 GO TO START-DELETE-GF-24. IX2144.2 +185800 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2144.2 +185900 MOVE "XXXXXYYYYY390ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +186000 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +186100 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +186200 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +186300 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +186400 START-TEST-GF-24. IX2144.2 +186500* IX2144.2 +186600* START-TEST-GF.06 - THE START STATEMENT USES AN OPERAND IN THE IX2144.2 +186700* KEY PHRASE WHICH IS NOT THE NAME OF AN IX2144.2 +186800* ALTERNATE KEY BUT IS THE NAME OF A DATA ITEM IX2144.2 +186900* THAT IS SUBORDINATE TO THE KEY. THE CONTENTSIX2144.2 +187000* OF THE DATA ITEM (POSITIONS 1 THRU 5 OF THE IX2144.2 +187100* ALTERNATE KEY) IS A DUPLICATE OF THE FIRST IX2144.2 +187200* 5 POSITIONS OF 6 OTHER RECORDS IN THE FILE. IX2144.2 +187300* THIS TEST EXPECTS THE RECORD POINTER IX2144.2 +187400* TO BE POSITIONED TO RECORD KEY XXXXXXXXXX380 IX2144.2 +187500* ALTKEY1 (RECORD NUMBER 190) WHICH WAS THE FIRIX2144.2 +187600* RECORD WRITTEN THAT IX2144.2 +187700* CONTAINS XXXXX IN THE FIRST 5 POSITIONS OF THIX2144.2 +187800* KEY. THE ALTERNATE KEY WAS LOADED WITH THE IX2144.2 +187900* VALUE XXXXXYYYYY390ALTKEY1 (KEY FOR RECORD IX2144.2 +188000* NUMBER 195) BEFORE THE START WAS EXECUTED. IX2144.2 +188100* IX2144.2 +188200 START IX-FS1 IX2144.2 +188300 KEY IS NOT LESS THAN IX-FS1-ALTKEY1-1-5 IX2144.2 +188400 INVALID KEY IX2144.2 +188500 MOVE FS1-STATUS TO FILESTATUS (6) IX2144.2 +188600 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +188700 GO TO START-FAIL-GF-24. IX2144.2 +188800 MOVE FS1-STATUS TO FILESTATUS (6). IX2144.2 +188900 READ IX-FS1 AT END IX2144.2 +189000 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +189100 GO TO START-FAIL-GF-24. IX2144.2 +189200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +189300 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2144.2 +189400 PERFORM PASS IX2144.2 +189500 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2144.2 +189600 GO TO START-WRITE-GF-24. IX2144.2 +189700 MOVE 65 TO RECNO. IX2144.2 +189800 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +189900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +190000 START-FAIL-GF-24. IX2144.2 +190100 PERFORM FAIL. IX2144.2 +190200 MOVE 190 TO CORRECT-18V0. IX2144.2 +190300 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +190400 TO RE-MARK. IX2144.2 +190500 GO TO START-WRITE-GF-24. IX2144.2 +190600 START-DELETE-GF-24. IX2144.2 +190700 PERFORM DE-LETE. IX2144.2 +190800 START-WRITE-GF-24. IX2144.2 +190900 PERFORM PRINT-DETAIL. IX2144.2 +191000 START-INIT-GF-25. IX2144.2 +191100 PERFORM START-INITIALIZE-RECORD. IX2144.2 +191200 MOVE "START-TEST-GF-25" TO PAR-NAME. IX2144.2 +191300 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +191400 PERFORM START-INIT-ERROR IX2144.2 +191500 GO TO START-DELETE-GF-25. IX2144.2 +191600 MOVE "CCCCCCCCCD022" TO FS1-RECKEY-1-13. IX2144.2 +191700 MOVE "YYYYYZYYYY410ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +191800 MOVE "VVVVVVVVVV380ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +191900 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +192000 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +192100 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +192200 START-TEST-GF-25. IX2144.2 +192300* IX2144.2 +192400* START-TEST-GF.07 - THE START STATEMENT USES AN OPERAND IN THE IX2144.2 +192500* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +192600* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2144.2 +192700* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +192800* POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IX2144.2 +192900* IS LOADED WITH YYYYYZ WHICH IS HIGHER THAN THIX2144.2 +193000* KEY VALUE OF THE LAST RECORD IN THE FILE. THIX2144.2 +193100* SHOULD BE NO RECORD IN THE FILE NOT LESS THANIX2144.2 +193200* KEY VALUE THUS AN INVALID KEY IS EXPECTED IX2144.2 +193300* WHEN THE START IS EXECUTED. IX2144.2 +193400* IX2144.2 +193500 START IX-FS1 IX2144.2 +193600 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2144.2 +193700 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (7) IX2144.2 +193800 GO TO START-PASS-GF-25. IX2144.2 +193900 MOVE FS1-STATUS TO FILESTATUS (7). IX2144.2 +194000 READ IX-FS1 AT END IX2144.2 +194100 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +194200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +194300 PERFORM FAIL. IX2144.2 +194400 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +194500 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +194600 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +194700 TO RE-MARK. IX2144.2 +194800 GO TO START-WRITE-GF-25. IX2144.2 +194900 START-PASS-GF-25. IX2144.2 +195000 PERFORM PASS. IX2144.2 +195100 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +195200 GO TO START-WRITE-GF-25. IX2144.2 +195300 START-DELETE-GF-25. IX2144.2 +195400 PERFORM DE-LETE. IX2144.2 +195500 START-WRITE-GF-25. IX2144.2 +195600 PERFORM PRINT-DETAIL. IX2144.2 +195700 START-INIT-GF-26. IX2144.2 +195800 PERFORM START-INITIALIZE-RECORD. IX2144.2 +195900 MOVE "START-TEST-GF-26" TO PAR-NAME. IX2144.2 +196000 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +196100 PERFORM START-INIT-ERROR IX2144.2 +196200 GO TO START-DELETE-GF-26. IX2144.2 +196300 MOVE "YYYYYUUUUU390" TO FS1-RECKEY-1-13. IX2144.2 +196400 MOVE "EEEEDEEEEE002ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +196500 MOVE "WWWWWWWWWV399ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +196600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +196700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +196800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +196900 START-TEST-GF-26. IX2144.2 +197000* IX2144.2 +197100* START-TEST-GF.08 - THIS TEST USES AN OPERAND IN THE IX2144.2 +197200* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +197300* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2144.2 +197400* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +197500* (POSITIONS 1 THRU 6 OF THE ALTERNATE KEY) IS IX2144.2 +197600* LOADED WITH "EEEEDE". THIS KEY VALUE IX2144.2 +197700* IS LOWER THAN ANY ALTERNATE KEY VALUE IN IX2144.2 +197800* POSITION 1 THRU 6 EXISTING IN THE FILE IX2144.2 +197900* THE START STATEMENT WITH THE KEY IS NOT LESS IX2144.2 +198000* THAN PHRASE IS EXECUTED AND SHOULD FIND A IX2144.2 +198100* RECORD WITH THE KEY VALUE "EEEEEEEEEF002 IX2144.2 +198200* ALTKEY1 (RECORD NUMBER 01). IX2144.2 +198300* IX2144.2 +198400 START IX-FS1 IX2144.2 +198500 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2144.2 +198600 INVALID KEY MOVE FS1-STATUS TO FILESTATUS (8) IX2144.2 +198700 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +198800 GO TO START-FAIL-GF-26. IX2144.2 +198900 MOVE FS1-STATUS TO FILESTATUS (8). IX2144.2 +199000 READ IX-FS1 AT END IX2144.2 +199100 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +199200 GO TO START-FAIL-GF-26. IX2144.2 +199300 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +199400 IF XRECORD-NUMBER (1) EQUAL TO 001 IX2144.2 +199500 PERFORM PASS IX2144.2 +199600 MOVE "SUBORDINATE DATA ITEM IN KEY" TO RE-MARK IX2144.2 +199700 GO TO START-WRITE-GF-26. IX2144.2 +199800 MOVE 01 TO RECNO. IX2144.2 +199900 PERFORM DISPLAY-ALTERNATE-KEY1. IX2144.2 +200000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +200100 START-FAIL-GF-26. IX2144.2 +200200 PERFORM FAIL. IX2144.2 +200300 MOVE 001 TO CORRECT-18V0. IX2144.2 +200400 MOVE "IX-36; IX-6: INVALID KEY PATH TAKEN OR AT END ON READ" IX2144.2 +200500 TO RE-MARK. IX2144.2 +200600 GO TO START-WRITE-GF-26. IX2144.2 +200700 START-DELETE-GF-26. IX2144.2 +200800 PERFORM DE-LETE. IX2144.2 +200900 START-WRITE-GF-26. IX2144.2 +201000 PERFORM PRINT-DETAIL. IX2144.2 +201100 START-INIT-GF-27. IX2144.2 +201200 PERFORM START-INITIALIZE-RECORD. IX2144.2 +201300 MOVE "START-TEST-GF-27" TO PAR-NAME. IX2144.2 +201400 IF INIT-FLAG NOT EQUAL ZERO IX2144.2 +201500 PERFORM START-INIT-ERROR IX2144.2 +201600 GO TO START-DELETE-GF-27. IX2144.2 +201700 MOVE "UUUUUUUUUU400" TO FS1-RECKEY-1-13. IX2144.2 +201800 MOVE "YYYYYZYYYY400ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +201900 MOVE "WWWWWWWWWV398ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +202000 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +202100 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +202200 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +202300 START-TEST-GF-27. IX2144.2 +202400* IX2144.2 +202500* START-TEST-GF.09 - THIS TEST USES AN OPERAND IN THE IX2144.2 +202600* KEY PHRASE OF THE START STATEMENT WHICH IS IX2144.2 +202700* A DATA ITEM SUBORDINATE TO THE ALTERNATE KEY IX2144.2 +202800* NAME. THE CONTENTS OF THE DATA ITEM IX2144.2 +202900* (POSITIONS 1 THRU 10 OF THE RECORD KEY) IS IX2144.2 +203000* LOADED WITH "YYYYYZYYYY". THIS KEY VALUE IX2144.2 +203100* IS NOT LESS THAN ANY ALTERNATE KEY VALUE IN IX2144.2 +203200* POSITION 1 THRU 10 EXISTING IN THE FILE IX2144.2 +203300* THEREFORE AN INVALID KEY CONDITION IS IX2144.2 +203400* EXPECTED WHEN THE START STATEMENT IS IX2144.2 +203500* EXECUTED. IX2144.2 +203600* IX2144.2 +203700 START IX-FS1 IX2144.2 +203800 KEY IS NOT LESS THAN IX-FS1-ALTKEY1-1-10 IX2144.2 +203900 INVALID KEY IX2144.2 +204000 MOVE FS1-STATUS TO FILESTATUS (9) IX2144.2 +204100 GO TO START-PASS-GF-27. IX2144.2 +204200 MOVE FS1-STATUS TO FILESTATUS (9). IX2144.2 +204300 READ IX-FS1 AT END IX2144.2 +204400 MOVE "AT END PATH TAKEN ON READ" TO RE-MARK.IX2144.2 +204500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +204600 PERFORM FAIL. IX2144.2 +204700 MOVE XRECORD-KEY (1) TO COMPUTED-A. IX2144.2 +204800 MOVE "INVALID KEY" TO CORRECT-A. IX2144.2 +204900 MOVE "IX-36 INVALID KEY PATH NOT BE TAKEN OR AT END ON READ" IX2144.2 +205000 TO RE-MARK. IX2144.2 +205100 GO TO START-WRITE-GF-27. IX2144.2 +205200 START-PASS-GF-27. IX2144.2 +205300 PERFORM PASS. IX2144.2 +205400 MOVE "INVALID KEY" TO RE-MARK. IX2144.2 +205500 GO TO START-WRITE-GF-27. IX2144.2 +205600 START-DELETE-GF-27. IX2144.2 +205700 PERFORM DE-LETE. IX2144.2 +205800 START-WRITE-GF-27. IX2144.2 +205900 PERFORM PRINT-DETAIL. IX2144.2 +206000 CLOSE IX-FS1. IX2144.2 +206100 IX2144.2 +206200* IX2144.2 +206300* THIS SERIES OF TESTS CHECKS THE CONTENTS OF THE FILE STATUS IX2144.2 +206400* CAPTURED FROM THE TESTS IN START-TEST-GF. IX2144.2 +206500* IX2144.2 +206600 START-TEST-GF-28. IX2144.2 +206700 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +206800 MOVE "START-TEST-GF-28" TO PAR-NAME. IX2144.2 +206900 IF FILESTATUS (1) EQUAL TO "**" IX2144.2 +207000 PERFORM DE-LETE IX2144.2 +207100 MOVE "FROM START-TEST-GF-19" TO CORRECT-A IX2144.2 +207200 GO TO START-TEST-GF-28A. IX2144.2 +207300* IX2144.2 +207400* START-TEST-006.01 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +207500* RESULTING FROM START-TEST-GF-19. THE FILE IX2144.2 +207600* STATUS CONTENTS IS EXPECTED TO BE "00". IX2144.2 +207700* IX2144.2 +207800 IF FILESTATUS (1) EQUAL TO "00" IX2144.2 +207900 PERFORM PASS IX2144.2 +208000 ELSE IX2144.2 +208100 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-19" TO RE-MARKIX2144.2 +208200 PERFORM FAIL IX2144.2 +208300 MOVE "00" TO CORRECT-A IX2144.2 +208400 MOVE FILESTATUS (1) TO COMPUTED-A. IX2144.2 +208500 START-TEST-GF-28A. IX2144.2 +208600 PERFORM PRINT-DETAIL. IX2144.2 +208700 START-TEST-GF-29. IX2144.2 +208800 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2144.2 +208900 IF FILESTATUS (2) EQUAL TO "**" IX2144.2 +209000 PERFORM DE-LETE IX2144.2 +209100 MOVE "FROM START-TEST-GF-20" TO CORRECT-A IX2144.2 +209200 GO TO START-TEST-GF-29A. IX2144.2 +209300* IX2144.2 +209400* START-TEST-006.02 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +209500* RESULTING FROM START-TEST-GF-20. THE FILE IX2144.2 +209600* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +209700* IX2144.2 +209800 IF FILESTATUS (2) EQUAL TO "00" IX2144.2 +209900 PERFORM PASS IX2144.2 +210000 ELSE PERFORM FAIL IX2144.2 +210100 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-20" TO RE-MARKIX2144.2 +210200 MOVE "00" TO CORRECT-A IX2144.2 +210300 MOVE FILESTATUS (2) TO COMPUTED-A. IX2144.2 +210400 START-TEST-GF-29A. IX2144.2 +210500 PERFORM PRINT-DETAIL. IX2144.2 +210600 START-TEST-GF-30. IX2144.2 +210700 MOVE "START-TEST-GF-30" TO PAR-NAME. IX2144.2 +210800 IF FILESTATUS (3) EQUAL TO "**" IX2144.2 +210900 PERFORM DE-LETE IX2144.2 +211000 MOVE "FROM START-TEST-GF.21" TO CORRECT-A IX2144.2 +211100 GO TO START-TEST-GF-30A. IX2144.2 +211200* IX2144.2 +211300* START-TEST-006.03 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +211400* RESULTING FROM START-TEST-GF-21. THE FILE IX2144.2 +211500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +211600* IX2144.2 +211700 IF FILESTATUS (3) EQUAL TO "00" IX2144.2 +211800 PERFORM PASS IX2144.2 +211900 ELSE PERFORM FAIL IX2144.2 +212000 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-21" TO RE-MARKIX2144.2 +212100 MOVE "00" TO CORRECT-A IX2144.2 +212200 MOVE FILESTATUS (3) TO COMPUTED-A. IX2144.2 +212300 START-TEST-GF-30A. IX2144.2 +212400 PERFORM PRINT-DETAIL. IX2144.2 +212500 START-TEST-GF-31. IX2144.2 +212600 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +212700 MOVE "START-TEST-GF-31" TO PAR-NAME. IX2144.2 +212800 IF FILESTATUS (4) EQUAL TO "**" IX2144.2 +212900 PERFORM DE-LETE IX2144.2 +213000 MOVE "FROM START-TEST-GF-22" TO CORRECT-A IX2144.2 +213100 GO TO START-TEST-GF-31A. IX2144.2 +213200* IX2144.2 +213300* START-TEST-006.04 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +213400* RESULTING FROM START-TEST-GF-22. THE FILE IX2144.2 +213500* STATUS CONTENTS IS EXPECTED TO BE "23". IX2144.2 +213600* IX2144.2 +213700 IF FILESTATUS (4) EQUAL TO "23" IX2144.2 +213800 PERFORM PASS IX2144.2 +213900 ELSE PERFORM FAIL IX2144.2 +214000 MOVE "FROM START-TEST-GF-04; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +214100 MOVE "23" TO CORRECT-A IX2144.2 +214200 MOVE FILESTATUS (4) TO COMPUTED-A. IX2144.2 +214300 START-TEST-GF-31A. IX2144.2 +214400 PERFORM PRINT-DETAIL. IX2144.2 +214500 START-TEST-GF-32. IX2144.2 +214600 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +214700 MOVE "START-TEST-GF-32" TO PAR-NAME. IX2144.2 +214800 IF FILESTATUS (5) EQUAL TO "**" IX2144.2 +214900 PERFORM DE-LETE IX2144.2 +215000 MOVE "FROM START-TEST-GF-23" TO CORRECT-A IX2144.2 +215100 GO TO START-TEST-GF-32A. IX2144.2 +215200* IX2144.2 +215300* START-TEST-006.05 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +215400* RESULTING FROM START-TEST-GF-23. THE FILE IX2144.2 +215500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +215600* IX2144.2 +215700 IF FILESTATUS (5) EQUAL TO "00" IX2144.2 +215800 PERFORM PASS IX2144.2 +215900 ELSE PERFORM FAIL IX2144.2 +216000 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-23" TO RE-MARKIX2144.2 +216100 MOVE "00" TO CORRECT-A IX2144.2 +216200 MOVE FILESTATUS (5) TO COMPUTED-A. IX2144.2 +216300 START-TEST-GF-32A. IX2144.2 +216400 PERFORM PRINT-DETAIL. IX2144.2 +216500 START-TEST-GF-33. IX2144.2 +216600 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +216700 MOVE "START-TEST-GF-33" TO PAR-NAME. IX2144.2 +216800 IF FILESTATUS (6) EQUAL TO "**" IX2144.2 +216900 PERFORM DE-LETE IX2144.2 +217000 MOVE "FROM START-TEST-GF-24" TO CORRECT-A IX2144.2 +217100 GO TO START-TEST-GF-33A. IX2144.2 +217200* IX2144.2 +217300* START-TEST-006.06 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +217400* RESULTING FROM START-TEST-GF-24. THE FILE IX2144.2 +217500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +217600* IX2144.2 +217700 IF FILESTATUS (6) EQUAL TO "00" IX2144.2 +217800 PERFORM PASS IX2144.2 +217900 ELSE PERFORM FAIL IX2144.2 +218000 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-24" TO RE-MARKIX2144.2 +218100 MOVE "00" TO CORRECT-A IX2144.2 +218200 MOVE FILESTATUS (6) TO COMPUTED-A. IX2144.2 +218300 START-TEST-GF-33A. IX2144.2 +218400 PERFORM PRINT-DETAIL. IX2144.2 +218500 START-TEST-GF-34. IX2144.2 +218600 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +218700 MOVE "START-TEST-GF-34" TO PAR-NAME. IX2144.2 +218800 IF FILESTATUS (7) EQUAL TO "**" IX2144.2 +218900 PERFORM DE-LETE IX2144.2 +219000 MOVE "FROM START-TEST-GF-25" TO CORRECT-A IX2144.2 +219100 GO TO START-TEST-GF-34A. IX2144.2 +219200* IX2144.2 +219300* START-TEST-006.07 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +219400* RESULTING FROM START-TEST-GF-25. THE FILE IX2144.2 +219500* STATUS CONTENTS IS EXPECTED TO BE "23" IX2144.2 +219600* IX2144.2 +219700 IF FILESTATUS (7) EQUAL TO "23" IX2144.2 +219800 PERFORM PASS IX2144.2 +219900 ELSE PERFORM FAIL IX2144.2 +220000 MOVE "FROM START-TEST-GF-25; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +220100 MOVE "23" TO CORRECT-A IX2144.2 +220200 MOVE FILESTATUS (7) TO COMPUTED-A. IX2144.2 +220300 START-TEST-GF-34A. IX2144.2 +220400 PERFORM PRINT-DETAIL. IX2144.2 +220500 START-TEST-GF-35. IX2144.2 +220600 MOVE "FILE STATUS START:00" TO FEATURE. IX2144.2 +220700 MOVE "START-TEST-GF-35" TO PAR-NAME. IX2144.2 +220800 IF FILESTATUS (8) EQUAL TO "**" IX2144.2 +220900 PERFORM DE-LETE IX2144.2 +221000 MOVE "FROM START-TEST-GF-26" TO CORRECT-A IX2144.2 +221100 GO TO START-TEST-GF-35A. IX2144.2 +221200* IX2144.2 +221300* START-TEST-006.08 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +221400* RESULTING FROM START-TEST-GF-26. THE FILE IX2144.2 +221500* STATUS CONTENTS IS EXPECTED TO BE "00" IX2144.2 +221600* IX2144.2 +221700 IF FILESTATUS (8) EQUAL TO "00" IX2144.2 +221800 PERFORM PASS IX2144.2 +221900 ELSE PERFORM FAIL IX2144.2 +222000 MOVE "IX-3; 1.3.4 (1) A;FROM START-TEST-GF-26" TO RE-MARKIX2144.2 +222100 MOVE "00" TO CORRECT-A IX2144.2 +222200 MOVE FILESTATUS (8) TO COMPUTED-A. IX2144.2 +222300 START-TEST-GF-35A. IX2144.2 +222400 PERFORM PRINT-DETAIL. IX2144.2 +222500 START-TEST-GF-36. IX2144.2 +222600 MOVE "FILE STATUS START:23" TO FEATURE. IX2144.2 +222700 MOVE "START-TEST-GF-36" TO PAR-NAME. IX2144.2 +222800 IF FILESTATUS (9) EQUAL TO "**" IX2144.2 +222900 PERFORM DE-LETE IX2144.2 +223000 MOVE "FROM START-TEST-GF-27" TO CORRECT-A IX2144.2 +223100 GO TO START-TEST-GF-36A. IX2144.2 +223200* IX2144.2 +223300* START-TEST-006.09 - THIS TEST CHECKS THE FILE STATUS CONTENTS IX2144.2 +223400* RESULTING FROM START-TEST-GF-27. THE FILE IX2144.2 +223500* STATUS CONTENTS IS EXPECTED TO BE "23". IX2144.2 +223600* IX2144.2 +223700 IF FILESTATUS (9) EQUAL TO "23" IX2144.2 +223800 PERFORM PASS IX2144.2 +223900 ELSE PERFORM FAIL IX2144.2 +224000 MOVE "FROM START-TEST-GF-27; IX-4 1.3.4 (3) C" TO RE-MARKIX2144.2 +224100 MOVE "23" TO CORRECT-A IX2144.2 +224200 MOVE FILESTATUS (9) TO COMPUTED-A. IX2144.2 +224300 START-TEST-GF-36A. IX2144.2 +224400 PERFORM PRINT-DETAIL. IX2144.2 +224500 IX2144.2 +224600 IX2144.2 +224700 IX2144.2 +224800 START-INIT-GF-37. IX2144.2 +224900 OPEN I-O IX-FS1. IX2144.2 +225000 MOVE "START SERIES" TO FEATURE. IX2144.2 +225100 MOVE "START-TEST-GF-37" TO PAR-NAME. IX2144.2 +225200 MOVE ZERO TO INVKEY-COUNTER. IX2144.2 +225300* IX2144.2 +225400* THIS TEST EXECUTES SEVERAL START STATEMENTS USING DIFFERENT IX2144.2 +225500* KEY VALUES. FOLLOWING EXECUTION OF THE LAST START IX2144.2 +225600* STATEMENT THE READ STATEMENT IS EXECUTED. THE START IX2144.2 +225700* STATEMENT SHOULD HAVE POSITION THE RECORD POINTER IX2144.2 +225800* SUCH THAT RECORD NUMBER 50 IS MADE AVAILABLE IX2144.2 +225900* TO THE READ STATEMENT. THE KEY OF REFERENCE IX2144.2 +226000* SHOULD BE ALTERNATE-KEY-2. IX2144.2 +226100* IX2144.2 +226200 START-TEST-GF-37. IX2144.2 +226300 MOVE "FGGGGGGGGG098" TO FS1-RECKEY-1-13. IX2144.2 +226400 MOVE "WWWWWWWXXX366ALTKEY1" TO FS1-ALTKEY1-1-20. IX2144.2 +226500 MOVE "RRRRRRRRRR300ALTKEY2" TO FS1-ALTKEY2-1-20. IX2144.2 +226600 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +226700 MOVE WRK-FS1-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2144.2 +226800 MOVE WRK-FS1-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2144.2 +226900 START IX-FS1 IX2144.2 +227000 KEY IS EQUAL TO IX-FS1-ALTKEY2 IX2144.2 +227100 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2144.2 +227200 START IX-FS1 INVALID KEY ADD 01 TO INVKEY-COUNTER. IX2144.2 +227300 START IX-FS1 IX2144.2 +227400 KEY IS NOT LESS THAN R-ALTKEY1-1-6 IX2144.2 +227500 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2144.2 +227600 START IX-FS1 IX2144.2 +227700 KEY IS NOT LESS THAN IX-FS1-ALTKEY2-1-5 IX2144.2 +227800 INVALID KEY ADD 1 TO INVKEY-COUNTER. IX2144.2 +227900 READ IX-FS1 AT END IX2144.2 +228000 MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +228100 GO TO START-FAIL-GF-37. IX2144.2 +228200 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2144.2 +228300 IF XRECORD-NUMBER (1) EQUAL TO 175 IX2144.2 +228400 PERFORM PASS IX2144.2 +228500 MOVE "MULTIPLE STARTS BEFORE READ " TO RE-MARK IX2144.2 +228600 GO TO START-WRITE-GF-37. IX2144.2 +228700 MOVE "RRRRRRRRRR050ALTKEY2" TO CORRECT-A. IX2144.2 +228800 MOVE ALTERNATE-KEY2 (1) TO WRK-FS1-ALTKEY2. IX2144.2 +228900 MOVE FS1-ALTKEY2-1-20 TO COMPUTED-A. IX2144.2 +229000 MOVE SPACE TO P-OR-F. IX2144.2 +229100 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2144.2 +229200 PERFORM PRINT-DETAIL. IX2144.2 +229300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2144.2 +229400 START-FAIL-GF-37. IX2144.2 +229500 PERFORM FAIL. IX2144.2 +229600 MOVE 175 TO CORRECT-18V0. IX2144.2 +229700 MOVE "WRONG RECORD NUMBER; IX-28 OR IX-36" TO RE-MARK. IX2144.2 +229800 GO TO START-WRITE-GF-37. IX2144.2 +229900 START-DELETE-GF-37. IX2144.2 +230000 PERFORM DE-LETE. IX2144.2 +230100 START-WRITE-GF-37. IX2144.2 +230200 PERFORM PRINT-DETAIL. IX2144.2 +230300 IX2144.2 +230400 CLOSE IX-FS1. IX2144.2 +230500 GO TO CCVS-EXIT. IX2144.2 +230600 IX2144.2 +230700 IX2144.2 +230800 START-INITIALIZE-RECORD. IX2144.2 +230900 MOVE "**" TO FS1-STATUS. IX2144.2 +231000 MOVE "GGGGGGGGGG200" TO FS1-RECKEY-1-13. IX2144.2 +231100 MOVE ZERO TO INIT-FLAG. IX2144.2 +231200 MOVE 9999 TO XRECORD-NUMBER (1). IX2144.2 +231300 MOVE SPACE TO IX-FS1R1-F-G-240. IX2144.2 +231400 MOVE WRK-FS1-RECKEY TO IX-REC-KEY-AREA. IX2144.2 +231500 START IX-FS1 IX2144.2 +231600 KEY IS EQUAL TO IX-FS1-KEY IX2144.2 +231700 INVALID KEY MOVE "INVALID KEY ON START" TO COMPUTED-A IX2144.2 +231800 MOVE 01 TO INIT-FLAG. IX2144.2 +231900 READ IX-FS1 INTO FILE-RECORD-INFO (1) IX2144.2 +232000 AT END MOVE "AT END ON READ" TO COMPUTED-A IX2144.2 +232100 MOVE 01 TO INIT-FLAG. IX2144.2 +232200 IF XRECORD-NUMBER (1) NOT EQUAL TO 100 IX2144.2 +232300 MOVE 02 TO INIT-FLAG. IX2144.2 +232400 MOVE SPACE TO FS1-STATUS. IX2144.2 +232500 START-INIT-ERROR. IX2144.2 +232600 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK. IX2144.2 +232700 MOVE "GGGGGGGGGG200" TO CORRECT-A. IX2144.2 +232800 IF INIT-FLAG NOT EQUAL 01 IX2144.2 +232900 MOVE XRECORD-KEY (1) TO WRK-FS1-RECKEY IX2144.2 +233000 MOVE FS1-RECKEY-1-13 TO COMPUTED-A. IX2144.2 +233100 PERFORM PRINT-DETAIL. IX2144.2 +233200 MOVE "**" TO FILESTATUS (REC-CT). IX2144.2 +233300 DISPLAY-RECORD-KEYS. IX2144.2 +233400 MOVE XRECORD-KEY (1) TO WRK-FS1-RECKEY. IX2144.2 +233500 MOVE FS1-RECKEY-1-13 TO COMPUTED-A. IX2144.2 +233600 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2144.2 +233700 MOVE SPACE TO P-OR-F. IX2144.2 +233800 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2144.2 +233900 PERFORM PRINT-DETAIL. IX2144.2 +234000 DISPLAY-ALTERNATE-KEY1. IX2144.2 +234100 MOVE ALTERNATE-KEY1 (1) TO WRK-FS1-ALTKEY1. IX2144.2 +234200 MOVE FS1-ALTKEY1-1-20 TO COMPUTED-A. IX2144.2 +234300 MOVE ALTKEY1-VALUE (RECNO) TO CORRECT-A. IX2144.2 +234400 MOVE SPACE TO P-OR-F. IX2144.2 +234500 MOVE "ALTERNATE RECORD KEY1 VALUES" TO RE-MARK. IX2144.2 +234600 PERFORM PRINT-DETAIL. IX2144.2 +234700 DISPLAY-ALTERNATE-KEY2. IX2144.2 +234800 MOVE ALTERNATE-KEY2 (1) TO WRK-FS1-ALTKEY2. IX2144.2 +234900 MOVE FS1-ALTKEY2-1-20 TO COMPUTED-A. IX2144.2 +235000 MOVE ALTKEY2-VALUE (RECNO) TO CORRECT-A. IX2144.2 +235100 MOVE SPACE TO P-OR-F. IX2144.2 +235200 MOVE "ALTERNATE RECORD KEY2 VALUES" TO RE-MARK. IX2144.2 +235300 PERFORM PRINT-DETAIL. IX2144.2 +235400 IX2144.2 +235500 IX2144.2 +235600 CCVS-EXIT SECTION. IX2144.2 +235700 CCVS-999999. IX2144.2 +235800 GO TO CLOSE-FILES. IX2144.2 diff --git a/tests/cobol85/IX/IX215A.CBL b/tests/cobol85/IX/IX215A.CBL new file mode 100755 index 00000000..9fa0e96a --- /dev/null +++ b/tests/cobol85/IX/IX215A.CBL @@ -0,0 +1,2805 @@ +000100 IDENTIFICATION DIVISION. IX2154.2 +000200 PROGRAM-ID. IX2154.2 +000300 IX215A. IX2154.2 +000400**************************************************************** IX2154.2 +000500* * IX2154.2 +000600* VALIDATION FOR:- * IX2154.2 +000700* * IX2154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2154.2 +000900* * IX2154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2154.2 +001100* * IX2154.2 +001200**************************************************************** IX2154.2 +001300* THE PURPOSE OF THIS PROGRAM IS TO TEST THE ABILITY TO IX2154.2 +001400* DESCRIBE THE PRIME RECORD KEY AND THE ALTERNATE RECORD KEYS IX2154.2 +001500* IN A REDEFINES CLAUSES AND TO TEST THE USE OF QUALIFICATION IX2154.2 +001600* OF THE RECORD KEYS. THE PROGRAM IS BROKEN INTO THREE SEC- IX2154.2 +001700* TIONS. THE FIRST SECTION TESTS THE ABILITY TO USE A IX2154.2 +001800* REDEFINED DATA ITEM OR A DATA ITEM SUBORDINATE TO IT CON- IX2154.2 +001900* TAINING THE LEFTMOST CHARACTER POSTIONS OF THE REDEFINED DATAIX2154.2 +002000* ITEM IN THE KEY PHRASE OF THE START STATEMENT. THE SECOND IX2154.2 +002100* SECTION TESTS THE ABILITY TO USE A RECORD KEY WHICH IS NESTEDIX2154.2 +002200* IN REDEFINES OR A DATA ITEM SUBORDINATE TO IT THAT CONTAINS IX2154.2 +002300* THE LEFTMOST CHARACTER POSITIONS OF A REDEFINED DATA ITEM IX2154.2 +002400* WHICH IS NESTED IN REDEFINES IN THE KEY PHRASE OF THE START IX2154.2 +002500* STATEMENT. THE THIRD SECTION TESTS THE USE OF QUALIFICATION IX2154.2 +002600* OF THE RECORD KEYS. DIFFERENT KEY VALUES ARE USED FOR IX2154.2 +002700* TESTING. IF A KEY VALUE IS PROVIDED WHICH MATCHES A RECORD IX2154.2 +002800* IN THE FILE THE EXECUTION OF A START STATEMENT FOLLOWED BY A IX2154.2 +002900* READ NEXT STATEMENT IS EXPECTED TO MADE AVAILABLE THE RECORD.IX2154.2 +003000* IF A KEY VALUE IS PROVIDED WHICH DOES NOT MATCH ANY RECORD INIX2154.2 +003100* THE FILE THEN THE INVALID KEY PATH IS EXPECTED TO BE TAKEN. IX2154.2 +003200* IX2154.2 +003300* REFERENCE AMERICAN NATIONAL STANDARD IX2154.2 +003400* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IX2154.2 +003500* SECTION IX, INDEX I-O, THE START IX2154.2 +003600* STATEMENT. PARAGRAPHS 4.7.3 (2), (3), (4); IX2154.2 +003700* 4.7.4 (1), (4), (5), IX2154.2 +003800* (10) AND IX2154.2 +003900* THE REDEFINES CLAUSE PAGE VI-39 5.10.4 (1), IX2154.2 +004000* (2). IX2154.2 +004100* IX2154.2 +004200* BEFORE EACH TEST THE RECORD KEY IS LOAD WITH A KEY VALUE IX2154.2 +004300* WHICH MAY OR MAY NOT BE A VALID KEY FOR THE FILE. ALSO IX2154.2 +004400* BEFORE EACH STEP IN A TEST AN INITIALIZATION PROCEDURE MAY ORIX2154.2 +004500* MAY NOT BE PERFORMED WHICH MAKES AVAILABLE RECORD NUMBER 200.IX2154.2 +004600* IF DURING THIS PROCEDURE AN INVALID KEY OCCURS THE TEST IS IX2154.2 +004700* DELETED. IX2154.2 +004800* IX2154.2 +004900* BEFORE EACH SECTION A INDEXED FILE IS CREATED CONTAINING TWO IX2154.2 +005000* ALTERNATE KEY AND THE ONE REQUIRED RECORD KEY FOR THE FILE. IX2154.2 +005100* IMMEDIATELY FOLLOWING FILE CREATION THE FILE IS READ AND THE IX2154.2 +005200* RECORDS OF THE FILE VERIFIED FOR ACCURACY. NEXT THE TESTS IX2154.2 +005300* ARE EXECUTED USING THE READ, DELETE, REWRITE, and START IX2154.2 +005400* STATEMENTS. IX2154.2 +005500* IX2154.2 +005600* THE RECORDS IN THE FILE ARE CREATED IN SEQUENTIAL ORDER BY IX2154.2 +005700* RECORD KEY VALUE. FOLLOWING IS A SAMPLE OF THE DATA CONTENTSIX2154.2 +005800* FOR THE RECORD KEY AND TWO ALTERNATE RECORD KEYS IN THE FILE.IX2154.2 +005900* IX2154.2 +006000* REC-NO RECORD-KEY ALTERNATE-KEY-1 ALTERNATE-KEY-2 IX2154.2 +006100* ------ ---------- --------------- --------------- IX2154.2 +006200* 001 BBBBBBBBBC002 EEEEEEEEEF002ALTKEY1 WWWWWWWWWV398ALTKEY2IX2154.2 +006300* 002 BBBBBBBBCC004 EEEEEEEEFF004ALTKEY1 WWWWWWWWVV396ALTKEY2IX2154.2 +006400* 003 BBBBBBBCCC006 EEEEEEEFFF006ALTKEY1 WWWWWWWVVV394ALTKEY2IX2154.2 +006500* . . . . IX2154.2 +006600* . . . . IX2154.2 +006700* . . . . IX2154.2 +006800* 010 CCCCCCCCCC020 FFFFFFFFFF020ALTKEY1 VVVVVVVVVV380ALTKEY2IX2154.2 +006900* 011 CCCCCCCCCD022 FFFFFFFFFG022ALTKEY1 VVVVVVVVVV380ALTKEY2IX2154.2 +007000* 012 CCCCCCCCDD024 FFFFFFFFGG024ALTKEY1 VVVVVVVVUU376ALTKEY2IX2154.2 +007100* . . . . IX2154.2 +007200* . . . . IX2154.2 +007300* . . . . IX2154.2 +007400* 200 UUUUUUUUUU400 YYYYYYYYYY400ALTKEY1 DDDDDDDDDD000ALTKEYIX2154.2 +007500* IX2154.2 +007600* NOTE 1 - ALTERNATE-KEY-2 CONTAINS DUPLICATE KEYS EVERY 10TH IX2154.2 +007700* AND 11TH RECORDS. IX2154.2 +007800* IX2154.2 +007900* NOTE 2 - THE FIRST 50 RECORDS AND LAST 25 RECORDS OF THE FILE IX2154.2 +008000* FOLLOW THE ABOVE SEQUENTIAL KEY PATTERN. FOR THE IX2154.2 +008100* MIDDEL 125 RECORDS ONLY THE NUMBER PART OF THE KEYS IX2154.2 +008200* ARE VARIED AND VARIED IN THE SEQUENCE SHOWN ABOVE. IX2154.2 +008300* THAT IS, RECORD KEY AND ALTERNATE-KEY-1 ARE IX2154.2 +008400* INCREMENTED BY 2 ANDT THE ALTERNATE KEY-2 IS IX2154.2 +008500* DECREMENTED BY 2 EACH TIME A RECORD IS WRITTEN TO THEIX2154.2 +008600* FILE. THE FILE IS DESIGNED TO BE LARGE ENOUGH SO IX2154.2 +008700* THAT AN I-O OPERATION IS REQUIRED FOR EACH RECORD IX2154.2 +008800* ACCESSED FROM THE FILE. IX2154.2 +008900* IX2154.2 +009000* X-CARD'S WHICH MUST BE REPLACED WITH IMPLEMENTOR-NAMES' IN IX2154.2 +009100* THIS PROGRAM ARE: IX2154.2 +009200* IX2154.2 +009300* X-24 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX2154.2 +009400* INDEXED FILE-1. IX2154.2 +009500* X-25 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX2154.2 +009600* INDEXED FILE-2. IX2154.2 +009700* X-26 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR IX2154.2 +009800* INDEXED FILE-3. IX2154.2 +009900* X-44 SYSTEM-NAME IN ASSIGN TO CLAUSE FOR INDEXEDIX2154.2 +010000* FILE-1 IF NEEDED. IX2154.2 +010100* X-45 SYSTEM-NAME IN ASSIGN TO CLAUSE FOR INDEXEDIX2154.2 +010200* FILE-2 IF NEEDED. IX2154.2 +010300* X-46 SYSTEM-NAME IN ASSIGN TO CLAUSE FOR INDEXEDIX2154.2 +010400* FILE-3 IF NEEDED. IX2154.2 +010500* X-55 SYSTEM PRINTER. IX2154.2 +010600* X-62 FOR RAW-DATA IX2154.2 +010700* X-82 SOURCE-COMPUTER. IX2154.2 +010800* X-83 OBJECT-COMPUTER. IX2154.2 +010900* IX2154.2 +011000******************************************************************IX2154.2 +011100* IX2154.2 +011200 ENVIRONMENT DIVISION. IX2154.2 +011300 CONFIGURATION SECTION. IX2154.2 +011400 SOURCE-COMPUTER. IX2154.2 +011500 Linux. IX2154.2 +011600 OBJECT-COMPUTER. IX2154.2 +011700 Linux IX2154.2 +011800 PROGRAM COLLATING SEQUENCE IS FOR-INX-START-TEST. IX2154.2 +011900 SPECIAL-NAMES. IX2154.2 +012000 ALPHABET IX2154.2 +012100 FOR-INX-START-TEST IS "WVUTSRJIHGFEDCB". IX2154.2 +012200 INPUT-OUTPUT SECTION. IX2154.2 +012300 FILE-CONTROL. IX2154.2 +012400*P SELECT RAW-DATA ASSIGN TO IX2154.2 +012500*P "XXXXX062" IX2154.2 +012600*P ORGANIZATION IS INDEXED IX2154.2 +012700*P ACCESS MODE IS RANDOM IX2154.2 +012800*P RECORD KEY IS RAW-DATA-KEY. IX2154.2 +012900 SELECT PRINT-FILE ASSIGN TO IX2154.2 +013000 "report.log". IX2154.2 +013100 SELECT IX-FD1 IX2154.2 +013200 ASSIGN TO IX2154.2 +013300 "XXXXX024" IX2154.2 +013400*J **** X-CARD UNDEFINED **** IX2154.2 +013500 ACCESS MODE IS DYNAMIC IX2154.2 +013600 RECORD KEY IS IX-FD1-KEY IX2154.2 +013700 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY1 IX2154.2 +013800 ALTERNATE RECORD KEY IS IX-FD1-ALTKEY2 WITH DUPLICATES IX2154.2 +013900 ORGANIZATION IS INDEXED. IX2154.2 +014000 SELECT IX-FD2 IX2154.2 +014100 ASSIGN TO IX2154.2 +014200 "XXXXX025" IX2154.2 +014300*J **** X-CARD UNDEFINED **** IX2154.2 +014400 ACCESS MODE IS DYNAMIC IX2154.2 +014500 ORGANIZATION IS INDEXED IX2154.2 +014600 RECORD KEY IS IX-FD2-KEY IX2154.2 +014700 ALTERNATE RECORD KEY IS IX-FD2-ALTKEY1 IX2154.2 +014800 ALTERNATE RECORD KEY IS IX-FD2-ALTKEY2 WITH DUPLICATES IX2154.2 +014900 . IX2154.2 +015000 SELECT IX-FD3 IX2154.2 +015100 ASSIGN TO IX2154.2 +015200 "XXXXX026" IX2154.2 +015300*J **** X-CARD UNDEFINED **** IX2154.2 +015400 ACCESS MODE IS DYNAMIC IX2154.2 +015500 ORGANIZATION IS INDEXED IX2154.2 +015600 RECORD KEY IS IX-FD3-KEY IN IX-FD3-RECKEY-AREA IX2154.2 +015700 ALTERNATE RECORD KEY IS IX-FD3-KEY OF IX2154.2 +015800 IX-FD3-ALTKEY1-AREA IX2154.2 +015900 ALTERNATE RECORD KEY IS IX-FD3-KEY IX2154.2 +016000 IN IX-FD3-ALTKEY2-AREA IX2154.2 +016100 WITH DUPLICATES IX2154.2 +016200 . IX2154.2 +016300 DATA DIVISION. IX2154.2 +016400 FILE SECTION. IX2154.2 +016500*P IX2154.2 +016600*PD RAW-DATA. IX2154.2 +016700*P IX2154.2 +016800*P1 RAW-DATA-SATZ. IX2154.2 +016900*P 05 RAW-DATA-KEY PIC X(6). IX2154.2 +017000*P 05 C-DATE PIC 9(6). IX2154.2 +017100*P 05 C-TIME PIC 9(8). IX2154.2 +017200*P 05 C-NO-OF-TESTS PIC 99. IX2154.2 +017300*P 05 C-OK PIC 999. IX2154.2 +017400*P 05 C-ALL PIC 999. IX2154.2 +017500*P 05 C-FAIL PIC 999. IX2154.2 +017600*P 05 C-DELETED PIC 999. IX2154.2 +017700*P 05 C-INSPECT PIC 999. IX2154.2 +017800*P 05 C-NOTE PIC X(13). IX2154.2 +017900*P 05 C-INDENT PIC X. IX2154.2 +018000*P 05 C-ABORT PIC X(8). IX2154.2 +018100 FD PRINT-FILE. IX2154.2 +018200 01 PRINT-REC PICTURE X(120). IX2154.2 +018300 01 DUMMY-RECORD PICTURE X(120). IX2154.2 +018400 FD IX-FD1 IX2154.2 +018500*C LABEL RECORDS ARE STANDARD IX2154.2 +018600*C DATA RECORD IS IX-FD1R1-F-G-240 IX2154.2 +018700 RECORD CONTAINS 240 CHARACTERS. IX2154.2 +018800 01 IX-FD1R1-F-G-240. IX2154.2 +018900 05 IX-FD1-REC-120 PICTURE X(120). IX2154.2 +019000 05 IX-FD1-REC-121-240. IX2154.2 +019100 10 FILLER PICTURE X(8). IX2154.2 +019200 10 IX-REC-KEY-AREA. IX2154.2 +019300 15 IX-FD1-KEY. IX2154.2 +019400 20 IX-FD1-KEY-1-10. IX2154.2 +019500 25 IX-FD1-KEY-1-5 PICTURE X(5). IX2154.2 +019600 25 IX-FD1-KEY-6-10 PICTURE X(5). IX2154.2 +019700 20 IX-FD1-KEY-11-13 PICTURE X(3). IX2154.2 +019800 15 IX-REDF-RECKEY REDEFINES IX-FD1-KEY. IX2154.2 +019900 20 R-RECKEY-1-7 PICTURE X(7). IX2154.2 +020000 20 R-REDF-RECKEY-1-7 REDEFINES R-RECKEY-1-7. IX2154.2 +020100 25 R-RECKEY-1-5 PICTURE X(5). IX2154.2 +020200 25 R-RECKEY-6-7 PICTURE XX. IX2154.2 +020300 20 R-RECKEY-8-13 PICTURE X(6). IX2154.2 +020400 15 FILLER PICTURE X(16). IX2154.2 +020500 10 FILLER PICTURE X(9). IX2154.2 +020600 10 IX-ALT-KEY1-AREA. IX2154.2 +020700 15 IX-FD1-ALTKEY1. IX2154.2 +020800 20 IX-FDW-ALTKEY1-1-10. IX2154.2 +020900 25 IX-FDW-ALTKEY1-1-5 PICTURE X(5). IX2154.2 +021000 25 IX-FDW-ALTKEY1-6-10 PICTURE X(5). IX2154.2 +021100 20 IX-FDW-ALTKEY1-11-13 PICTURE X(3). IX2154.2 +021200 20 IX-FDW-ALTKEY1-14-20 PICTURE X(7). IX2154.2 +021300 15 IX-REDF-ALTKEY1 REDEFINES IX-FD1-ALTKEY1. IX2154.2 +021400 20 R-ALTKEY1-1-6 PICTURE X(6). IX2154.2 +021500 20 R-REDF-ALTKEY1-1-6 REDEFINES R-ALTKEY1-1-6. IX2154.2 +021600 25 R-ALTKEY1-1-4 PICTURE X(4). IX2154.2 +021700 25 R-ALTKEY1-5-6 PICTURE XX. IX2154.2 +021800 20 R-ALTKEY1-7-10 PICTURE X(4). IX2154.2 +021900 20 R-ALTKEY1-11-20 PICTURE X(10). IX2154.2 +022000 15 FILLER PICTURE X(9). IX2154.2 +022100 10 FILLER PICTURE X(9). IX2154.2 +022200 10 IX-ALT-KEY2-AREA. IX2154.2 +022300 15 IX-FD1-ALTKEY2. IX2154.2 +022400 20 IX-FDW-ALTKEY2-1-10. IX2154.2 +022500 25 IX-FDW-ALTKEY2-1-5 PICTURE X(5). IX2154.2 +022600 25 IX-FDW-ALTKEY2-6-10 PICTURE X(5). IX2154.2 +022700 20 IX-FDW-ALTKEY2-11-13 PICTURE X(3). IX2154.2 +022800 20 IX-FDW-ALTKEY2-14-20 PICTURE X(7). IX2154.2 +022900 15 IX-REDF-ALTKEY2 REDEFINES IX-FD1-ALTKEY2. IX2154.2 +023000 20 R-ALTKEY2-1-3 PICTURE XXX. IX2154.2 +023100 20 R-REDF-ALTKEY2-1-3 REDEFINES R-ALTKEY2-1-3. IX2154.2 +023200 25 R-ALTKEY2-1-2 PICTURE XX. IX2154.2 +023300 25 R-ALTKEY2-3-3 PICTURE X. IX2154.2 +023400 20 R-ALTKEY2-4-20 PICTURE X(17). IX2154.2 +023500 15 FILLER PICTURE X(9). IX2154.2 +023600 10 FILLER PICTURE X(7). IX2154.2 +023700 FD IX-FD2 IX2154.2 +023800*C LABEL RECORDS ARE STANDARD IX2154.2 +023900*C DATA RECORD IS IX-FD2R1-F-G-241 IX2154.2 +024000 BLOCK CONTAINS 4 RECORDS IX2154.2 +024100 RECORD CONTAINS 241 CHARACTERS. IX2154.2 +024200 01 IX-FD2R1-F-G-241. IX2154.2 +024300 03 IX-FD2-REC-241. IX2154.2 +024400 05 IX-FD2-REC-120 PICTURE X(120). IX2154.2 +024500 05 IX-FD2-REC-121-241. IX2154.2 +024600 10 IX-FD2-RECKEY-AREA PICTURE X(37). IX2154.2 +024700 10 IX-FD2-RECKEY-AREA2 REDEFINES IX-FD2-RECKEY-AREA. IX2154.2 +024800 15 IX-FD2-RECKEY-AREA2-1 PICTURE X(23). IX2154.2 +024900 15 IX-FD2-RECKEY-AREA2-2 PICTURE X(14). IX2154.2 +025000 10 IX-FD2-RECKEY-AREA3 REDEFINES IX-FD2-RECKEY-AREA. IX2154.2 +025100 15 FILLER PICTURE X(8). IX2154.2 +025200 15 IX-FD2-KEY PICTURE X(13). IX2154.2 +025300 15 FILLER PICTURE X(16). IX2154.2 +025400 10 IX-FD2-RECKEY-AREA4 REDEFINES IX-FD2-RECKEY-AREA. IX2154.2 +025500 15 FILLER PICTURE X(8). IX2154.2 +025600 15 IX-FD2-RECKEY-REDF PICTURE X(13). IX2154.2 +025700 15 IX-FD2-RECKEY-REDF2 REDEFINES IX-FD2-RECKEY-REDF. IX2154.2 +025800 20 IX-FD2-RECKEY-1-6 PICTURE X(6). IX2154.2 +025900 20 IX-FD2-RECKEY-7-13 PICTURE X(7). IX2154.2 +026000 15 FILLER PICTURE X(16). IX2154.2 +026100 10 FILLER PICTURE X(9). IX2154.2 +026200 10 IX-FD2-ALTKEY1-AREA PICTURE X(29). IX2154.2 +026300 10 IX-FD2-ALTKEY1-AREA2 REDEFINES IX-FD2-ALTKEY1-AREA. IX2154.2 +026400 15 IX-FD2-ALTKEY1-1-6 PICTURE X(6). IX2154.2 +026500 15 IX-FD2-ALTKEY1-7-20 PICTURE X(14). IX2154.2 +026600 15 FILLER PICTURE X(9). IX2154.2 +026700 10 IX-FD2-ALTKEY1-AREA3 REDEFINES IX-FD2-ALTKEY1-AREA. IX2154.2 +026800 15 IX-FD2-ALTKEY1. IX2154.2 +026900 20 IX-FD2-ALTKEY1-10 PICTURE X(10). IX2154.2 +027000 20 IX-FD2-ALTKEY1-11-20 PICTURE X(10). IX2154.2 +027100 15 IX-FD2-REDF-ALTKEY1 REDEFINES IX-FD2-ALTKEY1. IX2154.2 +027200 20 IX-FD2-ALTKEY1-1-5 PICTURE X(5). IX2154.2 +027300 20 IX-FD2-ALTKEY1-6-20 PICTURE X(15). IX2154.2 +027400 15 FILLER PICTURE X(9). IX2154.2 +027500 10 FILLER PICTURE X(9). IX2154.2 +027600 10 IX-FD2-ALTKEY2-AREA PICTURE X(29). IX2154.2 +027700 10 IX-FD2-ALTKEY2-AREA2 REDEFINES IX-FD2-ALTKEY2-AREA. IX2154.2 +027800 15 IX-FD2-ALTKEY2 PICTURE X(20). IX2154.2 +027900 15 FILLER PICTURE X(9). IX2154.2 +028000 10 IX-FD2-ALTKEY2-AREA3 REDEFINES IX-FD2-ALTKEY2-AREA. IX2154.2 +028100 15 IX-FD2-ALTKEY2-1-6 PICTURE X(6). IX2154.2 +028200 15 IX-FD2-REDF-ALTKEY2-1-6 IX2154.2 +028300 REDEFINES IX-FD2-ALTKEY2-1-6. IX2154.2 +028400 20 IX-FD2-ALTKEY2-1-3 PICTURE XXX. IX2154.2 +028500 20 IX-FD2-ALTKEY2-4-6 PICTURE XXX. IX2154.2 +028600 15 IX-FD2-ALTKEY2-7-20 PICTURE X(14). IX2154.2 +028700 15 FILLER PICTURE X(9). IX2154.2 +028800 10 FILLER PICTURE X(8). IX2154.2 +028900 03 IX-FD2-REC-241-240 REDEFINES IX-FD2-REC-241. IX2154.2 +029000 05 IX-FD2-REC-240 PIC X(240). IX2154.2 +029100 05 FILLER PIC X. IX2154.2 +029200 FD IX-FD3 IX2154.2 +029300*C LABEL RECORDS ARE STANDARD IX2154.2 +029400*C DATA RECORD IS IX-FD3R1-F-G-242 IX2154.2 +029500 RECORD CONTAINS 242 CHARACTERS IX2154.2 +029600 BLOCK CONTAINS 1694 CHARACTERS. IX2154.2 +029700 01 IX-FD3R1-F-G-242. IX2154.2 +029800 03 IX-FD3-REC-242. IX2154.2 +029900 05 IX-FD3-REC-120 PICTURE X(120). IX2154.2 +030000 05 IX-FD3-REC-121-242. IX2154.2 +030100 10 FILLER PICTURE X(8). IX2154.2 +030200 10 IX-FD3-RECKEY-AREA. IX2154.2 +030300 15 IX-FD3-KEY PICTURE X(13). IX2154.2 +030400 10 FILLER PICTURE X(25). IX2154.2 +030500 10 IX-FD3-ALTKEY1-AREA. IX2154.2 +030600 15 IX-FD3-KEY PICTURE X(20). IX2154.2 +030700 10 FILLER PICTURE X(18). IX2154.2 +030800 10 IX-FD3-ALTKEY2-AREA. IX2154.2 +030900 15 IX-FD3-KEY PICTURE X(20). IX2154.2 +031000 10 FILLER PICTURE X(18). IX2154.2 +031100 03 IX-FD3-REC-240 REDEFINES IX-FD3-REC-242. IX2154.2 +031200 05 IX-FD3-240 PICTURE X(240). IX2154.2 +031300 05 FILLER PICTURE XX. IX2154.2 +031400 IX2154.2 +031500 IX2154.2 +031600 WORKING-STORAGE SECTION. IX2154.2 +031700 01 WRK-FDW-RECKEY. IX2154.2 +031800 05 FDW-RECKEY-1-13. IX2154.2 +031900 10 FDW-RECKEY-1-10 PICTURE X(10). IX2154.2 +032000 10 FDW-RECKEY-11-13 PICTURE 9(3). IX2154.2 +032100 05 FILLER PICTURE X(16) VALUE SPACE. IX2154.2 +032200 01 WRK-FDW-ALTKEY1. IX2154.2 +032300 05 FDW-ALTKEY1-1-20. IX2154.2 +032400 10 FDW-ALTKEY1-1-10. IX2154.2 +032500 15 FDW-ALTKEY1-1-5 PICTURE X(5). IX2154.2 +032600 15 FDW-ALTKEY1-6-10 PICTURE X(5). IX2154.2 +032700 10 FDW-ALTKEY1-11-13 PICTURE 9(3). IX2154.2 +032800 10 FDW-ALTKEY1-14-20 PICTURE X(7). IX2154.2 +032900 05 FILLER PICTURE X(9) VALUE SPACE. IX2154.2 +033000 01 WRK-FDW-ALTKEY2. IX2154.2 +033100 05 FDW-ALTKEY2-1-20. IX2154.2 +033200 10 FDW-ALTKEY2-1-10. IX2154.2 +033300 15 FDW-ALTKEY2-1-5 PICTURE X(5). IX2154.2 +033400 15 FDW-ALTKEY2-6-10 PICTURE X(5). IX2154.2 +033500 10 FDW-ALTKEY2-11-13 PICTURE 9(3). IX2154.2 +033600 10 FDW-ALTKEY2-14-20 PICTURE X(7). IX2154.2 +033700 05 FILLER PICTURE X(9) VALUE SPACE. IX2154.2 +033800 01 RECNO PICTURE 9(5) VALUE ZERO. IX2154.2 +033900 01 EXCUT-COUNTER-06V00 PICTURE 9(6) VALUE ZERO. IX2154.2 +034000 01 KEYSUB PICTURE 9(3) COMPUTATIONAL. IX2154.2 +034100 01 INVKEY-COUNTER PICTURE 9(3) COMPUTATIONAL. IX2154.2 +034200 01 RECORDS-WRITTEN PICTURE 9(3). IX2154.2 +034300 01 RECKEY-NUM PICTURE 9(3). IX2154.2 +034400 01 ALTKEY1-NUM PICTURE 9(3). IX2154.2 +034500 01 ALTKEY2-NUM PICTURE 9(3). IX2154.2 +034600 01 FAIL-SW PICTURE 9 VALUE ZERO. IX2154.2 +034700 01 RECORD-KEY-CONTENT. IX2154.2 +034800 05 FILLER PIC X(53) VALUE IX2154.2 +034900 "BBBBBBBBBC002EEEEEEEEEF002ALTKEY1WWWWWWWWWV398ALTKEY2".IX2154.2 +035000 05 FILLER PIC X(53) VALUE IX2154.2 +035100 "BBBBBBBBCC004EEEEEEEEFF004ALTKEY1WWWWWWWWVV396ALTKEY2".IX2154.2 +035200 05 FILLER PIC X(53) VALUE IX2154.2 +035300 "BBBBBBBCCC006EEEEEEEFFF006ALTKEY1WWWWWWWVVV394ALTKEY2".IX2154.2 +035400 05 FILLER PIC X(53) VALUE IX2154.2 +035500 "BBBBBBCCCC008EEEEEEFFFF008ALTKEY1WWWWWWVVVV392ALTKEY2".IX2154.2 +035600 05 FILLER PIC X(53) VALUE IX2154.2 +035700 "BBBBBCCCCC010EEEEEFFFFF010ALTKEY1WWWWWVVVVV390ALTKEY2".IX2154.2 +035800 05 FILLER PIC X(53) VALUE IX2154.2 +035900 "BBBBCCCCCC012EEEEFFFFFF012ALTKEY1WWWWVVVVVV388ALTKEY2".IX2154.2 +036000 05 FILLER PIC X(53) VALUE IX2154.2 +036100 "BBBCCCCCCC014EEEFFFFFFF014ALTKEY1WWWVVVVVVV386ALTKEY2".IX2154.2 +036200 05 FILLER PIC X(53) VALUE IX2154.2 +036300 "BBCCCCCCCC016EEFFFFFFFF016ALTKEY1WWVVVVVVVV384ALTKEY2".IX2154.2 +036400 05 FILLER PIC X(53) VALUE IX2154.2 +036500 "BCCCCCCCCC018EFFFFFFFFF018ALTKEY1WVVVVVVVVV382ALTKEY2".IX2154.2 +036600 05 FILLER PIC X(53) VALUE IX2154.2 +036700 "CCCCCCCCCC020FFFFFFFFFF020ALTKEY1VVVVVVVVVV380ALTKEY2".IX2154.2 +036800 05 FILLER PIC X(53) VALUE IX2154.2 +036900 "CCCCCCCCCD022FFFFFFFFFG022ALTKEY1VVVVVVVVVV380ALTKEY2".IX2154.2 +037000 05 FILLER PIC X(53) VALUE IX2154.2 +037100 "CCCCCCCCDD024FFFFFFFFGG024ALTKEY1VVVVVVVVUU376ALTKEY2".IX2154.2 +037200 05 FILLER PIC X(53) VALUE IX2154.2 +037300 "CCCCCCCDDD026FFFFFFFGGG026ALTKEY1VVVVVVVUUU374ALTKEY2".IX2154.2 +037400 05 FILLER PIC X(53) VALUE IX2154.2 +037500 "CCCCCCDDDD028FFFFFFGGGG028ALTKEY1VVVVVVUUUU372ALTKEY2".IX2154.2 +037600 05 FILLER PIC X(53) VALUE IX2154.2 +037700 "CCCCCDDDDD030FFFFFGGGGG030ALTKEY1VVVVVUUUUU370ALTKEY2".IX2154.2 +037800 05 FILLER PIC X(53) VALUE IX2154.2 +037900 "CCCCDDDDDD032FFFFGGGGGG032ALTKEY1VVVVUUUUUU368ALTKEY2".IX2154.2 +038000 05 FILLER PIC X(53) VALUE IX2154.2 +038100 "CCCDDDDDDD034FFFGGGGGGG034ALTKEY1VVVUUUUUUU366ALTKEY2".IX2154.2 +038200 05 FILLER PIC X(53) VALUE IX2154.2 +038300 "CCDDDDDDDD036FFGGGGGGGG036ALTKEY1VVUUUUUUUU364ALTKEY2".IX2154.2 +038400 05 FILLER PIC X(53) VALUE IX2154.2 +038500 "CDDDDDDDDD038FGGGGGGGGG038ALTKEY1VUUUUUUUUU362ALTKEY2".IX2154.2 +038600 05 FILLER PIC X(53) VALUE IX2154.2 +038700 "DDDDDDDDDD040GGGGGGGGGG040ALTKEY1UUUUUUUUUU360ALTKEY2".IX2154.2 +038800 05 FILLER PIC X(53) VALUE IX2154.2 +038900 "DDDDDDDDDE042GGGGGGGGGH042ALTKEY1UUUUUUUUUU360ALTKEY2".IX2154.2 +039000 05 FILLER PIC X(53) VALUE IX2154.2 +039100 "DDDDDDDDEE044GGGGGGGGHH044ALTKEY1UUUUUUUUTT356ALTKEY2".IX2154.2 +039200 05 FILLER PIC X(53) VALUE IX2154.2 +039300 "DDDDDDDEEE046GGGGGGGHHH046ALTKEY1UUUUUUUTTT354ALTKEY2".IX2154.2 +039400 05 FILLER PIC X(53) VALUE IX2154.2 +039500 "DDDDDDEEEE048GGGGGGHHHH048ALTKEY1UUUUUUTTTT352ALTKEY2".IX2154.2 +039600 05 FILLER PIC X(53) VALUE IX2154.2 +039700 "DDDDDEEEEE050GGGGGHHHHH050ALTKEY1UUUUUTTTTT350ALTKEY2".IX2154.2 +039800 05 FILLER PIC X(53) VALUE IX2154.2 +039900 "DDDDEEEEEE052GGGGHHHHHH052ALTKEY1UUUUTTTTTT348ALTKEY2".IX2154.2 +040000 05 FILLER PIC X(53) VALUE IX2154.2 +040100 "DDDEEEEEEE054GGGHHHHHHH054ALTKEY1UUUTTTTTTT346ALTKEY2".IX2154.2 +040200 05 FILLER PIC X(53) VALUE IX2154.2 +040300 "DDEEEEEEEE056GGHHHHHHHH056ALTKEY1UUTTTTTTTT344ALTKEY2".IX2154.2 +040400 05 FILLER PIC X(53) VALUE IX2154.2 +040500 "DEEEEEEEEE058GHHHHHHHHH058ALTKEY1UTTTTTTTTT342ALTKEY2".IX2154.2 +040600 05 FILLER PIC X(53) VALUE IX2154.2 +040700 "EEEEEEEEEE060HHHHHHHHHH060ALTKEY1TTTTTTTTTT340ALTKEY2".IX2154.2 +040800 05 FILLER PIC X(53) VALUE IX2154.2 +040900 "EEEEEEEEEF062HHHHHHHHHI062ALTKEY1TTTTTTTTTT340ALTKEY2".IX2154.2 +041000 05 FILLER PIC X(53) VALUE IX2154.2 +041100 "EEEEEEEEFF064HHHHHHHHII064ALTKEY1TTTTTTTTSS336ALTKEY2".IX2154.2 +041200 05 FILLER PIC X(53) VALUE IX2154.2 +041300 "EEEEEEEFFF066HHHHHHHIII066ALTKEY1TTTTTTTSSS334ALTKEY2".IX2154.2 +041400 05 FILLER PIC X(53) VALUE IX2154.2 +041500 "EEEEEEFFFF068HHHHHHIIII068ALTKEY1TTTTTTSSSS332ALTKEY2".IX2154.2 +041600 05 FILLER PIC X(53) VALUE IX2154.2 +041700 "EEEEEFFFFF070HHHHHIIIII070ALTKEY1TTTTTSSSSS330ALTKEY2".IX2154.2 +041800 05 FILLER PIC X(53) VALUE IX2154.2 +041900 "EEEEFFFFFF072HHHHIIIIII072ALTKEY1TTTTSSSSSS328ALTKEY2".IX2154.2 +042000 05 FILLER PIC X(53) VALUE IX2154.2 +042100 "EEEFFFFFFF074HHHIIIIIII074ALTKEY1TTTSSSSSSS326ALTKEY2".IX2154.2 +042200 05 FILLER PIC X(53) VALUE IX2154.2 +042300 "EEFFFFFFFF076HHIIIIIIII076ALTKEY1TTSSSSSSSS324ALTKEY2".IX2154.2 +042400 05 FILLER PIC X(53) VALUE IX2154.2 +042500 "EFFFFFFFFF078HIIIIIIIII078ALTKEY1TSSSSSSSSS322ALTKEY2".IX2154.2 +042600 05 FILLER PIC X(53) VALUE IX2154.2 +042700 "FFFFFFFFFF080IIIIIIIIII080ALTKEY1SSSSSSSSSS320ALTKEY2".IX2154.2 +042800 05 FILLER PIC X(53) VALUE IX2154.2 +042900 "FFFFFFFFFG082IIIIIIIIIJ082ALTKEY1SSSSSSSSSS320ALTKEY2".IX2154.2 +043000 05 FILLER PIC X(53) VALUE IX2154.2 +043100 "FFFFFFFFGG084IIIIIIIIJJ084ALTKEY1SSSSSSSSRR316ALTKEY2".IX2154.2 +043200 05 FILLER PIC X(53) VALUE IX2154.2 +043300 "FFFFFFFGGG086IIIIIIIJJJ086ALTKEY1SSSSSSSRRR314ALTKEY2".IX2154.2 +043400 05 FILLER PIC X(53) VALUE IX2154.2 +043500 "FFFFFFGGGG088IIIIIIJJJJ088ALTKEY1SSSSSSRRRR312ALTKEY2".IX2154.2 +043600 05 FILLER PIC X(53) VALUE IX2154.2 +043700 "FFFFFGGGGG090IIIIIJJJJJ090ALTKEY1SSSSSRRRRR310ALTKEY2".IX2154.2 +043800 05 FILLER PIC X(53) VALUE IX2154.2 +043900 "FFFFGGGGGG092IIIIJJJJJJ092ALTKEY1SSSSRRRRRR308ALTKEY2".IX2154.2 +044000 05 FILLER PIC X(53) VALUE IX2154.2 +044100 "FFFGGGGGGG094IIIJJJJJJJ094ALTKEY1SSSRRRRRRR306ALTKEY2".IX2154.2 +044200 05 FILLER PIC X(53) VALUE IX2154.2 +044300 "FFGGGGGGGG096IIJJJJJJJJ096ALTKEY1SSRRRRRRRR304ALTKEY2".IX2154.2 +044400 05 FILLER PIC X(53) VALUE IX2154.2 +044500 "FGGGGGGGGG098IJJJJJJJJJ098ALTKEY1SRRRRRRRRR302ALTKEY2".IX2154.2 +044600 05 FILLER PIC X(53) VALUE IX2154.2 +044700 "GGGGGGGGGG100JJJJJJJJJJ100ALTKEY1RRRRRRRRRR300ALTKEY2".IX2154.2 +044800 05 FILLER PIC X(53) VALUE IX2154.2 +044900 "RRRRSSSSSS352VVVVWWWWWW352ALTKEY1GGGGFFFFFF048ALTKEY2".IX2154.2 +045000 05 FILLER PIC X(53) VALUE IX2154.2 +045100 "RRRSSSSSSS354VVVWWWWWWW354ALTKEY1GGGFFFFFFF046ALTKEY2".IX2154.2 +045200 05 FILLER PIC X(53) VALUE IX2154.2 +045300 "RRSSSSSSSS356VVWWWWWWWW356ALTKEY1GGFFFFFFFF044ALTKEY2".IX2154.2 +045400 05 FILLER PIC X(53) VALUE IX2154.2 +045500 "RSSSSSSSSS358VWWWWWWWWW358ALTKEY1GFFFFFFFFF042ALTKEY2".IX2154.2 +045600 05 FILLER PIC X(53) VALUE IX2154.2 +045700 "SSSSSSSSSS360WWWWWWWWWW360ALTKEY1FFFFFFFFFF040ALTKEY2".IX2154.2 +045800 05 FILLER PIC X(53) VALUE IX2154.2 +045900 "SSSSSSSSST362WWWWWWWWWX362ALTKEY1FFFFFFFFFF040ALTKEY2".IX2154.2 +046000 05 FILLER PIC X(53) VALUE IX2154.2 +046100 "SSSSSSSSTT364WWWWWWWWXX364ALTKEY1FFFFFFFFEE036ALTKEY2".IX2154.2 +046200 05 FILLER PIC X(53) VALUE IX2154.2 +046300 "SSSSSSSTTT366WWWWWWWXXX366ALTKEY1FFFFFFFEEE034ALTKEY2".IX2154.2 +046400 05 FILLER PIC X(53) VALUE IX2154.2 +046500 "SSSSSSTTTT368WWWWWWXXXX368ALTKEY1FFFFFFEEEE032ALTKEY2".IX2154.2 +046600 05 FILLER PIC X(53) VALUE IX2154.2 +046700 "SSSSSTTTTT370WWWWWXXXXX370ALTKEY1FFFFFEEEEE030ALTKEY2".IX2154.2 +046800 05 FILLER PIC X(53) VALUE IX2154.2 +046900 "SSSSTTTTTT372WWWWXXXXXX372ALTKEY1FFFFEEEEEE028ALTKEY2".IX2154.2 +047000 05 FILLER PIC X(53) VALUE IX2154.2 +047100 "SSSTTTTTTT374WWWXXXXXXX374ALTKEY1FFFEEEEEEE026ALTKEY2".IX2154.2 +047200 05 FILLER PIC X(53) VALUE IX2154.2 +047300 "SSTTTTTTTT376WWXXXXXXXX376ALTKEY1FFEEEEEEEE024ALTKEY2".IX2154.2 +047400 05 FILLER PIC X(53) VALUE IX2154.2 +047500 "STTTTTTTTT378WXXXXXXXXX378ALTKEY1FEEEEEEEEE022ALTKEY2".IX2154.2 +047600 05 FILLER PIC X(53) VALUE IX2154.2 +047700 "TTTTTTTTTT380XXXXXXXXXX380ALTKEY1EEEEEEEEEE020ALTKEY2".IX2154.2 +047800 05 FILLER PIC X(53) VALUE IX2154.2 +047900 "TTTTTTTTTU382XXXXXXXXXY382ALTKEY1EEEEEEEEEE020ALTKEY2".IX2154.2 +048000 05 FILLER PIC X(53) VALUE IX2154.2 +048100 "TTTTTTTTUU384XXXXXXXXYY384ALTKEY1EEEEEEEEDD016ALTKEY2".IX2154.2 +048200 05 FILLER PIC X(53) VALUE IX2154.2 +048300 "TTTTTTTUUU386XXXXXXXYYY386ALTKEY1EEEEEEEDDD014ALTKEY2".IX2154.2 +048400 05 FILLER PIC X(53) VALUE IX2154.2 +048500 "TTTTTTUUUU388XXXXXXYYYY388ALTKEY1EEEEEEDDDD012ALTKEY2".IX2154.2 +048600 05 FILLER PIC X(53) VALUE IX2154.2 +048700 "TTTTTUUUUU390XXXXXYYYYY390ALTKEY1EEEEEDDDDD010ALTKEY2".IX2154.2 +048800 05 FILLER PIC X(53) VALUE IX2154.2 +048900 "TTTTUUUUUU392XXXXYYYYYY392ALTKEY1EEEEDDDDDD008ALTKEY2".IX2154.2 +049000 05 FILLER PIC X(53) VALUE IX2154.2 +049100 "TTTUUUUUUU394XXXYYYYYYY394ALTKEY1EEEDDDDDDD006ALTKEY2".IX2154.2 +049200 05 FILLER PIC X(53) VALUE IX2154.2 +049300 "TTUUUUUUUU396XXYYYYYYYY396ALTKEY1EEDDDDDDDD004ALTKEY2".IX2154.2 +049400 05 FILLER PIC X(53) VALUE IX2154.2 +049500 "TUUUUUUUUU398XYYYYYYYYY398ALTKEY1EDDDDDDDDD002ALTKEY2".IX2154.2 +049600 05 FILLER PIC X(53) VALUE IX2154.2 +049700 "UUUUUUUUUU400YYYYYYYYYY400ALTKEY1DDDDDDDDDD000ALTKEY2".IX2154.2 +049800 01 RECORD-KEY-DATA REDEFINES RECORD-KEY-CONTENT. IX2154.2 +049900 05 KEY-VALUES OCCURS 75 TIMES. IX2154.2 +050000 10 RECKEY-VALUE PICTURE X(13). IX2154.2 +050100 10 ALTKEY1-VALUE PICTURE X(20). IX2154.2 +050200 10 ALTKEY2-VALUE PICTURE X(20). IX2154.2 +050300 01 INIT-FLAG PICTURE 9. IX2154.2 +050400 01 FILE-RECORD-INFORMATION-REC. IX2154.2 +050500 03 FILE-RECORD-INFO-SKELETON. IX2154.2 +050600 05 FILLER PICTURE X(48) VALUE IX2154.2 +050700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2154.2 +050800 05 FILLER PICTURE X(46) VALUE IX2154.2 +050900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2154.2 +051000 05 FILLER PICTURE X(26) VALUE IX2154.2 +051100 ",LFIL=000000,ORG= ,LBLR= ". IX2154.2 +051200 05 FILLER PICTURE X(37) VALUE IX2154.2 +051300 ",RECKEY= ". IX2154.2 +051400 05 FILLER PICTURE X(38) VALUE IX2154.2 +051500 ",ALTKEY1= ". IX2154.2 +051600 05 FILLER PICTURE X(38) VALUE IX2154.2 +051700 ",ALTKEY2= ". IX2154.2 +051800 05 FILLER PICTURE X(7) VALUE SPACE.IX2154.2 +051900 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2154.2 +052000 05 FILE-RECORD-INFO-P1-120. IX2154.2 +052100 07 FILLER PIC X(5). IX2154.2 +052200 07 XFILE-NAME PIC X(6). IX2154.2 +052300 07 FILLER PIC X(8). IX2154.2 +052400 07 XRECORD-NAME PIC X(6). IX2154.2 +052500 07 FILLER PIC X(1). IX2154.2 +052600 07 REELUNIT-NUMBER PIC 9(1). IX2154.2 +052700 07 FILLER PIC X(7). IX2154.2 +052800 07 XRECORD-NUMBER PIC 9(6). IX2154.2 +052900 07 FILLER PIC X(6). IX2154.2 +053000 07 UPDATE-NUMBER PIC 9(2). IX2154.2 +053100 07 FILLER PIC X(5). IX2154.2 +053200 07 ODO-NUMBER PIC 9(4). IX2154.2 +053300 07 FILLER PIC X(5). IX2154.2 +053400 07 XPROGRAM-NAME PIC X(5). IX2154.2 +053500 07 FILLER PIC X(7). IX2154.2 +053600 07 XRECORD-LENGTH PIC 9(6). IX2154.2 +053700 07 FILLER PIC X(7). IX2154.2 +053800 07 CHARS-OR-RECORDS PIC X(2). IX2154.2 +053900 07 FILLER PIC X(1). IX2154.2 +054000 07 XBLOCK-SIZE PIC 9(4). IX2154.2 +054100 07 FILLER PIC X(6). IX2154.2 +054200 07 RECORDS-IN-FILE PIC 9(6). IX2154.2 +054300 07 FILLER PIC X(5). IX2154.2 +054400 07 XFILE-ORGANIZATION PIC X(2). IX2154.2 +054500 07 FILLER PIC X(6). IX2154.2 +054600 07 XLABEL-TYPE PIC X(1). IX2154.2 +054700 05 FILE-RECORD-INFO-P121-240. IX2154.2 +054800 07 FILLER PIC X(8). IX2154.2 +054900 07 XRECORD-KEY PIC X(29). IX2154.2 +055000 07 FILLER PIC X(9). IX2154.2 +055100 07 ALTERNATE-KEY1 PIC X(29). IX2154.2 +055200 07 FILLER PIC X(9). IX2154.2 +055300 07 ALTERNATE-KEY2 PIC X(29). IX2154.2 +055400 07 FILLER PIC X(7). IX2154.2 +055500 01 TEST-RESULTS. IX2154.2 +055600 02 FILLER PIC X VALUE SPACE. IX2154.2 +055700 02 FEATURE PIC X(20) VALUE SPACE. IX2154.2 +055800 02 FILLER PIC X VALUE SPACE. IX2154.2 +055900 02 P-OR-F PIC X(5) VALUE SPACE. IX2154.2 +056000 02 FILLER PIC X VALUE SPACE. IX2154.2 +056100 02 PAR-NAME. IX2154.2 +056200 03 FILLER PIC X(19) VALUE SPACE. IX2154.2 +056300 03 PARDOT-X PIC X VALUE SPACE. IX2154.2 +056400 03 DOTVALUE PIC 99 VALUE ZERO. IX2154.2 +056500 02 FILLER PIC X(8) VALUE SPACE. IX2154.2 +056600 02 RE-MARK PIC X(61). IX2154.2 +056700 01 TEST-COMPUTED. IX2154.2 +056800 02 FILLER PIC X(30) VALUE SPACE. IX2154.2 +056900 02 FILLER PIC X(17) VALUE IX2154.2 +057000 " COMPUTED=". IX2154.2 +057100 02 COMPUTED-X. IX2154.2 +057200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2154.2 +057300 03 COMPUTED-N REDEFINES COMPUTED-A IX2154.2 +057400 PIC -9(9).9(9). IX2154.2 +057500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2154.2 +057600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2154.2 +057700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2154.2 +057800 03 CM-18V0 REDEFINES COMPUTED-A. IX2154.2 +057900 04 COMPUTED-18V0 PIC -9(18). IX2154.2 +058000 04 FILLER PIC X. IX2154.2 +058100 03 FILLER PIC X(50) VALUE SPACE. IX2154.2 +058200 01 TEST-CORRECT. IX2154.2 +058300 02 FILLER PIC X(30) VALUE SPACE. IX2154.2 +058400 02 FILLER PIC X(17) VALUE " CORRECT =". IX2154.2 +058500 02 CORRECT-X. IX2154.2 +058600 03 CORRECT-A PIC X(20) VALUE SPACE. IX2154.2 +058700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2154.2 +058800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2154.2 +058900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2154.2 +059000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2154.2 +059100 03 CR-18V0 REDEFINES CORRECT-A. IX2154.2 +059200 04 CORRECT-18V0 PIC -9(18). IX2154.2 +059300 04 FILLER PIC X. IX2154.2 +059400 03 FILLER PIC X(2) VALUE SPACE. IX2154.2 +059500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2154.2 +059600 01 CCVS-C-1. IX2154.2 +059700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2154.2 +059800- "SS PARAGRAPH-NAME IX2154.2 +059900- " REMARKS". IX2154.2 +060000 02 FILLER PIC X(20) VALUE SPACE. IX2154.2 +060100 01 CCVS-C-2. IX2154.2 +060200 02 FILLER PIC X VALUE SPACE. IX2154.2 +060300 02 FILLER PIC X(6) VALUE "TESTED". IX2154.2 +060400 02 FILLER PIC X(15) VALUE SPACE. IX2154.2 +060500 02 FILLER PIC X(4) VALUE "FAIL". IX2154.2 +060600 02 FILLER PIC X(94) VALUE SPACE. IX2154.2 +060700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2154.2 +060800 01 REC-CT PIC 99 VALUE ZERO. IX2154.2 +060900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2154.2 +061000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2154.2 +061100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2154.2 +061200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2154.2 +061300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2154.2 +061400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2154.2 +061500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2154.2 +061600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2154.2 +061700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2154.2 +061800 01 CCVS-H-1. IX2154.2 +061900 02 FILLER PIC X(39) VALUE SPACES. IX2154.2 +062000 02 FILLER PIC X(42) VALUE IX2154.2 +062100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2154.2 +062200 02 FILLER PIC X(39) VALUE SPACES. IX2154.2 +062300 01 CCVS-H-2A. IX2154.2 +062400 02 FILLER PIC X(40) VALUE SPACE. IX2154.2 +062500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2154.2 +062600 02 FILLER PIC XXXX VALUE IX2154.2 +062700 "4.2 ". IX2154.2 +062800 02 FILLER PIC X(28) VALUE IX2154.2 +062900 " COPY - NOT FOR DISTRIBUTION". IX2154.2 +063000 02 FILLER PIC X(41) VALUE SPACE. IX2154.2 +063100 IX2154.2 +063200 01 CCVS-H-2B. IX2154.2 +063300 02 FILLER PIC X(15) VALUE IX2154.2 +063400 "TEST RESULT OF ". IX2154.2 +063500 02 TEST-ID PIC X(9). IX2154.2 +063600 02 FILLER PIC X(4) VALUE IX2154.2 +063700 " IN ". IX2154.2 +063800 02 FILLER PIC X(12) VALUE IX2154.2 +063900 " HIGH ". IX2154.2 +064000 02 FILLER PIC X(22) VALUE IX2154.2 +064100 " LEVEL VALIDATION FOR ". IX2154.2 +064200 02 FILLER PIC X(58) VALUE IX2154.2 +064300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2154.2 +064400 01 CCVS-H-3. IX2154.2 +064500 02 FILLER PIC X(34) VALUE IX2154.2 +064600 " FOR OFFICIAL USE ONLY ". IX2154.2 +064700 02 FILLER PIC X(58) VALUE IX2154.2 +064800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2154.2 +064900 02 FILLER PIC X(28) VALUE IX2154.2 +065000 " COPYRIGHT 1985 ". IX2154.2 +065100 01 CCVS-E-1. IX2154.2 +065200 02 FILLER PIC X(52) VALUE SPACE. IX2154.2 +065300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2154.2 +065400 02 ID-AGAIN PIC X(9). IX2154.2 +065500 02 FILLER PIC X(45) VALUE SPACES. IX2154.2 +065600 01 CCVS-E-2. IX2154.2 +065700 02 FILLER PIC X(31) VALUE SPACE. IX2154.2 +065800 02 FILLER PIC X(21) VALUE SPACE. IX2154.2 +065900 02 CCVS-E-2-2. IX2154.2 +066000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2154.2 +066100 03 FILLER PIC X VALUE SPACE. IX2154.2 +066200 03 ENDER-DESC PIC X(44) VALUE IX2154.2 +066300 "ERRORS ENCOUNTERED". IX2154.2 +066400 01 CCVS-E-3. IX2154.2 +066500 02 FILLER PIC X(22) VALUE IX2154.2 +066600 " FOR OFFICIAL USE ONLY". IX2154.2 +066700 02 FILLER PIC X(12) VALUE SPACE. IX2154.2 +066800 02 FILLER PIC X(58) VALUE IX2154.2 +066900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2154.2 +067000 02 FILLER PIC X(13) VALUE SPACE. IX2154.2 +067100 02 FILLER PIC X(15) VALUE IX2154.2 +067200 " COPYRIGHT 1985". IX2154.2 +067300 01 CCVS-E-4. IX2154.2 +067400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2154.2 +067500 02 FILLER PIC X(4) VALUE " OF ". IX2154.2 +067600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2154.2 +067700 02 FILLER PIC X(40) VALUE IX2154.2 +067800 " TESTS WERE EXECUTED SUCCESSFULLY". IX2154.2 +067900 01 XXINFO. IX2154.2 +068000 02 FILLER PIC X(19) VALUE IX2154.2 +068100 "*** INFORMATION ***". IX2154.2 +068200 02 INFO-TEXT. IX2154.2 +068300 04 FILLER PIC X(8) VALUE SPACE. IX2154.2 +068400 04 XXCOMPUTED PIC X(20). IX2154.2 +068500 04 FILLER PIC X(5) VALUE SPACE. IX2154.2 +068600 04 XXCORRECT PIC X(20). IX2154.2 +068700 02 INF-ANSI-REFERENCE PIC X(48). IX2154.2 +068800 01 HYPHEN-LINE. IX2154.2 +068900 02 FILLER PIC IS X VALUE IS SPACE. IX2154.2 +069000 02 FILLER PIC IS X(65) VALUE IS "************************IX2154.2 +069100- "*****************************************". IX2154.2 +069200 02 FILLER PIC IS X(54) VALUE IS "************************IX2154.2 +069300- "******************************". IX2154.2 +069400 01 CCVS-PGM-ID PIC X(9) VALUE IX2154.2 +069500 "IX215A". IX2154.2 +069600 PROCEDURE DIVISION. IX2154.2 +069700 CCVS1 SECTION. IX2154.2 +069800 OPEN-FILES. IX2154.2 +069900*P OPEN I-O RAW-DATA. IX2154.2 +070000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2154.2 +070100*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2154.2 +070200*P MOVE "ABORTED " TO C-ABORT. IX2154.2 +070300*P ADD 1 TO C-NO-OF-TESTS. IX2154.2 +070400*P ACCEPT C-DATE FROM DATE. IX2154.2 +070500*P ACCEPT C-TIME FROM TIME. IX2154.2 +070600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2154.2 +070700*PND-E-1. IX2154.2 +070800*P CLOSE RAW-DATA. IX2154.2 +070900 OPEN OUTPUT PRINT-FILE. IX2154.2 +071000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2154.2 +071100 MOVE SPACE TO TEST-RESULTS. IX2154.2 +071200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2154.2 +071300 MOVE ZERO TO REC-SKL-SUB. IX2154.2 +071400 PERFORM CCVS-INIT-FILE 9 TIMES. IX2154.2 +071500 CCVS-INIT-FILE. IX2154.2 +071600 ADD 1 TO REC-SKL-SUB. IX2154.2 +071700 MOVE FILE-RECORD-INFO-SKELETON IX2154.2 +071800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2154.2 +071900 CCVS-INIT-EXIT. IX2154.2 +072000 GO TO CCVS1-EXIT. IX2154.2 +072100 CLOSE-FILES. IX2154.2 +072200*P OPEN I-O RAW-DATA. IX2154.2 +072300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2154.2 +072400*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2154.2 +072500*P MOVE "OK. " TO C-ABORT. IX2154.2 +072600*P MOVE PASS-COUNTER TO C-OK. IX2154.2 +072700*P MOVE ERROR-HOLD TO C-ALL. IX2154.2 +072800*P MOVE ERROR-COUNTER TO C-FAIL. IX2154.2 +072900*P MOVE DELETE-COUNTER TO C-DELETED. IX2154.2 +073000*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2154.2 +073100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2154.2 +073200*PND-E-2. IX2154.2 +073300*P CLOSE RAW-DATA. IX2154.2 +073400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2154.2 +073500 TERMINATE-CCVS. IX2154.2 +073600*S EXIT PROGRAM. IX2154.2 +073700*SERMINATE-CALL. IX2154.2 +073800 STOP RUN. IX2154.2 +073900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2154.2 +074000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2154.2 +074100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2154.2 +074200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2154.2 +074300 MOVE "****TEST DELETED****" TO RE-MARK. IX2154.2 +074400 PRINT-DETAIL. IX2154.2 +074500 IF REC-CT NOT EQUAL TO ZERO IX2154.2 +074600 MOVE "." TO PARDOT-X IX2154.2 +074700 MOVE REC-CT TO DOTVALUE. IX2154.2 +074800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2154.2 +074900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2154.2 +075000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2154.2 +075100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2154.2 +075200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2154.2 +075300 MOVE SPACE TO CORRECT-X. IX2154.2 +075400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2154.2 +075500 MOVE SPACE TO RE-MARK. IX2154.2 +075600 HEAD-ROUTINE. IX2154.2 +075700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +075800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +075900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2154.2 +076000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2154.2 +076100 COLUMN-NAMES-ROUTINE. IX2154.2 +076200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +076300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +076400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +076500 END-ROUTINE. IX2154.2 +076600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2154.2 +076700 END-RTN-EXIT. IX2154.2 +076800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +076900 END-ROUTINE-1. IX2154.2 +077000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2154.2 +077100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2154.2 +077200 ADD PASS-COUNTER TO ERROR-HOLD. IX2154.2 +077300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2154.2 +077400 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2154.2 +077500 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2154.2 +077600 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2154.2 +077700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2154.2 +077800 END-ROUTINE-12. IX2154.2 +077900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2154.2 +078000 IF ERROR-COUNTER IS EQUAL TO ZERO IX2154.2 +078100 MOVE "NO " TO ERROR-TOTAL IX2154.2 +078200 ELSE IX2154.2 +078300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2154.2 +078400 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2154.2 +078500 PERFORM WRITE-LINE. IX2154.2 +078600 END-ROUTINE-13. IX2154.2 +078700 IF DELETE-COUNTER IS EQUAL TO ZERO IX2154.2 +078800 MOVE "NO " TO ERROR-TOTAL ELSE IX2154.2 +078900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2154.2 +079000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2154.2 +079100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +079200 IF INSPECT-COUNTER EQUAL TO ZERO IX2154.2 +079300 MOVE "NO " TO ERROR-TOTAL IX2154.2 +079400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2154.2 +079500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2154.2 +079600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +079700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2154.2 +079800 WRITE-LINE. IX2154.2 +079900 ADD 1 TO RECORD-COUNT. IX2154.2 +080000 IF RECORD-COUNT GREATER 42 IX2154.2 +080100 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2154.2 +080200 MOVE SPACE TO DUMMY-RECORD IX2154.2 +080300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2154.2 +080400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2154.2 +080500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2154.2 +080600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2154.2 +080700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2154.2 +080800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2154.2 +080900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2154.2 +081000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2154.2 +081100 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2154.2 +081200 MOVE ZERO TO RECORD-COUNT. IX2154.2 +081300 PERFORM WRT-LN. IX2154.2 +081400 WRT-LN. IX2154.2 +081500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2154.2 +081600 MOVE SPACE TO DUMMY-RECORD. IX2154.2 +081700 BLANK-LINE-PRINT. IX2154.2 +081800 PERFORM WRT-LN. IX2154.2 +081900 FAIL-ROUTINE. IX2154.2 +082000 IF COMPUTED-X NOT EQUAL TO SPACE IX2154.2 +082100 GO TO FAIL-ROUTINE-WRITE. IX2154.2 +082200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2154.2 +082300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2154.2 +082400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2154.2 +082500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +082600 MOVE SPACES TO INF-ANSI-REFERENCE. IX2154.2 +082700 GO TO FAIL-ROUTINE-EX. IX2154.2 +082800 FAIL-ROUTINE-WRITE. IX2154.2 +082900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2154.2 +083000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2154.2 +083100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2154.2 +083200 MOVE SPACES TO COR-ANSI-REFERENCE. IX2154.2 +083300 FAIL-ROUTINE-EX. EXIT. IX2154.2 +083400 BAIL-OUT. IX2154.2 +083500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2154.2 +083600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2154.2 +083700 BAIL-OUT-WRITE. IX2154.2 +083800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2154.2 +083900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2154.2 +084000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2154.2 +084100 MOVE SPACES TO INF-ANSI-REFERENCE. IX2154.2 +084200 BAIL-OUT-EX. EXIT. IX2154.2 +084300 CCVS1-EXIT. IX2154.2 +084400 EXIT. IX2154.2 +084500 SECT-0001-IX215A SECTION. IX2154.2 +084600 WRITE-INT-GF-01. IX2154.2 +084700 OPEN OUTPUT IX-FD1. IX2154.2 +084800 MOVE "IX-FD1" TO XFILE-NAME (1). IX2154.2 +084900 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2154.2 +085000 MOVE ZERO TO XRECORD-NUMBER (1). IX2154.2 +085100 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2154.2 +085200 MOVE "IX215" TO XPROGRAM-NAME (1). IX2154.2 +085300 MOVE 240 TO XRECORD-LENGTH (1). IX2154.2 +085400 MOVE 001 TO XBLOCK-SIZE (1). IX2154.2 +085500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2154.2 +085600 MOVE "S" TO XLABEL-TYPE (1). IX2154.2 +085700 MOVE 200 TO RECORDS-IN-FILE (1). IX2154.2 +085800 MOVE "CREATE-FILE-FD1" TO FEATURE. IX2154.2 +085900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. IX2154.2 +086000 MOVE ZERO TO KEYSUB. IX2154.2 +086100 MOVE ZERO TO INVKEY-COUNTER. IX2154.2 +086200 WRITE-INIT-GF-01-01. IX2154.2 +086300 PERFORM WRITE-TEST-GF-01-R1 50 TIMES. IX2154.2 +086400 PERFORM WRITE-TEST-GF-01-R2 125 TIMES. IX2154.2 +086500 PERFORM WRITE-TEST-GF-01-R1 25 TIMES. IX2154.2 +086600 GO TO WRITE-TEST-GF-01. IX2154.2 +086700 WRITE-TEST-GF-01-R1. IX2154.2 +086800 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +086900 ADD 001 TO KEYSUB. IX2154.2 +087000 MOVE RECKEY-VALUE (KEYSUB) TO FDW-RECKEY-1-13. IX2154.2 +087100 MOVE ALTKEY1-VALUE (KEYSUB) TO FDW-ALTKEY1-1-20. IX2154.2 +087200 MOVE ALTKEY2-VALUE (KEYSUB) TO FDW-ALTKEY2-1-20. IX2154.2 +087300 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +087400 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +087500 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +087600 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2154.2 +087700 WRITE IX-FD1R1-F-G-240 IX2154.2 +087800 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +087900 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +088000 WRITE-TEST-GF-01-R2. IX2154.2 +088100 ADD 002 TO FDW-RECKEY-11-13. IX2154.2 +088200 ADD 002 TO FDW-ALTKEY1-11-13. IX2154.2 +088300 SUBTRACT 002 FROM FDW-ALTKEY2-11-13. IX2154.2 +088400 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +088500 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +088600 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +088700 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +088800 MOVE FILE-RECORD-INFO (1) TO IX-FD1R1-F-G-240. IX2154.2 +088900 WRITE IX-FD1R1-F-G-240 IX2154.2 +089000 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +089100 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +089200 WRITE-TEST-GF-01. IX2154.2 +089300 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2154.2 +089400 GIVING RECORDS-WRITTEN. IX2154.2 +089500 IF RECORDS-WRITTEN EQUAL TO 200 IX2154.2 +089600 PERFORM PASS IX2154.2 +089700 MOVE "FILE IX-FD1 CREATED (200 RECORDS)" TO RE-MARK IX2154.2 +089800 ELSE PERFORM FAIL IX2154.2 +089900 MOVE IX2154.2 +090000 "IX-41;WRONG NUMBER OF RECORDS WRITTEN (MAY ALREADY EXIST)"IX2154.2 +090100 TO RE-MARK IX2154.2 +090200 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2154.2 +090300 GO TO WRITE-TEST-GF-01-END. IX2154.2 +090400 WRITE-DELETE-GF-01. IX2154.2 +090500 PERFORM DE-LETE. IX2154.2 +090600 WRITE-TEST-GF-01-END. IX2154.2 +090700 PERFORM PRINT-DETAIL. IX2154.2 +090800 CLOSE IX-FD1. IX2154.2 +090900 READ-INIT-F1-01. IX2154.2 +091000 OPEN INPUT IX-FD1. IX2154.2 +091100 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2154.2 +091200 MOVE "READ FILE IX-FD1" TO FEATURE. IX2154.2 +091300 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +091400 MOVE 02 TO RECKEY-NUM. IX2154.2 +091500 MOVE 002 TO ALTKEY1-NUM. IX2154.2 +091600 READ-TEST-F1-01-R1. IX2154.2 +091700 READ IX-FD1 NEXT RECORD AT END GO TO READ-TEST-F1-01. IX2154.2 +091800 MOVE IX-REC-KEY-AREA TO WRK-FDW-RECKEY. IX2154.2 +091900 MOVE IX-ALT-KEY1-AREA TO WRK-FDW-ALTKEY1. IX2154.2 +092000 IF FDW-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2154.2 +092100 AND FDW-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2154.2 +092200 NEXT SENTENCE IX2154.2 +092300 ELSE IX2154.2 +092400 PERFORM READ-FAIL-F1-01. IX2154.2 +092500 IF EXCUT-COUNTER-06V00 NOT LESS THAN 200 IX2154.2 +092600 GO TO READ-TEST-F1-01. IX2154.2 +092700 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +092800 ADD 002 TO RECKEY-NUM IX2154.2 +092900 ADD 002 TO ALTKEY1-NUM. IX2154.2 +093000 GO TO READ-TEST-F1-01-R1. IX2154.2 +093100 READ-TEST-F1-01. IX2154.2 +093200 IF FAIL-SW EQUAL TO 1 GO TO READ-EXIT-F1-01. IX2154.2 +093300 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2154.2 +093400 PERFORM PASS IX2154.2 +093500 MOVE "200 RECORDS VERIFIED" TO RE-MARK IX2154.2 +093600 ELSE PERFORM FAIL IX2154.2 +093700 MOVE "INCORRECT NUMBER OF RECORDS; IX-41 OR IX-28" TO RE-MARKIX2154.2 +093800 MOVE 200 TO CORRECT-18V0 IX2154.2 +093900 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2154.2 +094000 PERFORM PRINT-DETAIL. IX2154.2 +094100 GO TO READ-EXIT-F1-01. IX2154.2 +094200 READ-FAIL-F1-01. IX2154.2 +094300 MOVE 1 TO FAIL-SW. IX2154.2 +094400 PERFORM FAIL. IX2154.2 +094500 MOVE FDW-RECKEY-11-13 TO COMPUTED-18V0. IX2154.2 +094600 MOVE RECKEY-NUM TO CORRECT-18V0. IX2154.2 +094700 MOVE "READ-FAIL-F1-01; IX-41 OR IX-28" TO RE-MARK. IX2154.2 +094800 READ-EXIT-F1-01. IX2154.2 +094900 CLOSE IX-FD1. IX2154.2 +095000 START-INIT. IX2154.2 +095100 OPEN I-O IX-FD1. IX2154.2 +095200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +095300 MOVE "START-TEST-GF-01" TO PAR-NAME. IX2154.2 +095400 MOVE "START REDF REC-KEY" TO FEATURE. IX2154.2 +095500 MOVE "BBBBBBBBBC002" TO FDW-RECKEY-1-13. IX2154.2 +095600 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +095700 START-TEST-GF-01. IX2154.2 +095800 DELETE IX-FD1 INVALID KEY IX2154.2 +095900 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +096000 GO TO START-FAIL-GF-01. IX2154.2 +096100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +096200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +096300 GO TO START-DELETE-GF-01. IX2154.2 +096400 MOVE "BBBBBBBBBC002" TO FDW-RECKEY-1-13. IX2154.2 +096500 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +096600 START IX-FD1 IX2154.2 +096700 KEY IS EQUAL TO IX-REDF-RECKEY IX2154.2 +096800 INVALID KEY PERFORM PASS IX2154.2 +096900 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +097000 TO RE-MARK IX2154.2 +097100 GO TO START-WRITE-GF-01. IX2154.2 +097200 READ IX-FD1 NEXT RECORD AT END IX2154.2 +097300 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +097400 GO TO START-FAIL-GF-01. IX2154.2 +097500 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +097600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +097700 START-FAIL-GF-01. IX2154.2 +097800 PERFORM FAIL. IX2154.2 +097900 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +098000 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +098100 GO TO START-WRITE-GF-01. IX2154.2 +098200 START-DELETE-GF-01. IX2154.2 +098300 PERFORM DE-LETE. IX2154.2 +098400 START-WRITE-GF-01. IX2154.2 +098500 PERFORM PRINT-DETAIL. IX2154.2 +098600 START-INIT-GF-02. IX2154.2 +098700 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +098800 MOVE "START-TEST-GF-02" TO PAR-NAME. IX2154.2 +098900 MOVE "FGGGGGGGGG098" TO FDW-RECKEY-1-13. IX2154.2 +099000 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +099100 START-TEST-GF-02. IX2154.2 +099200 DELETE IX-FD1 INVALID KEY IX2154.2 +099300 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +099400 GO TO START-FAIL-GF-02. IX2154.2 +099500 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +099600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +099700 GO TO START-DELETE-GF-02. IX2154.2 +099800 MOVE "FGGGGGGAAA002" TO FDW-RECKEY-1-13. IX2154.2 +099900 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +100000 START IX-FD1 IX2154.2 +100100 KEY IS EQUAL TO R-RECKEY-1-7 IX2154.2 +100200 INVALID KEY PERFORM PASS IX2154.2 +100300 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +100400 TO RE-MARK IX2154.2 +100500 GO TO START-WRITE-GF-02. IX2154.2 +100600 READ IX-FD1 NEXT RECORD AT END IX2154.2 +100700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +100800 GO TO START-FAIL-GF-02. IX2154.2 +100900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +101000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +101100 START-FAIL-GF-02. IX2154.2 +101200 PERFORM FAIL. IX2154.2 +101300 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +101400 MOVE "IX-28 OR IX-36; WRONG RECORD NUMBER FOUND" TO RE-MARK. IX2154.2 +101500 GO TO START-WRITE-GF-02. IX2154.2 +101600 START-DELETE-GF-02. IX2154.2 +101700 PERFORM DE-LETE. IX2154.2 +101800 START-WRITE-GF-02. IX2154.2 +101900 PERFORM PRINT-DETAIL. IX2154.2 +102000 START-INIT-GF-03. IX2154.2 +102100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +102200 MOVE "START-TEST-GF-03" TO PAR-NAME. IX2154.2 +102300 MOVE "UUUUUUUUUU400" TO FDW-RECKEY-1-13. IX2154.2 +102400 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +102500 START-TEST-GF-03. IX2154.2 +102600 DELETE IX-FD1 INVALID KEY IX2154.2 +102700 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +102800 GO TO START-FAIL-GF-03. IX2154.2 +102900 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +103000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +103100 GO TO START-DELETE-GF-03. IX2154.2 +103200 MOVE "UUUUURRRRR000" TO FDW-RECKEY-1-13. IX2154.2 +103300 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +103400 START IX-FD1 IX2154.2 +103500 KEY IS EQUAL TO R-RECKEY-1-5 IX2154.2 +103600 INVALID KEY PERFORM PASS IX2154.2 +103700 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +103800 TO RE-MARK IX2154.2 +103900 GO TO START-WRITE-GF-03. IX2154.2 +104000 READ IX-FD1 NEXT RECORD AT END IX2154.2 +104100 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +104200 GO TO START-FAIL-GF-03. IX2154.2 +104300 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +104400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +104500 START-FAIL-GF-03. IX2154.2 +104600 PERFORM FAIL. IX2154.2 +104700 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +104800 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +104900 GO TO START-WRITE-GF-03. IX2154.2 +105000 START-DELETE-GF-03. IX2154.2 +105100 PERFORM DE-LETE. IX2154.2 +105200 START-WRITE-GF-03. IX2154.2 +105300 PERFORM PRINT-DETAIL. IX2154.2 +105400 START-INIT-GF-04. IX2154.2 +105500 MOVE "START REDF ALT-KEY-1" TO FEATURE. IX2154.2 +105600 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +105700 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2154.2 +105800 MOVE "TUUUUUUUUU398" TO FDW-RECKEY-1-13. IX2154.2 +105900 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +106000 START-TEST-GF-04. IX2154.2 +106100 READ IX-FD1 IX2154.2 +106200 KEY IS IX-FD1-KEY IX2154.2 +106300 INVALID KEY IX2154.2 +106400 MOVE "ERROR IX-28 F2; INVALID KEY PATH TAKEN ON INITIAL READ"IX2154.2 +106500 TO RE-MARK IX2154.2 +106600 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +106700 GO TO START-FAIL-GF-04. IX2154.2 +106800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +106900 IF XRECORD-NUMBER (3) NOT EQUAL TO 199 IX2154.2 +107000 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK IX2154.2 +107100 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +107200 GO TO START-FAIL-GF-04. IX2154.2 +107300 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +107400 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +107500 GO TO START-DELETE-GF-04. IX2154.2 +107600 MOVE "EEEEEEEEEE000ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +107700 MOVE "WWWWWWWWWW400ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +107800 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +107900 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +108000 MOVE "ERROR IX-33; INVALID KEY PATH TAKEN ON REWRITE"IX2154.2 +108100 TO RE-MARK IX2154.2 +108200 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +108300 GO TO START-FAIL-GF-04. IX2154.2 +108400 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +108500 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +108600 GO TO START-FAIL-GF-04. IX2154.2 +108700 MOVE "EEEEEEEEEE000ALTKEY1" TO FDW-ALTKEY1-1-20. IX2154.2 +108800 MOVE WRK-FDW-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2154.2 +108900 START IX-FD1 IX2154.2 +109000 KEY IS EQUAL TO IX-REDF-ALTKEY1 IX2154.2 +109100 INVALID KEY IX2154.2 +109200 MOVE "ERROR IX-36; INVALID KEY PATH TAKEN ON START" IX2154.2 +109300 TO RE-MARK IX2154.2 +109400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +109500 GO TO START-FAIL-GF-04. IX2154.2 +109600 READ IX-FD1 NEXT RECORD AT END IX2154.2 +109700 MOVE "IX-28 F1; AT END ON READ AFTER START" TO RE-MARKIX2154.2 +109800 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +109900 GO TO START-FAIL-GF-04. IX2154.2 +110000 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +110100 IF XRECORD-NUMBER (1) EQUAL TO 199 IX2154.2 +110200 PERFORM PASS IX2154.2 +110300 GO TO START-WRITE-GF-04. IX2154.2 +110400 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +110500 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +110600 MOVE "EEEEEEEEEE000ALTKEY1" TO CORRECT-A. IX2154.2 +110700 MOVE "IX-28 F1; INCORRECT ALTERNATE RECORD KEY1" TO RE-MARK.IX2154.2 +110800 PERFORM PRINT-DETAIL. IX2154.2 +110900 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +111000 TO RE-MARK. IX2154.2 +111100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +111200 START-FAIL-GF-04. IX2154.2 +111300 MOVE "START-TEST-GF-04" TO PAR-NAME. IX2154.2 +111400 PERFORM FAIL. IX2154.2 +111500 MOVE 199 TO CORRECT-18V0. IX2154.2 +111600 GO TO START-WRITE-GF-04. IX2154.2 +111700 START-DELETE-GF-04. IX2154.2 +111800 PERFORM DE-LETE. IX2154.2 +111900 START-WRITE-GF-04. IX2154.2 +112000 PERFORM PRINT-DETAIL. IX2154.2 +112100 START-INIT-GF-05. IX2154.2 +112200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +112300 MOVE "START-TEST-GF-05" TO PAR-NAME. IX2154.2 +112400 MOVE "BCCCCCCCCC018" TO FDW-RECKEY-1-13. IX2154.2 +112500 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +112600 START-TEST-GF-05. IX2154.2 +112700 READ IX-FD1 IX2154.2 +112800 KEY IS IX-FD1-KEY IX2154.2 +112900 INVALID KEY IX2154.2 +113000 MOVE "ERROR IX-33; INVALID KEY PATH TAKEN ON READ" IX2154.2 +113100 TO RE-MARK IX2154.2 +113200 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +113300 GO TO START-FAIL-GF-05. IX2154.2 +113400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +113500 IF XRECORD-NUMBER (3) NOT EQUAL TO 9 IX2154.2 +113600 MOVE 9 TO RECNO IX2154.2 +113700 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +113800 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK IX2154.2 +113900 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +114000 GO TO START-FAIL-GF-05. IX2154.2 +114100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +114200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +114300 GO TO START-DELETE-GF-05. IX2154.2 +114400 MOVE "AAAAAAAAAA400ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +114500 MOVE "ZZZZZZZZZZ002ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +114600 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +114700 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +114800 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +114900 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +115000 GO TO START-FAIL-GF-05. IX2154.2 +115100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +115200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +115300 GO TO START-FAIL-GF-05. IX2154.2 +115400 MOVE "AAAAAANNNN200ALTKEY1" TO FDW-ALTKEY1-1-20. IX2154.2 +115500 MOVE WRK-FDW-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2154.2 +115600 START IX-FD1 IX2154.2 +115700 KEY IS EQUAL TO R-ALTKEY1-1-6 IX2154.2 +115800 INVALID KEY IX2154.2 +115900 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +116000 TO RE-MARK IX2154.2 +116100 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +116200 GO TO START-FAIL-GF-05. IX2154.2 +116300 READ IX-FD1 NEXT RECORD AT END IX2154.2 +116400 MOVE "IX-28 F1; AT END ON READ AFTER START" TO RE-MARK IX2154.2 +116500 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +116600 GO TO START-FAIL-GF-05. IX2154.2 +116700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +116800 IF XRECORD-NUMBER (1) EQUAL TO 9 IX2154.2 +116900 PERFORM PASS IX2154.2 +117000 GO TO START-WRITE-GF-05. IX2154.2 +117100 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +117200 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +117300 MOVE "AAAAAAAAAA400ALTKEY1" TO CORRECT-A. IX2154.2 +117400 MOVE "INCORRECT ALTERNATE RECORD KEY1" TO RE-MARK. IX2154.2 +117500 PERFORM PRINT-DETAIL. IX2154.2 +117600 MOVE "IX-28 F1;WRONG RECORD NUMB FOUND READ ALTERN. REC KEY1"IX2154.2 +117700 TO RE-MARK. IX2154.2 +117800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +117900 START-FAIL-GF-05. IX2154.2 +118000 PERFORM FAIL. IX2154.2 +118100 MOVE 9 TO CORRECT-18V0. IX2154.2 +118200 GO TO START-WRITE-GF-05. IX2154.2 +118300 START-DELETE-GF-05. IX2154.2 +118400 PERFORM DE-LETE. IX2154.2 +118500 START-WRITE-GF-05. IX2154.2 +118600 PERFORM PRINT-DETAIL. IX2154.2 +118700 START-INIT-GF-06. IX2154.2 +118800 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +118900 MOVE "START-TEST-GF-06" TO PAR-NAME. IX2154.2 +119000 MOVE "GGGGGGGGGG100" TO FDW-RECKEY-1-13. IX2154.2 +119100 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +119200 START-TEST-GF-06. IX2154.2 +119300 READ IX-FD1 IX2154.2 +119400 KEY IS IX-FD1-KEY IX2154.2 +119500 INVALID KEY IX2154.2 +119600 MOVE "ERROR IX-28; INVALID KEY PATH TAKEN ON READ" IX2154.2 +119700 TO RE-MARK IX2154.2 +119800 GO TO START-FAIL-GF-06. IX2154.2 +119900 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +120000 IF XRECORD-NUMBER (3) NOT EQUAL TO 50 IX2154.2 +120100 MOVE 50 TO RECNO IX2154.2 +120200 MOVE "WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +120300 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +120400 GO TO START-FAIL-GF-06. IX2154.2 +120500 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +120600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +120700 GO TO START-DELETE-GF-06. IX2154.2 +120800 MOVE "AAGGGGGGGG100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +120900 MOVE "GGGGGGGGGG100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +121000 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +121100 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +121200 MOVE "ERROR IX-33; INVALID KEY PATH TAKEN ON REWRITE"IX2154.2 +121300 TO RE-MARK IX2154.2 +121400 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +121500 GO TO START-FAIL-GF-06. IX2154.2 +121600 IX2154.2 +121700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +121800 GO TO START-FAIL-GF-06. IX2154.2 +121900 MOVE "AAGGZZZZZZ100ALTKEY1" TO FDW-ALTKEY1-1-20. IX2154.2 +122000 MOVE WRK-FDW-ALTKEY1 TO IX-ALT-KEY1-AREA. IX2154.2 +122100 START IX-FD1 IX2154.2 +122200 KEY IS EQUAL TO R-ALTKEY1-1-4 IX2154.2 +122300 INVALID KEY IX2154.2 +122400 MOVE "ERROR IX-36; INVALID KEY PATH TAKEN ON START" IX2154.2 +122500 TO RE-MARK IX2154.2 +122600 MOVE "INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +122700 TO RE-MARK IX2154.2 +122800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +122900 GO TO START-FAIL-GF-06. IX2154.2 +123000 READ IX-FD1 NEXT RECORD AT END IX2154.2 +123100 MOVE "IX-28 F1; AT END ON READ AFTER START" TO RE-MARK IX2154.2 +123200 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +123300 GO TO START-FAIL-GF-06. IX2154.2 +123400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +123500 IF XRECORD-NUMBER (1) EQUAL TO 50 IX2154.2 +123600 PERFORM PASS IX2154.2 +123700 GO TO START-WRITE-GF-06. IX2154.2 +123800 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +123900 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +124000 MOVE "AAGGGGGGGG100ALTKEY1" TO CORRECT-A. IX2154.2 +124100 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +124200 PERFORM PRINT-DETAIL. IX2154.2 +124300 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1" IX2154.2 +124400 TO RE-MARK. IX2154.2 +124500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +124600 START-FAIL-GF-06. IX2154.2 +124700 PERFORM FAIL. IX2154.2 +124800 MOVE 50 TO CORRECT-18V0. IX2154.2 +124900 GO TO START-WRITE-GF-06. IX2154.2 +125000 START-DELETE-GF-06. IX2154.2 +125100 PERFORM DE-LETE. IX2154.2 +125200 START-WRITE-GF-06. IX2154.2 +125300 PERFORM PRINT-DETAIL. IX2154.2 +125400 START-INIT-GF-07. IX2154.2 +125500 MOVE "START REDF ALT-KEY-2" TO FEATURE. IX2154.2 +125600 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +125700 MOVE "START-TEST-GF-07" TO PAR-NAME. IX2154.2 +125800 MOVE "DDDDDEEEEE050" TO FDW-RECKEY-1-13. IX2154.2 +125900 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +126000 START-TEST-GF-07. IX2154.2 +126100 READ IX-FD1 IX2154.2 +126200 KEY IS IX-FD1-KEY IX2154.2 +126300 INVALID KEY IX2154.2 +126400 MOVE "IX-28 F2; INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +126500 TO RE-MARK IX2154.2 +126600 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +126700 GO TO START-FAIL-GF-07. IX2154.2 +126800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +126900 IF XRECORD-NUMBER (3) NOT EQUAL TO 25 IX2154.2 +127000 MOVE 25 TO RECNO IX2154.2 +127100 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +127200 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +127300 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +127400 GO TO START-FAIL-GF-07. IX2154.2 +127500 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +127600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +127700 GO TO START-DELETE-GF-07. IX2154.2 +127800 MOVE "BCBCBCBCBC200ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +127900 MOVE "CBCBCBCBCB100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +128000 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +128100 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +128200 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +128300 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +128400 GO TO START-FAIL-GF-07. IX2154.2 +128500 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +128600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +128700 GO TO START-FAIL-GF-07. IX2154.2 +128800 MOVE "CBCBCBCBCB100ALTKEY2" TO FDW-ALTKEY2-1-20. IX2154.2 +128900 MOVE WRK-FDW-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2154.2 +129000 START IX-FD1 IX2154.2 +129100 KEY IS EQUAL TO IX-REDF-ALTKEY2 IX2154.2 +129200 INVALID KEY IX2154.2 +129300 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +129400 TO RE-MARK IX2154.2 +129500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +129600 GO TO START-FAIL-GF-07. IX2154.2 +129700 READ IX-FD1 NEXT RECORD AT END IX2154.2 +129800 MOVE "IX-28; F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +129900 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +130000 GO TO START-FAIL-GF-07. IX2154.2 +130100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +130200 IF XRECORD-NUMBER (1) EQUAL TO 25 IX2154.2 +130300 PERFORM PASS IX2154.2 +130400 GO TO START-WRITE-GF-07. IX2154.2 +130500 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +130600 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +130700 MOVE "CBCBCBCBCB100ALTKEY2" TO CORRECT-A. IX2154.2 +130800 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +130900 PERFORM PRINT-DETAIL. IX2154.2 +131000 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +131100 TO RE-MARK. IX2154.2 +131200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +131300 START-FAIL-GF-07. IX2154.2 +131400 PERFORM FAIL. IX2154.2 +131500 MOVE 25 TO CORRECT-18V0. IX2154.2 +131600 GO TO START-WRITE-GF-07. IX2154.2 +131700 START-DELETE-GF-07. IX2154.2 +131800 PERFORM DE-LETE. IX2154.2 +131900 START-WRITE-GF-07. IX2154.2 +132000 PERFORM PRINT-DETAIL. IX2154.2 +132100 START-INIT-GF-08. IX2154.2 +132200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +132300 MOVE "START-TEST-GF-08" TO PAR-NAME. IX2154.2 +132400 MOVE "RRRRSSSSSS352" TO FDW-RECKEY-1-13. IX2154.2 +132500 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +132600 START-TEST-GF-08. IX2154.2 +132700 READ IX-FD1 IX2154.2 +132800 KEY IS IX-FD1-KEY IX2154.2 +132900 INVALID KEY IX2154.2 +133000 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +133100 TO RE-MARK IX2154.2 +133200 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +133300 GO TO START-FAIL-GF-08. IX2154.2 +133400 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +133500 IF XRECORD-NUMBER (3) NOT EQUAL TO 176 IX2154.2 +133600 MOVE 51 TO RECNO IX2154.2 +133700 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +133800 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +133900 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +134000 GO TO START-FAIL-GF-08. IX2154.2 +134100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +134200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +134300 GO TO START-DELETE-GF-08. IX2154.2 +134400 MOVE "DCDCDCDCDC100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +134500 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +134600 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +134700 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +134800 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +134900 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +135000 GO TO START-FAIL-GF-08. IX2154.2 +135100 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +135200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +135300 GO TO START-FAIL-GF-08. IX2154.2 +135400 MOVE "DCDAAAAAAA250ALTKEY2" TO FDW-ALTKEY2-1-20. IX2154.2 +135500 MOVE WRK-FDW-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2154.2 +135600 START IX-FD1 IX2154.2 +135700 KEY IS EQUAL TO R-ALTKEY2-1-3 IX2154.2 +135800 INVALID KEY IX2154.2 +135900 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +136000 TO RE-MARK IX2154.2 +136100 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +136200 GO TO START-FAIL-GF-08. IX2154.2 +136300 READ IX-FD1 NEXT RECORD AT END IX2154.2 +136400 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +136500 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +136600 GO TO START-FAIL-GF-08. IX2154.2 +136700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +136800 IF XRECORD-NUMBER (1) EQUAL TO 176 IX2154.2 +136900 PERFORM PASS IX2154.2 +137000 GO TO START-WRITE-GF-08. IX2154.2 +137100 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +137200 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +137300 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +137400 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +137500 PERFORM PRINT-DETAIL. IX2154.2 +137600 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +137700 TO RE-MARK. IX2154.2 +137800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +137900 START-FAIL-GF-08. IX2154.2 +138000 PERFORM FAIL. IX2154.2 +138100 MOVE 176 TO CORRECT-18V0. IX2154.2 +138200 GO TO START-WRITE-GF-08. IX2154.2 +138300 START-DELETE-GF-08. IX2154.2 +138400 PERFORM DE-LETE. IX2154.2 +138500 START-WRITE-GF-08. IX2154.2 +138600 PERFORM PRINT-DETAIL. IX2154.2 +138700 START-INIT-GF-09. IX2154.2 +138800 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +138900 MOVE "START-TEST-GF-09" TO PAR-NAME. IX2154.2 +139000 MOVE "BBBBBBCCCC008" TO FDW-RECKEY-1-13. IX2154.2 +139100 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +139200 START-TEST-GF-09. IX2154.2 +139300 READ IX-FD1 IX2154.2 +139400 KEY IS IX-FD1-KEY IX2154.2 +139500 INVALID KEY IX2154.2 +139600 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +139700 TO RE-MARK IX2154.2 +139800 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +139900 MOVE 4 TO CORRECT-18V0 IX2154.2 +140000 GO TO START-FAIL-GF-09. IX2154.2 +140100 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (3). IX2154.2 +140200 IF XRECORD-NUMBER (3) NOT EQUAL TO 4 IX2154.2 +140300 MOVE 4 TO RECNO IX2154.2 +140400 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +140500 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +140600 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +140700 MOVE 4 TO CORRECT-18V0 IX2154.2 +140800 GO TO START-FAIL-GF-09. IX2154.2 +140900 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +141000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +141100 GO TO START-DELETE-GF-09. IX2154.2 +141200 MOVE "CDCDCDCDCD100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +141300 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +141400 MOVE FILE-RECORD-INFO (3) TO IX-FD1R1-F-G-240. IX2154.2 +141500 REWRITE IX-FD1R1-F-G-240 INVALID KEY IX2154.2 +141600 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +141700 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +141800 MOVE 4 TO CORRECT-18V0 IX2154.2 +141900 GO TO START-FAIL-GF-09. IX2154.2 +142000 PERFORM START-INIT-FD1 THRU START-INIT-FD1-EXIT. IX2154.2 +142100 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +142200 GO TO START-FAIL-GF-09. IX2154.2 +142300 MOVE "DCZZZZZZZZ400ALTKEY2" TO FDW-ALTKEY2-1-20. IX2154.2 +142400 MOVE WRK-FDW-ALTKEY2 TO IX-ALT-KEY2-AREA. IX2154.2 +142500 START IX-FD1 IX2154.2 +142600 KEY IS EQUAL TO R-ALTKEY2-1-2 IX2154.2 +142700 INVALID KEY IX2154.2 +142800 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +142900 TO RE-MARK IX2154.2 +143000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +143100 MOVE 176 TO CORRECT-18V0 IX2154.2 +143200 GO TO START-FAIL-GF-09. IX2154.2 +143300 READ IX-FD1 NEXT RECORD AT END IX2154.2 +143400 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +143500 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +143600 MOVE 176 TO CORRECT-18V0 IX2154.2 +143700 GO TO START-FAIL-GF-09. IX2154.2 +143800 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +143900 IF XRECORD-NUMBER (1) NOT EQUAL TO 176 IX2154.2 +144000 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2 IX2154.2 +144100 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A IX2154.2 +144200 MOVE "DCDCDCDCDC100" TO CORRECT-A IX2154.2 +144300 MOVE IX2154.2 +144400 "IX-28 OR IX-36; INCORR KEY FOUND ON FIRST READ DUPL KEYS" IX2154.2 +144500 TO RE-MARK IX2154.2 +144600 PERFORM PRINT-DETAIL IX2154.2 +144700 MOVE "WRONG RECORD NUMBER FOUND ON FIRST READ DUPLICATE KEYS"IX2154.2 +144800 TO RE-MARK IX2154.2 +144900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2154.2 +145000 MOVE 176 TO CORRECT-18V0 IX2154.2 +145100 GO TO START-FAIL-GF-09. IX2154.2 +145200 READ IX-FD1 NEXT RECORD AT END IX2154.2 +145300 MOVE "IX-28;F1 AT END ON READ AFTER FIRST READ" TO RE-MARK IX2154.2 +145400 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +145500 MOVE 4 TO CORRECT-18V0 IX2154.2 +145600 GO TO START-FAIL-GF-09. IX2154.2 +145700 MOVE IX-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2154.2 +145800 IF XRECORD-NUMBER (1) EQUAL TO 4 IX2154.2 +145900 PERFORM PASS IX2154.2 +146000 PERFORM PRINT-DETAIL IX2154.2 +146100 GO TO START-WRITE-GF-09. IX2154.2 +146200 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +146300 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +146400 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +146500 MOVE IX2154.2 +146600 "IX-28OR IX-36; INCORR KEY FOUND ON SECOND READ DUPL. KEYS" IX2154.2 +146700 TO RE-MARK. IX2154.2 +146800 PERFORM PRINT-DETAIL. IX2154.2 +146900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +147000 MOVE 4 TO CORRECT-18V0. IX2154.2 +147100 START-FAIL-GF-09. IX2154.2 +147200 PERFORM FAIL. IX2154.2 +147300 GO TO START-WRITE-GF-09. IX2154.2 +147400 START-DELETE-GF-09. IX2154.2 +147500 PERFORM DE-LETE. IX2154.2 +147600 START-WRITE-GF-09. IX2154.2 +147700 PERFORM PRINT-DETAIL. IX2154.2 +147800 START-TERM-003. IX2154.2 +147900 CLOSE IX-FD1. IX2154.2 +148000 WRITE-INT-GF-02. IX2154.2 +148100 OPEN OUTPUT IX-FD2. IX2154.2 +148200 MOVE "IX-FD2" TO XFILE-NAME (1). IX2154.2 +148300 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2154.2 +148400 MOVE ZERO TO XRECORD-NUMBER (1). IX2154.2 +148500 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2154.2 +148600 MOVE "IX215" TO XPROGRAM-NAME (1). IX2154.2 +148700 MOVE 241 TO XRECORD-LENGTH (1). IX2154.2 +148800 MOVE 004 TO XBLOCK-SIZE (1). IX2154.2 +148900 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2154.2 +149000 MOVE "S" TO XLABEL-TYPE (1). IX2154.2 +149100 MOVE 200 TO RECORDS-IN-FILE (1). IX2154.2 +149200 MOVE "CREATE-FILE-FD2" TO FEATURE. IX2154.2 +149300 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2154.2 +149400 MOVE ZERO TO KEYSUB. IX2154.2 +149500 MOVE ZERO TO INVKEY-COUNTER. IX2154.2 +149600 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +149700 WRITE-INIT-GF-02-01. IX2154.2 +149800 PERFORM WRITE-TEST-GF-02-R1 50 TIMES. IX2154.2 +149900 PERFORM WRITE-TEST-GF-02-R2 125 TIMES. IX2154.2 +150000 PERFORM WRITE-TEST-GF-02-R1 25 TIMES. IX2154.2 +150100 GO TO WRITE-TEST-GF-02. IX2154.2 +150200 WRITE-TEST-GF-02-R1. IX2154.2 +150300 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +150400 ADD 001 TO KEYSUB. IX2154.2 +150500 MOVE RECKEY-VALUE (KEYSUB) TO FDW-RECKEY-1-13. IX2154.2 +150600 MOVE ALTKEY1-VALUE (KEYSUB) TO FDW-ALTKEY1-1-20. IX2154.2 +150700 MOVE ALTKEY2-VALUE (KEYSUB) TO FDW-ALTKEY2-1-20. IX2154.2 +150800 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +150900 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +151000 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +151100 MOVE FILE-RECORD-INFO (1) TO IX-FD2R1-F-G-241. IX2154.2 +151200 WRITE IX-FD2R1-F-G-241 IX2154.2 +151300 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +151400 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +151500 WRITE-TEST-GF-02-R2. IX2154.2 +151600 ADD 002 TO FDW-RECKEY-11-13. IX2154.2 +151700 ADD 002 TO FDW-ALTKEY1-11-13. IX2154.2 +151800 SUBTRACT 002 FROM FDW-ALTKEY2-11-13. IX2154.2 +151900 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +152000 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +152100 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +152200 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +152300 MOVE FILE-RECORD-INFO (1) TO IX-FD2R1-F-G-241. IX2154.2 +152400 WRITE IX-FD2R1-F-G-241 IX2154.2 +152500 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +152600 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +152700 WRITE-TEST-GF-02. IX2154.2 +152800 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2154.2 +152900 GIVING RECORDS-WRITTEN. IX2154.2 +153000 IF RECORDS-WRITTEN EQUAL TO 200 IX2154.2 +153100 PERFORM PASS IX2154.2 +153200 MOVE "FILE IX-FD2 CREATED (200 RECORDS)" TO RE-MARK IX2154.2 +153300 ELSE PERFORM FAIL IX2154.2 +153400 MOVE "IX-41;IX2154.2 +153500- "WRONG NUMBER OF RECORDS WRITTEN (MAY ALREADY EXIST)" IX2154.2 +153600 TO RE-MARK IX2154.2 +153700 MOVE 200 TO CORRECT-18V0 IX2154.2 +153800 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2154.2 +153900 GO TO WRITE-TEST-GF-02-END. IX2154.2 +154000 WRITE-DELETE-GF-02. IX2154.2 +154100 PERFORM DE-LETE. IX2154.2 +154200 WRITE-TEST-GF-02-END. IX2154.2 +154300 PERFORM PRINT-DETAIL. IX2154.2 +154400 CLOSE IX-FD2. IX2154.2 +154500 READ-INIT-F1-02. IX2154.2 +154600 OPEN INPUT IX-FD2. IX2154.2 +154700 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX2154.2 +154800 MOVE "READ FILE IX-FD2" TO FEATURE. IX2154.2 +154900 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +155000 MOVE 02 TO RECKEY-NUM. IX2154.2 +155100 MOVE 002 TO ALTKEY1-NUM. IX2154.2 +155200 READ-TEST-F1-02-R1. IX2154.2 +155300 READ IX-FD2 NEXT RECORD AT END GO TO READ-TEST-F1-02. IX2154.2 +155400 MOVE IX-FD2-KEY TO FDW-RECKEY-1-13. IX2154.2 +155500 MOVE IX-FD2-ALTKEY1 TO FDW-ALTKEY1-1-20. IX2154.2 +155600 IF FDW-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2154.2 +155700 AND FDW-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2154.2 +155800 NEXT SENTENCE IX2154.2 +155900 ELSE IX2154.2 +156000 PERFORM READ-FAIL-F1-02. IX2154.2 +156100 IF EXCUT-COUNTER-06V00 NOT LESS THAN 200 IX2154.2 +156200 GO TO READ-TEST-F1-02. IX2154.2 +156300 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +156400 ADD 002 TO RECKEY-NUM IX2154.2 +156500 ADD 002 TO ALTKEY1-NUM. IX2154.2 +156600 GO TO READ-TEST-F1-02-R1. IX2154.2 +156700 READ-TEST-F1-02. IX2154.2 +156800 IF FAIL-SW EQUAL TO 1 GO TO READ-EXIT-F1-02. IX2154.2 +156900 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2154.2 +157000 PERFORM PASS IX2154.2 +157100 MOVE "200 RECORDS VERIFIED" TO RE-MARK IX2154.2 +157200 ELSE PERFORM FAIL IX2154.2 +157300 MOVE IX2154.2 +157400 "INCORRECT NUMBER OF RECORDS; IX-28 OR IX-41" TO RE-MARKIX2154.2 +157500 MOVE 200 TO CORRECT-18V0 IX2154.2 +157600 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2154.2 +157700 PERFORM PRINT-DETAIL. IX2154.2 +157800 GO TO READ-EXIT-F1-02. IX2154.2 +157900 READ-FAIL-F1-02. IX2154.2 +158000 MOVE 1 TO FAIL-SW. IX2154.2 +158100 PERFORM FAIL. IX2154.2 +158200 MOVE FDW-RECKEY-11-13 TO COMPUTED-18V0. IX2154.2 +158300 MOVE RECKEY-NUM TO CORRECT-18V0. IX2154.2 +158400 MOVE "NUM EMBEDDED IN RECKEY; IX-28 OR IX-41" TO RE-MARK. IX2154.2 +158500 PERFORM PRINT-DETAIL. IX2154.2 +158600 READ-EXIT-F1-02. IX2154.2 +158700 CLOSE IX-FD2. IX2154.2 +158800 START-INIT-GF-10. IX2154.2 +158900 OPEN I-O IX-FD2. IX2154.2 +159000 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +159100 MOVE "START-TEST-GF-10" TO PAR-NAME. IX2154.2 +159200 MOVE "START REDF REC-KEY" TO FEATURE. IX2154.2 +159300 MOVE "TTTTUUUUUU392" TO IX-FD2-KEY. IX2154.2 +159400 START-TEST-GF-10. IX2154.2 +159500 DELETE IX-FD2 INVALID KEY IX2154.2 +159600 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +159700 GO TO START-FAIL-GF-10. IX2154.2 +159800 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +159900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +160000 GO TO START-DELETE-GF-10. IX2154.2 +160100 MOVE "TTTTUUUUUU392" TO IX-FD2-KEY. IX2154.2 +160200 START IX-FD2 KEY IS EQUAL TO IX-FD2-KEY IX2154.2 +160300 INVALID KEY PERFORM PASS IX2154.2 +160400 GO TO START-WRITE-GF-10. IX2154.2 +160500 READ IX-FD2 NEXT RECORD AT END IX2154.2 +160600 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +160700 GO TO START-FAIL-GF-10. IX2154.2 +160800 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +160900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +161000 START-FAIL-GF-10. IX2154.2 +161100 PERFORM FAIL. IX2154.2 +161200 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +161300 MOVE "IX-36; WRONG RECORD NUMBER FOUND" TO RE-MARK. IX2154.2 +161400 GO TO START-WRITE-GF-10. IX2154.2 +161500 START-DELETE-GF-10. IX2154.2 +161600 PERFORM DE-LETE. IX2154.2 +161700 START-WRITE-GF-10. IX2154.2 +161800 PERFORM PRINT-DETAIL. IX2154.2 +161900 START-INIT-GF-11. IX2154.2 +162000 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +162100 MOVE "START-TEST-GF-11" TO PAR-NAME. IX2154.2 +162200 MOVE "FFFFFGGGGG090" TO IX-FD2-KEY. IX2154.2 +162300 START-TEST-GF-11. IX2154.2 +162400 DELETE IX-FD2 INVALID KEY IX2154.2 +162500 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +162600 GO TO START-FAIL-GF-11. IX2154.2 +162700 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +162800 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +162900 GO TO START-DELETE-GF-11. IX2154.2 +163000 MOVE "FFFFFGGGGG090" TO IX-FD2-KEY. IX2154.2 +163100 START IX-FD2 KEY IS EQUAL TO IX-FD2-RECKEY-REDF IX2154.2 +163200 INVALID KEY PERFORM PASS IX2154.2 +163300 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +163400 TO RE-MARK IX2154.2 +163500 GO TO START-WRITE-GF-11. IX2154.2 +163600 READ IX-FD2 NEXT RECORD AT END IX2154.2 +163700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +163800 GO TO START-FAIL-GF-11. IX2154.2 +163900 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +164000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +164100 START-FAIL-GF-11. IX2154.2 +164200 PERFORM FAIL. IX2154.2 +164300 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +164400 MOVE "IX-28 OR IX-36; WRONG RECORD NUMBER FOUND" TO RE-MARK. IX2154.2 +164500 GO TO START-WRITE-GF-11. IX2154.2 +164600 START-DELETE-GF-11. IX2154.2 +164700 PERFORM DE-LETE. IX2154.2 +164800 START-WRITE-GF-11. IX2154.2 +164900 PERFORM PRINT-DETAIL. IX2154.2 +165000 START-INIT-GF-12. IX2154.2 +165100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +165200 MOVE "START-TEST-GF-12" TO PAR-NAME. IX2154.2 +165300 MOVE "BBBBCCCCCC012" TO IX-FD2-KEY. IX2154.2 +165400 START-TEST-GF-12. IX2154.2 +165500 DELETE IX-FD2 INVALID KEY IX2154.2 +165600 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +165700 GO TO START-FAIL-GF-12. IX2154.2 +165800 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +165900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +166000 GO TO START-DELETE-GF-12. IX2154.2 +166100 MOVE "BBBBCCDDDD015" TO IX-FD2-KEY. IX2154.2 +166200 START IX-FD2 IX2154.2 +166300 KEY IS EQUAL TO IX-FD2-RECKEY-1-6 IX2154.2 +166400 INVALID KEY PERFORM PASS IX2154.2 +166500 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +166600 TO RE-MARK IX2154.2 +166700 GO TO START-WRITE-GF-12. IX2154.2 +166800 READ IX-FD2 NEXT RECORD AT END IX2154.2 +166900 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +167000 GO TO START-FAIL-GF-12. IX2154.2 +167100 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +167200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +167300 START-FAIL-GF-12. IX2154.2 +167400 PERFORM FAIL. IX2154.2 +167500 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +167600 MOVE "WRONG RECORD NUMBER FOUND" TO RE-MARK. IX2154.2 +167700 GO TO START-WRITE-GF-12. IX2154.2 +167800 START-DELETE-GF-12. IX2154.2 +167900 PERFORM DE-LETE. IX2154.2 +168000 START-WRITE-GF-12. IX2154.2 +168100 PERFORM PRINT-DETAIL. IX2154.2 +168200 START-INIT-GF-13. IX2154.2 +168300 MOVE "START REDF ALT-KEY-1" TO FEATURE. IX2154.2 +168400 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +168500 MOVE "START-TEST-GF-13" TO PAR-NAME. IX2154.2 +168600 MOVE "RSSSSSSSSS358" TO IX-FD2-KEY. IX2154.2 +168700 START-TEST-GF-13. IX2154.2 +168800 READ IX-FD2 IX2154.2 +168900 KEY IS IX-FD2-KEY IX2154.2 +169000 INVALID KEY IX2154.2 +169100 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +169200 TO RE-MARK IX2154.2 +169300 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +169400 GO TO START-FAIL-GF-13. IX2154.2 +169500 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +169600 IF XRECORD-NUMBER (3) NOT EQUAL TO 179 IX2154.2 +169700 MOVE 54 TO RECNO IX2154.2 +169800 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +169900 MOVE "WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +170000 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +170100 GO TO START-FAIL-GF-13. IX2154.2 +170200 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +170300 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +170400 GO TO START-DELETE-GF-13. IX2154.2 +170500 MOVE "EEEEEEEEEE000ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +170600 MOVE "WWWWWWWWWW400ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +170700 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +170800 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +170900 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +171000 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +171100 GO TO START-FAIL-GF-13. IX2154.2 +171200 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +171300 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +171400 GO TO START-FAIL-GF-13. IX2154.2 +171500 MOVE "EEEEEEEEEE000ALTKEY1" TO IX-FD2-ALTKEY1. IX2154.2 +171600 START IX-FD2 IX2154.2 +171700 KEY IS EQUAL TO IX-FD2-ALTKEY1 IX2154.2 +171800 INVALID KEY IX2154.2 +171900 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +172000 TO RE-MARK IX2154.2 +172100 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +172200 GO TO START-FAIL-GF-13. IX2154.2 +172300 READ IX-FD2 NEXT RECORD AT END IX2154.2 +172400 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +172500 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +172600 GO TO START-FAIL-GF-13. IX2154.2 +172700 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +172800 IF XRECORD-NUMBER (1) EQUAL TO 179 IX2154.2 +172900 PERFORM PASS IX2154.2 +173000 GO TO START-WRITE-GF-13. IX2154.2 +173100 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +173200 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +173300 MOVE "EEEEEEEEEE000ALTKEY1" TO CORRECT-A. IX2154.2 +173400 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +173500 PERFORM PRINT-DETAIL. IX2154.2 +173600 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +173700 TO RE-MARK. IX2154.2 +173800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +173900 START-FAIL-GF-13. IX2154.2 +174000 PERFORM FAIL. IX2154.2 +174100 MOVE 179 TO CORRECT-18V0. IX2154.2 +174200 GO TO START-WRITE-GF-13. IX2154.2 +174300 START-DELETE-GF-13. IX2154.2 +174400 PERFORM DE-LETE. IX2154.2 +174500 START-WRITE-GF-13. IX2154.2 +174600 PERFORM PRINT-DETAIL. IX2154.2 +174700 START-INIT-GF-14. IX2154.2 +174800 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +174900 MOVE "START-TEST-GF-14" TO PAR-NAME. IX2154.2 +175000 MOVE "TTUUUUUUUU396" TO IX-FD2-KEY. IX2154.2 +175100 START-TEST-GF-14. IX2154.2 +175200 READ IX-FD2 IX2154.2 +175300 KEY IS IX-FD2-KEY IX2154.2 +175400 INVALID KEY IX2154.2 +175500 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +175600 TO RE-MARK IX2154.2 +175700 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +175800 GO TO START-FAIL-GF-14. IX2154.2 +175900 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +176000 IF XRECORD-NUMBER (3) NOT EQUAL TO 198 IX2154.2 +176100 MOVE 73 TO RECNO IX2154.2 +176200 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +176300 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +176400 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +176500 GO TO START-FAIL-GF-14. IX2154.2 +176600 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +176700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +176800 GO TO START-DELETE-GF-14. IX2154.2 +176900 MOVE "AAAAAAAAAA400ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +177000 MOVE "ZZZZZZZZZZ002ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +177100 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +177200 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +177300 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +177400 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +177500 GO TO START-FAIL-GF-14. IX2154.2 +177600 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +177700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +177800 GO TO START-FAIL-GF-14. IX2154.2 +177900 MOVE "AAAAAAAAAA400ALTKEY1" TO IX-FD2-ALTKEY1. IX2154.2 +178000 START IX-FD2 IX2154.2 +178100 KEY IS EQUAL TO IX-FD2-REDF-ALTKEY1 IX2154.2 +178200 INVALID KEY IX2154.2 +178300 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +178400 TO RE-MARK IX2154.2 +178500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +178600 GO TO START-FAIL-GF-14. IX2154.2 +178700 READ IX-FD2 NEXT RECORD AT END IX2154.2 +178800 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +178900 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +179000 GO TO START-FAIL-GF-14. IX2154.2 +179100 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +179200 IF XRECORD-NUMBER (1) EQUAL TO 198 IX2154.2 +179300 PERFORM PASS IX2154.2 +179400 GO TO START-WRITE-GF-14. IX2154.2 +179500 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +179600 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +179700 MOVE "AAAAAAAAAA400ALTKEY1" TO CORRECT-A. IX2154.2 +179800 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +179900 PERFORM PRINT-DETAIL. IX2154.2 +180000 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +180100 TO RE-MARK. IX2154.2 +180200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +180300 START-FAIL-GF-14. IX2154.2 +180400 PERFORM FAIL. IX2154.2 +180500 MOVE 198 TO CORRECT-18V0. IX2154.2 +180600 GO TO START-WRITE-GF-14. IX2154.2 +180700 START-DELETE-GF-14. IX2154.2 +180800 PERFORM DE-LETE. IX2154.2 +180900 START-WRITE-GF-14. IX2154.2 +181000 PERFORM PRINT-DETAIL. IX2154.2 +181100 START-INIT-GF-15. IX2154.2 +181200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +181300 MOVE "START-TEST-GF-15" TO PAR-NAME. IX2154.2 +181400 MOVE "BBBBBBBBBC002" TO IX-FD2-KEY. IX2154.2 +181500 START-TEST-GF-15. IX2154.2 +181600 READ IX-FD2 IX2154.2 +181700 KEY IS IX-FD2-KEY IX2154.2 +181800 INVALID KEY IX2154.2 +181900 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +182000 TO RE-MARK IX2154.2 +182100 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +182200 GO TO START-FAIL-GF-15. IX2154.2 +182300 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +182400 IF XRECORD-NUMBER (3) NOT EQUAL TO 1 IX2154.2 +182500 MOVE 1 TO RECNO IX2154.2 +182600 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +182700 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +182800 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +182900 GO TO START-FAIL-GF-15. IX2154.2 +183000 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +183100 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +183200 GO TO START-DELETE-GF-15. IX2154.2 +183300 MOVE "AAGGGGGGGG100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +183400 MOVE "GGGGGGGGGG100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +183500 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +183600 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +183700 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +183800 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +183900 GO TO START-FAIL-GF-15. IX2154.2 +184000 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +184100 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +184200 GO TO START-FAIL-GF-15. IX2154.2 +184300 MOVE "AAGGGZZZZZ100ALTKEY1" TO IX-FD2-ALTKEY1. IX2154.2 +184400 START IX-FD2 IX2154.2 +184500 KEY IS EQUAL TO IX-FD2-ALTKEY1-1-5 IX2154.2 +184600 INVALID KEY IX2154.2 +184700 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +184800 TO RE-MARK IX2154.2 +184900 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +185000 GO TO START-FAIL-GF-15. IX2154.2 +185100 READ IX-FD2 NEXT RECORD AT END IX2154.2 +185200 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +185300 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +185400 GO TO START-FAIL-GF-15. IX2154.2 +185500 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +185600 IF XRECORD-NUMBER (1) EQUAL TO 1 IX2154.2 +185700 PERFORM PASS IX2154.2 +185800 GO TO START-WRITE-GF-15. IX2154.2 +185900 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +186000 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +186100 MOVE "AAGGGGGGGG100ALTKEY1" TO CORRECT-A. IX2154.2 +186200 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +186300 PERFORM PRINT-DETAIL. IX2154.2 +186400 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +186500 TO RE-MARK. IX2154.2 +186600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +186700 START-FAIL-GF-15. IX2154.2 +186800 PERFORM FAIL. IX2154.2 +186900 MOVE 1 TO CORRECT-18V0. IX2154.2 +187000 GO TO START-WRITE-GF-15. IX2154.2 +187100 START-DELETE-GF-15. IX2154.2 +187200 PERFORM DE-LETE. IX2154.2 +187300 START-WRITE-GF-15. IX2154.2 +187400 PERFORM PRINT-DETAIL. IX2154.2 +187500 START-INIT-GF-16. IX2154.2 +187600 MOVE "START REDF ALT-KEY-2" TO FEATURE. IX2154.2 +187700 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +187800 MOVE "START-TEST-GF-16" TO PAR-NAME. IX2154.2 +187900 MOVE "SSSSSTTTTT370" TO IX-FD2-KEY. IX2154.2 +188000 START-TEST-GF-16. IX2154.2 +188100 READ IX-FD2 IX2154.2 +188200 KEY IS IX-FD2-KEY IX2154.2 +188300 INVALID KEY IX2154.2 +188400 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +188500 TO RE-MARK IX2154.2 +188600 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +188700 GO TO START-FAIL-GF-16. IX2154.2 +188800 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +188900 IF XRECORD-NUMBER (3) NOT EQUAL TO 185 IX2154.2 +189000 MOVE 60 TO RECNO IX2154.2 +189100 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +189200 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +189300 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +189400 GO TO START-FAIL-GF-16. IX2154.2 +189500 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +189600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +189700 GO TO START-DELETE-GF-16. IX2154.2 +189800 MOVE "BCBCBCBCBC200ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +189900 MOVE "CBCBCBCBCB100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +190000 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +190100 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +190200 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +190300 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +190400 GO TO START-FAIL-GF-16. IX2154.2 +190500 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +190600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +190700 GO TO START-FAIL-GF-16. IX2154.2 +190800 MOVE "CBCBCBCBCB100ALTKEY2" TO IX-FD2-ALTKEY2. IX2154.2 +190900 START IX-FD2 IX2154.2 +191000 KEY IS EQUAL TO IX-FD2-ALTKEY2 IX2154.2 +191100 INVALID KEY IX2154.2 +191200 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +191300 TO RE-MARK IX2154.2 +191400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +191500 GO TO START-FAIL-GF-16. IX2154.2 +191600 READ IX-FD2 NEXT RECORD AT END IX2154.2 +191700 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +191800 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +191900 GO TO START-FAIL-GF-16. IX2154.2 +192000 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +192100 IF XRECORD-NUMBER (1) EQUAL TO 185 IX2154.2 +192200 PERFORM PASS IX2154.2 +192300 GO TO START-WRITE-GF-16. IX2154.2 +192400 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +192500 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +192600 MOVE "CBCBCBCBCB100ALTKEY2" TO CORRECT-A. IX2154.2 +192700 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +192800 PERFORM PRINT-DETAIL. IX2154.2 +192900 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +193000 TO RE-MARK. IX2154.2 +193100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +193200 START-FAIL-GF-16. IX2154.2 +193300 PERFORM FAIL. IX2154.2 +193400 MOVE 185 TO CORRECT-18V0. IX2154.2 +193500 GO TO START-WRITE-GF-16. IX2154.2 +193600 START-DELETE-GF-16. IX2154.2 +193700 PERFORM DE-LETE. IX2154.2 +193800 START-WRITE-GF-16. IX2154.2 +193900 PERFORM PRINT-DETAIL. IX2154.2 +194000 START-INIT-GF-17. IX2154.2 +194100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +194200 MOVE "START-TEST-GF-17" TO PAR-NAME. IX2154.2 +194300 MOVE "FFFFFFFFFG082" TO IX-FD2-KEY. IX2154.2 +194400 START-TEST-GF-17. IX2154.2 +194500 READ IX-FD2 IX2154.2 +194600 KEY IS IX-FD2-KEY IX2154.2 +194700 INVALID KEY IX2154.2 +194800 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +194900 TO RE-MARK IX2154.2 +195000 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +195100 GO TO START-FAIL-GF-17. IX2154.2 +195200 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +195300 IF XRECORD-NUMBER (3) NOT EQUAL TO 41 IX2154.2 +195400 MOVE 41 TO RECNO IX2154.2 +195500 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +195600 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +195700 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +195800 GO TO START-FAIL-GF-17. IX2154.2 +195900 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +196000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +196100 GO TO START-DELETE-GF-17. IX2154.2 +196200 MOVE "DCDCDCDCDC100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +196300 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +196400 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +196500 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +196600 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +196700 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +196800 GO TO START-FAIL-GF-17. IX2154.2 +196900 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +197000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +197100 GO TO START-FAIL-GF-17. IX2154.2 +197200 MOVE "DCDCDCZZZZ999ALTKEY2" TO IX-FD2-ALTKEY2. IX2154.2 +197300 START IX-FD2 IX2154.2 +197400 KEY IS EQUAL TO IX-FD2-ALTKEY2-1-6 IX2154.2 +197500 INVALID KEY IX2154.2 +197600 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +197700 TO RE-MARK IX2154.2 +197800 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +197900 GO TO START-FAIL-GF-17. IX2154.2 +198000 READ IX-FD2 NEXT RECORD AT END IX2154.2 +198100 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +198200 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +198300 GO TO START-FAIL-GF-17. IX2154.2 +198400 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +198500 IF XRECORD-NUMBER (1) EQUAL TO 41 IX2154.2 +198600 PERFORM PASS IX2154.2 +198700 GO TO START-WRITE-GF-17. IX2154.2 +198800 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +198900 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +199000 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +199100 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +199200 PERFORM PRINT-DETAIL. IX2154.2 +199300 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +199400 TO RE-MARK. IX2154.2 +199500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +199600 START-FAIL-GF-17. IX2154.2 +199700 PERFORM FAIL. IX2154.2 +199800 MOVE 41 TO CORRECT-18V0. IX2154.2 +199900 GO TO START-WRITE-GF-17. IX2154.2 +200000 START-DELETE-GF-17. IX2154.2 +200100 PERFORM DE-LETE. IX2154.2 +200200 START-WRITE-GF-17. IX2154.2 +200300 PERFORM PRINT-DETAIL. IX2154.2 +200400 START-INIT-GF-18. IX2154.2 +200500 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +200600 MOVE "START-TEST-GF-18" TO PAR-NAME. IX2154.2 +200700 MOVE "TTTTTTTTUU384" TO IX-FD2-KEY. IX2154.2 +200800 START-TEST-GF-18. IX2154.2 +200900 READ IX-FD2 IX2154.2 +201000 KEY IS IX-FD2-KEY IX2154.2 +201100 INVALID KEY IX2154.2 +201200 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +201300 TO RE-MARK IX2154.2 +201400 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +201500 MOVE 192 TO CORRECT-18V0 IX2154.2 +201600 GO TO START-FAIL-GF-18. IX2154.2 +201700 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (3). IX2154.2 +201800 IF XRECORD-NUMBER (3) NOT EQUAL TO 192 IX2154.2 +201900 MOVE 67 TO RECNO IX2154.2 +202000 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +202100 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +202200 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +202300 MOVE 192 TO CORRECT-18V0 IX2154.2 +202400 GO TO START-FAIL-GF-18. IX2154.2 +202500 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +202600 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +202700 GO TO START-DELETE-GF-18. IX2154.2 +202800 MOVE "CDCDCDCDCD100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +202900 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +203000 MOVE FILE-RECORD-INFO (3) TO IX-FD2R1-F-G-241. IX2154.2 +203100 REWRITE IX-FD2R1-F-G-241 INVALID KEY IX2154.2 +203200 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +203300 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +203400 MOVE 192 TO CORRECT-18V0 IX2154.2 +203500 GO TO START-FAIL-GF-18. IX2154.2 +203600 PERFORM START-INIT-FD2 THRU START-INIT-FD2-EXIT. IX2154.2 +203700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +203800 GO TO START-FAIL-GF-18. IX2154.2 +203900 MOVE "DCDZZZZZZZ400ALTKEY2" TO IX-FD2-ALTKEY2. IX2154.2 +204000 START IX-FD2 IX2154.2 +204100 KEY IS EQUAL TO IX-FD2-ALTKEY2-1-3 IX2154.2 +204200 INVALID KEY IX2154.2 +204300 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +204400 TO RE-MARK IX2154.2 +204500 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +204600 MOVE 41 TO CORRECT-18V0 IX2154.2 +204700 GO TO START-FAIL-GF-18. IX2154.2 +204800 READ IX-FD2 NEXT RECORD AT END IX2154.2 +204900 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +205000 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +205100 MOVE 41 TO CORRECT-18V0 IX2154.2 +205200 GO TO START-FAIL-GF-18. IX2154.2 +205300 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +205400 IF XRECORD-NUMBER (1) NOT EQUAL TO 41 IX2154.2 +205500 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2 IX2154.2 +205600 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A IX2154.2 +205700 MOVE "DCDCDCDCDC100" TO CORRECT-A IX2154.2 +205800 MOVE IX2154.2 +205900 "IX-28/36; INCORRECT KEY FOUND ON FIRST READ DUPLICATE KEYS"IX2154.2 +206000 TO RE-MARK IX2154.2 +206100 PERFORM PRINT-DETAIL IX2154.2 +206200 MOVE "WRONG RECORD NUMBER FOUND ON FIRST READ DUPLICATE KEYS"IX2154.2 +206300 TO RE-MARK IX2154.2 +206400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2154.2 +206500 MOVE 41 TO CORRECT-18V0 IX2154.2 +206600 GO TO START-FAIL-GF-18. IX2154.2 +206700 READ IX-FD2 NEXT RECORD AT END IX2154.2 +206800 MOVE "IX-28;F1 AT END ON READ AFTER FIRST READ" TO RE-MARK IX2154.2 +206900 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +207000 MOVE 192 TO CORRECT-18V0 IX2154.2 +207100 GO TO START-FAIL-GF-18. IX2154.2 +207200 MOVE IX-FD2-REC-240 TO FILE-RECORD-INFO (1). IX2154.2 +207300 IF XRECORD-NUMBER (1) EQUAL TO 192 IX2154.2 +207400 PERFORM PASS IX2154.2 +207500 GO TO START-WRITE-GF-18. IX2154.2 +207600 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +207700 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +207800 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +207900 MOVE IX2154.2 +208000 "IX-28/-36INCORRECT KEY FOUND ON SECOND READ DUPLICATE KEYS" IX2154.2 +208100 TO RE-MARK. IX2154.2 +208200 PERFORM PRINT-DETAIL. IX2154.2 +208300 MOVE "WRONG REC NUMBER FOUND ON SECOND READ DUPLICATE KEYS" IX2154.2 +208400 TO RE-MARK. IX2154.2 +208500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +208600 MOVE 192 TO CORRECT-18V0. IX2154.2 +208700 START-FAIL-GF-18. IX2154.2 +208800 PERFORM FAIL. IX2154.2 +208900 GO TO START-WRITE-GF-18. IX2154.2 +209000 START-DELETE-GF-18. IX2154.2 +209100 PERFORM DE-LETE. IX2154.2 +209200 START-WRITE-GF-18. IX2154.2 +209300 PERFORM PRINT-DETAIL. IX2154.2 +209400 WRITE-WRITE-03. IX2154.2 +209500 CLOSE IX-FD2. IX2154.2 +209600 WRITE-INT-GF-03. IX2154.2 +209700 OPEN OUTPUT IX-FD3. IX2154.2 +209800 MOVE "IX-FD3" TO XFILE-NAME (1). IX2154.2 +209900 MOVE "R1-F-G" TO XRECORD-NAME (1). IX2154.2 +210000 MOVE ZERO TO XRECORD-NUMBER (1). IX2154.2 +210100 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2154.2 +210200 MOVE "IX215" TO XPROGRAM-NAME (1). IX2154.2 +210300 MOVE 242 TO XRECORD-LENGTH (1). IX2154.2 +210400 MOVE 007 TO XBLOCK-SIZE (1). IX2154.2 +210500 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2154.2 +210600 MOVE "S" TO XLABEL-TYPE (1). IX2154.2 +210700 MOVE 200 TO RECORDS-IN-FILE (1). IX2154.2 +210800 MOVE "CREATE-FILE-FD3" TO FEATURE. IX2154.2 +210900 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX2154.2 +211000 MOVE ZERO TO KEYSUB. IX2154.2 +211100 MOVE ZERO TO INVKEY-COUNTER. IX2154.2 +211200 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +211300 WRITE-INIT-GF-03. IX2154.2 +211400 PERFORM WRITE-TEST-GF-03R1 50 TIMES. IX2154.2 +211500 PERFORM WRITE-TEST-GF-03R2 125 TIMES. IX2154.2 +211600 PERFORM WRITE-TEST-GF-03R1 25 TIMES. IX2154.2 +211700 GO TO WRITE-TEST-GF-03. IX2154.2 +211800 WRITE-TEST-GF-03R1. IX2154.2 +211900 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +212000 ADD 001 TO KEYSUB. IX2154.2 +212100 MOVE RECKEY-VALUE (KEYSUB) TO FDW-RECKEY-1-13. IX2154.2 +212200 MOVE ALTKEY1-VALUE (KEYSUB) TO FDW-ALTKEY1-1-20. IX2154.2 +212300 MOVE ALTKEY2-VALUE (KEYSUB) TO FDW-ALTKEY2-1-20. IX2154.2 +212400 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +212500 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +212600 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +212700 MOVE FILE-RECORD-INFO (1) TO IX-FD3R1-F-G-242. IX2154.2 +212800 WRITE IX-FD3R1-F-G-242 IX2154.2 +212900 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +213000 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +213100 WRITE-TEST-GF-03R2. IX2154.2 +213200 ADD 002 TO FDW-RECKEY-11-13. IX2154.2 +213300 ADD 002 TO FDW-ALTKEY1-11-13. IX2154.2 +213400 SUBTRACT 002 FROM FDW-ALTKEY2-11-13. IX2154.2 +213500 ADD 001 TO XRECORD-NUMBER (1). IX2154.2 +213600 MOVE WRK-FDW-RECKEY TO XRECORD-KEY (1). IX2154.2 +213700 MOVE WRK-FDW-ALTKEY1 TO ALTERNATE-KEY1 (1). IX2154.2 +213800 MOVE WRK-FDW-ALTKEY2 TO ALTERNATE-KEY2 (1). IX2154.2 +213900 MOVE FILE-RECORD-INFO (1) TO IX-FD3R1-F-G-242. IX2154.2 +214000 WRITE IX-FD3R1-F-G-242 IX2154.2 +214100 INVALID KEY ADD 001 TO INVKEY-COUNTER. IX2154.2 +214200 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +214300 WRITE-TEST-GF-03. IX2154.2 +214400 SUBTRACT INVKEY-COUNTER FROM EXCUT-COUNTER-06V00 IX2154.2 +214500 GIVING RECORDS-WRITTEN. IX2154.2 +214600 IF RECORDS-WRITTEN EQUAL TO 200 IX2154.2 +214700 PERFORM PASS IX2154.2 +214800 MOVE "FILE IX-FD3 CREATED (200 RECORDS)" TO RE-MARK IX2154.2 +214900 ELSE PERFORM FAIL IX2154.2 +215000 MOVE "IX-41;IX2154.2 +215100- "WRONG NUMBER OF RECORDS WRITTEN (MAY ALREADY EXIST)" IX2154.2 +215200 TO RE-MARK IX2154.2 +215300 MOVE 200 TO CORRECT-18V0 IX2154.2 +215400 MOVE RECORDS-WRITTEN TO COMPUTED-18V0. IX2154.2 +215500 PERFORM PRINT-DETAIL. IX2154.2 +215600 GO TO WRITE-TEST-GF-03-END. IX2154.2 +215700 WRITE-DELETE-GF-03. IX2154.2 +215800 PERFORM DE-LETE. IX2154.2 +215900 PERFORM PRINT-DETAIL. IX2154.2 +216000 WRITE-TEST-GF-03-END. IX2154.2 +216100 CLOSE IX-FD3. IX2154.2 +216200 READ-INIT-F1-O3. IX2154.2 +216300 OPEN INPUT IX-FD3. IX2154.2 +216400 MOVE "READ-TEST-F1-O3" TO PAR-NAME. IX2154.2 +216500 MOVE "READ FILE IX-FD3" TO FEATURE. IX2154.2 +216600 MOVE ZERO TO EXCUT-COUNTER-06V00. IX2154.2 +216700 MOVE 02 TO RECKEY-NUM. IX2154.2 +216800 MOVE 002 TO ALTKEY1-NUM. IX2154.2 +216900 READ-TEST-F1-O3-R1. IX2154.2 +217000 READ IX-FD3 NEXT RECORD AT END GO TO READ-TEST-F1-O3. IX2154.2 +217100 MOVE IX-FD3-RECKEY-AREA TO FDW-RECKEY-1-13. IX2154.2 +217200 MOVE IX-FD3-ALTKEY1-AREA TO FDW-ALTKEY1-1-20. IX2154.2 +217300 IF FDW-RECKEY-11-13 EQUAL TO RECKEY-NUM IX2154.2 +217400 AND FDW-ALTKEY1-11-13 EQUAL TO ALTKEY1-NUM IX2154.2 +217500 NEXT SENTENCE IX2154.2 +217600 ELSE IX2154.2 +217700 PERFORM READ-FAIL-F1-O3. IX2154.2 +217800 IF EXCUT-COUNTER-06V00 NOT LESS THAN 200 IX2154.2 +217900 GO TO READ-TEST-F1-O3. IX2154.2 +218000 ADD 001 TO EXCUT-COUNTER-06V00. IX2154.2 +218100 ADD 002 TO RECKEY-NUM IX2154.2 +218200 ADD 002 TO ALTKEY1-NUM. IX2154.2 +218300 GO TO READ-TEST-F1-O3-R1. IX2154.2 +218400 READ-TEST-F1-O3. IX2154.2 +218500 IF FAIL-SW EQUAL TO 1 GO TO READ-EXIT-F1-O3. IX2154.2 +218600 IF EXCUT-COUNTER-06V00 EQUAL TO 200 IX2154.2 +218700 PERFORM PASS IX2154.2 +218800 MOVE "200 RECORDS VERIFIED" TO RE-MARK IX2154.2 +218900 ELSE PERFORM FAIL IX2154.2 +219000 MOVE IX2154.2 +219100 "IX-28 OR IX-41; INCORRECT NUMBER OF RECORDS" TO RE-MARKIX2154.2 +219200 MOVE 200 TO CORRECT-18V0 IX2154.2 +219300 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-18V0. IX2154.2 +219400 PERFORM PRINT-DETAIL. IX2154.2 +219500 GO TO READ-EXIT-F1-O3. IX2154.2 +219600 READ-FAIL-F1-O3. IX2154.2 +219700 MOVE 1 TO FAIL-SW. IX2154.2 +219800 PERFORM FAIL. IX2154.2 +219900 MOVE FDW-RECKEY-11-13 TO COMPUTED-18V0. IX2154.2 +220000 MOVE RECKEY-NUM TO CORRECT-18V0. IX2154.2 +220100 ADD 01 TO REC-CT. IX2154.2 +220200 MOVE "NUM EMBEDDED IN RECKEY" TO RE-MARK. IX2154.2 +220300 PERFORM PRINT-DETAIL. IX2154.2 +220400 READ-EXIT-F1-O3. IX2154.2 +220500 CLOSE IX-FD3. IX2154.2 +220600 START-INIT-GF-19. IX2154.2 +220700 OPEN I-O IX-FD3. IX2154.2 +220800 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +220900 MOVE "START-TEST-GF-19" TO PAR-NAME. IX2154.2 +221000 MOVE "START QUAL REC-KEY" TO FEATURE. IX2154.2 +221100 MOVE "FFGGGGGGGG096" TO IX-FD3-RECKEY-AREA. IX2154.2 +221200 START-TEST-GF-19. IX2154.2 +221300 DELETE IX-FD3 INVALID KEY IX2154.2 +221400 MOVE "IX-21; INVALID KEY " TO COMPUTED-A IX2154.2 +221500 GO TO START-FAIL-GF-19. IX2154.2 +221600 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +221700 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +221800 GO TO START-DELETE-GF-19. IX2154.2 +221900 MOVE "FFGGGGGGGG096" TO IX-FD3-RECKEY-AREA. IX2154.2 +222000 START IX-FD3 KEY IS EQUAL TO IX-FD3-KEY IN IX-FD3-RECKEY-AREAIX2154.2 +222100 INVALID KEY PERFORM PASS IX2154.2 +222200 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +222300 TO RE-MARK IX2154.2 +222400 GO TO START-WRITE-GF-19. IX2154.2 +222500 READ IX-FD3 NEXT RECORD AT END IX2154.2 +222600 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +222700 GO TO START-FAIL-GF-19. IX2154.2 +222800 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +222900 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +223000 START-FAIL-GF-19. IX2154.2 +223100 PERFORM FAIL. IX2154.2 +223200 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +223300 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +223400 GO TO START-WRITE-GF-19. IX2154.2 +223500 START-DELETE-GF-19. IX2154.2 +223600 PERFORM DE-LETE. IX2154.2 +223700 START-WRITE-GF-19. IX2154.2 +223800 PERFORM PRINT-DETAIL. IX2154.2 +223900 START-INIT-GF-20. IX2154.2 +224000 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +224100 MOVE "START-TEST-GF-20" TO PAR-NAME. IX2154.2 +224200 MOVE "CCCCCCCCCC020" TO IX-FD3-RECKEY-AREA. IX2154.2 +224300 START-TEST-GF-20. IX2154.2 +224400 DELETE IX-FD3 INVALID KEY IX2154.2 +224500 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +224600 GO TO START-FAIL-GF-20. IX2154.2 +224700 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +224800 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +224900 GO TO START-DELETE-GF-20. IX2154.2 +225000 MOVE "CCCCCCCCCC020" TO IX-FD3-RECKEY-AREA. IX2154.2 +225100 START IX-FD3 KEY IS EQUAL TO IX-FD3-KEY IX2154.2 +225200 OF IX-FD3-RECKEY-AREA IX2154.2 +225300 INVALID KEY PERFORM PASS IX2154.2 +225400 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +225500 TO RE-MARK IX2154.2 +225600 GO TO START-WRITE-GF-20. IX2154.2 +225700 READ IX-FD3 NEXT RECORD AT END IX2154.2 +225800 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +225900 GO TO START-FAIL-GF-20. IX2154.2 +226000 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +226100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +226200 START-FAIL-GF-20. IX2154.2 +226300 PERFORM FAIL. IX2154.2 +226400 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +226500 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +226600 GO TO START-WRITE-GF-20. IX2154.2 +226700 START-DELETE-GF-20. IX2154.2 +226800 PERFORM DE-LETE. IX2154.2 +226900 START-WRITE-GF-20. IX2154.2 +227000 PERFORM PRINT-DETAIL. IX2154.2 +227100 START-INIT-GF-21. IX2154.2 +227200 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +227300 MOVE "START-TEST-GF-21" TO PAR-NAME. IX2154.2 +227400 MOVE "SSSSSSSSST362" TO IX-FD3-RECKEY-AREA. IX2154.2 +227500 START-TEST-GF-21. IX2154.2 +227600 DELETE IX-FD3 INVALID KEY IX2154.2 +227700 MOVE "INVALID KEY (DELETE)" TO COMPUTED-A IX2154.2 +227800 GO TO START-FAIL-GF-21. IX2154.2 +227900 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +228000 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +228100 GO TO START-DELETE-GF-21. IX2154.2 +228200 MOVE "SSSSSSSSST362" TO IX-FD3-RECKEY-AREA. IX2154.2 +228300 START IX-FD3 KEY IS EQUAL TO IX2154.2 +228400 IX-FD3-KEY IN IX2154.2 +228500 IX-FD3-RECKEY-AREA IX2154.2 +228600 INVALID KEY PERFORM PASS IX2154.2 +228700 MOVE "OK.; INVALID KEY ON START OF DELETED RECORD" IX2154.2 +228800 TO RE-MARK IX2154.2 +228900 GO TO START-WRITE-GF-21. IX2154.2 +229000 READ IX-FD3 NEXT RECORD AT END IX2154.2 +229100 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +229200 GO TO START-FAIL-GF-21. IX2154.2 +229300 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +229400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +229500 START-FAIL-GF-21. IX2154.2 +229600 PERFORM FAIL. IX2154.2 +229700 MOVE "INVALID KEY ON START" TO CORRECT-A. IX2154.2 +229800 MOVE "WRONG RECORD NUMBER FOUND; IX-28 OR IX-36" TO RE-MARK. IX2154.2 +229900 GO TO START-WRITE-GF-21. IX2154.2 +230000 START-DELETE-GF-21. IX2154.2 +230100 PERFORM DE-LETE. IX2154.2 +230200 START-WRITE-GF-21. IX2154.2 +230300 PERFORM PRINT-DETAIL. IX2154.2 +230400 START-INIT-GF-22. IX2154.2 +230500 MOVE "START QUAL ALT-KEY-1" TO FEATURE. IX2154.2 +230600 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +230700 MOVE "START-TEST-GF-22" TO PAR-NAME. IX2154.2 +230800 MOVE "EEEEEEEEFF064" TO IX-FD3-RECKEY-AREA. IX2154.2 +230900 START-TEST-GF-22. IX2154.2 +231000 READ IX-FD3 IX2154.2 +231100 INVALID KEY PERFORM FAIL IX2154.2 +231200 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +231300 TO RE-MARK IX2154.2 +231400 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +231500 GO TO START-FAIL-GF-22. IX2154.2 +231600 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +231700 IF XRECORD-NUMBER (3) NOT EQUAL TO 32 IX2154.2 +231800 MOVE 32 TO RECNO IX2154.2 +231900 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +232000 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +232100 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +232200 GO TO START-FAIL-GF-22. IX2154.2 +232300 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +232400 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +232500 GO TO START-DELETE-GF-22. IX2154.2 +232600 MOVE "EEEEEEEEEE000ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +232700 MOVE "WWWWWWWWWW400ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +232800 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +232900 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +233000 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +233100 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +233200 GO TO START-FAIL-GF-22. IX2154.2 +233300 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +233400 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +233500 GO TO START-FAIL-GF-22. IX2154.2 +233600 MOVE "EEEEEEEEEE000ALTKEY1" TO IX-FD3-ALTKEY1-AREA. IX2154.2 +233700 START IX-FD3 IX2154.2 +233800 KEY IS EQUAL TO IX-FD3-KEY OF IX2154.2 +233900 IX-FD3-ALTKEY1-AREA IX2154.2 +234000 INVALID KEY IX2154.2 +234100 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +234200 TO RE-MARK IX2154.2 +234300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +234400 GO TO START-FAIL-GF-22. IX2154.2 +234500 READ IX-FD3 NEXT RECORD AT END IX2154.2 +234600 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +234700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +234800 GO TO START-FAIL-GF-22. IX2154.2 +234900 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +235000 IF XRECORD-NUMBER (1) EQUAL TO 32 IX2154.2 +235100 PERFORM PASS IX2154.2 +235200 GO TO START-WRITE-GF-22. IX2154.2 +235300 PERFORM FAIL. IX2154.2 +235400 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +235500 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +235600 MOVE "EEEEEEEEEE000ALTKEY1" TO CORRECT-A. IX2154.2 +235700 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +235800 PERFORM PRINT-DETAIL. IX2154.2 +235900 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +236000 TO RE-MARK. IX2154.2 +236100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +236200 START-FAIL-GF-22. IX2154.2 +236300 PERFORM FAIL. IX2154.2 +236400 MOVE 32 TO CORRECT-18V0. IX2154.2 +236500 GO TO START-WRITE-GF-22. IX2154.2 +236600 START-DELETE-GF-22. IX2154.2 +236700 PERFORM DE-LETE. IX2154.2 +236800 START-WRITE-GF-22. IX2154.2 +236900 PERFORM PRINT-DETAIL. IX2154.2 +237000 START-INIT-GF-23. IX2154.2 +237100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +237200 MOVE "START-TEST-GF-23" TO PAR-NAME. IX2154.2 +237300 MOVE "BBBBBBBCCC006" TO IX-FD3-RECKEY-AREA. IX2154.2 +237400 START-TEST-GF-23. IX2154.2 +237500 READ IX-FD3 IX2154.2 +237600 INVALID KEY IX2154.2 +237700 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +237800 TO RE-MARK IX2154.2 +237900 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +238000 GO TO START-FAIL-GF-23. IX2154.2 +238100 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +238200 IF XRECORD-NUMBER (3) NOT EQUAL TO 3 IX2154.2 +238300 MOVE 3 TO RECNO IX2154.2 +238400 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +238500 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +238600 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +238700 GO TO START-FAIL-GF-23. IX2154.2 +238800 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +238900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +239000 GO TO START-DELETE-GF-23. IX2154.2 +239100 MOVE "AAAAAAAAAA400ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +239200 MOVE "ZZZZZZZZZZ002ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +239300 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +239400 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +239500 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +239600 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +239700 GO TO START-FAIL-GF-23. IX2154.2 +239800 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +239900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +240000 GO TO START-FAIL-GF-23. IX2154.2 +240100 MOVE "AAAAAAAAAA400ALTKEY1" TO IX-FD3-ALTKEY1-AREA. IX2154.2 +240200 START IX-FD3 IX2154.2 +240300 KEY IS EQUAL TO IX2154.2 +240400 IX-FD3-KEY IX2154.2 +240500 IN IX-FD3-ALTKEY1-AREA IX2154.2 +240600 INVALID KEY IX2154.2 +240700 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +240800 TO RE-MARK IX2154.2 +240900 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +241000 GO TO START-FAIL-GF-23. IX2154.2 +241100 READ IX-FD3 NEXT RECORD AT END IX2154.2 +241200 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +241300 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +241400 GO TO START-FAIL-GF-23. IX2154.2 +241500 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +241600 IF XRECORD-NUMBER (1) EQUAL TO 3 IX2154.2 +241700 PERFORM PASS IX2154.2 +241800 GO TO START-WRITE-GF-23. IX2154.2 +241900 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +242000 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +242100 MOVE "AAAAAAAAAA400ALTKEY1" TO CORRECT-A. IX2154.2 +242200 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +242300 PERFORM PRINT-DETAIL. IX2154.2 +242400 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +242500 TO RE-MARK. IX2154.2 +242600 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +242700 START-FAIL-GF-23. IX2154.2 +242800 PERFORM FAIL. IX2154.2 +242900 MOVE 3 TO CORRECT-18V0. IX2154.2 +243000 GO TO START-WRITE-GF-23. IX2154.2 +243100 START-DELETE-GF-23. IX2154.2 +243200 PERFORM DE-LETE. IX2154.2 +243300 START-WRITE-GF-23. IX2154.2 +243400 PERFORM PRINT-DETAIL. IX2154.2 +243500 START-INIT-GF-24. IX2154.2 +243600 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +243700 MOVE "START-TEST-GF-24" TO PAR-NAME. IX2154.2 +243800 MOVE "SSSSSSSSSS360" TO IX-FD3-RECKEY-AREA. IX2154.2 +243900 START-TEST-GF-24. IX2154.2 +244000 READ IX-FD3 IX2154.2 +244100 INVALID KEY IX2154.2 +244200 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +244300 TO RE-MARK IX2154.2 +244400 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +244500 GO TO START-FAIL-GF-24. IX2154.2 +244600 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +244700 IF XRECORD-NUMBER (3) NOT EQUAL TO 180 IX2154.2 +244800 MOVE 55 TO RECNO IX2154.2 +244900 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +245000 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +245100 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +245200 GO TO START-FAIL-GF-24. IX2154.2 +245300 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +245400 GO TO START-DELETE-GF-24. IX2154.2 +245500 MOVE "AAGGGGGGGG100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +245600 MOVE "GGGGGGGGGG100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +245700 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +245800 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +245900 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +246000 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +246100 GO TO START-FAIL-GF-24. IX2154.2 +246200 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +246300 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +246400 GO TO START-FAIL-GF-24. IX2154.2 +246500 MOVE "AAGGGGGGGG100ALTKEY1" TO IX-FD3-ALTKEY1-AREA. IX2154.2 +246600 START IX-FD3 IX2154.2 +246700 KEY IS EQUAL TO IX2154.2 +246800 IX-FD3-KEY IX2154.2 +246900 OF IX-FD3-ALTKEY1-AREA IX2154.2 +247000 INVALID KEY PERFORM FAIL IX2154.2 +247100 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +247200 TO RE-MARK IX2154.2 +247300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +247400 GO TO START-FAIL-GF-24. IX2154.2 +247500 READ IX-FD3 NEXT RECORD AT END IX2154.2 +247600 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +247700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +247800 GO TO START-FAIL-GF-24. IX2154.2 +247900 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +248000 IF XRECORD-NUMBER (1) EQUAL TO 180 IX2154.2 +248100 PERFORM PASS IX2154.2 +248200 GO TO START-WRITE-GF-24. IX2154.2 +248300 MOVE ALTERNATE-KEY1 (1) TO WRK-FDW-ALTKEY1. IX2154.2 +248400 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +248500 MOVE "AAGGGGGGGG100ALTKEY1" TO CORRECT-A. IX2154.2 +248600 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY1" TO RE-MARK. IX2154.2 +248700 PERFORM PRINT-DETAIL. IX2154.2 +248800 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY1"IX2154.2 +248900 TO RE-MARK. IX2154.2 +249000 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +249100 START-FAIL-GF-24. IX2154.2 +249200 PERFORM FAIL. IX2154.2 +249300 MOVE 180 TO CORRECT-18V0. IX2154.2 +249400 GO TO START-WRITE-GF-24. IX2154.2 +249500 START-DELETE-GF-24. IX2154.2 +249600 PERFORM DE-LETE. IX2154.2 +249700 START-WRITE-GF-24. IX2154.2 +249800 PERFORM PRINT-DETAIL. IX2154.2 +249900 START-INIT-GF-25. IX2154.2 +250000 MOVE "START QUAL ALT-KEY-2" TO FEATURE. IX2154.2 +250100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +250200 MOVE "START-TEST-GF-25" TO PAR-NAME. IX2154.2 +250300 MOVE "CCCCCDDDDD030" TO IX-FD3-RECKEY-AREA. IX2154.2 +250400 START-TEST-GF-25. IX2154.2 +250500 READ IX-FD3 IX2154.2 +250600 INVALID KEY IX2154.2 +250700 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +250800 TO RE-MARK IX2154.2 +250900 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +251000 GO TO START-FAIL-GF-25. IX2154.2 +251100 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +251200 IF XRECORD-NUMBER (3) NOT EQUAL TO 15 IX2154.2 +251300 MOVE 15 TO RECNO IX2154.2 +251400 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +251500 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +251600 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +251700 GO TO START-FAIL-GF-25. IX2154.2 +251800 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +251900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +252000 GO TO START-DELETE-GF-25. IX2154.2 +252100 MOVE "BCBCBCBCBC200ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +252200 MOVE "CBCBCBCBCB100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +252300 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +252400 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +252500 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +252600 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +252700 GO TO START-FAIL-GF-25. IX2154.2 +252800 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +252900 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +253000 GO TO START-FAIL-GF-25. IX2154.2 +253100 MOVE "CBCBCBCBCB100ALTKEY2" TO IX-FD3-ALTKEY2-AREA. IX2154.2 +253200 START IX-FD3 IX2154.2 +253300 KEY IS EQUAL TO IX2154.2 +253400 IX-FD3-KEY IX2154.2 +253500 IN IX2154.2 +253600 IX-FD3-ALTKEY2-AREA IX2154.2 +253700 INVALID KEY IX2154.2 +253800 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +253900 TO RE-MARK IX2154.2 +254000 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +254100 GO TO START-FAIL-GF-25. IX2154.2 +254200 READ IX-FD3 NEXT RECORD AT END IX2154.2 +254300 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +254400 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +254500 GO TO START-FAIL-GF-25. IX2154.2 +254600 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +254700 IF XRECORD-NUMBER (1) EQUAL TO 15 IX2154.2 +254800 PERFORM PASS IX2154.2 +254900 GO TO START-WRITE-GF-25. IX2154.2 +255000 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +255100 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +255200 MOVE "CBCBCBCBCB100ALTKEY2" TO CORRECT-A. IX2154.2 +255300 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +255400 PERFORM PRINT-DETAIL. IX2154.2 +255500 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +255600 TO RE-MARK. IX2154.2 +255700 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +255800 START-FAIL-GF-25. IX2154.2 +255900 PERFORM FAIL. IX2154.2 +256000 MOVE 15 TO CORRECT-18V0. IX2154.2 +256100 GO TO START-WRITE-GF-25. IX2154.2 +256200 START-DELETE-GF-25. IX2154.2 +256300 PERFORM DE-LETE. IX2154.2 +256400 START-WRITE-GF-25. IX2154.2 +256500 PERFORM PRINT-DETAIL. IX2154.2 +256600 START-INIT-GF-26. IX2154.2 +256700 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +256800 MOVE "START-TEST-GF-26" TO PAR-NAME. IX2154.2 +256900 MOVE "TTTTTTTTTT380" TO IX-FD3-RECKEY-AREA. IX2154.2 +257000 START-TEST-GF-26. IX2154.2 +257100 READ IX-FD3 IX2154.2 +257200 INVALID KEY IX2154.2 +257300 MOVE "IX-28;F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +257400 TO RE-MARK IX2154.2 +257500 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +257600 GO TO START-FAIL-GF-26. IX2154.2 +257700 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +257800 IF XRECORD-NUMBER (3) NOT EQUAL TO 190 IX2154.2 +257900 MOVE 65 TO RECNO IX2154.2 +258000 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +258100 MOVE "IX-28;F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +258200 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +258300 GO TO START-FAIL-GF-26. IX2154.2 +258400 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +258500 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +258600 GO TO START-DELETE-GF-26. IX2154.2 +258700 MOVE "DCDCDCDCDC100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +258800 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +258900 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +259000 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +259100 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +259200 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +259300 GO TO START-FAIL-GF-26. IX2154.2 +259400 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +259500 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +259600 GO TO START-FAIL-GF-26. IX2154.2 +259700 MOVE "DCDCDCDCDC100ALTKEY2" TO IX-FD3-ALTKEY2-AREA. IX2154.2 +259800 START IX-FD3 IX2154.2 +259900 KEY IS EQUAL TO IX2154.2 +260000 IX-FD3-KEY OF IX-FD3-ALTKEY2-AREA IX2154.2 +260100 INVALID KEY IX2154.2 +260200 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +260300 TO RE-MARK IX2154.2 +260400 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +260500 GO TO START-FAIL-GF-26. IX2154.2 +260600 READ IX-FD3 NEXT RECORD AT END IX2154.2 +260700 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +260800 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +260900 GO TO START-FAIL-GF-26. IX2154.2 +261000 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +261100 IF XRECORD-NUMBER (1) EQUAL TO 190 IX2154.2 +261200 PERFORM PASS IX2154.2 +261300 GO TO START-WRITE-GF-26. IX2154.2 +261400 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +261500 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A. IX2154.2 +261600 MOVE "DCDCDCDCDC100ALTKEY2" TO CORRECT-A. IX2154.2 +261700 MOVE "IX-28 OR IX-36; INCORR ALTERN RECORD KEY2" TO RE-MARK. IX2154.2 +261800 PERFORM PRINT-DETAIL. IX2154.2 +261900 MOVE "WRONG RECORD NUMBER FOUND ON READ ALTERNATE REC KEY2"IX2154.2 +262000 TO RE-MARK. IX2154.2 +262100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +262200 START-FAIL-GF-26. IX2154.2 +262300 PERFORM FAIL. IX2154.2 +262400 MOVE 190 TO CORRECT-18V0. IX2154.2 +262500 GO TO START-WRITE-GF-26. IX2154.2 +262600 START-DELETE-GF-26. IX2154.2 +262700 PERFORM DE-LETE. IX2154.2 +262800 START-WRITE-GF-26. IX2154.2 +262900 PERFORM PRINT-DETAIL. IX2154.2 +263000 START-INIT-GF-27. IX2154.2 +263100 MOVE "----------" TO DUMMY-RECORD. PERFORM BLANK-LINE-PRINT. IX2154.2 +263200 MOVE "START-TEST-GF-27" TO PAR-NAME. IX2154.2 +263300 MOVE "CCCCCCCCDD024" TO IX-FD3-RECKEY-AREA. IX2154.2 +263400 START-TEST-GF-27. IX2154.2 +263500 READ IX-FD3 IX2154.2 +263600 INVALID KEY IX2154.2 +263700 MOVE "IX-28,F2 INVALID KEY PATH TAKEN ON INITIAL READ" IX2154.2 +263800 TO RE-MARK IX2154.2 +263900 MOVE "INVALID KEY ON READ" TO COMPUTED-A IX2154.2 +264000 MOVE 12 TO CORRECT-18V0 IX2154.2 +264100 GO TO START-FAIL-GF-27. IX2154.2 +264200 MOVE IX-FD3-240 TO FILE-RECORD-INFO (3). IX2154.2 +264300 IF XRECORD-NUMBER (3) NOT EQUAL TO 12 IX2154.2 +264400 MOVE 12 TO RECNO IX2154.2 +264500 PERFORM DISPLAY-RECORD-KEYS IX2154.2 +264600 MOVE "IX-28,F2 WRONG RECORD FOUND ON INITIAL READ" TO RE-MARKIX2154.2 +264700 MOVE XRECORD-NUMBER (3) TO COMPUTED-18V0 IX2154.2 +264800 MOVE 4 TO CORRECT-18V0 IX2154.2 +264900 GO TO START-FAIL-GF-27. IX2154.2 +265000 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +265100 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +265200 GO TO START-DELETE-GF-27. IX2154.2 +265300 MOVE "CDCDCDCDCD100ALTKEY1" TO ALTERNATE-KEY1 (3). IX2154.2 +265400 MOVE "DCDCDCDCDC100ALTKEY2" TO ALTERNATE-KEY2 (3). IX2154.2 +265500 MOVE FILE-RECORD-INFO (3) TO IX-FD3R1-F-G-242. IX2154.2 +265600 REWRITE IX-FD3R1-F-G-242 INVALID KEY IX2154.2 +265700 MOVE "IX-33; INVALID KEY PATH TAKEN ON REWRITE" TO RE-MARK IX2154.2 +265800 MOVE "INVALID KEY; REWRITE" TO COMPUTED-A IX2154.2 +265900 MOVE 12 TO CORRECT-18V0 IX2154.2 +266000 GO TO START-FAIL-GF-27. IX2154.2 +266100 PERFORM START-INIT-FD3 THRU START-INIT-FD3-EXIT. IX2154.2 +266200 IF INIT-FLAG NOT EQUAL ZERO IX2154.2 +266300 GO TO START-FAIL-GF-27. IX2154.2 +266400 MOVE "DCDCDCDCDC100ALTKEY2" TO IX-FD3-ALTKEY2-AREA. IX2154.2 +266500 START IX-FD3 IX2154.2 +266600 KEY IS EQUAL TO IX-FD3-KEY IX2154.2 +266700 IN IX2154.2 +266800 IX-FD3-ALTKEY2-AREA IX2154.2 +266900 INVALID KEY IX2154.2 +267000 MOVE "IX-36; INVALID KEY ON START OF REWRITTEN RECORD" IX2154.2 +267100 TO RE-MARK IX2154.2 +267200 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +267300 MOVE 190 TO CORRECT-18V0 IX2154.2 +267400 GO TO START-FAIL-GF-27. IX2154.2 +267500 READ IX-FD3 NEXT RECORD AT END IX2154.2 +267600 MOVE "IX-28;F1 AT END ON READ AFTER START" TO RE-MARK IX2154.2 +267700 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +267800 MOVE 190 TO CORRECT-18V0 IX2154.2 +267900 GO TO START-FAIL-GF-27. IX2154.2 +268000 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +268100 IF XRECORD-NUMBER (1) NOT EQUAL TO 190 IX2154.2 +268200 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2 IX2154.2 +268300 MOVE FDW-ALTKEY2-1-20 TO COMPUTED-A IX2154.2 +268400 MOVE "DCDCDCDCDC100" TO CORRECT-A IX2154.2 +268500 MOVE IX2154.2 +268600 "IX-28 OR IX-36; INCORR KEY FOUND ON FIRST READ DUPL KEYS" IX2154.2 +268700 TO RE-MARK IX2154.2 +268800 PERFORM PRINT-DETAIL IX2154.2 +268900 MOVE "WRONG RECORD NUMBER FOUND ON FIRST READ DUPLICATE KEYS"IX2154.2 +269000 TO RE-MARK IX2154.2 +269100 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 IX2154.2 +269200 MOVE 190 TO CORRECT-18V0 IX2154.2 +269300 GO TO START-FAIL-GF-27. IX2154.2 +269400 READ IX-FD3 NEXT RECORD AT END IX2154.2 +269500 MOVE "IX-28;F1 AT END ON READ AFTER FIRST READ" TO RE-MARK IX2154.2 +269600 MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +269700 MOVE 12 TO CORRECT-18V0 IX2154.2 +269800 GO TO START-FAIL-GF-27. IX2154.2 +269900 MOVE IX-FD3-240 TO FILE-RECORD-INFO (1). IX2154.2 +270000 IF XRECORD-NUMBER (1) EQUAL TO 12 IX2154.2 +270100 PERFORM PASS IX2154.2 +270200 GO TO START-WRITE-GF-27. IX2154.2 +270300 PERFORM FAIL. IX2154.2 +270400 MOVE ALTERNATE-KEY2 (1) TO WRK-FDW-ALTKEY2. IX2154.2 +270500 MOVE FDW-ALTKEY1-1-20 TO COMPUTED-A. IX2154.2 +270600 MOVE IX2154.2 +270700 "IX-28 OR IX-36; INCORR KEY FOUND ON SECOND READ DUPL KEYS" IX2154.2 +270800 TO RE-MARK. IX2154.2 +270900 PERFORM PRINT-DETAIL. IX2154.2 +271000 MOVE "WRONG REC NUMBER FOUND ON SECOND READ DUPLICATE KEYS" IX2154.2 +271100 TO RE-MARK. IX2154.2 +271200 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0. IX2154.2 +271300 MOVE 12 TO CORRECT-18V0. IX2154.2 +271400 START-FAIL-GF-27. IX2154.2 +271500 PERFORM FAIL. IX2154.2 +271600 GO TO START-WRITE-GF-27. IX2154.2 +271700 START-DELETE-GF-27. IX2154.2 +271800 PERFORM DE-LETE. IX2154.2 +271900 START-WRITE-GF-27. IX2154.2 +272000 PERFORM PRINT-DETAIL. IX2154.2 +272100 START-TERM-GF. IX2154.2 +272200 CLOSE IX-FD3. IX2154.2 +272300 START-TEST-FINISH. IX2154.2 +272400 GO TO START-TEST-COMPLETE. IX2154.2 +272500 START-INIT-FD1. IX2154.2 +272600 MOVE SPACE TO FILE-RECORD-INFO (1). IX2154.2 +272700 MOVE ZERO TO INIT-FLAG. IX2154.2 +272800 MOVE 9999 TO XRECORD-NUMBER (2). IX2154.2 +272900 MOVE SPACE TO IX-FD1R1-F-G-240. IX2154.2 +273000 MOVE "GGGGGGGGGG200" TO FDW-RECKEY-1-13. IX2154.2 +273100 MOVE WRK-FDW-RECKEY TO IX-REC-KEY-AREA. IX2154.2 +273200 START IX-FD1 KEY IS EQUAL TO IX-FD1-KEY INVALID KEY IX2154.2 +273300 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +273400 GO TO START-INIT-FD1-ERROR. IX2154.2 +273500 READ IX-FD1 NEXT RECORD INTO FILE-RECORD-INFO (2) IX2154.2 +273600 AT END MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +273700 GO TO START-INIT-FD1-ERROR. IX2154.2 +273800 IF XRECORD-NUMBER (2) EQUAL TO 100 IX2154.2 +273900 GO TO START-INIT-FD1-EXIT. IX2154.2 +274000 MOVE XRECORD-KEY (2) TO WRK-FDW-RECKEY. IX2154.2 +274100 MOVE FDW-RECKEY-1-13 TO COMPUTED-A. IX2154.2 +274200 START-INIT-FD1-ERROR. IX2154.2 +274300 MOVE 1 TO INIT-FLAG. IX2154.2 +274400 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK. IX2154.2 +274500 MOVE "GGGGGGGGGG200" TO CORRECT-A. IX2154.2 +274600 PERFORM PRINT-DETAIL. IX2154.2 +274700 START-INIT-FD1-EXIT. IX2154.2 +274800 EXIT. IX2154.2 +274900 START-INIT-FD2. IX2154.2 +275000 MOVE SPACE TO FILE-RECORD-INFO (1). IX2154.2 +275100 MOVE ZERO TO INIT-FLAG. IX2154.2 +275200 MOVE 9999 TO XRECORD-NUMBER (2). IX2154.2 +275300 MOVE SPACE TO IX-FD2R1-F-G-241. IX2154.2 +275400 MOVE "GGGGGGGGGG200" TO IX-FD2-KEY. IX2154.2 +275500 START IX-FD2 KEY IS EQUAL TO IX-FD2-KEY INVALID KEY IX2154.2 +275600 MOVE "INVALID KEY ON START" TO COMPUTED-A IX2154.2 +275700 GO TO START-INIT-FD2-ERROR. IX2154.2 +275800 READ IX-FD2 NEXT RECORD INTO FILE-RECORD-INFO (2) IX2154.2 +275900 AT END MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +276000 GO TO START-INIT-FD2-ERROR. IX2154.2 +276100 IF XRECORD-NUMBER (2) EQUAL TO 100 IX2154.2 +276200 GO TO START-INIT-FD2-EXIT. IX2154.2 +276300 MOVE XRECORD-KEY (2) TO WRK-FDW-RECKEY. IX2154.2 +276400 MOVE FDW-RECKEY-1-13 TO COMPUTED-A. IX2154.2 +276500 START-INIT-FD2-ERROR. IX2154.2 +276600 MOVE 1 TO INIT-FLAG. IX2154.2 +276700 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK. IX2154.2 +276800 MOVE "GGGGGGGGGG200" TO CORRECT-A. IX2154.2 +276900 PERFORM PRINT-DETAIL. IX2154.2 +277000 START-INIT-FD2-EXIT. IX2154.2 +277100 EXIT. IX2154.2 +277200 START-INIT-FD3. IX2154.2 +277300 MOVE SPACE TO FILE-RECORD-INFO (1). IX2154.2 +277400 MOVE ZERO TO INIT-FLAG. IX2154.2 +277500 MOVE 9999 TO XRECORD-NUMBER (2). IX2154.2 +277600 MOVE SPACE TO IX-FD3R1-F-G-242. IX2154.2 +277700 MOVE "GGGGGGGGGG200" TO IX-FD3-RECKEY-AREA. IX2154.2 +277800 START IX-FD3 IX2154.2 +277900 INVALID KEY MOVE "INVALID KEY ON START" TO COMPUTED-AIX2154.2 +278000 GO TO START-INIT-FD3-ERROR. IX2154.2 +278100 READ IX-FD3 NEXT RECORD INTO FILE-RECORD-INFO (2) IX2154.2 +278200 AT END MOVE "AT END ON READ" TO COMPUTED-A IX2154.2 +278300 GO TO START-INIT-FD3-ERROR. IX2154.2 +278400 IF XRECORD-NUMBER (2) EQUAL TO 100 IX2154.2 +278500 GO TO START-INIT-FD3-EXIT. IX2154.2 +278600 MOVE XRECORD-KEY (2) TO WRK-FDW-RECKEY. IX2154.2 +278700 MOVE FDW-RECKEY-1-13 TO COMPUTED-A. IX2154.2 +278800 START-INIT-FD3-ERROR. IX2154.2 +278900 MOVE 1 TO INIT-FLAG. IX2154.2 +279000 MOVE "TEST IMPROPERLY INITIALIZED" TO RE-MARK. IX2154.2 +279100 MOVE "GGGGGGGGGG200" TO CORRECT-A. IX2154.2 +279200 PERFORM PRINT-DETAIL. IX2154.2 +279300 START-INIT-FD3-EXIT. IX2154.2 +279400 EXIT. IX2154.2 +279500 DISPLAY-RECORD-KEYS. IX2154.2 +279600 MOVE XRECORD-KEY (3) TO WRK-FDW-RECKEY. IX2154.2 +279700 MOVE FDW-RECKEY-1-13 TO COMPUTED-A. IX2154.2 +279800 MOVE RECKEY-VALUE (RECNO) TO CORRECT-A. IX2154.2 +279900 MOVE "RECORD KEY VALUES" TO RE-MARK. IX2154.2 +280000 PERFORM PRINT-DETAIL. IX2154.2 +280100 START-TEST-COMPLETE. IX2154.2 +280200 EXIT. IX2154.2 +280300 CCVS-EXIT SECTION. IX2154.2 +280400 CCVS-999999. IX2154.2 +280500 GO TO CLOSE-FILES. IX2154.2 diff --git a/tests/cobol85/IX/IX216A.CBL b/tests/cobol85/IX/IX216A.CBL new file mode 100755 index 00000000..64f69668 --- /dev/null +++ b/tests/cobol85/IX/IX216A.CBL @@ -0,0 +1,792 @@ +000100 IDENTIFICATION DIVISION. IX2164.2 +000200 PROGRAM-ID. IX2164.2 +000300 IX216A. IX2164.2 +000400**************************************************************** IX2164.2 +000500* * IX2164.2 +000600* VALIDATION FOR:- * IX2164.2 +000700* * IX2164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2164.2 +000900* * IX2164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2164.2 +001100* * IX2164.2 +001200**************************************************************** IX2164.2 +001300* IX2164.2 +001400* NEW TESTS: IX2164.2 +001500* IX2164.2 +001600* SELECT OPTIONAL ... WITH IX2164.2 +001700* -------- IX2164.2 +001800* OPEN EXTEND ... (FOR A NON-EXISTING FILE) IX2164.2 +001900* ------ ------------ IX2164.2 +002000* THEN THE FILE IS CLOSED AFTER WRITING 300 RECORDS IX2164.2 +002100* AND OPENED WITH: IX2164.2 +002200* IX2164.2 +002300* OPEN EXTEND ... (FOR AN EXISTING FILE) IX2164.2 +002400* ------ -------- IX2164.2 +002500* AND CLOSE IX-FS2 LOCK. IX2164.2 +002600* ---- IX2164.2 +002700* IX2164.2 +002800* ALL OTHER TESTS ARE IDENTICAL WITH THE TESTS IN IX104. IX2164.2 +002900* IX2164.2 +003000* IX2164.2 +003100* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND SEMANTIC IX2164.2 +003200* ACTIONS ASSOCIATED WITH THE FOLLOWING ELEMENTS: IX2164.2 +003300* IX2164.2 +003400* (1) FILE STATUS IX2164.2 +003500* (2) USE AFTER EXCEPTION USING FILE-NAME IX2164.2 +003600* (3) READ IX2164.2 +003700* (4) WRITE IX2164.2 +003800* (5) REWRITE IX2164.2 +003900* (6) RECORD KEY IX2164.2 +004000* (7) ACCESS IX2164.2 +004100* IX2164.2 +004200* THIS PROGRAM CREATES AN INDEXED FILE SEQUENTIALLY (ACCESS IX2164.2 +004300* MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RECORDS OF THE IX2164.2 +004400* FILE. THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR IX2164.2 +004500* ACCURACY FOR EACH OPEN, CLOSE, READ AND REWRITE STATEMENT IX2164.2 +004600* USED. THE READ, WRITE AND REWRITE STATEMENTS ARE USED IX2164.2 +004700* WITHOUT THE APPROPRIATE AT END OR INVALID KEY PHRASES. THE IX2164.2 +004800* OMISSION OF THESE PHRASES ARE PERMITTED IF AN APPLICABLE USE IX2164.2 +004900* PROCEDURE HAS BEEN SPECIFIED. IX2164.2 +005000* IX2164.2 +005100* IX2164.2 +005200* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2164.2 +005300* IX2164.2 +005400* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2164.2 +005500* CLAUSE FOR DATA FILE IX-FD2 IX2164.2 +005600* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSIGN TO IX2164.2 +005700* CLAUSE FOR INDEX FILE IX-FD2 IX2164.2 +005800* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2164.2 +005900* X-62 IMPLEMENTOR-NAME FOR RAW-DATA (OPTIONAL) IX2164.2 +006000* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2164.2 +006100* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2164.2 +006200* IX2164.2 +006300* NOTE: X-CARDS 45 AND 62 ARE OPTIONAL IX2164.2 +006400* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2164.2 +006500* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2164.2 +006600* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2164.2 +006700* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2164.2 +006800* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2164.2 +006900* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2164.2 +007000* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2164.2 +007100* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2164.2 +007200* THEY ARE AS FOLLOWS IX2164.2 +007300* IX2164.2 +007400* J SELECTS X-CARD 45 IX2164.2 +007500* P SELECTS X-CARD 62 IX2164.2 +007600* IX2164.2 +007700****************************************************** IX2164.2 +007800 ENVIRONMENT DIVISION. IX2164.2 +007900 CONFIGURATION SECTION. IX2164.2 +008000 SOURCE-COMPUTER. IX2164.2 +008100 Linux. IX2164.2 +008200 OBJECT-COMPUTER. IX2164.2 +008300 Linux. IX2164.2 +008400 INPUT-OUTPUT SECTION. IX2164.2 +008500 FILE-CONTROL. IX2164.2 +008600*P SELECT RAW-DATA ASSIGN TO IX2164.2 +008700*P "XXXXX062" IX2164.2 +008800*P ORGANIZATION IS INDEXED IX2164.2 +008900*P ACCESS MODE IS RANDOM IX2164.2 +009000*P RECORD KEY IS RAW-DATA-KEY. IX2164.2 +009100 SELECT PRINT-FILE ASSIGN TO IX2164.2 +009200 "report.log". IX2164.2 +009300 SELECT OPTIONAL IX-FS2 ASSIGN IX2164.2 +009400 "XXXXX025" IX2164.2 +009500*J **** X-CARD UNDEFINED **** IX2164.2 +009600 ORGANIZATION IS INDEXED IX2164.2 +009700 ACCESS SEQUENTIAL IX2164.2 +009800 FILE STATUS IS IX-FS2-STATUS IX2164.2 +009900 RECORD IX-FS2-KEY. IX2164.2 +010000 DATA DIVISION. IX2164.2 +010100 FILE SECTION. IX2164.2 +010200*P IX2164.2 +010300*PD RAW-DATA. IX2164.2 +010400*P IX2164.2 +010500*P1 RAW-DATA-SATZ. IX2164.2 +010600*P 05 RAW-DATA-KEY PIC X(6). IX2164.2 +010700*P 05 C-DATE PIC 9(6). IX2164.2 +010800*P 05 C-TIME PIC 9(8). IX2164.2 +010900*P 05 C-NO-OF-TESTS PIC 99. IX2164.2 +011000*P 05 C-OK PIC 999. IX2164.2 +011100*P 05 C-ALL PIC 999. IX2164.2 +011200*P 05 C-FAIL PIC 999. IX2164.2 +011300*P 05 C-DELETED PIC 999. IX2164.2 +011400*P 05 C-INSPECT PIC 999. IX2164.2 +011500*P 05 C-NOTE PIC X(13). IX2164.2 +011600*P 05 C-INDENT PIC X. IX2164.2 +011700*P 05 C-ABORT PIC X(8). IX2164.2 +011800 FD PRINT-FILE. IX2164.2 +011900 01 PRINT-REC PICTURE X(120). IX2164.2 +012000 01 DUMMY-RECORD PICTURE X(120). IX2164.2 +012100 FD IX-FS2 IX2164.2 +012200*C LABEL RECORDS ARE STANDARD IX2164.2 +012300*C DATA RECORDS IX-FS2R1-F-G-240 IX2164.2 +012400 BLOCK CONTAINS 480 IX2164.2 +012500 RECORD CONTAINS 240 CHARACTERS. IX2164.2 +012600 01 IX-FS2R1-F-G-240. IX2164.2 +012700 05 IX-FS2-REC-120 PIC X(120). IX2164.2 +012800 05 IX-FS2-REC-120-240. IX2164.2 +012900 10 FILLER PICTURE X(8). IX2164.2 +013000 10 IX-FS2-KEY PIC X(29). IX2164.2 +013100 10 FILLER PIC X(83). IX2164.2 +013200 WORKING-STORAGE SECTION. IX2164.2 +013300 01 GRP-0101. IX2164.2 +013400 02 FILLER PIC X(10) VALUE "ABCD921XYZ". IX2164.2 +013500 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2164.2 +013600 02 FILLER PIC X(10) VALUE "Z2F()$+-AB". IX2164.2 +013700 01 GRP-0001. IX2164.2 +013800 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +013900 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014000 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014100 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014200 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014300 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014400 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. IX2164.2 +014500 05 IX-FS2-STATUS PIC XX VALUE SPACE. IX2164.2 +014600 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. IX2164.2 +014700 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. IX2164.2 +014800 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. IX2164.2 +014900 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. IX2164.2 +015000 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. IX2164.2 +015100 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. IX2164.2 +015200 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. IX2164.2 +015300 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. IX2164.2 +015400 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. IX2164.2 +015500 01 DUMMY-WRK-REC. IX2164.2 +015600 02 DUMMY-WRK1 PIC X(120). IX2164.2 +015700 02 DUMMY-WRK2 REDEFINES DUMMY-WRK1. IX2164.2 +015800 03 FILLER PIC X(5). IX2164.2 +015900 03 DUMMY-WRK-INDENT-5 PIC X(115). IX2164.2 +016000 01 FILE-RECORD-INFORMATION-REC. IX2164.2 +016100 03 FILE-RECORD-INFO-SKELETON. IX2164.2 +016200 05 FILLER PICTURE X(48) VALUE IX2164.2 +016300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2164.2 +016400 05 FILLER PICTURE X(46) VALUE IX2164.2 +016500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2164.2 +016600 05 FILLER PICTURE X(26) VALUE IX2164.2 +016700 ",LFIL=000000,ORG= ,LBLR= ". IX2164.2 +016800 05 FILLER PICTURE X(37) VALUE IX2164.2 +016900 ",RECKEY= ". IX2164.2 +017000 05 FILLER PICTURE X(38) VALUE IX2164.2 +017100 ",ALTKEY1= ". IX2164.2 +017200 05 FILLER PICTURE X(38) VALUE IX2164.2 +017300 ",ALTKEY2= ". IX2164.2 +017400 05 FILLER PICTURE X(7) VALUE SPACE.IX2164.2 +017500 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2164.2 +017600 05 FILE-RECORD-INFO-P1-120. IX2164.2 +017700 07 FILLER PIC X(5). IX2164.2 +017800 07 XFILE-NAME PIC X(6). IX2164.2 +017900 07 FILLER PIC X(8). IX2164.2 +018000 07 XRECORD-NAME PIC X(6). IX2164.2 +018100 07 FILLER PIC X(1). IX2164.2 +018200 07 REELUNIT-NUMBER PIC 9(1). IX2164.2 +018300 07 FILLER PIC X(7). IX2164.2 +018400 07 XRECORD-NUMBER PIC 9(6). IX2164.2 +018500 07 FILLER PIC X(6). IX2164.2 +018600 07 UPDATE-NUMBER PIC 9(2). IX2164.2 +018700 07 FILLER PIC X(5). IX2164.2 +018800 07 ODO-NUMBER PIC 9(4). IX2164.2 +018900 07 FILLER PIC X(5). IX2164.2 +019000 07 XPROGRAM-NAME PIC X(5). IX2164.2 +019100 07 FILLER PIC X(7). IX2164.2 +019200 07 XRECORD-LENGTH PIC 9(6). IX2164.2 +019300 07 FILLER PIC X(7). IX2164.2 +019400 07 CHARS-OR-RECORDS PIC X(2). IX2164.2 +019500 07 FILLER PIC X(1). IX2164.2 +019600 07 XBLOCK-SIZE PIC 9(4). IX2164.2 +019700 07 FILLER PIC X(6). IX2164.2 +019800 07 RECORDS-IN-FILE PIC 9(6). IX2164.2 +019900 07 FILLER PIC X(5). IX2164.2 +020000 07 XFILE-ORGANIZATION PIC X(2). IX2164.2 +020100 07 FILLER PIC X(6). IX2164.2 +020200 07 XLABEL-TYPE PIC X(1). IX2164.2 +020300 05 FILE-RECORD-INFO-P121-240. IX2164.2 +020400 07 FILLER PIC X(8). IX2164.2 +020500 07 XRECORD-KEY PIC X(29). IX2164.2 +020600 07 FILLER PIC X(9). IX2164.2 +020700 07 ALTERNATE-KEY1 PIC X(29). IX2164.2 +020800 07 FILLER PIC X(9). IX2164.2 +020900 07 ALTERNATE-KEY2 PIC X(29). IX2164.2 +021000 07 FILLER PIC X(7). IX2164.2 +021100 01 TEST-RESULTS. IX2164.2 +021200 02 FILLER PIC X VALUE SPACE. IX2164.2 +021300 02 FEATURE PIC X(20) VALUE SPACE. IX2164.2 +021400 02 FILLER PIC X VALUE SPACE. IX2164.2 +021500 02 P-OR-F PIC X(5) VALUE SPACE. IX2164.2 +021600 02 FILLER PIC X VALUE SPACE. IX2164.2 +021700 02 PAR-NAME. IX2164.2 +021800 03 FILLER PIC X(19) VALUE SPACE. IX2164.2 +021900 03 PARDOT-X PIC X VALUE SPACE. IX2164.2 +022000 03 DOTVALUE PIC 99 VALUE ZERO. IX2164.2 +022100 02 FILLER PIC X(8) VALUE SPACE. IX2164.2 +022200 02 RE-MARK PIC X(61). IX2164.2 +022300 01 TEST-COMPUTED. IX2164.2 +022400 02 FILLER PIC X(30) VALUE SPACE. IX2164.2 +022500 02 FILLER PIC X(17) VALUE IX2164.2 +022600 " COMPUTED=". IX2164.2 +022700 02 COMPUTED-X. IX2164.2 +022800 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2164.2 +022900 03 COMPUTED-N REDEFINES COMPUTED-A IX2164.2 +023000 PIC -9(9).9(9). IX2164.2 +023100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2164.2 +023200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2164.2 +023300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2164.2 +023400 03 CM-18V0 REDEFINES COMPUTED-A. IX2164.2 +023500 04 COMPUTED-18V0 PIC -9(18). IX2164.2 +023600 04 FILLER PIC X. IX2164.2 +023700 03 FILLER PIC X(50) VALUE SPACE. IX2164.2 +023800 01 TEST-CORRECT. IX2164.2 +023900 02 FILLER PIC X(30) VALUE SPACE. IX2164.2 +024000 02 FILLER PIC X(17) VALUE " CORRECT =". IX2164.2 +024100 02 CORRECT-X. IX2164.2 +024200 03 CORRECT-A PIC X(20) VALUE SPACE. IX2164.2 +024300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2164.2 +024400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2164.2 +024500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2164.2 +024600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2164.2 +024700 03 CR-18V0 REDEFINES CORRECT-A. IX2164.2 +024800 04 CORRECT-18V0 PIC -9(18). IX2164.2 +024900 04 FILLER PIC X. IX2164.2 +025000 03 FILLER PIC X(2) VALUE SPACE. IX2164.2 +025100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2164.2 +025200 01 CCVS-C-1. IX2164.2 +025300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2164.2 +025400- "SS PARAGRAPH-NAME IX2164.2 +025500- " REMARKS". IX2164.2 +025600 02 FILLER PIC X(20) VALUE SPACE. IX2164.2 +025700 01 CCVS-C-2. IX2164.2 +025800 02 FILLER PIC X VALUE SPACE. IX2164.2 +025900 02 FILLER PIC X(6) VALUE "TESTED". IX2164.2 +026000 02 FILLER PIC X(15) VALUE SPACE. IX2164.2 +026100 02 FILLER PIC X(4) VALUE "FAIL". IX2164.2 +026200 02 FILLER PIC X(94) VALUE SPACE. IX2164.2 +026300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2164.2 +026400 01 REC-CT PIC 99 VALUE ZERO. IX2164.2 +026500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2164.2 +026600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2164.2 +026700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2164.2 +026800 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2164.2 +026900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2164.2 +027000 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2164.2 +027100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2164.2 +027200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2164.2 +027300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2164.2 +027400 01 CCVS-H-1. IX2164.2 +027500 02 FILLER PIC X(39) VALUE SPACES. IX2164.2 +027600 02 FILLER PIC X(42) VALUE IX2164.2 +027700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2164.2 +027800 02 FILLER PIC X(39) VALUE SPACES. IX2164.2 +027900 01 CCVS-H-2A. IX2164.2 +028000 02 FILLER PIC X(40) VALUE SPACE. IX2164.2 +028100 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2164.2 +028200 02 FILLER PIC XXXX VALUE IX2164.2 +028300 "4.2 ". IX2164.2 +028400 02 FILLER PIC X(28) VALUE IX2164.2 +028500 " COPY - NOT FOR DISTRIBUTION". IX2164.2 +028600 02 FILLER PIC X(41) VALUE SPACE. IX2164.2 +028700 IX2164.2 +028800 01 CCVS-H-2B. IX2164.2 +028900 02 FILLER PIC X(15) VALUE IX2164.2 +029000 "TEST RESULT OF ". IX2164.2 +029100 02 TEST-ID PIC X(9). IX2164.2 +029200 02 FILLER PIC X(4) VALUE IX2164.2 +029300 " IN ". IX2164.2 +029400 02 FILLER PIC X(12) VALUE IX2164.2 +029500 " HIGH ". IX2164.2 +029600 02 FILLER PIC X(22) VALUE IX2164.2 +029700 " LEVEL VALIDATION FOR ". IX2164.2 +029800 02 FILLER PIC X(58) VALUE IX2164.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2164.2 +030000 01 CCVS-H-3. IX2164.2 +030100 02 FILLER PIC X(34) VALUE IX2164.2 +030200 " FOR OFFICIAL USE ONLY ". IX2164.2 +030300 02 FILLER PIC X(58) VALUE IX2164.2 +030400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2164.2 +030500 02 FILLER PIC X(28) VALUE IX2164.2 +030600 " COPYRIGHT 1985 ". IX2164.2 +030700 01 CCVS-E-1. IX2164.2 +030800 02 FILLER PIC X(52) VALUE SPACE. IX2164.2 +030900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2164.2 +031000 02 ID-AGAIN PIC X(9). IX2164.2 +031100 02 FILLER PIC X(45) VALUE SPACES. IX2164.2 +031200 01 CCVS-E-2. IX2164.2 +031300 02 FILLER PIC X(31) VALUE SPACE. IX2164.2 +031400 02 FILLER PIC X(21) VALUE SPACE. IX2164.2 +031500 02 CCVS-E-2-2. IX2164.2 +031600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2164.2 +031700 03 FILLER PIC X VALUE SPACE. IX2164.2 +031800 03 ENDER-DESC PIC X(44) VALUE IX2164.2 +031900 "ERRORS ENCOUNTERED". IX2164.2 +032000 01 CCVS-E-3. IX2164.2 +032100 02 FILLER PIC X(22) VALUE IX2164.2 +032200 " FOR OFFICIAL USE ONLY". IX2164.2 +032300 02 FILLER PIC X(12) VALUE SPACE. IX2164.2 +032400 02 FILLER PIC X(58) VALUE IX2164.2 +032500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2164.2 +032600 02 FILLER PIC X(13) VALUE SPACE. IX2164.2 +032700 02 FILLER PIC X(15) VALUE IX2164.2 +032800 " COPYRIGHT 1985". IX2164.2 +032900 01 CCVS-E-4. IX2164.2 +033000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2164.2 +033100 02 FILLER PIC X(4) VALUE " OF ". IX2164.2 +033200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2164.2 +033300 02 FILLER PIC X(40) VALUE IX2164.2 +033400 " TESTS WERE EXECUTED SUCCESSFULLY". IX2164.2 +033500 01 XXINFO. IX2164.2 +033600 02 FILLER PIC X(19) VALUE IX2164.2 +033700 "*** INFORMATION ***". IX2164.2 +033800 02 INFO-TEXT. IX2164.2 +033900 04 FILLER PIC X(8) VALUE SPACE. IX2164.2 +034000 04 XXCOMPUTED PIC X(20). IX2164.2 +034100 04 FILLER PIC X(5) VALUE SPACE. IX2164.2 +034200 04 XXCORRECT PIC X(20). IX2164.2 +034300 02 INF-ANSI-REFERENCE PIC X(48). IX2164.2 +034400 01 HYPHEN-LINE. IX2164.2 +034500 02 FILLER PIC IS X VALUE IS SPACE. IX2164.2 +034600 02 FILLER PIC IS X(65) VALUE IS "************************IX2164.2 +034700- "*****************************************". IX2164.2 +034800 02 FILLER PIC IS X(54) VALUE IS "************************IX2164.2 +034900- "******************************". IX2164.2 +035000 01 CCVS-PGM-ID PIC X(9) VALUE IX2164.2 +035100 "IX216A". IX2164.2 +035200 PROCEDURE DIVISION. IX2164.2 +035300 DECLARATIVES. IX2164.2 +035400 IX-FS2-01 SECTION. IX2164.2 +035500 USE AFTER STANDARD ERROR PROCEDURE ON IX-FS2. IX2164.2 +035600 IX-FS2-01-01. IX2164.2 +035700 ADD 1 TO WRK-CS-09V00-013. IX2164.2 +035800 GO TO IX-FS2-01-03 IX2164.2 +035900 IX-FS2-01-05 IX2164.2 +036000 DEPENDING ON WRK-CS-09V00-012. IX2164.2 +036100 GO TO IX-FS2-01-EXIT. IX2164.2 +036200 IX-FS2-01-03. IX2164.2 +036300*ENTRY FROM SEGMENT INX-TEST-001. IX2164.2 +036400* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. IX2164.2 +036500 ADD 1 TO WRK-CS-09V00-014. IX2164.2 +036600 IX-FS2-01-05. IX2164.2 +036700 ADD 1 TO WRK-CS-09V00-017. IX2164.2 +036800 IF XRECORD-NUMBER (2) EQUAL TO 500 IX2164.2 +036900 MOVE IX-FS2-STATUS TO WRK-XN-0002-002 IX2164.2 +037000 MOVE "10" TO WRK-XN-0002-003. IX2164.2 +037100 IX-FS2-01-EXIT. IX2164.2 +037200 EXIT. IX2164.2 +037300 END DECLARATIVES. IX2164.2 +037400 CCVS1 SECTION. IX2164.2 +037500 OPEN-FILES. IX2164.2 +037600*P OPEN I-O RAW-DATA. IX2164.2 +037700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2164.2 +037800*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2164.2 +037900*P MOVE "ABORTED " TO C-ABORT. IX2164.2 +038000*P ADD 1 TO C-NO-OF-TESTS. IX2164.2 +038100*P ACCEPT C-DATE FROM DATE. IX2164.2 +038200*P ACCEPT C-TIME FROM TIME. IX2164.2 +038300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2164.2 +038400*PND-E-1. IX2164.2 +038500*P CLOSE RAW-DATA. IX2164.2 +038600 OPEN OUTPUT PRINT-FILE. IX2164.2 +038700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2164.2 +038800 MOVE SPACE TO TEST-RESULTS. IX2164.2 +038900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2164.2 +039000 MOVE ZERO TO REC-SKL-SUB. IX2164.2 +039100 PERFORM CCVS-INIT-FILE 9 TIMES. IX2164.2 +039200 CCVS-INIT-FILE. IX2164.2 +039300 ADD 1 TO REC-SKL-SUB. IX2164.2 +039400 MOVE FILE-RECORD-INFO-SKELETON IX2164.2 +039500 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2164.2 +039600 CCVS-INIT-EXIT. IX2164.2 +039700 GO TO CCVS1-EXIT. IX2164.2 +039800 CLOSE-FILES. IX2164.2 +039900*P OPEN I-O RAW-DATA. IX2164.2 +040000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2164.2 +040100*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2164.2 +040200*P MOVE "OK. " TO C-ABORT. IX2164.2 +040300*P MOVE PASS-COUNTER TO C-OK. IX2164.2 +040400*P MOVE ERROR-HOLD TO C-ALL. IX2164.2 +040500*P MOVE ERROR-COUNTER TO C-FAIL. IX2164.2 +040600*P MOVE DELETE-COUNTER TO C-DELETED. IX2164.2 +040700*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2164.2 +040800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2164.2 +040900*PND-E-2. IX2164.2 +041000*P CLOSE RAW-DATA. IX2164.2 +041100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2164.2 +041200 TERMINATE-CCVS. IX2164.2 +041300*S EXIT PROGRAM. IX2164.2 +041400*SERMINATE-CALL. IX2164.2 +041500 STOP RUN. IX2164.2 +041600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2164.2 +041700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2164.2 +041800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2164.2 +041900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2164.2 +042000 MOVE "****TEST DELETED****" TO RE-MARK. IX2164.2 +042100 PRINT-DETAIL. IX2164.2 +042200 IF REC-CT NOT EQUAL TO ZERO IX2164.2 +042300 MOVE "." TO PARDOT-X IX2164.2 +042400 MOVE REC-CT TO DOTVALUE. IX2164.2 +042500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2164.2 +042600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2164.2 +042700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2164.2 +042800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2164.2 +042900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2164.2 +043000 MOVE SPACE TO CORRECT-X. IX2164.2 +043100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2164.2 +043200 MOVE SPACE TO RE-MARK. IX2164.2 +043300 HEAD-ROUTINE. IX2164.2 +043400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +043500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +043600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2164.2 +043700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2164.2 +043800 COLUMN-NAMES-ROUTINE. IX2164.2 +043900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +044000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +044100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +044200 END-ROUTINE. IX2164.2 +044300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2164.2 +044400 END-RTN-EXIT. IX2164.2 +044500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +044600 END-ROUTINE-1. IX2164.2 +044700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2164.2 +044800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2164.2 +044900 ADD PASS-COUNTER TO ERROR-HOLD. IX2164.2 +045000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2164.2 +045100 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2164.2 +045200 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2164.2 +045300 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2164.2 +045400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2164.2 +045500 END-ROUTINE-12. IX2164.2 +045600 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2164.2 +045700 IF ERROR-COUNTER IS EQUAL TO ZERO IX2164.2 +045800 MOVE "NO " TO ERROR-TOTAL IX2164.2 +045900 ELSE IX2164.2 +046000 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2164.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2164.2 +046200 PERFORM WRITE-LINE. IX2164.2 +046300 END-ROUTINE-13. IX2164.2 +046400 IF DELETE-COUNTER IS EQUAL TO ZERO IX2164.2 +046500 MOVE "NO " TO ERROR-TOTAL ELSE IX2164.2 +046600 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2164.2 +046700 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2164.2 +046800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +046900 IF INSPECT-COUNTER EQUAL TO ZERO IX2164.2 +047000 MOVE "NO " TO ERROR-TOTAL IX2164.2 +047100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2164.2 +047200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2164.2 +047300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +047400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2164.2 +047500 WRITE-LINE. IX2164.2 +047600 ADD 1 TO RECORD-COUNT. IX2164.2 +047700 IF RECORD-COUNT GREATER 42 IX2164.2 +047800 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2164.2 +047900 MOVE SPACE TO DUMMY-RECORD IX2164.2 +048000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2164.2 +048100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2164.2 +048200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2164.2 +048300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2164.2 +048400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2164.2 +048500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2164.2 +048600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2164.2 +048700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2164.2 +048800 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2164.2 +048900 MOVE ZERO TO RECORD-COUNT. IX2164.2 +049000 PERFORM WRT-LN. IX2164.2 +049100 WRT-LN. IX2164.2 +049200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2164.2 +049300 MOVE SPACE TO DUMMY-RECORD. IX2164.2 +049400 BLANK-LINE-PRINT. IX2164.2 +049500 PERFORM WRT-LN. IX2164.2 +049600 FAIL-ROUTINE. IX2164.2 +049700 IF COMPUTED-X NOT EQUAL TO SPACE IX2164.2 +049800 GO TO FAIL-ROUTINE-WRITE. IX2164.2 +049900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2164.2 +050000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2164.2 +050100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2164.2 +050200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +050300 MOVE SPACES TO INF-ANSI-REFERENCE. IX2164.2 +050400 GO TO FAIL-ROUTINE-EX. IX2164.2 +050500 FAIL-ROUTINE-WRITE. IX2164.2 +050600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2164.2 +050700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2164.2 +050800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2164.2 +050900 MOVE SPACES TO COR-ANSI-REFERENCE. IX2164.2 +051000 FAIL-ROUTINE-EX. EXIT. IX2164.2 +051100 BAIL-OUT. IX2164.2 +051200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2164.2 +051300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2164.2 +051400 BAIL-OUT-WRITE. IX2164.2 +051500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2164.2 +051600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2164.2 +051700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2164.2 +051800 MOVE SPACES TO INF-ANSI-REFERENCE. IX2164.2 +051900 BAIL-OUT-EX. EXIT. IX2164.2 +052000 CCVS1-EXIT. IX2164.2 +052100 EXIT. IX2164.2 +052200 SECT-IX-04-001 SECTION. IX2164.2 +052300 INX-INIT-001. IX2164.2 +052400 MOVE "CREATE IX-FS2" TO FEATURE IX2164.2 +052500 MOVE "IX-FS2" TO XFILE-NAME (2). IX2164.2 +052600 MOVE "R1-F-G" TO XRECORD-NAME (2). IX2164.2 +052700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). IX2164.2 +052800 MOVE 000240 TO XRECORD-LENGTH (2). IX2164.2 +052900 MOVE "RC" TO CHARS-OR-RECORDS (2). IX2164.2 +053000 MOVE 0001 TO XBLOCK-SIZE (2). IX2164.2 +053100 MOVE 000500 TO RECORDS-IN-FILE (2). IX2164.2 +053200 MOVE "IX" TO XFILE-ORGANIZATION (2). IX2164.2 +053300 MOVE "S" TO XLABEL-TYPE (2). IX2164.2 +053400 MOVE 000001 TO XRECORD-NUMBER (2). IX2164.2 +053500*INITIALIZE RECORD WORK AREA NUMBER 2. IX2164.2 +053600 MOVE 1 TO WRK-CS-09V00-012. IX2164.2 +053700 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 IX2164.2 +053800 WRK-CS-09V00-015 WRK-CS-09V00-016 IX2164.2 +053900 WRK-CS-09V00-017 WRK-CS-09V00-018. IX2164.2 +054000 OPEN-INIT-GF-01. IX2164.2 +054100 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +054200 MOVE ZERO TO WRK-DU-09V00-001. IX2164.2 +054300 OPEN-TEST-GF-01. IX2164.2 +054400* FILE IX-FS2 DOES NOT EXIST ********************** IX2164.2 +054500 OPEN EXTEND IX-FS2. IX2164.2 +054600 IF IX-FS2-STATUS = "05" IX2164.2 +054700 GO TO OPEN-PASS-GF-01. IX2164.2 +054800 OPEN-FAIL-GF-01. IX2164.2 +054900 PERFORM FAIL. IX2164.2 +055000 MOVE IX-FS2-STATUS TO COMPUTED-A. IX2164.2 +055100 MOVE "05" TO CORRECT-A. IX2164.2 +055200 MOVE "IX-3; 1.3.4 (1) D; STATUS AFTER OPEN EXTEND" TO RE-MARKIX2164.2 +055300 GO TO OPEN-WRITE-GF-01. IX2164.2 +055400 OPEN-PASS-GF-01. IX2164.2 +055500 PERFORM PASS. IX2164.2 +055600 OPEN-WRITE-GF-01. IX2164.2 +055700 MOVE "OPEN-TEST-GF-01" TO PAR-NAME. IX2164.2 +055800 MOVE "OPEN EXTEND: EXP: 05" TO FEATURE. IX2164.2 +055900 PERFORM PRINT-DETAIL. IX2164.2 +056000 MOVE GRP-0101 TO IX-FS2-KEY. IX2164.2 +056100 MOVE IX-FS2-STATUS TO WRK-XN-0002-001. IX2164.2 +056200*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. IX2164.2 +056300 WRITE-INIT-GF-01. IX2164.2 +056400 MOVE "99" TO IX-FS2-STATUS. IX2164.2 +056500 MOVE XRECORD-NUMBER (2) TO WRK-DU-09V00-001. IX2164.2 +056600 MOVE GRP-0101 TO XRECORD-KEY (2). IX2164.2 +056700 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240. IX2164.2 +056800 WRITE IX-FS2R1-F-G-240. IX2164.2 +056900 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +057000 ADD 1 TO WRK-CS-09V00-016. IX2164.2 +057100 IF XRECORD-NUMBER (2) EQUAL TO 300 IX2164.2 +057200 PERFORM WRITE-TEST-GF-01 THRU WRITE-TEST-GF-01-END. IX2164.2 +057300 IF XRECORD-NUMBER (2) EQUAL TO 500 IX2164.2 +057400 GO TO WRITE-TEST-GF-02. IX2164.2 +057500 ADD 01 TO XRECORD-NUMBER (2). IX2164.2 +057600 GO TO WRITE-INIT-GF-01. IX2164.2 +057700 WRITE-TEST-GF-01. IX2164.2 +057800 CLOSE IX-FS2. IX2164.2 +057900 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +058000 OPEN EXTEND IX-FS2. IX2164.2 +058100 WRITE-TEST-GF-01-02. IX2164.2 +058200 IF IX-FS2-STATUS = "00" IX2164.2 +058300 GO TO WRITE-TEST-GF-01-02-PASS. IX2164.2 +058400 WRITE-TEST-GF-01-02-FAIL. IX2164.2 +058500 PERFORM FAIL. IX2164.2 +058600 MOVE IX-FS2-STATUS TO COMPUTED-A. IX2164.2 +058700 MOVE "00" TO CORRECT-A. IX2164.2 +058800 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER OPEN EXTEND" TO RE-MARKIX2164.2 +058900 GO TO WRITE-TEST-GF-01-02-WRITE. IX2164.2 +059000 WRITE-TEST-GF-01-02-PASS. IX2164.2 +059100 PERFORM PASS. IX2164.2 +059200 WRITE-TEST-GF-01-02-WRITE. IX2164.2 +059300 MOVE "WRITE-TEST-GF-01 " TO PAR-NAME. IX2164.2 +059400 MOVE "OPEN EXTEND EXISTING" TO FEATURE. IX2164.2 +059500 PERFORM PRINT-DETAIL. IX2164.2 +059600 WRITE-TEST-GF-01-END. IX2164.2 +059700 EXIT. IX2164.2 +059800 IX2164.2 +059900 WRITE-TEST-GF-02. IX2164.2 +060000 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO IX2164.2 +060100 MOVE "IX-41; EXCEPTIONS/ERRORS" TO RE-MARK IX2164.2 +060200 MOVE ZERO TO CORRECT-18V0 IX2164.2 +060300 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX2164.2 +060400 PERFORM FAIL IX2164.2 +060500 ELSE IX2164.2 +060600 PERFORM PASS. IX2164.2 +060700 MOVE "OP EXT: ERROR/EXCEPT" TO FEATURE. IX2164.2 +060800 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. IX2164.2 +060900 PERFORM PRINT-DETAIL. IX2164.2 +061000 WRITE-TEST-GF-03. IX2164.2 +061100 MOVE "OP EXT: INCORR COUNT" TO FEATURE. IX2164.2 +061200 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. IX2164.2 +061300 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 IX2164.2 +061400 MOVE "IX-41; INCORRECT COUNT" TO RE-MARK IX2164.2 +061500 MOVE 500 TO CORRECT-18V0 IX2164.2 +061600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 IX2164.2 +061700 PERFORM FAIL IX2164.2 +061800 ELSE IX2164.2 +061900 PERFORM PASS. IX2164.2 +062000 PERFORM PRINT-DETAIL. IX2164.2 +062100 WRITE-TEST-GF-04. IX2164.2 +062200 MOVE "OP EXT STATUS EXP:00" TO FEATURE. IX2164.2 +062300 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. IX2164.2 +062400* IF WRK-XN-0002-001 NOT EQUAL TO "00" IX2164.2 +062500* MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER OPEN" TO RE-MARKIX2164.2 +062600* MOVE WRK-XN-0002-001 TO COMPUTED-A IX2164.2 +062700* MOVE "00" TO CORRECT-A IX2164.2 +062800* PERFORM FAIL IX2164.2 +062900* ELSE IX2164.2 +063000* PERFORM PASS. IX2164.2 +063100 PERFORM DE-LETE. IX2164.2 +063200 PERFORM PRINT-DETAIL. IX2164.2 +063300 WRITE-TEST-GF-05. IX2164.2 +063400 MOVE "WRITE STATUS EXP: 00" TO FEATURE. IX2164.2 +063500 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. IX2164.2 +063600 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +063700 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER WRITE" TO RE-MARKIX2164.2 +063800 MOVE IX-FS2-STATUS TO COMPUTED-A IX2164.2 +063900 MOVE "00" TO CORRECT-A IX2164.2 +064000 PERFORM FAIL IX2164.2 +064100 ELSE IX2164.2 +064200 PERFORM PASS. IX2164.2 +064300 PERFORM PRINT-DETAIL. IX2164.2 +064400 WRITE-TEST-GF-06. IX2164.2 +064500 MOVE "WRITE STATUS EXP: 00" TO FEATURE. IX2164.2 +064600 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. IX2164.2 +064700 IF WRK-CS-09V00-016 NOT EQUAL TO ZERO IX2164.2 +064800 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER WRITE" TO RE-MARKIX2164.2 +064900 MOVE ZERO TO CORRECT-18V0 IX2164.2 +065000 MOVE WRK-CS-09V00-016 TO COMPUTED-18V0 IX2164.2 +065100 PERFORM FAIL IX2164.2 +065200 ELSE IX2164.2 +065300 PERFORM PASS. IX2164.2 +065400 PERFORM PRINT-DETAIL. IX2164.2 +065500 WRITE-TEST-GF-07. IX2164.2 +065600 MOVE "CLOSE STATUS EXP: 00" TO FEATURE. IX2164.2 +065700 MOVE "WRITE-TEST-GF-07" TO PAR-NAME. IX2164.2 +065800 MOVE 99 TO IX-FS2-STATUS. IX2164.2 +065900 CLOSE IX-FS2. IX2164.2 +066000 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +066100 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER CLOSE" TO RE-MARKIX2164.2 +066200 MOVE IX-FS2-STATUS TO COMPUTED-A IX2164.2 +066300 MOVE "00" TO CORRECT-A IX2164.2 +066400 PERFORM FAIL IX2164.2 +066500 ELSE IX2164.2 +066600 PERFORM PASS. IX2164.2 +066700 PERFORM PRINT-DETAIL. IX2164.2 +066800 IX2164.2 +066900 RWRT-INIT-GF-01. IX2164.2 +067000 MOVE 2 TO WRK-CS-09V00-012. IX2164.2 +067100 MOVE ZERO TO WRK-CS-09V00-013. IX2164.2 +067200 MOVE ZERO TO WRK-CS-09V00-014. IX2164.2 +067300 MOVE ZERO TO WRK-CS-09V00-015. IX2164.2 +067400 MOVE ZERO TO WRK-CS-09V00-016. IX2164.2 +067500 MOVE ZERO TO WRK-CS-09V00-017. IX2164.2 +067600 MOVE ZERO TO WRK-CS-09V00-018. IX2164.2 +067700 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +067800 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. IX2164.2 +067900 OPEN I-O IX-FS2. IX2164.2 +068000 MOVE SPACE TO WRK-XN-0002-002 IX2164.2 +068100 MOVE SPACE TO WRK-XN-0002-003 IX2164.2 +068200 MOVE SPACE TO WRK-XN-0002-004 IX2164.2 +068300 MOVE IX-FS2-STATUS TO WRK-XN-0002-001 IX2164.2 +068400 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +068500 MOVE "UPDATE IX-FS2" TO FEATURE. IX2164.2 +068600*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. IX2164.2 +068700 RWRT-TEST-GF-01. IX2164.2 +068800 ADD 1 TO WRK-CS-09V00-014. IX2164.2 +068900 ADD 1 TO WRK-CS-09V00-015. IX2164.2 +069000 READ IX-FS2. IX2164.2 +069100 IF IX-FS2-STATUS EQUAL TO "10" IX2164.2 +069200 GO TO RWRT-TEST-GF-01-1. IX2164.2 +069300 MOVE IX-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). IX2164.2 +069400 IF WRK-CS-09V00-015 EQUAL TO 5 IX2164.2 +069500 ADD 01 TO UPDATE-NUMBER (2) IX2164.2 +069600 MOVE FILE-RECORD-INFO (2) TO IX-FS2R1-F-G-240 IX2164.2 +069700 PERFORM RWRT-010-UPDATE IX2164.2 +069800 MOVE ZERO TO WRK-CS-09V00-015 IX2164.2 +069900 GO TO RWRT-TEST-GF-01-2. IX2164.2 +070000 IF WRK-CS-09V00-014 GREATER 500 IX2164.2 +070100 GO TO RWRT-TEST-GF-01-1. IX2164.2 +070200 GO TO RWRT-TEST-GF-01. IX2164.2 +070300 RWRT-010-UPDATE. IX2164.2 +070400 REWRITE IX-FS2R1-F-G-240. IX2164.2 +070500 RWRT-TEST-GF-01-2. IX2164.2 +070600 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +070700 ADD 1 TO WRK-CS-09V00-016. IX2164.2 +070800 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +070900 GO TO RWRT-TEST-GF-01. IX2164.2 +071000 RWRT-TEST-GF-01-1. IX2164.2 +071100 MOVE "REWRITE ERR/EXCEPTIO" TO FEATURE. IX2164.2 +071200 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. IX2164.2 +071300 IF WRK-CS-09V00-013 NOT EQUAL TO 1 IX2164.2 +071400 MOVE "IX-33; EXCEPTIONS/ERRORS" TO RE-MARK IX2164.2 +071500 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 IX2164.2 +071600 MOVE 1 TO CORRECT-18V0 IX2164.2 +071700 PERFORM FAIL IX2164.2 +071800 ELSE IX2164.2 +071900 PERFORM PASS. IX2164.2 +072000 PERFORM PRINT-DETAIL. IX2164.2 +072100 RWRT-TEST-GF-02. IX2164.2 +072200 MOVE "REWRITE ERR/EXCEPTIO" TO FEATURE. IX2164.2 +072300 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. IX2164.2 +072400 IF WRK-CS-09V00-014 NOT EQUAL TO 501 IX2164.2 +072500 MOVE "IX-33;INCORRECT COUNT" TO RE-MARK IX2164.2 +072600 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 IX2164.2 +072700 MOVE 501 TO CORRECT-18V0 IX2164.2 +072800 PERFORM FAIL IX2164.2 +072900 ELSE IX2164.2 +073000 PERFORM PASS. IX2164.2 +073100 PERFORM PRINT-DETAIL. IX2164.2 +073200 RWRT-TEST-GF-03. IX2164.2 +073300 MOVE "OPEN STATUS EXP: 00" TO FEATURE. IX2164.2 +073400 MOVE "RWRT-TEST-GF-03" TO PAR-NAME. IX2164.2 +073500 IF WRK-XN-0002-001 NOT EQUAL TO "00" IX2164.2 +073600 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER OPEN" TO RE-MARKIX2164.2 +073700 MOVE WRK-XN-0002-001 TO COMPUTED-A IX2164.2 +073800 MOVE "00" TO CORRECT-A IX2164.2 +073900 PERFORM FAIL IX2164.2 +074000 ELSE IX2164.2 +074100 PERFORM PASS. IX2164.2 +074200 PERFORM PRINT-DETAIL. IX2164.2 +074300 RWRT-TEST-GF-04. IX2164.2 +074400 MOVE "AT END STATUS EXP:10" TO FEATURE. IX2164.2 +074500 MOVE "RWRT-TEST-GF-04" TO PAR-NAME. IX2164.2 +074600 IF IX-FS2-STATUS NOT EQUAL TO "10" IX2164.2 +074700 MOVE "IX-4; 1.3.4 (2) A; STATUS AT END " TO RE-MARKIX2164.2 +074800 MOVE IX-FS2-STATUS TO COMPUTED-A IX2164.2 +074900 MOVE "10" TO CORRECT-A IX2164.2 +075000 PERFORM FAIL IX2164.2 +075100 ELSE IX2164.2 +075200 PERFORM PASS. IX2164.2 +075300 PERFORM PRINT-DETAIL. IX2164.2 +075400 RWRT-TEST-GF-05. IX2164.2 +075500 MOVE "REWRITE ERR/EXCEPTIO" TO FEATURE. IX2164.2 +075600 MOVE "RWRT-TEST-GF-05" TO PAR-NAME. IX2164.2 +075700 IF WRK-XN-0002-002 NOT EQUAL TO "10" IX2164.2 +075800 MOVE "IX-4; 1.3.4 (2) A; STATUS AFTER END" TO RE-MARKIX2164.2 +075900 MOVE "EXCEPTIN/STATUS" TO RE-MARK IX2164.2 +076000 MOVE WRK-XN-0002-002 TO COMPUTED-A IX2164.2 +076100 MOVE "10" TO CORRECT-A IX2164.2 +076200 PERFORM FAIL IX2164.2 +076300 ELSE IX2164.2 +076400 PERFORM PASS. IX2164.2 +076500 PERFORM PRINT-DETAIL. IX2164.2 +076600 RWRT-TEST-GF-06. IX2164.2 +076700 MOVE "REWRITE ERR/EXCEPTIO" TO FEATURE. IX2164.2 +076800 MOVE "RWRT-TEST-GF-06" TO PAR-NAME. IX2164.2 +076900 IF WRK-XN-0002-003 NOT EQUAL TO "10" IX2164.2 +077000 MOVE "IX-4; 1.3.4 (2) A; NO/ EXCEPTION " TO RE-MARKIX2164.2 +077100 MOVE WRK-XN-0002-003 TO COMPUTED-A IX2164.2 +077200 MOVE "10" TO CORRECT-A IX2164.2 +077300 PERFORM FAIL IX2164.2 +077400 ELSE IX2164.2 +077500 PERFORM PASS. IX2164.2 +077600 PERFORM PRINT-DETAIL. IX2164.2 +077700 RWRT-TEST-GF-07. IX2164.2 +077800 MOVE "CLOSE LOCK STAT: 00" TO FEATURE. IX2164.2 +077900 MOVE "RWRT-TEST-GF-07" TO PAR-NAME. IX2164.2 +078000 MOVE SPACE TO IX-FS2-STATUS. IX2164.2 +078100 CLOSE IX-FS2 LOCK. IX2164.2 +078200 IF IX-FS2-STATUS NOT EQUAL TO "00" IX2164.2 +078300 MOVE "IX-3; 1.3.4 (1) A; STATUS AFTER CLOSE" TO RE-MARKIX2164.2 +078400 MOVE IX-FS2-STATUS TO COMPUTED-A IX2164.2 +078500 MOVE "00" TO CORRECT-A IX2164.2 +078600 PERFORM FAIL IX2164.2 +078700 ELSE IX2164.2 +078800 PERFORM PASS. IX2164.2 +078900 PERFORM PRINT-DETAIL. IX2164.2 +079000 CCVS-EXIT SECTION. IX2164.2 +079100 CCVS-999999. IX2164.2 +079200 GO TO CLOSE-FILES. IX2164.2 diff --git a/tests/cobol85/IX/IX217A.CBL b/tests/cobol85/IX/IX217A.CBL new file mode 100755 index 00000000..b9eec9c3 --- /dev/null +++ b/tests/cobol85/IX/IX217A.CBL @@ -0,0 +1,687 @@ +000100 IDENTIFICATION DIVISION. IX2174.2 +000200 PROGRAM-ID. IX2174.2 +000300 IX217A. IX2174.2 +000400**************************************************************** IX2174.2 +000500* * IX2174.2 +000600* VALIDATION FOR:- * IX2174.2 +000700* * IX2174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2174.2 +000900* * IX2174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2174.2 +001100* * IX2174.2 +001200**************************************************************** IX2174.2 +001300* IX2174.2 +001400* THE FUNCTION OF THIS PROGRAM IS TO CREATE IX2174.2 +001500* THE OPTIONAL BUT NOT EXISTING INDEXED FILES BY THE OPEN IX2174.2 +001600* I-O AND THE OPEN EXTEND STATEMENTS. THE FILE STATUS CODE IX2174.2 +001700* FOR BOTH FILES MUST BE "05" AFTER PROCESSING THE OPEN IX2174.2 +001800* STATEMENT. FILE IX-FS1 CONTAINS 50 RECORDS AFTER CORRECT IX2174.2 +001900* EXECUTION AND FILE IX-VS1 CONTAINS 25 LONG RECORDS (240) IX2174.2 +002000* AND 25 SHORT RECORDS (200) AFTER CORRECT EXECUTION. IX2174.2 +002100* IX2174.2 +002200* IX2174.2 +002300* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2174.2 +002400* IX2174.2 +002500* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2174.2 +002600* CLAUSE FOR DATA FILE IX-FS1 IX2174.2 +002700* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2174.2 +002800* CLAUSE FOR DATA FILE IX-VS1 IX2174.2 +002900* X-44 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2174.2 +003000* CLAUSE FOR INDEX FILE IX-FS1 IX2174.2 +003100* X-45 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2174.2 +003200* CLAUSE FOR INDEX FILE IX-VS1 IX2174.2 +003300* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2174.2 +003400* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2174.2 +003500* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2174.2 +003600* IX2174.2 +003700* NOTE: X-CARDS 44 AND 62 ARE OPTIONAL IX2174.2 +003800* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2174.2 +003900* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2174.2 +004000* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2174.2 +004100* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2174.2 +004200* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2174.2 +004300* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2174.2 +004400* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2174.2 +004500* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2174.2 +004600* THEY ARE AS FOLLOWS IX2174.2 +004700* IX2174.2 +004800* J SELECTS X-CARD 44 IX2174.2 +004900* J SELECTS X-CARD 45 IX2174.2 +005000* C SELECTS X-CARD 84 IX2174.2 +005100* IX2174.2 +005200****************************************************** IX2174.2 +005300 ENVIRONMENT DIVISION. IX2174.2 +005400 CONFIGURATION SECTION. IX2174.2 +005500 SOURCE-COMPUTER. IX2174.2 +005600 Linux. IX2174.2 +005700 OBJECT-COMPUTER. IX2174.2 +005800 Linux. IX2174.2 +005900 INPUT-OUTPUT SECTION. IX2174.2 +006000 FILE-CONTROL. IX2174.2 +006100 SELECT PRINT-FILE ASSIGN TO IX2174.2 +006200 "report.log". IX2174.2 +006300 IX2174.2 +006400 SELECT OPTIONAL IX-FS1 ASSIGN TO IX2174.2 +006500 "XXXXX024" IX2174.2 +006600*J **** X-CARD UNDEFINED **** IX2174.2 +006700 ORGANIZATION IS INDEXED IX2174.2 +006800 RECORD KEY IS IX-FS1-KEY IX2174.2 +006900 ACCESS MODE IS DYNAMIC IX2174.2 +007000 FILE STATUS IS IX-FS1-STATUS. IX2174.2 +007100 IX2174.2 +007200 SELECT OPTIONAL IX-VS1 ASSIGN TO IX2174.2 +007300 "XXXXX025" IX2174.2 +007400*J **** X-CARD UNDEFINED **** IX2174.2 +007500 ORGANIZATION IS INDEXED IX2174.2 +007600 RECORD KEY IS IX-VS1-KEY IX2174.2 +007700 ACCESS MODE IS SEQUENTIAL IX2174.2 +007800 FILE STATUS IS IX-VS1-STATUS. IX2174.2 +007900 IX2174.2 +008000 DATA DIVISION. IX2174.2 +008100 FILE SECTION. IX2174.2 +008200 FD PRINT-FILE. IX2174.2 +008300 01 PRINT-REC PICTURE X(120). IX2174.2 +008400 01 DUMMY-RECORD PICTURE X(120). IX2174.2 +008500 IX2174.2 +008600 FD IX-FS1 IX2174.2 +008700*C LABEL RECORD IS STANDARD IX2174.2 +008800*C DATA RECORD IS IX-FS1R1-F-G-240 IX2174.2 +008900 BLOCK CONTAINS 1 RECORDS IX2174.2 +009000 RECORD CONTAINS 240 CHARACTERS. IX2174.2 +009100 01 IX-FS1R1-F-G-240. IX2174.2 +009200 03 IX-FS1-WRK-120 PIC X(120). IX2174.2 +009300 03 IX-FS1-GRP-120. IX2174.2 +009400 05 FILLER PIC X(8). IX2174.2 +009500 05 IX-FS1-KEY PIC X(29). IX2174.2 +009600 05 FILLER PIC X(83). IX2174.2 +009700 IX2174.2 +009800 FD IX-VS1 IX2174.2 +009900*C LABEL RECORD IS STANDARD IX2174.2 +010000*C DATA RECORD IS IX-VS1R1-F-G-240 IX-VS1R1-F-G-200 IX2174.2 +010100 BLOCK CONTAINS 1 RECORDS IX2174.2 +010200 RECORD VARYING 200 TO 240 DEPENDING REC-LENGTH. IX2174.2 +010300 IX2174.2 +010400 01 IX-VS1R1-F-G-240. IX2174.2 +010500 03 IX-VS1-WRK-120 PIC X(120). IX2174.2 +010600 03 IX-VS1-GRP-120. IX2174.2 +010700 05 FILLER PIC X(8). IX2174.2 +010800 05 IX-VS1-KEY PIC X(29). IX2174.2 +010900 05 FILLER PIC X(83). IX2174.2 +011000 IX2174.2 +011100 01 IX-VS1R1-F-G-200. IX2174.2 +011200 03 IX-VS1-WRK-120-SHORT PIC X(120). IX2174.2 +011300 03 IX-VS1-GRP-80. IX2174.2 +011400 05 FILLER PIC X(8). IX2174.2 +011500 05 FILLER-KEY PIC X(29). IX2174.2 +011600 05 VIERZIG PIC X(43). IX2174.2 +011700 IX2174.2 +011800 WORKING-STORAGE SECTION. IX2174.2 +011900 01 REC-LENGTH PIC 9999 VALUE ZERO. IX2174.2 +012000 01 STATUS-ERROR PIC 9 VALUE ZERO. IX2174.2 +012100 01 GRP-0101. IX2174.2 +012200 02 FILLER PIC X(10) VALUE "ABCDLKJXYZ". IX2174.2 +012300 02 WRK-DU-09V00-001 PIC 9(9) VALUE ZERO. IX2174.2 +012400 02 FILLER PIC X(10) VALUE "ZIF,.$-+CD". IX2174.2 +012500 01 FILE-RECORD-INFORMATION-REC. IX2174.2 +012600 03 FILE-RECORD-INFO-SKELETON. IX2174.2 +012700 05 FILLER PICTURE X(48) VALUE IX2174.2 +012800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". IX2174.2 +012900 05 FILLER PICTURE X(46) VALUE IX2174.2 +013000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". IX2174.2 +013100 05 FILLER PICTURE X(26) VALUE IX2174.2 +013200 ",LFIL=000000,ORG= ,LBLR= ". IX2174.2 +013300 05 FILLER PICTURE X(37) VALUE IX2174.2 +013400 ",RECKEY= ". IX2174.2 +013500 05 FILLER PICTURE X(38) VALUE IX2174.2 +013600 ",ALTKEY1= ". IX2174.2 +013700 05 FILLER PICTURE X(38) VALUE IX2174.2 +013800 ",ALTKEY2= ". IX2174.2 +013900 05 FILLER PICTURE X(7) VALUE SPACE.IX2174.2 +014000 03 FILE-RECORD-INFO OCCURS 10 TIMES. IX2174.2 +014100 05 FILE-RECORD-INFO-P1-120. IX2174.2 +014200 07 FILLER PIC X(5). IX2174.2 +014300 07 XFILE-NAME PIC X(6). IX2174.2 +014400 07 FILLER PIC X(8). IX2174.2 +014500 07 XRECORD-NAME PIC X(6). IX2174.2 +014600 07 FILLER PIC X(1). IX2174.2 +014700 07 REELUNIT-NUMBER PIC 9(1). IX2174.2 +014800 07 FILLER PIC X(7). IX2174.2 +014900 07 XRECORD-NUMBER PIC 9(6). IX2174.2 +015000 07 FILLER PIC X(6). IX2174.2 +015100 07 UPDATE-NUMBER PIC 9(2). IX2174.2 +015200 07 FILLER PIC X(5). IX2174.2 +015300 07 ODO-NUMBER PIC 9(4). IX2174.2 +015400 07 FILLER PIC X(5). IX2174.2 +015500 07 XPROGRAM-NAME PIC X(5). IX2174.2 +015600 07 FILLER PIC X(7). IX2174.2 +015700 07 XRECORD-LENGTH PIC 9(6). IX2174.2 +015800 07 FILLER PIC X(7). IX2174.2 +015900 07 CHARS-OR-RECORDS PIC X(2). IX2174.2 +016000 07 FILLER PIC X(1). IX2174.2 +016100 07 XBLOCK-SIZE PIC 9(4). IX2174.2 +016200 07 FILLER PIC X(6). IX2174.2 +016300 07 RECORDS-IN-FILE PIC 9(6). IX2174.2 +016400 07 FILLER PIC X(5). IX2174.2 +016500 07 XFILE-ORGANIZATION PIC X(2). IX2174.2 +016600 07 FILLER PIC X(6). IX2174.2 +016700 07 XLABEL-TYPE PIC X(1). IX2174.2 +016800 05 FILE-RECORD-INFO-P121-240. IX2174.2 +016900 07 FILLER PIC X(8). IX2174.2 +017000 07 XRECORD-KEY PIC X(29). IX2174.2 +017100 07 FILLER PIC X(9). IX2174.2 +017200 07 ALTERNATE-KEY1 PIC X(29). IX2174.2 +017300 07 FILLER PIC X(9). IX2174.2 +017400 07 ALTERNATE-KEY2 PIC X(29). IX2174.2 +017500 07 FILLER PIC X(7). IX2174.2 +017600 IX2174.2 +017700 01 IX-FS1-STATUS. IX2174.2 +017800 05 IX-FS1-STAT1 PIC X. IX2174.2 +017900 05 IX-FS1-STAT2 PIC X. IX2174.2 +018000 IX2174.2 +018100 01 IX-VS1-STATUS. IX2174.2 +018200 05 IX-VS1-STAT1 PIC X. IX2174.2 +018300 05 IX-VS1-STAT2 PIC X. IX2174.2 +018400 IX2174.2 +018500 01 TEST-RESULTS. IX2174.2 +018600 02 FILLER PIC X VALUE SPACE. IX2174.2 +018700 02 FEATURE PIC X(20) VALUE SPACE. IX2174.2 +018800 02 FILLER PIC X VALUE SPACE. IX2174.2 +018900 02 P-OR-F PIC X(5) VALUE SPACE. IX2174.2 +019000 02 FILLER PIC X VALUE SPACE. IX2174.2 +019100 02 PAR-NAME. IX2174.2 +019200 03 FILLER PIC X(19) VALUE SPACE. IX2174.2 +019300 03 PARDOT-X PIC X VALUE SPACE. IX2174.2 +019400 03 DOTVALUE PIC 99 VALUE ZERO. IX2174.2 +019500 02 FILLER PIC X(8) VALUE SPACE. IX2174.2 +019600 02 RE-MARK PIC X(61). IX2174.2 +019700 01 TEST-COMPUTED. IX2174.2 +019800 02 FILLER PIC X(30) VALUE SPACE. IX2174.2 +019900 02 FILLER PIC X(17) VALUE IX2174.2 +020000 " COMPUTED=". IX2174.2 +020100 02 COMPUTED-X. IX2174.2 +020200 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2174.2 +020300 03 COMPUTED-N REDEFINES COMPUTED-A IX2174.2 +020400 PIC -9(9).9(9). IX2174.2 +020500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2174.2 +020600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2174.2 +020700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2174.2 +020800 03 CM-18V0 REDEFINES COMPUTED-A. IX2174.2 +020900 04 COMPUTED-18V0 PIC -9(18). IX2174.2 +021000 04 FILLER PIC X. IX2174.2 +021100 03 FILLER PIC X(50) VALUE SPACE. IX2174.2 +021200 01 TEST-CORRECT. IX2174.2 +021300 02 FILLER PIC X(30) VALUE SPACE. IX2174.2 +021400 02 FILLER PIC X(17) VALUE " CORRECT =". IX2174.2 +021500 02 CORRECT-X. IX2174.2 +021600 03 CORRECT-A PIC X(20) VALUE SPACE. IX2174.2 +021700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2174.2 +021800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2174.2 +021900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2174.2 +022000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2174.2 +022100 03 CR-18V0 REDEFINES CORRECT-A. IX2174.2 +022200 04 CORRECT-18V0 PIC -9(18). IX2174.2 +022300 04 FILLER PIC X. IX2174.2 +022400 03 FILLER PIC X(2) VALUE SPACE. IX2174.2 +022500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2174.2 +022600 01 CCVS-C-1. IX2174.2 +022700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2174.2 +022800- "SS PARAGRAPH-NAME IX2174.2 +022900- " REMARKS". IX2174.2 +023000 02 FILLER PIC X(20) VALUE SPACE. IX2174.2 +023100 01 CCVS-C-2. IX2174.2 +023200 02 FILLER PIC X VALUE SPACE. IX2174.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". IX2174.2 +023400 02 FILLER PIC X(15) VALUE SPACE. IX2174.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". IX2174.2 +023600 02 FILLER PIC X(94) VALUE SPACE. IX2174.2 +023700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2174.2 +023800 01 REC-CT PIC 99 VALUE ZERO. IX2174.2 +023900 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2174.2 +024000 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2174.2 +024100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2174.2 +024200 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2174.2 +024300 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2174.2 +024400 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2174.2 +024500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2174.2 +024600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2174.2 +024700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2174.2 +024800 01 CCVS-H-1. IX2174.2 +024900 02 FILLER PIC X(39) VALUE SPACES. IX2174.2 +025000 02 FILLER PIC X(42) VALUE IX2174.2 +025100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2174.2 +025200 02 FILLER PIC X(39) VALUE SPACES. IX2174.2 +025300 01 CCVS-H-2A. IX2174.2 +025400 02 FILLER PIC X(40) VALUE SPACE. IX2174.2 +025500 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2174.2 +025600 02 FILLER PIC XXXX VALUE IX2174.2 +025700 "4.2 ". IX2174.2 +025800 02 FILLER PIC X(28) VALUE IX2174.2 +025900 " COPY - NOT FOR DISTRIBUTION". IX2174.2 +026000 02 FILLER PIC X(41) VALUE SPACE. IX2174.2 +026100 IX2174.2 +026200 01 CCVS-H-2B. IX2174.2 +026300 02 FILLER PIC X(15) VALUE IX2174.2 +026400 "TEST RESULT OF ". IX2174.2 +026500 02 TEST-ID PIC X(9). IX2174.2 +026600 02 FILLER PIC X(4) VALUE IX2174.2 +026700 " IN ". IX2174.2 +026800 02 FILLER PIC X(12) VALUE IX2174.2 +026900 " HIGH ". IX2174.2 +027000 02 FILLER PIC X(22) VALUE IX2174.2 +027100 " LEVEL VALIDATION FOR ". IX2174.2 +027200 02 FILLER PIC X(58) VALUE IX2174.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2174.2 +027400 01 CCVS-H-3. IX2174.2 +027500 02 FILLER PIC X(34) VALUE IX2174.2 +027600 " FOR OFFICIAL USE ONLY ". IX2174.2 +027700 02 FILLER PIC X(58) VALUE IX2174.2 +027800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2174.2 +027900 02 FILLER PIC X(28) VALUE IX2174.2 +028000 " COPYRIGHT 1985 ". IX2174.2 +028100 01 CCVS-E-1. IX2174.2 +028200 02 FILLER PIC X(52) VALUE SPACE. IX2174.2 +028300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2174.2 +028400 02 ID-AGAIN PIC X(9). IX2174.2 +028500 02 FILLER PIC X(45) VALUE SPACES. IX2174.2 +028600 01 CCVS-E-2. IX2174.2 +028700 02 FILLER PIC X(31) VALUE SPACE. IX2174.2 +028800 02 FILLER PIC X(21) VALUE SPACE. IX2174.2 +028900 02 CCVS-E-2-2. IX2174.2 +029000 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2174.2 +029100 03 FILLER PIC X VALUE SPACE. IX2174.2 +029200 03 ENDER-DESC PIC X(44) VALUE IX2174.2 +029300 "ERRORS ENCOUNTERED". IX2174.2 +029400 01 CCVS-E-3. IX2174.2 +029500 02 FILLER PIC X(22) VALUE IX2174.2 +029600 " FOR OFFICIAL USE ONLY". IX2174.2 +029700 02 FILLER PIC X(12) VALUE SPACE. IX2174.2 +029800 02 FILLER PIC X(58) VALUE IX2174.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2174.2 +030000 02 FILLER PIC X(13) VALUE SPACE. IX2174.2 +030100 02 FILLER PIC X(15) VALUE IX2174.2 +030200 " COPYRIGHT 1985". IX2174.2 +030300 01 CCVS-E-4. IX2174.2 +030400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2174.2 +030500 02 FILLER PIC X(4) VALUE " OF ". IX2174.2 +030600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2174.2 +030700 02 FILLER PIC X(40) VALUE IX2174.2 +030800 " TESTS WERE EXECUTED SUCCESSFULLY". IX2174.2 +030900 01 XXINFO. IX2174.2 +031000 02 FILLER PIC X(19) VALUE IX2174.2 +031100 "*** INFORMATION ***". IX2174.2 +031200 02 INFO-TEXT. IX2174.2 +031300 04 FILLER PIC X(8) VALUE SPACE. IX2174.2 +031400 04 XXCOMPUTED PIC X(20). IX2174.2 +031500 04 FILLER PIC X(5) VALUE SPACE. IX2174.2 +031600 04 XXCORRECT PIC X(20). IX2174.2 +031700 02 INF-ANSI-REFERENCE PIC X(48). IX2174.2 +031800 01 HYPHEN-LINE. IX2174.2 +031900 02 FILLER PIC IS X VALUE IS SPACE. IX2174.2 +032000 02 FILLER PIC IS X(65) VALUE IS "************************IX2174.2 +032100- "*****************************************". IX2174.2 +032200 02 FILLER PIC IS X(54) VALUE IS "************************IX2174.2 +032300- "******************************". IX2174.2 +032400 01 CCVS-PGM-ID PIC X(9) VALUE IX2174.2 +032500 "IX217A". IX2174.2 +032600 PROCEDURE DIVISION. IX2174.2 +032700 CCVS1 SECTION. IX2174.2 +032800 OPEN-FILES. IX2174.2 +032900 OPEN OUTPUT PRINT-FILE. IX2174.2 +033000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2174.2 +033100 MOVE SPACE TO TEST-RESULTS. IX2174.2 +033200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2174.2 +033300 MOVE ZERO TO REC-SKL-SUB. IX2174.2 +033400 PERFORM CCVS-INIT-FILE 9 TIMES. IX2174.2 +033500 CCVS-INIT-FILE. IX2174.2 +033600 ADD 1 TO REC-SKL-SUB. IX2174.2 +033700 MOVE FILE-RECORD-INFO-SKELETON IX2174.2 +033800 TO FILE-RECORD-INFO (REC-SKL-SUB). IX2174.2 +033900 CCVS-INIT-EXIT. IX2174.2 +034000 GO TO CCVS1-EXIT. IX2174.2 +034100 CLOSE-FILES. IX2174.2 +034200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2174.2 +034300 TERMINATE-CCVS. IX2174.2 +034400 STOP RUN. IX2174.2 +034500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2174.2 +034600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2174.2 +034700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2174.2 +034800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2174.2 +034900 MOVE "****TEST DELETED****" TO RE-MARK. IX2174.2 +035000 PRINT-DETAIL. IX2174.2 +035100 IF REC-CT NOT EQUAL TO ZERO IX2174.2 +035200 MOVE "." TO PARDOT-X IX2174.2 +035300 MOVE REC-CT TO DOTVALUE. IX2174.2 +035400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2174.2 +035500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2174.2 +035600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2174.2 +035700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2174.2 +035800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2174.2 +035900 MOVE SPACE TO CORRECT-X. IX2174.2 +036000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2174.2 +036100 MOVE SPACE TO RE-MARK. IX2174.2 +036200 HEAD-ROUTINE. IX2174.2 +036300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +036400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +036500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2174.2 +036600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2174.2 +036700 COLUMN-NAMES-ROUTINE. IX2174.2 +036800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +036900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +037000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +037100 END-ROUTINE. IX2174.2 +037200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2174.2 +037300 END-RTN-EXIT. IX2174.2 +037400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +037500 END-ROUTINE-1. IX2174.2 +037600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2174.2 +037700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2174.2 +037800 ADD PASS-COUNTER TO ERROR-HOLD. IX2174.2 +037900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2174.2 +038000 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2174.2 +038100 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2174.2 +038200 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2174.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2174.2 +038400 END-ROUTINE-12. IX2174.2 +038500 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2174.2 +038600 IF ERROR-COUNTER IS EQUAL TO ZERO IX2174.2 +038700 MOVE "NO " TO ERROR-TOTAL IX2174.2 +038800 ELSE IX2174.2 +038900 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2174.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2174.2 +039100 PERFORM WRITE-LINE. IX2174.2 +039200 END-ROUTINE-13. IX2174.2 +039300 IF DELETE-COUNTER IS EQUAL TO ZERO IX2174.2 +039400 MOVE "NO " TO ERROR-TOTAL ELSE IX2174.2 +039500 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2174.2 +039600 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2174.2 +039700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +039800 IF INSPECT-COUNTER EQUAL TO ZERO IX2174.2 +039900 MOVE "NO " TO ERROR-TOTAL IX2174.2 +040000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2174.2 +040100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2174.2 +040200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +040300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2174.2 +040400 WRITE-LINE. IX2174.2 +040500 ADD 1 TO RECORD-COUNT. IX2174.2 +040600 IF RECORD-COUNT GREATER 42 IX2174.2 +040700 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2174.2 +040800 MOVE SPACE TO DUMMY-RECORD IX2174.2 +040900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2174.2 +041000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2174.2 +041100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2174.2 +041200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2174.2 +041300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2174.2 +041400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2174.2 +041500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2174.2 +041600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2174.2 +041700 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2174.2 +041800 MOVE ZERO TO RECORD-COUNT. IX2174.2 +041900 PERFORM WRT-LN. IX2174.2 +042000 WRT-LN. IX2174.2 +042100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2174.2 +042200 MOVE SPACE TO DUMMY-RECORD. IX2174.2 +042300 BLANK-LINE-PRINT. IX2174.2 +042400 PERFORM WRT-LN. IX2174.2 +042500 FAIL-ROUTINE. IX2174.2 +042600 IF COMPUTED-X NOT EQUAL TO SPACE IX2174.2 +042700 GO TO FAIL-ROUTINE-WRITE. IX2174.2 +042800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2174.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2174.2 +043000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2174.2 +043100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +043200 MOVE SPACES TO INF-ANSI-REFERENCE. IX2174.2 +043300 GO TO FAIL-ROUTINE-EX. IX2174.2 +043400 FAIL-ROUTINE-WRITE. IX2174.2 +043500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2174.2 +043600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2174.2 +043700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2174.2 +043800 MOVE SPACES TO COR-ANSI-REFERENCE. IX2174.2 +043900 FAIL-ROUTINE-EX. EXIT. IX2174.2 +044000 BAIL-OUT. IX2174.2 +044100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2174.2 +044200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2174.2 +044300 BAIL-OUT-WRITE. IX2174.2 +044400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2174.2 +044500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2174.2 +044600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2174.2 +044700 MOVE SPACES TO INF-ANSI-REFERENCE. IX2174.2 +044800 BAIL-OUT-EX. EXIT. IX2174.2 +044900 CCVS1-EXIT. IX2174.2 +045000 EXIT. IX2174.2 +045100 IX2174.2 +045200******************************************************************IX2174.2 +045300* TEST 1 *IX2174.2 +045400* OPEN I-O (ACCESS IS DYNAMIC) OPTIONAL NOT EXISTING FILEIX2174.2 +045500* 05 EXPECTED *IX2174.2 +045600* IX-3, 1.3.4 (1) D *IX2174.2 +045700******************************************************************IX2174.2 +045800 SECT-IX-01-001 SECTION. IX2174.2 +045900 OPN-INIT-GF-01. IX2174.2 +046000 MOVE SPACES TO IX-FS1-STATUS. IX2174.2 +046100 MOVE "OPEN I-O: 05 EXP." TO FEATURE. IX2174.2 +046200 MOVE "OPN-TEST-GF-01 " TO PAR-NAME. IX2174.2 +046300 OPN-TEST-GF-01. IX2174.2 +046400 OPEN IX2174.2 +046500 I-O IX-FS1. IX2174.2 +046600 IF IX-FS1-STATUS = "05" IX2174.2 +046700 GO TO OPN-PASS-GF-01. IX2174.2 +046800 OPN-FAIL-GF-01. IX2174.2 +046900 MOVE "IX-3, 1.3.4, (1) D. " TO RE-MARK. IX2174.2 +047000 PERFORM FAIL. IX2174.2 +047100 MOVE IX-FS1-STATUS TO COMPUTED-A. IX2174.2 +047200 MOVE "05" TO CORRECT-X. IX2174.2 +047300 GO TO OPN-WRITE-GF-01. IX2174.2 +047400 OPN-PASS-GF-01. IX2174.2 +047500 PERFORM PASS. IX2174.2 +047600 OPN-WRITE-GF-01. IX2174.2 +047700 PERFORM PRINT-DETAIL. IX2174.2 +047800 IX2174.2 +047900******************************************************************IX2174.2 +048000* TEST 2 *IX2174.2 +048100* WRITE 00 EXPECTED *IX2174.2 +048200* IX-3, 1.3.4 (1) A *IX2174.2 +048300******************************************************************IX2174.2 +048400 WRI-INIT-GF-01. IX2174.2 +048500 MOVE 240 TO REC-LENGTH. IX2174.2 +048600 MOVE ZERO TO STATUS-ERROR. IX2174.2 +048700 MOVE "WRI-TEST-GF-01 " TO PAR-NAME IX2174.2 +048800 MOVE "WRITE (OPT)F 00 EXP." TO FEATURE. IX2174.2 +048900 MOVE "IX-FS1" TO XFILE-NAME (1). IX2174.2 +049000 MOVE "IX-F-G" TO XRECORD-NAME (1). IX2174.2 +049100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2174.2 +049200 MOVE 000240 TO XRECORD-LENGTH (1). IX2174.2 +049300 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2174.2 +049400 MOVE 0001 TO XBLOCK-SIZE (1). IX2174.2 +049500 MOVE 000500 TO RECORDS-IN-FILE (1). IX2174.2 +049600 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2174.2 +049700 MOVE "S" TO XLABEL-TYPE (1). IX2174.2 +049800 MOVE 000001 TO XRECORD-NUMBER (1). IX2174.2 +049900 WRI-TEST-GF-01. IX2174.2 +050000 MOVE XRECORD-NUMBER (1) TO WRK-DU-09V00-001. IX2174.2 +050100 MOVE GRP-0101 TO XRECORD-KEY (1). IX2174.2 +050200 MOVE FILE-RECORD-INFO (1) TO IX-FS1R1-F-G-240. IX2174.2 +050300 WRITE IX-FS1R1-F-G-240 IX2174.2 +050400 INVALID KEY GO TO WRI-FAIL-GF-01. IX2174.2 +050500 IF IX-FS1-STATUS NOT EQUAL TO "00" IX2174.2 +050600 MOVE 1 TO STATUS-ERROR. IX2174.2 +050700 IF XRECORD-NUMBER (1) EQUAL TO 50 IX2174.2 +050800 GO TO WRI-TEST-GF-01-1. IX2174.2 +050900 ADD 000001 TO XRECORD-NUMBER (1). IX2174.2 +051000 GO TO WRI-TEST-GF-01. IX2174.2 +051100 WRI-TEST-GF-01-1. IX2174.2 +051200 IF STATUS-ERROR EQUAL TO ZERO IX2174.2 +051300 GO TO WRI-PASS-GF-01. IX2174.2 +051400 WRI-FAIL-GF-01. IX2174.2 +051500 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX2174.2 +051600 PERFORM FAIL. IX2174.2 +051700 GO TO WRI-WRITE-GF-01. IX2174.2 +051800 WRI-PASS-GF-01. IX2174.2 +051900 PERFORM PASS. IX2174.2 +052000 WRI-WRITE-GF-01. IX2174.2 +052100 PERFORM PRINT-DETAIL. IX2174.2 +052200 IX2174.2 +052300 CLOSE IX-FS1. IX2174.2 +052400******************************************************************IX2174.2 +052500* TEST 3 *IX2174.2 +052600* READ 00 EXPECTED *IX2174.2 +052700* IX-3, 1.3.4 (1) A *IX2174.2 +052800******************************************************************IX2174.2 +052900 READ-INIT-F1-01. IX2174.2 +053000 OPEN INPUT IX-FS1. IX2174.2 +053100 MOVE ZERO TO WRK-DU-09V00-001. IX2174.2 +053200 READ-TEST-F1-01. IX2174.2 +053300 READ IX-FS1 NEXT RECORD IX2174.2 +053400 AT END GO TO READ-TEST-F1-01-1. IX2174.2 +053500 MOVE IX-FS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2174.2 +053600 ADD 1 TO WRK-DU-09V00-001. IX2174.2 +053700 IF WRK-DU-09V00-001 GREATER 50 IX2174.2 +053800 MOVE "MORE THAN 50 RECORDS" TO RE-MARK IX2174.2 +053900 GO TO READ-TEST-F1-01-1. IX2174.2 +054000 IF XRECORD-NUMBER (1) = WRK-DU-09V00-001 IX2174.2 +054100 GO TO READ-TEST-F1-01 IX2174.2 +054200 ELSE IX2174.2 +054300 MOVE "WRONG RECORD NUMBER" TO RE-MARK IX2174.2 +054400 PERFORM FAIL IX2174.2 +054500 MOVE "READ (TO VERIFY)" TO FEATURE IX2174.2 +054600 MOVE "READ-TEST-F1-01" TO PAR-NAME IX2174.2 +054700 PERFORM PRINT-DETAIL IX2174.2 +054800 GO TO READ-TEST-F1-01-3. IX2174.2 +054900 READ-TEST-F1-01-1. IX2174.2 +055000 IF XRECORD-NUMBER (1) NOT EQUAL TO 50 IX2174.2 +055100 PERFORM FAIL IX2174.2 +055200 ELSE IX2174.2 +055300 PERFORM PASS. IX2174.2 +055400 GO TO READ-TEST-F1-01-2. IX2174.2 +055500 READ-TEST-F1-01-2. IX2174.2 +055600 MOVE "READ (TO VERIFY) " TO FEATURE. IX2174.2 +055700 MOVE "READ-TEST-F1-01" TO PAR-NAME. IX2174.2 +055800 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. IX2174.2 +055900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX2174.2 +056000 PERFORM PRINT-DETAIL. IX2174.2 +056100 READ-TEST-F1-01-3. IX2174.2 +056200 CLOSE IX-FS1. IX2174.2 +056300 IX2174.2 +056400******************************************************************IX2174.2 +056500* TEST 4 *IX2174.2 +056600* OPEN EXTEND (ACCESS IS DYNAMIC) OPTIONAL NOT EXISTING FILEIX2174.2 +056700* 05 EXPECTED *IX2174.2 +056800* IX-3, 1.3.4 (1) D *IX2174.2 +056900******************************************************************IX2174.2 +057000 OPN-INIT-GF-02. IX2174.2 +057100 MOVE SPACES TO IX-VS1-STATUS. IX2174.2 +057200 MOVE "OPEN EXTEND: 05 EXP." TO FEATURE. IX2174.2 +057300 MOVE "OPN-TEST-GF-02 " TO PAR-NAME. IX2174.2 +057400 OPN-TEST-GF-02. IX2174.2 +057500 OPEN IX2174.2 +057600 EXTEND IX-VS1. IX2174.2 +057700 IF IX-VS1-STATUS = "05" IX2174.2 +057800 GO TO OPN-PASS-GF-02. IX2174.2 +057900 OPN-FAIL-GF-02. IX2174.2 +058000 MOVE "IX-3, 1.3.4, (1) D. " TO RE-MARK. IX2174.2 +058100 PERFORM FAIL. IX2174.2 +058200 MOVE IX-VS1-STATUS TO COMPUTED-A. IX2174.2 +058300 MOVE "05" TO CORRECT-X. IX2174.2 +058400 GO TO OPN-WRITE-GF-02. IX2174.2 +058500 OPN-PASS-GF-02. IX2174.2 +058600 PERFORM PASS. IX2174.2 +058700 OPN-WRITE-GF-02. IX2174.2 +058800 PERFORM PRINT-DETAIL. IX2174.2 +058900 IX2174.2 +059000******************************************************************IX2174.2 +059100* TEST 5 *IX2174.2 +059200* WRITE 00 EXPECTED *IX2174.2 +059300* IX-3, 1.3.4 (1) A *IX2174.2 +059400******************************************************************IX2174.2 +059500 WRI-INIT-GF-02. IX2174.2 +059600 MOVE 240 TO REC-LENGTH. IX2174.2 +059700 MOVE ZERO TO STATUS-ERROR. IX2174.2 +059800 MOVE "WRI-TEST-GF-02 " TO PAR-NAME IX2174.2 +059900 MOVE "WRITE (OPT)S 00 EXP." TO FEATURE. IX2174.2 +060000 MOVE "IX-VS1" TO XFILE-NAME (1). IX2174.2 +060100 MOVE " LONG " TO XRECORD-NAME (1). IX2174.2 +060200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). IX2174.2 +060300 MOVE 000240 TO XRECORD-LENGTH (1). IX2174.2 +060400 MOVE "RC" TO CHARS-OR-RECORDS (1). IX2174.2 +060500 MOVE 0001 TO XBLOCK-SIZE (1). IX2174.2 +060600 MOVE 000500 TO RECORDS-IN-FILE (1). IX2174.2 +060700 MOVE "IX" TO XFILE-ORGANIZATION (1). IX2174.2 +060800 MOVE "S" TO XLABEL-TYPE (1). IX2174.2 +060900 MOVE 000001 TO XRECORD-NUMBER (1). IX2174.2 +061000 WRI-TEST-GF-02. IX2174.2 +061100 MOVE XRECORD-NUMBER (1) TO WRK-DU-09V00-001. IX2174.2 +061200 MOVE GRP-0101 TO XRECORD-KEY (1). IX2174.2 +061300 MOVE FILE-RECORD-INFO (1) TO IX-VS1R1-F-G-240. IX2174.2 +061400 IF XRECORD-NUMBER (1) LESS THAN 26 IX2174.2 +061500 WRITE IX-VS1R1-F-G-240 IX2174.2 +061600 INVALID KEY GO TO WRI-FAIL-GF-02. IX2174.2 +061700 IF IX-VS1-STATUS NOT EQUAL TO "00" IX2174.2 +061800 MOVE 1 TO STATUS-ERROR. IX2174.2 +061900 IF XRECORD-NUMBER (1) GREATER THAN 25 IX2174.2 +062000 WRITE IX-VS1R1-F-G-200 IX2174.2 +062100 INVALID KEY GO TO WRI-FAIL-GF-02. IX2174.2 +062200 IF IX-VS1-STATUS NOT EQUAL TO "00" IX2174.2 +062300 MOVE 1 TO STATUS-ERROR. IX2174.2 +062400 IF XRECORD-NUMBER (1) EQUAL TO 50 IX2174.2 +062500 GO TO WRI-TEST-GF-02-1. IX2174.2 +062600 IF XRECORD-NUMBER (1) EQUAL TO 25 IX2174.2 +062700 MOVE " SHORT" TO XRECORD-NAME (1) IX2174.2 +062800 MOVE 200 TO REC-LENGTH IX2174.2 +062900 MOVE 000200 TO XRECORD-LENGTH (1). IX2174.2 +063000 ADD 000001 TO XRECORD-NUMBER (1). IX2174.2 +063100 GO TO WRI-TEST-GF-02. IX2174.2 +063200 WRI-TEST-GF-02-1. IX2174.2 +063300 IF STATUS-ERROR EQUAL TO ZERO IX2174.2 +063400 GO TO WRI-PASS-GF-02. IX2174.2 +063500 WRI-FAIL-GF-02. IX2174.2 +063600 MOVE "IX-3, 1.3.4, (1) A. " TO RE-MARK. IX2174.2 +063700 PERFORM FAIL. IX2174.2 +063800 GO TO WRI-WRITE-GF-02. IX2174.2 +063900 WRI-PASS-GF-02. IX2174.2 +064000 PERFORM PASS. IX2174.2 +064100 WRI-WRITE-GF-02. IX2174.2 +064200 PERFORM PRINT-DETAIL. IX2174.2 +064300 IX2174.2 +064400 CLOSE IX-VS1. IX2174.2 +064500******************************************************************IX2174.2 +064600* TEST 6 *IX2174.2 +064700* READ 00 EXPECTED *IX2174.2 +064800* IX-3, 1.3.4 (1) A *IX2174.2 +064900******************************************************************IX2174.2 +065000 READ-INIT-F1-02. IX2174.2 +065100 OPEN INPUT IX-VS1. IX2174.2 +065200 MOVE ZERO TO WRK-DU-09V00-001. IX2174.2 +065300 READ-TEST-F1-02. IX2174.2 +065400 READ IX-VS1 NEXT RECORD IX2174.2 +065500 AT END GO TO READ-TEST-F1-02-1. IX2174.2 +065600 MOVE IX-VS1R1-F-G-240 TO FILE-RECORD-INFO (1). IX2174.2 +065700 ADD 1 TO WRK-DU-09V00-001. IX2174.2 +065800 IF WRK-DU-09V00-001 GREATER 50 IX2174.2 +065900 MOVE "MORE THAN 50 RECORDS" TO RE-MARK IX2174.2 +066000 GO TO READ-TEST-F1-02-1. IX2174.2 +066100 IF XRECORD-NUMBER (1) = WRK-DU-09V00-001 IX2174.2 +066200 GO TO READ-TEST-F1-02 IX2174.2 +066300 ELSE IX2174.2 +066400 MOVE "WRONG RECORD NUMBER" TO RE-MARK IX2174.2 +066500 PERFORM FAIL IX2174.2 +066600 MOVE "READ (TO VERIFY)" TO FEATURE IX2174.2 +066700 MOVE "READ-TEST-F1-02" TO PAR-NAME IX2174.2 +066800 PERFORM PRINT-DETAIL IX2174.2 +066900 GO TO READ-TEST-F1-02-3. IX2174.2 +067000 READ-TEST-F1-02-1. IX2174.2 +067100 IF XRECORD-NUMBER (1) NOT EQUAL TO 50 IX2174.2 +067200 PERFORM FAIL IX2174.2 +067300 ELSE IX2174.2 +067400 PERFORM PASS. IX2174.2 +067500 READ-TEST-F1-02-2. IX2174.2 +067600 MOVE "READ (TO VERIFY) " TO FEATURE. IX2174.2 +067700 MOVE "READ-TEST-F1-02" TO PAR-NAME. IX2174.2 +067800 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. IX2174.2 +067900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. IX2174.2 +068000 PERFORM PRINT-DETAIL. IX2174.2 +068100 READ-TEST-F1-02-3. IX2174.2 +068200 CLOSE IX-VS1. IX2174.2 +068300 IX2174.2 +068400 IX2174.2 +068500 CCVS-EXIT SECTION. IX2174.2 +068600 CCVS-999999. IX2174.2 +068700 GO TO CLOSE-FILES. IX2174.2 diff --git a/tests/cobol85/IX/IX218A.CBL b/tests/cobol85/IX/IX218A.CBL new file mode 100755 index 00000000..2daff375 --- /dev/null +++ b/tests/cobol85/IX/IX218A.CBL @@ -0,0 +1,613 @@ +000100 IDENTIFICATION DIVISION. IX2184.2 +000200 PROGRAM-ID. IX2184.2 +000300 IX218A. IX2184.2 +000400**************************************************************** IX2184.2 +000500* * IX2184.2 +000600* VALIDATION FOR:- * IX2184.2 +000700* * IX2184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2184.2 +000900* * IX2184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2184.2 +001100* * IX2184.2 +001200**************************************************************** IX2184.2 +001300* IX2184.2 +001400* 1. THE FUNCTION OF THIS PROGRAM IS TO CHECK THE SEQUENTIAL IX2184.2 +001500* READ STATEMENT FOR A NOT EXISTING OPTIONAL INDEXED FILE. IX2184.2 +001600* THE READ STATEMENT WITHOUT AN OPEN STATEMENT FOR SUCH A IX2184.2 +001700* FILE MUST CAUSE THE AT END CONDITION AND THE FILE STATUS IX2184.2 +001800* CODE 10. THIS CODE IS CHECKED HERE. THE NAME OF THE FILE IX2184.2 +001900* IS IX-FS1. THE AT END PHRASE IS SPECIFIED. THAT MEANS IX2184.2 +002000* THAT ANY USE AFTER STANDARD EXCEPTION PROCEDURE MUST NOT IX2184.2 +002100* BE EXECUTED. IX2184.2 +002200* IX2184.2 +002300* 2. ANOTHER FUNCTION OF THIS PROGRAM IS TO CHECK THE START IX2184.2 +002400* AND THE RANDOM READ STATEMENTS FOR A NOT EXISTING IX2184.2 +002500* OPTIONAL INDEXED FILE. BOTH ATTEMPTS SHOULD CAUSE THE IX2184.2 +002600* FILE STATUS CODE 23. THE INVALID KEY PHRASE IS SPECIFIED IX2184.2 +002700* AND THE USE AFTER STANDARD EXCEPTION PROCEDURE MUST NOT IX2184.2 +002800* BE EXECUTED. THE NAME OF THE FILE IS IX-FS2. IX2184.2 +002900* IX2184.2 +003000* IX2184.2 +003100* IX2184.2 +003200* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE IX2184.2 +003300* IX2184.2 +003400* X-24 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2184.2 +003500* CLAUSE FOR DATA FILE IX-FS1 IX2184.2 +003600* X-25 INDEXED FILE IMPLEMENTOR-NAME IN ASSGN TO IX2184.2 +003700* CLAUSE FOR DATA FILE IX-FS1 IX2184.2 +003800* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER IX2184.2 +003900* X-62 IMPLEMENTOR-NAME FOR RAW-DATA (OPTIONAL) IX2184.2 +004000* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER IX2184.2 +004100* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER IX2184.2 +004200* X-84 IMPLEMENTOR-NAME FOR PRINT-FILE IX2184.2 +004300* IX2184.2 +004400* NOTE: X-CARDS 44, 45 AND 62 ARE OPTIONAL IX2184.2 +004500* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- IX2184.2 +004600* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM IX2184.2 +004700* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS IX2184.2 +004800* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED IX2184.2 +004900* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE IX2184.2 +005000* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE IX2184.2 +005100* CONTROL CARD. THE LETTER CORRESPONDS TO A IX2184.2 +005200* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND IX2184.2 +005300* THEY ARE AS FOLLOWS IX2184.2 +005400* IX2184.2 +005500* J SELECTS X-CARD 44 IX2184.2 +005600* J SELECTS X-CARD 45 IX2184.2 +005700* P SELECTS X-CARD 62 IX2184.2 +005800* C SELECTS X-CARD 84 IX2184.2 +005900* IX2184.2 +006000****************************************************** IX2184.2 +006100 ENVIRONMENT DIVISION. IX2184.2 +006200 CONFIGURATION SECTION. IX2184.2 +006300 SOURCE-COMPUTER. IX2184.2 +006400 Linux. IX2184.2 +006500 OBJECT-COMPUTER. IX2184.2 +006600 Linux. IX2184.2 +006700 INPUT-OUTPUT SECTION. IX2184.2 +006800 FILE-CONTROL. IX2184.2 +006900*P SELECT RAW-DATA ASSIGN TO IX2184.2 +007000*P "XXXXX062" IX2184.2 +007100*P ORGANIZATION IS INDEXED IX2184.2 +007200*P ACCESS MODE IS RANDOM IX2184.2 +007300*P RECORD KEY IS RAW-DATA-KEY. IX2184.2 +007400 SELECT PRINT-FILE ASSIGN TO IX2184.2 +007500 "report.log". IX2184.2 +007600 IX2184.2 +007700 SELECT OPTIONAL IX-FS1 ASSIGN TO IX2184.2 +007800* SELECT IX-FS1 ASSIGN TO IX2184.2 +007900 "XXXXX024" IX2184.2 +008000*J **** X-CARD UNDEFINED **** IX2184.2 +008100 ORGANIZATION IS INDEXED IX2184.2 +008200 RECORD KEY IS IX-FS1-KEY IX2184.2 +008300 ACCESS MODE IS SEQUENTIAL IX2184.2 +008400 FILE STATUS IS IX-FS1-STATUS. IX2184.2 +008500 IX2184.2 +008600 SELECT OPTIONAL IX-FS2 ASSIGN TO IX2184.2 +008700* SELECT IX-FS2 ASSIGN TO IX2184.2 +008800 "XXXXX025" IX2184.2 +008900*J **** X-CARD UNDEFINED **** IX2184.2 +009000 ORGANIZATION IS INDEXED IX2184.2 +009100 RECORD KEY IS IX-FS2-KEY IX2184.2 +009200 ACCESS MODE IS DYNAMIC IX2184.2 +009300 FILE STATUS IS IX-FS2-STATUS. IX2184.2 +009400 IX2184.2 +009500 DATA DIVISION. IX2184.2 +009600 FILE SECTION. IX2184.2 +009700*P IX2184.2 +009800*PD RAW-DATA. IX2184.2 +009900*P IX2184.2 +010000*P1 RAW-DATA-SATZ. IX2184.2 +010100*P 05 RAW-DATA-KEY PIC X(6). IX2184.2 +010200*P 05 C-DATE PIC 9(6). IX2184.2 +010300*P 05 C-TIME PIC 9(8). IX2184.2 +010400*P 05 C-NO-OF-TESTS PIC 99. IX2184.2 +010500*P 05 C-OK PIC 999. IX2184.2 +010600*P 05 C-ALL PIC 999. IX2184.2 +010700*P 05 C-FAIL PIC 999. IX2184.2 +010800*P 05 C-DELETED PIC 999. IX2184.2 +010900*P 05 C-INSPECT PIC 999. IX2184.2 +011000*P 05 C-NOTE PIC X(13). IX2184.2 +011100*P 05 C-INDENT PIC X. IX2184.2 +011200*P 05 C-ABORT PIC X(8). IX2184.2 +011300 FD PRINT-FILE. IX2184.2 +011400 01 PRINT-REC PICTURE X(120). IX2184.2 +011500 01 DUMMY-RECORD PICTURE X(120). IX2184.2 +011600 IX2184.2 +011700 FD IX-FS1 IX2184.2 +011800*C LABEL RECORD IS STANDARD IX2184.2 +011900*C DATA RECORD IS IX-FS1R1-F-G-240 IX2184.2 +012000 BLOCK CONTAINS 1 RECORDS IX2184.2 +012100 RECORD CONTAINS 240 CHARACTERS. IX2184.2 +012200 01 IX-FS1R1-F-G-240. IX2184.2 +012300 03 IX-FS1-WRK-120 PIC X(120). IX2184.2 +012400 03 IX-FS1-GRP-120. IX2184.2 +012500 05 FILLER PIC X(8). IX2184.2 +012600 05 IX-FS1-KEY PIC X(29). IX2184.2 +012700 05 FILLER PIC X(83). IX2184.2 +012800 IX2184.2 +012900 FD IX-FS2 IX2184.2 +013000*C LABEL RECORD IS STANDARD IX2184.2 +013100*C DATA RECORD IS IX-FS2R1-F-G-240 IX2184.2 +013200 BLOCK CONTAINS 1 RECORDS IX2184.2 +013300 RECORD CONTAINS 240 CHARACTERS. IX2184.2 +013400 01 IX-FS2R1-F-G-240. IX2184.2 +013500 03 IX-FS2-WRK-120 PIC X(120). IX2184.2 +013600 03 IX-FS2-GRP-120. IX2184.2 +013700 05 FILLER PIC X(8). IX2184.2 +013800 05 IX-FS2-KEY PIC X(29). IX2184.2 +013900 05 FILLER PIC X(83). IX2184.2 +014000 IX2184.2 +014100 WORKING-STORAGE SECTION. IX2184.2 +014200 01 EOF-FLAG PIC 9 VALUE ZERO. IX2184.2 +014300 IX2184.2 +014400 01 IX-FS1-STATUS. IX2184.2 +014500 05 IX-FS1-STAT1 PIC X. IX2184.2 +014600 05 IX-FS1-STAT2 PIC X. IX2184.2 +014700 IX2184.2 +014800 01 IX-FS2-STATUS. IX2184.2 +014900 05 IX-FS2-STAT1 PIC X. IX2184.2 +015000 05 IX-FS2-STAT2 PIC X. IX2184.2 +015100 IX2184.2 +015200 01 TEST-RESULTS. IX2184.2 +015300 02 FILLER PIC X VALUE SPACE. IX2184.2 +015400 02 FEATURE PIC X(20) VALUE SPACE. IX2184.2 +015500 02 FILLER PIC X VALUE SPACE. IX2184.2 +015600 02 P-OR-F PIC X(5) VALUE SPACE. IX2184.2 +015700 02 FILLER PIC X VALUE SPACE. IX2184.2 +015800 02 PAR-NAME. IX2184.2 +015900 03 FILLER PIC X(19) VALUE SPACE. IX2184.2 +016000 03 PARDOT-X PIC X VALUE SPACE. IX2184.2 +016100 03 DOTVALUE PIC 99 VALUE ZERO. IX2184.2 +016200 02 FILLER PIC X(8) VALUE SPACE. IX2184.2 +016300 02 RE-MARK PIC X(61). IX2184.2 +016400 01 TEST-COMPUTED. IX2184.2 +016500 02 FILLER PIC X(30) VALUE SPACE. IX2184.2 +016600 02 FILLER PIC X(17) VALUE IX2184.2 +016700 " COMPUTED=". IX2184.2 +016800 02 COMPUTED-X. IX2184.2 +016900 03 COMPUTED-A PIC X(20) VALUE SPACE. IX2184.2 +017000 03 COMPUTED-N REDEFINES COMPUTED-A IX2184.2 +017100 PIC -9(9).9(9). IX2184.2 +017200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IX2184.2 +017300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IX2184.2 +017400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IX2184.2 +017500 03 CM-18V0 REDEFINES COMPUTED-A. IX2184.2 +017600 04 COMPUTED-18V0 PIC -9(18). IX2184.2 +017700 04 FILLER PIC X. IX2184.2 +017800 03 FILLER PIC X(50) VALUE SPACE. IX2184.2 +017900 01 TEST-CORRECT. IX2184.2 +018000 02 FILLER PIC X(30) VALUE SPACE. IX2184.2 +018100 02 FILLER PIC X(17) VALUE " CORRECT =". IX2184.2 +018200 02 CORRECT-X. IX2184.2 +018300 03 CORRECT-A PIC X(20) VALUE SPACE. IX2184.2 +018400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IX2184.2 +018500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IX2184.2 +018600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IX2184.2 +018700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IX2184.2 +018800 03 CR-18V0 REDEFINES CORRECT-A. IX2184.2 +018900 04 CORRECT-18V0 PIC -9(18). IX2184.2 +019000 04 FILLER PIC X. IX2184.2 +019100 03 FILLER PIC X(2) VALUE SPACE. IX2184.2 +019200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IX2184.2 +019300 01 CCVS-C-1. IX2184.2 +019400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIX2184.2 +019500- "SS PARAGRAPH-NAME IX2184.2 +019600- " REMARKS". IX2184.2 +019700 02 FILLER PIC X(20) VALUE SPACE. IX2184.2 +019800 01 CCVS-C-2. IX2184.2 +019900 02 FILLER PIC X VALUE SPACE. IX2184.2 +020000 02 FILLER PIC X(6) VALUE "TESTED". IX2184.2 +020100 02 FILLER PIC X(15) VALUE SPACE. IX2184.2 +020200 02 FILLER PIC X(4) VALUE "FAIL". IX2184.2 +020300 02 FILLER PIC X(94) VALUE SPACE. IX2184.2 +020400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IX2184.2 +020500 01 REC-CT PIC 99 VALUE ZERO. IX2184.2 +020600 01 DELETE-COUNTER PIC 999 VALUE ZERO. IX2184.2 +020700 01 ERROR-COUNTER PIC 999 VALUE ZERO. IX2184.2 +020800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IX2184.2 +020900 01 PASS-COUNTER PIC 999 VALUE ZERO. IX2184.2 +021000 01 TOTAL-ERROR PIC 999 VALUE ZERO. IX2184.2 +021100 01 ERROR-HOLD PIC 999 VALUE ZERO. IX2184.2 +021200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IX2184.2 +021300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IX2184.2 +021400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IX2184.2 +021500 01 CCVS-H-1. IX2184.2 +021600 02 FILLER PIC X(39) VALUE SPACES. IX2184.2 +021700 02 FILLER PIC X(42) VALUE IX2184.2 +021800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IX2184.2 +021900 02 FILLER PIC X(39) VALUE SPACES. IX2184.2 +022000 01 CCVS-H-2A. IX2184.2 +022100 02 FILLER PIC X(40) VALUE SPACE. IX2184.2 +022200 02 FILLER PIC X(7) VALUE "CCVS85 ". IX2184.2 +022300 02 FILLER PIC XXXX VALUE IX2184.2 +022400 "4.2 ". IX2184.2 +022500 02 FILLER PIC X(28) VALUE IX2184.2 +022600 " COPY - NOT FOR DISTRIBUTION". IX2184.2 +022700 02 FILLER PIC X(41) VALUE SPACE. IX2184.2 +022800 IX2184.2 +022900 01 CCVS-H-2B. IX2184.2 +023000 02 FILLER PIC X(15) VALUE IX2184.2 +023100 "TEST RESULT OF ". IX2184.2 +023200 02 TEST-ID PIC X(9). IX2184.2 +023300 02 FILLER PIC X(4) VALUE IX2184.2 +023400 " IN ". IX2184.2 +023500 02 FILLER PIC X(12) VALUE IX2184.2 +023600 " HIGH ". IX2184.2 +023700 02 FILLER PIC X(22) VALUE IX2184.2 +023800 " LEVEL VALIDATION FOR ". IX2184.2 +023900 02 FILLER PIC X(58) VALUE IX2184.2 +024000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2184.2 +024100 01 CCVS-H-3. IX2184.2 +024200 02 FILLER PIC X(34) VALUE IX2184.2 +024300 " FOR OFFICIAL USE ONLY ". IX2184.2 +024400 02 FILLER PIC X(58) VALUE IX2184.2 +024500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IX2184.2 +024600 02 FILLER PIC X(28) VALUE IX2184.2 +024700 " COPYRIGHT 1985 ". IX2184.2 +024800 01 CCVS-E-1. IX2184.2 +024900 02 FILLER PIC X(52) VALUE SPACE. IX2184.2 +025000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IX2184.2 +025100 02 ID-AGAIN PIC X(9). IX2184.2 +025200 02 FILLER PIC X(45) VALUE SPACES. IX2184.2 +025300 01 CCVS-E-2. IX2184.2 +025400 02 FILLER PIC X(31) VALUE SPACE. IX2184.2 +025500 02 FILLER PIC X(21) VALUE SPACE. IX2184.2 +025600 02 CCVS-E-2-2. IX2184.2 +025700 03 ERROR-TOTAL PIC XXX VALUE SPACE. IX2184.2 +025800 03 FILLER PIC X VALUE SPACE. IX2184.2 +025900 03 ENDER-DESC PIC X(44) VALUE IX2184.2 +026000 "ERRORS ENCOUNTERED". IX2184.2 +026100 01 CCVS-E-3. IX2184.2 +026200 02 FILLER PIC X(22) VALUE IX2184.2 +026300 " FOR OFFICIAL USE ONLY". IX2184.2 +026400 02 FILLER PIC X(12) VALUE SPACE. IX2184.2 +026500 02 FILLER PIC X(58) VALUE IX2184.2 +026600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IX2184.2 +026700 02 FILLER PIC X(13) VALUE SPACE. IX2184.2 +026800 02 FILLER PIC X(15) VALUE IX2184.2 +026900 " COPYRIGHT 1985". IX2184.2 +027000 01 CCVS-E-4. IX2184.2 +027100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IX2184.2 +027200 02 FILLER PIC X(4) VALUE " OF ". IX2184.2 +027300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IX2184.2 +027400 02 FILLER PIC X(40) VALUE IX2184.2 +027500 " TESTS WERE EXECUTED SUCCESSFULLY". IX2184.2 +027600 01 XXINFO. IX2184.2 +027700 02 FILLER PIC X(19) VALUE IX2184.2 +027800 "*** INFORMATION ***". IX2184.2 +027900 02 INFO-TEXT. IX2184.2 +028000 04 FILLER PIC X(8) VALUE SPACE. IX2184.2 +028100 04 XXCOMPUTED PIC X(20). IX2184.2 +028200 04 FILLER PIC X(5) VALUE SPACE. IX2184.2 +028300 04 XXCORRECT PIC X(20). IX2184.2 +028400 02 INF-ANSI-REFERENCE PIC X(48). IX2184.2 +028500 01 HYPHEN-LINE. IX2184.2 +028600 02 FILLER PIC IS X VALUE IS SPACE. IX2184.2 +028700 02 FILLER PIC IS X(65) VALUE IS "************************IX2184.2 +028800- "*****************************************". IX2184.2 +028900 02 FILLER PIC IS X(54) VALUE IS "************************IX2184.2 +029000- "******************************". IX2184.2 +029100 01 CCVS-PGM-ID PIC X(9) VALUE IX2184.2 +029200 "IX218A". IX2184.2 +029300 PROCEDURE DIVISION. IX2184.2 +029400 DECLARATIVES. IX2184.2 +029500 IX2184.2 +029600 READ-OPTIONAL-10 SECTION. IX2184.2 +029700 USE AFTER EXCEPTION PROCEDURE ON IX-FS1. IX2184.2 +029800 INPUT-PROCESS. IX2184.2 +029900 MOVE 1 TO EOF-FLAG. IX2184.2 +030000 IX2184.2 +030100 READ-OPTIONAL-23 SECTION. IX2184.2 +030200 USE AFTER EXCEPTION PROCEDURE ON IX-FS2. IX2184.2 +030300 INPUT-PROCESS. IX2184.2 +030400 MOVE 1 TO EOF-FLAG. IX2184.2 +030500 IX2184.2 +030600 END DECLARATIVES. IX2184.2 +030700 IX2184.2 +030800 CCVS1 SECTION. IX2184.2 +030900 OPEN-FILES. IX2184.2 +031000*P OPEN I-O RAW-DATA. IX2184.2 +031100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2184.2 +031200*P READ RAW-DATA INVALID KEY GO TO END-E-1. IX2184.2 +031300*P MOVE "ABORTED " TO C-ABORT. IX2184.2 +031400*P ADD 1 TO C-NO-OF-TESTS. IX2184.2 +031500*P ACCEPT C-DATE FROM DATE. IX2184.2 +031600*P ACCEPT C-TIME FROM TIME. IX2184.2 +031700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. IX2184.2 +031800*PND-E-1. IX2184.2 +031900*P CLOSE RAW-DATA. IX2184.2 +032000 OPEN OUTPUT PRINT-FILE. IX2184.2 +032100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IX2184.2 +032200 MOVE SPACE TO TEST-RESULTS. IX2184.2 +032300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IX2184.2 +032400 GO TO CCVS1-EXIT. IX2184.2 +032500 CLOSE-FILES. IX2184.2 +032600*P OPEN I-O RAW-DATA. IX2184.2 +032700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. IX2184.2 +032800*P READ RAW-DATA INVALID KEY GO TO END-E-2. IX2184.2 +032900*P MOVE "OK. " TO C-ABORT. IX2184.2 +033000*P MOVE PASS-COUNTER TO C-OK. IX2184.2 +033100*P MOVE ERROR-HOLD TO C-ALL. IX2184.2 +033200*P MOVE ERROR-COUNTER TO C-FAIL. IX2184.2 +033300*P MOVE DELETE-COUNTER TO C-DELETED. IX2184.2 +033400*P MOVE INSPECT-COUNTER TO C-INSPECT. IX2184.2 +033500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. IX2184.2 +033600*PND-E-2. IX2184.2 +033700*P CLOSE RAW-DATA IX-FS1 IX-FS2. IX2184.2 +033800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IX2184.2 +033900 TERMINATE-CCVS. IX2184.2 +034000*S EXIT PROGRAM. IX2184.2 +034100*SERMINATE-CALL. IX2184.2 +034200 STOP RUN. IX2184.2 +034300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IX2184.2 +034400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IX2184.2 +034500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IX2184.2 +034600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IX2184.2 +034700 MOVE "****TEST DELETED****" TO RE-MARK. IX2184.2 +034800 PRINT-DETAIL. IX2184.2 +034900 IF REC-CT NOT EQUAL TO ZERO IX2184.2 +035000 MOVE "." TO PARDOT-X IX2184.2 +035100 MOVE REC-CT TO DOTVALUE. IX2184.2 +035200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IX2184.2 +035300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IX2184.2 +035400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IX2184.2 +035500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IX2184.2 +035600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IX2184.2 +035700 MOVE SPACE TO CORRECT-X. IX2184.2 +035800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IX2184.2 +035900 MOVE SPACE TO RE-MARK. IX2184.2 +036000 HEAD-ROUTINE. IX2184.2 +036100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +036200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +036300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2184.2 +036400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IX2184.2 +036500 COLUMN-NAMES-ROUTINE. IX2184.2 +036600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +036700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +036800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +036900 END-ROUTINE. IX2184.2 +037000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IX2184.2 +037100 END-RTN-EXIT. IX2184.2 +037200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +037300 END-ROUTINE-1. IX2184.2 +037400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IX2184.2 +037500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IX2184.2 +037600 ADD PASS-COUNTER TO ERROR-HOLD. IX2184.2 +037700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IX2184.2 +037800 MOVE PASS-COUNTER TO CCVS-E-4-1. IX2184.2 +037900 MOVE ERROR-HOLD TO CCVS-E-4-2. IX2184.2 +038000 MOVE CCVS-E-4 TO CCVS-E-2-2. IX2184.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IX2184.2 +038200 END-ROUTINE-12. IX2184.2 +038300 MOVE "TEST(S) FAILED" TO ENDER-DESC. IX2184.2 +038400 IF ERROR-COUNTER IS EQUAL TO ZERO IX2184.2 +038500 MOVE "NO " TO ERROR-TOTAL IX2184.2 +038600 ELSE IX2184.2 +038700 MOVE ERROR-COUNTER TO ERROR-TOTAL. IX2184.2 +038800 MOVE CCVS-E-2 TO DUMMY-RECORD. IX2184.2 +038900 PERFORM WRITE-LINE. IX2184.2 +039000 END-ROUTINE-13. IX2184.2 +039100 IF DELETE-COUNTER IS EQUAL TO ZERO IX2184.2 +039200 MOVE "NO " TO ERROR-TOTAL ELSE IX2184.2 +039300 MOVE DELETE-COUNTER TO ERROR-TOTAL. IX2184.2 +039400 MOVE "TEST(S) DELETED " TO ENDER-DESC. IX2184.2 +039500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +039600 IF INSPECT-COUNTER EQUAL TO ZERO IX2184.2 +039700 MOVE "NO " TO ERROR-TOTAL IX2184.2 +039800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IX2184.2 +039900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IX2184.2 +040000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +040100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IX2184.2 +040200 WRITE-LINE. IX2184.2 +040300 ADD 1 TO RECORD-COUNT. IX2184.2 +040400 IF RECORD-COUNT GREATER 42 IX2184.2 +040500 MOVE DUMMY-RECORD TO DUMMY-HOLD IX2184.2 +040600 MOVE SPACE TO DUMMY-RECORD IX2184.2 +040700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IX2184.2 +040800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2184.2 +040900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IX2184.2 +041000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2184.2 +041100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IX2184.2 +041200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IX2184.2 +041300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IX2184.2 +041400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IX2184.2 +041500 MOVE DUMMY-HOLD TO DUMMY-RECORD IX2184.2 +041600 MOVE ZERO TO RECORD-COUNT. IX2184.2 +041700 PERFORM WRT-LN. IX2184.2 +041800 WRT-LN. IX2184.2 +041900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IX2184.2 +042000 MOVE SPACE TO DUMMY-RECORD. IX2184.2 +042100 BLANK-LINE-PRINT. IX2184.2 +042200 PERFORM WRT-LN. IX2184.2 +042300 FAIL-ROUTINE. IX2184.2 +042400 IF COMPUTED-X NOT EQUAL TO SPACE IX2184.2 +042500 GO TO FAIL-ROUTINE-WRITE. IX2184.2 +042600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IX2184.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2184.2 +042800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IX2184.2 +042900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. IX2184.2 +043100 GO TO FAIL-ROUTINE-EX. IX2184.2 +043200 FAIL-ROUTINE-WRITE. IX2184.2 +043300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IX2184.2 +043400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IX2184.2 +043500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IX2184.2 +043600 MOVE SPACES TO COR-ANSI-REFERENCE. IX2184.2 +043700 FAIL-ROUTINE-EX. EXIT. IX2184.2 +043800 BAIL-OUT. IX2184.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IX2184.2 +044000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IX2184.2 +044100 BAIL-OUT-WRITE. IX2184.2 +044200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IX2184.2 +044300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IX2184.2 +044400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IX2184.2 +044500 MOVE SPACES TO INF-ANSI-REFERENCE. IX2184.2 +044600 BAIL-OUT-EX. EXIT. IX2184.2 +044700 CCVS1-EXIT. IX2184.2 +044800 EXIT. IX2184.2 +044900 IX2184.2 +045000******************************************************************IX2184.2 +045100* TEST 1 *IX2184.2 +045200* READ (ACCESS IS SEQUENTIAL) OPTIONAL NOT EXISTING FILEIX2184.2 +045300* 10 EXPECTED *IX2184.2 +045400* IX-4, 1.3.4 (2) A 2); *IX2184.2 +045500* IX-29, 4.5.4 GR (4) B; *IX2184.2 +045600* IX-30, 4.5.4 GR (10) A; *IX2184.2 +045700* IX-30, 4.5.4 GR (10) B; *IX2184.2 +045800******************************************************************IX2184.2 +045900 SECT-IX-01-001 SECTION. IX2184.2 +046000 REA-INIT-F1-01. IX2184.2 +046100 MOVE ZERO TO EOF-FLAG. IX2184.2 +046200 MOVE SPACES TO IX-FS1-STATUS. IX2184.2 +046300 MOVE "READ OPTION. 10 EXP." TO FEATURE. IX2184.2 +046400 MOVE "REA-TEST-F1-01 " TO PAR-NAME. IX2184.2 +046500 OPEN INPUT IX-FS1. IX2184.2 +046600 REA-TEST-F1-01. IX2184.2 +046700 READ IX-FS1 AT END GO TO REA-TEST-F1-01-1. IX2184.2 +046800 REA-TEST-F1-01-1. IX2184.2 +046900 IF IX-FS1-STATUS EQUAL TO "10" IX2184.2 +047000 GO TO REA-PASS-F1-01. IX2184.2 +047100 REA-FAIL-F1-01. IX2184.2 +047200 MOVE "IX-4, 1.3.4, (2) A 2); IX-29 GR (4) B IX-30 GR (10) A,IX2184.2 +047300- " B" TO RE-MARK. IX2184.2 +047400 PERFORM FAIL. IX2184.2 +047500 MOVE IX-FS1-STATUS TO COMPUTED-A. IX2184.2 +047600 MOVE "10" TO CORRECT-X. IX2184.2 +047700 GO TO REA-WRITE-F1-01. IX2184.2 +047800 REA-PASS-F1-01. IX2184.2 +047900 PERFORM PASS. IX2184.2 +048000 REA-WRITE-F1-01. IX2184.2 +048100 PERFORM PRINT-DETAIL. IX2184.2 +048200 IX2184.2 +048300******************************************************************IX2184.2 +048400* TEST 2 *IX2184.2 +048500* READ I-O (ACCESS IS DYNAMIC) OPTIONAL NOT EXISTING FILEIX2184.2 +048600* *IX2184.2 +048700* IX-30, GR (10) B *IX2184.2 +048800******************************************************************IX2184.2 +048900 REA-INIT-GF-02. IX2184.2 +049000 MOVE "REA-TEST-GF-02 " TO PAR-NAME. IX2184.2 +049100 MOVE "NO USE MUST BE EXEC." TO FEATURE. IX2184.2 +049200 REA-TEST-GF-02. IX2184.2 +049300 IF EOF-FLAG EQUAL TO 0 IX2184.2 +049400 GO TO REA-PASS-GF-02. IX2184.2 +049500 REA-FAIL-GF-02. IX2184.2 +049600 MOVE "IX-30, GR (10) B; 1: USE PROCEDURE HAS BEEN EXECUTED" IX2184.2 +049700 TO RE-MARK. IX2184.2 +049800 PERFORM FAIL. IX2184.2 +049900 MOVE EOF-FLAG TO COMPUTED-N. IX2184.2 +050000 MOVE " 0" TO CORRECT-X. IX2184.2 +050100 GO TO REA-WRITE-GF-02. IX2184.2 +050200 REA-PASS-GF-02. IX2184.2 +050300 PERFORM PASS. IX2184.2 +050400 REA-WRITE-GF-02. IX2184.2 +050500 PERFORM PRINT-DETAIL. IX2184.2 +050600 IX2184.2 +050700******************************************************************IX2184.2 +050800* TEST 3 *IX2184.2 +050900* START (FOR AN OPTIONAL FILE WHICH IS NOT PRESENT) *IX2184.2 +051000* IX-4, 1.3.4 (3) C 2) 23 EXPECTED *IX2184.2 +051100******************************************************************IX2184.2 +051200 STA-INIT-GF-01. IX2184.2 +051300 MOVE ZERO TO EOF-FLAG. IX2184.2 +051400 MOVE SPACES TO IX-FS2-STATUS. IX2184.2 +051500 MOVE "STA-TEST-GF-01 " TO PAR-NAME. IX2184.2 +051600 MOVE "START OPT. 23 EXP." TO FEATURE. IX2184.2 +051700 OPEN INPUT IX-FS2. IX2184.2 +051800 STA-TEST-GF-01. IX2184.2 +051900 START IX-FS2 INVALID KEY GO TO STA-TEST-GF-01-1. IX2184.2 +052000 STA-TEST-GF-01-1. IX2184.2 +052100 IF IX-FS2-STATUS EQUAL TO "23" IX2184.2 +052200 GO TO STA-PASS-GF-01. IX2184.2 +052300 STA-FAIL-GF-01. IX2184.2 +052400 MOVE "IX-4, 1.3.4,(3) C 2)" TO RE-MARK. IX2184.2 +052500 PERFORM FAIL. IX2184.2 +052600 MOVE IX-FS2-STATUS TO COMPUTED-A. IX2184.2 +052700 MOVE "23" TO CORRECT-X. IX2184.2 +052800 GO TO STA-WRITE-GF-01. IX2184.2 +052900 STA-PASS-GF-01. IX2184.2 +053000 PERFORM PASS. IX2184.2 +053100 STA-WRITE-GF-01. IX2184.2 +053200 PERFORM PRINT-DETAIL. IX2184.2 +053300 IX2184.2 +053400******************************************************************IX2184.2 +053500* TEST 4 *IX2184.2 +053600* START (NO USE PROCEDURE MUST BE EXECUTED BECAUSE *IX2184.2 +053700* THE INVALID KEY PHRASE IS SPECIFIED) *IX2184.2 +053800* IX-37, 4.7.4, (5), (6) AND (7) *IX2184.2 +053900******************************************************************IX2184.2 +054000 STA-INIT-GF-02. IX2184.2 +054100 MOVE "STA-TEST-GF-02 " TO PAR-NAME. IX2184.2 +054200 MOVE "START NO USE EXP." TO FEATURE. IX2184.2 +054300 STA-TEST-GF-02. IX2184.2 +054400 IF EOF-FLAG EQUAL TO ZERO IX2184.2 +054500 GO TO STA-PASS-GF-02. IX2184.2 +054600 STA-FAIL-GF-02. IX2184.2 +054700 MOVE "IX-37 4.7.4,(5,6,7); 1:USE PROCEDURE HAS BEEN EXECUTED"IX2184.2 +054800 TO RE-MARK. IX2184.2 +054900 PERFORM FAIL. IX2184.2 +055000 MOVE EOF-FLAG TO COMPUTED-N. IX2184.2 +055100 MOVE "0" TO CORRECT-X. IX2184.2 +055200 GO TO STA-WRITE-GF-02. IX2184.2 +055300 STA-PASS-GF-02. IX2184.2 +055400 PERFORM PASS. IX2184.2 +055500 STA-WRITE-GF-02. IX2184.2 +055600 PERFORM PRINT-DETAIL. IX2184.2 +055700 IX2184.2 +055800******************************************************************IX2184.2 +055900* TEST 5 *IX2184.2 +056000* READ (RANDOM) (FOR AN OPTIONAL FILE WHICH IS NOT PRESENT) *IX2184.2 +056100* IX-4, 1.3.4 (3) C 2) *IX2184.2 +056200******************************************************************IX2184.2 +056300 REA-INIT-GF-03. IX2184.2 +056400 MOVE ZERO TO EOF-FLAG. IX2184.2 +056500 MOVE SPACES TO IX-FS2-STATUS. IX2184.2 +056600 MOVE "REA-TEST-GF-03 " TO PAR-NAME. IX2184.2 +056700 MOVE "RANDOM READ 23 EXP." TO FEATURE. IX2184.2 +056800 REA-TEST-GF-03. IX2184.2 +056900 READ IX-FS2 INVALID KEY GO TO REA-TEST-GF-03-1. IX2184.2 +057000 REA-TEST-GF-03-1. IX2184.2 +057100 IF IX-FS2-STATUS EQUAL TO "23" IX2184.2 +057200 GO TO REA-PASS-GF-03. IX2184.2 +057300 REA-FAIL-GF-03. IX2184.2 +057400 MOVE "IX-4, 1.3.4,(3) C 2); IX-36 4.7.4,GR (1), (5), (6) AND IX2184.2 +057500- " (7)" TO RE-MARK. IX2184.2 +057600 PERFORM FAIL. IX2184.2 +057700 MOVE IX-FS2-STATUS TO COMPUTED-A. IX2184.2 +057800 MOVE "23" TO CORRECT-X. IX2184.2 +057900 GO TO REA-WRITE-GF-03. IX2184.2 +058000 REA-PASS-GF-03. IX2184.2 +058100 PERFORM PASS. IX2184.2 +058200 REA-WRITE-GF-03. IX2184.2 +058300 PERFORM PRINT-DETAIL. IX2184.2 +058400 IX2184.2 +058500******************************************************************IX2184.2 +058600* TEST 6 *IX2184.2 +058700* READ (RANDOM) NO USE PROCEDURE MUST BE EXECUTED BECAUSE*IX2184.2 +058800* THE INVALID KEY PHRASE IS SPECIFIED) *IX2184.2 +058900* IX-29, 4.5.4, GR (4) B, (17) *IX2184.2 +059000******************************************************************IX2184.2 +059100 REA-INIT-GF-04. IX2184.2 +059200 MOVE "REA-TEST-GF-04 " TO PAR-NAME. IX2184.2 +059300 MOVE "RANDOM READ (NO USE)" TO FEATURE. IX2184.2 +059400 REA-TEST-GF-04. IX2184.2 +059500 IF EOF-FLAG EQUAL TO ZERO IX2184.2 +059600 GO TO REA-PASS-GF-04. IX2184.2 +059700 REA-FAIL-GF-04. IX2184.2 +059800 MOVE "IX-29 4.5.4, GR (4) B, (17); 1: USE PROCEDURE HAS BEEN IX2184.2 +059900- "EXECUTED" TO RE-MARK. IX2184.2 +060000 PERFORM FAIL. IX2184.2 +060100 MOVE EOF-FLAG TO COMPUTED-N. IX2184.2 +060200 MOVE "0" TO CORRECT-X. IX2184.2 +060300 GO TO REA-WRITE-GF-04. IX2184.2 +060400 REA-PASS-GF-04. IX2184.2 +060500 PERFORM PASS. IX2184.2 +060600 REA-WRITE-GF-04. IX2184.2 +060700 PERFORM PRINT-DETAIL. IX2184.2 +060800 IX2184.2 +060900 IX2184.2 +061000 IX2184.2 +061100 CCVS-EXIT SECTION. IX2184.2 +061200 CCVS-999999. IX2184.2 +061300 GO TO CLOSE-FILES. IX2184.2 diff --git a/tests/cobol85/IX/IX301M.CBL b/tests/cobol85/IX/IX301M.CBL new file mode 100755 index 00000000..8daa4f98 --- /dev/null +++ b/tests/cobol85/IX/IX301M.CBL @@ -0,0 +1,70 @@ +000100 IDENTIFICATION DIVISION. IX3014.2 +000200 PROGRAM-ID. IX3014.2 +000300 IX301M. IX3014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF INTERMEDIATE IX3014.2 +000500*SUBSET FEATURES THAT ARE USED IN LEVEL 1 INDEXED IX3014.2 +000600*INPUT-OUTPUT. IX3014.2 +000700 ENVIRONMENT DIVISION. IX3014.2 +000800 CONFIGURATION SECTION. IX3014.2 +000900 SOURCE-COMPUTER. IX3014.2 +001000 Linux. IX3014.2 +001100 OBJECT-COMPUTER. IX3014.2 +001200 Linux. IX3014.2 +001300 INPUT-OUTPUT SECTION. IX3014.2 +001400 FILE-CONTROL. IX3014.2 +001500 SELECT TFIL ASSIGN IX3014.2 +001600 "XXXXX024" IX3014.2 +001700 ORGANIZATION IS INDEXED IX3014.2 +001800*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +001900 IX3014.2 +002000 ACCESS MODE IS RANDOM IX3014.2 +002100*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +002200 IX3014.2 +002300 RECORD KEY IS RKEY. IX3014.2 +002400*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +002500 IX3014.2 +002600 DATA DIVISION. IX3014.2 +002700 FILE SECTION. IX3014.2 +002800 FD TFIL. IX3014.2 +002900 01 FREC. IX3014.2 +003000 03 RKEY PIC X(8). IX3014.2 +003100 IX3014.2 +003200 WORKING-STORAGE SECTION. IX3014.2 +003300 01 VARIABLES. IX3014.2 +003400 03 STATE PIC X(4) VALUE SPACES. IX3014.2 +003500 IX3014.2 +003600 PROCEDURE DIVISION. IX3014.2 +003700 IX3014.2 +003800 IX301M-CONTROL. IX3014.2 +003900 OPEN I-O TFIL. IX3014.2 +004000 PERFORM IX301M-READ THRU IX301M-DELETE 1 TIMES. IX3014.2 +004100 CLOSE TFIL. IX3014.2 +004200 STOP RUN. IX3014.2 +004300 IX3014.2 +004400 IX301M-READ. IX3014.2 +004500 READ TFIL INVALID KEY PERFORM INV-PARA IX3014.2 +004600 NOT INVALID KEY PERFORM DONE-PARA. IX3014.2 +004700*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +004800 IX3014.2 +004900 IX301M-REWRITE. IX3014.2 +005000 REWRITE FREC INVALID KEY PERFORM INV-PARA IX3014.2 +005100 NOT INVALID KEY PERFORM DONE-PARA. IX3014.2 +005200*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +005300 IX3014.2 +005400 IX301M-WRITE. IX3014.2 +005500 WRITE FREC INVALID KEY PERFORM INV-PARA IX3014.2 +005600 NOT INVALID KEY PERFORM DONE-PARA. IX3014.2 +005700*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +005800 IX3014.2 +005900 IX301M-DELETE. IX3014.2 +006000 DELETE TFIL INVALID KEY PERFORM INV-PARA IX3014.2 +006100 NOT INVALID KEY PERFORM DONE-PARA. IX3014.2 +006200*Message expected for above statement: NON-CONFORMING STANDARD IX3014.2 +006300 IX3014.2 +006400 INV-PARA. IX3014.2 +006500 MOVE "INVA" TO STATE. IX3014.2 +006600 IX3014.2 +006700 DONE-PARA. IX3014.2 +006800 MOVE "DONE" TO STATE. IX3014.2 +006900 IX3014.2 +007000*TOTAL NUMBER OF FLAGS EXPECTED = 7. IX3014.2 diff --git a/tests/cobol85/IX/IX302M.CBL b/tests/cobol85/IX/IX302M.CBL new file mode 100755 index 00000000..bda90522 --- /dev/null +++ b/tests/cobol85/IX/IX302M.CBL @@ -0,0 +1,71 @@ +000100 IDENTIFICATION DIVISION. IX3024.2 +000200 PROGRAM-ID. IX3024.2 +000300 IX302M. IX3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF IX3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN INTERMEDIATE SUBSET INDEXED IX3024.2 +000600*INPUT-OUTPUT. IX3024.2 +000700 ENVIRONMENT DIVISION. IX3024.2 +000800 CONFIGURATION SECTION. IX3024.2 +000900 SOURCE-COMPUTER. IX3024.2 +001000 Linux. IX3024.2 +001100 OBJECT-COMPUTER. IX3024.2 +001200 Linux. IX3024.2 +001300 INPUT-OUTPUT SECTION. IX3024.2 +001400 FILE-CONTROL. IX3024.2 +001500 SELECT TFIL ASSIGN IX3024.2 +001600 "XXXXX024" IX3024.2 +001700 ORGANIZATION IS INDEXED IX3024.2 +001800 ACCESS MODE IS SEQUENTIAL IX3024.2 +001900 RECORD KEY IS RKEY. IX3024.2 +002000 IX3024.2 +002100 SELECT SQ-FRR ASSIGN IX3024.2 +002200 "XXXXX013". IX3024.2 +002300 IX3024.2 +002400 IX3024.2 +002500 SELECT RR-FS1 ASSIGN IX3024.2 +002600 "XXXXX024" IX3024.2 +002700 ORGANIZATION IS INDEXED IX3024.2 +002800 RECORD KEY IS FKEY. IX3024.2 +002900 I-O-CONTROL. IX3024.2 +003000 XXXXX053. IX3024.2 +003100*Message expected for above statement: OBSOLETE IX3024.2 +003200 IX3024.2 +003300 DATA DIVISION. IX3024.2 +003400 FILE SECTION. IX3024.2 +003500 FD TFIL IX3024.2 +003600 LABEL RECORDS STANDARD IX3024.2 +003700*Message expected for above statement: OBSOLETE IX3024.2 +003800 IX3024.2 +003900 VALUE OF IX3024.2 +004000 OCLABELID IX3024.2 +004100 IS IX3024.2 +004200 "OCDUMMY" IX3024.2 +004300*Message expected for above statement: OBSOLETE IX3024.2 +004400 IX3024.2 +004500 DATA RECORDS ARE FREC. IX3024.2 +004600*Message expected for above statement: OBSOLETE IX3024.2 +004700 IX3024.2 +004800 01 FREC. IX3024.2 +004900 03 RKEY PIC X(8). IX3024.2 +005000 IX3024.2 +005100 FD SQ-FRR. IX3024.2 +005200 01 SREC. IX3024.2 +005300 03 SKEY PIC X(8). IX3024.2 +005400 IX3024.2 +005500 IX3024.2 +005600 FD RR-FS1. IX3024.2 +005700 01 RREC. IX3024.2 +005800 03 FKEY PIC X(8). IX3024.2 +005900 IX3024.2 +006000 WORKING-STORAGE SECTION. IX3024.2 +006100 01 VARIABLES. IX3024.2 +006200 03 VKEY PIC 9(8) VALUE ZERO. IX3024.2 +006300 03 DKEY PIC 9(8) VALUE ZERO. IX3024.2 +006400 IX3024.2 +006500 PROCEDURE DIVISION. IX3024.2 +006600 IX3024.2 +006700 IX302M-CONTROL. IX3024.2 +006800 DISPLAY "THIS IS A DUMMY PARAGRAPH". IX3024.2 +006900 STOP RUN. IX3024.2 +007000 IX3024.2 +007100*TOTAL NUMBER OF FLAGS EXPECTED = 4. IX3024.2 diff --git a/tests/cobol85/IX/IX401M.CBL b/tests/cobol85/IX/IX401M.CBL new file mode 100755 index 00000000..adb6920e --- /dev/null +++ b/tests/cobol85/IX/IX401M.CBL @@ -0,0 +1,84 @@ +000100 IDENTIFICATION DIVISION. IX4014.2 +000200 PROGRAM-ID. IX4014.2 +000300 IX401M. IX4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF HIGH IX4014.2 +000500*SUBSET FEATURES THAT ARE USED IN INDEXED IX4014.2 +000600*INPUT-OUTPUT. IX4014.2 +000700 ENVIRONMENT DIVISION. IX4014.2 +000800 CONFIGURATION SECTION. IX4014.2 +000900 SOURCE-COMPUTER. IX4014.2 +001000 Linux. IX4014.2 +001100 OBJECT-COMPUTER. IX4014.2 +001200 Linux. IX4014.2 +001300 INPUT-OUTPUT SECTION. IX4014.2 +001400 FILE-CONTROL. IX4014.2 +001500 SELECT OPTIONAL TFIL ASSIGN IX4014.2 +001600*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +001700 IX4014.2 +001800 "XXXXX025" IX4014.2 +001900 RESERVE 2 AREAS IX4014.2 +002000*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +002100 IX4014.2 +002200 ORGANIZATION IS INDEXED IX4014.2 +002300 ACCESS MODE IS DYNAMIC IX4014.2 +002400*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +002500 IX4014.2 +002600 RECORD KEY IS RKEY IX4014.2 +002700 ALTERNATE RECORD KEY IS BEANO. IX4014.2 +002800*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +002900 IX4014.2 +003000 SELECT TFIL2 ASSIGN IX4014.2 +003100 "XXXXX026" IX4014.2 +003200 ORGANIZATION IS INDEXED IX4014.2 +003300 ACCESS MODE IS SEQUENTIAL IX4014.2 +003400 RECORD KEY IS RKEY2. IX4014.2 +003500 IX4014.2 +003600 DATA DIVISION. IX4014.2 +003700 FILE SECTION. IX4014.2 +003800 FD TFIL IX4014.2 +003900 RECORD IS VARYING IN SIZE FROM 18 TO 36 CHARACTERS. IX4014.2 +004000*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +004100 IX4014.2 +004200 01 FREC. IX4014.2 +004300 03 RKEY PIC X(8). IX4014.2 +004400 03 BEANO PIC X(10). IX4014.2 +004500 IX4014.2 +004600 FD TFIL2. IX4014.2 +004700 01 FREC2. IX4014.2 +004800 03 RKEY2 PIC X(8). IX4014.2 +004900 IX4014.2 +005000 PROCEDURE DIVISION. IX4014.2 +005100 IX4014.2 +005200 IX401M-CONTROL. IX4014.2 +005300 OPEN INPUT TFIL. IX4014.2 +005400 PERFORM IX401M-CLOSE THRU IX401M-START. IX4014.2 +005500 CLOSE TFIL. IX4014.2 +005600 CLOSE TFIL2. IX4014.2 +005700 STOP RUN. IX4014.2 +005800 IX4014.2 +005900 IX401M-CLOSE. IX4014.2 +006000 CLOSE TFIL WITH LOCK. IX4014.2 +006100*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +006200 IX4014.2 +006300 IX401M-OPENEXT. IX4014.2 +006400 OPEN EXTEND TFIL2. IX4014.2 +006500*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +006600 IX4014.2 +006700 IX401M-READNEXT. IX4014.2 +006800 OPEN INPUT TFIL. IX4014.2 +006900 READ TFIL NEXT RECORD IX4014.2 +007000 AT END DISPLAY "AT END". IX4014.2 +007100*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +007200 IX4014.2 +007300 IX401M-READKEY. IX4014.2 +007400 READ TFIL RECORD IX4014.2 +007500 KEY IS RKEY IX4014.2 +007600 INVALID KEY DISPLAY "INVALID". IX4014.2 +007700*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +007800 IX4014.2 +007900 IX401M-START. IX4014.2 +008000 START TFIL KEY IS EQUAL TO RKEY IX4014.2 +008100 INVALID KEY DISPLAY "INVALID". IX4014.2 +008200*Message expected for above statement: NON-CONFORMING STANDARD IX4014.2 +008300 IX4014.2 +008400*TOTAL NUMBER OF FLAGS EXPECTED = 10. IX4014.2 diff --git a/tests/cobol85/Makefile.am b/tests/cobol85/Makefile.am old mode 100644 new mode 100755 index 7a9231f9..875043c5 --- a/tests/cobol85/Makefile.am +++ b/tests/cobol85/Makefile.am @@ -4,8 +4,10 @@ ## Copyright (C) 2008-2009 Roger While ## -#MODULES = CM DB IC IF IX NC OB RL RW SG SM SQ ST +#MODULES = NC SM IC SQ IX ST SG OB IF RL MODULES = NC SM IC SQ IX ST SG OB IF +MODULES_MAKEFILES = NC/Makefile SM/Makefile IC/Makefile SQ/Makefile IX/Makefile ST/Makefile SG/Makefile OB/Makefile IF/Makefile RL/Makefile + EXTRA_DIST = EXEC85.conf.in expand.pl report.pl summary.pl summary.txt \ NC.txt SM.txt IC.txt SQ.txt RL.txt IX.txt ST.txt SG.txt OB.txt IF.txt ifedit.sh @@ -15,7 +17,7 @@ COBOL = cobj -std=cobol85 COB85DIR = "`cd $(srcdir) && pwd`" -test: $(MODULES) +test: $(MODULES_MAKEFILES) @for m in $(MODULES); do \ (cd $$m && make test) \ done @@ -39,27 +41,8 @@ diff: diff summary.txt summary.log clean-local: - rm -rf copy copyalt $(MODULES) - -$(MODULES): newcob.val build/EXEC85.class $(srcdir)/EXEC85.conf.in - @echo -n "Building module $@..." - @sed 's/@MODULE@/$@/' $(srcdir)/EXEC85.conf.in > EXEC85.conf - @. ../atconfig; . ../atlocal; export PATH; java -cp $$CLASSPATH:./build EXEC85 - @$(srcdir)/ifedit.sh - @perl $(srcdir)/expand.pl newcob.tmp - @rm -f newcob.tmp newcob.log EXEC85.conf - @echo "test:" > $@/Makefile - @echo " . ../../atconfig; . ../../atlocal; export PATH; perl $(COB85DIR)/report.pl" >> $@/Makefile - @echo "done" + rm -rf copy copyalt $(MODULES_MAKEFILES) -build/EXEC85.class: newcob.val - @perl -pe 'BEGIN{<>; <>;} exit if /^\*END/;' newcob.val \ - | sed -e 's/XXXXX001.*/"newcob.val" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/XXXXX002.*/"newcob.tmp" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/XXXXX003.*/"unused"./' \ - -e 's/XXXXX055.*/"newcob.log"./' \ - -e 's/XXXXX058.*/"EXEC85.conf" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/ORGANIZATION SEQUENTIAL.*//' \ - > EXEC85.cob - . ../atconfig; . ../atlocal; export PATH; $(COBOL) EXEC85.cob - @rm -f EXEC85.cob +$(MODULES_MAKEFILES): + @echo "test:" > $@ + @echo " . ../../atconfig; . ../../atlocal; export PATH; perl $(COB85DIR)/report.pl" >> $@ diff --git a/tests/cobol85/Makefile.in b/tests/cobol85/Makefile.in index 13c4568d..34d805ba 100644 --- a/tests/cobol85/Makefile.in +++ b/tests/cobol85/Makefile.in @@ -278,8 +278,9 @@ top_build_prefix = @top_build_prefix@ top_builddir = @top_builddir@ top_srcdir = @top_srcdir@ -#MODULES = CM DB IC IF IX NC OB RL RW SG SM SQ ST +#MODULES = NC SM IC SQ IX ST SG OB IF RL MODULES = NC SM IC SQ IX ST SG OB IF +MODULES_MAKEFILES = NC/Makefile SM/Makefile IC/Makefile SQ/Makefile IX/Makefile ST/Makefile SG/Makefile OB/Makefile IF/Makefile RL/Makefile EXTRA_DIST = EXEC85.conf.in expand.pl report.pl summary.pl summary.txt \ NC.txt SM.txt IC.txt SQ.txt RL.txt IX.txt ST.txt SG.txt OB.txt IF.txt ifedit.sh @@ -482,7 +483,7 @@ uninstall-am: .PRECIOUS: Makefile -test: $(MODULES) +test: $(MODULES_MAKEFILES) @for m in $(MODULES); do \ (cd $$m && make test) \ done @@ -506,30 +507,11 @@ diff: diff summary.txt summary.log clean-local: - rm -rf copy copyalt $(MODULES) - -$(MODULES): newcob.val build/EXEC85.class $(srcdir)/EXEC85.conf.in - @echo -n "Building module $@..." - @sed 's/@MODULE@/$@/' $(srcdir)/EXEC85.conf.in > EXEC85.conf - @. ../atconfig; . ../atlocal; export PATH; java -cp $$CLASSPATH:./build EXEC85 - @$(srcdir)/ifedit.sh - @perl $(srcdir)/expand.pl newcob.tmp - @rm -f newcob.tmp newcob.log EXEC85.conf - @echo "test:" > $@/Makefile - @echo " . ../../atconfig; . ../../atlocal; export PATH; perl $(COB85DIR)/report.pl" >> $@/Makefile - @echo "done" - -build/EXEC85.class: newcob.val - @perl -pe 'BEGIN{<>; <>;} exit if /^\*END/;' newcob.val \ - | sed -e 's/XXXXX001.*/"newcob.val" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/XXXXX002.*/"newcob.tmp" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/XXXXX003.*/"unused"./' \ - -e 's/XXXXX055.*/"newcob.log"./' \ - -e 's/XXXXX058.*/"EXEC85.conf" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/ORGANIZATION SEQUENTIAL.*//' \ - > EXEC85.cob - . ../atconfig; . ../atlocal; export PATH; $(COBOL) EXEC85.cob - @rm -f EXEC85.cob + rm -rf copy copyalt $(MODULES_MAKEFILES) + +$(MODULES_MAKEFILES): + @echo "test:" > $@ + @echo " . ../../atconfig; . ../../atlocal; export PATH; perl $(COB85DIR)/report.pl" >> $@ # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. diff --git a/tests/cobol85/NC.txt b/tests/cobol85/NC.txt deleted file mode 100644 index 8480f693..00000000 --- a/tests/cobol85/NC.txt +++ /dev/null @@ -1,105 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -NC101A.CBL 93 93 0 0 0 OK -NC102A.CBL 42 42 0 0 0 OK -NC103A.CBL 102 102 0 0 0 OK -NC104A.CBL 141 141 0 0 0 OK -NC105A.CBL 132 129 0 3 0 OK -NC106A.CBL 126 126 0 0 0 OK -NC107A.CBL 177 172 0 0 5 OK -NC108M.CBL 14 14 0 0 0 OK -NC109M.CBL 11 11 0 0 0 OK -NC110M.CBL 0 0 0 0 0 OK -NC111A.CBL 7 7 0 0 0 OK -NC112A.CBL 32 32 0 0 0 OK -NC113M.CBL 0 0 0 0 0 OK -NC114M.CBL 6 5 0 0 1 OK -NC115A.CBL 31 31 0 0 0 OK -NC116A.CBL 66 66 0 0 0 OK -NC117A.CBL 40 40 0 0 0 OK -NC118A.CBL 29 29 0 0 0 OK -NC119A.CBL 36 36 0 0 0 OK -NC120A.CBL 39 39 0 0 0 OK -NC121M.CBL 41 39 0 0 2 OK -NC122A.CBL 24 24 0 0 0 OK -NC123A.CBL 34 34 0 0 0 OK -NC124A.CBL 169 169 0 0 0 OK -NC125A.CBL 110 110 0 0 0 OK -NC126A.CBL 145 145 0 0 0 OK -NC127A.CBL 2 2 0 0 0 OK -NC131A.CBL 10 10 0 0 0 OK -NC132A.CBL 25 25 0 0 0 OK -NC133A.CBL 25 25 0 0 0 OK -NC134A.CBL 20 20 0 0 0 OK -NC135A.CBL 8 7 0 0 1 OK -NC136A.CBL 8 8 0 0 0 OK -NC137A.CBL 8 8 0 0 0 OK -NC138A.CBL 36 36 0 0 0 OK -NC139A.CBL 41 41 0 0 0 OK -NC140A.CBL 70 70 0 0 0 OK -NC141A.CBL 9 9 0 0 0 OK -NC170A.CBL 96 96 0 0 0 OK -NC171A.CBL 108 108 0 0 0 OK -NC172A.CBL 101 101 0 0 0 OK -NC173A.CBL 102 102 0 0 0 OK -NC174A.CBL 77 76 0 1 0 OK -NC175A.CBL 97 97 0 0 0 OK -NC176A.CBL 124 124 0 0 0 OK -NC177A.CBL 108 108 0 0 0 OK -NC201A.CBL 59 59 0 0 0 OK -NC202A.CBL 77 77 0 0 0 OK -NC203A.CBL 57 57 0 0 0 OK -NC204M.CBL 15 15 0 0 0 OK -NC205A.CBL 10 10 0 0 0 OK -NC206A.CBL 53 53 0 0 0 OK -NC207A.CBL 85 85 0 0 0 OK -NC208A.CBL 24 24 0 0 0 OK -NC209A.CBL 32 32 0 0 0 OK -NC210A.CBL 85 85 0 0 0 OK -NC211A.CBL 51 51 0 0 0 OK -NC214M.CBL 0 0 0 0 0 OK -NC215A.CBL 7 7 0 0 0 OK -NC216A.CBL 57 57 0 0 0 OK -NC217A.CBL 81 80 0 1 0 OK -NC218A.CBL 125 125 0 0 0 OK -NC219A.CBL 9 9 0 0 0 OK -NC220M.CBL 25 23 0 0 2 OK -NC221A.CBL 17 17 0 0 0 OK -NC222A.CBL 8 8 0 0 0 OK -NC223A.CBL 94 94 0 0 0 OK -NC224A.CBL 14 14 0 0 0 OK -NC225A.CBL 63 63 0 0 0 OK -NC231A.CBL 24 24 0 0 0 OK -NC232A.CBL 17 17 0 0 0 OK -NC233A.CBL 14 14 0 0 0 OK -NC234A.CBL 17 17 0 0 0 OK -NC235A.CBL 13 13 0 0 0 OK -NC236A.CBL 10 10 0 0 0 OK -NC237A.CBL 13 13 0 0 0 OK -NC238A.CBL 10 10 0 0 0 OK -NC239A.CBL 8 8 0 0 0 OK -NC240A.CBL 11 11 0 0 0 OK -NC241A.CBL 11 11 0 0 0 OK -NC242A.CBL 12 12 0 0 0 OK -NC243A.CBL 16 16 0 0 0 OK -NC244A.CBL 6 6 0 0 0 OK -NC245A.CBL 28 28 0 0 0 OK -NC246A.CBL 49 49 0 0 0 OK -NC247A.CBL 21 20 0 1 0 OK -NC248A.CBL 11 11 0 0 0 OK -NC250A.CBL 115 115 0 0 0 OK -NC251A.CBL 59 59 0 0 0 OK -NC252A.CBL 75 75 0 0 0 OK -NC253A.CBL 61 61 0 0 0 OK -NC254A.CBL 9 9 0 0 0 OK -NC302M.CBL ----- test skipped ----- -NC303M.CBL ----- test skipped ----- -NC401M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 4380 4363 0 6 11 -% 100.0 99.6 0.0 0.1 0.3 - -Number of programs: 92 -Successfully executed: 92 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/NC/NC101A.CBL b/tests/cobol85/NC/NC101A.CBL new file mode 100755 index 00000000..036f85e7 --- /dev/null +++ b/tests/cobol85/NC/NC101A.CBL @@ -0,0 +1,1867 @@ +000100 IDENTIFICATION DIVISION. NC1014.2 +000200 PROGRAM-ID. NC1014.2 +000300 NC101A. NC1014.2 +000400**************************************************************** NC1014.2 +000500* * NC1014.2 +000600* VALIDATION FOR:- * NC1014.2 +000700* * NC1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1014.2 +000900* * NC1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1014.2 +001100* * NC1014.2 +001200**************************************************************** NC1014.2 +001300* * NC1014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1014.2 +001500* * NC1014.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1014.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1014.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1014.2 +001900* * NC1014.2 +002000**************************************************************** NC1014.2 +002100**************************************************************** NC1014.2 +002200* THIS PROGRAM TESTS THE FORMAT 1 MULTIPLY STATEMENT FOUND NC1014.2 +002300* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1014.2 +002400* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1014.2 +002500* TESTED, AS WELL AS THE ROUNDED OPTION. NC1014.2 +002600* NC1014.2 +002700* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1014.2 +002800* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1014.2 +002900* AS OPERANDS. NC1014.2 +003000* NC1014.2 +003100 NC1014.2 +003200 NC1014.2 +003300 ENVIRONMENT DIVISION. NC1014.2 +003400 CONFIGURATION SECTION. NC1014.2 +003500 SOURCE-COMPUTER. NC1014.2 +003600 Linux. NC1014.2 +003700 OBJECT-COMPUTER. NC1014.2 +003800 Linux. NC1014.2 +003900 INPUT-OUTPUT SECTION. NC1014.2 +004000 FILE-CONTROL. NC1014.2 +004100 SELECT PRINT-FILE ASSIGN TO NC1014.2 +004200 "report.log". NC1014.2 +004300 DATA DIVISION. NC1014.2 +004400 FILE SECTION. NC1014.2 +004500 FD PRINT-FILE. NC1014.2 +004600 01 PRINT-REC PICTURE X(120). NC1014.2 +004700 01 DUMMY-RECORD PICTURE X(120). NC1014.2 +004800 WORKING-STORAGE SECTION. NC1014.2 +004900 77 WRK-DS-18V00 PICTURE S9(18). NC1014.2 +005000 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1014.2 +005100 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1014.2 +005200 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1014.2 +005300 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1014.2 +005400 77 WRK-DS-10V00 PICTURE S9(10). NC1014.2 +005500 77 WRK-XN-00001 PICTURE X. NC1014.2 +005600 77 A10ONES-DS-10V00 PICTURE S9(10) NC1014.2 +005700 VALUE 1111111111. NC1014.2 +005800 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1014.2 +005900 VALUE 333333.333333. NC1014.2 +006000 77 WRK-DS-02V00 PICTURE S99. NC1014.2 +006100 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1014.2 +006200 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1014.2 +006300 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1014.2 +006400 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1014.2 +006500 77 A12ONES-DS-12V00 PICTURE S9(12) NC1014.2 +006600 VALUE 111111111111. NC1014.2 +006700 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1014.2 +006800 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1014.2 +006900 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1014.2 +007000 77 A18ONES-DS-18V00 PICTURE S9(18) NC1014.2 +007100 VALUE 111111111111111111. NC1014.2 +007200 77 WRK-DS-0201P PICTURE S99P. NC1014.2 +007300 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1014.2 +007400 77 WRK-DU-18V00 PICTURE 9(18). NC1014.2 +007500 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1014.2 +007600 VALUE 99. NC1014.2 +007700 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1014.2 +007800 VALUE .1. NC1014.2 +007900 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1014.2 +008000 77 WRK-DS-12V00 PICTURE S9(12). NC1014.2 +008100 77 WRK-DS-01V00 PICTURE S9. NC1014.2 +008200 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1014.2 +008300 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1014.2 +008400 VALUE 111111111.111111111. NC1014.2 +008500 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1014.2 +008600 77 WRK-DS-05V00 PICTURE S9(5). NC1014.2 +008700 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1014.2 +008800 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1014.2 +008900 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1014.2 +009000 77 XRAY PICTURE X. NC1014.2 +009100 01 WRK-XN-18-1 PIC X(18). NC1014.2 +009200 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1014.2 +009300 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1014.2 +009400 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1014.2 +009500 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1014.2 +009600 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1014.2 +009700 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1014.2 +009800 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1014.2 +009900 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1014.2 +010000 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1014.2 +010100 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1014.2 +010200 01 WRK-DU-1V5-1 PIC 9V9(5). NC1014.2 +010300 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1014.2 +010400 01 WRK-DU-2P4-1 PIC 99P(4) VALUE 990000. NC1014.2 +010500 01 WRK-DU-2V0-1 PIC 99. NC1014.2 +010600 01 WRK-DU-2V0-2 PIC 99. NC1014.2 +010700 01 WRK-DU-2V0-3 PIC 99. NC1014.2 +010800 01 WRK-DU-2V1-1 PIC 99V9. NC1014.2 +010900 01 WRK-DU-2V1-2 PIC 99V9. NC1014.2 +011000 01 WRK-DU-2V1-3 PIC 99V9. NC1014.2 +011100 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1014.2 +011200 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1014.2 +011300 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1014.2 +011400 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1014.2 +011500 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1014.2 +011600 01 WRK-DU-2V5-1 PIC 99V9(5). NC1014.2 +011700 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1014.2 +011800 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1014.2 +011900 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1014.2 +012000 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1014.2 +012100 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1014.2 +012200 01 WRK-NE-X-1 PIC 9(16).99. NC1014.2 +012300 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1014.2 +012400 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1014.2 +012500 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1014.2 +012600 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1014.2 +012700 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1014.2 +012800 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1014.2 +012900 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1014.2 +013000 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1014.2 +013100 01 WRK-NE-X-2 PIC -9(16).99. NC1014.2 +013200 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1014.2 +013300 01 WRK-NE-2 PIC $**.99. NC1014.2 +013400 01 WRK-NE-3 PIC $99.99CR. NC1014.2 +013500 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1014.2 +013600 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1014.2 +013700 VALUE +000000000000000001. NC1014.2 +013800 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1014.2 +013900 VALUE -000000000000000033. NC1014.2 +014000 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1014.2 +014100 VALUE 666666666666666666. NC1014.2 +014200 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1014.2 +014300 VALUE 009999999999999999. NC1014.2 +014400 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1014.2 +014500 VALUE 000022222222222222. NC1014.2 +014600 01 MULTIPLY-DATA. NC1014.2 +014700 02 MULT1 PICTURE IS 999V99 NC1014.2 +014800 VALUE IS 80.12. NC1014.2 +014900 02 MULT2 PICTURE IS 999V999. NC1014.2 +015000 02 MULT3 PICTURE IS $$99.99. NC1014.2 +015100 02 MULT4 PICTURE IS S99 NC1014.2 +015200 VALUE IS -56. NC1014.2 +015300 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1014.2 +015400 02 MULT6 PICTURE IS 99 VALUE IS NC1014.2 +015500 20. NC1014.2 +015600 01 DIVIDE-DATA. NC1014.2 +015700 02 DIV1 PICTURE IS 9(4)V99 NC1014.2 +015800 VALUE IS 1620.36. NC1014.2 +015900 02 DIV2 PICTURE IS 99V9 NC1014.2 +016000 VALUE IS 44.1. NC1014.2 +016100 02 DIV3 PICTURE IS 9(4)V9 NC1014.2 +016200 VALUE IS 1661.7. NC1014.2 +016300 02 DIV4 PICTURE IS S9V999 NC1014.2 +016400 VALUE IS -9.642. NC1014.2 +016500 02 DIV-02LEVEL-1. NC1014.2 +016600 03 DIV5 PICTURE IS V99 NC1014.2 +016700 VALUE IS .82. NC1014.2 +016800 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1014.2 +016900 03 DIV7 PICTURE IS 9V9 NC1014.2 +017000 VALUE IS 9.6. NC1014.2 +017100 01 DIV-DATA-2. NC1014.2 +017200 02 DIV8 PICTURE IS 99V9. NC1014.2 +017300 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1014.2 +017400 02 DIV10 PICTURE IS V999. NC1014.2 +017500 01 TEST-RESULTS. NC1014.2 +017600 02 FILLER PIC X VALUE SPACE. NC1014.2 +017700 02 FEATURE PIC X(20) VALUE SPACE. NC1014.2 +017800 02 FILLER PIC X VALUE SPACE. NC1014.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. NC1014.2 +018000 02 FILLER PIC X VALUE SPACE. NC1014.2 +018100 02 PAR-NAME. NC1014.2 +018200 03 FILLER PIC X(19) VALUE SPACE. NC1014.2 +018300 03 PARDOT-X PIC X VALUE SPACE. NC1014.2 +018400 03 DOTVALUE PIC 99 VALUE ZERO. NC1014.2 +018500 02 FILLER PIC X(8) VALUE SPACE. NC1014.2 +018600 02 RE-MARK PIC X(61). NC1014.2 +018700 01 TEST-COMPUTED. NC1014.2 +018800 02 FILLER PIC X(30) VALUE SPACE. NC1014.2 +018900 02 FILLER PIC X(17) VALUE NC1014.2 +019000 " COMPUTED=". NC1014.2 +019100 02 COMPUTED-X. NC1014.2 +019200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1014.2 +019300 03 COMPUTED-N REDEFINES COMPUTED-A NC1014.2 +019400 PIC -9(9).9(9). NC1014.2 +019500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1014.2 +019600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1014.2 +019700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1014.2 +019800 03 CM-18V0 REDEFINES COMPUTED-A. NC1014.2 +019900 04 COMPUTED-18V0 PIC -9(18). NC1014.2 +020000 04 FILLER PIC X. NC1014.2 +020100 03 FILLER PIC X(50) VALUE SPACE. NC1014.2 +020200 01 TEST-CORRECT. NC1014.2 +020300 02 FILLER PIC X(30) VALUE SPACE. NC1014.2 +020400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1014.2 +020500 02 CORRECT-X. NC1014.2 +020600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1014.2 +020700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1014.2 +020800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1014.2 +020900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1014.2 +021000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1014.2 +021100 03 CR-18V0 REDEFINES CORRECT-A. NC1014.2 +021200 04 CORRECT-18V0 PIC -9(18). NC1014.2 +021300 04 FILLER PIC X. NC1014.2 +021400 03 FILLER PIC X(2) VALUE SPACE. NC1014.2 +021500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1014.2 +021600 01 CCVS-C-1. NC1014.2 +021700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1014.2 +021800- "SS PARAGRAPH-NAME NC1014.2 +021900- " REMARKS". NC1014.2 +022000 02 FILLER PIC X(20) VALUE SPACE. NC1014.2 +022100 01 CCVS-C-2. NC1014.2 +022200 02 FILLER PIC X VALUE SPACE. NC1014.2 +022300 02 FILLER PIC X(6) VALUE "TESTED". NC1014.2 +022400 02 FILLER PIC X(15) VALUE SPACE. NC1014.2 +022500 02 FILLER PIC X(4) VALUE "FAIL". NC1014.2 +022600 02 FILLER PIC X(94) VALUE SPACE. NC1014.2 +022700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1014.2 +022800 01 REC-CT PIC 99 VALUE ZERO. NC1014.2 +022900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1014.2 +023000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1014.2 +023100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1014.2 +023200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1014.2 +023300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1014.2 +023400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1014.2 +023500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1014.2 +023600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1014.2 +023700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1014.2 +023800 01 CCVS-H-1. NC1014.2 +023900 02 FILLER PIC X(39) VALUE SPACES. NC1014.2 +024000 02 FILLER PIC X(42) VALUE NC1014.2 +024100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1014.2 +024200 02 FILLER PIC X(39) VALUE SPACES. NC1014.2 +024300 01 CCVS-H-2A. NC1014.2 +024400 02 FILLER PIC X(40) VALUE SPACE. NC1014.2 +024500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1014.2 +024600 02 FILLER PIC XXXX VALUE NC1014.2 +024700 "4.2 ". NC1014.2 +024800 02 FILLER PIC X(28) VALUE NC1014.2 +024900 " COPY - NOT FOR DISTRIBUTION". NC1014.2 +025000 02 FILLER PIC X(41) VALUE SPACE. NC1014.2 +025100 NC1014.2 +025200 01 CCVS-H-2B. NC1014.2 +025300 02 FILLER PIC X(15) VALUE NC1014.2 +025400 "TEST RESULT OF ". NC1014.2 +025500 02 TEST-ID PIC X(9). NC1014.2 +025600 02 FILLER PIC X(4) VALUE NC1014.2 +025700 " IN ". NC1014.2 +025800 02 FILLER PIC X(12) VALUE NC1014.2 +025900 " HIGH ". NC1014.2 +026000 02 FILLER PIC X(22) VALUE NC1014.2 +026100 " LEVEL VALIDATION FOR ". NC1014.2 +026200 02 FILLER PIC X(58) VALUE NC1014.2 +026300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1014.2 +026400 01 CCVS-H-3. NC1014.2 +026500 02 FILLER PIC X(34) VALUE NC1014.2 +026600 " FOR OFFICIAL USE ONLY ". NC1014.2 +026700 02 FILLER PIC X(58) VALUE NC1014.2 +026800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1014.2 +026900 02 FILLER PIC X(28) VALUE NC1014.2 +027000 " COPYRIGHT 1985 ". NC1014.2 +027100 01 CCVS-E-1. NC1014.2 +027200 02 FILLER PIC X(52) VALUE SPACE. NC1014.2 +027300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1014.2 +027400 02 ID-AGAIN PIC X(9). NC1014.2 +027500 02 FILLER PIC X(45) VALUE SPACES. NC1014.2 +027600 01 CCVS-E-2. NC1014.2 +027700 02 FILLER PIC X(31) VALUE SPACE. NC1014.2 +027800 02 FILLER PIC X(21) VALUE SPACE. NC1014.2 +027900 02 CCVS-E-2-2. NC1014.2 +028000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1014.2 +028100 03 FILLER PIC X VALUE SPACE. NC1014.2 +028200 03 ENDER-DESC PIC X(44) VALUE NC1014.2 +028300 "ERRORS ENCOUNTERED". NC1014.2 +028400 01 CCVS-E-3. NC1014.2 +028500 02 FILLER PIC X(22) VALUE NC1014.2 +028600 " FOR OFFICIAL USE ONLY". NC1014.2 +028700 02 FILLER PIC X(12) VALUE SPACE. NC1014.2 +028800 02 FILLER PIC X(58) VALUE NC1014.2 +028900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1014.2 +029000 02 FILLER PIC X(13) VALUE SPACE. NC1014.2 +029100 02 FILLER PIC X(15) VALUE NC1014.2 +029200 " COPYRIGHT 1985". NC1014.2 +029300 01 CCVS-E-4. NC1014.2 +029400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1014.2 +029500 02 FILLER PIC X(4) VALUE " OF ". NC1014.2 +029600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1014.2 +029700 02 FILLER PIC X(40) VALUE NC1014.2 +029800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1014.2 +029900 01 XXINFO. NC1014.2 +030000 02 FILLER PIC X(19) VALUE NC1014.2 +030100 "*** INFORMATION ***". NC1014.2 +030200 02 INFO-TEXT. NC1014.2 +030300 04 FILLER PIC X(8) VALUE SPACE. NC1014.2 +030400 04 XXCOMPUTED PIC X(20). NC1014.2 +030500 04 FILLER PIC X(5) VALUE SPACE. NC1014.2 +030600 04 XXCORRECT PIC X(20). NC1014.2 +030700 02 INF-ANSI-REFERENCE PIC X(48). NC1014.2 +030800 01 HYPHEN-LINE. NC1014.2 +030900 02 FILLER PIC IS X VALUE IS SPACE. NC1014.2 +031000 02 FILLER PIC IS X(65) VALUE IS "************************NC1014.2 +031100- "*****************************************". NC1014.2 +031200 02 FILLER PIC IS X(54) VALUE IS "************************NC1014.2 +031300- "******************************". NC1014.2 +031400 01 CCVS-PGM-ID PIC X(9) VALUE NC1014.2 +031500 "NC101A". NC1014.2 +031600 PROCEDURE DIVISION. NC1014.2 +031700 CCVS1 SECTION. NC1014.2 +031800 OPEN-FILES. NC1014.2 +031900 OPEN OUTPUT PRINT-FILE. NC1014.2 +032000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1014.2 +032100 MOVE SPACE TO TEST-RESULTS. NC1014.2 +032200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1014.2 +032300 GO TO CCVS1-EXIT. NC1014.2 +032400 CLOSE-FILES. NC1014.2 +032500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1014.2 +032600 TERMINATE-CCVS. NC1014.2 +032700*S EXIT PROGRAM. NC1014.2 +032800*SERMINATE-CALL. NC1014.2 +032900 STOP RUN. NC1014.2 +033000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1014.2 +033100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1014.2 +033200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1014.2 +033300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1014.2 +033400 MOVE "****TEST DELETED****" TO RE-MARK. NC1014.2 +033500 PRINT-DETAIL. NC1014.2 +033600 IF REC-CT NOT EQUAL TO ZERO NC1014.2 +033700 MOVE "." TO PARDOT-X NC1014.2 +033800 MOVE REC-CT TO DOTVALUE. NC1014.2 +033900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1014.2 +034000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1014.2 +034100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1014.2 +034200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1014.2 +034300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1014.2 +034400 MOVE SPACE TO CORRECT-X. NC1014.2 +034500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1014.2 +034600 MOVE SPACE TO RE-MARK. NC1014.2 +034700 HEAD-ROUTINE. NC1014.2 +034800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +034900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +035000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1014.2 +035100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1014.2 +035200 COLUMN-NAMES-ROUTINE. NC1014.2 +035300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +035400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +035500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +035600 END-ROUTINE. NC1014.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1014.2 +035800 END-RTN-EXIT. NC1014.2 +035900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +036000 END-ROUTINE-1. NC1014.2 +036100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1014.2 +036200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1014.2 +036300 ADD PASS-COUNTER TO ERROR-HOLD. NC1014.2 +036400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1014.2 +036500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1014.2 +036600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1014.2 +036700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1014.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1014.2 +036900 END-ROUTINE-12. NC1014.2 +037000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1014.2 +037100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1014.2 +037200 MOVE "NO " TO ERROR-TOTAL NC1014.2 +037300 ELSE NC1014.2 +037400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1014.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1014.2 +037600 PERFORM WRITE-LINE. NC1014.2 +037700 END-ROUTINE-13. NC1014.2 +037800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1014.2 +037900 MOVE "NO " TO ERROR-TOTAL ELSE NC1014.2 +038000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1014.2 +038100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1014.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +038300 IF INSPECT-COUNTER EQUAL TO ZERO NC1014.2 +038400 MOVE "NO " TO ERROR-TOTAL NC1014.2 +038500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1014.2 +038600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1014.2 +038700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +038800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1014.2 +038900 WRITE-LINE. NC1014.2 +039000 ADD 1 TO RECORD-COUNT. NC1014.2 +039100 IF RECORD-COUNT GREATER 42 NC1014.2 +039200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1014.2 +039300 MOVE SPACE TO DUMMY-RECORD NC1014.2 +039400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1014.2 +039500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1014.2 +039600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1014.2 +039700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1014.2 +039800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1014.2 +039900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1014.2 +040000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1014.2 +040100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1014.2 +040200 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1014.2 +040300 MOVE ZERO TO RECORD-COUNT. NC1014.2 +040400 PERFORM WRT-LN. NC1014.2 +040500 WRT-LN. NC1014.2 +040600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1014.2 +040700 MOVE SPACE TO DUMMY-RECORD. NC1014.2 +040800 BLANK-LINE-PRINT. NC1014.2 +040900 PERFORM WRT-LN. NC1014.2 +041000 FAIL-ROUTINE. NC1014.2 +041100 IF COMPUTED-X NOT EQUAL TO SPACE NC1014.2 +041200 GO TO FAIL-ROUTINE-WRITE. NC1014.2 +041300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1014.2 +041400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1014.2 +041500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1014.2 +041600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +041700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1014.2 +041800 GO TO FAIL-ROUTINE-EX. NC1014.2 +041900 FAIL-ROUTINE-WRITE. NC1014.2 +042000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1014.2 +042100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1014.2 +042200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1014.2 +042300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1014.2 +042400 FAIL-ROUTINE-EX. EXIT. NC1014.2 +042500 BAIL-OUT. NC1014.2 +042600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1014.2 +042700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1014.2 +042800 BAIL-OUT-WRITE. NC1014.2 +042900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1014.2 +043000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1014.2 +043100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1014.2 +043200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1014.2 +043300 BAIL-OUT-EX. EXIT. NC1014.2 +043400 CCVS1-EXIT. NC1014.2 +043500 EXIT. NC1014.2 +043600 SECT-NC101A-001 SECTION. NC1014.2 +043700 MPY-INIT-F1-1. NC1014.2 +043800 MOVE "MULTIPLY BY" TO FEATURE. NC1014.2 +043900 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +044000 MOVE 80.12 TO MULT1. NC1014.2 +044100 MOVE 4 TO MULT5. NC1014.2 +044200 MPY-TEST-F1-1. NC1014.2 +044300 MULTIPLY MULT5 BY MULT1. NC1014.2 +044400 IF MULT1 EQUAL TO 320.48 NC1014.2 +044500 PERFORM PASS NC1014.2 +044600 ELSE NC1014.2 +044700 GO TO MPY-FAIL-F1-1. NC1014.2 +044800 GO TO MPY-WRITE-F1-1. NC1014.2 +044900 MPY-DELETE-F1-1. NC1014.2 +045000 PERFORM DE-LETE. NC1014.2 +045100 GO TO MPY-WRITE-F1-1. NC1014.2 +045200 MPY-FAIL-F1-1. NC1014.2 +045300 PERFORM FAIL. NC1014.2 +045400 MOVE MULT1 TO COMPUTED-N. NC1014.2 +045500 MOVE +320.48 TO CORRECT-N. NC1014.2 +045600 MPY-WRITE-F1-1. NC1014.2 +045700 MOVE "MPY-TEST-F1-1 " TO PAR-NAME. NC1014.2 +045800 PERFORM PRINT-DETAIL. NC1014.2 +045900* NC1014.2 +046000 MPY-INIT-F1-2. NC1014.2 +046100 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +046200 MOVE -56 TO MULT4. NC1014.2 +046300 MPY-TEST-F1-2. NC1014.2 +046400 MULTIPLY -1.3 BY MULT4 ROUNDED. NC1014.2 +046500 IF MULT4 EQUAL TO 73 NC1014.2 +046600 PERFORM PASS NC1014.2 +046700 ELSE NC1014.2 +046800 GO TO MPY-FAIL-F1-2. NC1014.2 +046900 GO TO MPY-WRITE-F1-2. NC1014.2 +047000 MPY-DELETE-F1-2. NC1014.2 +047100 PERFORM DE-LETE. NC1014.2 +047200 GO TO MPY-WRITE-F1-2. NC1014.2 +047300 MPY-FAIL-F1-2. NC1014.2 +047400 PERFORM FAIL. NC1014.2 +047500 MOVE MULT4 TO COMPUTED-N. NC1014.2 +047600 MOVE +73 TO CORRECT-N. NC1014.2 +047700 MPY-WRITE-F1-2. NC1014.2 +047800 MOVE "MPY-TEST-F1-2 " TO PAR-NAME. NC1014.2 +047900 PERFORM PRINT-DETAIL. NC1014.2 +048000 NC1014.2 +048100 MPY-INIT-F1-3-1. NC1014.2 +048200 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +048300 MOVE 4 TO MULT5. NC1014.2 +048400 MOVE "A" TO XRAY. NC1014.2 +048500 MPY-TEST-F1-3-0. NC1014.2 +048600 MULTIPLY MULT5 BY MULT5 ON SIZE ERROR NC1014.2 +048700 MOVE "K" TO XRAY. NC1014.2 +048800 MPY-TEST-F1-3-1. NC1014.2 +048900 IF XRAY EQUAL TO "K" NC1014.2 +049000 PERFORM PASS NC1014.2 +049100 ELSE NC1014.2 +049200 GO TO MPY-FAIL-F1-3-1. NC1014.2 +049300 GO TO MPY-WRITE-F1-3-1. NC1014.2 +049400 MPY-DELETE-F1-3-1. NC1014.2 +049500 PERFORM DE-LETE. NC1014.2 +049600 GO TO MPY-WRITE-F1-3-1. NC1014.2 +049700 MPY-FAIL-F1-3-1. NC1014.2 +049800 MOVE XRAY TO COMPUTED-X. NC1014.2 +049900 MOVE "A" TO CORRECT-X. NC1014.2 +050000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1014.2 +050100 PERFORM FAIL. NC1014.2 +050200 MPY-WRITE-F1-3-1. NC1014.2 +050300 MOVE "MPY-TEST-F1-3-1 " TO PAR-NAME. NC1014.2 +050400 PERFORM PRINT-DETAIL. NC1014.2 +050500 MPY-TEST-F1-3-2. NC1014.2 +050600 IF MULT5 EQUAL TO 4 NC1014.2 +050700 PERFORM PASS NC1014.2 +050800 ELSE NC1014.2 +050900 GO TO MPY-FAIL-F1-3-2. NC1014.2 +051000 GO TO MPY-WRITE-F1-3-2. NC1014.2 +051100 MPY-DELETE-F1-3-2. NC1014.2 +051200 PERFORM DE-LETE. NC1014.2 +051300 GO TO MPY-WRITE-F1-3-2. NC1014.2 +051400 MPY-FAIL-F1-3-2. NC1014.2 +051500 PERFORM FAIL. NC1014.2 +051600 MOVE MULT5 TO COMPUTED-N. NC1014.2 +051700 MOVE +4 TO CORRECT-N. NC1014.2 +051800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1014.2 +051900 MPY-WRITE-F1-3-2. NC1014.2 +052000 MOVE "MPY-TEST-F1-3-2" TO PAR-NAME. NC1014.2 +052100 PERFORM PRINT-DETAIL. NC1014.2 +052200 NC1014.2 +052300 MPY-INIT-F1-4-1. NC1014.2 +052400 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +052500 MOVE 20 TO MULT6. NC1014.2 +052600 MOVE "B" TO XRAY. NC1014.2 +052700 MPY-TEST-F1-4-O. NC1014.2 +052800 MULTIPLY 4.99 BY MULT6 ROUNDED ON SIZE ERROR NC1014.2 +052900 MOVE "L" TO XRAY. NC1014.2 +053000 MPY-TEST-F1-4-1. NC1014.2 +053100 IF XRAY EQUAL TO "L" NC1014.2 +053200 PERFORM PASS NC1014.2 +053300 ELSE NC1014.2 +053400 GO TO MPY-FAIL-F1-4-1. NC1014.2 +053500 GO TO MPY-WRITE-F1-4-1. NC1014.2 +053600 MPY-DELETE-F1-4-1. NC1014.2 +053700 PERFORM DE-LETE. NC1014.2 +053800 GO TO MPY-WRITE-F1-4-1. NC1014.2 +053900 MPY-FAIL-F1-4-1. NC1014.2 +054000 MOVE "L" TO CORRECT-X. NC1014.2 +054100 MOVE XRAY TO COMPUTED-X. NC1014.2 +054200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1014.2 +054300 PERFORM FAIL. NC1014.2 +054400 MPY-WRITE-F1-4-1. NC1014.2 +054500 MOVE "MPY-TEST-F1-4-1" TO PAR-NAME. NC1014.2 +054600 PERFORM PRINT-DETAIL. NC1014.2 +054700 MPY-TEST-F1-4-2. NC1014.2 +054800 IF MULT6 EQUAL TO 20 NC1014.2 +054900 PERFORM PASS NC1014.2 +055000 ELSE NC1014.2 +055100 GO TO MPY-FAIL-F1-4-2. NC1014.2 +055200 GO TO MPY-WRITE-F1-4-2. NC1014.2 +055300 MPY-DELETE-F1-4-2. NC1014.2 +055400 PERFORM DE-LETE. NC1014.2 +055500 GO TO MPY-WRITE-F1-4-2. NC1014.2 +055600 MPY-FAIL-F1-4-2. NC1014.2 +055700 PERFORM FAIL. NC1014.2 +055800 MOVE MULT6 TO COMPUTED-N. NC1014.2 +055900 MOVE +20 TO CORRECT-N. NC1014.2 +056000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1014.2 +056100 MPY-WRITE-F1-4-2. NC1014.2 +056200 MOVE "MPY-TEST-F1-4-2" TO PAR-NAME. NC1014.2 +056300 PERFORM PRINT-DETAIL. NC1014.2 +056400 NC1014.2 +056500 MPY-INIT-F1-5. NC1014.2 +056600 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +056700 MOVE 222222222222 TO WRK-DS-18V00. NC1014.2 +056800 MPY-TEST-F1-5-0. NC1014.2 +056900 MULTIPLY A06THREES-DS-03V03 BY WRK-DS-18V00. NC1014.2 +057000 MPY-TEST-F1-5-1. NC1014.2 +057100 IF WRK-DS-18V00 EQUAL TO 000074073999999925 NC1014.2 +057200 PERFORM PASS NC1014.2 +057300 GO TO MPY-WRITE-F1-5. NC1014.2 +057400 GO TO MPY-FAIL-F1-5. NC1014.2 +057500 MPY-DELETE-F1-5. NC1014.2 +057600 PERFORM DE-LETE. NC1014.2 +057700 GO TO MPY-WRITE-F1-5. NC1014.2 +057800 MPY-FAIL-F1-5. NC1014.2 +057900 MOVE 000074073999999925 TO CORRECT-18V0. NC1014.2 +058000 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1014.2 +058100 PERFORM FAIL. NC1014.2 +058200 MPY-WRITE-F1-5. NC1014.2 +058300 MOVE "MPY-TEST-F1-5 " TO PAR-NAME. NC1014.2 +058400 PERFORM PRINT-DETAIL. NC1014.2 +058500 NC1014.2 +058600 MPY-INIT-F1-6. NC1014.2 +058700 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +058800 MOVE A08TWOS-DS-02V06 TO WRK-DS-06V06. NC1014.2 +058900 MPY-TEST-F1-6-0. NC1014.2 +059000 MULTIPLY 0.4 BY WRK-DS-06V06 ROUNDED. NC1014.2 +059100 MPY-TEST-F1-6-1. NC1014.2 +059200 IF WRK-DS-12V00-S EQUAL TO 000008888889 NC1014.2 +059300 PERFORM PASS NC1014.2 +059400 GO TO MPY-WRITE-F1-6. NC1014.2 +059500 GO TO MPY-FAIL-F1-6. NC1014.2 +059600 MPY-DELETE-F1-6. NC1014.2 +059700 PERFORM DE-LETE. NC1014.2 +059800 GO TO MPY-WRITE-F1-6. NC1014.2 +059900 MPY-FAIL-F1-6. NC1014.2 +060000 MOVE WRK-DS-12V00-S TO COMPUTED-18V0. NC1014.2 +060100 MOVE 000008888889 TO CORRECT-18V0. NC1014.2 +060200 PERFORM FAIL. NC1014.2 +060300 MPY-WRITE-F1-6. NC1014.2 +060400 MOVE "MPY-TEST-F1-6 " TO PAR-NAME. NC1014.2 +060500 PERFORM PRINT-DETAIL. NC1014.2 +060600 NC1014.2 +060700 MPY-INIT-F1-7. NC1014.2 +060800 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +060900 MOVE "0" TO WRK-XN-00001. NC1014.2 +061000 MOVE A10ONES-DS-10V00 TO WRK-DS-10V00. NC1014.2 +061100 MPY-TEST-F1-7-0. NC1014.2 +061200 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +061300 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +061400 MPY-TEST-F1-7-1. NC1014.2 +061500 IF WRK-DS-10V00 EQUAL TO 1111111111 NC1014.2 +061600 PERFORM PASS NC1014.2 +061700 GO TO MPY-WRITE-F1-7-1. NC1014.2 +061800 GO TO MPY-FAIL-F1-7-1. NC1014.2 +061900 MPY-DELETE-F1-7-1. NC1014.2 +062000 PERFORM DE-LETE. NC1014.2 +062100 GO TO MPY-WRITE-F1-7-1. NC1014.2 +062200 MPY-FAIL-F1-7-1. NC1014.2 +062300 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1014.2 +062400 MOVE 1111111111 TO CORRECT-18V0. NC1014.2 +062500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1014.2 +062600 PERFORM FAIL. NC1014.2 +062700 MPY-WRITE-F1-7-1. NC1014.2 +062800 MOVE "MPY-TEST-F1-7-1 " TO PAR-NAME. NC1014.2 +062900 PERFORM PRINT-DETAIL. NC1014.2 +063000 MPY-TEST-F1-7-2. NC1014.2 +063100 IF WRK-XN-00001 EQUAL TO "1" NC1014.2 +063200 PERFORM PASS NC1014.2 +063300 GO TO MPY-WRITE-F1-7-2. NC1014.2 +063400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1014.2 +063500 MOVE "1" TO CORRECT-A. NC1014.2 +063600 MOVE WRK-XN-00001 TO COMPUTED-A. NC1014.2 +063700 PERFORM FAIL. NC1014.2 +063800 GO TO MPY-WRITE-F1-7-2. NC1014.2 +063900 MPY-DELETE-F1-7-2. NC1014.2 +064000 PERFORM DE-LETE. NC1014.2 +064100 MPY-WRITE-F1-7-2. NC1014.2 +064200 MOVE "MPY-TEST-F1-7-2 " TO PAR-NAME. NC1014.2 +064300 PERFORM PRINT-DETAIL. NC1014.2 +064400 NC1014.2 +064500 MPY-INIT-F1-8. NC1014.2 +064600 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +064700 MOVE "1" TO WRK-XN-00001. NC1014.2 +064800 MOVE -99 TO WRK-DS-02V00. NC1014.2 +064900 MPY-TEST-F1-8-0. NC1014.2 +065000 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +065100 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1014.2 +065200 MPY-TEST-F1-8-1. NC1014.2 +065300 IF WRK-DS-02V00 EQUAL TO 00 NC1014.2 +065400 PERFORM PASS NC1014.2 +065500 GO TO MPY-WRITE-F1-8-1. NC1014.2 +065600 GO TO MPY-FAIL-F1-8-1. NC1014.2 +065700 MPY-DELETE-F1-8-1. NC1014.2 +065800 PERFORM DE-LETE. NC1014.2 +065900 GO TO MPY-WRITE-F1-8-1. NC1014.2 +066000 MPY-FAIL-F1-8-1. NC1014.2 +066100 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1014.2 +066200 MOVE 00 TO CORRECT-N. NC1014.2 +066300 PERFORM FAIL. NC1014.2 +066400 MPY-WRITE-F1-8-1. NC1014.2 +066500 MOVE "MPY-TEST-F1-8-1 " TO PAR-NAME. NC1014.2 +066600 PERFORM PRINT-DETAIL. NC1014.2 +066700 MPY-TEST-F1-8-2. NC1014.2 +066800 IF WRK-XN-00001 EQUAL TO "1" NC1014.2 +066900 PERFORM PASS NC1014.2 +067000 GO TO MPY-WRITE-F1-8-2. NC1014.2 +067100 MOVE "1" TO CORRECT-A. NC1014.2 +067200 MOVE WRK-XN-00001 TO COMPUTED-A. NC1014.2 +067300 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1014.2 +067400 PERFORM FAIL. NC1014.2 +067500 GO TO MPY-WRITE-F1-8-2. NC1014.2 +067600 MPY-DELETE-F1-8-2. NC1014.2 +067700 PERFORM DE-LETE. NC1014.2 +067800 MPY-WRITE-F1-8-2. NC1014.2 +067900 MOVE "MPY-TEST-F1-8-2 " TO PAR-NAME. NC1014.2 +068000 PERFORM PRINT-DETAIL. NC1014.2 +068100 NC1014.2 +068200 MPY-INIT-F1-9. NC1014.2 +068300 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +068400 MOVE "0" TO WRK-XN-00001. NC1014.2 +068500 MOVE -01 TO WRK-DS-02V00. NC1014.2 +068600 MPY-TEST-F1-9-0. NC1014.2 +068700 MULTIPLY 99.5 BY WRK-DS-02V00 ROUNDED NC1014.2 +068800 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +068900 MPY-TEST-F1-9-1. NC1014.2 +069000 IF WRK-DS-02V00 EQUAL TO -01 NC1014.2 +069100 PERFORM PASS NC1014.2 +069200 GO TO MPY-WRITE-F1-9-1. NC1014.2 +069300 GO TO MPY-FAIL-F1-9-1. NC1014.2 +069400 MPY-DELETE-F1-9-1. NC1014.2 +069500 PERFORM DE-LETE. NC1014.2 +069600 GO TO MPY-WRITE-F1-9-1. NC1014.2 +069700 MPY-FAIL-F1-9-1. NC1014.2 +069800 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1014.2 +069900 MOVE -01 TO CORRECT-N. NC1014.2 +070000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1014.2 +070100 PERFORM FAIL. NC1014.2 +070200 MPY-WRITE-F1-9-1. NC1014.2 +070300 MOVE "MPY-TEST-F1-9-1 " TO PAR-NAME. NC1014.2 +070400 PERFORM PRINT-DETAIL. NC1014.2 +070500 MPY-TEST-F1-9-2. NC1014.2 +070600 IF WRK-XN-00001 EQUAL TO "1" NC1014.2 +070700 PERFORM PASS NC1014.2 +070800 GO TO MPY-WRITE-F1-9-2. NC1014.2 +070900 MOVE "1" TO CORRECT-A. NC1014.2 +071000 MOVE WRK-XN-00001 TO COMPUTED-A. NC1014.2 +071100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1014.2 +071200 PERFORM FAIL. NC1014.2 +071300 GO TO MPY-WRITE-F1-9-2. NC1014.2 +071400 MPY-DELETE-F1-9-2. NC1014.2 +071500 PERFORM DE-LETE. NC1014.2 +071600 MPY-WRITE-F1-9-2. NC1014.2 +071700 MOVE "MPY-TEST-F1-9-2 " TO PAR-NAME. NC1014.2 +071800 PERFORM PRINT-DETAIL. NC1014.2 +071900 NC1014.2 +072000 MPY-INIT-F1-10. NC1014.2 +072100 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +072200 MOVE "1" TO WRK-XN-00001. NC1014.2 +072300 MOVE -01 TO WRK-DS-02V00. NC1014.2 +072400 MPY-TEST-F1-10-0. NC1014.2 +072500 MULTIPLY 99.4 BY WRK-DS-02V00 ROUNDED NC1014.2 +072600 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1014.2 +072700 MPY-TEST-F1-10-1. NC1014.2 +072800 IF WRK-DS-02V00 EQUAL TO -99 NC1014.2 +072900 PERFORM PASS NC1014.2 +073000 GO TO MPY-WRITE-F1-10-1. NC1014.2 +073100 GO TO MPY-FAIL-F1-10-1. NC1014.2 +073200 MPY-DELETE-F1-10-1. NC1014.2 +073300 PERFORM DE-LETE. NC1014.2 +073400 GO TO MPY-WRITE-F1-10-1. NC1014.2 +073500 MPY-FAIL-F1-10-1. NC1014.2 +073600 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1014.2 +073700 MOVE -99 TO CORRECT-N. NC1014.2 +073800 PERFORM FAIL. NC1014.2 +073900 MPY-WRITE-F1-10-1. NC1014.2 +074000 MOVE "MPY-TEST-F1-10-1 " TO PAR-NAME. NC1014.2 +074100 PERFORM PRINT-DETAIL. NC1014.2 +074200 MPY-TEST-F1-10-2. NC1014.2 +074300 IF WRK-XN-00001 EQUAL TO "1" NC1014.2 +074400 PERFORM PASS NC1014.2 +074500 GO TO MPY-WRITE-F1-10-2. NC1014.2 +074600 MOVE "1" TO CORRECT-A. NC1014.2 +074700 MOVE WRK-XN-00001 TO COMPUTED-A. NC1014.2 +074800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1014.2 +074900 PERFORM FAIL. NC1014.2 +075000 GO TO MPY-WRITE-F1-10-2. NC1014.2 +075100 MPY-DELETE-F1-10-2. NC1014.2 +075200 PERFORM DE-LETE. NC1014.2 +075300 MPY-WRITE-F1-10-2. NC1014.2 +075400 MOVE "MPY-TEST-F1-10-2 " TO PAR-NAME. NC1014.2 +075500 PERFORM PRINT-DETAIL. NC1014.2 +075600 NC1014.2 +075700 MPY-INIT-F1-11. NC1014.2 +075800 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +075900 MOVE -990 TO WRK-DS-0201P. NC1014.2 +076000 MPY-TEST-F1-11-0. NC1014.2 +076100 MULTIPLY A01ONE-CS-00V01 BY WRK-DS-0201P. NC1014.2 +076200 MPY-TEST-F1-11. NC1014.2 +076300 MOVE WRK-DS-0201P TO WRK-DS-05V00. NC1014.2 +076400 IF WRK-DS-05V00 EQUAL TO -00090 NC1014.2 +076500 PERFORM PASS NC1014.2 +076600 GO TO MPY-WRITE-F1-11. NC1014.2 +076700 MOVE -00090 TO CORRECT-N. NC1014.2 +076800 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1014.2 +076900 PERFORM FAIL. NC1014.2 +077000 GO TO MPY-WRITE-F1-11. NC1014.2 +077100 MPY-DELETE-F1-11. NC1014.2 +077200 PERFORM DE-LETE. NC1014.2 +077300 MPY-WRITE-F1-11. NC1014.2 +077400 MOVE "MPY-TEST-F1-11 " TO PAR-NAME. NC1014.2 +077500 PERFORM PRINT-DETAIL. NC1014.2 +077600 NC1014.2 +077700 MPY-INIT-F1-12. NC1014.2 +077800 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +077900 MOVE A18ONES-DS-18V00 TO WRK-CS-18V00. NC1014.2 +078000 MPY-TEST-F1-12-0. NC1014.2 +078100 MULTIPLY A01ONE-DS-P0801 BY WRK-CS-18V00. NC1014.2 +078200 MPY-TEST-F1-12. NC1014.2 +078300 MOVE WRK-CS-18V00 TO WRK-DU-18V00. NC1014.2 +078400 IF WRK-DU-18V00 EQUAL TO 000000000111111111 NC1014.2 +078500 PERFORM PASS NC1014.2 +078600 GO TO MPY-WRITE-F1-12. NC1014.2 +078700 MOVE 000000000111111111 TO CORRECT-18V0. NC1014.2 +078800 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1014.2 +078900 PERFORM FAIL. NC1014.2 +079000 GO TO MPY-WRITE-F1-12. NC1014.2 +079100 MPY-DELETE-F1-12. NC1014.2 +079200 PERFORM DE-LETE. NC1014.2 +079300 MPY-WRITE-F1-12. NC1014.2 +079400 MOVE "MPY-TEST-F1-12 " TO PAR-NAME. NC1014.2 +079500 PERFORM PRINT-DETAIL. NC1014.2 +079600* NC1014.2 +079700* NC1014.2 +079800 MPY-INIT-F1-13. NC1014.2 +079900* ===--> NEW SIZE ERROR TESTS <--=== NC1014.2 +080000 MOVE "VI-67 6.4.2 " TO ANSI-REFERENCE. NC1014.2 +080100 MOVE "MPY-TEST-F1-13 " TO PAR-NAME. NC1014.2 +080200 MOVE "0" TO WRK-XN-00001. NC1014.2 +080300 MOVE 1111111111 TO WRK-DS-10V00. NC1014.2 +080400 MOVE 1 TO REC-CT. NC1014.2 +080500 MPY-TEST-F1-13-0. NC1014.2 +080600 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +080700 ON SIZE ERROR GO TO MPY-TEST-F1-13-1 NC1014.2 +080800 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +080900 GO TO MPY-TEST-F1-13-1. NC1014.2 +081000 MPY-DELETE-F1-13. NC1014.2 +081100 PERFORM DE-LETE. NC1014.2 +081200 PERFORM PRINT-DETAIL. NC1014.2 +081300 GO TO MPY-INIT-F1-14. NC1014.2 +081400 MPY-TEST-F1-13-1. NC1014.2 +081500 MOVE "MPY-TEST-F1-13-1" TO PAR-NAME NC1014.2 +081600 IF WRK-XN-00001 = "0" NC1014.2 +081700 PERFORM PASS NC1014.2 +081800 PERFORM PRINT-DETAIL NC1014.2 +081900 ELSE NC1014.2 +082000 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +082100 MOVE "0" TO CORRECT-X NC1014.2 +082200 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1014.2 +082300 PERFORM FAIL NC1014.2 +082400 PERFORM PRINT-DETAIL. NC1014.2 +082500 ADD 1 TO REC-CT. NC1014.2 +082600 MPY-TEST-F1-13-2. NC1014.2 +082700 MOVE "MPY-TEST-F1-13-2" TO PAR-NAME NC1014.2 +082800 IF WRK-DS-10V00 = 1111111111 NC1014.2 +082900 PERFORM PASS NC1014.2 +083000 PERFORM PRINT-DETAIL NC1014.2 +083100 ELSE NC1014.2 +083200 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +083300 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +083400 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1014.2 +083500 PERFORM FAIL NC1014.2 +083600 PERFORM PRINT-DETAIL. NC1014.2 +083700* NC1014.2 +083800* NC1014.2 +083900 MPY-INIT-F1-14. NC1014.2 +084000* ===--> NEW SIZE ERROR TESTS <--=== NC1014.2 +084100 MOVE "VI-67 6.4.2 " TO ANSI-REFERENCE. NC1014.2 +084200 MOVE "MPY-TEST-F1-14 " TO PAR-NAME. NC1014.2 +084300 MOVE "1" TO WRK-XN-00001. NC1014.2 +084400 MOVE 1 TO REC-CT. NC1014.2 +084500 MOVE -99 TO WRK-DS-02V00. NC1014.2 +084600 MPY-TEST-F1-14-0. NC1014.2 +084700 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +084800 ON SIZE ERROR GO TO MPY-TEST-F1-14-1 NC1014.2 +084900 NOT ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1014.2 +085000 GO TO MPY-TEST-F1-14-1. NC1014.2 +085100 MPY-DELETE-F1-14. NC1014.2 +085200 PERFORM DE-LETE. NC1014.2 +085300 PERFORM PRINT-DETAIL. NC1014.2 +085400 GO TO MPY-INIT-F1-15. NC1014.2 +085500 MPY-TEST-F1-14-1. NC1014.2 +085600 MOVE "MPY-TEST-F1-14-1" TO PAR-NAME. NC1014.2 +085700 IF WRK-XN-00001 = "0" NC1014.2 +085800 PERFORM PASS NC1014.2 +085900 PERFORM PRINT-DETAIL NC1014.2 +086000 ELSE NC1014.2 +086100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +086200 MOVE "0" TO CORRECT-X NC1014.2 +086300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +086400 TO RE-MARK NC1014.2 +086500 PERFORM FAIL NC1014.2 +086600 PERFORM PRINT-DETAIL. NC1014.2 +086700 ADD 1 TO REC-CT. NC1014.2 +086800 MPY-TEST-F1-14-2. NC1014.2 +086900 MOVE "MPY-TEST-F1-14-2" TO PAR-NAME. NC1014.2 +087000 IF WRK-DS-02V00 = 00 NC1014.2 +087100 PERFORM PASS NC1014.2 +087200 PERFORM PRINT-DETAIL NC1014.2 +087300 ELSE NC1014.2 +087400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +087500 MOVE 00 TO CORRECT-N NC1014.2 +087600 PERFORM FAIL NC1014.2 +087700 PERFORM PRINT-DETAIL. NC1014.2 +087800* NC1014.2 +087900* NC1014.2 +088000 MPY-INIT-F1-15. NC1014.2 +088100* ===--> NEW SIZE ERROR TESTS <--=== NC1014.2 +088200 MOVE "VI-67 6.4.2 " TO ANSI-REFERENCE. NC1014.2 +088300 MOVE "0" TO WRK-XN-00001. NC1014.2 +088400 MOVE 1111111111 TO WRK-DS-10V00. NC1014.2 +088500 MOVE 1 TO REC-CT. NC1014.2 +088600 MPY-TEST-F1-15-0. NC1014.2 +088700 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +088800 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +088900 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1014.2 +089000 GO TO MPY-TEST-F1-15-1. NC1014.2 +089100 MPY-DELETE-F1-15. NC1014.2 +089200 PERFORM DE-LETE. NC1014.2 +089300 PERFORM PRINT-DETAIL. NC1014.2 +089400 GO TO MPY-INIT-F1-16. NC1014.2 +089500 MPY-TEST-F1-15-1. NC1014.2 +089600 MOVE "MPY-TEST-F1-15-1" TO PAR-NAME. NC1014.2 +089700 IF WRK-XN-00001 = "1" NC1014.2 +089800 PERFORM PASS NC1014.2 +089900 PERFORM PRINT-DETAIL NC1014.2 +090000 ELSE NC1014.2 +090100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +090200 MOVE "1" TO CORRECT-X NC1014.2 +090300 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1014.2 +090400 PERFORM FAIL NC1014.2 +090500 PERFORM PRINT-DETAIL. NC1014.2 +090600 ADD 1 TO REC-CT. NC1014.2 +090700 MPY-TEST-F1-15-2. NC1014.2 +090800 MOVE "MPY-TEST-F1-15-2" TO PAR-NAME. NC1014.2 +090900 IF WRK-DS-10V00 = 1111111111 NC1014.2 +091000 PERFORM PASS NC1014.2 +091100 PERFORM PRINT-DETAIL NC1014.2 +091200 ELSE NC1014.2 +091300 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +091400 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +091500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1014.2 +091600 PERFORM FAIL NC1014.2 +091700 PERFORM PRINT-DETAIL. NC1014.2 +091800* NC1014.2 +091900* NC1014.2 +092000 MPY-INIT-F1-16. NC1014.2 +092100* ===--> NEW SIZE ERROR TESTS <--=== NC1014.2 +092200 MOVE "VI-67 6.4.2 " TO ANSI-REFERENCE. NC1014.2 +092300 MOVE "0" TO WRK-XN-00001. NC1014.2 +092400 MOVE -99 TO WRK-DS-02V00. NC1014.2 +092500 MOVE 1 TO REC-CT. NC1014.2 +092600 MPY-TEST-F1-16-0. NC1014.2 +092700 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +092800 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +092900 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1014.2 +093000 GO TO MPY-TEST-F1-16-1. NC1014.2 +093100 MPY-DELETE-F1-16. NC1014.2 +093200 PERFORM DE-LETE. NC1014.2 +093300 PERFORM PRINT-DETAIL. NC1014.2 +093400 GO TO MPY-INIT-F1-17. NC1014.2 +093500 MPY-TEST-F1-16-1. NC1014.2 +093600 MOVE "MPY-TEST-F1-16-1" TO PAR-NAME. NC1014.2 +093700 IF WRK-XN-00001 = "2" NC1014.2 +093800 PERFORM PASS NC1014.2 +093900 PERFORM PRINT-DETAIL NC1014.2 +094000 ELSE NC1014.2 +094100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +094200 MOVE "2" TO CORRECT-X NC1014.2 +094300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +094400 TO RE-MARK NC1014.2 +094500 PERFORM FAIL NC1014.2 +094600 PERFORM PRINT-DETAIL. NC1014.2 +094700 ADD 1 TO REC-CT. NC1014.2 +094800 MPY-TEST-F1-16-2. NC1014.2 +094900 MOVE "MPY-TEST-F1-16-2" TO PAR-NAME. NC1014.2 +095000 IF WRK-DS-02V00 = 00 NC1014.2 +095100 PERFORM PASS NC1014.2 +095200 PERFORM PRINT-DETAIL NC1014.2 +095300 ELSE NC1014.2 +095400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +095500 MOVE 00 TO CORRECT-N NC1014.2 +095600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1014.2 +095700 PERFORM FAIL NC1014.2 +095800 PERFORM PRINT-DETAIL. NC1014.2 +095900* NC1014.2 +096000* NC1014.2 +096100 MPY-INIT-F1-17. NC1014.2 +096200 MOVE "VI-106 6.19.4 GR1" TO ANSI-REFERENCE. NC1014.2 +096300* ===--> MULTIPLE RESULT FIELDS <--=== NC1014.2 +096400 MOVE "MPY-TEST-F1-17" TO PAR-NAME. NC1014.2 +096500 MOVE .00001 TO WRK-DU-4P1-1. NC1014.2 +096600 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +096700 MOVE 1 TO REC-CT. NC1014.2 +096800 MPY-TEST-F1-17-0. NC1014.2 +096900 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-5V1-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +097000 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 WRK-DU-0V12-1. NC1014.2 +097100 GO TO MPY-TEST-F1-17-1. NC1014.2 +097200 MPY-DELETE-F1-17. NC1014.2 +097300 PERFORM DE-LETE. NC1014.2 +097400 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +097500 PERFORM PRINT-DETAIL. NC1014.2 +097600 GO TO MPY-INIT-F1-18. NC1014.2 +097700 MPY-TEST-F1-17-1. NC1014.2 +097800 IF WRK-DU-5V1-1 = .1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +097900 ELSE NC1014.2 +098000 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE .1 NC1014.2 +098100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +098200 ADD 1 TO REC-CT. NC1014.2 +098300 MPY-TEST-F1-17-2. NC1014.2 +098400 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +098500 ELSE NC1014.2 +098600 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +098700 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +098800 ADD 1 TO REC-CT. NC1014.2 +098900 MPY-TEST-F1-17-3. NC1014.2 +099000 IF WRK-DU-6V0-1 = 1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +099100 ELSE NC1014.2 +099200 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 1 NC1014.2 +099300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +099400 ADD 1 TO REC-CT. NC1014.2 +099500 MPY-TEST-F1-17-4. NC1014.2 +099600 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +099700 ELSE NC1014.2 +099800 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +099900 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +100000 ADD 1 TO REC-CT. NC1014.2 +100100 MPY-TEST-F1-17-5. NC1014.2 +100200 IF WRK-DU-0V12-1 = .0000000001 PERFORM PASS PERFORM NC1014.2 +100300 PRINT-DETAIL ELSE NC1014.2 +100400 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +100500 .0000000001 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +100600* NC1014.2 +100700 MPY-INIT-F1-18. NC1014.2 +100800* => SIZE ERROR CONDITION. <--== NC1014.2 +100900* ==--> MULTIPLE RESULT FIELDS<--== NC1014.2 +101000* ===--> & SIZE ERROR CONDITIONS<--=== NC1014.2 +101100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +101200 MOVE "MPY-TEST-F1-18" TO PAR-NAME. NC1014.2 +101300 MOVE "0" TO WRK-XN-00001. NC1014.2 +101400 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +101500 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +101600 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +101700 MOVE 0 TO WRK-DU-0V12-1. NC1014.2 +101800 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +101900 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +102000 MOVE 1 TO REC-CT. NC1014.2 +102100 MPY-TEST-F1-18-0. NC1014.2 +102200 MULTIPLY WRK-DU-5V1-1 BY WRK-DU-2V0-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +102300 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 WRK-DU-0V12-1 NC1014.2 +102400 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +102500 GO TO MPY-TEST-F1-18-1. NC1014.2 +102600 MPY-DELETE-F1-18. NC1014.2 +102700 PERFORM DE-LETE. NC1014.2 +102800 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +102900 PERFORM PRINT-DETAIL. NC1014.2 +103000 GO TO MPY-INIT-F1-19. NC1014.2 +103100 MPY-TEST-F1-18-1. NC1014.2 +103200 IF WRK-DU-2V0-1 = 99 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +103300 ELSE NC1014.2 +103400 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 99 NC1014.2 +103500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +103600 ADD 1 TO REC-CT. NC1014.2 +103700 MPY-TEST-F1-18-2. NC1014.2 +103800 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +103900 ELSE NC1014.2 +104000 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +104100 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +104200 ADD 1 TO REC-CT. NC1014.2 +104300 MPY-TEST-F1-18-3. NC1014.2 +104400 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +104500 ELSE NC1014.2 +104600 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +104700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +104800 ADD 1 TO REC-CT. NC1014.2 +104900 MPY-TEST-F1-18-4. NC1014.2 +105000 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +105100 ELSE NC1014.2 +105200 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +105300 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +105400 ADD 1 TO REC-CT. NC1014.2 +105500 MPY-TEST-F1-18-5. NC1014.2 +105600 IF WRK-DU-0V12-1 = 0 PERFORM PASS PERFORM NC1014.2 +105700 PRINT-DETAIL ELSE NC1014.2 +105800 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE 0 NC1014.2 +105900 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +106000 ADD 1 TO REC-CT. NC1014.2 +106100 MPY-TEST-F1-18-6. NC1014.2 +106200 IF WRK-XN-00001 = "1" NC1014.2 +106300 PERFORM PASS NC1014.2 +106400 PERFORM PRINT-DETAIL NC1014.2 +106500 ELSE NC1014.2 +106600 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC1014.2 +106700 TO RE-MARK NC1014.2 +106800 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +106900 MOVE "1" TO CORRECT-X NC1014.2 +107000 PERFORM PRINT-DETAIL. NC1014.2 +107100* NC1014.2 +107200 MPY-INIT-F1-19. NC1014.2 +107300* ==--> NO SIZE ERROR CONDITION. <--== NC1014.2 +107400* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +107500* ===--> & SIZE ERROR CONDITIONS <--=== NC1014.2 +107600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +107700 MOVE "MPY-TEST-F1-19" TO PAR-NAME. NC1014.2 +107800 MOVE "0" TO WRK-XN-00001. NC1014.2 +107900 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +108000 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +108100 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +108200 MOVE .00001 TO WRK-DU-0V12-1. NC1014.2 +108300 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +108400 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +108500 MOVE .00001 TO WRK-DU-4P1-1. NC1014.2 +108600 MOVE 1 TO REC-CT. NC1014.2 +108700 MPY-TEST-F1-19-0. NC1014.2 +108800 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-5V1-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +108900 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 NC1014.2 +109000 WRK-DU-0V12-1 NC1014.2 +109100 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +109200 GO TO MPY-TEST-F1-19-1. NC1014.2 +109300 MPY-DELETE-F1-19. NC1014.2 +109400 PERFORM DE-LETE. NC1014.2 +109500 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +109600 PERFORM PRINT-DETAIL. NC1014.2 +109700 GO TO MPY-INIT-F1-20. NC1014.2 +109800 MPY-TEST-F1-19-1. NC1014.2 +109900 IF WRK-DU-5V1-1 = .1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +110000 ELSE NC1014.2 +110100 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE .1 NC1014.2 +110200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +110300 ADD 1 TO REC-CT. NC1014.2 +110400 MPY-TEST-F1-19-2. NC1014.2 +110500 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +110600 ELSE NC1014.2 +110700 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +110800 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +110900 ADD 1 TO REC-CT. NC1014.2 +111000 MPY-TEST-F1-19-3. NC1014.2 +111100 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +111200 ELSE NC1014.2 +111300 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +111400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +111500 ADD 1 TO REC-CT. NC1014.2 +111600 MPY-TEST-F1-19-4. NC1014.2 +111700 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +111800 ELSE NC1014.2 +111900 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +112000 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +112100 ADD 1 TO REC-CT. NC1014.2 +112200 MPY-TEST-F1-19-5. NC1014.2 +112300 IF WRK-DU-0V12-1 = .0000000001 PERFORM PASS PERFORM NC1014.2 +112400 PRINT-DETAIL ELSE NC1014.2 +112500 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +112600 .0000000001 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +112700 ADD 1 TO REC-CT. NC1014.2 +112800 MPY-TEST-F1-19-6. NC1014.2 +112900 IF WRK-XN-00001 = "0" NC1014.2 +113000 PERFORM PASS NC1014.2 +113100 PERFORM PRINT-DETAIL NC1014.2 +113200 ELSE NC1014.2 +113300 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC1014.2 +113400 TO RE-MARK NC1014.2 +113500 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +113600 MOVE "0" TO CORRECT-X NC1014.2 +113700 PERFORM PRINT-DETAIL. NC1014.2 +113800* NC1014.2 +113900 MPY-INIT-F1-20. NC1014.2 +114000* ==--> SIZE ERROR CONDITION. <--== NC1014.2 +114100* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +114200* ==--> NEW SIZE ERROR TESTS <--== NC1014.2 +114300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +114400 MOVE "MPY-TEST-F1-20" TO PAR-NAME. NC1014.2 +114500 MOVE "0" TO WRK-XN-00001. NC1014.2 +114600 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +114700 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +114800 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +114900 MOVE 0 TO WRK-DU-0V12-1. NC1014.2 +115000 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +115100 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +115200 MOVE 1 TO REC-CT. NC1014.2 +115300 MPY-TEST-F1-20-0. NC1014.2 +115400 MULTIPLY WRK-DU-5V1-1 BY WRK-DU-2V0-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +115500 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 WRK-DU-0V12-1 NC1014.2 +115600 ON SIZE ERROR GO TO MPY-TEST-F1-20-1 NC1014.2 +115700 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +115800 GO TO MPY-TEST-F1-20-1. NC1014.2 +115900 MPY-DELETE-F1-20. NC1014.2 +116000 PERFORM DE-LETE. NC1014.2 +116100 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +116200 PERFORM PRINT-DETAIL. NC1014.2 +116300 GO TO MPY-INIT-F1-21. NC1014.2 +116400 MPY-TEST-F1-20-1. NC1014.2 +116500 IF WRK-DU-2V0-1 = 99 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +116600 ELSE NC1014.2 +116700 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 99 NC1014.2 +116800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +116900 ADD 1 TO REC-CT. NC1014.2 +117000 MPY-TEST-F1-20-2. NC1014.2 +117100 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +117200 ELSE NC1014.2 +117300 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +117400 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +117500 ADD 1 TO REC-CT. NC1014.2 +117600 MPY-TEST-F1-20-3. NC1014.2 +117700 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +117800 ELSE NC1014.2 +117900 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +118000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +118100 ADD 1 TO REC-CT. NC1014.2 +118200 MPY-TEST-F1-20-4. NC1014.2 +118300 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +118400 ELSE NC1014.2 +118500 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +118600 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +118700 ADD 1 TO REC-CT. NC1014.2 +118800 MPY-TEST-F1-20-5. NC1014.2 +118900 IF WRK-DU-0V12-1 = 0 PERFORM PASS PERFORM NC1014.2 +119000 PRINT-DETAIL ELSE NC1014.2 +119100 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE 0 NC1014.2 +119200 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +119300 ADD 1 TO REC-CT. NC1014.2 +119400 MPY-TEST-F1-20-6. NC1014.2 +119500 IF WRK-XN-00001 = "0" NC1014.2 +119600 PERFORM PASS NC1014.2 +119700 PERFORM PRINT-DETAIL NC1014.2 +119800 ELSE NC1014.2 +119900 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC1014.2 +120000 TO RE-MARK NC1014.2 +120100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +120200 MOVE "0" TO CORRECT-X NC1014.2 +120300 PERFORM PRINT-DETAIL. NC1014.2 +120400* NC1014.2 +120500 MPY-INIT-F1-21. NC1014.2 +120600* ==--> NO SIZE ERROR CONDITION. <--== NC1014.2 +120700* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +120800* ==--> NEW SIZE ERROR TESTS <--== NC1014.2 +120900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +121000 MOVE "MPY-TEST-F1-21" TO PAR-NAME. NC1014.2 +121100 MOVE "0" TO WRK-XN-00001. NC1014.2 +121200 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +121300 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +121400 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +121500 MOVE .00001 TO WRK-DU-0V12-1. NC1014.2 +121600 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +121700 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +121800 MOVE .00001 TO WRK-DU-4P1-1. NC1014.2 +121900 MOVE 1 TO REC-CT. NC1014.2 +122000 MPY-TEST-F1-21-0. NC1014.2 +122100 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-5V1-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +122200 WRK-DU-6V0-1 ROUNDED NC1014.2 +122300 WRK-DU-6V0-2 ROUNDED WRK-DU-0V12-1 NC1014.2 +122400 ON SIZE ERROR GO TO MPY-TEST-F1-21-1 NC1014.2 +122500 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1014.2 +122600 GO TO MPY-TEST-F1-21-1. NC1014.2 +122700 MPY-DELETE-F1-21. NC1014.2 +122800 PERFORM DE-LETE. NC1014.2 +122900 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +123000 PERFORM PRINT-DETAIL. NC1014.2 +123100 GO TO MPY-INIT-F1-22. NC1014.2 +123200 MPY-TEST-F1-21-1. NC1014.2 +123300 IF WRK-DU-5V1-1 = .1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +123400 ELSE NC1014.2 +123500 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE .1 NC1014.2 +123600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +123700 ADD 1 TO REC-CT. NC1014.2 +123800 MPY-TEST-F1-21-2. NC1014.2 +123900 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +124000 ELSE NC1014.2 +124100 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +124200 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +124300 ADD 1 TO REC-CT. NC1014.2 +124400 MPY-TEST-F1-21-3. NC1014.2 +124500 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +124600 ELSE NC1014.2 +124700 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 1 NC1014.2 +124800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +124900 ADD 1 TO REC-CT. NC1014.2 +125000 MPY-TEST-F1-21-4. NC1014.2 +125100 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +125200 ELSE NC1014.2 +125300 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +125400 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +125500 ADD 1 TO REC-CT. NC1014.2 +125600 MPY-TEST-F1-21-5. NC1014.2 +125700 IF WRK-DU-0V12-1 = .0000000001 PERFORM PASS PERFORM NC1014.2 +125800 PRINT-DETAIL ELSE NC1014.2 +125900 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +126000 .0000000001 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +126100 ADD 1 TO REC-CT. NC1014.2 +126200 MPY-TEST-F1-21-6. NC1014.2 +126300 IF WRK-XN-00001 = "1" NC1014.2 +126400 PERFORM PASS NC1014.2 +126500 PERFORM PRINT-DETAIL NC1014.2 +126600 ELSE NC1014.2 +126700 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1014.2 +126800 TO RE-MARK NC1014.2 +126900 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +127000 MOVE "1" TO CORRECT-X NC1014.2 +127100 PERFORM PRINT-DETAIL. NC1014.2 +127200* NC1014.2 +127300 MPY-INIT-F1-22. NC1014.2 +127400* ==--> SIZE ERROR CONDITION. <--== NC1014.2 +127500* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +127600* ==--> NEW SIZE ERROR TESTS <--== NC1014.2 +127700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +127800 MOVE "MPY-TEST-F1-22" TO PAR-NAME. NC1014.2 +127900 MOVE "0" TO WRK-XN-00001. NC1014.2 +128000 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +128100 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +128200 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +128300 MOVE 0 TO WRK-DU-0V12-1. NC1014.2 +128400 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +128500 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +128600 MOVE 1 TO REC-CT. NC1014.2 +128700 MPY-TEST-F1-22-0. NC1014.2 +128800 MULTIPLY WRK-DU-5V1-1 BY WRK-DU-2V0-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +128900 WRK-DU-6V0-1 ROUNDED WRK-DU-6V0-2 WRK-DU-0V12-1 NC1014.2 +129000 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +129100 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1014.2 +129200 GO TO MPY-TEST-F1-22-1. NC1014.2 +129300 MPY-DELETE-F1-22. NC1014.2 +129400 PERFORM DE-LETE. NC1014.2 +129500 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +129600 PERFORM PRINT-DETAIL. NC1014.2 +129700 GO TO MPY-INIT-F1-23. NC1014.2 +129800 MPY-TEST-F1-22-1. NC1014.2 +129900 IF WRK-DU-5V1-1 = 12345.6 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +130000 ELSE NC1014.2 +130100 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE 12345.6 NC1014.2 +130200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +130300 ADD 1 TO REC-CT. NC1014.2 +130400 MPY-TEST-F1-22-2. NC1014.2 +130500 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +130600 ELSE NC1014.2 +130700 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +130800 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +130900 ADD 1 TO REC-CT. NC1014.2 +131000 MPY-TEST-F1-22-3. NC1014.2 +131100 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +131200 ELSE NC1014.2 +131300 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +131400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +131500 ADD 1 TO REC-CT. NC1014.2 +131600 MPY-TEST-F1-22-4. NC1014.2 +131700 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +131800 ELSE NC1014.2 +131900 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +132000 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +132100 ADD 1 TO REC-CT. NC1014.2 +132200 MPY-TEST-F1-22-5. NC1014.2 +132300 IF WRK-DU-0V12-1 = 0 PERFORM PASS PERFORM NC1014.2 +132400 PRINT-DETAIL ELSE NC1014.2 +132500 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +132600 0 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +132700 ADD 1 TO REC-CT. NC1014.2 +132800 MPY-TEST-F1-22-6. NC1014.2 +132900 IF WRK-XN-00001 = "1" NC1014.2 +133000 PERFORM PASS NC1014.2 +133100 PERFORM PRINT-DETAIL NC1014.2 +133200 ELSE NC1014.2 +133300 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC1014.2 +133400 TO RE-MARK NC1014.2 +133500 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +133600 MOVE "1" TO CORRECT-X NC1014.2 +133700 PERFORM PRINT-DETAIL. NC1014.2 +133800* NC1014.2 +133900* NC1014.2 +134000 MPY-INIT-F1-23. NC1014.2 +134100* ==--> NO SIZE ERROR CONDITION. <--== NC1014.2 +134200* ==--> MULTIPLE RESULT FIELDS <--== NC1014.2 +134300* ==--> NEW SIZE ERROR TESTS <--== NC1014.2 +134400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1014.2 +134500 MOVE "MPY-TEST-F1-23" TO PAR-NAME. NC1014.2 +134600 MOVE "0" TO WRK-XN-00001. NC1014.2 +134700 MOVE 0 TO WRK-DU-2P4-1. NC1014.2 +134800 MOVE 0 TO WRK-DU-6V0-1. NC1014.2 +134900 MOVE 0 TO WRK-DU-6V0-2. NC1014.2 +135000 MOVE .00001 TO WRK-DU-0V12-1. NC1014.2 +135100 MOVE 99 TO WRK-DU-2V0-1. NC1014.2 +135200 MOVE 12345.6 TO WRK-DU-5V1-1. NC1014.2 +135300 MOVE .00001 TO WRK-DU-4P1-1. NC1014.2 +135400 MOVE 1 TO REC-CT. NC1014.2 +135500 MPY-TEST-F1-23-0. NC1014.2 +135600 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-5V1-1 ROUNDED WRK-DU-2P4-1 NC1014.2 +135700 WRK-DU-6V0-1 ROUNDED NC1014.2 +135800 WRK-DU-6V0-2 ROUNDED WRK-DU-0V12-1 NC1014.2 +135900 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +136000 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1014.2 +136100 GO TO MPY-TEST-F1-23-1. NC1014.2 +136200 MPY-DELETE-F1-23. NC1014.2 +136300 PERFORM DE-LETE. NC1014.2 +136400 MOVE "*DELETED BY FCTC*" TO FEATURE. NC1014.2 +136500 PERFORM PRINT-DETAIL. NC1014.2 +136600 GO TO MPY-INIT-F1-24. NC1014.2 +136700 MPY-TEST-F1-23-1. NC1014.2 +136800 IF WRK-DU-5V1-1 = .1 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +136900 ELSE NC1014.2 +137000 PERFORM FAIL MOVE WRK-DU-5V1-1 TO COMPUTED-N MOVE .1 NC1014.2 +137100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +137200 ADD 1 TO REC-CT. NC1014.2 +137300 MPY-TEST-F1-23-2. NC1014.2 +137400 IF WRK-DU-2P4-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +137500 ELSE NC1014.2 +137600 PERFORM FAIL MOVE WRK-DU-2P4-1 TO COMPUTED-N MOVE 0 TO NC1014.2 +137700 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +137800 ADD 1 TO REC-CT. NC1014.2 +137900 MPY-TEST-F1-23-3. NC1014.2 +138000 IF WRK-DU-6V0-1 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +138100 ELSE NC1014.2 +138200 PERFORM FAIL MOVE WRK-DU-6V0-1 TO COMPUTED-N MOVE 0 NC1014.2 +138300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +138400 ADD 1 TO REC-CT. NC1014.2 +138500 MPY-TEST-F1-23-4. NC1014.2 +138600 IF WRK-DU-6V0-2 = 0 PERFORM PASS PERFORM PRINT-DETAIL NC1014.2 +138700 ELSE NC1014.2 +138800 PERFORM FAIL MOVE WRK-DU-6V0-2 TO COMPUTED-N MOVE 0 TO NC1014.2 +138900 CORRECT-N PERFORM PRINT-DETAIL. NC1014.2 +139000 ADD 1 TO REC-CT. NC1014.2 +139100 MPY-TEST-F1-23-5. NC1014.2 +139200 IF WRK-DU-0V12-1 = .0000000001 PERFORM PASS PERFORM NC1014.2 +139300 PRINT-DETAIL ELSE NC1014.2 +139400 PERFORM FAIL MOVE WRK-DU-0V12-1 TO COMPUTED-0V18 MOVE NC1014.2 +139500 .0000000001 TO CORRECT-0V18 PERFORM PRINT-DETAIL. NC1014.2 +139600 ADD 1 TO REC-CT. NC1014.2 +139700 MPY-TEST-F1-23-6. NC1014.2 +139800 IF WRK-XN-00001 = "2" NC1014.2 +139900 PERFORM PASS NC1014.2 +140000 PERFORM PRINT-DETAIL NC1014.2 +140100 ELSE NC1014.2 +140200 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1014.2 +140300 TO RE-MARK NC1014.2 +140400 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +140500 MOVE "1" TO CORRECT-X NC1014.2 +140600 PERFORM PRINT-DETAIL. NC1014.2 +140700* NC1014.2 +140800* NC1014.2 +140900 MPY-INIT-F1-24. NC1014.2 +141000* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +141100* ==--> SIZE ERROR CONDITION <--== NC1014.2 +141200 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1014.2 +141300 MOVE "MPY-TEST-F1-24" TO PAR-NAME NC1014.2 +141400 MOVE "0" TO WRK-XN-00001. NC1014.2 +141500 MOVE A10ONES-DS-10V00 TO WRK-DS-10V00. NC1014.2 +141600 MOVE 0 TO WRK-DS-05V00. NC1014.2 +141700 MOVE 0 TO WRK-DS-02V00. NC1014.2 +141800 MOVE 0 TO WRK-CS-18V00. NC1014.2 +141900 MOVE 1 TO REC-CT. NC1014.2 +142000 MPY-TEST-F1-24-0. NC1014.2 +142100 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +142200 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +142300 MOVE 23 TO WRK-DS-05V00 NC1014.2 +142400 MOVE -4 TO WRK-DS-02V00 NC1014.2 +142500 END-MULTIPLY NC1014.2 +142600 MOVE 99 TO WRK-CS-18V00. NC1014.2 +142700 GO TO MPY-TEST-F1-24-1. NC1014.2 +142800 MPY-DELETE-F1-24-1. NC1014.2 +142900 PERFORM DE-LETE. NC1014.2 +143000 PERFORM PRINT-DETAIL. NC1014.2 +143100 GO TO MPY-INIT-F1-25. NC1014.2 +143200 MPY-TEST-F1-24-1. NC1014.2 +143300 MOVE "MPY-TEST-F1-24-1" TO PAR-NAME. NC1014.2 +143400 IF WRK-XN-00001 = "1" NC1014.2 +143500 PERFORM PASS NC1014.2 +143600 PERFORM PRINT-DETAIL NC1014.2 +143700 ELSE NC1014.2 +143800 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +143900 MOVE "1" TO CORRECT-X NC1014.2 +144000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1014.2 +144100 PERFORM FAIL NC1014.2 +144200 PERFORM PRINT-DETAIL. NC1014.2 +144300 ADD 1 TO REC-CT. NC1014.2 +144400 MPY-TEST-F1-24-2. NC1014.2 +144500 MOVE "MPY-TEST-F1-24-2" TO PAR-NAME. NC1014.2 +144600 IF WRK-DS-05V00 = 23 NC1014.2 +144700 PERFORM PASS NC1014.2 +144800 PERFORM PRINT-DETAIL NC1014.2 +144900 ELSE NC1014.2 +145000 MOVE WRK-DS-05V00 TO COMPUTED-N NC1014.2 +145100 MOVE 23 TO CORRECT-N NC1014.2 +145200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1014.2 +145300 PERFORM FAIL NC1014.2 +145400 PERFORM PRINT-DETAIL. NC1014.2 +145500 ADD 1 TO REC-CT. NC1014.2 +145600 MPY-TEST-F1-24-3. NC1014.2 +145700 MOVE "MPY-TEST-F1-24-3" TO PAR-NAME. NC1014.2 +145800 IF WRK-DS-02V00 = -4 NC1014.2 +145900 PERFORM PASS NC1014.2 +146000 PERFORM PRINT-DETAIL NC1014.2 +146100 ELSE NC1014.2 +146200 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +146300 MOVE -4 TO CORRECT-N NC1014.2 +146400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1014.2 +146500 PERFORM FAIL NC1014.2 +146600 PERFORM PRINT-DETAIL. NC1014.2 +146700 ADD 1 TO REC-CT. NC1014.2 +146800 MPY-TEST-F1-24-4. NC1014.2 +146900 MOVE "MPY-TEST-F1-24-4" TO PAR-NAME. NC1014.2 +147000 IF WRK-DS-10V00 = 1111111111 NC1014.2 +147100 PERFORM PASS NC1014.2 +147200 PERFORM PRINT-DETAIL NC1014.2 +147300 ELSE NC1014.2 +147400 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +147500 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +147600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1014.2 +147700 PERFORM FAIL NC1014.2 +147800 PERFORM PRINT-DETAIL. NC1014.2 +147900 ADD 1 TO REC-CT. NC1014.2 +148000 MPY-TEST-F1-24-5. NC1014.2 +148100 MOVE "MPY-TEST-F1-24-5" TO PAR-NAME. NC1014.2 +148200 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +148300 PERFORM PASS NC1014.2 +148400 PERFORM PRINT-DETAIL NC1014.2 +148500 ELSE NC1014.2 +148600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +148700 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +148800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +148900 PERFORM FAIL NC1014.2 +149000 PERFORM PRINT-DETAIL. NC1014.2 +149100* NC1014.2 +149200* NC1014.2 +149300 MPY-INIT-F1-25. NC1014.2 +149400* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +149500 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1014.2 +149600 MOVE "MPY-TEST-F1-25" TO PAR-NAME NC1014.2 +149700 MOVE "1" TO WRK-XN-00001. NC1014.2 +149800 MOVE -99 TO WRK-DS-02V00. NC1014.2 +149900 MOVE 0 TO WRK-DS-10V00. NC1014.2 +150000 MOVE 0 TO WRK-DS-01V00. NC1014.2 +150100 MOVE 0 TO WRK-CS-18V00. NC1014.2 +150200 MOVE 1 TO REC-CT. NC1014.2 +150300 MPY-TEST-F1-25-0. NC1014.2 +150400 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +150500 ON SIZE ERROR MOVE "0" TO WRK-XN-00001 NC1014.2 +150600 MOVE 23 TO WRK-DS-10V00 NC1014.2 +150700 MOVE -4 TO WRK-DS-01V00 NC1014.2 +150800 END-MULTIPLY NC1014.2 +150900 MOVE 99 TO WRK-CS-18V00. NC1014.2 +151000 GO TO MPY-TEST-F1-25-1. NC1014.2 +151100 MPY-DELETE-F1-25-1. NC1014.2 +151200 PERFORM DE-LETE. NC1014.2 +151300 PERFORM PRINT-DETAIL. NC1014.2 +151400 GO TO MPY-INIT-F1-26. NC1014.2 +151500 MPY-TEST-F1-25-1. NC1014.2 +151600 MOVE "MPY-TEST-F1-25-1" TO PAR-NAME. NC1014.2 +151700 IF WRK-XN-00001 = "1" NC1014.2 +151800 PERFORM PASS NC1014.2 +151900 PERFORM PRINT-DETAIL NC1014.2 +152000 ELSE NC1014.2 +152100 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +152200 MOVE "1" TO CORRECT-X NC1014.2 +152300 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARKNC1014.2 +152400 PERFORM FAIL NC1014.2 +152500 PERFORM PRINT-DETAIL. NC1014.2 +152600 ADD 1 TO REC-CT. NC1014.2 +152700 MPY-TEST-F1-25-2. NC1014.2 +152800 MOVE "MPY-TEST-F1-25-2" TO PAR-NAME. NC1014.2 +152900 IF WRK-DS-10V00 = 0000000000 NC1014.2 +153000 PERFORM PASS NC1014.2 +153100 PERFORM PRINT-DETAIL NC1014.2 +153200 ELSE NC1014.2 +153300 MOVE WRK-DS-10V00 TO COMPUTED-N NC1014.2 +153400 MOVE 0000000000 TO CORRECT-N NC1014.2 +153500 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARKNC1014.2 +153600 PERFORM FAIL NC1014.2 +153700 PERFORM PRINT-DETAIL. NC1014.2 +153800 ADD 1 TO REC-CT. NC1014.2 +153900 MPY-TEST-F1-25-3. NC1014.2 +154000 MOVE "MPY-TEST-F1-25-3" TO PAR-NAME. NC1014.2 +154100 IF WRK-DS-01V00 = 0 NC1014.2 +154200 PERFORM PASS NC1014.2 +154300 PERFORM PRINT-DETAIL NC1014.2 +154400 ELSE NC1014.2 +154500 MOVE WRK-DS-01V00 TO COMPUTED-N NC1014.2 +154600 MOVE 0 TO CORRECT-N NC1014.2 +154700 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARKNC1014.2 +154800 PERFORM FAIL NC1014.2 +154900 PERFORM PRINT-DETAIL. NC1014.2 +155000 ADD 1 TO REC-CT. NC1014.2 +155100 MPY-TEST-F1-25-4. NC1014.2 +155200 MOVE "MPY-TEST-F1-25-4" TO PAR-NAME. NC1014.2 +155300 IF WRK-DS-02V00 = 00 NC1014.2 +155400 PERFORM PASS NC1014.2 +155500 PERFORM PRINT-DETAIL NC1014.2 +155600 ELSE NC1014.2 +155700 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +155800 MOVE 00 TO CORRECT-N NC1014.2 +155900 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARKNC1014.2 +156000 PERFORM FAIL NC1014.2 +156100 PERFORM PRINT-DETAIL. NC1014.2 +156200 ADD 1 TO REC-CT. NC1014.2 +156300 MPY-TEST-F1-25-5. NC1014.2 +156400 MOVE "MPY-TEST-F1-25-5" TO PAR-NAME. NC1014.2 +156500 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +156600 PERFORM PASS NC1014.2 +156700 PERFORM PRINT-DETAIL NC1014.2 +156800 ELSE NC1014.2 +156900 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +157000 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +157100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +157200 PERFORM FAIL NC1014.2 +157300 PERFORM PRINT-DETAIL. NC1014.2 +157400* NC1014.2 +157500* NC1014.2 +157600 MPY-INIT-F1-26. NC1014.2 +157700* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +157800 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1014.2 +157900 MOVE "MPY-TEST-F1-26" TO PAR-NAME NC1014.2 +158000 MOVE "0" TO WRK-XN-00001. NC1014.2 +158100 MOVE A10ONES-DS-10V00 TO WRK-DS-10V00. NC1014.2 +158200 MOVE 0 TO WRK-DS-05V00. NC1014.2 +158300 MOVE 0 TO WRK-DS-02V00. NC1014.2 +158400 MOVE 0 TO WRK-CS-18V00. NC1014.2 +158500 MOVE 1 TO REC-CT. NC1014.2 +158600 MPY-TEST-F1-26-0. NC1014.2 +158700 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +158800 ON SIZE ERROR GO TO MPY-TEST-F1-26-01 NC1014.2 +158900 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +159000 MOVE 23 TO WRK-DS-05V00 NC1014.2 +159100 MOVE -4 TO WRK-DS-02V00 NC1014.2 +159200 END-MULTIPLY. NC1014.2 +159300 MPY-TEST-F1-26-01. NC1014.2 +159400 MOVE 99 TO WRK-CS-18V00. NC1014.2 +159500 GO TO MPY-TEST-F1-26-1. NC1014.2 +159600 MPY-DELETE-F1-26-1. NC1014.2 +159700 PERFORM DE-LETE. NC1014.2 +159800 PERFORM PRINT-DETAIL. NC1014.2 +159900 GO TO MPY-INIT-F1-27. NC1014.2 +160000 MPY-TEST-F1-26-1. NC1014.2 +160100 MOVE "MPY-TEST-F1-26-1" TO PAR-NAME. NC1014.2 +160200 IF WRK-XN-00001 = "0" NC1014.2 +160300 PERFORM PASS NC1014.2 +160400 PERFORM PRINT-DETAIL NC1014.2 +160500 ELSE NC1014.2 +160600 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +160700 MOVE "0" TO CORRECT-X NC1014.2 +160800 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1014.2 +160900 TO RE-MARK NC1014.2 +161000 PERFORM FAIL NC1014.2 +161100 PERFORM PRINT-DETAIL. NC1014.2 +161200 ADD 1 TO REC-CT. NC1014.2 +161300 MPY-TEST-F1-26-2. NC1014.2 +161400 MOVE "MPY-TEST-F1-26-2" TO PAR-NAME. NC1014.2 +161500 IF WRK-DS-05V00 = 00000 NC1014.2 +161600 PERFORM PASS NC1014.2 +161700 PERFORM PRINT-DETAIL NC1014.2 +161800 ELSE NC1014.2 +161900 MOVE WRK-DS-05V00 TO COMPUTED-N NC1014.2 +162000 MOVE 0 TO CORRECT-N NC1014.2 +162100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1014.2 +162200 TO RE-MARK NC1014.2 +162300 PERFORM FAIL NC1014.2 +162400 PERFORM PRINT-DETAIL. NC1014.2 +162500 ADD 1 TO REC-CT. NC1014.2 +162600 MPY-TEST-F1-26-3. NC1014.2 +162700 MOVE "MPY-TEST-F1-26-3" TO PAR-NAME. NC1014.2 +162800 IF WRK-DS-02V00 = 0 NC1014.2 +162900 PERFORM PASS NC1014.2 +163000 PERFORM PRINT-DETAIL NC1014.2 +163100 ELSE NC1014.2 +163200 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +163300 MOVE 0 TO CORRECT-N NC1014.2 +163400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1014.2 +163500 TO RE-MARK NC1014.2 +163600 PERFORM FAIL NC1014.2 +163700 PERFORM PRINT-DETAIL. NC1014.2 +163800 ADD 1 TO REC-CT. NC1014.2 +163900 MPY-TEST-F1-26-4. NC1014.2 +164000 MOVE "MPY-TEST-F1-26-4" TO PAR-NAME. NC1014.2 +164100 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +164200 PERFORM PASS NC1014.2 +164300 PERFORM PRINT-DETAIL NC1014.2 +164400 ELSE NC1014.2 +164500 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +164600 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +164700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +164800 PERFORM FAIL NC1014.2 +164900 PERFORM PRINT-DETAIL. NC1014.2 +165000 ADD 1 TO REC-CT. NC1014.2 +165100 MPY-TEST-F1-26-5. NC1014.2 +165200 MOVE "MPY-TEST-F1-26-5" TO PAR-NAME. NC1014.2 +165300 IF WRK-DS-10V00 = 1111111111 NC1014.2 +165400 PERFORM PASS NC1014.2 +165500 PERFORM PRINT-DETAIL NC1014.2 +165600 ELSE NC1014.2 +165700 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +165800 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +165900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1014.2 +166000 TO RE-MARK NC1014.2 +166100 PERFORM FAIL NC1014.2 +166200 PERFORM PRINT-DETAIL. NC1014.2 +166300* NC1014.2 +166400* NC1014.2 +166500 MPY-INIT-F1-27. NC1014.2 +166600* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +166700 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1014.2 +166800 MOVE "1" TO WRK-XN-00001. NC1014.2 +166900 MOVE -99 TO WRK-DS-02V00. NC1014.2 +167000 MOVE 0 TO WRK-DS-10V00. NC1014.2 +167100 MOVE 0 TO WRK-DS-01V00. NC1014.2 +167200 MOVE 0 TO WRK-DS-18V00. NC1014.2 +167300 MOVE 1 TO REC-CT. NC1014.2 +167400 MPY-TEST-F1-27-0. NC1014.2 +167500 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +167600 ON SIZE ERROR GO TO MPY-TEST-F1-27-01 NC1014.2 +167700 NOT ON SIZE ERROR MOVE "0" TO WRK-XN-00001 NC1014.2 +167800 MOVE 23 TO WRK-DS-10V00 NC1014.2 +167900 MOVE -4 TO WRK-DS-01V00 NC1014.2 +168000 END-MULTIPLY. NC1014.2 +168100 MPY-TEST-F1-27-01. NC1014.2 +168200 MOVE 99 TO WRK-CS-18V00. NC1014.2 +168300 GO TO MPY-TEST-F1-27-1. NC1014.2 +168400 MPY-DELETE-F1-27-1. NC1014.2 +168500 PERFORM DE-LETE. NC1014.2 +168600 PERFORM PRINT-DETAIL. NC1014.2 +168700 GO TO MPY-INIT-F1-28. NC1014.2 +168800 MPY-TEST-F1-27-1. NC1014.2 +168900 MOVE "MPY-TEST-F1-27-1" TO PAR-NAME. NC1014.2 +169000 IF WRK-XN-00001 = "0" NC1014.2 +169100 PERFORM PASS NC1014.2 +169200 PERFORM PRINT-DETAIL NC1014.2 +169300 ELSE NC1014.2 +169400 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +169500 MOVE "0" TO CORRECT-X NC1014.2 +169600 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +169700 TO RE-MARK NC1014.2 +169800 PERFORM FAIL NC1014.2 +169900 PERFORM PRINT-DETAIL. NC1014.2 +170000 ADD 1 TO REC-CT. NC1014.2 +170100 MPY-TEST-F1-27-2. NC1014.2 +170200 MOVE "MPY-TEST-F1-27-2" TO PAR-NAME. NC1014.2 +170300 IF WRK-DS-10V00 = 23 NC1014.2 +170400 PERFORM PASS NC1014.2 +170500 PERFORM PRINT-DETAIL NC1014.2 +170600 ELSE NC1014.2 +170700 MOVE WRK-DS-10V00 TO COMPUTED-N NC1014.2 +170800 MOVE 23 TO CORRECT-N NC1014.2 +170900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +171000 TO RE-MARK NC1014.2 +171100 PERFORM FAIL NC1014.2 +171200 PERFORM PRINT-DETAIL. NC1014.2 +171300 ADD 1 TO REC-CT. NC1014.2 +171400 MPY-TEST-F1-27-3. NC1014.2 +171500 MOVE "MPY-TEST-F1-27-3" TO PAR-NAME. NC1014.2 +171600 IF WRK-DS-02V00 = 00 NC1014.2 +171700 PERFORM PASS NC1014.2 +171800 PERFORM PRINT-DETAIL NC1014.2 +171900 ELSE NC1014.2 +172000 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +172100 MOVE 00 TO CORRECT-N NC1014.2 +172200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +172300 TO RE-MARK NC1014.2 +172400 PERFORM FAIL NC1014.2 +172500 PERFORM PRINT-DETAIL. NC1014.2 +172600 ADD 1 TO REC-CT. NC1014.2 +172700 MPY-TEST-F1-27-4. NC1014.2 +172800 MOVE "MPY-TEST-F1-27-4" TO PAR-NAME. NC1014.2 +172900 IF WRK-DS-01V00 = -4 NC1014.2 +173000 PERFORM PASS NC1014.2 +173100 PERFORM PRINT-DETAIL NC1014.2 +173200 ELSE NC1014.2 +173300 MOVE WRK-DS-01V00 TO COMPUTED-N NC1014.2 +173400 MOVE -4 TO CORRECT-N NC1014.2 +173500 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1014.2 +173600 TO RE-MARK NC1014.2 +173700 PERFORM FAIL NC1014.2 +173800 PERFORM PRINT-DETAIL. NC1014.2 +173900 ADD 1 TO REC-CT. NC1014.2 +174000 MPY-TEST-F1-27-5. NC1014.2 +174100 MOVE "MPY-TEST-F1-27-5" TO PAR-NAME NC1014.2 +174200 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +174300 PERFORM PASS NC1014.2 +174400 PERFORM PRINT-DETAIL NC1014.2 +174500 ELSE NC1014.2 +174600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +174700 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +174800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +174900 PERFORM FAIL NC1014.2 +175000 PERFORM PRINT-DETAIL. NC1014.2 +175100* NC1014.2 +175200* NC1014.2 +175300 MPY-INIT-F1-28. NC1014.2 +175400* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +175500 MOVE A10ONES-DS-10V00 TO WRK-DS-10V00. NC1014.2 +175600 MOVE "0" TO WRK-XN-00001. NC1014.2 +175700 MOVE 0 TO WRK-CS-18V00. NC1014.2 +175800 MOVE 1 TO REC-CT. NC1014.2 +175900 MPY-TEST-F1-28-0. NC1014.2 +176000 MULTIPLY A12THREES-DS-06V06 BY WRK-DS-10V00 NC1014.2 +176100 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +176200 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001 NC1014.2 +176300 END-MULTIPLY NC1014.2 +176400 MOVE 99 TO WRK-CS-18V00. NC1014.2 +176500 GO TO MPY-TEST-F1-28-1. NC1014.2 +176600 MPY-DELETE-F1-28-1. NC1014.2 +176700 PERFORM DE-LETE. NC1014.2 +176800 PERFORM PRINT-DETAIL. NC1014.2 +176900 GO TO MPY-INIT-F1-29. NC1014.2 +177000 MPY-TEST-F1-28-1. NC1014.2 +177100 MOVE "MPY-TEST-F1-28-1" TO PAR-NAME. NC1014.2 +177200 IF WRK-XN-00001 = "1" NC1014.2 +177300 PERFORM PASS NC1014.2 +177400 PERFORM PRINT-DETAIL NC1014.2 +177500 ELSE NC1014.2 +177600 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +177700 MOVE "1" TO CORRECT-X NC1014.2 +177800 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" NC1014.2 +177900 TO RE-MARK NC1014.2 +178000 PERFORM FAIL NC1014.2 +178100 PERFORM PRINT-DETAIL. NC1014.2 +178200 ADD 1 TO REC-CT. NC1014.2 +178300 MPY-TEST-F1-28-2. NC1014.2 +178400 MOVE "MPY-TEST-F1-28-2" TO PAR-NAME. NC1014.2 +178500 IF WRK-DS-10V00 = 1111111111 NC1014.2 +178600 PERFORM PASS NC1014.2 +178700 PERFORM PRINT-DETAIL NC1014.2 +178800 ELSE NC1014.2 +178900 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1014.2 +179000 MOVE 1111111111 TO CORRECT-18V0 NC1014.2 +179100 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" NC1014.2 +179200 TO RE-MARK NC1014.2 +179300 PERFORM FAIL NC1014.2 +179400 PERFORM PRINT-DETAIL. NC1014.2 +179500 ADD 1 TO REC-CT. NC1014.2 +179600 MPY-TEST-F1-28-3. NC1014.2 +179700 MOVE "MPY-TEST-F1-28-3" TO PAR-NAME. NC1014.2 +179800 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +179900 PERFORM PASS NC1014.2 +180000 PERFORM PRINT-DETAIL NC1014.2 +180100 ELSE NC1014.2 +180200 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +180300 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +180400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +180500 PERFORM FAIL NC1014.2 +180600 PERFORM PRINT-DETAIL. NC1014.2 +180700* NC1014.2 +180800* NC1014.2 +180900 MPY-INIT-F1-29. NC1014.2 +181000* ==-->EXPLICIT SCOPE TERMINATOR <--== NC1014.2 +181100 MOVE "0" TO WRK-XN-00001. NC1014.2 +181200 MOVE -99 TO WRK-DS-02V00. NC1014.2 +181300 MOVE ZERO TO WRK-CS-18V00. NC1014.2 +181400 MOVE 1 TO REC-CT. NC1014.2 +181500 MPY-TEST-F1-29-0. NC1014.2 +181600 MULTIPLY AZERO-DS-05V05 BY WRK-DS-02V00 NC1014.2 +181700 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1014.2 +181800 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001 NC1014.2 +181900 END-MULTIPLY NC1014.2 +182000 MOVE 99 TO WRK-CS-18V00. NC1014.2 +182100 GO TO MPY-TEST-F1-29-1. NC1014.2 +182200 MPY-DELETE-F1-29-1. NC1014.2 +182300 PERFORM DE-LETE. NC1014.2 +182400 PERFORM PRINT-DETAIL. NC1014.2 +182500 GO TO CCVS-EXIT. NC1014.2 +182600 MPY-TEST-F1-29-1. NC1014.2 +182700 MOVE "MPY-TEST-F1-29-1" TO PAR-NAME. NC1014.2 +182800 IF WRK-XN-00001 = "2" NC1014.2 +182900 PERFORM PASS NC1014.2 +183000 PERFORM PRINT-DETAIL NC1014.2 +183100 ELSE NC1014.2 +183200 MOVE WRK-XN-00001 TO COMPUTED-X NC1014.2 +183300 MOVE "2" TO CORRECT-X NC1014.2 +183400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1014.2 +183500 TO RE-MARK NC1014.2 +183600 PERFORM FAIL NC1014.2 +183700 PERFORM PRINT-DETAIL. NC1014.2 +183800 ADD 1 TO REC-CT. NC1014.2 +183900 MPY-TEST-F1-29-2. NC1014.2 +184000 MOVE "MPY-TEST-F1-29-2" TO PAR-NAME. NC1014.2 +184100 IF WRK-DS-02V00 = 00 NC1014.2 +184200 PERFORM PASS NC1014.2 +184300 PERFORM PRINT-DETAIL NC1014.2 +184400 ELSE NC1014.2 +184500 MOVE WRK-DS-02V00 TO COMPUTED-N NC1014.2 +184600 MOVE 00 TO CORRECT-N NC1014.2 +184700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1014.2 +184800 TO RE-MARK NC1014.2 +184900 PERFORM FAIL NC1014.2 +185000 PERFORM PRINT-DETAIL. NC1014.2 +185100 ADD 1 TO REC-CT. NC1014.2 +185200 MPY-TEST-F1-29-3. NC1014.2 +185300 MOVE "MPY-TEST-F1-29-3" TO PAR-NAME. NC1014.2 +185400 IF WRK-CS-18V00 = 000000000000000099 NC1014.2 +185500 PERFORM PASS NC1014.2 +185600 PERFORM PRINT-DETAIL NC1014.2 +185700 ELSE NC1014.2 +185800 MOVE WRK-CS-18V00 TO COMPUTED-N NC1014.2 +185900 MOVE 000000000000000099 TO CORRECT-N NC1014.2 +186000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1014.2 +186100 PERFORM FAIL NC1014.2 +186200 PERFORM PRINT-DETAIL. NC1014.2 +186300* NC1014.2 +186400* NC1014.2 +186500 CCVS-EXIT SECTION. NC1014.2 +186600 CCVS-999999. NC1014.2 +186700 GO TO CLOSE-FILES. NC1014.2 diff --git a/tests/cobol85/NC/NC101A.log b/tests/cobol85/NC/NC101A.log new file mode 100755 index 00000000..5bf31364 --- /dev/null +++ b/tests/cobol85/NC/NC101A.log @@ -0,0 +1,146 @@ + + OFFICIAL COBOL COMPILER VALIDATION SYSTEM + + CCVS85 4.2 COPY - NOT FOR DISTRIBUTION + +TEST RESULT OF NC101A IN HIGH LEVEL VALIDATION FOR ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. + + + FOR OFFICIAL USE ONLY COBOL 85 VERSION 4.2, Apr 1993 SSVG COPYRIGHT 1985 + + + FEATURE PASS PARAGRAPH-NAME REMARKS + TESTED FAIL + + *********************************************************************************************************************** + MULTIPLY BY PASS MPY-TEST-F1-1 + MULTIPLY BY PASS MPY-TEST-F1-2 + MULTIPLY BY PASS MPY-TEST-F1-3-1 + MULTIPLY BY PASS MPY-TEST-F1-3-2 + MULTIPLY BY PASS MPY-TEST-F1-4-1 + MULTIPLY BY PASS MPY-TEST-F1-4-2 + MULTIPLY BY PASS MPY-TEST-F1-5 + MULTIPLY BY PASS MPY-TEST-F1-6 + MULTIPLY BY PASS MPY-TEST-F1-7-1 + MULTIPLY BY PASS MPY-TEST-F1-7-2 + MULTIPLY BY PASS MPY-TEST-F1-8-1 + MULTIPLY BY PASS MPY-TEST-F1-8-2 + MULTIPLY BY PASS MPY-TEST-F1-9-1 + MULTIPLY BY PASS MPY-TEST-F1-9-2 + MULTIPLY BY PASS MPY-TEST-F1-10-1 + MULTIPLY BY PASS MPY-TEST-F1-10-2 + MULTIPLY BY PASS MPY-TEST-F1-11 + MULTIPLY BY PASS MPY-TEST-F1-12 + MULTIPLY BY PASS MPY-TEST-F1-13-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-13-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-14-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-14-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-15-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-15-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-16-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-16-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-17 .01 + MULTIPLY BY PASS MPY-TEST-F1-17 .02 + OFFICIAL COBOL COMPILER VALIDATION SYSTEM + + CCVS85 4.2 COPY - NOT FOR DISTRIBUTION + +TEST RESULT OF NC101A IN HIGH LEVEL VALIDATION FOR ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. + + + FOR OFFICIAL USE ONLY COBOL 85 VERSION 4.2, Apr 1993 SSVG COPYRIGHT 1985 + + + FEATURE PASS PARAGRAPH-NAME REMARKS + TESTED FAIL + *********************************************************************************************************************** + MULTIPLY BY PASS MPY-TEST-F1-17 .03 + MULTIPLY BY PASS MPY-TEST-F1-17 .04 + MULTIPLY BY PASS MPY-TEST-F1-17 .05 + MULTIPLY BY PASS MPY-TEST-F1-18 .01 + MULTIPLY BY PASS MPY-TEST-F1-18 .02 + MULTIPLY BY PASS MPY-TEST-F1-18 .03 + MULTIPLY BY PASS MPY-TEST-F1-18 .04 + MULTIPLY BY PASS MPY-TEST-F1-18 .05 + MULTIPLY BY PASS MPY-TEST-F1-18 .06 + MULTIPLY BY PASS MPY-TEST-F1-19 .01 + MULTIPLY BY PASS MPY-TEST-F1-19 .02 + MULTIPLY BY PASS MPY-TEST-F1-19 .03 + MULTIPLY BY PASS MPY-TEST-F1-19 .04 + MULTIPLY BY PASS MPY-TEST-F1-19 .05 + MULTIPLY BY PASS MPY-TEST-F1-19 .06 + MULTIPLY BY PASS MPY-TEST-F1-20 .01 + MULTIPLY BY PASS MPY-TEST-F1-20 .02 + MULTIPLY BY PASS MPY-TEST-F1-20 .03 + MULTIPLY BY PASS MPY-TEST-F1-20 .04 + MULTIPLY BY PASS MPY-TEST-F1-20 .05 + MULTIPLY BY PASS MPY-TEST-F1-20 .06 + MULTIPLY BY PASS MPY-TEST-F1-21 .01 + MULTIPLY BY PASS MPY-TEST-F1-21 .02 + MULTIPLY BY PASS MPY-TEST-F1-21 .03 + MULTIPLY BY PASS MPY-TEST-F1-21 .04 + MULTIPLY BY PASS MPY-TEST-F1-21 .05 + MULTIPLY BY PASS MPY-TEST-F1-21 .06 + MULTIPLY BY PASS MPY-TEST-F1-22 .01 + MULTIPLY BY PASS MPY-TEST-F1-22 .02 + MULTIPLY BY PASS MPY-TEST-F1-22 .03 + MULTIPLY BY PASS MPY-TEST-F1-22 .04 + MULTIPLY BY PASS MPY-TEST-F1-22 .05 + MULTIPLY BY PASS MPY-TEST-F1-22 .06 + MULTIPLY BY PASS MPY-TEST-F1-23 .01 + MULTIPLY BY PASS MPY-TEST-F1-23 .02 + MULTIPLY BY PASS MPY-TEST-F1-23 .03 + MULTIPLY BY PASS MPY-TEST-F1-23 .04 + MULTIPLY BY PASS MPY-TEST-F1-23 .05 + MULTIPLY BY PASS MPY-TEST-F1-23 .06 + MULTIPLY BY PASS MPY-TEST-F1-24-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-24-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-24-3 .03 + MULTIPLY BY PASS MPY-TEST-F1-24-4 .04 + OFFICIAL COBOL COMPILER VALIDATION SYSTEM + + CCVS85 4.2 COPY - NOT FOR DISTRIBUTION + +TEST RESULT OF NC101A IN HIGH LEVEL VALIDATION FOR ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. + + + FOR OFFICIAL USE ONLY COBOL 85 VERSION 4.2, Apr 1993 SSVG COPYRIGHT 1985 + + + FEATURE PASS PARAGRAPH-NAME REMARKS + TESTED FAIL + *********************************************************************************************************************** + MULTIPLY BY PASS MPY-TEST-F1-24-5 .05 + MULTIPLY BY PASS MPY-TEST-F1-25-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-25-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-25-3 .03 + MULTIPLY BY PASS MPY-TEST-F1-25-4 .04 + MULTIPLY BY PASS MPY-TEST-F1-25-5 .05 + MULTIPLY BY PASS MPY-TEST-F1-26-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-26-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-26-3 .03 + MULTIPLY BY PASS MPY-TEST-F1-26-4 .04 + MULTIPLY BY PASS MPY-TEST-F1-26-5 .05 + MULTIPLY BY PASS MPY-TEST-F1-27-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-27-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-27-3 .03 + MULTIPLY BY PASS MPY-TEST-F1-27-4 .04 + MULTIPLY BY PASS MPY-TEST-F1-27-5 .05 + MULTIPLY BY PASS MPY-TEST-F1-28-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-28-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-28-3 .03 + MULTIPLY BY PASS MPY-TEST-F1-29-1 .01 + MULTIPLY BY PASS MPY-TEST-F1-29-2 .02 + MULTIPLY BY PASS MPY-TEST-F1-29-3 .03 + *********************************************************************************************************************** + + + + + END OF TEST- NC101A + + 093 OF 093 TESTS WERE EXECUTED SUCCESSFULLY + NO TEST(S) FAILED + NO TEST(S) DELETED + NO TEST(S) REQUIRE INSPECTION + FOR OFFICIAL USE ONLY ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. COPYRIGHT 1985 \ No newline at end of file diff --git a/tests/cobol85/NC/NC102A.CBL b/tests/cobol85/NC/NC102A.CBL new file mode 100755 index 00000000..1079ba3e --- /dev/null +++ b/tests/cobol85/NC/NC102A.CBL @@ -0,0 +1,1503 @@ +000100 IDENTIFICATION DIVISION. NC1024.2 +000200 PROGRAM-ID. NC1024.2 +000300 NC102A. NC1024.2 +000400 NC1024.2 +000500**************************************************************** NC1024.2 +000600* * NC1024.2 +000700* VALIDATION FOR:- * NC1024.2 +000800* * NC1024.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1024.2 +001000* * NC1024.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1024.2 +001200* * NC1024.2 +001300**************************************************************** NC1024.2 +001400* * NC1024.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC1024.2 +001600* * NC1024.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC1024.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC1024.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC1024.2 +002000* * NC1024.2 +002100**************************************************************** NC1024.2 +002200* NC1024.2 +002300* THIS PROGRAM TESTS FORMATS 1, 2 AND 3 OF THE "PERFORM" NC1024.2 +002400* STATEMENT, FORMATS 1 AND 2 OF THE "GO" STATEMENT AND NC1024.2 +002500* THE "EXIT" STATEMENT. NC1024.2 +002600* NC1024.2 +002700 ENVIRONMENT DIVISION. NC1024.2 +002800 CONFIGURATION SECTION. NC1024.2 +002900 SOURCE-COMPUTER. NC1024.2 +003000 Linux. NC1024.2 +003100 OBJECT-COMPUTER. NC1024.2 +003200 Linux. NC1024.2 +003300 INPUT-OUTPUT SECTION. NC1024.2 +003400 FILE-CONTROL. NC1024.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1024.2 +003600 "report.log". NC1024.2 +003700 DATA DIVISION. NC1024.2 +003800 FILE SECTION. NC1024.2 +003900 FD PRINT-FILE. NC1024.2 +004000 01 PRINT-REC PICTURE X(120). NC1024.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1024.2 +004200 WORKING-STORAGE SECTION. NC1024.2 +004300 01 PERFORM3 PIC 9 VALUE 5. NC1024.2 +004400 01 WRK-XN-18-1 PIC X(18). NC1024.2 +004500 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1024.2 +004600 01 WRK-DU-X-18V0-1 REDEFINES WRK-XN-18-1 PIC 9(18). NC1024.2 +004700 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1024.2 +004800 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1024.2 +004900 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1024.2 +005000 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1024.2 +005100 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1024.2 +005200 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1024.2 +005300 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1024.2 +005400 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1024.2 +005500 01 WRK-DU-1V5-1 PIC 9V9(5). NC1024.2 +005600 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1024.2 +005700 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1024.2 +005800 01 WRK-DU-2V0-1 PIC 99. NC1024.2 +005900 01 WRK-DU-2V0-2 PIC 99. NC1024.2 +006000 01 WRK-DU-2V0-3 PIC 99. NC1024.2 +006100 01 WRK-DU-2V1-1 PIC 99V9. NC1024.2 +006200 01 WRK-DU-2V1-2 PIC 99V9. NC1024.2 +006300 01 WRK-DU-2V1-3 PIC 99V9. NC1024.2 +006400 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1024.2 +006500 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1024.2 +006600 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1024.2 +006700 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1024.2 +006800 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1024.2 +006900 01 WRK-DU-2V5-1 PIC 99V9(5). NC1024.2 +007000 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1024.2 +007100 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1024.2 +007200 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1024.2 +007300 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1024.2 +007400 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1024.2 +007500 01 WRK-NE-X-1 PIC 9(16).99. NC1024.2 +007600 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1024.2 +007700 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1024.2 +007800 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1024.2 +007900 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1024.2 +008000 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1024.2 +008100 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1024.2 +008200 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1024.2 +008300 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1024.2 +008400 01 WRK-NE-X-2 PIC -9(16).99. NC1024.2 +008500 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1024.2 +008600 01 WRK-NE-2 PIC $**.99. NC1024.2 +008700 01 WRK-NE-3 PIC $99.99CR. NC1024.2 +008800 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1024.2 +008900 77 WRK-DS-02V00 PICTURE S99. NC1024.2 +009000 77 ATWO-DS-01V00 PICTURE S9 NC1024.2 +009100 VALUE 2. NC1024.2 +009200 77 P-COUNT PICTURE 9(6). NC1024.2 +009300 77 THREE PICTURE IS 9 VALUE IS 3. NC1024.2 +009400 77 WS-FOUR PICTURE IS 9 VALUE IS 4. NC1024.2 +009500 77 XRAY PICTURE IS X. NC1024.2 +009600 77 ALTERLOOP PICTURE IS 9 VALUE IS NC1024.2 +009700 ZERO. NC1024.2 +009800 01 NOTE-RECORD. NC1024.2 +009900 02 A PICTURE X VALUE SPACE. NC1024.2 +010000 02 B PICTURE X VALUE SPACE. NC1024.2 +010100 02 C PICTURE X VALUE SPACE. NC1024.2 +010200 02 D PICTURE X VALUE SPACE. NC1024.2 +010300 02 E PICTURE X VALUE SPACE. NC1024.2 +010400 02 F PICTURE X VALUE SPACE. NC1024.2 +010500 02 G PICTURE X VALUE SPACE. NC1024.2 +010600 02 H PICTURE X VALUE SPACE. NC1024.2 +010700 02 I PICTURE X VALUE SPACE. NC1024.2 +010800 02 J PICTURE X VALUE SPACE. NC1024.2 +010900 02 K PICTURE X VALUE SPACE. NC1024.2 +011000 02 L PICTURE X VALUE SPACE. NC1024.2 +011100 02 M PICTURE X VALUE SPACE. NC1024.2 +011200 02 N PICTURE X VALUE SPACE. NC1024.2 +011300 02 O PICTURE X VALUE SPACE. NC1024.2 +011400 02 P PICTURE X VALUE SPACE. NC1024.2 +011500 01 GO-TABLE. NC1024.2 +011600 02 GO-SCRIPT OCCURS 8 TIMES PICTURE 9. NC1024.2 +011700 01 GO-TO-DEPEND PICTURE IS 9 VALUE IS 0. NC1024.2 +011800 01 GO-TO-DEEP PICTURE IS 9 VALUE IS 1. NC1024.2 +011900 01 PERFORM1 PICTURE IS XXX NC1024.2 +012000 VALUE IS SPACE. NC1024.2 +012100 01 PERFORM2 PICTURE IS S999 NC1024.2 +012200 VALUE IS 20. NC1024.2 +012300 01 PERFORM4 PICTURE IS S99V9. NC1024.2 +012400 01 PERFORM5 PICTURE IS 999 NC1024.2 +012500 VALUE IS ZERO. NC1024.2 +012600 01 PERFORM-KEY PICTURE IS 9. NC1024.2 +012700 01 PERFORM-HOLD. NC1024.2 +012800 02 TEST-LETTER OCCURS 20 TIMES PICTURE X. NC1024.2 +012900 01 TEST-RESULTS. NC1024.2 +013000 02 FILLER PIC X VALUE SPACE. NC1024.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. NC1024.2 +013200 02 FILLER PIC X VALUE SPACE. NC1024.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. NC1024.2 +013400 02 FILLER PIC X VALUE SPACE. NC1024.2 +013500 02 PAR-NAME. NC1024.2 +013600 03 FILLER PIC X(19) VALUE SPACE. NC1024.2 +013700 03 PARDOT-X PIC X VALUE SPACE. NC1024.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. NC1024.2 +013900 02 FILLER PIC X(8) VALUE SPACE. NC1024.2 +014000 02 RE-MARK PIC X(61). NC1024.2 +014100 01 TEST-COMPUTED. NC1024.2 +014200 02 FILLER PIC X(30) VALUE SPACE. NC1024.2 +014300 02 FILLER PIC X(17) VALUE NC1024.2 +014400 " COMPUTED=". NC1024.2 +014500 02 COMPUTED-X. NC1024.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1024.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A NC1024.2 +014800 PIC -9(9).9(9). NC1024.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1024.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1024.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1024.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. NC1024.2 +015300 04 COMPUTED-18V0 PIC -9(18). NC1024.2 +015400 04 FILLER PIC X. NC1024.2 +015500 03 FILLER PIC X(50) VALUE SPACE. NC1024.2 +015600 01 TEST-CORRECT. NC1024.2 +015700 02 FILLER PIC X(30) VALUE SPACE. NC1024.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". NC1024.2 +015900 02 CORRECT-X. NC1024.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. NC1024.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1024.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1024.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1024.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1024.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. NC1024.2 +016600 04 CORRECT-18V0 PIC -9(18). NC1024.2 +016700 04 FILLER PIC X. NC1024.2 +016800 03 FILLER PIC X(2) VALUE SPACE. NC1024.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1024.2 +017000 01 CCVS-C-1. NC1024.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1024.2 +017200- "SS PARAGRAPH-NAME NC1024.2 +017300- " REMARKS". NC1024.2 +017400 02 FILLER PIC X(20) VALUE SPACE. NC1024.2 +017500 01 CCVS-C-2. NC1024.2 +017600 02 FILLER PIC X VALUE SPACE. NC1024.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". NC1024.2 +017800 02 FILLER PIC X(15) VALUE SPACE. NC1024.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". NC1024.2 +018000 02 FILLER PIC X(94) VALUE SPACE. NC1024.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1024.2 +018200 01 REC-CT PIC 99 VALUE ZERO. NC1024.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1024.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1024.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1024.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1024.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1024.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1024.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1024.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1024.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1024.2 +019200 01 CCVS-H-1. NC1024.2 +019300 02 FILLER PIC X(39) VALUE SPACES. NC1024.2 +019400 02 FILLER PIC X(42) VALUE NC1024.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1024.2 +019600 02 FILLER PIC X(39) VALUE SPACES. NC1024.2 +019700 01 CCVS-H-2A. NC1024.2 +019800 02 FILLER PIC X(40) VALUE SPACE. NC1024.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1024.2 +020000 02 FILLER PIC XXXX VALUE NC1024.2 +020100 "4.2 ". NC1024.2 +020200 02 FILLER PIC X(28) VALUE NC1024.2 +020300 " COPY - NOT FOR DISTRIBUTION". NC1024.2 +020400 02 FILLER PIC X(41) VALUE SPACE. NC1024.2 +020500 NC1024.2 +020600 01 CCVS-H-2B. NC1024.2 +020700 02 FILLER PIC X(15) VALUE NC1024.2 +020800 "TEST RESULT OF ". NC1024.2 +020900 02 TEST-ID PIC X(9). NC1024.2 +021000 02 FILLER PIC X(4) VALUE NC1024.2 +021100 " IN ". NC1024.2 +021200 02 FILLER PIC X(12) VALUE NC1024.2 +021300 " HIGH ". NC1024.2 +021400 02 FILLER PIC X(22) VALUE NC1024.2 +021500 " LEVEL VALIDATION FOR ". NC1024.2 +021600 02 FILLER PIC X(58) VALUE NC1024.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1024.2 +021800 01 CCVS-H-3. NC1024.2 +021900 02 FILLER PIC X(34) VALUE NC1024.2 +022000 " FOR OFFICIAL USE ONLY ". NC1024.2 +022100 02 FILLER PIC X(58) VALUE NC1024.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1024.2 +022300 02 FILLER PIC X(28) VALUE NC1024.2 +022400 " COPYRIGHT 1985 ". NC1024.2 +022500 01 CCVS-E-1. NC1024.2 +022600 02 FILLER PIC X(52) VALUE SPACE. NC1024.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1024.2 +022800 02 ID-AGAIN PIC X(9). NC1024.2 +022900 02 FILLER PIC X(45) VALUE SPACES. NC1024.2 +023000 01 CCVS-E-2. NC1024.2 +023100 02 FILLER PIC X(31) VALUE SPACE. NC1024.2 +023200 02 FILLER PIC X(21) VALUE SPACE. NC1024.2 +023300 02 CCVS-E-2-2. NC1024.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1024.2 +023500 03 FILLER PIC X VALUE SPACE. NC1024.2 +023600 03 ENDER-DESC PIC X(44) VALUE NC1024.2 +023700 "ERRORS ENCOUNTERED". NC1024.2 +023800 01 CCVS-E-3. NC1024.2 +023900 02 FILLER PIC X(22) VALUE NC1024.2 +024000 " FOR OFFICIAL USE ONLY". NC1024.2 +024100 02 FILLER PIC X(12) VALUE SPACE. NC1024.2 +024200 02 FILLER PIC X(58) VALUE NC1024.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1024.2 +024400 02 FILLER PIC X(13) VALUE SPACE. NC1024.2 +024500 02 FILLER PIC X(15) VALUE NC1024.2 +024600 " COPYRIGHT 1985". NC1024.2 +024700 01 CCVS-E-4. NC1024.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1024.2 +024900 02 FILLER PIC X(4) VALUE " OF ". NC1024.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1024.2 +025100 02 FILLER PIC X(40) VALUE NC1024.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". NC1024.2 +025300 01 XXINFO. NC1024.2 +025400 02 FILLER PIC X(19) VALUE NC1024.2 +025500 "*** INFORMATION ***". NC1024.2 +025600 02 INFO-TEXT. NC1024.2 +025700 04 FILLER PIC X(8) VALUE SPACE. NC1024.2 +025800 04 XXCOMPUTED PIC X(20). NC1024.2 +025900 04 FILLER PIC X(5) VALUE SPACE. NC1024.2 +026000 04 XXCORRECT PIC X(20). NC1024.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). NC1024.2 +026200 01 HYPHEN-LINE. NC1024.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. NC1024.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************NC1024.2 +026500- "*****************************************". NC1024.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************NC1024.2 +026700- "******************************". NC1024.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE NC1024.2 +026900 "NC102A". NC1024.2 +027000 PROCEDURE DIVISION. NC1024.2 +027100 CCVS1 SECTION. NC1024.2 +027200 OPEN-FILES. NC1024.2 +027300 OPEN OUTPUT PRINT-FILE. NC1024.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1024.2 +027500 MOVE SPACE TO TEST-RESULTS. NC1024.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1024.2 +027700 GO TO CCVS1-EXIT. NC1024.2 +027800 CLOSE-FILES. NC1024.2 +027900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1024.2 +028000 TERMINATE-CCVS. NC1024.2 +028100*S EXIT PROGRAM. NC1024.2 +028200*SERMINATE-CALL. NC1024.2 +028300 STOP RUN. NC1024.2 +028400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1024.2 +028500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1024.2 +028600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1024.2 +028700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1024.2 +028800 MOVE "****TEST DELETED****" TO RE-MARK. NC1024.2 +028900 PRINT-DETAIL. NC1024.2 +029000 IF REC-CT NOT EQUAL TO ZERO NC1024.2 +029100 MOVE "." TO PARDOT-X NC1024.2 +029200 MOVE REC-CT TO DOTVALUE. NC1024.2 +029300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1024.2 +029400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1024.2 +029500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1024.2 +029600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1024.2 +029700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1024.2 +029800 MOVE SPACE TO CORRECT-X. NC1024.2 +029900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1024.2 +030000 MOVE SPACE TO RE-MARK. NC1024.2 +030100 HEAD-ROUTINE. NC1024.2 +030200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +030300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +030400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1024.2 +030500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1024.2 +030600 COLUMN-NAMES-ROUTINE. NC1024.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +031000 END-ROUTINE. NC1024.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1024.2 +031200 END-RTN-EXIT. NC1024.2 +031300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +031400 END-ROUTINE-1. NC1024.2 +031500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1024.2 +031600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1024.2 +031700 ADD PASS-COUNTER TO ERROR-HOLD. NC1024.2 +031800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1024.2 +031900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1024.2 +032000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1024.2 +032100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1024.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1024.2 +032300 END-ROUTINE-12. NC1024.2 +032400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1024.2 +032500 IF ERROR-COUNTER IS EQUAL TO ZERO NC1024.2 +032600 MOVE "NO " TO ERROR-TOTAL NC1024.2 +032700 ELSE NC1024.2 +032800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1024.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1024.2 +033000 PERFORM WRITE-LINE. NC1024.2 +033100 END-ROUTINE-13. NC1024.2 +033200 IF DELETE-COUNTER IS EQUAL TO ZERO NC1024.2 +033300 MOVE "NO " TO ERROR-TOTAL ELSE NC1024.2 +033400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1024.2 +033500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1024.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +033700 IF INSPECT-COUNTER EQUAL TO ZERO NC1024.2 +033800 MOVE "NO " TO ERROR-TOTAL NC1024.2 +033900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1024.2 +034000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1024.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +034200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1024.2 +034300 WRITE-LINE. NC1024.2 +034400 ADD 1 TO RECORD-COUNT. NC1024.2 +034500 IF RECORD-COUNT GREATER 42 NC1024.2 +034600 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1024.2 +034700 MOVE SPACE TO DUMMY-RECORD NC1024.2 +034800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1024.2 +034900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1024.2 +035000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1024.2 +035100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1024.2 +035200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1024.2 +035300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1024.2 +035400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1024.2 +035500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1024.2 +035600 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1024.2 +035700 MOVE ZERO TO RECORD-COUNT. NC1024.2 +035800 PERFORM WRT-LN. NC1024.2 +035900 WRT-LN. NC1024.2 +036000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1024.2 +036100 MOVE SPACE TO DUMMY-RECORD. NC1024.2 +036200 BLANK-LINE-PRINT. NC1024.2 +036300 PERFORM WRT-LN. NC1024.2 +036400 FAIL-ROUTINE. NC1024.2 +036500 IF COMPUTED-X NOT EQUAL TO SPACE NC1024.2 +036600 GO TO FAIL-ROUTINE-WRITE. NC1024.2 +036700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1024.2 +036800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1024.2 +036900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1024.2 +037000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +037100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1024.2 +037200 GO TO FAIL-ROUTINE-EX. NC1024.2 +037300 FAIL-ROUTINE-WRITE. NC1024.2 +037400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1024.2 +037500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1024.2 +037600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1024.2 +037700 MOVE SPACES TO COR-ANSI-REFERENCE. NC1024.2 +037800 FAIL-ROUTINE-EX. EXIT. NC1024.2 +037900 BAIL-OUT. NC1024.2 +038000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1024.2 +038100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1024.2 +038200 BAIL-OUT-WRITE. NC1024.2 +038300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1024.2 +038400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1024.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1024.2 +038600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1024.2 +038700 BAIL-OUT-EX. EXIT. NC1024.2 +038800 CCVS1-EXIT. NC1024.2 +038900 EXIT. NC1024.2 +039000 SECT-NC102A-001 SECTION. NC1024.2 +039100 GO--INIT-F1-1. NC1024.2 +039200 MOVE "V1-88 6.14.4 GR1" TO ANSI-REFERENCE. NC1024.2 +039300 GO--TEST-F1-1. NC1024.2 +039400 GO TO GO--PASS-F1-1. NC1024.2 +039500 PERFORM FAIL. NC1024.2 +039600 GO TO GO--WRITE-F1-1. NC1024.2 +039700 GO--DELETE-F1-1. NC1024.2 +039800 PERFORM DE-LETE. NC1024.2 +039900 GO TO GO--WRITE-F1-1. NC1024.2 +040000 GO--PASS-F1-1. NC1024.2 +040100 PERFORM PASS. NC1024.2 +040200 GO--WRITE-F1-1. NC1024.2 +040300 MOVE "GO TO " TO FEATURE. NC1024.2 +040400 MOVE "GO--TEST-F1-1" TO PAR-NAME. NC1024.2 +040500 PERFORM PRINT-DETAIL. NC1024.2 +040600 GO--INIT-F2-1. NC1024.2 +040700 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +040800 MOVE "GO--TEST-F2-1" TO PAR-NAME. NC1024.2 +040900 MOVE SPACE TO P-OR-F. NC1024.2 +041000 MOVE "GO TO DEPENDING" TO FEATURE. NC1024.2 +041100 MOVE 0 TO GO-TO-DEPEND. NC1024.2 +041200 GO--TEST-F2-1. NC1024.2 +041300 PERFORM PRINT-DETAIL. NC1024.2 +041400 MOVE SPACE TO FEATURE. NC1024.2 +041500 GO TO GO--B NC1024.2 +041600 GO--D NC1024.2 +041700 GO--C DEPENDING ON GO-TO-DEPEND. NC1024.2 +041800* NOTE GO--TEST-F2-1 THRU GO--E TEST THE GO TO NC1024.2 +041900* DEPENDING OPTION FOR GO-TO-DEPEND EQUAL TO 0,1,3,2,4. NC1024.2 +042000* NOTE INITIAL VALUE OF GO-TO-DEPEND IS ZERO. NC1024.2 +042100 GO TO GO--A. NC1024.2 +042200 GO--DELETE-F2-1. NC1024.2 +042300 MOVE "GO--TEST-F2-1" TO PAR-NAME. NC1024.2 +042400 PERFORM DE-LETE. NC1024.2 +042500 GO TO GO--WRITE-F2-1. NC1024.2 +042600 GO--A. NC1024.2 +042700 MOVE "GO--A" TO PAR-NAME. NC1024.2 +042800 IF GO-TO-DEPEND EQUAL TO 0 NC1024.2 +042900 PERFORM PASS NC1024.2 +043000 ADD 1 TO GO-TO-DEPEND NC1024.2 +043100 GO TO GO--TEST-F2-1. NC1024.2 +043200 IF GO-TO-DEPEND GREATER THAN 3 NC1024.2 +043300 GO TO GO--E. NC1024.2 +043400 PERFORM FAIL NC1024.2 +043500 MOVE 1 TO GO-TO-DEPEND NC1024.2 +043600 GO TO GO--TEST-F2-1. NC1024.2 +043700* NOTE CONTROL SHOULD FALL THRU TO GO--A FOR GO-TO-DEPEND NC1024.2 +043800* EQUAL TO 0, 4. NC1024.2 +043900 GO--B. NC1024.2 +044000 MOVE "GO--B" TO PAR-NAME. NC1024.2 +044100 IF GO-TO-DEPEND NOT EQUAL TO 1 NC1024.2 +044200 PERFORM FAIL NC1024.2 +044300 MOVE 3 TO GO-TO-DEPEND NC1024.2 +044400 GO TO GO--TEST-F2-1. NC1024.2 +044500 PERFORM PASS. NC1024.2 +044600 ADD 2 TO GO-TO-DEPEND. NC1024.2 +044700 GO TO GO--TEST-F2-1. NC1024.2 +044800 GO--C. NC1024.2 +044900 MOVE "GO--C" TO PAR-NAME. NC1024.2 +045000 IF GO-TO-DEPEND NOT EQUAL TO 3 NC1024.2 +045100 PERFORM FAIL NC1024.2 +045200 MOVE 2 TO GO-TO-DEPEND NC1024.2 +045300 GO TO GO--TEST-F2-1. NC1024.2 +045400 PERFORM PASS. NC1024.2 +045500 SUBTRACT 1 FROM GO-TO-DEPEND. NC1024.2 +045600 GO TO GO--TEST-F2-1. NC1024.2 +045700 GO--D. NC1024.2 +045800 MOVE "GO--D" TO PAR-NAME. NC1024.2 +045900 IF GO-TO-DEPEND NOT EQUAL TO 2 NC1024.2 +046000 PERFORM FAIL NC1024.2 +046100 MOVE 4 TO GO-TO-DEPEND NC1024.2 +046200 GO TO GO--TEST-F2-1. NC1024.2 +046300 PERFORM PASS. NC1024.2 +046400 ADD 2 TO GO-TO-DEPEND. NC1024.2 +046500 GO TO GO--TEST-F2-1. NC1024.2 +046600 GO--E. NC1024.2 +046700 MOVE "GO--E" TO PAR-NAME. NC1024.2 +046800 IF GO-TO-DEPEND EQUAL TO 4 NC1024.2 +046900 PERFORM PASS NC1024.2 +047000 GO TO GO--WRITE-F2-1. NC1024.2 +047100 PERFORM FAIL. NC1024.2 +047200 GO--WRITE-F2-1. NC1024.2 +047300 PERFORM PRINT-DETAIL. NC1024.2 +047400 GO--INIT-F1-2. NC1024.2 +047500 MOVE "V1-88 6.14.4 GR1" TO ANSI-REFERENCE. NC1024.2 +047600 GO--TEST-F1-2. NC1024.2 +047700 GO TO GO--PASS-F1-2. NC1024.2 +047800* NOTE THAT GO--PASS-F1-2 IS A SECTION-NAME. NC1024.2 +047900 PERFORM FAIL. NC1024.2 +048000 GO TO GO--WRITE-F1-2. NC1024.2 +048100 GO--DELETE-F1-2. NC1024.2 +048200 PERFORM DE-LETE. NC1024.2 +048300 GO TO GO--WRITE-F1-2. NC1024.2 +048400 GO--PASS-F1-2 SECTION. NC1024.2 +048500 GO--PAS-F1-2. NC1024.2 +048600 PERFORM PASS. NC1024.2 +048700 GO--WRITE-F1-2. NC1024.2 +048800 MOVE "GO TO" TO FEATURE. NC1024.2 +048900 MOVE "GO--TEST-F1-2" TO PAR-NAME. NC1024.2 +049000 PERFORM PRINT-DETAIL. NC1024.2 +049100* NC1024.2 +049200* NC1024.2 +049300 GO--INIT-F2-2. NC1024.2 +049400 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +049500 MOVE 1 TO GO-TO-DEEP. NC1024.2 +049600 GO--TEST-F2-2. NC1024.2 +049700 GO TO GO--PASS-F2-2 NC1024.2 +049800 GO--FAIL-F2-2 DEPENDING ON GO-TO-DEEP. NC1024.2 +049900* NOTE THAT GO--PASS-F2-2 IS A SECTION-NAME. NC1024.2 +050000 GO TO GO--FAIL-F2-2. NC1024.2 +050100 GO--DELETE-F2-2. NC1024.2 +050200 PERFORM DE-LETE. NC1024.2 +050300 GO TO GO--WRITE-F2-2. NC1024.2 +050400 GO--PASS-F2-2 SECTION. NC1024.2 +050500 GO--PAS-F2-2. NC1024.2 +050600 IF GO-TO-DEEP EQUAL TO 1 NC1024.2 +050700 PERFORM PASS NC1024.2 +050800 GO TO GO--WRITE-F2-2. NC1024.2 +050900 GO--FAIL-F2-2. NC1024.2 +051000 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +051100 MOVE 1 TO CORRECT-N. NC1024.2 +051200 PERFORM FAIL. NC1024.2 +051300 GO--WRITE-F2-2. NC1024.2 +051400 MOVE "GO TO DEPENDING" TO FEATURE. NC1024.2 +051500 MOVE "GO--TEST-F2-2" TO PAR-NAME. NC1024.2 +051600 PERFORM PRINT-DETAIL. NC1024.2 +051700 GO--INIT-F2-3. NC1024.2 +051800 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +051900 MOVE 0 TO GO-TO-DEEP. NC1024.2 +052000 MOVE 2 TO GO-TO-DEPEND. NC1024.2 +052100 GO--TEST-F2-3. NC1024.2 +052200 IF GO-TO-DEPEND EQUAL TO 2 GO TO GO--A-F2-3 GO--B-F2-3 NC1024.2 +052300 DEPENDING ON GO-TO-DEPEND ELSE GO TO GO--C-F2-3 NC1024.2 +052400 GO--D-F2-3 GO--E-F2-3 DEPENDING GO-TO-DEPEND. NC1024.2 +052500 GO--DELETE-F2-3. NC1024.2 +052600 PERFORM DE-LETE. NC1024.2 +052700 GO TO GO--WRITE-F2-3. NC1024.2 +052800 GO--A-F2-3. NC1024.2 +052900 MOVE 1 TO GO-TO-DEEP. NC1024.2 +053000 GO TO GO--F-F2-3. NC1024.2 +053100 GO--B-F2-3. NC1024.2 +053200 MOVE 2 TO GO-TO-DEEP. NC1024.2 +053300 GO TO GO--F-F2-3. NC1024.2 +053400 GO--C-F2-3. NC1024.2 +053500 MOVE 3 TO GO-TO-DEEP. NC1024.2 +053600 GO TO GO--F-F2-3. NC1024.2 +053700 GO--D-F2-3. NC1024.2 +053800 MOVE 4 TO GO-TO-DEEP. NC1024.2 +053900 GO TO GO--F-F2-3. NC1024.2 +054000 GO--E-F2-3. NC1024.2 +054100 MOVE 5 TO GO-TO-DEEP. NC1024.2 +054200 GO TO GO--F-F2-3. NC1024.2 +054300 GO--F-F2-3. NC1024.2 +054400 IF GO-TO-DEEP EQUAL TO 2 NC1024.2 +054500 PERFORM PASS GO TO GO--WRITE-F2-3. NC1024.2 +054600 GO--FAIL-F2-3. NC1024.2 +054700 PERFORM FAIL. NC1024.2 +054800 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +054900 MOVE 2 TO CORRECT-N. NC1024.2 +055000 GO--WRITE-F2-3. NC1024.2 +055100 MOVE "GO--TEST-F2-3 " TO PAR-NAME. NC1024.2 +055200 PERFORM PRINT-DETAIL. NC1024.2 +055300 GO--INIT-F2-4. NC1024.2 +055400 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +055500 MOVE 0 TO GO-TO-DEEP. NC1024.2 +055600 MOVE 3 TO GO-TO-DEPEND. NC1024.2 +055700 GO--TEST-F2-4. NC1024.2 +055800 IF GO-TO-DEPEND EQUAL TO 2 GO TO GO--A-F2-4 GO--B-F2-4 NC1024.2 +055900 DEPENDING ON GO-TO-DEPEND ELSE GO TO GO--C-F2-4 NC1024.2 +056000 GO--D-F2-4 GO--E-F2-4 DEPENDING GO-TO-DEPEND. NC1024.2 +056100 GO--DELETE-F2-4. NC1024.2 +056200 PERFORM DE-LETE. NC1024.2 +056300 GO TO GO--WRITE-F2-4. NC1024.2 +056400 GO--A-F2-4. NC1024.2 +056500 MOVE 1 TO GO-TO-DEEP. NC1024.2 +056600 GO TO GO--F-F2-4. NC1024.2 +056700 GO--B-F2-4. NC1024.2 +056800 MOVE 2 TO GO-TO-DEEP. NC1024.2 +056900 GO TO GO--F-F2-4. NC1024.2 +057000 GO--C-F2-4. NC1024.2 +057100 MOVE 3 TO GO-TO-DEEP. NC1024.2 +057200 GO TO GO--F-F2-4. NC1024.2 +057300 GO--D-F2-4. NC1024.2 +057400 MOVE 4 TO GO-TO-DEEP. NC1024.2 +057500 GO TO GO--F-F2-4. NC1024.2 +057600 GO--E-F2-4. NC1024.2 +057700 MOVE 5 TO GO-TO-DEEP. NC1024.2 +057800 GO TO GO--F-F2-4. NC1024.2 +057900 GO--F-F2-4. NC1024.2 +058000 IF GO-TO-DEEP EQUAL TO 5 NC1024.2 +058100 PERFORM PASS GO TO GO--WRITE-F2-4. NC1024.2 +058200 GO--FAIL-F2-4. NC1024.2 +058300 PERFORM FAIL. NC1024.2 +058400 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +058500 MOVE 5 TO CORRECT-N. NC1024.2 +058600 GO--WRITE-F2-4. NC1024.2 +058700 MOVE "GO--TEST-F2-4 " TO PAR-NAME. NC1024.2 +058800 PERFORM PRINT-DETAIL. NC1024.2 +058900* NC1024.2 +059000* NC1024.2 +059100 GO--INIT-F2-5. NC1024.2 +059200 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +059300 MOVE "87654321" TO GO-TABLE. NC1024.2 +059400 MOVE 0 TO GO-TO-DEEP. NC1024.2 +059500 GO--TEST-F2-5. NC1024.2 +059600 GO TO GO--A-F2-5 GO--B-F2-5 GO--C-F2-5 DEPENDING ON NC1024.2 +059700 GO-SCRIPT (7). NC1024.2 +059800 GO--DELETE-F2-5. NC1024.2 +059900 PERFORM DE-LETE. NC1024.2 +060000 GO TO GO--WRITE-F2-5. NC1024.2 +060100 GO--A-F2-5. NC1024.2 +060200 MOVE 1 TO GO-TO-DEEP. NC1024.2 +060300 GO TO GO--D-F2-5. NC1024.2 +060400 GO--B-F2-5. NC1024.2 +060500 MOVE 2 TO GO-TO-DEEP. NC1024.2 +060600 GO TO GO--D-F2-5. NC1024.2 +060700 GO--C-F2-5. NC1024.2 +060800 MOVE 3 TO GO-TO-DEEP. NC1024.2 +060900 GO TO GO--D-F2-5. NC1024.2 +061000 GO--D-F2-5. NC1024.2 +061100 IF GO-TO-DEEP EQUAL TO 2 NC1024.2 +061200 PERFORM PASS GO TO GO--WRITE-F2-5. NC1024.2 +061300 GO--FAIL-F2-5. NC1024.2 +061400 PERFORM FAIL. NC1024.2 +061500 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +061600 MOVE 2 TO CORRECT-N. NC1024.2 +061700 GO--WRITE-F2-5. NC1024.2 +061800 MOVE "GO--TEST-F2-5 " TO PAR-NAME. NC1024.2 +061900 PERFORM PRINT-DETAIL. NC1024.2 +062000* NC1024.2 +062100* NC1024.2 +062200 GO--INIT-F2-6. NC1024.2 +062300*==--> SINGLE PROCEDURE GO DEPENDING <--== NC1024.2 +062400 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +062500 MOVE 1 TO GO-TO-DEEP. NC1024.2 +062600 GO--TEST-F2-6. NC1024.2 +062700 GO TO GO--PASS-F2-6 DEPENDING ON GO-TO-DEEP. NC1024.2 +062800* NOTE THAT GO--PASS-F2-6 IS A SECTION-NAME. NC1024.2 +062900 GO TO GO--FAIL-F2-6. NC1024.2 +063000 GO--DELETE-F2-6. NC1024.2 +063100 PERFORM DE-LETE. NC1024.2 +063200 GO TO GO--WRITE-F2-6. NC1024.2 +063300 GO--PASS-F2-6 SECTION. NC1024.2 +063400 GO--PAS-F2-6. NC1024.2 +063500 IF GO-TO-DEEP EQUAL TO 1 NC1024.2 +063600 PERFORM PASS NC1024.2 +063700 GO TO GO--WRITE-F2-6. NC1024.2 +063800 GO--FAIL-F2-6. NC1024.2 +063900 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +064000 MOVE 1 TO CORRECT-N. NC1024.2 +064100 PERFORM FAIL. NC1024.2 +064200 GO--WRITE-F2-6. NC1024.2 +064300 MOVE "GO TO DEPENDING" TO FEATURE. NC1024.2 +064400 MOVE "GO--TEST-F2-6" TO PAR-NAME. NC1024.2 +064500 PERFORM PRINT-DETAIL. NC1024.2 +064600* NC1024.2 +064700* NC1024.2 +064800 GO--INIT-F2-7. NC1024.2 +064900 MOVE "V1-88 6.14.4 GR3" TO ANSI-REFERENCE. NC1024.2 +065000* ==--> OPTIONAL "TO" <--== NC1024.2 +065100 MOVE "87654321" TO GO-TABLE. NC1024.2 +065200 MOVE 0 TO GO-TO-DEEP. NC1024.2 +065300 GO--TEST-F2-7-0. NC1024.2 +065400 GO GO--A-F2-7 GO--B-F2-7 GO--C-F2-7 DEPENDING ON NC1024.2 +065500 GO-SCRIPT (7). NC1024.2 +065600 GO--DELETE-F2-7. NC1024.2 +065700 PERFORM DE-LETE. NC1024.2 +065800 GO TO GO--WRITE-F2-7. NC1024.2 +065900 GO--A-F2-7. NC1024.2 +066000 MOVE 1 TO GO-TO-DEEP. NC1024.2 +066100 GO TO GO--D-F2-7. NC1024.2 +066200 GO--B-F2-7. NC1024.2 +066300 MOVE 2 TO GO-TO-DEEP. NC1024.2 +066400 GO TO GO--D-F2-7. NC1024.2 +066500 GO--C-F2-7. NC1024.2 +066600 MOVE 3 TO GO-TO-DEEP. NC1024.2 +066700 GO TO GO--D-F2-7. NC1024.2 +066800 GO--D-F2-7. NC1024.2 +066900 IF GO-TO-DEEP EQUAL TO 2 NC1024.2 +067000 PERFORM PASS GO TO GO--WRITE-F2-7. NC1024.2 +067100 GO--FAIL-F2-7. NC1024.2 +067200 PERFORM FAIL. NC1024.2 +067300 MOVE GO-TO-DEEP TO COMPUTED-N. NC1024.2 +067400 MOVE 2 TO CORRECT-N. NC1024.2 +067500 GO--WRITE-F2-7. NC1024.2 +067600 MOVE "GO--TEST-F2-7 " TO PAR-NAME. NC1024.2 +067700 PERFORM PRINT-DETAIL. NC1024.2 +067800* NC1024.2 +067900* NC1024.2 +068000 GO--INIT-F1-3. NC1024.2 +068100 MOVE "V1-88 6.14.4 GR1" TO ANSI-REFERENCE. NC1024.2 +068200 GOTO-TEST-F1-3. NC1024.2 +068300 GO P2. NC1024.2 +068400 GOTO-FAIL-F1-3. NC1024.2 +068500 PERFORM FAIL. NC1024.2 +068600 GO TO GOTO-WRITE-F1-3. NC1024.2 +068700 GOTO-DELETE-F1-3. NC1024.2 +068800 PERFORM DE-LETE. NC1024.2 +068900 GO TO GOTO-WRITE-F1-3. NC1024.2 +069000 P2. NC1024.2 +069100 PERFORM PASS. NC1024.2 +069200 GOTO-WRITE-F1-3. NC1024.2 +069300 MOVE "GOTO-TEST-F1-3" TO PAR-NAME. NC1024.2 +069400 MOVE "GO - NO OPTIONAL TO" TO FEATURE. NC1024.2 +069500 PERFORM PRINT-DETAIL. NC1024.2 +069600 EXIT--INIT-GF-1. NC1024.2 +069700 MOVE "V1-87 6.13.2 " TO ANSI-REFERENCE. NC1024.2 +069800 EXIT-TEST-GF-1. NC1024.2 +069900 GO TO EXIT-CHECK-GF-1. NC1024.2 +070000 EXIT-DELETE-GF-1. NC1024.2 +070100 PERFORM DE-LETE. NC1024.2 +070200 GO TO EXIT-WRITE-GF-1. NC1024.2 +070300 EXIT-CHECK-GF-1. NC1024.2 +070400 EXIT. NC1024.2 +070500 EXIT-PASS-GF-1. NC1024.2 +070600 PERFORM PASS. NC1024.2 +070700 EXIT-WRITE-GF-1. NC1024.2 +070800 MOVE "EXIT" TO FEATURE. NC1024.2 +070900 MOVE "EXIT-TEST-GF-1" TO PAR-NAME. NC1024.2 +071000 PERFORM PRINT-DETAIL. NC1024.2 +071100 PFM-INIT-F1-1. NC1024.2 +071200 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +071300 MOVE 1 TO PERFORM-KEY. NC1024.2 +071400 PFM-TEST-F1-1. NC1024.2 +071500* NOTE THIS TEST IS FOR OPTION 1 AND TESTS SIMPLE OUT OF NC1024.2 +071600* LINE PERFORM. NC1024.2 +071700 PERFORM PFM-A. NC1024.2 +071800 IF PERFORM1 EQUAL TO "ABC" NC1024.2 +071900 PERFORM PASS NC1024.2 +072000 ELSE NC1024.2 +072100 PERFORM FAIL. NC1024.2 +072200 GO TO PFM-WRITE-F1-1. NC1024.2 +072300 PFM-DELETE-F1-1. NC1024.2 +072400 PERFORM DE-LETE. NC1024.2 +072500 PFM-WRITE-F1-1. NC1024.2 +072600 MOVE "PERFORM" TO FEATURE. NC1024.2 +072700 MOVE "PFM-TEST-F1-1" TO PAR-NAME. NC1024.2 +072800 PERFORM PRINT-DETAIL. NC1024.2 +072900 PFM-INIT-F1-2. NC1024.2 +073000 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +073100 MOVE 2 TO PERFORM-KEY. NC1024.2 +073200 PFM-TEST-F1-2. NC1024.2 +073300* NOTE THIS TEST IS DESIGNED TO TEST ENTERING A PROCEDURE NC1024.2 +073400* IN LINE WHICH IS ALSO REFERENCED BY AN OUT OF LINE PERFORM. NC1024.2 +073500 GO TO PFM-A. NC1024.2 +073600 PFM-DELETE-F1-2. NC1024.2 +073700 PERFORM DE-LETE. NC1024.2 +073800 GO TO PFM-WRITE-F1-2. NC1024.2 +073900 PFM-A. NC1024.2 +074000 IF PERFORM-KEY EQUAL TO 1 NC1024.2 +074100 MOVE "ABC" TO PERFORM1 NC1024.2 +074200 ELSE NC1024.2 +074300 MOVE "XYZ" TO PERFORM1. NC1024.2 +074400 PFM-B. NC1024.2 +074500 IF PERFORM-KEY EQUAL TO 1 NC1024.2 +074600 PERFORM FAIL NC1024.2 +074700 PERFORM PRINT-DETAIL NC1024.2 +074800 GO TO PFM-TEST-F1-2. NC1024.2 +074900* NOTE FOR PFM-TEST-F1-1 CONTROL SHOULD NOT BE TRANSFERRED NC1024.2 +075000* TO THIS PARAGRAPH BUT FOR PFM-TEST-F1-2 IT SHOULD BE. NC1024.2 +075100 IF PERFORM1 EQUAL TO "XYZ" NC1024.2 +075200 PERFORM PASS NC1024.2 +075300 ELSE NC1024.2 +075400 PERFORM FAIL. NC1024.2 +075500 PFM-WRITE-F1-2. NC1024.2 +075600 MOVE "PERFORM" TO FEATURE. NC1024.2 +075700 MOVE "PFM-TEST-F1-2" TO PAR-NAME. NC1024.2 +075800 PERFORM PRINT-DETAIL. NC1024.2 +075900 PFM-INIT-F2-1. NC1024.2 +076000 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +076100 MOVE 3 TO THREE. NC1024.2 +076200 PFM-TEST-F2-1. NC1024.2 +076300 PERFORM PFM-C 3 TIMES. NC1024.2 +076400 PERFORM PFM-C THREE TIMES. NC1024.2 +076500* NOTE THIS TEST IS FOR OPTION 2. NC1024.2 +076600 IF PERFORM2 EQUAL TO 56 NC1024.2 +076700 PERFORM PASS NC1024.2 +076800 ELSE NC1024.2 +076900 PERFORM FAIL. NC1024.2 +077000 GO TO PFM-WRITE-F2-1. NC1024.2 +077100 PFM-DELETE-F2-1. NC1024.2 +077200 PERFORM DE-LETE. NC1024.2 +077300 PFM-WRITE-F2-1. NC1024.2 +077400 MOVE "PERFORM TIMES" TO FEATURE. NC1024.2 +077500 MOVE "PFM-TEST-F2-1" TO PAR-NAME. NC1024.2 +077600 PERFORM PRINT-DETAIL. NC1024.2 +077700 PFM-INIT-F1-3. NC1024.2 +077800 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +077900 PFM-TEST-F1-3. NC1024.2 +078000 PERFORM PFM-E THRU PFM-H. NC1024.2 +078100* NOTE THIS TEST IS FOR A NESTED PERFORM WITH THE INCLUDED NC1024.2 +078200* PERFORM TOTALLY INCLUDED IN THE SEQUENCE REFERENCED BY THE NC1024.2 +078300* FIRST PERFORM - IT ALSO TESTS THE EXIT VERB AND PERFORM NC1024.2 +078400* THRU. NC1024.2 +078500 IF PERFORM1 NOT EQUAL TO "CSW" NC1024.2 +078600 MOVE "CSW" TO CORRECT-A NC1024.2 +078700 MOVE PERFORM1 TO COMPUTED-A NC1024.2 +078800 PERFORM FAIL NC1024.2 +078900 GO TO PFM-WRITE-F1-3. NC1024.2 +079000 IF PERFORM4 EQUAL TO 70.0 NC1024.2 +079100 PERFORM PASS NC1024.2 +079200 ELSE NC1024.2 +079300 MOVE 70.0 TO CORRECT-N NC1024.2 +079400 MOVE PERFORM4 TO COMPUTED-N NC1024.2 +079500 PERFORM FAIL. NC1024.2 +079600 GO TO PFM-WRITE-F1-3. NC1024.2 +079700 PFM-DELETE-F1-3. NC1024.2 +079800 PERFORM DE-LETE. NC1024.2 +079900 PFM-WRITE-F1-3. NC1024.2 +080000 MOVE "NESTED PERFORM THRU" TO FEATURE. NC1024.2 +080100 MOVE "PFM-TEST-F1-3" TO PAR-NAME. NC1024.2 +080200 PERFORM PRINT-DETAIL. NC1024.2 +080300 PFM-INIT-F1-4. NC1024.2 +080400 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +080500 PFM-TEST-F1-4. NC1024.2 +080600 PERFORM PFM-J. NC1024.2 +080700* NOTE THIS TEST IS FOR A NESTED PERFORM WITH THE INCLUDED NC1024.2 +080800* PERFORM TOTALLY EXCLUDED FROM THE SEQUENCE REFERENCED BY NC1024.2 +080900* THE FIRST PERFORM. NC1024.2 +081000 IF PERFORM1 EQUAL TO "YES" NC1024.2 +081100 PERFORM PASS NC1024.2 +081200 ELSE NC1024.2 +081300 MOVE "YES" TO CORRECT-A NC1024.2 +081400 MOVE PERFORM1 TO COMPUTED-A NC1024.2 +081500 PERFORM FAIL NC1024.2 +081600 GO TO PFM-WRITE-F1-4. NC1024.2 +081700 IF PERFORM2 EQUAL TO 312 NC1024.2 +081800 PERFORM PASS NC1024.2 +081900 ELSE NC1024.2 +082000 MOVE 312 TO CORRECT-N NC1024.2 +082100 MOVE PERFORM2 TO COMPUTED-N NC1024.2 +082200 PERFORM FAIL. NC1024.2 +082300 GO TO PFM-WRITE-F1-4. NC1024.2 +082400 PFM-DELETE-F1-4. NC1024.2 +082500 PERFORM DE-LETE. NC1024.2 +082600 PFM-WRITE-F1-4. NC1024.2 +082700 MOVE "NESTED PERFORM" TO FEATURE. NC1024.2 +082800 MOVE "PFM-TEST-F1-4" TO PAR-NAME. NC1024.2 +082900 PERFORM PRINT-DETAIL. NC1024.2 +083000 PFM-INIT-F1-5. NC1024.2 +083100 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +083200 PFM-TEST-F1-5. NC1024.2 +083300 PERFORM PFM-N. NC1024.2 +083400* NOTE PFM-N IS A SECTION-NAME. NC1024.2 +083500 GO TO PFM-WRITE-F1-5. NC1024.2 +083600 PFM-DELETE-F1-5. NC1024.2 +083700 PERFORM DE-LETE. NC1024.2 +083800 PFM-WRITE-F1-5. NC1024.2 +083900 MOVE "PERFORM SECTION-NAME" TO FEATURE. NC1024.2 +084000 MOVE "PFM-TEST-F1-5" TO PAR-NAME. NC1024.2 +084100 PERFORM PRINT-DETAIL. NC1024.2 +084200 PFM-INIT-F2-2. NC1024.2 +084300 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +084400 PFM-TEST-F2-2. NC1024.2 +084500 PERFORM PFM-V THRU PFM-Z 5 TIMES. NC1024.2 +084600* NOTE THESE ARE ALL EXIT PARAGRAPHS. NC1024.2 +084700 PERFORM PASS. NC1024.2 +084800 GO TO PFM-WRITE-F2-2. NC1024.2 +084900 PFM-DELETE-F2-2. NC1024.2 +085000 PERFORM DE-LETE. NC1024.2 +085100 PFM-WRITE-F2-2. NC1024.2 +085200 MOVE "PERFORM EXIT PARAS" TO FEATURE. NC1024.2 +085300 MOVE "PFM-TEST-F2-2" TO PAR-NAME. NC1024.2 +085400 PERFORM PRINT-DETAIL. NC1024.2 +085500 PFM-INIT-F1-6. NC1024.2 +085600 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +085700 MOVE ZERO TO P-COUNT. NC1024.2 +085800 PFM-TEST-F1-6. NC1024.2 +085900 PERFORM PFM-B-F1-6. NC1024.2 +086000 ADD 1 TO P-COUNT. NC1024.2 +086100 PERFORM PFM-A-F1-6. NC1024.2 +086200 ADD 1 TO P-COUNT. NC1024.2 +086300 PFM-A-F1-6 SECTION. NC1024.2 +086400 PFM-B-F1-6. NC1024.2 +086500 ADD 100 TO P-COUNT. NC1024.2 +086600 PFM-TESTT-F1-6 SECTION. NC1024.2 +086700 PFM-TESTTT-F1-6. NC1024.2 +086800 IF P-COUNT EQUAL TO 000302 NC1024.2 +086900 PERFORM PASS GO TO PFM-WRITE-F1-6. NC1024.2 +087000 GO TO PFM-FAIL-F1-6. NC1024.2 +087100 PFM-DELETE-F1-6. NC1024.2 +087200 PERFORM DE-LETE. NC1024.2 +087300 GO TO PFM-WRITE-F1-6. NC1024.2 +087400 PFM-FAIL-F1-6. NC1024.2 +087500 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +087600 MOVE 000302 TO CORRECT-N. NC1024.2 +087700 PERFORM FAIL. NC1024.2 +087800 PFM-WRITE-F1-6. NC1024.2 +087900 MOVE "PERFORM " TO FEATURE. NC1024.2 +088000 MOVE "PFM-TEST-F1-6" TO PAR-NAME. NC1024.2 +088100 PERFORM PRINT-DETAIL. NC1024.2 +088200 PFM-INIT-F2-3. NC1024.2 +088300 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +088400 MOVE ZERO TO P-COUNT NC1024.2 +088500 MOVE 2 TO ATWO-DS-01V00. NC1024.2 +088600 PFM-TEST-F2-3. NC1024.2 +088700 PERFORM PFM-B-F2-3 2 TIMES. NC1024.2 +088800 ADD 1 TO P-COUNT. NC1024.2 +088900 PERFORM PFM-A-F2-3 ATWO-DS-01V00 TIMES. NC1024.2 +089000 ADD 1 TO P-COUNT. NC1024.2 +089100 PFM-A-F2-3 SECTION. NC1024.2 +089200 PFM-B-F2-3. NC1024.2 +089300 ADD 100 TO P-COUNT. NC1024.2 +089400 PFM-TESTT-F2-3 SECTION. NC1024.2 +089500 PFM-TESTTT-F2-3. NC1024.2 +089600 IF P-COUNT EQUAL TO 000502 NC1024.2 +089700 PERFORM PASS GO TO PFM-WRITE-F2-3. NC1024.2 +089800 GO TO PFM-FAIL-F2-3. NC1024.2 +089900 PFM-DELETE-F2-3. NC1024.2 +090000 PERFORM DE-LETE. NC1024.2 +090100 GO TO PFM-WRITE-F2-3. NC1024.2 +090200 PFM-FAIL-F2-3. NC1024.2 +090300 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +090400 MOVE 000502 TO CORRECT-N. NC1024.2 +090500 PERFORM FAIL. NC1024.2 +090600 PFM-WRITE-F2-3. NC1024.2 +090700 MOVE "PERFORM TIMES " TO FEATURE. NC1024.2 +090800 MOVE "PFM-TEST-F2-3" TO PAR-NAME. NC1024.2 +090900 PERFORM PRINT-DETAIL. NC1024.2 +091000 PFM-INIT-F1-7. NC1024.2 +091100 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +091200 MOVE ZERO TO P-COUNT. NC1024.2 +091300 PFM-TEST-F1-7. NC1024.2 +091400 PERFORM PFM-B-F1-7 THROUGH PFM-D-F1-7. NC1024.2 +091500 ADD 1 TO P-COUNT NC1024.2 +091600 PERFORM PFM-A-F1-7 THRU PFM-C-F1-7. NC1024.2 +091700 ADD 1 TO P-COUNT. NC1024.2 +091800 PERFORM PFM-A-F1-7 THRU PFM-D-F1-7. NC1024.2 +091900 ADD 1 TO P-COUNT. NC1024.2 +092000 PERFORM PFM-B-F1-7 THRU PFM-C-F1-7. NC1024.2 +092100 ADD 1 TO P-COUNT. NC1024.2 +092200 PFM-A-F1-7 SECTION. NC1024.2 +092300 PFM-B-F1-7. NC1024.2 +092400 ADD 100 TO P-COUNT. NC1024.2 +092500 PFM-C-F1-7 SECTION. NC1024.2 +092600 PFM-D-F1-7. NC1024.2 +092700 ADD 10000 TO P-COUNT. NC1024.2 +092800 PFM-TESTT-F1-7 SECTION. NC1024.2 +092900 PFM-TESTTT-F1-7. NC1024.2 +093000 IF P-COUNT EQUAL TO 050504 NC1024.2 +093100 PERFORM PASS NC1024.2 +093200 GO TO PFM-WRITE-F1-7. NC1024.2 +093300 GO TO PFM-FAIL-F1-7. NC1024.2 +093400 PFM-DELETE-F1-7. NC1024.2 +093500 PERFORM DE-LETE. NC1024.2 +093600 GO TO PFM-WRITE-F1-7. NC1024.2 +093700 PFM-FAIL-F1-7. NC1024.2 +093800 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +093900 MOVE 050504 TO CORRECT-N. NC1024.2 +094000 PERFORM FAIL. NC1024.2 +094100 PFM-WRITE-F1-7. NC1024.2 +094200 MOVE "PERFORM THRU " TO FEATURE. NC1024.2 +094300 MOVE "PFM-TEST-F1-7" TO PAR-NAME. NC1024.2 +094400 PERFORM PRINT-DETAIL. NC1024.2 +094500 PFM-INIT-F2-4. NC1024.2 +094600 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +094700 MOVE ZERO TO P-COUNT. NC1024.2 +094800 PFM-TEST-F2-4. NC1024.2 +094900 PERFORM PFM-B-F2-4 THROUGH PFM-D-F2-4 2 TIMES. NC1024.2 +095000 ADD 1 TO P-COUNT. NC1024.2 +095100 PERFORM PFM-A-F2-4 THRU PFM-C-F2-4 2 TIMES. NC1024.2 +095200 ADD 1 TO P-COUNT. NC1024.2 +095300 PERFORM PFM-A-F2-4 THRU PFM-D-F2-4 2 TIMES. NC1024.2 +095400 ADD 1 TO P-COUNT. NC1024.2 +095500 PERFORM PFM-B-F2-4 THRU PFM-D-F2-4 2 TIMES. NC1024.2 +095600 ADD 1 TO P-COUNT. NC1024.2 +095700 PFM-A-F2-4 SECTION. NC1024.2 +095800 PFM-B-F2-4. NC1024.2 +095900 ADD 100 TO P-COUNT. NC1024.2 +096000 PFM-C-F2-4 SECTION. NC1024.2 +096100 PFM-D-F2-4. NC1024.2 +096200 ADD 10000 TO P-COUNT. NC1024.2 +096300 PFM-TESTT-F2-4 SECTION. NC1024.2 +096400 PFM-TESTTT-F2-4. NC1024.2 +096500 IF P-COUNT EQUAL TO 090904 NC1024.2 +096600 PERFORM PASS GO TO PFM-WRITE-F2-4. NC1024.2 +096700 GO TO PFM-FAIL-F2-4. NC1024.2 +096800 PFM-DELETE-F2-4. NC1024.2 +096900 PERFORM DE-LETE. NC1024.2 +097000 GO TO PFM-WRITE-F2-4. NC1024.2 +097100 PFM-FAIL-F2-4. NC1024.2 +097200 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +097300 MOVE 090904 TO CORRECT-N. NC1024.2 +097400 PERFORM FAIL. NC1024.2 +097500 PFM-WRITE-F2-4. NC1024.2 +097600 MOVE "PERFORM THRU, TIMES " TO FEATURE. NC1024.2 +097700 MOVE "PFM-TEST-F2-4" TO PAR-NAME. NC1024.2 +097800 PERFORM PRINT-DETAIL. NC1024.2 +097900 PFM-INIT-F1-8. NC1024.2 +098000 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +098100 MOVE ZERO TO P-COUNT. NC1024.2 +098200 PFM-TEST-F1-8. NC1024.2 +098300 ADD 1 TO P-COUNT. NC1024.2 +098400 PERFORM PFM-A-F1-8. NC1024.2 +098500 ADD 2 TO P-COUNT. NC1024.2 +098600 GO TO PFM-TESTT-F1-8. NC1024.2 +098700 PFM-A-F1-8. NC1024.2 +098800 ADD 10 TO P-COUNT. NC1024.2 +098900 PERFORM PFM-B-F1-8. NC1024.2 +099000 ADD 20 TO P-COUNT. NC1024.2 +099100 PFM-B-F1-8. NC1024.2 +099200 ADD 100 TO P-COUNT. NC1024.2 +099300 PERFORM PFM-C-F1-8. NC1024.2 +099400 ADD 200 TO P-COUNT. NC1024.2 +099500 PFM-C-F1-8. NC1024.2 +099600 ADD 1000 TO P-COUNT. NC1024.2 +099700 PERFORM PFM-D-F1-8. NC1024.2 +099800 ADD 2000 TO P-COUNT. NC1024.2 +099900 PFM-D-F1-8. NC1024.2 +100000 ADD 10000 TO P-COUNT. NC1024.2 +100100 PERFORM PFM-E-F1-8. NC1024.2 +100200 ADD 20000 TO P-COUNT. NC1024.2 +100300 PFM-E-F1-8. NC1024.2 +100400 ADD 100000 TO P-COUNT. NC1024.2 +100500 PFM-TESTT-F1-8. NC1024.2 +100600 IF P-COUNT EQUAL TO 133333 NC1024.2 +100700 PERFORM PASS GO TO PFM-WRITE-F1-8. NC1024.2 +100800 GO TO PFM-FAIL-F1-8. NC1024.2 +100900 PFM-DELETE-F1-8. NC1024.2 +101000 PERFORM DE-LETE. NC1024.2 +101100 GO TO PFM-WRITE-F1-8. NC1024.2 +101200 PFM-FAIL-F1-8. NC1024.2 +101300 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +101400 MOVE 133333 TO CORRECT-N. NC1024.2 +101500 PERFORM FAIL. NC1024.2 +101600 PFM-WRITE-F1-8. NC1024.2 +101700 MOVE "NESTED PERFORM " TO FEATURE. NC1024.2 +101800 MOVE "PFM-TEST-F1-8" TO PAR-NAME. NC1024.2 +101900 PERFORM PRINT-DETAIL. NC1024.2 +102000 PFM-INIT-F2-5. NC1024.2 +102100 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +102200 MOVE ZERO TO P-COUNT. NC1024.2 +102300 PFM-TEST-F2-5. NC1024.2 +102400 PERFORM PFM-A-F2-5 THRU PFM-B-F2-5. NC1024.2 +102500 ADD 1 TO P-COUNT. NC1024.2 +102600 PERFORM PFM-A-F2-5 THRU PFM-B-F2-5 2 TIMES. NC1024.2 +102700 ADD 2 TO P-COUNT. NC1024.2 +102800 PFM-A-F2-5. NC1024.2 +102900 ADD 100 TO P-COUNT. NC1024.2 +103000 PFM-B-F2-5. NC1024.2 +103100 EXIT. NC1024.2 +103200 PFM-TESTT-F2-5. NC1024.2 +103300 IF P-COUNT EQUAL TO 000403 NC1024.2 +103400 PERFORM PASS GO TO PFM-WRITE-F2-5. NC1024.2 +103500 GO TO PFM-FAIL-F2-5. NC1024.2 +103600 PFM-DELETE-F2-5. NC1024.2 +103700 PERFORM DE-LETE. NC1024.2 +103800 GO TO PFM-WRITE-F2-5. NC1024.2 +103900 PFM-FAIL-F2-5. NC1024.2 +104000 MOVE P-COUNT TO COMPUTED-N. NC1024.2 +104100 MOVE 000403 TO CORRECT-N. NC1024.2 +104200 MOVE "PERFORM WITH EXIT" TO FEATURE. NC1024.2 +104300 PERFORM FAIL. NC1024.2 +104400 PFM-WRITE-F2-5. NC1024.2 +104500 MOVE "PFM-TEST-F2-5" TO PAR-NAME. NC1024.2 +104600 PERFORM PRINT-DETAIL. NC1024.2 +104700 PFM-INIT-F1-9. NC1024.2 +104800 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +104900 MOVE SPACES TO PERFORM-HOLD. NC1024.2 +105000 PFM-TEST-F1-9. NC1024.2 +105100 PERFORM A101. NC1024.2 +105200 IF PERFORM-HOLD EQUAL TO "ABCDEFGHIJKLMNOPQRST" NC1024.2 +105300 PERFORM PASS NC1024.2 +105400 GO TO PFM-WRITE-F1-9. NC1024.2 +105500 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. NC1024.2 +105600 MOVE PERFORM-HOLD TO COMPUTED-A. NC1024.2 +105700 PERFORM FAIL. NC1024.2 +105800 GO TO PFM-WRITE-F1-9. NC1024.2 +105900 PFM-DELETE-F1-9. NC1024.2 +106000 PERFORM DE-LETE. NC1024.2 +106100 PFM-WRITE-F1-9. NC1024.2 +106200 MOVE "PFM-TEST-F1-9" TO PAR-NAME. NC1024.2 +106300 PERFORM PRINT-DETAIL. NC1024.2 +106400 PFM-A-F1-10 SECTION. NC1024.2 +106500 PFM-INIT-F1-10. NC1024.2 +106600 MOVE "V1-111 6.20.4 GR10" TO ANSI-REFERENCE. NC1024.2 +106700 PFM-TEST-F1-10. NC1024.2 +106800 PERFORM PFM-G-F1-10 THRU PFM-B-F1-10. NC1024.2 +106900* NOTE PERFORM SECTION-NAME THRU PARAGRAPH-NAME -- SECOND NC1024.2 +107000* PROCEDURE-NAME PHYSICALLY PRECEEDS THE FIRST BUT NC1024.2 +107100* LOGICALLY FOLLOWS IT. NC1024.2 +107200 GO TO PFM-WRITE-F1-10. NC1024.2 +107300 PFM-DELETE-F1-10. NC1024.2 +107400 PERFORM DE-LETE. NC1024.2 +107500 GO TO PFM-WRITE-F1-10. NC1024.2 +107600 PFM-B-F1-10. NC1024.2 +107700 PERFORM PASS. NC1024.2 +107800 PFM-C-F1-10. NC1024.2 +107900 PERFORM FAIL. NC1024.2 +108000 MOVE "RETURN MECHANISM LOST" TO RE-MARK. NC1024.2 +108100 GO TO PFM-WRITE-F1-10. NC1024.2 +108200 PFM-D-F1-10. NC1024.2 +108300 PERFORM FAIL. NC1024.2 +108400 MOVE "PERFORM GOT LOST IN GO TOS" TO RE-MARK. NC1024.2 +108500 GO TO PFM-WRITE-F1-10. NC1024.2 +108600 PFM-E-F1-10. NC1024.2 +108700 GO TO PFM-L-F1-10. NC1024.2 +108800 PFM-F-F1-10. NC1024.2 +108900 GO TO PFM-D-F1-10. NC1024.2 +109000 PFM-G-F1-10 SECTION. NC1024.2 +109100 PFM-H-F1-10. NC1024.2 +109200 GO TO PFM-E-F1-10. NC1024.2 +109300 PFM-I-F1-10. NC1024.2 +109400 GO TO PFM-D-F1-10. NC1024.2 +109500* NOTE SINCE THIS PARAGRAPH SHOULD NEVER BE ENTERED, IT IS NC1024.2 +109600* NOT POSSIBLE TO EXECUTE THE LAST SENTENCE IN PFM- NC1024.2 +109700* G-F1-10 EVEN THOUGH PFM-G-F1-10 IS A SECTION WHICH NC1024.2 +109800* IS THE OBJECT OF A PERFORM -- ALL THIS IS LEGAL. NC1024.2 +109900 PFM-J-F1-10 SECTION. NC1024.2 +110000 NC1024.2 +110100 PFM-K-F1-10. NC1024.2 +110200 PERFORM FAIL. NC1024.2 +110300 MOVE "PFM-K-F1-10 ENTERED" TO RE-MARK. NC1024.2 +110400 GO TO PFM-WRITE-F1-10. NC1024.2 +110500 PFM-L-F1-10. NC1024.2 +110600 GO TO PFM-B-F1-10. NC1024.2 +110700 PFM-WRITE-F1-10. NC1024.2 +110800 MOVE "PERFORM GO TO PARAS" TO FEATURE. NC1024.2 +110900 MOVE "PFM-TEST-F1-10" TO PAR-NAME. NC1024.2 +111000 PERFORM PRINT-DETAIL. NC1024.2 +111100 PFM-INIT-F2-5. NC1024.2 +111200 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +111300 MOVE ZERO TO PERFORM2. NC1024.2 +111400 PFM-TEST-F2-6. NC1024.2 +111500 PERFORM PFM-S PERFORM2 TIMES. NC1024.2 +111600 MOVE -3 TO PERFORM2. NC1024.2 +111700 PERFORM PFM-T PERFORM2 TIMES. NC1024.2 +111800 MOVE 7 TO PERFORM5. NC1024.2 +111900 PERFORM PFM-U PERFORM5 TIMES. NC1024.2 +112000* NOTE THE STANDARD SPECIFIES THAT THE COMPILER MUST NC1024.2 +112100* SIMPLY IGNORE THE FIRST TWO PERFORM5, AND MUST NC1024.2 +112200* PERFORM PFM-U SEVEN TIMES --- NOTE THAT PERFORM5 NC1024.2 +112300* IS INCREMENTED IN PFM-U, BUT THIS SHOULD HAVE NO NC1024.2 +112400* EFFECT ON THE NUMBER OF TIMES PFM-U IS PERFORMED. NC1024.2 +112500 IF PERFORM5 EQUAL TO 707 NC1024.2 +112600 PERFORM PASS GO TO PFM-WRITE-F2-6. NC1024.2 +112700 GO TO PFM-FAIL-F2-6. NC1024.2 +112800 PFM-DELETE-F2-6. NC1024.2 +112900 PERFORM DE-LETE. NC1024.2 +113000 GO TO PFM-WRITE-F2-6. NC1024.2 +113100 PFM-FAIL-F2-6. NC1024.2 +113200 MOVE PERFORM5 TO COMPUTED-N. NC1024.2 +113300 MOVE 707 TO CORRECT-N. NC1024.2 +113400 PERFORM FAIL. NC1024.2 +113500 PFM-WRITE-F2-6. NC1024.2 +113600 MOVE "PERFORM ... TIMES" TO FEATURE. NC1024.2 +113700 MOVE "PFM-TEST-F2-6" TO PAR-NAME. NC1024.2 +113800 PERFORM PRINT-DETAIL. NC1024.2 +113900* NC1024.2 +114000* NC1024.2 +114100 PFM-INIT-F1-11. NC1024.2 +114200 MOVE "V1-110 6.20.4 GR6" TO ANSI-REFERENCE. NC1024.2 +114300* ==--> IN LINE PERFORM <--== NC1024.2 +114400 MOVE 0 TO WRK-DU-2V0-1. NC1024.2 +114500 MOVE 0 TO WRK-DU-2V0-2. NC1024.2 +114600 PFM-TEST-F1-11-0. NC1024.2 +114700 PERFORM MOVE 88 TO WRK-DU-2V0-1 NC1024.2 +114800 MOVE 99 TO WRK-DU-2V0-2 NC1024.2 +114900 END-PERFORM. NC1024.2 +115000 PFM-TEST-F1-11-1. NC1024.2 +115100 IF WRK-DU-2V0-1 = 88 NC1024.2 +115200 PERFORM PASS NC1024.2 +115300 ELSE NC1024.2 +115400 MOVE 88 TO CORRECT-N NC1024.2 +115500 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1024.2 +115600 PERFORM FAIL. NC1024.2 +115700 GO TO PFM-WRITE-F1-11-1. NC1024.2 +115800 PFM-DELETE-F1-11-1. NC1024.2 +115900 PERFORM DE-LETE. NC1024.2 +116000 PFM-WRITE-F1-11-1. NC1024.2 +116100 MOVE "PFM-TEST-F1-11-1" TO PAR-NAME. NC1024.2 +116200 PERFORM PRINT-DETAIL. NC1024.2 +116300 PFM-TEST-F1-11-2. NC1024.2 +116400 IF WRK-DU-2V0-2 = 99 NC1024.2 +116500 PERFORM PASS NC1024.2 +116600 ELSE NC1024.2 +116700 MOVE 99 TO CORRECT-N NC1024.2 +116800 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1024.2 +116900 PERFORM FAIL. NC1024.2 +117000 GO TO PFM-WRITE-F1-11-2. NC1024.2 +117100 PFM-DELETE-F1-11-2. NC1024.2 +117200 PERFORM DE-LETE. NC1024.2 +117300 PFM-WRITE-F1-11-2. NC1024.2 +117400 MOVE "PFM-TEST-F1-11-2" TO PAR-NAME. NC1024.2 +117500 PERFORM PRINT-DETAIL. NC1024.2 +117600* NC1024.2 +117700* NC1024.2 +117800 PFM-INIT-F2-7. NC1024.2 +117900* ==--> IN LINE PERFORM <--== NC1024.2 +118000 MOVE "V1-110 6.20.4 GR6" TO ANSI-REFERENCE. NC1024.2 +118100 MOVE "PERFORM .... TIMES" TO FEATURE. NC1024.2 +118200 MOVE 0 TO P-COUNT. NC1024.2 +118300 MOVE 0 TO WRK-DU-2V0-1. NC1024.2 +118400 PFM-TEST-F2-7-0. NC1024.2 +118500 PERFORM 4 TIMES NC1024.2 +118600 ADD 3 TO P-COUNT NC1024.2 +118700 ADD 4 TO P-COUNT NC1024.2 +118800 END-PERFORM NC1024.2 +118900 MOVE 77 TO WRK-DU-2V0-1. NC1024.2 +119000 PFM-TEST-F2-7-1. NC1024.2 +119100 IF P-COUNT = 28 NC1024.2 +119200 PERFORM PASS NC1024.2 +119300 ELSE NC1024.2 +119400 MOVE 28 TO CORRECT-N NC1024.2 +119500 MOVE P-COUNT TO COMPUTED-N NC1024.2 +119600 PERFORM FAIL. NC1024.2 +119700 GO TO PFM-WRITE-F2-7-1. NC1024.2 +119800 PFM-DELETE-F2-7-1. NC1024.2 +119900 PERFORM DE-LETE. NC1024.2 +120000 PFM-WRITE-F2-7-1. NC1024.2 +120100 MOVE "PFM-TEST-F2-7-1" TO PAR-NAME. NC1024.2 +120200 PERFORM PRINT-DETAIL. NC1024.2 +120300 PFM-TEST-F2-7-2. NC1024.2 +120400 IF WRK-DU-2V0-1 = 77 NC1024.2 +120500 PERFORM PASS NC1024.2 +120600 ELSE NC1024.2 +120700 MOVE 77 TO CORRECT-N NC1024.2 +120800 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1024.2 +120900 PERFORM FAIL. NC1024.2 +121000 GO TO PFM-WRITE-F2-7-2. NC1024.2 +121100 PFM-DELETE-F2-7-2. NC1024.2 +121200 PERFORM DE-LETE. NC1024.2 +121300 PFM-WRITE-F2-7-2. NC1024.2 +121400 MOVE "PFM-TEST-F2-7-2" TO PAR-NAME. NC1024.2 +121500 PERFORM PRINT-DETAIL. NC1024.2 +121600* NC1024.2 +121700* NC1024.2 +121800 PFM-INIT-F2-8. NC1024.2 +121900* ==--> IN LINE PERFORM <--== NC1024.2 +122000 MOVE "V1-110 6.20.4 GR6" TO ANSI-REFERENCE. NC1024.2 +122100 MOVE "PERFORM .... TIMES" TO FEATURE. NC1024.2 +122200 MOVE 0 TO P-COUNT. NC1024.2 +122300 MOVE 0 TO WRK-DU-2V0-1. NC1024.2 +122400 MOVE 4 TO WRK-DU-2V0-2. NC1024.2 +122500 PFM-TEST-F2-8-0. NC1024.2 +122600 PERFORM WRK-DU-2V0-2 TIMES NC1024.2 +122700 ADD 3 TO P-COUNT NC1024.2 +122800 ADD 4 TO P-COUNT NC1024.2 +122900 END-PERFORM NC1024.2 +123000 MOVE 77 TO WRK-DU-2V0-1. NC1024.2 +123100 PFM-TEST-F2-8-1. NC1024.2 +123200 IF P-COUNT = 28 NC1024.2 +123300 PERFORM PASS NC1024.2 +123400 ELSE NC1024.2 +123500 MOVE 28 TO CORRECT-N NC1024.2 +123600 MOVE P-COUNT TO COMPUTED-N NC1024.2 +123700 PERFORM FAIL. NC1024.2 +123800 GO TO PFM-WRITE-F2-8-1. NC1024.2 +123900 PFM-DELETE-F2-8-1. NC1024.2 +124000 PERFORM DE-LETE. NC1024.2 +124100 PFM-WRITE-F2-8-1. NC1024.2 +124200 MOVE "PFM-TEST-F2-8-1" TO PAR-NAME. NC1024.2 +124300 PERFORM PRINT-DETAIL. NC1024.2 +124400 PFM-TEST-F2-8-2. NC1024.2 +124500 IF WRK-DU-2V0-1 = 77 NC1024.2 +124600 PERFORM PASS NC1024.2 +124700 ELSE NC1024.2 +124800 MOVE 77 TO CORRECT-N NC1024.2 +124900 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1024.2 +125000 PERFORM FAIL. NC1024.2 +125100 GO TO PFM-WRITE-F2-8-2. NC1024.2 +125200 PFM-DELETE-F2-8-2. NC1024.2 +125300 PERFORM DE-LETE. NC1024.2 +125400 PFM-WRITE-F2-8-2. NC1024.2 +125500 MOVE "PFM-TEST-F2-8-2" TO PAR-NAME. NC1024.2 +125600 PERFORM PRINT-DETAIL. NC1024.2 +125700* NC1024.2 +125800* NC1024.2 +125900 PFM-INIT-F3-1. NC1024.2 +126000 MOVE "PERFORM UNTIL" TO FEATURE. NC1024.2 +126100 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +126200 MOVE 1 TO PERFORM2. NC1024.2 +126300 MOVE 5 TO PERFORM3. NC1024.2 +126400 PFM-TEST-F3-1. NC1024.2 +126500 PERFORM PFM-F3-1-A THRU PFM-F3-1-AA NC1024.2 +126600 UNTIL PERFORM2 EQUAL TO 48. NC1024.2 +126700* NOTE IN THIS TEST THE CONDITION IS NOT SATISFIED NC1024.2 +126800* ORIGINALLY WHEN THE PERFORM IS ENTERED. NC1024.2 +126900 IF PERFORM2 = 48 NC1024.2 +127000 PERFORM PASS NC1024.2 +127100 GO TO PFM-WRITE-F3-1. NC1024.2 +127200 GO TO PFM-FAIL-F3-1. NC1024.2 +127300 PFM-DELETE-F3-1. NC1024.2 +127400 PERFORM DE-LETE. NC1024.2 +127500 GO TO PFM-WRITE-F3-1. NC1024.2 +127600 PFM-F3-1-A. NC1024.2 +127700 MULTIPLY PERFORM3 BY 6 GIVING PERFORM2. NC1024.2 +127800 PFM-F3-1-AA. NC1024.2 +127900 ADD 1 TO PERFORM3. NC1024.2 +128000 PFM-FAIL-F3-1. NC1024.2 +128100 MOVE PERFORM2 TO COMPUTED-N. NC1024.2 +128200 MOVE 48 TO CORRECT-N. NC1024.2 +128300 PERFORM FAIL. NC1024.2 +128400 PFM-WRITE-F3-1. NC1024.2 +128500 MOVE "PFM-TEST-F3-1" TO PAR-NAME. NC1024.2 +128600 PERFORM PRINT-DETAIL. NC1024.2 +128700* NC1024.2 +128800* NC1024.2 +128900 PFM-INIT-F3-2. NC1024.2 +129000 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +129100 MOVE 50 TO PERFORM2. NC1024.2 +129200* NOTE: IN THIS TEST CONDITION IS SATISFIED WHEN PERFORM IS NC1024.2 +129300* ENTERED AND CONTROL SHOULD NOT BE PASSED TO PFM-F3-2-C. NC1024.2 +129400 PFM-TEST-F3-2-0. NC1024.2 +129500 PERFORM PFM-F3-2-C UNTIL PERFORM2 GREATER THAN 25. NC1024.2 +129600 IF PERFORM2 EQUAL TO 50 NC1024.2 +129700 PERFORM PASS NC1024.2 +129800 GO TO PFM-WRITE-F3-2. NC1024.2 +129900 GO TO PFM-FAIL-F3-2. NC1024.2 +130000 PFM-DELETE-F3-2. NC1024.2 +130100 PERFORM DE-LETE. NC1024.2 +130200 GO TO PFM-WRITE-F3-2. NC1024.2 +130300 PFM-F3-2-C. NC1024.2 +130400 ADD 1 TO PERFORM2. NC1024.2 +130500 PFM-FAIL-F3-2. NC1024.2 +130600 MOVE PERFORM2 TO COMPUTED-N. NC1024.2 +130700 MOVE 50 TO CORRECT-N. NC1024.2 +130800 PERFORM FAIL. NC1024.2 +130900 PFM-WRITE-F3-2. NC1024.2 +131000 MOVE "PFM-TEST-F3-2" TO PAR-NAME. NC1024.2 +131100 PERFORM PRINT-DETAIL. NC1024.2 +131200* NC1024.2 +131300* NC1024.2 +131400 PFM-INIT-F3-3. NC1024.2 +131500 MOVE "V1-108 6.20.2" TO ANSI-REFERENCE. NC1024.2 +131600 MOVE ZERO TO WRK-DS-02V00. NC1024.2 +131700 PFM-TEST-F3-3. NC1024.2 +131800 PERFORM PFM-A-F3-3 THROUGH PFM-B-F3-3 NC1024.2 +131900 UNTIL WRK-DS-02V00 IS EQUAL TO 99. NC1024.2 +132000 GO TO PFM-TESTT-F3-3. NC1024.2 +132100 PFM-A-F3-3. NC1024.2 +132200 EXIT. NC1024.2 +132300 PFM-B-F3-3. NC1024.2 +132400 ADD 1 TO WRK-DS-02V00. NC1024.2 +132500 PFM-TESTT-F3-3. NC1024.2 +132600 IF WRK-DS-02V00 EQUAL TO 99 NC1024.2 +132700 PERFORM PASS GO TO PFM-WRITE-F3-3. NC1024.2 +132800 GO TO PFM-FAIL-F3-3. NC1024.2 +132900 PFM-DELETE-F3-3. NC1024.2 +133000 PERFORM DE-LETE. NC1024.2 +133100 GO TO PFM-WRITE-F3-3. NC1024.2 +133200 PFM-FAIL-F3-3. NC1024.2 +133300 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1024.2 +133400 MOVE 99 TO CORRECT-N. NC1024.2 +133500 PERFORM FAIL. NC1024.2 +133600 PFM-WRITE-F3-3. NC1024.2 +133700 MOVE "PFM-TEST-F3-3 " TO PAR-NAME. NC1024.2 +133800 PERFORM PRINT-DETAIL. NC1024.2 +133900* NC1024.2 +134000* NC1024.2 +134100 PFM-INIT-F3-4. NC1024.2 +134200* ==--> IN-LINE PERFORM <--== NC1024.2 +134300 MOVE "V1-110 6.20.4 GR6" TO ANSI-REFERENCE. NC1024.2 +134400 MOVE ZERO TO WRK-DU-6V0-1. NC1024.2 +134500 PFM-TEST-F3-4-0. NC1024.2 +134600 PERFORM UNTIL WRK-DU-6V0-1 = 99 NC1024.2 +134700 ADD 6 TO WRK-DU-6V0-1 NC1024.2 +134800 SUBTRACT 3 FROM WRK-DU-6V0-1 NC1024.2 +134900 END-PERFORM NC1024.2 +135000 SUBTRACT 1 FROM WRK-DU-6V0-1. NC1024.2 +135100 PFM-TESTT-F3-4-1. NC1024.2 +135200 IF WRK-DU-6V0-1 EQUAL TO 98 NC1024.2 +135300 PERFORM PASS GO TO PFM-WRITE-F3-4. NC1024.2 +135400 GO TO PFM-FAIL-F3-4. NC1024.2 +135500 PFM-DELETE-F3-4. NC1024.2 +135600 PERFORM DE-LETE. NC1024.2 +135700 GO TO PFM-WRITE-F3-4. NC1024.2 +135800 PFM-FAIL-F3-4. NC1024.2 +135900 MOVE WRK-DU-6V0-1 TO COMPUTED-N. NC1024.2 +136000 MOVE 98 TO CORRECT-N. NC1024.2 +136100 PERFORM FAIL. NC1024.2 +136200 PFM-WRITE-F3-4. NC1024.2 +136300 MOVE "PFM-TEST-F3-4 " TO PAR-NAME. NC1024.2 +136400 PERFORM PRINT-DETAIL. NC1024.2 +136500 GO TO CCVS-EXIT. NC1024.2 +136600 A121. NC1024.2 +136700 EXIT. NC1024.2 +136800 A120. NC1024.2 +136900 MOVE "T" TO TEST-LETTER (20). NC1024.2 +137000 PERFORM A121. NC1024.2 +137100 A119. NC1024.2 +137200 MOVE "S" TO TEST-LETTER (19). NC1024.2 +137300 PERFORM A120. NC1024.2 +137400 A118. NC1024.2 +137500 MOVE "R" TO TEST-LETTER (18). NC1024.2 +137600 PERFORM A119. NC1024.2 +137700 A117. NC1024.2 +137800 MOVE "Q" TO TEST-LETTER (17). NC1024.2 +137900 PERFORM A118. NC1024.2 +138000 A116. NC1024.2 +138100 MOVE "P" TO TEST-LETTER (16). NC1024.2 +138200 PERFORM A117. NC1024.2 +138300 A115. NC1024.2 +138400 MOVE "O" TO TEST-LETTER (15). NC1024.2 +138500 PERFORM A116. NC1024.2 +138600 A114. NC1024.2 +138700 MOVE "N" TO TEST-LETTER (14). NC1024.2 +138800 PERFORM A115. NC1024.2 +138900 A113. NC1024.2 +139000 MOVE "M" TO TEST-LETTER (13). NC1024.2 +139100 PERFORM A114. NC1024.2 +139200 A112. NC1024.2 +139300 MOVE "L" TO TEST-LETTER (12). NC1024.2 +139400 PERFORM A113. NC1024.2 +139500 A111. NC1024.2 +139600 MOVE "K" TO TEST-LETTER (11). NC1024.2 +139700 PERFORM A112. NC1024.2 +139800 A110. NC1024.2 +139900 MOVE "J" TO TEST-LETTER (10). NC1024.2 +140000 PERFORM A111. NC1024.2 +140100 A109. NC1024.2 +140200 MOVE "I" TO TEST-LETTER (9). NC1024.2 +140300 PERFORM A110. NC1024.2 +140400 A108. NC1024.2 +140500 MOVE "H" TO TEST-LETTER (8). NC1024.2 +140600 PERFORM A109. NC1024.2 +140700 A107. NC1024.2 +140800 MOVE "G" TO TEST-LETTER (7). NC1024.2 +140900 PERFORM A108. NC1024.2 +141000 A106. NC1024.2 +141100 MOVE "F" TO TEST-LETTER (6). NC1024.2 +141200 PERFORM A107. NC1024.2 +141300 A105. NC1024.2 +141400 MOVE "E" TO TEST-LETTER (5). NC1024.2 +141500 PERFORM A106. NC1024.2 +141600 A104. NC1024.2 +141700 MOVE "D" TO TEST-LETTER (4). NC1024.2 +141800 PERFORM A105. NC1024.2 +141900 A103. NC1024.2 +142000 MOVE "C" TO TEST-LETTER (3). NC1024.2 +142100 PERFORM A104. NC1024.2 +142200 A102. NC1024.2 +142300 MOVE "B" TO TEST-LETTER (2). NC1024.2 +142400 PERFORM A103. NC1024.2 +142500 A101. NC1024.2 +142600 MOVE "A" TO TEST-LETTER (1). NC1024.2 +142700 PERFORM A102. NC1024.2 +142800 PFM-C. NC1024.2 +142900 ADD 6 TO PERFORM2. NC1024.2 +143000 PFM-D. NC1024.2 +143100 PERFORM FAIL. NC1024.2 +143200 GO TO PFM-TEST-F1-3. NC1024.2 +143300* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH NC1024.2 +143400* FROM THE PREVIOUS ONE. NC1024.2 +143500 PFM-E. NC1024.2 +143600 MOVE "CSW" TO PERFORM1. NC1024.2 +143700 PERFORM PFM-F THRU PFM-G. NC1024.2 +143800 SUBTRACT .8 FROM PERFORM4. NC1024.2 +143900 GO TO PFM-H. NC1024.2 +144000 PFM-F. NC1024.2 +144100 MOVE 60.5 TO PERFORM4. NC1024.2 +144200 PFM-G. NC1024.2 +144300 ADD 10.3 TO PERFORM4. NC1024.2 +144400 PFM-H. NC1024.2 +144500 EXIT. NC1024.2 +144600 PFM-I. NC1024.2 +144700 PERFORM FAIL. NC1024.2 +144800 GO TO PFM-WRITE-F3-4. NC1024.2 +144900* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH NC1024.2 +145000* FROM THE PREVIOUS ONE. NC1024.2 +145100 PFM-J. NC1024.2 +145200 MOVE "YES" TO PERFORM1. NC1024.2 +145300 PERFORM PFM-L. NC1024.2 +145400 MULTIPLY 3 BY PERFORM2. NC1024.2 +145500 PFM-K. NC1024.2 +145600 PERFORM FAIL. NC1024.2 +145700 GO TO PFM-WRITE-F1-4. NC1024.2 +145800* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH NC1024.2 +145900* FROM THE PREVIOUS ONE. NC1024.2 +146000 PFM-L. NC1024.2 +146100 MOVE 4 TO PERFORM2. NC1024.2 +146200 ADD 100 TO PERFORM2. NC1024.2 +146300 PFM-M. NC1024.2 +146400 PERFORM FAIL. NC1024.2 +146500 GO TO PFM-WRITE-F1-4. NC1024.2 +146600* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH NC1024.2 +146700* FROM THE PREVIOUS ONE. NC1024.2 +146800 PFM-N SECTION. NC1024.2 +146900 PFM-O. NC1024.2 +147000 PERFORM FAIL. NC1024.2 +147100 PFM-P. NC1024.2 +147200 SUBTRACT 1 FROM ERROR-COUNTER. NC1024.2 +147300 PERFORM PASS. NC1024.2 +147400 PFM-Q SECTION. NC1024.2 +147500 PFM-R. NC1024.2 +147600 PERFORM FAIL. NC1024.2 +147700 GO TO PFM-WRITE-F1-5. NC1024.2 +147800* NOTE CONTROL SHOULD NOT PASS TO THIS PARAGRAPH FROM THE NC1024.2 +147900* PREVIOUS ONE. NC1024.2 +148000 PFM-S. NC1024.2 +148100 ADD 1 TO PERFORM5. NC1024.2 +148200 PFM-T. NC1024.2 +148300 ADD 10 TO PERFORM5. NC1024.2 +148400 PFM-U. NC1024.2 +148500 ADD 100 TO PERFORM5. NC1024.2 +148600 IF PERFORM5 GREATER THAN 899 NC1024.2 +148700 MOVE PERFORM5 TO COMPUTED-N NC1024.2 +148800 MOVE 707 TO CORRECT-N NC1024.2 +148900 PERFORM FAIL NC1024.2 +149000 MOVE "PFM-TEST-F2-6" TO PAR-NAME NC1024.2 +149100 MOVE "*** ABORTED *** SEE PFM-U" TO RE-MARK NC1024.2 +149200 PERFORM PRINT-DETAIL NC1024.2 +149300 PERFORM END-ROUTINE THRU END-ROUTINE-13 NC1024.2 +149400 CLOSE PRINT-FILE NC1024.2 +149500 STOP RUN. NC1024.2 +149600 PFM-V. EXIT. NC1024.2 +149700 PFM-W. EXIT. NC1024.2 +149800 PFM-X. EXIT. NC1024.2 +149900 PFM-Y. EXIT. NC1024.2 +150000 PFM-Z. EXIT. NC1024.2 +150100 CCVS-EXIT SECTION. NC1024.2 +150200 CCVS-999999. NC1024.2 +150300 GO TO CLOSE-FILES. NC1024.2 diff --git a/tests/cobol85/NC/NC103A.CBL b/tests/cobol85/NC/NC103A.CBL new file mode 100755 index 00000000..a371f501 --- /dev/null +++ b/tests/cobol85/NC/NC103A.CBL @@ -0,0 +1,2139 @@ +000100 IDENTIFICATION DIVISION. NC1034.2 +000200 PROGRAM-ID. NC1034.2 +000300 NC103A. NC1034.2 +000400**************************************************************** NC1034.2 +000500* * NC1034.2 +000600* VALIDATION FOR:- * NC1034.2 +000700* * NC1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1034.2 +000900* * NC1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1034.2 +001100* * NC1034.2 +001200**************************************************************** NC1034.2 +001300* * NC1034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1034.2 +001500* * NC1034.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1034.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1034.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1034.2 +001900* * NC1034.2 +002000**************************************************************** NC1034.2 +002100* NC1034.2 +002200* PROGRAM NC103A TESTS THE GENERAL FORMAT OF THE "IF" NC1034.2 +002300* STATEMENT AND "NEXT SENTENCE". NC1034.2 +002400* NC1034.2 +002500 ENVIRONMENT DIVISION. NC1034.2 +002600 CONFIGURATION SECTION. NC1034.2 +002700 SOURCE-COMPUTER. NC1034.2 +002800 Linux. NC1034.2 +002900 OBJECT-COMPUTER. NC1034.2 +003000 Linux. NC1034.2 +003100 INPUT-OUTPUT SECTION. NC1034.2 +003200 FILE-CONTROL. NC1034.2 +003300 SELECT PRINT-FILE ASSIGN TO NC1034.2 +003400 "report.log". NC1034.2 +003500 DATA DIVISION. NC1034.2 +003600 FILE SECTION. NC1034.2 +003700 FD PRINT-FILE. NC1034.2 +003800 01 PRINT-REC PICTURE X(120). NC1034.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC1034.2 +004000 WORKING-STORAGE SECTION. NC1034.2 +004100 01 TEST-RESULTS. NC1034.2 +004200 02 FILLER PIC X VALUE SPACE. NC1034.2 +004300 02 FEATURE PIC X(20) VALUE SPACE. NC1034.2 +004400 02 FILLER PIC X VALUE SPACE. NC1034.2 +004500 02 P-OR-F PIC X(5) VALUE SPACE. NC1034.2 +004600 02 FILLER PIC X VALUE SPACE. NC1034.2 +004700 02 PAR-NAME. NC1034.2 +004800 03 FILLER PIC X(19) VALUE SPACE. NC1034.2 +004900 03 PARDOT-X PIC X VALUE SPACE. NC1034.2 +005000 03 DOTVALUE PIC 99 VALUE ZERO. NC1034.2 +005100 02 FILLER PIC X(8) VALUE SPACE. NC1034.2 +005200 02 RE-MARK PIC X(61). NC1034.2 +005300 01 TEST-COMPUTED. NC1034.2 +005400 02 FILLER PIC X(30) VALUE SPACE. NC1034.2 +005500 02 FILLER PIC X(17) VALUE NC1034.2 +005600 " COMPUTED=". NC1034.2 +005700 02 COMPUTED-X. NC1034.2 +005800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1034.2 +005900 03 COMPUTED-N REDEFINES COMPUTED-A NC1034.2 +006000 PIC -9(9).9(9). NC1034.2 +006100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1034.2 +006200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1034.2 +006300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1034.2 +006400 03 CM-18V0 REDEFINES COMPUTED-A. NC1034.2 +006500 04 COMPUTED-18V0 PIC -9(18). NC1034.2 +006600 04 FILLER PIC X. NC1034.2 +006700 03 FILLER PIC X(50) VALUE SPACE. NC1034.2 +006800 01 TEST-CORRECT. NC1034.2 +006900 02 FILLER PIC X(30) VALUE SPACE. NC1034.2 +007000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1034.2 +007100 02 CORRECT-X. NC1034.2 +007200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1034.2 +007300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1034.2 +007400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1034.2 +007500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1034.2 +007600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1034.2 +007700 03 CR-18V0 REDEFINES CORRECT-A. NC1034.2 +007800 04 CORRECT-18V0 PIC -9(18). NC1034.2 +007900 04 FILLER PIC X. NC1034.2 +008000 03 FILLER PIC X(2) VALUE SPACE. NC1034.2 +008100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1034.2 +008200 01 CCVS-C-1. NC1034.2 +008300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1034.2 +008400- "SS PARAGRAPH-NAME NC1034.2 +008500- " REMARKS". NC1034.2 +008600 02 FILLER PIC X(20) VALUE SPACE. NC1034.2 +008700 01 CCVS-C-2. NC1034.2 +008800 02 FILLER PIC X VALUE SPACE. NC1034.2 +008900 02 FILLER PIC X(6) VALUE "TESTED". NC1034.2 +009000 02 FILLER PIC X(15) VALUE SPACE. NC1034.2 +009100 02 FILLER PIC X(4) VALUE "FAIL". NC1034.2 +009200 02 FILLER PIC X(94) VALUE SPACE. NC1034.2 +009300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1034.2 +009400 01 REC-CT PIC 99 VALUE ZERO. NC1034.2 +009500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1034.2 +009600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1034.2 +009700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1034.2 +009800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1034.2 +009900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1034.2 +010000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1034.2 +010100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1034.2 +010200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1034.2 +010300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1034.2 +010400 01 CCVS-H-1. NC1034.2 +010500 02 FILLER PIC X(39) VALUE SPACES. NC1034.2 +010600 02 FILLER PIC X(42) VALUE NC1034.2 +010700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1034.2 +010800 02 FILLER PIC X(39) VALUE SPACES. NC1034.2 +010900 01 CCVS-H-2A. NC1034.2 +011000 02 FILLER PIC X(40) VALUE SPACE. NC1034.2 +011100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1034.2 +011200 02 FILLER PIC XXXX VALUE NC1034.2 +011300 "4.2 ". NC1034.2 +011400 02 FILLER PIC X(28) VALUE NC1034.2 +011500 " COPY - NOT FOR DISTRIBUTION". NC1034.2 +011600 02 FILLER PIC X(41) VALUE SPACE. NC1034.2 +011700 NC1034.2 +011800 01 CCVS-H-2B. NC1034.2 +011900 02 FILLER PIC X(15) VALUE NC1034.2 +012000 "TEST RESULT OF ". NC1034.2 +012100 02 TEST-ID PIC X(9). NC1034.2 +012200 02 FILLER PIC X(4) VALUE NC1034.2 +012300 " IN ". NC1034.2 +012400 02 FILLER PIC X(12) VALUE NC1034.2 +012500 " HIGH ". NC1034.2 +012600 02 FILLER PIC X(22) VALUE NC1034.2 +012700 " LEVEL VALIDATION FOR ". NC1034.2 +012800 02 FILLER PIC X(58) VALUE NC1034.2 +012900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1034.2 +013000 01 CCVS-H-3. NC1034.2 +013100 02 FILLER PIC X(34) VALUE NC1034.2 +013200 " FOR OFFICIAL USE ONLY ". NC1034.2 +013300 02 FILLER PIC X(58) VALUE NC1034.2 +013400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1034.2 +013500 02 FILLER PIC X(28) VALUE NC1034.2 +013600 " COPYRIGHT 1985 ". NC1034.2 +013700 01 CCVS-E-1. NC1034.2 +013800 02 FILLER PIC X(52) VALUE SPACE. NC1034.2 +013900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1034.2 +014000 02 ID-AGAIN PIC X(9). NC1034.2 +014100 02 FILLER PIC X(45) VALUE SPACES. NC1034.2 +014200 01 CCVS-E-2. NC1034.2 +014300 02 FILLER PIC X(31) VALUE SPACE. NC1034.2 +014400 02 FILLER PIC X(21) VALUE SPACE. NC1034.2 +014500 02 CCVS-E-2-2. NC1034.2 +014600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1034.2 +014700 03 FILLER PIC X VALUE SPACE. NC1034.2 +014800 03 ENDER-DESC PIC X(44) VALUE NC1034.2 +014900 "ERRORS ENCOUNTERED". NC1034.2 +015000 01 CCVS-E-3. NC1034.2 +015100 02 FILLER PIC X(22) VALUE NC1034.2 +015200 " FOR OFFICIAL USE ONLY". NC1034.2 +015300 02 FILLER PIC X(12) VALUE SPACE. NC1034.2 +015400 02 FILLER PIC X(58) VALUE NC1034.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1034.2 +015600 02 FILLER PIC X(13) VALUE SPACE. NC1034.2 +015700 02 FILLER PIC X(15) VALUE NC1034.2 +015800 " COPYRIGHT 1985". NC1034.2 +015900 01 CCVS-E-4. NC1034.2 +016000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1034.2 +016100 02 FILLER PIC X(4) VALUE " OF ". NC1034.2 +016200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1034.2 +016300 02 FILLER PIC X(40) VALUE NC1034.2 +016400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1034.2 +016500 01 XXINFO. NC1034.2 +016600 02 FILLER PIC X(19) VALUE NC1034.2 +016700 "*** INFORMATION ***". NC1034.2 +016800 02 INFO-TEXT. NC1034.2 +016900 04 FILLER PIC X(8) VALUE SPACE. NC1034.2 +017000 04 XXCOMPUTED PIC X(20). NC1034.2 +017100 04 FILLER PIC X(5) VALUE SPACE. NC1034.2 +017200 04 XXCORRECT PIC X(20). NC1034.2 +017300 02 INF-ANSI-REFERENCE PIC X(48). NC1034.2 +017400 01 HYPHEN-LINE. NC1034.2 +017500 02 FILLER PIC IS X VALUE IS SPACE. NC1034.2 +017600 02 FILLER PIC IS X(65) VALUE IS "************************NC1034.2 +017700- "*****************************************". NC1034.2 +017800 02 FILLER PIC IS X(54) VALUE IS "************************NC1034.2 +017900- "******************************". NC1034.2 +018000 01 CCVS-PGM-ID PIC X(9) VALUE NC1034.2 +018100 "NC103A". NC1034.2 +018200 01 IF-D1 PICTURE IS S9(4)V9(2) NC1034.2 +018300 VALUE IS 0. NC1034.2 +018400 01 IF-D2 PICTURE IS S9(4)V9(2) NC1034.2 +018500 VALUE IS ZERO. NC1034.2 +018600 01 IF-D3 PICTURE IS X(10) NC1034.2 +018700 VALUE IS "0000000000". NC1034.2 +018800 01 IF-D4 PICTURE IS X(15) NC1034.2 +018900 VALUE IS " ". NC1034.2 +019000 01 IF-D6 PICTURE IS A(10) NC1034.2 +019100 VALUE IS "BABABABABA". NC1034.2 +019200 01 IF-D7 PICTURE IS S9(6)V9(4) NC1034.2 +019300 VALUE IS +123.45. NC1034.2 +019400 01 IF-D8 PICTURE IS 9(6)V9(4) NC1034.2 +019500 VALUE IS 12300. NC1034.2 +019600 01 IF-D9 PICTURE IS X(3) NC1034.2 +019700 VALUE IS "123". NC1034.2 +019800 01 IF-D11 PICTURE IS X(6) NC1034.2 +019900 VALUE IS "ABCDEF". NC1034.2 +020000 01 IF-D13 PICTURE IS 9(6)V9(4) NC1034.2 +020100 VALUE IS 12300. NC1034.2 +020200 01 IF-D14 PICTURE IS S9(4)V9(2) NC1034.2 +020300 VALUE IS +123.45. NC1034.2 +020400 01 IF-D15 PICTURE IS S999PP NC1034.2 +020500 VALUE IS 12300. NC1034.2 +020600 01 IF-D16 PICTURE IS PP99 NC1034.2 +020700 VALUE IS .0012. NC1034.2 +020800 01 IF-D17 PICTURE IS SV9(4) NC1034.2 +020900 VALUE IS .0012. NC1034.2 +021000 01 IF-D18 PICTURE IS X(10) NC1034.2 +021100 VALUE IS "BABABABABA". NC1034.2 +021200 01 IF-D19 PICTURE IS X(10) NC1034.2 +021300 VALUE IS "ABCDEF ". NC1034.2 +021400 01 IF-D23 PICTURE IS $9,9B9.90+. NC1034.2 +021500 01 IF-D24 PICTURE IS X(10) NC1034.2 +021600 VALUE IS "$1,2 3.40+". NC1034.2 +021700 01 IF-D25 PICTURE IS ABABX0A. NC1034.2 +021800 01 IF-D26 PIC X(7) NC1034.2 +021900 VALUE IS "A C D0E". NC1034.2 +022000 01 IF-D27 PICTURE 9(6)V9(4) VALUE 2137.45 NC1034.2 +022100 USAGE IS COMPUTATIONAL. NC1034.2 +022200 01 IF-D28 PICTURE IS 999999V9999 NC1034.2 +022300 VALUE IS 2137.45. NC1034.2 +022400 01 IF-D32 PICTURE IS 9 VALUE IS 0. NC1034.2 +022500 01 IF-D33 PICTURE S9 VALUE -0. NC1034.2 +022600 01 IF-D34 PICTURE S9 VALUE +0. NC1034.2 +022700 01 IF-D37 PICTURE 9(5) VALUE 0001234. NC1034.2 +022800 01 IF-D38 PICTURE X(20) VALUE " BABBAGE". NC1034.2 +022900 01 ALPHA-UPPER PIC X(20) VALUE " UPPERCASE CHARS". NC1034.2 +023000 01 ALPHA-LOWER PIC X(20) VALUE " lowercase chars". NC1034.2 +023100 01 NON-COBOL-CHARACTERS PICTURE X(8) VALUE NC1034.2 +023200 "12345678". NC1034.2 +023300 01 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1034.2 +023400 01 A18ONES-DS-18V00 PICTURE S9(18) NC1034.2 +023500 VALUE 111111111111111111. NC1034.2 +023600 01 ONES-XN-00018 PICTURE X(18) NC1034.2 +023700 VALUE "111111111111111111". NC1034.2 +023800 01 A99-DS-02V00 PICTURE S99 VALUE 99. NC1034.2 +023900 01 WRK-DU-02V00 PICTURE 99. NC1034.2 +024000 01 TWOS-XN-00002 PICTURE XX VALUE "22". NC1034.2 +024100 01 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1034.2 +024200 VALUE 111111111.111111111. NC1034.2 +024300 01 ONES-XN-00002 PICTURE XX VALUE "11". NC1034.2 +024400 01 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1034.2 +024500 01 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1034.2 +024600 01 A990-DS-0201P PICTURE S99P VALUE +990. NC1034.2 +024700 01 XDATA-XN-00018 PICTURE X(18) NC1034.2 +024800 VALUE "00ABCDEFGHI 4321 ". NC1034.2 +024900 01 XDATA-DS-18V00-S REDEFINES XDATA-XN-00018 PICTURE S9(18). NC1034.2 +025000 01 YADATA-XN-00010 PICTURE X(10) VALUE "ABCDEFGHIJ".NC1034.2 +025100 01 YADATA-XN-00010-U-AND-L PICTURE X(10) VALUE "AbCdEfGhIj".NC1034.2 +025200 01 DUMMY-DS-00001 PICTURE S9 VALUE -1. NC1034.2 +025300 01 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1034.2 +025400 01 WRK-DS-18V0-1 PIC S9(18) VALUE NC1034.2 +025500 -123456789012345678. NC1034.2 +025600 01 WRK-XN-18-2 PIC X(18) VALUE NC1034.2 +025700 "123456789012345678". NC1034.2 +025800 NC1034.2 +025900 01 IF-D10. NC1034.2 +026000 02 FILLER PICTURE XX VALUE "01". NC1034.2 +026100 02 FILLER PICTURE XX VALUE "23". NC1034.2 +026200 02 IF-D10A. NC1034.2 +026300 03 FILLER PICTURE XXXX VALUE "4567". NC1034.2 +026400 03 FILLER PICTURE XXXX VALUE "8912". NC1034.2 +026500 01 IF-D12. NC1034.2 +026600 02 FILLER PICTURE XXX VALUE "ABC". NC1034.2 +026700 02 IF-D12A. NC1034.2 +026800 03 IF-D12B. NC1034.2 +026900 04 FILLER PICTURE XX VALUE "DE". NC1034.2 +027000 04 FILLER PICTURE X VALUE "F". NC1034.2 +027100 01 IF-D20. NC1034.2 +027200 02 FILLER PICTURE 9(5) VALUE ZERO. NC1034.2 +027300 02 FILLER PICTURE 99 VALUE 12. NC1034.2 +027400 02 FILLER PICTURE 9 VALUE 3. NC1034.2 +027500 02 FILLER PICTURE 99 VALUE 45. NC1034.2 +027600 01 IF-D21. NC1034.2 +027700 02 FILLER PICTURE 9(5) VALUE ZERO. NC1034.2 +027800 02 FILLER PICTURE 9(5) VALUE 12345. NC1034.2 +027900 01 IF-D22. NC1034.2 +028000 02 FILLER PICTURE AA VALUE "AB". NC1034.2 +028100 02 FILLER PICTURE AAAA VALUE "CDEF". NC1034.2 +028200 01 IF-D35. NC1034.2 +028300 02 IF-D35A VALUE "*ASTERISK". NC1034.2 +028400 03 FILLER PICTURE A(6). NC1034.2 +028500 03 FILLER PICTURE AAA. NC1034.2 +028600 02 IF-D35B VALUE "/SLASH". NC1034.2 +028700 03 FILLER PICTURE 9(6). NC1034.2 +028800 01 IF-D36 REDEFINES IF-D35. NC1034.2 +028900 02 IF-D36A PICTURE X(6). NC1034.2 +029000 02 IF-D36B PICTURE XXX. NC1034.2 +029100 02 IF-D36C PICTURE X(6). NC1034.2 +029200 01 IF-D39. NC1034.2 +029300 02 FILLER PICTURE A(6) VALUE "ABCDEF". NC1034.2 +029400 02 FILLER PICTURE A(4) VALUE SPACE. NC1034.2 +029500 01 LEVEL-01. NC1034.2 +029600 02 LEVEL-02. NC1034.2 +029700 03 LEVEL-03. NC1034.2 +029800 04 LEVEL-04. NC1034.2 +029900 05 LEVEL-05. NC1034.2 +030000 06 LEVEL-06. NC1034.2 +030100 07 LEVEL-07. NC1034.2 +030200 08 LEVEL-08. NC1034.2 +030300 09 LEVEL-09. NC1034.2 +030400 10 LEVEL-10 PICTURE IS X VALUE IS "R".NC1034.2 +030500 01 LEVEL-RECEIVER PICTURE IS X VALUE IS NC1034.2 +030600 SPACE. NC1034.2 +030700 01 LEVEL-SENDER PICTURE X VALUE "S". NC1034.2 +030800 01 VAL PICTURE IS 9 VALUE IS 0. NC1034.2 +030900 01 A-2 PICTURE IS A VALUE IS "A".NC1034.2 +031000 01 N-27 PICTURE IS 9999V9 NC1034.2 +031100 VALUE IS 9999.9. NC1034.2 +031200 01 N-30 PICTURE IS 9V9 NC1034.2 +031300 VALUE IS 2. NC1034.2 +031400 01 N-31 PICTURE IS 9(6). NC1034.2 +031500 01 X-32 REDEFINES N-31 PICTURE IS X(6). NC1034.2 +031600 01 N-33 PICTURE IS 9(5) NC1034.2 +031700 VALUE IS 29. NC1034.2 +031800 01 A-37 PICTURE IS A VALUE IS "X".NC1034.2 +031900 01 X-38 REDEFINES A-37 PICTURE IS X. NC1034.2 +032000 01 X-43 PIC X(10) VALUE " l75.63". NC1034.2 +032100 01 N-84 PICTURE IS 9999999999. NC1034.2 +032200 01 NUMERIC-GRP-TEST. NC1034.2 +032300 02 NUMERIC-1 PICTURE 9 VALUE 0. NC1034.2 +032400 02 NUMERIC-2. NC1034.2 +032500 03 NUMERIC-3 PICTURE 9(1)V9(1) VALUE ZERO. NC1034.2 +032600 03 NUMERIC-4. NC1034.2 +032700 04 NUMERIC-5 PICTURE 9(18) VALUE 1. NC1034.2 +032800 02 NUMERIC-6. NC1034.2 +032900 03 NUMERIC-7 PICTURE X VALUE "7". NC1034.2 +033000 03 NUMERIC-8 PICTURE 9 VALUE 8. NC1034.2 +033100 01 NUM-GRP. NC1034.2 +033200 02 NUM-SUB-GRP PIC 9. NC1034.2 +033300 01 GROUP-1000. NC1034.2 +033400 02 FILLER PIC X. NC1034.2 +033500 02 GROUP-X1000. NC1034.2 +033600 03 GROUP-1000-1 PIC X(500) VALUE ZERO. NC1034.2 +033700 03 XNAME PICTURE X(100) VALUE QUOTE. NC1034.2 +033800 03 GROUP-1000-2 PICTURE X(399) VALUE SPACE. NC1034.2 +033900 03 GROUP-1000-3 PICTURE X VALUE ".". NC1034.2 +034000 02 GROUP-X500-2. NC1034.2 +034100 03 GROUP-X500-A PICTURE X(500) VALUE ZERO. NC1034.2 +034200 03 GROUP-X500-1. NC1034.2 +034300 04 GROUP-X500-1-1 PICTURE X(50) VALUE QUOTE. NC1034.2 +034400 04 GROUP-X500-1-2 PICTURE X(50) VALUE QUOTE. NC1034.2 +034500 04 GROUP-X500-1-3 PICTURE X(398) VALUE SPACE. NC1034.2 +034600 04 GROUP-X500-1-4 PICTURE XX VALUE " .". NC1034.2 +034700 01 HI-LO-VALUES. NC1034.2 +034800 02 LOW-VAL PIC X VALUE LOW-VALUE. NC1034.2 +034900 02 ZERO-01 PICTURE 9(18) VALUE 1. NC1034.2 +035000 02 ABC PICTURE XXX VALUE "ABC". NC1034.2 +035100 02 NINE-17-8 PICTURE 9(18) VALUE 999999999999999998. NC1034.2 +035200 02 ZERO-NULL PIC 9(9) VALUE 0. NC1034.2 +035300 02 ZERO-ZERO PICTURE 9(9)V9(9) VALUE 0.0. NC1034.2 +035400 01 COMP-DATA. NC1034.2 +035500 02 COMP-DATA1 PICTURE 9(18) COMPUTATIONAL VALUE 300. NC1034.2 +035600 02 COMP-DATA2 PICTURE 9(10) COMPUTATIONAL VALUE 100000. NC1034.2 +035700 02 COMP-DATA3 PICTURE 9 COMPUTATIONAL VALUE 9. NC1034.2 +035800 02 COMP-DATA4 PICTURE 9(9)V9(7) COMPUTATIONAL VALUE 3.3. NC1034.2 +035900 02 COMP-DATA5 PICTURE 9(5)V9(2) COMPUTATIONAL VALUE 52.25. NC1034.2 +036000 02 COMP-DATA6 PICTURE 9V9 COMPUTATIONAL VALUE 8.8. NC1034.2 +036100 02 COMP-DATA7 PICTURE 9(3)V9(2) COMPUTATIONAL VALUE 300.00.NC1034.2 +036200 02 COMP-DATA8 PICTURE 9V9(9) COMPUTATIONAL VALUE 3.3000000.NC1034.2 +036300 02 COMP-DATA9 PICTURE 9(8) COMPUTATIONAL VALUE 100000. NC1034.2 +036400 01 DISP-DATA. NC1034.2 +036500 02 DISP-DATA1 PICTURE 9(18) VALUE 300. NC1034.2 +036600 02 DISP-DATA2 PICTURE 9(8) VALUE 100000. NC1034.2 +036700 02 DISP-DATA3 PICTURE 9 VALUE 9. NC1034.2 +036800 02 DISP-DATA4 PICTURE 9(7)V9(9) VALUE 3.3. NC1034.2 +036900 02 DISP-DATA5 PICTURE 9(2)V9(2) VALUE 52.25. NC1034.2 +037000 02 DISP-DATA6 PICTURE 9V9 VALUE 8.8. NC1034.2 +037100 PROCEDURE DIVISION. NC1034.2 +037200 CCVS1 SECTION. NC1034.2 +037300 OPEN-FILES. NC1034.2 +037400 OPEN OUTPUT PRINT-FILE. NC1034.2 +037500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1034.2 +037600 MOVE SPACE TO TEST-RESULTS. NC1034.2 +037700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1034.2 +037800 GO TO CCVS1-EXIT. NC1034.2 +037900 CLOSE-FILES. NC1034.2 +038000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1034.2 +038100 TERMINATE-CCVS. NC1034.2 +038200*S EXIT PROGRAM. NC1034.2 +038300*SERMINATE-CALL. NC1034.2 +038400 STOP RUN. NC1034.2 +038500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1034.2 +038600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1034.2 +038700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1034.2 +038800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1034.2 +038900 MOVE "****TEST DELETED****" TO RE-MARK. NC1034.2 +039000 PRINT-DETAIL. NC1034.2 +039100 IF REC-CT NOT EQUAL TO ZERO NC1034.2 +039200 MOVE "." TO PARDOT-X NC1034.2 +039300 MOVE REC-CT TO DOTVALUE. NC1034.2 +039400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1034.2 +039500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1034.2 +039600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1034.2 +039700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1034.2 +039800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1034.2 +039900 MOVE SPACE TO CORRECT-X. NC1034.2 +040000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1034.2 +040100 MOVE SPACE TO RE-MARK. NC1034.2 +040200 HEAD-ROUTINE. NC1034.2 +040300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +040400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +040500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1034.2 +040600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1034.2 +040700 COLUMN-NAMES-ROUTINE. NC1034.2 +040800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +040900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +041000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +041100 END-ROUTINE. NC1034.2 +041200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1034.2 +041300 END-RTN-EXIT. NC1034.2 +041400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +041500 END-ROUTINE-1. NC1034.2 +041600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1034.2 +041700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1034.2 +041800 ADD PASS-COUNTER TO ERROR-HOLD. NC1034.2 +041900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1034.2 +042000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1034.2 +042100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1034.2 +042200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1034.2 +042300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1034.2 +042400 END-ROUTINE-12. NC1034.2 +042500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1034.2 +042600 IF ERROR-COUNTER IS EQUAL TO ZERO NC1034.2 +042700 MOVE "NO " TO ERROR-TOTAL NC1034.2 +042800 ELSE NC1034.2 +042900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1034.2 +043000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1034.2 +043100 PERFORM WRITE-LINE. NC1034.2 +043200 END-ROUTINE-13. NC1034.2 +043300 IF DELETE-COUNTER IS EQUAL TO ZERO NC1034.2 +043400 MOVE "NO " TO ERROR-TOTAL ELSE NC1034.2 +043500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1034.2 +043600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1034.2 +043700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +043800 IF INSPECT-COUNTER EQUAL TO ZERO NC1034.2 +043900 MOVE "NO " TO ERROR-TOTAL NC1034.2 +044000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1034.2 +044100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1034.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +044300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1034.2 +044400 WRITE-LINE. NC1034.2 +044500 ADD 1 TO RECORD-COUNT. NC1034.2 +044600 IF RECORD-COUNT GREATER 42 NC1034.2 +044700 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1034.2 +044800 MOVE SPACE TO DUMMY-RECORD NC1034.2 +044900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1034.2 +045000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1034.2 +045100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1034.2 +045200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1034.2 +045300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1034.2 +045400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1034.2 +045500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1034.2 +045600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1034.2 +045700 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1034.2 +045800 MOVE ZERO TO RECORD-COUNT. NC1034.2 +045900 PERFORM WRT-LN. NC1034.2 +046000 WRT-LN. NC1034.2 +046100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1034.2 +046200 MOVE SPACE TO DUMMY-RECORD. NC1034.2 +046300 BLANK-LINE-PRINT. NC1034.2 +046400 PERFORM WRT-LN. NC1034.2 +046500 FAIL-ROUTINE. NC1034.2 +046600 IF COMPUTED-X NOT EQUAL TO SPACE NC1034.2 +046700 GO TO FAIL-ROUTINE-WRITE. NC1034.2 +046800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1034.2 +046900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1034.2 +047000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1034.2 +047100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +047200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1034.2 +047300 GO TO FAIL-ROUTINE-EX. NC1034.2 +047400 FAIL-ROUTINE-WRITE. NC1034.2 +047500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1034.2 +047600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1034.2 +047700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1034.2 +047800 MOVE SPACES TO COR-ANSI-REFERENCE. NC1034.2 +047900 FAIL-ROUTINE-EX. EXIT. NC1034.2 +048000 BAIL-OUT. NC1034.2 +048100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1034.2 +048200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1034.2 +048300 BAIL-OUT-WRITE. NC1034.2 +048400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1034.2 +048500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1034.2 +048600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1034.2 +048700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1034.2 +048800 BAIL-OUT-EX. EXIT. NC1034.2 +048900 CCVS1-EXIT. NC1034.2 +049000 EXIT. NC1034.2 +049100 SECT-NC103A-001 SECTION. NC1034.2 +049200 NC-03-001. NC1034.2 +049300 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC1034.2 +049400 PERFORM PRINT-DETAIL. NC1034.2 +049500 MOVE "COMPARE NUMERIC, ALPHA- " TO RE-MARK. NC1034.2 +049600 PERFORM PRINT-DETAIL. NC1034.2 +049700 MOVE "NUMERIC, ALPHABETIC, AND " TO RE-MARK. NC1034.2 +049800 PERFORM PRINT-DETAIL. NC1034.2 +049900 MOVE "GROUP ITEMS IN VARYING " TO RE-MARK. NC1034.2 +050000 PERFORM PRINT-DETAIL. NC1034.2 +050100 MOVE "COMBINATIONS. " TO RE-MARK. NC1034.2 +050200 PERFORM PRINT-DETAIL. NC1034.2 +050300 MOVE SPACE TO TEST-RESULTS. NC1034.2 +050400 IF--INIT-GF-1. NC1034.2 +050500 MOVE "COMPARE--EQUAL" TO FEATURE. NC1034.2 +050600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +050700 MOVE 0 TO IF-D1. NC1034.2 +050800 IF--TEST-GF-1. NC1034.2 +050900 IF ZERO IS EQUAL TO IF-D1 NC1034.2 +051000 PERFORM PASS NC1034.2 +051100 ELSE NC1034.2 +051200 PERFORM FAIL. NC1034.2 +051300 GO TO IF--WRITE-GF-1. NC1034.2 +051400 IF--DELETE-GF-1. NC1034.2 +051500 PERFORM DE-LETE. NC1034.2 +051600 IF--WRITE-GF-1. NC1034.2 +051700 MOVE "IF--TEST-GF-1 " TO PAR-NAME. NC1034.2 +051800 PERFORM PRINT-DETAIL. NC1034.2 +051900 IF--INIT-GF-2. NC1034.2 +052000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +052100 MOVE ZERO TO IF-D2. NC1034.2 +052200 IF--TEST-GF-2. NC1034.2 +052300 IF ZERO IS EQUAL TO IF-D2 NC1034.2 +052400 PERFORM PASS NC1034.2 +052500 ELSE NC1034.2 +052600 PERFORM FAIL. NC1034.2 +052700 GO TO IF--WRITE-GF-2. NC1034.2 +052800 IF--DELETE-GF-2. NC1034.2 +052900 PERFORM DE-LETE. NC1034.2 +053000 IF--WRITE-GF-2. NC1034.2 +053100 MOVE "IF--TEST-GF-2 " TO PAR-NAME. NC1034.2 +053200 PERFORM PRINT-DETAIL. NC1034.2 +053300 IF--INIT-GF-3. NC1034.2 +053400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +053500 MOVE "123" TO IF-D9. NC1034.2 +053600 IF--TEST-GF-3. NC1034.2 +053700 IF IF-D9 EQUAL TO 123 NC1034.2 +053800 PERFORM PASS NC1034.2 +053900 ELSE NC1034.2 +054000 PERFORM FAIL. NC1034.2 +054100 GO TO IF--WRITE-GF-3. NC1034.2 +054200 IF--DELETE-GF-3. NC1034.2 +054300 PERFORM DE-LETE. NC1034.2 +054400 IF--WRITE-GF-3. NC1034.2 +054500 MOVE "IF--TEST-GF-3 " TO PAR-NAME. NC1034.2 +054600 PERFORM PRINT-DETAIL. NC1034.2 +054700 IF--INIT-GF-4. NC1034.2 +054800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +054900 MOVE "012345678912" TO IF-D10. NC1034.2 +055000 IF--TEST-GF-4. NC1034.2 +055100 IF IF-D10 EQUAL TO 012345678912 NC1034.2 +055200 PERFORM PASS NC1034.2 +055300 ELSE NC1034.2 +055400 PERFORM FAIL. NC1034.2 +055500 GO TO IF--WRITE-GF-4. NC1034.2 +055600 IF--DELETE-GF-4. NC1034.2 +055700 PERFORM DE-LETE. NC1034.2 +055800 IF--WRITE-GF-4. NC1034.2 +055900 MOVE "IF--TEST-GF-4 " TO PAR-NAME. NC1034.2 +056000 PERFORM PRINT-DETAIL. NC1034.2 +056100 IF--INIT-GF-5. NC1034.2 +056200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +056300 MOVE "ABCDEF" TO IF-D11. NC1034.2 +056400 IF--TEST-GF-5. NC1034.2 +056500 IF IF-D11 EQUAL TO "ABCDEF" NC1034.2 +056600 PERFORM PASS NC1034.2 +056700 ELSE NC1034.2 +056800 PERFORM FAIL. NC1034.2 +056900 GO TO IF--WRITE-GF-5. NC1034.2 +057000 IF--DELETE-GF-5. NC1034.2 +057100 PERFORM DE-LETE. NC1034.2 +057200 IF--WRITE-GF-5. NC1034.2 +057300 MOVE "IF--TEST-GF-5 " TO PAR-NAME. NC1034.2 +057400 PERFORM PRINT-DETAIL. NC1034.2 +057500 IF--INIT-GF-6. NC1034.2 +057600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +057700 MOVE "ABCDEF" TO IF-D12. NC1034.2 +057800 IF--TEST-GF-6. NC1034.2 +057900 IF IF-D12 EQUAL TO "ABCDEF" NC1034.2 +058000 PERFORM PASS NC1034.2 +058100 ELSE NC1034.2 +058200 PERFORM FAIL. NC1034.2 +058300 GO TO IF--WRITE-GF-6. NC1034.2 +058400 IF--DELETE-GF-6. NC1034.2 +058500 PERFORM DE-LETE. NC1034.2 +058600 IF--WRITE-GF-6. NC1034.2 +058700 MOVE "IF--TEST-GF-6 " TO PAR-NAME. NC1034.2 +058800 PERFORM PRINT-DETAIL. NC1034.2 +058900 IF--INIT-GF-7. NC1034.2 +059000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +059100 MOVE +123.45 TO IF-D7. NC1034.2 +059200 IF--TEST-GF-7. NC1034.2 +059300 IF IF-D7 EQUAL TO +123.45 NC1034.2 +059400 PERFORM PASS NC1034.2 +059500 ELSE NC1034.2 +059600 PERFORM FAIL. NC1034.2 +059700 GO TO IF--WRITE-GF-7. NC1034.2 +059800 IF--DELETE-GF-7. NC1034.2 +059900 PERFORM DE-LETE. NC1034.2 +060000 IF--WRITE-GF-7. NC1034.2 +060100 MOVE "IF--TEST-GF-7 " TO PAR-NAME. NC1034.2 +060200 PERFORM PRINT-DETAIL. NC1034.2 +060300 IF--INIT-GF-8. NC1034.2 +060400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +060500 MOVE 12300 TO IF-D8. NC1034.2 +060600 IF--TEST-GF-8. NC1034.2 +060700 IF IF-D8 EQUAL TO 12300 NC1034.2 +060800 PERFORM PASS NC1034.2 +060900 ELSE NC1034.2 +061000 PERFORM FAIL. NC1034.2 +061100 GO TO IF--WRITE-GF-8. NC1034.2 +061200 IF--DELETE-GF-8. NC1034.2 +061300 PERFORM DE-LETE. NC1034.2 +061400 IF--WRITE-GF-8. NC1034.2 +061500 MOVE "IF--TEST-GF-8 " TO PAR-NAME. NC1034.2 +061600 PERFORM PRINT-DETAIL. NC1034.2 +061700 IF--INIT-GF-9. NC1034.2 +061800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +061900 MOVE 12300 TO IF-D8. NC1034.2 +062000 MOVE 12300 TO IF-D13. NC1034.2 +062100 IF--TEST-GF-9. NC1034.2 +062200 IF IF-D13 EQUAL TO IF-D8 NC1034.2 +062300 PERFORM PASS NC1034.2 +062400 ELSE NC1034.2 +062500 PERFORM FAIL. NC1034.2 +062600 GO TO IF--WRITE-GF-9. NC1034.2 +062700 IF--DELETE-GF-9. NC1034.2 +062800 PERFORM DE-LETE. NC1034.2 +062900 IF--WRITE-GF-9. NC1034.2 +063000 MOVE "IF--TEST-GF-9 " TO PAR-NAME. NC1034.2 +063100 PERFORM PRINT-DETAIL. NC1034.2 +063200 IF--INIT-GF-10. NC1034.2 +063300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +063400 MOVE .0012 TO IF-D16. NC1034.2 +063500 MOVE .0012 TO IF-D17. NC1034.2 +063600 IF--TEST-GF-10. NC1034.2 +063700 IF IF-D16 EQUAL TO IF-D17 NC1034.2 +063800 PERFORM PASS NC1034.2 +063900 ELSE NC1034.2 +064000 PERFORM FAIL. NC1034.2 +064100 GO TO IF--WRITE-GF-10. NC1034.2 +064200 IF--DELETE-GF-10. NC1034.2 +064300 PERFORM DE-LETE. NC1034.2 +064400 IF--WRITE-GF-10. NC1034.2 +064500 MOVE "IF--TEST-GF-10" TO PAR-NAME. NC1034.2 +064600 PERFORM PRINT-DETAIL. NC1034.2 +064700 IF--INIT-GF-11. NC1034.2 +064800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +064900 MOVE 2137.45 TO IF-D27. NC1034.2 +065000 MOVE 2137.45 TO IF-D28. NC1034.2 +065100 IF--TEST-GF-11. NC1034.2 +065200 IF IF-D27 EQUAL TO IF-D28 NC1034.2 +065300 PERFORM PASS ELSE PERFORM FAIL. NC1034.2 +065400 GO TO IF-WRITE-GF-11. NC1034.2 +065500 IF-DELETE-GF-11. NC1034.2 +065600 PERFORM DE-LETE. NC1034.2 +065700 IF-WRITE-GF-11. NC1034.2 +065800 MOVE "IF--TEST-GF-11" TO PAR-NAME. NC1034.2 +065900 PERFORM PRINT-DETAIL. NC1034.2 +066000 IF--INIT-GF-12. NC1034.2 +066100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +066200 MOVE +123.45 TO IF-D14. NC1034.2 +066300 MOVE +123.45 TO IF-D7. NC1034.2 +066400 IF--TEST-GF-12. NC1034.2 +066500 IF IF-D14 EQUAL TO IF-D7 NC1034.2 +066600 PERFORM PASS NC1034.2 +066700 ELSE NC1034.2 +066800 PERFORM FAIL. NC1034.2 +066900 GO TO IF--WRITE-GF-12. NC1034.2 +067000 IF--DELETE-GF-12. NC1034.2 +067100 PERFORM DE-LETE. NC1034.2 +067200 IF--WRITE-GF-12. NC1034.2 +067300 MOVE "IF--TEST-GF-12" TO PAR-NAME. NC1034.2 +067400 PERFORM PRINT-DETAIL. NC1034.2 +067500 IF--INIT-GF-13. NC1034.2 +067600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +067700 MOVE 12300 TO IF-D15. NC1034.2 +067800 MOVE 12300 TO IF-D8. NC1034.2 +067900 IF--TEST-GF-13. NC1034.2 +068000 IF IF-D15 EQUAL TO IF-D8 NC1034.2 +068100 PERFORM PASS NC1034.2 +068200 ELSE NC1034.2 +068300 PERFORM FAIL. NC1034.2 +068400 GO TO IF--WRITE-GF-13. NC1034.2 +068500 IF--DELETE-GF-13. NC1034.2 +068600 PERFORM DE-LETE. NC1034.2 +068700 IF--WRITE-GF-13. NC1034.2 +068800 MOVE "IF--TEST-GF-13" TO PAR-NAME. NC1034.2 +068900 PERFORM PRINT-DETAIL. NC1034.2 +069000 IF--INIT-GF-14. NC1034.2 +069100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +069200 MOVE 0000012345 TO IF-D20. NC1034.2 +069300 MOVE 0000012345 TO IF-D21. NC1034.2 +069400 IF--TEST-GF-14. NC1034.2 +069500 IF IF-D20 EQUAL TO IF-D21 NC1034.2 +069600 PERFORM PASS NC1034.2 +069700 ELSE NC1034.2 +069800 PERFORM FAIL. NC1034.2 +069900 GO TO IF--WRITE-GF-14. NC1034.2 +070000 IF--DELETE-GF-14. NC1034.2 +070100 PERFORM DE-LETE. NC1034.2 +070200 IF--WRITE-GF-14. NC1034.2 +070300 MOVE "IF--TEST-GF-14" TO PAR-NAME. NC1034.2 +070400 PERFORM PRINT-DETAIL. NC1034.2 +070500 IF--INIT-GF-15. NC1034.2 +070600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +070700 MOVE "$1,2 3.40+" TO IF-D24. NC1034.2 +070800 MOVE +123.4 TO IF-D23. NC1034.2 +070900 IF--TEST-GF-15. NC1034.2 +071000 IF IF-D23 EQUAL TO IF-D24 NC1034.2 +071100 PERFORM PASS NC1034.2 +071200 ELSE NC1034.2 +071300 PERFORM FAIL. NC1034.2 +071400 GO TO IF--WRITE-GF-15. NC1034.2 +071500 IF--DELETE-GF-15. NC1034.2 +071600 PERFORM DE-LETE. NC1034.2 +071700 IF--WRITE-GF-15. NC1034.2 +071800 MOVE "IF--TEST-GF-15" TO PAR-NAME. NC1034.2 +071900 PERFORM PRINT-DETAIL. NC1034.2 +072000 IF--INIT-GF-16. NC1034.2 +072100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +072200 MOVE "A C D0E" TO IF-D26. NC1034.2 +072300 MOVE "ACDE" TO IF-D25. NC1034.2 +072400 IF--TEST-GF-16. NC1034.2 +072500 IF IF-D25 EQUAL TO IF-D26 NC1034.2 +072600 PERFORM PASS NC1034.2 +072700 ELSE NC1034.2 +072800 PERFORM FAIL. NC1034.2 +072900 GO TO IF--WRITE-GF-16. NC1034.2 +073000 IF--DELETE-GF-16. NC1034.2 +073100 PERFORM DE-LETE. NC1034.2 +073200 IF--WRITE-GF-16. NC1034.2 +073300 MOVE "IF--TEST-GF-16" TO PAR-NAME. NC1034.2 +073400 PERFORM PRINT-DETAIL. NC1034.2 +073500 IF--INIT-GF-17. NC1034.2 +073600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +073700 MOVE "BABABABABA" TO IF-D6. NC1034.2 +073800 MOVE "BABABABABA" TO IF-D18. NC1034.2 +073900 IF--TEST-GF-17. NC1034.2 +074000 IF IF-D6 EQUAL TO IF-D18 NC1034.2 +074100 PERFORM PASS NC1034.2 +074200 ELSE NC1034.2 +074300 PERFORM FAIL. NC1034.2 +074400 GO TO IF--WRITE-GF-17. NC1034.2 +074500 IF--DELETE-GF-17. NC1034.2 +074600 PERFORM DE-LETE. NC1034.2 +074700 IF--WRITE-GF-17. NC1034.2 +074800 MOVE "IF--TEST-GF-17" TO PAR-NAME. NC1034.2 +074900 PERFORM PRINT-DETAIL. NC1034.2 +075000 IF--INIT-GF-18. NC1034.2 +075100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +075200 MOVE "ABCDEF" TO IF-D22. NC1034.2 +075300 MOVE "ABCDEF" TO IF-D12. NC1034.2 +075400 IF--TEST-GF-18. NC1034.2 +075500 IF IF-D22 EQUAL TO IF-D12 NC1034.2 +075600 PERFORM PASS NC1034.2 +075700 ELSE NC1034.2 +075800 PERFORM FAIL. NC1034.2 +075900 GO TO IF--WRITE-GF-18. NC1034.2 +076000 IF--DELETE-GF-18. NC1034.2 +076100 PERFORM DE-LETE. NC1034.2 +076200 IF--WRITE-GF-18. NC1034.2 +076300 MOVE "IF--TEST-GF-18" TO PAR-NAME. NC1034.2 +076400 PERFORM PRINT-DETAIL. NC1034.2 +076500 IF--INIT-GF-19. NC1034.2 +076600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +076700 MOVE "ABCDEF " TO IF-D39. NC1034.2 +076800 MOVE "ABCDEF " TO IF-D19. NC1034.2 +076900 IF--TEST-GF-19. NC1034.2 +077000 IF IF-D39 EQUAL TO IF-D19 NC1034.2 +077100 PERFORM PASS NC1034.2 +077200 ELSE NC1034.2 +077300 PERFORM FAIL. NC1034.2 +077400 GO TO IF--WRITE-GF-19. NC1034.2 +077500 IF--DELETE-GF-19. NC1034.2 +077600 PERFORM DE-LETE. NC1034.2 +077700 IF--WRITE-GF-19. NC1034.2 +077800 MOVE "IF--TEST-GF-19" TO PAR-NAME. NC1034.2 +077900 PERFORM PRINT-DETAIL. NC1034.2 +078000 IF--INIT-GF-20. NC1034.2 +078100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +078200 MOVE "COMPARE--GREATER" TO FEATURE. NC1034.2 +078300 MOVE 0 TO IF-D1. NC1034.2 +078400 IF--TEST-GF-20. NC1034.2 +078500 IF IF-D1 IS GREATER THAN ZERO NC1034.2 +078600 PERFORM FAIL NC1034.2 +078700 ELSE NC1034.2 +078800 PERFORM PASS. NC1034.2 +078900 GO TO IF--WRITE-GF-20. NC1034.2 +079000 IF--DELETE-GF-20. NC1034.2 +079100 PERFORM DE-LETE. NC1034.2 +079200 IF--WRITE-GF-20. NC1034.2 +079300 MOVE "IF--TEST-GF-20" TO PAR-NAME. NC1034.2 +079400 PERFORM PRINT-DETAIL. NC1034.2 +079500 IF--INIT-GF-21. NC1034.2 +079600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +079700 MOVE "123" TO IF-D9. NC1034.2 +079800 IF--TEST-GF-21. NC1034.2 +079900 IF IF-D9 GREATER THAN 123 NC1034.2 +080000 PERFORM FAIL NC1034.2 +080100 ELSE NC1034.2 +080200 PERFORM PASS. NC1034.2 +080300 GO TO IF--WRITE-GF-21. NC1034.2 +080400 IF--DELETE-GF-21. NC1034.2 +080500 PERFORM DE-LETE. NC1034.2 +080600 IF--WRITE-GF-21. NC1034.2 +080700 MOVE "IF--TEST-GF-21" TO PAR-NAME. NC1034.2 +080800 PERFORM PRINT-DETAIL. NC1034.2 +080900 IF--INIT-GF-22. NC1034.2 +081000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +081100 MOVE "012345678912" TO IF-D10. NC1034.2 +081200 IF--TEST-GF-22. NC1034.2 +081300 IF IF-D10 GREATER THAN 012345678912 NC1034.2 +081400 PERFORM FAIL NC1034.2 +081500 ELSE NC1034.2 +081600 PERFORM PASS. NC1034.2 +081700 GO TO IF--WRITE-GF-22. NC1034.2 +081800 IF--DELETE-GF-22. NC1034.2 +081900 PERFORM DE-LETE. NC1034.2 +082000 IF--WRITE-GF-22. NC1034.2 +082100 MOVE "IF--TEST-GF-22" TO PAR-NAME. NC1034.2 +082200 PERFORM PRINT-DETAIL. NC1034.2 +082300 IF--INIT-GF-23. NC1034.2 +082400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +082500 MOVE "ABCDEF" TO IF-D10. NC1034.2 +082600 IF--TEST-GF-23. NC1034.2 +082700 IF IF-D11 GREATER THAN "ABCDEF" NC1034.2 +082800 PERFORM FAIL NC1034.2 +082900 ELSE NC1034.2 +083000 PERFORM PASS. NC1034.2 +083100 GO TO IF--WRITE-GF-23. NC1034.2 +083200 IF--DELETE-GF-23. NC1034.2 +083300 PERFORM DE-LETE. NC1034.2 +083400 IF--WRITE-GF-23. NC1034.2 +083500 MOVE "IF--TEST-GF-23" TO PAR-NAME. NC1034.2 +083600 PERFORM PRINT-DETAIL. NC1034.2 +083700 IF--INIT-GF-24. NC1034.2 +083800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +083900 MOVE "ABCDEF" TO IF-D12. NC1034.2 +084000 IF--TEST-GF-24. NC1034.2 +084100 IF IF-D12 GREATER THAN "ABCDEF" NC1034.2 +084200 PERFORM FAIL NC1034.2 +084300 ELSE NC1034.2 +084400 PERFORM PASS. NC1034.2 +084500 GO TO IF--WRITE-GF-24. NC1034.2 +084600 IF--DELETE-GF-24. NC1034.2 +084700 PERFORM DE-LETE. NC1034.2 +084800 IF--WRITE-GF-24. NC1034.2 +084900 MOVE "IF--TEST-GF-24" TO PAR-NAME. NC1034.2 +085000 PERFORM PRINT-DETAIL. NC1034.2 +085100 IF--INIT-GF-25. NC1034.2 +085200 MOVE +123.45 TO IF-D7. NC1034.2 +085300 IF--TEST-GF-25. NC1034.2 +085400 IF IF-D7 GREATER THAN +123.45 NC1034.2 +085500 PERFORM FAIL NC1034.2 +085600 ELSE NC1034.2 +085700 PERFORM PASS. NC1034.2 +085800 GO TO IF--WRITE-GF-25. NC1034.2 +085900 IF--DELETE-GF-25. NC1034.2 +086000 PERFORM DE-LETE. NC1034.2 +086100 IF--WRITE-GF-25. NC1034.2 +086200 MOVE "IF--TEST-GF-25" TO PAR-NAME. NC1034.2 +086300 PERFORM PRINT-DETAIL. NC1034.2 +086400 IF--INIT-GF-26. NC1034.2 +086500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +086600 MOVE 12300 TO IF-D8. NC1034.2 +086700 IF--TEST-GF-26. NC1034.2 +086800 IF IF-D8 GREATER THAN 12300 NC1034.2 +086900 PERFORM FAIL NC1034.2 +087000 ELSE NC1034.2 +087100 PERFORM PASS. NC1034.2 +087200 GO TO IF--WRITE-GF-26. NC1034.2 +087300 IF--DELETE-GF-26. NC1034.2 +087400 PERFORM DE-LETE. NC1034.2 +087500 IF--WRITE-GF-26. NC1034.2 +087600 MOVE "IF--TEST-GF-26" TO PAR-NAME. NC1034.2 +087700 PERFORM PRINT-DETAIL. NC1034.2 +087800 IF--INIT-GF-27. NC1034.2 +087900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +088000 MOVE 12300 TO IF-D8. NC1034.2 +088100 MOVE 12300 TO IF-D13. NC1034.2 +088200 IF--TEST-GF-27. NC1034.2 +088300 IF IF-D13 GREATER THAN IF-D8 NC1034.2 +088400 PERFORM FAIL NC1034.2 +088500 ELSE NC1034.2 +088600 PERFORM PASS. NC1034.2 +088700 GO TO IF--WRITE-GF-27. NC1034.2 +088800 IF--DELETE-GF-27. NC1034.2 +088900 PERFORM DE-LETE. NC1034.2 +089000 IF--WRITE-GF-27. NC1034.2 +089100 MOVE "IF--TEST-GF-27" TO PAR-NAME. NC1034.2 +089200 PERFORM PRINT-DETAIL. NC1034.2 +089300 IF--INIT-GF-28. NC1034.2 +089400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +089500 MOVE .0012 TO IF-D16. NC1034.2 +089600 MOVE .0012 TO IF-D17. NC1034.2 +089700 IF--TEST-GF-28. NC1034.2 +089800 IF IF-D16 GREATER THAN IF-D17 NC1034.2 +089900 PERFORM FAIL NC1034.2 +090000 ELSE NC1034.2 +090100 PERFORM PASS. NC1034.2 +090200 GO TO IF--WRITE-GF-28. NC1034.2 +090300 IF--DELETE-GF-28. NC1034.2 +090400 PERFORM DE-LETE. NC1034.2 +090500 IF--WRITE-GF-28. NC1034.2 +090600 MOVE "IF--TEST-GF-28" TO PAR-NAME. NC1034.2 +090700 PERFORM PRINT-DETAIL. NC1034.2 +090800 IF--INIT-GF-29. NC1034.2 +090900 MOVE 2137.45 TO IF-D27. NC1034.2 +091000 MOVE 2137.45 TO IF-D28. NC1034.2 +091100 IF--TEST-GF-29. NC1034.2 +091200 IF IF-D27 GREATER THAN IF-D28 NC1034.2 +091300 PERFORM FAIL NC1034.2 +091400 ELSE NC1034.2 +091500 PERFORM PASS. NC1034.2 +091600 GO TO IF-WRITE-GF-29. NC1034.2 +091700 IF-DELETE-GF-29. NC1034.2 +091800 PERFORM DE-LETE. NC1034.2 +091900 IF-WRITE-GF-29. NC1034.2 +092000 MOVE "IF--TEST-GF-29" TO PAR-NAME. NC1034.2 +092100 PERFORM PRINT-DETAIL. NC1034.2 +092200 IF--INIT-GF-30. NC1034.2 +092300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +092400 MOVE +123.45 TO IF-D7. NC1034.2 +092500 MOVE +123.45 TO IF-D14. NC1034.2 +092600 IF--TEST-GF-30. NC1034.2 +092700 IF IF-D14 GREATER THAN IF-D7 NC1034.2 +092800 PERFORM FAIL NC1034.2 +092900 ELSE NC1034.2 +093000 PERFORM PASS. NC1034.2 +093100 GO TO IF--WRITE-GF-30. NC1034.2 +093200 IF--DELETE-GF-30. NC1034.2 +093300 PERFORM DE-LETE. NC1034.2 +093400 IF--WRITE-GF-30. NC1034.2 +093500 MOVE "IF--TEST-GF-30" TO PAR-NAME. NC1034.2 +093600 PERFORM PRINT-DETAIL. NC1034.2 +093700 IF--INIT-GF-31. NC1034.2 +093800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +093900 MOVE 12300 TO IF-D8. NC1034.2 +094000 MOVE 12300 TO IF-D15. NC1034.2 +094100 IF--TEST-GF-31. NC1034.2 +094200 IF IF-D15 GREATER THAN IF-D8 NC1034.2 +094300 PERFORM FAIL NC1034.2 +094400 ELSE NC1034.2 +094500 PERFORM PASS. NC1034.2 +094600 GO TO IF--WRITE-GF-31. NC1034.2 +094700 IF--DELETE-GF-31. NC1034.2 +094800 PERFORM DE-LETE. NC1034.2 +094900 IF--WRITE-GF-31. NC1034.2 +095000 MOVE "IF--TEST-GF-31" TO PAR-NAME. NC1034.2 +095100 PERFORM PRINT-DETAIL. NC1034.2 +095200 IF--INIT-GF-32. NC1034.2 +095300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +095400 MOVE 0000012345 TO IF-D20. NC1034.2 +095500 MOVE 0000012345 TO IF-D21. NC1034.2 +095600 IF--TEST-GF-32. NC1034.2 +095700 IF IF-D20 GREATER THAN IF-D21 NC1034.2 +095800 PERFORM FAIL NC1034.2 +095900 ELSE NC1034.2 +096000 PERFORM PASS. NC1034.2 +096100 GO TO IF--WRITE-GF-32. NC1034.2 +096200 IF--DELETE-GF-32. NC1034.2 +096300 PERFORM DE-LETE. NC1034.2 +096400 IF--WRITE-GF-32. NC1034.2 +096500 MOVE "IF--TEST-GF-32" TO PAR-NAME. NC1034.2 +096600 PERFORM PRINT-DETAIL. NC1034.2 +096700 IF--INIT-GF-33. NC1034.2 +096800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +096900 MOVE "A C D0E" TO IF-D26. NC1034.2 +097000 MOVE "ABCD" TO IF-D25. NC1034.2 +097100 IF--TEST-GF-33. NC1034.2 +097200 IF IF-D26 GREATER THAN IF-D25 NC1034.2 +097300 PERFORM PASS NC1034.2 +097400 ELSE NC1034.2 +097500 PERFORM FAIL. NC1034.2 +097600 GO TO IF--WRITE-GF-33. NC1034.2 +097700 IF--DELETE-GF-33. NC1034.2 +097800 PERFORM DE-LETE. NC1034.2 +097900 IF--WRITE-GF-33. NC1034.2 +098000 MOVE "IF--TEST-GF-33" TO PAR-NAME. NC1034.2 +098100 PERFORM PRINT-DETAIL. NC1034.2 +098200 IF--INIT-GF-34. NC1034.2 +098300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +098400 MOVE "A C D0E" TO IF-D26. NC1034.2 +098500 MOVE "ABCD" TO IF-D25. NC1034.2 +098600 IF--TEST-GF-34. NC1034.2 +098700 IF IF-D25 GREATER THAN IF-D26 NC1034.2 +098800 PERFORM FAIL NC1034.2 +098900 ELSE NC1034.2 +099000 PERFORM PASS. NC1034.2 +099100 GO TO IF--WRITE-GF-34. NC1034.2 +099200 IF--DELETE-GF-34. NC1034.2 +099300 PERFORM DE-LETE. NC1034.2 +099400 IF--WRITE-GF-34. NC1034.2 +099500 MOVE "IF--TEST-GF-34" TO PAR-NAME. NC1034.2 +099600 PERFORM PRINT-DETAIL. NC1034.2 +099700 IF--INIT-GF-35. NC1034.2 +099800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +099900 MOVE "BABABABABA" TO IF-D6. NC1034.2 +100000 MOVE "BABABABABA" TO IF-D18. NC1034.2 +100100 IF--TEST-GF-35. NC1034.2 +100200 IF IF-D6 GREATER THAN IF-D18 NC1034.2 +100300 PERFORM FAIL NC1034.2 +100400 ELSE NC1034.2 +100500 PERFORM PASS. NC1034.2 +100600 GO TO IF--WRITE-GF-35. NC1034.2 +100700 IF--DELETE-GF-35. NC1034.2 +100800 PERFORM DE-LETE. NC1034.2 +100900 IF--WRITE-GF-35. NC1034.2 +101000 MOVE "IF--TEST-GF-35" TO PAR-NAME. NC1034.2 +101100 PERFORM PRINT-DETAIL. NC1034.2 +101200 IF--INIT-GF-36. NC1034.2 +101300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +101400 MOVE "ABCDEF" TO IF-D12. NC1034.2 +101500 MOVE "ABCDEF" TO IF-D22. NC1034.2 +101600 IF--TEST-GF-36. NC1034.2 +101700 IF IF-D22 GREATER THAN IF-D12 NC1034.2 +101800 PERFORM FAIL NC1034.2 +101900 ELSE NC1034.2 +102000 PERFORM PASS. NC1034.2 +102100 GO TO IF--WRITE-GF-36. NC1034.2 +102200 IF--DELETE-GF-36. NC1034.2 +102300 PERFORM DE-LETE. NC1034.2 +102400 IF--WRITE-GF-36. NC1034.2 +102500 MOVE "IF--TEST-GF-36" TO PAR-NAME. NC1034.2 +102600 PERFORM PRINT-DETAIL. NC1034.2 +102700 IF--INIT-GF-37. NC1034.2 +102800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +102900 MOVE "COMPARE--LESS THAN" TO FEATURE. NC1034.2 +103000 MOVE +123.45 TO IF-D7. NC1034.2 +103100 IF--TEST-GF-37. NC1034.2 +103200 IF IF-D7 IS LESS THAN 123.45 NC1034.2 +103300 PERFORM FAIL NC1034.2 +103400 ELSE NC1034.2 +103500 PERFORM PASS. NC1034.2 +103600 GO TO IF--WRITE-GF-37. NC1034.2 +103700 IF--DELETE-GF-37. NC1034.2 +103800 PERFORM DE-LETE. NC1034.2 +103900 IF--WRITE-GF-37. NC1034.2 +104000 MOVE "IF--TEST-GF-37" TO PAR-NAME. NC1034.2 +104100 PERFORM PRINT-DETAIL. NC1034.2 +104200 IF--INIT-GF-38. NC1034.2 +104300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +104400 MOVE "ABCDEF" TO IF-D11. NC1034.2 +104500 IF--TEST-GF-38. NC1034.2 +104600 IF IF-D11 LESS THAN "ABCDEF" NC1034.2 +104700 PERFORM FAIL NC1034.2 +104800 ELSE NC1034.2 +104900 PERFORM PASS. NC1034.2 +105000 GO TO IF--WRITE-GF-38. NC1034.2 +105100 IF--DELETE-GF-38. NC1034.2 +105200 PERFORM DE-LETE. NC1034.2 +105300 IF--WRITE-GF-38. NC1034.2 +105400 MOVE "IF--TEST-GF-38" TO PAR-NAME. NC1034.2 +105500 PERFORM PRINT-DETAIL. NC1034.2 +105600 IF--INIT-GF-39. NC1034.2 +105700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +105800 MOVE "BABABABABA" TO IF-D6. NC1034.2 +105900 MOVE "BABABABABA" TO IF-D18. NC1034.2 +106000 IF--TEST-GF-39. NC1034.2 +106100 IF IF-D6 LESS THAN IF-D18 NC1034.2 +106200 PERFORM FAIL NC1034.2 +106300 ELSE NC1034.2 +106400 PERFORM PASS. NC1034.2 +106500 GO TO IF--WRITE-GF-39. NC1034.2 +106600 IF--DELETE-GF-39. NC1034.2 +106700 PERFORM DE-LETE. NC1034.2 +106800 IF--WRITE-GF-39. NC1034.2 +106900 MOVE "IF--TEST-GF-39" TO PAR-NAME. NC1034.2 +107000 PERFORM PRINT-DETAIL. NC1034.2 +107100 IF--INIT-GF-40. NC1034.2 +107200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +107300 MOVE 0000012345 TO IF-D20. NC1034.2 +107400 MOVE 0000012345 TO IF-D21. NC1034.2 +107500 IF--TEST-GF-40. NC1034.2 +107600 IF IF-D20 LESS THAN IF-D21 NC1034.2 +107700 PERFORM FAIL NC1034.2 +107800 ELSE NC1034.2 +107900 PERFORM PASS. NC1034.2 +108000 GO TO IF--WRITE-GF-40. NC1034.2 +108100 IF--DELETE-GF-40. NC1034.2 +108200 PERFORM DE-LETE. NC1034.2 +108300 IF--WRITE-GF-40. NC1034.2 +108400 MOVE "IF--TEST-GF-40" TO PAR-NAME. NC1034.2 +108500 PERFORM PRINT-DETAIL. NC1034.2 +108600 IF--INIT-D. NC1034.2 +108700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +108800 MOVE "COMPARE--NOT EQUAL" TO FEATURE. NC1034.2 +108900 MOVE +123.45 TO IF-D7. NC1034.2 +109000 IF--TEST-GF-41. NC1034.2 +109100 IF IF-D7 IS NOT EQUAL TO 23.45 NC1034.2 +109200 PERFORM PASS NC1034.2 +109300 ELSE NC1034.2 +109400 PERFORM FAIL. NC1034.2 +109500 GO TO IF--WRITE-GF-41. NC1034.2 +109600 IF--DELETE-GF-41. NC1034.2 +109700 PERFORM DE-LETE. NC1034.2 +109800 IF--WRITE-GF-41. NC1034.2 +109900 MOVE "IF--TEST-GF-41" TO PAR-NAME. NC1034.2 +110000 PERFORM PRINT-DETAIL. NC1034.2 +110100 IF--INIT-GF-42. NC1034.2 +110200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +110300 MOVE "ABCDEF" TO IF-D11. NC1034.2 +110400 IF--TEST-GF-42. NC1034.2 +110500 IF IF-D11 NOT EQUAL TO "ABCDE " NC1034.2 +110600 PERFORM PASS NC1034.2 +110700 ELSE NC1034.2 +110800 PERFORM FAIL. NC1034.2 +110900 GO TO IF--WRITE-GF-42. NC1034.2 +111000 IF--DELETE-GF-42. NC1034.2 +111100 PERFORM DE-LETE. NC1034.2 +111200 IF--WRITE-GF-42. NC1034.2 +111300 MOVE "IF--TEST-GF-42" TO PAR-NAME. NC1034.2 +111400 PERFORM PRINT-DETAIL. NC1034.2 +111500 IF--INIT-GF-43. NC1034.2 +111600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +111700 MOVE "BABABABABA" TO IF-D6. NC1034.2 +111800 MOVE "BABABABABA" TO IF-D18. NC1034.2 +111900 IF--TEST-GF-43. NC1034.2 +112000 IF IF-D6 NOT EQUAL TO IF-D18 NC1034.2 +112100 PERFORM FAIL NC1034.2 +112200 ELSE NC1034.2 +112300 PERFORM PASS. NC1034.2 +112400 GO TO IF--WRITE-GF-43. NC1034.2 +112500 IF--DELETE-GF-43. NC1034.2 +112600 PERFORM DE-LETE. NC1034.2 +112700 IF--WRITE-GF-43. NC1034.2 +112800 MOVE "IF--TEST-GF-43" TO PAR-NAME. NC1034.2 +112900 PERFORM PRINT-DETAIL. NC1034.2 +113000 IF--INIT-GF-44. NC1034.2 +113100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +113200 MOVE 0000012345 TO IF-D20. NC1034.2 +113300 MOVE 0000012345 TO IF-D21. NC1034.2 +113400 IF--TEST-GF-44. NC1034.2 +113500 IF IF-D20 NOT EQUAL TO IF-D21 NC1034.2 +113600 PERFORM FAIL NC1034.2 +113700 ELSE NC1034.2 +113800 PERFORM PASS. NC1034.2 +113900 GO TO IF--WRITE-GF-44. NC1034.2 +114000 IF--DELETE-GF-44. NC1034.2 +114100 PERFORM DE-LETE. NC1034.2 +114200 IF--WRITE-GF-44. NC1034.2 +114300 MOVE "IF--TEST-GF-44" TO PAR-NAME. NC1034.2 +114400 PERFORM PRINT-DETAIL. NC1034.2 +114500 IF--INIT-GF-45. NC1034.2 +114600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +114700 MOVE "COMPARE--NOT LESS" TO FEATURE. NC1034.2 +114800 MOVE +123.45 TO IF-D7. NC1034.2 +114900 IF--TEST-GF-45. NC1034.2 +115000 IF IF-D7 IS NOT LESS THAN 123.45 NC1034.2 +115100 PERFORM PASS NC1034.2 +115200 ELSE NC1034.2 +115300 PERFORM FAIL. NC1034.2 +115400 GO TO IF--WRITE-GF-45. NC1034.2 +115500 IF--DELETE-GF-45. NC1034.2 +115600 PERFORM DE-LETE. NC1034.2 +115700 IF--WRITE-GF-45. NC1034.2 +115800 MOVE "IF--TEST-GF-45" TO PAR-NAME. NC1034.2 +115900 PERFORM PRINT-DETAIL. NC1034.2 +116000 IF--INIT-GF-46. NC1034.2 +116100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +116200 MOVE "ABCDEF" TO IF-D11. NC1034.2 +116300 IF--TEST-GF-46. NC1034.2 +116400 IF IF-D11 IS NOT LESS THAN "ABCDEF" NC1034.2 +116500 PERFORM PASS NC1034.2 +116600 ELSE NC1034.2 +116700 PERFORM FAIL. NC1034.2 +116800 GO TO IF--WRITE-GF-46. NC1034.2 +116900 IF--DELETE-GF-46. NC1034.2 +117000 PERFORM DE-LETE. NC1034.2 +117100 IF--WRITE-GF-46. NC1034.2 +117200 MOVE "IF--TEST-GF-46" TO PAR-NAME. NC1034.2 +117300 PERFORM PRINT-DETAIL. NC1034.2 +117400 IF--INIT-GF-47. NC1034.2 +117500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +117600 MOVE "BABABABABA" TO IF-D6. NC1034.2 +117700 MOVE "BABABABABA" TO IF-D18. NC1034.2 +117800 IF--TEST-GF-47. NC1034.2 +117900 IF IF-D6 IS NOT LESS THAN IF-D18 NC1034.2 +118000 PERFORM PASS NC1034.2 +118100 ELSE NC1034.2 +118200 PERFORM FAIL. NC1034.2 +118300 GO TO IF--WRITE-GF-47. NC1034.2 +118400 IF--DELETE-GF-47. NC1034.2 +118500 PERFORM DE-LETE. NC1034.2 +118600 IF--WRITE-GF-47. NC1034.2 +118700 MOVE "IF--TEST-GF-47" TO PAR-NAME. NC1034.2 +118800 PERFORM PRINT-DETAIL. NC1034.2 +118900 IF--INIT-GF-48. NC1034.2 +119000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +119100 MOVE 0000012345 TO IF-D20. NC1034.2 +119200 MOVE 0000012345 TO IF-D21. NC1034.2 +119300 IF--TEST-GF-48. NC1034.2 +119400 IF IF-D20 NOT LESS THAN IF-D21 NC1034.2 +119500 PERFORM PASS NC1034.2 +119600 ELSE NC1034.2 +119700 PERFORM FAIL. NC1034.2 +119800 GO TO IF--WRITE-GF-48. NC1034.2 +119900 IF--DELETE-GF-48. NC1034.2 +120000 PERFORM DE-LETE. NC1034.2 +120100 IF--WRITE-GF-48. NC1034.2 +120200 MOVE "IF--TEST-GF-48" TO PAR-NAME. NC1034.2 +120300 PERFORM PRINT-DETAIL. NC1034.2 +120400 IF--INIT-GF-49. NC1034.2 +120500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +120600 MOVE "COMPARE--NOT GREATER" TO FEATURE. NC1034.2 +120700 MOVE +123.45 TO IF-D7. NC1034.2 +120800 IF--TEST-GF-49. NC1034.2 +120900 IF IF-D7 NOT GREATER THAN 123.45 NC1034.2 +121000 PERFORM PASS NC1034.2 +121100 ELSE NC1034.2 +121200 PERFORM FAIL. NC1034.2 +121300 GO TO IF--WRITE-GF-49. NC1034.2 +121400 IF--DELETE-GF-49. NC1034.2 +121500 PERFORM DE-LETE. NC1034.2 +121600 IF--WRITE-GF-49. NC1034.2 +121700 MOVE "IF--TEST-GF-49" TO PAR-NAME. NC1034.2 +121800 PERFORM PRINT-DETAIL. NC1034.2 +121900 IF--INIT-GF-50. NC1034.2 +122000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +122100 MOVE "ABCDEF" TO IF-D11. NC1034.2 +122200 IF--TEST-GF-50. NC1034.2 +122300 IF IF-D11 IS NOT GREATER THAN "ABCD " NC1034.2 +122400 PERFORM FAIL NC1034.2 +122500 ELSE NC1034.2 +122600 PERFORM PASS. NC1034.2 +122700* THIS TEST ASSUMES THAT BLANK PRECEDES THE LETTERS OF NC1034.2 +122800* THE ALPHABET IN THE COLLATING SEQUENCE. NC1034.2 +122900 GO TO IF--WRITE-GF-50. NC1034.2 +123000 IF--DELETE-GF-50. NC1034.2 +123100 PERFORM DE-LETE. NC1034.2 +123200 IF--WRITE-GF-50. NC1034.2 +123300 MOVE "IF--TEST-GF-50" TO PAR-NAME. NC1034.2 +123400 PERFORM PRINT-DETAIL. NC1034.2 +123500 IF--INIT-GF-51. NC1034.2 +123600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +123700 MOVE "BABABABABA" TO IF-D6. NC1034.2 +123800 MOVE "BABABABABA" TO IF-D18. NC1034.2 +123900 IF--TEST-GF-51. NC1034.2 +124000 IF IF-D6 NOT GREATER THAN IF-D18 NC1034.2 +124100 PERFORM PASS NC1034.2 +124200 ELSE NC1034.2 +124300 PERFORM FAIL. NC1034.2 +124400 GO TO IF--WRITE-GF-51. NC1034.2 +124500 IF--DELETE-GF-51. NC1034.2 +124600 PERFORM DE-LETE. NC1034.2 +124700 IF--WRITE-GF-51. NC1034.2 +124800 MOVE "IF--TEST-GF-51" TO PAR-NAME. NC1034.2 +124900 PERFORM PRINT-DETAIL. NC1034.2 +125000 IF--INIT-GF-52. NC1034.2 +125100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +125200 MOVE "ABCDEF" TO IF-D11. NC1034.2 +125300 MOVE "ABCDEF" TO IF-D12. NC1034.2 +125400 IF--TEST-GF-52. NC1034.2 +125500 IF IF-D12 NOT GREATER THAN IF-D11 NC1034.2 +125600 PERFORM PASS NC1034.2 +125700 ELSE NC1034.2 +125800 PERFORM FAIL. NC1034.2 +125900 GO TO IF--WRITE-GF-52. NC1034.2 +126000 IF--DELETE-GF-52. NC1034.2 +126100 PERFORM DE-LETE. NC1034.2 +126200 IF--WRITE-GF-52. NC1034.2 +126300 MOVE "IF--TEST-GF-52" TO PAR-NAME. NC1034.2 +126400 PERFORM PRINT-DETAIL. NC1034.2 +126500 IF--INIT-GF-53. NC1034.2 +126600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +126700 MOVE "COMPARE--HIGH LOW " TO FEATURE. NC1034.2 +126800 MOVE LOW-VALUE TO LOW-VAL. NC1034.2 +126900 IF--TEST-GF-53. NC1034.2 +127000 IF HIGH-VALUE NOT GREATER THAN LOW-VAL NC1034.2 +127100 PERFORM FAIL NC1034.2 +127200 ELSE NC1034.2 +127300 PERFORM PASS. NC1034.2 +127400 GO TO IF--WRITE-GF-53. NC1034.2 +127500 IF--DELETE-GF-53. NC1034.2 +127600 PERFORM DE-LETE. NC1034.2 +127700 IF--WRITE-GF-53. NC1034.2 +127800 MOVE "IF--TEST-GF-53" TO PAR-NAME. NC1034.2 +127900 PERFORM PRINT-DETAIL. NC1034.2 +128000 IF--INIT-GF-54. NC1034.2 +128100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +128200 MOVE LOW-VALUE TO LOW-VAL. NC1034.2 +128300 IF--TEST-GF-54. NC1034.2 +128400 IF LOW-VAL LESS THAN HIGH-VALUE NC1034.2 +128500 PERFORM PASS NC1034.2 +128600 ELSE NC1034.2 +128700 PERFORM FAIL. NC1034.2 +128800 GO TO IF--WRITE-GF-54. NC1034.2 +128900 IF--DELETE-GF-54. NC1034.2 +129000 PERFORM DE-LETE. NC1034.2 +129100 IF--WRITE-GF-54. NC1034.2 +129200 MOVE "IF--TEST-GF-54" TO PAR-NAME. NC1034.2 +129300 PERFORM PRINT-DETAIL. NC1034.2 +129400 IF--INIT-GF-55. NC1034.2 +129500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +129600 MOVE LOW-VALUE TO LOW-VAL. NC1034.2 +129700 MOVE 1 TO ZERO-01. NC1034.2 +129800 IF--TEST-GF-55. NC1034.2 +129900 IF ZERO-01 GREATER THAN LOW-VALUE NC1034.2 +130000 PERFORM PASS NC1034.2 +130100 ELSE NC1034.2 +130200 PERFORM FAIL. NC1034.2 +130300 GO TO IF--WRITE-GF-55. NC1034.2 +130400 IF--DELETE-GF-55. NC1034.2 +130500 PERFORM DE-LETE. NC1034.2 +130600 IF--WRITE-GF-55. NC1034.2 +130700 MOVE "IF--TEST-GF-55" TO PAR-NAME. NC1034.2 +130800 PERFORM PRINT-DETAIL. NC1034.2 +130900 IF--INIT-GF-56. NC1034.2 +131000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +131100 MOVE "ABC" TO ABC. NC1034.2 +131200 IF--TEST-GF-56. NC1034.2 +131300 IF ABC GREATER THAN HIGH-VALUE NC1034.2 +131400 PERFORM FAIL NC1034.2 +131500 ELSE NC1034.2 +131600 PERFORM PASS. NC1034.2 +131700 GO TO IF--WRITE-GF-56. NC1034.2 +131800 IF--DELETE-GF-56. NC1034.2 +131900 PERFORM DE-LETE. NC1034.2 +132000 IF--WRITE-GF-56. NC1034.2 +132100 MOVE "IF--TEST-GF-56" TO PAR-NAME. NC1034.2 +132200 PERFORM PRINT-DETAIL. NC1034.2 +132300 IF--INIT-GF-57. NC1034.2 +132400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +132500 MOVE 999999999999999998 TO NINE-17-8. NC1034.2 +132600 IF--TEST-GF-57. NC1034.2 +132700 IF NINE-17-8 LESS THAN HIGH-VALUE NC1034.2 +132800 PERFORM PASS NC1034.2 +132900 ELSE NC1034.2 +133000 PERFORM FAIL. NC1034.2 +133100 GO TO IF--WRITE-GF-57. NC1034.2 +133200 IF--DELETE-GF-57. NC1034.2 +133300 PERFORM DE-LETE. NC1034.2 +133400 IF--WRITE-GF-57. NC1034.2 +133500 MOVE "IF--TEST-GF-57" TO PAR-NAME. NC1034.2 +133600 PERFORM PRINT-DETAIL. NC1034.2 +133700 IF--INIT-GF-58. NC1034.2 +133800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +133900 MOVE 0 TO ZERO-NULL. NC1034.2 +134000 IF--TEST-GF-58. NC1034.2 +134100 IF ZERO-NULL NOT EQUAL TO HIGH-VALUE NC1034.2 +134200 PERFORM PASS NC1034.2 +134300 ELSE NC1034.2 +134400 PERFORM FAIL. NC1034.2 +134500 GO TO IF--WRITE-GF-58. NC1034.2 +134600 IF--DELETE-GF-58. NC1034.2 +134700 PERFORM DE-LETE. NC1034.2 +134800 IF--WRITE-GF-58. NC1034.2 +134900 MOVE "IF--TEST-GF-58" TO PAR-NAME. NC1034.2 +135000 PERFORM PRINT-DETAIL. NC1034.2 +135100 IF--INIT-GF-59. NC1034.2 +135200 MOVE "ABC" TO ABC. NC1034.2 +135300 IF--TEST-GF-59. NC1034.2 +135400 IF ABC LESS THAN LOW-VALUE NC1034.2 +135500 PERFORM FAIL NC1034.2 +135600 GO TO IF--WRITE-GF-59. NC1034.2 +135700 PERFORM PASS. NC1034.2 +135800 GO TO IF--WRITE-GF-59. NC1034.2 +135900 IF--DELETE-GF-59. NC1034.2 +136000 PERFORM DE-LETE. NC1034.2 +136100 IF--WRITE-GF-59. NC1034.2 +136200 MOVE "IF--TEST-GF-59" TO PAR-NAME. NC1034.2 +136300 PERFORM PRINT-DETAIL. NC1034.2 +136400 IF--INIT-GF-60. NC1034.2 +136500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +136600 MOVE "COMPARE--EQUAL" TO FEATURE. NC1034.2 +136700 MOVE 0 TO IF-D32. NC1034.2 +136800 MOVE -0 TO IF-D33. NC1034.2 +136900 IF--TEST-GF-60. NC1034.2 +137000 IF IF-D32 EQUAL TO IF-D33 NC1034.2 +137100 PERFORM PASS NC1034.2 +137200 ELSE NC1034.2 +137300 PERFORM FAIL. NC1034.2 +137400 GO TO IF--WRITE-GF-60. NC1034.2 +137500 IF--DELETE-GF-60. NC1034.2 +137600 PERFORM DE-LETE. NC1034.2 +137700 IF--WRITE-GF-60. NC1034.2 +137800 MOVE "IF--TEST-GF-60" TO PAR-NAME. NC1034.2 +137900 PERFORM PRINT-DETAIL. NC1034.2 +138000 IF--INIT-GF-61. NC1034.2 +138100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +138200 MOVE 0 TO IF-D32. NC1034.2 +138300 MOVE +0 TO IF-D34. NC1034.2 +138400 IF--TEST-GF-61. NC1034.2 +138500 IF IF-D32 EQUAL TO IF-D34 NC1034.2 +138600 PERFORM PASS NC1034.2 +138700 ELSE NC1034.2 +138800 PERFORM FAIL. NC1034.2 +138900 GO TO IF--WRITE-GF-61. NC1034.2 +139000 IF--DELETE-GF-61. NC1034.2 +139100 PERFORM DE-LETE. NC1034.2 +139200 IF--WRITE-GF-61. NC1034.2 +139300 MOVE "IF--TEST-GF-61" TO PAR-NAME. NC1034.2 +139400 PERFORM PRINT-DETAIL. NC1034.2 +139500 IF--INIT-GF-62. NC1034.2 +139600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +139700 MOVE -0 TO IF-D33. NC1034.2 +139800 MOVE +0 TO IF-D34. NC1034.2 +139900 IF--TEST-GF-62. NC1034.2 +140000 IF IF-D33 EQUAL TO IF-D34 NC1034.2 +140100 PERFORM PASS NC1034.2 +140200 ELSE NC1034.2 +140300 PERFORM FAIL. NC1034.2 +140400 GO TO IF--WRITE-GF-62. NC1034.2 +140500 IF--DELETE-GF-62. NC1034.2 +140600 PERFORM DE-LETE. NC1034.2 +140700 IF--WRITE-GF-62. NC1034.2 +140800 MOVE "IF--TEST-GF-62" TO PAR-NAME. NC1034.2 +140900 PERFORM PRINT-DETAIL. NC1034.2 +141000 IF--INIT-GF-63. NC1034.2 +141100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +141200 MOVE ZERO TO AZERO-DS-05V05. NC1034.2 +141300 IF--TEST-GF-63. NC1034.2 +141400 IF AZERO-DS-05V05 EQUAL TO ZERO NC1034.2 +141500 PERFORM PASS NC1034.2 +141600 GO TO IF-WRITE-GF-63. NC1034.2 +141700 GO TO IF-FAIL-GF-63. NC1034.2 +141800 IF-DELETE-GF-63. NC1034.2 +141900 PERFORM DE-LETE. NC1034.2 +142000 GO TO IF-WRITE-GF-63. NC1034.2 +142100 IF-FAIL-GF-63. NC1034.2 +142200 MOVE 00000.00000 TO CORRECT-N. NC1034.2 +142300 MOVE AZERO-DS-05V05 TO COMPUTED-N. NC1034.2 +142400 PERFORM FAIL. NC1034.2 +142500 IF-WRITE-GF-63. NC1034.2 +142600 MOVE "IF--TEST-GF-63 " TO PAR-NAME. NC1034.2 +142700 PERFORM PRINT-DETAIL. NC1034.2 +142800 IF--INIT-GF-64. NC1034.2 +142900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +143000 MOVE SPACE TO CORRECT-A. NC1034.2 +143100 IF--TEST-GF-64. NC1034.2 +143200 IF SPACE EQUAL TO CORRECT-A NC1034.2 +143300 PERFORM PASS NC1034.2 +143400 GO TO IF-WRITE-GF-64. NC1034.2 +143500 GO TO IF-FAIL-GF-64. NC1034.2 +143600 IF-DELETE-GF-64. NC1034.2 +143700 PERFORM DE-LETE. NC1034.2 +143800 GO TO IF-WRITE-GF-64. NC1034.2 +143900 IF-FAIL-GF-64. NC1034.2 +144000 MOVE CORRECT-A TO COMPUTED-A. NC1034.2 +144100 MOVE SPACE TO CORRECT-A. NC1034.2 +144200 PERFORM FAIL. NC1034.2 +144300 IF-WRITE-GF-64. NC1034.2 +144400 MOVE "IF--TEST-GF-64 " TO PAR-NAME. NC1034.2 +144500 PERFORM PRINT-DETAIL. NC1034.2 +144600 IF--INIT-GF-65. NC1034.2 +144700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +144800 MOVE 111111111111111111 TO A18ONES-DS-18V00. NC1034.2 +144900 MOVE "111111111111111111" TO ONES-XN-00018. NC1034.2 +145000 IF--TEST-GF-65. NC1034.2 +145100 IF A18ONES-DS-18V00 EQUAL TO ONES-XN-00018 NC1034.2 +145200 PERFORM PASS NC1034.2 +145300 GO TO IF-WRITE-GF-65. NC1034.2 +145400 GO TO IF-FAIL-GF-65. NC1034.2 +145500 IF-DELETE-GF-65. NC1034.2 +145600 PERFORM DE-LETE. NC1034.2 +145700 GO TO IF-WRITE-GF-65. NC1034.2 +145800 IF-FAIL-GF-65. NC1034.2 +145900 MOVE ONES-XN-00018 TO CORRECT-A. NC1034.2 +146000 MOVE A18ONES-DS-18V00 TO COMPUTED-A. NC1034.2 +146100 MOVE "FIELDS DIDNT COMPARE EQUAL" TO RE-MARK NC1034.2 +146200 PERFORM FAIL. NC1034.2 +146300 IF-WRITE-GF-65. NC1034.2 +146400 MOVE "IF--TEST-GF-65 " TO PAR-NAME. NC1034.2 +146500 PERFORM PRINT-DETAIL. NC1034.2 +146600 IF--INIT-GF-66. NC1034.2 +146700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +146800 MOVE 22 TO TWOS-XN-00002. NC1034.2 +146900 MOVE 99 TO A99-DS-02V00. NC1034.2 +147000 IF--TEST-GF-66. NC1034.2 +147100 IF TWOS-XN-00002 IS EQUAL TO A99-DS-02V00 NC1034.2 +147200 MOVE TWOS-XN-00002 TO COMPUTED-A NC1034.2 +147300 MOVE A99-DS-02V00 TO CORRECT-A NC1034.2 +147400 PERFORM FAIL NC1034.2 +147500 GO TO IF-WRITE-GF-66. NC1034.2 +147600 PERFORM PASS. NC1034.2 +147700 GO TO IF-WRITE-GF-66. NC1034.2 +147800 IF-DELETE-GF-66. NC1034.2 +147900 PERFORM DE-LETE. NC1034.2 +148000 IF-WRITE-GF-66. NC1034.2 +148100 MOVE "IF--TEST-GF-66 " TO PAR-NAME. NC1034.2 +148200 PERFORM PRINT-DETAIL. NC1034.2 +148300 IF--INIT-GF-67. NC1034.2 +148400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +148500 MOVE "COMPARE--LESS THAN " TO FEATURE. NC1034.2 +148600 MOVE 111111111.111111111 TO A18ONES-DS-09V09. NC1034.2 +148700 MOVE 99 TO A99-DS-02V00. NC1034.2 +148800 IF--TEST-GF-67. NC1034.2 +148900 IF A99-DS-02V00 LESS THAN A18ONES-DS-09V09 NC1034.2 +149000 PERFORM PASS NC1034.2 +149100 GO TO IF-WRITE-GF-67 ELSE NC1034.2 +149200 GO TO IF-FAIL-GF-67. NC1034.2 +149300 IF-DELETE-GF-67. NC1034.2 +149400 PERFORM DE-LETE. NC1034.2 +149500 GO TO IF-WRITE-GF-67. NC1034.2 +149600 IF-FAIL-GF-67. NC1034.2 +149700 MOVE A99-DS-02V00 TO CORRECT-A. NC1034.2 +149800 MOVE A18ONES-DS-09V09 TO COMPUTED-N. NC1034.2 +149900 PERFORM FAIL. NC1034.2 +150000 IF-WRITE-GF-67. NC1034.2 +150100 MOVE "IF--TEST-GF-67 " TO PAR-NAME. NC1034.2 +150200 PERFORM PRINT-DETAIL. NC1034.2 +150300 IF--INIT-GF-68. NC1034.2 +150400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +150500 MOVE "11" TO ONES-XN-00002. NC1034.2 +150600 IF--TEST-GF-68. NC1034.2 +150700 IF "11" LESS THAN ONES-XN-00002 NC1034.2 +150800 MOVE "11" TO CORRECT-A NC1034.2 +150900 MOVE ONES-XN-00002 TO COMPUTED-A NC1034.2 +151000 PERFORM FAIL NC1034.2 +151100 GO TO IF-WRITE-GF-68 ELSE NC1034.2 +151200 PERFORM PASS NC1034.2 +151300 GO TO IF-WRITE-GF-68. NC1034.2 +151400 IF-DELETE-GF-68. NC1034.2 +151500 PERFORM DE-LETE. NC1034.2 +151600 IF-WRITE-GF-68. NC1034.2 +151700 MOVE "IF--TEST-GF-68 " TO PAR-NAME. NC1034.2 +151800 PERFORM PRINT-DETAIL. NC1034.2 +151900 IF--INIT-GF-69. NC1034.2 +152000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +152100 MOVE "11" TO ONES-XN-00002. NC1034.2 +152200 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +152300 IF--TEST-GF-69. NC1034.2 +152400 IF A02TWOS-DU-02V00 LESS THAN ONES-XN-00002 NC1034.2 +152500 MOVE ONES-XN-00002 TO CORRECT-A NC1034.2 +152600 MOVE A02TWOS-DU-02V00 TO COMPUTED-A NC1034.2 +152700 PERFORM FAIL NC1034.2 +152800 GO TO IF-WRITE-GF-69 ELSE NC1034.2 +152900 PERFORM PASS NC1034.2 +153000 GO TO IF-WRITE-GF-69. NC1034.2 +153100 IF-DELETE-GF-69. NC1034.2 +153200 PERFORM DE-LETE. NC1034.2 +153300 IF-WRITE-GF-69. NC1034.2 +153400 MOVE "IF--TEST-GF-69 " TO PAR-NAME. NC1034.2 +153500 PERFORM PRINT-DETAIL. NC1034.2 +153600 IF--INIT-GF-70. NC1034.2 +153700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +153800 MOVE "22" TO TWOS-XN-00002. NC1034.2 +153900 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +154000 IF--TEST-GF-70. NC1034.2 +154100 IF TWOS-XN-00002 LESS THAN A02TWOS-DU-02V00 NC1034.2 +154200 MOVE TWOS-XN-00002 TO CORRECT-A NC1034.2 +154300 MOVE A02TWOS-DU-02V00 TO COMPUTED-A NC1034.2 +154400 PERFORM FAIL NC1034.2 +154500 GO TO IF-WRITE-GF-70 ELSE NC1034.2 +154600 PERFORM PASS NC1034.2 +154700 GO TO IF-WRITE-GF-70. NC1034.2 +154800 IF-DELETE-GF-70. NC1034.2 +154900 PERFORM DE-LETE. NC1034.2 +155000 IF-WRITE-GF-70. NC1034.2 +155100 MOVE "IF--TEST-70 " TO PAR-NAME. NC1034.2 +155200 PERFORM PRINT-DETAIL. NC1034.2 +155300 IF--INIT-GF-71. NC1034.2 +155400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +155500 MOVE "COMPARE--GREATER " TO FEATURE. NC1034.2 +155600 MOVE 99 TO A99-DS-02V00. NC1034.2 +155700 IF--TEST-GF-71. NC1034.2 +155800 IF A99-DS-02V00 GREATER THAN 88.9 NEXT SENTENCE ELSE NC1034.2 +155900 MOVE A99-DS-02V00 TO CORRECT-A NC1034.2 +156000 MOVE "88.9" TO COMPUTED-A NC1034.2 +156100 PERFORM FAIL NC1034.2 +156200 GO TO IF-WRITE-GF-71. NC1034.2 +156300 PERFORM PASS. NC1034.2 +156400 GO TO IF-WRITE-GF-71. NC1034.2 +156500 IF-DELETE-GF-71. NC1034.2 +156600 PERFORM DE-LETE. NC1034.2 +156700 IF-WRITE-GF-71. NC1034.2 +156800 MOVE "IF--TEST-GF-71 " TO PAR-NAME. NC1034.2 +156900 PERFORM PRINT-DETAIL. NC1034.2 +157000 IF--INIT-GF-72. NC1034.2 +157100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +157200 MOVE "11" TO ONES-XN-00002. NC1034.2 +157300 MOVE "22" TO TWOS-XN-00002. NC1034.2 +157400 IF--TEST-GF-72. NC1034.2 +157500 IF ONES-XN-00002 GREATER THAN TWOS-XN-00002 NEXT SENTENCE NC1034.2 +157600 ELSE PERFORM PASS NC1034.2 +157700 GO TO IF-WRITE-GF-72. NC1034.2 +157800 MOVE ONES-XN-00002 TO COMPUTED-A. NC1034.2 +157900 MOVE TWOS-XN-00002 TO CORRECT-A. NC1034.2 +158000 PERFORM FAIL. NC1034.2 +158100 GO TO IF-WRITE-GF-72. NC1034.2 +158200 IF-DELETE-GF-72. NC1034.2 +158300 PERFORM DE-LETE. NC1034.2 +158400 IF-WRITE-GF-72. NC1034.2 +158500 MOVE "IF--TEST-GF-72 " TO PAR-NAME. NC1034.2 +158600 PERFORM PRINT-DETAIL. NC1034.2 +158700 IF--INIT-GF-73. NC1034.2 +158800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +158900 MOVE "11" TO ONES-XN-00002. NC1034.2 +159000 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +159100 IF--TEST-GF-73. NC1034.2 +159200 IF A02TWOS-DU-02V00 GREATER THAN ONES-XN-00002 NC1034.2 +159300 NEXT SENTENCE ELSE NC1034.2 +159400 MOVE A02TWOS-DU-02V00 TO CORRECT-A NC1034.2 +159500 MOVE ONES-XN-00002 TO COMPUTED-A NC1034.2 +159600 PERFORM FAIL NC1034.2 +159700 GO TO IF-WRITE-GF-73. NC1034.2 +159800 PERFORM PASS. NC1034.2 +159900 GO TO IF-WRITE-GF-73. NC1034.2 +160000 IF-DELETE-GF-73. NC1034.2 +160100 PERFORM DE-LETE. NC1034.2 +160200 IF-WRITE-GF-73. NC1034.2 +160300 MOVE "IF--TEST-GF-73 " TO PAR-NAME. NC1034.2 +160400 PERFORM PRINT-DETAIL. NC1034.2 +160500 IF--INIT-GF-74. NC1034.2 +160600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +160700 MOVE "22" TO TWOS-XN-00002. NC1034.2 +160800 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +160900 IF--TEST-GF-74. NC1034.2 +161000 IF TWOS-XN-00002 GREATER THAN A02TWOS-DU-02V00 NC1034.2 +161100 NEXT SENTENCE ELSE NC1034.2 +161200 PERFORM PASS NC1034.2 +161300 GO TO IF-WRITE-GF-74. NC1034.2 +161400 MOVE TWOS-XN-00002 TO CORRECT-A. NC1034.2 +161500 MOVE A02TWOS-DU-02V00 TO COMPUTED-A. NC1034.2 +161600 PERFORM FAIL. NC1034.2 +161700 GO TO IF-WRITE-GF-74. NC1034.2 +161800 IF-DELETE-GF-74. NC1034.2 +161900 PERFORM DE-LETE. NC1034.2 +162000 IF-WRITE-GF-74. NC1034.2 +162100 MOVE "IF--TEST-GF-74 " TO PAR-NAME. NC1034.2 +162200 PERFORM PRINT-DETAIL. NC1034.2 +162300 IF--INIT-GF-75. NC1034.2 +162400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +162500 MOVE "COMPARE--NOT EQUAL " TO FEATURE. NC1034.2 +162600 MOVE SPACE TO CORRECT-A. NC1034.2 +162700 IF--TEST-GF-75. NC1034.2 +162800 IF ZERO IS NOT EQUAL TO CORRECT-A NC1034.2 +162900 PERFORM PASS NC1034.2 +163000 GO TO IF-WRITE-GF-75. NC1034.2 +163100 MOVE ZERO TO COMPUTED-A. NC1034.2 +163200 PERFORM FAIL. NC1034.2 +163300 GO TO IF-WRITE-GF-75. NC1034.2 +163400 IF-DELETE-GF-75. NC1034.2 +163500 PERFORM DE-LETE. NC1034.2 +163600 IF-WRITE-GF-75. NC1034.2 +163700 MOVE "IF--TEST-75 " TO PAR-NAME. NC1034.2 +163800 PERFORM PRINT-DETAIL. NC1034.2 +163900 IF--INIT-GF-76. NC1034.2 +164000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +164100 MOVE +022.00 TO A02TWOS-DS-03V02. NC1034.2 +164200 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +164300 IF--TEST-GF-76. NC1034.2 +164400 IF A02TWOS-DU-02V00 NOT EQUAL TO A02TWOS-DS-03V02 NC1034.2 +164500 MOVE A02TWOS-DU-02V00 TO CORRECT-N NC1034.2 +164600 MOVE A02TWOS-DS-03V02 TO COMPUTED-N NC1034.2 +164700 PERFORM FAIL NC1034.2 +164800 GO TO IF-WRITE-GF-76 ELSE NEXT SENTENCE. NC1034.2 +164900 PERFORM PASS NC1034.2 +165000 GO TO IF-WRITE-GF-76. NC1034.2 +165100 IF-DELETE-GF-76. NC1034.2 +165200 PERFORM DE-LETE. NC1034.2 +165300 IF-WRITE-GF-76. NC1034.2 +165400 MOVE "IF--TEST-GF-76 " TO PAR-NAME. NC1034.2 +165500 PERFORM PRINT-DETAIL. NC1034.2 +165600 IF--INIT-GF-77. NC1034.2 +165700 MOVE "COMPARE--NOT LESS " TO FEATURE. NC1034.2 +165800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +165900 MOVE "22" TO TWOS-XN-00002. NC1034.2 +166000 MOVE "11" TO ONES-XN-00002. NC1034.2 +166100 IF--TEST-GF-77. NC1034.2 +166200 IF TWOS-XN-00002 NOT LESS THAN ONES-XN-00002 NC1034.2 +166300 PERFORM PASS NC1034.2 +166400 GO TO IF-WRITE-GF-77 ELSE NEXT SENTENCE. NC1034.2 +166500 MOVE TWOS-XN-00002 TO CORRECT-A. NC1034.2 +166600 MOVE ONES-XN-00002 TO COMPUTED-A. NC1034.2 +166700 PERFORM FAIL. NC1034.2 +166800 GO TO IF-WRITE-GF-77. NC1034.2 +166900 IF-DELETE-GF-77. NC1034.2 +167000 PERFORM DE-LETE. NC1034.2 +167100 IF-WRITE-GF-77. NC1034.2 +167200 MOVE "IF--TEST-GF-77 " TO PAR-NAME. NC1034.2 +167300 PERFORM PRINT-DETAIL. NC1034.2 +167400 IF--INIT-GF-78. NC1034.2 +167500 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +167600 MOVE .000000001 TO A01ONE-DS-P0801. NC1034.2 +167700 IF--TEST-GF-78. NC1034.2 +167800 IF 0.0000000001 IS NOT LESS THAN A01ONE-DS-P0801 NC1034.2 +167900 MOVE "0.0000000001" TO CORRECT-A NC1034.2 +168000 MOVE A01ONE-DS-P0801 TO COMPUTED-N NC1034.2 +168100 PERFORM FAIL NC1034.2 +168200 GO TO IF-WRITE-GF-78 ELSE NC1034.2 +168300 PERFORM PASS NC1034.2 +168400 GO TO IF-WRITE-GF-78. NC1034.2 +168500 IF-DELETE-GF-78. NC1034.2 +168600 PERFORM DE-LETE. NC1034.2 +168700 IF-WRITE-GF-78. NC1034.2 +168800 MOVE "IF--TEST-GF-78 " TO PAR-NAME. NC1034.2 +168900 PERFORM PRINT-DETAIL. NC1034.2 +169000 IF--INIT-GF-79. NC1034.2 +169100 MOVE "COMPARE--NOT GREATER" TO FEATURE. NC1034.2 +169200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +169300 MOVE "11" TO ONES-XN-00002. NC1034.2 +169400 MOVE "22" TO TWOS-XN-00002. NC1034.2 +169500 IF--TEST-GF-79. NC1034.2 +169600 IF ONES-XN-00002 NOT GREATER THAN TWOS-XN-00002 NC1034.2 +169700 PERFORM PASS NC1034.2 +169800 GO TO IF-WRITE-GF-79. NC1034.2 +169900 MOVE ONES-XN-00002 TO CORRECT-A. NC1034.2 +170000 MOVE TWOS-XN-00002 TO COMPUTED-A. NC1034.2 +170100 PERFORM FAIL. NC1034.2 +170200 GO TO IF-WRITE-GF-79. NC1034.2 +170300 IF-DELETE-GF-79. NC1034.2 +170400 PERFORM DE-LETE. NC1034.2 +170500 IF-WRITE-GF-79. NC1034.2 +170600 MOVE "IF--TEST-GF-79 " TO PAR-NAME. NC1034.2 +170700 PERFORM PRINT-DETAIL. NC1034.2 +170800 IF--INIT-GF-80. NC1034.2 +170900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +171000 MOVE +990 TO A990-DS-0201P. NC1034.2 +171100 MOVE 99 TO A99-DS-02V00. NC1034.2 +171200 IF--TEST-GF-80. NC1034.2 +171300 IF A990-DS-0201P NOT GREATER THAN A99-DS-02V00 NC1034.2 +171400 MOVE A990-DS-0201P TO COMPUTED-N NC1034.2 +171500 MOVE A99-DS-02V00 TO CORRECT-N NC1034.2 +171600 PERFORM FAIL NC1034.2 +171700 GO TO IF-WRITE-GF-80. NC1034.2 +171800 PERFORM PASS. NC1034.2 +171900 GO TO IF-WRITE-GF-80. NC1034.2 +172000 IF-DELETE-GF-80. NC1034.2 +172100 PERFORM DE-LETE. NC1034.2 +172200 IF-WRITE-GF-80. NC1034.2 +172300 MOVE "IF--TEST-GF-80 " TO PAR-NAME. NC1034.2 +172400 PERFORM PRINT-DETAIL. NC1034.2 +172500 IF--INIT-GF-81. NC1034.2 +172600 MOVE "COMPARE--GROUP VALUE" TO FEATURE. NC1034.2 +172700 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +172800 MOVE "*ASTERISK/SLASH" TO IF-D35. NC1034.2 +172900 IF--TEST-GF-81. NC1034.2 +173000 IF IF-D36A EQUAL TO "*ASTER" NC1034.2 +173100 PERFORM PASS GO TO IF--WRITE-GF-81. NC1034.2 +173200 GO TO IF--FAIL-GF-81. NC1034.2 +173300 IF--DELETE-GF-81. NC1034.2 +173400 PERFORM DE-LETE. NC1034.2 +173500 GO TO IF--WRITE-GF-81. NC1034.2 +173600 IF--FAIL-GF-81. NC1034.2 +173700 PERFORM FAIL. NC1034.2 +173800 MOVE IF-D36A TO COMPUTED-A. NC1034.2 +173900 MOVE "*ASTER" TO CORRECT-A. NC1034.2 +174000 IF--WRITE-GF-81. NC1034.2 +174100 MOVE "IF--TEST-GF-81" TO PAR-NAME. NC1034.2 +174200 PERFORM PRINT-DETAIL. NC1034.2 +174300 IF--INIT-GF-82. NC1034.2 +174400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +174500 MOVE "*ASTERISK/SLASH" TO IF-D35. NC1034.2 +174600 IF--TEST-GF-82. NC1034.2 +174700 IF IF-D36B EQUAL TO "ISK" NC1034.2 +174800 PERFORM PASS GO TO IF--WRITE-GF-82. NC1034.2 +174900 GO TO IF--FAIL-GF-82. NC1034.2 +175000 IF--DELETE-GF-82. NC1034.2 +175100 PERFORM DE-LETE. NC1034.2 +175200 GO TO IF--WRITE-GF-82. NC1034.2 +175300 IF--FAIL-GF-82. NC1034.2 +175400 PERFORM FAIL. NC1034.2 +175500 MOVE IF-D36B TO COMPUTED-A. NC1034.2 +175600 MOVE "ISK" TO CORRECT-A. NC1034.2 +175700 IF--WRITE-GF-82. NC1034.2 +175800 MOVE "IF--TEST-GF-82" TO PAR-NAME. NC1034.2 +175900 PERFORM PRINT-DETAIL. NC1034.2 +176000 IF--INIT-GF-83. NC1034.2 +176100 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +176200 MOVE "*ASTERISK/SLASH" TO IF-D35. NC1034.2 +176300 IF--TEST-GF-83. NC1034.2 +176400 IF IF-D36C EQUAL TO "/SLASH" NC1034.2 +176500 PERFORM PASS GO TO IF--WRITE-GF-83. NC1034.2 +176600 GO TO IF--FAIL-GF-83. NC1034.2 +176700 IF--DELETE-GF-83. NC1034.2 +176800 PERFORM DE-LETE. NC1034.2 +176900 GO TO IF--WRITE-GF-83. NC1034.2 +177000 IF--FAIL-GF-83. NC1034.2 +177100 PERFORM FAIL. NC1034.2 +177200 MOVE IF-D36C TO COMPUTED-A. NC1034.2 +177300 MOVE "/SLASH" TO CORRECT-A. NC1034.2 +177400 IF--WRITE-GF-83. NC1034.2 +177500 MOVE "IF--TEST-GF-83" TO PAR-NAME. NC1034.2 +177600 PERFORM PRINT-DETAIL. NC1034.2 +177700 IF--INIT-GF-84. NC1034.2 +177800 MOVE "COMPARE--EQUAL" TO FEATURE. NC1034.2 +177900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +178000 MOVE 0001234 TO IF-D37. NC1034.2 +178100 IF--TEST-GF-84. NC1034.2 +178200 IF IF-D37 EQUAL TO 01234 NC1034.2 +178300 PERFORM PASS GO TO IF--WRITE-GF-84. NC1034.2 +178400 GO TO IF--FAIL-GF-84. NC1034.2 +178500 IF--DELETE-GF-84. NC1034.2 +178600 PERFORM DE-LETE. NC1034.2 +178700 GO TO IF--WRITE-GF-84. NC1034.2 +178800 IF--FAIL-GF-84. NC1034.2 +178900 PERFORM FAIL. NC1034.2 +179000 MOVE IF-D37 TO COMPUTED-N. NC1034.2 +179100 MOVE 01234 TO CORRECT-N. NC1034.2 +179200 IF--WRITE-GF-84. NC1034.2 +179300 MOVE "IF--TEST-GF-84" TO PAR-NAME. NC1034.2 +179400 PERFORM PRINT-DETAIL. NC1034.2 +179500 IF--INIT-GF-85. NC1034.2 +179600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +179700 MOVE " BABBAGE" TO IF-D38. NC1034.2 +179800 IF--TEST-GF-85. NC1034.2 +179900 IF IF-D38 EQUAL TO " BABBAGE " NC1034.2 +180000 PERFORM PASS GO TO IF--WRITE-GF-85. NC1034.2 +180100 GO TO IF--FAIL-GF-85. NC1034.2 +180200 IF--DELETE-GF-85. NC1034.2 +180300 PERFORM DE-LETE. NC1034.2 +180400 GO TO IF--WRITE-GF-85. NC1034.2 +180500 IF--FAIL-GF-85. NC1034.2 +180600 PERFORM FAIL. NC1034.2 +180700 MOVE IF-D38 TO COMPUTED-A. NC1034.2 +180800 MOVE " BABBAGE " TO CORRECT-A. NC1034.2 +180900 IF--WRITE-GF-85. NC1034.2 +181000 MOVE "IF--TEST-GF-85" TO PAR-NAME. NC1034.2 +181100 PERFORM PRINT-DETAIL. NC1034.2 +181200 IF--INIT-GF-86. NC1034.2 +181300 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +181400 MOVE NC1034.2 +181500 "12345678" NC1034.2 +181600 TO NON-COBOL-CHARACTERS. NC1034.2 +181700 IF--TEST-GF-86. NC1034.2 +181800 IF NON-COBOL-CHARACTERS EQUAL TO NC1034.2 +181900 "12345678" NC1034.2 +182000 PERFORM PASS GO TO IF--WRITE-GF-86. NC1034.2 +182100 GO TO IF--FAIL-GF-86. NC1034.2 +182200 IF--DELETE-GF-86. NC1034.2 +182300 PERFORM DE-LETE. NC1034.2 +182400 GO TO IF--WRITE-GF-86. NC1034.2 +182500 IF--FAIL-GF-86. NC1034.2 +182600 PERFORM FAIL. NC1034.2 +182700 MOVE NON-COBOL-CHARACTERS TO COMPUTED-A. NC1034.2 +182800 MOVE NC1034.2 +182900 "12345678" NC1034.2 +183000 TO CORRECT-A. NC1034.2 +183100 IF--WRITE-GF-86. NC1034.2 +183200 MOVE "IF--TEST-GF-86" TO PAR-NAME. NC1034.2 +183300 MOVE "NON COBOL CHARACTERS" TO RE-MARK. NC1034.2 +183400 PERFORM PRINT-DETAIL. NC1034.2 +183500 IF--INIT-GF-87. NC1034.2 +183600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +183700 MOVE 100000 TO COMP-DATA2. NC1034.2 +183800 MOVE 100000 TO COMP-DATA9. NC1034.2 +183900 IF--TEST-GF-87. NC1034.2 +184000 IF COMP-DATA2 EQUAL TO COMP-DATA9 NC1034.2 +184100 PERFORM PASS NC1034.2 +184200 GO TO IF--WRITE-GF-87. NC1034.2 +184300 MOVE COMP-DATA2 TO COMPUTED-18V0. NC1034.2 +184400 MOVE COMP-DATA9 TO CORRECT-18V0. NC1034.2 +184500 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +184600 PERFORM FAIL. NC1034.2 +184700 GO TO IF--WRITE-GF-87. NC1034.2 +184800 IF--DELETE-GF-87. NC1034.2 +184900 PERFORM DE-LETE. NC1034.2 +185000 IF--WRITE-GF-87. NC1034.2 +185100 MOVE "IF--TEST-GF-87" TO PAR-NAME. NC1034.2 +185200 PERFORM PRINT-DETAIL. NC1034.2 +185300 IF--INIT-GF-88. NC1034.2 +185400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +185500 MOVE 300 TO COMP-DATA1. NC1034.2 +185600 MOVE 300.00 TO COMP-DATA7. NC1034.2 +185700 IF--TEST-GF-88. NC1034.2 +185800 IF COMP-DATA1 EQUAL TO COMP-DATA7 NC1034.2 +185900 PERFORM PASS NC1034.2 +186000 GO TO IF--WRITE-GF-88. NC1034.2 +186100 MOVE COMP-DATA1 TO COMPUTED-18V0. NC1034.2 +186200 MOVE COMP-DATA7 TO CORRECT-N. NC1034.2 +186300 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +186400 PERFORM FAIL. NC1034.2 +186500 GO TO IF--WRITE-GF-88. NC1034.2 +186600 IF--DELETE-GF-88. NC1034.2 +186700 PERFORM DE-LETE. NC1034.2 +186800 IF--WRITE-GF-88. NC1034.2 +186900 MOVE "IF--TEST-GF-88" TO PAR-NAME. NC1034.2 +187000 PERFORM PRINT-DETAIL. NC1034.2 +187100 IF--INIT-GF-89. NC1034.2 +187200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +187300 MOVE 300 TO COMP-DATA1. NC1034.2 +187400 MOVE 300 TO DISP-DATA1. NC1034.2 +187500 IF--TEST-GF-89. NC1034.2 +187600 IF COMP-DATA1 EQUAL TO DISP-DATA1 NC1034.2 +187700 PERFORM PASS NC1034.2 +187800 GO TO IF--WRITE-GF-89. NC1034.2 +187900 MOVE COMP-DATA1 TO COMPUTED-18V0. NC1034.2 +188000 MOVE DISP-DATA1 TO CORRECT-18V0. NC1034.2 +188100 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +188200 PERFORM FAIL. NC1034.2 +188300 GO TO IF--WRITE-GF-89. NC1034.2 +188400 IF--DELETE-GF-89. NC1034.2 +188500 PERFORM DE-LETE. NC1034.2 +188600 IF--WRITE-GF-89. NC1034.2 +188700 MOVE "IF--TEST-GF-89" TO PAR-NAME. NC1034.2 +188800 PERFORM PRINT-DETAIL. NC1034.2 +188900 IF--INIT-GF-90. NC1034.2 +189000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +189100 MOVE 100000 TO COMP-DATA1. NC1034.2 +189200 MOVE 100000 TO DISP-DATA1. NC1034.2 +189300 IF--TEST-GF-90. NC1034.2 +189400 IF COMP-DATA2 EQUAL TO DISP-DATA2 NC1034.2 +189500 PERFORM PASS NC1034.2 +189600 GO TO IF--WRITE-GF-90. NC1034.2 +189700 MOVE COMP-DATA2 TO COMPUTED-N. NC1034.2 +189800 MOVE DISP-DATA2 TO CORRECT-N. NC1034.2 +189900 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +190000 PERFORM FAIL. NC1034.2 +190100 GO TO IF--WRITE-GF-90. NC1034.2 +190200 IF--DELETE-GF-90. NC1034.2 +190300 PERFORM DE-LETE. NC1034.2 +190400 IF--WRITE-GF-90. NC1034.2 +190500 MOVE "IF--TEST-GF-90" TO PAR-NAME. NC1034.2 +190600 PERFORM PRINT-DETAIL. NC1034.2 +190700 IF--INIT-GF-91. NC1034.2 +190800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +190900 MOVE 9 TO COMP-DATA3. NC1034.2 +191000 MOVE 9 TO DISP-DATA3. NC1034.2 +191100 IF--TEST-GF-91. NC1034.2 +191200 IF COMP-DATA3 EQUAL TO DISP-DATA3 NC1034.2 +191300 PERFORM PASS NC1034.2 +191400 GO TO IF--WRITE-GF-91. NC1034.2 +191500 MOVE COMP-DATA3 TO COMPUTED-N. NC1034.2 +191600 MOVE DISP-DATA3 TO CORRECT-N. NC1034.2 +191700 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +191800 PERFORM FAIL. NC1034.2 +191900 GO TO IF--WRITE-GF-91. NC1034.2 +192000 IF--DELETE-GF-91. NC1034.2 +192100 PERFORM DE-LETE. NC1034.2 +192200 IF--WRITE-GF-91. NC1034.2 +192300 MOVE "IF--TEST-GF-91" TO PAR-NAME. NC1034.2 +192400 PERFORM PRINT-DETAIL. NC1034.2 +192500 IF--INIT-GF-92. NC1034.2 +192600 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +192700 MOVE 300.00 TO COMP-DATA7. NC1034.2 +192800 MOVE 300 TO DISP-DATA1. NC1034.2 +192900 IF--TEST-GF-92. NC1034.2 +193000 IF COMP-DATA7 EQUAL TO DISP-DATA1 NC1034.2 +193100 PERFORM PASS NC1034.2 +193200 GO TO IF--WRITE-GF-92. NC1034.2 +193300 MOVE COMP-DATA7 TO COMPUTED-N. NC1034.2 +193400 MOVE DISP-DATA1 TO CORRECT-N. NC1034.2 +193500 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +193600 PERFORM FAIL. NC1034.2 +193700 GO TO IF--WRITE-GF-92. NC1034.2 +193800 IF--DELETE-GF-92. NC1034.2 +193900 PERFORM DE-LETE. NC1034.2 +194000 IF--WRITE-GF-92. NC1034.2 +194100 MOVE "IF--TEST-GF-92" TO PAR-NAME. NC1034.2 +194200 PERFORM PRINT-DETAIL. NC1034.2 +194300 IF--INIT-GF-93. NC1034.2 +194400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +194500 MOVE 3.3 TO COMP-DATA4. NC1034.2 +194600 MOVE 3.3000000 TO COMP-DATA8. NC1034.2 +194700 IF--TEST-GF-93. NC1034.2 +194800 IF COMP-DATA4 EQUAL TO COMP-DATA8 NC1034.2 +194900 PERFORM PASS NC1034.2 +195000 GO TO IF--WRITE-GF-93. NC1034.2 +195100 MOVE COMP-DATA4 TO COMPUTED-N. NC1034.2 +195200 MOVE COMP-DATA8 TO CORRECT-N. NC1034.2 +195300 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +195400 PERFORM FAIL. NC1034.2 +195500 GO TO IF--WRITE-GF-93. NC1034.2 +195600 IF--DELETE-GF-93. NC1034.2 +195700 PERFORM DE-LETE. NC1034.2 +195800 IF--WRITE-GF-93. NC1034.2 +195900 MOVE "IF--TEST-GF-93" TO PAR-NAME. NC1034.2 +196000 PERFORM PRINT-DETAIL. NC1034.2 +196100 IF--INIT-GF-94. NC1034.2 +196200 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +196300 MOVE 300 TO COMP-DATA7. NC1034.2 +196400 MOVE 300 TO DISP-DATA1. NC1034.2 +196500 IF--TEST-GF-94. NC1034.2 +196600 IF COMP-DATA7 EQUAL TO DISP-DATA1 NC1034.2 +196700 PERFORM PASS NC1034.2 +196800 GO TO IF--WRITE-GF-94. NC1034.2 +196900 MOVE COMP-DATA7 TO COMPUTED-N. NC1034.2 +197000 MOVE DISP-DATA1 TO CORRECT-N. NC1034.2 +197100 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +197200 PERFORM FAIL. NC1034.2 +197300 GO TO IF--WRITE-GF-94. NC1034.2 +197400 IF--DELETE-GF-94. NC1034.2 +197500 PERFORM DE-LETE. NC1034.2 +197600 IF--WRITE-GF-94. NC1034.2 +197700 MOVE "IF--TEST-GF-94" TO PAR-NAME. NC1034.2 +197800 PERFORM PRINT-DETAIL. NC1034.2 +197900 IF--INIT-GF-95. NC1034.2 +198000 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +198100 MOVE 3.3000000 TO COMP-DATA8. NC1034.2 +198200 MOVE 3.3 TO DISP-DATA4. NC1034.2 +198300 IF--TEST-GF-95. NC1034.2 +198400 IF DISP-DATA4 EQUAL TO COMP-DATA8 NC1034.2 +198500 PERFORM PASS NC1034.2 +198600 GO TO IF--WRITE-GF-95. NC1034.2 +198700 MOVE DISP-DATA4 TO COMPUTED-N. NC1034.2 +198800 MOVE COMP-DATA8 TO CORRECT-N. NC1034.2 +198900 MOVE "ENTRIES DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +199000 PERFORM FAIL. NC1034.2 +199100 GO TO IF--WRITE-GF-95. NC1034.2 +199200 IF--DELETE-GF-95. NC1034.2 +199300 PERFORM DE-LETE. NC1034.2 +199400 IF--WRITE-GF-95. NC1034.2 +199500 MOVE "IF--TEST-GF-95" TO PAR-NAME. NC1034.2 +199600 PERFORM PRINT-DETAIL. NC1034.2 +199700 MOVE "COMPARE GROUP-LEVEL " TO FEATURE. NC1034.2 +199800 IF--INIT-GF-96. NC1034.2 +199900 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +200000 MOVE ZEROS TO GROUP-1000-1. NC1034.2 +200100 MOVE QUOTES TO XNAME. NC1034.2 +200200 MOVE SPACES TO GROUP-1000-2. NC1034.2 +200300 MOVE "." TO GROUP-1000-3. NC1034.2 +200400 MOVE ZEROS TO GROUP-X500-A. NC1034.2 +200500 MOVE QUOTES TO GROUP-X500-1-1. NC1034.2 +200600 MOVE QUOTES TO GROUP-X500-1-2. NC1034.2 +200700 MOVE SPACES TO GROUP-X500-1-3. NC1034.2 +200800 MOVE " ." TO GROUP-X500-1-4. NC1034.2 +200900 IF--TEST-GF-96. NC1034.2 +201000 IF GROUP-X1000 EQUAL TO GROUP-X500-2 NC1034.2 +201100 PERFORM PASS NC1034.2 +201200 GO TO IF--WRITE-GF-96. NC1034.2 +201300 MOVE "GROUP LEVEL X(1000) " TO COMPUTED-A. NC1034.2 +201400 MOVE "GROUP LEVEL X(1000) " TO CORRECT-A. NC1034.2 +201500 MOVE "FIELDS DIDNT COMPARE EQUAL" TO RE-MARK. NC1034.2 +201600 PERFORM FAIL. NC1034.2 +201700 GO TO IF--WRITE-GF-96. NC1034.2 +201800 IF--DELETE-GF-96. NC1034.2 +201900 PERFORM DE-LETE. NC1034.2 +202000 IF--WRITE-GF-96. NC1034.2 +202100 MOVE "IF--TEST-GF-96" TO PAR-NAME. NC1034.2 +202200 PERFORM PRINT-DETAIL. NC1034.2 +202300 IF--INIT-GF-97. NC1034.2 +202400 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +202500 MOVE 22 TO A02TWOS-DU-02V00. NC1034.2 +202600 MOVE ZERO TO VAL. NC1034.2 +202700 IF--TEST-GF-97. NC1034.2 +202800 IF A02TWOS-DU-02V00 LESS THAN "AA" NC1034.2 +202900 ADD 1 TO VAL. NC1034.2 +203000 IF A02TWOS-DU-02V00 GREATER THAN "AA" NC1034.2 +203100 ADD 1 TO VAL. NC1034.2 +203200 IF VAL EQUAL TO 1 NC1034.2 +203300 PERFORM PASS NC1034.2 +203400 GO TO IF--WRITE-GF-97. NC1034.2 +203500 PERFORM FAIL. NC1034.2 +203600 MOVE VAL TO COMPUTED-N. NC1034.2 +203700 MOVE 1 TO CORRECT-N. NC1034.2 +203800 GO TO IF--WRITE-GF-97. NC1034.2 +203900 IF--DELETE-GF-97. NC1034.2 +204000 PERFORM DE-LETE. NC1034.2 +204100 IF--WRITE-GF-97. NC1034.2 +204200 MOVE "COMPARE NUM VS ALPH" TO FEATURE. NC1034.2 +204300 MOVE "IF--TEST-GF-97" TO PAR-NAME. NC1034.2 +204400 PERFORM PRINT-DETAIL. NC1034.2 +204500* NC1034.2 +204600* NC1034.2 +204700 IF--INIT-GF-98. NC1034.2 +204800 MOVE "V1-89 6.15.4 GR2" TO ANSI-REFERENCE. NC1034.2 +204900 MOVE -123456789012345678 TO WRK-DS-18V0-1. NC1034.2 +205000 MOVE "123456789012345678" TO WRK-XN-18-2. NC1034.2 +205100 IF-TEST-GF-98. NC1034.2 +205200 IF WRK-DS-18V0-1 EQUAL WRK-XN-18-2 PERFORM PASS NC1034.2 +205300 ELSE PERFORM FAIL. NC1034.2 +205400 GO TO IF-WRITE-GF-98. NC1034.2 +205500 IF-DELETE-GF-98. NC1034.2 +205600 PERFORM DE-LETE. NC1034.2 +205700 IF-WRITE-GF-98. NC1034.2 +205800 MOVE "IF-TEST-GF-98" TO PAR-NAME. NC1034.2 +205900 MOVE "EQUAL - NO TO" TO FEATURE. NC1034.2 +206000 MOVE "PSEUDO-MOVE TO STRIP MINUS SIGN" TO RE-MARK. NC1034.2 +206100 PERFORM PRINT-DETAIL. NC1034.2 +206200* NC1034.2 +206300* NC1034.2 +206400 IF--INIT-GF-99. NC1034.2 +206500* ==--> OPTIONAL WORD "THEN" <--== NC1034.2 +206600 MOVE "COMPARE--EQUAL" TO FEATURE. NC1034.2 +206700 MOVE "V1-89 6.15.2 " TO ANSI-REFERENCE. NC1034.2 +206800 MOVE 0 TO IF-D1. NC1034.2 +206900 IF--TEST-GF-99. NC1034.2 +207000 IF ZERO IS EQUAL TO IF-D1 NC1034.2 +207100 THEN PERFORM PASS NC1034.2 +207200 ELSE NC1034.2 +207300 PERFORM FAIL. NC1034.2 +207400 GO TO IF--WRITE-GF-99. NC1034.2 +207500 IF--DELETE-GF-99. NC1034.2 +207600 PERFORM DE-LETE. NC1034.2 +207700 IF--WRITE-GF-99. NC1034.2 +207800 MOVE "IF--TEST-GF-99" TO PAR-NAME. NC1034.2 +207900 PERFORM PRINT-DETAIL. NC1034.2 +208000* NC1034.2 +208100* NC1034.2 +208200 IF--INIT-GF-100. NC1034.2 +208300* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1034.2 +208400 MOVE "V1-89 6.4.3 " TO ANSI-REFERENCE. NC1034.2 +208500 MOVE ZERO TO WRK-DU-02V00. NC1034.2 +208600 MOVE ZERO TO IF-D2. NC1034.2 +208700 IF--TEST-GF-100-1. NC1034.2 +208800 IF ZERO IS EQUAL TO IF-D2 NC1034.2 +208900 PERFORM PASS NC1034.2 +209000 ELSE NC1034.2 +209100 PERFORM FAIL NC1034.2 +209200 END-IF NC1034.2 +209300 MOVE 99 TO WRK-DU-02V00. NC1034.2 +209400 GO TO IF--WRITE-GF-100-1. NC1034.2 +209500 IF--DELETE-GF-100-1. NC1034.2 +209600 PERFORM DE-LETE. NC1034.2 +209700 IF--WRITE-GF-100-1. NC1034.2 +209800 MOVE "IF--TEST-GF-100-1" TO PAR-NAME. NC1034.2 +209900 PERFORM PRINT-DETAIL. NC1034.2 +210000 IF--TEST-GF-100-2. NC1034.2 +210100 IF WRK-DU-02V00 = 99 NC1034.2 +210200 PERFORM PASS NC1034.2 +210300 ELSE NC1034.2 +210400 MOVE 99 TO CORRECT-N NC1034.2 +210500 MOVE WRK-DU-02V00 TO COMPUTED-N NC1034.2 +210600 PERFORM FAIL. NC1034.2 +210700 GO TO IF--WRITE-GF-100-2. NC1034.2 +210800 IF--DELETE-GF-100-2. NC1034.2 +210900 PERFORM DE-LETE. NC1034.2 +211000 IF--WRITE-GF-100-2. NC1034.2 +211100 MOVE "IF--TEST-GF-100-2" TO PAR-NAME. NC1034.2 +211200 PERFORM PRINT-DETAIL. NC1034.2 +211300* NC1034.2 +211400* NC1034.2 +211500 IF--INIT-GF-101. NC1034.2 +211600 MOVE " BABBAGE" TO IF-D38. NC1034.2 +211700 IF--TEST-GF-101. NC1034.2 +211800* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1034.2 +211900 MOVE "V1-89 6.4.3 " TO ANSI-REFERENCE. NC1034.2 +212000 IF IF-D38 EQUAL TO " BABBAGE " NC1034.2 +212100 PERFORM PASS NC1034.2 +212200 GO TO IF--WRITE-GF-101 NC1034.2 +212300 END-IF NC1034.2 +212400 GO TO IF--FAIL-GF-101. NC1034.2 +212500 IF--DELETE-GF-101. NC1034.2 +212600 PERFORM DE-LETE. NC1034.2 +212700 GO TO IF--WRITE-GF-101. NC1034.2 +212800 IF--FAIL-GF-101. NC1034.2 +212900 PERFORM FAIL. NC1034.2 +213000 MOVE IF-D38 TO COMPUTED-A. NC1034.2 +213100 MOVE " BABBAGE " TO CORRECT-A. NC1034.2 +213200 IF--WRITE-GF-101. NC1034.2 +213300 MOVE "IF--TEST-GF-101" TO PAR-NAME. NC1034.2 +213400 PERFORM PRINT-DETAIL. NC1034.2 +213500* NC1034.2 +213600* NC1034.2 +213700 CCVS-EXIT SECTION. NC1034.2 +213800 CCVS-999999. NC1034.2 +213900 GO TO CLOSE-FILES. NC1034.2 diff --git a/tests/cobol85/NC/NC104A.CBL b/tests/cobol85/NC/NC104A.CBL new file mode 100755 index 00000000..62c308be --- /dev/null +++ b/tests/cobol85/NC/NC104A.CBL @@ -0,0 +1,2851 @@ +000100 IDENTIFICATION DIVISION. NC1044.2 +000200 PROGRAM-ID. NC1044.2 +000300 NC104A. NC1044.2 +000400**************************************************************** NC1044.2 +000500* * NC1044.2 +000600* VALIDATION FOR:- * NC1044.2 +000700* * NC1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1044.2 +000900* * NC1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1044.2 +001100* * NC1044.2 +001200**************************************************************** NC1044.2 +001300* * NC1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1044.2 +001500* * NC1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1044.2 +001900* * NC1044.2 +002000**************************************************************** NC1044.2 +002100* NC1044.2 +002200* PROGRAM NC104A TESTS FORMAT 1 OF THE MOVE STATEMENT NC1044.2 +002300* WITH VARIOUS COMBINATIONS OF SENDING AND RECEIVING FIELDS. NC1044.2 +002400* NC1044.2 +002500* (SEE ALSO NC105A). NC1044.2 +002600* NC1044.2 +002700 NC1044.2 +002800 ENVIRONMENT DIVISION. NC1044.2 +002900 CONFIGURATION SECTION. NC1044.2 +003000 SOURCE-COMPUTER. NC1044.2 +003100 Linux. NC1044.2 +003200 OBJECT-COMPUTER. NC1044.2 +003300 Linux. NC1044.2 +003400 INPUT-OUTPUT SECTION. NC1044.2 +003500 FILE-CONTROL. NC1044.2 +003600 SELECT PRINT-FILE ASSIGN TO NC1044.2 +003700 "report.log". NC1044.2 +003800 DATA DIVISION. NC1044.2 +003900 FILE SECTION. NC1044.2 +004000 FD PRINT-FILE NC1044.2 +004100 LABEL RECORDS NC1044.2 +004200 OMITTED NC1044.2 +004300 DATA RECORD IS PRINT-REC DUMMY-RECORD. NC1044.2 +004400 01 PRINT-REC PICTURE X(120). NC1044.2 +004500 01 DUMMY-RECORD PICTURE X(120). NC1044.2 +004600 WORKING-STORAGE SECTION. NC1044.2 +004700 01 MOVE1 PICTURE IS 9(5) NC1044.2 +004800 VALUE IS 12345. NC1044.2 +004900 01 MOVE2 PICTURE IS 9(5). NC1044.2 +005000 01 MOVE3 PICTURE IS 99. NC1044.2 +005100 01 MOVE4 PICTURE IS 9(7). NC1044.2 +005200 01 MOVE5 PICTURE IS 99V999. NC1044.2 +005300 01 MOVE6 PICTURE IS V99999. NC1044.2 +005400 01 MOVE8 PICTURE IS 9(5)V99. NC1044.2 +005500 01 MOVE9 PICTURE IS 9(7)V99. NC1044.2 +005600 01 MOVE10 PICTURE IS $999.99. NC1044.2 +005700 01 MOVE11 PICTURE IS $99,999.99. NC1044.2 +005800 01 MOVE12 PICTURE IS $(5)9(3). NC1044.2 +005900 01 MOVE13 PICTURE IS *(5)9(6). NC1044.2 +006000 01 MOVE14 PICTURE IS +9(5). NC1044.2 +006100 01 MOVE15 PICTURE IS 9(5) NC1044.2 +006200 VALUE IS 00000. NC1044.2 +006300 01 MOVE16 PICTURE IS 9(5)CR. NC1044.2 +006400 01 MOVE17 PICTURE IS $99,999.99 NC1044.2 +006500 BLANK WHEN ZERO. NC1044.2 +006600 01 MOVE18 PICTURE IS ZZZZZZ. NC1044.2 +006700 01 MOVE19 PICTURE IS X(5). NC1044.2 +006800 01 MOVE20 PICTURE IS X(4). NC1044.2 +006900 01 MOVE21 PICTURE IS X(7). NC1044.2 +007000 01 MOVE22 PICTURE IS XBX0XBX0X. NC1044.2 +007100 01 MOVE23 PICTURE IS 999V99 NC1044.2 +007200 VALUE IS 123.45. NC1044.2 +007300 01 MOVE24 PICTURE IS XBXXXB000XXXX. NC1044.2 +007400 01 MOVE25 PICTURE IS 999. NC1044.2 +007500 01 MOVE26 PICTURE IS 999V99. NC1044.2 +007600 01 MOVE27 PICTURE IS 99PP. NC1044.2 +007700 01 MOVE29 PICTURE IS 9999V999. NC1044.2 +007800 01 MOVE29A VALUE IS "$123.45". NC1044.2 +007900 02 MOVE30 PICTURE IS $999.99. NC1044.2 +008000 01 MOVE31 PICTURE IS X(9). NC1044.2 +008100 01 MOVE32 PICTURE IS X(5) NC1044.2 +008200 VALUE IS "ABCDE". NC1044.2 +008300 01 MOVE33 PICTURE IS A(5). NC1044.2 +008400 01 MOVE34 PICTURE IS A(7). NC1044.2 +008500 01 MOVE35 PICTURE IS A(3). NC1044.2 +008600 01 MOVE35A VALUE IS "1 A05". NC1044.2 +008700 02 MOVE36 PICTURE IS XBA09. NC1044.2 +008800 01 MOVE37 PICTURE IS AAAAA NC1044.2 +008900 VALUE IS "ABCDE". NC1044.2 +009000 01 MOVE39 PICTURE IS 0XXXXX0. NC1044.2 +009100 01 MOVE47A. NC1044.2 +009200 02 MOVE48 PICTURE IS 9V9(17). NC1044.2 +009300 02 MOVE49 PICTURE IS 9(5) NC1044.2 +009400 VALUE IS 00045. NC1044.2 +009500 02 MOVE50 PICTURE IS X(5) NC1044.2 +009600 VALUE IS "12345". NC1044.2 +009700 02 MOVE51 PICTURE IS S9(5) NC1044.2 +009800 VALUE IS -12345. NC1044.2 +009900 02 MOVE52 PICTURE IS 9(5)-. NC1044.2 +010000 01 AN-DATANAMES. NC1044.2 +010100 02 ANDATA1 PICTURE X VALUE SPACE. NC1044.2 +010200 02 ANDATA2 PICTURE XX VALUE SPACE. NC1044.2 +010300 02 ANDATA3 PICTURE XXX VALUE SPACE. NC1044.2 +010400 02 ANDATA4 PICTURE X(4) VALUE SPACE. NC1044.2 +010500 02 ANDATA5 PICTURE X(5) VALUE SPACE. NC1044.2 +010600 02 ANDATA6 PICTURE X(6) VALUE SPACE. NC1044.2 +010700 02 ANDATA7 PICTURE X(7) VALUE SPACE. NC1044.2 +010800 02 ANDATA8 PICTURE X(8) VALUE SPACE. NC1044.2 +010900 02 ANDATA9 PICTURE X(9) VALUE SPACE. NC1044.2 +011000 02 ANDATA10 PICTURE X(10) VALUE SPACE. NC1044.2 +011100 02 ANDATA11 PICTURE X(11) VALUE SPACE. NC1044.2 +011200 02 ANDATA12 PICTURE X(12) VALUE SPACE. NC1044.2 +011300 02 ANDATA13 PICTURE X(13) VALUE SPACE. NC1044.2 +011400 02 ANDATA14 PICTURE X(14) VALUE SPACE. NC1044.2 +011500 02 ANDATA15 PICTURE X(15) VALUE SPACE. NC1044.2 +011600 02 ANDATA16 PICTURE X(16) VALUE SPACE. NC1044.2 +011700 02 ANDATA17 PICTURE X(17) VALUE SPACE. NC1044.2 +011800 02 ANDATA18 PICTURE X(18) VALUE SPACE. NC1044.2 +011900 02 ANDATA19 PICTURE X(19) VALUE SPACE. NC1044.2 +012000 02 ANDATA20 PICTURE X(20) VALUE SPACE. NC1044.2 +012100 02 ANDATA21 PICTURE X(120) VALUE SPACE. NC1044.2 +012200 01 42-DATANAMES. NC1044.2 +012300 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC1044.2 +012400 02 DNAME2 PICTURE 99 VALUE 01 COMPUTATIONAL. NC1044.2 +012500 02 DNAME3 PICTURE 999 VALUE 001 COMPUTATIONAL. NC1044.2 +012600 02 DNAME4 PICTURE 9(4) VALUE 0001 COMPUTATIONAL. NC1044.2 +012700 02 DNAME5 PICTURE 9(5) VALUE 00001 COMPUTATIONAL. NC1044.2 +012800 02 DNAME6 PICTURE 9(6) VALUE 000001 COMPUTATIONAL. NC1044.2 +012900 02 DNAME7 PICTURE 9(7) VALUE 0000001 COMPUTATIONAL. NC1044.2 +013000 02 DNAME8 PICTURE 9(8) VALUE 00000001 COMPUTATIONAL. NC1044.2 +013100 02 DNAME9 PICTURE 9(9) VALUE 000000001. NC1044.2 +013200 02 DNAME10 PICTURE 9(10) VALUE 0000000001. NC1044.2 +013300 02 DNAME11 PICTURE 9(11) VALUE 00000000001. NC1044.2 +013400 02 DNAME12 PICTURE 9(12) VALUE 000000000001. NC1044.2 +013500 02 DNAME13 PICTURE 9(13) VALUE 0000000000001. NC1044.2 +013600 02 DNAME14 PICTURE 9(14) VALUE 00000000000001. NC1044.2 +013700 02 DNAME15 PICTURE 9(15) VALUE 000000000000001. NC1044.2 +013800 02 DNAME16 PICTURE 9(16) VALUE 0000000000000001. NC1044.2 +013900 02 DNAME17 PICTURE 9(17) VALUE 00000000000000001. NC1044.2 +014000 02 DNAME18 PICTURE 9(18) VALUE 000000000000000001. NC1044.2 +014100 02 DNAME19 PICTURE 9 VALUE 1. NC1044.2 +014200 02 DNAME20 PICTURE 99 VALUE 11. NC1044.2 +014300 02 DNAME21 PICTURE 999 VALUE 111. NC1044.2 +014400 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC1044.2 +014500 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC1044.2 +014600 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC1044.2 +014700 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC1044.2 +014800 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC1044.2 +014900 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC1044.2 +015000 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC1044.2 +015100 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC1044.2 +015200 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015300 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015400 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015500 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015600 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015700 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015800 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +015900 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016000 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016100 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016200 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016300 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016400 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1044.2 +016500 01 TEST-RESULTS. NC1044.2 +016600 02 FILLER PIC X VALUE SPACE. NC1044.2 +016700 02 FEATURE PIC X(20) VALUE SPACE. NC1044.2 +016800 02 FILLER PIC X VALUE SPACE. NC1044.2 +016900 02 P-OR-F PIC X(5) VALUE SPACE. NC1044.2 +017000 02 FILLER PIC X VALUE SPACE. NC1044.2 +017100 02 PAR-NAME. NC1044.2 +017200 03 FILLER PIC X(19) VALUE SPACE. NC1044.2 +017300 03 PARDOT-X PIC X VALUE SPACE. NC1044.2 +017400 03 DOTVALUE PIC 99 VALUE ZERO. NC1044.2 +017500 02 FILLER PIC X(8) VALUE SPACE. NC1044.2 +017600 02 RE-MARK PIC X(61). NC1044.2 +017700 01 TEST-COMPUTED. NC1044.2 +017800 02 FILLER PIC X(30) VALUE SPACE. NC1044.2 +017900 02 FILLER PIC X(17) VALUE NC1044.2 +018000 " COMPUTED=". NC1044.2 +018100 02 COMPUTED-X. NC1044.2 +018200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1044.2 +018300 03 COMPUTED-N REDEFINES COMPUTED-A NC1044.2 +018400 PIC -9(9).9(9). NC1044.2 +018500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1044.2 +018600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1044.2 +018700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1044.2 +018800 03 CM-18V0 REDEFINES COMPUTED-A. NC1044.2 +018900 04 COMPUTED-18V0 PIC -9(18). NC1044.2 +019000 04 FILLER PIC X. NC1044.2 +019100 03 FILLER PIC X(50) VALUE SPACE. NC1044.2 +019200 01 TEST-CORRECT. NC1044.2 +019300 02 FILLER PIC X(30) VALUE SPACE. NC1044.2 +019400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1044.2 +019500 02 CORRECT-X. NC1044.2 +019600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1044.2 +019700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1044.2 +019800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1044.2 +019900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1044.2 +020000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1044.2 +020100 03 CR-18V0 REDEFINES CORRECT-A. NC1044.2 +020200 04 CORRECT-18V0 PIC -9(18). NC1044.2 +020300 04 FILLER PIC X. NC1044.2 +020400 03 FILLER PIC X(2) VALUE SPACE. NC1044.2 +020500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1044.2 +020600 01 CCVS-C-1. NC1044.2 +020700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1044.2 +020800- "SS PARAGRAPH-NAME NC1044.2 +020900- " REMARKS". NC1044.2 +021000 02 FILLER PIC X(20) VALUE SPACE. NC1044.2 +021100 01 CCVS-C-2. NC1044.2 +021200 02 FILLER PIC X VALUE SPACE. NC1044.2 +021300 02 FILLER PIC X(6) VALUE "TESTED". NC1044.2 +021400 02 FILLER PIC X(15) VALUE SPACE. NC1044.2 +021500 02 FILLER PIC X(4) VALUE "FAIL". NC1044.2 +021600 02 FILLER PIC X(94) VALUE SPACE. NC1044.2 +021700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1044.2 +021800 01 REC-CT PIC 99 VALUE ZERO. NC1044.2 +021900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1044.2 +022000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1044.2 +022100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1044.2 +022200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1044.2 +022300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1044.2 +022400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1044.2 +022500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1044.2 +022600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1044.2 +022700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1044.2 +022800 01 CCVS-H-1. NC1044.2 +022900 02 FILLER PIC X(39) VALUE SPACES. NC1044.2 +023000 02 FILLER PIC X(42) VALUE NC1044.2 +023100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1044.2 +023200 02 FILLER PIC X(39) VALUE SPACES. NC1044.2 +023300 01 CCVS-H-2A. NC1044.2 +023400 02 FILLER PIC X(40) VALUE SPACE. NC1044.2 +023500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1044.2 +023600 02 FILLER PIC XXXX VALUE NC1044.2 +023700 "4.2 ". NC1044.2 +023800 02 FILLER PIC X(28) VALUE NC1044.2 +023900 " COPY - NOT FOR DISTRIBUTION". NC1044.2 +024000 02 FILLER PIC X(41) VALUE SPACE. NC1044.2 +024100 NC1044.2 +024200 01 CCVS-H-2B. NC1044.2 +024300 02 FILLER PIC X(15) VALUE NC1044.2 +024400 "TEST RESULT OF ". NC1044.2 +024500 02 TEST-ID PIC X(9). NC1044.2 +024600 02 FILLER PIC X(4) VALUE NC1044.2 +024700 " IN ". NC1044.2 +024800 02 FILLER PIC X(12) VALUE NC1044.2 +024900 " HIGH ". NC1044.2 +025000 02 FILLER PIC X(22) VALUE NC1044.2 +025100 " LEVEL VALIDATION FOR ". NC1044.2 +025200 02 FILLER PIC X(58) VALUE NC1044.2 +025300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1044.2 +025400 01 CCVS-H-3. NC1044.2 +025500 02 FILLER PIC X(34) VALUE NC1044.2 +025600 " FOR OFFICIAL USE ONLY ". NC1044.2 +025700 02 FILLER PIC X(58) VALUE NC1044.2 +025800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1044.2 +025900 02 FILLER PIC X(28) VALUE NC1044.2 +026000 " COPYRIGHT 1985 ". NC1044.2 +026100 01 CCVS-E-1. NC1044.2 +026200 02 FILLER PIC X(52) VALUE SPACE. NC1044.2 +026300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1044.2 +026400 02 ID-AGAIN PIC X(9). NC1044.2 +026500 02 FILLER PIC X(45) VALUE SPACES. NC1044.2 +026600 01 CCVS-E-2. NC1044.2 +026700 02 FILLER PIC X(31) VALUE SPACE. NC1044.2 +026800 02 FILLER PIC X(21) VALUE SPACE. NC1044.2 +026900 02 CCVS-E-2-2. NC1044.2 +027000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1044.2 +027100 03 FILLER PIC X VALUE SPACE. NC1044.2 +027200 03 ENDER-DESC PIC X(44) VALUE NC1044.2 +027300 "ERRORS ENCOUNTERED". NC1044.2 +027400 01 CCVS-E-3. NC1044.2 +027500 02 FILLER PIC X(22) VALUE NC1044.2 +027600 " FOR OFFICIAL USE ONLY". NC1044.2 +027700 02 FILLER PIC X(12) VALUE SPACE. NC1044.2 +027800 02 FILLER PIC X(58) VALUE NC1044.2 +027900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1044.2 +028000 02 FILLER PIC X(13) VALUE SPACE. NC1044.2 +028100 02 FILLER PIC X(15) VALUE NC1044.2 +028200 " COPYRIGHT 1985". NC1044.2 +028300 01 CCVS-E-4. NC1044.2 +028400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1044.2 +028500 02 FILLER PIC X(4) VALUE " OF ". NC1044.2 +028600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1044.2 +028700 02 FILLER PIC X(40) VALUE NC1044.2 +028800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1044.2 +028900 01 XXINFO. NC1044.2 +029000 02 FILLER PIC X(19) VALUE NC1044.2 +029100 "*** INFORMATION ***". NC1044.2 +029200 02 INFO-TEXT. NC1044.2 +029300 04 FILLER PIC X(8) VALUE SPACE. NC1044.2 +029400 04 XXCOMPUTED PIC X(20). NC1044.2 +029500 04 FILLER PIC X(5) VALUE SPACE. NC1044.2 +029600 04 XXCORRECT PIC X(20). NC1044.2 +029700 02 INF-ANSI-REFERENCE PIC X(48). NC1044.2 +029800 01 HYPHEN-LINE. NC1044.2 +029900 02 FILLER PIC IS X VALUE IS SPACE. NC1044.2 +030000 02 FILLER PIC IS X(65) VALUE IS "************************NC1044.2 +030100- "*****************************************". NC1044.2 +030200 02 FILLER PIC IS X(54) VALUE IS "************************NC1044.2 +030300- "******************************". NC1044.2 +030400 01 CCVS-PGM-ID PIC X(9) VALUE NC1044.2 +030500 "NC104A". NC1044.2 +030600 PROCEDURE DIVISION. NC1044.2 +030700 CCVS1 SECTION. NC1044.2 +030800 OPEN-FILES. NC1044.2 +030900 OPEN OUTPUT PRINT-FILE. NC1044.2 +031000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1044.2 +031100 MOVE SPACE TO TEST-RESULTS. NC1044.2 +031200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1044.2 +031300 GO TO CCVS1-EXIT. NC1044.2 +031400 CLOSE-FILES. NC1044.2 +031500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1044.2 +031600 TERMINATE-CCVS. NC1044.2 +031700*S EXIT PROGRAM. NC1044.2 +031800*SERMINATE-CALL. NC1044.2 +031900 STOP RUN. NC1044.2 +032000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1044.2 +032100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1044.2 +032200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1044.2 +032300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1044.2 +032400 MOVE "****TEST DELETED****" TO RE-MARK. NC1044.2 +032500 PRINT-DETAIL. NC1044.2 +032600 IF REC-CT NOT EQUAL TO ZERO NC1044.2 +032700 MOVE "." TO PARDOT-X NC1044.2 +032800 MOVE REC-CT TO DOTVALUE. NC1044.2 +032900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1044.2 +033000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1044.2 +033100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1044.2 +033200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1044.2 +033300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1044.2 +033400 MOVE SPACE TO CORRECT-X. NC1044.2 +033500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1044.2 +033600 MOVE SPACE TO RE-MARK. NC1044.2 +033700 HEAD-ROUTINE. NC1044.2 +033800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +033900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +034000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1044.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1044.2 +034200 COLUMN-NAMES-ROUTINE. NC1044.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +034600 END-ROUTINE. NC1044.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1044.2 +034800 END-RTN-EXIT. NC1044.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +035000 END-ROUTINE-1. NC1044.2 +035100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1044.2 +035200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1044.2 +035300 ADD PASS-COUNTER TO ERROR-HOLD. NC1044.2 +035400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1044.2 +035500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1044.2 +035600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1044.2 +035700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1044.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1044.2 +035900 END-ROUTINE-12. NC1044.2 +036000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1044.2 +036100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1044.2 +036200 MOVE "NO " TO ERROR-TOTAL NC1044.2 +036300 ELSE NC1044.2 +036400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1044.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1044.2 +036600 PERFORM WRITE-LINE. NC1044.2 +036700 END-ROUTINE-13. NC1044.2 +036800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1044.2 +036900 MOVE "NO " TO ERROR-TOTAL ELSE NC1044.2 +037000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1044.2 +037100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1044.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +037300 IF INSPECT-COUNTER EQUAL TO ZERO NC1044.2 +037400 MOVE "NO " TO ERROR-TOTAL NC1044.2 +037500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1044.2 +037600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1044.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +037800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1044.2 +037900 WRITE-LINE. NC1044.2 +038000 ADD 1 TO RECORD-COUNT. NC1044.2 +038100 IF RECORD-COUNT GREATER 42 NC1044.2 +038200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1044.2 +038300 MOVE SPACE TO DUMMY-RECORD NC1044.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1044.2 +038500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1044.2 +038600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1044.2 +038700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1044.2 +038800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1044.2 +038900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1044.2 +039000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1044.2 +039100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1044.2 +039200 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1044.2 +039300 MOVE ZERO TO RECORD-COUNT. NC1044.2 +039400 PERFORM WRT-LN. NC1044.2 +039500 WRT-LN. NC1044.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1044.2 +039700 MOVE SPACE TO DUMMY-RECORD. NC1044.2 +039800 BLANK-LINE-PRINT. NC1044.2 +039900 PERFORM WRT-LN. NC1044.2 +040000 FAIL-ROUTINE. NC1044.2 +040100 IF COMPUTED-X NOT EQUAL TO SPACE NC1044.2 +040200 GO TO FAIL-ROUTINE-WRITE. NC1044.2 +040300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1044.2 +040400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1044.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1044.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +040700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1044.2 +040800 GO TO FAIL-ROUTINE-EX. NC1044.2 +040900 FAIL-ROUTINE-WRITE. NC1044.2 +041000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1044.2 +041100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1044.2 +041200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1044.2 +041300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1044.2 +041400 FAIL-ROUTINE-EX. EXIT. NC1044.2 +041500 BAIL-OUT. NC1044.2 +041600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1044.2 +041700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1044.2 +041800 BAIL-OUT-WRITE. NC1044.2 +041900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1044.2 +042000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1044.2 +042100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1044.2 +042200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1044.2 +042300 BAIL-OUT-EX. EXIT. NC1044.2 +042400 CCVS1-EXIT. NC1044.2 +042500 EXIT. NC1044.2 +042600 SECT-NC104A-001 SECTION. NC1044.2 +042700 MOVE-INIT-F1-1. NC1044.2 +042800 MOVE "MOVE NUMERIC INTEGER" TO FEATURE. NC1044.2 +042900 MOVE "V1-102 6.18.2" TO ANSI-REFERENCE. NC1044.2 +043000 MOVE 12345 TO MOVE1. NC1044.2 +043100 MOVE-TEST-F1-1-0. NC1044.2 +043200 MOVE MOVE1 TO MOVE2. NC1044.2 +043300 MOVE-TEST-F1-1-1. NC1044.2 +043400 IF MOVE2 EQUAL TO 12345 NC1044.2 +043500 PERFORM PASS NC1044.2 +043600 ELSE NC1044.2 +043700 GO TO MOVE-FAIL-F1-1. NC1044.2 +043800* NOTE NI TO NI (NUMERIC INTEGRAL) MOVE, EQUAL SIZE. NC1044.2 +043900 GO TO MOVE-WRITE-F1-1. NC1044.2 +044000 MOVE-DELETE-F1-1. NC1044.2 +044100 PERFORM DE-LETE. NC1044.2 +044200 GO TO MOVE-WRITE-F1-1. NC1044.2 +044300 MOVE-FAIL-F1-1. NC1044.2 +044400 MOVE MOVE2 TO COMPUTED-N. NC1044.2 +044500 MOVE 12345 TO CORRECT-N. NC1044.2 +044600 PERFORM FAIL. NC1044.2 +044700 MOVE-WRITE-F1-1. NC1044.2 +044800 MOVE "MOVE-TEST-F1-1 " TO PAR-NAME. NC1044.2 +044900 PERFORM PRINT-DETAIL. NC1044.2 +045000 MOVE-INIT-F1-2. NC1044.2 +045100 MOVE 12345 TO MOVE1. NC1044.2 +045200 MOVE-TEST-F1-2-0. NC1044.2 +045300 MOVE MOVE1 TO MOVE3. NC1044.2 +045400 MOVE-TEST-F1-2-1. NC1044.2 +045500 IF MOVE3 EQUAL TO 45 NC1044.2 +045600 PERFORM PASS NC1044.2 +045700 ELSE NC1044.2 +045800 GO TO MOVE-FAIL-F1-2. NC1044.2 +045900* NOTE NI TO NI MOVE, WITH TRUNCATION. NC1044.2 +046000 GO TO MOVE-WRITE-F1-2. NC1044.2 +046100 MOVE-DELETE-F1-2. NC1044.2 +046200 PERFORM DE-LETE. NC1044.2 +046300 GO TO MOVE-WRITE-F1-2. NC1044.2 +046400 MOVE-FAIL-F1-2. NC1044.2 +046500 MOVE MOVE3 TO COMPUTED-N. NC1044.2 +046600 MOVE 45 TO CORRECT-N. NC1044.2 +046700 PERFORM FAIL. NC1044.2 +046800 MOVE-WRITE-F1-2. NC1044.2 +046900 MOVE "MOVE-TEST-F1-2 " TO PAR-NAME. NC1044.2 +047000 PERFORM PRINT-DETAIL. NC1044.2 +047100 MOVE-INIT-F1-3. NC1044.2 +047200 MOVE 12345 TO MOVE1. NC1044.2 +047300 MOVE-TEST-F1-3-0. NC1044.2 +047400 MOVE MOVE1 TO MOVE4. NC1044.2 +047500 MOVE-TEST-F1-3-1. NC1044.2 +047600 IF MOVE4 EQUAL TO 0012345 NC1044.2 +047700 PERFORM PASS NC1044.2 +047800 ELSE NC1044.2 +047900 GO TO MOVE-FAIL-F1-3. NC1044.2 +048000* NOTE NI TO NI MOVE, WITH ZERO PADDING. NC1044.2 +048100 GO TO MOVE-WRITE-F1-3. NC1044.2 +048200 MOVE-DELETE-F1-3. NC1044.2 +048300 PERFORM DE-LETE. NC1044.2 +048400 GO TO MOVE-WRITE-F1-3. NC1044.2 +048500 MOVE-FAIL-F1-3. NC1044.2 +048600 MOVE MOVE4 TO COMPUTED-N. NC1044.2 +048700 MOVE 0012345 TO CORRECT-N. NC1044.2 +048800 PERFORM FAIL. NC1044.2 +048900 MOVE-WRITE-F1-3. NC1044.2 +049000 MOVE "MOVE-TEST-F1-3 " TO PAR-NAME. NC1044.2 +049100 PERFORM PRINT-DETAIL. NC1044.2 +049200 MOVE-INIT-F1-4. NC1044.2 +049300 MOVE 12345 TO MOVE1. NC1044.2 +049400 MOVE-TEST-F1-4-0. NC1044.2 +049500 MOVE MOVE1 TO MOVE5. NC1044.2 +049600 MOVE-TEST-F1-4-1. NC1044.2 +049700 IF MOVE5 EQUAL TO 45 NC1044.2 +049800 PERFORM PASS NC1044.2 +049900 ELSE NC1044.2 +050000 GO TO MOVE-FAIL-F1-4. NC1044.2 +050100* NOTE NI TO NNI (NUMERIC NON INTEGER), LEFT TRUNCATION NC1044.2 +050200* ZERO FILL ON RIGHT. NC1044.2 +050300 GO TO MOVE-WRITE-F1-4. NC1044.2 +050400 MOVE-DELETE-F1-4. NC1044.2 +050500 PERFORM DE-LETE. NC1044.2 +050600 GO TO MOVE-WRITE-F1-4. NC1044.2 +050700 MOVE-FAIL-F1-4. NC1044.2 +050800 MOVE MOVE5 TO COMPUTED-N. NC1044.2 +050900 MOVE 45 TO CORRECT-N. NC1044.2 +051000 PERFORM FAIL. NC1044.2 +051100 MOVE-WRITE-F1-4. NC1044.2 +051200 MOVE "MOVE-TEST-F1-4 " TO PAR-NAME. NC1044.2 +051300 PERFORM PRINT-DETAIL. NC1044.2 +051400 MOVE-INIT-F1-5. NC1044.2 +051500 MOVE 12345 TO MOVE1. NC1044.2 +051600 MOVE-TEST-F1-5-0. NC1044.2 +051700 MOVE MOVE1 TO MOVE48. NC1044.2 +051800 MOVE-TEST-F1-5-1. NC1044.2 +051900 IF MOVE48 EQUAL TO 5 NC1044.2 +052000 PERFORM PASS NC1044.2 +052100 ELSE NC1044.2 +052200 GO TO MOVE-FAIL-F1-5. NC1044.2 +052300* NOTE NI TO NNI MOVE, RECEIVING FIELD MAX SIZE. NC1044.2 +052400 GO TO MOVE-WRITE-F1-5. NC1044.2 +052500 MOVE-DELETE-F1-5. NC1044.2 +052600 PERFORM DE-LETE. NC1044.2 +052700 GO TO MOVE-WRITE-F1-5. NC1044.2 +052800 MOVE-FAIL-F1-5. NC1044.2 +052900 MOVE MOVE48 TO COMPUTED-N. NC1044.2 +053000 MOVE 5 TO CORRECT-N. NC1044.2 +053100 PERFORM FAIL. NC1044.2 +053200 MOVE-WRITE-F1-5. NC1044.2 +053300 MOVE "MOVE-TEST-F1-5 " TO PAR-NAME. NC1044.2 +053400 PERFORM PRINT-DETAIL. NC1044.2 +053500 MOVE-INIT-F1-6. NC1044.2 +053600 MOVE 12345 TO MOVE1. NC1044.2 +053700 MOVE-TEST-F1-6-0. NC1044.2 +053800 MOVE MOVE1 TO MOVE27. NC1044.2 +053900 MOVE-TEST-F1-6-1. NC1044.2 +054000 IF MOVE27 EQUAL TO 2300 NC1044.2 +054100 PERFORM PASS NC1044.2 +054200 ELSE NC1044.2 +054300 GO TO MOVE-FAIL-F1-6. NC1044.2 +054400* NOTE NI TO NNI MOVE SCALING. NC1044.2 +054500 GO TO MOVE-WRITE-F1-6. NC1044.2 +054600 MOVE-DELETE-F1-6. NC1044.2 +054700 PERFORM DE-LETE. NC1044.2 +054800 GO TO MOVE-WRITE-F1-6. NC1044.2 +054900 MOVE-FAIL-F1-6. NC1044.2 +055000 MOVE MOVE27 TO COMPUTED-N. NC1044.2 +055100 MOVE 2300 TO CORRECT-N. NC1044.2 +055200 PERFORM FAIL. NC1044.2 +055300 MOVE-WRITE-F1-6. NC1044.2 +055400 MOVE "MOVE-TEST-F1-6 " TO PAR-NAME. NC1044.2 +055500 PERFORM PRINT-DETAIL. NC1044.2 +055600 MOVE-INIT-F1-7. NC1044.2 +055700 MOVE 12345 TO MOVE1. NC1044.2 +055800 MOVE-TEST-F1-7-0. NC1044.2 +055900 MOVE MOVE1 TO MOVE8. NC1044.2 +056000 MOVE-TEST-F1-7-1. NC1044.2 +056100 IF MOVE1 EQUAL TO 12345.00 NC1044.2 +056200 PERFORM PASS NC1044.2 +056300 ELSE NC1044.2 +056400 GO TO MOVE-FAIL-F1-7. NC1044.2 +056500* NOTE NI TO NNI MOVE, ZERO PADDING ON RIGHT. NC1044.2 +056600 GO TO MOVE-WRITE-F1-7. NC1044.2 +056700 MOVE-DELETE-F1-7. NC1044.2 +056800 PERFORM DE-LETE. NC1044.2 +056900 GO TO MOVE-WRITE-F1-7. NC1044.2 +057000 MOVE-FAIL-F1-7. NC1044.2 +057100 MOVE MOVE8 TO COMPUTED-N. NC1044.2 +057200 MOVE 12345.00 TO CORRECT-N. NC1044.2 +057300 PERFORM FAIL. NC1044.2 +057400 MOVE-WRITE-F1-7. NC1044.2 +057500 MOVE "MOVE-TEST-F1-7 " TO PAR-NAME. NC1044.2 +057600 PERFORM PRINT-DETAIL. NC1044.2 +057700 MOVE-INIT-F1-8. NC1044.2 +057800 MOVE 12345 TO MOVE1. NC1044.2 +057900 MOVE-TEST-F1-8-0. NC1044.2 +058000 MOVE MOVE1 TO MOVE9. NC1044.2 +058100 MOVE-TEST-F1-8-1. NC1044.2 +058200 IF MOVE9 EQUAL TO 012345.00 NC1044.2 +058300 PERFORM PASS NC1044.2 +058400 ELSE NC1044.2 +058500 GO TO MOVE-FAIL-F1-8. NC1044.2 +058600* NOTE NI TO NNI MOVE, ZERO PADDING LEFT AND RIGHT. NC1044.2 +058700 GO TO MOVE-WRITE-F1-8. NC1044.2 +058800 MOVE-DELETE-F1-8. NC1044.2 +058900 PERFORM DE-LETE. NC1044.2 +059000 GO TO MOVE-WRITE-F1-8. NC1044.2 +059100 MOVE-FAIL-F1-8. NC1044.2 +059200 MOVE MOVE9 TO COMPUTED-N. NC1044.2 +059300 MOVE 0012345.00 TO CORRECT-N. NC1044.2 +059400 PERFORM FAIL. NC1044.2 +059500 MOVE-WRITE-F1-8. NC1044.2 +059600 MOVE "MOVE-TEST-F1-8 " TO PAR-NAME. NC1044.2 +059700 PERFORM PRINT-DETAIL. NC1044.2 +059800 MOVE-INIT-F1-9. NC1044.2 +059900 MOVE 12345 TO MOVE1. NC1044.2 +060000 MOVE-TEST-F1-9-0. NC1044.2 +060100 MOVE MOVE1 TO MOVE10. NC1044.2 +060200 MOVE-TEST-F1-9-1. NC1044.2 +060300 IF MOVE10 EQUAL TO "$345.00" NC1044.2 +060400 PERFORM PASS NC1044.2 +060500 ELSE NC1044.2 +060600 GO TO MOVE-FAIL-F1-9. NC1044.2 +060700* NOTE NI TO NE MOVE, FIXED INSERTION, CURRENCY SIGN, PERIOD. NC1044.2 +060800 GO TO MOVE-WRITE-F1-9. NC1044.2 +060900 MOVE-DELETE-F1-9. NC1044.2 +061000 PERFORM DE-LETE. NC1044.2 +061100 GO TO MOVE-WRITE-F1-9. NC1044.2 +061200 MOVE-FAIL-F1-9. NC1044.2 +061300 MOVE MOVE10 TO COMPUTED-A. NC1044.2 +061400 MOVE "$345.00" TO CORRECT-A. NC1044.2 +061500 PERFORM FAIL. NC1044.2 +061600 MOVE-WRITE-F1-9. NC1044.2 +061700 MOVE "MOVE-TEST-F1-9 " TO PAR-NAME. NC1044.2 +061800 PERFORM PRINT-DETAIL. NC1044.2 +061900 MOVE-INIT-F1-10. NC1044.2 +062000 MOVE 12345 TO MOVE1. NC1044.2 +062100 MOVE-TEST-F1-10-0. NC1044.2 +062200 MOVE MOVE1 TO MOVE11. NC1044.2 +062300 MOVE-TEST-F1-10-1. NC1044.2 +062400 IF MOVE11 EQUAL TO "$12,345.00" NC1044.2 +062500 PERFORM PASS NC1044.2 +062600 ELSE NC1044.2 +062700 GO TO MOVE-FAIL-F1-10. NC1044.2 +062800* NOTE NI TO NE MOVE, FIXED INSERTION (CURRENCY SIGN, NC1044.2 +062900* COMMA, PERIOD) ZERO FILL ON RIGHT. NC1044.2 +063000 GO TO MOVE-WRITE-F1-10. NC1044.2 +063100 MOVE-DELETE-F1-10. NC1044.2 +063200 PERFORM DE-LETE. NC1044.2 +063300 GO TO MOVE-WRITE-F1-10. NC1044.2 +063400 MOVE-FAIL-F1-10. NC1044.2 +063500 MOVE MOVE11 TO COMPUTED-A. NC1044.2 +063600 MOVE "$12,345.00" TO CORRECT-A. NC1044.2 +063700 PERFORM FAIL. NC1044.2 +063800 MOVE-WRITE-F1-10. NC1044.2 +063900 MOVE "MOVE-TEST-F1-10" TO PAR-NAME. NC1044.2 +064000 PERFORM PRINT-DETAIL. NC1044.2 +064100 MOVE-INIT-F1-11. NC1044.2 +064200 MOVE 00045 TO MOVE49. NC1044.2 +064300 MOVE-TEST-F1-11-0. NC1044.2 +064400 MOVE MOVE49 TO MOVE12. NC1044.2 +064500 MOVE-TEST-F1-11-1. NC1044.2 +064600 IF MOVE12 EQUAL TO " $045" NC1044.2 +064700 PERFORM PASS NC1044.2 +064800 ELSE NC1044.2 +064900 GO TO MOVE-FAIL-F1-11. NC1044.2 +065000* NOTE NI TO NE MOVE, FLOAT CURRENCY SIGN. NC1044.2 +065100 GO TO MOVE-WRITE-F1-11. NC1044.2 +065200 MOVE-DELETE-F1-11. NC1044.2 +065300 PERFORM DE-LETE. NC1044.2 +065400 GO TO MOVE-WRITE-F1-11. NC1044.2 +065500 MOVE-FAIL-F1-11. NC1044.2 +065600 MOVE MOVE12 TO COMPUTED-A. NC1044.2 +065700 MOVE " $045" TO CORRECT-A. NC1044.2 +065800 PERFORM FAIL. NC1044.2 +065900 MOVE-WRITE-F1-11. NC1044.2 +066000 MOVE "MOVE-TEST-F1-11" TO PAR-NAME. NC1044.2 +066100 PERFORM PRINT-DETAIL. NC1044.2 +066200 MOVE-INIT-F1-12. NC1044.2 +066300 MOVE 00045 TO MOVE49. NC1044.2 +066400 MOVE-TEST-F1-12-0. NC1044.2 +066500 MOVE MOVE49 TO MOVE13. NC1044.2 +066600 MOVE-TEST-F1-12-1. NC1044.2 +066700 IF MOVE13 EQUAL TO "*****000045" NC1044.2 +066800 PERFORM PASS NC1044.2 +066900 ELSE NC1044.2 +067000 GO TO MOVE-FAIL-F1-12. NC1044.2 +067100* NOTE NI TO NE MOVE, CHECK PROTECT. NC1044.2 +067200 GO TO MOVE-WRITE-F1-12. NC1044.2 +067300 MOVE-DELETE-F1-12. NC1044.2 +067400 PERFORM DE-LETE. NC1044.2 +067500 GO TO MOVE-WRITE-F1-12. NC1044.2 +067600 MOVE-FAIL-F1-12. NC1044.2 +067700 MOVE MOVE13 TO COMPUTED-A. NC1044.2 +067800 MOVE "*****000045" TO CORRECT-A. NC1044.2 +067900 PERFORM FAIL. NC1044.2 +068000 MOVE-WRITE-F1-12. NC1044.2 +068100 MOVE "MOVE-TEST-F1-12" TO PAR-NAME. NC1044.2 +068200 PERFORM PRINT-DETAIL. NC1044.2 +068300 MOVE-INIT-F1-13. NC1044.2 +068400 MOVE 12345 TO MOVE1. NC1044.2 +068500 MOVE-TEST-F1-13-0. NC1044.2 +068600 MOVE MOVE1 TO MOVE14. NC1044.2 +068700 MOVE-TEST-F1-13-1. NC1044.2 +068800 IF MOVE14 EQUAL TO "+12345" NC1044.2 +068900 PERFORM PASS NC1044.2 +069000 ELSE NC1044.2 +069100 GO TO MOVE-FAIL-F1-13. NC1044.2 +069200* NOTE NI TO NE MOVE, REPORT SIGN. NC1044.2 +069300 GO TO MOVE-WRITE-F1-13. NC1044.2 +069400 MOVE-DELETE-F1-13. NC1044.2 +069500 PERFORM DE-LETE. NC1044.2 +069600 GO TO MOVE-WRITE-F1-13. NC1044.2 +069700 MOVE-FAIL-F1-13. NC1044.2 +069800 MOVE MOVE14 TO COMPUTED-A. NC1044.2 +069900 MOVE "+12345" TO CORRECT-A. NC1044.2 +070000 PERFORM FAIL. NC1044.2 +070100 MOVE-WRITE-F1-13. NC1044.2 +070200 MOVE "MOVE-TEST-F1-13" TO PAR-NAME. NC1044.2 +070300 PERFORM PRINT-DETAIL. NC1044.2 +070400 MOVE-INIT-F1-14. NC1044.2 +070500 MOVE -12345 TO MOVE51. NC1044.2 +070600 MOVE-TEST-F1-14-0. NC1044.2 +070700 MOVE MOVE51 TO MOVE16. NC1044.2 +070800 MOVE-TEST-F1-14-1. NC1044.2 +070900 IF MOVE16 EQUAL TO "12345CR" NC1044.2 +071000 PERFORM PASS NC1044.2 +071100 ELSE NC1044.2 +071200 GO TO MOVE-FAIL-F1-14. NC1044.2 +071300* NOTE NI TO NE MOVE, REPORT SYMBOL CR. NC1044.2 +071400 GO TO MOVE-WRITE-F1-14. NC1044.2 +071500 MOVE-DELETE-F1-14. NC1044.2 +071600 PERFORM DE-LETE. NC1044.2 +071700 GO TO MOVE-WRITE-F1-14. NC1044.2 +071800 MOVE-FAIL-F1-14. NC1044.2 +071900 MOVE MOVE16 TO COMPUTED-A. NC1044.2 +072000 MOVE "12345CR" TO CORRECT-A. NC1044.2 +072100 PERFORM FAIL. NC1044.2 +072200 MOVE-WRITE-F1-14. NC1044.2 +072300 MOVE "MOVE-TEST-F1-14" TO PAR-NAME. NC1044.2 +072400 PERFORM PRINT-DETAIL. NC1044.2 +072500 MOVE-INIT-F1-15. NC1044.2 +072600 MOVE -12345 TO MOVE51. NC1044.2 +072700 MOVE-TEST-F1-15-0. NC1044.2 +072800 MOVE MOVE51 TO MOVE52. NC1044.2 +072900 MOVE-TEST-F1-15-1. NC1044.2 +073000 IF MOVE52 EQUAL TO "12345-" NC1044.2 +073100 PERFORM PASS NC1044.2 +073200 ELSE NC1044.2 +073300 GO TO MOVE-FAIL-F1-15. NC1044.2 +073400* NOTE NI TO NE MOVE REPORT SIGN. NC1044.2 +073500 GO TO MOVE-WRITE-F1-15. NC1044.2 +073600 MOVE-DELETE-F1-15. NC1044.2 +073700 PERFORM DE-LETE. NC1044.2 +073800 GO TO MOVE-WRITE-F1-15. NC1044.2 +073900 MOVE-FAIL-F1-15. NC1044.2 +074000 MOVE MOVE52 TO COMPUTED-A. NC1044.2 +074100 MOVE "12345-" TO CORRECT-A. NC1044.2 +074200 PERFORM FAIL. NC1044.2 +074300 MOVE-WRITE-F1-15. NC1044.2 +074400 MOVE "MOVE-TEST-F1-15" TO PAR-NAME. NC1044.2 +074500 PERFORM PRINT-DETAIL. NC1044.2 +074600 MOVE-INIT-F1-16. NC1044.2 +074700 MOVE 00000 TO MOVE15. NC1044.2 +074800 MOVE-TEST-F1-16-0. NC1044.2 +074900 MOVE MOVE15 TO MOVE17. NC1044.2 +075000 MOVE-TEST-F1-16-1. NC1044.2 +075100 IF MOVE17 EQUAL TO SPACE NC1044.2 +075200 PERFORM PASS NC1044.2 +075300 ELSE NC1044.2 +075400 GO TO MOVE-FAIL-F1-16. NC1044.2 +075500* NOTE NI TO NE MOVE, BLANK WHEN ZERO CLAUSE. NC1044.2 +075600 GO TO MOVE-WRITE-F1-16. NC1044.2 +075700 MOVE-DELETE-F1-16. NC1044.2 +075800 PERFORM DE-LETE. NC1044.2 +075900 GO TO MOVE-WRITE-F1-16. NC1044.2 +076000 MOVE-FAIL-F1-16. NC1044.2 +076100 MOVE MOVE17 TO COMPUTED-A. NC1044.2 +076200 MOVE SPACE TO CORRECT-A. NC1044.2 +076300 PERFORM FAIL. NC1044.2 +076400 MOVE-WRITE-F1-16. NC1044.2 +076500 MOVE "MOVE-TEST-F1-16" TO PAR-NAME. NC1044.2 +076600 PERFORM PRINT-DETAIL. NC1044.2 +076700 MOVE-INIT-F1-17. NC1044.2 +076800 MOVE 00000 TO MOVE15. NC1044.2 +076900 MOVE-TEST-F1-17-0. NC1044.2 +077000 MOVE MOVE15 TO MOVE18. NC1044.2 +077100 MOVE-TEST-F1-17-1. NC1044.2 +077200 IF MOVE18 EQUAL TO SPACE NC1044.2 +077300 PERFORM PASS NC1044.2 +077400 ELSE NC1044.2 +077500 GO TO MOVE-FAIL-F1-17. NC1044.2 +077600* NOTE NI TO NE MOVE, BLANK WHEN ZERO PICTURE. NC1044.2 +077700 GO TO MOVE-WRITE-F1-17. NC1044.2 +077800 MOVE-DELETE-F1-17. NC1044.2 +077900 PERFORM DE-LETE. NC1044.2 +078000 GO TO MOVE-WRITE-F1-17. NC1044.2 +078100 MOVE-FAIL-F1-17. NC1044.2 +078200 MOVE MOVE18 TO COMPUTED-A. NC1044.2 +078300 MOVE SPACE TO CORRECT-A. NC1044.2 +078400 PERFORM FAIL. NC1044.2 +078500 MOVE-WRITE-F1-17. NC1044.2 +078600 MOVE "MOVE-TEST-F1-17" TO PAR-NAME. NC1044.2 +078700 PERFORM PRINT-DETAIL. NC1044.2 +078800 MOVE-INIT-F1-18. NC1044.2 +078900 MOVE 12345 TO MOVE1. NC1044.2 +079000 MOVE-TEST-F1-18-0. NC1044.2 +079100 MOVE MOVE1 TO MOVE19. NC1044.2 +079200 MOVE-TEST-F1-18-1. NC1044.2 +079300 IF MOVE19 EQUAL TO 12345 NC1044.2 +079400 PERFORM PASS NC1044.2 +079500 ELSE NC1044.2 +079600 GO TO MOVE-FAIL-F1-18. NC1044.2 +079700* NOTE NI TO AN MOVE, EQUAL SIZE. NC1044.2 +079800 GO TO MOVE-WRITE-F1-18. NC1044.2 +079900 MOVE-DELETE-F1-18. NC1044.2 +080000 PERFORM DE-LETE. NC1044.2 +080100 GO TO MOVE-WRITE-F1-18. NC1044.2 +080200 MOVE-FAIL-F1-18. NC1044.2 +080300 MOVE MOVE19 TO COMPUTED-N. NC1044.2 +080400 MOVE 12345 TO CORRECT-N. NC1044.2 +080500 PERFORM FAIL. NC1044.2 +080600 MOVE-WRITE-F1-18. NC1044.2 +080700 MOVE "MOVE-TEST-F1-18" TO PAR-NAME. NC1044.2 +080800 PERFORM PRINT-DETAIL. NC1044.2 +080900 MOVE-INIT-F1-19. NC1044.2 +081000 MOVE 12345 TO MOVE1. NC1044.2 +081100 MOVE-TEST-F1-19-0. NC1044.2 +081200 MOVE MOVE1 TO MOVE20. NC1044.2 +081300 MOVE-TEST-F1-19-1. NC1044.2 +081400 IF MOVE20 EQUAL TO 1234 NC1044.2 +081500 PERFORM PASS NC1044.2 +081600 ELSE NC1044.2 +081700 GO TO MOVE-FAIL-F1-19. NC1044.2 +081800* NOTE NI TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +081900 GO TO MOVE-WRITE-F1-19. NC1044.2 +082000 MOVE-DELETE-F1-19. NC1044.2 +082100 PERFORM DE-LETE. NC1044.2 +082200 GO TO MOVE-WRITE-F1-19. NC1044.2 +082300 MOVE-FAIL-F1-19. NC1044.2 +082400 MOVE MOVE20 TO COMPUTED-N. NC1044.2 +082500 MOVE 1234 TO CORRECT-N. NC1044.2 +082600 PERFORM FAIL. NC1044.2 +082700 MOVE-WRITE-F1-19. NC1044.2 +082800 MOVE "MOVE-TEST-F1-19" TO PAR-NAME. NC1044.2 +082900 PERFORM PRINT-DETAIL. NC1044.2 +083000 MOVE-INIT-F1-20. NC1044.2 +083100 MOVE 12345 TO MOVE1. NC1044.2 +083200 MOVE-TEST-F1-20-0. NC1044.2 +083300 MOVE MOVE1 TO MOVE21. NC1044.2 +083400 MOVE-TEST-F1-20-1. NC1044.2 +083500 IF MOVE21 EQUAL TO "12345 " NC1044.2 +083600 PERFORM PASS NC1044.2 +083700 ELSE NC1044.2 +083800 GO TO MOVE-FAIL-F1-20. NC1044.2 +083900* NOTE NI TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +084000 GO TO MOVE-WRITE-F1-20. NC1044.2 +084100 MOVE-DELETE-F1-20. NC1044.2 +084200 PERFORM DE-LETE. NC1044.2 +084300 GO TO MOVE-WRITE-F1-20. NC1044.2 +084400 MOVE-FAIL-F1-20. NC1044.2 +084500 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +084600 MOVE "12345 " TO CORRECT-A. NC1044.2 +084700 PERFORM FAIL. NC1044.2 +084800 MOVE-WRITE-F1-20. NC1044.2 +084900 MOVE "MOVE-TEST-F1-20" TO PAR-NAME. NC1044.2 +085000 PERFORM PRINT-DETAIL. NC1044.2 +085100 MOVE-INIT-F1-21. NC1044.2 +085200 MOVE 12345 TO MOVE1. NC1044.2 +085300 MOVE-TEST-F1-21-0. NC1044.2 +085400 MOVE MOVE1 TO MOVE22. NC1044.2 +085500 MOVE-TEST-F1-21-1. NC1044.2 +085600 IF MOVE22 EQUAL TO "1 203 405" NC1044.2 +085700 PERFORM PASS NC1044.2 +085800 ELSE NC1044.2 +085900 GO TO MOVE-FAIL-F1-21. NC1044.2 +086000* NOTE NI TO AE MOVE, ZERO AND SPACE INSERTION. NC1044.2 +086100 GO TO MOVE-WRITE-F1-21. NC1044.2 +086200 MOVE-DELETE-F1-21. NC1044.2 +086300 PERFORM DE-LETE. NC1044.2 +086400 GO TO MOVE-WRITE-F1-21. NC1044.2 +086500 MOVE-FAIL-F1-21. NC1044.2 +086600 MOVE MOVE22 TO COMPUTED-A. NC1044.2 +086700 MOVE "1 203 405" TO CORRECT-A. NC1044.2 +086800 PERFORM FAIL. NC1044.2 +086900 MOVE-WRITE-F1-21. NC1044.2 +087000 MOVE "MOVE-TEST-F1-21" TO PAR-NAME. NC1044.2 +087100 PERFORM PRINT-DETAIL. NC1044.2 +087200 MOVE-INIT-F1-22. NC1044.2 +087300 MOVE 123.45 TO MOVE23. NC1044.2 +087400 MOVE "MOVE NUM NON-INTEGER" TO FEATURE. NC1044.2 +087500 MOVE-TEST-F1-22-0. NC1044.2 +087600 MOVE MOVE23 TO MOVE4. NC1044.2 +087700 MOVE-TEST-F1-22-1. NC1044.2 +087800 IF MOVE4 EQUAL TO 0000123 NC1044.2 +087900 PERFORM PASS NC1044.2 +088000 ELSE NC1044.2 +088100 GO TO MOVE-FAIL-F1-22. NC1044.2 +088200* NOTE NNI TO NI MOVE, ZERO PADDING ON LEFT, TRUNCATION. NC1044.2 +088300 GO TO MOVE-WRITE-F1-22. NC1044.2 +088400 MOVE-DELETE-F1-22. NC1044.2 +088500 PERFORM DE-LETE. NC1044.2 +088600 GO TO MOVE-WRITE-F1-22. NC1044.2 +088700 MOVE-FAIL-F1-22. NC1044.2 +088800 MOVE MOVE23 TO COMPUTED-N. NC1044.2 +088900 MOVE 0000123 TO CORRECT-N. NC1044.2 +089000 PERFORM FAIL. NC1044.2 +089100 MOVE-WRITE-F1-22. NC1044.2 +089200 MOVE "MOVE-TEST-F1-22" TO PAR-NAME. NC1044.2 +089300 PERFORM PRINT-DETAIL. NC1044.2 +089400 MOVE-INIT-F1-23. NC1044.2 +089500 MOVE 123.45 TO MOVE23. NC1044.2 +089600 MOVE-TEST-F1-23-0. NC1044.2 +089700 MOVE MOVE23 TO MOVE25. NC1044.2 +089800 MOVE-TEST-F1-23-1. NC1044.2 +089900 IF MOVE25 EQUAL TO 123 NC1044.2 +090000 PERFORM PASS NC1044.2 +090100 ELSE NC1044.2 +090200 GO TO MOVE-FAIL-F1-23. NC1044.2 +090300* NOTE NNI TO NI MOVE, TRUNCATION ON RIGHT. NC1044.2 +090400 GO TO MOVE-WRITE-F1-23. NC1044.2 +090500 MOVE-DELETE-F1-23. NC1044.2 +090600 PERFORM DE-LETE. NC1044.2 +090700 GO TO MOVE-WRITE-F1-23. NC1044.2 +090800 MOVE-FAIL-F1-23. NC1044.2 +090900 MOVE MOVE25 TO COMPUTED-N. NC1044.2 +091000 MOVE 123 TO CORRECT-N. NC1044.2 +091100 PERFORM FAIL. NC1044.2 +091200 MOVE-WRITE-F1-23. NC1044.2 +091300 MOVE "MOVE-TEST-F1-23" TO PAR-NAME. NC1044.2 +091400 PERFORM PRINT-DETAIL. NC1044.2 +091500 MOVE-INIT-F1-24. NC1044.2 +091600 MOVE 123.45 TO MOVE23. NC1044.2 +091700 MOVE-TEST-F1-24-0. NC1044.2 +091800 MOVE MOVE23 TO MOVE3. NC1044.2 +091900 MOVE-TEST-F1-24-1. NC1044.2 +092000 IF MOVE3 EQUAL TO 23 NC1044.2 +092100 PERFORM PASS NC1044.2 +092200 ELSE NC1044.2 +092300 GO TO MOVE-FAIL-F1-24. NC1044.2 +092400* NOTE NNI TO NI MOVE, TRUNCATION LEFT AND RIGHT. NC1044.2 +092500 GO TO MOVE-WRITE-F1-24. NC1044.2 +092600 MOVE-DELETE-F1-24. NC1044.2 +092700 PERFORM DE-LETE. NC1044.2 +092800 GO TO MOVE-WRITE-F1-24. NC1044.2 +092900 MOVE-FAIL-F1-24. NC1044.2 +093000 MOVE MOVE3 TO COMPUTED-N. NC1044.2 +093100 MOVE 23 TO CORRECT-N. NC1044.2 +093200 PERFORM FAIL. NC1044.2 +093300 MOVE-WRITE-F1-24. NC1044.2 +093400 MOVE "MOVE-TEST-F1-24" TO PAR-NAME. NC1044.2 +093500 PERFORM PRINT-DETAIL. NC1044.2 +093600 MOVE-INIT-F1-25. NC1044.2 +093700 MOVE 123.45 TO MOVE23. NC1044.2 +093800 MOVE-TEST-F1-25-0. NC1044.2 +093900 MOVE MOVE23 TO MOVE27. NC1044.2 +094000 MOVE-TEST-F1-25-1. NC1044.2 +094100 IF MOVE27 EQUAL TO 0100 NC1044.2 +094200 PERFORM PASS NC1044.2 +094300 ELSE NC1044.2 +094400 GO TO MOVE-FAIL-F1-25. NC1044.2 +094500* NOTE NNI TO NNI MOVE, SCALING. NC1044.2 +094600 GO TO MOVE-WRITE-F1-25. NC1044.2 +094700 MOVE-DELETE-F1-25. NC1044.2 +094800 PERFORM DE-LETE. NC1044.2 +094900 GO TO MOVE-WRITE-F1-25. NC1044.2 +095000 MOVE-FAIL-F1-25. NC1044.2 +095100 MOVE MOVE27 TO COMPUTED-N. NC1044.2 +095200 MOVE 0100 TO CORRECT-N. NC1044.2 +095300 PERFORM FAIL. NC1044.2 +095400 MOVE-WRITE-F1-25. NC1044.2 +095500 MOVE "MOVE-TEST-F1-25" TO PAR-NAME. NC1044.2 +095600 PERFORM PRINT-DETAIL. NC1044.2 +095700 MOVE-INIT-F1-26. NC1044.2 +095800 MOVE 123.45 TO MOVE23. NC1044.2 +095900 MOVE-TEST-F1-26-0. NC1044.2 +096000 MOVE MOVE23 TO MOVE6. NC1044.2 +096100 MOVE-TEST-F1-26-1. NC1044.2 +096200 IF MOVE6 EQUAL TO .45000 NC1044.2 +096300 PERFORM PASS NC1044.2 +096400 ELSE NC1044.2 +096500 GO TO MOVE-FAIL-F1-26. NC1044.2 +096600* NOTE NNI TO NNI MOVE, TRUNCATION ON LEFT AND ZERO NC1044.2 +096700* FILL ON RIGHT. NC1044.2 +096800 GO TO MOVE-WRITE-F1-26. NC1044.2 +096900 MOVE-DELETE-F1-26. NC1044.2 +097000 PERFORM DE-LETE. NC1044.2 +097100 GO TO MOVE-WRITE-F1-26. NC1044.2 +097200 MOVE-FAIL-F1-26. NC1044.2 +097300 MOVE MOVE6 TO COMPUTED-N. NC1044.2 +097400 MOVE .45000 TO CORRECT-N. NC1044.2 +097500 PERFORM FAIL. NC1044.2 +097600 MOVE-WRITE-F1-26. NC1044.2 +097700 MOVE "MOVE-TEST-F1-26" TO PAR-NAME. NC1044.2 +097800 PERFORM PRINT-DETAIL. NC1044.2 +097900 MOVE-INIT-F1-27. NC1044.2 +098000 MOVE 123.45 TO MOVE23. NC1044.2 +098100 MOVE-TEST-F1-27-0. NC1044.2 +098200 MOVE MOVE23 TO MOVE29. NC1044.2 +098300 MOVE-TEST-F1-27-1. NC1044.2 +098400 IF MOVE29 EQUAL TO 0123.450 NC1044.2 +098500 PERFORM PASS NC1044.2 +098600 ELSE NC1044.2 +098700 GO TO MOVE-FAIL-F1-27. NC1044.2 +098800* NOTE NNI TO NNI MOVE, ZERO PADDING ON LEFT AND RIGHT. NC1044.2 +098900 GO TO MOVE-WRITE-F1-27. NC1044.2 +099000 MOVE-DELETE-F1-27. NC1044.2 +099100 PERFORM DE-LETE. NC1044.2 +099200 GO TO MOVE-WRITE-F1-27. NC1044.2 +099300 MOVE-FAIL-F1-27. NC1044.2 +099400 MOVE MOVE29 TO COMPUTED-N. NC1044.2 +099500 MOVE 0123.450 TO CORRECT-N. NC1044.2 +099600 PERFORM FAIL. NC1044.2 +099700 MOVE-WRITE-F1-27. NC1044.2 +099800 MOVE "MOVE-TEST-F1-27" TO PAR-NAME. NC1044.2 +099900 PERFORM PRINT-DETAIL. NC1044.2 +100000 MOVE-INIT-F1-28. NC1044.2 +100100 MOVE 123.45 TO MOVE23. NC1044.2 +100200 MOVE-TEST-F1-28-0. NC1044.2 +100300 MOVE MOVE23 TO MOVE11. NC1044.2 +100400 MOVE-TEST-F1-28-1. NC1044.2 +100500 IF MOVE11 EQUAL TO "$00,123.45" NC1044.2 +100600 PERFORM PASS NC1044.2 +100700 ELSE NC1044.2 +100800 GO TO MOVE-FAIL-F1-28. NC1044.2 +100900* NOTE NNI TO NE MOVE, FIXED INSERTION, ZERO PADDING ON LEFT. NC1044.2 +101000 GO TO MOVE-WRITE-F1-28. NC1044.2 +101100 MOVE-DELETE-F1-28. NC1044.2 +101200 PERFORM DE-LETE. NC1044.2 +101300 GO TO MOVE-WRITE-F1-28. NC1044.2 +101400 MOVE-FAIL-F1-28. NC1044.2 +101500 MOVE MOVE11 TO COMPUTED-A. NC1044.2 +101600 MOVE "$00,123.45" TO CORRECT-A. NC1044.2 +101700 PERFORM FAIL. NC1044.2 +101800 MOVE-WRITE-F1-28. NC1044.2 +101900 MOVE "MOVE-TEST-F1-28" TO PAR-NAME. NC1044.2 +102000 PERFORM PRINT-DETAIL. NC1044.2 +102100 MOVE-INIT-F1-29. NC1044.2 +102200 MOVE 123.45 TO MOVE23. NC1044.2 +102300 MOVE-TEST-F1-29-0. NC1044.2 +102400 MOVE MOVE30 TO MOVE21. NC1044.2 +102500 MOVE-TEST-F1-29-1. NC1044.2 +102600 IF MOVE21 EQUAL TO "$123.45" NC1044.2 +102700 PERFORM PASS NC1044.2 +102800 ELSE NC1044.2 +102900 GO TO MOVE-FAIL-F1-29. NC1044.2 +103000* NOTE NE TO AN MOVE, EQUAL SIZE. NC1044.2 +103100 GO TO MOVE-WRITE-F1-29. NC1044.2 +103200 MOVE-DELETE-F1-29. NC1044.2 +103300 PERFORM DE-LETE. NC1044.2 +103400 GO TO MOVE-WRITE-F1-29. NC1044.2 +103500 MOVE-FAIL-F1-29. NC1044.2 +103600 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +103700 MOVE "$123.45" TO CORRECT-A. NC1044.2 +103800 PERFORM FAIL. NC1044.2 +103900 MOVE-WRITE-F1-29. NC1044.2 +104000 MOVE "MOVE-TEST-F1-29" TO PAR-NAME. NC1044.2 +104100 PERFORM PRINT-DETAIL. NC1044.2 +104200 MOVE-INIT-F1-30. NC1044.2 +104300 MOVE "$123.45" TO MOVE29A. NC1044.2 +104400 MOVE-TEST-F1-30-0. NC1044.2 +104500 MOVE MOVE30 TO MOVE31. NC1044.2 +104600 MOVE-TEST-F1-30-1. NC1044.2 +104700 IF MOVE31 EQUAL TO "$123.45 " NC1044.2 +104800 PERFORM PASS NC1044.2 +104900 ELSE NC1044.2 +105000 GO TO MOVE-FAIL-F1-30. NC1044.2 +105100* NOTE NE TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +105200 GO TO MOVE-WRITE-F1-30. NC1044.2 +105300 MOVE-DELETE-F1-30. NC1044.2 +105400 PERFORM DE-LETE. NC1044.2 +105500 GO TO MOVE-WRITE-F1-30. NC1044.2 +105600 MOVE-FAIL-F1-30. NC1044.2 +105700 MOVE MOVE31 TO COMPUTED-A. NC1044.2 +105800 MOVE "$123.45 " TO CORRECT-A. NC1044.2 +105900 PERFORM FAIL. NC1044.2 +106000 MOVE-WRITE-F1-30. NC1044.2 +106100 MOVE "MOVE-TEST-F1-30" TO PAR-NAME. NC1044.2 +106200 PERFORM PRINT-DETAIL. NC1044.2 +106300 MOVE-INIT-F1-31. NC1044.2 +106400 MOVE "$123.45" TO MOVE29A. NC1044.2 +106500 MOVE-TEST-F1-31-0. NC1044.2 +106600 MOVE MOVE30 TO MOVE20. NC1044.2 +106700 MOVE-TEST-F1-31-1. NC1044.2 +106800 IF MOVE20 EQUAL TO "$123" NC1044.2 +106900 PERFORM PASS NC1044.2 +107000 ELSE NC1044.2 +107100 GO TO MOVE-FAIL-F1-31. NC1044.2 +107200* NOTE NE TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +107300 GO TO MOVE-WRITE-F1-31. NC1044.2 +107400 MOVE-DELETE-F1-31. NC1044.2 +107500 PERFORM DE-LETE. NC1044.2 +107600 GO TO MOVE-WRITE-F1-31. NC1044.2 +107700 MOVE-FAIL-F1-31. NC1044.2 +107800 MOVE MOVE20 TO COMPUTED-A. NC1044.2 +107900 MOVE "$123" TO CORRECT-A. NC1044.2 +108000 PERFORM FAIL. NC1044.2 +108100 MOVE-WRITE-F1-31. NC1044.2 +108200 MOVE "MOVE-TEST-F1-31" TO PAR-NAME. NC1044.2 +108300 PERFORM PRINT-DETAIL. NC1044.2 +108400 MOVE-INIT-F1-32. NC1044.2 +108500 MOVE "$123.45" TO MOVE29A. NC1044.2 +108600 MOVE-TEST-F1-32-0. NC1044.2 +108700 MOVE MOVE30 TO MOVE24. NC1044.2 +108800 MOVE-TEST-F1-32-1. NC1044.2 +108900 IF MOVE24 EQUAL TO "$ 123 000.45 " NC1044.2 +109000 PERFORM PASS NC1044.2 +109100 ELSE NC1044.2 +109200 GO TO MOVE-FAIL-F1-32. NC1044.2 +109300* NOTE NE TO AE MOVE, SPACE AND ZERO INSERTION. NC1044.2 +109400 GO TO MOVE-WRITE-F1-32. NC1044.2 +109500 MOVE-DELETE-F1-32. NC1044.2 +109600 PERFORM DE-LETE. NC1044.2 +109700 GO TO MOVE-WRITE-F1-32. NC1044.2 +109800 MOVE-FAIL-F1-32. NC1044.2 +109900 MOVE MOVE24 TO COMPUTED-A. NC1044.2 +110000 MOVE "$ 123 000.45 " TO CORRECT-A. NC1044.2 +110100 PERFORM FAIL. NC1044.2 +110200 MOVE-WRITE-F1-32. NC1044.2 +110300 MOVE "MOVE-TEST-F1-32" TO PAR-NAME. NC1044.2 +110400 PERFORM PRINT-DETAIL. NC1044.2 +110500 MOVE-INIT-F1-33. NC1044.2 +110600 MOVE "MOVE ALPHANUMERIC " TO FEATURE. NC1044.2 +110700 MOVE "12345" TO MOVE50. NC1044.2 +110800 MOVE-TEST-F1-33-0. NC1044.2 +110900 MOVE MOVE50 TO MOVE2. NC1044.2 +111000 MOVE-TEST-F1-33-1. NC1044.2 +111100 IF MOVE2 EQUAL TO 12345 NC1044.2 +111200 PERFORM PASS NC1044.2 +111300 ELSE NC1044.2 +111400 GO TO MOVE-FAIL-F1-33. NC1044.2 +111500* NOTE AN TO NI MOVE, EQUAL SIZE. NC1044.2 +111600 GO TO MOVE-WRITE-F1-33. NC1044.2 +111700 MOVE-DELETE-F1-33. NC1044.2 +111800 PERFORM DE-LETE. NC1044.2 +111900 GO TO MOVE-WRITE-F1-33. NC1044.2 +112000 MOVE-FAIL-F1-33. NC1044.2 +112100 MOVE MOVE2 TO COMPUTED-N. NC1044.2 +112200 MOVE 12345 TO CORRECT-N. NC1044.2 +112300 PERFORM FAIL. NC1044.2 +112400 MOVE-WRITE-F1-33. NC1044.2 +112500 MOVE "MOVE-TEST-F1-33" TO PAR-NAME. NC1044.2 +112600 PERFORM PRINT-DETAIL. NC1044.2 +112700 MOVE-INIT-F1-34. NC1044.2 +112800 MOVE "12345" TO MOVE50. NC1044.2 +112900 MOVE-TEST-F1-34-0. NC1044.2 +113000 MOVE MOVE50 TO MOVE4. NC1044.2 +113100 MOVE-TEST-F1-34-1. NC1044.2 +113200 IF MOVE4 EQUAL TO 0012345 NC1044.2 +113300 PERFORM PASS NC1044.2 +113400 ELSE NC1044.2 +113500 GO TO MOVE-FAIL-F1-34. NC1044.2 +113600* NOTE AN TO NI MOVE, ZERO PADDING ON LEFT. NC1044.2 +113700 GO TO MOVE-WRITE-F1-34. NC1044.2 +113800 MOVE-DELETE-F1-34. NC1044.2 +113900 PERFORM DE-LETE. NC1044.2 +114000 GO TO MOVE-WRITE-F1-34. NC1044.2 +114100 MOVE-FAIL-F1-34. NC1044.2 +114200 MOVE MOVE4 TO COMPUTED-N. NC1044.2 +114300 MOVE 0012345 TO CORRECT-N. NC1044.2 +114400 PERFORM FAIL. NC1044.2 +114500 MOVE-WRITE-F1-34. NC1044.2 +114600 MOVE "MOVE-TEST-F1-34" TO PAR-NAME. NC1044.2 +114700 PERFORM PRINT-DETAIL. NC1044.2 +114800 MOVE-INIT-F1-35. NC1044.2 +114900 MOVE "12345" TO MOVE50. NC1044.2 +115000 MOVE-TEST-F1-35-0. NC1044.2 +115100 MOVE MOVE50 TO MOVE3. NC1044.2 +115200 MOVE-TEST-F1-35-1. NC1044.2 +115300 IF MOVE3 EQUAL TO 45 NC1044.2 +115400 PERFORM PASS NC1044.2 +115500 ELSE NC1044.2 +115600 GO TO MOVE-FAIL-F1-35. NC1044.2 +115700* NOTE AN TO NI MOVE, TRUNCATION ON LEFT. NC1044.2 +115800 GO TO MOVE-WRITE-F1-35. NC1044.2 +115900 MOVE-DELETE-F1-35. NC1044.2 +116000 PERFORM DE-LETE. NC1044.2 +116100 GO TO MOVE-WRITE-F1-35. NC1044.2 +116200 MOVE-FAIL-F1-35. NC1044.2 +116300 MOVE MOVE50 TO COMPUTED-N. NC1044.2 +116400 MOVE 45 TO CORRECT-N. NC1044.2 +116500 PERFORM FAIL. NC1044.2 +116600 MOVE-WRITE-F1-35. NC1044.2 +116700 MOVE "MOVE-TEST-F1-35" TO PAR-NAME. NC1044.2 +116800 PERFORM PRINT-DETAIL. NC1044.2 +116900 MOVE-INIT-F1-36. NC1044.2 +117000 MOVE "12345" TO MOVE50. NC1044.2 +117100 MOVE-TEST-F1-36-0. NC1044.2 +117200 MOVE MOVE50 TO MOVE26. NC1044.2 +117300 MOVE-TEST-F1-36-1. NC1044.2 +117400 IF MOVE26 EQUAL TO 345.00 NC1044.2 +117500 PERFORM PASS NC1044.2 +117600 ELSE NC1044.2 +117700 GO TO MOVE-FAIL-F1-36. NC1044.2 +117800* NOTE AN TO NNI MOVE, ZERO FILL RIGHT, TRUNCATION LEFT. NC1044.2 +117900 GO TO MOVE-WRITE-F1-36. NC1044.2 +118000 MOVE-DELETE-F1-36. NC1044.2 +118100 PERFORM DE-LETE. NC1044.2 +118200 GO TO MOVE-WRITE-F1-36. NC1044.2 +118300 MOVE-FAIL-F1-36. NC1044.2 +118400 MOVE MOVE26 TO COMPUTED-N. NC1044.2 +118500 MOVE 345.00 TO CORRECT-N. NC1044.2 +118600 PERFORM FAIL. NC1044.2 +118700 MOVE-WRITE-F1-36. NC1044.2 +118800 MOVE "MOVE-TEST-F1-36" TO PAR-NAME. NC1044.2 +118900 PERFORM PRINT-DETAIL. NC1044.2 +119000 MOVE-INIT-F1-37. NC1044.2 +119100 MOVE "12345" TO MOVE50. NC1044.2 +119200 MOVE-TEST-F1-37-0. NC1044.2 +119300 MOVE MOVE50 TO MOVE9. NC1044.2 +119400 MOVE-TEST-F1-37-1. NC1044.2 +119500 IF MOVE9 EQUAL TO 0012345.00 NC1044.2 +119600 PERFORM PASS NC1044.2 +119700 ELSE NC1044.2 +119800 GO TO MOVE-FAIL-F1-37. NC1044.2 +119900* NOTE AN TO NNI MOVE, ZERO PADDING LEFT AND RIGHT. NC1044.2 +120000 GO TO MOVE-WRITE-F1-37. NC1044.2 +120100 MOVE-DELETE-F1-37. NC1044.2 +120200 PERFORM DE-LETE. NC1044.2 +120300 GO TO MOVE-WRITE-F1-37. NC1044.2 +120400 MOVE-FAIL-F1-37. NC1044.2 +120500 MOVE MOVE9 TO COMPUTED-N. NC1044.2 +120600 MOVE 0012345.00 TO CORRECT-N. NC1044.2 +120700 PERFORM FAIL. NC1044.2 +120800 MOVE-WRITE-F1-37. NC1044.2 +120900 MOVE "MOVE-TEST-F1-37" TO PAR-NAME. NC1044.2 +121000 PERFORM PRINT-DETAIL. NC1044.2 +121100 MOVE-INIT-F1-38. NC1044.2 +121200 MOVE "12345" TO MOVE50. NC1044.2 +121300 MOVE-TEST-F1-38-0. NC1044.2 +121400 MOVE MOVE50 TO MOVE16. NC1044.2 +121500 MOVE-TEST-F1-38-1. NC1044.2 +121600 IF MOVE16 EQUAL TO "12345 " NC1044.2 +121700 PERFORM PASS NC1044.2 +121800 ELSE NC1044.2 +121900 GO TO MOVE-FAIL-F1-38. NC1044.2 +122000* NOTE AN TO NE WITH CR SYMBOL. NC1044.2 +122100 GO TO MOVE-WRITE-F1-38. NC1044.2 +122200 MOVE-DELETE-F1-38. NC1044.2 +122300 PERFORM DE-LETE. NC1044.2 +122400 GO TO MOVE-WRITE-F1-38. NC1044.2 +122500 MOVE-FAIL-F1-38. NC1044.2 +122600 MOVE MOVE16 TO COMPUTED-A. NC1044.2 +122700 MOVE "12345 " TO CORRECT-A. NC1044.2 +122800 PERFORM FAIL. NC1044.2 +122900 MOVE-WRITE-F1-38. NC1044.2 +123000 MOVE "MOVE-TEST-F1-38" TO PAR-NAME. NC1044.2 +123100 PERFORM PRINT-DETAIL. NC1044.2 +123200 MOVE-INIT-F1-39. NC1044.2 +123300 MOVE "12345" TO MOVE50. NC1044.2 +123400 MOVE-TEST-F1-39-0. NC1044.2 +123500 MOVE MOVE50 TO MOVE11. NC1044.2 +123600 MOVE-TEST-F1-39-1. NC1044.2 +123700 IF MOVE11 EQUAL TO "$12,345.00" NC1044.2 +123800 PERFORM PASS NC1044.2 +123900 ELSE NC1044.2 +124000 GO TO MOVE-FAIL-F1-39. NC1044.2 +124100* NOTE AN TO NNI MOVE, INSERTION CHARACTERS AND ZERO PADDING NC1044.2 +124200* ON RIGHT. NC1044.2 +124300 GO TO MOVE-WRITE-F1-39. NC1044.2 +124400 MOVE-DELETE-F1-39. NC1044.2 +124500 PERFORM DE-LETE. NC1044.2 +124600 GO TO MOVE-WRITE-F1-39. NC1044.2 +124700 MOVE-FAIL-F1-39. NC1044.2 +124800 MOVE MOVE11 TO COMPUTED-A. NC1044.2 +124900 MOVE "$12,345.00" TO CORRECT-A. NC1044.2 +125000 PERFORM FAIL. NC1044.2 +125100 MOVE-WRITE-F1-39. NC1044.2 +125200 MOVE "MOVE-TEST-F1-39" TO PAR-NAME. NC1044.2 +125300 PERFORM PRINT-DETAIL. NC1044.2 +125400 MOVE-INIT-F1-40. NC1044.2 +125500 MOVE "ABCDE" TO MOVE32. NC1044.2 +125600 MOVE-TEST-F1-40-0. NC1044.2 +125700 MOVE MOVE32 TO MOVE21. NC1044.2 +125800 MOVE-TEST-F1-40-1. NC1044.2 +125900 IF MOVE21 EQUAL TO "ABCDE " NC1044.2 +126000 PERFORM PASS NC1044.2 +126100 ELSE NC1044.2 +126200 GO TO MOVE-FAIL-F1-40. NC1044.2 +126300* NOTE AN TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +126400 GO TO MOVE-WRITE-F1-40. NC1044.2 +126500 MOVE-DELETE-F1-40. NC1044.2 +126600 PERFORM DE-LETE. NC1044.2 +126700 GO TO MOVE-WRITE-F1-40. NC1044.2 +126800 MOVE-FAIL-F1-40. NC1044.2 +126900 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +127000 MOVE "ABCDE " TO CORRECT-A. NC1044.2 +127100 PERFORM FAIL. NC1044.2 +127200 MOVE-WRITE-F1-40. NC1044.2 +127300 MOVE "MOVE-TEST-F1-40" TO PAR-NAME. NC1044.2 +127400 PERFORM PRINT-DETAIL. NC1044.2 +127500 MOVE-INIT-F1-41. NC1044.2 +127600 MOVE "ABCDE" TO MOVE32. NC1044.2 +127700 MOVE-TEST-F1-41-0. NC1044.2 +127800 MOVE MOVE32 TO MOVE20. NC1044.2 +127900 MOVE-TEST-F1-41-1. NC1044.2 +128000 IF MOVE20 EQUAL TO "ABCD" NC1044.2 +128100 PERFORM PASS NC1044.2 +128200 ELSE NC1044.2 +128300 GO TO MOVE-FAIL-F1-41. NC1044.2 +128400* NOTE AN TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +128500 GO TO MOVE-WRITE-F1-41. NC1044.2 +128600 MOVE-DELETE-F1-41. NC1044.2 +128700 PERFORM DE-LETE. NC1044.2 +128800 GO TO MOVE-WRITE-F1-41. NC1044.2 +128900 MOVE-FAIL-F1-41. NC1044.2 +129000 MOVE MOVE20 TO COMPUTED-A. NC1044.2 +129100 MOVE "ABCD" TO CORRECT-A. NC1044.2 +129200 PERFORM FAIL. NC1044.2 +129300 MOVE-WRITE-F1-41. NC1044.2 +129400 MOVE "MOVE-TEST-F1-41" TO PAR-NAME. NC1044.2 +129500 PERFORM PRINT-DETAIL. NC1044.2 +129600 MOVE-INIT-F1-42. NC1044.2 +129700 MOVE "ABCDE" TO MOVE32. NC1044.2 +129800 MOVE-TEST-F1-42-0. NC1044.2 +129900 MOVE MOVE32 TO MOVE22. NC1044.2 +130000 MOVE-TEST-F1-42-1. NC1044.2 +130100 IF MOVE22 EQUAL TO "A B0C D0E" NC1044.2 +130200 PERFORM PASS NC1044.2 +130300 ELSE NC1044.2 +130400 GO TO MOVE-FAIL-F1-42. NC1044.2 +130500* NOTE AN TO AE MOVE, ZERO AND SPACE INSERTION. NC1044.2 +130600 GO TO MOVE-WRITE-F1-42. NC1044.2 +130700 MOVE-DELETE-F1-42. NC1044.2 +130800 PERFORM DE-LETE. NC1044.2 +130900 GO TO MOVE-WRITE-F1-42. NC1044.2 +131000 MOVE-FAIL-F1-42. NC1044.2 +131100 MOVE MOVE22 TO COMPUTED-A. NC1044.2 +131200 MOVE "A B0C D0E" TO CORRECT-A. NC1044.2 +131300 PERFORM FAIL. NC1044.2 +131400 MOVE-WRITE-F1-42. NC1044.2 +131500 MOVE "MOVE-TEST-F1-42" TO PAR-NAME. NC1044.2 +131600 PERFORM PRINT-DETAIL. NC1044.2 +131700 MOVE-INIT-F1-43. NC1044.2 +131800 MOVE "ABCDE" TO MOVE32. NC1044.2 +131900 MOVE-TEST-F1-43-0. NC1044.2 +132000 MOVE MOVE32 TO MOVE33. NC1044.2 +132100 MOVE-TEST-F1-43-1. NC1044.2 +132200 IF MOVE33 EQUAL TO "ABCDE" NC1044.2 +132300 PERFORM PASS NC1044.2 +132400 ELSE NC1044.2 +132500 GO TO MOVE-FAIL-F1-43. NC1044.2 +132600* NOTE AN TO A MOVE, EQUAL SIZE. NC1044.2 +132700 GO TO MOVE-WRITE-F1-43. NC1044.2 +132800 MOVE-DELETE-F1-43. NC1044.2 +132900 PERFORM DE-LETE. NC1044.2 +133000 GO TO MOVE-WRITE-F1-43. NC1044.2 +133100 MOVE-FAIL-F1-43. NC1044.2 +133200 MOVE MOVE33 TO COMPUTED-A. NC1044.2 +133300 MOVE "ABCDE" TO CORRECT-A. NC1044.2 +133400 PERFORM FAIL. NC1044.2 +133500 MOVE-WRITE-F1-43. NC1044.2 +133600 MOVE "MOVE-TEST-F1-43" TO PAR-NAME. NC1044.2 +133700 PERFORM PRINT-DETAIL. NC1044.2 +133800 MOVE-INIT-F1-44. NC1044.2 +133900 MOVE "ABCDE" TO MOVE32. NC1044.2 +134000 MOVE-TEST-F1-44-0. NC1044.2 +134100 MOVE MOVE32 TO MOVE34. NC1044.2 +134200 MOVE-TEST-F1-44-1. NC1044.2 +134300 IF MOVE34 EQUAL TO "ABCDE " NC1044.2 +134400 PERFORM PASS NC1044.2 +134500 ELSE NC1044.2 +134600 GO TO MOVE-FAIL-F1-44. NC1044.2 +134700* NOTE AN TO A MOVE, SPACE PADDING ON RIGHT. NC1044.2 +134800 GO TO MOVE-WRITE-F1-44. NC1044.2 +134900 MOVE-DELETE-F1-44. NC1044.2 +135000 PERFORM DE-LETE. NC1044.2 +135100 GO TO MOVE-WRITE-F1-44. NC1044.2 +135200 MOVE-FAIL-F1-44. NC1044.2 +135300 MOVE MOVE34 TO COMPUTED-A. NC1044.2 +135400 MOVE "ABCDE " TO CORRECT-A. NC1044.2 +135500 PERFORM FAIL. NC1044.2 +135600 MOVE-WRITE-F1-44. NC1044.2 +135700 MOVE "MOVE-TEST-F1-44" TO PAR-NAME. NC1044.2 +135800 PERFORM PRINT-DETAIL. NC1044.2 +135900 MOVE-INIT-F1-45. NC1044.2 +136000 MOVE "ABCDE" TO MOVE32. NC1044.2 +136100 MOVE-TEST-F1-45-0. NC1044.2 +136200 MOVE MOVE32 TO MOVE35. NC1044.2 +136300 MOVE-TEST-F1-45-1. NC1044.2 +136400 IF MOVE35 EQUAL TO "ABC" NC1044.2 +136500 PERFORM PASS NC1044.2 +136600 ELSE NC1044.2 +136700 GO TO MOVE-FAIL-F1-45. NC1044.2 +136800* NOTE AN TO A MOVE, TRUNCATION ON RIGHT. NC1044.2 +136900 GO TO MOVE-WRITE-F1-45. NC1044.2 +137000 MOVE-DELETE-F1-45. NC1044.2 +137100 PERFORM DE-LETE. NC1044.2 +137200 GO TO MOVE-WRITE-F1-45. NC1044.2 +137300 MOVE-FAIL-F1-45. NC1044.2 +137400 MOVE MOVE35 TO COMPUTED-A. NC1044.2 +137500 MOVE "ABC" TO CORRECT-A. NC1044.2 +137600 PERFORM FAIL. NC1044.2 +137700 MOVE-WRITE-F1-45. NC1044.2 +137800 MOVE "MOVE-TEST-F1-45" TO PAR-NAME. NC1044.2 +137900 PERFORM PRINT-DETAIL. NC1044.2 +138000 MOVE-INIT-F1-46. NC1044.2 +138100 MOVE "1 A05" TO MOVE35A. NC1044.2 +138200 MOVE-TEST-F1-46-0. NC1044.2 +138300 MOVE MOVE36 TO MOVE21. NC1044.2 +138400 MOVE-TEST-F1-46-1. NC1044.2 +138500 IF MOVE21 EQUAL TO "1 A05 " NC1044.2 +138600 PERFORM PASS NC1044.2 +138700 ELSE NC1044.2 +138800 GO TO MOVE-FAIL-F1-46. NC1044.2 +138900* NOTE AE TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +139000 GO TO MOVE-WRITE-F1-46. NC1044.2 +139100 MOVE-DELETE-F1-46. NC1044.2 +139200 PERFORM DE-LETE. NC1044.2 +139300 GO TO MOVE-WRITE-F1-46. NC1044.2 +139400 MOVE-FAIL-F1-46. NC1044.2 +139500 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +139600 MOVE "1 A05 " TO CORRECT-A. NC1044.2 +139700 PERFORM FAIL. NC1044.2 +139800 MOVE-WRITE-F1-46. NC1044.2 +139900 MOVE "MOVE-TEST-F1-46" TO PAR-NAME. NC1044.2 +140000 PERFORM PRINT-DETAIL. NC1044.2 +140100 MOVE-INIT-F1-47. NC1044.2 +140200 MOVE "1 A05" TO MOVE35A. NC1044.2 +140300 MOVE-TEST-F1-47-0. NC1044.2 +140400 MOVE MOVE36 TO MOVE20. NC1044.2 +140500 MOVE-TEST-F1-47-1. NC1044.2 +140600 IF MOVE20 EQUAL TO "1 A0" NC1044.2 +140700 PERFORM PASS NC1044.2 +140800 ELSE NC1044.2 +140900 GO TO MOVE-FAIL-F1-47. NC1044.2 +141000* NOTE AE TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +141100 GO TO MOVE-WRITE-F1-47. NC1044.2 +141200 MOVE-DELETE-F1-47. NC1044.2 +141300 PERFORM DE-LETE. NC1044.2 +141400 GO TO MOVE-WRITE-F1-47. NC1044.2 +141500 MOVE-FAIL-F1-47. NC1044.2 +141600 MOVE MOVE20 TO COMPUTED-A. NC1044.2 +141700 MOVE "1 A0" TO CORRECT-A. NC1044.2 +141800 PERFORM FAIL. NC1044.2 +141900 MOVE-WRITE-F1-47. NC1044.2 +142000 MOVE "MOVE-TEST-F1-47" TO PAR-NAME. NC1044.2 +142100 PERFORM PRINT-DETAIL. NC1044.2 +142200 MOVE-INIT-F1-48. NC1044.2 +142300 MOVE "1 A05" TO MOVE35A. NC1044.2 +142400 MOVE-TEST-F1-48-0. NC1044.2 +142500 MOVE MOVE36 TO MOVE39. NC1044.2 +142600 MOVE-TEST-F1-48-1. NC1044.2 +142700 IF MOVE39 EQUAL TO "01 A050" NC1044.2 +142800 PERFORM PASS NC1044.2 +142900 ELSE NC1044.2 +143000 GO TO MOVE-FAIL-F1-48. NC1044.2 +143100* NOTE AE TO AE MOVE, ZERO INSERTION. NC1044.2 +143200 GO TO MOVE-WRITE-F1-48. NC1044.2 +143300 MOVE-DELETE-F1-48. NC1044.2 +143400 PERFORM DE-LETE. NC1044.2 +143500 GO TO MOVE-WRITE-F1-48. NC1044.2 +143600 MOVE-FAIL-F1-48. NC1044.2 +143700 MOVE MOVE39 TO COMPUTED-A. NC1044.2 +143800 MOVE "01 A050" TO CORRECT-A. NC1044.2 +143900 PERFORM FAIL. NC1044.2 +144000 MOVE-WRITE-F1-48. NC1044.2 +144100 MOVE "MOVE-TEST-F1-48" TO PAR-NAME. NC1044.2 +144200 PERFORM PRINT-DETAIL. NC1044.2 +144300 MOVE-INIT-F1-49. NC1044.2 +144400 MOVE "1 A05" TO MOVE35A. NC1044.2 +144500 MOVE-TEST-F1-49-0. NC1044.2 +144600 MOVE MOVE35A TO MOVE33. NC1044.2 +144700 MOVE-TEST-F1-49-1. NC1044.2 +144800 IF MOVE33 EQUAL TO "1 A05" NC1044.2 +144900 PERFORM PASS NC1044.2 +145000 ELSE NC1044.2 +145100 GO TO MOVE-FAIL-F1-49. NC1044.2 +145200* NOTE AE TO A MOVE, EQUAL SIZE. NC1044.2 +145300 GO TO MOVE-WRITE-F1-49. NC1044.2 +145400 MOVE-DELETE-F1-49. NC1044.2 +145500 PERFORM DE-LETE. NC1044.2 +145600 GO TO MOVE-WRITE-F1-49. NC1044.2 +145700 MOVE-FAIL-F1-49. NC1044.2 +145800 MOVE MOVE33 TO COMPUTED-A. NC1044.2 +145900 MOVE "1 A05" TO CORRECT-A. NC1044.2 +146000 PERFORM FAIL. NC1044.2 +146100 MOVE-WRITE-F1-49. NC1044.2 +146200 MOVE "MOVE-TEST-F1-49" TO PAR-NAME. NC1044.2 +146300 PERFORM PRINT-DETAIL. NC1044.2 +146400 MOVE-INIT-F1-50. NC1044.2 +146500 MOVE "1 A05" TO MOVE35A. NC1044.2 +146600 MOVE-TEST-F1-50-0. NC1044.2 +146700 MOVE MOVE35A TO MOVE34. NC1044.2 +146800 MOVE-TEST-F1-50-1. NC1044.2 +146900 IF MOVE34 EQUAL TO "1 A05 " NC1044.2 +147000 PERFORM PASS NC1044.2 +147100 ELSE NC1044.2 +147200 GO TO MOVE-FAIL-F1-50. NC1044.2 +147300* NOTE AE TO A MOVE, SPACE PADDING ON RIGHT. NC1044.2 +147400 GO TO MOVE-WRITE-F1-50. NC1044.2 +147500 MOVE-DELETE-F1-50. NC1044.2 +147600 PERFORM DE-LETE. NC1044.2 +147700 GO TO MOVE-WRITE-F1-50. NC1044.2 +147800 MOVE-FAIL-F1-50. NC1044.2 +147900 MOVE MOVE34 TO COMPUTED-A. NC1044.2 +148000 MOVE "1 A05 " TO CORRECT-A. NC1044.2 +148100 PERFORM FAIL. NC1044.2 +148200 MOVE-WRITE-F1-50. NC1044.2 +148300 MOVE "MOVE-TEST-F1-50" TO PAR-NAME. NC1044.2 +148400 PERFORM PRINT-DETAIL. NC1044.2 +148500 MOVE-INIT-F1-51. NC1044.2 +148600 MOVE "1 A05" TO MOVE35A. NC1044.2 +148700 MOVE-TEST-F1-51-0. NC1044.2 +148800 MOVE MOVE35A TO MOVE35. NC1044.2 +148900 MOVE-TEST-F1-51-1. NC1044.2 +149000 IF MOVE35 EQUAL TO "1 A" NC1044.2 +149100 PERFORM PASS NC1044.2 +149200 ELSE NC1044.2 +149300 GO TO MOVE-FAIL-F1-51. NC1044.2 +149400* NOTE AE TO A MOVE, TRUNCATION ON RIGHT. NC1044.2 +149500 GO TO MOVE-WRITE-F1-51. NC1044.2 +149600 MOVE-DELETE-F1-51. NC1044.2 +149700 PERFORM DE-LETE. NC1044.2 +149800 GO TO MOVE-WRITE-F1-51. NC1044.2 +149900 MOVE-FAIL-F1-51. NC1044.2 +150000 MOVE MOVE35 TO COMPUTED-A. NC1044.2 +150100 MOVE "1 A" TO CORRECT-A. NC1044.2 +150200 PERFORM FAIL. NC1044.2 +150300 MOVE-WRITE-F1-51. NC1044.2 +150400 MOVE "MOVE-TEST-F1-51" TO PAR-NAME. NC1044.2 +150500 PERFORM PRINT-DETAIL. NC1044.2 +150600 MOVE-INIT-F1-52. NC1044.2 +150700 MOVE "ABCDE" TO MOVE37. NC1044.2 +150800 MOVE "MOVE ALPHABETIC " TO FEATURE. NC1044.2 +150900 MOVE-TEST-F1-52-0. NC1044.2 +151000 MOVE MOVE37 TO MOVE21. NC1044.2 +151100 MOVE-TEST-F1-52-1. NC1044.2 +151200 IF MOVE21 EQUAL TO "ABCDE " NC1044.2 +151300 PERFORM PASS NC1044.2 +151400 ELSE NC1044.2 +151500 GO TO MOVE-FAIL-F1-52. NC1044.2 +151600* NOTE A TO AN MOVE, SPACE PADDING ON RIGHT. NC1044.2 +151700 GO TO MOVE-WRITE-F1-52. NC1044.2 +151800 MOVE-DELETE-F1-52. NC1044.2 +151900 PERFORM DE-LETE. NC1044.2 +152000 GO TO MOVE-WRITE-F1-52. NC1044.2 +152100 MOVE-FAIL-F1-52. NC1044.2 +152200 MOVE MOVE21 TO COMPUTED-A. NC1044.2 +152300 MOVE "ABCDE " TO CORRECT-A. NC1044.2 +152400 PERFORM FAIL. NC1044.2 +152500 MOVE-WRITE-F1-52. NC1044.2 +152600 MOVE "MOVE-TEST-F1-52" TO PAR-NAME. NC1044.2 +152700 PERFORM PRINT-DETAIL. NC1044.2 +152800 MOVE-INIT-F1-53. NC1044.2 +152900 MOVE "ABCDE" TO MOVE37. NC1044.2 +153000 MOVE-TEST-F1-53-0. NC1044.2 +153100 MOVE MOVE37 TO MOVE20. NC1044.2 +153200 MOVE-TEST-F1-53-1. NC1044.2 +153300 IF MOVE20 EQUAL TO "ABCD" NC1044.2 +153400 PERFORM PASS NC1044.2 +153500 ELSE NC1044.2 +153600 GO TO MOVE-FAIL-F1-53. NC1044.2 +153700* NOTE A TO AN MOVE, TRUNCATION ON RIGHT. NC1044.2 +153800 GO TO MOVE-WRITE-F1-53. NC1044.2 +153900 MOVE-DELETE-F1-53. NC1044.2 +154000 PERFORM DE-LETE. NC1044.2 +154100 GO TO MOVE-WRITE-F1-53. NC1044.2 +154200 MOVE-FAIL-F1-53. NC1044.2 +154300 MOVE MOVE20 TO COMPUTED-A. NC1044.2 +154400 MOVE "ABCD" TO CORRECT-A. NC1044.2 +154500 PERFORM FAIL. NC1044.2 +154600 MOVE-WRITE-F1-53. NC1044.2 +154700 MOVE "MOVE-TEST-F1-53" TO PAR-NAME. NC1044.2 +154800 PERFORM PRINT-DETAIL. NC1044.2 +154900 MOVE-INIT-F1-54. NC1044.2 +155000 MOVE "ABCDE" TO MOVE37. NC1044.2 +155100 MOVE-TEST-F1-54-0. NC1044.2 +155200 MOVE MOVE37 TO MOVE39. NC1044.2 +155300 MOVE-TEST-F1-54-1. NC1044.2 +155400 IF MOVE39 EQUAL TO "0ABCDE0" NC1044.2 +155500 PERFORM PASS NC1044.2 +155600 ELSE NC1044.2 +155700 GO TO MOVE-FAIL-F1-54. NC1044.2 +155800* NOTE A TO AE MOVE, ZERO INSERTION. NC1044.2 +155900 GO TO MOVE-WRITE-F1-54. NC1044.2 +156000 MOVE-DELETE-F1-54. NC1044.2 +156100 PERFORM DE-LETE. NC1044.2 +156200 GO TO MOVE-WRITE-F1-54. NC1044.2 +156300 MOVE-FAIL-F1-54. NC1044.2 +156400 MOVE MOVE39 TO COMPUTED-A. NC1044.2 +156500 MOVE "0ABCDE0" TO CORRECT-A. NC1044.2 +156600 PERFORM FAIL. NC1044.2 +156700 MOVE-WRITE-F1-54. NC1044.2 +156800 MOVE "MOVE-TEST-F1-54" TO PAR-NAME. NC1044.2 +156900 PERFORM PRINT-DETAIL. NC1044.2 +157000 MOVE-INIT-F1-55. NC1044.2 +157100 MOVE "ABCDE" TO MOVE37. NC1044.2 +157200 MOVE-TEST-F1-55-0. NC1044.2 +157300 MOVE MOVE37 TO MOVE34. NC1044.2 +157400 MOVE-TEST-F1-55-1. NC1044.2 +157500 IF MOVE34 EQUAL TO "ABCDE " NC1044.2 +157600 PERFORM PASS NC1044.2 +157700 ELSE NC1044.2 +157800 GO TO MOVE-FAIL-F1-55. NC1044.2 +157900* NOTE A TO A MOVE, SPACE PADDING ON RIGHT. NC1044.2 +158000 GO TO MOVE-WRITE-F1-55. NC1044.2 +158100 MOVE-DELETE-F1-55. NC1044.2 +158200 PERFORM DE-LETE. NC1044.2 +158300 GO TO MOVE-WRITE-F1-55. NC1044.2 +158400 MOVE-FAIL-F1-55. NC1044.2 +158500 MOVE MOVE4 TO COMPUTED-A. NC1044.2 +158600 MOVE "ABCDE " TO CORRECT-A. NC1044.2 +158700 PERFORM FAIL. NC1044.2 +158800 MOVE-WRITE-F1-55. NC1044.2 +158900 MOVE "MOVE-TEST-F1-55" TO PAR-NAME. NC1044.2 +159000 PERFORM PRINT-DETAIL. NC1044.2 +159100 MOVE-INIT-F1-56. NC1044.2 +159200 MOVE "ABCDE" TO MOVE37. NC1044.2 +159300 MOVE-TEST-F1-56-0. NC1044.2 +159400 MOVE MOVE37 TO MOVE35. NC1044.2 +159500 MOVE-TEST-F1-56-1. NC1044.2 +159600 IF MOVE35 EQUAL TO "ABC" NC1044.2 +159700 PERFORM PASS NC1044.2 +159800 ELSE NC1044.2 +159900 GO TO MOVE-FAIL-F1-56. NC1044.2 +160000* NOTE A TO A MOVE, TRUNCATION ON RIGHT. NC1044.2 +160100 GO TO MOVE-WRITE-F1-56. NC1044.2 +160200 MOVE-DELETE-F1-56. NC1044.2 +160300 PERFORM DE-LETE. NC1044.2 +160400 GO TO MOVE-WRITE-F1-56. NC1044.2 +160500 MOVE-FAIL-F1-56. NC1044.2 +160600 MOVE MOVE35 TO COMPUTED-A. NC1044.2 +160700 MOVE "ABC" TO CORRECT-A. NC1044.2 +160800 PERFORM FAIL. NC1044.2 +160900 MOVE-WRITE-F1-56. NC1044.2 +161000 MOVE "MOVE-TEST-F1-56" TO PAR-NAME. NC1044.2 +161100 PERFORM PRINT-DETAIL. NC1044.2 +161200 NUMERIC-OPERAND-LIMITS-TESTS SECTION. NC1044.2 +161300 MOVE-INIT-F1-57-1. NC1044.2 +161400 MOVE "MOVE LIMITS TESTS " TO FEATURE. NC1044.2 +161500 MOVE 1 TO DNAME1. NC1044.2 +161600* NOTE THE FOLLOWING 44 TESTS WILL TEST THE LIMITS OF NC1044.2 +161700* THE MOVE STATEMENT WITH OVER 20 OPERANDS, A DELETION NC1044.2 +161800* PLACED IN THIS PARAGRAPH WILL SKIP THE LIMITS TESTS NC1044.2 +161900* BUT A NOTE STATEMENT MAY NEED TO BE PLACED IN EACH TEST.NC1044.2 +162000 GO TO MOVE-TEST-F1-57-0. NC1044.2 +162100 MOVE-INIT-DELETE-F1-57-1. NC1044.2 +162200 PERFORM DE-LETE. NC1044.2 +162300 MOVE "MOVE LIMITS TESTS " TO FEATURE. NC1044.2 +162400 MOVE "MOVE-TEST, F1-57-1 THRU F1-58-21" TO PAR-NAME. NC1044.2 +162500 PERFORM PRINT-DETAIL. NC1044.2 +162600 ADD 43 TO DELETE-COUNTER. NC1044.2 +162700 GO TO MOVE-INIT-F1-58. NC1044.2 +162800 MOVE-TEST-F1-57-0. NC1044.2 +162900 MOVE DNAME1 TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26 NC1044.2 +163000 DNAME27 DNAME28 DNAME29 DNAME30 DNAME31 DNAME32 NC1044.2 +163100 DNAME33 DNAME34 DNAME35 DNAME36 DNAME37 DNAME38 NC1044.2 +163200 DNAME39 DNAME40 DNAME41 DNAME42 DNAME19. NC1044.2 +163300 MOVE-TEST-F1-57-1. NC1044.2 +163400 IF DNAME19 EQUAL TO 1 NC1044.2 +163500 PERFORM PASS NC1044.2 +163600 GO TO MOVE-WRITE-F1-57-1. NC1044.2 +163700 MOVE 1 TO CORRECT-18V0. NC1044.2 +163800 MOVE DNAME19 TO COMPUTED-18V0. NC1044.2 +163900 PERFORM FAIL. NC1044.2 +164000 GO TO MOVE-WRITE-F1-57-1. NC1044.2 +164100 MOVE-DELETE-F1-57-1. NC1044.2 +164200 PERFORM DE-LETE. NC1044.2 +164300* NOTE *** A DELETE IN THIS TEST WILL CAUSE THE NEXT NC1044.2 +164400* 43 TESTS TO FAIL. NC1044.2 +164500 MOVE-WRITE-F1-57-1. NC1044.2 +164600 MOVE "MOVE-TEST-F1-57-1 " TO PAR-NAME. NC1044.2 +164700 PERFORM PRINT-DETAIL. NC1044.2 +164800 MOVE-TEST-F1-57-2. NC1044.2 +164900 IF DNAME22 EQUAL TO 1 NC1044.2 +165000 PERFORM PASS NC1044.2 +165100 GO TO MOVE-WRITE-F1-57-2. NC1044.2 +165200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +165300 MOVE DNAME22 TO COMPUTED-18V0. NC1044.2 +165400 MOVE 1 TO CORRECT-18V0. NC1044.2 +165500 PERFORM FAIL. NC1044.2 +165600 GO TO MOVE-WRITE-F1-57-2. NC1044.2 +165700 MOVE-DELETE-F1-57-2. NC1044.2 +165800 PERFORM DE-LETE. NC1044.2 +165900 MOVE-WRITE-F1-57-2. NC1044.2 +166000 MOVE "MOVE-TEST-F1-57-2 " TO PAR-NAME. NC1044.2 +166100 PERFORM PRINT-DETAIL. NC1044.2 +166200 MOVE-TEST-F1-57-3. NC1044.2 +166300 IF DNAME23 EQUAL TO 1 NC1044.2 +166400 PERFORM PASS NC1044.2 +166500 GO TO MOVE-WRITE-F1-57-3. NC1044.2 +166600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +166700 MOVE DNAME23 TO COMPUTED-18V0. NC1044.2 +166800 MOVE 1 TO CORRECT-18V0. NC1044.2 +166900 PERFORM FAIL. NC1044.2 +167000 GO TO MOVE-WRITE-F1-57-3. NC1044.2 +167100 MOVE-DELETE-F1-57-3. NC1044.2 +167200 PERFORM DE-LETE. NC1044.2 +167300 MOVE-WRITE-F1-57-3. NC1044.2 +167400 MOVE "MOVE-TEST-F1-57-3 " TO PAR-NAME. NC1044.2 +167500 PERFORM PRINT-DETAIL. NC1044.2 +167600 MOVE-TEST-F1-57-4. NC1044.2 +167700 IF DNAME24 EQUAL TO 1 NC1044.2 +167800 PERFORM PASS NC1044.2 +167900 GO TO MOVE-WRITE-F1-57-4. NC1044.2 +168000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +168100 MOVE DNAME24 TO COMPUTED-18V0. NC1044.2 +168200 MOVE 1 TO CORRECT-18V0. NC1044.2 +168300 PERFORM FAIL. NC1044.2 +168400 GO TO MOVE-WRITE-F1-57-4. NC1044.2 +168500 MOVE-DELETE-F1-57-4. NC1044.2 +168600 PERFORM DE-LETE. NC1044.2 +168700 MOVE-WRITE-F1-57-4. NC1044.2 +168800 MOVE "MOVE-TEST-F1-57-4 " TO PAR-NAME. NC1044.2 +168900 PERFORM PRINT-DETAIL. NC1044.2 +169000 MOVE-TEST-F1-57-5. NC1044.2 +169100 IF DNAME25 EQUAL TO 1 NC1044.2 +169200 PERFORM PASS NC1044.2 +169300 GO TO MOVE-WRITE-F1-57-5. NC1044.2 +169400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +169500 MOVE DNAME25 TO COMPUTED-18V0. NC1044.2 +169600 MOVE 1 TO CORRECT-18V0. NC1044.2 +169700 PERFORM FAIL. NC1044.2 +169800 GO TO MOVE-WRITE-F1-57-5. NC1044.2 +169900 MOVE-DELETE-F1-57-5. NC1044.2 +170000 PERFORM DE-LETE. NC1044.2 +170100 MOVE-WRITE-F1-57-5. NC1044.2 +170200 MOVE "MOVE-TEST-F1-57-5 " TO PAR-NAME. NC1044.2 +170300 PERFORM PRINT-DETAIL. NC1044.2 +170400 MOVE-TEST-F1-57-6. NC1044.2 +170500 IF DNAME26 EQUAL TO 1 NC1044.2 +170600 PERFORM PASS NC1044.2 +170700 GO TO MOVE-WRITE-F1-57-6. NC1044.2 +170800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +170900 MOVE DNAME26 TO COMPUTED-18V0. NC1044.2 +171000 MOVE 1 TO CORRECT-18V0. NC1044.2 +171100 PERFORM FAIL. NC1044.2 +171200 GO TO MOVE-WRITE-F1-57-6. NC1044.2 +171300 MOVE-DELETE-F1-57-6. NC1044.2 +171400 PERFORM DE-LETE. NC1044.2 +171500 MOVE-WRITE-F1-57-6. NC1044.2 +171600 MOVE "MOVE-TEST-F1-57-6 " TO PAR-NAME. NC1044.2 +171700 PERFORM PRINT-DETAIL. NC1044.2 +171800 MOVE-TEST-F1-57-7. NC1044.2 +171900 IF DNAME27 EQUAL TO 1 NC1044.2 +172000 PERFORM PASS NC1044.2 +172100 GO TO MOVE-WRITE-F1-57-7. NC1044.2 +172200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +172300 MOVE DNAME27 TO COMPUTED-18V0. NC1044.2 +172400 MOVE 1 TO CORRECT-18V0. NC1044.2 +172500 PERFORM FAIL. NC1044.2 +172600 GO TO MOVE-WRITE-F1-57-7. NC1044.2 +172700 MOVE-DELETE-F1-57-7. NC1044.2 +172800 PERFORM DE-LETE. NC1044.2 +172900 MOVE-WRITE-F1-57-7. NC1044.2 +173000 MOVE "MOVE-TEST-F1-57-7 " TO PAR-NAME. NC1044.2 +173100 PERFORM PRINT-DETAIL. NC1044.2 +173200 MOVE-TEST-F1-57-8. NC1044.2 +173300 IF DNAME28 EQUAL TO 1 NC1044.2 +173400 PERFORM PASS NC1044.2 +173500 GO TO MOVE-WRITE-F1-57-8. NC1044.2 +173600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +173700 MOVE DNAME28 TO COMPUTED-18V0. NC1044.2 +173800 MOVE 1 TO CORRECT-18V0. NC1044.2 +173900 PERFORM FAIL. NC1044.2 +174000 GO TO MOVE-WRITE-F1-57-8. NC1044.2 +174100 MOVE-DELETE-F1-57-8. NC1044.2 +174200 PERFORM DE-LETE. NC1044.2 +174300 MOVE-WRITE-F1-57-8. NC1044.2 +174400 MOVE "MOVE-TEST-F1-57-8 " TO PAR-NAME. NC1044.2 +174500 PERFORM PRINT-DETAIL. NC1044.2 +174600 MOVE-TEST-F1-57-9. NC1044.2 +174700 IF DNAME29 EQUAL TO 1 NC1044.2 +174800 PERFORM PASS NC1044.2 +174900 GO TO MOVE-WRITE-F1-57-9. NC1044.2 +175000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +175100 MOVE DNAME29 TO COMPUTED-18V0. NC1044.2 +175200 MOVE 1 TO CORRECT-18V0. NC1044.2 +175300 PERFORM FAIL. NC1044.2 +175400 GO TO MOVE-WRITE-F1-57-9. NC1044.2 +175500 MOVE-DELETE-F1-57-9. NC1044.2 +175600 PERFORM DE-LETE. NC1044.2 +175700 MOVE-WRITE-F1-57-9. NC1044.2 +175800 MOVE "MOVE-TEST-F1-57-9 " TO PAR-NAME. NC1044.2 +175900 PERFORM PRINT-DETAIL. NC1044.2 +176000 MOVE-TEST-F1-57-10. NC1044.2 +176100 IF DNAME30 EQUAL TO 1 NC1044.2 +176200 PERFORM PASS NC1044.2 +176300 GO TO MOVE-WRITE-F1-57-10. NC1044.2 +176400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +176500 MOVE DNAME30 TO COMPUTED-18V0. NC1044.2 +176600 MOVE 1 TO CORRECT-18V0. NC1044.2 +176700 PERFORM FAIL. NC1044.2 +176800 GO TO MOVE-WRITE-F1-57-10. NC1044.2 +176900 MOVE-DELETE-F1-57-10. NC1044.2 +177000 PERFORM DE-LETE. NC1044.2 +177100 MOVE-WRITE-F1-57-10. NC1044.2 +177200 MOVE "MOVE-TEST-F1-57-10 " TO PAR-NAME. NC1044.2 +177300 PERFORM PRINT-DETAIL. NC1044.2 +177400 MOVE-TEST-F1-57-11. NC1044.2 +177500 IF DNAME31 EQUAL TO 1 NC1044.2 +177600 PERFORM PASS NC1044.2 +177700 GO TO MOVE-WRITE-F1-57-11. NC1044.2 +177800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +177900 MOVE DNAME31 TO COMPUTED-18V0. NC1044.2 +178000 MOVE 1 TO CORRECT-18V0. NC1044.2 +178100 PERFORM FAIL. NC1044.2 +178200 GO TO MOVE-WRITE-F1-57-11. NC1044.2 +178300 MOVE-DELETE-F1-57-11. NC1044.2 +178400 PERFORM DE-LETE. NC1044.2 +178500 MOVE-WRITE-F1-57-11. NC1044.2 +178600 MOVE "MOVE-TEST-F1-57-11 " TO PAR-NAME. NC1044.2 +178700 PERFORM PRINT-DETAIL. NC1044.2 +178800 MOVE-TEST-F1-57-12. NC1044.2 +178900 IF DNAME32 EQUAL TO 1 NC1044.2 +179000 PERFORM PASS NC1044.2 +179100 GO TO MOVE-WRITE-F1-57-12. NC1044.2 +179200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +179300 MOVE DNAME32 TO COMPUTED-18V0. NC1044.2 +179400 MOVE 1 TO CORRECT-18V0. NC1044.2 +179500 PERFORM FAIL. NC1044.2 +179600 GO TO MOVE-WRITE-F1-57-12. NC1044.2 +179700 MOVE-DELETE-F1-57-12. NC1044.2 +179800 PERFORM DE-LETE. NC1044.2 +179900 MOVE-WRITE-F1-57-12. NC1044.2 +180000 MOVE "MOVE-TEST-F1-57-12 " TO PAR-NAME. NC1044.2 +180100 PERFORM PRINT-DETAIL. NC1044.2 +180200 MOVE-TEST-F1-57-13. NC1044.2 +180300 IF DNAME33 EQUAL TO 1 NC1044.2 +180400 PERFORM PASS NC1044.2 +180500 GO TO MOVE-WRITE-F1-57-13. NC1044.2 +180600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +180700 MOVE DNAME33 TO COMPUTED-18V0. NC1044.2 +180800 MOVE 1 TO CORRECT-18V0. NC1044.2 +180900 PERFORM FAIL. NC1044.2 +181000 GO TO MOVE-WRITE-F1-57-13. NC1044.2 +181100 MOVE-DELETE-F1-57-13. NC1044.2 +181200 PERFORM DE-LETE. NC1044.2 +181300 MOVE-WRITE-F1-57-13. NC1044.2 +181400 MOVE "MOVE-TEST-F1-57-13 " TO PAR-NAME. NC1044.2 +181500 PERFORM PRINT-DETAIL. NC1044.2 +181600 MOVE-TEST-F1-57-14. NC1044.2 +181700 IF DNAME34 EQUAL TO 1 NC1044.2 +181800 PERFORM PASS NC1044.2 +181900 GO TO MOVE-WRITE-F1-57-14. NC1044.2 +182000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +182100 MOVE DNAME34 TO COMPUTED-18V0. NC1044.2 +182200 MOVE 1 TO CORRECT-18V0. NC1044.2 +182300 PERFORM FAIL. NC1044.2 +182400 GO TO MOVE-WRITE-F1-57-14. NC1044.2 +182500 MOVE-DELETE-F1-57-14. NC1044.2 +182600 PERFORM DE-LETE. NC1044.2 +182700 MOVE-WRITE-F1-57-14. NC1044.2 +182800 MOVE "MOVE-TEST-F1-57-14 " TO PAR-NAME. NC1044.2 +182900 PERFORM PRINT-DETAIL. NC1044.2 +183000 MOVE-TEST-F1-57-15. NC1044.2 +183100 IF DNAME35 EQUAL TO 1 NC1044.2 +183200 PERFORM PASS NC1044.2 +183300 GO TO MOVE-WRITE-F1-57-15. NC1044.2 +183400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +183500 MOVE DNAME35 TO COMPUTED-18V0. NC1044.2 +183600 MOVE 1 TO CORRECT-18V0. NC1044.2 +183700 PERFORM FAIL. NC1044.2 +183800 GO TO MOVE-WRITE-F1-57-15. NC1044.2 +183900 MOVE-DELETE-F1-57-15. NC1044.2 +184000 PERFORM DE-LETE. NC1044.2 +184100 MOVE-WRITE-F1-57-15. NC1044.2 +184200 MOVE "MOVE-TEST-F1-57-15 " TO PAR-NAME. NC1044.2 +184300 PERFORM PRINT-DETAIL. NC1044.2 +184400 MOVE-TEST-F1-57-16. NC1044.2 +184500 IF DNAME36 EQUAL TO 1 NC1044.2 +184600 PERFORM PASS NC1044.2 +184700 GO TO MOVE-WRITE-F1-57-16. NC1044.2 +184800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +184900 MOVE DNAME36 TO COMPUTED-18V0. NC1044.2 +185000 MOVE 1 TO CORRECT-18V0. NC1044.2 +185100 PERFORM FAIL. NC1044.2 +185200 GO TO MOVE-WRITE-F1-57-16. NC1044.2 +185300 MOVE-DELETE-F1-57-16. NC1044.2 +185400 PERFORM DE-LETE. NC1044.2 +185500 MOVE-WRITE-F1-57-16. NC1044.2 +185600 MOVE "MOVE-TEST-F1-57-16 " TO PAR-NAME. NC1044.2 +185700 PERFORM PRINT-DETAIL. NC1044.2 +185800 MOVE-TEST-F1-57-17. NC1044.2 +185900 IF DNAME37 EQUAL TO 1 NC1044.2 +186000 PERFORM PASS NC1044.2 +186100 GO TO MOVE-WRITE-F1-57-17. NC1044.2 +186200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +186300 MOVE DNAME37 TO COMPUTED-18V0. NC1044.2 +186400 MOVE 1 TO CORRECT-18V0. NC1044.2 +186500 PERFORM FAIL. NC1044.2 +186600 GO TO MOVE-WRITE-F1-57-17. NC1044.2 +186700 MOVE-DELETE-F1-57-17. NC1044.2 +186800 PERFORM DE-LETE. NC1044.2 +186900 MOVE-WRITE-F1-57-17. NC1044.2 +187000 MOVE "MOVE-TEST-F1-57-17 " TO PAR-NAME. NC1044.2 +187100 PERFORM PRINT-DETAIL. NC1044.2 +187200 MOVE-TEST-F1-57-18. NC1044.2 +187300 IF DNAME38 EQUAL TO 1 NC1044.2 +187400 PERFORM PASS NC1044.2 +187500 GO TO MOVE-WRITE-F1-57-18. NC1044.2 +187600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +187700 MOVE DNAME38 TO COMPUTED-18V0. NC1044.2 +187800 MOVE 1 TO CORRECT-18V0. NC1044.2 +187900 PERFORM FAIL. NC1044.2 +188000 GO TO MOVE-WRITE-F1-57-18. NC1044.2 +188100 MOVE-DELETE-F1-57-18. NC1044.2 +188200 PERFORM DE-LETE. NC1044.2 +188300 MOVE-WRITE-F1-57-18. NC1044.2 +188400 MOVE "MOVE-TEST-F1-57-18 " TO PAR-NAME. NC1044.2 +188500 PERFORM PRINT-DETAIL. NC1044.2 +188600 MOVE-TEST-F1-57-19. NC1044.2 +188700 IF DNAME39 EQUAL TO 1 NC1044.2 +188800 PERFORM PASS NC1044.2 +188900 GO TO MOVE-WRITE-F1-57-19. NC1044.2 +189000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +189100 MOVE DNAME39 TO COMPUTED-18V0. NC1044.2 +189200 MOVE 1 TO CORRECT-18V0. NC1044.2 +189300 PERFORM FAIL. NC1044.2 +189400 GO TO MOVE-WRITE-F1-57-19. NC1044.2 +189500 MOVE-DELETE-F1-57-19. NC1044.2 +189600 PERFORM DE-LETE. NC1044.2 +189700 MOVE-WRITE-F1-57-19. NC1044.2 +189800 MOVE "MOVE-TEST-F1-57-19 " TO PAR-NAME. NC1044.2 +189900 PERFORM PRINT-DETAIL. NC1044.2 +190000 MOVE-TEST-F1-57-20. NC1044.2 +190100 IF DNAME40 EQUAL TO 1 NC1044.2 +190200 PERFORM PASS NC1044.2 +190300 GO TO MOVE-WRITE-F1-57-20. NC1044.2 +190400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +190500 MOVE DNAME40 TO COMPUTED-18V0. NC1044.2 +190600 MOVE 1 TO CORRECT-18V0. NC1044.2 +190700 PERFORM FAIL. NC1044.2 +190800 GO TO MOVE-WRITE-F1-57-20. NC1044.2 +190900 MOVE-DELETE-F1-57-20. NC1044.2 +191000 PERFORM DE-LETE. NC1044.2 +191100 MOVE-WRITE-F1-57-20. NC1044.2 +191200 MOVE "MOVE-TEST-F1-57-20 " TO PAR-NAME. NC1044.2 +191300 PERFORM PRINT-DETAIL. NC1044.2 +191400 MOVE-TEST-F1-57-21. NC1044.2 +191500 IF DNAME41 EQUAL TO 1 NC1044.2 +191600 PERFORM PASS NC1044.2 +191700 GO TO MOVE-WRITE-F1-57-21. NC1044.2 +191800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +191900 MOVE DNAME41 TO COMPUTED-18V0. NC1044.2 +192000 MOVE 1 TO CORRECT-18V0. NC1044.2 +192100 PERFORM FAIL. NC1044.2 +192200 GO TO MOVE-WRITE-F1-57-21. NC1044.2 +192300 MOVE-DELETE-F1-57-21. NC1044.2 +192400 PERFORM DE-LETE. NC1044.2 +192500 MOVE-WRITE-F1-57-21. NC1044.2 +192600 MOVE "MOVE-TEST-F1-57-21 " TO PAR-NAME. NC1044.2 +192700 PERFORM PRINT-DETAIL. NC1044.2 +192800 MOVE-TEST-F1-57-22. NC1044.2 +192900 IF DNAME42 EQUAL TO 1 NC1044.2 +193000 PERFORM PASS NC1044.2 +193100 GO TO MOVE-WRITE-F1-57-22. NC1044.2 +193200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-57-1. NC1044.2 +193300 MOVE DNAME42 TO COMPUTED-18V0. NC1044.2 +193400 MOVE 1 TO CORRECT-18V0. NC1044.2 +193500 PERFORM FAIL. NC1044.2 +193600 GO TO MOVE-WRITE-F1-57-22. NC1044.2 +193700 MOVE-DELETE-F1-57-22. NC1044.2 +193800 PERFORM DE-LETE. NC1044.2 +193900 MOVE-WRITE-F1-57-22. NC1044.2 +194000 MOVE "MOVE-TEST-F1-57-22 " TO PAR-NAME. NC1044.2 +194100 PERFORM PRINT-DETAIL. NC1044.2 +194200 MOVE-INIT-F1-58. NC1044.2 +194300 MOVE 000000000000000001 TO DNAME18. NC1044.2 +194400 MOVE-TEST-F1-58-0. NC1044.2 +194500 MOVE DNAME18 TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26 NC1044.2 +194600 DNAME27 DNAME28 DNAME29 DNAME30 DNAME31 DNAME32 NC1044.2 +194700 DNAME33 DNAME34 DNAME35 DNAME36 DNAME37 DNAME38 NC1044.2 +194800 DNAME39 DNAME40 DNAME41 DNAME42. NC1044.2 +194900 MOVE-TEST-F1-58-1. NC1044.2 +195000 IF DNAME22 EQUAL TO 1 NC1044.2 +195100 PERFORM PASS NC1044.2 +195200 GO TO MOVE-WRITE-F1-58-1. NC1044.2 +195300 MOVE DNAME22 TO COMPUTED-18V0. NC1044.2 +195400 MOVE 1 TO CORRECT-18V0. NC1044.2 +195500 PERFORM FAIL. NC1044.2 +195600 GO TO MOVE-WRITE-F1-58-1. NC1044.2 +195700 MOVE-DELETE-F1-58-1. NC1044.2 +195800 PERFORM DE-LETE. NC1044.2 +195900 MOVE-WRITE-F1-58-1. NC1044.2 +196000 MOVE "MOVE-TEST-F1-58-1 " TO PAR-NAME. NC1044.2 +196100 PERFORM PRINT-DETAIL. NC1044.2 +196200 MOVE-TEST-F1-58-2. NC1044.2 +196300 IF DNAME23 EQUAL TO 1 NC1044.2 +196400 PERFORM PASS NC1044.2 +196500 GO TO MOVE-WRITE-F1-58-2. NC1044.2 +196600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +196700 MOVE DNAME23 TO COMPUTED-18V0. NC1044.2 +196800 MOVE 1 TO CORRECT-18V0. NC1044.2 +196900 PERFORM FAIL. NC1044.2 +197000 GO TO MOVE-WRITE-F1-58-2. NC1044.2 +197100 MOVE-DELETE-F1-58-2. NC1044.2 +197200 PERFORM DE-LETE. NC1044.2 +197300 MOVE-WRITE-F1-58-2. NC1044.2 +197400 MOVE "MOVE-TEST-F1-58-2 " TO PAR-NAME. NC1044.2 +197500 PERFORM PRINT-DETAIL. NC1044.2 +197600 MOVE-TEST-F1-58-3. NC1044.2 +197700 IF DNAME24 EQUAL TO 1 NC1044.2 +197800 PERFORM PASS NC1044.2 +197900 GO TO MOVE-WRITE-F1-58-3. NC1044.2 +198000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +198100 MOVE DNAME24 TO COMPUTED-18V0. NC1044.2 +198200 MOVE 1 TO CORRECT-18V0. NC1044.2 +198300 PERFORM FAIL. NC1044.2 +198400 GO TO MOVE-WRITE-F1-58-3. NC1044.2 +198500 MOVE-DELETE-F1-58-3. NC1044.2 +198600 PERFORM DE-LETE. NC1044.2 +198700 MOVE-WRITE-F1-58-3. NC1044.2 +198800 MOVE "MOVE-TEST-F1-58-3 " TO PAR-NAME. NC1044.2 +198900 PERFORM PRINT-DETAIL. NC1044.2 +199000 MOVE-TEST-F1-58-4. NC1044.2 +199100 IF DNAME25 EQUAL TO 1 NC1044.2 +199200 PERFORM PASS NC1044.2 +199300 GO TO MOVE-WRITE-F1-58-4. NC1044.2 +199400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +199500 MOVE DNAME25 TO COMPUTED-18V0. NC1044.2 +199600 MOVE 1 TO CORRECT-18V0. NC1044.2 +199700 PERFORM FAIL. NC1044.2 +199800 GO TO MOVE-WRITE-F1-58-4. NC1044.2 +199900 MOVE-DELETE-F1-58-4. NC1044.2 +200000 PERFORM DE-LETE. NC1044.2 +200100 MOVE-WRITE-F1-58-4. NC1044.2 +200200 MOVE "MOVE-TEST-F1-58-4 " TO PAR-NAME. NC1044.2 +200300 PERFORM PRINT-DETAIL. NC1044.2 +200400 MOVE-TEST-F1-58-5. NC1044.2 +200500 IF DNAME26 EQUAL TO 1 NC1044.2 +200600 PERFORM PASS NC1044.2 +200700 GO TO MOVE-WRITE-F1-58-5. NC1044.2 +200800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +200900 MOVE DNAME26 TO COMPUTED-18V0. NC1044.2 +201000 MOVE 1 TO CORRECT-18V0. NC1044.2 +201100 PERFORM FAIL. NC1044.2 +201200 GO TO MOVE-WRITE-F1-58-5. NC1044.2 +201300 MOVE-DELETE-F1-58-5. NC1044.2 +201400 PERFORM DE-LETE. NC1044.2 +201500 MOVE-WRITE-F1-58-5. NC1044.2 +201600 MOVE "MOVE-TEST-F1-58-5 " TO PAR-NAME. NC1044.2 +201700 PERFORM PRINT-DETAIL. NC1044.2 +201800 MOVE-TEST-F1-58-6. NC1044.2 +201900 IF DNAME27 EQUAL TO 1 NC1044.2 +202000 PERFORM PASS NC1044.2 +202100 GO TO MOVE-WRITE-F1-58-6. NC1044.2 +202200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +202300 MOVE DNAME27 TO COMPUTED-18V0. NC1044.2 +202400 MOVE 1 TO CORRECT-18V0. NC1044.2 +202500 PERFORM FAIL. NC1044.2 +202600 GO TO MOVE-WRITE-F1-58-6. NC1044.2 +202700 MOVE-DELETE-F1-58-6. NC1044.2 +202800 PERFORM DE-LETE. NC1044.2 +202900 MOVE-WRITE-F1-58-6. NC1044.2 +203000 MOVE "MOVE-TEST-F1-58-6 " TO PAR-NAME. NC1044.2 +203100 PERFORM PRINT-DETAIL. NC1044.2 +203200 MOVE-TEST-F1-58-7. NC1044.2 +203300 IF DNAME28 EQUAL TO 1 NC1044.2 +203400 PERFORM PASS NC1044.2 +203500 GO TO MOVE-WRITE-F1-58-7. NC1044.2 +203600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +203700 MOVE DNAME28 TO COMPUTED-18V0. NC1044.2 +203800 MOVE 1 TO CORRECT-18V0. NC1044.2 +203900 PERFORM FAIL. NC1044.2 +204000 GO TO MOVE-WRITE-F1-58-7. NC1044.2 +204100 MOVE-DELETE-F1-58-7. NC1044.2 +204200 PERFORM DE-LETE. NC1044.2 +204300 MOVE-WRITE-F1-58-7. NC1044.2 +204400 MOVE "MOVE-TEST-F1-58-7 " TO PAR-NAME. NC1044.2 +204500 PERFORM PRINT-DETAIL. NC1044.2 +204600 MOVE-TEST-F1-58-8. NC1044.2 +204700 IF DNAME29 EQUAL TO 1 NC1044.2 +204800 PERFORM PASS NC1044.2 +204900 GO TO MOVE-WRITE-F1-58-8. NC1044.2 +205000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +205100 MOVE DNAME29 TO COMPUTED-18V0. NC1044.2 +205200 MOVE 1 TO CORRECT-18V0. NC1044.2 +205300 PERFORM FAIL. NC1044.2 +205400 GO TO MOVE-WRITE-F1-58-8. NC1044.2 +205500 MOVE-DELETE-F1-58-8. NC1044.2 +205600 PERFORM DE-LETE. NC1044.2 +205700 MOVE-WRITE-F1-58-8. NC1044.2 +205800 MOVE "MOVE-TEST-F1-58-8 " TO PAR-NAME. NC1044.2 +205900 PERFORM PRINT-DETAIL. NC1044.2 +206000 MOVE-TEST-F1-58-9. NC1044.2 +206100 IF DNAME30 EQUAL TO 1 NC1044.2 +206200 PERFORM PASS NC1044.2 +206300 GO TO MOVE-WRITE-F1-58-9. NC1044.2 +206400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +206500 MOVE DNAME30 TO COMPUTED-18V0. NC1044.2 +206600 MOVE 1 TO CORRECT-18V0. NC1044.2 +206700 PERFORM FAIL. NC1044.2 +206800 GO TO MOVE-WRITE-F1-58-9. NC1044.2 +206900 MOVE-DELETE-F1-58-9. NC1044.2 +207000 PERFORM DE-LETE. NC1044.2 +207100 MOVE-WRITE-F1-58-9. NC1044.2 +207200 MOVE "MOVE-TEST-F1-58-9 " TO PAR-NAME. NC1044.2 +207300 PERFORM PRINT-DETAIL. NC1044.2 +207400 MOVE-TEST-F1-58-10. NC1044.2 +207500 IF DNAME31 EQUAL TO 1 NC1044.2 +207600 PERFORM PASS NC1044.2 +207700 GO TO MOVE-WRITE-F1-58-10. NC1044.2 +207800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +207900 MOVE DNAME31 TO COMPUTED-18V0. NC1044.2 +208000 MOVE 1 TO CORRECT-18V0. NC1044.2 +208100 PERFORM FAIL. NC1044.2 +208200 GO TO MOVE-WRITE-F1-58-10. NC1044.2 +208300 MOVE-DELETE-F1-58-10. NC1044.2 +208400 PERFORM DE-LETE. NC1044.2 +208500 MOVE-WRITE-F1-58-10. NC1044.2 +208600 MOVE "MOVE-TEST-F1-58-10 " TO PAR-NAME. NC1044.2 +208700 PERFORM PRINT-DETAIL. NC1044.2 +208800 MOVE-TEST-F1-58-11. NC1044.2 +208900 IF DNAME32 EQUAL TO 1 NC1044.2 +209000 PERFORM PASS NC1044.2 +209100 GO TO MOVE-WRITE-F1-58-11. NC1044.2 +209200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +209300 MOVE DNAME32 TO COMPUTED-18V0. NC1044.2 +209400 MOVE 1 TO CORRECT-18V0. NC1044.2 +209500 PERFORM FAIL. NC1044.2 +209600 GO TO MOVE-WRITE-F1-58-11. NC1044.2 +209700 MOVE-DELETE-F1-58-11. NC1044.2 +209800 PERFORM DE-LETE. NC1044.2 +209900 MOVE-WRITE-F1-58-11. NC1044.2 +210000 MOVE "MOVE-TEST-F1-58-11 " TO PAR-NAME. NC1044.2 +210100 PERFORM PRINT-DETAIL. NC1044.2 +210200 MOVE-TEST-F1-58-12. NC1044.2 +210300 IF DNAME33 EQUAL TO 1 NC1044.2 +210400 PERFORM PASS NC1044.2 +210500 GO TO MOVE-WRITE-F1-58-12. NC1044.2 +210600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +210700 MOVE DNAME33 TO COMPUTED-18V0. NC1044.2 +210800 MOVE 1 TO CORRECT-18V0. NC1044.2 +210900 PERFORM FAIL. NC1044.2 +211000 GO TO MOVE-WRITE-F1-58-12. NC1044.2 +211100 MOVE-DELETE-F1-58-12. NC1044.2 +211200 PERFORM DE-LETE. NC1044.2 +211300 MOVE-WRITE-F1-58-12. NC1044.2 +211400 MOVE "MOVE-TEST-F1-58-12 " TO PAR-NAME. NC1044.2 +211500 PERFORM PRINT-DETAIL. NC1044.2 +211600 MOVE-TEST-F1-58-13. NC1044.2 +211700 IF DNAME34 EQUAL TO 1 NC1044.2 +211800 PERFORM PASS NC1044.2 +211900 GO TO MOVE-WRITE-F1-58-13. NC1044.2 +212000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +212100 MOVE DNAME34 TO COMPUTED-18V0. NC1044.2 +212200 MOVE 1 TO CORRECT-18V0. NC1044.2 +212300 PERFORM FAIL. NC1044.2 +212400 GO TO MOVE-WRITE-F1-58-13. NC1044.2 +212500 MOVE-DELETE-F1-58-13. NC1044.2 +212600 PERFORM DE-LETE. NC1044.2 +212700 MOVE-WRITE-F1-58-13. NC1044.2 +212800 MOVE "MOVE-TEST-F1-58-13 " TO PAR-NAME. NC1044.2 +212900 PERFORM PRINT-DETAIL. NC1044.2 +213000 MOVE-TEST-F1-58-14. NC1044.2 +213100 IF DNAME35 EQUAL TO 1 NC1044.2 +213200 PERFORM PASS NC1044.2 +213300 GO TO MOVE-WRITE-F1-58-14. NC1044.2 +213400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +213500 MOVE DNAME35 TO COMPUTED-18V0. NC1044.2 +213600 MOVE 1 TO CORRECT-18V0. NC1044.2 +213700 PERFORM FAIL. NC1044.2 +213800 GO TO MOVE-WRITE-F1-58-14. NC1044.2 +213900 MOVE-DELETE-F1-58-14. NC1044.2 +214000 PERFORM DE-LETE. NC1044.2 +214100 MOVE-WRITE-F1-58-14. NC1044.2 +214200 MOVE "MOVE-TEST-F1-58-14 " TO PAR-NAME. NC1044.2 +214300 PERFORM PRINT-DETAIL. NC1044.2 +214400 MOVE-TEST-F1-58-15. NC1044.2 +214500 IF DNAME36 EQUAL TO 1 NC1044.2 +214600 PERFORM PASS NC1044.2 +214700 GO TO MOVE-WRITE-F1-58-15. NC1044.2 +214800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +214900 MOVE DNAME36 TO COMPUTED-18V0. NC1044.2 +215000 MOVE 1 TO CORRECT-18V0. NC1044.2 +215100 PERFORM FAIL. NC1044.2 +215200 GO TO MOVE-WRITE-F1-58-15. NC1044.2 +215300 MOVE-DELETE-F1-58-15. NC1044.2 +215400 PERFORM DE-LETE. NC1044.2 +215500 MOVE-WRITE-F1-58-15. NC1044.2 +215600 MOVE "MOVE-TEST-F1-58-15 " TO PAR-NAME. NC1044.2 +215700 PERFORM PRINT-DETAIL. NC1044.2 +215800 MOVE-TEST-F1-58-16. NC1044.2 +215900 IF DNAME37 EQUAL TO 1 NC1044.2 +216000 PERFORM PASS NC1044.2 +216100 GO TO MOVE-WRITE-F1-58-16. NC1044.2 +216200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +216300 MOVE DNAME37 TO COMPUTED-18V0. NC1044.2 +216400 MOVE 1 TO CORRECT-18V0. NC1044.2 +216500 PERFORM FAIL. NC1044.2 +216600 GO TO MOVE-WRITE-F1-58-16. NC1044.2 +216700 MOVE-DELETE-F1-58-16. NC1044.2 +216800 PERFORM DE-LETE. NC1044.2 +216900 MOVE-WRITE-F1-58-16. NC1044.2 +217000 MOVE "MOVE-TEST-F1-58-16 " TO PAR-NAME. NC1044.2 +217100 PERFORM PRINT-DETAIL. NC1044.2 +217200 MOVE-TEST-F1-58-17. NC1044.2 +217300 IF DNAME38 EQUAL TO 1 NC1044.2 +217400 PERFORM PASS NC1044.2 +217500 GO TO MOVE-WRITE-F1-58-17. NC1044.2 +217600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +217700 MOVE DNAME38 TO COMPUTED-18V0. NC1044.2 +217800 MOVE 1 TO CORRECT-18V0. NC1044.2 +217900 PERFORM FAIL. NC1044.2 +218000 GO TO MOVE-WRITE-F1-58-17. NC1044.2 +218100 MOVE-DELETE-F1-58-17. NC1044.2 +218200 PERFORM DE-LETE. NC1044.2 +218300 MOVE-WRITE-F1-58-17. NC1044.2 +218400 MOVE "MOVE-TEST-F1-58-17 " TO PAR-NAME. NC1044.2 +218500 PERFORM PRINT-DETAIL. NC1044.2 +218600 MOVE-TEST-F1-58-18. NC1044.2 +218700 IF DNAME39 EQUAL TO 1 NC1044.2 +218800 PERFORM PASS NC1044.2 +218900 GO TO MOVE-WRITE-F1-58-18. NC1044.2 +219000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +219100 MOVE DNAME39 TO COMPUTED-18V0. NC1044.2 +219200 MOVE 1 TO CORRECT-18V0. NC1044.2 +219300 PERFORM FAIL. NC1044.2 +219400 GO TO MOVE-WRITE-F1-58-18. NC1044.2 +219500 MOVE-DELETE-F1-58-18. NC1044.2 +219600 PERFORM DE-LETE. NC1044.2 +219700 MOVE-WRITE-F1-58-18. NC1044.2 +219800 MOVE "MOVE-TEST-F1-58-18 " TO PAR-NAME. NC1044.2 +219900 PERFORM PRINT-DETAIL. NC1044.2 +220000 MOVE-TEST-F1-58-19. NC1044.2 +220100 IF DNAME40 EQUAL TO 1 NC1044.2 +220200 PERFORM PASS NC1044.2 +220300 GO TO MOVE-WRITE-F1-58-19. NC1044.2 +220400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +220500 MOVE DNAME40 TO COMPUTED-18V0. NC1044.2 +220600 MOVE 1 TO CORRECT-18V0. NC1044.2 +220700 PERFORM FAIL. NC1044.2 +220800 GO TO MOVE-WRITE-F1-58-19. NC1044.2 +220900 MOVE-DELETE-F1-58-19. NC1044.2 +221000 PERFORM DE-LETE. NC1044.2 +221100 MOVE-WRITE-F1-58-19. NC1044.2 +221200 MOVE "MOVE-TEST-F1-58-19 " TO PAR-NAME. NC1044.2 +221300 PERFORM PRINT-DETAIL. NC1044.2 +221400 MOVE-TEST-F1-58-20. NC1044.2 +221500 IF DNAME41 EQUAL TO 1 NC1044.2 +221600 PERFORM PASS NC1044.2 +221700 GO TO MOVE-WRITE-F1-58-20. NC1044.2 +221800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +221900 MOVE DNAME41 TO COMPUTED-18V0. NC1044.2 +222000 MOVE 1 TO CORRECT-18V0. NC1044.2 +222100 PERFORM FAIL. NC1044.2 +222200 GO TO MOVE-WRITE-F1-58-20. NC1044.2 +222300 MOVE-DELETE-F1-58-20. NC1044.2 +222400 PERFORM DE-LETE. NC1044.2 +222500 MOVE-WRITE-F1-58-20. NC1044.2 +222600 MOVE "MOVE-TEST-F1-58-20 " TO PAR-NAME. NC1044.2 +222700 PERFORM PRINT-DETAIL. NC1044.2 +222800 MOVE-TEST-F1-58-21. NC1044.2 +222900 IF DNAME42 EQUAL TO 1 NC1044.2 +223000 PERFORM PASS NC1044.2 +223100 GO TO MOVE-WRITE-F1-58-21. NC1044.2 +223200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-58-1. NC1044.2 +223300 MOVE DNAME42 TO COMPUTED-18V0. NC1044.2 +223400 MOVE 1 TO CORRECT-18V0. NC1044.2 +223500 PERFORM FAIL. NC1044.2 +223600 GO TO MOVE-WRITE-F1-58-21. NC1044.2 +223700 MOVE-DELETE-F1-58-21. NC1044.2 +223800 PERFORM DE-LETE. NC1044.2 +223900 MOVE-WRITE-F1-58-21. NC1044.2 +224000 MOVE "MOVE-TEST-F1-58-21 " TO PAR-NAME. NC1044.2 +224100 PERFORM PRINT-DETAIL. NC1044.2 +224200 MOVE-INIT-F1-59-1. NC1044.2 +224300 MOVE ZERO TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26. NC1044.2 +224400 MOVE ZERO TO DNAME27 DNAME28 DNAME29 DNAME30 DNAME31. NC1044.2 +224500 MOVE ZERO TO DNAME32 DNAME33 DNAME34 DNAME35 DNAME36. NC1044.2 +224600 MOVE ZERO TO DNAME37 DNAME38 DNAME39 DNAME40 DNAME41. NC1044.2 +224700 MOVE ZERO TO DNAME42. NC1044.2 +224800 MOVE-TEST-F1-59-0. NC1044.2 +224900 MOVE "A" TO ANDATA1 ANDATA2 ANDATA3 ANDATA4 ANDATA5 NC1044.2 +225000 ANDATA6 ANDATA7 ANDATA8 ANDATA9 ANDATA10 ANDATA11 NC1044.2 +225100 ANDATA12 ANDATA13 ANDATA14 ANDATA15 ANDATA16 NC1044.2 +225200 ANDATA17 ANDATA18 ANDATA19 ANDATA20 ANDATA21. NC1044.2 +225300 MOVE-TEST-F1-59-1. NC1044.2 +225400 IF ANDATA1 EQUAL TO "A" NC1044.2 +225500 PERFORM PASS NC1044.2 +225600 GO TO MOVE-WRITE-F1-59-1. NC1044.2 +225700 MOVE ANDATA1 TO COMPUTED-A. NC1044.2 +225800 MOVE "A" TO CORRECT-A. NC1044.2 +225900 PERFORM FAIL. NC1044.2 +226000 GO TO MOVE-WRITE-F1-59-1. NC1044.2 +226100 MOVE-DELETE-F1-59-1. NC1044.2 +226200 PERFORM DE-LETE. NC1044.2 +226300 MOVE-WRITE-F1-59-1. NC1044.2 +226400 MOVE "MOVE-TEST-F1-59-1 " TO PAR-NAME. NC1044.2 +226500 PERFORM PRINT-DETAIL. NC1044.2 +226600 MOVE-TEST-F1-59-2. NC1044.2 +226700 IF ANDATA2 EQUAL TO "A" NC1044.2 +226800 PERFORM PASS NC1044.2 +226900 GO TO MOVE-WRITE-F1-59-2. NC1044.2 +227000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +227100 MOVE ANDATA2 TO COMPUTED-A. NC1044.2 +227200 MOVE "A" TO CORRECT-A. NC1044.2 +227300 PERFORM FAIL. NC1044.2 +227400 GO TO MOVE-WRITE-F1-59-2. NC1044.2 +227500 MOVE-DELETE-F1-59-2. NC1044.2 +227600 PERFORM DE-LETE. NC1044.2 +227700 MOVE-WRITE-F1-59-2. NC1044.2 +227800 MOVE "MOVE-TEST-F1-59-2 " TO PAR-NAME. NC1044.2 +227900 PERFORM PRINT-DETAIL. NC1044.2 +228000 MOVE-TEST-F1-59-3. NC1044.2 +228100 IF ANDATA3 EQUAL TO "A" NC1044.2 +228200 PERFORM PASS NC1044.2 +228300 GO TO MOVE-WRITE-F1-59-3. NC1044.2 +228400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +228500 MOVE ANDATA3 TO COMPUTED-A. NC1044.2 +228600 MOVE "A" TO CORRECT-A. NC1044.2 +228700 PERFORM FAIL. NC1044.2 +228800 GO TO MOVE-WRITE-F1-59-3. NC1044.2 +228900 MOVE-DELETE-F1-59-3. NC1044.2 +229000 PERFORM DE-LETE. NC1044.2 +229100 MOVE-WRITE-F1-59-3. NC1044.2 +229200 MOVE "MOVE-TEST-F1-59-3 " TO PAR-NAME. NC1044.2 +229300 PERFORM PRINT-DETAIL. NC1044.2 +229400 MOVE-TEST-F1-59-4-4. NC1044.2 +229500 IF ANDATA4 EQUAL TO "A" NC1044.2 +229600 PERFORM PASS NC1044.2 +229700 GO TO MOVE-WRITE-F1-59-4. NC1044.2 +229800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +229900 MOVE ANDATA4 TO COMPUTED-A. NC1044.2 +230000 MOVE "A" TO CORRECT-A. NC1044.2 +230100 PERFORM FAIL. NC1044.2 +230200 GO TO MOVE-WRITE-F1-59-4. NC1044.2 +230300 MOVE-DELETE-F1-59-4. NC1044.2 +230400 PERFORM DE-LETE. NC1044.2 +230500 MOVE-WRITE-F1-59-4. NC1044.2 +230600 MOVE "MOVE-TEST-F1-59-4 " TO PAR-NAME. NC1044.2 +230700 PERFORM PRINT-DETAIL. NC1044.2 +230800 MOVE-TEST-F1-59-5. NC1044.2 +230900 IF ANDATA5 EQUAL TO "A" NC1044.2 +231000 PERFORM PASS NC1044.2 +231100 GO TO MOVE-WRITE-F1-59-5. NC1044.2 +231200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +231300 MOVE ANDATA5 TO COMPUTED-A. NC1044.2 +231400 MOVE "A" TO CORRECT-A. NC1044.2 +231500 PERFORM FAIL. NC1044.2 +231600 GO TO MOVE-WRITE-F1-59-5. NC1044.2 +231700 MOVE-DELETE-F1-59-5. NC1044.2 +231800 PERFORM DE-LETE. NC1044.2 +231900 MOVE-WRITE-F1-59-5. NC1044.2 +232000 MOVE "MOVE-TEST-F1-59-5 " TO PAR-NAME. NC1044.2 +232100 PERFORM PRINT-DETAIL. NC1044.2 +232200 MOVE-TEST-F1-59-6. NC1044.2 +232300 IF ANDATA6 EQUAL TO "A" NC1044.2 +232400 PERFORM PASS NC1044.2 +232500 GO TO MOVE-WRITE-F1-59-6. NC1044.2 +232600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +232700 MOVE ANDATA6 TO COMPUTED-A. NC1044.2 +232800 MOVE "A" TO CORRECT-A. NC1044.2 +232900 PERFORM FAIL. NC1044.2 +233000 GO TO MOVE-WRITE-F1-59-6. NC1044.2 +233100 MOVE-DELETE-F1-59-6. NC1044.2 +233200 PERFORM DE-LETE. NC1044.2 +233300 MOVE-WRITE-F1-59-6. NC1044.2 +233400 MOVE "MOVE-TEST-F1-59-6 " TO PAR-NAME. NC1044.2 +233500 PERFORM PRINT-DETAIL. NC1044.2 +233600 MOVE-TEST-F1-59-7. NC1044.2 +233700 IF ANDATA7 EQUAL TO "A" NC1044.2 +233800 PERFORM PASS NC1044.2 +233900 GO TO MOVE-WRITE-F1-59-7. NC1044.2 +234000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +234100 MOVE ANDATA7 TO COMPUTED-A. NC1044.2 +234200 MOVE "A" TO CORRECT-A. NC1044.2 +234300 PERFORM FAIL. NC1044.2 +234400 GO TO MOVE-WRITE-F1-59-7. NC1044.2 +234500 MOVE-DELETE-F1-59-7. NC1044.2 +234600 PERFORM DE-LETE. NC1044.2 +234700 MOVE-WRITE-F1-59-7. NC1044.2 +234800 MOVE "MOVE-TEST-F1-59-7 " TO PAR-NAME. NC1044.2 +234900 PERFORM PRINT-DETAIL. NC1044.2 +235000 MOVE-TEST-F1-59-8. NC1044.2 +235100 IF ANDATA8 EQUAL TO "A" NC1044.2 +235200 PERFORM PASS NC1044.2 +235300 GO TO MOVE-WRITE-F1-59-8. NC1044.2 +235400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +235500 MOVE ANDATA8 TO COMPUTED-A. NC1044.2 +235600 MOVE "A" TO CORRECT-A. NC1044.2 +235700 PERFORM FAIL. NC1044.2 +235800 GO TO MOVE-WRITE-F1-59-8. NC1044.2 +235900 MOVE-DELETE-F1-59-8. NC1044.2 +236000 PERFORM DE-LETE. NC1044.2 +236100 MOVE-WRITE-F1-59-8. NC1044.2 +236200 MOVE "MOVE-TEST-F1-59-8 " TO PAR-NAME. NC1044.2 +236300 PERFORM PRINT-DETAIL. NC1044.2 +236400 MOVE-TEST-F1-59-9. NC1044.2 +236500 IF ANDATA9 EQUAL TO "A" NC1044.2 +236600 PERFORM PASS NC1044.2 +236700 GO TO MOVE-WRITE-F1-59-9. NC1044.2 +236800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +236900 MOVE ANDATA9 TO COMPUTED-A. NC1044.2 +237000 MOVE "A" TO CORRECT-A. NC1044.2 +237100 PERFORM FAIL. NC1044.2 +237200 GO TO MOVE-WRITE-F1-59-9. NC1044.2 +237300 MOVE-DELETE-F1-59-9. NC1044.2 +237400 PERFORM DE-LETE. NC1044.2 +237500 MOVE-WRITE-F1-59-9. NC1044.2 +237600 MOVE "MOVE-TEST-F1-59-9 " TO PAR-NAME. NC1044.2 +237700 PERFORM PRINT-DETAIL. NC1044.2 +237800 MOVE-TEST-F1-59-10. NC1044.2 +237900 IF ANDATA10 EQUAL TO "A" NC1044.2 +238000 PERFORM PASS NC1044.2 +238100 GO TO MOVE-WRITE-F1-59-10. NC1044.2 +238200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +238300 MOVE ANDATA10 TO COMPUTED-A. NC1044.2 +238400 MOVE "A" TO CORRECT-A. NC1044.2 +238500 PERFORM FAIL. NC1044.2 +238600 GO TO MOVE-WRITE-F1-59-10. NC1044.2 +238700 MOVE-DELETE-F1-59-10. NC1044.2 +238800 PERFORM DE-LETE. NC1044.2 +238900 MOVE-WRITE-F1-59-10. NC1044.2 +239000 MOVE "MOVE-TEST-F1-59-10 " TO PAR-NAME. NC1044.2 +239100 PERFORM PRINT-DETAIL. NC1044.2 +239200 MOVE-TEST-F1-59-11. NC1044.2 +239300 IF ANDATA11 EQUAL TO "A" NC1044.2 +239400 PERFORM PASS NC1044.2 +239500 GO TO MOVE-WRITE-F1-59-11. NC1044.2 +239600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +239700 MOVE ANDATA11 TO COMPUTED-A. NC1044.2 +239800 MOVE "A" TO CORRECT-A. NC1044.2 +239900 PERFORM FAIL. NC1044.2 +240000 GO TO MOVE-WRITE-F1-59-11. NC1044.2 +240100 MOVE-DELETE-F1-59-11. NC1044.2 +240200 PERFORM DE-LETE. NC1044.2 +240300 MOVE-WRITE-F1-59-11. NC1044.2 +240400 MOVE "MOVE-TEST-F1-59-11 " TO PAR-NAME. NC1044.2 +240500 PERFORM PRINT-DETAIL. NC1044.2 +240600 MOVE-TEST-F1-59-12. NC1044.2 +240700 IF ANDATA12 EQUAL TO "A" NC1044.2 +240800 PERFORM PASS NC1044.2 +240900 GO TO MOVE-WRITE-F1-59-12. NC1044.2 +241000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +241100 MOVE ANDATA12 TO COMPUTED-A. NC1044.2 +241200 MOVE "A" TO CORRECT-A. NC1044.2 +241300 PERFORM FAIL. NC1044.2 +241400 GO TO MOVE-WRITE-F1-59-12. NC1044.2 +241500 MOVE-DELETE-F1-59-12. NC1044.2 +241600 PERFORM DE-LETE. NC1044.2 +241700 MOVE-WRITE-F1-59-12. NC1044.2 +241800 MOVE "MOVE-TEST-F1-59-12 " TO PAR-NAME. NC1044.2 +241900 PERFORM PRINT-DETAIL. NC1044.2 +242000 MOVE-TEST-F1-59-13. NC1044.2 +242100 IF ANDATA13 EQUAL TO "A" NC1044.2 +242200 PERFORM PASS NC1044.2 +242300 GO TO MOVE-WRITE-F1-59-13. NC1044.2 +242400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +242500 MOVE ANDATA13 TO COMPUTED-A. NC1044.2 +242600 MOVE "A" TO CORRECT-A. NC1044.2 +242700 PERFORM FAIL. NC1044.2 +242800 GO TO MOVE-WRITE-F1-59-13. NC1044.2 +242900 MOVE-DELETE-F1-59-13. NC1044.2 +243000 PERFORM DE-LETE. NC1044.2 +243100 MOVE-WRITE-F1-59-13. NC1044.2 +243200 MOVE "MOVE-TEST-F1-59-13 " TO PAR-NAME. NC1044.2 +243300 PERFORM PRINT-DETAIL. NC1044.2 +243400 MOVE-TEST-F1-59-14. NC1044.2 +243500 IF ANDATA14 EQUAL TO "A" NC1044.2 +243600 PERFORM PASS NC1044.2 +243700 GO TO MOVE-WRITE-F1-59-14. NC1044.2 +243800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +243900 MOVE ANDATA14 TO COMPUTED-A. NC1044.2 +244000 MOVE "A" TO CORRECT-A. NC1044.2 +244100 PERFORM FAIL. NC1044.2 +244200 GO TO MOVE-WRITE-F1-59-14. NC1044.2 +244300 MOVE-DELETE-F1-59-14. NC1044.2 +244400 PERFORM DE-LETE. NC1044.2 +244500 MOVE-WRITE-F1-59-14. NC1044.2 +244600 MOVE "MOVE-TEST-F1-59-14 " TO PAR-NAME. NC1044.2 +244700 PERFORM PRINT-DETAIL. NC1044.2 +244800 MOVE-TEST-F1-59-15. NC1044.2 +244900 IF ANDATA15 EQUAL TO "A" NC1044.2 +245000 PERFORM PASS NC1044.2 +245100 GO TO MOVE-WRITE-F1-59-15. NC1044.2 +245200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +245300 MOVE ANDATA15 TO COMPUTED-A. NC1044.2 +245400 MOVE "A" TO CORRECT-A. NC1044.2 +245500 PERFORM FAIL. NC1044.2 +245600 GO TO MOVE-WRITE-F1-59-15. NC1044.2 +245700 MOVE-DELETE-F1-59-15. NC1044.2 +245800 PERFORM DE-LETE. NC1044.2 +245900 MOVE-WRITE-F1-59-15. NC1044.2 +246000 MOVE "MOVE-TEST-F1-59-15 " TO PAR-NAME. NC1044.2 +246100 PERFORM PRINT-DETAIL. NC1044.2 +246200 MOVE-TEST-F1-59-16. NC1044.2 +246300 IF ANDATA16 EQUAL TO "A" NC1044.2 +246400 PERFORM PASS NC1044.2 +246500 GO TO MOVE-WRITE-F1-59-16. NC1044.2 +246600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +246700 MOVE ANDATA16 TO COMPUTED-A. NC1044.2 +246800 MOVE "A" TO CORRECT-A. NC1044.2 +246900 PERFORM FAIL. NC1044.2 +247000 GO TO MOVE-WRITE-F1-59-16. NC1044.2 +247100 MOVE-DELETE-F1-59-16. NC1044.2 +247200 PERFORM DE-LETE. NC1044.2 +247300 MOVE-WRITE-F1-59-16. NC1044.2 +247400 MOVE "MOVE-TEST-F1-59-16 " TO PAR-NAME. NC1044.2 +247500 PERFORM PRINT-DETAIL. NC1044.2 +247600 MOVE-TEST-F1-59-17. NC1044.2 +247700 IF ANDATA17 EQUAL TO "A" NC1044.2 +247800 PERFORM PASS NC1044.2 +247900 GO TO MOVE-WRITE-F1-59-17. NC1044.2 +248000* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +248100 MOVE ANDATA17 TO COMPUTED-A. NC1044.2 +248200 MOVE "A" TO CORRECT-A. NC1044.2 +248300 PERFORM FAIL. NC1044.2 +248400 GO TO MOVE-WRITE-F1-59-17. NC1044.2 +248500 MOVE-DELETE-F1-59-17. NC1044.2 +248600 PERFORM DE-LETE. NC1044.2 +248700 MOVE-WRITE-F1-59-17. NC1044.2 +248800 MOVE "MOVE-TEST-F1-59-17 " TO PAR-NAME. NC1044.2 +248900 PERFORM PRINT-DETAIL. NC1044.2 +249000 MOVE-TEST-F1-59-18. NC1044.2 +249100 IF ANDATA18 EQUAL TO "A" NC1044.2 +249200 PERFORM PASS NC1044.2 +249300 GO TO MOVE-WRITE-F1-59-18. NC1044.2 +249400* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +249500 MOVE ANDATA18 TO COMPUTED-A. NC1044.2 +249600 MOVE "A" TO CORRECT-A. NC1044.2 +249700 PERFORM FAIL. NC1044.2 +249800 GO TO MOVE-WRITE-F1-59-18. NC1044.2 +249900 MOVE-DELETE-F1-59-18. NC1044.2 +250000 PERFORM DE-LETE. NC1044.2 +250100 MOVE-WRITE-F1-59-18. NC1044.2 +250200 MOVE "MOVE-TEST-F1-59-18 " TO PAR-NAME. NC1044.2 +250300 PERFORM PRINT-DETAIL. NC1044.2 +250400 MOVE-TEST-F1-59-19. NC1044.2 +250500 IF ANDATA19 EQUAL TO "A" NC1044.2 +250600 PERFORM PASS NC1044.2 +250700 GO TO MOVE-WRITE-F1-59-19. NC1044.2 +250800* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +250900 MOVE ANDATA19 TO COMPUTED-A. NC1044.2 +251000 MOVE "A" TO CORRECT-A. NC1044.2 +251100 PERFORM FAIL. NC1044.2 +251200 GO TO MOVE-WRITE-F1-59-19. NC1044.2 +251300 MOVE-DELETE-F1-59-19. NC1044.2 +251400 PERFORM DE-LETE. NC1044.2 +251500 MOVE-WRITE-F1-59-19. NC1044.2 +251600 MOVE "MOVE-TEST-F1-59-19 " TO PAR-NAME. NC1044.2 +251700 PERFORM PRINT-DETAIL. NC1044.2 +251800 MOVE-TEST-F1-59-20. NC1044.2 +251900 IF ANDATA20 EQUAL TO "A" NC1044.2 +252000 PERFORM PASS NC1044.2 +252100 GO TO MOVE-WRITE-F1-59-20. NC1044.2 +252200* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +252300 MOVE ANDATA20 TO COMPUTED-A. NC1044.2 +252400 MOVE "A" TO CORRECT-A. NC1044.2 +252500 PERFORM FAIL. NC1044.2 +252600 GO TO MOVE-WRITE-F1-59-20. NC1044.2 +252700 MOVE-DELETE-F1-59-20. NC1044.2 +252800 PERFORM DE-LETE. NC1044.2 +252900 MOVE-WRITE-F1-59-20. NC1044.2 +253000 MOVE "MOVE-TEST-F1-59-20 " TO PAR-NAME. NC1044.2 +253100 PERFORM PRINT-DETAIL. NC1044.2 +253200 MOVE-TEST-F1-59-21. NC1044.2 +253300 IF ANDATA21 EQUAL TO "A" NC1044.2 +253400 PERFORM PASS NC1044.2 +253500 GO TO MOVE-WRITE-F1-59-21. NC1044.2 +253600* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-59-1. NC1044.2 +253700 MOVE ANDATA21 TO COMPUTED-A. NC1044.2 +253800 MOVE "A" TO CORRECT-A. NC1044.2 +253900 PERFORM FAIL. NC1044.2 +254000 GO TO MOVE-WRITE-F1-59-21. NC1044.2 +254100 MOVE-DELETE-F1-59-21. NC1044.2 +254200 PERFORM DE-LETE. NC1044.2 +254300 MOVE-WRITE-F1-59-21. NC1044.2 +254400 MOVE "MOVE-TEST-F1-59-21 " TO PAR-NAME. NC1044.2 +254500 PERFORM PRINT-DETAIL. NC1044.2 +254600 MOVE-INIT-F1-60. NC1044.2 +254700* NC1044.2 +254800 MOVE-TEST-F1-60-0. NC1044.2 +254900 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO ANDATA1 ANDATA2 ANDATA3 NC1044.2 +255000 ANDATA4 ANDATA5 ANDATA6 ANDATA7 ANDATA8 ANDATA9 NC1044.2 +255100 ANDATA10 ANDATA11 ANDATA12 ANDATA13 ANDATA14 NC1044.2 +255200 ANDATA15 ANDATA16 ANDATA17 ANDATA18 ANDATA19 NC1044.2 +255300 ANDATA20 ANDATA21. NC1044.2 +255400 MOVE-TEST-F1-60-1. NC1044.2 +255500 IF ANDATA1 EQUAL TO "A" NC1044.2 +255600 PERFORM PASS NC1044.2 +255700 GO TO MOVE-WRITE-F1-60-1. NC1044.2 +255800 MOVE ANDATA1 TO COMPUTED-A. NC1044.2 +255900 MOVE "A" TO CORRECT-A. NC1044.2 +256000 PERFORM FAIL. NC1044.2 +256100 GO TO MOVE-WRITE-F1-60-1. NC1044.2 +256200 MOVE-DELETE-F1-60-1. NC1044.2 +256300 PERFORM DE-LETE. NC1044.2 +256400 MOVE-WRITE-F1-60-1. NC1044.2 +256500 MOVE "MOVE-TEST-F1-60-1 " TO PAR-NAME. NC1044.2 +256600 PERFORM PRINT-DETAIL. NC1044.2 +256700 MOVE-TEST-F1-60-2. NC1044.2 +256800 IF ANDATA2 EQUAL TO "AB" NC1044.2 +256900 PERFORM PASS NC1044.2 +257000 GO TO MOVE-WRITE-F1-60-2. NC1044.2 +257100* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +257200 MOVE ANDATA2 TO COMPUTED-A. NC1044.2 +257300 MOVE "AB" TO CORRECT-A. NC1044.2 +257400 PERFORM FAIL. NC1044.2 +257500 GO TO MOVE-WRITE-F1-60-2. NC1044.2 +257600 MOVE-DELETE-F1-60-2. NC1044.2 +257700 PERFORM DE-LETE. NC1044.2 +257800 MOVE-WRITE-F1-60-2. NC1044.2 +257900 MOVE "MOVE-TEST-F1-60-2 " TO PAR-NAME. NC1044.2 +258000 PERFORM PRINT-DETAIL. NC1044.2 +258100 MOVE-TEST-F1-60-3. NC1044.2 +258200 IF ANDATA3 EQUAL TO "ABC" NC1044.2 +258300 PERFORM PASS NC1044.2 +258400 GO TO MOVE-WRITE-F1-60-3. NC1044.2 +258500* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +258600 MOVE ANDATA3 TO COMPUTED-A. NC1044.2 +258700 MOVE "ABC" TO CORRECT-A. NC1044.2 +258800 PERFORM FAIL. NC1044.2 +258900 GO TO MOVE-WRITE-F1-60-3. NC1044.2 +259000 MOVE-DELETE-F1-60-3. NC1044.2 +259100 PERFORM DE-LETE. NC1044.2 +259200 MOVE-WRITE-F1-60-3. NC1044.2 +259300 MOVE "MOVE-TEST-F1-60-3 " TO PAR-NAME. NC1044.2 +259400 PERFORM PRINT-DETAIL. NC1044.2 +259500 MOVE-TEST-F1-60-4. NC1044.2 +259600 IF ANDATA4 EQUAL TO "ABCD" NC1044.2 +259700 PERFORM PASS NC1044.2 +259800 GO TO MOVE-WRITE-F1-60-4. NC1044.2 +259900* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +260000 MOVE ANDATA4 TO COMPUTED-A. NC1044.2 +260100 MOVE "ABCD" TO CORRECT-A. NC1044.2 +260200 PERFORM FAIL. NC1044.2 +260300 GO TO MOVE-WRITE-F1-60-4. NC1044.2 +260400 MOVE-DELETE-F1-60-4. NC1044.2 +260500 PERFORM DE-LETE. NC1044.2 +260600 MOVE-WRITE-F1-60-4. NC1044.2 +260700 MOVE "MOVE-TEST-F1-60-4 " TO PAR-NAME. NC1044.2 +260800 PERFORM PRINT-DETAIL. NC1044.2 +260900 MOVE-TEST-F1-60-5. NC1044.2 +261000 IF ANDATA5 EQUAL TO "ABCDE" NC1044.2 +261100 PERFORM PASS NC1044.2 +261200 GO TO MOVE-WRITE-F1-60-5. NC1044.2 +261300* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +261400 MOVE ANDATA5 TO COMPUTED-A. NC1044.2 +261500 MOVE "ABCDE" TO CORRECT-A. NC1044.2 +261600 PERFORM FAIL. NC1044.2 +261700 GO TO MOVE-WRITE-F1-60-5. NC1044.2 +261800 MOVE-DELETE-F1-60-5. NC1044.2 +261900 PERFORM DE-LETE. NC1044.2 +262000 MOVE-WRITE-F1-60-5. NC1044.2 +262100 MOVE "MOVE-TEST-F1-60-5 " TO PAR-NAME. NC1044.2 +262200 PERFORM PRINT-DETAIL. NC1044.2 +262300 MOVE-TEST-F1-60-6. NC1044.2 +262400 IF ANDATA6 EQUAL TO "ABCDEF" NC1044.2 +262500 PERFORM PASS NC1044.2 +262600 GO TO MOVE-WRITE-F1-60-6. NC1044.2 +262700* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +262800 MOVE ANDATA6 TO COMPUTED-A. NC1044.2 +262900 MOVE "ABCDEF" TO CORRECT-A. NC1044.2 +263000 PERFORM FAIL. NC1044.2 +263100 GO TO MOVE-WRITE-F1-60-6. NC1044.2 +263200 MOVE-DELETE-F1-60-6. NC1044.2 +263300 PERFORM DE-LETE. NC1044.2 +263400 MOVE-WRITE-F1-60-6. NC1044.2 +263500 MOVE "MOVE-TEST-F1-60-6 " TO PAR-NAME. NC1044.2 +263600 PERFORM PRINT-DETAIL. NC1044.2 +263700 MOVE-TEST-F1-60-7. NC1044.2 +263800 IF ANDATA7 EQUAL TO "ABCDEFG" NC1044.2 +263900 PERFORM PASS NC1044.2 +264000 GO TO MOVE-WRITE-F1-60-7. NC1044.2 +264100* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +264200 MOVE ANDATA7 TO COMPUTED-A. NC1044.2 +264300 MOVE "ABCDEFG" TO CORRECT-A. NC1044.2 +264400 PERFORM FAIL. NC1044.2 +264500 GO TO MOVE-WRITE-F1-60-7. NC1044.2 +264600 MOVE-DELETE-F1-60-7. NC1044.2 +264700 PERFORM DE-LETE. NC1044.2 +264800 MOVE-WRITE-F1-60-7. NC1044.2 +264900 MOVE "MOVE-TEST-F1-60-7 " TO PAR-NAME. NC1044.2 +265000 PERFORM PRINT-DETAIL. NC1044.2 +265100 MOVE-TEST-F1-60-8. NC1044.2 +265200 IF ANDATA8 EQUAL TO "ABCDEFGH" NC1044.2 +265300 PERFORM PASS NC1044.2 +265400 GO TO MOVE-WRITE-F1-60-8. NC1044.2 +265500* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +265600 MOVE ANDATA8 TO COMPUTED-A. NC1044.2 +265700 MOVE "ABCDEFGH" TO CORRECT-A. NC1044.2 +265800 PERFORM FAIL. NC1044.2 +265900 GO TO MOVE-WRITE-F1-60-8. NC1044.2 +266000 MOVE-DELETE-F1-60-8. NC1044.2 +266100 PERFORM DE-LETE. NC1044.2 +266200 MOVE-WRITE-F1-60-8. NC1044.2 +266300 MOVE "MOVE-TEST-F1-60-8 " TO PAR-NAME. NC1044.2 +266400 PERFORM PRINT-DETAIL. NC1044.2 +266500 MOVE-TEST-F1-60-9. NC1044.2 +266600 IF ANDATA9 EQUAL TO "ABCDEFGHI" NC1044.2 +266700 PERFORM PASS NC1044.2 +266800 GO TO MOVE-WRITE-F1-60-9. NC1044.2 +266900* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +267000 MOVE ANDATA9 TO COMPUTED-A. NC1044.2 +267100 MOVE "ABCDEFGHI" TO CORRECT-A. NC1044.2 +267200 PERFORM FAIL. NC1044.2 +267300 GO TO MOVE-WRITE-F1-60-9. NC1044.2 +267400 MOVE-DELETE-F1-60-9. NC1044.2 +267500 PERFORM DE-LETE. NC1044.2 +267600 MOVE-WRITE-F1-60-9. NC1044.2 +267700 MOVE "MOVE-TEST-F1-60-9 " TO PAR-NAME. NC1044.2 +267800 PERFORM PRINT-DETAIL. NC1044.2 +267900 MOVE-TEST-F1-60-10. NC1044.2 +268000 IF ANDATA10 EQUAL TO "ABCDEFGHIJ" NC1044.2 +268100 PERFORM PASS NC1044.2 +268200 GO TO MOVE-WRITE-F1-60-10. NC1044.2 +268300* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +268400 MOVE ANDATA10 TO COMPUTED-A. NC1044.2 +268500 MOVE "ABCDEFGHIJ" TO CORRECT-A. NC1044.2 +268600 PERFORM FAIL. NC1044.2 +268700 GO TO MOVE-WRITE-F1-60-10. NC1044.2 +268800 MOVE-DELETE-F1-60-10. NC1044.2 +268900 PERFORM DE-LETE. NC1044.2 +269000 MOVE-WRITE-F1-60-10. NC1044.2 +269100 MOVE "MOVE-TEST-F1-60-10 " TO PAR-NAME. NC1044.2 +269200 PERFORM PRINT-DETAIL. NC1044.2 +269300 MOVE-TEST-F1-60-11. NC1044.2 +269400 IF ANDATA11 EQUAL TO "ABCDEFGHIJK" NC1044.2 +269500 PERFORM PASS NC1044.2 +269600 GO TO MOVE-WRITE-F1-60-11. NC1044.2 +269700* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +269800 MOVE ANDATA11 TO COMPUTED-A. NC1044.2 +269900 MOVE "ABCDEFGHIJK" TO CORRECT-A. NC1044.2 +270000 PERFORM FAIL. NC1044.2 +270100 GO TO MOVE-WRITE-F1-60-11. NC1044.2 +270200 MOVE-DELETE-F1-60-11. NC1044.2 +270300 PERFORM DE-LETE. NC1044.2 +270400 MOVE-WRITE-F1-60-11. NC1044.2 +270500 MOVE "MOVE-TEST-F1-60-11 " TO PAR-NAME. NC1044.2 +270600 PERFORM PRINT-DETAIL. NC1044.2 +270700 MOVE-TEST-F1-60-12. NC1044.2 +270800 IF ANDATA12 EQUAL TO "ABCDEFGHIJKL" NC1044.2 +270900 PERFORM PASS NC1044.2 +271000 GO TO MOVE-WRITE-F1-60-12. NC1044.2 +271100* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +271200 MOVE ANDATA12 TO COMPUTED-A. NC1044.2 +271300 MOVE "ABCDEFGHIJKL" TO CORRECT-A. NC1044.2 +271400 PERFORM FAIL. NC1044.2 +271500 GO TO MOVE-WRITE-F1-60-12. NC1044.2 +271600 MOVE-DELETE-F1-60-12. NC1044.2 +271700 PERFORM DE-LETE. NC1044.2 +271800 MOVE-WRITE-F1-60-12. NC1044.2 +271900 MOVE "MOVE-TEST-F1-60-12 " TO PAR-NAME. NC1044.2 +272000 PERFORM PRINT-DETAIL. NC1044.2 +272100 MOVE-TEST-F1-60-13. NC1044.2 +272200 IF ANDATA13 EQUAL TO "ABCDEFGHIJKLM" NC1044.2 +272300 PERFORM PASS NC1044.2 +272400 GO TO MOVE-WRITE-F1-60-13. NC1044.2 +272500* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +272600 MOVE ANDATA13 TO COMPUTED-A. NC1044.2 +272700 MOVE "ABCDEFGHIJKLM" TO CORRECT-A. NC1044.2 +272800 PERFORM FAIL. NC1044.2 +272900 GO TO MOVE-WRITE-F1-60-13. NC1044.2 +273000 MOVE-DELETE-F1-60-13. NC1044.2 +273100 PERFORM DE-LETE. NC1044.2 +273200 MOVE-WRITE-F1-60-13. NC1044.2 +273300 MOVE "MOVE-TEST-F1-60-13 " TO PAR-NAME. NC1044.2 +273400 PERFORM PRINT-DETAIL. NC1044.2 +273500 MOVE-TEST-F1-60-14. NC1044.2 +273600 IF ANDATA14 EQUAL TO "ABCDEFGHIJKLMN" NC1044.2 +273700 PERFORM PASS NC1044.2 +273800 GO TO MOVE-WRITE-F1-60-14. NC1044.2 +273900* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +274000 MOVE ANDATA14 TO COMPUTED-A. NC1044.2 +274100 MOVE "ABCDEFGHIJKLMN" TO CORRECT-A. NC1044.2 +274200 PERFORM FAIL. NC1044.2 +274300 GO TO MOVE-WRITE-F1-60-14. NC1044.2 +274400 MOVE-DELETE-F1-60-14. NC1044.2 +274500 PERFORM DE-LETE. NC1044.2 +274600 MOVE-WRITE-F1-60-14. NC1044.2 +274700 MOVE "MOVE-TEST-F1-60-14 " TO PAR-NAME. NC1044.2 +274800 PERFORM PRINT-DETAIL. NC1044.2 +274900 MOVE-TEST-F1-60-15. NC1044.2 +275000 IF ANDATA15 EQUAL TO "ABCDEFGHIJKLMNO" NC1044.2 +275100 PERFORM PASS NC1044.2 +275200 GO TO MOVE-WRITE-F1-60-15. NC1044.2 +275300* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +275400 MOVE ANDATA15 TO COMPUTED-A. NC1044.2 +275500 MOVE "ABCDEFGHIJKLMNO" TO CORRECT-A. NC1044.2 +275600 PERFORM FAIL. NC1044.2 +275700 GO TO MOVE-WRITE-F1-60-15. NC1044.2 +275800 MOVE-DELETE-F1-60-15. NC1044.2 +275900 PERFORM DE-LETE. NC1044.2 +276000 MOVE-WRITE-F1-60-15. NC1044.2 +276100 MOVE "MOVE-TEST-F1-60-15 " TO PAR-NAME. NC1044.2 +276200 PERFORM PRINT-DETAIL. NC1044.2 +276300 MOVE-TEST-F1-60-16. NC1044.2 +276400 IF ANDATA16 EQUAL TO "ABCDEFGHIJKLMNOP" NC1044.2 +276500 PERFORM PASS NC1044.2 +276600 GO TO MOVE-WRITE-F1-60-16. NC1044.2 +276700* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +276800 MOVE ANDATA16 TO COMPUTED-A. NC1044.2 +276900 MOVE "ABCDEFGHIJKLMNOP" TO CORRECT-A. NC1044.2 +277000 PERFORM FAIL. NC1044.2 +277100 GO TO MOVE-WRITE-F1-60-16. NC1044.2 +277200 MOVE-DELETE-F1-60-16. NC1044.2 +277300 PERFORM DE-LETE. NC1044.2 +277400 MOVE-WRITE-F1-60-16. NC1044.2 +277500 MOVE "MOVE-TEST-F1-60-16 " TO PAR-NAME. NC1044.2 +277600 PERFORM PRINT-DETAIL. NC1044.2 +277700 MOVE-TEST-F1-60-17. NC1044.2 +277800 IF ANDATA17 EQUAL TO "ABCDEFGHIJKLMNOPQ" NC1044.2 +277900 PERFORM PASS NC1044.2 +278000 GO TO MOVE-WRITE-F1-60-17. NC1044.2 +278100* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +278200 MOVE ANDATA17 TO COMPUTED-A. NC1044.2 +278300 MOVE "ABCDEFGHIJKLMNOPQ" TO CORRECT-A. NC1044.2 +278400 PERFORM FAIL. NC1044.2 +278500 GO TO MOVE-WRITE-F1-60-17. NC1044.2 +278600 MOVE-DELETE-F1-60-17. NC1044.2 +278700 PERFORM DE-LETE. NC1044.2 +278800 MOVE-WRITE-F1-60-17. NC1044.2 +278900 MOVE "MOVE-TEST-F1-60-17 " TO PAR-NAME. NC1044.2 +279000 PERFORM PRINT-DETAIL. NC1044.2 +279100 MOVE-TEST-F1-60-18. NC1044.2 +279200 IF ANDATA18 EQUAL TO "ABCDEFGHIJKLMNOPQR" NC1044.2 +279300 PERFORM PASS NC1044.2 +279400 GO TO MOVE-WRITE-F1-60-18. NC1044.2 +279500* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +279600 MOVE ANDATA18 TO COMPUTED-A. NC1044.2 +279700 MOVE "ABCDEFGHIJKLMNOPQR" TO CORRECT-A. NC1044.2 +279800 PERFORM FAIL. NC1044.2 +279900 GO TO MOVE-WRITE-F1-60-18. NC1044.2 +280000 MOVE-DELETE-F1-60-18. NC1044.2 +280100 PERFORM DE-LETE. NC1044.2 +280200 MOVE-WRITE-F1-60-18. NC1044.2 +280300 MOVE "MOVE-TEST-F1-60-18 " TO PAR-NAME. NC1044.2 +280400 PERFORM PRINT-DETAIL. NC1044.2 +280500 MOVE-TEST-F1-60-19. NC1044.2 +280600 IF ANDATA19 EQUAL TO "ABCDEFGHIJKLMNOPQRS" NC1044.2 +280700 PERFORM PASS NC1044.2 +280800 GO TO MOVE-WRITE-F1-60-19. NC1044.2 +280900* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +281000 MOVE ANDATA19 TO COMPUTED-A. NC1044.2 +281100 MOVE "ABCDEFGHIJKLMNOPQRS" TO CORRECT-A. NC1044.2 +281200 PERFORM FAIL. NC1044.2 +281300 GO TO MOVE-WRITE-F1-60-19. NC1044.2 +281400 MOVE-DELETE-F1-60-19. NC1044.2 +281500 PERFORM DE-LETE. NC1044.2 +281600 MOVE-WRITE-F1-60-19. NC1044.2 +281700 MOVE "MOVE-TEST-F1-60-19 " TO PAR-NAME. NC1044.2 +281800 PERFORM PRINT-DETAIL. NC1044.2 +281900 MOVE-TEST-F1-60-20. NC1044.2 +282000 IF ANDATA20 EQUAL TO "ABCDEFGHIJKLMNOPQRST" NC1044.2 +282100 PERFORM PASS NC1044.2 +282200 GO TO MOVE-WRITE-F1-60-20. NC1044.2 +282300* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +282400 MOVE ANDATA20 TO COMPUTED-A. NC1044.2 +282500 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. NC1044.2 +282600 PERFORM FAIL. NC1044.2 +282700 GO TO MOVE-WRITE-F1-60-20. NC1044.2 +282800 MOVE-DELETE-F1-60-20. NC1044.2 +282900 PERFORM DE-LETE. NC1044.2 +283000 MOVE-WRITE-F1-60-20. NC1044.2 +283100 MOVE "MOVE-TEST-F1-60-20 " TO PAR-NAME. NC1044.2 +283200 PERFORM PRINT-DETAIL. NC1044.2 +283300 MOVE-TEST-F1-60-21. NC1044.2 +283400 IF ANDATA21 EQUAL TO "ABCDEFGHIJKLMNOPQRSTU" NC1044.2 +283500 PERFORM PASS NC1044.2 +283600 GO TO MOVE-WRITE-F1-60-21. NC1044.2 +283700* NOTE THIS TEST DEPENDS ON PARAGRAPH MOVE-TEST-F1-60-1. NC1044.2 +283800 MOVE "SEE RE-MARK COL" TO COMPUTED-A. NC1044.2 +283900 MOVE ANDATA21 TO RE-MARK. NC1044.2 +284000 MOVE "ALPHABET A THRU U" TO CORRECT-A. NC1044.2 +284100 PERFORM FAIL. NC1044.2 +284200 GO TO MOVE-WRITE-F1-60-21. NC1044.2 +284300 MOVE-DELETE-F1-60-21. NC1044.2 +284400 PERFORM DE-LETE. NC1044.2 +284500 MOVE-WRITE-F1-60-21. NC1044.2 +284600 MOVE "MOVE-TEST-F1-60-21 " TO PAR-NAME. NC1044.2 +284700 PERFORM PRINT-DETAIL. NC1044.2 +284800 PERFORM END-ROUTINE. NC1044.2 +284900 CCVS-EXIT SECTION. NC1044.2 +285000 CCVS-999999. NC1044.2 +285100 GO TO CLOSE-FILES. NC1044.2 diff --git a/tests/cobol85/NC/NC105A.CBL b/tests/cobol85/NC/NC105A.CBL new file mode 100755 index 00000000..be96b76a --- /dev/null +++ b/tests/cobol85/NC/NC105A.CBL @@ -0,0 +1,3117 @@ +000100 IDENTIFICATION DIVISION. NC1054.2 +000200 PROGRAM-ID. NC1054.2 +000300 NC105A. NC1054.2 +000400**************************************************************** NC1054.2 +000500* * NC1054.2 +000600* VALIDATION FOR:- * NC1054.2 +000700* * NC1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1054.2 +000900* * NC1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1054.2 +001100* * NC1054.2 +001200**************************************************************** NC1054.2 +001300* * NC1054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1054.2 +001500* * NC1054.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1054.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1054.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1054.2 +001900* * NC1054.2 +002000**************************************************************** NC1054.2 +002100* NC1054.2 +002200* PROGRAM NC105A CONTAINS FURTHER TESTS OF FORMAT 1 OF NC1054.2 +002300* THE MOVE STATEMENT. NC1054.2 +002400* NC1054.2 +002500* (SEE ALSO NC104A). NC1054.2 +002600* NC1054.2 +002700 ENVIRONMENT DIVISION. NC1054.2 +002800 CONFIGURATION SECTION. NC1054.2 +002900 SOURCE-COMPUTER. NC1054.2 +003000 Linux. NC1054.2 +003100 OBJECT-COMPUTER. NC1054.2 +003200 Linux. NC1054.2 +003300 INPUT-OUTPUT SECTION. NC1054.2 +003400 FILE-CONTROL. NC1054.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1054.2 +003600 "report.log". NC1054.2 +003700 DATA DIVISION. NC1054.2 +003800 FILE SECTION. NC1054.2 +003900 FD PRINT-FILE NC1054.2 +004000 LABEL RECORDS NC1054.2 +004100 OMITTED NC1054.2 +004200 DATA RECORD IS PRINT-REC DUMMY-RECORD. NC1054.2 +004300 01 PRINT-REC PICTURE X(120). NC1054.2 +004400 01 DUMMY-RECORD PICTURE X(120). NC1054.2 +004500 WORKING-STORAGE SECTION. NC1054.2 +004600 77 LENGTH-COUNTER PICTURE 999 VALUE 000. NC1054.2 +004700 77 SPOS-LIT1 PICTURE S9(5) VALUE +60666. NC1054.2 +004800 77 SPOS-LIT2 PICTURE S9(5) VALUE +60667. NC1054.2 +004900 77 SNEG-LIT1 PICTURE S9(5) VALUE -70717. NC1054.2 +005000 77 SNEG-LIT2 PICTURE S9(5) VALUE -70718. NC1054.2 +005100 77 ALPHA-LIT PICTURE X(5) VALUE SPACE. NC1054.2 +005200 77 TA--X PIC 9(5) COMPUTATIONAL. NC1054.2 +005300 77 WRK-CS-18V00 VALUE ZERO PICTURE 9(18) COMPUTATIONAL. NC1054.2 +005400 77 WRK-CS-01V00 VALUE ZERO PICTURE 9 COMPUTATIONAL. NC1054.2 +005500 77 WRK-CS-10V00 VALUE ZERO PICTURE 9(10) COMPUTATIONAL. NC1054.2 +005600 77 WRK-DS-18V00 VALUE ZERO PICTURE 9(18). NC1054.2 +005700 77 WRK-DS-01V00 VALUE ZERO PICTURE 9. NC1054.2 +005800 77 WRK-DS-10V00 VALUE ZERO PICTURE 9(10). NC1054.2 +005900 77 WRK-CS-08V08 PIC S9(8)V9(8) VALUE 832.553 COMPUTATIONAL. NC1054.2 +006000 77 WRK-CS-04V08 PIC S9(4)V9(8) VALUE 6382.47 COMPUTATIONAL. NC1054.2 +006100 77 WRK-DS-08V08 PIC S9(8)V9(8) VALUE ZERO. NC1054.2 +006200 77 WRK-DS-04V08 PIC S9(4)V9(8) VALUE ZERO. NC1054.2 +006300 77 WRK-EDIT-Z3VZ3 PIC ZZZ.ZZZ. NC1054.2 +006400 77 WRK-EDIT-05V00 PIC ****9. NC1054.2 +006500 77 WRK-EDIT-18V00 PIC ZZZZZZZZZZZZZZZZZ9. NC1054.2 +006600 77 WRK-EDIT-05V02 PIC -99999.99. NC1054.2 +006700 77 WRK-CS-03V00 PIC S999 COMPUTATIONAL. NC1054.2 +006800 77 MOVE74 PICTURE 9(9)V9 VALUE 234565432.1 NC1054.2 +006900 SYNCHRONIZED RIGHT COMPUTATIONAL. NC1054.2 +007000 77 MOVE75 PICTURE 9(10) NC1054.2 +007100 SYNCHRONIZED RIGHT COMPUTATIONAL. NC1054.2 +007200 77 EDIT-PICTURE-01 PICTURE 9B(15)99. NC1054.2 +007300 77 EDIT-PICTURE-02 PICTURE $0(10)999. NC1054.2 +007400 77 EDIT-DATA-1 PICTURE 999 VALUE 333. NC1054.2 +007500 77 EDIT-DATA-2 PICTURE 999 VALUE 916. NC1054.2 +007600 01 GRP-EDIT-PIC-05. NC1054.2 +007700 02 EDIT-PIC-05 PICTURE $$$,999.99. NC1054.2 +007800 01 GRP-EDIT-PIC-06. NC1054.2 +007900 02 EDIT-PIC-06 PICTURE $$$B999.99. NC1054.2 +008000 01 GRP-EDIT-PIC-07. NC1054.2 +008100 02 EDIT-PIC-07 PICTURE +++,999.99. NC1054.2 +008200 01 GRP-EDIT-PIC-08. NC1054.2 +008300 02 EDIT-PIC-08 PICTURE ---,999.99. NC1054.2 +008400 01 GRP-EDIT-PIC-09. NC1054.2 +008500 02 EDIT-PIC-09 PICTURE ***,999.99. NC1054.2 +008600 01 GRP-EDIT-PIC-10. NC1054.2 +008700 02 EDIT-PIC-10 PICTURE ZZZ,999.99. NC1054.2 +008800 01 GRP-MOVE-CONSTANTS. NC1054.2 +008900 03 GRP-GROUP-MOVE-FROM. NC1054.2 +009000 04 GRP-ALPHABETIC. NC1054.2 +009100 05 ALPHABET-AN-00026 PICTURE A(26) NC1054.2 +009200 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC1054.2 +009300 04 GRP-NUMERIC. NC1054.2 +009400 05 DIGITS-DU-10V00 PICTURE 9(10) NC1054.2 +009500 VALUE 0123456789. NC1054.2 +009600 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DU-10V00 NC1054.2 +009700 PICTURE 9(6)V9999. NC1054.2 +009800 04 GRP-ALPHANUMERIC. NC1054.2 +009900 05 ALPHANUMERIC-XN-00049 PICTURE X(49) NC1054.2 +010000 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789". NC1054.2 +010100 01 GRP-ALPHANUMERIC-1001. NC1054.2 +010200 04 GRP-ALPHANUMERIC-1002. NC1054.2 +010300 05 ALPHANUMERIC-XN-00050 PICTURE X(50) VALUE NC1054.2 +010400 "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789 ". NC1054.2 +010500 01 GRP-MOVE-RECEIVING-FIELDS. NC1054.2 +010600 03 GRP-GROUP-MOVE-TO. NC1054.2 +010700 04 GRP-WRK-AN-00026. NC1054.2 +010800 05 WRK-AN-00026 PICTURE A(26). NC1054.2 +010900 04 GRP-WRK-DU-10V00. NC1054.2 +011000 05 WRK-DU-10V00 PICTURE 9(10). NC1054.2 +011100 04 GRP-WRK-XN-00049. NC1054.2 +011200 05 WRK-XN-00049 PICTURE X(49). NC1054.2 +011300 04 GRP-NE-0001. NC1054.2 +011400 05 NE-0001 PICTURE ZZZ,999.999,9. NC1054.2 +011500 04 GRP-NE-0002. NC1054.2 +011600 05 NE-0002 PICTURE Z(7),999. NC1054.2 +011700 04 GRP-AE-0001. NC1054.2 +011800 05 AE-0001 PICTURE X(26)BX(12)0X(10). NC1054.2 +011900 04 GRP-AE-0002. NC1054.2 +012000 05 AE-0002 PICTURE XX0XXBXXX. NC1054.2 +012100 01 GRP-NUMERIC-99 PICTURE 99 VALUE 99. NC1054.2 +012200 01 GRP-RECEIVING. NC1054.2 +012300 02 RECEIVE-1. NC1054.2 +012400 03 RECEIVE-2 PICTURE 99 VALUE 03. NC1054.2 +012500 03 RECEIVE-3 PICTURE 9A9 VALUE ZERO. NC1054.2 +012600 02 RECEIVE-4 PICTURE 9(5)V99 VALUE ZERO. NC1054.2 +012700 02 RECEIVE-5 PICTURE X(4) VALUE ZERO. NC1054.2 +012800 02 RECEIVE-6. NC1054.2 +012900 03 RECEIVE-7 PICTURE 999 VALUE ZERO. NC1054.2 +013000 03 RECEIVE-8 PICTURE AA VALUE "AA". NC1054.2 +013100 01 SEND-BREAKDOWN. NC1054.2 +013200 02 FIRST-20S PICTURE X(20). NC1054.2 +013300 02 SECOND-20S PICTURE X(20). NC1054.2 +013400 02 THIRD-20S PICTURE X(20). NC1054.2 +013500 02 FOURTH-20S PICTURE X(20). NC1054.2 +013600 02 FIFTH-20S PICTURE X(20). NC1054.2 +013700 02 SIXTH-20S PICTURE X(20). NC1054.2 +013800 01 RECEIVE-BREAKDOWN. NC1054.2 +013900 02 FIRST-20R PICTURE X(20). NC1054.2 +014000 02 SECOND-20R PICTURE X(20). NC1054.2 +014100 02 THIRD-20R PICTURE X(20). NC1054.2 +014200 02 FOURTH-20R PICTURE X(20). NC1054.2 +014300 02 FIFTH-20R PICTURE X(20). NC1054.2 +014400 02 SIXTH-20R PICTURE X(20). NC1054.2 +014500 01 FORTY-NINE-COMPARE. NC1054.2 +014600 02 FIRST-26 PICTURE X(26). NC1054.2 +014700 02 PADD-REST PICTURE X(23). NC1054.2 +014800 01 HIGH-VALUE-EDIT. NC1054.2 +014900 02 HIGH-1 PICTURE XX VALUE HIGH-VALUE. NC1054.2 +015000 02 FILLER PICTURE 9 VALUE 0. NC1054.2 +015100 02 HIGH-2 PICTURE XX VALUE HIGH-VALUE. NC1054.2 +015200 02 FILLER PICTURE X VALUE SPACE. NC1054.2 +015300 02 HIGH-3 PICTURE XXX VALUE HIGH-VALUE. NC1054.2 +015400 01 HIGH-VALU-10LONG PICTURE X(10) VALUE HIGH-VALUE. NC1054.2 +015500 01 LOW-VALU-10LONG PICTURE X(10) VALUE LOW-VALUE. NC1054.2 +015600 01 HIGH-VALU-49LONG PICTURE X(49) VALUE HIGH-VALUE. NC1054.2 +015700 01 LOW-VALU-49LONG PICTURE X(49) VALUE LOW-VALUE. NC1054.2 +015800 01 QUOTE-10LONG PICTURE X(10) VALUE QUOTE. NC1054.2 +015900 01 QUOTE-49LONG PICTURE X(49) VALUE QUOTE. NC1054.2 +016000 01 MOVE1 PICTURE IS 9(5) NC1054.2 +016100 VALUE IS 12345. NC1054.2 +016200 01 MOVE2 PICTURE IS 9(5). NC1054.2 +016300 01 MOVE3 PICTURE IS 99. NC1054.2 +016400 01 MOVE5 PICTURE IS 99V999. NC1054.2 +016500 01 MOVE6 PICTURE IS V99999. NC1054.2 +016600 01 MOVE7 PICTURE IS 9V99. NC1054.2 +016700 01 MOVE16 PICTURE IS 9(5)CR. NC1054.2 +016800 01 MOVE20 PICTURE IS X(4). NC1054.2 +016900 01 MOVE21 PICTURE IS X(7). NC1054.2 +017000 01 MOVE23 PICTURE IS 999V99 NC1054.2 +017100 VALUE IS 123.45. NC1054.2 +017200 01 MOVE29 PICTURE IS 9999V999. NC1054.2 +017300 01 MOVE29X REDEFINES MOVE29 PICTURE IS X(7). NC1054.2 +017400 01 MOVE29A VALUE IS "$123.45". NC1054.2 +017500 02 MOVE30 PICTURE IS $999.99. NC1054.2 +017600 01 MOVE32 PICTURE IS X(5) NC1054.2 +017700 VALUE IS "ABCDE". NC1054.2 +017800 01 MOVE35 PICTURE IS A(3). NC1054.2 +017900 01 MOVE35A VALUE IS "1 A05". NC1054.2 +018000 02 MOVE36 PICTURE IS XBA09. NC1054.2 +018100 01 MOVE37 PICTURE IS AAAAA NC1054.2 +018200 VALUE IS "ABCDE". NC1054.2 +018300 01 MOVE39 PICTURE IS 0XXXXX0. NC1054.2 +018400 01 MOVE40 PICTURE IS 9999V9. NC1054.2 +018500 01 MOVE41 PICTURE IS A(7) NC1054.2 +018600 JUSTIFIED RIGHT. NC1054.2 +018700 01 MOVE42. NC1054.2 +018800 02 MOVE43. NC1054.2 +018900 03 MOVE43A PICTURE IS 999 NC1054.2 +019000 VALUE IS 123. NC1054.2 +019100 03 MOVE43B PICTURE IS AAA NC1054.2 +019200 VALUE IS "ABC". NC1054.2 +019300 02 MOVE43C. NC1054.2 +019400 03 MOVE44 PICTURE IS 999 NC1054.2 +019500 VALUE IS 123. NC1054.2 +019600 03 MOVE45 PICTURE IS AAA NC1054.2 +019700 VALUE IS "ABC". NC1054.2 +019800 02 MOVE46 REDEFINES MOVE43C. NC1054.2 +019900 03 MOVE47 PICTURE IS X OCCURS NC1054.2 +020000 6 TIMES. NC1054.2 +020100 01 MOVE47A. NC1054.2 +020200 02 MOVE48 PICTURE IS 9V9(17). NC1054.2 +020300 02 MOVE49 PICTURE IS 9(5) NC1054.2 +020400 VALUE IS 00045. NC1054.2 +020500 02 MOVE51 PICTURE IS S9(5) NC1054.2 +020600 VALUE IS -12345. NC1054.2 +020700 02 MOVE51A PICTURE IS S9(5) NC1054.2 +020800 VALUE IS -00045. NC1054.2 +020900 02 MOVE52 PICTURE IS 9(5)-. NC1054.2 +021000 01 MOVE66 PICTURE IS 9(5)DB. NC1054.2 +021100 01 MOVE67 PICTURE IS 9(5)+. NC1054.2 +021200 01 MOVE68 PICTURE IS ++++99. NC1054.2 +021300 01 MOVE69 PICTURE IS ----99. NC1054.2 +021400 01 MOVE70 PICTURE IS 9(5). NC1054.2 +021500 01 MOVE71 PICTURE X(20). NC1054.2 +021600 01 MOVE72 PICTURE 9(10) NC1054.2 +021700 VALUE 3344556677. NC1054.2 +021800 01 MOVE73 PICTURE X(5)BA(10)0X. NC1054.2 +021900 01 GRP-LEV-NUMERIC. NC1054.2 +022000 02 NUMERIC-LIT PICTURE 9(5). NC1054.2 +022100 02 CU-05V00-001 PIC 9(5) USAGE COMP. NC1054.2 +022200 02 CU-03V02-001 PIC 999V99 USAGE COMP. NC1054.2 +022300 02 CS-05V00-001 PIC S9(5) USAGE IS COMP. NC1054.2 +022400 01 TEST-RESULTS. NC1054.2 +022500 02 FILLER PIC X VALUE SPACE. NC1054.2 +022600 02 FEATURE PIC X(20) VALUE SPACE. NC1054.2 +022700 02 FILLER PIC X VALUE SPACE. NC1054.2 +022800 02 P-OR-F PIC X(5) VALUE SPACE. NC1054.2 +022900 02 FILLER PIC X VALUE SPACE. NC1054.2 +023000 02 PAR-NAME. NC1054.2 +023100 03 FILLER PIC X(19) VALUE SPACE. NC1054.2 +023200 03 PARDOT-X PIC X VALUE SPACE. NC1054.2 +023300 03 DOTVALUE PIC 99 VALUE ZERO. NC1054.2 +023400 02 FILLER PIC X(8) VALUE SPACE. NC1054.2 +023500 02 RE-MARK PIC X(61). NC1054.2 +023600 01 TEST-COMPUTED. NC1054.2 +023700 02 FILLER PIC X(30) VALUE SPACE. NC1054.2 +023800 02 FILLER PIC X(17) VALUE NC1054.2 +023900 " COMPUTED=". NC1054.2 +024000 02 COMPUTED-X. NC1054.2 +024100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1054.2 +024200 03 COMPUTED-N REDEFINES COMPUTED-A NC1054.2 +024300 PIC -9(9).9(9). NC1054.2 +024400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1054.2 +024500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1054.2 +024600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1054.2 +024700 03 CM-18V0 REDEFINES COMPUTED-A. NC1054.2 +024800 04 COMPUTED-18V0 PIC -9(18). NC1054.2 +024900 04 FILLER PIC X. NC1054.2 +025000 03 FILLER PIC X(50) VALUE SPACE. NC1054.2 +025100 01 TEST-CORRECT. NC1054.2 +025200 02 FILLER PIC X(30) VALUE SPACE. NC1054.2 +025300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1054.2 +025400 02 CORRECT-X. NC1054.2 +025500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1054.2 +025600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1054.2 +025700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1054.2 +025800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1054.2 +025900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1054.2 +026000 03 CR-18V0 REDEFINES CORRECT-A. NC1054.2 +026100 04 CORRECT-18V0 PIC -9(18). NC1054.2 +026200 04 FILLER PIC X. NC1054.2 +026300 03 FILLER PIC X(2) VALUE SPACE. NC1054.2 +026400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1054.2 +026500 01 CCVS-C-1. NC1054.2 +026600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1054.2 +026700- "SS PARAGRAPH-NAME NC1054.2 +026800- " REMARKS". NC1054.2 +026900 02 FILLER PIC X(20) VALUE SPACE. NC1054.2 +027000 01 CCVS-C-2. NC1054.2 +027100 02 FILLER PIC X VALUE SPACE. NC1054.2 +027200 02 FILLER PIC X(6) VALUE "TESTED". NC1054.2 +027300 02 FILLER PIC X(15) VALUE SPACE. NC1054.2 +027400 02 FILLER PIC X(4) VALUE "FAIL". NC1054.2 +027500 02 FILLER PIC X(94) VALUE SPACE. NC1054.2 +027600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1054.2 +027700 01 REC-CT PIC 99 VALUE ZERO. NC1054.2 +027800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1054.2 +027900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1054.2 +028000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1054.2 +028100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1054.2 +028200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1054.2 +028300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1054.2 +028400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1054.2 +028500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1054.2 +028600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1054.2 +028700 01 CCVS-H-1. NC1054.2 +028800 02 FILLER PIC X(39) VALUE SPACES. NC1054.2 +028900 02 FILLER PIC X(42) VALUE NC1054.2 +029000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1054.2 +029100 02 FILLER PIC X(39) VALUE SPACES. NC1054.2 +029200 01 CCVS-H-2A. NC1054.2 +029300 02 FILLER PIC X(40) VALUE SPACE. NC1054.2 +029400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1054.2 +029500 02 FILLER PIC XXXX VALUE NC1054.2 +029600 "4.2 ". NC1054.2 +029700 02 FILLER PIC X(28) VALUE NC1054.2 +029800 " COPY - NOT FOR DISTRIBUTION". NC1054.2 +029900 02 FILLER PIC X(41) VALUE SPACE. NC1054.2 +030000 NC1054.2 +030100 01 CCVS-H-2B. NC1054.2 +030200 02 FILLER PIC X(15) VALUE NC1054.2 +030300 "TEST RESULT OF ". NC1054.2 +030400 02 TEST-ID PIC X(9). NC1054.2 +030500 02 FILLER PIC X(4) VALUE NC1054.2 +030600 " IN ". NC1054.2 +030700 02 FILLER PIC X(12) VALUE NC1054.2 +030800 " HIGH ". NC1054.2 +030900 02 FILLER PIC X(22) VALUE NC1054.2 +031000 " LEVEL VALIDATION FOR ". NC1054.2 +031100 02 FILLER PIC X(58) VALUE NC1054.2 +031200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1054.2 +031300 01 CCVS-H-3. NC1054.2 +031400 02 FILLER PIC X(34) VALUE NC1054.2 +031500 " FOR OFFICIAL USE ONLY ". NC1054.2 +031600 02 FILLER PIC X(58) VALUE NC1054.2 +031700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1054.2 +031800 02 FILLER PIC X(28) VALUE NC1054.2 +031900 " COPYRIGHT 1985 ". NC1054.2 +032000 01 CCVS-E-1. NC1054.2 +032100 02 FILLER PIC X(52) VALUE SPACE. NC1054.2 +032200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1054.2 +032300 02 ID-AGAIN PIC X(9). NC1054.2 +032400 02 FILLER PIC X(45) VALUE SPACES. NC1054.2 +032500 01 CCVS-E-2. NC1054.2 +032600 02 FILLER PIC X(31) VALUE SPACE. NC1054.2 +032700 02 FILLER PIC X(21) VALUE SPACE. NC1054.2 +032800 02 CCVS-E-2-2. NC1054.2 +032900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1054.2 +033000 03 FILLER PIC X VALUE SPACE. NC1054.2 +033100 03 ENDER-DESC PIC X(44) VALUE NC1054.2 +033200 "ERRORS ENCOUNTERED". NC1054.2 +033300 01 CCVS-E-3. NC1054.2 +033400 02 FILLER PIC X(22) VALUE NC1054.2 +033500 " FOR OFFICIAL USE ONLY". NC1054.2 +033600 02 FILLER PIC X(12) VALUE SPACE. NC1054.2 +033700 02 FILLER PIC X(58) VALUE NC1054.2 +033800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1054.2 +033900 02 FILLER PIC X(13) VALUE SPACE. NC1054.2 +034000 02 FILLER PIC X(15) VALUE NC1054.2 +034100 " COPYRIGHT 1985". NC1054.2 +034200 01 CCVS-E-4. NC1054.2 +034300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1054.2 +034400 02 FILLER PIC X(4) VALUE " OF ". NC1054.2 +034500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1054.2 +034600 02 FILLER PIC X(40) VALUE NC1054.2 +034700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1054.2 +034800 01 XXINFO. NC1054.2 +034900 02 FILLER PIC X(19) VALUE NC1054.2 +035000 "*** INFORMATION ***". NC1054.2 +035100 02 INFO-TEXT. NC1054.2 +035200 04 FILLER PIC X(8) VALUE SPACE. NC1054.2 +035300 04 XXCOMPUTED PIC X(20). NC1054.2 +035400 04 FILLER PIC X(5) VALUE SPACE. NC1054.2 +035500 04 XXCORRECT PIC X(20). NC1054.2 +035600 02 INF-ANSI-REFERENCE PIC X(48). NC1054.2 +035700 01 HYPHEN-LINE. NC1054.2 +035800 02 FILLER PIC IS X VALUE IS SPACE. NC1054.2 +035900 02 FILLER PIC IS X(65) VALUE IS "************************NC1054.2 +036000- "*****************************************". NC1054.2 +036100 02 FILLER PIC IS X(54) VALUE IS "************************NC1054.2 +036200- "******************************". NC1054.2 +036300 01 CCVS-PGM-ID PIC X(9) VALUE NC1054.2 +036400 "NC105A". NC1054.2 +036500 PROCEDURE DIVISION. NC1054.2 +036600 CCVS1 SECTION. NC1054.2 +036700 OPEN-FILES. NC1054.2 +036800 OPEN OUTPUT PRINT-FILE. NC1054.2 +036900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1054.2 +037000 MOVE SPACE TO TEST-RESULTS. NC1054.2 +037100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1054.2 +037200 GO TO CCVS1-EXIT. NC1054.2 +037300 CLOSE-FILES. NC1054.2 +037400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1054.2 +037500 TERMINATE-CCVS. NC1054.2 +037600*S EXIT PROGRAM. NC1054.2 +037700*SERMINATE-CALL. NC1054.2 +037800 STOP RUN. NC1054.2 +037900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1054.2 +038000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1054.2 +038100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1054.2 +038200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1054.2 +038300 MOVE "****TEST DELETED****" TO RE-MARK. NC1054.2 +038400 PRINT-DETAIL. NC1054.2 +038500 IF REC-CT NOT EQUAL TO ZERO NC1054.2 +038600 MOVE "." TO PARDOT-X NC1054.2 +038700 MOVE REC-CT TO DOTVALUE. NC1054.2 +038800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1054.2 +038900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1054.2 +039000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1054.2 +039100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1054.2 +039200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1054.2 +039300 MOVE SPACE TO CORRECT-X. NC1054.2 +039400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1054.2 +039500 MOVE SPACE TO RE-MARK. NC1054.2 +039600 HEAD-ROUTINE. NC1054.2 +039700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +039800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +039900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1054.2 +040000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1054.2 +040100 COLUMN-NAMES-ROUTINE. NC1054.2 +040200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +040300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +040400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +040500 END-ROUTINE. NC1054.2 +040600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1054.2 +040700 END-RTN-EXIT. NC1054.2 +040800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +040900 END-ROUTINE-1. NC1054.2 +041000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1054.2 +041100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1054.2 +041200 ADD PASS-COUNTER TO ERROR-HOLD. NC1054.2 +041300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1054.2 +041400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1054.2 +041500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1054.2 +041600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1054.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1054.2 +041800 END-ROUTINE-12. NC1054.2 +041900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1054.2 +042000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1054.2 +042100 MOVE "NO " TO ERROR-TOTAL NC1054.2 +042200 ELSE NC1054.2 +042300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1054.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1054.2 +042500 PERFORM WRITE-LINE. NC1054.2 +042600 END-ROUTINE-13. NC1054.2 +042700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1054.2 +042800 MOVE "NO " TO ERROR-TOTAL ELSE NC1054.2 +042900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1054.2 +043000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1054.2 +043100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +043200 IF INSPECT-COUNTER EQUAL TO ZERO NC1054.2 +043300 MOVE "NO " TO ERROR-TOTAL NC1054.2 +043400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1054.2 +043500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1054.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +043700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1054.2 +043800 WRITE-LINE. NC1054.2 +043900 ADD 1 TO RECORD-COUNT. NC1054.2 +044000 IF RECORD-COUNT GREATER 42 NC1054.2 +044100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1054.2 +044200 MOVE SPACE TO DUMMY-RECORD NC1054.2 +044300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1054.2 +044400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1054.2 +044500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1054.2 +044600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1054.2 +044700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1054.2 +044800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1054.2 +044900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1054.2 +045000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1054.2 +045100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1054.2 +045200 MOVE ZERO TO RECORD-COUNT. NC1054.2 +045300 PERFORM WRT-LN. NC1054.2 +045400 WRT-LN. NC1054.2 +045500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1054.2 +045600 MOVE SPACE TO DUMMY-RECORD. NC1054.2 +045700 BLANK-LINE-PRINT. NC1054.2 +045800 PERFORM WRT-LN. NC1054.2 +045900 FAIL-ROUTINE. NC1054.2 +046000 IF COMPUTED-X NOT EQUAL TO SPACE NC1054.2 +046100 GO TO FAIL-ROUTINE-WRITE. NC1054.2 +046200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1054.2 +046300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1054.2 +046400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1054.2 +046500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +046600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1054.2 +046700 GO TO FAIL-ROUTINE-EX. NC1054.2 +046800 FAIL-ROUTINE-WRITE. NC1054.2 +046900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1054.2 +047000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1054.2 +047100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1054.2 +047200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1054.2 +047300 FAIL-ROUTINE-EX. EXIT. NC1054.2 +047400 BAIL-OUT. NC1054.2 +047500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1054.2 +047600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1054.2 +047700 BAIL-OUT-WRITE. NC1054.2 +047800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1054.2 +047900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1054.2 +048000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1054.2 +048100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1054.2 +048200 BAIL-OUT-EX. EXIT. NC1054.2 +048300 CCVS1-EXIT. NC1054.2 +048400 EXIT. NC1054.2 +048500 SECT-NC105A-001 SECTION. NC1054.2 +048600 MOVE-INIT-F1-1. NC1054.2 +048700 MOVE "VI-102 6.18.2" TO ANSI-REFERENCE. NC1054.2 +048800 MOVE "MOVE LITERAL " TO FEATURE. NC1054.2 +048900 MOVE-TEST-F1-1-0. NC1054.2 +049000 MOVE 123.45 TO MOVE40. NC1054.2 +049100 MOVE-TEST-F1-1-1. NC1054.2 +049200 IF MOVE40 EQUAL TO 123.4 NC1054.2 +049300 PERFORM PASS NC1054.2 +049400 ELSE NC1054.2 +049500 GO TO MOVE-FAIL-F1-1. NC1054.2 +049600* NOTE NUMERIC LITERAL NON INTEGRAL TO NNI MOVE, TRUNCATION ON NC1054.2 +049700* RIGHT, ZERO PADDIND ON LEFT. NC1054.2 +049800 GO TO MOVE-WRITE-F1-1. NC1054.2 +049900 MOVE-DELETE-F1-1. NC1054.2 +050000 PERFORM DE-LETE. NC1054.2 +050100 GO TO MOVE-WRITE-F1-1. NC1054.2 +050200 MOVE-FAIL-F1-1. NC1054.2 +050300 MOVE MOVE40 TO COMPUTED-N. NC1054.2 +050400 MOVE 123.4 TO CORRECT-N. NC1054.2 +050500 PERFORM FAIL. NC1054.2 +050600 MOVE-WRITE-F1-1. NC1054.2 +050700 MOVE "MOVE-TEST-F1-1" TO PAR-NAME. NC1054.2 +050800 PERFORM PRINT-DETAIL. NC1054.2 +050900 MOVE-TEST-F1-2-0. NC1054.2 +051000 MOVE 123.45 TO MOVE5. NC1054.2 +051100 MOVE-TEST-F1-2-1. NC1054.2 +051200 IF MOVE5 EQUAL TO 23.45 NC1054.2 +051300 PERFORM PASS NC1054.2 +051400 ELSE NC1054.2 +051500 GO TO MOVE-FAIL-F1-2. NC1054.2 +051600* NOTE NUMERIC LITERAL NON-INTEGRAL TO NNI MOVE, TRUNCATION ON NC1054.2 +051700* LEFT, ZERO PADDING ON RIGHT. NC1054.2 +051800 GO TO MOVE-WRITE-F1-2. NC1054.2 +051900 MOVE-DELETE-F1-2. NC1054.2 +052000 PERFORM DE-LETE. NC1054.2 +052100 GO TO MOVE-WRITE-F1-2. NC1054.2 +052200 MOVE-FAIL-F1-2. NC1054.2 +052300 MOVE MOVE5 TO COMPUTED-N. NC1054.2 +052400 MOVE 23.45 TO CORRECT-N. NC1054.2 +052500 PERFORM FAIL. NC1054.2 +052600 MOVE-WRITE-F1-2. NC1054.2 +052700 MOVE "MOVE-TEST-F1-2" TO PAR-NAME. NC1054.2 +052800 PERFORM PRINT-DETAIL. NC1054.2 +052900 MOVE-TEST-F1-3-0. NC1054.2 +053000 MOVE "ABCDE" TO MOVE21. NC1054.2 +053100 MOVE-TEST-F1-3-1. NC1054.2 +053200 IF MOVE21 EQUAL TO "ABCDE " NC1054.2 +053300 PERFORM PASS NC1054.2 +053400 ELSE NC1054.2 +053500 GO TO MOVE-FAIL-F1-3. NC1054.2 +053600* NOTE NON-NUMERIC LITERAL TO AN MOVE, SPACE PADDING ON RIGHT. NC1054.2 +053700 GO TO MOVE-WRITE-F1-3. NC1054.2 +053800 MOVE-DELETE-F1-3. NC1054.2 +053900 PERFORM DE-LETE. NC1054.2 +054000 GO TO MOVE-WRITE-F1-3. NC1054.2 +054100 MOVE-FAIL-F1-3. NC1054.2 +054200 MOVE MOVE21 TO COMPUTED-A. NC1054.2 +054300 MOVE "ABCDE " TO CORRECT-A. NC1054.2 +054400 PERFORM FAIL. NC1054.2 +054500 MOVE-WRITE-F1-3. NC1054.2 +054600 MOVE "MOVE-TEST-F1-3" TO PAR-NAME. NC1054.2 +054700 PERFORM PRINT-DETAIL. NC1054.2 +054800 MOVE-TEST-F1-4-0. NC1054.2 +054900 MOVE "ABCDE" TO MOVE20. NC1054.2 +055000 MOVE-TEST-F1-4-1. NC1054.2 +055100 IF MOVE20 EQUAL TO "ABCD" NC1054.2 +055200 PERFORM PASS NC1054.2 +055300 ELSE NC1054.2 +055400 GO TO MOVE-FAIL-F1-4. NC1054.2 +055500* NOTE NON-NUMERIC LITERAL TO AN MOVE, TRUNCATION ON RIGHT. NC1054.2 +055600 GO TO MOVE-WRITE-F1-4. NC1054.2 +055700 MOVE-DELETE-F1-4. NC1054.2 +055800 PERFORM DE-LETE. NC1054.2 +055900 GO TO MOVE-WRITE-F1-4. NC1054.2 +056000 MOVE-FAIL-F1-4. NC1054.2 +056100 MOVE MOVE20 TO COMPUTED-A. NC1054.2 +056200 MOVE "ABCD" TO CORRECT-A. NC1054.2 +056300 PERFORM FAIL. NC1054.2 +056400 MOVE-WRITE-F1-4. NC1054.2 +056500 MOVE "MOVE-TEST-F1-4" TO PAR-NAME. NC1054.2 +056600 PERFORM PRINT-DETAIL. NC1054.2 +056700 MOVE-INIT-F1-5. NC1054.2 +056800 MOVE "MISC MOVE " TO FEATURE. NC1054.2 +056900 MOVE 12345 TO MOVE1. NC1054.2 +057000 MOVE-TEST-F1-5-0. NC1054.2 +057100 MOVE MOVE1 TO TA--X. NC1054.2 +057200 MOVE-TEST-F1-5-1. NC1054.2 +057300 IF TA--X EQUAL TO 12345 NC1054.2 +057400 PERFORM PASS NC1054.2 +057500 ELSE NC1054.2 +057600 GO TO MOVE-FAIL-F1-5. NC1054.2 +057700* NOTE NUMERIC LITERAL TO COMP, ZERO FILL ON LEFT. NC1054.2 +057800 GO TO MOVE-WRITE-F1-5. NC1054.2 +057900 MOVE-DELETE-F1-5. NC1054.2 +058000 PERFORM DE-LETE. NC1054.2 +058100 GO TO MOVE-WRITE-F1-5. NC1054.2 +058200 MOVE-FAIL-F1-5. NC1054.2 +058300 MOVE TA--X TO COMPUTED-N. NC1054.2 +058400 MOVE 12345 TO CORRECT-N. NC1054.2 +058500 PERFORM FAIL. NC1054.2 +058600 MOVE-WRITE-F1-5. NC1054.2 +058700 MOVE "MOVE-TEST-F1-5" TO PAR-NAME. NC1054.2 +058800 PERFORM PRINT-DETAIL. NC1054.2 +058900 MOVE-TEST-F1-6-0. NC1054.2 +059000 MOVE SPACE TO MOVE20. NC1054.2 +059100 MOVE-TEST-F1-6-1. NC1054.2 +059200 IF MOVE20 EQUAL TO " " NC1054.2 +059300 PERFORM PASS NC1054.2 +059400 ELSE NC1054.2 +059500 GO TO MOVE-FAIL-F1-6. NC1054.2 +059600* NOTE FIGURATIVE CONSTANT SPACE TO AN MOVE. NC1054.2 +059700 GO TO MOVE-WRITE-F1-6. NC1054.2 +059800 MOVE-DELETE-F1-6. NC1054.2 +059900 PERFORM DE-LETE. NC1054.2 +060000 GO TO MOVE-WRITE-F1-6. NC1054.2 +060100 MOVE-FAIL-F1-6. NC1054.2 +060200 MOVE MOVE20 TO COMPUTED-A. NC1054.2 +060300 MOVE " " TO CORRECT-A. NC1054.2 +060400 PERFORM FAIL. NC1054.2 +060500 MOVE-WRITE-F1-6. NC1054.2 +060600 MOVE "MOVE-TEST-F1-6" TO PAR-NAME. NC1054.2 +060700 PERFORM PRINT-DETAIL. NC1054.2 +060800 MOVE-TEST-F1-7-0. NC1054.2 +060900 MOVE ZERO TO MOVE2. NC1054.2 +061000 MOVE-TEST-F1-7-1. NC1054.2 +061100 IF MOVE2 EQUAL TO 00000 NC1054.2 +061200 PERFORM PASS NC1054.2 +061300 ELSE NC1054.2 +061400 GO TO MOVE-FAIL-F1-7. NC1054.2 +061500* NOTE FIGURATIVE CONSTANT ZERO TO N MOVE. NC1054.2 +061600 GO TO MOVE-WRITE-F1-7. NC1054.2 +061700 MOVE-DELETE-F1-7. NC1054.2 +061800 PERFORM DE-LETE. NC1054.2 +061900 GO TO MOVE-WRITE-F1-7. NC1054.2 +062000 MOVE-FAIL-F1-7. NC1054.2 +062100 MOVE MOVE2 TO COMPUTED-N. NC1054.2 +062200 MOVE 00000 TO CORRECT-N. NC1054.2 +062300 PERFORM FAIL. NC1054.2 +062400 MOVE-WRITE-F1-7. NC1054.2 +062500 MOVE "MOVE-TEST-F1-7" TO PAR-NAME. NC1054.2 +062600 PERFORM PRINT-DETAIL. NC1054.2 +062700 MOVE-INIT-F1-8. NC1054.2 +062800 MOVE "ABCDE" TO MOVE32. NC1054.2 +062900 MOVE-TEST-F1-8-0. NC1054.2 +063000 MOVE MOVE32 TO MOVE41. NC1054.2 +063100 MOVE-TEST-F1-8-1. NC1054.2 +063200 IF MOVE41 EQUAL TO " ABCDE" NC1054.2 +063300 PERFORM PASS NC1054.2 +063400 ELSE NC1054.2 +063500 GO TO MOVE-FAIL-F1-8. NC1054.2 +063600* NOTE AN TO A MOVE, JUSTIFIED RIGHT. NC1054.2 +063700 GO TO MOVE-WRITE-F1-8. NC1054.2 +063800 MOVE-DELETE-F1-8. NC1054.2 +063900 PERFORM DE-LETE. NC1054.2 +064000 GO TO MOVE-WRITE-F1-8. NC1054.2 +064100 MOVE-FAIL-F1-8. NC1054.2 +064200 MOVE MOVE41 TO COMPUTED-A. NC1054.2 +064300 MOVE " ABCDE" TO CORRECT-A. NC1054.2 +064400 PERFORM FAIL. NC1054.2 +064500 MOVE-WRITE-F1-8. NC1054.2 +064600 MOVE "MOVE-TEST-F1-8" TO PAR-NAME. NC1054.2 +064700 PERFORM PRINT-DETAIL. NC1054.2 +064800 MOVE-INIT-F1-9. NC1054.2 +064900 MOVE "GROUP MOVE " TO FEATURE. NC1054.2 +065000 MOVE 12345 TO MOVE1. NC1054.2 +065100 MOVE-TEST-F1-9-0. NC1054.2 +065200 MOVE MOVE1 TO MOVE46. NC1054.2 +065300 MOVE-TEST-F1-9-1. NC1054.2 +065400 IF MOVE46 EQUAL TO "12345 " NC1054.2 +065500 PERFORM PASS NC1054.2 +065600 ELSE NC1054.2 +065700 GO TO MOVE-FAIL-F1-9. NC1054.2 +065800* NOTE NI TO GROUP MOVE. NC1054.2 +065900 GO TO MOVE-WRITE-F1-9. NC1054.2 +066000 MOVE-DELETE-F1-9. NC1054.2 +066100 PERFORM DE-LETE. NC1054.2 +066200 GO TO MOVE-WRITE-F1-9. NC1054.2 +066300 MOVE-FAIL-F1-9. NC1054.2 +066400 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +066500 MOVE "12345 " TO CORRECT-A. NC1054.2 +066600 PERFORM FAIL. NC1054.2 +066700 MOVE-WRITE-F1-9. NC1054.2 +066800 MOVE "MOVE-TEST-F1-9" TO PAR-NAME. NC1054.2 +066900 PERFORM PRINT-DETAIL. NC1054.2 +067000 MOVE-INIT-F1-10. NC1054.2 +067100 MOVE 123.45 TO MOVE23. NC1054.2 +067200 MOVE-TEST-F1-10-0. NC1054.2 +067300 MOVE MOVE23 TO MOVE46. NC1054.2 +067400 MOVE-TEST-F1-10-1. NC1054.2 +067500 IF MOVE46 EQUAL TO "12345 " NC1054.2 +067600 PERFORM PASS NC1054.2 +067700 ELSE NC1054.2 +067800 GO TO MOVE-FAIL-F1-10. NC1054.2 +067900* NOTE NNI TO GROUP MOVE. NC1054.2 +068000 GO TO MOVE-WRITE-F1-10. NC1054.2 +068100 MOVE-DELETE-F1-10. NC1054.2 +068200 PERFORM DE-LETE. NC1054.2 +068300 GO TO MOVE-WRITE-F1-10. NC1054.2 +068400 MOVE-FAIL-F1-10. NC1054.2 +068500 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +068600 MOVE "12345 " TO CORRECT-A. NC1054.2 +068700 PERFORM FAIL. NC1054.2 +068800 MOVE-WRITE-F1-10. NC1054.2 +068900 MOVE "MOVE-TEST-F1-10" TO PAR-NAME. NC1054.2 +069000 PERFORM PRINT-DETAIL. NC1054.2 +069100 MOVE-INIT-F1-11. NC1054.2 +069200 MOVE "$123.45" TO MOVE29A. NC1054.2 +069300 MOVE-TEST-F1-11-0. NC1054.2 +069400 MOVE MOVE30 TO MOVE46. NC1054.2 +069500 MOVE-TEST-F1-11-1. NC1054.2 +069600 IF MOVE46 EQUAL TO "$123.4" NC1054.2 +069700 PERFORM PASS NC1054.2 +069800 ELSE NC1054.2 +069900 GO TO MOVE-FAIL-F1-11. NC1054.2 +070000* NOTE NE TO GROUP MOVE. NC1054.2 +070100 GO TO MOVE-WRITE-F1-11. NC1054.2 +070200 MOVE-DELETE-F1-11. NC1054.2 +070300 PERFORM DE-LETE. NC1054.2 +070400 GO TO MOVE-WRITE-F1-11. NC1054.2 +070500 MOVE-FAIL-F1-11. NC1054.2 +070600 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +070700 MOVE "$123.4" TO CORRECT-A. NC1054.2 +070800 PERFORM FAIL. NC1054.2 +070900 MOVE-WRITE-F1-11. NC1054.2 +071000 MOVE "MOVE-TEST-F1-11" TO PAR-NAME. NC1054.2 +071100 PERFORM PRINT-DETAIL. NC1054.2 +071200 MOVE-INIT-F1-12. NC1054.2 +071300 MOVE "ABCDE" TO MOVE32. NC1054.2 +071400 MOVE-TEST-F1-12-0. NC1054.2 +071500 MOVE MOVE32 TO MOVE46. NC1054.2 +071600 MOVE-TEST-F1-12-1. NC1054.2 +071700 IF MOVE46 EQUAL TO "ABCDE " NC1054.2 +071800 PERFORM PASS NC1054.2 +071900 ELSE NC1054.2 +072000 GO TO MOVE-FAIL-F1-12. NC1054.2 +072100* NOTE AN TO GROUP MOVE. NC1054.2 +072200 GO TO MOVE-WRITE-F1-12. NC1054.2 +072300 MOVE-DELETE-F1-12. NC1054.2 +072400 PERFORM DE-LETE. NC1054.2 +072500 GO TO MOVE-WRITE-F1-12. NC1054.2 +072600 MOVE-FAIL-F1-12. NC1054.2 +072700 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +072800 MOVE "ABCDE" TO CORRECT-A. NC1054.2 +072900 PERFORM FAIL. NC1054.2 +073000 MOVE-WRITE-F1-12. NC1054.2 +073100 MOVE "MOVE-TEST-F1-12" TO PAR-NAME. NC1054.2 +073200 PERFORM PRINT-DETAIL. NC1054.2 +073300 MOVE-INIT-F1-13. NC1054.2 +073400 MOVE "1 A05" TO MOVE35A. NC1054.2 +073500 MOVE-TEST-F1-13-0. NC1054.2 +073600 MOVE MOVE36 TO MOVE46. NC1054.2 +073700 MOVE-TEST-F1-13-1. NC1054.2 +073800 IF MOVE46 EQUAL TO "1 A05 " NC1054.2 +073900 PERFORM PASS NC1054.2 +074000 ELSE NC1054.2 +074100 GO TO MOVE-FAIL-F1-13. NC1054.2 +074200* NOTE AE TO GROUP MOVE. NC1054.2 +074300 GO TO MOVE-WRITE-F1-13. NC1054.2 +074400 MOVE-DELETE-F1-13. NC1054.2 +074500 PERFORM DE-LETE. NC1054.2 +074600 GO TO MOVE-WRITE-F1-13. NC1054.2 +074700 MOVE-FAIL-F1-13. NC1054.2 +074800 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +074900 MOVE "1 A05 " TO CORRECT-A. NC1054.2 +075000 PERFORM FAIL. NC1054.2 +075100 MOVE-WRITE-F1-13. NC1054.2 +075200 MOVE "MOVE-TEST-F1-13" TO PAR-NAME. NC1054.2 +075300 PERFORM PRINT-DETAIL. NC1054.2 +075400 MOVE-INIT-F1-14. NC1054.2 +075500 MOVE "ABCDE" TO MOVE37. NC1054.2 +075600 MOVE-TEST-F1-14-0. NC1054.2 +075700 MOVE MOVE37 TO MOVE46. NC1054.2 +075800 MOVE-TEST-F1-14-1. NC1054.2 +075900 IF MOVE46 EQUAL TO "ABCDE " NC1054.2 +076000 PERFORM PASS NC1054.2 +076100 ELSE NC1054.2 +076200 GO TO MOVE-FAIL-F1-14. NC1054.2 +076300* NOTE A TO GROUP MOVE. NC1054.2 +076400 GO TO MOVE-WRITE-F1-14. NC1054.2 +076500 MOVE-DELETE-F1-14. NC1054.2 +076600 PERFORM DE-LETE. NC1054.2 +076700 GO TO MOVE-WRITE-F1-14. NC1054.2 +076800 MOVE-FAIL-F1-14. NC1054.2 +076900 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +077000 MOVE "ABCDE " TO CORRECT-A. NC1054.2 +077100 PERFORM FAIL. NC1054.2 +077200 MOVE-WRITE-F1-14. NC1054.2 +077300 MOVE "MOVE-TEST-F1-14" TO PAR-NAME. NC1054.2 +077400 PERFORM PRINT-DETAIL. NC1054.2 +077500 MOVE-INIT-F1-15. NC1054.2 +077600 MOVE "123ABC" TO MOVE43. NC1054.2 +077700 MOVE-TEST-F1-15-0. NC1054.2 +077800 MOVE MOVE43 TO MOVE46. NC1054.2 +077900 MOVE-TEST-F1-15-1. NC1054.2 +078000 IF MOVE46 EQUAL TO "123ABC" NC1054.2 +078100 PERFORM PASS NC1054.2 +078200 ELSE NC1054.2 +078300 GO TO MOVE-FAIL-F1-15. NC1054.2 +078400* NOTE GROUP TO GROUP MOVE. NC1054.2 +078500 GO TO MOVE-WRITE-F1-15. NC1054.2 +078600 MOVE-DELETE-F1-15. NC1054.2 +078700 PERFORM DE-LETE. NC1054.2 +078800 GO TO MOVE-WRITE-F1-15. NC1054.2 +078900 MOVE-FAIL-F1-15. NC1054.2 +079000 MOVE MOVE46 TO COMPUTED-A. NC1054.2 +079100 MOVE "123ABC" TO CORRECT-A. NC1054.2 +079200 PERFORM FAIL. NC1054.2 +079300 MOVE-WRITE-F1-15. NC1054.2 +079400 MOVE "MOVE-TEST-F1-15" TO PAR-NAME. NC1054.2 +079500 PERFORM PRINT-DETAIL. NC1054.2 +079600 MOVE-INIT-F1-16. NC1054.2 +079700 MOVE "123ABC" TO MOVE43. NC1054.2 +079800 MOVE-TEST-F1-16-0. NC1054.2 +079900 MOVE MOVE43 TO MOVE3. NC1054.2 +080000 MOVE-TEST-F1-16-1. NC1054.2 +080100 IF MOVE3 EQUAL TO 12 NC1054.2 +080200 PERFORM PASS NC1054.2 +080300 ELSE NC1054.2 +080400 GO TO MOVE-FAIL-F1-16. NC1054.2 +080500* NOTE GROUP TO NI MOVE. NC1054.2 +080600 GO TO MOVE-WRITE-F1-16. NC1054.2 +080700 MOVE-DELETE-F1-16. NC1054.2 +080800 PERFORM DE-LETE. NC1054.2 +080900 GO TO MOVE-WRITE-F1-16. NC1054.2 +081000 MOVE-FAIL-F1-16. NC1054.2 +081100 MOVE MOVE3 TO COMPUTED-N. NC1054.2 +081200 MOVE 12 TO CORRECT-N. NC1054.2 +081300 PERFORM FAIL. NC1054.2 +081400 MOVE-WRITE-F1-16. NC1054.2 +081500 MOVE "MOVE-TEST-F1-16" TO PAR-NAME. NC1054.2 +081600 PERFORM PRINT-DETAIL. NC1054.2 +081700 MOVE-INIT-F1-17. NC1054.2 +081800 MOVE "123ABC" TO MOVE43. NC1054.2 +081900 MOVE-TEST-F1-17-0. NC1054.2 +082000 MOVE MOVE43 TO MOVE29. NC1054.2 +082100 MOVE-TEST-F1-17-1. NC1054.2 +082200 IF MOVE29X EQUAL TO "123ABC " NC1054.2 +082300 PERFORM PASS NC1054.2 +082400 ELSE NC1054.2 +082500 GO TO MOVE-FAIL-F1-17. NC1054.2 +082600* NOTE GROUP TO NNI MOVE. NC1054.2 +082700 GO TO MOVE-WRITE-F1-17. NC1054.2 +082800 MOVE-DELETE-F1-17. NC1054.2 +082900 PERFORM DE-LETE. NC1054.2 +083000 GO TO MOVE-WRITE-F1-17. NC1054.2 +083100 MOVE-FAIL-F1-17. NC1054.2 +083200 MOVE MOVE29X TO COMPUTED-A. NC1054.2 +083300 MOVE "123ABC" TO CORRECT-A. NC1054.2 +083400 PERFORM FAIL. NC1054.2 +083500 MOVE-WRITE-F1-17. NC1054.2 +083600 MOVE "MOVE-TEST-F1-17" TO PAR-NAME. NC1054.2 +083700 PERFORM PRINT-DETAIL. NC1054.2 +083800 MOVE-INIT-F1-18. NC1054.2 +083900 MOVE "123ABC" TO MOVE43. NC1054.2 +084000 MOVE-TEST-F1-18-0. NC1054.2 +084100 MOVE MOVE43 TO MOVE21. NC1054.2 +084200 MOVE-TEST-F1-18-1. NC1054.2 +084300 IF MOVE21 EQUAL TO "123ABC " NC1054.2 +084400 PERFORM PASS NC1054.2 +084500 ELSE NC1054.2 +084600 GO TO MOVE-FAIL-F1-18. NC1054.2 +084700* NOTE GROUP TO AN MOVE SPACE PADDING ON RIGHT. NC1054.2 +084800 GO TO MOVE-WRITE-F1-18. NC1054.2 +084900 MOVE-DELETE-F1-18. NC1054.2 +085000 PERFORM DE-LETE. NC1054.2 +085100 GO TO MOVE-WRITE-F1-18. NC1054.2 +085200 MOVE-FAIL-F1-18. NC1054.2 +085300 MOVE MOVE21 TO COMPUTED-A. NC1054.2 +085400 MOVE "123ABC" TO CORRECT-A. NC1054.2 +085500 PERFORM FAIL. NC1054.2 +085600 MOVE-WRITE-F1-18. NC1054.2 +085700 MOVE "MOVE-TEST-F1-18" TO PAR-NAME. NC1054.2 +085800 PERFORM PRINT-DETAIL. NC1054.2 +085900 MOVE-INIT-F1-19. NC1054.2 +086000 MOVE "123ABC" TO MOVE43. NC1054.2 +086100 MOVE-TEST-F1-19-0. NC1054.2 +086200 MOVE MOVE43 TO MOVE20. NC1054.2 +086300 MOVE-TEST-F1-19-1. NC1054.2 +086400 IF MOVE20 EQUAL TO "123A" NC1054.2 +086500 PERFORM PASS NC1054.2 +086600 ELSE NC1054.2 +086700 GO TO MOVE-FAIL-F1-19. NC1054.2 +086800* NOTE GROUP TO AN MOVE. NC1054.2 +086900 GO TO MOVE-WRITE-F1-19. NC1054.2 +087000 MOVE-DELETE-F1-19. NC1054.2 +087100 PERFORM DE-LETE. NC1054.2 +087200 GO TO MOVE-WRITE-F1-19. NC1054.2 +087300 MOVE-FAIL-F1-19. NC1054.2 +087400 MOVE MOVE20 TO COMPUTED-A. NC1054.2 +087500 MOVE "123A" TO CORRECT-A. NC1054.2 +087600 PERFORM FAIL. NC1054.2 +087700 MOVE-WRITE-F1-19. NC1054.2 +087800 MOVE "MOVE-TEST-F1-19" TO PAR-NAME. NC1054.2 +087900 PERFORM PRINT-DETAIL. NC1054.2 +088000 MOVE-INIT-F1-20. NC1054.2 +088100 MOVE "123ABC" TO MOVE43. NC1054.2 +088200 MOVE-TEST-F1-20-0. NC1054.2 +088300 MOVE MOVE43 TO MOVE39. NC1054.2 +088400 MOVE-TEST-F1-20-1. NC1054.2 +088500 IF MOVE39 NOT EQUAL TO "123ABC " NC1054.2 +088600 GO TO MOVE-FAIL-F1-20. NC1054.2 +088700* NOTE GROUP TO AE MOVE. NC1054.2 +088800 PERFORM PASS. NC1054.2 +088900 GO TO MOVE-WRITE-F1-20. NC1054.2 +089000 MOVE-DELETE-F1-20. NC1054.2 +089100 PERFORM DE-LETE. NC1054.2 +089200 GO TO MOVE-WRITE-F1-20. NC1054.2 +089300 MOVE-FAIL-F1-20. NC1054.2 +089400 MOVE MOVE39 TO COMPUTED-A. NC1054.2 +089500 MOVE "123ABC" TO CORRECT-A. NC1054.2 +089600 PERFORM FAIL. NC1054.2 +089700 MOVE-WRITE-F1-20. NC1054.2 +089800 MOVE "MOVE-TEST-F1-20" TO PAR-NAME. NC1054.2 +089900 PERFORM PRINT-DETAIL. NC1054.2 +090000 MOVE-INIT-F1-21. NC1054.2 +090100 MOVE "123ABC" TO MOVE43. NC1054.2 +090200 MOVE-TEST-F1-21-0. NC1054.2 +090300 MOVE MOVE43 TO MOVE35. NC1054.2 +090400 MOVE-TEST-F1-21-1. NC1054.2 +090500 IF MOVE35 EQUAL TO "123" NC1054.2 +090600 PERFORM PASS NC1054.2 +090700 ELSE NC1054.2 +090800 GO TO MOVE-FAIL-F1-21. NC1054.2 +090900* NOTE GROUP TO A MOVE. NC1054.2 +091000 GO TO MOVE-WRITE-F1-21. NC1054.2 +091100 MOVE-DELETE-F1-21. NC1054.2 +091200 PERFORM DE-LETE. NC1054.2 +091300 GO TO MOVE-WRITE-F1-21. NC1054.2 +091400 MOVE-FAIL-F1-21. NC1054.2 +091500 MOVE MOVE35 TO COMPUTED-A. NC1054.2 +091600 MOVE "123" TO CORRECT-A. NC1054.2 +091700 PERFORM FAIL. NC1054.2 +091800 MOVE-WRITE-F1-21. NC1054.2 +091900 MOVE "MOVE-TEST-F1-21" TO PAR-NAME. NC1054.2 +092000 PERFORM PRINT-DETAIL. NC1054.2 +092100 MOVE-INIT-F1-22. NC1054.2 +092200 MOVE "EDITED MOVE " TO FEATURE. NC1054.2 +092300 MOVE "12345" TO MOVE1. NC1054.2 +092400 MOVE-TEST-F1-22-0. NC1054.2 +092500 MOVE MOVE1 TO MOVE16. NC1054.2 +092600 MOVE-TEST-F1-22-1. NC1054.2 +092700 IF MOVE16 EQUAL TO "12345 " NC1054.2 +092800 PERFORM PASS NC1054.2 +092900 ELSE NC1054.2 +093000 GO TO MOVE-FAIL-F1-22. NC1054.2 +093100* NOTE NI TO NE MOVE, REPORT SYMBOL CR. NC1054.2 +093200 GO TO MOVE-WRITE-F1-22. NC1054.2 +093300 MOVE-DELETE-F1-22. NC1054.2 +093400 PERFORM DE-LETE. NC1054.2 +093500 GO TO MOVE-WRITE-F1-22. NC1054.2 +093600 MOVE-FAIL-F1-22. NC1054.2 +093700 MOVE MOVE16 TO COMPUTED-A. NC1054.2 +093800 MOVE "12345 " TO CORRECT-A. NC1054.2 +093900 PERFORM FAIL. NC1054.2 +094000 MOVE-WRITE-F1-22. NC1054.2 +094100 MOVE "MOVE-TEST-F1-22" TO PAR-NAME. NC1054.2 +094200 PERFORM PRINT-DETAIL. NC1054.2 +094300 MOVE-INIT-F1-23. NC1054.2 +094400 MOVE "12345" TO MOVE1. NC1054.2 +094500 MOVE-TEST-F1-23-0. NC1054.2 +094600 MOVE MOVE1 TO MOVE52. NC1054.2 +094700 MOVE-TEST-F1-23-1. NC1054.2 +094800 IF MOVE52 EQUAL TO "12345 " NC1054.2 +094900 PERFORM PASS NC1054.2 +095000 ELSE NC1054.2 +095100 GO TO MOVE-FAIL-F1-23. NC1054.2 +095200* NOTE NI TO NE MOVE, REPORT SIGN -. NC1054.2 +095300 GO TO MOVE-WRITE-F1-23. NC1054.2 +095400 MOVE-DELETE-F1-23. NC1054.2 +095500 PERFORM DE-LETE. NC1054.2 +095600 GO TO MOVE-WRITE-F1-23. NC1054.2 +095700 MOVE-FAIL-F1-23. NC1054.2 +095800 MOVE MOVE52 TO COMPUTED-A. NC1054.2 +095900 MOVE "12345 " TO CORRECT-A. NC1054.2 +096000 PERFORM FAIL. NC1054.2 +096100 MOVE-WRITE-F1-23. NC1054.2 +096200 MOVE "MOVE-TEST-F1-23" TO PAR-NAME. NC1054.2 +096300 PERFORM PRINT-DETAIL. NC1054.2 +096400 MOVE-INIT-F1-24. NC1054.2 +096500 MOVE -12345 TO MOVE51. NC1054.2 +096600 MOVE-TEST-F1-24-0. NC1054.2 +096700 MOVE MOVE51 TO MOVE66. NC1054.2 +096800 MOVE-TEST-F1-24-1. NC1054.2 +096900 IF MOVE66 EQUAL TO "12345DB" NC1054.2 +097000 PERFORM PASS NC1054.2 +097100 ELSE NC1054.2 +097200 GO TO MOVE-FAIL-F1-24. NC1054.2 +097300* NOTE NI TO NE MOVE, REPORT SYMBOL DB. NC1054.2 +097400 GO TO MOVE-WRITE-F1-24. NC1054.2 +097500 MOVE-DELETE-F1-24. NC1054.2 +097600 PERFORM DE-LETE. NC1054.2 +097700 GO TO MOVE-WRITE-F1-24. NC1054.2 +097800 MOVE-FAIL-F1-24. NC1054.2 +097900 MOVE MOVE66 TO COMPUTED-A. NC1054.2 +098000 MOVE "12345DB" TO CORRECT-A. NC1054.2 +098100 PERFORM FAIL. NC1054.2 +098200 MOVE-WRITE-F1-24. NC1054.2 +098300 MOVE "MOVE-TEST-F1-24" TO PAR-NAME. NC1054.2 +098400 PERFORM PRINT-DETAIL. NC1054.2 +098500 MOVE-INIT-F1-25. NC1054.2 +098600 MOVE 12345 TO MOVE1. NC1054.2 +098700 MOVE-TEST-F1-25-0. NC1054.2 +098800 MOVE MOVE1 TO MOVE66. NC1054.2 +098900 MOVE-TEST-F1-25-1. NC1054.2 +099000 IF MOVE66 EQUAL TO "12345 " NC1054.2 +099100 PERFORM PASS NC1054.2 +099200 ELSE NC1054.2 +099300 GO TO MOVE-FAIL-F1-25. NC1054.2 +099400* NOTE NI TO NE MOVE, REPORT SYMBOL DB. NC1054.2 +099500 GO TO MOVE-WRITE-F1-25. NC1054.2 +099600 MOVE-DELETE-F1-25. NC1054.2 +099700 PERFORM DE-LETE. NC1054.2 +099800 GO TO MOVE-WRITE-F1-25. NC1054.2 +099900 MOVE-FAIL-F1-25. NC1054.2 +100000 MOVE MOVE66 TO COMPUTED-A. NC1054.2 +100100 MOVE "12345 " TO CORRECT-A. NC1054.2 +100200 PERFORM FAIL. NC1054.2 +100300 MOVE-WRITE-F1-25. NC1054.2 +100400 MOVE "MOVE-TEST-F1-25" TO PAR-NAME. NC1054.2 +100500 PERFORM PRINT-DETAIL. NC1054.2 +100600 MOVE-INIT-F1-26. NC1054.2 +100700 MOVE -12345 TO MOVE51. NC1054.2 +100800 MOVE-TEST-F1-26-0. NC1054.2 +100900 MOVE MOVE51 TO MOVE67. NC1054.2 +101000 MOVE-TEST-F1-26-1. NC1054.2 +101100 IF MOVE67 EQUAL TO "12345-" NC1054.2 +101200 PERFORM PASS NC1054.2 +101300 ELSE NC1054.2 +101400 GO TO MOVE-FAIL-F1-26. NC1054.2 +101500* NOTE NI TO NE MOVE, REPORT SIGN +. NC1054.2 +101600 GO TO MOVE-WRITE-F1-26. NC1054.2 +101700 MOVE-DELETE-F1-26. NC1054.2 +101800 PERFORM DE-LETE. NC1054.2 +101900 GO TO MOVE-WRITE-F1-26. NC1054.2 +102000 MOVE-FAIL-F1-26. NC1054.2 +102100 MOVE MOVE67 TO COMPUTED-A. NC1054.2 +102200 MOVE "12345-" TO CORRECT-A. NC1054.2 +102300 PERFORM FAIL. NC1054.2 +102400 MOVE-WRITE-F1-26. NC1054.2 +102500 MOVE "MOVE-TEST-F1-26" TO PAR-NAME. NC1054.2 +102600 PERFORM PRINT-DETAIL. NC1054.2 +102700 MOVE-INIT-F1-27. NC1054.2 +102800 MOVE 12345 TO MOVE1. NC1054.2 +102900 MOVE-TEST-F1-27-0. NC1054.2 +103000 MOVE MOVE1 TO MOVE67. NC1054.2 +103100 MOVE-TEST-F1-27-1. NC1054.2 +103200 IF MOVE67 EQUAL TO "12345+" NC1054.2 +103300 PERFORM PASS NC1054.2 +103400 ELSE NC1054.2 +103500 GO TO MOVE-FAIL-F1-27. NC1054.2 +103600* NOTE NI TO NE MOVE, REPORT SIGN +. NC1054.2 +103700 GO TO MOVE-WRITE-F1-27. NC1054.2 +103800 MOVE-DELETE-F1-27. NC1054.2 +103900 PERFORM DE-LETE. NC1054.2 +104000 GO TO MOVE-WRITE-F1-27. NC1054.2 +104100 MOVE-FAIL-F1-27. NC1054.2 +104200 MOVE MOVE67 TO COMPUTED-A. NC1054.2 +104300 MOVE "12345+" TO CORRECT-A. NC1054.2 +104400 PERFORM FAIL. NC1054.2 +104500 MOVE-WRITE-F1-27. NC1054.2 +104600 MOVE "MOVE-TEST-F1-27" TO PAR-NAME. NC1054.2 +104700 PERFORM PRINT-DETAIL. NC1054.2 +104800 MOVE-INIT-F1-28. NC1054.2 +104900 MOVE 45 TO MOVE49. NC1054.2 +105000 MOVE-TEST-F1-28-0. NC1054.2 +105100 MOVE MOVE49 TO MOVE68. NC1054.2 +105200 MOVE-TEST-F1-28-1. NC1054.2 +105300 IF MOVE68 EQUAL TO " +45" NC1054.2 +105400 PERFORM PASS NC1054.2 +105500 ELSE NC1054.2 +105600 GO TO MOVE-FAIL-F1-28. NC1054.2 +105700* NOTE NI TO NE MOVE, FLOATING REPORT SIGN. NC1054.2 +105800 GO TO MOVE-WRITE-F1-28. NC1054.2 +105900 MOVE-DELETE-F1-28. NC1054.2 +106000 PERFORM DE-LETE. NC1054.2 +106100 GO TO MOVE-WRITE-F1-28. NC1054.2 +106200 MOVE-FAIL-F1-28. NC1054.2 +106300 MOVE MOVE68 TO COMPUTED-A. NC1054.2 +106400 MOVE " +45" TO CORRECT-A. NC1054.2 +106500 PERFORM FAIL. NC1054.2 +106600 MOVE-WRITE-F1-28. NC1054.2 +106700 MOVE "MOVE-TEST-F1-28" TO PAR-NAME. NC1054.2 +106800 PERFORM PRINT-DETAIL. NC1054.2 +106900 MOVE-INIT-F1-29. NC1054.2 +107000 MOVE -45 TO MOVE51A. NC1054.2 +107100 MOVE-TEST-F1-29-0. NC1054.2 +107200 MOVE MOVE51A TO MOVE69. NC1054.2 +107300 MOVE-TEST-F1-29-1. NC1054.2 +107400 IF MOVE69 EQUAL TO " -45" NC1054.2 +107500 PERFORM PASS NC1054.2 +107600 ELSE NC1054.2 +107700 GO TO MOVE-FAIL-F1-29. NC1054.2 +107800* NOTE NI TO NE MOVE, FLOATING REPORT SIGN. NC1054.2 +107900 GO TO MOVE-WRITE-F1-29. NC1054.2 +108000 MOVE-DELETE-F1-29. NC1054.2 +108100 PERFORM DE-LETE. NC1054.2 +108200 GO TO MOVE-WRITE-F1-29. NC1054.2 +108300 MOVE-FAIL-F1-29. NC1054.2 +108400 MOVE MOVE69 TO COMPUTED-A. NC1054.2 +108500 MOVE " -45" TO CORRECT-A. NC1054.2 +108600 PERFORM FAIL. NC1054.2 +108700 MOVE-WRITE-F1-29. NC1054.2 +108800 MOVE "MOVE-TEST-F1-29" TO PAR-NAME. NC1054.2 +108900 PERFORM PRINT-DETAIL. NC1054.2 +109000 MOVE-INIT-F1-30. NC1054.2 +109100 MOVE 12345 TO MOVE1. NC1054.2 +109200 MOVE-TEST-F1-30-0. NC1054.2 +109300 MOVE MOVE1 TO MOVE70. NC1054.2 +109400 MOVE-TEST-F1-30-1. NC1054.2 +109500 IF MOVE70 EQUAL TO 12345 NC1054.2 +109600 PERFORM PASS NC1054.2 +109700 ELSE NC1054.2 +109800 GO TO MOVE-FAIL-F1-30. NC1054.2 +109900* NOTE, TO AUDIT SYNC OPTION. NC1054.2 +110000 GO TO MOVE-WRITE-F1-30. NC1054.2 +110100 MOVE-DELETE-F1-30. NC1054.2 +110200 PERFORM DE-LETE. NC1054.2 +110300 GO TO MOVE-WRITE-F1-30. NC1054.2 +110400 MOVE-FAIL-F1-30. NC1054.2 +110500 MOVE MOVE70 TO COMPUTED-N. NC1054.2 +110600 MOVE 12345 TO CORRECT-N. NC1054.2 +110700 PERFORM FAIL. NC1054.2 +110800 MOVE-WRITE-F1-30. NC1054.2 +110900 MOVE "MISC MOVE " TO FEATURE. NC1054.2 +111000 MOVE "MOVE-TEST-F1-30" TO PAR-NAME. NC1054.2 +111100 PERFORM PRINT-DETAIL. NC1054.2 +111200 MOVE-INIT-F1-31. NC1054.2 +111300 NC1054.2 +111400 MOVE-TEST-F1-31-0. NC1054.2 +111500 MOVE 1.11115111115111115 TO MOVE48. NC1054.2 +111600 MOVE-TEST-F1-31-1. NC1054.2 +111700 IF MOVE48 EQUAL TO 1.11115111115111115 NC1054.2 +111800 PERFORM PASS NC1054.2 +111900 ELSE NC1054.2 +112000 GO TO MOVE-FAIL-F1-31. NC1054.2 +112100* NOTE MAXIMUM LENGTH NUMERIC LITERAL. NC1054.2 +112200 GO TO MOVE-WRITE-F1-31. NC1054.2 +112300 MOVE-DELETE-F1-31. NC1054.2 +112400 PERFORM DE-LETE. NC1054.2 +112500 GO TO MOVE-WRITE-F1-31. NC1054.2 +112600 MOVE-FAIL-F1-31. NC1054.2 +112700 MOVE MOVE48 TO COMPUTED-N. NC1054.2 +112800 MOVE "1.11115111115111115" TO CORRECT-A. NC1054.2 +112900 PERFORM FAIL. NC1054.2 +113000 MOVE-WRITE-F1-31. NC1054.2 +113100 MOVE "MAXIMUM LENGTH MOVE " TO FEATURE. NC1054.2 +113200 MOVE "MOVE-TEST-F1-31" TO PAR-NAME. NC1054.2 +113300 PERFORM PRINT-DETAIL. NC1054.2 +113400 MOVE-INIT-F1-32. NC1054.2 +113500 MOVE 0 TO TA--X. NC1054.2 +113600 MOVE-TEST-F1-32-0. NC1054.2 +113700 MOVE MOVE23 TO MOVE5 MOVE6 MOVE7. NC1054.2 +113800 MOVE-TEST-F1-32-1. NC1054.2 +113900 IF MOVE5 NOT EQUAL TO 23.45 NC1054.2 +114000 MOVE MOVE5 TO COMPUTED-N NC1054.2 +114100 MOVE 23.45 TO CORRECT-N NC1054.2 +114200 PERFORM FAIL PERFORM MOVE-WRITE-F1-32 NC1054.2 +114300 MOVE 1 TO TA--X. NC1054.2 +114400 IF MOVE6 NOT EQUAL TO .45 NC1054.2 +114500 MOVE MOVE6 TO COMPUTED-N NC1054.2 +114600 MOVE .45 TO CORRECT-N NC1054.2 +114700 PERFORM FAIL PERFORM MOVE-WRITE-F1-32 NC1054.2 +114800 MOVE 1 TO TA--X. NC1054.2 +114900 IF MOVE7 NOT EQUAL TO 3.45 NC1054.2 +115000 MOVE MOVE7 TO COMPUTED-N NC1054.2 +115100 MOVE 3.45 TO CORRECT-N NC1054.2 +115200 GO TO MOVE-FAIL-F1-32. NC1054.2 +115300 IF TA--X IS NOT EQUAL TO 0 GO TO MOVE-INIT-F1-33. NC1054.2 +115400 PERFORM PASS. NC1054.2 +115500 GO TO MOVE-WRITE-F1-32. NC1054.2 +115600 MOVE-DELETE-F1-32. NC1054.2 +115700 PERFORM DE-LETE. NC1054.2 +115800 GO TO MOVE-WRITE-F1-32. NC1054.2 +115900 MOVE-FAIL-F1-32. NC1054.2 +116000 PERFORM FAIL. NC1054.2 +116100 MOVE-WRITE-F1-32. NC1054.2 +116200 MOVE "MOVE-TEST-F1-32" TO PAR-NAME. NC1054.2 +116300 PERFORM PRINT-DETAIL. NC1054.2 +116400 MOVE-INIT-F1-33. NC1054.2 +116500 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO GRP-ALPHABETIC. NC1054.2 +116600 MOVE-TEST-F1-33-0. NC1054.2 +116700 MOVE GRP-GROUP-MOVE-FROM TO GRP-GROUP-MOVE-TO. NC1054.2 +116800 MOVE-TEST-F1-33-1. NC1054.2 +116900 IF ALPHABET-AN-00026 NOT EQUAL TO WRK-AN-00026 NC1054.2 +117000 GO TO MOVE-FAIL-F1-33. NC1054.2 +117100 IF DIGITS-DU-10V00 NOT EQUAL TO WRK-DU-10V00 NC1054.2 +117200 GO TO MOVE-FAIL-F1-33. NC1054.2 +117300 IF ALPHANUMERIC-XN-00049 NOT EQUAL TO WRK-XN-00049 NC1054.2 +117400 GO TO MOVE-FAIL-F1-33. NC1054.2 +117500 IF NE-0001 NOT EQUAL TO SPACE GO TO MOVE-FAIL-F1-33. NC1054.2 +117600 IF NE-0002 NOT EQUAL TO SPACE GO TO MOVE-FAIL-F1-33. NC1054.2 +117700 IF AE-0001 NOT EQUAL TO SPACE GO TO MOVE-FAIL-F1-33. NC1054.2 +117800 IF AE-0002 EQUAL TO SPACE NC1054.2 +117900 PERFORM PASS NC1054.2 +118000 GO TO MOVE-WRITE-F1-33. NC1054.2 +118100 GO TO MOVE-FAIL-F1-33. NC1054.2 +118200 MOVE-DELETE-F1-33. NC1054.2 +118300 PERFORM DE-LETE. NC1054.2 +118400 GO TO MOVE-WRITE-F1-33. NC1054.2 +118500 MOVE-FAIL-F1-33. NC1054.2 +118600 MOVE GRP-MOVE-CONSTANTS TO SEND-BREAKDOWN. NC1054.2 +118700 MOVE GRP-MOVE-RECEIVING-FIELDS TO RECEIVE-BREAKDOWN. NC1054.2 +118800 MOVE 119 TO LENGTH-COUNTER. NC1054.2 +118900 PERFORM FAIL. NC1054.2 +119000 PERFORM A20 THRU A120. NC1054.2 +119100 MOVE-WRITE-F1-33. NC1054.2 +119200 MOVE "MOVE ALPHA GROUP " TO FEATURE. NC1054.2 +119300 MOVE "MOVE-TEST-F1-33 " TO PAR-NAME. NC1054.2 +119400 PERFORM PRINT-DETAIL. NC1054.2 +119500 MOVE-INIT-F1-34. NC1054.2 +119600 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO GRP-ALPHABETIC. NC1054.2 +119700 MOVE-TEST-F1-34-0. NC1054.2 +119800 MOVE GRP-ALPHABETIC TO WRK-AN-00026. NC1054.2 +119900 MOVE-TEST-F1-34-1. NC1054.2 +120000 IF GRP-ALPHABETIC EQUAL TO GRP-WRK-AN-00026 NC1054.2 +120100 PERFORM PASS NC1054.2 +120200 GO TO MOVE-WRITE-F1-34. NC1054.2 +120300 GO TO MOVE-FAIL-F1-34. NC1054.2 +120400 MOVE-DELETE-F1-34. NC1054.2 +120500 PERFORM DE-LETE. NC1054.2 +120600 GO TO MOVE-WRITE-F1-34. NC1054.2 +120700 MOVE-FAIL-F1-34. NC1054.2 +120800 MOVE GRP-ALPHABETIC TO SEND-BREAKDOWN. NC1054.2 +120900 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +121000 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +121100 PERFORM FAIL. NC1054.2 +121200 PERFORM A20 THRU A40. NC1054.2 +121300 MOVE-WRITE-F1-34. NC1054.2 +121400 MOVE "MOVE-TEST-F1-34 " TO PAR-NAME. NC1054.2 +121500 PERFORM PRINT-DETAIL. NC1054.2 +121600 MOVE-INIT-F1-35. NC1054.2 +121700 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +121800 TO GRP-ALPHANUMERIC. NC1054.2 +121900 MOVE "MOVE ALPHA-NUM GROUP" TO FEATURE. NC1054.2 +122000 MOVE-TEST-F1-35-0. NC1054.2 +122100 MOVE GRP-ALPHANUMERIC TO WRK-XN-00049. NC1054.2 +122200 MOVE-TEST-F1-35-1. NC1054.2 +122300 IF GRP-ALPHANUMERIC EQUAL TO GRP-WRK-XN-00049 NC1054.2 +122400 PERFORM PASS NC1054.2 +122500 GO TO MOVE-WRITE-F1-35. NC1054.2 +122600 GO TO MOVE-FAIL-F1-35. NC1054.2 +122700 MOVE-DELETE-F1-35. NC1054.2 +122800 PERFORM DE-LETE. NC1054.2 +122900 GO TO MOVE-WRITE-F1-35. NC1054.2 +123000 MOVE-FAIL-F1-35. NC1054.2 +123100 MOVE GRP-ALPHANUMERIC TO SEND-BREAKDOWN. NC1054.2 +123200 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +123300 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +123400 PERFORM FAIL. NC1054.2 +123500 PERFORM A20 THRU A60. NC1054.2 +123600 MOVE-WRITE-F1-35. NC1054.2 +123700 MOVE "MOVE-TEST-F1-35 " TO PAR-NAME. NC1054.2 +123800 PERFORM PRINT-DETAIL. NC1054.2 +123900 MOVE-INIT-F1-36. NC1054.2 +124000 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +124100 TO GRP-ALPHANUMERIC. NC1054.2 +124200 MOVE "MOVE ALPHA-NUM GROUP" TO FEATURE. NC1054.2 +124300 MOVE-TEST-F1-36-0. NC1054.2 +124400 MOVE GRP-ALPHANUMERIC TO AE-0001. NC1054.2 +124500 MOVE-TEST-F1-36-1. NC1054.2 +124600 IF GRP-ALPHANUMERIC-1002 EQUAL TO GRP-AE-0001 NC1054.2 +124700 PERFORM PASS NC1054.2 +124800 GO TO MOVE-WRITE-F1-36. NC1054.2 +124900 GO TO MOVE-FAIL-F1-36. NC1054.2 +125000 MOVE-DELETE-F1-36. NC1054.2 +125100 PERFORM DE-LETE. NC1054.2 +125200 GO TO MOVE-WRITE-F1-36. NC1054.2 +125300 MOVE-FAIL-F1-36. NC1054.2 +125400 MOVE GRP-ALPHANUMERIC-1002 TO SEND-BREAKDOWN. NC1054.2 +125500 MOVE GRP-AE-0001 TO RECEIVE-BREAKDOWN. NC1054.2 +125600 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +125700 PERFORM FAIL. NC1054.2 +125800 PERFORM A20 THRU A60. NC1054.2 +125900 MOVE-WRITE-F1-36. NC1054.2 +126000 MOVE "MOVE-TEST-F1-36 " TO PAR-NAME. NC1054.2 +126100 PERFORM PRINT-DETAIL. NC1054.2 +126200 MOVE-INIT-F1-37. NC1054.2 +126300 MOVE "MOVE NUMERIC GROUP " TO FEATURE. NC1054.2 +126400 MOVE 0123456789 TO GRP-NUMERIC. NC1054.2 +126500 MOVE-TEST-F1-37-0. NC1054.2 +126600 MOVE GRP-NUMERIC TO WRK-DU-10V00. NC1054.2 +126700 MOVE-TEST-F1-37-1. NC1054.2 +126800 IF GRP-NUMERIC EQUAL TO GRP-WRK-DU-10V00 NC1054.2 +126900 PERFORM PASS NC1054.2 +127000 GO TO MOVE-WRITE-F1-37. NC1054.2 +127100 GO TO MOVE-FAIL-F1-37. NC1054.2 +127200 MOVE-DELETE-F1-37. NC1054.2 +127300 PERFORM DE-LETE. NC1054.2 +127400 GO TO MOVE-WRITE-F1-37. NC1054.2 +127500 MOVE-FAIL-F1-37. NC1054.2 +127600 MOVE GRP-NUMERIC TO CORRECT-A. NC1054.2 +127700 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +127800 PERFORM FAIL. NC1054.2 +127900 MOVE-WRITE-F1-37. NC1054.2 +128000 MOVE "MOVE-TEST-F1-37 " TO PAR-NAME. NC1054.2 +128100 PERFORM PRINT-DETAIL. NC1054.2 +128200 MOVE-INIT-F1-38. NC1054.2 +128300 MOVE 0123456789 TO GRP-NUMERIC. NC1054.2 +128400 MOVE-TEST-F1-38-0. NC1054.2 +128500 MOVE GRP-NUMERIC TO NE-0001. NC1054.2 +128600 MOVE-TEST-F1-38-1. NC1054.2 +128700 IF "0123456789 " EQUAL TO GRP-NE-0001 NC1054.2 +128800 PERFORM PASS NC1054.2 +128900 GO TO MOVE-WRITE-F1-38. NC1054.2 +129000 GO TO MOVE-FAIL-F1-38. NC1054.2 +129100 MOVE-DELETE-F1-38. NC1054.2 +129200 PERFORM DE-LETE. NC1054.2 +129300 GO TO MOVE-WRITE-F1-38. NC1054.2 +129400 MOVE-FAIL-F1-38. NC1054.2 +129500 MOVE GRP-NUMERIC TO CORRECT-A. NC1054.2 +129600 MOVE GRP-NE-0001 TO COMPUTED-A. NC1054.2 +129700 PERFORM FAIL. NC1054.2 +129800 MOVE-WRITE-F1-38. NC1054.2 +129900 MOVE "MOVE-TEST-F1-38 " TO PAR-NAME. NC1054.2 +130000 PERFORM PRINT-DETAIL. NC1054.2 +130100 MOVE-INIT-F1-39. NC1054.2 +130200 MOVE "MOVE ALPHA ITEM " TO FEATURE. NC1054.2 +130300 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO ALPHABET-AN-00026. NC1054.2 +130400 MOVE-TEST-F1-39-0. NC1054.2 +130500 MOVE ALPHABET-AN-00026 TO GRP-WRK-AN-00026. NC1054.2 +130600 MOVE-TEST-F1-39-1. NC1054.2 +130700 IF ALPHABET-AN-00026 EQUAL TO WRK-AN-00026 NC1054.2 +130800 PERFORM PASS NC1054.2 +130900 GO TO MOVE-WRITE-F1-39. NC1054.2 +131000 GO TO MOVE-FAIL-F1-39. NC1054.2 +131100 MOVE-DELETE-F1-39. NC1054.2 +131200 PERFORM DE-LETE. NC1054.2 +131300 GO TO MOVE-WRITE-F1-39. NC1054.2 +131400 MOVE-FAIL-F1-39. NC1054.2 +131500 MOVE ALPHABET-AN-00026 TO SEND-BREAKDOWN. NC1054.2 +131600 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +131700 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +131800 PERFORM FAIL. NC1054.2 +131900 PERFORM A20 THRU A40. NC1054.2 +132000 MOVE-WRITE-F1-39. NC1054.2 +132100 MOVE "MOVE-TEST-F1-39 " TO PAR-NAME. NC1054.2 +132200 PERFORM PRINT-DETAIL. NC1054.2 +132300 MOVE-INIT-F1-40. NC1054.2 +132400 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO ALPHABET-AN-00026. NC1054.2 +132500 MOVE-TEST-F1-40-0. NC1054.2 +132600 MOVE ALPHABET-AN-00026 TO WRK-AN-00026. NC1054.2 +132700 MOVE-TEST-F1-40-1. NC1054.2 +132800 IF ALPHABET-AN-00026 EQUAL TO GRP-WRK-AN-00026 NC1054.2 +132900 PERFORM PASS NC1054.2 +133000 GO TO MOVE-WRITE-F1-40. NC1054.2 +133100 GO TO MOVE-FAIL-F1-40. NC1054.2 +133200 MOVE-DELETE-F1-40. NC1054.2 +133300 PERFORM DE-LETE. NC1054.2 +133400 GO TO MOVE-WRITE-F1-40. NC1054.2 +133500 MOVE-FAIL-F1-40. NC1054.2 +133600 MOVE ALPHABET-AN-00026 TO SEND-BREAKDOWN. NC1054.2 +133700 MOVE WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +133800 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +133900 PERFORM FAIL. NC1054.2 +134000 PERFORM A20 THRU A40. NC1054.2 +134100 MOVE-WRITE-F1-40. NC1054.2 +134200 MOVE "MOVE-TEST-F1-40 " TO PAR-NAME. NC1054.2 +134300 PERFORM PRINT-DETAIL. NC1054.2 +134400 MOVE-INIT-F1-41. NC1054.2 +134500 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO ALPHABET-AN-00026. NC1054.2 +134600 MOVE-TEST-F1-41-0. NC1054.2 +134700 MOVE ALPHABET-AN-00026 TO WRK-XN-00049 FIRST-26. NC1054.2 +134800 MOVE-TEST-F1-41-1. NC1054.2 +134900 MOVE SPACE TO PADD-REST. NC1054.2 +135000 IF FORTY-NINE-COMPARE EQUAL TO GRP-WRK-XN-00049 NC1054.2 +135100 PERFORM PASS NC1054.2 +135200 GO TO MOVE-WRITE-F1-41. NC1054.2 +135300 GO TO MOVE-FAIL-F1-41. NC1054.2 +135400 MOVE-DELETE-F1-41. NC1054.2 +135500 PERFORM DE-LETE. NC1054.2 +135600 GO TO MOVE-WRITE-F1-41. NC1054.2 +135700 MOVE-FAIL-F1-41. NC1054.2 +135800 MOVE FORTY-NINE-COMPARE TO SEND-BREAKDOWN. NC1054.2 +135900 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +136000 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +136100 PERFORM FAIL. NC1054.2 +136200 PERFORM A20 THRU A60. NC1054.2 +136300 MOVE-WRITE-F1-41. NC1054.2 +136400 MOVE "MOVE-TEST-F1-41 " TO PAR-NAME. NC1054.2 +136500 PERFORM PRINT-DETAIL. NC1054.2 +136600 MOVE-INIT-F1-42. NC1054.2 +136700 MOVE "MOVE ALPHA-NUM ITEM " TO FEATURE. NC1054.2 +136800 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +136900 TO ALPHANUMERIC-XN-00049. NC1054.2 +137000 MOVE-TEST-F1-42-0. NC1054.2 +137100 MOVE ALPHANUMERIC-XN-00049 TO GRP-WRK-XN-00049. NC1054.2 +137200 MOVE-TEST-F1-42-1. NC1054.2 +137300 IF ALPHANUMERIC-XN-00049 EQUAL TO WRK-XN-00049 NC1054.2 +137400 PERFORM PASS NC1054.2 +137500 GO TO MOVE-WRITE-F1-42. NC1054.2 +137600 GO TO MOVE-FAIL-F1-42. NC1054.2 +137700 MOVE-DELETE-F1-42. NC1054.2 +137800 PERFORM DE-LETE. NC1054.2 +137900 GO TO MOVE-WRITE-F1-42. NC1054.2 +138000 MOVE-FAIL-F1-42. NC1054.2 +138100 MOVE ALPHANUMERIC-XN-00049 TO SEND-BREAKDOWN. NC1054.2 +138200 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +138300 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +138400 PERFORM FAIL. NC1054.2 +138500 PERFORM A20 THRU A60. NC1054.2 +138600 MOVE-WRITE-F1-42. NC1054.2 +138700 MOVE "MOVE-TEST-F1-42 " TO PAR-NAME. NC1054.2 +138800 PERFORM PRINT-DETAIL. NC1054.2 +138900 MOVE-INIT-F1-43. NC1054.2 +139000 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +139100 TO ALPHANUMERIC-XN-00049. NC1054.2 +139200 MOVE-TEST-F1-43-0. NC1054.2 +139300 MOVE ALPHANUMERIC-XN-00049 TO WRK-AN-00026 NC1054.2 +139400 FORTY-NINE-COMPARE. NC1054.2 +139500 MOVE SPACE TO PADD-REST. NC1054.2 +139600 MOVE-TEST-F1-43-1. NC1054.2 +139700 IF FIRST-26 EQUAL TO GRP-WRK-AN-00026 NC1054.2 +139800 PERFORM PASS NC1054.2 +139900 GO TO MOVE-WRITE-F1-43. NC1054.2 +140000 GO TO MOVE-FAIL-F1-43. NC1054.2 +140100 MOVE-DELETE-F1-43. NC1054.2 +140200 PERFORM DE-LETE. NC1054.2 +140300 GO TO MOVE-WRITE-F1-43. NC1054.2 +140400 MOVE-FAIL-F1-43. NC1054.2 +140500 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +140600 MOVE FIRST-26 TO SEND-BREAKDOWN. NC1054.2 +140700 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +140800 PERFORM FAIL. NC1054.2 +140900 PERFORM A20 THRU A40. NC1054.2 +141000 MOVE-WRITE-F1-43. NC1054.2 +141100 MOVE "MOVE-TEST-F1-43 " TO PAR-NAME. NC1054.2 +141200 PERFORM PRINT-DETAIL. NC1054.2 +141300 MOVE-INIT-F1-44. NC1054.2 +141400 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +141500 TO ALPHANUMERIC-XN-00049. NC1054.2 +141600 MOVE-TEST-F1-44-0. NC1054.2 +141700 MOVE ALPHANUMERIC-XN-00049 TO WRK-XN-00049. NC1054.2 +141800 MOVE-TEST-F1-44-1. NC1054.2 +141900 IF ALPHANUMERIC-XN-00049 EQUAL TO GRP-WRK-XN-00049 NC1054.2 +142000 PERFORM PASS NC1054.2 +142100 GO TO MOVE-WRITE-F1-44. NC1054.2 +142200 GO TO MOVE-FAIL-F1-44. NC1054.2 +142300 MOVE-DELETE-F1-44. NC1054.2 +142400 PERFORM DE-LETE. NC1054.2 +142500 GO TO MOVE-WRITE-F1-44. NC1054.2 +142600 MOVE-FAIL-F1-44. NC1054.2 +142700 MOVE ALPHANUMERIC-XN-00049 TO SEND-BREAKDOWN. NC1054.2 +142800 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +142900 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +143000 PERFORM FAIL. NC1054.2 +143100 PERFORM A20 THRU A60. NC1054.2 +143200 MOVE-WRITE-F1-44. NC1054.2 +143300 MOVE "MOVE-TEST-F1-44" TO PAR-NAME. NC1054.2 +143400 PERFORM PRINT-DETAIL. NC1054.2 +143500 MOVE-INIT-F1-45. NC1054.2 +143600 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +143700 TO ALPHANUMERIC-XN-00049. NC1054.2 +143800 MOVE-TEST-F1-45-0. NC1054.2 +143900 MOVE ALPHANUMERIC-XN-00049 TO AE-0001. NC1054.2 +144000 MOVE-TEST-F1-45-1. NC1054.2 +144100 IF GRP-AE-0001 EQUAL TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ +- =$, .NC1054.2 +144200- "()/0 012345678" NC1054.2 +144300 PERFORM PASS NC1054.2 +144400 GO TO MOVE-WRITE-F1-45. NC1054.2 +144500 GO TO MOVE-FAIL-F1-45. NC1054.2 +144600 MOVE-DELETE-F1-45. NC1054.2 +144700 PERFORM DE-LETE. NC1054.2 +144800 GO TO MOVE-WRITE-F1-45. NC1054.2 +144900 MOVE-FAIL-F1-45. NC1054.2 +145000 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ +- =$, .()/0 012345678" NC1054.2 +145100 TO SEND-BREAKDOWN. NC1054.2 +145200 MOVE AE-0001 TO RECEIVE-BREAKDOWN. NC1054.2 +145300 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +145400 PERFORM FAIL. NC1054.2 +145500 PERFORM A20 THRU A60. NC1054.2 +145600 MOVE-WRITE-F1-45. NC1054.2 +145700 MOVE "MOVE-TEST-F1-45" TO PAR-NAME. NC1054.2 +145800 PERFORM PRINT-DETAIL. NC1054.2 +145900 MOVE-INIT-F1-46. NC1054.2 +146000 NC1054.2 +146100 MOVE-TEST-F1-46-0. NC1054.2 +146200 MOVE "4444444444444444440123456789" TO WRK-DU-10V00. NC1054.2 +146300 MOVE-TEST-F1-46-1. NC1054.2 +146400 IF GRP-WRK-DU-10V00 EQUAL TO "0123456789" NC1054.2 +146500 PERFORM PASS NC1054.2 +146600 GO TO MOVE-WRITE-F1-46. NC1054.2 +146700 GO TO MOVE-FAIL-F1-46. NC1054.2 +146800 MOVE-DELETE-F1-46. NC1054.2 +146900 PERFORM DE-LETE. NC1054.2 +147000 GO TO MOVE-WRITE-F1-46. NC1054.2 +147100 MOVE-FAIL-F1-46. NC1054.2 +147200 MOVE "0123456789" TO CORRECT-A. NC1054.2 +147300 MOVE WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +147400 PERFORM FAIL. NC1054.2 +147500 MOVE-WRITE-F1-46. NC1054.2 +147600 MOVE "MOVE-TEST-F1-46" TO PAR-NAME. NC1054.2 +147700 PERFORM PRINT-DETAIL. NC1054.2 +147800 MOVE-INIT-F1-47. NC1054.2 +147900 MOVE 3344556677 TO MOVE72. NC1054.2 +148000 MOVE-TEST-F1-47-0. NC1054.2 +148100 MOVE MOVE72 TO MOVE73. NC1054.2 +148200 MOVE-TEST-F1-47-1. NC1054.2 +148300 IF MOVE73 EQUAL TO "33445 56677 0 " NC1054.2 +148400 PERFORM PASS NC1054.2 +148500 GO TO MOVE-WRITE-F1-47. NC1054.2 +148600 GO TO MOVE-FAIL-F1-47. NC1054.2 +148700 MOVE-DELETE-F1-47. NC1054.2 +148800 PERFORM DE-LETE. NC1054.2 +148900 GO TO MOVE-WRITE-F1-47. NC1054.2 +149000 MOVE-FAIL-F1-47. NC1054.2 +149100 MOVE MOVE73 TO COMPUTED-A. NC1054.2 +149200 MOVE "33445 56677 0 " TO CORRECT-A. NC1054.2 +149300 PERFORM FAIL. NC1054.2 +149400 MOVE-WRITE-F1-47. NC1054.2 +149500 MOVE "MOVE-TEST-F1-47" TO PAR-NAME. NC1054.2 +149600 PERFORM PRINT-DETAIL. NC1054.2 +149700 MOVE-INIT-F1-48. NC1054.2 +149800 NC1054.2 +149900 MOVE-TEST-F1-48-0. NC1054.2 +150000 MOVE "*" TO AE-0002. NC1054.2 +150100 MOVE-TEST-F1-48-1. NC1054.2 +150200 IF GRP-AE-0002 EQUAL TO "* 0 " NC1054.2 +150300 PERFORM PASS NC1054.2 +150400 GO TO MOVE-WRITE-F1-48. NC1054.2 +150500 GO TO MOVE-FAIL-F1-48. NC1054.2 +150600 MOVE-DELETE-F1-48. NC1054.2 +150700 PERFORM DE-LETE. NC1054.2 +150800 GO TO MOVE-WRITE-F1-48. NC1054.2 +150900 MOVE-FAIL-F1-48. NC1054.2 +151000 MOVE AE-0002 TO COMPUTED-A. NC1054.2 +151100 MOVE "* 0 " TO CORRECT-A. NC1054.2 +151200 PERFORM FAIL. NC1054.2 +151300 PERFORM A20 THRU A60. NC1054.2 +151400 MOVE-WRITE-F1-48. NC1054.2 +151500 MOVE "MOVE-TEST-F1-48" TO PAR-NAME. NC1054.2 +151600 PERFORM PRINT-DETAIL. NC1054.2 +151700 MOVE-INIT-F1-49. NC1054.2 +151800 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- =$, .()/ 0123456789" NC1054.2 +151900 TO ALPHANUMERIC-XN-00049. NC1054.2 +152000 MOVE-TEST-F1-49-0. NC1054.2 +152100 MOVE ALPHANUMERIC-XN-00049 TO AE-0001. NC1054.2 +152200 MOVE-TEST-F1-49-1. NC1054.2 +152300 MOVE AE-0001 TO AE-0002. NC1054.2 +152400 IF AE-0002 EQUAL TO "AB0CD EFG" NC1054.2 +152500 PERFORM PASS NC1054.2 +152600 GO TO MOVE-WRITE-F1-49. NC1054.2 +152700 GO TO MOVE-FAIL-F1-49. NC1054.2 +152800 MOVE-DELETE-F1-49. NC1054.2 +152900 PERFORM DE-LETE. NC1054.2 +153000 GO TO MOVE-WRITE-F1-49. NC1054.2 +153100 MOVE-FAIL-F1-49. NC1054.2 +153200 MOVE AE-0002 TO COMPUTED-A. NC1054.2 +153300 MOVE "AB0CD EFG" TO CORRECT-A. NC1054.2 +153400 PERFORM FAIL. NC1054.2 +153500 MOVE-WRITE-F1-49. NC1054.2 +153600 MOVE "MOVE-TEST-F1-49" TO PAR-NAME. NC1054.2 +153700 PERFORM PRINT-DETAIL. NC1054.2 +153800 MOVE-INIT-F1-50. NC1054.2 +153900 MOVE "MOVE NUMERIC ITEM " TO FEATURE. NC1054.2 +154000 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +154100 MOVE-TEST-F1-50-0. NC1054.2 +154200 MOVE DIGITS-DU-10V00 TO GRP-WRK-DU-10V00. NC1054.2 +154300 MOVE-TEST-F1-50-1. NC1054.2 +154400 IF WRK-DU-10V00 EQUAL TO DIGITS-DU-10V00 NC1054.2 +154500 PERFORM PASS NC1054.2 +154600 GO TO MOVE-WRITE-F1-50. NC1054.2 +154700 GO TO MOVE-FAIL-F1-50. NC1054.2 +154800 MOVE-DELETE-F1-50. NC1054.2 +154900 PERFORM DE-LETE. NC1054.2 +155000 GO TO MOVE-WRITE-F1-50. NC1054.2 +155100 MOVE-FAIL-F1-50. NC1054.2 +155200 MOVE DIGITS-DU-10V00 TO CORRECT-A. NC1054.2 +155300 MOVE WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +155400 PERFORM FAIL. NC1054.2 +155500 MOVE-WRITE-F1-50. NC1054.2 +155600 MOVE "MOVE-TEST-F1-50" TO PAR-NAME. NC1054.2 +155700 PERFORM PRINT-DETAIL. NC1054.2 +155800 MOVE-INIT-F1-51. NC1054.2 +155900 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +156000 MOVE-TEST-F1-51-0. NC1054.2 +156100 MOVE DIGITS-DU-10V00 TO WRK-XN-00049. NC1054.2 +156200 MOVE-TEST-F1-51-1. NC1054.2 +156300 IF GRP-WRK-XN-00049 EQUAL TO "0123456789 NC1054.2 +156400- " " NC1054.2 +156500 PERFORM PASS NC1054.2 +156600 GO TO MOVE-WRITE-F1-51. NC1054.2 +156700 GO TO MOVE-FAIL-F1-51. NC1054.2 +156800 MOVE-DELETE-F1-51. NC1054.2 +156900 PERFORM DE-LETE. NC1054.2 +157000 GO TO MOVE-WRITE-F1-51. NC1054.2 +157100 MOVE-FAIL-F1-51. NC1054.2 +157200 MOVE "0123456789 " NC1054.2 +157300 TO SEND-BREAKDOWN NC1054.2 +157400 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +157500 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +157600 PERFORM FAIL. NC1054.2 +157700 PERFORM A20 THRU A60. NC1054.2 +157800 MOVE-WRITE-F1-51. NC1054.2 +157900 MOVE "MOVE-TEST-F1-51" TO PAR-NAME. NC1054.2 +158000 PERFORM PRINT-DETAIL. NC1054.2 +158100 MOVE-INIT-F1-52. NC1054.2 +158200 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +158300 MOVE-TEST-F1-52-0. NC1054.2 +158400 MOVE DIGITS-DU-10V00 TO AE-0002. NC1054.2 +158500 MOVE-TEST-F1-52-1. NC1054.2 +158600 IF GRP-AE-0002 EQUAL TO "01023 456" NC1054.2 +158700 PERFORM PASS NC1054.2 +158800 GO TO MOVE-WRITE-F1-52. NC1054.2 +158900 GO TO MOVE-FAIL-F1-52. NC1054.2 +159000 MOVE-DELETE-F1-52. NC1054.2 +159100 PERFORM DE-LETE. NC1054.2 +159200 GO TO MOVE-WRITE-F1-52. NC1054.2 +159300 MOVE-FAIL-F1-52. NC1054.2 +159400 MOVE "01023 456" TO CORRECT-A. NC1054.2 +159500 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +159600 PERFORM FAIL. NC1054.2 +159700 MOVE-WRITE-F1-52. NC1054.2 +159800 MOVE "MOVE-TEST-F1-52" TO PAR-NAME. NC1054.2 +159900 PERFORM PRINT-DETAIL. NC1054.2 +160000 MOVE-INIT-F1-53. NC1054.2 +160100 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +160200 MOVE-TEST-F1-53-0. NC1054.2 +160300 MOVE DIGITS-DU-10V00 TO WRK-DU-10V00. NC1054.2 +160400 MOVE-TEST-F1-53-1. NC1054.2 +160500 IF GRP-WRK-DU-10V00 EQUAL TO DIGITS-DU-10V00 NC1054.2 +160600 PERFORM PASS NC1054.2 +160700 GO TO MOVE-WRITE-F1-53. NC1054.2 +160800 GO TO MOVE-FAIL-F1-53. NC1054.2 +160900 MOVE-DELETE-F1-53. NC1054.2 +161000 PERFORM DE-LETE. NC1054.2 +161100 GO TO MOVE-WRITE-F1-53. NC1054.2 +161200 MOVE-FAIL-F1-53. NC1054.2 +161300 MOVE DIGITS-DU-10V00 TO CORRECT-A. NC1054.2 +161400 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +161500 PERFORM FAIL. NC1054.2 +161600 MOVE-WRITE-F1-53. NC1054.2 +161700 MOVE "MOVE-TEST-F1-53" TO PAR-NAME. NC1054.2 +161800 PERFORM PRINT-DETAIL. NC1054.2 +161900 MOVE-INIT-F1-54. NC1054.2 +162000 MOVE 0123456789 TO DIGITS-DU-10V00. NC1054.2 +162100 MOVE-TEST-F1-54-0. NC1054.2 +162200 MOVE DIGITS-DU-06V04-S TO NE-0001. NC1054.2 +162300 MOVE-TEST-F1-54-1. NC1054.2 +162400 IF GRP-NE-0001 EQUAL TO " 12,345.678,9" NC1054.2 +162500 PERFORM PASS NC1054.2 +162600 GO TO MOVE-WRITE-F1-54. NC1054.2 +162700 GO TO MOVE-FAIL-F1-54. NC1054.2 +162800 MOVE-DELETE-F1-54. NC1054.2 +162900 PERFORM DE-LETE. NC1054.2 +163000 GO TO MOVE-WRITE-F1-54. NC1054.2 +163100 MOVE-FAIL-F1-54. NC1054.2 +163200 MOVE " 12,345.678,9" TO CORRECT-A. NC1054.2 +163300 MOVE GRP-NE-0001 TO COMPUTED-A. NC1054.2 +163400 PERFORM FAIL. NC1054.2 +163500 MOVE-WRITE-F1-54. NC1054.2 +163600 MOVE "MOVE-TEST-F1-54" TO PAR-NAME. NC1054.2 +163700 PERFORM PRINT-DETAIL. NC1054.2 +163800 MOVE-INIT-F1-55. NC1054.2 +163900 MOVE "MOVE NUMERIC EDITED" TO FEATURE. NC1054.2 +164000 MOVE-TEST-F1-55-0. NC1054.2 +164100 MOVE " 12,345.678,9" TO GRP-NE-0001. NC1054.2 +164200 MOVE NE-0001 TO GRP-WRK-XN-00049. NC1054.2 +164300 MOVE-TEST-F1-55-1. NC1054.2 +164400 IF GRP-WRK-XN-00049 EQUAL TO NC1054.2 +164500 " 12,345.678,9 " NC1054.2 +164600 PERFORM PASS NC1054.2 +164700 GO TO MOVE-WRITE-F1-55. NC1054.2 +164800 GO TO MOVE-FAIL-F1-55. NC1054.2 +164900 MOVE-DELETE-F1-55. NC1054.2 +165000 PERFORM DE-LETE. NC1054.2 +165100 GO TO MOVE-WRITE-F1-55. NC1054.2 +165200 MOVE-FAIL-F1-55. NC1054.2 +165300 MOVE " 12,345.678,9 " NC1054.2 +165400 TO SEND-BREAKDOWN. NC1054.2 +165500 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +165600 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +165700 PERFORM FAIL. NC1054.2 +165800 PERFORM A20 THRU A60. NC1054.2 +165900 MOVE-WRITE-F1-55. NC1054.2 +166000 MOVE "MOVE-TEST-F1-55" TO PAR-NAME. NC1054.2 +166100 PERFORM PRINT-DETAIL. NC1054.2 +166200 MOVE-INIT-F1-56. NC1054.2 +166300 NC1054.2 +166400 MOVE-TEST-F1-56-0. NC1054.2 +166500 MOVE " 12,345.678,9" TO GRP-NE-0001. NC1054.2 +166600 MOVE NE-0001 TO WRK-XN-00049. NC1054.2 +166700 MOVE-TEST-F1-56-1. NC1054.2 +166800 IF GRP-WRK-XN-00049 EQUAL TO NC1054.2 +166900 " 12,345.678,9 " NC1054.2 +167000 PERFORM PASS NC1054.2 +167100 GO TO MOVE-WRITE-F1-56. NC1054.2 +167200 GO TO MOVE-FAIL-F1-56. NC1054.2 +167300 MOVE-DELETE-F1-56. NC1054.2 +167400 PERFORM DE-LETE. NC1054.2 +167500 GO TO MOVE-WRITE-F1-56. NC1054.2 +167600 MOVE-FAIL-F1-56. NC1054.2 +167700 MOVE " 12,345.678,9 " NC1054.2 +167800 TO SEND-BREAKDOWN. NC1054.2 +167900 MOVE WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +168000 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +168100 PERFORM FAIL. NC1054.2 +168200 PERFORM A20 THRU A60. NC1054.2 +168300 MOVE-WRITE-F1-56. NC1054.2 +168400 MOVE "MOVE-TEST-F1-56" TO PAR-NAME. NC1054.2 +168500 PERFORM PRINT-DETAIL. NC1054.2 +168600 MOVE-INIT-F1-57. NC1054.2 +168700 NC1054.2 +168800 MOVE-TEST-F1-57-0. NC1054.2 +168900 MOVE " 12,345.678,9" TO GRP-NE-0001. NC1054.2 +169000 MOVE NE-0001 TO AE-0002. NC1054.2 +169100 MOVE-TEST-F1-57-1. NC1054.2 +169200 IF GRP-AE-0002 EQUAL TO " 102, 345" NC1054.2 +169300 PERFORM PASS NC1054.2 +169400 GO TO MOVE-WRITE-F1-57. NC1054.2 +169500 GO TO MOVE-FAIL-F1-57. NC1054.2 +169600 MOVE-DELETE-F1-57. NC1054.2 +169700 PERFORM DE-LETE. NC1054.2 +169800 GO TO MOVE-WRITE-F1-57. NC1054.2 +169900 MOVE-FAIL-F1-57. NC1054.2 +170000 MOVE " 102, 345" TO CORRECT-A. NC1054.2 +170100 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +170200 PERFORM FAIL. NC1054.2 +170300 MOVE-WRITE-F1-57. NC1054.2 +170400 MOVE "MOVE-TEST-F1-57" TO PAR-NAME. NC1054.2 +170500 PERFORM PRINT-DETAIL. NC1054.2 +170600 MOVE-INIT-F1-58. NC1054.2 +170700 MOVE "MOVE ZERO LITERAL " TO FEATURE. NC1054.2 +170800 MOVE-TEST-F1-58-0. NC1054.2 +170900 MOVE ZERO TO GRP-WRK-DU-10V00. NC1054.2 +171000 MOVE-TEST-F1-58-1. NC1054.2 +171100 IF WRK-DU-10V00 EQUAL TO "0000000000" NC1054.2 +171200 PERFORM PASS NC1054.2 +171300 GO TO MOVE-WRITE-F1-58. NC1054.2 +171400 GO TO MOVE-FAIL-F1-58. NC1054.2 +171500 MOVE-DELETE-F1-58. NC1054.2 +171600 PERFORM DE-LETE. NC1054.2 +171700 GO TO MOVE-WRITE-F1-58. NC1054.2 +171800 MOVE-FAIL-F1-58. NC1054.2 +171900 MOVE "0000000000" TO CORRECT-A. NC1054.2 +172000 MOVE WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +172100 PERFORM FAIL. NC1054.2 +172200 MOVE-WRITE-F1-58. NC1054.2 +172300 MOVE "MOVE-TEST-F1-58" TO PAR-NAME. NC1054.2 +172400 PERFORM PRINT-DETAIL. NC1054.2 +172500 MOVE-INIT-F1-59. NC1054.2 +172600 NC1054.2 +172700 MOVE-TEST-F1-59-0. NC1054.2 +172800 MOVE "0000000000000000000000000000000000000000000000000" NC1054.2 +172900 TO WRK-XN-00049. NC1054.2 +173000 MOVE-TEST-F1-59-1. NC1054.2 +173100 IF GRP-WRK-XN-00049 EQUAL TO ZERO NC1054.2 +173200 PERFORM PASS NC1054.2 +173300 GO TO MOVE-WRITE-F1-59. NC1054.2 +173400 GO TO MOVE-FAIL-F1-59. NC1054.2 +173500 MOVE-DELETE-F1-59. NC1054.2 +173600 PERFORM DE-LETE. NC1054.2 +173700 GO TO MOVE-WRITE-F1-59. NC1054.2 +173800 MOVE-FAIL-F1-59. NC1054.2 +173900 MOVE "0000000000000000000000000000000000000000000000000" NC1054.2 +174000 TO SEND-BREAKDOWN. NC1054.2 +174100 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +174200 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +174300 PERFORM FAIL. NC1054.2 +174400 PERFORM A20 THRU A60. NC1054.2 +174500 MOVE-WRITE-F1-59. NC1054.2 +174600 MOVE "MOVE-TEST-F1-59" TO PAR-NAME. NC1054.2 +174700 PERFORM PRINT-DETAIL. NC1054.2 +174800 MOVE-INIT-F1-60. NC1054.2 +174900 NC1054.2 +175000 MOVE-TEST-F1-60-0. NC1054.2 +175100 MOVE ZERO TO AE-0002. NC1054.2 +175200 MOVE-TEST-F1-60-1. NC1054.2 +175300 IF GRP-AE-0002 EQUAL TO "00000 000" NC1054.2 +175400 PERFORM PASS NC1054.2 +175500 GO TO MOVE-WRITE-F1-60. NC1054.2 +175600 GO TO MOVE-FAIL-F1-60. NC1054.2 +175700 MOVE-DELETE-F1-60. NC1054.2 +175800 PERFORM DE-LETE. NC1054.2 +175900 GO TO MOVE-WRITE-F1-60. NC1054.2 +176000 MOVE-FAIL-F1-60. NC1054.2 +176100 MOVE "00000 000" TO CORRECT-A. NC1054.2 +176200 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +176300 PERFORM FAIL. NC1054.2 +176400 MOVE-WRITE-F1-60. NC1054.2 +176500 MOVE "MOVE-TEST-F1-60" TO PAR-NAME. NC1054.2 +176600 PERFORM PRINT-DETAIL. NC1054.2 +176700 MOVE-INIT-F1-61. NC1054.2 +176800 MOVE-TEST-F1-61-0. NC1054.2 +176900 MOVE ZERO TO WRK-DU-10V00. NC1054.2 +177000 MOVE-TEST-F1-61-1. NC1054.2 +177100 IF GRP-WRK-DU-10V00 EQUAL TO "0000000000" NC1054.2 +177200 PERFORM PASS NC1054.2 +177300 GO TO MOVE-WRITE-F1-61. NC1054.2 +177400 GO TO MOVE-FAIL-F1-61. NC1054.2 +177500 MOVE-DELETE-117. NC1054.2 +177600 PERFORM DE-LETE. NC1054.2 +177700 GO TO MOVE-WRITE-F1-61. NC1054.2 +177800 MOVE-FAIL-F1-61. NC1054.2 +177900 MOVE "0000000000" TO CORRECT-A. NC1054.2 +178000 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +178100 PERFORM FAIL. NC1054.2 +178200 MOVE-WRITE-F1-61. NC1054.2 +178300 MOVE "MOVE-TEST-F1-61" TO PAR-NAME. NC1054.2 +178400 PERFORM PRINT-DETAIL. NC1054.2 +178500 MOVE-INIT-F1-62. NC1054.2 +178600 MOVE-TEST-F1-62-0. NC1054.2 +178700 MOVE ZERO TO NE-0001. NC1054.2 +178800 MOVE-TEST-F1-62-1. NC1054.2 +178900 IF GRP-NE-0001 EQUAL TO " 000.000,0" NC1054.2 +179000 PERFORM PASS NC1054.2 +179100 GO TO MOVE-WRITE-F1-62. NC1054.2 +179200 GO TO MOVE-FAIL-F1-62. NC1054.2 +179300 MOVE-DELETE-F1-62. NC1054.2 +179400 PERFORM DE-LETE. NC1054.2 +179500 GO TO MOVE-WRITE-F1-62. NC1054.2 +179600 MOVE-FAIL-F1-62. NC1054.2 +179700 MOVE " 000.000,0" TO CORRECT-A. NC1054.2 +179800 MOVE GRP-NE-0001 TO COMPUTED-A. NC1054.2 +179900 PERFORM FAIL. NC1054.2 +180000 MOVE-WRITE-F1-62. NC1054.2 +180100 MOVE "MOVE-TEST-F1-62" TO PAR-NAME. NC1054.2 +180200 PERFORM PRINT-DETAIL. NC1054.2 +180300 MOVE-INIT-F1-63. NC1054.2 +180400 MOVE "MOVE SPACE LITERAL " TO FEATURE. NC1054.2 +180500 MOVE-TEST-F1-63-0. NC1054.2 +180600 MOVE SPACE TO GRP-WRK-DU-10V00. NC1054.2 +180700 MOVE-TEST-F1-63-1. NC1054.2 +180800 IF GRP-WRK-DU-10V00 EQUAL TO SPACE NC1054.2 +180900 PERFORM PASS NC1054.2 +181000 GO TO MOVE-WRITE-F1-63. NC1054.2 +181100 GO TO MOVE-FAIL-F1-63. NC1054.2 +181200 MOVE-DELETE-F1-63. NC1054.2 +181300 PERFORM DE-LETE. NC1054.2 +181400 GO TO MOVE-WRITE-F1-63. NC1054.2 +181500 MOVE-FAIL-F1-63. NC1054.2 +181600 MOVE SPACE TO CORRECT-A. NC1054.2 +181700 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +181800 PERFORM FAIL. NC1054.2 +181900 MOVE-WRITE-F1-63. NC1054.2 +182000 MOVE "MOVE-TEST-F1-63" TO PAR-NAME. NC1054.2 +182100 PERFORM PRINT-DETAIL. NC1054.2 +182200 MOVE-INIT-F1-64. NC1054.2 +182300 MOVE-TEST-F1-64-0. NC1054.2 +182400 MOVE SPACE TO WRK-AN-00026. NC1054.2 +182500 MOVE-TEST-F1-64-1. NC1054.2 +182600 IF GRP-WRK-AN-00026 EQUAL TO " " NC1054.2 +182700 PERFORM PASS NC1054.2 +182800 GO TO MOVE-WRITE-F1-64. NC1054.2 +182900 GO TO MOVE-FAIL-F1-64. NC1054.2 +183000 MOVE-DELETE-F1-64. NC1054.2 +183100 PERFORM DE-LETE. NC1054.2 +183200 GO TO MOVE-WRITE-F1-64. NC1054.2 +183300 MOVE-FAIL-F1-64. NC1054.2 +183400 MOVE SPACE TO SEND-BREAKDOWN. NC1054.2 +183500 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +183600 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +183700 PERFORM FAIL. NC1054.2 +183800 PERFORM A20 THRU A40. NC1054.2 +183900 MOVE-WRITE-F1-64. NC1054.2 +184000 MOVE "MOVE-TEST-F1-64" TO PAR-NAME. NC1054.2 +184100 PERFORM PRINT-DETAIL. NC1054.2 +184200 MOVE-INIT-F1-65. NC1054.2 +184300 MOVE-TEST-F1-65-0. NC1054.2 +184400 MOVE SPACE TO WRK-XN-00049. NC1054.2 +184500 MOVE-TEST-F1-65-1. NC1054.2 +184600 IF GRP-WRK-XN-00049 EQUAL TO SPACE NC1054.2 +184700 PERFORM PASS NC1054.2 +184800 GO TO MOVE-WRITE-F1-65. NC1054.2 +184900 GO TO MOVE-FAIL-F1-65. NC1054.2 +185000 MOVE-DELETE-F1-65. NC1054.2 +185100 PERFORM DE-LETE. NC1054.2 +185200 GO TO MOVE-WRITE-F1-65. NC1054.2 +185300 MOVE-FAIL-F1-65. NC1054.2 +185400 MOVE SPACE TO SEND-BREAKDOWN. NC1054.2 +185500 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +185600 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +185700 PERFORM FAIL. NC1054.2 +185800 PERFORM A20 THRU A60. NC1054.2 +185900 MOVE-WRITE-F1-65. NC1054.2 +186000 MOVE "MOVE-TEST-F1-65" TO PAR-NAME. NC1054.2 +186100 PERFORM PRINT-DETAIL. NC1054.2 +186200 MOVE-INIT-F1-66. NC1054.2 +186300 MOVE-TEST-F1-66-0. NC1054.2 +186400 MOVE SPACE TO AE-0002. NC1054.2 +186500 MOVE-TEST-F1-66-1. NC1054.2 +186600 IF GRP-AE-0002 EQUAL TO " 0 " NC1054.2 +186700 PERFORM PASS NC1054.2 +186800 GO TO MOVE-WRITE-F1-66. NC1054.2 +186900 GO TO MOVE-FAIL-F1-66. NC1054.2 +187000 MOVE-DELETE-F1-66. NC1054.2 +187100 PERFORM DE-LETE. NC1054.2 +187200 GO TO MOVE-WRITE-F1-66. NC1054.2 +187300 MOVE-FAIL-F1-66. NC1054.2 +187400 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +187500 MOVE " 0 " TO CORRECT-A. NC1054.2 +187600 PERFORM FAIL. NC1054.2 +187700 MOVE-WRITE-F1-66. NC1054.2 +187800 MOVE "MOVE-TEST-F1-66" TO PAR-NAME. NC1054.2 +187900 PERFORM PRINT-DETAIL. NC1054.2 +188000 MOVE-INIT-F1-67. NC1054.2 +188100 MOVE "MOVE HIGH-VALUE " TO FEATURE. NC1054.2 +188200 MOVE-TEST-F1-67-0. NC1054.2 +188300 MOVE HIGH-VALUE TO GRP-WRK-DU-10V00. NC1054.2 +188400 MOVE-TEST-F1-67-1. NC1054.2 +188500 IF GRP-WRK-DU-10V00 EQUAL TO HIGH-VALUE NC1054.2 +188600 PERFORM PASS NC1054.2 +188700 GO TO MOVE-WRITE-F1-67. NC1054.2 +188800 GO TO MOVE-FAIL-F1-67. NC1054.2 +188900 MOVE-DELETE-F1-67. NC1054.2 +189000 PERFORM DE-LETE. NC1054.2 +189100 GO TO MOVE-WRITE-F1-67. NC1054.2 +189200 MOVE-FAIL-F1-67. NC1054.2 +189300 MOVE HIGH-VALU-10LONG TO CORRECT-A. NC1054.2 +189400 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +189500 PERFORM FAIL. NC1054.2 +189600 MOVE-WRITE-F1-67. NC1054.2 +189700 MOVE "MOVE-TEST-F1-67" TO PAR-NAME. NC1054.2 +189800 PERFORM PRINT-DETAIL. NC1054.2 +189900 MOVE-INIT-F1-68. NC1054.2 +190000 MOVE-TEST-F1-68-0. NC1054.2 +190100 MOVE HIGH-VALUE TO WRK-XN-00049. NC1054.2 +190200 MOVE-TEST-F1-68-1. NC1054.2 +190300 IF GRP-WRK-XN-00049 EQUAL TO HIGH-VALUE NC1054.2 +190400 PERFORM PASS NC1054.2 +190500 GO TO MOVE-WRITE-F1-68. NC1054.2 +190600 MOVE-DELETE-F1-68. NC1054.2 +190700 PERFORM DE-LETE. NC1054.2 +190800 GO TO MOVE-WRITE-F1-68. NC1054.2 +190900 MOVE-FAIL-F1-68. NC1054.2 +191000 MOVE HIGH-VALU-49LONG TO SEND-BREAKDOWN. NC1054.2 +191100 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +191200 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +191300 PERFORM FAIL. NC1054.2 +191400 PERFORM A20 THRU A60. NC1054.2 +191500 MOVE-WRITE-F1-68. NC1054.2 +191600 MOVE "MOVE-TEST-F1-68" TO PAR-NAME. NC1054.2 +191700 PERFORM PRINT-DETAIL. NC1054.2 +191800 MOVE-INIT-F1-69. NC1054.2 +191900 MOVE-TEST-F1-69-0. NC1054.2 +192000 MOVE HIGH-VALUE TO AE-0002. NC1054.2 +192100 MOVE-TEST-F1-69-1. NC1054.2 +192200 IF GRP-AE-0002 EQUAL TO HIGH-VALUE-EDIT NC1054.2 +192300 PERFORM PASS NC1054.2 +192400 GO TO MOVE-WRITE-F1-69. NC1054.2 +192500 GO TO MOVE-FAIL-F1-69. NC1054.2 +192600 MOVE-DELETE-F1-69. NC1054.2 +192700 PERFORM DE-LETE. NC1054.2 +192800 GO TO MOVE-WRITE-F1-69. NC1054.2 +192900 MOVE-FAIL-F1-69. NC1054.2 +193000 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +193100 MOVE HIGH-VALUE-EDIT TO CORRECT-A. NC1054.2 +193200 PERFORM FAIL. NC1054.2 +193300 MOVE-WRITE-F1-69. NC1054.2 +193400 MOVE "MOVE-TEST-F1-69" TO PAR-NAME. NC1054.2 +193500 PERFORM PRINT-DETAIL. NC1054.2 +193600 MOVE-INIT-F1-70. NC1054.2 +193700 MOVE "MOVE LOW-VALUE " TO FEATURE. NC1054.2 +193800 MOVE-TEST-F1-70-0. NC1054.2 +193900 MOVE LOW-VALUE TO GRP-WRK-DU-10V00. NC1054.2 +194000 MOVE-TEST-F1-70-1. NC1054.2 +194100 IF GRP-WRK-DU-10V00 EQUAL TO LOW-VALUE NC1054.2 +194200 PERFORM PASS NC1054.2 +194300 GO TO MOVE-WRITE-F1-70. NC1054.2 +194400 GO TO MOVE-FAIL-F1-70. NC1054.2 +194500 MOVE-DELETE-F1-70. NC1054.2 +194600 PERFORM DE-LETE. NC1054.2 +194700 GO TO MOVE-WRITE-F1-70. NC1054.2 +194800 MOVE-FAIL-F1-70. NC1054.2 +194900 MOVE LOW-VALU-10LONG TO CORRECT-A. NC1054.2 +195000 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +195100 PERFORM FAIL. NC1054.2 +195200 MOVE-WRITE-F1-70. NC1054.2 +195300 MOVE "MOVE-TEST-F1-70" TO PAR-NAME. NC1054.2 +195400 PERFORM PRINT-DETAIL. NC1054.2 +195500 MOVE-INIT-F1-71. NC1054.2 +195600 MOVE-TEST-F1-71-0. NC1054.2 +195700 MOVE LOW-VALUE TO WRK-XN-00049. NC1054.2 +195800 MOVE-TEST-F1-71-1. NC1054.2 +195900 IF GRP-WRK-XN-00049 EQUAL TO LOW-VALUE NC1054.2 +196000 PERFORM PASS NC1054.2 +196100 GO TO MOVE-WRITE-F1-71. NC1054.2 +196200 GO TO MOVE-FAIL-F1-71. NC1054.2 +196300 MOVE-DELETE-F1-71. NC1054.2 +196400 PERFORM DE-LETE. NC1054.2 +196500 GO TO MOVE-WRITE-F1-71. NC1054.2 +196600 MOVE-FAIL-F1-71. NC1054.2 +196700 MOVE LOW-VALU-49LONG TO SEND-BREAKDOWN. NC1054.2 +196800 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +196900 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +197000 PERFORM FAIL. NC1054.2 +197100 PERFORM A20 THRU A60. NC1054.2 +197200 MOVE-WRITE-F1-71. NC1054.2 +197300 MOVE "MOVE-TEST-F1-71" TO PAR-NAME. NC1054.2 +197400 PERFORM PRINT-DETAIL. NC1054.2 +197500 MOVE-INIT-F1-72. NC1054.2 +197600 MOVE LOW-VALUE TO HIGH-1 HIGH-2 HIGH-3. NC1054.2 +197700 MOVE-TEST-F1-72-0. NC1054.2 +197800 MOVE LOW-VALUE TO AE-0002. NC1054.2 +197900 MOVE-TEST-F1-72-1. NC1054.2 +198000 IF GRP-AE-0002 EQUAL TO HIGH-VALUE-EDIT NC1054.2 +198100 PERFORM PASS NC1054.2 +198200 GO TO MOVE-WRITE-F1-72. NC1054.2 +198300 GO TO MOVE-FAIL-F1-72. NC1054.2 +198400 MOVE-DELETE-F1-72. NC1054.2 +198500 PERFORM DE-LETE. NC1054.2 +198600 GO TO MOVE-WRITE-F1-72. NC1054.2 +198700 MOVE-FAIL-F1-72. NC1054.2 +198800 MOVE HIGH-VALUE-EDIT TO CORRECT-A. NC1054.2 +198900 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +199000 PERFORM FAIL. NC1054.2 +199100 MOVE-WRITE-F1-72. NC1054.2 +199200 MOVE "MOVE-TEST-F1-72" TO PAR-NAME. NC1054.2 +199300 PERFORM PRINT-DETAIL. NC1054.2 +199400 MOVE-INIT-F1-73. NC1054.2 +199500 MOVE "MOVE QUOTE " TO FEATURE. NC1054.2 +199600 MOVE-TEST-F1-73-0. NC1054.2 +199700 MOVE QUOTE TO GRP-WRK-DU-10V00. NC1054.2 +199800 MOVE-TEST-F1-73-1. NC1054.2 +199900 IF GRP-WRK-DU-10V00 EQUAL TO QUOTE NC1054.2 +200000 PERFORM PASS NC1054.2 +200100 GO TO MOVE-WRITE-F1-73. NC1054.2 +200200 GO TO MOVE-FAIL-F1-73. NC1054.2 +200300 MOVE-DELETE-F1-73. NC1054.2 +200400 PERFORM DE-LETE. NC1054.2 +200500 GO TO MOVE-WRITE-F1-73. NC1054.2 +200600 MOVE-FAIL-F1-73. NC1054.2 +200700 MOVE QUOTE-10LONG TO CORRECT-A. NC1054.2 +200800 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +200900 PERFORM FAIL. NC1054.2 +201000 MOVE-WRITE-F1-73. NC1054.2 +201100 MOVE "MOVE-TEST-F1-73" TO PAR-NAME. NC1054.2 +201200 PERFORM PRINT-DETAIL. NC1054.2 +201300 MOVE-INIT-F1-74. NC1054.2 +201400 MOVE-TEST-F1-74-0. NC1054.2 +201500 MOVE QUOTE TO WRK-XN-00049. NC1054.2 +201600 MOVE-TEST-F1-74-1. NC1054.2 +201700 IF GRP-WRK-XN-00049 EQUAL TO QUOTE NC1054.2 +201800 PERFORM PASS NC1054.2 +201900 GO TO MOVE-WRITE-F1-74. NC1054.2 +202000 GO TO MOVE-FAIL-F1-74. NC1054.2 +202100 MOVE-DELETE-F1-74. NC1054.2 +202200 PERFORM DE-LETE. NC1054.2 +202300 GO TO MOVE-WRITE-F1-74. NC1054.2 +202400 MOVE-FAIL-F1-74. NC1054.2 +202500 MOVE QUOTE-49LONG TO SEND-BREAKDOWN. NC1054.2 +202600 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +202700 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +202800 PERFORM FAIL. NC1054.2 +202900 PERFORM A20 THRU A60. NC1054.2 +203000 MOVE-WRITE-F1-74. NC1054.2 +203100 MOVE "MOVE-TEST-F1-74" TO PAR-NAME. NC1054.2 +203200 PERFORM PRINT-DETAIL. NC1054.2 +203300 MOVE-INIT-F1-75. NC1054.2 +203400 MOVE QUOTE TO HIGH-1 HIGH-2 HIGH-3. NC1054.2 +203500 MOVE-TEST-F1-75-0. NC1054.2 +203600 MOVE QUOTE TO AE-0002. NC1054.2 +203700 MOVE-TEST-F1-75-1. NC1054.2 +203800 IF GRP-AE-0002 EQUAL TO HIGH-VALUE-EDIT NC1054.2 +203900 PERFORM PASS NC1054.2 +204000 GO TO MOVE-WRITE-F1-75. NC1054.2 +204100 GO TO MOVE-FAIL-F1-75. NC1054.2 +204200 MOVE-DELETE-F1-75. NC1054.2 +204300 PERFORM DE-LETE. NC1054.2 +204400 GO TO MOVE-WRITE-F1-75. NC1054.2 +204500 MOVE-FAIL-F1-75. NC1054.2 +204600 MOVE HIGH-VALUE-EDIT TO CORRECT-A. NC1054.2 +204700 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +204800 PERFORM FAIL. NC1054.2 +204900 MOVE-WRITE-F1-75. NC1054.2 +205000 MOVE "MOVE-TEST-F1-75" TO PAR-NAME. NC1054.2 +205100 PERFORM PRINT-DETAIL. NC1054.2 +205200 MOVE-INIT-F1-76. NC1054.2 +205300 MOVE-TEST-F1-76-0. NC1054.2 +205400 MOVE "A1B2C3D4E5" TO GRP-WRK-DU-10V00. NC1054.2 +205500 MOVE-TEST-F1-76-1. NC1054.2 +205600 IF GRP-WRK-DU-10V00 EQUAL TO "A1B2C3D4E5" NC1054.2 +205700 PERFORM PASS NC1054.2 +205800 GO TO MOVE-WRITE-F1-76. NC1054.2 +205900 GO TO MOVE-FAIL-F1-76. NC1054.2 +206000 MOVE-DELETE-F1-76. NC1054.2 +206100 PERFORM DE-LETE. NC1054.2 +206200 GO TO MOVE-WRITE-F1-76. NC1054.2 +206300 MOVE-FAIL-F1-76. NC1054.2 +206400 MOVE "A1B2C3D4E5" TO CORRECT-A. NC1054.2 +206500 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +206600 PERFORM FAIL. NC1054.2 +206700 MOVE-WRITE-F1-76. NC1054.2 +206800 MOVE "MOVE ALPHNUM LITERAL" TO FEATURE. NC1054.2 +206900 MOVE "MOVE-TEST-F1-76" TO PAR-NAME. NC1054.2 +207000 PERFORM PRINT-DETAIL. NC1054.2 +207100 MOVE-INIT-F1-77. NC1054.2 +207200 MOVE-TEST-F1-77-0. NC1054.2 +207300 MOVE "ABCDEFGHIJK" TO WRK-AN-00026. NC1054.2 +207400 MOVE-TEST-F1-77-1. NC1054.2 +207500 IF GRP-WRK-AN-00026 EQUAL TO "ABCDEFGHIJK "NC1054.2 +207600 PERFORM PASS NC1054.2 +207700 GO TO MOVE-WRITE-F1-77. NC1054.2 +207800 GO TO MOVE-FAIL-F1-77. NC1054.2 +207900 MOVE-DELETE-F1-77. NC1054.2 +208000 PERFORM DE-LETE. NC1054.2 +208100 GO TO MOVE-WRITE-F1-77. NC1054.2 +208200 MOVE-FAIL-F1-77. NC1054.2 +208300 MOVE "ABCDEFGHIJK " TO SEND-BREAKDOWN. NC1054.2 +208400 MOVE GRP-WRK-AN-00026 TO RECEIVE-BREAKDOWN. NC1054.2 +208500 MOVE 026 TO LENGTH-COUNTER. NC1054.2 +208600 PERFORM FAIL. NC1054.2 +208700 PERFORM A20 THRU A40. NC1054.2 +208800 MOVE-WRITE-F1-77. NC1054.2 +208900 MOVE "MOVE ALPHA LITERAL " TO FEATURE. NC1054.2 +209000 MOVE "MOVE-TEST-F1-77" TO PAR-NAME. NC1054.2 +209100 PERFORM PRINT-DETAIL. NC1054.2 +209200 MOVE-INIT-F1-78. NC1054.2 +209300 MOVE "MOVE ALPHNUM LITERAL" TO FEATURE. NC1054.2 +209400 MOVE-TEST-F1-78-0. NC1054.2 +209500 MOVE "1A2B3C4D5E6F" TO WRK-XN-00049. NC1054.2 +209600 MOVE-TEST-F1-78-1. NC1054.2 +209700 IF GRP-WRK-XN-00049 EQUAL TO NC1054.2 +209800 "1A2B3C4D5E6F " NC1054.2 +209900 PERFORM PASS NC1054.2 +210000 GO TO MOVE-WRITE-F1-78. NC1054.2 +210100 GO TO MOVE-FAIL-F1-78. NC1054.2 +210200 MOVE-DELETE-F1-78. NC1054.2 +210300 PERFORM DE-LETE. NC1054.2 +210400 GO TO MOVE-WRITE-F1-78. NC1054.2 +210500 MOVE-FAIL-F1-78. NC1054.2 +210600 MOVE "1A2B3C4D5E6F " NC1054.2 +210700 TO SEND-BREAKDOWN. NC1054.2 +210800 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +210900 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +211000 PERFORM FAIL. NC1054.2 +211100 PERFORM A20 THRU A60. NC1054.2 +211200 MOVE-WRITE-F1-78. NC1054.2 +211300 MOVE "MOVE-TEST-F1-78" TO PAR-NAME. NC1054.2 +211400 PERFORM PRINT-DETAIL. NC1054.2 +211500 MOVE-INIT-F1-79. NC1054.2 +211600 MOVE-TEST-F1-79-0. NC1054.2 +211700 MOVE "1Z2Y3X4W5V" TO AE-0002. NC1054.2 +211800 MOVE-TEST-F1-79-1. NC1054.2 +211900 IF GRP-AE-0002 EQUAL TO "1Z02Y 3X4" NC1054.2 +212000 PERFORM PASS NC1054.2 +212100 GO TO MOVE-WRITE-F1-79. NC1054.2 +212200 GO TO MOVE-FAIL-F1-79. NC1054.2 +212300 MOVE-DELETE-F1-79. NC1054.2 +212400 PERFORM DE-LETE. NC1054.2 +212500 GO TO MOVE-WRITE-F1-79. NC1054.2 +212600 MOVE-FAIL-F1-79. NC1054.2 +212700 MOVE "1Z02Y 3X4" TO CORRECT-A. NC1054.2 +212800 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +212900 PERFORM FAIL. NC1054.2 +213000 MOVE-WRITE-F1-79. NC1054.2 +213100 MOVE "MOVE-TEST-F1-79" TO PAR-NAME. NC1054.2 +213200 PERFORM PRINT-DETAIL. NC1054.2 +213300 MOVE-INIT-F1-80. NC1054.2 +213400 MOVE-TEST-F1-80-0. NC1054.2 +213500 MOVE "9876543210" TO WRK-DU-10V00. NC1054.2 +213600 MOVE-TEST-F1-80-1. NC1054.2 +213700 IF GRP-WRK-DU-10V00 EQUAL TO "9876543210" NC1054.2 +213800 PERFORM PASS NC1054.2 +213900 GO TO MOVE-WRITE-F1-80. NC1054.2 +214000 GO TO MOVE-FAIL-F1-80. NC1054.2 +214100 MOVE-DELETE-F1-80. NC1054.2 +214200 PERFORM DE-LETE. NC1054.2 +214300 GO TO MOVE-WRITE-F1-80. NC1054.2 +214400 MOVE-FAIL-F1-80. NC1054.2 +214500 MOVE "9876543210" TO CORRECT-A. NC1054.2 +214600 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +214700 PERFORM FAIL. NC1054.2 +214800 MOVE-WRITE-F1-80. NC1054.2 +214900 MOVE "MOVE-TEST-F1-80" TO PAR-NAME. NC1054.2 +215000 PERFORM PRINT-DETAIL. NC1054.2 +215100 MOVE-INIT-F1-81. NC1054.2 +215200 MOVE-TEST-F1-81-0. NC1054.2 +215300 MOVE "9876543210" TO NE-0002. NC1054.2 +215400 MOVE-TEST-F1-81-1. NC1054.2 +215500 IF GRP-NE-0002 EQUAL TO "9876543,210" NC1054.2 +215600 PERFORM PASS NC1054.2 +215700 GO TO MOVE-WRITE-F1-81. NC1054.2 +215800 GO TO MOVE-FAIL-F1-81. NC1054.2 +215900 MOVE-DELETE-F1-81. NC1054.2 +216000 PERFORM DE-LETE. NC1054.2 +216100 GO TO MOVE-WRITE-F1-81. NC1054.2 +216200 MOVE-FAIL-F1-81. NC1054.2 +216300 MOVE "9876543,210" TO CORRECT-A. NC1054.2 +216400 MOVE GRP-NE-0002 TO COMPUTED-A. NC1054.2 +216500 PERFORM FAIL. NC1054.2 +216600 MOVE-WRITE-F1-81. NC1054.2 +216700 MOVE "MOVE-TEST-F1-81" TO PAR-NAME. NC1054.2 +216800 PERFORM PRINT-DETAIL. NC1054.2 +216900 MOVE-INIT-F1-82. NC1054.2 +217000 MOVE "MOVE NUMERIC LITERAL" TO FEATURE. NC1054.2 +217100 MOVE-TEST-F1-82-0. NC1054.2 +217200 MOVE 0123456789 TO GRP-WRK-DU-10V00. NC1054.2 +217300 MOVE-TEST-F1-82-1. NC1054.2 +217400 IF GRP-WRK-DU-10V00 EQUAL TO "0123456789" NC1054.2 +217500 PERFORM PASS NC1054.2 +217600 GO TO MOVE-WRITE-F1-82. NC1054.2 +217700 GO TO MOVE-FAIL-F1-82. NC1054.2 +217800 MOVE-DELETE-F1-82. NC1054.2 +217900 PERFORM DE-LETE. NC1054.2 +218000 GO TO MOVE-WRITE-F1-82. NC1054.2 +218100 MOVE-FAIL-F1-82. NC1054.2 +218200 MOVE "0123456789" TO CORRECT-A. NC1054.2 +218300 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +218400 PERFORM FAIL. NC1054.2 +218500 MOVE-WRITE-F1-82. NC1054.2 +218600 MOVE "MOVE-TEST-F1-82" TO PAR-NAME. NC1054.2 +218700 PERFORM PRINT-DETAIL. NC1054.2 +218800 MOVE-INIT-F1-83. NC1054.2 +218900 MOVE-TEST-F1-83-0. NC1054.2 +219000 MOVE 0918273645 TO WRK-XN-00049. NC1054.2 +219100 MOVE-TEST-F1-83-1. NC1054.2 +219200 IF GRP-WRK-XN-00049 EQUAL TO NC1054.2 +219300 "0918273645 " NC1054.2 +219400 PERFORM PASS NC1054.2 +219500 GO TO MOVE-WRITE-F1-83. NC1054.2 +219600 GO TO MOVE-FAIL-F1-83. NC1054.2 +219700 MOVE-DELETE-F1-83. NC1054.2 +219800 PERFORM DE-LETE. NC1054.2 +219900 GO TO MOVE-WRITE-F1-83. NC1054.2 +220000 MOVE-FAIL-F1-83. NC1054.2 +220100 MOVE "0918273645 " NC1054.2 +220200 TO SEND-BREAKDOWN. NC1054.2 +220300 MOVE GRP-WRK-XN-00049 TO RECEIVE-BREAKDOWN. NC1054.2 +220400 MOVE 049 TO LENGTH-COUNTER. NC1054.2 +220500 PERFORM FAIL. NC1054.2 +220600 PERFORM A20 THRU A60. NC1054.2 +220700 MOVE-WRITE-F1-83. NC1054.2 +220800 MOVE "MOVE-TEST-F1-82" TO PAR-NAME. NC1054.2 +220900 PERFORM PRINT-DETAIL. NC1054.2 +221000 MOVE-INIT-F1-84. NC1054.2 +221100 MOVE-TEST-F1-84-0. NC1054.2 +221200 MOVE 019823 TO AE-0002. NC1054.2 +221300 MOVE-TEST-F1-84-1. NC1054.2 +221400 IF GRP-AE-0002 EQUAL TO "01098 23 " NC1054.2 +221500 PERFORM PASS NC1054.2 +221600 GO TO MOVE-WRITE-F1-84. NC1054.2 +221700 GO TO MOVE-FAIL-F1-84. NC1054.2 +221800 MOVE-DELETE-F1-84. NC1054.2 +221900 PERFORM DE-LETE. NC1054.2 +222000 GO TO MOVE-WRITE-F1-84. NC1054.2 +222100 MOVE-FAIL-F1-84. NC1054.2 +222200 MOVE "01098 23 " TO CORRECT-A. NC1054.2 +222300 MOVE GRP-AE-0002 TO COMPUTED-A. NC1054.2 +222400 PERFORM FAIL. NC1054.2 +222500 MOVE-WRITE-F1-84. NC1054.2 +222600 MOVE "MOVE-TEST-F1-84" TO PAR-NAME. NC1054.2 +222700 PERFORM PRINT-DETAIL. NC1054.2 +222800 MOVE-INIT-F1-85. NC1054.2 +222900 MOVE-TEST-F1-85-0. NC1054.2 +223000 MOVE 9876543210 TO WRK-DU-10V00. NC1054.2 +223100 MOVE-TEST-F1-85-1. NC1054.2 +223200 IF GRP-WRK-DU-10V00 EQUAL TO "9876543210" NC1054.2 +223300 PERFORM PASS NC1054.2 +223400 GO TO MOVE-WRITE-F1-85. NC1054.2 +223500 GO TO MOVE-FAIL-F1-85. NC1054.2 +223600 MOVE-DELETE-F1-85. NC1054.2 +223700 PERFORM DE-LETE. NC1054.2 +223800 GO TO MOVE-WRITE-F1-85. NC1054.2 +223900 MOVE-FAIL-F1-85. NC1054.2 +224000 MOVE "9876543210" TO CORRECT-A. NC1054.2 +224100 MOVE GRP-WRK-DU-10V00 TO COMPUTED-A. NC1054.2 +224200 PERFORM FAIL. NC1054.2 +224300 MOVE-WRITE-F1-85. NC1054.2 +224400 MOVE "MOVE-TEST-F1-85" TO PAR-NAME. NC1054.2 +224500 PERFORM PRINT-DETAIL. NC1054.2 +224600 MOVE-INIT-F1-86. NC1054.2 +224700 MOVE-TEST-F1-86-0. NC1054.2 +224800 MOVE 00012345 TO NE-0002. NC1054.2 +224900 MOVE-TEST-F1-86-1. NC1054.2 +225000 IF GRP-NE-0002 EQUAL TO " 12,345" NC1054.2 +225100 PERFORM PASS NC1054.2 +225200 GO TO MOVE-WRITE-F1-86. NC1054.2 +225300 GO TO MOVE-FAIL-F1-86. NC1054.2 +225400 MOVE-DELETE-F1-86. NC1054.2 +225500 PERFORM DE-LETE. NC1054.2 +225600 GO TO MOVE-WRITE-F1-86. NC1054.2 +225700 MOVE-FAIL-F1-86. NC1054.2 +225800 MOVE " 12,345" TO CORRECT-A. NC1054.2 +225900 MOVE GRP-NE-0002 TO COMPUTED-A. NC1054.2 +226000 PERFORM FAIL. NC1054.2 +226100 MOVE-WRITE-F1-86. NC1054.2 +226200 MOVE "MOVE-TEST-F1-86" TO PAR-NAME. NC1054.2 +226300 PERFORM PRINT-DETAIL. NC1054.2 +226400 MOVE-INIT-F1-87. NC1054.2 +226500 MOVE-TEST-F1-87-0. NC1054.2 +226600 MOVE 000011.1223 TO NE-0001. NC1054.2 +226700 MOVE-TEST-F1-87-1. NC1054.2 +226800 IF GRP-NE-0001 EQUAL TO " 011.122,3" NC1054.2 +226900 PERFORM PASS NC1054.2 +227000 GO TO MOVE-WRITE-F1-87. NC1054.2 +227100 GO TO MOVE-FAIL-F1-87. NC1054.2 +227200 MOVE-DELETE-F1-87. NC1054.2 +227300 PERFORM DE-LETE. NC1054.2 +227400 GO TO MOVE-WRITE-F1-87. NC1054.2 +227500 MOVE-FAIL-F1-87. NC1054.2 +227600 MOVE " 011.122,3" TO CORRECT-A. NC1054.2 +227700 MOVE GRP-NE-0001 TO COMPUTED-A. NC1054.2 +227800 PERFORM FAIL. NC1054.2 +227900 MOVE-WRITE-F1-87. NC1054.2 +228000 MOVE "MOVE-TEST-F1-87" TO PAR-NAME. NC1054.2 +228100 PERFORM PRINT-DETAIL. NC1054.2 +228200 MOVE-INIT-F1-88. NC1054.2 +228300 MOVE +60666 TO SPOS-LIT1. NC1054.2 +228400 MOVE-TEST-F1-88-0. NC1054.2 +228500 MOVE SPOS-LIT1 TO NUMERIC-LIT. NC1054.2 +228600 MOVE-TEST-F1-88-1. NC1054.2 +228700 IF NUMERIC-LIT EQUAL TO "60666" NC1054.2 +228800 PERFORM PASS NC1054.2 +228900 GO TO MOVE-WRITE-F1-88. NC1054.2 +229000 MOVE GRP-LEV-NUMERIC TO COMPUTED-A. NC1054.2 +229100 MOVE 60666 TO CORRECT-A. NC1054.2 +229200 PERFORM FAIL. NC1054.2 +229300 GO TO MOVE-WRITE-F1-88. NC1054.2 +229400 MOVE-DELETE-F1-88. NC1054.2 +229500 PERFORM DE-LETE. NC1054.2 +229600 MOVE-WRITE-F1-88. NC1054.2 +229700 MOVE "MOVE-TEST-F1-88" TO PAR-NAME. NC1054.2 +229800 PERFORM PRINT-DETAIL. NC1054.2 +229900 MOVE-INIT-F1-89. NC1054.2 +230000 MOVE -70717 TO SPOS-LIT1. NC1054.2 +230100 MOVE-TEST-F1-89-0. NC1054.2 +230200 MOVE SNEG-LIT1 TO NUMERIC-LIT. NC1054.2 +230300 MOVE-TEST-F1-89-1. NC1054.2 +230400 IF NUMERIC-LIT EQUAL TO "70717" NC1054.2 +230500 PERFORM PASS NC1054.2 +230600 GO TO MOVE-WRITE-F1-89. NC1054.2 +230700 MOVE GRP-LEV-NUMERIC TO COMPUTED-A. NC1054.2 +230800 MOVE 70717 TO CORRECT-A. NC1054.2 +230900 PERFORM FAIL. NC1054.2 +231000 GO TO MOVE-WRITE-F1-89. NC1054.2 +231100 MOVE-DELETE-F1-89. NC1054.2 +231200 PERFORM DE-LETE. NC1054.2 +231300 MOVE-WRITE-F1-89. NC1054.2 +231400 MOVE "MOVE-TEST-F1-89" TO PAR-NAME. NC1054.2 +231500 PERFORM PRINT-DETAIL. NC1054.2 +231600 MOVE-INIT-F1-90. NC1054.2 +231700 MOVE +60667 TO SPOS-LIT2. NC1054.2 +231800 MOVE-TEST-F1-90-0. NC1054.2 +231900 MOVE SPOS-LIT2 TO NUMERIC-LIT. NC1054.2 +232000 MOVE-TEST-F1-90-1. NC1054.2 +232100 IF NUMERIC-LIT EQUAL TO 60667 NC1054.2 +232200 PERFORM PASS NC1054.2 +232300 GO TO MOVE-WRITE-F1-90. NC1054.2 +232400 MOVE GRP-LEV-NUMERIC TO COMPUTED-A. NC1054.2 +232500 MOVE 60667 TO CORRECT-A. NC1054.2 +232600 PERFORM FAIL. NC1054.2 +232700 GO TO MOVE-WRITE-F1-90. NC1054.2 +232800 MOVE-DELETE-F1-90. NC1054.2 +232900 PERFORM DE-LETE. NC1054.2 +233000 MOVE-WRITE-F1-90. NC1054.2 +233100 MOVE "MOVE-TEST-F1-90" TO PAR-NAME. NC1054.2 +233200 PERFORM PRINT-DETAIL. NC1054.2 +233300 MOVE-INIT-F1-91. NC1054.2 +233400 MOVE -70718 TO SNEG-LIT2. NC1054.2 +233500 MOVE-TEST-F1-91-0. NC1054.2 +233600 MOVE SNEG-LIT2 TO NUMERIC-LIT. NC1054.2 +233700 MOVE-TEST-F1-91-1. NC1054.2 +233800 IF NUMERIC-LIT EQUAL TO 70718 NC1054.2 +233900 PERFORM PASS NC1054.2 +234000 GO TO MOVE-WRITE-F1-91. NC1054.2 +234100 MOVE "+S9 MOVED TO PICTURE X " TO RE-MARK. NC1054.2 +234200 MOVE NUMERIC-LIT TO COMPUTED-A. NC1054.2 +234300 MOVE "70718" TO CORRECT-A. NC1054.2 +234400 PERFORM FAIL. NC1054.2 +234500 GO TO MOVE-WRITE-F1-91. NC1054.2 +234600 MOVE-DELETE-F1-91. NC1054.2 +234700 PERFORM DE-LETE. NC1054.2 +234800 MOVE-WRITE-F1-91. NC1054.2 +234900 MOVE "MOVE-TEST-F1-91" TO PAR-NAME. NC1054.2 +235000 PERFORM PRINT-DETAIL. NC1054.2 +235100 MOVE-INIT-F1-92. NC1054.2 +235200 MOVE +60666 TO SPOS-LIT1. NC1054.2 +235300 MOVE-TEST-F1-92-0. NC1054.2 +235400 MOVE SPOS-LIT1 TO ALPHA-LIT. NC1054.2 +235500 MOVE-TEST-F1-92-1. NC1054.2 +235600 IF ALPHA-LIT EQUAL TO "60666" NC1054.2 +235700 PERFORM PASS NC1054.2 +235800 GO TO MOVE-WRITE-F1-92. NC1054.2 +235900 MOVE ALPHA-LIT TO COMPUTED-A. NC1054.2 +236000 MOVE "60666" TO CORRECT-A. NC1054.2 +236100 MOVE "SIGN SHOULD NOT BE MOVED" TO RE-MARK. NC1054.2 +236200 PERFORM FAIL. NC1054.2 +236300 GO TO MOVE-WRITE-F1-92. NC1054.2 +236400 MOVE-DELETE-F1-92. NC1054.2 +236500 PERFORM DE-LETE. NC1054.2 +236600 MOVE-WRITE-F1-92. NC1054.2 +236700 MOVE "MOVE-TEST-F1-92" TO PAR-NAME. NC1054.2 +236800 PERFORM PRINT-DETAIL. NC1054.2 +236900 MOVE-INIT-F1-93. NC1054.2 +237000 MOVE -70717 TO SNEG-LIT1. NC1054.2 +237100 MOVE-TEST-F1-93-0. NC1054.2 +237200 MOVE SNEG-LIT1 TO ALPHA-LIT. NC1054.2 +237300 MOVE-TEST-F1-93-1. NC1054.2 +237400 IF ALPHA-LIT EQUAL TO "70717" NC1054.2 +237500 PERFORM PASS NC1054.2 +237600 GO TO MOVE-WRITE-F1-93. NC1054.2 +237700 MOVE ALPHA-LIT TO COMPUTED-A. NC1054.2 +237800 MOVE "70717" TO CORRECT-A. NC1054.2 +237900 MOVE "SIGN SHOULD NOT BE MOVED" TO RE-MARK. NC1054.2 +238000 PERFORM FAIL. NC1054.2 +238100 GO TO MOVE-WRITE-F1-93. NC1054.2 +238200 MOVE-DELETE-F1-93. NC1054.2 +238300 PERFORM DE-LETE. NC1054.2 +238400 MOVE-WRITE-F1-93. NC1054.2 +238500 MOVE "MOVE-TEST-F1-93" TO PAR-NAME. NC1054.2 +238600 PERFORM PRINT-DETAIL. NC1054.2 +238700 MOVE-INIT-F1-94. NC1054.2 +238800 MOVE "JUSTIFIED MOVES " TO FEATURE. NC1054.2 +238900 MOVE 99 TO GRP-NUMERIC-99. NC1054.2 +239000 MOVE-TEST-F1-94-0. NC1054.2 +239100 MOVE GRP-NUMERIC-99 TO RECEIVE-1 RECEIVE-4 RECEIVE-5 NC1054.2 +239200 RECEIVE-6. NC1054.2 +239300 MOVE-TEST-F1-94-1. NC1054.2 +239400 IF RECEIVE-1 EQUAL TO "99 " NC1054.2 +239500 PERFORM PASS NC1054.2 +239600 GO TO MOVE-WRITE-F1-94. NC1054.2 +239700 MOVE RECEIVE-1 TO COMPUTED-A. NC1054.2 +239800 MOVE "99 " TO CORRECT-A. NC1054.2 +239900 PERFORM FAIL. NC1054.2 +240000 GO TO MOVE-WRITE-F1-94. NC1054.2 +240100 MOVE-DELETE-F1-94. NC1054.2 +240200 PERFORM DE-LETE. NC1054.2 +240300 MOVE-WRITE-F1-94. NC1054.2 +240400 MOVE "MOVE-TEST-F1-94" TO PAR-NAME. NC1054.2 +240500 PERFORM PRINT-DETAIL. NC1054.2 +240600 MOVE-TEST-F1-95. NC1054.2 +240700 IF RECEIVE-4 EQUAL TO 99.00 NC1054.2 +240800 PERFORM PASS NC1054.2 +240900 GO TO MOVE-WRITE-F1-95. NC1054.2 +241000 MOVE 99.00 TO CORRECT-N. NC1054.2 +241100 MOVE RECEIVE-4 TO COMPUTED-N. NC1054.2 +241200 PERFORM FAIL. NC1054.2 +241300 GO TO MOVE-WRITE-F1-95. NC1054.2 +241400 MOVE-DELETE-F1-95. NC1054.2 +241500 PERFORM DE-LETE. NC1054.2 +241600 MOVE-WRITE-F1-95. NC1054.2 +241700 MOVE "MOVE-TEST-F1-95" TO PAR-NAME. NC1054.2 +241800 PERFORM PRINT-DETAIL. NC1054.2 +241900 MOVE-TEST-F1-96. NC1054.2 +242000 IF RECEIVE-5 EQUAL TO "99 " NC1054.2 +242100 PERFORM PASS NC1054.2 +242200 GO TO MOVE-WRITE-F1-96. NC1054.2 +242300 MOVE RECEIVE-5 TO COMPUTED-A. NC1054.2 +242400 MOVE "99 " TO CORRECT-A. NC1054.2 +242500 PERFORM FAIL. NC1054.2 +242600 GO TO MOVE-WRITE-F1-96. NC1054.2 +242700 MOVE-DELETE-F1-96. NC1054.2 +242800 PERFORM DE-LETE. NC1054.2 +242900 MOVE-WRITE-F1-96. NC1054.2 +243000 MOVE "MOVE-TEST-F1-96" TO PAR-NAME. NC1054.2 +243100 PERFORM PRINT-DETAIL. NC1054.2 +243200 MOVE-TEST-F1-97. NC1054.2 +243300 IF RECEIVE-6 EQUAL TO "99 " NC1054.2 +243400 PERFORM PASS NC1054.2 +243500 GO TO MOVE-WRITE-F1-97. NC1054.2 +243600 MOVE RECEIVE-6 TO COMPUTED-A. NC1054.2 +243700 MOVE "99 " TO CORRECT-A. NC1054.2 +243800 PERFORM FAIL. NC1054.2 +243900 GO TO MOVE-WRITE-F1-97. NC1054.2 +244000 MOVE-DELETE-F1-97. NC1054.2 +244100 PERFORM DE-LETE. NC1054.2 +244200 MOVE-WRITE-F1-97. NC1054.2 +244300 MOVE "MOVE-TEST-F1-97" TO PAR-NAME. NC1054.2 +244400 PERFORM PRINT-DETAIL. NC1054.2 +244500 MOVE-INIT-F1-98. NC1054.2 +244600 MOVE "MOVE (COMP/DISPLAY)" TO FEATURE. NC1054.2 +244700 MOVE 798 TO WRK-CS-18V00. NC1054.2 +244800 MOVE-TEST-F1-98-0. NC1054.2 +244900 MOVE WRK-CS-18V00 TO WRK-DS-18V00. NC1054.2 +245000 MOVE-TEST-F1-98-1. NC1054.2 +245100 IF WRK-DS-18V00 EQUAL TO WRK-CS-18V00 NC1054.2 +245200 PERFORM PASS NC1054.2 +245300 GO TO MOVE-WRITE-F1-98. NC1054.2 +245400 MOVE WRK-CS-18V00 TO CORRECT-18V0. NC1054.2 +245500 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1054.2 +245600 PERFORM FAIL. NC1054.2 +245700 MOVE "FIELDS COMPARED UNEQUAL" TO RE-MARK. NC1054.2 +245800 GO TO MOVE-WRITE-F1-98. NC1054.2 +245900 MOVE-DELETE-F1-98. NC1054.2 +246000 PERFORM DE-LETE. NC1054.2 +246100 MOVE-WRITE-F1-98. NC1054.2 +246200 MOVE "MOVE-TEST-F1-98" TO PAR-NAME. NC1054.2 +246300 PERFORM PRINT-DETAIL. NC1054.2 +246400 MOVE-INIT-F1-99. NC1054.2 +246500 MOVE 798 TO WRK-CS-18V00. NC1054.2 +246600 MOVE-TEST-F1-99-0. NC1054.2 +246700 MOVE WRK-CS-18V00 TO WRK-DS-10V00. NC1054.2 +246800 MOVE-TEST-F1-99-1. NC1054.2 +246900 IF WRK-DS-10V00 EQUAL TO WRK-CS-18V00 NC1054.2 +247000 PERFORM PASS NC1054.2 +247100 GO TO MOVE-WRITE-F1-99. NC1054.2 +247200 MOVE WRK-DS-10V00 TO CORRECT-18V0. NC1054.2 +247300 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1054.2 +247400 PERFORM FAIL. NC1054.2 +247500 GO TO MOVE-WRITE-F1-99. NC1054.2 +247600 MOVE-DELETE-F1-99. NC1054.2 +247700 PERFORM DE-LETE. NC1054.2 +247800 MOVE-WRITE-F1-99. NC1054.2 +247900 MOVE "MOVE-TEST-F1-99" TO PAR-NAME. NC1054.2 +248000 PERFORM PRINT-DETAIL. NC1054.2 +248100 MOVE-INIT-F1-100. NC1054.2 +248200 MOVE 7 TO WRK-DS-18V00. NC1054.2 +248300 MOVE-TEST-F1-100-0. NC1054.2 +248400 MOVE WRK-DS-18V00 TO WRK-CS-01V00. NC1054.2 +248500 MOVE-TEST-F1-100-1. NC1054.2 +248600 IF WRK-CS-01V00 EQUAL TO WRK-DS-18V00 NC1054.2 +248700 PERFORM PASS NC1054.2 +248800 GO TO MOVE-WRITE-F1-100. NC1054.2 +248900 MOVE WRK-DS-18V00 TO COMPUTED-18V0 NC1054.2 +249000 MOVE WRK-CS-01V00 TO CORRECT-18V0. NC1054.2 +249100 PERFORM FAIL. NC1054.2 +249200 GO TO MOVE-WRITE-F1-100. NC1054.2 +249300 MOVE-DELETE-F1-100. NC1054.2 +249400 PERFORM DE-LETE. NC1054.2 +249500 MOVE-WRITE-F1-100. NC1054.2 +249600 MOVE "MOVE-TEST-F1-100" TO PAR-NAME. NC1054.2 +249700 PERFORM PRINT-DETAIL. NC1054.2 +249800 MOVE-INIT-F1-101. NC1054.2 +249900 MOVE 0123456789 TO WRK-DS-10V00. NC1054.2 +250000 MOVE-TEST-F1-101-0. NC1054.2 +250100 MOVE WRK-DS-10V00 TO WRK-CS-18V00. NC1054.2 +250200 MOVE-TEST-F1-101-1. NC1054.2 +250300 IF WRK-DS-10V00 EQUAL TO WRK-CS-18V00 NC1054.2 +250400 PERFORM PASS NC1054.2 +250500 GO TO MOVE-WRITE-F1-101. NC1054.2 +250600 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1054.2 +250700 MOVE WRK-CS-18V00 TO CORRECT-18V0. NC1054.2 +250800 MOVE "FIELDS COMPARED UNEQUAL" TO RE-MARK. NC1054.2 +250900 PERFORM FAIL. NC1054.2 +251000 GO TO MOVE-WRITE-F1-101. NC1054.2 +251100 MOVE-DELETE-F1-101. NC1054.2 +251200 PERFORM DE-LETE. NC1054.2 +251300 MOVE-WRITE-F1-101. NC1054.2 +251400 MOVE "MOVE-TEST-F1-101" TO PAR-NAME. NC1054.2 +251500 PERFORM PRINT-DETAIL. NC1054.2 +251600 MOVE-INIT-F1-102. NC1054.2 +251700 MOVE 3 TO WRK-CS-18V00. NC1054.2 +251800 MOVE-TEST-F1-102-0. NC1054.2 +251900 MOVE WRK-CS-18V00 TO WRK-DS-01V00. NC1054.2 +252000 MOVE-TEST-F1-102-1. NC1054.2 +252100 IF WRK-CS-18V00 EQUAL TO WRK-DS-01V00 NC1054.2 +252200 PERFORM PASS NC1054.2 +252300 GO TO MOVE-WRITE-F1-102. NC1054.2 +252400 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1054.2 +252500 MOVE WRK-DS-01V00 TO CORRECT-18V0. NC1054.2 +252600 MOVE "FIELDS COMPARED UNEQUAL" TO RE-MARK. NC1054.2 +252700 PERFORM FAIL. NC1054.2 +252800 GO TO MOVE-WRITE-F1-102. NC1054.2 +252900 MOVE-DELETE-F1-102. NC1054.2 +253000 PERFORM DE-LETE. NC1054.2 +253100 MOVE-WRITE-F1-102. NC1054.2 +253200 MOVE "MOVE-TEST-F1-102" TO PAR-NAME. NC1054.2 +253300 PERFORM PRINT-DETAIL. NC1054.2 +253400 MOVE-INIT-F1-103. NC1054.2 +253500 MOVE 832.553 TO WRK-CS-08V08. NC1054.2 +253600 MOVE-TEST-F1-103-0. NC1054.2 +253700 MOVE WRK-CS-08V08 TO WRK-EDIT-Z3VZ3. NC1054.2 +253800 MOVE-TEST-F1-103-1. NC1054.2 +253900 IF WRK-EDIT-Z3VZ3 EQUAL TO "832.553" NC1054.2 +254000 PERFORM PASS NC1054.2 +254100 GO TO MOVE-WRITE-F1-103. NC1054.2 +254200 MOVE "832.553" TO CORRECT-A. NC1054.2 +254300 MOVE WRK-EDIT-Z3VZ3 TO COMPUTED-A. NC1054.2 +254400 PERFORM FAIL. NC1054.2 +254500 GO TO MOVE-WRITE-F1-103. NC1054.2 +254600 MOVE-DELETE-F1-103. NC1054.2 +254700 PERFORM DE-LETE. NC1054.2 +254800 MOVE-WRITE-F1-103. NC1054.2 +254900 MOVE "MOVE-TEST-F1-103" TO PAR-NAME. NC1054.2 +255000 PERFORM PRINT-DETAIL. NC1054.2 +255100 MOVE-INIT-F1-104. NC1054.2 +255200 MOVE 6382.47 TO WRK-CS-08V08. NC1054.2 +255300 MOVE-TEST-F1-104-0. NC1054.2 +255400 MOVE WRK-CS-04V08 TO WRK-EDIT-05V02. NC1054.2 +255500 MOVE-TEST-F1-104-1. NC1054.2 +255600 IF WRK-EDIT-05V02 EQUAL TO " 06382.47" NC1054.2 +255700 PERFORM PASS NC1054.2 +255800 GO TO MOVE-WRITE-F1-104. NC1054.2 +255900 MOVE " 06382.47" TO CORRECT-A. NC1054.2 +256000 MOVE WRK-EDIT-05V02 TO COMPUTED-A. NC1054.2 +256100 PERFORM FAIL. NC1054.2 +256200 GO TO MOVE-WRITE-F1-104. NC1054.2 +256300 MOVE-DELETE-F1-104. NC1054.2 +256400 PERFORM DE-LETE. NC1054.2 +256500 MOVE-WRITE-F1-104. NC1054.2 +256600 MOVE "MOVE-TEST-F1-104" TO PAR-NAME. NC1054.2 +256700 PERFORM PRINT-DETAIL. NC1054.2 +256800 MOVE-INIT-F1-105. NC1054.2 +256900 MOVE 832.553 TO WRK-CS-08V08. NC1054.2 +257000 MOVE-TEST-F1-105-0. NC1054.2 +257100 MOVE WRK-CS-08V08 TO WRK-EDIT-05V00. NC1054.2 +257200 MOVE-TEST-F1-105-1. NC1054.2 +257300 IF WRK-EDIT-05V00 EQUAL TO "**832" NC1054.2 +257400 PERFORM PASS NC1054.2 +257500 GO TO MOVE-WRITE-F1-105. NC1054.2 +257600 MOVE "**832" TO CORRECT-A. NC1054.2 +257700 MOVE WRK-EDIT-05V00 TO COMPUTED-A. NC1054.2 +257800 PERFORM FAIL. NC1054.2 +257900 GO TO MOVE-WRITE-F1-105. NC1054.2 +258000 MOVE-DELETE-F1-105. NC1054.2 +258100 PERFORM DE-LETE. NC1054.2 +258200 MOVE-WRITE-F1-105. NC1054.2 +258300 MOVE "MOVE-TEST-F1-105" TO PAR-NAME. NC1054.2 +258400 PERFORM PRINT-DETAIL. NC1054.2 +258500 MOVE-INIT-F1-106. NC1054.2 +258600 MOVE 6382.47 TO WRK-CS-04V08. NC1054.2 +258700 MOVE-TEST-F1-106-0. NC1054.2 +258800 MOVE WRK-CS-04V08 TO WRK-EDIT-05V02. NC1054.2 +258900 MOVE-TEST-F1-106-1. NC1054.2 +259000 IF WRK-EDIT-05V02 EQUAL TO " 06382.47" NC1054.2 +259100 PERFORM PASS NC1054.2 +259200 GO TO MOVE-WRITE-F1-106. NC1054.2 +259300 MOVE WRK-EDIT-05V02 TO COMPUTED-A. NC1054.2 +259400 MOVE " 06382.47" TO CORRECT-A. NC1054.2 +259500 PERFORM FAIL. NC1054.2 +259600 GO TO MOVE-WRITE-F1-106. NC1054.2 +259700 MOVE-DELETE-F1-106. NC1054.2 +259800 PERFORM DE-LETE. NC1054.2 +259900 MOVE-WRITE-F1-106. NC1054.2 +260000 MOVE "MOVE-TEST-F1-106" TO PAR-NAME. NC1054.2 +260100 PERFORM PRINT-DETAIL. NC1054.2 +260200 MOVE-INIT-F1-107. NC1054.2 +260300 MOVE ZERO TO WRK-CS-18V00. NC1054.2 +260400 MOVE-TEST-F1-107-0. NC1054.2 +260500 MOVE WRK-CS-18V00 TO WRK-EDIT-18V00. NC1054.2 +260600 MOVE-TEST-F1-107-1. NC1054.2 +260700 IF WRK-EDIT-18V00 EQUAL TO " 0" NC1054.2 +260800 PERFORM PASS NC1054.2 +260900 GO TO MOVE-WRITE-F1-107. NC1054.2 +261000 MOVE " 0" TO CORRECT-A. NC1054.2 +261100 MOVE WRK-EDIT-18V00 TO COMPUTED-A. NC1054.2 +261200 PERFORM FAIL. NC1054.2 +261300 GO TO MOVE-WRITE-F1-107. NC1054.2 +261400 MOVE-DELETE-F1-107. NC1054.2 +261500 PERFORM DE-LETE. NC1054.2 +261600 MOVE-WRITE-F1-107. NC1054.2 +261700 MOVE "MOVE-TEST-F1-107" TO PAR-NAME. NC1054.2 +261800 PERFORM PRINT-DETAIL. NC1054.2 +261900 MOVE-INIT-F1-108. NC1054.2 +262000 MOVE "MOVE (DISPLAY/COMP)" TO FEATURE. NC1054.2 +262100 MOVE 15 TO WRK-DS-10V00. NC1054.2 +262200 MOVE-TEST-F1-108-0. NC1054.2 +262300 MOVE WRK-DS-10V00 TO WRK-CS-01V00. NC1054.2 +262400 MOVE-TEST-F1-108-1. NC1054.2 +262500 IF WRK-CS-01V00 EQUAL TO 5 NC1054.2 +262600 PERFORM PASS NC1054.2 +262700 GO TO MOVE-WRITE-F1-108. NC1054.2 +262800 MOVE 5 TO CORRECT-N. NC1054.2 +262900 MOVE WRK-CS-01V00 TO COMPUTED-N. NC1054.2 +263000 PERFORM FAIL. NC1054.2 +263100 GO TO MOVE-WRITE-F1-108. NC1054.2 +263200 MOVE-DELETE-F1-108. NC1054.2 +263300 PERFORM DE-LETE. NC1054.2 +263400 MOVE-WRITE-F1-108. NC1054.2 +263500 MOVE "MOVE-TEST-F1-108" TO PAR-NAME. NC1054.2 +263600 PERFORM PRINT-DETAIL. NC1054.2 +263700 MOVE-INIT-F1-109. NC1054.2 +263800 MOVE 1023 TO WRK-DS-10V00. NC1054.2 +263900 MOVE-TEST-F1-109-0. NC1054.2 +264000 MOVE WRK-DS-10V00 TO WRK-CS-03V00. NC1054.2 +264100 MOVE-TEST-F1-109-1. NC1054.2 +264200 IF WRK-CS-03V00 EQUAL TO 023 NC1054.2 +264300 PERFORM PASS NC1054.2 +264400 GO TO MOVE-WRITE-F1-109. NC1054.2 +264500 MOVE WRK-CS-03V00 TO COMPUTED-N. NC1054.2 +264600 MOVE 023 TO CORRECT-N. NC1054.2 +264700 PERFORM FAIL. NC1054.2 +264800 GO TO MOVE-WRITE-F1-109. NC1054.2 +264900 MOVE-DELETE-F1-109. NC1054.2 +265000 PERFORM DE-LETE. NC1054.2 +265100 MOVE-WRITE-F1-109. NC1054.2 +265200 MOVE "MOVE-TEST-F1-109" TO PAR-NAME. NC1054.2 +265300 PERFORM PRINT-DETAIL. NC1054.2 +265400 MOVE-INIT-F1-110. NC1054.2 +265500 MOVE SPACE TO MOVE71. NC1054.2 +265600 MOVE-TEST-F1-110-0. NC1054.2 +265700 MOVE 00000 TO MOVE71. NC1054.2 +265800 MOVE-TEST-F1-110-1. NC1054.2 +265900 IF MOVE71 EQUAL TO "00000 " NC1054.2 +266000 PERFORM PASS GO TO MOVE-WRITE-F1-110. NC1054.2 +266100 GO TO MOVE-FAIL-F1-110. NC1054.2 +266200 MOVE-DELETE-F1-110. NC1054.2 +266300 PERFORM DE-LETE. NC1054.2 +266400 GO TO MOVE-WRITE-F1-110. NC1054.2 +266500 MOVE-FAIL-F1-110. NC1054.2 +266600 PERFORM FAIL. NC1054.2 +266700 MOVE MOVE71 TO COMPUTED-A. NC1054.2 +266800 MOVE "00000 " TO CORRECT-A. NC1054.2 +266900 MOVE-WRITE-F1-110. NC1054.2 +267000 MOVE "MOVE NUMERIC" TO FEATURE. NC1054.2 +267100 MOVE "MOVE-TEST-F1-110" TO PAR-NAME. NC1054.2 +267200 PERFORM PRINT-DETAIL. NC1054.2 +267300 MOVE-INIT-F1-111. NC1054.2 +267400 MOVE 234565432.1 TO MOVE74. NC1054.2 +267500 MOVE-TEST-F1-111-0. NC1054.2 +267600 MOVE MOVE74 TO MOVE75. NC1054.2 +267700 MOVE-TEST-F1-111. NC1054.2 +267800 IF MOVE75 EQUAL TO 234565432 NC1054.2 +267900 PERFORM PASS GO TO MOVE-WRITE-F1-111. NC1054.2 +268000 GO TO MOVE-FAIL-F1-111. NC1054.2 +268100 MOVE-DELETE-F1-111. NC1054.2 +268200 PERFORM DE-LETE. NC1054.2 +268300 GO TO MOVE-WRITE-F1-111. NC1054.2 +268400 MOVE-FAIL-F1-111. NC1054.2 +268500 MOVE MOVE75 TO COMPUTED-N. NC1054.2 +268600 MOVE 234565432 TO CORRECT-N. NC1054.2 +268700 PERFORM FAIL. NC1054.2 +268800 MOVE-WRITE-F1-111. NC1054.2 +268900 MOVE "MOVE -- COMP, SYNC" TO FEATURE. NC1054.2 +269000 MOVE "MOVE-TEST-F1-111" TO PAR-NAME. NC1054.2 +269100 PERFORM PRINT-DETAIL. NC1054.2 +269200 MOVE-INIT-F1-112. NC1054.2 +269300 MOVE "MOVE TO COMP (ABS)" TO FEATURE. NC1054.2 +269400 MOVE +60666 TO SPOS-LIT1. NC1054.2 +269500 MOVE-TEST-F1-112-0. NC1054.2 +269600 MOVE SPOS-LIT1 TO CU-05V00-001. NC1054.2 +269700 MOVE-TEST-F1-112-1. NC1054.2 +269800 IF CU-05V00-001 EQUAL TO 60666 NC1054.2 +269900 PERFORM PASS NC1054.2 +270000 GO TO MOVE-WRITE-F1-112. NC1054.2 +270100 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +270200 MOVE 60666 TO CORRECT-18V0. NC1054.2 +270300 PERFORM FAIL. NC1054.2 +270400 GO TO MOVE-WRITE-F1-112. NC1054.2 +270500 MOVE-DELETE-F1-112. NC1054.2 +270600 PERFORM DE-LETE. NC1054.2 +270700 MOVE-WRITE-F1-112. NC1054.2 +270800 MOVE "MOVE-TEST-F1-112" TO PAR-NAME. NC1054.2 +270900 PERFORM PRINT-DETAIL. NC1054.2 +271000 MOVE-INIT-F1-113. NC1054.2 +271100 MOVE +60667 TO SPOS-LIT2. NC1054.2 +271200 MOVE-TEST-F1-113-0. NC1054.2 +271300 MOVE SPOS-LIT2 TO CU-05V00-001. NC1054.2 +271400 MOVE-TEST-F1-113-1. NC1054.2 +271500 IF CU-05V00-001 EQUAL TO 60667 NC1054.2 +271600 PERFORM PASS NC1054.2 +271700 GO TO MOVE-WRITE-F1-113. NC1054.2 +271800 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +271900 MOVE 60667 TO CORRECT-18V0. NC1054.2 +272000 PERFORM FAIL. NC1054.2 +272100 GO TO MOVE-WRITE-F1-113. NC1054.2 +272200 MOVE-DELETE-F1-113. NC1054.2 +272300 PERFORM DE-LETE. NC1054.2 +272400 MOVE-WRITE-F1-113. NC1054.2 +272500 MOVE "MOVE-TEST-F1-113" TO PAR-NAME. NC1054.2 +272600 PERFORM PRINT-DETAIL. NC1054.2 +272700 MOVE-TEST-F1-114. NC1054.2 +272800 MOVE SNEG-LIT1 TO CU-05V00-001. NC1054.2 +272900 IF CU-05V00-001 EQUAL TO 70717 NC1054.2 +273000 PERFORM PASS NC1054.2 +273100 GO TO MOVE-WRITE-F1-114. NC1054.2 +273200 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +273300 MOVE 70717 TO CORRECT-18V0. NC1054.2 +273400 PERFORM FAIL. NC1054.2 +273500 GO TO MOVE-WRITE-F1-114. NC1054.2 +273600 MOVE-DELETE-F1-114. NC1054.2 +273700 PERFORM DE-LETE. NC1054.2 +273800 MOVE-WRITE-F1-114. NC1054.2 +273900 MOVE "MOVE-TEST-F1-114" TO PAR-NAME. NC1054.2 +274000 PERFORM PRINT-DETAIL. NC1054.2 +274100 MOVE-INIT-F1-115. NC1054.2 +274200 MOVE -70718 TO SNEG-LIT2. NC1054.2 +274300 MOVE-TEST-F1-115-0. NC1054.2 +274400 MOVE SNEG-LIT2 TO CU-05V00-001. NC1054.2 +274500 MOVE-TEST-F1-115. NC1054.2 +274600 IF CU-05V00-001 EQUAL TO 70718 NC1054.2 +274700 PERFORM PASS NC1054.2 +274800 GO TO MOVE-WRITE-F1-115. NC1054.2 +274900 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +275000 MOVE 70718 TO CORRECT-18V0. NC1054.2 +275100 PERFORM FAIL. NC1054.2 +275200 GO TO MOVE-WRITE-F1-115. NC1054.2 +275300 MOVE-DELETE-F1-115. NC1054.2 +275400 PERFORM DE-LETE. NC1054.2 +275500 MOVE-WRITE-F1-115. NC1054.2 +275600 MOVE "MOVE-TEST-F1-115" TO PAR-NAME. NC1054.2 +275700 PERFORM PRINT-DETAIL. NC1054.2 +275800 MOVE-INIT-F1-116. NC1054.2 +275900 MOVE +60666 TO SPOS-LIT1. NC1054.2 +276000 MOVE-TEST-F1-116-0. NC1054.2 +276100 MOVE SPOS-LIT1 TO CS-05V00-001. NC1054.2 +276200 MOVE-TEST-F1-116-1. NC1054.2 +276300 MOVE CS-05V00-001 TO CU-05V00-001. NC1054.2 +276400 IF CU-05V00-001 EQUAL TO 60666 NC1054.2 +276500 PERFORM PASS NC1054.2 +276600 GO TO MOVE-WRITE-F1-116. NC1054.2 +276700 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +276800 MOVE 60666 TO CORRECT-18V0. NC1054.2 +276900 PERFORM FAIL. NC1054.2 +277000 GO TO MOVE-WRITE-F1-116. NC1054.2 +277100 MOVE-DELETE-F1-116. NC1054.2 +277200 PERFORM DE-LETE. NC1054.2 +277300 MOVE-WRITE-F1-116. NC1054.2 +277400 MOVE "MOVE-TEST-F1-116" TO PAR-NAME. NC1054.2 +277500 PERFORM PRINT-DETAIL. NC1054.2 +277600 MOVE-INIT-F1-117. NC1054.2 +277700 MOVE +60667 TO SPOS-LIT2. NC1054.2 +277800 MOVE-TEST-F1-117-0. NC1054.2 +277900 MOVE SPOS-LIT2 TO CS-05V00-001. NC1054.2 +278000 MOVE CS-05V00-001 TO CU-05V00-001. NC1054.2 +278100 MOVE-TEST-F1-117-1. NC1054.2 +278200 IF CU-05V00-001 EQUAL TO 60667 NC1054.2 +278300 PERFORM PASS NC1054.2 +278400 GO TO MOVE-WRITE-F1-117. NC1054.2 +278500 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +278600 MOVE 60667 TO CORRECT-18V0. NC1054.2 +278700 PERFORM FAIL. NC1054.2 +278800 GO TO MOVE-WRITE-F1-117. NC1054.2 +278900 MOVE-DELETE-F1-117. NC1054.2 +279000 PERFORM DE-LETE. NC1054.2 +279100 MOVE-WRITE-F1-117. NC1054.2 +279200 MOVE "MOVE-TEST-F1-117" TO PAR-NAME. NC1054.2 +279300 PERFORM PRINT-DETAIL. NC1054.2 +279400 MOVE-INIT-F1-118. NC1054.2 +279500 MOVE -70717 TO SNEG-LIT1. NC1054.2 +279600 MOVE-TEST-F1-118-0. NC1054.2 +279700 MOVE SNEG-LIT1 TO CS-05V00-001. NC1054.2 +279800 MOVE CS-05V00-001 TO CU-05V00-001. NC1054.2 +279900 MOVE-TEST-F1-118-1. NC1054.2 +280000 IF CU-05V00-001 EQUAL TO 70717 NC1054.2 +280100 PERFORM PASS NC1054.2 +280200 GO TO MOVE-WRITE-F1-118. NC1054.2 +280300 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +280400 MOVE 70717 TO CORRECT-18V0. NC1054.2 +280500 PERFORM FAIL. NC1054.2 +280600 GO TO MOVE-WRITE-F1-118. NC1054.2 +280700 MOVE-DELETE-F1-118. NC1054.2 +280800 PERFORM DE-LETE. NC1054.2 +280900 MOVE-WRITE-F1-118. NC1054.2 +281000 MOVE "MOVE-TEST-F1-118" TO PAR-NAME. NC1054.2 +281100 PERFORM PRINT-DETAIL. NC1054.2 +281200 MOVE-INIT-F1-119. NC1054.2 +281300 MOVE -70718 TO SNEG-LIT2. NC1054.2 +281400 MOVE-TEST-F1-119-0. NC1054.2 +281500 MOVE SNEG-LIT2 TO CS-05V00-001. NC1054.2 +281600 MOVE CS-05V00-001 TO CU-05V00-001. NC1054.2 +281700 MOVE-TEST-F1-119-1. NC1054.2 +281800 IF CU-05V00-001 EQUAL TO 70718 NC1054.2 +281900 PERFORM PASS NC1054.2 +282000 GO TO MOVE-WRITE-F1-119. NC1054.2 +282100 MOVE CU-05V00-001 TO COMPUTED-18V0. NC1054.2 +282200 MOVE 70718 TO CORRECT-18V0. NC1054.2 +282300 PERFORM FAIL. NC1054.2 +282400 GO TO MOVE-WRITE-F1-119. NC1054.2 +282500 MOVE-DELETE-F1-119. NC1054.2 +282600 PERFORM DE-LETE. NC1054.2 +282700 MOVE-WRITE-F1-119. NC1054.2 +282800 MOVE "MOVE-TEST-F1-119" TO PAR-NAME. NC1054.2 +282900 PERFORM PRINT-DETAIL. NC1054.2 +283000* NC1054.2 +283100* MOVE-TEST-176 THROUGH MOVE-TEST-178 CONTAIN MOVE NC1054.2 +283200* STATEMENTS OF THE FORM NC1054.2 +283300* MOVE ALL LITERAL TO NUMERIC DATA ITEM. NC1054.2 +283400* NC1054.2 +283500* REFERENCES IN X3.23-1974 NC1054.2 +283600* PAGE I-85, 5.3.2.2.2.3(1) NC1054.2 +283700* PAGE II-76, 5.15.4(4)B.3 NC1054.2 +283800* NC1054.2 +283900*MOVE-TEST-176. NC1054.2 +284000* MOVE ZERO TO MOVE5. NC1054.2 +284100* MOVE ALL "123" TO MOVE5. NC1054.2 +284200* IF MOVE5 EQUAL TO 12 NC1054.2 +284300* PERFORM PASS NC1054.2 +284400* GO TO MOVE-WRITE-176 NC1054.2 +284500* ELSE GO TO MOVE-FAIL-176. NC1054.2 +284600 MOVE-DELETE-176. NC1054.2 +284700 PERFORM DE-LETE. NC1054.2 +284800 GO TO MOVE-WRITE-176. NC1054.2 +284900 MOVE-FAIL-176. NC1054.2 +285000 PERFORM FAIL. NC1054.2 +285100 MOVE 12 TO CORRECT-N. NC1054.2 +285200 MOVE MOVE5 TO COMPUTED-N. NC1054.2 +285300 MOVE-WRITE-176. NC1054.2 +285400 MOVE "*DELETED BY FCCTS*" TO FEATURE. NC1054.2 +285500 MOVE "MOVE-TEST-176" TO PAR-NAME. NC1054.2 +285600 PERFORM PRINT-DETAIL. NC1054.2 +285700*MOVE-TEST-177. NC1054.2 +285800* MOVE ZERO TO MOVE5. NC1054.2 +285900* MOVE ALL "ABC123" TO MOVE5. NC1054.2 +286000* IF MOVE5 EQUAL TO 23 NC1054.2 +286100* PERFORM PASS NC1054.2 +286200* GO TO MOVE-WRITE-177 NC1054.2 +286300* ELSE GO TO MOVE-FAIL-177. NC1054.2 +286400 MOVE-DELETE-177. NC1054.2 +286500 PERFORM DE-LETE. NC1054.2 +286600 GO TO MOVE-WRITE-177. NC1054.2 +286700 MOVE-FAIL-177. NC1054.2 +286800 PERFORM FAIL. NC1054.2 +286900 MOVE 23 TO CORRECT-N. NC1054.2 +287000 MOVE MOVE5 TO COMPUTED-N. NC1054.2 +287100 MOVE-WRITE-177. NC1054.2 +287200 MOVE "*DELETED BY FCCTS*" TO FEATURE. NC1054.2 +287300 MOVE "MOVE-TEST-177" TO PAR-NAME. NC1054.2 +287400 PERFORM PRINT-DETAIL. NC1054.2 +287500*MOVE-TEST-178. NC1054.2 +287600* MOVE ZERO TO MOVE7. NC1054.2 +287700* MOVE ALL "2A" TO MOVE7. NC1054.2 +287800* IF MOVE7 EQUAL TO 2 NC1054.2 +287900* PERFORM PASS NC1054.2 +288000* GO TO MOVE-WRITE-178 NC1054.2 +288100* ELSE GO TO MOVE-FAIL-178. NC1054.2 +288200 MOVE-DELETE-178. NC1054.2 +288300 PERFORM DE-LETE. NC1054.2 +288400 GO TO MOVE-WRITE-178. NC1054.2 +288500 MOVE-FAIL-178. NC1054.2 +288600 PERFORM FAIL. NC1054.2 +288700 MOVE 2 TO CORRECT-N. NC1054.2 +288800 MOVE MOVE7 TO COMPUTED-N. NC1054.2 +288900 MOVE-WRITE-178. NC1054.2 +289000 MOVE "*DELETED BY FCCTS*" TO FEATURE. NC1054.2 +289100 MOVE "MOVE-TEST-178" TO PAR-NAME. NC1054.2 +289200 PERFORM PRINT-DETAIL. NC1054.2 +289300 MOVE "EDIT--B(N), 0(N)" TO FEATURE. NC1054.2 +289400 EDIT-INIT-F1-120. NC1054.2 +289500 NC1054.2 +289600 EDIT-TEST-F1-120-0. NC1054.2 +289700 MOVE "926" TO EDIT-PICTURE-01. NC1054.2 +289800 EDIT-TEST-F1-120-1. NC1054.2 +289900 IF EDIT-PICTURE-01 EQUAL TO "9 26" NC1054.2 +290000 PERFORM PASS NC1054.2 +290100 GO TO EDIT-WRITE-F1-120. NC1054.2 +290200 PERFORM FAIL. NC1054.2 +290300 MOVE EDIT-PICTURE-01 TO COMPUTED-A. NC1054.2 +290400 MOVE "9 26" TO CORRECT-A. NC1054.2 +290500 GO TO EDIT-WRITE-F1-120. NC1054.2 +290600 EDIT-DELETE-F1-120. NC1054.2 +290700 PERFORM DE-LETE. NC1054.2 +290800 EDIT-WRITE-F1-120. NC1054.2 +290900 MOVE "EDIT-TEST-F1-120" TO PAR-NAME. NC1054.2 +291000 PERFORM PRINT-DETAIL. NC1054.2 +291100 EDIT-INIT-F1-121. NC1054.2 +291200 NC1054.2 +291300 EDIT-TEST-F1-121-0. NC1054.2 +291400 MOVE "1492" TO EDIT-PICTURE-02. NC1054.2 +291500 EDIT-TEST-F1-121-1. NC1054.2 +291600 IF EDIT-PICTURE-02 EQUAL TO "$0000000000492" NC1054.2 +291700 PERFORM PASS NC1054.2 +291800 GO TO EDIT-WRITE-F1-121. NC1054.2 +291900 PERFORM FAIL. NC1054.2 +292000 MOVE EDIT-PICTURE-02 TO COMPUTED-A. NC1054.2 +292100 MOVE "$0000000000492" TO CORRECT-A. NC1054.2 +292200 GO TO EDIT-WRITE-F1-121. NC1054.2 +292300 EDIT-DELETE-F1-121. NC1054.2 +292400 PERFORM DE-LETE. NC1054.2 +292500 EDIT-WRITE-F1-121. NC1054.2 +292600 MOVE "EDIT-TEST-F1-121" TO PAR-NAME. NC1054.2 +292700 PERFORM PRINT-DETAIL. NC1054.2 +292800 EDIT-INIT-F1-122. NC1054.2 +292900 MOVE 333 TO EDIT-DATA-1. NC1054.2 +293000 EDIT-TEST-F1-122-0. NC1054.2 +293100 MOVE EDIT-DATA-1 TO EDIT-PICTURE-01. NC1054.2 +293200 EDIT-TEST-F1-122-1. NC1054.2 +293300 IF EDIT-PICTURE-01 EQUAL TO "3 33" NC1054.2 +293400 PERFORM PASS NC1054.2 +293500 GO TO EDIT-WRITE-F1-122. NC1054.2 +293600 PERFORM FAIL. NC1054.2 +293700 MOVE EDIT-PICTURE-01 TO COMPUTED-A. NC1054.2 +293800 MOVE "3 33" TO CORRECT-A. NC1054.2 +293900 GO TO EDIT-WRITE-F1-122. NC1054.2 +294000 EDIT-DELETE-F1-122. NC1054.2 +294100 PERFORM DE-LETE. NC1054.2 +294200 EDIT-WRITE-F1-122. NC1054.2 +294300 MOVE "EDIT-TEST-F1-122" TO PAR-NAME. NC1054.2 +294400 PERFORM PRINT-DETAIL. NC1054.2 +294500 EDIT-INIT-F1-123. NC1054.2 +294600 MOVE 916 TO EDIT-DATA-2. NC1054.2 +294700 EDIT-TEST-F1-123-0. NC1054.2 +294800 MOVE EDIT-DATA-2 TO EDIT-PICTURE-02. NC1054.2 +294900 EDIT-TEST-F1-123-1. NC1054.2 +295000 IF EDIT-PICTURE-02 EQUAL TO "$0000000000916" NC1054.2 +295100 PERFORM PASS NC1054.2 +295200 GO TO EDIT-WRITE-F1-123. NC1054.2 +295300 PERFORM FAIL. NC1054.2 +295400 MOVE EDIT-PICTURE-02 TO COMPUTED-A. NC1054.2 +295500 MOVE "$0000000000916 " TO CORRECT-A. NC1054.2 +295600 GO TO EDIT-WRITE-F1-123. NC1054.2 +295700 EDIT-DELETE-F1-123. NC1054.2 +295800 PERFORM DE-LETE. NC1054.2 +295900 EDIT-WRITE-F1-123. NC1054.2 +296000 MOVE "EDIT-TEST-F1-123" TO PAR-NAME. NC1054.2 +296100 PERFORM PRINT-DETAIL. NC1054.2 +296200 EDIT-INIT-F1-124. NC1054.2 +296300 MOVE "EDIT -- MASKED EDIT" TO FEATURE. NC1054.2 +296400 EDIT-TEST-F1-124-0. NC1054.2 +296500 MOVE 000987.65 TO EDIT-PIC-05. NC1054.2 +296600 EDIT-TEST-F1-124-1. NC1054.2 +296700 IF GRP-EDIT-PIC-05 EQUAL TO " $987.65" NC1054.2 +296800 PERFORM PASS NC1054.2 +296900 GO TO EDIT-WRITE-F1-124. NC1054.2 +297000 PERFORM FAIL. NC1054.2 +297100 MOVE EDIT-PIC-05 TO COMPUTED-A. NC1054.2 +297200 MOVE " $987.65" TO CORRECT-A. NC1054.2 +297300 GO TO EDIT-WRITE-F1-124. NC1054.2 +297400 EDIT-DELETE-F1-124. NC1054.2 +297500 PERFORM DE-LETE. NC1054.2 +297600 EDIT-WRITE-F1-124. NC1054.2 +297700 MOVE "EDIT-TEST-F1-124" TO PAR-NAME. NC1054.2 +297800 PERFORM PRINT-DETAIL. NC1054.2 +297900 EDIT-INIT-F1-125. NC1054.2 +298000* NC1054.2 +298100 EDIT-TEST-F1-125-0. NC1054.2 +298200 MOVE 000123.45 TO EDIT-PIC-06. NC1054.2 +298300 EDIT-TEST-F1-125-1. NC1054.2 +298400 IF GRP-EDIT-PIC-06 EQUAL TO " $123.45" NC1054.2 +298500 PERFORM PASS NC1054.2 +298600 GO TO EDIT-WRITE-F1-125. NC1054.2 +298700 PERFORM FAIL. NC1054.2 +298800 MOVE EDIT-PIC-06 TO COMPUTED-A. NC1054.2 +298900 MOVE " $123.45" TO CORRECT-A. NC1054.2 +299000 GO TO EDIT-WRITE-F1-125. NC1054.2 +299100 EDIT-DELETE-F1-125. NC1054.2 +299200 PERFORM DE-LETE. NC1054.2 +299300 EDIT-WRITE-F1-125. NC1054.2 +299400 MOVE "EDIT-TEST-F1-125" TO PAR-NAME. NC1054.2 +299500 PERFORM PRINT-DETAIL. NC1054.2 +299600 EDIT-INIT-F1-126. NC1054.2 +299700* NC1054.2 +299800 EDIT-TEST-F1-126-0. NC1054.2 +299900 MOVE 000321.01 TO EDIT-PIC-07. NC1054.2 +300000 EDIT-TEST-F1-126-1. NC1054.2 +300100 IF GRP-EDIT-PIC-07 EQUAL TO " +321.01" NC1054.2 +300200 PERFORM PASS NC1054.2 +300300 GO TO EDIT-WRITE-F1-126. NC1054.2 +300400 PERFORM FAIL. NC1054.2 +300500 MOVE EDIT-PIC-07 TO COMPUTED-A. NC1054.2 +300600 MOVE " +321.01" TO CORRECT-A. NC1054.2 +300700 GO TO EDIT-WRITE-F1-126. NC1054.2 +300800 EDIT-DELETE-F1-126. NC1054.2 +300900 PERFORM DE-LETE. NC1054.2 +301000 EDIT-WRITE-F1-126. NC1054.2 +301100 MOVE "EDIT-TEST-F1-126" TO PAR-NAME. NC1054.2 +301200 PERFORM PRINT-DETAIL. NC1054.2 +301300 EDIT-INIT-F1-127. NC1054.2 +301400* NC1054.2 +301500 EDIT-TEST-F1-127-0. NC1054.2 +301600 MOVE -0012.98 TO EDIT-PIC-08. NC1054.2 +301700 EDIT-TEST-F1-127-1. NC1054.2 +301800 IF GRP-EDIT-PIC-08 EQUAL TO " -012.98" NC1054.2 +301900 PERFORM PASS NC1054.2 +302000 GO TO EDIT-WRITE-F1-127. NC1054.2 +302100 PERFORM FAIL. NC1054.2 +302200 MOVE EDIT-PIC-08 TO COMPUTED-A. NC1054.2 +302300 MOVE " -012.98" TO CORRECT-A. NC1054.2 +302400 GO TO EDIT-WRITE-F1-127. NC1054.2 +302500 EDIT-DELETE-F1-127. NC1054.2 +302600 PERFORM DE-LETE. NC1054.2 +302700 EDIT-WRITE-F1-127. NC1054.2 +302800 MOVE "EDIT-TEST-F1-127" TO PAR-NAME. NC1054.2 +302900 PERFORM PRINT-DETAIL. NC1054.2 +303000 EDIT-INIT-F1-128. NC1054.2 +303100* NC1054.2 +303200 EDIT-TEST-F1-128-0. NC1054.2 +303300 MOVE 0000567.43 TO EDIT-PIC-09. NC1054.2 +303400 EDIT-TEST-F1-128-1. NC1054.2 +303500 IF GRP-EDIT-PIC-09 EQUAL TO "****567.43" NC1054.2 +303600 PERFORM PASS NC1054.2 +303700 GO TO EDIT-WRITE-F1-128. NC1054.2 +303800 PERFORM FAIL. NC1054.2 +303900 MOVE EDIT-PIC-09 TO COMPUTED-A. NC1054.2 +304000 MOVE "****567.43" TO CORRECT-A. NC1054.2 +304100 GO TO EDIT-WRITE-F1-128. NC1054.2 +304200 EDIT-DELETE-F1-128. NC1054.2 +304300 PERFORM DE-LETE. NC1054.2 +304400 EDIT-WRITE-F1-128. NC1054.2 +304500 MOVE "EDIT-TEST-F1-128" TO PAR-NAME. NC1054.2 +304600 PERFORM PRINT-DETAIL. NC1054.2 +304700 EDIT-INIT-F1-129. NC1054.2 +304800* NC1054.2 +304900 EDIT-TEST-F1-129-0. NC1054.2 +305000 MOVE ZERO TO EDIT-PIC-10. NC1054.2 +305100 EDIT-TEST-F1-129-1. NC1054.2 +305200 IF GRP-EDIT-PIC-10 EQUAL TO " 000.00" NC1054.2 +305300 PERFORM PASS NC1054.2 +305400 GO TO EDIT-WRITE-F1-129. NC1054.2 +305500 PERFORM FAIL. NC1054.2 +305600 MOVE EDIT-PIC-10 TO COMPUTED-A. NC1054.2 +305700 MOVE " 000.00" TO CORRECT-A. NC1054.2 +305800 GO TO EDIT-WRITE-F1-129. NC1054.2 +305900 EDIT-DELETE-F1-129. NC1054.2 +306000 PERFORM DE-LETE. NC1054.2 +306100 EDIT-WRITE-F1-129. NC1054.2 +306200 MOVE "EDIT-TEST-F1-129" TO PAR-NAME. NC1054.2 +306300 PERFORM PRINT-DETAIL. NC1054.2 +306400 GO TO CCVS-EXIT. NC1054.2 +306500 A20. NC1054.2 +306600 MOVE FIRST-20S TO CORRECT-A. NC1054.2 +306700 MOVE FIRST-20R TO COMPUTED-A. NC1054.2 +306800 MOVE "1ST 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +306900 MOVE TEST-RESULTS TO PRINT-REC. NC1054.2 +307000 WRITE PRINT-REC AFTER ADVANCING 1 LINES. NC1054.2 +307100 SUBTRACT 20 FROM LENGTH-COUNTER. NC1054.2 +307200 A40. NC1054.2 +307300 MOVE SECOND-20S TO CORRECT-A. NC1054.2 +307400 MOVE SECOND-20R TO COMPUTED-A. NC1054.2 +307500 MOVE "2ND 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +307600 IF LENGTH-COUNTER GREATER THAN 20 NC1054.2 +307700 MOVE SPACE TO P-OR-F NC1054.2 +307800 MOVE TEST-RESULTS TO PRINT-REC NC1054.2 +307900 WRITE PRINT-REC AFTER ADVANCING 1 LINES NC1054.2 +308000 SUBTRACT 20 FROM LENGTH-COUNTER ELSE NC1054.2 +308100 MOVE 000 TO LENGTH-COUNTER. NC1054.2 +308200 A60. NC1054.2 +308300 MOVE THIRD-20S TO CORRECT-A. NC1054.2 +308400 MOVE THIRD-20R TO COMPUTED-A. NC1054.2 +308500 MOVE "3RD 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +308600 IF LENGTH-COUNTER GREATER THAN 20 NC1054.2 +308700 MOVE SPACE TO P-OR-F NC1054.2 +308800 MOVE TEST-RESULTS TO PRINT-REC NC1054.2 +308900 WRITE PRINT-REC AFTER ADVANCING 1 LINES NC1054.2 +309000 SUBTRACT 20 FROM LENGTH-COUNTER ELSE NC1054.2 +309100 MOVE 000 TO LENGTH-COUNTER. NC1054.2 +309200 A80. NC1054.2 +309300 MOVE FOURTH-20S TO CORRECT-A. NC1054.2 +309400 MOVE FOURTH-20R TO COMPUTED-A. NC1054.2 +309500 MOVE "4TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +309600 IF LENGTH-COUNTER GREATER THAN 20 NC1054.2 +309700 MOVE SPACE TO P-OR-F NC1054.2 +309800 MOVE TEST-RESULTS TO PRINT-REC NC1054.2 +309900 WRITE PRINT-REC AFTER ADVANCING 1 LINES NC1054.2 +310000 SUBTRACT 20 FROM LENGTH-COUNTER ELSE NC1054.2 +310100 MOVE 000 TO LENGTH-COUNTER. NC1054.2 +310200 A100. NC1054.2 +310300 MOVE FIFTH-20S TO CORRECT-A. NC1054.2 +310400 MOVE FIFTH-20R TO COMPUTED-A. NC1054.2 +310500 MOVE "5TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +310600 IF LENGTH-COUNTER GREATER THAN 20 NC1054.2 +310700 MOVE SPACE TO P-OR-F NC1054.2 +310800 MOVE TEST-RESULTS TO PRINT-REC NC1054.2 +310900 WRITE PRINT-REC AFTER ADVANCING 1 LINES. NC1054.2 +311000 MOVE 000 TO LENGTH-COUNTER. NC1054.2 +311100 A120. NC1054.2 +311200 MOVE SIXTH-20S TO CORRECT-A. NC1054.2 +311300 MOVE SIXTH-20R TO COMPUTED-A. NC1054.2 +311400 MOVE "6TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1054.2 +311500 CCVS-EXIT SECTION. NC1054.2 +311600 CCVS-999999. NC1054.2 +311700 GO TO CLOSE-FILES. NC1054.2 diff --git a/tests/cobol85/NC/NC106A.CBL b/tests/cobol85/NC/NC106A.CBL new file mode 100755 index 00000000..7f6663ae --- /dev/null +++ b/tests/cobol85/NC/NC106A.CBL @@ -0,0 +1,2533 @@ +000100 IDENTIFICATION DIVISION. NC1064.2 +000200 PROGRAM-ID. NC1064.2 +000300 NC106A. NC1064.2 +000400**************************************************************** NC1064.2 +000500* * NC1064.2 +000600* VALIDATION FOR:- * NC1064.2 +000700* * NC1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1064.2 +000900* * NC1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1064.2 +001100* * NC1064.2 +001200**************************************************************** NC1064.2 +001300* * NC1064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1064.2 +001500* * NC1064.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1064.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1064.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1064.2 +001900* * NC1064.2 +002000**************************************************************** NC1064.2 +002100* NC1064.2 +002200* PROGRAM NC106A TESTS FORMAT 1 OF THE SUBTRACT NC1064.2 +002300* STATEMENT. VARIOUS COMBINATINS OF DATA-ITEMS AND ALL NC1064.2 +002400* OPTIONAL PHRASES ARE TESTED. NC1064.2 +002500* NC1064.2 +002600 NC1064.2 +002700 ENVIRONMENT DIVISION. NC1064.2 +002800 CONFIGURATION SECTION. NC1064.2 +002900 SOURCE-COMPUTER. NC1064.2 +003000 Linux. NC1064.2 +003100 OBJECT-COMPUTER. NC1064.2 +003200 Linux. NC1064.2 +003300 INPUT-OUTPUT SECTION. NC1064.2 +003400 FILE-CONTROL. NC1064.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1064.2 +003600 "report.log". NC1064.2 +003700 DATA DIVISION. NC1064.2 +003800 FILE SECTION. NC1064.2 +003900 FD PRINT-FILE. NC1064.2 +004000 01 PRINT-REC PICTURE X(120). NC1064.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1064.2 +004200 WORKING-STORAGE SECTION. NC1064.2 +004300 01 WRK-NE-X-1 PIC 9(16).99. NC1064.2 +004400 01 WRK-NE-X-2 PIC -9(16).99. NC1064.2 +004500 01 WRK-XN-00001 PIC X. NC1064.2 +004600 01 WRK-XN-18-1 PIC X(18). NC1064.2 +004700 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1064.2 +004800 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1064.2 +004900 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1064.2 +005000 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1064.2 +005100 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1064.2 +005200 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1064.2 +005300 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1064.2 +005400 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1064.2 +005500 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1064.2 +005600 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1064.2 +005700 01 WRK-DU-1V5-1 PIC 9V9(5). NC1064.2 +005800 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1064.2 +005900 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1064.2 +006000 01 WRK-DU-2V0-1 PIC 99. NC1064.2 +006100 01 WRK-DU-2V0-2 PIC 99. NC1064.2 +006200 01 WRK-DU-2V0-3 PIC 99. NC1064.2 +006300 01 WRK-DU-2V1-1 PIC 99V9. NC1064.2 +006400 01 WRK-DU-2V1-2 PIC 99V9. NC1064.2 +006500 01 WRK-DU-2V1-3 PIC 99V9. NC1064.2 +006600 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1064.2 +006700 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1064.2 +006800 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1064.2 +006900 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1064.2 +007000 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1064.2 +007100 01 WRK-DU-2V5-1 PIC 99V9(5). NC1064.2 +007200 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1064.2 +007300 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1064.2 +007400 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1064.2 +007500 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1064.2 +007600 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1064.2 +007700 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1064.2 +007800 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1064.2 +007900 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1064.2 +008000 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1064.2 +008100 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1064.2 +008200 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1064.2 +008300 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1064.2 +008400 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1064.2 +008500 01 42-DATANAMES. NC1064.2 +008600 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC1064.2 +008700 02 DNAME2 PICTURE 99 VALUE 1 COMPUTATIONAL. NC1064.2 +008800 02 DNAME3 PICTURE 999 VALUE 1 COMPUTATIONAL. NC1064.2 +008900 02 DNAME4 PICTURE 9(4) VALUE 1 COMPUTATIONAL. NC1064.2 +009000 02 DNAME5 PICTURE 9(5) VALUE 1 COMPUTATIONAL. NC1064.2 +009100 02 DNAME6 PICTURE 9(6) VALUE 1 COMPUTATIONAL. NC1064.2 +009200 02 DNAME7 PICTURE 9(7) VALUE 1 COMPUTATIONAL. NC1064.2 +009300 02 DNAME8 PICTURE 9(8) VALUE 1 COMPUTATIONAL. NC1064.2 +009400 02 DNAME9 PICTURE 9(9) VALUE 1 COMPUTATIONAL. NC1064.2 +009500 02 DNAME10 PICTURE 9(10) VALUE 1. NC1064.2 +009600 02 DNAME11 PICTURE 9(11) VALUE 1. NC1064.2 +009700 02 DNAME12 PICTURE 9(12) VALUE 1. NC1064.2 +009800 02 DNAME13 PICTURE 9(13) VALUE 1. NC1064.2 +009900 02 DNAME14 PICTURE 9(14) VALUE 1. NC1064.2 +010000 02 DNAME15 PICTURE 9(15) VALUE 1. NC1064.2 +010100 02 DNAME16 PICTURE 9(16) VALUE 1. NC1064.2 +010200 02 DNAME17 PICTURE 9(17) VALUE 1. NC1064.2 +010300 02 DNAME18 PICTURE 9(18) VALUE 1. NC1064.2 +010400 02 DNAME19 PICTURE 9 VALUE 1. NC1064.2 +010500 02 DNAME20 PICTURE 99 VALUE 1. NC1064.2 +010600 02 DNAME21 PICTURE 999 VALUE 1. NC1064.2 +010700 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC1064.2 +010800 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC1064.2 +010900 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC1064.2 +011000 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC1064.2 +011100 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC1064.2 +011200 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC1064.2 +011300 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC1064.2 +011400 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC1064.2 +011500 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +011600 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +011700 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +011800 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +011900 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012000 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012100 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012200 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012300 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012400 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012500 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012600 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012700 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +012800 77 SIZE-ERR PICTURE X VALUE SPACE. NC1064.2 +012900 77 SIZE-ERR2 PICTURE X VALUE SPACE. NC1064.2 +013000 77 SIZE-ERR3 PICTURE X VALUE SPACE. NC1064.2 +013100 77 SIZE-ERR4 PICTURE X VALUE SPACE. NC1064.2 +013200 77 A18TWOS-DS-18V00 PICTURE S9(18) NC1064.2 +013300 VALUE 222222222222222222. NC1064.2 +013400 77 A18ONES-DS-18V00 PICTURE S9(18) NC1064.2 +013500 VALUE 111111111111111111. NC1064.2 +013600 77 WRK-DS-10V00 PICTURE S9(10). NC1064.2 +013700 77 A10ONES-DS-10V00 PICTURE S9(10) NC1064.2 +013800 VALUE 1111111111. NC1064.2 +013900 77 A05ONES-DS-05V00 PICTURE S9(5) NC1064.2 +014000 VALUE 11111. NC1064.2 +014100 77 A02ONES-DS-02V00 PICTURE S99 NC1064.2 +014200 VALUE 11. NC1064.2 +014300 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1064.2 +014400 77 WRK-DS-18V00 REDEFINES WRK-DS-09V09 NC1064.2 +014500 PICTURE S9(18). NC1064.2 +014600 77 A06THREES-DS-03V03 PICTURE S999V999 NC1064.2 +014700 VALUE 333.333. NC1064.2 +014800 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1064.2 +014900 VALUE 333333.333333. NC1064.2 +015000 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1064.2 +015100 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC1064.2 +015200 PICTURE S9(12). NC1064.2 +015300 77 A05ONES-DS-00V05 PICTURE SV9(5) NC1064.2 +015400 VALUE .11111. NC1064.2 +015500 77 WRK-DS-05V00 PICTURE S9(5). NC1064.2 +015600 77 WRK-DS-02V00 PICTURE S99. NC1064.2 +015700 77 A12ONES-DS-12V00 PICTURE S9(12) NC1064.2 +015800 VALUE 111111111111. NC1064.2 +015900 77 WRK-DS-03V10 PICTURE S999V9(10). NC1064.2 +016000 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1064.2 +016100 PICTURE S9(13). NC1064.2 +016200 77 A99-DS-02V00 PICTURE S99 NC1064.2 +016300 VALUE 99. NC1064.2 +016400 77 A03ONES-DS-02V01 PICTURE S99V9 NC1064.2 +016500 VALUE 11.1. NC1064.2 +016600 77 A06ONES-DS-03V03 PICTURE S999V999 NC1064.2 +016700 VALUE 111.111. NC1064.2 +016800 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1064.2 +016900 VALUE 22.222222. NC1064.2 +017000 77 A01ONE-DS-P0801 PICTURE SP(8)9 NC1064.2 +017100 VALUE .000000001. NC1064.2 +017200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1064.2 +017300 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1064.2 +017400 VALUE 111111111111111111. NC1064.2 +017500 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1064.2 +017600 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1064.2 +017700 VALUE 99. NC1064.2 +017800 77 WRK-DS-0201P PICTURE S99P. NC1064.2 +017900 77 WRK-DS-06V00 PICTURE S9(6). NC1064.2 +018000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) NC1064.2 +018100 VALUE ZERO. NC1064.2 +018200 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1064.2 +018300 VALUE +012345678.876543210. NC1064.2 +018400 77 XDATA-XN-00018 PICTURE X(18) NC1064.2 +018500 VALUE "00ABCDEFGHI 4321 ". NC1064.2 +018600 77 WRK-XN-00018 PICTURE X(18). NC1064.2 +018700 77 ADD-12 PICTURE PP9 VALUE .001. NC1064.2 +018800 77 ADD-13 PICTURE 9PP VALUE 100. NC1064.2 +018900 77 ADD-14 PICTURE 999V999. NC1064.2 +019000 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1064.2 +019100 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1064.2 +019200 COMPUTATIONAL. NC1064.2 +019300 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1064.2 +019400 COMPUTATIONAL. NC1064.2 +019500 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1064.2 +019600 COMPUTATIONAL. NC1064.2 +019700 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1064.2 +019800 COMPUTATIONAL. NC1064.2 +019900 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1064.2 +020000 COMPUTATIONAL. NC1064.2 +020100 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1064.2 +020200 COMPUTATIONAL. NC1064.2 +020300 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1064.2 +020400 COMPUTATIONAL. NC1064.2 +020500 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1064.2 +020600 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1064.2 +020700 COMPUTATIONAL. NC1064.2 +020800 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1064.2 +020900 01 SUBTRACT-DATA. NC1064.2 +021000 02 SUBTR-1 PICTURE 9 VALUE 1. NC1064.2 +021100 02 SUBTR-2 PICTURE S99 VALUE 99. NC1064.2 +021200 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1064.2 +021300 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1064.2 +021400 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1064.2 +021500 02 SUBTR-6 PICTURE 9 VALUE 1. NC1064.2 +021600 02 SUBTR-7 PICTURE S99 VALUE 99. NC1064.2 +021700 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1064.2 +021800 02 SUBTR-10 PICTURE S999 VALUE 100. NC1064.2 +021900 02 SUBTR-11 PICTURE S999V999. NC1064.2 +022000 01 N-3 PICTURE IS 99999. NC1064.2 +022100 01 N-4 PICTURE IS 9(5) NC1064.2 +022200 VALUE IS 52800. NC1064.2 +022300 01 N-5 PICTURE IS S9(9)V99 NC1064.2 +022400 VALUE IS 000000001.00. NC1064.2 +022500 01 N-7 PICTURE IS S9(7)V9(4) NC1064.2 +022600 VALUE IS 0000001.0000. NC1064.2 +022700 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1064.2 +022800 01 N-10 PICTURE IS S99999V NC1064.2 +022900 VALUE IS -00001. NC1064.2 +023000 01 N-11 PICTURE IS 9 VALUE IS 9. NC1064.2 +023100 01 N-12 PICTURE IS 9 VALUE IS 9. NC1064.2 +023200 01 N-13 PICTURE IS 9(5) NC1064.2 +023300 VALUE IS 99999. NC1064.2 +023400 01 N-14 PICTURE IS 9 VALUE IS 1. NC1064.2 +023500 01 N-15 PICTURE IS 9(16). NC1064.2 +023600 01 N-16 PICTURE IS S999999V99 NC1064.2 +023700 VALUE IS 5.90. NC1064.2 +023800 01 N-17 PICTURE IS S9(3)V99 NC1064.2 +023900 VALUE IS +3.6. NC1064.2 +024000 01 N-18 PICTURE IS S9(10) NC1064.2 +024100 VALUE IS -5. NC1064.2 +024200 01 N-19 PICTURE IS $9.00. NC1064.2 +024300 01 N-20 PICTURE IS S9(9) NC1064.2 +024400 VALUE IS -999999999. NC1064.2 +024500 01 N-21 PICTURE IS 9 VALUE IS 5. NC1064.2 +024600 01 N-22 PICTURE IS 999V99 NC1064.2 +024700 VALUE IS 005.55. NC1064.2 +024800 01 N-23 PICTURE IS $$$.99CR. NC1064.2 +024900 01 N-25 PICTURE IS 9 VALUE IS 1. NC1064.2 +025000 01 N-26 PICTURE 9(5). NC1064.2 +025100 01 N-27 PICTURE IS 9999V9 NC1064.2 +025200 VALUE IS 9999.9. NC1064.2 +025300 01 N-28 PICTURE IS $9999.00. NC1064.2 +025400 01 N-40 PICTURE IS 9(7) NC1064.2 +025500 VALUE IS 7777777. NC1064.2 +025600 01 N-41 PICTURE IS 9(7) NC1064.2 +025700 VALUE IS 1111111. NC1064.2 +025800 01 N-42 PICTURE IS 9(3)P(4). NC1064.2 +025900 01 TRUNC-DATA. NC1064.2 +026000 02 N-43 PICTURE S9V9 VALUE +1.6. NC1064.2 +026100 02 N-44 PICTURE S9V9 VALUE -1.6. NC1064.2 +026200 02 N-45 PICTURE S9. NC1064.2 +026300 01 MINUS-NAMES. NC1064.2 +026400 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1064.2 +026500 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1064.2 +026600 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1064.2 +026700 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1064.2 +026800 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1064.2 +026900 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1064.2 +027000 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1064.2 +027100 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1064.2 +027200 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1064.2 +027300 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1064.2 +027400 02 WHOLE-FIELD PICTURE S9(18). NC1064.2 +027500 02 DECMAL-FIELD PICTURE SV9(18). NC1064.2 +027600 01 TEST-RESULTS. NC1064.2 +027700 02 FILLER PIC X VALUE SPACE. NC1064.2 +027800 02 FEATURE PIC X(20) VALUE SPACE. NC1064.2 +027900 02 FILLER PIC X VALUE SPACE. NC1064.2 +028000 02 P-OR-F PIC X(5) VALUE SPACE. NC1064.2 +028100 02 FILLER PIC X VALUE SPACE. NC1064.2 +028200 02 PAR-NAME. NC1064.2 +028300 03 FILLER PIC X(19) VALUE SPACE. NC1064.2 +028400 03 PARDOT-X PIC X VALUE SPACE. NC1064.2 +028500 03 DOTVALUE PIC 99 VALUE ZERO. NC1064.2 +028600 02 FILLER PIC X(8) VALUE SPACE. NC1064.2 +028700 02 RE-MARK PIC X(61). NC1064.2 +028800 01 TEST-COMPUTED. NC1064.2 +028900 02 FILLER PIC X(30) VALUE SPACE. NC1064.2 +029000 02 FILLER PIC X(17) VALUE NC1064.2 +029100 " COMPUTED=". NC1064.2 +029200 02 COMPUTED-X. NC1064.2 +029300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1064.2 +029400 03 COMPUTED-N REDEFINES COMPUTED-A NC1064.2 +029500 PIC -9(9).9(9). NC1064.2 +029600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1064.2 +029700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1064.2 +029800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1064.2 +029900 03 CM-18V0 REDEFINES COMPUTED-A. NC1064.2 +030000 04 COMPUTED-18V0 PIC -9(18). NC1064.2 +030100 04 FILLER PIC X. NC1064.2 +030200 03 FILLER PIC X(50) VALUE SPACE. NC1064.2 +030300 01 TEST-CORRECT. NC1064.2 +030400 02 FILLER PIC X(30) VALUE SPACE. NC1064.2 +030500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1064.2 +030600 02 CORRECT-X. NC1064.2 +030700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1064.2 +030800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1064.2 +030900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1064.2 +031000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1064.2 +031100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1064.2 +031200 03 CR-18V0 REDEFINES CORRECT-A. NC1064.2 +031300 04 CORRECT-18V0 PIC -9(18). NC1064.2 +031400 04 FILLER PIC X. NC1064.2 +031500 03 FILLER PIC X(2) VALUE SPACE. NC1064.2 +031600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1064.2 +031700 01 CCVS-C-1. NC1064.2 +031800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1064.2 +031900- "SS PARAGRAPH-NAME NC1064.2 +032000- " REMARKS". NC1064.2 +032100 02 FILLER PIC X(20) VALUE SPACE. NC1064.2 +032200 01 CCVS-C-2. NC1064.2 +032300 02 FILLER PIC X VALUE SPACE. NC1064.2 +032400 02 FILLER PIC X(6) VALUE "TESTED". NC1064.2 +032500 02 FILLER PIC X(15) VALUE SPACE. NC1064.2 +032600 02 FILLER PIC X(4) VALUE "FAIL". NC1064.2 +032700 02 FILLER PIC X(94) VALUE SPACE. NC1064.2 +032800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1064.2 +032900 01 REC-CT PIC 99 VALUE ZERO. NC1064.2 +033000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1064.2 +033100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1064.2 +033200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1064.2 +033300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1064.2 +033400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1064.2 +033500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1064.2 +033600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1064.2 +033700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1064.2 +033800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1064.2 +033900 01 CCVS-H-1. NC1064.2 +034000 02 FILLER PIC X(39) VALUE SPACES. NC1064.2 +034100 02 FILLER PIC X(42) VALUE NC1064.2 +034200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1064.2 +034300 02 FILLER PIC X(39) VALUE SPACES. NC1064.2 +034400 01 CCVS-H-2A. NC1064.2 +034500 02 FILLER PIC X(40) VALUE SPACE. NC1064.2 +034600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1064.2 +034700 02 FILLER PIC XXXX VALUE NC1064.2 +034800 "4.2 ". NC1064.2 +034900 02 FILLER PIC X(28) VALUE NC1064.2 +035000 " COPY - NOT FOR DISTRIBUTION". NC1064.2 +035100 02 FILLER PIC X(41) VALUE SPACE. NC1064.2 +035200 NC1064.2 +035300 01 CCVS-H-2B. NC1064.2 +035400 02 FILLER PIC X(15) VALUE NC1064.2 +035500 "TEST RESULT OF ". NC1064.2 +035600 02 TEST-ID PIC X(9). NC1064.2 +035700 02 FILLER PIC X(4) VALUE NC1064.2 +035800 " IN ". NC1064.2 +035900 02 FILLER PIC X(12) VALUE NC1064.2 +036000 " HIGH ". NC1064.2 +036100 02 FILLER PIC X(22) VALUE NC1064.2 +036200 " LEVEL VALIDATION FOR ". NC1064.2 +036300 02 FILLER PIC X(58) VALUE NC1064.2 +036400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1064.2 +036500 01 CCVS-H-3. NC1064.2 +036600 02 FILLER PIC X(34) VALUE NC1064.2 +036700 " FOR OFFICIAL USE ONLY ". NC1064.2 +036800 02 FILLER PIC X(58) VALUE NC1064.2 +036900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1064.2 +037000 02 FILLER PIC X(28) VALUE NC1064.2 +037100 " COPYRIGHT 1985 ". NC1064.2 +037200 01 CCVS-E-1. NC1064.2 +037300 02 FILLER PIC X(52) VALUE SPACE. NC1064.2 +037400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1064.2 +037500 02 ID-AGAIN PIC X(9). NC1064.2 +037600 02 FILLER PIC X(45) VALUE SPACES. NC1064.2 +037700 01 CCVS-E-2. NC1064.2 +037800 02 FILLER PIC X(31) VALUE SPACE. NC1064.2 +037900 02 FILLER PIC X(21) VALUE SPACE. NC1064.2 +038000 02 CCVS-E-2-2. NC1064.2 +038100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1064.2 +038200 03 FILLER PIC X VALUE SPACE. NC1064.2 +038300 03 ENDER-DESC PIC X(44) VALUE NC1064.2 +038400 "ERRORS ENCOUNTERED". NC1064.2 +038500 01 CCVS-E-3. NC1064.2 +038600 02 FILLER PIC X(22) VALUE NC1064.2 +038700 " FOR OFFICIAL USE ONLY". NC1064.2 +038800 02 FILLER PIC X(12) VALUE SPACE. NC1064.2 +038900 02 FILLER PIC X(58) VALUE NC1064.2 +039000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1064.2 +039100 02 FILLER PIC X(13) VALUE SPACE. NC1064.2 +039200 02 FILLER PIC X(15) VALUE NC1064.2 +039300 " COPYRIGHT 1985". NC1064.2 +039400 01 CCVS-E-4. NC1064.2 +039500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1064.2 +039600 02 FILLER PIC X(4) VALUE " OF ". NC1064.2 +039700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1064.2 +039800 02 FILLER PIC X(40) VALUE NC1064.2 +039900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1064.2 +040000 01 XXINFO. NC1064.2 +040100 02 FILLER PIC X(19) VALUE NC1064.2 +040200 "*** INFORMATION ***". NC1064.2 +040300 02 INFO-TEXT. NC1064.2 +040400 04 FILLER PIC X(8) VALUE SPACE. NC1064.2 +040500 04 XXCOMPUTED PIC X(20). NC1064.2 +040600 04 FILLER PIC X(5) VALUE SPACE. NC1064.2 +040700 04 XXCORRECT PIC X(20). NC1064.2 +040800 02 INF-ANSI-REFERENCE PIC X(48). NC1064.2 +040900 01 HYPHEN-LINE. NC1064.2 +041000 02 FILLER PIC IS X VALUE IS SPACE. NC1064.2 +041100 02 FILLER PIC IS X(65) VALUE IS "************************NC1064.2 +041200- "*****************************************". NC1064.2 +041300 02 FILLER PIC IS X(54) VALUE IS "************************NC1064.2 +041400- "******************************". NC1064.2 +041500 01 CCVS-PGM-ID PIC X(9) VALUE NC1064.2 +041600 "NC106A". NC1064.2 +041700 PROCEDURE DIVISION. NC1064.2 +041800 CCVS1 SECTION. NC1064.2 +041900 OPEN-FILES. NC1064.2 +042000 OPEN OUTPUT PRINT-FILE. NC1064.2 +042100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1064.2 +042200 MOVE SPACE TO TEST-RESULTS. NC1064.2 +042300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1064.2 +042400 GO TO CCVS1-EXIT. NC1064.2 +042500 CLOSE-FILES. NC1064.2 +042600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1064.2 +042700 TERMINATE-CCVS. NC1064.2 +042800*S EXIT PROGRAM. NC1064.2 +042900*SERMINATE-CALL. NC1064.2 +043000 STOP RUN. NC1064.2 +043100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1064.2 +043200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1064.2 +043300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1064.2 +043400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1064.2 +043500 MOVE "****TEST DELETED****" TO RE-MARK. NC1064.2 +043600 PRINT-DETAIL. NC1064.2 +043700 IF REC-CT NOT EQUAL TO ZERO NC1064.2 +043800 MOVE "." TO PARDOT-X NC1064.2 +043900 MOVE REC-CT TO DOTVALUE. NC1064.2 +044000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1064.2 +044100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1064.2 +044200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1064.2 +044300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1064.2 +044400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1064.2 +044500 MOVE SPACE TO CORRECT-X. NC1064.2 +044600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1064.2 +044700 MOVE SPACE TO RE-MARK. NC1064.2 +044800 HEAD-ROUTINE. NC1064.2 +044900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +045000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +045100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1064.2 +045200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1064.2 +045300 COLUMN-NAMES-ROUTINE. NC1064.2 +045400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +045500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +045600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +045700 END-ROUTINE. NC1064.2 +045800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1064.2 +045900 END-RTN-EXIT. NC1064.2 +046000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +046100 END-ROUTINE-1. NC1064.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1064.2 +046300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1064.2 +046400 ADD PASS-COUNTER TO ERROR-HOLD. NC1064.2 +046500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1064.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1064.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1064.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1064.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1064.2 +047000 END-ROUTINE-12. NC1064.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1064.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1064.2 +047300 MOVE "NO " TO ERROR-TOTAL NC1064.2 +047400 ELSE NC1064.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1064.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1064.2 +047700 PERFORM WRITE-LINE. NC1064.2 +047800 END-ROUTINE-13. NC1064.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1064.2 +048000 MOVE "NO " TO ERROR-TOTAL ELSE NC1064.2 +048100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1064.2 +048200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1064.2 +048300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +048400 IF INSPECT-COUNTER EQUAL TO ZERO NC1064.2 +048500 MOVE "NO " TO ERROR-TOTAL NC1064.2 +048600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1064.2 +048700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1064.2 +048800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +048900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1064.2 +049000 WRITE-LINE. NC1064.2 +049100 ADD 1 TO RECORD-COUNT. NC1064.2 +049200 IF RECORD-COUNT GREATER 42 NC1064.2 +049300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1064.2 +049400 MOVE SPACE TO DUMMY-RECORD NC1064.2 +049500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1064.2 +049600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1064.2 +049700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1064.2 +049800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1064.2 +049900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1064.2 +050000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1064.2 +050100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1064.2 +050200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1064.2 +050300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1064.2 +050400 MOVE ZERO TO RECORD-COUNT. NC1064.2 +050500 PERFORM WRT-LN. NC1064.2 +050600 WRT-LN. NC1064.2 +050700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1064.2 +050800 MOVE SPACE TO DUMMY-RECORD. NC1064.2 +050900 BLANK-LINE-PRINT. NC1064.2 +051000 PERFORM WRT-LN. NC1064.2 +051100 FAIL-ROUTINE. NC1064.2 +051200 IF COMPUTED-X NOT EQUAL TO SPACE NC1064.2 +051300 GO TO FAIL-ROUTINE-WRITE. NC1064.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1064.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1064.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1064.2 +051700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +051800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1064.2 +051900 GO TO FAIL-ROUTINE-EX. NC1064.2 +052000 FAIL-ROUTINE-WRITE. NC1064.2 +052100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1064.2 +052200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1064.2 +052300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1064.2 +052400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1064.2 +052500 FAIL-ROUTINE-EX. EXIT. NC1064.2 +052600 BAIL-OUT. NC1064.2 +052700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1064.2 +052800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1064.2 +052900 BAIL-OUT-WRITE. NC1064.2 +053000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1064.2 +053100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1064.2 +053200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1064.2 +053300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1064.2 +053400 BAIL-OUT-EX. EXIT. NC1064.2 +053500 CCVS1-EXIT. NC1064.2 +053600 EXIT. NC1064.2 +053700 SECT-NC106A-001 SECTION. NC1064.2 +053800 SUB-INIT-F1-1. NC1064.2 +053900 MOVE "SUBTRACT" TO FEATURE. NC1064.2 +054000 MOVE "VI-134 6.25.4 GR1" TO ANSI-REFERENCE. NC1064.2 +054100 SUB-TEST-F1-1. NC1064.2 +054200 SUBTRACT 1 FROM N-5. NC1064.2 +054300 IF N-5 EQUAL TO 0 NC1064.2 +054400 PERFORM PASS NC1064.2 +054500 GO TO SUB-WRITE-F1-1. NC1064.2 +054600 GO TO SUB-FAIL-F1-1. NC1064.2 +054700 SUB-DELETE-F1-1. NC1064.2 +054800 PERFORM DE-LETE. NC1064.2 +054900 GO TO SUB-WRITE-F1-1. NC1064.2 +055000 SUB-FAIL-F1-1. NC1064.2 +055100 MOVE N-5 TO COMPUTED-N. NC1064.2 +055200 MOVE 0 TO CORRECT-N. NC1064.2 +055300 PERFORM FAIL. NC1064.2 +055400 SUB-WRITE-F1-1. NC1064.2 +055500 MOVE "SUB-TEST-F1-1 " TO PAR-NAME. NC1064.2 +055600 PERFORM PRINT-DETAIL. NC1064.2 +055700 SUB-TEST-F1-2. NC1064.2 +055800 SUBTRACT N-17 FROM N-18 ROUNDED. NC1064.2 +055900 IF N-18 EQUAL TO -9 NC1064.2 +056000 PERFORM PASS NC1064.2 +056100 GO TO SUB-WRITE-F1-2. NC1064.2 +056200 GO TO SUB-FAIL-F1-2. NC1064.2 +056300 SUB-DELETE-F1-2. NC1064.2 +056400 PERFORM DE-LETE. NC1064.2 +056500 GO TO SUB-WRITE-F1-2. NC1064.2 +056600 SUB-FAIL-F1-2. NC1064.2 +056700 MOVE N-18 TO COMPUTED-N. NC1064.2 +056800 MOVE -9 TO CORRECT-N. NC1064.2 +056900 PERFORM FAIL. NC1064.2 +057000 SUB-WRITE-F1-2. NC1064.2 +057100 MOVE "SUB-TEST-F1-2 " TO PAR-NAME. NC1064.2 +057200 PERFORM PRINT-DETAIL. NC1064.2 +057300 SUB-INIT-F1-3. NC1064.2 +057400 MOVE -00001 TO N-10. NC1064.2 +057500 MOVE 99999 TO N-13. NC1064.2 +057600 SUB-TEST-F1-3-0. NC1064.2 +057700 SUBTRACT N-10 FROM N-13 ON SIZE ERROR NC1064.2 +057800 PERFORM PASS NC1064.2 +057900 GO TO SUB-WRITE-F1-3-1. NC1064.2 +058000 GO TO SUB-FAIL-F1-3-1. NC1064.2 +058100 SUB-DELETE-F1-3-1. NC1064.2 +058200 PERFORM DE-LETE. NC1064.2 +058300 GO TO SUB-WRITE-F1-3-1. NC1064.2 +058400 SUB-FAIL-F1-3-1. NC1064.2 +058500 MOVE N-13 TO COMPUTED-N. NC1064.2 +058600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +058700 PERFORM FAIL. NC1064.2 +058800 SUB-WRITE-F1-3-1. NC1064.2 +058900 MOVE "SUB-TEST-F1-3-1 " TO PAR-NAME. NC1064.2 +059000 PERFORM PRINT-DETAIL. NC1064.2 +059100 SUB-TEST-F1-3-2. NC1064.2 +059200 IF N-13 = 99999 NC1064.2 +059300 PERFORM PASS NC1064.2 +059400 GO TO SUB-WRITE-F1-3-2. NC1064.2 +059500 GO TO SUB-FAIL-F1-3-2. NC1064.2 +059600 SUB-DELETE-F1-3-2. NC1064.2 +059700 PERFORM DE-LETE. NC1064.2 +059800 GO TO SUB-WRITE-F1-3-2. NC1064.2 +059900 SUB-FAIL-F1-3-2. NC1064.2 +060000 MOVE N-13 TO COMPUTED-N. NC1064.2 +060100 MOVE 99999 TO CORRECT-N. NC1064.2 +060200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +060300 PERFORM FAIL. NC1064.2 +060400 SUB-WRITE-F1-3-2. NC1064.2 +060500 MOVE "SUB-TEST-F1-3-2 " TO PAR-NAME. NC1064.2 +060600 PERFORM PRINT-DETAIL. NC1064.2 +060700 SUB-INIT-F1-4-1. NC1064.2 +060800 MOVE -999999999 TO N-20. NC1064.2 +060900 SUB-TEST-F1-4-1. NC1064.2 +061000 SUBTRACT .7 FROM N-20 ROUNDED ON SIZE ERROR NC1064.2 +061100 PERFORM PASS NC1064.2 +061200 GO TO SUB-WRITE-F1-4-1. NC1064.2 +061300 GO TO SUB-FAIL-F1-4-1. NC1064.2 +061400 SUB-DELETE-F1-4-1. NC1064.2 +061500 PERFORM DE-LETE. NC1064.2 +061600 GO TO SUB-WRITE-F1-4-1. NC1064.2 +061700 SUB-FAIL-F1-4-1. NC1064.2 +061800 MOVE N-20 TO COMPUTED-N. NC1064.2 +061900 MOVE -999999999 TO CORRECT-N. NC1064.2 +062000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +062100 PERFORM FAIL. NC1064.2 +062200 SUB-WRITE-F1-4-1. NC1064.2 +062300 MOVE "SUB-TEST-F1-4-1 " TO PAR-NAME. NC1064.2 +062400 PERFORM PRINT-DETAIL. NC1064.2 +062500 SUB-TEST-F1-4-2. NC1064.2 +062600 IF N-20 = -999999999 NC1064.2 +062700 PERFORM PASS NC1064.2 +062800 GO TO SUB-WRITE-F1-4-2. NC1064.2 +062900 GO TO SUB-FAIL-F1-4-2. NC1064.2 +063000 SUB-DELETE-F1-4-2. NC1064.2 +063100 PERFORM DE-LETE. NC1064.2 +063200 GO TO SUB-WRITE-F1-4-2. NC1064.2 +063300 SUB-FAIL-F1-4-2. NC1064.2 +063400 MOVE N-20 TO COMPUTED-N. NC1064.2 +063500 MOVE -999999999 TO CORRECT-N. NC1064.2 +063600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +063700 PERFORM FAIL. NC1064.2 +063800 SUB-WRITE-F1-4-2. NC1064.2 +063900 MOVE "SUB-TEST-F1-4-2 " TO PAR-NAME. NC1064.2 +064000 PERFORM PRINT-DETAIL. NC1064.2 +064100 SUB-INIT-F1-5. NC1064.2 +064200 MOVE "SUBTRACT ---" TO FEATURE. NC1064.2 +064300 PERFORM PRINT-DETAIL. NC1064.2 +064400 MOVE " FROM" TO FEATURE. NC1064.2 +064500 SUB-TEST-F1-5. NC1064.2 +064600 MOVE A18TWOS-DS-18V00 TO WRK-DS-18V00. NC1064.2 +064700 SUBTRACT A18ONES-DS-18V00 FROM WRK-DS-18V00. NC1064.2 +064800 IF WRK-DS-18V00 EQUAL TO 111111111111111111 NC1064.2 +064900 PERFORM PASS GO TO SUB-WRITE-F1-5. NC1064.2 +065000 GO TO SUB-FAIL-F1-5. NC1064.2 +065100 SUB-DELETE-F1-5. NC1064.2 +065200 PERFORM DE-LETE. NC1064.2 +065300 GO TO SUB-WRITE-F1-5. NC1064.2 +065400 SUB-FAIL-F1-5. NC1064.2 +065500 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1064.2 +065600 MOVE 111111111111111111 TO CORRECT-18V0. NC1064.2 +065700 PERFORM FAIL. NC1064.2 +065800 SUB-WRITE-F1-5. NC1064.2 +065900 MOVE "SUB-TEST-F1-5" TO PAR-NAME. NC1064.2 +066000 PERFORM PRINT-DETAIL. NC1064.2 +066100 SUB-TEST-F1-6. NC1064.2 +066200 MOVE A12THREES-DS-06V06 TO WRK-DS-06V06. NC1064.2 +066300 SUBTRACT A05ONES-DS-05V00 NC1064.2 +066400 A05ONES-DS-00V05 NC1064.2 +066500 A06ONES-DS-03V03 FROM WRK-DS-06V06. NC1064.2 +066600 IF WRK-DS-06V06 EQUAL TO 322111.111223 NC1064.2 +066700 PERFORM PASS GO TO SUB-WRITE-F1-6. NC1064.2 +066800 GO TO SUB-FAIL-F1-6. NC1064.2 +066900 SUB-DELETE-F1-6. NC1064.2 +067000 PERFORM DE-LETE. NC1064.2 +067100 GO TO SUB-WRITE-F1-6. NC1064.2 +067200 SUB-FAIL-F1-6. NC1064.2 +067300 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1064.2 +067400 MOVE 322111.111223 TO CORRECT-N. NC1064.2 +067500 PERFORM FAIL. NC1064.2 +067600 SUB-WRITE-F1-6. NC1064.2 +067700 MOVE "SUB-TEST-F1-6" TO PAR-NAME. NC1064.2 +067800 PERFORM PRINT-DETAIL. NC1064.2 +067900 SUB-INIT-F1-7. NC1064.2 +068000 MOVE " ROUNDED" TO FEATURE. NC1064.2 +068100 SUB-TEST-F1-7. NC1064.2 +068200 MOVE ZERO TO WRK-DS-0201P. NC1064.2 +068300 SUBTRACT A99-DS-02V00 FROM WRK-DS-0201P ROUNDED. NC1064.2 +068400 IF WRK-DS-0201P EQUAL TO -100 NC1064.2 +068500 PERFORM PASS GO TO SUB-WRITE-F1-7. NC1064.2 +068600 GO TO SUB-FAIL-F1-7. NC1064.2 +068700 SUB-DELETE-F1-7. NC1064.2 +068800 PERFORM DE-LETE. NC1064.2 +068900 GO TO SUB-WRITE-F1-7. NC1064.2 +069000 SUB-FAIL-F1-7. NC1064.2 +069100 MOVE WRK-DS-0201P TO COMPUTED-N. NC1064.2 +069200 MOVE -100 TO CORRECT-N. NC1064.2 +069300 PERFORM FAIL. NC1064.2 +069400 SUB-WRITE-F1-7. NC1064.2 +069500 MOVE "SUB-TEST-F1-7" TO PAR-NAME. NC1064.2 +069600 PERFORM PRINT-DETAIL. NC1064.2 +069700 SUB-INIT-F1-8-1. NC1064.2 +069800 MOVE " SIZE ERROR" TO FEATURE. NC1064.2 +069900 MOVE -11 TO WRK-DS-02V00. NC1064.2 +070000 SUB-TEST-F1-8-1. NC1064.2 +070100 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 ON SIZE ERROR NC1064.2 +070200 PERFORM PASS GO TO SUB-WRITE-F1-8-1. NC1064.2 +070300 GO TO SUB-FAIL-F1-8-1. NC1064.2 +070400 SUB-DELETE-F1-8-1. NC1064.2 +070500 PERFORM DE-LETE. NC1064.2 +070600 GO TO SUB-WRITE-F1-8-1. NC1064.2 +070700 SUB-FAIL-F1-8-1. NC1064.2 +070800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +070900 PERFORM FAIL. NC1064.2 +071000 SUB-WRITE-F1-8-1. NC1064.2 +071100 MOVE "SUB-TEST-F1-8-1" TO PAR-NAME. NC1064.2 +071200 PERFORM PRINT-DETAIL. NC1064.2 +071300 SUB-TEST-F1-8-2. NC1064.2 +071400 IF WRK-DS-02V00 EQUAL TO -11 NC1064.2 +071500 PERFORM PASS GO TO SUB-WRITE-F1-8-2. NC1064.2 +071600* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-8-1 NC1064.2 +071700 GO TO SUB-FAIL-F1-8-2. NC1064.2 +071800 SUB-DELETE-F1-8-2. NC1064.2 +071900 PERFORM DE-LETE. NC1064.2 +072000 GO TO SUB-WRITE-F1-8-2. NC1064.2 +072100 SUB-FAIL-F1-8-2. NC1064.2 +072200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +072300 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1064.2 +072400 MOVE -11 TO CORRECT-N. NC1064.2 +072500 PERFORM FAIL. NC1064.2 +072600 SUB-WRITE-F1-8-2. NC1064.2 +072700 MOVE "SUB-TEST-F1-8-2" TO PAR-NAME. NC1064.2 +072800 PERFORM PRINT-DETAIL. NC1064.2 +072900 SUB-INIT-F1-9-1. NC1064.2 +073000 MOVE " ROUNDED,SIZE ERROR" TO FEATURE. NC1064.2 +073100 SUB-TEST-F1-9-1. NC1064.2 +073200 MOVE ZERO TO WRK-DS-05V00. NC1064.2 +073300 SUBTRACT 33333 NC1064.2 +073400 A06THREES-DS-03V03 NC1064.2 +073500 A12THREES-DS-06V06 NC1064.2 +073600 FROM WRK-DS-05V00 ROUNDED ON SIZE ERROR NC1064.2 +073700 PERFORM PASS GO TO SUB-WRITE-F1-9-1. NC1064.2 +073800 GO TO SUB-FAIL-F1-9-1. NC1064.2 +073900 SUB-DELETE-F1-9-1. NC1064.2 +074000 PERFORM DE-LETE. NC1064.2 +074100 GO TO SUB-WRITE-F1-9-1. NC1064.2 +074200 SUB-FAIL-F1-9-1. NC1064.2 +074300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +074400 PERFORM FAIL. NC1064.2 +074500 SUB-WRITE-F1-9-1. NC1064.2 +074600 MOVE "SUB-TEST-F1-9-1" TO PAR-NAME. NC1064.2 +074700 PERFORM PRINT-DETAIL. NC1064.2 +074800 SUB-TEST-F1-9-2. NC1064.2 +074900 IF WRK-DS-05V00 EQUAL TO ZERO NC1064.2 +075000 PERFORM PASS GO TO SUB-WRITE-F1-9-2. NC1064.2 +075100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-9-1 NC1064.2 +075200 GO TO SUB-FAIL-F1-9-2. NC1064.2 +075300 SUB-DELETE-F1-9-2. NC1064.2 +075400 PERFORM DE-LETE. NC1064.2 +075500 GO TO SUB-WRITE-F1-9-2. NC1064.2 +075600 SUB-FAIL-F1-9-2. NC1064.2 +075700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +075800 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1064.2 +075900 MOVE ZERO TO CORRECT-N. NC1064.2 +076000 PERFORM FAIL. NC1064.2 +076100 SUB-WRITE-F1-9-2. NC1064.2 +076200 MOVE "SUB-TEST-F1-9-2" TO PAR-NAME. NC1064.2 +076300 PERFORM PRINT-DETAIL. NC1064.2 +076400 SUB-INIT-F1-10. NC1064.2 +076500 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +076600 SUB-TEST-F1-10-1. NC1064.2 +076700 SUBTRACT A12THREES-DS-06V06 NC1064.2 +076800 333333 NC1064.2 +076900 A06THREES-DS-03V03 NC1064.2 +077000 -0000009 NC1064.2 +077100 FROM WRK-DS-06V06 ROUNDED ON SIZE ERROR NC1064.2 +077200 GO TO SUB-FAIL-F1-10-1. NC1064.2 +077300 PERFORM PASS. NC1064.2 +077400 GO TO SUB-WRITE-F1-10-1. NC1064.2 +077500 SUB-DELETE-F1-10-1. NC1064.2 +077600 PERFORM DE-LETE. NC1064.2 +077700 GO TO SUB-WRITE-F1-10-1. NC1064.2 +077800 SUB-FAIL-F1-10-1. NC1064.2 +077900 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1064.2 +078000 PERFORM FAIL. NC1064.2 +078100 SUB-WRITE-F1-10-1. NC1064.2 +078200 MOVE "SUB-TEST-F1-10-1" TO PAR-NAME. NC1064.2 +078300 PERFORM PRINT-DETAIL. NC1064.2 +078400 SUB-TEST-F1-10-2. NC1064.2 +078500 IF WRK-DS-06V06 EQUAL TO -666990.666333 NC1064.2 +078600 PERFORM PASS GO TO SUB-WRITE-F1-10-2. NC1064.2 +078700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-10-1 NC1064.2 +078800 GO TO SUB-FAIL-F1-10-2. NC1064.2 +078900 SUB-DELETE-F1-10-2. NC1064.2 +079000 PERFORM DE-LETE. NC1064.2 +079100 GO TO SUB-WRITE-F1-10-2. NC1064.2 +079200 SUB-FAIL-F1-10-2. NC1064.2 +079300 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1064.2 +079400 MOVE -666990.666333 TO CORRECT-N. NC1064.2 +079500 PERFORM FAIL. NC1064.2 +079600 SUB-WRITE-F1-10-2. NC1064.2 +079700 MOVE "SUB-TEST-F1-10-2" TO PAR-NAME. NC1064.2 +079800 PERFORM PRINT-DETAIL. NC1064.2 +079900 SUB-INIT-F1-11. NC1064.2 +080000 MOVE " COMP VS. DISPLAY" TO FEATURE. NC1064.2 +080100 SUB-TEST-F1-11. NC1064.2 +080200 MOVE ZERO TO WRK-CS-18V00 NC1064.2 +080300 SUBTRACT A18ONES-DS-18V00 FROM WRK-CS-18V00. NC1064.2 +080400 IF WRK-CS-18V00 EQUAL TO -111111111111111111 NC1064.2 +080500 PERFORM PASS GO TO SUB-WRITE-F1-11. NC1064.2 +080600 GO TO SUB-FAIL-F1-11. NC1064.2 +080700 SUB-DELETE-F1-11. NC1064.2 +080800 PERFORM DE-LETE. NC1064.2 +080900 GO TO SUB-WRITE-F1-11. NC1064.2 +081000 SUB-FAIL-F1-11. NC1064.2 +081100 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1064.2 +081200 MOVE -111111111111111111 TO CORRECT-18V0. NC1064.2 +081300 PERFORM FAIL. NC1064.2 +081400 SUB-WRITE-F1-11. NC1064.2 +081500 MOVE "SUB-TEST-F1-11" TO PAR-NAME. NC1064.2 +081600 PERFORM PRINT-DETAIL. NC1064.2 +081700 SUB-TEST-F1-12. NC1064.2 +081800 MOVE ZERO TO WRK-DS-18V00. NC1064.2 +081900 SUBTRACT A18ONES-CS-18V00 FROM WRK-DS-18V00. NC1064.2 +082000 IF WRK-DS-18V00 EQUAL TO -111111111111111111 NC1064.2 +082100 PERFORM PASS GO TO SUB-WRITE-F1-12. NC1064.2 +082200 GO TO SUB-FAIL-F1-12. NC1064.2 +082300 SUB-DELETE-F1-12. NC1064.2 +082400 PERFORM DE-LETE. NC1064.2 +082500 GO TO SUB-WRITE-F1-12. NC1064.2 +082600 SUB-FAIL-F1-12. NC1064.2 +082700 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1064.2 +082800 MOVE -111111111111111111 TO CORRECT-18V0. NC1064.2 +082900 PERFORM FAIL. NC1064.2 +083000 SUB-WRITE-F1-12. NC1064.2 +083100 MOVE "SUB-TEST-F1-12" TO PAR-NAME. NC1064.2 +083200 PERFORM PRINT-DETAIL. NC1064.2 +083300 SUB-TEST-F1-13. NC1064.2 +083400 MOVE ZERO TO WRK-CS-02V02. NC1064.2 +083500 SUBTRACT A99-CS-02V00 FROM WRK-CS-02V02. NC1064.2 +083600 IF WRK-CS-02V02 EQUAL TO -99.00 NC1064.2 +083700 PERFORM PASS GO TO SUB-WRITE-F1-13. NC1064.2 +083800 GO TO SUB-FAIL-F1-13. NC1064.2 +083900 SUB-DELETE-F1-13. NC1064.2 +084000 PERFORM DE-LETE. NC1064.2 +084100 GO TO SUB-WRITE-F1-13. NC1064.2 +084200 SUB-FAIL-F1-13. NC1064.2 +084300 MOVE WRK-CS-02V02 TO COMPUTED-N. NC1064.2 +084400 MOVE -99.00 TO CORRECT-N. NC1064.2 +084500 PERFORM FAIL. NC1064.2 +084600 SUB-WRITE-F1-13. NC1064.2 +084700 MOVE "SUB-TEST-F1-13" TO PAR-NAME. NC1064.2 +084800 PERFORM PRINT-DETAIL. NC1064.2 +084900 SUB-TEST-F1-14-1. NC1064.2 +085000 MOVE A99-CS-02V00 TO WRK-CS-02V02. NC1064.2 +085100 SUBTRACT -99 FROM WRK-CS-02V02 ON SIZE ERROR NC1064.2 +085200 PERFORM PASS GO TO SUB-WRITE-F1-14-1. NC1064.2 +085300 GO TO SUB-FAIL-F1-14-1. NC1064.2 +085400 SUB-DELETE-F1-14-1. NC1064.2 +085500 PERFORM DE-LETE. NC1064.2 +085600 GO TO SUB-WRITE-F1-14-1. NC1064.2 +085700 SUB-FAIL-F1-14-1. NC1064.2 +085800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +085900 PERFORM FAIL. NC1064.2 +086000 SUB-WRITE-F1-14-1. NC1064.2 +086100 MOVE "SUB-TEST-F1-14-1" TO PAR-NAME. NC1064.2 +086200 PERFORM PRINT-DETAIL. NC1064.2 +086300 SUB-TEST-F1-14-2. NC1064.2 +086400 IF WRK-CS-02V02 EQUAL TO 99 NC1064.2 +086500 PERFORM PASS GO TO SUB-WRITE-F1-14-2. NC1064.2 +086600* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-14-1 NC1064.2 +086700 GO TO SUB-FAIL-F1-14-2. NC1064.2 +086800 SUB-DELETE-F1-14-2. NC1064.2 +086900 PERFORM DE-LETE. NC1064.2 +087000 GO TO SUB-WRITE-F1-14-2. NC1064.2 +087100 SUB-FAIL-F1-14-2. NC1064.2 +087200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +087300 MOVE WRK-CS-02V02 TO COMPUTED-N. NC1064.2 +087400 MOVE 99 TO CORRECT-N. NC1064.2 +087500 PERFORM FAIL. NC1064.2 +087600 SUB-WRITE-F1-14-2. NC1064.2 +087700 MOVE "SUB-TEST-F1-14-2" TO PAR-NAME. NC1064.2 +087800 PERFORM PRINT-DETAIL. NC1064.2 +087900 SUB-TEST-F1-15. NC1064.2 +088000 SUBTRACT SUBTR-1 SUBTR-3 FROM SUBTR-7. NC1064.2 +088100 IF SUBTR-7 EQUAL TO 99 NC1064.2 +088200 PERFORM PASS GO TO SUB-WRITE-F1-15. NC1064.2 +088300 GO TO SUB-FAIL-F1-15. NC1064.2 +088400 SUB-DELETE-F1-15. NC1064.2 +088500 PERFORM DE-LETE. NC1064.2 +088600 GO TO SUB-WRITE-F1-15. NC1064.2 +088700 SUB-FAIL-F1-15. NC1064.2 +088800 MOVE SUBTR-7 TO COMPUTED-N. NC1064.2 +088900 MOVE 99 TO CORRECT-N. NC1064.2 +089000 PERFORM FAIL. NC1064.2 +089100 SUB-WRITE-F1-15. NC1064.2 +089200 MOVE "SUB-TEST-F1-15" TO PAR-NAME. NC1064.2 +089300 PERFORM PRINT-DETAIL. NC1064.2 +089400 SUB-TEST-F1-16. NC1064.2 +089500 SUBTRACT SUBTR-5 -98 SUBTR-3 -1 FROM SUBTR-10. NC1064.2 +089600 IF SUBTR-10 EQUAL TO 100 NC1064.2 +089700 PERFORM PASS GO TO SUB-WRITE-F1-16. NC1064.2 +089800 GO TO SUB-FAIL-F1-16. NC1064.2 +089900 SUB-DELETE-F1-16. NC1064.2 +090000 PERFORM DE-LETE. NC1064.2 +090100 GO TO SUB-WRITE-F1-16. NC1064.2 +090200 SUB-FAIL-F1-16. NC1064.2 +090300 MOVE SUBTR-10 TO COMPUTED-N. NC1064.2 +090400 MOVE 100 TO CORRECT-N. NC1064.2 +090500 PERFORM FAIL. NC1064.2 +090600 SUB-WRITE-F1-16. NC1064.2 +090700 MOVE "SUB-TEST-F1-16" TO PAR-NAME. NC1064.2 +090800 PERFORM PRINT-DETAIL. NC1064.2 +090900 SUB-TEST-F1-17. NC1064.2 +091000 SUBTRACT SUBTR-4 FROM SUBTR-6 ROUNDED. NC1064.2 +091100 IF SUBTR-6 EQUAL TO 1 NC1064.2 +091200 PERFORM PASS GO TO SUB-WRITE-F1-17. NC1064.2 +091300 GO TO SUB-FAIL-F1-17. NC1064.2 +091400 SUB-DELETE-F1-17. NC1064.2 +091500 PERFORM DE-LETE. NC1064.2 +091600 GO TO SUB-WRITE-F1-17. NC1064.2 +091700 SUB-FAIL-F1-17. NC1064.2 +091800 MOVE SUBTR-6 TO COMPUTED-N. NC1064.2 +091900 MOVE 1 TO CORRECT-N. NC1064.2 +092000 PERFORM FAIL. NC1064.2 +092100 SUB-WRITE-F1-17. NC1064.2 +092200 MOVE "SUB-TEST-F1-17" TO PAR-NAME. NC1064.2 +092300 PERFORM PRINT-DETAIL. NC1064.2 +092400 SUB-TEST-F1-18-1. NC1064.2 +092500 SUBTRACT .01 FROM SUBTR-8 ON SIZE ERROR NC1064.2 +092600 PERFORM PASS GO TO SUB-WRITE-F1-18-1. NC1064.2 +092700 GO TO SUB-FAIL-F1-18-1. NC1064.2 +092800 SUB-DELETE-F1-18-1. NC1064.2 +092900 PERFORM DE-LETE. NC1064.2 +093000 GO TO SUB-WRITE-F1-18-1. NC1064.2 +093100 SUB-FAIL-F1-18-1. NC1064.2 +093200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1064.2 +093300 PERFORM FAIL. NC1064.2 +093400 SUB-WRITE-F1-18-1. NC1064.2 +093500 MOVE "SUB-TEST-F1-18-1" TO PAR-NAME. NC1064.2 +093600 PERFORM PRINT-DETAIL. NC1064.2 +093700 SUB-TEST-F1-18-2. NC1064.2 +093800 IF SUBTR-8 EQUAL TO -9.99 NC1064.2 +093900 PERFORM PASS GO TO SUB-WRITE-F1-18-2. NC1064.2 +094000* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F1-18-1 NC1064.2 +094100 GO TO SUB-FAIL-F1-18-2. NC1064.2 +094200 SUB-DELETE-F1-18-2. NC1064.2 +094300 PERFORM DE-LETE. NC1064.2 +094400 GO TO SUB-WRITE-F1-18-2. NC1064.2 +094500 SUB-FAIL-F1-18-2. NC1064.2 +094600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1064.2 +094700 MOVE SUBTR-8 TO COMPUTED-N. NC1064.2 +094800 MOVE -9.99 TO CORRECT-N. NC1064.2 +094900 PERFORM FAIL. NC1064.2 +095000 SUB-WRITE-F1-18-2. NC1064.2 +095100 MOVE "SUB-TEST-F1-18-2" TO PAR-NAME. NC1064.2 +095200 PERFORM PRINT-DETAIL. NC1064.2 +095300 SUB-TEST-F1-19. NC1064.2 +095400 MOVE A18FIVES-CS-18V00 TO WRK-CS-18V00. NC1064.2 +095500 SUBTRACT A18THREES-CS-18V00 FROM WRK-CS-18V00. NC1064.2 +095600 IF WRK-CS-18V00 EQUAL TO -222222222222222222 NC1064.2 +095700 PERFORM PASS NC1064.2 +095800 GO TO SUB-WRITE-F1-19. NC1064.2 +095900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1064.2 +096000 MOVE -222222222222222222 TO CORRECT-18V0. NC1064.2 +096100 PERFORM FAIL. NC1064.2 +096200 GO TO SUB-WRITE-F1-19. NC1064.2 +096300 SUB-DELETE-F1-19. NC1064.2 +096400 PERFORM DE-LETE. NC1064.2 +096500 SUB-WRITE-F1-19. NC1064.2 +096600 MOVE "SUB-TEST-F1-19 " TO PAR-NAME. NC1064.2 +096700 PERFORM PRINT-DETAIL. NC1064.2 +096800 SUB-TEST-F1-20. NC1064.2 +096900 MOVE -980 TO WRK-CS-03V00. NC1064.2 +097000 MOVE SPACE TO SIZE-ERR. NC1064.2 +097100* NOTE IN THIS TEST, 1 IS SUBTRACTED FROM A 3-DIGIT COMP NC1064.2 +097200* SYNC FIELD UNTIL A SIZE ERROR OCCURS --- IF THE NC1064.2 +097300* VALUE OF THE FIELD REACHES -1180 WITHOUT A SIZE NC1064.2 +097400* ERROR, THEN THE ATTEMPTED SUBTRACTIONS ARE STOPPED. NC1064.2 +097500 PERFORM SUB-A-F1-20 THRU SUB-B-F1-20 200 TIMES. NC1064.2 +097600 IF SIZE-ERR EQUAL TO SPACE NC1064.2 +097700 MOVE "SIZE ERROR NOT ENCOUNTERED" TO RE-MARK NC1064.2 +097800 MOVE "-1180 OR LESS" TO COMPUTED-A NC1064.2 +097900 MOVE "-999 IN S999 FIELD" TO CORRECT-A NC1064.2 +098000 PERFORM FAIL NC1064.2 +098100 GO TO SUB-WRITE-F1-20. NC1064.2 +098200 IF WRK-CS-03V00 EQUAL TO -999 NC1064.2 +098300 PERFORM PASS GO TO SUB-WRITE-F1-20. NC1064.2 +098400 PERFORM FAIL. NC1064.2 +098500 MOVE WRK-CS-03V00 TO COMPUTED-N. NC1064.2 +098600 MOVE -999 TO CORRECT-N. NC1064.2 +098700 GO TO SUB-WRITE-F1-20. NC1064.2 +098800 SUB-DELETE-F1-20. NC1064.2 +098900 PERFORM DE-LETE. NC1064.2 +099000 GO TO SUB-WRITE-F1-20. NC1064.2 +099100 SUB-A-F1-20. NC1064.2 +099200 IF SIZE-ERR EQUAL TO "E" GO TO SUB-B-F1-20. NC1064.2 +099300 SUBTRACT 1 FROM WRK-CS-03V00 ON SIZE ERROR NC1064.2 +099400 MOVE "E" TO SIZE-ERR. NC1064.2 +099500 SUB-B-F1-20. NC1064.2 +099600 EXIT. NC1064.2 +099700 SUB-WRITE-F1-20. NC1064.2 +099800 MOVE "SUBT, COMP, SIZE ERR" TO FEATURE. NC1064.2 +099900 MOVE "SUB-TEST-F1-20" TO PAR-NAME. NC1064.2 +100000 PERFORM PRINT-DETAIL. NC1064.2 +100100* NC1064.2 +100200 SUB-INIT-F1-21. NC1064.2 +100300* ==--> NEW SIZE ERROR TESTS <--== NC1064.2 +100400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +100500 MOVE -11 TO WRK-DS-02V00. NC1064.2 +100600 SUB-TEST-F1-21. NC1064.2 +100700 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +100800 NOT ON SIZE ERROR NC1064.2 +100900 GO TO SUB-FAIL-F1-21. NC1064.2 +101000 PERFORM PASS GO TO SUB-WRITE-F1-21. NC1064.2 +101100 SUB-DELETE-F1-21. NC1064.2 +101200 PERFORM DE-LETE. NC1064.2 +101300 GO TO SUB-WRITE-F1-21. NC1064.2 +101400 SUB-FAIL-F1-21. NC1064.2 +101500 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1064.2 +101600 PERFORM FAIL. NC1064.2 +101700 SUB-WRITE-F1-21. NC1064.2 +101800 MOVE "SUB-TEST-F1-21" TO PAR-NAME. NC1064.2 +101900 PERFORM PRINT-DETAIL. NC1064.2 +102000* NC1064.2 +102100 SUB-INIT-F1-22. NC1064.2 +102200* ==--> NEW SIZE ERROR TESTS <--== NC1064.2 +102300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +102400 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +102500 SUB-TEST-F1-22. NC1064.2 +102600 SUBTRACT A12THREES-DS-06V06 NC1064.2 +102700 333333 NC1064.2 +102800 A06THREES-DS-03V03 NC1064.2 +102900 -0000009 NC1064.2 +103000 FROM WRK-DS-06V06 ROUNDED NC1064.2 +103100 NOT ON SIZE ERROR NC1064.2 +103200 PERFORM PASS NC1064.2 +103300 GO TO SUB-WRITE-F1-22. NC1064.2 +103400 GO TO SUB-FAIL-F1-22. NC1064.2 +103500 SUB-DELETE-F1-22. NC1064.2 +103600 PERFORM DE-LETE. NC1064.2 +103700 GO TO SUB-WRITE-F1-22. NC1064.2 +103800 SUB-FAIL-F1-22. NC1064.2 +103900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1064.2 +104000 PERFORM FAIL. NC1064.2 +104100 SUB-WRITE-F1-22. NC1064.2 +104200 MOVE "SUB-TEST-F1-22" TO PAR-NAME. NC1064.2 +104300 PERFORM PRINT-DETAIL. NC1064.2 +104400* NC1064.2 +104500 SUB-INIT-F1-23. NC1064.2 +104600* ==--> NEW SIZE ERROR TESTS <--== NC1064.2 +104700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +104800 MOVE -11 TO WRK-DS-02V00. NC1064.2 +104900 SUB-TEST-F1-23. NC1064.2 +105000 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +105100 ON SIZE ERROR NC1064.2 +105200 PERFORM PASS GO TO SUB-WRITE-F1-23 NC1064.2 +105300 NOT ON SIZE ERROR NC1064.2 +105400 GO TO SUB-FAIL-F1-23. NC1064.2 +105500 SUB-DELETE-F1-23. NC1064.2 +105600 PERFORM DE-LETE. NC1064.2 +105700 GO TO SUB-WRITE-F1-23. NC1064.2 +105800 SUB-FAIL-F1-23. NC1064.2 +105900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1064.2 +106000 PERFORM FAIL. NC1064.2 +106100 SUB-WRITE-F1-23. NC1064.2 +106200 MOVE "SUB-TEST-F1-23" TO PAR-NAME. NC1064.2 +106300 PERFORM PRINT-DETAIL. NC1064.2 +106400* NC1064.2 +106500 SUB-INIT-F1-24. NC1064.2 +106600* ==--> NEW SIZE ERROR TESTS <--== NC1064.2 +106700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +106800 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +106900 SUB-TEST-F1-24. NC1064.2 +107000 SUBTRACT A12THREES-DS-06V06 NC1064.2 +107100 333333 NC1064.2 +107200 A06THREES-DS-03V03 NC1064.2 +107300 -0000009 NC1064.2 +107400 FROM WRK-DS-06V06 ROUNDED NC1064.2 +107500 ON SIZE ERROR NC1064.2 +107600 GO TO SUB-FAIL-F1-24 NC1064.2 +107700 NOT ON SIZE ERROR NC1064.2 +107800 PERFORM PASS NC1064.2 +107900 GO TO SUB-WRITE-F1-24. NC1064.2 +108000 SUB-DELETE-F1-24. NC1064.2 +108100 PERFORM DE-LETE. NC1064.2 +108200 GO TO SUB-WRITE-F1-24. NC1064.2 +108300 SUB-FAIL-F1-24. NC1064.2 +108400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1064.2 +108500 PERFORM FAIL. NC1064.2 +108600 SUB-WRITE-F1-24. NC1064.2 +108700 MOVE "SUB-TEST-F1-24" TO PAR-NAME. NC1064.2 +108800 PERFORM PRINT-DETAIL. NC1064.2 +108900* NC1064.2 +109000 SUB-INIT-F1-25. NC1064.2 +109100* ==--> MULTIPLE OPERANDS <--== NC1064.2 +109200 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +109300 MOVE "SUBTR LIMIT TESTS " TO FEATURE. NC1064.2 +109400 MOVE 1 TO DNAME1 DNAME2 DNAME3 DNAME4 DNAME5. NC1064.2 +109500 MOVE 1 TO DNAME6 DNAME7 DNAME8 DNAME9 DNAME10. NC1064.2 +109600 MOVE 1 TO DNAME11 DNAME12 DNAME13 DNAME14 DNAME14. NC1064.2 +109700 MOVE 1 TO DNAME16 DNAME17 DNAME18 DNAME19 DNAME20. NC1064.2 +109800 MOVE 1 TO DNAME21. NC1064.2 +109900 MOVE 21 TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26. NC1064.2 +110000 MOVE 21 TO DNAME27 DNAME28 DNAME29 DNAME30 DNAME31. NC1064.2 +110100 MOVE 21 TO DNAME32 DNAME33 DNAME34 DNAME35 DNAME36. NC1064.2 +110200 MOVE 21 TO DNAME37 DNAME38 DNAME39 DNAME40 DNAME41. NC1064.2 +110300 MOVE 21 TO DNAME42. NC1064.2 +110400* THE FOLLOWING 22 TESTS VERIFY THE ABILITY OF THE COMPILER NC1064.2 +110500* TO HANDLE A MAXIMUM OF 42 OPERANDS IN A SUBTRACT STATEMENT. NC1064.2 +110600* A DELETION IN THIS PARAGRAPH WILL SKIP THE LIMIT TESTS. NC1064.2 +110700 GO TO SUB-TEST-F1-25-0. NC1064.2 +110800 SUB-DELETE-F1-25-0. NC1064.2 +110900 PERFORM DE-LETE. NC1064.2 +111000 MOVE "SUB-TEST-F1-25 - 26 " TO PAR-NAME. NC1064.2 +111100 MOVE "SUBTR LIMITS TESTS " TO FEATURE. NC1064.2 +111200 ADD 21 TO DELETE-COUNTER. NC1064.2 +111300 PERFORM PRINT-DETAIL. NC1064.2 +111400 GO TO SUB-INIT-F1-26. NC1064.2 +111500 SUB-TEST-F1-25-0. NC1064.2 +111600 SUBTRACT DNAME1 NC1064.2 +111700 DNAME2 NC1064.2 +111800 DNAME3 NC1064.2 +111900 DNAME4 NC1064.2 +112000 DNAME5 NC1064.2 +112100 DNAME6 NC1064.2 +112200 DNAME7 NC1064.2 +112300 DNAME8 NC1064.2 +112400 DNAME9 NC1064.2 +112500 DNAME10 NC1064.2 +112600 DNAME11 NC1064.2 +112700 DNAME12 NC1064.2 +112800 DNAME13 NC1064.2 +112900 DNAME14 NC1064.2 +113000 DNAME15 NC1064.2 +113100 DNAME16 NC1064.2 +113200 DNAME17 NC1064.2 +113300 DNAME18 NC1064.2 +113400 DNAME19 NC1064.2 +113500 DNAME20 NC1064.2 +113600 DNAME21 NC1064.2 +113700 FROM DNAME22. NC1064.2 +113800 SUB-TEST-F1-25-1. NC1064.2 +113900 IF DNAME22 EQUAL TO ZERO NC1064.2 +114000 PERFORM PASS NC1064.2 +114100 GO TO SUB-WRITE-F1-25. NC1064.2 +114200 MOVE DNAME22 TO COMPUTED-18V0. NC1064.2 +114300 MOVE ZERO TO CORRECT-18V0. NC1064.2 +114400 PERFORM FAIL. NC1064.2 +114500 GO TO SUB-WRITE-F1-25. NC1064.2 +114600 SUB-DELETE-F1-25. NC1064.2 +114700 PERFORM DE-LETE. NC1064.2 +114800 SUB-WRITE-F1-25. NC1064.2 +114900 MOVE "SUB-TEST-F1-25" TO PAR-NAME. NC1064.2 +115000 PERFORM PRINT-DETAIL. NC1064.2 +115100 SUB-INIT-F1-26. NC1064.2 +115200 MOVE 21 TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26. NC1064.2 +115300 MOVE 21 TO DNAME27 DNAME28 DNAME29 DNAME30 DNAME31. NC1064.2 +115400 MOVE 21 TO DNAME32 DNAME33 DNAME34 DNAME35 DNAME36. NC1064.2 +115500 MOVE 21 TO DNAME37 DNAME38 DNAME39 DNAME40 DNAME41. NC1064.2 +115600 MOVE 21 TO DNAME42. NC1064.2 +115700 SUB-TEST-F1-26-0. NC1064.2 +115800 SUBTRACT DNAME1 NC1064.2 +115900 DNAME2 NC1064.2 +116000 DNAME3 NC1064.2 +116100 DNAME4 NC1064.2 +116200 DNAME5 NC1064.2 +116300 DNAME6 NC1064.2 +116400 DNAME7 NC1064.2 +116500 DNAME8 NC1064.2 +116600 DNAME9 NC1064.2 +116700 DNAME10 NC1064.2 +116800 DNAME11 NC1064.2 +116900 DNAME12 NC1064.2 +117000 DNAME13 NC1064.2 +117100 DNAME14 NC1064.2 +117200 DNAME15 NC1064.2 +117300 DNAME16 NC1064.2 +117400 DNAME17 NC1064.2 +117500 DNAME18 NC1064.2 +117600 DNAME19 NC1064.2 +117700 DNAME20 NC1064.2 +117800 DNAME21 NC1064.2 +117900 FROM DNAME22 NC1064.2 +118000 DNAME23 NC1064.2 +118100 DNAME24 NC1064.2 +118200 DNAME25 NC1064.2 +118300 DNAME26 NC1064.2 +118400 DNAME27 NC1064.2 +118500 DNAME28 NC1064.2 +118600 DNAME29 NC1064.2 +118700 DNAME30 NC1064.2 +118800 DNAME31 NC1064.2 +118900 DNAME32 NC1064.2 +119000 DNAME33 NC1064.2 +119100 DNAME34 NC1064.2 +119200 DNAME35 NC1064.2 +119300 DNAME36 NC1064.2 +119400 DNAME37 NC1064.2 +119500 DNAME38 NC1064.2 +119600 DNAME39 NC1064.2 +119700 DNAME40 NC1064.2 +119800 DNAME41 NC1064.2 +119900 DNAME42. NC1064.2 +120000 SUB-TEST-F1-26-1. NC1064.2 +120100 IF DNAME22 EQUAL TO ZERO NC1064.2 +120200 PERFORM PASS NC1064.2 +120300 GO TO SUB-WRITE-F1-26-1. NC1064.2 +120400 MOVE DNAME22 TO COMPUTED-18V0. NC1064.2 +120500 MOVE ZERO TO CORRECT-18V0. NC1064.2 +120600 PERFORM FAIL. NC1064.2 +120700 GO TO SUB-WRITE-F1-26-1. NC1064.2 +120800 SUB-DELETE-F1-26-1. NC1064.2 +120900 PERFORM DE-LETE. NC1064.2 +121000 SUB-WRITE-F1-26-1. NC1064.2 +121100 MOVE "SUB-TEST-F1-26-1" TO PAR-NAME. NC1064.2 +121200 PERFORM PRINT-DETAIL. NC1064.2 +121300 SUB-TEST-F1-26-2. NC1064.2 +121400 IF DNAME23 EQUAL TO ZERO NC1064.2 +121500 PERFORM PASS NC1064.2 +121600 GO TO SUB-WRITE-F1-26-2. NC1064.2 +121700 MOVE ZERO TO CORRECT-18V0. NC1064.2 +121800 MOVE DNAME23 TO COMPUTED-18V0. NC1064.2 +121900 PERFORM FAIL. NC1064.2 +122000 GO TO SUB-WRITE-F1-26-2. NC1064.2 +122100 SUB-DELETE-F1-26-2. NC1064.2 +122200 PERFORM DE-LETE. NC1064.2 +122300 SUB-WRITE-F1-26-2. NC1064.2 +122400 MOVE "SUB-TEST-F1-26-2 " TO PAR-NAME. NC1064.2 +122500 PERFORM PRINT-DETAIL. NC1064.2 +122600 SUB-TEST-F1-26-3. NC1064.2 +122700 IF DNAME24 EQUAL TO ZERO NC1064.2 +122800 PERFORM PASS NC1064.2 +122900 GO TO SUB-WRITE-F1-26-3. NC1064.2 +123000 MOVE ZERO TO CORRECT-18V0. NC1064.2 +123100 MOVE DNAME24 TO COMPUTED-18V0. NC1064.2 +123200 PERFORM FAIL. NC1064.2 +123300 GO TO SUB-WRITE-F1-26-3. NC1064.2 +123400 SUB-DELETE-F1-26-3. NC1064.2 +123500 PERFORM DE-LETE. NC1064.2 +123600 SUB-WRITE-F1-26-3. NC1064.2 +123700 MOVE "SUB-TEST-F1-26-3 " TO PAR-NAME. NC1064.2 +123800 PERFORM PRINT-DETAIL. NC1064.2 +123900 SUB-TEST-F1-26-4. NC1064.2 +124000 IF DNAME25 EQUAL TO ZERO NC1064.2 +124100 PERFORM PASS NC1064.2 +124200 GO TO SUB-WRITE-F1-26-4. NC1064.2 +124300 MOVE ZERO TO CORRECT-18V0. NC1064.2 +124400 MOVE DNAME25 TO COMPUTED-18V0. NC1064.2 +124500 PERFORM FAIL. NC1064.2 +124600 GO TO SUB-WRITE-F1-26-4. NC1064.2 +124700 SUB-DELETE-F1-26-4. NC1064.2 +124800 PERFORM DE-LETE. NC1064.2 +124900 SUB-WRITE-F1-26-4. NC1064.2 +125000 MOVE "SUB-TEST-F1-26-4 " TO PAR-NAME. NC1064.2 +125100 PERFORM PRINT-DETAIL. NC1064.2 +125200 SUB-TEST-F1-26-5. NC1064.2 +125300 IF DNAME26 EQUAL TO ZERO NC1064.2 +125400 PERFORM PASS NC1064.2 +125500 GO TO SUB-WRITE-F1-26-5. NC1064.2 +125600 MOVE ZERO TO CORRECT-18V0. NC1064.2 +125700 MOVE DNAME26 TO COMPUTED-18V0. NC1064.2 +125800 PERFORM FAIL. NC1064.2 +125900 GO TO SUB-WRITE-F1-26-5. NC1064.2 +126000 SUB-DELETE-F1-26-5. NC1064.2 +126100 PERFORM DE-LETE. NC1064.2 +126200 SUB-WRITE-F1-26-5. NC1064.2 +126300 MOVE "SUB-TEST-F1-26-5 " TO PAR-NAME. NC1064.2 +126400 PERFORM PRINT-DETAIL. NC1064.2 +126500 SUB-TEST-F1-26-6. NC1064.2 +126600 IF DNAME27 EQUAL TO ZERO NC1064.2 +126700 PERFORM PASS NC1064.2 +126800 GO TO SUB-WRITE-F1-26-6. NC1064.2 +126900 MOVE ZERO TO CORRECT-18V0. NC1064.2 +127000 MOVE DNAME27 TO COMPUTED-18V0. NC1064.2 +127100 PERFORM FAIL. NC1064.2 +127200 GO TO SUB-WRITE-F1-26-6. NC1064.2 +127300 SUB-DELETE-F1-26-6. NC1064.2 +127400 PERFORM DE-LETE. NC1064.2 +127500 SUB-WRITE-F1-26-6. NC1064.2 +127600 MOVE "SUB-TEST-F1-26-6 " TO PAR-NAME. NC1064.2 +127700 PERFORM PRINT-DETAIL. NC1064.2 +127800 SUB-TEST-F1-26-7. NC1064.2 +127900 IF DNAME28 EQUAL TO ZERO NC1064.2 +128000 PERFORM PASS NC1064.2 +128100 GO TO SUB-WRITE-F1-26-7. NC1064.2 +128200 MOVE ZERO TO CORRECT-18V0. NC1064.2 +128300 MOVE DNAME28 TO COMPUTED-18V0. NC1064.2 +128400 PERFORM FAIL. NC1064.2 +128500 GO TO SUB-WRITE-F1-26-7. NC1064.2 +128600 SUB-DELETE-F1-26-7. NC1064.2 +128700 PERFORM DE-LETE. NC1064.2 +128800 SUB-WRITE-F1-26-7. NC1064.2 +128900 MOVE "SUB-TEST-F1-26-7 " TO PAR-NAME. NC1064.2 +129000 PERFORM PRINT-DETAIL. NC1064.2 +129100 SUB-TEST-F1-26-8. NC1064.2 +129200 IF DNAME29 EQUAL TO ZERO NC1064.2 +129300 PERFORM PASS NC1064.2 +129400 GO TO SUB-WRITE-F1-26-8. NC1064.2 +129500 MOVE ZERO TO CORRECT-18V0. NC1064.2 +129600 MOVE DNAME29 TO COMPUTED-18V0. NC1064.2 +129700 PERFORM FAIL. NC1064.2 +129800 GO TO SUB-WRITE-F1-26-8. NC1064.2 +129900 SUB-DELETE-F1-26-8. NC1064.2 +130000 PERFORM DE-LETE. NC1064.2 +130100 SUB-WRITE-F1-26-8. NC1064.2 +130200 MOVE "SUB-TEST-F1-26-8 " TO PAR-NAME. NC1064.2 +130300 PERFORM PRINT-DETAIL. NC1064.2 +130400 SUB-TEST-F1-26-9. NC1064.2 +130500 IF DNAME30 EQUAL TO ZERO NC1064.2 +130600 PERFORM PASS NC1064.2 +130700 GO TO SUB-WRITE-F1-26-9. NC1064.2 +130800 MOVE ZERO TO CORRECT-18V0. NC1064.2 +130900 MOVE DNAME30 TO COMPUTED-18V0. NC1064.2 +131000 PERFORM FAIL. NC1064.2 +131100 GO TO SUB-WRITE-F1-26-9. NC1064.2 +131200 SUB-DELETE-F1-26-9. NC1064.2 +131300 PERFORM DE-LETE. NC1064.2 +131400 SUB-WRITE-F1-26-9. NC1064.2 +131500 MOVE "SUB-TEST-F1-26-9 " TO PAR-NAME. NC1064.2 +131600 PERFORM PRINT-DETAIL. NC1064.2 +131700 SUB-TEST-F1-26-10. NC1064.2 +131800 IF DNAME31 EQUAL TO ZERO NC1064.2 +131900 PERFORM PASS NC1064.2 +132000 GO TO SUB-WRITE-F1-26-10. NC1064.2 +132100 MOVE ZERO TO CORRECT-18V0. NC1064.2 +132200 MOVE DNAME31 TO COMPUTED-18V0. NC1064.2 +132300 PERFORM FAIL. NC1064.2 +132400 GO TO SUB-WRITE-F1-26-10. NC1064.2 +132500 SUB-DELETE-F1-26-10. NC1064.2 +132600 PERFORM DE-LETE. NC1064.2 +132700 SUB-WRITE-F1-26-10. NC1064.2 +132800 MOVE "SUB-TEST-F1-26-10 " TO PAR-NAME. NC1064.2 +132900 PERFORM PRINT-DETAIL. NC1064.2 +133000 SUB-TEST-F1-26-11. NC1064.2 +133100 IF DNAME32 EQUAL TO ZERO NC1064.2 +133200 PERFORM PASS NC1064.2 +133300 GO TO SUB-WRITE-F1-26-11. NC1064.2 +133400 MOVE ZERO TO CORRECT-18V0. NC1064.2 +133500 MOVE DNAME32 TO COMPUTED-18V0. NC1064.2 +133600 PERFORM FAIL. NC1064.2 +133700 GO TO SUB-WRITE-F1-26-11. NC1064.2 +133800 SUB-DELETE-F1-26-11. NC1064.2 +133900 PERFORM DE-LETE. NC1064.2 +134000 SUB-WRITE-F1-26-11. NC1064.2 +134100 MOVE "SUB-TEST-F1-26-11 " TO PAR-NAME. NC1064.2 +134200 PERFORM PRINT-DETAIL. NC1064.2 +134300 SUB-TEST-F1-26-12. NC1064.2 +134400 IF DNAME33 EQUAL TO ZERO NC1064.2 +134500 PERFORM PASS NC1064.2 +134600 GO TO SUB-WRITE-F1-26-12. NC1064.2 +134700 MOVE ZERO TO CORRECT-18V0. NC1064.2 +134800 MOVE DNAME33 TO COMPUTED-18V0. NC1064.2 +134900 PERFORM FAIL. NC1064.2 +135000 GO TO SUB-WRITE-F1-26-12. NC1064.2 +135100 SUB-DELETE-F1-26-12. NC1064.2 +135200 PERFORM DE-LETE. NC1064.2 +135300 SUB-WRITE-F1-26-12. NC1064.2 +135400 MOVE "SUB-TEST-F1-26-12 " TO PAR-NAME. NC1064.2 +135500 PERFORM PRINT-DETAIL. NC1064.2 +135600 SUB-TEST-F1-26-13. NC1064.2 +135700 IF DNAME34 EQUAL TO ZERO NC1064.2 +135800 PERFORM PASS NC1064.2 +135900 GO TO SUB-WRITE-F1-26-13. NC1064.2 +136000 MOVE ZERO TO CORRECT-18V0. NC1064.2 +136100 MOVE DNAME34 TO COMPUTED-18V0. NC1064.2 +136200 PERFORM FAIL. NC1064.2 +136300 GO TO SUB-WRITE-F1-26-13. NC1064.2 +136400 SUB-DELETE-F1-26-13. NC1064.2 +136500 PERFORM DE-LETE. NC1064.2 +136600 SUB-WRITE-F1-26-13. NC1064.2 +136700 MOVE "SUB-TEST-F1-26-13 " TO PAR-NAME. NC1064.2 +136800 PERFORM PRINT-DETAIL. NC1064.2 +136900 SUB-TEST-F1-26-14. NC1064.2 +137000 IF DNAME35 EQUAL TO ZERO NC1064.2 +137100 PERFORM PASS NC1064.2 +137200 GO TO SUB-WRITE-F1-26-14. NC1064.2 +137300 MOVE ZERO TO CORRECT-18V0. NC1064.2 +137400 MOVE DNAME35 TO COMPUTED-18V0. NC1064.2 +137500 PERFORM FAIL. NC1064.2 +137600 GO TO SUB-WRITE-F1-26-14. NC1064.2 +137700 SUB-DELETE-F1-26-14. NC1064.2 +137800 PERFORM DE-LETE. NC1064.2 +137900 SUB-WRITE-F1-26-14. NC1064.2 +138000 MOVE "SUB-TEST-F1-26-14 " TO PAR-NAME. NC1064.2 +138100 PERFORM PRINT-DETAIL. NC1064.2 +138200 SUB-TEST-F1-26-15. NC1064.2 +138300 IF DNAME36 EQUAL TO ZERO NC1064.2 +138400 PERFORM PASS NC1064.2 +138500 GO TO SUB-WRITE-F1-26-15. NC1064.2 +138600 MOVE ZERO TO CORRECT-18V0. NC1064.2 +138700 MOVE DNAME36 TO COMPUTED-18V0. NC1064.2 +138800 PERFORM FAIL. NC1064.2 +138900 GO TO SUB-WRITE-F1-26-15. NC1064.2 +139000 SUB-DELETE-F1-26-15. NC1064.2 +139100 PERFORM DE-LETE. NC1064.2 +139200 SUB-WRITE-F1-26-15. NC1064.2 +139300 MOVE "SUB-TEST-F1-26-15 " TO PAR-NAME. NC1064.2 +139400 PERFORM PRINT-DETAIL. NC1064.2 +139500 SUB-TEST-F1-26-16. NC1064.2 +139600 IF DNAME37 EQUAL TO ZERO NC1064.2 +139700 PERFORM PASS NC1064.2 +139800 GO TO SUB-WRITE-F1-26-16. NC1064.2 +139900 MOVE ZERO TO CORRECT-18V0. NC1064.2 +140000 MOVE DNAME37 TO COMPUTED-18V0. NC1064.2 +140100 PERFORM FAIL. NC1064.2 +140200 GO TO SUB-WRITE-F1-26-16. NC1064.2 +140300 SUB-DELETE-F1-26-16. NC1064.2 +140400 PERFORM DE-LETE. NC1064.2 +140500 SUB-WRITE-F1-26-16. NC1064.2 +140600 MOVE "SUB-TEST-F1-26-16 " TO PAR-NAME. NC1064.2 +140700 PERFORM PRINT-DETAIL. NC1064.2 +140800 SUB-TEST-F1-26-17. NC1064.2 +140900 IF DNAME38 EQUAL TO ZERO NC1064.2 +141000 PERFORM PASS NC1064.2 +141100 GO TO SUB-WRITE-F1-26-17. NC1064.2 +141200 MOVE ZERO TO CORRECT-18V0. NC1064.2 +141300 MOVE DNAME38 TO COMPUTED-18V0. NC1064.2 +141400 PERFORM FAIL. NC1064.2 +141500 GO TO SUB-WRITE-F1-26-17. NC1064.2 +141600 SUB-DELETE-F1-26-17. NC1064.2 +141700 PERFORM DE-LETE. NC1064.2 +141800 SUB-WRITE-F1-26-17. NC1064.2 +141900 MOVE "SUB-TEST-F1-26-17 " TO PAR-NAME. NC1064.2 +142000 PERFORM PRINT-DETAIL. NC1064.2 +142100 SUB-TEST-F1-26-18. NC1064.2 +142200 IF DNAME39 EQUAL TO ZERO NC1064.2 +142300 PERFORM PASS NC1064.2 +142400 GO TO SUB-WRITE-F1-26-18. NC1064.2 +142500 MOVE ZERO TO CORRECT-18V0. NC1064.2 +142600 MOVE DNAME39 TO COMPUTED-18V0. NC1064.2 +142700 PERFORM FAIL. NC1064.2 +142800 GO TO SUB-WRITE-F1-26-18. NC1064.2 +142900 SUB-DELETE-F1-26-18. NC1064.2 +143000 PERFORM DE-LETE. NC1064.2 +143100 SUB-WRITE-F1-26-18. NC1064.2 +143200 MOVE "SUB-TEST-F1-26-18 " TO PAR-NAME. NC1064.2 +143300 PERFORM PRINT-DETAIL. NC1064.2 +143400 SUB-TEST-F1-26-19. NC1064.2 +143500 IF DNAME40 EQUAL TO ZERO NC1064.2 +143600 PERFORM PASS NC1064.2 +143700 GO TO SUB-WRITE-F1-26-19. NC1064.2 +143800 MOVE ZERO TO CORRECT-18V0. NC1064.2 +143900 MOVE DNAME40 TO COMPUTED-18V0. NC1064.2 +144000 PERFORM FAIL. NC1064.2 +144100 GO TO SUB-WRITE-F1-26-19. NC1064.2 +144200 SUB-DELETE-F1-26-19. NC1064.2 +144300 PERFORM DE-LETE. NC1064.2 +144400 SUB-WRITE-F1-26-19. NC1064.2 +144500 MOVE "SUB-TEST-F1-26-19 " TO PAR-NAME. NC1064.2 +144600 PERFORM PRINT-DETAIL. NC1064.2 +144700 SUB-TEST-F1-26-20. NC1064.2 +144800 IF DNAME41 EQUAL TO ZERO NC1064.2 +144900 PERFORM PASS NC1064.2 +145000 GO TO SUB-WRITE-F1-26-20. NC1064.2 +145100 MOVE DNAME41 TO COMPUTED-18V0. NC1064.2 +145200 MOVE ZERO TO CORRECT-18V0. NC1064.2 +145300 PERFORM FAIL. NC1064.2 +145400 GO TO SUB-WRITE-F1-26-20. NC1064.2 +145500 SUB-DELETE-F1-26-20. NC1064.2 +145600 PERFORM DE-LETE. NC1064.2 +145700 SUB-WRITE-F1-26-20. NC1064.2 +145800 MOVE "SUB-TEST-F1-26-20 " TO PAR-NAME. NC1064.2 +145900 PERFORM PRINT-DETAIL. NC1064.2 +146000 SUB-TEST-F1-26-21. NC1064.2 +146100 IF DNAME42 EQUAL TO ZERO NC1064.2 +146200 PERFORM PASS NC1064.2 +146300 GO TO SUB-WRITE-F1-26-21. NC1064.2 +146400 MOVE DNAME42 TO COMPUTED-18V0. NC1064.2 +146500 MOVE ZERO TO CORRECT-18V0. NC1064.2 +146600 PERFORM FAIL. NC1064.2 +146700 GO TO SUB-WRITE-F1-26-21. NC1064.2 +146800 SUB-DELETE-F1-26-21. NC1064.2 +146900 PERFORM DE-LETE. NC1064.2 +147000 SUB-WRITE-F1-26-21. NC1064.2 +147100 MOVE "SUB-TEST-F1-26-21 " TO PAR-NAME. NC1064.2 +147200 PERFORM PRINT-DETAIL. NC1064.2 +147300* NC1064.2 +147400 SUB-INIT-F1-27. NC1064.2 +147500* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +147600 MOVE "VI-134 6.25.4 GR1" TO ANSI-REFERENCE. NC1064.2 +147700 MOVE "SUB-TEST-F1-27" TO PAR-NAME. NC1064.2 +147800 MOVE ZERO TO REC-CT. NC1064.2 +147900 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +148000 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +148100 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +148200 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +148300 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +148400 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +148500 MOVE -9999999999999999.99 TO WRK-DS-16V2-1. NC1064.2 +148600 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +148700 SUB-TEST-F1-27-0. NC1064.2 +148800 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +148900 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +149000 ROUNDED WRK-DU-16V2-1. NC1064.2 +149100 GO TO SUB-TEST-F1-27-1. NC1064.2 +149200 SUB-DELETE-F1-27. NC1064.2 +149300 PERFORM DE-LETE. NC1064.2 +149400 PERFORM PRINT-DETAIL. NC1064.2 +149500 GO TO SUB-INIT-F1-28. NC1064.2 +149600 SUB-TEST-F1-27-1. NC1064.2 +149700 MOVE "SUB-TEST-F1-27-1" TO PAR-NAME. NC1064.2 +149800 MOVE 1 TO REC-CT. NC1064.2 +149900 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +150000 ELSE NC1064.2 +150100 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +150200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +150300 ADD 1 TO REC-CT. NC1064.2 +150400 SUB-TEST-F1-27-2. NC1064.2 +150500 MOVE "SUB-TEST-F1-27-2" TO PAR-NAME. NC1064.2 +150600 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +150700 ELSE NC1064.2 +150800 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +150900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +151000 ADD 1 TO REC-CT. NC1064.2 +151100 SUB-TEST-F1-27-3. NC1064.2 +151200 MOVE "SUB-TEST-F1-27-3" TO PAR-NAME. NC1064.2 +151300 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +151400 ELSE NC1064.2 +151500 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +151600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +151700 ADD 1 TO REC-CT. NC1064.2 +151800 SUB-TEST-F1-27-4. NC1064.2 +151900 MOVE "SUB-TEST-F1-27-4" TO PAR-NAME. NC1064.2 +152000 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +152100 ELSE NC1064.2 +152200 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +152300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +152400 ADD 1 TO REC-CT. NC1064.2 +152500 SUB-TEST-F1-27-5. NC1064.2 +152600 MOVE "SUB-TEST-F1-27-5" TO PAR-NAME. NC1064.2 +152700 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +152800 PERFORM PRINT-DETAIL ELSE NC1064.2 +152900 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +153000 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +153100 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +153200* NC1064.2 +153300 SUB-INIT-F1-28. NC1064.2 +153400* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +153500* ==--> NO SIZE ERROR <--== NC1064.2 +153600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +153700 MOVE "SUB-TEST-F1-28" TO PAR-NAME. NC1064.2 +153800 MOVE ZERO TO REC-CT. NC1064.2 +153900 MOVE SPACE TO SIZE-ERR2. NC1064.2 +154000 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +154100 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +154200 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +154300 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +154400 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +154500 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +154600 MOVE -8888888888888888.88 TO WRK-DS-16V2-1. NC1064.2 +154700 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +154800 SUB-TEST-F1-28-0. NC1064.2 +154900 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +155000 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +155100 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +155200 ON SIZE ERROR NC1064.2 +155300 MOVE "A" TO SIZE-ERR2. NC1064.2 +155400 GO TO SUB-TEST-F1-28-1. NC1064.2 +155500 SUB-DELETE-F1-28. NC1064.2 +155600 PERFORM DE-LETE. NC1064.2 +155700 PERFORM PRINT-DETAIL. NC1064.2 +155800 GO TO SUB-INIT-F1-29. NC1064.2 +155900 SUB-TEST-F1-28-1. NC1064.2 +156000 MOVE "SUB-TEST-F1-28-1" TO PAR-NAME. NC1064.2 +156100 MOVE 1 TO REC-CT. NC1064.2 +156200 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +156300 ELSE NC1064.2 +156400 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +156500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +156600 ADD 1 TO REC-CT. NC1064.2 +156700 SUB-TEST-F1-28-2. NC1064.2 +156800 MOVE "SUB-TEST-F1-28-2" TO PAR-NAME. NC1064.2 +156900 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +157000 ELSE NC1064.2 +157100 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +157200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +157300 ADD 1 TO REC-CT. NC1064.2 +157400 SUB-TEST-F1-28-3. NC1064.2 +157500 MOVE "SUB-TEST-F1-28-3" TO PAR-NAME. NC1064.2 +157600 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +157700 ELSE NC1064.2 +157800 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +157900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +158000 ADD 1 TO REC-CT. NC1064.2 +158100 SUB-TEST-F1-28-4. NC1064.2 +158200 MOVE "SUB-TEST-F1-28-4" TO PAR-NAME. NC1064.2 +158300 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +158400 ELSE NC1064.2 +158500 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +158600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +158700 ADD 1 TO REC-CT. NC1064.2 +158800 SUB-TEST-F1-28-5. NC1064.2 +158900 MOVE "SUB-TEST-F1-28-5" TO PAR-NAME. NC1064.2 +159000 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +159100 PERFORM PRINT-DETAIL ELSE NC1064.2 +159200 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +159300 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +159400 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +159500 ADD 1 TO REC-CT. NC1064.2 +159600 SUB-TEST-F1-28-6. NC1064.2 +159700 MOVE "SUB-TEST-F1-28-6" TO PAR-NAME. NC1064.2 +159800 IF WRK-DS-16V2-1 = -8888888888888901.22 PERFORM PASS NC1064.2 +159900 PERFORM PRINT-DETAIL ELSE NC1064.2 +160000 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +160100 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +160200 MOVE "-8888888888888901.22" TO CORRECT-A NC1064.2 +160300 PERFORM PRINT-DETAIL. NC1064.2 +160400 ADD 1 TO REC-CT. NC1064.2 +160500 SUB-TEST-F1-28-7. NC1064.2 +160600 MOVE "SUB-TEST-F1-28-7" TO PAR-NAME. NC1064.2 +160700 IF SIZE-ERR2 = SPACE NC1064.2 +160800 PERFORM PASS NC1064.2 +160900 PERFORM PRINT-DETAIL NC1064.2 +161000 ELSE NC1064.2 +161100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +161200 TO RE-MARK NC1064.2 +161300 MOVE SPACE TO CORRECT-X NC1064.2 +161400 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +161500 PERFORM FAIL NC1064.2 +161600 PERFORM PRINT-DETAIL. NC1064.2 +161700* NC1064.2 +161800 SUB-INIT-F1-29. NC1064.2 +161900* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +162000* ==--> SIZE ERROR <--== NC1064.2 +162100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +162200 MOVE "SUB-TEST-F1-29" TO PAR-NAME. NC1064.2 +162300 MOVE ZERO TO REC-CT. NC1064.2 +162400 MOVE SPACE TO SIZE-ERR2. NC1064.2 +162500 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +162600 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +162700 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +162800 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +162900 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +163000 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +163100 MOVE -9999999999999999.99 TO WRK-DS-16V2-1. NC1064.2 +163200 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +163300 SUB-TEST-F1-29-0. NC1064.2 +163400 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +163500 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +163600 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +163700 ON SIZE ERROR NC1064.2 +163800 MOVE "A" TO SIZE-ERR2. NC1064.2 +163900 GO TO SUB-TEST-F1-29-1. NC1064.2 +164000 SUB-DELETE-F1-29. NC1064.2 +164100 PERFORM DE-LETE. NC1064.2 +164200 PERFORM PRINT-DETAIL. NC1064.2 +164300 GO TO SUB-INIT-F1-30. NC1064.2 +164400 SUB-TEST-F1-29-1. NC1064.2 +164500 MOVE "SUB-TEST-F1-29-1" TO PAR-NAME. NC1064.2 +164600 MOVE 1 TO REC-CT. NC1064.2 +164700 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +164800 ELSE NC1064.2 +164900 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +165000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +165100 ADD 1 TO REC-CT. NC1064.2 +165200 SUB-TEST-F1-29-2. NC1064.2 +165300 MOVE "SUB-TEST-F1-29-2" TO PAR-NAME. NC1064.2 +165400 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +165500 ELSE NC1064.2 +165600 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +165700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +165800 ADD 1 TO REC-CT. NC1064.2 +165900 SUB-TEST-F1-29-3. NC1064.2 +166000 MOVE "SUB-TEST-F1-29-3" TO PAR-NAME. NC1064.2 +166100 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +166200 ELSE NC1064.2 +166300 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +166400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +166500 ADD 1 TO REC-CT. NC1064.2 +166600 SUB-TEST-F1-29-4. NC1064.2 +166700 MOVE "SUB-TEST-F1-29-4" TO PAR-NAME. NC1064.2 +166800 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +166900 ELSE NC1064.2 +167000 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +167100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +167200 ADD 1 TO REC-CT. NC1064.2 +167300 SUB-TEST-F1-29-5. NC1064.2 +167400 MOVE "SUB-TEST-F1-29-5" TO PAR-NAME. NC1064.2 +167500 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +167600 PERFORM PRINT-DETAIL ELSE NC1064.2 +167700 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +167800 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +167900 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +168000 ADD 1 TO REC-CT. NC1064.2 +168100 SUB-TEST-F1-29-6. NC1064.2 +168200 MOVE "SUB-TEST-F1-29-6" TO PAR-NAME. NC1064.2 +168300 IF WRK-DS-16V2-1 = -9999999999999999.99 PERFORM PASS NC1064.2 +168400 PERFORM PRINT-DETAIL ELSE NC1064.2 +168500 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +168600 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +168700 MOVE "-9999999999999999.99" TO CORRECT-A NC1064.2 +168800 PERFORM PRINT-DETAIL. NC1064.2 +168900 ADD 1 TO REC-CT. NC1064.2 +169000 SUB-TEST-F1-29-7. NC1064.2 +169100 MOVE "SUB-TEST-F1-29-7" TO PAR-NAME. NC1064.2 +169200 IF SIZE-ERR2 = "A" NC1064.2 +169300 PERFORM PASS NC1064.2 +169400 PERFORM PRINT-DETAIL NC1064.2 +169500 ELSE NC1064.2 +169600 MOVE "ON SIZE ERROR SHOULD HAVE OCCURED" NC1064.2 +169700 TO RE-MARK NC1064.2 +169800 MOVE "A" TO CORRECT-X NC1064.2 +169900 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +170000 PERFORM FAIL NC1064.2 +170100 PERFORM PRINT-DETAIL. NC1064.2 +170200* NC1064.2 +170300 SUB-INIT-F1-30. NC1064.2 +170400* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +170500* ==--> NO SIZE ERROR <--== NC1064.2 +170600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +170700 MOVE "SUB-TEST-F1-30" TO PAR-NAME. NC1064.2 +170800 MOVE ZERO TO REC-CT. NC1064.2 +170900 MOVE SPACE TO SIZE-ERR2. NC1064.2 +171000 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +171100 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +171200 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +171300 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +171400 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +171500 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +171600 MOVE -8888888888888888.88 TO WRK-DS-16V2-1. NC1064.2 +171700 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +171800 SUB-TEST-F1-30-0. NC1064.2 +171900 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +172000 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +172100 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +172200 NOT ON SIZE ERROR NC1064.2 +172300 MOVE "A" TO SIZE-ERR2. NC1064.2 +172400 GO TO SUB-TEST-F1-30-1. NC1064.2 +172500 SUB-DELETE-F1-30. NC1064.2 +172600 PERFORM DE-LETE. NC1064.2 +172700 PERFORM PRINT-DETAIL. NC1064.2 +172800 GO TO SUB-INIT-F1-31. NC1064.2 +172900 SUB-TEST-F1-30-1. NC1064.2 +173000 MOVE "SUB-TEST-F1-30-1" TO PAR-NAME. NC1064.2 +173100 MOVE 1 TO REC-CT. NC1064.2 +173200 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +173300 ELSE NC1064.2 +173400 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +173500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +173600 ADD 1 TO REC-CT. NC1064.2 +173700 SUB-TEST-F1-30-2. NC1064.2 +173800 MOVE "SUB-TEST-F1-30-2" TO PAR-NAME. NC1064.2 +173900 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +174000 ELSE NC1064.2 +174100 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +174200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +174300 ADD 1 TO REC-CT. NC1064.2 +174400 SUB-TEST-F1-30-3. NC1064.2 +174500 MOVE "SUB-TEST-F1-30-3" TO PAR-NAME. NC1064.2 +174600 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +174700 ELSE NC1064.2 +174800 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +174900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +175000 ADD 1 TO REC-CT. NC1064.2 +175100 SUB-TEST-F1-30-4. NC1064.2 +175200 MOVE "SUB-TEST-F1-30-4" TO PAR-NAME. NC1064.2 +175300 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +175400 ELSE NC1064.2 +175500 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +175600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +175700 ADD 1 TO REC-CT. NC1064.2 +175800 SUB-TEST-F1-30-5. NC1064.2 +175900 MOVE "SUB-TEST-F1-30-5" TO PAR-NAME. NC1064.2 +176000 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +176100 PERFORM PRINT-DETAIL ELSE NC1064.2 +176200 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +176300 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +176400 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +176500 ADD 1 TO REC-CT. NC1064.2 +176600 SUB-TEST-F1-30-6. NC1064.2 +176700 MOVE "SUB-TEST-F1-30-6" TO PAR-NAME. NC1064.2 +176800 IF WRK-DS-16V2-1 = -8888888888888901.22 PERFORM PASS NC1064.2 +176900 PERFORM PRINT-DETAIL ELSE NC1064.2 +177000 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +177100 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +177200 MOVE "-8888888888888901.22" TO CORRECT-A NC1064.2 +177300 PERFORM PRINT-DETAIL. NC1064.2 +177400 ADD 1 TO REC-CT. NC1064.2 +177500 SUB-TEST-F1-30-7. NC1064.2 +177600 MOVE "SUB-TEST-F1-30-7" TO PAR-NAME. NC1064.2 +177700 IF SIZE-ERR2 = "A" NC1064.2 +177800 PERFORM PASS NC1064.2 +177900 PERFORM PRINT-DETAIL NC1064.2 +178000 ELSE NC1064.2 +178100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +178200 TO RE-MARK NC1064.2 +178300 MOVE "A" TO CORRECT-X NC1064.2 +178400 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +178500 PERFORM FAIL NC1064.2 +178600 PERFORM PRINT-DETAIL. NC1064.2 +178700* NC1064.2 +178800 SUB-INIT-F1-31. NC1064.2 +178900* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +179000* ==--> SIZE ERROR <--== NC1064.2 +179100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +179200 MOVE "SUB-TEST-F1-31" TO PAR-NAME. NC1064.2 +179300 MOVE ZERO TO REC-CT. NC1064.2 +179400 MOVE SPACE TO SIZE-ERR2. NC1064.2 +179500 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +179600 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +179700 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +179800 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +179900 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +180000 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +180100 MOVE -9999999999999999.99 TO WRK-DS-16V2-1. NC1064.2 +180200 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +180300 SUB-TEST-F1-31-0. NC1064.2 +180400 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +180500 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +180600 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +180700 NOT ON SIZE ERROR NC1064.2 +180800 MOVE "A" TO SIZE-ERR2. NC1064.2 +180900 GO TO SUB-TEST-F1-31-1. NC1064.2 +181000 SUB-DELETE-F1-31. NC1064.2 +181100 PERFORM DE-LETE. NC1064.2 +181200 PERFORM PRINT-DETAIL. NC1064.2 +181300 GO TO SUB-INIT-F1-32. NC1064.2 +181400 SUB-TEST-F1-31-1. NC1064.2 +181500 MOVE "SUB-TEST-F1-31-1" TO PAR-NAME. NC1064.2 +181600 MOVE 1 TO REC-CT. NC1064.2 +181700 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +181800 ELSE NC1064.2 +181900 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +182000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +182100 ADD 1 TO REC-CT. NC1064.2 +182200 SUB-TEST-F1-31-2. NC1064.2 +182300 MOVE "SUB-TEST-F1-31-2" TO PAR-NAME. NC1064.2 +182400 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +182500 ELSE NC1064.2 +182600 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +182700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +182800 ADD 1 TO REC-CT. NC1064.2 +182900 SUB-TEST-F1-31-3. NC1064.2 +183000 MOVE "SUB-TEST-F1-31-3" TO PAR-NAME. NC1064.2 +183100 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +183200 ELSE NC1064.2 +183300 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +183400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +183500 ADD 1 TO REC-CT. NC1064.2 +183600 SUB-TEST-F1-31-4. NC1064.2 +183700 MOVE "SUB-TEST-F1-31-4" TO PAR-NAME. NC1064.2 +183800 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +183900 ELSE NC1064.2 +184000 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +184100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +184200 ADD 1 TO REC-CT. NC1064.2 +184300 SUB-TEST-F1-31-5. NC1064.2 +184400 MOVE "SUB-TEST-F1-31-5" TO PAR-NAME. NC1064.2 +184500 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +184600 PERFORM PRINT-DETAIL ELSE NC1064.2 +184700 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +184800 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +184900 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +185000 ADD 1 TO REC-CT. NC1064.2 +185100 SUB-TEST-F1-31-6. NC1064.2 +185200 MOVE "SUB-TEST-F1-31-6" TO PAR-NAME. NC1064.2 +185300 IF WRK-DS-16V2-1 = -9999999999999999.99 PERFORM PASS NC1064.2 +185400 PERFORM PRINT-DETAIL ELSE NC1064.2 +185500 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +185600 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +185700 MOVE "-9999999999999999.99" TO CORRECT-A NC1064.2 +185800 PERFORM PRINT-DETAIL. NC1064.2 +185900 ADD 1 TO REC-CT. NC1064.2 +186000 SUB-TEST-F1-31-7. NC1064.2 +186100 MOVE "SUB-TEST-F1-31-7" TO PAR-NAME. NC1064.2 +186200 IF SIZE-ERR2 = SPACE NC1064.2 +186300 PERFORM PASS NC1064.2 +186400 PERFORM PRINT-DETAIL NC1064.2 +186500 ELSE NC1064.2 +186600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +186700 TO RE-MARK NC1064.2 +186800 MOVE SPACE TO CORRECT-X NC1064.2 +186900 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +187000 PERFORM FAIL NC1064.2 +187100 PERFORM PRINT-DETAIL. NC1064.2 +187200* NC1064.2 +187300 SUB-INIT-F1-32. NC1064.2 +187400* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +187500* ==--> NO SIZE ERROR <--== NC1064.2 +187600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +187700 MOVE "SUB-TEST-F1-32" TO PAR-NAME. NC1064.2 +187800 MOVE ZERO TO REC-CT. NC1064.2 +187900 MOVE SPACE TO SIZE-ERR2. NC1064.2 +188000 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +188100 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +188200 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +188300 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +188400 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +188500 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +188600 MOVE -8888888888888888.88 TO WRK-DS-16V2-1. NC1064.2 +188700 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +188800 SUB-TEST-F1-32-0. NC1064.2 +188900 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +189000 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +189100 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +189200 ON SIZE ERROR NC1064.2 +189300 MOVE "Z" TO SIZE-ERR2 NC1064.2 +189400 NOT ON SIZE ERROR NC1064.2 +189500 MOVE "A" TO SIZE-ERR2. NC1064.2 +189600 GO TO SUB-TEST-F1-32-1. NC1064.2 +189700 SUB-DELETE-F1-32. NC1064.2 +189800 PERFORM DE-LETE. NC1064.2 +189900 PERFORM PRINT-DETAIL. NC1064.2 +190000 GO TO SUB-INIT-F1-33. NC1064.2 +190100 SUB-TEST-F1-32-1. NC1064.2 +190200 MOVE "SUB-TEST-F1-32-1" TO PAR-NAME. NC1064.2 +190300 MOVE 1 TO REC-CT. NC1064.2 +190400 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +190500 ELSE NC1064.2 +190600 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +190700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +190800 ADD 1 TO REC-CT. NC1064.2 +190900 SUB-TEST-F1-32-2. NC1064.2 +191000 MOVE "SUB-TEST-F1-32-2" TO PAR-NAME. NC1064.2 +191100 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +191200 ELSE NC1064.2 +191300 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +191400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +191500 ADD 1 TO REC-CT. NC1064.2 +191600 SUB-TEST-F1-32-3. NC1064.2 +191700 MOVE "SUB-TEST-F1-32-3" TO PAR-NAME. NC1064.2 +191800 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +191900 ELSE NC1064.2 +192000 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +192100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +192200 ADD 1 TO REC-CT. NC1064.2 +192300 SUB-TEST-F1-32-4. NC1064.2 +192400 MOVE "SUB-TEST-F1-32-4" TO PAR-NAME. NC1064.2 +192500 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +192600 ELSE NC1064.2 +192700 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +192800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +192900 ADD 1 TO REC-CT. NC1064.2 +193000 SUB-TEST-F1-32-5. NC1064.2 +193100 MOVE "SUB-TEST-F1-32-5" TO PAR-NAME. NC1064.2 +193200 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +193300 PERFORM PRINT-DETAIL ELSE NC1064.2 +193400 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +193500 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +193600 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +193700 ADD 1 TO REC-CT. NC1064.2 +193800 SUB-TEST-F1-32-6. NC1064.2 +193900 MOVE "SUB-TEST-F1-32-6" TO PAR-NAME. NC1064.2 +194000 IF WRK-DS-16V2-1 = -8888888888888901.22 PERFORM PASS NC1064.2 +194100 PERFORM PRINT-DETAIL ELSE NC1064.2 +194200 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +194300 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +194400 MOVE "-8888888888888901.22" TO CORRECT-A NC1064.2 +194500 PERFORM PRINT-DETAIL. NC1064.2 +194600 ADD 1 TO REC-CT. NC1064.2 +194700 SUB-TEST-F1-32-7. NC1064.2 +194800 MOVE "SUB-TEST-F1-32-7" TO PAR-NAME. NC1064.2 +194900 IF SIZE-ERR2 = "A" NC1064.2 +195000 PERFORM PASS NC1064.2 +195100 PERFORM PRINT-DETAIL NC1064.2 +195200 ELSE NC1064.2 +195300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +195400 TO RE-MARK NC1064.2 +195500 MOVE "A" TO CORRECT-X NC1064.2 +195600 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +195700 PERFORM FAIL NC1064.2 +195800 PERFORM PRINT-DETAIL. NC1064.2 +195900* NC1064.2 +196000 SUB-INIT-F1-33. NC1064.2 +196100* ==--> MULTIPLE RESULT FIELDS <--== NC1064.2 +196200* ==--> SIZE ERROR <--== NC1064.2 +196300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1064.2 +196400 MOVE "SUB-TEST-F1-33" TO PAR-NAME. NC1064.2 +196500 MOVE ZERO TO REC-CT. NC1064.2 +196600 MOVE SPACE TO SIZE-ERR2. NC1064.2 +196700 MOVE 10 TO WRK-DU-2V0-1. NC1064.2 +196800 MOVE .3 TO WRK-DU-0V1-1. NC1064.2 +196900 MOVE 12.34 TO WRK-DU-2V2-1. NC1064.2 +197000 MOVE ZERO TO WRK-DS-2V2-1. NC1064.2 +197100 MOVE -12.34 TO WRK-DS-2V2-2. NC1064.2 +197200 MOVE 22.33 TO WRK-DU-2V2-2. NC1064.2 +197300 MOVE -9999999999999999.99 TO WRK-DS-16V2-1. NC1064.2 +197400 MOVE 9999999999999999.99 TO WRK-DU-16V2-1. NC1064.2 +197500 SUB-TEST-F1-33-0. NC1064.2 +197600 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DU-2V2-1 NC1064.2 +197700 WRK-DS-2V2-1 ROUNDED WRK-DS-2V2-2 WRK-DU-2V2-2 NC1064.2 +197800 ROUNDED WRK-DU-16V2-1 WRK-DS-16V2-1 NC1064.2 +197900 ON SIZE ERROR NC1064.2 +198000 MOVE "A" TO SIZE-ERR2 NC1064.2 +198100 NOT ON SIZE ERROR NC1064.2 +198200 MOVE "Z" TO SIZE-ERR2. NC1064.2 +198300 GO TO SUB-TEST-F1-33-1. NC1064.2 +198400 SUB-DELETE-F1-33. NC1064.2 +198500 PERFORM DE-LETE. NC1064.2 +198600 PERFORM PRINT-DETAIL. NC1064.2 +198700 GO TO SUB-INIT-F1-34. NC1064.2 +198800 SUB-TEST-F1-33-1. NC1064.2 +198900 MOVE "SUB-TEST-F1-33-1" TO PAR-NAME. NC1064.2 +199000 MOVE 1 TO REC-CT. NC1064.2 +199100 IF WRK-DU-2V2-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +199200 ELSE NC1064.2 +199300 PERFORM FAIL MOVE WRK-DU-2V2-1 TO COMPUTED-N MOVE ZERO NC1064.2 +199400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +199500 ADD 1 TO REC-CT. NC1064.2 +199600 SUB-TEST-F1-33-2. NC1064.2 +199700 MOVE "SUB-TEST-F1-33-2" TO PAR-NAME. NC1064.2 +199800 IF WRK-DS-2V2-1 = -12.34 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +199900 ELSE NC1064.2 +200000 PERFORM FAIL MOVE WRK-DS-2V2-1 TO COMPUTED-N MOVE -12.34 NC1064.2 +200100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +200200 ADD 1 TO REC-CT. NC1064.2 +200300 SUB-TEST-F1-33-3. NC1064.2 +200400 MOVE "SUB-TEST-F1-33-3" TO PAR-NAME. NC1064.2 +200500 IF WRK-DS-2V2-2 = -24.68 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +200600 ELSE NC1064.2 +200700 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE -24.68 NC1064.2 +200800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +200900 ADD 1 TO REC-CT. NC1064.2 +201000 SUB-TEST-F1-33-4. NC1064.2 +201100 MOVE "SUB-TEST-F1-33-4" TO PAR-NAME. NC1064.2 +201200 IF WRK-DU-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1064.2 +201300 ELSE NC1064.2 +201400 PERFORM FAIL MOVE WRK-DU-2V2-2 TO COMPUTED-N MOVE 09.99 NC1064.2 +201500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1064.2 +201600 ADD 1 TO REC-CT. NC1064.2 +201700 SUB-TEST-F1-33-5. NC1064.2 +201800 MOVE "SUB-TEST-F1-33-5" TO PAR-NAME. NC1064.2 +201900 IF WRK-DU-16V2-1 = 9999999999999987.65 PERFORM PASS NC1064.2 +202000 PERFORM PRINT-DETAIL ELSE NC1064.2 +202100 PERFORM FAIL MOVE WRK-DU-16V2-1 TO WRK-NE-X-1 NC1064.2 +202200 MOVE WRK-NE-X-1 TO COMPUTED-A NC1064.2 +202300 MOVE "9999999999999987.65" TO CORRECT-A PERFORM PRINT-DETAIL.NC1064.2 +202400 ADD 1 TO REC-CT. NC1064.2 +202500 SUB-TEST-F1-33-6. NC1064.2 +202600 MOVE "SUB-TEST-F1-33-6" TO PAR-NAME. NC1064.2 +202700 IF WRK-DS-16V2-1 = -9999999999999999.99 PERFORM PASS NC1064.2 +202800 PERFORM PRINT-DETAIL ELSE NC1064.2 +202900 PERFORM FAIL MOVE WRK-DS-16V2-1 TO WRK-NE-X-2 NC1064.2 +203000 MOVE WRK-NE-X-2 TO COMPUTED-A NC1064.2 +203100 MOVE "-9999999999999999.99" TO CORRECT-A NC1064.2 +203200 PERFORM PRINT-DETAIL. NC1064.2 +203300 ADD 1 TO REC-CT. NC1064.2 +203400 SUB-TEST-F1-33-7. NC1064.2 +203500 MOVE "SUB-TEST-F1-33-7" TO PAR-NAME. NC1064.2 +203600 IF SIZE-ERR2 = "A" NC1064.2 +203700 PERFORM PASS NC1064.2 +203800 PERFORM PRINT-DETAIL NC1064.2 +203900 ELSE NC1064.2 +204000 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +204100 TO RE-MARK NC1064.2 +204200 MOVE "A" TO CORRECT-X NC1064.2 +204300 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +204400 PERFORM FAIL NC1064.2 +204500 PERFORM PRINT-DETAIL. NC1064.2 +204600* NC1064.2 +204700 SUB-INIT-F1-34. NC1064.2 +204800* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1064.2 +204900* ==--> SIZE ERROR <--== NC1064.2 +205000 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +205100 MOVE -11 TO WRK-DS-02V00. NC1064.2 +205200 MOVE SPACE TO WRK-XN-00001. NC1064.2 +205300 MOVE SPACE TO SIZE-ERR2. NC1064.2 +205400 MOVE SPACE TO SIZE-ERR3. NC1064.2 +205500 MOVE SPACE TO SIZE-ERR4. NC1064.2 +205600 MOVE 1 TO REC-CT. NC1064.2 +205700 SUB-TEST-F1-34-0. NC1064.2 +205800 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +205900 ON SIZE ERROR NC1064.2 +206000 MOVE "1" TO WRK-XN-00001 NC1064.2 +206100 MOVE "A" TO SIZE-ERR2 NC1064.2 +206200 MOVE "B" TO SIZE-ERR3 NC1064.2 +206300 END-SUBTRACT NC1064.2 +206400 MOVE "C" TO SIZE-ERR4. NC1064.2 +206500 GO TO SUB-TEST-F1-34-1. NC1064.2 +206600 SUB-DELETE-F1-34. NC1064.2 +206700 PERFORM DE-LETE. NC1064.2 +206800 PERFORM PRINT-DETAIL. NC1064.2 +206900 GO TO SUB-INIT-F1-35. NC1064.2 +207000 SUB-TEST-F1-34-1. NC1064.2 +207100 MOVE "SUB-TEST-F1-34-1" TO PAR-NAME. NC1064.2 +207200 IF WRK-XN-00001 = "1" NC1064.2 +207300 PERFORM PASS NC1064.2 +207400 PERFORM PRINT-DETAIL NC1064.2 +207500 ELSE NC1064.2 +207600 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +207700 TO RE-MARK NC1064.2 +207800 MOVE "1" TO CORRECT-X NC1064.2 +207900 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +208000 PERFORM FAIL NC1064.2 +208100 PERFORM PRINT-DETAIL. NC1064.2 +208200 ADD 1 TO REC-CT. NC1064.2 +208300 SUB-TEST-F1-34-2. NC1064.2 +208400 MOVE "SUB-TEST-F1-34-2" TO PAR-NAME. NC1064.2 +208500 IF SIZE-ERR2 = "A" NC1064.2 +208600 PERFORM PASS NC1064.2 +208700 PERFORM PRINT-DETAIL NC1064.2 +208800 ELSE NC1064.2 +208900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +209000 TO RE-MARK NC1064.2 +209100 MOVE "A" TO CORRECT-X NC1064.2 +209200 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +209300 PERFORM FAIL NC1064.2 +209400 PERFORM PRINT-DETAIL. NC1064.2 +209500 ADD 1 TO REC-CT. NC1064.2 +209600 SUB-TEST-F1-34-3. NC1064.2 +209700 MOVE "SUB-TEST-F1-34-3" TO PAR-NAME. NC1064.2 +209800 IF SIZE-ERR3 = "B" NC1064.2 +209900 PERFORM PASS NC1064.2 +210000 PERFORM PRINT-DETAIL NC1064.2 +210100 ELSE NC1064.2 +210200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +210300 TO RE-MARK NC1064.2 +210400 MOVE "B" TO CORRECT-X NC1064.2 +210500 MOVE SIZE-ERR3 TO COMPUTED-X NC1064.2 +210600 PERFORM FAIL NC1064.2 +210700 PERFORM PRINT-DETAIL. NC1064.2 +210800 ADD 1 TO REC-CT. NC1064.2 +210900 SUB-TEST-F1-34-4. NC1064.2 +211000 MOVE "SUB-TEST-F1-34-4" TO PAR-NAME. NC1064.2 +211100 IF SIZE-ERR4 = "C" NC1064.2 +211200 PERFORM PASS NC1064.2 +211300 PERFORM PRINT-DETAIL NC1064.2 +211400 ELSE NC1064.2 +211500 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +211600 TO RE-MARK NC1064.2 +211700 MOVE "C" TO CORRECT-X NC1064.2 +211800 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +211900 PERFORM FAIL NC1064.2 +212000 PERFORM PRINT-DETAIL. NC1064.2 +212100 ADD 1 TO REC-CT. NC1064.2 +212200 SUB-TEST-F1-34-5. NC1064.2 +212300 MOVE "SUB-TEST-F1-34-5" TO PAR-NAME. NC1064.2 +212400 IF WRK-DS-02V00 = -11 NC1064.2 +212500 PERFORM PASS NC1064.2 +212600 PERFORM PRINT-DETAIL NC1064.2 +212700 ELSE NC1064.2 +212800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +212900 TO RE-MARK NC1064.2 +213000 MOVE -11 TO CORRECT-N NC1064.2 +213100 MOVE WRK-DS-02V00 TO COMPUTED-N NC1064.2 +213200 PERFORM FAIL NC1064.2 +213300 PERFORM PRINT-DETAIL. NC1064.2 +213400* NC1064.2 +213500 SUB-INIT-F1-35. NC1064.2 +213600* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +213700 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +213800 MOVE "SUB-TEST-F1-35" TO PAR-NAME. NC1064.2 +213900 MOVE SPACE TO WRK-XN-00001. NC1064.2 +214000 MOVE SPACE TO SIZE-ERR2. NC1064.2 +214100 MOVE SPACE TO SIZE-ERR3. NC1064.2 +214200 MOVE SPACE TO SIZE-ERR4. NC1064.2 +214300 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +214400 MOVE 1 TO REC-CT. NC1064.2 +214500 SUB-TEST-F1-35-0. NC1064.2 +214600 SUBTRACT A12THREES-DS-06V06 NC1064.2 +214700 333333 NC1064.2 +214800 A06THREES-DS-03V03 NC1064.2 +214900 -0000009 NC1064.2 +215000 FROM WRK-DS-06V06 ROUNDED NC1064.2 +215100 ON SIZE ERROR NC1064.2 +215200 MOVE "1" TO WRK-XN-00001 NC1064.2 +215300 MOVE "A" TO SIZE-ERR2 NC1064.2 +215400 MOVE "B" TO SIZE-ERR3 NC1064.2 +215500 END-SUBTRACT NC1064.2 +215600 MOVE "C" TO SIZE-ERR4. NC1064.2 +215700 GO TO SUB-TEST-F1-35-1. NC1064.2 +215800 SUB-DELETE-F1-35. NC1064.2 +215900 PERFORM DE-LETE. NC1064.2 +216000 PERFORM PRINT-DETAIL. NC1064.2 +216100 GO TO SUB-INIT-F1-36. NC1064.2 +216200 SUB-TEST-F1-35-1. NC1064.2 +216300 MOVE "SUB-TEST-F1-35-1" TO PAR-NAME. NC1064.2 +216400 IF WRK-XN-00001 = SPACE NC1064.2 +216500 PERFORM PASS NC1064.2 +216600 PERFORM PRINT-DETAIL NC1064.2 +216700 ELSE NC1064.2 +216800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +216900 TO RE-MARK NC1064.2 +217000 MOVE SPACE TO CORRECT-X NC1064.2 +217100 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +217200 PERFORM FAIL NC1064.2 +217300 PERFORM PRINT-DETAIL. NC1064.2 +217400 ADD 1 TO REC-CT. NC1064.2 +217500 SUB-TEST-F1-35-2. NC1064.2 +217600 MOVE "SUB-TEST-F1-35-2" TO PAR-NAME. NC1064.2 +217700 IF SIZE-ERR2 = SPACE NC1064.2 +217800 PERFORM PASS NC1064.2 +217900 PERFORM PRINT-DETAIL NC1064.2 +218000 ELSE NC1064.2 +218100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +218200 TO RE-MARK NC1064.2 +218300 MOVE SPACE TO CORRECT-X NC1064.2 +218400 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +218500 PERFORM FAIL NC1064.2 +218600 PERFORM PRINT-DETAIL. NC1064.2 +218700 ADD 1 TO REC-CT. NC1064.2 +218800 SUB-TEST-F1-35-3. NC1064.2 +218900 MOVE "SUB-TEST-F1-35-3" TO PAR-NAME. NC1064.2 +219000 IF SIZE-ERR3 = SPACE NC1064.2 +219100 PERFORM PASS NC1064.2 +219200 PERFORM PRINT-DETAIL NC1064.2 +219300 ELSE NC1064.2 +219400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +219500 TO RE-MARK NC1064.2 +219600 MOVE SPACE TO CORRECT-X NC1064.2 +219700 MOVE SIZE-ERR3 TO COMPUTED-X NC1064.2 +219800 PERFORM FAIL NC1064.2 +219900 PERFORM PRINT-DETAIL. NC1064.2 +220000 ADD 1 TO REC-CT. NC1064.2 +220100 SUB-TEST-F1-35-4. NC1064.2 +220200 MOVE "SUB-TEST-F1-35-4" TO PAR-NAME. NC1064.2 +220300 IF SIZE-ERR4 = "C" NC1064.2 +220400 PERFORM PASS NC1064.2 +220500 PERFORM PRINT-DETAIL NC1064.2 +220600 ELSE NC1064.2 +220700 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +220800 TO RE-MARK NC1064.2 +220900 MOVE "C" TO CORRECT-X NC1064.2 +221000 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +221100 PERFORM FAIL NC1064.2 +221200 PERFORM PRINT-DETAIL. NC1064.2 +221300 ADD 1 TO REC-CT. NC1064.2 +221400 SUB-TEST-F1-35-5. NC1064.2 +221500 MOVE "SUB-TEST-F1-35-5" TO PAR-NAME. NC1064.2 +221600 IF WRK-DS-06V06 = -666990.666333 NC1064.2 +221700 PERFORM PASS NC1064.2 +221800 PERFORM PRINT-DETAIL NC1064.2 +221900 ELSE NC1064.2 +222000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +222100 TO RE-MARK NC1064.2 +222200 MOVE -666990.666333 TO CORRECT-N NC1064.2 +222300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1064.2 +222400 PERFORM FAIL NC1064.2 +222500 PERFORM PRINT-DETAIL. NC1064.2 +222600* NC1064.2 +222700 SUB-INIT-F1-36. NC1064.2 +222800* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +222900 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +223000 MOVE "SUB-TEST-F1-36" TO PAR-NAME. NC1064.2 +223100 MOVE SPACE TO WRK-XN-00001. NC1064.2 +223200 MOVE SPACE TO SIZE-ERR2. NC1064.2 +223300 MOVE SPACE TO SIZE-ERR3. NC1064.2 +223400 MOVE SPACE TO SIZE-ERR4. NC1064.2 +223500 MOVE -11 TO WRK-DS-02V00. NC1064.2 +223600 MOVE 1 TO REC-CT. NC1064.2 +223700 SUB-TEST-F1-36-0. NC1064.2 +223800 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +223900 NOT ON SIZE ERROR NC1064.2 +224000 MOVE "1" TO WRK-XN-00001 NC1064.2 +224100 MOVE "A" TO SIZE-ERR2 NC1064.2 +224200 MOVE "B" TO SIZE-ERR3 NC1064.2 +224300 END-SUBTRACT NC1064.2 +224400 MOVE "C" TO SIZE-ERR4. NC1064.2 +224500 GO TO SUB-TEST-F1-36-1. NC1064.2 +224600 SUB-DELETE-F1-36. NC1064.2 +224700 PERFORM DE-LETE. NC1064.2 +224800 PERFORM PRINT-DETAIL. NC1064.2 +224900 GO TO SUB-INIT-F1-37. NC1064.2 +225000 SUB-TEST-F1-36-1. NC1064.2 +225100 MOVE "SUB-TEST-F1-36-1" TO PAR-NAME. NC1064.2 +225200 IF WRK-XN-00001 = SPACE NC1064.2 +225300 PERFORM PASS NC1064.2 +225400 PERFORM PRINT-DETAIL NC1064.2 +225500 ELSE NC1064.2 +225600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +225700 TO RE-MARK NC1064.2 +225800 MOVE SPACE TO CORRECT-X NC1064.2 +225900 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +226000 PERFORM FAIL NC1064.2 +226100 PERFORM PRINT-DETAIL. NC1064.2 +226200 ADD 1 TO REC-CT. NC1064.2 +226300 SUB-TEST-F1-36-2. NC1064.2 +226400 MOVE "SUB-TEST-F1-36-2" TO PAR-NAME. NC1064.2 +226500 IF SIZE-ERR2 = SPACE NC1064.2 +226600 PERFORM PASS NC1064.2 +226700 PERFORM PRINT-DETAIL NC1064.2 +226800 ELSE NC1064.2 +226900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +227000 TO RE-MARK NC1064.2 +227100 MOVE SPACE TO CORRECT-X NC1064.2 +227200 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +227300 PERFORM FAIL NC1064.2 +227400 PERFORM PRINT-DETAIL. NC1064.2 +227500 ADD 1 TO REC-CT. NC1064.2 +227600 SUB-TEST-F1-36-3. NC1064.2 +227700 MOVE "SUB-TEST-F1-36-3" TO PAR-NAME. NC1064.2 +227800 IF SIZE-ERR3 = SPACE NC1064.2 +227900 PERFORM PASS NC1064.2 +228000 PERFORM PRINT-DETAIL NC1064.2 +228100 ELSE NC1064.2 +228200 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1064.2 +228300 TO RE-MARK NC1064.2 +228400 MOVE SPACE TO CORRECT-X NC1064.2 +228500 MOVE SIZE-ERR3 TO COMPUTED-X NC1064.2 +228600 PERFORM FAIL NC1064.2 +228700 PERFORM PRINT-DETAIL NC1064.2 +228800 ADD 1 TO REC-CT. NC1064.2 +228900 SUB-TEST-F1-36-4. NC1064.2 +229000 MOVE "SUB-TEST-F1-36-4" TO PAR-NAME. NC1064.2 +229100 IF SIZE-ERR4 = "C" NC1064.2 +229200 PERFORM PASS NC1064.2 +229300 PERFORM PRINT-DETAIL NC1064.2 +229400 ELSE NC1064.2 +229500 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +229600 TO RE-MARK NC1064.2 +229700 MOVE "C" TO CORRECT-X NC1064.2 +229800 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +229900 PERFORM FAIL NC1064.2 +230000 PERFORM PRINT-DETAIL. NC1064.2 +230100 ADD 1 TO REC-CT. NC1064.2 +230200 SUB-TEST-F1-36-5. NC1064.2 +230300 MOVE "SUB-TEST-F1-36-5" TO PAR-NAME. NC1064.2 +230400 IF WRK-DS-02V00 = -11 NC1064.2 +230500 PERFORM PASS NC1064.2 +230600 PERFORM PRINT-DETAIL NC1064.2 +230700 ELSE NC1064.2 +230800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +230900 TO RE-MARK NC1064.2 +231000 MOVE -11 TO CORRECT-N NC1064.2 +231100 MOVE WRK-DS-02V00 TO COMPUTED-N NC1064.2 +231200 PERFORM FAIL NC1064.2 +231300 PERFORM PRINT-DETAIL. NC1064.2 +231400* NC1064.2 +231500 SUB-INIT-F1-37. NC1064.2 +231600* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +231700 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +231800 MOVE "SUB-TEST-F1-37" TO PAR-NAME. NC1064.2 +231900 MOVE SPACE TO WRK-XN-00001. NC1064.2 +232000 MOVE SPACE TO SIZE-ERR2. NC1064.2 +232100 MOVE SPACE TO SIZE-ERR3. NC1064.2 +232200 MOVE SPACE TO SIZE-ERR4. NC1064.2 +232300 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +232400 MOVE 1 TO REC-CT. NC1064.2 +232500 SUB-TEST-F1-37-0. NC1064.2 +232600 SUBTRACT A12THREES-DS-06V06 NC1064.2 +232700 333333 NC1064.2 +232800 A06THREES-DS-03V03 NC1064.2 +232900 -0000009 NC1064.2 +233000 FROM WRK-DS-06V06 ROUNDED NC1064.2 +233100 NOT ON SIZE ERROR NC1064.2 +233200 MOVE "1" TO WRK-XN-00001 NC1064.2 +233300 MOVE "A" TO SIZE-ERR2 NC1064.2 +233400 MOVE "B" TO SIZE-ERR3 NC1064.2 +233500 END-SUBTRACT NC1064.2 +233600 MOVE "C" TO SIZE-ERR4. NC1064.2 +233700 GO TO SUB-TEST-F1-37-1. NC1064.2 +233800 SUB-DELETE-F1-37. NC1064.2 +233900 PERFORM DE-LETE. NC1064.2 +234000 PERFORM PRINT-DETAIL. NC1064.2 +234100 GO TO SUB-INIT-F1-38. NC1064.2 +234200 SUB-TEST-F1-37-1. NC1064.2 +234300 MOVE "SUB-TEST-F1-37-1" TO PAR-NAME. NC1064.2 +234400 IF WRK-XN-00001 = "1" NC1064.2 +234500 PERFORM PASS NC1064.2 +234600 PERFORM PRINT-DETAIL NC1064.2 +234700 ELSE NC1064.2 +234800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +234900 TO RE-MARK NC1064.2 +235000 MOVE "1" TO CORRECT-X NC1064.2 +235100 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +235200 PERFORM FAIL NC1064.2 +235300 PERFORM PRINT-DETAIL. NC1064.2 +235400 ADD 1 TO REC-CT. NC1064.2 +235500 SUB-TEST-F1-37-2. NC1064.2 +235600 MOVE "SUB-TEST-F1-37-2" TO PAR-NAME. NC1064.2 +235700 IF SIZE-ERR2 = "A" NC1064.2 +235800 PERFORM PASS NC1064.2 +235900 PERFORM PRINT-DETAIL NC1064.2 +236000 ELSE NC1064.2 +236100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +236200 TO RE-MARK NC1064.2 +236300 MOVE "A" TO CORRECT-X NC1064.2 +236400 MOVE SIZE-ERR2 TO COMPUTED-X NC1064.2 +236500 PERFORM FAIL NC1064.2 +236600 PERFORM PRINT-DETAIL. NC1064.2 +236700 ADD 1 TO REC-CT. NC1064.2 +236800 SUB-TEST-F1-37-3. NC1064.2 +236900 MOVE "SUB-TEST-F1-37-3" TO PAR-NAME. NC1064.2 +237000 IF SIZE-ERR3 = "B" NC1064.2 +237100 PERFORM PASS NC1064.2 +237200 PERFORM PRINT-DETAIL NC1064.2 +237300 ELSE NC1064.2 +237400 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +237500 TO RE-MARK NC1064.2 +237600 MOVE "B" TO CORRECT-X NC1064.2 +237700 MOVE SIZE-ERR3 TO COMPUTED-X NC1064.2 +237800 PERFORM FAIL NC1064.2 +237900 PERFORM PRINT-DETAIL. NC1064.2 +238000 ADD 1 TO REC-CT. NC1064.2 +238100 SUB-TEST-F1-37-4. NC1064.2 +238200 MOVE "SUB-TEST-F1-37-4" TO PAR-NAME. NC1064.2 +238300 IF SIZE-ERR4 = "C" NC1064.2 +238400 PERFORM PASS NC1064.2 +238500 PERFORM PRINT-DETAIL NC1064.2 +238600 ELSE NC1064.2 +238700 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +238800 TO RE-MARK NC1064.2 +238900 MOVE "C" TO CORRECT-X NC1064.2 +239000 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +239100 PERFORM FAIL NC1064.2 +239200 PERFORM PRINT-DETAIL. NC1064.2 +239300 ADD 1 TO REC-CT. NC1064.2 +239400 SUB-TEST-F1-37-5. NC1064.2 +239500 MOVE "SUB-TEST-F1-37-5" TO PAR-NAME. NC1064.2 +239600 IF WRK-DS-06V06 = -666990.666333 NC1064.2 +239700 PERFORM PASS NC1064.2 +239800 PERFORM PRINT-DETAIL NC1064.2 +239900 ELSE NC1064.2 +240000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +240100 TO RE-MARK NC1064.2 +240200 MOVE -666990.666333 TO CORRECT-N NC1064.2 +240300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1064.2 +240400 PERFORM FAIL NC1064.2 +240500 PERFORM PRINT-DETAIL. NC1064.2 +240600* NC1064.2 +240700 SUB-INIT-F1-38. NC1064.2 +240800* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +240900 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +241000 MOVE "SUB-TEST-F1-38" TO PAR-NAME. NC1064.2 +241100 MOVE "0" TO WRK-XN-00001. NC1064.2 +241200 MOVE "0" TO SIZE-ERR4. NC1064.2 +241300 MOVE -11 TO WRK-DS-02V00. NC1064.2 +241400 MOVE 1 TO REC-CT. NC1064.2 +241500 SUB-TEST-F1-38-0. NC1064.2 +241600 SUBTRACT A99-DS-02V00 FROM WRK-DS-02V00 NC1064.2 +241700 ON SIZE ERROR NC1064.2 +241800 MOVE SPACE TO WRK-XN-00001 NC1064.2 +241900 NOT ON SIZE ERROR NC1064.2 +242000 MOVE "1" TO WRK-XN-00001 NC1064.2 +242100 END-SUBTRACT NC1064.2 +242200 MOVE "C" TO SIZE-ERR4. NC1064.2 +242300 GO TO SUB-TEST-F1-38-1. NC1064.2 +242400 SUB-DELETE-F1-38. NC1064.2 +242500 PERFORM DE-LETE. NC1064.2 +242600 PERFORM PRINT-DETAIL. NC1064.2 +242700 GO TO SUB-INIT-F1-39. NC1064.2 +242800 SUB-TEST-F1-38-1. NC1064.2 +242900 MOVE "SUB-TEST-F1-38-1" TO PAR-NAME. NC1064.2 +243000 IF WRK-XN-00001 = SPACE NC1064.2 +243100 PERFORM PASS NC1064.2 +243200 PERFORM PRINT-DETAIL NC1064.2 +243300 ELSE NC1064.2 +243400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +243500 TO RE-MARK NC1064.2 +243600 MOVE SPACE TO CORRECT-X NC1064.2 +243700 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +243800 PERFORM FAIL NC1064.2 +243900 PERFORM PRINT-DETAIL. NC1064.2 +244000 ADD 1 TO REC-CT. NC1064.2 +244100 SUB-TEST-F1-38-2. NC1064.2 +244200 MOVE "SUB-TEST-F1-38-2" TO PAR-NAME. NC1064.2 +244300 IF SIZE-ERR4 = "C" NC1064.2 +244400 PERFORM PASS NC1064.2 +244500 PERFORM PRINT-DETAIL NC1064.2 +244600 ELSE NC1064.2 +244700 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +244800 TO RE-MARK NC1064.2 +244900 MOVE "C" TO CORRECT-X NC1064.2 +245000 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +245100 PERFORM FAIL NC1064.2 +245200 PERFORM PRINT-DETAIL. NC1064.2 +245300 ADD 1 TO REC-CT. NC1064.2 +245400 SUB-TEST-F1-38-3. NC1064.2 +245500 MOVE "SUB-TEST-F1-38-3" TO PAR-NAME. NC1064.2 +245600 IF WRK-DS-02V00 = -11 NC1064.2 +245700 PERFORM PASS NC1064.2 +245800 PERFORM PRINT-DETAIL NC1064.2 +245900 ELSE NC1064.2 +246000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +246100 TO RE-MARK NC1064.2 +246200 MOVE -11 TO CORRECT-N NC1064.2 +246300 MOVE WRK-DS-02V00 TO COMPUTED-N NC1064.2 +246400 PERFORM FAIL NC1064.2 +246500 PERFORM PRINT-DETAIL. NC1064.2 +246600* NC1064.2 +246700 SUB-INIT-F1-39. NC1064.2 +246800* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1064.2 +246900 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1064.2 +247000 MOVE "SUB-TEST-F1-39" TO PAR-NAME. NC1064.2 +247100 MOVE SPACE TO WRK-XN-00001. NC1064.2 +247200 MOVE SPACE TO SIZE-ERR4. NC1064.2 +247300 MOVE ZERO TO WRK-DS-06V06. NC1064.2 +247400 MOVE 1 TO REC-CT. NC1064.2 +247500 SUB-TEST-F1-39-0. NC1064.2 +247600 SUBTRACT A12THREES-DS-06V06 NC1064.2 +247700 333333 NC1064.2 +247800 A06THREES-DS-03V03 NC1064.2 +247900 -0000009 NC1064.2 +248000 FROM WRK-DS-06V06 ROUNDED NC1064.2 +248100 ON SIZE ERROR NC1064.2 +248200 MOVE "X" TO WRK-XN-00001 NC1064.2 +248300 NOT ON SIZE ERROR NC1064.2 +248400 MOVE "1" TO WRK-XN-00001 NC1064.2 +248500 END-SUBTRACT NC1064.2 +248600 MOVE "C" TO SIZE-ERR4. NC1064.2 +248700 GO TO SUB-TEST-F1-39-1. NC1064.2 +248800 SUB-DELETE-F1-39. NC1064.2 +248900 PERFORM DE-LETE. NC1064.2 +249000 PERFORM PRINT-DETAIL. NC1064.2 +249100 GO TO CCVS-EXIT. NC1064.2 +249200 SUB-TEST-F1-39-1. NC1064.2 +249300 MOVE "SUB-TEST-F1-39-1" TO PAR-NAME. NC1064.2 +249400 IF WRK-XN-00001 = "1" NC1064.2 +249500 PERFORM PASS NC1064.2 +249600 PERFORM PRINT-DETAIL NC1064.2 +249700 ELSE NC1064.2 +249800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1064.2 +249900 TO RE-MARK NC1064.2 +250000 MOVE "1" TO CORRECT-X NC1064.2 +250100 MOVE WRK-XN-00001 TO COMPUTED-X NC1064.2 +250200 PERFORM FAIL NC1064.2 +250300 PERFORM PRINT-DETAIL. NC1064.2 +250400 ADD 1 TO REC-CT. NC1064.2 +250500 SUB-TEST-F1-39-2. NC1064.2 +250600 MOVE "SUB-TEST-F1-39-2" TO PAR-NAME. NC1064.2 +250700 IF SIZE-ERR4 = "C" NC1064.2 +250800 PERFORM PASS NC1064.2 +250900 PERFORM PRINT-DETAIL NC1064.2 +251000 ELSE NC1064.2 +251100 MOVE "SCOPE TERMINATOR IGNORED" NC1064.2 +251200 TO RE-MARK NC1064.2 +251300 MOVE "C" TO CORRECT-X NC1064.2 +251400 MOVE SIZE-ERR4 TO COMPUTED-X NC1064.2 +251500 PERFORM FAIL NC1064.2 +251600 PERFORM PRINT-DETAIL. NC1064.2 +251700 ADD 1 TO REC-CT. NC1064.2 +251800 SUB-TEST-F1-39-3. NC1064.2 +251900 MOVE "SUB-TEST-F1-39-3" TO PAR-NAME. NC1064.2 +252000 IF WRK-DS-06V06 = -666990.666333 NC1064.2 +252100 PERFORM PASS NC1064.2 +252200 PERFORM PRINT-DETAIL NC1064.2 +252300 ELSE NC1064.2 +252400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1064.2 +252500 TO RE-MARK NC1064.2 +252600 MOVE -666990.666333 TO CORRECT-N NC1064.2 +252700 MOVE WRK-DS-06V06 TO COMPUTED-N NC1064.2 +252800 PERFORM FAIL NC1064.2 +252900 PERFORM PRINT-DETAIL. NC1064.2 +253000* NC1064.2 +253100 CCVS-EXIT SECTION. NC1064.2 +253200 CCVS-999999. NC1064.2 +253300 GO TO CLOSE-FILES. NC1064.2 diff --git a/tests/cobol85/NC/NC107A.CBL b/tests/cobol85/NC/NC107A.CBL new file mode 100755 index 00000000..113fff7c --- /dev/null +++ b/tests/cobol85/NC/NC107A.CBL @@ -0,0 +1,2033 @@ +000100 IDENTIFICATION DIVISION. NC1074.2 +000200 PROGRAM-ID. NC1074.2 +000300 NC107A. NC1074.2 +000400**************************************************************** NC1074.2 +000500* * NC1074.2 +000600* VALIDATION FOR:- * NC1074.2 +000700* * NC1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1074.2 +000900* * NC1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1074.2 +001100* * NC1074.2 +001200**************************************************************** NC1074.2 +001300* * NC1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1074.2 +001500* * NC1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1074.2 +001900* * NC1074.2 +002000**************************************************************** NC1074.2 +002100* NC1074.2 +002200* PROGRAM NC107A TESTS THE FOLLOWING FEATURES: NC1074.2 +002300* NC1074.2 +002400* FIGURATIVE CONSTANTS NC1074.2 +002500* CONTINUATION LINES NC1074.2 +002600* SEPARATORS NC1074.2 +002700* JUSTIFIED CLAUSE NC1074.2 +002800* SYNCHRONISED CLAUSE NC1074.2 +002900* BLANK WHEN ZERO CLAUSE NC1074.2 +003000* MAXIMUM LENGTH DATA-NAMES, LITERALS NC1074.2 +003100* AND PARAGRAPH-NAMES. NC1074.2 +003200* REDEFINES CLAUSE NC1074.2 +003300* USAGE CLAUSE NC1074.2 +003400* VALUE CLAUSE NC1074.2 +003500* CURRENCY SIGN CLAUSE NC1074.2 +003600* DECIMAL-POINT IS COMMA CLAUSE NC1074.2 +003700* NUMERIC PARAGRAPH NAMES NC1074.2 +003800* CONTINUE STATEMENT NC1074.2 +003900 NC1074.2 +004000 ENVIRONMENT DIVISION. NC1074.2 +004100 CONFIGURATION SECTION. NC1074.2 +004200 SOURCE-COMPUTER. NC1074.2 +004300 Linux. NC1074.2 +004400 OBJECT-COMPUTER. NC1074.2 +004500 Linux. NC1074.2 +004600 SPECIAL-NAMES. NC1074.2 +004700 CURRENCY SIGN IS "W" NC1074.2 +004800 DECIMAL-POINT IS COMMA. NC1074.2 +004900 INPUT-OUTPUT SECTION. NC1074.2 +005000 FILE-CONTROL. NC1074.2 +005100 SELECT PRINT-FILE ASSIGN TO NC1074.2 +005200 "report.log". NC1074.2 +005300 DATA DIVISION. NC1074.2 +005400 FILE SECTION. NC1074.2 +005500 FD PRINT-FILE. NC1074.2 +005600 01 PRINT-REC PICTURE X(120). NC1074.2 +005700 01 DUMMY-RECORD PICTURE X(120). NC1074.2 +005800 WORKING-STORAGE SECTION. NC1074.2 +005900 01 SUB1 PIC S9(3) COMP. NC1074.2 +006000 01 SUB2 PIC S9(3) COMP. NC1074.2 +006100 01 TAB-LOC. NC1074.2 +006200 03 FILLER PIC X(16) VALUE "TABLE LOCATION: ". NC1074.2 +006300 03 TAB1 PIC ZZ9. NC1074.2 +006400 03 FILLER PIC XX VALUE ", ". NC1074.2 +006500 03 TAB2 PIC ZZ9. NC1074.2 +006600 77 DATA-A PICTURE IS X(10). NC1074.2 +006700 77 DATA-B PICTURE IS 9(5). NC1074.2 +006800 77 DATA-C PICTURE IS 9(5). NC1074.2 +006900 77 DATA-D PICTURE IS X(10) NC1074.2 +007000 JUSTIFIED RIGHT. NC1074.2 +007100 77 DATA-E PICTURE IS A(9) NC1074.2 +007200 JUSTIFIED. NC1074.2 +007300 77 DATA-F PICTURE IS 9(10) NC1074.2 +007400 BLANK WHEN ZERO. NC1074.2 +007500 77 DATA-G SYNCHRONIZED RIGHT PICTURE X(5) NC1074.2 +007600 VALUE IS "VWXYZ". NC1074.2 +007700 77 DATA-H PICTURE IS X(5) NC1074.2 +007800 VALUE IS "VWXYZ". NC1074.2 +007900 77 DATA-I PICTURE IS 9999 NC1074.2 +008000 VALUE IS 12. NC1074.2 +008100 77 DATA-J PICTURE IS WWWWW. NC1074.2 +008200 77 DATA-K PICTURE IS 9999999V99 NC1074.2 +008300 VALUE IS 1234567,89. NC1074.2 +008400 77 DATA-L PICTURE IS 9.999.999,99. NC1074.2 +008500 77 DATA-M PICTURE IS W9999 NC1074.2 +008600 BLANK WHEN ZERO. NC1074.2 +008700 77 DATA-N PICTURE IS X(16) NC1074.2 +008800 VALUE IS "4 SPACES ON LEFT". NC1074.2 +008900 77 DATA-O PICTURE IS X(20) NC1074.2 +009000 JUSTIFIED RIGHT. NC1074.2 +009100 77 DATA-P PICTURE 999 VALUE "000" BLANK WHEN ZERO. NC1074.2 +009200 77 DATA-P1 REDEFINES DATA-P PICTURE XXX. NC1074.2 +009300 77 DATA-Q VALUE "QUOTE IN COL. 72"NC1074.2 +009400 PICTURE X(16). NC1074.2 +009500 77 DATA-R VALUE "LITERAL ENDS AT 72NC1074.2 +009600- "" NC1074.2 +009700 PICTURE X(18). NC1074.2 +009800 77 DATA-S PICTURE X(20) VALUE "OFFSET NC1074.2 +009900- "CONTINUATION ". NC1074.2 +010000 77 DATA-T PICTURE X(20) VALUE "OFFSET CONTINUATION NC1074.2 +010100- "". NC1074.2 +010200 77 DATA-U PICTURE X(20) VALUE "OFFNC1074.2 +010300- "SETNC1074.2 +010400- " CONC1074.2 +010500- "NTINC1074.2 +010600- "NUANC1074.2 +010700- "TNC1074.2 +010800- "IONNC1074.2 +010900- " ".NC1074.2 +011000 77 DATA-V PICTURE X(20) VALUE SPACE. NC1074.2 +011100 77 DATA-W PICTURE X(20) VALUE NC1074.2 +011200 "OFFSET CONTINUATION ". NC1074.2 +011300 77 NUM-UTILITY PICTURE 9999 NC1074.2 +011400 VALUE ZERO. NC1074.2 +011500 01 WRK-XN-160-1 PIC X(160) VALUE NC1074.2 +011600 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +011700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +011800- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +011900- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +012000- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +012100- """""""""""""""""""""". NC1074.2 +012200 01 CHARACTER-BREAKDOWN-R. NC1074.2 +012300 02 FIRST-20R PICTURE X(20). NC1074.2 +012400 02 SECOND-20R PICTURE X(20). NC1074.2 +012500 02 THIRD-20R PICTURE X(20). NC1074.2 +012600 02 FOURTH-20R PICTURE X(20). NC1074.2 +012700 01 CHARACTER-BREAKDOWN-S. NC1074.2 +012800 02 FIRST-20S PICTURE X(20). NC1074.2 +012900 02 SECOND-20S PICTURE X(20). NC1074.2 +013000 02 THIRD-20S PICTURE X(20). NC1074.2 +013100 02 FOURTH-20S PICTURE X(20). NC1074.2 +013200 01 X80-CHARACTER-FIELD. NC1074.2 +013300 02 FILLER PICTURE X(80). NC1074.2 +013400 01 A-DATA-NAME-30-CHARACTERS-LONG PICTURE IS X. NC1074.2 +013500 01 LONG-PICTURE PICTURE IS NC1074.2 +013600 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. NC1074.2 +013700 01 LONG-NUMBER PICTURE 999999999V999999999 NC1074.2 +013800 VALUE IS 211113411,114311112. NC1074.2 +013900 01 LONG-LITERAL. NC1074.2 +014000 02 LONG20 PICTURE IS X(20) NC1074.2 +014100 VALUE IS "STANDARD COMPILERS M". NC1074.2 +014200 02 LONG40 PICTURE IS X(20) NC1074.2 +014300 VALUE IS "UST ALLOW NON-NUMERI". NC1074.2 +014400 02 LONG60 PICTURE IS X(20) NC1074.2 +014500 VALUE IS "C LITERALS OF AT LEA". NC1074.2 +014600 02 LONG80 PICTURE IS X(20) NC1074.2 +014700 VALUE IS "ST 120 CHARACTERS AN". NC1074.2 +014800 02 LONG100 PICTURE IS X(20) NC1074.2 +014900 VALUE IS "D NUMERIC LITERALS O". NC1074.2 +015000 02 LONG120 PICTURE IS X(20) NC1074.2 +015100 VALUE IS "F AT LEAST 18 DIGITS". NC1074.2 +015200 02 LONG140 PICTURE IS X(20) NC1074.2 +015300 VALUE IS " BUT NOW EXTENDED UP". NC1074.2 +015400 02 LONG160 PICTURE IS X(20) NC1074.2 +015500 VALUE IS "TO 160 DIGITS FOR 8X". NC1074.2 +015600 01 LONG-PICTURE-A PICTURE X(000000000000000020). NC1074.2 +015700 01 LONG-PICTURE-B PICTURE X(15) JUSTIFIED RIGHT. NC1074.2 +015800 01 LONG-PICTURE-C PICTURE X(000000000000000010). NC1074.2 +015900 01 REDEF1 PICTURE IS 9 VALUE IS 9. NC1074.2 +016000 01 REDEF2 REDEFINES REDEF1 PICTURE IS X. NC1074.2 +016100 01 REDEF3 PICTURE IS XXX NC1074.2 +016200 VALUE IS "ABC". NC1074.2 +016300 01 REDEF4 REDEFINES REDEF3 PICTURE IS A. NC1074.2 +016400 01 REDEF5 PICTURE IS X(6) NC1074.2 +016500 VALUE IS "UVWXYZ". NC1074.2 +016600 01 REDEF6 REDEFINES REDEF5 PICTURE IS 9(6). NC1074.2 +016700 01 REDEF7 REDEFINES REDEF5 PICTURE IS A(6). NC1074.2 +016800 01 REDEF8 REDEFINES REDEF5. NC1074.2 +016900 02 REDEF8X. NC1074.2 +017000 03 REDEF8A PICTURE IS XX. NC1074.2 +017100 03 REDEF8B PICTURE IS 99. NC1074.2 +017200 02 REDEF8C PICTURE IS AA. NC1074.2 +017300 01 REDEF9 REDEFINES REDEF5 PICTURE IS X(6). NC1074.2 +017400 01 REDEF10. NC1074.2 +017500 02 RDFDATA1 PICTURE X(10) VALUE "ABC98765DE".NC1074.2 +017600 02 RDFDATA2 PIC 9(4)V99 VALUE 9116,44. NC1074.2 +017700 02 RDFDATA3. NC1074.2 +017800 08 RDFDATA4 PICTURE X(6) VALUE "ALLDON". NC1074.2 +017900 08 RDFDATA5 PICTURE XX99 VALUE "XX66". NC1074.2 +018000 02 RDFDATA6 PICTURE A(20) VALUE NC1074.2 +018100 NC1074.2 +018200 "ZYXWVUTSRQPONMLKJIHG". NC1074.2 +018300 01 REDEF11 REDEFINES REDEF10. NC1074.2 +018400 02 RDFDATA7 PICTURE X(20). NC1074.2 +018500 02 RDF8. NC1074.2 +018600 03 RDFDATA8 OCCURS 36 TIMES PICTURE XX. NC1074.2 +018700 01 REDEF12 REDEFINES REDEF10. NC1074.2 +018800 02 RDFDATA9 PICTURE A(3). NC1074.2 +018900 02 RDFDATA10 PICTURE 9(5). NC1074.2 +019000 02 RDFDATA11. NC1074.2 +019100 03 RDFDATA12. NC1074.2 +019200 04 RDFDATA13 PICTURE XX. NC1074.2 +019300 04 RDFDATA14 OCCURS 6 TIMES PICTURE 9. NC1074.2 +019400 03 RDFDATA15 PICTURE X(8). NC1074.2 +019500 02 RDFDATA16 PICTURE 99. NC1074.2 +019600 02 RDFDATA17 PICTURE X(80). NC1074.2 +019700 02 RDFDATA18 PICTURE X(14). NC1074.2 +019800 01 REDEF13. NC1074.2 +019900 02 FILLER PICTURE X(57) VALUE NC1074.2 +020000 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA". NC1074.2 +020100 02 FILLER PICTURE X(57) VALUE NC1074.2 +020200 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA". NC1074.2 +020300 02 FILLER PICTURE X(6) VALUE "AAAAAA". NC1074.2 +020400 01 REDEF20. NC1074.2 +020500 03 REDEF21 PICTURE X(10). NC1074.2 +020600 03 REDEF22 REDEFINES REDEF21 NC1074.2 +020700 PIC X(10). NC1074.2 +020800 03 REDEF23 REDEFINES REDEF21 NC1074.2 +020900 PIC X(9). NC1074.2 +021000 01 U1. NC1074.2 +021100 02 U2 PICTURE 9 USAGE IS NC1074.2 +021200 DISPLAY VALUE IS 9. NC1074.2 +021300 02 U3 PICTURE IS 9 USAGE IS NC1074.2 +021400 COMPUTATIONAL VALUE IS 9. NC1074.2 +021500 02 U4 PICTURE IS 9 USAGE IS NC1074.2 +021600 DISPLAY VALUE IS 9. NC1074.2 +021700 02 U5 USAGE IS COMPUTATIONAL. NC1074.2 +021800 03 U6 PICTURE IS 9 USAGE IS NC1074.2 +021900 COMPUTATIONAL VALUE IS 5. NC1074.2 +022000 03 U7 PICTURE IS 9 VALUE IS 6. NC1074.2 +022100 02 U8 PICTURE IS X. NC1074.2 +022200 01 U9 USAGE COMPUTATIONAL. NC1074.2 +022300 02 U10 PICTURE 9. NC1074.2 +022400 02 U11 PICTURE 9 COMPUTATIONAL. NC1074.2 +022500 01 U12. NC1074.2 +022600 02 U13 PICTURE 9 USAGE IS BINARY NC1074.2 +022700 VALUE 3. NC1074.2 +022800 02 U14 PICTURE 9 USAGE IS BINARY NC1074.2 +022900 VALUE 3. NC1074.2 +023000 01 U22. NC1074.2 +023100 02 U23 PICTURE 9 USAGE IS BINARY NC1074.2 +023200 VALUE 4. NC1074.2 +023300 02 U24 PICTURE 9 USAGE IS BINARY NC1074.2 +023400 VALUE 4. NC1074.2 +023500* NC1074.2 +023600* TWO-DIMENSIONAL TABLE USED IN VALUE CLAUSE: NC1074.2 +023700* NC1074.2 +023800 01 VALUE-TABLE. NC1074.2 +023900 03 VALUE-TABLE-1 OCCURS 10. NC1074.2 +024000 05 VALUE-TABLE-2 OCCURS 10 NC1074.2 +024100 PIC XX VALUE "AZ". NC1074.2 +024200* NC1074.2 +024300* NC1074.2 +024400 01 TEST-FIELD PIC X(10). NC1074.2 +024500* NC1074.2 +024600* NC1074.2 +024700 01 SEP-01. 02 SEP-02. 03 SEP-03. 04 SEP-04 PICTURE X(9) VALUE NC1074.2 +024800 "SEPARATOR". NC1074.2 +024900* NC1074.2 +025000* GROUP ITEMS USED IN JUSTIFIED TESTS. NC1074.2 +025100* NC1074.2 +025200 01 GROUP-TO-JUST-1. NC1074.2 +025300 02 FILLER PICTURE X VALUE "A". NC1074.2 +025400 02 FILLER PICTURE X VALUE "B". NC1074.2 +025500 02 FILLER PICTURE X VALUE "C". NC1074.2 +025600 01 GROUP-TO-JUST-2. NC1074.2 +025700 02 GROUP-TO-JUST-21. NC1074.2 +025800 03 FILLER PICTURE X(5) VALUE "ABCDE". NC1074.2 +025900 03 FILLER PICTURE X(2) VALUE "FG". NC1074.2 +026000 02 FILLER PICTURE X(8) VALUE "HIJKLMNO". NC1074.2 +026100 01 GROUP-FOR-JUST-TESTS. NC1074.2 +026200 02 NJUST-XN-3 PICTURE X(3) VALUE "ABC". NC1074.2 +026300 02 NJUST-XN-5 PICTURE X(5) VALUE "CDEFG". NC1074.2 +026400 02 NJUST-XN-15 PICTURE X(15) VALUE "ABCDEFGHIJKLMNO". NC1074.2 +026500* NC1074.2 +026600* DATA ITEMS WITH JUSTIFIED CLAUSE. NC1074.2 +026700* NC1074.2 +026800 01 XJ-00005 PICTURE X(5) JUSTIFIED RIGHT. NC1074.2 +026900 01 AJ-00005 PICTURE A(5) JUSTIFIED RIGHT. NC1074.2 +027000 01 XJ-00007 PICTURE X(7) JUST RIGHT. NC1074.2 +027100 01 AJ-00007 PICTURE A(7) JUSTIFIED. NC1074.2 +027200 01 GROUP-WITH-JUST-ITEMS. NC1074.2 +027300 02 XN-00005-NJUST PICTURE X(5). NC1074.2 +027400 02 XJ-00009 PICTURE X(9) JUST. NC1074.2 +027500 02 AJ-00009 PICTURE A(9) JUST. NC1074.2 +027600* NC1074.2 +027700* INITIALIZATION TAKES PLACE INDEPENDENT OF ANY NC1074.2 +027800* JUSTIFIED CLAUSE. NC1074.2 +027900* NC1074.2 +028000 01 XJ-00002 PICTURE X(2) JUST VALUE "AB". NC1074.2 +028100 01 XJ-00003 PICTURE X(3) JUST VALUE "XY". NC1074.2 +028200 01 TEST-RESULTS. NC1074.2 +028300 02 FILLER PIC X VALUE SPACE. NC1074.2 +028400 02 FEATURE PIC X(20) VALUE SPACE. NC1074.2 +028500 02 FILLER PIC X VALUE SPACE. NC1074.2 +028600 02 P-OR-F PIC X(5) VALUE SPACE. NC1074.2 +028700 02 FILLER PIC X VALUE SPACE. NC1074.2 +028800 02 PAR-NAME. NC1074.2 +028900 03 FILLER PIC X(19) VALUE SPACE. NC1074.2 +029000 03 PARDOT-X PIC X VALUE SPACE. NC1074.2 +029100 03 DOTVALUE PIC 99 VALUE ZERO. NC1074.2 +029200 02 FILLER PIC X(8) VALUE SPACE. NC1074.2 +029300 02 RE-MARK PIC X(61). NC1074.2 +029400 01 TEST-COMPUTED. NC1074.2 +029500 02 FILLER PIC X(30) VALUE SPACE. NC1074.2 +029600 02 FILLER PIC X(17) VALUE NC1074.2 +029700 " COMPUTED=". NC1074.2 +029800 02 COMPUTED-X. NC1074.2 +029900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1074.2 +030000 03 COMPUTED-N REDEFINES COMPUTED-A NC1074.2 +030100 PIC -9(9),9(9). NC1074.2 +030200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -,9(18). NC1074.2 +030300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4),9(14). NC1074.2 +030400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14),9(4). NC1074.2 +030500 03 CM-18V0 REDEFINES COMPUTED-A. NC1074.2 +030600 04 COMPUTED-18V0 PIC -9(18). NC1074.2 +030700 04 FILLER PIC X. NC1074.2 +030800 03 FILLER PIC X(50) VALUE SPACE. NC1074.2 +030900 01 TEST-CORRECT. NC1074.2 +031000 02 FILLER PIC X(30) VALUE SPACE. NC1074.2 +031100 02 FILLER PIC X(17) VALUE " CORRECT =". NC1074.2 +031200 02 CORRECT-X. NC1074.2 +031300 03 CORRECT-A PIC X(20) VALUE SPACE. NC1074.2 +031400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9),9(9). NC1074.2 +031500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -,9(18). NC1074.2 +031600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4),9(14). NC1074.2 +031700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14),9(4). NC1074.2 +031800 03 CR-18V0 REDEFINES CORRECT-A. NC1074.2 +031900 04 CORRECT-18V0 PIC -9(18). NC1074.2 +032000 04 FILLER PIC X. NC1074.2 +032100 03 FILLER PIC X(2) VALUE SPACE. NC1074.2 +032200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1074.2 +032300 01 CCVS-C-1. NC1074.2 +032400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1074.2 +032500- "SS PARAGRAPH-NAME NC1074.2 +032600- " REMARKS". NC1074.2 +032700 02 FILLER PIC X(20) VALUE SPACE. NC1074.2 +032800 01 CCVS-C-2. NC1074.2 +032900 02 FILLER PIC X VALUE SPACE. NC1074.2 +033000 02 FILLER PIC X(6) VALUE "TESTED". NC1074.2 +033100 02 FILLER PIC X(15) VALUE SPACE. NC1074.2 +033200 02 FILLER PIC X(4) VALUE "FAIL". NC1074.2 +033300 02 FILLER PIC X(94) VALUE SPACE. NC1074.2 +033400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1074.2 +033500 01 REC-CT PIC 99 VALUE ZERO. NC1074.2 +033600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1074.2 +033700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1074.2 +033800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1074.2 +033900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1074.2 +034000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1074.2 +034100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1074.2 +034200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1074.2 +034300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1074.2 +034400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1074.2 +034500 01 CCVS-H-1. NC1074.2 +034600 02 FILLER PIC X(39) VALUE SPACES. NC1074.2 +034700 02 FILLER PIC X(42) VALUE NC1074.2 +034800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1074.2 +034900 02 FILLER PIC X(39) VALUE SPACES. NC1074.2 +035000 01 CCVS-H-2A. NC1074.2 +035100 02 FILLER PIC X(40) VALUE SPACE. NC1074.2 +035200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1074.2 +035300 02 FILLER PIC XXXX VALUE NC1074.2 +035400 "4.2 ". NC1074.2 +035500 02 FILLER PIC X(28) VALUE NC1074.2 +035600 " COPY - NOT FOR DISTRIBUTION". NC1074.2 +035700 02 FILLER PIC X(41) VALUE SPACE. NC1074.2 +035800 NC1074.2 +035900 01 CCVS-H-2B. NC1074.2 +036000 02 FILLER PIC X(15) VALUE NC1074.2 +036100 "TEST RESULT OF ". NC1074.2 +036200 02 TEST-ID PIC X(9). NC1074.2 +036300 02 FILLER PIC X(4) VALUE NC1074.2 +036400 " IN ". NC1074.2 +036500 02 FILLER PIC X(12) VALUE NC1074.2 +036600 " HIGH ". NC1074.2 +036700 02 FILLER PIC X(22) VALUE NC1074.2 +036800 " LEVEL VALIDATION FOR ". NC1074.2 +036900 02 FILLER PIC X(58) VALUE NC1074.2 +037000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1074.2 +037100 01 CCVS-H-3. NC1074.2 +037200 02 FILLER PIC X(34) VALUE NC1074.2 +037300 " FOR OFFICIAL USE ONLY ". NC1074.2 +037400 02 FILLER PIC X(58) VALUE NC1074.2 +037500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1074.2 +037600 02 FILLER PIC X(28) VALUE NC1074.2 +037700 " COPYRIGHT 1985 ". NC1074.2 +037800 01 CCVS-E-1. NC1074.2 +037900 02 FILLER PIC X(52) VALUE SPACE. NC1074.2 +038000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1074.2 +038100 02 ID-AGAIN PIC X(9). NC1074.2 +038200 02 FILLER PIC X(45) VALUE SPACES. NC1074.2 +038300 01 CCVS-E-2. NC1074.2 +038400 02 FILLER PIC X(31) VALUE SPACE. NC1074.2 +038500 02 FILLER PIC X(21) VALUE SPACE. NC1074.2 +038600 02 CCVS-E-2-2. NC1074.2 +038700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1074.2 +038800 03 FILLER PIC X VALUE SPACE. NC1074.2 +038900 03 ENDER-DESC PIC X(44) VALUE NC1074.2 +039000 "ERRORS ENCOUNTERED". NC1074.2 +039100 01 CCVS-E-3. NC1074.2 +039200 02 FILLER PIC X(22) VALUE NC1074.2 +039300 " FOR OFFICIAL USE ONLY". NC1074.2 +039400 02 FILLER PIC X(12) VALUE SPACE. NC1074.2 +039500 02 FILLER PIC X(58) VALUE NC1074.2 +039600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1074.2 +039700 02 FILLER PIC X(13) VALUE SPACE. NC1074.2 +039800 02 FILLER PIC X(15) VALUE NC1074.2 +039900 " COPYRIGHT 1985". NC1074.2 +040000 01 CCVS-E-4. NC1074.2 +040100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1074.2 +040200 02 FILLER PIC X(4) VALUE " OF ". NC1074.2 +040300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1074.2 +040400 02 FILLER PIC X(40) VALUE NC1074.2 +040500 " TESTS WERE EXECUTED SUCCESSFULLY". NC1074.2 +040600 01 XXINFO. NC1074.2 +040700 02 FILLER PIC X(19) VALUE NC1074.2 +040800 "*** INFORMATION ***". NC1074.2 +040900 02 INFO-TEXT. NC1074.2 +041000 04 FILLER PIC X(8) VALUE SPACE. NC1074.2 +041100 04 XXCOMPUTED PIC X(20). NC1074.2 +041200 04 FILLER PIC X(5) VALUE SPACE. NC1074.2 +041300 04 XXCORRECT PIC X(20). NC1074.2 +041400 02 INF-ANSI-REFERENCE PIC X(48). NC1074.2 +041500 01 HYPHEN-LINE. NC1074.2 +041600 02 FILLER PIC IS X VALUE IS SPACE. NC1074.2 +041700 02 FILLER PIC IS X(65) VALUE IS "************************NC1074.2 +041800- "*****************************************". NC1074.2 +041900 02 FILLER PIC IS X(54) VALUE IS "************************NC1074.2 +042000- "******************************". NC1074.2 +042100 01 CCVS-PGM-ID PIC X(9) VALUE NC1074.2 +042200 "NC107A". NC1074.2 +042300 PROCEDURE DIVISION. NC1074.2 +042400 CCVS1 SECTION. NC1074.2 +042500 OPEN-FILES. NC1074.2 +042600 OPEN OUTPUT PRINT-FILE. NC1074.2 +042700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1074.2 +042800 MOVE SPACE TO TEST-RESULTS. NC1074.2 +042900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1074.2 +043000 GO TO CCVS1-EXIT. NC1074.2 +043100 CLOSE-FILES. NC1074.2 +043200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1074.2 +043300 TERMINATE-CCVS. NC1074.2 +043400*S EXIT PROGRAM. NC1074.2 +043500*SERMINATE-CALL. NC1074.2 +043600 STOP RUN. NC1074.2 +043700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1074.2 +043800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1074.2 +043900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1074.2 +044000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1074.2 +044100 MOVE "****TEST DELETED****" TO RE-MARK. NC1074.2 +044200 PRINT-DETAIL. NC1074.2 +044300 IF REC-CT NOT EQUAL TO ZERO NC1074.2 +044400 MOVE "." TO PARDOT-X NC1074.2 +044500 MOVE REC-CT TO DOTVALUE. NC1074.2 +044600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1074.2 +044700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1074.2 +044800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1074.2 +044900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1074.2 +045000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1074.2 +045100 MOVE SPACE TO CORRECT-X. NC1074.2 +045200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1074.2 +045300 MOVE SPACE TO RE-MARK. NC1074.2 +045400 HEAD-ROUTINE. NC1074.2 +045500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +045600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +045700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1074.2 +045800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1074.2 +045900 COLUMN-NAMES-ROUTINE. NC1074.2 +046000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +046100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +046200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +046300 END-ROUTINE. NC1074.2 +046400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1074.2 +046500 END-RTN-EXIT. NC1074.2 +046600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +046700 END-ROUTINE-1. NC1074.2 +046800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1074.2 +046900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1074.2 +047000 ADD PASS-COUNTER TO ERROR-HOLD. NC1074.2 +047100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1074.2 +047200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1074.2 +047300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1074.2 +047400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1074.2 +047500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1074.2 +047600 END-ROUTINE-12. NC1074.2 +047700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1074.2 +047800 IF ERROR-COUNTER IS EQUAL TO ZERO NC1074.2 +047900 MOVE "NO " TO ERROR-TOTAL NC1074.2 +048000 ELSE NC1074.2 +048100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1074.2 +048200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1074.2 +048300 PERFORM WRITE-LINE. NC1074.2 +048400 END-ROUTINE-13. NC1074.2 +048500 IF DELETE-COUNTER IS EQUAL TO ZERO NC1074.2 +048600 MOVE "NO " TO ERROR-TOTAL ELSE NC1074.2 +048700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1074.2 +048800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1074.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +049000 IF INSPECT-COUNTER EQUAL TO ZERO NC1074.2 +049100 MOVE "NO " TO ERROR-TOTAL NC1074.2 +049200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1074.2 +049300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1074.2 +049400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +049500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1074.2 +049600 WRITE-LINE. NC1074.2 +049700 ADD 1 TO RECORD-COUNT. NC1074.2 +049800 IF RECORD-COUNT GREATER 42 NC1074.2 +049900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1074.2 +050000 MOVE SPACE TO DUMMY-RECORD NC1074.2 +050100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1074.2 +050200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1074.2 +050300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1074.2 +050400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1074.2 +050500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1074.2 +050600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1074.2 +050700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1074.2 +050800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1074.2 +050900 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1074.2 +051000 MOVE ZERO TO RECORD-COUNT. NC1074.2 +051100 PERFORM WRT-LN. NC1074.2 +051200 WRT-LN. NC1074.2 +051300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1074.2 +051400 MOVE SPACE TO DUMMY-RECORD. NC1074.2 +051500 BLANK-LINE-PRINT. NC1074.2 +051600 PERFORM WRT-LN. NC1074.2 +051700 FAIL-ROUTINE. NC1074.2 +051800 IF COMPUTED-X NOT EQUAL TO SPACE NC1074.2 +051900 GO TO FAIL-ROUTINE-WRITE. NC1074.2 +052000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1074.2 +052100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1074.2 +052200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1074.2 +052300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +052400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1074.2 +052500 GO TO FAIL-ROUTINE-EX. NC1074.2 +052600 FAIL-ROUTINE-WRITE. NC1074.2 +052700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1074.2 +052800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1074.2 +052900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1074.2 +053000 MOVE SPACES TO COR-ANSI-REFERENCE. NC1074.2 +053100 FAIL-ROUTINE-EX. EXIT. NC1074.2 +053200 BAIL-OUT. NC1074.2 +053300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1074.2 +053400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1074.2 +053500 BAIL-OUT-WRITE. NC1074.2 +053600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1074.2 +053700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1074.2 +053800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1074.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1074.2 +054000 BAIL-OUT-EX. EXIT. NC1074.2 +054100 CCVS1-EXIT. NC1074.2 +054200 EXIT. NC1074.2 +054300 SECT-NC107A-001 SECTION. NC1074.2 +054400*REMARKS-TEST. NC1074.2 +054500* MOVE "IV-11 7.2.4" TO ANSI-REFERENCE. NC1074.2 +054600* MOVE "COBOL REMARKS PARA" TO FEATURE. NC1074.2 +054700* MOVE "REMARKS" TO PAR-NAME. NC1074.2 +054800* MOVE "PHONY LINES SHOULDNT EXECUT" TO RE-MARK. NC1074.2 +054900* PERFORM PRINT-DETAIL. NC1074.2 +055000*NOTE-TEST-1. NC1074.2 +055100* PERFORM FAIL. NC1074.2 +055200* NOTE ENTER GO TO NOTE-WRITE-1 NC1074.2 +055300* USE GO TO NOTE-WRITE-1 NC1074.2 +055400* DECLARATIVES GO TO NOTE-WRITE-1 NC1074.2 +055500* DATA DIVISION GO TO NOTE-WRITE-1 NC1074.2 +055600* COPY (SEE ALSO PROGRAM LB104) GO TO NOTE-WRITE-1 NC1074.2 +055700* THE COMPILER SHOULD "IGNORE" THE ABOVE WORDS. NC1074.2 +055800* PERFORM PASS NC1074.2 +055900* GO TO NOTE-WRITE-1. NC1074.2 +056000*NOTE-DELETE-1. NC1074.2 +056100* PERFORM DE-LETE. NC1074.2 +056200 NOTE-WRITE-1. NC1074.2 +056300 MOVE "NOTE RESERVED WORDS" TO FEATURE. NC1074.2 +056400 MOVE "NOTE-TEST-1" TO PAR-NAME. NC1074.2 +056500 PERFORM PRINT-DETAIL. NC1074.2 +056600 FIG-INIT. NC1074.2 +056700 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +056800 MOVE SPACE TO TEST-RESULTS. NC1074.2 +056900 MOVE "PLEASE CHECK THE COMPUTED" TO RE-MARK. NC1074.2 +057000 PERFORM PRINT-DETAIL. NC1074.2 +057100 MOVE "COLUMN TO BE CERTAIN THAT" TO RE-MARK. NC1074.2 +057200 PERFORM PRINT-DETAIL. NC1074.2 +057300 MOVE "THE CORRECT VALUES FOR THE" TO RE-MARK. NC1074.2 +057400 PERFORM PRINT-DETAIL. NC1074.2 +057500 MOVE "FIGURATIVE CONSTANTS ARE" TO RE-MARK. NC1074.2 +057600 PERFORM PRINT-DETAIL. NC1074.2 +057700 MOVE "SHOWN" TO RE-MARK. NC1074.2 +057800 PERFORM PRINT-DETAIL. NC1074.2 +057900 MOVE "FIGURATIVE CONSTANTS" TO FEATURE. NC1074.2 +058000 FIG-TEST-1. NC1074.2 +058100 MOVE ZERO TO COMPUTED-18V0. NC1074.2 +058200 MOVE "ZERO " TO CORRECT-A. NC1074.2 +058300 PERFORM INSPT. NC1074.2 +058400 GO TO FIG-WRITE-1. NC1074.2 +058500 FIG-DELETE-1. NC1074.2 +058600 PERFORM DE-LETE. NC1074.2 +058700 FIG-WRITE-1. NC1074.2 +058800 MOVE "FIG-TEST-1" TO PAR-NAME. NC1074.2 +058900 PERFORM PRINT-DETAIL. NC1074.2 +059000 FIG-TEST-2. NC1074.2 +059100 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +059200 MOVE SPACE TO COMPUTED-A. NC1074.2 +059300 MOVE "SPACE " TO CORRECT-A. NC1074.2 +059400 PERFORM INSPT. NC1074.2 +059500 GO TO FIG-WRITE-2. NC1074.2 +059600 FIG-DELETE-2. NC1074.2 +059700 PERFORM DE-LETE. NC1074.2 +059800 FIG-WRITE-2. NC1074.2 +059900 MOVE "FIG-TEST-2" TO PAR-NAME. NC1074.2 +060000 PERFORM PRINT-DETAIL. NC1074.2 +060100 FIG-TEST-3. NC1074.2 +060200 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +060300 MOVE QUOTE TO COMPUTED-A. NC1074.2 +060400 MOVE "QUOTE " TO CORRECT-A. NC1074.2 +060500 PERFORM INSPT. NC1074.2 +060600 GO TO FIG-WRITE-3. NC1074.2 +060700 FIG-DELETE-3. NC1074.2 +060800 PERFORM DE-LETE. NC1074.2 +060900 FIG-WRITE-3. NC1074.2 +061000 MOVE "FIG-TEST-3" TO PAR-NAME. NC1074.2 +061100 PERFORM PRINT-DETAIL. NC1074.2 +061200 FIG-TEST-4. NC1074.2 +061300 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +061400 MOVE HIGH-VALUE TO COMPUTED-A. NC1074.2 +061500 MOVE "HIGH-VALUE" TO CORRECT-A. NC1074.2 +061600 PERFORM INSPT. NC1074.2 +061700 GO TO FIG-WRITE-4. NC1074.2 +061800 FIG-DELETE-4. NC1074.2 +061900 PERFORM DE-LETE. NC1074.2 +062000 FIG-WRITE-4. NC1074.2 +062100 MOVE "FIG-TEST-4" TO PAR-NAME. NC1074.2 +062200 PERFORM PRINT-DETAIL. NC1074.2 +062300 FIG-TEST-5. NC1074.2 +062400 MOVE "IV-11 4.2.2.2.3" TO ANSI-REFERENCE. NC1074.2 +062500 MOVE LOW-VALUE TO COMPUTED-A. NC1074.2 +062600 MOVE "LOW-VALUE " TO CORRECT-A. NC1074.2 +062700 PERFORM INSPT. NC1074.2 +062800 GO TO FIG-WRITE-5. NC1074.2 +062900 FIG-DELETE-5. NC1074.2 +063000 PERFORM DE-LETE. NC1074.2 +063100 FIG-WRITE-5. NC1074.2 +063200 MOVE "FIG-TEST-5" TO PAR-NAME. NC1074.2 +063300 PERFORM PRINT-DETAIL. NC1074.2 +063400 CONTIN-INIT-A. NC1074.2 +063500 MOVE "CONTINUE A.N. LITRLS" TO FEATURE. NC1074.2 +063600 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +063700 MOVE "ABCDEFNC1074.2 +063800- "GHIJ" TO DATA-A. NC1074.2 +063900 CONTIN-TEST-1. NC1074.2 +064000 IF DATA-A EQUAL TO "ABCDEFGHIJ" NC1074.2 +064100 PERFORM PASS NC1074.2 +064200 GO TO CONTIN-WRITE-1. NC1074.2 +064300 GO TO CONTIN-FAIL-1. NC1074.2 +064400 CONTIN-DELETE-1. NC1074.2 +064500 PERFORM DE-LETE. NC1074.2 +064600 GO TO CONTIN-WRITE-1. NC1074.2 +064700 CONTIN-FAIL-1. NC1074.2 +064800 MOVE DATA-A TO COMPUTED-A. NC1074.2 +064900 MOVE "ABCDEFGHIJ" TO CORRECT-A. NC1074.2 +065000 PERFORM FAIL. NC1074.2 +065100 CONTIN-WRITE-1. NC1074.2 +065200 MOVE "CONTIN-TEST-1" TO PAR-NAME. NC1074.2 +065300 PERFORM PRINT-DETAIL. NC1074.2 +065400 CONTIN-TEST-2. NC1074.2 +065500 IF DATA-Q EQUAL TO "QUOTE IN COL. 72"NC1074.2 +065600 PERFORM PASS NC1074.2 +065700 GO TO CONTIN-WRITE-2. NC1074.2 +065800 PERFORM FAIL. NC1074.2 +065900 MOVE DATA-Q TO COMPUTED-A. NC1074.2 +066000 MOVE "QUOTE IN COL. 72" TO CORRECT-A. NC1074.2 +066100 GO TO CONTIN-WRITE-2. NC1074.2 +066200 CONTIN-DELETE-2. NC1074.2 +066300 PERFORM DE-LETE. NC1074.2 +066400 CONTIN-WRITE-2. NC1074.2 +066500 MOVE "CONTIN-TEST-2" TO PAR-NAME. NC1074.2 +066600 PERFORM PRINT-DETAIL. NC1074.2 +066700 CONTIN-TEST-3. NC1074.2 +066800 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +066900 IF DATA-R EQUAL TO "LITERAL ENDS AT 72NC1074.2 +067000- "" NC1074.2 +067100 PERFORM PASS NC1074.2 +067200 GO TO CONTIN-WRITE-3. NC1074.2 +067300 PERFORM FAIL. NC1074.2 +067400 MOVE DATA-R TO COMPUTED-A. NC1074.2 +067500 MOVE "LITERAL ENDS AT 72" TO CORRECT-A. NC1074.2 +067600 GO TO CONTIN-WRITE-3. NC1074.2 +067700 CONTIN-DELETE-3. NC1074.2 +067800 PERFORM DE-LETE. NC1074.2 +067900 CONTIN-WRITE-3. NC1074.2 +068000 MOVE "CONTIN-TEST-3" TO PAR-NAME. NC1074.2 +068100 PERFORM PRINT-DETAIL. NC1074.2 +068200 CONTIN-TEST-4. NC1074.2 +068300 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +068400 IF DATA-W EQUAL TO DATA-S NC1074.2 +068500 PERFORM PASS GO TO CONTIN-WRITE-4. NC1074.2 +068600 PERFORM FAIL. NC1074.2 +068700 MOVE DATA-S TO COMPUTED-A. NC1074.2 +068800 MOVE DATA-W TO CORRECT-A. NC1074.2 +068900 GO TO CONTIN-WRITE-4. NC1074.2 +069000 CONTIN-DELETE-4. NC1074.2 +069100 PERFORM DE-LETE. NC1074.2 +069200 CONTIN-WRITE-4. NC1074.2 +069300 MOVE "CONTIN-TEST-4" TO PAR-NAME NC1074.2 +069400 PERFORM PRINT-DETAIL. NC1074.2 +069500 CONTIN-TEST-5. NC1074.2 +069600 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +069700 IF DATA-W EQUAL TO DATA-T NC1074.2 +069800 PERFORM PASS GO TO CONTIN-WRITE-5. NC1074.2 +069900 PERFORM FAIL. NC1074.2 +070000 MOVE DATA-T TO COMPUTED-A. NC1074.2 +070100 MOVE DATA-W TO CORRECT-A. NC1074.2 +070200 GO TO CONTIN-WRITE-5. NC1074.2 +070300 CONTIN-DELETE-5. NC1074.2 +070400 PERFORM DE-LETE. NC1074.2 +070500 CONTIN-WRITE-5. NC1074.2 +070600 MOVE "CONTIN-TEST-5" TO PAR-NAME NC1074.2 +070700 PERFORM PRINT-DETAIL. NC1074.2 +070800 CONTIN-TEST-6. NC1074.2 +070900 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +071000 IF DATA-W EQUAL TO DATA-U NC1074.2 +071100 PERFORM PASS GO TO CONTIN-WRITE-6. NC1074.2 +071200 PERFORM FAIL. NC1074.2 +071300 MOVE DATA-U TO COMPUTED-A. NC1074.2 +071400 MOVE DATA-W TO CORRECT-A. NC1074.2 +071500 GO TO CONTIN-WRITE-6. NC1074.2 +071600 CONTIN-DELETE-6. NC1074.2 +071700 PERFORM DE-LETE. NC1074.2 +071800 CONTIN-WRITE-6. NC1074.2 +071900 MOVE "CONTIN-TEST-6" TO PAR-NAME NC1074.2 +072000 PERFORM PRINT-DETAIL. NC1074.2 +072100 CONTIN-TEST-7. NC1074.2 +072200 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +072300 MOVE DATA-S TO DATA-V. NC1074.2 +072400 IF DATA-W EQUAL TO DATA-V NC1074.2 +072500 PERFORM PASS GO TO CONTIN-WRITE-7. NC1074.2 +072600 PERFORM FAIL. NC1074.2 +072700 MOVE DATA-V TO COMPUTED-A. NC1074.2 +072800 MOVE DATA-W TO CORRECT-A. NC1074.2 +072900 GO TO CONTIN-WRITE-7. NC1074.2 +073000 CONTIN-DELETE-7. NC1074.2 +073100 PERFORM DE-LETE. NC1074.2 +073200 CONTIN-WRITE-7. NC1074.2 +073300 MOVE "CONTIN-TEST-7" TO PAR-NAME NC1074.2 +073400 PERFORM PRINT-DETAIL. NC1074.2 +073500 CONTIN-TEST-8. NC1074.2 +073600 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC1074.2 +073700 IF DATA-S EQUAL TO "OFFSET CONTINUATION NC1074.2 +073800- ""NC1074.2 +073900 PERFORM PASS GO TO CONTIN-WRITE-8. NC1074.2 +074000 PERFORM FAIL. NC1074.2 +074100 MOVE "OFFSET CONTINUATION NC1074.2 +074200- ""NC1074.2 +074300 TO COMPUTED-A. NC1074.2 +074400 MOVE DATA-S TO CORRECT-A. NC1074.2 +074500 GO TO CONTIN-WRITE-8. NC1074.2 +074600 CONTIN-DELETE-8. NC1074.2 +074700 PERFORM DE-LETE. NC1074.2 +074800 CONTIN-WRITE-8. NC1074.2 +074900 MOVE "CONTIN-TEST-8" TO PAR-NAME NC1074.2 +075000 PERFORM PRINT-DETAIL. NC1074.2 +075100 CONTIN-TEST-9. NC1074.2 +075200 MOVE "IV-10 4.2.2.2.1.2 (2) AND IV-9 4.2.2.2.1" NC1074.2 +075300 TO ANSI-REFERENCE. NC1074.2 +075400 IF WRK-XN-160-1 EQUAL TO NC1074.2 +075500 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +075600- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +075700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +075800- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +075900- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC1074.2 +076000- """""""""""""""""""""" PERFORM PASS NC1074.2 +076100 ELSE PERFORM FAIL. NC1074.2 +076200 GO TO CONTIN-WRITE-9. NC1074.2 +076300 CONTIN-DELETE-9. NC1074.2 +076400 PERFORM DE-LETE. NC1074.2 +076500 CONTIN-WRITE-9. NC1074.2 +076600 MOVE "CONTIN-TEST-9" TO PAR-NAME. NC1074.2 +076700 MOVE "160 PAIRS OF QUOTES" TO FEATURE. NC1074.2 +076800 PERFORM PRINT-DETAIL. NC1074.2 +076900 SEP-INIT-A. NC1074.2 +077000 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1074.2 +077100 MOVE "SEPARATORS (SPACES)" TO FEATURE. NC1074.2 +077200 SEP-TEST-1. NC1074.2 +077300 PERFORM PASS.NC1074.2 +077400 GONC1074.2 +077500 TONC1074.2 +077600 SEP-WRITE-1.NC1074.2 +077700 SEP-TEST-1-1. NC1074.2 +077800 PERFORM FAIL.NC1074.2 +077900 GO TO SEP-WRITE-1.NC1074.2 +078000* NOTENC1074.2 +078100* SEP-TEST-1NC1074.2 +078200* ENTIRE PARAGRAPH IS "NC1074.2 +078300* RIGHT-JUSTIFIED, TO MARGIN R.NC1074.2 +078400 SEP-DELETE-1. NC1074.2 +078500 PERFORM DE-LETE. NC1074.2 +078600 SEP-WRITE-1. NC1074.2 +078700 MOVE "SEP-TEST-1" TO PAR-NAME. NC1074.2 +078800 PERFORM PRINT-DETAIL. NC1074.2 +078900 SEP-TEST-2 SECTION. NC1074.2 +079000 SEP-TEST-2-PARA. NC1074.2 +079100 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1074.2 +079200 S2. PERFORM PASS. IF P-OR-F EQUAL TO "PASS " GO TO NC1074.2 +079300 SEP-WRITE-2. PERFORM FAIL. GO TO SEP-WRITE-2. NC1074.2 +079400 SEP-DELETE-2. NC1074.2 +079500 PERFORM DE-LETE. NC1074.2 +079600 SEP-WRITE-2. NC1074.2 +079700 MOVE "SEP-TEST-2" TO PAR-NAME. NC1074.2 +079800 PERFORM PRINT-DETAIL. NC1074.2 +079900 SEP-TEST-3. NC1074.2 +080000 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1074.2 +080100 IF SEP-03 EQUAL TO "SEPARATOR" NC1074.2 +080200 PERFORM PASS NC1074.2 +080300 GO TO SEP-WRITE-3. NC1074.2 +080400 PERFORM FAIL. NC1074.2 +080500 MOVE SEP-03 TO COMPUTED-A. NC1074.2 +080600 MOVE "SEPARATOR" TO CORRECT-A. NC1074.2 +080700 GO TO SEP-WRITE-3. NC1074.2 +080800 SEP-DELETE-3. NC1074.2 +080900 PERFORM DE-LETE. NC1074.2 +081000 SEP-WRITE-3. NC1074.2 +081100 MOVE "SEP-TEST-3" TO PAR-NAME. NC1074.2 +081200 PERFORM PRINT-DETAIL. NC1074.2 +081300 SEP-TEST-4. NC1074.2 +081400 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1074.2 +081500 PERFORM FAIL. NC1074.2 +081600 NC1074.2 +081700 NC1074.2 +081800 NC1074.2 +081900 NC1074.2 +082000 NC1074.2 +082100 NC1074.2 +082200 NC1074.2 +082300 NC1074.2 +082400 NC1074.2 +082500 NC1074.2 +082600 NC1074.2 +082700 NC1074.2 +082800 NC1074.2 +082900 NC1074.2 +083000 NC1074.2 +083100 NC1074.2 +083200 NC1074.2 +083300 NC1074.2 +083400 NC1074.2 +083500 NC1074.2 +083600 NC1074.2 +083700 NC1074.2 +083800 NC1074.2 +083900 NC1074.2 +084000 NC1074.2 +084100 NC1074.2 +084200 NC1074.2 +084300 NC1074.2 +084400 NC1074.2 +084500 NC1074.2 +084600 NC1074.2 +084700 NC1074.2 +084800 NC1074.2 +084900 NC1074.2 +085000 NC1074.2 +085100 NC1074.2 +085200 NC1074.2 +085300 NC1074.2 +085400 NC1074.2 +085500 NC1074.2 +085600 NC1074.2 +085700 NC1074.2 +085800 NC1074.2 +085900 NC1074.2 +086000 NC1074.2 +086100 NC1074.2 +086200 NC1074.2 +086300 NC1074.2 +086400 NC1074.2 +086500 NC1074.2 +086600 NC1074.2 +086700 NC1074.2 +086800 NC1074.2 +086900 NC1074.2 +087000 NC1074.2 +087100 NC1074.2 +087200 NC1074.2 +087300 NC1074.2 +087400 NC1074.2 +087500 NC1074.2 +087600 NC1074.2 +087700 NC1074.2 +087800 NC1074.2 +087900 NC1074.2 +088000 NC1074.2 +088100 NC1074.2 +088200 NC1074.2 +088300 NC1074.2 +088400 NC1074.2 +088500 NC1074.2 +088600 NC1074.2 +088700 NC1074.2 +088800 NC1074.2 +088900 NC1074.2 +089000 NC1074.2 +089100 NC1074.2 +089200 NC1074.2 +089300 NC1074.2 +089400 NC1074.2 +089500 NC1074.2 +089600 NC1074.2 +089700 NC1074.2 +089800 NC1074.2 +089900 NC1074.2 +090000 NC1074.2 +090100 NC1074.2 +090200 NC1074.2 +090300 NC1074.2 +090400 NC1074.2 +090500 NC1074.2 +090600 NC1074.2 +090700 NC1074.2 +090800 NC1074.2 +090900 NC1074.2 +091000 NC1074.2 +091100 NC1074.2 +091200 NC1074.2 +091300 NC1074.2 +091400 NC1074.2 +091500 NC1074.2 +091600 NC1074.2 +091700 SUBTRACT NC1074.2 +091800 1 FROM ERROR-COUNTER. NC1074.2 +091900 PERFORM PASS. NC1074.2 +092000 GO TO SEP-WRITE-4. NC1074.2 +092100 SEP-DELETE-4. NC1074.2 +092200 PERFORM DE-LETE. NC1074.2 +092300 SEP-WRITE-4. NC1074.2 +092400 MOVE "SEP-TEST-4" TO PAR-NAME. NC1074.2 +092500 PERFORM PRINT-DETAIL. NC1074.2 +092600 SEP-TEST-5 SECTION. NC1074.2 +092700 SEP-TEST-5-PARA. NC1074.2 +092800* ==--> SEMICOLON AS SEPARATOR <--== NC1074.2 +092900 MOVE "IV-4 4.2.1(2)" TO ANSI-REFERENCE. NC1074.2 +093000 S5. PERFORM PASS, IF P-OR-F EQUAL TO "PASS " GO TO NC1074.2 +093100 SEP-WRITE-5; ELSE PERFORM FAIL, GO TO SEP-WRITE-5. NC1074.2 +093200 SEP-DELETE-5. NC1074.2 +093300 PERFORM DE-LETE. NC1074.2 +093400 SEP-WRITE-5. NC1074.2 +093500 MOVE "SEP-TEST-5" TO PAR-NAME. NC1074.2 +093600 PERFORM PRINT-DETAIL. NC1074.2 +093700 JUST-INIT-01. NC1074.2 +093800 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +093900* NC1074.2 +094000* INITIALIZATION TAKES PLACE INDEPENDENT OF ANY JUSTIFIED NC1074.2 +094100* CLAUSE. NC1074.2 +094200* REFERENCE - X3.23-1985, PAGE VI-49, 5.15.4(1)C. NC1074.2 +094300* NC1074.2 +094400 MOVE "JUST WITH VALUE" TO FEATURE. NC1074.2 +094500 MOVE "JUST-TEST-01" TO PAR-NAME. NC1074.2 +094600 JUST-TEST-01-1. NC1074.2 +094700 IF XJ-00002 EQUAL TO "AB" NC1074.2 +094800 PERFORM PASS NC1074.2 +094900 GO TO JUST-WRITE-01-1 NC1074.2 +095000 ELSE GO TO JUST-FAIL-01-1. NC1074.2 +095100 JUST-DELETE-01-1. NC1074.2 +095200 PERFORM DE-LETE. NC1074.2 +095300 GO TO JUST-WRITE-01-1. NC1074.2 +095400 JUST-FAIL-01-1. NC1074.2 +095500 PERFORM FAIL. NC1074.2 +095600 MOVE XJ-00002 TO COMPUTED-A. NC1074.2 +095700 MOVE "AB" TO CORRECT-A. NC1074.2 +095800 JUST-WRITE-01-1. NC1074.2 +095900 MOVE 1 TO REC-CT. NC1074.2 +096000 PERFORM PRINT-DETAIL. NC1074.2 +096100 JUST-TEST-01-2. NC1074.2 +096200 IF XJ-00003 EQUAL TO "XY " NC1074.2 +096300 PERFORM PASS NC1074.2 +096400 GO TO JUST-WRITE-01-2 NC1074.2 +096500 ELSE GO TO JUST-FAIL-01-2. NC1074.2 +096600 JUST-DELETE-01-2. NC1074.2 +096700 PERFORM DE-LETE. NC1074.2 +096800 GO TO JUST-WRITE-01-2. NC1074.2 +096900 JUST-FAIL-01-2. NC1074.2 +097000 PERFORM FAIL. NC1074.2 +097100 MOVE XJ-00003 TO COMPUTED-A. NC1074.2 +097200 MOVE "XY " TO CORRECT-A. NC1074.2 +097300 JUST-WRITE-01-2. NC1074.2 +097400 MOVE 2 TO REC-CT. NC1074.2 +097500 PERFORM PRINT-DETAIL. NC1074.2 +097600 JUST-INIT-02. NC1074.2 +097700 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +097800* NC1074.2 +097900* JUSTIFIED RECEIVING ITEM TESTS NC1074.2 +098000* IF THE SENDING ITEM IS LARGER THAN THE RECEIVING ITEM, NC1074.2 +098100* THEN THE LEFTMOST CHARACTERS ARE TRUNCATED. IF THE SENDING NC1074.2 +098200* ITEM IS SMALLER THAN THE RECEIVING ITEM, THEN THE DATA IS NC1074.2 +098300* ALIGNED TO THE RIGHT WITH SPACES IN THE LEFTMOST CHARACTER NC1074.2 +098400* POSITIONS. NC1074.2 +098500* REFERENCE - X3.23-1985, PAGE VI-24, 6.5.4.(1) NC1074.2 +098600* NC1074.2 +098700* JUST-TEST-02 CONTAINS STATEMENTS OF THE FORM NC1074.2 +098800* MOVE ALPHANUMERIC LITERAL TO ALPHANUMERIC JUSTIFIED ITEM.NC1074.2 +098900* NC1074.2 +099000 MOVE "MOVE - JUST REC ITEM" TO FEATURE. NC1074.2 +099100 MOVE "JUST-TEST-02" TO PAR-NAME. NC1074.2 +099200 JUST-TEST-02-1-0. NC1074.2 +099300 MOVE "ABC" TO XJ-00005. NC1074.2 +099400 JUST-TEST-02-1-1. NC1074.2 +099500 IF XJ-00005 EQUAL TO " ABC" NC1074.2 +099600 PERFORM PASS NC1074.2 +099700 GO TO JUST-WRITE-02-1 NC1074.2 +099800 ELSE GO TO JUST-FAIL-02-1. NC1074.2 +099900 JUST-DELETE-02-1. NC1074.2 +100000 PERFORM DE-LETE. NC1074.2 +100100 GO TO JUST-WRITE-02-1. NC1074.2 +100200 JUST-FAIL-02-1. NC1074.2 +100300 PERFORM FAIL. NC1074.2 +100400 MOVE " ABC" TO CORRECT-A. NC1074.2 +100500 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +100600 JUST-WRITE-02-1. NC1074.2 +100700 MOVE 1 TO REC-CT. NC1074.2 +100800 PERFORM PRINT-DETAIL. NC1074.2 +100900 JUST-TEST-02-2-0. NC1074.2 +101000 MOVE "ABCDEFGHI" TO XJ-00005. NC1074.2 +101100 JUST-TEST-02-2-1. NC1074.2 +101200 IF XJ-00005 EQUAL TO "EFGHI" NC1074.2 +101300 PERFORM PASS NC1074.2 +101400 GO TO JUST-WRITE-02-2 NC1074.2 +101500 ELSE GO TO JUST-FAIL-02-2. NC1074.2 +101600 JUST-DELETE-02-2. NC1074.2 +101700 PERFORM DE-LETE. NC1074.2 +101800 GO TO JUST-WRITE-02-2. NC1074.2 +101900 JUST-FAIL-02-2. NC1074.2 +102000 PERFORM FAIL. NC1074.2 +102100 MOVE "EFGHI" TO CORRECT-A. NC1074.2 +102200 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +102300 JUST-WRITE-02-2. NC1074.2 +102400 MOVE 2 TO REC-CT. NC1074.2 +102500 PERFORM PRINT-DETAIL. NC1074.2 +102600 JUST-TEST-02-3-0. NC1074.2 +102700 MOVE "CDEFG" TO XJ-00005. NC1074.2 +102800 JUST-TEST-02-3-1. NC1074.2 +102900 IF XJ-00005 EQUAL TO "CDEFG" NC1074.2 +103000 PERFORM PASS NC1074.2 +103100 GO TO JUST-WRITE-02-3 NC1074.2 +103200 ELSE GO TO JUST-FAIL-02-3. NC1074.2 +103300 JUST-DELETE-02-3. NC1074.2 +103400 PERFORM DE-LETE. NC1074.2 +103500 GO TO JUST-WRITE-02-3. NC1074.2 +103600 JUST-FAIL-02-3. NC1074.2 +103700 PERFORM FAIL. NC1074.2 +103800 MOVE "CDEFG" TO CORRECT-A. NC1074.2 +103900 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +104000 JUST-WRITE-02-3. NC1074.2 +104100 MOVE 3 TO REC-CT. NC1074.2 +104200 PERFORM PRINT-DETAIL. NC1074.2 +104300 JUST-INIT-03. NC1074.2 +104400 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +104500* NC1074.2 +104600* JUST-TEST-03 CONTAINS STATEMENTS OF THE FORM NC1074.2 +104700* MOVE ALPHANUMERIC ITEM TO ALPHABETIC JUSTIFIED ITEM. NC1074.2 +104800* NC1074.2 +104900 MOVE "MOVE - JUST REC ITEM" TO FEATURE. NC1074.2 +105000 MOVE "JUST-TEST-03" TO PAR-NAME. NC1074.2 +105100 JUST-TEST-03-1-0. NC1074.2 +105200 MOVE NJUST-XN-3 TO AJ-00005. NC1074.2 +105300 JUST-TEST-03-1-1. NC1074.2 +105400 IF AJ-00005 EQUAL TO " ABC" NC1074.2 +105500 PERFORM PASS NC1074.2 +105600 GO TO JUST-WRITE-03-1 NC1074.2 +105700 ELSE GO TO JUST-FAIL-03-1. NC1074.2 +105800 JUST-DELETE-03-1. NC1074.2 +105900 PERFORM DE-LETE. NC1074.2 +106000 GO TO JUST-WRITE-03-1. NC1074.2 +106100 JUST-FAIL-03-1. NC1074.2 +106200 PERFORM FAIL. NC1074.2 +106300 MOVE " ABC" TO CORRECT-A. NC1074.2 +106400 MOVE AJ-00005 TO COMPUTED-A. NC1074.2 +106500 JUST-WRITE-03-1. NC1074.2 +106600 MOVE 1 TO REC-CT. NC1074.2 +106700 PERFORM PRINT-DETAIL. NC1074.2 +106800 JUST-TEST-03-2-0. NC1074.2 +106900 MOVE NJUST-XN-5 TO AJ-00005. NC1074.2 +107000 JUST-TEST-03-2-1. NC1074.2 +107100 IF AJ-00005 EQUAL TO "CDEFG" NC1074.2 +107200 PERFORM PASS NC1074.2 +107300 GO TO JUST-WRITE-03-2 NC1074.2 +107400 ELSE GO TO JUST-FAIL-03-2. NC1074.2 +107500 JUST-DELETE-03-2. NC1074.2 +107600 PERFORM DE-LETE. NC1074.2 +107700 GO TO JUST-WRITE-03-2. NC1074.2 +107800 JUST-FAIL-03-2. NC1074.2 +107900 PERFORM FAIL. NC1074.2 +108000 MOVE "CDEFG" TO CORRECT-A. NC1074.2 +108100 MOVE AJ-00005 TO COMPUTED-A. NC1074.2 +108200 JUST-WRITE-03-2. NC1074.2 +108300 MOVE 2 TO REC-CT. NC1074.2 +108400 PERFORM PRINT-DETAIL. NC1074.2 +108500 JUST-TEST-03-3-0. NC1074.2 +108600 MOVE NJUST-XN-15 TO AJ-00005. NC1074.2 +108700 JUST-TEST-03-3-1. NC1074.2 +108800 IF AJ-00005 EQUAL TO "KLMNO" NC1074.2 +108900 PERFORM PASS NC1074.2 +109000 GO TO JUST-WRITE-03-3 NC1074.2 +109100 ELSE GO TO JUST-FAIL-03-3. NC1074.2 +109200 JUST-DELETE-03-3. NC1074.2 +109300 PERFORM DE-LETE. NC1074.2 +109400 GO TO JUST-WRITE-03-3. NC1074.2 +109500 JUST-FAIL-03-3. NC1074.2 +109600 PERFORM FAIL. NC1074.2 +109700 MOVE "KLMNO" TO CORRECT-A. NC1074.2 +109800 MOVE AJ-00005 TO COMPUTED-A. NC1074.2 +109900 JUST-WRITE-03-3. NC1074.2 +110000 MOVE 3 TO REC-CT. NC1074.2 +110100 PERFORM PRINT-DETAIL. NC1074.2 +110200 JUST-INIT-04. NC1074.2 +110300 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +110400* NC1074.2 +110500* JUST-TEST-04 CONTAINS STATEMENTS OF THE FORM NC1074.2 +110600* MOVE GROUP ITEM TO ALPHABETIC JUSTIFIED ITEM. NC1074.2 +110700* NC1074.2 +110800 MOVE "MOVE - JUST REC ITEM" TO FEATURE. NC1074.2 +110900 MOVE "JUST-TEST-04" TO PAR-NAME. NC1074.2 +111000 JUST-TEST-04-1-0. NC1074.2 +111100 MOVE GROUP-TO-JUST-1 TO AJ-00007. NC1074.2 +111200 JUST-TEST-04-1-1. NC1074.2 +111300 IF AJ-00007 EQUAL TO " ABC" NC1074.2 +111400 PERFORM PASS NC1074.2 +111500 GO TO JUST-WRITE-04-1 NC1074.2 +111600 ELSE GO TO JUST-FAIL-04-1. NC1074.2 +111700 JUST-DELETE-04-1. NC1074.2 +111800 PERFORM DE-LETE. NC1074.2 +111900 GO TO JUST-WRITE-04-1. NC1074.2 +112000 JUST-FAIL-04-1. NC1074.2 +112100 PERFORM FAIL. NC1074.2 +112200 MOVE " ABC" TO CORRECT-A. NC1074.2 +112300 MOVE AJ-00007 TO COMPUTED-A. NC1074.2 +112400 JUST-WRITE-04-1. NC1074.2 +112500 MOVE 1 TO REC-CT. NC1074.2 +112600 PERFORM PRINT-DETAIL. NC1074.2 +112700 JUST-TEST-04-2-0. NC1074.2 +112800 MOVE GROUP-TO-JUST-21 TO AJ-00007. NC1074.2 +112900 JUST-TEST-04-2-1. NC1074.2 +113000 IF AJ-00007 EQUAL TO "ABCDEFG" NC1074.2 +113100 PERFORM PASS NC1074.2 +113200 GO TO JUST-WRITE-04-2 NC1074.2 +113300 ELSE GO TO JUST-FAIL-04-2. NC1074.2 +113400 JUST-DELETE-04-2. NC1074.2 +113500 PERFORM DE-LETE. NC1074.2 +113600 GO TO JUST-WRITE-04-2. NC1074.2 +113700 JUST-FAIL-04-2. NC1074.2 +113800 PERFORM FAIL. NC1074.2 +113900 MOVE "ABCDEFG" TO CORRECT-A. NC1074.2 +114000 MOVE AJ-00007 TO COMPUTED-A. NC1074.2 +114100 JUST-WRITE-04-2. NC1074.2 +114200 MOVE 2 TO REC-CT. NC1074.2 +114300 PERFORM PRINT-DETAIL. NC1074.2 +114400 JUST-TEST-04-3-0. NC1074.2 +114500 MOVE GROUP-TO-JUST-2 TO AJ-00007. NC1074.2 +114600 JUST-TEST-04-3-1. NC1074.2 +114700 IF AJ-00007 EQUAL TO "IJKLMNO" NC1074.2 +114800 PERFORM PASS NC1074.2 +114900 GO TO JUST-WRITE-04-3 NC1074.2 +115000 ELSE GO TO JUST-FAIL-04-3. NC1074.2 +115100 JUST-DELETE-04-3. NC1074.2 +115200 PERFORM DE-LETE. NC1074.2 +115300 GO TO JUST-WRITE-04-3. NC1074.2 +115400 JUST-FAIL-04-3. NC1074.2 +115500 PERFORM FAIL. NC1074.2 +115600 MOVE "IJKLMNO" TO CORRECT-A. NC1074.2 +115700 MOVE AJ-00007 TO COMPUTED-A. NC1074.2 +115800 JUST-WRITE-04-3. NC1074.2 +115900 MOVE 3 TO REC-CT. NC1074.2 +116000 PERFORM PRINT-DETAIL. NC1074.2 +116100 JUST-INIT-05. NC1074.2 +116200 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +116300* NC1074.2 +116400* JUST-TEST-05 CONTAINS MOVE STATEMENTS WITH A JUSTIFIED NC1074.2 +116500* SENDING ITEM. NC1074.2 +116600* NC1074.2 +116700 MOVE "MOVE-JUST SEND ITEM" TO FEATURE. NC1074.2 +116800 MOVE "JUST-TEST-05" TO PAR-NAME. NC1074.2 +116900 MOVE "12345ABCDEFGHUXYZ PQR" TO GROUP-WITH-JUST-ITEMS. NC1074.2 +117000 MOVE SPACE TO GROUP-FOR-JUST-TESTS. NC1074.2 +117100 JUST-TEST-05-1-0. NC1074.2 +117200 MOVE AJ-00009 TO NJUST-XN-15. NC1074.2 +117300 JUST-TEST-05-1-1. NC1074.2 +117400 IF NJUST-XN-15 EQUAL TO "XYZ PQR " NC1074.2 +117500 PERFORM PASS NC1074.2 +117600 GO TO JUST-WRITE-05-1 NC1074.2 +117700 ELSE GO TO JUST-FAIL-05-1. NC1074.2 +117800 JUST-DELETE-05-1. NC1074.2 +117900 PERFORM DE-LETE. NC1074.2 +118000 GO TO JUST-WRITE-05-1. NC1074.2 +118100 JUST-FAIL-05-1. NC1074.2 +118200 PERFORM FAIL. NC1074.2 +118300 MOVE "XYZ PQR " TO CORRECT-A. NC1074.2 +118400 MOVE NJUST-XN-15 TO COMPUTED-A. NC1074.2 +118500 JUST-WRITE-05-1. NC1074.2 +118600 MOVE 1 TO REC-CT. NC1074.2 +118700 PERFORM PRINT-DETAIL. NC1074.2 +118800 JUST-TEST-05-2-0. NC1074.2 +118900 MOVE XJ-00009 TO NJUST-XN-3. NC1074.2 +119000 JUST-TEST-05-2-1. NC1074.2 +119100 IF NJUST-XN-3 EQUAL TO "ABC" NC1074.2 +119200 PERFORM PASS NC1074.2 +119300 GO TO JUST-WRITE-05-2 NC1074.2 +119400 ELSE GO TO JUST-FAIL-05-2. NC1074.2 +119500 JUST-DELETE-05-2. NC1074.2 +119600 PERFORM DE-LETE. NC1074.2 +119700 GO TO JUST-WRITE-05-2. NC1074.2 +119800 JUST-FAIL-05-2. NC1074.2 +119900 PERFORM FAIL. NC1074.2 +120000 MOVE NJUST-XN-3 TO COMPUTED-A. NC1074.2 +120100 MOVE "ABC" TO CORRECT-A. NC1074.2 +120200 JUST-WRITE-05-2. NC1074.2 +120300 MOVE 2 TO REC-CT. NC1074.2 +120400 PERFORM PRINT-DETAIL. NC1074.2 +120500 JUST-INIT-06. NC1074.2 +120600 MOVE "IV-24 5.6.4" TO ANSI-REFERENCE. NC1074.2 +120700* NC1074.2 +120800* JUST-TEST-06 CONTAINS MOVE STATEMENTS WITH A JUSTIFIED NC1074.2 +120900* SENDING ITEM AND A JUSTIFIED RECEIVING ITEM. NC1074.2 +121000* NC1074.2 +121100 MOVE "MOVE - JUST TO JUST" TO FEATURE. NC1074.2 +121200 MOVE "JUST-TEST-06" TO PAR-NAME. NC1074.2 +121300 MOVE "12345ABCDEFGHIXYZ PQR" TO GROUP-WITH-JUST-ITEMS. NC1074.2 +121400 JUST-TEST-06-0. NC1074.2 +121500 MOVE SPACE TO XJ-00005. NC1074.2 +121600 JUST-TEST-06-1. NC1074.2 +121700 MOVE XJ-00009 TO XJ-00005. NC1074.2 +121800 IF XJ-00005 EQUAL TO "EFGHI" NC1074.2 +121900 PERFORM PASS NC1074.2 +122000 GO TO JUST-WRITE-06-1 NC1074.2 +122100 ELSE GO TO JUST-FAIL-06-1. NC1074.2 +122200 JUST-DELETE-06-1. NC1074.2 +122300 PERFORM DE-LETE. NC1074.2 +122400 GO TO JUST-WRITE-06-1. NC1074.2 +122500 JUST-FAIL-06-1. NC1074.2 +122600 PERFORM FAIL. NC1074.2 +122700 MOVE "EFGHI" TO CORRECT-A. NC1074.2 +122800 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +122900 JUST-WRITE-06-1. NC1074.2 +123000 MOVE 1 TO REC-CT. NC1074.2 +123100 PERFORM PRINT-DETAIL. NC1074.2 +123200 JUST-INIT-06-2. NC1074.2 +123300 MOVE SPACE TO AJ-00005. NC1074.2 +123400 JUST-TEST-06-2. NC1074.2 +123500 MOVE AJ-00009 TO AJ-00005. NC1074.2 +123600 IF AJ-00005 EQUAL TO " PQR" NC1074.2 +123700 PERFORM PASS NC1074.2 +123800 GO TO JUST-WRITE-06-2 NC1074.2 +123900 ELSE GO TO JUST-FAIL-06-2. NC1074.2 +124000 JUST-DELETE-06-2. NC1074.2 +124100 PERFORM DE-LETE. NC1074.2 +124200 GO TO JUST-WRITE-06-2. NC1074.2 +124300 JUST-FAIL-06-2. NC1074.2 +124400 PERFORM FAIL. NC1074.2 +124500 MOVE " PQR" TO CORRECT-A. NC1074.2 +124600 MOVE AJ-00005 TO COMPUTED-A. NC1074.2 +124700 JUST-WRITE-06-2. NC1074.2 +124800 MOVE 2 TO REC-CT. NC1074.2 +124900 PERFORM PRINT-DETAIL. NC1074.2 +125000 JUST-INIT-06-3. NC1074.2 +125100 MOVE "ABCDEFG" TO XJ-00007. NC1074.2 +125200 MOVE SPACE TO AJ-00007. NC1074.2 +125300 JUST-TEST-06-3. NC1074.2 +125400 MOVE XJ-00007 TO AJ-00007. NC1074.2 +125500 IF AJ-00007 EQUAL TO "ABCDEFG" NC1074.2 +125600 PERFORM PASS NC1074.2 +125700 GO TO JUST-WRITE-06-3 NC1074.2 +125800 ELSE GO TO JUST-FAIL-06-3. NC1074.2 +125900 JUST-DELETE-06-3. NC1074.2 +126000 PERFORM DE-LETE. NC1074.2 +126100 GO TO JUST-WRITE-06-3. NC1074.2 +126200 JUST-FAIL-06-3. NC1074.2 +126300 PERFORM FAIL. NC1074.2 +126400 MOVE "ABCDEFG" TO CORRECT-A. NC1074.2 +126500 MOVE AJ-00007 TO COMPUTED-A. NC1074.2 +126600 JUST-WRITE-06-3. NC1074.2 +126700 MOVE 3 TO REC-CT. NC1074.2 +126800 PERFORM PRINT-DETAIL. NC1074.2 +126900 JUST-INIT-06-4. NC1074.2 +127000 MOVE SPACE TO XJ-00005. NC1074.2 +127100 JUST-TEST-06-4. NC1074.2 +127200 MOVE XJ-00007 TO XJ-00005. NC1074.2 +127300 IF XJ-00005 EQUAL TO "CDEFG" NC1074.2 +127400 PERFORM PASS NC1074.2 +127500 GO TO JUST-WRITE-06-4 NC1074.2 +127600 ELSE GO TO JUST-FAIL-06-4. NC1074.2 +127700 JUST-DELETE-06-4. NC1074.2 +127800 PERFORM DE-LETE. NC1074.2 +127900 GO TO JUST-WRITE-06-4. NC1074.2 +128000 JUST-FAIL-06-4. NC1074.2 +128100 PERFORM FAIL. NC1074.2 +128200 MOVE "CDEFG" TO CORRECT-A. NC1074.2 +128300 MOVE XJ-00005 TO COMPUTED-A. NC1074.2 +128400 JUST-WRITE-06-4. NC1074.2 +128500 MOVE 4 TO REC-CT. NC1074.2 +128600 PERFORM PRINT-DETAIL. NC1074.2 +128700 JUST-INIT-06-5. NC1074.2 +128800 MOVE SPACE TO XJ-00009. NC1074.2 +128900 JUST-TEST-06-5. NC1074.2 +129000 MOVE XJ-00007 TO XJ-00009. NC1074.2 +129100 IF XJ-00009 EQUAL TO " ABCDEFG" NC1074.2 +129200 PERFORM PASS NC1074.2 +129300 GO TO JUST-WRITE-06-5 NC1074.2 +129400 ELSE GO TO JUST-FAIL-06-5. NC1074.2 +129500 JUST-DELETE-06-5. NC1074.2 +129600 PERFORM DE-LETE. NC1074.2 +129700 GO TO JUST-WRITE-06-5. NC1074.2 +129800 JUST-FAIL-06-5. NC1074.2 +129900 PERFORM FAIL. NC1074.2 +130000 MOVE " ABCDEFG" TO CORRECT-A. NC1074.2 +130100 MOVE XJ-00009 TO COMPUTED-A. NC1074.2 +130200 JUST-WRITE-06-5. NC1074.2 +130300 MOVE 5 TO REC-CT. NC1074.2 +130400 PERFORM PRINT-DETAIL. NC1074.2 +130500 MOVE 0 TO REC-CT. NC1074.2 +130600 SYNC-TEST-1. NC1074.2 +130700 MOVE "VI-44 5.13.4" TO ANSI-REFERENCE. NC1074.2 +130800 IF DATA-G EQUAL TO DATA-H NC1074.2 +130900 PERFORM PASS NC1074.2 +131000 ELSE NC1074.2 +131100 PERFORM FAIL. NC1074.2 +131200 GO TO SYNC-WRITE-1. NC1074.2 +131300 SYNC-DELETE-1. NC1074.2 +131400 PERFORM DE-LETE. NC1074.2 +131500 SYNC-WRITE-1. NC1074.2 +131600 MOVE "SYNCHRONIZED" TO FEATURE. NC1074.2 +131700 MOVE "SYNC-TEST-1" TO PAR-NAME. NC1074.2 +131800 PERFORM PRINT-DETAIL. NC1074.2 +131900 BZERO-INIT. NC1074.2 +132000 MOVE "VI-22 5.4" TO ANSI-REFERENCE. NC1074.2 +132100 MOVE "BLANK WHEN ZERO" TO FEATURE. NC1074.2 +132200 BZERO-TEST-1-0. NC1074.2 +132300 MOVE 0000000000 TO DATA-F. NC1074.2 +132400 BZERO-TEST-1-1. NC1074.2 +132500 IF DATA-F EQUAL TO " " NC1074.2 +132600 PERFORM PASS NC1074.2 +132700 ELSE NC1074.2 +132800 GO TO BZERO-FAIL-1. NC1074.2 +132900 GO TO BZERO-WRITE-1. NC1074.2 +133000 BZERO-DELETE-1. NC1074.2 +133100 PERFORM DE-LETE. NC1074.2 +133200 GO TO BZERO-WRITE-1. NC1074.2 +133300 BZERO-FAIL-1. NC1074.2 +133400 MOVE DATA-F TO COMPUTED-A. NC1074.2 +133500 MOVE "SHOULD BE BLANK" TO CORRECT-A. NC1074.2 +133600 PERFORM FAIL. NC1074.2 +133700 BZERO-WRITE-1. NC1074.2 +133800 MOVE "BZERO-TEST-1" TO PAR-NAME. NC1074.2 +133900 PERFORM PRINT-DETAIL. NC1074.2 +134000 BZERO-INIT-2. NC1074.2 +134100 MOVE "VI-22 5.4" TO ANSI-REFERENCE. NC1074.2 +134200 MOVE 0000 TO DATA-M. NC1074.2 +134300 BZERO-TEST-2. NC1074.2 +134400 IF DATA-M EQUAL TO SPACE NC1074.2 +134500 PERFORM PASS NC1074.2 +134600 GO TO BZERO-WRITE-2. NC1074.2 +134700 GO TO BZERO-FAIL-2. NC1074.2 +134800 BZERO-DELETE-2. NC1074.2 +134900 PERFORM DE-LETE. NC1074.2 +135000 GO TO BZERO-WRITE-2. NC1074.2 +135100 BZERO-FAIL-2. NC1074.2 +135200 MOVE DATA-M TO COMPUTED-A. NC1074.2 +135300 MOVE "SHOULD BE BLANK" TO CORRECT-A. NC1074.2 +135400 PERFORM FAIL. NC1074.2 +135500 BZERO-WRITE-2. NC1074.2 +135600 MOVE "BZERO-TEST-2" TO PAR-NAME. NC1074.2 +135700 PERFORM PRINT-DETAIL. NC1074.2 +135800 BZERO-INIT-3. NC1074.2 +135900 MOVE "VI-22 5.4" TO ANSI-REFERENCE. NC1074.2 +136000 BZERO-TEST-3. NC1074.2 +136100 IF DATA-P1 EQUAL TO "000" NC1074.2 +136200 PERFORM PASS GO TO BZERO-WRITE-3. NC1074.2 +136300 GO TO BZERO-FAIL-3. NC1074.2 +136400 BZERO-DELETE-3. NC1074.2 +136500 PERFORM DE-LETE. NC1074.2 +136600 GO TO BZERO-WRITE-3. NC1074.2 +136700 BZERO-FAIL-3. NC1074.2 +136800 PERFORM FAIL. NC1074.2 +136900 MOVE DATA-P1 TO COMPUTED-A. NC1074.2 +137000 MOVE "000" TO CORRECT-A. NC1074.2 +137100 BZERO-WRITE-3. NC1074.2 +137200 MOVE "BZERO-TEST-3" TO PAR-NAME. NC1074.2 +137300 PERFORM PRINT-DETAIL. NC1074.2 +137400 LONG-PARAGRAPH-NAME-----INIT-1. NC1074.2 +137500 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +137600 LONG-PARAGRAPH-NAME-----TEST-1. NC1074.2 +137700 PERFORM PASS. NC1074.2 +137800 GO TO LONG-WRITE-1. NC1074.2 +137900 LONG-DELETE-1. NC1074.2 +138000 PERFORM DE-LETE. NC1074.2 +138100 LONG-WRITE-1. NC1074.2 +138200 MOVE "LONG PARAGRAPH-NAME" TO FEATURE. NC1074.2 +138300 MOVE "LONG-PARAGRAPH---ETC" TO PAR-NAME. NC1074.2 +138400 PERFORM PRINT-DETAIL. NC1074.2 +138500 LONG-INIT-2. NC1074.2 +138600 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +138700 LONG-TEST-2. NC1074.2 +138800 MOVE SPACE TO A-DATA-NAME-30-CHARACTERS-LONG. NC1074.2 +138900 PERFORM PASS. NC1074.2 +139000 GO TO LONG-WRITE-2. NC1074.2 +139100 LONG-DELETE-2. NC1074.2 +139200 PERFORM DE-LETE. NC1074.2 +139300 LONG-WRITE-2. NC1074.2 +139400 MOVE "LONG DATA-NAME" TO FEATURE. NC1074.2 +139500 MOVE "LONG-TEST-2" TO PAR-NAME. NC1074.2 +139600 PERFORM PRINT-DETAIL. NC1074.2 +139700 LONG-INIT-3. NC1074.2 +139800 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +139900 LONG-TEST-3. NC1074.2 +140000 MOVE SPACE TO LONG-PICTURE. NC1074.2 +140100 PERFORM PASS. NC1074.2 +140200 GO TO LONG-WRITE-3. NC1074.2 +140300 LONG-DELETE-3. NC1074.2 +140400 PERFORM DE-LETE. NC1074.2 +140500 LONG-WRITE-3. NC1074.2 +140600 MOVE "LONG PICTURE" TO FEATURE. NC1074.2 +140700 MOVE "LONG-TEST-3" TO PAR-NAME. NC1074.2 +140800 PERFORM PRINT-DETAIL. NC1074.2 +140900 LONG-INIT-4. NC1074.2 +141000 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +141100 LONG-TEST-4. NC1074.2 +141200 MOVE "LONG-TEST-4" TO PAR-NAME. NC1074.2 +141300 IF LONG-LITERAL EQUAL TO "STANDARD COMPILERS MUST ALLOWNC1074.2 +141400- " NON-NUMERIC LITERALS OF AT LEAST 120 CHARACTERS AND NUMERICNC1074.2 +141500- " LITERALS OF AT LEAST 18 DIGITS BUT NOW EXTENDED UPTO 160 DINC1074.2 +141600- "GITS FOR 8X" NC1074.2 +141700 PERFORM PASS NC1074.2 +141800 ELSE NC1074.2 +141900 GO TO LONG-FAIL-4. NC1074.2 +142000 GO TO LONG-WRITE-4. NC1074.2 +142100 LONG-DELETE-4. NC1074.2 +142200 MOVE "LONG-TEST-4" TO PAR-NAME. NC1074.2 +142300 PERFORM DE-LETE. NC1074.2 +142400 GO TO LONG-WRITE-4. NC1074.2 +142500 LONG-FAIL-4. NC1074.2 +142600 PERFORM FAIL. NC1074.2 +142700 MOVE SPACE TO TEST-RESULTS. NC1074.2 +142800 MOVE LONG20 TO COMPUTED-A. NC1074.2 +142900 PERFORM PRINT-DETAIL. NC1074.2 +143000 MOVE LONG40 TO COMPUTED-A. NC1074.2 +143100 PERFORM PRINT-DETAIL. NC1074.2 +143200 MOVE LONG60 TO COMPUTED-A. NC1074.2 +143300 PERFORM PRINT-DETAIL. NC1074.2 +143400 MOVE LONG80 TO COMPUTED-A. NC1074.2 +143500 PERFORM PRINT-DETAIL. NC1074.2 +143600 MOVE LONG100 TO COMPUTED-A. NC1074.2 +143700 PERFORM PRINT-DETAIL. NC1074.2 +143800 MOVE LONG120 TO COMPUTED-A. NC1074.2 +143900 PERFORM PRINT-DETAIL. NC1074.2 +144000 MOVE LONG140 TO COMPUTED-A. NC1074.2 +144100 PERFORM PRINT-DETAIL. NC1074.2 +144200 MOVE LONG160 TO COMPUTED-A. NC1074.2 +144300 PERFORM PRINT-DETAIL. NC1074.2 +144400 MOVE "SEE PROGRAM" TO RE-MARK. NC1074.2 +144500 LONG-WRITE-4. NC1074.2 +144600 MOVE "LONG NON-NUM LITERAL" TO FEATURE. NC1074.2 +144700 PERFORM PRINT-DETAIL. NC1074.2 +144800 LONG-INIT-5. NC1074.2 +144900 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +145000 MOVE 211113411,114311112 TO LONG-NUMBER. NC1074.2 +145100 LONG-TEST-5. NC1074.2 +145200 IF LONG-NUMBER EQUAL TO 211113411,114311112 PERFORM PASS NC1074.2 +145300 ELSE GO TO LONG-FAIL-5. NC1074.2 +145400 GO TO LONG-WRITE-5. NC1074.2 +145500 LONG-DELETE-5. NC1074.2 +145600 PERFORM DE-LETE. NC1074.2 +145700 GO TO LONG-WRITE-5. NC1074.2 +145800 LONG-FAIL-5. NC1074.2 +145900 MOVE LONG-NUMBER TO COMPUTED-N. NC1074.2 +146000 MOVE " 211113411,114311112" TO CORRECT-A. NC1074.2 +146100 PERFORM FAIL. NC1074.2 +146200 LONG-WRITE-5. NC1074.2 +146300 MOVE "LONG NUMERIC LITERAL" TO FEATURE. NC1074.2 +146400 MOVE "LONG-TEST-5" TO PAR-NAME. NC1074.2 +146500 PERFORM PRINT-DETAIL. NC1074.2 +146600 LONG-INIT-6. NC1074.2 +146700 MOVE "IV-9 4.2.2.2.1" TO ANSI-REFERENCE. NC1074.2 +146800 MOVE "ABCDEFGHIJKLMNOPQRST" TO LONG-PICTURE-A. NC1074.2 +146900 LONG-TEST-6. NC1074.2 +147000 MOVE LONG-PICTURE-A TO LONG-PICTURE-B. NC1074.2 +147100 MOVE LONG-PICTURE-B TO LONG-PICTURE-C. NC1074.2 +147200 IF LONG-PICTURE-C EQUAL TO "FGHIJKLMNO" NC1074.2 +147300 PERFORM PASS GO TO LONG-WRITE-6. NC1074.2 +147400 GO TO LONG-FAIL-6. NC1074.2 +147500 LONG-DELETE-6. NC1074.2 +147600 PERFORM DE-LETE. NC1074.2 +147700 GO TO LONG-WRITE-6. NC1074.2 +147800 LONG-FAIL-6. NC1074.2 +147900 MOVE LONG-PICTURE-C TO COMPUTED-A. NC1074.2 +148000 MOVE "FGHIJKLMNO" TO CORRECT-A. NC1074.2 +148100 PERFORM FAIL. NC1074.2 +148200 LONG-WRITE-6. NC1074.2 +148300 MOVE "LONG PICTURE" TO FEATURE. NC1074.2 +148400 MOVE "LONG-TEST-6" TO PAR-NAME. NC1074.2 +148500 PERFORM PRINT-DETAIL. NC1074.2 +148600 RDF-INIT-1. NC1074.2 +148700 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +148800 MOVE "REDEFINES" TO FEATURE. NC1074.2 +148900 RDF-TEST-1-0. NC1074.2 +149000 MOVE "5" TO REDEF2. NC1074.2 +149100 RDF-TEST-1-1. NC1074.2 +149200 IF REDEF1 EQUAL TO 5 PERFORM PASS GO TO RDF-WRITE-1. NC1074.2 +149300 GO TO RDF-FAIL-1. NC1074.2 +149400 RDF-DELETE-1. NC1074.2 +149500 PERFORM DE-LETE. NC1074.2 +149600 GO TO RDF-WRITE-1. NC1074.2 +149700 RDF-FAIL-1. NC1074.2 +149800 MOVE REDEF1 TO COMPUTED-A. NC1074.2 +149900 MOVE "5" TO CORRECT-A. NC1074.2 +150000 PERFORM FAIL. NC1074.2 +150100 RDF-WRITE-1. NC1074.2 +150200 MOVE "RDF-TEST-1" TO PAR-NAME. NC1074.2 +150300 PERFORM PRINT-DETAIL. NC1074.2 +150400 RDF-INIT-2. NC1074.2 +150500 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +150600 RDF-TEST-2-0. NC1074.2 +150700 MOVE "W" TO REDEF4. NC1074.2 +150800 RDF-TEST-2-1. NC1074.2 +150900 IF REDEF3 EQUAL TO "WBC" PERFORM PASS GO TO RDF-WRITE-2. NC1074.2 +151000 GO TO RDF-FAIL-2. NC1074.2 +151100 RDF-DELETE-2. NC1074.2 +151200 PERFORM DE-LETE. NC1074.2 +151300 GO TO RDF-WRITE-2. NC1074.2 +151400 RDF-FAIL-2. NC1074.2 +151500 MOVE REDEF3 TO COMPUTED-A. NC1074.2 +151600 MOVE "WBC" TO CORRECT-A. NC1074.2 +151700 PERFORM FAIL. NC1074.2 +151800 RDF-WRITE-2. NC1074.2 +151900 MOVE "RDF-TEST-2" TO PAR-NAME. NC1074.2 +152000 PERFORM PRINT-DETAIL. NC1074.2 +152100 RDF-INIT-3. NC1074.2 +152200 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +152300 MOVE 123456 TO REDEF6. NC1074.2 +152400 MOVE "AB" TO REDEF8A. NC1074.2 +152500 MOVE "EF" TO REDEF8C. NC1074.2 +152600 RDF-TEST-3. NC1074.2 +152700 IF REDEF5 EQUAL TO "AB34EF" PERFORM PASS GO TO RDF-WRITE-3. NC1074.2 +152800 GO TO RDF-FAIL-3. NC1074.2 +152900 RDF-DELETE-3. NC1074.2 +153000 PERFORM DE-LETE. NC1074.2 +153100 GO TO RDF-WRITE-3. NC1074.2 +153200 RDF-FAIL-3. NC1074.2 +153300 MOVE REDEF5 TO COMPUTED-A. NC1074.2 +153400 MOVE "AB34EF" TO CORRECT-A. NC1074.2 +153500 PERFORM FAIL. NC1074.2 +153600 RDF-WRITE-3. NC1074.2 +153700 MOVE "RDF-TEST-3" TO PAR-NAME. NC1074.2 +153800 PERFORM PRINT-DETAIL. NC1074.2 +153900 RDF-INIT-4. NC1074.2 +154000 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +154100 RDF-TEST-4. NC1074.2 +154200 IF RDFDATA7 EQUAL TO "ABC98765DE911644ALLD" NC1074.2 +154300 PERFORM PASS NC1074.2 +154400 GO TO RDF-WRITE-4. NC1074.2 +154500 MOVE RDFDATA7 TO COMPUTED-A. NC1074.2 +154600 MOVE "ABC98765DE911644ALLD" TO CORRECT-A. NC1074.2 +154700 PERFORM FAIL. NC1074.2 +154800 GO TO RDF-WRITE-4. NC1074.2 +154900 RDF-DELETE-4. NC1074.2 +155000 PERFORM DE-LETE. NC1074.2 +155100 RDF-WRITE-4. NC1074.2 +155200 MOVE "RDF-TEST-4 " TO PAR-NAME. NC1074.2 +155300 PERFORM PRINT-DETAIL. NC1074.2 +155400 RDF-INIT-5. NC1074.2 +155500 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +155600 RDF-TEST-5. NC1074.2 +155700 IF RDFDATA8 (13) EQUAL TO "HG" NC1074.2 +155800 PERFORM PASS NC1074.2 +155900 GO TO RDF-WRITE-5. NC1074.2 +156000 MOVE "HG" TO CORRECT-A. NC1074.2 +156100 MOVE RDFDATA8 (13) TO COMPUTED-A. NC1074.2 +156200 PERFORM FAIL. NC1074.2 +156300 GO TO RDF-WRITE-5. NC1074.2 +156400 RDF-DELETE-5. NC1074.2 +156500 PERFORM DE-LETE. NC1074.2 +156600 RDF-WRITE-5. NC1074.2 +156700 MOVE "RDF-TEST-5 " TO PAR-NAME. NC1074.2 +156800 PERFORM PRINT-DETAIL. NC1074.2 +156900 RDF-INIT-6. NC1074.2 +157000 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +157100 RDF-TEST-6. NC1074.2 +157200 IF RDFDATA2 EQUAL TO 9116,44 NC1074.2 +157300 PERFORM PASS NC1074.2 +157400 GO TO RDF-WRITE-6. NC1074.2 +157500 MOVE 9116,44 TO COMPUTED-N. NC1074.2 +157600 MOVE RDFDATA2 TO CORRECT-N. NC1074.2 +157700 PERFORM FAIL. NC1074.2 +157800 GO TO RDF-WRITE-6. NC1074.2 +157900 RDF-DELETE-6. NC1074.2 +158000 PERFORM DE-LETE. NC1074.2 +158100 RDF-WRITE-6. NC1074.2 +158200 MOVE "RDF-TEST-6 " TO PAR-NAME. NC1074.2 +158300 PERFORM PRINT-DETAIL. NC1074.2 +158400 RDF-INIT-7. NC1074.2 +158500 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +158600 RDF-TEST-7. NC1074.2 +158700 IF RDFDATA16 EQUAL TO 66 NC1074.2 +158800 PERFORM PASS NC1074.2 +158900 GO TO RDF-WRITE-7. NC1074.2 +159000 MOVE RDFDATA16 TO COMPUTED-A. NC1074.2 +159100 MOVE 66 TO CORRECT-A. NC1074.2 +159200 PERFORM FAIL. NC1074.2 +159300 GO TO RDF-WRITE-7. NC1074.2 +159400 RDF-DELETE-7. NC1074.2 +159500 PERFORM DE-LETE. NC1074.2 +159600 RDF-WRITE-7. NC1074.2 +159700 MOVE "RDF-TEST-7 " TO PAR-NAME. NC1074.2 +159800 PERFORM PRINT-DETAIL. NC1074.2 +159900 RDF-INIT-8. NC1074.2 +160000 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +160100 MOVE SPACE TO REDEF12. NC1074.2 +160200 RDF-TEST-8. NC1074.2 +160300 IF REDEF11 EQUAL TO SPACE NC1074.2 +160400 PERFORM PASS NC1074.2 +160500 GO TO RDF-WRITE-8. NC1074.2 +160600 MOVE "SPACE EXPECTED " TO CORRECT-A. NC1074.2 +160700 MOVE "NON BLANK CHARACTERS" TO COMPUTED-A. NC1074.2 +160800 MOVE "REDEF11 CONTAINS NON BLANKS" TO RE-MARK. NC1074.2 +160900 PERFORM FAIL. NC1074.2 +161000 GO TO RDF-WRITE-8. NC1074.2 +161100 RDF-DELETE-8. NC1074.2 +161200 PERFORM DE-LETE. NC1074.2 +161300 RDF-WRITE-8. NC1074.2 +161400 MOVE "RDF-TEST-8 " TO PAR-NAME. NC1074.2 +161500 PERFORM PRINT-DETAIL. NC1074.2 +161600 RDF-INIT-9. NC1074.2 +161700 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +161800 MOVE ZERO TO REDEF12. NC1074.2 +161900 MOVE SPACE TO REDEF11. NC1074.2 +162000 RDF-TEST-9. NC1074.2 +162100 IF RDFDATA18 EQUAL TO ZERO NC1074.2 +162200 PERFORM PASS NC1074.2 +162300 GO TO RDF-WRITE-9. NC1074.2 +162400 MOVE "00000000000000" TO CORRECT-A. NC1074.2 +162500 MOVE RDFDATA18 TO COMPUTED-A. NC1074.2 +162600 PERFORM FAIL. NC1074.2 +162700 GO TO RDF-WRITE-9. NC1074.2 +162800 RDF-DELETE-9. NC1074.2 +162900 PERFORM DE-LETE. NC1074.2 +163000 RDF-WRITE-9. NC1074.2 +163100 MOVE "RDF-TEST-9 " TO PAR-NAME. NC1074.2 +163200 PERFORM PRINT-DETAIL. NC1074.2 +163300 RDF-INIT-10. NC1074.2 +163400 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +163500 MOVE ZERO TO REDEF12. NC1074.2 +163600 MOVE "MOVING DATA TO A REDEFINED FIELD CAN BE RISKY " NC1074.2 +163700 TO REDEF10. NC1074.2 +163800 RDF-TEST-10. NC1074.2 +163900 IF RDFDATA8 (14) EQUAL TO "00" NC1074.2 +164000 PERFORM PASS NC1074.2 +164100 GO TO RDF-WRITE-10. NC1074.2 +164200 MOVE 00 TO CORRECT-A. NC1074.2 +164300 MOVE RDFDATA8 (14) TO COMPUTED-A. NC1074.2 +164400 PERFORM FAIL. NC1074.2 +164500 GO TO RDF-WRITE-10. NC1074.2 +164600 RDF-DELETE-10. NC1074.2 +164700 PERFORM DE-LETE. NC1074.2 +164800 RDF-WRITE-10. NC1074.2 +164900 MOVE "RDF-TEST-10 " TO PAR-NAME. NC1074.2 +165000 PERFORM PRINT-DETAIL. NC1074.2 +165100 RDF-INIT-11. NC1074.2 +165200 MOVE "VI-38 5.10" TO ANSI-REFERENCE. NC1074.2 +165300 RDF-TEST-11. NC1074.2 +165400 MOVE REDEF13 TO REDEF12. NC1074.2 +165500 IF REDEF10 EQUAL TO NC1074.2 +165600 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" NC1074.2 +165700 PERFORM PASS NC1074.2 +165800 GO TO RDF-WRITE-11. NC1074.2 +165900 MOVE "ALPHABETIC A 46 LONG" TO CORRECT-A COMPUTED-A. NC1074.2 +166000 MOVE "FIELDS DIDNT COMPARE EQUAL " TO RE-MARK. NC1074.2 +166100 PERFORM FAIL. NC1074.2 +166200 GO TO RDF-WRITE-11. NC1074.2 +166300 RDF-DELETE-11. NC1074.2 +166400 PERFORM DE-LETE. NC1074.2 +166500 RDF-WRITE-11. NC1074.2 +166600 MOVE "RDF-TEST-11 " TO PAR-NAME. NC1074.2 +166700 PERFORM PRINT-DETAIL. NC1074.2 +166800 RDF-INIT-12. NC1074.2 +166900 MOVE "VI-38 5.10.3 SR6" TO ANSI-REFERENCE. NC1074.2 +167000 MOVE "ABC98765DE" TO REDEF20. NC1074.2 +167100 RDF-TEST-12. NC1074.2 +167200 IF REDEF22 = "ABC98765DE" NC1074.2 +167300 PERFORM PASS NC1074.2 +167400 GO TO RDF-WRITE-12. NC1074.2 +167500 GO TO RDF-FAIL-12. NC1074.2 +167600 RDF-DELETE-12. NC1074.2 +167700 PERFORM DE-LETE. NC1074.2 +167800 GO TO RDF-WRITE-12. NC1074.2 +167900 RDF-FAIL-12. NC1074.2 +168000 MOVE REDEF22 TO COMPUTED-A. NC1074.2 +168100 MOVE "ABC98765DE" TO CORRECT-A. NC1074.2 +168200 PERFORM FAIL. NC1074.2 +168300 RDF-WRITE-12. NC1074.2 +168400 MOVE "RDF-TEST-12 " TO PAR-NAME. NC1074.2 +168500 PERFORM PRINT-DETAIL. NC1074.2 +168600 RDF-INIT-13. NC1074.2 +168700 MOVE "VI-38 5.10.3 SR6" TO ANSI-REFERENCE. NC1074.2 +168800 MOVE "0987654321" TO REDEF22. NC1074.2 +168900 RDF-TEST-13. NC1074.2 +169000 IF REDEF23 = "098765432" NC1074.2 +169100 PERFORM PASS NC1074.2 +169200 GO TO RDF-WRITE-13. NC1074.2 +169300 GO TO RDF-FAIL-13. NC1074.2 +169400 RDF-DELETE-13. NC1074.2 +169500 PERFORM DE-LETE. NC1074.2 +169600 GO TO RDF-WRITE-13. NC1074.2 +169700 RDF-FAIL-13. NC1074.2 +169800 MOVE REDEF22 TO COMPUTED-A. NC1074.2 +169900 MOVE "098765432" TO CORRECT-A. NC1074.2 +170000 PERFORM FAIL. NC1074.2 +170100 RDF-WRITE-13. NC1074.2 +170200 MOVE "RDF-TEST-13" TO PAR-NAME. NC1074.2 +170300 PERFORM PRINT-DETAIL. NC1074.2 +170400 USAGE-INIT-1. NC1074.2 +170500 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +170600 MOVE "USAGE" TO FEATURE. NC1074.2 +170700 USAGE-TEST-1. NC1074.2 +170800 IF U2 GREATER THAN U7 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +170900 GO TO USAGE-WRITE-1. NC1074.2 +171000 USAGE-DELETE-1. NC1074.2 +171100 PERFORM DE-LETE. NC1074.2 +171200 USAGE-WRITE-1. NC1074.2 +171300 MOVE "USAGE-TEST-1" TO PAR-NAME. NC1074.2 +171400 PERFORM PRINT-DETAIL. NC1074.2 +171500 USAGE-INIT-2. NC1074.2 +171600 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +171700 USAGE-TEST-2. NC1074.2 +171800 IF U2 EQUAL TO U4 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +171900 GO TO USAGE-WRITE-2. NC1074.2 +172000 USAGE-DELETE-2. NC1074.2 +172100 PERFORM DE-LETE. NC1074.2 +172200 USAGE-WRITE-2. NC1074.2 +172300 MOVE "USAGE-TEST-2" TO PAR-NAME. NC1074.2 +172400 PERFORM PRINT-DETAIL. NC1074.2 +172500 USAGE-INIT-3. NC1074.2 +172600 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +172700 USAGE-TEST-3. NC1074.2 +172800 IF U3 EQUAL TO U4 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +172900 GO TO USAGE-WRITE-3. NC1074.2 +173000 USAGE-DELETE-3. NC1074.2 +173100 PERFORM DE-LETE. NC1074.2 +173200 USAGE-WRITE-3. NC1074.2 +173300 MOVE "USAGE-TEST-3" TO PAR-NAME. NC1074.2 +173400 PERFORM PRINT-DETAIL. NC1074.2 +173500 USAGE-INIT-4. NC1074.2 +173600 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +173700 USAGE-TEST-4-0. NC1074.2 +173800 MOVE U5 TO U9. NC1074.2 +173900 USAGE-TEST-4-1. NC1074.2 +174000 IF U6 EQUAL TO U10 NC1074.2 +174100 PERFORM PASS NC1074.2 +174200 GO TO USAGE-WRITE-4. NC1074.2 +174300 GO TO USAGE-FAIL-4. NC1074.2 +174400 USAGE-DELETE-4. NC1074.2 +174500 PERFORM DE-LETE. NC1074.2 +174600 GO TO USAGE-WRITE-4. NC1074.2 +174700 USAGE-FAIL-4. NC1074.2 +174800 MOVE U10 TO COMPUTED-N. NC1074.2 +174900 MOVE U6 TO CORRECT-N. NC1074.2 +175000 PERFORM FAIL. NC1074.2 +175100 USAGE-WRITE-4. NC1074.2 +175200 MOVE "USAGE-TEST-4" TO PAR-NAME. NC1074.2 +175300 PERFORM PRINT-DETAIL. NC1074.2 +175400 USAGE-INIT-5. NC1074.2 +175500 MOVE "VI-46 5.14" TO ANSI-REFERENCE. NC1074.2 +175600 USAGE-TEST-5-0. NC1074.2 +175700 MOVE U5 TO U9. NC1074.2 +175800 USAGE-TEST-5-1. NC1074.2 +175900 IF U7 EQUAL TO U11 NC1074.2 +176000 PERFORM PASS NC1074.2 +176100 GO TO USAGE-WRITE-5. NC1074.2 +176200 MOVE U7 TO CORRECT-N. NC1074.2 +176300 MOVE U11 TO COMPUTED-N. NC1074.2 +176400 PERFORM FAIL. NC1074.2 +176500 GO TO USAGE-WRITE-5. NC1074.2 +176600 USAGE-DELETE-5. NC1074.2 +176700 PERFORM DE-LETE. NC1074.2 +176800 USAGE-WRITE-5. NC1074.2 +176900 MOVE "USAGE-TEST-5" TO PAR-NAME. NC1074.2 +177000 PERFORM PRINT-DETAIL. NC1074.2 +177100 USAGE-INIT-6. NC1074.2 +177200 MOVE "VI-47 5.14.4 GR3 GR9" TO ANSI-REFERENCE. NC1074.2 +177300 USAGE-TEST-6. NC1074.2 +177400 IF U22 GREATER THAN U12 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +177500 GO TO USAGE-WRITE-6. NC1074.2 +177600 USAGE-DELETE-6. NC1074.2 +177700 PERFORM DE-LETE. NC1074.2 +177800 USAGE-WRITE-6. NC1074.2 +177900 MOVE "USAGE-TEST-6" TO PAR-NAME. NC1074.2 +178000 PERFORM PRINT-DETAIL. NC1074.2 +178100 USAGE-INIT-7. NC1074.2 +178200 MOVE "VI-47 5.14.4 GR3 GR9" TO ANSI-REFERENCE. NC1074.2 +178300 USAGE-TEST-7. NC1074.2 +178400 IF U23 GREATER THAN U13 PERFORM PASS ELSE PERFORM FAIL. NC1074.2 +178500 GO TO USAGE-WRITE-7. NC1074.2 +178600 USAGE-DELETE-7. NC1074.2 +178700 PERFORM DE-LETE. NC1074.2 +178800 USAGE-WRITE-7. NC1074.2 +178900 MOVE "USAGE-TEST-7" TO PAR-NAME. NC1074.2 +179000 PERFORM PRINT-DETAIL. NC1074.2 +179100 VALUE-INIT-1. NC1074.2 +179200 MOVE "VI-50 5.15.6 (6)" TO ANSI-REFERENCE. NC1074.2 +179300 MOVE "VALUE FOR OCCURS FIELD" TO FEATURE. NC1074.2 +179400 MOVE "VALUE TESTS 1, 2 & 3" TO PAR-NAME. NC1074.2 +179500 VALUE-TEST-1. NC1074.2 +179600 MOVE 1 TO SUB1. NC1074.2 +179700 PERFORM VALUE-TEST-2 NC1074.2 +179800 UNTIL SUB1 > 10. NC1074.2 +179900 GO TO CURR-TEST-1. NC1074.2 +180000 VALUE-TEST-2. NC1074.2 +180100 MOVE 1 TO SUB2. NC1074.2 +180200 PERFORM VALUE-TEST-3 NC1074.2 +180300 UNTIL SUB2 > 10. NC1074.2 +180400 ADD 1 TO SUB1. NC1074.2 +180500 VALUE-TEST-3. NC1074.2 +180600 MOVE SUB1 TO TAB1. NC1074.2 +180700 MOVE SUB2 TO TAB2. NC1074.2 +180800 MOVE TAB-LOC TO PAR-NAME. NC1074.2 +180900 IF VALUE-TABLE-2 (SUB1 SUB2) = "AZ" NC1074.2 +181000 PERFORM PASS NC1074.2 +181100 ELSE NC1074.2 +181200 MOVE VALUE-TABLE-2 (SUB1 SUB2) TO COMPUTED-A NC1074.2 +181300 MOVE "AZ" TO CORRECT-A NC1074.2 +181400 PERFORM FAIL. NC1074.2 +181500 PERFORM PRINT-DETAIL. NC1074.2 +181600 ADD 1 TO SUB2. NC1074.2 +181700 VALUE-DELETE-1. NC1074.2 +181800 PERFORM DE-LETE. NC1074.2 +181900 PERFORM PRINT-DETAIL. NC1074.2 +182000 CURR-TEST-1. NC1074.2 +182100 MOVE DATA-I TO DATA-J. NC1074.2 +182200 IF DATA-J EQUAL TO " W12" PERFORM PASS GO TO CURR-WRITE-1. NC1074.2 +182300 GO TO CURR-FAIL-1. NC1074.2 +182400 CURR-DELETE-1. NC1074.2 +182500 PERFORM DE-LETE. NC1074.2 +182600 GO TO CURR-WRITE-1. NC1074.2 +182700 CURR-FAIL-1. NC1074.2 +182800 MOVE DATA-J TO COMPUTED-A. NC1074.2 +182900 MOVE " W12" TO CORRECT-A. NC1074.2 +183000 PERFORM FAIL. NC1074.2 +183100 CURR-WRITE-1. NC1074.2 +183200 MOVE "CURRENCY SIGN IS" TO FEATURE. NC1074.2 +183300 MOVE "CURR-TEST-1" TO PAR-NAME. NC1074.2 +183400 PERFORM PRINT-DETAIL. NC1074.2 +183500 DCOM-TEST-1. NC1074.2 +183600 MOVE DATA-K TO DATA-L. NC1074.2 +183700 IF DATA-L EQUAL TO "1.234.567,89" PERFORM PASS NC1074.2 +183800 GO TO DCOM-WRITE-1. NC1074.2 +183900 GO TO DCOM-FAIL-1. NC1074.2 +184000 DCOM-DELETE-1. NC1074.2 +184100 PERFORM DE-LETE. NC1074.2 +184200 GO TO DCOM-WRITE-1. NC1074.2 +184300 DCOM-FAIL-1. NC1074.2 +184400 MOVE DATA-L TO COMPUTED-A. NC1074.2 +184500 MOVE "1.234.567,89" TO CORRECT-A. NC1074.2 +184600 PERFORM FAIL. NC1074.2 +184700 DCOM-WRITE-1. NC1074.2 +184800 MOVE "DECIMAL IS COMMA" TO FEATURE. NC1074.2 +184900 MOVE "DCOM-TEST-1" TO PAR-NAME. NC1074.2 +185000 PERFORM PRINT-DETAIL. NC1074.2 +185100 DCOM-INIT-2. NC1074.2 +185200 MOVE "123456789." TO TEST-FIELD. NC1074.2 +185300 DCOM-TEST-2-1. NC1074.2 +185400 IF TEST-FIELD = "123456789." NC1074.2 +185500 PERFORM PASS NC1074.2 +185600 GO TO DCOM-WRITE-2. NC1074.2 +185700 GO TO DCOM-FAIL-2. NC1074.2 +185800 DCOM-DELETE-2. NC1074.2 +185900 PERFORM DE-LETE. NC1074.2 +186000 GO TO DCOM-WRITE-2. NC1074.2 +186100 DCOM-FAIL-2. NC1074.2 +186200 MOVE TEST-FIELD TO COMPUTED-A. NC1074.2 +186300 MOVE "123456789." TO CORRECT-A. NC1074.2 +186400 PERFORM FAIL. NC1074.2 +186500 DCOM-WRITE-2. NC1074.2 +186600 MOVE "DCOM-TEST-2" TO PAR-NAME. NC1074.2 +186700 PERFORM PRINT-DETAIL. NC1074.2 +186800 DCOM-INIT-3. NC1074.2 +186900 MOVE "123456789," TO TEST-FIELD. NC1074.2 +187000 DCOM-TEST-3-1. NC1074.2 +187100 IF TEST-FIELD = "123456789," NC1074.2 +187200 PERFORM PASS NC1074.2 +187300 GO TO DCOM-WRITE-3. NC1074.2 +187400 GO TO DCOM-FAIL-3. NC1074.2 +187500 DCOM-DELETE-3. NC1074.2 +187600 PERFORM DE-LETE. NC1074.2 +187700 GO TO DCOM-WRITE-3. NC1074.2 +187800 DCOM-FAIL-3. NC1074.2 +187900 MOVE TEST-FIELD TO COMPUTED-A. NC1074.2 +188000 MOVE "123456789," TO CORRECT-A. NC1074.2 +188100 PERFORM FAIL. NC1074.2 +188200 DCOM-WRITE-3. NC1074.2 +188300 MOVE "DCOM-TEST-3" TO PAR-NAME. NC1074.2 +188400 PERFORM PRINT-DETAIL. NC1074.2 +188500 NUM-INIT-A. NC1074.2 +188600 MOVE "NUMERIC PARA-NAMES" TO FEATURE. NC1074.2 +188700 PERFORM PRINT-DETAIL. NC1074.2 +188800 NUM-TEST-2. NC1074.2 +188900 MOVE 3 TO NUM-UTILITY. NC1074.2 +189000 GO TO 3 4 5 DEPENDING ON NUM-UTILITY. NC1074.2 +189100 PERFORM FAIL. NC1074.2 +189200 MOVE "GO TO DEPENDING IGNORED" TO RE-MARK. NC1074.2 +189300 GO TO NUM-WRITE-2. NC1074.2 +189400 NUM-DELETE-2. NC1074.2 +189500 PERFORM DE-LETE. NC1074.2 +189600 GO TO NUM-WRITE-2. NC1074.2 +189700 4. NC1074.2 +189800 PERFORM FAIL. NC1074.2 +189900 MOVE "PARAGRAPH 4 ENTERED" TO RE-MARK NC1074.2 +190000 GO TO NUM-WRITE-2. NC1074.2 +190100 5. NC1074.2 +190200 PERFORM PASS. NC1074.2 +190300 GO TO NUM-WRITE-2. NC1074.2 +190400 3. NC1074.2 +190500 PERFORM FAIL. NC1074.2 +190600 MOVE "PARAGRAPH 3 ENTERED" TO RE-MARK. NC1074.2 +190700 NUM-WRITE-2. NC1074.2 +190800 MOVE " GO TO DEPENDING" TO FEATURE. NC1074.2 +190900 MOVE "NUM-TEST-2" TO PAR-NAME. NC1074.2 +191000 PERFORM PRINT-DETAIL. NC1074.2 +191100 NUM-TEST-3. NC1074.2 +191200 MOVE ZERO TO NUM-UTILITY. NC1074.2 +191300 PERFORM 000000000000000000000000001 THRU NC1074.2 +191400 00000000000000000000000000001 2 TIMES. NC1074.2 +191500 IF NUM-UTILITY EQUAL TO 220 NC1074.2 +191600 PERFORM PASS GO TO NUM-WRITE-3. NC1074.2 +191700 GO TO NUM-FAIL-3. NC1074.2 +191800 NUM-DELETE-3. NC1074.2 +191900 PERFORM DE-LETE. NC1074.2 +192000 GO TO NUM-WRITE-3. NC1074.2 +192100 NUM-FAIL-3. NC1074.2 +192200 PERFORM FAIL. NC1074.2 +192300 MOVE NUM-UTILITY TO COMPUTED-N. NC1074.2 +192400 MOVE 220 TO CORRECT-N. NC1074.2 +192500 NC1074.2 +192600 NUM-WRITE-3. NC1074.2 +192700 MOVE " PERFORM THRU TIMES" TO FEATURE. NC1074.2 +192800 MOVE "NUM-TEST-3" TO PAR-NAME. NC1074.2 +192900 PERFORM PRINT-DETAIL. NC1074.2 +193000 NC1074.2 +193100 NUM-TEST-4. NC1074.2 +193200 MOVE ZERO TO NUM-UTILITY. NC1074.2 +193300 PERFORM 0000000000000000000000000001. NC1074.2 +193400 IF NUM-UTILITY EQUAL TO 1100 NC1074.2 +193500 PERFORM PASS GO TO NUM-WRITE-4. NC1074.2 +193600 GO TO NUM-FAIL-4. NC1074.2 +193700 NUM-DELETE-4. NC1074.2 +193800 PERFORM DE-LETE. NC1074.2 +193900 GO TO NUM-WRITE-4. NC1074.2 +194000 NUM-FAIL-4. NC1074.2 +194100 PERFORM FAIL. NC1074.2 +194200 MOVE NUM-UTILITY TO COMPUTED-N. NC1074.2 +194300 MOVE 1100 TO CORRECT-N. NC1074.2 +194400 NUM-WRITE-4. NC1074.2 +194500 MOVE " PERFORM SECT-NAME" TO FEATURE. NC1074.2 +194600 MOVE "NUM-TEST-4" TO PAR-NAME. NC1074.2 +194700 PERFORM PRINT-DETAIL. NC1074.2 +194800 GO TO NUM-EXIT. NC1074.2 +194900 0000000000000000000000001 SECTION. NC1074.2 +195000 00000000000000000000000001. NC1074.2 +195100 ADD 1 TO NUM-UTILITY ON SIZE ERROR GO TO NUM-ERROR. NC1074.2 +195200 NC1074.2 +195300 000000000000000000000000001. NC1074.2 +195400 ADD 10 TO NUM-UTILITY ON SIZE ERROR GO TO NUM-ERROR. NC1074.2 +195500 0000000000000000000000000001 SECTION. NC1074.2 +195600 00000000000000000000000000001. NC1074.2 +195700 ADD 100 TO NUM-UTILITY ON SIZE ERROR GO TO NUM-ERROR. NC1074.2 +195800 000000000000000000000000000001. NC1074.2 +195900 ADD 1000 TO NUM-UTILITY ON SIZE ERROR GO TO NUM-ERROR. NC1074.2 +196000 NUM-EXIT-SECT SECTION. NC1074.2 +196100 NUM-ERROR. NC1074.2 +196200 MOVE " PERFORM" TO FEATURE. NC1074.2 +196300 MOVE "NUM-TEST-4 " TO PAR-NAME. NC1074.2 +196400 PERFORM FAIL. NC1074.2 +196500 MOVE NUM-UTILITY TO COMPUTED-N. NC1074.2 +196600 MOVE "SIZE ERROR ENCOUNTERED" TO RE-MARK. NC1074.2 +196700 PERFORM PRINT-DETAIL. NC1074.2 +196800 NUM-EXIT. NC1074.2 +196900 EXIT. NC1074.2 +197000 NUM-TEST-5. NC1074.2 +197100 MOVE " GO TO " TO FEATURE. NC1074.2 +197200 GO TO 000000000000000000000000000002. NC1074.2 +197300 NUM-DELETE-5. NC1074.2 +197400 PERFORM DE-LETE. NC1074.2 +197500 GO TO NUM-WRITE-5. NC1074.2 +197600 000000000000000000000000000002. NC1074.2 +197700 MOVE 2222 TO NUM-UTILITY. NC1074.2 +197800 COMPARE-TEST-5. NC1074.2 +197900 IF NUM-UTILITY EQUAL TO 2222 NC1074.2 +198000 PERFORM PASS NC1074.2 +198100 GO TO NUM-WRITE-5. NC1074.2 +198200 MOVE 2222 TO CORRECT-A. NC1074.2 +198300 MOVE "GO TO PARAGRAPH NOT ENTERED" TO RE-MARK. NC1074.2 +198400 PERFORM FAIL. NC1074.2 +198500 NUM-WRITE-5. NC1074.2 +198600 MOVE "NUM-TEST-5 " TO PAR-NAME. NC1074.2 +198700 PERFORM PRINT-DETAIL. NC1074.2 +198800 CONT-INIT-1. NC1074.2 +198900 MOVE "ABCDEFGHIJ" TO TEST-FIELD. NC1074.2 +199000 MOVE "CONTINUE STATEMENT" TO FEATURE. NC1074.2 +199100 MOVE "VI-77 6.9" TO ANSI-REFERENCE. NC1074.2 +199200 CONT-TEST-1-1. NC1074.2 +199300 IF TEST-FIELD = "ABCDEFGHIJ" NC1074.2 +199400 CONTINUE NC1074.2 +199500 ELSE NC1074.2 +199600 GO TO CONT-FAIL-1. NC1074.2 +199700 PERFORM PASS. NC1074.2 +199800 GO TO CONT-WRITE-1. NC1074.2 +199900 CONT-DELETE-1. NC1074.2 +200000 PERFORM DE-LETE. NC1074.2 +200100 GO TO CONT-WRITE-1. NC1074.2 +200200 CONT-FAIL-1. NC1074.2 +200300 MOVE "CONTINUE STATEMENT" TO FEATURE. NC1074.2 +200400 MOVE TEST-FIELD TO COMPUTED-A. NC1074.2 +200500 MOVE "123456789." TO CORRECT-A. NC1074.2 +200600 PERFORM FAIL. NC1074.2 +200700 CONT-WRITE-1. NC1074.2 +200800 MOVE "CONT-TEST-1" TO PAR-NAME. NC1074.2 +200900 PERFORM PRINT-DETAIL. NC1074.2 +201000 CONT-INIT-2. NC1074.2 +201100 MOVE "ABCDEFGHIJ" TO TEST-FIELD. NC1074.2 +201200 MOVE "CONTINUE STATEMENT" TO FEATURE. NC1074.2 +201300 MOVE "VI-77 6.9" TO ANSI-REFERENCE. NC1074.2 +201400 CONT-TEST-2-1. NC1074.2 +201500 IF TEST-FIELD = "ABCDEFGHIJ" NC1074.2 +201600 PERFORM PASS NC1074.2 +201700 GO TO CONT-WRITE-2 NC1074.2 +201800 ELSE NC1074.2 +201900 CONTINUE. NC1074.2 +202000 GO TO CONT-FAIL-2. NC1074.2 +202100 CONT-DELETE-2. NC1074.2 +202200 PERFORM DE-LETE. NC1074.2 +202300 GO TO CONT-WRITE-2. NC1074.2 +202400 CONT-FAIL-2. NC1074.2 +202500 MOVE TEST-FIELD TO COMPUTED-A. NC1074.2 +202600 MOVE "123456789." TO CORRECT-A. NC1074.2 +202700 PERFORM FAIL. NC1074.2 +202800 CONT-WRITE-2. NC1074.2 +202900 MOVE "CONT-TEST-2" TO PAR-NAME. NC1074.2 +203000 PERFORM PRINT-DETAIL. NC1074.2 +203100 CCVS-EXIT SECTION. NC1074.2 +203200 CCVS-999999. NC1074.2 +203300 GO TO CLOSE-FILES. NC1074.2 diff --git a/tests/cobol85/NC/NC108M.CBL b/tests/cobol85/NC/NC108M.CBL new file mode 100755 index 00000000..931183ba --- /dev/null +++ b/tests/cobol85/NC/NC108M.CBL @@ -0,0 +1,777 @@ +000100 IDENTIFICATION DIVISION. NC1084.2 +000200 PROGRAM-ID. NC1084.2 +000300 NC108M. NC1084.2 +000400**************************************************************** NC1084.2 +000500* * NC1084.2 +000600* VALIDATION FOR:- * NC1084.2 +000700* * NC1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1084.2 +000900* * NC1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1084.2 +001100* * NC1084.2 +001200**************************************************************** NC1084.2 +001300* * NC1084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1084.2 +001500* * NC1084.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1084.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1084.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1084.2 +001900* * NC1084.2 +002000**************************************************************** NC1084.2 +002100* NC1084.2 +002200* PROGRAM NC108M TESTS THE FOLLOWING FEATURES: NC1084.2 +002300* NC1084.2 +002400* COMPACT IDENTIFICATION DIVISION NC1084.2 +002500* COMBINED DATA DESCRIPTION CLAUSES NC1084.2 +002600* ABBREVIATIONS NC1084.2 +002700* COBOL CHARACTER SET NC1084.2 +002800* ALPHABET CLAUSE NC1084.2 +002900* NC1084.2 +003000 ENVIRONMENT DIVISION. NC1084.2 +003100 CONFIGURATION SECTION. NC1084.2 +003200 SOURCE-COMPUTER. NC1084.2 +003300 Linux. NC1084.2 +003400 OBJECT-COMPUTER. NC1084.2 +003500 Linux. NC1084.2 +003600 SPECIAL-NAMES. NC1084.2 +003700 SWITCH-1 NC1084.2 +003800 IS ABBREV-SWITCH NC1084.2 +003900 ON ON-SWITCH NC1084.2 +004000 OFF IS OFF-SWITCH NC1084.2 +004100* ALPHABET THE-WILD-ONE IS NC1084.2 +004200* "A" THRU "H" "I" ALSO "J", ALSO "K", ALSO NC1084.2 +004300* "L" ALSO "M" ALSO "N" "O" THROUGH "Z" "0" THRU "9", NC1084.2 +004400* NC1084.2 +004500* NC1084.2 +004600*ALPHABET-TEST-10 ***** THE WHOLE ALPHABET IS ONE LITERAL NC1084.2 +004700* WITH ALL 51 CHARACTERS IN THE COBOL CHARACTER SET. TEST-10 NC1084.2 +004800* IS ONLY A SYNTAX CHECK ON NC1084.2 +004900* ALPHABET-NAME IS LITERAL. NC1084.2 +005000* NC1084.2 +005100* NC1084.2 +005200* THE-BIG-OL-LITERAL-ALPHABET IS "A+0B-1C*2D/3E=4FL5G,6H;7I.8J"NC1084.2 +005300* ""9K(L)M>N<". NC1084.2 +007000 01 CHARACTER-QUOTE PIC X VALUE QUOTE. NC1084.2 +007100 01 CHARACTER-LOW PIC X(26) VALUE "abcdefghijklmnopqrstuvwxyz". NC1084.2 +007200 01 COMPLETE-01. NC1084.2 +007300 02 COMPLETE-F. NC1084.2 +007400 03 FILLER PICTURE X(90) VALUE SPACE. NC1084.2 +007500 03 FL-LESS PICTURE <(3),<<<.99 VALUE " <1,111.11". NC1084.2 +007600 02 COMPLETE-FORMAT NC1084.2 +007700 REDEFINES COMPLETE-F NC1084.2 +007800 JUSTIFIED RIGHT NC1084.2 +007900 PICTURE X(5) NC1084.2 +008000 OCCURS 20 TIMES NC1084.2 +008100 USAGE IS DISPLAY. NC1084.2 +008200 02 MORE-COMPLETE-FORMAT NC1084.2 +008300 BLANK WHEN ZERO NC1084.2 +008400 PICTURE IS 9 NC1084.2 +008500 SYNCHRONIZED RIGHT NC1084.2 +008600 DISPLAY NC1084.2 +008700 VALUE IS "5". NC1084.2 +008800 01 PIC-GROUP. NC1084.2 +008900 02 FILLER PICTURE X(4) VALUE "AAAA". NC1084.2 +009000 02 FILLER PIC X(4) VALUE "BBBB". NC1084.2 +009100 02 FILLER PIC IS X(4) VALUE "CCCC". NC1084.2 +009200 02 PICTURE X(4) VALUE "DDDD". NC1084.2 +009300 01 PICTURE-ITEM PICTURE X(16) VALUE "AAAABBBBCCCCDDDD". NC1084.2 +009400 01 SEND-JUST PICTURE X(5) VALUE "RIGHT". NC1084.2 +009500 01 RECEIVE-JUST PICTURE X(10) JUST. NC1084.2 +009600 01 RECEIVE-JUSTRIGHT PICTURE X(10) JUST RIGHT. NC1084.2 +009700 01 SEND-BLANK PICTURE 9(5) VALUE ZERO. NC1084.2 +009800 01 RECEIVE-BLANK PICTURE 9(9) BLANK ZERO. NC1084.2 +009900 01 COMP-GROUP. NC1084.2 +010000 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +010100 02 FILLER PICTURE 9(5) VALUE 77777 USAGE IS COMP. NC1084.2 +010200 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +010300 01 COMPUTATIONAL-GROUP. NC1084.2 +010400 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +010500 02 FILLER PICTURE 9(5) VALUE 77777 COMPUTATIONAL. NC1084.2 +010600 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +010700 01 SYNC-GROUP. NC1084.2 +010800 02 PICTURE X(5) VALUE SPACE. NC1084.2 +010900 02 PICTURE 9(5) VALUE 55555 SYNC. NC1084.2 +011000 02 PICTURE X(5) VALUE SPACE. NC1084.2 +011100 01 SYNCHRONIZED-GROUP. NC1084.2 +011200 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +011300 02 FILLER PICTURE 9(5) VALUE 55555 SYNCHRONIZED. NC1084.2 +011400 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +011500 01 SYNC-RIGHT-GROUP. NC1084.2 +011600 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +011700 02 FILLER PICTURE 9(5) VALUE 33333 SYNC RIGHT. NC1084.2 +011800 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +011900 01 SYNCHRONIZED-RIGHT-GROUP. NC1084.2 +012000 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012100 02 FILLER PICTURE 9(5) VALUE 33333 SYNCHRONIZED RIGHT. NC1084.2 +012200 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012300 01 SYNC-LEFT-GROUP. NC1084.2 +012400 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012500 02 FILLER PICTURE 9(5) VALUE 11111 SYNC LEFT. NC1084.2 +012600 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012700 01 SYNCHRONIZED-LEFT-GROUP. NC1084.2 +012800 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +012900 02 FILLER PICTURE 9(5) VALUE 11111 SYNCHRONIZED LEFT. NC1084.2 +013000 02 FILLER PICTURE X(5) VALUE SPACE. NC1084.2 +013100 01 TEST-FIELD PIC X(10). NC1084.2 +013200 01 REDEFINES TEST-FIELD NC1084.2 +013300 PIC 9(9). NC1084.2 +013400 01 TEST-RESULTS. NC1084.2 +013500 02 FILLER PIC X VALUE SPACE. NC1084.2 +013600 02 FEATURE PIC X(20) VALUE SPACE. NC1084.2 +013700 02 FILLER PIC X VALUE SPACE. NC1084.2 +013800 02 P-OR-F PIC X(5) VALUE SPACE. NC1084.2 +013900 02 FILLER PIC X VALUE SPACE. NC1084.2 +014000 02 PAR-NAME. NC1084.2 +014100 03 FILLER PIC X(19) VALUE SPACE. NC1084.2 +014200 03 PARDOT-X PIC X VALUE SPACE. NC1084.2 +014300 03 DOTVALUE PIC 99 VALUE ZERO. NC1084.2 +014400 02 FILLER PIC X(8) VALUE SPACE. NC1084.2 +014500 02 RE-MARK PIC X(61). NC1084.2 +014600 01 TEST-COMPUTED. NC1084.2 +014700 02 FILLER PIC X(30) VALUE SPACE. NC1084.2 +014800 02 FILLER PIC X(17) VALUE NC1084.2 +014900 " COMPUTED=". NC1084.2 +015000 02 COMPUTED-X. NC1084.2 +015100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1084.2 +015200 03 COMPUTED-N REDEFINES COMPUTED-A NC1084.2 +015300 PIC -9(9).9(9). NC1084.2 +015400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1084.2 +015500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1084.2 +015600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1084.2 +015700 03 CM-18V0 REDEFINES COMPUTED-A. NC1084.2 +015800 04 COMPUTED-18V0 PIC -9(18). NC1084.2 +015900 04 FILLER PIC X. NC1084.2 +016000 03 FILLER PIC X(50) VALUE SPACE. NC1084.2 +016100 01 TEST-CORRECT. NC1084.2 +016200 02 FILLER PIC X(30) VALUE SPACE. NC1084.2 +016300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1084.2 +016400 02 CORRECT-X. NC1084.2 +016500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1084.2 +016600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1084.2 +016700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1084.2 +016800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1084.2 +016900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1084.2 +017000 03 CR-18V0 REDEFINES CORRECT-A. NC1084.2 +017100 04 CORRECT-18V0 PIC -9(18). NC1084.2 +017200 04 FILLER PIC X. NC1084.2 +017300 03 FILLER PIC X(2) VALUE SPACE. NC1084.2 +017400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1084.2 +017500 01 CCVS-C-1. NC1084.2 +017600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1084.2 +017700- "SS PARAGRAPH-NAME NC1084.2 +017800- " REMARKS". NC1084.2 +017900 02 FILLER PIC X(20) VALUE SPACE. NC1084.2 +018000 01 CCVS-C-2. NC1084.2 +018100 02 FILLER PIC X VALUE SPACE. NC1084.2 +018200 02 FILLER PIC X(6) VALUE "TESTED". NC1084.2 +018300 02 FILLER PIC X(15) VALUE SPACE. NC1084.2 +018400 02 FILLER PIC X(4) VALUE "FAIL". NC1084.2 +018500 02 FILLER PIC X(94) VALUE SPACE. NC1084.2 +018600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1084.2 +018700 01 REC-CT PIC 99 VALUE ZERO. NC1084.2 +018800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1084.2 +018900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1084.2 +019000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1084.2 +019100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1084.2 +019200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1084.2 +019300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1084.2 +019400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1084.2 +019500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1084.2 +019600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1084.2 +019700 01 CCVS-H-1. NC1084.2 +019800 02 FILLER PIC X(39) VALUE SPACES. NC1084.2 +019900 02 FILLER PIC X(42) VALUE NC1084.2 +020000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1084.2 +020100 02 FILLER PIC X(39) VALUE SPACES. NC1084.2 +020200 01 CCVS-H-2A. NC1084.2 +020300 02 FILLER PIC X(40) VALUE SPACE. NC1084.2 +020400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1084.2 +020500 02 FILLER PIC XXXX VALUE NC1084.2 +020600 "4.2 ". NC1084.2 +020700 02 FILLER PIC X(28) VALUE NC1084.2 +020800 " COPY - NOT FOR DISTRIBUTION". NC1084.2 +020900 02 FILLER PIC X(41) VALUE SPACE. NC1084.2 +021000 NC1084.2 +021100 01 CCVS-H-2B. NC1084.2 +021200 02 FILLER PIC X(15) VALUE NC1084.2 +021300 "TEST RESULT OF ". NC1084.2 +021400 02 TEST-ID PIC X(9). NC1084.2 +021500 02 FILLER PIC X(4) VALUE NC1084.2 +021600 " IN ". NC1084.2 +021700 02 FILLER PIC X(12) VALUE NC1084.2 +021800 " HIGH ". NC1084.2 +021900 02 FILLER PIC X(22) VALUE NC1084.2 +022000 " LEVEL VALIDATION FOR ". NC1084.2 +022100 02 FILLER PIC X(58) VALUE NC1084.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1084.2 +022300 01 CCVS-H-3. NC1084.2 +022400 02 FILLER PIC X(34) VALUE NC1084.2 +022500 " FOR OFFICIAL USE ONLY ". NC1084.2 +022600 02 FILLER PIC X(58) VALUE NC1084.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1084.2 +022800 02 FILLER PIC X(28) VALUE NC1084.2 +022900 " COPYRIGHT 1985 ". NC1084.2 +023000 01 CCVS-E-1. NC1084.2 +023100 02 FILLER PIC X(52) VALUE SPACE. NC1084.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1084.2 +023300 02 ID-AGAIN PIC X(9). NC1084.2 +023400 02 FILLER PIC X(45) VALUE SPACES. NC1084.2 +023500 01 CCVS-E-2. NC1084.2 +023600 02 FILLER PIC X(31) VALUE SPACE. NC1084.2 +023700 02 FILLER PIC X(21) VALUE SPACE. NC1084.2 +023800 02 CCVS-E-2-2. NC1084.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1084.2 +024000 03 FILLER PIC X VALUE SPACE. NC1084.2 +024100 03 ENDER-DESC PIC X(44) VALUE NC1084.2 +024200 "ERRORS ENCOUNTERED". NC1084.2 +024300 01 CCVS-E-3. NC1084.2 +024400 02 FILLER PIC X(22) VALUE NC1084.2 +024500 " FOR OFFICIAL USE ONLY". NC1084.2 +024600 02 FILLER PIC X(12) VALUE SPACE. NC1084.2 +024700 02 FILLER PIC X(58) VALUE NC1084.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1084.2 +024900 02 FILLER PIC X(13) VALUE SPACE. NC1084.2 +025000 02 FILLER PIC X(15) VALUE NC1084.2 +025100 " COPYRIGHT 1985". NC1084.2 +025200 01 CCVS-E-4. NC1084.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1084.2 +025400 02 FILLER PIC X(4) VALUE " OF ". NC1084.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1084.2 +025600 02 FILLER PIC X(40) VALUE NC1084.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1084.2 +025800 01 XXINFO. NC1084.2 +025900 02 FILLER PIC X(19) VALUE NC1084.2 +026000 "*** INFORMATION ***". NC1084.2 +026100 02 INFO-TEXT. NC1084.2 +026200 04 FILLER PIC X(8) VALUE SPACE. NC1084.2 +026300 04 XXCOMPUTED PIC X(20). NC1084.2 +026400 04 FILLER PIC X(5) VALUE SPACE. NC1084.2 +026500 04 XXCORRECT PIC X(20). NC1084.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). NC1084.2 +026700 01 HYPHEN-LINE. NC1084.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. NC1084.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************NC1084.2 +027000- "*****************************************". NC1084.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************NC1084.2 +027200- "******************************". NC1084.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE NC1084.2 +027400 "NC108M". NC1084.2 +027500 PROCEDURE DIVISION. NC1084.2 +027600 CCVS1 SECTION. NC1084.2 +027700 OPEN-FILES. NC1084.2 +027800 OPEN OUTPUT PRINT-FILE. NC1084.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1084.2 +028000 MOVE SPACE TO TEST-RESULTS. NC1084.2 +028100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1084.2 +028200 GO TO CCVS1-EXIT. NC1084.2 +028300 CLOSE-FILES. NC1084.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1084.2 +028500 TERMINATE-CCVS. NC1084.2 +028600*S EXIT PROGRAM. NC1084.2 +028700*SERMINATE-CALL. NC1084.2 +028800 STOP RUN. NC1084.2 +028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1084.2 +029000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1084.2 +029100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1084.2 +029200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1084.2 +029300 MOVE "****TEST DELETED****" TO RE-MARK. NC1084.2 +029400 PRINT-DETAIL. NC1084.2 +029500 IF REC-CT NOT EQUAL TO ZERO NC1084.2 +029600 MOVE "." TO PARDOT-X NC1084.2 +029700 MOVE REC-CT TO DOTVALUE. NC1084.2 +029800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1084.2 +029900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1084.2 +030000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1084.2 +030100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1084.2 +030200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1084.2 +030300 MOVE SPACE TO CORRECT-X. NC1084.2 +030400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1084.2 +030500 MOVE SPACE TO RE-MARK. NC1084.2 +030600 HEAD-ROUTINE. NC1084.2 +030700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +030800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +030900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1084.2 +031000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1084.2 +031100 COLUMN-NAMES-ROUTINE. NC1084.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +031500 END-ROUTINE. NC1084.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1084.2 +031700 END-RTN-EXIT. NC1084.2 +031800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +031900 END-ROUTINE-1. NC1084.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1084.2 +032100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1084.2 +032200 ADD PASS-COUNTER TO ERROR-HOLD. NC1084.2 +032300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1084.2 +032400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1084.2 +032500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1084.2 +032600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1084.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1084.2 +032800 END-ROUTINE-12. NC1084.2 +032900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1084.2 +033000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1084.2 +033100 MOVE "NO " TO ERROR-TOTAL NC1084.2 +033200 ELSE NC1084.2 +033300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1084.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1084.2 +033500 PERFORM WRITE-LINE. NC1084.2 +033600 END-ROUTINE-13. NC1084.2 +033700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1084.2 +033800 MOVE "NO " TO ERROR-TOTAL ELSE NC1084.2 +033900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1084.2 +034000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1084.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +034200 IF INSPECT-COUNTER EQUAL TO ZERO NC1084.2 +034300 MOVE "NO " TO ERROR-TOTAL NC1084.2 +034400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1084.2 +034500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1084.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +034700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1084.2 +034800 WRITE-LINE. NC1084.2 +034900 ADD 1 TO RECORD-COUNT. NC1084.2 +035000 IF RECORD-COUNT GREATER 50 NC1084.2 +035100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1084.2 +035200 MOVE SPACE TO DUMMY-RECORD NC1084.2 +035300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1084.2 +035400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1084.2 +035500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1084.2 +035600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1084.2 +035700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1084.2 +035800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1084.2 +035900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1084.2 +036000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1084.2 +036100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1084.2 +036200 MOVE ZERO TO RECORD-COUNT. NC1084.2 +036300 PERFORM WRT-LN. NC1084.2 +036400 WRT-LN. NC1084.2 +036500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1084.2 +036600 MOVE SPACE TO DUMMY-RECORD. NC1084.2 +036700 BLANK-LINE-PRINT. NC1084.2 +036800 PERFORM WRT-LN. NC1084.2 +036900 FAIL-ROUTINE. NC1084.2 +037000 IF COMPUTED-X NOT EQUAL TO SPACE NC1084.2 +037100 GO TO FAIL-ROUTINE-WRITE. NC1084.2 +037200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1084.2 +037300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1084.2 +037400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1084.2 +037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +037600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1084.2 +037700 GO TO FAIL-ROUTINE-EX. NC1084.2 +037800 FAIL-ROUTINE-WRITE. NC1084.2 +037900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1084.2 +038000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1084.2 +038100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1084.2 +038200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1084.2 +038300 FAIL-ROUTINE-EX. EXIT. NC1084.2 +038400 BAIL-OUT. NC1084.2 +038500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1084.2 +038600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1084.2 +038700 BAIL-OUT-WRITE. NC1084.2 +038800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1084.2 +038900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1084.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1084.2 +039100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1084.2 +039200 BAIL-OUT-EX. EXIT. NC1084.2 +039300 CCVS1-EXIT. NC1084.2 +039400 EXIT. NC1084.2 +039500*IDENTIFICATION DIVISION. NC1084.2 +039600* NOTE THE ENTIRE IDENTIFICATION DIVISION IS OPTIONAL, WITH THENC1084.2 +039700* EXCEPTION OF THE IDENTIFICATION DIVISION AND PROGRAM-ID NC1084.2 +039800* CLAUSES. AS A TEST, ALL THE OPTIONAL CLAUSES HAVE BEEN NC1084.2 +039900* REMOVED. INFORMATION NORMALLY GIVEN THERE IS LISTED BELOW NC1084.2 +040000* AS A COMMENT. ADDITIONALLY, KEY WORDS ARE USED IN COMMENT NC1084.2 +040100* LINES TO ASCERTAIN WHETHER COMMENTS ARE BEING SYNTAX CHECKED.NC1084.2 +040200**************************************************************** NC1084.2 +040300* * NC1084.2 +040400* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * NC1084.2 +040500* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * NC1084.2 +040600* COMFORMANCE WITH THE AMERICAN NATIONAL STANDARD * NC1084.2 +040700* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * NC1084.2 +040800* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * NC1084.2 +040900* (ISO DOCUMENT REFERENCE: ISO ). * NC1084.2 +041000* * NC1084.2 +041100* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * NC1084.2 +041200* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * NC1084.2 +041300* DOCUMENT REFERENCE: ). * NC1084.2 +041400* * NC1084.2 +041500* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * NC1084.2 +041600* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * NC1084.2 +041700* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * NC1084.2 +041800* * NC1084.2 +041900* THE FEDERAL SOFTWARE TESTING CENTRE * NC1084.2 +042000* OFFICE OF SOFTWARE DEVELOPMENT * NC1084.2 +042100* & INFORMATION TECHNOLOGY * NC1084.2 +042200* TWO SKYLINE PLACE * NC1084.2 +042300* SUITE 1100 * NC1084.2 +042400* 5203 LEESBURG PIKE * NC1084.2 +042500* FALLS CHURCH * NC1084.2 +042600* VA 22041 * NC1084.2 +042700* U.S.A. * NC1084.2 +042800* * NC1084.2 +042900* THE PROJECT TEAM MEMBERS WERE: * NC1084.2 +043000* * NC1084.2 +043100* BIADI (BUREAU INTER ADMINISTRATION * NC1084.2 +043200* DE DOCUMENTATION INFORMATIQUE) * NC1084.2 +043300* 21 RUE BARA * NC1084.2 +043400* F-92132 ISSY * NC1084.2 +043500* FRANCE * NC1084.2 +043600* * NC1084.2 +043700* * NC1084.2 +043800* GMD (GESELLSCHAFT FUR MATHEMATIK * NC1084.2 +043900* UND DATENVERARBEITUNG MBH) * NC1084.2 +044000* SCHLOSS BIRLINGHOVEN * NC1084.2 +044100* POSTFACH 12 40 * NC1084.2 +044200* D-5205 ST. AUGUSTIN 1 * NC1084.2 +044300* GERMANY FR * NC1084.2 +044400* * NC1084.2 +044500* * NC1084.2 +044600* NCC (THE NATIONAL COMPUTING CENTRE LTD) * NC1084.2 +044700* OXFORD ROAD * NC1084.2 +044800* MANCHESTER * NC1084.2 +044900* M1 7ED * NC1084.2 +045000* UNITED KINGDOM * NC1084.2 +045100* * NC1084.2 +045200* * NC1084.2 +045300* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * NC1084.2 +045400* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * NC1084.2 +045500* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * NC1084.2 +045600* * NC1084.2 +045700**************************************************************** NC1084.2 +045800* * NC1084.2 +045900* VALIDATION FOR:- * NC1084.2 +046000* " HIGH ". NC1084.2 +046100* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * NC1084.2 +046200* * NC1084.2 +046300* CREATION DATE / VALIDATION DATE * NC1084.2 +046400* "4.2 ". NC1084.2 +046500* * NC1084.2 +046600**************************************************************** NC1084.2 +046700* NC1084.2 +046800* PROGRAM NC108M TESTS THE FOLLOWING FEATURES: NC1084.2 +046900* NC1084.2 +047000* COMPACT "IDENTIFICATION DIVISION" NC1084.2 +047100* COMBINED DATA DESCRIPTION CLAUSES NC1084.2 +047200* ABBREVIATIONS NC1084.2 +047300* COBOL CHARACTER SET NC1084.2 +047400* ALPHABET CLAUSE NC1084.2 +047500* NC1084.2 +047600* NC1084.2 +047700* NC1084.2 +047800* THE SOURCE LINES IN THE ENVIRONMENT AND DATA DIVISION NC1084.2 +047900* SHOULD BE REPLACED AS FOLLOWS NC1084.2 +048000* XXXXX36 REPLACE WITH SYSTEM OUTPUT DEVICE (PRINTER) NC1084.2 +048100* FILE-NAME IS PRINT-FILE. NC1084.2 +048200* XXXXX38 REPLACE WITH SYSTEM NAME FOR A SWITCH NC1084.2 +048300* SWITCH-NAME IS ABBREV-SEITCH. NC1084.2 +048400* XXXXX49 REPLACE WITH SOURCE COMPUTER NAME NC1084.2 +048500* XXXXX50 REPLACE WITH OBJECT COMPUTER NAME NC1084.2 +048600* NC1084.2 +048700* THE DOD COBOL TEST ROUTINES HAVE BEEN CREATED TO BE NC1084.2 +048800* USED TO VALIDATE THAT NC1084.2 +048900* NC1084.2 +049000* 1 A COBOL COMPILER CONTAINS THE ELEMENTS OF THE NC1084.2 +049100* ANSI COBOL. NC1084.2 +049200* NC1084.2 +049300* 2 TO PROVIDE EXAMPLES OF THE USES OF THE DIFFERENT NC1084.2 +049400* ELEMENTS OF THE COBOL LANGUAGE. NC1084.2 +049500* NC1084.2 +049600* 3 TO BE USED AS TEST DATA FOR PRE-PROCESSORS NC1084.2 +049700* FLOWCHARTERS ETC. NC1084.2 +049800* NC1084.2 +049900* 4 IT IS HOPED THAT EVALUATIONS CORRECTIONS NC1084.2 +050000* SUGGESTIONS AND COMMENTS WILL BE FORWARDED TO NC1084.2 +050100* NAVY PROGRAMMING LANGUAGES DIVISION NC1084.2 +050200* ROOM 2C319 THE PENTAGON NC1084.2 +050300* WASHINGTON D C 20350. NC1084.2 +050400* * * * * * * * * * * * * * * * * * * * * *.NC1084.2 +050500* NC1084.2 +050600* PHONE (202) 695-4750. NC1084.2 +050700* NC1084.2 +050800* * * * * * * * * * * * * * * * * * * * * *.NC1084.2 +050900 FMT-INIT-GF-1. NC1084.2 +051000 MOVE "COMPLETE DATA FORMAT" TO FEATURE. NC1084.2 +051100 MOVE "V1-6 3.2.1.1" TO ANSI-REFERENCE. NC1084.2 +051200 FMT-TEST-GF-1. NC1084.2 +051300 MOVE COMPLETE-FORMAT (19) TO COMPUTED-A. NC1084.2 +051400 MOVE " <1,1" TO CORRECT-A. NC1084.2 +051500 IF COMPLETE-FORMAT (19) EQUAL TO " <1,1" NC1084.2 +051600 MOVE "FAILURE IF DOLLAR APPEARS" TO RE-MARK NC1084.2 +051700 GO TO FMT-WRITE-GF-1. NC1084.2 +051800 PERFORM FAIL. NC1084.2 +051900 MOVE "LESS THAN SHOULD APPEAR" TO RE-MARK. NC1084.2 +052000 GO TO FMT-WRITE-GF-1. NC1084.2 +052100 FMT-DELETE-GF-1. NC1084.2 +052200 PERFORM DE-LETE. NC1084.2 +052300 FMT-WRITE-GF-1. NC1084.2 +052400 MOVE "FMT-TEST-GF-1" TO PAR-NAME. NC1084.2 +052500 PERFORM PRINT-DETAIL. NC1084.2 +052600 FMT-INIT-GF-2. NC1084.2 +052700 MOVE "V1-20 5.3" TO ANSI-REFERENCE. NC1084.2 +052800 FMT-TEST-GF-2. NC1084.2 +052900 IF MORE-COMPLETE-FORMAT NOT EQUAL TO "5" NC1084.2 +053000 PERFORM FAIL NC1084.2 +053100 ELSE PERFORM PASS NC1084.2 +053200 GO TO FMT-WRITE-GF-2. NC1084.2 +053300 MOVE MORE-COMPLETE-FORMAT TO COMPUTED-A. NC1084.2 +053400 MOVE "5" TO CORRECT-A. NC1084.2 +053500 GO TO FMT-WRITE-GF-2. NC1084.2 +053600 FMT-DELETE-GF-2. NC1084.2 +053700 PERFORM DE-LETE. NC1084.2 +053800 FMT-WRITE-GF-2. NC1084.2 +053900 MOVE "FMT-TEST-GF-2" TO PAR-NAME. NC1084.2 +054000 PERFORM PRINT-DETAIL. NC1084.2 +054100 FMT-TEST-GF-3. NC1084.2 +054200 MOVE ZERO TO MORE-COMPLETE-FORMAT. NC1084.2 +054300 IF MORE-COMPLETE-FORMAT EQUAL TO SPACE NC1084.2 +054400 PERFORM PASS NC1084.2 +054500 GO TO FMT-WRITE-GF-3. NC1084.2 +054600 PERFORM FAIL. NC1084.2 +054700 MOVE MORE-COMPLETE-FORMAT TO COMPUTED-A. NC1084.2 +054800 MOVE " (SPACES)" TO CORRECT-A. NC1084.2 +054900 GO TO FMT-WRITE-GF-3. NC1084.2 +055000 FMT-DELETE-GF-3. NC1084.2 +055100 PERFORM DE-LETE. NC1084.2 +055200 FMT-WRITE-GF-3. NC1084.2 +055300 MOVE "FMT-TEST-GF-3" TO PAR-NAME. NC1084.2 +055400 PERFORM PRINT-DETAIL. NC1084.2 +055500 ABR-INIT-GF-1. NC1084.2 +055600 MOVE "DATA DESCR ABBREVS -" TO FEATURE. NC1084.2 +055700 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +055800 PERFORM PRINT-DETAIL. NC1084.2 +055900 ABR-TEST-GF-1. NC1084.2 +056000 IF PIC-GROUP IS EQUAL TO PICTURE-ITEM NC1084.2 +056100 PERFORM PASS GO TO ABR-WRITE-GF-1. NC1084.2 +056200 GO TO ABR-FAIL-GF-1. NC1084.2 +056300 ABR-DELETE-GF-1. NC1084.2 +056400 PERFORM DE-LETE. NC1084.2 +056500 GO TO ABR-WRITE-GF-1. NC1084.2 +056600 ABR-FAIL-GF-1. NC1084.2 +056700 MOVE PIC-GROUP TO COMPUTED-A. NC1084.2 +056800 MOVE PICTURE-ITEM TO CORRECT-A. NC1084.2 +056900 PERFORM FAIL. NC1084.2 +057000 ABR-WRITE-GF-1. NC1084.2 +057100 MOVE " PIC" TO FEATURE. NC1084.2 +057200 MOVE "ABR-TEST-GF-1 " TO PAR-NAME. NC1084.2 +057300 PERFORM PRINT-DETAIL. NC1084.2 +057400 ABR-INIT-GF-2. NC1084.2 +057500 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +057600 MOVE SEND-JUST TO RECEIVE-JUSTRIGHT. NC1084.2 +057700 ABR-TEST-GF-2. NC1084.2 +057800 IF RECEIVE-JUSTRIGHT EQUAL TO " RIGHT" NC1084.2 +057900 PERFORM PASS GO TO ABR-WRITE-GF-2. NC1084.2 +058000 GO TO ABR-FAIL-GF-2. NC1084.2 +058100 ABR-DELETE-GF-2. NC1084.2 +058200 PERFORM DE-LETE. NC1084.2 +058300 GO TO ABR-WRITE-GF-2. NC1084.2 +058400 ABR-FAIL-GF-2. NC1084.2 +058500 PERFORM FAIL. NC1084.2 +058600 MOVE RECEIVE-JUSTRIGHT TO COMPUTED-A. NC1084.2 +058700 MOVE " RIGHT" TO CORRECT-A. NC1084.2 +058800 ABR-WRITE-GF-2. NC1084.2 +058900 MOVE " JUST" TO FEATURE NC1084.2 +059000 MOVE "ABR-TEST-GF-2 " TO PAR-NAME. NC1084.2 +059100 PERFORM PRINT-DETAIL. NC1084.2 +059200 ABR-INIT-GF-3. NC1084.2 +059300 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +059400 MOVE SEND-JUST TO RECEIVE-JUST. NC1084.2 +059500 ABR-TEST-GF-3. NC1084.2 +059600 IF RECEIVE-JUST EQUAL TO " RIGHT" NC1084.2 +059700 PERFORM PASS GO TO ABR-WRITE-GF-3. NC1084.2 +059800 GO TO ABR-FAIL-GF-3. NC1084.2 +059900 ABR-DELETE-GF-3. NC1084.2 +060000 PERFORM DE-LETE. NC1084.2 +060100 GO TO ABR-WRITE-GF-3. NC1084.2 +060200 ABR-FAIL-GF-3. NC1084.2 +060300 PERFORM FAIL. NC1084.2 +060400 MOVE RECEIVE-JUST TO COMPUTED-A. NC1084.2 +060500 MOVE " RIGHT" TO CORRECT-A. NC1084.2 +060600 ABR-WRITE-GF-3. NC1084.2 +060700 MOVE "ABR-TEST-GF-3 " TO PAR-NAME. NC1084.2 +060800 PERFORM PRINT-DETAIL. NC1084.2 +060900 ABR-INIT-GF-4. NC1084.2 +061000 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +061100 MOVE SEND-BLANK TO RECEIVE-BLANK. NC1084.2 +061200 ABR-TEST-GF-4. NC1084.2 +061300 IF RECEIVE-BLANK EQUAL TO " " NC1084.2 +061400 PERFORM PASS GO TO ABR-WRITE-GF-4. NC1084.2 +061500 GO TO ABR-FAIL-GF-4. NC1084.2 +061600 ABR-DELETE-GF-4. NC1084.2 +061700 PERFORM DE-LETE. NC1084.2 +061800 GO TO ABR-WRITE-GF-4. NC1084.2 +061900 ABR-FAIL-GF-4. NC1084.2 +062000 PERFORM FAIL. NC1084.2 +062100 MOVE RECEIVE-BLANK TO COMPUTED-A. NC1084.2 +062200 MOVE " (SPACES)" TO CORRECT-A. NC1084.2 +062300 ABR-WRITE-GF-4. NC1084.2 +062400 MOVE " BLANK ZERO" TO FEATURE NC1084.2 +062500 MOVE "ABR-TEST-GF-4 " TO PAR-NAME. NC1084.2 +062600 PERFORM PRINT-DETAIL. NC1084.2 +062700 ABR-INIT-GF-5. NC1084.2 +062800 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +062900 ABR-TEST-GF-5. NC1084.2 +063000 IF COMP-GROUP EQUAL TO COMPUTATIONAL-GROUP NC1084.2 +063100 PERFORM PASS GO TO ABR-WRITE-GF-5. NC1084.2 +063200 GO TO ABR-FAIL-GF-5. NC1084.2 +063300 ABR-DELETE-GF-5. NC1084.2 +063400 PERFORM DE-LETE. NC1084.2 +063500 GO TO ABR-WRITE-GF-5. NC1084.2 +063600 ABR-FAIL-GF-5. NC1084.2 +063700 PERFORM FAIL. NC1084.2 +063800 MOVE COMP-GROUP TO COMPUTED-A. NC1084.2 +063900 MOVE COMPUTATIONAL-GROUP TO CORRECT-A. NC1084.2 +064000 ABR-WRITE-GF-5. NC1084.2 +064100 MOVE " COMP" TO FEATURE. NC1084.2 +064200 MOVE "ABR-TEST-GF-5 " TO PAR-NAME. NC1084.2 +064300 PERFORM PRINT-DETAIL. NC1084.2 +064400 ABR-INIT-GF-6. NC1084.2 +064500 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +064600 ABR-TEST-GF-6. NC1084.2 +064700 IF SYNC-GROUP EQUAL TO SYNCHRONIZED-GROUP NC1084.2 +064800 PERFORM PASS GO TO ABR-WRITE-GF-6. NC1084.2 +064900 GO TO ABR-FAIL-GF-6. NC1084.2 +065000 ABR-DELETE-GF-6. NC1084.2 +065100 PERFORM DE-LETE. NC1084.2 +065200 GO TO ABR-WRITE-GF-6. NC1084.2 +065300 ABR-FAIL-GF-6. NC1084.2 +065400 PERFORM FAIL. NC1084.2 +065500 MOVE SYNC-GROUP TO COMPUTED-A. NC1084.2 +065600 MOVE SYNCHRONIZED-GROUP TO CORRECT-A. NC1084.2 +065700 ABR-WRITE-GF-6. NC1084.2 +065800 MOVE " SYNC" TO FEATURE NC1084.2 +065900 MOVE "ABR-TEST-GF-6 " TO PAR-NAME. NC1084.2 +066000 PERFORM PRINT-DETAIL. NC1084.2 +066100 ABR-INIT-GF-7. NC1084.2 +066200 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +066300 ABR-TEST-GF-7. NC1084.2 +066400 IF SYNC-RIGHT-GROUP EQUAL TO SYNCHRONIZED-RIGHT-GROUP NC1084.2 +066500 PERFORM PASS GO TO ABR-WRITE-GF-7. NC1084.2 +066600 GO TO ABR-FAIL-GF-7. NC1084.2 +066700 ABR-DELETE-GF-7. NC1084.2 +066800 PERFORM DE-LETE. NC1084.2 +066900 GO TO ABR-WRITE-GF-7. NC1084.2 +067000 ABR-FAIL-GF-7. NC1084.2 +067100 PERFORM FAIL. NC1084.2 +067200 MOVE SYNC-RIGHT-GROUP TO COMPUTED-A. NC1084.2 +067300 MOVE SYNCHRONIZED-RIGHT-GROUP TO CORRECT-A. NC1084.2 +067400 ABR-WRITE-GF-7. NC1084.2 +067500 MOVE "ABR-TEST-GF-7 " TO PAR-NAME. NC1084.2 +067600 PERFORM PRINT-DETAIL. NC1084.2 +067700 ABR-INIT-GF-8. NC1084.2 +067800 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +067900 ABR-TEST-GF-8. NC1084.2 +068000 IF SYNC-LEFT-GROUP EQUAL TO SYNCHRONIZED-LEFT-GROUP NC1084.2 +068100 PERFORM PASS GO TO ABR-WRITE-GF-8. NC1084.2 +068200 GO TO ABR-FAIL-GF-8. NC1084.2 +068300 ABR-DELETE-GF-8. NC1084.2 +068400 PERFORM DE-LETE. NC1084.2 +068500 GO TO ABR-WRITE-GF-8. NC1084.2 +068600 ABR-FAIL-GF-8. NC1084.2 +068700 PERFORM FAIL. NC1084.2 +068800 MOVE SYNC-LEFT-GROUP TO COMPUTED-A. NC1084.2 +068900 MOVE SYNCHRONIZED-LEFT-GROUP TO CORRECT-A. NC1084.2 +069000 ABR-WRITE-GF-8. NC1084.2 +069100 MOVE "ABR-TEST-GF-8 " TO PAR-NAME. NC1084.2 +069200 PERFORM PRINT-DETAIL. NC1084.2 +069300 ABR-INIT-GF-9. NC1084.2 +069400 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +069500 ABR-TEST-GF-9. NC1084.2 +069600 MOVE ZERO TO ONE NC1084.2 +069700 IF ON-SWITCH ADD 1 TO ONE. NC1084.2 +069800 IF OFF-SWITCH ADD 1 TO ONE. NC1084.2 +069900 IF ONE EQUAL TO 1 PERFORM PASS GO TO ABR-WRITE-GF-9 NC1084.2 +070000 ELSE MOVE 1 TO ONE GO TO ABR-FAIL-GF-9. NC1084.2 +070100 ABR-DELETE-GF-9. NC1084.2 +070200 PERFORM DE-LETE. NC1084.2 +070300 GO TO ABR-WRITE-GF-9. NC1084.2 +070400 ABR-FAIL-GF-9. NC1084.2 +070500 PERFORM FAIL. NC1084.2 +070600 MOVE "NOT BOOLEAN COMPLEMENTS" TO RE-MARK. NC1084.2 +070700 ABR-WRITE-GF-9. NC1084.2 +070800 MOVE "SPECIAL-NAMES SWITCH" TO FEATURE. NC1084.2 +070900 MOVE "ABR-TEST-GF-9 " TO PAR-NAME. NC1084.2 +071000 PERFORM PRINT-DETAIL. NC1084.2 +071100 ABR-INIT-GF-10. NC1084.2 +071200 MOVE "VI-20 5.3" TO ANSI-REFERENCE. NC1084.2 +071300 MOVE ZERO TO FL-LESS. NC1084.2 +071400 MOVE FL-LESS TO COMPUTED-A. NC1084.2 +071500 MOVE " <.00" TO CORRECT-A. NC1084.2 +071600 ABR-TEST-GF-10. NC1084.2 +071700 IF FL-LESS EQUAL TO " <.00" NC1084.2 +071800 MOVE "FAILURE IF DOLLAR APPEARS" TO RE-MARK NC1084.2 +071900 GO TO ABR-WRITE-GF-10. NC1084.2 +072000 GO TO ABR-FAIL-GF-10. NC1084.2 +072100 ABR-DELETE-GF-10. NC1084.2 +072200 PERFORM DE-LETE. NC1084.2 +072300 GO TO ABR-WRITE-GF-10. NC1084.2 +072400 ABR-FAIL-GF-10. NC1084.2 +072500 PERFORM FAIL. NC1084.2 +072600 MOVE "LESS THAN SHOULD APPEAR" TO RE-MARK. NC1084.2 +072700 ABR-WRITE-GF-10. NC1084.2 +072800 MOVE "ABR-TEST-GF-10" TO PAR-NAME. NC1084.2 +072900 MOVE "SPECIAL-NAMES CURNCY" TO FEATURE. NC1084.2 +073000 PERFORM PRINT-DETAIL. NC1084.2 +073100 CHA-INIT-1. NC1084.2 +073200 MOVE "III-3" TO ANSI-REFERENCE. NC1084.2 +073300 CHA-GF-1-1. NC1084.2 +073400 IF XCHAR-SET EQUAL TO NC1084.2 +073500 "ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 +-*/=$,.;()><" NC1084.2 +073600 PERFORM PASS ELSE PERFORM FAIL. NC1084.2 +073700* NOTE 51 CHARACTER LITERAL INCLUDES TWO SPACES BUT NO NC1084.2 +073800* QUOTE. NC1084.2 +073900 GO TO CHA-WRITE-GF-1-1. NC1084.2 +074000 CHA-DELETE-GF-1-1. NC1084.2 +074100 PERFORM DE-LETE. NC1084.2 +074200 CHA-WRITE-GF-1-1. NC1084.2 +074300 MOVE "CHARACTER-SET" TO FEATURE. NC1084.2 +074400 MOVE "CHA-GF-1-1" TO PAR-NAME. NC1084.2 +074500 PERFORM PRINT-DETAIL. NC1084.2 +074600 CHA-GF-1-2. NC1084.2 +074700 IF CHARACTER-QUOTE = QUOTE NC1084.2 +074800 PERFORM PASS ELSE PERFORM FAIL. NC1084.2 +074900 GO TO CHA-WRITE-GF-1-2. NC1084.2 +075000 CHA-DELETE-GF-1-2. NC1084.2 +075100 PERFORM DE-LETE. NC1084.2 +075200 CHA-WRITE-GF-1-2. NC1084.2 +075300 MOVE "CHARACTER-SET" TO FEATURE. NC1084.2 +075400 MOVE "CHA-GF-1-2" TO PAR-NAME. NC1084.2 +075500 PERFORM PRINT-DETAIL. NC1084.2 +075600 CHA-GF-1-3. NC1084.2 +075700 IF CHARACTER-LOW = "abcdefghijklmnopqrstuvwxyz" NC1084.2 +075800 PERFORM PASS ELSE PERFORM FAIL. NC1084.2 +075900 GO TO CHA-WRITE-GF-1-3. NC1084.2 +076000 CHA-DELETE-GF-1-3. NC1084.2 +076100 PERFORM DE-LETE. NC1084.2 +076200 CHA-WRITE-GF-1-3. NC1084.2 +076300 MOVE "CHARACTER-SET" TO FEATURE. NC1084.2 +076400 MOVE "CHA-GF-1-3" TO PAR-NAME. NC1084.2 +076500 PERFORM PRINT-DETAIL. NC1084.2 +076600* NC1084.2 +076700 ALPHABET-INIT-10. NC1084.2 +076800 MOVE "VI-15 4.5.4 GR4" TO ANSI-REFERENCE. NC1084.2 +076900 ALPHABET-TEST-10. NC1084.2 +077000 PERFORM END-ROUTINE. NC1084.2 +077100 MOVE " ALPHABET-NAME ***** CHECK THE ALPHABET-NAMENC1084.2 +077200- " IN THE SPECIAL-NAMES PARAGRAPH" TO TEST-RESULTS. NC1084.2 +077300 PERFORM PRINT-DETAIL. NC1084.2 +077400* NC1084.2 +077500 CCVS-EXIT SECTION. NC1084.2 +077600 CCVS-999999. NC1084.2 +077700 GO TO CLOSE-FILES. NC1084.2 diff --git a/tests/cobol85/NC/NC109M.CBL b/tests/cobol85/NC/NC109M.CBL new file mode 100755 index 00000000..aa5480a8 --- /dev/null +++ b/tests/cobol85/NC/NC109M.CBL @@ -0,0 +1,964 @@ +000100 IDENTIFICATION DIVISION. NC1094.2 +000200 PROGRAM-ID. NC1094.2 +000300 NC109M. NC1094.2 +000400**************************************************************** NC1094.2 +000500* * NC1094.2 +000600* VALIDATION FOR:- * NC1094.2 +000700* * NC1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1094.2 +000900* * NC1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1094.2 +001100* * NC1094.2 +001200**************************************************************** NC1094.2 +001300* * NC1094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1094.2 +001500* * NC1094.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1094.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1094.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1094.2 +001900* * NC1094.2 +002000**************************************************************** NC1094.2 +002100* NC1094.2 +002200* PROGRAM NC109M TESTS FORMAT 1 OF THE ACCEPT STATEMENT NC1094.2 +002300* AND THE GENERAL FORMAT OF THE DISPLAY STATEMENT. NC1094.2 +002400* NC1094.2 +002500* NC1094.2 +002600 NC1094.2 +002700 ENVIRONMENT DIVISION. NC1094.2 +002800 CONFIGURATION SECTION. NC1094.2 +002900 SOURCE-COMPUTER. NC1094.2 +003000 Linux. NC1094.2 +003100 OBJECT-COMPUTER. NC1094.2 +003200 Linux. NC1094.2 +003300 INPUT-OUTPUT SECTION. NC1094.2 +003400 FILE-CONTROL. NC1094.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1094.2 +003600 "report.log". NC1094.2 +003700 DATA DIVISION. NC1094.2 +003800 FILE SECTION. NC1094.2 +003900 FD PRINT-FILE. NC1094.2 +004000 01 PRINT-REC PICTURE X(120). NC1094.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1094.2 +004200 WORKING-STORAGE SECTION. NC1094.2 +004300 01 CHARACTER-BREAKDOWN-R. NC1094.2 +004400 02 FIRST-20R PICTURE X(20). NC1094.2 +004500 02 SECOND-20R PICTURE X(20). NC1094.2 +004600 02 THIRD-20R PICTURE X(20). NC1094.2 +004700 02 FOURTH-20R PICTURE X(20). NC1094.2 +004800 01 CHARACTER-BREAKDOWN-S. NC1094.2 +004900 02 FIRST-20S PICTURE X(20). NC1094.2 +005000 02 SECOND-20S PICTURE X(20). NC1094.2 +005100 02 THIRD-20S PICTURE X(20). NC1094.2 +005200 02 FOURTH-20S PICTURE X(20). NC1094.2 +005300 01 X80-CHARACTER-FIELD. NC1094.2 +005400 02 FILLER PICTURE X(80). NC1094.2 +005500 01 ACCEPT-RESULTS. NC1094.2 +005600 02 FILLER PICTURE X(80) VALUE NC1094.2 +005700 "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456NC1094.2 +005800- "789 ". NC1094.2 +005900 01 DISPLAY-DATA. NC1094.2 +006000 02 DISPLAY-A. NC1094.2 +006100 03 DISPLAY-03 PICTURE A VALUE "A". NC1094.2 +006200 03 DISPLAY-03A. NC1094.2 +006300 04 DISPLAY-04 PICTURE A VALUE "L". NC1094.2 +006400 04 DISPLAY-04A. NC1094.2 +006500 05 DISPLAY-05 PICTURE A VALUE "P". NC1094.2 +006600 05 DISPLAY-05A. NC1094.2 +006700 06 DISPLAY-06 PICTURE A VALUE "H". NC1094.2 +006800 06 DISPLAY-06A. NC1094.2 +006900 07 DISPLAY-07 PICTURE A VALUE "A". NC1094.2 +007000 07 DISPLAY-07A. NC1094.2 +007100 08 DISPLAY-08 PICTURE A VALUE "B". NC1094.2 +007200 08 DISPLAY-08A. NC1094.2 +007300 09 DISPLAY-09 PICTURE A VALUE "E". NC1094.2 +007400 09 DISPLAY-09A. NC1094.2 +007500 10 DISPLAY-10 PICTURE AAA VALUE "TIC". NC1094.2 +007600 02 DISPLAY-N PICTURE 9(10) VALUE 0123456789. NC1094.2 +007700 02 DISPLAY-X PICTURE X(10) VALUE "A1B2C3D4E5". NC1094.2 +007800 02 DISPLAY-B PICTURE X(13). NC1094.2 +007900 02 DISPLAY-C REDEFINES DISPLAY-B. NC1094.2 +008000 03 DISPLAY-D PICTURE X(8). NC1094.2 +008100 03 DISPLAY-E PICTURE X(5). NC1094.2 +008200 02 DISPLAY-F. NC1094.2 +008300 03 DISPLAY-G PICTURE X(100) VALUE "*001*002*003*00NC1094.2 +008400- "4*005*006*007*008*009*010*011*012*013*014*015*016*017*018*01NC1094.2 +008500- "9*020*021*022*023*024*025". NC1094.2 +008600 03 DISPLAY-H PICTURE X(100) VALUE "*026*027*028*02NC1094.2 +008700- "9*030*031*032*033*034*035*036*037*038*039*040*041*042*043*04NC1094.2 +008800- "4*045*046*047*048*049*050". NC1094.2 +008900 02 SEE-ABOVE PICTURE X(9) VALUE "SEE ABOVE". NC1094.2 +009000 02 SEE-BELOW PICTURE X(9) VALUE "SEE BELOW". NC1094.2 +009100 02 CORRECT-FOLLOWS PICTURE X(20) VALUE NC1094.2 +009200 "CORRECT DATA FOLLOWS". NC1094.2 +009300 02 END-CORRECT PICTURE X(16) VALUE NC1094.2 +009400 "END CORRECT DATA". NC1094.2 +009500 02 DISPLAY-WRITER. NC1094.2 +009600 03 DIS-PLAYER. NC1094.2 +009700 04 FILLER PICTURE X(6). NC1094.2 +009800 04 QUOTE-SLOT PICTURE X. NC1094.2 +009900 04 FILLER PICTURE X(112). NC1094.2 +010000 02 DISPLAY-SWITCH PICTURE 9 VALUE ZERO. NC1094.2 +010100 02 ZERO-SPACE-QUOTE. NC1094.2 +010200 03 FILLER PICTURE X VALUE ZERO. NC1094.2 +010300 03 FILLER PICTURE X VALUE SPACE. NC1094.2 +010400 03 FILLER PICTURE X VALUE QUOTE. NC1094.2 +010500 01 LONG-LITERAL. NC1094.2 +010600 02 LONG20 PICTURE IS X(20) NC1094.2 +010700 VALUE IS "STANDARD COMPILERS M". NC1094.2 +010800 02 LONG40 PICTURE IS X(20) NC1094.2 +010900 VALUE IS "UST ALLOW NON-NUMERI". NC1094.2 +011000 02 LONG60 PICTURE IS X(20) NC1094.2 +011100 VALUE IS "C LITERALS OF AT LEA". NC1094.2 +011200 02 LONG80 PICTURE IS X(20) NC1094.2 +011300 VALUE IS "ST 120 CHARACTERS AN". NC1094.2 +011400 02 LONG100 PICTURE IS X(20) NC1094.2 +011500 VALUE IS "D NUMERIC LITERALS O". NC1094.2 +011600 02 LONG120 PICTURE IS X(20) NC1094.2 +011700 VALUE IS "F AT LEAST 18 DIGITS". NC1094.2 +011800 01 ACCEPT-DATA. NC1094.2 +011900 02 ACCEPT-D1. NC1094.2 +012000 03 ACCEPT-D1-A PICTURE X(20). NC1094.2 +012100 03 ACCEPT-D1-B PICTURE X(7). NC1094.2 +012200 02 ACCEPT-D2 PICTURE X(27) NC1094.2 +012300 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXY Z". NC1094.2 +012400 02 ACCEPT-D3 PICTURE 9(10) USAGE DISPLAY. NC1094.2 +012500 02 ACCEPT-D4 PICTURE 9(10) USAGE DISPLAY VALUE 0123456789. NC1094.2 +012600 02 ACCEPT-D5 PICTURE X(11). NC1094.2 +012700 02 ACCEPT-D6 PICTURE X(11) VALUE "().+-*/$, =". NC1094.2 +012800 02 ACCEPT-D7 PICTURE X. NC1094.2 +012900 02 ACCEPT-D8 PICTURE X VALUE "9". NC1094.2 +013000 02 ACCEPT-D9 PICTURE X. NC1094.2 +013100 02 ACCEPT-D10 PICTURE X VALUE "0". NC1094.2 +013200 02 ACCEPT-D11 PICTURE A(20). NC1094.2 +013300 02 ACCEPT-D12 PICTURE A(20) NC1094.2 +013400 VALUE " ABC XYZ ". NC1094.2 +013500 02 ACCEPT-D13 PICTURE 9(9). NC1094.2 +013600 02 ACCEPT-D14 PICTURE 9(9) VALUE 012345678. NC1094.2 +013700 02 ACCEPT-D15 PICTURE X. NC1094.2 +013800 02 ACCEPT-D16 PICTURE X VALUE SPACE. NC1094.2 +013900 02 ACCEPT-D17 PICTURE X. NC1094.2 +014000 02 ACCEPT-D18 PICTURE X VALUE QUOTE. NC1094.2 +014100 02 ACCEPT-D21. NC1094.2 +014200 03 TAB-ACCEPT PICTURE XXXX OCCURS 3 TIMES. NC1094.2 +014300 02 ACCEPT-D22 PICTURE X(12) VALUE "....ABCD....". NC1094.2 +014400 01 TAB-VALUE PICTURE X(21) NC1094.2 +014500 VALUE "ABCDEFGHIJKLMNOPQRSTU". NC1094.2 +014600 01 NO-TAB-RECORD REDEFINES TAB-VALUE. NC1094.2 +014700 02 X1 PICTURE X. NC1094.2 +014800 02 X2 PICTURE X. NC1094.2 +014900 02 X3 PICTURE X. NC1094.2 +015000 02 X4 PICTURE X. NC1094.2 +015100 02 X5 PICTURE X. NC1094.2 +015200 02 X6 PICTURE X. NC1094.2 +015300 02 X7 PICTURE X. NC1094.2 +015400 02 X8 PICTURE X. NC1094.2 +015500 02 X9 PICTURE X. NC1094.2 +015600 02 X10 PICTURE X. NC1094.2 +015700 02 X11 PICTURE X. NC1094.2 +015800 02 X12 PICTURE X. NC1094.2 +015900 02 X13 PICTURE X. NC1094.2 +016000 02 X14 PICTURE X. NC1094.2 +016100 02 X15 PICTURE X. NC1094.2 +016200 02 X16 PICTURE X. NC1094.2 +016300 02 X17 PICTURE X. NC1094.2 +016400 02 X18 PICTURE X. NC1094.2 +016500 02 X19 PICTURE X. NC1094.2 +016600 02 X20 PICTURE X. NC1094.2 +016700 02 X21 PICTURE X. NC1094.2 +016800 01 TAB-RECORD REDEFINES TAB-VALUE. NC1094.2 +016900 02 XTAB PICTURE X OCCURS 21 TIMES. NC1094.2 +017000 01 DISPLAY-MIXTURE. NC1094.2 +017100 02 I-DATA PICTURE X(17) NC1094.2 +017200 VALUE " IDENTIFIER DATA ". NC1094.2 +017300 02 TA-VALUE PICTURE X(20) NC1094.2 +017400 VALUE "A B C D E 0102030405". NC1094.2 +017500 02 TA-BLE REDEFINES TA-VALUE. NC1094.2 +017600 04 PIECE-A PICTURE XX OCCURS 5 TIMES. NC1094.2 +017700 04 PIECE-N PICTURE 99 OCCURS 5 TIMES. NC1094.2 +017800 02 TRUE-PAIR. NC1094.2 +017900 03 A1 PICTURE X(21) NC1094.2 +018000 VALUE " (TOTAL 21 OPERANDS) ". NC1094.2 +018100 03 A2 PICTURE X(11) NC1094.2 +018200 VALUE "END OF DATA". NC1094.2 +018300 01 TEST-RESULTS. NC1094.2 +018400 02 FILLER PIC X VALUE SPACE. NC1094.2 +018500 02 FEATURE PIC X(20) VALUE SPACE. NC1094.2 +018600 02 FILLER PIC X VALUE SPACE. NC1094.2 +018700 02 P-OR-F PIC X(5) VALUE SPACE. NC1094.2 +018800 02 FILLER PIC X VALUE SPACE. NC1094.2 +018900 02 PAR-NAME. NC1094.2 +019000 03 FILLER PIC X(19) VALUE SPACE. NC1094.2 +019100 03 PARDOT-X PIC X VALUE SPACE. NC1094.2 +019200 03 DOTVALUE PIC 99 VALUE ZERO. NC1094.2 +019300 02 FILLER PIC X(8) VALUE SPACE. NC1094.2 +019400 02 RE-MARK PIC X(61). NC1094.2 +019500 01 TEST-COMPUTED. NC1094.2 +019600 02 FILLER PIC X(30) VALUE SPACE. NC1094.2 +019700 02 FILLER PIC X(17) VALUE NC1094.2 +019800 " COMPUTED=". NC1094.2 +019900 02 COMPUTED-X. NC1094.2 +020000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1094.2 +020100 03 COMPUTED-N REDEFINES COMPUTED-A NC1094.2 +020200 PIC -9(9).9(9). NC1094.2 +020300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1094.2 +020400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1094.2 +020500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1094.2 +020600 03 CM-18V0 REDEFINES COMPUTED-A. NC1094.2 +020700 04 COMPUTED-18V0 PIC -9(18). NC1094.2 +020800 04 FILLER PIC X. NC1094.2 +020900 03 FILLER PIC X(50) VALUE SPACE. NC1094.2 +021000 01 TEST-CORRECT. NC1094.2 +021100 02 FILLER PIC X(30) VALUE SPACE. NC1094.2 +021200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1094.2 +021300 02 CORRECT-X. NC1094.2 +021400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1094.2 +021500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1094.2 +021600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1094.2 +021700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1094.2 +021800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1094.2 +021900 03 CR-18V0 REDEFINES CORRECT-A. NC1094.2 +022000 04 CORRECT-18V0 PIC -9(18). NC1094.2 +022100 04 FILLER PIC X. NC1094.2 +022200 03 FILLER PIC X(2) VALUE SPACE. NC1094.2 +022300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1094.2 +022400 01 CCVS-C-1. NC1094.2 +022500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1094.2 +022600- "SS PARAGRAPH-NAME NC1094.2 +022700- " REMARKS". NC1094.2 +022800 02 FILLER PIC X(20) VALUE SPACE. NC1094.2 +022900 01 CCVS-C-2. NC1094.2 +023000 02 FILLER PIC X VALUE SPACE. NC1094.2 +023100 02 FILLER PIC X(6) VALUE "TESTED". NC1094.2 +023200 02 FILLER PIC X(15) VALUE SPACE. NC1094.2 +023300 02 FILLER PIC X(4) VALUE "FAIL". NC1094.2 +023400 02 FILLER PIC X(94) VALUE SPACE. NC1094.2 +023500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1094.2 +023600 01 REC-CT PIC 99 VALUE ZERO. NC1094.2 +023700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1094.2 +023800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1094.2 +023900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1094.2 +024000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1094.2 +024100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1094.2 +024200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1094.2 +024300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1094.2 +024400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1094.2 +024500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1094.2 +024600 01 CCVS-H-1. NC1094.2 +024700 02 FILLER PIC X(39) VALUE SPACES. NC1094.2 +024800 02 FILLER PIC X(42) VALUE NC1094.2 +024900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1094.2 +025000 02 FILLER PIC X(39) VALUE SPACES. NC1094.2 +025100 01 CCVS-H-2A. NC1094.2 +025200 02 FILLER PIC X(40) VALUE SPACE. NC1094.2 +025300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1094.2 +025400 02 FILLER PIC XXXX VALUE NC1094.2 +025500 "4.2 ". NC1094.2 +025600 02 FILLER PIC X(28) VALUE NC1094.2 +025700 " COPY - NOT FOR DISTRIBUTION". NC1094.2 +025800 02 FILLER PIC X(41) VALUE SPACE. NC1094.2 +025900 NC1094.2 +026000 01 CCVS-H-2B. NC1094.2 +026100 02 FILLER PIC X(15) VALUE NC1094.2 +026200 "TEST RESULT OF ". NC1094.2 +026300 02 TEST-ID PIC X(9). NC1094.2 +026400 02 FILLER PIC X(4) VALUE NC1094.2 +026500 " IN ". NC1094.2 +026600 02 FILLER PIC X(12) VALUE NC1094.2 +026700 " HIGH ". NC1094.2 +026800 02 FILLER PIC X(22) VALUE NC1094.2 +026900 " LEVEL VALIDATION FOR ". NC1094.2 +027000 02 FILLER PIC X(58) VALUE NC1094.2 +027100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1094.2 +027200 01 CCVS-H-3. NC1094.2 +027300 02 FILLER PIC X(34) VALUE NC1094.2 +027400 " FOR OFFICIAL USE ONLY ". NC1094.2 +027500 02 FILLER PIC X(58) VALUE NC1094.2 +027600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1094.2 +027700 02 FILLER PIC X(28) VALUE NC1094.2 +027800 " COPYRIGHT 1985 ". NC1094.2 +027900 01 CCVS-E-1. NC1094.2 +028000 02 FILLER PIC X(52) VALUE SPACE. NC1094.2 +028100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1094.2 +028200 02 ID-AGAIN PIC X(9). NC1094.2 +028300 02 FILLER PIC X(45) VALUE SPACES. NC1094.2 +028400 01 CCVS-E-2. NC1094.2 +028500 02 FILLER PIC X(31) VALUE SPACE. NC1094.2 +028600 02 FILLER PIC X(21) VALUE SPACE. NC1094.2 +028700 02 CCVS-E-2-2. NC1094.2 +028800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1094.2 +028900 03 FILLER PIC X VALUE SPACE. NC1094.2 +029000 03 ENDER-DESC PIC X(44) VALUE NC1094.2 +029100 "ERRORS ENCOUNTERED". NC1094.2 +029200 01 CCVS-E-3. NC1094.2 +029300 02 FILLER PIC X(22) VALUE NC1094.2 +029400 " FOR OFFICIAL USE ONLY". NC1094.2 +029500 02 FILLER PIC X(12) VALUE SPACE. NC1094.2 +029600 02 FILLER PIC X(58) VALUE NC1094.2 +029700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1094.2 +029800 02 FILLER PIC X(13) VALUE SPACE. NC1094.2 +029900 02 FILLER PIC X(15) VALUE NC1094.2 +030000 " COPYRIGHT 1985". NC1094.2 +030100 01 CCVS-E-4. NC1094.2 +030200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1094.2 +030300 02 FILLER PIC X(4) VALUE " OF ". NC1094.2 +030400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1094.2 +030500 02 FILLER PIC X(40) VALUE NC1094.2 +030600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1094.2 +030700 01 XXINFO. NC1094.2 +030800 02 FILLER PIC X(19) VALUE NC1094.2 +030900 "*** INFORMATION ***". NC1094.2 +031000 02 INFO-TEXT. NC1094.2 +031100 04 FILLER PIC X(8) VALUE SPACE. NC1094.2 +031200 04 XXCOMPUTED PIC X(20). NC1094.2 +031300 04 FILLER PIC X(5) VALUE SPACE. NC1094.2 +031400 04 XXCORRECT PIC X(20). NC1094.2 +031500 02 INF-ANSI-REFERENCE PIC X(48). NC1094.2 +031600 01 HYPHEN-LINE. NC1094.2 +031700 02 FILLER PIC IS X VALUE IS SPACE. NC1094.2 +031800 02 FILLER PIC IS X(65) VALUE IS "************************NC1094.2 +031900- "*****************************************". NC1094.2 +032000 02 FILLER PIC IS X(54) VALUE IS "************************NC1094.2 +032100- "******************************". NC1094.2 +032200 01 CCVS-PGM-ID PIC X(9) VALUE NC1094.2 +032300 "NC109M". NC1094.2 +032400 PROCEDURE DIVISION. NC1094.2 +032500 CCVS1 SECTION. NC1094.2 +032600 OPEN-FILES. NC1094.2 +032700 OPEN OUTPUT PRINT-FILE. NC1094.2 +032800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1094.2 +032900 MOVE SPACE TO TEST-RESULTS. NC1094.2 +033000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1094.2 +033100 GO TO CCVS1-EXIT. NC1094.2 +033200 CLOSE-FILES. NC1094.2 +033300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1094.2 +033400 TERMINATE-CCVS. NC1094.2 +033500*S EXIT PROGRAM. NC1094.2 +033600*SERMINATE-CALL. NC1094.2 +033700 STOP RUN. NC1094.2 +033800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1094.2 +033900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1094.2 +034000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1094.2 +034100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1094.2 +034200 MOVE "****TEST DELETED****" TO RE-MARK. NC1094.2 +034300 PRINT-DETAIL. NC1094.2 +034400 IF REC-CT NOT EQUAL TO ZERO NC1094.2 +034500 MOVE "." TO PARDOT-X NC1094.2 +034600 MOVE REC-CT TO DOTVALUE. NC1094.2 +034700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1094.2 +034800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1094.2 +034900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1094.2 +035000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1094.2 +035100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1094.2 +035200 MOVE SPACE TO CORRECT-X. NC1094.2 +035300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1094.2 +035400 MOVE SPACE TO RE-MARK. NC1094.2 +035500 HEAD-ROUTINE. NC1094.2 +035600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +035700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +035800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1094.2 +035900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1094.2 +036000 COLUMN-NAMES-ROUTINE. NC1094.2 +036100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +036200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +036300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +036400 END-ROUTINE. NC1094.2 +036500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1094.2 +036600 END-RTN-EXIT. NC1094.2 +036700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +036800 END-ROUTINE-1. NC1094.2 +036900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1094.2 +037000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1094.2 +037100 ADD PASS-COUNTER TO ERROR-HOLD. NC1094.2 +037200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1094.2 +037300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1094.2 +037400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1094.2 +037500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1094.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1094.2 +037700 END-ROUTINE-12. NC1094.2 +037800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1094.2 +037900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1094.2 +038000 MOVE "NO " TO ERROR-TOTAL NC1094.2 +038100 ELSE NC1094.2 +038200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1094.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1094.2 +038400 PERFORM WRITE-LINE. NC1094.2 +038500 END-ROUTINE-13. NC1094.2 +038600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1094.2 +038700 MOVE "NO " TO ERROR-TOTAL ELSE NC1094.2 +038800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1094.2 +038900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1094.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +039100 IF INSPECT-COUNTER EQUAL TO ZERO NC1094.2 +039200 MOVE "NO " TO ERROR-TOTAL NC1094.2 +039300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1094.2 +039400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1094.2 +039500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +039600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1094.2 +039700 WRITE-LINE. NC1094.2 +039800 ADD 1 TO RECORD-COUNT. NC1094.2 +039900 IF RECORD-COUNT GREATER 42 NC1094.2 +040000 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1094.2 +040100 MOVE SPACE TO DUMMY-RECORD NC1094.2 +040200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1094.2 +040300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1094.2 +040400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1094.2 +040500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1094.2 +040600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1094.2 +040700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1094.2 +040800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1094.2 +040900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1094.2 +041000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1094.2 +041100 MOVE ZERO TO RECORD-COUNT. NC1094.2 +041200 PERFORM WRT-LN. NC1094.2 +041300 WRT-LN. NC1094.2 +041400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1094.2 +041500 MOVE SPACE TO DUMMY-RECORD. NC1094.2 +041600 BLANK-LINE-PRINT. NC1094.2 +041700 PERFORM WRT-LN. NC1094.2 +041800 FAIL-ROUTINE. NC1094.2 +041900 IF COMPUTED-X NOT EQUAL TO SPACE NC1094.2 +042000 GO TO FAIL-ROUTINE-WRITE. NC1094.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1094.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1094.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1094.2 +042400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +042500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1094.2 +042600 GO TO FAIL-ROUTINE-EX. NC1094.2 +042700 FAIL-ROUTINE-WRITE. NC1094.2 +042800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1094.2 +042900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1094.2 +043000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1094.2 +043100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1094.2 +043200 FAIL-ROUTINE-EX. EXIT. NC1094.2 +043300 BAIL-OUT. NC1094.2 +043400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1094.2 +043500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1094.2 +043600 BAIL-OUT-WRITE. NC1094.2 +043700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1094.2 +043800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1094.2 +043900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1094.2 +044000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1094.2 +044100 BAIL-OUT-EX. EXIT. NC1094.2 +044200 CCVS1-EXIT. NC1094.2 +044300 EXIT. NC1094.2 +044400 SECT-NC109M-001 SECTION. NC1094.2 +044500 ACC-INIT-GF-1. NC1094.2 +044600 MOVE "ACCEPT" TO FEATURE. NC1094.2 +044700 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +044800 MOVE SPACES TO ACCEPT-D1. NC1094.2 +044900 ACC-TEST-GF-1. NC1094.2 +045000 MOVE "ACC-TEST-GF-1" TO PAR-NAME. NC1094.2 +045100 ACCEPT ACCEPT-D1. NC1094.2 +045200 IF ACCEPT-D1 EQUAL TO ACCEPT-D2 NC1094.2 +045300 PERFORM PASS GO TO ACC-WRITE-GF-1. NC1094.2 +045400* NOTE ACCEPT ALPHABETIC LITERAL TO ALPHANUMERIC FIELD. NC1094.2 +045500 GO TO ACC-FAIL-GF-1. NC1094.2 +045600 ACC-DELETE-GF-1. NC1094.2 +045700 MOVE "ACC-TEST-GF-1" TO PAR-NAME. NC1094.2 +045800 PERFORM DE-LETE. NC1094.2 +045900 GO TO ACC-WRITE-GF-1. NC1094.2 +046000 ACC-FAIL-GF-1. NC1094.2 +046100 PERFORM FAIL. NC1094.2 +046200 MOVE ACCEPT-D1-A TO COMPUTED-A. NC1094.2 +046300 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. NC1094.2 +046400 PERFORM PRINT-DETAIL. NC1094.2 +046500 MOVE ACCEPT-D1-B TO COMPUTED-A. NC1094.2 +046600 MOVE "UVWXY Z" TO CORRECT-A. NC1094.2 +046700 MOVE "LAST 7 OF 27-CHAR FIELD" TO RE-MARK. NC1094.2 +046800 ACC-WRITE-GF-1. NC1094.2 +046900 PERFORM PRINT-DETAIL. NC1094.2 +047000 ACC-INIT-GF-2. NC1094.2 +047100 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +047200 MOVE ZEROES TO ACCEPT-D3. NC1094.2 +047300 ACC-TEST-GF-2. NC1094.2 +047400 ACCEPT ACCEPT-D3. NC1094.2 +047500 IF ACCEPT-D3 EQUAL TO ACCEPT-D4 NC1094.2 +047600 PERFORM PASS GO TO ACC-WRITE-GF-2. NC1094.2 +047700* NOTE ACCEPT NUMERIC LITERAL TO NUMERIC FIELD SAME LENGTH.NC1094.2 +047800 GO TO ACC-FAIL-GF-2. NC1094.2 +047900 ACC-DELETE-GF-2. NC1094.2 +048000 PERFORM DE-LETE. NC1094.2 +048100 GO TO ACC-WRITE-GF-2. NC1094.2 +048200 ACC-FAIL-GF-2. NC1094.2 +048300 MOVE ACCEPT-D3 TO COMPUTED-18V0. NC1094.2 +048400 MOVE ACCEPT-D4 TO CORRECT-18V0. NC1094.2 +048500 PERFORM FAIL. NC1094.2 +048600 ACC-WRITE-GF-2. NC1094.2 +048700 MOVE "ACC-TEST-GF-2 " TO PAR-NAME. NC1094.2 +048800 PERFORM PRINT-DETAIL. NC1094.2 +048900 ACC-INIT-GF-3. NC1094.2 +049000 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +049100 MOVE SPACES TO ACCEPT-D5. NC1094.2 +049200 ACC-TEST-GF-3. NC1094.2 +049300 ACCEPT ACCEPT-D5. NC1094.2 +049400 IF ACCEPT-D5 EQUAL TO ACCEPT-D6 NC1094.2 +049500 PERFORM PASS GO TO ACC-WRITE-GF-3. NC1094.2 +049600* NOTE ACCEPT SPECIAL CHARACTERS. NC1094.2 +049700 GO TO ACC-FAIL-GF-3. NC1094.2 +049800 ACC-DELETE-GF-3. NC1094.2 +049900 PERFORM DE-LETE. NC1094.2 +050000 GO TO ACC-WRITE-GF-3. NC1094.2 +050100 ACC-FAIL-GF-3. NC1094.2 +050200 MOVE ACCEPT-D5 TO COMPUTED-A. NC1094.2 +050300 MOVE ACCEPT-D6 TO CORRECT-A. NC1094.2 +050400 PERFORM FAIL. NC1094.2 +050500 ACC-WRITE-GF-3. NC1094.2 +050600 MOVE "ACC-TEST-GF-3 " TO PAR-NAME. NC1094.2 +050700 PERFORM PRINT-DETAIL. NC1094.2 +050800 ACC-INIT-GF-4. NC1094.2 +050900 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +051000 MOVE SPACES TO ACCEPT-D7. NC1094.2 +051100 ACC-TEST-GF-4. NC1094.2 +051200 ACCEPT ACCEPT-D7. NC1094.2 +051300 IF ACCEPT-D7 EQUAL TO ACCEPT-D8 NC1094.2 +051400 PERFORM PASS GO TO ACC-WRITE-GF-4. NC1094.2 +051500* NOTE ACCEPT HIGH-VALUE. NC1094.2 +051600* NOTE CHANGED TO ACCEPT AN ALPHANUMERIC 9. NC1094.2 +051700 GO TO ACC-FAIL-GF-4. NC1094.2 +051800 ACC-DELETE-GF-4. NC1094.2 +051900 PERFORM DE-LETE. NC1094.2 +052000 GO TO ACC-WRITE-GF-4. NC1094.2 +052100 ACC-FAIL-GF-4. NC1094.2 +052200 MOVE ACCEPT-D7 TO COMPUTED-A. NC1094.2 +052300 MOVE ACCEPT-D8 TO CORRECT-A. NC1094.2 +052400 PERFORM FAIL. NC1094.2 +052500 ACC-WRITE-GF-4. NC1094.2 +052600 MOVE "ACC-TEST-GF-4 " TO PAR-NAME. NC1094.2 +052700 PERFORM PRINT-DETAIL. NC1094.2 +052800 ACC-INIT-GF-5. NC1094.2 +052900 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +053000 MOVE SPACES TO ACCEPT-D9. NC1094.2 +053100 ACC-TEST-GF-5. NC1094.2 +053200 ACCEPT ACCEPT-D9. NC1094.2 +053300 IF ACCEPT-D9 EQUAL TO ACCEPT-D10 NC1094.2 +053400 PERFORM PASS GO TO ACC-WRITE-GF-5. NC1094.2 +053500* NOTE CHANGED TO ACCEPT AN ALPHANUMERIC 0. NC1094.2 +053600* NOTE ACCEPT LOW-VALUE. NC1094.2 +053700 GO TO ACC-FAIL-GF-5. NC1094.2 +053800 ACC-DELETE-GF-5. NC1094.2 +053900 PERFORM DE-LETE. NC1094.2 +054000 GO TO ACC-WRITE-GF-5. NC1094.2 +054100 ACC-FAIL-GF-5. NC1094.2 +054200 MOVE ACCEPT-D9 TO COMPUTED-A. NC1094.2 +054300 MOVE ACCEPT-D10 TO CORRECT-A. NC1094.2 +054400 PERFORM FAIL. NC1094.2 +054500 ACC-WRITE-GF-5. NC1094.2 +054600 MOVE "ACC-TEST-GF-5 " TO PAR-NAME. NC1094.2 +054700 PERFORM PRINT-DETAIL. NC1094.2 +054800 ACC-INIT-GF-6. NC1094.2 +054900 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +055000 MOVE SPACES TO ACCEPT-D11. NC1094.2 +055100 ACC-TEST-GF-6. NC1094.2 +055200 ACCEPT ACCEPT-D11. NC1094.2 +055300 IF ACCEPT-D11 EQUAL TO ACCEPT-D12 NC1094.2 +055400 PERFORM PASS GO TO ACC-WRITE-GF-6. NC1094.2 +055500* NOTE ACCEPT ALPHABETIC LITERAL TO ALPHABETIC FIELD. NC1094.2 +055600 GO TO ACC-FAIL-GF-6. NC1094.2 +055700 ACC-DELETE-GF-6. NC1094.2 +055800 PERFORM DE-LETE. NC1094.2 +055900 GO TO ACC-WRITE-GF-6. NC1094.2 +056000 ACC-FAIL-GF-6. NC1094.2 +056100 MOVE ACCEPT-D11 TO COMPUTED-A. NC1094.2 +056200 MOVE ACCEPT-D12 TO CORRECT-A. NC1094.2 +056300 PERFORM FAIL. NC1094.2 +056400 ACC-WRITE-GF-6. NC1094.2 +056500 MOVE "ACC-TEST-GF-6 " TO PAR-NAME. NC1094.2 +056600 PERFORM PRINT-DETAIL. NC1094.2 +056700 ACC-INIT-GF-7. NC1094.2 +056800 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +056900 MOVE ZEROES TO ACCEPT-D13. NC1094.2 +057000 ACC-TEST-GF-7. NC1094.2 +057100 ACCEPT ACCEPT-D13. NC1094.2 +057200 IF ACCEPT-D13 EQUAL TO ACCEPT-D14 NC1094.2 +057300 PERFORM PASS GO TO ACC-WRITE-GF-7. NC1094.2 +057400* NOTE ACCEPT NUMERIC LITERAL TO NUMERIC FIELD OF DIFFERENTNC1094.2 +057500* LENGTH. NC1094.2 +057600 GO TO ACC-FAIL-GF-7. NC1094.2 +057700 ACC-DELETE-GF-7. NC1094.2 +057800 PERFORM DE-LETE. NC1094.2 +057900 GO TO ACC-WRITE-GF-7. NC1094.2 +058000 ACC-FAIL-GF-7. NC1094.2 +058100 MOVE ACCEPT-D13 TO COMPUTED-A. NC1094.2 +058200 MOVE ACCEPT-D14 TO CORRECT-A. NC1094.2 +058300 PERFORM FAIL. NC1094.2 +058400 ACC-WRITE-GF-7. NC1094.2 +058500 MOVE "ACC-TEST-GF-7 " TO PAR-NAME. NC1094.2 +058600 PERFORM PRINT-DETAIL. NC1094.2 +058700 ACC-INIT-GF-8. NC1094.2 +058800 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +058900 MOVE ZEROES TO ACCEPT-D15. NC1094.2 +059000 ACC-TEST-GF-8. NC1094.2 +059100 ACCEPT ACCEPT-D15. NC1094.2 +059200 IF ACCEPT-D15 EQUAL TO ACCEPT-D16 NC1094.2 +059300 PERFORM PASS GO TO ACC-WRITE-GF-8. NC1094.2 +059400* NOTE ACCEPT SINGLE SPACE. NC1094.2 +059500 GO TO ACC-FAIL-GF-8. NC1094.2 +059600 ACC-DELETE-GF-8. NC1094.2 +059700 PERFORM DE-LETE. NC1094.2 +059800 GO TO ACC-WRITE-GF-8. NC1094.2 +059900 ACC-FAIL-GF-8. NC1094.2 +060000 PERFORM FAIL. NC1094.2 +060100 MOVE ACCEPT-D15 TO COMPUTED-A. NC1094.2 +060200 MOVE " (SPACES)" TO CORRECT-A. NC1094.2 +060300 ACC-WRITE-GF-8. NC1094.2 +060400 MOVE "ACC-TEST-GF-8" TO PAR-NAME. NC1094.2 +060500 PERFORM PRINT-DETAIL. NC1094.2 +060600 ACC-INIT-GF-9. NC1094.2 +060700 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +060800 MOVE ZEROES TO ACCEPT-D17. NC1094.2 +060900 ACC-TEST-GF-9. NC1094.2 +061000 ACCEPT ACCEPT-D17. NC1094.2 +061100 IF ACCEPT-D17 EQUAL TO ACCEPT-D18 NC1094.2 +061200 PERFORM PASS GO TO ACC-WRITE-GF-9. NC1094.2 +061300* NOTE ACCEPT A QUOTE. NC1094.2 +061400 GO TO ACC-FAIL-GF-9. NC1094.2 +061500 ACC-DELETE-GF-9. NC1094.2 +061600 PERFORM DE-LETE. NC1094.2 +061700 GO TO ACC-WRITE-GF-9. NC1094.2 +061800 ACC-FAIL-GF-9. NC1094.2 +061900 PERFORM FAIL. NC1094.2 +062000 MOVE ACCEPT-D17 TO COMPUTED-A. NC1094.2 +062100 MOVE ACCEPT-D18 TO CORRECT-A. NC1094.2 +062200 ACC-WRITE-GF-9. NC1094.2 +062300 MOVE "ACC-TEST-GF-9" TO PAR-NAME. NC1094.2 +062400 PERFORM PRINT-DETAIL. NC1094.2 +062500 ACC-INIT-GF-10. NC1094.2 +062600 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +062700 MOVE "............" TO ACCEPT-D21. NC1094.2 +062800 ACC-TEST-GF-10. NC1094.2 +062900 ACCEPT TAB-ACCEPT (2). NC1094.2 +063000 IF ACCEPT-D21 EQUAL TO ACCEPT-D22 NC1094.2 +063100 PERFORM PASS GO TO ACC-WRITE-GF-10. NC1094.2 +063200* NOTE ACCEPT TO SUBSCRIPTED AREA. NC1094.2 +063300 GO TO ACC-FAIL-GF-10. NC1094.2 +063400 ACC-DELETE-GF-10. NC1094.2 +063500 PERFORM DE-LETE. NC1094.2 +063600 GO TO ACC-WRITE-GF-10. NC1094.2 +063700 ACC-FAIL-GF-10. NC1094.2 +063800 PERFORM FAIL. NC1094.2 +063900 MOVE ACCEPT-D21 TO COMPUTED-A. NC1094.2 +064000 MOVE ACCEPT-D22 TO CORRECT-A. NC1094.2 +064100 ACC-WRITE-GF-10. NC1094.2 +064200 MOVE "ACC-TEST-GF-10" TO PAR-NAME. NC1094.2 +064300 PERFORM PRINT-DETAIL. NC1094.2 +064400 ACC-INIT-GF-11. NC1094.2 +064500 MOVE "V1-71 6.5.4 GR1-5" TO ANSI-REFERENCE. NC1094.2 +064600 MOVE SPACES TO X80-CHARACTER-FIELD. NC1094.2 +064700 ACC-TEST-GF-11. NC1094.2 +064800 ACCEPT X80-CHARACTER-FIELD. NC1094.2 +064900 MOVE "ACC-TEST-GF-11" TO PAR-NAME. NC1094.2 +065000 IF X80-CHARACTER-FIELD EQUAL TO ACCEPT-RESULTS NC1094.2 +065100 PERFORM PASS GO TO ACC-WRITE-GF-11. NC1094.2 +065200* NOTE ACCEPT 80-CHARACTER LITERAL. NC1094.2 +065300 GO TO ACC-FAIL-GF-11. NC1094.2 +065400 ACC-DELETE-GF-11. NC1094.2 +065500 PERFORM DE-LETE. NC1094.2 +065600 MOVE "ACC-TEST-GF-11" TO PAR-NAME. NC1094.2 +065700 GO TO ACC-WRITE-GF-11. NC1094.2 +065800 ACC-FAIL-GF-11. NC1094.2 +065900 MOVE X80-CHARACTER-FIELD TO CHARACTER-BREAKDOWN-R. NC1094.2 +066000 PERFORM FAIL. NC1094.2 +066100 MOVE ACCEPT-RESULTS TO CHARACTER-BREAKDOWN-S. NC1094.2 +066200 MOVE FIRST-20R TO COMPUTED-A. NC1094.2 +066300 MOVE FIRST-20S TO CORRECT-A. NC1094.2 +066400 PERFORM PRINT-DETAIL. NC1094.2 +066500 MOVE SECOND-20R TO COMPUTED-A. NC1094.2 +066600 MOVE SECOND-20S TO CORRECT-A. NC1094.2 +066700 PERFORM PRINT-DETAIL. NC1094.2 +066800 MOVE THIRD-20R TO COMPUTED-A. NC1094.2 +066900 MOVE THIRD-20S TO CORRECT-A. NC1094.2 +067000 PERFORM PRINT-DETAIL. NC1094.2 +067100 MOVE FOURTH-20R TO COMPUTED-A. NC1094.2 +067200 MOVE FOURTH-20S TO CORRECT-A. NC1094.2 +067300 MOVE "LAST 20 OF 80-CHAR FIELD" TO RE-MARK. NC1094.2 +067400 ACC-WRITE-GF-11. NC1094.2 +067500 PERFORM PRINT-DETAIL. NC1094.2 +067600 DISP-INIT-GF-1. NC1094.2 +067700 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +067800 PERFORM BLANK-LINE-PRINT. NC1094.2 +067900 MOVE "DISPLAY TESTS" TO FEATURE. NC1094.2 +068000 MOVE "SEE NOTE IN DISP-INIT-GF-1" TO RE-MARK. NC1094.2 +068100 PERFORM PRINT-DETAIL. NC1094.2 +068200 PERFORM BLANK-LINE-PRINT 4 TIMES. NC1094.2 +068300 MOVE "DISPLAY" TO FEATURE. NC1094.2 +068400* NOTE FOR THE SAKE OF CONVENIENCE IN READING THE OUTPUT, NC1094.2 +068500* THE DISPLAY TESTS ARE CONSTRUCTED ON THE ASSUMPTION NC1094.2 +068600* THAT THE DISPLAYED OUTPUT WILL BE PRINTED ALONG NC1094.2 +068700* WITH THE OUTPUT FROM THE WRITE STATEMENTS --- NC1094.2 +068800* HOWEVER IT IS NOT CONSIDERED NONSTANDARD IF THE NC1094.2 +068900* DISPLAYED DATA APPEARS ELSEWHERE IN THE LISTING, OR NC1094.2 +069000* FOR THAT MATTER, ON SOME OTHER DEVICE. NC1094.2 +069100 DISP-TEST-GF-1. NC1094.2 +069200 MOVE "DISP-TEST-GF-1 " TO PAR-NAME. NC1094.2 +069300 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +069400 DISPLAY DISPLAY-A. NC1094.2 +069500* NOTE GROUP OF ALPHABETIC DATA ITEMS. NC1094.2 +069600 MOVE DISPLAY-A TO DIS-PLAYER. NC1094.2 +069700 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +069800 GO TO DISP-WRITE-GF-1. NC1094.2 +069900 DISP-DELETE-GF-1. NC1094.2 +070000 PERFORM DE-LETE. NC1094.2 +070100 DISP-WRITE-GF-1. NC1094.2 +070200 MOVE "DISP-TEST-GF-1 " TO PAR-NAME. NC1094.2 +070300 PERFORM PRINT-DETAIL. NC1094.2 +070400 DISP-INIT-GF-2. NC1094.2 +070500 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +070600 MOVE "DISP-TEST-GF-2 " TO PAR-NAME. NC1094.2 +070700 DISP-TEST-GF-2. NC1094.2 +070800 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +070900 DISPLAY "ALPHABETIC LITERAL". NC1094.2 +071000* NOTE ALPHABETIC LITERAL. NC1094.2 +071100 MOVE "ALPHABETIC LITERAL" TO DIS-PLAYER. NC1094.2 +071200 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +071300 GO TO DISP-WRITE-GF-2. NC1094.2 +071400 DISP-DELETE-GF-2. NC1094.2 +071500 PERFORM DE-LETE. NC1094.2 +071600 DISP-WRITE-GF-2. NC1094.2 +071700 MOVE "DISP-TEST-GF-2 " TO PAR-NAME. NC1094.2 +071800 PERFORM PRINT-DETAIL. NC1094.2 +071900 DISP-INIT-GF-3. NC1094.2 +072000 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +072100 MOVE "DISP-TEST-GF-3" TO PAR-NAME. NC1094.2 +072200 MOVE 0123456789 TO DISPLAY-N. NC1094.2 +072300 DISP-TEST-GF-3. NC1094.2 +072400 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +072500 DISPLAY DISPLAY-N. NC1094.2 +072600* NOTE NUMERIC DATA ITEM. NC1094.2 +072700 MOVE DISPLAY-N TO DIS-PLAYER. NC1094.2 +072800 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +072900 GO TO DISP-WRITE-GF-3. NC1094.2 +073000 DISP-DELETE-GF-3. NC1094.2 +073100 PERFORM DE-LETE. NC1094.2 +073200 DISP-WRITE-GF-3. NC1094.2 +073300 MOVE "DISP-TEST-GF-3 " TO PAR-NAME. NC1094.2 +073400 PERFORM PRINT-DETAIL. NC1094.2 +073500 DISP-INIT-GF-4. NC1094.2 +073600 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +073700 MOVE "DISP-TEST-GF-4" TO PAR-NAME. NC1094.2 +073800 DISP-TEST-GF-4. NC1094.2 +073900 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +074000 DISPLAY 9876543210. NC1094.2 +074100* NOTE NUMERIC LITERAL. NC1094.2 +074200 MOVE 9876543210 TO DIS-PLAYER. NC1094.2 +074300 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +074400 GO TO DISP-WRITE-GF-4. NC1094.2 +074500 DISP-DELETE-GF-4. NC1094.2 +074600 PERFORM DE-LETE. NC1094.2 +074700 DISP-WRITE-GF-4. NC1094.2 +074800 MOVE "DISP-TEST-GF-4 " TO PAR-NAME. NC1094.2 +074900 PERFORM PRINT-DETAIL. NC1094.2 +075000 DISP-INIT-GF-5. NC1094.2 +075100 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +075200 MOVE "DISP-TEST-GF-5" TO PAR-NAME. NC1094.2 +075300 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC1094.2 +075400 DISP-TEST-GF-5. NC1094.2 +075500 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +075600 DISPLAY DISPLAY-X. NC1094.2 +075700* NOTE ALPHANUMERIC DATA ITEM. NC1094.2 +075800 MOVE DISPLAY-X TO DIS-PLAYER. NC1094.2 +075900 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +076000 GO TO DISP-WRITE-GF-5. NC1094.2 +076100 DISP-DELETE-GF-5. NC1094.2 +076200 PERFORM DE-LETE. NC1094.2 +076300 DISP-WRITE-GF-5. NC1094.2 +076400 MOVE "DISP-TEST-GF-5 " TO PAR-NAME. NC1094.2 +076500 PERFORM PRINT-DETAIL. NC1094.2 +076600 DISP-INIT-GF-6. NC1094.2 +076700 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +076800 MOVE "DISP-TEST-GF-6" TO PAR-NAME. NC1094.2 +076900 DISP-TEST-GF-6. NC1094.2 +077000 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +077100 DISPLAY "12345 ///// ALPHANUMERIC LITERAL". NC1094.2 +077200* NOTE ALPHANUMERIC LITERAL. NC1094.2 +077300 MOVE "12345 ///// ALPHANUMERIC LITERAL" TO DIS-PLAYER. NC1094.2 +077400 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +077500 GO TO DISP-WRITE-GF-6. NC1094.2 +077600 DISP-DELETE-GF-6. NC1094.2 +077700 PERFORM DE-LETE. NC1094.2 +077800 DISP-WRITE-GF-6. NC1094.2 +077900 MOVE "DISP-TEST-GF-6 " TO PAR-NAME. NC1094.2 +078000 PERFORM PRINT-DETAIL. NC1094.2 +078100 DISP-INIT-GF-7. NC1094.2 +078200 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +078300 MOVE "DISP-TEST-GF-7" TO PAR-NAME. NC1094.2 +078400 MOVE "ALPHABETIC" TO DISPLAY-A. NC1094.2 +078500 MOVE 0123456789 TO DISPLAY-N. NC1094.2 +078600 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC1094.2 +078700 DISP-TEST-GF-7. NC1094.2 +078800 MOVE "DISP-TEST-GF-7 " TO PAR-NAME. NC1094.2 +078900 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +079000 DISPLAY DISPLAY-A DISPLAY-N DISPLAY-X " SERIES". NC1094.2 +079100* NOTE SERIES OF THREE DATA ITEMS AND A LITERAL. NC1094.2 +079200 MOVE "ALPHABETIC0123456789A1B2C3D4E5 SERIES" NC1094.2 +079300 TO DIS-PLAYER. NC1094.2 +079400 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +079500 GO TO DISP-WRITE-GF-7. NC1094.2 +079600 DISP-DELETE-GF-7. NC1094.2 +079700 PERFORM DE-LETE. NC1094.2 +079800 DISP-WRITE-GF-7. NC1094.2 +079900 MOVE "DISP-TEST-GF-7 " TO PAR-NAME. NC1094.2 +080000 PERFORM PRINT-DETAIL. NC1094.2 +080100 DISP-INIT-GF-8. NC1094.2 +080200 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +080300 MOVE "DISP-TEST-GF-8 " TO PAR-NAME. NC1094.2 +080400 DISP-TEST-GF-8. NC1094.2 +080500 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +080600 DISPLAY ZERO SPACE QUOTE. NC1094.2 +080700* NOTE SERIES OF FIGURATIVE CONSTANTS --- ONLY ONE OCCUR- NC1094.2 +080800* RANCE OF EACH CHARACTER SHOULD APPEAR. NC1094.2 +080900 MOVE ZERO-SPACE-QUOTE TO DIS-PLAYER. NC1094.2 +081000 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +081100 GO TO DISP-WRITE-GF-8. NC1094.2 +081200 DISP-DELETE-GF-8. NC1094.2 +081300 PERFORM DE-LETE. NC1094.2 +081400 DISP-WRITE-GF-8. NC1094.2 +081500 MOVE "DISP-TEST-GF-8 " TO PAR-NAME. NC1094.2 +081600 PERFORM PRINT-DETAIL. NC1094.2 +081700 DISP-INIT-GF-9. NC1094.2 +081800 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +081900 MOVE "DISP-TEST-GF-9 " TO PAR-NAME. NC1094.2 +082000 MOVE "REDEFINE-INFO" TO DISPLAY-B. NC1094.2 +082100 DISP-TEST-GF-9. NC1094.2 +082200 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +082300 DISPLAY DISPLAY-C. NC1094.2 +082400* NOTE DISPLAY DATA ITEM WHICH CONTAINS A REDEFINES CLAUSE.NC1094.2 +082500 MOVE "REDEFINE-INFO" TO DIS-PLAYER. NC1094.2 +082600 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +082700 GO TO DISP-WRITE-GF-9. NC1094.2 +082800 DISP-DELETE-GF-9. NC1094.2 +082900 PERFORM DE-LETE. NC1094.2 +083000 DISP-WRITE-GF-9. NC1094.2 +083100 MOVE "DISP-TEST-GF-9 " TO PAR-NAME. NC1094.2 +083200 PERFORM PRINT-DETAIL. NC1094.2 +083300 DISP-INIT-GF-10. NC1094.2 +083400 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +083500 MOVE "DISP-TEST-GF-10 " TO PAR-NAME. NC1094.2 +083600 DISP-TEST-GF-10. NC1094.2 +083700 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +083800 DISPLAY DISPLAY-F. NC1094.2 +083900* NOTE 200-CHARACTER GROUP ITEM --- ACTUAL NUMBER OF NC1094.2 +084000* CHARACTERS DISPLAYED DEPENDS UPON THE SYSTEM. NC1094.2 +084100 MOVE DISPLAY-G TO DIS-PLAYER. NC1094.2 +084200 MOVE 1 TO DISPLAY-SWITCH. NC1094.2 +084300* NOTE THE "CORRECT" RESULT IS WRITTEN AS TWO 100-CHARACTERNC1094.2 +084400* LINES, BUT THE DIVISION OF THE DISPLAYED "COMPUTED" NC1094.2 +084500* DATA DEPENDS UPON THE SYSTEM. NC1094.2 +084600 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +084700 GO TO DISP-WRITE-GF-10. NC1094.2 +084800 DISP-DELETE-GF-10. NC1094.2 +084900 PERFORM DE-LETE. NC1094.2 +085000 DISP-WRITE-GF-10. NC1094.2 +085100 MOVE "DISP-TEST-GF-10 " TO PAR-NAME. NC1094.2 +085200 PERFORM PRINT-DETAIL. NC1094.2 +085300 DISP-INIT-GF-11. NC1094.2 +085400 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +085500 MOVE "DISP-TEST-GF-11 " TO PAR-NAME. NC1094.2 +085600 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO TAB-VALUE. NC1094.2 +085700 DISP-TEST-GF-11. NC1094.2 +085800 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +085900 DISPLAY X21 X20 X19 X18 X17 X16 X15 X14 X13 X12 X11 X10 X9 NC1094.2 +086000 X8 X7 X6 X5 X4 X3 X2 X1. NC1094.2 +086100* NOTE 21 ELEMENTARY ALPHABETIC DATA ITEMS. NC1094.2 +086200 MOVE "UTSRQPONMLKJIHGFEDCBA" TO DIS-PLAYER. NC1094.2 +086300 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +086400 GO TO DISP-WRITE-GF-11. NC1094.2 +086500 DISP-DELETE-GF-11. NC1094.2 +086600 PERFORM DE-LETE. NC1094.2 +086700 DISP-WRITE-GF-11. NC1094.2 +086800 MOVE "DISP-TEST-GF-11 " TO PAR-NAME. NC1094.2 +086900 PERFORM PRINT-DETAIL. NC1094.2 +087000 DISP-INIT-GF-12. NC1094.2 +087100 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +087200 MOVE "DISP-TEST-GF-12 " TO PAR-NAME. NC1094.2 +087300 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO TAB-VALUE. NC1094.2 +087400 DISP-TEST-GF-12. NC1094.2 +087500 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +087600 DISPLAY XTAB (1) XTAB (2) XTAB (3) XTAB (4) NC1094.2 +087700 XTAB (5) XTAB (6) XTAB (7) XTAB (8) NC1094.2 +087800 XTAB (9) XTAB (10) XTAB (11) XTAB (12) NC1094.2 +087900 XTAB (13) XTAB (14) XTAB (15) XTAB (16) NC1094.2 +088000 XTAB (17) XTAB (18) XTAB (19) XTAB (20) NC1094.2 +088100 XTAB (21). NC1094.2 +088200* NOTE 21 SUBSCRIPTED DATA ITEMS. NC1094.2 +088300 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO DIS-PLAYER. NC1094.2 +088400 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +088500 GO TO DISP-WRITE-GF-12. NC1094.2 +088600 DISP-DELETE-GF-12. NC1094.2 +088700 PERFORM DE-LETE. NC1094.2 +088800 DISP-WRITE-GF-12. NC1094.2 +088900 MOVE "DISP-TEST-GF-12 " TO PAR-NAME. NC1094.2 +089000 PERFORM PRINT-DETAIL. NC1094.2 +089100 DISP-INIT-GF-13. NC1094.2 +089200 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +089300 MOVE "DISP-TEST-GF-13 " TO PAR-NAME. NC1094.2 +089400 DISP-TEST-GF-13. NC1094.2 +089500 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +089600 DISPLAY "QUOTE " QUOTE " ASTERISK " "*" " NUMERIC LITERALS "NC1094.2 +089700 21 SPACE 35 I-DATA PIECE-A (1) PIECE-A (2) PIECE-ANC1094.2 +089800 (3) PIECE-A (4) PIECE-A (5) PIECE-N (1) PIECE-N (2) NC1094.2 +089900 PIECE-N (3) PIECE-N (4) PIECE-N (5) A1 A2. NC1094.2 +090000 MOVE "QUOTE ASTERISK * NUMERIC LITERALS 21 35 IDENTIFNC1094.2 +090100- "IER DATA A B C D E 0102030405 (TOTAL 21 OPERANDS) END OF DATNC1094.2 +090200- "A" TO DIS-PLAYER. NC1094.2 +090300* NOTE 21 MIXED IDENTIFIERS AND LITERALS. NC1094.2 +090400 MOVE QUOTE TO QUOTE-SLOT. NC1094.2 +090500 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +090600 GO TO DISP-WRITE-GF-13. NC1094.2 +090700 DISP-DELETE-GF-13. NC1094.2 +090800 PERFORM DE-LETE. NC1094.2 +090900 DISP-WRITE-GF-13. NC1094.2 +091000 MOVE "DISP-TEST-GF-13 " TO PAR-NAME. NC1094.2 +091100 PERFORM PRINT-DETAIL. NC1094.2 +091200 DISP-INIT-GF-14. NC1094.2 +091300* ===---> "ALL" LITERAL <--=== NC1094.2 +091400 MOVE "V1-78 6.10.4" TO ANSI-REFERENCE. NC1094.2 +091500 MOVE "DISP-TEST-GF-14 GR3 " TO PAR-NAME. NC1094.2 +091600 DISP-TEST-GF-14. NC1094.2 +091700 PERFORM DISPLAY-SUPPORT-1. NC1094.2 +091800 DISPLAY ALL "ABCD" NC1094.2 +091900* NOTE "ALL" LITERAL. NC1094.2 +092000 MOVE "ABCD" TO DIS-PLAYER. NC1094.2 +092100 PERFORM DISPLAY-SUPPORT-2. NC1094.2 +092200 GO TO DISP-WRITE-GF-14. NC1094.2 +092300 DISP-DELETE-GF-14. NC1094.2 +092400 PERFORM DE-LETE. NC1094.2 +092500 DISP-WRITE-GF-14. NC1094.2 +092600 MOVE "DISP-TEST-GF-14 " TO PAR-NAME. NC1094.2 +092700 PERFORM PRINT-DETAIL. NC1094.2 +092800 GO TO CCVS-EXIT. NC1094.2 +092900 DISPLAY-SUPPORT-1. NC1094.2 +093000 PERFORM BLANK-LINE-PRINT. NC1094.2 +093100 MOVE SPACE TO P-OR-F. NC1094.2 +093200 MOVE SEE-BELOW TO COMPUTED-A. NC1094.2 +093300 MOVE SEE-BELOW TO CORRECT-A. NC1094.2 +093400 PERFORM PRINT-DETAIL. NC1094.2 +093500 MOVE SPACE TO FEATURE. NC1094.2 +093600 DISPLAY TEST-RESULTS. NC1094.2 +093700 DISPLAY-SUPPORT-2. NC1094.2 +093800 MOVE SPACE TO TEST-RESULTS. NC1094.2 +093900 DISPLAY TEST-RESULTS. NC1094.2 +094000 MOVE SPACE TO TEST-RESULTS. NC1094.2 +094100 PERFORM PRINT-DETAIL. NC1094.2 +094200 MOVE CORRECT-FOLLOWS TO RE-MARK. NC1094.2 +094300 PERFORM PRINT-DETAIL. NC1094.2 +094400 PERFORM BLANK-LINE-PRINT. NC1094.2 +094500 MOVE DISPLAY-WRITER TO TEST-RESULTS. NC1094.2 +094600 PERFORM PRINT-DETAIL. NC1094.2 +094700 IF DISPLAY-SWITCH EQUAL TO 1 NC1094.2 +094800 MOVE ZERO TO DISPLAY-SWITCH NC1094.2 +094900 MOVE DISPLAY-H TO DIS-PLAYER NC1094.2 +095000 MOVE DISPLAY-WRITER TO TEST-RESULTS NC1094.2 +095100 PERFORM PRINT-DETAIL. NC1094.2 +095200 MOVE SPACE TO TEST-RESULTS. NC1094.2 +095300 PERFORM BLANK-LINE-PRINT. NC1094.2 +095400 IF DISPLAY-SWITCH EQUAL TO 1 NC1094.2 +095500 MOVE "SEE NOTE IN DISP-TEST-GF-10" TO RE-MARK. NC1094.2 +095600 PERFORM PRINT-DETAIL. NC1094.2 +095700 MOVE "DISPLAY" TO FEATURE. NC1094.2 +095800 MOVE SEE-ABOVE TO COMPUTED-A. NC1094.2 +095900 MOVE SEE-ABOVE TO CORRECT-A. NC1094.2 +096000 MOVE END-CORRECT TO RE-MARK. NC1094.2 +096100 MOVE "ERRORS ENCOUNTERED" TO ENDER-DESC. NC1094.2 +096200 CCVS-EXIT SECTION. NC1094.2 +096300 CCVS-999999. NC1094.2 +096400 GO TO CLOSE-FILES. NC1094.2 diff --git a/tests/cobol85/NC/NC109M.DAT b/tests/cobol85/NC/NC109M.DAT new file mode 100755 index 00000000..5e2122b9 --- /dev/null +++ b/tests/cobol85/NC/NC109M.DAT @@ -0,0 +1,11 @@ +ABCDEFGHIJKLMNOPQRSTUVWXY Z +0123456789 +().+-*/$, = +9 +0 + ABC XYZ +0123456789 + +" +ABCD +A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456789 diff --git a/tests/cobol85/NC/NC110M.CBL b/tests/cobol85/NC/NC110M.CBL new file mode 100755 index 00000000..54e988e8 --- /dev/null +++ b/tests/cobol85/NC/NC110M.CBL @@ -0,0 +1,89 @@ +000100 IDENTIFICATION DIVISION. NC1104.2 +000200 PROGRAM-ID. NC1104.2 +000300 NC110M. NC1104.2 +000400**************************************************************** NC1104.2 +000500* * NC1104.2 +000600* VALIDATION FOR:- * NC1104.2 +000700* * NC1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1104.2 +000900* * NC1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1104.2 +001100* * NC1104.2 +001200**************************************************************** NC1104.2 +001300* * NC1104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1104.2 +001500* * NC1104.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1104.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1104.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1104.2 +001900* * NC1104.2 +002000**************************************************************** NC1104.2 +002100* NC1104.2 +002200* THE PROCEDURE DIVISION OF NC110M CONSISTS ENTIRELY OF NC1104.2 +002300* PARAGRAPH NAMES AND "DISPLAY" LITERAL STATEMENTS. NC1104.2 +002400* NC1104.2 +002500 ENVIRONMENT DIVISION. NC1104.2 +002600 CONFIGURATION SECTION. NC1104.2 +002700 SOURCE-COMPUTER. NC1104.2 +002800 Linux. NC1104.2 +002900 OBJECT-COMPUTER. NC1104.2 +003000 Linux. NC1104.2 +003100 DATA DIVISION. NC1104.2 +003200 PROCEDURE DIVISION. NC1104.2 +003300 HEADER-PRINT. NC1104.2 +003400 DISPLAY " ". NC1104.2 +003500 DISPLAY NC1104.2 +003600 " FOR OFFICIAL USE ONLY ".NC1104.2 +003700 DISPLAY NC1104.2 +003800 " OFFICIAL COBOL COMPILER TEST SYSTEM. ". NC1104.2 +003900 DISPLAY NC1104.2 +004000 " TEST RESULTS SET- NC110M ".NC1104.2 +004100 DISPLAY NC1104.2 +004200 " ".NC1104.2 +004300 DISPLAY NC1104.2 +004400 " FOR OFFICIAL USE ONLY " NC1104.2 +004500 " ". NC1104.2 +004600 DISPLAY NC1104.2 +004700 "COPYRIGHT 1985". NC1104.2 +004800 DISPLAY NC1104.2 +004900 " ".NC1104.2 +005000 DISPLAY NC1104.2 +005100 " FEATURE RESULTS AND ".NC1104.2 +005200 DISPLAY NC1104.2 +005300 " TESTED REMARKS ".NC1104.2 +005400 DISPLAY NC1104.2 +005500 " ".NC1104.2 +005600 DISPLAY NC1104.2 +005700 " ---------------------------------------------------------".NC1104.2 +005800 GO-TEST. NC1104.2 +005900 DISPLAY NC1104.2 +006000 " GO TO THIS TEST PASSES UNLESS FAIL APPEARS BELOW. ".NC1104.2 +006100 GO TO PERFORM-TEST. NC1104.2 +006200 GO-FAIL. NC1104.2 +006300 DISPLAY NC1104.2 +006400 " FAIL". NC1104.2 +006500 PERFORM-TEST. NC1104.2 +006600 DISPLAY NC1104.2 +006700 " PERFORM THIS TEST FAILS UNLESS PASS APPEARS BELOW. ".NC1104.2 +006800 PERFORM PASS. NC1104.2 +006900 ENDER-PRINT. NC1104.2 +007000 DISPLAY NC1104.2 +007100 " ---------------------------------------------------------".NC1104.2 +007200 DISPLAY NC1104.2 +007300 SPACE. NC1104.2 +007400 DISPLAY NC1104.2 +007500 " END OF TEST - NC110M ".NC1104.2 +007600 DISPLAY NC1104.2 +007700 " CHECK FOR ERRORS ".NC1104.2 +007800 DISPLAY NC1104.2 +007900 " ".NC1104.2 +008000 DISPLAY NC1104.2 +008100 " FOR OFFICIAL USE ONLY " NC1104.2 +008200 DISPLAY NC1104.2 +008300 "COPYRIGHT 1985". NC1104.2 +008400 DISPLAY NC1104.2 +008500 " NTIS DISTRIBUTION COBOL 1985 ". NC1104.2 +008600 STOP RUN. NC1104.2 +008700 PASS. NC1104.2 +008800 DISPLAY NC1104.2 +008900 " PASS". NC1104.2 diff --git a/tests/cobol85/NC/NC111A.CBL b/tests/cobol85/NC/NC111A.CBL new file mode 100755 index 00000000..bb38d6fa --- /dev/null +++ b/tests/cobol85/NC/NC111A.CBL @@ -0,0 +1,478 @@ +000100 IDENTIFICATION DIVISION. NC1114.2 +000200 PROGRAM-ID. NC1114.2 +000300 NC111A. NC1114.2 +000400**************************************************************** NC1114.2 +000500* * NC1114.2 +000600* VALIDATION FOR:- * NC1114.2 +000700* * NC1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1114.2 +000900* * NC1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1114.2 +001100* * NC1114.2 +001200**************************************************************** NC1114.2 +001300* * NC1114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1114.2 +001500* * NC1114.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1114.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1114.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1114.2 +001900* * NC1114.2 +002000**************************************************************** NC1114.2 +002100* NC1114.2 +002200* PROGRAM NC111A TESTS THE TRUNCATION OF RESULTANT IDENTIFIERS NC1114.2 +002300* USING ADD SUBTRACT AND MULTIPLY STATEMENTS. NC1114.2 +002400* NC1114.2 +002500* NC1114.2 +002600 NC1114.2 +002700 ENVIRONMENT DIVISION. NC1114.2 +002800 CONFIGURATION SECTION. NC1114.2 +002900 SOURCE-COMPUTER. NC1114.2 +003000 Linux. NC1114.2 +003100 OBJECT-COMPUTER. NC1114.2 +003200 Linux. NC1114.2 +003300 INPUT-OUTPUT SECTION. NC1114.2 +003400 FILE-CONTROL. NC1114.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1114.2 +003600 "report.log". NC1114.2 +003700 DATA DIVISION. NC1114.2 +003800 FILE SECTION. NC1114.2 +003900 FD PRINT-FILE. NC1114.2 +004000 01 PRINT-REC PICTURE X(120). NC1114.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1114.2 +004200 WORKING-STORAGE SECTION. NC1114.2 +004300 01 N-11 PICTURE IS 9 VALUE IS 9. NC1114.2 +004400 01 N-12 PICTURE IS 9 VALUE IS 9. NC1114.2 +004500 01 N-40 PICTURE IS 9(7) NC1114.2 +004600 VALUE IS 7777777. NC1114.2 +004700 01 N-41 PICTURE IS 9(7) NC1114.2 +004800 VALUE IS 1111111. NC1114.2 +004900 01 N-42 PICTURE IS 9(3)P(4). NC1114.2 +005000 01 TRUNC-DATA. NC1114.2 +005100 02 N-43 PICTURE S9V9 VALUE +1.6. NC1114.2 +005200 02 N-44 PICTURE S9V9 VALUE -1.6. NC1114.2 +005300 02 N-45 PICTURE S9. NC1114.2 +005400 01 TEST-RESULTS. NC1114.2 +005500 02 FILLER PIC X VALUE SPACE. NC1114.2 +005600 02 FEATURE PIC X(20) VALUE SPACE. NC1114.2 +005700 02 FILLER PIC X VALUE SPACE. NC1114.2 +005800 02 P-OR-F PIC X(5) VALUE SPACE. NC1114.2 +005900 02 FILLER PIC X VALUE SPACE. NC1114.2 +006000 02 PAR-NAME. NC1114.2 +006100 03 FILLER PIC X(19) VALUE SPACE. NC1114.2 +006200 03 PARDOT-X PIC X VALUE SPACE. NC1114.2 +006300 03 DOTVALUE PIC 99 VALUE ZERO. NC1114.2 +006400 02 FILLER PIC X(8) VALUE SPACE. NC1114.2 +006500 02 RE-MARK PIC X(61). NC1114.2 +006600 01 TEST-COMPUTED. NC1114.2 +006700 02 FILLER PIC X(30) VALUE SPACE. NC1114.2 +006800 02 FILLER PIC X(17) VALUE NC1114.2 +006900 " COMPUTED=". NC1114.2 +007000 02 COMPUTED-X. NC1114.2 +007100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1114.2 +007200 03 COMPUTED-N REDEFINES COMPUTED-A NC1114.2 +007300 PIC -9(9).9(9). NC1114.2 +007400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1114.2 +007500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1114.2 +007600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1114.2 +007700 03 CM-18V0 REDEFINES COMPUTED-A. NC1114.2 +007800 04 COMPUTED-18V0 PIC -9(18). NC1114.2 +007900 04 FILLER PIC X. NC1114.2 +008000 03 FILLER PIC X(50) VALUE SPACE. NC1114.2 +008100 01 TEST-CORRECT. NC1114.2 +008200 02 FILLER PIC X(30) VALUE SPACE. NC1114.2 +008300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1114.2 +008400 02 CORRECT-X. NC1114.2 +008500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1114.2 +008600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1114.2 +008700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1114.2 +008800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1114.2 +008900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1114.2 +009000 03 CR-18V0 REDEFINES CORRECT-A. NC1114.2 +009100 04 CORRECT-18V0 PIC -9(18). NC1114.2 +009200 04 FILLER PIC X. NC1114.2 +009300 03 FILLER PIC X(2) VALUE SPACE. NC1114.2 +009400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1114.2 +009500 01 CCVS-C-1. NC1114.2 +009600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1114.2 +009700- "SS PARAGRAPH-NAME NC1114.2 +009800- " REMARKS". NC1114.2 +009900 02 FILLER PIC X(20) VALUE SPACE. NC1114.2 +010000 01 CCVS-C-2. NC1114.2 +010100 02 FILLER PIC X VALUE SPACE. NC1114.2 +010200 02 FILLER PIC X(6) VALUE "TESTED". NC1114.2 +010300 02 FILLER PIC X(15) VALUE SPACE. NC1114.2 +010400 02 FILLER PIC X(4) VALUE "FAIL". NC1114.2 +010500 02 FILLER PIC X(94) VALUE SPACE. NC1114.2 +010600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1114.2 +010700 01 REC-CT PIC 99 VALUE ZERO. NC1114.2 +010800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1114.2 +010900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1114.2 +011000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1114.2 +011100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1114.2 +011200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1114.2 +011300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1114.2 +011400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1114.2 +011500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1114.2 +011600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1114.2 +011700 01 CCVS-H-1. NC1114.2 +011800 02 FILLER PIC X(39) VALUE SPACES. NC1114.2 +011900 02 FILLER PIC X(42) VALUE NC1114.2 +012000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1114.2 +012100 02 FILLER PIC X(39) VALUE SPACES. NC1114.2 +012200 01 CCVS-H-2A. NC1114.2 +012300 02 FILLER PIC X(40) VALUE SPACE. NC1114.2 +012400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1114.2 +012500 02 FILLER PIC XXXX VALUE NC1114.2 +012600 "4.2 ". NC1114.2 +012700 02 FILLER PIC X(28) VALUE NC1114.2 +012800 " COPY - NOT FOR DISTRIBUTION". NC1114.2 +012900 02 FILLER PIC X(41) VALUE SPACE. NC1114.2 +013000 NC1114.2 +013100 01 CCVS-H-2B. NC1114.2 +013200 02 FILLER PIC X(15) VALUE NC1114.2 +013300 "TEST RESULT OF ". NC1114.2 +013400 02 TEST-ID PIC X(9). NC1114.2 +013500 02 FILLER PIC X(4) VALUE NC1114.2 +013600 " IN ". NC1114.2 +013700 02 FILLER PIC X(12) VALUE NC1114.2 +013800 " HIGH ". NC1114.2 +013900 02 FILLER PIC X(22) VALUE NC1114.2 +014000 " LEVEL VALIDATION FOR ". NC1114.2 +014100 02 FILLER PIC X(58) VALUE NC1114.2 +014200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1114.2 +014300 01 CCVS-H-3. NC1114.2 +014400 02 FILLER PIC X(34) VALUE NC1114.2 +014500 " FOR OFFICIAL USE ONLY ". NC1114.2 +014600 02 FILLER PIC X(58) VALUE NC1114.2 +014700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1114.2 +014800 02 FILLER PIC X(28) VALUE NC1114.2 +014900 " COPYRIGHT 1985 ". NC1114.2 +015000 01 CCVS-E-1. NC1114.2 +015100 02 FILLER PIC X(52) VALUE SPACE. NC1114.2 +015200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1114.2 +015300 02 ID-AGAIN PIC X(9). NC1114.2 +015400 02 FILLER PIC X(45) VALUE SPACES. NC1114.2 +015500 01 CCVS-E-2. NC1114.2 +015600 02 FILLER PIC X(31) VALUE SPACE. NC1114.2 +015700 02 FILLER PIC X(21) VALUE SPACE. NC1114.2 +015800 02 CCVS-E-2-2. NC1114.2 +015900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1114.2 +016000 03 FILLER PIC X VALUE SPACE. NC1114.2 +016100 03 ENDER-DESC PIC X(44) VALUE NC1114.2 +016200 "ERRORS ENCOUNTERED". NC1114.2 +016300 01 CCVS-E-3. NC1114.2 +016400 02 FILLER PIC X(22) VALUE NC1114.2 +016500 " FOR OFFICIAL USE ONLY". NC1114.2 +016600 02 FILLER PIC X(12) VALUE SPACE. NC1114.2 +016700 02 FILLER PIC X(58) VALUE NC1114.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1114.2 +016900 02 FILLER PIC X(13) VALUE SPACE. NC1114.2 +017000 02 FILLER PIC X(15) VALUE NC1114.2 +017100 " COPYRIGHT 1985". NC1114.2 +017200 01 CCVS-E-4. NC1114.2 +017300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1114.2 +017400 02 FILLER PIC X(4) VALUE " OF ". NC1114.2 +017500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1114.2 +017600 02 FILLER PIC X(40) VALUE NC1114.2 +017700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1114.2 +017800 01 XXINFO. NC1114.2 +017900 02 FILLER PIC X(19) VALUE NC1114.2 +018000 "*** INFORMATION ***". NC1114.2 +018100 02 INFO-TEXT. NC1114.2 +018200 04 FILLER PIC X(8) VALUE SPACE. NC1114.2 +018300 04 XXCOMPUTED PIC X(20). NC1114.2 +018400 04 FILLER PIC X(5) VALUE SPACE. NC1114.2 +018500 04 XXCORRECT PIC X(20). NC1114.2 +018600 02 INF-ANSI-REFERENCE PIC X(48). NC1114.2 +018700 01 HYPHEN-LINE. NC1114.2 +018800 02 FILLER PIC IS X VALUE IS SPACE. NC1114.2 +018900 02 FILLER PIC IS X(65) VALUE IS "************************NC1114.2 +019000- "*****************************************". NC1114.2 +019100 02 FILLER PIC IS X(54) VALUE IS "************************NC1114.2 +019200- "******************************". NC1114.2 +019300 01 CCVS-PGM-ID PIC X(9) VALUE NC1114.2 +019400 "NC111A". NC1114.2 +019500 PROCEDURE DIVISION. NC1114.2 +019600 CCVS1 SECTION. NC1114.2 +019700 OPEN-FILES. NC1114.2 +019800 OPEN OUTPUT PRINT-FILE. NC1114.2 +019900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1114.2 +020000 MOVE SPACE TO TEST-RESULTS. NC1114.2 +020100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1114.2 +020200 GO TO CCVS1-EXIT. NC1114.2 +020300 CLOSE-FILES. NC1114.2 +020400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1114.2 +020500 TERMINATE-CCVS. NC1114.2 +020600*S EXIT PROGRAM. NC1114.2 +020700*SERMINATE-CALL. NC1114.2 +020800 STOP RUN. NC1114.2 +020900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1114.2 +021000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1114.2 +021100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1114.2 +021200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1114.2 +021300 MOVE "****TEST DELETED****" TO RE-MARK. NC1114.2 +021400 PRINT-DETAIL. NC1114.2 +021500 IF REC-CT NOT EQUAL TO ZERO NC1114.2 +021600 MOVE "." TO PARDOT-X NC1114.2 +021700 MOVE REC-CT TO DOTVALUE. NC1114.2 +021800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1114.2 +021900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1114.2 +022000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1114.2 +022100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1114.2 +022200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1114.2 +022300 MOVE SPACE TO CORRECT-X. NC1114.2 +022400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1114.2 +022500 MOVE SPACE TO RE-MARK. NC1114.2 +022600 HEAD-ROUTINE. NC1114.2 +022700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +022800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +022900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1114.2 +023000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1114.2 +023100 COLUMN-NAMES-ROUTINE. NC1114.2 +023200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +023300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +023500 END-ROUTINE. NC1114.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1114.2 +023700 END-RTN-EXIT. NC1114.2 +023800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +023900 END-ROUTINE-1. NC1114.2 +024000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1114.2 +024100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1114.2 +024200 ADD PASS-COUNTER TO ERROR-HOLD. NC1114.2 +024300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1114.2 +024400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1114.2 +024500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1114.2 +024600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1114.2 +024700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1114.2 +024800 END-ROUTINE-12. NC1114.2 +024900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1114.2 +025000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1114.2 +025100 MOVE "NO " TO ERROR-TOTAL NC1114.2 +025200 ELSE NC1114.2 +025300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1114.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1114.2 +025500 PERFORM WRITE-LINE. NC1114.2 +025600 END-ROUTINE-13. NC1114.2 +025700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1114.2 +025800 MOVE "NO " TO ERROR-TOTAL ELSE NC1114.2 +025900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1114.2 +026000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1114.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +026200 IF INSPECT-COUNTER EQUAL TO ZERO NC1114.2 +026300 MOVE "NO " TO ERROR-TOTAL NC1114.2 +026400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1114.2 +026500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1114.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +026700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1114.2 +026800 WRITE-LINE. NC1114.2 +026900 ADD 1 TO RECORD-COUNT. NC1114.2 +027000 IF RECORD-COUNT GREATER 42 NC1114.2 +027100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1114.2 +027200 MOVE SPACE TO DUMMY-RECORD NC1114.2 +027300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1114.2 +027400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1114.2 +027500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1114.2 +027600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1114.2 +027700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1114.2 +027800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1114.2 +027900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1114.2 +028000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1114.2 +028100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1114.2 +028200 MOVE ZERO TO RECORD-COUNT. NC1114.2 +028300 PERFORM WRT-LN. NC1114.2 +028400 WRT-LN. NC1114.2 +028500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1114.2 +028600 MOVE SPACE TO DUMMY-RECORD. NC1114.2 +028700 BLANK-LINE-PRINT. NC1114.2 +028800 PERFORM WRT-LN. NC1114.2 +028900 FAIL-ROUTINE. NC1114.2 +029000 IF COMPUTED-X NOT EQUAL TO SPACE NC1114.2 +029100 GO TO FAIL-ROUTINE-WRITE. NC1114.2 +029200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1114.2 +029300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1114.2 +029400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1114.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1114.2 +029700 GO TO FAIL-ROUTINE-EX. NC1114.2 +029800 FAIL-ROUTINE-WRITE. NC1114.2 +029900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1114.2 +030000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1114.2 +030100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1114.2 +030200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1114.2 +030300 FAIL-ROUTINE-EX. EXIT. NC1114.2 +030400 BAIL-OUT. NC1114.2 +030500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1114.2 +030600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1114.2 +030700 BAIL-OUT-WRITE. NC1114.2 +030800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1114.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1114.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1114.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1114.2 +031200 BAIL-OUT-EX. EXIT. NC1114.2 +031300 CCVS1-EXIT. NC1114.2 +031400 EXIT. NC1114.2 +031500 SECT-NC111A-001 SECTION. NC1114.2 +031600 BLURB-REMARK. NC1114.2 +031700 MOVE SPACE TO TEST-RESULTS. NC1114.2 +031800 MOVE "THE FOLLOWING 3 TESTS TEST " TO RE-MARK. NC1114.2 +031900 PERFORM PRINT-DETAIL. NC1114.2 +032000 MOVE "SOME SPECIFIC FEATURES OF " TO RE-MARK. NC1114.2 +032100 PERFORM PRINT-DETAIL. NC1114.2 +032200 MOVE "THE TRUNCATION, ROUNDED AND" TO RE-MARK. NC1114.2 +032300 PERFORM PRINT-DETAIL. NC1114.2 +032400 MOVE "SIZE ERROR OPTIONS. GENERAL" TO RE-MARK. NC1114.2 +032500 PERFORM PRINT-DETAIL. NC1114.2 +032600 MOVE "FEATURES OF THESE OPTIONS " TO RE-MARK. NC1114.2 +032700 PERFORM PRINT-DETAIL. NC1114.2 +032800 MOVE "ARE TESTED IN THE ADD, SUB-" TO RE-MARK. NC1114.2 +032900 PERFORM PRINT-DETAIL. NC1114.2 +033000 MOVE "TRACT, MULTIPLY, AND DIVIDE" TO RE-MARK. NC1114.2 +033100 PERFORM PRINT-DETAIL. NC1114.2 +033200 MOVE "TESTS. " TO RE-MARK. NC1114.2 +033300 PERFORM PRINT-DETAIL. NC1114.2 +033400 TRU-INIT-GF-1. NC1114.2 +033500 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +033600 MOVE 7777777 TO N-40. NC1114.2 +033700 MOVE 1111111 TO N-41. NC1114.2 +033800 TRU-TEST-GF-1-0. NC1114.2 +033900 ADD N-40 N-41 GIVING N-42. NC1114.2 +034000 TRU-TEST-GF-1-1. NC1114.2 +034100 IF N-42 EQUAL TO 8880000 NC1114.2 +034200 PERFORM PASS NC1114.2 +034300 GO TO TRU-WRITE-GF-1. NC1114.2 +034400 GO TO TRU-FAIL-GF-1. NC1114.2 +034500 TRU-DELETE-GF-1. NC1114.2 +034600 PERFORM DE-LETE. NC1114.2 +034700 GO TO TRU-WRITE-GF-1. NC1114.2 +034800 TRU-FAIL-GF-1. NC1114.2 +034900 MOVE N-42 TO COMPUTED-N. NC1114.2 +035000 MOVE 8880000 TO CORRECT-N. NC1114.2 +035100 PERFORM FAIL. NC1114.2 +035200 TRU-WRITE-GF-1. NC1114.2 +035300 MOVE "TRUNCATION" TO FEATURE. NC1114.2 +035400 MOVE "TRU-TEST-GF-1" TO PAR-NAME. NC1114.2 +035500 PERFORM PRINT-DETAIL. NC1114.2 +035600 TRU-INIT-GF-2. NC1114.2 +035700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +035800 MOVE ZERO TO N-45. NC1114.2 +035900 MOVE +1.6 TO N-43. NC1114.2 +036000 TRU-TEST-GF-2-0. NC1114.2 +036100 ADD N-43 1.4 GIVING N-45. NC1114.2 +036200 TRU-TEST-GF-2-1. NC1114.2 +036300 IF N-45 EQUAL TO +3 NC1114.2 +036400 PERFORM PASS GO TO TRU-WRITE-GF-2. NC1114.2 +036500 GO TO TRU-FAIL-GF-2. NC1114.2 +036600 TRU-DELETE-GF-2. NC1114.2 +036700 PERFORM DE-LETE. NC1114.2 +036800 GO TO TRU-WRITE-GF-2. NC1114.2 +036900 TRU-FAIL-GF-2. NC1114.2 +037000 PERFORM FAIL. NC1114.2 +037100 MOVE N-45 TO COMPUTED-N. NC1114.2 +037200 MOVE 3 TO CORRECT-N. NC1114.2 +037300 TRU-WRITE-GF-2. NC1114.2 +037400 MOVE "TRU-TEST-GF-2 " TO PAR-NAME. NC1114.2 +037500 PERFORM PRINT-DETAIL. NC1114.2 +037600 TRU-INIT-GF-3. NC1114.2 +037700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +037800 MOVE ZERO TO N-45. NC1114.2 +037900 MOVE -1.6 TO N-44. NC1114.2 +038000 TRU-TEST-GF-3-0. NC1114.2 +038100 ADD N-44 -1.4 GIVING N-45. NC1114.2 +038200 TRU-TEST-GF-3-1. NC1114.2 +038300 IF N-45 EQUAL TO -3 NC1114.2 +038400 PERFORM PASS GO TO TRU-WRITE-GF-3. NC1114.2 +038500 GO TO TRU-FAIL-GF-3. NC1114.2 +038600 TRU-DELETE-GF-3. NC1114.2 +038700 PERFORM DE-LETE. NC1114.2 +038800 GO TO TRU-WRITE-GF-3. NC1114.2 +038900 TRU-FAIL-GF-3. NC1114.2 +039000 PERFORM FAIL. NC1114.2 +039100 MOVE N-45 TO COMPUTED-N. NC1114.2 +039200 MOVE -3 TO CORRECT-N. NC1114.2 +039300 TRU-WRITE-GF-3. NC1114.2 +039400 MOVE "TRU-TEST-GF-3 " TO PAR-NAME. NC1114.2 +039500 PERFORM PRINT-DETAIL. NC1114.2 +039600 TRU-INIT-GF-4. NC1114.2 +039700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +039800 MOVE ZERO TO N-45. NC1114.2 +039900 MOVE +1.6 TO N-43. NC1114.2 +040000 TRU-TEST-GF-4-0. NC1114.2 +040100 MULTIPLY 5 BY N-43 GIVING N-45. NC1114.2 +040200 TRU-TEST-GF-4-1. NC1114.2 +040300 IF N-45 EQUAL TO +8 NC1114.2 +040400 PERFORM PASS GO TO TRU-WRITE-GF-4. NC1114.2 +040500 GO TO TRU-FAIL-GF-4. NC1114.2 +040600 TRU-DELETE-GF-4. NC1114.2 +040700 PERFORM DE-LETE. NC1114.2 +040800 GO TO TRU-WRITE-GF-4. NC1114.2 +040900 TRU-FAIL-GF-4. NC1114.2 +041000 PERFORM FAIL. NC1114.2 +041100 MOVE N-45 TO COMPUTED-N. NC1114.2 +041200 MOVE 8 TO CORRECT-N. NC1114.2 +041300 TRU-WRITE-GF-4. NC1114.2 +041400 MOVE "TRU-TEST-GF-4 " TO PAR-NAME. NC1114.2 +041500 PERFORM PRINT-DETAIL. NC1114.2 +041600 TRU-INIT-GF-5. NC1114.2 +041700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +041800 MOVE ZERO TO N-45. NC1114.2 +041900 MOVE -1.6 TO N-44. NC1114.2 +042000 TRU-TEST-GF-5-0. NC1114.2 +042100 MULTIPLY 5 BY N-44 GIVING N-45. NC1114.2 +042200 TRU-TEST-GF-5-1. NC1114.2 +042300 IF N-45 EQUAL TO -8 NC1114.2 +042400 PERFORM PASS GO TO TRU-WRITE-GF-5. NC1114.2 +042500 GO TO TRU-FAIL-GF-5. NC1114.2 +042600 TRU-DELETE-GF-5. NC1114.2 +042700 PERFORM DE-LETE. NC1114.2 +042800 GO TO TRU-WRITE-GF-5. NC1114.2 +042900 TRU-FAIL-GF-5. NC1114.2 +043000 PERFORM FAIL. NC1114.2 +043100 MOVE N-45 TO COMPUTED-N. NC1114.2 +043200 MOVE -8 TO CORRECT-N. NC1114.2 +043300 TRU-WRITE-GF-5. NC1114.2 +043400 MOVE "TRU-TEST-GF-5 " TO PAR-NAME. NC1114.2 +043500 PERFORM PRINT-DETAIL. NC1114.2 +043600 TRU-INIT-GF-6. NC1114.2 +043700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +043800 MOVE ZERO TO N-45. NC1114.2 +043900 MOVE +1.6 TO N-43. NC1114.2 +044000 TRU-TEST-GF-6-0. NC1114.2 +044100 SUBTRACT -1.4 FROM N-43 GIVING N-45. NC1114.2 +044200 TRU-TEST-GF-6-1. NC1114.2 +044300 IF N-45 EQUAL TO +3 NC1114.2 +044400 PERFORM PASS GO TO TRU-WRITE-GF-6. NC1114.2 +044500 GO TO TRU-FAIL-GF-6. NC1114.2 +044600 TRU-DELETE-GF-6. NC1114.2 +044700 PERFORM DE-LETE. NC1114.2 +044800 GO TO TRU-WRITE-GF-6. NC1114.2 +044900 TRU-FAIL-GF-6. NC1114.2 +045000 PERFORM FAIL. NC1114.2 +045100 MOVE N-45 TO COMPUTED-N. NC1114.2 +045200 MOVE 3 TO CORRECT-N. NC1114.2 +045300 TRU-WRITE-GF-6. NC1114.2 +045400 MOVE "TRU-TEST-GF-6 " TO PAR-NAME. NC1114.2 +045500 PERFORM PRINT-DETAIL. NC1114.2 +045600 TRU-INIT-GF-7. NC1114.2 +045700 MOVE "V1-67 6.4.1" TO ANSI-REFERENCE. NC1114.2 +045800 MOVE ZERO TO N-45. NC1114.2 +045900 MOVE -1.6 TO N-44. NC1114.2 +046000 TRU-TEST-GF-7-0. NC1114.2 +046100 SUBTRACT +1.4 FROM N-44 GIVING N-45. NC1114.2 +046200 TRU-TEST-GF-7-1. NC1114.2 +046300 IF N-45 EQUAL TO -3 NC1114.2 +046400 PERFORM PASS GO TO TRU-WRITE-GF-7. NC1114.2 +046500 GO TO TRU-FAIL-GF-7. NC1114.2 +046600 TRU-DELETE-GF-7. NC1114.2 +046700 PERFORM DE-LETE. NC1114.2 +046800 GO TO TRU-WRITE-GF-7. NC1114.2 +046900 TRU-FAIL-GF-7. NC1114.2 +047000 PERFORM FAIL. NC1114.2 +047100 MOVE N-45 TO COMPUTED-N. NC1114.2 +047200 MOVE -3 TO CORRECT-N. NC1114.2 +047300 TRU-WRITE-GF-7. NC1114.2 +047400 MOVE "TRU-TEST-GF-7 " TO PAR-NAME. NC1114.2 +047500 PERFORM PRINT-DETAIL. NC1114.2 +047600 CCVS-EXIT SECTION. NC1114.2 +047700 CCVS-999999. NC1114.2 +047800 GO TO CLOSE-FILES. NC1114.2 diff --git a/tests/cobol85/NC/NC112A.CBL b/tests/cobol85/NC/NC112A.CBL new file mode 100755 index 00000000..13ff9a6e --- /dev/null +++ b/tests/cobol85/NC/NC112A.CBL @@ -0,0 +1,1027 @@ +000100 IDENTIFICATION DIVISION. NC1124.2 +000200 PROGRAM-ID. NC1124.2 +000300 NC112A. NC1124.2 +000400**************************************************************** NC1124.2 +000500* * NC1124.2 +000600* VALIDATION FOR:- * NC1124.2 +000700* * NC1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1124.2 +000900* * NC1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1124.2 +001100* * NC1124.2 +001200**************************************************************** NC1124.2 +001300* * NC1124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1124.2 +001500* * NC1124.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1124.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1124.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1124.2 +001900* * NC1124.2 +002000**************************************************************** NC1124.2 +002100* NC1124.2 +002200* PROGRAM NC112A TESTS THE USE OF MULTIPLE OPERANDS WITH NC1124.2 +002300* THE ADD, SUBTRACT AND MOVE STATEMENTS. NC1124.2 +002400* NC1124.2 +002500 ENVIRONMENT DIVISION. NC1124.2 +002600 CONFIGURATION SECTION. NC1124.2 +002700 SOURCE-COMPUTER. NC1124.2 +002800 Linux. NC1124.2 +002900 OBJECT-COMPUTER. NC1124.2 +003000 Linux. NC1124.2 +003100 INPUT-OUTPUT SECTION. NC1124.2 +003200 FILE-CONTROL. NC1124.2 +003300 SELECT PRINT-FILE ASSIGN TO NC1124.2 +003400 "report.log". NC1124.2 +003500 DATA DIVISION. NC1124.2 +003600 FILE SECTION. NC1124.2 +003700 FD PRINT-FILE. NC1124.2 +003800 01 PRINT-REC PICTURE X(120). NC1124.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC1124.2 +004000 WORKING-STORAGE SECTION. NC1124.2 +004100 77 ACCUM-1 PICTURE 9(17) VALUE ZERO. NC1124.2 +004200 77 ACCUM-2 PICTURE 9(18) VALUE ZERO. NC1124.2 +004300 77 ACCUM-3 PICTURE 9V9(3) VALUE 1. NC1124.2 +004400 77 ACCUM-4 PICTURE 9V9(3) VALUE ZERO. NC1124.2 +004500 01 D-NAMES. NC1124.2 +004600 02 DNAME-1 PICTURE 9 VALUE 1. NC1124.2 +004700 02 DNAME-2 PICTURE 9(3) VALUE 1. NC1124.2 +004800 02 DNAME-3 PICTURE 9(5) VALUE 1. NC1124.2 +004900 02 DNAME-4 PICTURE 9(7) VALUE 1. NC1124.2 +005000 02 DNAME-5 PICTURE 9(9) VALUE 1. NC1124.2 +005100 02 DNAME-6 PICTURE 9(11) VALUE 1. NC1124.2 +005200 02 DNAME-7 PICTURE 9(13) VALUE 1. NC1124.2 +005300 02 DNAME-8 PICTURE 9(15) VALUE 1. NC1124.2 +005400 02 DNAME-9 PICTURE 9(17) VALUE 1. NC1124.2 +005500 02 DNAME-10 PICTURE 9(18) VALUE 1. NC1124.2 +005600 01 TEST-RESULTS. NC1124.2 +005700 02 FILLER PIC X VALUE SPACE. NC1124.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. NC1124.2 +005900 02 FILLER PIC X VALUE SPACE. NC1124.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. NC1124.2 +006100 02 FILLER PIC X VALUE SPACE. NC1124.2 +006200 02 PAR-NAME. NC1124.2 +006300 03 FILLER PIC X(19) VALUE SPACE. NC1124.2 +006400 03 PARDOT-X PIC X VALUE SPACE. NC1124.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. NC1124.2 +006600 02 FILLER PIC X(8) VALUE SPACE. NC1124.2 +006700 02 RE-MARK PIC X(61). NC1124.2 +006800 01 TEST-COMPUTED. NC1124.2 +006900 02 FILLER PIC X(30) VALUE SPACE. NC1124.2 +007000 02 FILLER PIC X(17) VALUE NC1124.2 +007100 " COMPUTED=". NC1124.2 +007200 02 COMPUTED-X. NC1124.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1124.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A NC1124.2 +007500 PIC -9(9).9(9). NC1124.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1124.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1124.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1124.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. NC1124.2 +008000 04 COMPUTED-18V0 PIC -9(18). NC1124.2 +008100 04 FILLER PIC X. NC1124.2 +008200 03 FILLER PIC X(50) VALUE SPACE. NC1124.2 +008300 01 TEST-CORRECT. NC1124.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC1124.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1124.2 +008600 02 CORRECT-X. NC1124.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1124.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1124.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1124.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1124.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1124.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. NC1124.2 +009300 04 CORRECT-18V0 PIC -9(18). NC1124.2 +009400 04 FILLER PIC X. NC1124.2 +009500 03 FILLER PIC X(2) VALUE SPACE. NC1124.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1124.2 +009700 01 CCVS-C-1. NC1124.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1124.2 +009900- "SS PARAGRAPH-NAME NC1124.2 +010000- " REMARKS". NC1124.2 +010100 02 FILLER PIC X(20) VALUE SPACE. NC1124.2 +010200 01 CCVS-C-2. NC1124.2 +010300 02 FILLER PIC X VALUE SPACE. NC1124.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". NC1124.2 +010500 02 FILLER PIC X(15) VALUE SPACE. NC1124.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". NC1124.2 +010700 02 FILLER PIC X(94) VALUE SPACE. NC1124.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1124.2 +010900 01 REC-CT PIC 99 VALUE ZERO. NC1124.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1124.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1124.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1124.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1124.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1124.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1124.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1124.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1124.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1124.2 +011900 01 CCVS-H-1. NC1124.2 +012000 02 FILLER PIC X(39) VALUE SPACES. NC1124.2 +012100 02 FILLER PIC X(42) VALUE NC1124.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1124.2 +012300 02 FILLER PIC X(39) VALUE SPACES. NC1124.2 +012400 01 CCVS-H-2A. NC1124.2 +012500 02 FILLER PIC X(40) VALUE SPACE. NC1124.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1124.2 +012700 02 FILLER PIC XXXX VALUE NC1124.2 +012800 "4.2 ". NC1124.2 +012900 02 FILLER PIC X(28) VALUE NC1124.2 +013000 " COPY - NOT FOR DISTRIBUTION". NC1124.2 +013100 02 FILLER PIC X(41) VALUE SPACE. NC1124.2 +013200 NC1124.2 +013300 01 CCVS-H-2B. NC1124.2 +013400 02 FILLER PIC X(15) VALUE NC1124.2 +013500 "TEST RESULT OF ". NC1124.2 +013600 02 TEST-ID PIC X(9). NC1124.2 +013700 02 FILLER PIC X(4) VALUE NC1124.2 +013800 " IN ". NC1124.2 +013900 02 FILLER PIC X(12) VALUE NC1124.2 +014000 " HIGH ". NC1124.2 +014100 02 FILLER PIC X(22) VALUE NC1124.2 +014200 " LEVEL VALIDATION FOR ". NC1124.2 +014300 02 FILLER PIC X(58) VALUE NC1124.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1124.2 +014500 01 CCVS-H-3. NC1124.2 +014600 02 FILLER PIC X(34) VALUE NC1124.2 +014700 " FOR OFFICIAL USE ONLY ". NC1124.2 +014800 02 FILLER PIC X(58) VALUE NC1124.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1124.2 +015000 02 FILLER PIC X(28) VALUE NC1124.2 +015100 " COPYRIGHT 1985 ". NC1124.2 +015200 01 CCVS-E-1. NC1124.2 +015300 02 FILLER PIC X(52) VALUE SPACE. NC1124.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1124.2 +015500 02 ID-AGAIN PIC X(9). NC1124.2 +015600 02 FILLER PIC X(45) VALUE SPACES. NC1124.2 +015700 01 CCVS-E-2. NC1124.2 +015800 02 FILLER PIC X(31) VALUE SPACE. NC1124.2 +015900 02 FILLER PIC X(21) VALUE SPACE. NC1124.2 +016000 02 CCVS-E-2-2. NC1124.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1124.2 +016200 03 FILLER PIC X VALUE SPACE. NC1124.2 +016300 03 ENDER-DESC PIC X(44) VALUE NC1124.2 +016400 "ERRORS ENCOUNTERED". NC1124.2 +016500 01 CCVS-E-3. NC1124.2 +016600 02 FILLER PIC X(22) VALUE NC1124.2 +016700 " FOR OFFICIAL USE ONLY". NC1124.2 +016800 02 FILLER PIC X(12) VALUE SPACE. NC1124.2 +016900 02 FILLER PIC X(58) VALUE NC1124.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1124.2 +017100 02 FILLER PIC X(13) VALUE SPACE. NC1124.2 +017200 02 FILLER PIC X(15) VALUE NC1124.2 +017300 " COPYRIGHT 1985". NC1124.2 +017400 01 CCVS-E-4. NC1124.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1124.2 +017600 02 FILLER PIC X(4) VALUE " OF ". NC1124.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1124.2 +017800 02 FILLER PIC X(40) VALUE NC1124.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1124.2 +018000 01 XXINFO. NC1124.2 +018100 02 FILLER PIC X(19) VALUE NC1124.2 +018200 "*** INFORMATION ***". NC1124.2 +018300 02 INFO-TEXT. NC1124.2 +018400 04 FILLER PIC X(8) VALUE SPACE. NC1124.2 +018500 04 XXCOMPUTED PIC X(20). NC1124.2 +018600 04 FILLER PIC X(5) VALUE SPACE. NC1124.2 +018700 04 XXCORRECT PIC X(20). NC1124.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). NC1124.2 +018900 01 HYPHEN-LINE. NC1124.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. NC1124.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************NC1124.2 +019200- "*****************************************". NC1124.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************NC1124.2 +019400- "******************************". NC1124.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE NC1124.2 +019600 "NC112A". NC1124.2 +019700 PROCEDURE DIVISION. NC1124.2 +019800 CCVS1 SECTION. NC1124.2 +019900 OPEN-FILES. NC1124.2 +020000 OPEN OUTPUT PRINT-FILE. NC1124.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1124.2 +020200 MOVE SPACE TO TEST-RESULTS. NC1124.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1124.2 +020400 GO TO CCVS1-EXIT. NC1124.2 +020500 CLOSE-FILES. NC1124.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1124.2 +020700 TERMINATE-CCVS. NC1124.2 +020800*S EXIT PROGRAM. NC1124.2 +020900*SERMINATE-CALL. NC1124.2 +021000 STOP RUN. NC1124.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1124.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1124.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1124.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1124.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. NC1124.2 +021600 PRINT-DETAIL. NC1124.2 +021700 IF REC-CT NOT EQUAL TO ZERO NC1124.2 +021800 MOVE "." TO PARDOT-X NC1124.2 +021900 MOVE REC-CT TO DOTVALUE. NC1124.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1124.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1124.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1124.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1124.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1124.2 +022500 MOVE SPACE TO CORRECT-X. NC1124.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1124.2 +022700 MOVE SPACE TO RE-MARK. NC1124.2 +022800 HEAD-ROUTINE. NC1124.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1124.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1124.2 +023300 COLUMN-NAMES-ROUTINE. NC1124.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +023700 END-ROUTINE. NC1124.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1124.2 +023900 END-RTN-EXIT. NC1124.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +024100 END-ROUTINE-1. NC1124.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1124.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1124.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. NC1124.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1124.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1124.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1124.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1124.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1124.2 +025000 END-ROUTINE-12. NC1124.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1124.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1124.2 +025300 MOVE "NO " TO ERROR-TOTAL NC1124.2 +025400 ELSE NC1124.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1124.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1124.2 +025700 PERFORM WRITE-LINE. NC1124.2 +025800 END-ROUTINE-13. NC1124.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1124.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE NC1124.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1124.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1124.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO NC1124.2 +026500 MOVE "NO " TO ERROR-TOTAL NC1124.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1124.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1124.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1124.2 +027000 WRITE-LINE. NC1124.2 +027100 ADD 1 TO RECORD-COUNT. NC1124.2 +027200 IF RECORD-COUNT GREATER 42 NC1124.2 +027300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1124.2 +027400 MOVE SPACE TO DUMMY-RECORD NC1124.2 +027500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1124.2 +027600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1124.2 +027700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1124.2 +027800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1124.2 +027900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1124.2 +028000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1124.2 +028100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1124.2 +028200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1124.2 +028300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1124.2 +028400 MOVE ZERO TO RECORD-COUNT. NC1124.2 +028500 PERFORM WRT-LN. NC1124.2 +028600 WRT-LN. NC1124.2 +028700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1124.2 +028800 MOVE SPACE TO DUMMY-RECORD. NC1124.2 +028900 BLANK-LINE-PRINT. NC1124.2 +029000 PERFORM WRT-LN. NC1124.2 +029100 FAIL-ROUTINE. NC1124.2 +029200 IF COMPUTED-X NOT EQUAL TO SPACE NC1124.2 +029300 GO TO FAIL-ROUTINE-WRITE. NC1124.2 +029400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1124.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1124.2 +029600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1124.2 +029700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +029800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1124.2 +029900 GO TO FAIL-ROUTINE-EX. NC1124.2 +030000 FAIL-ROUTINE-WRITE. NC1124.2 +030100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1124.2 +030200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1124.2 +030300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1124.2 +030400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1124.2 +030500 FAIL-ROUTINE-EX. EXIT. NC1124.2 +030600 BAIL-OUT. NC1124.2 +030700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1124.2 +030800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1124.2 +030900 BAIL-OUT-WRITE. NC1124.2 +031000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1124.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1124.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1124.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1124.2 +031400 BAIL-OUT-EX. EXIT. NC1124.2 +031500 CCVS1-EXIT. NC1124.2 +031600 EXIT. NC1124.2 +031700 SECT-NC112A-001 SECTION. NC1124.2 +031800 ADD-INIT-F1-1. NC1124.2 +031900 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +032000 MOVE 0 TO ACCUM-1. NC1124.2 +032100 MOVE 1 TO DNAME-1. NC1124.2 +032200 MOVE 1 TO DNAME-2. NC1124.2 +032300 MOVE 1 TO DNAME-3. NC1124.2 +032400 MOVE 1 TO DNAME-4. NC1124.2 +032500 MOVE 1 TO DNAME-5. NC1124.2 +032600 MOVE 1 TO DNAME-6. NC1124.2 +032700 MOVE 1 TO DNAME-7. NC1124.2 +032800 MOVE 1 TO DNAME-8. NC1124.2 +032900 MOVE 1 TO DNAME-9. NC1124.2 +033000 MOVE 1 TO DNAME-10. NC1124.2 +033100 ADD-TEST-F1-1-0. NC1124.2 +033200 ADD DNAME-1 NC1124.2 +033300 DNAME-2 NC1124.2 +033400 DNAME-3 NC1124.2 +033500 DNAME-4 NC1124.2 +033600 DNAME-5 NC1124.2 +033700 DNAME-6 NC1124.2 +033800 DNAME-7 NC1124.2 +033900 DNAME-8 NC1124.2 +034000 DNAME-9 NC1124.2 +034100 DNAME-10 TO ACCUM-1. NC1124.2 +034200 ADD-TEST-F1-1-1. NC1124.2 +034300 IF ACCUM-1 EQUAL TO 10 NC1124.2 +034400 PERFORM PASS NC1124.2 +034500 GO TO ADD-WRITE-F1-1. NC1124.2 +034600 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +034700 MOVE 10 TO CORRECT-A. NC1124.2 +034800 PERFORM FAIL. NC1124.2 +034900 GO TO ADD-WRITE-F1-1. NC1124.2 +035000 ADD-DELETE-F1-1. NC1124.2 +035100 PERFORM DE-LETE. NC1124.2 +035200 ADD-WRITE-F1-1. NC1124.2 +035300 MOVE "ADD LIMITS TESTS" TO FEATURE. NC1124.2 +035400 MOVE "ADD-TEST-F1-1" TO PAR-NAME. NC1124.2 +035500 PERFORM PRINT-DETAIL. NC1124.2 +035600 ADD-INIT-F1-2. NC1124.2 +035700 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +035800 MOVE 0 TO ACCUM-1. NC1124.2 +035900 MOVE 1 TO DNAME-1. NC1124.2 +036000 MOVE 1 TO DNAME-2. NC1124.2 +036100 MOVE 1 TO DNAME-3. NC1124.2 +036200 MOVE 1 TO DNAME-4. NC1124.2 +036300 MOVE 1 TO DNAME-5. NC1124.2 +036400 MOVE 1 TO DNAME-6. NC1124.2 +036500 MOVE 1 TO DNAME-7. NC1124.2 +036600 MOVE 1 TO DNAME-8. NC1124.2 +036700 MOVE 1 TO DNAME-9. NC1124.2 +036800 MOVE 1 TO DNAME-10. NC1124.2 +036900 ADD-TEST-F1-2-0. NC1124.2 +037000 ADD DNAME-1 NC1124.2 +037100 DNAME-2 NC1124.2 +037200 DNAME-3 NC1124.2 +037300 DNAME-4 NC1124.2 +037400 DNAME-5 NC1124.2 +037500 DNAME-6 NC1124.2 +037600 DNAME-7 NC1124.2 +037700 DNAME-8 NC1124.2 +037800 DNAME-9 NC1124.2 +037900 DNAME-10 TO ACCUM-1 ROUNDED ON SIZE ERROR NC1124.2 +038000 MOVE 0 TO ACCUM-1. NC1124.2 +038100 ADD-TEST-F1-2-1. NC1124.2 +038200 IF ACCUM-1 EQUAL TO 10 NC1124.2 +038300 PERFORM PASS NC1124.2 +038400 GO TO ADD-WRITE-F1-2. NC1124.2 +038500 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +038600 MOVE 10 TO CORRECT-A. NC1124.2 +038700 PERFORM FAIL. NC1124.2 +038800 GO TO ADD-WRITE-F1-2. NC1124.2 +038900 ADD-DELETE-F1-2. NC1124.2 +039000 PERFORM DE-LETE. NC1124.2 +039100 ADD-WRITE-F1-2. NC1124.2 +039200 MOVE "ADD-TEST-F1-2" TO PAR-NAME. NC1124.2 +039300 PERFORM PRINT-DETAIL. NC1124.2 +039400 ADD-INIT-F2-1. NC1124.2 +039500 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +039600 MOVE 0 TO ACCUM-1. NC1124.2 +039700 MOVE 1 TO DNAME-1. NC1124.2 +039800 MOVE 1 TO DNAME-2. NC1124.2 +039900 MOVE 1 TO DNAME-3. NC1124.2 +040000 MOVE 1 TO DNAME-4. NC1124.2 +040100 MOVE 1 TO DNAME-5. NC1124.2 +040200 MOVE 1 TO DNAME-6. NC1124.2 +040300 MOVE 1 TO DNAME-7. NC1124.2 +040400 MOVE 1 TO DNAME-8. NC1124.2 +040500 MOVE 1 TO DNAME-9. NC1124.2 +040600 MOVE 1 TO DNAME-10. NC1124.2 +040700 ADD-TEST-F2-1-0. NC1124.2 +040800 ADD DNAME-1 NC1124.2 +040900 DNAME-2 NC1124.2 +041000 DNAME-3 NC1124.2 +041100 DNAME-4 NC1124.2 +041200 DNAME-5 NC1124.2 +041300 DNAME-6 NC1124.2 +041400 DNAME-7 NC1124.2 +041500 DNAME-8 NC1124.2 +041600 DNAME-9 NC1124.2 +041700 DNAME-10 GIVING ACCUM-1. NC1124.2 +041800 ADD-TEST-F2-1-1. NC1124.2 +041900 IF ACCUM-1 EQUAL TO 10 NC1124.2 +042000 PERFORM PASS NC1124.2 +042100 GO TO ADD-WRITE-F2-1. NC1124.2 +042200 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +042300 MOVE 10 TO CORRECT-A. NC1124.2 +042400 PERFORM FAIL. NC1124.2 +042500 GO TO ADD-WRITE-F2-1. NC1124.2 +042600 ADD-DELETE-F2-1. NC1124.2 +042700 PERFORM DE-LETE. NC1124.2 +042800 ADD-WRITE-F2-1. NC1124.2 +042900 MOVE "ADD-TEST-F2-1" TO PAR-NAME. NC1124.2 +043000 PERFORM PRINT-DETAIL. NC1124.2 +043100 ADD-INIT-F2-2. NC1124.2 +043200 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +043300 MOVE 1 TO ACCUM-1. NC1124.2 +043400 MOVE 1 TO DNAME-1. NC1124.2 +043500 MOVE 1 TO DNAME-2. NC1124.2 +043600 MOVE 1 TO DNAME-3. NC1124.2 +043700 MOVE 1 TO DNAME-4. NC1124.2 +043800 MOVE 1 TO DNAME-5. NC1124.2 +043900 MOVE 1 TO DNAME-6. NC1124.2 +044000 MOVE 1 TO DNAME-7. NC1124.2 +044100 MOVE 1 TO DNAME-8. NC1124.2 +044200 MOVE 1 TO DNAME-9. NC1124.2 +044300 MOVE 1 TO DNAME-10. NC1124.2 +044400 ADD-TEST-F2-2-0. NC1124.2 +044500 ADD DNAME-1 NC1124.2 +044600 DNAME-2 NC1124.2 +044700 DNAME-3 NC1124.2 +044800 DNAME-4 NC1124.2 +044900 DNAME-5 NC1124.2 +045000 DNAME-6 NC1124.2 +045100 DNAME-7 NC1124.2 +045200 DNAME-8 NC1124.2 +045300 DNAME-9 NC1124.2 +045400 DNAME-10 GIVING ACCUM-1 ROUNDED ON SIZE ERROR NC1124.2 +045500 MOVE 0 TO ACCUM-1. NC1124.2 +045600 ADD-TEST-F2-2-1. NC1124.2 +045700 IF ACCUM-1 EQUAL TO 10 NC1124.2 +045800 PERFORM PASS NC1124.2 +045900 GO TO ADD-WRITE-F2-2. NC1124.2 +046000 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +046100 MOVE 10 TO CORRECT-A. NC1124.2 +046200 PERFORM FAIL. NC1124.2 +046300 GO TO ADD-WRITE-F2-2. NC1124.2 +046400 ADD-DELETE-F2-2. NC1124.2 +046500 PERFORM DE-LETE. NC1124.2 +046600 ADD-WRITE-F2-2. NC1124.2 +046700 MOVE "ADD-TEST-F2-2" TO PAR-NAME. NC1124.2 +046800 PERFORM PRINT-DETAIL. NC1124.2 +046900 ADD-INIT-F1-3. NC1124.2 +047000 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +047100 MOVE 1 TO DNAME-1. NC1124.2 +047200 MOVE 1 TO DNAME-2. NC1124.2 +047300 MOVE 1 TO DNAME-3. NC1124.2 +047400 MOVE 1 TO DNAME-4. NC1124.2 +047500 MOVE 1 TO DNAME-5. NC1124.2 +047600 MOVE 1 TO DNAME-6. NC1124.2 +047700 MOVE 1 TO DNAME-7. NC1124.2 +047800 MOVE 1 TO DNAME-8. NC1124.2 +047900 MOVE 1 TO DNAME-9. NC1124.2 +048000 MOVE 1 TO DNAME-10. NC1124.2 +048100 ADD-TEST-F1-3-0. NC1124.2 +048200 ADD DNAME-2 NC1124.2 +048300 DNAME-3 NC1124.2 +048400 DNAME-4 NC1124.2 +048500 DNAME-5 NC1124.2 +048600 DNAME-6 NC1124.2 +048700 DNAME-7 NC1124.2 +048800 DNAME-8 NC1124.2 +048900 DNAME-9 NC1124.2 +049000 DNAME-10 TO DNAME-1 NC1124.2 +049100 ON SIZE ERROR NC1124.2 +049200 PERFORM PASS NC1124.2 +049300 GO TO ADD-WRITE-F1-3. NC1124.2 +049400 MOVE "SIZE ERROR EXPECTED" TO RE-MARK. NC1124.2 +049500 MOVE DNAME-1 TO COMPUTED-A. NC1124.2 +049600 MOVE "UNCHANGED (STILL 1)" TO CORRECT-A. NC1124.2 +049700 PERFORM FAIL. NC1124.2 +049800 GO TO ADD-WRITE-F1-3. NC1124.2 +049900 ADD-DELETE-F1-3. NC1124.2 +050000 PERFORM DE-LETE. NC1124.2 +050100 ADD-WRITE-F1-3. NC1124.2 +050200 MOVE "ADD-TEST-F1-3" TO PAR-NAME. NC1124.2 +050300 PERFORM PRINT-DETAIL. NC1124.2 +050400 ADD-INIT-F2-3. NC1124.2 +050500 MOVE "V1-74 6.6.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +050600 MOVE 1 TO DNAME-1. NC1124.2 +050700 MOVE 1 TO DNAME-2. NC1124.2 +050800 MOVE 1 TO DNAME-3. NC1124.2 +050900 MOVE 1 TO DNAME-4. NC1124.2 +051000 MOVE 1 TO DNAME-5. NC1124.2 +051100 MOVE 1 TO DNAME-6. NC1124.2 +051200 MOVE 1 TO DNAME-7. NC1124.2 +051300 MOVE 1 TO DNAME-8. NC1124.2 +051400 MOVE 1 TO DNAME-9. NC1124.2 +051500 MOVE 1 TO DNAME-10. NC1124.2 +051600 ADD-TEST-F2-3-0. NC1124.2 +051700 ADD DNAME-1 NC1124.2 +051800 DNAME-2 NC1124.2 +051900 DNAME-3 NC1124.2 +052000 DNAME-4 NC1124.2 +052100 DNAME-5 NC1124.2 +052200 DNAME-6 NC1124.2 +052300 DNAME-7 NC1124.2 +052400 DNAME-8 NC1124.2 +052500 DNAME-9 NC1124.2 +052600 DNAME-10 GIVING DNAME-1 ON SIZE ERROR NC1124.2 +052700 PERFORM PASS NC1124.2 +052800 GO TO ADD-WRITE-F2-3. NC1124.2 +052900 MOVE "SIZE ERROR EXPECTED" TO RE-MARK. NC1124.2 +053000 MOVE "UNCHANGED (STILL 1)" TO CORRECT-A. NC1124.2 +053100 MOVE DNAME-1 TO COMPUTED-A. NC1124.2 +053200 PERFORM FAIL. NC1124.2 +053300 GO TO ADD-WRITE-F2-3. NC1124.2 +053400 ADD-DELETE-F2-3. NC1124.2 +053500 PERFORM DE-LETE. NC1124.2 +053600 ADD-WRITE-F2-3. NC1124.2 +053700 MOVE "ADD-TEST-F2-3" TO PAR-NAME. NC1124.2 +053800 PERFORM PRINT-DETAIL. NC1124.2 +053900 SUB-INIT-F1-1. NC1124.2 +054000 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +054100 MOVE 1 TO DNAME-1. NC1124.2 +054200 MOVE 1 TO DNAME-2. NC1124.2 +054300 MOVE 1 TO DNAME-3. NC1124.2 +054400 MOVE 1 TO DNAME-4. NC1124.2 +054500 MOVE 1 TO DNAME-5. NC1124.2 +054600 MOVE 1 TO DNAME-6. NC1124.2 +054700 MOVE 1 TO DNAME-7. NC1124.2 +054800 MOVE 1 TO DNAME-8. NC1124.2 +054900 MOVE 1 TO DNAME-9. NC1124.2 +055000 MOVE 1 TO DNAME-10. NC1124.2 +055100 MOVE 10 TO ACCUM-1. NC1124.2 +055200 SUB-TEST-F1-1-0. NC1124.2 +055300 SUBTRACT DNAME-1 NC1124.2 +055400 DNAME-2 NC1124.2 +055500 DNAME-3 NC1124.2 +055600 DNAME-4 NC1124.2 +055700 DNAME-5 NC1124.2 +055800 DNAME-6 NC1124.2 +055900 DNAME-7 NC1124.2 +056000 DNAME-8 NC1124.2 +056100 DNAME-9 NC1124.2 +056200 DNAME-10 FROM ACCUM-1. NC1124.2 +056300 SUB-TEST-F1-1-1. NC1124.2 +056400 IF ACCUM-1 EQUAL TO ZERO NC1124.2 +056500 PERFORM PASS NC1124.2 +056600 GO TO SUB-WRITE-F1-1. NC1124.2 +056700 MOVE 0 TO CORRECT-A. NC1124.2 +056800 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +056900 PERFORM FAIL. NC1124.2 +057000 GO TO SUB-WRITE-F1-1. NC1124.2 +057100 SUB-DELETE-F1-1. NC1124.2 +057200 PERFORM DE-LETE. NC1124.2 +057300 SUB-WRITE-F1-1. NC1124.2 +057400 MOVE "SUBTRACT LIMITS" TO FEATURE. NC1124.2 +057500 PERFORM END-ROUTINE. NC1124.2 +057600 MOVE "SUB-TEST-F1-1" TO PAR-NAME. NC1124.2 +057700 PERFORM PRINT-DETAIL. NC1124.2 +057800 SUB-INIT-F2-1. NC1124.2 +057900 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +058000 MOVE 1 TO DNAME-1. NC1124.2 +058100 MOVE 1 TO DNAME-2. NC1124.2 +058200 MOVE 1 TO DNAME-3. NC1124.2 +058300 MOVE 1 TO DNAME-4. NC1124.2 +058400 MOVE 1 TO DNAME-5. NC1124.2 +058500 MOVE 1 TO DNAME-6. NC1124.2 +058600 MOVE 1 TO DNAME-7. NC1124.2 +058700 MOVE 1 TO DNAME-8. NC1124.2 +058800 MOVE 1 TO DNAME-9. NC1124.2 +058900 MOVE 1 TO DNAME-10. NC1124.2 +059000 MOVE 10 TO ACCUM-1. NC1124.2 +059100 SUB-TEST-F2-1-0. NC1124.2 +059200 SUBTRACT DNAME-1 NC1124.2 +059300 DNAME-2 NC1124.2 +059400 DNAME-3 NC1124.2 +059500 DNAME-4 NC1124.2 +059600 DNAME-5 NC1124.2 +059700 DNAME-6 NC1124.2 +059800 DNAME-7 NC1124.2 +059900 DNAME-8 NC1124.2 +060000 DNAME-9 NC1124.2 +060100 DNAME-10 FROM ACCUM-1 GIVING ACCUM-1. NC1124.2 +060200 SUB-TEST-F2-1-1. NC1124.2 +060300 IF ACCUM-1 EQUAL TO 0 NC1124.2 +060400 PERFORM PASS NC1124.2 +060500 GO TO SUB-WRITE-F2-1. NC1124.2 +060600 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +060700 MOVE 0 TO CORRECT-A. NC1124.2 +060800 PERFORM FAIL. NC1124.2 +060900 GO TO SUB-WRITE-F2-1. NC1124.2 +061000 SUB-DELETE-F2-1. NC1124.2 +061100 PERFORM DE-LETE. NC1124.2 +061200 SUB-WRITE-F2-1. NC1124.2 +061300 MOVE "SUB-TEST-F2-1" TO PAR-NAME. NC1124.2 +061400 PERFORM PRINT-DETAIL. NC1124.2 +061500 SUB-INIT-F2-2. NC1124.2 +061600 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +061700 MOVE 1 TO DNAME-1. NC1124.2 +061800 MOVE 1 TO DNAME-2. NC1124.2 +061900 MOVE 1 TO DNAME-3. NC1124.2 +062000 MOVE 1 TO DNAME-4. NC1124.2 +062100 MOVE 1 TO DNAME-5. NC1124.2 +062200 MOVE 1 TO DNAME-6. NC1124.2 +062300 MOVE 1 TO DNAME-7. NC1124.2 +062400 MOVE 1 TO DNAME-8. NC1124.2 +062500 MOVE 1 TO DNAME-9. NC1124.2 +062600 MOVE 1 TO DNAME-10. NC1124.2 +062700 SUB-TEST-F2-2-0. NC1124.2 +062800 SUBTRACT DNAME-2 NC1124.2 +062900 DNAME-3 NC1124.2 +063000 DNAME-4 NC1124.2 +063100 DNAME-5 NC1124.2 +063200 DNAME-6 NC1124.2 +063300 DNAME-7 NC1124.2 +063400 DNAME-8 NC1124.2 +063500 DNAME-9 NC1124.2 +063600 DNAME-10 FROM 100 GIVING DNAME-1 ON SIZE ERROR NC1124.2 +063700 PERFORM PASS NC1124.2 +063800 GO TO SUB-WRITE-F2-2. NC1124.2 +063900 MOVE "UNCHANGED (STILL 1)" TO CORRECT-A. NC1124.2 +064000 MOVE DNAME-1 TO COMPUTED-A. NC1124.2 +064100 PERFORM FAIL. NC1124.2 +064200 MOVE "SIZE ERROR EXPECTED" TO RE-MARK. NC1124.2 +064300 GO TO SUB-WRITE-F2-2. NC1124.2 +064400 SUB-DELETE-F2-2. NC1124.2 +064500 PERFORM DE-LETE. NC1124.2 +064600 SUB-WRITE-F2-2. NC1124.2 +064700 MOVE "SUB-TEST-F2-2" TO PAR-NAME. NC1124.2 +064800 PERFORM PRINT-DETAIL. NC1124.2 +064900 SUB-INIT-F2-3. NC1124.2 +065000 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +065100 MOVE 1 TO DNAME-1. NC1124.2 +065200 MOVE 100 TO ACCUM-1. NC1124.2 +065300 SUB-TEST-F2-3. NC1124.2 +065400 SUBTRACT DNAME-1 NC1124.2 +065500 1 NC1124.2 +065600 DNAME-1 NC1124.2 +065700 DNAME-1 NC1124.2 +065800 DNAME-1 NC1124.2 +065900 1 NC1124.2 +066000 -1 NC1124.2 +066100 1 NC1124.2 +066200 1 FROM 7 GIVING ACCUM-1. NC1124.2 +066300 IF ACCUM-1 EQUAL TO 0 NC1124.2 +066400 PERFORM PASS NC1124.2 +066500 GO TO SUB-WRITE-F2-3. NC1124.2 +066600 MOVE 0 TO CORRECT-A. NC1124.2 +066700 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +066800 PERFORM FAIL. NC1124.2 +066900 GO TO SUB-WRITE-F2-3. NC1124.2 +067000 SUB-DELETE-F2-3. NC1124.2 +067100 PERFORM DE-LETE. NC1124.2 +067200 SUB-WRITE-F2-3. NC1124.2 +067300 MOVE "SUB-TEST-F2-3" TO PAR-NAME. NC1124.2 +067400 PERFORM PRINT-DETAIL. NC1124.2 +067500 SUB-INIT-F1-2. NC1124.2 +067600 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +067700 MOVE 1 TO DNAME-1. NC1124.2 +067800 MOVE 10 TO ACCUM-1. NC1124.2 +067900 MOVE 1 TO ACCUM-3. NC1124.2 +068000 SUB-TEST-F1-2-0. NC1124.2 +068100 SUBTRACT DNAME-1 NC1124.2 +068200 .5 NC1124.2 +068300 .5 NC1124.2 +068400 .5 NC1124.2 +068500 .5 NC1124.2 +068600 .5 NC1124.2 +068700 .5 NC1124.2 +068800 .5 NC1124.2 +068900 .5 NC1124.2 +069000 .5 FROM ACCUM-1 ROUNDED. NC1124.2 +069100 SUB-TEST-F1-2-1. NC1124.2 +069200 IF ACCUM-1 EQUAL TO 5 NC1124.2 +069300 PERFORM PASS NC1124.2 +069400 GO TO SUB-WRITE-F1-2. NC1124.2 +069500 MOVE ACCUM-1 TO COMPUTED-A. NC1124.2 +069600 MOVE 5 TO CORRECT-A. NC1124.2 +069700 PERFORM FAIL. NC1124.2 +069800 GO TO SUB-WRITE-F1-2. NC1124.2 +069900 SUB-DELETE-F1-2. NC1124.2 +070000 PERFORM DE-LETE. NC1124.2 +070100 SUB-WRITE-F1-2. NC1124.2 +070200 MOVE "SUB-TEST-F1-2" TO PAR-NAME. NC1124.2 +070300 PERFORM PRINT-DETAIL. NC1124.2 +070400 SUB-INIT-F2-4. NC1124.2 +070500 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +070600 MOVE 1 TO DNAME-1. NC1124.2 +070700 MOVE 10 TO ACCUM-1. NC1124.2 +070800 MOVE 1 TO ACCUM-2. NC1124.2 +070900 SUB-TEST-F2-4-0. NC1124.2 +071000 SUBTRACT DNAME-1 NC1124.2 +071100 .5 NC1124.2 +071200 .5 NC1124.2 +071300 .5 NC1124.2 +071400 .5 NC1124.2 +071500 .5 NC1124.2 +071600 .5 NC1124.2 +071700 .5 NC1124.2 +071800 .5 NC1124.2 +071900 .5 FROM ACCUM-1 GIVING ACCUM-2 ROUNDED. NC1124.2 +072000 SUB-TEST-F2-4-1. NC1124.2 +072100 IF ACCUM-2 EQUAL TO 5 NC1124.2 +072200 PERFORM PASS NC1124.2 +072300 GO TO SUB-WRITE-F2-4. NC1124.2 +072400 MOVE ACCUM-2 TO COMPUTED-A. NC1124.2 +072500 MOVE 5 TO CORRECT-A. NC1124.2 +072600 PERFORM FAIL. NC1124.2 +072700 GO TO SUB-WRITE-F2-4. NC1124.2 +072800 SUB-DELETE-F2-4. NC1124.2 +072900 PERFORM DE-LETE. NC1124.2 +073000 SUB-WRITE-F2-4. NC1124.2 +073100 MOVE "SUB-TEST-F2-4" TO PAR-NAME. NC1124.2 +073200 PERFORM PRINT-DETAIL. NC1124.2 +073300 MOVE-INIT-F1-1-1. NC1124.2 +073400 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +073500 MOVE ZERO TO D-NAMES. NC1124.2 +073600 MOVE 1 TO ACCUM-3. NC1124.2 +073700 MOVE-TEST-F1-1-1. NC1124.2 +073800 MOVE ACCUM-3 TO NC1124.2 +073900 DNAME-1 NC1124.2 +074000 DNAME-2 NC1124.2 +074100 DNAME-3 NC1124.2 +074200 DNAME-4 NC1124.2 +074300 DNAME-5 NC1124.2 +074400 DNAME-6 NC1124.2 +074500 DNAME-7 NC1124.2 +074600 DNAME-8 NC1124.2 +074700 DNAME-9 NC1124.2 +074800 DNAME-10. NC1124.2 +074900 MOVE-TEST-F1-1-1-1. NC1124.2 +075000 IF DNAME-1 EQUAL TO 1 NC1124.2 +075100 PERFORM PASS NC1124.2 +075200 GO TO MOVE-WRITE-F1-1-1. NC1124.2 +075300 MOVE 1 TO CORRECT-N. NC1124.2 +075400 MOVE DNAME-1 TO COMPUTED-N. NC1124.2 +075500 PERFORM FAIL. NC1124.2 +075600 GO TO MOVE-WRITE-F1-1-1. NC1124.2 +075700 MOVE-DELETE-F1-1-1. NC1124.2 +075800 PERFORM DE-LETE. NC1124.2 +075900 MOVE-WRITE-F1-1-1. NC1124.2 +076000 MOVE "MOVE LIMITS TESTS" TO FEATURE. NC1124.2 +076100 PERFORM END-ROUTINE. NC1124.2 +076200 MOVE "MOVE-TEST-F1-1-1" TO PAR-NAME. NC1124.2 +076300 PERFORM PRINT-DETAIL. NC1124.2 +076400 MOVE-TEST-F1-1-2. NC1124.2 +076500 IF DNAME-2 EQUAL TO 1 NC1124.2 +076600 PERFORM PASS NC1124.2 +076700 GO TO MOVE-WRITE-F1-1-2. NC1124.2 +076800 MOVE 1 TO CORRECT-N. NC1124.2 +076900 MOVE DNAME-2 TO COMPUTED-N. NC1124.2 +077000 PERFORM FAIL. NC1124.2 +077100 GO TO MOVE-WRITE-F1-1-2. NC1124.2 +077200 MOVE-DELETE-F1-1-2. NC1124.2 +077300 PERFORM DE-LETE. NC1124.2 +077400 MOVE-WRITE-F1-1-2. NC1124.2 +077500 MOVE "MOVE-TEST-F1-1-2" TO PAR-NAME. NC1124.2 +077600 PERFORM PRINT-DETAIL. NC1124.2 +077700 MOVE-TEST-F1-1-3. NC1124.2 +077800 IF DNAME-3 EQUAL TO 1 NC1124.2 +077900 PERFORM PASS NC1124.2 +078000 GO TO MOVE-WRITE-F1-1-3. NC1124.2 +078100 MOVE 1 TO CORRECT-N. NC1124.2 +078200 MOVE DNAME-3 TO COMPUTED-N. NC1124.2 +078300 PERFORM FAIL. NC1124.2 +078400 GO TO MOVE-WRITE-F1-1-3. NC1124.2 +078500 MOVE-DELETE-F1-1-3. NC1124.2 +078600 PERFORM DE-LETE. NC1124.2 +078700 MOVE-WRITE-F1-1-3. NC1124.2 +078800 MOVE "MOVE-TEST-F1-1-3" TO PAR-NAME. NC1124.2 +078900 PERFORM PRINT-DETAIL. NC1124.2 +079000 MOVE-TEST-F1-1-4. NC1124.2 +079100 IF DNAME-4 EQUAL TO 1 NC1124.2 +079200 PERFORM PASS NC1124.2 +079300 GO TO MOVE-WRITE-F1-1-4. NC1124.2 +079400 MOVE 1 TO CORRECT-N. NC1124.2 +079500 MOVE DNAME-4 TO COMPUTED-N. NC1124.2 +079600 PERFORM FAIL. NC1124.2 +079700 GO TO MOVE-WRITE-F1-1-4. NC1124.2 +079800 MOVE-DELETE-F1-1-4. NC1124.2 +079900 PERFORM DE-LETE. NC1124.2 +080000 MOVE-WRITE-F1-1-4. NC1124.2 +080100 MOVE "MOVE-TEST-F1-1-4" TO PAR-NAME. NC1124.2 +080200 PERFORM PRINT-DETAIL. NC1124.2 +080300 MOVE-TEST-F1-1-5. NC1124.2 +080400 IF DNAME-5 EQUAL TO 1 NC1124.2 +080500 PERFORM PASS NC1124.2 +080600 GO TO MOVE-WRITE-F1-1-5. NC1124.2 +080700 MOVE 1 TO CORRECT-N. NC1124.2 +080800 MOVE DNAME-5 TO COMPUTED-N. NC1124.2 +080900 PERFORM FAIL. NC1124.2 +081000 GO TO MOVE-WRITE-F1-1-5. NC1124.2 +081100 MOVE-DELETE-F1-1-5. NC1124.2 +081200 PERFORM DE-LETE. NC1124.2 +081300 MOVE-WRITE-F1-1-5. NC1124.2 +081400 MOVE "MOVE-TEST-F1-1-5 " TO PAR-NAME. NC1124.2 +081500 PERFORM PRINT-DETAIL. NC1124.2 +081600 MOVE-TEST-F1-1-6. NC1124.2 +081700 IF DNAME-6 EQUAL TO 1 NC1124.2 +081800 PERFORM PASS NC1124.2 +081900 GO TO MOVE-WRITE-F1-1-6. NC1124.2 +082000 MOVE 1 TO CORRECT-N. NC1124.2 +082100 MOVE DNAME-6 TO COMPUTED-N. NC1124.2 +082200 PERFORM FAIL. NC1124.2 +082300 GO TO MOVE-WRITE-F1-1-6. NC1124.2 +082400 MOVE-DELETE-F1-1-6. NC1124.2 +082500 PERFORM DE-LETE. NC1124.2 +082600 MOVE-WRITE-F1-1-6. NC1124.2 +082700 MOVE "MOVE-TEST-F1-1-6 " TO PAR-NAME. NC1124.2 +082800 PERFORM PRINT-DETAIL. NC1124.2 +082900 MOVE-TEST-F1-1-7. NC1124.2 +083000 IF DNAME-7 EQUAL TO 1 NC1124.2 +083100 PERFORM PASS NC1124.2 +083200 GO TO MOVE-WRITE-F1-1-7. NC1124.2 +083300 MOVE 1 TO CORRECT-N. NC1124.2 +083400 MOVE DNAME-7 TO COMPUTED-N. NC1124.2 +083500 PERFORM FAIL. NC1124.2 +083600 GO TO MOVE-WRITE-F1-1-7. NC1124.2 +083700 MOVE-DELETE-F1-1-7. NC1124.2 +083800 PERFORM DE-LETE. NC1124.2 +083900 MOVE-WRITE-F1-1-7. NC1124.2 +084000 MOVE "MOVE-TEST-F1-1-7 " TO PAR-NAME. NC1124.2 +084100 PERFORM PRINT-DETAIL. NC1124.2 +084200 MOVE-TEST-F1-1-8. NC1124.2 +084300 IF DNAME-8 EQUAL TO 1 NC1124.2 +084400 PERFORM PASS NC1124.2 +084500 GO TO MOVE-WRITE-F1-1-8. NC1124.2 +084600 MOVE 1 TO CORRECT-N. NC1124.2 +084700 MOVE DNAME-8 TO COMPUTED-N. NC1124.2 +084800 PERFORM FAIL. NC1124.2 +084900 GO TO MOVE-WRITE-F1-1-8. NC1124.2 +085000 MOVE-DELETE-F1-1-8. NC1124.2 +085100 PERFORM DE-LETE. NC1124.2 +085200 MOVE-WRITE-F1-1-8. NC1124.2 +085300 MOVE "MOVE-TEST-F1-1-8 " TO PAR-NAME. NC1124.2 +085400 PERFORM PRINT-DETAIL. NC1124.2 +085500 MOVE-TEST-F1-1-9. NC1124.2 +085600 IF DNAME-9 EQUAL TO 1 NC1124.2 +085700 PERFORM PASS NC1124.2 +085800 GO TO MOVE-WRITE-F1-1-9. NC1124.2 +085900 MOVE 1 TO CORRECT-N. NC1124.2 +086000 MOVE DNAME-9 TO COMPUTED-N. NC1124.2 +086100 PERFORM FAIL. NC1124.2 +086200 GO TO MOVE-WRITE-F1-1-9. NC1124.2 +086300 MOVE-DELETE-F1-1-9. NC1124.2 +086400 PERFORM DE-LETE. NC1124.2 +086500 MOVE-WRITE-F1-1-9. NC1124.2 +086600 MOVE "MOVE-TEST-F1-1-9 " TO PAR-NAME. NC1124.2 +086700 PERFORM PRINT-DETAIL. NC1124.2 +086800 MOVE-TEST-F1-1-10. NC1124.2 +086900 IF DNAME-10 EQUAL TO 1 NC1124.2 +087000 PERFORM PASS NC1124.2 +087100 GO TO MOVE-WRITE-F1-1-10. NC1124.2 +087200 MOVE 1 TO CORRECT-N. NC1124.2 +087300 MOVE DNAME-10 TO COMPUTED-N. NC1124.2 +087400 PERFORM FAIL. NC1124.2 +087500 GO TO MOVE-WRITE-F1-1-10. NC1124.2 +087600 MOVE-DELETE-F1-1-10. NC1124.2 +087700 PERFORM DE-LETE. NC1124.2 +087800 MOVE-WRITE-F1-1-10. NC1124.2 +087900 MOVE "MOVE-TEST-F1-1-10" TO PAR-NAME. NC1124.2 +088000 PERFORM PRINT-DETAIL. NC1124.2 +088100 MOVE-INIT-F1-2-1. NC1124.2 +088200 MOVE "V1-134 6.25.4 GR1,2" TO ANSI-REFERENCE. NC1124.2 +088300 MOVE HIGH-VALUE TO D-NAMES. NC1124.2 +088400 MOVE-TEST-F1-2-0. NC1124.2 +088500 MOVE ZERO TO DNAME-1 NC1124.2 +088600 DNAME-2 NC1124.2 +088700 DNAME-3 NC1124.2 +088800 DNAME-4 NC1124.2 +088900 DNAME-5 NC1124.2 +089000 DNAME-6 NC1124.2 +089100 DNAME-7 NC1124.2 +089200 DNAME-8 NC1124.2 +089300 DNAME-9 NC1124.2 +089400 DNAME-10. NC1124.2 +089500 MOVE-TEST-F1-2-1. NC1124.2 +089600 IF DNAME-1 EQUAL TO 0 NC1124.2 +089700 PERFORM PASS NC1124.2 +089800 GO TO MOVE-WRITE-F1-2-1. NC1124.2 +089900 MOVE 0 TO CORRECT-N. NC1124.2 +090000 MOVE DNAME-1 TO COMPUTED-N. NC1124.2 +090100 PERFORM FAIL. NC1124.2 +090200 GO TO MOVE-WRITE-F1-2-1. NC1124.2 +090300 MOVE-DELETE-F1-2-1. NC1124.2 +090400 PERFORM DE-LETE. NC1124.2 +090500 MOVE-WRITE-F1-2-1. NC1124.2 +090600 MOVE "MOVE-TEST-F1-2-1" TO PAR-NAME. NC1124.2 +090700 PERFORM PRINT-DETAIL. NC1124.2 +090800 MOVE-TEST-F1-2-2. NC1124.2 +090900 IF DNAME-2 EQUAL TO 0 NC1124.2 +091000 PERFORM PASS NC1124.2 +091100 GO TO MOVE-WRITE-F1-2-2. NC1124.2 +091200 MOVE 0 TO CORRECT-N. NC1124.2 +091300 MOVE DNAME-2 TO COMPUTED-N. NC1124.2 +091400 PERFORM FAIL. NC1124.2 +091500 GO TO MOVE-WRITE-F1-2-2. NC1124.2 +091600 MOVE-DELETE-F1-2-2. NC1124.2 +091700 PERFORM DE-LETE. NC1124.2 +091800 MOVE-WRITE-F1-2-2. NC1124.2 +091900 MOVE "MOVE-TEST-F1-2-2" TO PAR-NAME. NC1124.2 +092000 PERFORM PRINT-DETAIL. NC1124.2 +092100 MOVE-TEST-F1-2-3. NC1124.2 +092200 IF DNAME-3 EQUAL TO 0 NC1124.2 +092300 PERFORM PASS NC1124.2 +092400 GO TO MOVE-WRITE-F1-2-3. NC1124.2 +092500 MOVE 0 TO CORRECT-N. NC1124.2 +092600 MOVE DNAME-3 TO COMPUTED-N. NC1124.2 +092700 PERFORM FAIL. NC1124.2 +092800 GO TO MOVE-WRITE-F1-2-3. NC1124.2 +092900 MOVE-DELETE-F1-2-3. NC1124.2 +093000 PERFORM DE-LETE. NC1124.2 +093100 MOVE-WRITE-F1-2-3. NC1124.2 +093200 MOVE "MOVE-TEST-F1-2-3" TO PAR-NAME. NC1124.2 +093300 PERFORM PRINT-DETAIL. NC1124.2 +093400 MOVE-TEST-F1-2-4. NC1124.2 +093500 IF DNAME-4 EQUAL TO 0 NC1124.2 +093600 PERFORM PASS NC1124.2 +093700 GO TO MOVE-WRITE-F1-2-4. NC1124.2 +093800 MOVE 0 TO CORRECT-N. NC1124.2 +093900 MOVE DNAME-4 TO COMPUTED-N. NC1124.2 +094000 PERFORM FAIL. NC1124.2 +094100 GO TO MOVE-WRITE-F1-2-4. NC1124.2 +094200 MOVE-DELETE-F1-2-4. NC1124.2 +094300 PERFORM DE-LETE. NC1124.2 +094400 MOVE-WRITE-F1-2-4. NC1124.2 +094500 MOVE "MOVE-TEST-F1-2-4" TO PAR-NAME. NC1124.2 +094600 PERFORM PRINT-DETAIL. NC1124.2 +094700 MOVE-TEST-F1-2-5. NC1124.2 +094800 IF DNAME-5 EQUAL TO 0 NC1124.2 +094900 PERFORM PASS NC1124.2 +095000 GO TO MOVE-WRITE-F1-2-5. NC1124.2 +095100 MOVE 0 TO CORRECT-N. NC1124.2 +095200 MOVE DNAME-5 TO COMPUTED-N. NC1124.2 +095300 PERFORM FAIL. NC1124.2 +095400 GO TO MOVE-WRITE-F1-2-5. NC1124.2 +095500 MOVE-DELETE-F1-2-5. NC1124.2 +095600 PERFORM DE-LETE. NC1124.2 +095700 MOVE-WRITE-F1-2-5. NC1124.2 +095800 MOVE "MOVE-TEST-F1-2-5" TO PAR-NAME. NC1124.2 +095900 PERFORM PRINT-DETAIL. NC1124.2 +096000 MOVE-TEST-F1-2-6. NC1124.2 +096100 IF DNAME-6 EQUAL TO 0 NC1124.2 +096200 PERFORM PASS NC1124.2 +096300 GO TO MOVE-WRITE-F1-2-6. NC1124.2 +096400 MOVE 0 TO CORRECT-N. NC1124.2 +096500 MOVE DNAME-6 TO COMPUTED-N. NC1124.2 +096600 PERFORM FAIL. NC1124.2 +096700 GO TO MOVE-WRITE-F1-2-6. NC1124.2 +096800 MOVE-DELETE-F1-2-6. NC1124.2 +096900 PERFORM DE-LETE. NC1124.2 +097000 MOVE-WRITE-F1-2-6. NC1124.2 +097100 MOVE "MOVE-TEST-F1-2-6" TO PAR-NAME. NC1124.2 +097200 PERFORM PRINT-DETAIL. NC1124.2 +097300 MOVE-TEST-F1-2-7. NC1124.2 +097400 IF DNAME-7 EQUAL TO 0 NC1124.2 +097500 PERFORM PASS NC1124.2 +097600 GO TO MOVE-WRITE-F1-2-7. NC1124.2 +097700 MOVE 0 TO CORRECT-N. NC1124.2 +097800 MOVE DNAME-7 TO COMPUTED-N. NC1124.2 +097900 PERFORM FAIL. NC1124.2 +098000 GO TO MOVE-WRITE-F1-2-7. NC1124.2 +098100 MOVE-DELETE-F1-2-7. NC1124.2 +098200 PERFORM DE-LETE. NC1124.2 +098300 MOVE-WRITE-F1-2-7. NC1124.2 +098400 MOVE "MOVE-TEST-F1-2-7" TO PAR-NAME. NC1124.2 +098500 PERFORM PRINT-DETAIL. NC1124.2 +098600 MOVE-TEST-F1-2-8. NC1124.2 +098700 IF DNAME-8 EQUAL TO 0 NC1124.2 +098800 PERFORM PASS NC1124.2 +098900 GO TO MOVE-WRITE-F1-2-8. NC1124.2 +099000 MOVE 0 TO CORRECT-N. NC1124.2 +099100 MOVE DNAME-8 TO COMPUTED-N. NC1124.2 +099200 PERFORM FAIL. NC1124.2 +099300 GO TO MOVE-WRITE-F1-2-8. NC1124.2 +099400 MOVE-DELETE-F1-2-8. NC1124.2 +099500 PERFORM DE-LETE. NC1124.2 +099600 MOVE-WRITE-F1-2-8. NC1124.2 +099700 MOVE "MOVE-TEST-F1-2-8" TO PAR-NAME. NC1124.2 +099800 PERFORM PRINT-DETAIL. NC1124.2 +099900 MOVE-TEST-F1-2-9. NC1124.2 +100000 IF DNAME-9 EQUAL TO 0 NC1124.2 +100100 PERFORM PASS NC1124.2 +100200 GO TO MOVE-WRITE-F1-2-9. NC1124.2 +100300 MOVE 0 TO CORRECT-N. NC1124.2 +100400 MOVE DNAME-9 TO COMPUTED-N. NC1124.2 +100500 PERFORM FAIL. NC1124.2 +100600 GO TO MOVE-WRITE-F1-2-9. NC1124.2 +100700 MOVE-DELETE-F1-2-9. NC1124.2 +100800 PERFORM DE-LETE. NC1124.2 +100900 MOVE-WRITE-F1-2-9. NC1124.2 +101000 MOVE "MOVE-TEST-F1-2-9" TO PAR-NAME. NC1124.2 +101100 PERFORM PRINT-DETAIL. NC1124.2 +101200 MOVE-TEST-F1-2-10. NC1124.2 +101300 IF DNAME-10 EQUAL TO 0 NC1124.2 +101400 PERFORM PASS NC1124.2 +101500 GO TO MOVE-WRITE-F1-2-10. NC1124.2 +101600 MOVE 0 TO CORRECT-N. NC1124.2 +101700 MOVE DNAME-10 TO COMPUTED-N. NC1124.2 +101800 PERFORM FAIL. NC1124.2 +101900 GO TO MOVE-WRITE-F1-2-10. NC1124.2 +102000 MOVE-DELETE-F1-2-10. NC1124.2 +102100 PERFORM DE-LETE. NC1124.2 +102200 MOVE-WRITE-F1-2-10. NC1124.2 +102300 MOVE "MOVE-TEST-F1-2-10" TO PAR-NAME. NC1124.2 +102400 PERFORM PRINT-DETAIL. NC1124.2 +102500 CCVS-EXIT SECTION. NC1124.2 +102600 CCVS-999999. NC1124.2 +102700 GO TO CLOSE-FILES. NC1124.2 diff --git a/tests/cobol85/NC/NC113M.CBL b/tests/cobol85/NC/NC113M.CBL new file mode 100755 index 00000000..36a4e7fd --- /dev/null +++ b/tests/cobol85/NC/NC113M.CBL @@ -0,0 +1,262 @@ +000100 IDENTIFICATION DIVISION. NC1134.2 +000200 PROGRAM-ID. NC1134.2 +000300 NC113M. NC1134.2 +000400**************************************************************** NC1134.2 +000500* * NC1134.2 +000600* VALIDATION FOR:- * NC1134.2 +000700* * NC1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1134.2 +000900* * NC1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1134.2 +001100* * NC1134.2 +001200**************************************************************** NC1134.2 +001300* * NC1134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1134.2 +001500* * NC1134.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1134.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1134.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1134.2 +001900* * NC1134.2 +002000**************************************************************** NC1134.2 +002100* NC1134.2 +002200* PROGRAM NC113M VERIFIES CORRECT USE OF AREA A WITHIN NC1134.2 +002300* A PROGRAM. NC1134.2 +002400* NC1134.2 +002500* NC1134.2 +002600 ENVIRONMENT DIVISION. NC1134.2 +002700 CONFIGURATION SECTION. NC1134.2 +002800 SOURCE-COMPUTER. NC1134.2 +002900 Linux. NC1134.2 +003000 OBJECT-COMPUTER. NC1134.2 +003100 Linux. NC1134.2 +003200 INPUT-OUTPUT SECTION. NC1134.2 +003300 FILE-CONTROL. NC1134.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1134.2 +003500 "report.log". NC1134.2 +003600 DATA NC1134.2 +003700 DIVISION. NC1134.2 +003800 FILE SECTION. NC1134.2 +003900 FD PRINT-FILE. NC1134.2 +004000 01 PRINT-REC PICTURE X(120). NC1134.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1134.2 +004200 WORKING-STORAGE SECTION. NC1134.2 +004300 77 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. NC1134.2 +004400 77 DELETE-CNT PICTURE 999 VALUE ZERO. NC1134.2 +004500 01 TEST-RESULTS. NC1134.2 +004600 02 FILLER PICTURE X VALUE SPACE. NC1134.2 +004700 02 FEATURE PICTURE X(20). NC1134.2 +004800 02 FILLER PICTURE X VALUE SPACE. NC1134.2 +004900 02 P-OR-F PICTURE XXXXX. NC1134.2 +005000 02 FILLER PICTURE X VALUE SPACE. NC1134.2 +005100 02 PAR-NAME PICTURE X(19). NC1134.2 +005200 02 FILLER PICTURE X VALUE SPACE. NC1134.2 +005300 02 COMPUTED-A PICTURE X(20). NC1134.2 +005400 02 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). NC1134.2 +005500 02 FILLER PICTURE XX VALUE SPACE. NC1134.2 +005600 02 CORRECT-A PICTURE X(20). NC1134.2 +005700 02 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). NC1134.2 +005800 02 FILLER PICTURE XX VALUE SPACE. NC1134.2 +005900 02 RE-MARK PICTURE X(27). NC1134.2 +006000 01 HEADER-LINE-1. NC1134.2 +006100 02 PAGE-CONTROL-4 PICTURE IS X VALUE IS "1". NC1134.2 +006200 02 FILLER PICTURE X(42) VALUE NC1134.2 +006300 SPACE. NC1134.2 +006400 02 FILLER PICTURE X(42) VALUE NC1134.2 +006500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM ". NC1134.2 +006600 02 FILLER PICTURE X(35) VALUE NC1134.2 +006700 SPACE. NC1134.2 +006800 01 HEADER-LINE-2. NC1134.2 +006900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. NC1134.2 +007000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". NC1134.2 +007100 02 TEST-ID PICTURE IS X(9). NC1134.2 +007200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. NC1134.2 +007300 01 HEADER-LINE-3. NC1134.2 +007400 02 FILLER PICTURE X(34) VALUE NC1134.2 +007500 " FOR OFFICIAL USE ONLY ". NC1134.2 +007600 02 FILLER PICTURE X(58) VALUE NC1134.2 +007700 " ". NC1134.2 +007800 02 FILLER PICTURE X(28) VALUE NC1134.2 +007900 " COPYRIGHT 1985 ". NC1134.2 +008000 01 COLUMNS-LINE-1. NC1134.2 +008100 02 PAGE-CONTROL-C PICTURE IS X VALUE IS SPACE. NC1134.2 +008200 02 FILLER PICTURE IS X(99) VALUE IS "FEATURE PASNC1134.2 +008300- "S PARAGRAPH NAME NC1134.2 +008400- " REMARKS". NC1134.2 +008500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. NC1134.2 +008600 01 COLUMNS-LINE-2. NC1134.2 +008700 02 FILLER PICTURE IS X VALUE IS SPACE. NC1134.2 +008800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". NC1134.2 +008900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. NC1134.2 +009000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". NC1134.2 +009100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. NC1134.2 +009200 01 ENDER-LINE-1. NC1134.2 +009300 02 FILLER PICTURE IS X(52) VALUE IS SPACE. NC1134.2 +009400 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". NC1134.2 +009500 02 ID-AGAIN PICTURE IS X(9). NC1134.2 +009600 02 FILLER PICTURE IS X(45) VALUE IS SPACE. NC1134.2 +009700 01 ENDER-LINE-2. NC1134.2 +009800 02 FILLER PICTURE X(31) VALUE NC1134.2 +009900 SPACE. NC1134.2 +010000 02 FILLER PICTURE X(21) VALUE IS SPACE. NC1134.2 +010100 02 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. NC1134.2 +010200 02 FILLER PICTURE IS X VALUE IS SPACE. NC1134.2 +010300 02 ENDER-DESC PICTURE X(31) VALUE IS "ERRORS ENNC1134.2 +010400- "COUNTERED". NC1134.2 +010500 02 FILLER PICTURE IS X(33) VALUE IS SPACE. NC1134.2 +010600 01 ENDER-LINE-3. NC1134.2 +010700 02 FILLER PICTURE X(22) VALUE NC1134.2 +010800 " FOR OFFICIAL USE ONLY". NC1134.2 +010900 02 FILLER PICTURE X(12) VALUE SPACE. NC1134.2 +011000 02 FILLER PICTURE X(58) VALUE SPACE. NC1134.2 +011100 02 FILLER PICTURE X(13) VALUE SPACE. NC1134.2 +011200 02 FILLER PICTURE X(15) VALUE " COPYRIGHT 1985". NC1134.2 +011300 01 HYPHEN-LINE. NC1134.2 +011400 02 FILLER PICTURE IS X VALUE IS SPACE. NC1134.2 +011500 02 FILLER PICTURE IS X(65) VALUE IS "------------------------NC1134.2 +011600- "-----------------------------------------". NC1134.2 +011700 02 FILLER PICTURE IS X(54) VALUE IS "------------------------NC1134.2 +011800- "------------------------------". NC1134.2 +011900 PROCEDURE NC1134.2 +012000 DIVISION NC1134.2 +012100 . NC1134.2 +012200 OPEN-FILES. NC1134.2 +012300 OPEN OUTPUT PRINT-FILE. NC1134.2 +012400 MOVE " NC113M" TO TEST-ID. NC1134.2 +012500 MOVE TEST-ID TO ID-AGAIN. NC1134.2 +012600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1134.2 +012700 MOVE SPACE TO TEST-RESULTS. NC1134.2 +012800 MOVE "MARGIN TESTING" TO FEATURE. NC1134.2 +012900 PERFORM MAR-TEST-1. NC1134.2 +013000 MAR-TEST-2. NC1134.2 +013100 MOVE "VISUALLY CHECKED" TO RE-MARK. NC1134.2 +013200 MOVE "MAR-TEST-2" TO PAR-NAME. NC1134.2 +013300 PERFORM PRINT-DETAIL. NC1134.2 +013400 GO TO MAR-TEST-3. NC1134.2 +013500 MAR-TEST-15. NC1134.2 +013600 MOVE "MAR-TEST-15" TO PAR-NAME. NC1134.2 +013700 PERFORM PRINT-DETAIL. NC1134.2 +013800 MAR-TEST-7. NC1134.2 +013900 MOVE "MAR-TEST-7" TO PAR-NAME. NC1134.2 +014000 PERFORM PRINT-DETAIL. NC1134.2 +014100* GO TO MAR-TEST-8. NC1134.2 +014200 MAR-TEST-12. NC1134.2 +014300 MOVE "MAR-TEST-12" TO PAR-NAME. NC1134.2 +014400 PERFORM PRINT-DETAIL. NC1134.2 +014500 GO TO MAR-TEST-13. NC1134.2 +014600 MAR-TEST-4. NC1134.2 +014700 MOVE "MAR-TEST-4" TO PAR-NAME. NC1134.2 +014800 PERFORM PRINT-DETAIL. NC1134.2 +014900 MAR-TEST-9. NC1134.2 +015000 MOVE "MAR-TEST-9" TO PAR-NAME. NC1134.2 +015100 PERFORM PRINT-DETAIL. NC1134.2 +015200 MAR-TEST-8. NC1134.2 +015300 MOVE "MAR-TEST-8" TO PAR-NAME. NC1134.2 +015400 PERFORM PRINT-DETAIL. NC1134.2 +015500 PERFORM MAR-TEST-9. NC1134.2 +015600 GO TO MAR-TEST-10. NC1134.2 +015700 MAR-TEST-1. NC1134.2 +015800 MOVE "ANSWERS MUST BE" TO RE-MARK. NC1134.2 +015900 MOVE "MAR-TEST-1" TO PAR-NAME. NC1134.2 +016000 PERFORM PRINT-DETAIL. NC1134.2 +016100 MAR-TEST-5. NC1134.2 +016200 MOVE "TESTS MUST BE SEQUENTIAL" TO RE-MARK. NC1134.2 +016300 MOVE "MAR-TEST-5" TO PAR-NAME. NC1134.2 +016400 PERFORM PRINT-DETAIL. NC1134.2 +016500 GO TO MAR-TEST-6. NC1134.2 +016600 MAR-TEST-13. NC1134.2 +016700 MOVE "MAR-TEST-13" TO PAR-NAME. NC1134.2 +016800 PERFORM PRINT-DETAIL. NC1134.2 +016900 GO TO MAR-TEST-14. NC1134.2 +017000 MAR-TEST-3. NC1134.2 +017100 MOVE "FOR CORRECTNESS" TO RE-MARK. NC1134.2 +017200 MOVE "MAR-TEST-3" TO PAR-NAME. NC1134.2 +017300 PERFORM PRINT-DETAIL. NC1134.2 +017400 PERFORM MAR-TEST-4. NC1134.2 +017500 GO TO MAR-TEST-5. NC1134.2 +017600 MAR-TEST-14. NC1134.2 +017700 MOVE "MAR-TEST-14" TO PAR-NAME. NC1134.2 +017800 PERFORM PRINT-DETAIL. NC1134.2 +017900 PERFORM MAR-TEST-15. NC1134.2 +018000 GO TO CLOSE-FILES. NC1134.2 +018100 MAR-TEST-11. NC1134.2 +018200 MOVE "MAR-TEST-11" TO PAR-NAME. NC1134.2 +018300 PERFORM PRINT-DETAIL. NC1134.2 +018400 GO TO MAR-TEST-12. NC1134.2 +018500 MAR-TEST-10. NC1134.2 +018600 MOVE "MAR-TEST-10" TO PAR-NAME. NC1134.2 +018700 PERFORM PRINT-DETAIL. NC1134.2 +018800 GO TO MAR-TEST-11. NC1134.2 +018900 MAR-TEST-6. NC1134.2 +019000 MOVE "MAR-TEST-6" TO PAR-NAME. NC1134.2 +019100 PERFORM PRINT-DETAIL. NC1134.2 +019200 PERFORM MAR-TEST-7. NC1134.2 +019300 GO TO MAR-TEST-8. NC1134.2 +019400 CLOSE-FILES. NC1134.2 +019500 PERFORM END-ROUTINE THRU END-ROUTINE-3. NC1134.2 +019600 CLOSE PRINT-FILE. NC1134.2 +019700 STOP RUN. NC1134.2 +019800 PASS. NC1134.2 +019900 MOVE "PASS" TO P-OR-F. NC1134.2 +020000 FAIL. NC1134.2 +020100 ADD 1 TO ERROR-COUNTER. NC1134.2 +020200 MOVE "FAIL*" TO P-OR-F. NC1134.2 +020300 DE-LETE. NC1134.2 +020400 MOVE SPACE TO P-OR-F. NC1134.2 +020500 MOVE " ************ " TO COMPUTED-A. NC1134.2 +020600 MOVE " ************ " TO CORRECT-A. NC1134.2 +020700 MOVE "****TEST DELETED****" TO RE-MARK. NC1134.2 +020800 ADD 1 TO DELETE-CNT. NC1134.2 +020900 PRINT-DETAIL. NC1134.2 +021000 MOVE TEST-RESULTS TO PRINT-REC. NC1134.2 +021100 WRITE PRINT-REC AFTER 1. NC1134.2 +021200 MOVE SPACE TO P-OR-F. NC1134.2 +021300 MOVE SPACE TO PAR-NAME. NC1134.2 +021400 MOVE SPACE TO COMPUTED-A. NC1134.2 +021500 MOVE SPACE TO CORRECT-A. NC1134.2 +021600 MOVE SPACE TO RE-MARK. NC1134.2 +021700 HEAD-ROUTINE. NC1134.2 +021800 PERFORM BLANK-LINE-PRINT 15 TIMES. NC1134.2 +021900 MOVE HEADER-LINE-1 TO DUMMY-RECORD. NC1134.2 +022000 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +022100 PERFORM BLANK-LINE-PRINT. NC1134.2 +022200 MOVE HEADER-LINE-2 TO DUMMY-RECORD. NC1134.2 +022300 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +022400 PERFORM BLANK-LINE-PRINT 4 TIMES. NC1134.2 +022500 MOVE HEADER-LINE-3 TO DUMMY-RECORD. NC1134.2 +022600 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +022700 PERFORM BLANK-LINE-PRINT 2 TIMES. NC1134.2 +022800 COLUMN-NAMES-ROUTINE. NC1134.2 +022900 MOVE COLUMNS-LINE-1 TO DUMMY-RECORD. NC1134.2 +023000 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +023100 MOVE SPACE TO PAGE-CONTROL-C. NC1134.2 +023200 MOVE COLUMNS-LINE-2 TO DUMMY-RECORD. NC1134.2 +023300 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +023400 PERFORM BLANK-LINE-PRINT. NC1134.2 +023500 MOVE HYPHEN-LINE TO DUMMY-RECORD. NC1134.2 +023600 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +023700 END-ROUTINE. NC1134.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. NC1134.2 +023900 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +024000 PARA-Z. NC1134.2 +024100 PERFORM BLANK-LINE-PRINT 4 TIMES. NC1134.2 +024200 MOVE ENDER-LINE-1 TO DUMMY-RECORD. NC1134.2 +024300 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +024400 END-ROUTINE-1. NC1134.2 +024500 PERFORM BLANK-LINE-PRINT. NC1134.2 +024600 MOVE "TESTS REQUIRE VISUAL INSPECTION" TO ENDER-DESC. NC1134.2 +024700 END-ROUTINE-2. NC1134.2 +024800 MOVE " 15" TO ERROR-TOTAL. NC1134.2 +024900 END-ROUTINE-3. NC1134.2 +025000 MOVE ENDER-LINE-2 TO DUMMY-RECORD. NC1134.2 +025100 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +025200 IF DELETE-CNT IS EQUAL TO ZERO NC1134.2 +025300 MOVE " NO" TO ERROR-TOTAL ELSE NC1134.2 +025400 MOVE DELETE-CNT TO ERROR-TOTAL. NC1134.2 +025500 MOVE "TESTS DELETED " TO ENDER-DESC. NC1134.2 +025600 MOVE ENDER-LINE-2 TO DUMMY-RECORD. NC1134.2 +025700 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +025800 MOVE ENDER-LINE-3 TO DUMMY-RECORD. NC1134.2 +025900 WRITE DUMMY-RECORD AFTER 1. NC1134.2 +026000 BLANK-LINE-PRINT. NC1134.2 +026100 MOVE SPACE TO DUMMY-RECORD. NC1134.2 +026200 WRITE DUMMY-RECORD AFTER 1. NC1134.2 diff --git a/tests/cobol85/NC/NC114M.CBL b/tests/cobol85/NC/NC114M.CBL new file mode 100755 index 00000000..b3e5cecf --- /dev/null +++ b/tests/cobol85/NC/NC114M.CBL @@ -0,0 +1,500 @@ +000100 IDENTIFICATION DIVISION. NC1144.2 +000200 PROGRAM-ID. NC1144.2 +000300 NC114M. NC1144.2 +000400**************************************************************** NC1144.2 +000500* * NC1144.2 +000600* VALIDATION FOR:- * NC1144.2 +000700* * NC1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1144.2 +000900* * NC1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1144.2 +001100* * NC1144.2 +001200**************************************************************** NC1144.2 +001300* * NC1144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1144.2 +001500* * NC1144.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1144.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1144.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1144.2 +001900* * NC1144.2 +002000**************************************************************** NC1144.2 +002100* NC1144.2 +002200* PROGRAM NC114M TESTS: NC1144.2 +002300* NC1144.2 +002400* ALPHA-NUMERIC EDITING NC1144.2 +002500* COMMENT LINES NC1144.2 +002600* UNIQUENESS OF REFERENCE (DATA, PARAGRAPH & SECTION NAME) NC1144.2 +002700* SEQUENCE NUMBERING NC1144.2 +002800* NC1144.2 +002900******************************************************************NC1144.2 +003000* NC1144.2 +003100 ENVIRONMENT DIVISION. NC1144.2 +003200 CONFIGURATION SECTION. NC1144.2 +003300 SOURCE-COMPUTER. NC1144.2 +003400 Linux. NC1144.2 +003500 OBJECT-COMPUTER. NC1144.2 +003600 Linux NC1144.2 +003700 PROGRAM COLLATING SEQUENCE IS AMERICAN-INDIAN. NC1144.2 +003800 SPECIAL-NAMES. NC1144.2 +003900 ALPHABET AMERICAN-INDIAN IS NATIVE. NC1144.2 +004000 INPUT-OUTPUT SECTION. NC1144.2 +004100 FILE-CONTROL. NC1144.2 +004200 SELECT PRINT-FILE ASSIGN TO NC1144.2 +004300 "report.log". NC1144.2 +004400 DATA DIVISION. NC1144.2 +004500 FILE SECTION. NC1144.2 +004600 FD PRINT-FILE. NC1144.2 +004700 01 PRINT-REC PICTURE X(120). NC1144.2 +004800 01 DUMMY-RECORD PICTURE X(120). NC1144.2 +004900 WORKING-STORAGE SECTION. NC1144.2 +005000 01 NINE-DU-9 PIC 9 VALUE 9. NC1144.2 +005100 01 WRK-DU-99-1 PIC 99. NC1144.2 +005200 01 WRK-DU-99-2 PIC 99. NC1144.2 +005300 01 WRK-AE-1 PIC ABA VALUE "ABC". NC1144.2 +005400 01 WRK-AE-2 PIC A/AA. NC1144.2 +005500 01 WRK-AE-3 PIC XBXXX/XXX/XXX/XXX/XXXBXX. NC1144.2 +005600 01 WRK-NE-1 PIC 9/99 . NC1144.2 +005700/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +005800/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +005900* ASTERISK COMMENT SHOULD NOT BE SYNTAX CHECKED "(,$*.)-/+> <,....NC1144.2 +006000*SIGN-LEADING-TEST-9 ) , > ; < NC1144.2 +006100 01 WRK-DS-L-18V0-1 PIC S9(18) SIGN IS LEADING . NC1144.2 +006200* SIGN-TRAILING-TEST-10 NC1144.2 +006300 01 WRK-DS-T-18V0-1 PIC S9(18) SIGN TRAILING . NC1144.2 +006400* SIGN-SEPARATE-TEST-11 NC1144.2 +006500 01 WRK-DS-S-18V0-1 PIC S9(18) SIGN TRAILING SEPARATE CHARACTER. NC1144.2 +006600* REDEFINITION-TEST-12 NC1144.2 +006700 01 WRK-XN-18-1 PIC X(18). NC1144.2 +006800 01 WRK-AN-18-X-1 REDEFINES WRK-XN-18-1 PIC A(18). NC1144.2 +006900 01 GRP-X-1 REDEFINES WRK-XN-18-1. NC1144.2 +007000 02 WRK-DU-9V0-1 PIC 9(9). NC1144.2 +007100 02 WRK-DU-9V0-2 PIC 9(9). NC1144.2 +007200 01 WRK-DS-18V0-1 PIC S9(18) NC1144.2 +007300 VALUE -123456789012345678. NC1144.2 +007400 01 WRK-XN-18-2 PIC X(18) VALUE "123456789012345678". NC1144.2 +007500 01 WRK-DS-LS-1P17-1 PIC S9P(17) SIGN LEADING SEPARATE NC1144.2 +007600 CHARACTER VALUE -100000000000000000. NC1144.2 +007700/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +007800 01 PIC-SYNTAX-TEST-19 PIC AB9. NC1144.2 +007900/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +008000 01 TEST-RESULTS. NC1144.2 +008100 02 FILLER PIC X VALUE SPACE. NC1144.2 +008200 02 FEATURE PIC X(20) VALUE SPACE. NC1144.2 +008300 02 FILLER PIC X VALUE SPACE. NC1144.2 +008400 02 P-OR-F PIC X(5) VALUE SPACE. NC1144.2 +008500 02 FILLER PIC X VALUE SPACE. NC1144.2 +008600 02 PAR-NAME. NC1144.2 +008700 03 FILLER PIC X(19) VALUE SPACE. NC1144.2 +008800 03 PARDOT-X PIC X VALUE SPACE. NC1144.2 +008900 03 DOTVALUE PIC 99 VALUE ZERO. NC1144.2 +009000 02 FILLER PIC X(8) VALUE SPACE. NC1144.2 +009100 02 RE-MARK PIC X(61). NC1144.2 +009200 01 TEST-COMPUTED. NC1144.2 +009300 02 FILLER PIC X(30) VALUE SPACE. NC1144.2 +009400 02 FILLER PIC X(17) VALUE NC1144.2 +009500 " COMPUTED=". NC1144.2 +009600 02 COMPUTED-X. NC1144.2 +009700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1144.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A NC1144.2 +009900 PIC -9(9).9(9). NC1144.2 +010000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1144.2 +010100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1144.2 +010200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1144.2 +010300 03 CM-18V0 REDEFINES COMPUTED-A. NC1144.2 +010400 04 COMPUTED-18V0 PIC -9(18). NC1144.2 +010500 04 FILLER PIC X. NC1144.2 +010600 03 FILLER PIC X(50) VALUE SPACE. NC1144.2 +010700 01 TEST-CORRECT. NC1144.2 +010800 02 FILLER PIC X(30) VALUE SPACE. NC1144.2 +010900 02 FILLER PIC X(17) VALUE " CORRECT =". NC1144.2 +011000 02 CORRECT-X. NC1144.2 +011100 03 CORRECT-A PIC X(20) VALUE SPACE. NC1144.2 +011200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1144.2 +011300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1144.2 +011400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1144.2 +011500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1144.2 +011600 03 CR-18V0 REDEFINES CORRECT-A. NC1144.2 +011700 04 CORRECT-18V0 PIC -9(18). NC1144.2 +011800 04 FILLER PIC X. NC1144.2 +011900 03 FILLER PIC X(2) VALUE SPACE. NC1144.2 +012000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1144.2 +012100 01 CCVS-C-1. NC1144.2 +012200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1144.2 +012300- "SS PARAGRAPH-NAME NC1144.2 +012400- " REMARKS". NC1144.2 +012500 02 FILLER PIC X(20) VALUE SPACE. NC1144.2 +012600 01 CCVS-C-2. NC1144.2 +012700 02 FILLER PIC X VALUE SPACE. NC1144.2 +012800 02 FILLER PIC X(6) VALUE "TESTED". NC1144.2 +012900 02 FILLER PIC X(15) VALUE SPACE. NC1144.2 +013000 02 FILLER PIC X(4) VALUE "FAIL". NC1144.2 +013100 02 FILLER PIC X(94) VALUE SPACE. NC1144.2 +013200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1144.2 +013300 01 REC-CT PIC 99 VALUE ZERO. NC1144.2 +013400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1144.2 +013500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1144.2 +013600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1144.2 +013700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1144.2 +013800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1144.2 +013900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1144.2 +014000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1144.2 +014100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1144.2 +014200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1144.2 +014300 01 CCVS-H-1. NC1144.2 +014400 02 FILLER PIC X(39) VALUE SPACES. NC1144.2 +014500 02 FILLER PIC X(42) VALUE NC1144.2 +014600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1144.2 +014700 02 FILLER PIC X(39) VALUE SPACES. NC1144.2 +014800 01 CCVS-H-2A. NC1144.2 +014900 02 FILLER PIC X(40) VALUE SPACE. NC1144.2 +015000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1144.2 +015100 02 FILLER PIC XXXX VALUE NC1144.2 +015200 "4.2 ". NC1144.2 +015300 02 FILLER PIC X(28) VALUE NC1144.2 +015400 " COPY - NOT FOR DISTRIBUTION". NC1144.2 +015500 02 FILLER PIC X(41) VALUE SPACE. NC1144.2 +015600 NC1144.2 +015700 01 CCVS-H-2B. NC1144.2 +015800 02 FILLER PIC X(15) VALUE NC1144.2 +015900 "TEST RESULT OF ". NC1144.2 +016000 02 TEST-ID PIC X(9). NC1144.2 +016100 02 FILLER PIC X(4) VALUE NC1144.2 +016200 " IN ". NC1144.2 +016300 02 FILLER PIC X(12) VALUE NC1144.2 +016400 " HIGH ". NC1144.2 +016500 02 FILLER PIC X(22) VALUE NC1144.2 +016600 " LEVEL VALIDATION FOR ". NC1144.2 +016700 02 FILLER PIC X(58) VALUE NC1144.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1144.2 +016900 01 CCVS-H-3. NC1144.2 +017000 02 FILLER PIC X(34) VALUE NC1144.2 +017100 " FOR OFFICIAL USE ONLY ". NC1144.2 +017200 02 FILLER PIC X(58) VALUE NC1144.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1144.2 +017400 02 FILLER PIC X(28) VALUE NC1144.2 +017500 " COPYRIGHT 1985 ". NC1144.2 +017600 01 CCVS-E-1. NC1144.2 +017700 02 FILLER PIC X(52) VALUE SPACE. NC1144.2 +017800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1144.2 +017900 02 ID-AGAIN PIC X(9). NC1144.2 +018000 02 FILLER PIC X(45) VALUE SPACES. NC1144.2 +018100 01 CCVS-E-2. NC1144.2 +018200 02 FILLER PIC X(31) VALUE SPACE. NC1144.2 +018300 02 FILLER PIC X(21) VALUE SPACE. NC1144.2 +018400 02 CCVS-E-2-2. NC1144.2 +018500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1144.2 +018600 03 FILLER PIC X VALUE SPACE. NC1144.2 +018700 03 ENDER-DESC PIC X(44) VALUE NC1144.2 +018800 "ERRORS ENCOUNTERED". NC1144.2 +018900 01 CCVS-E-3. NC1144.2 +019000 02 FILLER PIC X(22) VALUE NC1144.2 +019100 " FOR OFFICIAL USE ONLY". NC1144.2 +019200 02 FILLER PIC X(12) VALUE SPACE. NC1144.2 +019300 02 FILLER PIC X(58) VALUE NC1144.2 +019400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1144.2 +019500 02 FILLER PIC X(13) VALUE SPACE. NC1144.2 +019600 02 FILLER PIC X(15) VALUE NC1144.2 +019700 " COPYRIGHT 1985". NC1144.2 +019800 01 CCVS-E-4. NC1144.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1144.2 +020000 02 FILLER PIC X(4) VALUE " OF ". NC1144.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1144.2 +020200 02 FILLER PIC X(40) VALUE NC1144.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". NC1144.2 +020400 01 XXINFO. NC1144.2 +020500 02 FILLER PIC X(19) VALUE NC1144.2 +020600 "*** INFORMATION ***". NC1144.2 +020700 02 INFO-TEXT. NC1144.2 +020800 04 FILLER PIC X(8) VALUE SPACE. NC1144.2 +020900 04 XXCOMPUTED PIC X(20). NC1144.2 +021000 04 FILLER PIC X(5) VALUE SPACE. NC1144.2 +021100 04 XXCORRECT PIC X(20). NC1144.2 +021200 02 INF-ANSI-REFERENCE PIC X(48). NC1144.2 +021300 01 HYPHEN-LINE. NC1144.2 +021400 02 FILLER PIC IS X VALUE IS SPACE. NC1144.2 +021500 02 FILLER PIC IS X(65) VALUE IS "************************NC1144.2 +021600- "*****************************************". NC1144.2 +021700 02 FILLER PIC IS X(54) VALUE IS "************************NC1144.2 +021800- "******************************". NC1144.2 +021900 01 CCVS-PGM-ID PIC X(9) VALUE NC1144.2 +022000 "NC114M". NC1144.2 +022100 PROCEDURE DIVISION. NC1144.2 +022200 CCVS1 SECTION. NC1144.2 +022300 OPEN-FILES. NC1144.2 +022400 OPEN OUTPUT PRINT-FILE. NC1144.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1144.2 +022600 MOVE SPACE TO TEST-RESULTS. NC1144.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1144.2 +022800 GO TO CCVS1-EXIT. NC1144.2 +022900 CLOSE-FILES. NC1144.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1144.2 +023100 TERMINATE-CCVS. NC1144.2 +023200*S EXIT PROGRAM. NC1144.2 +023300*SERMINATE-CALL. NC1144.2 +023400 STOP RUN. NC1144.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1144.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1144.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1144.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1144.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. NC1144.2 +024000 PRINT-DETAIL. NC1144.2 +024100 IF REC-CT NOT EQUAL TO ZERO NC1144.2 +024200 MOVE "." TO PARDOT-X NC1144.2 +024300 MOVE REC-CT TO DOTVALUE. NC1144.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1144.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1144.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1144.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1144.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1144.2 +024900 MOVE SPACE TO CORRECT-X. NC1144.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1144.2 +025100 MOVE SPACE TO RE-MARK. NC1144.2 +025200 HEAD-ROUTINE. NC1144.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1144.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1144.2 +025700 COLUMN-NAMES-ROUTINE. NC1144.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +026100 END-ROUTINE. NC1144.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1144.2 +026300 END-RTN-EXIT. NC1144.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +026500 END-ROUTINE-1. NC1144.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1144.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1144.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. NC1144.2 +026900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1144.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1144.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1144.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1144.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1144.2 +027400 END-ROUTINE-12. NC1144.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1144.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO NC1144.2 +027700 MOVE "NO " TO ERROR-TOTAL NC1144.2 +027800 ELSE NC1144.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1144.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1144.2 +028100 PERFORM WRITE-LINE. NC1144.2 +028200 END-ROUTINE-13. NC1144.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO NC1144.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE NC1144.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1144.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1144.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO NC1144.2 +028900 MOVE "NO " TO ERROR-TOTAL NC1144.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1144.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1144.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1144.2 +029400 WRITE-LINE. NC1144.2 +029500 ADD 1 TO RECORD-COUNT. NC1144.2 +029600 IF RECORD-COUNT GREATER 42 NC1144.2 +029700 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1144.2 +029800 MOVE SPACE TO DUMMY-RECORD NC1144.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1144.2 +030000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1144.2 +030100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1144.2 +030200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1144.2 +030300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1144.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1144.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1144.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1144.2 +030700 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1144.2 +030800 MOVE ZERO TO RECORD-COUNT. NC1144.2 +030900 PERFORM WRT-LN. NC1144.2 +031000 WRT-LN. NC1144.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1144.2 +031200 MOVE SPACE TO DUMMY-RECORD. NC1144.2 +031300 BLANK-LINE-PRINT. NC1144.2 +031400 PERFORM WRT-LN. NC1144.2 +031500 FAIL-ROUTINE. NC1144.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE NC1144.2 +031700 GO TO FAIL-ROUTINE-WRITE. NC1144.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1144.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1144.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1144.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1144.2 +032300 GO TO FAIL-ROUTINE-EX. NC1144.2 +032400 FAIL-ROUTINE-WRITE. NC1144.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1144.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1144.2 +032700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1144.2 +032800 MOVE SPACES TO COR-ANSI-REFERENCE. NC1144.2 +032900 FAIL-ROUTINE-EX. EXIT. NC1144.2 +033000 BAIL-OUT. NC1144.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1144.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1144.2 +033300 BAIL-OUT-WRITE. NC1144.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1144.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1144.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1144.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1144.2 +033800 BAIL-OUT-EX. EXIT. NC1144.2 +033900 CCVS1-EXIT. NC1144.2 +034000 EXIT. NC1144.2 +034100/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +034200* NULL1-NU-L-TEST-13 NC1144.2 +034300 0 SECTION. NC1144.2 +034400 NULL1 SECTION. NC1144.2 +034500 NU-L SECTION .NC1144.2 +034600 A. NC1144.2 +034700 B . NC1144.2 +034800 C . NC1144.2 +034900 D . NC1144.2 +035000 THE-END. NC1144.2 +035100 EXIT. NC1144.2 +035200/ STROKE-COMMENT-TEST-7 SHOULD PAGE EJECT AND PRINT ON TOP LINE NC1144.2 +035300* ASTERISK COMMENT SHOULD NOT BE SYNTAX CHECKED "(,l*.)-/+> <,....NC1144.2 +035400 SECT-NC114-1 SECTION. NC1144.2 +035500 ALPHA-EDIT-TEST-4. NC1144.2 +035600 IF WRK-AE-1 EQUAL TO "ABC" NEXT SENTENCE ELSE MOVE "ABC" TO NC1144.2 +035700 CORRECT-A GO TO ALPHA-EDIT-FAIL-4. NC1144.2 +035800 MOVE "DEF" TO WRK-AE-1. NC1144.2 +035900 IF WRK-AE-1 EQUAL TO "D E" PERFORM PASS NC1144.2 +036000 GO TO ALPHA-EDIT-WRITE-4 ELSE MOVE "D E" TO CORRECT-A NC1144.2 +036100 GO TO ALPHA-EDIT-FAIL-4. NC1144.2 +036200 ALPHA-EDIT-DELETE-4. NC1144.2 +036300 PERFORM DE-LETE. NC1144.2 +036400 GO TO ALPHA-EDIT-WRITE-4. NC1144.2 +036500 ALPHA-EDIT-FAIL-4. NC1144.2 +036600 PERFORM FAIL. NC1144.2 +036700 MOVE WRK-AE-1 TO COMPUTED-A. NC1144.2 +036800 ALPHA-EDIT-WRITE-4. NC1144.2 +036900 MOVE "ALPHA-ED-TEST-4" TO PAR-NAME. NC1144.2 +037000 MOVE "B AS EDIT CHARACTER" TO FEATURE. NC1144.2 +037100 PERFORM PRINT-DETAIL. NC1144.2 +037200* ASTERISK COMMENT SHOULD NOT BE SYNTAX CHECKED "(,l*.)-/+> <,....NC1144.2 +037300 ALPHA-EDIT-TEST-5. NC1144.2 +037400 MOVE "ABC" TO WRK-AE-2. NC1144.2 +037500 IF WRK-AE-2 EQUAL TO "A/BC" PERFORM PASS NC1144.2 +037600 GO TO ALPHA-EDIT-WRITE-5 ELSE GO TO ALPHA-EDIT-FAIL-5. NC1144.2 +037700 ALPHA-EDIT-DELETE-5. NC1144.2 +037800 PERFORM DE-LETE. NC1144.2 +037900 GO TO ALPHA-EDIT-WRITE-5. NC1144.2 +038000 ALPHA-EDIT-FAIL-5. NC1144.2 +038100 PERFORM FAIL. NC1144.2 +038200 MOVE WRK-AE-2 TO COMPUTED-A. NC1144.2 +038300 MOVE "A/BC" TO CORRECT-A. NC1144.2 +038400 ALPHA-EDIT-WRITE-5. NC1144.2 +038500 MOVE "ALPHA-ED-TEST-5" TO PAR-NAME. NC1144.2 +038600 MOVE "/ AS EDIT CHARACTER" TO FEATURE. NC1144.2 +038700 PERFORM PRINT-DETAIL. NC1144.2 +038800 NUM-EDIT-TEST-6. NC1144.2 +038900 MOVE 123 TO WRK-NE-1. NC1144.2 +039000 IF WRK-NE-1 EQUAL TO "1/23" PERFORM PASS NC1144.2 +039100 GO TO NUM-EDIT-WRITE-6 ELSE GO TO NUM-EDIT-FAIL-6. NC1144.2 +039200 NUM-EDIT-DELETE-6. NC1144.2 +039300 PERFORM DE-LETE. NC1144.2 +039400 GO TO NUM-EDIT-WRITE-6. NC1144.2 +039500 NUM-EDIT-FAIL-6. NC1144.2 +039600 PERFORM FAIL. NC1144.2 +039700 MOVE WRK-NE-1 TO COMPUTED-A. NC1144.2 +039800 MOVE "1/23" TO CORRECT-A. NC1144.2 +039900 NUM-EDIT-WRITE-6. NC1144.2 +040000 MOVE "NUM-EDIT-TEST-6" TO PAR-NAME. NC1144.2 +040100 MOVE "/ AS EDIT CHARACTER" TO FEATURE. NC1144.2 +040200 PERFORM PRINT-DETAIL. NC1144.2 +040300* ASTERISK COMMENT SHOULD NOT BE SYNTAX CHECKED "(,l*.)-/+> <,....NC1144.2 +040400 ELEM-MOVE-TEST-16. NC1144.2 +040500 MOVE WRK-DS-LS-1P17-1 TO WRK-XN-18-2. NC1144.2 +040600 IF WRK-XN-18-2 EQUAL TO "100000000000000000" PERFORM PASS NC1144.2 +040700 GO TO ELEM-MOVE-WRITE-16. NC1144.2 +040800 GO TO ELEM-MOVE-FAIL-16. NC1144.2 +040900 ELEM-MOVE-DELETE-16. NC1144.2 +041000 PERFORM DE-LETE. NC1144.2 +041100 GO TO ELEM-MOVE-WRITE-16. NC1144.2 +041200 ELEM-MOVE-FAIL-16. NC1144.2 +041300 PERFORM FAIL. NC1144.2 +041400 MOVE WRK-XN-18-2 TO COMPUTED-A. NC1144.2 +041500 MOVE "100000000000000000" TO CORRECT-A. NC1144.2 +041600 ELEM-MOVE-WRITE-16. NC1144.2 +041700 MOVE "MOVE-TEST-16" TO PAR-NAME. NC1144.2 +041800 MOVE "STRIP MINUS SIGN" TO FEATURE. NC1144.2 +041900 PERFORM PRINT-DETAIL. NC1144.2 +042000 ELEM-MOVE-TEST-17. NC1144.2 +042100 MOVE WRK-DS-LS-1P17-1 TO WRK-AE-3. NC1144.2 +042200 IF WRK-AE-3 EQUAL TO "1 000/000/000/000/000 00" NC1144.2 +042300 PERFORM PASS GO TO ELEM-MOVE-WRITE-17. NC1144.2 +042400 GO TO ELEM-MOVE-FAIL-17. NC1144.2 +042500 ELEM-MOVE-DELETE-17. NC1144.2 +042600 PERFORM DE-LETE. NC1144.2 +042700 GO TO ELEM-MOVE-WRITE-17. NC1144.2 +042800 ELEM-MOVE-FAIL-17. NC1144.2 +042900 PERFORM FAIL. NC1144.2 +043000 MOVE WRK-AE-3 TO COMPUTED-A. NC1144.2 +043100 MOVE "1 000/000/000/000/000 00" TO CORRECT-A. NC1144.2 +043200 ELEM-MOVE-WRITE-17. NC1144.2 +043300 MOVE "MOVE-TEST-17" TO PAR-NAME. NC1144.2 +043400 MOVE "/ AND B EDITS" TO FEATURE. NC1144.2 +043500 PERFORM PRINT-DETAIL. NC1144.2 +043600 TEST-19-SYNTAX. NC1144.2 +043700 PERFORM END-ROUTINE. NC1144.2 +043800 MOVE ZERO TO REC-CT. NC1144.2 +043900 MOVE SPACE TO TEST-RESULTS. NC1144.2 +044000 MOVE " PICTURE AB9 ** CHECK DATA DIV." TO TEST-RESULTS. NC1144.2 +044100 PERFORM PRINT-DETAIL. NC1144.2 +044200* NC1144.2 +044300* THE FOLLOWING LINES HAVE SPECIAL CHARACTERS IN THE NC1144.2 +044400* SEQUENCE AREA (COLS 1-6) AND MANUAL VERIFICATION OF NC1144.2 +044500* THEIR POSITION ON THE COMPILATION LISTING IS REQUESTED NC1144.2 +044600* IN THE REPORT. NC1144.2 +044700* NC1144.2 +044800 SEQ-NUM-TEST-1. NC1144.2 +044900 MOVE "IV-44 7.2.1" TO ANSI-REFERENCE. NC1144.2 +045000 MOVE SPACES TO TEST-RESULTS. NC1144.2 +045100 MOVE "SEQUENCE NUMBER AREA" TO FEATURE. NC1144.2 +045200 MOVE "SEQ-NUM-TEST-1" TO PAR-NAME. NC1144.2 +045300 PERFORM PRINT-DETAIL. NC1144.2 +045400 MOVE " PLEASE VERIFY THAT THE FOLLOWING ENTRIES" NC1144.2 +045500 TO RE-MARK. NC1144.2 +045600 PERFORM PRINT-DETAIL. NC1144.2 +045700 MOVE " ARE PRINTED IN THE SEQUENCE NUMBER AREA" NC1144.2 +045800 TO RE-MARK. NC1144.2 +045900 PERFORM PRINT-DETAIL. NC1144.2 +046000 MOVE " (COLUMNS 1-6) NEAR THE END OF THE " NC1144.2 +046100 TO RE-MARK. NC1144.2 +046200 PERFORM PRINT-DETAIL. NC1144.2 +046300 MOVE " COMPILATION LISTING FOR NC114M: " NC1144.2 +046400 TO RE-MARK. NC1144.2 +046500 PERFORM PRINT-DETAIL. NC1144.2 +046600 MOVE SPACES TO TEST-RESULTS. NC1144.2 +046700 MOVE " COLUMNS: 123456" TO RE-MARK. NC1144.2 +046800 PERFORM PRINT-DETAIL. NC1144.2 +046900 MOVE " =======: ======" TO RE-MARK. NC1144.2 +047000 PERFORM PRINT-DETAIL. NC1144.2 +047100 MOVE " ENTRY-1: ABCDEF" TO RE-MARK. NC1144.2 +047200 PERFORM PRINT-DETAIL. NC1144.2 +047300 MOVE " ENTRY-2: */+(>'" TO RE-MARK. NC1144.2 +047400 PERFORM PRINT-DETAIL. NC1144.2 +047500 MOVE " ENTRY-3: 999-99" TO RE-MARK. NC1144.2 +047600 PERFORM PRINT-DETAIL. NC1144.2 +047700 MOVE " ENTRY-4: Z=.,;<" TO RE-MARK. NC1144.2 +047800 PERFORM PRINT-DETAIL. NC1144.2 +047900 MOVE " ENTRY-5: )14$ X" TO RE-MARK. NC1144.2 +048000 PERFORM PRINT-DETAIL. NC1144.2 +048100 MOVE " ENTRY-6: 23 4" TO RE-MARK. NC1144.2 +048200 PERFORM PRINT-DETAIL. NC1144.2 +048300 PERFORM INSPT. NC1144.2 +048400* NC1144.2 +048500 NC1144.2 +ABCDEF +*/+(>' +999-99 +Z=.,;< +)14$ X + 23 4 +049200 NC1144.2 +049300 NC1144.2 +049400 NC1144.2 +049500 NC1144.2 +049600* NC1144.2 +049700 CCVS-EXIT SECTION. NC1144.2 +049800 CCVS-999999. NC1144.2 +049900 GO TO CLOSE-FILES. NC1144.2 +050000* ASTERISK COMMENT AS THE LAST LINE IN THE SOURCE PROGRAM LISTING NC1144.2 diff --git a/tests/cobol85/NC/NC115A.CBL b/tests/cobol85/NC/NC115A.CBL new file mode 100755 index 00000000..b5958b7b --- /dev/null +++ b/tests/cobol85/NC/NC115A.CBL @@ -0,0 +1,1104 @@ +000100 IDENTIFICATION DIVISION. NC1154.2 +000200 PROGRAM-ID. NC1154.2 +000300 NC115A. NC1154.2 +000400**************************************************************** NC1154.2 +000500* * NC1154.2 +000600* VALIDATION FOR:- * NC1154.2 +000700* * NC1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1154.2 +000900* * NC1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1154.2 +001100* * NC1154.2 +001200**************************************************************** NC1154.2 +001300* * NC1154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1154.2 +001500* * NC1154.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1154.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1154.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1154.2 +001900* * NC1154.2 +002000**************************************************************** NC1154.2 +002100* NC1154.2 +002200* PROGRAM NC115A TESTS FORMATS 1, 2, AND 3 OF NC1154.2 +002300* THE INSPECT STATEMENT. NC1154.2 +002400* NC1154.2 +002500******************************************************************NC1154.2 +002600 ENVIRONMENT DIVISION. NC1154.2 +002700 CONFIGURATION SECTION. NC1154.2 +002800 SOURCE-COMPUTER. NC1154.2 +002900 Linux. NC1154.2 +003000 OBJECT-COMPUTER. NC1154.2 +003100 Linux. NC1154.2 +003200 INPUT-OUTPUT SECTION. NC1154.2 +003300 FILE-CONTROL. NC1154.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1154.2 +003500 "report.log". NC1154.2 +003600 DATA DIVISION. NC1154.2 +003700 FILE SECTION. NC1154.2 +003800 FD PRINT-FILE. NC1154.2 +003900 01 PRINT-REC PICTURE X(120). NC1154.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1154.2 +004100 WORKING-STORAGE SECTION. NC1154.2 +004200 01 WRK-DU-999-1 PIC 999. NC1154.2 +004300 01 WRK-DU-999-2 PIC 999. NC1154.2 +004400 01 WRK-DU-999-3 PIC 999. NC1154.2 +004500 01 WRK-DU-999-4 PIC 999. NC1154.2 +004600 01 JUST-XN-20-1 PIC X(20) JUSTIFIED. NC1154.2 +004700 01 SPACE-XN-1-1 PIC X VALUE SPACE. NC1154.2 +004800 01 COMMA-XN-1-1 PIC X VALUE ",". NC1154.2 +004900 01 HYPEN-XN-1-1 PIC X VALUE "-". NC1154.2 +005000 01 A-XN-1-1 PIC X VALUE "A". NC1154.2 +005100 01 D-XN-1-1 PIC X VALUE "D". NC1154.2 +005200 01 G-XN-1-1 PIC X VALUE "G". NC1154.2 +005300 01 H-XN-1-1 PIC X VALUE "H". NC1154.2 +005400 01 L-XN-1-1 PIC X VALUE "L". NC1154.2 +005500 01 O-XN-1-1 PIC X VALUE "O". NC1154.2 +005600 01 P-XN-1-1 PIC X VALUE "P". NC1154.2 +005700 01 S-XN-1-1 PIC X VALUE "S". NC1154.2 +005800 01 Z-XN-1-1 PIC X VALUE "Z". NC1154.2 +005900 01 WRK-OK. NC1154.2 +006000 03 WRK-OK-1-20 PIC X(20). NC1154.2 +006100 03 WRK-OK-21-40 PIC X(20). NC1154.2 +006200 03 WRK-OK-41-60 PIC X(20). NC1154.2 +006300 03 WRK-OK-61-80 PIC X(20). NC1154.2 +006400 03 WRK-OK-81-83 PIC X(3). NC1154.2 +006500 01 WRK-ER. NC1154.2 +006600 03 WRK-ER-1-20 PIC X(20). NC1154.2 +006700 03 WRK-ER-21-40 PIC X(20). NC1154.2 +006800 03 WRK-ER-41-60 PIC X(20). NC1154.2 +006900 03 WRK-ER-61-80 PIC X(20). NC1154.2 +007000 03 WRK-ER-81-83 PIC X(3). NC1154.2 +007100 NC1154.2 +007200 01 WRK-XN-83-1 PIC X(83). NC1154.2 +007300 01 WC-XN-83 PIC X(83) VALUE NC1154.2 +007400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +007500- "IDS CAN NOT BE ALL BAD.". NC1154.2 +007600 01 ANS-XN-83-1 PIC X(83) VALUE NC1154.2 +007700 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +007800- "IDS CAN NOT BE ALL BAD.". NC1154.2 +007900 01 ANS-XN-83-2 PIC X(83) VALUE NC1154.2 +008000 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +008100- "IDS CAN NOT BE ALL BAD.". NC1154.2 +008200 01 ANS-XN-83-3 PIC X(83) VALUE NC1154.2 +008300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +008400- "IDS CAN NOT BE ALL-BAD.". NC1154.2 +008500 01 ANS-XN-83-4 PIC X(83) VALUE NC1154.2 +008600 "EH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +008700- "IDS CAN NOT BE ALL BAD.". NC1154.2 +008800 01 ANS-XN-83-5 PIC X(83) VALUE NC1154.2 +008900 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +009000- "IDS CAN NOT BE ALL BAD.". NC1154.2 +009100 01 ANS-XN-83-6 PIC X(83) VALUE NC1154.2 +009200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1154.2 +009300- "IDS CAN NOT BE ALZZZZZZ". NC1154.2 +009400 01 ANS-XN-83-7 PIC X(83) VALUE NC1154.2 +009500 "OH-YES-AH-YES-W.P.-ZRITOES-HERE.-ANYONE-WHO-HATES-DOGS-AND-KNC1154.2 +009600- "IDS-CAN-NOT-BE-ALZZZZZZ". NC1154.2 +009700 01 TEST-RESULTS. NC1154.2 +009800 02 FILLER PIC X VALUE SPACE. NC1154.2 +009900 02 FEATURE PIC X(20) VALUE SPACE. NC1154.2 +010000 02 FILLER PIC X VALUE SPACE. NC1154.2 +010100 02 P-OR-F PIC X(5) VALUE SPACE. NC1154.2 +010200 02 FILLER PIC X VALUE SPACE. NC1154.2 +010300 02 PAR-NAME. NC1154.2 +010400 03 FILLER PIC X(19) VALUE SPACE. NC1154.2 +010500 03 PARDOT-X PIC X VALUE SPACE. NC1154.2 +010600 03 DOTVALUE PIC 99 VALUE ZERO. NC1154.2 +010700 02 FILLER PIC X(8) VALUE SPACE. NC1154.2 +010800 02 RE-MARK PIC X(61). NC1154.2 +010900 01 TEST-COMPUTED. NC1154.2 +011000 02 FILLER PIC X(30) VALUE SPACE. NC1154.2 +011100 02 FILLER PIC X(17) VALUE NC1154.2 +011200 " COMPUTED=". NC1154.2 +011300 02 COMPUTED-X. NC1154.2 +011400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1154.2 +011500 03 COMPUTED-N REDEFINES COMPUTED-A NC1154.2 +011600 PIC -9(9).9(9). NC1154.2 +011700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1154.2 +011800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1154.2 +011900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1154.2 +012000 03 CM-18V0 REDEFINES COMPUTED-A. NC1154.2 +012100 04 COMPUTED-18V0 PIC -9(18). NC1154.2 +012200 04 FILLER PIC X. NC1154.2 +012300 03 FILLER PIC X(50) VALUE SPACE. NC1154.2 +012400 01 TEST-CORRECT. NC1154.2 +012500 02 FILLER PIC X(30) VALUE SPACE. NC1154.2 +012600 02 FILLER PIC X(17) VALUE " CORRECT =". NC1154.2 +012700 02 CORRECT-X. NC1154.2 +012800 03 CORRECT-A PIC X(20) VALUE SPACE. NC1154.2 +012900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1154.2 +013000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1154.2 +013100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1154.2 +013200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1154.2 +013300 03 CR-18V0 REDEFINES CORRECT-A. NC1154.2 +013400 04 CORRECT-18V0 PIC -9(18). NC1154.2 +013500 04 FILLER PIC X. NC1154.2 +013600 03 FILLER PIC X(2) VALUE SPACE. NC1154.2 +013700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1154.2 +013800 01 CCVS-C-1. NC1154.2 +013900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1154.2 +014000- "SS PARAGRAPH-NAME NC1154.2 +014100- " REMARKS". NC1154.2 +014200 02 FILLER PIC X(20) VALUE SPACE. NC1154.2 +014300 01 CCVS-C-2. NC1154.2 +014400 02 FILLER PIC X VALUE SPACE. NC1154.2 +014500 02 FILLER PIC X(6) VALUE "TESTED". NC1154.2 +014600 02 FILLER PIC X(15) VALUE SPACE. NC1154.2 +014700 02 FILLER PIC X(4) VALUE "FAIL". NC1154.2 +014800 02 FILLER PIC X(94) VALUE SPACE. NC1154.2 +014900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1154.2 +015000 01 REC-CT PIC 99 VALUE ZERO. NC1154.2 +015100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1154.2 +015200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1154.2 +015300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1154.2 +015400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1154.2 +015500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1154.2 +015600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1154.2 +015700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1154.2 +015800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1154.2 +015900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1154.2 +016000 01 CCVS-H-1. NC1154.2 +016100 02 FILLER PIC X(39) VALUE SPACES. NC1154.2 +016200 02 FILLER PIC X(42) VALUE NC1154.2 +016300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1154.2 +016400 02 FILLER PIC X(39) VALUE SPACES. NC1154.2 +016500 01 CCVS-H-2A. NC1154.2 +016600 02 FILLER PIC X(40) VALUE SPACE. NC1154.2 +016700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1154.2 +016800 02 FILLER PIC XXXX VALUE NC1154.2 +016900 "4.2 ". NC1154.2 +017000 02 FILLER PIC X(28) VALUE NC1154.2 +017100 " COPY - NOT FOR DISTRIBUTION". NC1154.2 +017200 02 FILLER PIC X(41) VALUE SPACE. NC1154.2 +017300 NC1154.2 +017400 01 CCVS-H-2B. NC1154.2 +017500 02 FILLER PIC X(15) VALUE NC1154.2 +017600 "TEST RESULT OF ". NC1154.2 +017700 02 TEST-ID PIC X(9). NC1154.2 +017800 02 FILLER PIC X(4) VALUE NC1154.2 +017900 " IN ". NC1154.2 +018000 02 FILLER PIC X(12) VALUE NC1154.2 +018100 " HIGH ". NC1154.2 +018200 02 FILLER PIC X(22) VALUE NC1154.2 +018300 " LEVEL VALIDATION FOR ". NC1154.2 +018400 02 FILLER PIC X(58) VALUE NC1154.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1154.2 +018600 01 CCVS-H-3. NC1154.2 +018700 02 FILLER PIC X(34) VALUE NC1154.2 +018800 " FOR OFFICIAL USE ONLY ". NC1154.2 +018900 02 FILLER PIC X(58) VALUE NC1154.2 +019000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1154.2 +019100 02 FILLER PIC X(28) VALUE NC1154.2 +019200 " COPYRIGHT 1985 ". NC1154.2 +019300 01 CCVS-E-1. NC1154.2 +019400 02 FILLER PIC X(52) VALUE SPACE. NC1154.2 +019500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1154.2 +019600 02 ID-AGAIN PIC X(9). NC1154.2 +019700 02 FILLER PIC X(45) VALUE SPACES. NC1154.2 +019800 01 CCVS-E-2. NC1154.2 +019900 02 FILLER PIC X(31) VALUE SPACE. NC1154.2 +020000 02 FILLER PIC X(21) VALUE SPACE. NC1154.2 +020100 02 CCVS-E-2-2. NC1154.2 +020200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1154.2 +020300 03 FILLER PIC X VALUE SPACE. NC1154.2 +020400 03 ENDER-DESC PIC X(44) VALUE NC1154.2 +020500 "ERRORS ENCOUNTERED". NC1154.2 +020600 01 CCVS-E-3. NC1154.2 +020700 02 FILLER PIC X(22) VALUE NC1154.2 +020800 " FOR OFFICIAL USE ONLY". NC1154.2 +020900 02 FILLER PIC X(12) VALUE SPACE. NC1154.2 +021000 02 FILLER PIC X(58) VALUE NC1154.2 +021100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1154.2 +021200 02 FILLER PIC X(13) VALUE SPACE. NC1154.2 +021300 02 FILLER PIC X(15) VALUE NC1154.2 +021400 " COPYRIGHT 1985". NC1154.2 +021500 01 CCVS-E-4. NC1154.2 +021600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1154.2 +021700 02 FILLER PIC X(4) VALUE " OF ". NC1154.2 +021800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1154.2 +021900 02 FILLER PIC X(40) VALUE NC1154.2 +022000 " TESTS WERE EXECUTED SUCCESSFULLY". NC1154.2 +022100 01 XXINFO. NC1154.2 +022200 02 FILLER PIC X(19) VALUE NC1154.2 +022300 "*** INFORMATION ***". NC1154.2 +022400 02 INFO-TEXT. NC1154.2 +022500 04 FILLER PIC X(8) VALUE SPACE. NC1154.2 +022600 04 XXCOMPUTED PIC X(20). NC1154.2 +022700 04 FILLER PIC X(5) VALUE SPACE. NC1154.2 +022800 04 XXCORRECT PIC X(20). NC1154.2 +022900 02 INF-ANSI-REFERENCE PIC X(48). NC1154.2 +023000 01 HYPHEN-LINE. NC1154.2 +023100 02 FILLER PIC IS X VALUE IS SPACE. NC1154.2 +023200 02 FILLER PIC IS X(65) VALUE IS "************************NC1154.2 +023300- "*****************************************". NC1154.2 +023400 02 FILLER PIC IS X(54) VALUE IS "************************NC1154.2 +023500- "******************************". NC1154.2 +023600 01 CCVS-PGM-ID PIC X(9) VALUE NC1154.2 +023700 "NC115A". NC1154.2 +023800 PROCEDURE DIVISION. NC1154.2 +023900 CCVS1 SECTION. NC1154.2 +024000 OPEN-FILES. NC1154.2 +024100 OPEN OUTPUT PRINT-FILE. NC1154.2 +024200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1154.2 +024300 MOVE SPACE TO TEST-RESULTS. NC1154.2 +024400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1154.2 +024500 GO TO CCVS1-EXIT. NC1154.2 +024600 CLOSE-FILES. NC1154.2 +024700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1154.2 +024800 TERMINATE-CCVS. NC1154.2 +024900*S EXIT PROGRAM. NC1154.2 +025000*SERMINATE-CALL. NC1154.2 +025100 STOP RUN. NC1154.2 +025200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1154.2 +025300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1154.2 +025400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1154.2 +025500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1154.2 +025600 MOVE "****TEST DELETED****" TO RE-MARK. NC1154.2 +025700 PRINT-DETAIL. NC1154.2 +025800 IF REC-CT NOT EQUAL TO ZERO NC1154.2 +025900 MOVE "." TO PARDOT-X NC1154.2 +026000 MOVE REC-CT TO DOTVALUE. NC1154.2 +026100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1154.2 +026200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1154.2 +026300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1154.2 +026400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1154.2 +026500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1154.2 +026600 MOVE SPACE TO CORRECT-X. NC1154.2 +026700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1154.2 +026800 MOVE SPACE TO RE-MARK. NC1154.2 +026900 HEAD-ROUTINE. NC1154.2 +027000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +027100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +027200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1154.2 +027300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1154.2 +027400 COLUMN-NAMES-ROUTINE. NC1154.2 +027500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +027600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +027800 END-ROUTINE. NC1154.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1154.2 +028000 END-RTN-EXIT. NC1154.2 +028100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +028200 END-ROUTINE-1. NC1154.2 +028300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1154.2 +028400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1154.2 +028500 ADD PASS-COUNTER TO ERROR-HOLD. NC1154.2 +028600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1154.2 +028700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1154.2 +028800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1154.2 +028900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1154.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1154.2 +029100 END-ROUTINE-12. NC1154.2 +029200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1154.2 +029300 IF ERROR-COUNTER IS EQUAL TO ZERO NC1154.2 +029400 MOVE "NO " TO ERROR-TOTAL NC1154.2 +029500 ELSE NC1154.2 +029600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1154.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1154.2 +029800 PERFORM WRITE-LINE. NC1154.2 +029900 END-ROUTINE-13. NC1154.2 +030000 IF DELETE-COUNTER IS EQUAL TO ZERO NC1154.2 +030100 MOVE "NO " TO ERROR-TOTAL ELSE NC1154.2 +030200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1154.2 +030300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1154.2 +030400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +030500 IF INSPECT-COUNTER EQUAL TO ZERO NC1154.2 +030600 MOVE "NO " TO ERROR-TOTAL NC1154.2 +030700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1154.2 +030800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1154.2 +030900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +031000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1154.2 +031100 WRITE-LINE. NC1154.2 +031200 ADD 1 TO RECORD-COUNT. NC1154.2 +031300 IF RECORD-COUNT GREATER 42 NC1154.2 +031400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1154.2 +031500 MOVE SPACE TO DUMMY-RECORD NC1154.2 +031600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1154.2 +031700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1154.2 +031800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1154.2 +031900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1154.2 +032000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1154.2 +032100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1154.2 +032200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1154.2 +032300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1154.2 +032400 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1154.2 +032500 MOVE ZERO TO RECORD-COUNT. NC1154.2 +032600 PERFORM WRT-LN. NC1154.2 +032700 WRT-LN. NC1154.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1154.2 +032900 MOVE SPACE TO DUMMY-RECORD. NC1154.2 +033000 BLANK-LINE-PRINT. NC1154.2 +033100 PERFORM WRT-LN. NC1154.2 +033200 FAIL-ROUTINE. NC1154.2 +033300 IF COMPUTED-X NOT EQUAL TO SPACE NC1154.2 +033400 GO TO FAIL-ROUTINE-WRITE. NC1154.2 +033500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1154.2 +033600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1154.2 +033700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1154.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1154.2 +034000 GO TO FAIL-ROUTINE-EX. NC1154.2 +034100 FAIL-ROUTINE-WRITE. NC1154.2 +034200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1154.2 +034300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1154.2 +034400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1154.2 +034500 MOVE SPACES TO COR-ANSI-REFERENCE. NC1154.2 +034600 FAIL-ROUTINE-EX. EXIT. NC1154.2 +034700 BAIL-OUT. NC1154.2 +034800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1154.2 +034900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1154.2 +035000 BAIL-OUT-WRITE. NC1154.2 +035100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1154.2 +035200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1154.2 +035300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1154.2 +035400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1154.2 +035500 BAIL-OUT-EX. EXIT. NC1154.2 +035600 CCVS1-EXIT. NC1154.2 +035700 EXIT. NC1154.2 +035800 SECT-NC115A-001 SECTION. NC1154.2 +035900 INSP-INIT-F1-1. NC1154.2 +036000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +036100 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +036200 INSP-TEST-F1-1-0. NC1154.2 +036300 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS. NC1154.2 +036400 INSP-TEST-F1-1-1. NC1154.2 +036500 IF WRK-DU-999-1 EQUAL TO 83 NC1154.2 +036600 PERFORM PASS NC1154.2 +036700 GO TO INSP-WRITE-F1-1. NC1154.2 +036800 GO TO INSP-FAIL-F1-1. NC1154.2 +036900 INSP-DELETE-F1-1. NC1154.2 +037000 PERFORM DE-LETE. NC1154.2 +037100 GO TO INSP-WRITE-F1-1. NC1154.2 +037200 INSP-FAIL-F1-1. NC1154.2 +037300 PERFORM FAIL. NC1154.2 +037400 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +037500 MOVE 83 TO CORRECT-N. NC1154.2 +037600 INSP-WRITE-F1-1. NC1154.2 +037700 MOVE "INSP-TEST-F1-1" TO PAR-NAME. NC1154.2 +037800 MOVE "TALLY FOR CHARACTERS" TO FEATURE. NC1154.2 +037900 PERFORM PRINT-DETAIL. NC1154.2 +038000 INSP-INIT-F1-2. NC1154.2 +038100 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +038200 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +038300 INSP-TEST-F1-2-0. NC1154.2 +038400 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL "A". NC1154.2 +038500 INSP-TEST-F1-2-1. NC1154.2 +038600 IF WRK-DU-999-1 EQUAL TO 8 NC1154.2 +038700 PERFORM PASS NC1154.2 +038800 GO TO INSP-WRITE-F1-2. NC1154.2 +038900 GO TO INSP-FAIL-F1-2. NC1154.2 +039000 INSP-DELETE-F1-2. NC1154.2 +039100 PERFORM DE-LETE. NC1154.2 +039200 GO TO INSP-WRITE-F1-2. NC1154.2 +039300 INSP-FAIL-F1-2. NC1154.2 +039400 PERFORM FAIL. NC1154.2 +039500 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +039600 MOVE 8 TO CORRECT-N. NC1154.2 +039700 INSP-WRITE-F1-2. NC1154.2 +039800 MOVE "INSP-TEST-F1-2" TO PAR-NAME. NC1154.2 +039900 MOVE "TALLY ALL LITERAL" TO FEATURE. NC1154.2 +040000 PERFORM PRINT-DETAIL. NC1154.2 +040100 INSP-INIT-F1-3. NC1154.2 +040200 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +040300 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +040400 INSP-TEST-F1-3-0. NC1154.2 +040500 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL SPACE. NC1154.2 +040600 INSP-TEST-F1-3-1. NC1154.2 +040700 IF WRK-DU-999-1 EQUAL TO 17 NC1154.2 +040800 PERFORM PASS NC1154.2 +040900 GO TO INSP-WRITE-F1-3. NC1154.2 +041000 GO TO INSP-FAIL-F1-3. NC1154.2 +041100 INSP-DELETE-F1-3. NC1154.2 +041200 PERFORM DE-LETE. NC1154.2 +041300 GO TO INSP-WRITE-F1-3. NC1154.2 +041400 INSP-FAIL-F1-3. NC1154.2 +041500 PERFORM FAIL. NC1154.2 +041600 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +041700 MOVE 17 TO CORRECT-N. NC1154.2 +041800 INSP-WRITE-F1-3. NC1154.2 +041900 MOVE "INSP-TEST-F1-3" TO PAR-NAME. NC1154.2 +042000 MOVE "TALLY FOR ALL SPACE" TO FEATURE. NC1154.2 +042100 PERFORM PRINT-DETAIL. NC1154.2 +042200 INSP-INIT-F1-4. NC1154.2 +042300 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +042400 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +042500 INSP-TEST-F1-4-0. NC1154.2 +042600 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR LEADING "A". NC1154.2 +042700 INSP-TEST-F1-4-1. NC1154.2 +042800 IF WRK-DU-999-1 EQUAL TO 1 NC1154.2 +042900 PERFORM PASS NC1154.2 +043000 GO TO INSP-WRITE-F1-4. NC1154.2 +043100 GO TO INSP-FAIL-F1-4. NC1154.2 +043200 INSP-DELETE-F1-4. NC1154.2 +043300 PERFORM DE-LETE. NC1154.2 +043400 GO TO INSP-WRITE-F1-4. NC1154.2 +043500 INSP-FAIL-F1-4. NC1154.2 +043600 PERFORM FAIL. NC1154.2 +043700 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +043800 MOVE 1 TO CORRECT-N. NC1154.2 +043900 INSP-WRITE-F1-4. NC1154.2 +044000 MOVE "INSP-TEST-F1-4" TO PAR-NAME. NC1154.2 +044100 MOVE "TALLY LEADING LIT" TO FEATURE. NC1154.2 +044200 PERFORM PRINT-DETAIL. NC1154.2 +044300 INSP-INIT-F1-5. NC1154.2 +044400 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +044500 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +044600 INSP-TEST-F1-5-0. NC1154.2 +044700 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +044800 AFTER "W". NC1154.2 +044900 INSP-TEST-F1-5-1. NC1154.2 +045000 IF WRK-DU-999-1 EQUAL TO 68 NC1154.2 +045100 PERFORM PASS NC1154.2 +045200 GO TO INSP-WRITE-F1-5. NC1154.2 +045300 GO TO INSP-FAIL-F1-5. NC1154.2 +045400 INSP-DELETE-F1-5. NC1154.2 +045500 PERFORM DE-LETE. NC1154.2 +045600 GO TO INSP-WRITE-F1-5. NC1154.2 +045700 INSP-FAIL-F1-5. NC1154.2 +045800 PERFORM FAIL. NC1154.2 +045900 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +046000 MOVE 68 TO CORRECT-N. NC1154.2 +046100 INSP-WRITE-F1-5. NC1154.2 +046200 MOVE "INSP-TEST-F1-5" TO PAR-NAME. NC1154.2 +046300 MOVE "FOR CHARS AFTER LIT" TO FEATURE. NC1154.2 +046400 PERFORM PRINT-DETAIL. NC1154.2 +046500 INSP-INIT-F1-6. NC1154.2 +046600 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +046700 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +046800 INSP-TEST-F1-6-0. NC1154.2 +046900 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL " " NC1154.2 +047000 BEFORE INITIAL "W". NC1154.2 +047100 INSP-TEST-F1-6-1. NC1154.2 +047200 IF WRK-DU-999-1 EQUAL TO 4 NC1154.2 +047300 PERFORM PASS NC1154.2 +047400 GO TO INSP-WRITE-F1-6. NC1154.2 +047500 GO TO INSP-FAIL-F1-6. NC1154.2 +047600 INSP-DELETE-F1-6. NC1154.2 +047700 PERFORM DE-LETE. NC1154.2 +047800 GO TO INSP-WRITE-F1-6. NC1154.2 +047900 INSP-FAIL-F1-6. NC1154.2 +048000 PERFORM FAIL. NC1154.2 +048100 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +048200 MOVE 4 TO CORRECT-N. NC1154.2 +048300 INSP-WRITE-F1-6. NC1154.2 +048400 MOVE "INSP-TEST-F1-6" TO PAR-NAME. NC1154.2 +048500 MOVE "ALL BEFORE INITIAL" TO FEATURE. NC1154.2 +048600 PERFORM PRINT-DETAIL. NC1154.2 +048700 INSP-INIT-F1-7. NC1154.2 +048800 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +048900 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +049000 INSP-TEST-F1-7-0. NC1154.2 +049100 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR LEADING "Y" NC1154.2 +049200 AFTER INITIAL SPACE. NC1154.2 +049300 INSP-TEST-F1-7-1. NC1154.2 +049400 IF WRK-DU-999-1 EQUAL TO 1 NC1154.2 +049500 PERFORM PASS NC1154.2 +049600 GO TO INSP-WRITE-F1-7. NC1154.2 +049700 GO TO INSP-FAIL-F1-7. NC1154.2 +049800 INSP-DELETE-F1-7. NC1154.2 +049900 PERFORM DE-LETE. NC1154.2 +050000 GO TO INSP-WRITE-F1-7. NC1154.2 +050100 INSP-FAIL-F1-7. NC1154.2 +050200 PERFORM FAIL. NC1154.2 +050300 MOVE WRK-DU-999-1 TO COMPUTED-N. NC1154.2 +050400 MOVE 1 TO CORRECT-N. NC1154.2 +050500 INSP-WRITE-F1-7. NC1154.2 +050600 MOVE "INSP-TEST-F1-7" TO PAR-NAME. NC1154.2 +050700 MOVE "LEAD LIT INITIAL FIG" TO FEATURE. NC1154.2 +050800 PERFORM PRINT-DETAIL. NC1154.2 +050900 INSP-INIT-F2-1. NC1154.2 +051000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +051100 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +051200 MOVE "INSP-TEST-F2-1" TO PAR-NAME. NC1154.2 +051300 MOVE "REP CHARS BY SPACE" TO FEATURE. NC1154.2 +051400 INSP-TEST-F2-1-0. NC1154.2 +051500 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY SPACE. NC1154.2 +051600 INSP-TEST-F2-1-1. NC1154.2 +051700 IF WRK-XN-83-1 EQUAL TO SPACE NC1154.2 +051800 PERFORM PASS NC1154.2 +051900 PERFORM PRINT-DETAIL NC1154.2 +052000 GO TO INSP-INIT-F2-2. NC1154.2 +052100 GO TO INSP-FAIL-F2-1. NC1154.2 +052200 INSP-DELETE-F2-1. NC1154.2 +052300 PERFORM DE-LETE. NC1154.2 +052400 PERFORM PRINT-DETAIL. NC1154.2 +052500 GO TO INSP-INIT-F2-2. NC1154.2 +052600 INSP-FAIL-F2-1. NC1154.2 +052700 PERFORM FAIL. NC1154.2 +052800 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +052900 MOVE SPACE TO WRK-OK. NC1154.2 +053000 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +053100 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +053200 PERFORM PRINT-DETAIL. NC1154.2 +053300 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +053400 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +053500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +053600 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +053700 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +053800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +053900 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +054000 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +054100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +054200 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +054300 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +054400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +054500 INSP-INIT-F2-2. NC1154.2 +054600 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +054700 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +054800 MOVE "INSP-TEST-F2-2" TO PAR-NAME. NC1154.2 +054900 MOVE "CHARS BEFORE INITIAL" TO FEATURE. NC1154.2 +055000 INSP-TEST-F2-2-0. NC1154.2 +055100 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY "O" NC1154.2 +055200 BEFORE INITIAL "H". NC1154.2 +055300 INSP-TEST-F2-2-1. NC1154.2 +055400 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC1154.2 +055500 PERFORM PASS NC1154.2 +055600 PERFORM PRINT-DETAIL NC1154.2 +055700 GO TO INSP-INIT-F2-3. NC1154.2 +055800 GO TO INSP-FAIL-F2-2. NC1154.2 +055900 INSP-DELETE-F2-2. NC1154.2 +056000 PERFORM DE-LETE. NC1154.2 +056100 PERFORM PRINT-DETAIL. NC1154.2 +056200 GO TO INSP-INIT-F2-3. NC1154.2 +056300 INSP-FAIL-F2-2. NC1154.2 +056400 PERFORM FAIL. NC1154.2 +056500 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +056600 MOVE ANS-XN-83-1 TO WRK-OK. NC1154.2 +056700 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +056800 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +056900 PERFORM PRINT-DETAIL. NC1154.2 +057000 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +057100 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +057200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +057300 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +057400 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +057500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +057600 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +057700 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +057800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +057900 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +058000 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +058100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +058200 INSP-INIT-F2-3. NC1154.2 +058300 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +058400 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +058500 MOVE "INSP-TEST-F2-3" TO PAR-NAME. NC1154.2 +058600 MOVE "LEAD AFTER INIT ID" TO FEATURE. NC1154.2 +058700 INSP-TEST-F2-3-0. NC1154.2 +058800 INSPECT WRK-XN-83-1 REPLACING LEADING SPACE-XN-1-1 NC1154.2 +058900 BY COMMA-XN-1-1 AFTER INITIAL S-XN-1-1. NC1154.2 +059000 INSP-TEST-F2-3-1. NC1154.2 +059100 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-2 NC1154.2 +059200 PERFORM PASS NC1154.2 +059300 PERFORM PRINT-DETAIL NC1154.2 +059400 GO TO INSP-INIT-F2-4. NC1154.2 +059500 GO TO INSP-FAIL-F2-3. NC1154.2 +059600 INSP-DELETE-F2-3. NC1154.2 +059700 PERFORM DE-LETE. NC1154.2 +059800 PERFORM PRINT-DETAIL. NC1154.2 +059900 GO TO INSP-INIT-F2-4. NC1154.2 +060000 INSP-FAIL-F2-3. NC1154.2 +060100 PERFORM FAIL. NC1154.2 +060200 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +060300 MOVE ANS-XN-83-2 TO WRK-OK. NC1154.2 +060400 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +060500 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +060600 PERFORM PRINT-DETAIL. NC1154.2 +060700 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +060800 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +060900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +061000 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +061100 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +061200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +061300 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +061400 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +061500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +061600 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +061700 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +061800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +061900 INSP-INIT-F2-4. NC1154.2 +062000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +062100 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +062200 MOVE "INSP-TEST-F2-4" TO PAR-NAME. NC1154.2 +062300 MOVE "FIRST BY ID BEFORE" TO FEATURE. NC1154.2 +062400 INSP-TEST-F2-4-0. NC1154.2 +062500 INSPECT WRK-XN-83-1 REPLACING FIRST "A" BY O-XN-1-1 NC1154.2 +062600 BEFORE INITIAL "H". NC1154.2 +062700 INSP-TEST-F2-4-1. NC1154.2 +062800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC1154.2 +062900 PERFORM PASS NC1154.2 +063000 PERFORM PRINT-DETAIL NC1154.2 +063100 GO TO INSP-INIT-F2-5. NC1154.2 +063200 GO TO INSP-FAIL-F2-4. NC1154.2 +063300 INSP-DELETE-F2-4. NC1154.2 +063400 PERFORM DE-LETE. NC1154.2 +063500 PERFORM PRINT-DETAIL. NC1154.2 +063600 GO TO INSP-INIT-F2-5. NC1154.2 +063700 INSP-FAIL-F2-4. NC1154.2 +063800 PERFORM FAIL. NC1154.2 +063900 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +064000 MOVE ANS-XN-83-1 TO WRK-OK. NC1154.2 +064100 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +064200 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +064300 PERFORM PRINT-DETAIL. NC1154.2 +064400 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +064500 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +064600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +064700 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +064800 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +064900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +065000 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +065100 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +065200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +065300 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +065400 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +065500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +065600 INSP-INIT-F2-5. NC1154.2 +065700 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +065800 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +065900 MOVE "INSP-TEST-F2-5" TO PAR-NAME. NC1154.2 +066000 MOVE "ALL ID BY LIT AFTER" TO FEATURE. NC1154.2 +066100 INSP-TEST-F2-5-0. NC1154.2 +066200 INSPECT WRK-XN-83-1 REPLACING ALL SPACE-XN-1-1 BY "-" NC1154.2 +066300 AFTER L-XN-1-1. NC1154.2 +066400 INSP-TEST-F2-5-1. NC1154.2 +066500 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-3 NC1154.2 +066600 PERFORM PASS NC1154.2 +066700 PERFORM PRINT-DETAIL NC1154.2 +066800 GO TO INSP-INIT-F3-1. NC1154.2 +066900 GO TO INSP-FAIL-F2-5. NC1154.2 +067000 INSP-DELETE-F2-5. NC1154.2 +067100 PERFORM DE-LETE. NC1154.2 +067200 PERFORM PRINT-DETAIL. NC1154.2 +067300 GO TO INSP-INIT-F3-1. NC1154.2 +067400 INSP-FAIL-F2-5. NC1154.2 +067500 PERFORM FAIL. NC1154.2 +067600 MOVE WRK-XN-83-1 TO WRK-ER. NC1154.2 +067700 MOVE ANS-XN-83-3 TO WRK-OK. NC1154.2 +067800 MOVE WRK-OK-1-20 TO CORRECT-X. NC1154.2 +067900 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1154.2 +068000 PERFORM PRINT-DETAIL. NC1154.2 +068100 MOVE WRK-OK-21-40 TO CORRECT-X. NC1154.2 +068200 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1154.2 +068300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +068400 MOVE WRK-OK-41-60 TO CORRECT-X. NC1154.2 +068500 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1154.2 +068600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +068700 MOVE WRK-OK-61-80 TO CORRECT-X. NC1154.2 +068800 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1154.2 +068900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +069000 MOVE WRK-OK-81-83 TO CORRECT-X. NC1154.2 +069100 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1154.2 +069200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +069300 INSP-INIT-F3-1. NC1154.2 +069400 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +069500 MOVE "INSP-TEST-F3-1" TO PAR-NAME. NC1154.2 +069600 MOVE "TALLY-REPLACE CHARS" TO FEATURE. NC1154.2 +069700 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +069800 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +069900 MOVE 1 TO REC-CT. NC1154.2 +070000 INSP-TEST-F3-1-0. NC1154.2 +070100 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +070200 REPLACING CHARACTERS BY " ". NC1154.2 +070300 GO TO TEST-F3-1-1. NC1154.2 +070400 INSP-DELETE-F3-1. NC1154.2 +070500 PERFORM DE-LETE. NC1154.2 +070600 PERFORM PRINT-DETAIL. NC1154.2 +070700 GO TO INSP-INIT-F3-2. NC1154.2 +070800 TEST-F3-1-1. NC1154.2 +070900 IF WRK-DU-999-1 EQUAL TO 83 NC1154.2 +071000 PERFORM PASS NC1154.2 +071100 PERFORM PRINT-DETAIL NC1154.2 +071200 ELSE NC1154.2 +071300 PERFORM FAIL NC1154.2 +071400 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +071500 MOVE 83 TO CORRECT-N NC1154.2 +071600 PERFORM PRINT-DETAIL. NC1154.2 +071700 ADD 1 TO REC-CT. NC1154.2 +071800 TEST-F3-1-2. NC1154.2 +071900 IF WRK-XN-83-1 EQUAL TO SPACE NC1154.2 +072000 PERFORM PASS NC1154.2 +072100 PERFORM PRINT-DETAIL NC1154.2 +072200 ELSE NC1154.2 +072300 PERFORM FAIL NC1154.2 +072400 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +072500 MOVE SPACES TO WRK-OK NC1154.2 +072600 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +072700 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +072800 PERFORM PRINT-DETAIL NC1154.2 +072900 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +073000 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +073100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +073200 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +073300 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +073400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +073500 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +073600 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +073700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +073800 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +073900 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +074000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +074100 INSP-INIT-F3-2. NC1154.2 +074200 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +074300 MOVE "INSP-TEST-F3-2" TO PAR-NAME. NC1154.2 +074400 MOVE "LIT BY BEFORE INIT" TO FEATURE. NC1154.2 +074500 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +074600 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +074700 MOVE 1 TO REC-CT. NC1154.2 +074800 INSP-TEST-F3-2-0. NC1154.2 +074900 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +075000 AFTER L-XN-1-1 REPLACING ALL "A" BY "E" BEFORE INITIAL NC1154.2 +075100 H-XN-1-1. NC1154.2 +075200 GO TO TEST-F3-2-1. NC1154.2 +075300 INSP-DELETE-F3-2. NC1154.2 +075400 PERFORM DE-LETE. NC1154.2 +075500 PERFORM PRINT-DETAIL. NC1154.2 +075600 GO TO INSP-INIT-F3-3. NC1154.2 +075700 TEST-F3-2-1. NC1154.2 +075800 IF WRK-DU-999-1 EQUAL TO 6 NC1154.2 +075900 PERFORM PASS NC1154.2 +076000 PERFORM PRINT-DETAIL NC1154.2 +076100 ELSE NC1154.2 +076200 PERFORM FAIL NC1154.2 +076300 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +076400 MOVE 6 TO CORRECT-N NC1154.2 +076500 PERFORM PRINT-DETAIL. NC1154.2 +076600 ADD 1 TO REC-CT. NC1154.2 +076700 TEST-F3-2-2. NC1154.2 +076800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-4 NC1154.2 +076900 PERFORM PASS NC1154.2 +077000 PERFORM PRINT-DETAIL NC1154.2 +077100 ELSE NC1154.2 +077200 PERFORM FAIL NC1154.2 +077300 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +077400 MOVE ANS-XN-83-4 TO WRK-OK NC1154.2 +077500 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +077600 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +077700 PERFORM PRINT-DETAIL NC1154.2 +077800 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +077900 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +078000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +078100 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +078200 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +078300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +078400 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +078500 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +078600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +078700 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +078800 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +078900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +079000 INSP-INIT-F3-3. NC1154.2 +079100 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +079200 MOVE "INSP-TEST-F3-3" TO PAR-NAME. NC1154.2 +079300 MOVE "REPL FIRST AFTER" TO FEATURE. NC1154.2 +079400 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +079500 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +079600 MOVE 1 TO REC-CT. NC1154.2 +079700 INSP-TEST-F3-3-0. NC1154.2 +079800 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" BEFORE NC1154.2 +079900 L-XN-1-1 REPLACING FIRST A-XN-1-1 BY "O" AFTER NC1154.2 +080000 INITIAL H-XN-1-1. NC1154.2 +080100 GO TO TEST-F3-3-1. NC1154.2 +080200 INSP-DELETE-F3-3. NC1154.2 +080300 PERFORM DE-LETE. NC1154.2 +080400 PERFORM PRINT-DETAIL. NC1154.2 +080500 GO TO INSP-INIT-F3-4. NC1154.2 +080600 TEST-F3-3-1. NC1154.2 +080700 IF WRK-DU-999-1 EQUAL TO 7 NC1154.2 +080800 PERFORM PASS NC1154.2 +080900 PERFORM PRINT-DETAIL NC1154.2 +081000 ELSE NC1154.2 +081100 PERFORM FAIL NC1154.2 +081200 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +081300 MOVE 7 TO CORRECT-N NC1154.2 +081400 PERFORM PRINT-DETAIL. NC1154.2 +081500 ADD 1 TO REC-CT. NC1154.2 +081600 TEST-F3-3-2. NC1154.2 +081700 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC1154.2 +081800 PERFORM PASS NC1154.2 +081900 PERFORM PRINT-DETAIL NC1154.2 +082000 ELSE NC1154.2 +082100 PERFORM FAIL NC1154.2 +082200 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +082300 MOVE ANS-XN-83-5 TO WRK-OK NC1154.2 +082400 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +082500 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +082600 PERFORM PRINT-DETAIL NC1154.2 +082700 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +082800 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +082900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +083000 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +083100 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +083200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +083300 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +083400 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +083500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +083600 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +083700 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +083800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +083900 INSP-INIT-F3-4. NC1154.2 +084000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +084100 MOVE "INSP-TEST-F3-4" TO PAR-NAME. NC1154.2 +084200 MOVE "FOR LEADING" TO FEATURE. NC1154.2 +084300 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +084400 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +084500 MOVE 1 TO REC-CT. NC1154.2 +084600 INSP-TEST-F3-4-0. NC1154.2 +084700 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR LEADING NC1154.2 +084800 A-XN-1-1 REPLACING LEADING A-XN-1-1 BY "O". NC1154.2 +084900 GO TO TEST-F3-4-1. NC1154.2 +085000 INSP-DELETE-F3-4. NC1154.2 +085100 PERFORM DE-LETE. NC1154.2 +085200 PERFORM PRINT-DETAIL. NC1154.2 +085300 GO TO INSP-INIT-F3-5. NC1154.2 +085400 TEST-F3-4-1. NC1154.2 +085500 IF WRK-DU-999-1 EQUAL TO 1 NC1154.2 +085600 PERFORM PASS NC1154.2 +085700 PERFORM PRINT-DETAIL NC1154.2 +085800 ELSE NC1154.2 +085900 PERFORM FAIL NC1154.2 +086000 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +086100 MOVE 1 TO CORRECT-N NC1154.2 +086200 PERFORM PRINT-DETAIL. NC1154.2 +086300 ADD 1 TO REC-CT. NC1154.2 +086400 TEST-F3-4-2. NC1154.2 +086500 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC1154.2 +086600 PERFORM PASS NC1154.2 +086700 PERFORM PRINT-DETAIL NC1154.2 +086800 ELSE NC1154.2 +086900 PERFORM FAIL NC1154.2 +087000 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +087100 MOVE ANS-XN-83-1 TO WRK-OK NC1154.2 +087200 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +087300 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +087400 PERFORM PRINT-DETAIL NC1154.2 +087500 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +087600 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +087700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +087800 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +087900 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +088000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +088100 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +088200 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +088300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +088400 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +088500 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +088600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +088700 INSP-INIT-F3-5. NC1154.2 +088800 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +088900 MOVE "INSP-TEST-F3-5" TO PAR-NAME. NC1154.2 +089000 MOVE "LIT BY AFTER INIT" TO FEATURE. NC1154.2 +089100 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +089200 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +089300 MOVE 1 TO REC-CT. NC1154.2 +089400 INSP-TEST-F3-5-0. NC1154.2 +089500 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" NC1154.2 +089600 REPLACING FIRST "A" BY "O" AFTER INITIAL "Y". NC1154.2 +089700 GO TO TEST-F3-5-1. NC1154.2 +089800 INSP-DELETE-F3-5. NC1154.2 +089900 PERFORM DE-LETE. NC1154.2 +090000 PERFORM PRINT-DETAIL. NC1154.2 +090100 GO TO INSP-INIT-F3-6. NC1154.2 +090200 TEST-F3-5-1. NC1154.2 +090300 IF WRK-DU-999-1 EQUAL TO 8 NC1154.2 +090400 PERFORM PASS NC1154.2 +090500 PERFORM PRINT-DETAIL NC1154.2 +090600 ELSE NC1154.2 +090700 PERFORM FAIL NC1154.2 +090800 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +090900 MOVE 8 TO CORRECT-N NC1154.2 +091000 PERFORM PRINT-DETAIL. NC1154.2 +091100 ADD 1 TO REC-CT. NC1154.2 +091200 TEST-F3-5-2. NC1154.2 +091300 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC1154.2 +091400 PERFORM PASS NC1154.2 +091500 PERFORM PRINT-DETAIL NC1154.2 +091600 ELSE NC1154.2 +091700 PERFORM FAIL NC1154.2 +091800 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +091900 MOVE ANS-XN-83-5 TO WRK-OK NC1154.2 +092000 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +092100 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +092200 PERFORM PRINT-DETAIL NC1154.2 +092300 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +092400 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +092500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +092600 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +092700 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +092800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +092900 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +093000 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +093100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +093200 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +093300 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +093400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +093500 INSP-INIT-F3-6. NC1154.2 +093600 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +093700 MOVE "INSP-TEST-F3-6" TO PAR-NAME. NC1154.2 +093800 MOVE "CHAR AFTER ALL BEF" TO FEATURE. NC1154.2 +093900 MOVE ZERO TO WRK-DU-999-1. NC1154.2 +094000 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +094100 MOVE 1 TO REC-CT. NC1154.2 +094200 INSP-TEST-F3-6-0. NC1154.2 +094300 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +094400 AFTER A-XN-1-1 REPLACING ALL "A" BY "O" BEFORE H-XN-1-1. NC1154.2 +094500 GO TO TEST-F3-6-1. NC1154.2 +094600 INSP-DELETE-F3-6. NC1154.2 +094700 PERFORM DE-LETE. NC1154.2 +094800 PERFORM PRINT-DETAIL. NC1154.2 +094900 GO TO INSP-INIT-F3-7. NC1154.2 +095000 TEST-F3-6-1. NC1154.2 +095100 IF WRK-DU-999-1 EQUAL TO 82 NC1154.2 +095200 PERFORM PASS NC1154.2 +095300 PERFORM PRINT-DETAIL NC1154.2 +095400 ELSE NC1154.2 +095500 PERFORM FAIL NC1154.2 +095600 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +095700 MOVE 82 TO CORRECT-N NC1154.2 +095800 PERFORM PRINT-DETAIL. NC1154.2 +095900 ADD 1 TO REC-CT. NC1154.2 +096000 TEST-F3-6-2. NC1154.2 +096100 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC1154.2 +096200 PERFORM PASS NC1154.2 +096300 PERFORM PRINT-DETAIL NC1154.2 +096400 ELSE NC1154.2 +096500 PERFORM FAIL NC1154.2 +096600 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +096700 MOVE ANS-XN-83-1 TO WRK-OK NC1154.2 +096800 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +096900 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +097000 PERFORM PRINT-DETAIL NC1154.2 +097100 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +097200 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +097300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +097400 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +097500 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +097600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +097700 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +097800 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +097900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +098000 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +098100 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +098200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +098300 INSP-INIT-F3-7. NC1154.2 +098400 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +098500 MOVE ZERO TO WRK-DU-999-1 WRK-DU-999-2 WRK-DU-999-3 NC1154.2 +098600 WRK-DU-999-4. NC1154.2 +098700 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +098800 MOVE "INSP-TEST-F3-7" TO PAR-NAME. NC1154.2 +098900 MOVE "TALLY SERIES" TO FEATURE. NC1154.2 +099000 MOVE 1 TO REC-CT. NC1154.2 +099100 INSP-TEST-F3-7-0. NC1154.2 +099200 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A". NC1154.2 +099300 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-2 FOR LEADING "A". NC1154.2 +099400 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-3 FOR CHARACTERS NC1154.2 +099500 BEFORE ".". NC1154.2 +099600 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-4 FOR CHARACTERS NC1154.2 +099700 AFTER "L". NC1154.2 +099800 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY "Z" AFTER "L". NC1154.2 +099900 GO TO INSP-TEST-F3-7-1. NC1154.2 +100000 INSP-DELETE-F3-7. NC1154.2 +100100 PERFORM DE-LETE. NC1154.2 +100200 PERFORM PRINT-DETAIL. NC1154.2 +100300 GO TO INSP-INIT-F3-8. NC1154.2 +100400 INSP-TEST-F3-7-1. NC1154.2 +100500 IF WRK-DU-999-1 EQUAL TO 8 PERFORM PASS PERFORM PRINT-DETAIL NC1154.2 +100600 ELSE NC1154.2 +100700 PERFORM FAIL MOVE WRK-DU-999-1 TO COMPUTED-N MOVE 8 NC1154.2 +100800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1154.2 +100900 ADD 1 TO REC-CT. NC1154.2 +101000 INSP-TEST-F3-7-2. NC1154.2 +101100 IF WRK-DU-999-2 EQUAL TO 1 PERFORM PASS PERFORM PRINT-DETAIL NC1154.2 +101200 ELSE NC1154.2 +101300 PERFORM FAIL MOVE WRK-DU-999-2 TO COMPUTED-N MOVE 1 NC1154.2 +101400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1154.2 +101500 ADD 1 TO REC-CT. NC1154.2 +101600 INSP-TEST-F3-7-3. NC1154.2 +101700 IF WRK-DU-999-3 EQUAL TO 15 PERFORM PASS PERFORM PRINT-DETAILNC1154.2 +101800 ELSE NC1154.2 +101900 PERFORM FAIL MOVE WRK-DU-999-3 TO COMPUTED-N MOVE 15 NC1154.2 +102000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1154.2 +102100 ADD 1 TO REC-CT. NC1154.2 +102200 INSP-TEST-F3-7-4. NC1154.2 +102300 IF WRK-DU-999-4 EQUAL TO 6 PERFORM PASS PERFORM PRINT-DETAIL NC1154.2 +102400 ELSE NC1154.2 +102500 PERFORM FAIL MOVE WRK-DU-999-4 TO COMPUTED-N MOVE 6 NC1154.2 +102600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1154.2 +102700 ADD 1 TO REC-CT. NC1154.2 +102800 INSP-TEST-F3-7-5. NC1154.2 +102900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-6 PERFORM PASS PERFORM NC1154.2 +103000 PRINT-DETAIL ELSE NC1154.2 +103100 PERFORM FAIL NC1154.2 +103200 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +103300 MOVE ANS-XN-83-6 TO WRK-OK NC1154.2 +103400 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +103500 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +103600 PERFORM PRINT-DETAIL NC1154.2 +103700 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +103800 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +103900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +104000 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +104100 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +104200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +104300 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +104400 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +104500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +104600 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +104700 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +104800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +104900 INSP-INIT-F3-8. NC1154.2 +105000 MOVE "VI-95 6.17.4" TO ANSI-REFERENCE. NC1154.2 +105100 MOVE "INSP-TEST-F3-8" TO PAR-NAME. NC1154.2 +105200 MOVE "REPLACE SERIES" TO FEATURE. NC1154.2 +105300 MOVE ZERO TO REC-CT WRK-DU-999-1. NC1154.2 +105400 MOVE WC-XN-83 TO WRK-XN-83-1. NC1154.2 +105500 MOVE 1 TO REC-CT. NC1154.2 +105600 INSP-TEST-F3-8-0. NC1154.2 +105700 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC1154.2 +105800 BEFORE "." REPLACING CHARACTERS BY Z-XN-1-1 AFTER NC1154.2 +105900 L-XN-1-1. NC1154.2 +106000 INSPECT WRK-XN-83-1 REPLACING ALL " " BY HYPEN-XN-1-1. NC1154.2 +106100 INSPECT WRK-XN-83-1 REPLACING FIRST "C" BY P-XN-1-1. NC1154.2 +106200 INSPECT WRK-XN-83-1 REPLACING LEADING A-XN-1-1 BY O-XN-1-1. NC1154.2 +106300 INSPECT WRK-XN-83-1 REPLACING ALL "F" BY "Z" BEFORE G-XN-1-1.NC1154.2 +106400 GO TO TEST-F3-8-1. NC1154.2 +106500 INSP-DELETE-F3-8. NC1154.2 +106600 PERFORM DE-LETE. NC1154.2 +106700 PERFORM PRINT-DETAIL. NC1154.2 +106800 GO TO CCVS-999999. NC1154.2 +106900 TEST-F3-8-1. NC1154.2 +107000 IF WRK-DU-999-1 EQUAL TO 15 NC1154.2 +107100 PERFORM PASS NC1154.2 +107200 PERFORM PRINT-DETAIL NC1154.2 +107300 ELSE NC1154.2 +107400 PERFORM FAIL NC1154.2 +107500 MOVE WRK-DU-999-1 TO COMPUTED-N NC1154.2 +107600 MOVE 15 TO CORRECT-N NC1154.2 +107700 PERFORM PRINT-DETAIL. NC1154.2 +107800 ADD 1 TO REC-CT. NC1154.2 +107900 TEST-F3-8-2. NC1154.2 +108000 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-7 NC1154.2 +108100 PERFORM PASS NC1154.2 +108200 PERFORM PRINT-DETAIL NC1154.2 +108300 ELSE NC1154.2 +108400 PERFORM FAIL NC1154.2 +108500 MOVE WRK-XN-83-1 TO WRK-ER NC1154.2 +108600 MOVE ANS-XN-83-7 TO WRK-OK NC1154.2 +108700 MOVE WRK-OK-1-20 TO CORRECT-X NC1154.2 +108800 MOVE WRK-ER-1-20 TO COMPUTED-X NC1154.2 +108900 PERFORM PRINT-DETAIL NC1154.2 +109000 MOVE WRK-OK-21-40 TO CORRECT-X NC1154.2 +109100 MOVE WRK-ER-21-40 TO COMPUTED-X NC1154.2 +109200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +109300 MOVE WRK-OK-41-60 TO CORRECT-X NC1154.2 +109400 MOVE WRK-ER-41-60 TO COMPUTED-X NC1154.2 +109500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +109600 MOVE WRK-OK-61-80 TO CORRECT-X NC1154.2 +109700 MOVE WRK-ER-61-80 TO COMPUTED-X NC1154.2 +109800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1154.2 +109900 MOVE WRK-OK-81-83 TO CORRECT-X NC1154.2 +110000 MOVE WRK-ER-81-83 TO COMPUTED-X NC1154.2 +110100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1154.2 +110200 CCVS-EXIT SECTION. NC1154.2 +110300 CCVS-999999. NC1154.2 +110400 GO TO CLOSE-FILES. NC1154.2 diff --git a/tests/cobol85/NC/NC116A.CBL b/tests/cobol85/NC/NC116A.CBL new file mode 100755 index 00000000..a8fe7c22 --- /dev/null +++ b/tests/cobol85/NC/NC116A.CBL @@ -0,0 +1,1493 @@ +000100 IDENTIFICATION DIVISION. NC1164.2 +000200 PROGRAM-ID. NC1164.2 +000300 NC116A. NC1164.2 +000400**************************************************************** NC1164.2 +000500* * NC1164.2 +000600* VALIDATION FOR:- * NC1164.2 +000700* * NC1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1164.2 +000900* * NC1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1164.2 +001100* * NC1164.2 +001200**************************************************************** NC1164.2 +001300* * NC1164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1164.2 +001500* * NC1164.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1164.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1164.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1164.2 +001900* * NC1164.2 +002000**************************************************************** NC1164.2 +002100* NC1164.2 +002200* PROGRAM NC116A TESTS THE USE OF THE SIGN CLAUSE NC1164.2 +002300* USING THE "IF" AND "MOVE" STATEMENTS. ALL COMBINATIONS NC1164.2 +002400* OF THE SIGN CLAUSE PHRASES ARE TESTED USING DATA ITEMS OF NC1164.2 +002500* VARIOUS LENGTHS. NC1164.2 +002600* NC1164.2 +002700 ENVIRONMENT DIVISION. NC1164.2 +002800 CONFIGURATION SECTION. NC1164.2 +002900 SOURCE-COMPUTER. NC1164.2 +003000 Linux. NC1164.2 +003100 OBJECT-COMPUTER. NC1164.2 +003200 Linux. NC1164.2 +003300 INPUT-OUTPUT SECTION. NC1164.2 +003400 FILE-CONTROL. NC1164.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1164.2 +003600 "report.log". NC1164.2 +003700 DATA DIVISION. NC1164.2 +003800 FILE SECTION. NC1164.2 +003900 FD PRINT-FILE. NC1164.2 +004000 01 PRINT-REC PICTURE X(120). NC1164.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1164.2 +004200 WORKING-STORAGE SECTION. NC1164.2 +004300*======================= NC1164.2 +004400 01 TEST-17-DATA SIGN TRAILING. NC1164.2 +004500 03 TEST-17-A PIC S9(4). NC1164.2 +004600 03 TEST-17-B PIC S9(4). NC1164.2 +004700 03 TEST-17-GROUP SIGN LEADING SEPARATE. NC1164.2 +004800 05 TEST-17-C PIC S9(4). NC1164.2 +004900 05 FILLER REDEFINES TEST-17-C. NC1164.2 +005000 07 TEST-17-C-SIGN PIC X. NC1164.2 +005100 07 FILLER PIC X(4). NC1164.2 +005200 NC1164.2 +005300 01 TEST-18-DATA SIGN TRAILING. NC1164.2 +005400 03 TEST-18-A PIC S9(4). NC1164.2 +005500 03 TEST-18-B PIC S9(4) SIGN LEADING SEPARATE. NC1164.2 +005600 03 TEST-18-BX REDEFINES TEST-18-B. NC1164.2 +005700 05 TEST-18-B-SIGN PIC X. NC1164.2 +005800 05 FILLER PIC X(4). NC1164.2 +005900 03 TEST-18-C PIC S9(4). NC1164.2 +006000 01 DS-LS-5 PICTURE S99999 NC1164.2 +006100 SIGN IS LEADING SEPARATE CHARACTER NC1164.2 +006200 VALUE +91275. NC1164.2 +006300 01 GRP-001 REDEFINES DS-LS-5. NC1164.2 +006400 02 TEST1-AN-1 PICTURE X. NC1164.2 +006500 02 TEST1-AN-5 PICTURE X(5). NC1164.2 +006600 01 DS-LS-4 PICTURE S9999 NC1164.2 +006700 SIGN IS LEADING SEPARATE CHARACTER NC1164.2 +006800 VALUE -9127. NC1164.2 +006900 01 GRP-002 REDEFINES DS-LS-4. NC1164.2 +007000 02 TEST1N-AN-1 PICTURE X. NC1164.2 +007100 02 TEST1N-AN-4 PICTURE X(4). NC1164.2 +007200 01 DS-TS-5 PICTURE S99999 NC1164.2 +007300 SIGN IS TRAILING SEPARATE CHARACTER NC1164.2 +007400 VALUE +80361. NC1164.2 +007500 01 GRP-003 REDEFINES DS-TS-5. NC1164.2 +007600 02 TEST2-AN-5 PICTURE X(5). NC1164.2 +007700 02 TEST2-AN-1 PICTURE X. NC1164.2 +007800 01 DS-TS-4 PICTURE S9999 NC1164.2 +007900 SIGN IS TRAILING SEPARATE CHARACTER NC1164.2 +008000 VALUE -8036. NC1164.2 +008100 01 GRP-004 REDEFINES DS-TS-4. NC1164.2 +008200 02 TEST2N-AN-4 PICTURE X(4). NC1164.2 +008300 02 TEST2N-AN-1 PICTURE X. NC1164.2 +008400 01 DS-L-5 PICTURE S99999 VALUE +91275 NC1164.2 +008500 SIGN IS LEADING. NC1164.2 +008600 01 GRP-005 REDEFINES DS-L-5. NC1164.2 +008700 02 TEST3-AN-1 PICTURE X. NC1164.2 +008800 02 TEST3-AN-4 PICTURE X(4). NC1164.2 +008900 01 DS-L-4 PICTURE S9999 VALUE -9127 NC1164.2 +009000 SIGN IS LEADING. NC1164.2 +009100 01 GRP-006 REDEFINES DS-L-4. NC1164.2 +009200 02 TEST3N-AN-1 PICTURE X. NC1164.2 +009300 02 TEST3N-AN-3 PICTURE XXX. NC1164.2 +009400 01 DS-T-5 PICTURE S99999 VALUE +83621 NC1164.2 +009500 SIGN IS TRAILING. NC1164.2 +009600 01 GRP-007 REDEFINES DS-T-5. NC1164.2 +009700 02 TEST4-AN-4 PICTURE X(4). NC1164.2 +009800 02 TEST4-AN-1 PICTURE X. NC1164.2 +009900 01 DS-T-4 PICTURE S9999 VALUE -3621 NC1164.2 +010000 SIGN IS TRAILING. NC1164.2 +010100 01 GRP-008 REDEFINES DS-T-4. NC1164.2 +010200 02 TEST4N-AN-3 PICTURE XXX. NC1164.2 +010300 02 TEST4N-AN-1 PICTURE X. NC1164.2 +010400 01 DU-005 PICTURE 9(5) VALUE ZERO. NC1164.2 +010500 01 DS-005 PICTURE S9(5) VALUE 0. NC1164.2 +010600 01 CU-005 PICTURE 9(5) USAGE COMPUTATIONAL VALUE 0. NC1164.2 +010700 01 CS-005 PICTURE S9(5) USAGE COMPUTATIONAL VALUE 0. NC1164.2 +010800 01 WRK-DS-LS-5 PICTURE S99999 VALUE ZERO NC1164.2 +010900 SIGN LEADING SEPARATE. NC1164.2 +011000 01 GRP-09 REDEFINES WRK-DS-LS-5 PICTURE X(6). NC1164.2 +011100 01 WRK-DS-TS-5 PICTURE S99999 VALUE ZERO NC1164.2 +011200 SIGN TRAILING SEPARATE. NC1164.2 +011300 01 GRP-10 REDEFINES WRK-DS-TS-5 PICTURE X(6). NC1164.2 +011400 01 WRK-DS-L-5 PICTURE S99999 VALUE ZERO NC1164.2 +011500 SIGN LEADING. NC1164.2 +011600 01 WRK-DS-T-5 PICTURE S99999 VALUE ZERO NC1164.2 +011700 SIGN TRAILING. NC1164.2 +011800 01 AN-006 PICTURE X(6) VALUE SPACE. NC1164.2 +011900 01 DS-L-00008 PIC S9(8) SIGN LEADING VALUE +01234567. NC1164.2 +012000 01 AN-00008-X-1 REDEFINES DS-L-00008 PIC X(8). NC1164.2 +012100 01 DS-T-00008 PIC S9(8) SIGN TRAILING VALUE -01234567. NC1164.2 +012200 01 AN-00008-X-2 REDEFINES DS-T-00008 PIC X(8). NC1164.2 +012300 01 DS-T-00008-1 PIC S9(8) SIGN TRAILING VALUE +01234567. NC1164.2 +012400 01 AN-00008-X-5 REDEFINES DS-T-00008-1 PIC X(8). NC1164.2 +012500 01 DS-LS-00008 PIC S9(8) NC1164.2 +012600 SIGN IS LEADING SEPARATE CHARACTER NC1164.2 +012700 VALUE -07654321. NC1164.2 +012800 01 AN-00009-X-3 REDEFINES DS-LS-00008 PIC X(9). NC1164.2 +012900 01 DS-LS-00008-1 PIC S9(8) NC1164.2 +013000 SIGN IS LEADING SEPARATE CHARACTER NC1164.2 +013100 VALUE +07654321. NC1164.2 +013200 01 AN-00009-X-6 REDEFINES DS-LS-00008-1 PIC X(9). NC1164.2 +013300 01 DS-TS-00008 PIC S9(8) NC1164.2 +013400 SIGN TRAILING SEPARATE NC1164.2 +013500 VALUE +07654321. NC1164.2 +013600 01 AN-00009-X-4 REDEFINES DS-TS-00008 PIC X(9). NC1164.2 +013700 01 CS-00007-1 PIC S9(7) COMPUTATIONAL VALUE +1234567. NC1164.2 +013800 01 CU-00007-1 PIC 9(7) COMPUTATIONAL VALUE 1234567. NC1164.2 +013900 01 DS-00007-1 PIC S9(7) DISPLAY VALUE +1234567. NC1164.2 +014000 01 DU-00007-1 PIC 9(7) DISPLAY VALUE 1234567. NC1164.2 +014100 01 CS-00007-2 PIC S9(7) COMPUTATIONAL VALUE -1234567. NC1164.2 +014200 01 CU-00007-2 PIC 9(7) COMPUTATIONAL VALUE 1234567. NC1164.2 +014300 01 DS-00007-2 PIC S9(7) DISPLAY VALUE -1234567. NC1164.2 +014400 01 DU-00007-2 PIC 9(7) DISPLAY VALUE 1234567. NC1164.2 +014500 01 CS-00007-3 PIC S9(7) COMPUTATIONAL VALUE -7654321. NC1164.2 +014600 01 CU-00007-3 PIC 9(7) COMPUTATIONAL VALUE 7654321. NC1164.2 +014700 01 DS-00007-3 PIC S9(7) DISPLAY VALUE -7654321. NC1164.2 +014800 01 DU-00007-3 PIC 9(7) DISPLAY VALUE 7654321. NC1164.2 +014900 01 CS-00007-4 PIC S9(7) COMPUTATIONAL VALUE +7654321. NC1164.2 +015000 01 CU-00007-4 PIC 9(7) COMPUTATIONAL VALUE 7654321. NC1164.2 +015100 01 DS-00007-4 PIC S9(7) DISPLAY VALUE +7654321. NC1164.2 +015200 01 DU-00007-4 PIC 9(7) DISPLAY VALUE 7654321. NC1164.2 +015300 01 TEST-RESULTS. NC1164.2 +015400 02 FILLER PIC X VALUE SPACE. NC1164.2 +015500 02 FEATURE PIC X(20) VALUE SPACE. NC1164.2 +015600 02 FILLER PIC X VALUE SPACE. NC1164.2 +015700 02 P-OR-F PIC X(5) VALUE SPACE. NC1164.2 +015800 02 FILLER PIC X VALUE SPACE. NC1164.2 +015900 02 PAR-NAME. NC1164.2 +016000 03 FILLER PIC X(19) VALUE SPACE. NC1164.2 +016100 03 PARDOT-X PIC X VALUE SPACE. NC1164.2 +016200 03 DOTVALUE PIC 99 VALUE ZERO. NC1164.2 +016300 02 FILLER PIC X(8) VALUE SPACE. NC1164.2 +016400 02 RE-MARK PIC X(61). NC1164.2 +016500 01 TEST-COMPUTED. NC1164.2 +016600 02 FILLER PIC X(30) VALUE SPACE. NC1164.2 +016700 02 FILLER PIC X(17) VALUE NC1164.2 +016800 " COMPUTED=". NC1164.2 +016900 02 COMPUTED-X. NC1164.2 +017000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1164.2 +017100 03 COMPUTED-N REDEFINES COMPUTED-A NC1164.2 +017200 PIC -9(9).9(9). NC1164.2 +017300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1164.2 +017400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1164.2 +017500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1164.2 +017600 03 CM-18V0 REDEFINES COMPUTED-A. NC1164.2 +017700 04 COMPUTED-18V0 PIC -9(18). NC1164.2 +017800 04 FILLER PIC X. NC1164.2 +017900 03 FILLER PIC X(50) VALUE SPACE. NC1164.2 +018000 01 TEST-CORRECT. NC1164.2 +018100 02 FILLER PIC X(30) VALUE SPACE. NC1164.2 +018200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1164.2 +018300 02 CORRECT-X. NC1164.2 +018400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1164.2 +018500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1164.2 +018600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1164.2 +018700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1164.2 +018800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1164.2 +018900 03 CR-18V0 REDEFINES CORRECT-A. NC1164.2 +019000 04 CORRECT-18V0 PIC -9(18). NC1164.2 +019100 04 FILLER PIC X. NC1164.2 +019200 03 FILLER PIC X(2) VALUE SPACE. NC1164.2 +019300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1164.2 +019400 01 CCVS-C-1. NC1164.2 +019500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1164.2 +019600- "SS PARAGRAPH-NAME NC1164.2 +019700- " REMARKS". NC1164.2 +019800 02 FILLER PIC X(20) VALUE SPACE. NC1164.2 +019900 01 CCVS-C-2. NC1164.2 +020000 02 FILLER PIC X VALUE SPACE. NC1164.2 +020100 02 FILLER PIC X(6) VALUE "TESTED". NC1164.2 +020200 02 FILLER PIC X(15) VALUE SPACE. NC1164.2 +020300 02 FILLER PIC X(4) VALUE "FAIL". NC1164.2 +020400 02 FILLER PIC X(94) VALUE SPACE. NC1164.2 +020500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1164.2 +020600 01 REC-CT PIC 99 VALUE ZERO. NC1164.2 +020700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1164.2 +020800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1164.2 +020900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1164.2 +021000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1164.2 +021100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1164.2 +021200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1164.2 +021300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1164.2 +021400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1164.2 +021500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1164.2 +021600 01 CCVS-H-1. NC1164.2 +021700 02 FILLER PIC X(39) VALUE SPACES. NC1164.2 +021800 02 FILLER PIC X(42) VALUE NC1164.2 +021900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1164.2 +022000 02 FILLER PIC X(39) VALUE SPACES. NC1164.2 +022100 01 CCVS-H-2A. NC1164.2 +022200 02 FILLER PIC X(40) VALUE SPACE. NC1164.2 +022300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1164.2 +022400 02 FILLER PIC XXXX VALUE NC1164.2 +022500 "4.2 ". NC1164.2 +022600 02 FILLER PIC X(28) VALUE NC1164.2 +022700 " COPY - NOT FOR DISTRIBUTION". NC1164.2 +022800 02 FILLER PIC X(41) VALUE SPACE. NC1164.2 +022900 NC1164.2 +023000 01 CCVS-H-2B. NC1164.2 +023100 02 FILLER PIC X(15) VALUE NC1164.2 +023200 "TEST RESULT OF ". NC1164.2 +023300 02 TEST-ID PIC X(9). NC1164.2 +023400 02 FILLER PIC X(4) VALUE NC1164.2 +023500 " IN ". NC1164.2 +023600 02 FILLER PIC X(12) VALUE NC1164.2 +023700 " HIGH ". NC1164.2 +023800 02 FILLER PIC X(22) VALUE NC1164.2 +023900 " LEVEL VALIDATION FOR ". NC1164.2 +024000 02 FILLER PIC X(58) VALUE NC1164.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1164.2 +024200 01 CCVS-H-3. NC1164.2 +024300 02 FILLER PIC X(34) VALUE NC1164.2 +024400 " FOR OFFICIAL USE ONLY ". NC1164.2 +024500 02 FILLER PIC X(58) VALUE NC1164.2 +024600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1164.2 +024700 02 FILLER PIC X(28) VALUE NC1164.2 +024800 " COPYRIGHT 1985 ". NC1164.2 +024900 01 CCVS-E-1. NC1164.2 +025000 02 FILLER PIC X(52) VALUE SPACE. NC1164.2 +025100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1164.2 +025200 02 ID-AGAIN PIC X(9). NC1164.2 +025300 02 FILLER PIC X(45) VALUE SPACES. NC1164.2 +025400 01 CCVS-E-2. NC1164.2 +025500 02 FILLER PIC X(31) VALUE SPACE. NC1164.2 +025600 02 FILLER PIC X(21) VALUE SPACE. NC1164.2 +025700 02 CCVS-E-2-2. NC1164.2 +025800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1164.2 +025900 03 FILLER PIC X VALUE SPACE. NC1164.2 +026000 03 ENDER-DESC PIC X(44) VALUE NC1164.2 +026100 "ERRORS ENCOUNTERED". NC1164.2 +026200 01 CCVS-E-3. NC1164.2 +026300 02 FILLER PIC X(22) VALUE NC1164.2 +026400 " FOR OFFICIAL USE ONLY". NC1164.2 +026500 02 FILLER PIC X(12) VALUE SPACE. NC1164.2 +026600 02 FILLER PIC X(58) VALUE NC1164.2 +026700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1164.2 +026800 02 FILLER PIC X(13) VALUE SPACE. NC1164.2 +026900 02 FILLER PIC X(15) VALUE NC1164.2 +027000 " COPYRIGHT 1985". NC1164.2 +027100 01 CCVS-E-4. NC1164.2 +027200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1164.2 +027300 02 FILLER PIC X(4) VALUE " OF ". NC1164.2 +027400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1164.2 +027500 02 FILLER PIC X(40) VALUE NC1164.2 +027600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1164.2 +027700 01 XXINFO. NC1164.2 +027800 02 FILLER PIC X(19) VALUE NC1164.2 +027900 "*** INFORMATION ***". NC1164.2 +028000 02 INFO-TEXT. NC1164.2 +028100 04 FILLER PIC X(8) VALUE SPACE. NC1164.2 +028200 04 XXCOMPUTED PIC X(20). NC1164.2 +028300 04 FILLER PIC X(5) VALUE SPACE. NC1164.2 +028400 04 XXCORRECT PIC X(20). NC1164.2 +028500 02 INF-ANSI-REFERENCE PIC X(48). NC1164.2 +028600 01 HYPHEN-LINE. NC1164.2 +028700 02 FILLER PIC IS X VALUE IS SPACE. NC1164.2 +028800 02 FILLER PIC IS X(65) VALUE IS "************************NC1164.2 +028900- "*****************************************". NC1164.2 +029000 02 FILLER PIC IS X(54) VALUE IS "************************NC1164.2 +029100- "******************************". NC1164.2 +029200 01 CCVS-PGM-ID PIC X(9) VALUE NC1164.2 +029300 "NC116A". NC1164.2 +029400 PROCEDURE DIVISION. NC1164.2 +029500 CCVS1 SECTION. NC1164.2 +029600 OPEN-FILES. NC1164.2 +029700 OPEN OUTPUT PRINT-FILE. NC1164.2 +029800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1164.2 +029900 MOVE SPACE TO TEST-RESULTS. NC1164.2 +030000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1164.2 +030100 GO TO CCVS1-EXIT. NC1164.2 +030200 CLOSE-FILES. NC1164.2 +030300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1164.2 +030400 TERMINATE-CCVS. NC1164.2 +030500*S EXIT PROGRAM. NC1164.2 +030600*SERMINATE-CALL. NC1164.2 +030700 STOP RUN. NC1164.2 +030800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1164.2 +030900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1164.2 +031000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1164.2 +031100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1164.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. NC1164.2 +031300 PRINT-DETAIL. NC1164.2 +031400 IF REC-CT NOT EQUAL TO ZERO NC1164.2 +031500 MOVE "." TO PARDOT-X NC1164.2 +031600 MOVE REC-CT TO DOTVALUE. NC1164.2 +031700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1164.2 +031800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1164.2 +031900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1164.2 +032000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1164.2 +032100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1164.2 +032200 MOVE SPACE TO CORRECT-X. NC1164.2 +032300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1164.2 +032400 MOVE SPACE TO RE-MARK. NC1164.2 +032500 HEAD-ROUTINE. NC1164.2 +032600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +032700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +032800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1164.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1164.2 +033000 COLUMN-NAMES-ROUTINE. NC1164.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +033400 END-ROUTINE. NC1164.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1164.2 +033600 END-RTN-EXIT. NC1164.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +033800 END-ROUTINE-1. NC1164.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1164.2 +034000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1164.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. NC1164.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1164.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1164.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1164.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1164.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1164.2 +034700 END-ROUTINE-12. NC1164.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1164.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1164.2 +035000 MOVE "NO " TO ERROR-TOTAL NC1164.2 +035100 ELSE NC1164.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1164.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1164.2 +035400 PERFORM WRITE-LINE. NC1164.2 +035500 END-ROUTINE-13. NC1164.2 +035600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1164.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE NC1164.2 +035800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1164.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1164.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO NC1164.2 +036200 MOVE "NO " TO ERROR-TOTAL NC1164.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1164.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1164.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1164.2 +036700 WRITE-LINE. NC1164.2 +036800 ADD 1 TO RECORD-COUNT. NC1164.2 +036900 IF RECORD-COUNT GREATER 42 NC1164.2 +037000 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1164.2 +037100 MOVE SPACE TO DUMMY-RECORD NC1164.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1164.2 +037300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1164.2 +037400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1164.2 +037500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1164.2 +037600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1164.2 +037700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1164.2 +037800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1164.2 +037900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1164.2 +038000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1164.2 +038100 MOVE ZERO TO RECORD-COUNT. NC1164.2 +038200 PERFORM WRT-LN. NC1164.2 +038300 WRT-LN. NC1164.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1164.2 +038500 MOVE SPACE TO DUMMY-RECORD. NC1164.2 +038600 BLANK-LINE-PRINT. NC1164.2 +038700 PERFORM WRT-LN. NC1164.2 +038800 FAIL-ROUTINE. NC1164.2 +038900 IF COMPUTED-X NOT EQUAL TO SPACE NC1164.2 +039000 GO TO FAIL-ROUTINE-WRITE. NC1164.2 +039100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1164.2 +039200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1164.2 +039300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1164.2 +039400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +039500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1164.2 +039600 GO TO FAIL-ROUTINE-EX. NC1164.2 +039700 FAIL-ROUTINE-WRITE. NC1164.2 +039800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1164.2 +039900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1164.2 +040000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1164.2 +040100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1164.2 +040200 FAIL-ROUTINE-EX. EXIT. NC1164.2 +040300 BAIL-OUT. NC1164.2 +040400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1164.2 +040500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1164.2 +040600 BAIL-OUT-WRITE. NC1164.2 +040700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1164.2 +040800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1164.2 +040900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1164.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1164.2 +041100 BAIL-OUT-EX. EXIT. NC1164.2 +041200 CCVS1-EXIT. NC1164.2 +041300 EXIT. NC1164.2 +041400 SECT-NC116A-001 SECTION. NC1164.2 +041500 SIG-INIT-GF-1. NC1164.2 +041600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +041700 MOVE "SIG-TEST-GF-1" TO PAR-NAME. NC1164.2 +041800 MOVE 1 TO REC-CT. NC1164.2 +041900 MOVE "SIGN LEADING SEPARATE" TO FEATURE. NC1164.2 +042000 MOVE "LEADING SIGN EQUAL PLUS" TO RE-MARK. NC1164.2 +042100 SIG-TEST-GF-1-1. NC1164.2 +042200* THIS TEST CHECKS THE SIGN AND THE NUMERIC CHARACTERS NC1164.2 +042300* OF AN ITEM DEFINED AS SIGN IS LEADING SEPARATE CHARACTER. NC1164.2 +042400 IF TEST1-AN-1 EQUAL TO "+" NC1164.2 +042500 PERFORM PASS NC1164.2 +042600 GO TO SIG-WRTE-GF-1-1. NC1164.2 +042700 GO TO SIG-FAIL-GF-1-1. NC1164.2 +042800 SIG-DELETE-GF-1-1. NC1164.2 +042900 PERFORM DE-LETE. NC1164.2 +043000 PERFORM PRINT-DETAIL. NC1164.2 +043100 GO TO SIG-INIT-GF-2. NC1164.2 +043200 SIG-FAIL-GF-1-1. NC1164.2 +043300 PERFORM FAIL. NC1164.2 +043400 MOVE "+" TO CORRECT-A. NC1164.2 +043500 MOVE TEST1-AN-1 TO COMPUTED-A. NC1164.2 +043600 SIG-WRTE-GF-1-1. NC1164.2 +043700 PERFORM PRINT-DETAIL. NC1164.2 +043800 SIG-TEST-GF-1-2. NC1164.2 +043900 IF TEST1-AN-5 EQUAL TO "91275" NC1164.2 +044000 PERFORM PASS NC1164.2 +044100 GO TO SIG-WRTE-GF-1-2. NC1164.2 +044200 SIG-FAIL-GF-1-2. NC1164.2 +044300 PERFORM FAIL. NC1164.2 +044400 MOVE "NUMERIC CHARACTERS" TO RE-MARK. NC1164.2 +044500 MOVE "91275" TO CORRECT-A. NC1164.2 +044600 MOVE TEST1-AN-5 TO COMPUTED-A. NC1164.2 +044700 SIG-WRTE-GF-1-2. NC1164.2 +044800 MOVE 2 TO REC-CT. NC1164.2 +044900 PERFORM PRINT-DETAIL. NC1164.2 +045000 SIG-TEST-GF-1-3. NC1164.2 +045100 IF TEST1N-AN-1 NOT EQUAL TO "-" NC1164.2 +045200 GO TO SIG-FAIL-GF-1-3. NC1164.2 +045300 PERFORM PASS. NC1164.2 +045400 GO TO SIG-WRTE-GF-1-3. NC1164.2 +045500 SIG-FAIL-GF-1-3. NC1164.2 +045600 PERFORM FAIL. NC1164.2 +045700 MOVE "-" TO CORRECT-A. NC1164.2 +045800 MOVE TEST1N-AN-1 TO COMPUTED-A. NC1164.2 +045900 SIG-WRTE-GF-1-3. NC1164.2 +046000 MOVE 3 TO REC-CT. NC1164.2 +046100 MOVE "LEADING SIGN EQUAL MINUS" TO RE-MARK. NC1164.2 +046200 PERFORM PRINT-DETAIL. NC1164.2 +046300 SIG-TEST-GF-1-4. NC1164.2 +046400 IF TEST1N-AN-4 NOT EQUAL TO "9127" NC1164.2 +046500 GO TO SIG-FAIL-GF-1-4. NC1164.2 +046600 PERFORM PASS. NC1164.2 +046700 GO TO SIG-WRTE-GF-1-4. NC1164.2 +046800 SIG-FAIL-GF-1-4. NC1164.2 +046900 PERFORM FAIL. NC1164.2 +047000 MOVE "NUMERIC CHARACTERS" TO RE-MARK. NC1164.2 +047100 MOVE "9127" TO CORRECT-A. NC1164.2 +047200 MOVE TEST1N-AN-4 TO COMPUTED-A. NC1164.2 +047300 SIG-WRTE-GF-1-4. NC1164.2 +047400 MOVE 4 TO REC-CT. NC1164.2 +047500 PERFORM PRINT-DETAIL. NC1164.2 +047600 SIG-INIT-GF-2. NC1164.2 +047700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +047800 MOVE "SIG-TEST-GF-2" TO PAR-NAME. NC1164.2 +047900 MOVE 1 TO REC-CT. NC1164.2 +048000 MOVE "SIGN TRLNG SEPARATE" TO FEATURE. NC1164.2 +048100 MOVE "TRAILING SIGN EQUAL PLUS" TO RE-MARK. NC1164.2 +048200* THIS TEST CHECKS THE SIGN AND THE NUMERIC CHARACTERS NC1164.2 +048300* OF AN ITEM DEFINED AS SIGN IS TRAILING SEPARATE CHARACTER. NC1164.2 +048400 SIG-TEST-GF-2-1. NC1164.2 +048500 IF TEST2-AN-1 EQUAL TO "+" NC1164.2 +048600 PERFORM PASS NC1164.2 +048700 GO TO SIG-WRTE-GF-2-1. NC1164.2 +048800 GO TO SIG-FAIL-GF-2-1. NC1164.2 +048900 SIG-DELETE-GF-2-1. NC1164.2 +049000 PERFORM DE-LETE. NC1164.2 +049100 PERFORM PRINT-DETAIL. NC1164.2 +049200 GO TO SIG-INIT-GF-3. NC1164.2 +049300 SIG-FAIL-GF-2-1. NC1164.2 +049400 PERFORM FAIL. NC1164.2 +049500 MOVE "+" TO CORRECT-A. NC1164.2 +049600 MOVE TEST2-AN-1 TO COMPUTED-A. NC1164.2 +049700 SIG-WRTE-GF-2-1. NC1164.2 +049800 PERFORM PRINT-DETAIL. NC1164.2 +049900 SIGNTEST-GF-2-2. NC1164.2 +050000 IF TEST2-AN-5 EQUAL TO "80361" NC1164.2 +050100 PERFORM PASS NC1164.2 +050200 GO TO SIG-WRTE-GF-2-2. NC1164.2 +050300 GO TO SIG-FAIL-GF-2-2. NC1164.2 +050400 SIG-FAIL-GF-2-2. NC1164.2 +050500 PERFORM FAIL. NC1164.2 +050600 MOVE "80361" TO CORRECT-A. NC1164.2 +050700 MOVE TEST2-AN-5 TO COMPUTED-A. NC1164.2 +050800 MOVE "NUMERIC CHARACTERS" TO RE-MARK. NC1164.2 +050900 SIG-WRTE-GF-2-2. NC1164.2 +051000 MOVE 2 TO REC-CT. NC1164.2 +051100 PERFORM PRINT-DETAIL. NC1164.2 +051200 SIG-TEST-GF-2-3. NC1164.2 +051300 IF TEST2N-AN-1 NOT EQUAL TO "-" NC1164.2 +051400 GO TO SIG-FAIL-GF-2-3. NC1164.2 +051500 PERFORM PASS. NC1164.2 +051600 GO TO SIG-WRTE-GF-2-3. NC1164.2 +051700 SIG-FAIL-GF-2-3. NC1164.2 +051800 PERFORM FAIL. NC1164.2 +051900 MOVE "-" TO CORRECT-A. NC1164.2 +052000 MOVE TEST2N-AN-1 TO COMPUTED-A. NC1164.2 +052100 SIG-WRTE-GF-2-3. NC1164.2 +052200 MOVE 3 TO REC-CT. NC1164.2 +052300 MOVE "TRAILING SIGN EQUAL MINUS" TO RE-MARK. NC1164.2 +052400 PERFORM PRINT-DETAIL. NC1164.2 +052500 SIG-TEST-GF-2-4. NC1164.2 +052600 IF TEST2N-AN-4 NOT EQUAL TO "8036" NC1164.2 +052700 GO TO SIG-FAIL-GF-2-4. NC1164.2 +052800 PERFORM PASS. NC1164.2 +052900 GO TO SIG-WRTE-GF-2-4. NC1164.2 +053000 SIG-FAIL-GF-2-4. NC1164.2 +053100 PERFORM FAIL. NC1164.2 +053200 MOVE "8036" TO CORRECT-A. NC1164.2 +053300 MOVE TEST2N-AN-4 TO COMPUTED-A. NC1164.2 +053400 MOVE "NUMERIC CHARACTERS" TO RE-MARK. NC1164.2 +053500 SIG-WRTE-GF-2-4. NC1164.2 +053600 MOVE 4 TO REC-CT. NC1164.2 +053700 PERFORM PRINT-DETAIL. NC1164.2 +053800 SIG-INIT-GF-3. NC1164.2 +053900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +054000 MOVE "SIG-TEST-GF-3" TO PAR-NAME. NC1164.2 +054100 MOVE "SIGN LEADING" TO FEATURE. NC1164.2 +054200 MOVE 1 TO REC-CT. NC1164.2 +054300 MOVE "POSITIVE NUMERIC ITEM" TO RE-MARK. NC1164.2 +054400* THIS TEST CHECKS ALL BUT THE LEADING CHARACTER OF AN NC1164.2 +054500* ITEM DEFINED AS SIGN IS LEADING. (NOT SEPARATE CHAR.) NC1164.2 +054600 SIG-TEST-GF-3-1. NC1164.2 +054700 IF TEST3-AN-4 EQUAL TO "1275" NC1164.2 +054800 PERFORM PASS NC1164.2 +054900 GO TO SIG-WRTE-GF-3-1. NC1164.2 +055000 GO TO SIG-FAIL-GF-3-1. NC1164.2 +055100 SIG-DELETE-GF-3-1. NC1164.2 +055200 PERFORM DE-LETE. NC1164.2 +055300 PERFORM PRINT-DETAIL. NC1164.2 +055400 GO TO SIG-INIT-GF-4. NC1164.2 +055500 SIG-FAIL-GF-3-1. NC1164.2 +055600 PERFORM FAIL. NC1164.2 +055700 MOVE "1275" TO CORRECT-A. NC1164.2 +055800 MOVE TEST3-AN-4 TO COMPUTED-A. NC1164.2 +055900 SIG-WRTE-GF-3-1. NC1164.2 +056000 PERFORM PRINT-DETAIL. NC1164.2 +056100 SIG-TEST-GF-3-2. NC1164.2 +056200 IF TEST3N-AN-3 NOT EQUAL TO "127" NC1164.2 +056300 GO TO SIG-FAIL-GF-3-2. NC1164.2 +056400 PERFORM PASS. NC1164.2 +056500 GO TO SIG-WRTE-GF-3-2. NC1164.2 +056600 SIG-DELETE-GF-3-2. NC1164.2 +056700 PERFORM DE-LETE. NC1164.2 +056800 SIG-FAIL-GF-3-2. NC1164.2 +056900 PERFORM FAIL. NC1164.2 +057000 MOVE "127" TO CORRECT-A. NC1164.2 +057100 MOVE TEST3N-AN-3 TO COMPUTED-A. NC1164.2 +057200 SIG-WRTE-GF-3-2. NC1164.2 +057300 MOVE 2 TO REC-CT. NC1164.2 +057400 MOVE "NEGATIVE NUMERIC ITEM" TO RE-MARK. NC1164.2 +057500 PERFORM PRINT-DETAIL. NC1164.2 +057600 SIG-INIT-GF-4. NC1164.2 +057700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +057800 MOVE "SIG-TEST-GF-4" TO PAR-NAME. NC1164.2 +057900 MOVE "SIGN TRAILING" TO FEATURE. NC1164.2 +058000 MOVE 1 TO REC-CT. NC1164.2 +058100 MOVE "POSITIVE NUMERIC ITEM" TO RE-MARK. NC1164.2 +058200* THIS TEST CHECKS ALL BUT THE TRAILING CHARACTER OF AN NC1164.2 +058300* ITEM DEFINED AS SIGN IS TRAILING. (NOT SEPARATE CHAR.) NC1164.2 +058400 SIG-TEST-GF-4-1. NC1164.2 +058500 IF TEST4-AN-4 EQUAL TO "8362" NC1164.2 +058600 PERFORM PASS NC1164.2 +058700 GO TO SIG-WRTE-GF-4-1. NC1164.2 +058800 GO TO SIG-FAIL-GF-4-1. NC1164.2 +058900 SIG-DELETE-GF-4-1. NC1164.2 +059000 PERFORM DE-LETE. NC1164.2 +059100 PERFORM PRINT-DETAIL. NC1164.2 +059200 GO TO SIG-INIT-GF-5. NC1164.2 +059300 SIG-FAIL-GF-4-1. NC1164.2 +059400 PERFORM FAIL. NC1164.2 +059500 MOVE "8362" TO CORRECT-A. NC1164.2 +059600 MOVE TEST4-AN-4 TO COMPUTED-A. NC1164.2 +059700 SIG-WRTE-GF-4-1. NC1164.2 +059800 PERFORM PRINT-DETAIL. NC1164.2 +059900 SIG-TEST-GF-4-2. NC1164.2 +060000 IF TEST4N-AN-3 NOT EQUAL TO "362" NC1164.2 +060100 GO TO SIG-FAIL-GF-4-2. NC1164.2 +060200 PERFORM PASS. NC1164.2 +060300 GO TO SIG-WRTE-GF-4-2. NC1164.2 +060400 SIG-DELETE-GF-4-2. NC1164.2 +060500 PERFORM DE-LETE. NC1164.2 +060600 SIG-FAIL-GF-4-2. NC1164.2 +060700 PERFORM FAIL. NC1164.2 +060800 MOVE "362" TO CORRECT-A. NC1164.2 +060900 MOVE TEST4N-AN-3 TO COMPUTED-A. NC1164.2 +061000 SIG-WRTE-GF-4-2. NC1164.2 +061100 MOVE 2 TO REC-CT. NC1164.2 +061200 MOVE "NEGATIVE NUMERIC ITEM" TO RE-MARK. NC1164.2 +061300 PERFORM PRINT-DETAIL. NC1164.2 +061400 SIG-INIT-GF-5. NC1164.2 +061500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +061600 MOVE "SIG-TEST-GF-5" TO PAR-NAME. NC1164.2 +061700 MOVE "COMPARE SIGNED ITEMS" TO FEATURE. NC1164.2 +061800 MOVE "LEADING SIGN" TO RE-MARK. NC1164.2 +061900 MOVE 1 TO REC-CT. NC1164.2 +062000* THIS SERIES OF TESTS COMPARE A SIGNED DISPLAY ITEM WITH NC1164.2 +062100* LEADING SIGN TO FOUR SIGNED AND UNSIGNED COMPUTATIONAL AND NC1164.2 +062200* DISPLAY ITEMS. NC1164.2 +062300 SIG-TEST-GF-5-1. NC1164.2 +062400 IF DS-L-00008 EQUAL TO CS-00007-1 NC1164.2 +062500 PERFORM PASS NC1164.2 +062600 GO TO SIG-WRITE-GF-5-1. NC1164.2 +062700 GO TO SIG-FAIL-GF-5-1. NC1164.2 +062800 SIG-DELETE-GF-5-1. NC1164.2 +062900 PERFORM DE-LETE. NC1164.2 +063000 PERFORM PRINT-DETAIL. NC1164.2 +063100 GO TO SIG-INIT-GF-6. NC1164.2 +063200 SIG-FAIL-GF-5-1. NC1164.2 +063300 PERFORM FAIL. NC1164.2 +063400 MOVE AN-00008-X-1 TO COMPUTED-A. NC1164.2 +063500 MOVE CS-00007-1 TO CORRECT-18V0. NC1164.2 +063600 SIG-WRITE-GF-5-1. NC1164.2 +063700 PERFORM PRINT-DETAIL. NC1164.2 +063800 SIG-TEST-GF-5-2. NC1164.2 +063900 MOVE 2 TO REC-CT. NC1164.2 +064000 IF DS-L-00008 EQUAL TO CU-00007-1 NC1164.2 +064100 PERFORM PASS NC1164.2 +064200 GO TO SIG-WRITE-GF-5-2. NC1164.2 +064300 SIG-FAIL-GF-5-2. NC1164.2 +064400 PERFORM FAIL. NC1164.2 +064500 MOVE AN-00008-X-1 TO COMPUTED-A. NC1164.2 +064600 MOVE CU-00007-1 TO CORRECT-18V0. NC1164.2 +064700 SIG-WRITE-GF-5-2. NC1164.2 +064800 PERFORM PRINT-DETAIL. NC1164.2 +064900 SIG-TEST-GF-5-3. NC1164.2 +065000 MOVE 3 TO REC-CT. NC1164.2 +065100 IF DS-L-00008 EQUAL TO DS-00007-1 NC1164.2 +065200 PERFORM PASS NC1164.2 +065300 GO TO SIG-WRITE-GF-5-3. NC1164.2 +065400 SIG-FAIL-GF-5-3. NC1164.2 +065500 PERFORM FAIL. NC1164.2 +065600 MOVE AN-00008-X-1 TO COMPUTED-A. NC1164.2 +065700 MOVE DS-00007-1 TO CORRECT-18V0. NC1164.2 +065800 SIG-WRITE-GF-5-3. NC1164.2 +065900 PERFORM PRINT-DETAIL. NC1164.2 +066000 SIG-TEST-GF-5-4. NC1164.2 +066100 MOVE 4 TO REC-CT. NC1164.2 +066200 IF DS-L-00008 EQUAL TO DU-00007-1 NC1164.2 +066300 PERFORM PASS NC1164.2 +066400 GO TO SIG-WRITE-GF-5-4. NC1164.2 +066500 SIG-FAIL-GF-5-4. NC1164.2 +066600 PERFORM FAIL. NC1164.2 +066700 MOVE AN-00008-X-1 TO COMPUTED-A. NC1164.2 +066800 MOVE DU-00007-1 TO CORRECT-18V0. NC1164.2 +066900 SIG-WRITE-GF-5-4. NC1164.2 +067000 PERFORM PRINT-DETAIL. NC1164.2 +067100 SIG-INIT-GF-6. NC1164.2 +067200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +067300 MOVE "SIG-TEST-GF-6" TO PAR-NAME. NC1164.2 +067400 MOVE "COMPARE SIGNED ITEMS" TO FEATURE. NC1164.2 +067500 MOVE "TRAILING SIGN" TO RE-MARK. NC1164.2 +067600* THIS SERIES OF TESTS COMPARE A SIGNED DISPLAY ITEM WITH NC1164.2 +067700* TRAILING SIGN TO FOUR SIGNED AND UNSIGNED COMPUTATIONAL AND NC1164.2 +067800* DISPLAY ITEMS. NC1164.2 +067900 SIG-TEST-GF-6-1. NC1164.2 +068000 MOVE 1 TO REC-CT. NC1164.2 +068100 IF DS-T-00008 EQUAL TO CS-00007-2 NC1164.2 +068200 PERFORM PASS NC1164.2 +068300 GO TO SIG-WRITE-GF-6-1. NC1164.2 +068400 GO TO SIG-FAIL-GF-6-1. NC1164.2 +068500 SIG-DELETE-GF-6-1. NC1164.2 +068600 PERFORM DE-LETE. NC1164.2 +068700 PERFORM PRINT-DETAIL. NC1164.2 +068800 GO TO SIG-INIT-GF-7. NC1164.2 +068900 SIG-FAIL-GF-6-1. NC1164.2 +069000 PERFORM FAIL. NC1164.2 +069100 MOVE AN-00008-X-2 TO COMPUTED-A. NC1164.2 +069200 MOVE CS-00007-2 TO CORRECT-18V0. NC1164.2 +069300 SIG-WRITE-GF-6-1. NC1164.2 +069400 PERFORM PRINT-DETAIL. NC1164.2 +069500 SIG-TEST-GF-6-2. NC1164.2 +069600 MOVE 2 TO REC-CT. NC1164.2 +069700 IF DS-T-00008-1 EQUAL TO CU-00007-2 NC1164.2 +069800 PERFORM PASS NC1164.2 +069900 GO TO SIG-WRITE-GF-6-2. NC1164.2 +070000 SIG-FAIL-GF-6-2. NC1164.2 +070100 PERFORM FAIL. NC1164.2 +070200 MOVE AN-00008-X-5 TO COMPUTED-A. NC1164.2 +070300 MOVE CU-00007-2 TO CORRECT-18V0. NC1164.2 +070400 SIG-WRITE-GF-6-2. NC1164.2 +070500 PERFORM PRINT-DETAIL. NC1164.2 +070600 SIG-TEST-GF-6-3. NC1164.2 +070700 MOVE 3 TO REC-CT. NC1164.2 +070800 IF DS-T-00008 EQUAL TO DS-00007-2 NC1164.2 +070900 PERFORM PASS NC1164.2 +071000 GO TO SIG-WRITE-GF-6-3. NC1164.2 +071100 SIG-FAIL-GF-6-3. NC1164.2 +071200 PERFORM FAIL. NC1164.2 +071300 MOVE AN-00008-X-2 TO COMPUTED-A. NC1164.2 +071400 MOVE DS-00007-2 TO CORRECT-18V0. NC1164.2 +071500 SIG-WRITE-GF-6-3. NC1164.2 +071600 PERFORM PRINT-DETAIL. NC1164.2 +071700 SIG-TEST-GF-6-4. NC1164.2 +071800 MOVE 4 TO REC-CT. NC1164.2 +071900 IF DS-T-00008-1 EQUAL TO DU-00007-2 NC1164.2 +072000 PERFORM PASS NC1164.2 +072100 GO TO SIG-WRITE-GF-6-4. NC1164.2 +072200 SIG-FAIL-GF-6-4. NC1164.2 +072300 PERFORM FAIL. NC1164.2 +072400 MOVE AN-00008-X-5 TO COMPUTED-A. NC1164.2 +072500 MOVE DU-00007-2 TO CORRECT-18V0. NC1164.2 +072600 SIG-WRITE-GF-6-4. NC1164.2 +072700 PERFORM PRINT-DETAIL. NC1164.2 +072800 SIG-INIT-GF-7. NC1164.2 +072900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +073000 MOVE "SIG-TEST-GF-7" TO PAR-NAME. NC1164.2 +073100 MOVE "COMPARE SIGNED ITEMS" TO FEATURE. NC1164.2 +073200 MOVE "LEADING SIGN SEPARATE CHARACTER" TO RE-MARK. NC1164.2 +073300* THIS SERIES OF TESTS COMPARE A SIGNED DISPLAY ITEM WITH NC1164.2 +073400* LEADING SIGN AND SEPARATE CHARACTER TO FOUR SIGNED AND NC1164.2 +073500* UNSIGNED COMPUTATIONAL AND DISPLAY ITEMS. NC1164.2 +073600 SIG-TEST-GF-7-1. NC1164.2 +073700 MOVE 1 TO REC-CT. NC1164.2 +073800 IF DS-LS-00008 EQUAL TO CS-00007-3 NC1164.2 +073900 PERFORM PASS NC1164.2 +074000 GO TO SIG-WRITE-GF-7-1. NC1164.2 +074100 GO TO SIG-FAIL-GF-7-1. NC1164.2 +074200 SIG-DELETE-GF-7-1. NC1164.2 +074300 PERFORM DE-LETE. NC1164.2 +074400 PERFORM PRINT-DETAIL. NC1164.2 +074500 GO TO SIG-INIT-GF-8. NC1164.2 +074600 SIG-FAIL-GF-7-1. NC1164.2 +074700 PERFORM FAIL. NC1164.2 +074800 MOVE AN-00009-X-3 TO COMPUTED-A. NC1164.2 +074900 MOVE CS-00007-3 TO CORRECT-18V0. NC1164.2 +075000 SIG-WRITE-GF-7-1. NC1164.2 +075100 PERFORM PRINT-DETAIL. NC1164.2 +075200 SIG-TEST-GF-7-2. NC1164.2 +075300 MOVE 2 TO REC-CT. NC1164.2 +075400 IF DS-LS-00008-1 EQUAL TO CU-00007-3 NC1164.2 +075500 PERFORM PASS NC1164.2 +075600 GO TO SIG-WRITE-GF-7-2. NC1164.2 +075700 SIG-FAIL-GF-7-2. NC1164.2 +075800 PERFORM FAIL. NC1164.2 +075900 MOVE AN-00009-X-6 TO COMPUTED-A. NC1164.2 +076000 MOVE CU-00007-3 TO CORRECT-18V0. NC1164.2 +076100 SIG-WRITE-GF-7-2. NC1164.2 +076200 PERFORM PRINT-DETAIL. NC1164.2 +076300 SIG-TEST-GF-7-3. NC1164.2 +076400 MOVE 3 TO REC-CT. NC1164.2 +076500 IF DS-LS-00008 EQUAL TO DS-00007-3 NC1164.2 +076600 PERFORM PASS. NC1164.2 +076700 GO TO SIG-WRITE-GF-7-3. NC1164.2 +076800 SIG-FAIL-GF-7-3. NC1164.2 +076900 PERFORM FAIL. NC1164.2 +077000 MOVE AN-00009-X-3 TO COMPUTED-A. NC1164.2 +077100 MOVE DS-00007-3 TO CORRECT-18V0. NC1164.2 +077200 SIG-WRITE-GF-7-3. NC1164.2 +077300 PERFORM PRINT-DETAIL. NC1164.2 +077400 SIG-TEST-GF-7-4. NC1164.2 +077500 MOVE 4 TO REC-CT. NC1164.2 +077600 IF DS-LS-00008-1 EQUAL TO DU-00007-3 NC1164.2 +077700 PERFORM PASS NC1164.2 +077800 GO TO SIG-WRITE-GF-7-4. NC1164.2 +077900 SIG-FAIL-GF-7-4. NC1164.2 +078000 PERFORM FAIL. NC1164.2 +078100 MOVE AN-00009-X-6 TO COMPUTED-A. NC1164.2 +078200 MOVE DU-00007-3 TO CORRECT-18V0. NC1164.2 +078300 SIG-WRITE-GF-7-4. NC1164.2 +078400 PERFORM PRINT-DETAIL. NC1164.2 +078500 SIG-INIT-GF-8. NC1164.2 +078600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +078700 MOVE "SIG-TEST-GF-8" TO PAR-NAME. NC1164.2 +078800 MOVE "COMPARE SIGN ITEMS" TO FEATURE. NC1164.2 +078900 MOVE "TRAILING SIGN SEPARATE CHARACTR" TO RE-MARK. NC1164.2 +079000* THIS SERIES OF TESTS COMPARE A SIGNED DISPLAY ITEM WITH NC1164.2 +079100* TRAILING SIGN AND SEPARATE CHARACTER TO FOUR SIGNED AND NC1164.2 +079200* UNSIGNED COMPUTATIONAL AND DISPLAY ITEMS. NC1164.2 +079300 SIG-TEST-GF-8-1. NC1164.2 +079400 MOVE 1 TO REC-CT. NC1164.2 +079500 IF DS-TS-00008 EQUAL TO CS-00007-4 NC1164.2 +079600 PERFORM PASS NC1164.2 +079700 GO TO SIG-WRITE-GF-8-1. NC1164.2 +079800 GO TO SIG-FAIL-GF-8-1. NC1164.2 +079900 SIG-DELETE-GF-8-1. NC1164.2 +080000 PERFORM DE-LETE. NC1164.2 +080100 PERFORM PRINT-DETAIL. NC1164.2 +080200 GO TO SIG-INIT-GF-9. NC1164.2 +080300 SIG-FAIL-GF-8-1. NC1164.2 +080400 PERFORM FAIL. NC1164.2 +080500 MOVE AN-00009-X-4 TO COMPUTED-A. NC1164.2 +080600 MOVE CS-00007-4 TO CORRECT-18V0. NC1164.2 +080700 SIG-WRITE-GF-8-1. NC1164.2 +080800 PERFORM PRINT-DETAIL. NC1164.2 +080900 SIG-TEST-GF-8-2. NC1164.2 +081000 MOVE 2 TO REC-CT. NC1164.2 +081100 IF DS-TS-00008 EQUAL TO CU-00007-4 NC1164.2 +081200 PERFORM PASS NC1164.2 +081300 GO TO SIG-WRITE-GF-8-2. NC1164.2 +081400 SIG-FAIL-GF-8-2. NC1164.2 +081500 PERFORM FAIL. NC1164.2 +081600 MOVE AN-00009-X-4 TO COMPUTED-A. NC1164.2 +081700 MOVE CU-00007-4 TO CORRECT-18V0. NC1164.2 +081800 SIG-WRITE-GF-8-2. NC1164.2 +081900 PERFORM PRINT-DETAIL. NC1164.2 +082000 SIG-TEST-GF-8-3. NC1164.2 +082100 MOVE 3 TO REC-CT. NC1164.2 +082200 IF DS-TS-00008 EQUAL TO DS-00007-4 NC1164.2 +082300 PERFORM PASS NC1164.2 +082400 GO TO SIG-WRITE-GF-8-3. NC1164.2 +082500 SIG-FAIL-GF-8-3. NC1164.2 +082600 PERFORM FAIL. NC1164.2 +082700 MOVE AN-00009-X-4 TO COMPUTED-A. NC1164.2 +082800 MOVE DS-00007-4 TO CORRECT-18V0. NC1164.2 +082900 SIG-WRITE-GF-8-3. NC1164.2 +083000 PERFORM PRINT-DETAIL. NC1164.2 +083100 SIG-TEST-GF-8-4. NC1164.2 +083200 MOVE 4 TO REC-CT. NC1164.2 +083300 IF DS-TS-00008 EQUAL TO DU-00007-4 NC1164.2 +083400 PERFORM PASS NC1164.2 +083500 GO TO SIG-WRITE-GF-8-4. NC1164.2 +083600 SIG-FAIL-GF-8-4. NC1164.2 +083700 PERFORM FAIL. NC1164.2 +083800 MOVE AN-00009-X-4 TO COMPUTED-A. NC1164.2 +083900 MOVE DU-00007-4 TO CORRECT-18V0. NC1164.2 +084000 SIG-WRITE-GF-8-4. NC1164.2 +084100 PERFORM PRINT-DETAIL. NC1164.2 +084200 SIG-INIT-GF-9. NC1164.2 +084300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +084400 MOVE "SIG-TEST-GF-9" TO PAR-NAME. NC1164.2 +084500 MOVE "SENDING ITEM DS-LS" TO FEATURE. NC1164.2 +084600 MOVE 1 TO REC-CT. NC1164.2 +084700* THIS TEST MOVES A NUMERIC ITEM WITH SIGN IS LEADING NC1164.2 +084800* SEPARATE CHARACTER TO UNSIGNED DISPLAY, SIGNED DISPLAY, NC1164.2 +084900* UNSIGNED COMPUTATIONAL AND SIGNED COMPUTATIONAL ITEMS. NC1164.2 +085000 SIG-TEST-GF-9-1. NC1164.2 +085100 MOVE DS-LS-5 TO DU-005. NC1164.2 +085200 IF DU-005 EQUAL TO 91275 NC1164.2 +085300 PERFORM PASS NC1164.2 +085400 GO TO SIG-WRTE-GF-9-1. NC1164.2 +085500 GO TO SIG-FAIL-GF-9-1. NC1164.2 +085600 SIG-DELETE-GF-9-1. NC1164.2 +085700 PERFORM DE-LETE. NC1164.2 +085800 PERFORM PRINT-DETAIL. NC1164.2 +085900 GO TO SIG-INIT-GF-10. NC1164.2 +086000 SIG-FAIL-GF-9-1. NC1164.2 +086100 PERFORM FAIL. NC1164.2 +086200 MOVE DU-005 TO COMPUTED-18V0. NC1164.2 +086300 MOVE 91275 TO CORRECT-18V0. NC1164.2 +086400 MOVE "MOVE DS-LS-5 TO DU-005" TO RE-MARK. NC1164.2 +086500 SIG-WRTE-GF-9-1. NC1164.2 +086600 PERFORM PRINT-DETAIL. NC1164.2 +086700 SIG-TEST-GF-9-2. NC1164.2 +086800 MOVE DS-LS-5 TO DS-005. NC1164.2 +086900 IF DS-005 EQUAL TO +91275 NC1164.2 +087000 PERFORM PASS NC1164.2 +087100 GO TO SIG-WRTE-GF-9-2. NC1164.2 +087200 SIG-FAIL-GF-9-2. NC1164.2 +087300 PERFORM FAIL. NC1164.2 +087400 MOVE DS-005 TO COMPUTED-18V0. NC1164.2 +087500 MOVE +91275 TO CORRECT-18V0. NC1164.2 +087600 MOVE "MOVE DS-LS-5 TO DS-005" TO RE-MARK. NC1164.2 +087700 SIG-WRTE-GF-9-2. NC1164.2 +087800 MOVE 2 TO REC-CT. NC1164.2 +087900 PERFORM PRINT-DETAIL. NC1164.2 +088000 SIG-TEST-GF-9-3. NC1164.2 +088100 MOVE DS-LS-5 TO CU-005. NC1164.2 +088200 IF CU-005 EQUAL TO 91275 NC1164.2 +088300 PERFORM PASS NC1164.2 +088400 GO TO SIG-WRTE-GF-9-3. NC1164.2 +088500 SIG-FAIL-GF-9-3. NC1164.2 +088600 PERFORM FAIL. NC1164.2 +088700 MOVE CU-005 TO COMPUTED-18V0. NC1164.2 +088800 MOVE 91275 TO CORRECT-18V0. NC1164.2 +088900 MOVE "MOVE DS-LS-5 TO CU-005" TO RE-MARK. NC1164.2 +089000 SIG-WRTE-GF-9-3. NC1164.2 +089100 MOVE 3 TO REC-CT. NC1164.2 +089200 PERFORM PRINT-DETAIL. NC1164.2 +089300 SIG-TEST-GF-9-4. NC1164.2 +089400 MOVE DS-LS-5 TO CS-005. NC1164.2 +089500 IF CS-005 EQUAL TO +91275 NC1164.2 +089600 PERFORM PASS NC1164.2 +089700 GO TO SIG-WRTE-GF-9-4. NC1164.2 +089800 SIG-FAIL-GF-9-4. NC1164.2 +089900 PERFORM FAIL. NC1164.2 +090000 MOVE CS-005 TO COMPUTED-18V0. NC1164.2 +090100 MOVE +91275 TO CORRECT-18V0. NC1164.2 +090200 MOVE "MOVE DS-LS-5 TO CS-005" TO RE-MARK. NC1164.2 +090300 SIG-WRTE-GF-9-4. NC1164.2 +090400 MOVE 4 TO REC-CT. NC1164.2 +090500 PERFORM PRINT-DETAIL. NC1164.2 +090600 SIG-INIT-GF-10. NC1164.2 +090700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +090800 MOVE "SIG-TEST-GF-10" TO PAR-NAME. NC1164.2 +090900 MOVE "SENDING ITEM DS-TS-4" TO FEATURE. NC1164.2 +091000* THIS TEST MOVES A NUMERIC ITEM WITH SIGN IS TRAILING NC1164.2 +091100* SEPARATE CHARACTER TO UNSIGNED DISPLAY, SIGNED DISPLAY, NC1164.2 +091200* UNSIGNED COMPUTATIONAL AND SIGNED COMPUTATIONAL ITEMS. NC1164.2 +091300 SIG-TEST-GF-10-1. NC1164.2 +091400 MOVE DS-TS-4 TO DU-005. NC1164.2 +091500 IF DU-005 NOT EQUAL TO 08036 NC1164.2 +091600 GO TO SIG-FAIL-GF-10-1. NC1164.2 +091700 PERFORM PASS. NC1164.2 +091800 GO TO SIG-WRTE-GF-10-1. NC1164.2 +091900 SIG-DELETE-GF-10-1. NC1164.2 +092000 PERFORM DE-LETE. NC1164.2 +092100 PERFORM PRINT-DETAIL. NC1164.2 +092200 GO TO SIG-INIT-GF-11. NC1164.2 +092300 SIG-FAIL-GF-10-1. NC1164.2 +092400 PERFORM FAIL. NC1164.2 +092500 MOVE DU-005 TO COMPUTED-18V0. NC1164.2 +092600 MOVE 08036 TO CORRECT-18V0. NC1164.2 +092700 MOVE "MOVE DS-TS-4 TO DU-005" TO RE-MARK. NC1164.2 +092800 SIG-WRTE-GF-10-1. NC1164.2 +092900 MOVE 1 TO REC-CT. NC1164.2 +093000 PERFORM PRINT-DETAIL. NC1164.2 +093100 SIG-TEST-GF-10-2. NC1164.2 +093200 MOVE DS-TS-4 TO DS-005. NC1164.2 +093300 IF DS-005 NOT EQUAL TO -08036 NC1164.2 +093400 GO TO SIG-FAIL-GF-10-2. NC1164.2 +093500 PERFORM PASS. NC1164.2 +093600 GO TO SIG-WRTE-GF-10-2. NC1164.2 +093700 SIG-FAIL-GF-10-2. NC1164.2 +093800 PERFORM FAIL. NC1164.2 +093900 MOVE DS-005 TO COMPUTED-18V0. NC1164.2 +094000 MOVE -08036 TO CORRECT-18V0. NC1164.2 +094100 MOVE "MOVE DS-TS-4 TO DS-005" TO RE-MARK. NC1164.2 +094200 SIG-WRTE-GF-10-2. NC1164.2 +094300 MOVE 2 TO REC-CT. NC1164.2 +094400 PERFORM PRINT-DETAIL. NC1164.2 +094500 SIG-TEST-GF-10-3. NC1164.2 +094600 MOVE DS-TS-4 TO CU-005. NC1164.2 +094700 IF CU-005 NOT EQUAL TO 08036 NC1164.2 +094800 GO TO SIG-FAIL-GF-10-3. NC1164.2 +094900 PERFORM PASS. NC1164.2 +095000 GO TO SIG-WRTE-GF-10-3. NC1164.2 +095100 SIG-FAIL-GF-10-3. NC1164.2 +095200 PERFORM FAIL. NC1164.2 +095300 MOVE CU-005 TO COMPUTED-18V0. NC1164.2 +095400 MOVE 08036 TO CORRECT-18V0. NC1164.2 +095500 MOVE "MOVE DS-TS-4 TO CU-005" TO RE-MARK. NC1164.2 +095600 SIG-WRTE-GF-10-3. NC1164.2 +095700 MOVE 3 TO REC-CT. NC1164.2 +095800 PERFORM PRINT-DETAIL. NC1164.2 +095900 SIG-TEST-GF-10-4. NC1164.2 +096000 MOVE DS-TS-4 TO CS-005. NC1164.2 +096100 IF CS-005 NOT EQUAL TO -08036 NC1164.2 +096200 GO TO SIG-FAIL-GF-10-4. NC1164.2 +096300 PERFORM PASS. NC1164.2 +096400 GO TO SIG-WRTE-GF-10-4. NC1164.2 +096500 SIG-FAIL-GF-10-4. NC1164.2 +096600 PERFORM FAIL. NC1164.2 +096700 MOVE CS-005 TO COMPUTED-18V0. NC1164.2 +096800 MOVE -08036 TO CORRECT-18V0. NC1164.2 +096900 MOVE "MOVE DS-TS-4 TO CS-005" TO RE-MARK. NC1164.2 +097000 SIG-WRTE-GF-10-4. NC1164.2 +097100 MOVE 4 TO REC-CT. NC1164.2 +097200 PERFORM PRINT-DETAIL. NC1164.2 +097300 SIG-INIT-GF-11. NC1164.2 +097400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +097500 MOVE "SIG-TEST-GF-11" TO PAR-NAME. NC1164.2 +097600 MOVE "SIGN SEPARATE ITEMS" TO FEATURE. NC1164.2 +097700* THIS TEST CONTAINS MOVE STATEMENTS WHERE BOTH THE NC1164.2 +097800* SENDING AND RECEIVING ITEM HAVE SEPARATE SIGN CHARACTERS. NC1164.2 +097900 SIG-TEST-GF-11-1. NC1164.2 +098000 MOVE DS-LS-4 TO WRK-DS-LS-5. NC1164.2 +098100 IF GRP-09 EQUAL TO "-09127" NC1164.2 +098200 PERFORM PASS NC1164.2 +098300 GO TO SIG-WRTE-GF-11-1. NC1164.2 +098400 GO TO SIG-FAIL-GF-11-1. NC1164.2 +098500 SIG-DELETE-GF-11-1. NC1164.2 +098600 PERFORM DE-LETE. NC1164.2 +098700 PERFORM PRINT-DETAIL. NC1164.2 +098800 GO TO SIG-INIT-GF-12. NC1164.2 +098900 SIG-FAIL-GF-11-1. NC1164.2 +099000 PERFORM FAIL. NC1164.2 +099100 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +099200 MOVE "-09127" TO CORRECT-A. NC1164.2 +099300 MOVE "MOVE DS-LS-4 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +099400 SIG-WRTE-GF-11-1. NC1164.2 +099500 MOVE 1 TO REC-CT. NC1164.2 +099600 PERFORM PRINT-DETAIL. NC1164.2 +099700 SIG-TEST-GF-11-2. NC1164.2 +099800 MOVE DS-LS-4 TO WRK-DS-TS-5. NC1164.2 +099900 IF GRP-10 NOT EQUAL TO "09127-" NC1164.2 +100000 GO TO SIG-FAIL-GF-11-2. NC1164.2 +100100 PERFORM PASS. NC1164.2 +100200 GO TO SIG-WRTE-GF-11-2. NC1164.2 +100300 SIG-FAIL-GF-11-2. NC1164.2 +100400 PERFORM FAIL. NC1164.2 +100500 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +100600 MOVE "09127-" TO CORRECT-A. NC1164.2 +100700 MOVE "MOVE DS-LS-4 TO WRK-DS-TS-S" TO RE-MARK. NC1164.2 +100800 SIG-WRTE-GF-11-2. NC1164.2 +100900 MOVE 2 TO REC-CT. NC1164.2 +101000 PERFORM PRINT-DETAIL. NC1164.2 +101100 SIG-TEST-GF-11-3. NC1164.2 +101200 MOVE DS-TS-5 TO WRK-DS-LS-5. NC1164.2 +101300 IF GRP-09 EQUAL TO "+80361" NC1164.2 +101400 PERFORM PASS NC1164.2 +101500 GO TO SIG-WRTE-GF-11-3. NC1164.2 +101600 SIG-FAIL-GF-11-3. NC1164.2 +101700 PERFORM FAIL. NC1164.2 +101800 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +101900 MOVE "+80361" TO CORRECT-A. NC1164.2 +102000 MOVE "MOVE DS-TS-5 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +102100 SIG-WRTE-GF-11-3. NC1164.2 +102200 MOVE 3 TO REC-CT. NC1164.2 +102300 PERFORM PRINT-DETAIL. NC1164.2 +102400 SIG-TEST-GF-11-4. NC1164.2 +102500 MOVE DS-TS-5 TO WRK-DS-TS-5. NC1164.2 +102600 IF GRP-10 NOT EQUAL TO "80361+" NC1164.2 +102700 GO TO SIG-FAIL-GF-11-4. NC1164.2 +102800 PERFORM PASS. NC1164.2 +102900 GO TO SIG-WRTE-GF-11-4. NC1164.2 +103000 SIG-FAIL-GF-11-4. NC1164.2 +103100 PERFORM FAIL. NC1164.2 +103200 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +103300 MOVE "80361+" TO CORRECT-A. NC1164.2 +103400 MOVE "MOVE DS-TS-5 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +103500 SIG-WRTE-GF-11-4. NC1164.2 +103600 MOVE 4 TO REC-CT. NC1164.2 +103700 PERFORM PRINT-DETAIL. NC1164.2 +103800 SIG-INIT-GF-12. NC1164.2 +103900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +104000 MOVE "SIG-TEST-GF-12" TO PAR-NAME. NC1164.2 +104100 MOVE "SIGN CLAUSE ITEMS" TO FEATURE. NC1164.2 +104200* THIS TEST CONTAINS MOVE STATEMENTS WITH A SIGN IS NC1164.2 +104300* SEPARATE SENDING ITEM AND SIGN CLAUSE RECEIVING ITEMS, NC1164.2 +104400* BUT RECEIVING ITEMS SIGNS ARE NOT SEPARATE. NC1164.2 +104500 SIG-TEST-GF-12-1. NC1164.2 +104600 MOVE DS-LS-5 TO WRK-DS-L-5. NC1164.2 +104700 IF WRK-DS-L-5 NOT EQUAL TO +91275 NC1164.2 +104800 GO TO SIG-FAIL-GF-12-1. NC1164.2 +104900 PERFORM PASS. NC1164.2 +105000 GO TO SIG-WRTE-GF-12-1. NC1164.2 +105100 SIG-DELETE-GF-12-1. NC1164.2 +105200 PERFORM DE-LETE. NC1164.2 +105300 PERFORM PRINT-DETAIL. NC1164.2 +105400 GO TO SIG-INIT-GF-13. NC1164.2 +105500 SIG-FAIL-GF-12-1. NC1164.2 +105600 PERFORM FAIL. NC1164.2 +105700 MOVE WRK-DS-L-5 TO COMPUTED-18V0. NC1164.2 +105800 MOVE "+91275" TO CORRECT-A. NC1164.2 +105900 MOVE "MOVE DS-LS-5 TO WRK-DS-L-5" TO RE-MARK. NC1164.2 +106000 SIG-WRTE-GF-12-1. NC1164.2 +106100 MOVE 1 TO REC-CT. NC1164.2 +106200 PERFORM PRINT-DETAIL. NC1164.2 +106300 SIG-TEST-GF-12-2. NC1164.2 +106400 MOVE DS-LS-5 TO WRK-DS-T-5. NC1164.2 +106500 IF WRK-DS-T-5 NOT EQUAL TO +91275 NC1164.2 +106600 GO TO SIG-FAIL-GF-12-2. NC1164.2 +106700 PERFORM PASS. NC1164.2 +106800 GO TO SIG-WRTE-GF-12-2. NC1164.2 +106900 SIG-FAIL-GF-12-2. NC1164.2 +107000 PERFORM FAIL. NC1164.2 +107100 MOVE "+91275" TO CORRECT-A. NC1164.2 +107200 MOVE WRK-DS-T-5 TO COMPUTED-18V0. NC1164.2 +107300 MOVE "MOVE DS-LS-5 TO WRK-DS-T-5" TO RE-MARK. NC1164.2 +107400 SIG-WRTE-GF-12-2. NC1164.2 +107500 MOVE 2 TO REC-CT. NC1164.2 +107600 PERFORM PRINT-DETAIL. NC1164.2 +107700 SIG-TEST-GF-12-3. NC1164.2 +107800 MOVE DS-TS-5 TO WRK-DS-L-5. NC1164.2 +107900 IF WRK-DS-L-5 NOT EQUAL TO +80361 NC1164.2 +108000 GO TO SIG-FAIL-GF-12-3. NC1164.2 +108100 PERFORM PASS. NC1164.2 +108200 GO TO SIG-WRITE-GF-12-3. NC1164.2 +108300 SIG-FAIL-GF-12-3. NC1164.2 +108400 PERFORM FAIL. NC1164.2 +108500 MOVE "+80361" TO CORRECT-A. NC1164.2 +108600 MOVE WRK-DS-L-5 TO COMPUTED-18V0. NC1164.2 +108700 MOVE "MOVE DS-TS-5 TO WRK-DS-L-5" TO RE-MARK. NC1164.2 +108800 SIG-WRITE-GF-12-3. NC1164.2 +108900 MOVE 3 TO REC-CT. NC1164.2 +109000 PERFORM PRINT-DETAIL. NC1164.2 +109100 SIG-TEST-GF-12-4. NC1164.2 +109200 MOVE DS-TS-5 TO WRK-DS-T-5. NC1164.2 +109300 IF WRK-DS-T-5 NOT EQUAL TO +80361 NC1164.2 +109400 GO TO SIG-FAIL-GF-12-4. NC1164.2 +109500 PERFORM PASS. NC1164.2 +109600 GO TO SIG-WRITE-GF-12-4. NC1164.2 +109700 SIG-FAIL-GF-12-4. NC1164.2 +109800 PERFORM FAIL. NC1164.2 +109900 MOVE "+80361" TO CORRECT-A. NC1164.2 +110000 MOVE WRK-DS-T-5 TO COMPUTED-18V0. NC1164.2 +110100 MOVE "MOVE DS-TS-5 TO WRK-DS-T-5" TO RE-MARK. NC1164.2 +110200 SIG-WRITE-GF-12-4. NC1164.2 +110300 MOVE 4 TO REC-CT. NC1164.2 +110400 PERFORM PRINT-DETAIL. NC1164.2 +110500 SIG-INIT-GF-13. NC1164.2 +110600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +110700 MOVE "SIG-TEST-GF-13" TO PAR-NAME. NC1164.2 +110800* THIS TEST CONTAINS MOVE STATEMENTS WITH A SIGN IS NC1164.2 +110900* SEPARATE RECEIVING ITEM AND SENDING ITEMS WITH A SIGN NC1164.2 +111000* CLAUSE BUT THE SIGN IS NOT SEPARATE. NC1164.2 +111100 MOVE ZERO TO WRK-DS-LS-5. NC1164.2 +111200 MOVE ZERO TO WRK-DS-TS-5. NC1164.2 +111300 SIG-TEST-GF-13-1. NC1164.2 +111400 MOVE DS-L-5 TO WRK-DS-LS-5. NC1164.2 +111500 IF GRP-09 EQUAL TO "+91275" NC1164.2 +111600 PERFORM PASS NC1164.2 +111700 GO TO SIG-WRITE-GF-13-1. NC1164.2 +111800 GO TO SIG-FAIL-GF-13-1. NC1164.2 +111900 SIG-DELETE-GF-13-1. NC1164.2 +112000 PERFORM DE-LETE. NC1164.2 +112100 PERFORM PRINT-DETAIL. NC1164.2 +112200 GO TO SIG-INIT-GF-14. NC1164.2 +112300 SIG-FAIL-GF-13-1. NC1164.2 +112400 PERFORM FAIL. NC1164.2 +112500 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +112600 MOVE "+91275" TO CORRECT-A. NC1164.2 +112700 MOVE "MOVE DS-L-5 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +112800 SIG-WRITE-GF-13-1. NC1164.2 +112900 MOVE 1 TO REC-CT. NC1164.2 +113000 PERFORM PRINT-DETAIL. NC1164.2 +113100 SIG-TEST-GF-13-2. NC1164.2 +113200 MOVE DS-T-4 TO WRK-DS-LS-5. NC1164.2 +113300 IF GRP-09 EQUAL TO "-03621" NC1164.2 +113400 PERFORM PASS NC1164.2 +113500 GO TO SIG-WRITE-GF-13-2. NC1164.2 +113600 SIG-FAIL-GF-13-2. NC1164.2 +113700 PERFORM FAIL. NC1164.2 +113800 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +113900 MOVE "-03621" TO CORRECT-A. NC1164.2 +114000 MOVE "MOVE DS-T-4 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +114100 SIG-WRITE-GF-13-2. NC1164.2 +114200 MOVE 2 TO REC-CT. NC1164.2 +114300 PERFORM PRINT-DETAIL. NC1164.2 +114400 SIG-TEST-GF-13-3. NC1164.2 +114500 MOVE DS-L-5 TO WRK-DS-TS-5. NC1164.2 +114600 IF GRP-10 EQUAL TO "91275+" NC1164.2 +114700 PERFORM PASS NC1164.2 +114800 GO TO SIG-WRITE-GF-13-3. NC1164.2 +114900 SIG-FAIL-GF-13-3. NC1164.2 +115000 PERFORM FAIL. NC1164.2 +115100 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +115200 MOVE "91275+" TO CORRECT-A. NC1164.2 +115300 MOVE "MOVE DS-L-5 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +115400 SIG-WRITE-GF-13-3. NC1164.2 +115500 MOVE 3 TO REC-CT. NC1164.2 +115600 PERFORM PRINT-DETAIL. NC1164.2 +115700 SIG-TEST-GF-13-4. NC1164.2 +115800 MOVE DS-T-4 TO WRK-DS-TS-5. NC1164.2 +115900 IF GRP-10 EQUAL TO "03621-" NC1164.2 +116000 PERFORM PASS NC1164.2 +116100 GO TO SIG-WRITE-GF-13-4. NC1164.2 +116200 SIG-FAIL-GF-13-4. NC1164.2 +116300 PERFORM FAIL. NC1164.2 +116400 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +116500 MOVE "03621-" TO CORRECT-A. NC1164.2 +116600 MOVE "MOVE DS-T-4 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +116700 SIG-WRITE-GF-13-4. NC1164.2 +116800 MOVE 4 TO REC-CT. NC1164.2 +116900 PERFORM PRINT-DETAIL. NC1164.2 +117000 SIG-INIT-GF-14. NC1164.2 +117100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +117200 MOVE "SIG-TEST-GF-14" TO PAR-NAME. NC1164.2 +117300 MOVE "SIGNED NUM. TO ALPHA" TO FEATURE. NC1164.2 +117400* THIS TEST CONTAINS MOVE STATEMENTS WITH A SIGNED NC1164.2 +117500* NUMERIC SENDING ITEM AND ALPHANUMERIC RECEIVING ITEM. NC1164.2 +117600* THE OPERATIONAL SIGN SHOULD NOT BE MOVED AND SPACE NC1164.2 +117700* FILLING ON THE RIGHT SHOULD OCCUR. NC1164.2 +117800 SIG-TEST-GF-14-1. NC1164.2 +117900 MOVE DS-LS-5 TO AN-006. NC1164.2 +118000 IF AN-006 EQUAL TO "91275 " NC1164.2 +118100 PERFORM PASS NC1164.2 +118200 GO TO SIG-WRITE-GF-14-1. NC1164.2 +118300 GO TO SIG-FAIL-GF-14-1. NC1164.2 +118400 SIG-DELETE-GF-14-1. NC1164.2 +118500 PERFORM DE-LETE. NC1164.2 +118600 PERFORM PRINT-DETAIL. NC1164.2 +118700 GO TO SIG-INIT-GF-15. NC1164.2 +118800 SIG-FAIL-GF-14-1. NC1164.2 +118900 PERFORM FAIL. NC1164.2 +119000 MOVE AN-006 TO COMPUTED-A. NC1164.2 +119100 MOVE "91275 " TO CORRECT-A. NC1164.2 +119200 MOVE "MOVE DS-LS-5 TO AN-006" TO RE-MARK. NC1164.2 +119300 SIG-WRITE-GF-14-1. NC1164.2 +119400 MOVE 1 TO REC-CT. NC1164.2 +119500 PERFORM PRINT-DETAIL. NC1164.2 +119600 SIG-TEST-GF-14-2. NC1164.2 +119700 MOVE SPACE TO AN-006. NC1164.2 +119800 MOVE DS-TS-4 TO AN-006. NC1164.2 +119900 IF AN-006 NOT EQUAL TO "8036 " NC1164.2 +120000 GO TO SIG-FAIL-GF-14-2. NC1164.2 +120100 PERFORM PASS. NC1164.2 +120200 GO TO SIG-WRITE-GF-14-2. NC1164.2 +120300 SIG-FAIL-GF-14-2. NC1164.2 +120400 PERFORM FAIL. NC1164.2 +120500 MOVE AN-006 TO COMPUTED-A. NC1164.2 +120600 MOVE "8036 " TO CORRECT-A. NC1164.2 +120700 MOVE "MOVE DS-TS-4 TO AN-006" TO RE-MARK. NC1164.2 +120800 SIG-WRITE-GF-14-2. NC1164.2 +120900 MOVE 2 TO REC-CT. NC1164.2 +121000 PERFORM PRINT-DETAIL. NC1164.2 +121100 SIG-TEST-GF-14-3. NC1164.2 +121200 MOVE SPACE TO AN-006. NC1164.2 +121300 MOVE DS-L-4 TO AN-006. NC1164.2 +121400 IF AN-006 EQUAL TO "9127 " NC1164.2 +121500 PERFORM PASS NC1164.2 +121600 GO TO SIG-WRITE-GF-14-3. NC1164.2 +121700 SIG-FAIL-GF-14-3. NC1164.2 +121800 PERFORM FAIL. NC1164.2 +121900 MOVE AN-006 TO COMPUTED-A. NC1164.2 +122000 MOVE "9127 " TO CORRECT-A. NC1164.2 +122100 MOVE "MOVE DS-L-4 TO AN-006" TO RE-MARK. NC1164.2 +122200 SIG-WRITE-GF-14-3. NC1164.2 +122300 MOVE 3 TO REC-CT. NC1164.2 +122400 PERFORM PRINT-DETAIL. NC1164.2 +122500 SIG-TEST-GF-14-4. NC1164.2 +122600 MOVE SPACE TO AN-006. NC1164.2 +122700 MOVE DS-T-5 TO AN-006. NC1164.2 +122800 IF AN-006 NOT EQUAL TO "83621 " NC1164.2 +122900 GO TO SIG-FAIL-GF-14-4. NC1164.2 +123000 PERFORM PASS. NC1164.2 +123100 GO TO SIG-WRITE-GF-14-4. NC1164.2 +123200 SIG-FAIL-GF-14-4. NC1164.2 +123300 PERFORM FAIL. NC1164.2 +123400 MOVE AN-006 TO COMPUTED-A. NC1164.2 +123500 MOVE "83621 " TO CORRECT-A. NC1164.2 +123600 MOVE "MOVE DS-T-5 TO AN-006" TO RE-MARK. NC1164.2 +123700 SIG-WRITE-GF-14-4. NC1164.2 +123800 MOVE 4 TO REC-CT. NC1164.2 +123900 PERFORM PRINT-DETAIL. NC1164.2 +124000 SIG-INIT-GF-15. NC1164.2 +124100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +124200 MOVE "SIG-TEST-GF-15" TO PAR-NAME. NC1164.2 +124300 MOVE 15759 TO DU-005 CU-005. NC1164.2 +124400 MOVE -15759 TO DS-005 CS-005. NC1164.2 +124500* THIS TEST MOVES SIGNED AND UNSIGNED DISPLAY ITEMS, NC1164.2 +124600* SIGNED AND UNSIGNED COMPUTATIONAL ITEMS, AND SIGNED AND NC1164.2 +124700* UNSIGNED NUMERIC LITERALS TO A NUMERIC ITEM WITH SIGN NC1164.2 +124800* LEADING SEPARATE. NC1164.2 +124900 MOVE "RECEIVING ITEM DS-LS" TO FEATURE. NC1164.2 +125000 SIG-TEST-GF-15-1. NC1164.2 +125100 MOVE SPACE TO GRP-09. NC1164.2 +125200 MOVE DU-005 TO WRK-DS-LS-5. NC1164.2 +125300 IF GRP-09 EQUAL TO "+15759" NC1164.2 +125400 PERFORM PASS NC1164.2 +125500 GO TO SIG-WRITE-GF-15-1. NC1164.2 +125600 GO TO SIG-FAIL-GF-15-1. NC1164.2 +125700 SIG-DELETE-GF-15-1. NC1164.2 +125800 PERFORM DE-LETE. NC1164.2 +125900 PERFORM PRINT-DETAIL. NC1164.2 +126000 GO TO SIG-INIT-GF-16. NC1164.2 +126100 SIG-FAIL-GF-15-1. NC1164.2 +126200 PERFORM FAIL. NC1164.2 +126300 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +126400 MOVE "+15759" TO CORRECT-A. NC1164.2 +126500 MOVE "MOVE DU-005 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +126600 SIG-WRITE-GF-15-1. NC1164.2 +126700 MOVE 1 TO REC-CT. NC1164.2 +126800 PERFORM PRINT-DETAIL. NC1164.2 +126900 SIG-TEST-GF-15-2. NC1164.2 +127000 MOVE SPACE TO GRP-09. NC1164.2 +127100 MOVE CU-005 TO WRK-DS-LS-5. NC1164.2 +127200 IF GRP-09 NOT EQUAL TO "+15759" NC1164.2 +127300 GO TO SIG-FAIL-GF-15-2. NC1164.2 +127400 PERFORM PASS NC1164.2 +127500 GO TO SIG-WRITE-GF-15-2. NC1164.2 +127600 SIG-FAIL-GF-15-2. NC1164.2 +127700 PERFORM FAIL. NC1164.2 +127800 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +127900 MOVE "+15759" TO CORRECT-A. NC1164.2 +128000 MOVE "MOVE CU-005 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +128100 SIG-WRITE-GF-15-2. NC1164.2 +128200 MOVE 2 TO REC-CT. NC1164.2 +128300 PERFORM PRINT-DETAIL. NC1164.2 +128400 SIG-TEST-GF-15-3. NC1164.2 +128500 MOVE SPACE TO GRP-09. NC1164.2 +128600 MOVE DS-005 TO WRK-DS-LS-5. NC1164.2 +128700 IF GRP-09 EQUAL TO "-15759" NC1164.2 +128800 PERFORM PASS NC1164.2 +128900 GO TO SIG-WRITE-GF-15-3. NC1164.2 +129000 SIG-FAIL-GF-15-3. NC1164.2 +129100 PERFORM FAIL. NC1164.2 +129200 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +129300 MOVE "-15759" TO CORRECT-A. NC1164.2 +129400 MOVE "MOVE DS-005 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +129500 SIG-WRITE-GF-15-3. NC1164.2 +129600 MOVE 3 TO REC-CT. NC1164.2 +129700 PERFORM PRINT-DETAIL. NC1164.2 +129800 SIG-TEST-GF-15-4. NC1164.2 +129900 MOVE SPACE TO GRP-09. NC1164.2 +130000 MOVE CS-005 TO WRK-DS-LS-5. NC1164.2 +130100 IF GRP-09 NOT EQUAL TO "-15759" NC1164.2 +130200 GO TO SIG-FAIL-GF-15-4. NC1164.2 +130300 PERFORM PASS. NC1164.2 +130400 GO TO SIG-WRITE-GF-15-4. NC1164.2 +130500 SIG-FAIL-GF-15-4. NC1164.2 +130600 PERFORM FAIL. NC1164.2 +130700 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +130800 MOVE "-15759" TO CORRECT-A. NC1164.2 +130900 MOVE "MOVE CS-005 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +131000 SIG-WRITE-GF-15-4. NC1164.2 +131100 MOVE 4 TO REC-CT. NC1164.2 +131200 PERFORM PRINT-DETAIL. NC1164.2 +131300 SIG-TEST-GF-15-5. NC1164.2 +131400 MOVE SPACE TO GRP-09. NC1164.2 +131500 MOVE 15759 TO WRK-DS-LS-5. NC1164.2 +131600 IF GRP-09 EQUAL TO "+15759" NC1164.2 +131700 PERFORM PASS NC1164.2 +131800 GO TO SIG-WRITE-GF-15-5. NC1164.2 +131900 SIG-FAIL-GF-15-5. NC1164.2 +132000 PERFORM FAIL. NC1164.2 +132100 MOVE "+15759" TO CORRECT-A. NC1164.2 +132200 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +132300 MOVE "MOVE 15759 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +132400 SIG-WRITE-GF-15-5. NC1164.2 +132500 MOVE 5 TO REC-CT. NC1164.2 +132600 PERFORM PRINT-DETAIL. NC1164.2 +132700 SIG-TEST-GF-15-6. NC1164.2 +132800 MOVE SPACE TO GRP-09. NC1164.2 +132900 MOVE -15759 TO WRK-DS-LS-5. NC1164.2 +133000 IF GRP-09 NOT EQUAL TO "-15759" NC1164.2 +133100 GO TO SIG-FAIL-GF-15-6. NC1164.2 +133200 PERFORM PASS. NC1164.2 +133300 GO TO SIG-WRITE-GF-15-6. NC1164.2 +133400 SIG-FAIL-GF-15-6. NC1164.2 +133500 PERFORM FAIL. NC1164.2 +133600 MOVE GRP-09 TO COMPUTED-A. NC1164.2 +133700 MOVE "-15759" TO CORRECT-A. NC1164.2 +133800 MOVE "MOVE -15759 TO WRK-DS-LS-5" TO RE-MARK. NC1164.2 +133900 SIG-WRITE-GF-15-6. NC1164.2 +134000 MOVE 6 TO REC-CT. NC1164.2 +134100 PERFORM PRINT-DETAIL. NC1164.2 +134200 SIG-INIT-GF-16. NC1164.2 +134300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1164.2 +134400 MOVE "SIG-TEST-GF-16" TO PAR-NAME. NC1164.2 +134500 MOVE "RECEIVING ITEM DS-TS" TO FEATURE. NC1164.2 +134600* THIS TEST MOVES SIGNED AND UNSIGNED DISPLAY ITEMS, NC1164.2 +134700* SIGNED AND UNSIGNED COMPUTATIONAL ITEMS, AND SIGNED AND NC1164.2 +134800* UNSIGNED NUMERIC LITERALS TO A NUMERIC ITEM WITH SIGN NC1164.2 +134900* TRAILING SEPARATE CLAUSE. NC1164.2 +135000 MOVE SPACE TO GRP-10. NC1164.2 +135100 MOVE DU-005 TO WRK-DS-TS-5. NC1164.2 +135200 SIG-TEST-GF-16-1. NC1164.2 +135300 IF GRP-10 EQUAL TO "15759+" NC1164.2 +135400 PERFORM PASS NC1164.2 +135500 GO TO SIG-WRITE-GF-16-1. NC1164.2 +135600 GO TO SIG-FAIL-GF-16-1. NC1164.2 +135700 SIG-DELETE-GF-16-1. NC1164.2 +135800 PERFORM DE-LETE. NC1164.2 +135900 PERFORM PRINT-DETAIL. NC1164.2 +136000 GO TO SIG-INIT-GF-17. NC1164.2 +136100 SIG-FAIL-GF-16-1. NC1164.2 +136200 PERFORM FAIL. NC1164.2 +136300 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +136400 MOVE "15759+" TO CORRECT-A. NC1164.2 +136500 MOVE "MOVE DU-005 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +136600 SIG-WRITE-GF-16-1. NC1164.2 +136700 MOVE 1 TO REC-CT. NC1164.2 +136800 PERFORM PRINT-DETAIL. NC1164.2 +136900 SIG-TEST-GF-16-2. NC1164.2 +137000 MOVE SPACE TO GRP-10. NC1164.2 +137100 MOVE CU-005 TO WRK-DS-TS-5. NC1164.2 +137200 IF GRP-10 NOT EQUAL TO "15759+" NC1164.2 +137300 GO TO SIG-FAIL-GF-16-2. NC1164.2 +137400 PERFORM PASS. NC1164.2 +137500 GO TO SIG-WRITE-GF-16-2. NC1164.2 +137600 SIG-FAIL-GF-16-2. NC1164.2 +137700 PERFORM FAIL. NC1164.2 +137800 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +137900 MOVE "15759+" TO CORRECT-A. NC1164.2 +138000 MOVE "MOVE CU-005 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +138100 SIG-WRITE-GF-16-2. NC1164.2 +138200 MOVE 2 TO REC-CT. NC1164.2 +138300 PERFORM PRINT-DETAIL. NC1164.2 +138400 SIG-TEST-GF-16-3. NC1164.2 +138500 MOVE SPACE TO GRP-10. NC1164.2 +138600 MOVE DS-005 TO WRK-DS-TS-5. NC1164.2 +138700 IF GRP-10 EQUAL TO "15759-" NC1164.2 +138800 PERFORM PASS NC1164.2 +138900 GO TO SIG-WRITE-GF-16-3. NC1164.2 +139000 SIG-FAIL-GF-16-3. NC1164.2 +139100 PERFORM FAIL. NC1164.2 +139200 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +139300 MOVE "15759-" TO CORRECT-A. NC1164.2 +139400 MOVE "MOVE DS-005 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +139500 SIG-WRITE-GF-16-3. NC1164.2 +139600 MOVE 3 TO REC-CT. NC1164.2 +139700 PERFORM PRINT-DETAIL. NC1164.2 +139800 SIG-TEST-GF-16-4. NC1164.2 +139900 MOVE SPACE TO GRP-10. NC1164.2 +140000 MOVE CS-005 TO WRK-DS-TS-5. NC1164.2 +140100 IF GRP-10 NOT EQUAL TO "15759-" NC1164.2 +140200 GO TO SIG-FAIL-GF-16-4. NC1164.2 +140300 PERFORM PASS. NC1164.2 +140400 GO TO SIG-WRITE-GF-16-4. NC1164.2 +140500 SIG-FAIL-GF-16-4. NC1164.2 +140600 PERFORM FAIL. NC1164.2 +140700 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +140800 MOVE "15759-" TO CORRECT-A. NC1164.2 +140900 MOVE "MOVE CS-005 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +141000 SIG-WRITE-GF-16-4. NC1164.2 +141100 MOVE 4 TO REC-CT. NC1164.2 +141200 PERFORM PRINT-DETAIL. NC1164.2 +141300 SIG-TEST-GF-16-5. NC1164.2 +141400 MOVE SPACE TO GRP-10. NC1164.2 +141500 MOVE 15759 TO WRK-DS-TS-5. NC1164.2 +141600 IF GRP-10 EQUAL TO "15759+" NC1164.2 +141700 PERFORM PASS NC1164.2 +141800 GO TO SIG-WRITE-GF-16-5. NC1164.2 +141900 SIG-FAIL-GF-16-5. NC1164.2 +142000 PERFORM FAIL. NC1164.2 +142100 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +142200 MOVE "15759+" TO CORRECT-A. NC1164.2 +142300 MOVE "MOVE 15759 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +142400 SIG-WRITE-GF-16-5. NC1164.2 +142500 MOVE 5 TO REC-CT. NC1164.2 +142600 PERFORM PRINT-DETAIL. NC1164.2 +142700 SIG-TEST-GF-16-6. NC1164.2 +142800 MOVE SPACE TO GRP-10. NC1164.2 +142900 MOVE -15759 TO WRK-DS-TS-5. NC1164.2 +143000 IF GRP-10 NOT EQUAL TO "15759-" NC1164.2 +143100 GO TO SIG-FAIL-GF-16-6. NC1164.2 +143200 PERFORM PASS. NC1164.2 +143300 GO TO SIG-WRITE-GF-16-6. NC1164.2 +143400 SIG-FAIL-GF-16-6. NC1164.2 +143500 PERFORM FAIL. NC1164.2 +143600 MOVE GRP-10 TO COMPUTED-A. NC1164.2 +143700 MOVE "15759-" TO CORRECT-A. NC1164.2 +143800 MOVE "MOVE -15759 TO WRK-DS-TS-5" TO RE-MARK. NC1164.2 +143900 SIG-WRITE-GF-16-6. NC1164.2 +144000 MOVE 6 TO REC-CT. NC1164.2 +144100 PERFORM PRINT-DETAIL. NC1164.2 +144200* NC1164.2 +144300 SIG-INIT-GF-17. NC1164.2 +144400 MOVE "VI-42 5.12.4 GR2" TO ANSI-REFERENCE. NC1164.2 +144500 MOVE "SIG-TEST-GF-17" TO PAR-NAME. NC1164.2 +144600 MOVE "PRECEDENCE OF SUBORDINATE SIGN CLAUSE" TO FEATURE. NC1164.2 +144700 MOVE 1234 TO TEST-17-C. NC1164.2 +144800 MOVE 0 TO REC-CT. NC1164.2 +144900 SIG-TEST-GF-17. NC1164.2 +145000 IF TEST-17-C-SIGN = "+" NC1164.2 +145100 PERFORM PASS NC1164.2 +145200 GO TO SIG-WRITE-GF-17 NC1164.2 +145300 ELSE NC1164.2 +145400 GO TO SIG-FAIL-GF-17. NC1164.2 +145500 SIG-DELETE-GF-17. NC1164.2 +145600 PERFORM DE-LETE. NC1164.2 +145700 GO TO SIG-WRITE-GF-17. NC1164.2 +145800 SIG-FAIL-GF-17. NC1164.2 +145900 PERFORM FAIL. NC1164.2 +146000 MOVE "POSITIVE SIGN EXPECTED" TO RE-MARK. NC1164.2 +146100 MOVE "+" TO CORRECT-X. NC1164.2 +146200 MOVE TEST-17-C-SIGN TO COMPUTED-X. NC1164.2 +146300 SIG-WRITE-GF-17. NC1164.2 +146400 PERFORM PRINT-DETAIL. NC1164.2 +146500* NC1164.2 +146600 SIG-INIT-GF-18. NC1164.2 +146700 MOVE "VI-42 5.12.4 GR3" TO ANSI-REFERENCE. NC1164.2 +146800 MOVE "SIG-TEST-GF-18" TO PAR-NAME. NC1164.2 +146900 MOVE "PRECEDENCE OF SUBORDINATE SIGN CLAUSE" TO FEATURE. NC1164.2 +147000 MOVE 1234 TO TEST-18-B. NC1164.2 +147100 MOVE 0 TO REC-CT. NC1164.2 +147200 SIG-TEST-GF-18. NC1164.2 +147300 IF TEST-18-B-SIGN = "+" NC1164.2 +147400 PERFORM PASS NC1164.2 +147500 GO TO SIG-WRITE-GF-18 NC1164.2 +147600 ELSE NC1164.2 +147700 GO TO SIG-FAIL-GF-18. NC1164.2 +147800 SIG-DELETE-GF-18. NC1164.2 +147900 PERFORM DE-LETE. NC1164.2 +148000 GO TO SIG-WRITE-GF-18. NC1164.2 +148100 SIG-FAIL-GF-18. NC1164.2 +148200 PERFORM FAIL. NC1164.2 +148300 MOVE "POSITIVE SIGN EXPECTED" TO RE-MARK. NC1164.2 +148400 MOVE "+" TO CORRECT-X. NC1164.2 +148500 MOVE TEST-18-B-SIGN TO COMPUTED-X. NC1164.2 +148600 SIG-WRITE-GF-18. NC1164.2 +148700 PERFORM PRINT-DETAIL. NC1164.2 +148800* NC1164.2 +148900 TERMINATE-ROUTINE. NC1164.2 +149000 EXIT. NC1164.2 +149100 CCVS-EXIT SECTION. NC1164.2 +149200 CCVS-999999. NC1164.2 +149300 GO TO CLOSE-FILES. NC1164.2 diff --git a/tests/cobol85/NC/NC117A.CBL b/tests/cobol85/NC/NC117A.CBL new file mode 100755 index 00000000..3f61634d --- /dev/null +++ b/tests/cobol85/NC/NC117A.CBL @@ -0,0 +1,1208 @@ +000100 IDENTIFICATION DIVISION. NC1174.2 +000200 PROGRAM-ID. NC1174.2 +000300 NC117A. NC1174.2 +000400**************************************************************** NC1174.2 +000500* * NC1174.2 +000600* VALIDATION FOR:- * NC1174.2 +000700* * NC1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1174.2 +000900* * NC1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1174.2 +001100* * NC1174.2 +001200**************************************************************** NC1174.2 +001300* * NC1174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1174.2 +001500* * NC1174.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1174.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1174.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1174.2 +001900* * NC1174.2 +002000**************************************************************** NC1174.2 +002100* NC1174.2 +002200* PROGRAM NC117A TESTS THE USE OF THE "SIGN" CLAUSE USING NC1174.2 +002300* THE "DIVIDE" STATEMENT. ALL COMBINATIONS OF THE "SIGN" NC1174.2 +002400* CLAUSE PHRASES ARE TESTED USING DATA ITEMS OF NC1174.2 +002500* LENGTHS. NC1174.2 +002600* NC1174.2 +002700* NC1174.2 +002800 NC1174.2 +002900 NC1174.2 +003000 ENVIRONMENT DIVISION. NC1174.2 +003100 CONFIGURATION SECTION. NC1174.2 +003200 SOURCE-COMPUTER. NC1174.2 +003300 Linux. NC1174.2 +003400 OBJECT-COMPUTER. NC1174.2 +003500 Linux. NC1174.2 +003600 INPUT-OUTPUT SECTION. NC1174.2 +003700 FILE-CONTROL. NC1174.2 +003800 SELECT PRINT-FILE ASSIGN TO NC1174.2 +003900 "report.log". NC1174.2 +004000 DATA DIVISION. NC1174.2 +004100 FILE SECTION. NC1174.2 +004200 FD PRINT-FILE. NC1174.2 +004300 01 PRINT-REC PICTURE X(120). NC1174.2 +004400 01 DUMMY-RECORD PICTURE X(120). NC1174.2 +004500 WORKING-STORAGE SECTION. NC1174.2 +004600 77 WRK-DS-LS-18V00 PICTURE S9(18) NC1174.2 +004700 SIGN IS LEADING SEPARATE CHARACTER. NC1174.2 +004800 77 A06THREES-DS-LS-03V03 PICTURE S999V999 VALUE 333.333NC1174.2 +004900 SIGN IS LEADING. NC1174.2 +005000 77 WRK-DS-TS-06V06 PICTURE S9(6)V9(6) NC1174.2 +005100 SIGN IS TRAILING SEPARATE CHARACTER. NC1174.2 +005200 77 WRK-DS-TS-12V00-S-S REDEFINES WRK-DS-TS-06V06 PICTURE S9(12) NC1174.2 +005300 SIGN TRAILING SEPARATE. NC1174.2 +005400 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1174.2 +005500 77 WRK-DS-10V00 PICTURE S9(10). NC1174.2 +005600 77 WRK-XN-00001 PICTURE X. NC1174.2 +005700 77 A10ONES-DS-T-10V00 PICTURE S9(10) NC1174.2 +005800 SIGN IS TRAILING NC1174.2 +005900 VALUE 1111111111. NC1174.2 +006000 77 A12THREES-DS-LS-06V06 PICTURE S9(6)V9(6) NC1174.2 +006100 SIGN IS LEADING SEPARATE NC1174.2 +006200 VALUE 333333.333333. NC1174.2 +006300 77 WRK-DS-02V00 PICTURE S99. NC1174.2 +006400 77 AZERO-DS-LS-05V05 PICTURE S9(5)V9(5) VALUE ZERO NC1174.2 +006500 SIGN IS LEADING SEPARATE CHARACTER. NC1174.2 +006600 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1174.2 +006700 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1174.2 +006800 77 A05ONES-DS-LS-00V05 PICTURE SV9(5) VALUE .11111 NC1174.2 +006900 SIGN IS LEADING SEPARATE CHARACTER. NC1174.2 +007000 77 A12ONES-DS-12V00 PICTURE S9(12) NC1174.2 +007100 VALUE 111111111111. NC1174.2 +007200 77 A01ONE-DS-TS-P0801 PICTURE SP(8)9 VALUE .000000001NC1174.2 +007300 SIGN IS TRAILING SEPARATE. NC1174.2 +007400 77 WRK-DS-T-09V08 PICTURE S9(9)V9(8) NC1174.2 +007500 SIGN IS TRAILING. NC1174.2 +007600 77 WKR-DS-T-17V00-S REDEFINES WRK-DS-T-09V08 PICTURE S9(17) NC1174.2 +007700 SIGN TRAILING. NC1174.2 +007800 77 A18ONES-DS-18V00 PICTURE S9(18) NC1174.2 +007900 VALUE 111111111111111111. NC1174.2 +008000 77 WRK-DS-LS-0201P PICTURE S99P NC1174.2 +008100 SIGN IS LEADING SEPARATE. NC1174.2 +008200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1174.2 +008300 77 WRK-DU-18V00 PICTURE 9(18). NC1174.2 +008400 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1174.2 +008500 VALUE 99. NC1174.2 +008600 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1174.2 +008700 VALUE .1. NC1174.2 +008800 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1174.2 +008900 77 WRK-DS-TS-12V00-S PICTURE S9(12) NC1174.2 +009000 SIGN IS TRAILING SEPARATE CHARACTER. NC1174.2 +009100 77 WRK-DS-LS-01V00 PICTURE S9 LEADING SEPARATE. NC1174.2 +009200 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1174.2 +009300 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1174.2 +009400 LEADING SEPARATE NC1174.2 +009500 VALUE 111111111.111111111. NC1174.2 +009600 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1174.2 +009700 77 WRK-DS-05V00 PICTURE S9(5). NC1174.2 +009800 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1174.2 +009900 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1174.2 +010000 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1174.2 +010100 77 XRAY PICTURE X. NC1174.2 +010200 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1174.2 +010300 VALUE +000000000000000001. NC1174.2 +010400 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1174.2 +010500 VALUE -000000000000000033. NC1174.2 +010600 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1174.2 +010700 VALUE 666666666666666666. NC1174.2 +010800 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1174.2 +010900 VALUE 009999999999999999. NC1174.2 +011000 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1174.2 +011100 VALUE 000022222222222222. NC1174.2 +011200 01 MULTIPLY-DATA LEADING SEPARATE. NC1174.2 +011300 02 MULT1 PICTURE IS 999V99 NC1174.2 +011400 VALUE IS 80.12. NC1174.2 +011500 02 MULT2 PICTURE IS 999V999. NC1174.2 +011600 02 MULT3 PICTURE IS $$99.99. NC1174.2 +011700 02 MULT4 PICTURE IS S99 NC1174.2 +011800 VALUE IS -56. NC1174.2 +011900 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1174.2 +012000 02 MULT6 PICTURE IS 99 VALUE IS NC1174.2 +012100 20. NC1174.2 +012200 01 DIVIDE-DATA TRAILING SEPARATE. NC1174.2 +012300 02 DIV1 PICTURE IS 9(4)V99 NC1174.2 +012400 VALUE IS 1620.36. NC1174.2 +012500 02 DIV2 PICTURE IS 99V9 NC1174.2 +012600 VALUE IS 44.1. NC1174.2 +012700 02 DIV3 PICTURE IS 9(4)V9 NC1174.2 +012800 VALUE IS 1661.7. NC1174.2 +012900 02 DIV4 PICTURE IS S9V999 NC1174.2 +013000 VALUE IS -9.642. NC1174.2 +013100 02 SIG-02LEVEL-1. NC1174.2 +013200 03 DIV5 PICTURE IS V99 NC1174.2 +013300 VALUE IS .82. NC1174.2 +013400 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1174.2 +013500 03 DIV7 PICTURE IS 9V9 NC1174.2 +013600 VALUE IS 9.6. NC1174.2 +013700 01 SIG-DATA-2. NC1174.2 +013800 02 DIV8 PICTURE IS 99V9. NC1174.2 +013900 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1174.2 +014000 02 DIV10 PICTURE IS V999. NC1174.2 +014100 01 TEST-RESULTS. NC1174.2 +014200 02 FILLER PIC X VALUE SPACE. NC1174.2 +014300 02 FEATURE PIC X(20) VALUE SPACE. NC1174.2 +014400 02 FILLER PIC X VALUE SPACE. NC1174.2 +014500 02 P-OR-F PIC X(5) VALUE SPACE. NC1174.2 +014600 02 FILLER PIC X VALUE SPACE. NC1174.2 +014700 02 PAR-NAME. NC1174.2 +014800 03 FILLER PIC X(19) VALUE SPACE. NC1174.2 +014900 03 PARDOT-X PIC X VALUE SPACE. NC1174.2 +015000 03 DOTVALUE PIC 99 VALUE ZERO. NC1174.2 +015100 02 FILLER PIC X(8) VALUE SPACE. NC1174.2 +015200 02 RE-MARK PIC X(61). NC1174.2 +015300 01 TEST-COMPUTED. NC1174.2 +015400 02 FILLER PIC X(30) VALUE SPACE. NC1174.2 +015500 02 FILLER PIC X(17) VALUE NC1174.2 +015600 " COMPUTED=". NC1174.2 +015700 02 COMPUTED-X. NC1174.2 +015800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1174.2 +015900 03 COMPUTED-N REDEFINES COMPUTED-A NC1174.2 +016000 PIC -9(9).9(9). NC1174.2 +016100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1174.2 +016200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1174.2 +016300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1174.2 +016400 03 CM-18V0 REDEFINES COMPUTED-A. NC1174.2 +016500 04 COMPUTED-18V0 PIC -9(18). NC1174.2 +016600 04 FILLER PIC X. NC1174.2 +016700 03 FILLER PIC X(50) VALUE SPACE. NC1174.2 +016800 01 TEST-CORRECT. NC1174.2 +016900 02 FILLER PIC X(30) VALUE SPACE. NC1174.2 +017000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1174.2 +017100 02 CORRECT-X. NC1174.2 +017200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1174.2 +017300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1174.2 +017400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1174.2 +017500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1174.2 +017600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1174.2 +017700 03 CR-18V0 REDEFINES CORRECT-A. NC1174.2 +017800 04 CORRECT-18V0 PIC -9(18). NC1174.2 +017900 04 FILLER PIC X. NC1174.2 +018000 03 FILLER PIC X(2) VALUE SPACE. NC1174.2 +018100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1174.2 +018200 01 CCVS-C-1. NC1174.2 +018300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1174.2 +018400- "SS PARAGRAPH-NAME NC1174.2 +018500- " REMARKS". NC1174.2 +018600 02 FILLER PIC X(20) VALUE SPACE. NC1174.2 +018700 01 CCVS-C-2. NC1174.2 +018800 02 FILLER PIC X VALUE SPACE. NC1174.2 +018900 02 FILLER PIC X(6) VALUE "TESTED". NC1174.2 +019000 02 FILLER PIC X(15) VALUE SPACE. NC1174.2 +019100 02 FILLER PIC X(4) VALUE "FAIL". NC1174.2 +019200 02 FILLER PIC X(94) VALUE SPACE. NC1174.2 +019300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1174.2 +019400 01 REC-CT PIC 99 VALUE ZERO. NC1174.2 +019500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1174.2 +019600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1174.2 +019700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1174.2 +019800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1174.2 +019900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1174.2 +020000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1174.2 +020100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1174.2 +020200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1174.2 +020300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1174.2 +020400 01 CCVS-H-1. NC1174.2 +020500 02 FILLER PIC X(39) VALUE SPACES. NC1174.2 +020600 02 FILLER PIC X(42) VALUE NC1174.2 +020700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1174.2 +020800 02 FILLER PIC X(39) VALUE SPACES. NC1174.2 +020900 01 CCVS-H-2A. NC1174.2 +021000 02 FILLER PIC X(40) VALUE SPACE. NC1174.2 +021100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1174.2 +021200 02 FILLER PIC XXXX VALUE NC1174.2 +021300 "4.2 ". NC1174.2 +021400 02 FILLER PIC X(28) VALUE NC1174.2 +021500 " COPY - NOT FOR DISTRIBUTION". NC1174.2 +021600 02 FILLER PIC X(41) VALUE SPACE. NC1174.2 +021700 NC1174.2 +021800 01 CCVS-H-2B. NC1174.2 +021900 02 FILLER PIC X(15) VALUE NC1174.2 +022000 "TEST RESULT OF ". NC1174.2 +022100 02 TEST-ID PIC X(9). NC1174.2 +022200 02 FILLER PIC X(4) VALUE NC1174.2 +022300 " IN ". NC1174.2 +022400 02 FILLER PIC X(12) VALUE NC1174.2 +022500 " HIGH ". NC1174.2 +022600 02 FILLER PIC X(22) VALUE NC1174.2 +022700 " LEVEL VALIDATION FOR ". NC1174.2 +022800 02 FILLER PIC X(58) VALUE NC1174.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1174.2 +023000 01 CCVS-H-3. NC1174.2 +023100 02 FILLER PIC X(34) VALUE NC1174.2 +023200 " FOR OFFICIAL USE ONLY ". NC1174.2 +023300 02 FILLER PIC X(58) VALUE NC1174.2 +023400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1174.2 +023500 02 FILLER PIC X(28) VALUE NC1174.2 +023600 " COPYRIGHT 1985 ". NC1174.2 +023700 01 CCVS-E-1. NC1174.2 +023800 02 FILLER PIC X(52) VALUE SPACE. NC1174.2 +023900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1174.2 +024000 02 ID-AGAIN PIC X(9). NC1174.2 +024100 02 FILLER PIC X(45) VALUE SPACES. NC1174.2 +024200 01 CCVS-E-2. NC1174.2 +024300 02 FILLER PIC X(31) VALUE SPACE. NC1174.2 +024400 02 FILLER PIC X(21) VALUE SPACE. NC1174.2 +024500 02 CCVS-E-2-2. NC1174.2 +024600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1174.2 +024700 03 FILLER PIC X VALUE SPACE. NC1174.2 +024800 03 ENDER-DESC PIC X(44) VALUE NC1174.2 +024900 "ERRORS ENCOUNTERED". NC1174.2 +025000 01 CCVS-E-3. NC1174.2 +025100 02 FILLER PIC X(22) VALUE NC1174.2 +025200 " FOR OFFICIAL USE ONLY". NC1174.2 +025300 02 FILLER PIC X(12) VALUE SPACE. NC1174.2 +025400 02 FILLER PIC X(58) VALUE NC1174.2 +025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1174.2 +025600 02 FILLER PIC X(13) VALUE SPACE. NC1174.2 +025700 02 FILLER PIC X(15) VALUE NC1174.2 +025800 " COPYRIGHT 1985". NC1174.2 +025900 01 CCVS-E-4. NC1174.2 +026000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1174.2 +026100 02 FILLER PIC X(4) VALUE " OF ". NC1174.2 +026200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1174.2 +026300 02 FILLER PIC X(40) VALUE NC1174.2 +026400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1174.2 +026500 01 XXINFO. NC1174.2 +026600 02 FILLER PIC X(19) VALUE NC1174.2 +026700 "*** INFORMATION ***". NC1174.2 +026800 02 INFO-TEXT. NC1174.2 +026900 04 FILLER PIC X(8) VALUE SPACE. NC1174.2 +027000 04 XXCOMPUTED PIC X(20). NC1174.2 +027100 04 FILLER PIC X(5) VALUE SPACE. NC1174.2 +027200 04 XXCORRECT PIC X(20). NC1174.2 +027300 02 INF-ANSI-REFERENCE PIC X(48). NC1174.2 +027400 01 HYPHEN-LINE. NC1174.2 +027500 02 FILLER PIC IS X VALUE IS SPACE. NC1174.2 +027600 02 FILLER PIC IS X(65) VALUE IS "************************NC1174.2 +027700- "*****************************************". NC1174.2 +027800 02 FILLER PIC IS X(54) VALUE IS "************************NC1174.2 +027900- "******************************". NC1174.2 +028000 01 CCVS-PGM-ID PIC X(9) VALUE NC1174.2 +028100 "NC117A". NC1174.2 +028200 PROCEDURE DIVISION. NC1174.2 +028300 CCVS1 SECTION. NC1174.2 +028400 OPEN-FILES. NC1174.2 +028500 OPEN OUTPUT PRINT-FILE. NC1174.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1174.2 +028700 MOVE SPACE TO TEST-RESULTS. NC1174.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1174.2 +028900 GO TO CCVS1-EXIT. NC1174.2 +029000 CLOSE-FILES. NC1174.2 +029100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1174.2 +029200 TERMINATE-CCVS. NC1174.2 +029300*S EXIT PROGRAM. NC1174.2 +029400*SERMINATE-CALL. NC1174.2 +029500 STOP RUN. NC1174.2 +029600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1174.2 +029700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1174.2 +029800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1174.2 +029900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1174.2 +030000 MOVE "****TEST DELETED****" TO RE-MARK. NC1174.2 +030100 PRINT-DETAIL. NC1174.2 +030200 IF REC-CT NOT EQUAL TO ZERO NC1174.2 +030300 MOVE "." TO PARDOT-X NC1174.2 +030400 MOVE REC-CT TO DOTVALUE. NC1174.2 +030500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1174.2 +030600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1174.2 +030700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1174.2 +030800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1174.2 +030900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1174.2 +031000 MOVE SPACE TO CORRECT-X. NC1174.2 +031100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1174.2 +031200 MOVE SPACE TO RE-MARK. NC1174.2 +031300 HEAD-ROUTINE. NC1174.2 +031400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +031500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +031600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1174.2 +031700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1174.2 +031800 COLUMN-NAMES-ROUTINE. NC1174.2 +031900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +032000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +032100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +032200 END-ROUTINE. NC1174.2 +032300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1174.2 +032400 END-RTN-EXIT. NC1174.2 +032500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +032600 END-ROUTINE-1. NC1174.2 +032700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1174.2 +032800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1174.2 +032900 ADD PASS-COUNTER TO ERROR-HOLD. NC1174.2 +033000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1174.2 +033100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1174.2 +033200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1174.2 +033300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1174.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1174.2 +033500 END-ROUTINE-12. NC1174.2 +033600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1174.2 +033700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1174.2 +033800 MOVE "NO " TO ERROR-TOTAL NC1174.2 +033900 ELSE NC1174.2 +034000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1174.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1174.2 +034200 PERFORM WRITE-LINE. NC1174.2 +034300 END-ROUTINE-13. NC1174.2 +034400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1174.2 +034500 MOVE "NO " TO ERROR-TOTAL ELSE NC1174.2 +034600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1174.2 +034700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1174.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +034900 IF INSPECT-COUNTER EQUAL TO ZERO NC1174.2 +035000 MOVE "NO " TO ERROR-TOTAL NC1174.2 +035100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1174.2 +035200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1174.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +035400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1174.2 +035500 WRITE-LINE. NC1174.2 +035600 ADD 1 TO RECORD-COUNT. NC1174.2 +035700 IF RECORD-COUNT GREATER 42 NC1174.2 +035800 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1174.2 +035900 MOVE SPACE TO DUMMY-RECORD NC1174.2 +036000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1174.2 +036100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1174.2 +036200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1174.2 +036300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1174.2 +036400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1174.2 +036500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1174.2 +036600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1174.2 +036700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1174.2 +036800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1174.2 +036900 MOVE ZERO TO RECORD-COUNT. NC1174.2 +037000 PERFORM WRT-LN. NC1174.2 +037100 WRT-LN. NC1174.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1174.2 +037300 MOVE SPACE TO DUMMY-RECORD. NC1174.2 +037400 BLANK-LINE-PRINT. NC1174.2 +037500 PERFORM WRT-LN. NC1174.2 +037600 FAIL-ROUTINE. NC1174.2 +037700 IF COMPUTED-X NOT EQUAL TO SPACE NC1174.2 +037800 GO TO FAIL-ROUTINE-WRITE. NC1174.2 +037900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1174.2 +038000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1174.2 +038100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1174.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +038300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1174.2 +038400 GO TO FAIL-ROUTINE-EX. NC1174.2 +038500 FAIL-ROUTINE-WRITE. NC1174.2 +038600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1174.2 +038700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1174.2 +038800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1174.2 +038900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1174.2 +039000 FAIL-ROUTINE-EX. EXIT. NC1174.2 +039100 BAIL-OUT. NC1174.2 +039200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1174.2 +039300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1174.2 +039400 BAIL-OUT-WRITE. NC1174.2 +039500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1174.2 +039600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1174.2 +039700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1174.2 +039800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1174.2 +039900 BAIL-OUT-EX. EXIT. NC1174.2 +040000 CCVS1-EXIT. NC1174.2 +040100 EXIT. NC1174.2 +040200 SECT-NC117A-001 SECTION. NC1174.2 +040300 SIG-INIT-GF-1. NC1174.2 +040400 MOVE "DIVIDE INTO" TO FEATURE. NC1174.2 +040500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +040600 MOVE 1620.36 TO DIV1. NC1174.2 +040700 SIG-TEST-GF-1-0. NC1174.2 +040800 DIVIDE 64.3 INTO DIV1. NC1174.2 +040900 SIG-TEST-GF-1-1. NC1174.2 +041000 IF DIV1 EQUAL TO 25.2 NC1174.2 +041100 PERFORM PASS NC1174.2 +041200 ELSE NC1174.2 +041300 GO TO SIG-FAIL-GF-1. NC1174.2 +041400 GO TO SIG-WRITE-GF-1. NC1174.2 +041500 SIG-DELETE-GF-1. NC1174.2 +041600 PERFORM DE-LETE. NC1174.2 +041700 GO TO SIG-WRITE-GF-1. NC1174.2 +041800 SIG-FAIL-GF-1. NC1174.2 +041900 PERFORM FAIL. NC1174.2 +042000 MOVE DIV1 TO COMPUTED-N. NC1174.2 +042100 MOVE +25.2 TO CORRECT-N. NC1174.2 +042200 SIG-WRITE-GF-1. NC1174.2 +042300 MOVE "SIG-TEST-GF-1" TO PAR-NAME. NC1174.2 +042400 PERFORM PRINT-DETAIL. NC1174.2 +042500 SIG-INIT-GF-2. NC1174.2 +042600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +042700 MOVE 44.1 TO DIV2. NC1174.2 +042800 MOVE 1661.7 TO DIV3. NC1174.2 +042900 SIG-TEST-GF-2. NC1174.2 +043000 DIVIDE DIV2 INTO DIV3 ROUNDED. NC1174.2 +043100 IF DIV3 EQUAL TO 37.7 NC1174.2 +043200 PERFORM PASS NC1174.2 +043300 ELSE NC1174.2 +043400 GO TO SIG-FAIL-GF-2. NC1174.2 +043500 GO TO SIG-WRITE-GF-2. NC1174.2 +043600 SIG-DELETE-GF-2. NC1174.2 +043700 PERFORM DE-LETE. NC1174.2 +043800 GO TO SIG-WRITE-GF-2. NC1174.2 +043900 SIG-FAIL-GF-2. NC1174.2 +044000 PERFORM FAIL. NC1174.2 +044100 MOVE DIV3 TO COMPUTED-N. NC1174.2 +044200 MOVE +37.7 TO CORRECT-N. NC1174.2 +044300 SIG-WRITE-GF-2. NC1174.2 +044400 MOVE "SIG-TEST-GF-2 " TO PAR-NAME. NC1174.2 +044500 PERFORM PRINT-DETAIL. NC1174.2 +044600 SIG-INIT-GF-3. NC1174.2 +044700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +044800 MOVE -9.642 TO DIV4. NC1174.2 +044900 MOVE .82 TO DIV5. NC1174.2 +045000 MOVE "A" TO XRAY. NC1174.2 +045100 SIG-TEST-GF-3-0. NC1174.2 +045200 DIVIDE DIV5 INTO DIV4 ON SIZE ERROR NC1174.2 +045300 MOVE "M" TO XRAY. NC1174.2 +045400 SIG-TEST-GF-3-1. NC1174.2 +045500 IF XRAY EQUAL TO "M" NC1174.2 +045600 PERFORM PASS NC1174.2 +045700 ELSE NC1174.2 +045800 GO TO SIG-FAIL-GF-3. NC1174.2 +045900 GO TO SIG-WRITE-GF-3. NC1174.2 +046000 SIG-DELETE-GF-3-1. NC1174.2 +046100 PERFORM DE-LETE. NC1174.2 +046200 GO TO SIG-WRITE-GF-3. NC1174.2 +046300 SIG-FAIL-GF-3. NC1174.2 +046400 MOVE DIV4 TO COMPUTED-N. NC1174.2 +046500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +046600 PERFORM FAIL. NC1174.2 +046700 SIG-WRITE-GF-3. NC1174.2 +046800 MOVE "SIG-TEST-GF-3-1" TO PAR-NAME. NC1174.2 +046900 PERFORM PRINT-DETAIL. NC1174.2 +047000 SIG-TEST-GF-3-2. NC1174.2 +047100 IF DIV4 EQUAL TO -9.642 NC1174.2 +047200 PERFORM PASS NC1174.2 +047300 ELSE NC1174.2 +047400 GO TO SIG-FAIL-GF-3-2. NC1174.2 +047500 GO TO SIG-WRITE-GF-3-2. NC1174.2 +047600 SIG-DELETE-GF-3-2. NC1174.2 +047700 PERFORM DE-LETE. NC1174.2 +047800 GO TO SIG-WRITE-GF-3-2. NC1174.2 +047900 SIG-FAIL-GF-3-2. NC1174.2 +048000 PERFORM FAIL. NC1174.2 +048100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +048200 MOVE DIV4 TO COMPUTED-N. NC1174.2 +048300 MOVE -9.642 TO CORRECT-N. NC1174.2 +048400 SIG-WRITE-GF-3-2. NC1174.2 +048500 MOVE "SIG-TEST-GF-3-2 " TO PAR-NAME. NC1174.2 +048600 PERFORM PRINT-DETAIL. NC1174.2 +048700 SIG-INIT-GF-4. NC1174.2 +048800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +048900 MOVE 44.1 TO DIV2. NC1174.2 +049000 MOVE 0 TO DIV6. NC1174.2 +049100 MOVE "A" TO XRAY. NC1174.2 +049200 SIG-TEST-GF-4-1-0. NC1174.2 +049300 DIVIDE DIV6 INTO DIV2 ON SIZE ERROR NC1174.2 +049400 MOVE "N" TO XRAY. NC1174.2 +049500 SIG-TEST-GF-4-1-1. NC1174.2 +049600 IF XRAY EQUAL TO "N" NC1174.2 +049700 PERFORM PASS NC1174.2 +049800 ELSE NC1174.2 +049900 GO TO SIG-FAIL-GF-4-1. NC1174.2 +050000 GO TO SIG-WRITE-GF-4-1. NC1174.2 +050100 SIG-DELETE-GF-4-1. NC1174.2 +050200 PERFORM DE-LETE. NC1174.2 +050300 GO TO SIG-WRITE-GF-4-1. NC1174.2 +050400 SIG-FAIL-GF-4-1. NC1174.2 +050500 MOVE DIV2 TO COMPUTED-N. NC1174.2 +050600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +050700 PERFORM FAIL. NC1174.2 +050800 SIG-WRITE-GF-4-1. NC1174.2 +050900 MOVE "SIG-TEST-GF-4-1 " TO PAR-NAME. NC1174.2 +051000 PERFORM PRINT-DETAIL. NC1174.2 +051100 SIG-TEST-GF-4-2. NC1174.2 +051200 IF DIV2 EQUAL TO 44.1 NC1174.2 +051300 PERFORM PASS NC1174.2 +051400 ELSE NC1174.2 +051500 GO TO SIG-FAIL-GF-4-2. NC1174.2 +051600 GO TO SIG-WRITE-GF-4-2. NC1174.2 +051700 SIG-DELETE-GF-4-2. NC1174.2 +051800 PERFORM DE-LETE. NC1174.2 +051900 GO TO SIG-WRITE-GF-4-2. NC1174.2 +052000 SIG-FAIL-GF-4-2. NC1174.2 +052100 PERFORM FAIL. NC1174.2 +052200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +052300 MOVE DIV2 TO COMPUTED-N. NC1174.2 +052400 MOVE +44.1000 TO CORRECT-N. NC1174.2 +052500 SIG-WRITE-GF-4-2. NC1174.2 +052600 MOVE "SIG-TEST-GF-4-2 " TO PAR-NAME. NC1174.2 +052700 PERFORM PRINT-DETAIL. NC1174.2 +052800 SIG-INIT-GF-5. NC1174.2 +052900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +053000 MOVE 9.6 TO DIV7. NC1174.2 +053100 MOVE "A" TO XRAY. NC1174.2 +053200 SIG-TEST-GF-5-0. NC1174.2 +053300 DIVIDE 0.097 INTO DIV7 ROUNDED ON SIZE ERROR NC1174.2 +053400 MOVE "N" TO XRAY. NC1174.2 +053500 SIG-TEST-GF-5-1. NC1174.2 +053600 IF XRAY EQUAL TO "N" NC1174.2 +053700 PERFORM PASS NC1174.2 +053800 ELSE NC1174.2 +053900 GO TO SIG-FAIL-GF-5-1. NC1174.2 +054000 GO TO SIG-WRITE-GF-5-1. NC1174.2 +054100 SIG-DELETE-GF-5-1. NC1174.2 +054200 PERFORM DE-LETE. NC1174.2 +054300 GO TO SIG-WRITE-GF-5-1. NC1174.2 +054400 SIG-FAIL-GF-5-1. NC1174.2 +054500 MOVE DIV7 TO COMPUTED-N. NC1174.2 +054600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +054700 PERFORM FAIL. NC1174.2 +054800 SIG-WRITE-GF-5-1. NC1174.2 +054900 MOVE "SIG-TEST-GF-5-1 " TO PAR-NAME. NC1174.2 +055000 PERFORM PRINT-DETAIL. NC1174.2 +055100 SIG-TEST-GF-5-2. NC1174.2 +055200 IF DIV7 NOT EQUAL TO 9.6 NC1174.2 +055300 GO TO SIG-FAIL-GF-5-2. NC1174.2 +055400 PERFORM PASS. NC1174.2 +055500 GO TO SIG-WRITE-GF-5-2. NC1174.2 +055600 SIG-DELETE-GF-5-2. NC1174.2 +055700 PERFORM DE-LETE. NC1174.2 +055800 GO TO SIG-WRITE-GF-5-2. NC1174.2 +055900 SIG-FAIL-GF-5-2. NC1174.2 +056000 PERFORM FAIL. NC1174.2 +056100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +056200 MOVE DIV7 TO COMPUTED-N. NC1174.2 +056300 MOVE +9.6 TO CORRECT-N. NC1174.2 +056400 SIG-WRITE-GF-5-2. NC1174.2 +056500 MOVE "SIG-TEST-GF-5-2 " TO PAR-NAME. NC1174.2 +056600 PERFORM PRINT-DETAIL. NC1174.2 +056700 SIG-INIT-GF-11. NC1174.2 +056800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +056900 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1174.2 +057000 MOVE 44.1 TO DIV2. NC1174.2 +057100 MOVE ZERO TO DIV8. NC1174.2 +057200 SIG-TEST-GF-11-0. NC1174.2 +057300 DIVIDE DIV2 INTO 864.36 GIVING DIV8. NC1174.2 +057400 SIG-TEST-GF-11-1. NC1174.2 +057500 IF DIV8 EQUAL TO 19.6 NC1174.2 +057600 PERFORM PASS NC1174.2 +057700 ELSE NC1174.2 +057800 GO TO SIG-FAIL-GF-11. NC1174.2 +057900 GO TO SIG-WRITE-GF-11. NC1174.2 +058000 SIG-DELETE-GF-11. NC1174.2 +058100 PERFORM DE-LETE. NC1174.2 +058200 GO TO SIG-WRITE-GF-11. NC1174.2 +058300 SIG-FAIL-GF-11. NC1174.2 +058400 PERFORM FAIL. NC1174.2 +058500 MOVE DIV8 TO COMPUTED-N. NC1174.2 +058600 MOVE +19.6 TO CORRECT-N. NC1174.2 +058700 SIG-WRITE-GF-11. NC1174.2 +058800 MOVE "SIG-TEST-GF-11 " TO PAR-NAME. NC1174.2 +058900 PERFORM PRINT-DETAIL. NC1174.2 +059000 SIG-INIT-GF-12. NC1174.2 +059100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +059200 MOVE 1620.36 TO DIV1. NC1174.2 +059300 MOVE ZERO TO DIV9. NC1174.2 +059400 SIG-TEST-GF-12-0. NC1174.2 +059500 DIVIDE 0.533 INTO DIV1 GIVING DIV9 ROUNDED. NC1174.2 +059600 SIG-TEST-GF-12-1. NC1174.2 +059700 IF DIV9 EQUAL TO " 3,040.1" NC1174.2 +059800 PERFORM PASS NC1174.2 +059900 ELSE NC1174.2 +060000 GO TO SIG-FAIL-GF-12. NC1174.2 +060100 GO TO SIG-WRITE-GF-12. NC1174.2 +060200 SIG-DELETE-GF-12. NC1174.2 +060300 PERFORM DE-LETE. NC1174.2 +060400 GO TO SIG-WRITE-GF-12. NC1174.2 +060500 SIG-FAIL-GF-12. NC1174.2 +060600 PERFORM FAIL. NC1174.2 +060700 MOVE DIV9 TO COMPUTED-A. NC1174.2 +060800 MOVE " 3,040.1" TO CORRECT-A. NC1174.2 +060900 SIG-WRITE-GF-12. NC1174.2 +061000 MOVE "SIG-TEST-GF-12" TO PAR-NAME. NC1174.2 +061100 PERFORM PRINT-DETAIL. NC1174.2 +061200 SIG-INIT-GF-13. NC1174.2 +061300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +061400 MOVE -9.642 TO DIV4. NC1174.2 +061500 MOVE ZERO TO DIV10. NC1174.2 +061600 MOVE 44.1 TO DIV2. NC1174.2 +061700 MOVE "A" TO XRAY. NC1174.2 +061800 SIG-TEST-GF-13-0. NC1174.2 +061900 DIVIDE DIV4 INTO DIV2 GIVING DIV10 ON SIZE ERROR NC1174.2 +062000 MOVE "P" TO XRAY. NC1174.2 +062100 SIG-TEST-GF-13-1. NC1174.2 +062200 IF XRAY EQUAL TO "P" NC1174.2 +062300 PERFORM PASS NC1174.2 +062400 ELSE NC1174.2 +062500 GO TO SIG-FAIL-GF-13-1. NC1174.2 +062600 GO TO SIG-WRITE-GF-13-1. NC1174.2 +062700 SIG-DELETE-GF-13-1. NC1174.2 +062800 PERFORM DE-LETE. NC1174.2 +062900 GO TO SIG-WRITE-GF-13-1. NC1174.2 +063000 SIG-FAIL-GF-13-1. NC1174.2 +063100 MOVE DIV10 TO COMPUTED-N. NC1174.2 +063200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +063300 PERFORM FAIL. NC1174.2 +063400 SIG-WRITE-GF-13-1. NC1174.2 +063500 MOVE "SIG-TEST-GF-13-1" TO PAR-NAME. NC1174.2 +063600 PERFORM PRINT-DETAIL. NC1174.2 +063700 SIG-TEST-GF-13-2. NC1174.2 +063800 IF DIV10 NOT EQUAL TO ZERO NC1174.2 +063900 GO TO SIG-FAIL-GF-13-2. NC1174.2 +064000 PERFORM PASS. NC1174.2 +064100 GO TO SIG-WRITE-GF-13-2. NC1174.2 +064200 SIG-DELETE-GF-13-2. NC1174.2 +064300 PERFORM DE-LETE. NC1174.2 +064400 GO TO SIG-WRITE-GF-13-2. NC1174.2 +064500 SIG-FAIL-GF-13-2. NC1174.2 +064600 PERFORM FAIL. NC1174.2 +064700 MOVE DIV10 TO COMPUTED-N. NC1174.2 +064800 MOVE ZERO TO CORRECT-N. NC1174.2 +064900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +065000 SIG-WRITE-GF-13-2. NC1174.2 +065100 MOVE "SIG-TEST-GF-13-2" TO PAR-NAME. NC1174.2 +065200 PERFORM PRINT-DETAIL. NC1174.2 +065300 SIG-INIT-GF-19. NC1174.2 +065400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +065500 MOVE ZERO TO DIV8. NC1174.2 +065600 MOVE 44.1 TO DIV2. NC1174.2 +065700 MOVE "DIVIDE BY" TO FEATURE. NC1174.2 +065800 SIG-TEST-GF-19. NC1174.2 +065900 DIVIDE 864.36 BY DIV2 GIVING DIV8. NC1174.2 +066000 IF DIV8 EQUAL TO 19.6 NC1174.2 +066100 PERFORM PASS NC1174.2 +066200 ELSE NC1174.2 +066300 GO TO SIG-FAIL-GF-19. NC1174.2 +066400 GO TO SIG-WRITE-GF-19. NC1174.2 +066500 SIG-DELETE-GF-19. NC1174.2 +066600 PERFORM DE-LETE. NC1174.2 +066700 GO TO SIG-WRITE-GF-19. NC1174.2 +066800 SIG-FAIL-GF-19. NC1174.2 +066900 PERFORM FAIL. NC1174.2 +067000 MOVE DIV8 TO COMPUTED-N. NC1174.2 +067100 MOVE 19.6 TO CORRECT-N. NC1174.2 +067200 SIG-WRITE-GF-19. NC1174.2 +067300 MOVE "SIG-TEST-GF-19" TO PAR-NAME. NC1174.2 +067400 PERFORM PRINT-DETAIL. NC1174.2 +067500 SIG-INIT-GF-20. NC1174.2 +067600 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1174.2 +067700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +067800 MOVE 1620.36 TO DIV1. NC1174.2 +067900 MOVE ZERO TO DIV9. NC1174.2 +068000 SIG-TEST-GF-20-0. NC1174.2 +068100 DIVIDE DIV1 BY 0.533 GIVING DIV9 ROUNDED. NC1174.2 +068200 SIG-TEST-GF-20-1. NC1174.2 +068300 IF DIV9 EQUAL TO " 3,040.1" NC1174.2 +068400 PERFORM PASS NC1174.2 +068500 ELSE NC1174.2 +068600 GO TO SIG-FAIL-GF-20. NC1174.2 +068700 GO TO SIG-WRITE-GF-20. NC1174.2 +068800 SIG-DELETE-GF-20. NC1174.2 +068900 PERFORM DE-LETE. NC1174.2 +069000 GO TO SIG-WRITE-GF-20. NC1174.2 +069100 SIG-FAIL-GF-20. NC1174.2 +069200 PERFORM FAIL. NC1174.2 +069300 MOVE DIV9 TO COMPUTED-A. NC1174.2 +069400 MOVE " 3,040.1" TO CORRECT-A. NC1174.2 +069500 SIG-WRITE-GF-20. NC1174.2 +069600 MOVE "SIG-TEST-GF-20" TO PAR-NAME. NC1174.2 +069700 PERFORM PRINT-DETAIL. NC1174.2 +069800 SIG-INIT-GF-21. NC1174.2 +069900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +070000 MOVE -9.642 TO DIV4. NC1174.2 +070100 MOVE ZERO TO DIV10. NC1174.2 +070200 MOVE 44.1 TO DIV2. NC1174.2 +070300 MOVE "A" TO XRAY. NC1174.2 +070400 SIG-TEST-GF-21-0. NC1174.2 +070500 DIVIDE DIV2 BY DIV4 GIVING DIV10 ON SIZE ERROR NC1174.2 +070600 MOVE "P" TO XRAY. NC1174.2 +070700 SIG-TEST-GF-21-1. NC1174.2 +070800 IF XRAY EQUAL TO "P" NC1174.2 +070900 PERFORM PASS NC1174.2 +071000 ELSE NC1174.2 +071100 GO TO SIG-FAIL-GF-21-1. NC1174.2 +071200 GO TO SIG-WRITE-GF-21-1. NC1174.2 +071300 SIG-DELETE-GF-21-1. NC1174.2 +071400 PERFORM DE-LETE. NC1174.2 +071500 GO TO SIG-WRITE-GF-21-1. NC1174.2 +071600 SIG-FAIL-GF-21-1. NC1174.2 +071700 MOVE DIV10 TO COMPUTED-N. NC1174.2 +071800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1174.2 +071900 PERFORM FAIL. NC1174.2 +072000 SIG-WRITE-GF-21-1. NC1174.2 +072100 MOVE "SIG-TEST-GF-21-1" TO PAR-NAME. NC1174.2 +072200 PERFORM PRINT-DETAIL. NC1174.2 +072300 SIG-TEST-GF-21-2. NC1174.2 +072400 IF DIV10 = 0 NC1174.2 +072500 PERFORM PASS NC1174.2 +072600 ELSE NC1174.2 +072700 GO TO SIG-FAIL-GF-21-2. NC1174.2 +072800 GO TO SIG-WRITE-GF-21-2. NC1174.2 +072900 SIG-DELETE-GF-21-2. NC1174.2 +073000 PERFORM DE-LETE. NC1174.2 +073100 GO TO SIG-WRITE-GF-21-2. NC1174.2 +073200 SIG-FAIL-GF-21-2. NC1174.2 +073300 MOVE DIV10 TO COMPUTED-N. NC1174.2 +073400 MOVE 0 TO CORRECT-N. NC1174.2 +073500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +073600 PERFORM FAIL. NC1174.2 +073700 SIG-WRITE-GF-21-2. NC1174.2 +073800 MOVE "SIG-TEST-GF-21-2" TO PAR-NAME. NC1174.2 +073900 PERFORM PRINT-DETAIL. NC1174.2 +074000 SIG-INIT-GF-6. NC1174.2 +074100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +074200 MOVE "DIVIDE INTO " TO FEATURE. NC1174.2 +074300 MOVE 99 TO WRK-DS-LS-18V00. NC1174.2 +074400 SIG-TEST-GF-6-0. NC1174.2 +074500 DIVIDE A99-DS-02V00 INTO WRK-DS-LS-18V00. NC1174.2 +074600 SIG-TEST-GF-6-1. NC1174.2 +074700 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000001 NC1174.2 +074800 PERFORM PASS NC1174.2 +074900 GO TO SIG-WRITE-GF-6. NC1174.2 +075000 GO TO SIG-FAIL-GF-6. NC1174.2 +075100 SIG-DELETE-GF-6. NC1174.2 +075200 PERFORM DE-LETE. NC1174.2 +075300 GO TO SIG-WRITE-GF-6. NC1174.2 +075400 SIG-FAIL-GF-6. NC1174.2 +075500 MOVE 000000000000000001 TO CORRECT-18V0. NC1174.2 +075600 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +075700 PERFORM FAIL. NC1174.2 +075800 SIG-WRITE-GF-6. NC1174.2 +075900 MOVE "SIG-TEST-GF-6 " TO PAR-NAME. NC1174.2 +076000 PERFORM PRINT-DETAIL. NC1174.2 +076100 SIG-INIT-GF-7. NC1174.2 +076200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +076300 MOVE 2 TO WRK-DS-TS-12V00-S. NC1174.2 +076400 SIG-TEST-GF-7-0. NC1174.2 +076500 DIVIDE 4 INTO WRK-DS-TS-12V00-S ROUNDED. NC1174.2 +076600 SIG-TEST-GF-7-1. NC1174.2 +076700 IF WRK-DS-TS-12V00-S EQUAL TO 000000000001 NC1174.2 +076800 PERFORM PASS NC1174.2 +076900 GO TO SIG-WRITE-GF-7. NC1174.2 +077000 GO TO SIG-FAIL-GF-7. NC1174.2 +077100 SIG-DELETE-GF-7. NC1174.2 +077200 PERFORM DE-LETE. NC1174.2 +077300 GO TO SIG-WRITE-GF-7. NC1174.2 +077400 SIG-FAIL-GF-7. NC1174.2 +077500 MOVE WRK-DS-TS-12V00-S TO COMPUTED-18V0. NC1174.2 +077600 MOVE 000000000001 TO CORRECT-18V0. NC1174.2 +077700 PERFORM FAIL. NC1174.2 +077800 SIG-WRITE-GF-7. NC1174.2 +077900 MOVE "SIG-TEST-GF-7 " TO PAR-NAME. NC1174.2 +078000 PERFORM PRINT-DETAIL. NC1174.2 +078100 SIG-INIT-GF-8. NC1174.2 +078200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +078300 MOVE 1 TO WRK-DS-LS-01V00. NC1174.2 +078400 MOVE "0" TO WRK-XN-00001. NC1174.2 +078500 SIG-TEST-GF-8-0. NC1174.2 +078600 DIVIDE 0.1 INTO WRK-DS-LS-01V00 ON SIZE ERROR NC1174.2 +078700 MOVE "1" TO WRK-XN-00001. NC1174.2 +078800 SIG-TEST-GF-8-1. NC1174.2 +078900 IF WRK-DS-LS-01V00 EQUAL TO 1 NC1174.2 +079000 PERFORM PASS NC1174.2 +079100 GO TO SIG-WRITE-GF-8-1. NC1174.2 +079200 GO TO SIG-FAIL-GF-8-1. NC1174.2 +079300 SIG-DELETE-GF-8-1. NC1174.2 +079400 PERFORM DE-LETE. NC1174.2 +079500 GO TO SIG-WRITE-GF-8-1. NC1174.2 +079600 SIG-FAIL-GF-8-1. NC1174.2 +079700 MOVE 1 TO CORRECT-N. NC1174.2 +079800 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +079900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +080000 PERFORM FAIL. NC1174.2 +080100 SIG-WRITE-GF-8-1. NC1174.2 +080200 MOVE "SIG-TEST-GF-8-1 " TO PAR-NAME. NC1174.2 +080300 PERFORM PRINT-DETAIL. NC1174.2 +080400 SIG-TEST-GF-8-2. NC1174.2 +080500 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +080600 PERFORM PASS NC1174.2 +080700 GO TO SIG-WRITE-GF-8-2. NC1174.2 +080800 MOVE "1" TO CORRECT-A. NC1174.2 +080900 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +081000 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1174.2 +081100 PERFORM FAIL. NC1174.2 +081200 GO TO SIG-WRITE-GF-8-2. NC1174.2 +081300 SIG-DELETE-GF-8-2. NC1174.2 +081400 PERFORM DE-LETE. NC1174.2 +081500 SIG-WRITE-GF-8-2. NC1174.2 +081600 MOVE "SIG-TEST-GF-8-2 " TO PAR-NAME. NC1174.2 +081700 PERFORM PRINT-DETAIL. NC1174.2 +081800 SIG-INIT-GF-9. NC1174.2 +081900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +082000 MOVE -.000000001 TO WRK-DS-09V09. NC1174.2 +082100 MOVE "1" TO WRK-XN-00001. NC1174.2 +082200 SIG-TEST-GF-9-0. NC1174.2 +082300 DIVIDE A01ONE-DS-TS-P0801 INTO WRK-DS-09V09 ON SIZE ERROR NC1174.2 +082400 MOVE "0" TO WRK-XN-00001. NC1174.2 +082500 SIG-TEST-GF-9-1. NC1174.2 +082600 IF WRK-DS-18V00-S EQUAL TO -000000001000000000 NC1174.2 +082700 PERFORM PASS NC1174.2 +082800 GO TO SIG-WRITE-GF-9-1. NC1174.2 +082900 GO TO SIG-FAIL-GF-9-1. NC1174.2 +083000 SIG-DELETE-GF-9-1. NC1174.2 +083100 PERFORM DE-LETE. NC1174.2 +083200 GO TO SIG-WRITE-GF-9-1. NC1174.2 +083300 SIG-FAIL-GF-9-1. NC1174.2 +083400 MOVE -000000001000000000 TO CORRECT-18V0. NC1174.2 +083500 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1174.2 +083600 PERFORM FAIL. NC1174.2 +083700 SIG-WRITE-GF-9-1. NC1174.2 +083800 MOVE "SIG-TEST-GF-9-1 " TO PAR-NAME. NC1174.2 +083900 PERFORM PRINT-DETAIL. NC1174.2 +084000 SIG-TEST-GF-9-2. NC1174.2 +084100 IF WRK-XN-00001 EQUAL TO "0" NC1174.2 +084200 MOVE "1" TO CORRECT-A NC1174.2 +084300 MOVE "0" TO COMPUTED-A NC1174.2 +084400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1174.2 +084500 PERFORM FAIL NC1174.2 +084600 GO TO SIG-WRITE-GF-9-2. NC1174.2 +084700 PERFORM PASS. NC1174.2 +084800 GO TO SIG-WRITE-GF-9-2. NC1174.2 +084900 SIG-DELETE-GF-9-2. NC1174.2 +085000 PERFORM DE-LETE. NC1174.2 +085100 SIG-WRITE-GF-9-2. NC1174.2 +085200 MOVE "SIG-TEST-GF-9-2 " TO PAR-NAME. NC1174.2 +085300 PERFORM PRINT-DETAIL. NC1174.2 +085400 SIG-INIT-GF-10. NC1174.2 +085500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +085600 MOVE ZERO TO WRK-DS-LS-01V00 AZERO-DS-LS-05V05. NC1174.2 +085700 MOVE "0" TO WRK-XN-00001. NC1174.2 +085800 SIG-TEST-GF-10-0. NC1174.2 +085900 DIVIDE AZERO-DS-LS-05V05 INTO WRK-DS-LS-01V00 ROUNDED NC1174.2 +086000 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1174.2 +086100 SIG-TEST-GF-10-1. NC1174.2 +086200 IF WRK-DS-LS-01V00 EQUAL TO 0 NC1174.2 +086300 PERFORM PASS NC1174.2 +086400 GO TO SIG-WRITE-GF-10-1. NC1174.2 +086500 GO TO SIG-FAIL-GF-10-1. NC1174.2 +086600 SIG-DELETE-GF-10-1. NC1174.2 +086700 PERFORM DE-LETE. NC1174.2 +086800 GO TO SIG-WRITE-GF-10-1. NC1174.2 +086900 SIG-FAIL-GF-10-1. NC1174.2 +087000 MOVE 0 TO CORRECT-N. NC1174.2 +087100 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +087200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +087300 PERFORM FAIL. NC1174.2 +087400 SIG-WRITE-GF-10-1. NC1174.2 +087500 MOVE "SIG-TEST-GF-10-1 " TO PAR-NAME. NC1174.2 +087600 PERFORM PRINT-DETAIL. NC1174.2 +087700 SIG-TEST-GF-10-2. NC1174.2 +087800 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +087900 PERFORM PASS NC1174.2 +088000 GO TO SIG-WRITE-GF-10-2. NC1174.2 +088100 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1174.2 +088200 MOVE "1" TO CORRECT-A. NC1174.2 +088300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +088400 PERFORM FAIL. NC1174.2 +088500 GO TO SIG-WRITE-GF-10-2. NC1174.2 +088600 SIG-DELETE-GF-10-2. NC1174.2 +088700 PERFORM DE-LETE. NC1174.2 +088800 SIG-WRITE-GF-10-2. NC1174.2 +088900 MOVE "SIG-TEST-GF-10-2 " TO PAR-NAME. NC1174.2 +089000 PERFORM PRINT-DETAIL. NC1174.2 +089100 SIG-INIT-GF-14. NC1174.2 +089200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +089300 MOVE "DIVIDE INTO GIVING " TO FEATURE. NC1174.2 +089400 MOVE ZERO TO WRK-DS-LS-01V00. NC1174.2 +089500 MOVE 22 TO A02TWOS-DU-02V00. NC1174.2 +089600 SIG-TEST-GF-14-0. NC1174.2 +089700 DIVIDE -10.9 INTO A02TWOS-DU-02V00 GIVING WRK-DS-LS-01V00. NC1174.2 +089800 SIG-TEST-GF-14-1. NC1174.2 +089900 IF WRK-DS-LS-01V00 EQUAL TO -2 NC1174.2 +090000 PERFORM PASS NC1174.2 +090100 GO TO SIG-WRITE-GF-14. NC1174.2 +090200 GO TO SIG-FAIL-GF-14. NC1174.2 +090300 SIG-DELETE-GF-14. NC1174.2 +090400 PERFORM DE-LETE. NC1174.2 +090500 GO TO SIG-WRITE-GF-14. NC1174.2 +090600 SIG-FAIL-GF-14. NC1174.2 +090700 MOVE -2 TO CORRECT-N. NC1174.2 +090800 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +090900 PERFORM FAIL. NC1174.2 +091000 SIG-WRITE-GF-14. NC1174.2 +091100 MOVE "SIG-TEST-GF-14 " TO PAR-NAME. NC1174.2 +091200 PERFORM PRINT-DETAIL. NC1174.2 +091300 SIG-INIT-GF-15. NC1174.2 +091400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +091500 MOVE 0.0000000001 TO WRK-DS-03V10. NC1174.2 +091600 MOVE ZERO TO WRK-DS-LS-18V00. NC1174.2 +091700 MOVE .000000001 TO A01ONE-DS-TS-P0801. NC1174.2 +091800 SIG-TEST-GF-15-0. NC1174.2 +091900 DIVIDE WRK-DS-03V10 INTO A01ONE-DS-TS-P0801 NC1174.2 +092000 GIVING WRK-DS-LS-18V00 ROUNDED. NC1174.2 +092100 SIG-TEST-GF-15-1. NC1174.2 +092200 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000010 NC1174.2 +092300 PERFORM PASS NC1174.2 +092400 GO TO SIG-WRITE-GF-15. NC1174.2 +092500 GO TO SIG-FAIL-GF-15. NC1174.2 +092600 SIG-DELETE-GF-15. NC1174.2 +092700 PERFORM DE-LETE. NC1174.2 +092800 GO TO SIG-WRITE-GF-15. NC1174.2 +092900 SIG-FAIL-GF-15. NC1174.2 +093000 MOVE 000000000000000010 TO CORRECT-18V0. NC1174.2 +093100 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +093200 PERFORM FAIL. NC1174.2 +093300 SIG-WRITE-GF-15. NC1174.2 +093400 MOVE "SIG-TEST-GF-15 " TO PAR-NAME. NC1174.2 +093500 PERFORM PRINT-DETAIL. NC1174.2 +093600 SIG-INIT-GF-16. NC1174.2 +093700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +093800 MOVE ZERO TO WRK-DS-LS-18V00 AZERO-DS-LS-05V05. NC1174.2 +093900 MOVE "0" TO WRK-XN-00001. NC1174.2 +094000 SIG-TEST-GF-16-0. NC1174.2 +094100 DIVIDE AZERO-DS-LS-05V05 INTO A99-DS-02V00 NC1174.2 +094200 GIVING WRK-DS-LS-18V00 ON SIZE ERROR NC1174.2 +094300 MOVE "1" TO WRK-XN-00001. NC1174.2 +094400 SIG-TEST-GF-16-1. NC1174.2 +094500 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000000 NC1174.2 +094600 PERFORM PASS NC1174.2 +094700 GO TO SIG-WRITE-GF-16-1. NC1174.2 +094800 GO TO SIG-FAIL-GF-16-1. NC1174.2 +094900 SIG-DELETE-GF-16-1. NC1174.2 +095000 PERFORM DE-LETE. NC1174.2 +095100 GO TO SIG-WRITE-GF-16-1. NC1174.2 +095200 SIG-FAIL-GF-16-1. NC1174.2 +095300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +095400 MOVE 000000000000000000 TO CORRECT-18V0. NC1174.2 +095500 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +095600 PERFORM FAIL. NC1174.2 +095700 SIG-WRITE-GF-16-1. NC1174.2 +095800 MOVE "SIG-TEST-GF-16-1 " TO PAR-NAME. NC1174.2 +095900 PERFORM PRINT-DETAIL. NC1174.2 +096000 SIG-TEST-GF-16-2. NC1174.2 +096100 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +096200 PERFORM PASS NC1174.2 +096300 GO TO SIG-WRITE-GF-16-2. NC1174.2 +096400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1174.2 +096500 MOVE "1" TO CORRECT-A. NC1174.2 +096600 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +096700 PERFORM FAIL. NC1174.2 +096800 GO TO SIG-WRITE-GF-16-2. NC1174.2 +096900 SIG-DELETE-GF-16-2. NC1174.2 +097000 PERFORM DE-LETE. NC1174.2 +097100 SIG-WRITE-GF-16-2. NC1174.2 +097200 MOVE "SIG-TEST-32 " TO PAR-NAME. NC1174.2 +097300 PERFORM PRINT-DETAIL. NC1174.2 +097400 SIG-INIT-GF-17. NC1174.2 +097500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +097600 MOVE ZERO TO WRK-DS-LS-0201P. NC1174.2 +097700 MOVE -0.005 TO WRK-DS-09V09. NC1174.2 +097800 MOVE "0" TO WRK-XN-00001. NC1174.2 +097900 SIG-TEST-GF-17-0. NC1174.2 +098000 DIVIDE WRK-DS-09V09 INTO A05ONES-DS-LS-00V05 GIVING NC1174.2 +098100 WRK-DS-LS-0201P ROUNDED ON SIZE ERROR NC1174.2 +098200 MOVE "1" TO WRK-XN-00001. NC1174.2 +098300 SIG-TEST-GF-17-1. NC1174.2 +098400 MOVE WRK-DS-LS-0201P TO WRK-DS-05V00. NC1174.2 +098500 IF WRK-DS-05V00 EQUAL TO -00020 NC1174.2 +098600 PERFORM PASS NC1174.2 +098700 GO TO SIG-WRITE-GF-17-1. NC1174.2 +098800 GO TO SIG-FAIL-GF-17-1. NC1174.2 +098900 SIG-DELETE-GF-17-1. NC1174.2 +099000 PERFORM DE-LETE. NC1174.2 +099100 GO TO SIG-WRITE-GF-17-1. NC1174.2 +099200 SIG-FAIL-GF-17-1. NC1174.2 +099300 MOVE -00020 TO CORRECT-N. NC1174.2 +099400 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1174.2 +099500 PERFORM FAIL. NC1174.2 +099600 SIG-WRITE-GF-17-1. NC1174.2 +099700 MOVE "SIG-TEST-GF-17-1 " TO PAR-NAME. NC1174.2 +099800 PERFORM PRINT-DETAIL. NC1174.2 +099900 SIG-TEST-GF-17-2. NC1174.2 +100000 IF WRK-XN-00001 EQUAL TO "0" NC1174.2 +100100 PERFORM PASS NC1174.2 +100200 GO TO SIG-WRITE-GF-17-2. NC1174.2 +100300 MOVE "0" TO CORRECT-A. NC1174.2 +100400 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +100500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1174.2 +100600 PERFORM FAIL. NC1174.2 +100700 GO TO SIG-WRITE-GF-17-2. NC1174.2 +100800 SIG-DELETE-GF-17-2. NC1174.2 +100900 PERFORM DE-LETE. NC1174.2 +101000 SIG-WRITE-GF-17-2. NC1174.2 +101100 MOVE "SIG-TEST-GF-17-2 " TO PAR-NAME. NC1174.2 +101200 PERFORM PRINT-DETAIL. NC1174.2 +101300 SIG-INIT-GF-18. NC1174.2 +101400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +101500 MOVE "1" TO WRK-XN-00001. NC1174.2 +101600 MOVE ZERO TO WRK-DS-LS-01V00. NC1174.2 +101700 MOVE 22 TO A02TWOS-DU-02V00 A02TWOS-DS-03V02. NC1174.2 +101800 SIG-TEST-GF-18-0. NC1174.2 +101900 DIVIDE A02TWOS-DU-02V00 INTO A02TWOS-DS-03V02 GIVING NC1174.2 +102000 WRK-DS-LS-01V00 ROUNDED ON SIZE ERROR NC1174.2 +102100 MOVE "0" TO WRK-XN-00001. NC1174.2 +102200 SIG-TEST-GF-18-1. NC1174.2 +102300 IF WRK-DS-LS-01V00 EQUAL TO +1 NC1174.2 +102400 PERFORM PASS NC1174.2 +102500 GO TO SIG-WRITE-GF-18-1. NC1174.2 +102600 GO TO SIG-FAIL-GF-18-1. NC1174.2 +102700 SIG-DELETE-GF-18-1. NC1174.2 +102800 PERFORM DE-LETE. NC1174.2 +102900 GO TO SIG-WRITE-GF-18-1. NC1174.2 +103000 SIG-FAIL-GF-18-1. NC1174.2 +103100 MOVE +1 TO CORRECT-N. NC1174.2 +103200 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +103300 PERFORM FAIL. NC1174.2 +103400 SIG-WRITE-GF-18-1. NC1174.2 +103500 MOVE "SIG-TEST-GF-18-1 " TO PAR-NAME. NC1174.2 +103600 PERFORM PRINT-DETAIL. NC1174.2 +103700 SIG-TEST-GF-18-2. NC1174.2 +103800 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +103900 PERFORM PASS NC1174.2 +104000 GO TO SIG-WRITE-GF-18-2. NC1174.2 +104100 MOVE "1" TO CORRECT-A. NC1174.2 +104200 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +104300 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1174.2 +104400 PERFORM FAIL. NC1174.2 +104500 GO TO SIG-WRITE-GF-18-2. NC1174.2 +104600 SIG-DELETE-GF-18-2. NC1174.2 +104700 PERFORM DE-LETE. NC1174.2 +104800 SIG-WRITE-GF-18-2. NC1174.2 +104900 MOVE "SIG-TEST-GF-18-2 " TO PAR-NAME. NC1174.2 +105000 PERFORM PRINT-DETAIL. NC1174.2 +105100 SIG-INIT-GF-22. NC1174.2 +105200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +105300 MOVE "DIVIDE BY GIVING " TO FEATURE. NC1174.2 +105400 MOVE ZERO TO WRK-DS-LS-01V00. NC1174.2 +105500 SIG-TEST-GF-22-0. NC1174.2 +105600 DIVIDE A02TWOS-DU-02V00 BY -10.9 GIVING WRK-DS-LS-01V00. NC1174.2 +105700 SIG-TEST-GF-22-1. NC1174.2 +105800 IF WRK-DS-LS-01V00 EQUAL TO -2 NC1174.2 +105900 PERFORM PASS NC1174.2 +106000 GO TO SIG-WRITE-GF-22. NC1174.2 +106100 GO TO SIG-FAIL-GF-22. NC1174.2 +106200 SIG-DELETE-GF-22. NC1174.2 +106300 PERFORM DE-LETE. NC1174.2 +106400 GO TO SIG-WRITE-GF-22. NC1174.2 +106500 SIG-FAIL-GF-22. NC1174.2 +106600 MOVE -2 TO CORRECT-N. NC1174.2 +106700 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +106800 PERFORM FAIL. NC1174.2 +106900 SIG-WRITE-GF-22. NC1174.2 +107000 MOVE "SIG-TEST-GF-22 " TO PAR-NAME. NC1174.2 +107100 PERFORM PRINT-DETAIL. NC1174.2 +107200 SIG-INIT-GF-23. NC1174.2 +107300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +107400 MOVE 0.0000000001 TO WRK-DS-03V10. NC1174.2 +107500 MOVE ZERO TO WRK-DS-LS-18V00. NC1174.2 +107600 MOVE .000000001 TO A01ONE-DS-TS-P0801. NC1174.2 +107700 SIG-TEST-GF-23-0. NC1174.2 +107800 DIVIDE A01ONE-DS-TS-P0801 BY WRK-DS-03V10 GIVING NC1174.2 +107900 WRK-DS-LS-18V00 ROUNDED. NC1174.2 +108000 SIG-TEST-GF-23-1. NC1174.2 +108100 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000010 NC1174.2 +108200 PERFORM PASS NC1174.2 +108300 GO TO SIG-WRITE-GF-23. NC1174.2 +108400 GO TO SIG-FAIL-GF-23. NC1174.2 +108500 SIG-DELETE-GF-23. NC1174.2 +108600 PERFORM DE-LETE. NC1174.2 +108700 GO TO SIG-WRITE-GF-23. NC1174.2 +108800 SIG-FAIL-GF-23. NC1174.2 +108900 MOVE 000000000000000010 TO CORRECT-18V0. NC1174.2 +109000 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +109100 PERFORM FAIL. NC1174.2 +109200 SIG-WRITE-GF-23. NC1174.2 +109300 MOVE "SIG-TEST-GF-23 " TO PAR-NAME. NC1174.2 +109400 PERFORM PRINT-DETAIL. NC1174.2 +109500 SIG-INIT-GF-24. NC1174.2 +109600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +109700 MOVE ZERO TO WRK-DS-LS-18V00 AZERO-DS-LS-05V05. NC1174.2 +109800 MOVE "0" TO WRK-XN-00001. NC1174.2 +109900 MOVE 99 TO A99-DS-02V00. NC1174.2 +110000 SIG-TEST-GF-24-0. NC1174.2 +110100 DIVIDE A99-DS-02V00 BY AZERO-DS-LS-05V05 GIVING NC1174.2 +110200 WRK-DS-LS-18V00 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1174.2 +110300 SIG-TEST-GF-24-1. NC1174.2 +110400 IF WRK-DS-LS-18V00 EQUAL TO 000000000000000000 NC1174.2 +110500 PERFORM PASS NC1174.2 +110600 GO TO SIG-WRITE-GF-24-1. NC1174.2 +110700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1174.2 +110800 MOVE 000000000000000000 TO CORRECT-18V0. NC1174.2 +110900 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1174.2 +111000 PERFORM FAIL. NC1174.2 +111100 GO TO SIG-WRITE-GF-24-1. NC1174.2 +111200 SIG-DELETE-GF-24-1. NC1174.2 +111300 PERFORM DE-LETE. NC1174.2 +111400 SIG-WRITE-GF-24-1. NC1174.2 +111500 MOVE "SIG-TEST-GF-24-1 " TO PAR-NAME. NC1174.2 +111600 PERFORM PRINT-DETAIL. NC1174.2 +111700 SIG-TEST-GF-24-2. NC1174.2 +111800 IF WRK-XN-00001 EQUAL TO "1" NC1174.2 +111900 PERFORM PASS NC1174.2 +112000 GO TO SIG-WRITE-GF-24-2. NC1174.2 +112100 MOVE "1" TO CORRECT-A. NC1174.2 +112200 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +112300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1174.2 +112400 PERFORM FAIL. NC1174.2 +112500 GO TO SIG-WRITE-GF-24-2. NC1174.2 +112600 SIG-DELETE-GF-24-2. NC1174.2 +112700 PERFORM DE-LETE. NC1174.2 +112800 SIG-WRITE-GF-24-2. NC1174.2 +112900 MOVE "SIG-TEST-GF-24-2 " TO PAR-NAME. NC1174.2 +113000 PERFORM PRINT-DETAIL. NC1174.2 +113100 SIG-INIT-GF-25. NC1174.2 +113200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +113300 MOVE .11111 TO A05ONES-DS-LS-00V05. NC1174.2 +113400 MOVE ZERO TO WRK-DS-LS-0201P. NC1174.2 +113500 MOVE -0.005 TO WRK-DS-09V09. NC1174.2 +113600 MOVE "0" TO WRK-XN-00001. NC1174.2 +113700 SIG-TEST-GF-25-0. NC1174.2 +113800 DIVIDE A05ONES-DS-LS-00V05 BY WRK-DS-09V09 GIVING NC1174.2 +113900 WRK-DS-LS-0201P ROUNDED ON SIZE ERROR NC1174.2 +114000 MOVE "1" TO WRK-XN-00001. NC1174.2 +114100 SIG-TEST-GF-25-1. NC1174.2 +114200 MOVE WRK-DS-LS-0201P TO WRK-DS-05V00. NC1174.2 +114300 IF WRK-DS-05V00 EQUAL TO -00020 NC1174.2 +114400 PERFORM PASS NC1174.2 +114500 GO TO SIG-WRITE-GF-25-1. NC1174.2 +114600 MOVE -00020 TO CORRECT-N. NC1174.2 +114700 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1174.2 +114800 PERFORM FAIL. NC1174.2 +114900 GO TO SIG-WRITE-GF-25-1. NC1174.2 +115000 SIG-DELETE-GF-25-1. NC1174.2 +115100 PERFORM DE-LETE. NC1174.2 +115200 SIG-WRITE-GF-25-1. NC1174.2 +115300 MOVE "SIG-TEST-GF-25-1 " TO PAR-NAME. NC1174.2 +115400 PERFORM PRINT-DETAIL. NC1174.2 +115500 SIG-TEST-GF-25-2. NC1174.2 +115600 IF WRK-XN-00001 EQUAL TO "0" NC1174.2 +115700 PERFORM PASS NC1174.2 +115800 GO TO SIG-WRITE-GF-25-2. NC1174.2 +115900 MOVE "0" TO CORRECT-A. NC1174.2 +116000 MOVE WRK-XN-00001 TO COMPUTED-A. NC1174.2 +116100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1174.2 +116200 PERFORM FAIL. NC1174.2 +116300 GO TO SIG-WRITE-GF-25-2. NC1174.2 +116400 SIG-DELETE-GF-25-2. NC1174.2 +116500 PERFORM DE-LETE. NC1174.2 +116600 SIG-WRITE-GF-25-2. NC1174.2 +116700 MOVE "SIG-TEST-GF-25-2 " TO PAR-NAME. NC1174.2 +116800 PERFORM PRINT-DETAIL. NC1174.2 +116900 SIG-INIT-GF-26. NC1174.2 +117000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1174.2 +117100 MOVE 22 TO A02TWOS-DU-02V00 A02TWOS-DS-03V02. NC1174.2 +117200 MOVE "1" TO WRK-XN-00001. NC1174.2 +117300 MOVE ZERO TO WRK-DS-LS-01V00. NC1174.2 +117400 SIG-TEST-GF-26-0. NC1174.2 +117500 DIVIDE A02TWOS-DS-03V02 BY A02TWOS-DU-02V00 GIVING NC1174.2 +117600 WRK-DS-LS-01V00 ROUNDED ON SIZE ERROR NC1174.2 +117700 MOVE "0" TO WRK-XN-00001. NC1174.2 +117800 SIG-TEST-GF-26-1. NC1174.2 +117900 IF WRK-DS-LS-01V00 EQUAL TO +1 NC1174.2 +118000 PERFORM PASS NC1174.2 +118100 GO TO SIG-WRITE-GF-26-1. NC1174.2 +118200 MOVE +1 TO CORRECT-N. NC1174.2 +118300 MOVE WRK-DS-LS-01V00 TO COMPUTED-N. NC1174.2 +118400 PERFORM FAIL. NC1174.2 +118500 GO TO SIG-WRITE-GF-26-1. NC1174.2 +118600 SIG-DELETE-GF-26-1. NC1174.2 +118700 PERFORM DE-LETE. NC1174.2 +118800 SIG-WRITE-GF-26-1. NC1174.2 +118900 MOVE "SIG-TEST-GF-26-1 " TO PAR-NAME. NC1174.2 +119000 PERFORM PRINT-DETAIL. NC1174.2 +119100 SIG-TEST-GF-26-2. NC1174.2 +119200 IF WRK-XN-00001 EQUAL TO "0" NC1174.2 +119300 MOVE "0" TO COMPUTED-A NC1174.2 +119400 MOVE "1" TO CORRECT-A NC1174.2 +119500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1174.2 +119600 PERFORM FAIL NC1174.2 +119700 GO TO SIG-WRITE-GF-26-2. NC1174.2 +119800 PERFORM PASS. NC1174.2 +119900 GO TO SIG-WRITE-GF-26-2. NC1174.2 +120000 SIG-DELETE-GF-26-2. NC1174.2 +120100 PERFORM DE-LETE. NC1174.2 +120200 SIG-WRITE-GF-26-2. NC1174.2 +120300 MOVE "SIG-TEST-GF-26-2 " TO PAR-NAME. NC1174.2 +120400 PERFORM PRINT-DETAIL. NC1174.2 +120500* NC1174.2 +120600 CCVS-EXIT SECTION. NC1174.2 +120700 CCVS-999999. NC1174.2 +120800 GO TO CLOSE-FILES. NC1174.2 diff --git a/tests/cobol85/NC/NC118A.CBL b/tests/cobol85/NC/NC118A.CBL new file mode 100755 index 00000000..398366e3 --- /dev/null +++ b/tests/cobol85/NC/NC118A.CBL @@ -0,0 +1,1037 @@ +000100 IDENTIFICATION DIVISION. NC1184.2 +000200 PROGRAM-ID. NC1184.2 +000300 NC118A. NC1184.2 +000400**************************************************************** NC1184.2 +000500* * NC1184.2 +000600* VALIDATION FOR:- * NC1184.2 +000700* * NC1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1184.2 +000900* * NC1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1184.2 +001100* * NC1184.2 +001200**************************************************************** NC1184.2 +001300* * NC1184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1184.2 +001500* * NC1184.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1184.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1184.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1184.2 +001900* * NC1184.2 +002000**************************************************************** NC1184.2 +002100* NC1184.2 +002200* PROGRAM NC118A TESTS THE USE OF THE "SIGN" CLAUSE USING NC1184.2 +002300* FORMATS 1 AND 2 OF THE ADD STATEMENT. ALL COMBINATIONS NC1184.2 +002400* OF THE SIGN CLAUSE PHRASES ARE TESTED USING DATA ITEMS NC1184.2 +002500* OF VARIOUS LENGTHS. NC1184.2 +002600* NC1184.2 +002700 NC1184.2 +002800 ENVIRONMENT DIVISION. NC1184.2 +002900 CONFIGURATION SECTION. NC1184.2 +003000 SOURCE-COMPUTER. NC1184.2 +003100 Linux. NC1184.2 +003200 OBJECT-COMPUTER. NC1184.2 +003300 Linux. NC1184.2 +003400 INPUT-OUTPUT SECTION. NC1184.2 +003500 FILE-CONTROL. NC1184.2 +003600 SELECT PRINT-FILE ASSIGN TO NC1184.2 +003700 "report.log". NC1184.2 +003800 DATA DIVISION. NC1184.2 +003900 FILE SECTION. NC1184.2 +004000 FD PRINT-FILE. NC1184.2 +004100 01 PRINT-REC PICTURE X(120). NC1184.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC1184.2 +004300 WORKING-STORAGE SECTION. NC1184.2 +004400 77 SIZE-ERR PICTURE X VALUE SPACE. NC1184.2 +004500 77 A18TWOS-DS-LS-18V00 PICTURE S9(18) NC1184.2 +004600 SIGN IS LEADING SEPARATE NC1184.2 +004700 VALUE 222222222222222222. NC1184.2 +004800 77 A18ONES-DS-TS-18V00 PICTURE S9(18) NC1184.2 +004900 SIGN IS TRAILING SEPARATE NC1184.2 +005000 VALUE 111111111111111111. NC1184.2 +005100 77 WRK-DS-10V00 PICTURE S9(10) TRAILING. NC1184.2 +005200 77 A10ONES-DS-T-10V00 PICTURE S9(10) NC1184.2 +005300 SIGN TRAILING NC1184.2 +005400 VALUE 1111111111. NC1184.2 +005500 77 A05ONES-DS-L-05V00 PICTURE S9(5) NC1184.2 +005600 SIGN LEADING NC1184.2 +005700 VALUE 11111. NC1184.2 +005800 77 A02ONES-DS-LS-02V00 PICTURE S99 NC1184.2 +005900 LEADING SEPARATE NC1184.2 +006000 VALUE 11. NC1184.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9) TRAILING. NC1184.2 +006200 77 WRK-DS-T-18V00 REDEFINES WRK-DS-09V09 NC1184.2 +006300 PICTURE S9(18) TRAILING. NC1184.2 +006400 77 A06THREES-DS-03V03 PICTURE S999V999 NC1184.2 +006500 VALUE 333.333. NC1184.2 +006600 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1184.2 +006700 VALUE 333333.333333. NC1184.2 +006800 77 WRK-DS-TS-06V06 PICTURE S9(6)V9(6) NC1184.2 +006900 SIGN IS TRAILING SEPARATE CHARACTER. NC1184.2 +007000 77 WRK-DS-TS-12V00-S REDEFINES WRK-DS-TS-06V06 NC1184.2 +007100 TRAILING SEPARATE NC1184.2 +007200 PICTURE S9(12). NC1184.2 +007300 77 A05ONES-DS-LS-00V05 PICTURE SV9(5) NC1184.2 +007400 LEADING SEPARATE NC1184.2 +007500 VALUE .11111. NC1184.2 +007600 77 WRK-DS-T-05V00 PICTURE S9(5) TRAILING. NC1184.2 +007700 77 WRK-DS-T-06V00 PICTURE S9(6) TRAILING. NC1184.2 +007800 77 WRK-DS-02V00 PICTURE S99. NC1184.2 +007900 77 A12ONES-DS-L-12V00 PICTURE S9(12) NC1184.2 +008000 USAGE IS DISPLAY SIGN IS LEADING NC1184.2 +008100 VALUE 111111111111. NC1184.2 +008200 77 WRK-DS-03V10 PICTURE S999V9(10). NC1184.2 +008300 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1184.2 +008400 PICTURE S9(13). NC1184.2 +008500 77 A99-DS-T-02V00 PICTURE S99 NC1184.2 +008600 USAGE IS DISPLAY SIGN IS TRAILING NC1184.2 +008700 VALUE 99. NC1184.2 +008800 77 A03ONES-DS-02V01 PICTURE S99V9 NC1184.2 +008900 VALUE 11.1. NC1184.2 +009000 77 A06ONES-DS-TS-03V03 PICTURE S999V999 NC1184.2 +009100 USAGE IS DISPLAY TRAILING SEPARATE NC1184.2 +009200 VALUE 111.111. NC1184.2 +009300 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1184.2 +009400 VALUE 22.222222. NC1184.2 +009500 77 A01ONES-DS-LS-P0801 PICTURE SP(8)9 NC1184.2 +009600 SIGN IS LEADING SEPARATE NC1184.2 +009700 VALUE .000000001. NC1184.2 +009800 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1184.2 +009900 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1184.2 +010000 VALUE 111111111111111111. NC1184.2 +010100 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1184.2 +010200 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1184.2 +010300 VALUE 99. NC1184.2 +010400 77 WRK-DS-TS-0201P PICTURE S99P TRAILING SEPARATE. NC1184.2 +010500 77 WRK-DS-06V00 PICTURE S9(6). NC1184.2 +010600 77 AZERO-DS-LS-05V05 PICTURE S9(5)V9(5) NC1184.2 +010700 SIGN IS LEADING SEPARATE USAGE DISPLAY NC1184.2 +010800 VALUE ZERO. NC1184.2 +010900 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1184.2 +011000 VALUE +012345678.876543210. NC1184.2 +011100 77 XDATA-XN-00018 PICTURE X(18) NC1184.2 +011200 VALUE "00ABCDEFGHI 4321 ". NC1184.2 +011300 77 WRK-XN-00018 PICTURE X(18). NC1184.2 +011400 77 ADD-12 PICTURE PP9 VALUE .001. NC1184.2 +011500 77 ADD-13 PICTURE 9PP VALUE 100. NC1184.2 +011600 77 ADD-14 PICTURE 999V999. NC1184.2 +011700 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1184.2 +011800 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1184.2 +011900 COMPUTATIONAL. NC1184.2 +012000 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1184.2 +012100 COMPUTATIONAL. NC1184.2 +012200 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1184.2 +012300 COMPUTATIONAL. NC1184.2 +012400 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1184.2 +012500 COMPUTATIONAL. NC1184.2 +012600 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1184.2 +012700 COMPUTATIONAL. NC1184.2 +012800 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1184.2 +012900 COMPUTATIONAL. NC1184.2 +013000 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1184.2 +013100 COMPUTATIONAL. NC1184.2 +013200 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1184.2 +013300 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1184.2 +013400 COMPUTATIONAL. NC1184.2 +013500 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1184.2 +013600 01 SUBTRACT-DATA SIGN IS LEADING SEPARATE DISPLAY. NC1184.2 +013700 02 SUBTR-1 PICTURE 9 VALUE 1. NC1184.2 +013800 02 SUBTR-2 PICTURE S99 VALUE 99. NC1184.2 +013900 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1184.2 +014000 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1184.2 +014100 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1184.2 +014200 02 SUBTR-6 PICTURE 9 VALUE 1. NC1184.2 +014300 02 SUBTR-7 PICTURE S99 VALUE 99. NC1184.2 +014400 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1184.2 +014500 02 SUBTR-10 PICTURE S999 VALUE 100. NC1184.2 +014600 02 SUBTR-11 PICTURE S999V999. NC1184.2 +014700 01 N-3 PICTURE IS 99999. NC1184.2 +014800 01 N-4 PICTURE IS 9(5) NC1184.2 +014900 VALUE IS 52800. NC1184.2 +015000 01 N-5 PICTURE IS S9(9)V99 NC1184.2 +015100 SIGN IS LEADING SEPARATE NC1184.2 +015200 VALUE IS 000000001.00. NC1184.2 +015300 01 N-7 PICTURE IS S9(7)V9(4) NC1184.2 +015400 SIGN IS LEADING SEPARATE CHARACTER NC1184.2 +015500 VALUE IS 0000001.0000. NC1184.2 +015600 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1184.2 +015700 01 N-10 PICTURE IS S99999V NC1184.2 +015800 VALUE IS -00001. NC1184.2 +015900 01 N-11 PICTURE IS 9 VALUE IS 9. NC1184.2 +016000 01 N-12 PICTURE IS 9 VALUE IS 9. NC1184.2 +016100 01 N-13 PICTURE IS 9(5) NC1184.2 +016200 VALUE IS 99999. NC1184.2 +016300 01 N-14 PICTURE IS 9 VALUE IS 1. NC1184.2 +016400 01 N-15 PICTURE IS 9(16). NC1184.2 +016500 01 N-16 PICTURE IS S999999V99 NC1184.2 +016600 VALUE IS 5.90. NC1184.2 +016700 01 N-17 PICTURE IS S9(3)V99 NC1184.2 +016800 VALUE IS +3.6. NC1184.2 +016900 01 N-18 PICTURE IS S9(10) NC1184.2 +017000 VALUE IS -5. NC1184.2 +017100 01 N-19 PICTURE IS $9.00. NC1184.2 +017200 01 N-20 PICTURE IS S9(9) NC1184.2 +017300 VALUE IS -999999999. NC1184.2 +017400 01 N-21 PICTURE IS 9 VALUE IS 5. NC1184.2 +017500 01 N-22 PICTURE IS 999V99 NC1184.2 +017600 VALUE IS 005.55. NC1184.2 +017700 01 N-23 PICTURE IS $$$.99CR. NC1184.2 +017800 01 N-25 PICTURE IS 9 VALUE IS 1. NC1184.2 +017900 01 N-26 PICTURE 9(5). NC1184.2 +018000 01 N-27 PICTURE IS 9999V9 NC1184.2 +018100 VALUE IS 9999.9. NC1184.2 +018200 01 N-28 PICTURE IS $9999.00. NC1184.2 +018300 01 N-40 PICTURE IS 9(7) NC1184.2 +018400 VALUE IS 7777777. NC1184.2 +018500 01 N-41 PICTURE IS 9(7) NC1184.2 +018600 VALUE IS 1111111. NC1184.2 +018700 01 N-42 PICTURE IS 9(3)P(4). NC1184.2 +018800 01 TRUNC-DATA. NC1184.2 +018900 02 N-43 PICTURE S9V9 VALUE +1.6. NC1184.2 +019000 02 N-44 PICTURE S9V9 VALUE -1.6. NC1184.2 +019100 02 N-45 PICTURE S9. NC1184.2 +019200 01 MINUS-NAMES SIGN IS TRAILING SEPARATE CHARACTER. NC1184.2 +019300 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1184.2 +019400 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1184.2 +019500 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1184.2 +019600 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1184.2 +019700 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1184.2 +019800 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1184.2 +019900 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1184.2 +020000 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1184.2 +020100 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1184.2 +020200 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1184.2 +020300 02 WHOLE-FIELD PICTURE S9(18). NC1184.2 +020400 02 DECMAL-FIELD PICTURE SV9(18). NC1184.2 +020500 01 TEST-RESULTS. NC1184.2 +020600 02 FILLER PIC X VALUE SPACE. NC1184.2 +020700 02 FEATURE PIC X(20) VALUE SPACE. NC1184.2 +020800 02 FILLER PIC X VALUE SPACE. NC1184.2 +020900 02 P-OR-F PIC X(5) VALUE SPACE. NC1184.2 +021000 02 FILLER PIC X VALUE SPACE. NC1184.2 +021100 02 PAR-NAME. NC1184.2 +021200 03 FILLER PIC X(19) VALUE SPACE. NC1184.2 +021300 03 PARDOT-X PIC X VALUE SPACE. NC1184.2 +021400 03 DOTVALUE PIC 99 VALUE ZERO. NC1184.2 +021500 02 FILLER PIC X(8) VALUE SPACE. NC1184.2 +021600 02 RE-MARK PIC X(61). NC1184.2 +021700 01 TEST-COMPUTED. NC1184.2 +021800 02 FILLER PIC X(30) VALUE SPACE. NC1184.2 +021900 02 FILLER PIC X(17) VALUE NC1184.2 +022000 " COMPUTED=". NC1184.2 +022100 02 COMPUTED-X. NC1184.2 +022200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1184.2 +022300 03 COMPUTED-N REDEFINES COMPUTED-A NC1184.2 +022400 PIC -9(9).9(9). NC1184.2 +022500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1184.2 +022600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1184.2 +022700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1184.2 +022800 03 CM-18V0 REDEFINES COMPUTED-A. NC1184.2 +022900 04 COMPUTED-18V0 PIC -9(18). NC1184.2 +023000 04 FILLER PIC X. NC1184.2 +023100 03 FILLER PIC X(50) VALUE SPACE. NC1184.2 +023200 01 TEST-CORRECT. NC1184.2 +023300 02 FILLER PIC X(30) VALUE SPACE. NC1184.2 +023400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1184.2 +023500 02 CORRECT-X. NC1184.2 +023600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1184.2 +023700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1184.2 +023800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1184.2 +023900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1184.2 +024000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1184.2 +024100 03 CR-18V0 REDEFINES CORRECT-A. NC1184.2 +024200 04 CORRECT-18V0 PIC -9(18). NC1184.2 +024300 04 FILLER PIC X. NC1184.2 +024400 03 FILLER PIC X(2) VALUE SPACE. NC1184.2 +024500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1184.2 +024600 01 CCVS-C-1. NC1184.2 +024700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1184.2 +024800- "SS PARAGRAPH-NAME NC1184.2 +024900- " REMARKS". NC1184.2 +025000 02 FILLER PIC X(20) VALUE SPACE. NC1184.2 +025100 01 CCVS-C-2. NC1184.2 +025200 02 FILLER PIC X VALUE SPACE. NC1184.2 +025300 02 FILLER PIC X(6) VALUE "TESTED". NC1184.2 +025400 02 FILLER PIC X(15) VALUE SPACE. NC1184.2 +025500 02 FILLER PIC X(4) VALUE "FAIL". NC1184.2 +025600 02 FILLER PIC X(94) VALUE SPACE. NC1184.2 +025700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1184.2 +025800 01 REC-CT PIC 99 VALUE ZERO. NC1184.2 +025900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1184.2 +026000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1184.2 +026100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1184.2 +026200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1184.2 +026300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1184.2 +026400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1184.2 +026500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1184.2 +026600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1184.2 +026700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1184.2 +026800 01 CCVS-H-1. NC1184.2 +026900 02 FILLER PIC X(39) VALUE SPACES. NC1184.2 +027000 02 FILLER PIC X(42) VALUE NC1184.2 +027100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1184.2 +027200 02 FILLER PIC X(39) VALUE SPACES. NC1184.2 +027300 01 CCVS-H-2A. NC1184.2 +027400 02 FILLER PIC X(40) VALUE SPACE. NC1184.2 +027500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1184.2 +027600 02 FILLER PIC XXXX VALUE NC1184.2 +027700 "4.2 ". NC1184.2 +027800 02 FILLER PIC X(28) VALUE NC1184.2 +027900 " COPY - NOT FOR DISTRIBUTION". NC1184.2 +028000 02 FILLER PIC X(41) VALUE SPACE. NC1184.2 +028100 NC1184.2 +028200 01 CCVS-H-2B. NC1184.2 +028300 02 FILLER PIC X(15) VALUE NC1184.2 +028400 "TEST RESULT OF ". NC1184.2 +028500 02 TEST-ID PIC X(9). NC1184.2 +028600 02 FILLER PIC X(4) VALUE NC1184.2 +028700 " IN ". NC1184.2 +028800 02 FILLER PIC X(12) VALUE NC1184.2 +028900 " HIGH ". NC1184.2 +029000 02 FILLER PIC X(22) VALUE NC1184.2 +029100 " LEVEL VALIDATION FOR ". NC1184.2 +029200 02 FILLER PIC X(58) VALUE NC1184.2 +029300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1184.2 +029400 01 CCVS-H-3. NC1184.2 +029500 02 FILLER PIC X(34) VALUE NC1184.2 +029600 " FOR OFFICIAL USE ONLY ". NC1184.2 +029700 02 FILLER PIC X(58) VALUE NC1184.2 +029800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1184.2 +029900 02 FILLER PIC X(28) VALUE NC1184.2 +030000 " COPYRIGHT 1985 ". NC1184.2 +030100 01 CCVS-E-1. NC1184.2 +030200 02 FILLER PIC X(52) VALUE SPACE. NC1184.2 +030300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1184.2 +030400 02 ID-AGAIN PIC X(9). NC1184.2 +030500 02 FILLER PIC X(45) VALUE SPACES. NC1184.2 +030600 01 CCVS-E-2. NC1184.2 +030700 02 FILLER PIC X(31) VALUE SPACE. NC1184.2 +030800 02 FILLER PIC X(21) VALUE SPACE. NC1184.2 +030900 02 CCVS-E-2-2. NC1184.2 +031000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1184.2 +031100 03 FILLER PIC X VALUE SPACE. NC1184.2 +031200 03 ENDER-DESC PIC X(44) VALUE NC1184.2 +031300 "ERRORS ENCOUNTERED". NC1184.2 +031400 01 CCVS-E-3. NC1184.2 +031500 02 FILLER PIC X(22) VALUE NC1184.2 +031600 " FOR OFFICIAL USE ONLY". NC1184.2 +031700 02 FILLER PIC X(12) VALUE SPACE. NC1184.2 +031800 02 FILLER PIC X(58) VALUE NC1184.2 +031900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1184.2 +032000 02 FILLER PIC X(13) VALUE SPACE. NC1184.2 +032100 02 FILLER PIC X(15) VALUE NC1184.2 +032200 " COPYRIGHT 1985". NC1184.2 +032300 01 CCVS-E-4. NC1184.2 +032400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1184.2 +032500 02 FILLER PIC X(4) VALUE " OF ". NC1184.2 +032600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1184.2 +032700 02 FILLER PIC X(40) VALUE NC1184.2 +032800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1184.2 +032900 01 XXINFO. NC1184.2 +033000 02 FILLER PIC X(19) VALUE NC1184.2 +033100 "*** INFORMATION ***". NC1184.2 +033200 02 INFO-TEXT. NC1184.2 +033300 04 FILLER PIC X(8) VALUE SPACE. NC1184.2 +033400 04 XXCOMPUTED PIC X(20). NC1184.2 +033500 04 FILLER PIC X(5) VALUE SPACE. NC1184.2 +033600 04 XXCORRECT PIC X(20). NC1184.2 +033700 02 INF-ANSI-REFERENCE PIC X(48). NC1184.2 +033800 01 HYPHEN-LINE. NC1184.2 +033900 02 FILLER PIC IS X VALUE IS SPACE. NC1184.2 +034000 02 FILLER PIC IS X(65) VALUE IS "************************NC1184.2 +034100- "*****************************************". NC1184.2 +034200 02 FILLER PIC IS X(54) VALUE IS "************************NC1184.2 +034300- "******************************". NC1184.2 +034400 01 CCVS-PGM-ID PIC X(9) VALUE NC1184.2 +034500 "NC118A". NC1184.2 +034600 PROCEDURE DIVISION. NC1184.2 +034700 CCVS1 SECTION. NC1184.2 +034800 OPEN-FILES. NC1184.2 +034900 OPEN OUTPUT PRINT-FILE. NC1184.2 +035000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1184.2 +035100 MOVE SPACE TO TEST-RESULTS. NC1184.2 +035200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1184.2 +035300 GO TO CCVS1-EXIT. NC1184.2 +035400 CLOSE-FILES. NC1184.2 +035500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1184.2 +035600 TERMINATE-CCVS. NC1184.2 +035700*S EXIT PROGRAM. NC1184.2 +035800*SERMINATE-CALL. NC1184.2 +035900 STOP RUN. NC1184.2 +036000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1184.2 +036100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1184.2 +036200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1184.2 +036300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1184.2 +036400 MOVE "****TEST DELETED****" TO RE-MARK. NC1184.2 +036500 PRINT-DETAIL. NC1184.2 +036600 IF REC-CT NOT EQUAL TO ZERO NC1184.2 +036700 MOVE "." TO PARDOT-X NC1184.2 +036800 MOVE REC-CT TO DOTVALUE. NC1184.2 +036900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1184.2 +037000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1184.2 +037100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1184.2 +037200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1184.2 +037300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1184.2 +037400 MOVE SPACE TO CORRECT-X. NC1184.2 +037500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1184.2 +037600 MOVE SPACE TO RE-MARK. NC1184.2 +037700 HEAD-ROUTINE. NC1184.2 +037800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +037900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +038000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1184.2 +038100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1184.2 +038200 COLUMN-NAMES-ROUTINE. NC1184.2 +038300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +038400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +038500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +038600 END-ROUTINE. NC1184.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1184.2 +038800 END-RTN-EXIT. NC1184.2 +038900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +039000 END-ROUTINE-1. NC1184.2 +039100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1184.2 +039200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1184.2 +039300 ADD PASS-COUNTER TO ERROR-HOLD. NC1184.2 +039400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1184.2 +039500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1184.2 +039600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1184.2 +039700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1184.2 +039800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1184.2 +039900 END-ROUTINE-12. NC1184.2 +040000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1184.2 +040100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1184.2 +040200 MOVE "NO " TO ERROR-TOTAL NC1184.2 +040300 ELSE NC1184.2 +040400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1184.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1184.2 +040600 PERFORM WRITE-LINE. NC1184.2 +040700 END-ROUTINE-13. NC1184.2 +040800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1184.2 +040900 MOVE "NO " TO ERROR-TOTAL ELSE NC1184.2 +041000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1184.2 +041100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1184.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +041300 IF INSPECT-COUNTER EQUAL TO ZERO NC1184.2 +041400 MOVE "NO " TO ERROR-TOTAL NC1184.2 +041500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1184.2 +041600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1184.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +041800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1184.2 +041900 WRITE-LINE. NC1184.2 +042000 ADD 1 TO RECORD-COUNT. NC1184.2 +042100 IF RECORD-COUNT GREATER 42 NC1184.2 +042200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1184.2 +042300 MOVE SPACE TO DUMMY-RECORD NC1184.2 +042400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1184.2 +042500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1184.2 +042600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1184.2 +042700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1184.2 +042800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1184.2 +042900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1184.2 +043000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1184.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1184.2 +043200 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1184.2 +043300 MOVE ZERO TO RECORD-COUNT. NC1184.2 +043400 PERFORM WRT-LN. NC1184.2 +043500 WRT-LN. NC1184.2 +043600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1184.2 +043700 MOVE SPACE TO DUMMY-RECORD. NC1184.2 +043800 BLANK-LINE-PRINT. NC1184.2 +043900 PERFORM WRT-LN. NC1184.2 +044000 FAIL-ROUTINE. NC1184.2 +044100 IF COMPUTED-X NOT EQUAL TO SPACE NC1184.2 +044200 GO TO FAIL-ROUTINE-WRITE. NC1184.2 +044300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1184.2 +044400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1184.2 +044500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1184.2 +044600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +044700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1184.2 +044800 GO TO FAIL-ROUTINE-EX. NC1184.2 +044900 FAIL-ROUTINE-WRITE. NC1184.2 +045000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1184.2 +045100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1184.2 +045200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1184.2 +045300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1184.2 +045400 FAIL-ROUTINE-EX. EXIT. NC1184.2 +045500 BAIL-OUT. NC1184.2 +045600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1184.2 +045700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1184.2 +045800 BAIL-OUT-WRITE. NC1184.2 +045900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1184.2 +046000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1184.2 +046100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1184.2 +046200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1184.2 +046300 BAIL-OUT-EX. EXIT. NC1184.2 +046400 CCVS1-EXIT. NC1184.2 +046500 EXIT. NC1184.2 +046600 SECT-NC118A-001 SECTION. NC1184.2 +046700 SIG-INIT-GF-1. NC1184.2 +046800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +046900 MOVE "ADD " TO FEATURE. NC1184.2 +047000 MOVE 000000001.00 TO N-5. NC1184.2 +047100 MOVE 0000001.0000 TO N-7. NC1184.2 +047200 SIG-TEST-GF-1-0. NC1184.2 +047300 ADD N-5 TO N-7. NC1184.2 +047400 SIG-TEST-GF-1-1. NC1184.2 +047500 IF N-7 = 2 NC1184.2 +047600 PERFORM PASS GO TO SIG-WRITE-GF-1. NC1184.2 +047700 GO TO SIG-FAIL-GF-1. NC1184.2 +047800 SIG-DELETE-GF-1. NC1184.2 +047900 PERFORM DE-LETE. NC1184.2 +048000 GO TO SIG-WRITE-GF-1. NC1184.2 +048100 SIG-FAIL-GF-1. NC1184.2 +048200 MOVE N-7 TO COMPUTED-N NC1184.2 +048300 MOVE 2 TO CORRECT-N. NC1184.2 +048400 PERFORM FAIL. NC1184.2 +048500 SIG-WRITE-GF-1. NC1184.2 +048600 MOVE "SIG-TEST-GF-1" TO PAR-NAME. NC1184.2 +048700 PERFORM PRINT-DETAIL. NC1184.2 +048800 SIG-INIT-GF-2. NC1184.2 +048900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +049000 MOVE "ADD ---" TO FEATURE. NC1184.2 +049100 PERFORM PRINT-DETAIL. NC1184.2 +049200 MOVE " TO" TO FEATURE. NC1184.2 +049300 MOVE A18TWOS-DS-LS-18V00 TO WRK-DS-T-18V00. NC1184.2 +049400 SIG-TEST-GF-2-0. NC1184.2 +049500 ADD A18ONES-DS-TS-18V00 TO WRK-DS-T-18V00. NC1184.2 +049600 SIG-TEST-GF-2-1. NC1184.2 +049700 IF WRK-DS-T-18V00 EQUAL TO 333333333333333333 NC1184.2 +049800 PERFORM PASS GO TO SIG-WRITE-GF-2. NC1184.2 +049900 GO TO SIG-FAIL-GF-2. NC1184.2 +050000 SIG-DELETE-GF-2. NC1184.2 +050100 PERFORM DE-LETE. NC1184.2 +050200 GO TO SIG-WRITE-GF-2. NC1184.2 +050300 SIG-FAIL-GF-2. NC1184.2 +050400 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1184.2 +050500 MOVE 333333333333333333 TO CORRECT-18V0. NC1184.2 +050600 PERFORM FAIL. NC1184.2 +050700 SIG-WRITE-GF-2. NC1184.2 +050800 MOVE "SIG-TEST-GF-2" TO PAR-NAME. NC1184.2 +050900 PERFORM PRINT-DETAIL. NC1184.2 +051000 SIG-INIT-GF-3. NC1184.2 +051100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +051200 MOVE ZERO TO WRK-DS-10V00. NC1184.2 +051300 SIG-TEST-GF-3-0. NC1184.2 +051400 ADD A10ONES-DS-T-10V00 A05ONES-DS-L-05V00 NC1184.2 +051500 TO WRK-DS-10V00. NC1184.2 +051600 SIG-TEST-GF-3-1. NC1184.2 +051700 IF WRK-DS-10V00 EQUAL TO 1111122222 NC1184.2 +051800 PERFORM PASS GO TO SIG-WRITE-GF-3. NC1184.2 +051900 GO TO SIG-FAIL-GF-3. NC1184.2 +052000 SIG-DELETE-GF-3. NC1184.2 +052100 PERFORM DE-LETE. NC1184.2 +052200 GO TO SIG-WRITE-GF-3. NC1184.2 +052300 SIG-FAIL-GF-3. NC1184.2 +052400 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1184.2 +052500 MOVE 1111122222 TO CORRECT-18V0. NC1184.2 +052600 PERFORM FAIL. NC1184.2 +052700 SIG-WRITE-GF-3. NC1184.2 +052800 MOVE "SIG-TEST-GF-3" TO PAR-NAME. NC1184.2 +052900 PERFORM PRINT-DETAIL. NC1184.2 +053000 SIG-INIT-GF-4. NC1184.2 +053100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +053200 MOVE ZERO TO WRK-DS-10V00. NC1184.2 +053300 SIG-TEST-GF-4-0. NC1184.2 +053400 ADD A02ONES-DS-LS-02V00 NC1184.2 +053500 A10ONES-DS-T-10V00 NC1184.2 +053600 A05ONES-DS-L-05V00 TO WRK-DS-10V00. NC1184.2 +053700 SIG-TEST-GF-4-1. NC1184.2 +053800 IF WRK-DS-10V00 EQUAL TO 1111122233 NC1184.2 +053900 PERFORM PASS GO TO SIG-WRITE-GF-4. NC1184.2 +054000 GO TO SIG-FAIL-GF-4. NC1184.2 +054100 SIG-DELETE-GF-4. NC1184.2 +054200 PERFORM DE-LETE. NC1184.2 +054300 GO TO SIG-WRITE-GF-4. NC1184.2 +054400 SIG-FAIL-GF-4. NC1184.2 +054500 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1184.2 +054600 MOVE 1111122233 TO CORRECT-18V0. NC1184.2 +054700 PERFORM FAIL. NC1184.2 +054800 SIG-WRITE-GF-4. NC1184.2 +054900 MOVE "SIG-TEST-GF-4" TO PAR-NAME. NC1184.2 +055000 PERFORM PRINT-DETAIL. NC1184.2 +055100 SIG-INIT-GF-10. NC1184.2 +055200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +055300 MOVE " GIVING" TO FEATURE. NC1184.2 +055400 MOVE ZERO TO WRK-DS-09V09. NC1184.2 +055500 SIG-TEST-GF-10-0. NC1184.2 +055600 ADD A06THREES-DS-03V03 NC1184.2 +055700 A12THREES-DS-06V06 GIVING WRK-DS-09V09. NC1184.2 +055800 SIG-TEST-GF-10-1. NC1184.2 +055900 IF WRK-DS-09V09 EQUAL TO 000333666.666333000 NC1184.2 +056000 PERFORM PASS GO TO SIG-WRITE-GF-10. NC1184.2 +056100 GO TO SIG-FAIL-GF-10. NC1184.2 +056200 SIG-DELETE-GF-10. NC1184.2 +056300 PERFORM DE-LETE. NC1184.2 +056400 GO TO SIG-WRITE-GF-10. NC1184.2 +056500 SIG-FAIL-GF-10. NC1184.2 +056600 MOVE WRK-DS-09V09 TO COMPUTED-N. NC1184.2 +056700 MOVE 000333666.666333000 TO CORRECT-N. NC1184.2 +056800 PERFORM FAIL. NC1184.2 +056900 SIG-WRITE-GF-10. NC1184.2 +057000 MOVE "SIG-TEST-GF-10" TO PAR-NAME. NC1184.2 +057100 PERFORM PRINT-DETAIL. NC1184.2 +057200 SIG-INIT-GF-11. NC1184.2 +057300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +057400 MOVE ZERO TO WRK-DS-TS-06V06. NC1184.2 +057500 SIG-TEST-GF-11-0. NC1184.2 +057600 ADD A05ONES-DS-L-05V00 NC1184.2 +057700 A05ONES-DS-LS-00V05 NC1184.2 +057800 A12THREES-DS-06V06 NC1184.2 +057900 A06THREES-DS-03V03 GIVING WRK-DS-TS-06V06. NC1184.2 +058000 SIG-TEST-GF-11-1. NC1184.2 +058100 IF WRK-DS-TS-06V06 EQUAL TO 344777.777443 NC1184.2 +058200 PERFORM PASS GO TO SIG-WRITE-GF-11. NC1184.2 +058300 GO TO SIG-FAIL-GF-11. NC1184.2 +058400 SIG-DELETE-GF-11. NC1184.2 +058500 PERFORM DE-LETE. NC1184.2 +058600 GO TO SIG-WRITE-GF-11. NC1184.2 +058700 SIG-FAIL-GF-11. NC1184.2 +058800 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1184.2 +058900 MOVE 344777.777443 TO CORRECT-N. NC1184.2 +059000 PERFORM FAIL. NC1184.2 +059100 SIG-WRITE-GF-11. NC1184.2 +059200 MOVE "SIG-TEST-GF-11" TO PAR-NAME. NC1184.2 +059300 PERFORM PRINT-DETAIL. NC1184.2 +059400 SIG-INIT-GF-5. NC1184.2 +059500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +059600 MOVE " ROUNDED" TO FEATURE. NC1184.2 +059700 MOVE ZERO TO WRK-DS-T-05V00. NC1184.2 +059800 SIG-TEST-GF-5-0. NC1184.2 +059900 ADD 55554.5 TO WRK-DS-T-05V00 ROUNDED. NC1184.2 +060000 SIG-TEST-GF-5-1. NC1184.2 +060100 IF WRK-DS-T-05V00 EQUAL TO 55555 NC1184.2 +060200 PERFORM PASS GO TO SIG-WRITE-GF-5. NC1184.2 +060300 GO TO SIG-FAIL-GF-5. NC1184.2 +060400 SIG-DELETE-GF-5. NC1184.2 +060500 PERFORM DE-LETE. NC1184.2 +060600 GO TO SIG-WRITE-GF-5. NC1184.2 +060700 SIG-FAIL-GF-5. NC1184.2 +060800 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1184.2 +060900 MOVE 55555 TO CORRECT-N. NC1184.2 +061000 PERFORM FAIL. NC1184.2 +061100 SIG-WRITE-GF-5. NC1184.2 +061200 MOVE "SIG-TEST-GF-5" TO PAR-NAME. NC1184.2 +061300 PERFORM PRINT-DETAIL. NC1184.2 +061400 SIG-INIT-GF-12. NC1184.2 +061500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +061600 MOVE ZERO TO WRK-DS-T-06V00. NC1184.2 +061700 SIG-TEST-GF-12-0. NC1184.2 +061800 ADD A05ONES-DS-LS-00V05 NC1184.2 +061900 A12THREES-DS-06V06 NC1184.2 +062000 A05ONES-DS-LS-00V05 GIVING WRK-DS-T-06V00 ROUNDED. NC1184.2 +062100 SIG-TEST-GF-12-1. NC1184.2 +062200 IF WRK-DS-T-06V00 EQUAL TO 333334 NC1184.2 +062300 PERFORM PASS GO TO SIG-WRITE-GF-12. NC1184.2 +062400 GO TO SIG-FAIL-GF-12. NC1184.2 +062500 SIG-DELETE-GF-12. NC1184.2 +062600 PERFORM DE-LETE. NC1184.2 +062700 GO TO SIG-WRITE-GF-12. NC1184.2 +062800 SIG-FAIL-GF-12. NC1184.2 +062900 MOVE WRK-DS-T-06V00 TO COMPUTED-N. NC1184.2 +063000 MOVE 333334 TO CORRECT-N. NC1184.2 +063100 PERFORM FAIL. NC1184.2 +063200 SIG-WRITE-GF-12. NC1184.2 +063300 MOVE "SIG-TEST-GF-12" TO PAR-NAME. NC1184.2 +063400 PERFORM PRINT-DETAIL. NC1184.2 +063500 SIG-INIT-GF-13. NC1184.2 +063600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +063700 MOVE ZERO TO WRK-DS-10V00. NC1184.2 +063800 SIG-TEST-GF-13-1-0. NC1184.2 +063900 ADD A12ONES-DS-L-12V00 NC1184.2 +064000 ZERO GIVING WRK-DS-10V00 ON SIZE ERROR NC1184.2 +064100 PERFORM PASS GO TO SIG-WRITE-GF-13-1. NC1184.2 +064200 GO TO SIG-FAIL-GF-13-1. NC1184.2 +064300 SIG-DELETE-GF-13-1. NC1184.2 +064400 PERFORM DE-LETE. NC1184.2 +064500 GO TO SIG-WRITE-GF-13-1. NC1184.2 +064600 SIG-FAIL-GF-13-1. NC1184.2 +064700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1184.2 +064800 PERFORM FAIL. NC1184.2 +064900 SIG-WRITE-GF-13-1. NC1184.2 +065000 MOVE "SIG-TEST-GF-13-1" TO PAR-NAME. NC1184.2 +065100 PERFORM PRINT-DETAIL. NC1184.2 +065200 SIG-TEST-GF-13-2. NC1184.2 +065300 IF WRK-DS-10V00 EQUAL TO ZERO NC1184.2 +065400 PERFORM PASS GO TO SIG-WRITE-GF-13-2. NC1184.2 +065500* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-13-1 NC1184.2 +065600 GO TO SIG-FAIL-GF-13-2. NC1184.2 +065700 SIG-DELETE-GF-13-2. NC1184.2 +065800 PERFORM DE-LETE. NC1184.2 +065900 GO TO SIG-WRITE-GF-13-2. NC1184.2 +066000 SIG-FAIL-GF-13-2. NC1184.2 +066100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1184.2 +066200 MOVE WRK-DS-10V00 TO COMPUTED-14V4. NC1184.2 +066300 MOVE ZERO TO CORRECT-14V4. NC1184.2 +066400 PERFORM FAIL. NC1184.2 +066500 SIG-WRITE-GF-13-2. NC1184.2 +066600 MOVE "SIG-TEST-GF-13-2" TO PAR-NAME. NC1184.2 +066700 PERFORM PRINT-DETAIL. NC1184.2 +066800 SIG-INIT-GF-6. NC1184.2 +066900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +067000 MOVE " ROUNDED,SIZE ERROR" TO FEATURE. NC1184.2 +067100 MOVE ZERO TO WRK-DS-T-05V00. NC1184.2 +067200 SIG-TEST-GF-6-1. NC1184.2 +067300 ADD 33333 NC1184.2 +067400 A06THREES-DS-03V03 NC1184.2 +067500 A12THREES-DS-06V06 NC1184.2 +067600 TO WRK-DS-T-05V00 ROUNDED ON SIZE ERROR NC1184.2 +067700 PERFORM PASS GO TO SIG-WRITE-GF-6-1. NC1184.2 +067800 GO TO SIG-FAIL-GF-6-1. NC1184.2 +067900 SIG-DELETE-GF-6-1. NC1184.2 +068000 PERFORM DE-LETE. NC1184.2 +068100 GO TO SIG-WRITE-GF-6-1. NC1184.2 +068200 SIG-FAIL-GF-6-1. NC1184.2 +068300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1184.2 +068400 PERFORM FAIL. NC1184.2 +068500 SIG-WRITE-GF-6-1. NC1184.2 +068600 MOVE "SIG-TEST-GF-6-1" TO PAR-NAME. NC1184.2 +068700 PERFORM PRINT-DETAIL. NC1184.2 +068800 SIG-TEST-GF-6-2. NC1184.2 +068900 IF WRK-DS-T-05V00 EQUAL TO ZERO NC1184.2 +069000 PERFORM PASS GO TO SIG-WRITE-GF-6-2. NC1184.2 +069100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-6-1 NC1184.2 +069200 GO TO SIG-FAIL-GF-6-2. NC1184.2 +069300 SIG-DELETE-GF-6-2. NC1184.2 +069400 PERFORM DE-LETE. NC1184.2 +069500 GO TO SIG-WRITE-GF-6-2. NC1184.2 +069600 SIG-FAIL-GF-6-2. NC1184.2 +069700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1184.2 +069800 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1184.2 +069900 MOVE ZERO TO CORRECT-N. NC1184.2 +070000 PERFORM FAIL. NC1184.2 +070100 SIG-WRITE-GF-6-2. NC1184.2 +070200 MOVE "SIG-TEST-GF-6-2" TO PAR-NAME. NC1184.2 +070300 PERFORM PRINT-DETAIL. NC1184.2 +070400 SIG-INIT-GF-7. NC1184.2 +070500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +070600 MOVE ZERO TO WRK-DS-TS-06V06. NC1184.2 +070700 SIG-TEST-GF-7-1. NC1184.2 +070800 ADD A12THREES-DS-06V06 NC1184.2 +070900 333333 NC1184.2 +071000 A06THREES-DS-03V03 NC1184.2 +071100 TO WRK-DS-TS-06V06 ROUNDED ON SIZE ERROR NC1184.2 +071200 GO TO SIG-FAIL-GF-7-1. NC1184.2 +071300 PERFORM PASS. NC1184.2 +071400 GO TO SIG-WRITE-GF-7-1. NC1184.2 +071500 SIG-DELETE-GF-7-1. NC1184.2 +071600 PERFORM DE-LETE. NC1184.2 +071700 GO TO SIG-WRITE-GF-7-1. NC1184.2 +071800 SIG-FAIL-GF-7-1. NC1184.2 +071900 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1184.2 +072000 PERFORM FAIL. NC1184.2 +072100 SIG-WRITE-GF-7-1. NC1184.2 +072200 MOVE "SIG-TEST-GF-7-1" TO PAR-NAME. NC1184.2 +072300 PERFORM PRINT-DETAIL. NC1184.2 +072400 SIG-TEST-GF-7-2. NC1184.2 +072500 IF WRK-DS-TS-06V06 EQUAL TO 666999.666333 NC1184.2 +072600 PERFORM PASS GO TO SIG-WRITE-GF-7-2. NC1184.2 +072700* NOTE THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-7-1NC1184.2 +072800 GO TO SIG-FAIL-GF-7-2. NC1184.2 +072900 SIG-DELETE-GF-7-2. NC1184.2 +073000 PERFORM DE-LETE. NC1184.2 +073100 GO TO SIG-WRITE-GF-7-2. NC1184.2 +073200 SIG-FAIL-GF-7-2. NC1184.2 +073300 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1184.2 +073400 MOVE 666999.666333 TO CORRECT-N. NC1184.2 +073500 PERFORM FAIL. NC1184.2 +073600 SIG-WRITE-GF-7-2. NC1184.2 +073700 MOVE "SIG-TEST-GF-7-2" TO PAR-NAME. NC1184.2 +073800 PERFORM PRINT-DETAIL. NC1184.2 +073900 SIG-INIT-GF-14. NC1184.2 +074000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +074100 MOVE ZERO TO WRK-DS-T-05V00. NC1184.2 +074200 SIG-TEST-GF-14-1. NC1184.2 +074300 ADD 33333 NC1184.2 +074400 A06THREES-DS-03V03 NC1184.2 +074500 A12THREES-DS-06V06 NC1184.2 +074600 GIVING WRK-DS-T-05V00 ROUNDED ON SIZE ERROR NC1184.2 +074700 PERFORM PASS GO TO SIG-WRITE-GF-14-1. NC1184.2 +074800 GO TO SIG-FAIL-GF-14-1. NC1184.2 +074900 SIG-DELETE-GF-14-1. NC1184.2 +075000 PERFORM DE-LETE. NC1184.2 +075100 GO TO SIG-WRITE-GF-14-1. NC1184.2 +075200 SIG-FAIL-GF-14-1. NC1184.2 +075300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1184.2 +075400 PERFORM FAIL. NC1184.2 +075500 SIG-WRITE-GF-14-1. NC1184.2 +075600 MOVE "SIG-TEST-GF-14-1" TO PAR-NAME. NC1184.2 +075700 PERFORM PRINT-DETAIL. NC1184.2 +075800 SIG-TEST-GF-14-2. NC1184.2 +075900 IF WRK-DS-T-05V00 EQUAL TO ZERO NC1184.2 +076000 PERFORM PASS GO TO SIG-WRITE-GF-14-2. NC1184.2 +076100 GO TO SIG-FAIL-GF-14-2. NC1184.2 +076200* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-14-1 NC1184.2 +076300 SIG-DELETE-GF-14-2. NC1184.2 +076400 PERFORM DE-LETE. NC1184.2 +076500 GO TO SIG-WRITE-GF-14-2. NC1184.2 +076600 SIG-FAIL-GF-14-2. NC1184.2 +076700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1184.2 +076800 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1184.2 +076900 MOVE ZERO TO CORRECT-N. NC1184.2 +077000 PERFORM FAIL. NC1184.2 +077100 SIG-WRITE-GF-14-2. NC1184.2 +077200 MOVE "SIG-TEST-GF-14-2" TO PAR-NAME. NC1184.2 +077300 PERFORM PRINT-DETAIL. NC1184.2 +077400 SIG-INIT-GF-15. NC1184.2 +077500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +077600 MOVE ZERO TO WRK-DS-TS-06V06. NC1184.2 +077700 SIG-TEST-GF-15-1-0. NC1184.2 +077800 ADD A12THREES-DS-06V06 NC1184.2 +077900 333333 NC1184.2 +078000 A06THREES-DS-03V03 NC1184.2 +078100 GIVING WRK-DS-TS-06V06 ROUNDED ON SIZE ERROR NC1184.2 +078200 GO TO SIG-FAIL-GF-15-1. NC1184.2 +078300 PERFORM PASS. NC1184.2 +078400 GO TO SIG-WRITE-GF-15-1. NC1184.2 +078500 SIG-DELETE-GF-15-1. NC1184.2 +078600 PERFORM DE-LETE. NC1184.2 +078700 GO TO SIG-WRITE-GF-15-1. NC1184.2 +078800 SIG-FAIL-GF-15-1. NC1184.2 +078900 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1184.2 +079000 PERFORM FAIL. NC1184.2 +079100 SIG-WRITE-GF-15-1. NC1184.2 +079200 MOVE "SIG-TEST-GF-15-1" TO PAR-NAME. NC1184.2 +079300 PERFORM PRINT-DETAIL. NC1184.2 +079400 SIG-TEST-GF-15-2. NC1184.2 +079500 IF WRK-DS-TS-06V06 EQUAL TO 666999.666333 NC1184.2 +079600 PERFORM PASS GO TO SIG-WRITE-GF-15-2. NC1184.2 +079700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SIG-TEST-GF-15-1 NC1184.2 +079800 GO TO SIG-FAIL-GF-15-2. NC1184.2 +079900 SIG-DELETE-GF-15-2. NC1184.2 +080000 PERFORM DE-LETE. NC1184.2 +080100 GO TO SIG-WRITE-GF-15-2. NC1184.2 +080200 SIG-FAIL-GF-15-2. NC1184.2 +080300 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1184.2 +080400 MOVE 666999.666333 TO CORRECT-N. NC1184.2 +080500 PERFORM FAIL. NC1184.2 +080600 SIG-WRITE-GF-15-2. NC1184.2 +080700 MOVE "SIG-TEST-GF-15-2" TO PAR-NAME. NC1184.2 +080800 PERFORM PRINT-DETAIL. NC1184.2 +080900 SIG-INIT-GF-16. NC1184.2 +081000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +081100 MOVE " SERIES" TO FEATURE. NC1184.2 +081200 MOVE ZERO TO WRK-DS-03V10. NC1184.2 +081300 SIG-TEST-GF-16-0. NC1184.2 +081400 ADD A99-DS-T-02V00 NC1184.2 +081500 A03ONES-DS-02V01 NC1184.2 +081600 A06ONES-DS-TS-03V03 NC1184.2 +081700 A08TWOS-DS-02V06 NC1184.2 +081800 -1.1111111 NC1184.2 +081900 +.11111111 NC1184.2 +082000 A01ONES-DS-LS-P0801 GIVING WRK-DS-03V10. NC1184.2 +082100 SIG-TEST-GF-16-1. NC1184.2 +082200 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1184.2 +082300 PERFORM PASS GO TO SIG-WRITE-GF-16. NC1184.2 +082400 GO TO SIG-FAIL-GF-16. NC1184.2 +082500 SIG-DELETE-GF-16. NC1184.2 +082600 PERFORM DE-LETE. NC1184.2 +082700 GO TO SIG-WRITE-GF-16. NC1184.2 +082800 SIG-FAIL-GF-16. NC1184.2 +082900 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1184.2 +083000 MOVE 242.4332220110 TO CORRECT-4V14. NC1184.2 +083100 PERFORM FAIL. NC1184.2 +083200 SIG-WRITE-GF-16. NC1184.2 +083300 MOVE "SIG-TEST-GF-16" TO PAR-NAME. NC1184.2 +083400 PERFORM PRINT-DETAIL. NC1184.2 +083500 SIG-INIT-GF-17. NC1184.2 +083600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +083700 MOVE ZERO TO WRK-DS-03V10. NC1184.2 +083800 SIG-TEST-GF-17-0. NC1184.2 +083900 ADD A01ONES-DS-LS-P0801 NC1184.2 +084000 +.11111111 NC1184.2 +084100 -1.1111111 NC1184.2 +084200 A08TWOS-DS-02V06 NC1184.2 +084300 A06ONES-DS-TS-03V03 NC1184.2 +084400 A03ONES-DS-02V01 NC1184.2 +084500 A99-DS-T-02V00 GIVING WRK-DS-03V10. NC1184.2 +084600 SIG-TEST-GF-17-1. NC1184.2 +084700 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1184.2 +084800 PERFORM PASS GO TO SIG-WRITE-GF-17. NC1184.2 +084900 GO TO SIG-FAIL-GF-17. NC1184.2 +085000 SIG-DELETE-GF-17. NC1184.2 +085100 PERFORM DE-LETE. NC1184.2 +085200 GO TO SIG-WRITE-GF-17. NC1184.2 +085300 SIG-FAIL-GF-17. NC1184.2 +085400 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1184.2 +085500 MOVE 242.4332220110 TO CORRECT-4V14. NC1184.2 +085600 PERFORM FAIL. NC1184.2 +085700 SIG-WRITE-GF-17. NC1184.2 +085800 MOVE "SIG-TEST-GF-17" TO PAR-NAME. NC1184.2 +085900 PERFORM PRINT-DETAIL. NC1184.2 +086000 SIG-INIT-GF-18. NC1184.2 +086100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +086200 MOVE ZERO TO WRK-DS-03V10. NC1184.2 +086300 SIG-TEST-GF-18-0. NC1184.2 +086400 ADD A08TWOS-DS-02V06 NC1184.2 +086500 A99-DS-T-02V00 NC1184.2 +086600 -1.1111111 NC1184.2 +086700 A03ONES-DS-02V01 NC1184.2 +086800 A01ONES-DS-LS-P0801 NC1184.2 +086900 +.11111111 NC1184.2 +087000 A06ONES-DS-TS-03V03 GIVING WRK-DS-03V10. NC1184.2 +087100 SIG-TEST-GF-18-1. NC1184.2 +087200 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1184.2 +087300 PERFORM PASS GO TO SIG-WRITE-GF-18. NC1184.2 +087400 GO TO SIG-FAIL-GF-18. NC1184.2 +087500 SIG-DELETE-GF-18. NC1184.2 +087600 PERFORM DE-LETE. NC1184.2 +087700 GO TO SIG-WRITE-GF-18. NC1184.2 +087800 SIG-FAIL-GF-18. NC1184.2 +087900 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1184.2 +088000 MOVE 242.4332220110 TO CORRECT-4V14. NC1184.2 +088100 PERFORM FAIL. NC1184.2 +088200 SIG-WRITE-GF-18. NC1184.2 +088300 MOVE "SIG-TEST-GF-18" TO PAR-NAME. NC1184.2 +088400 PERFORM PRINT-DETAIL. NC1184.2 +088500 SIG-INIT-GF-8. NC1184.2 +088600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +088700 MOVE " COMP VS. DISPLAY" TO FEATURE. NC1184.2 +088800 MOVE A18ONES-DS-TS-18V00 TO WRK-CS-18V00. NC1184.2 +088900 SIG-TEST-GF-8-0. NC1184.2 +089000 ADD A18ONES-DS-TS-18V00 TO WRK-CS-18V00. NC1184.2 +089100 SIG-TEST-GF-8-1. NC1184.2 +089200 IF WRK-CS-18V00 EQUAL TO 222222222222222222 NC1184.2 +089300 PERFORM PASS GO TO SIG-WRITE-GF-8. NC1184.2 +089400 GO TO SIG-FAIL-GF-8. NC1184.2 +089500 SIG-DELETE-GF-8. NC1184.2 +089600 PERFORM DE-LETE. NC1184.2 +089700 GO TO SIG-WRITE-GF-8. NC1184.2 +089800 SIG-FAIL-GF-8. NC1184.2 +089900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1184.2 +090000 MOVE 222222222222222222 TO CORRECT-18V0. NC1184.2 +090100 PERFORM FAIL. NC1184.2 +090200 SIG-WRITE-GF-8. NC1184.2 +090300 MOVE "SIG-TEST-GF-8" TO PAR-NAME. NC1184.2 +090400 PERFORM PRINT-DETAIL. NC1184.2 +090500 SIG-INIT-GF-9. NC1184.2 +090600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +090700 MOVE A18ONES-DS-TS-18V00 TO WRK-DS-T-18V00. NC1184.2 +090800 SIG-TEST-GF-9-0. NC1184.2 +090900 ADD A18ONES-CS-18V00 TO WRK-DS-T-18V00. NC1184.2 +091000 SIG-TEST-GF-9-1. NC1184.2 +091100 IF WRK-DS-T-18V00 EQUAL TO 222222222222222222 NC1184.2 +091200 PERFORM PASS GO TO SIG-WRITE-GF-9. NC1184.2 +091300 GO TO SIG-FAIL-GF-9. NC1184.2 +091400 SIG-DELETE-GF-9. NC1184.2 +091500 PERFORM DE-LETE. NC1184.2 +091600 GO TO SIG-WRITE-GF-9. NC1184.2 +091700 SIG-FAIL-GF-9. NC1184.2 +091800 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1184.2 +091900 MOVE 222222222222222222 TO CORRECT-18V0. NC1184.2 +092000 PERFORM FAIL. NC1184.2 +092100 SIG-WRITE-GF-9. NC1184.2 +092200 MOVE "SIG-TEST-GF-9" TO PAR-NAME. NC1184.2 +092300 PERFORM PRINT-DETAIL. NC1184.2 +092400 SIG-INIT-GF-19. NC1184.2 +092500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +092600 MOVE SPACE TO SIZE-ERR. NC1184.2 +092700 SIG-TEST-GF-19-0. NC1184.2 +092800 ADD MINUS-NAME1 MINUS-NAME2 -34 -1 PLUS-NAME1 NC1184.2 +092900 PLUS-NAME2 EVEN-NAME1 35 GIVING WHOLE-FIELD NC1184.2 +093000 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1184.2 +093100 SIG-TEST-GF-19-1. NC1184.2 +093200 IF WHOLE-FIELD EQUAL TO +1 NC1184.2 +093300 PERFORM PASS NC1184.2 +093400 GO TO SIG-WRITE-GF-19-1. NC1184.2 +093500 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC1184.2 +093600 MOVE +1 TO CORRECT-18V0. NC1184.2 +093700 PERFORM FAIL. NC1184.2 +093800 GO TO SIG-WRITE-GF-19-1. NC1184.2 +093900 SIG-DELETE-GF-19-1. NC1184.2 +094000 PERFORM DE-LETE. NC1184.2 +094100 SIG-WRITE-GF-19-1. NC1184.2 +094200 MOVE "SIG-TEST-GF-19-1" TO PAR-NAME. NC1184.2 +094300 PERFORM PRINT-DETAIL. NC1184.2 +094400 SIG-TEST-GF-19-2. NC1184.2 +094500 IF SIZE-ERR EQUAL TO "1" NC1184.2 +094600 PERFORM FAIL NC1184.2 +094700 MOVE SPACE TO CORRECT-A NC1184.2 +094800 MOVE 1 TO COMPUTED-A NC1184.2 +094900 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1184.2 +095000 GO TO SIG-WRITE-GF-19-2. NC1184.2 +095100 PERFORM PASS. NC1184.2 +095200 GO TO SIG-WRITE-GF-19-2. NC1184.2 +095300 SIG-DELETE-GF-19-2. NC1184.2 +095400 PERFORM DE-LETE. NC1184.2 +095500 SIG-WRITE-GF-19-2. NC1184.2 +095600 MOVE "SIG-TEST-GF-19-2" TO PAR-NAME. NC1184.2 +095700 PERFORM PRINT-DETAIL. NC1184.2 +095800 SIG-INIT-GF-20. NC1184.2 +095900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +096000 MOVE SPACE TO SIZE-ERR. NC1184.2 +096100 MOVE ZERO TO DECMAL-FIELD. NC1184.2 +096200 MOVE -.999999999999999999 TO MINUS-NAME3. NC1184.2 +096300 MOVE -.999999999999999999 TO MINUS-NAME4. NC1184.2 +096400 MOVE +.1 TO EVEN-NAME2. NC1184.2 +096500 MOVE +.999999999999999999 TO PLUS-NAME3. NC1184.2 +096600 MOVE +.999999999999999999 TO PLUS-NAME4. NC1184.2 +096700 SIG-TEST-GF-20-0. NC1184.2 +096800 ADD MINUS-NAME3 MINUS-NAME4 -.34 -.01 PLUS-NAME3 NC1184.2 +096900 PLUS-NAME4 EVEN-NAME2 .35 GIVING DECMAL-FIELD NC1184.2 +097000 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1184.2 +097100 SIG-TEST-GF-20-1. NC1184.2 +097200 IF DECMAL-FIELD EQUAL TO +.1 NC1184.2 +097300 PERFORM PASS NC1184.2 +097400 GO TO SIG-WRITE-GF-20-1. NC1184.2 +097500 MOVE DECMAL-FIELD TO COMPUTED-0V18. NC1184.2 +097600 MOVE +.1 TO CORRECT-0V18. NC1184.2 +097700 PERFORM FAIL. NC1184.2 +097800 GO TO SIG-WRITE-GF-20-1. NC1184.2 +097900 SIG-DELETE-GF-20-1. NC1184.2 +098000 PERFORM DE-LETE. NC1184.2 +098100 SIG-WRITE-GF-20-1. NC1184.2 +098200 MOVE "SIG-TEST-GF-20-1" TO PAR-NAME. NC1184.2 +098300 PERFORM PRINT-DETAIL. NC1184.2 +098400 SIG-TEST-GF-20-2. NC1184.2 +098500 IF SIZE-ERR EQUAL TO "1" NC1184.2 +098600 PERFORM FAIL NC1184.2 +098700 MOVE SPACE TO CORRECT-A NC1184.2 +098800 MOVE 1 TO COMPUTED-A NC1184.2 +098900 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1184.2 +099000 GO TO SIG-WRITE-GF-20-2. NC1184.2 +099100 PERFORM PASS. NC1184.2 +099200 GO TO SIG-WRITE-GF-20-2. NC1184.2 +099300 SIG-DELETE-GF-20-2. NC1184.2 +099400 PERFORM DE-LETE. NC1184.2 +099500 SIG-WRITE-GF-20-2. NC1184.2 +099600 MOVE "SIG-TEST-GF-20-2" TO PAR-NAME. NC1184.2 +099700 PERFORM PRINT-DETAIL. NC1184.2 +099800 SIG-INIT-GF-21. NC1184.2 +099900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +100000 MOVE ZERO TO WRK-CS-18V00. NC1184.2 +100100 SIG-TEST-GF-21-0. NC1184.2 +100200 ADD A18ONES-CS-18V00 A18ONES-DS-TS-18V00 GIVING WRK-CS-18V00.NC1184.2 +100300 SIG-TEST-GF-21-1. NC1184.2 +100400 IF WRK-CS-18V00 EQUAL TO 222222222222222222 NC1184.2 +100500 PERFORM PASS NC1184.2 +100600 GO TO SIG-WRITE-GF-21. NC1184.2 +100700 MOVE 222222222222222222 TO CORRECT-18V0. NC1184.2 +100800 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1184.2 +100900 PERFORM FAIL. NC1184.2 +101000 GO TO SIG-WRITE-GF-21. NC1184.2 +101100 SIG-DELETE-GF-21. NC1184.2 +101200 PERFORM DE-LETE. NC1184.2 +101300 SIG-WRITE-GF-21. NC1184.2 +101400 MOVE "SIG-TEST-GF-21 " TO PAR-NAME. NC1184.2 +101500 PERFORM PRINT-DETAIL. NC1184.2 +101600 SIG-INIT-GF-22. NC1184.2 +101700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1184.2 +101800 MOVE ZERO TO WRK-DS-T-18V00. NC1184.2 +101900 SIG-TEST-GF-22-0. NC1184.2 +102000 ADD A18SIXES-CS-18V00 A12SEVENS-CU-18V00 GIVING NC1184.2 +102100 WRK-DS-T-18V00. NC1184.2 +102200 SIG-TEST-GF-22-1. NC1184.2 +102300 IF WRK-DS-T-18V00 EQUAL TO 666667444444444443 NC1184.2 +102400 PERFORM PASS NC1184.2 +102500 GO TO SIG-WRITE-GF-22. NC1184.2 +102600 MOVE 666667444444444443 TO CORRECT-18V0. NC1184.2 +102700 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1184.2 +102800 PERFORM FAIL. NC1184.2 +102900 GO TO SIG-WRITE-GF-22. NC1184.2 +103000 SIG-DELETE-GF-22. NC1184.2 +103100 PERFORM DE-LETE. NC1184.2 +103200 SIG-WRITE-GF-22. NC1184.2 +103300 MOVE "SIG-TEST-GF-22 " TO PAR-NAME. NC1184.2 +103400 PERFORM PRINT-DETAIL. NC1184.2 +103500 CCVS-EXIT SECTION. NC1184.2 +103600 CCVS-999999. NC1184.2 +103700 GO TO CLOSE-FILES. NC1184.2 diff --git a/tests/cobol85/NC/NC119A.CBL b/tests/cobol85/NC/NC119A.CBL new file mode 100755 index 00000000..b318c613 --- /dev/null +++ b/tests/cobol85/NC/NC119A.CBL @@ -0,0 +1,1176 @@ +000100 IDENTIFICATION DIVISION. NC1194.2 +000200 PROGRAM-ID. NC1194.2 +000300 NC119A. NC1194.2 +000400**************************************************************** NC1194.2 +000500* * NC1194.2 +000600* VALIDATION FOR:- * NC1194.2 +000700* * NC1194.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1194.2 +000900* * NC1194.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1194.2 +001100* * NC1194.2 +001200**************************************************************** NC1194.2 +001300* * NC1194.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1194.2 +001500* * NC1194.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1194.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1194.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1194.2 +001900* * NC1194.2 +002000**************************************************************** NC1194.2 +002100* NC1194.2 +002200* PROGRAM NC119A TESTS THE USE OF THE "SIGN" CLAUSE WITH NC1194.2 +002300* FORMATS 1 AND 2 OF THE SUBTRACT STATEMENT. NC1194.2 +002400* ALL COMBINATIONS OF THE SIGN CLAUSE PHRASES ARE USED NC1194.2 +002500* WITH DATA ITEMS OF VARIOUS LENGTHS. NC1194.2 +002600* NC1194.2 +002700* NC1194.2 +002800 NC1194.2 +002900 ENVIRONMENT DIVISION. NC1194.2 +003000 CONFIGURATION SECTION. NC1194.2 +003100 SOURCE-COMPUTER. NC1194.2 +003200 Linux. NC1194.2 +003300 OBJECT-COMPUTER. NC1194.2 +003400 Linux. NC1194.2 +003500 INPUT-OUTPUT SECTION. NC1194.2 +003600 FILE-CONTROL. NC1194.2 +003700 SELECT PRINT-FILE ASSIGN TO NC1194.2 +003800 "report.log". NC1194.2 +003900 DATA DIVISION. NC1194.2 +004000 FILE SECTION. NC1194.2 +004100 FD PRINT-FILE. NC1194.2 +004200 01 PRINT-REC PICTURE X(120). NC1194.2 +004300 01 DUMMY-RECORD PICTURE X(120). NC1194.2 +004400 WORKING-STORAGE SECTION. NC1194.2 +004500 77 SIZE-ERR PICTURE X VALUE SPACE. NC1194.2 +004600 77 A18TWOS-DS-LS-18V00 PICTURE S9(18) NC1194.2 +004700 SIGN IS LEADING SEPARATE NC1194.2 +004800 VALUE 222222222222222222. NC1194.2 +004900 77 A18ONES-DS-TS-18V00 PICTURE S9(18) NC1194.2 +005000 SIGN IS TRAILING SEPARATE NC1194.2 +005100 VALUE 111111111111111111. NC1194.2 +005200 77 WRK-DS-10V00 PICTURE S9(10) TRAILING. NC1194.2 +005300 77 A10ONES-DS-T-10V00 PICTURE S9(10) NC1194.2 +005400 SIGN TRAILING NC1194.2 +005500 VALUE 1111111111. NC1194.2 +005600 77 A05ONES-DS-L-05V00 PICTURE S9(5) NC1194.2 +005700 SIGN LEADING NC1194.2 +005800 VALUE 11111. NC1194.2 +005900 77 A02ONES-DS-LS-02V00 PICTURE S99 NC1194.2 +006000 LEADING SEPARATE NC1194.2 +006100 VALUE 11. NC1194.2 +006200 77 WRK-DS-09V09 PICTURE S9(9)V9(9) TRAILING. NC1194.2 +006300 77 WRK-DS-T-18V00 REDEFINES WRK-DS-09V09 NC1194.2 +006400 PICTURE S9(18) TRAILING. NC1194.2 +006500 77 A06THREES-DS-03V03 PICTURE S999V999 NC1194.2 +006600 VALUE 333.333. NC1194.2 +006700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1194.2 +006800 VALUE 333333.333333. NC1194.2 +006900 77 WRK-DS-TS-06V06 PICTURE S9(6)V9(6) NC1194.2 +007000 SIGN IS TRAILING SEPARATE CHARACTER. NC1194.2 +007100 77 WRK-DS-TS-12V00-S REDEFINES WRK-DS-TS-06V06 NC1194.2 +007200 TRAILING SEPARATE NC1194.2 +007300 PICTURE S9(12). NC1194.2 +007400 77 A05ONES-DS-LS-00V05 PICTURE SV9(5) NC1194.2 +007500 LEADING SEPARATE NC1194.2 +007600 VALUE .11111. NC1194.2 +007700 77 WRK-DS-T-05V00 PICTURE S9(5) TRAILING. NC1194.2 +007800 77 WRK-DS-02V00 PICTURE S99. NC1194.2 +007900 77 A12ONES-DS-L-12V00 PICTURE S9(12) NC1194.2 +008000 USAGE IS DISPLAY SIGN IS LEADING NC1194.2 +008100 VALUE 111111111111. NC1194.2 +008200 77 WRK-DS-03V10 PICTURE S999V9(10). NC1194.2 +008300 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1194.2 +008400 PICTURE S9(13). NC1194.2 +008500 77 A99-DS-T-02V00 PICTURE S99 NC1194.2 +008600 USAGE IS DISPLAY SIGN IS TRAILING NC1194.2 +008700 VALUE 99. NC1194.2 +008800 77 A03ONES-DS-02V01 PICTURE S99V9 NC1194.2 +008900 VALUE 11.1. NC1194.2 +009000 77 A06ONES-DS-TS-03V03 PICTURE S999V999 NC1194.2 +009100 USAGE IS DISPLAY TRAILING SEPARATE NC1194.2 +009200 VALUE 111.111. NC1194.2 +009300 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1194.2 +009400 VALUE 22.222222. NC1194.2 +009500 77 A01ONES-DS-LS-P0801 PICTURE SP(8)9 NC1194.2 +009600 SIGN IS LEADING SEPARATE NC1194.2 +009700 VALUE .000000001. NC1194.2 +009800 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1194.2 +009900 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1194.2 +010000 VALUE 111111111111111111. NC1194.2 +010100 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1194.2 +010200 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1194.2 +010300 VALUE 99. NC1194.2 +010400 77 WRK-DS-TS-0201P PICTURE S99P TRAILING SEPARATE. NC1194.2 +010500 77 WRK-DS-06V00 PICTURE S9(6). NC1194.2 +010600 77 AZERO-DS-LS-05V05 PICTURE S9(5)V9(5) NC1194.2 +010700 SIGN IS LEADING SEPARATE USAGE DISPLAY NC1194.2 +010800 VALUE ZERO. NC1194.2 +010900 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1194.2 +011000 VALUE +012345678.876543210. NC1194.2 +011100 77 XDATA-XN-00018 PICTURE X(18) NC1194.2 +011200 VALUE "00ABCDEFGHI 4321 ". NC1194.2 +011300 77 WRK-XN-00018 PICTURE X(18). NC1194.2 +011400 77 ADD-12 PICTURE PP9 VALUE .001. NC1194.2 +011500 77 ADD-13 PICTURE 9PP VALUE 100. NC1194.2 +011600 77 ADD-14 PICTURE 999V999. NC1194.2 +011700 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1194.2 +011800 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1194.2 +011900 COMPUTATIONAL. NC1194.2 +012000 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1194.2 +012100 COMPUTATIONAL. NC1194.2 +012200 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1194.2 +012300 COMPUTATIONAL. NC1194.2 +012400 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1194.2 +012500 COMPUTATIONAL. NC1194.2 +012600 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1194.2 +012700 COMPUTATIONAL. NC1194.2 +012800 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1194.2 +012900 COMPUTATIONAL. NC1194.2 +013000 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1194.2 +013100 COMPUTATIONAL. NC1194.2 +013200 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1194.2 +013300 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1194.2 +013400 COMPUTATIONAL. NC1194.2 +013500 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1194.2 +013600 01 SUBTRACT-DATA SIGN IS LEADING SEPARATE DISPLAY. NC1194.2 +013700 02 SUBTR-1 PICTURE 9 VALUE 1. NC1194.2 +013800 02 SUBTR-2 PICTURE S99 VALUE 99. NC1194.2 +013900 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1194.2 +014000 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1194.2 +014100 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1194.2 +014200 02 SUBTR-6 PICTURE 9 VALUE 1. NC1194.2 +014300 02 SUBTR-7 PICTURE S99 VALUE 99. NC1194.2 +014400 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1194.2 +014500 02 SUBTR-10 PICTURE S999 VALUE 100. NC1194.2 +014600 02 SUBTR-11 PICTURE S999V999. NC1194.2 +014700 01 N-3 PICTURE IS 99999. NC1194.2 +014800 01 N-4 PICTURE IS 9(5) NC1194.2 +014900 VALUE IS 52800. NC1194.2 +015000 01 N-5 PICTURE IS S9(9)V99 NC1194.2 +015100 SIGN IS LEADING SEPARATE NC1194.2 +015200 VALUE IS 000000001.00. NC1194.2 +015300 01 N-7 PICTURE IS S9(7)V9(4) NC1194.2 +015400 SIGN IS LEADING SEPARATE CHARACTER NC1194.2 +015500 VALUE IS 0000001.0000. NC1194.2 +015600 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1194.2 +015700 01 N-10 PICTURE IS S99999V NC1194.2 +015800 VALUE IS -00001. NC1194.2 +015900 01 N-11 PICTURE IS 9 VALUE IS 9. NC1194.2 +016000 01 N-12 PICTURE IS 9 VALUE IS 9. NC1194.2 +016100 01 N-13 PICTURE IS 9(5) NC1194.2 +016200 VALUE IS 99999. NC1194.2 +016300 01 N-14 PICTURE IS 9 VALUE IS 1. NC1194.2 +016400 01 N-15 PICTURE IS 9(16). NC1194.2 +016500 01 N-16 PICTURE IS S999999V99 NC1194.2 +016600 VALUE IS 5.90. NC1194.2 +016700 01 N-17 PICTURE IS S9(3)V99 NC1194.2 +016800 VALUE IS +3.6. NC1194.2 +016900 01 N-18 PICTURE IS S9(10) NC1194.2 +017000 VALUE IS -5. NC1194.2 +017100 01 N-19 PICTURE IS $9.00. NC1194.2 +017200 01 N-20 PICTURE IS S9(9) NC1194.2 +017300 VALUE IS -999999999. NC1194.2 +017400 01 N-21 PICTURE IS 9 VALUE IS 5. NC1194.2 +017500 01 N-22 PICTURE IS 999V99 NC1194.2 +017600 VALUE IS 005.55. NC1194.2 +017700 01 N-23 PICTURE IS $$$.99CR. NC1194.2 +017800 01 N-25 PICTURE IS 9 VALUE IS 1. NC1194.2 +017900 01 N-26 PICTURE 9(5). NC1194.2 +018000 01 N-27 PICTURE IS 9999V9 NC1194.2 +018100 VALUE IS 9999.9. NC1194.2 +018200 01 N-28 PICTURE IS $9999.00. NC1194.2 +018300 01 N-40 PICTURE IS 9(7) NC1194.2 +018400 VALUE IS 7777777. NC1194.2 +018500 01 N-41 PICTURE IS 9(7) NC1194.2 +018600 VALUE IS 1111111. NC1194.2 +018700 01 N-42 PICTURE IS 9(3)P(4). NC1194.2 +018800 01 TRUNC-DATA. NC1194.2 +018900 02 N-43 PICTURE S9V9 VALUE +1.6. NC1194.2 +019000 02 N-44 PICTURE S9V9 VALUE -1.6. NC1194.2 +019100 02 N-45 PICTURE S9. NC1194.2 +019200 01 MINUS-NAMES SIGN IS LEADING SEPARATE CHARACTER. NC1194.2 +019300 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1194.2 +019400 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1194.2 +019500 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1194.2 +019600 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1194.2 +019700 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1194.2 +019800 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1194.2 +019900 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1194.2 +020000 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1194.2 +020100 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1194.2 +020200 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1194.2 +020300 02 WHOLE-FIELD PICTURE S9(18). NC1194.2 +020400 02 DECMAL-FIELD PICTURE SV9(18). NC1194.2 +020500 01 TEST-RESULTS. NC1194.2 +020600 02 FILLER PIC X VALUE SPACE. NC1194.2 +020700 02 FEATURE PIC X(20) VALUE SPACE. NC1194.2 +020800 02 FILLER PIC X VALUE SPACE. NC1194.2 +020900 02 P-OR-F PIC X(5) VALUE SPACE. NC1194.2 +021000 02 FILLER PIC X VALUE SPACE. NC1194.2 +021100 02 PAR-NAME. NC1194.2 +021200 03 FILLER PIC X(19) VALUE SPACE. NC1194.2 +021300 03 PARDOT-X PIC X VALUE SPACE. NC1194.2 +021400 03 DOTVALUE PIC 99 VALUE ZERO. NC1194.2 +021500 02 FILLER PIC X(8) VALUE SPACE. NC1194.2 +021600 02 RE-MARK PIC X(61). NC1194.2 +021700 01 TEST-COMPUTED. NC1194.2 +021800 02 FILLER PIC X(30) VALUE SPACE. NC1194.2 +021900 02 FILLER PIC X(17) VALUE NC1194.2 +022000 " COMPUTED=". NC1194.2 +022100 02 COMPUTED-X. NC1194.2 +022200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1194.2 +022300 03 COMPUTED-N REDEFINES COMPUTED-A NC1194.2 +022400 PIC -9(9).9(9). NC1194.2 +022500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1194.2 +022600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1194.2 +022700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1194.2 +022800 03 CM-18V0 REDEFINES COMPUTED-A. NC1194.2 +022900 04 COMPUTED-18V0 PIC -9(18). NC1194.2 +023000 04 FILLER PIC X. NC1194.2 +023100 03 FILLER PIC X(50) VALUE SPACE. NC1194.2 +023200 01 TEST-CORRECT. NC1194.2 +023300 02 FILLER PIC X(30) VALUE SPACE. NC1194.2 +023400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1194.2 +023500 02 CORRECT-X. NC1194.2 +023600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1194.2 +023700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1194.2 +023800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1194.2 +023900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1194.2 +024000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1194.2 +024100 03 CR-18V0 REDEFINES CORRECT-A. NC1194.2 +024200 04 CORRECT-18V0 PIC -9(18). NC1194.2 +024300 04 FILLER PIC X. NC1194.2 +024400 03 FILLER PIC X(2) VALUE SPACE. NC1194.2 +024500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1194.2 +024600 01 CCVS-C-1. NC1194.2 +024700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1194.2 +024800- "SS PARAGRAPH-NAME NC1194.2 +024900- " REMARKS". NC1194.2 +025000 02 FILLER PIC X(20) VALUE SPACE. NC1194.2 +025100 01 CCVS-C-2. NC1194.2 +025200 02 FILLER PIC X VALUE SPACE. NC1194.2 +025300 02 FILLER PIC X(6) VALUE "TESTED". NC1194.2 +025400 02 FILLER PIC X(15) VALUE SPACE. NC1194.2 +025500 02 FILLER PIC X(4) VALUE "FAIL". NC1194.2 +025600 02 FILLER PIC X(94) VALUE SPACE. NC1194.2 +025700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1194.2 +025800 01 REC-CT PIC 99 VALUE ZERO. NC1194.2 +025900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1194.2 +026000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1194.2 +026100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1194.2 +026200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1194.2 +026300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1194.2 +026400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1194.2 +026500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1194.2 +026600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1194.2 +026700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1194.2 +026800 01 CCVS-H-1. NC1194.2 +026900 02 FILLER PIC X(39) VALUE SPACES. NC1194.2 +027000 02 FILLER PIC X(42) VALUE NC1194.2 +027100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1194.2 +027200 02 FILLER PIC X(39) VALUE SPACES. NC1194.2 +027300 01 CCVS-H-2A. NC1194.2 +027400 02 FILLER PIC X(40) VALUE SPACE. NC1194.2 +027500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1194.2 +027600 02 FILLER PIC XXXX VALUE NC1194.2 +027700 "4.2 ". NC1194.2 +027800 02 FILLER PIC X(28) VALUE NC1194.2 +027900 " COPY - NOT FOR DISTRIBUTION". NC1194.2 +028000 02 FILLER PIC X(41) VALUE SPACE. NC1194.2 +028100 NC1194.2 +028200 01 CCVS-H-2B. NC1194.2 +028300 02 FILLER PIC X(15) VALUE NC1194.2 +028400 "TEST RESULT OF ". NC1194.2 +028500 02 TEST-ID PIC X(9). NC1194.2 +028600 02 FILLER PIC X(4) VALUE NC1194.2 +028700 " IN ". NC1194.2 +028800 02 FILLER PIC X(12) VALUE NC1194.2 +028900 " HIGH ". NC1194.2 +029000 02 FILLER PIC X(22) VALUE NC1194.2 +029100 " LEVEL VALIDATION FOR ". NC1194.2 +029200 02 FILLER PIC X(58) VALUE NC1194.2 +029300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1194.2 +029400 01 CCVS-H-3. NC1194.2 +029500 02 FILLER PIC X(34) VALUE NC1194.2 +029600 " FOR OFFICIAL USE ONLY ". NC1194.2 +029700 02 FILLER PIC X(58) VALUE NC1194.2 +029800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1194.2 +029900 02 FILLER PIC X(28) VALUE NC1194.2 +030000 " COPYRIGHT 1985 ". NC1194.2 +030100 01 CCVS-E-1. NC1194.2 +030200 02 FILLER PIC X(52) VALUE SPACE. NC1194.2 +030300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1194.2 +030400 02 ID-AGAIN PIC X(9). NC1194.2 +030500 02 FILLER PIC X(45) VALUE SPACES. NC1194.2 +030600 01 CCVS-E-2. NC1194.2 +030700 02 FILLER PIC X(31) VALUE SPACE. NC1194.2 +030800 02 FILLER PIC X(21) VALUE SPACE. NC1194.2 +030900 02 CCVS-E-2-2. NC1194.2 +031000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1194.2 +031100 03 FILLER PIC X VALUE SPACE. NC1194.2 +031200 03 ENDER-DESC PIC X(44) VALUE NC1194.2 +031300 "ERRORS ENCOUNTERED". NC1194.2 +031400 01 CCVS-E-3. NC1194.2 +031500 02 FILLER PIC X(22) VALUE NC1194.2 +031600 " FOR OFFICIAL USE ONLY". NC1194.2 +031700 02 FILLER PIC X(12) VALUE SPACE. NC1194.2 +031800 02 FILLER PIC X(58) VALUE NC1194.2 +031900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1194.2 +032000 02 FILLER PIC X(13) VALUE SPACE. NC1194.2 +032100 02 FILLER PIC X(15) VALUE NC1194.2 +032200 " COPYRIGHT 1985". NC1194.2 +032300 01 CCVS-E-4. NC1194.2 +032400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1194.2 +032500 02 FILLER PIC X(4) VALUE " OF ". NC1194.2 +032600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1194.2 +032700 02 FILLER PIC X(40) VALUE NC1194.2 +032800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1194.2 +032900 01 XXINFO. NC1194.2 +033000 02 FILLER PIC X(19) VALUE NC1194.2 +033100 "*** INFORMATION ***". NC1194.2 +033200 02 INFO-TEXT. NC1194.2 +033300 04 FILLER PIC X(8) VALUE SPACE. NC1194.2 +033400 04 XXCOMPUTED PIC X(20). NC1194.2 +033500 04 FILLER PIC X(5) VALUE SPACE. NC1194.2 +033600 04 XXCORRECT PIC X(20). NC1194.2 +033700 02 INF-ANSI-REFERENCE PIC X(48). NC1194.2 +033800 01 HYPHEN-LINE. NC1194.2 +033900 02 FILLER PIC IS X VALUE IS SPACE. NC1194.2 +034000 02 FILLER PIC IS X(65) VALUE IS "************************NC1194.2 +034100- "*****************************************". NC1194.2 +034200 02 FILLER PIC IS X(54) VALUE IS "************************NC1194.2 +034300- "******************************". NC1194.2 +034400 01 CCVS-PGM-ID PIC X(9) VALUE NC1194.2 +034500 "NC119A". NC1194.2 +034600 PROCEDURE DIVISION. NC1194.2 +034700 CCVS1 SECTION. NC1194.2 +034800 OPEN-FILES. NC1194.2 +034900 OPEN OUTPUT PRINT-FILE. NC1194.2 +035000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1194.2 +035100 MOVE SPACE TO TEST-RESULTS. NC1194.2 +035200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1194.2 +035300 GO TO CCVS1-EXIT. NC1194.2 +035400 CLOSE-FILES. NC1194.2 +035500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1194.2 +035600 TERMINATE-CCVS. NC1194.2 +035700*S EXIT PROGRAM. NC1194.2 +035800*SERMINATE-CALL. NC1194.2 +035900 STOP RUN. NC1194.2 +036000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1194.2 +036100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1194.2 +036200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1194.2 +036300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1194.2 +036400 MOVE "****TEST DELETED****" TO RE-MARK. NC1194.2 +036500 PRINT-DETAIL. NC1194.2 +036600 IF REC-CT NOT EQUAL TO ZERO NC1194.2 +036700 MOVE "." TO PARDOT-X NC1194.2 +036800 MOVE REC-CT TO DOTVALUE. NC1194.2 +036900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1194.2 +037000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1194.2 +037100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1194.2 +037200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1194.2 +037300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1194.2 +037400 MOVE SPACE TO CORRECT-X. NC1194.2 +037500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1194.2 +037600 MOVE SPACE TO RE-MARK. NC1194.2 +037700 HEAD-ROUTINE. NC1194.2 +037800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +037900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +038000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1194.2 +038100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1194.2 +038200 COLUMN-NAMES-ROUTINE. NC1194.2 +038300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +038400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +038500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +038600 END-ROUTINE. NC1194.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1194.2 +038800 END-RTN-EXIT. NC1194.2 +038900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +039000 END-ROUTINE-1. NC1194.2 +039100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1194.2 +039200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1194.2 +039300 ADD PASS-COUNTER TO ERROR-HOLD. NC1194.2 +039400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1194.2 +039500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1194.2 +039600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1194.2 +039700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1194.2 +039800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1194.2 +039900 END-ROUTINE-12. NC1194.2 +040000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1194.2 +040100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1194.2 +040200 MOVE "NO " TO ERROR-TOTAL NC1194.2 +040300 ELSE NC1194.2 +040400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1194.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1194.2 +040600 PERFORM WRITE-LINE. NC1194.2 +040700 END-ROUTINE-13. NC1194.2 +040800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1194.2 +040900 MOVE "NO " TO ERROR-TOTAL ELSE NC1194.2 +041000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1194.2 +041100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1194.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +041300 IF INSPECT-COUNTER EQUAL TO ZERO NC1194.2 +041400 MOVE "NO " TO ERROR-TOTAL NC1194.2 +041500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1194.2 +041600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1194.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +041800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1194.2 +041900 WRITE-LINE. NC1194.2 +042000 ADD 1 TO RECORD-COUNT. NC1194.2 +042100 IF RECORD-COUNT GREATER 42 NC1194.2 +042200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1194.2 +042300 MOVE SPACE TO DUMMY-RECORD NC1194.2 +042400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1194.2 +042500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1194.2 +042600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1194.2 +042700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1194.2 +042800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1194.2 +042900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1194.2 +043000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1194.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1194.2 +043200 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1194.2 +043300 MOVE ZERO TO RECORD-COUNT. NC1194.2 +043400 PERFORM WRT-LN. NC1194.2 +043500 WRT-LN. NC1194.2 +043600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1194.2 +043700 MOVE SPACE TO DUMMY-RECORD. NC1194.2 +043800 BLANK-LINE-PRINT. NC1194.2 +043900 PERFORM WRT-LN. NC1194.2 +044000 FAIL-ROUTINE. NC1194.2 +044100 IF COMPUTED-X NOT EQUAL TO SPACE NC1194.2 +044200 GO TO FAIL-ROUTINE-WRITE. NC1194.2 +044300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1194.2 +044400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1194.2 +044500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1194.2 +044600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +044700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1194.2 +044800 GO TO FAIL-ROUTINE-EX. NC1194.2 +044900 FAIL-ROUTINE-WRITE. NC1194.2 +045000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1194.2 +045100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1194.2 +045200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1194.2 +045300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1194.2 +045400 FAIL-ROUTINE-EX. EXIT. NC1194.2 +045500 BAIL-OUT. NC1194.2 +045600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1194.2 +045700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1194.2 +045800 BAIL-OUT-WRITE. NC1194.2 +045900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1194.2 +046000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1194.2 +046100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1194.2 +046200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1194.2 +046300 BAIL-OUT-EX. EXIT. NC1194.2 +046400 CCVS1-EXIT. NC1194.2 +046500 EXIT. NC1194.2 +046600 SECT-NC119A-001 SECTION. NC1194.2 +046700 SUB-INIT-GF-1. NC1194.2 +046800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +046900 PERFORM END-ROUTINE. NC1194.2 +047000 MOVE "SUBTRACT" TO FEATURE. NC1194.2 +047100 MOVE 1 TO N-5. NC1194.2 +047200 SUB-TEST-GF-1-0. NC1194.2 +047300 SUBTRACT 1 FROM N-5. NC1194.2 +047400 SUB-TEST-GF-1-1. NC1194.2 +047500 IF N-5 EQUAL TO 0 NC1194.2 +047600 PERFORM PASS NC1194.2 +047700 GO TO SUB-WRITE-GF-1. NC1194.2 +047800 GO TO SUB-FAIL-GF-1. NC1194.2 +047900 SUB-DELETE-GF-1. NC1194.2 +048000 PERFORM DE-LETE. NC1194.2 +048100 GO TO SUB-WRITE-GF-1. NC1194.2 +048200 SUB-FAIL-GF-1. NC1194.2 +048300 MOVE N-5 TO COMPUTED-N. NC1194.2 +048400 MOVE 0 TO CORRECT-N. NC1194.2 +048500 PERFORM FAIL. NC1194.2 +048600 SUB-WRITE-GF-1. NC1194.2 +048700 MOVE "SUB-TEST-GF-1 " TO PAR-NAME. NC1194.2 +048800 PERFORM PRINT-DETAIL. NC1194.2 +048900 SUB-INIT-GF-2. NC1194.2 +049000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +049100 MOVE A18TWOS-DS-LS-18V00 TO WRK-DS-T-18V00. NC1194.2 +049200 SUB-TEST-GF-2-0. NC1194.2 +049300 SUBTRACT A18ONES-DS-TS-18V00 FROM WRK-DS-T-18V00. NC1194.2 +049400 SUB-TEST-GF-2-1. NC1194.2 +049500 IF WRK-DS-T-18V00 EQUAL TO 111111111111111111 NC1194.2 +049600 PERFORM PASS GO TO SUB-WRITE-GF-2. NC1194.2 +049700 GO TO SUB-FAIL-GF-2. NC1194.2 +049800 SUB-DELETE-GF-2. NC1194.2 +049900 PERFORM DE-LETE. NC1194.2 +050000 GO TO SUB-WRITE-GF-2. NC1194.2 +050100 SUB-FAIL-GF-2. NC1194.2 +050200 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1194.2 +050300 MOVE 111111111111111111 TO CORRECT-18V0. NC1194.2 +050400 PERFORM FAIL. NC1194.2 +050500 SUB-WRITE-GF-2. NC1194.2 +050600 MOVE "SUB-TEST-GF-2" TO PAR-NAME. NC1194.2 +050700 PERFORM PRINT-DETAIL. NC1194.2 +050800 SUB-INIT-GF-3. NC1194.2 +050900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +051000 MOVE A12THREES-DS-06V06 TO WRK-DS-TS-06V06. NC1194.2 +051100 SUB-TEST-GF-3-0. NC1194.2 +051200 SUBTRACT A05ONES-DS-L-05V00 NC1194.2 +051300 A05ONES-DS-LS-00V05 NC1194.2 +051400 A06ONES-DS-TS-03V03 FROM WRK-DS-TS-06V06. NC1194.2 +051500 SUB-TEST-GF-3-1. NC1194.2 +051600 IF WRK-DS-TS-06V06 EQUAL TO 322111.111223 NC1194.2 +051700 PERFORM PASS GO TO SUB-WRITE-GF-3. NC1194.2 +051800 GO TO SUB-FAIL-GF-3. NC1194.2 +051900 SUB-DELETE-GF-3. NC1194.2 +052000 PERFORM DE-LETE. NC1194.2 +052100 GO TO SUB-WRITE-GF-3. NC1194.2 +052200 SUB-FAIL-GF-3. NC1194.2 +052300 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +052400 MOVE 322111.111223 TO CORRECT-N. NC1194.2 +052500 PERFORM FAIL. NC1194.2 +052600 SUB-WRITE-GF-3. NC1194.2 +052700 MOVE "SUB-TEST-GF-3" TO PAR-NAME. NC1194.2 +052800 PERFORM PRINT-DETAIL. NC1194.2 +052900 SUB-INIT-GF-13. NC1194.2 +053000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +053100 MOVE " GIVING" TO FEATURE. NC1194.2 +053200 MOVE ZERO TO WRK-DS-09V09. NC1194.2 +053300 SUB-TEST-GF-13-0. NC1194.2 +053400 SUBTRACT A06THREES-DS-03V03 FROM A12THREES-DS-06V06 NC1194.2 +053500 GIVING WRK-DS-TS-06V06. NC1194.2 +053600 SUB-TEST-GF-13-1. NC1194.2 +053700 IF WRK-DS-TS-06V06 EQUAL TO 333000.000333 NC1194.2 +053800 PERFORM PASS GO TO SUB-WRITE-GF-13. NC1194.2 +053900 GO TO SUB-FAIL-GF-13. NC1194.2 +054000 SUB-DELETE-GF-13. NC1194.2 +054100 PERFORM DE-LETE. NC1194.2 +054200 GO TO SUB-WRITE-GF-13. NC1194.2 +054300 SUB-FAIL-GF-13. NC1194.2 +054400 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +054500 MOVE 333000.000333 TO CORRECT-N. NC1194.2 +054600 PERFORM FAIL. NC1194.2 +054700 SUB-WRITE-GF-13. NC1194.2 +054800 MOVE "SUB-TEST-GF-13" TO PAR-NAME. NC1194.2 +054900 PERFORM PRINT-DETAIL. NC1194.2 +055000 SUB-INIT-GF-14. NC1194.2 +055100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +055200 MOVE ZERO TO WRK-DS-TS-06V06. NC1194.2 +055300 SUB-TEST-GF-14. NC1194.2 +055400 SUBTRACT A05ONES-DS-L-05V00 NC1194.2 +055500 A05ONES-DS-LS-00V05 NC1194.2 +055600 A12THREES-DS-06V06 NC1194.2 +055700 A06THREES-DS-03V03 FROM ZERO GIVING WRK-DS-TS-06V06.NC1194.2 +055800 IF WRK-DS-TS-06V06 EQUAL TO -344777.777443 NC1194.2 +055900 PERFORM PASS GO TO SUB-WRITE-GF-14. NC1194.2 +056000 GO TO SUB-FAIL-GF-14. NC1194.2 +056100 SUB-DELETE-GF-14. NC1194.2 +056200 PERFORM DE-LETE. NC1194.2 +056300 GO TO SUB-WRITE-GF-14. NC1194.2 +056400 SUB-FAIL-GF-14. NC1194.2 +056500 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +056600 MOVE -344777.777443 TO CORRECT-N. NC1194.2 +056700 PERFORM FAIL. NC1194.2 +056800 SUB-WRITE-GF-14. NC1194.2 +056900 MOVE "SUB-TEST-GF-14" TO PAR-NAME. NC1194.2 +057000 PERFORM PRINT-DETAIL. NC1194.2 +057100 SUB-INIT-GF-4. NC1194.2 +057200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +057300 MOVE " ROUNDED" TO FEATURE. NC1194.2 +057400 MOVE ZERO TO WRK-DS-TS-0201P. NC1194.2 +057500 SUB-TEST-GF-4-0. NC1194.2 +057600 SUBTRACT A99-DS-T-02V00 FROM WRK-DS-TS-0201P ROUNDED. NC1194.2 +057700 SUB-TEST-GF-4-1. NC1194.2 +057800 IF WRK-DS-TS-0201P EQUAL TO -100 NC1194.2 +057900 PERFORM PASS GO TO SUB-WRITE-GF-4. NC1194.2 +058000 GO TO SUB-FAIL-GF-4. NC1194.2 +058100 SUB-DELETE-GF-4. NC1194.2 +058200 PERFORM DE-LETE. NC1194.2 +058300 GO TO SUB-WRITE-GF-4. NC1194.2 +058400 SUB-FAIL-GF-4. NC1194.2 +058500 MOVE WRK-DS-TS-0201P TO COMPUTED-N. NC1194.2 +058600 MOVE -100 TO CORRECT-N. NC1194.2 +058700 PERFORM FAIL. NC1194.2 +058800 SUB-WRITE-GF-4. NC1194.2 +058900 MOVE "SUB-TEST-GF-4" TO PAR-NAME. NC1194.2 +059000 PERFORM PRINT-DETAIL. NC1194.2 +059100 SUB-INIT-GF-15. NC1194.2 +059200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +059300 MOVE -099999.999999 TO WRK-DS-TS-06V06. NC1194.2 +059400 MOVE ZERO TO WRK-DS-06V00. NC1194.2 +059500 SUB-TEST-GF-15-0. NC1194.2 +059600 SUBTRACT A05ONES-DS-L-05V00 NC1194.2 +059700 -11111 NC1194.2 +059800 AZERO-DS-LS-05V05 FROM WRK-DS-TS-06V06 NC1194.2 +059900 GIVING WRK-DS-06V00 ROUNDED. NC1194.2 +060000 SUB-TEST-GF-15-1. NC1194.2 +060100 IF WRK-DS-06V00 EQUAL TO -100000 NC1194.2 +060200 PERFORM PASS GO TO SUB-WRITE-GF-15. NC1194.2 +060300 GO TO SUB-FAIL-GF-15. NC1194.2 +060400 SUB-DELETE-GF-15. NC1194.2 +060500 PERFORM DE-LETE. NC1194.2 +060600 GO TO SUB-WRITE-GF-15. NC1194.2 +060700 SUB-FAIL-GF-15. NC1194.2 +060800 MOVE WRK-DS-06V00 TO COMPUTED-N. NC1194.2 +060900 MOVE -100000 TO CORRECT-N. NC1194.2 +061000 PERFORM FAIL. NC1194.2 +061100 SUB-WRITE-GF-15. NC1194.2 +061200 MOVE "SUB-TEST-GF-15" TO PAR-NAME. NC1194.2 +061300 PERFORM PRINT-DETAIL. NC1194.2 +061400 SUB-INIT-GF-5-1. NC1194.2 +061500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +061600 MOVE " SIZE ERROR" TO FEATURE. NC1194.2 +061700 MOVE -11 TO WRK-DS-02V00. NC1194.2 +061800 SUB-TEST-GF-5-1-0. NC1194.2 +061900 SUBTRACT A99-DS-T-02V00 FROM WRK-DS-02V00 ON SIZE ERROR NC1194.2 +062000 PERFORM PASS GO TO SUB-WRITE-GF-5-1. NC1194.2 +062100 GO TO SUB-FAIL-GF-5-1. NC1194.2 +062200 SUB-DELETE-GF-5-1. NC1194.2 +062300 PERFORM DE-LETE. NC1194.2 +062400 GO TO SUB-WRITE-GF-5-1. NC1194.2 +062500 SUB-FAIL-GF-5-1. NC1194.2 +062600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +062700 PERFORM FAIL. NC1194.2 +062800 SUB-WRITE-GF-5-1. NC1194.2 +062900 MOVE "SUB-TEST-GF-5-1" TO PAR-NAME. NC1194.2 +063000 PERFORM PRINT-DETAIL. NC1194.2 +063100 SUB-TEST-GF-5-2. NC1194.2 +063200 IF WRK-DS-02V00 EQUAL TO -11 NC1194.2 +063300 PERFORM PASS GO TO SUB-WRITE-GF-5-2. NC1194.2 +063400* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-5-1 NC1194.2 +063500 GO TO SUB-FAIL-GF-5-2. NC1194.2 +063600 SUB-DELETE-GF-5-2. NC1194.2 +063700 PERFORM DE-LETE. NC1194.2 +063800 GO TO SUB-WRITE-GF-5-2. NC1194.2 +063900 SUB-FAIL-GF-5-2. NC1194.2 +064000 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1194.2 +064100 MOVE -11 TO CORRECT-N. NC1194.2 +064200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +064300 PERFORM FAIL. NC1194.2 +064400 SUB-WRITE-GF-5-2. NC1194.2 +064500 MOVE "SUB-TEST-GF-5-2" TO PAR-NAME. NC1194.2 +064600 PERFORM PRINT-DETAIL. NC1194.2 +064700 SUB-INIT-GF-16-1. NC1194.2 +064800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +064900 MOVE ZERO TO WRK-DS-10V00. NC1194.2 +065000 SUB-TEST-GF-16-1-0. NC1194.2 +065100 SUBTRACT A12ONES-DS-L-12V00 NC1194.2 +065200 FROM ZERO GIVING WRK-DS-10V00 ON SIZE ERROR NC1194.2 +065300 PERFORM PASS GO TO SUB-WRITE-GF-16-1. NC1194.2 +065400 GO TO SUB-FAIL-GF-16-1. NC1194.2 +065500 SUB-DELETE-GF-16-1. NC1194.2 +065600 PERFORM DE-LETE. NC1194.2 +065700 GO TO SUB-WRITE-GF-16-1. NC1194.2 +065800 SUB-FAIL-GF-16-1. NC1194.2 +065900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +066000 PERFORM FAIL. NC1194.2 +066100 SUB-WRITE-GF-16-1. NC1194.2 +066200 MOVE "SUB-TEST-GF-16-1" TO PAR-NAME. NC1194.2 +066300 PERFORM PRINT-DETAIL. NC1194.2 +066400 SUB-TEST-GF-16-2. NC1194.2 +066500 IF WRK-DS-10V00 EQUAL TO ZERO NC1194.2 +066600 PERFORM PASS GO TO SUB-WRITE-GF-16-2. NC1194.2 +066700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-GF-16-1 NC1194.2 +066800 GO TO SUB-FAIL-GF-16-2. NC1194.2 +066900 SUB-DELETE-GF-16-2. NC1194.2 +067000 PERFORM DE-LETE. NC1194.2 +067100 GO TO SUB-WRITE-GF-16-2. NC1194.2 +067200 SUB-FAIL-GF-16-2. NC1194.2 +067300 MOVE WRK-DS-10V00 TO COMPUTED-14V4. NC1194.2 +067400 MOVE ZERO TO CORRECT-14V4. NC1194.2 +067500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +067600 PERFORM FAIL. NC1194.2 +067700 SUB-WRITE-GF-16-2. NC1194.2 +067800 MOVE "SUB-TEST-GF-16-2" TO PAR-NAME. NC1194.2 +067900 PERFORM PRINT-DETAIL. NC1194.2 +068000 SUB-INIT-GF-17-1. NC1194.2 +068100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +068200 MOVE " ROUNDED,SIZE ERROR" TO FEATURE. NC1194.2 +068300 MOVE ZERO TO WRK-DS-T-05V00. NC1194.2 +068400 SUB-TEST-GF-17-1-0. NC1194.2 +068500 SUBTRACT 33333 NC1194.2 +068600 A06THREES-DS-03V03 NC1194.2 +068700 A12THREES-DS-06V06 NC1194.2 +068800 FROM WRK-DS-T-05V00 ROUNDED ON SIZE ERROR NC1194.2 +068900 PERFORM PASS GO TO SUB-WRITE-GF-17-1. NC1194.2 +069000 GO TO SUB-FAIL-GF-17-1. NC1194.2 +069100 SUB-DELETE-GF-17-1. NC1194.2 +069200 PERFORM DE-LETE. NC1194.2 +069300 GO TO SUB-WRITE-GF-17-1. NC1194.2 +069400 SUB-FAIL-GF-17-1. NC1194.2 +069500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +069600 PERFORM FAIL. NC1194.2 +069700 SUB-WRITE-GF-17-1. NC1194.2 +069800 MOVE "SUB-TEST-GF-17-1" TO PAR-NAME. NC1194.2 +069900 PERFORM PRINT-DETAIL. NC1194.2 +070000 SUB-TEST-GF-17-2. NC1194.2 +070100 IF WRK-DS-T-05V00 EQUAL TO ZERO NC1194.2 +070200 PERFORM PASS GO TO SUB-WRITE-GF-17-2. NC1194.2 +070300* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-17-1 NC1194.2 +070400 GO TO SUB-FAIL-GF-17-2. NC1194.2 +070500 SUB-DELETE-GF-17-2. NC1194.2 +070600 PERFORM DE-LETE. NC1194.2 +070700 GO TO SUB-WRITE-GF-17-2. NC1194.2 +070800 SUB-FAIL-GF-17-2. NC1194.2 +070900 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1194.2 +071000 MOVE ZERO TO CORRECT-N. NC1194.2 +071100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +071200 PERFORM FAIL. NC1194.2 +071300 SUB-WRITE-GF-17-2. NC1194.2 +071400 MOVE "SUB-TEST-GF-17-2" TO PAR-NAME. NC1194.2 +071500 PERFORM PRINT-DETAIL. NC1194.2 +071600 SUB-INIT-GF-6-1. NC1194.2 +071700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +071800 MOVE ZERO TO WRK-DS-TS-06V06. NC1194.2 +071900 SUB-TEST-GF-6-1. NC1194.2 +072000 SUBTRACT A12THREES-DS-06V06 NC1194.2 +072100 333333 NC1194.2 +072200 A06THREES-DS-03V03 NC1194.2 +072300 -0000009 NC1194.2 +072400 FROM WRK-DS-TS-06V06 ROUNDED ON SIZE ERROR NC1194.2 +072500 GO TO SUB-FAIL-GF-6-1. NC1194.2 +072600 PERFORM PASS. NC1194.2 +072700 GO TO SUB-WRITE-GF-6-1. NC1194.2 +072800 SUB-DELETE-GF-6-1. NC1194.2 +072900 PERFORM DE-LETE. NC1194.2 +073000 GO TO SUB-WRITE-GF-6-1. NC1194.2 +073100 SUB-FAIL-GF-6-1. NC1194.2 +073200 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1194.2 +073300 PERFORM FAIL. NC1194.2 +073400 SUB-WRITE-GF-6-1. NC1194.2 +073500 MOVE "SUB-TEST-GF-6-1" TO PAR-NAME. NC1194.2 +073600 PERFORM PRINT-DETAIL. NC1194.2 +073700 SUB-TEST-GF-6-2. NC1194.2 +073800 IF WRK-DS-TS-06V06 EQUAL TO -666990.666333 NC1194.2 +073900 PERFORM PASS GO TO SUB-WRITE-GF-6-2. NC1194.2 +074000* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-6-1 NC1194.2 +074100 GO TO SUB-FAIL-GF-6-2. NC1194.2 +074200 SUB-DELETE-GF-6-2. NC1194.2 +074300 PERFORM DE-LETE. NC1194.2 +074400 GO TO SUB-WRITE-GF-6-2. NC1194.2 +074500 SUB-FAIL-GF-6-2. NC1194.2 +074600 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +074700 MOVE -666990.666333 TO CORRECT-N. NC1194.2 +074800 PERFORM FAIL. NC1194.2 +074900 SUB-WRITE-GF-6-2. NC1194.2 +075000 MOVE "SUB-TEST-GF-6-2" TO PAR-NAME. NC1194.2 +075100 PERFORM PRINT-DETAIL. NC1194.2 +075200 SUB-INIT-GF-18-1. NC1194.2 +075300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +075400 MOVE ZERO TO WRK-DS-T-05V00. NC1194.2 +075500 SUB-TEST-GF-18-1. NC1194.2 +075600 SUBTRACT 33333 NC1194.2 +075700 A06THREES-DS-03V03 NC1194.2 +075800 A12THREES-DS-06V06 NC1194.2 +075900 FROM -1000000 GIVING WRK-DS-T-05V00 NC1194.2 +076000 ROUNDED ON SIZE ERROR NC1194.2 +076100 PERFORM PASS GO TO SUB-WRITE-GF-18-1. NC1194.2 +076200 GO TO SUB-FAIL-GF-18-1. NC1194.2 +076300 SUB-DELETE-GF-18-1. NC1194.2 +076400 PERFORM DE-LETE. NC1194.2 +076500 GO TO SUB-WRITE-GF-18-1. NC1194.2 +076600 SUB-FAIL-GF-18-1. NC1194.2 +076700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +076800 PERFORM FAIL. NC1194.2 +076900 SUB-WRITE-GF-18-1. NC1194.2 +077000 MOVE "SUB-TEST-GF-18-1" TO PAR-NAME. NC1194.2 +077100 PERFORM PRINT-DETAIL. NC1194.2 +077200 SUB-TEST-GF-18-2. NC1194.2 +077300 IF WRK-DS-T-05V00 EQUAL TO ZERO NC1194.2 +077400 PERFORM PASS GO TO SUB-WRITE-GF-18-2. NC1194.2 +077500* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-18-1 NC1194.2 +077600 GO TO SUB-FAIL-GF-18-2. NC1194.2 +077700 SUB-DELETE-GF-18-2. NC1194.2 +077800 PERFORM DE-LETE. NC1194.2 +077900 GO TO SUB-WRITE-GF-18-2. NC1194.2 +078000 SUB-FAIL-GF-18-2. NC1194.2 +078100 MOVE WRK-DS-T-05V00 TO COMPUTED-N. NC1194.2 +078200 MOVE ZERO TO CORRECT-N. NC1194.2 +078300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +078400 PERFORM FAIL. NC1194.2 +078500 SUB-WRITE-GF-18-2. NC1194.2 +078600 MOVE "SUB-TEST-GF-18-2" TO PAR-NAME. NC1194.2 +078700 PERFORM PRINT-DETAIL. NC1194.2 +078800 SUB-INIT-GF-19-1. NC1194.2 +078900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +079000 MOVE ZERO TO WRK-DS-TS-06V06. NC1194.2 +079100 SUB-TEST-GF-19-1. NC1194.2 +079200 SUBTRACT A12THREES-DS-06V06 NC1194.2 +079300 333333 NC1194.2 +079400 A06THREES-DS-03V03 NC1194.2 +079500 -.0000009 FROM 0000000 NC1194.2 +079600 GIVING WRK-DS-TS-06V06 ROUNDED ON SIZE ERROR NC1194.2 +079700 GO TO SUB-FAIL-GF-19-1. NC1194.2 +079800 PERFORM PASS. NC1194.2 +079900 GO TO SUB-WRITE-GF-19-1. NC1194.2 +080000 SUB-DELETE-GF-19-1. NC1194.2 +080100 PERFORM DE-LETE. NC1194.2 +080200 GO TO SUB-WRITE-GF-19-1. NC1194.2 +080300 SUB-FAIL-GF-19-1. NC1194.2 +080400 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1194.2 +080500 PERFORM FAIL. NC1194.2 +080600 SUB-WRITE-GF-19-1. NC1194.2 +080700 MOVE "SUB-TEST-GF-19-1" TO PAR-NAME. NC1194.2 +080800 PERFORM PRINT-DETAIL. NC1194.2 +080900 SUB-TEST-GF-19-2. NC1194.2 +081000 IF WRK-DS-TS-06V06 EQUAL TO -666999.666332 NC1194.2 +081100 PERFORM PASS GO TO SUB-WRITE-GF-19-2. NC1194.2 +081200* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-19-1 NC1194.2 +081300 GO TO SUB-FAIL-GF-19-2. NC1194.2 +081400 SUB-DELETE-GF-19-2. NC1194.2 +081500 PERFORM DE-LETE. NC1194.2 +081600 GO TO SUB-WRITE-GF-19-2. NC1194.2 +081700 SUB-FAIL-GF-19-2. NC1194.2 +081800 MOVE WRK-DS-TS-06V06 TO COMPUTED-N. NC1194.2 +081900 MOVE -666999.666332 TO CORRECT-N. NC1194.2 +082000 PERFORM FAIL. NC1194.2 +082100 SUB-WRITE-GF-19-2. NC1194.2 +082200 MOVE "SUB-TEST-GF-19-2" TO PAR-NAME. NC1194.2 +082300 PERFORM PRINT-DETAIL. NC1194.2 +082400 SUB-INIT-GF-20. NC1194.2 +082500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +082600 MOVE " SERIES" TO FEATURE. NC1194.2 +082700 MOVE ZERO TO WRK-DS-03V10. NC1194.2 +082800 SUB-TEST-GF-20. NC1194.2 +082900 SUBTRACT A99-DS-T-02V00 NC1194.2 +083000 A03ONES-DS-02V01 NC1194.2 +083100 A06ONES-DS-TS-03V03 NC1194.2 +083200 A08TWOS-DS-02V06 NC1194.2 +083300 -1.1111111 NC1194.2 +083400 +.11111111 NC1194.2 +083500 A01ONES-DS-LS-P0801 FROM 0000.000000 NC1194.2 +083600 GIVING WRK-DS-03V10. NC1194.2 +083700 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1194.2 +083800 PERFORM PASS GO TO SUB-WRITE-GF-20. NC1194.2 +083900 GO TO SUB-FAIL-GF-20. NC1194.2 +084000 SUB-DELETE-GF-20. NC1194.2 +084100 PERFORM DE-LETE. NC1194.2 +084200 GO TO SUB-WRITE-GF-20. NC1194.2 +084300 SUB-FAIL-GF-20. NC1194.2 +084400 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1194.2 +084500 MOVE -242.4332220110 TO CORRECT-4V14. NC1194.2 +084600 PERFORM FAIL. NC1194.2 +084700 SUB-WRITE-GF-20. NC1194.2 +084800 MOVE "SUB-TEST-GF-20" TO PAR-NAME. NC1194.2 +084900 PERFORM PRINT-DETAIL. NC1194.2 +085000 SUB-INIT-GF-21. NC1194.2 +085100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +085200 MOVE ZERO TO WRK-DS-03V10. NC1194.2 +085300 SUB-TEST-GF-21-0. NC1194.2 +085400 SUBTRACT A01ONES-DS-LS-P0801 NC1194.2 +085500 +.11111111 NC1194.2 +085600 -1.1111111 NC1194.2 +085700 A08TWOS-DS-02V06 NC1194.2 +085800 A06ONES-DS-TS-03V03 NC1194.2 +085900 A03ONES-DS-02V01 NC1194.2 +086000 A99-DS-T-02V00 FROM 0000.000000 GIVING WRK-DS-03V10.NC1194.2 +086100 SUB-TEST-GF-21-1. NC1194.2 +086200 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1194.2 +086300 PERFORM PASS GO TO SUB-WRITE-GF-21. NC1194.2 +086400 GO TO SUB-FAIL-GF-21. NC1194.2 +086500 SUB-DELETE-GF-21. NC1194.2 +086600 PERFORM DE-LETE. NC1194.2 +086700 GO TO SUB-WRITE-GF-21. NC1194.2 +086800 SUB-FAIL-GF-21. NC1194.2 +086900 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1194.2 +087000 MOVE -242.4332220110 TO CORRECT-4V14. NC1194.2 +087100 PERFORM FAIL. NC1194.2 +087200 SUB-WRITE-GF-21. NC1194.2 +087300 MOVE "SUB-TEST-GF-21" TO PAR-NAME. NC1194.2 +087400 PERFORM PRINT-DETAIL. NC1194.2 +087500 SUB-INIT-GF-22. NC1194.2 +087600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +087700 MOVE ZERO TO WRK-DS-03V10. NC1194.2 +087800 SUB-TEST-GF-22-0. NC1194.2 +087900 SUBTRACT A08TWOS-DS-02V06 NC1194.2 +088000 A99-DS-T-02V00 NC1194.2 +088100 -1.1111111 NC1194.2 +088200 A03ONES-DS-02V01 NC1194.2 +088300 A01ONES-DS-LS-P0801 NC1194.2 +088400 +.11111111 NC1194.2 +088500 A06ONES-DS-TS-03V03 FROM 0000.000000 NC1194.2 +088600 GIVING WRK-DS-03V10. NC1194.2 +088700 SUB-TEST-GF-22-1. NC1194.2 +088800 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1194.2 +088900 PERFORM PASS GO TO SUB-WRITE-GF-22. NC1194.2 +089000 GO TO SUB-FAIL-GF-22. NC1194.2 +089100 SUB-DELETE-GF-22. NC1194.2 +089200 PERFORM DE-LETE. NC1194.2 +089300 GO TO SUB-WRITE-GF-22. NC1194.2 +089400 SUB-FAIL-GF-22. NC1194.2 +089500 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1194.2 +089600 MOVE -242.4332220110 TO CORRECT-4V14. NC1194.2 +089700 PERFORM FAIL. NC1194.2 +089800 SUB-WRITE-GF-22. NC1194.2 +089900 MOVE "SUB-TEST-GF-22" TO PAR-NAME. NC1194.2 +090000 PERFORM PRINT-DETAIL. NC1194.2 +090100 SUB-INIT-GF-7. NC1194.2 +090200 MOVE " COMP VS. DISPLAY" TO FEATURE. NC1194.2 +090300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +090400 MOVE ZERO TO WRK-CS-18V00. NC1194.2 +090500 SUB-TEST-GF-7-0. NC1194.2 +090600 SUBTRACT A18ONES-DS-TS-18V00 FROM WRK-CS-18V00. NC1194.2 +090700 SUB-TEST-GF-7-1. NC1194.2 +090800 IF WRK-CS-18V00 EQUAL TO -111111111111111111 NC1194.2 +090900 PERFORM PASS GO TO SUB-WRITE-GF-7. NC1194.2 +091000 GO TO SUB-FAIL-GF-7. NC1194.2 +091100 SUB-DELETE-GF-7. NC1194.2 +091200 PERFORM DE-LETE. NC1194.2 +091300 GO TO SUB-WRITE-GF-7. NC1194.2 +091400 SUB-FAIL-GF-7. NC1194.2 +091500 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1194.2 +091600 MOVE -111111111111111111 TO CORRECT-18V0. NC1194.2 +091700 PERFORM FAIL. NC1194.2 +091800 SUB-WRITE-GF-7. NC1194.2 +091900 MOVE "SUB-TEST-GF-7" TO PAR-NAME. NC1194.2 +092000 PERFORM PRINT-DETAIL. NC1194.2 +092100 SUB-INIT-GF-8. NC1194.2 +092200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +092300 MOVE ZERO TO WRK-DS-T-18V00. NC1194.2 +092400 SUB-TEST-GF-8-0. NC1194.2 +092500 SUBTRACT A18ONES-CS-18V00 FROM WRK-DS-T-18V00. NC1194.2 +092600 SUB-TEST-GF-8-1. NC1194.2 +092700 IF WRK-DS-T-18V00 EQUAL TO -111111111111111111 NC1194.2 +092800 PERFORM PASS GO TO SUB-WRITE-GF-8. NC1194.2 +092900 GO TO SUB-FAIL-GF-8. NC1194.2 +093000 SUB-DELETE-GF-8. NC1194.2 +093100 PERFORM DE-LETE. NC1194.2 +093200 GO TO SUB-WRITE-GF-8. NC1194.2 +093300 SUB-FAIL-GF-8. NC1194.2 +093400 MOVE WRK-DS-T-18V00 TO COMPUTED-18V0. NC1194.2 +093500 MOVE -111111111111111111 TO CORRECT-18V0. NC1194.2 +093600 PERFORM FAIL. NC1194.2 +093700 SUB-WRITE-GF-8. NC1194.2 +093800 MOVE "SUB-TEST-GF-8" TO PAR-NAME. NC1194.2 +093900 PERFORM PRINT-DETAIL. NC1194.2 +094000 SUB-INIT-GF-9. NC1194.2 +094100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +094200 MOVE 1 TO SUBTR-1. NC1194.2 +094300 MOVE -1 TO SUBTR-3. NC1194.2 +094400 MOVE 99 TO SUBTR-7. NC1194.2 +094500 SUB-TEST-GF-9-0. NC1194.2 +094600 SUBTRACT SUBTR-1 SUBTR-3 FROM SUBTR-7. NC1194.2 +094700 SUB-TEST-GF-9-1. NC1194.2 +094800 IF SUBTR-7 EQUAL TO 99 NC1194.2 +094900 PERFORM PASS GO TO SUB-WRITE-GF-9. NC1194.2 +095000 GO TO SUB-FAIL-GF-9. NC1194.2 +095100 SUB-DELETE-GF-9. NC1194.2 +095200 PERFORM DE-LETE. NC1194.2 +095300 GO TO SUB-WRITE-GF-9. NC1194.2 +095400 SUB-FAIL-GF-9. NC1194.2 +095500 MOVE SUBTR-7 TO COMPUTED-N. NC1194.2 +095600 MOVE 99 TO CORRECT-N. NC1194.2 +095700 PERFORM FAIL. NC1194.2 +095800 SUB-WRITE-GF-9. NC1194.2 +095900 MOVE "SUB-TEST-GF-9" TO PAR-NAME. NC1194.2 +096000 PERFORM PRINT-DETAIL. NC1194.2 +096100 SUB-INIT-GF-10. NC1194.2 +096200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +096300 MOVE 100 TO SUBTR-5. NC1194.2 +096400 MOVE -1 TO SUBTR-3. NC1194.2 +096500 MOVE 100 TO SUBTR-10. NC1194.2 +096600 SUB-TEST-GF-10-0. NC1194.2 +096700 SUBTRACT SUBTR-5 -98 SUBTR-3 -1 FROM SUBTR-10. NC1194.2 +096800 SUB-TEST-GF-10-1. NC1194.2 +096900 IF SUBTR-10 EQUAL TO 100 NC1194.2 +097000 PERFORM PASS GO TO SUB-WRITE-GF-10. NC1194.2 +097100 GO TO SUB-FAIL-GF-10. NC1194.2 +097200 SUB-DELETE-GF-10. NC1194.2 +097300 PERFORM DE-LETE. NC1194.2 +097400 GO TO SUB-WRITE-GF-10. NC1194.2 +097500 SUB-FAIL-GF-10. NC1194.2 +097600 MOVE SUBTR-10 TO COMPUTED-N. NC1194.2 +097700 MOVE 100 TO CORRECT-N. NC1194.2 +097800 PERFORM FAIL. NC1194.2 +097900 SUB-WRITE-GF-10. NC1194.2 +098000 MOVE "SUB-TEST-GF-10" TO PAR-NAME. NC1194.2 +098100 PERFORM PRINT-DETAIL. NC1194.2 +098200 SUB-INIT-GF-23. NC1194.2 +098300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +098400 MOVE 100 TO SUBTR-5. NC1194.2 +098500 MOVE .001 TO SUBTR-4. NC1194.2 +098600 MOVE 99 TO SUBTR-2. NC1194.2 +098700 MOVE 0 TO SUBTR-11. NC1194.2 +098800 SUB-TEST-GF-23-0. NC1194.2 +098900 SUBTRACT SUBTR-4 SUBTR-5 .499 FROM SUBTR-2 GIVING SUBTR-11. NC1194.2 +099000 SUB-TEST-GF-23-1. NC1194.2 +099100 IF SUBTR-11 EQUAL TO -1.5 NC1194.2 +099200 PERFORM PASS GO TO SUB-WRITE-GF-23. NC1194.2 +099300 GO TO SUB-FAIL-GF-23. NC1194.2 +099400 SUB-DELETE-GF-23. NC1194.2 +099500 PERFORM DE-LETE. NC1194.2 +099600 GO TO SUB-WRITE-GF-23. NC1194.2 +099700 SUB-FAIL-GF-23. NC1194.2 +099800 MOVE SUBTR-11 TO COMPUTED-N. NC1194.2 +099900 MOVE -1.5 TO CORRECT-N. NC1194.2 +100000 PERFORM FAIL. NC1194.2 +100100 SUB-WRITE-GF-23. NC1194.2 +100200 MOVE "SUB-TEST-GF-23" TO PAR-NAME. NC1194.2 +100300 PERFORM PRINT-DETAIL. NC1194.2 +100400 SUB-INIT-GF-11. NC1194.2 +100500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +100600 MOVE 1 TO SUBTR-6. NC1194.2 +100700 MOVE .001 TO SUBTR-4. NC1194.2 +100800 SUB-TEST-GF-11-0. NC1194.2 +100900 SUBTRACT SUBTR-4 FROM SUBTR-6 ROUNDED. NC1194.2 +101000 SUB-TEST-GF-11-1. NC1194.2 +101100 IF SUBTR-6 EQUAL TO 1 NC1194.2 +101200 PERFORM PASS GO TO SUB-WRITE-GF-11. NC1194.2 +101300 GO TO SUB-FAIL-GF-11. NC1194.2 +101400 SUB-DELETE-GF-11. NC1194.2 +101500 PERFORM DE-LETE. NC1194.2 +101600 GO TO SUB-WRITE-GF-11. NC1194.2 +101700 SUB-FAIL-GF-11. NC1194.2 +101800 MOVE SUBTR-6 TO COMPUTED-N. NC1194.2 +101900 MOVE 1 TO CORRECT-N. NC1194.2 +102000 PERFORM FAIL. NC1194.2 +102100 SUB-WRITE-GF-11. NC1194.2 +102200 MOVE "SUB-TEST-GF-11" TO PAR-NAME. NC1194.2 +102300 PERFORM PRINT-DETAIL. NC1194.2 +102400 SUB-INIT-GF-12. NC1194.2 +102500 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +102600 MOVE -9.99 TO SUBTR-8. NC1194.2 +102700 SUB-TEST-GF-12-0. NC1194.2 +102800 SUBTRACT .01 FROM SUBTR-8 ON SIZE ERROR NC1194.2 +102900 PERFORM PASS GO TO SUB-WRITE-GF-12-1. NC1194.2 +103000 GO TO SUB-FAIL-GF-12-1. NC1194.2 +103100 SUB-DELETE-GF-12-1. NC1194.2 +103200 PERFORM DE-LETE. NC1194.2 +103300 GO TO SUB-WRITE-GF-12-1. NC1194.2 +103400 SUB-FAIL-GF-12-1. NC1194.2 +103500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +103600 PERFORM FAIL. NC1194.2 +103700 SUB-WRITE-GF-12-1. NC1194.2 +103800 MOVE "SUB-TEST-GF-12-1" TO PAR-NAME. NC1194.2 +103900 PERFORM PRINT-DETAIL. NC1194.2 +104000 SUB-TEST-GF-12-2. NC1194.2 +104100 IF SUBTR-8 EQUAL TO -9.99 NC1194.2 +104200 PERFORM PASS GO TO SUB-WRITE-GF-12-2. NC1194.2 +104300* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-12-1 NC1194.2 +104400 GO TO SUB-FAIL-GF-12-2. NC1194.2 +104500 SUB-DELETE-GF-12-2. NC1194.2 +104600 PERFORM DE-LETE. NC1194.2 +104700 GO TO SUB-WRITE-GF-12-2. NC1194.2 +104800 SUB-FAIL-GF-12-2. NC1194.2 +104900 MOVE SUBTR-8 TO COMPUTED-N. NC1194.2 +105000 MOVE -9.99 TO CORRECT-N. NC1194.2 +105100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +105200 PERFORM FAIL. NC1194.2 +105300 SUB-WRITE-GF-12-2. NC1194.2 +105400 MOVE "SUB-TEST-GF-12-2" TO PAR-NAME. NC1194.2 +105500 PERFORM PRINT-DETAIL. NC1194.2 +105600 SUB-INIT-GF-24. NC1194.2 +105700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +105800 MOVE 1 TO SUBTR-1. NC1194.2 +105900 MOVE -1 TO SUBTR-3. NC1194.2 +106000 MOVE 100 TO SUBTR-5. NC1194.2 +106100 MOVE 99 TO SUBTR-7. NC1194.2 +106200 SUB-TEST-GF-24-1. NC1194.2 +106300 SUBTRACT SUBTR-1 SUBTR-3 FROM SUBTR-5 GIVING SUBTR-7 ON NC1194.2 +106400 SIZE ERROR NC1194.2 +106500 PERFORM PASS GO TO SUB-WRITE-GF-24-1. NC1194.2 +106600 GO TO SUB-FAIL-GF-24-1. NC1194.2 +106700 SUB-DELETE-GF-24-1. NC1194.2 +106800 PERFORM DE-LETE. NC1194.2 +106900 GO TO SUB-WRITE-GF-24-1. NC1194.2 +107000 SUB-FAIL-GF-24-1. NC1194.2 +107100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1194.2 +107200 PERFORM FAIL. NC1194.2 +107300 SUB-WRITE-GF-24-1. NC1194.2 +107400 MOVE "SUB-TEST-GF-24-1" TO PAR-NAME. NC1194.2 +107500 PERFORM PRINT-DETAIL. NC1194.2 +107600 SUB-TEST-GF-24-2. NC1194.2 +107700 IF SUBTR-7 EQUAL TO 99 NC1194.2 +107800 PERFORM PASS GO TO SUB-WRITE-GF-24-2. NC1194.2 +107900* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-GF-24-1 NC1194.2 +108000 GO TO SUB-FAIL-GF-24-2. NC1194.2 +108100 SUB-DELETE-GF-24-2. NC1194.2 +108200 PERFORM DE-LETE. NC1194.2 +108300 GO TO SUB-WRITE-GF-24-2. NC1194.2 +108400 SUB-FAIL-GF-24-2. NC1194.2 +108500 MOVE SUBTR-7 TO COMPUTED-N. NC1194.2 +108600 MOVE 99 TO CORRECT-N. NC1194.2 +108700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1194.2 +108800 PERFORM FAIL. NC1194.2 +108900 SUB-WRITE-GF-24-2. NC1194.2 +109000 MOVE "SUB-TEST-GF-24-2" TO PAR-NAME. NC1194.2 +109100 PERFORM PRINT-DETAIL. NC1194.2 +109200 SUB-INIT-GF-25. NC1194.2 +109300 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +109400 MOVE -999999999999999999 TO MINUS-NAME1. NC1194.2 +109500 MOVE -999999999999999999 TO MINUS-NAME2. NC1194.2 +109600 MOVE +999999999999999999 TO PLUS-NAME1. NC1194.2 +109700 MOVE +999999999999999999 TO PLUS-NAME1. NC1194.2 +109800 MOVE +1 TO EVEN-NAME1. NC1194.2 +109900 MOVE 0 TO WHOLE-FIELD. NC1194.2 +110000 MOVE SPACE TO SIZE-ERR. NC1194.2 +110100 SUB-TEST-GF-25-0. NC1194.2 +110200 SUBTRACT MINUS-NAME1 MINUS-NAME2 -34 -1 PLUS-NAME1 NC1194.2 +110300 PLUS-NAME2 EVEN-NAME1 35 FROM EVEN-NAME1 GIVING NC1194.2 +110400 WHOLE-FIELD NC1194.2 +110500 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1194.2 +110600 SUB-TEST-GF-25-1. NC1194.2 +110700 IF WHOLE-FIELD EQUAL TO 0 NC1194.2 +110800 PERFORM PASS NC1194.2 +110900 GO TO SUB-WRITE-GF-25-1. NC1194.2 +111000 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC1194.2 +111100 MOVE 0 TO CORRECT-18V0. NC1194.2 +111200 PERFORM FAIL. NC1194.2 +111300 GO TO SUB-WRITE-GF-25-1. NC1194.2 +111400 SUB-DELETE-GF-25-1. NC1194.2 +111500 PERFORM DE-LETE. NC1194.2 +111600 SUB-WRITE-GF-25-1. NC1194.2 +111700 MOVE "SUB-TEST-GF-25-1" TO PAR-NAME. NC1194.2 +111800 PERFORM PRINT-DETAIL. NC1194.2 +111900 SUB-TEST-GF-25-2. NC1194.2 +112000 IF SIZE-ERR EQUAL TO "1" NC1194.2 +112100 PERFORM FAIL NC1194.2 +112200 MOVE SPACE TO CORRECT-A NC1194.2 +112300 MOVE 1 TO COMPUTED-A NC1194.2 +112400 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1194.2 +112500 GO TO SUB-WRITE-GF-25-2. NC1194.2 +112600 PERFORM PASS. NC1194.2 +112700 GO TO SUB-WRITE-GF-25-2. NC1194.2 +112800 SUB-DELETE-GF-25-2. NC1194.2 +112900 PERFORM DE-LETE. NC1194.2 +113000 SUB-WRITE-GF-25-2. NC1194.2 +113100 MOVE "SUB-TEST-GF-25-2" TO PAR-NAME. NC1194.2 +113200 PERFORM PRINT-DETAIL. NC1194.2 +113300 SUB-INIT-GF-26. NC1194.2 +113400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1194.2 +113500 MOVE SPACE TO SIZE-ERR. NC1194.2 +113600 MOVE -.999999999999999999 TO MINUS-NAME3. NC1194.2 +113700 MOVE -.999999999999999999 TO MINUS-NAME4. NC1194.2 +113800 MOVE +.999999999999999999 TO PLUS-NAME3. NC1194.2 +113900 MOVE +.999999999999999999 TO PLUS-NAME4. NC1194.2 +114000 MOVE +1 TO EVEN-NAME2. NC1194.2 +114100 MOVE 0 TO DECMAL-FIELD. NC1194.2 +114200 SUB-TEST-GF-26-0. NC1194.2 +114300 SUBTRACT MINUS-NAME3 MINUS-NAME4 -.34 -.01 PLUS-NAME3 NC1194.2 +114400 PLUS-NAME4 EVEN-NAME2 .35 FROM EVEN-NAME2 NC1194.2 +114500 GIVING DECMAL-FIELD NC1194.2 +114600 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1194.2 +114700 SUB-TEST-GF-26-1. NC1194.2 +114800 IF DECMAL-FIELD EQUAL TO .0 NC1194.2 +114900 PERFORM PASS NC1194.2 +115000 GO TO SUB-WRITE-GF-26-1. NC1194.2 +115100 MOVE DECMAL-FIELD TO COMPUTED-0V18. NC1194.2 +115200 MOVE .0 TO CORRECT-0V18. NC1194.2 +115300 PERFORM FAIL. NC1194.2 +115400 GO TO SUB-WRITE-GF-26-1. NC1194.2 +115500 SUB-DELETE-GF-26-1. NC1194.2 +115600 PERFORM DE-LETE. NC1194.2 +115700 SUB-WRITE-GF-26-1. NC1194.2 +115800 MOVE "SUB-TEST-GF-26-1" TO PAR-NAME. NC1194.2 +115900 PERFORM PRINT-DETAIL. NC1194.2 +116000 SUB-TEST-GF-26-2. NC1194.2 +116100 IF SIZE-ERR EQUAL TO "1" NC1194.2 +116200 PERFORM FAIL NC1194.2 +116300 MOVE SPACE TO CORRECT-A NC1194.2 +116400 MOVE 1 TO COMPUTED-A NC1194.2 +116500 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1194.2 +116600 GO TO SUB-WRITE-GF-26-2. NC1194.2 +116700 PERFORM PASS. NC1194.2 +116800 GO TO SUB-WRITE-GF-26-2. NC1194.2 +116900 SUB-DELETE-GF-26-2. NC1194.2 +117000 PERFORM DE-LETE. NC1194.2 +117100 SUB-WRITE-GF-26-2. NC1194.2 +117200 MOVE "SUB-TEST-GF-26-2" TO PAR-NAME. NC1194.2 +117300 PERFORM PRINT-DETAIL. NC1194.2 +117400 CCVS-EXIT SECTION. NC1194.2 +117500 CCVS-999999. NC1194.2 +117600 GO TO CLOSE-FILES. NC1194.2 diff --git a/tests/cobol85/NC/NC120A.CBL b/tests/cobol85/NC/NC120A.CBL new file mode 100755 index 00000000..d32b6491 --- /dev/null +++ b/tests/cobol85/NC/NC120A.CBL @@ -0,0 +1,1147 @@ +000100 IDENTIFICATION DIVISION. NC1204.2 +000200 PROGRAM-ID. NC1204.2 +000300 NC120A. NC1204.2 +000400**************************************************************** NC1204.2 +000500* * NC1204.2 +000600* VALIDATION FOR:- * NC1204.2 +000700* * NC1204.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1204.2 +000900* * NC1204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1204.2 +001100* * NC1204.2 +001200**************************************************************** NC1204.2 +001300* * NC1204.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1204.2 +001500* * NC1204.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1204.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1204.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1204.2 +001900* * NC1204.2 +002000**************************************************************** NC1204.2 +002100* NC1204.2 +002200* PROGRAM NC120A TESTS THE USE OF THE "SIGN" CLAUSE WITH NC1204.2 +002300* FORMATS 1 AND 2 OF THE MULTIPLY STATEMENT. NC1204.2 +002400* ALL COMBINATIONS OF THE SIGN CLAUSE ARE USED WITH NC1204.2 +002500* DATA ITEMS OF VARIOUS LENGTHS. NC1204.2 +002600* NC1204.2 +002700 ENVIRONMENT DIVISION. NC1204.2 +002800 CONFIGURATION SECTION. NC1204.2 +002900 SOURCE-COMPUTER. NC1204.2 +003000 Linux. NC1204.2 +003100 OBJECT-COMPUTER. NC1204.2 +003200 Linux. NC1204.2 +003300 INPUT-OUTPUT SECTION. NC1204.2 +003400 FILE-CONTROL. NC1204.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1204.2 +003600 "report.log". NC1204.2 +003700 DATA DIVISION. NC1204.2 +003800 FILE SECTION. NC1204.2 +003900 FD PRINT-FILE. NC1204.2 +004000 01 PRINT-REC PICTURE X(120). NC1204.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1204.2 +004200 WORKING-STORAGE SECTION. NC1204.2 +004300 77 WRK-DS-LS-18V00 PICTURE S9(18) NC1204.2 +004400 SIGN IS LEADING SEPARATE CHARACTER. NC1204.2 +004500 77 A06THREES-DS-LS-03V03 PICTURE S999V999 VALUE 333.333NC1204.2 +004600 SIGN IS LEADING. NC1204.2 +004700 77 WRK-DS-TS-06V06 PICTURE S9(6)V9(6) NC1204.2 +004800 SIGN IS TRAILING SEPARATE CHARACTER. NC1204.2 +004900 77 WRK-DS-TS-12V00-S-S REDEFINES WRK-DS-TS-06V06 PICTURE S9(12) NC1204.2 +005000 SIGN TRAILING SEPARATE. NC1204.2 +005100 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1204.2 +005200 77 WRK-DS-10V00 PICTURE S9(10). NC1204.2 +005300 77 WRK-XN-00001 PICTURE X. NC1204.2 +005400 77 A10ONES-DS-T-10V00 PICTURE S9(10) NC1204.2 +005500 SIGN IS TRAILING NC1204.2 +005600 VALUE 1111111111. NC1204.2 +005700 77 A12THREES-DS-LS-06V06 PICTURE S9(6)V9(6) NC1204.2 +005800 SIGN IS LEADING SEPARATE NC1204.2 +005900 VALUE 333333.333333. NC1204.2 +006000 77 WRK-DS-02V00 PICTURE S99. NC1204.2 +006100 77 AZERO-DS-LS-05V05 PICTURE S9(5)V9(5) VALUE ZERO NC1204.2 +006200 SIGN IS LEADING SEPARATE CHARACTER. NC1204.2 +006300 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1204.2 +006400 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1204.2 +006500 77 A05ONES-DS-LS-00V05 PICTURE SV9(5) VALUE .11111 NC1204.2 +006600 SIGN IS LEADING SEPARATE CHARACTER. NC1204.2 +006700 77 A12ONES-DS-12V00 PICTURE S9(12) NC1204.2 +006800 VALUE 111111111111. NC1204.2 +006900 77 A01ONE-DS-TS-P0801 PICTURE SP(8)9 VALUE .000000001NC1204.2 +007000 SIGN IS TRAILING SEPARATE. NC1204.2 +007100 77 WRK-DS-T-09V08 PICTURE S9(9)V9(8) NC1204.2 +007200 SIGN IS TRAILING. NC1204.2 +007300 77 WKR-DS-T-17V00-S REDEFINES WRK-DS-T-09V08 PICTURE S9(17) NC1204.2 +007400 SIGN TRAILING. NC1204.2 +007500 77 A18ONES-DS-18V00 PICTURE S9(18) NC1204.2 +007600 VALUE 111111111111111111. NC1204.2 +007700 77 WRK-DS-LS-0201P PICTURE S99P NC1204.2 +007800 SIGN IS LEADING SEPARATE. NC1204.2 +007900 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1204.2 +008000 77 WRK-DU-18V00 PICTURE 9(18). NC1204.2 +008100 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1204.2 +008200 VALUE 99. NC1204.2 +008300 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1204.2 +008400 VALUE .1. NC1204.2 +008500 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1204.2 +008600 77 WRK-DS-TS-12V00-S PICTURE S9(12). NC1204.2 +008700 77 WRK-DS-LS-01V00 PICTURE S9 LEADING SEPARATE. NC1204.2 +008800 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1204.2 +008900 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1204.2 +009000 VALUE 111111111.111111111. NC1204.2 +009100 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1204.2 +009200 77 WRK-DS-05V00 PICTURE S9(5). NC1204.2 +009300 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1204.2 +009400 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1204.2 +009500 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1204.2 +009600 77 XRAY PICTURE X. NC1204.2 +009700 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1204.2 +009800 VALUE +000000000000000001. NC1204.2 +009900 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1204.2 +010000 VALUE -000000000000000033. NC1204.2 +010100 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1204.2 +010200 VALUE 666666666666666666. NC1204.2 +010300 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1204.2 +010400 VALUE 009999999999999999. NC1204.2 +010500 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1204.2 +010600 VALUE 000022222222222222. NC1204.2 +010700 01 MULTIPLY-DATA LEADING SEPARATE. NC1204.2 +010800 02 MULT1 PICTURE IS 999V99 NC1204.2 +010900 VALUE IS 80.12. NC1204.2 +011000 02 MULT2 PICTURE IS 999V999. NC1204.2 +011100 02 MULT3 PICTURE IS $$99.99. NC1204.2 +011200 02 MULT4 PICTURE IS S99 NC1204.2 +011300 VALUE IS -56. NC1204.2 +011400 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1204.2 +011500 02 MULT6 PICTURE IS 99 VALUE IS NC1204.2 +011600 20. NC1204.2 +011700 01 DIVIDE-DATA TRAILING SEPARATE. NC1204.2 +011800 02 DIV1 PICTURE IS 9(4)V99 NC1204.2 +011900 VALUE IS 1620.36. NC1204.2 +012000 02 DIV2 PICTURE IS 99V9 NC1204.2 +012100 VALUE IS 44.1. NC1204.2 +012200 02 DIV3 PICTURE IS 9(4)V9 NC1204.2 +012300 VALUE IS 1661.7. NC1204.2 +012400 02 DIV4 PICTURE IS S9V999 NC1204.2 +012500 VALUE IS -9.642. NC1204.2 +012600 02 DIV-02LEVEL-1. NC1204.2 +012700 03 DIV5 PICTURE IS V99 NC1204.2 +012800 VALUE IS .82. NC1204.2 +012900 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1204.2 +013000 03 DIV7 PICTURE IS 9V9 NC1204.2 +013100 VALUE IS 9.6. NC1204.2 +013200 01 DIV-DATA-2. NC1204.2 +013300 02 DIV8 PICTURE IS 99V9. NC1204.2 +013400 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1204.2 +013500 02 DIV10 PICTURE IS V999. NC1204.2 +013600 01 TEST-RESULTS. NC1204.2 +013700 02 FILLER PIC X VALUE SPACE. NC1204.2 +013800 02 FEATURE PIC X(20) VALUE SPACE. NC1204.2 +013900 02 FILLER PIC X VALUE SPACE. NC1204.2 +014000 02 P-OR-F PIC X(5) VALUE SPACE. NC1204.2 +014100 02 FILLER PIC X VALUE SPACE. NC1204.2 +014200 02 PAR-NAME. NC1204.2 +014300 03 FILLER PIC X(19) VALUE SPACE. NC1204.2 +014400 03 PARDOT-X PIC X VALUE SPACE. NC1204.2 +014500 03 DOTVALUE PIC 99 VALUE ZERO. NC1204.2 +014600 02 FILLER PIC X(8) VALUE SPACE. NC1204.2 +014700 02 RE-MARK PIC X(61). NC1204.2 +014800 01 TEST-COMPUTED. NC1204.2 +014900 02 FILLER PIC X(30) VALUE SPACE. NC1204.2 +015000 02 FILLER PIC X(17) VALUE NC1204.2 +015100 " COMPUTED=". NC1204.2 +015200 02 COMPUTED-X. NC1204.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1204.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A NC1204.2 +015500 PIC -9(9).9(9). NC1204.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1204.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1204.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1204.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. NC1204.2 +016000 04 COMPUTED-18V0 PIC -9(18). NC1204.2 +016100 04 FILLER PIC X. NC1204.2 +016200 03 FILLER PIC X(50) VALUE SPACE. NC1204.2 +016300 01 TEST-CORRECT. NC1204.2 +016400 02 FILLER PIC X(30) VALUE SPACE. NC1204.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1204.2 +016600 02 CORRECT-X. NC1204.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1204.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1204.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1204.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1204.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1204.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. NC1204.2 +017300 04 CORRECT-18V0 PIC -9(18). NC1204.2 +017400 04 FILLER PIC X. NC1204.2 +017500 03 FILLER PIC X(2) VALUE SPACE. NC1204.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1204.2 +017700 01 CCVS-C-1. NC1204.2 +017800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1204.2 +017900- "SS PARAGRAPH-NAME NC1204.2 +018000- " REMARKS". NC1204.2 +018100 02 FILLER PIC X(20) VALUE SPACE. NC1204.2 +018200 01 CCVS-C-2. NC1204.2 +018300 02 FILLER PIC X VALUE SPACE. NC1204.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". NC1204.2 +018500 02 FILLER PIC X(15) VALUE SPACE. NC1204.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". NC1204.2 +018700 02 FILLER PIC X(94) VALUE SPACE. NC1204.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1204.2 +018900 01 REC-CT PIC 99 VALUE ZERO. NC1204.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1204.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1204.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1204.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1204.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1204.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1204.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1204.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1204.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1204.2 +019900 01 CCVS-H-1. NC1204.2 +020000 02 FILLER PIC X(39) VALUE SPACES. NC1204.2 +020100 02 FILLER PIC X(42) VALUE NC1204.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1204.2 +020300 02 FILLER PIC X(39) VALUE SPACES. NC1204.2 +020400 01 CCVS-H-2A. NC1204.2 +020500 02 FILLER PIC X(40) VALUE SPACE. NC1204.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1204.2 +020700 02 FILLER PIC XXXX VALUE NC1204.2 +020800 "4.2 ". NC1204.2 +020900 02 FILLER PIC X(28) VALUE NC1204.2 +021000 " COPY - NOT FOR DISTRIBUTION". NC1204.2 +021100 02 FILLER PIC X(41) VALUE SPACE. NC1204.2 +021200 NC1204.2 +021300 01 CCVS-H-2B. NC1204.2 +021400 02 FILLER PIC X(15) VALUE NC1204.2 +021500 "TEST RESULT OF ". NC1204.2 +021600 02 TEST-ID PIC X(9). NC1204.2 +021700 02 FILLER PIC X(4) VALUE NC1204.2 +021800 " IN ". NC1204.2 +021900 02 FILLER PIC X(12) VALUE NC1204.2 +022000 " HIGH ". NC1204.2 +022100 02 FILLER PIC X(22) VALUE NC1204.2 +022200 " LEVEL VALIDATION FOR ". NC1204.2 +022300 02 FILLER PIC X(58) VALUE NC1204.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1204.2 +022500 01 CCVS-H-3. NC1204.2 +022600 02 FILLER PIC X(34) VALUE NC1204.2 +022700 " FOR OFFICIAL USE ONLY ". NC1204.2 +022800 02 FILLER PIC X(58) VALUE NC1204.2 +022900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1204.2 +023000 02 FILLER PIC X(28) VALUE NC1204.2 +023100 " COPYRIGHT 1985 ". NC1204.2 +023200 01 CCVS-E-1. NC1204.2 +023300 02 FILLER PIC X(52) VALUE SPACE. NC1204.2 +023400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1204.2 +023500 02 ID-AGAIN PIC X(9). NC1204.2 +023600 02 FILLER PIC X(45) VALUE SPACES. NC1204.2 +023700 01 CCVS-E-2. NC1204.2 +023800 02 FILLER PIC X(31) VALUE SPACE. NC1204.2 +023900 02 FILLER PIC X(21) VALUE SPACE. NC1204.2 +024000 02 CCVS-E-2-2. NC1204.2 +024100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1204.2 +024200 03 FILLER PIC X VALUE SPACE. NC1204.2 +024300 03 ENDER-DESC PIC X(44) VALUE NC1204.2 +024400 "ERRORS ENCOUNTERED". NC1204.2 +024500 01 CCVS-E-3. NC1204.2 +024600 02 FILLER PIC X(22) VALUE NC1204.2 +024700 " FOR OFFICIAL USE ONLY". NC1204.2 +024800 02 FILLER PIC X(12) VALUE SPACE. NC1204.2 +024900 02 FILLER PIC X(58) VALUE NC1204.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1204.2 +025100 02 FILLER PIC X(13) VALUE SPACE. NC1204.2 +025200 02 FILLER PIC X(15) VALUE NC1204.2 +025300 " COPYRIGHT 1985". NC1204.2 +025400 01 CCVS-E-4. NC1204.2 +025500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1204.2 +025600 02 FILLER PIC X(4) VALUE " OF ". NC1204.2 +025700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1204.2 +025800 02 FILLER PIC X(40) VALUE NC1204.2 +025900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1204.2 +026000 01 XXINFO. NC1204.2 +026100 02 FILLER PIC X(19) VALUE NC1204.2 +026200 "*** INFORMATION ***". NC1204.2 +026300 02 INFO-TEXT. NC1204.2 +026400 04 FILLER PIC X(8) VALUE SPACE. NC1204.2 +026500 04 XXCOMPUTED PIC X(20). NC1204.2 +026600 04 FILLER PIC X(5) VALUE SPACE. NC1204.2 +026700 04 XXCORRECT PIC X(20). NC1204.2 +026800 02 INF-ANSI-REFERENCE PIC X(48). NC1204.2 +026900 01 HYPHEN-LINE. NC1204.2 +027000 02 FILLER PIC IS X VALUE IS SPACE. NC1204.2 +027100 02 FILLER PIC IS X(65) VALUE IS "************************NC1204.2 +027200- "*****************************************". NC1204.2 +027300 02 FILLER PIC IS X(54) VALUE IS "************************NC1204.2 +027400- "******************************". NC1204.2 +027500 01 CCVS-PGM-ID PIC X(9) VALUE NC1204.2 +027600 "NC120A". NC1204.2 +027700 PROCEDURE DIVISION. NC1204.2 +027800 CCVS1 SECTION. NC1204.2 +027900 OPEN-FILES. NC1204.2 +028000 OPEN OUTPUT PRINT-FILE. NC1204.2 +028100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1204.2 +028200 MOVE SPACE TO TEST-RESULTS. NC1204.2 +028300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1204.2 +028400 GO TO CCVS1-EXIT. NC1204.2 +028500 CLOSE-FILES. NC1204.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1204.2 +028700 TERMINATE-CCVS. NC1204.2 +028800*S EXIT PROGRAM. NC1204.2 +028900*SERMINATE-CALL. NC1204.2 +029000 STOP RUN. NC1204.2 +029100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1204.2 +029200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1204.2 +029300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1204.2 +029400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1204.2 +029500 MOVE "****TEST DELETED****" TO RE-MARK. NC1204.2 +029600 PRINT-DETAIL. NC1204.2 +029700 IF REC-CT NOT EQUAL TO ZERO NC1204.2 +029800 MOVE "." TO PARDOT-X NC1204.2 +029900 MOVE REC-CT TO DOTVALUE. NC1204.2 +030000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1204.2 +030100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1204.2 +030200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1204.2 +030300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1204.2 +030400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1204.2 +030500 MOVE SPACE TO CORRECT-X. NC1204.2 +030600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1204.2 +030700 MOVE SPACE TO RE-MARK. NC1204.2 +030800 HEAD-ROUTINE. NC1204.2 +030900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +031000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +031100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1204.2 +031200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1204.2 +031300 COLUMN-NAMES-ROUTINE. NC1204.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +031700 END-ROUTINE. NC1204.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1204.2 +031900 END-RTN-EXIT. NC1204.2 +032000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +032100 END-ROUTINE-1. NC1204.2 +032200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1204.2 +032300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1204.2 +032400 ADD PASS-COUNTER TO ERROR-HOLD. NC1204.2 +032500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1204.2 +032600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1204.2 +032700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1204.2 +032800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1204.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1204.2 +033000 END-ROUTINE-12. NC1204.2 +033100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1204.2 +033200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1204.2 +033300 MOVE "NO " TO ERROR-TOTAL NC1204.2 +033400 ELSE NC1204.2 +033500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1204.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1204.2 +033700 PERFORM WRITE-LINE. NC1204.2 +033800 END-ROUTINE-13. NC1204.2 +033900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1204.2 +034000 MOVE "NO " TO ERROR-TOTAL ELSE NC1204.2 +034100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1204.2 +034200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1204.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +034400 IF INSPECT-COUNTER EQUAL TO ZERO NC1204.2 +034500 MOVE "NO " TO ERROR-TOTAL NC1204.2 +034600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1204.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1204.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1204.2 +035000 WRITE-LINE. NC1204.2 +035100 ADD 1 TO RECORD-COUNT. NC1204.2 +035200 IF RECORD-COUNT GREATER 42 NC1204.2 +035300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1204.2 +035400 MOVE SPACE TO DUMMY-RECORD NC1204.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1204.2 +035600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1204.2 +035700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1204.2 +035800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1204.2 +035900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1204.2 +036000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1204.2 +036100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1204.2 +036200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1204.2 +036300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1204.2 +036400 MOVE ZERO TO RECORD-COUNT. NC1204.2 +036500 PERFORM WRT-LN. NC1204.2 +036600 WRT-LN. NC1204.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1204.2 +036800 MOVE SPACE TO DUMMY-RECORD. NC1204.2 +036900 BLANK-LINE-PRINT. NC1204.2 +037000 PERFORM WRT-LN. NC1204.2 +037100 FAIL-ROUTINE. NC1204.2 +037200 IF COMPUTED-X NOT EQUAL TO SPACE NC1204.2 +037300 GO TO FAIL-ROUTINE-WRITE. NC1204.2 +037400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1204.2 +037500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1204.2 +037600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1204.2 +037700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +037800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1204.2 +037900 GO TO FAIL-ROUTINE-EX. NC1204.2 +038000 FAIL-ROUTINE-WRITE. NC1204.2 +038100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1204.2 +038200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1204.2 +038300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1204.2 +038400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1204.2 +038500 FAIL-ROUTINE-EX. EXIT. NC1204.2 +038600 BAIL-OUT. NC1204.2 +038700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1204.2 +038800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1204.2 +038900 BAIL-OUT-WRITE. NC1204.2 +039000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1204.2 +039100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1204.2 +039200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1204.2 +039300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1204.2 +039400 BAIL-OUT-EX. EXIT. NC1204.2 +039500 CCVS1-EXIT. NC1204.2 +039600 EXIT. NC1204.2 +039700 SECTION-NC120A-001 SECTION. NC1204.2 +039800 SIG-INIT-GF-14. NC1204.2 +039900 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1204.2 +040000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +040100 MOVE 80.12 TO MULT1. NC1204.2 +040200 MOVE 0 TO MULT2. NC1204.2 +040300 SIG-TEST-GF-14-0. NC1204.2 +040400 MULTIPLY MULT1 BY 4.3 GIVING MULT2. NC1204.2 +040500 SIG-TEST-GF-14-1. NC1204.2 +040600 IF MULT2 NOT EQUAL TO 344.516 NC1204.2 +040700 GO TO SIG-FAIL-GF-14. NC1204.2 +040800 PERFORM PASS NC1204.2 +040900 GO TO SIG-WRITE-GF-14. NC1204.2 +041000 SIG-DELETE-GF-14. NC1204.2 +041100 PERFORM DE-LETE. NC1204.2 +041200 GO TO SIG-WRITE-GF-14. NC1204.2 +041300 SIG-FAIL-GF-14. NC1204.2 +041400 PERFORM FAIL. NC1204.2 +041500 MOVE MULT2 TO COMPUTED-N. NC1204.2 +041600 MOVE +344.516 TO CORRECT-N. NC1204.2 +041700 SIG-WRITE-GF-14. NC1204.2 +041800 MOVE "SIG-TEST-GF-14" TO PAR-NAME. NC1204.2 +041900 PERFORM PRINT-DETAIL. NC1204.2 +042000 SIG-INIT-GF-15. NC1204.2 +042100 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +042200 MOVE 80.12 TO MULT1. NC1204.2 +042300 MOVE 0 TO MULT3. NC1204.2 +042400 SIG-TEST-GF-15-0. NC1204.2 +042500 MULTIPLY .9 BY MULT1 GIVING MULT3 ROUNDED. NC1204.2 +042600 SIG-TEST-GF-15-1. NC1204.2 +042700 IF MULT3 NOT EQUAL TO " $72.11" NC1204.2 +042800 GO TO SIG-FAIL-GF-15. NC1204.2 +042900 PERFORM PASS. NC1204.2 +043000 GO TO SIG-WRITE-GF-15. NC1204.2 +043100 SIG-DELETE-GF-15. NC1204.2 +043200 PERFORM DE-LETE. NC1204.2 +043300 GO TO SIG-WRITE-GF-15. NC1204.2 +043400 SIG-FAIL-GF-15. NC1204.2 +043500 PERFORM FAIL. NC1204.2 +043600 MOVE MULT3 TO COMPUTED-A. NC1204.2 +043700 MOVE " l72.11" TO CORRECT-A. NC1204.2 +043800 SIG-WRITE-GF-15. NC1204.2 +043900 MOVE "SIG-TEST-GF-15 " TO PAR-NAME. NC1204.2 +044000 PERFORM PRINT-DETAIL. NC1204.2 +044100 SIG-INIT-GF-16. NC1204.2 +044200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +044300 MOVE -56 TO MULT4. NC1204.2 +044400 MOVE 80.12 TO MULT1. NC1204.2 +044500 MOVE 4 TO MULT5. NC1204.2 +044600 SIG-TEST-GF-16-0. NC1204.2 +044700 MULTIPLY MULT4 BY MULT1 GIVING MULT5 ON SIZE ERROR NC1204.2 +044800 MOVE "H" TO XRAY. NC1204.2 +044900 SIG-TEST-GF-16-1. NC1204.2 +045000 IF XRAY EQUAL TO "H" NC1204.2 +045100 PERFORM PASS NC1204.2 +045200 ELSE NC1204.2 +045300 GO TO SIG-FAIL-GF-16-1. NC1204.2 +045400 GO TO SIG-WRITE-GF-16-1. NC1204.2 +045500 SIG-DELETE-GF-16-1. NC1204.2 +045600 PERFORM DE-LETE. NC1204.2 +045700 GO TO SIG-WRITE-GF-16-1. NC1204.2 +045800 SIG-FAIL-GF-16-1. NC1204.2 +045900 MOVE MULT5 TO COMPUTED-N. NC1204.2 +046000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1204.2 +046100 PERFORM FAIL. NC1204.2 +046200 SIG-WRITE-GF-16-1. NC1204.2 +046300 MOVE "SIG-TEST-GF-16-1 " TO PAR-NAME. NC1204.2 +046400 PERFORM PRINT-DETAIL. NC1204.2 +046500 SIG-TEST-GF-16-2. NC1204.2 +046600 IF MULT5 NOT EQUAL TO 4 NC1204.2 +046700 GO TO SIG-FAIL-GF-16-2. NC1204.2 +046800 PERFORM PASS. NC1204.2 +046900 GO TO SIG-WRITE-GF-16-2. NC1204.2 +047000 SIG-DELETE-GF-16-2. NC1204.2 +047100 PERFORM DE-LETE. NC1204.2 +047200 GO TO SIG-WRITE-GF-16-2. NC1204.2 +047300 SIG-FAIL-GF-16-2. NC1204.2 +047400 PERFORM FAIL. NC1204.2 +047500 MOVE MULT5 TO COMPUTED-N. NC1204.2 +047600 MOVE +4 TO CORRECT-N. NC1204.2 +047700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1204.2 +047800 SIG-WRITE-GF-16-2. NC1204.2 +047900 MOVE "SIG-TEST-GF-16-2 " TO PAR-NAME. NC1204.2 +048000 PERFORM PRINT-DETAIL. NC1204.2 +048100 SIG-INIT-GF-1. NC1204.2 +048200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +048300 MOVE 4 TO MULT5. NC1204.2 +048400 MOVE "A" TO XRAY. NC1204.2 +048500 SIG-TEST-GF-1-0. NC1204.2 +048600 MULTIPLY 3.3 BY -3 GIVING MULT5 ROUNDED ON SIZE ERROR NC1204.2 +048700 MOVE "J" TO XRAY. NC1204.2 +048800 SIG-TEST-GF-1-1. NC1204.2 +048900 IF XRAY NOT EQUAL TO "J" NC1204.2 +049000 GO TO SIG-FAIL-GF-1-1 NC1204.2 +049100 ELSE NC1204.2 +049200 PERFORM PASS. NC1204.2 +049300 GO TO SIG-WRITE-GF-1-1. NC1204.2 +049400 SIG-DELETE-GF-1-1. NC1204.2 +049500 PERFORM DE-LETE. NC1204.2 +049600 GO TO SIG-WRITE-GF-1-1. NC1204.2 +049700 SIG-FAIL-GF-1-1. NC1204.2 +049800 MOVE MULT5 TO COMPUTED-N. NC1204.2 +049900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1204.2 +050000 PERFORM FAIL. NC1204.2 +050100 SIG-WRITE-GF-1-1. NC1204.2 +050200 MOVE "SIG-TEST-GF-1-1 " TO PAR-NAME. NC1204.2 +050300 PERFORM PRINT-DETAIL. NC1204.2 +050400 SIG-TEST-GF-1-2. NC1204.2 +050500 IF MULT5 EQUAL TO 4 NC1204.2 +050600 PERFORM PASS NC1204.2 +050700 ELSE NC1204.2 +050800 GO TO SIG-FAIL-GF-1-2. NC1204.2 +050900 GO TO SIG-WRITE-GF-1-2. NC1204.2 +051000 SIG-DELETE-GF-1-2. NC1204.2 +051100 PERFORM DE-LETE. NC1204.2 +051200 GO TO SIG-WRITE-GF-1-2. NC1204.2 +051300 SIG-FAIL-GF-1-2. NC1204.2 +051400 PERFORM FAIL. NC1204.2 +051500 MOVE MULT5 TO COMPUTED-N. NC1204.2 +051600 MOVE +4 TO CORRECT-N. NC1204.2 +051700 MOVE 4 TO MULT5. NC1204.2 +051800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1204.2 +051900 SIG-WRITE-GF-1-2. NC1204.2 +052000 MOVE "SIG-TEST-GF-1-2 " TO PAR-NAME. NC1204.2 +052100 PERFORM PRINT-DETAIL. NC1204.2 +052200 SIG-INIT-GF-2. NC1204.2 +052300 MOVE "MULTIPLY BY" TO FEATURE. NC1204.2 +052400 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +052500 MOVE 4 TO MULT5. NC1204.2 +052600 SIG-TEST-GF-2-0. NC1204.2 +052700 MULTIPLY MULT5 BY MULT1. NC1204.2 +052800 SIG-TEST-GF-2-1. NC1204.2 +052900 IF MULT1 EQUAL TO 320.48 NC1204.2 +053000 PERFORM PASS NC1204.2 +053100 ELSE NC1204.2 +053200 GO TO SIG-FAIL-GF-2. NC1204.2 +053300 GO TO SIG-WRITE-GF-2. NC1204.2 +053400 SIG-DELETE-GF-2. NC1204.2 +053500 PERFORM DE-LETE. NC1204.2 +053600 GO TO SIG-WRITE-GF-2. NC1204.2 +053700 SIG-FAIL-GF-2. NC1204.2 +053800 PERFORM FAIL. NC1204.2 +053900 MOVE MULT1 TO COMPUTED-N. NC1204.2 +054000 MOVE +320.48 TO CORRECT-N. NC1204.2 +054100 SIG-WRITE-GF-2. NC1204.2 +054200 MOVE "SIG-TEST-GF-2 " TO PAR-NAME. NC1204.2 +054300 PERFORM PRINT-DETAIL. NC1204.2 +054400 SIG-INIT-GF-3. NC1204.2 +054500 MOVE "MULTIPLY BY" TO FEATURE. NC1204.2 +054600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +054700 MOVE -56 TO MULT4. NC1204.2 +054800 SIG-TEST-GF-3-0. NC1204.2 +054900 MULTIPLY -1.3 BY MULT4 ROUNDED. NC1204.2 +055000 SIG-TEST-GF-3-1. NC1204.2 +055100 IF MULT4 EQUAL TO 73 NC1204.2 +055200 PERFORM PASS NC1204.2 +055300 ELSE NC1204.2 +055400 GO TO SIG-FAIL-GF-3. NC1204.2 +055500 GO TO SIG-WRITE-GF-3. NC1204.2 +055600 SIG-DELETE-GF-3. NC1204.2 +055700 PERFORM DE-LETE. NC1204.2 +055800 GO TO SIG-WRITE-GF-3. NC1204.2 +055900 SIG-FAIL-GF-3. NC1204.2 +056000 PERFORM FAIL. NC1204.2 +056100 MOVE MULT4 TO COMPUTED-N. NC1204.2 +056200 MOVE +73 TO CORRECT-N. NC1204.2 +056300 SIG-WRITE-GF-3. NC1204.2 +056400 MOVE "SIG-TEST-GF-3 " TO PAR-NAME. NC1204.2 +056500 PERFORM PRINT-DETAIL. NC1204.2 +056600 SIG-INIT-GF-4. NC1204.2 +056700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +056800 MOVE 4 TO MULT5. NC1204.2 +056900 MOVE "B" TO XRAY. NC1204.2 +057000 SIG-TEST-GF-4-0. NC1204.2 +057100 MULTIPLY MULT5 BY MULT5 ON SIZE ERROR NC1204.2 +057200 MOVE "K" TO XRAY. NC1204.2 +057300 SIG-TEST-GF-4-1. NC1204.2 +057400 IF XRAY EQUAL TO "K" NC1204.2 +057500 PERFORM PASS NC1204.2 +057600 ELSE NC1204.2 +057700 GO TO SIG-FAIL-GF-4-1. NC1204.2 +057800 GO TO SIG-WRITE-GF-4-1. NC1204.2 +057900 SIG-DELETE-GF-4-1. NC1204.2 +058000 PERFORM DE-LETE. NC1204.2 +058100 GO TO SIG-WRITE-GF-4-1. NC1204.2 +058200 SIG-FAIL-GF-4-1. NC1204.2 +058300 MOVE MULT5 TO COMPUTED-N. NC1204.2 +058400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1204.2 +058500 PERFORM FAIL. NC1204.2 +058600 SIG-WRITE-GF-4-1. NC1204.2 +058700 MOVE "SIG-TEST-GF-4-1 " TO PAR-NAME. NC1204.2 +058800 PERFORM PRINT-DETAIL. NC1204.2 +058900 SIG-TEST-GF-4-2. NC1204.2 +059000 IF MULT5 EQUAL TO 4 NC1204.2 +059100 PERFORM PASS NC1204.2 +059200 ELSE NC1204.2 +059300 GO TO SIG-FAIL-GF-4-2. NC1204.2 +059400 GO TO SIG-WRITE-GF-4-2. NC1204.2 +059500 SIG-DELETE-GF-4-2. NC1204.2 +059600 PERFORM DE-LETE. NC1204.2 +059700 GO TO SIG-WRITE-GF-4-2. NC1204.2 +059800 SIG-FAIL-GF-4-2. NC1204.2 +059900 PERFORM FAIL. NC1204.2 +060000 MOVE MULT5 TO COMPUTED-N. NC1204.2 +060100 MOVE +4 TO CORRECT-N. NC1204.2 +060200 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK. NC1204.2 +060300 SIG-WRITE-GF-4-2. NC1204.2 +060400 MOVE "SIG-TEST-GF-4-2" TO PAR-NAME. NC1204.2 +060500 PERFORM PRINT-DETAIL. NC1204.2 +060600 SIG-INIT-GF-5. NC1204.2 +060700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +060800 MOVE 20 TO MULT6. NC1204.2 +060900 MOVE "C" TO XRAY. NC1204.2 +061000 SIG-TEST-GF-5-0. NC1204.2 +061100 MULTIPLY 4.99 BY MULT6 ROUNDED ON SIZE ERROR NC1204.2 +061200 MOVE "L" TO XRAY. NC1204.2 +061300 SIG-TEST-GF-5-1. NC1204.2 +061400 IF XRAY EQUAL TO "L" NC1204.2 +061500 PERFORM PASS NC1204.2 +061600 ELSE NC1204.2 +061700 GO TO SIG-FAIL-GF-5-1. NC1204.2 +061800 GO TO SIG-WRITE-GF-5-1. NC1204.2 +061900 SIG-DELETE-GF-5-1. NC1204.2 +062000 PERFORM DE-LETE. NC1204.2 +062100 GO TO SIG-WRITE-GF-5-1. NC1204.2 +062200 SIG-FAIL-GF-5-1. NC1204.2 +062300 MOVE MULT6 TO COMPUTED-N. NC1204.2 +062400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1204.2 +062500 PERFORM FAIL. NC1204.2 +062600 SIG-WRITE-GF-5-1. NC1204.2 +062700 MOVE "SIG-TEST-GF-5-1" TO PAR-NAME. NC1204.2 +062800 PERFORM PRINT-DETAIL. NC1204.2 +062900 SIG-TEST-GF-5-2. NC1204.2 +063000 IF MULT6 EQUAL TO 20 NC1204.2 +063100 PERFORM PASS NC1204.2 +063200 ELSE NC1204.2 +063300 GO TO SIG-FAIL-GF-5-2. NC1204.2 +063400 GO TO SIG-WRITE-GF-5-2. NC1204.2 +063500 SIG-DELETE-GF-5-2. NC1204.2 +063600 PERFORM DE-LETE. NC1204.2 +063700 GO TO SIG-WRITE-GF-5-2. NC1204.2 +063800 SIG-FAIL-GF-5-2. NC1204.2 +063900 PERFORM FAIL. NC1204.2 +064000 MOVE MULT6 TO COMPUTED-N. NC1204.2 +064100 MOVE +20 TO CORRECT-N. NC1204.2 +064200 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK. NC1204.2 +064300 SIG-WRITE-GF-5-2. NC1204.2 +064400 MOVE "SIG-TEST-GF-5-2" TO PAR-NAME. NC1204.2 +064500 PERFORM PRINT-DETAIL. NC1204.2 +064600 SIG-INIT-GF-6. NC1204.2 +064700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +064800 MOVE 222222222222 TO WRK-DS-LS-18V00. NC1204.2 +064900 SIG-TEST-GF-6-0. NC1204.2 +065000 MULTIPLY A06THREES-DS-LS-03V03 BY WRK-DS-LS-18V00. NC1204.2 +065100 SIG-TEST-GF-6-1. NC1204.2 +065200 IF WRK-DS-LS-18V00 EQUAL TO 000074073999999925 NC1204.2 +065300 PERFORM PASS NC1204.2 +065400 GO TO SIG-WRITE-GF-6. NC1204.2 +065500 GO TO SIG-FAIL-GF-6. NC1204.2 +065600 SIG-DELETE-GF-6. NC1204.2 +065700 PERFORM DE-LETE. NC1204.2 +065800 GO TO SIG-WRITE-GF-6. NC1204.2 +065900 SIG-FAIL-GF-6. NC1204.2 +066000 MOVE 000074073999999925 TO CORRECT-18V0. NC1204.2 +066100 MOVE WRK-DS-LS-18V00 TO COMPUTED-18V0. NC1204.2 +066200 PERFORM FAIL. NC1204.2 +066300 SIG-WRITE-GF-6. NC1204.2 +066400 MOVE "SIG-TEST-GF-6 " TO PAR-NAME. NC1204.2 +066500 PERFORM PRINT-DETAIL. NC1204.2 +066600 SIG-INIT-GF-7. NC1204.2 +066700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +066800 MOVE A08TWOS-DS-02V06 TO WRK-DS-TS-06V06. NC1204.2 +066900 SIG-TEST-GF-7-0. NC1204.2 +067000 MULTIPLY 0.4 BY WRK-DS-TS-06V06 ROUNDED. NC1204.2 +067100 SIG-TEST-GF-7-1. NC1204.2 +067200 IF WRK-DS-TS-12V00-S-S EQUAL TO 000008888889 NC1204.2 +067300 PERFORM PASS NC1204.2 +067400 GO TO SIG-WRITE-GF-7. NC1204.2 +067500 GO TO SIG-FAIL-GF-7. NC1204.2 +067600 SIG-DELETE-GF-7. NC1204.2 +067700 PERFORM DE-LETE. NC1204.2 +067800 GO TO SIG-WRITE-GF-7. NC1204.2 +067900 SIG-FAIL-GF-7. NC1204.2 +068000 MOVE WRK-DS-TS-12V00-S-S TO COMPUTED-18V0. NC1204.2 +068100 MOVE 000008888889 TO CORRECT-18V0. NC1204.2 +068200 PERFORM FAIL. NC1204.2 +068300 SIG-WRITE-GF-7. NC1204.2 +068400 MOVE "SIG-TEST-GF-7 " TO PAR-NAME. NC1204.2 +068500 PERFORM PRINT-DETAIL. NC1204.2 +068600 SIG-INIT-GF-8. NC1204.2 +068700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +068800 MOVE "0" TO WRK-XN-00001. NC1204.2 +068900 MOVE A10ONES-DS-T-10V00 TO WRK-DS-10V00. NC1204.2 +069000 SIG-TEST-GF-8-0. NC1204.2 +069100 MULTIPLY A12THREES-DS-LS-06V06 BY WRK-DS-10V00 NC1204.2 +069200 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1204.2 +069300 SIG-TEST-GF-8-1. NC1204.2 +069400 IF WRK-DS-10V00 EQUAL TO 1111111111 NC1204.2 +069500 PERFORM PASS NC1204.2 +069600 GO TO SIG-WRITE-GF-8-1. NC1204.2 +069700 GO TO SIG-FAIL-GF-8-1. NC1204.2 +069800 SIG-DELETE-GF-8-1. NC1204.2 +069900 PERFORM DE-LETE. NC1204.2 +070000 GO TO SIG-WRITE-GF-8-1. NC1204.2 +070100 SIG-FAIL-GF-8-1. NC1204.2 +070200 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +070300 MOVE 1111111111 TO CORRECT-18V0. NC1204.2 +070400 PERFORM FAIL. NC1204.2 +070500 SIG-WRITE-GF-8-1. NC1204.2 +070600 MOVE "SIG-TEST-GF-8-1 " TO PAR-NAME. NC1204.2 +070700 PERFORM PRINT-DETAIL. NC1204.2 +070800 SIG-TEST-GF-8-2. NC1204.2 +070900 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +071000 PERFORM PASS NC1204.2 +071100 GO TO SIG-WRITE-GF-8-2. NC1204.2 +071200 MOVE "1" TO CORRECT-A. NC1204.2 +071300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +071400 PERFORM FAIL. NC1204.2 +071500 GO TO SIG-WRITE-GF-8-2. NC1204.2 +071600 SIG-DELETE-GF-8-2. NC1204.2 +071700 PERFORM DE-LETE. NC1204.2 +071800 SIG-WRITE-GF-8-2. NC1204.2 +071900 MOVE "SIG-TEST-GF-8-2 " TO PAR-NAME. NC1204.2 +072000 PERFORM PRINT-DETAIL. NC1204.2 +072100 SIG-INIT-GF-9. NC1204.2 +072200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +072300 MOVE "1" TO WRK-XN-00001. NC1204.2 +072400 MOVE -99 TO WRK-DS-02V00. NC1204.2 +072500 SIG-TEST-GF-9-0. NC1204.2 +072600 MULTIPLY AZERO-DS-LS-05V05 BY WRK-DS-02V00 NC1204.2 +072700 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1204.2 +072800 SIG-TEST-GF-9-1. NC1204.2 +072900 IF WRK-DS-02V00 EQUAL TO 00 NC1204.2 +073000 PERFORM PASS NC1204.2 +073100 GO TO SIG-WRITE-GF-9-1. NC1204.2 +073200 GO TO SIG-FAIL-GF-9-1. NC1204.2 +073300 SIG-DELETE-GF-9-1. NC1204.2 +073400 PERFORM DE-LETE. NC1204.2 +073500 GO TO SIG-WRITE-GF-9-1. NC1204.2 +073600 SIG-FAIL-GF-9-1. NC1204.2 +073700 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1204.2 +073800 MOVE 00 TO CORRECT-N. NC1204.2 +073900 PERFORM FAIL. NC1204.2 +074000 SIG-WRITE-GF-9-1. NC1204.2 +074100 MOVE "SIG-TEST-GF-9-1 " TO PAR-NAME. NC1204.2 +074200 PERFORM PRINT-DETAIL. NC1204.2 +074300 SIG-TEST-GF-9-2. NC1204.2 +074400 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +074500 PERFORM PASS NC1204.2 +074600 GO TO SIG-WRITE-GF-9-2. NC1204.2 +074700 MOVE "1" TO CORRECT-A. NC1204.2 +074800 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +074900 PERFORM FAIL. NC1204.2 +075000 GO TO SIG-WRITE-GF-9-2. NC1204.2 +075100 SIG-DELETE-GF-9-2. NC1204.2 +075200 PERFORM DE-LETE. NC1204.2 +075300 SIG-WRITE-GF-9-2. NC1204.2 +075400 MOVE "SIG-TEST-GF-9-2 " TO PAR-NAME. NC1204.2 +075500 PERFORM PRINT-DETAIL. NC1204.2 +075600 SIG-INIT-GF-10. NC1204.2 +075700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +075800 MOVE "0" TO WRK-XN-00001. NC1204.2 +075900 MOVE -01 TO WRK-DS-02V00. NC1204.2 +076000 SIG-TEST-GF-10-0. NC1204.2 +076100 MULTIPLY 99.5 BY WRK-DS-02V00 ROUNDED NC1204.2 +076200 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1204.2 +076300 SIG-TEST-GF-10-1. NC1204.2 +076400 IF WRK-DS-02V00 EQUAL TO -01 NC1204.2 +076500 PERFORM PASS NC1204.2 +076600 GO TO SIG-WRITE-GF-10-1. NC1204.2 +076700 GO TO SIG-FAIL-GF-10-1. NC1204.2 +076800 SIG-DELETE-GF-10-1. NC1204.2 +076900 PERFORM DE-LETE. NC1204.2 +077000 GO TO SIG-WRITE-GF-10-1. NC1204.2 +077100 SIG-FAIL-GF-10-1. NC1204.2 +077200 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1204.2 +077300 MOVE -01 TO CORRECT-N. NC1204.2 +077400 PERFORM FAIL. NC1204.2 +077500 SIG-WRITE-GF-10-1. NC1204.2 +077600 MOVE "SIG-TEST-GF-10-1 " TO PAR-NAME. NC1204.2 +077700 PERFORM PRINT-DETAIL. NC1204.2 +077800 SIG-TEST-GF-10-2. NC1204.2 +077900 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +078000 PERFORM PASS NC1204.2 +078100 GO TO SIG-WRITE-GF-10-2. NC1204.2 +078200 MOVE "1" TO CORRECT-A. NC1204.2 +078300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +078400 PERFORM FAIL. NC1204.2 +078500 GO TO SIG-WRITE-GF-10-2. NC1204.2 +078600 SIG-DELETE-GF-10-2. NC1204.2 +078700 PERFORM DE-LETE. NC1204.2 +078800 SIG-WRITE-GF-10-2. NC1204.2 +078900 MOVE "SIG-TEST-GF-10-2 " TO PAR-NAME. NC1204.2 +079000 PERFORM PRINT-DETAIL. NC1204.2 +079100 SIG-INIT-GF-11. NC1204.2 +079200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +079300 MOVE "1" TO WRK-XN-00001. NC1204.2 +079400 MOVE -01 TO WRK-DS-02V00. NC1204.2 +079500 SIG-TEST-GF-11-0. NC1204.2 +079600 MULTIPLY 99.4 BY WRK-DS-02V00 ROUNDED NC1204.2 +079700 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1204.2 +079800 SIG-TEST-GF-11-1. NC1204.2 +079900 IF WRK-DS-02V00 EQUAL TO -99 NC1204.2 +080000 PERFORM PASS NC1204.2 +080100 GO TO SIG-WRITE-GF-11-1. NC1204.2 +080200 GO TO SIG-FAIL-GF-11-1. NC1204.2 +080300 SIG-DELETE-GF-11-1. NC1204.2 +080400 PERFORM DE-LETE. NC1204.2 +080500 GO TO SIG-WRITE-GF-11-1. NC1204.2 +080600 SIG-FAIL-GF-11-1. NC1204.2 +080700 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1204.2 +080800 MOVE -99 TO CORRECT-N. NC1204.2 +080900 PERFORM FAIL. NC1204.2 +081000 SIG-WRITE-GF-11-1. NC1204.2 +081100 MOVE "SIG-TEST-GF-11-1 " TO PAR-NAME. NC1204.2 +081200 PERFORM PRINT-DETAIL. NC1204.2 +081300 SIG-TEST-GF-11-2. NC1204.2 +081400 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +081500 PERFORM PASS NC1204.2 +081600 GO TO SIG-WRITE-GF-11-2. NC1204.2 +081700 MOVE "1" TO CORRECT-A. NC1204.2 +081800 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +081900 PERFORM FAIL. NC1204.2 +082000 GO TO SIG-WRITE-GF-11-2. NC1204.2 +082100 SIG-DELETE-GF-11-2. NC1204.2 +082200 PERFORM DE-LETE. NC1204.2 +082300 SIG-WRITE-GF-11-2. NC1204.2 +082400 MOVE "SIG-TEST-GF-11-2 " TO PAR-NAME. NC1204.2 +082500 PERFORM PRINT-DETAIL. NC1204.2 +082600 SIG-INIT-GF-17. NC1204.2 +082700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +082800 MOVE "MULTIPLY BY GIVING " TO FEATURE. NC1204.2 +082900 MOVE ZERO TO WRK-DS-09V09. NC1204.2 +083000 SIG-TEST-GF-17-0. NC1204.2 +083100 MULTIPLY A06THREES-DS-LS-03V03 BY A12THREES-DS-LS-06V06 NC1204.2 +083200 GIVING WRK-DS-09V09. NC1204.2 +083300 SIG-TEST-GF-17-1. NC1204.2 +083400 IF WRK-DS-18V00-S EQUAL TO 111110999999888889 NC1204.2 +083500 PERFORM PASS NC1204.2 +083600 GO TO SIG-WRITE-GF-17. NC1204.2 +083700 GO TO SIG-FAIL-GF-17. NC1204.2 +083800 SIG-DELETE-GF-17. NC1204.2 +083900 PERFORM DE-LETE. NC1204.2 +084000 GO TO SIG-WRITE-GF-17. NC1204.2 +084100 SIG-FAIL-GF-17. NC1204.2 +084200 MOVE 111110999999888889 TO CORRECT-18V0. NC1204.2 +084300 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1204.2 +084400 PERFORM FAIL. NC1204.2 +084500 SIG-WRITE-GF-17. NC1204.2 +084600 MOVE "SIG-TEST-GF-17 " TO PAR-NAME. NC1204.2 +084700 PERFORM PRINT-DETAIL. NC1204.2 +084800 SIG-INIT-GF-18. NC1204.2 +084900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +085000 MOVE ZERO TO WRK-DS-10V00. NC1204.2 +085100 SIG-TEST-GF-18-0. NC1204.2 +085200 MULTIPLY A06THREES-DS-LS-03V03 BY A06THREES-DS-LS-03V03 NC1204.2 +085300 GIVING WRK-DS-10V00 ROUNDED. NC1204.2 +085400 SIG-TEST-GF-18-1. NC1204.2 +085500 IF WRK-DS-10V00 EQUAL TO 0000111111 NC1204.2 +085600 PERFORM PASS NC1204.2 +085700 GO TO SIG-WRITE-GF-18. NC1204.2 +085800 GO TO SIG-FAIL-GF-18. NC1204.2 +085900 SIG-DELETE-GF-18. NC1204.2 +086000 PERFORM DE-LETE. NC1204.2 +086100 GO TO SIG-WRITE-GF-18. NC1204.2 +086200 SIG-FAIL-GF-18. NC1204.2 +086300 MOVE 0000111111 TO CORRECT-18V0. NC1204.2 +086400 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +086500 PERFORM FAIL. NC1204.2 +086600 SIG-WRITE-GF-18. NC1204.2 +086700 MOVE "SIG-TEST-GF-18 " TO PAR-NAME. NC1204.2 +086800 PERFORM PRINT-DETAIL. NC1204.2 +086900 SIG-INIT-GF-19. NC1204.2 +087000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +087100 MOVE "0" TO WRK-XN-00001. NC1204.2 +087200 MOVE ZERO TO WRK-DS-10V00. NC1204.2 +087300 SIG-TEST-GF-19-0. NC1204.2 +087400 MULTIPLY A05ONES-DS-LS-00V05 BY A12ONES-DS-12V00 NC1204.2 +087500 GIVING WRK-DS-10V00 ON SIZE ERROR NC1204.2 +087600 MOVE "1" TO WRK-XN-00001. NC1204.2 +087700 SIG-TEST-GF-19-1. NC1204.2 +087800 IF WRK-DS-10V00 EQUAL TO 0000000000 NC1204.2 +087900 PERFORM PASS NC1204.2 +088000 GO TO SIG-WRITE-GF-19-1. NC1204.2 +088100 GO TO SIG-FAIL-GF-19-1. NC1204.2 +088200 SIG-DELETE-GF-19-1. NC1204.2 +088300 PERFORM DE-LETE. NC1204.2 +088400 GO TO SIG-WRITE-GF-19-1. NC1204.2 +088500 SIG-FAIL-GF-19-1. NC1204.2 +088600 MOVE 0000000000 TO CORRECT-18V0. NC1204.2 +088700 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +088800 PERFORM FAIL. NC1204.2 +088900 SIG-WRITE-GF-19-1. NC1204.2 +089000 MOVE "SIG-TEST-GF-19-1 " TO PAR-NAME. NC1204.2 +089100 PERFORM PRINT-DETAIL. NC1204.2 +089200 SIG-TEST-GF-19-2. NC1204.2 +089300 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +089400 PERFORM PASS NC1204.2 +089500 GO TO SIG-WRITE-GF-19-2. NC1204.2 +089600 MOVE "1" TO CORRECT-A. NC1204.2 +089700 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +089800 PERFORM FAIL. NC1204.2 +089900 GO TO SIG-WRITE-GF-19-2. NC1204.2 +090000 SIG-DELETE-GF-19-2. NC1204.2 +090100 PERFORM DE-LETE. NC1204.2 +090200 SIG-WRITE-GF-19-2. NC1204.2 +090300 MOVE "SIG-TEST-GF-19-2 " TO PAR-NAME. NC1204.2 +090400 PERFORM PRINT-DETAIL. NC1204.2 +090500 SIG-INIT-GF-20. NC1204.2 +090600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +090700 MOVE "1" TO WRK-XN-00001. NC1204.2 +090800 MOVE ZERO TO WRK-DS-10V00. NC1204.2 +090900 SIG-TEST-GF-20-0. NC1204.2 +091000 MULTIPLY A01ONE-DS-TS-P0801 BY A12ONES-DS-12V00 NC1204.2 +091100 GIVING WRK-DS-10V00 ON SIZE ERROR NC1204.2 +091200 MOVE "0" TO WRK-XN-00001. NC1204.2 +091300 SIG-TEST-GF-20-1. NC1204.2 +091400 IF WRK-DS-10V00 EQUAL TO 0000000111 NC1204.2 +091500 PERFORM PASS NC1204.2 +091600 GO TO SIG-WRITE-GF-20-1. NC1204.2 +091700 GO TO SIG-FAIL-GF-20-1. NC1204.2 +091800 SIG-DELETE-GF-20-1. NC1204.2 +091900 PERFORM DE-LETE. NC1204.2 +092000 GO TO SIG-WRITE-GF-20-1. NC1204.2 +092100 SIG-FAIL-GF-20-1. NC1204.2 +092200 MOVE 0000000111 TO CORRECT-18V0. NC1204.2 +092300 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +092400 PERFORM FAIL. NC1204.2 +092500 SIG-WRITE-GF-20-1. NC1204.2 +092600 MOVE "SIG-TEST-GF-20-1 " TO PAR-NAME. NC1204.2 +092700 PERFORM PRINT-DETAIL. NC1204.2 +092800 SIG-TEST-GF-20-2. NC1204.2 +092900 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +093000 PERFORM PASS NC1204.2 +093100 GO TO SIG-WRITE-GF-20-2. NC1204.2 +093200 MOVE "1" TO CORRECT-A. NC1204.2 +093300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +093400 PERFORM FAIL. NC1204.2 +093500 GO TO SIG-WRITE-GF-20-2. NC1204.2 +093600 SIG-DELETE-GF-20-2. NC1204.2 +093700 PERFORM DE-LETE. NC1204.2 +093800 SIG-WRITE-GF-20-2. NC1204.2 +093900 MOVE "SIG-TEST-GF-20-2 " TO PAR-NAME. NC1204.2 +094000 PERFORM PRINT-DETAIL. NC1204.2 +094100 SIG-INIT-GF-21. NC1204.2 +094200 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +094300 MOVE "0" TO WRK-XN-00001. NC1204.2 +094400 MOVE ZERO TO WRK-DS-10V00. NC1204.2 +094500 SIG-TEST-GF-21-0. NC1204.2 +094600 MULTIPLY 9.5 BY A10ONES-DS-T-10V00 NC1204.2 +094700 GIVING WRK-DS-10V00 ROUNDED ON SIZE ERROR NC1204.2 +094800 MOVE "1" TO WRK-XN-00001. NC1204.2 +094900 SIG-TEST-GF-21-1. NC1204.2 +095000 IF WRK-DS-10V00 EQUAL TO 0000000000 NC1204.2 +095100 PERFORM PASS NC1204.2 +095200 GO TO SIG-WRITE-GF-21-1. NC1204.2 +095300 MOVE 0000000000 TO CORRECT-18V0. NC1204.2 +095400 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1204.2 +095500 PERFORM FAIL. NC1204.2 +095600 GO TO SIG-WRITE-GF-21-1. NC1204.2 +095700 SIG-DELETE-GF-21-1. NC1204.2 +095800 PERFORM DE-LETE. NC1204.2 +095900 SIG-WRITE-GF-21-1. NC1204.2 +096000 MOVE "SIG-TEST-GF-21-1 " TO PAR-NAME. NC1204.2 +096100 PERFORM PRINT-DETAIL. NC1204.2 +096200 SIG-TEST-GF-21-2. NC1204.2 +096300 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +096400 PERFORM PASS NC1204.2 +096500 GO TO SIG-WRITE-GF-21-2. NC1204.2 +096600 MOVE "1" TO CORRECT-A. NC1204.2 +096700 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +096800 PERFORM FAIL. NC1204.2 +096900 GO TO SIG-WRITE-GF-21-2. NC1204.2 +097000 SIG-DELETE-GF-21-2. NC1204.2 +097100 PERFORM DE-LETE. NC1204.2 +097200 SIG-WRITE-GF-21-2. NC1204.2 +097300 MOVE "SIG-TEST-GF-21-2 " TO PAR-NAME. NC1204.2 +097400 PERFORM PRINT-DETAIL. NC1204.2 +097500 SIG-INIT-GF-22. NC1204.2 +097600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +097700 MOVE "1" TO WRK-XN-00001. NC1204.2 +097800 MOVE ZERO TO WRK-DS-T-09V08. NC1204.2 +097900 SIG-TEST-GF-22-0. NC1204.2 +098000 MULTIPLY A01ONE-DS-TS-P0801 BY A18ONES-DS-18V00 NC1204.2 +098100 GIVING WRK-DS-T-09V08 ROUNDED ON SIZE ERROR NC1204.2 +098200 MOVE "0" TO WRK-XN-00001. NC1204.2 +098300 SIG-TEST-GF-22-1. NC1204.2 +098400 IF WKR-DS-T-17V00-S EQUAL TO 11111111111111111 NC1204.2 +098500 PERFORM PASS NC1204.2 +098600 GO TO SIG-WRITE-GF-22-1. NC1204.2 +098700 MOVE 11111111111111111 TO CORRECT-18V0. NC1204.2 +098800 MOVE WKR-DS-T-17V00-S TO COMPUTED-18V0. NC1204.2 +098900 PERFORM FAIL. NC1204.2 +099000 GO TO SIG-WRITE-GF-22-1. NC1204.2 +099100 SIG-DELETE-GF-22-1. NC1204.2 +099200 PERFORM DE-LETE. NC1204.2 +099300 SIG-WRITE-GF-22-1. NC1204.2 +099400 MOVE "SIG-TEST-GF-22-1 " TO PAR-NAME. NC1204.2 +099500 PERFORM PRINT-DETAIL. NC1204.2 +099600 SIG-TEST-GF-22-2. NC1204.2 +099700 IF WRK-XN-00001 EQUAL TO "1" NC1204.2 +099800 PERFORM PASS NC1204.2 +099900 GO TO SIG-WRITE-GF-22-2. NC1204.2 +100000 MOVE "1" TO CORRECT-A. NC1204.2 +100100 MOVE WRK-XN-00001 TO COMPUTED-A. NC1204.2 +100200 PERFORM FAIL. NC1204.2 +100300 GO TO SIG-WRITE-GF-22-2. NC1204.2 +100400 SIG-DELETE-GF-22-2. NC1204.2 +100500 PERFORM DE-LETE. NC1204.2 +100600 SIG-WRITE-GF-22-2. NC1204.2 +100700 MOVE "SIG-TEST-GF-22-2 " TO PAR-NAME. NC1204.2 +100800 PERFORM PRINT-DETAIL. NC1204.2 +100900 SIG-INIT-GF-12. NC1204.2 +101000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +101100 MOVE "MULTIPLY BY " TO FEATURE. NC1204.2 +101200 MOVE -990 TO WRK-DS-LS-0201P. NC1204.2 +101300 SIG-TEST-GF-12-0. NC1204.2 +101400 MULTIPLY A01ONE-CS-00V01 BY WRK-DS-LS-0201P. NC1204.2 +101500 SIG-TEST-GF-12-1. NC1204.2 +101600 MOVE WRK-DS-LS-0201P TO WRK-DS-05V00. NC1204.2 +101700 IF WRK-DS-05V00 EQUAL TO -00090 NC1204.2 +101800 PERFORM PASS NC1204.2 +101900 GO TO SIG-WRITE-GF-12. NC1204.2 +102000 MOVE -00090 TO CORRECT-N. NC1204.2 +102100 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1204.2 +102200 PERFORM FAIL. NC1204.2 +102300 GO TO SIG-WRITE-GF-12. NC1204.2 +102400 SIG-DELETE-GF-12. NC1204.2 +102500 PERFORM DE-LETE. NC1204.2 +102600 SIG-WRITE-GF-12. NC1204.2 +102700 MOVE "SIG-TEST-GF-12 " TO PAR-NAME. NC1204.2 +102800 PERFORM PRINT-DETAIL. NC1204.2 +102900 SIG-INIT-GF-13. NC1204.2 +103000 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +103100 MOVE A18ONES-DS-18V00 TO WRK-CS-18V00. NC1204.2 +103200 SIG-TEST-GF-13-0. NC1204.2 +103300 MULTIPLY A01ONE-DS-TS-P0801 BY WRK-CS-18V00. NC1204.2 +103400 SIG-TEST-GF-13-1. NC1204.2 +103500 MOVE WRK-CS-18V00 TO WRK-DU-18V00. NC1204.2 +103600 IF WRK-DU-18V00 EQUAL TO 000000000111111111 NC1204.2 +103700 PERFORM PASS NC1204.2 +103800 GO TO SIG-WRITE-GF-13. NC1204.2 +103900 MOVE 000000000111111111 TO CORRECT-18V0. NC1204.2 +104000 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1204.2 +104100 PERFORM FAIL. NC1204.2 +104200 GO TO SIG-WRITE-GF-13. NC1204.2 +104300 SIG-DELETE-GF-13. NC1204.2 +104400 PERFORM DE-LETE. NC1204.2 +104500 SIG-WRITE-GF-13. NC1204.2 +104600 MOVE "SIG-TEST-GF-13 " TO PAR-NAME. NC1204.2 +104700 PERFORM PRINT-DETAIL. NC1204.2 +104800 SIG-INIT-GF-23. NC1204.2 +104900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +105000 MOVE ZERO TO WRK-CS-02V02. NC1204.2 +105100 SIG-TEST-GF-23-0. NC1204.2 +105200 MULTIPLY A99-CS-02V00 BY A01ONE-CS-00V01 GIVING WRK-CS-02V02.NC1204.2 +105300 SIG-TEST-GF-23-1. NC1204.2 +105400 MOVE WRK-CS-02V02 TO WRK-DS-TS-06V06. NC1204.2 +105500 IF WRK-DS-TS-12V00-S-S EQUAL TO 000009900000 NC1204.2 +105600 PERFORM PASS NC1204.2 +105700 GO TO SIG-WRITE-GF-23. NC1204.2 +105800 MOVE 000009900000 TO CORRECT-18V0. NC1204.2 +105900 MOVE WRK-DS-TS-12V00-S-S TO COMPUTED-18V0. NC1204.2 +106000 PERFORM FAIL. NC1204.2 +106100 GO TO SIG-WRITE-GF-23. NC1204.2 +106200 SIG-DELETE-GF-23. NC1204.2 +106300 PERFORM DE-LETE. NC1204.2 +106400 SIG-WRITE-GF-23. NC1204.2 +106500 MOVE "MULTIPLY BY GIVING " TO FEATURE. NC1204.2 +106600 MOVE "SIG-TEST-GF-23 " TO PAR-NAME. NC1204.2 +106700 PERFORM PRINT-DETAIL. NC1204.2 +106800 SIG-INIT-GF-24. NC1204.2 +106900 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +107000 MOVE ZERO TO WRK-CS-18V00. NC1204.2 +107100 SIG-TEST-GF-24-0. NC1204.2 +107200 MULTIPLY A01ONES-CS-18V00 BY A02THREES-CS-18V00 NC1204.2 +107300 GIVING WRK-CS-18V00. NC1204.2 +107400 SIG-TEST-GF-24-1. NC1204.2 +107500 IF WRK-CS-18V00 EQUAL TO -000000000000000033 NC1204.2 +107600 PERFORM PASS NC1204.2 +107700 GO TO SIG-WRITE-GF-24. NC1204.2 +107800 MOVE -000000000000000033 TO CORRECT-18V0. NC1204.2 +107900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1204.2 +108000 PERFORM FAIL. NC1204.2 +108100 GO TO SIG-WRITE-GF-24. NC1204.2 +108200 SIG-DELETE-GF-24. NC1204.2 +108300 PERFORM DE-LETE. NC1204.2 +108400 SIG-WRITE-GF-24. NC1204.2 +108500 MOVE "SIG-TEST-GF-24 " TO PAR-NAME. NC1204.2 +108600 PERFORM PRINT-DETAIL. NC1204.2 +108700 SIG-INIT-GF-25. NC1204.2 +108800 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +108900 MOVE ZERO TO WRK-DU-18V00. NC1204.2 +109000 SIG-TEST-GF-25-0. NC1204.2 +109100 MULTIPLY A02THREES-CS-18V00 BY A14TWOS-CU-18V00 NC1204.2 +109200 GIVING WRK-DU-18V00. NC1204.2 +109300 SIG-TEST-GF-25-1. NC1204.2 +109400 IF WRK-DU-18V00 EQUAL TO 000733333333333326 NC1204.2 +109500 PERFORM PASS NC1204.2 +109600 GO TO SIG-WRITE-GF-25. NC1204.2 +109700 MOVE 000733333333333326 TO CORRECT-18V0. NC1204.2 +109800 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1204.2 +109900 PERFORM FAIL. NC1204.2 +110000 GO TO SIG-WRITE-GF-25. NC1204.2 +110100 SIG-DELETE-GF-25. NC1204.2 +110200 PERFORM DE-LETE. NC1204.2 +110300 SIG-WRITE-GF-25. NC1204.2 +110400 MOVE "SIG-TEST-GF-25 " TO PAR-NAME. NC1204.2 +110500 PERFORM PRINT-DETAIL. NC1204.2 +110600 SIG-INIT-GF-26. NC1204.2 +110700 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +110800 MOVE ZERO TO WRK-CS-18V00. NC1204.2 +110900 SIG-TEST-GF-26-0. NC1204.2 +111000 MULTIPLY A02THREES-CS-18V00 BY A16NINES-CU-18V00 NC1204.2 +111100 GIVING WRK-CS-18V00. NC1204.2 +111200 SIG-TEST-GF-26-1. NC1204.2 +111300 IF WRK-CS-18V00 EQUAL TO -329999999999999967 NC1204.2 +111400 PERFORM PASS NC1204.2 +111500 GO TO SIG-WRITE-GF-26. NC1204.2 +111600 MOVE -329999999999999967 TO CORRECT-18V0. NC1204.2 +111700 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1204.2 +111800 PERFORM FAIL. NC1204.2 +111900 GO TO SIG-WRITE-GF-26. NC1204.2 +112000 SIG-DELETE-GF-26. NC1204.2 +112100 PERFORM DE-LETE. NC1204.2 +112200 SIG-WRITE-GF-26. NC1204.2 +112300 MOVE "SIG-TEST-GF-26 " TO PAR-NAME. NC1204.2 +112400 PERFORM PRINT-DETAIL. NC1204.2 +112500 SIG-INIT-GF-27. NC1204.2 +112600 MOVE "VI-42 5.12.4" TO ANSI-REFERENCE. NC1204.2 +112700 MOVE ZERO TO WRK-DU-18V00. NC1204.2 +112800 SIG-TEST-GF-27-0. NC1204.2 +112900 MULTIPLY A01ONES-CS-18V00 BY A18SIXES-CU-18V00 NC1204.2 +113000 GIVING WRK-DU-18V00. NC1204.2 +113100 SIG-TEST-GF-27-1. NC1204.2 +113200 IF WRK-DU-18V00 EQUAL TO 666666666666666666 NC1204.2 +113300 PERFORM PASS NC1204.2 +113400 GO TO SIG-WRITE-GF-27. NC1204.2 +113500 MOVE 666666666666666666 TO CORRECT-18V0. NC1204.2 +113600 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1204.2 +113700 PERFORM FAIL. NC1204.2 +113800 GO TO SIG-WRITE-GF-27. NC1204.2 +113900 SIG-DELETE-GF-27. NC1204.2 +114000 PERFORM DE-LETE. NC1204.2 +114100 SIG-WRITE-GF-27. NC1204.2 +114200 MOVE "SIG-TEST-GF-27 " TO PAR-NAME. NC1204.2 +114300 PERFORM PRINT-DETAIL. NC1204.2 +114400 PERFORM END-ROUTINE. NC1204.2 +114500 CCVS-EXIT SECTION. NC1204.2 +114600 CCVS-999999. NC1204.2 +114700 GO TO CLOSE-FILES. NC1204.2 diff --git a/tests/cobol85/NC/NC121M.CBL b/tests/cobol85/NC/NC121M.CBL new file mode 100755 index 00000000..a07b18df --- /dev/null +++ b/tests/cobol85/NC/NC121M.CBL @@ -0,0 +1,1288 @@ +000100 IDENTIFICATION DIVISION. NC1214.2 +000200 PROGRAM-ID. NC1214.2 +000300 NC121M. NC1214.2 +000400**************************************************************** NC1214.2 +000500* * NC1214.2 +000600* VALIDATION FOR:- * NC1214.2 +000700* * NC1214.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1214.2 +000900* * NC1214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1214.2 +001100* * NC1214.2 +001200**************************************************************** NC1214.2 +001300* * NC1214.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1214.2 +001500* * NC1214.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1214.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1214.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1214.2 +001900* * NC1214.2 +002000**************************************************************** NC1214.2 +002100* NC1214.2 +002200* PROGRAM NC121M TESTS THE USE OF INDEXED IDENTIFIERS WITH NC1214.2 +002300* FORMATS 1 AND 2 OF THE "MULTIPLY" STATEMENT, FORMATS NC1214.2 +002400* 1, 2 AND 3 OF THE "DIVIDE" STATEMENT, FORMATS 1 AND 2 OF NC1214.2 +002500* THE "PERFORM" STATEMENT AND THE "DISPLAY" STATEMENT NC1214.2 +002600* GENERAL FORMAT. NC1214.2 +002700* ONE AND TWO LEVELS OF INDEXING ARE USED AS WELL AS NC1214.2 +002800* RELATIVE INDEXING. NC1214.2 +002900* NC1214.2 +003000 ENVIRONMENT DIVISION. NC1214.2 +003100 CONFIGURATION SECTION. NC1214.2 +003200 SOURCE-COMPUTER. NC1214.2 +003300 Linux. NC1214.2 +003400 OBJECT-COMPUTER. NC1214.2 +003500 Linux. NC1214.2 +003600 INPUT-OUTPUT SECTION. NC1214.2 +003700 FILE-CONTROL. NC1214.2 +003800 SELECT PRINT-FILE ASSIGN TO NC1214.2 +003900 "report.log". NC1214.2 +004000 DATA DIVISION. NC1214.2 +004100 FILE SECTION. NC1214.2 +004200 FD PRINT-FILE. NC1214.2 +004300 01 PRINT-REC PICTURE X(120). NC1214.2 +004400 01 DUMMY-RECORD PICTURE X(120). NC1214.2 +004500 WORKING-STORAGE SECTION. NC1214.2 +004600 01 TABLE1. NC1214.2 +004700 02 TABLE1-NUM PICTURE S9V99 NC1214.2 +004800 OCCURS 10 TIMES NC1214.2 +004900 INDEXED BY INDEX1. NC1214.2 +005000 01 TABLE2. NC1214.2 +005100 02 TABLE2-NUM PICTURE 9V9 NC1214.2 +005200 OCCURS 6 TIMES NC1214.2 +005300 INDEXED BY INDEX2. NC1214.2 +005400 01 TABLE3. NC1214.2 +005500 02 TABLE3-NUM PICTURE 99V9 NC1214.2 +005600 OCCURS 6 TIMES NC1214.2 +005700 INDEXED BY INDEX3. NC1214.2 +005800 01 TABLE4. NC1214.2 +005900 02 TABLE4-NUM1 OCCURS 3 TIMES NC1214.2 +006000 INDEXED BY INDEX4-1. NC1214.2 +006100 03 TABLE4-NUM2 PICTURE 99 NC1214.2 +006200 OCCURS 3 TIMES NC1214.2 +006300 INDEXED BY INDEX4-2. NC1214.2 +006400 01 TABLE5. NC1214.2 +006500 02 TABLE5-NUM PIC 9 NC1214.2 +006600 OCCURS 2 TIMES NC1214.2 +006700 INDEXED BY INDEX5. NC1214.2 +006800 01 TABLE6. NC1214.2 +006900 02 TABLE6-REC PICTURE X(10) NC1214.2 +007000 OCCURS 2 TIMES NC1214.2 +007100 INDEXED BY INDEX6. NC1214.2 +007200 01 NUM-9V9 PICTURE 9V9. NC1214.2 +007300 01 TEST-RESULTS. NC1214.2 +007400 02 FILLER PIC X VALUE SPACE. NC1214.2 +007500 02 FEATURE PIC X(20) VALUE SPACE. NC1214.2 +007600 02 FILLER PIC X VALUE SPACE. NC1214.2 +007700 02 P-OR-F PIC X(5) VALUE SPACE. NC1214.2 +007800 02 FILLER PIC X VALUE SPACE. NC1214.2 +007900 02 PAR-NAME. NC1214.2 +008000 03 FILLER PIC X(19) VALUE SPACE. NC1214.2 +008100 03 PARDOT-X PIC X VALUE SPACE. NC1214.2 +008200 03 DOTVALUE PIC 99 VALUE ZERO. NC1214.2 +008300 02 FILLER PIC X(8) VALUE SPACE. NC1214.2 +008400 02 RE-MARK PIC X(61). NC1214.2 +008500 01 TEST-COMPUTED. NC1214.2 +008600 02 FILLER PIC X(30) VALUE SPACE. NC1214.2 +008700 02 FILLER PIC X(17) VALUE NC1214.2 +008800 " COMPUTED=". NC1214.2 +008900 02 COMPUTED-X. NC1214.2 +009000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1214.2 +009100 03 COMPUTED-N REDEFINES COMPUTED-A NC1214.2 +009200 PIC -9(9).9(9). NC1214.2 +009300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1214.2 +009400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1214.2 +009500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1214.2 +009600 03 CM-18V0 REDEFINES COMPUTED-A. NC1214.2 +009700 04 COMPUTED-18V0 PIC -9(18). NC1214.2 +009800 04 FILLER PIC X. NC1214.2 +009900 03 FILLER PIC X(50) VALUE SPACE. NC1214.2 +010000 01 TEST-CORRECT. NC1214.2 +010100 02 FILLER PIC X(30) VALUE SPACE. NC1214.2 +010200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1214.2 +010300 02 CORRECT-X. NC1214.2 +010400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1214.2 +010500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1214.2 +010600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1214.2 +010700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1214.2 +010800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1214.2 +010900 03 CR-18V0 REDEFINES CORRECT-A. NC1214.2 +011000 04 CORRECT-18V0 PIC -9(18). NC1214.2 +011100 04 FILLER PIC X. NC1214.2 +011200 03 FILLER PIC X(2) VALUE SPACE. NC1214.2 +011300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1214.2 +011400 01 CCVS-C-1. NC1214.2 +011500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1214.2 +011600- "SS PARAGRAPH-NAME NC1214.2 +011700- " REMARKS". NC1214.2 +011800 02 FILLER PIC X(20) VALUE SPACE. NC1214.2 +011900 01 CCVS-C-2. NC1214.2 +012000 02 FILLER PIC X VALUE SPACE. NC1214.2 +012100 02 FILLER PIC X(6) VALUE "TESTED". NC1214.2 +012200 02 FILLER PIC X(15) VALUE SPACE. NC1214.2 +012300 02 FILLER PIC X(4) VALUE "FAIL". NC1214.2 +012400 02 FILLER PIC X(94) VALUE SPACE. NC1214.2 +012500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1214.2 +012600 01 REC-CT PIC 99 VALUE ZERO. NC1214.2 +012700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1214.2 +012800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1214.2 +012900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1214.2 +013000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1214.2 +013100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1214.2 +013200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1214.2 +013300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1214.2 +013400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1214.2 +013500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1214.2 +013600 01 CCVS-H-1. NC1214.2 +013700 02 FILLER PIC X(39) VALUE SPACES. NC1214.2 +013800 02 FILLER PIC X(42) VALUE NC1214.2 +013900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1214.2 +014000 02 FILLER PIC X(39) VALUE SPACES. NC1214.2 +014100 01 CCVS-H-2A. NC1214.2 +014200 02 FILLER PIC X(40) VALUE SPACE. NC1214.2 +014300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1214.2 +014400 02 FILLER PIC XXXX VALUE NC1214.2 +014500 "4.2 ". NC1214.2 +014600 02 FILLER PIC X(28) VALUE NC1214.2 +014700 " COPY - NOT FOR DISTRIBUTION". NC1214.2 +014800 02 FILLER PIC X(41) VALUE SPACE. NC1214.2 +014900 NC1214.2 +015000 01 CCVS-H-2B. NC1214.2 +015100 02 FILLER PIC X(15) VALUE NC1214.2 +015200 "TEST RESULT OF ". NC1214.2 +015300 02 TEST-ID PIC X(9). NC1214.2 +015400 02 FILLER PIC X(4) VALUE NC1214.2 +015500 " IN ". NC1214.2 +015600 02 FILLER PIC X(12) VALUE NC1214.2 +015700 " HIGH ". NC1214.2 +015800 02 FILLER PIC X(22) VALUE NC1214.2 +015900 " LEVEL VALIDATION FOR ". NC1214.2 +016000 02 FILLER PIC X(58) VALUE NC1214.2 +016100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1214.2 +016200 01 CCVS-H-3. NC1214.2 +016300 02 FILLER PIC X(34) VALUE NC1214.2 +016400 " FOR OFFICIAL USE ONLY ". NC1214.2 +016500 02 FILLER PIC X(58) VALUE NC1214.2 +016600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1214.2 +016700 02 FILLER PIC X(28) VALUE NC1214.2 +016800 " COPYRIGHT 1985 ". NC1214.2 +016900 01 CCVS-E-1. NC1214.2 +017000 02 FILLER PIC X(52) VALUE SPACE. NC1214.2 +017100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1214.2 +017200 02 ID-AGAIN PIC X(9). NC1214.2 +017300 02 FILLER PIC X(45) VALUE SPACES. NC1214.2 +017400 01 CCVS-E-2. NC1214.2 +017500 02 FILLER PIC X(31) VALUE SPACE. NC1214.2 +017600 02 FILLER PIC X(21) VALUE SPACE. NC1214.2 +017700 02 CCVS-E-2-2. NC1214.2 +017800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1214.2 +017900 03 FILLER PIC X VALUE SPACE. NC1214.2 +018000 03 ENDER-DESC PIC X(44) VALUE NC1214.2 +018100 "ERRORS ENCOUNTERED". NC1214.2 +018200 01 CCVS-E-3. NC1214.2 +018300 02 FILLER PIC X(22) VALUE NC1214.2 +018400 " FOR OFFICIAL USE ONLY". NC1214.2 +018500 02 FILLER PIC X(12) VALUE SPACE. NC1214.2 +018600 02 FILLER PIC X(58) VALUE NC1214.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1214.2 +018800 02 FILLER PIC X(13) VALUE SPACE. NC1214.2 +018900 02 FILLER PIC X(15) VALUE NC1214.2 +019000 " COPYRIGHT 1985". NC1214.2 +019100 01 CCVS-E-4. NC1214.2 +019200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1214.2 +019300 02 FILLER PIC X(4) VALUE " OF ". NC1214.2 +019400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1214.2 +019500 02 FILLER PIC X(40) VALUE NC1214.2 +019600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1214.2 +019700 01 XXINFO. NC1214.2 +019800 02 FILLER PIC X(19) VALUE NC1214.2 +019900 "*** INFORMATION ***". NC1214.2 +020000 02 INFO-TEXT. NC1214.2 +020100 04 FILLER PIC X(8) VALUE SPACE. NC1214.2 +020200 04 XXCOMPUTED PIC X(20). NC1214.2 +020300 04 FILLER PIC X(5) VALUE SPACE. NC1214.2 +020400 04 XXCORRECT PIC X(20). NC1214.2 +020500 02 INF-ANSI-REFERENCE PIC X(48). NC1214.2 +020600 01 HYPHEN-LINE. NC1214.2 +020700 02 FILLER PIC IS X VALUE IS SPACE. NC1214.2 +020800 02 FILLER PIC IS X(65) VALUE IS "************************NC1214.2 +020900- "*****************************************". NC1214.2 +021000 02 FILLER PIC IS X(54) VALUE IS "************************NC1214.2 +021100- "******************************". NC1214.2 +021200 01 CCVS-PGM-ID PIC X(9) VALUE NC1214.2 +021300 "NC121M". NC1214.2 +021400 PROCEDURE DIVISION. NC1214.2 +021500 CCVS1 SECTION. NC1214.2 +021600 OPEN-FILES. NC1214.2 +021700 OPEN OUTPUT PRINT-FILE. NC1214.2 +021800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1214.2 +021900 MOVE SPACE TO TEST-RESULTS. NC1214.2 +022000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1214.2 +022100 GO TO CCVS1-EXIT. NC1214.2 +022200 CLOSE-FILES. NC1214.2 +022300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1214.2 +022400 TERMINATE-CCVS. NC1214.2 +022500*S EXIT PROGRAM. NC1214.2 +022600*SERMINATE-CALL. NC1214.2 +022700 STOP RUN. NC1214.2 +022800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1214.2 +022900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1214.2 +023000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1214.2 +023100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1214.2 +023200 MOVE "****TEST DELETED****" TO RE-MARK. NC1214.2 +023300 PRINT-DETAIL. NC1214.2 +023400 IF REC-CT NOT EQUAL TO ZERO NC1214.2 +023500 MOVE "." TO PARDOT-X NC1214.2 +023600 MOVE REC-CT TO DOTVALUE. NC1214.2 +023700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1214.2 +023800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1214.2 +023900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1214.2 +024000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1214.2 +024100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1214.2 +024200 MOVE SPACE TO CORRECT-X. NC1214.2 +024300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1214.2 +024400 MOVE SPACE TO RE-MARK. NC1214.2 +024500 HEAD-ROUTINE. NC1214.2 +024600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +024700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +024800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1214.2 +024900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1214.2 +025000 COLUMN-NAMES-ROUTINE. NC1214.2 +025100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +025200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +025400 END-ROUTINE. NC1214.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1214.2 +025600 END-RTN-EXIT. NC1214.2 +025700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +025800 END-ROUTINE-1. NC1214.2 +025900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1214.2 +026000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1214.2 +026100 ADD PASS-COUNTER TO ERROR-HOLD. NC1214.2 +026200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1214.2 +026300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1214.2 +026400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1214.2 +026500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1214.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1214.2 +026700 END-ROUTINE-12. NC1214.2 +026800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1214.2 +026900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1214.2 +027000 MOVE "NO " TO ERROR-TOTAL NC1214.2 +027100 ELSE NC1214.2 +027200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1214.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1214.2 +027400 PERFORM WRITE-LINE. NC1214.2 +027500 END-ROUTINE-13. NC1214.2 +027600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1214.2 +027700 MOVE "NO " TO ERROR-TOTAL ELSE NC1214.2 +027800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1214.2 +027900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1214.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +028100 IF INSPECT-COUNTER EQUAL TO ZERO NC1214.2 +028200 MOVE "NO " TO ERROR-TOTAL NC1214.2 +028300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1214.2 +028400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1214.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +028600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1214.2 +028700 WRITE-LINE. NC1214.2 +028800 ADD 1 TO RECORD-COUNT. NC1214.2 +028900 IF RECORD-COUNT GREATER 42 NC1214.2 +029000 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1214.2 +029100 MOVE SPACE TO DUMMY-RECORD NC1214.2 +029200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1214.2 +029300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1214.2 +029400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1214.2 +029500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1214.2 +029600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1214.2 +029700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1214.2 +029800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1214.2 +029900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1214.2 +030000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1214.2 +030100 MOVE ZERO TO RECORD-COUNT. NC1214.2 +030200 PERFORM WRT-LN. NC1214.2 +030300 WRT-LN. NC1214.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1214.2 +030500 MOVE SPACE TO DUMMY-RECORD. NC1214.2 +030600 BLANK-LINE-PRINT. NC1214.2 +030700 PERFORM WRT-LN. NC1214.2 +030800 FAIL-ROUTINE. NC1214.2 +030900 IF COMPUTED-X NOT EQUAL TO SPACE NC1214.2 +031000 GO TO FAIL-ROUTINE-WRITE. NC1214.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1214.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1214.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1214.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1214.2 +031600 GO TO FAIL-ROUTINE-EX. NC1214.2 +031700 FAIL-ROUTINE-WRITE. NC1214.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1214.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1214.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1214.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1214.2 +032200 FAIL-ROUTINE-EX. EXIT. NC1214.2 +032300 BAIL-OUT. NC1214.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1214.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1214.2 +032600 BAIL-OUT-WRITE. NC1214.2 +032700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1214.2 +032800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1214.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1214.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1214.2 +033100 BAIL-OUT-EX. EXIT. NC1214.2 +033200 CCVS1-EXIT. NC1214.2 +033300 EXIT. NC1214.2 +033400 SECT-NC121M-001 SECTION. NC1214.2 +033500 BUILD-TABLE1. NC1214.2 +033600 MOVE 4.00 TO TABLE1-NUM (1). NC1214.2 +033700 MOVE 1.34 TO TABLE1-NUM (2). NC1214.2 +033800 MOVE 7.00 TO TABLE1-NUM (3). NC1214.2 +033900 MOVE 3.00 TO TABLE1-NUM (4). NC1214.2 +034000 MOVE 2.00 TO TABLE1-NUM (5). NC1214.2 +034100 MOVE 1.50 TO TABLE1-NUM (6). NC1214.2 +034200 MOVE 3.50 TO TABLE1-NUM (7). NC1214.2 +034300 MOVE 0.00 TO TABLE1-NUM (8). NC1214.2 +034400 MOVE 5.00 TO TABLE1-NUM (9). NC1214.2 +034500 MOVE -9.00 TO TABLE1-NUM (10). NC1214.2 +034600 BUILD-TABLE2. NC1214.2 +034700 MOVE 1.0 TO TABLE2-NUM (1). NC1214.2 +034800 MOVE 6.0 TO TABLE2-NUM (2). NC1214.2 +034900 MOVE 3.0 TO TABLE2-NUM (3). NC1214.2 +035000 MOVE 2.0 TO TABLE2-NUM (4). NC1214.2 +035100 MOVE 9.7 TO TABLE2-NUM (5). NC1214.2 +035200 MOVE 1.2 TO TABLE2-NUM (6). NC1214.2 +035300 BUILD-TABLE4. NC1214.2 +035400 MOVE 01 TO TABLE4-NUM2 (1 1). NC1214.2 +035500 MOVE 02 TO TABLE4-NUM2 (1 2). NC1214.2 +035600 MOVE 03 TO TABLE4-NUM2 (1 3). NC1214.2 +035700 MOVE 12 TO TABLE4-NUM2 (2 1). NC1214.2 +035800 MOVE 24 TO TABLE4-NUM2 (2 2). NC1214.2 +035900 MOVE 25 TO TABLE4-NUM2 (2 3). NC1214.2 +036000 MOVE 14 TO TABLE4-NUM2 (3 1). NC1214.2 +036100 MOVE 15 TO TABLE4-NUM2 (3 2). NC1214.2 +036200 MOVE 16 TO TABLE4-NUM2 (3 3). NC1214.2 +036300 BUILD-TABLE5. NC1214.2 +036400 MOVE 3 TO TABLE5-NUM (1). NC1214.2 +036500 MOVE 2 TO TABLE5-NUM (2). NC1214.2 +036600 BUILD-TABLE6. NC1214.2 +036700 MOVE "LITERAL-01" TO TABLE6-REC (1). NC1214.2 +036800 MOVE "0123456789" TO TABLE6-REC (2). NC1214.2 +036900 IND-INIT-GF-1. NC1214.2 +037000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +037100 MOVE "MULTIPLY BY" TO FEATURE. NC1214.2 +037200 MOVE 2.0 TO NUM-9V9. NC1214.2 +037300 SET INDEX1 TO 1. NC1214.2 +037400 IND-TEST-GF-1-0. NC1214.2 +037500 MULTIPLY TABLE1-NUM (INDEX1) BY NUM-9V9. NC1214.2 +037600 IND-TEST-GF-1-1. NC1214.2 +037700 IF NUM-9V9 EQUAL TO 8.0 NC1214.2 +037800 PERFORM PASS NC1214.2 +037900 ELSE GO TO IND-FAIL-GF-1. NC1214.2 +038000 GO TO IND-WRITE-GF-1. NC1214.2 +038100 IND-DELETE-GF-1. NC1214.2 +038200 PERFORM DE-LETE. NC1214.2 +038300 GO TO IND-WRITE-GF-1. NC1214.2 +038400 IND-FAIL-GF-1. NC1214.2 +038500 PERFORM FAIL. NC1214.2 +038600 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +038700 MOVE 8.0 TO CORRECT-14V4. NC1214.2 +038800 IND-WRITE-GF-1. NC1214.2 +038900 MOVE "IND-TEST-GF-1" TO PAR-NAME. NC1214.2 +039000 PERFORM PRINT-DETAIL. NC1214.2 +039100 IND-INIT-GF-2. NC1214.2 +039200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +039300 MOVE "MULTIPLY ROUNDED" TO FEATURE. NC1214.2 +039400 MOVE 4.0 TO NUM-9V9. NC1214.2 +039500 SET INDEX1 TO 2. NC1214.2 +039600 IND-TEST-GF-2-0. NC1214.2 +039700 MULTIPLY TABLE1-NUM (INDEX1) BY NUM-9V9 ROUNDED. NC1214.2 +039800 IND-TEST-GF-2-1. NC1214.2 +039900 IF NUM-9V9 EQUAL TO 5.4 NC1214.2 +040000 PERFORM PASS NC1214.2 +040100 ELSE GO TO IND-FAIL-GF-2. NC1214.2 +040200 GO TO IND-WRITE-GF-2. NC1214.2 +040300 IND-DELETE-GF-2. NC1214.2 +040400 PERFORM DE-LETE. NC1214.2 +040500 GO TO IND-WRITE-GF-2. NC1214.2 +040600 IND-FAIL-GF-2. NC1214.2 +040700 PERFORM FAIL. NC1214.2 +040800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +040900 MOVE 5.4 TO CORRECT-14V4. NC1214.2 +041000 IND-WRITE-GF-2. NC1214.2 +041100 MOVE "IND-TEST-GF-2" TO PAR-NAME. NC1214.2 +041200 PERFORM PRINT-DETAIL. NC1214.2 +041300 IND-INIT-GF-3. NC1214.2 +041400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +041500 MOVE "MULTIPLY ON SIZE ERR" TO FEATURE. NC1214.2 +041600 MOVE 6.0 TO NUM-9V9. NC1214.2 +041700 SET INDEX1 TO 3. NC1214.2 +041800 IND-TEST-GF-3-1. NC1214.2 +041900 MULTIPLY TABLE1-NUM (INDEX1) BY NUM-9V9 ON SIZE ERROR NC1214.2 +042000 PERFORM PASS NC1214.2 +042100 GO TO IND-WRITE-GF-3-1. NC1214.2 +042200 GO TO IND-FAIL-GF-3-1. NC1214.2 +042300 IND-DELETE-GF-3-1. NC1214.2 +042400 PERFORM DE-LETE. NC1214.2 +042500 GO TO IND-WRITE-GF-3-1. NC1214.2 +042600 IND-FAIL-GF-3-1. NC1214.2 +042700 PERFORM FAIL. NC1214.2 +042800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +042900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1214.2 +043000 IND-WRITE-GF-3-1. NC1214.2 +043100 MOVE "IND-TEST-GF-3-1" TO PAR-NAME. NC1214.2 +043200 PERFORM PRINT-DETAIL. NC1214.2 +043300 IND-TEST-GF-3-2. NC1214.2 +043400 IF NUM-9V9 = 6.0 NC1214.2 +043500 PERFORM PASS NC1214.2 +043600 GO TO IND-WRITE-GF-3-2. NC1214.2 +043700 GO TO IND-FAIL-GF-3-2. NC1214.2 +043800 IND-DELETE-GF-3-2. NC1214.2 +043900 PERFORM DE-LETE. NC1214.2 +044000 GO TO IND-WRITE-GF-3-2. NC1214.2 +044100 IND-FAIL-GF-3-2. NC1214.2 +044200 PERFORM FAIL. NC1214.2 +044300 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +044400 MOVE 6.0 TO CORRECT-14V4. NC1214.2 +044500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1214.2 +044600 IND-WRITE-GF-3-2. NC1214.2 +044700 MOVE "IND-TEST-GF-3-2" TO PAR-NAME. NC1214.2 +044800 PERFORM PRINT-DETAIL. NC1214.2 +044900 IND-INIT-GF-4. NC1214.2 +045000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +045100 MOVE "MULTIPLY BY" TO FEATURE. NC1214.2 +045200 SET INDEX1 TO 1. NC1214.2 +045300 SET INDEX2 TO 1. NC1214.2 +045400 IND-TEST-GF-4-0. NC1214.2 +045500 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2). NC1214.2 +045600 IND-TEST-GF-4-1. NC1214.2 +045700 IF TABLE2-NUM (INDEX2) EQUAL TO 4.0 NC1214.2 +045800 PERFORM PASS NC1214.2 +045900 ELSE GO TO IND-FAIL-GF-4. NC1214.2 +046000 GO TO IND-WRITE-GF-4. NC1214.2 +046100 IND-DELETE-GF-4. NC1214.2 +046200 PERFORM DE-LETE. NC1214.2 +046300 GO TO IND-WRITE-GF-4. NC1214.2 +046400 IND-FAIL-GF-4. NC1214.2 +046500 PERFORM FAIL. NC1214.2 +046600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +046700 MOVE 4.0 TO CORRECT-14V4. NC1214.2 +046800 IND-WRITE-GF-4. NC1214.2 +046900 MOVE "IND-TEST-GF-4" TO PAR-NAME. NC1214.2 +047000 PERFORM PRINT-DETAIL. NC1214.2 +047100 IND-INIT-GF-5. NC1214.2 +047200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +047300 MOVE "MULTIPLY ROUNDED" TO FEATURE. NC1214.2 +047400 PERFORM BUILD-TABLE2. NC1214.2 +047500 SET INDEX1 TO 2. NC1214.2 +047600 SET INDEX2 TO 2. NC1214.2 +047700 IND-TEST-GF-5-0. NC1214.2 +047800 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) ROUNDED. NC1214.2 +047900 IND-TEST-GF-5-1. NC1214.2 +048000 IF TABLE2-NUM (INDEX2) EQUAL TO 8.0 NC1214.2 +048100 PERFORM PASS NC1214.2 +048200 ELSE GO TO IND-FAIL-GF-5. NC1214.2 +048300 GO TO IND-WRITE-GF-5. NC1214.2 +048400 IND-DELETE-GF-5. NC1214.2 +048500 PERFORM DE-LETE. NC1214.2 +048600 GO TO IND-WRITE-GF-5. NC1214.2 +048700 IND-FAIL-GF-5. NC1214.2 +048800 PERFORM FAIL. NC1214.2 +048900 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +049000 MOVE 8.0 TO CORRECT-14V4. NC1214.2 +049100 IND-WRITE-GF-5. NC1214.2 +049200 MOVE "IND-TEST-GF-5" TO PAR-NAME. NC1214.2 +049300 PERFORM PRINT-DETAIL. NC1214.2 +049400 IND-INIT-GF-6. NC1214.2 +049500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +049600 MOVE "MULTIPLY ON SIZE ERR" TO FEATURE. NC1214.2 +049700 PERFORM BUILD-TABLE2. NC1214.2 +049800 SET INDEX1 TO 3. NC1214.2 +049900 SET INDEX2 TO 3. NC1214.2 +050000 IND-TEST-GF-6-1. NC1214.2 +050100 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +050200 ON SIZE ERROR NC1214.2 +050300 PERFORM PASS NC1214.2 +050400 GO TO IND-WRITE-GF-6-1. NC1214.2 +050500 GO TO IND-FAIL-GF-6-1. NC1214.2 +050600 IND-DELETE-GF-6-1. NC1214.2 +050700 PERFORM DE-LETE. NC1214.2 +050800 GO TO IND-WRITE-GF-6-1. NC1214.2 +050900 IND-FAIL-GF-6-1. NC1214.2 +051000 PERFORM FAIL. NC1214.2 +051100 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +051200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1214.2 +051300 IND-WRITE-GF-6-1. NC1214.2 +051400 MOVE "IND-TEST-GF-6-1" TO PAR-NAME. NC1214.2 +051500 PERFORM PRINT-DETAIL. NC1214.2 +051600 IND-TEST-GF-6-2. NC1214.2 +051700 IF TABLE2-NUM (INDEX2) = 3.0 NC1214.2 +051800 PERFORM PASS NC1214.2 +051900 GO TO IND-WRITE-GF-6-2. NC1214.2 +052000 GO TO IND-FAIL-GF-6-2. NC1214.2 +052100 IND-DELETE-GF-6-2. NC1214.2 +052200 PERFORM DE-LETE. NC1214.2 +052300 GO TO IND-WRITE-GF-6-2. NC1214.2 +052400 IND-FAIL-GF-6-2. NC1214.2 +052500 PERFORM FAIL. NC1214.2 +052600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +052700 MOVE 3.0 TO CORRECT-14V4. NC1214.2 +052800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1214.2 +052900 IND-WRITE-GF-6-2. NC1214.2 +053000 MOVE "IND-TEST-GF-6-2" TO PAR-NAME. NC1214.2 +053100 PERFORM PRINT-DETAIL. NC1214.2 +053200 IND-INIT-GF-7. NC1214.2 +053300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +053400 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +053500 PERFORM BUILD-TABLE2. NC1214.2 +053600 MOVE ZERO TO NUM-9V9. NC1214.2 +053700 SET INDEX1 TO 1. NC1214.2 +053800 IND-TEST-GF-7-0. NC1214.2 +053900 MULTIPLY 2 BY TABLE1-NUM (INDEX1) GIVING NUM-9V9. NC1214.2 +054000 IND-TEST-GF-7-1. NC1214.2 +054100 IF NUM-9V9 EQUAL TO 8.0 NC1214.2 +054200 PERFORM PASS NC1214.2 +054300 ELSE GO TO IND-FAIL-GF-7. NC1214.2 +054400 GO TO IND-WRITE-GF-7. NC1214.2 +054500 IND-DELETE-GF-7. NC1214.2 +054600 PERFORM DE-LETE. NC1214.2 +054700 GO TO IND-WRITE-GF-7. NC1214.2 +054800 IND-FAIL-GF-7. NC1214.2 +054900 PERFORM FAIL. NC1214.2 +055000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +055100 MOVE 8.0 TO CORRECT-14V4. NC1214.2 +055200 IND-WRITE-GF-7. NC1214.2 +055300 MOVE "IND-TEST-GF-7" TO PAR-NAME. NC1214.2 +055400 PERFORM PRINT-DETAIL. NC1214.2 +055500 IND-INIT-GF-8. NC1214.2 +055600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +055700 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +055800 PERFORM BUILD-TABLE2. NC1214.2 +055900 MOVE ZERO TO NUM-9V9. NC1214.2 +056000 SET INDEX1 TO 4. NC1214.2 +056100 SET INDEX2 TO 4. NC1214.2 +056200 IND-TEST-GF-8-0. NC1214.2 +056300 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +056400 GIVING NUM-9V9. NC1214.2 +056500 IND-TEST-GF-8-1. NC1214.2 +056600 IF NUM-9V9 EQUAL TO 6.0 NC1214.2 +056700 PERFORM PASS NC1214.2 +056800 ELSE GO TO IND-FAIL-GF-8. NC1214.2 +056900 GO TO IND-WRITE-GF-8. NC1214.2 +057000 IND-DELETE-GF-8. NC1214.2 +057100 PERFORM DE-LETE. NC1214.2 +057200 GO TO IND-WRITE-GF-8. NC1214.2 +057300 IND-FAIL-GF-8. NC1214.2 +057400 PERFORM FAIL. NC1214.2 +057500 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +057600 MOVE 6.0 TO CORRECT-14V4. NC1214.2 +057700 IND-WRITE-GF-8. NC1214.2 +057800 MOVE "IND-TEST-GF-8" TO PAR-NAME. NC1214.2 +057900 PERFORM PRINT-DETAIL. NC1214.2 +058000 IND-INIT-GF-9. NC1214.2 +058100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +058200 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +058300 PERFORM BUILD-TABLE2. NC1214.2 +058400 MOVE ZERO TO TABLE3. NC1214.2 +058500 SET INDEX1 TO 3. NC1214.2 +058600 SET INDEX2 TO 2. NC1214.2 +058700 SET INDEX3 TO 1. NC1214.2 +058800 IND-TEST-GF-9-0. NC1214.2 +058900 MULTIPLY TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +059000 GIVING TABLE3-NUM (INDEX3). NC1214.2 +059100 IND-TEST-GF-9-1. NC1214.2 +059200 IF TABLE3-NUM (INDEX3) EQUAL TO 42.0 NC1214.2 +059300 PERFORM PASS NC1214.2 +059400 ELSE GO TO IND-FAIL-GF-9. NC1214.2 +059500 GO TO IND-WRITE-GF-9. NC1214.2 +059600 IND-DELETE-GF-9. NC1214.2 +059700 PERFORM DE-LETE. NC1214.2 +059800 GO TO IND-WRITE-GF-9. NC1214.2 +059900 IND-FAIL-GF-9. NC1214.2 +060000 PERFORM FAIL. NC1214.2 +060100 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1214.2 +060200 MOVE 42.0 TO CORRECT-14V4. NC1214.2 +060300 IND-WRITE-GF-9. NC1214.2 +060400 MOVE "IND-TEST-GF-9" TO PAR-NAME. NC1214.2 +060500 PERFORM PRINT-DETAIL. NC1214.2 +060600 IND-INIT-GF-10. NC1214.2 +060700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +060800 MOVE "MULTIPLY BY" TO FEATURE. NC1214.2 +060900 MOVE 2.0 TO NUM-9V9. NC1214.2 +061000 SET INDEX1 TO 3. NC1214.2 +061100 IND-TEST-GF-10-0. NC1214.2 +061200 MULTIPLY TABLE1-NUM (INDEX1 - 2) BY NUM-9V9. NC1214.2 +061300 IND-TEST-GF-10-1. NC1214.2 +061400 IF NUM-9V9 EQUAL TO 8.0 NC1214.2 +061500 PERFORM PASS NC1214.2 +061600 ELSE GO TO IND-FAIL-GF-10. NC1214.2 +061700 GO TO IND-WRITE-GF-10. NC1214.2 +061800 IND-DELETE-GF-10. NC1214.2 +061900 PERFORM DE-LETE. NC1214.2 +062000 GO TO IND-WRITE-GF-10. NC1214.2 +062100 IND-FAIL-GF-10. NC1214.2 +062200 PERFORM FAIL. NC1214.2 +062300 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +062400 MOVE 8.0 TO CORRECT-14V4. NC1214.2 +062500 IND-WRITE-GF-10. NC1214.2 +062600 MOVE "IND-TEST-GF-10" TO PAR-NAME. NC1214.2 +062700 PERFORM PRINT-DETAIL. NC1214.2 +062800 IND-INIT-GF-11. NC1214.2 +062900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +063000 MOVE "MULTIPLY BY" TO FEATURE. NC1214.2 +063100 PERFORM BUILD-TABLE2. NC1214.2 +063200 SET INDEX1 TO 2. NC1214.2 +063300 SET INDEX2 TO 5. NC1214.2 +063400 IND-TEST-GF-11-0. NC1214.2 +063500 MULTIPLY TABLE1-NUM (INDEX1 - 1) BY TABLE2-NUM (INDEX2 + 1). NC1214.2 +063600 IND-TEST-GF-11-1. NC1214.2 +063700 IF TABLE2-NUM (INDEX2 + 1) EQUAL TO 4.8 NC1214.2 +063800 PERFORM PASS NC1214.2 +063900 ELSE GO TO IND-FAIL-GF-11. NC1214.2 +064000 GO TO IND-WRITE-GF-11. NC1214.2 +064100 IND-DELETE-GF-11. NC1214.2 +064200 PERFORM DE-LETE. NC1214.2 +064300 GO TO IND-WRITE-GF-11. NC1214.2 +064400 IND-FAIL-GF-11. NC1214.2 +064500 PERFORM FAIL. NC1214.2 +064600 MOVE TABLE2-NUM (INDEX2 + 1) TO COMPUTED-14V4. NC1214.2 +064700 MOVE 4.8 TO CORRECT-14V4. NC1214.2 +064800 IND-WRITE-GF-11. NC1214.2 +064900 MOVE "IND-TEST-GF-11" TO PAR-NAME. NC1214.2 +065000 PERFORM PRINT-DETAIL. NC1214.2 +065100 IND-INIT-GF-12. NC1214.2 +065200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +065300 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +065400 PERFORM BUILD-TABLE2. NC1214.2 +065500 MOVE ZERO TO NUM-9V9. NC1214.2 +065600 SET INDEX1 TO 6. NC1214.2 +065700 SET INDEX2 TO 3. NC1214.2 +065800 IND-TEST-GF-12-0. NC1214.2 +065900 MULTIPLY TABLE1-NUM (INDEX1 - 2) BY TABLE2-NUM (INDEX2 - 2) NC1214.2 +066000 GIVING NUM-9V9. NC1214.2 +066100 IND-TEST-GF-12-1. NC1214.2 +066200 IF NUM-9V9 EQUAL TO 3.0 NC1214.2 +066300 PERFORM PASS NC1214.2 +066400 ELSE GO TO IND-FAIL-GF-12. NC1214.2 +066500 GO TO IND-WRITE-GF-12. NC1214.2 +066600 IND-DELETE-GF-12. NC1214.2 +066700 PERFORM DE-LETE. NC1214.2 +066800 GO TO IND-WRITE-GF-12. NC1214.2 +066900 IND-FAIL-GF-12. NC1214.2 +067000 PERFORM FAIL. NC1214.2 +067100 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +067200 MOVE 3.0 TO CORRECT-14V4. NC1214.2 +067300 IND-WRITE-GF-12. NC1214.2 +067400 MOVE "IND-TEST-GF-12" TO PAR-NAME. NC1214.2 +067500 PERFORM PRINT-DETAIL. NC1214.2 +067600 IND-INIT-GF-13. NC1214.2 +067700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +067800 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1214.2 +067900 PERFORM BUILD-TABLE2. NC1214.2 +068000 MOVE ZERO TO TABLE3. NC1214.2 +068100 SET INDEX1 TO 1. NC1214.2 +068200 SET INDEX2 TO 3. NC1214.2 +068300 SET INDEX3 TO 1. NC1214.2 +068400 IND-TEST-GF-13-0. NC1214.2 +068500 MULTIPLY TABLE1-NUM (INDEX1 + 2) BY TABLE2-NUM (INDEX2 - 1) NC1214.2 +068600 GIVING TABLE3-NUM (INDEX3 + 1). NC1214.2 +068700 IND-TEST-GF-13-1. NC1214.2 +068800 IF TABLE3-NUM (INDEX3 + 1) EQUAL TO 42.0 NC1214.2 +068900 PERFORM PASS NC1214.2 +069000 ELSE GO TO IND-FAIL-GF-13. NC1214.2 +069100 GO TO IND-WRITE-GF-13. NC1214.2 +069200 IND-DELETE-GF-13. NC1214.2 +069300 PERFORM DE-LETE. NC1214.2 +069400 GO TO IND-WRITE-GF-13. NC1214.2 +069500 IND-FAIL-GF-13. NC1214.2 +069600 PERFORM FAIL. NC1214.2 +069700 MOVE TABLE3-NUM (INDEX3 + 1) TO COMPUTED-14V4. NC1214.2 +069800 MOVE 42.0 TO CORRECT-14V4. NC1214.2 +069900 IND-WRITE-GF-13. NC1214.2 +070000 MOVE "IND-TEST-GF-13" TO PAR-NAME. NC1214.2 +070100 PERFORM PRINT-DETAIL. NC1214.2 +070200 IND-INIT-GF-14. NC1214.2 +070300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +070400 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +070500 MOVE 9.0 TO NUM-9V9. NC1214.2 +070600 SET INDEX1 TO 4. NC1214.2 +070700 IND-TEST-GF-14-0. NC1214.2 +070800 DIVIDE TABLE1-NUM (INDEX1) INTO NUM-9V9. NC1214.2 +070900 IND-TEST-GF-14-1. NC1214.2 +071000 IF NUM-9V9 EQUAL TO 3.0 NC1214.2 +071100 PERFORM PASS NC1214.2 +071200 GO TO IND-WRITE-GF-14. NC1214.2 +071300 GO TO IND-FAIL-GF-14. NC1214.2 +071400 IND-DELETE-GF-14. NC1214.2 +071500 PERFORM DE-LETE. NC1214.2 +071600 GO TO IND-WRITE-GF-14. NC1214.2 +071700 IND-FAIL-GF-14. NC1214.2 +071800 PERFORM FAIL. NC1214.2 +071900 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +072000 MOVE 3.0 TO CORRECT-14V4. NC1214.2 +072100 IND-WRITE-GF-14. NC1214.2 +072200 MOVE "IND-TEST-GF-14" TO PAR-NAME. NC1214.2 +072300 PERFORM PRINT-DETAIL. NC1214.2 +072400 IND-INIT-GF-15. NC1214.2 +072500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +072600 MOVE "DIVIDE ROUNDED" TO FEATURE. NC1214.2 +072700 MOVE 8.1 TO NUM-9V9. NC1214.2 +072800 SET INDEX1 TO 9. NC1214.2 +072900 IND-TEST-GF-15-0. NC1214.2 +073000 DIVIDE TABLE1-NUM (INDEX1) INTO NUM-9V9 ROUNDED. NC1214.2 +073100 IND-TEST-GF-15-1. NC1214.2 +073200 IF NUM-9V9 EQUAL TO 1.6 NC1214.2 +073300 PERFORM PASS NC1214.2 +073400 GO TO IND-WRITE-GF-15. NC1214.2 +073500 GO TO IND-FAIL-GF-15. NC1214.2 +073600 IND-DELETE-GF-15. NC1214.2 +073700 PERFORM DE-LETE. NC1214.2 +073800 GO TO IND-WRITE-GF-15. NC1214.2 +073900 IND-FAIL-GF-15. NC1214.2 +074000 PERFORM FAIL. NC1214.2 +074100 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +074200 MOVE 1.6 TO CORRECT-14V4. NC1214.2 +074300 IND-WRITE-GF-15. NC1214.2 +074400 MOVE "IND-TEST-GF-15" TO PAR-NAME. NC1214.2 +074500 PERFORM PRINT-DETAIL. NC1214.2 +074600 IND-INIT-GF-16. NC1214.2 +074700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +074800 MOVE "DIVIDE ON SIZE ERROR" TO FEATURE. NC1214.2 +074900 MOVE 9.9 TO NUM-9V9. NC1214.2 +075000 SET INDEX1 TO 8. NC1214.2 +075100 IND-TEST-GF-16-1. NC1214.2 +075200 DIVIDE TABLE1-NUM (INDEX1) INTO NUM-9V9 ON SIZE ERROR NC1214.2 +075300 PERFORM PASS NC1214.2 +075400 GO TO IND-WRITE-GF-16-1. NC1214.2 +075500 GO TO IND-FAIL-GF-16-1. NC1214.2 +075600 IND-DELETE-GF-16-1. NC1214.2 +075700 PERFORM DE-LETE. NC1214.2 +075800 GO TO IND-WRITE-GF-16-1. NC1214.2 +075900 IND-FAIL-GF-16-1. NC1214.2 +076000 PERFORM FAIL. NC1214.2 +076100 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +076200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1214.2 +076300 IND-WRITE-GF-16-1. NC1214.2 +076400 MOVE "IND-TEST-GF-16-1" TO PAR-NAME. NC1214.2 +076500 PERFORM PRINT-DETAIL. NC1214.2 +076600 IND-TEST-GF-16-2. NC1214.2 +076700 MOVE 9.9 TO NUM-9V9. NC1214.2 +076800 IF NUM-9V9 = 9.9 NC1214.2 +076900 PERFORM PASS NC1214.2 +077000 GO TO IND-WRITE-GF-16-2. NC1214.2 +077100 GO TO IND-FAIL-GF-16-2. NC1214.2 +077200 IND-DELETE-GF-16-2. NC1214.2 +077300 PERFORM DE-LETE. NC1214.2 +077400 GO TO IND-WRITE-GF-16-2. NC1214.2 +077500 IND-FAIL-GF-16-2. NC1214.2 +077600 PERFORM FAIL. NC1214.2 +077700 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +077800 MOVE 9.9 TO CORRECT-14V4. NC1214.2 +077900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1214.2 +078000 IND-WRITE-GF-16-2. NC1214.2 +078100 MOVE "IND-TEST-GF-16-2" TO PAR-NAME. NC1214.2 +078200 PERFORM PRINT-DETAIL. NC1214.2 +078300 IND-INIT-GF-17. NC1214.2 +078400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +078500 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +078600 PERFORM BUILD-TABLE2. NC1214.2 +078700 SET INDEX1 TO 4. NC1214.2 +078800 SET INDEX2 TO 2. NC1214.2 +078900 IND-TEST-GF-17-0. NC1214.2 +079000 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2). NC1214.2 +079100 IND-TEST-GF-17-1. NC1214.2 +079200 IF TABLE2-NUM (INDEX2) EQUAL TO 2.0 NC1214.2 +079300 PERFORM PASS NC1214.2 +079400 GO TO IND-WRITE-GF-17. NC1214.2 +079500 GO TO IND-FAIL-GF-17. NC1214.2 +079600 IND-DELETE-GF-17. NC1214.2 +079700 PERFORM DE-LETE. NC1214.2 +079800 GO TO IND-WRITE-GF-17. NC1214.2 +079900 IND-FAIL-GF-17. NC1214.2 +080000 PERFORM FAIL. NC1214.2 +080100 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +080200 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +080300 IND-WRITE-GF-17. NC1214.2 +080400 MOVE "IND-TEST-GF-17" TO PAR-NAME. NC1214.2 +080500 PERFORM PRINT-DETAIL. NC1214.2 +080600 IND-INIT-GF-18. NC1214.2 +080700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +080800 MOVE "DIVIDE ROUNDED" TO FEATURE. NC1214.2 +080900 PERFORM BUILD-TABLE2. NC1214.2 +081000 SET INDEX1 TO 9. NC1214.2 +081100 SET INDEX2 TO 5. NC1214.2 +081200 IND-TEST-GF-18-0. NC1214.2 +081300 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2) ROUNDED. NC1214.2 +081400 IND-TEST-GF-18-1. NC1214.2 +081500 IF TABLE2-NUM (INDEX2) EQUAL TO 1.9 NC1214.2 +081600 PERFORM PASS NC1214.2 +081700 GO TO IND-WRITE-GF-18. NC1214.2 +081800 GO TO IND-FAIL-GF-18. NC1214.2 +081900 IND-DELETE-GF-18. NC1214.2 +082000 PERFORM DE-LETE. NC1214.2 +082100 GO TO IND-WRITE-GF-18. NC1214.2 +082200 IND-FAIL-GF-18. NC1214.2 +082300 PERFORM FAIL. NC1214.2 +082400 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +082500 MOVE 1.9 TO CORRECT-14V4. NC1214.2 +082600 IND-WRITE-GF-18. NC1214.2 +082700 MOVE "IND-TEST-GF-18" TO PAR-NAME. NC1214.2 +082800 PERFORM PRINT-DETAIL. NC1214.2 +082900 IND-INIT-GF-19. NC1214.2 +083000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +083100 MOVE "DIVIDE ON SIZE ERROR" TO FEATURE. NC1214.2 +083200 PERFORM BUILD-TABLE2. NC1214.2 +083300 SET INDEX1 TO 8. NC1214.2 +083400 SET INDEX2 TO 5. NC1214.2 +083500 IND-TEST-GF-19-1. NC1214.2 +083600 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2) NC1214.2 +083700 ON SIZE ERROR NC1214.2 +083800 PERFORM PASS NC1214.2 +083900 GO TO IND-WRITE-GF-19-1. NC1214.2 +084000 GO TO IND-FAIL-GF-19-1. NC1214.2 +084100 IND-DELETE-GF-19-1. NC1214.2 +084200 PERFORM DE-LETE. NC1214.2 +084300 GO TO IND-WRITE-GF-19-1. NC1214.2 +084400 IND-FAIL-GF-19-1. NC1214.2 +084500 PERFORM FAIL. NC1214.2 +084600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +084700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1214.2 +084800 IND-WRITE-GF-19-1. NC1214.2 +084900 MOVE "IND-TEST-GF-19-1" TO PAR-NAME. NC1214.2 +085000 PERFORM PRINT-DETAIL. NC1214.2 +085100 IND-TEST-GF-19-2. NC1214.2 +085200 IF TABLE2-NUM (INDEX2) = 9.7 NC1214.2 +085300 PERFORM PASS NC1214.2 +085400 GO TO IND-WRITE-GF-19-2. NC1214.2 +085500 GO TO IND-FAIL-GF-19-2. NC1214.2 +085600 IND-DELETE-GF-19-2. NC1214.2 +085700 PERFORM DE-LETE. NC1214.2 +085800 GO TO IND-WRITE-GF-19-2. NC1214.2 +085900 IND-FAIL-GF-19-2. NC1214.2 +086000 PERFORM FAIL. NC1214.2 +086100 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1214.2 +086200 MOVE 9.7 TO CORRECT-14V4. NC1214.2 +086300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1214.2 +086400 IND-WRITE-GF-19-2. NC1214.2 +086500 MOVE "IND-TEST-GF-19-2" TO PAR-NAME. NC1214.2 +086600 PERFORM PRINT-DETAIL. NC1214.2 +086700 IND-INIT-GF-22. NC1214.2 +086800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +086900 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +087000 MOVE ZERO TO NUM-9V9. NC1214.2 +087100 SET INDEX1 TO 4. NC1214.2 +087200 IND-TEST-GF-22-0. NC1214.2 +087300 DIVIDE 3 INTO TABLE1-NUM (INDEX1) GIVING NUM-9V9. NC1214.2 +087400 IND-TEST-GF-22-1. NC1214.2 +087500 IF NUM-9V9 EQUAL TO 1.0 NC1214.2 +087600 PERFORM PASS NC1214.2 +087700 GO TO IND-WRITE-GF-22. NC1214.2 +087800 GO TO IND-FAIL-GF-22. NC1214.2 +087900 IND-DELETE-GF-22. NC1214.2 +088000 PERFORM DE-LETE. NC1214.2 +088100 GO TO IND-WRITE-GF-22. NC1214.2 +088200 IND-FAIL-GF-22. NC1214.2 +088300 PERFORM FAIL. NC1214.2 +088400 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +088500 MOVE 1.0 TO CORRECT-14V4. NC1214.2 +088600 IND-WRITE-GF-22. NC1214.2 +088700 MOVE "IND-TEST-GF-22" TO PAR-NAME. NC1214.2 +088800 PERFORM PRINT-DETAIL. NC1214.2 +088900 IND-INIT-GF-23. NC1214.2 +089000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +089100 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +089200 PERFORM BUILD-TABLE2. NC1214.2 +089300 MOVE ZERO TO NUM-9V9. NC1214.2 +089400 SET INDEX1 TO 4. NC1214.2 +089500 SET INDEX2 TO 2. NC1214.2 +089600 IND-TEST-GF-23-0. NC1214.2 +089700 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2) NC1214.2 +089800 GIVING NUM-9V9. NC1214.2 +089900 IND-TEST-GF-23-1. NC1214.2 +090000 IF NUM-9V9 EQUAL TO 2.0 NC1214.2 +090100 PERFORM PASS NC1214.2 +090200 GO TO IND-WRITE-GF-23. NC1214.2 +090300 GO TO IND-FAIL-GF-23. NC1214.2 +090400 IND-DELETE-GF-23. NC1214.2 +090500 PERFORM DE-LETE. NC1214.2 +090600 GO TO IND-WRITE-GF-23. NC1214.2 +090700 IND-FAIL-GF-23. NC1214.2 +090800 PERFORM FAIL. NC1214.2 +090900 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +091000 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +091100 IND-WRITE-GF-23. NC1214.2 +091200 MOVE "IND-TEST-GF-23" TO PAR-NAME. NC1214.2 +091300 PERFORM PRINT-DETAIL. NC1214.2 +091400 IND-INIT-GF-24. NC1214.2 +091500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +091600 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +091700 PERFORM BUILD-TABLE2. NC1214.2 +091800 MOVE ZERO TO TABLE3. NC1214.2 +091900 SET INDEX1 TO 4. NC1214.2 +092000 SET INDEX2 TO 2. NC1214.2 +092100 SET INDEX3 TO 3. NC1214.2 +092200 IND-TEST-GF-24-0. NC1214.2 +092300 DIVIDE TABLE1-NUM (INDEX1) INTO TABLE2-NUM (INDEX2) NC1214.2 +092400 GIVING TABLE3-NUM (INDEX3). NC1214.2 +092500 IND-TEST-GF-24-1. NC1214.2 +092600 IF TABLE3-NUM (INDEX3) EQUAL TO 2.0 NC1214.2 +092700 PERFORM PASS NC1214.2 +092800 GO TO IND-WRITE-GF-24. NC1214.2 +092900 GO TO IND-FAIL-GF-24. NC1214.2 +093000 IND-DELETE-GF-24. NC1214.2 +093100 PERFORM DE-LETE. NC1214.2 +093200 GO TO IND-WRITE-GF-24. NC1214.2 +093300 IND-FAIL-GF-24. NC1214.2 +093400 PERFORM FAIL. NC1214.2 +093500 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1214.2 +093600 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +093700 IND-WRITE-GF-24. NC1214.2 +093800 MOVE "IND-TEST-GF-24" TO PAR-NAME. NC1214.2 +093900 PERFORM PRINT-DETAIL. NC1214.2 +094000 IND-INIT-GF-25. NC1214.2 +094100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +094200 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +094300 PERFORM BUILD-TABLE4. NC1214.2 +094400 SET INDEX4-1 TO 3. NC1214.2 +094500 SET INDEX4-2 TO 1. NC1214.2 +094600 IND-TEST-GF-25-0. NC1214.2 +094700 DIVIDE TABLE4-NUM2 (1 2) INTO NC1214.2 +094800 TABLE4-NUM2 (INDEX4-1 INDEX4-2). NC1214.2 +094900 IND-TEST-GF-25-1. NC1214.2 +095000 IF TABLE4-NUM2 (INDEX4-1 INDEX4-2) EQUAL TO 7 NC1214.2 +095100 PERFORM PASS NC1214.2 +095200 GO TO IND-WRITE-GF-25. NC1214.2 +095300 GO TO IND-FAIL-GF-25. NC1214.2 +095400 IND-DELETE-GF-25. NC1214.2 +095500 PERFORM DE-LETE. NC1214.2 +095600 GO TO IND-WRITE-GF-25. NC1214.2 +095700 IND-FAIL-GF-25. NC1214.2 +095800 PERFORM FAIL. NC1214.2 +095900 MOVE TABLE4-NUM2 (INDEX4-1 INDEX4-2) TO COMPUTED-14V4. NC1214.2 +096000 MOVE 7 TO CORRECT-14V4. NC1214.2 +096100 IND-WRITE-GF-25. NC1214.2 +096200 MOVE "IND-TEST-GF-25" TO PAR-NAME. NC1214.2 +096300 PERFORM PRINT-DETAIL. NC1214.2 +096400 IND-INIT-GF-20. NC1214.2 +096500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +096600 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +096700 MOVE 9.5 TO NUM-9V9. NC1214.2 +096800 SET INDEX1 TO 8. NC1214.2 +096900 IND-TEST-GF-20-0. NC1214.2 +097000 DIVIDE TABLE1-NUM (INDEX1 + 1) INTO NUM-9V9. NC1214.2 +097100 IND-TEST-GF-20-1. NC1214.2 +097200 IF NUM-9V9 EQUAL TO 1.9 NC1214.2 +097300 PERFORM PASS NC1214.2 +097400 GO TO IND-WRITE-GF-20. NC1214.2 +097500 GO TO IND-FAIL-GF-20. NC1214.2 +097600 IND-DELETE-GF-20. NC1214.2 +097700 PERFORM DE-LETE. NC1214.2 +097800 GO TO IND-WRITE-GF-20. NC1214.2 +097900 IND-FAIL-GF-20. NC1214.2 +098000 PERFORM FAIL. NC1214.2 +098100 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +098200 MOVE 1.9 TO CORRECT-14V4. NC1214.2 +098300 IND-WRITE-GF-20. NC1214.2 +098400 MOVE "IND-TEST-GF-20" TO PAR-NAME. NC1214.2 +098500 PERFORM PRINT-DETAIL. NC1214.2 +098600 IND-INIT-GF-21. NC1214.2 +098700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +098800 MOVE "DIVIDE INTO" TO FEATURE. NC1214.2 +098900 PERFORM BUILD-TABLE2. NC1214.2 +099000 SET INDEX1 TO 6. NC1214.2 +099100 SET INDEX2 TO 4. NC1214.2 +099200 IND-TEST-GF-21-0. NC1214.2 +099300 DIVIDE TABLE1-NUM (INDEX1 - 2) INTO NC1214.2 +099400 TABLE2-NUM (INDEX2 + 2). NC1214.2 +099500 IND-TEST-GF-21-1. NC1214.2 +099600 IF TABLE2-NUM (INDEX2 + 2) EQUAL TO .4 NC1214.2 +099700 PERFORM PASS NC1214.2 +099800 GO TO IND-WRITE-GF-21. NC1214.2 +099900 GO TO IND-FAIL-GF-21. NC1214.2 +100000 IND-DELETE-GF-21. NC1214.2 +100100 PERFORM DE-LETE. NC1214.2 +100200 GO TO IND-WRITE-GF-21. NC1214.2 +100300 IND-FAIL-GF-21. NC1214.2 +100400 PERFORM FAIL. NC1214.2 +100500 MOVE TABLE2-NUM (INDEX2 + 2) TO COMPUTED-14V4. NC1214.2 +100600 MOVE .4 TO CORRECT-14V4. NC1214.2 +100700 IND-WRITE-GF-21. NC1214.2 +100800 MOVE "IND-TEST-GF-21" TO PAR-NAME. NC1214.2 +100900 PERFORM PRINT-DETAIL. NC1214.2 +101000 IND-INIT-GF-26. NC1214.2 +101100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +101200 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +101300 PERFORM BUILD-TABLE2. NC1214.2 +101400 MOVE ZERO TO NUM-9V9. NC1214.2 +101500 SET INDEX1 TO 6. NC1214.2 +101600 SET INDEX2 TO 1. NC1214.2 +101700 IND-TEST-GF-26-0. NC1214.2 +101800 DIVIDE TABLE1-NUM (INDEX1 - 2) INTO NC1214.2 +101900 TABLE2-NUM (INDEX2 + 1) GIVING NUM-9V9. NC1214.2 +102000 IND-TEST-GF-26-1. NC1214.2 +102100 IF NUM-9V9 EQUAL TO 2.0 NC1214.2 +102200 PERFORM PASS NC1214.2 +102300 GO TO IND-WRITE-GF-26. NC1214.2 +102400 GO TO IND-FAIL-GF-26. NC1214.2 +102500 IND-DELETE-GF-26. NC1214.2 +102600 PERFORM DE-LETE. NC1214.2 +102700 GO TO IND-WRITE-GF-26. NC1214.2 +102800 IND-FAIL-GF-26. NC1214.2 +102900 PERFORM FAIL. NC1214.2 +103000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +103100 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +103200 IND-WRITE-GF-26. NC1214.2 +103300 MOVE "IND-TEST-GF-26" TO PAR-NAME. NC1214.2 +103400 PERFORM PRINT-DETAIL. NC1214.2 +103500 IND-INIT-GF-27. NC1214.2 +103600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +103700 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1214.2 +103800 PERFORM BUILD-TABLE2. NC1214.2 +103900 MOVE ZERO TO TABLE3. NC1214.2 +104000 SET INDEX1 TO 8. NC1214.2 +104100 SET INDEX2 TO 1. NC1214.2 +104200 SET INDEX3 TO 4. NC1214.2 +104300 IND-TEST-GF-27-0. NC1214.2 +104400 DIVIDE TABLE1-NUM (INDEX1 - 2) INTO NC1214.2 +104500 TABLE2-NUM (INDEX2 + 1) GIVING TABLE3-NUM (INDEX3 - 1). NC1214.2 +104600 IND-TEST-GF-27-1. NC1214.2 +104700 IF TABLE3-NUM (INDEX3 - 1) EQUAL TO 4 NC1214.2 +104800 PERFORM PASS NC1214.2 +104900 GO TO IND-WRITE-GF-27. NC1214.2 +105000 GO TO IND-FAIL-GF-27. NC1214.2 +105100 IND-DELETE-GF-27. NC1214.2 +105200 PERFORM DE-LETE. NC1214.2 +105300 GO TO IND-WRITE-GF-27. NC1214.2 +105400 IND-FAIL-GF-27. NC1214.2 +105500 PERFORM FAIL. NC1214.2 +105600 MOVE TABLE3-NUM (INDEX3 - 1) TO COMPUTED-14V4. NC1214.2 +105700 MOVE 4.0 TO CORRECT-14V4. NC1214.2 +105800 IND-WRITE-GF-27. NC1214.2 +105900 MOVE "IND-TEST-GF-27" TO PAR-NAME. NC1214.2 +106000 PERFORM PRINT-DETAIL. NC1214.2 +106100 IND-INIT-GF-28. NC1214.2 +106200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +106300 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +106400 PERFORM BUILD-TABLE4. NC1214.2 +106500 SET INDEX4-1 TO 2. NC1214.2 +106600 SET INDEX4-2 TO 1. NC1214.2 +106700 IND-TEST-GF-28-0. NC1214.2 +106800 DIVIDE TABLE4-NUM2 (INDEX4-1 INDEX4-2) BY NC1214.2 +106900 TABLE4-NUM2 (1 3) GIVING TABLE4-NUM2 (3 3). NC1214.2 +107000 IND-TEST-GF-28-1. NC1214.2 +107100 IF TABLE4-NUM2 (3 3) EQUAL TO 4 NC1214.2 +107200 PERFORM PASS NC1214.2 +107300 GO TO IND-WRITE-GF-28. NC1214.2 +107400 GO TO IND-FAIL-GF-28. NC1214.2 +107500 IND-DELETE-GF-28. NC1214.2 +107600 PERFORM DE-LETE. NC1214.2 +107700 GO TO IND-WRITE-GF-28. NC1214.2 +107800 IND-FAIL-GF-28. NC1214.2 +107900 PERFORM FAIL. NC1214.2 +108000 MOVE TABLE4-NUM2 (3 3) TO COMPUTED-14V4. NC1214.2 +108100 MOVE 4.0 TO CORRECT-14V4. NC1214.2 +108200 IND-WRITE-GF-28. NC1214.2 +108300 MOVE "IND-TEST-GF-28" TO PAR-NAME. NC1214.2 +108400 PERFORM PRINT-DETAIL. NC1214.2 +108500 IND-INIT-GF-29. NC1214.2 +108600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +108700 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +108800 PERFORM BUILD-TABLE2. NC1214.2 +108900 MOVE ZERO TO NUM-9V9. NC1214.2 +109000 SET INDEX2 TO 2. NC1214.2 +109100 IND-TEST-GF-29-0. NC1214.2 +109200 DIVIDE TABLE2-NUM (INDEX2) BY TABLE2-NUM (INDEX2 + 1) NC1214.2 +109300 GIVING NUM-9V9. NC1214.2 +109400 IND-TEST-GF-29-1. NC1214.2 +109500 IF NUM-9V9 EQUAL TO 2.0 NC1214.2 +109600 PERFORM PASS NC1214.2 +109700 GO TO IND-WRITE-GF-29. NC1214.2 +109800 GO TO IND-FAIL-GF-29. NC1214.2 +109900 IND-DELETE-GF-29. NC1214.2 +110000 PERFORM DE-LETE. NC1214.2 +110100 GO TO IND-WRITE-GF-29. NC1214.2 +110200 IND-FAIL-GF-29. NC1214.2 +110300 PERFORM FAIL. NC1214.2 +110400 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +110500 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +110600 IND-WRITE-GF-29. NC1214.2 +110700 MOVE "IND-TEST-GF-29" TO PAR-NAME. NC1214.2 +110800 PERFORM PRINT-DETAIL. NC1214.2 +110900 IND-INIT-GF-30. NC1214.2 +111000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +111100 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +111200 PERFORM BUILD-TABLE2. NC1214.2 +111300 SET INDEX2 TO 6. NC1214.2 +111400 IND-TEST-GF-30-0. NC1214.2 +111500 DIVIDE TABLE2-NUM (INDEX2) BY TABLE2-NUM (INDEX2 - 3) NC1214.2 +111600 GIVING TABLE2-NUM (INDEX2 - 1). NC1214.2 +111700 IND-TEST-GF-30-1. NC1214.2 +111800 IF TABLE2-NUM (INDEX2 - 1) EQUAL TO 0.4 NC1214.2 +111900 PERFORM PASS NC1214.2 +112000 GO TO IND-WRITE-GF-30. NC1214.2 +112100 GO TO IND-FAIL-GF-30. NC1214.2 +112200 IND-DELETE-GF-30. NC1214.2 +112300 PERFORM DE-LETE. NC1214.2 +112400 GO TO IND-WRITE-GF-30. NC1214.2 +112500 IND-FAIL-GF-30. NC1214.2 +112600 PERFORM FAIL. NC1214.2 +112700 MOVE TABLE2-NUM (INDEX2 - 1) TO COMPUTED-14V4. NC1214.2 +112800 MOVE 0.4 TO CORRECT-14V4. NC1214.2 +112900 IND-WRITE-GF-30. NC1214.2 +113000 MOVE "IND-TEST-GF-30" TO PAR-NAME. NC1214.2 +113100 PERFORM PRINT-DETAIL. NC1214.2 +113200 IND-INIT-GF-31. NC1214.2 +113300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +113400 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +113500 MOVE ZERO TO NUM-9V9. NC1214.2 +113600 SET INDEX1 TO 1. NC1214.2 +113700 IND-TEST-GF-31-0. NC1214.2 +113800 DIVIDE 8 BY TABLE1-NUM (INDEX1) GIVING NUM-9V9. NC1214.2 +113900 IND-TEST-GF-31-1. NC1214.2 +114000 IF NUM-9V9 EQUAL TO 2.0 NC1214.2 +114100 PERFORM PASS NC1214.2 +114200 GO TO IND-WRITE-GF-31. NC1214.2 +114300 GO TO IND-FAIL-GF-31. NC1214.2 +114400 IND-DELETE-GF-31. NC1214.2 +114500 PERFORM DE-LETE. NC1214.2 +114600 GO TO IND-WRITE-GF-31. NC1214.2 +114700 IND-FAIL-GF-31. NC1214.2 +114800 PERFORM FAIL. NC1214.2 +114900 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +115000 MOVE 2.0 TO CORRECT-14V4. NC1214.2 +115100 IND-WRITE-GF-31. NC1214.2 +115200 MOVE "IND-TEST-GF-31" TO PAR-NAME. NC1214.2 +115300 PERFORM PRINT-DETAIL. NC1214.2 +115400 IND-INIT-GF-32. NC1214.2 +115500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +115600 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +115700 MOVE ZERO TO NUM-9V9. NC1214.2 +115800 PERFORM BUILD-TABLE2. NC1214.2 +115900 SET INDEX1 TO 3. NC1214.2 +116000 SET INDEX2 TO 4. NC1214.2 +116100 IND-TEST-GF-32-0. NC1214.2 +116200 DIVIDE TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +116300 GIVING NUM-9V9. NC1214.2 +116400 IND-TEST-GF-32-1. NC1214.2 +116500 IF NUM-9V9 EQUAL TO 3.5 NC1214.2 +116600 PERFORM PASS NC1214.2 +116700 GO TO IND-WRITE-GF-32. NC1214.2 +116800 GO TO IND-FAIL-GF-32. NC1214.2 +116900 IND-DELETE-GF-32. NC1214.2 +117000 PERFORM DE-LETE. NC1214.2 +117100 GO TO IND-WRITE-GF-32. NC1214.2 +117200 IND-FAIL-GF-32. NC1214.2 +117300 PERFORM FAIL. NC1214.2 +117400 MOVE NUM-9V9 TO COMPUTED-14V4. NC1214.2 +117500 MOVE 3.5 TO CORRECT-14V4. NC1214.2 +117600 IND-WRITE-GF-32. NC1214.2 +117700 MOVE "IND-TEST-GF-32" TO PAR-NAME. NC1214.2 +117800 PERFORM PRINT-DETAIL. NC1214.2 +117900 IND-INIT-GF-33. NC1214.2 +118000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +118100 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1214.2 +118200 MOVE ZERO TO TABLE3. NC1214.2 +118300 PERFORM BUILD-TABLE2. NC1214.2 +118400 SET INDEX1 TO 4. NC1214.2 +118500 SET INDEX2 TO 3. NC1214.2 +118600 SET INDEX3 TO 2. NC1214.2 +118700 IND-TEST-GF-33-0. NC1214.2 +118800 DIVIDE TABLE1-NUM (INDEX1) BY TABLE2-NUM (INDEX2) NC1214.2 +118900 GIVING TABLE3-NUM (INDEX3). NC1214.2 +119000 IND-TEST-GF-33-1. NC1214.2 +119100 IF TABLE3-NUM (INDEX3) EQUAL TO 1.0 NC1214.2 +119200 PERFORM PASS NC1214.2 +119300 GO TO IND-WRITE-GF-33. NC1214.2 +119400 GO TO IND-FAIL-GF-33. NC1214.2 +119500 IND-DELETE-GF-33. NC1214.2 +119600 PERFORM DE-LETE. NC1214.2 +119700 GO TO IND-WRITE-GF-33. NC1214.2 +119800 IND-FAIL-GF-33. NC1214.2 +119900 PERFORM FAIL. NC1214.2 +120000 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1214.2 +120100 MOVE 1.0 TO CORRECT-14V4. NC1214.2 +120200 IND-WRITE-GF-33. NC1214.2 +120300 MOVE "IND-TEST-GF-33" TO PAR-NAME. NC1214.2 +120400 PERFORM PRINT-DETAIL. NC1214.2 +120500 IND-INIT-GF-34. NC1214.2 +120600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +120700 MOVE "PERFORM" TO FEATURE. NC1214.2 +120800 MOVE ZERO TO NUM-9V9. NC1214.2 +120900 SET INDEX5 TO 1. NC1214.2 +121000 IND-TEST-GF-34-0. NC1214.2 +121100 PERFORM PARAGRAPH-A TABLE5-NUM (INDEX5) TIMES. NC1214.2 +121200 IND-TEST-GF-34-1. NC1214.2 +121300 IF NUM-9V9 EQUAL TO 3 NC1214.2 +121400 PERFORM PASS NC1214.2 +121500 ELSE GO TO IND-FAIL-GF-34. NC1214.2 +121600 GO TO IND-WRITE-GF-34. NC1214.2 +121700 IND-DELETE-GF-34. NC1214.2 +121800 PERFORM DE-LETE. NC1214.2 +121900 GO TO IND-WRITE-GF-34. NC1214.2 +122000 IND-FAIL-GF-34. NC1214.2 +122100 PERFORM FAIL. NC1214.2 +122200 MOVE NUM-9V9 TO COMPUTED-18V0. NC1214.2 +122300 MOVE 3 TO CORRECT-18V0. NC1214.2 +122400 IND-WRITE-GF-34. NC1214.2 +122500 MOVE "IND-TEST-GF-34" TO PAR-NAME. NC1214.2 +122600 PERFORM PRINT-DETAIL. NC1214.2 +122700 IND-INIT-GF-35. NC1214.2 +122800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +122900 MOVE "PERFORM THRU" TO FEATURE. NC1214.2 +123000 MOVE ZERO TO NUM-9V9. NC1214.2 +123100 SET INDEX5 TO 2. NC1214.2 +123200 IND-TEST-GF-35-0. NC1214.2 +123300 PERFORM PARAGRAPH-A THRU PARAGRAPH-B NC1214.2 +123400 TABLE5-NUM (INDEX5) TIMES. NC1214.2 +123500 IND-TEST-GF-35-1. NC1214.2 +123600 IF NUM-9V9 EQUAL TO 4 NC1214.2 +123700 PERFORM PASS NC1214.2 +123800 ELSE GO TO IND-FAIL-GF-35. NC1214.2 +123900 GO TO IND-WRITE-GF-35. NC1214.2 +124000 IND-DELETE-GF-35. NC1214.2 +124100 PERFORM DE-LETE. NC1214.2 +124200 GO TO IND-WRITE-GF-35. NC1214.2 +124300 IND-FAIL-GF-35. NC1214.2 +124400 PERFORM FAIL. NC1214.2 +124500 MOVE NUM-9V9 TO COMPUTED-18V0. NC1214.2 +124600 MOVE 4 TO CORRECT-18V0. NC1214.2 +124700 IND-WRITE-GF-35. NC1214.2 +124800 MOVE "IND-TEST-GF-35" TO PAR-NAME. NC1214.2 +124900 PERFORM PRINT-DETAIL. NC1214.2 +125000 IND-INIT-GF-36. NC1214.2 +125100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +125200 MOVE "DISPLAY" TO FEATURE. NC1214.2 +125300 MOVE "RESULTS MUST BE" TO RE-MARK. NC1214.2 +125400 MOVE "LITERAL-01" TO CORRECT-A. NC1214.2 +125500 SET INDEX6 TO 1. NC1214.2 +125600 IND-TEST-GF-36. NC1214.2 +125700 DISPLAY " ". NC1214.2 +125800 DISPLAY TABLE6-REC (INDEX6). NC1214.2 +125900 PERFORM INSPT. NC1214.2 +126000 GO TO IND-WRITE-GF-36. NC1214.2 +126100 IND-DELETE-GF-36. NC1214.2 +126200 PERFORM DE-LETE. NC1214.2 +126300 IND-WRITE-GF-36. NC1214.2 +126400 MOVE "IND-TEST-GF-36" TO PAR-NAME. NC1214.2 +126500 PERFORM PRINT-DETAIL. NC1214.2 +126600 IND-INIT-GF-37. NC1214.2 +126700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1214.2 +126800 MOVE "DISPLAY" TO FEATURE. NC1214.2 +126900 MOVE "VISUALLY CHECKED" TO RE-MARK. NC1214.2 +127000 MOVE "0123456789" TO CORRECT-A. NC1214.2 +127100 SET INDEX6 TO 1. NC1214.2 +127200 IND-TEST-GF-37. NC1214.2 +127300 DISPLAY TABLE6-REC (INDEX6 + 1). NC1214.2 +127400 PERFORM INSPT. NC1214.2 +127500 GO TO IND-WRITE-GF-37. NC1214.2 +127600 IND-DELETE-GF-37. NC1214.2 +127700 PERFORM DE-LETE. NC1214.2 +127800 IND-WRITE-GF-37. NC1214.2 +127900 MOVE "IND-TEST-GF-37" TO PAR-NAME. NC1214.2 +128000 PERFORM PRINT-DETAIL. NC1214.2 +128100 GO TO CCVS-999999. NC1214.2 +128200 PARAGRAPH-A. NC1214.2 +128300 ADD 1 TO NUM-9V9. NC1214.2 +128400 PARAGRAPH-B. NC1214.2 +128500 ADD 1 TO NUM-9V9. NC1214.2 +128600 CCVS-EXIT SECTION. NC1214.2 +128700 CCVS-999999. NC1214.2 +128800 GO TO CLOSE-FILES. NC1214.2 diff --git a/tests/cobol85/NC/NC122A.CBL b/tests/cobol85/NC/NC122A.CBL new file mode 100755 index 00000000..1b496d73 --- /dev/null +++ b/tests/cobol85/NC/NC122A.CBL @@ -0,0 +1,1038 @@ +000100 IDENTIFICATION DIVISION. NC1224.2 +000200 PROGRAM-ID. NC1224.2 +000300 NC122A. NC1224.2 +000400**************************************************************** NC1224.2 +000500* * NC1224.2 +000600* VALIDATION FOR:- * NC1224.2 +000700* * NC1224.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1224.2 +000900* * NC1224.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1224.2 +001100* * NC1224.2 +001200**************************************************************** NC1224.2 +001300* * NC1224.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1224.2 +001500* * NC1224.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1224.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1224.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1224.2 +001900* * NC1224.2 +002000**************************************************************** NC1224.2 +002100* NC1224.2 +002200* PROGRAM NC122A TESTS THE USE OF INDEXED IDENTIFIERS USING NC1224.2 +002300* FORMATS 1, 2 AND 3 OF THE "INSPECT" STATEMENT. NC1224.2 +002400* SINGLE LEVEL AND RELATIVE INDEXING ARE USED. NC1224.2 +002500* NC1224.2 +002600 ENVIRONMENT DIVISION. NC1224.2 +002700 CONFIGURATION SECTION. NC1224.2 +002800 SOURCE-COMPUTER. NC1224.2 +002900 Linux. NC1224.2 +003000 OBJECT-COMPUTER. NC1224.2 +003100 Linux. NC1224.2 +003200 INPUT-OUTPUT SECTION. NC1224.2 +003300 FILE-CONTROL. NC1224.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1224.2 +003500 "report.log". NC1224.2 +003600 DATA DIVISION. NC1224.2 +003700 FILE SECTION. NC1224.2 +003800 FD PRINT-FILE. NC1224.2 +003900 01 PRINT-REC PICTURE X(120). NC1224.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1224.2 +004100 WORKING-STORAGE SECTION. NC1224.2 +004200 01 WRK-OK. NC1224.2 +004300 03 WRK-OK-1-20 PIC X(20). NC1224.2 +004400 03 WRK-OK-21-40 PIC X(20). NC1224.2 +004500 03 WRK-OK-41-60 PIC X(20). NC1224.2 +004600 03 WRK-OK-61-80 PIC X(20). NC1224.2 +004700 03 WRK-OK-81-83 PIC X(3). NC1224.2 +004800 01 WRK-ER. NC1224.2 +004900 03 WRK-ER-1-20 PIC X(20). NC1224.2 +005000 03 WRK-ER-21-40 PIC X(20). NC1224.2 +005100 03 WRK-ER-41-60 PIC X(20). NC1224.2 +005200 03 WRK-ER-61-80 PIC X(20). NC1224.2 +005300 03 WRK-ER-81-83 PIC X(3). NC1224.2 +005400 01 TABLE1. NC1224.2 +005500 02 TABLE1-REC PICTURE X(83) NC1224.2 +005600 OCCURS 4 TIMES NC1224.2 +005700 INDEXED BY INDEX1. NC1224.2 +005800 01 TABLE2. NC1224.2 +005900 02 WRK-DU-999 PICTURE 999 NC1224.2 +006000 OCCURS 4 TIMES NC1224.2 +006100 INDEXED BY INDEX2. NC1224.2 +006200 01 TABLE3. NC1224.2 +006300 02 TABLE3-SYMBOL PICTURE X NC1224.2 +006400 OCCURS 3 TIMES NC1224.2 +006500 INDEXED BY INDEX3. NC1224.2 +006600 01 TABLE4. NC1224.2 +006700 02 TABLE4-LETTER PICTURE X NC1224.2 +006800 OCCURS 9 TIMES NC1224.2 +006900 INDEXED BY INDEX4. NC1224.2 +007000 01 WC-XN-83 PIC X(83) VALUE NC1224.2 +007100 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +007200- "IDS CAN NOT BE ALL BAD.". NC1224.2 +007300 01 ANS-XN-83-1 PIC X(83) VALUE NC1224.2 +007400 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +007500- "IDS CAN NOT BE ALL BAD.". NC1224.2 +007600 01 ANS-XN-83-2 PIC X(83) VALUE NC1224.2 +007700 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +007800- "IDS CAN NOT BE ALL BAD.". NC1224.2 +007900 01 ANS-XN-83-3 PIC X(83) VALUE NC1224.2 +008000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +008100- "IDS CAN NOT BE ALL-BAD.". NC1224.2 +008200 01 ANS-XN-83-4 PIC X(83) VALUE NC1224.2 +008300 "EH YES EH YES W.C. FRITOES HERE. ENYONE WHO HETES DOGS END KNC1224.2 +008400- "IDS CEN NOT BE ELL BAD.". NC1224.2 +008500 01 ANS-XN-83-5 PIC X(83) VALUE NC1224.2 +008600 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC1224.2 +008700- "IDS CAN NOT BE ALL BAD.". NC1224.2 +008800 01 TEST-RESULTS. NC1224.2 +008900 02 FILLER PIC X VALUE SPACE. NC1224.2 +009000 02 FEATURE PIC X(20) VALUE SPACE. NC1224.2 +009100 02 FILLER PIC X VALUE SPACE. NC1224.2 +009200 02 P-OR-F PIC X(5) VALUE SPACE. NC1224.2 +009300 02 FILLER PIC X VALUE SPACE. NC1224.2 +009400 02 PAR-NAME. NC1224.2 +009500 03 FILLER PIC X(19) VALUE SPACE. NC1224.2 +009600 03 PARDOT-X PIC X VALUE SPACE. NC1224.2 +009700 03 DOTVALUE PIC 99 VALUE ZERO. NC1224.2 +009800 02 FILLER PIC X(8) VALUE SPACE. NC1224.2 +009900 02 RE-MARK PIC X(61). NC1224.2 +010000 01 TEST-COMPUTED. NC1224.2 +010100 02 FILLER PIC X(30) VALUE SPACE. NC1224.2 +010200 02 FILLER PIC X(17) VALUE NC1224.2 +010300 " COMPUTED=". NC1224.2 +010400 02 COMPUTED-X. NC1224.2 +010500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1224.2 +010600 03 COMPUTED-N REDEFINES COMPUTED-A NC1224.2 +010700 PIC -9(9).9(9). NC1224.2 +010800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1224.2 +010900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1224.2 +011000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1224.2 +011100 03 CM-18V0 REDEFINES COMPUTED-A. NC1224.2 +011200 04 COMPUTED-18V0 PIC -9(18). NC1224.2 +011300 04 FILLER PIC X. NC1224.2 +011400 03 FILLER PIC X(50) VALUE SPACE. NC1224.2 +011500 01 TEST-CORRECT. NC1224.2 +011600 02 FILLER PIC X(30) VALUE SPACE. NC1224.2 +011700 02 FILLER PIC X(17) VALUE " CORRECT =". NC1224.2 +011800 02 CORRECT-X. NC1224.2 +011900 03 CORRECT-A PIC X(20) VALUE SPACE. NC1224.2 +012000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1224.2 +012100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1224.2 +012200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1224.2 +012300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1224.2 +012400 03 CR-18V0 REDEFINES CORRECT-A. NC1224.2 +012500 04 CORRECT-18V0 PIC -9(18). NC1224.2 +012600 04 FILLER PIC X. NC1224.2 +012700 03 FILLER PIC X(2) VALUE SPACE. NC1224.2 +012800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1224.2 +012900 01 CCVS-C-1. NC1224.2 +013000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1224.2 +013100- "SS PARAGRAPH-NAME NC1224.2 +013200- " REMARKS". NC1224.2 +013300 02 FILLER PIC X(20) VALUE SPACE. NC1224.2 +013400 01 CCVS-C-2. NC1224.2 +013500 02 FILLER PIC X VALUE SPACE. NC1224.2 +013600 02 FILLER PIC X(6) VALUE "TESTED". NC1224.2 +013700 02 FILLER PIC X(15) VALUE SPACE. NC1224.2 +013800 02 FILLER PIC X(4) VALUE "FAIL". NC1224.2 +013900 02 FILLER PIC X(94) VALUE SPACE. NC1224.2 +014000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1224.2 +014100 01 REC-CT PIC 99 VALUE ZERO. NC1224.2 +014200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1224.2 +014300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1224.2 +014400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1224.2 +014500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1224.2 +014600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1224.2 +014700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1224.2 +014800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1224.2 +014900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1224.2 +015000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1224.2 +015100 01 CCVS-H-1. NC1224.2 +015200 02 FILLER PIC X(39) VALUE SPACES. NC1224.2 +015300 02 FILLER PIC X(42) VALUE NC1224.2 +015400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1224.2 +015500 02 FILLER PIC X(39) VALUE SPACES. NC1224.2 +015600 01 CCVS-H-2A. NC1224.2 +015700 02 FILLER PIC X(40) VALUE SPACE. NC1224.2 +015800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1224.2 +015900 02 FILLER PIC XXXX VALUE NC1224.2 +016000 "4.2 ". NC1224.2 +016100 02 FILLER PIC X(28) VALUE NC1224.2 +016200 " COPY - NOT FOR DISTRIBUTION". NC1224.2 +016300 02 FILLER PIC X(41) VALUE SPACE. NC1224.2 +016400 NC1224.2 +016500 01 CCVS-H-2B. NC1224.2 +016600 02 FILLER PIC X(15) VALUE NC1224.2 +016700 "TEST RESULT OF ". NC1224.2 +016800 02 TEST-ID PIC X(9). NC1224.2 +016900 02 FILLER PIC X(4) VALUE NC1224.2 +017000 " IN ". NC1224.2 +017100 02 FILLER PIC X(12) VALUE NC1224.2 +017200 " HIGH ". NC1224.2 +017300 02 FILLER PIC X(22) VALUE NC1224.2 +017400 " LEVEL VALIDATION FOR ". NC1224.2 +017500 02 FILLER PIC X(58) VALUE NC1224.2 +017600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1224.2 +017700 01 CCVS-H-3. NC1224.2 +017800 02 FILLER PIC X(34) VALUE NC1224.2 +017900 " FOR OFFICIAL USE ONLY ". NC1224.2 +018000 02 FILLER PIC X(58) VALUE NC1224.2 +018100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1224.2 +018200 02 FILLER PIC X(28) VALUE NC1224.2 +018300 " COPYRIGHT 1985 ". NC1224.2 +018400 01 CCVS-E-1. NC1224.2 +018500 02 FILLER PIC X(52) VALUE SPACE. NC1224.2 +018600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1224.2 +018700 02 ID-AGAIN PIC X(9). NC1224.2 +018800 02 FILLER PIC X(45) VALUE SPACES. NC1224.2 +018900 01 CCVS-E-2. NC1224.2 +019000 02 FILLER PIC X(31) VALUE SPACE. NC1224.2 +019100 02 FILLER PIC X(21) VALUE SPACE. NC1224.2 +019200 02 CCVS-E-2-2. NC1224.2 +019300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1224.2 +019400 03 FILLER PIC X VALUE SPACE. NC1224.2 +019500 03 ENDER-DESC PIC X(44) VALUE NC1224.2 +019600 "ERRORS ENCOUNTERED". NC1224.2 +019700 01 CCVS-E-3. NC1224.2 +019800 02 FILLER PIC X(22) VALUE NC1224.2 +019900 " FOR OFFICIAL USE ONLY". NC1224.2 +020000 02 FILLER PIC X(12) VALUE SPACE. NC1224.2 +020100 02 FILLER PIC X(58) VALUE NC1224.2 +020200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1224.2 +020300 02 FILLER PIC X(13) VALUE SPACE. NC1224.2 +020400 02 FILLER PIC X(15) VALUE NC1224.2 +020500 " COPYRIGHT 1985". NC1224.2 +020600 01 CCVS-E-4. NC1224.2 +020700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1224.2 +020800 02 FILLER PIC X(4) VALUE " OF ". NC1224.2 +020900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1224.2 +021000 02 FILLER PIC X(40) VALUE NC1224.2 +021100 " TESTS WERE EXECUTED SUCCESSFULLY". NC1224.2 +021200 01 XXINFO. NC1224.2 +021300 02 FILLER PIC X(19) VALUE NC1224.2 +021400 "*** INFORMATION ***". NC1224.2 +021500 02 INFO-TEXT. NC1224.2 +021600 04 FILLER PIC X(8) VALUE SPACE. NC1224.2 +021700 04 XXCOMPUTED PIC X(20). NC1224.2 +021800 04 FILLER PIC X(5) VALUE SPACE. NC1224.2 +021900 04 XXCORRECT PIC X(20). NC1224.2 +022000 02 INF-ANSI-REFERENCE PIC X(48). NC1224.2 +022100 01 HYPHEN-LINE. NC1224.2 +022200 02 FILLER PIC IS X VALUE IS SPACE. NC1224.2 +022300 02 FILLER PIC IS X(65) VALUE IS "************************NC1224.2 +022400- "*****************************************". NC1224.2 +022500 02 FILLER PIC IS X(54) VALUE IS "************************NC1224.2 +022600- "******************************". NC1224.2 +022700 01 CCVS-PGM-ID PIC X(9) VALUE NC1224.2 +022800 "NC122A". NC1224.2 +022900 PROCEDURE DIVISION. NC1224.2 +023000 CCVS1 SECTION. NC1224.2 +023100 OPEN-FILES. NC1224.2 +023200 OPEN OUTPUT PRINT-FILE. NC1224.2 +023300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1224.2 +023400 MOVE SPACE TO TEST-RESULTS. NC1224.2 +023500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1224.2 +023600 GO TO CCVS1-EXIT. NC1224.2 +023700 CLOSE-FILES. NC1224.2 +023800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1224.2 +023900 TERMINATE-CCVS. NC1224.2 +024000*S EXIT PROGRAM. NC1224.2 +024100*SERMINATE-CALL. NC1224.2 +024200 STOP RUN. NC1224.2 +024300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1224.2 +024400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1224.2 +024500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1224.2 +024600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1224.2 +024700 MOVE "****TEST DELETED****" TO RE-MARK. NC1224.2 +024800 PRINT-DETAIL. NC1224.2 +024900 IF REC-CT NOT EQUAL TO ZERO NC1224.2 +025000 MOVE "." TO PARDOT-X NC1224.2 +025100 MOVE REC-CT TO DOTVALUE. NC1224.2 +025200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1224.2 +025300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1224.2 +025400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1224.2 +025500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1224.2 +025600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1224.2 +025700 MOVE SPACE TO CORRECT-X. NC1224.2 +025800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1224.2 +025900 MOVE SPACE TO RE-MARK. NC1224.2 +026000 HEAD-ROUTINE. NC1224.2 +026100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +026200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +026300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1224.2 +026400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1224.2 +026500 COLUMN-NAMES-ROUTINE. NC1224.2 +026600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +026700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +026800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +026900 END-ROUTINE. NC1224.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1224.2 +027100 END-RTN-EXIT. NC1224.2 +027200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +027300 END-ROUTINE-1. NC1224.2 +027400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1224.2 +027500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1224.2 +027600 ADD PASS-COUNTER TO ERROR-HOLD. NC1224.2 +027700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1224.2 +027800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1224.2 +027900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1224.2 +028000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1224.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1224.2 +028200 END-ROUTINE-12. NC1224.2 +028300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1224.2 +028400 IF ERROR-COUNTER IS EQUAL TO ZERO NC1224.2 +028500 MOVE "NO " TO ERROR-TOTAL NC1224.2 +028600 ELSE NC1224.2 +028700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1224.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1224.2 +028900 PERFORM WRITE-LINE. NC1224.2 +029000 END-ROUTINE-13. NC1224.2 +029100 IF DELETE-COUNTER IS EQUAL TO ZERO NC1224.2 +029200 MOVE "NO " TO ERROR-TOTAL ELSE NC1224.2 +029300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1224.2 +029400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1224.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +029600 IF INSPECT-COUNTER EQUAL TO ZERO NC1224.2 +029700 MOVE "NO " TO ERROR-TOTAL NC1224.2 +029800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1224.2 +029900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1224.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +030100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1224.2 +030200 WRITE-LINE. NC1224.2 +030300 ADD 1 TO RECORD-COUNT. NC1224.2 +030400 IF RECORD-COUNT GREATER 42 NC1224.2 +030500 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1224.2 +030600 MOVE SPACE TO DUMMY-RECORD NC1224.2 +030700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1224.2 +030800 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1224.2 +030900 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1224.2 +031000 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1224.2 +031100 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1224.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1224.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1224.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1224.2 +031500 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1224.2 +031600 MOVE ZERO TO RECORD-COUNT. NC1224.2 +031700 PERFORM WRT-LN. NC1224.2 +031800 WRT-LN. NC1224.2 +031900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1224.2 +032000 MOVE SPACE TO DUMMY-RECORD. NC1224.2 +032100 BLANK-LINE-PRINT. NC1224.2 +032200 PERFORM WRT-LN. NC1224.2 +032300 FAIL-ROUTINE. NC1224.2 +032400 IF COMPUTED-X NOT EQUAL TO SPACE NC1224.2 +032500 GO TO FAIL-ROUTINE-WRITE. NC1224.2 +032600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1224.2 +032700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1224.2 +032800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1224.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1224.2 +033100 GO TO FAIL-ROUTINE-EX. NC1224.2 +033200 FAIL-ROUTINE-WRITE. NC1224.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1224.2 +033400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1224.2 +033500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1224.2 +033600 MOVE SPACES TO COR-ANSI-REFERENCE. NC1224.2 +033700 FAIL-ROUTINE-EX. EXIT. NC1224.2 +033800 BAIL-OUT. NC1224.2 +033900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1224.2 +034000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1224.2 +034100 BAIL-OUT-WRITE. NC1224.2 +034200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1224.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1224.2 +034400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1224.2 +034500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1224.2 +034600 BAIL-OUT-EX. EXIT. NC1224.2 +034700 CCVS1-EXIT. NC1224.2 +034800 EXIT. NC1224.2 +034900 BUILD-TABLE1. NC1224.2 +035000 MOVE WC-XN-83 TO TABLE1-REC (1). NC1224.2 +035100 MOVE WC-XN-83 TO TABLE1-REC (2). NC1224.2 +035200 MOVE WC-XN-83 TO TABLE1-REC (3). NC1224.2 +035300 MOVE WC-XN-83 TO TABLE1-REC (4). NC1224.2 +035400 BUILD-TABLE3. NC1224.2 +035500 MOVE " " TO TABLE3-SYMBOL (1). NC1224.2 +035600 MOVE "," TO TABLE3-SYMBOL (2). NC1224.2 +035700 MOVE "-" TO TABLE3-SYMBOL (3). NC1224.2 +035800 BUILD-TABLE4. NC1224.2 +035900 MOVE "A" TO TABLE4-LETTER (1). NC1224.2 +036000 MOVE "D" TO TABLE4-LETTER (2). NC1224.2 +036100 MOVE "G" TO TABLE4-LETTER (3). NC1224.2 +036200 MOVE "H" TO TABLE4-LETTER (4). NC1224.2 +036300 MOVE "L" TO TABLE4-LETTER (5). NC1224.2 +036400 MOVE "O" TO TABLE4-LETTER (6). NC1224.2 +036500 MOVE "Y" TO TABLE4-LETTER (7). NC1224.2 +036600 MOVE "S" TO TABLE4-LETTER (8). NC1224.2 +036700 MOVE "Z" TO TABLE4-LETTER (9). NC1224.2 +036800 IND-INIT-GF-1. NC1224.2 +036900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +037000 MOVE ZERO TO TABLE2. NC1224.2 +037100 SET INDEX1 TO 1. NC1224.2 +037200 SET INDEX2 TO 1. NC1224.2 +037300 IND-TEST-GF-1-0. NC1224.2 +037400 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +037500 FOR CHARACTERS. NC1224.2 +037600 IND-TEST-GF-1-1. NC1224.2 +037700 IF WRK-DU-999 (INDEX2) EQUAL TO 83 NC1224.2 +037800 PERFORM PASS NC1224.2 +037900 GO TO IND-WRITE-GF-1. NC1224.2 +038000 GO TO IND-FAIL-GF-1. NC1224.2 +038100 IND-DELETE-GF-1. NC1224.2 +038200 PERFORM DE-LETE. NC1224.2 +038300 GO TO IND-WRITE-GF-1. NC1224.2 +038400 IND-FAIL-GF-1. NC1224.2 +038500 PERFORM FAIL. NC1224.2 +038600 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +038700 MOVE 83 TO CORRECT-N. NC1224.2 +038800 IND-WRITE-GF-1. NC1224.2 +038900 MOVE "IND-TEST-GF-1" TO PAR-NAME. NC1224.2 +039000 MOVE "TALLY FOR CHARACTERS" TO FEATURE. NC1224.2 +039100 PERFORM PRINT-DETAIL. NC1224.2 +039200 IND-INIT-GF-2. NC1224.2 +039300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +039400 MOVE ZERO TO TABLE2. NC1224.2 +039500 SET INDEX1 TO 2. NC1224.2 +039600 SET INDEX2 TO 2. NC1224.2 +039700 MOVE ZERO TO WRK-DU-999 (INDEX2). NC1224.2 +039800 IND-TEST-GF-2-0. NC1224.2 +039900 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +040000 FOR ALL "A". NC1224.2 +040100 IND-TEST-GF-2-1. NC1224.2 +040200 IF WRK-DU-999 (INDEX2) EQUAL TO 8 NC1224.2 +040300 PERFORM PASS NC1224.2 +040400 GO TO IND-WRITE-GF-2. NC1224.2 +040500 GO TO IND-FAIL-GF-2. NC1224.2 +040600 IND-DELETE-GF-2. NC1224.2 +040700 PERFORM DE-LETE. NC1224.2 +040800 GO TO IND-WRITE-GF-2. NC1224.2 +040900 IND-FAIL-GF-2. NC1224.2 +041000 PERFORM FAIL. NC1224.2 +041100 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +041200 MOVE 8 TO CORRECT-N. NC1224.2 +041300 IND-WRITE-GF-2. NC1224.2 +041400 MOVE "IND-TEST-GF-2" TO PAR-NAME. NC1224.2 +041500 MOVE "TALLY FOR LITERAL" TO FEATURE. NC1224.2 +041600 PERFORM PRINT-DETAIL. NC1224.2 +041700 IND-INIT-GF-3. NC1224.2 +041800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +041900 MOVE ZERO TO TABLE2. NC1224.2 +042000 SET INDEX1 TO 3. NC1224.2 +042100 SET INDEX2 TO 3. NC1224.2 +042200 MOVE ZERO TO WRK-DU-999 (INDEX2). NC1224.2 +042300 IND-TEST-GF-3-0. NC1224.2 +042400 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +042500 FOR ALL SPACE. NC1224.2 +042600 IND-TEST-GF-3-1. NC1224.2 +042700 IF WRK-DU-999 (INDEX2) EQUAL TO 17 NC1224.2 +042800 PERFORM PASS NC1224.2 +042900 GO TO IND-WRITE-GF-3. NC1224.2 +043000 GO TO IND-FAIL-GF-3. NC1224.2 +043100 IND-DELETE-GF-3. NC1224.2 +043200 PERFORM DE-LETE. NC1224.2 +043300 GO TO IND-WRITE-GF-3. NC1224.2 +043400 IND-FAIL-GF-3. NC1224.2 +043500 PERFORM FAIL. NC1224.2 +043600 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +043700 MOVE 17 TO CORRECT-N. NC1224.2 +043800 IND-WRITE-GF-3. NC1224.2 +043900 MOVE "IND-TEST-GF-3" TO PAR-NAME. NC1224.2 +044000 MOVE "TALLY FOR ALL SPACE" TO FEATURE. NC1224.2 +044100 PERFORM PRINT-DETAIL. NC1224.2 +044200 IND-INIT-GF-4. NC1224.2 +044300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +044400 MOVE ZERO TO TABLE2. NC1224.2 +044500 SET INDEX1 TO 4. NC1224.2 +044600 SET INDEX2 TO 4. NC1224.2 +044700 MOVE ZERO TO WRK-DU-999 (INDEX2). NC1224.2 +044800 IND-TEST-GF-4-0. NC1224.2 +044900 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +045000 FOR LEADING "A". NC1224.2 +045100 IND-TEST-GF-4-1. NC1224.2 +045200 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC1224.2 +045300 PERFORM PASS NC1224.2 +045400 GO TO IND-WRITE-GF-4. NC1224.2 +045500 GO TO IND-FAIL-GF-4. NC1224.2 +045600 IND-DELETE-GF-4. NC1224.2 +045700 PERFORM DE-LETE. NC1224.2 +045800 GO TO IND-WRITE-GF-4. NC1224.2 +045900 IND-FAIL-GF-4. NC1224.2 +046000 PERFORM FAIL. NC1224.2 +046100 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +046200 MOVE 1 TO CORRECT-N. NC1224.2 +046300 IND-WRITE-GF-4. NC1224.2 +046400 MOVE "IND-TEST-GF-4" TO PAR-NAME. NC1224.2 +046500 MOVE "TALLY LEADING LIT." TO FEATURE. NC1224.2 +046600 PERFORM PRINT-DETAIL. NC1224.2 +046700 IND-INIT-GF-5. NC1224.2 +046800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +046900 SET INDEX1 TO 1. NC1224.2 +047000 SET INDEX2 TO 2. NC1224.2 +047100 MOVE ZERO TO TABLE2. NC1224.2 +047200 MOVE ZERO TO WRK-DU-999 (INDEX2 + 1). NC1224.2 +047300 IND-TEST-GF-5-0. NC1224.2 +047400 INSPECT TABLE1-REC (INDEX1 + 1) TALLYING NC1224.2 +047500 WRK-DU-999 (INDEX2 + 1) NC1224.2 +047600 FOR CHARACTERS AFTER "W". NC1224.2 +047700 IND-TEST-GF-5-1. NC1224.2 +047800 IF WRK-DU-999 (INDEX2 + 1) EQUAL TO 68 NC1224.2 +047900 PERFORM PASS NC1224.2 +048000 GO TO IND-WRITE-GF-5. NC1224.2 +048100 GO TO IND-FAIL-GF-5. NC1224.2 +048200 IND-DELETE-GF-5. NC1224.2 +048300 PERFORM DE-LETE. NC1224.2 +048400 GO TO IND-WRITE-GF-5. NC1224.2 +048500 IND-FAIL-GF-5. NC1224.2 +048600 PERFORM FAIL. NC1224.2 +048700 MOVE WRK-DU-999 (INDEX2 + 1) TO COMPUTED-N. NC1224.2 +048800 MOVE 68 TO CORRECT-N. NC1224.2 +048900 IND-WRITE-GF-5. NC1224.2 +049000 MOVE "IND-TEST-GF-5" TO PAR-NAME. NC1224.2 +049100 MOVE "FOR CHARS AFTER LIT." TO FEATURE. NC1224.2 +049200 PERFORM PRINT-DETAIL. NC1224.2 +049300 IND-INIT-GF-6. NC1224.2 +049400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +049500 MOVE ZERO TO TABLE2. NC1224.2 +049600 SET INDEX1 TO 3. NC1224.2 +049700 SET INDEX2 TO 4. NC1224.2 +049800 MOVE ZERO TO WRK-DU-999 (INDEX2 - 2). NC1224.2 +049900 IND-TEST-GF-6-0. NC1224.2 +050000 INSPECT TABLE1-REC (INDEX1 - 1) NC1224.2 +050100 TALLYING WRK-DU-999 (INDEX2 - 2) NC1224.2 +050200 FOR ALL " " BEFORE INITIAL "W". NC1224.2 +050300 IND-TEST-GF-6-1. NC1224.2 +050400 IF WRK-DU-999 (INDEX2 - 2) EQUAL TO 4 NC1224.2 +050500 PERFORM PASS NC1224.2 +050600 GO TO IND-WRITE-GF-6. NC1224.2 +050700 GO TO IND-FAIL-GF-6. NC1224.2 +050800 IND-DELETE-GF-6. NC1224.2 +050900 PERFORM DE-LETE. NC1224.2 +051000 GO TO IND-WRITE-GF-6. NC1224.2 +051100 IND-FAIL-GF-6. NC1224.2 +051200 PERFORM FAIL. NC1224.2 +051300 MOVE WRK-DU-999 (INDEX2 - 2) TO COMPUTED-N. NC1224.2 +051400 MOVE 4 TO CORRECT-N. NC1224.2 +051500 IND-WRITE-GF-6. NC1224.2 +051600 MOVE "IND-TEST-GF-6" TO PAR-NAME. NC1224.2 +051700 MOVE "ALL BEFORE INITIAL" TO FEATURE. NC1224.2 +051800 PERFORM PRINT-DETAIL. NC1224.2 +051900 IND-INIT-GF-7. NC1224.2 +052000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +052100 MOVE ZERO TO TABLE2. NC1224.2 +052200 SET INDEX1 TO 1. NC1224.2 +052300 SET INDEX2 TO 1. NC1224.2 +052400 MOVE ZERO TO WRK-DU-999 (INDEX2). NC1224.2 +052500 IND-TEST-GF-7-0. NC1224.2 +052600 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +052700 FOR LEADING "Y" AFTER INITIAL SPACE. NC1224.2 +052800 IND-TEST-GF-7-1. NC1224.2 +052900 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC1224.2 +053000 PERFORM PASS NC1224.2 +053100 GO TO IND-WRITE-GF-7. NC1224.2 +053200 GO TO IND-FAIL-GF-7. NC1224.2 +053300 IND-DELETE-GF-7. NC1224.2 +053400 PERFORM DE-LETE. NC1224.2 +053500 GO TO IND-WRITE-GF-7. NC1224.2 +053600 IND-FAIL-GF-7. NC1224.2 +053700 PERFORM FAIL. NC1224.2 +053800 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC1224.2 +053900 MOVE 1 TO CORRECT-N. NC1224.2 +054000 IND-WRITE-GF-7. NC1224.2 +054100 MOVE "IND-TEST-GF-7" TO PAR-NAME. NC1224.2 +054200 MOVE "LEAD. LIT. INITIAL" TO FEATURE. NC1224.2 +054300 PERFORM PRINT-DETAIL. NC1224.2 +054400 IND-INIT-GF-8. NC1224.2 +054500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +054600 PERFORM BUILD-TABLE1. NC1224.2 +054700 SET INDEX1 TO 1. NC1224.2 +054800 IND-TEST-GF-8-0. NC1224.2 +054900 INSPECT TABLE1-REC (INDEX1) REPLACING CHARACTERS BY SPACE. NC1224.2 +055000 IND-TEST-GF-8-1. NC1224.2 +055100 IF TABLE1-REC (INDEX1) EQUAL TO SPACE NC1224.2 +055200 PERFORM PASS NC1224.2 +055300 GO TO IND-WRITE-GF-8. NC1224.2 +055400 GO TO IND-FAIL-GF-8. NC1224.2 +055500 IND-DELETE-GF-8. NC1224.2 +055600 PERFORM DE-LETE. NC1224.2 +055700 GO TO IND-WRITE-GF-8. NC1224.2 +055800 IND-FAIL-GF-8. NC1224.2 +055900 PERFORM FAIL. NC1224.2 +056000 MOVE TABLE1-REC (INDEX1) TO COMPUTED-A. NC1224.2 +056100 MOVE "SPACES" TO CORRECT-A. NC1224.2 +056200 IND-WRITE-GF-8. NC1224.2 +056300 MOVE "IND-TEST-GF-8" TO PAR-NAME. NC1224.2 +056400 MOVE "REP. CHARS BY SPACE" TO FEATURE. NC1224.2 +056500 PERFORM PRINT-DETAIL. NC1224.2 +056600 IND-INIT-GF-9. NC1224.2 +056700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +056800 PERFORM BUILD-TABLE1. NC1224.2 +056900 SET INDEX1 TO 2. NC1224.2 +057000 IND-TEST-GF-9-0. NC1224.2 +057100 INSPECT TABLE1-REC (INDEX1) REPLACING CHARACTERS NC1224.2 +057200 BY "O" BEFORE INITIAL "H". NC1224.2 +057300 IND-TEST-GF-9-1. NC1224.2 +057400 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC1224.2 +057500 PERFORM PASS NC1224.2 +057600 GO TO IND-WRITE-GF-9. NC1224.2 +057700 GO TO IND-FAIL-GF-9. NC1224.2 +057800 IND-DELETE-GF-9. NC1224.2 +057900 PERFORM DE-LETE. NC1224.2 +058000 GO TO IND-WRITE-GF-9. NC1224.2 +058100 IND-FAIL-GF-9. NC1224.2 +058200 PERFORM FAIL. NC1224.2 +058300 MOVE TABLE1-REC (INDEX1) TO WRK-ER. NC1224.2 +058400 MOVE ANS-XN-83-1 TO WRK-OK. NC1224.2 +058500 MOVE WRK-OK-1-20 TO CORRECT-X. NC1224.2 +058600 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1224.2 +058700 PERFORM PRINT-DETAIL. NC1224.2 +058800 MOVE WRK-OK-21-40 TO CORRECT-X. NC1224.2 +058900 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1224.2 +059000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +059100 MOVE WRK-OK-41-60 TO CORRECT-X. NC1224.2 +059200 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1224.2 +059300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +059400 MOVE WRK-OK-61-80 TO CORRECT-X. NC1224.2 +059500 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1224.2 +059600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +059700 MOVE WRK-OK-81-83 TO CORRECT-X. NC1224.2 +059800 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1224.2 +059900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +060000 IND-WRITE-GF-9. NC1224.2 +060100 MOVE "IND-TEST-GF-9" TO PAR-NAME. NC1224.2 +060200 MOVE "CHARS BEFORE INITIAL" TO FEATURE. NC1224.2 +060300 PERFORM PRINT-DETAIL. NC1224.2 +060400 IND-INIT-GF-10. NC1224.2 +060500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +060600 PERFORM BUILD-TABLE1. NC1224.2 +060700 SET INDEX1 TO 3. NC1224.2 +060800 SET INDEX3 TO 1. NC1224.2 +060900 SET INDEX4 TO 8. NC1224.2 +061000 IND-TEST-GF-10-0. NC1224.2 +061100 INSPECT TABLE1-REC (INDEX1) REPLACING LEADING NC1224.2 +061200 TABLE3-SYMBOL (INDEX3) BY TABLE3-SYMBOL (INDEX3 + 1) NC1224.2 +061300 AFTER INITIAL TABLE4-LETTER (INDEX4). NC1224.2 +061400 IND-TEST-GF-10-1. NC1224.2 +061500 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-2 NC1224.2 +061600 PERFORM PASS NC1224.2 +061700 GO TO IND-WRITE-GF-10. NC1224.2 +061800 GO TO IND-FAIL-GF-10. NC1224.2 +061900 IND-DELETE-GF-10. NC1224.2 +062000 PERFORM DE-LETE. NC1224.2 +062100 GO TO IND-WRITE-GF-10. NC1224.2 +062200 IND-FAIL-GF-10. NC1224.2 +062300 PERFORM FAIL. NC1224.2 +062400 MOVE TABLE1-REC (INDEX1) TO WRK-ER. NC1224.2 +062500 MOVE ANS-XN-83-2 TO WRK-OK. NC1224.2 +062600 MOVE WRK-OK-1-20 TO CORRECT-X. NC1224.2 +062700 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1224.2 +062800 PERFORM PRINT-DETAIL. NC1224.2 +062900 MOVE WRK-OK-21-40 TO CORRECT-X. NC1224.2 +063000 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1224.2 +063100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +063200 MOVE WRK-OK-41-60 TO CORRECT-X. NC1224.2 +063300 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1224.2 +063400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +063500 MOVE WRK-OK-61-80 TO CORRECT-X. NC1224.2 +063600 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1224.2 +063700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +063800 MOVE WRK-OK-81-83 TO CORRECT-X. NC1224.2 +063900 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1224.2 +064000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +064100 IND-WRITE-GF-10. NC1224.2 +064200 MOVE "IND-TEST-GF-10" TO PAR-NAME. NC1224.2 +064300 MOVE "LEAD. AFTER INIT. ID" TO FEATURE. NC1224.2 +064400 PERFORM PRINT-DETAIL. NC1224.2 +064500 IND-INIT-GF-11. NC1224.2 +064600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +064700 PERFORM BUILD-TABLE1. NC1224.2 +064800 SET INDEX1 TO 4. NC1224.2 +064900 SET INDEX4 TO 6. NC1224.2 +065000 IND-TEST-GF-11-0. NC1224.2 +065100 INSPECT TABLE1-REC (INDEX1) REPLACING FIRST "A" NC1224.2 +065200 BY TABLE4-LETTER (INDEX4) BEFORE INITIAL "H". NC1224.2 +065300 IND-TEST-GF-11-1. NC1224.2 +065400 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC1224.2 +065500 PERFORM PASS NC1224.2 +065600 GO TO IND-WRITE-GF-11. NC1224.2 +065700 GO TO IND-FAIL-GF-11. NC1224.2 +065800 IND-DELETE-GF-11. NC1224.2 +065900 PERFORM DE-LETE. NC1224.2 +066000 GO TO IND-WRITE-GF-11. NC1224.2 +066100 IND-FAIL-GF-11. NC1224.2 +066200 PERFORM FAIL. NC1224.2 +066300 MOVE TABLE1-REC (INDEX1) TO WRK-ER. NC1224.2 +066400 MOVE ANS-XN-83-1 TO WRK-OK. NC1224.2 +066500 MOVE WRK-OK-1-20 TO CORRECT-X. NC1224.2 +066600 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1224.2 +066700 PERFORM PRINT-DETAIL. NC1224.2 +066800 MOVE WRK-OK-21-40 TO CORRECT-X. NC1224.2 +066900 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1224.2 +067000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +067100 MOVE WRK-OK-41-60 TO CORRECT-X. NC1224.2 +067200 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1224.2 +067300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +067400 MOVE WRK-OK-61-80 TO CORRECT-X. NC1224.2 +067500 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1224.2 +067600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +067700 MOVE WRK-OK-81-83 TO CORRECT-X. NC1224.2 +067800 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1224.2 +067900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +068000 IND-WRITE-GF-11. NC1224.2 +068100 MOVE "IND-TEST-GF-11" TO PAR-NAME. NC1224.2 +068200 MOVE "FIRST BY ID BEFORE" TO FEATURE. NC1224.2 +068300 PERFORM PRINT-DETAIL. NC1224.2 +068400 IND-INIT-GF-12. NC1224.2 +068500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +068600 PERFORM BUILD-TABLE1. NC1224.2 +068700 SET INDEX1 TO 1. NC1224.2 +068800 SET INDEX3 TO 1. NC1224.2 +068900 SET INDEX4 TO 5. NC1224.2 +069000 IND-TEST-GF-12-0. NC1224.2 +069100 INSPECT TABLE1-REC (INDEX1 + 1) REPLACING ALL NC1224.2 +069200 TABLE3-SYMBOL (INDEX3) BY "-" AFTER TABLE4-LETTER (INDEX4). NC1224.2 +069300 IND-TEST-GF-12-1. NC1224.2 +069400 IF TABLE1-REC (INDEX1 + 1) EQUAL TO ANS-XN-83-3 NC1224.2 +069500 PERFORM PASS NC1224.2 +069600 GO TO IND-WRITE-GF-12. NC1224.2 +069700 GO TO IND-FAIL-GF-12. NC1224.2 +069800 IND-DELETE-GF-12. NC1224.2 +069900 PERFORM DE-LETE. NC1224.2 +070000 GO TO IND-WRITE-GF-12. NC1224.2 +070100 IND-FAIL-GF-12. NC1224.2 +070200 PERFORM FAIL. NC1224.2 +070300 MOVE TABLE1-REC (INDEX1 + 1) TO WRK-ER. NC1224.2 +070400 MOVE ANS-XN-83-3 TO WRK-OK. NC1224.2 +070500 MOVE WRK-OK-1-20 TO CORRECT-X. NC1224.2 +070600 MOVE WRK-ER-1-20 TO COMPUTED-X. NC1224.2 +070700 PERFORM PRINT-DETAIL. NC1224.2 +070800 MOVE WRK-OK-21-40 TO CORRECT-X. NC1224.2 +070900 MOVE WRK-ER-21-40 TO COMPUTED-X. NC1224.2 +071000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +071100 MOVE WRK-OK-41-60 TO CORRECT-X. NC1224.2 +071200 MOVE WRK-ER-41-60 TO COMPUTED-X. NC1224.2 +071300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +071400 MOVE WRK-OK-61-80 TO CORRECT-X. NC1224.2 +071500 MOVE WRK-ER-61-80 TO COMPUTED-X. NC1224.2 +071600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +071700 MOVE WRK-OK-81-83 TO CORRECT-X. NC1224.2 +071800 MOVE WRK-ER-81-83 TO COMPUTED-X. NC1224.2 +071900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +072000 IND-WRITE-GF-12. NC1224.2 +072100 MOVE "IND-TEST-GF-12" TO PAR-NAME. NC1224.2 +072200 MOVE "ALL ID BY LIT. AFTER" TO FEATURE. NC1224.2 +072300 PERFORM PRINT-DETAIL. NC1224.2 +072400 IND-INIT-GF-13. NC1224.2 +072500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +072600 MOVE "IND-TEST-GF-13" TO PAR-NAME. NC1224.2 +072700 MOVE "TALLY REPLACE CHARS" TO FEATURE. NC1224.2 +072800 MOVE 1 TO REC-CT. NC1224.2 +072900 PERFORM BUILD-TABLE1. NC1224.2 +073000 MOVE ZERO TO TABLE2. NC1224.2 +073100 SET INDEX1 TO 1. NC1224.2 +073200 SET INDEX2 TO 1. NC1224.2 +073300 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +073400 IND-TEST-GF-13-0. NC1224.2 +073500 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +073600 FOR CHARACTERS REPLACING CHARACTERS BY " ". NC1224.2 +073700 GO TO IND-TEST-GF-13-1. NC1224.2 +073800 IND-DELETE-GF-13. NC1224.2 +073900 PERFORM DE-LETE. NC1224.2 +074000 PERFORM PRINT-DETAIL. NC1224.2 +074100 GO TO IND-INIT-GF-14. NC1224.2 +074200 IND-TEST-GF-13-1. NC1224.2 +074300 IF WRK-DU-999 (INDEX2) EQUAL TO 83 NC1224.2 +074400 PERFORM PASS NC1224.2 +074500 PERFORM PRINT-DETAIL NC1224.2 +074600 ELSE PERFORM FAIL NC1224.2 +074700 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +074800 MOVE 83 TO CORRECT-N NC1224.2 +074900 PERFORM PRINT-DETAIL. NC1224.2 +075000 ADD 1 TO REC-CT. NC1224.2 +075100 IND-TEST-GF-13-2. NC1224.2 +075200 IF TABLE1-REC (INDEX1) EQUAL TO SPACE NC1224.2 +075300 PERFORM PASS NC1224.2 +075400 PERFORM PRINT-DETAIL NC1224.2 +075500 ELSE NC1224.2 +075600 PERFORM FAIL NC1224.2 +075700 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +075800 MOVE SPACES TO WRK-OK NC1224.2 +075900 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +076000 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +076100 PERFORM PRINT-DETAIL NC1224.2 +076200 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +076300 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +076400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +076500 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +076600 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +076700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +076800 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +076900 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +077000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +077100 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +077200 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +077300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +077400 IND-INIT-GF-14. NC1224.2 +077500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +077600 MOVE "IND-TEST-GF-14" TO PAR-NAME. NC1224.2 +077700 MOVE "LIT. BY BEFORE INIT." TO FEATURE. NC1224.2 +077800 MOVE 1 TO REC-CT. NC1224.2 +077900 PERFORM BUILD-TABLE1. NC1224.2 +078000 MOVE ZERO TO TABLE2. NC1224.2 +078100 SET INDEX1 TO 4. NC1224.2 +078200 SET INDEX2 TO 2. NC1224.2 +078300 SET INDEX4 TO 5. NC1224.2 +078400 IND-TEST-GF-14-0. NC1224.2 +078500 INSPECT TABLE1-REC (INDEX1 - 2) TALLYING NC1224.2 +078600 WRK-DU-999 (INDEX2 + 2) FOR CHARACTERS NC1224.2 +078700 AFTER TABLE4-LETTER (INDEX4 - 1) REPLACING ALL NC1224.2 +078800 "A" BY "E" BEFORE INITIAL TABLE4-LETTER (INDEX4). NC1224.2 +078900 GO TO IND-TEST-GF-14-1. NC1224.2 +079000 IND-DELETE-GF-14. NC1224.2 +079100 PERFORM DE-LETE. NC1224.2 +079200 PERFORM PRINT-DETAIL. NC1224.2 +079300 GO TO IND-INIT-GF-15. NC1224.2 +079400 IND-TEST-GF-14-1. NC1224.2 +079500 IF WRK-DU-999 (INDEX2 + 2) EQUAL TO 81 NC1224.2 +079600 PERFORM PASS NC1224.2 +079700 PERFORM PRINT-DETAIL NC1224.2 +079800 ELSE PERFORM FAIL NC1224.2 +079900 MOVE WRK-DU-999 (INDEX2 + 2) TO COMPUTED-N NC1224.2 +080000 MOVE 6 TO CORRECT-N NC1224.2 +080100 PERFORM PRINT-DETAIL. NC1224.2 +080200 ADD 1 TO REC-CT. NC1224.2 +080300 IND-TEST-GF-14-2. NC1224.2 +080400 IF TABLE1-REC (INDEX1 - 2) EQUAL TO ANS-XN-83-4 NC1224.2 +080500 PERFORM PASS NC1224.2 +080600 PERFORM PRINT-DETAIL NC1224.2 +080700 ELSE NC1224.2 +080800 PERFORM FAIL NC1224.2 +080900 MOVE TABLE1-REC (INDEX1 - 2) TO WRK-ER NC1224.2 +081000 MOVE ANS-XN-83-4 TO WRK-OK NC1224.2 +081100 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +081200 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +081300 PERFORM PRINT-DETAIL NC1224.2 +081400 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +081500 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +081600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +081700 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +081800 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +081900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +082000 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +082100 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +082200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +082300 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +082400 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +082500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +082600 IND-INIT-GF-15. NC1224.2 +082700 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +082800 MOVE "IND-TEST-GF-15" TO PAR-NAME. NC1224.2 +082900 MOVE "REPL. FIRST AFTER" TO FEATURE. NC1224.2 +083000 MOVE 1 TO REC-CT. NC1224.2 +083100 PERFORM BUILD-TABLE1. NC1224.2 +083200 MOVE ZERO TO TABLE2. NC1224.2 +083300 SET INDEX1 TO 1. NC1224.2 +083400 SET INDEX2 TO 1. NC1224.2 +083500 SET INDEX4 TO 4. NC1224.2 +083600 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +083700 IND-TEST-GF-15-0. NC1224.2 +083800 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +083900 FOR ALL "A" BEFORE TABLE4-LETTER (INDEX4 + 1) NC1224.2 +084000 REPLACING FIRST TABLE4-LETTER (INDEX4 - 3) NC1224.2 +084100 BY "O" AFTER INITIAL TABLE4-LETTER (INDEX4). NC1224.2 +084200 GO TO IND-TEST-GF-15-1. NC1224.2 +084300 IND-DELETE-GF-15. NC1224.2 +084400 PERFORM DE-LETE. NC1224.2 +084500 PERFORM PRINT-DETAIL. NC1224.2 +084600 GO TO IND-INIT-GF-16. NC1224.2 +084700 IND-TEST-GF-15-1. NC1224.2 +084800 IF WRK-DU-999 (INDEX2) EQUAL TO 7 NC1224.2 +084900 PERFORM PASS NC1224.2 +085000 PERFORM PRINT-DETAIL NC1224.2 +085100 ELSE PERFORM FAIL NC1224.2 +085200 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +085300 MOVE 7 TO CORRECT-N NC1224.2 +085400 PERFORM PRINT-DETAIL. NC1224.2 +085500 ADD 1 TO REC-CT. NC1224.2 +085600 IND-TEST-GF-15-2. NC1224.2 +085700 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-5 NC1224.2 +085800 PERFORM PASS NC1224.2 +085900 PERFORM PRINT-DETAIL NC1224.2 +086000 ELSE NC1224.2 +086100 PERFORM FAIL NC1224.2 +086200 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +086300 MOVE ANS-XN-83-5 TO WRK-OK NC1224.2 +086400 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +086500 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +086600 PERFORM PRINT-DETAIL NC1224.2 +086700 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +086800 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +086900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +087000 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +087100 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +087200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +087300 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +087400 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +087500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +087600 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +087700 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +087800 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +087900 IND-INIT-GF-16. NC1224.2 +088000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +088100 MOVE "IND-TEST-GF-16" TO PAR-NAME. NC1224.2 +088200 MOVE "FOR LEADING" TO FEATURE. NC1224.2 +088300 MOVE 1 TO REC-CT. NC1224.2 +088400 PERFORM BUILD-TABLE1. NC1224.2 +088500 MOVE ZERO TO TABLE2. NC1224.2 +088600 SET INDEX1 TO 2. NC1224.2 +088700 SET INDEX2 TO 2. NC1224.2 +088800 SET INDEX4 TO 1. NC1224.2 +088900 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +089000 IND-TEST-GF-16-0. NC1224.2 +089100 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +089200 FOR LEADING TABLE4-LETTER (INDEX4) REPLACING NC1224.2 +089300 LEADING TABLE4-LETTER (INDEX4) BY "O". NC1224.2 +089400 GO TO IND-TEST-GF-16-1. NC1224.2 +089500 IND-DELETE-GF-16. NC1224.2 +089600 PERFORM DE-LETE. NC1224.2 +089700 PERFORM PRINT-DETAIL. NC1224.2 +089800 GO TO IND-INIT-GF-17. NC1224.2 +089900 IND-TEST-GF-16-1. NC1224.2 +090000 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC1224.2 +090100 PERFORM PASS NC1224.2 +090200 PERFORM PRINT-DETAIL NC1224.2 +090300 ELSE PERFORM FAIL NC1224.2 +090400 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +090500 MOVE 1 TO CORRECT-N NC1224.2 +090600 PERFORM PRINT-DETAIL. NC1224.2 +090700 ADD 1 TO REC-CT. NC1224.2 +090800 IND-TEST-GF-16-2. NC1224.2 +090900 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC1224.2 +091000 PERFORM PASS NC1224.2 +091100 PERFORM PRINT-DETAIL NC1224.2 +091200 ELSE NC1224.2 +091300 PERFORM FAIL NC1224.2 +091400 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +091500 MOVE ANS-XN-83-1 TO WRK-OK NC1224.2 +091600 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +091700 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +091800 PERFORM PRINT-DETAIL NC1224.2 +091900 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +092000 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +092100 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +092200 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +092300 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +092400 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +092500 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +092600 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +092700 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +092800 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +092900 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +093000 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +093100 IND-INIT-GF-17. NC1224.2 +093200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +093300 MOVE "IND-TEST-GF-17" TO PAR-NAME. NC1224.2 +093400 MOVE "LIT. BY AFTER INIT." TO FEATURE. NC1224.2 +093500 MOVE 1 TO REC-CT. NC1224.2 +093600 PERFORM BUILD-TABLE1. NC1224.2 +093700 MOVE ZERO TO TABLE2. NC1224.2 +093800 SET INDEX1 TO 3. NC1224.2 +093900 SET INDEX2 TO 3. NC1224.2 +094000 SET INDEX4 TO 7. NC1224.2 +094100 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +094200 IND-TEST-GF-17-0. NC1224.2 +094300 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +094400 FOR ALL "A" REPLACING FIRST "A" BY "O" NC1224.2 +094500 AFTER INITIAL TABLE4-LETTER (INDEX4). NC1224.2 +094600 GO TO IND-TEST-GF-17-1. NC1224.2 +094700 IND-DELETE-GF-17. NC1224.2 +094800 PERFORM DE-LETE. NC1224.2 +094900 PERFORM PRINT-DETAIL. NC1224.2 +095000 GO TO IND-INIT-GF-18. NC1224.2 +095100 IND-TEST-GF-17-1. NC1224.2 +095200 IF WRK-DU-999 (INDEX2) EQUAL TO 8 NC1224.2 +095300 PERFORM PASS NC1224.2 +095400 PERFORM PRINT-DETAIL NC1224.2 +095500 ELSE PERFORM FAIL NC1224.2 +095600 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +095700 MOVE 8 TO CORRECT-N NC1224.2 +095800 PERFORM PRINT-DETAIL. NC1224.2 +095900 ADD 1 TO REC-CT. NC1224.2 +096000 IND-TEST-GF-17-2. NC1224.2 +096100 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-5 NC1224.2 +096200 PERFORM PASS NC1224.2 +096300 PERFORM PRINT-DETAIL NC1224.2 +096400 ELSE NC1224.2 +096500 PERFORM FAIL NC1224.2 +096600 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +096700 MOVE ANS-XN-83-1 TO WRK-OK NC1224.2 +096800 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +096900 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +097000 PERFORM PRINT-DETAIL NC1224.2 +097100 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +097200 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +097300 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +097400 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +097500 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +097600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +097700 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +097800 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +097900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +098000 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +098100 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +098200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +098300 IND-INIT-GF-18. NC1224.2 +098400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1224.2 +098500 MOVE "IND-TEST-GF-18" TO PAR-NAME. NC1224.2 +098600 MOVE "CHARS AFTER ALL BEF." TO FEATURE. NC1224.2 +098700 MOVE 1 TO REC-CT. NC1224.2 +098800 PERFORM BUILD-TABLE1. NC1224.2 +098900 MOVE ZERO TO TABLE2. NC1224.2 +099000 SET INDEX1 TO 4. NC1224.2 +099100 SET INDEX2 TO 4. NC1224.2 +099200 SET INDEX4 TO 1. NC1224.2 +099300 MOVE 0 TO WRK-DU-999 (INDEX2). NC1224.2 +099400 IND-TEST-GF-18-0. NC1224.2 +099500 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC1224.2 +099600 FOR CHARACTERS AFTER TABLE4-LETTER (INDEX4) NC1224.2 +099700 REPLACING ALL "A" BY "O" NC1224.2 +099800 BEFORE TABLE4-LETTER (INDEX4 + 3). NC1224.2 +099900 GO TO IND-TEST-GF-18-1. NC1224.2 +100000 IND-DELETE-GF-18. NC1224.2 +100100 PERFORM DE-LETE. NC1224.2 +100200 PERFORM PRINT-DETAIL. NC1224.2 +100300 GO TO CCVS-999999. NC1224.2 +100400 IND-TEST-GF-18-1. NC1224.2 +100500 IF WRK-DU-999 (INDEX2) EQUAL TO 82 NC1224.2 +100600 PERFORM PASS NC1224.2 +100700 PERFORM PRINT-DETAIL NC1224.2 +100800 ELSE PERFORM FAIL NC1224.2 +100900 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC1224.2 +101000 MOVE 82 TO CORRECT-N NC1224.2 +101100 PERFORM PRINT-DETAIL. NC1224.2 +101200 ADD 1 TO REC-CT. NC1224.2 +101300 IND-TEST-GF-18-2. NC1224.2 +101400 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC1224.2 +101500 PERFORM PASS NC1224.2 +101600 PERFORM PRINT-DETAIL NC1224.2 +101700 ELSE NC1224.2 +101800 PERFORM FAIL NC1224.2 +101900 MOVE TABLE1-REC (INDEX1) TO WRK-ER NC1224.2 +102000 MOVE ANS-XN-83-1 TO WRK-OK NC1224.2 +102100 MOVE WRK-OK-1-20 TO CORRECT-X NC1224.2 +102200 MOVE WRK-ER-1-20 TO COMPUTED-X NC1224.2 +102300 PERFORM PRINT-DETAIL NC1224.2 +102400 MOVE WRK-OK-21-40 TO CORRECT-X NC1224.2 +102500 MOVE WRK-ER-21-40 TO COMPUTED-X NC1224.2 +102600 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +102700 MOVE WRK-OK-41-60 TO CORRECT-X NC1224.2 +102800 MOVE WRK-ER-41-60 TO COMPUTED-X NC1224.2 +102900 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +103000 MOVE WRK-OK-61-80 TO CORRECT-X NC1224.2 +103100 MOVE WRK-ER-61-80 TO COMPUTED-X NC1224.2 +103200 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX NC1224.2 +103300 MOVE WRK-OK-81-83 TO CORRECT-X NC1224.2 +103400 MOVE WRK-ER-81-83 TO COMPUTED-X NC1224.2 +103500 PERFORM FAIL-ROUTINE-WRITE THRU FAIL-ROUTINE-EX. NC1224.2 +103600 CCVS-EXIT SECTION. NC1224.2 +103700 CCVS-999999. NC1224.2 +103800 GO TO CLOSE-FILES. NC1224.2 diff --git a/tests/cobol85/NC/NC123A.CBL b/tests/cobol85/NC/NC123A.CBL new file mode 100755 index 00000000..a1fd7b3f --- /dev/null +++ b/tests/cobol85/NC/NC123A.CBL @@ -0,0 +1,1129 @@ +000100 IDENTIFICATION DIVISION. NC1234.2 +000200 PROGRAM-ID. NC1234.2 +000300 NC123A. NC1234.2 +000400**************************************************************** NC1234.2 +000500* * NC1234.2 +000600* VALIDATION FOR:- * NC1234.2 +000700* * NC1234.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1234.2 +000900* * NC1234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1234.2 +001100* * NC1234.2 +001200**************************************************************** NC1234.2 +001300* * NC1234.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1234.2 +001500* * NC1234.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1234.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1234.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1234.2 +001900* * NC1234.2 +002000**************************************************************** NC1234.2 +002100* NC1234.2 +002200* PROGRAM NC123A TESTS THE USE OF INDEXED IDENTIFIERS WITH NC1234.2 +002300* FORMATS 1 AND 2 OF THE "ADD" AND "SUBTRACT" STATEMENTS AND NC1234.2 +002400* FORMAT 2 OF THE "GO" STATEMENT. NC1234.2 +002500* ONE AND TWO LEVELS OF INDEXING ARE USED AS WELL AS NC1234.2 +002600* RELATIVE INDEXING. NC1234.2 +002700* NC1234.2 +002800 ENVIRONMENT DIVISION. NC1234.2 +002900 CONFIGURATION SECTION. NC1234.2 +003000 SOURCE-COMPUTER. NC1234.2 +003100 Linux. NC1234.2 +003200 OBJECT-COMPUTER. NC1234.2 +003300 Linux. NC1234.2 +003400 INPUT-OUTPUT SECTION. NC1234.2 +003500 FILE-CONTROL. NC1234.2 +003600 SELECT PRINT-FILE ASSIGN TO NC1234.2 +003700 "report.log". NC1234.2 +003800 DATA DIVISION. NC1234.2 +003900 FILE SECTION. NC1234.2 +004000 FD PRINT-FILE. NC1234.2 +004100 01 PRINT-REC PICTURE X(120). NC1234.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC1234.2 +004300 WORKING-STORAGE SECTION. NC1234.2 +004400 01 TABLE1. NC1234.2 +004500 02 TABLE1-NUM PICTURE S9V99 NC1234.2 +004600 OCCURS 10 TIMES NC1234.2 +004700 INDEXED BY INDEX1. NC1234.2 +004800 01 TABLE2. NC1234.2 +004900 02 TABLE2-NUM PICTURE 9V9 NC1234.2 +005000 OCCURS 6 TIMES NC1234.2 +005100 INDEXED BY INDEX2. NC1234.2 +005200 01 TABLE3. NC1234.2 +005300 02 TABLE3-NUM PICTURE 99V9 NC1234.2 +005400 OCCURS 6 TIMES NC1234.2 +005500 INDEXED BY INDEX3. NC1234.2 +005600 01 TABLE4. NC1234.2 +005700 02 TABLE4-NUM1 OCCURS 3 TIMES NC1234.2 +005800 INDEXED BY INDEX4-1. NC1234.2 +005900 03 TABLE4-NUM2 PICTURE 99 NC1234.2 +006000 OCCURS 3 TIMES NC1234.2 +006100 INDEXED BY INDEX4-2. NC1234.2 +006200 01 TABLE5. NC1234.2 +006300 02 TABLE5-NUM PIC 999 NC1234.2 +006400 OCCURS 2 TIMES NC1234.2 +006500 INDEXED BY INDEX5. NC1234.2 +006600 01 NUM-9V9 PICTURE 9V9. NC1234.2 +006700 01 TEST-RESULTS. NC1234.2 +006800 02 FILLER PIC X VALUE SPACE. NC1234.2 +006900 02 FEATURE PIC X(20) VALUE SPACE. NC1234.2 +007000 02 FILLER PIC X VALUE SPACE. NC1234.2 +007100 02 P-OR-F PIC X(5) VALUE SPACE. NC1234.2 +007200 02 FILLER PIC X VALUE SPACE. NC1234.2 +007300 02 PAR-NAME. NC1234.2 +007400 03 FILLER PIC X(19) VALUE SPACE. NC1234.2 +007500 03 PARDOT-X PIC X VALUE SPACE. NC1234.2 +007600 03 DOTVALUE PIC 99 VALUE ZERO. NC1234.2 +007700 02 FILLER PIC X(8) VALUE SPACE. NC1234.2 +007800 02 RE-MARK PIC X(61). NC1234.2 +007900 01 TEST-COMPUTED. NC1234.2 +008000 02 FILLER PIC X(30) VALUE SPACE. NC1234.2 +008100 02 FILLER PIC X(17) VALUE NC1234.2 +008200 " COMPUTED=". NC1234.2 +008300 02 COMPUTED-X. NC1234.2 +008400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1234.2 +008500 03 COMPUTED-N REDEFINES COMPUTED-A NC1234.2 +008600 PIC -9(9).9(9). NC1234.2 +008700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1234.2 +008800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1234.2 +008900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1234.2 +009000 03 CM-18V0 REDEFINES COMPUTED-A. NC1234.2 +009100 04 COMPUTED-18V0 PIC -9(18). NC1234.2 +009200 04 FILLER PIC X. NC1234.2 +009300 03 FILLER PIC X(50) VALUE SPACE. NC1234.2 +009400 01 TEST-CORRECT. NC1234.2 +009500 02 FILLER PIC X(30) VALUE SPACE. NC1234.2 +009600 02 FILLER PIC X(17) VALUE " CORRECT =". NC1234.2 +009700 02 CORRECT-X. NC1234.2 +009800 03 CORRECT-A PIC X(20) VALUE SPACE. NC1234.2 +009900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1234.2 +010000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1234.2 +010100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1234.2 +010200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1234.2 +010300 03 CR-18V0 REDEFINES CORRECT-A. NC1234.2 +010400 04 CORRECT-18V0 PIC -9(18). NC1234.2 +010500 04 FILLER PIC X. NC1234.2 +010600 03 FILLER PIC X(2) VALUE SPACE. NC1234.2 +010700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1234.2 +010800 01 CCVS-C-1. NC1234.2 +010900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1234.2 +011000- "SS PARAGRAPH-NAME NC1234.2 +011100- " REMARKS". NC1234.2 +011200 02 FILLER PIC X(20) VALUE SPACE. NC1234.2 +011300 01 CCVS-C-2. NC1234.2 +011400 02 FILLER PIC X VALUE SPACE. NC1234.2 +011500 02 FILLER PIC X(6) VALUE "TESTED". NC1234.2 +011600 02 FILLER PIC X(15) VALUE SPACE. NC1234.2 +011700 02 FILLER PIC X(4) VALUE "FAIL". NC1234.2 +011800 02 FILLER PIC X(94) VALUE SPACE. NC1234.2 +011900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1234.2 +012000 01 REC-CT PIC 99 VALUE ZERO. NC1234.2 +012100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1234.2 +012200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1234.2 +012300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1234.2 +012400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1234.2 +012500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1234.2 +012600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1234.2 +012700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1234.2 +012800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1234.2 +012900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1234.2 +013000 01 CCVS-H-1. NC1234.2 +013100 02 FILLER PIC X(39) VALUE SPACES. NC1234.2 +013200 02 FILLER PIC X(42) VALUE NC1234.2 +013300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1234.2 +013400 02 FILLER PIC X(39) VALUE SPACES. NC1234.2 +013500 01 CCVS-H-2A. NC1234.2 +013600 02 FILLER PIC X(40) VALUE SPACE. NC1234.2 +013700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1234.2 +013800 02 FILLER PIC XXXX VALUE NC1234.2 +013900 "4.2 ". NC1234.2 +014000 02 FILLER PIC X(28) VALUE NC1234.2 +014100 " COPY - NOT FOR DISTRIBUTION". NC1234.2 +014200 02 FILLER PIC X(41) VALUE SPACE. NC1234.2 +014300 NC1234.2 +014400 01 CCVS-H-2B. NC1234.2 +014500 02 FILLER PIC X(15) VALUE NC1234.2 +014600 "TEST RESULT OF ". NC1234.2 +014700 02 TEST-ID PIC X(9). NC1234.2 +014800 02 FILLER PIC X(4) VALUE NC1234.2 +014900 " IN ". NC1234.2 +015000 02 FILLER PIC X(12) VALUE NC1234.2 +015100 " HIGH ". NC1234.2 +015200 02 FILLER PIC X(22) VALUE NC1234.2 +015300 " LEVEL VALIDATION FOR ". NC1234.2 +015400 02 FILLER PIC X(58) VALUE NC1234.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1234.2 +015600 01 CCVS-H-3. NC1234.2 +015700 02 FILLER PIC X(34) VALUE NC1234.2 +015800 " FOR OFFICIAL USE ONLY ". NC1234.2 +015900 02 FILLER PIC X(58) VALUE NC1234.2 +016000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1234.2 +016100 02 FILLER PIC X(28) VALUE NC1234.2 +016200 " COPYRIGHT 1985 ". NC1234.2 +016300 01 CCVS-E-1. NC1234.2 +016400 02 FILLER PIC X(52) VALUE SPACE. NC1234.2 +016500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1234.2 +016600 02 ID-AGAIN PIC X(9). NC1234.2 +016700 02 FILLER PIC X(45) VALUE SPACES. NC1234.2 +016800 01 CCVS-E-2. NC1234.2 +016900 02 FILLER PIC X(31) VALUE SPACE. NC1234.2 +017000 02 FILLER PIC X(21) VALUE SPACE. NC1234.2 +017100 02 CCVS-E-2-2. NC1234.2 +017200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1234.2 +017300 03 FILLER PIC X VALUE SPACE. NC1234.2 +017400 03 ENDER-DESC PIC X(44) VALUE NC1234.2 +017500 "ERRORS ENCOUNTERED". NC1234.2 +017600 01 CCVS-E-3. NC1234.2 +017700 02 FILLER PIC X(22) VALUE NC1234.2 +017800 " FOR OFFICIAL USE ONLY". NC1234.2 +017900 02 FILLER PIC X(12) VALUE SPACE. NC1234.2 +018000 02 FILLER PIC X(58) VALUE NC1234.2 +018100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1234.2 +018200 02 FILLER PIC X(13) VALUE SPACE. NC1234.2 +018300 02 FILLER PIC X(15) VALUE NC1234.2 +018400 " COPYRIGHT 1985". NC1234.2 +018500 01 CCVS-E-4. NC1234.2 +018600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1234.2 +018700 02 FILLER PIC X(4) VALUE " OF ". NC1234.2 +018800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1234.2 +018900 02 FILLER PIC X(40) VALUE NC1234.2 +019000 " TESTS WERE EXECUTED SUCCESSFULLY". NC1234.2 +019100 01 XXINFO. NC1234.2 +019200 02 FILLER PIC X(19) VALUE NC1234.2 +019300 "*** INFORMATION ***". NC1234.2 +019400 02 INFO-TEXT. NC1234.2 +019500 04 FILLER PIC X(8) VALUE SPACE. NC1234.2 +019600 04 XXCOMPUTED PIC X(20). NC1234.2 +019700 04 FILLER PIC X(5) VALUE SPACE. NC1234.2 +019800 04 XXCORRECT PIC X(20). NC1234.2 +019900 02 INF-ANSI-REFERENCE PIC X(48). NC1234.2 +020000 01 HYPHEN-LINE. NC1234.2 +020100 02 FILLER PIC IS X VALUE IS SPACE. NC1234.2 +020200 02 FILLER PIC IS X(65) VALUE IS "************************NC1234.2 +020300- "*****************************************". NC1234.2 +020400 02 FILLER PIC IS X(54) VALUE IS "************************NC1234.2 +020500- "******************************". NC1234.2 +020600 01 CCVS-PGM-ID PIC X(9) VALUE NC1234.2 +020700 "NC123A". NC1234.2 +020800 PROCEDURE DIVISION. NC1234.2 +020900 CCVS1 SECTION. NC1234.2 +021000 OPEN-FILES. NC1234.2 +021100 OPEN OUTPUT PRINT-FILE. NC1234.2 +021200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1234.2 +021300 MOVE SPACE TO TEST-RESULTS. NC1234.2 +021400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1234.2 +021500 GO TO CCVS1-EXIT. NC1234.2 +021600 CLOSE-FILES. NC1234.2 +021700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1234.2 +021800 TERMINATE-CCVS. NC1234.2 +021900*S EXIT PROGRAM. NC1234.2 +022000*SERMINATE-CALL. NC1234.2 +022100 STOP RUN. NC1234.2 +022200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1234.2 +022300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1234.2 +022400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1234.2 +022500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1234.2 +022600 MOVE "****TEST DELETED****" TO RE-MARK. NC1234.2 +022700 PRINT-DETAIL. NC1234.2 +022800 IF REC-CT NOT EQUAL TO ZERO NC1234.2 +022900 MOVE "." TO PARDOT-X NC1234.2 +023000 MOVE REC-CT TO DOTVALUE. NC1234.2 +023100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1234.2 +023200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1234.2 +023300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1234.2 +023400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1234.2 +023500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1234.2 +023600 MOVE SPACE TO CORRECT-X. NC1234.2 +023700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1234.2 +023800 MOVE SPACE TO RE-MARK. NC1234.2 +023900 HEAD-ROUTINE. NC1234.2 +024000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +024100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +024200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1234.2 +024300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1234.2 +024400 COLUMN-NAMES-ROUTINE. NC1234.2 +024500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +024600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +024700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +024800 END-ROUTINE. NC1234.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1234.2 +025000 END-RTN-EXIT. NC1234.2 +025100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +025200 END-ROUTINE-1. NC1234.2 +025300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1234.2 +025400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1234.2 +025500 ADD PASS-COUNTER TO ERROR-HOLD. NC1234.2 +025600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1234.2 +025700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1234.2 +025800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1234.2 +025900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1234.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1234.2 +026100 END-ROUTINE-12. NC1234.2 +026200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1234.2 +026300 IF ERROR-COUNTER IS EQUAL TO ZERO NC1234.2 +026400 MOVE "NO " TO ERROR-TOTAL NC1234.2 +026500 ELSE NC1234.2 +026600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1234.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1234.2 +026800 PERFORM WRITE-LINE. NC1234.2 +026900 END-ROUTINE-13. NC1234.2 +027000 IF DELETE-COUNTER IS EQUAL TO ZERO NC1234.2 +027100 MOVE "NO " TO ERROR-TOTAL ELSE NC1234.2 +027200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1234.2 +027300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1234.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +027500 IF INSPECT-COUNTER EQUAL TO ZERO NC1234.2 +027600 MOVE "NO " TO ERROR-TOTAL NC1234.2 +027700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1234.2 +027800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1234.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +028000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1234.2 +028100 WRITE-LINE. NC1234.2 +028200 ADD 1 TO RECORD-COUNT. NC1234.2 +028300 IF RECORD-COUNT GREATER 42 NC1234.2 +028400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1234.2 +028500 MOVE SPACE TO DUMMY-RECORD NC1234.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1234.2 +028700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1234.2 +028800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1234.2 +028900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1234.2 +029000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1234.2 +029100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1234.2 +029200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1234.2 +029300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1234.2 +029400 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1234.2 +029500 MOVE ZERO TO RECORD-COUNT. NC1234.2 +029600 PERFORM WRT-LN. NC1234.2 +029700 WRT-LN. NC1234.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1234.2 +029900 MOVE SPACE TO DUMMY-RECORD. NC1234.2 +030000 BLANK-LINE-PRINT. NC1234.2 +030100 PERFORM WRT-LN. NC1234.2 +030200 FAIL-ROUTINE. NC1234.2 +030300 IF COMPUTED-X NOT EQUAL TO SPACE NC1234.2 +030400 GO TO FAIL-ROUTINE-WRITE. NC1234.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1234.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1234.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1234.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1234.2 +031000 GO TO FAIL-ROUTINE-EX. NC1234.2 +031100 FAIL-ROUTINE-WRITE. NC1234.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1234.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1234.2 +031400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1234.2 +031500 MOVE SPACES TO COR-ANSI-REFERENCE. NC1234.2 +031600 FAIL-ROUTINE-EX. EXIT. NC1234.2 +031700 BAIL-OUT. NC1234.2 +031800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1234.2 +031900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1234.2 +032000 BAIL-OUT-WRITE. NC1234.2 +032100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1234.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1234.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1234.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1234.2 +032500 BAIL-OUT-EX. EXIT. NC1234.2 +032600 CCVS1-EXIT. NC1234.2 +032700 EXIT. NC1234.2 +032800 BUILD-TABLE1. NC1234.2 +032900 MOVE 1.00 TO TABLE1-NUM (1). NC1234.2 +033000 MOVE 0.68 TO TABLE1-NUM (2). NC1234.2 +033100 MOVE 9.00 TO TABLE1-NUM (3). NC1234.2 +033200 MOVE 5.00 TO TABLE1-NUM (4). NC1234.2 +033300 MOVE 2.00 TO TABLE1-NUM (5). NC1234.2 +033400 MOVE 1.50 TO TABLE1-NUM (6). NC1234.2 +033500 MOVE 3.50 TO TABLE1-NUM (7). NC1234.2 +033600 MOVE 6.60 TO TABLE1-NUM (8). NC1234.2 +033700 MOVE 2.56 TO TABLE1-NUM (9). NC1234.2 +033800 MOVE -9.00 TO TABLE1-NUM (10). NC1234.2 +033900 BUILD-TABLE2. NC1234.2 +034000 MOVE 5.0 TO TABLE2-NUM (1). NC1234.2 +034100 MOVE 4.0 TO TABLE2-NUM (2). NC1234.2 +034200 MOVE 9.0 TO TABLE2-NUM (3). NC1234.2 +034300 MOVE 4.0 TO TABLE2-NUM (4). NC1234.2 +034400 MOVE 4.6 TO TABLE2-NUM (5). NC1234.2 +034500 MOVE 1.3 TO TABLE2-NUM (6). NC1234.2 +034600 BUILD-TABLE4. NC1234.2 +034700 MOVE 20 TO TABLE4-NUM2 (1 1). NC1234.2 +034800 MOVE 21 TO TABLE4-NUM2 (1 2). NC1234.2 +034900 MOVE 22 TO TABLE4-NUM2 (1 3). NC1234.2 +035000 MOVE 23 TO TABLE4-NUM2 (2 1). NC1234.2 +035100 MOVE 24 TO TABLE4-NUM2 (2 2). NC1234.2 +035200 MOVE 25 TO TABLE4-NUM2 (2 3). NC1234.2 +035300 MOVE 26 TO TABLE4-NUM2 (3 1). NC1234.2 +035400 MOVE 27 TO TABLE4-NUM2 (3 2). NC1234.2 +035500 MOVE 28 TO TABLE4-NUM2 (3 3). NC1234.2 +035600 BUILD-TABLE5. NC1234.2 +035700 MOVE 003 TO TABLE5-NUM (1). NC1234.2 +035800 MOVE 002 TO TABLE5-NUM (2). NC1234.2 +035900 IND-INIT-GF-1. NC1234.2 +036000 MOVE "ADD TO" TO FEATURE. NC1234.2 +036100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +036200 MOVE 1.0 TO NUM-9V9. NC1234.2 +036300 SET INDEX1 TO 1. NC1234.2 +036400 IND-TEST-GF-1-0. NC1234.2 +036500 ADD TABLE1-NUM (INDEX1) TO NUM-9V9. NC1234.2 +036600 IND-TEST-GF-1-1. NC1234.2 +036700 IF NUM-9V9 EQUAL TO 2.0 NC1234.2 +036800 PERFORM PASS NC1234.2 +036900 ELSE GO TO IND-FAIL-GF-1. NC1234.2 +037000 GO TO IND-WRITE-GF-1. NC1234.2 +037100 IND-DELETE-GF-1. NC1234.2 +037200 PERFORM DE-LETE. NC1234.2 +037300 GO TO IND-WRITE-GF-1. NC1234.2 +037400 IND-FAIL-GF-1. NC1234.2 +037500 PERFORM FAIL. NC1234.2 +037600 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +037700 MOVE 2.0 TO CORRECT-14V4. NC1234.2 +037800 IND-WRITE-GF-1. NC1234.2 +037900 MOVE "IND-TEST-GF-1" TO PAR-NAME. NC1234.2 +038000 PERFORM PRINT-DETAIL. NC1234.2 +038100 IND-INIT-GF-2. NC1234.2 +038200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +038300 MOVE "ADD ROUNDED" TO FEATURE. NC1234.2 +038400 MOVE 2.0 TO NUM-9V9. NC1234.2 +038500 SET INDEX1 TO 2. NC1234.2 +038600 IND-TEST-GF-2-0. NC1234.2 +038700 ADD TABLE1-NUM (INDEX1) TO NUM-9V9 ROUNDED. NC1234.2 +038800 IND-TEST-GF-2-1. NC1234.2 +038900 IF NUM-9V9 EQUAL TO 2.7 NC1234.2 +039000 PERFORM PASS NC1234.2 +039100 ELSE GO TO IND-FAIL-GF-2. NC1234.2 +039200 GO TO IND-WRITE-GF-2. NC1234.2 +039300 IND-DELETE-GF-2. NC1234.2 +039400 PERFORM DE-LETE. NC1234.2 +039500 GO TO IND-WRITE-GF-2. NC1234.2 +039600 IND-FAIL-GF-2. NC1234.2 +039700 PERFORM FAIL. NC1234.2 +039800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +039900 MOVE 2.7 TO CORRECT-14V4. NC1234.2 +040000 IND-WRITE-GF-2. NC1234.2 +040100 MOVE "IND-TEST-GF-2" TO PAR-NAME. NC1234.2 +040200 PERFORM PRINT-DETAIL. NC1234.2 +040300 IND-INIT-GF-3. NC1234.2 +040400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +040500 MOVE "ADD ON SIZE ERROR" TO FEATURE. NC1234.2 +040600 MOVE 5.0 TO NUM-9V9. NC1234.2 +040700 SET INDEX1 TO 3. NC1234.2 +040800 IND-TEST-GF-3-1. NC1234.2 +040900 ADD TABLE1-NUM (INDEX1) TO NUM-9V9 ON SIZE ERROR NC1234.2 +041000 PERFORM PASS NC1234.2 +041100 GO TO IND-WRITE-GF-3-1. NC1234.2 +041200 GO TO IND-FAIL-GF-3-1. NC1234.2 +041300 IND-DELETE-GF-3-1. NC1234.2 +041400 PERFORM DE-LETE. NC1234.2 +041500 GO TO IND-WRITE-GF-3-1. NC1234.2 +041600 IND-FAIL-GF-3-1. NC1234.2 +041700 PERFORM FAIL. NC1234.2 +041800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +041900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +042000 IND-WRITE-GF-3-1. NC1234.2 +042100 MOVE "IND-TEST-GF-3-1" TO PAR-NAME. NC1234.2 +042200 PERFORM PRINT-DETAIL. NC1234.2 +042300 IND-TEST-GF-3-2. NC1234.2 +042400 IF NUM-9V9 = 5.0 NC1234.2 +042500 PERFORM PASS NC1234.2 +042600 GO TO IND-WRITE-GF-3-2. NC1234.2 +042700 GO TO IND-FAIL-GF-3-2. NC1234.2 +042800 IND-DELETE-GF-3-2. NC1234.2 +042900 PERFORM DE-LETE. NC1234.2 +043000 GO TO IND-WRITE-GF-3-2. NC1234.2 +043100 IND-FAIL-GF-3-2. NC1234.2 +043200 PERFORM FAIL. NC1234.2 +043300 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +043400 MOVE 5.0 TO CORRECT-14V4. NC1234.2 +043500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1234.2 +043600 IND-WRITE-GF-3-2. NC1234.2 +043700 MOVE "IND-TEST-GF-3-2" TO PAR-NAME. NC1234.2 +043800 PERFORM PRINT-DETAIL. NC1234.2 +043900 IND-INIT-GF-4. NC1234.2 +044000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +044100 MOVE "ADD TO" TO FEATURE. NC1234.2 +044200 SET INDEX1 TO 1. NC1234.2 +044300 SET INDEX2 TO 1. NC1234.2 +044400 IND-TEST-GF-4-0. NC1234.2 +044500 ADD TABLE1-NUM (INDEX1) TO TABLE2-NUM (INDEX2). NC1234.2 +044600 IND-TEST-GF-4-1. NC1234.2 +044700 IF TABLE2-NUM (INDEX2) EQUAL TO 6.0 NC1234.2 +044800 PERFORM PASS NC1234.2 +044900 ELSE GO TO IND-FAIL-GF-4. NC1234.2 +045000 GO TO IND-WRITE-GF-4. NC1234.2 +045100 IND-DELETE-GF-4. NC1234.2 +045200 PERFORM DE-LETE. NC1234.2 +045300 GO TO IND-WRITE-GF-4. NC1234.2 +045400 IND-FAIL-GF-4. NC1234.2 +045500 PERFORM FAIL. NC1234.2 +045600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +045700 MOVE 6.0 TO CORRECT-14V4. NC1234.2 +045800 IND-WRITE-GF-4. NC1234.2 +045900 MOVE "IND-TEST-GF-4" TO PAR-NAME. NC1234.2 +046000 PERFORM PRINT-DETAIL. NC1234.2 +046100 IND-INIT-GF-5. NC1234.2 +046200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +046300 MOVE "ADD ROUNDED" TO FEATURE. NC1234.2 +046400 PERFORM BUILD-TABLE2. NC1234.2 +046500 SET INDEX1 TO 2. NC1234.2 +046600 SET INDEX2 TO 2. NC1234.2 +046700 IND-TEST-GF-5-0. NC1234.2 +046800 ADD TABLE1-NUM (INDEX1) TO TABLE2-NUM (INDEX2) ROUNDED. NC1234.2 +046900 IND-TEST-GF-5-1. NC1234.2 +047000 IF TABLE2-NUM (INDEX2) EQUAL TO 4.7 NC1234.2 +047100 PERFORM PASS NC1234.2 +047200 ELSE GO TO IND-FAIL-GF-5. NC1234.2 +047300 GO TO IND-WRITE-GF-5. NC1234.2 +047400 IND-DELETE-GF-5. NC1234.2 +047500 PERFORM DE-LETE. NC1234.2 +047600 GO TO IND-WRITE-GF-5. NC1234.2 +047700 IND-FAIL-GF-5. NC1234.2 +047800 PERFORM FAIL. NC1234.2 +047900 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +048000 MOVE 4.7 TO CORRECT-14V4. NC1234.2 +048100 IND-WRITE-GF-5. NC1234.2 +048200 MOVE "IND-TEST-GF-5" TO PAR-NAME. NC1234.2 +048300 PERFORM PRINT-DETAIL. NC1234.2 +048400 IND-INIT-GF-6. NC1234.2 +048500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +048600 MOVE "ADD ON SIZE ERROR" TO FEATURE. NC1234.2 +048700 PERFORM BUILD-TABLE2. NC1234.2 +048800 SET INDEX1 TO 3. NC1234.2 +048900 SET INDEX2 TO 3. NC1234.2 +049000 IND-TEST-GF-6-1. NC1234.2 +049100 ADD TABLE1-NUM (INDEX1) TO TABLE2-NUM (INDEX2) ON SIZE ERROR NC1234.2 +049200 PERFORM PASS NC1234.2 +049300 GO TO IND-WRITE-GF-6-1. NC1234.2 +049400 GO TO IND-FAIL-GF-6-1. NC1234.2 +049500 IND-DELETE-GF-6-1. NC1234.2 +049600 PERFORM DE-LETE. NC1234.2 +049700 GO TO IND-WRITE-GF-6-1. NC1234.2 +049800 IND-FAIL-GF-6-1. NC1234.2 +049900 PERFORM FAIL. NC1234.2 +050000 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +050100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +050200 IND-WRITE-GF-6-1. NC1234.2 +050300 MOVE "IND-TEST-GF-6-1" TO PAR-NAME. NC1234.2 +050400 PERFORM PRINT-DETAIL. NC1234.2 +050500 IND-TEST-GF-6-2. NC1234.2 +050600 IF TABLE2-NUM (INDEX2) = 9.0 NC1234.2 +050700 PERFORM PASS NC1234.2 +050800 GO TO IND-WRITE-GF-6-2. NC1234.2 +050900 GO TO IND-FAIL-GF-6-2. NC1234.2 +051000 IND-DELETE-GF-6-2. NC1234.2 +051100 PERFORM DE-LETE. NC1234.2 +051200 GO TO IND-WRITE-GF-6-2. NC1234.2 +051300 IND-FAIL-GF-6-2. NC1234.2 +051400 PERFORM FAIL. NC1234.2 +051500 MOVE 9.0 TO CORRECT-14V4. NC1234.2 +051600 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +051700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +051800 IND-WRITE-GF-6-2. NC1234.2 +051900 MOVE "IND-TEST-GF-6-2" TO PAR-NAME. NC1234.2 +052000 PERFORM PRINT-DETAIL. NC1234.2 +052100 IND-INIT-GF-10. NC1234.2 +052200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +052300 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +052400 MOVE ZERO TO NUM-9V9. NC1234.2 +052500 SET INDEX1 TO 4. NC1234.2 +052600 IND-TEST-GF-10-0. NC1234.2 +052700 ADD 3 TABLE1-NUM (INDEX1) GIVING NUM-9V9. NC1234.2 +052800 IND-TEST-GF-10-1. NC1234.2 +052900 IF NUM-9V9 EQUAL TO 8.0 NC1234.2 +053000 PERFORM PASS NC1234.2 +053100 ELSE GO TO IND-FAIL-GF-10. NC1234.2 +053200 GO TO IND-WRITE-GF-10. NC1234.2 +053300 IND-DELETE-GF-10. NC1234.2 +053400 PERFORM DE-LETE. NC1234.2 +053500 GO TO IND-WRITE-GF-10. NC1234.2 +053600 IND-FAIL-GF-10. NC1234.2 +053700 PERFORM FAIL. NC1234.2 +053800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +053900 MOVE 8.0 TO CORRECT-14V4. NC1234.2 +054000 IND-WRITE-GF-10. NC1234.2 +054100 MOVE "IND-TEST-GF-10" TO PAR-NAME. NC1234.2 +054200 PERFORM PRINT-DETAIL. NC1234.2 +054300 IND-INIT-GF-11. NC1234.2 +054400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +054500 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +054600 MOVE ZERO TO NUM-9V9. NC1234.2 +054700 PERFORM BUILD-TABLE2. NC1234.2 +054800 SET INDEX1 TO 1. NC1234.2 +054900 SET INDEX2 TO 4. NC1234.2 +055000 IND-TEST-GF-11-0. NC1234.2 +055100 ADD TABLE1-NUM (INDEX1) TABLE2-NUM (INDEX2) GIVING NUM-9V9. NC1234.2 +055200 IND-TEST-GF-11-1. NC1234.2 +055300 IF NUM-9V9 EQUAL TO 5.0 NC1234.2 +055400 PERFORM PASS NC1234.2 +055500 ELSE GO TO IND-FAIL-GF-11. NC1234.2 +055600 GO TO IND-WRITE-GF-11. NC1234.2 +055700 IND-DELETE-GF-11. NC1234.2 +055800 PERFORM DE-LETE. NC1234.2 +055900 GO TO IND-WRITE-GF-11. NC1234.2 +056000 IND-FAIL-GF-11. NC1234.2 +056100 PERFORM FAIL. NC1234.2 +056200 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +056300 MOVE 5.0 TO CORRECT-14V4. NC1234.2 +056400 IND-WRITE-GF-11. NC1234.2 +056500 MOVE "IND-TEST-GF-11" TO PAR-NAME. NC1234.2 +056600 PERFORM PRINT-DETAIL. NC1234.2 +056700 IND-INIT-GF-12. NC1234.2 +056800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +056900 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +057000 PERFORM BUILD-TABLE2. NC1234.2 +057100 MOVE ZERO TO TABLE3. NC1234.2 +057200 SET INDEX1 TO 5. NC1234.2 +057300 SET INDEX2 TO 1. NC1234.2 +057400 SET INDEX3 TO 3. NC1234.2 +057500 IND-TEST-GF-12-0. NC1234.2 +057600 ADD TABLE1-NUM (INDEX1) TABLE2-NUM (INDEX2) NC1234.2 +057700 GIVING TABLE3-NUM (INDEX3). NC1234.2 +057800 IND-TEST-GF-12-1. NC1234.2 +057900 IF TABLE3-NUM (INDEX3) EQUAL TO 7.0 NC1234.2 +058000 PERFORM PASS NC1234.2 +058100 ELSE GO TO IND-FAIL-GF-12. NC1234.2 +058200 GO TO IND-WRITE-GF-12. NC1234.2 +058300 IND-DELETE-GF-12. NC1234.2 +058400 PERFORM DE-LETE. NC1234.2 +058500 GO TO IND-WRITE-GF-12. NC1234.2 +058600 IND-FAIL-GF-12. NC1234.2 +058700 PERFORM FAIL. NC1234.2 +058800 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1234.2 +058900 MOVE 7.0 TO CORRECT-14V4. NC1234.2 +059000 IND-WRITE-GF-12. NC1234.2 +059100 MOVE "IND-TEST-GF-12" TO PAR-NAME. NC1234.2 +059200 PERFORM PRINT-DETAIL. NC1234.2 +059300 IND-INIT-GF-7. NC1234.2 +059400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +059500 MOVE "ADD TO" TO FEATURE. NC1234.2 +059600 SET INDEX4-1 TO 3. NC1234.2 +059700 SET INDEX4-2 TO 2. NC1234.2 +059800 IND-TEST-GF-7-0. NC1234.2 +059900 ADD TABLE4-NUM2 (3 1) TO TABLE4-NUM2 (INDEX4-1 INDEX4-2). NC1234.2 +060000 IND-TEST-GF-7-1. NC1234.2 +060100 IF TABLE4-NUM2 (INDEX4-1 INDEX4-2) EQUAL TO 53 NC1234.2 +060200 PERFORM PASS NC1234.2 +060300 ELSE GO TO IND-FAIL-GF-7. NC1234.2 +060400 GO TO IND-WRITE-GF-7. NC1234.2 +060500 IND-DELETE-GF-7. NC1234.2 +060600 PERFORM DE-LETE. NC1234.2 +060700 GO TO IND-WRITE-GF-7. NC1234.2 +060800 IND-FAIL-GF-7. NC1234.2 +060900 PERFORM FAIL. NC1234.2 +061000 MOVE TABLE4-NUM2 (INDEX4-1 INDEX4-2) TO COMPUTED-14V4. NC1234.2 +061100 MOVE 53 TO CORRECT-14V4. NC1234.2 +061200 IND-WRITE-GF-7. NC1234.2 +061300 MOVE "IND-TEST-GF-7" TO PAR-NAME. NC1234.2 +061400 PERFORM PRINT-DETAIL. NC1234.2 +061500 IND-INIT-GF-8. NC1234.2 +061600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +061700 MOVE "ADD TO" TO FEATURE. NC1234.2 +061800 MOVE 1.6 TO NUM-9V9. NC1234.2 +061900 SET INDEX1 TO 5. NC1234.2 +062000 IND-TEST-GF-8-0. NC1234.2 +062100 ADD TABLE1-NUM (INDEX1 + 1) TO NUM-9V9. NC1234.2 +062200 IND-TEST-GF-8-1. NC1234.2 +062300 IF NUM-9V9 EQUAL TO 3.1 NC1234.2 +062400 PERFORM PASS NC1234.2 +062500 ELSE GO TO IND-FAIL-GF-8. NC1234.2 +062600 GO TO IND-WRITE-GF-8. NC1234.2 +062700 IND-DELETE-GF-8. NC1234.2 +062800 PERFORM DE-LETE. NC1234.2 +062900 GO TO IND-WRITE-GF-8. NC1234.2 +063000 IND-FAIL-GF-8. NC1234.2 +063100 PERFORM FAIL. NC1234.2 +063200 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +063300 MOVE 3.1 TO CORRECT-14V4. NC1234.2 +063400 IND-WRITE-GF-8. NC1234.2 +063500 MOVE "IND-TEST-GF-8" TO PAR-NAME. NC1234.2 +063600 PERFORM PRINT-DETAIL. NC1234.2 +063700 IND-INIT-GF-9. NC1234.2 +063800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +063900 MOVE "ADD TO" TO FEATURE. NC1234.2 +064000 PERFORM BUILD-TABLE2. NC1234.2 +064100 SET INDEX1 TO 6. NC1234.2 +064200 SET INDEX2 TO 6. NC1234.2 +064300 IND-TEST-GF-9-0. NC1234.2 +064400 ADD TABLE1-NUM (INDEX1 + 1) TO TABLE2-NUM (INDEX2 - 1). NC1234.2 +064500 IND-TEST-GF-9-1. NC1234.2 +064600 IF TABLE2-NUM (INDEX2 - 1) EQUAL TO 8.1 NC1234.2 +064700 PERFORM PASS NC1234.2 +064800 ELSE GO TO IND-FAIL-GF-9. NC1234.2 +064900 GO TO IND-WRITE-GF-9. NC1234.2 +065000 IND-DELETE-GF-9. NC1234.2 +065100 PERFORM DE-LETE. NC1234.2 +065200 GO TO IND-WRITE-GF-9. NC1234.2 +065300 IND-FAIL-GF-9. NC1234.2 +065400 PERFORM FAIL. NC1234.2 +065500 MOVE TABLE2-NUM (INDEX2 - 1) TO COMPUTED-14V4. NC1234.2 +065600 MOVE 8.1 TO CORRECT-14V4. NC1234.2 +065700 IND-WRITE-GF-9. NC1234.2 +065800 MOVE "IND-TEST-GF-9" TO PAR-NAME. NC1234.2 +065900 PERFORM PRINT-DETAIL. NC1234.2 +066000 IND-INIT-GF-13. NC1234.2 +066100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +066200 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +066300 PERFORM BUILD-TABLE2. NC1234.2 +066400 MOVE ZERO TO NUM-9V9. NC1234.2 +066500 SET INDEX1 TO 7. NC1234.2 +066600 SET INDEX2 TO 4. NC1234.2 +066700 IND-TEST-GF-13-0. NC1234.2 +066800 ADD TABLE1-NUM (INDEX1 + 1) TABLE2-NUM (INDEX2 + 2) NC1234.2 +066900 GIVING NUM-9V9. NC1234.2 +067000 IND-TEST-GF-13-1. NC1234.2 +067100 IF NUM-9V9 EQUAL TO 7.9 NC1234.2 +067200 PERFORM PASS NC1234.2 +067300 ELSE GO TO IND-FAIL-GF-13. NC1234.2 +067400 GO TO IND-WRITE-GF-13. NC1234.2 +067500 IND-DELETE-GF-13. NC1234.2 +067600 PERFORM DE-LETE. NC1234.2 +067700 GO TO IND-WRITE-GF-13. NC1234.2 +067800 IND-FAIL-GF-13. NC1234.2 +067900 PERFORM FAIL. NC1234.2 +068000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +068100 MOVE 7.9 TO CORRECT-14V4. NC1234.2 +068200 IND-WRITE-GF-13. NC1234.2 +068300 MOVE "IND-TEST-GF-13" TO PAR-NAME. NC1234.2 +068400 PERFORM PRINT-DETAIL. NC1234.2 +068500 IND-INIT-GF-14. NC1234.2 +068600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +068700 MOVE "ADD GIVING" TO FEATURE. NC1234.2 +068800 PERFORM BUILD-TABLE2. NC1234.2 +068900 MOVE ZERO TO TABLE3. NC1234.2 +069000 SET INDEX1 TO 3. NC1234.2 +069100 SET INDEX2 TO 2. NC1234.2 +069200 SET INDEX3 TO 6. NC1234.2 +069300 IND-TEST-GF-14-0. NC1234.2 +069400 ADD TABLE1-NUM (INDEX1 + 1) TABLE2-NUM (INDEX2 + 1) NC1234.2 +069500 GIVING TABLE3-NUM (INDEX3 - 2). NC1234.2 +069600 IND-TEST-GF-14-1. NC1234.2 +069700 IF TABLE3-NUM (INDEX3 - 2) EQUAL TO 14.0 NC1234.2 +069800 PERFORM PASS NC1234.2 +069900 ELSE GO TO IND-FAIL-GF-14. NC1234.2 +070000 GO TO IND-WRITE-GF-14. NC1234.2 +070100 IND-DELETE-GF-14. NC1234.2 +070200 PERFORM DE-LETE. NC1234.2 +070300 GO TO IND-WRITE-GF-14. NC1234.2 +070400 IND-FAIL-GF-14. NC1234.2 +070500 PERFORM FAIL. NC1234.2 +070600 MOVE TABLE3-NUM (INDEX3 - 2) TO COMPUTED-14V4. NC1234.2 +070700 MOVE 14.0 TO CORRECT-14V4. NC1234.2 +070800 IND-WRITE-GF-14. NC1234.2 +070900 MOVE "IND-TEST-GF-14" TO PAR-NAME. NC1234.2 +071000 PERFORM PRINT-DETAIL. NC1234.2 +071100 IND-INIT-GF-15. NC1234.2 +071200 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +071300 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +071400 MOVE 3.0 TO NUM-9V9. NC1234.2 +071500 SET INDEX1 TO 1. NC1234.2 +071600 IND-TEST-GF-15-0. NC1234.2 +071700 SUBTRACT TABLE1-NUM (INDEX1) FROM NUM-9V9. NC1234.2 +071800 IND-TEST-GF-15-1. NC1234.2 +071900 IF NUM-9V9 EQUAL TO 2.0 NC1234.2 +072000 PERFORM PASS NC1234.2 +072100 ELSE GO TO IND-FAIL-GF-15. NC1234.2 +072200 GO TO IND-WRITE-GF-15. NC1234.2 +072300 IND-DELETE-GF-15. NC1234.2 +072400 PERFORM DE-LETE. NC1234.2 +072500 GO TO IND-WRITE-GF-15. NC1234.2 +072600 IND-FAIL-GF-15. NC1234.2 +072700 PERFORM FAIL. NC1234.2 +072800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +072900 MOVE 2.0 TO CORRECT-14V4. NC1234.2 +073000 IND-WRITE-GF-15. NC1234.2 +073100 MOVE "IND-TEST-GF-15" TO PAR-NAME. NC1234.2 +073200 PERFORM PRINT-DETAIL. NC1234.2 +073300 IND-INIT-GF-16. NC1234.2 +073400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +073500 MOVE "SUBTRACT ROUNDED" TO FEATURE. NC1234.2 +073600 MOVE 5.0 TO NUM-9V9. NC1234.2 +073700 SET INDEX1 TO 9. NC1234.2 +073800 IND-TEST-GF-16-0. NC1234.2 +073900 SUBTRACT TABLE1-NUM (INDEX1) FROM NUM-9V9 ROUNDED. NC1234.2 +074000 IND-TEST-GF-16-1. NC1234.2 +074100 IF NUM-9V9 EQUAL TO 2.4 NC1234.2 +074200 PERFORM PASS NC1234.2 +074300 ELSE GO TO IND-FAIL-GF-16. NC1234.2 +074400 GO TO IND-WRITE-GF-16. NC1234.2 +074500 IND-DELETE-GF-16. NC1234.2 +074600 PERFORM DE-LETE. NC1234.2 +074700 GO TO IND-WRITE-GF-16. NC1234.2 +074800 IND-FAIL-GF-16. NC1234.2 +074900 PERFORM FAIL. NC1234.2 +075000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +075100 MOVE 2.4 TO CORRECT-14V4. NC1234.2 +075200 IND-WRITE-GF-16. NC1234.2 +075300 MOVE "IND-TEST-GF-16" TO PAR-NAME. NC1234.2 +075400 PERFORM PRINT-DETAIL. NC1234.2 +075500 IND-INIT-GF-17. NC1234.2 +075600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +075700 MOVE "SUBTRACT ON SIZE ERROR" TO FEATURE. NC1234.2 +075800 MOVE 9.0 TO NUM-9V9. NC1234.2 +075900 SET INDEX1 TO 10. NC1234.2 +076000 IND-TEST-GF-17-1. NC1234.2 +076100 SUBTRACT TABLE1-NUM (INDEX1) FROM NUM-9V9 ON SIZE ERROR NC1234.2 +076200 PERFORM PASS NC1234.2 +076300 GO TO IND-WRITE-GF-17-1. NC1234.2 +076400 GO TO IND-FAIL-GF-17-1. NC1234.2 +076500 IND-DELETE-GF-17-1. NC1234.2 +076600 PERFORM DE-LETE. NC1234.2 +076700 GO TO IND-WRITE-GF-17-1. NC1234.2 +076800 IND-FAIL-GF-17-1. NC1234.2 +076900 PERFORM FAIL. NC1234.2 +077000 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +077100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +077200 IND-WRITE-GF-17-1. NC1234.2 +077300 MOVE "IND-TEST-GF-17-1" TO PAR-NAME. NC1234.2 +077400 PERFORM PRINT-DETAIL. NC1234.2 +077500 IND-TEST-GF-17-2. NC1234.2 +077600 IF NUM-9V9 = 9.0 NC1234.2 +077700 PERFORM PASS NC1234.2 +077800 GO TO IND-WRITE-GF-17-2. NC1234.2 +077900 GO TO IND-FAIL-GF-17-2. NC1234.2 +078000 IND-DELETE-GF-17-2. NC1234.2 +078100 PERFORM DE-LETE. NC1234.2 +078200 GO TO IND-WRITE-GF-17-2. NC1234.2 +078300 IND-FAIL-GF-17-2. NC1234.2 +078400 PERFORM FAIL. NC1234.2 +078500 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +078600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1234.2 +078700 IND-WRITE-GF-17-2. NC1234.2 +078800 MOVE "IND-TEST-GF-17-2" TO PAR-NAME. NC1234.2 +078900 PERFORM PRINT-DETAIL. NC1234.2 +079000 IND-INIT-GF-18. NC1234.2 +079100 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +079200 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +079300 PERFORM BUILD-TABLE2. NC1234.2 +079400 SET INDEX1 TO 1. NC1234.2 +079500 SET INDEX2 TO 1. NC1234.2 +079600 IND-TEST-GF-18-0. NC1234.2 +079700 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2). NC1234.2 +079800 IND-TEST-GF-18-1. NC1234.2 +079900 IF TABLE2-NUM (INDEX2) EQUAL TO 4.0 NC1234.2 +080000 PERFORM PASS NC1234.2 +080100 ELSE GO TO IND-FAIL-GF-18. NC1234.2 +080200 GO TO IND-WRITE-GF-18. NC1234.2 +080300 IND-DELETE-GF-18. NC1234.2 +080400 PERFORM DE-LETE. NC1234.2 +080500 GO TO IND-WRITE-GF-18. NC1234.2 +080600 IND-FAIL-GF-18. NC1234.2 +080700 PERFORM FAIL. NC1234.2 +080800 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +080900 MOVE 4.0 TO CORRECT-14V4. NC1234.2 +081000 IND-WRITE-GF-18. NC1234.2 +081100 MOVE "IND-TEST-GF-18" TO PAR-NAME. NC1234.2 +081200 PERFORM PRINT-DETAIL. NC1234.2 +081300 IND-INIT-GF-19. NC1234.2 +081400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +081500 MOVE "SUBTRACT ROUNDED" TO FEATURE. NC1234.2 +081600 PERFORM BUILD-TABLE2. NC1234.2 +081700 SET INDEX1 TO 9. NC1234.2 +081800 SET INDEX2 TO 3. NC1234.2 +081900 IND-TEST-GF-19-0. NC1234.2 +082000 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2) NC1234.2 +082100 ROUNDED. NC1234.2 +082200 IND-TEST-GF-19-1. NC1234.2 +082300 IF TABLE2-NUM (INDEX2) EQUAL TO 6.4 NC1234.2 +082400 PERFORM PASS NC1234.2 +082500 ELSE GO TO IND-FAIL-GF-19. NC1234.2 +082600 GO TO IND-WRITE-GF-19. NC1234.2 +082700 IND-DELETE-GF-19. NC1234.2 +082800 PERFORM DE-LETE. NC1234.2 +082900 GO TO IND-WRITE-GF-19. NC1234.2 +083000 IND-FAIL-GF-19. NC1234.2 +083100 PERFORM FAIL. NC1234.2 +083200 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +083300 MOVE 6.4 TO CORRECT-14V4. NC1234.2 +083400 IND-WRITE-GF-19. NC1234.2 +083500 MOVE "IND-TEST-GF-19" TO PAR-NAME. NC1234.2 +083600 PERFORM PRINT-DETAIL. NC1234.2 +083700 IND-INIT-GF-20. NC1234.2 +083800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +083900 MOVE "SUBTRACT ON SIZE ERROR" TO FEATURE. NC1234.2 +084000 PERFORM BUILD-TABLE2. NC1234.2 +084100 SET INDEX1 TO 10. NC1234.2 +084200 SET INDEX2 TO 4. NC1234.2 +084300 IND-TEST-GF-20-1. NC1234.2 +084400 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2) NC1234.2 +084500 ON SIZE ERROR NC1234.2 +084600 PERFORM PASS NC1234.2 +084700 GO TO IND-WRITE-GF-20-1. NC1234.2 +084800 GO TO IND-FAIL-GF-20-1. NC1234.2 +084900 IND-DELETE-GF-20-1. NC1234.2 +085000 PERFORM DE-LETE. NC1234.2 +085100 GO TO IND-WRITE-GF-20-1. NC1234.2 +085200 IND-FAIL-GF-20-1. NC1234.2 +085300 PERFORM FAIL. NC1234.2 +085400 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +085500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +085600 IND-WRITE-GF-20-1. NC1234.2 +085700 MOVE "IND-TEST-GF-20-1" TO PAR-NAME. NC1234.2 +085800 PERFORM PRINT-DETAIL. NC1234.2 +085900 IND-TEST-GF-20-2. NC1234.2 +086000 IF TABLE2-NUM (INDEX2) = 4.0 NC1234.2 +086100 PERFORM PASS NC1234.2 +086200 GO TO IND-WRITE-GF-20-2. NC1234.2 +086300 GO TO IND-FAIL-GF-20-2. NC1234.2 +086400 IND-DELETE-GF-20-2. NC1234.2 +086500 PERFORM DE-LETE. NC1234.2 +086600 GO TO IND-WRITE-GF-20-2. NC1234.2 +086700 IND-FAIL-GF-20-2. NC1234.2 +086800 PERFORM FAIL. NC1234.2 +086900 MOVE TABLE2-NUM (INDEX2) TO COMPUTED-14V4. NC1234.2 +087000 MOVE 4 TO CORRECT-14V4. NC1234.2 +087100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1234.2 +087200 IND-WRITE-GF-20-2. NC1234.2 +087300 MOVE "IND-TEST-GF-20-2" TO PAR-NAME. NC1234.2 +087400 PERFORM PRINT-DETAIL. NC1234.2 +087500 IND-INIT-GF-24. NC1234.2 +087600 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +087700 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +087800 MOVE ZERO TO NUM-9V9. NC1234.2 +087900 SET INDEX1 TO 1. NC1234.2 +088000 IND-TEST-GF-24-0. NC1234.2 +088100 SUBTRACT TABLE1-NUM (INDEX1) FROM 8 GIVING NUM-9V9. NC1234.2 +088200 IND-TEST-GF-24-1. NC1234.2 +088300 IF NUM-9V9 EQUAL TO 7.0 NC1234.2 +088400 PERFORM PASS NC1234.2 +088500 ELSE GO TO IND-FAIL-GF-24. NC1234.2 +088600 GO TO IND-WRITE-GF-24. NC1234.2 +088700 IND-DELETE-GF-24. NC1234.2 +088800 PERFORM DE-LETE. NC1234.2 +088900 GO TO IND-WRITE-GF-24. NC1234.2 +089000 IND-FAIL-GF-24. NC1234.2 +089100 PERFORM FAIL. NC1234.2 +089200 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +089300 MOVE 7.0 TO CORRECT-14V4. NC1234.2 +089400 IND-WRITE-GF-24. NC1234.2 +089500 MOVE "IND-TEST-GF-24" TO PAR-NAME. NC1234.2 +089600 PERFORM PRINT-DETAIL. NC1234.2 +089700 IND-INIT-GF-25. NC1234.2 +089800 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +089900 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +090000 MOVE ZERO TO NUM-9V9. NC1234.2 +090100 PERFORM BUILD-TABLE2. NC1234.2 +090200 SET INDEX1 TO 1. NC1234.2 +090300 SET INDEX2 TO 3. NC1234.2 +090400 IND-TEST-GF-25-0. NC1234.2 +090500 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2) NC1234.2 +090600 GIVING NUM-9V9. NC1234.2 +090700 IND-TEST-GF-25-1. NC1234.2 +090800 IF NUM-9V9 EQUAL TO 8.0 NC1234.2 +090900 PERFORM PASS NC1234.2 +091000 ELSE GO TO IND-FAIL-GF-25. NC1234.2 +091100 GO TO IND-WRITE-GF-25. NC1234.2 +091200 IND-DELETE-GF-25. NC1234.2 +091300 PERFORM DE-LETE. NC1234.2 +091400 GO TO IND-WRITE-GF-25. NC1234.2 +091500 IND-FAIL-GF-25. NC1234.2 +091600 PERFORM FAIL. NC1234.2 +091700 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +091800 MOVE 8.0 TO CORRECT-14V4. NC1234.2 +091900 IND-WRITE-GF-25. NC1234.2 +092000 MOVE "IND-TEST-GF-25" TO PAR-NAME. NC1234.2 +092100 PERFORM PRINT-DETAIL. NC1234.2 +092200 IND-INIT-GF-26. NC1234.2 +092300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +092400 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +092500 MOVE ZERO TO TABLE3. NC1234.2 +092600 PERFORM BUILD-TABLE2. NC1234.2 +092700 SET INDEX1 TO 10. NC1234.2 +092800 SET INDEX2 TO 1. NC1234.2 +092900 SET INDEX3 TO 3. NC1234.2 +093000 IND-TEST-GF-26-0. NC1234.2 +093100 SUBTRACT TABLE1-NUM (INDEX1) FROM TABLE2-NUM (INDEX2) NC1234.2 +093200 GIVING TABLE3-NUM (INDEX3). NC1234.2 +093300 IND-TEST-GF-26-1. NC1234.2 +093400 IF TABLE3-NUM (INDEX3) EQUAL TO 14.0 NC1234.2 +093500 PERFORM PASS NC1234.2 +093600 ELSE GO TO IND-FAIL-GF-26. NC1234.2 +093700 GO TO IND-WRITE-GF-26. NC1234.2 +093800 IND-DELETE-GF-26. NC1234.2 +093900 PERFORM DE-LETE. NC1234.2 +094000 GO TO IND-WRITE-GF-26. NC1234.2 +094100 IND-FAIL-GF-26. NC1234.2 +094200 PERFORM FAIL. NC1234.2 +094300 MOVE TABLE3-NUM (INDEX3) TO COMPUTED-14V4. NC1234.2 +094400 MOVE 14.0 TO CORRECT-14V4. NC1234.2 +094500 IND-WRITE-GF-26. NC1234.2 +094600 MOVE "IND-TEST-GF-26" TO PAR-NAME. NC1234.2 +094700 PERFORM PRINT-DETAIL. NC1234.2 +094800 IND-INIT-GF-21. NC1234.2 +094900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +095000 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +095100 PERFORM BUILD-TABLE4. NC1234.2 +095200 SET INDEX4-1 TO 3. NC1234.2 +095300 SET INDEX4-2 TO 3. NC1234.2 +095400 IND-TEST-GF-21-0. NC1234.2 +095500 SUBTRACT TABLE4-NUM2 (1 1) FROM NC1234.2 +095600 TABLE4-NUM2 (INDEX4-1 INDEX4-2). NC1234.2 +095700 IND-TEST-GF-21-1. NC1234.2 +095800 IF TABLE4-NUM2 (INDEX4-1 INDEX4-2) EQUAL TO 8 NC1234.2 +095900 PERFORM PASS NC1234.2 +096000 ELSE GO TO IND-FAIL-GF-21. NC1234.2 +096100 GO TO IND-WRITE-GF-21. NC1234.2 +096200 IND-DELETE-GF-21. NC1234.2 +096300 PERFORM DE-LETE. NC1234.2 +096400 GO TO IND-WRITE-GF-21. NC1234.2 +096500 IND-FAIL-GF-21. NC1234.2 +096600 PERFORM FAIL. NC1234.2 +096700 MOVE TABLE4-NUM2 (INDEX4-1 INDEX4-2) TO COMPUTED-14V4. NC1234.2 +096800 MOVE 8.0 TO CORRECT-14V4. NC1234.2 +096900 IND-WRITE-GF-21. NC1234.2 +097000 MOVE "SUBTRCT-TEST-GF-21" TO PAR-NAME. NC1234.2 +097100 PERFORM PRINT-DETAIL. NC1234.2 +097200 IND-INIT-GF-22. NC1234.2 +097300 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +097400 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +097500 MOVE 0.0 TO NUM-9V9. NC1234.2 +097600 SET INDEX1 TO 9. NC1234.2 +097700 IND-TEST-GF-22-0. NC1234.2 +097800 SUBTRACT TABLE1-NUM (INDEX1 + 1) FROM NUM-9V9. NC1234.2 +097900 IND-TEST-GF-22-1. NC1234.2 +098000 IF NUM-9V9 EQUAL TO 9.0 NC1234.2 +098100 PERFORM PASS NC1234.2 +098200 ELSE GO TO IND-FAIL-GF-22. NC1234.2 +098300 GO TO IND-WRITE-GF-22. NC1234.2 +098400 IND-DELETE-GF-22. NC1234.2 +098500 PERFORM DE-LETE. NC1234.2 +098600 GO TO IND-WRITE-GF-22. NC1234.2 +098700 IND-FAIL-GF-22. NC1234.2 +098800 PERFORM FAIL. NC1234.2 +098900 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +099000 MOVE 9.0 TO CORRECT-14V4. NC1234.2 +099100 IND-WRITE-GF-22. NC1234.2 +099200 MOVE "SUBTRCT-TEST-GF-22" TO PAR-NAME. NC1234.2 +099300 PERFORM PRINT-DETAIL. NC1234.2 +099400 IND-INIT-GF-23. NC1234.2 +099500 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +099600 MOVE "SUBTRACT FROM" TO FEATURE. NC1234.2 +099700 PERFORM BUILD-TABLE2. NC1234.2 +099800 SET INDEX1 TO 9. NC1234.2 +099900 SET INDEX2 TO 6. NC1234.2 +100000 IND-TEST-GF-23-0. NC1234.2 +100100 SUBTRACT TABLE1-NUM (INDEX1 - 2) FROM NC1234.2 +100200 TABLE2-NUM (INDEX2 - 1). NC1234.2 +100300 IND-TEST-GF-23-1. NC1234.2 +100400 IF TABLE2-NUM (INDEX2 - 1) EQUAL TO 1.1 NC1234.2 +100500 PERFORM PASS NC1234.2 +100600 ELSE GO TO IND-FAIL-GF-23. NC1234.2 +100700 GO TO IND-WRITE-GF-23. NC1234.2 +100800 IND-DELETE-GF-23. NC1234.2 +100900 PERFORM DE-LETE. NC1234.2 +101000 GO TO IND-WRITE-GF-23. NC1234.2 +101100 IND-FAIL-GF-23. NC1234.2 +101200 PERFORM FAIL. NC1234.2 +101300 MOVE TABLE2-NUM (INDEX2 - 1) TO COMPUTED-14V4. NC1234.2 +101400 MOVE 1.1 TO CORRECT-14V4. NC1234.2 +101500 IND-WRITE-GF-23. NC1234.2 +101600 MOVE "SUBTRCT-TEST-GF-23" TO PAR-NAME. NC1234.2 +101700 PERFORM PRINT-DETAIL. NC1234.2 +101800 IND-INIT-GF-27. NC1234.2 +101900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +102000 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +102100 MOVE ZERO TO NUM-9V9. NC1234.2 +102200 PERFORM BUILD-TABLE2. NC1234.2 +102300 SET INDEX1 TO 7. NC1234.2 +102400 SET INDEX2 TO 4. NC1234.2 +102500 IND-TEST-GF-27-0. NC1234.2 +102600 SUBTRACT TABLE1-NUM (INDEX1 - 2) FROM NC1234.2 +102700 TABLE2-NUM (INDEX2 - 1) GIVING NUM-9V9. NC1234.2 +102800 IND-TEST-GF-27-1. NC1234.2 +102900 IF NUM-9V9 EQUAL TO 7.0 NC1234.2 +103000 PERFORM PASS NC1234.2 +103100 ELSE GO TO IND-FAIL-GF-27. NC1234.2 +103200 GO TO IND-WRITE-GF-27. NC1234.2 +103300 IND-DELETE-GF-27. NC1234.2 +103400 PERFORM DE-LETE. NC1234.2 +103500 GO TO IND-WRITE-GF-27. NC1234.2 +103600 IND-FAIL-GF-27. NC1234.2 +103700 PERFORM FAIL. NC1234.2 +103800 MOVE NUM-9V9 TO COMPUTED-14V4. NC1234.2 +103900 MOVE 7.0 TO CORRECT-14V4. NC1234.2 +104000 IND-WRITE-GF-27. NC1234.2 +104100 MOVE "SUBTRCT-TEST-GF-27" TO PAR-NAME. NC1234.2 +104200 PERFORM PRINT-DETAIL. NC1234.2 +104300 IND-INIT-GF-28. NC1234.2 +104400 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +104500 MOVE "SUBTRACT GIVING" TO FEATURE. NC1234.2 +104600 MOVE ZERO TO TABLE3. NC1234.2 +104700 PERFORM BUILD-TABLE2. NC1234.2 +104800 SET INDEX1 TO 8. NC1234.2 +104900 SET INDEX2 TO 2. NC1234.2 +105000 SET INDEX3 TO 6. NC1234.2 +105100 IND-TEST-GF-28-0. NC1234.2 +105200 SUBTRACT TABLE1-NUM (INDEX1 + 2) FROM NC1234.2 +105300 TABLE2-NUM (INDEX2 + 1) GIVING TABLE3-NUM (INDEX3 - 1). NC1234.2 +105400 IND-TEST-GF-28-1. NC1234.2 +105500 IF TABLE3-NUM (INDEX3 - 1) EQUAL TO 18.0 NC1234.2 +105600 PERFORM PASS NC1234.2 +105700 ELSE GO TO IND-FAIL-GF-28. NC1234.2 +105800 GO TO IND-WRITE-GF-28. NC1234.2 +105900 IND-DELETE-GF-28. NC1234.2 +106000 PERFORM DE-LETE. NC1234.2 +106100 GO TO IND-WRITE-GF-28. NC1234.2 +106200 IND-FAIL-GF-28. NC1234.2 +106300 PERFORM FAIL. NC1234.2 +106400 MOVE TABLE3-NUM (INDEX3 - 1) TO COMPUTED-14V4. NC1234.2 +106500 MOVE 18.0 TO CORRECT-14V4. NC1234.2 +106600 IND-WRITE-GF-28. NC1234.2 +106700 MOVE "SUBTRCT-TEST-GF-28" TO PAR-NAME. NC1234.2 +106800 PERFORM PRINT-DETAIL. NC1234.2 +106900 IND-INIT-GF-29. NC1234.2 +107000 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +107100 MOVE "GO TO DEPENDING ON" TO FEATURE. NC1234.2 +107200 SET INDEX5 TO 1. NC1234.2 +107300 IND-TEST-GF-29. NC1234.2 +107400 GO TO IND-A NC1234.2 +107500 IND-B NC1234.2 +107600 IND-C DEPENDING ON TABLE5-NUM (INDEX5). NC1234.2 +107700 GO TO IND-FAIL-GF-29. NC1234.2 +107800 IND-DELETE-GF-29. NC1234.2 +107900 PERFORM DE-LETE. NC1234.2 +108000 GO TO IND-WRITE-GF-29. NC1234.2 +108100 IND-FAIL-GF-29. NC1234.2 +108200 PERFORM FAIL. NC1234.2 +108300 MOVE "TRANSFERED CONTROL TO WRONG PAR" TO RE-MARK. NC1234.2 +108400 GO TO IND-WRITE-GF-29. NC1234.2 +108500 IND-A. NC1234.2 +108600 MOVE "IND-A" TO COMPUTED-A. NC1234.2 +108700 MOVE "IND-C" TO CORRECT-A. NC1234.2 +108800 GO TO IND-FAIL-GF-29. NC1234.2 +108900 IND-B. NC1234.2 +109000 MOVE "IND-B" TO COMPUTED-A. NC1234.2 +109100 MOVE "IND-C" TO CORRECT-A. NC1234.2 +109200 GO TO IND-FAIL-GF-29. NC1234.2 +109300 IND-C. NC1234.2 +109400 PERFORM PASS. NC1234.2 +109500 IND-WRITE-GF-29. NC1234.2 +109600 MOVE "IND-TEST-GF-29" TO PAR-NAME. NC1234.2 +109700 PERFORM PRINT-DETAIL. NC1234.2 +109800 IND-INIT-GF-30. NC1234.2 +109900 MOVE "IV-21 4.3.8.2.3/4" TO ANSI-REFERENCE. NC1234.2 +110000 MOVE "GO TO DEPENDING ON" TO FEATURE. NC1234.2 +110100 SET INDEX5 TO 1. NC1234.2 +110200 IND-TEST-GF-30. NC1234.2 +110300 GO TO IND-D NC1234.2 +110400 IND-E NC1234.2 +110500 IND-F DEPENDING ON TABLE5-NUM (INDEX5 + 1). NC1234.2 +110600 GO TO IND-FAIL-GF-30. NC1234.2 +110700 IND-DELETE-GF-30. NC1234.2 +110800 PERFORM DE-LETE. NC1234.2 +110900 GO TO IND-WRITE-GF-30. NC1234.2 +111000 IND-FAIL-GF-30. NC1234.2 +111100 PERFORM FAIL. NC1234.2 +111200 MOVE "TRANSFERED CONTROL TO WRONG PAR" TO RE-MARK. NC1234.2 +111300 GO TO IND-WRITE-GF-30. NC1234.2 +111400 IND-D. NC1234.2 +111500 MOVE "IND-D" TO COMPUTED-A. NC1234.2 +111600 MOVE "IND-E" TO CORRECT-A. NC1234.2 +111700 GO TO IND-FAIL-GF-30. NC1234.2 +111800 IND-F. NC1234.2 +111900 MOVE "IND-F" TO COMPUTED-A. NC1234.2 +112000 MOVE "IND-E" TO CORRECT-A. NC1234.2 +112100 GO TO IND-FAIL-GF-30. NC1234.2 +112200 IND-E. NC1234.2 +112300 PERFORM PASS. NC1234.2 +112400 IND-WRITE-GF-30. NC1234.2 +112500 MOVE "IND-TEST-GF-30" TO PAR-NAME. NC1234.2 +112600 PERFORM PRINT-DETAIL. NC1234.2 +112700 CCVS-EXIT SECTION. NC1234.2 +112800 CCVS-999999. NC1234.2 +112900 GO TO CLOSE-FILES. NC1234.2 diff --git a/tests/cobol85/NC/NC124A.CBL b/tests/cobol85/NC/NC124A.CBL new file mode 100755 index 00000000..515450cd --- /dev/null +++ b/tests/cobol85/NC/NC124A.CBL @@ -0,0 +1,2354 @@ +000100 IDENTIFICATION DIVISION. NC1244.2 +000200 PROGRAM-ID. NC1244.2 +000300 NC1244.2 +000400 NC124A. NC1244.2 +000500**************************************************************** NC1244.2 +000600* * NC1244.2 +000700* VALIDATION FOR:- * NC1244.2 +000800* * NC1244.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1244.2 +001000* * NC1244.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1244.2 +001200* * NC1244.2 +001300**************************************************************** NC1244.2 +001400* * NC1244.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC1244.2 +001600* * NC1244.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC1244.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC1244.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC1244.2 +002000* * NC1244.2 +002100**************************************************************** NC1244.2 +002200* NC1244.2 +002300* PROGRAM NC124A TESTS THE USE OF NC1244.2 +002400* PICTURE CHARACTERS P, S, +, -, Z AND *. NC1244.2 +002500* NC1244.2 +002600 ENVIRONMENT DIVISION. NC1244.2 +002700 CONFIGURATION SECTION. NC1244.2 +002800 SOURCE-COMPUTER. NC1244.2 +002900 Linux. NC1244.2 +003000 OBJECT-COMPUTER. NC1244.2 +003100 Linux. NC1244.2 +003200 INPUT-OUTPUT SECTION. NC1244.2 +003300 FILE-CONTROL. NC1244.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1244.2 +003500 "report.log". NC1244.2 +003600 DATA DIVISION. NC1244.2 +003700 FILE SECTION. NC1244.2 +003800 FD PRINT-FILE. NC1244.2 +003900 01 PRINT-REC PICTURE X(120). NC1244.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1244.2 +004100 WORKING-STORAGE SECTION. NC1244.2 +004200 01 WORK-AREA-1 PICTURE 9 VALUE 0. NC1244.2 +004300 01 WORK-AREA-2 PICTURE 99 VALUE 12. NC1244.2 +004400 01 WORK-AREA-3 PICTURE S99 VALUE -12. NC1244.2 +004500 01 WORK-AREA-4 PICTURE S999 VALUE 123. NC1244.2 +004600 01 WORK-AREA-5 PICTURE S999 VALUE -123. NC1244.2 +004700 01 WORK-AREA-6 PICTURE 9999 VALUE 1234. NC1244.2 +004800 01 WORK-AREA-7 PICTURE S9999 VALUE -1234. NC1244.2 +004900 01 WORK-AREA-8 PICTURE S99V99 VALUE 12.34. NC1244.2 +005000 01 WORK-AREA-9 PICTURE S99V99 VALUE -12.34. NC1244.2 +005100 01 WORK-AREA-10 PICTURE 9 VALUE 0. NC1244.2 +005200 01 WORK-AREA-11 PICTURE V99 VALUE .02. NC1244.2 +005300 01 WORK-AREA-12 PICTURE 99 VALUE 12. NC1244.2 +005400 01 WORK-AREA-13 PICTURE 99V99 VALUE 12.34. NC1244.2 +005500 01 WORK-AREA-14 PICTURE 9999 VALUE 1234. NC1244.2 +005600 01 WORK-AREA-15 PICTURE 9999V99 VALUE 1234.56. NC1244.2 +005700 01 WORK-AREA-16 PICTURE 9 VALUE 0. NC1244.2 +005800 01 WORK-AREA-17 PICTURE 99 VALUE 13. NC1244.2 +005900 01 WORK-AREA-18 PICTURE 999 VALUE 123. NC1244.2 +006000 01 WORK-AREA-19 PICTURE 9999 VALUE 2010. NC1244.2 +006100 01 WORK-AREA-20 PICTURE 9999V9 VALUE 1010.2. NC1244.2 +006200 01 WORK-AREA-21 PICTURE V99 VALUE .01. NC1244.2 +006300 01 WORK-AREA-22 PICTURE 9 VALUE 0. NC1244.2 +006400 01 WORK-AREA-23 PICTURE 9V99 VALUE 1.01. NC1244.2 +006500 01 WORK-AREA-24 PICTURE 999V VALUE 217. NC1244.2 +006600 01 WORK-AREA-25 PICTURE 9999V99 VALUE 1010.20. NC1244.2 +006700 01 WORK-AREA-26 PICTURE V99 VALUE .01. NC1244.2 +006800 01 WORK-AREA-27 PICTURE S9PP VALUE 200. NC1244.2 +006900 01 WORK-AREA-27A PICTURE X(3) VALUE SPACE. NC1244.2 +007000 01 WORK-AREA-28 PICTURE 999 VALUE 567. NC1244.2 +007100 01 WORK-AREA-28A PICTURE S9PP VALUE ZERO. NC1244.2 +007200 01 WORK-AREA-29 PICTURE 999 VALUE 123. NC1244.2 +007300 01 WORK-AREA-29A PICTURE 9PP VALUE ZERO. NC1244.2 +007400 01 WORK-AREA-29B PICTURE X(3) VALUE SPACE. NC1244.2 +007500 01 WORK-AREA-30 PICTURE 999PP VALUE 00900. NC1244.2 +007600 01 WORK-AREA-30A PICTURE ZZZPP VALUE ZERO. NC1244.2 +007700 01 WORK-AREA-31 PICTURE 999PP VALUE 01200. NC1244.2 +007800 01 WORK-AREA-31A PICTURE ZZZPP VALUE ZERO. NC1244.2 +007900 01 WORK-AREA-31B PICTURE X(5) VALUE SPACE. NC1244.2 +008000 01 WORK-AREA-32 PICTURE PP9 VALUE .001. NC1244.2 +008100 01 WORK-AREA-32A PICTURE V999 VALUE ZERO. NC1244.2 +008200 01 WORK-AREA-33 PICTURE V999 VALUE .567. NC1244.2 +008300 01 WORK-AREA-33A PICTURE PP9 VALUE ZERO. NC1244.2 +008400 01 WORK-AREA-34 PICTURE V999 VALUE .123. NC1244.2 +008500 01 WORK-AREA-34A PICTURE PP9 VALUE ZERO. NC1244.2 +008600 01 WORK-AREA-34B PICTURE V999 VALUE ZERO. NC1244.2 +008700 01 EDIT-AREA-1 PICTURE +9999. NC1244.2 +008800 01 EDIT-AREA-2 PICTURE -9999. NC1244.2 +008900 01 EDIT-AREA-3 PICTURE ++++9. NC1244.2 +009000 01 EDIT-AREA-4 PICTURE ----9. NC1244.2 +009100 01 EDIT-AREA-5 PICTURE +++++. NC1244.2 +009200 01 EDIT-AREA-6 PICTURE -----. NC1244.2 +009300 01 EDIT-AREA-7 PICTURE +++++.++. NC1244.2 +009400 01 EDIT-AREA-8 PICTURE --,---.--. NC1244.2 +009500 01 EDIT-AREA-9 PICTURE $$99. NC1244.2 +009600 01 EDIT-AREA-10 PICTURE $$$$9. NC1244.2 +009700 01 EDIT-AREA-11 PICTURE $$$$$.99. NC1244.2 +009800 01 EDIT-AREA-12 PICTURE $$,$$$.$$. NC1244.2 +009900 01 EDIT-AREA-13 PICTURE *999. NC1244.2 +010000 01 EDIT-AREA-14 PICTURE **99. NC1244.2 +010100 01 EDIT-AREA-15 PICTURE ***9. NC1244.2 +010200 01 EDIT-AREA-16 PICTURE **.**. NC1244.2 +010300 01 EDIT-AREA-17 PICTURE *,***.**. NC1244.2 +010400 01 EDIT-AREA-18 PICTURE 9999. NC1244.2 +010500 01 EDIT-AREA-19 PICTURE Z999. NC1244.2 +010600 01 EDIT-AREA-20 PICTURE ZZ99. NC1244.2 +010700 01 EDIT-AREA-21 PICTURE ZZZ9. NC1244.2 +010800 01 EDIT-AREA-22 PICTURE ZZZZ. NC1244.2 +010900 01 EDIT-AREA-23 PICTURE ZZ.ZZ. NC1244.2 +011000 01 EDIT-AREA-24 PICTURE Z,ZZZ. NC1244.2 +011100 01 TEST-RESULTS. NC1244.2 +011200 02 FILLER PIC X VALUE SPACE. NC1244.2 +011300 02 FEATURE PIC X(20) VALUE SPACE. NC1244.2 +011400 02 FILLER PIC X VALUE SPACE. NC1244.2 +011500 02 P-OR-F PIC X(5) VALUE SPACE. NC1244.2 +011600 02 FILLER PIC X VALUE SPACE. NC1244.2 +011700 02 PAR-NAME. NC1244.2 +011800 03 FILLER PIC X(19) VALUE SPACE. NC1244.2 +011900 03 PARDOT-X PIC X VALUE SPACE. NC1244.2 +012000 03 DOTVALUE PIC 99 VALUE ZERO. NC1244.2 +012100 02 FILLER PIC X(8) VALUE SPACE. NC1244.2 +012200 02 RE-MARK PIC X(61). NC1244.2 +012300 01 TEST-COMPUTED. NC1244.2 +012400 02 FILLER PIC X(30) VALUE SPACE. NC1244.2 +012500 02 FILLER PIC X(17) VALUE NC1244.2 +012600 " COMPUTED=". NC1244.2 +012700 02 COMPUTED-X. NC1244.2 +012800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1244.2 +012900 03 COMPUTED-N REDEFINES COMPUTED-A NC1244.2 +013000 PIC -9(9).9(9). NC1244.2 +013100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1244.2 +013200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1244.2 +013300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1244.2 +013400 03 CM-18V0 REDEFINES COMPUTED-A. NC1244.2 +013500 04 COMPUTED-18V0 PIC -9(18). NC1244.2 +013600 04 FILLER PIC X. NC1244.2 +013700 03 FILLER PIC X(50) VALUE SPACE. NC1244.2 +013800 01 TEST-CORRECT. NC1244.2 +013900 02 FILLER PIC X(30) VALUE SPACE. NC1244.2 +014000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1244.2 +014100 02 CORRECT-X. NC1244.2 +014200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1244.2 +014300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1244.2 +014400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1244.2 +014500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1244.2 +014600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1244.2 +014700 03 CR-18V0 REDEFINES CORRECT-A. NC1244.2 +014800 04 CORRECT-18V0 PIC -9(18). NC1244.2 +014900 04 FILLER PIC X. NC1244.2 +015000 03 FILLER PIC X(2) VALUE SPACE. NC1244.2 +015100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1244.2 +015200 01 CCVS-C-1. NC1244.2 +015300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1244.2 +015400- "SS PARAGRAPH-NAME NC1244.2 +015500- " REMARKS". NC1244.2 +015600 02 FILLER PIC X(20) VALUE SPACE. NC1244.2 +015700 01 CCVS-C-2. NC1244.2 +015800 02 FILLER PIC X VALUE SPACE. NC1244.2 +015900 02 FILLER PIC X(6) VALUE "TESTED". NC1244.2 +016000 02 FILLER PIC X(15) VALUE SPACE. NC1244.2 +016100 02 FILLER PIC X(4) VALUE "FAIL". NC1244.2 +016200 02 FILLER PIC X(94) VALUE SPACE. NC1244.2 +016300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1244.2 +016400 01 REC-CT PIC 99 VALUE ZERO. NC1244.2 +016500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1244.2 +016600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1244.2 +016700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1244.2 +016800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1244.2 +016900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1244.2 +017000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1244.2 +017100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1244.2 +017200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1244.2 +017300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1244.2 +017400 01 CCVS-H-1. NC1244.2 +017500 02 FILLER PIC X(39) VALUE SPACES. NC1244.2 +017600 02 FILLER PIC X(42) VALUE NC1244.2 +017700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1244.2 +017800 02 FILLER PIC X(39) VALUE SPACES. NC1244.2 +017900 01 CCVS-H-2A. NC1244.2 +018000 02 FILLER PIC X(40) VALUE SPACE. NC1244.2 +018100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1244.2 +018200 02 FILLER PIC XXXX VALUE NC1244.2 +018300 "4.2 ". NC1244.2 +018400 02 FILLER PIC X(28) VALUE NC1244.2 +018500 " COPY - NOT FOR DISTRIBUTION". NC1244.2 +018600 02 FILLER PIC X(41) VALUE SPACE. NC1244.2 +018700 NC1244.2 +018800 01 CCVS-H-2B. NC1244.2 +018900 02 FILLER PIC X(15) VALUE NC1244.2 +019000 "TEST RESULT OF ". NC1244.2 +019100 02 TEST-ID PIC X(9). NC1244.2 +019200 02 FILLER PIC X(4) VALUE NC1244.2 +019300 " IN ". NC1244.2 +019400 02 FILLER PIC X(12) VALUE NC1244.2 +019500 " HIGH ". NC1244.2 +019600 02 FILLER PIC X(22) VALUE NC1244.2 +019700 " LEVEL VALIDATION FOR ". NC1244.2 +019800 02 FILLER PIC X(58) VALUE NC1244.2 +019900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1244.2 +020000 01 CCVS-H-3. NC1244.2 +020100 02 FILLER PIC X(34) VALUE NC1244.2 +020200 " FOR OFFICIAL USE ONLY ". NC1244.2 +020300 02 FILLER PIC X(58) VALUE NC1244.2 +020400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1244.2 +020500 02 FILLER PIC X(28) VALUE NC1244.2 +020600 " COPYRIGHT 1985 ". NC1244.2 +020700 01 CCVS-E-1. NC1244.2 +020800 02 FILLER PIC X(52) VALUE SPACE. NC1244.2 +020900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1244.2 +021000 02 ID-AGAIN PIC X(9). NC1244.2 +021100 02 FILLER PIC X(45) VALUE SPACES. NC1244.2 +021200 01 CCVS-E-2. NC1244.2 +021300 02 FILLER PIC X(31) VALUE SPACE. NC1244.2 +021400 02 FILLER PIC X(21) VALUE SPACE. NC1244.2 +021500 02 CCVS-E-2-2. NC1244.2 +021600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1244.2 +021700 03 FILLER PIC X VALUE SPACE. NC1244.2 +021800 03 ENDER-DESC PIC X(44) VALUE NC1244.2 +021900 "ERRORS ENCOUNTERED". NC1244.2 +022000 01 CCVS-E-3. NC1244.2 +022100 02 FILLER PIC X(22) VALUE NC1244.2 +022200 " FOR OFFICIAL USE ONLY". NC1244.2 +022300 02 FILLER PIC X(12) VALUE SPACE. NC1244.2 +022400 02 FILLER PIC X(58) VALUE NC1244.2 +022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1244.2 +022600 02 FILLER PIC X(13) VALUE SPACE. NC1244.2 +022700 02 FILLER PIC X(15) VALUE NC1244.2 +022800 " COPYRIGHT 1985". NC1244.2 +022900 01 CCVS-E-4. NC1244.2 +023000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1244.2 +023100 02 FILLER PIC X(4) VALUE " OF ". NC1244.2 +023200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1244.2 +023300 02 FILLER PIC X(40) VALUE NC1244.2 +023400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1244.2 +023500 01 XXINFO. NC1244.2 +023600 02 FILLER PIC X(19) VALUE NC1244.2 +023700 "*** INFORMATION ***". NC1244.2 +023800 02 INFO-TEXT. NC1244.2 +023900 04 FILLER PIC X(8) VALUE SPACE. NC1244.2 +024000 04 XXCOMPUTED PIC X(20). NC1244.2 +024100 04 FILLER PIC X(5) VALUE SPACE. NC1244.2 +024200 04 XXCORRECT PIC X(20). NC1244.2 +024300 02 INF-ANSI-REFERENCE PIC X(48). NC1244.2 +024400 01 HYPHEN-LINE. NC1244.2 +024500 02 FILLER PIC IS X VALUE IS SPACE. NC1244.2 +024600 02 FILLER PIC IS X(65) VALUE IS "************************NC1244.2 +024700- "*****************************************". NC1244.2 +024800 02 FILLER PIC IS X(54) VALUE IS "************************NC1244.2 +024900- "******************************". NC1244.2 +025000 01 CCVS-PGM-ID PIC X(9) VALUE NC1244.2 +025100 "NC124A". NC1244.2 +025200 PROCEDURE DIVISION. NC1244.2 +025300 CCVS1 SECTION. NC1244.2 +025400 OPEN-FILES. NC1244.2 +025500 OPEN OUTPUT PRINT-FILE. NC1244.2 +025600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1244.2 +025700 MOVE SPACE TO TEST-RESULTS. NC1244.2 +025800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1244.2 +025900 GO TO CCVS1-EXIT. NC1244.2 +026000 CLOSE-FILES. NC1244.2 +026100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1244.2 +026200 TERMINATE-CCVS. NC1244.2 +026300*S EXIT PROGRAM. NC1244.2 +026400*SERMINATE-CALL. NC1244.2 +026500 STOP RUN. NC1244.2 +026600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1244.2 +026700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1244.2 +026800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1244.2 +026900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1244.2 +027000 MOVE "****TEST DELETED****" TO RE-MARK. NC1244.2 +027100 PRINT-DETAIL. NC1244.2 +027200 IF REC-CT NOT EQUAL TO ZERO NC1244.2 +027300 MOVE "." TO PARDOT-X NC1244.2 +027400 MOVE REC-CT TO DOTVALUE. NC1244.2 +027500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1244.2 +027600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1244.2 +027700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1244.2 +027800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1244.2 +027900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1244.2 +028000 MOVE SPACE TO CORRECT-X. NC1244.2 +028100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1244.2 +028200 MOVE SPACE TO RE-MARK. NC1244.2 +028300 HEAD-ROUTINE. NC1244.2 +028400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +028500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +028600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1244.2 +028700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1244.2 +028800 COLUMN-NAMES-ROUTINE. NC1244.2 +028900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +029000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +029100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +029200 END-ROUTINE. NC1244.2 +029300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1244.2 +029400 END-RTN-EXIT. NC1244.2 +029500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +029600 END-ROUTINE-1. NC1244.2 +029700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1244.2 +029800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1244.2 +029900 ADD PASS-COUNTER TO ERROR-HOLD. NC1244.2 +030000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1244.2 +030100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1244.2 +030200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1244.2 +030300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1244.2 +030400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1244.2 +030500 END-ROUTINE-12. NC1244.2 +030600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1244.2 +030700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1244.2 +030800 MOVE "NO " TO ERROR-TOTAL NC1244.2 +030900 ELSE NC1244.2 +031000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1244.2 +031100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1244.2 +031200 PERFORM WRITE-LINE. NC1244.2 +031300 END-ROUTINE-13. NC1244.2 +031400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1244.2 +031500 MOVE "NO " TO ERROR-TOTAL ELSE NC1244.2 +031600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1244.2 +031700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1244.2 +031800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +031900 IF INSPECT-COUNTER EQUAL TO ZERO NC1244.2 +032000 MOVE "NO " TO ERROR-TOTAL NC1244.2 +032100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1244.2 +032200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1244.2 +032300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +032400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1244.2 +032500 WRITE-LINE. NC1244.2 +032600 ADD 1 TO RECORD-COUNT. NC1244.2 +032700 IF RECORD-COUNT GREATER 42 NC1244.2 +032800 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1244.2 +032900 MOVE SPACE TO DUMMY-RECORD NC1244.2 +033000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1244.2 +033100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1244.2 +033200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1244.2 +033300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1244.2 +033400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1244.2 +033500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1244.2 +033600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1244.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1244.2 +033800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1244.2 +033900 MOVE ZERO TO RECORD-COUNT. NC1244.2 +034000 PERFORM WRT-LN. NC1244.2 +034100 WRT-LN. NC1244.2 +034200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1244.2 +034300 MOVE SPACE TO DUMMY-RECORD. NC1244.2 +034400 BLANK-LINE-PRINT. NC1244.2 +034500 PERFORM WRT-LN. NC1244.2 +034600 FAIL-ROUTINE. NC1244.2 +034700 IF COMPUTED-X NOT EQUAL TO SPACE NC1244.2 +034800 GO TO FAIL-ROUTINE-WRITE. NC1244.2 +034900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1244.2 +035000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1244.2 +035100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1244.2 +035200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +035300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1244.2 +035400 GO TO FAIL-ROUTINE-EX. NC1244.2 +035500 FAIL-ROUTINE-WRITE. NC1244.2 +035600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1244.2 +035700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1244.2 +035800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1244.2 +035900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1244.2 +036000 FAIL-ROUTINE-EX. EXIT. NC1244.2 +036100 BAIL-OUT. NC1244.2 +036200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1244.2 +036300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1244.2 +036400 BAIL-OUT-WRITE. NC1244.2 +036500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1244.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1244.2 +036700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1244.2 +036800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1244.2 +036900 BAIL-OUT-EX. EXIT. NC1244.2 +037000 CCVS1-EXIT. NC1244.2 +037100 EXIT. NC1244.2 +037200 PICTURE-INIT-1. NC1244.2 +037300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +037400 MOVE "PICTRE-TST-1" TO PAR-NAME. NC1244.2 +037500 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +037600 MOVE 0 TO WORK-AREA-1. NC1244.2 +037700 MOVE 1 TO REC-CT. NC1244.2 +037800 PICTURE-TEST-1. NC1244.2 +037900 MOVE WORK-AREA-1 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +038000 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +038100 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +038200 GO TO PICTURE-TEST-1-A. NC1244.2 +038300 PICTURE-DELETE-1. NC1244.2 +038400 PERFORM DE-LETE. NC1244.2 +038500 PERFORM PRINT-DETAIL. NC1244.2 +038600 GO TO PICTURE-INIT-2. NC1244.2 +038700 PICTURE-TEST-1-A. NC1244.2 +038800 IF EDIT-AREA-1 EQUAL TO "+0000" NC1244.2 +038900 PERFORM PASS NC1244.2 +039000 PERFORM PRINT-DETAIL NC1244.2 +039100 ELSE PERFORM FAIL NC1244.2 +039200 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +039300 MOVE "+0000" TO CORRECT-A NC1244.2 +039400 PERFORM PRINT-DETAIL. NC1244.2 +039500 ADD 1 TO REC-CT. NC1244.2 +039600 PICTURE-TEST-1-B. NC1244.2 +039700 IF EDIT-AREA-2 EQUAL TO " 0000" NC1244.2 +039800 PERFORM PASS NC1244.2 +039900 PERFORM PRINT-DETAIL NC1244.2 +040000 ELSE PERFORM FAIL NC1244.2 +040100 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +040200 MOVE " 0000" TO CORRECT-A NC1244.2 +040300 PERFORM PRINT-DETAIL. NC1244.2 +040400 ADD 1 TO REC-CT. NC1244.2 +040500 PICTURE-TEST-1-C. NC1244.2 +040600 IF EDIT-AREA-3 EQUAL TO " +0" NC1244.2 +040700 PERFORM PASS NC1244.2 +040800 PERFORM PRINT-DETAIL NC1244.2 +040900 ELSE PERFORM FAIL NC1244.2 +041000 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +041100 MOVE " +0" TO CORRECT-A NC1244.2 +041200 PERFORM PRINT-DETAIL. NC1244.2 +041300 ADD 1 TO REC-CT. NC1244.2 +041400 PICTURE-TEST-1-D. NC1244.2 +041500 IF EDIT-AREA-4 EQUAL TO " 0" NC1244.2 +041600 PERFORM PASS NC1244.2 +041700 PERFORM PRINT-DETAIL NC1244.2 +041800 ELSE PERFORM FAIL NC1244.2 +041900 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +042000 MOVE " 0" TO CORRECT-A NC1244.2 +042100 PERFORM PRINT-DETAIL. NC1244.2 +042200 ADD 1 TO REC-CT. NC1244.2 +042300 PICTURE-TEST-1-E. NC1244.2 +042400 IF EDIT-AREA-5 EQUAL TO " " NC1244.2 +042500 PERFORM PASS NC1244.2 +042600 PERFORM PRINT-DETAIL NC1244.2 +042700 ELSE PERFORM FAIL NC1244.2 +042800 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +042900 MOVE "SPACES" TO CORRECT-A NC1244.2 +043000 PERFORM PRINT-DETAIL. NC1244.2 +043100 ADD 1 TO REC-CT. NC1244.2 +043200 PICTURE-TEST-1-F. NC1244.2 +043300 IF EDIT-AREA-6 EQUAL TO " " NC1244.2 +043400 PERFORM PASS NC1244.2 +043500 PERFORM PRINT-DETAIL NC1244.2 +043600 ELSE PERFORM FAIL NC1244.2 +043700 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +043800 MOVE "SPACES" TO CORRECT-A NC1244.2 +043900 PERFORM PRINT-DETAIL. NC1244.2 +044000 ADD 1 TO REC-CT. NC1244.2 +044100 PICTURE-TEST-1-G. NC1244.2 +044200 IF EDIT-AREA-7 EQUAL TO " " NC1244.2 +044300 PERFORM PASS NC1244.2 +044400 PERFORM PRINT-DETAIL NC1244.2 +044500 ELSE PERFORM FAIL NC1244.2 +044600 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +044700 MOVE "SPACES" TO CORRECT-A NC1244.2 +044800 PERFORM PRINT-DETAIL. NC1244.2 +044900 ADD 1 TO REC-CT. NC1244.2 +045000 PICTURE-TEST-1-H. NC1244.2 +045100 IF EDIT-AREA-8 EQUAL TO " " NC1244.2 +045200 PERFORM PASS NC1244.2 +045300 PERFORM PRINT-DETAIL NC1244.2 +045400 ELSE PERFORM FAIL NC1244.2 +045500 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +045600 MOVE "SPACES" TO CORRECT-A NC1244.2 +045700 PERFORM PRINT-DETAIL. NC1244.2 +045800 PICTURE-INIT-2. NC1244.2 +045900 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +046000 MOVE "PICTRE-TST-2" TO PAR-NAME. NC1244.2 +046100 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +046200 MOVE 12 TO WORK-AREA-2. NC1244.2 +046300 MOVE 1 TO REC-CT. NC1244.2 +046400 PICTURE-TEST-2. NC1244.2 +046500 MOVE WORK-AREA-2 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +046600 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +046700 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +046800 GO TO PICTURE-TEST-2-A. NC1244.2 +046900 PICTURE-DELETE-2. NC1244.2 +047000 PERFORM DE-LETE. NC1244.2 +047100 PERFORM PRINT-DETAIL. NC1244.2 +047200 GO TO PICTURE-INIT-3. NC1244.2 +047300 PICTURE-TEST-2-A. NC1244.2 +047400 IF EDIT-AREA-1 EQUAL TO "+0012" NC1244.2 +047500 PERFORM PASS NC1244.2 +047600 PERFORM PRINT-DETAIL NC1244.2 +047700 ELSE PERFORM FAIL NC1244.2 +047800 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +047900 MOVE "+0012" TO CORRECT-A NC1244.2 +048000 PERFORM PRINT-DETAIL. NC1244.2 +048100 ADD 1 TO REC-CT. NC1244.2 +048200 PICTURE-TEST-2-B. NC1244.2 +048300 IF EDIT-AREA-2 EQUAL TO " 0012" NC1244.2 +048400 PERFORM PASS NC1244.2 +048500 PERFORM PRINT-DETAIL NC1244.2 +048600 ELSE PERFORM FAIL NC1244.2 +048700 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +048800 MOVE " 0012" TO CORRECT-A NC1244.2 +048900 PERFORM PRINT-DETAIL. NC1244.2 +049000 ADD 1 TO REC-CT. NC1244.2 +049100 PICTURE-TEST-2-C. NC1244.2 +049200 IF EDIT-AREA-3 EQUAL TO " +12" NC1244.2 +049300 PERFORM PASS NC1244.2 +049400 PERFORM PRINT-DETAIL NC1244.2 +049500 ELSE PERFORM FAIL NC1244.2 +049600 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +049700 MOVE " +12" TO CORRECT-A NC1244.2 +049800 PERFORM PRINT-DETAIL. NC1244.2 +049900 ADD 1 TO REC-CT. NC1244.2 +050000 PICTURE-TEST-2-D. NC1244.2 +050100 IF EDIT-AREA-4 EQUAL TO " 12" NC1244.2 +050200 PERFORM PASS NC1244.2 +050300 PERFORM PRINT-DETAIL NC1244.2 +050400 ELSE PERFORM FAIL NC1244.2 +050500 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +050600 MOVE " 12" TO CORRECT-A NC1244.2 +050700 PERFORM PRINT-DETAIL. NC1244.2 +050800 ADD 1 TO REC-CT. NC1244.2 +050900 PICTURE-TEST-2-E. NC1244.2 +051000 IF EDIT-AREA-5 EQUAL TO " +12" NC1244.2 +051100 PERFORM PASS NC1244.2 +051200 PERFORM PRINT-DETAIL NC1244.2 +051300 ELSE PERFORM FAIL NC1244.2 +051400 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +051500 MOVE " +12" TO CORRECT-A NC1244.2 +051600 PERFORM PRINT-DETAIL. NC1244.2 +051700 ADD 1 TO REC-CT. NC1244.2 +051800 PICTURE-TEST-2-F. NC1244.2 +051900 IF EDIT-AREA-6 EQUAL TO " 12" NC1244.2 +052000 PERFORM PASS NC1244.2 +052100 PERFORM PRINT-DETAIL NC1244.2 +052200 ELSE PERFORM FAIL NC1244.2 +052300 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +052400 MOVE " 12" TO CORRECT-A NC1244.2 +052500 PERFORM PRINT-DETAIL. NC1244.2 +052600 ADD 1 TO REC-CT. NC1244.2 +052700 PICTURE-TEST-2-G. NC1244.2 +052800 IF EDIT-AREA-7 EQUAL TO " +12.00" NC1244.2 +052900 PERFORM PASS NC1244.2 +053000 PERFORM PRINT-DETAIL NC1244.2 +053100 ELSE PERFORM FAIL NC1244.2 +053200 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +053300 MOVE " +12.00" TO CORRECT-A NC1244.2 +053400 PERFORM PRINT-DETAIL. NC1244.2 +053500 ADD 1 TO REC-CT. NC1244.2 +053600 PICTURE-TEST-2-H. NC1244.2 +053700 IF EDIT-AREA-8 EQUAL TO " 12.00" NC1244.2 +053800 PERFORM PASS NC1244.2 +053900 PERFORM PRINT-DETAIL NC1244.2 +054000 ELSE PERFORM FAIL NC1244.2 +054100 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +054200 MOVE " 12.00" TO CORRECT-A NC1244.2 +054300 PERFORM PRINT-DETAIL. NC1244.2 +054400 PICTURE-INIT-3. NC1244.2 +054500 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +054600 MOVE "PICTRE-TST-3" TO PAR-NAME. NC1244.2 +054700 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +054800 MOVE -12 TO WORK-AREA-3. NC1244.2 +054900 MOVE 1 TO REC-CT. NC1244.2 +055000 PICTURE-TEST-3. NC1244.2 +055100 MOVE WORK-AREA-3 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +055200 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +055300 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +055400 GO TO PICTURE-TEST-3-A. NC1244.2 +055500 PICTURE-DELETE-3. NC1244.2 +055600 PERFORM DE-LETE. NC1244.2 +055700 PERFORM PRINT-DETAIL. NC1244.2 +055800 GO TO PICTURE-INIT-4. NC1244.2 +055900 PICTURE-TEST-3-A. NC1244.2 +056000 IF EDIT-AREA-1 EQUAL TO "-0012" NC1244.2 +056100 PERFORM PASS NC1244.2 +056200 PERFORM PRINT-DETAIL NC1244.2 +056300 ELSE PERFORM FAIL NC1244.2 +056400 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +056500 MOVE "-0012" TO CORRECT-A NC1244.2 +056600 PERFORM PRINT-DETAIL. NC1244.2 +056700 ADD 1 TO REC-CT. NC1244.2 +056800 PICTURE-TEST-3-B. NC1244.2 +056900 IF EDIT-AREA-2 EQUAL TO "-0012" NC1244.2 +057000 PERFORM PASS NC1244.2 +057100 PERFORM PRINT-DETAIL NC1244.2 +057200 ELSE PERFORM FAIL NC1244.2 +057300 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +057400 MOVE "-0012" TO CORRECT-A NC1244.2 +057500 PERFORM PRINT-DETAIL. NC1244.2 +057600 ADD 1 TO REC-CT. NC1244.2 +057700 PICTURE-TEST-3-C. NC1244.2 +057800 IF EDIT-AREA-3 EQUAL TO " -12" NC1244.2 +057900 PERFORM PASS NC1244.2 +058000 PERFORM PRINT-DETAIL NC1244.2 +058100 ELSE PERFORM FAIL NC1244.2 +058200 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +058300 MOVE " -12" TO CORRECT-A NC1244.2 +058400 PERFORM PRINT-DETAIL. NC1244.2 +058500 ADD 1 TO REC-CT. NC1244.2 +058600 PICTURE-TEST-3-D. NC1244.2 +058700 IF EDIT-AREA-4 EQUAL TO " -12" NC1244.2 +058800 PERFORM PASS NC1244.2 +058900 PERFORM PRINT-DETAIL NC1244.2 +059000 ELSE PERFORM FAIL NC1244.2 +059100 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +059200 MOVE " -12" TO CORRECT-A NC1244.2 +059300 PERFORM PRINT-DETAIL. NC1244.2 +059400 ADD 1 TO REC-CT. NC1244.2 +059500 PICTURE-TEST-3-E. NC1244.2 +059600 IF EDIT-AREA-5 EQUAL TO " -12" NC1244.2 +059700 PERFORM PASS NC1244.2 +059800 PERFORM PRINT-DETAIL NC1244.2 +059900 ELSE PERFORM FAIL NC1244.2 +060000 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +060100 MOVE " -12" TO CORRECT-A NC1244.2 +060200 PERFORM PRINT-DETAIL. NC1244.2 +060300 ADD 1 TO REC-CT. NC1244.2 +060400 PICTURE-TEST-3-F. NC1244.2 +060500 IF EDIT-AREA-6 EQUAL TO " -12" NC1244.2 +060600 PERFORM PASS NC1244.2 +060700 PERFORM PRINT-DETAIL NC1244.2 +060800 ELSE PERFORM FAIL NC1244.2 +060900 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +061000 MOVE " -12" TO CORRECT-A NC1244.2 +061100 PERFORM PRINT-DETAIL. NC1244.2 +061200 ADD 1 TO REC-CT. NC1244.2 +061300 PICTURE-TEST-3-G. NC1244.2 +061400 IF EDIT-AREA-7 EQUAL TO " -12.00" NC1244.2 +061500 PERFORM PASS NC1244.2 +061600 PERFORM PRINT-DETAIL NC1244.2 +061700 ELSE PERFORM FAIL NC1244.2 +061800 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +061900 MOVE " -12.00" TO CORRECT-A NC1244.2 +062000 PERFORM PRINT-DETAIL. NC1244.2 +062100 ADD 1 TO REC-CT. NC1244.2 +062200 PICTURE-TEST-3-H. NC1244.2 +062300 IF EDIT-AREA-8 EQUAL TO " -12.00" NC1244.2 +062400 PERFORM PASS NC1244.2 +062500 PERFORM PRINT-DETAIL NC1244.2 +062600 ELSE PERFORM FAIL NC1244.2 +062700 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +062800 MOVE " -12.00" TO CORRECT-A NC1244.2 +062900 PERFORM PRINT-DETAIL. NC1244.2 +063000 PICTURE-INIT-4. NC1244.2 +063100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +063200 MOVE "PICTRE-TST-4" TO PAR-NAME. NC1244.2 +063300 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +063400 MOVE 123 TO WORK-AREA-4. NC1244.2 +063500 MOVE 1 TO REC-CT. NC1244.2 +063600 PICTURE-TEST-4. NC1244.2 +063700 MOVE WORK-AREA-4 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +063800 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +063900 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +064000 GO TO PICTURE-TEST-4-A. NC1244.2 +064100 PICTURE-DELETE-4. NC1244.2 +064200 PERFORM DE-LETE. NC1244.2 +064300 PERFORM PRINT-DETAIL. NC1244.2 +064400 GO TO PICTURE-INIT-5. NC1244.2 +064500 PICTURE-TEST-4-A. NC1244.2 +064600 IF EDIT-AREA-1 EQUAL TO "+0123" NC1244.2 +064700 PERFORM PASS NC1244.2 +064800 PERFORM PRINT-DETAIL NC1244.2 +064900 ELSE PERFORM FAIL NC1244.2 +065000 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +065100 MOVE "+0123" TO CORRECT-A NC1244.2 +065200 PERFORM PRINT-DETAIL. NC1244.2 +065300 ADD 1 TO REC-CT. NC1244.2 +065400 PICTURE-TEST-4-B. NC1244.2 +065500 IF EDIT-AREA-2 EQUAL TO " 0123" NC1244.2 +065600 PERFORM PASS NC1244.2 +065700 PERFORM PRINT-DETAIL NC1244.2 +065800 ELSE PERFORM FAIL NC1244.2 +065900 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +066000 MOVE " 0123" TO CORRECT-A NC1244.2 +066100 PERFORM PRINT-DETAIL. NC1244.2 +066200 ADD 1 TO REC-CT. NC1244.2 +066300 PICTURE-TEST-4-C. NC1244.2 +066400 IF EDIT-AREA-3 EQUAL TO " +123" NC1244.2 +066500 PERFORM PASS NC1244.2 +066600 PERFORM PRINT-DETAIL NC1244.2 +066700 ELSE PERFORM FAIL NC1244.2 +066800 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +066900 MOVE " +123" TO CORRECT-A NC1244.2 +067000 PERFORM PRINT-DETAIL. NC1244.2 +067100 ADD 1 TO REC-CT. NC1244.2 +067200 PICTURE-TEST-4-D. NC1244.2 +067300 IF EDIT-AREA-4 EQUAL TO " 123" NC1244.2 +067400 PERFORM PASS NC1244.2 +067500 PERFORM PRINT-DETAIL NC1244.2 +067600 ELSE PERFORM FAIL NC1244.2 +067700 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +067800 MOVE " 123" TO CORRECT-A NC1244.2 +067900 PERFORM PRINT-DETAIL. NC1244.2 +068000 ADD 1 TO REC-CT. NC1244.2 +068100 PICTURE-TEST-4-E. NC1244.2 +068200 IF EDIT-AREA-5 EQUAL TO " +123" NC1244.2 +068300 PERFORM PASS NC1244.2 +068400 PERFORM PRINT-DETAIL NC1244.2 +068500 ELSE PERFORM FAIL NC1244.2 +068600 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +068700 MOVE " +123" TO CORRECT-A NC1244.2 +068800 PERFORM PRINT-DETAIL. NC1244.2 +068900 ADD 1 TO REC-CT. NC1244.2 +069000 PICTURE-TEST-4-F. NC1244.2 +069100 IF EDIT-AREA-6 EQUAL TO " 123" NC1244.2 +069200 PERFORM PASS NC1244.2 +069300 PERFORM PRINT-DETAIL NC1244.2 +069400 ELSE PERFORM FAIL NC1244.2 +069500 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +069600 MOVE " 123" TO CORRECT-A NC1244.2 +069700 PERFORM PRINT-DETAIL. NC1244.2 +069800 ADD 1 TO REC-CT. NC1244.2 +069900 PICTURE-TEST-4-G. NC1244.2 +070000 IF EDIT-AREA-7 EQUAL TO " +123.00" NC1244.2 +070100 PERFORM PASS NC1244.2 +070200 PERFORM PRINT-DETAIL NC1244.2 +070300 ELSE PERFORM FAIL NC1244.2 +070400 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +070500 MOVE " +123.00" TO CORRECT-A NC1244.2 +070600 PERFORM PRINT-DETAIL. NC1244.2 +070700 ADD 1 TO REC-CT. NC1244.2 +070800 PICTURE-TEST-4-H. NC1244.2 +070900 IF EDIT-AREA-8 EQUAL TO " 123.00" NC1244.2 +071000 PERFORM PASS NC1244.2 +071100 PERFORM PRINT-DETAIL NC1244.2 +071200 ELSE PERFORM FAIL NC1244.2 +071300 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +071400 MOVE " 123.00" TO CORRECT-A NC1244.2 +071500 PERFORM PRINT-DETAIL. NC1244.2 +071600 PICTURE-INIT-5. NC1244.2 +071700 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +071800 MOVE "PICTRE-TST-5" TO PAR-NAME. NC1244.2 +071900 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +072000 MOVE -123 TO WORK-AREA-5. NC1244.2 +072100 MOVE 1 TO REC-CT. NC1244.2 +072200 PICTURE-TEST-5. NC1244.2 +072300 MOVE WORK-AREA-5 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +072400 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +072500 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +072600 GO TO PICTURE-TEST-5-A. NC1244.2 +072700 PICTURE-DELETE-5. NC1244.2 +072800 PERFORM DE-LETE. NC1244.2 +072900 PERFORM PRINT-DETAIL. NC1244.2 +073000 GO TO PICTURE-INIT-6. NC1244.2 +073100 PICTURE-TEST-5-A. NC1244.2 +073200 IF EDIT-AREA-1 EQUAL TO "-0123" NC1244.2 +073300 PERFORM PASS NC1244.2 +073400 PERFORM PRINT-DETAIL NC1244.2 +073500 ELSE PERFORM FAIL NC1244.2 +073600 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +073700 MOVE "-0123" TO CORRECT-A NC1244.2 +073800 PERFORM PRINT-DETAIL. NC1244.2 +073900 ADD 1 TO REC-CT. NC1244.2 +074000 PICTURE-TEST-5-B. NC1244.2 +074100 IF EDIT-AREA-2 EQUAL TO "-0123" NC1244.2 +074200 PERFORM PASS NC1244.2 +074300 PERFORM PRINT-DETAIL NC1244.2 +074400 ELSE PERFORM FAIL NC1244.2 +074500 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +074600 MOVE "-0123" TO CORRECT-A NC1244.2 +074700 PERFORM PRINT-DETAIL. NC1244.2 +074800 ADD 1 TO REC-CT. NC1244.2 +074900 PICTURE-TEST-5-C. NC1244.2 +075000 IF EDIT-AREA-3 EQUAL TO " -123" NC1244.2 +075100 PERFORM PASS NC1244.2 +075200 PERFORM PRINT-DETAIL NC1244.2 +075300 ELSE PERFORM FAIL NC1244.2 +075400 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +075500 MOVE " -123" TO CORRECT-A NC1244.2 +075600 PERFORM PRINT-DETAIL. NC1244.2 +075700 ADD 1 TO REC-CT. NC1244.2 +075800 PICTURE-TEST-5-D. NC1244.2 +075900 IF EDIT-AREA-4 EQUAL TO " -123" NC1244.2 +076000 PERFORM PASS NC1244.2 +076100 PERFORM PRINT-DETAIL NC1244.2 +076200 ELSE PERFORM FAIL NC1244.2 +076300 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +076400 MOVE " -123" TO CORRECT-A NC1244.2 +076500 PERFORM PRINT-DETAIL. NC1244.2 +076600 ADD 1 TO REC-CT. NC1244.2 +076700 PICTURE-TEST-5-E. NC1244.2 +076800 IF EDIT-AREA-5 EQUAL TO " -123" NC1244.2 +076900 PERFORM PASS NC1244.2 +077000 PERFORM PRINT-DETAIL NC1244.2 +077100 ELSE PERFORM FAIL NC1244.2 +077200 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +077300 MOVE " -123" TO CORRECT-A NC1244.2 +077400 PERFORM PRINT-DETAIL. NC1244.2 +077500 ADD 1 TO REC-CT. NC1244.2 +077600 PICTURE-TEST-5-F. NC1244.2 +077700 IF EDIT-AREA-6 EQUAL TO " -123" NC1244.2 +077800 PERFORM PASS NC1244.2 +077900 PERFORM PRINT-DETAIL NC1244.2 +078000 ELSE PERFORM FAIL NC1244.2 +078100 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +078200 MOVE " -123" TO CORRECT-A NC1244.2 +078300 PERFORM PRINT-DETAIL. NC1244.2 +078400 ADD 1 TO REC-CT. NC1244.2 +078500 PICTURE-TEST-5-G. NC1244.2 +078600 IF EDIT-AREA-7 EQUAL TO " -123.00" NC1244.2 +078700 PERFORM PASS NC1244.2 +078800 PERFORM PRINT-DETAIL NC1244.2 +078900 ELSE PERFORM FAIL NC1244.2 +079000 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +079100 MOVE " -123.00" TO CORRECT-A NC1244.2 +079200 PERFORM PRINT-DETAIL. NC1244.2 +079300 ADD 1 TO REC-CT. NC1244.2 +079400 PICTURE-TEST-5-H. NC1244.2 +079500 IF EDIT-AREA-8 EQUAL TO " -123.00" NC1244.2 +079600 PERFORM PASS NC1244.2 +079700 PERFORM PRINT-DETAIL NC1244.2 +079800 ELSE PERFORM FAIL NC1244.2 +079900 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +080000 MOVE " -123.00" TO CORRECT-A NC1244.2 +080100 PERFORM PRINT-DETAIL. NC1244.2 +080200 PICTURE-INIT-6. NC1244.2 +080300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +080400 MOVE "PICTRE-TST-6" TO PAR-NAME. NC1244.2 +080500 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +080600 MOVE 1234 TO WORK-AREA-6. NC1244.2 +080700 MOVE 1 TO REC-CT. NC1244.2 +080800 PICTURE-TEST-6. NC1244.2 +080900 MOVE WORK-AREA-6 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +081000 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +081100 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +081200 GO TO PICTURE-TEST-6-A. NC1244.2 +081300 PICTURE-DELETE-6. NC1244.2 +081400 PERFORM DE-LETE. NC1244.2 +081500 PERFORM PRINT-DETAIL. NC1244.2 +081600 GO TO PICTURE-INIT-7. NC1244.2 +081700 PICTURE-TEST-6-A. NC1244.2 +081800 IF EDIT-AREA-1 EQUAL TO "+1234" NC1244.2 +081900 PERFORM PASS NC1244.2 +082000 PERFORM PRINT-DETAIL NC1244.2 +082100 ELSE PERFORM FAIL NC1244.2 +082200 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +082300 MOVE "+1234" TO CORRECT-A NC1244.2 +082400 PERFORM PRINT-DETAIL. NC1244.2 +082500 ADD 1 TO REC-CT. NC1244.2 +082600 PICTURE-TEST-6-B. NC1244.2 +082700 IF EDIT-AREA-2 EQUAL TO " 1234" NC1244.2 +082800 PERFORM PASS NC1244.2 +082900 PERFORM PRINT-DETAIL NC1244.2 +083000 ELSE PERFORM FAIL NC1244.2 +083100 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +083200 MOVE " 1234" TO CORRECT-A NC1244.2 +083300 PERFORM PRINT-DETAIL. NC1244.2 +083400 ADD 1 TO REC-CT. NC1244.2 +083500 PICTURE-TEST-6-C. NC1244.2 +083600 IF EDIT-AREA-3 EQUAL TO "+1234" NC1244.2 +083700 PERFORM PASS NC1244.2 +083800 PERFORM PRINT-DETAIL NC1244.2 +083900 ELSE PERFORM FAIL NC1244.2 +084000 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +084100 MOVE "+1234" TO CORRECT-A NC1244.2 +084200 PERFORM PRINT-DETAIL. NC1244.2 +084300 ADD 1 TO REC-CT. NC1244.2 +084400 PICTURE-TEST-6-D. NC1244.2 +084500 IF EDIT-AREA-4 EQUAL TO " 1234" NC1244.2 +084600 PERFORM PASS NC1244.2 +084700 PERFORM PRINT-DETAIL NC1244.2 +084800 ELSE PERFORM FAIL NC1244.2 +084900 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +085000 MOVE " 1234" TO CORRECT-A NC1244.2 +085100 PERFORM PRINT-DETAIL. NC1244.2 +085200 ADD 1 TO REC-CT. NC1244.2 +085300 PICTURE-TEST-6-E. NC1244.2 +085400 IF EDIT-AREA-5 EQUAL TO "+1234" NC1244.2 +085500 PERFORM PASS NC1244.2 +085600 PERFORM PRINT-DETAIL NC1244.2 +085700 ELSE PERFORM FAIL NC1244.2 +085800 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +085900 MOVE "+1234" TO CORRECT-A NC1244.2 +086000 PERFORM PRINT-DETAIL. NC1244.2 +086100 ADD 1 TO REC-CT. NC1244.2 +086200 PICTURE-TEST-6-F. NC1244.2 +086300 IF EDIT-AREA-6 EQUAL TO " 1234" NC1244.2 +086400 PERFORM PASS NC1244.2 +086500 PERFORM PRINT-DETAIL NC1244.2 +086600 ELSE PERFORM FAIL NC1244.2 +086700 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +086800 MOVE " 1234" TO CORRECT-A NC1244.2 +086900 PERFORM PRINT-DETAIL. NC1244.2 +087000 ADD 1 TO REC-CT. NC1244.2 +087100 PICTURE-TEST-6-G. NC1244.2 +087200 IF EDIT-AREA-7 EQUAL TO "+1234.00" NC1244.2 +087300 PERFORM PASS NC1244.2 +087400 PERFORM PRINT-DETAIL NC1244.2 +087500 ELSE PERFORM FAIL NC1244.2 +087600 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +087700 MOVE "+1234.00" TO CORRECT-A NC1244.2 +087800 PERFORM PRINT-DETAIL. NC1244.2 +087900 ADD 1 TO REC-CT. NC1244.2 +088000 PICTURE-TEST-6-H. NC1244.2 +088100 IF EDIT-AREA-8 EQUAL TO " 1,234.00" NC1244.2 +088200 PERFORM PASS NC1244.2 +088300 PERFORM PRINT-DETAIL NC1244.2 +088400 ELSE PERFORM FAIL NC1244.2 +088500 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +088600 MOVE " 1,234.00" TO CORRECT-A NC1244.2 +088700 PERFORM PRINT-DETAIL. NC1244.2 +088800 PICTURE-INIT-7. NC1244.2 +088900 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +089000 MOVE "PICTRE-TST-7" TO PAR-NAME. NC1244.2 +089100 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +089200 MOVE -1234 TO WORK-AREA-7. NC1244.2 +089300 MOVE 1 TO REC-CT. NC1244.2 +089400 PICTURE-TEST-7. NC1244.2 +089500 MOVE WORK-AREA-7 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +089600 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +089700 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +089800 GO TO PICTURE-TEST-7-A. NC1244.2 +089900 PICTURE-DELETE-7. NC1244.2 +090000 PERFORM DE-LETE. NC1244.2 +090100 PERFORM PRINT-DETAIL. NC1244.2 +090200 GO TO PICTURE-INIT-8. NC1244.2 +090300 PICTURE-TEST-7-A. NC1244.2 +090400 IF EDIT-AREA-1 EQUAL TO "-1234" NC1244.2 +090500 PERFORM PASS NC1244.2 +090600 PERFORM PRINT-DETAIL NC1244.2 +090700 ELSE PERFORM FAIL NC1244.2 +090800 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +090900 MOVE "-1234" TO CORRECT-A NC1244.2 +091000 PERFORM PRINT-DETAIL. NC1244.2 +091100 ADD 1 TO REC-CT. NC1244.2 +091200 PICTURE-TEST-7-B. NC1244.2 +091300 IF EDIT-AREA-2 EQUAL TO "-1234" NC1244.2 +091400 PERFORM PASS NC1244.2 +091500 PERFORM PRINT-DETAIL NC1244.2 +091600 ELSE PERFORM FAIL NC1244.2 +091700 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +091800 MOVE "-1234" TO CORRECT-A NC1244.2 +091900 PERFORM PRINT-DETAIL. NC1244.2 +092000 ADD 1 TO REC-CT. NC1244.2 +092100 PICTURE-TEST-7-C. NC1244.2 +092200 IF EDIT-AREA-3 EQUAL TO "-1234" NC1244.2 +092300 PERFORM PASS NC1244.2 +092400 PERFORM PRINT-DETAIL NC1244.2 +092500 ELSE PERFORM FAIL NC1244.2 +092600 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +092700 MOVE "-1234" TO CORRECT-A NC1244.2 +092800 PERFORM PRINT-DETAIL. NC1244.2 +092900 ADD 1 TO REC-CT. NC1244.2 +093000 PICTURE-TEST-7-D. NC1244.2 +093100 IF EDIT-AREA-4 EQUAL TO "-1234" NC1244.2 +093200 PERFORM PASS NC1244.2 +093300 PERFORM PRINT-DETAIL NC1244.2 +093400 ELSE PERFORM FAIL NC1244.2 +093500 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +093600 MOVE "-1234" TO CORRECT-A NC1244.2 +093700 PERFORM PRINT-DETAIL. NC1244.2 +093800 ADD 1 TO REC-CT. NC1244.2 +093900 PICTURE-TEST-7-E. NC1244.2 +094000 IF EDIT-AREA-5 EQUAL TO "-1234" NC1244.2 +094100 PERFORM PASS NC1244.2 +094200 PERFORM PRINT-DETAIL NC1244.2 +094300 ELSE PERFORM FAIL NC1244.2 +094400 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +094500 MOVE "-1234" TO CORRECT-A NC1244.2 +094600 PERFORM PRINT-DETAIL. NC1244.2 +094700 ADD 1 TO REC-CT. NC1244.2 +094800 PICTURE-TEST-7-F. NC1244.2 +094900 IF EDIT-AREA-6 EQUAL TO "-1234" NC1244.2 +095000 PERFORM PASS NC1244.2 +095100 PERFORM PRINT-DETAIL NC1244.2 +095200 ELSE PERFORM FAIL NC1244.2 +095300 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +095400 MOVE "-1234" TO CORRECT-A NC1244.2 +095500 PERFORM PRINT-DETAIL. NC1244.2 +095600 ADD 1 TO REC-CT. NC1244.2 +095700 PICTURE-TEST-7-G. NC1244.2 +095800 IF EDIT-AREA-7 EQUAL TO "-1234.00" NC1244.2 +095900 PERFORM PASS NC1244.2 +096000 PERFORM PRINT-DETAIL NC1244.2 +096100 ELSE PERFORM FAIL NC1244.2 +096200 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +096300 MOVE "-1234.00" TO CORRECT-A NC1244.2 +096400 PERFORM PRINT-DETAIL. NC1244.2 +096500 ADD 1 TO REC-CT. NC1244.2 +096600 PICTURE-TEST-7-H. NC1244.2 +096700 IF EDIT-AREA-8 EQUAL TO "-1,234.00" NC1244.2 +096800 PERFORM PASS NC1244.2 +096900 PERFORM PRINT-DETAIL NC1244.2 +097000 ELSE PERFORM FAIL NC1244.2 +097100 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +097200 MOVE "-1,234.00" TO CORRECT-A NC1244.2 +097300 PERFORM PRINT-DETAIL. NC1244.2 +097400 PICTURE-INIT-8. NC1244.2 +097500 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +097600 MOVE "PICTRE-TST-8" TO PAR-NAME. NC1244.2 +097700 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +097800 MOVE 12.34 TO WORK-AREA-8. NC1244.2 +097900 MOVE 1 TO REC-CT. NC1244.2 +098000 PICTURE-TEST-8. NC1244.2 +098100 MOVE WORK-AREA-8 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +098200 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +098300 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +098400 GO TO PICTURE-TEST-8-A. NC1244.2 +098500 PICTURE-DELETE-8. NC1244.2 +098600 PERFORM DE-LETE. NC1244.2 +098700 PERFORM PRINT-DETAIL. NC1244.2 +098800 GO TO PICTURE-INIT-9. NC1244.2 +098900 PICTURE-TEST-8-A. NC1244.2 +099000 IF EDIT-AREA-1 EQUAL TO "+0012" NC1244.2 +099100 PERFORM PASS NC1244.2 +099200 PERFORM PRINT-DETAIL NC1244.2 +099300 ELSE PERFORM FAIL NC1244.2 +099400 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +099500 MOVE "+0012" TO CORRECT-A NC1244.2 +099600 PERFORM PRINT-DETAIL. NC1244.2 +099700 ADD 1 TO REC-CT. NC1244.2 +099800 PICTURE-TEST-8-B. NC1244.2 +099900 IF EDIT-AREA-2 EQUAL TO " 0012" NC1244.2 +100000 PERFORM PASS NC1244.2 +100100 PERFORM PRINT-DETAIL NC1244.2 +100200 ELSE PERFORM FAIL NC1244.2 +100300 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +100400 MOVE " 0012" TO CORRECT-A NC1244.2 +100500 PERFORM PRINT-DETAIL. NC1244.2 +100600 ADD 1 TO REC-CT. NC1244.2 +100700 PICTURE-TEST-8-C. NC1244.2 +100800 IF EDIT-AREA-3 EQUAL TO " +12" NC1244.2 +100900 PERFORM PASS NC1244.2 +101000 PERFORM PRINT-DETAIL NC1244.2 +101100 ELSE PERFORM FAIL NC1244.2 +101200 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +101300 MOVE " +12" TO CORRECT-A NC1244.2 +101400 PERFORM PRINT-DETAIL. NC1244.2 +101500 ADD 1 TO REC-CT. NC1244.2 +101600 PICTURE-TEST-8-D. NC1244.2 +101700 IF EDIT-AREA-4 EQUAL TO " 12" NC1244.2 +101800 PERFORM PASS NC1244.2 +101900 PERFORM PRINT-DETAIL NC1244.2 +102000 ELSE PERFORM FAIL NC1244.2 +102100 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +102200 MOVE " 12" TO CORRECT-A NC1244.2 +102300 PERFORM PRINT-DETAIL. NC1244.2 +102400 ADD 1 TO REC-CT. NC1244.2 +102500 PICTURE-TEST-8-E. NC1244.2 +102600 IF EDIT-AREA-5 EQUAL TO " +12" NC1244.2 +102700 PERFORM PASS NC1244.2 +102800 PERFORM PRINT-DETAIL NC1244.2 +102900 ELSE PERFORM FAIL NC1244.2 +103000 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +103100 MOVE " +12" TO CORRECT-A NC1244.2 +103200 PERFORM PRINT-DETAIL. NC1244.2 +103300 ADD 1 TO REC-CT. NC1244.2 +103400 PICTURE-TEST-8-F. NC1244.2 +103500 IF EDIT-AREA-6 EQUAL TO " 12" NC1244.2 +103600 PERFORM PASS NC1244.2 +103700 PERFORM PRINT-DETAIL NC1244.2 +103800 ELSE PERFORM FAIL NC1244.2 +103900 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +104000 MOVE " 12" TO CORRECT-A NC1244.2 +104100 PERFORM PRINT-DETAIL. NC1244.2 +104200 ADD 1 TO REC-CT. NC1244.2 +104300 PICTURE-TEST-8-G. NC1244.2 +104400 IF EDIT-AREA-7 EQUAL TO " +12.34" NC1244.2 +104500 PERFORM PASS NC1244.2 +104600 PERFORM PRINT-DETAIL NC1244.2 +104700 ELSE PERFORM FAIL NC1244.2 +104800 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +104900 MOVE " +12.34" TO CORRECT-A NC1244.2 +105000 PERFORM PRINT-DETAIL. NC1244.2 +105100 ADD 1 TO REC-CT. NC1244.2 +105200 PICTURE-TEST-8-H. NC1244.2 +105300 IF EDIT-AREA-8 EQUAL TO " 12.34" NC1244.2 +105400 PERFORM PASS NC1244.2 +105500 PERFORM PRINT-DETAIL NC1244.2 +105600 ELSE PERFORM FAIL NC1244.2 +105700 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +105800 MOVE " 12.34" TO CORRECT-A NC1244.2 +105900 PERFORM PRINT-DETAIL. NC1244.2 +106000 PICTURE-INIT-9. NC1244.2 +106100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +106200 MOVE "PICTRE-TST-9" TO PAR-NAME. NC1244.2 +106300 MOVE "PICTURE + AND -" TO FEATURE. NC1244.2 +106400 MOVE -12.34 TO WORK-AREA-9. NC1244.2 +106500 MOVE 1 TO REC-CT. NC1244.2 +106600 PICTURE-TEST-9. NC1244.2 +106700 MOVE WORK-AREA-9 TO EDIT-AREA-1 EDIT-AREA-2 EDIT-AREA-3 NC1244.2 +106800 EDIT-AREA-4 EDIT-AREA-5 EDIT-AREA-6 NC1244.2 +106900 EDIT-AREA-7 EDIT-AREA-8. NC1244.2 +107000 GO TO PICTURE-TEST-9-A. NC1244.2 +107100 PICTURE-DELETE-9. NC1244.2 +107200 PERFORM DE-LETE. NC1244.2 +107300 PERFORM PRINT-DETAIL. NC1244.2 +107400 GO TO PICTURE-INIT-10. NC1244.2 +107500 PICTURE-TEST-9-A. NC1244.2 +107600 IF EDIT-AREA-1 EQUAL TO "-0012" NC1244.2 +107700 PERFORM PASS NC1244.2 +107800 PERFORM PRINT-DETAIL NC1244.2 +107900 ELSE PERFORM FAIL NC1244.2 +108000 MOVE EDIT-AREA-1 TO COMPUTED-A NC1244.2 +108100 MOVE "-0012" TO CORRECT-A NC1244.2 +108200 PERFORM PRINT-DETAIL. NC1244.2 +108300 ADD 1 TO REC-CT. NC1244.2 +108400 PICTURE-TEST-9-B. NC1244.2 +108500 IF EDIT-AREA-2 EQUAL TO "-0012" NC1244.2 +108600 PERFORM PASS NC1244.2 +108700 PERFORM PRINT-DETAIL NC1244.2 +108800 ELSE PERFORM FAIL NC1244.2 +108900 MOVE EDIT-AREA-2 TO COMPUTED-A NC1244.2 +109000 MOVE "-0012" TO CORRECT-A NC1244.2 +109100 PERFORM PRINT-DETAIL. NC1244.2 +109200 ADD 1 TO REC-CT. NC1244.2 +109300 PICTURE-TEST-9-C. NC1244.2 +109400 IF EDIT-AREA-3 EQUAL TO " -12" NC1244.2 +109500 PERFORM PASS NC1244.2 +109600 PERFORM PRINT-DETAIL NC1244.2 +109700 ELSE PERFORM FAIL NC1244.2 +109800 MOVE EDIT-AREA-3 TO COMPUTED-A NC1244.2 +109900 MOVE " -12" TO CORRECT-A NC1244.2 +110000 PERFORM PRINT-DETAIL. NC1244.2 +110100 ADD 1 TO REC-CT. NC1244.2 +110200 PICTURE-TEST-9-D. NC1244.2 +110300 IF EDIT-AREA-4 EQUAL TO " -12" NC1244.2 +110400 PERFORM PASS NC1244.2 +110500 PERFORM PRINT-DETAIL NC1244.2 +110600 ELSE PERFORM FAIL NC1244.2 +110700 MOVE EDIT-AREA-4 TO COMPUTED-A NC1244.2 +110800 MOVE " -12" TO CORRECT-A NC1244.2 +110900 PERFORM PRINT-DETAIL. NC1244.2 +111000 ADD 1 TO REC-CT. NC1244.2 +111100 PICTURE-TEST-9-E. NC1244.2 +111200 IF EDIT-AREA-5 EQUAL TO " -12" NC1244.2 +111300 PERFORM PASS NC1244.2 +111400 PERFORM PRINT-DETAIL NC1244.2 +111500 ELSE PERFORM FAIL NC1244.2 +111600 MOVE EDIT-AREA-5 TO COMPUTED-A NC1244.2 +111700 MOVE " -12" TO CORRECT-A NC1244.2 +111800 PERFORM PRINT-DETAIL. NC1244.2 +111900 ADD 1 TO REC-CT. NC1244.2 +112000 PICTURE-TEST-9-F. NC1244.2 +112100 IF EDIT-AREA-6 EQUAL TO " -12" NC1244.2 +112200 PERFORM PASS NC1244.2 +112300 PERFORM PRINT-DETAIL NC1244.2 +112400 ELSE PERFORM FAIL NC1244.2 +112500 MOVE EDIT-AREA-6 TO COMPUTED-A NC1244.2 +112600 MOVE " -12" TO CORRECT-A NC1244.2 +112700 PERFORM PRINT-DETAIL. NC1244.2 +112800 ADD 1 TO REC-CT. NC1244.2 +112900 PICTURE-TEST-9-G. NC1244.2 +113000 IF EDIT-AREA-7 EQUAL TO " -12.34" NC1244.2 +113100 PERFORM PASS NC1244.2 +113200 PERFORM PRINT-DETAIL NC1244.2 +113300 ELSE PERFORM FAIL NC1244.2 +113400 MOVE EDIT-AREA-7 TO COMPUTED-A NC1244.2 +113500 MOVE " -12.34" TO CORRECT-A NC1244.2 +113600 PERFORM PRINT-DETAIL. NC1244.2 +113700 ADD 1 TO REC-CT. NC1244.2 +113800 PICTURE-TEST-9-H. NC1244.2 +113900 IF EDIT-AREA-8 EQUAL TO " -12.34" NC1244.2 +114000 PERFORM PASS NC1244.2 +114100 PERFORM PRINT-DETAIL NC1244.2 +114200 ELSE PERFORM FAIL NC1244.2 +114300 MOVE EDIT-AREA-8 TO COMPUTED-A NC1244.2 +114400 MOVE " -12.34" TO CORRECT-A NC1244.2 +114500 PERFORM PRINT-DETAIL. NC1244.2 +114600 PICTURE-INIT-10. NC1244.2 +114700 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +114800 MOVE "PCTRE-TST-10" TO PAR-NAME. NC1244.2 +114900 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +115000 MOVE 0 TO WORK-AREA-10. NC1244.2 +115100 MOVE 1 TO REC-CT. NC1244.2 +115200 PICTURE-TEST-10. NC1244.2 +115300 MOVE WORK-AREA-10 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +115400 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +115500 GO TO PICTURE-TEST-10-A. NC1244.2 +115600 PICTURE-DELETE-10. NC1244.2 +115700 PERFORM DE-LETE. NC1244.2 +115800 PERFORM PRINT-DETAIL. NC1244.2 +115900 GO TO PICTURE-INIT-11. NC1244.2 +116000 PICTURE-TEST-10-A. NC1244.2 +116100 IF EDIT-AREA-9 EQUAL TO " $00" NC1244.2 +116200 PERFORM PASS NC1244.2 +116300 PERFORM PRINT-DETAIL NC1244.2 +116400 ELSE PERFORM FAIL NC1244.2 +116500 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +116600 MOVE " $00" TO CORRECT-A NC1244.2 +116700 PERFORM PRINT-DETAIL. NC1244.2 +116800 ADD 1 TO REC-CT. NC1244.2 +116900 PICTURE-TEST-10-B. NC1244.2 +117000 IF EDIT-AREA-10 EQUAL TO " $0" NC1244.2 +117100 PERFORM PASS NC1244.2 +117200 PERFORM PRINT-DETAIL NC1244.2 +117300 ELSE PERFORM FAIL NC1244.2 +117400 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +117500 MOVE " $0" TO CORRECT-A NC1244.2 +117600 PERFORM PRINT-DETAIL. NC1244.2 +117700 ADD 1 TO REC-CT. NC1244.2 +117800 PICTURE-TEST-10-C. NC1244.2 +117900 IF EDIT-AREA-11 EQUAL TO " $.00" NC1244.2 +118000 PERFORM PASS NC1244.2 +118100 PERFORM PRINT-DETAIL NC1244.2 +118200 ELSE PERFORM FAIL NC1244.2 +118300 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +118400 MOVE " $.00" TO CORRECT-A NC1244.2 +118500 PERFORM PRINT-DETAIL. NC1244.2 +118600 ADD 1 TO REC-CT. NC1244.2 +118700 PICTURE-TEST-10-D. NC1244.2 +118800 IF EDIT-AREA-12 EQUAL TO " " NC1244.2 +118900 PERFORM PASS NC1244.2 +119000 PERFORM PRINT-DETAIL NC1244.2 +119100 ELSE PERFORM FAIL NC1244.2 +119200 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +119300 MOVE "SPACES" TO CORRECT-A NC1244.2 +119400 PERFORM PRINT-DETAIL. NC1244.2 +119500 PICTURE-INIT-11. NC1244.2 +119600 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +119700 MOVE "PCTRE-TST-11" TO PAR-NAME. NC1244.2 +119800 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +119900 MOVE .02 TO WORK-AREA-11. NC1244.2 +120000 MOVE 1 TO REC-CT. NC1244.2 +120100 PICTURE-TEST-11. NC1244.2 +120200 MOVE WORK-AREA-11 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +120300 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +120400 GO TO PICTURE-TEST-11-A. NC1244.2 +120500 PICTURE-DELETE-11. NC1244.2 +120600 PERFORM DE-LETE. NC1244.2 +120700 PERFORM PRINT-DETAIL. NC1244.2 +120800 GO TO PICTURE-INIT-12. NC1244.2 +120900 PICTURE-TEST-11-A. NC1244.2 +121000 IF EDIT-AREA-9 EQUAL TO " $00" NC1244.2 +121100 PERFORM PASS NC1244.2 +121200 PERFORM PRINT-DETAIL NC1244.2 +121300 ELSE PERFORM FAIL NC1244.2 +121400 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +121500 MOVE " $00" TO CORRECT-A NC1244.2 +121600 PERFORM PRINT-DETAIL. NC1244.2 +121700 ADD 1 TO REC-CT. NC1244.2 +121800 PICTURE-TEST-11-B. NC1244.2 +121900 IF EDIT-AREA-10 EQUAL TO " $0" NC1244.2 +122000 PERFORM PASS NC1244.2 +122100 PERFORM PRINT-DETAIL NC1244.2 +122200 ELSE PERFORM FAIL NC1244.2 +122300 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +122400 MOVE " $0" TO CORRECT-A NC1244.2 +122500 PERFORM PRINT-DETAIL. NC1244.2 +122600 ADD 1 TO REC-CT. NC1244.2 +122700 PICTURE-TEST-11-C. NC1244.2 +122800 IF EDIT-AREA-11 EQUAL TO " $.02" NC1244.2 +122900 PERFORM PASS NC1244.2 +123000 PERFORM PRINT-DETAIL NC1244.2 +123100 ELSE PERFORM FAIL NC1244.2 +123200 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +123300 MOVE " $.02" TO CORRECT-A NC1244.2 +123400 PERFORM PRINT-DETAIL. NC1244.2 +123500 ADD 1 TO REC-CT. NC1244.2 +123600 PICTURE-TEST-11-D. NC1244.2 +123700 IF EDIT-AREA-12 EQUAL TO " $.02" NC1244.2 +123800 PERFORM PASS NC1244.2 +123900 PERFORM PRINT-DETAIL NC1244.2 +124000 ELSE PERFORM FAIL NC1244.2 +124100 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +124200 MOVE " $.02" TO CORRECT-A NC1244.2 +124300 PERFORM PRINT-DETAIL. NC1244.2 +124400 PICTURE-INIT-12. NC1244.2 +124500 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +124600 MOVE "PCTRE-TST-12" TO PAR-NAME. NC1244.2 +124700 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +124800 MOVE 12 TO WORK-AREA-12. NC1244.2 +124900 MOVE 1 TO REC-CT. NC1244.2 +125000 PICTURE-TEST-12. NC1244.2 +125100 MOVE WORK-AREA-12 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +125200 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +125300 GO TO PICTURE-TEST-12-A. NC1244.2 +125400 PICTURE-DELETE-12. NC1244.2 +125500 PERFORM DE-LETE. NC1244.2 +125600 PERFORM PRINT-DETAIL. NC1244.2 +125700 GO TO PICTURE-INIT-13. NC1244.2 +125800 PICTURE-TEST-12-A. NC1244.2 +125900 IF EDIT-AREA-9 EQUAL TO " $12" NC1244.2 +126000 PERFORM PASS NC1244.2 +126100 PERFORM PRINT-DETAIL NC1244.2 +126200 ELSE PERFORM FAIL NC1244.2 +126300 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +126400 MOVE " $12" TO CORRECT-A NC1244.2 +126500 PERFORM PRINT-DETAIL. NC1244.2 +126600 ADD 1 TO REC-CT. NC1244.2 +126700 PICTURE-TEST-12-B. NC1244.2 +126800 IF EDIT-AREA-10 EQUAL TO " $12" NC1244.2 +126900 PERFORM PASS NC1244.2 +127000 PERFORM PRINT-DETAIL NC1244.2 +127100 ELSE PERFORM FAIL NC1244.2 +127200 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +127300 MOVE " $12" TO CORRECT-A NC1244.2 +127400 PERFORM PRINT-DETAIL. NC1244.2 +127500 ADD 1 TO REC-CT. NC1244.2 +127600 PICTURE-TEST-12-C. NC1244.2 +127700 IF EDIT-AREA-11 EQUAL TO " $12.00" NC1244.2 +127800 PERFORM PASS NC1244.2 +127900 PERFORM PRINT-DETAIL NC1244.2 +128000 ELSE PERFORM FAIL NC1244.2 +128100 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +128200 MOVE " $12.00" TO CORRECT-A NC1244.2 +128300 PERFORM PRINT-DETAIL. NC1244.2 +128400 ADD 1 TO REC-CT. NC1244.2 +128500 PICTURE-TEST-12-D. NC1244.2 +128600 IF EDIT-AREA-12 EQUAL TO " $12.00" NC1244.2 +128700 PERFORM PASS NC1244.2 +128800 PERFORM PRINT-DETAIL NC1244.2 +128900 ELSE PERFORM FAIL NC1244.2 +129000 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +129100 MOVE " $12.00" TO CORRECT-A NC1244.2 +129200 PERFORM PRINT-DETAIL. NC1244.2 +129300 PICTURE-INIT-13. NC1244.2 +129400 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +129500 MOVE "PCTRE-TST-13" TO PAR-NAME. NC1244.2 +129600 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +129700 MOVE 12.34 TO WORK-AREA-13. NC1244.2 +129800 MOVE 1 TO REC-CT. NC1244.2 +129900 PICTURE-TEST-13. NC1244.2 +130000 MOVE WORK-AREA-13 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +130100 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +130200 GO TO PICTURE-TEST-13-A. NC1244.2 +130300 PICTURE-DELETE-13. NC1244.2 +130400 PERFORM DE-LETE. NC1244.2 +130500 PERFORM PRINT-DETAIL. NC1244.2 +130600 GO TO PICTURE-INIT-14. NC1244.2 +130700 PICTURE-TEST-13-A. NC1244.2 +130800 IF EDIT-AREA-9 EQUAL TO " $12" NC1244.2 +130900 PERFORM PASS NC1244.2 +131000 PERFORM PRINT-DETAIL NC1244.2 +131100 ELSE PERFORM FAIL NC1244.2 +131200 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +131300 MOVE " $12" TO CORRECT-A NC1244.2 +131400 PERFORM PRINT-DETAIL. NC1244.2 +131500 ADD 1 TO REC-CT. NC1244.2 +131600 PICTURE-TEST-13-B. NC1244.2 +131700 IF EDIT-AREA-10 EQUAL TO " $12" NC1244.2 +131800 PERFORM PASS NC1244.2 +131900 PERFORM PRINT-DETAIL NC1244.2 +132000 ELSE PERFORM FAIL NC1244.2 +132100 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +132200 MOVE " $12" TO CORRECT-A NC1244.2 +132300 PERFORM PRINT-DETAIL. NC1244.2 +132400 ADD 1 TO REC-CT. NC1244.2 +132500 PICTURE-TEST-13-C. NC1244.2 +132600 IF EDIT-AREA-11 EQUAL TO " $12.34" NC1244.2 +132700 PERFORM PASS NC1244.2 +132800 PERFORM PRINT-DETAIL NC1244.2 +132900 ELSE PERFORM FAIL NC1244.2 +133000 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +133100 MOVE " $12.34" TO CORRECT-A NC1244.2 +133200 PERFORM PRINT-DETAIL. NC1244.2 +133300 ADD 1 TO REC-CT. NC1244.2 +133400 PICTURE-TEST-13-D. NC1244.2 +133500 IF EDIT-AREA-12 EQUAL TO " $12.34" NC1244.2 +133600 PERFORM PASS NC1244.2 +133700 PERFORM PRINT-DETAIL NC1244.2 +133800 ELSE PERFORM FAIL NC1244.2 +133900 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +134000 MOVE " $12.34" TO CORRECT-A NC1244.2 +134100 PERFORM PRINT-DETAIL. NC1244.2 +134200 PICTURE-INIT-14. NC1244.2 +134300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +134400 MOVE "PCTRE-TST-14" TO PAR-NAME. NC1244.2 +134500 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +134600 MOVE 1234 TO WORK-AREA-14. NC1244.2 +134700 MOVE 1 TO REC-CT. NC1244.2 +134800 PICTURE-TEST-14. NC1244.2 +134900 MOVE WORK-AREA-14 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +135000 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +135100 GO TO PICTURE-TEST-14-A. NC1244.2 +135200 PICTURE-DELETE-14. NC1244.2 +135300 PERFORM DE-LETE. NC1244.2 +135400 PERFORM PRINT-DETAIL. NC1244.2 +135500 GO TO PICTURE-INIT-15. NC1244.2 +135600 PICTURE-TEST-14-A. NC1244.2 +135700 IF EDIT-AREA-9 EQUAL TO "$234" NC1244.2 +135800 PERFORM PASS NC1244.2 +135900 PERFORM PRINT-DETAIL NC1244.2 +136000 ELSE PERFORM FAIL NC1244.2 +136100 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +136200 MOVE "$234" TO CORRECT-A NC1244.2 +136300 PERFORM PRINT-DETAIL. NC1244.2 +136400 ADD 1 TO REC-CT. NC1244.2 +136500 PICTURE-TEST-14-B. NC1244.2 +136600 IF EDIT-AREA-10 EQUAL TO "$1234" NC1244.2 +136700 PERFORM PASS NC1244.2 +136800 PERFORM PRINT-DETAIL NC1244.2 +136900 ELSE PERFORM FAIL NC1244.2 +137000 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +137100 MOVE "$1234" TO CORRECT-A NC1244.2 +137200 PERFORM PRINT-DETAIL. NC1244.2 +137300 ADD 1 TO REC-CT. NC1244.2 +137400 PICTURE-TEST-14-C. NC1244.2 +137500 IF EDIT-AREA-11 EQUAL TO "$1234.00" NC1244.2 +137600 PERFORM PASS NC1244.2 +137700 PERFORM PRINT-DETAIL NC1244.2 +137800 ELSE PERFORM FAIL NC1244.2 +137900 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +138000 MOVE "$1234.00" TO CORRECT-A NC1244.2 +138100 PERFORM PRINT-DETAIL. NC1244.2 +138200 ADD 1 TO REC-CT. NC1244.2 +138300 PICTURE-TEST-14-D. NC1244.2 +138400 IF EDIT-AREA-12 EQUAL TO "$1,234.00" NC1244.2 +138500 PERFORM PASS NC1244.2 +138600 PERFORM PRINT-DETAIL NC1244.2 +138700 ELSE PERFORM FAIL NC1244.2 +138800 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +138900 MOVE "$1,234.00" TO CORRECT-A NC1244.2 +139000 PERFORM PRINT-DETAIL. NC1244.2 +139100 PICTURE-INIT-15. NC1244.2 +139200 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +139300 MOVE "PCTRE-TST-15" TO PAR-NAME. NC1244.2 +139400 MOVE "PICTURE CHARACTER l" TO FEATURE. NC1244.2 +139500 MOVE 1234.56 TO WORK-AREA-15. NC1244.2 +139600 MOVE 1 TO REC-CT. NC1244.2 +139700 PICTURE-TEST-15. NC1244.2 +139800 MOVE WORK-AREA-15 TO EDIT-AREA-9 EDIT-AREA-10 NC1244.2 +139900 EDIT-AREA-11 EDIT-AREA-12. NC1244.2 +140000 GO TO PICTURE-TEST-15-A. NC1244.2 +140100 PICTURE-DELETE-15. NC1244.2 +140200 PERFORM DE-LETE. NC1244.2 +140300 PERFORM PRINT-DETAIL. NC1244.2 +140400 GO TO PICTURE-INIT-16. NC1244.2 +140500 PICTURE-TEST-15-A. NC1244.2 +140600 IF EDIT-AREA-9 EQUAL TO "$234" NC1244.2 +140700 PERFORM PASS NC1244.2 +140800 PERFORM PRINT-DETAIL NC1244.2 +140900 ELSE PERFORM FAIL NC1244.2 +141000 MOVE EDIT-AREA-9 TO COMPUTED-A NC1244.2 +141100 MOVE "$234" TO CORRECT-A NC1244.2 +141200 PERFORM PRINT-DETAIL. NC1244.2 +141300 ADD 1 TO REC-CT. NC1244.2 +141400 PICTURE-TEST-15-B. NC1244.2 +141500 IF EDIT-AREA-10 EQUAL TO "$1234" NC1244.2 +141600 PERFORM PASS NC1244.2 +141700 PERFORM PRINT-DETAIL NC1244.2 +141800 ELSE PERFORM FAIL NC1244.2 +141900 MOVE EDIT-AREA-10 TO COMPUTED-A NC1244.2 +142000 MOVE "$1234" TO CORRECT-A NC1244.2 +142100 PERFORM PRINT-DETAIL. NC1244.2 +142200 ADD 1 TO REC-CT. NC1244.2 +142300 PICTURE-TEST-15-C. NC1244.2 +142400 IF EDIT-AREA-11 EQUAL TO "$1234.56" NC1244.2 +142500 PERFORM PASS NC1244.2 +142600 PERFORM PRINT-DETAIL NC1244.2 +142700 ELSE PERFORM FAIL NC1244.2 +142800 MOVE EDIT-AREA-11 TO COMPUTED-A NC1244.2 +142900 MOVE "$1234.56" TO CORRECT-A NC1244.2 +143000 PERFORM PRINT-DETAIL. NC1244.2 +143100 ADD 1 TO REC-CT. NC1244.2 +143200 PICTURE-TEST-15-D. NC1244.2 +143300 IF EDIT-AREA-12 EQUAL TO "$1,234.56" NC1244.2 +143400 PERFORM PASS NC1244.2 +143500 PERFORM PRINT-DETAIL NC1244.2 +143600 ELSE PERFORM FAIL NC1244.2 +143700 MOVE EDIT-AREA-12 TO COMPUTED-A NC1244.2 +143800 MOVE "$1,234.56" TO CORRECT-A NC1244.2 +143900 PERFORM PRINT-DETAIL. NC1244.2 +144000 PICTURE-INIT-16. NC1244.2 +144100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +144200 MOVE "PCTRE-TST-16" TO PAR-NAME. NC1244.2 +144300 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +144400 MOVE 0 TO WORK-AREA-16. NC1244.2 +144500 MOVE 1 TO REC-CT. NC1244.2 +144600 PICTURE-TEST-16. NC1244.2 +144700 MOVE WORK-AREA-16 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +144800 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +144900 GO TO PICTURE-TEST-16-A. NC1244.2 +145000 PICTURE-DELETE-16. NC1244.2 +145100 PERFORM DE-LETE. NC1244.2 +145200 PERFORM PRINT-DETAIL. NC1244.2 +145300 GO TO PICTURE-INIT-17. NC1244.2 +145400 PICTURE-TEST-16-A. NC1244.2 +145500 IF EDIT-AREA-13 EQUAL TO "*000" NC1244.2 +145600 PERFORM PASS NC1244.2 +145700 PERFORM PRINT-DETAIL NC1244.2 +145800 ELSE PERFORM FAIL NC1244.2 +145900 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +146000 MOVE "*000" TO CORRECT-A NC1244.2 +146100 PERFORM PRINT-DETAIL. NC1244.2 +146200 ADD 1 TO REC-CT. NC1244.2 +146300 PICTURE-TEST-16-B. NC1244.2 +146400 IF EDIT-AREA-14 EQUAL TO "**00" NC1244.2 +146500 PERFORM PASS NC1244.2 +146600 PERFORM PRINT-DETAIL NC1244.2 +146700 ELSE PERFORM FAIL NC1244.2 +146800 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +146900 MOVE "**00" TO CORRECT-A NC1244.2 +147000 PERFORM PRINT-DETAIL. NC1244.2 +147100 ADD 1 TO REC-CT. NC1244.2 +147200 PICTURE-TEST-16-C. NC1244.2 +147300 IF EDIT-AREA-15 EQUAL TO "***0" NC1244.2 +147400 PERFORM PASS NC1244.2 +147500 PERFORM PRINT-DETAIL NC1244.2 +147600 ELSE PERFORM FAIL NC1244.2 +147700 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +147800 MOVE "***0" TO CORRECT-A NC1244.2 +147900 PERFORM PRINT-DETAIL. NC1244.2 +148000 ADD 1 TO REC-CT. NC1244.2 +148100 PICTURE-TEST-16-D. NC1244.2 +148200 IF EDIT-AREA-16 EQUAL TO "**.**" NC1244.2 +148300 PERFORM PASS NC1244.2 +148400 PERFORM PRINT-DETAIL NC1244.2 +148500 ELSE PERFORM FAIL NC1244.2 +148600 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +148700 MOVE "**.**" TO CORRECT-A NC1244.2 +148800 PERFORM PRINT-DETAIL. NC1244.2 +148900 ADD 1 TO REC-CT. NC1244.2 +149000 PICTURE-TEST-16-E. NC1244.2 +149100 IF EDIT-AREA-17 EQUAL TO "*****.**" NC1244.2 +149200 PERFORM PASS NC1244.2 +149300 PERFORM PRINT-DETAIL NC1244.2 +149400 ELSE PERFORM FAIL NC1244.2 +149500 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +149600 MOVE "*****.**" TO CORRECT-A NC1244.2 +149700 PERFORM PRINT-DETAIL. NC1244.2 +149800 PICTURE-INIT-17. NC1244.2 +149900 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +150000 MOVE "PCTRE-TST-17" TO PAR-NAME. NC1244.2 +150100 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +150200 MOVE 13 TO WORK-AREA-17. NC1244.2 +150300 MOVE 1 TO REC-CT. NC1244.2 +150400 PICTURE-TEST-17. NC1244.2 +150500 MOVE WORK-AREA-17 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +150600 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +150700 GO TO PICTURE-TEST-17-A. NC1244.2 +150800 PICTURE-DELETE-17. NC1244.2 +150900 PERFORM DE-LETE. NC1244.2 +151000 PERFORM PRINT-DETAIL. NC1244.2 +151100 GO TO PICTURE-INIT-18. NC1244.2 +151200 PICTURE-TEST-17-A. NC1244.2 +151300 IF EDIT-AREA-13 EQUAL TO "*013" NC1244.2 +151400 PERFORM PASS NC1244.2 +151500 PERFORM PRINT-DETAIL NC1244.2 +151600 ELSE PERFORM FAIL NC1244.2 +151700 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +151800 MOVE "*013" TO CORRECT-A NC1244.2 +151900 PERFORM PRINT-DETAIL. NC1244.2 +152000 ADD 1 TO REC-CT. NC1244.2 +152100 PICTURE-TEST-17-B. NC1244.2 +152200 IF EDIT-AREA-14 EQUAL TO "**13" NC1244.2 +152300 PERFORM PASS NC1244.2 +152400 PERFORM PRINT-DETAIL NC1244.2 +152500 ELSE PERFORM FAIL NC1244.2 +152600 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +152700 MOVE "**13" TO CORRECT-A NC1244.2 +152800 PERFORM PRINT-DETAIL. NC1244.2 +152900 ADD 1 TO REC-CT. NC1244.2 +153000 PICTURE-TEST-17-C. NC1244.2 +153100 IF EDIT-AREA-15 EQUAL TO "**13" NC1244.2 +153200 PERFORM PASS NC1244.2 +153300 PERFORM PRINT-DETAIL NC1244.2 +153400 ELSE PERFORM FAIL NC1244.2 +153500 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +153600 MOVE "**13" TO CORRECT-A NC1244.2 +153700 PERFORM PRINT-DETAIL. NC1244.2 +153800 ADD 1 TO REC-CT. NC1244.2 +153900 PICTURE-TEST-17-D. NC1244.2 +154000 IF EDIT-AREA-16 EQUAL TO "13.00" NC1244.2 +154100 PERFORM PASS NC1244.2 +154200 PERFORM PRINT-DETAIL NC1244.2 +154300 ELSE PERFORM FAIL NC1244.2 +154400 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +154500 MOVE "13.00" TO CORRECT-A NC1244.2 +154600 PERFORM PRINT-DETAIL. NC1244.2 +154700 ADD 1 TO REC-CT. NC1244.2 +154800 PICTURE-TEST-17-E. NC1244.2 +154900 IF EDIT-AREA-17 EQUAL TO "***13.00" NC1244.2 +155000 PERFORM PASS NC1244.2 +155100 PERFORM PRINT-DETAIL NC1244.2 +155200 ELSE PERFORM FAIL NC1244.2 +155300 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +155400 MOVE "***13.00" TO CORRECT-A NC1244.2 +155500 PERFORM PRINT-DETAIL. NC1244.2 +155600 PICTURE-INIT-18. NC1244.2 +155700 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +155800 MOVE "PCTRE-TST-18" TO PAR-NAME. NC1244.2 +155900 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +156000 MOVE 123 TO WORK-AREA-18. NC1244.2 +156100 MOVE 1 TO REC-CT. NC1244.2 +156200 PICTURE-TEST-18. NC1244.2 +156300 MOVE WORK-AREA-18 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +156400 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +156500 GO TO PICTURE-TEST-18-A. NC1244.2 +156600 PICTURE-DELETE-18. NC1244.2 +156700 PERFORM DE-LETE. NC1244.2 +156800 PERFORM PRINT-DETAIL. NC1244.2 +156900 GO TO PICTURE-INIT-19. NC1244.2 +157000 PICTURE-TEST-18-A. NC1244.2 +157100 IF EDIT-AREA-13 EQUAL TO "*123" NC1244.2 +157200 PERFORM PASS NC1244.2 +157300 PERFORM PRINT-DETAIL NC1244.2 +157400 ELSE PERFORM FAIL NC1244.2 +157500 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +157600 MOVE "*123" TO CORRECT-A NC1244.2 +157700 PERFORM PRINT-DETAIL. NC1244.2 +157800 ADD 1 TO REC-CT. NC1244.2 +157900 PICTURE-TEST-18-B. NC1244.2 +158000 IF EDIT-AREA-14 EQUAL TO "*123" NC1244.2 +158100 PERFORM PASS NC1244.2 +158200 PERFORM PRINT-DETAIL NC1244.2 +158300 ELSE PERFORM FAIL NC1244.2 +158400 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +158500 MOVE "*123" TO CORRECT-A NC1244.2 +158600 PERFORM PRINT-DETAIL. NC1244.2 +158700 ADD 1 TO REC-CT. NC1244.2 +158800 PICTURE-TEST-18-C. NC1244.2 +158900 IF EDIT-AREA-15 EQUAL TO "*123" NC1244.2 +159000 PERFORM PASS NC1244.2 +159100 PERFORM PRINT-DETAIL NC1244.2 +159200 ELSE PERFORM FAIL NC1244.2 +159300 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +159400 MOVE "*123" TO CORRECT-A NC1244.2 +159500 PERFORM PRINT-DETAIL. NC1244.2 +159600 ADD 1 TO REC-CT. NC1244.2 +159700 PICTURE-TEST-18-D. NC1244.2 +159800 IF EDIT-AREA-16 EQUAL TO "23.00" NC1244.2 +159900 PERFORM PASS NC1244.2 +160000 PERFORM PRINT-DETAIL NC1244.2 +160100 ELSE PERFORM FAIL NC1244.2 +160200 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +160300 MOVE "23.00" TO CORRECT-A NC1244.2 +160400 PERFORM PRINT-DETAIL. NC1244.2 +160500 ADD 1 TO REC-CT. NC1244.2 +160600 PICTURE-TEST-18-E. NC1244.2 +160700 IF EDIT-AREA-17 EQUAL TO "**123.00" NC1244.2 +160800 PERFORM PASS NC1244.2 +160900 PERFORM PRINT-DETAIL NC1244.2 +161000 ELSE PERFORM FAIL NC1244.2 +161100 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +161200 MOVE "**123.00" TO CORRECT-A NC1244.2 +161300 PERFORM PRINT-DETAIL. NC1244.2 +161400 PICTURE-INIT-19. NC1244.2 +161500 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +161600 MOVE "PCTRE-TST-19" TO PAR-NAME. NC1244.2 +161700 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +161800 MOVE 2010 TO WORK-AREA-19. NC1244.2 +161900 MOVE 1 TO REC-CT. NC1244.2 +162000 PICTURE-TEST-19. NC1244.2 +162100 MOVE WORK-AREA-19 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +162200 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +162300 GO TO PICTURE-TEST-19-A. NC1244.2 +162400 PICTURE-DELETE-19. NC1244.2 +162500 PERFORM DE-LETE. NC1244.2 +162600 PERFORM PRINT-DETAIL. NC1244.2 +162700 GO TO PICTURE-INIT-20. NC1244.2 +162800 PICTURE-TEST-19-A. NC1244.2 +162900 IF EDIT-AREA-13 EQUAL TO "2010" NC1244.2 +163000 PERFORM PASS NC1244.2 +163100 PERFORM PRINT-DETAIL NC1244.2 +163200 ELSE PERFORM FAIL NC1244.2 +163300 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +163400 MOVE "2010" TO CORRECT-A NC1244.2 +163500 PERFORM PRINT-DETAIL. NC1244.2 +163600 ADD 1 TO REC-CT. NC1244.2 +163700 PICTURE-TEST-19-B. NC1244.2 +163800 IF EDIT-AREA-14 EQUAL TO "2010" NC1244.2 +163900 PERFORM PASS NC1244.2 +164000 PERFORM PRINT-DETAIL NC1244.2 +164100 ELSE PERFORM FAIL NC1244.2 +164200 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +164300 MOVE "2010" TO CORRECT-A NC1244.2 +164400 PERFORM PRINT-DETAIL. NC1244.2 +164500 ADD 1 TO REC-CT. NC1244.2 +164600 PICTURE-TEST-19-C. NC1244.2 +164700 IF EDIT-AREA-15 EQUAL TO "2010" NC1244.2 +164800 PERFORM PASS NC1244.2 +164900 PERFORM PRINT-DETAIL NC1244.2 +165000 ELSE PERFORM FAIL NC1244.2 +165100 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +165200 MOVE "2010" TO CORRECT-A NC1244.2 +165300 PERFORM PRINT-DETAIL. NC1244.2 +165400 ADD 1 TO REC-CT. NC1244.2 +165500 PICTURE-TEST-19-D. NC1244.2 +165600 IF EDIT-AREA-16 EQUAL TO "10.00" NC1244.2 +165700 PERFORM PASS NC1244.2 +165800 PERFORM PRINT-DETAIL NC1244.2 +165900 ELSE PERFORM FAIL NC1244.2 +166000 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +166100 MOVE "10.00" TO CORRECT-A NC1244.2 +166200 PERFORM PRINT-DETAIL. NC1244.2 +166300 ADD 1 TO REC-CT. NC1244.2 +166400 PICTURE-TEST-19-E. NC1244.2 +166500 IF EDIT-AREA-17 EQUAL TO "2,010.00" NC1244.2 +166600 PERFORM PASS NC1244.2 +166700 PERFORM PRINT-DETAIL NC1244.2 +166800 ELSE PERFORM FAIL NC1244.2 +166900 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +167000 MOVE "2,010.00" TO CORRECT-A NC1244.2 +167100 PERFORM PRINT-DETAIL. NC1244.2 +167200 PICTURE-INIT-20. NC1244.2 +167300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +167400 MOVE "PCTRE-TST-20" TO PAR-NAME. NC1244.2 +167500 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +167600 MOVE 1 TO REC-CT. NC1244.2 +167700 MOVE 1010.2 TO WORK-AREA-20. NC1244.2 +167800 PICTURE-TEST-20. NC1244.2 +167900 MOVE WORK-AREA-20 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +168000 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +168100 GO TO PICTURE-TEST-20-A. NC1244.2 +168200 PICTURE-DELETE-20. NC1244.2 +168300 PERFORM DE-LETE. NC1244.2 +168400 PERFORM PRINT-DETAIL. NC1244.2 +168500 GO TO PICTURE-INIT-21. NC1244.2 +168600 PICTURE-TEST-20-A. NC1244.2 +168700 IF EDIT-AREA-13 EQUAL TO "1010" NC1244.2 +168800 PERFORM PASS NC1244.2 +168900 PERFORM PRINT-DETAIL NC1244.2 +169000 ELSE PERFORM FAIL NC1244.2 +169100 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +169200 MOVE "1010" TO CORRECT-A NC1244.2 +169300 PERFORM PRINT-DETAIL. NC1244.2 +169400 ADD 1 TO REC-CT. NC1244.2 +169500 PICTURE-TEST-20-B. NC1244.2 +169600 IF EDIT-AREA-14 EQUAL TO "1010" NC1244.2 +169700 PERFORM PASS NC1244.2 +169800 PERFORM PRINT-DETAIL NC1244.2 +169900 ELSE PERFORM FAIL NC1244.2 +170000 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +170100 MOVE "1010" TO CORRECT-A NC1244.2 +170200 PERFORM PRINT-DETAIL. NC1244.2 +170300 ADD 1 TO REC-CT. NC1244.2 +170400 PICTURE-TEST-20-C. NC1244.2 +170500 IF EDIT-AREA-15 EQUAL TO "1010" NC1244.2 +170600 PERFORM PASS NC1244.2 +170700 PERFORM PRINT-DETAIL NC1244.2 +170800 ELSE PERFORM FAIL NC1244.2 +170900 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +171000 MOVE "1010" TO CORRECT-A NC1244.2 +171100 PERFORM PRINT-DETAIL. NC1244.2 +171200 ADD 1 TO REC-CT. NC1244.2 +171300 PICTURE-TEST-20-D. NC1244.2 +171400 IF EDIT-AREA-16 EQUAL TO "10.20" NC1244.2 +171500 PERFORM PASS NC1244.2 +171600 PERFORM PRINT-DETAIL NC1244.2 +171700 ELSE PERFORM FAIL NC1244.2 +171800 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +171900 MOVE "10.20" TO CORRECT-A NC1244.2 +172000 PERFORM PRINT-DETAIL. NC1244.2 +172100 ADD 1 TO REC-CT. NC1244.2 +172200 PICTURE-TEST-20-E. NC1244.2 +172300 IF EDIT-AREA-17 EQUAL TO "1,010.20" NC1244.2 +172400 PERFORM PASS NC1244.2 +172500 PERFORM PRINT-DETAIL NC1244.2 +172600 ELSE PERFORM FAIL NC1244.2 +172700 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +172800 MOVE "1,010.20" TO CORRECT-A NC1244.2 +172900 PERFORM PRINT-DETAIL. NC1244.2 +173000 PICTURE-INIT-21. NC1244.2 +173100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +173200 MOVE "PCTRE-TST-21" TO PAR-NAME. NC1244.2 +173300 MOVE "PICTURE CHARACTER *" TO FEATURE. NC1244.2 +173400 MOVE .01 TO WORK-AREA-21. NC1244.2 +173500 MOVE 1 TO REC-CT. NC1244.2 +173600 PICTURE-TEST-21. NC1244.2 +173700 MOVE WORK-AREA-21 TO EDIT-AREA-13 EDIT-AREA-14 EDIT-AREA-15NC1244.2 +173800 EDIT-AREA-16 EDIT-AREA-17. NC1244.2 +173900 GO TO PICTURE-TEST-21-A. NC1244.2 +174000 PICTURE-DELETE-21. NC1244.2 +174100 PERFORM DE-LETE. NC1244.2 +174200 PERFORM PRINT-DETAIL. NC1244.2 +174300 GO TO PICTURE-INIT-22. NC1244.2 +174400 PICTURE-TEST-21-A. NC1244.2 +174500 IF EDIT-AREA-13 EQUAL TO "*000" NC1244.2 +174600 PERFORM PASS NC1244.2 +174700 PERFORM PRINT-DETAIL NC1244.2 +174800 ELSE PERFORM FAIL NC1244.2 +174900 MOVE EDIT-AREA-13 TO COMPUTED-A NC1244.2 +175000 MOVE "*000" TO CORRECT-A NC1244.2 +175100 PERFORM PRINT-DETAIL. NC1244.2 +175200 ADD 1 TO REC-CT. NC1244.2 +175300 PICTURE-TEST-21-B. NC1244.2 +175400 IF EDIT-AREA-14 EQUAL TO "**00" NC1244.2 +175500 PERFORM PASS NC1244.2 +175600 PERFORM PRINT-DETAIL NC1244.2 +175700 ELSE PERFORM FAIL NC1244.2 +175800 MOVE EDIT-AREA-14 TO COMPUTED-A NC1244.2 +175900 MOVE "**00" TO CORRECT-A NC1244.2 +176000 PERFORM PRINT-DETAIL. NC1244.2 +176100 ADD 1 TO REC-CT. NC1244.2 +176200 PICTURE-TEST-21-C. NC1244.2 +176300 IF EDIT-AREA-15 EQUAL TO "***0" NC1244.2 +176400 PERFORM PASS NC1244.2 +176500 PERFORM PRINT-DETAIL NC1244.2 +176600 ELSE PERFORM FAIL NC1244.2 +176700 MOVE EDIT-AREA-15 TO COMPUTED-A NC1244.2 +176800 MOVE "***0" TO CORRECT-A NC1244.2 +176900 PERFORM PRINT-DETAIL. NC1244.2 +177000 ADD 1 TO REC-CT. NC1244.2 +177100 PICTURE-TEST-21-D. NC1244.2 +177200 IF EDIT-AREA-16 EQUAL TO "**.01" NC1244.2 +177300 PERFORM PASS NC1244.2 +177400 PERFORM PRINT-DETAIL NC1244.2 +177500 ELSE PERFORM FAIL NC1244.2 +177600 MOVE EDIT-AREA-16 TO COMPUTED-A NC1244.2 +177700 MOVE "**.01" TO CORRECT-A NC1244.2 +177800 PERFORM PRINT-DETAIL. NC1244.2 +177900 ADD 1 TO REC-CT. NC1244.2 +178000 PICTURE-TEST-21-E. NC1244.2 +178100 IF EDIT-AREA-17 EQUAL TO "*****.01" NC1244.2 +178200 PERFORM PASS NC1244.2 +178300 PERFORM PRINT-DETAIL NC1244.2 +178400 ELSE PERFORM FAIL NC1244.2 +178500 MOVE EDIT-AREA-17 TO COMPUTED-A NC1244.2 +178600 MOVE "*****.01" TO CORRECT-A NC1244.2 +178700 PERFORM PRINT-DETAIL. NC1244.2 +178800 PICTURE-INIT-22. NC1244.2 +178900 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +179000 MOVE "PCTRE-TST-22" TO PAR-NAME. NC1244.2 +179100 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +179200 MOVE 0 TO WORK-AREA-22. NC1244.2 +179300 MOVE 1 TO REC-CT. NC1244.2 +179400 PICTURE-TEST-22. NC1244.2 +179500 MOVE WORK-AREA-22 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +179600 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +179700 EDIT-AREA-24. NC1244.2 +179800 GO TO PICTURE-TEST-22-A. NC1244.2 +179900 PICTURE-DELETE-22. NC1244.2 +180000 PERFORM DE-LETE. NC1244.2 +180100 PERFORM PRINT-DETAIL. NC1244.2 +180200 GO TO PICTURE-INIT-23. NC1244.2 +180300 PICTURE-TEST-22-A. NC1244.2 +180400 IF EDIT-AREA-18 EQUAL TO "0000" NC1244.2 +180500 PERFORM PASS NC1244.2 +180600 PERFORM PRINT-DETAIL NC1244.2 +180700 ELSE PERFORM FAIL NC1244.2 +180800 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +180900 MOVE "0000" TO CORRECT-A NC1244.2 +181000 PERFORM PRINT-DETAIL. NC1244.2 +181100 ADD 1 TO REC-CT. NC1244.2 +181200 PICTURE-TEST-22-B. NC1244.2 +181300 IF EDIT-AREA-19 EQUAL TO " 000" NC1244.2 +181400 PERFORM PASS NC1244.2 +181500 PERFORM PRINT-DETAIL NC1244.2 +181600 ELSE PERFORM FAIL NC1244.2 +181700 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +181800 MOVE " 000" TO CORRECT-A NC1244.2 +181900 PERFORM PRINT-DETAIL. NC1244.2 +182000 ADD 1 TO REC-CT. NC1244.2 +182100 PICTURE-TEST-22-C. NC1244.2 +182200 IF EDIT-AREA-20 EQUAL TO " 00" NC1244.2 +182300 PERFORM PASS NC1244.2 +182400 PERFORM PRINT-DETAIL NC1244.2 +182500 ELSE PERFORM FAIL NC1244.2 +182600 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +182700 MOVE " 00" TO CORRECT-A NC1244.2 +182800 PERFORM PRINT-DETAIL. NC1244.2 +182900 ADD 1 TO REC-CT. NC1244.2 +183000 PICTURE-TEST-22-D. NC1244.2 +183100 IF EDIT-AREA-21 EQUAL TO " 0" NC1244.2 +183200 PERFORM PASS NC1244.2 +183300 PERFORM PRINT-DETAIL NC1244.2 +183400 ELSE PERFORM FAIL NC1244.2 +183500 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +183600 MOVE " 0" TO CORRECT-A NC1244.2 +183700 PERFORM PRINT-DETAIL. NC1244.2 +183800 ADD 1 TO REC-CT. NC1244.2 +183900 PICTURE-TEST-22-E. NC1244.2 +184000 IF EDIT-AREA-22 EQUAL TO " " NC1244.2 +184100 PERFORM PASS NC1244.2 +184200 PERFORM PRINT-DETAIL NC1244.2 +184300 ELSE PERFORM FAIL NC1244.2 +184400 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +184500 MOVE "SPACES" TO CORRECT-A NC1244.2 +184600 PERFORM PRINT-DETAIL. NC1244.2 +184700 ADD 1 TO REC-CT. NC1244.2 +184800 PICTURE-TEST-22-F. NC1244.2 +184900 IF EDIT-AREA-23 EQUAL TO " " NC1244.2 +185000 PERFORM PASS NC1244.2 +185100 PERFORM PRINT-DETAIL NC1244.2 +185200 ELSE PERFORM FAIL NC1244.2 +185300 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +185400 MOVE "SPACES" TO CORRECT-A NC1244.2 +185500 PERFORM PRINT-DETAIL. NC1244.2 +185600 ADD 1 TO REC-CT. NC1244.2 +185700 PICTURE-TEST-22-G. NC1244.2 +185800 IF EDIT-AREA-24 EQUAL TO " " NC1244.2 +185900 PERFORM PASS NC1244.2 +186000 PERFORM PRINT-DETAIL NC1244.2 +186100 ELSE PERFORM FAIL NC1244.2 +186200 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +186300 MOVE "SPACES" TO CORRECT-A NC1244.2 +186400 PERFORM PRINT-DETAIL. NC1244.2 +186500 PICTURE-INIT-23. NC1244.2 +186600 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +186700 MOVE "PCTRE-TST-23" TO PAR-NAME. NC1244.2 +186800 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +186900 MOVE 1.01 TO WORK-AREA-23. NC1244.2 +187000 MOVE 1 TO REC-CT. NC1244.2 +187100 PICTURE-TEST-23. NC1244.2 +187200 MOVE WORK-AREA-23 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +187300 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +187400 EDIT-AREA-24. NC1244.2 +187500 GO TO PICTURE-TEST-23-A. NC1244.2 +187600 PICTURE-DELETE-23. NC1244.2 +187700 PERFORM DE-LETE. NC1244.2 +187800 PERFORM PRINT-DETAIL. NC1244.2 +187900 GO TO PICTURE-INIT-24. NC1244.2 +188000 PICTURE-TEST-23-A. NC1244.2 +188100 IF EDIT-AREA-18 EQUAL TO "0001" NC1244.2 +188200 PERFORM PASS NC1244.2 +188300 PERFORM PRINT-DETAIL NC1244.2 +188400 ELSE PERFORM FAIL NC1244.2 +188500 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +188600 MOVE "0001" TO CORRECT-A NC1244.2 +188700 PERFORM PRINT-DETAIL. NC1244.2 +188800 ADD 1 TO REC-CT. NC1244.2 +188900 PICTURE-TEST-23-B. NC1244.2 +189000 IF EDIT-AREA-19 EQUAL TO " 001" NC1244.2 +189100 PERFORM PASS NC1244.2 +189200 PERFORM PRINT-DETAIL NC1244.2 +189300 ELSE PERFORM FAIL NC1244.2 +189400 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +189500 MOVE " 001" TO CORRECT-A NC1244.2 +189600 PERFORM PRINT-DETAIL. NC1244.2 +189700 ADD 1 TO REC-CT. NC1244.2 +189800 PICTURE-TEST-23-C. NC1244.2 +189900 IF EDIT-AREA-20 EQUAL TO " 01" NC1244.2 +190000 PERFORM PASS NC1244.2 +190100 PERFORM PRINT-DETAIL NC1244.2 +190200 ELSE PERFORM FAIL NC1244.2 +190300 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +190400 MOVE " 01" TO CORRECT-A NC1244.2 +190500 PERFORM PRINT-DETAIL. NC1244.2 +190600 ADD 1 TO REC-CT. NC1244.2 +190700 PICTURE-TEST-23-D. NC1244.2 +190800 IF EDIT-AREA-21 EQUAL TO " 1" NC1244.2 +190900 PERFORM PASS NC1244.2 +191000 PERFORM PRINT-DETAIL NC1244.2 +191100 ELSE PERFORM FAIL NC1244.2 +191200 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +191300 MOVE " 1" TO CORRECT-A NC1244.2 +191400 PERFORM PRINT-DETAIL. NC1244.2 +191500 ADD 1 TO REC-CT. NC1244.2 +191600 PICTURE-TEST-23-E. NC1244.2 +191700 IF EDIT-AREA-22 EQUAL TO " 1" NC1244.2 +191800 PERFORM PASS NC1244.2 +191900 PERFORM PRINT-DETAIL NC1244.2 +192000 ELSE PERFORM FAIL NC1244.2 +192100 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +192200 MOVE " 1" TO CORRECT-A NC1244.2 +192300 PERFORM PRINT-DETAIL. NC1244.2 +192400 ADD 1 TO REC-CT. NC1244.2 +192500 PICTURE-TEST-23-F. NC1244.2 +192600 IF EDIT-AREA-23 EQUAL TO " 1.01" NC1244.2 +192700 PERFORM PASS NC1244.2 +192800 PERFORM PRINT-DETAIL NC1244.2 +192900 ELSE PERFORM FAIL NC1244.2 +193000 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +193100 MOVE " 1.01" TO CORRECT-A NC1244.2 +193200 PERFORM PRINT-DETAIL. NC1244.2 +193300 ADD 1 TO REC-CT. NC1244.2 +193400 PICTURE-TEST-23-G. NC1244.2 +193500 IF EDIT-AREA-24 EQUAL TO " 1" NC1244.2 +193600 PERFORM PASS NC1244.2 +193700 PERFORM PRINT-DETAIL NC1244.2 +193800 ELSE PERFORM FAIL NC1244.2 +193900 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +194000 MOVE " 1" TO CORRECT-A NC1244.2 +194100 PERFORM PRINT-DETAIL. NC1244.2 +194200 PICTURE-INIT-24. NC1244.2 +194300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +194400 MOVE "PCTRE-TST-24" TO PAR-NAME. NC1244.2 +194500 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +194600 MOVE 217 TO WORK-AREA-24. NC1244.2 +194700 MOVE 1 TO REC-CT. NC1244.2 +194800 PICTURE-TEST-24. NC1244.2 +194900 MOVE WORK-AREA-24 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +195000 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +195100 EDIT-AREA-24. NC1244.2 +195200 GO TO PICTURE-TEST-24-A. NC1244.2 +195300 PICTURE-DELETE-24. NC1244.2 +195400 PERFORM DE-LETE. NC1244.2 +195500 PERFORM PRINT-DETAIL. NC1244.2 +195600 GO TO PICTURE-INIT-25. NC1244.2 +195700 PICTURE-TEST-24-A. NC1244.2 +195800 IF EDIT-AREA-18 EQUAL TO "0217" NC1244.2 +195900 PERFORM PASS NC1244.2 +196000 PERFORM PRINT-DETAIL NC1244.2 +196100 ELSE PERFORM FAIL NC1244.2 +196200 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +196300 MOVE "0217" TO CORRECT-A NC1244.2 +196400 PERFORM PRINT-DETAIL. NC1244.2 +196500 ADD 1 TO REC-CT. NC1244.2 +196600 PICTURE-TEST-24-B. NC1244.2 +196700 IF EDIT-AREA-19 EQUAL TO " 217" NC1244.2 +196800 PERFORM PASS NC1244.2 +196900 PERFORM PRINT-DETAIL NC1244.2 +197000 ELSE PERFORM FAIL NC1244.2 +197100 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +197200 MOVE " 217" TO CORRECT-A NC1244.2 +197300 PERFORM PRINT-DETAIL. NC1244.2 +197400 ADD 1 TO REC-CT. NC1244.2 +197500 PICTURE-TEST-24-C. NC1244.2 +197600 IF EDIT-AREA-20 EQUAL TO " 217" NC1244.2 +197700 PERFORM PASS NC1244.2 +197800 PERFORM PRINT-DETAIL NC1244.2 +197900 ELSE PERFORM FAIL NC1244.2 +198000 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +198100 MOVE " 217" TO CORRECT-A NC1244.2 +198200 PERFORM PRINT-DETAIL. NC1244.2 +198300 ADD 1 TO REC-CT. NC1244.2 +198400 PICTURE-TEST-24-D. NC1244.2 +198500 IF EDIT-AREA-21 EQUAL TO " 217" NC1244.2 +198600 PERFORM PASS NC1244.2 +198700 PERFORM PRINT-DETAIL NC1244.2 +198800 ELSE PERFORM FAIL NC1244.2 +198900 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +199000 MOVE " 217" TO CORRECT-A NC1244.2 +199100 PERFORM PRINT-DETAIL. NC1244.2 +199200 ADD 1 TO REC-CT. NC1244.2 +199300 PICTURE-TEST-24-E. NC1244.2 +199400 IF EDIT-AREA-22 EQUAL TO " 217" NC1244.2 +199500 PERFORM PASS NC1244.2 +199600 PERFORM PRINT-DETAIL NC1244.2 +199700 ELSE PERFORM FAIL NC1244.2 +199800 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +199900 MOVE " 217" TO CORRECT-A NC1244.2 +200000 PERFORM PRINT-DETAIL. NC1244.2 +200100 ADD 1 TO REC-CT. NC1244.2 +200200 PICTURE-TEST-24-F. NC1244.2 +200300 IF EDIT-AREA-23 EQUAL TO "17.00" NC1244.2 +200400 PERFORM PASS NC1244.2 +200500 PERFORM PRINT-DETAIL NC1244.2 +200600 ELSE PERFORM FAIL NC1244.2 +200700 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +200800 MOVE "17.00" TO CORRECT-A NC1244.2 +200900 PERFORM PRINT-DETAIL. NC1244.2 +201000 ADD 1 TO REC-CT. NC1244.2 +201100 PICTURE-TEST-24-G. NC1244.2 +201200 IF EDIT-AREA-24 EQUAL TO " 217" NC1244.2 +201300 PERFORM PASS NC1244.2 +201400 PERFORM PRINT-DETAIL NC1244.2 +201500 ELSE PERFORM FAIL NC1244.2 +201600 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +201700 MOVE " 217" TO CORRECT-A NC1244.2 +201800 PERFORM PRINT-DETAIL. NC1244.2 +201900 PICTURE-INIT-25. NC1244.2 +202000 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +202100 MOVE "PCTRE-TST-25" TO PAR-NAME. NC1244.2 +202200 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +202300 MOVE 1010.20 TO WORK-AREA-25. NC1244.2 +202400 MOVE 1 TO REC-CT. NC1244.2 +202500 PICTURE-TEST-25. NC1244.2 +202600 MOVE WORK-AREA-25 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +202700 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +202800 EDIT-AREA-24. NC1244.2 +202900 GO TO PICTURE-TEST-25-A. NC1244.2 +203000 PICTURE-DELETE-25. NC1244.2 +203100 PERFORM DE-LETE. NC1244.2 +203200 PERFORM PRINT-DETAIL. NC1244.2 +203300 GO TO PICTURE-INIT-26. NC1244.2 +203400 PICTURE-TEST-25-A. NC1244.2 +203500 IF EDIT-AREA-18 EQUAL TO "1010" NC1244.2 +203600 PERFORM PASS NC1244.2 +203700 PERFORM PRINT-DETAIL NC1244.2 +203800 ELSE PERFORM FAIL NC1244.2 +203900 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +204000 MOVE "1010" TO CORRECT-A NC1244.2 +204100 PERFORM PRINT-DETAIL. NC1244.2 +204200 ADD 1 TO REC-CT. NC1244.2 +204300 PICTURE-TEST-25-B. NC1244.2 +204400 IF EDIT-AREA-19 EQUAL TO "1010" NC1244.2 +204500 PERFORM PASS NC1244.2 +204600 PERFORM PRINT-DETAIL NC1244.2 +204700 ELSE PERFORM FAIL NC1244.2 +204800 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +204900 MOVE "1010" TO CORRECT-A NC1244.2 +205000 PERFORM PRINT-DETAIL. NC1244.2 +205100 ADD 1 TO REC-CT. NC1244.2 +205200 PICTURE-TEST-25-C. NC1244.2 +205300 IF EDIT-AREA-20 EQUAL TO "1010" NC1244.2 +205400 PERFORM PASS NC1244.2 +205500 PERFORM PRINT-DETAIL NC1244.2 +205600 ELSE PERFORM FAIL NC1244.2 +205700 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +205800 MOVE "1010" TO CORRECT-A NC1244.2 +205900 PERFORM PRINT-DETAIL. NC1244.2 +206000 ADD 1 TO REC-CT. NC1244.2 +206100 PICTURE-TEST-25-D. NC1244.2 +206200 IF EDIT-AREA-21 EQUAL TO "1010" NC1244.2 +206300 PERFORM PASS NC1244.2 +206400 PERFORM PRINT-DETAIL NC1244.2 +206500 ELSE PERFORM FAIL NC1244.2 +206600 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +206700 MOVE "1010" TO CORRECT-A NC1244.2 +206800 PERFORM PRINT-DETAIL. NC1244.2 +206900 ADD 1 TO REC-CT. NC1244.2 +207000 PICTURE-TEST-25-E. NC1244.2 +207100 IF EDIT-AREA-22 EQUAL TO "1010" NC1244.2 +207200 PERFORM PASS NC1244.2 +207300 PERFORM PRINT-DETAIL NC1244.2 +207400 ELSE PERFORM FAIL NC1244.2 +207500 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +207600 MOVE "1010" TO CORRECT-A NC1244.2 +207700 PERFORM PRINT-DETAIL. NC1244.2 +207800 ADD 1 TO REC-CT. NC1244.2 +207900 PICTURE-TEST-25-F. NC1244.2 +208000 IF EDIT-AREA-23 EQUAL TO "10.20" NC1244.2 +208100 PERFORM PASS NC1244.2 +208200 PERFORM PRINT-DETAIL NC1244.2 +208300 ELSE PERFORM FAIL NC1244.2 +208400 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +208500 MOVE "10.20" TO CORRECT-A NC1244.2 +208600 PERFORM PRINT-DETAIL. NC1244.2 +208700 ADD 1 TO REC-CT. NC1244.2 +208800 PICTURE-TEST-25-G. NC1244.2 +208900 IF EDIT-AREA-24 EQUAL TO "1,010" NC1244.2 +209000 PERFORM PASS NC1244.2 +209100 PERFORM PRINT-DETAIL NC1244.2 +209200 ELSE PERFORM FAIL NC1244.2 +209300 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +209400 MOVE "1,010" TO CORRECT-A NC1244.2 +209500 PERFORM PRINT-DETAIL. NC1244.2 +209600 PICTURE-INIT-26. NC1244.2 +209700 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +209800 MOVE "PCTRE-TST-26" TO PAR-NAME. NC1244.2 +209900 MOVE "PICTURE CHARACTER Z" TO FEATURE. NC1244.2 +210000 MOVE .01 TO WORK-AREA-26. NC1244.2 +210100 MOVE 1 TO REC-CT. NC1244.2 +210200 PICTURE-TEST-26. NC1244.2 +210300 MOVE WORK-AREA-26 TO EDIT-AREA-18 EDIT-AREA-19 EDIT-AREA-20NC1244.2 +210400 EDIT-AREA-21 EDIT-AREA-22 EDIT-AREA-23NC1244.2 +210500 EDIT-AREA-24. NC1244.2 +210600 GO TO PICTURE-TEST-26-A. NC1244.2 +210700 PICTURE-DELETE-26. NC1244.2 +210800 PERFORM DE-LETE. NC1244.2 +210900 PERFORM PRINT-DETAIL. NC1244.2 +211000 GO TO PICTURE-INIT-27. NC1244.2 +211100 PICTURE-TEST-26-A. NC1244.2 +211200 IF EDIT-AREA-18 EQUAL TO "0000" NC1244.2 +211300 PERFORM PASS NC1244.2 +211400 PERFORM PRINT-DETAIL NC1244.2 +211500 ELSE PERFORM FAIL NC1244.2 +211600 MOVE EDIT-AREA-18 TO COMPUTED-A NC1244.2 +211700 MOVE "0000" TO CORRECT-A NC1244.2 +211800 PERFORM PRINT-DETAIL. NC1244.2 +211900 ADD 1 TO REC-CT. NC1244.2 +212000 PICTURE-TEST-26-B. NC1244.2 +212100 IF EDIT-AREA-19 EQUAL TO " 000" NC1244.2 +212200 PERFORM PASS NC1244.2 +212300 PERFORM PRINT-DETAIL NC1244.2 +212400 ELSE PERFORM FAIL NC1244.2 +212500 MOVE EDIT-AREA-19 TO COMPUTED-A NC1244.2 +212600 MOVE " 000" TO CORRECT-A NC1244.2 +212700 PERFORM PRINT-DETAIL. NC1244.2 +212800 ADD 1 TO REC-CT. NC1244.2 +212900 PICTURE-TEST-26-C. NC1244.2 +213000 IF EDIT-AREA-20 EQUAL TO " 00" NC1244.2 +213100 PERFORM PASS NC1244.2 +213200 PERFORM PRINT-DETAIL NC1244.2 +213300 ELSE PERFORM FAIL NC1244.2 +213400 MOVE EDIT-AREA-20 TO COMPUTED-A NC1244.2 +213500 MOVE " 00" TO CORRECT-A NC1244.2 +213600 PERFORM PRINT-DETAIL. NC1244.2 +213700 ADD 1 TO REC-CT. NC1244.2 +213800 IF EDIT-AREA-21 EQUAL TO " 0" NC1244.2 +213900 PERFORM PASS NC1244.2 +214000 PERFORM PRINT-DETAIL NC1244.2 +214100 ELSE PERFORM FAIL NC1244.2 +214200 MOVE EDIT-AREA-21 TO COMPUTED-A NC1244.2 +214300 MOVE " 0" TO CORRECT-A NC1244.2 +214400 PERFORM PRINT-DETAIL. NC1244.2 +214500 ADD 1 TO REC-CT. NC1244.2 +214600 PICTURE-TEST-26-E. NC1244.2 +214700 IF EDIT-AREA-22 EQUAL TO " " NC1244.2 +214800 PERFORM PASS NC1244.2 +214900 PERFORM PRINT-DETAIL NC1244.2 +215000 ELSE PERFORM FAIL NC1244.2 +215100 MOVE EDIT-AREA-22 TO COMPUTED-A NC1244.2 +215200 MOVE "SPACES" TO CORRECT-A NC1244.2 +215300 PERFORM PRINT-DETAIL. NC1244.2 +215400 ADD 1 TO REC-CT. NC1244.2 +215500 PICTURE-TEST-26-F. NC1244.2 +215600 IF EDIT-AREA-23 EQUAL TO " .01" NC1244.2 +215700 PERFORM PASS NC1244.2 +215800 PERFORM PRINT-DETAIL NC1244.2 +215900 ELSE PERFORM FAIL NC1244.2 +216000 MOVE EDIT-AREA-23 TO COMPUTED-A NC1244.2 +216100 MOVE " .01" TO CORRECT-A NC1244.2 +216200 PERFORM PRINT-DETAIL. NC1244.2 +216300 ADD 1 TO REC-CT. NC1244.2 +216400 PICTURE-TEST-26-G. NC1244.2 +216500 IF EDIT-AREA-24 EQUAL TO " " NC1244.2 +216600 PERFORM PASS NC1244.2 +216700 PERFORM PRINT-DETAIL NC1244.2 +216800 ELSE PERFORM FAIL NC1244.2 +216900 MOVE EDIT-AREA-24 TO COMPUTED-A NC1244.2 +217000 MOVE "SPACES" TO CORRECT-A NC1244.2 +217100 PERFORM PRINT-DETAIL. NC1244.2 +217200 PICTURE-INIT-27. NC1244.2 +217300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +217400 MOVE ZERO TO REC-CT. NC1244.2 +217500 MOVE 200 TO WORK-AREA-27. NC1244.2 +217600 MOVE SPACE TO WORK-AREA-27A. NC1244.2 +217700 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +217800 PICTURE-TEST-27-0. NC1244.2 +217900 MOVE WORK-AREA-27 TO WORK-AREA-27A. NC1244.2 +218000 PICTURE-TEST-27-1. NC1244.2 +218100 IF WORK-AREA-27A EQUAL TO "200" NC1244.2 +218200 PERFORM PASS NC1244.2 +218300 ELSE GO TO PICTURE-FAIL-27. NC1244.2 +218400 GO TO PICTURE-WRITE-27. NC1244.2 +218500 PICTURE-DELETE-27. NC1244.2 +218600 PERFORM DE-LETE. NC1244.2 +218700 GO TO PICTURE-WRITE-27. NC1244.2 +218800 PICTURE-FAIL-27. NC1244.2 +218900 PERFORM FAIL. NC1244.2 +219000 MOVE WORK-AREA-27A TO COMPUTED-A. NC1244.2 +219100 MOVE "200" TO CORRECT-A. NC1244.2 +219200 PICTURE-WRITE-27. NC1244.2 +219300 MOVE "PICTURE-TEST-27" TO PAR-NAME. NC1244.2 +219400 PERFORM PRINT-DETAIL. NC1244.2 +219500 PICTURE-INIT-28. NC1244.2 +219600 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +219700 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +219800 MOVE 567 TO WORK-AREA-28. NC1244.2 +219900 MOVE ZERO TO WORK-AREA-28A. NC1244.2 +220000 PICTURE-TEST-28-0. NC1244.2 +220100 MOVE WORK-AREA-28 TO WORK-AREA-28A. NC1244.2 +220200 PICTURE-TEST-28-1. NC1244.2 +220300 IF WORK-AREA-28A EQUAL TO 500 NC1244.2 +220400 PERFORM PASS NC1244.2 +220500 ELSE GO TO PICTURE-FAIL-28. NC1244.2 +220600 GO TO PICTURE-WRITE-28. NC1244.2 +220700 PICTURE-DELETE-28. NC1244.2 +220800 PERFORM DE-LETE. NC1244.2 +220900 GO TO PICTURE-WRITE-28. NC1244.2 +221000 PICTURE-FAIL-28. NC1244.2 +221100 PERFORM FAIL. NC1244.2 +221200 MOVE WORK-AREA-28A TO COMPUTED-A. NC1244.2 +221300 MOVE 500 TO CORRECT-18V0. NC1244.2 +221400 PICTURE-WRITE-28. NC1244.2 +221500 MOVE "PICTURE-TEST-28" TO PAR-NAME. NC1244.2 +221600 PERFORM PRINT-DETAIL. NC1244.2 +221700 PICTURE-INIT-29. NC1244.2 +221800 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +221900 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +222000 MOVE 123 TO WORK-AREA-29. NC1244.2 +222100 MOVE ZERO TO WORK-AREA-29A. NC1244.2 +222200 MOVE SPACE TO WORK-AREA-29B. NC1244.2 +222300 PICTURE-TEST-29. NC1244.2 +222400 MOVE WORK-AREA-29 TO WORK-AREA-29A. NC1244.2 +222500 MOVE WORK-AREA-29A TO WORK-AREA-29B. NC1244.2 +222600 IF WORK-AREA-29B EQUAL TO "100" NC1244.2 +222700 PERFORM PASS NC1244.2 +222800 ELSE GO TO PICTURE-FAIL-29. NC1244.2 +222900 GO TO PICTURE-WRITE-29. NC1244.2 +223000 PICTURE-DELETE-29. NC1244.2 +223100 PERFORM DE-LETE. NC1244.2 +223200 GO TO PICTURE-WRITE-29. NC1244.2 +223300 PICTURE-FAIL-29. NC1244.2 +223400 PERFORM FAIL. NC1244.2 +223500 MOVE WORK-AREA-29B TO COMPUTED-A. NC1244.2 +223600 MOVE "100" TO CORRECT-A. NC1244.2 +223700 PICTURE-WRITE-29. NC1244.2 +223800 MOVE "PICTURE-TEST-29" TO PAR-NAME. NC1244.2 +223900 PERFORM PRINT-DETAIL. NC1244.2 +224000 PICTURE-INIT-30. NC1244.2 +224100 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +224200 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +224300 MOVE 00900 TO WORK-AREA-30. NC1244.2 +224400 MOVE ZERO TO WORK-AREA-30A. NC1244.2 +224500 PICTURE-TEST-30-0. NC1244.2 +224600 MOVE WORK-AREA-30 TO WORK-AREA-30A. NC1244.2 +224700 PICTURE-TEST-30-1. NC1244.2 +224800 IF WORK-AREA-30A EQUAL TO " 9" NC1244.2 +224900 PERFORM PASS NC1244.2 +225000 ELSE GO TO PICTURE-FAIL-30. NC1244.2 +225100 GO TO PICTURE-WRITE-30. NC1244.2 +225200 PICTURE-DELETE-30. NC1244.2 +225300 PERFORM DE-LETE. NC1244.2 +225400 GO TO PICTURE-WRITE-30. NC1244.2 +225500 PICTURE-FAIL-30. NC1244.2 +225600 PERFORM FAIL. NC1244.2 +225700 MOVE WORK-AREA-30A TO COMPUTED-A. NC1244.2 +225800 MOVE " 9" TO CORRECT-A. NC1244.2 +225900 PICTURE-WRITE-30. NC1244.2 +226000 MOVE "PICTURE-TEST-30" TO PAR-NAME. NC1244.2 +226100 PERFORM PRINT-DETAIL. NC1244.2 +226200 PICTURE-INIT-31. NC1244.2 +226300 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +226400 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +226500 MOVE 01200 TO WORK-AREA-31. NC1244.2 +226600 MOVE ZERO TO WORK-AREA-31A. NC1244.2 +226700 MOVE SPACE TO WORK-AREA-31B. NC1244.2 +226800 PICTURE-TEST-31. NC1244.2 +226900 MOVE WORK-AREA-31 TO WORK-AREA-31A. NC1244.2 +227000 MOVE WORK-AREA-31A TO WORK-AREA-31B. NC1244.2 +227100 IF WORK-AREA-31B EQUAL TO " 12 " NC1244.2 +227200 PERFORM PASS NC1244.2 +227300 ELSE GO TO PICTURE-FAIL-31. NC1244.2 +227400 GO TO PICTURE-WRITE-31. NC1244.2 +227500 PICTURE-DELETE-31. NC1244.2 +227600 PERFORM DE-LETE. NC1244.2 +227700 GO TO PICTURE-WRITE-31. NC1244.2 +227800 PICTURE-FAIL-31. NC1244.2 +227900 PERFORM FAIL. NC1244.2 +228000 MOVE WORK-AREA-31B TO COMPUTED-A. NC1244.2 +228100 MOVE " 12 " TO CORRECT-A. NC1244.2 +228200 PICTURE-WRITE-31. NC1244.2 +228300 MOVE "PICTURE-TEST-31" TO PAR-NAME. NC1244.2 +228400 PERFORM PRINT-DETAIL. NC1244.2 +228500 PICTURE-INIT-32. NC1244.2 +228600 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +228700 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +228800 MOVE .001 TO WORK-AREA-32. NC1244.2 +228900 MOVE ZERO TO WORK-AREA-32A. NC1244.2 +229000 PICTURE-TEST-32-0. NC1244.2 +229100 MOVE WORK-AREA-32 TO WORK-AREA-32A. NC1244.2 +229200 PICTURE-TEST-32-1. NC1244.2 +229300 IF WORK-AREA-32A EQUAL TO .001 NC1244.2 +229400 PERFORM PASS NC1244.2 +229500 ELSE GO TO PICTURE-FAIL-32. NC1244.2 +229600 GO TO PICTURE-WRITE-32. NC1244.2 +229700 PICTURE-DELETE-32. NC1244.2 +229800 PERFORM DE-LETE. NC1244.2 +229900 GO TO PICTURE-WRITE-32. NC1244.2 +230000 PICTURE-FAIL-32. NC1244.2 +230100 PERFORM FAIL. NC1244.2 +230200 MOVE WORK-AREA-32A TO COMPUTED-0V18. NC1244.2 +230300 MOVE .001 TO CORRECT-0V18. NC1244.2 +230400 PICTURE-WRITE-32. NC1244.2 +230500 MOVE "PICTURE-TEST-32" TO PAR-NAME. NC1244.2 +230600 PERFORM PRINT-DETAIL. NC1244.2 +230700 PICTURE-INIT-33. NC1244.2 +230800 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +230900 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +231000 MOVE .567 TO WORK-AREA-33. NC1244.2 +231100 MOVE ZERO TO WORK-AREA-33A. NC1244.2 +231200 PICTURE-TEST-33-0. NC1244.2 +231300 MOVE WORK-AREA-33 TO WORK-AREA-33A. NC1244.2 +231400 PICTURE-TEST-33-1. NC1244.2 +231500 IF WORK-AREA-33A EQUAL TO .007 NC1244.2 +231600 PERFORM PASS NC1244.2 +231700 ELSE GO TO PICTURE-FAIL-33. NC1244.2 +231800 GO TO PICTURE-WRITE-33. NC1244.2 +231900 PICTURE-DELETE-33. NC1244.2 +232000 PERFORM DE-LETE. NC1244.2 +232100 GO TO PICTURE-WRITE-33. NC1244.2 +232200 PICTURE-FAIL-33. NC1244.2 +232300 PERFORM FAIL. NC1244.2 +232400 MOVE WORK-AREA-33A TO COMPUTED-0V18. NC1244.2 +232500 MOVE .007 TO CORRECT-0V18. NC1244.2 +232600 PICTURE-WRITE-33. NC1244.2 +232700 MOVE "PICTURE-TEST-33" TO PAR-NAME. NC1244.2 +232800 PERFORM PRINT-DETAIL. NC1244.2 +232900 PICTURE-INIT-34. NC1244.2 +233000 MOVE "VI-31" TO ANSI-REFERENCE. NC1244.2 +233100 MOVE "PICTURE CHARACTER P" TO FEATURE. NC1244.2 +233200 MOVE .123 TO WORK-AREA-34. NC1244.2 +233300 MOVE ZERO TO WORK-AREA-34A. NC1244.2 +233400 MOVE ZERO TO WORK-AREA-34B. NC1244.2 +233500 PICTURE-TEST-34. NC1244.2 +233600 MOVE WORK-AREA-34 TO WORK-AREA-34A. NC1244.2 +233700 MOVE WORK-AREA-34A TO WORK-AREA-34B. NC1244.2 +233800 IF WORK-AREA-34B EQUAL TO .003 NC1244.2 +233900 PERFORM PASS NC1244.2 +234000 ELSE GO TO PICTURE-FAIL-34. NC1244.2 +234100 GO TO PICTURE-WRITE-34. NC1244.2 +234200 PICTURE-DELETE-34. NC1244.2 +234300 PERFORM DE-LETE. NC1244.2 +234400 GO TO PICTURE-WRITE-34. NC1244.2 +234500 PICTURE-FAIL-34. NC1244.2 +234600 PERFORM FAIL. NC1244.2 +234700 MOVE WORK-AREA-34B TO COMPUTED-0V18. NC1244.2 +234800 MOVE .003 TO CORRECT-0V18. NC1244.2 +234900 PICTURE-WRITE-34. NC1244.2 +235000 MOVE "PICTURE-TEST-34" TO PAR-NAME. NC1244.2 +235100 PERFORM PRINT-DETAIL. NC1244.2 +235200 CCVS-EXIT SECTION. NC1244.2 +235300 CCVS-999999. NC1244.2 +235400 GO TO CLOSE-FILES. NC1244.2 diff --git a/tests/cobol85/NC/NC125A.CBL b/tests/cobol85/NC/NC125A.CBL new file mode 100755 index 00000000..a18dfa17 --- /dev/null +++ b/tests/cobol85/NC/NC125A.CBL @@ -0,0 +1,750 @@ +000100 IDENTIFICATION DIVISION. NC1254.2 +000200 PROGRAM-ID. NC1254.2 +000300 NC125A. NC1254.2 +000400**************************************************************** NC1254.2 +000500* * NC1254.2 +000600* VALIDATION FOR:- * NC1254.2 +000700* * NC1254.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1254.2 +000900* * NC1254.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1254.2 +001100* * NC1254.2 +001200**************************************************************** NC1254.2 +001300* * NC1254.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1254.2 +001500* * NC1254.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1254.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1254.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1254.2 +001900* * NC1254.2 +002000**************************************************************** NC1254.2 +002100* NC1254.2 +002200* PROGRAM NC125A TESTS THE USE OF PICTURE CHARACTERS NC1254.2 +002300* $ + * . , WITH FORMAT 1 OF THE "MOVE" STATEMENT AND NC1254.2 +002400* FORMAT 2 OF THE "ADD" AND "SUBTRACT" STATEMENTS. NC1254.2 +002500* NC1254.2 +002600 ENVIRONMENT DIVISION. NC1254.2 +002700 CONFIGURATION SECTION. NC1254.2 +002800 SOURCE-COMPUTER. NC1254.2 +002900 Linux. NC1254.2 +003000 OBJECT-COMPUTER. NC1254.2 +003100 Linux. NC1254.2 +003200 INPUT-OUTPUT SECTION. NC1254.2 +003300 FILE-CONTROL. NC1254.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1254.2 +003500 "report.log". NC1254.2 +003600 DATA DIVISION. NC1254.2 +003700 FILE SECTION. NC1254.2 +003800 FD PRINT-FILE. NC1254.2 +003900 01 PRINT-REC PICTURE X(120). NC1254.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1254.2 +004100 WORKING-STORAGE SECTION. NC1254.2 +004200 01 W1. NC1254.2 +004300 02 WRK-EDIT-001 PIC $$,$$$,$$$,$$$,$$$,$$$.99. NC1254.2 +004400 01 W2. NC1254.2 +004500 02 WRK-EDIT-002 PIC ++,+++,+++,+++,+++,+++.99. NC1254.2 +004600 01 W3. NC1254.2 +004700 02 WRK-EDIT-003 PIC --,---,---,---,---,---.99. NC1254.2 +004800 01 W4. NC1254.2 +004900 02 WRK-EDIT-004 PIC *,***,***,***,***,***.99. NC1254.2 +005000 01 W5. NC1254.2 +005100 02 WRK-EDIT-005 PIC 9,9,9,9,9,9,9,9,9,9,9,9,. NC1254.2 +005200 01 W6. NC1254.2 +005300 02 WRK-EDIT-006 PIC 999999999999.. NC1254.2 +005400 01 TBL-001. NC1254.2 +005500 02 FILLER PIC S9(16)V99 VALUE ZERO. NC1254.2 +005600 02 FILLER PIC S9(16)V99 VALUE .01. NC1254.2 +005700 02 FILLER PIC S9(16)V99 VALUE .19. NC1254.2 +005800 02 FILLER PIC S9(16)V99 VALUE 1.00. NC1254.2 +005900 02 FILLER PIC S9(16)V99 VALUE 111.11. NC1254.2 +006000 02 FILLER PIC S9(16)V99 VALUE 9999.11. NC1254.2 +006100 02 FILLER PIC S9(16)V99 VALUE 1010101.99. NC1254.2 +006200 02 FILLER PIC S9(16)V99 VALUE 900000000.11. NC1254.2 +006300 02 FILLER PIC S9(16)V99 VALUE 9999999999.99. NC1254.2 +006400 01 TBL-001-R REDEFINES TBL-001. NC1254.2 +006500 02 TBL-001-O PIC S9(16)V99 OCCURS 9 TIMES. NC1254.2 +006600 01 TBL-002. NC1254.2 +006700 02 FILLER PIC X(25) VALUE " $.00". NC1254.2 +006800 02 FILLER PIC X(25) VALUE " $.01". NC1254.2 +006900 02 FILLER PIC X(25) VALUE " $.19". NC1254.2 +007000 02 FILLER PIC X(25) VALUE " $1.00". NC1254.2 +007100 02 FILLER PIC X(25) VALUE " $111.11". NC1254.2 +007200 02 FILLER PIC X(25) VALUE " $9,999.11". NC1254.2 +007300 02 FILLER PIC X(25) VALUE " $1,010,101.99". NC1254.2 +007400 02 FILLER PIC X(25) VALUE " $900,000,000.11". NC1254.2 +007500 02 FILLER PIC X(25) VALUE " $9,999,999,999.99". NC1254.2 +007600 01 TBL-002-R REDEFINES TBL-002. NC1254.2 +007700 02 TBL-002-O PIC X(25) OCCURS 9 TIMES. NC1254.2 +007800 01 TBL-003. NC1254.2 +007900 02 FILLER PIC X(25) VALUE " +.00". NC1254.2 +008000 02 FILLER PIC X(25) VALUE " +.01". NC1254.2 +008100 02 FILLER PIC X(25) VALUE " +.19". NC1254.2 +008200 02 FILLER PIC X(25) VALUE " +1.00". NC1254.2 +008300 02 FILLER PIC X(25) VALUE " +111.11". NC1254.2 +008400 02 FILLER PIC X(25) VALUE " +9,999.11". NC1254.2 +008500 02 FILLER PIC X(25) VALUE " +1,010,101.99". NC1254.2 +008600 02 FILLER PIC X(25) VALUE " +900,000,000.11". NC1254.2 +008700 02 FILLER PIC X(25) VALUE " +9,999,999,999.99". NC1254.2 +008800 01 TBL-003-R REDEFINES TBL-003. NC1254.2 +008900 02 TBL-003-O PIC X(25) OCCURS 9 TIMES. NC1254.2 +009000 01 TBL-004. NC1254.2 +009100 02 FILLER PIC X(25) VALUE " .00". NC1254.2 +009200 02 FILLER PIC X(25) VALUE " .01". NC1254.2 +009300 02 FILLER PIC X(25) VALUE " .19". NC1254.2 +009400 02 FILLER PIC X(25) VALUE " 1.00". NC1254.2 +009500 02 FILLER PIC X(25) VALUE " 111.11". NC1254.2 +009600 02 FILLER PIC X(25) VALUE " 9,999.11". NC1254.2 +009700 02 FILLER PIC X(25) VALUE " 1,010,101.99". NC1254.2 +009800 02 FILLER PIC X(25) VALUE " 900,000,000.11". NC1254.2 +009900 02 FILLER PIC X(25) VALUE " 9,999,999,999.99". NC1254.2 +010000 01 TBL-004-R REDEFINES TBL-004. NC1254.2 +010100 02 TBL-004-O PIC X(25) OCCURS 9 TIMES. NC1254.2 +010200 01 TBL-005. NC1254.2 +010300 02 FILLER PIC X(24) VALUE "*********************.00". NC1254.2 +010400 02 FILLER PIC X(24) VALUE "*********************.01". NC1254.2 +010500 02 FILLER PIC X(24) VALUE "*********************.19". NC1254.2 +010600 02 FILLER PIC X(24) VALUE "********************1.00". NC1254.2 +010700 02 FILLER PIC X(24) VALUE "******************111.11". NC1254.2 +010800 02 FILLER PIC X(24) VALUE "****************9,999.11". NC1254.2 +010900 02 FILLER PIC X(24) VALUE "************1,010,101.99". NC1254.2 +011000 02 FILLER PIC X(24) VALUE "**********900,000,000.11". NC1254.2 +011100 02 FILLER PIC X(24) VALUE "********9,999,999,999.99". NC1254.2 +011200 01 TBL-005-R REDEFINES TBL-005. NC1254.2 +011300 02 TBL-005-O PIC X(24) OCCURS 9 TIMES. NC1254.2 +011400 01 TBL-006. NC1254.2 +011500 02 FILLER PIC X(25) VALUE " .00". NC1254.2 +011600 02 FILLER PIC X(25) VALUE " -.01". NC1254.2 +011700 02 FILLER PIC X(25) VALUE " -.19". NC1254.2 +011800 02 FILLER PIC X(25) VALUE " -1.00". NC1254.2 +011900 02 FILLER PIC X(25) VALUE " -111.11". NC1254.2 +012000 02 FILLER PIC X(25) VALUE " -9,999.11". NC1254.2 +012100 02 FILLER PIC X(25) VALUE " -1,010,101.99". NC1254.2 +012200 02 FILLER PIC X(25) VALUE " -900,000,000.11". NC1254.2 +012300 02 FILLER PIC X(25) VALUE " -9,999,999,999.99". NC1254.2 +012400 01 TBL-006-R REDEFINES TBL-006. NC1254.2 +012500 02 TBL-006-O PIC X(25) OCCURS 9 TIMES. NC1254.2 +012600 01 CTR-1 PIC 999 VALUE 0. NC1254.2 +012700 01 CRT-2 PIC 999 VALUE 9. NC1254.2 +012800 01 CTR-3 PIC 999 VALUE 0. NC1254.2 +012900 01 TEST-RESULTS. NC1254.2 +013000 02 FILLER PIC X VALUE SPACE. NC1254.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. NC1254.2 +013200 02 FILLER PIC X VALUE SPACE. NC1254.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. NC1254.2 +013400 02 FILLER PIC X VALUE SPACE. NC1254.2 +013500 02 PAR-NAME. NC1254.2 +013600 03 FILLER PIC X(19) VALUE SPACE. NC1254.2 +013700 03 PARDOT-X PIC X VALUE SPACE. NC1254.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. NC1254.2 +013900 02 FILLER PIC X(8) VALUE SPACE. NC1254.2 +014000 02 RE-MARK PIC X(61). NC1254.2 +014100 01 TEST-COMPUTED. NC1254.2 +014200 02 FILLER PIC X(30) VALUE SPACE. NC1254.2 +014300 02 FILLER PIC X(17) VALUE NC1254.2 +014400 " COMPUTED=". NC1254.2 +014500 02 COMPUTED-X. NC1254.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1254.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A NC1254.2 +014800 PIC -9(9).9(9). NC1254.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1254.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1254.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1254.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. NC1254.2 +015300 04 COMPUTED-18V0 PIC -9(18). NC1254.2 +015400 04 FILLER PIC X. NC1254.2 +015500 03 FILLER PIC X(50) VALUE SPACE. NC1254.2 +015600 01 TEST-CORRECT. NC1254.2 +015700 02 FILLER PIC X(30) VALUE SPACE. NC1254.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". NC1254.2 +015900 02 CORRECT-X. NC1254.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. NC1254.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1254.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1254.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1254.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1254.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. NC1254.2 +016600 04 CORRECT-18V0 PIC -9(18). NC1254.2 +016700 04 FILLER PIC X. NC1254.2 +016800 03 FILLER PIC X(2) VALUE SPACE. NC1254.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1254.2 +017000 01 CCVS-C-1. NC1254.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1254.2 +017200- "SS PARAGRAPH-NAME NC1254.2 +017300- " REMARKS". NC1254.2 +017400 02 FILLER PIC X(20) VALUE SPACE. NC1254.2 +017500 01 CCVS-C-2. NC1254.2 +017600 02 FILLER PIC X VALUE SPACE. NC1254.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". NC1254.2 +017800 02 FILLER PIC X(15) VALUE SPACE. NC1254.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". NC1254.2 +018000 02 FILLER PIC X(94) VALUE SPACE. NC1254.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1254.2 +018200 01 REC-CT PIC 99 VALUE ZERO. NC1254.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1254.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1254.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1254.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1254.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1254.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1254.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1254.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1254.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1254.2 +019200 01 CCVS-H-1. NC1254.2 +019300 02 FILLER PIC X(39) VALUE SPACES. NC1254.2 +019400 02 FILLER PIC X(42) VALUE NC1254.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1254.2 +019600 02 FILLER PIC X(39) VALUE SPACES. NC1254.2 +019700 01 CCVS-H-2A. NC1254.2 +019800 02 FILLER PIC X(40) VALUE SPACE. NC1254.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1254.2 +020000 02 FILLER PIC XXXX VALUE NC1254.2 +020100 "4.2 ". NC1254.2 +020200 02 FILLER PIC X(28) VALUE NC1254.2 +020300 " COPY - NOT FOR DISTRIBUTION". NC1254.2 +020400 02 FILLER PIC X(41) VALUE SPACE. NC1254.2 +020500 NC1254.2 +020600 01 CCVS-H-2B. NC1254.2 +020700 02 FILLER PIC X(15) VALUE NC1254.2 +020800 "TEST RESULT OF ". NC1254.2 +020900 02 TEST-ID PIC X(9). NC1254.2 +021000 02 FILLER PIC X(4) VALUE NC1254.2 +021100 " IN ". NC1254.2 +021200 02 FILLER PIC X(12) VALUE NC1254.2 +021300 " HIGH ". NC1254.2 +021400 02 FILLER PIC X(22) VALUE NC1254.2 +021500 " LEVEL VALIDATION FOR ". NC1254.2 +021600 02 FILLER PIC X(58) VALUE NC1254.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1254.2 +021800 01 CCVS-H-3. NC1254.2 +021900 02 FILLER PIC X(34) VALUE NC1254.2 +022000 " FOR OFFICIAL USE ONLY ". NC1254.2 +022100 02 FILLER PIC X(58) VALUE NC1254.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1254.2 +022300 02 FILLER PIC X(28) VALUE NC1254.2 +022400 " COPYRIGHT 1985 ". NC1254.2 +022500 01 CCVS-E-1. NC1254.2 +022600 02 FILLER PIC X(52) VALUE SPACE. NC1254.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1254.2 +022800 02 ID-AGAIN PIC X(9). NC1254.2 +022900 02 FILLER PIC X(45) VALUE SPACES. NC1254.2 +023000 01 CCVS-E-2. NC1254.2 +023100 02 FILLER PIC X(31) VALUE SPACE. NC1254.2 +023200 02 FILLER PIC X(21) VALUE SPACE. NC1254.2 +023300 02 CCVS-E-2-2. NC1254.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1254.2 +023500 03 FILLER PIC X VALUE SPACE. NC1254.2 +023600 03 ENDER-DESC PIC X(44) VALUE NC1254.2 +023700 "ERRORS ENCOUNTERED". NC1254.2 +023800 01 CCVS-E-3. NC1254.2 +023900 02 FILLER PIC X(22) VALUE NC1254.2 +024000 " FOR OFFICIAL USE ONLY". NC1254.2 +024100 02 FILLER PIC X(12) VALUE SPACE. NC1254.2 +024200 02 FILLER PIC X(58) VALUE NC1254.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1254.2 +024400 02 FILLER PIC X(13) VALUE SPACE. NC1254.2 +024500 02 FILLER PIC X(15) VALUE NC1254.2 +024600 " COPYRIGHT 1985". NC1254.2 +024700 01 CCVS-E-4. NC1254.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1254.2 +024900 02 FILLER PIC X(4) VALUE " OF ". NC1254.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1254.2 +025100 02 FILLER PIC X(40) VALUE NC1254.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". NC1254.2 +025300 01 XXINFO. NC1254.2 +025400 02 FILLER PIC X(19) VALUE NC1254.2 +025500 "*** INFORMATION ***". NC1254.2 +025600 02 INFO-TEXT. NC1254.2 +025700 04 FILLER PIC X(8) VALUE SPACE. NC1254.2 +025800 04 XXCOMPUTED PIC X(20). NC1254.2 +025900 04 FILLER PIC X(5) VALUE SPACE. NC1254.2 +026000 04 XXCORRECT PIC X(20). NC1254.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). NC1254.2 +026200 01 HYPHEN-LINE. NC1254.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. NC1254.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************NC1254.2 +026500- "*****************************************". NC1254.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************NC1254.2 +026700- "******************************". NC1254.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE NC1254.2 +026900 "NC125A". NC1254.2 +027000 PROCEDURE DIVISION. NC1254.2 +027100 CCVS1 SECTION. NC1254.2 +027200 OPEN-FILES. NC1254.2 +027300 OPEN OUTPUT PRINT-FILE. NC1254.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1254.2 +027500 MOVE SPACE TO TEST-RESULTS. NC1254.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1254.2 +027700 GO TO CCVS1-EXIT. NC1254.2 +027800 CLOSE-FILES. NC1254.2 +027900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1254.2 +028000 TERMINATE-CCVS. NC1254.2 +028100*S EXIT PROGRAM. NC1254.2 +028200*SERMINATE-CALL. NC1254.2 +028300 STOP RUN. NC1254.2 +028400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1254.2 +028500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1254.2 +028600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1254.2 +028700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1254.2 +028800 MOVE "****TEST DELETED****" TO RE-MARK. NC1254.2 +028900 PRINT-DETAIL. NC1254.2 +029000 IF REC-CT NOT EQUAL TO ZERO NC1254.2 +029100 MOVE "." TO PARDOT-X NC1254.2 +029200 MOVE REC-CT TO DOTVALUE. NC1254.2 +029300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1254.2 +029400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1254.2 +029500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1254.2 +029600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1254.2 +029700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1254.2 +029800 MOVE SPACE TO CORRECT-X. NC1254.2 +029900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1254.2 +030000 MOVE SPACE TO RE-MARK. NC1254.2 +030100 HEAD-ROUTINE. NC1254.2 +030200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +030300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +030400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1254.2 +030500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1254.2 +030600 COLUMN-NAMES-ROUTINE. NC1254.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +031000 END-ROUTINE. NC1254.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1254.2 +031200 END-RTN-EXIT. NC1254.2 +031300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +031400 END-ROUTINE-1. NC1254.2 +031500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1254.2 +031600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1254.2 +031700 ADD PASS-COUNTER TO ERROR-HOLD. NC1254.2 +031800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1254.2 +031900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1254.2 +032000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1254.2 +032100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1254.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1254.2 +032300 END-ROUTINE-12. NC1254.2 +032400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1254.2 +032500 IF ERROR-COUNTER IS EQUAL TO ZERO NC1254.2 +032600 MOVE "NO " TO ERROR-TOTAL NC1254.2 +032700 ELSE NC1254.2 +032800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1254.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1254.2 +033000 PERFORM WRITE-LINE. NC1254.2 +033100 END-ROUTINE-13. NC1254.2 +033200 IF DELETE-COUNTER IS EQUAL TO ZERO NC1254.2 +033300 MOVE "NO " TO ERROR-TOTAL ELSE NC1254.2 +033400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1254.2 +033500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1254.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +033700 IF INSPECT-COUNTER EQUAL TO ZERO NC1254.2 +033800 MOVE "NO " TO ERROR-TOTAL NC1254.2 +033900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1254.2 +034000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1254.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +034200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1254.2 +034300 WRITE-LINE. NC1254.2 +034400 ADD 1 TO RECORD-COUNT. NC1254.2 +034500 IF RECORD-COUNT GREATER 42 NC1254.2 +034600 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1254.2 +034700 MOVE SPACE TO DUMMY-RECORD NC1254.2 +034800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1254.2 +034900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1254.2 +035000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1254.2 +035100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1254.2 +035200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1254.2 +035300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1254.2 +035400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1254.2 +035500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1254.2 +035600 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1254.2 +035700 MOVE ZERO TO RECORD-COUNT. NC1254.2 +035800 PERFORM WRT-LN. NC1254.2 +035900 WRT-LN. NC1254.2 +036000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1254.2 +036100 MOVE SPACE TO DUMMY-RECORD. NC1254.2 +036200 BLANK-LINE-PRINT. NC1254.2 +036300 PERFORM WRT-LN. NC1254.2 +036400 FAIL-ROUTINE. NC1254.2 +036500 IF COMPUTED-X NOT EQUAL TO SPACE NC1254.2 +036600 GO TO FAIL-ROUTINE-WRITE. NC1254.2 +036700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1254.2 +036800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1254.2 +036900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1254.2 +037000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +037100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1254.2 +037200 GO TO FAIL-ROUTINE-EX. NC1254.2 +037300 FAIL-ROUTINE-WRITE. NC1254.2 +037400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1254.2 +037500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1254.2 +037600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1254.2 +037700 MOVE SPACES TO COR-ANSI-REFERENCE. NC1254.2 +037800 FAIL-ROUTINE-EX. EXIT. NC1254.2 +037900 BAIL-OUT. NC1254.2 +038000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1254.2 +038100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1254.2 +038200 BAIL-OUT-WRITE. NC1254.2 +038300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1254.2 +038400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1254.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1254.2 +038600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1254.2 +038700 BAIL-OUT-EX. EXIT. NC1254.2 +038800 CCVS1-EXIT. NC1254.2 +038900 EXIT. NC1254.2 +039000 SECT-NC125A-001 SECTION. NC1254.2 +039100 EDI-TEST-GF1. NC1254.2 +039200 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +039300 MOVE "EDI-TEST-GF1" TO PAR-NAME. NC1254.2 +039400 MOVE "l EDIT MOVE" TO FEATURE. NC1254.2 +039500 MOVE 0 TO REC-CT. NC1254.2 +039600 MOVE 0 TO CTR-1. NC1254.2 +039700 MOVE ZERO TO TBL-001-O (1). NC1254.2 +039800 MOVE .01 TO TBL-001-O (2). NC1254.2 +039900 PERFORM EDI-TEST-GF1-R CRT-2 TIMES NC1254.2 +040000 GO TO EDI-TEST-GF1-EXIT. NC1254.2 +040100 EDI-TEST-GF1-DELETE. NC1254.2 +040200 PERFORM DE-LETE. NC1254.2 +040300 PERFORM PRINT-DETAIL. NC1254.2 +040400 GO TO EDI-TEST-GF1-EXIT. NC1254.2 +040500 EDI-TEST-GF1-R. NC1254.2 +040600 ADD 1 TO REC-CT. NC1254.2 +040700 ADD 1 TO CTR-1. NC1254.2 +040800 MOVE TBL-001-O (CTR-1) TO WRK-EDIT-001. NC1254.2 +040900 IF WRK-EDIT-001 EQUAL TO TBL-002-O (CTR-1) PERFORM PASS NC1254.2 +041000 ELSE MOVE W1 TO COMPUTED-X MOVE TBL-002-O (CTR-1) TO NC1254.2 +041100 CORRECT-X NC1254.2 +041200 PERFORM FAIL. NC1254.2 +041300 PERFORM PRINT-DETAIL. NC1254.2 +041400 EDI-TEST-GF1-EXIT. NC1254.2 +041500 EXIT. NC1254.2 +041600 EDI-TEST-GF2. NC1254.2 +041700 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +041800 MOVE "EDI-TEST-GF2" TO PAR-NAME. NC1254.2 +041900 MOVE "+ EDIT MOVE" TO FEATURE. NC1254.2 +042000 MOVE 0 TO REC-CT. NC1254.2 +042100 MOVE 0 TO CTR-1. NC1254.2 +042200 MOVE ZERO TO TBL-001-O (1). NC1254.2 +042300 MOVE .01 TO TBL-001-O (2). NC1254.2 +042400 PERFORM EDI-TEST-GF2-R CRT-2 TIMES NC1254.2 +042500 GO TO EDI-TEST-GF2-EXIT. NC1254.2 +042600 EDI-TEST-GF2-DELETE. NC1254.2 +042700 PERFORM DE-LETE. NC1254.2 +042800 PERFORM PRINT-DETAIL. NC1254.2 +042900 GO TO EDI-TEST-GF2-EXIT. NC1254.2 +043000 EDI-TEST-GF2-R. NC1254.2 +043100 ADD 1 TO REC-CT. NC1254.2 +043200 ADD 1 TO CTR-1. NC1254.2 +043300 MOVE TBL-001-O (CTR-1) TO WRK-EDIT-002. NC1254.2 +043400 IF WRK-EDIT-002 EQUAL TO TBL-003-O (CTR-1) PERFORM PASS NC1254.2 +043500 ELSE MOVE W2 TO COMPUTED-X MOVE TBL-003-O (CTR-1) TO NC1254.2 +043600 CORRECT-X NC1254.2 +043700 PERFORM FAIL. NC1254.2 +043800 PERFORM PRINT-DETAIL. NC1254.2 +043900 EDI-TEST-GF2-EXIT. NC1254.2 +044000 EXIT. NC1254.2 +044100 EDI-TEST-GF3. NC1254.2 +044200 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +044300 MOVE "EDI-TEST-GF3" TO PAR-NAME. NC1254.2 +044400 MOVE "- EDIT MOVE" TO FEATURE. NC1254.2 +044500 MOVE 0 TO REC-CT. NC1254.2 +044600 MOVE 0 TO CTR-1. NC1254.2 +044700 MOVE ZERO TO TBL-001-O (1). NC1254.2 +044800 MOVE .01 TO TBL-001-O (2). NC1254.2 +044900 PERFORM EDI-TEST-GF3-R CRT-2 TIMES NC1254.2 +045000 GO TO EDI-TEST-GF3-EXIT. NC1254.2 +045100 EDI-TEST-GF3-DELETE. NC1254.2 +045200 PERFORM DE-LETE. NC1254.2 +045300 PERFORM PRINT-DETAIL. NC1254.2 +045400 GO TO EDI-TEST-GF3-EXIT. NC1254.2 +045500 EDI-TEST-GF3-R. NC1254.2 +045600 ADD 1 TO REC-CT. NC1254.2 +045700 ADD 1 TO CTR-1. NC1254.2 +045800 MOVE TBL-001-O (CTR-1) TO WRK-EDIT-003. NC1254.2 +045900 IF WRK-EDIT-003 EQUAL TO TBL-004-O (CTR-1) PERFORM PASS NC1254.2 +046000 ELSE MOVE W3 TO COMPUTED-X MOVE TBL-004-O (CTR-1) TO NC1254.2 +046100 CORRECT-X NC1254.2 +046200 PERFORM FAIL. NC1254.2 +046300 PERFORM PRINT-DETAIL. NC1254.2 +046400 EDI-TEST-GF3-EXIT. NC1254.2 +046500 EXIT. NC1254.2 +046600 EDI-TEST-GF4. NC1254.2 +046700 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +046800 MOVE "EDI-TEST-GF4" TO PAR-NAME. NC1254.2 +046900 MOVE "* EDIT MOVE" TO FEATURE. NC1254.2 +047000 MOVE 0 TO REC-CT. NC1254.2 +047100 MOVE 0 TO CTR-1. NC1254.2 +047200 MOVE ZERO TO TBL-001-O (1). NC1254.2 +047300 MOVE .01 TO TBL-001-O (2). NC1254.2 +047400 PERFORM EDI-TEST-GF4-R CRT-2 TIMES NC1254.2 +047500 GO TO EDI-TEST-GF4-EXIT. NC1254.2 +047600 EDI-TEST-GF4-DELETE. NC1254.2 +047700 PERFORM DE-LETE. NC1254.2 +047800 PERFORM PRINT-DETAIL. NC1254.2 +047900 GO TO EDI-TEST-GF4-EXIT. NC1254.2 +048000 EDI-TEST-GF4-R. NC1254.2 +048100 ADD 1 TO REC-CT. NC1254.2 +048200 ADD 1 TO CTR-1. NC1254.2 +048300 MOVE TBL-001-O (CTR-1) TO WRK-EDIT-004. NC1254.2 +048400 IF WRK-EDIT-004 EQUAL TO TBL-005-O (CTR-1) PERFORM PASS NC1254.2 +048500 ELSE MOVE W4 TO COMPUTED-X MOVE TBL-005-O (CTR-1) TO NC1254.2 +048600 CORRECT-X NC1254.2 +048700 PERFORM FAIL. NC1254.2 +048800 PERFORM PRINT-DETAIL. NC1254.2 +048900 EDI-TEST-GF4-EXIT. NC1254.2 +049000 EXIT. NC1254.2 +049100 EDI-TEST-GF5. NC1254.2 +049200 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +049300 MOVE "EDI-TEST-GF5" TO PAR-NAME. NC1254.2 +049400 MOVE "l EDIT ADD" TO FEATURE. NC1254.2 +049500 MOVE 0 TO CTR-1. NC1254.2 +049600 MOVE 0 TO CTR-3. NC1254.2 +049700 MOVE 0 TO REC-CT. NC1254.2 +049800 MOVE ZERO TO TBL-001-O (1). NC1254.2 +049900 MOVE .01 TO TBL-001-O (2). NC1254.2 +050000 PERFORM EDI-TEST-GF5-R CRT-2 TIMES NC1254.2 +050100 GO TO EDI-TEST-GF5-EXIT. NC1254.2 +050200 EDI-TEST-GF5-DELETE. NC1254.2 +050300 PERFORM DE-LETE. NC1254.2 +050400 PERFORM PRINT-DETAIL. NC1254.2 +050500 GO TO EDI-TEST-GF5-EXIT. NC1254.2 +050600 EDI-TEST-GF5-R. NC1254.2 +050700 ADD 1 TO REC-CT. NC1254.2 +050800 ADD 1 TO CTR-1. NC1254.2 +050900 ADD TBL-001-O (CTR-1) CTR-3 GIVING WRK-EDIT-001. NC1254.2 +051000 IF WRK-EDIT-001 EQUAL TO TBL-002-O (CTR-1) PERFORM PASS NC1254.2 +051100 ELSE MOVE W1 TO COMPUTED-X MOVE TBL-002-O (CTR-1) TO NC1254.2 +051200 CORRECT-X NC1254.2 +051300 PERFORM FAIL. NC1254.2 +051400 PERFORM PRINT-DETAIL. NC1254.2 +051500 EDI-TEST-GF5-EXIT. NC1254.2 +051600 EXIT. NC1254.2 +051700 EDI-TEST-GF6. NC1254.2 +051800 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +051900 MOVE "EDI-TEST-GF6" TO PAR-NAME. NC1254.2 +052000 MOVE "+ EDIT ADD" TO FEATURE. NC1254.2 +052100 MOVE 0 TO CTR-1. NC1254.2 +052200 MOVE 0 TO CTR-3. NC1254.2 +052300 MOVE 0 TO REC-CT. NC1254.2 +052400 MOVE ZERO TO TBL-001-O (1). NC1254.2 +052500 MOVE .01 TO TBL-001-O (2). NC1254.2 +052600 PERFORM EDI-TEST-GF6-R CRT-2 TIMES NC1254.2 +052700 GO TO EDI-TEST-GF6-EXIT. NC1254.2 +052800 EDI-TEST-GF6-DELETE. NC1254.2 +052900 PERFORM DE-LETE. NC1254.2 +053000 PERFORM PRINT-DETAIL. NC1254.2 +053100 GO TO EDI-TEST-GF6-EXIT. NC1254.2 +053200 EDI-TEST-GF6-R. NC1254.2 +053300 ADD 1 TO REC-CT. NC1254.2 +053400 ADD 1 TO CTR-1. NC1254.2 +053500 ADD TBL-001-O (CTR-1) CTR-3 GIVING WRK-EDIT-002. NC1254.2 +053600 IF WRK-EDIT-002 EQUAL TO TBL-003-O (CTR-1) PERFORM PASS NC1254.2 +053700 ELSE MOVE W2 TO COMPUTED-X MOVE TBL-003-O (CTR-1) TO NC1254.2 +053800 CORRECT-X NC1254.2 +053900 PERFORM FAIL. NC1254.2 +054000 PERFORM PRINT-DETAIL. NC1254.2 +054100 EDI-TEST-GF6-EXIT. NC1254.2 +054200 EXIT. NC1254.2 +054300 EDI-TEST-GF7. NC1254.2 +054400 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +054500 MOVE "EDI-TEST-GF7" TO PAR-NAME. NC1254.2 +054600 MOVE "- EDIT ADD" TO FEATURE. NC1254.2 +054700 MOVE 0 TO CTR-1. NC1254.2 +054800 MOVE 0 TO CTR-3. NC1254.2 +054900 MOVE 0 TO REC-CT. NC1254.2 +055000 MOVE ZERO TO TBL-001-O (1). NC1254.2 +055100 MOVE .01 TO TBL-001-O (2). NC1254.2 +055200 PERFORM EDI-TEST-GF7-R CRT-2 TIMES NC1254.2 +055300 GO TO EDI-TEST-GF7-EXIT. NC1254.2 +055400 EDI-TEST-GF7-DELETE. NC1254.2 +055500 PERFORM DE-LETE. NC1254.2 +055600 PERFORM PRINT-DETAIL. NC1254.2 +055700 GO TO EDI-TEST-GF7-EXIT. NC1254.2 +055800 EDI-TEST-GF7-R. NC1254.2 +055900 ADD 1 TO REC-CT. NC1254.2 +056000 ADD 1 TO CTR-1. NC1254.2 +056100 ADD TBL-001-O (CTR-1) CTR-3 GIVING WRK-EDIT-003. NC1254.2 +056200 IF WRK-EDIT-003 EQUAL TO TBL-004-O (CTR-1) PERFORM PASS NC1254.2 +056300 ELSE MOVE W3 TO COMPUTED-X MOVE TBL-004-O (CTR-1) TO NC1254.2 +056400 CORRECT-X NC1254.2 +056500 PERFORM FAIL. NC1254.2 +056600 PERFORM PRINT-DETAIL. NC1254.2 +056700 EDI-TEST-GF7-EXIT. NC1254.2 +056800 EXIT. NC1254.2 +056900 EDI-TEST-GF8. NC1254.2 +057000 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +057100 MOVE "EDI-TEST-GF8" TO PAR-NAME. NC1254.2 +057200 MOVE "* EDIT ADD" TO FEATURE. NC1254.2 +057300 MOVE 0 TO CTR-1. NC1254.2 +057400 MOVE 0 TO CTR-3. NC1254.2 +057500 MOVE 0 TO REC-CT. NC1254.2 +057600 MOVE ZERO TO TBL-001-O (1). NC1254.2 +057700 MOVE .01 TO TBL-001-O (2). NC1254.2 +057800 PERFORM EDI-TEST-GF8-R CRT-2 TIMES NC1254.2 +057900 GO TO EDI-TEST-GF8-EXIT. NC1254.2 +058000 EDI-TEST-GF8-DELETE. NC1254.2 +058100 PERFORM DE-LETE. NC1254.2 +058200 PERFORM PRINT-DETAIL. NC1254.2 +058300 GO TO EDI-TEST-GF8-EXIT. NC1254.2 +058400 EDI-TEST-GF8-R. NC1254.2 +058500 ADD 1 TO REC-CT. NC1254.2 +058600 ADD 1 TO CTR-1. NC1254.2 +058700 ADD TBL-001-O (CTR-1) CTR-3 GIVING WRK-EDIT-004. NC1254.2 +058800 IF WRK-EDIT-004 EQUAL TO TBL-005-O (CTR-1) PERFORM PASS NC1254.2 +058900 ELSE MOVE W4 TO COMPUTED-X MOVE TBL-005-O (CTR-1) TO NC1254.2 +059000 CORRECT-X NC1254.2 +059100 PERFORM FAIL. NC1254.2 +059200 PERFORM PRINT-DETAIL. NC1254.2 +059300 EDI-TEST-GF8-EXIT. NC1254.2 +059400 EXIT. NC1254.2 +059500 EDI-TEST-GF9. NC1254.2 +059600 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +059700 MOVE "EDI-TEST-GF9" TO PAR-NAME. NC1254.2 +059800 MOVE "l EDIT SUB" TO FEATURE. NC1254.2 +059900 MOVE 0 TO CTR-1. NC1254.2 +060000 MOVE 0 TO CTR-3. NC1254.2 +060100 MOVE 0 TO REC-CT. NC1254.2 +060200 MOVE ZERO TO TBL-001-O (1). NC1254.2 +060300 MOVE .01 TO TBL-001-O (2). NC1254.2 +060400 PERFORM EDI-TEST-GF9-R CRT-2 TIMES NC1254.2 +060500 GO TO EDI-TEST-GF9-EXIT. NC1254.2 +060600 EDI-TEST-GF9-DELETE. NC1254.2 +060700 PERFORM DE-LETE. NC1254.2 +060800 PERFORM PRINT-DETAIL. NC1254.2 +060900 GO TO EDI-TEST-GF9-EXIT. NC1254.2 +061000 EDI-TEST-GF9-R. NC1254.2 +061100 ADD 1 TO REC-CT. NC1254.2 +061200 ADD 1 TO CTR-1. NC1254.2 +061300 SUBTRACT TBL-001-O (CTR-1) FROM CTR-3 GIVING WRK-EDIT-001. NC1254.2 +061400 IF WRK-EDIT-001 EQUAL TO TBL-002-O (CTR-1) PERFORM PASS NC1254.2 +061500 ELSE MOVE W1 TO COMPUTED-X MOVE TBL-002-O (CTR-1) TO NC1254.2 +061600 CORRECT-X NC1254.2 +061700 PERFORM FAIL. NC1254.2 +061800 PERFORM PRINT-DETAIL. NC1254.2 +061900 EDI-TEST-GF9-EXIT. NC1254.2 +062000 EXIT. NC1254.2 +062100 EDI-TEST-GF10. NC1254.2 +062200 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +062300 MOVE "EDI-TEST-GF10" TO PAR-NAME. NC1254.2 +062400 MOVE "+ EDIT SUB" TO FEATURE. NC1254.2 +062500 MOVE 0 TO CTR-1. NC1254.2 +062600 MOVE 0 TO CTR-3. NC1254.2 +062700 MOVE 0 TO REC-CT. NC1254.2 +062800 MOVE ZERO TO TBL-001-O (1). NC1254.2 +062900 MOVE .01 TO TBL-001-O (2). NC1254.2 +063000 MOVE " +.00" TO TBL-006-O (1). NC1254.2 +063100 PERFORM EDI-TEST-GF10-R CRT-2 TIMES NC1254.2 +063200 GO TO EDI-TEST-GF10-EXIT. NC1254.2 +063300 EDI-TEST-GF10-DELETE. NC1254.2 +063400 PERFORM DE-LETE. NC1254.2 +063500 PERFORM PRINT-DETAIL. NC1254.2 +063600 GO TO EDI-TEST-GF10-EXIT. NC1254.2 +063700 EDI-TEST-GF10-R. NC1254.2 +063800 ADD 1 TO REC-CT. NC1254.2 +063900 ADD 1 TO CTR-1. NC1254.2 +064000 SUBTRACT TBL-001-O (CTR-1) FROM CTR-3 GIVING WRK-EDIT-002. NC1254.2 +064100 IF WRK-EDIT-002 EQUAL TO TBL-006-O (CTR-1) PERFORM PASS NC1254.2 +064200 ELSE MOVE W2 TO COMPUTED-X MOVE TBL-006-O (CTR-1) TO NC1254.2 +064300 CORRECT-X NC1254.2 +064400 PERFORM FAIL. NC1254.2 +064500 PERFORM PRINT-DETAIL. NC1254.2 +064600 EDI-TEST-GF10-EXIT. NC1254.2 +064700 EXIT. NC1254.2 +064800 EDI-TEST-GF11. NC1254.2 +064900 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +065000 MOVE "EDI-TEST-GF11" TO PAR-NAME. NC1254.2 +065100 MOVE "- EDIT SUB" TO FEATURE. NC1254.2 +065200 MOVE 0 TO CTR-1. NC1254.2 +065300 MOVE 0 TO CTR-3. NC1254.2 +065400 MOVE 0 TO REC-CT. NC1254.2 +065500 MOVE ZERO TO TBL-001-O (1). NC1254.2 +065600 MOVE .01 TO TBL-001-O (2). NC1254.2 +065700 MOVE " .00" TO TBL-006-O (1). NC1254.2 +065800 PERFORM EDI-TEST-GF11-R CRT-2 TIMES NC1254.2 +065900 GO TO EDI-TEST-GF11-EXIT. NC1254.2 +066000 EDI-TEST-GF11-DELETE. NC1254.2 +066100 PERFORM DE-LETE. NC1254.2 +066200 PERFORM PRINT-DETAIL. NC1254.2 +066300 GO TO EDI-TEST-GF11-EXIT. NC1254.2 +066400 EDI-TEST-GF11-R. NC1254.2 +066500 ADD 1 TO REC-CT. NC1254.2 +066600 ADD 1 TO CTR-1. NC1254.2 +066700 SUBTRACT TBL-001-O (CTR-1) FROM CTR-3 GIVING WRK-EDIT-003. NC1254.2 +066800 IF WRK-EDIT-003 EQUAL TO TBL-006-O (CTR-1) PERFORM PASS NC1254.2 +066900 ELSE MOVE W3 TO COMPUTED-X MOVE TBL-006-O (CTR-1) TO NC1254.2 +067000 CORRECT-X NC1254.2 +067100 PERFORM FAIL. NC1254.2 +067200 PERFORM PRINT-DETAIL. NC1254.2 +067300 EDI-TEST-GF11-EXIT. NC1254.2 +067400 EXIT. NC1254.2 +067500 EDI-TEST-GF12. NC1254.2 +067600 MOVE "VI-34 5.9.5 (7), (8)" TO ANSI-REFERENCE. NC1254.2 +067700 MOVE "EDI-TEST-GF12" TO PAR-NAME. NC1254.2 +067800 MOVE "* EDIT SUB" TO FEATURE. NC1254.2 +067900 MOVE 0 TO CTR-1. NC1254.2 +068000 MOVE 0 TO CTR-3. NC1254.2 +068100 MOVE 0 TO REC-CT. NC1254.2 +068200 MOVE ZERO TO TBL-001-O (1). NC1254.2 +068300 MOVE .01 TO TBL-001-O (2). NC1254.2 +068400 PERFORM EDI-TEST-GF12-R CRT-2 TIMES NC1254.2 +068500 GO TO EDI-TEST-GF12-EXIT. NC1254.2 +068600 EDI-TEST-GF12-DELETE. NC1254.2 +068700 PERFORM DE-LETE. NC1254.2 +068800 PERFORM PRINT-DETAIL. NC1254.2 +068900 GO TO EDI-TEST-GF12-EXIT. NC1254.2 +069000 EDI-TEST-GF12-R. NC1254.2 +069100 ADD 1 TO REC-CT. NC1254.2 +069200 ADD 1 TO CTR-1. NC1254.2 +069300 SUBTRACT TBL-001-O (CTR-1) FROM CTR-3 GIVING WRK-EDIT-004. NC1254.2 +069400 IF WRK-EDIT-004 EQUAL TO TBL-005-O (CTR-1) PERFORM PASS NC1254.2 +069500 ELSE MOVE W4 TO COMPUTED-X MOVE TBL-005-O (CTR-1) TO NC1254.2 +069600 CORRECT-X NC1254.2 +069700 PERFORM FAIL. NC1254.2 +069800 PERFORM PRINT-DETAIL. NC1254.2 +069900 EDI-TEST-GF12-EXIT. NC1254.2 +070000 EXIT. NC1254.2 +070100* NC1254.2 +070200 EDI-INIT-GF-13. NC1254.2 +070300 MOVE "VI-33 5.9.5 (4), (5)" TO ANSI-REFERENCE. NC1254.2 +070400 MOVE "EDI-TEST-GF-13" TO PAR-NAME. NC1254.2 +070500 MOVE "COMMA AS LAST SYMBOL" TO FEATURE. NC1254.2 +070600 EDI-TEST-GF-13-0. NC1254.2 +070700 MOVE 123456789012 TO WRK-EDIT-005. NC1254.2 +070800 EDI-TEST-GF-13-1. NC1254.2 +070900 IF WRK-EDIT-005 = "1,2,3,4,5,6,7,8,9,0,1,2," NC1254.2 +071000 PERFORM PASS NC1254.2 +071100 ELSE NC1254.2 +071200 GO TO EDI-FAIL-GF-13. NC1254.2 +071300 GO TO EDI-WRITE-GF-13. NC1254.2 +071400 EDI-DELETE-GF-13. NC1254.2 +071500 PERFORM DE-LETE. NC1254.2 +071600 PERFORM PRINT-DETAIL. NC1254.2 +071700 GO TO EDI-INIT-GF-14. NC1254.2 +071800 EDI-FAIL-GF-13. NC1254.2 +071900 MOVE "1,2,3,4,5,6,7,8,9,0,1,2," TO CORRECT-X. NC1254.2 +072000 MOVE W5 TO COMPUTED-X. NC1254.2 +072100 PERFORM FAIL. NC1254.2 +072200 EDI-WRITE-GF-13. NC1254.2 +072300 PERFORM PRINT-DETAIL. NC1254.2 +072400* NC1254.2 +072500 EDI-INIT-GF-14. NC1254.2 +072600 MOVE "VI-34 5.9.5 (4), (5)" TO ANSI-REFERENCE. NC1254.2 +072700 MOVE "EDI-TEST-GF-14" TO PAR-NAME. NC1254.2 +072800 MOVE "PERIOD LAST SYMBOL" TO FEATURE. NC1254.2 +072900 EDI-TEST-GF-14-0. NC1254.2 +073000 MOVE 123456789012 TO WRK-EDIT-006. NC1254.2 +073100 EDI-TEST-GF-14-1. NC1254.2 +073200 IF WRK-EDIT-006 = "123456789012." NC1254.2 +073300 PERFORM PASS NC1254.2 +073400 ELSE NC1254.2 +073500 GO TO EDI-FAIL-GF-14. NC1254.2 +073600 GO TO EDI-WRITE-GF-14. NC1254.2 +073700 EDI-DELETE-GF-14. NC1254.2 +073800 PERFORM DE-LETE. NC1254.2 +073900 PERFORM PRINT-DETAIL. NC1254.2 +074000 GO TO EDI-INIT-GF-14. NC1254.2 +074100 EDI-FAIL-GF-14. NC1254.2 +074200 MOVE "123456789012." TO CORRECT-X. NC1254.2 +074300 MOVE W6 TO COMPUTED-X. NC1254.2 +074400 PERFORM FAIL. NC1254.2 +074500 EDI-WRITE-GF-14. NC1254.2 +074600 PERFORM PRINT-DETAIL. NC1254.2 +074700* NC1254.2 +074800 CCVS-EXIT SECTION. NC1254.2 +074900 CCVS-999999. NC1254.2 +075000 GO TO CLOSE-FILES. NC1254.2 diff --git a/tests/cobol85/NC/NC126A.CBL b/tests/cobol85/NC/NC126A.CBL new file mode 100755 index 00000000..dd20d994 --- /dev/null +++ b/tests/cobol85/NC/NC126A.CBL @@ -0,0 +1,2636 @@ +000100 IDENTIFICATION DIVISION. NC1264.2 +000200 PROGRAM-ID. NC1264.2 +000300 NC126A. NC1264.2 +000400**************************************************************** NC1264.2 +000500* * NC1264.2 +000600* VALIDATION FOR:- * NC1264.2 +000700* * NC1264.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1264.2 +000900* * NC1264.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1264.2 +001100* * NC1264.2 +001200**************************************************************** NC1264.2 +001300* * NC1264.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1264.2 +001500* * NC1264.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1264.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1264.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1264.2 +001900* * NC1264.2 +002000**************************************************************** NC1264.2 +002100* NC1264.2 +002200* PROGRAM NC126A TESTS THE USE OF LEVEL NUMBERS 01 THROUGH 49 NC1264.2 +002300* INCLUSIVE WITH A VARIETY OF PICTURE CLAUSES AND GROUP AND NC1264.2 +002400* ELEMENTARY COMPARISONS. NC1264.2 +002500* NC1264.2 +002600 ENVIRONMENT DIVISION. NC1264.2 +002700 CONFIGURATION SECTION. NC1264.2 +002800 SOURCE-COMPUTER. NC1264.2 +002900 Linux. NC1264.2 +003000 OBJECT-COMPUTER. NC1264.2 +003100 Linux. NC1264.2 +003200 INPUT-OUTPUT SECTION. NC1264.2 +003300 FILE-CONTROL. NC1264.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1264.2 +003500 "report.log". NC1264.2 +003600 DATA DIVISION. NC1264.2 +003700 FILE SECTION. NC1264.2 +003800 FD PRINT-FILE. NC1264.2 +003900 01 PRINT-REC PICTURE X(120). NC1264.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1264.2 +004100 WORKING-STORAGE SECTION. NC1264.2 +004200 01 TEST-GROUP-1. NC1264.2 +004300 02 GP-1 PICTURE ZZZ999. NC1264.2 +004400 02 GPLEVEL-1. NC1264.2 +004500 03 GP-2 PICTURE 9(9).99. NC1264.2 +004600 03 GPLEVEL-2. NC1264.2 +004700 04 GP-3 PICTURE 0009(9). NC1264.2 +004800 04 GPLEVEL-3. NC1264.2 +004900 05 GP-4 PICTURE ZBZBZ9. NC1264.2 +005000 05 GPLEVEL-4. NC1264.2 +005100 06 GP-5 PICTURE $$$,$99.99. NC1264.2 +005200 06 GPLEVEL-5. NC1264.2 +005300 07 GP-6 PICTURE ******99. NC1264.2 +005400 07 GPLEVEL-6. NC1264.2 +005500 08 GP-7 PICTURE +999,999. NC1264.2 +005600 08 GPLEVEL-7. NC1264.2 +005700 09 GP-8 PICTURE X(14). NC1264.2 +005800 09 GPLEVEL-8. NC1264.2 +005900 10 GP-9 PICTURE XBXBXBX. NC1264.2 +006000 10 GPLEVEL-9. NC1264.2 +006100 11 GP-10 PICTURE 9090900. NC1264.2 +006200 11 GPLEVEL-10. NC1264.2 +006300 12 GP-11 PICTURE $999,999.00. NC1264.2 +006400 12 GPLEVEL-11. NC1264.2 +006500 13 GP-12 PICTURE ZZZ.9. NC1264.2 +006600 13 GPLEVEL-12. NC1264.2 +006700 14 GP-13 PICTURE ZZ9B900. NC1264.2 +006800 14 GPLEVEL-13. NC1264.2 +006900 15 GP-14 PICTURE XXXX. NC1264.2 +007000 15 GPLEVEL-14. NC1264.2 +007100 16 GP-15 PICTURE 9(10). NC1264.2 +007200 16 GPLEVEL-15. NC1264.2 +007300 17 GP-16 PICTURE Z(11). NC1264.2 +007400 17 GPLEVEL-16. NC1264.2 +007500 18 GP-17 PICTURE 99BB909. NC1264.2 +007600 18 GPLEVEL-17. NC1264.2 +007700 19 GP-18 PICTURE -*B*99. NC1264.2 +007800 19 GPLEVEL-18. NC1264.2 +007900 20 GP-19 PICTURE 0009999. NC1264.2 +008000 20 GPLEVEL-19. NC1264.2 +008100 21 GP-20 PICTURE 999DB. NC1264.2 +008200 21 GPLEVEL-20. NC1264.2 +008300 22 GP-21 PICTURE ABABABA. NC1264.2 +008400 22 GPLEVEL-21. NC1264.2 +008500 23 GP-22 PICTURE *999999. NC1264.2 +008600 23 GPLEVEL-22. NC1264.2 +008700 24 GP-23 PICTURE XXXXXA. NC1264.2 +008800 24 GPLEVEL-23. NC1264.2 +008900 25 GP-24 PICTURE $$$,$$$.99. NC1264.2 +009000 25 GPLEVEL-24. NC1264.2 +009100 26 GP-25 PICTURE 9BB9BBB9BBB. NC1264.2 +009200 26 GPLEVEL-25. NC1264.2 +009300 27 GP-26 PICTURE 9990009. NC1264.2 +009400 27 GPLEVEL-26. NC1264.2 +009500 28 GP-27 PICTURE 9,999,999. NC1264.2 +009600 28 GPLEVEL-27. NC1264.2 +009700 29 GP-28 PICTURE 9(7),9. NC1264.2 +009800 29 GPLEVEL-28. NC1264.2 +009900 30 GP-29 PICTURE $***.99. NC1264.2 +010000 30 GPLEVEL-29. NC1264.2 +010100 31 GP-30 PICTURE X(15). NC1264.2 +010200 31 GPLEVEL-30. NC1264.2 +010300 32 GP-31 PICTURE 9(10). NC1264.2 +010400 32 GPLEVEL-31. NC1264.2 +010500 33 GP-32 PICTURE *99. NC1264.2 +010600 33 GPLEVEL-32. NC1264.2 +010700 34 GP-33 PICTURE ZZZ9. NC1264.2 +010800 34 GPLEVEL-33. NC1264.2 +010900 35 GP-34 PICTURE BB9BB9. NC1264.2 +011000 35 GPLEVEL-34. NC1264.2 +011100 36 GP-35 PICTURE $99,999.99. NC1264.2 +011200 36 GPLEVEL-35. NC1264.2 +011300 37 GP-36 PICTURE 090909. NC1264.2 +011400 37 GPLEVEL-36. NC1264.2 +011500 38 GP-37 PICTURE ZZZZ. NC1264.2 +011600 38 GPLEVEL-37. NC1264.2 +011700 39 GP-38 PICTURE +99. NC1264.2 +011800 39 GPLEVEL-38. NC1264.2 +011900 40 GP-39 PICTURE -99. NC1264.2 +012000 40 GPLEVEL-39. NC1264.2 +012100 41 GP-40 PICTURE 99CR. NC1264.2 +012200 41 GPLEVEL-40. NC1264.2 +012300 42 GP-41 PICTURE 99DB. NC1264.2 +012400 42 GPLEVEL-41. NC1264.2 +012500 43 GP-42 PICTURE ****. NC1264.2 +012600 43 GPLEVEL-42. NC1264.2 +012700 44 GP-43 PICTURE AAA. NC1264.2 +012800 44 GPLEVEL-43. NC1264.2 +012900 45 GP-44 PICTURE XXX. NC1264.2 +013000 45 GPLEVEL-44. NC1264.2 +013100 46 GP-45 PICTURE *9999. NC1264.2 +013200 46 GPLEVEL-45. NC1264.2 +013300 47 GP-46 PICTURE 9(10).99. NC1264.2 +013400 47 GPLEVEL-46. NC1264.2 +013500 48 GP-47 OCCURS 2 TIMES PICTURE 9. NC1264.2 +013600 48 GPLEVEL-47. NC1264.2 +013700 49 GP-48 OCCURS 2 TIMES PICTURE X. NC1264.2 +013800 01 TABLE-GROUP. NC1264.2 +013900 02 TB-1 PICTURE XX. NC1264.2 +014000 02 TBGRP-1. NC1264.2 +014100 03 TB-2 PICTURE XX. NC1264.2 +014200 03 TBGRP-2. NC1264.2 +014300 04 TB-3 PICTURE XX. NC1264.2 +014400 04 TBGRP-3. NC1264.2 +014500 05 TB-4 PICTURE XX. NC1264.2 +014600 05 TBGRP-4. NC1264.2 +014700 06 TB-5 PICTURE XX. NC1264.2 +014800 06 TBGRP-5. NC1264.2 +014900 07 TB-6 PICTURE XX. NC1264.2 +015000 07 TBGRP-6. NC1264.2 +015100 08 TB-7 PICTURE XX. NC1264.2 +015200 08 TBGRP-7. NC1264.2 +015300 09 TB-8 PICTURE XX. NC1264.2 +015400 09 TBGRP-8. NC1264.2 +015500 10 TB-9 PICTURE XX. NC1264.2 +015600 10 TBGRP-9. NC1264.2 +015700 11 TB-10 PICTURE XX. NC1264.2 +015800 11 TBGRP-10. NC1264.2 +015900 12 TB-11 PICTURE XX. NC1264.2 +016000 12 TBGRP-11. NC1264.2 +016100 13 TB-12 PICTURE XX. NC1264.2 +016200 13 TBGRP-12. NC1264.2 +016300 14 TB-13 PICTURE XX. NC1264.2 +016400 14 TBGRP-13. NC1264.2 +016500 15 TB-14 PICTURE XX. NC1264.2 +016600 15 TBGRP-14. NC1264.2 +016700 16 TB-15 PICTURE XX. NC1264.2 +016800 16 TBGRP-15. NC1264.2 +016900 17 TB-16 PICTURE XX. NC1264.2 +017000 17 TBGRP-16. NC1264.2 +017100 18 TB-17 PICTURE XX. NC1264.2 +017200 18 TBGRP-17. NC1264.2 +017300 19 TB-18 PICTURE XX. NC1264.2 +017400 19 TBGRP-18. NC1264.2 +017500 20 TB-19 PICTURE XX. NC1264.2 +017600 20 TBGRP-19. NC1264.2 +017700 21 TB-20 PICTURE XX. NC1264.2 +017800 21 TBGRP-20. NC1264.2 +017900 22 TB-21 PICTURE XX. NC1264.2 +018000 22 TBGRP-21. NC1264.2 +018100 23 TB-22 PICTURE XX. NC1264.2 +018200 23 TBGRP-22. NC1264.2 +018300 24 TB-23 PICTURE XX. NC1264.2 +018400 24 TBGRP-23. NC1264.2 +018500 25 TB-24 PICTURE XX. NC1264.2 +018600 25 TBGRP-24. NC1264.2 +018700 26 TB-25 PICTURE XX. NC1264.2 +018800 26 TBGRP-25. NC1264.2 +018900 27 TB-26 PICTURE XX. NC1264.2 +019000 27 TBGRP-26. NC1264.2 +019100 28 TB-27 PICTURE XX. NC1264.2 +019200 28 TBGRP-27. NC1264.2 +019300 29 TB-28 PICTURE XX. NC1264.2 +019400 29 TBGRP-28. NC1264.2 +019500 30 TB-29 PICTURE XX. NC1264.2 +019600 30 TBGRP-29. NC1264.2 +019700 31 TB-30 PICTURE XX. NC1264.2 +019800 31 TBGRP-30. NC1264.2 +019900 32 TB-31 PICTURE XX. NC1264.2 +020000 32 TBGRP-31. NC1264.2 +020100 33 TB-32 PICTURE XX. NC1264.2 +020200 33 TBGRP-32. NC1264.2 +020300 34 TB-33 PICTURE XX. NC1264.2 +020400 34 TBGRP-33. NC1264.2 +020500 35 TB-34 PICTURE XX. NC1264.2 +020600 35 TBGRP-34. NC1264.2 +020700 36 TB-35 PICTURE XX. NC1264.2 +020800 36 TBGRP-35. NC1264.2 +020900 37 TB-36 PICTURE XX. NC1264.2 +021000 37 TBGRP-36. NC1264.2 +021100 38 TB-37 PICTURE XX. NC1264.2 +021200 38 TBGRP-37. NC1264.2 +021300 39 TB-38 PICTURE XX. NC1264.2 +021400 39 TBGRP-38. NC1264.2 +021500 40 TB-39 PICTURE XX. NC1264.2 +021600 40 TBGRP-39. NC1264.2 +021700 41 TB-40 PICTURE XX. NC1264.2 +021800 41 TBGRP-40. NC1264.2 +021900 42 TB-41 PICTURE XX. NC1264.2 +022000 42 TBGRP-41. NC1264.2 +022100 43 TB-42 PICTURE XX. NC1264.2 +022200 43 TBGRP-42. NC1264.2 +022300 44 TB-43 PICTURE XX. NC1264.2 +022400 44 TBGRP-43. NC1264.2 +022500 45 TB-44 PICTURE XX. NC1264.2 +022600 45 TBGRP-44. NC1264.2 +022700 46 TB-45 PICTURE XX. NC1264.2 +022800 46 TBGRP-45. NC1264.2 +022900 47 TB-46 PICTURE XX. NC1264.2 +023000 47 TBGRP-46. NC1264.2 +023100 48 TB-47 PICTURE XX. NC1264.2 +023200 48 TBGRP-47. NC1264.2 +023300 49 TB-48 PICTURE XX. NC1264.2 +023400 01 LITERAL-98. NC1264.2 +023500 02 A-PART-98 PICTURE X(20) VALUE "ABCDEFGHIJKLMNOPQRST". NC1264.2 +023600 02 B-PART-98 PICTURE X(20) VALUE "01234567899876543210". NC1264.2 +023700 02 C-PART-98 PICTURE X(20) VALUE "SUPERCALIFRAGILISTIC". NC1264.2 +023800 02 D-PART-98 PICTURE X(20) VALUE "THAT LITERAL WAS BAD". NC1264.2 +023900 02 E-PART-98 PICTURE X(16) VALUE "UP ON THE ROOFS". NC1264.2 +024000 01 BREAKDOWN-RECORD. NC1264.2 +024100 02 LENGTH-COUNTER PICTURE 999 VALUE ZERO. NC1264.2 +024200 02 COMPUTED-BREAKDOWN. NC1264.2 +024300 03 CM-20 PICTURE X(20). NC1264.2 +024400 03 CM-40 PICTURE X(20). NC1264.2 +024500 03 CM-60 PICTURE X(20). NC1264.2 +024600 03 CM-80 PICTURE X(20). NC1264.2 +024700 03 CM-100 PICTURE X(20). NC1264.2 +024800 03 CM-120 PICTURE X(20). NC1264.2 +024900 03 CM-140 PICTURE X(20). NC1264.2 +025000 03 CM-160 PICTURE X(20). NC1264.2 +025100 03 CM-180 PICTURE X(20). NC1264.2 +025200 03 CM-200 PICTURE X(20). NC1264.2 +025300 02 CORRECT-BREAKDOWN. NC1264.2 +025400 03 CR-20 PICTURE X(20). NC1264.2 +025500 03 CR-40 PICTURE X(20). NC1264.2 +025600 03 CR-60 PICTURE X(20). NC1264.2 +025700 03 CR-80 PICTURE X(20). NC1264.2 +025800 03 CR-100 PICTURE X(20). NC1264.2 +025900 03 CR-120 PICTURE X(20). NC1264.2 +026000 03 CR-140 PICTURE X(20). NC1264.2 +026100 03 CR-160 PICTURE X(20). NC1264.2 +026200 03 CR-180 PICTURE X(20). NC1264.2 +026300 03 CR-200 PICTURE X(20). NC1264.2 +026400 01 TEST-RESULTS. NC1264.2 +026500 02 FILLER PIC X VALUE SPACE. NC1264.2 +026600 02 FEATURE PIC X(20) VALUE SPACE. NC1264.2 +026700 02 FILLER PIC X VALUE SPACE. NC1264.2 +026800 02 P-OR-F PIC X(5) VALUE SPACE. NC1264.2 +026900 02 FILLER PIC X VALUE SPACE. NC1264.2 +027000 02 PAR-NAME. NC1264.2 +027100 03 FILLER PIC X(19) VALUE SPACE. NC1264.2 +027200 03 PARDOT-X PIC X VALUE SPACE. NC1264.2 +027300 03 DOTVALUE PIC 99 VALUE ZERO. NC1264.2 +027400 02 FILLER PIC X(8) VALUE SPACE. NC1264.2 +027500 02 RE-MARK PIC X(61). NC1264.2 +027600 01 TEST-COMPUTED. NC1264.2 +027700 02 FILLER PIC X(30) VALUE SPACE. NC1264.2 +027800 02 FILLER PIC X(17) VALUE NC1264.2 +027900 " COMPUTED=". NC1264.2 +028000 02 COMPUTED-X. NC1264.2 +028100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1264.2 +028200 03 COMPUTED-N REDEFINES COMPUTED-A NC1264.2 +028300 PIC -9(9).9(9). NC1264.2 +028400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1264.2 +028500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1264.2 +028600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1264.2 +028700 03 CM-18V0 REDEFINES COMPUTED-A. NC1264.2 +028800 04 COMPUTED-18V0 PIC -9(18). NC1264.2 +028900 04 FILLER PIC X. NC1264.2 +029000 03 FILLER PIC X(50) VALUE SPACE. NC1264.2 +029100 01 TEST-CORRECT. NC1264.2 +029200 02 FILLER PIC X(30) VALUE SPACE. NC1264.2 +029300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1264.2 +029400 02 CORRECT-X. NC1264.2 +029500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1264.2 +029600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1264.2 +029700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1264.2 +029800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1264.2 +029900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1264.2 +030000 03 CR-18V0 REDEFINES CORRECT-A. NC1264.2 +030100 04 CORRECT-18V0 PIC -9(18). NC1264.2 +030200 04 FILLER PIC X. NC1264.2 +030300 03 FILLER PIC X(2) VALUE SPACE. NC1264.2 +030400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1264.2 +030500 01 CCVS-C-1. NC1264.2 +030600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1264.2 +030700- "SS PARAGRAPH-NAME NC1264.2 +030800- " REMARKS". NC1264.2 +030900 02 FILLER PIC X(20) VALUE SPACE. NC1264.2 +031000 01 CCVS-C-2. NC1264.2 +031100 02 FILLER PIC X VALUE SPACE. NC1264.2 +031200 02 FILLER PIC X(6) VALUE "TESTED". NC1264.2 +031300 02 FILLER PIC X(15) VALUE SPACE. NC1264.2 +031400 02 FILLER PIC X(4) VALUE "FAIL". NC1264.2 +031500 02 FILLER PIC X(94) VALUE SPACE. NC1264.2 +031600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1264.2 +031700 01 REC-CT PIC 99 VALUE ZERO. NC1264.2 +031800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1264.2 +031900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1264.2 +032000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1264.2 +032100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1264.2 +032200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1264.2 +032300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1264.2 +032400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1264.2 +032500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1264.2 +032600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1264.2 +032700 01 CCVS-H-1. NC1264.2 +032800 02 FILLER PIC X(39) VALUE SPACES. NC1264.2 +032900 02 FILLER PIC X(42) VALUE NC1264.2 +033000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1264.2 +033100 02 FILLER PIC X(39) VALUE SPACES. NC1264.2 +033200 01 CCVS-H-2A. NC1264.2 +033300 02 FILLER PIC X(40) VALUE SPACE. NC1264.2 +033400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1264.2 +033500 02 FILLER PIC XXXX VALUE NC1264.2 +033600 "4.2 ". NC1264.2 +033700 02 FILLER PIC X(28) VALUE NC1264.2 +033800 " COPY - NOT FOR DISTRIBUTION". NC1264.2 +033900 02 FILLER PIC X(41) VALUE SPACE. NC1264.2 +034000 NC1264.2 +034100 01 CCVS-H-2B. NC1264.2 +034200 02 FILLER PIC X(15) VALUE NC1264.2 +034300 "TEST RESULT OF ". NC1264.2 +034400 02 TEST-ID PIC X(9). NC1264.2 +034500 02 FILLER PIC X(4) VALUE NC1264.2 +034600 " IN ". NC1264.2 +034700 02 FILLER PIC X(12) VALUE NC1264.2 +034800 " HIGH ". NC1264.2 +034900 02 FILLER PIC X(22) VALUE NC1264.2 +035000 " LEVEL VALIDATION FOR ". NC1264.2 +035100 02 FILLER PIC X(58) VALUE NC1264.2 +035200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1264.2 +035300 01 CCVS-H-3. NC1264.2 +035400 02 FILLER PIC X(34) VALUE NC1264.2 +035500 " FOR OFFICIAL USE ONLY ". NC1264.2 +035600 02 FILLER PIC X(58) VALUE NC1264.2 +035700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1264.2 +035800 02 FILLER PIC X(28) VALUE NC1264.2 +035900 " COPYRIGHT 1985 ". NC1264.2 +036000 01 CCVS-E-1. NC1264.2 +036100 02 FILLER PIC X(52) VALUE SPACE. NC1264.2 +036200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1264.2 +036300 02 ID-AGAIN PIC X(9). NC1264.2 +036400 02 FILLER PIC X(45) VALUE SPACES. NC1264.2 +036500 01 CCVS-E-2. NC1264.2 +036600 02 FILLER PIC X(31) VALUE SPACE. NC1264.2 +036700 02 FILLER PIC X(21) VALUE SPACE. NC1264.2 +036800 02 CCVS-E-2-2. NC1264.2 +036900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1264.2 +037000 03 FILLER PIC X VALUE SPACE. NC1264.2 +037100 03 ENDER-DESC PIC X(44) VALUE NC1264.2 +037200 "ERRORS ENCOUNTERED". NC1264.2 +037300 01 CCVS-E-3. NC1264.2 +037400 02 FILLER PIC X(22) VALUE NC1264.2 +037500 " FOR OFFICIAL USE ONLY". NC1264.2 +037600 02 FILLER PIC X(12) VALUE SPACE. NC1264.2 +037700 02 FILLER PIC X(58) VALUE NC1264.2 +037800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1264.2 +037900 02 FILLER PIC X(13) VALUE SPACE. NC1264.2 +038000 02 FILLER PIC X(15) VALUE NC1264.2 +038100 " COPYRIGHT 1985". NC1264.2 +038200 01 CCVS-E-4. NC1264.2 +038300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1264.2 +038400 02 FILLER PIC X(4) VALUE " OF ". NC1264.2 +038500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1264.2 +038600 02 FILLER PIC X(40) VALUE NC1264.2 +038700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1264.2 +038800 01 XXINFO. NC1264.2 +038900 02 FILLER PIC X(19) VALUE NC1264.2 +039000 "*** INFORMATION ***". NC1264.2 +039100 02 INFO-TEXT. NC1264.2 +039200 04 FILLER PIC X(8) VALUE SPACE. NC1264.2 +039300 04 XXCOMPUTED PIC X(20). NC1264.2 +039400 04 FILLER PIC X(5) VALUE SPACE. NC1264.2 +039500 04 XXCORRECT PIC X(20). NC1264.2 +039600 02 INF-ANSI-REFERENCE PIC X(48). NC1264.2 +039700 01 HYPHEN-LINE. NC1264.2 +039800 02 FILLER PIC IS X VALUE IS SPACE. NC1264.2 +039900 02 FILLER PIC IS X(65) VALUE IS "************************NC1264.2 +040000- "*****************************************". NC1264.2 +040100 02 FILLER PIC IS X(54) VALUE IS "************************NC1264.2 +040200- "******************************". NC1264.2 +040300 01 CCVS-PGM-ID PIC X(9) VALUE NC1264.2 +040400 "NC126A". NC1264.2 +040500 PROCEDURE DIVISION. NC1264.2 +040600 CCVS1 SECTION. NC1264.2 +040700 OPEN-FILES. NC1264.2 +040800 OPEN OUTPUT PRINT-FILE. NC1264.2 +040900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1264.2 +041000 MOVE SPACE TO TEST-RESULTS. NC1264.2 +041100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1264.2 +041200 GO TO CCVS1-EXIT. NC1264.2 +041300 CLOSE-FILES. NC1264.2 +041400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1264.2 +041500 TERMINATE-CCVS. NC1264.2 +041600*S EXIT PROGRAM. NC1264.2 +041700*SERMINATE-CALL. NC1264.2 +041800 STOP RUN. NC1264.2 +041900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1264.2 +042000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1264.2 +042100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1264.2 +042200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1264.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. NC1264.2 +042400 PRINT-DETAIL. NC1264.2 +042500 IF REC-CT NOT EQUAL TO ZERO NC1264.2 +042600 MOVE "." TO PARDOT-X NC1264.2 +042700 MOVE REC-CT TO DOTVALUE. NC1264.2 +042800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1264.2 +042900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1264.2 +043000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1264.2 +043100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1264.2 +043200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1264.2 +043300 MOVE SPACE TO CORRECT-X. NC1264.2 +043400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1264.2 +043500 MOVE SPACE TO RE-MARK. NC1264.2 +043600 HEAD-ROUTINE. NC1264.2 +043700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +043800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +043900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1264.2 +044000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1264.2 +044100 COLUMN-NAMES-ROUTINE. NC1264.2 +044200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +044300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +044400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +044500 END-ROUTINE. NC1264.2 +044600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1264.2 +044700 END-RTN-EXIT. NC1264.2 +044800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +044900 END-ROUTINE-1. NC1264.2 +045000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1264.2 +045100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1264.2 +045200 ADD PASS-COUNTER TO ERROR-HOLD. NC1264.2 +045300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1264.2 +045400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1264.2 +045500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1264.2 +045600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1264.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1264.2 +045800 END-ROUTINE-12. NC1264.2 +045900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1264.2 +046000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1264.2 +046100 MOVE "NO " TO ERROR-TOTAL NC1264.2 +046200 ELSE NC1264.2 +046300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1264.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1264.2 +046500 PERFORM WRITE-LINE. NC1264.2 +046600 END-ROUTINE-13. NC1264.2 +046700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1264.2 +046800 MOVE "NO " TO ERROR-TOTAL ELSE NC1264.2 +046900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1264.2 +047000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1264.2 +047100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +047200 IF INSPECT-COUNTER EQUAL TO ZERO NC1264.2 +047300 MOVE "NO " TO ERROR-TOTAL NC1264.2 +047400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1264.2 +047500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1264.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +047700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1264.2 +047800 WRITE-LINE. NC1264.2 +047900 ADD 1 TO RECORD-COUNT. NC1264.2 +048000 IF RECORD-COUNT GREATER 42 NC1264.2 +048100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1264.2 +048200 MOVE SPACE TO DUMMY-RECORD NC1264.2 +048300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1264.2 +048400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1264.2 +048500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1264.2 +048600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1264.2 +048700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1264.2 +048800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1264.2 +048900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1264.2 +049000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1264.2 +049100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1264.2 +049200 MOVE ZERO TO RECORD-COUNT. NC1264.2 +049300 PERFORM WRT-LN. NC1264.2 +049400 WRT-LN. NC1264.2 +049500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1264.2 +049600 MOVE SPACE TO DUMMY-RECORD. NC1264.2 +049700 BLANK-LINE-PRINT. NC1264.2 +049800 PERFORM WRT-LN. NC1264.2 +049900 FAIL-ROUTINE. NC1264.2 +050000 IF COMPUTED-X NOT EQUAL TO SPACE NC1264.2 +050100 GO TO FAIL-ROUTINE-WRITE. NC1264.2 +050200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1264.2 +050300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1264.2 +050400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1264.2 +050500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +050600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1264.2 +050700 GO TO FAIL-ROUTINE-EX. NC1264.2 +050800 FAIL-ROUTINE-WRITE. NC1264.2 +050900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1264.2 +051000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1264.2 +051100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1264.2 +051200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1264.2 +051300 FAIL-ROUTINE-EX. EXIT. NC1264.2 +051400 BAIL-OUT. NC1264.2 +051500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1264.2 +051600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1264.2 +051700 BAIL-OUT-WRITE. NC1264.2 +051800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1264.2 +051900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1264.2 +052000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1264.2 +052100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1264.2 +052200 BAIL-OUT-EX. EXIT. NC1264.2 +052300 CCVS1-EXIT. NC1264.2 +052400 EXIT. NC1264.2 +052500 SECT-NC126A-001 SECTION. NC1264.2 +052600 LEV-INIT-GF-1-1. NC1264.2 +052700 MOVE "VI-21 5.3.3 SR1" TO ANSI-REFERENCE. NC1264.2 +052800 MOVE "SPACE MOVED TO GRP" TO FEATURE. NC1264.2 +052900 PERFORM PRINT-DETAIL. NC1264.2 +053000 MOVE "GROUP ITEM CHECK " TO FEATURE. NC1264.2 +053100 LEV-TEST-GF-1-0. NC1264.2 +053200 MOVE SPACE TO TABLE-GROUP. NC1264.2 +053300 LEV-TEST-GF-1-1. NC1264.2 +053400 IF TBGRP-1 EQUAL TO SPACE NC1264.2 +053500 PERFORM PASS NC1264.2 +053600 GO TO LEV-WRITE-GF-1-1. NC1264.2 +053700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +053800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +053900 MOVE 94 TO LENGTH-COUNTER. NC1264.2 +054000 GO TO LEV-WRITE-GF-1-1. NC1264.2 +054100 LEV-DELETE-GF-1-1. NC1264.2 +054200 PERFORM DE-LETE. NC1264.2 +054300 LEV-WRITE-GF-1-1. NC1264.2 +054400 MOVE "LEV-TEST-GF-1-1" TO PAR-NAME. NC1264.2 +054500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +054600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +054700 PERFORM PRINT-DETAIL. NC1264.2 +054800 LEV-TEST-GF-1-2. NC1264.2 +054900 IF TBGRP-2 EQUAL TO SPACE NC1264.2 +055000 PERFORM PASS NC1264.2 +055100 GO TO LEV-WRITE-GF-1-2. NC1264.2 +055200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +055300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +055400 MOVE 92 TO LENGTH-COUNTER. NC1264.2 +055500 GO TO LEV-WRITE-GF-1-2. NC1264.2 +055600 LEV-DELETE-GF-1-2. NC1264.2 +055700 PERFORM DE-LETE. NC1264.2 +055800 LEV-WRITE-GF-1-2. NC1264.2 +055900 MOVE "LEV-TEST-GF-1-2" TO PAR-NAME. NC1264.2 +056000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +056100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +056200 PERFORM PRINT-DETAIL. NC1264.2 +056300 LEV-TEST-GF-1-3. NC1264.2 +056400 IF TBGRP-3 EQUAL TO SPACE NC1264.2 +056500 PERFORM PASS NC1264.2 +056600 GO TO LEV-WRITE-GF-1-3. NC1264.2 +056700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +056800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +056900 MOVE 90 TO LENGTH-COUNTER. NC1264.2 +057000 GO TO LEV-WRITE-GF-1-3. NC1264.2 +057100 LEV-DELETE-GF-1-3. NC1264.2 +057200 PERFORM DE-LETE. NC1264.2 +057300 LEV-WRITE-GF-1-3. NC1264.2 +057400 MOVE "LEV-TEST-GF-1-3" TO PAR-NAME. NC1264.2 +057500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +057600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +057700 PERFORM PRINT-DETAIL. NC1264.2 +057800 LEV-TEST-GF-1-4. NC1264.2 +057900 IF TBGRP-4 EQUAL TO SPACE NC1264.2 +058000 PERFORM PASS NC1264.2 +058100 GO TO LEV-WRITE-GF-1-4. NC1264.2 +058200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +058300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +058400 MOVE 88 TO LENGTH-COUNTER. NC1264.2 +058500 GO TO LEV-WRITE-GF-1-4. NC1264.2 +058600 LEV-DELETE-GF-1-4. NC1264.2 +058700 PERFORM DE-LETE. NC1264.2 +058800 LEV-WRITE-GF-1-4. NC1264.2 +058900 MOVE "LEV-TEST-GF-1-4" TO PAR-NAME. NC1264.2 +059000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +059100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +059200 PERFORM PRINT-DETAIL. NC1264.2 +059300 LEV-TEST-GF-1-5. NC1264.2 +059400 IF TBGRP-5 EQUAL TO SPACE NC1264.2 +059500 PERFORM PASS NC1264.2 +059600 GO TO LEV-WRITE-GF-1-5. NC1264.2 +059700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +059800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +059900 MOVE 86 TO LENGTH-COUNTER. NC1264.2 +060000 GO TO LEV-WRITE-GF-1-5. NC1264.2 +060100 LEV-DELETE-GF-1-5. NC1264.2 +060200 PERFORM DE-LETE. NC1264.2 +060300 LEV-WRITE-GF-1-5. NC1264.2 +060400 MOVE "LEV-TEST-GF-1-5" TO PAR-NAME. NC1264.2 +060500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +060600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +060700 PERFORM PRINT-DETAIL. NC1264.2 +060800 LEV-TEST-GF-1-6. NC1264.2 +060900 IF TBGRP-6 EQUAL TO SPACE NC1264.2 +061000 PERFORM PASS NC1264.2 +061100 GO TO LEV-WRITE-GF-1-6. NC1264.2 +061200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +061300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +061400 MOVE 84 TO LENGTH-COUNTER. NC1264.2 +061500 GO TO LEV-WRITE-GF-1-6. NC1264.2 +061600 LEV-DELETE-GF-1-6. NC1264.2 +061700 PERFORM DE-LETE. NC1264.2 +061800 LEV-WRITE-GF-1-6. NC1264.2 +061900 MOVE "LEV-TEST-GF-1-6" TO PAR-NAME. NC1264.2 +062000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +062100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +062200 PERFORM PRINT-DETAIL. NC1264.2 +062300 LEV-TEST-GF-1-7. NC1264.2 +062400 IF TBGRP-7 EQUAL TO SPACE NC1264.2 +062500 PERFORM PASS NC1264.2 +062600 GO TO LEV-WRITE-GF-1-7. NC1264.2 +062700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +062800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +062900 MOVE 82 TO LENGTH-COUNTER. NC1264.2 +063000 GO TO LEV-WRITE-GF-1-7. NC1264.2 +063100 LEV-DELETE-GF-1-7. NC1264.2 +063200 PERFORM DE-LETE. NC1264.2 +063300 LEV-WRITE-GF-1-7. NC1264.2 +063400 MOVE "LEV-TEST-GF-1-7" TO PAR-NAME. NC1264.2 +063500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +063600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +063700 PERFORM PRINT-DETAIL. NC1264.2 +063800 LEV-TEST-GF-1-8. NC1264.2 +063900 IF TBGRP-8 EQUAL TO SPACE NC1264.2 +064000 PERFORM PASS NC1264.2 +064100 GO TO LEV-WRITE-GF-1-8. NC1264.2 +064200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +064300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +064400 MOVE 80 TO LENGTH-COUNTER. NC1264.2 +064500 GO TO LEV-WRITE-GF-1-8. NC1264.2 +064600 LEV-DELETE-GF-1-8. NC1264.2 +064700 PERFORM DE-LETE. NC1264.2 +064800 LEV-WRITE-GF-1-8. NC1264.2 +064900 MOVE "LEV-TEST-GF-1-8" TO PAR-NAME. NC1264.2 +065000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +065100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +065200 PERFORM PRINT-DETAIL. NC1264.2 +065300 LEV-TEST-GF-1-9. NC1264.2 +065400 IF TBGRP-9 EQUAL TO SPACE NC1264.2 +065500 PERFORM PASS NC1264.2 +065600 GO TO LEV-WRITE-GF-1-9. NC1264.2 +065700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +065800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +065900 MOVE 78 TO LENGTH-COUNTER. NC1264.2 +066000 GO TO LEV-WRITE-GF-1-9. NC1264.2 +066100 LEV-DELETE-GF-1-9. NC1264.2 +066200 PERFORM DE-LETE. NC1264.2 +066300 LEV-WRITE-GF-1-9. NC1264.2 +066400 MOVE "LEV-TEST-GF-1-9" TO PAR-NAME. NC1264.2 +066500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +066600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +066700 PERFORM PRINT-DETAIL. NC1264.2 +066800 LEV-TEST-GF-10. NC1264.2 +066900 IF TBGRP-10 EQUAL TO SPACE NC1264.2 +067000 PERFORM PASS NC1264.2 +067100 GO TO LEV-WRITE-GF-1-10. NC1264.2 +067200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +067300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +067400 MOVE 76 TO LENGTH-COUNTER. NC1264.2 +067500 GO TO LEV-WRITE-GF-1-10. NC1264.2 +067600 LEV-DELETE-GF-1-10. NC1264.2 +067700 PERFORM DE-LETE. NC1264.2 +067800 LEV-WRITE-GF-1-10. NC1264.2 +067900 MOVE "LEV-TEST-GF-1-10" TO PAR-NAME. NC1264.2 +068000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +068100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +068200 PERFORM PRINT-DETAIL. NC1264.2 +068300 LEV-TEST-GF-1-11. NC1264.2 +068400 IF TBGRP-11 EQUAL TO SPACE NC1264.2 +068500 PERFORM PASS NC1264.2 +068600 GO TO LEV-WRITE-GF-1-11. NC1264.2 +068700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +068800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +068900 MOVE 74 TO LENGTH-COUNTER. NC1264.2 +069000 GO TO LEV-WRITE-GF-1-11. NC1264.2 +069100 LEV-DELETE-GF-1-11. NC1264.2 +069200 PERFORM DE-LETE. NC1264.2 +069300 LEV-WRITE-GF-1-11. NC1264.2 +069400 MOVE "LEV-TEST-GF-1-11" TO PAR-NAME. NC1264.2 +069500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +069600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +069700 PERFORM PRINT-DETAIL. NC1264.2 +069800 LEV-TEST-GF-1-12. NC1264.2 +069900 IF TBGRP-12 EQUAL TO SPACE NC1264.2 +070000 PERFORM PASS NC1264.2 +070100 GO TO LEV-WRITE-GF-1-12. NC1264.2 +070200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +070300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +070400 MOVE 72 TO LENGTH-COUNTER. NC1264.2 +070500 GO TO LEV-WRITE-GF-1-12. NC1264.2 +070600 LEV-DELETE-GF-1-12. NC1264.2 +070700 PERFORM DE-LETE. NC1264.2 +070800 LEV-WRITE-GF-1-12. NC1264.2 +070900 MOVE "LEV-TEST-GF-1-12" TO PAR-NAME. NC1264.2 +071000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +071100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +071200 PERFORM PRINT-DETAIL. NC1264.2 +071300 LEV-TEST-GF-13. NC1264.2 +071400 IF TBGRP-13 EQUAL TO SPACE NC1264.2 +071500 PERFORM PASS NC1264.2 +071600 GO TO LEV-WRITE-GF-1-13. NC1264.2 +071700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +071800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +071900 MOVE 70 TO LENGTH-COUNTER. NC1264.2 +072000 GO TO LEV-WRITE-GF-1-13. NC1264.2 +072100 LEV-DELETE-GF-1-13. NC1264.2 +072200 PERFORM DE-LETE. NC1264.2 +072300 LEV-WRITE-GF-1-13. NC1264.2 +072400 MOVE "LEV-TEST-GF-1-13" TO PAR-NAME. NC1264.2 +072500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +072600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +072700 PERFORM PRINT-DETAIL. NC1264.2 +072800 LEV-TEST-GF-1-14. NC1264.2 +072900 IF TBGRP-14 EQUAL TO SPACE NC1264.2 +073000 PERFORM PASS NC1264.2 +073100 GO TO LEV-WRITE-GF-1-14. NC1264.2 +073200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +073300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +073400 MOVE 68 TO LENGTH-COUNTER. NC1264.2 +073500 GO TO LEV-WRITE-GF-1-14. NC1264.2 +073600 LEV-DELETE-GF-1-14. NC1264.2 +073700 PERFORM DE-LETE. NC1264.2 +073800 LEV-WRITE-GF-1-14. NC1264.2 +073900 MOVE "LEV-TEST-GF-1-14" TO PAR-NAME. NC1264.2 +074000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +074100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +074200 PERFORM PRINT-DETAIL. NC1264.2 +074300 LEV-TEST-GF-1-15. NC1264.2 +074400 IF TBGRP-15 EQUAL TO SPACE NC1264.2 +074500 PERFORM PASS NC1264.2 +074600 GO TO LEV-WRITE-GF-1-15. NC1264.2 +074700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +074800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +074900 MOVE 66 TO LENGTH-COUNTER. NC1264.2 +075000 GO TO LEV-WRITE-GF-1-15. NC1264.2 +075100 LEV-DELETE-GF-1-15. NC1264.2 +075200 PERFORM DE-LETE. NC1264.2 +075300 LEV-WRITE-GF-1-15. NC1264.2 +075400 MOVE "LEV-TEST-GF-1-15" TO PAR-NAME. NC1264.2 +075500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +075600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +075700 PERFORM PRINT-DETAIL. NC1264.2 +075800 LEV-TEST-GF-1-16. NC1264.2 +075900 IF TBGRP-16 EQUAL TO SPACE NC1264.2 +076000 PERFORM PASS NC1264.2 +076100 GO TO LEV-WRITE-GF-1-16. NC1264.2 +076200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +076300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +076400 MOVE 64 TO LENGTH-COUNTER. NC1264.2 +076500 GO TO LEV-WRITE-GF-1-16. NC1264.2 +076600 LEV-DELETE-GF-1-16. NC1264.2 +076700 PERFORM DE-LETE. NC1264.2 +076800 LEV-WRITE-GF-1-16. NC1264.2 +076900 MOVE "LEV-TEST-GF-1-16" TO PAR-NAME. NC1264.2 +077000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +077100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +077200 PERFORM PRINT-DETAIL. NC1264.2 +077300 LEV-TEST-GF-1-17. NC1264.2 +077400 IF TBGRP-17 EQUAL TO SPACE NC1264.2 +077500 PERFORM PASS NC1264.2 +077600 GO TO LEV-WRITE-GF-1-17. NC1264.2 +077700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +077800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +077900 MOVE 62 TO LENGTH-COUNTER. NC1264.2 +078000 GO TO LEV-WRITE-GF-1-17. NC1264.2 +078100 LEV-DELETE-GF-1-17. NC1264.2 +078200 PERFORM DE-LETE. NC1264.2 +078300 LEV-WRITE-GF-1-17. NC1264.2 +078400 MOVE "LEV-TEST-GF-1-17" TO PAR-NAME. NC1264.2 +078500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +078600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +078700 PERFORM PRINT-DETAIL. NC1264.2 +078800 LEV-TEST-GF-1-18. NC1264.2 +078900 IF TBGRP-18 EQUAL TO SPACE NC1264.2 +079000 PERFORM PASS NC1264.2 +079100 GO TO LEV-WRITE-GF-1-18. NC1264.2 +079200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +079300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +079400 MOVE 60 TO LENGTH-COUNTER. NC1264.2 +079500 GO TO LEV-WRITE-GF-1-18. NC1264.2 +079600 LEV-DELETE-GF-1-18. NC1264.2 +079700 PERFORM DE-LETE. NC1264.2 +079800 LEV-WRITE-GF-1-18. NC1264.2 +079900 MOVE "LEV-TEST-GF-1-18" TO PAR-NAME. NC1264.2 +080000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +080100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +080200 PERFORM PRINT-DETAIL. NC1264.2 +080300 LEV-TEST-GF-1-19. NC1264.2 +080400 IF TBGRP-19 EQUAL TO SPACE NC1264.2 +080500 PERFORM PASS NC1264.2 +080600 GO TO LEV-WRITE-GF-1-19. NC1264.2 +080700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +080800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +080900 MOVE 58 TO LENGTH-COUNTER. NC1264.2 +081000 GO TO LEV-WRITE-GF-1-19. NC1264.2 +081100 LEV-DELETE-GF-1-19. NC1264.2 +081200 PERFORM DE-LETE. NC1264.2 +081300 LEV-WRITE-GF-1-19. NC1264.2 +081400 MOVE "LEV-TEST-GF-1-19" TO PAR-NAME. NC1264.2 +081500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +081600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +081700 PERFORM PRINT-DETAIL. NC1264.2 +081800 LEV-TEST-GF-1-20. NC1264.2 +081900 IF TBGRP-20 EQUAL TO SPACE NC1264.2 +082000 PERFORM PASS NC1264.2 +082100 GO TO LEV-WRITE-GF-1-20. NC1264.2 +082200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +082300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +082400 MOVE 56 TO LENGTH-COUNTER. NC1264.2 +082500 GO TO LEV-WRITE-GF-1-20. NC1264.2 +082600 LEV-DELETE-GF-1-20. NC1264.2 +082700 PERFORM DE-LETE. NC1264.2 +082800 LEV-WRITE-GF-1-20. NC1264.2 +082900 MOVE "LEV-TEST-GF-1-20" TO PAR-NAME. NC1264.2 +083000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +083100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +083200 PERFORM PRINT-DETAIL. NC1264.2 +083300 LEV-TEST-GF-1-21. NC1264.2 +083400 IF TBGRP-21 EQUAL TO SPACE NC1264.2 +083500 PERFORM PASS NC1264.2 +083600 GO TO LEV-WRITE-GF-1-21. NC1264.2 +083700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +083800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +083900 MOVE 54 TO LENGTH-COUNTER. NC1264.2 +084000 GO TO LEV-WRITE-GF-1-21. NC1264.2 +084100 LEV-DELETE-GF-1-21. NC1264.2 +084200 PERFORM DE-LETE. NC1264.2 +084300 LEV-WRITE-GF-1-21. NC1264.2 +084400 MOVE "LEV-TEST-GF-1-21" TO PAR-NAME. NC1264.2 +084500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +084600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +084700 PERFORM PRINT-DETAIL. NC1264.2 +084800 LEV-TEST-GF-1-22. NC1264.2 +084900 IF TBGRP-22 EQUAL TO SPACE NC1264.2 +085000 PERFORM PASS NC1264.2 +085100 GO TO LEV-WRITE-GF-1-22. NC1264.2 +085200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +085300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +085400 MOVE 52 TO LENGTH-COUNTER. NC1264.2 +085500 GO TO LEV-WRITE-GF-1-22. NC1264.2 +085600 LEV-DELETE-GF-1-22. NC1264.2 +085700 PERFORM DE-LETE. NC1264.2 +085800 LEV-WRITE-GF-1-22. NC1264.2 +085900 MOVE "LEV-TEST-GF-1-22" TO PAR-NAME. NC1264.2 +086000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +086100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +086200 PERFORM PRINT-DETAIL. NC1264.2 +086300 LEV-TEST-GF-1-23. NC1264.2 +086400 IF TBGRP-23 EQUAL TO SPACE NC1264.2 +086500 PERFORM PASS NC1264.2 +086600 GO TO LEV-WRITE-GF-1-23. NC1264.2 +086700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +086800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +086900 MOVE 50 TO LENGTH-COUNTER. NC1264.2 +087000 GO TO LEV-WRITE-GF-1-23. NC1264.2 +087100 LEV-DELETE-GF-1-23. NC1264.2 +087200 PERFORM DE-LETE. NC1264.2 +087300 LEV-WRITE-GF-1-23. NC1264.2 +087400 MOVE "LEV-TEST-GF-1-23" TO PAR-NAME. NC1264.2 +087500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +087600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +087700 PERFORM PRINT-DETAIL. NC1264.2 +087800 LEV-TEST-GF-1-24. NC1264.2 +087900 IF TBGRP-24 EQUAL TO SPACE NC1264.2 +088000 PERFORM PASS NC1264.2 +088100 GO TO LEV-WRITE-GF-1-24. NC1264.2 +088200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +088300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +088400 MOVE 48 TO LENGTH-COUNTER. NC1264.2 +088500 GO TO LEV-WRITE-GF-1-24. NC1264.2 +088600 LEV-DELETE-GF-1-24. NC1264.2 +088700 PERFORM DE-LETE. NC1264.2 +088800 LEV-WRITE-GF-1-24. NC1264.2 +088900 MOVE "LEV-TEST-GF-1-24" TO PAR-NAME. NC1264.2 +089000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +089100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +089200 PERFORM PRINT-DETAIL. NC1264.2 +089300 LEV-TEST-GF-1-25. NC1264.2 +089400 IF TBGRP-25 EQUAL TO SPACE NC1264.2 +089500 PERFORM PASS NC1264.2 +089600 GO TO LEV-WRITE-GF-1-25. NC1264.2 +089700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +089800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +089900 MOVE 46 TO LENGTH-COUNTER. NC1264.2 +090000 GO TO LEV-WRITE-GF-1-25. NC1264.2 +090100 LEV-DELETE-GF-1-25. NC1264.2 +090200 PERFORM DE-LETE. NC1264.2 +090300 LEV-WRITE-GF-1-25. NC1264.2 +090400 MOVE "LEV-TEST-GF-1-25" TO PAR-NAME. NC1264.2 +090500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +090600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +090700 PERFORM PRINT-DETAIL. NC1264.2 +090800 LEV-TEST-GF-1-26. NC1264.2 +090900 IF TBGRP-26 EQUAL TO SPACE NC1264.2 +091000 PERFORM PASS NC1264.2 +091100 GO TO LEV-WRITE-GF-1-26. NC1264.2 +091200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +091300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +091400 MOVE 44 TO LENGTH-COUNTER. NC1264.2 +091500 GO TO LEV-WRITE-GF-1-26. NC1264.2 +091600 LEV-DELETE-GF-1-26. NC1264.2 +091700 PERFORM DE-LETE. NC1264.2 +091800 LEV-WRITE-GF-1-26. NC1264.2 +091900 MOVE "LEV-TEST-GF-1-26" TO PAR-NAME. NC1264.2 +092000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +092100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +092200 PERFORM PRINT-DETAIL. NC1264.2 +092300 LEV-TEST-GF-1-27. NC1264.2 +092400 IF TBGRP-27 EQUAL TO SPACE NC1264.2 +092500 PERFORM PASS NC1264.2 +092600 GO TO LEV-WRITE-GF-1-27. NC1264.2 +092700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +092800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +092900 MOVE 42 TO LENGTH-COUNTER. NC1264.2 +093000 GO TO LEV-WRITE-GF-1-27. NC1264.2 +093100 LEV-DELETE-GF-1-27. NC1264.2 +093200 PERFORM DE-LETE. NC1264.2 +093300 LEV-WRITE-GF-1-27. NC1264.2 +093400 MOVE "LEV-TEST-GF-1-27" TO PAR-NAME. NC1264.2 +093500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +093600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +093700 PERFORM PRINT-DETAIL. NC1264.2 +093800 LEV-TEST-GF-1-28. NC1264.2 +093900 IF TBGRP-28 EQUAL TO SPACE NC1264.2 +094000 PERFORM PASS NC1264.2 +094100 GO TO LEV-WRITE-GF-1-28. NC1264.2 +094200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +094300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +094400 MOVE 40 TO LENGTH-COUNTER. NC1264.2 +094500 GO TO LEV-WRITE-GF-1-28. NC1264.2 +094600 LEV-DELETE-GF-1-28. NC1264.2 +094700 PERFORM DE-LETE. NC1264.2 +094800 LEV-WRITE-GF-1-28. NC1264.2 +094900 MOVE "LEV-TEST-GF-1-28" TO PAR-NAME. NC1264.2 +095000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +095100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +095200 PERFORM PRINT-DETAIL. NC1264.2 +095300 LEV-TEST-GF-1-29. NC1264.2 +095400 IF TBGRP-29 EQUAL TO SPACE NC1264.2 +095500 PERFORM PASS NC1264.2 +095600 GO TO LEV-WRITE-GF-1-29. NC1264.2 +095700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +095800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +095900 MOVE 38 TO LENGTH-COUNTER. NC1264.2 +096000 GO TO LEV-WRITE-GF-1-29. NC1264.2 +096100 LEV-DELETE-GF-1-29. NC1264.2 +096200 PERFORM DE-LETE. NC1264.2 +096300 LEV-WRITE-GF-1-29. NC1264.2 +096400 MOVE "LEV-TEST-GF-1-29" TO PAR-NAME. NC1264.2 +096500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +096600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +096700 PERFORM PRINT-DETAIL. NC1264.2 +096800 LEV-TEST-GF-1-30. NC1264.2 +096900 IF TBGRP-30 EQUAL TO SPACE NC1264.2 +097000 PERFORM PASS NC1264.2 +097100 GO TO LEV-WRITE-GF-1-30. NC1264.2 +097200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +097300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +097400 MOVE 36 TO LENGTH-COUNTER. NC1264.2 +097500 GO TO LEV-WRITE-GF-1-30. NC1264.2 +097600 LEV-DELETE-GF-1-30. NC1264.2 +097700 PERFORM DE-LETE. NC1264.2 +097800 LEV-WRITE-GF-1-30. NC1264.2 +097900 MOVE "LEV-TEST-GF-1-30" TO PAR-NAME. NC1264.2 +098000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +098100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +098200 PERFORM PRINT-DETAIL. NC1264.2 +098300 LEV-TEST-GF-1-31. NC1264.2 +098400 IF TBGRP-31 EQUAL TO SPACE NC1264.2 +098500 PERFORM PASS NC1264.2 +098600 GO TO LEV-WRITE-GF-1-31. NC1264.2 +098700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +098800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +098900 MOVE 34 TO LENGTH-COUNTER. NC1264.2 +099000 GO TO LEV-WRITE-GF-1-31. NC1264.2 +099100 LEV-DELETE-GF-1-31. NC1264.2 +099200 PERFORM DE-LETE. NC1264.2 +099300 LEV-WRITE-GF-1-31. NC1264.2 +099400 MOVE "LEV-TEST-GF-1-31" TO PAR-NAME. NC1264.2 +099500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +099600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +099700 PERFORM PRINT-DETAIL. NC1264.2 +099800 LEV-TEST-GF-1-32. NC1264.2 +099900 IF TBGRP-32 EQUAL TO SPACE NC1264.2 +100000 PERFORM PASS NC1264.2 +100100 GO TO LEV-WRITE-GF-1-32. NC1264.2 +100200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +100300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +100400 MOVE 32 TO LENGTH-COUNTER. NC1264.2 +100500 GO TO LEV-WRITE-GF-1-32. NC1264.2 +100600 LEV-DELETE-GF-1-32. NC1264.2 +100700 PERFORM DE-LETE. NC1264.2 +100800 LEV-WRITE-GF-1-32. NC1264.2 +100900 MOVE "LEV-TEST-GF-1-32" TO PAR-NAME. NC1264.2 +101000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +101100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +101200 PERFORM PRINT-DETAIL. NC1264.2 +101300 LEV-TEST-GF-1-33. NC1264.2 +101400 IF TBGRP-33 EQUAL TO SPACE NC1264.2 +101500 PERFORM PASS NC1264.2 +101600 GO TO LEV-WRITE-GF-1-33. NC1264.2 +101700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +101800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +101900 MOVE 30 TO LENGTH-COUNTER. NC1264.2 +102000 GO TO LEV-WRITE-GF-1-33. NC1264.2 +102100 LEV-DELETE-GF-1-33. NC1264.2 +102200 PERFORM DE-LETE. NC1264.2 +102300 LEV-WRITE-GF-1-33. NC1264.2 +102400 MOVE "LEV-TEST-GF-1-33" TO PAR-NAME. NC1264.2 +102500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +102600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +102700 PERFORM PRINT-DETAIL. NC1264.2 +102800 LEV-TEST-GF-1-34. NC1264.2 +102900 IF TBGRP-34 EQUAL TO SPACE NC1264.2 +103000 PERFORM PASS NC1264.2 +103100 GO TO LEV-WRITE-GF-1-34. NC1264.2 +103200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +103300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +103400 MOVE 28 TO LENGTH-COUNTER. NC1264.2 +103500 GO TO LEV-WRITE-GF-1-34. NC1264.2 +103600 LEV-DELETE-GF-1-34. NC1264.2 +103700 PERFORM DE-LETE. NC1264.2 +103800 LEV-WRITE-GF-1-34. NC1264.2 +103900 MOVE "LEV-TEST-GF-1-34" TO PAR-NAME. NC1264.2 +104000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +104100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +104200 PERFORM PRINT-DETAIL. NC1264.2 +104300 LEV-TEST-GF-1-35. NC1264.2 +104400 IF TBGRP-35 EQUAL TO SPACE NC1264.2 +104500 PERFORM PASS NC1264.2 +104600 GO TO LEV-WRITE-GF-1-35. NC1264.2 +104700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +104800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +104900 MOVE 26 TO LENGTH-COUNTER. NC1264.2 +105000 GO TO LEV-WRITE-GF-1-35. NC1264.2 +105100 LEV-DELETE-GF-1-35. NC1264.2 +105200 PERFORM DE-LETE. NC1264.2 +105300 LEV-WRITE-GF-1-35. NC1264.2 +105400 MOVE "LEV-TEST-GF-1-35" TO PAR-NAME. NC1264.2 +105500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +105600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +105700 PERFORM PRINT-DETAIL. NC1264.2 +105800 LEV-TEST-GF-1-36. NC1264.2 +105900 IF TBGRP-36 EQUAL TO SPACE NC1264.2 +106000 PERFORM PASS NC1264.2 +106100 GO TO LEV-WRITE-GF-1-36. NC1264.2 +106200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +106300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +106400 MOVE 24 TO LENGTH-COUNTER. NC1264.2 +106500 GO TO LEV-WRITE-GF-1-36. NC1264.2 +106600 LEV-DELETE-GF-1-36. NC1264.2 +106700 PERFORM DE-LETE. NC1264.2 +106800 LEV-WRITE-GF-1-36. NC1264.2 +106900 MOVE "LEV-TEST-GF-1-36" TO PAR-NAME. NC1264.2 +107000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +107100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +107200 PERFORM PRINT-DETAIL. NC1264.2 +107300 LEV-TEST-GF-1-37. NC1264.2 +107400 IF TBGRP-37 EQUAL TO SPACE NC1264.2 +107500 PERFORM PASS NC1264.2 +107600 GO TO LEV-WRITE-GF-1-37. NC1264.2 +107700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +107800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +107900 MOVE 22 TO LENGTH-COUNTER. NC1264.2 +108000 GO TO LEV-WRITE-GF-1-37. NC1264.2 +108100 LEV-DELETE-GF-1-37. NC1264.2 +108200 PERFORM DE-LETE. NC1264.2 +108300 LEV-WRITE-GF-1-37. NC1264.2 +108400 MOVE "LEV-TEST-GF-1-37" TO PAR-NAME. NC1264.2 +108500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +108600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +108700 PERFORM PRINT-DETAIL. NC1264.2 +108800 LEV-TEST-GF-1-38. NC1264.2 +108900 IF TBGRP-38 EQUAL TO SPACE NC1264.2 +109000 PERFORM PASS NC1264.2 +109100 GO TO LEV-WRITE-GF-1-38. NC1264.2 +109200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +109300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +109400 MOVE 20 TO LENGTH-COUNTER. NC1264.2 +109500 GO TO LEV-WRITE-GF-1-38. NC1264.2 +109600 LEV-DELETE-GF-1-38. NC1264.2 +109700 PERFORM DE-LETE. NC1264.2 +109800 LEV-WRITE-GF-1-38. NC1264.2 +109900 MOVE "LEV-TEST-GF-1-38" TO PAR-NAME. NC1264.2 +110000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +110100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +110200 PERFORM PRINT-DETAIL. NC1264.2 +110300 LEV-TEST-GF-1-39. NC1264.2 +110400 IF TBGRP-39 EQUAL TO SPACE NC1264.2 +110500 PERFORM PASS NC1264.2 +110600 GO TO LEV-WRITE-GF-1-39. NC1264.2 +110700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +110800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +110900 MOVE 18 TO LENGTH-COUNTER. NC1264.2 +111000 GO TO LEV-WRITE-GF-1-39. NC1264.2 +111100 LEV-DELETE-GF-1-39. NC1264.2 +111200 PERFORM DE-LETE. NC1264.2 +111300 LEV-WRITE-GF-1-39. NC1264.2 +111400 MOVE "LEV-TEST-GF-1-39" TO PAR-NAME. NC1264.2 +111500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +111600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +111700 PERFORM PRINT-DETAIL. NC1264.2 +111800 LEV-TEST-GF-1-40. NC1264.2 +111900 IF TBGRP-40 EQUAL TO SPACE NC1264.2 +112000 PERFORM PASS NC1264.2 +112100 GO TO LEV-WRITE-GF-1-40. NC1264.2 +112200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +112300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +112400 MOVE 16 TO LENGTH-COUNTER. NC1264.2 +112500 GO TO LEV-WRITE-GF-1-40. NC1264.2 +112600 LEV-DELETE-GF-1-40. NC1264.2 +112700 PERFORM DE-LETE. NC1264.2 +112800 LEV-WRITE-GF-1-40. NC1264.2 +112900 MOVE "LEV-TEST-GF-1-40" TO PAR-NAME. NC1264.2 +113000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +113100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +113200 PERFORM PRINT-DETAIL. NC1264.2 +113300 LEV-TEST-GF-1-41. NC1264.2 +113400 IF TBGRP-41 EQUAL TO SPACE NC1264.2 +113500 PERFORM PASS NC1264.2 +113600 GO TO LEV-WRITE-GF-1-41. NC1264.2 +113700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +113800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +113900 MOVE 14 TO LENGTH-COUNTER. NC1264.2 +114000 GO TO LEV-WRITE-GF-1-41. NC1264.2 +114100 LEV-DELETE-GF-1-41. NC1264.2 +114200 PERFORM DE-LETE. NC1264.2 +114300 LEV-WRITE-GF-1-41. NC1264.2 +114400 MOVE "LEV-TEST-GF-1-41" TO PAR-NAME. NC1264.2 +114500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +114600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +114700 PERFORM PRINT-DETAIL. NC1264.2 +114800 LEV-TEST-GF-1-42. NC1264.2 +114900 IF TBGRP-42 EQUAL TO SPACE NC1264.2 +115000 PERFORM PASS NC1264.2 +115100 GO TO LEV-WRITE-GF-1-42. NC1264.2 +115200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +115300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +115400 MOVE 12 TO LENGTH-COUNTER. NC1264.2 +115500 GO TO LEV-WRITE-GF-1-42. NC1264.2 +115600 LEV-DELETE-GF-1-42. NC1264.2 +115700 PERFORM DE-LETE. NC1264.2 +115800 LEV-WRITE-GF-1-42. NC1264.2 +115900 MOVE "LEV-TEST-GF-1-42" TO PAR-NAME. NC1264.2 +116000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +116100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +116200 PERFORM PRINT-DETAIL. NC1264.2 +116300 LEV-TEST-GF-1-43. NC1264.2 +116400 IF TBGRP-43 EQUAL TO SPACE NC1264.2 +116500 PERFORM PASS NC1264.2 +116600 GO TO LEV-WRITE-GF-1-43. NC1264.2 +116700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +116800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +116900 MOVE 10 TO LENGTH-COUNTER. NC1264.2 +117000 GO TO LEV-WRITE-GF-1-43. NC1264.2 +117100 LEV-DELETE-GF-1-43. NC1264.2 +117200 PERFORM DE-LETE. NC1264.2 +117300 LEV-WRITE-GF-1-43. NC1264.2 +117400 MOVE "LEV-TEST-GF-1-43" TO PAR-NAME. NC1264.2 +117500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +117600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +117700 PERFORM PRINT-DETAIL. NC1264.2 +117800 LEV-TEST-GF-1-44. NC1264.2 +117900 IF TBGRP-44 EQUAL TO SPACE NC1264.2 +118000 PERFORM PASS NC1264.2 +118100 GO TO LEV-WRITE-GF-1-44. NC1264.2 +118200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +118300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +118400 MOVE 8 TO LENGTH-COUNTER. NC1264.2 +118500 GO TO LEV-WRITE-GF-1-44. NC1264.2 +118600 LEV-DELETE-GF-1-44. NC1264.2 +118700 PERFORM DE-LETE. NC1264.2 +118800 LEV-WRITE-GF-1-44. NC1264.2 +118900 MOVE "LEV-TEST-GF-1-44" TO PAR-NAME. NC1264.2 +119000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +119100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +119200 PERFORM PRINT-DETAIL. NC1264.2 +119300 LEV-TEST-GF-1-45. NC1264.2 +119400 IF TBGRP-45 EQUAL TO SPACE NC1264.2 +119500 PERFORM PASS NC1264.2 +119600 GO TO LEV-WRITE-GF-1-45. NC1264.2 +119700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +119800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +119900 MOVE 6 TO LENGTH-COUNTER. NC1264.2 +120000 GO TO LEV-WRITE-GF-1-45. NC1264.2 +120100 LEV-DELETE-GF-1-45. NC1264.2 +120200 PERFORM DE-LETE. NC1264.2 +120300 LEV-WRITE-GF-1-45. NC1264.2 +120400 MOVE "LEV-TEST-GF-1-45" TO PAR-NAME. NC1264.2 +120500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +120600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +120700 PERFORM PRINT-DETAIL. NC1264.2 +120800 LEV-TEST-GF-1-46. NC1264.2 +120900 IF TBGRP-46 EQUAL TO SPACE NC1264.2 +121000 PERFORM PASS NC1264.2 +121100 GO TO LEV-WRITE-GF-1-46. NC1264.2 +121200 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +121300 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +121400 MOVE 4 TO LENGTH-COUNTER. NC1264.2 +121500 GO TO LEV-WRITE-GF-1-46. NC1264.2 +121600 LEV-DELETE-GF-1-46. NC1264.2 +121700 PERFORM DE-LETE. NC1264.2 +121800 LEV-WRITE-GF-1-46. NC1264.2 +121900 MOVE "LEV-TEST-GF-1-46" TO PAR-NAME. NC1264.2 +122000 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +122100 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +122200 PERFORM PRINT-DETAIL. NC1264.2 +122300 LEV-TEST-GF-1-47. NC1264.2 +122400 IF TBGRP-47 EQUAL TO SPACE NC1264.2 +122500 PERFORM PASS NC1264.2 +122600 GO TO LEV-WRITE-GF-1-47. NC1264.2 +122700 MOVE TABLE-GROUP TO COMPUTED-BREAKDOWN. NC1264.2 +122800 MOVE SPACE TO CORRECT-BREAKDOWN. NC1264.2 +122900 MOVE 2 TO LENGTH-COUNTER. NC1264.2 +123000 GO TO LEV-WRITE-GF-1-47. NC1264.2 +123100 LEV-DELETE-GF-1-47. NC1264.2 +123200 PERFORM DE-LETE. NC1264.2 +123300 LEV-WRITE-GF-1-47. NC1264.2 +123400 MOVE "LEV-TEST-GF-1-47" TO PAR-NAME. NC1264.2 +123500 IF LENGTH-COUNTER GREATER THAN ZERO NC1264.2 +123600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. NC1264.2 +123700 PERFORM PRINT-DETAIL. NC1264.2 +123800 LEV-INIT-GF-2-1. NC1264.2 +123900 MOVE "VI-21 5.3.3 SR1" TO ANSI-REFERENCE. NC1264.2 +124000 PERFORM END-ROUTINE. NC1264.2 +124100 MOVE SPACE TO PRINT-REC. NC1264.2 +124200 MOVE "ALPHA MOVED TO GROUP" TO FEATURE. NC1264.2 +124300 PERFORM PRINT-DETAIL. NC1264.2 +124400 MOVE "ELEMENTRY ITEM CHK" TO FEATURE. NC1264.2 +124500 MOVE "ABCDEFGHIJKLMNOPQRST" TO A-PART-98. NC1264.2 +124600 MOVE "01234567899876543210" TO B-PART-98. NC1264.2 +124700 MOVE "SUPERCALIFRAGILISTIC" TO C-PART-98. NC1264.2 +124800 MOVE "THAT LITERAL WAS BAD" TO D-PART-98. NC1264.2 +124900 MOVE "UP ON THE ROOFS" TO E-PART-98. NC1264.2 +125000 MOVE LITERAL-98 TO TABLE-GROUP. NC1264.2 +125100 LEV-TEST-GF-2-1. NC1264.2 +125200 IF TB-1 EQUAL TO "AB" NC1264.2 +125300 PERFORM PASS NC1264.2 +125400 GO TO LEV-WRITE-GF-2-1. NC1264.2 +125500 PERFORM FAIL. NC1264.2 +125600 MOVE TB-1 TO COMPUTED-A. NC1264.2 +125700 MOVE "AB" TO CORRECT-A. NC1264.2 +125800 GO TO LEV-WRITE-GF-2-1. NC1264.2 +125900 LEV-DELETE-GF-2-1. NC1264.2 +126000 PERFORM DE-LETE. NC1264.2 +126100 LEV-WRITE-GF-2-1. NC1264.2 +126200 MOVE "LEV-TEST-GF-2-1" TO PAR-NAME. NC1264.2 +126300 PERFORM PRINT-DETAIL. NC1264.2 +126400 LEV-TEST-GF-2-2. NC1264.2 +126500 IF TB-2 EQUAL TO "CD" NC1264.2 +126600 PERFORM PASS NC1264.2 +126700 GO TO LEV-WRITE-GF-2-2. NC1264.2 +126800 PERFORM FAIL. NC1264.2 +126900 MOVE TB-2 TO COMPUTED-A. NC1264.2 +127000 MOVE "CD" TO CORRECT-A. NC1264.2 +127100 GO TO LEV-WRITE-GF-2-2. NC1264.2 +127200 LEV-DELETE-GF-2-2. NC1264.2 +127300 PERFORM DE-LETE. NC1264.2 +127400 LEV-WRITE-GF-2-2. NC1264.2 +127500 MOVE "LEV-TEST-GF-2-2" TO PAR-NAME. NC1264.2 +127600 PERFORM PRINT-DETAIL. NC1264.2 +127700 LEV-TEST-GF-2-3. NC1264.2 +127800 IF TB-3 EQUAL TO "EF" NC1264.2 +127900 PERFORM PASS NC1264.2 +128000 GO TO LEV-WRITE-GF-2-3. NC1264.2 +128100 PERFORM FAIL. NC1264.2 +128200 MOVE TB-3 TO COMPUTED-A. NC1264.2 +128300 MOVE "EF" TO CORRECT-A. NC1264.2 +128400 GO TO LEV-WRITE-GF-2-3. NC1264.2 +128500 LEV-DELETE-GF-2-3. NC1264.2 +128600 PERFORM DE-LETE. NC1264.2 +128700 LEV-WRITE-GF-2-3. NC1264.2 +128800 MOVE "LEV-TEST-GF-2-3" TO PAR-NAME. NC1264.2 +128900 PERFORM PRINT-DETAIL. NC1264.2 +129000 LEV-TEST-GF-2-4. NC1264.2 +129100 IF TB-4 EQUAL TO "GH" NC1264.2 +129200 PERFORM PASS NC1264.2 +129300 GO TO LEV-WRITE-GF-2-4. NC1264.2 +129400 PERFORM FAIL. NC1264.2 +129500 MOVE TB-4 TO COMPUTED-A. NC1264.2 +129600 MOVE "GH" TO CORRECT-A. NC1264.2 +129700 GO TO LEV-WRITE-GF-2-4. NC1264.2 +129800 LEV-DELETE-GF-2-4. NC1264.2 +129900 PERFORM DE-LETE. NC1264.2 +130000 LEV-WRITE-GF-2-4. NC1264.2 +130100 MOVE "LEV-TEST-GF-2-4" TO PAR-NAME. NC1264.2 +130200 PERFORM PRINT-DETAIL. NC1264.2 +130300 LEV-TEST-GF-2-5. NC1264.2 +130400 IF TB-5 EQUAL TO "IJ" NC1264.2 +130500 PERFORM PASS NC1264.2 +130600 GO TO LEV-WRITE-GF-2-5. NC1264.2 +130700 PERFORM FAIL. NC1264.2 +130800 MOVE TB-5 TO COMPUTED-A. NC1264.2 +130900 MOVE "IJ" TO CORRECT-A. NC1264.2 +131000 GO TO LEV-WRITE-GF-2-5. NC1264.2 +131100 LEV-DELETE-GF-2-5. NC1264.2 +131200 PERFORM DE-LETE. NC1264.2 +131300 LEV-WRITE-GF-2-5. NC1264.2 +131400 MOVE "LEV-TEST-GF-2-5" TO PAR-NAME. NC1264.2 +131500 PERFORM PRINT-DETAIL. NC1264.2 +131600 LEV-TEST-GF-2-6. NC1264.2 +131700 IF TB-6 EQUAL TO "KL" NC1264.2 +131800 PERFORM PASS NC1264.2 +131900 GO TO LEV-WRITE-GF-2-6. NC1264.2 +132000 PERFORM FAIL. NC1264.2 +132100 MOVE TB-6 TO COMPUTED-A. NC1264.2 +132200 MOVE "KL" TO CORRECT-A. NC1264.2 +132300 GO TO LEV-WRITE-GF-2-6. NC1264.2 +132400 LEV-DELETE-GF-2-6. NC1264.2 +132500 PERFORM DE-LETE. NC1264.2 +132600 LEV-WRITE-GF-2-6. NC1264.2 +132700 MOVE "LEV-TEST-GF-2-6" TO PAR-NAME. NC1264.2 +132800 PERFORM PRINT-DETAIL. NC1264.2 +132900 LEV-TEST-GF-2-7. NC1264.2 +133000 IF TB-7 EQUAL TO "MN" NC1264.2 +133100 PERFORM PASS NC1264.2 +133200 GO TO LEV-WRITE-GF-2-7. NC1264.2 +133300 PERFORM FAIL. NC1264.2 +133400 MOVE TB-7 TO COMPUTED-A. NC1264.2 +133500 MOVE "MN" TO CORRECT-A. NC1264.2 +133600 GO TO LEV-WRITE-GF-2-7. NC1264.2 +133700 LEV-DELETE-GF-2-7. NC1264.2 +133800 PERFORM DE-LETE. NC1264.2 +133900 LEV-WRITE-GF-2-7. NC1264.2 +134000 MOVE "LEV-TEST-GF-2-7" TO PAR-NAME. NC1264.2 +134100 PERFORM PRINT-DETAIL. NC1264.2 +134200 LEV-TEST-GF-2-8. NC1264.2 +134300 IF TB-8 EQUAL TO "OP" NC1264.2 +134400 PERFORM PASS NC1264.2 +134500 GO TO LEV-WRITE-GF-2-8. NC1264.2 +134600 PERFORM FAIL. NC1264.2 +134700 MOVE TB-8 TO COMPUTED-A. NC1264.2 +134800 MOVE "OP" TO CORRECT-A. NC1264.2 +134900 GO TO LEV-WRITE-GF-2-8. NC1264.2 +135000 LEV-DELETE-GF-2-8. NC1264.2 +135100 PERFORM DE-LETE. NC1264.2 +135200 LEV-WRITE-GF-2-8. NC1264.2 +135300 MOVE "LEV-TEST-GF-2-8" TO PAR-NAME. NC1264.2 +135400 PERFORM PRINT-DETAIL. NC1264.2 +135500 LEV-TEST-GF-2-9. NC1264.2 +135600 IF TB-9 EQUAL TO "QR" NC1264.2 +135700 PERFORM PASS NC1264.2 +135800 GO TO LEV-WRITE-GF-2-9. NC1264.2 +135900 PERFORM FAIL. NC1264.2 +136000 MOVE TB-9 TO COMPUTED-A. NC1264.2 +136100 MOVE "QR" TO CORRECT-A. NC1264.2 +136200 GO TO LEV-WRITE-GF-2-9. NC1264.2 +136300 LEV-DELETE-GF-2-9. NC1264.2 +136400 PERFORM DE-LETE. NC1264.2 +136500 LEV-WRITE-GF-2-9. NC1264.2 +136600 MOVE "LEV-TEST-GF-2-9" TO PAR-NAME. NC1264.2 +136700 PERFORM PRINT-DETAIL. NC1264.2 +136800 LEV-TEST-GF-2-10. NC1264.2 +136900 IF TB-10 EQUAL TO "ST" NC1264.2 +137000 PERFORM PASS NC1264.2 +137100 GO TO LEV-WRITE-GF-2-10. NC1264.2 +137200 PERFORM FAIL. NC1264.2 +137300 MOVE TB-10 TO COMPUTED-A. NC1264.2 +137400 MOVE "ST" TO CORRECT-A. NC1264.2 +137500 GO TO LEV-WRITE-GF-2-10. NC1264.2 +137600 LEV-DELETE-GF-2-10. NC1264.2 +137700 PERFORM DE-LETE. NC1264.2 +137800 LEV-WRITE-GF-2-10. NC1264.2 +137900 MOVE "LEV-TEST-GF-2-10" TO PAR-NAME. NC1264.2 +138000 PERFORM PRINT-DETAIL. NC1264.2 +138100 LEV-TEST-GF-2-11. NC1264.2 +138200 IF TB-11 EQUAL TO "01" NC1264.2 +138300 PERFORM PASS NC1264.2 +138400 GO TO LEV-WRITE-GF-2-11. NC1264.2 +138500 PERFORM FAIL. NC1264.2 +138600 MOVE TB-11 TO COMPUTED-A. NC1264.2 +138700 MOVE "01" TO CORRECT-A. NC1264.2 +138800 GO TO LEV-WRITE-GF-2-11. NC1264.2 +138900 LEV-DELETE-GF-2-11. NC1264.2 +139000 PERFORM DE-LETE. NC1264.2 +139100 LEV-WRITE-GF-2-11. NC1264.2 +139200 MOVE "LEV-TEST-GF-2-11" TO PAR-NAME. NC1264.2 +139300 PERFORM PRINT-DETAIL. NC1264.2 +139400 LEV-TEST-GF-2-12. NC1264.2 +139500 IF TB-12 EQUAL TO "23" NC1264.2 +139600 PERFORM PASS NC1264.2 +139700 GO TO LEV-WRITE-GF-2-12. NC1264.2 +139800 PERFORM FAIL. NC1264.2 +139900 MOVE TB-12 TO COMPUTED-A. NC1264.2 +140000 MOVE "23" TO CORRECT-A. NC1264.2 +140100 GO TO LEV-WRITE-GF-2-12. NC1264.2 +140200 LEV-DELETE-GF-2-12. NC1264.2 +140300 PERFORM DE-LETE. NC1264.2 +140400 LEV-WRITE-GF-2-12. NC1264.2 +140500 MOVE "LEV-TEST-GF-2-12" TO PAR-NAME. NC1264.2 +140600 PERFORM PRINT-DETAIL. NC1264.2 +140700 LEV-TEST-GF-2-13. NC1264.2 +140800 IF TB-13 EQUAL TO "45" NC1264.2 +140900 PERFORM PASS NC1264.2 +141000 GO TO LEV-WRITE-GF-2-13. NC1264.2 +141100 PERFORM FAIL. NC1264.2 +141200 MOVE TB-13 TO COMPUTED-A. NC1264.2 +141300 MOVE "45" TO CORRECT-A. NC1264.2 +141400 GO TO LEV-WRITE-GF-2-13. NC1264.2 +141500 LEV-DELETE-GF-2-13. NC1264.2 +141600 PERFORM DE-LETE. NC1264.2 +141700 LEV-WRITE-GF-2-13. NC1264.2 +141800 MOVE "LEV-TEST-GF-2-13" TO PAR-NAME. NC1264.2 +141900 PERFORM PRINT-DETAIL. NC1264.2 +142000 LEV-TEST-GF-2-14. NC1264.2 +142100 IF TB-14 EQUAL TO "67" NC1264.2 +142200 PERFORM PASS NC1264.2 +142300 GO TO LEV-WRITE-GF-2-14. NC1264.2 +142400 PERFORM FAIL. NC1264.2 +142500 MOVE TB-14 TO COMPUTED-A. NC1264.2 +142600 MOVE "67" TO CORRECT-A. NC1264.2 +142700 GO TO LEV-WRITE-GF-2-14. NC1264.2 +142800 LEV-DELETE-GF-2-14. NC1264.2 +142900 PERFORM DE-LETE. NC1264.2 +143000 LEV-WRITE-GF-2-14. NC1264.2 +143100 MOVE "LEV-TEST-GF-2-14" TO PAR-NAME. NC1264.2 +143200 PERFORM PRINT-DETAIL. NC1264.2 +143300 LEV-TEST-GF-2-15. NC1264.2 +143400 IF TB-15 EQUAL TO "89" NC1264.2 +143500 PERFORM PASS NC1264.2 +143600 GO TO LEV-WRITE-GF-2-15. NC1264.2 +143700 PERFORM FAIL. NC1264.2 +143800 MOVE TB-15 TO COMPUTED-A. NC1264.2 +143900 MOVE "89" TO CORRECT-A. NC1264.2 +144000 GO TO LEV-WRITE-GF-2-15. NC1264.2 +144100 LEV-DELETE-GF-2-15. NC1264.2 +144200 PERFORM DE-LETE. NC1264.2 +144300 LEV-WRITE-GF-2-15. NC1264.2 +144400 MOVE "LEV-TEST-GF-2-15" TO PAR-NAME. NC1264.2 +144500 PERFORM PRINT-DETAIL. NC1264.2 +144600 LEV-TEST-GF-2-16. NC1264.2 +144700 IF TB-16 EQUAL TO "98" NC1264.2 +144800 PERFORM PASS NC1264.2 +144900 GO TO LEV-WRITE-GF-2-16. NC1264.2 +145000 PERFORM FAIL. NC1264.2 +145100 MOVE TB-16 TO COMPUTED-A. NC1264.2 +145200 MOVE "98" TO CORRECT-A. NC1264.2 +145300 GO TO LEV-WRITE-GF-2-16. NC1264.2 +145400 LEV-DELETE-GF-2-16. NC1264.2 +145500 PERFORM DE-LETE. NC1264.2 +145600 LEV-WRITE-GF-2-16. NC1264.2 +145700 MOVE "LEV-TEST-GF-2-16" TO PAR-NAME. NC1264.2 +145800 PERFORM PRINT-DETAIL. NC1264.2 +145900 LEV-TEST-GF-2-17. NC1264.2 +146000 IF TB-17 EQUAL TO "76" NC1264.2 +146100 PERFORM PASS NC1264.2 +146200 GO TO LEV-WRITE-GF-2-17. NC1264.2 +146300 PERFORM FAIL. NC1264.2 +146400 MOVE TB-17 TO COMPUTED-A. NC1264.2 +146500 MOVE "76" TO CORRECT-A. NC1264.2 +146600 GO TO LEV-WRITE-GF-2-17. NC1264.2 +146700 LEV-DELETE-GF-2-17. NC1264.2 +146800 PERFORM DE-LETE. NC1264.2 +146900 LEV-WRITE-GF-2-17. NC1264.2 +147000 MOVE "LEV-TEST-GF-2-17" TO PAR-NAME. NC1264.2 +147100 PERFORM PRINT-DETAIL. NC1264.2 +147200 LEV-TEST-GF-2-18. NC1264.2 +147300 IF TB-18 EQUAL TO "54" NC1264.2 +147400 PERFORM PASS NC1264.2 +147500 GO TO LEV-WRITE-GF-2-18. NC1264.2 +147600 PERFORM FAIL. NC1264.2 +147700 MOVE TB-18 TO COMPUTED-A. NC1264.2 +147800 MOVE "54" TO CORRECT-A. NC1264.2 +147900 GO TO LEV-WRITE-GF-2-18. NC1264.2 +148000 LEV-DELETE-GF-2-18. NC1264.2 +148100 PERFORM DE-LETE. NC1264.2 +148200 LEV-WRITE-GF-2-18. NC1264.2 +148300 MOVE "LEV-TEST-GF-2-18" TO PAR-NAME. NC1264.2 +148400 PERFORM PRINT-DETAIL. NC1264.2 +148500 LEV-TEST-GF-2-19. NC1264.2 +148600 IF TB-19 EQUAL TO "32" NC1264.2 +148700 PERFORM PASS NC1264.2 +148800 GO TO LEV-WRITE-GF-2-19. NC1264.2 +148900 PERFORM FAIL. NC1264.2 +149000 MOVE TB-19 TO COMPUTED-A. NC1264.2 +149100 MOVE "32" TO CORRECT-A. NC1264.2 +149200 GO TO LEV-WRITE-GF-2-19. NC1264.2 +149300 LEV-DELETE-GF-2-19. NC1264.2 +149400 PERFORM DE-LETE. NC1264.2 +149500 LEV-WRITE-GF-2-19. NC1264.2 +149600 MOVE "LEV-TEST-GF-2-19" TO PAR-NAME. NC1264.2 +149700 PERFORM PRINT-DETAIL. NC1264.2 +149800 LEV-TEST-GF-2-20. NC1264.2 +149900 IF TB-20 EQUAL TO "10" NC1264.2 +150000 PERFORM PASS NC1264.2 +150100 GO TO LEV-WRITE-GF-2-20. NC1264.2 +150200 PERFORM FAIL. NC1264.2 +150300 MOVE TB-20 TO COMPUTED-A. NC1264.2 +150400 MOVE "10" TO CORRECT-A. NC1264.2 +150500 GO TO LEV-WRITE-GF-2-20. NC1264.2 +150600 LEV-DELETE-GF-2-20. NC1264.2 +150700 PERFORM DE-LETE. NC1264.2 +150800 LEV-WRITE-GF-2-20. NC1264.2 +150900 MOVE "LEV-TEST-GF-2-20" TO PAR-NAME. NC1264.2 +151000 PERFORM PRINT-DETAIL. NC1264.2 +151100 LEV-TEST-GF-2-21. NC1264.2 +151200 IF TB-21 EQUAL TO "SU" NC1264.2 +151300 PERFORM PASS NC1264.2 +151400 GO TO LEV-WRITE-GF-2-21. NC1264.2 +151500 PERFORM FAIL. NC1264.2 +151600 MOVE TB-21 TO COMPUTED-A. NC1264.2 +151700 MOVE "SU" TO CORRECT-A. NC1264.2 +151800 GO TO LEV-WRITE-GF-2-21. NC1264.2 +151900 LEV-DELETE-GF-2-21. NC1264.2 +152000 PERFORM DE-LETE. NC1264.2 +152100 LEV-WRITE-GF-2-21. NC1264.2 +152200 MOVE "LEV-TEST-GF-2-21" TO PAR-NAME. NC1264.2 +152300 PERFORM PRINT-DETAIL. NC1264.2 +152400 LEV-TEST-GF-2-22. NC1264.2 +152500 IF TB-22 EQUAL TO "PE" NC1264.2 +152600 PERFORM PASS NC1264.2 +152700 GO TO LEV-WRITE-GF-2-22. NC1264.2 +152800 PERFORM FAIL. NC1264.2 +152900 MOVE TB-22 TO COMPUTED-A. NC1264.2 +153000 MOVE "PE" TO CORRECT-A. NC1264.2 +153100 GO TO LEV-WRITE-GF-2-22. NC1264.2 +153200 LEV-DELETE-GF-2-22. NC1264.2 +153300 PERFORM DE-LETE. NC1264.2 +153400 LEV-WRITE-GF-2-22. NC1264.2 +153500 MOVE "LEV-TEST-GF-2-22" TO PAR-NAME. NC1264.2 +153600 PERFORM PRINT-DETAIL. NC1264.2 +153700 LEV-TEST-GF-2-23. NC1264.2 +153800 IF TB-23 EQUAL TO "RC" NC1264.2 +153900 PERFORM PASS NC1264.2 +154000 GO TO LEV-WRITE-GF-2-23. NC1264.2 +154100 PERFORM FAIL. NC1264.2 +154200 MOVE TB-23 TO COMPUTED-A. NC1264.2 +154300 MOVE "RC" TO CORRECT-A. NC1264.2 +154400 GO TO LEV-WRITE-GF-2-23. NC1264.2 +154500 LEV-DELETE-GF-2-23. NC1264.2 +154600 PERFORM DE-LETE. NC1264.2 +154700 LEV-WRITE-GF-2-23. NC1264.2 +154800 MOVE "LEV-TEST-GF-2-23" TO PAR-NAME. NC1264.2 +154900 PERFORM PRINT-DETAIL. NC1264.2 +155000 LEV-TEST-GF-2-24. NC1264.2 +155100 IF TB-24 EQUAL TO "AL" NC1264.2 +155200 PERFORM PASS NC1264.2 +155300 GO TO LEV-WRITE-GF-2-24. NC1264.2 +155400 PERFORM FAIL. NC1264.2 +155500 MOVE TB-24 TO COMPUTED-A. NC1264.2 +155600 MOVE "AL" TO CORRECT-A. NC1264.2 +155700 GO TO LEV-WRITE-GF-2-24. NC1264.2 +155800 LEV-DELETE-GF-2-24. NC1264.2 +155900 PERFORM DE-LETE. NC1264.2 +156000 LEV-WRITE-GF-2-24. NC1264.2 +156100 MOVE "LEV-TEST-GF-2-24" TO PAR-NAME. NC1264.2 +156200 PERFORM PRINT-DETAIL. NC1264.2 +156300 LEV-TEST-GF-2-25. NC1264.2 +156400 IF TB-25 EQUAL TO "IF" NC1264.2 +156500 PERFORM PASS NC1264.2 +156600 GO TO LEV-WRITE-GF-2-25. NC1264.2 +156700 PERFORM FAIL. NC1264.2 +156800 MOVE TB-25 TO COMPUTED-A. NC1264.2 +156900 MOVE "IF" TO CORRECT-A. NC1264.2 +157000 GO TO LEV-WRITE-GF-2-25. NC1264.2 +157100 LEV-DELETE-GF-2-25. NC1264.2 +157200 PERFORM DE-LETE. NC1264.2 +157300 LEV-WRITE-GF-2-25. NC1264.2 +157400 MOVE "LEV-TEST-GF-2-25" TO PAR-NAME. NC1264.2 +157500 PERFORM PRINT-DETAIL. NC1264.2 +157600 LEV-TEST-GF-2-26. NC1264.2 +157700 IF TB-26 EQUAL TO "RA" NC1264.2 +157800 PERFORM PASS NC1264.2 +157900 GO TO LEV-WRITE-GF-2-26. NC1264.2 +158000 PERFORM FAIL. NC1264.2 +158100 MOVE TB-26 TO COMPUTED-A. NC1264.2 +158200 MOVE "RA" TO CORRECT-A. NC1264.2 +158300 GO TO LEV-WRITE-GF-2-26. NC1264.2 +158400 LEV-DELETE-GF-2-26. NC1264.2 +158500 PERFORM DE-LETE. NC1264.2 +158600 LEV-WRITE-GF-2-26. NC1264.2 +158700 MOVE "LEV-TEST-GF-2-26" TO PAR-NAME. NC1264.2 +158800 PERFORM PRINT-DETAIL. NC1264.2 +158900 LEV-TEST-GF-2-27. NC1264.2 +159000 IF TB-27 EQUAL TO "GI" NC1264.2 +159100 PERFORM PASS NC1264.2 +159200 GO TO LEV-WRITE-GF-2-27. NC1264.2 +159300 PERFORM FAIL. NC1264.2 +159400 MOVE TB-27 TO COMPUTED-A. NC1264.2 +159500 MOVE "GI" TO CORRECT-A. NC1264.2 +159600 GO TO LEV-WRITE-GF-2-27. NC1264.2 +159700 LEV-DELETE-GF-2-27. NC1264.2 +159800 PERFORM DE-LETE. NC1264.2 +159900 LEV-WRITE-GF-2-27. NC1264.2 +160000 MOVE "LEV-TEST-GF-2-27" TO PAR-NAME. NC1264.2 +160100 PERFORM PRINT-DETAIL. NC1264.2 +160200 LEV-TEST-GF-2-28. NC1264.2 +160300 IF TB-28 EQUAL TO "LI" NC1264.2 +160400 PERFORM PASS NC1264.2 +160500 GO TO LEV-WRITE-GF-2-28. NC1264.2 +160600 PERFORM FAIL. NC1264.2 +160700 MOVE TB-29 TO COMPUTED-A. NC1264.2 +160800 MOVE "LI" TO CORRECT-A. NC1264.2 +160900 GO TO LEV-WRITE-GF-2-28. NC1264.2 +161000 LEV-DELETE-GF-2-28. NC1264.2 +161100 PERFORM DE-LETE. NC1264.2 +161200 LEV-WRITE-GF-2-28. NC1264.2 +161300 MOVE "LEV-TEST-GF-2-28" TO PAR-NAME. NC1264.2 +161400 PERFORM PRINT-DETAIL. NC1264.2 +161500 LEV-TEST-GF-2-29. NC1264.2 +161600 IF TB-29 EQUAL TO "ST" NC1264.2 +161700 PERFORM PASS NC1264.2 +161800 GO TO LEV-WRITE-GF-2-29. NC1264.2 +161900 PERFORM FAIL. NC1264.2 +162000 MOVE TB-29 TO COMPUTED-A. NC1264.2 +162100 MOVE "ST" TO CORRECT-A. NC1264.2 +162200 GO TO LEV-WRITE-GF-2-29. NC1264.2 +162300 LEV-DELETE-GF-2-29. NC1264.2 +162400 PERFORM DE-LETE. NC1264.2 +162500 LEV-WRITE-GF-2-29. NC1264.2 +162600 MOVE "LEV-TEST-GF-2-29" TO PAR-NAME. NC1264.2 +162700 PERFORM PRINT-DETAIL. NC1264.2 +162800 LEV-TEST-GF-2-30. NC1264.2 +162900 IF TB-30 EQUAL TO "IC" NC1264.2 +163000 PERFORM PASS NC1264.2 +163100 GO TO LEV-WRITE-GF-2-30. NC1264.2 +163200 PERFORM FAIL. NC1264.2 +163300 MOVE TB-30 TO COMPUTED-A. NC1264.2 +163400 MOVE "IC" TO CORRECT-A. NC1264.2 +163500 GO TO LEV-WRITE-GF-2-30. NC1264.2 +163600 LEV-DELETE-GF-2-30. NC1264.2 +163700 PERFORM DE-LETE. NC1264.2 +163800 LEV-WRITE-GF-2-30. NC1264.2 +163900 MOVE "LEV-TEST-GF-2-30" TO PAR-NAME. NC1264.2 +164000 PERFORM PRINT-DETAIL. NC1264.2 +164100 LEV-TEST-GF-2-31. NC1264.2 +164200 IF TB-31 EQUAL TO "TH" NC1264.2 +164300 PERFORM PASS NC1264.2 +164400 GO TO LEV-WRITE-GF-2-31. NC1264.2 +164500 PERFORM FAIL. NC1264.2 +164600 MOVE TB-31 TO COMPUTED-A. NC1264.2 +164700 MOVE "TH" TO CORRECT-A. NC1264.2 +164800 GO TO LEV-WRITE-GF-2-31. NC1264.2 +164900 LEV-DELETE-GF-2-31. NC1264.2 +165000 PERFORM DE-LETE. NC1264.2 +165100 LEV-WRITE-GF-2-31. NC1264.2 +165200 MOVE "LEV-TEST-GF-2-31" TO PAR-NAME. NC1264.2 +165300 PERFORM PRINT-DETAIL. NC1264.2 +165400 LEV-TEST-GF-2-32. NC1264.2 +165500 IF TB-32 EQUAL TO "AT" NC1264.2 +165600 PERFORM PASS NC1264.2 +165700 GO TO LEV-WRITE-GF-2-32. NC1264.2 +165800 PERFORM FAIL. NC1264.2 +165900 MOVE TB-32 TO COMPUTED-A. NC1264.2 +166000 MOVE "AT" TO CORRECT-A. NC1264.2 +166100 GO TO LEV-WRITE-GF-2-32. NC1264.2 +166200 LEV-DELETE-GF-2-32. NC1264.2 +166300 PERFORM DE-LETE. NC1264.2 +166400 LEV-WRITE-GF-2-32. NC1264.2 +166500 MOVE "LEV-TEST-GF-2-32" TO PAR-NAME. NC1264.2 +166600 PERFORM PRINT-DETAIL. NC1264.2 +166700 LEV-TEST-GF-2-33. NC1264.2 +166800 IF TB-33 EQUAL TO " L" NC1264.2 +166900 PERFORM PASS NC1264.2 +167000 GO TO LEV-WRITE-GF-2-33. NC1264.2 +167100 PERFORM FAIL. NC1264.2 +167200 MOVE TB-33 TO COMPUTED-A. NC1264.2 +167300 MOVE " L" TO CORRECT-A. NC1264.2 +167400 GO TO LEV-WRITE-GF-2-33. NC1264.2 +167500 LEV-DELETE-GF-2-33. NC1264.2 +167600 PERFORM DE-LETE. NC1264.2 +167700 LEV-WRITE-GF-2-33. NC1264.2 +167800 MOVE "LEV-TEST-GF-2-33" TO PAR-NAME. NC1264.2 +167900 PERFORM PRINT-DETAIL. NC1264.2 +168000 LEV-TEST-GF-2-34. NC1264.2 +168100 IF TB-34 EQUAL TO "IT" NC1264.2 +168200 PERFORM PASS NC1264.2 +168300 GO TO LEV-WRITE-GF-2-34. NC1264.2 +168400 PERFORM FAIL. NC1264.2 +168500 MOVE TB-34 TO COMPUTED-A. NC1264.2 +168600 MOVE "IT" TO CORRECT-A. NC1264.2 +168700 GO TO LEV-WRITE-GF-2-34. NC1264.2 +168800 LEV-DELETE-GF-2-34. NC1264.2 +168900 PERFORM DE-LETE. NC1264.2 +169000 LEV-WRITE-GF-2-34. NC1264.2 +169100 MOVE "LEV-TEST-GF-2-34" TO PAR-NAME. NC1264.2 +169200 PERFORM PRINT-DETAIL. NC1264.2 +169300 LEV-TEST-GF-2-35. NC1264.2 +169400 IF TB-35 EQUAL TO "ER" NC1264.2 +169500 PERFORM PASS NC1264.2 +169600 GO TO LEV-WRITE-GF-2-35. NC1264.2 +169700 PERFORM FAIL. NC1264.2 +169800 MOVE TB-35 TO COMPUTED-A. NC1264.2 +169900 MOVE "ER" TO CORRECT-A. NC1264.2 +170000 GO TO LEV-WRITE-GF-2-35. NC1264.2 +170100 LEV-DELETE-GF-2-35. NC1264.2 +170200 PERFORM DE-LETE. NC1264.2 +170300 LEV-WRITE-GF-2-35. NC1264.2 +170400 MOVE "LEV-TEST-GF-2-35" TO PAR-NAME. NC1264.2 +170500 PERFORM PRINT-DETAIL. NC1264.2 +170600 LEV-TEST-GF-2-36. NC1264.2 +170700 IF TB-36 EQUAL TO "AL" NC1264.2 +170800 PERFORM PASS NC1264.2 +170900 GO TO LEV-WRITE-GF-2-36. NC1264.2 +171000 PERFORM FAIL. NC1264.2 +171100 MOVE TB-36 TO COMPUTED-A. NC1264.2 +171200 MOVE "AL" TO CORRECT-A. NC1264.2 +171300 GO TO LEV-WRITE-GF-2-36. NC1264.2 +171400 LEV-DELETE-GF-2-36. NC1264.2 +171500 PERFORM DE-LETE. NC1264.2 +171600 LEV-WRITE-GF-2-36. NC1264.2 +171700 MOVE "LEV-TEST-GF-2-36" TO PAR-NAME. NC1264.2 +171800 PERFORM PRINT-DETAIL. NC1264.2 +171900 LEV-TEST-GF-2-37. NC1264.2 +172000 IF TB-37 EQUAL TO " W" NC1264.2 +172100 PERFORM PASS NC1264.2 +172200 GO TO LEV-WRITE-GF-2-37. NC1264.2 +172300 PERFORM FAIL. NC1264.2 +172400 MOVE TB-37 TO COMPUTED-A. NC1264.2 +172500 MOVE " W" TO CORRECT-A. NC1264.2 +172600 GO TO LEV-WRITE-GF-2-37. NC1264.2 +172700 LEV-DELETE-GF-2-37. NC1264.2 +172800 PERFORM DE-LETE. NC1264.2 +172900 LEV-WRITE-GF-2-37. NC1264.2 +173000 MOVE "LEV-TEST-GF-2-37" TO PAR-NAME. NC1264.2 +173100 PERFORM PRINT-DETAIL. NC1264.2 +173200 LEV-TEST-GF-2-38. NC1264.2 +173300 IF TB-38 EQUAL TO "AS" NC1264.2 +173400 PERFORM PASS NC1264.2 +173500 GO TO LEV-WRITE-GF-2-38. NC1264.2 +173600 PERFORM FAIL. NC1264.2 +173700 MOVE TB-38 TO COMPUTED-A. NC1264.2 +173800 MOVE "AS" TO CORRECT-A. NC1264.2 +173900 GO TO LEV-WRITE-GF-2-38. NC1264.2 +174000 LEV-DELETE-GF-2-38. NC1264.2 +174100 PERFORM DE-LETE. NC1264.2 +174200 LEV-WRITE-GF-2-38. NC1264.2 +174300 MOVE "LEV-TEST-GF-2-38" TO PAR-NAME. NC1264.2 +174400 PERFORM PRINT-DETAIL. NC1264.2 +174500 LEV-TEST-GF-2-39. NC1264.2 +174600 IF TB-39 EQUAL TO " B" NC1264.2 +174700 PERFORM PASS NC1264.2 +174800 GO TO LEV-WRITE-GF-2-39. NC1264.2 +174900 PERFORM FAIL. NC1264.2 +175000 MOVE TB-39 TO COMPUTED-A. NC1264.2 +175100 MOVE " B" TO CORRECT-A. NC1264.2 +175200 GO TO LEV-WRITE-GF-2-39. NC1264.2 +175300 LEV-DELETE-GF-2-39. NC1264.2 +175400 PERFORM DE-LETE. NC1264.2 +175500 LEV-WRITE-GF-2-39. NC1264.2 +175600 MOVE "LEV-TEST-GF-2-39" TO PAR-NAME. NC1264.2 +175700 PERFORM PRINT-DETAIL. NC1264.2 +175800 LEV-TEST-GF-2-40. NC1264.2 +175900 IF TB-40 EQUAL TO "AD" NC1264.2 +176000 PERFORM PASS NC1264.2 +176100 GO TO LEV-WRITE-GF-2-40. NC1264.2 +176200 PERFORM FAIL. NC1264.2 +176300 MOVE TB-40 TO COMPUTED-A. NC1264.2 +176400 MOVE "AD" TO CORRECT-A. NC1264.2 +176500 GO TO LEV-WRITE-GF-2-40. NC1264.2 +176600 LEV-DELETE-GF-2-40. NC1264.2 +176700 PERFORM DE-LETE. NC1264.2 +176800 LEV-WRITE-GF-2-40. NC1264.2 +176900 MOVE "LEV-TEST-GF-2-40" TO PAR-NAME. NC1264.2 +177000 PERFORM PRINT-DETAIL. NC1264.2 +177100 LEV-TEST-GF-2-41. NC1264.2 +177200 IF TB-41 EQUAL TO "UP" NC1264.2 +177300 PERFORM PASS NC1264.2 +177400 GO TO LEV-WRITE-GF-2-41. NC1264.2 +177500 PERFORM FAIL. NC1264.2 +177600 MOVE TB-41 TO COMPUTED-A. NC1264.2 +177700 MOVE "UP" TO CORRECT-A. NC1264.2 +177800 GO TO LEV-WRITE-GF-2-41. NC1264.2 +177900 LEV-DELETE-GF-2-41. NC1264.2 +178000 PERFORM DE-LETE. NC1264.2 +178100 LEV-WRITE-GF-2-41. NC1264.2 +178200 MOVE "LEV-TEST-GF-2-41" TO PAR-NAME. NC1264.2 +178300 PERFORM PRINT-DETAIL. NC1264.2 +178400 LEV-TEST-GF-2-42. NC1264.2 +178500 IF TB-42 EQUAL TO " O" NC1264.2 +178600 PERFORM PASS NC1264.2 +178700 GO TO LEV-WRITE-GF-2-42. NC1264.2 +178800 PERFORM FAIL. NC1264.2 +178900 MOVE TB-42 TO COMPUTED-A. NC1264.2 +179000 MOVE " O" TO CORRECT-A. NC1264.2 +179100 GO TO LEV-WRITE-GF-2-42. NC1264.2 +179200 LEV-DELETE-GF-2-42. NC1264.2 +179300 PERFORM DE-LETE. NC1264.2 +179400 LEV-WRITE-GF-2-42. NC1264.2 +179500 MOVE "LEV-TEST-GF-2-42" TO PAR-NAME. NC1264.2 +179600 PERFORM PRINT-DETAIL. NC1264.2 +179700 LEV-TEST-GF-2-43. NC1264.2 +179800 IF TB-43 EQUAL TO "N " NC1264.2 +179900 PERFORM PASS NC1264.2 +180000 GO TO LEV-WRITE-GF-2-43. NC1264.2 +180100 PERFORM FAIL. NC1264.2 +180200 MOVE TB-43 TO COMPUTED-A. NC1264.2 +180300 MOVE "N " TO CORRECT-A. NC1264.2 +180400 GO TO LEV-WRITE-GF-2-43. NC1264.2 +180500 LEV-DELETE-GF-2-43. NC1264.2 +180600 PERFORM DE-LETE. NC1264.2 +180700 LEV-WRITE-GF-2-43. NC1264.2 +180800 MOVE "LEV-TEST-GF-2-43" TO PAR-NAME. NC1264.2 +180900 PERFORM PRINT-DETAIL. NC1264.2 +181000 LEV-TEST-GF-2-44. NC1264.2 +181100 IF TB-44 EQUAL TO "TH" NC1264.2 +181200 PERFORM PASS NC1264.2 +181300 GO TO LEV-WRITE-GF-2-44. NC1264.2 +181400 PERFORM FAIL. NC1264.2 +181500 MOVE TB-44 TO COMPUTED-A. NC1264.2 +181600 MOVE "TH" TO CORRECT-A. NC1264.2 +181700 GO TO LEV-WRITE-GF-2-44. NC1264.2 +181800 LEV-DELETE-GF-2-44. NC1264.2 +181900 PERFORM DE-LETE. NC1264.2 +182000 LEV-WRITE-GF-2-44. NC1264.2 +182100 MOVE "LEV-TEST-GF-2-44" TO PAR-NAME. NC1264.2 +182200 PERFORM PRINT-DETAIL. NC1264.2 +182300 LEV-TEST-GF-2-45. NC1264.2 +182400 IF TB-45 EQUAL TO "E " NC1264.2 +182500 PERFORM PASS NC1264.2 +182600 GO TO LEV-WRITE-GF-2-45. NC1264.2 +182700 PERFORM FAIL. NC1264.2 +182800 MOVE TB-45 TO COMPUTED-A. NC1264.2 +182900 MOVE "E " TO CORRECT-A. NC1264.2 +183000 GO TO LEV-WRITE-GF-2-45. NC1264.2 +183100 LEV-DELETE-GF-2-45. NC1264.2 +183200 PERFORM DE-LETE. NC1264.2 +183300 LEV-WRITE-GF-2-45. NC1264.2 +183400 MOVE "LEV-TEST-GF-2-45" TO PAR-NAME. NC1264.2 +183500 PERFORM PRINT-DETAIL. NC1264.2 +183600 LEV-TEST-GF-2-46. NC1264.2 +183700 IF TB-46 EQUAL TO "RO" NC1264.2 +183800 PERFORM PASS NC1264.2 +183900 GO TO LEV-WRITE-GF-2-46. NC1264.2 +184000 PERFORM FAIL. NC1264.2 +184100 MOVE TB-46 TO COMPUTED-A. NC1264.2 +184200 MOVE "RO" TO CORRECT-A. NC1264.2 +184300 GO TO LEV-WRITE-GF-2-46. NC1264.2 +184400 LEV-DELETE-GF-2-46. NC1264.2 +184500 PERFORM DE-LETE. NC1264.2 +184600 LEV-WRITE-GF-2-46. NC1264.2 +184700 MOVE "LEV-TEST-GF-2-46" TO PAR-NAME. NC1264.2 +184800 PERFORM PRINT-DETAIL. NC1264.2 +184900 LEV-TEST-GF-2-47. NC1264.2 +185000 IF TB-47 EQUAL TO "OF" NC1264.2 +185100 PERFORM PASS NC1264.2 +185200 GO TO LEV-WRITE-GF-2-47. NC1264.2 +185300 PERFORM FAIL. NC1264.2 +185400 MOVE TB-47 TO COMPUTED-A. NC1264.2 +185500 MOVE "OF" TO CORRECT-A. NC1264.2 +185600 GO TO LEV-WRITE-GF-2-47. NC1264.2 +185700 LEV-DELETE-GF-2-47. NC1264.2 +185800 PERFORM DE-LETE. NC1264.2 +185900 LEV-WRITE-GF-2-47. NC1264.2 +186000 MOVE "LEV-TEST-GF-2-47" TO PAR-NAME. NC1264.2 +186100 PERFORM PRINT-DETAIL. NC1264.2 +186200 LEV-TEST-GF-2-48. NC1264.2 +186300 IF TB-48 EQUAL TO "S " NC1264.2 +186400 PERFORM PASS NC1264.2 +186500 GO TO LEV-WRITE-GF-2-48. NC1264.2 +186600 PERFORM FAIL. NC1264.2 +186700 MOVE TB-48 TO COMPUTED-A. NC1264.2 +186800 MOVE "S " TO CORRECT-A. NC1264.2 +186900 GO TO LEV-WRITE-GF-2-48. NC1264.2 +187000 LEV-DELETE-GF-2-48. NC1264.2 +187100 PERFORM DE-LETE. NC1264.2 +187200 LEV-WRITE-GF-2-48. NC1264.2 +187300 MOVE "LEV-TEST-GF-2-48" TO PAR-NAME. NC1264.2 +187400 PERFORM PRINT-DETAIL. NC1264.2 +187500 LEV-INIT-GF-3-1. NC1264.2 +187600 MOVE "VI-21 5.3.3 SR1" TO ANSI-REFERENCE. NC1264.2 +187700 PERFORM END-ROUTINE. NC1264.2 +187800 MOVE SPACE TO PRINT-REC. NC1264.2 +187900 MOVE "NUMERIC MOVED TO GRP" TO FEATURE. NC1264.2 +188000 PERFORM PRINT-DETAIL. NC1264.2 +188100 MOVE "ELEMENTRY ITEM CHK" TO FEATURE. NC1264.2 +188200 MOVE 000046 TO GP-1. NC1264.2 +188300 MOVE 12345678902 TO GP-2. NC1264.2 +188400 MOVE 121619492 TO GP-3. NC1264.2 +188500 MOVE 0109 TO GP-4. NC1264.2 +188600 MOVE 6645143 TO GP-5. NC1264.2 +188700 MOVE 000096 TO GP-6. NC1264.2 +188800 MOVE -4361 TO GP-7. NC1264.2 +188900 MOVE "PROGRAM DIVISI" TO GP-8. NC1264.2 +189000 MOVE "NPLD" TO GP-9. NC1264.2 +189100 MOVE 770 TO GP-10. NC1264.2 +189200 MOVE 5604 TO GP-11. NC1264.2 +189300 MOVE ZERO TO GP-12. NC1264.2 +189400 MOVE 0004 TO GP-13. NC1264.2 +189500 MOVE "KLOP" TO GP-14. NC1264.2 +189600 MOVE 12345678902 TO GP-15. NC1264.2 +189700 MOVE ZERO TO GP-16. NC1264.2 +189800 MOVE 1972 TO GP-17. NC1264.2 +189900 MOVE -0042 TO GP-18. NC1264.2 +190000 MOVE ZERO TO GP-19. NC1264.2 +190100 MOVE 492 TO GP-20. NC1264.2 +190200 MOVE SPACE TO GP-21. NC1264.2 +190300 MOVE 040290 TO GP-22. NC1264.2 +190400 MOVE "9A8B7C" TO GP-23. NC1264.2 +190500 MOVE 040290 TO GP-24. NC1264.2 +190600 MOVE 289 TO GP-25. NC1264.2 +190700 MOVE 2251 TO GP-26. NC1264.2 +190800 MOVE 1692 TO GP-27. NC1264.2 +190900 MOVE 00000041 TO GP-28. NC1264.2 +191000 MOVE 00001 TO GP-29. NC1264.2 +191100 MOVE ZERO TO GP-30. NC1264.2 +191200 MOVE ZERO TO GP-31. NC1264.2 +191300 MOVE 000 TO GP-32. NC1264.2 +191400 MOVE ZERO TO GP-33. NC1264.2 +191500 MOVE 21 TO GP-34. NC1264.2 +191600 MOVE 36 TO GP-35. NC1264.2 +191700 MOVE 918 TO GP-36. NC1264.2 +191800 MOVE ZERO TO GP-37. NC1264.2 +191900 MOVE -36 TO GP-38. NC1264.2 +192000 MOVE 24 TO GP-39. NC1264.2 +192100 MOVE 36 TO GP-40. NC1264.2 +192200 MOVE -1 TO GP-41. NC1264.2 +192300 MOVE ZERO TO GP-42. NC1264.2 +192400 MOVE "AIR" TO GP-43. NC1264.2 +192500 MOVE "9ZX" TO GP-44. NC1264.2 +192600 MOVE 01000 TO GP-45. NC1264.2 +192700 MOVE 93 TO GP-46. NC1264.2 +192800 MOVE 5 TO GP-47 (1). NC1264.2 +192900 MOVE ZERO TO GP-47 (2). NC1264.2 +193000 MOVE "Y" TO GP-48 (1). NC1264.2 +193100 MOVE SPACE TO GP-48 (2). NC1264.2 +193200 LEV-TEST-GF-3-1. NC1264.2 +193300 IF GP-1 EQUAL TO " 046" NC1264.2 +193400 PERFORM PASS NC1264.2 +193500 GO TO LEV-WRITE-GF-3-1. NC1264.2 +193600 PERFORM FAIL. NC1264.2 +193700 MOVE GP-1 TO COMPUTED-A. NC1264.2 +193800 MOVE " 046" TO CORRECT-A. NC1264.2 +193900 GO TO LEV-WRITE-GF-3-1. NC1264.2 +194000 LEV-DELETE-GF-3-1. NC1264.2 +194100 PERFORM DE-LETE. NC1264.2 +194200 LEV-WRITE-GF-3-1. NC1264.2 +194300 MOVE "LEV-TEST-GF-3-1" TO PAR-NAME. NC1264.2 +194400 PERFORM PRINT-DETAIL. NC1264.2 +194500 LEV-TEST-GF-3-2. NC1264.2 +194600 IF GP-2 EQUAL TO "345678902.00" NC1264.2 +194700 PERFORM PASS NC1264.2 +194800 GO TO LEV-WRITE-GF-3-2. NC1264.2 +194900 PERFORM FAIL. NC1264.2 +195000 MOVE GP-2 TO COMPUTED-A NC1264.2 +195100 MOVE "345678902.00" TO CORRECT-A. NC1264.2 +195200 GO TO LEV-WRITE-GF-3-2. NC1264.2 +195300 LEV-DELETE-GF-3-2. NC1264.2 +195400 PERFORM DE-LETE. NC1264.2 +195500 LEV-WRITE-GF-3-2. NC1264.2 +195600 MOVE "LEV-TEST-GF-3-2" TO PAR-NAME. NC1264.2 +195700 PERFORM PRINT-DETAIL. NC1264.2 +195800 LEV-TEST-GF-3-3. NC1264.2 +195900 IF GP-3 EQUAL TO "000121619492" NC1264.2 +196000 PERFORM PASS NC1264.2 +196100 GO TO LEV-WRITE-GF-3-3. NC1264.2 +196200 PERFORM FAIL. NC1264.2 +196300 MOVE GP-3 TO COMPUTED-A NC1264.2 +196400 MOVE "000121619492" TO CORRECT-A. NC1264.2 +196500 GO TO LEV-WRITE-GF-3-3. NC1264.2 +196600 LEV-DELETE-GF-3-3. NC1264.2 +196700 PERFORM DE-LETE. NC1264.2 +196800 LEV-WRITE-GF-3-3. NC1264.2 +196900 MOVE "LEV-TEST-GF-3-3" TO PAR-NAME. NC1264.2 +197000 PERFORM PRINT-DETAIL. NC1264.2 +197100 LEV-TEST-GF-3-4. NC1264.2 +197200 IF GP-4 EQUAL TO " 1 09" NC1264.2 +197300 PERFORM PASS NC1264.2 +197400 GO TO LEV-WRITE-GF-3-4. NC1264.2 +197500 PERFORM FAIL. NC1264.2 +197600 MOVE GP-4 TO COMPUTED-A NC1264.2 +197700 MOVE " 1 09" TO CORRECT-A. NC1264.2 +197800 GO TO LEV-WRITE-GF-3-4. NC1264.2 +197900 LEV-DELETE-GF-3-4. NC1264.2 +198000 PERFORM DE-LETE. NC1264.2 +198100 LEV-WRITE-GF-3-4. NC1264.2 +198200 MOVE "LEV-TEST-GF-3-4" TO PAR-NAME. NC1264.2 +198300 PERFORM PRINT-DETAIL. NC1264.2 +198400 LEV-TEST-GF-3-5. NC1264.2 +198500 IF GP-5 EQUAL TO "$45,143.00" NC1264.2 +198600 PERFORM PASS NC1264.2 +198700 GO TO LEV-WRITE-GF-3-5. NC1264.2 +198800 PERFORM FAIL. NC1264.2 +198900 MOVE GP-5 TO COMPUTED-A NC1264.2 +199000 MOVE "$45,143.00" TO CORRECT-A. NC1264.2 +199100 GO TO LEV-WRITE-GF-3-5. NC1264.2 +199200 LEV-DELETE-GF-3-5. NC1264.2 +199300 PERFORM DE-LETE. NC1264.2 +199400 LEV-WRITE-GF-3-5. NC1264.2 +199500 MOVE "LEV-TEST-GF-3-5" TO PAR-NAME. NC1264.2 +199600 PERFORM PRINT-DETAIL. NC1264.2 +199700 LEV-TEST-GF-3-6. NC1264.2 +199800 IF GP-6 EQUAL TO "******96" NC1264.2 +199900 PERFORM PASS NC1264.2 +200000 GO TO LEV-WRITE-GF-3-6. NC1264.2 +200100 PERFORM FAIL. NC1264.2 +200200 MOVE GP-6 TO COMPUTED-A NC1264.2 +200300 MOVE "******96" TO CORRECT-A. NC1264.2 +200400 GO TO LEV-WRITE-GF-3-6. NC1264.2 +200500 LEV-DELETE-GF-3-6. NC1264.2 +200600 PERFORM DE-LETE. NC1264.2 +200700 LEV-WRITE-GF-3-6. NC1264.2 +200800 MOVE "LEV-TEST-GF-3-6" TO PAR-NAME. NC1264.2 +200900 PERFORM PRINT-DETAIL. NC1264.2 +201000 LEV-TEST-GF-3-7. NC1264.2 +201100 IF GP-7 EQUAL TO "-004,361" NC1264.2 +201200 PERFORM PASS NC1264.2 +201300 GO TO LEV-WRITE-GF-3-7. NC1264.2 +201400 PERFORM FAIL. NC1264.2 +201500 MOVE GP-7 TO COMPUTED-A NC1264.2 +201600 MOVE "-004,361" TO CORRECT-A. NC1264.2 +201700 GO TO LEV-WRITE-GF-3-7. NC1264.2 +201800 LEV-DELETE-GF-3-7. NC1264.2 +201900 PERFORM DE-LETE. NC1264.2 +202000 LEV-WRITE-GF-3-7. NC1264.2 +202100 MOVE "LEV-TEST-GF-3-7" TO PAR-NAME. NC1264.2 +202200 PERFORM PRINT-DETAIL. NC1264.2 +202300 LEV-TEST-GF-3-8. NC1264.2 +202400 IF GP-8 EQUAL TO "PROGRAM DIVISI" NC1264.2 +202500 PERFORM PASS NC1264.2 +202600 GO TO LEV-WRITE-GF-3-8. NC1264.2 +202700 PERFORM FAIL. NC1264.2 +202800 MOVE "PROGRAM DIVISI" TO CORRECT-A. NC1264.2 +202900 GO TO LEV-WRITE-GF-3-8. NC1264.2 +203000 LEV-DELETE-GF-3-8. NC1264.2 +203100 PERFORM DE-LETE. NC1264.2 +203200 LEV-WRITE-GF-3-8. NC1264.2 +203300 MOVE "LEV-TEST-GF-3-8" TO PAR-NAME. NC1264.2 +203400 PERFORM PRINT-DETAIL. NC1264.2 +203500 LEV-TEST-GF-3-9. NC1264.2 +203600 IF GP-9 EQUAL TO "N P L D" NC1264.2 +203700 PERFORM PASS NC1264.2 +203800 GO TO LEV-WRITE-GF-3-9. NC1264.2 +203900 PERFORM FAIL. NC1264.2 +204000 MOVE GP-9 TO COMPUTED-A NC1264.2 +204100 MOVE "N P L D" TO CORRECT-A. NC1264.2 +204200 GO TO LEV-WRITE-GF-3-9. NC1264.2 +204300 LEV-DELETE-GF-3-9. NC1264.2 +204400 PERFORM DE-LETE. NC1264.2 +204500 LEV-WRITE-GF-3-9. NC1264.2 +204600 MOVE "LEV-TEST-GF-3-9" TO PAR-NAME. NC1264.2 +204700 PERFORM PRINT-DETAIL. NC1264.2 +204800 LEV-TEST-GF-3-10. NC1264.2 +204900 IF GP-10 EQUAL TO "7070000" NC1264.2 +205000 PERFORM PASS NC1264.2 +205100 GO TO LEV-WRITE-GF-3-10. NC1264.2 +205200 PERFORM FAIL. NC1264.2 +205300 MOVE GP-10 TO COMPUTED-A NC1264.2 +205400 MOVE "7070000" TO CORRECT-A. NC1264.2 +205500 GO TO LEV-WRITE-GF-3-10. NC1264.2 +205600 LEV-DELETE-GF-3-10. NC1264.2 +205700 PERFORM DE-LETE. NC1264.2 +205800 LEV-WRITE-GF-3-10. NC1264.2 +205900 MOVE "LEV-TEST-GF-3-10" TO PAR-NAME. NC1264.2 +206000 PERFORM PRINT-DETAIL. NC1264.2 +206100 LEV-TEST-GF-3-11. NC1264.2 +206200 IF GP-11 EQUAL TO "$005,604.00" NC1264.2 +206300 PERFORM PASS NC1264.2 +206400 GO TO LEV-WRITE-GF-3-11. NC1264.2 +206500 PERFORM FAIL. NC1264.2 +206600 MOVE GP-11 TO COMPUTED-A. NC1264.2 +206700 MOVE "$005,604.00" TO CORRECT-A. NC1264.2 +206800 GO TO LEV-WRITE-GF-3-11. NC1264.2 +206900 LEV-DELETE-GF-3-11. NC1264.2 +207000 PERFORM DE-LETE. NC1264.2 +207100 LEV-WRITE-GF-3-11. NC1264.2 +207200 MOVE "LEV-TEST-GF-3-11" TO PAR-NAME. NC1264.2 +207300 PERFORM PRINT-DETAIL. NC1264.2 +207400 LEV-TEST-GF-3-12. NC1264.2 +207500 IF GP-12 EQUAL TO " .0" NC1264.2 +207600 PERFORM PASS NC1264.2 +207700 GO TO LEV-WRITE-GF-3-12. NC1264.2 +207800 PERFORM FAIL. NC1264.2 +207900 MOVE GP-12 TO COMPUTED-A NC1264.2 +208000 MOVE " .0" TO CORRECT-A. NC1264.2 +208100 GO TO LEV-WRITE-GF-3-12. NC1264.2 +208200 LEV-DELETE-GF-3-12. NC1264.2 +208300 PERFORM DE-LETE. NC1264.2 +208400 LEV-WRITE-GF-3-12. NC1264.2 +208500 MOVE "LEV-TEST-GF-3-12" TO PAR-NAME. NC1264.2 +208600 PERFORM PRINT-DETAIL. NC1264.2 +208700 LEV-TEST-GF-3-13. NC1264.2 +208800 IF GP-13 EQUAL TO " 0 400" NC1264.2 +208900 PERFORM PASS NC1264.2 +209000 GO TO LEV-WRITE-GF-3-13. NC1264.2 +209100 PERFORM FAIL. NC1264.2 +209200 MOVE GP-13 TO COMPUTED-A. NC1264.2 +209300 MOVE " 0 400" TO CORRECT-A. NC1264.2 +209400 GO TO LEV-WRITE-GF-3-13. NC1264.2 +209500 LEV-DELETE-GF-3-13. NC1264.2 +209600 PERFORM DE-LETE. NC1264.2 +209700 LEV-WRITE-GF-3-13. NC1264.2 +209800 MOVE "LEV-TEST-GF-3-13" TO PAR-NAME. NC1264.2 +209900 PERFORM PRINT-DETAIL. NC1264.2 +210000 LEV-TEST-GF-3-14. NC1264.2 +210100 IF GP-14 EQUAL TO "KLOP" NC1264.2 +210200 PERFORM PASS NC1264.2 +210300 GO TO LEV-WRITE-GF-3-14. NC1264.2 +210400 PERFORM FAIL. NC1264.2 +210500 MOVE GP-14 TO COMPUTED-A NC1264.2 +210600 MOVE "KLOP" TO CORRECT-A. NC1264.2 +210700 GO TO LEV-WRITE-GF-3-14. NC1264.2 +210800 LEV-DELETE-GF-3-14. NC1264.2 +210900 PERFORM DE-LETE. NC1264.2 +211000 LEV-WRITE-GF-3-14. NC1264.2 +211100 MOVE "LEV-TEST-GF-3-14" TO PAR-NAME. NC1264.2 +211200 PERFORM PRINT-DETAIL. NC1264.2 +211300 LEV-TEST-GF-3-15. NC1264.2 +211400 IF GP-15 EQUAL TO "2345678902" NC1264.2 +211500 PERFORM PASS NC1264.2 +211600 GO TO LEV-WRITE-GF-3-15. NC1264.2 +211700 PERFORM FAIL. NC1264.2 +211800 MOVE GP-15 TO COMPUTED-A. NC1264.2 +211900 MOVE "2345678902" TO CORRECT-A. NC1264.2 +212000 GO TO LEV-WRITE-GF-3-15. NC1264.2 +212100 LEV-DELETE-GF-3-15. NC1264.2 +212200 PERFORM DE-LETE. NC1264.2 +212300 LEV-WRITE-GF-3-15. NC1264.2 +212400 MOVE "LEV-TEST-GF-3-15" TO PAR-NAME. NC1264.2 +212500 PERFORM PRINT-DETAIL. NC1264.2 +212600 LEV-TEST-GF-3-16. NC1264.2 +212700 IF GP-16 EQUAL TO SPACE NC1264.2 +212800 PERFORM PASS NC1264.2 +212900 GO TO LEV-WRITE-GF-3-16. NC1264.2 +213000 PERFORM FAIL. NC1264.2 +213100 MOVE GP-16 TO COMPUTED-A NC1264.2 +213200 MOVE "SPACE" TO CORRECT-A. NC1264.2 +213300 GO TO LEV-WRITE-GF-3-16. NC1264.2 +213400 LEV-DELETE-GF-3-16. NC1264.2 +213500 PERFORM DE-LETE. NC1264.2 +213600 LEV-WRITE-GF-3-16. NC1264.2 +213700 MOVE "LEV-TEST-GF-3-16" TO PAR-NAME. NC1264.2 +213800 PERFORM PRINT-DETAIL. NC1264.2 +213900 LEV-TEST-GF-3-17. NC1264.2 +214000 IF GP-17 EQUAL TO "19 702" NC1264.2 +214100 PERFORM PASS NC1264.2 +214200 GO TO LEV-WRITE-GF-3-17. NC1264.2 +214300 PERFORM FAIL. NC1264.2 +214400 MOVE GP-17 TO COMPUTED-A. NC1264.2 +214500 MOVE "19 702" TO CORRECT-A. NC1264.2 +214600 GO TO LEV-WRITE-GF-3-17. NC1264.2 +214700 LEV-DELETE-GF-3-17. NC1264.2 +214800 PERFORM DE-LETE. NC1264.2 +214900 LEV-WRITE-GF-3-17. NC1264.2 +215000 MOVE "LEV-TEST-GF-3-17" TO PAR-NAME. NC1264.2 +215100 PERFORM PRINT-DETAIL. NC1264.2 +215200 LEV-TEST-GF-3-18. NC1264.2 +215300 IF GP-18 EQUAL TO "-***42" NC1264.2 +215400 PERFORM PASS NC1264.2 +215500 GO TO LEV-WRITE-GF-3-18. NC1264.2 +215600 PERFORM FAIL. NC1264.2 +215700 MOVE GP-18 TO COMPUTED-A NC1264.2 +215800 MOVE "-***42" TO CORRECT-A. NC1264.2 +215900 GO TO LEV-WRITE-GF-3-18. NC1264.2 +216000 LEV-DELETE-GF-3-18. NC1264.2 +216100 PERFORM DE-LETE. NC1264.2 +216200 LEV-WRITE-GF-3-18. NC1264.2 +216300 MOVE "LEV-TEST-GF-3-18" TO PAR-NAME. NC1264.2 +216400 PERFORM PRINT-DETAIL. NC1264.2 +216500 LEV-TEST-GF-3-19. NC1264.2 +216600 IF GP-19 EQUAL TO ZERO NC1264.2 +216700 PERFORM PASS NC1264.2 +216800 GO TO LEV-WRITE-GF-3-19. NC1264.2 +216900 PERFORM FAIL. NC1264.2 +217000 MOVE GP-19 TO COMPUTED-A. NC1264.2 +217100 MOVE "0000000" TO CORRECT-A. NC1264.2 +217200 GO TO LEV-WRITE-GF-3-19. NC1264.2 +217300 LEV-DELETE-GF-3-19. NC1264.2 +217400 PERFORM DE-LETE. NC1264.2 +217500 LEV-WRITE-GF-3-19. NC1264.2 +217600 MOVE "LEV-TEST-GF-3-19" TO PAR-NAME. NC1264.2 +217700 PERFORM PRINT-DETAIL. NC1264.2 +217800 LEV-TEST-GF-3-20. NC1264.2 +217900 IF GP-20 EQUAL TO "492 " NC1264.2 +218000 PERFORM PASS NC1264.2 +218100 GO TO LEV-WRITE-GF-3-20. NC1264.2 +218200 PERFORM FAIL. NC1264.2 +218300 MOVE GP-20 TO COMPUTED-A NC1264.2 +218400 MOVE "492 " TO CORRECT-A. NC1264.2 +218500 GO TO LEV-WRITE-GF-3-20. NC1264.2 +218600 LEV-DELETE-GF-3-20. NC1264.2 +218700 PERFORM DE-LETE. NC1264.2 +218800 LEV-WRITE-GF-3-20. NC1264.2 +218900 MOVE "LEV-TEST-GF-3-20" TO PAR-NAME. NC1264.2 +219000 PERFORM PRINT-DETAIL. NC1264.2 +219100 LEV-TEST-GF-3-21. NC1264.2 +219200 IF GP-21 EQUAL TO SPACE NC1264.2 +219300 PERFORM PASS NC1264.2 +219400 GO TO LEV-WRITE-GF-3-21. NC1264.2 +219500 PERFORM FAIL. NC1264.2 +219600 MOVE GP-20 TO COMPUTED-A NC1264.2 +219700 MOVE "SPACE" TO CORRECT-A. NC1264.2 +219800 GO TO LEV-WRITE-GF-3-21. NC1264.2 +219900 LEV-DELETE-GF-3-21. NC1264.2 +220000 PERFORM DE-LETE. NC1264.2 +220100 LEV-WRITE-GF-3-21. NC1264.2 +220200 MOVE "LEV-TEST-GF-3-21" TO PAR-NAME. NC1264.2 +220300 PERFORM PRINT-DETAIL. NC1264.2 +220400 LEV-TEST-GF-3-22. NC1264.2 +220500 IF GP-22 EQUAL TO "*040290" NC1264.2 +220600 PERFORM PASS NC1264.2 +220700 GO TO LEV-WRITE-GF-3-22. NC1264.2 +220800 PERFORM FAIL NC1264.2 +220900 MOVE GP-22 TO COMPUTED-A NC1264.2 +221000 MOVE "*040290" TO CORRECT-A. NC1264.2 +221100 GO TO LEV-WRITE-GF-3-22. NC1264.2 +221200 LEV-DELETE-GF-3-22. NC1264.2 +221300 PERFORM DE-LETE. NC1264.2 +221400 LEV-WRITE-GF-3-22. NC1264.2 +221500 MOVE "LEV-TEST-GF-3-22" TO PAR-NAME. NC1264.2 +221600 PERFORM PRINT-DETAIL. NC1264.2 +221700 LEV-TEST-GF-3-23. NC1264.2 +221800 IF GP-23 EQUAL TO "9A8B7C" NC1264.2 +221900 PERFORM PASS NC1264.2 +222000 GO TO LEV-WRITE-GF-3-23. NC1264.2 +222100 PERFORM FAIL. NC1264.2 +222200 MOVE GP-23 TO COMPUTED-A NC1264.2 +222300 MOVE "9A8B7C" TO CORRECT-A. NC1264.2 +222400 GO TO LEV-WRITE-GF-3-23. NC1264.2 +222500 LEV-DELETE-GF-3-23. NC1264.2 +222600 PERFORM DE-LETE. NC1264.2 +222700 LEV-WRITE-GF-3-23. NC1264.2 +222800 MOVE "LEV-TEST-GF-3-23" TO PAR-NAME. NC1264.2 +222900 PERFORM PRINT-DETAIL. NC1264.2 +223000 LEV-TEST-GF-3-24. NC1264.2 +223100 IF GP-24 EQUAL TO "$40,290.00" NC1264.2 +223200 PERFORM PASS NC1264.2 +223300 GO TO LEV-WRITE-GF-3-24. NC1264.2 +223400 PERFORM FAIL. NC1264.2 +223500 MOVE GP-24 TO COMPUTED-A NC1264.2 +223600 MOVE "$40,290.00" TO CORRECT-A. NC1264.2 +223700 GO TO LEV-WRITE-GF-3-24. NC1264.2 +223800 LEV-DELETE-GF-3-24. NC1264.2 +223900 PERFORM DE-LETE. NC1264.2 +224000 LEV-WRITE-GF-3-24. NC1264.2 +224100 MOVE "LEV-TEST-GF-3-24" TO PAR-NAME. NC1264.2 +224200 PERFORM PRINT-DETAIL. NC1264.2 +224300 LEV-TEST-GF-3-25. NC1264.2 +224400 IF GP-25 EQUAL TO "2 8 9 " NC1264.2 +224500 PERFORM PASS NC1264.2 +224600 GO TO LEV-WRITE-GF-3-25. NC1264.2 +224700 PERFORM FAIL. NC1264.2 +224800 MOVE GP-25 TO COMPUTED-A NC1264.2 +224900 MOVE "2 8 9 " TO CORRECT-A. NC1264.2 +225000 GO TO LEV-WRITE-GF-3-25. NC1264.2 +225100 LEV-DELETE-GF-3-25. NC1264.2 +225200 PERFORM DE-LETE. NC1264.2 +225300 LEV-WRITE-GF-3-25. NC1264.2 +225400 MOVE "LEV-TEST-GF-3-25" TO PAR-NAME. NC1264.2 +225500 PERFORM PRINT-DETAIL. NC1264.2 +225600 LEV-TEST-GF-3-26. NC1264.2 +225700 IF GP-26 EQUAL TO "2250001" NC1264.2 +225800 PERFORM PASS NC1264.2 +225900 GO TO LEV-WRITE-GF-3-26. NC1264.2 +226000 PERFORM FAIL. NC1264.2 +226100 MOVE GP-26 TO COMPUTED-A NC1264.2 +226200 MOVE "2250001" TO CORRECT-A. NC1264.2 +226300 GO TO LEV-WRITE-GF-3-26. NC1264.2 +226400 LEV-DELETE-GF-3-26. NC1264.2 +226500 PERFORM DE-LETE. NC1264.2 +226600 LEV-WRITE-GF-3-26. NC1264.2 +226700 MOVE "LEV-TEST-GF-3-26" TO PAR-NAME. NC1264.2 +226800 PERFORM PRINT-DETAIL. NC1264.2 +226900 LEV-TEST-GF-3-27. NC1264.2 +227000 IF GP-27 EQUAL TO "0,001,692" NC1264.2 +227100 PERFORM PASS NC1264.2 +227200 GO TO LEV-WRITE-GF-3-27. NC1264.2 +227300 PERFORM FAIL. NC1264.2 +227400 MOVE GP-27 TO COMPUTED-A NC1264.2 +227500 MOVE "0,001,692" TO CORRECT-A. NC1264.2 +227600 GO TO LEV-WRITE-GF-3-27. NC1264.2 +227700 LEV-DELETE-GF-3-27. NC1264.2 +227800 PERFORM DE-LETE. NC1264.2 +227900 LEV-WRITE-GF-3-27. NC1264.2 +228000 MOVE "LEV-TEST-GF-3-27" TO PAR-NAME. NC1264.2 +228100 PERFORM PRINT-DETAIL. NC1264.2 +228200 LEV-TEST-GF-3-28. NC1264.2 +228300 IF GP-28 EQUAL TO "0000004,1" NC1264.2 +228400 PERFORM PASS NC1264.2 +228500 GO TO LEV-WRITE-GF-3-28. NC1264.2 +228600 PERFORM FAIL. NC1264.2 +228700 MOVE GP-28 TO COMPUTED-A. NC1264.2 +228800 MOVE "0000004,1" TO CORRECT-A. NC1264.2 +228900 GO TO LEV-WRITE-GF-3-28. NC1264.2 +229000 LEV-DELETE-GF-3-28. NC1264.2 +229100 PERFORM DE-LETE. NC1264.2 +229200 LEV-WRITE-GF-3-28. NC1264.2 +229300 MOVE "LEV-TEST-GF-3-28" TO PAR-NAME. NC1264.2 +229400 PERFORM PRINT-DETAIL. NC1264.2 +229500 LEV-TEST-GF-3-29. NC1264.2 +229600 IF GP-29 EQUAL TO "$**1.00" NC1264.2 +229700 PERFORM PASS NC1264.2 +229800 GO TO LEV-WRITE-GF-3-29. NC1264.2 +229900 PERFORM FAIL. NC1264.2 +230000 MOVE GP-29 TO COMPUTED-A NC1264.2 +230100 MOVE "$**1.00" TO CORRECT-A. NC1264.2 +230200 GO TO LEV-WRITE-GF-3-29. NC1264.2 +230300 LEV-DELETE-GF-3-29. NC1264.2 +230400 PERFORM DE-LETE. NC1264.2 +230500 LEV-WRITE-GF-3-29. NC1264.2 +230600 MOVE "LEV-TEST-GF-3-29" TO PAR-NAME. NC1264.2 +230700 PERFORM PRINT-DETAIL. NC1264.2 +230800 LEV-TEST-GF-3-30. NC1264.2 +230900 IF GP-30 EQUAL TO ZERO NC1264.2 +231000 PERFORM PASS NC1264.2 +231100 GO TO LEV-WRITE-GF-3-30. NC1264.2 +231200 PERFORM FAIL. NC1264.2 +231300 MOVE GP-30 TO COMPUTED-A NC1264.2 +231400 MOVE "000000000000000" TO CORRECT-A. NC1264.2 +231500 GO TO LEV-WRITE-GF-3-30. NC1264.2 +231600 LEV-DELETE-GF-3-30. NC1264.2 +231700 PERFORM DE-LETE. NC1264.2 +231800 LEV-WRITE-GF-3-30. NC1264.2 +231900 MOVE "LEV-TEST-GF-3-30" TO PAR-NAME. NC1264.2 +232000 PERFORM PRINT-DETAIL. NC1264.2 +232100 LEV-TEST-GF-3-31. NC1264.2 +232200 IF GP-31 EQUAL TO ZERO NC1264.2 +232300 PERFORM PASS NC1264.2 +232400 GO TO LEV-WRITE-GF-3-31. NC1264.2 +232500 PERFORM FAIL. NC1264.2 +232600 MOVE GP-31 TO COMPUTED-A NC1264.2 +232700 MOVE "SPACE" TO CORRECT-A. NC1264.2 +232800 GO TO LEV-WRITE-GF-3-31. NC1264.2 +232900 LEV-DELETE-GF-3-31. NC1264.2 +233000 PERFORM DE-LETE. NC1264.2 +233100 LEV-WRITE-GF-3-31. NC1264.2 +233200 MOVE "LEV-TEST-GF-3-31" TO PAR-NAME. NC1264.2 +233300 PERFORM PRINT-DETAIL. NC1264.2 +233400 LEV-TEST-GF-3-32. NC1264.2 +233500 IF GP-32 EQUAL TO "*00" NC1264.2 +233600 PERFORM PASS NC1264.2 +233700 GO TO LEV-WRITE-GF-3-32. NC1264.2 +233800 PERFORM FAIL. NC1264.2 +233900 MOVE GP-32 TO COMPUTED-A NC1264.2 +234000 MOVE "*00" TO CORRECT-A. NC1264.2 +234100 GO TO LEV-WRITE-GF-3-32. NC1264.2 +234200 LEV-DELETE-GF-3-32. NC1264.2 +234300 PERFORM DE-LETE. NC1264.2 +234400 LEV-WRITE-GF-3-32. NC1264.2 +234500 MOVE "LEV-TEST-GF-3-32" TO PAR-NAME. NC1264.2 +234600 PERFORM PRINT-DETAIL. NC1264.2 +234700 LEV-TEST-GF-3-33. NC1264.2 +234800 IF GP-33 EQUAL TO " 0" NC1264.2 +234900 PERFORM PASS NC1264.2 +235000 GO TO LEV-WRITE-GF-3-33. NC1264.2 +235100 PERFORM FAIL. NC1264.2 +235200 MOVE GP-33 TO COMPUTED-A NC1264.2 +235300 MOVE " 0" TO CORRECT-A. NC1264.2 +235400 GO TO LEV-WRITE-GF-3-33. NC1264.2 +235500 LEV-DELETE-GF-3-33. NC1264.2 +235600 PERFORM DE-LETE. NC1264.2 +235700 LEV-WRITE-GF-3-33. NC1264.2 +235800 MOVE "LEV-TEST-GF-3-33" TO PAR-NAME. NC1264.2 +235900 PERFORM PRINT-DETAIL. NC1264.2 +236000 LEV-TEST-GF-3-34. NC1264.2 +236100 IF GP-34 EQUAL TO " 2 1" NC1264.2 +236200 PERFORM PASS NC1264.2 +236300 GO TO LEV-WRITE-GF-3-34. NC1264.2 +236400 PERFORM FAIL. NC1264.2 +236500 MOVE GP-34 TO COMPUTED-A. NC1264.2 +236600 MOVE " 2 1" TO CORRECT-A. NC1264.2 +236700 GO TO LEV-WRITE-GF-3-34. NC1264.2 +236800 LEV-DELETE-GF-3-34. NC1264.2 +236900 PERFORM DE-LETE. NC1264.2 +237000 LEV-WRITE-GF-3-34. NC1264.2 +237100 MOVE "LEV-TEST-GF-3-34" TO PAR-NAME. NC1264.2 +237200 PERFORM PRINT-DETAIL. NC1264.2 +237300 LEV-TEST-GF-3-35. NC1264.2 +237400 IF GP-35 EQUAL TO "$00,036.00" NC1264.2 +237500 PERFORM PASS NC1264.2 +237600 GO TO LEV-WRITE-GF-3-35. NC1264.2 +237700 PERFORM FAIL. NC1264.2 +237800 MOVE GP-35 TO COMPUTED-A. NC1264.2 +237900 MOVE "$00,036.00" TO CORRECT-A. NC1264.2 +238000 GO TO LEV-WRITE-GF-3-35. NC1264.2 +238100 LEV-DELETE-GF-3-35. NC1264.2 +238200 PERFORM DE-LETE. NC1264.2 +238300 LEV-WRITE-GF-3-35. NC1264.2 +238400 MOVE "LEV-TEST-GF-3-35" TO PAR-NAME. NC1264.2 +238500 PERFORM PRINT-DETAIL. NC1264.2 +238600 LEV-TEST-GF-3-36. NC1264.2 +238700 IF GP-36 EQUAL TO "090108" NC1264.2 +238800 PERFORM PASS NC1264.2 +238900 GO TO LEV-WRITE-GF-3-36. NC1264.2 +239000 PERFORM FAIL. NC1264.2 +239100 MOVE GP-36 TO COMPUTED-A NC1264.2 +239200 MOVE "090108" TO CORRECT-A. NC1264.2 +239300 GO TO LEV-WRITE-GF-3-36. NC1264.2 +239400 LEV-DELETE-GF-3-36. NC1264.2 +239500 PERFORM DE-LETE. NC1264.2 +239600 LEV-WRITE-GF-3-36. NC1264.2 +239700 MOVE "LEV-TEST-GF-3-36" TO PAR-NAME. NC1264.2 +239800 PERFORM PRINT-DETAIL. NC1264.2 +239900 LEV-TEST-GF-3-37. NC1264.2 +240000 IF GP-37 EQUAL TO SPACE NC1264.2 +240100 PERFORM PASS NC1264.2 +240200 GO TO LEV-WRITE-GF-3-37. NC1264.2 +240300 PERFORM FAIL. NC1264.2 +240400 MOVE GP-37 TO COMPUTED-A NC1264.2 +240500 MOVE "SPACE" TO CORRECT-A. NC1264.2 +240600 GO TO LEV-WRITE-GF-3-37. NC1264.2 +240700 LEV-DELETE-GF-3-37. NC1264.2 +240800 PERFORM DE-LETE. NC1264.2 +240900 LEV-WRITE-GF-3-37. NC1264.2 +241000 MOVE "LEV-TEST-GF-3-37" TO PAR-NAME. NC1264.2 +241100 PERFORM PRINT-DETAIL. NC1264.2 +241200 LEV-TEST-GF-3-38. NC1264.2 +241300 IF GP-38 EQUAL TO "-36" NC1264.2 +241400 PERFORM PASS NC1264.2 +241500 GO TO LEV-WRITE-GF-3-38. NC1264.2 +241600 PERFORM FAIL. NC1264.2 +241700 MOVE GP-38 TO COMPUTED-A NC1264.2 +241800 MOVE "-36" TO CORRECT-A. NC1264.2 +241900 GO TO LEV-WRITE-GF-3-38. NC1264.2 +242000 LEV-DELETE-GF-3-38. NC1264.2 +242100 PERFORM DE-LETE. NC1264.2 +242200 LEV-WRITE-GF-3-38. NC1264.2 +242300 MOVE "LEV-TEST-GF-3-38" TO PAR-NAME. NC1264.2 +242400 PERFORM PRINT-DETAIL. NC1264.2 +242500 LEV-TEST-GF-3-39. NC1264.2 +242600 IF GP-39 EQUAL TO " 24" NC1264.2 +242700 PERFORM PASS NC1264.2 +242800 GO TO LEV-WRITE-GF-3-39. NC1264.2 +242900 PERFORM FAIL. NC1264.2 +243000 MOVE GP-39 TO COMPUTED-A NC1264.2 +243100 MOVE " 24" TO CORRECT-A. NC1264.2 +243200 GO TO LEV-WRITE-GF-3-39. NC1264.2 +243300 LEV-DELETE-GF-3-39. NC1264.2 +243400 PERFORM DE-LETE. NC1264.2 +243500 LEV-WRITE-GF-3-39. NC1264.2 +243600 MOVE "LEV-TEST-GF-3-39" TO PAR-NAME. NC1264.2 +243700 PERFORM PRINT-DETAIL. NC1264.2 +243800 LEV-TEST-GF-3-40. NC1264.2 +243900 IF GP-40 EQUAL TO "36 " NC1264.2 +244000 PERFORM PASS NC1264.2 +244100 GO TO LEV-WRITE-GF-3-40. NC1264.2 +244200 PERFORM FAIL. NC1264.2 +244300 MOVE GP-40 TO COMPUTED-A NC1264.2 +244400 MOVE "36 " TO CORRECT-A. NC1264.2 +244500 GO TO LEV-WRITE-GF-3-40. NC1264.2 +244600 LEV-DELETE-GF-3-40. NC1264.2 +244700 PERFORM DE-LETE. NC1264.2 +244800 LEV-WRITE-GF-3-40. NC1264.2 +244900 MOVE "LEV-TEST-GF-3-40" TO PAR-NAME. NC1264.2 +245000 PERFORM PRINT-DETAIL. NC1264.2 +245100 LEV-TEST-GF-3-41. NC1264.2 +245200 IF GP-41 EQUAL TO "01DB" NC1264.2 +245300 PERFORM PASS NC1264.2 +245400 GO TO LEV-WRITE-GF-3-41. NC1264.2 +245500 PERFORM FAIL. NC1264.2 +245600 MOVE GP-41 TO COMPUTED-A NC1264.2 +245700 MOVE "01DB" TO CORRECT-A. NC1264.2 +245800 GO TO LEV-WRITE-GF-3-41. NC1264.2 +245900 LEV-DELETE-GF-3-41. NC1264.2 +246000 PERFORM DE-LETE. NC1264.2 +246100 LEV-WRITE-GF-3-41. NC1264.2 +246200 MOVE "LEV-TEST-GF-3-41" TO PAR-NAME. NC1264.2 +246300 PERFORM PRINT-DETAIL. NC1264.2 +246400 LEV-TEST-GF-3-42. NC1264.2 +246500 IF GP-42 EQUAL TO "****" NC1264.2 +246600 PERFORM PASS NC1264.2 +246700 GO TO LEV-WRITE-GF-3-42. NC1264.2 +246800 PERFORM FAIL. NC1264.2 +246900 MOVE GP-42 TO COMPUTED-A. NC1264.2 +247000 MOVE "****" TO CORRECT-A. NC1264.2 +247100 GO TO LEV-WRITE-GF-3-42. NC1264.2 +247200 LEV-DELETE-GF-3-42. NC1264.2 +247300 PERFORM DE-LETE. NC1264.2 +247400 LEV-WRITE-GF-3-42. NC1264.2 +247500 MOVE "LEV-TEST-GF-3-42" TO PAR-NAME. NC1264.2 +247600 PERFORM PRINT-DETAIL. NC1264.2 +247700 LEV-TEST-GF-3-43. NC1264.2 +247800 IF GP-43 EQUAL TO "AIR" NC1264.2 +247900 PERFORM PASS NC1264.2 +248000 GO TO LEV-WRITE-GF-3-43. NC1264.2 +248100 PERFORM FAIL. NC1264.2 +248200 MOVE GP-43 TO COMPUTED-A NC1264.2 +248300 MOVE "AIR" TO CORRECT-A. NC1264.2 +248400 GO TO LEV-WRITE-GF-3-43. NC1264.2 +248500 LEV-DELETE-GF-3-43. NC1264.2 +248600 PERFORM DE-LETE. NC1264.2 +248700 LEV-WRITE-GF-3-43. NC1264.2 +248800 MOVE "LEV-TEST-GF-3-43" TO PAR-NAME. NC1264.2 +248900 PERFORM PRINT-DETAIL. NC1264.2 +249000 LEV-TEST-GF-3-44. NC1264.2 +249100 IF GP-44 EQUAL TO "9ZX" NC1264.2 +249200 PERFORM PASS NC1264.2 +249300 GO TO LEV-WRITE-GF-3-44. NC1264.2 +249400 PERFORM FAIL. NC1264.2 +249500 MOVE GP-44 TO COMPUTED-A NC1264.2 +249600 MOVE "9ZX" TO CORRECT-A. NC1264.2 +249700 GO TO LEV-WRITE-GF-3-44. NC1264.2 +249800 LEV-DELETE-GF-3-44. NC1264.2 +249900 PERFORM DE-LETE. NC1264.2 +250000 LEV-WRITE-GF-3-44. NC1264.2 +250100 MOVE "LEV-TEST-GF-3-44" TO PAR-NAME. NC1264.2 +250200 PERFORM PRINT-DETAIL. NC1264.2 +250300 LEV-TEST-GF-3-45. NC1264.2 +250400 IF GP-45 EQUAL TO "*1000" NC1264.2 +250500 PERFORM PASS NC1264.2 +250600 GO TO LEV-WRITE-GF-3-45. NC1264.2 +250700 PERFORM FAIL. NC1264.2 +250800 MOVE GP-45 TO COMPUTED-A NC1264.2 +250900 MOVE "*1000" TO CORRECT-A. NC1264.2 +251000 GO TO LEV-WRITE-GF-3-45. NC1264.2 +251100 LEV-DELETE-GF-3-45. NC1264.2 +251200 PERFORM DE-LETE. NC1264.2 +251300 LEV-WRITE-GF-3-45. NC1264.2 +251400 MOVE "LEV-TEST-GF-3-45" TO PAR-NAME. NC1264.2 +251500 PERFORM PRINT-DETAIL. NC1264.2 +251600 LEV-TEST-GF-3-46. NC1264.2 +251700 IF GP-46 EQUAL TO "0000000093.00" NC1264.2 +251800 PERFORM PASS NC1264.2 +251900 GO TO LEV-WRITE-GF-3-46. NC1264.2 +252000 PERFORM FAIL. NC1264.2 +252100 MOVE GP-46 TO COMPUTED-A NC1264.2 +252200 MOVE "0000000093.00" TO CORRECT-A. NC1264.2 +252300 GO TO LEV-WRITE-GF-3-46. NC1264.2 +252400 LEV-DELETE-GF-3-46. NC1264.2 +252500 PERFORM DE-LETE. NC1264.2 +252600 LEV-WRITE-GF-3-46. NC1264.2 +252700 MOVE "LEV-TEST-GF-3-46" TO PAR-NAME. NC1264.2 +252800 PERFORM PRINT-DETAIL. NC1264.2 +252900 LEV-TEST-GF-3-47. NC1264.2 +253000 IF GP-47 (1) EQUAL TO "5" NC1264.2 +253100 PERFORM PASS NC1264.2 +253200 GO TO LEV-WRITE-GF-3-47. NC1264.2 +253300 PERFORM FAIL. NC1264.2 +253400 MOVE GP-47 (1) TO COMPUTED-A. NC1264.2 +253500 MOVE "5" TO CORRECT-A. NC1264.2 +253600 GO TO LEV-WRITE-GF-3-47. NC1264.2 +253700 LEV-DELETE-GF-3-47. NC1264.2 +253800 PERFORM DE-LETE. NC1264.2 +253900 LEV-WRITE-GF-3-47. NC1264.2 +254000 MOVE "LEV-TEST-GF-3-47" TO PAR-NAME. NC1264.2 +254100 PERFORM PRINT-DETAIL. NC1264.2 +254200 LEV-TEST-GF-3-48. NC1264.2 +254300 IF GP-47 (2) EQUAL TO ZERO NC1264.2 +254400 PERFORM PASS NC1264.2 +254500 GO TO LEV-WRITE-GF-3-48. NC1264.2 +254600 PERFORM FAIL. NC1264.2 +254700 MOVE GP-47 (2) TO COMPUTED-A. NC1264.2 +254800 MOVE ZERO TO CORRECT-A. NC1264.2 +254900 GO TO LEV-WRITE-GF-3-48. NC1264.2 +255000 LEV-DELETE-GF-3-48. NC1264.2 +255100 PERFORM DE-LETE. NC1264.2 +255200 LEV-WRITE-GF-3-48. NC1264.2 +255300 MOVE "LEV-TEST-GF-3-48" TO PAR-NAME. NC1264.2 +255400 PERFORM PRINT-DETAIL. NC1264.2 +255500 LEV-TEST-GF-3-49. NC1264.2 +255600 IF GP-48 (1) EQUAL TO "Y" NC1264.2 +255700 PERFORM PASS NC1264.2 +255800 GO TO LEV-WRITE-GF-3-49. NC1264.2 +255900 PERFORM FAIL. NC1264.2 +256000 MOVE GP-48 (1) TO COMPUTED-A. NC1264.2 +256100 MOVE "Y" TO CORRECT-A. NC1264.2 +256200 GO TO LEV-WRITE-GF-3-49. NC1264.2 +256300 LEV-DELETE-GF-3-49. NC1264.2 +256400 PERFORM DE-LETE. NC1264.2 +256500 LEV-WRITE-GF-3-49. NC1264.2 +256600 MOVE "LEV-TEST-GF-3-49" TO PAR-NAME. NC1264.2 +256700 PERFORM PRINT-DETAIL. NC1264.2 +256800 LEV-TEST-GF-3-50. NC1264.2 +256900 IF GP-48 (2) EQUAL TO " " NC1264.2 +257000 PERFORM PASS NC1264.2 +257100 GO TO LEV-WRITE-GF-3-50. NC1264.2 +257200 PERFORM FAIL. NC1264.2 +257300 MOVE GP-48 (2) TO COMPUTED-A. NC1264.2 +257400 MOVE " " TO CORRECT-A. NC1264.2 +257500 GO TO LEV-WRITE-GF-3-50. NC1264.2 +257600 LEV-DELETE-GF-3-50. NC1264.2 +257700 PERFORM DE-LETE. NC1264.2 +257800 LEV-WRITE-GF-3-50. NC1264.2 +257900 MOVE "LEV-TEST-GF-3-50" TO PAR-NAME. NC1264.2 +258000 PERFORM PRINT-DETAIL. NC1264.2 +258100 GO TO CCVS-EXIT. NC1264.2 +258200 BREAKDOWN-PARA. NC1264.2 +258300 PERFORM FAIL. NC1264.2 +258400 MOVE CM-20 TO COMPUTED-A. NC1264.2 +258500 MOVE CR-20 TO CORRECT-A. NC1264.2 +258600 MOVE " 1ST 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +258700 IF LENGTH-COUNTER LESS THAN 21 GO TO BREAKDOWN-EXIT. NC1264.2 +258800 PERFORM PRINT-DETAIL. NC1264.2 +258900 MOVE CM-40 TO COMPUTED-A. NC1264.2 +259000 MOVE CR-40 TO CORRECT-A. NC1264.2 +259100 MOVE " 2ND 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +259200 IF LENGTH-COUNTER LESS THAN 41 GO TO BREAKDOWN-EXIT. NC1264.2 +259300 PERFORM PRINT-DETAIL. NC1264.2 +259400 MOVE CM-60 TO COMPUTED-A. NC1264.2 +259500 MOVE CR-60 TO CORRECT-A. NC1264.2 +259600 MOVE " 3RD 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +259700 IF LENGTH-COUNTER LESS THAN 61 GO TO BREAKDOWN-EXIT. NC1264.2 +259800 PERFORM PRINT-DETAIL. NC1264.2 +259900 MOVE CM-80 TO COMPUTED-A. NC1264.2 +260000 MOVE CR-80 TO CORRECT-A. NC1264.2 +260100 MOVE " 4TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +260200 IF LENGTH-COUNTER LESS THAN 81 GO TO BREAKDOWN-EXIT. NC1264.2 +260300 PERFORM PRINT-DETAIL. NC1264.2 +260400 MOVE CM-100 TO COMPUTED-A. NC1264.2 +260500 MOVE CR-100 TO CORRECT-A. NC1264.2 +260600 MOVE " 5TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +260700 IF LENGTH-COUNTER LESS THAN 101 GO TO BREAKDOWN-EXIT. NC1264.2 +260800 PERFORM PRINT-DETAIL. NC1264.2 +260900 MOVE CM-120 TO COMPUTED-A. NC1264.2 +261000 MOVE CR-120 TO CORRECT-A. NC1264.2 +261100 MOVE " 6TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +261200 IF LENGTH-COUNTER LESS THAN 121 GO TO BREAKDOWN-EXIT. NC1264.2 +261300 PERFORM PRINT-DETAIL. NC1264.2 +261400 MOVE CM-140 TO COMPUTED-A. NC1264.2 +261500 MOVE CR-140 TO CORRECT-A. NC1264.2 +261600 MOVE " 7TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +261700 IF LENGTH-COUNTER LESS THAN 141 GO TO BREAKDOWN-EXIT. NC1264.2 +261800 PERFORM PRINT-DETAIL. NC1264.2 +261900 MOVE CM-160 TO COMPUTED-A. NC1264.2 +262000 MOVE CR-160 TO CORRECT-A. NC1264.2 +262100 MOVE " 8TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +262200 IF LENGTH-COUNTER LESS THAN 161 GO TO BREAKDOWN-EXIT. NC1264.2 +262300 PERFORM PRINT-DETAIL. NC1264.2 +262400 MOVE CM-180 TO COMPUTED-A. NC1264.2 +262500 MOVE CR-180 TO CORRECT-A. NC1264.2 +262600 MOVE " 9TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +262700 IF LENGTH-COUNTER LESS THAN 181 GO TO BREAKDOWN-EXIT. NC1264.2 +262800 PERFORM PRINT-DETAIL. NC1264.2 +262900 MOVE CM-200 TO COMPUTED-A. NC1264.2 +263000 MOVE CR-200 TO CORRECT-A. NC1264.2 +263100 MOVE "10TH 20 POSITIONS OF RESULTS" TO RE-MARK. NC1264.2 +263200 BREAKDOWN-EXIT. NC1264.2 +263300 MOVE ZERO TO LENGTH-COUNTER. NC1264.2 +263400 CCVS-EXIT SECTION. NC1264.2 +263500 CCVS-999999. NC1264.2 +263600 GO TO CLOSE-FILES. NC1264.2 diff --git a/tests/cobol85/NC/NC127A.CBL b/tests/cobol85/NC/NC127A.CBL new file mode 100755 index 00000000..549a8a00 --- /dev/null +++ b/tests/cobol85/NC/NC127A.CBL @@ -0,0 +1,349 @@ +000100 identification division. NC1274.2 +000200 program-id. NC1274.2 +000300 nc127A. NC1274.2 +000400**************************************************************** NC1274.2 +000500* * NC1274.2 +000600* VALIDATION FOR:- * NC1274.2 +000700* * NC1274.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1274.2 +000900* * NC1274.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1274.2 +001100* * NC1274.2 +001200**************************************************************** NC1274.2 +001300* * NC1274.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1274.2 +001500* * NC1274.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1274.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1274.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1274.2 +001900* * NC1274.2 +002000**************************************************************** NC1274.2 +002100* NC1274.2 +002200* program nc127a is written using lower case letters NC1274.2 +002300* throughout, with the exception of standard COBOL text NC1274.2 +002400* which is copied into every CCVS8x program from a library NC1274.2 +002500* and some alphanumeric literals. NC1274.2 +002600* NC1274.2 +002700 environment division. NC1274.2 +002800 configuration section. NC1274.2 +002900 source-computer. NC1274.2 +003000 Linux. NC1274.2 +003100 object-computer. NC1274.2 +003200 Linux. NC1274.2 +003300 input-output section. NC1274.2 +003400 file-control. NC1274.2 +003500 select print-file assign to NC1274.2 +003600 "report.log". NC1274.2 +003700 data division. NC1274.2 +003800 file section. NC1274.2 +003900 FD PRINT-FILE. NC1274.2 +004000 01 print-rec picture x(120). NC1274.2 +004100 01 dummy-record picture x(120). NC1274.2 +004200 working-storage section. NC1274.2 +004300 01 alphabetic-lit-upper pic x(9) value "ABCRSTXYZ". NC1274.2 +004400 01 alphabetic-lit-lower pic x(9) value "abcrstxyz". NC1274.2 +004500 01 alpha-lit-upper-lower pic x(9) value "dEfJkLuVw". NC1274.2 +004600 01 TEST-RESULTS. NC1274.2 +004700 02 FILLER PIC X VALUE SPACE. NC1274.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. NC1274.2 +004900 02 FILLER PIC X VALUE SPACE. NC1274.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. NC1274.2 +005100 02 FILLER PIC X VALUE SPACE. NC1274.2 +005200 02 PAR-NAME. NC1274.2 +005300 03 FILLER PIC X(19) VALUE SPACE. NC1274.2 +005400 03 PARDOT-X PIC X VALUE SPACE. NC1274.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. NC1274.2 +005600 02 FILLER PIC X(8) VALUE SPACE. NC1274.2 +005700 02 RE-MARK PIC X(61). NC1274.2 +005800 01 TEST-COMPUTED. NC1274.2 +005900 02 FILLER PIC X(30) VALUE SPACE. NC1274.2 +006000 02 FILLER PIC X(17) VALUE NC1274.2 +006100 " COMPUTED=". NC1274.2 +006200 02 COMPUTED-X. NC1274.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1274.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A NC1274.2 +006500 PIC -9(9).9(9). NC1274.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1274.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1274.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1274.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. NC1274.2 +007000 04 COMPUTED-18V0 PIC -9(18). NC1274.2 +007100 04 FILLER PIC X. NC1274.2 +007200 03 FILLER PIC X(50) VALUE SPACE. NC1274.2 +007300 01 TEST-CORRECT. NC1274.2 +007400 02 FILLER PIC X(30) VALUE SPACE. NC1274.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1274.2 +007600 02 CORRECT-X. NC1274.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1274.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1274.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1274.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1274.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1274.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. NC1274.2 +008300 04 CORRECT-18V0 PIC -9(18). NC1274.2 +008400 04 FILLER PIC X. NC1274.2 +008500 03 FILLER PIC X(2) VALUE SPACE. NC1274.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1274.2 +008700 01 CCVS-C-1. NC1274.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1274.2 +008900- "SS PARAGRAPH-NAME NC1274.2 +009000- " REMARKS". NC1274.2 +009100 02 FILLER PIC X(20) VALUE SPACE. NC1274.2 +009200 01 CCVS-C-2. NC1274.2 +009300 02 FILLER PIC X VALUE SPACE. NC1274.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". NC1274.2 +009500 02 FILLER PIC X(15) VALUE SPACE. NC1274.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". NC1274.2 +009700 02 FILLER PIC X(94) VALUE SPACE. NC1274.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1274.2 +009900 01 REC-CT PIC 99 VALUE ZERO. NC1274.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1274.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1274.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1274.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1274.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1274.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1274.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1274.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1274.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1274.2 +010900 01 CCVS-H-1. NC1274.2 +011000 02 FILLER PIC X(39) VALUE SPACES. NC1274.2 +011100 02 FILLER PIC X(42) VALUE NC1274.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1274.2 +011300 02 FILLER PIC X(39) VALUE SPACES. NC1274.2 +011400 01 CCVS-H-2A. NC1274.2 +011500 02 FILLER PIC X(40) VALUE SPACE. NC1274.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1274.2 +011700 02 FILLER PIC XXXX VALUE NC1274.2 +011800 "4.2 ". NC1274.2 +011900 02 FILLER PIC X(28) VALUE NC1274.2 +012000 " COPY - NOT FOR DISTRIBUTION". NC1274.2 +012100 02 FILLER PIC X(41) VALUE SPACE. NC1274.2 +012200 NC1274.2 +012300 01 CCVS-H-2B. NC1274.2 +012400 02 FILLER PIC X(15) VALUE NC1274.2 +012500 "TEST RESULT OF ". NC1274.2 +012600 02 TEST-ID PIC X(9). NC1274.2 +012700 02 FILLER PIC X(4) VALUE NC1274.2 +012800 " IN ". NC1274.2 +012900 02 FILLER PIC X(12) VALUE NC1274.2 +013000 " HIGH ". NC1274.2 +013100 02 FILLER PIC X(22) VALUE NC1274.2 +013200 " LEVEL VALIDATION FOR ". NC1274.2 +013300 02 FILLER PIC X(58) VALUE NC1274.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1274.2 +013500 01 CCVS-H-3. NC1274.2 +013600 02 FILLER PIC X(34) VALUE NC1274.2 +013700 " FOR OFFICIAL USE ONLY ". NC1274.2 +013800 02 FILLER PIC X(58) VALUE NC1274.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1274.2 +014000 02 FILLER PIC X(28) VALUE NC1274.2 +014100 " COPYRIGHT 1985 ". NC1274.2 +014200 01 CCVS-E-1. NC1274.2 +014300 02 FILLER PIC X(52) VALUE SPACE. NC1274.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1274.2 +014500 02 ID-AGAIN PIC X(9). NC1274.2 +014600 02 FILLER PIC X(45) VALUE SPACES. NC1274.2 +014700 01 CCVS-E-2. NC1274.2 +014800 02 FILLER PIC X(31) VALUE SPACE. NC1274.2 +014900 02 FILLER PIC X(21) VALUE SPACE. NC1274.2 +015000 02 CCVS-E-2-2. NC1274.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1274.2 +015200 03 FILLER PIC X VALUE SPACE. NC1274.2 +015300 03 ENDER-DESC PIC X(44) VALUE NC1274.2 +015400 "ERRORS ENCOUNTERED". NC1274.2 +015500 01 CCVS-E-3. NC1274.2 +015600 02 FILLER PIC X(22) VALUE NC1274.2 +015700 " FOR OFFICIAL USE ONLY". NC1274.2 +015800 02 FILLER PIC X(12) VALUE SPACE. NC1274.2 +015900 02 FILLER PIC X(58) VALUE NC1274.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1274.2 +016100 02 FILLER PIC X(13) VALUE SPACE. NC1274.2 +016200 02 FILLER PIC X(15) VALUE NC1274.2 +016300 " COPYRIGHT 1985". NC1274.2 +016400 01 CCVS-E-4. NC1274.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1274.2 +016600 02 FILLER PIC X(4) VALUE " OF ". NC1274.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1274.2 +016800 02 FILLER PIC X(40) VALUE NC1274.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1274.2 +017000 01 XXINFO. NC1274.2 +017100 02 FILLER PIC X(19) VALUE NC1274.2 +017200 "*** INFORMATION ***". NC1274.2 +017300 02 INFO-TEXT. NC1274.2 +017400 04 FILLER PIC X(8) VALUE SPACE. NC1274.2 +017500 04 XXCOMPUTED PIC X(20). NC1274.2 +017600 04 FILLER PIC X(5) VALUE SPACE. NC1274.2 +017700 04 XXCORRECT PIC X(20). NC1274.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). NC1274.2 +017900 01 HYPHEN-LINE. NC1274.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. NC1274.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************NC1274.2 +018200- "*****************************************". NC1274.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************NC1274.2 +018400- "******************************". NC1274.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE NC1274.2 +018600 "NC127A". NC1274.2 +018700 PROCEDURE DIVISION. NC1274.2 +018800 CCVS1 SECTION. NC1274.2 +018900 OPEN-FILES. NC1274.2 +019000 OPEN OUTPUT PRINT-FILE. NC1274.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1274.2 +019200 MOVE SPACE TO TEST-RESULTS. NC1274.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1274.2 +019400 GO TO CCVS1-EXIT. NC1274.2 +019500 CLOSE-FILES. NC1274.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1274.2 +019700 TERMINATE-CCVS. NC1274.2 +019800*S EXIT PROGRAM. NC1274.2 +019900*SERMINATE-CALL. NC1274.2 +020000 STOP RUN. NC1274.2 +020100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1274.2 +020200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1274.2 +020300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1274.2 +020400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1274.2 +020500 MOVE "****TEST DELETED****" TO RE-MARK. NC1274.2 +020600 PRINT-DETAIL. NC1274.2 +020700 IF REC-CT NOT EQUAL TO ZERO NC1274.2 +020800 MOVE "." TO PARDOT-X NC1274.2 +020900 MOVE REC-CT TO DOTVALUE. NC1274.2 +021000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1274.2 +021100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1274.2 +021200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1274.2 +021300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1274.2 +021400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1274.2 +021500 MOVE SPACE TO CORRECT-X. NC1274.2 +021600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1274.2 +021700 MOVE SPACE TO RE-MARK. NC1274.2 +021800 HEAD-ROUTINE. NC1274.2 +021900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +022000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +022100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1274.2 +022200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1274.2 +022300 COLUMN-NAMES-ROUTINE. NC1274.2 +022400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +022500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +022600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +022700 END-ROUTINE. NC1274.2 +022800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1274.2 +022900 END-RTN-EXIT. NC1274.2 +023000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +023100 END-ROUTINE-1. NC1274.2 +023200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1274.2 +023300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1274.2 +023400 ADD PASS-COUNTER TO ERROR-HOLD. NC1274.2 +023500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1274.2 +023600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1274.2 +023700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1274.2 +023800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1274.2 +023900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1274.2 +024000 END-ROUTINE-12. NC1274.2 +024100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1274.2 +024200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1274.2 +024300 MOVE "NO " TO ERROR-TOTAL NC1274.2 +024400 ELSE NC1274.2 +024500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1274.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1274.2 +024700 PERFORM WRITE-LINE. NC1274.2 +024800 END-ROUTINE-13. NC1274.2 +024900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1274.2 +025000 MOVE "NO " TO ERROR-TOTAL ELSE NC1274.2 +025100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1274.2 +025200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1274.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +025400 IF INSPECT-COUNTER EQUAL TO ZERO NC1274.2 +025500 MOVE "NO " TO ERROR-TOTAL NC1274.2 +025600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1274.2 +025700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1274.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +025900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1274.2 +026000 WRITE-LINE. NC1274.2 +026100 ADD 1 TO RECORD-COUNT. NC1274.2 +026200 IF RECORD-COUNT GREATER 42 NC1274.2 +026300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1274.2 +026400 MOVE SPACE TO DUMMY-RECORD NC1274.2 +026500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1274.2 +026600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1274.2 +026700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1274.2 +026800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1274.2 +026900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1274.2 +027000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1274.2 +027100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1274.2 +027200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1274.2 +027300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1274.2 +027400 MOVE ZERO TO RECORD-COUNT. NC1274.2 +027500 PERFORM WRT-LN. NC1274.2 +027600 WRT-LN. NC1274.2 +027700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1274.2 +027800 MOVE SPACE TO DUMMY-RECORD. NC1274.2 +027900 BLANK-LINE-PRINT. NC1274.2 +028000 PERFORM WRT-LN. NC1274.2 +028100 FAIL-ROUTINE. NC1274.2 +028200 IF COMPUTED-X NOT EQUAL TO SPACE NC1274.2 +028300 GO TO FAIL-ROUTINE-WRITE. NC1274.2 +028400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1274.2 +028500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1274.2 +028600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1274.2 +028700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +028800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1274.2 +028900 GO TO FAIL-ROUTINE-EX. NC1274.2 +029000 FAIL-ROUTINE-WRITE. NC1274.2 +029100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1274.2 +029200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1274.2 +029300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1274.2 +029400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1274.2 +029500 FAIL-ROUTINE-EX. EXIT. NC1274.2 +029600 BAIL-OUT. NC1274.2 +029700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1274.2 +029800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1274.2 +029900 BAIL-OUT-WRITE. NC1274.2 +030000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1274.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1274.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1274.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1274.2 +030400 BAIL-OUT-EX. EXIT. NC1274.2 +030500 CCVS1-EXIT. NC1274.2 +030600 EXIT. NC1274.2 +030700 sect-nc127a-001 section. NC1274.2 +030800 low-init-gf-1. NC1274.2 +030900 move "III-4 NOTE-2" to ansi-reference. NC1274.2 +031000 low-test-gf-1-1. NC1274.2 +031100 if alphabetic-lit-upper not = alphabetic-lit-lower NC1274.2 +031200 perform pass NC1274.2 +031300 go to low-write-gf-1. NC1274.2 +031400 go to low-fail-gf-1. NC1274.2 +031500 low-delete-gf-1. NC1274.2 +031600 perform de-lete. NC1274.2 +031700 go to low-write-GF-1. NC1274.2 +031800 low-fail-gf-1. NC1274.2 +031900 move alphabetic-lit-upper to correct-x. NC1274.2 +032000 move alphabetic-lit-lower to computed-x. NC1274.2 +032100 move "upper and lower case should not be equal" NC1274.2 +032200 to re-mark. NC1274.2 +032300 perform fail. NC1274.2 +032400 low-write-gf-1. NC1274.2 +032500 move "lower case program" to feature. NC1274.2 +032600 MOVE "low-test-gf-1" to par-name. NC1274.2 +032700 perform print-detail. NC1274.2 +032800 low-init-gf-2. NC1274.2 +032900 move "vi-67 6.4.1" to ansi-reference. NC1274.2 +033000 low-test-gf-2. NC1274.2 +033100 if alpha-lit-upper-lower = "dEfJkLuVw" NC1274.2 +033200 perform pass NC1274.2 +033300 go to low-write-gf-2. NC1274.2 +033400 go to low-fail-gf-2. NC1274.2 +033500 low-delete-gf-2. NC1274.2 +033600 perform de-lete. NC1274.2 +033700 go to low-write-GF-2. NC1274.2 +033800 low-fail-gf-2. NC1274.2 +033900 move alpha-lit-upper-lower to correct-x. NC1274.2 +034000 move alpha-lit-upper-lower to computed-x. NC1274.2 +034100 move "identical literals should be equal" NC1274.2 +034200 to re-mark. NC1274.2 +034300 perform fail. NC1274.2 +034400 low-write-gf-2. NC1274.2 +034500 MOVE "low-test-gf-2" to par-name. NC1274.2 +034600 perform print-detail. NC1274.2 +034700 CCVS-EXIT SECTION. NC1274.2 +034800 CCVS-999999. NC1274.2 +034900 GO TO CLOSE-FILES. NC1274.2 diff --git a/tests/cobol85/NC/NC131A.CBL b/tests/cobol85/NC/NC131A.CBL new file mode 100755 index 00000000..aa78d23d --- /dev/null +++ b/tests/cobol85/NC/NC131A.CBL @@ -0,0 +1,468 @@ +000100 IDENTIFICATION DIVISION. NC1314.2 +000200 PROGRAM-ID. NC1314.2 +000300 NC131A. NC1314.2 +000400**************************************************************** NC1314.2 +000500* * NC1314.2 +000600* VALIDATION FOR:- * NC1314.2 +000700* * NC1314.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1314.2 +000900* * NC1314.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1314.2 +001100* * NC1314.2 +001200**************************************************************** NC1314.2 +001300* * NC1314.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1314.2 +001500* * NC1314.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1314.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1314.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1314.2 +001900* * NC1314.2 +002000**************************************************************** NC1314.2 +002100* NC1314.2 +002200* PROGRAM NC131A TESTS FORMAT 1 OF THE SET STATEMENT USING NC1314.2 +002300* VARIOUS COMBINATIONS OF INDEX-NAMES, IDENTIFIERS & INTEGERS NC1314.2 +002400* NC1314.2 +002500 ENVIRONMENT DIVISION. NC1314.2 +002600 CONFIGURATION SECTION. NC1314.2 +002700 SOURCE-COMPUTER. NC1314.2 +002800 Linux. NC1314.2 +002900 OBJECT-COMPUTER. NC1314.2 +003000 Linux. NC1314.2 +003100 INPUT-OUTPUT SECTION. NC1314.2 +003200 FILE-CONTROL. NC1314.2 +003300 SELECT PRINT-FILE ASSIGN TO NC1314.2 +003400 "report.log". NC1314.2 +003500 DATA DIVISION. NC1314.2 +003600 FILE SECTION. NC1314.2 +003700 FD PRINT-FILE. NC1314.2 +003800 01 PRINT-REC PICTURE X(120). NC1314.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC1314.2 +004000 WORKING-STORAGE SECTION. NC1314.2 +004100 77 I-DATA-1 USAGE IS INDEX. NC1314.2 +004200 77 IDENT-1 PICTURE 9 VALUE IS 4. NC1314.2 +004300 77 IDENT-2 PICTURE 9. NC1314.2 +004400 77 IDENT-3 PICTURE S99 USAGE COMPUTATIONAL. NC1314.2 +004500 77 SGN-IDX PICTURE 9(18). NC1314.2 +004600 01 INDEX-VALUE PIC 9999. NC1314.2 +004700 01 I-DATA-GROUP USAGE IS INDEX. NC1314.2 +004800 02 I-DATA-2 USAGE IS INDEX. NC1314.2 +004900 02 I-DATA-3 USAGE IS INDEX. NC1314.2 +005000 01 TABLE-1. NC1314.2 +005100 02 TAB1-REC PICTURE 99 OCCURS 100 TIMES NC1314.2 +005200 INDEXED BY INDEX1. NC1314.2 +005300 01 TABLE-2. NC1314.2 +005400 02 TAB2-REC PICTURE 999 OCCURS 100 TIMES NC1314.2 +005500 INDEXED BY INDEX2. NC1314.2 +005600 01 TEST-RESULTS. NC1314.2 +005700 02 FILLER PIC X VALUE SPACE. NC1314.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. NC1314.2 +005900 02 FILLER PIC X VALUE SPACE. NC1314.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. NC1314.2 +006100 02 FILLER PIC X VALUE SPACE. NC1314.2 +006200 02 PAR-NAME. NC1314.2 +006300 03 FILLER PIC X(19) VALUE SPACE. NC1314.2 +006400 03 PARDOT-X PIC X VALUE SPACE. NC1314.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. NC1314.2 +006600 02 FILLER PIC X(8) VALUE SPACE. NC1314.2 +006700 02 RE-MARK PIC X(61). NC1314.2 +006800 01 TEST-COMPUTED. NC1314.2 +006900 02 FILLER PIC X(30) VALUE SPACE. NC1314.2 +007000 02 FILLER PIC X(17) VALUE NC1314.2 +007100 " COMPUTED=". NC1314.2 +007200 02 COMPUTED-X. NC1314.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1314.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A NC1314.2 +007500 PIC -9(9).9(9). NC1314.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1314.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1314.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1314.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. NC1314.2 +008000 04 COMPUTED-18V0 PIC -9(18). NC1314.2 +008100 04 FILLER PIC X. NC1314.2 +008200 03 FILLER PIC X(50) VALUE SPACE. NC1314.2 +008300 01 TEST-CORRECT. NC1314.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC1314.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1314.2 +008600 02 CORRECT-X. NC1314.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1314.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1314.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1314.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1314.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1314.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. NC1314.2 +009300 04 CORRECT-18V0 PIC -9(18). NC1314.2 +009400 04 FILLER PIC X. NC1314.2 +009500 03 FILLER PIC X(2) VALUE SPACE. NC1314.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1314.2 +009700 01 CCVS-C-1. NC1314.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1314.2 +009900- "SS PARAGRAPH-NAME NC1314.2 +010000- " REMARKS". NC1314.2 +010100 02 FILLER PIC X(20) VALUE SPACE. NC1314.2 +010200 01 CCVS-C-2. NC1314.2 +010300 02 FILLER PIC X VALUE SPACE. NC1314.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". NC1314.2 +010500 02 FILLER PIC X(15) VALUE SPACE. NC1314.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". NC1314.2 +010700 02 FILLER PIC X(94) VALUE SPACE. NC1314.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1314.2 +010900 01 REC-CT PIC 99 VALUE ZERO. NC1314.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1314.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1314.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1314.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1314.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1314.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1314.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1314.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1314.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1314.2 +011900 01 CCVS-H-1. NC1314.2 +012000 02 FILLER PIC X(39) VALUE SPACES. NC1314.2 +012100 02 FILLER PIC X(42) VALUE NC1314.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1314.2 +012300 02 FILLER PIC X(39) VALUE SPACES. NC1314.2 +012400 01 CCVS-H-2A. NC1314.2 +012500 02 FILLER PIC X(40) VALUE SPACE. NC1314.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1314.2 +012700 02 FILLER PIC XXXX VALUE NC1314.2 +012800 "4.2 ". NC1314.2 +012900 02 FILLER PIC X(28) VALUE NC1314.2 +013000 " COPY - NOT FOR DISTRIBUTION". NC1314.2 +013100 02 FILLER PIC X(41) VALUE SPACE. NC1314.2 +013200 NC1314.2 +013300 01 CCVS-H-2B. NC1314.2 +013400 02 FILLER PIC X(15) VALUE NC1314.2 +013500 "TEST RESULT OF ". NC1314.2 +013600 02 TEST-ID PIC X(9). NC1314.2 +013700 02 FILLER PIC X(4) VALUE NC1314.2 +013800 " IN ". NC1314.2 +013900 02 FILLER PIC X(12) VALUE NC1314.2 +014000 " HIGH ". NC1314.2 +014100 02 FILLER PIC X(22) VALUE NC1314.2 +014200 " LEVEL VALIDATION FOR ". NC1314.2 +014300 02 FILLER PIC X(58) VALUE NC1314.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1314.2 +014500 01 CCVS-H-3. NC1314.2 +014600 02 FILLER PIC X(34) VALUE NC1314.2 +014700 " FOR OFFICIAL USE ONLY ". NC1314.2 +014800 02 FILLER PIC X(58) VALUE NC1314.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1314.2 +015000 02 FILLER PIC X(28) VALUE NC1314.2 +015100 " COPYRIGHT 1985 ". NC1314.2 +015200 01 CCVS-E-1. NC1314.2 +015300 02 FILLER PIC X(52) VALUE SPACE. NC1314.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1314.2 +015500 02 ID-AGAIN PIC X(9). NC1314.2 +015600 02 FILLER PIC X(45) VALUE SPACES. NC1314.2 +015700 01 CCVS-E-2. NC1314.2 +015800 02 FILLER PIC X(31) VALUE SPACE. NC1314.2 +015900 02 FILLER PIC X(21) VALUE SPACE. NC1314.2 +016000 02 CCVS-E-2-2. NC1314.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1314.2 +016200 03 FILLER PIC X VALUE SPACE. NC1314.2 +016300 03 ENDER-DESC PIC X(44) VALUE NC1314.2 +016400 "ERRORS ENCOUNTERED". NC1314.2 +016500 01 CCVS-E-3. NC1314.2 +016600 02 FILLER PIC X(22) VALUE NC1314.2 +016700 " FOR OFFICIAL USE ONLY". NC1314.2 +016800 02 FILLER PIC X(12) VALUE SPACE. NC1314.2 +016900 02 FILLER PIC X(58) VALUE NC1314.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1314.2 +017100 02 FILLER PIC X(13) VALUE SPACE. NC1314.2 +017200 02 FILLER PIC X(15) VALUE NC1314.2 +017300 " COPYRIGHT 1985". NC1314.2 +017400 01 CCVS-E-4. NC1314.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1314.2 +017600 02 FILLER PIC X(4) VALUE " OF ". NC1314.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1314.2 +017800 02 FILLER PIC X(40) VALUE NC1314.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1314.2 +018000 01 XXINFO. NC1314.2 +018100 02 FILLER PIC X(19) VALUE NC1314.2 +018200 "*** INFORMATION ***". NC1314.2 +018300 02 INFO-TEXT. NC1314.2 +018400 04 FILLER PIC X(8) VALUE SPACE. NC1314.2 +018500 04 XXCOMPUTED PIC X(20). NC1314.2 +018600 04 FILLER PIC X(5) VALUE SPACE. NC1314.2 +018700 04 XXCORRECT PIC X(20). NC1314.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). NC1314.2 +018900 01 HYPHEN-LINE. NC1314.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. NC1314.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************NC1314.2 +019200- "*****************************************". NC1314.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************NC1314.2 +019400- "******************************". NC1314.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE NC1314.2 +019600 "NC131A". NC1314.2 +019700 PROCEDURE DIVISION. NC1314.2 +019800 CCVS1 SECTION. NC1314.2 +019900 OPEN-FILES. NC1314.2 +020000 OPEN OUTPUT PRINT-FILE. NC1314.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1314.2 +020200 MOVE SPACE TO TEST-RESULTS. NC1314.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1314.2 +020400 GO TO CCVS1-EXIT. NC1314.2 +020500 CLOSE-FILES. NC1314.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1314.2 +020700 TERMINATE-CCVS. NC1314.2 +020800*S EXIT PROGRAM. NC1314.2 +020900*SERMINATE-CALL. NC1314.2 +021000 STOP RUN. NC1314.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1314.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1314.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1314.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1314.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. NC1314.2 +021600 PRINT-DETAIL. NC1314.2 +021700 IF REC-CT NOT EQUAL TO ZERO NC1314.2 +021800 MOVE "." TO PARDOT-X NC1314.2 +021900 MOVE REC-CT TO DOTVALUE. NC1314.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1314.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1314.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1314.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1314.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1314.2 +022500 MOVE SPACE TO CORRECT-X. NC1314.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1314.2 +022700 MOVE SPACE TO RE-MARK. NC1314.2 +022800 HEAD-ROUTINE. NC1314.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1314.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1314.2 +023300 COLUMN-NAMES-ROUTINE. NC1314.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +023700 END-ROUTINE. NC1314.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1314.2 +023900 END-RTN-EXIT. NC1314.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +024100 END-ROUTINE-1. NC1314.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1314.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1314.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. NC1314.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1314.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1314.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1314.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1314.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1314.2 +025000 END-ROUTINE-12. NC1314.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1314.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1314.2 +025300 MOVE "NO " TO ERROR-TOTAL NC1314.2 +025400 ELSE NC1314.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1314.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1314.2 +025700 PERFORM WRITE-LINE. NC1314.2 +025800 END-ROUTINE-13. NC1314.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1314.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE NC1314.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1314.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1314.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO NC1314.2 +026500 MOVE "NO " TO ERROR-TOTAL NC1314.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1314.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1314.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1314.2 +027000 WRITE-LINE. NC1314.2 +027100 ADD 1 TO RECORD-COUNT. NC1314.2 +027200 IF RECORD-COUNT GREATER 42 NC1314.2 +027300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1314.2 +027400 MOVE SPACE TO DUMMY-RECORD NC1314.2 +027500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1314.2 +027600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1314.2 +027700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1314.2 +027800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1314.2 +027900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1314.2 +028000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1314.2 +028100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1314.2 +028200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1314.2 +028300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1314.2 +028400 MOVE ZERO TO RECORD-COUNT. NC1314.2 +028500 PERFORM WRT-LN. NC1314.2 +028600 WRT-LN. NC1314.2 +028700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1314.2 +028800 MOVE SPACE TO DUMMY-RECORD. NC1314.2 +028900 BLANK-LINE-PRINT. NC1314.2 +029000 PERFORM WRT-LN. NC1314.2 +029100 FAIL-ROUTINE. NC1314.2 +029200 IF COMPUTED-X NOT EQUAL TO SPACE NC1314.2 +029300 GO TO FAIL-ROUTINE-WRITE. NC1314.2 +029400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1314.2 +029500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1314.2 +029600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1314.2 +029700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +029800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1314.2 +029900 GO TO FAIL-ROUTINE-EX. NC1314.2 +030000 FAIL-ROUTINE-WRITE. NC1314.2 +030100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1314.2 +030200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1314.2 +030300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1314.2 +030400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1314.2 +030500 FAIL-ROUTINE-EX. EXIT. NC1314.2 +030600 BAIL-OUT. NC1314.2 +030700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1314.2 +030800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1314.2 +030900 BAIL-OUT-WRITE. NC1314.2 +031000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1314.2 +031100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1314.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1314.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1314.2 +031400 BAIL-OUT-EX. EXIT. NC1314.2 +031500 CCVS1-EXIT. NC1314.2 +031600 EXIT. NC1314.2 +031700 SECT-NC131A-001 SECTION. NC1314.2 +031800 TEST-1. NC1314.2 +031900 MOVE "VI-127 6.23.4" TO ANSI-REFERENCE. NC1314.2 +032000 SET INDEX1 TO 5. NC1314.2 +032100 IF INDEX1 EQUAL TO 5 PERFORM PASS GO TO OK1. NC1314.2 +032200 SET SGN-IDX TO INDEX1. NC1314.2 +032300 MOVE SGN-IDX TO COMPUTED-18V0. NC1314.2 +032400 MOVE 5 TO CORRECT-18V0. NC1314.2 +032500 PERFORM FAIL. NC1314.2 +032600 OK1. NC1314.2 +032700 MOVE "TEST-1" TO PAR-NAME. NC1314.2 +032800 MOVE "SET OPT 1" TO FEATURE. NC1314.2 +032900 PERFORM PRINT-DETAIL. NC1314.2 +033000 TEST-2. NC1314.2 +033100 SET INDEX1 TO IDENT-1. NC1314.2 +033200 IF INDEX1 EQUAL TO 4 PERFORM PASS GO TO OK2. NC1314.2 +033300 SET SGN-IDX TO INDEX1. NC1314.2 +033400 MOVE SGN-IDX TO COMPUTED-18V0. NC1314.2 +033500 MOVE IDENT-1 TO CORRECT-18V0. NC1314.2 +033600 PERFORM FAIL. NC1314.2 +033700 OK2. NC1314.2 +033800 MOVE "TEST-2" TO PAR-NAME. NC1314.2 +033900 MOVE "SET OPT 2" TO FEATURE. NC1314.2 +034000 PERFORM PRINT-DETAIL. NC1314.2 +034100 TEST-3. NC1314.2 +034200 SET INDEX1 TO 4. NC1314.2 +034300 SET INDEX2 TO INDEX1. NC1314.2 +034400 IF INDEX2 EQUAL TO INDEX1 PERFORM PASS GO TO OK3. NC1314.2 +034500 SET SGN-IDX TO INDEX2. NC1314.2 +034600 MOVE SGN-IDX TO COMPUTED-18V0. NC1314.2 +034700 MOVE 4 TO CORRECT-18V0. NC1314.2 +034800 PERFORM FAIL. NC1314.2 +034900 OK3. NC1314.2 +035000 MOVE "TEST-3" TO PAR-NAME. NC1314.2 +035100 MOVE "SET OPT 3" TO FEATURE. NC1314.2 +035200 PERFORM PRINT-DETAIL. NC1314.2 +035300 TEST-4. NC1314.2 +035400 SET INDEX2 TO 4. NC1314.2 +035500 SET I-DATA-1 TO INDEX2. NC1314.2 +035600 IF I-DATA-1 EQUAL TO INDEX2 PERFORM PASS GO TO OK4. NC1314.2 +035700 SET INDEX-VALUE TO INDEX2. NC1314.2 +035800 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1314.2 +035900 MOVE 4 TO CORRECT-18V0. NC1314.2 +036000 PERFORM FAIL. NC1314.2 +036100 OK4. NC1314.2 +036200 MOVE "TEST-4" TO PAR-NAME. NC1314.2 +036300 MOVE "SET OPT 4" TO FEATURE. NC1314.2 +036400 PERFORM PRINT-DETAIL. NC1314.2 +036500 TEST-5. NC1314.2 +036600 SET INDEX2 TO 4. NC1314.2 +036700 SET I-DATA-1 TO INDEX2. NC1314.2 +036800 SET I-DATA-2 TO I-DATA-1. NC1314.2 +036900 IF I-DATA-2 EQUAL TO I-DATA-1 PERFORM PASS GO TO OK5. NC1314.2 +037000 SET INDEX-VALUE TO INDEX2. NC1314.2 +037100 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1314.2 +037200 MOVE 4 TO CORRECT-18V0. NC1314.2 +037300 PERFORM FAIL. NC1314.2 +037400 OK5. NC1314.2 +037500 MOVE "TEST-5" TO PAR-NAME. NC1314.2 +037600 MOVE "SET OPT 5" TO FEATURE. NC1314.2 +037700 PERFORM PRINT-DETAIL. NC1314.2 +037800 TEST-6. NC1314.2 +037900 SET INDEX2 TO 6. NC1314.2 +038000 SET IDENT-2 TO INDEX2. NC1314.2 +038100 IF IDENT-2 EQUAL TO INDEX2 PERFORM PASS GO TO OK6. NC1314.2 +038200 SET SGN-IDX TO INDEX2. NC1314.2 +038300 MOVE SGN-IDX TO COMPUTED-18V0. NC1314.2 +038400 MOVE 6 TO CORRECT-18V0. NC1314.2 +038500 PERFORM FAIL. NC1314.2 +038600 OK6. NC1314.2 +038700 MOVE "TEST-6" TO PAR-NAME. NC1314.2 +038800 MOVE "SET OPT 6" TO FEATURE. NC1314.2 +038900 PERFORM PRINT-DETAIL. NC1314.2 +039000 MOVE SPACE TO FEATURE. NC1314.2 +039100 END-TEST. NC1314.2 +039200 PERFORM BLANK-LINE-PRINT 2 TIMES. NC1314.2 +039300 MOVE "ASCENDING NUMBER LIST" TO RE-MARK. NC1314.2 +039400 PERFORM PRINT-DETAIL. NC1314.2 +039500 PERFORM BLANK-LINE-PRINT. NC1314.2 +039600 SET INDEX1 TO 1. NC1314.2 +039700 MOVE 1 TO IDENT-3. NC1314.2 +039800 L. MOVE IDENT-3 TO TAB1-REC (INDEX1). NC1314.2 +039900 IF IDENT-3 EQUAL TO 99 GO TO P-LIST. NC1314.2 +040000 ADD 1 TO IDENT-3. NC1314.2 +040100 SET INDEX1 TO IDENT-3. NC1314.2 +040200 GO TO L. NC1314.2 +040300 P-LIST. NC1314.2 +040400 SET INDEX1 TO 1. NC1314.2 +040500 MOVE 1 TO IDENT-3. NC1314.2 +040600 M. NC1314.2 +040700 MOVE TAB1-REC (INDEX1) TO RE-MARK. NC1314.2 +040800 PERFORM PRINT-DETAIL. NC1314.2 +040900 IF IDENT-3 EQUAL TO 99 GO TO CL-OSE. NC1314.2 +041000 ADD 1 TO IDENT-3. NC1314.2 +041100 SET INDEX1 TO IDENT-3. NC1314.2 +041200 GO TO M. NC1314.2 +041300 CL-OSE. NC1314.2 +041400 PERFORM BLANK-LINE-PRINT. NC1314.2 +041500 MOVE "END OF TABLE LIST" TO RE-MARK. NC1314.2 +041600 PERFORM PRINT-DETAIL. NC1314.2 +041700* NC1314.2 +041800 IDX-INIT-8. NC1314.2 +041900 MOVE "VI-127 6.23.4 GR3(c)" TO ANSI-REFERENCE. NC1314.2 +042000 SET INDEX1 TO 4. NC1314.2 +042100 IDX-TEST-8-0. NC1314.2 +042200 SET INDEX2 NC1314.2 +042300 IDENT-1 TO INDEX1. NC1314.2 +042400 IDX-TEST-8-1. NC1314.2 +042500 IF IDENT-1 EQUAL TO 4 PERFORM PASS GO TO OK8-1. NC1314.2 +042600 MOVE IDENT-1 TO COMPUTED-18V0. NC1314.2 +042700 MOVE 4 TO CORRECT-18V0. NC1314.2 +042800 PERFORM FAIL. NC1314.2 +042900 OK8-1. NC1314.2 +043000 MOVE "IDX-TEST-8-1" TO PAR-NAME. NC1314.2 +043100 PERFORM PRINT-DETAIL. NC1314.2 +043200 IDX-TEST-8-2. NC1314.2 +043300 IF INDEX2 EQUAL TO INDEX1 PERFORM PASS GO TO OK8-2. NC1314.2 +043400 SET INDEX-VALUE TO INDEX2. NC1314.2 +043500 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1314.2 +043600 MOVE 4 TO CORRECT-18V0. NC1314.2 +043700 PERFORM FAIL. NC1314.2 +043800 OK8-2. NC1314.2 +043900 MOVE "IDX-TEST-8-2" TO PAR-NAME. NC1314.2 +044000 PERFORM PRINT-DETAIL. NC1314.2 +044100* NC1314.2 +044200 IDX-INIT-9. NC1314.2 +044300 MOVE "VI-127 6.23.4 GR3(c)" TO ANSI-REFERENCE. NC1314.2 +044400 SET INDEX1 TO 4. NC1314.2 +044500 IDX-TEST-9-0. NC1314.2 +044600 SET IDENT-1 NC1314.2 +044700 INDEX2 TO INDEX1. NC1314.2 +044800 IDX-TEST-9-1. NC1314.2 +044900 IF IDENT-1 EQUAL TO 4 PERFORM PASS GO TO OK9-1. NC1314.2 +045000 MOVE IDENT-1 TO COMPUTED-18V0. NC1314.2 +045100 MOVE 4 TO CORRECT-18V0. NC1314.2 +045200 PERFORM FAIL. NC1314.2 +045300 OK9-1. NC1314.2 +045400 MOVE "IDX-TEST-9-1" TO PAR-NAME. NC1314.2 +045500 PERFORM PRINT-DETAIL. NC1314.2 +045600 IDX-TEST-9-2. NC1314.2 +045700 IF INDEX2 EQUAL TO INDEX1 PERFORM PASS GO TO OK9-2. NC1314.2 +045800 SET INDEX-VALUE TO INDEX2. NC1314.2 +045900 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1314.2 +046000 MOVE 4 TO CORRECT-18V0. NC1314.2 +046100 PERFORM FAIL. NC1314.2 +046200 OK9-2. NC1314.2 +046300 MOVE "IDX-TEST-9-2" TO PAR-NAME. NC1314.2 +046400 PERFORM PRINT-DETAIL. NC1314.2 +046500* NC1314.2 +046600 CCVS-EXIT SECTION. NC1314.2 +046700 CCVS-999999. NC1314.2 +046800 GO TO CLOSE-FILES. NC1314.2 diff --git a/tests/cobol85/NC/NC132A.CBL b/tests/cobol85/NC/NC132A.CBL new file mode 100755 index 00000000..77254500 --- /dev/null +++ b/tests/cobol85/NC/NC132A.CBL @@ -0,0 +1,794 @@ +000100 IDENTIFICATION DIVISION. NC1324.2 +000200 PROGRAM-ID. NC1324.2 +000300 NC132A. NC1324.2 +000400**************************************************************** NC1324.2 +000500* * NC1324.2 +000600* VALIDATION FOR:- * NC1324.2 +000700* * NC1324.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1324.2 +000900* * NC1324.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1324.2 +001100* * NC1324.2 +001200**************************************************************** NC1324.2 +001300* * NC1324.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1324.2 +001500* * NC1324.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1324.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1324.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1324.2 +001900* * NC1324.2 +002000**************************************************************** NC1324.2 +002100* NC1324.2 +002200* PROGRAM NC132A TESTS THE USE OF SUBSCRIPTS TO ACCESS A NC1324.2 +002300* SINGLE LEVEL TABLE USING INTEGER DISPLAY AND COMPUTATIONAL NC1324.2 +002400* FIELDS AS SUBSCRIPTS. NC1324.2 +002500* NC1324.2 +002600 ENVIRONMENT DIVISION. NC1324.2 +002700 CONFIGURATION SECTION. NC1324.2 +002800 SOURCE-COMPUTER. NC1324.2 +002900 Linux. NC1324.2 +003000 OBJECT-COMPUTER. NC1324.2 +003100 Linux. NC1324.2 +003200 INPUT-OUTPUT SECTION. NC1324.2 +003300 FILE-CONTROL. NC1324.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1324.2 +003500 "report.log". NC1324.2 +003600 DATA DIVISION. NC1324.2 +003700 FILE SECTION. NC1324.2 +003800 FD PRINT-FILE. NC1324.2 +003900 01 PRINT-REC PICTURE X(120). NC1324.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1324.2 +004100 WORKING-STORAGE SECTION. NC1324.2 +004200 77 CON-1 PICTURE 9 VALUE 1. NC1324.2 +004300 77 CON-2 PICTURE 9 VALUE 2. NC1324.2 +004400 77 CON-3 PICTURE 9 VALUE 3. NC1324.2 +004500 77 CON-4 PICTURE 9 VALUE 4. NC1324.2 +004600 77 SUB-3 PICTURE S9(18) COMPUTATIONAL VALUE 2. NC1324.2 +004700 77 SUB-4 PICTURE 9(18) COMPUTATIONAL VALUE 4. NC1324.2 +004800 01 CONSTANTS-77. NC1324.2 +004900 02 SUB1 PICTURE 9 VALUE 1. NC1324.2 +005000 02 SUB2 PICTURE S9 VALUE +4. NC1324.2 +005100 02 TABLE-A-VALUES PICTURE X(20) VALUE "1112223334441122334NC1324.2 +005200- "4". NC1324.2 +005300 01 TABLE-A. NC1324.2 +005400 02 ENTRY-A-1 PICTURE XXX OCCURS 4 TIMES. NC1324.2 +005500 02 ENTRY-A-2 OCCURS 4 TIMES. NC1324.2 +005600 03 ENTRY-A-3 PICTURE X. NC1324.2 +005700 03 ENTRY-A-4 PICTURE X. NC1324.2 +005800 01 TABLE-B. NC1324.2 +005900 02 ENTRY-B-1 PICTURE X(4) VALUE "1234". NC1324.2 +006000 02 ENTRY-B-2 REDEFINES ENTRY-B-1 PICTURE 9 OCCURS 4. NC1324.2 +006100 01 TABLE-C. NC1324.2 +006200 02 ENTRY-C PICTURE 9 OCCURS 4 TIMES. NC1324.2 +006300 01 TEST-RESULTS. NC1324.2 +006400 02 FILLER PIC X VALUE SPACE. NC1324.2 +006500 02 FEATURE PIC X(20) VALUE SPACE. NC1324.2 +006600 02 FILLER PIC X VALUE SPACE. NC1324.2 +006700 02 P-OR-F PIC X(5) VALUE SPACE. NC1324.2 +006800 02 FILLER PIC X VALUE SPACE. NC1324.2 +006900 02 PAR-NAME. NC1324.2 +007000 03 FILLER PIC X(19) VALUE SPACE. NC1324.2 +007100 03 PARDOT-X PIC X VALUE SPACE. NC1324.2 +007200 03 DOTVALUE PIC 99 VALUE ZERO. NC1324.2 +007300 02 FILLER PIC X(8) VALUE SPACE. NC1324.2 +007400 02 RE-MARK PIC X(61). NC1324.2 +007500 01 TEST-COMPUTED. NC1324.2 +007600 02 FILLER PIC X(30) VALUE SPACE. NC1324.2 +007700 02 FILLER PIC X(17) VALUE NC1324.2 +007800 " COMPUTED=". NC1324.2 +007900 02 COMPUTED-X. NC1324.2 +008000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1324.2 +008100 03 COMPUTED-N REDEFINES COMPUTED-A NC1324.2 +008200 PIC -9(9).9(9). NC1324.2 +008300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1324.2 +008400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1324.2 +008500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1324.2 +008600 03 CM-18V0 REDEFINES COMPUTED-A. NC1324.2 +008700 04 COMPUTED-18V0 PIC -9(18). NC1324.2 +008800 04 FILLER PIC X. NC1324.2 +008900 03 FILLER PIC X(50) VALUE SPACE. NC1324.2 +009000 01 TEST-CORRECT. NC1324.2 +009100 02 FILLER PIC X(30) VALUE SPACE. NC1324.2 +009200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1324.2 +009300 02 CORRECT-X. NC1324.2 +009400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1324.2 +009500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1324.2 +009600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1324.2 +009700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1324.2 +009800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1324.2 +009900 03 CR-18V0 REDEFINES CORRECT-A. NC1324.2 +010000 04 CORRECT-18V0 PIC -9(18). NC1324.2 +010100 04 FILLER PIC X. NC1324.2 +010200 03 FILLER PIC X(2) VALUE SPACE. NC1324.2 +010300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1324.2 +010400 01 CCVS-C-1. NC1324.2 +010500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1324.2 +010600- "SS PARAGRAPH-NAME NC1324.2 +010700- " REMARKS". NC1324.2 +010800 02 FILLER PIC X(20) VALUE SPACE. NC1324.2 +010900 01 CCVS-C-2. NC1324.2 +011000 02 FILLER PIC X VALUE SPACE. NC1324.2 +011100 02 FILLER PIC X(6) VALUE "TESTED". NC1324.2 +011200 02 FILLER PIC X(15) VALUE SPACE. NC1324.2 +011300 02 FILLER PIC X(4) VALUE "FAIL". NC1324.2 +011400 02 FILLER PIC X(94) VALUE SPACE. NC1324.2 +011500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1324.2 +011600 01 REC-CT PIC 99 VALUE ZERO. NC1324.2 +011700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1324.2 +011800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1324.2 +011900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1324.2 +012000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1324.2 +012100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1324.2 +012200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1324.2 +012300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1324.2 +012400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1324.2 +012500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1324.2 +012600 01 CCVS-H-1. NC1324.2 +012700 02 FILLER PIC X(39) VALUE SPACES. NC1324.2 +012800 02 FILLER PIC X(42) VALUE NC1324.2 +012900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1324.2 +013000 02 FILLER PIC X(39) VALUE SPACES. NC1324.2 +013100 01 CCVS-H-2A. NC1324.2 +013200 02 FILLER PIC X(40) VALUE SPACE. NC1324.2 +013300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1324.2 +013400 02 FILLER PIC XXXX VALUE NC1324.2 +013500 "4.2 ". NC1324.2 +013600 02 FILLER PIC X(28) VALUE NC1324.2 +013700 " COPY - NOT FOR DISTRIBUTION". NC1324.2 +013800 02 FILLER PIC X(41) VALUE SPACE. NC1324.2 +013900 NC1324.2 +014000 01 CCVS-H-2B. NC1324.2 +014100 02 FILLER PIC X(15) VALUE NC1324.2 +014200 "TEST RESULT OF ". NC1324.2 +014300 02 TEST-ID PIC X(9). NC1324.2 +014400 02 FILLER PIC X(4) VALUE NC1324.2 +014500 " IN ". NC1324.2 +014600 02 FILLER PIC X(12) VALUE NC1324.2 +014700 " HIGH ". NC1324.2 +014800 02 FILLER PIC X(22) VALUE NC1324.2 +014900 " LEVEL VALIDATION FOR ". NC1324.2 +015000 02 FILLER PIC X(58) VALUE NC1324.2 +015100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1324.2 +015200 01 CCVS-H-3. NC1324.2 +015300 02 FILLER PIC X(34) VALUE NC1324.2 +015400 " FOR OFFICIAL USE ONLY ". NC1324.2 +015500 02 FILLER PIC X(58) VALUE NC1324.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1324.2 +015700 02 FILLER PIC X(28) VALUE NC1324.2 +015800 " COPYRIGHT 1985 ". NC1324.2 +015900 01 CCVS-E-1. NC1324.2 +016000 02 FILLER PIC X(52) VALUE SPACE. NC1324.2 +016100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1324.2 +016200 02 ID-AGAIN PIC X(9). NC1324.2 +016300 02 FILLER PIC X(45) VALUE SPACES. NC1324.2 +016400 01 CCVS-E-2. NC1324.2 +016500 02 FILLER PIC X(31) VALUE SPACE. NC1324.2 +016600 02 FILLER PIC X(21) VALUE SPACE. NC1324.2 +016700 02 CCVS-E-2-2. NC1324.2 +016800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1324.2 +016900 03 FILLER PIC X VALUE SPACE. NC1324.2 +017000 03 ENDER-DESC PIC X(44) VALUE NC1324.2 +017100 "ERRORS ENCOUNTERED". NC1324.2 +017200 01 CCVS-E-3. NC1324.2 +017300 02 FILLER PIC X(22) VALUE NC1324.2 +017400 " FOR OFFICIAL USE ONLY". NC1324.2 +017500 02 FILLER PIC X(12) VALUE SPACE. NC1324.2 +017600 02 FILLER PIC X(58) VALUE NC1324.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1324.2 +017800 02 FILLER PIC X(13) VALUE SPACE. NC1324.2 +017900 02 FILLER PIC X(15) VALUE NC1324.2 +018000 " COPYRIGHT 1985". NC1324.2 +018100 01 CCVS-E-4. NC1324.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1324.2 +018300 02 FILLER PIC X(4) VALUE " OF ". NC1324.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1324.2 +018500 02 FILLER PIC X(40) VALUE NC1324.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1324.2 +018700 01 XXINFO. NC1324.2 +018800 02 FILLER PIC X(19) VALUE NC1324.2 +018900 "*** INFORMATION ***". NC1324.2 +019000 02 INFO-TEXT. NC1324.2 +019100 04 FILLER PIC X(8) VALUE SPACE. NC1324.2 +019200 04 XXCOMPUTED PIC X(20). NC1324.2 +019300 04 FILLER PIC X(5) VALUE SPACE. NC1324.2 +019400 04 XXCORRECT PIC X(20). NC1324.2 +019500 02 INF-ANSI-REFERENCE PIC X(48). NC1324.2 +019600 01 HYPHEN-LINE. NC1324.2 +019700 02 FILLER PIC IS X VALUE IS SPACE. NC1324.2 +019800 02 FILLER PIC IS X(65) VALUE IS "************************NC1324.2 +019900- "*****************************************". NC1324.2 +020000 02 FILLER PIC IS X(54) VALUE IS "************************NC1324.2 +020100- "******************************". NC1324.2 +020200 01 CCVS-PGM-ID PIC X(9) VALUE NC1324.2 +020300 "NC132A". NC1324.2 +020400 PROCEDURE DIVISION. NC1324.2 +020500 CCVS1 SECTION. NC1324.2 +020600 OPEN-FILES. NC1324.2 +020700 OPEN OUTPUT PRINT-FILE. NC1324.2 +020800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1324.2 +020900 MOVE SPACE TO TEST-RESULTS. NC1324.2 +021000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1324.2 +021100 GO TO CCVS1-EXIT. NC1324.2 +021200 CLOSE-FILES. NC1324.2 +021300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1324.2 +021400 TERMINATE-CCVS. NC1324.2 +021500*S EXIT PROGRAM. NC1324.2 +021600*SERMINATE-CALL. NC1324.2 +021700 STOP RUN. NC1324.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1324.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1324.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1324.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1324.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. NC1324.2 +022300 PRINT-DETAIL. NC1324.2 +022400 IF REC-CT NOT EQUAL TO ZERO NC1324.2 +022500 MOVE "." TO PARDOT-X NC1324.2 +022600 MOVE REC-CT TO DOTVALUE. NC1324.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1324.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1324.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1324.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1324.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1324.2 +023200 MOVE SPACE TO CORRECT-X. NC1324.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1324.2 +023400 MOVE SPACE TO RE-MARK. NC1324.2 +023500 HEAD-ROUTINE. NC1324.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1324.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1324.2 +024000 COLUMN-NAMES-ROUTINE. NC1324.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +024400 END-ROUTINE. NC1324.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1324.2 +024600 END-RTN-EXIT. NC1324.2 +024700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +024800 END-ROUTINE-1. NC1324.2 +024900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1324.2 +025000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1324.2 +025100 ADD PASS-COUNTER TO ERROR-HOLD. NC1324.2 +025200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1324.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1324.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1324.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1324.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1324.2 +025700 END-ROUTINE-12. NC1324.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1324.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1324.2 +026000 MOVE "NO " TO ERROR-TOTAL NC1324.2 +026100 ELSE NC1324.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1324.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1324.2 +026400 PERFORM WRITE-LINE. NC1324.2 +026500 END-ROUTINE-13. NC1324.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1324.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE NC1324.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1324.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1324.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO NC1324.2 +027200 MOVE "NO " TO ERROR-TOTAL NC1324.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1324.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1324.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1324.2 +027700 WRITE-LINE. NC1324.2 +027800 ADD 1 TO RECORD-COUNT. NC1324.2 +027900 IF RECORD-COUNT GREATER 42 NC1324.2 +028000 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1324.2 +028100 MOVE SPACE TO DUMMY-RECORD NC1324.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1324.2 +028300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1324.2 +028400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1324.2 +028500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1324.2 +028600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1324.2 +028700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1324.2 +028800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1324.2 +028900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1324.2 +029000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1324.2 +029100 MOVE ZERO TO RECORD-COUNT. NC1324.2 +029200 PERFORM WRT-LN. NC1324.2 +029300 WRT-LN. NC1324.2 +029400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1324.2 +029500 MOVE SPACE TO DUMMY-RECORD. NC1324.2 +029600 BLANK-LINE-PRINT. NC1324.2 +029700 PERFORM WRT-LN. NC1324.2 +029800 FAIL-ROUTINE. NC1324.2 +029900 IF COMPUTED-X NOT EQUAL TO SPACE NC1324.2 +030000 GO TO FAIL-ROUTINE-WRITE. NC1324.2 +030100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1324.2 +030200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1324.2 +030300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1324.2 +030400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +030500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1324.2 +030600 GO TO FAIL-ROUTINE-EX. NC1324.2 +030700 FAIL-ROUTINE-WRITE. NC1324.2 +030800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1324.2 +030900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1324.2 +031000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1324.2 +031100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1324.2 +031200 FAIL-ROUTINE-EX. EXIT. NC1324.2 +031300 BAIL-OUT. NC1324.2 +031400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1324.2 +031500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1324.2 +031600 BAIL-OUT-WRITE. NC1324.2 +031700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1324.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1324.2 +031900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1324.2 +032000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1324.2 +032100 BAIL-OUT-EX. EXIT. NC1324.2 +032200 CCVS1-EXIT. NC1324.2 +032300 EXIT. NC1324.2 +032400 SECT-TH132A-001 SECTION. NC1324.2 +032500 TH-02-001. NC1324.2 +032600 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1324.2 +032700 MOVE TABLE-A-VALUES TO TABLE-A. NC1324.2 +032800 MOVE "SUBSCRIPTING" TO FEATURE. NC1324.2 +032900 SUB-SCRIPT-1. NC1324.2 +033000 IF TABLE-A IS NOT EQUAL TO TABLE-A-VALUES NC1324.2 +033100 GO TO SUB-SCRIPT-1B. NC1324.2 +033200 PERFORM PASS. NC1324.2 +033300 GO TO SUB-SCRIPT-1C. NC1324.2 +033400 SUB-SCRIPT-1A. NC1324.2 +033500 PERFORM DE-LETE. NC1324.2 +033600 GO TO SUB-SCRIPT-1C. NC1324.2 +033700 SUB-SCRIPT-1B. NC1324.2 +033800 PERFORM FAIL. NC1324.2 +033900 MOVE TABLE-A TO COMPUTED-A. NC1324.2 +034000 MOVE "11122233344411223344" TO CORRECT-A. NC1324.2 +034100 SUB-SCRIPT-1C. NC1324.2 +034200 MOVE "SUB-SCRIPT-1" TO PAR-NAME. NC1324.2 +034300 PERFORM PRINT-DETAIL. NC1324.2 +034400* NOTE ******* THIS TEST CHECKS TO SEE THAT THE TABLE NC1324.2 +034500* TO BE USED IN THE PROGRAM IS SET UP NC1324.2 +034600* CORRECTLY. NC1324.2 +034700 SUB-SCRIPT-2. NC1324.2 +034800 IF ENTRY-A-1 (1) NOT EQUAL TO "111" NC1324.2 +034900 GO TO SUB-SCRIPT-2B. NC1324.2 +035000 PERFORM PASS. NC1324.2 +035100 GO TO SUB-SCRIPT-2C. NC1324.2 +035200 SUB-SCRIPT-2A. NC1324.2 +035300 PERFORM DE-LETE. NC1324.2 +035400 GO TO SUB-SCRIPT-2C. NC1324.2 +035500 SUB-SCRIPT-2B. NC1324.2 +035600 PERFORM FAIL. NC1324.2 +035700 MOVE ENTRY-A-1 (1) TO COMPUTED-A NC1324.2 +035800 MOVE "111" TO CORRECT-A. NC1324.2 +035900 SUB-SCRIPT-2C. NC1324.2 +036000 MOVE "SUB-SCRIPT-2" TO PAR-NAME. NC1324.2 +036100 PERFORM PRINT-DETAIL. NC1324.2 +036200* NOTE ****** THIS CHECKS THE USE OF NUMERIC LITERALS NC1324.2 +036300* AS SUBSCRIPTS. NC1324.2 +036400 SUB-SCRIPT-3. NC1324.2 +036500 IF ENTRY-A-1 (SUB1) NOT EQUAL TO "111" NC1324.2 +036600 GO TO SUB-SCRIPT-3B. NC1324.2 +036700 PERFORM PASS. NC1324.2 +036800 GO TO SUB-SCRIPT-3C. NC1324.2 +036900 SUB-SCRIPT-3A. NC1324.2 +037000 PERFORM DE-LETE. NC1324.2 +037100 GO TO SUB-SCRIPT-3C. NC1324.2 +037200 SUB-SCRIPT-3B. NC1324.2 +037300 PERFORM FAIL. NC1324.2 +037400 MOVE ENTRY-A-1 (SUB1) TO COMPUTED-A. NC1324.2 +037500 MOVE "111" TO CORRECT-A. NC1324.2 +037600 SUB-SCRIPT-3C. NC1324.2 +037700 MOVE "SUB-SCRIPT-3" TO PAR-NAME. NC1324.2 +037800 PERFORM PRINT-DETAIL. NC1324.2 +037900* NOTE ******* THIS CHECKS THE USE OF UNSIGNED NC1324.2 +038000* CONSTANTS AS SUBSCRIPTS. NC1324.2 +038100 SUB-SCRIPT-4. NC1324.2 +038200 ADD 1 TO SUB1. NC1324.2 +038300 IF ENTRY-A-1 (SUB1) NOT EQUAL TO "222" NC1324.2 +038400 GO TO SUB-SCRIPT-4B. NC1324.2 +038500 PERFORM PASS. NC1324.2 +038600 GO TO SUB-SCRIPT-4C. NC1324.2 +038700 SUB-SCRIPT-4A. NC1324.2 +038800 PERFORM DE-LETE. NC1324.2 +038900 GO TO SUB-SCRIPT-4C. NC1324.2 +039000 SUB-SCRIPT-4B. NC1324.2 +039100 PERFORM FAIL. NC1324.2 +039200 MOVE ENTRY-A-1 (SUB1) TO COMPUTED-A. NC1324.2 +039300 MOVE "222" TO CORRECT-A. NC1324.2 +039400 SUB-SCRIPT-4C. NC1324.2 +039500 MOVE "SUB-SCRIPT-4" TO PAR-NAME. NC1324.2 +039600 PERFORM PRINT-DETAIL. NC1324.2 +039700* NOTE ******* THIS CHECKS THE VARYING OF AN NC1324.2 +039800* UNSIGNED SUBSCRIPT. NC1324.2 +039900 SUB-SCRIPT-5. NC1324.2 +040000 MOVE +4 TO SUB2. NC1324.2 +040100 IF ENTRY-A-1 (SUB2) NOT EQUAL TO "444" NC1324.2 +040200 GO TO SUB-SCRIPT-5B. NC1324.2 +040300 PERFORM PASS. NC1324.2 +040400 GO TO SUB-SCRIPT-5C. NC1324.2 +040500 SUB-SCRIPT-5A. NC1324.2 +040600 PERFORM DE-LETE. NC1324.2 +040700 GO TO SUB-SCRIPT-5C. NC1324.2 +040800 SUB-SCRIPT-5B. NC1324.2 +040900 PERFORM FAIL. NC1324.2 +041000 MOVE ENTRY-A-1 (SUB2) TO COMPUTED-A. NC1324.2 +041100 MOVE "444" TO CORRECT-A. NC1324.2 +041200 SUB-SCRIPT-5C. NC1324.2 +041300 MOVE "SUB-SCRIPT-5" TO PAR-NAME. NC1324.2 +041400 PERFORM PRINT-DETAIL. NC1324.2 +041500* NOTE ****** THIS CHECKS THE USE OF A SIGNED NC1324.2 +041600* CONSTANT AS SUBSCRIPTS. NC1324.2 +041700 SUB-SCRIPT-6. NC1324.2 +041800 SUBTRACT +1 FROM SUB2. NC1324.2 +041900 IF ENTRY-A-1 (SUB2) NOT EQUAL TO "333" NC1324.2 +042000 GO TO SUB-SCRIPT-6B. NC1324.2 +042100 PERFORM PASS. NC1324.2 +042200 GO TO SUB-SCRIPT-6C. NC1324.2 +042300 SUB-SCRIPT-6A. NC1324.2 +042400 PERFORM DE-LETE. NC1324.2 +042500 GO TO SUB-SCRIPT-6C. NC1324.2 +042600 SUB-SCRIPT-6B. NC1324.2 +042700 PERFORM FAIL. NC1324.2 +042800 MOVE ENTRY-A-1 (SUB2) TO COMPUTED-A. NC1324.2 +042900 MOVE "333" TO CORRECT-A. NC1324.2 +043000 SUB-SCRIPT-6C. NC1324.2 +043100 MOVE "SUB-SCRIPT-6" TO PAR-NAME. NC1324.2 +043200 PERFORM PRINT-DETAIL. NC1324.2 +043300* NOTE ****** THIS CHECKS THE VARYING OF A NC1324.2 +043400* SIGNED SUBSCRIPT. NC1324.2 +043500*SUB-SCRIPT-7. NC1324.2 +043600* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1324.2 +043700* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1324.2 +043800 SUB-SCRIPT-8. NC1324.2 +043900 IF ENTRY-A-3 (2) NOT EQUAL TO "2" NC1324.2 +044000 GO TO SUB-SCRIPT-8B. NC1324.2 +044100 PERFORM PASS. NC1324.2 +044200 GO TO SUB-SCRIPT-8C. NC1324.2 +044300 SUB-SCRIPT-8A. NC1324.2 +044400 PERFORM DE-LETE. NC1324.2 +044500 GO TO SUB-SCRIPT-8C. NC1324.2 +044600 SUB-SCRIPT-8B. NC1324.2 +044700 PERFORM FAIL. NC1324.2 +044800 MOVE ENTRY-A-3 (2) TO COMPUTED-A. NC1324.2 +044900 MOVE "2" TO CORRECT-A. NC1324.2 +045000 SUB-SCRIPT-8C. NC1324.2 +045100 MOVE "SUB-SCRIPT-8" TO PAR-NAME. NC1324.2 +045200 PERFORM PRINT-DETAIL. NC1324.2 +045300* NOTE ***** THIS CHECKS THE USE OF AN ELEMENTARY ITEM NC1324.2 +045400* WHEN THE GROUP ITEM HAS THE OCCURS. NC1324.2 +045500 SUB-SCRIPT-9. NC1324.2 +045600 IF ENTRY-A-2 (4) NOT EQUAL TO "44" NC1324.2 +045700 GO TO SUB-SCRIPT-9B. NC1324.2 +045800 PERFORM PASS. NC1324.2 +045900 GO TO SUB-SCRIPT-9C. NC1324.2 +046000 SUB-SCRIPT-9A. NC1324.2 +046100 PERFORM DE-LETE. NC1324.2 +046200 GO TO SUB-SCRIPT-9C. NC1324.2 +046300 SUB-SCRIPT-9B. NC1324.2 +046400 PERFORM FAIL. NC1324.2 +046500 MOVE ENTRY-A-2 (4) TO COMPUTED-A. NC1324.2 +046600 MOVE "44" TO CORRECT-A. NC1324.2 +046700 SUB-SCRIPT-9C. NC1324.2 +046800 MOVE "SUB-SCRIPT-9" TO PAR-NAME. NC1324.2 +046900 PERFORM PRINT-DETAIL. NC1324.2 +047000* NOTE ******* THIS CHECKS A GROUP ITEM WHEN IT NC1324.2 +047100* HAS THE OCCURS. NC1324.2 +047200 SUB-SCRIPT-10. NC1324.2 +047300 IF ENTRY-B-2 (1) NOT EQUAL TO "1" NC1324.2 +047400 GO TO SUB-SCRIPT-10B. NC1324.2 +047500 PERFORM PASS. NC1324.2 +047600 GO TO SUB-SCRIPT-10C. NC1324.2 +047700 SUB-SCRIPT-10A. NC1324.2 +047800 PERFORM DE-LETE. NC1324.2 +047900 GO TO SUB-SCRIPT-10C. NC1324.2 +048000 SUB-SCRIPT-10B. NC1324.2 +048100 PERFORM FAIL. NC1324.2 +048200 MOVE ENTRY-B-2 (1) TO COMPUTED-A. NC1324.2 +048300 MOVE "1" TO CORRECT-A. NC1324.2 +048400 SUB-SCRIPT-10C. NC1324.2 +048500 MOVE "SUB-SCRIPT-10" TO PAR-NAME. NC1324.2 +048600 PERFORM PRINT-DETAIL. NC1324.2 +048700* NOTE ****** THIS CHECKS THE USE OF THE REDEFINE. NC1324.2 +048800 SUB-SCRIPT-11. NC1324.2 +048900 MOVE ENTRY-B-2 (1) TO ENTRY-C (4). NC1324.2 +049000 MOVE ENTRY-B-2 (2) TO ENTRY-C (3). NC1324.2 +049100 MOVE ENTRY-B-2 (3) TO ENTRY-C (2). NC1324.2 +049200 MOVE ENTRY-B-2 (4) TO ENTRY-C (1). NC1324.2 +049300 IF TABLE-C NOT EQUAL TO "4321" NC1324.2 +049400 GO TO SUB-SCRIPT-11B. NC1324.2 +049500 PERFORM PASS. NC1324.2 +049600 GO TO SUB-SCRIPT-11C. NC1324.2 +049700 SUB-SCRIPT-11A. NC1324.2 +049800 PERFORM DE-LETE. NC1324.2 +049900 GO TO SUB-SCRIPT-11C. NC1324.2 +050000 SUB-SCRIPT-11B. NC1324.2 +050100 PERFORM FAIL. NC1324.2 +050200 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +050300 MOVE "4321" TO CORRECT-A. NC1324.2 +050400 SUB-SCRIPT-11C. NC1324.2 +050500 MOVE "SUB-SCRIPT-11" TO PAR-NAME. NC1324.2 +050600 PERFORM PRINT-DETAIL. NC1324.2 +050700 SUB-SCRIPT-12. NC1324.2 +050800 MOVE "0000" TO TABLE-C. NC1324.2 +050900 ADD ENTRY-B-2 (1) TO ENTRY-C (1). NC1324.2 +051000 ADD ENTRY-B-2 (2) TO ENTRY-C (2). NC1324.2 +051100 ADD ENTRY-B-2 (3) TO ENTRY-C (3). NC1324.2 +051200 ADD ENTRY-B-2 (4) TO ENTRY-C (4). NC1324.2 +051300 IF TABLE-C NOT EQUAL TO "1234" NC1324.2 +051400 GO TO SUB-SCRIPT-12B. NC1324.2 +051500 PERFORM PASS. NC1324.2 +051600 GO TO SUB-SCRIPT-12C. NC1324.2 +051700 SUB-SCRIPT-12A. NC1324.2 +051800 PERFORM DE-LETE. NC1324.2 +051900 GO TO SUB-SCRIPT-12C. NC1324.2 +052000 SUB-SCRIPT-12B. NC1324.2 +052100 PERFORM FAIL. NC1324.2 +052200 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +052300 MOVE "1234" TO CORRECT-A. NC1324.2 +052400 SUB-SCRIPT-12C. NC1324.2 +052500 MOVE "SUB-SCRIPT-12" TO PAR-NAME. NC1324.2 +052600 PERFORM PRINT-DETAIL. NC1324.2 +052700* THIS TEST CHECKS THE USE OF SUBSCRIPTED DATA-NAMES NC1324.2 +052800* IN AN ADD STATEMENT NC1324.2 +052900 SUB-SCRIPT-13. NC1324.2 +053000 MOVE "1234" TO TABLE-C. NC1324.2 +053100 SUBTRACT ENTRY-B-2 (1) FROM ENTRY-C (1). NC1324.2 +053200 SUBTRACT ENTRY-B-2 (2) FROM ENTRY-C (2). NC1324.2 +053300 SUBTRACT ENTRY-B-2 (3) FROM ENTRY-C (3). NC1324.2 +053400 SUBTRACT ENTRY-B-2 (4) FROM ENTRY-C (4). NC1324.2 +053500 IF TABLE-C NOT EQUAL TO "0000" NC1324.2 +053600 GO TO SUB-SCRIPT-13B. NC1324.2 +053700 PERFORM PASS. NC1324.2 +053800 GO TO SUB-SCRIPT-13C. NC1324.2 +053900 SUB-SCRIPT-13A. NC1324.2 +054000 PERFORM DE-LETE. NC1324.2 +054100 GO TO SUB-SCRIPT-13C. NC1324.2 +054200 SUB-SCRIPT-13B. NC1324.2 +054300 PERFORM FAIL. NC1324.2 +054400 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +054500 MOVE "0000" TO CORRECT-A. NC1324.2 +054600 SUB-SCRIPT-13C. NC1324.2 +054700 MOVE "SUB-SCRIPT-13" TO PAR-NAME. NC1324.2 +054800 PERFORM PRINT-DETAIL. NC1324.2 +054900* THIS TEST CHECKS THE USE OF SUBSCRIPTED DATA-NAMES NC1324.2 +055000* IN A SUBTRACT STATEMENT. NC1324.2 +055100 SUB-SCRIPT-14. NC1324.2 +055200 MOVE "1111" TO TABLE-C. NC1324.2 +055300 MULTIPLY ENTRY-B-2 (1) BY ENTRY-C (1). NC1324.2 +055400 MULTIPLY ENTRY-B-2 (2) BY ENTRY-C (2). NC1324.2 +055500 MULTIPLY ENTRY-B-2 (3) BY ENTRY-C (3). NC1324.2 +055600 MULTIPLY ENTRY-B-2 (4) BY ENTRY-C (4). NC1324.2 +055700 IF TABLE-C NOT EQUAL TO "1234" NC1324.2 +055800 GO TO SUB-SCRIPT-14B. NC1324.2 +055900 PERFORM PASS. NC1324.2 +056000 GO TO SUB-SCRIPT-14C. NC1324.2 +056100 SUB-SCRIPT-14A. NC1324.2 +056200 PERFORM DE-LETE. NC1324.2 +056300 GO TO SUB-SCRIPT-14C. NC1324.2 +056400 SUB-SCRIPT-14B. NC1324.2 +056500 PERFORM FAIL. NC1324.2 +056600 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +056700 MOVE "1234" TO CORRECT-A. NC1324.2 +056800 SUB-SCRIPT-14C. NC1324.2 +056900 MOVE "SUB-SCRIPT-14" TO PAR-NAME. NC1324.2 +057000 PERFORM PRINT-DETAIL. NC1324.2 +057100* THIS TEST CHECKS THE USE OF SUBSCRIPTED DATA-NAMES NC1324.2 +057200* IN A MULTIPLY STATEMENT. NC1324.2 +057300 SUB-SCRIPT-15. NC1324.2 +057400 MOVE "1234" TO TABLE-C. NC1324.2 +057500 DIVIDE ENTRY-B-2 (1) INTO ENTRY-C (1). NC1324.2 +057600 DIVIDE ENTRY-B-2 (2) INTO ENTRY-C (2). NC1324.2 +057700 DIVIDE ENTRY-B-2 (3) INTO ENTRY-C (3). NC1324.2 +057800 DIVIDE ENTRY-B-2 (4) INTO ENTRY-C (4). NC1324.2 +057900 IF TABLE-C NOT EQUAL TO "1111" NC1324.2 +058000 GO TO SUB-SCRIPT-15B. NC1324.2 +058100 PERFORM PASS. NC1324.2 +058200 GO TO SUB-SCRIPT-15C. NC1324.2 +058300 SUB-SCRIPT-15A. NC1324.2 +058400 PERFORM DE-LETE. NC1324.2 +058500 GO TO SUB-SCRIPT-15C. NC1324.2 +058600 SUB-SCRIPT-15B. NC1324.2 +058700 PERFORM FAIL. NC1324.2 +058800 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +058900 MOVE "1111" TO CORRECT-A. NC1324.2 +059000 SUB-SCRIPT-15C. NC1324.2 +059100 MOVE "SUB-SCRIPT-15" TO PAR-NAME. NC1324.2 +059200 PERFORM PRINT-DETAIL. NC1324.2 +059300* THIS TEST CHECKS THE USE OF SUBSCRIPTED DATA-NAMES NC1324.2 +059400* IN A DIVIDE STATEMENT. NC1324.2 +059500 MOVE TABLE-A-VALUES TO TABLE-A. NC1324.2 +059600 SUB-SCRIPT-16. NC1324.2 +059700 IF ENTRY-A-1 (SUB-3) EQUAL TO "222" NC1324.2 +059800 PERFORM PASS NC1324.2 +059900 GO TO SUB-SCRIPT-16B. NC1324.2 +060000 MOVE "222" TO CORRECT-A. NC1324.2 +060100 MOVE ENTRY-A-1 (SUB-3) TO COMPUTED-A. NC1324.2 +060200 PERFORM FAIL. NC1324.2 +060300 GO TO SUB-SCRIPT-16B. NC1324.2 +060400 SUB-SCRIPT-16A. NC1324.2 +060500 PERFORM DE-LETE. NC1324.2 +060600 SUB-SCRIPT-16B. NC1324.2 +060700 MOVE "SUB-SCRIPT-16" TO PAR-NAME. NC1324.2 +060800* NOTE COMPUTATIONAL SUBSCRIPT USED S9(18). NC1324.2 +060900 PERFORM PRINT-DETAIL. NC1324.2 +061000 SUB-SCRIPT-17. NC1324.2 +061100 IF ENTRY-A-2 (SUB-4) EQUAL TO "44" NC1324.2 +061200 PERFORM PASS NC1324.2 +061300 GO TO SUB-SCRIPT-17B. NC1324.2 +061400 MOVE "44" TO CORRECT-A. NC1324.2 +061500 MOVE ENTRY-A-2 (SUB-4) TO COMPUTED-A. NC1324.2 +061600 PERFORM FAIL. NC1324.2 +061700 GO TO SUB-SCRIPT-17B. NC1324.2 +061800 SUB-SCRIPT-17A. NC1324.2 +061900 PERFORM DE-LETE. NC1324.2 +062000 SUB-SCRIPT-17B. NC1324.2 +062100 MOVE "SUB-SCRIPT-17" TO PAR-NAME. NC1324.2 +062200* NOTE COMPUTATIONAL SUBSCRIPT USED 9(18). NC1324.2 +062300 PERFORM PRINT-DETAIL. NC1324.2 +062400 SUB-SCRIPT-18. NC1324.2 +062500 IF ENTRY-A-2 (+4) EQUAL TO "44" NC1324.2 +062600 PERFORM PASS NC1324.2 +062700 GO TO SUB-SCRIPT-18B. NC1324.2 +062800 MOVE "44" TO CORRECT-A. NC1324.2 +062900 MOVE ENTRY-A-2 (+4) TO COMPUTED-A. NC1324.2 +063000 PERFORM FAIL. NC1324.2 +063100 GO TO SUB-SCRIPT-18B. NC1324.2 +063200 SUB-SCRIPT-18A. NC1324.2 +063300 PERFORM DE-LETE. NC1324.2 +063400 SUB-SCRIPT-18B. NC1324.2 +063500 MOVE "SUB-SCRIPT-18" TO PAR-NAME. NC1324.2 +063600* NOTE SIGNED NUMERIC LITERAL SUBSCRIPT. NC1324.2 +063700 PERFORM PRINT-DETAIL. NC1324.2 +063800 SUB-SCRIPT-19. NC1324.2 +063900 IF ENTRY-A-3 (CON-2) NOT EQUAL TO "2" NC1324.2 +064000 GO TO SUB-SCRIPT-19B. NC1324.2 +064100 PERFORM PASS. NC1324.2 +064200 GO TO SUB-SCRIPT-19C. NC1324.2 +064300 SUB-SCRIPT-19A. NC1324.2 +064400 PERFORM DE-LETE. NC1324.2 +064500 GO TO SUB-SCRIPT-19C. NC1324.2 +064600 SUB-SCRIPT-19B. NC1324.2 +064700 PERFORM FAIL. NC1324.2 +064800 MOVE ENTRY-A-3 (CON-2) TO COMPUTED-A. NC1324.2 +064900 MOVE "2" TO CORRECT-A. NC1324.2 +065000 SUB-SCRIPT-19C. NC1324.2 +065100 MOVE "SUB-SCRIPT-19" TO PAR-NAME. NC1324.2 +065200 PERFORM PRINT-DETAIL. NC1324.2 +065300* NOTE ***** THIS CHECKS THE USE OF AN ELEMENTARY ITEM NC1324.2 +065400* WHEN THE GROUP ITEM HAS THE OCCURS. NC1324.2 +065500 SUB-SCRIPT-20. NC1324.2 +065600 IF ENTRY-A-2 (CON-4) NOT EQUAL TO "44" NC1324.2 +065700 GO TO SUB-SCRIPT-20B. NC1324.2 +065800 PERFORM PASS. NC1324.2 +065900 GO TO SUB-SCRIPT-20C. NC1324.2 +066000 SUB-SCRIPT-20A. NC1324.2 +066100 PERFORM DE-LETE. NC1324.2 +066200 GO TO SUB-SCRIPT-20C. NC1324.2 +066300 SUB-SCRIPT-20B. NC1324.2 +066400 PERFORM FAIL. NC1324.2 +066500 MOVE ENTRY-A-2 (CON-4) TO COMPUTED-A. NC1324.2 +066600 MOVE "44" TO CORRECT-A. NC1324.2 +066700 SUB-SCRIPT-20C. NC1324.2 +066800 MOVE "SUB-SCRIPT-20" TO PAR-NAME. NC1324.2 +066900 PERFORM PRINT-DETAIL. NC1324.2 +067000* NOTE ******* THIS CHECKS A GROUP ITEM WHEN IT NC1324.2 +067100* HAS THE OCCURS. NC1324.2 +067200 SUB-SCRIPT-21. NC1324.2 +067300 IF ENTRY-B-2 (CON-1) NOT EQUAL TO "1" NC1324.2 +067400 GO TO SUB-SCRIPT-21B. NC1324.2 +067500 PERFORM PASS. NC1324.2 +067600 GO TO SUB-SCRIPT-21C. NC1324.2 +067700 SUB-SCRIPT-21A. NC1324.2 +067800 PERFORM DE-LETE. NC1324.2 +067900 GO TO SUB-SCRIPT-21C. NC1324.2 +068000 SUB-SCRIPT-21B. NC1324.2 +068100 PERFORM FAIL. NC1324.2 +068200 MOVE ENTRY-B-2 (CON-1) TO COMPUTED-A. NC1324.2 +068300 MOVE "1" TO CORRECT-A. NC1324.2 +068400 SUB-SCRIPT-21C. NC1324.2 +068500 MOVE "SUB-SCRIPT-21" TO PAR-NAME. NC1324.2 +068600 PERFORM PRINT-DETAIL. NC1324.2 +068700* USE OF ITEM WHICH IS DEFINED WITH BOTH THE REDEFINES NC1324.2 +068800* AND THE OCCURS CLAUSE. NC1324.2 +068900 SUB-SCRIPT-22. NC1324.2 +069000 MOVE ENTRY-B-2 (CON-1) TO ENTRY-C (CON-4). NC1324.2 +069100 MOVE ENTRY-B-2 (CON-2) TO ENTRY-C (CON-3). NC1324.2 +069200 MOVE ENTRY-B-2 (CON-3) TO ENTRY-C (CON-2). NC1324.2 +069300 MOVE ENTRY-B-2 (CON-4) TO ENTRY-C (CON-1). NC1324.2 +069400 IF TABLE-C NOT EQUAL TO "4321" NC1324.2 +069500 GO TO SUB-SCRIPT-22B. NC1324.2 +069600 PERFORM PASS. NC1324.2 +069700 GO TO SUB-SCRIPT-22C. NC1324.2 +069800 SUB-SCRIPT-22A. NC1324.2 +069900 PERFORM DE-LETE. NC1324.2 +070000 GO TO SUB-SCRIPT-22C. NC1324.2 +070100 SUB-SCRIPT-22B. NC1324.2 +070200 PERFORM FAIL. NC1324.2 +070300 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +070400 MOVE "4321" TO CORRECT-A. NC1324.2 +070500 SUB-SCRIPT-22C. NC1324.2 +070600 MOVE "SUB-SCRIPT-22" TO PAR-NAME. NC1324.2 +070700 PERFORM PRINT-DETAIL. NC1324.2 +070800 SUB-SCRIPT-23. NC1324.2 +070900 MOVE "0000" TO TABLE-C. NC1324.2 +071000 ADD ENTRY-B-2 (CON-1) TO ENTRY-C (CON-1). NC1324.2 +071100 ADD ENTRY-B-2 (CON-2) TO ENTRY-C (CON-2). NC1324.2 +071200 ADD ENTRY-B-2 (CON-3) TO ENTRY-C (CON-3). NC1324.2 +071300 ADD ENTRY-B-2 (CON-4) TO ENTRY-C (CON-4). NC1324.2 +071400 IF TABLE-C NOT EQUAL TO "1234" NC1324.2 +071500 GO TO SUB-SCRIPT-23B. NC1324.2 +071600 PERFORM PASS. NC1324.2 +071700 GO TO SUB-SCRIPT-23C. NC1324.2 +071800 SUB-SCRIPT-23A. NC1324.2 +071900 PERFORM DE-LETE. NC1324.2 +072000 GO TO SUB-SCRIPT-23C. NC1324.2 +072100 SUB-SCRIPT-23B. NC1324.2 +072200 PERFORM FAIL. NC1324.2 +072300 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +072400 MOVE "1234" TO CORRECT-A. NC1324.2 +072500 SUB-SCRIPT-23C. NC1324.2 +072600 MOVE "SUB-SCRIPT-23" TO PAR-NAME. NC1324.2 +072700 PERFORM PRINT-DETAIL. NC1324.2 +072800* ADD STATEMENTS WITH UNSIGNED NUMERIC ITEMS AS SUBSCRIPTS. NC1324.2 +072900 SUB-SCRIPT-24. NC1324.2 +073000 MOVE "1234" TO TABLE-C. NC1324.2 +073100 SUBTRACT ENTRY-B-2 (CON-1) FROM ENTRY-C (CON-1). NC1324.2 +073200 SUBTRACT ENTRY-B-2 (CON-2) FROM ENTRY-C (CON-2). NC1324.2 +073300 SUBTRACT ENTRY-B-2 (CON-3) FROM ENTRY-C (CON-3). NC1324.2 +073400 SUBTRACT ENTRY-B-2 (CON-4) FROM ENTRY-C (CON-4). NC1324.2 +073500 IF TABLE-C NOT EQUAL TO "0000" NC1324.2 +073600 GO TO SUB-SCRIPT-24B. NC1324.2 +073700 PERFORM PASS. NC1324.2 +073800 GO TO SUB-SCRIPT-24C. NC1324.2 +073900 SUB-SCRIPT-24A. NC1324.2 +074000 PERFORM DE-LETE. NC1324.2 +074100 GO TO SUB-SCRIPT-24C. NC1324.2 +074200 SUB-SCRIPT-24B. NC1324.2 +074300 PERFORM FAIL. NC1324.2 +074400 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +074500 MOVE "0000" TO CORRECT-A. NC1324.2 +074600 SUB-SCRIPT-24C. NC1324.2 +074700 MOVE "SUB-SCRIPT-24" TO PAR-NAME. NC1324.2 +074800 PERFORM PRINT-DETAIL. NC1324.2 +074900* SUBSTRACT STATEMENTS WITH UNSIGNED NUMERIC ITEMS AS SUBSCRIPTNC1324.2 +075000 SUB-SCRIPT-25. NC1324.2 +075100 MOVE "1111" TO TABLE-C. NC1324.2 +075200 MULTIPLY ENTRY-B-2 (CON-1) BY ENTRY-C (CON-1). NC1324.2 +075300 MULTIPLY ENTRY-B-2 (CON-2) BY ENTRY-C (CON-2). NC1324.2 +075400 MULTIPLY ENTRY-B-2 (CON-3) BY ENTRY-C (CON-3). NC1324.2 +075500 MULTIPLY ENTRY-B-2 (CON-4) BY ENTRY-C (CON-4). NC1324.2 +075600 IF TABLE-C NOT EQUAL TO "1234" NC1324.2 +075700 GO TO SUB-SCRIPT-25B. NC1324.2 +075800 PERFORM PASS. NC1324.2 +075900 GO TO SUB-SCRIPT-25C. NC1324.2 +076000 SUB-SCRIPT-25A. NC1324.2 +076100 PERFORM DE-LETE. NC1324.2 +076200 GO TO SUB-SCRIPT-25C. NC1324.2 +076300 SUB-SCRIPT-25B. NC1324.2 +076400 PERFORM FAIL. NC1324.2 +076500 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +076600 MOVE "1234" TO CORRECT-A. NC1324.2 +076700 SUB-SCRIPT-25C. NC1324.2 +076800 MOVE "SUB-SCRIPT-25" TO PAR-NAME. NC1324.2 +076900 PERFORM PRINT-DETAIL. NC1324.2 +077000* MULTIPLY STATEMENTS WITH UNSIGNED NUMERIC ITEMS AS SUBSCRIPTSNC1324.2 +077100 SUB-SCRIPT-26. NC1324.2 +077200 MOVE "1234" TO TABLE-C. NC1324.2 +077300 DIVIDE ENTRY-B-2 (CON-1) INTO ENTRY-C (CON-1). NC1324.2 +077400 DIVIDE ENTRY-B-2 (CON-2) INTO ENTRY-C (CON-2). NC1324.2 +077500 DIVIDE ENTRY-B-2 (CON-3) INTO ENTRY-C (CON-3). NC1324.2 +077600 DIVIDE ENTRY-B-2 (CON-4) INTO ENTRY-C (CON-4). NC1324.2 +077700 IF TABLE-C NOT EQUAL TO "1111" NC1324.2 +077800 GO TO SUB-SCRIPT-26B. NC1324.2 +077900 PERFORM PASS. NC1324.2 +078000 GO TO SUB-SCRIPT-26C. NC1324.2 +078100 SUB-SCRIPT-26A. NC1324.2 +078200 PERFORM DE-LETE. NC1324.2 +078300 GO TO SUB-SCRIPT-26C. NC1324.2 +078400 SUB-SCRIPT-26B. NC1324.2 +078500 PERFORM FAIL. NC1324.2 +078600 MOVE TABLE-C TO COMPUTED-A. NC1324.2 +078700 MOVE "1111" TO CORRECT-A. NC1324.2 +078800 SUB-SCRIPT-26C. NC1324.2 +078900 MOVE "SUB-SCRIPT-26" TO PAR-NAME. NC1324.2 +079000 PERFORM PRINT-DETAIL. NC1324.2 +079100* DIVIDE STATEMENTS WITH UNSIGNED NUMERIC ITEMS AS SUBSCRIPTS. NC1324.2 +079200 CCVS-EXIT SECTION. NC1324.2 +079300 CCVS-999999. NC1324.2 +079400 GO TO CLOSE-FILES. NC1324.2 diff --git a/tests/cobol85/NC/NC133A.CBL b/tests/cobol85/NC/NC133A.CBL new file mode 100755 index 00000000..798133d5 --- /dev/null +++ b/tests/cobol85/NC/NC133A.CBL @@ -0,0 +1,713 @@ +000100 IDENTIFICATION DIVISION. NC1334.2 +000200 PROGRAM-ID. NC1334.2 +000300 NC133A. NC1334.2 +000400**************************************************************** NC1334.2 +000500* * NC1334.2 +000600* VALIDATION FOR:- * NC1334.2 +000700* * NC1334.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1334.2 +000900* * NC1334.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1334.2 +001100* * NC1334.2 +001200**************************************************************** NC1334.2 +001300* * NC1334.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1334.2 +001500* * NC1334.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1334.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1334.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1334.2 +001900* * NC1334.2 +002000**************************************************************** NC1334.2 +002100* NC1334.2 +002200* PROGRAM NC133A TESTS THE USE OF FORMAT 1 OF THE SET NC1334.2 +002300* STATEMENT USING VARIOUS INTEGERS, INDEX-NAMES AND NC1334.2 +002400* IDENTIFIERS. NC1334.2 +002500* REDEFINED SINGLE LEVEL TABLES ARE USED. NC1334.2 +002600* NC1334.2 +002700 ENVIRONMENT DIVISION. NC1334.2 +002800 CONFIGURATION SECTION. NC1334.2 +002900 SOURCE-COMPUTER. NC1334.2 +003000 Linux. NC1334.2 +003100 OBJECT-COMPUTER. NC1334.2 +003200 Linux. NC1334.2 +003300 INPUT-OUTPUT SECTION. NC1334.2 +003400 FILE-CONTROL. NC1334.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1334.2 +003600 "report.log". NC1334.2 +003700 DATA DIVISION. NC1334.2 +003800 FILE SECTION. NC1334.2 +003900 FD PRINT-FILE. NC1334.2 +004000 01 PRINT-REC PICTURE X(120). NC1334.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1334.2 +004200 WORKING-STORAGE SECTION. NC1334.2 +004300 77 SGN-IDX PIC S9(18) VALUE ZERO. NC1334.2 +004400 77 UNSGN-IDX PIC 9(18) VALUE ZERO. NC1334.2 +004500 77 USE-IDX USAGE INDEX. NC1334.2 +004600 77 COMP-U-IDX18 PICTURE 9(18) COMPUTATIONAL VALUE ZERO. NC1334.2 +004700 77 COMP-S-IDX18 PICTURE S9(18) COMPUTATIONAL VALUE ZERO. NC1334.2 +004800 77 COMP-U-IDX1 PICTURE 9 COMPUTATIONAL VALUE ZERO. NC1334.2 +004900 77 COMP-S-IDX1 PICTURE S9 COMPUTATIONAL VALUE ZERO. NC1334.2 +005000 01 INDEX-VALUE PIC 9999. NC1334.2 +005100 01 TABLE-A-VALUES PIC X(20) VALUE "11122233344415263748". NC1334.2 +005200 01 TABLE-A. NC1334.2 +005300 02 ENTRY-A-1 PICTURE XXX OCCURS 4 TIMES INDEXED IDX-1. NC1334.2 +005400 02 ENTRY-A-2 OCCURS 4 TIMES INDEXED BY IDX-2. NC1334.2 +005500 03 ENTRY-A-3 PIC X. NC1334.2 +005600 03 ENTRY-A-4 PIC X. NC1334.2 +005700 01 TABLE-A1 REDEFINES TABLE-A. NC1334.2 +005800 02 ENTRY-A-5 PICTURE XXX OCCURS 4 TIMES. NC1334.2 +005900 02 ENTRY-A-6 OCCURS 4 TIMES INDEXED BY IDX-X2. NC1334.2 +006000 03 ENTRY-A-7 PIC X. NC1334.2 +006100 03 ENTRY-A-8 PIC X. NC1334.2 +006200 01 TABLE-B. NC1334.2 +006300 02 ENTRY-B-1 PIC X(4) VALUE "1234". NC1334.2 +006400 02 ENTRY-B-2 REDEFINES ENTRY-B-1 PIC 9 OCCURS 4 INDEXED NC1334.2 +006500 BY IDX-3. NC1334.2 +006600 01 TEST-RESULTS. NC1334.2 +006700 02 FILLER PIC X VALUE SPACE. NC1334.2 +006800 02 FEATURE PIC X(20) VALUE SPACE. NC1334.2 +006900 02 FILLER PIC X VALUE SPACE. NC1334.2 +007000 02 P-OR-F PIC X(5) VALUE SPACE. NC1334.2 +007100 02 FILLER PIC X VALUE SPACE. NC1334.2 +007200 02 PAR-NAME. NC1334.2 +007300 03 FILLER PIC X(19) VALUE SPACE. NC1334.2 +007400 03 PARDOT-X PIC X VALUE SPACE. NC1334.2 +007500 03 DOTVALUE PIC 99 VALUE ZERO. NC1334.2 +007600 02 FILLER PIC X(8) VALUE SPACE. NC1334.2 +007700 02 RE-MARK PIC X(61). NC1334.2 +007800 01 TEST-COMPUTED. NC1334.2 +007900 02 FILLER PIC X(30) VALUE SPACE. NC1334.2 +008000 02 FILLER PIC X(17) VALUE NC1334.2 +008100 " COMPUTED=". NC1334.2 +008200 02 COMPUTED-X. NC1334.2 +008300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1334.2 +008400 03 COMPUTED-N REDEFINES COMPUTED-A NC1334.2 +008500 PIC -9(9).9(9). NC1334.2 +008600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1334.2 +008700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1334.2 +008800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1334.2 +008900 03 CM-18V0 REDEFINES COMPUTED-A. NC1334.2 +009000 04 COMPUTED-18V0 PIC -9(18). NC1334.2 +009100 04 FILLER PIC X. NC1334.2 +009200 03 FILLER PIC X(50) VALUE SPACE. NC1334.2 +009300 01 TEST-CORRECT. NC1334.2 +009400 02 FILLER PIC X(30) VALUE SPACE. NC1334.2 +009500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1334.2 +009600 02 CORRECT-X. NC1334.2 +009700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1334.2 +009800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1334.2 +009900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1334.2 +010000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1334.2 +010100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1334.2 +010200 03 CR-18V0 REDEFINES CORRECT-A. NC1334.2 +010300 04 CORRECT-18V0 PIC -9(18). NC1334.2 +010400 04 FILLER PIC X. NC1334.2 +010500 03 FILLER PIC X(2) VALUE SPACE. NC1334.2 +010600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1334.2 +010700 01 CCVS-C-1. NC1334.2 +010800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1334.2 +010900- "SS PARAGRAPH-NAME NC1334.2 +011000- " REMARKS". NC1334.2 +011100 02 FILLER PIC X(20) VALUE SPACE. NC1334.2 +011200 01 CCVS-C-2. NC1334.2 +011300 02 FILLER PIC X VALUE SPACE. NC1334.2 +011400 02 FILLER PIC X(6) VALUE "TESTED". NC1334.2 +011500 02 FILLER PIC X(15) VALUE SPACE. NC1334.2 +011600 02 FILLER PIC X(4) VALUE "FAIL". NC1334.2 +011700 02 FILLER PIC X(94) VALUE SPACE. NC1334.2 +011800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1334.2 +011900 01 REC-CT PIC 99 VALUE ZERO. NC1334.2 +012000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1334.2 +012100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1334.2 +012200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1334.2 +012300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1334.2 +012400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1334.2 +012500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1334.2 +012600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1334.2 +012700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1334.2 +012800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1334.2 +012900 01 CCVS-H-1. NC1334.2 +013000 02 FILLER PIC X(39) VALUE SPACES. NC1334.2 +013100 02 FILLER PIC X(42) VALUE NC1334.2 +013200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1334.2 +013300 02 FILLER PIC X(39) VALUE SPACES. NC1334.2 +013400 01 CCVS-H-2A. NC1334.2 +013500 02 FILLER PIC X(40) VALUE SPACE. NC1334.2 +013600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1334.2 +013700 02 FILLER PIC XXXX VALUE NC1334.2 +013800 "4.2 ". NC1334.2 +013900 02 FILLER PIC X(28) VALUE NC1334.2 +014000 " COPY - NOT FOR DISTRIBUTION". NC1334.2 +014100 02 FILLER PIC X(41) VALUE SPACE. NC1334.2 +014200 NC1334.2 +014300 01 CCVS-H-2B. NC1334.2 +014400 02 FILLER PIC X(15) VALUE NC1334.2 +014500 "TEST RESULT OF ". NC1334.2 +014600 02 TEST-ID PIC X(9). NC1334.2 +014700 02 FILLER PIC X(4) VALUE NC1334.2 +014800 " IN ". NC1334.2 +014900 02 FILLER PIC X(12) VALUE NC1334.2 +015000 " HIGH ". NC1334.2 +015100 02 FILLER PIC X(22) VALUE NC1334.2 +015200 " LEVEL VALIDATION FOR ". NC1334.2 +015300 02 FILLER PIC X(58) VALUE NC1334.2 +015400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1334.2 +015500 01 CCVS-H-3. NC1334.2 +015600 02 FILLER PIC X(34) VALUE NC1334.2 +015700 " FOR OFFICIAL USE ONLY ". NC1334.2 +015800 02 FILLER PIC X(58) VALUE NC1334.2 +015900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1334.2 +016000 02 FILLER PIC X(28) VALUE NC1334.2 +016100 " COPYRIGHT 1985 ". NC1334.2 +016200 01 CCVS-E-1. NC1334.2 +016300 02 FILLER PIC X(52) VALUE SPACE. NC1334.2 +016400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1334.2 +016500 02 ID-AGAIN PIC X(9). NC1334.2 +016600 02 FILLER PIC X(45) VALUE SPACES. NC1334.2 +016700 01 CCVS-E-2. NC1334.2 +016800 02 FILLER PIC X(31) VALUE SPACE. NC1334.2 +016900 02 FILLER PIC X(21) VALUE SPACE. NC1334.2 +017000 02 CCVS-E-2-2. NC1334.2 +017100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1334.2 +017200 03 FILLER PIC X VALUE SPACE. NC1334.2 +017300 03 ENDER-DESC PIC X(44) VALUE NC1334.2 +017400 "ERRORS ENCOUNTERED". NC1334.2 +017500 01 CCVS-E-3. NC1334.2 +017600 02 FILLER PIC X(22) VALUE NC1334.2 +017700 " FOR OFFICIAL USE ONLY". NC1334.2 +017800 02 FILLER PIC X(12) VALUE SPACE. NC1334.2 +017900 02 FILLER PIC X(58) VALUE NC1334.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1334.2 +018100 02 FILLER PIC X(13) VALUE SPACE. NC1334.2 +018200 02 FILLER PIC X(15) VALUE NC1334.2 +018300 " COPYRIGHT 1985". NC1334.2 +018400 01 CCVS-E-4. NC1334.2 +018500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1334.2 +018600 02 FILLER PIC X(4) VALUE " OF ". NC1334.2 +018700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1334.2 +018800 02 FILLER PIC X(40) VALUE NC1334.2 +018900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1334.2 +019000 01 XXINFO. NC1334.2 +019100 02 FILLER PIC X(19) VALUE NC1334.2 +019200 "*** INFORMATION ***". NC1334.2 +019300 02 INFO-TEXT. NC1334.2 +019400 04 FILLER PIC X(8) VALUE SPACE. NC1334.2 +019500 04 XXCOMPUTED PIC X(20). NC1334.2 +019600 04 FILLER PIC X(5) VALUE SPACE. NC1334.2 +019700 04 XXCORRECT PIC X(20). NC1334.2 +019800 02 INF-ANSI-REFERENCE PIC X(48). NC1334.2 +019900 01 HYPHEN-LINE. NC1334.2 +020000 02 FILLER PIC IS X VALUE IS SPACE. NC1334.2 +020100 02 FILLER PIC IS X(65) VALUE IS "************************NC1334.2 +020200- "*****************************************". NC1334.2 +020300 02 FILLER PIC IS X(54) VALUE IS "************************NC1334.2 +020400- "******************************". NC1334.2 +020500 01 CCVS-PGM-ID PIC X(9) VALUE NC1334.2 +020600 "NC133A". NC1334.2 +020700 PROCEDURE DIVISION. NC1334.2 +020800 CCVS1 SECTION. NC1334.2 +020900 OPEN-FILES. NC1334.2 +021000 OPEN OUTPUT PRINT-FILE. NC1334.2 +021100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1334.2 +021200 MOVE SPACE TO TEST-RESULTS. NC1334.2 +021300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1334.2 +021400 GO TO CCVS1-EXIT. NC1334.2 +021500 CLOSE-FILES. NC1334.2 +021600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1334.2 +021700 TERMINATE-CCVS. NC1334.2 +021800*S EXIT PROGRAM. NC1334.2 +021900*SERMINATE-CALL. NC1334.2 +022000 STOP RUN. NC1334.2 +022100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1334.2 +022200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1334.2 +022300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1334.2 +022400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1334.2 +022500 MOVE "****TEST DELETED****" TO RE-MARK. NC1334.2 +022600 PRINT-DETAIL. NC1334.2 +022700 IF REC-CT NOT EQUAL TO ZERO NC1334.2 +022800 MOVE "." TO PARDOT-X NC1334.2 +022900 MOVE REC-CT TO DOTVALUE. NC1334.2 +023000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1334.2 +023100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1334.2 +023200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1334.2 +023300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1334.2 +023400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1334.2 +023500 MOVE SPACE TO CORRECT-X. NC1334.2 +023600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1334.2 +023700 MOVE SPACE TO RE-MARK. NC1334.2 +023800 HEAD-ROUTINE. NC1334.2 +023900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +024000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +024100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1334.2 +024200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1334.2 +024300 COLUMN-NAMES-ROUTINE. NC1334.2 +024400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +024500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +024700 END-ROUTINE. NC1334.2 +024800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1334.2 +024900 END-RTN-EXIT. NC1334.2 +025000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +025100 END-ROUTINE-1. NC1334.2 +025200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1334.2 +025300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1334.2 +025400 ADD PASS-COUNTER TO ERROR-HOLD. NC1334.2 +025500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1334.2 +025600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1334.2 +025700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1334.2 +025800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1334.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1334.2 +026000 END-ROUTINE-12. NC1334.2 +026100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1334.2 +026200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1334.2 +026300 MOVE "NO " TO ERROR-TOTAL NC1334.2 +026400 ELSE NC1334.2 +026500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1334.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1334.2 +026700 PERFORM WRITE-LINE. NC1334.2 +026800 END-ROUTINE-13. NC1334.2 +026900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1334.2 +027000 MOVE "NO " TO ERROR-TOTAL ELSE NC1334.2 +027100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1334.2 +027200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1334.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +027400 IF INSPECT-COUNTER EQUAL TO ZERO NC1334.2 +027500 MOVE "NO " TO ERROR-TOTAL NC1334.2 +027600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1334.2 +027700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1334.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +027900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1334.2 +028000 WRITE-LINE. NC1334.2 +028100 ADD 1 TO RECORD-COUNT. NC1334.2 +028200 IF RECORD-COUNT GREATER 42 NC1334.2 +028300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1334.2 +028400 MOVE SPACE TO DUMMY-RECORD NC1334.2 +028500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1334.2 +028600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1334.2 +028700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1334.2 +028800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1334.2 +028900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1334.2 +029000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1334.2 +029100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1334.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1334.2 +029300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1334.2 +029400 MOVE ZERO TO RECORD-COUNT. NC1334.2 +029500 PERFORM WRT-LN. NC1334.2 +029600 WRT-LN. NC1334.2 +029700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1334.2 +029800 MOVE SPACE TO DUMMY-RECORD. NC1334.2 +029900 BLANK-LINE-PRINT. NC1334.2 +030000 PERFORM WRT-LN. NC1334.2 +030100 FAIL-ROUTINE. NC1334.2 +030200 IF COMPUTED-X NOT EQUAL TO SPACE NC1334.2 +030300 GO TO FAIL-ROUTINE-WRITE. NC1334.2 +030400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1334.2 +030500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1334.2 +030600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1334.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1334.2 +030900 GO TO FAIL-ROUTINE-EX. NC1334.2 +031000 FAIL-ROUTINE-WRITE. NC1334.2 +031100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1334.2 +031200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1334.2 +031300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1334.2 +031400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1334.2 +031500 FAIL-ROUTINE-EX. EXIT. NC1334.2 +031600 BAIL-OUT. NC1334.2 +031700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1334.2 +031800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1334.2 +031900 BAIL-OUT-WRITE. NC1334.2 +032000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1334.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1334.2 +032200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1334.2 +032300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1334.2 +032400 BAIL-OUT-EX. EXIT. NC1334.2 +032500 CCVS1-EXIT. NC1334.2 +032600 EXIT. NC1334.2 +032700 SECT-TH133A-001 SECTION. NC1334.2 +032800 TH-04-001. NC1334.2 +032900 IDX-INIT-A. NC1334.2 +033000 MOVE "INDEXING " TO FEATURE. NC1334.2 +033100 MOVE TABLE-A-VALUES TO TABLE-A. NC1334.2 +033200 IF TABLE-A EQUAL TO TABLE-A-VALUES NC1334.2 +033300 PERFORM PASS NC1334.2 +033400 MOVE "TABLE CREATED CORRECTLY" TO RE-MARK NC1334.2 +033500 GO TO INIT-WRITE. NC1334.2 +033600 MOVE "TABLE CREATED INCORRECTLY" TO RE-MARK. NC1334.2 +033700 PERFORM FAIL. NC1334.2 +033800 PERFORM INIT-WRITE. NC1334.2 +033900 GO TO CCVS-EXIT. NC1334.2 +034000 INIT-WRITE. NC1334.2 +034100 MOVE "TABLE BUILD" TO PAR-NAME. NC1334.2 +034200 PERFORM PRINT-DETAIL. NC1334.2 +034300 IDX-TEST-1. NC1334.2 +034400 SET IDX-1 TO 3. NC1334.2 +034500 IF ENTRY-A-1 (IDX-1) EQUAL TO "333" NC1334.2 +034600 PERFORM PASS NC1334.2 +034700 GO TO IDX-WRITE-1. NC1334.2 +034800 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +034900 MOVE "333" TO CORRECT-A. NC1334.2 +035000 PERFORM FAIL. NC1334.2 +035100 GO TO IDX-WRITE-1. NC1334.2 +035200 IDX-DELETE-1. NC1334.2 +035300 PERFORM DE-LETE. NC1334.2 +035400 IDX-WRITE-1. NC1334.2 +035500 MOVE "IDX-TEST-1 " TO PAR-NAME. NC1334.2 +035600 PERFORM PRINT-DETAIL. NC1334.2 +035700 IDX-TEST-2. NC1334.2 +035800 SET IDX-1 TO 2. NC1334.2 +035900 IF ENTRY-A-1 (IDX-1) EQUAL TO "222" NC1334.2 +036000 PERFORM PASS NC1334.2 +036100 GO TO IDX-WRITE-2. NC1334.2 +036200 MOVE 222 TO CORRECT-A. NC1334.2 +036300 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +036400 PERFORM FAIL. NC1334.2 +036500 GO TO IDX-WRITE-2. NC1334.2 +036600 IDX-DELETE-2. NC1334.2 +036700 PERFORM DE-LETE. NC1334.2 +036800 IDX-WRITE-2. NC1334.2 +036900 MOVE "IDX-TEST-2" TO PAR-NAME. NC1334.2 +037000 PERFORM PRINT-DETAIL. NC1334.2 +037100 IDX-TEST-3. NC1334.2 +037200 SET IDX-1 TO 000001. NC1334.2 +037300 IF ENTRY-A-1 (IDX-1) EQUAL TO "111" NC1334.2 +037400 PERFORM PASS NC1334.2 +037500 GO TO IDX-WRITE-3. NC1334.2 +037600 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +037700 MOVE 111 TO CORRECT-A. NC1334.2 +037800 PERFORM FAIL. NC1334.2 +037900 GO TO IDX-WRITE-3. NC1334.2 +038000 IDX-DELETE-3. NC1334.2 +038100 PERFORM DE-LETE. NC1334.2 +038200 IDX-WRITE-3. NC1334.2 +038300 MOVE "IDX-TEST-3" TO PAR-NAME. NC1334.2 +038400 PERFORM PRINT-DETAIL. NC1334.2 +038500 IDX-TEST-4. NC1334.2 +038600 SET IDX-1 TO 000000000000000004. NC1334.2 +038700 IF ENTRY-A-1 (IDX-1) EQUAL TO "444" NC1334.2 +038800 PERFORM PASS NC1334.2 +038900 GO TO IDX-WRITE-4. NC1334.2 +039000 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +039100 MOVE 444 TO CORRECT-A. NC1334.2 +039200 PERFORM FAIL. NC1334.2 +039300 GO TO IDX-WRITE-4. NC1334.2 +039400 IDX-DELETE-4. NC1334.2 +039500 PERFORM DE-LETE. NC1334.2 +039600 IDX-WRITE-4. NC1334.2 +039700 MOVE "IDX-TEST-4" TO PAR-NAME. NC1334.2 +039800 PERFORM PRINT-DETAIL. NC1334.2 +039900 IDX-TEST-5. NC1334.2 +040000 MOVE 3 TO SGN-IDX. NC1334.2 +040100 SET IDX-2 TO SGN-IDX. NC1334.2 +040200 IF ENTRY-A-4 (IDX-2) EQUAL TO "7" NC1334.2 +040300 PERFORM PASS NC1334.2 +040400 GO TO IDX-WRITE-5. NC1334.2 +040500 MOVE ENTRY-A-4 (IDX-2) TO COMPUTED-A. NC1334.2 +040600 MOVE 7 TO CORRECT-A. NC1334.2 +040700 PERFORM FAIL. NC1334.2 +040800 GO TO IDX-WRITE-5. NC1334.2 +040900 IDX-DELETE-5. NC1334.2 +041000 PERFORM DE-LETE. NC1334.2 +041100 IDX-WRITE-5. NC1334.2 +041200 MOVE "IDX-TEST-5" TO PAR-NAME. NC1334.2 +041300 PERFORM PRINT-DETAIL. NC1334.2 +041400 MOVE "SET STATEMENT" TO FEATURE. NC1334.2 +041500 IDX-TEST-6. NC1334.2 +041600 MOVE 1 TO UNSGN-IDX. NC1334.2 +041700 SET IDX-2 TO UNSGN-IDX. NC1334.2 +041800 IF ENTRY-A-2 (IDX-2) EQUAL TO "15" NC1334.2 +041900 PERFORM PASS NC1334.2 +042000 GO TO IDX-WRITE-6. NC1334.2 +042100 MOVE ENTRY-A-2 (IDX-2) TO COMPUTED-A. NC1334.2 +042200 MOVE 15 TO CORRECT-A. NC1334.2 +042300 PERFORM FAIL. NC1334.2 +042400 GO TO IDX-WRITE-6. NC1334.2 +042500 IDX-DELETE-6. NC1334.2 +042600 PERFORM DE-LETE. NC1334.2 +042700 IDX-WRITE-6. NC1334.2 +042800 MOVE "IDX-TEST-6" TO PAR-NAME. NC1334.2 +042900 PERFORM PRINT-DETAIL. NC1334.2 +043000 IDX-TEST-7. NC1334.2 +043100 SET IDX-1 TO 4. NC1334.2 +043200 SET IDX-2 TO IDX-1. NC1334.2 +043300 IF IDX-2 EQUAL TO 4 NC1334.2 +043400 PERFORM PASS NC1334.2 +043500 GO TO IDX-WRITE-7. NC1334.2 +043600 MOVE 4 TO CORRECT-A. NC1334.2 +043700 SET INDEX-VALUE TO IDX-2. NC1334.2 +043800 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1334.2 +043900 PERFORM FAIL. NC1334.2 +044000 GO TO IDX-WRITE-7. NC1334.2 +044100 IDX-DELETE-7. NC1334.2 +044200 PERFORM DE-LETE. NC1334.2 +044300 IDX-WRITE-7. NC1334.2 +044400 MOVE "IDX-TEST-7" TO PAR-NAME. NC1334.2 +044500 PERFORM PRINT-DETAIL. NC1334.2 +044600 IDX-TEST-8. NC1334.2 +044700 SET IDX-1 TO 4. NC1334.2 +044800 SET IDX-2 TO IDX-1. NC1334.2 +044900 IF ENTRY-A-4 (IDX-2) EQUAL TO "8" NC1334.2 +045000 PERFORM PASS NC1334.2 +045100 GO TO IDX-WRITE-8. NC1334.2 +045200 MOVE 8 TO CORRECT-A. NC1334.2 +045300 MOVE ENTRY-A-4 (IDX-2) TO COMPUTED-A. NC1334.2 +045400 PERFORM FAIL. NC1334.2 +045500 GO TO IDX-WRITE-8. NC1334.2 +045600 IDX-DELETE-8. NC1334.2 +045700 PERFORM DE-LETE. NC1334.2 +045800 IDX-WRITE-8. NC1334.2 +045900 MOVE "IDX-TEST-8" TO PAR-NAME. NC1334.2 +046000 PERFORM PRINT-DETAIL. NC1334.2 +046100 IDX-TEST-9. NC1334.2 +046200 SET IDX-X2 TO 02. NC1334.2 +046300 SET USE-IDX TO IDX-X2. NC1334.2 +046400 SET IDX-2 TO USE-IDX. NC1334.2 +046500 IF IDX-2 EQUAL TO 2 NC1334.2 +046600 PERFORM PASS NC1334.2 +046700 GO TO IDX-WRITE-9. NC1334.2 +046800 MOVE 2 TO CORRECT-A. NC1334.2 +046900 SET INDEX-VALUE TO IDX-2. NC1334.2 +047000 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1334.2 +047100 PERFORM FAIL. NC1334.2 +047200 GO TO IDX-WRITE-9. NC1334.2 +047300 IDX-DELETE-9. NC1334.2 +047400 PERFORM DE-LETE. NC1334.2 +047500 IDX-WRITE-9. NC1334.2 +047600 MOVE "IDX-TEST-9" TO PAR-NAME. NC1334.2 +047700 PERFORM PRINT-DETAIL. NC1334.2 +047800 IDX-TEST-10. NC1334.2 +047900 SET IDX-2 TO 4. NC1334.2 +048000 SET USE-IDX TO IDX-2. NC1334.2 +048100 SET IDX-X2 TO USE-IDX. NC1334.2 +048200 IF ENTRY-A-8 (IDX-X2) EQUAL TO ENTRY-A-4 (IDX-2) NC1334.2 +048300 PERFORM PASS NC1334.2 +048400 GO TO IDX-WRITE-10. NC1334.2 +048500 MOVE ENTRY-A-4 (IDX-2) TO COMPUTED-A. NC1334.2 +048600 MOVE ENTRY-A-8 (IDX-X2) TO CORRECT-A. NC1334.2 +048700 MOVE "TABLE ENTRIES SHOULD BE EQUAL" TO RE-MARK. NC1334.2 +048800 PERFORM FAIL. NC1334.2 +048900 GO TO IDX-WRITE-10. NC1334.2 +049000 IDX-DELETE-10. NC1334.2 +049100 PERFORM DE-LETE. NC1334.2 +049200 IDX-WRITE-10. NC1334.2 +049300 MOVE "IDX-TEST-10" TO PAR-NAME. NC1334.2 +049400 PERFORM PRINT-DETAIL. NC1334.2 +049500 IDX-TEST-11. NC1334.2 +049600 SET IDX-3 TO 0004. NC1334.2 +049700 IF ENTRY-B-2 (IDX-3) EQUAL TO 4 NC1334.2 +049800 PERFORM PASS NC1334.2 +049900 GO TO IDX-WRITE-11. NC1334.2 +050000 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +050100 MOVE 4 TO CORRECT-A. NC1334.2 +050200 PERFORM FAIL. NC1334.2 +050300 GO TO IDX-WRITE-11. NC1334.2 +050400 IDX-DELETE-11. NC1334.2 +050500 PERFORM DE-LETE. NC1334.2 +050600 IDX-WRITE-11. NC1334.2 +050700 MOVE "IDX-TEST-11" TO PAR-NAME. NC1334.2 +050800 PERFORM PRINT-DETAIL. NC1334.2 +050900 IDX-TEST-12. NC1334.2 +051000 SET IDX-3 TO 0000002. NC1334.2 +051100 IF ENTRY-B-2 (IDX-3) EQUAL TO 2 NC1334.2 +051200 PERFORM PASS NC1334.2 +051300 GO TO IDX-WRITE-12. NC1334.2 +051400 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +051500 MOVE 2 TO CORRECT-A. NC1334.2 +051600 PERFORM FAIL. NC1334.2 +051700 GO TO IDX-WRITE-12. NC1334.2 +051800 IDX-DELETE-12. NC1334.2 +051900 PERFORM DE-LETE. NC1334.2 +052000 IDX-WRITE-12. NC1334.2 +052100 MOVE "IDX-TEST-12" TO PAR-NAME. NC1334.2 +052200 PERFORM PRINT-DETAIL. NC1334.2 +052300 IDX-TEST-13. NC1334.2 +052400 SET IDX-3 TO 000000000000000003. NC1334.2 +052500 IF ENTRY-B-2 (IDX-3) EQUAL TO 3 NC1334.2 +052600 PERFORM PASS NC1334.2 +052700 GO TO IDX-WRITE-13. NC1334.2 +052800 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +052900 MOVE 3 TO CORRECT-A. NC1334.2 +053000 PERFORM FAIL. NC1334.2 +053100 GO TO IDX-WRITE-13. NC1334.2 +053200 IDX-DELETE-13. NC1334.2 +053300 PERFORM DE-LETE. NC1334.2 +053400 IDX-WRITE-13. NC1334.2 +053500 MOVE "IDX-TEST-13" TO PAR-NAME. NC1334.2 +053600 PERFORM PRINT-DETAIL. NC1334.2 +053700 IDX-TEST-14. NC1334.2 +053800 SET IDX-3 TO 000000000000000004. NC1334.2 +053900 IF ENTRY-B-2 (IDX-3) EQUAL TO 4 NC1334.2 +054000 PERFORM PASS NC1334.2 +054100 GO TO IDX-WRITE-14. NC1334.2 +054200 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +054300 MOVE 4 TO CORRECT-A. NC1334.2 +054400 PERFORM FAIL. NC1334.2 +054500 GO TO IDX-WRITE-14. NC1334.2 +054600 IDX-DELETE-14. NC1334.2 +054700 PERFORM DE-LETE. NC1334.2 +054800 IDX-WRITE-14. NC1334.2 +054900 MOVE "IDX-TEST-14" TO PAR-NAME. NC1334.2 +055000 PERFORM PRINT-DETAIL. NC1334.2 +055100 IDX-TEST-15. NC1334.2 +055200 SET IDX-3 TO 000000000000000002. NC1334.2 +055300 IF ENTRY-B-2 (IDX-3) EQUAL TO 2 NC1334.2 +055400 PERFORM PASS NC1334.2 +055500 GO TO IDX-WRITE-15. NC1334.2 +055600 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +055700 MOVE 2 TO CORRECT-A. NC1334.2 +055800 PERFORM FAIL. NC1334.2 +055900 GO TO IDX-WRITE-15. NC1334.2 +056000 IDX-DELETE-15. NC1334.2 +056100 PERFORM DE-LETE. NC1334.2 +056200 IDX-WRITE-15. NC1334.2 +056300 MOVE "IDX-TEST-15" TO PAR-NAME. NC1334.2 +056400 PERFORM PRINT-DETAIL. NC1334.2 +056500 IDX-TEST-16. NC1334.2 +056600 SET IDX-3 TO 03. NC1334.2 +056700 SET IDX-2 TO 03. NC1334.2 +056800 IF ENTRY-A-3 (IDX-2) EQUAL TO ENTRY-B-2 (IDX-3) NC1334.2 +056900 PERFORM PASS NC1334.2 +057000 GO TO IDX-WRITE-16. NC1334.2 +057100 MOVE ENTRY-A-3 (IDX-2) TO COMPUTED-A. NC1334.2 +057200 MOVE ENTRY-B-2 (IDX-3) TO CORRECT-A. NC1334.2 +057300 MOVE "TABLE ENTRIES SHOULD BE EQUAL" TO RE-MARK. NC1334.2 +057400 PERFORM FAIL. NC1334.2 +057500 GO TO IDX-WRITE-16. NC1334.2 +057600 IDX-DELETE-16. NC1334.2 +057700 PERFORM DE-LETE. NC1334.2 +057800 IDX-WRITE-16. NC1334.2 +057900 MOVE "IDX-TEST-16" TO PAR-NAME. NC1334.2 +058000 PERFORM PRINT-DETAIL. NC1334.2 +058100 IDX-TEST-17. NC1334.2 +058200 MOVE 3 TO COMP-U-IDX18. NC1334.2 +058300 SET IDX-1 TO COMP-U-IDX18. NC1334.2 +058400 IF ENTRY-A-1 (IDX-1) EQUAL TO "333" NC1334.2 +058500 PERFORM PASS NC1334.2 +058600 GO TO IDX-WRITE-17. NC1334.2 +058700 MOVE "333" TO CORRECT-A. NC1334.2 +058800 MOVE ENTRY-A-1 (IDX-1) TO COMPUTED-A. NC1334.2 +058900 PERFORM FAIL. NC1334.2 +059000 GO TO IDX-WRITE-17. NC1334.2 +059100 IDX-DELETE-17. NC1334.2 +059200 PERFORM DE-LETE. NC1334.2 +059300 IDX-WRITE-17. NC1334.2 +059400 MOVE "IDX-TEST-17" TO PAR-NAME. NC1334.2 +059500 PERFORM PRINT-DETAIL. NC1334.2 +059600 IDX-TEST-18. NC1334.2 +059700 MOVE 4 TO COMP-S-IDX18. NC1334.2 +059800 SET IDX-2 TO COMP-S-IDX18. NC1334.2 +059900 IF ENTRY-A-2 (IDX-2) EQUAL TO "48" NC1334.2 +060000 PERFORM PASS NC1334.2 +060100 GO TO IDX-WRITE-18. NC1334.2 +060200 MOVE "48" TO CORRECT-A. NC1334.2 +060300 MOVE ENTRY-A-2 (IDX-2) TO COMPUTED-A. NC1334.2 +060400 PERFORM FAIL. NC1334.2 +060500 GO TO IDX-WRITE-18. NC1334.2 +060600 IDX-DELETE-18. NC1334.2 +060700 PERFORM DE-LETE. NC1334.2 +060800 IDX-WRITE-18. NC1334.2 +060900 MOVE "IDX-TEST-18" TO PAR-NAME. NC1334.2 +061000 PERFORM PRINT-DETAIL. NC1334.2 +061100 IDX-TEST-19. NC1334.2 +061200 MOVE 1 TO COMP-U-IDX1. NC1334.2 +061300 SET IDX-3 TO COMP-U-IDX1. NC1334.2 +061400 IF ENTRY-B-2 (IDX-3) EQUAL TO 1 NC1334.2 +061500 PERFORM PASS NC1334.2 +061600 GO TO IDX-WRITE-19. NC1334.2 +061700 MOVE "1" TO CORRECT-A. NC1334.2 +061800 MOVE ENTRY-B-2 (IDX-3) TO COMPUTED-A. NC1334.2 +061900 PERFORM FAIL. NC1334.2 +062000 GO TO IDX-WRITE-19. NC1334.2 +062100 IDX-DELETE-19. NC1334.2 +062200 PERFORM DE-LETE. NC1334.2 +062300 IDX-WRITE-19. NC1334.2 +062400 MOVE "IDX-TEST-19" TO PAR-NAME. NC1334.2 +062500 PERFORM PRINT-DETAIL. NC1334.2 +062600 IDX-TEST-20. NC1334.2 +062700 MOVE 2 TO COMP-S-IDX1. NC1334.2 +062800 SET IDX-2 TO COMP-S-IDX1. NC1334.2 +062900 IF ENTRY-A-3 (IDX-2) EQUAL TO "2" NC1334.2 +063000 PERFORM PASS NC1334.2 +063100 GO TO IDX-WRITE-20. NC1334.2 +063200 MOVE "2" TO CORRECT-A. NC1334.2 +063300 MOVE ENTRY-A-3 (IDX-2) TO COMPUTED-A. NC1334.2 +063400 PERFORM FAIL. NC1334.2 +063500 GO TO IDX-WRITE-20. NC1334.2 +063600 IDX-DELETE-20. NC1334.2 +063700 PERFORM DE-LETE. NC1334.2 +063800 IDX-WRITE-20. NC1334.2 +063900 MOVE "IDX-TEST-20" TO PAR-NAME. NC1334.2 +064000 PERFORM PRINT-DETAIL. NC1334.2 +064100 IDX-TEST-21. NC1334.2 +064200 SET IDX-1 TO 3. NC1334.2 +064300 SET COMP-S-IDX18 TO IDX-1. NC1334.2 +064400 IF COMP-S-IDX18 EQUAL TO +3 NC1334.2 +064500 PERFORM PASS NC1334.2 +064600 GO TO IDX-WRITE-21. NC1334.2 +064700 MOVE +3 TO CORRECT-N. NC1334.2 +064800 MOVE COMP-S-IDX18 TO COMPUTED-N. NC1334.2 +064900 PERFORM FAIL. NC1334.2 +065000 GO TO IDX-WRITE-21. NC1334.2 +065100 IDX-DELETE-21. NC1334.2 +065200 PERFORM DE-LETE. NC1334.2 +065300 IDX-WRITE-21. NC1334.2 +065400 MOVE "IDX-TEST-21" TO PAR-NAME. NC1334.2 +065500 PERFORM PRINT-DETAIL. NC1334.2 +065600 IDX-TEST-22. NC1334.2 +065700 SET IDX-2 TO 2. NC1334.2 +065800 SET COMP-U-IDX1 TO IDX-2. NC1334.2 +065900 IF COMP-U-IDX1 EQUAL TO 2 NC1334.2 +066000 PERFORM PASS NC1334.2 +066100 GO TO IDX-WRITE-22. NC1334.2 +066200 MOVE COMP-U-IDX1 TO COMPUTED-N. NC1334.2 +066300 MOVE 2 TO CORRECT-N. NC1334.2 +066400 PERFORM FAIL. NC1334.2 +066500 GO TO IDX-WRITE-22. NC1334.2 +066600 IDX-DELETE-22. NC1334.2 +066700 PERFORM DE-LETE. NC1334.2 +066800 IDX-WRITE-22. NC1334.2 +066900 MOVE "IDX-TEST-22" TO PAR-NAME. NC1334.2 +067000 PERFORM PRINT-DETAIL. NC1334.2 +067100 IDX-TEST-23. NC1334.2 +067200 MOVE 4 TO COMP-S-IDX18. NC1334.2 +067300 SET IDX-2 TO COMP-S-IDX18. NC1334.2 +067400 IF COMP-S-IDX18 EQUAL TO IDX-2 NC1334.2 +067500 PERFORM PASS NC1334.2 +067600 GO TO IDX-WRITE-23. NC1334.2 +067700 SET INDEX-VALUE TO IDX-2. NC1334.2 +067800 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1334.2 +067900 MOVE COMP-S-IDX18 TO CORRECT-18V0. NC1334.2 +068000 MOVE "INDEX VALUES SHOULD BE EQUAL" TO RE-MARK. NC1334.2 +068100 PERFORM FAIL. NC1334.2 +068200 GO TO IDX-WRITE-23. NC1334.2 +068300 IDX-DELETE-23. NC1334.2 +068400 PERFORM DE-LETE. NC1334.2 +068500 IDX-WRITE-23. NC1334.2 +068600 MOVE "IDX-TEST-23" TO PAR-NAME. NC1334.2 +068700 PERFORM PRINT-DETAIL. NC1334.2 +068800 IDX-TEST-24. NC1334.2 +068900 MOVE 2 TO COMP-U-IDX1. NC1334.2 +069000 SET IDX-3 TO COMP-U-IDX1. NC1334.2 +069100 IF IDX-3 EQUAL TO COMP-U-IDX1 NC1334.2 +069200 PERFORM PASS NC1334.2 +069300 GO TO IDX-WRITE-24. NC1334.2 +069400 MOVE COMP-U-IDX1 TO CORRECT-18V0. NC1334.2 +069500 SET INDEX-VALUE TO IDX-3. NC1334.2 +069600 MOVE INDEX-VALUE TO COMPUTED-18V0. NC1334.2 +069700 MOVE "INDEX VALUES SHOULD BE EQUAL" TO RE-MARK. NC1334.2 +069800 PERFORM FAIL. NC1334.2 +069900 GO TO IDX-WRITE-24. NC1334.2 +070000 IDX-DELETE-24. NC1334.2 +070100 PERFORM DE-LETE. NC1334.2 +070200 IDX-WRITE-24. NC1334.2 +070300 MOVE "IDX-TEST-24" TO PAR-NAME. NC1334.2 +070400 PERFORM PRINT-DETAIL. NC1334.2 +070500*IDX-TEST-25. NC1334.2 +070600* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1334.2 +070700* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1334.2 +070800*IDX-TEST-26. NC1334.2 +070900* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1334.2 +071000* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1334.2 +071100 CCVS-EXIT SECTION. NC1334.2 +071200 CCVS-999999. NC1334.2 +071300 GO TO CLOSE-FILES. NC1334.2 diff --git a/tests/cobol85/NC/NC134A.CBL b/tests/cobol85/NC/NC134A.CBL new file mode 100755 index 00000000..419f68b7 --- /dev/null +++ b/tests/cobol85/NC/NC134A.CBL @@ -0,0 +1,713 @@ +000100 IDENTIFICATION DIVISION. NC1344.2 +000200 PROGRAM-ID. NC1344.2 +000300 NC134A. NC1344.2 +000400**************************************************************** NC1344.2 +000500* * NC1344.2 +000600* VALIDATION FOR:- * NC1344.2 +000700* * NC1344.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1344.2 +000900* * NC1344.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1344.2 +001100* * NC1344.2 +001200**************************************************************** NC1344.2 +001300* * NC1344.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1344.2 +001500* * NC1344.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1344.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1344.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1344.2 +001900* * NC1344.2 +002000**************************************************************** NC1344.2 +002100* NC1344.2 +002200* PROGRAM NC134A TESTS THE ACCESSING OF A THREE-DIMENSIONAL NC1344.2 +002300* TABLE USING NUMERIC LITERALS AND DATA-NAMES AS SUBSCRIPTS. NC1344.2 +002400* RELATIVE SUBSCRIPTING IS ALSO USED. NC1344.2 +002500* NC1344.2 +002600 ENVIRONMENT DIVISION. NC1344.2 +002700 CONFIGURATION SECTION. NC1344.2 +002800 SOURCE-COMPUTER. NC1344.2 +002900 Linux. NC1344.2 +003000 OBJECT-COMPUTER. NC1344.2 +003100 Linux. NC1344.2 +003200 INPUT-OUTPUT SECTION. NC1344.2 +003300 FILE-CONTROL. NC1344.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1344.2 +003500 "report.log". NC1344.2 +003600 DATA DIVISION. NC1344.2 +003700 FILE SECTION. NC1344.2 +003800 FD PRINT-FILE. NC1344.2 +003900 01 PRINT-REC PICTURE X(120). NC1344.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1344.2 +004100 WORKING-STORAGE SECTION. NC1344.2 +004200 77 A-NAME-30-CHARACTERS-IN-LENGTH PICTURE IS XXX VALUE IS "END".NC1344.2 +004300 77 LONG-PICTURE PICTURE IS XXXXXXXXXXXXXXXXXXXXXXXXXXXXX. NC1344.2 +004400 77 ONE PICTURE IS 9 VALUE IS 1 USAGE IS COMPUTATIONAL. NC1344.2 +004500 77 TWO PICTURE IS 9 VALUE IS 2 USAGE IS COMPUTATIONAL. NC1344.2 +004600 77 THREE PICTURE IS 9 VALUE IS 3 COMPUTATIONAL. NC1344.2 +004700 77 FOUR PICTURE IS 9 VALUE IS 4 COMPUTATIONAL. NC1344.2 +004800 77 FIVE PICTURE IS 9 VALUE IS 5 COMPUTATIONAL. NC1344.2 +004900 77 SIX PICTURE IS 9 VALUE IS 6 COMPUTATIONAL. NC1344.2 +005000 77 SEVEN PICTURE IS 9 VALUE IS 7 COMPUTATIONAL. NC1344.2 +005100 77 EIGHT PICTURE IS 9 VALUE 8 COMPUTATIONAL. NC1344.2 +005200 77 NINE PICTURE IS 9 VALUE 9 USAGE IS COMPUTATIONAL. NC1344.2 +005300 77 TEN PICTURE 99 VALUE 10 USAGE COMPUTATIONAL. NC1344.2 +005400 77 FIFTEEN PICTURE 99 VALUE 15 USAGE COMPUTATIONAL. NC1344.2 +005500 77 TWENTY PICTURE 99 VALUE 20 USAGE IS COMPUTATIONAL. NC1344.2 +005600 77 TWENTY-5 PICTURE 99 VALUE 25. NC1344.2 +005700 77 D-1 PICTURE IS S9V99 VALUE IS 1.06. NC1344.2 +005800 77 D-2 PICTURE IS S9V99 VALUE IS -1.06. NC1344.2 +005900 77 D-3 PICTURE IS 9(18) VALUE IS 979797979797979798. NC1344.2 +006000 77 D-4 PICTURE IS S99V99 VALUE IS +10.1. NC1344.2 +006100 77 D-5 PICTURE IS S999 VALUE IS -1. NC1344.2 +006200 77 D-6 PICTURE IS S999P VALUE IS 10. NC1344.2 +006300 77 D-7 PICTURE IS S99V99 VALUE IS 1.09. NC1344.2 +006400 77 D-8 PICTURE IS S999V9 VALUE 175. NC1344.2 +006500 77 D-9 PICTURE IS 9(4)V9(4) VALUE IS 111.1189. NC1344.2 +006600 77 D-10 PICTURE 999 VALUE 100. NC1344.2 +006700 77 D-11 PICTURE 999 VALUE 300. NC1344.2 +006800 77 D-12 PICTURE 999 VALUE 900. NC1344.2 +006900 77 W-1 PICTURE IS 9. NC1344.2 +007000 77 W-2 PICTURE IS 99. NC1344.2 +007100 77 W-3 PICTURE IS 999. NC1344.2 +007200 77 W-4 PICTURE IS 9 VALUE IS ZERO. NC1344.2 +007300 77 W-5 PICTURE IS 99 VALUE IS ZERO. NC1344.2 +007400 77 W-6 PICTURE IS 999 VALUE IS ZERO. NC1344.2 +007500 77 W-7 PICTURE IS 9. NC1344.2 +007600 77 W-8 PICTURE 99 BLANK ZERO. NC1344.2 +007700 77 W-9 PICTURE 999. NC1344.2 +007800 77 W-10 PICTURE 99V9. NC1344.2 +007900 77 W-11 PICTURE S99V9. NC1344.2 +008000 77 W-12 PICTURE S9V99. NC1344.2 +008100 77 W-13 PICTURE S9(2)V9(2). NC1344.2 +008200 77 W-14 PICTURE IS S99V99. NC1344.2 +008300 77 XRAY PICTURE IS 9. NC1344.2 +008400 77 CTR-1 PICTURE IS 999. NC1344.2 +008500 77 SUBSCRIPT-1 PICTURE IS 999. NC1344.2 +008600 77 SUBSCRIPT-2 PICTURE IS 999. NC1344.2 +008700 77 SUBSCRIPT-3 PICTURE IS 999. NC1344.2 +008800 01 TABLE-10. NC1344.2 +008900 02 STATE-1 OCCURS 10 TIMES. NC1344.2 +009000 03 YEAR-1 OCCURS 10 TIMES. NC1344.2 +009100 04 ANIMAL PICTURE IS 999 OCCURS 03 TIMES. NC1344.2 +009200 01 NUMBER-LIST. NC1344.2 +009300 02 FILLER PICTURE IS X VALUE IS SPACE. NC1344.2 +009400 02 LINE-1 OCCURS 20 TIMES. NC1344.2 +009500 03 BLANKSPACE PICTURE IS XX. NC1344.2 +009600 03 PRINT-ELE PICTURE IS 999. NC1344.2 +009700 01 TABLE-1. NC1344.2 +009800 02 TAB-ELE PICTURE IS 999 OCCURS 100 TIMES. NC1344.2 +009900 01 TEST-RESULTS. NC1344.2 +010000 02 FILLER PIC X VALUE SPACE. NC1344.2 +010100 02 FEATURE PIC X(20) VALUE SPACE. NC1344.2 +010200 02 FILLER PIC X VALUE SPACE. NC1344.2 +010300 02 P-OR-F PIC X(5) VALUE SPACE. NC1344.2 +010400 02 FILLER PIC X VALUE SPACE. NC1344.2 +010500 02 PAR-NAME. NC1344.2 +010600 03 FILLER PIC X(19) VALUE SPACE. NC1344.2 +010700 03 PARDOT-X PIC X VALUE SPACE. NC1344.2 +010800 03 DOTVALUE PIC 99 VALUE ZERO. NC1344.2 +010900 02 FILLER PIC X(8) VALUE SPACE. NC1344.2 +011000 02 RE-MARK PIC X(61). NC1344.2 +011100 01 TEST-COMPUTED. NC1344.2 +011200 02 FILLER PIC X(30) VALUE SPACE. NC1344.2 +011300 02 FILLER PIC X(17) VALUE NC1344.2 +011400 " COMPUTED=". NC1344.2 +011500 02 COMPUTED-X. NC1344.2 +011600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1344.2 +011700 03 COMPUTED-N REDEFINES COMPUTED-A NC1344.2 +011800 PIC -9(9).9(9). NC1344.2 +011900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1344.2 +012000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1344.2 +012100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1344.2 +012200 03 CM-18V0 REDEFINES COMPUTED-A. NC1344.2 +012300 04 COMPUTED-18V0 PIC -9(18). NC1344.2 +012400 04 FILLER PIC X. NC1344.2 +012500 03 FILLER PIC X(50) VALUE SPACE. NC1344.2 +012600 01 TEST-CORRECT. NC1344.2 +012700 02 FILLER PIC X(30) VALUE SPACE. NC1344.2 +012800 02 FILLER PIC X(17) VALUE " CORRECT =". NC1344.2 +012900 02 CORRECT-X. NC1344.2 +013000 03 CORRECT-A PIC X(20) VALUE SPACE. NC1344.2 +013100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1344.2 +013200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1344.2 +013300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1344.2 +013400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1344.2 +013500 03 CR-18V0 REDEFINES CORRECT-A. NC1344.2 +013600 04 CORRECT-18V0 PIC -9(18). NC1344.2 +013700 04 FILLER PIC X. NC1344.2 +013800 03 FILLER PIC X(2) VALUE SPACE. NC1344.2 +013900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1344.2 +014000 01 CCVS-C-1. NC1344.2 +014100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1344.2 +014200- "SS PARAGRAPH-NAME NC1344.2 +014300- " REMARKS". NC1344.2 +014400 02 FILLER PIC X(20) VALUE SPACE. NC1344.2 +014500 01 CCVS-C-2. NC1344.2 +014600 02 FILLER PIC X VALUE SPACE. NC1344.2 +014700 02 FILLER PIC X(6) VALUE "TESTED". NC1344.2 +014800 02 FILLER PIC X(15) VALUE SPACE. NC1344.2 +014900 02 FILLER PIC X(4) VALUE "FAIL". NC1344.2 +015000 02 FILLER PIC X(94) VALUE SPACE. NC1344.2 +015100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1344.2 +015200 01 REC-CT PIC 99 VALUE ZERO. NC1344.2 +015300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1344.2 +015400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1344.2 +015500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1344.2 +015600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1344.2 +015700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1344.2 +015800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1344.2 +015900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1344.2 +016000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1344.2 +016100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1344.2 +016200 01 CCVS-H-1. NC1344.2 +016300 02 FILLER PIC X(39) VALUE SPACES. NC1344.2 +016400 02 FILLER PIC X(42) VALUE NC1344.2 +016500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1344.2 +016600 02 FILLER PIC X(39) VALUE SPACES. NC1344.2 +016700 01 CCVS-H-2A. NC1344.2 +016800 02 FILLER PIC X(40) VALUE SPACE. NC1344.2 +016900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1344.2 +017000 02 FILLER PIC XXXX VALUE NC1344.2 +017100 "4.2 ". NC1344.2 +017200 02 FILLER PIC X(28) VALUE NC1344.2 +017300 " COPY - NOT FOR DISTRIBUTION". NC1344.2 +017400 02 FILLER PIC X(41) VALUE SPACE. NC1344.2 +017500 NC1344.2 +017600 01 CCVS-H-2B. NC1344.2 +017700 02 FILLER PIC X(15) VALUE NC1344.2 +017800 "TEST RESULT OF ". NC1344.2 +017900 02 TEST-ID PIC X(9). NC1344.2 +018000 02 FILLER PIC X(4) VALUE NC1344.2 +018100 " IN ". NC1344.2 +018200 02 FILLER PIC X(12) VALUE NC1344.2 +018300 " HIGH ". NC1344.2 +018400 02 FILLER PIC X(22) VALUE NC1344.2 +018500 " LEVEL VALIDATION FOR ". NC1344.2 +018600 02 FILLER PIC X(58) VALUE NC1344.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1344.2 +018800 01 CCVS-H-3. NC1344.2 +018900 02 FILLER PIC X(34) VALUE NC1344.2 +019000 " FOR OFFICIAL USE ONLY ". NC1344.2 +019100 02 FILLER PIC X(58) VALUE NC1344.2 +019200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1344.2 +019300 02 FILLER PIC X(28) VALUE NC1344.2 +019400 " COPYRIGHT 1985 ". NC1344.2 +019500 01 CCVS-E-1. NC1344.2 +019600 02 FILLER PIC X(52) VALUE SPACE. NC1344.2 +019700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1344.2 +019800 02 ID-AGAIN PIC X(9). NC1344.2 +019900 02 FILLER PIC X(45) VALUE SPACES. NC1344.2 +020000 01 CCVS-E-2. NC1344.2 +020100 02 FILLER PIC X(31) VALUE SPACE. NC1344.2 +020200 02 FILLER PIC X(21) VALUE SPACE. NC1344.2 +020300 02 CCVS-E-2-2. NC1344.2 +020400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1344.2 +020500 03 FILLER PIC X VALUE SPACE. NC1344.2 +020600 03 ENDER-DESC PIC X(44) VALUE NC1344.2 +020700 "ERRORS ENCOUNTERED". NC1344.2 +020800 01 CCVS-E-3. NC1344.2 +020900 02 FILLER PIC X(22) VALUE NC1344.2 +021000 " FOR OFFICIAL USE ONLY". NC1344.2 +021100 02 FILLER PIC X(12) VALUE SPACE. NC1344.2 +021200 02 FILLER PIC X(58) VALUE NC1344.2 +021300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1344.2 +021400 02 FILLER PIC X(13) VALUE SPACE. NC1344.2 +021500 02 FILLER PIC X(15) VALUE NC1344.2 +021600 " COPYRIGHT 1985". NC1344.2 +021700 01 CCVS-E-4. NC1344.2 +021800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1344.2 +021900 02 FILLER PIC X(4) VALUE " OF ". NC1344.2 +022000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1344.2 +022100 02 FILLER PIC X(40) VALUE NC1344.2 +022200 " TESTS WERE EXECUTED SUCCESSFULLY". NC1344.2 +022300 01 XXINFO. NC1344.2 +022400 02 FILLER PIC X(19) VALUE NC1344.2 +022500 "*** INFORMATION ***". NC1344.2 +022600 02 INFO-TEXT. NC1344.2 +022700 04 FILLER PIC X(8) VALUE SPACE. NC1344.2 +022800 04 XXCOMPUTED PIC X(20). NC1344.2 +022900 04 FILLER PIC X(5) VALUE SPACE. NC1344.2 +023000 04 XXCORRECT PIC X(20). NC1344.2 +023100 02 INF-ANSI-REFERENCE PIC X(48). NC1344.2 +023200 01 HYPHEN-LINE. NC1344.2 +023300 02 FILLER PIC IS X VALUE IS SPACE. NC1344.2 +023400 02 FILLER PIC IS X(65) VALUE IS "************************NC1344.2 +023500- "*****************************************". NC1344.2 +023600 02 FILLER PIC IS X(54) VALUE IS "************************NC1344.2 +023700- "******************************". NC1344.2 +023800 01 CCVS-PGM-ID PIC X(9) VALUE NC1344.2 +023900 "NC134A". NC1344.2 +024000 PROCEDURE DIVISION. NC1344.2 +024100 CCVS1 SECTION. NC1344.2 +024200 OPEN-FILES. NC1344.2 +024300 OPEN OUTPUT PRINT-FILE. NC1344.2 +024400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1344.2 +024500 MOVE SPACE TO TEST-RESULTS. NC1344.2 +024600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1344.2 +024700 GO TO CCVS1-EXIT. NC1344.2 +024800 CLOSE-FILES. NC1344.2 +024900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1344.2 +025000 TERMINATE-CCVS. NC1344.2 +025100*S EXIT PROGRAM. NC1344.2 +025200*SERMINATE-CALL. NC1344.2 +025300 STOP RUN. NC1344.2 +025400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1344.2 +025500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1344.2 +025600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1344.2 +025700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1344.2 +025800 MOVE "****TEST DELETED****" TO RE-MARK. NC1344.2 +025900 PRINT-DETAIL. NC1344.2 +026000 IF REC-CT NOT EQUAL TO ZERO NC1344.2 +026100 MOVE "." TO PARDOT-X NC1344.2 +026200 MOVE REC-CT TO DOTVALUE. NC1344.2 +026300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1344.2 +026400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1344.2 +026500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1344.2 +026600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1344.2 +026700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1344.2 +026800 MOVE SPACE TO CORRECT-X. NC1344.2 +026900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1344.2 +027000 MOVE SPACE TO RE-MARK. NC1344.2 +027100 HEAD-ROUTINE. NC1344.2 +027200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +027300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +027400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1344.2 +027500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1344.2 +027600 COLUMN-NAMES-ROUTINE. NC1344.2 +027700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +027800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +028000 END-ROUTINE. NC1344.2 +028100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1344.2 +028200 END-RTN-EXIT. NC1344.2 +028300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +028400 END-ROUTINE-1. NC1344.2 +028500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1344.2 +028600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1344.2 +028700 ADD PASS-COUNTER TO ERROR-HOLD. NC1344.2 +028800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1344.2 +028900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1344.2 +029000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1344.2 +029100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1344.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1344.2 +029300 END-ROUTINE-12. NC1344.2 +029400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1344.2 +029500 IF ERROR-COUNTER IS EQUAL TO ZERO NC1344.2 +029600 MOVE "NO " TO ERROR-TOTAL NC1344.2 +029700 ELSE NC1344.2 +029800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1344.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1344.2 +030000 PERFORM WRITE-LINE. NC1344.2 +030100 END-ROUTINE-13. NC1344.2 +030200 IF DELETE-COUNTER IS EQUAL TO ZERO NC1344.2 +030300 MOVE "NO " TO ERROR-TOTAL ELSE NC1344.2 +030400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1344.2 +030500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1344.2 +030600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +030700 IF INSPECT-COUNTER EQUAL TO ZERO NC1344.2 +030800 MOVE "NO " TO ERROR-TOTAL NC1344.2 +030900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1344.2 +031000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1344.2 +031100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +031200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1344.2 +031300 WRITE-LINE. NC1344.2 +031400 ADD 1 TO RECORD-COUNT. NC1344.2 +031500 IF RECORD-COUNT GREATER 42 NC1344.2 +031600 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1344.2 +031700 MOVE SPACE TO DUMMY-RECORD NC1344.2 +031800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1344.2 +031900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1344.2 +032000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1344.2 +032100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1344.2 +032200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1344.2 +032300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1344.2 +032400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1344.2 +032500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1344.2 +032600 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1344.2 +032700 MOVE ZERO TO RECORD-COUNT. NC1344.2 +032800 PERFORM WRT-LN. NC1344.2 +032900 WRT-LN. NC1344.2 +033000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1344.2 +033100 MOVE SPACE TO DUMMY-RECORD. NC1344.2 +033200 BLANK-LINE-PRINT. NC1344.2 +033300 PERFORM WRT-LN. NC1344.2 +033400 FAIL-ROUTINE. NC1344.2 +033500 IF COMPUTED-X NOT EQUAL TO SPACE NC1344.2 +033600 GO TO FAIL-ROUTINE-WRITE. NC1344.2 +033700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1344.2 +033800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1344.2 +033900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1344.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1344.2 +034200 GO TO FAIL-ROUTINE-EX. NC1344.2 +034300 FAIL-ROUTINE-WRITE. NC1344.2 +034400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1344.2 +034500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1344.2 +034600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1344.2 +034700 MOVE SPACES TO COR-ANSI-REFERENCE. NC1344.2 +034800 FAIL-ROUTINE-EX. EXIT. NC1344.2 +034900 BAIL-OUT. NC1344.2 +035000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1344.2 +035100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1344.2 +035200 BAIL-OUT-WRITE. NC1344.2 +035300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1344.2 +035400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1344.2 +035500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1344.2 +035600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1344.2 +035700 BAIL-OUT-EX. EXIT. NC1344.2 +035800 CCVS1-EXIT. NC1344.2 +035900 EXIT. NC1344.2 +036000 SECT-NC134A-001 SECTION. NC1344.2 +036100 NC-05-001. NC1344.2 +036200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1344.2 +036300 MOVE 1 TO SUBSCRIPT-1. NC1344.2 +036400 MOVE 1 TO W-3. NC1344.2 +036500 PERFORM BUILD-TABLE 100 TIMES. NC1344.2 +036600* NOTE TABLE IS CONSTRUCTED WITH VALUES FROM 1 TO 100. NC1344.2 +036700 MOVE "SUBSCRIPTING" TO FEATURE. NC1344.2 +036800 TEST-1. NC1344.2 +036900 IF TAB-ELE (50) EQUAL TO 50 PERFORM PASS ELSE GO TO TST-11. NC1344.2 +037000 GO TO TST-12. NC1344.2 +037100 TST-11. NC1344.2 +037200 PERFORM FAIL. NC1344.2 +037300 MOVE TAB-ELE (50) TO COMPUTED-A. NC1344.2 +037400 MOVE "50" TO CORRECT-A. NC1344.2 +037500 TST-12. NC1344.2 +037600 MOVE "TEST-1" TO PAR-NAME. NC1344.2 +037700 PERFORM PRINT-DETAIL. NC1344.2 +037800 TEST-2. NC1344.2 +037900 IF TAB-ELE (TWENTY-5) EQUAL TO 25 PERFORM PASS ELSE GO TO NC1344.2 +038000 TST-21. NC1344.2 +038100 GO TO TST-22. NC1344.2 +038200 TST-21. NC1344.2 +038300 PERFORM FAIL. NC1344.2 +038400 MOVE TAB-ELE (TWENTY-5) TO COMPUTED-A. NC1344.2 +038500 MOVE "25" TO CORRECT-A. NC1344.2 +038600 TST-22. NC1344.2 +038700 MOVE "TEST-2" TO PAR-NAME. NC1344.2 +038800 PERFORM PRINT-DETAIL. NC1344.2 +038900 TEST-3. NC1344.2 +039000 IF TAB-ELE (99) EQUAL TO 99 PERFORM PASS ELSE GO TO TST-31. NC1344.2 +039100 GO TO TST-32. NC1344.2 +039200 TST-31. NC1344.2 +039300 PERFORM FAIL. NC1344.2 +039400 MOVE TAB-ELE (99) TO COMPUTED-A. NC1344.2 +039500 MOVE "99" TO CORRECT-A. NC1344.2 +039600 TST-32. NC1344.2 +039700 MOVE "TEST-3" TO PAR-NAME. NC1344.2 +039800 PERFORM PRINT-DETAIL. NC1344.2 +039900 WRITE-TABLE-OUT. NC1344.2 +040000 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +040100 MOVE 1 TO CTR-1. NC1344.2 +040200 PERFORM TABLE-WRITE THRU END-OF 100 TIMES. NC1344.2 +040300 GO TO CONSTRUCTION. NC1344.2 +040400 BUILD-TABLE. NC1344.2 +040500 MOVE W-3 TO TAB-ELE (SUBSCRIPT-1). NC1344.2 +040600 ADD 1 TO SUBSCRIPT-1. NC1344.2 +040700 ADD 1 TO W-3. NC1344.2 +040800 TABLE-WRITE. NC1344.2 +040900 MOVE TAB-ELE (SUBSCRIPT-2) TO PRINT-ELE (CTR-1) NC1344.2 +041000 MOVE SPACE TO BLANKSPACE (CTR-1). NC1344.2 +041100 ADD 1 TO SUBSCRIPT-2. NC1344.2 +041200 ADD 1 TO CTR-1. NC1344.2 +041300 IF CTR-1 IS EQUAL TO 21 PERFORM TABLE-DUMP. NC1344.2 +041400 END-OF. NC1344.2 +041500 EXIT. NC1344.2 +041600 TABLE-DUMP. NC1344.2 +041700 MOVE SPACE TO PRINT-REC. NC1344.2 +041800 MOVE NUMBER-LIST TO PRINT-REC. NC1344.2 +041900 PERFORM WRITE-LINE. NC1344.2 +042000 MOVE 01 TO CTR-1. NC1344.2 +042100 CONSTRUCTION. NC1344.2 +042200 MOVE 1 TO SUBSCRIPT-1. NC1344.2 +042300 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +042400 MOVE 1 TO SUBSCRIPT-3. NC1344.2 +042500 MOVE 1 TO W-3. NC1344.2 +042600 PERFORM TABLE-BUILD-2 THROUGH FINE 300 TIMES. NC1344.2 +042700 TABTEST-1. NC1344.2 +042800 IF ANIMAL (1 1 1) EQUAL TO 1 PERFORM PASS ELSE GO TO NC1344.2 +042900 TTST-11. NC1344.2 +043000 GO TO TTST-12. NC1344.2 +043100 TTST-11. NC1344.2 +043200 PERFORM FAIL. NC1344.2 +043300 MOVE ANIMAL (1 1 1) TO COMPUTED-A. NC1344.2 +043400 MOVE "001" TO CORRECT-A. NC1344.2 +043500 TTST-12. NC1344.2 +043600 MOVE "TABTEST-1" TO PAR-NAME. NC1344.2 +043700 PERFORM PRINT-DETAIL. NC1344.2 +043800 TABTEST-2. NC1344.2 +043900 MOVE 1 TO W-1. NC1344.2 +044000 MOVE 1 TO W-2. NC1344.2 +044100 MOVE 1 TO W-3. NC1344.2 +044200 IF ANIMAL (W-1 W-2 W-3) EQUAL TO 1 PERFORM PASS ELSE GO NC1344.2 +044300 TO TTST-21. NC1344.2 +044400 GO TO TTST-22. NC1344.2 +044500 TTST-21. NC1344.2 +044600 PERFORM FAIL. NC1344.2 +044700 MOVE ANIMAL (W-1 W-2 W-3) TO COMPUTED-A. NC1344.2 +044800 MOVE "001" TO CORRECT-A. NC1344.2 +044900 TTST-22. NC1344.2 +045000 MOVE "TABTEST-2" TO PAR-NAME. NC1344.2 +045100 PERFORM PRINT-DETAIL. NC1344.2 +045200 TABTEST-3. NC1344.2 +045300 MOVE 3 TO W-3. NC1344.2 +045400 MOVE 3 TO W-2. NC1344.2 +045500 MOVE 1 TO W-1. NC1344.2 +045600 IF ANIMAL (W-1 W-2 W-3) EQUAL TO 9 PERFORM PASS ELSE GO NC1344.2 +045700 TO TTST-31. NC1344.2 +045800 GO TO TTST-32. NC1344.2 +045900 TTST-31. NC1344.2 +046000 PERFORM FAIL. NC1344.2 +046100 MOVE ANIMAL (W-1 W-2 W-3) TO COMPUTED-A. NC1344.2 +046200 MOVE "009" TO CORRECT-A. NC1344.2 +046300 TTST-32. NC1344.2 +046400 MOVE "TABTEST-3" TO PAR-NAME. NC1344.2 +046500 PERFORM PRINT-DETAIL. NC1344.2 +046600 TABTEST-4. NC1344.2 +046700 IF ANIMAL (10 10 1) EQUAL TO 298 PERFORM PASS ELSE GO TONC1344.2 +046800 TTST-41. NC1344.2 +046900 GO TO TTST-42. NC1344.2 +047000 TTST-41. NC1344.2 +047100 PERFORM FAIL. NC1344.2 +047200 MOVE ANIMAL (10 10 1) TO COMPUTED-A. NC1344.2 +047300 MOVE "298" TO CORRECT-A. NC1344.2 +047400 TTST-42. NC1344.2 +047500 MOVE "TABTEST-4" TO PAR-NAME. NC1344.2 +047600 PERFORM PRINT-DETAIL. NC1344.2 +047700 TABTEST-5. NC1344.2 +047800 MOVE 3 TO W-1. NC1344.2 +047900 MOVE 10 TO W-2. NC1344.2 +048000 MOVE 10 TO W-3. NC1344.2 +048100 IF ANIMAL (W-3 W-2 W-1) EQUAL TO 300 PERFORM PASS ELSE GO NC1344.2 +048200 TO TTST-51. NC1344.2 +048300 GO TO TTST-52. NC1344.2 +048400 TTST-51. NC1344.2 +048500 PERFORM FAIL. NC1344.2 +048600 MOVE ANIMAL (W-3 W-2 W-1) TO COMPUTED-A. NC1344.2 +048700 MOVE "300" TO CORRECT-A. NC1344.2 +048800 TTST-52. NC1344.2 +048900 MOVE "TABTEST-5" TO PAR-NAME. NC1344.2 +049000 PERFORM PRINT-DETAIL. NC1344.2 +049100 TABTEST-6. NC1344.2 +049200 IF YEAR-1 (1 1) EQUAL TO "001002003" PERFORM PASS ELSE GO NC1344.2 +049300 TO TTST-61. NC1344.2 +049400 GO TO TTST-62. NC1344.2 +049500 TTST-61. NC1344.2 +049600 PERFORM FAIL. NC1344.2 +049700 MOVE YEAR-1 (1 1) TO COMPUTED-A. NC1344.2 +049800 MOVE "001002003" TO CORRECT-A. NC1344.2 +049900 TTST-62. NC1344.2 +050000 MOVE "TABTEST-6" TO PAR-NAME. NC1344.2 +050100 PERFORM PRINT-DETAIL. NC1344.2 +050200 TABTEST-7. NC1344.2 +050300 IF YEAR-1 (10 10) EQUAL TO "298299300" PERFORM PASS ELSE GONC1344.2 +050400 TO TTST-71. NC1344.2 +050500 GO TO TTST-72. NC1344.2 +050600 TTST-71. NC1344.2 +050700 MOVE YEAR-1 (10 10) TO COMPUTED-A. NC1344.2 +050800 MOVE "298299300" TO CORRECT-A. NC1344.2 +050900 PERFORM FAIL. NC1344.2 +051000 TTST-72. NC1344.2 +051100 MOVE "TABTEST-7" TO PAR-NAME. NC1344.2 +051200 PERFORM PRINT-DETAIL. NC1344.2 +051300 TABTEST-8. NC1344.2 +051400 MOVE 02 TO W-1. NC1344.2 +051500 MOVE 07 TO W-2. NC1344.2 +051600 IF ANIMAL (W-1 W-2 1) EQUAL TO 49 PERFORM PASS ELSE GO TO NC1344.2 +051700 TTST-81. NC1344.2 +051800 GO TO TTST-82. NC1344.2 +051900 TTST-81. NC1344.2 +052000 PERFORM FAIL. NC1344.2 +052100 MOVE ANIMAL (W-1 W-2 1) TO COMPUTED-A. NC1344.2 +052200 MOVE "049" TO CORRECT-A. NC1344.2 +052300 TTST-82. NC1344.2 +052400 MOVE "TABTEST-8" TO PAR-NAME. NC1344.2 +052500 PERFORM PRINT-DETAIL. NC1344.2 +052600 TABTEST-9. NC1344.2 +052700 MOVE 08 TO W-1. NC1344.2 +052800 MOVE 03 TO W-3. NC1344.2 +052900 IF ANIMAL (W-1 1 W-3) EQUAL TO 213 PERFORM PASS ELSE GO TO NC1344.2 +053000 TTST-91. NC1344.2 +053100 GO TO TTST-92. NC1344.2 +053200 TTST-91. NC1344.2 +053300 PERFORM FAIL. NC1344.2 +053400 MOVE ANIMAL (W-1 1 W-3) TO COMPUTED-A. NC1344.2 +053500 MOVE "213" TO CORRECT-A. NC1344.2 +053600 TTST-92. NC1344.2 +053700 MOVE "TABTEST-9" TO PAR-NAME. NC1344.2 +053800 PERFORM PRINT-DETAIL. NC1344.2 +053900 TABTEST-10. NC1344.2 +054000 MOVE 5 TO W-1. NC1344.2 +054100 IF YEAR-1 (W-1 10) EQUAL TO "148149150" PERFORM PASS ELSE NC1344.2 +054200 GO TO TTST-101. NC1344.2 +054300 GO TO TTST-102. NC1344.2 +054400 TTST-101. NC1344.2 +054500 PERFORM FAIL. NC1344.2 +054600 MOVE YEAR-1 (W-1 10) TO COMPUTED-A. NC1344.2 +054700 MOVE "148149150" TO CORRECT-A. NC1344.2 +054800 TTST-102. NC1344.2 +054900 MOVE "TABTEST-10" TO PAR-NAME. NC1344.2 +055000 PERFORM PRINT-DETAIL. NC1344.2 +055100 TABTEST-11. NC1344.2 +055200 IF YEAR-1 (+10 +10) EQUAL TO "298299300" NC1344.2 +055300 PERFORM PASS NC1344.2 +055400 GO TO TABTEST-11B. NC1344.2 +055500 MOVE YEAR-1 (+10 +10) TO COMPUTED-A. NC1344.2 +055600 MOVE "298299300" TO CORRECT-A. NC1344.2 +055700 PERFORM FAIL. NC1344.2 +055800 GO TO TABTEST-11B. NC1344.2 +055900 TABTEST-11A. NC1344.2 +056000 PERFORM DE-LETE. NC1344.2 +056100 TABTEST-11B. NC1344.2 +056200 MOVE "TABTEST-11" TO PAR-NAME. NC1344.2 +056300* NOTE SIGNED NUMERIC LITERALS AS SUBSCRIPTS. NC1344.2 +056400 PERFORM PRINT-DETAIL. NC1344.2 +056500 TABTEST-12. NC1344.2 +056600 MOVE 1 TO W-1. NC1344.2 +056700 IF YEAR-1 (W-1 +1) EQUAL TO "001002003" NC1344.2 +056800 PERFORM PASS NC1344.2 +056900 GO TO TABTEST-12B. NC1344.2 +057000 MOVE YEAR-1 (W-1 +1) TO COMPUTED-A. NC1344.2 +057100 MOVE "001002003" TO CORRECT-A. NC1344.2 +057200 PERFORM FAIL. NC1344.2 +057300 GO TO TABTEST-12B. NC1344.2 +057400 TABTEST-12A. NC1344.2 +057500 PERFORM DE-LETE. NC1344.2 +057600 TABTEST-12B. NC1344.2 +057700 MOVE "TABTEST-12" TO PAR-NAME. NC1344.2 +057800* NOTE SIGNED NUMERIC LITERAL AND NC1344.2 +057900* UNSIGNED NUMERIC ITEM AS SUBSCRIPTS. NC1344.2 +058000 PERFORM PRINT-DETAIL. NC1344.2 +058100 TABTEST-13. NC1344.2 +058200 IF ANIMAL (+8 +1 +3) EQUAL TO 213 NC1344.2 +058300 PERFORM PASS NC1344.2 +058400 GO TO TABTEST-13B. NC1344.2 +058500 MOVE ANIMAL (+8 +1 +3) TO COMPUTED-A. NC1344.2 +058600 MOVE "213" TO CORRECT-A. NC1344.2 +058700 PERFORM FAIL. NC1344.2 +058800 GO TO TABTEST-13B. NC1344.2 +058900 TABTEST-13A. NC1344.2 +059000 PERFORM DE-LETE. NC1344.2 +059100 TABTEST-13B. NC1344.2 +059200 MOVE "TABTEST-13" TO PAR-NAME. NC1344.2 +059300* NOTE SIGNED NUMERIC LITERALS AS SUBSCRIPTS. NC1344.2 +059400 PERFORM PRINT-DETAIL. NC1344.2 +059500 TABTEST-14. NC1344.2 +059600 MOVE 1 TO W-2. NC1344.2 +059700 IF ANIMAL (+8 W-2 +3) EQUAL TO 213 NC1344.2 +059800 PERFORM PASS NC1344.2 +059900 GO TO TABTEST-14B. NC1344.2 +060000 MOVE ANIMAL (+8 W-2 +3) TO COMPUTED-A. NC1344.2 +060100 MOVE "213" TO CORRECT-A. NC1344.2 +060200 PERFORM FAIL. NC1344.2 +060300 GO TO TABTEST-14B. NC1344.2 +060400 TABTEST-14A. NC1344.2 +060500 PERFORM DE-LETE. NC1344.2 +060600 TABTEST-14B. NC1344.2 +060700 MOVE "TABTEST-14" TO PAR-NAME. NC1344.2 +060800* NOTE SIGNED NUMERIC LITERALS AND NC1344.2 +060900* UNSIGNED NUMERIC ITEM AS SUBSCRIPTS. NC1344.2 +061000 PERFORM PRINT-DETAIL. NC1344.2 +061100 TABTEST-15. NC1344.2 +061200 MOVE 8 TO W-1. NC1344.2 +061300 MOVE 3 TO W-3. NC1344.2 +061400 IF ANIMAL (W-1 +1 W-3) EQUAL TO 213 NC1344.2 +061500 PERFORM PASS NC1344.2 +061600 GO TO TABTEST-15B. NC1344.2 +061700 MOVE ANIMAL (W-1 +1 W-3) TO COMPUTED-A. NC1344.2 +061800 MOVE "213" TO CORRECT-A. NC1344.2 +061900 PERFORM FAIL. NC1344.2 +062000 GO TO TABTEST-15B. NC1344.2 +062100 TABTEST-15A. NC1344.2 +062200 PERFORM DE-LETE. NC1344.2 +062300 TABTEST-15B. NC1344.2 +062400 MOVE "TABTEST-15" TO PAR-NAME. NC1344.2 +062500* NOTE UNSIGNED NUMERIC ITEMS AND SIGNED NUMERIC LITERAL NC1344.2 +062600 PERFORM PRINT-DETAIL. NC1344.2 +062700 TABINIT-16. NC1344.2 +062800* ==--> RELATIVE SUBSCRIPTING <--== NC1344.2 +062900 MOVE "IV-22 4.3.8.4 GR4" TO ANSI-REFERENCE. NC1344.2 +063000 MOVE 1 TO W-1. NC1344.2 +063100 MOVE 20 TO W-2. NC1344.2 +063200 MOVE 5 TO W-3. NC1344.2 +063300 TABTEST-16. NC1344.2 +063400 IF ANIMAL (W-3 + 5 W-2 - 10 W-1 + 2) = 300 NC1344.2 +063500 PERFORM PASS NC1344.2 +063600 ELSE NC1344.2 +063700 GO TO TTST-161. NC1344.2 +063800 GO TO TTST-162. NC1344.2 +063900 TTST-161. NC1344.2 +064000 PERFORM FAIL. NC1344.2 +064100 MOVE ANIMAL (W-3 + 5 W-2 - 10 W-1 + 2) TO COMPUTED-A. NC1344.2 +064200 MOVE "300" TO CORRECT-A. NC1344.2 +064300 TTST-162. NC1344.2 +064400 MOVE "TABTEST-16" TO PAR-NAME. NC1344.2 +064500 PERFORM PRINT-DETAIL. NC1344.2 +064600 TABINIT-17. NC1344.2 +064700* ==--> RELATIVE SUBSCRIPTING <--== NC1344.2 +064800 MOVE "IV-22 4.3.8.4 GR4" TO ANSI-REFERENCE. NC1344.2 +064900 MOVE 9 TO W-1. NC1344.2 +065000 MOVE 6 TO W-2. NC1344.2 +065100 MOVE 999 TO W-3. NC1344.2 +065200 TABTEST-17. NC1344.2 +065300 IF ANIMAL (W-1 - 7 W-2 + 1 W-3 - 998) EQUAL TO 49 NC1344.2 +065400 PERFORM PASS NC1344.2 +065500 ELSE NC1344.2 +065600 GO TO TTST-171. NC1344.2 +065700 GO TO TTST-172. NC1344.2 +065800 TTST-171. NC1344.2 +065900 PERFORM FAIL. NC1344.2 +066000 MOVE ANIMAL (W-1 - 7 W-2 + 1 W-3 - 998) TO COMPUTED-A. NC1344.2 +066100 MOVE "049" TO CORRECT-A. NC1344.2 +066200 TTST-172. NC1344.2 +066300 MOVE "TABTEST-17" TO PAR-NAME. NC1344.2 +066400 PERFORM PRINT-DETAIL. NC1344.2 +066500* USED AS SUBSCRIPT. NC1344.2 +066600 WRITE-TABLE. NC1344.2 +066700 PERFORM BLANK-LINE-PRINT 2 TIMES. NC1344.2 +066800 MOVE 1 TO SUBSCRIPT-3 NC1344.2 +066900 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +067000 MOVE 1 TO SUBSCRIPT-1. NC1344.2 +067100 MOVE 1 TO CTR-1 NC1344.2 +067200 PERFORM PRINT-TABLE THROUGH END-TAB 300 TIMES. NC1344.2 +067300 GO TO EXIT-NOTE. NC1344.2 +067400 EXIT-NOTE. NC1344.2 +067500 GO TO FIN-WRAPUP. NC1344.2 +067600 PRINT-TABLE. NC1344.2 +067700 MOVE ANIMAL (SUBSCRIPT-1 SUBSCRIPT-2 SUBSCRIPT-3) TO NC1344.2 +067800 PRINT-ELE (CTR-1). NC1344.2 +067900 ADD 1 TO CTR-1 NC1344.2 +068000 IF CTR-1 EQUAL TO 21 PERFORM TABLE-DUMP. NC1344.2 +068100 ADD 1 TO SUBSCRIPT-3. NC1344.2 +068200 IF SUBSCRIPT-3 GREATER THAN 3 GO TO CCCC ELSE GO TO END-TAB. NC1344.2 +068300 CCCC. NC1344.2 +068400 ADD 1 TO SUBSCRIPT-2 NC1344.2 +068500 MOVE 1 TO SUBSCRIPT-3. NC1344.2 +068600 IF SUBSCRIPT-2 GREATER THAN 10 GO TO DDD ELSE GO TO END-TAB. NC1344.2 +068700 DDD. NC1344.2 +068800 ADD 1 TO SUBSCRIPT-1. NC1344.2 +068900 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +069000 END-TAB. NC1344.2 +069100 EXIT. NC1344.2 +069200 NC1344.2 +069300 TABLE-BUILD-2. NC1344.2 +069400 MOVE W-3 TO ANIMAL (SUBSCRIPT-1 SUBSCRIPT-2 SUBSCRIPT-3). NC1344.2 +069500 ADD 01 TO W-3. NC1344.2 +069600 ADD 01 TO SUBSCRIPT-3. NC1344.2 +069700 IF SUBSCRIPT-3 IS GREATER THAN 3 GO TO AAAA ELSE GO TO NC1344.2 +069800 FINE. NC1344.2 +069900 AAAA. NC1344.2 +070000 ADD 1 TO SUBSCRIPT-2. NC1344.2 +070100 MOVE 1 TO SUBSCRIPT-3. NC1344.2 +070200 IF SUBSCRIPT-2 IS GREATER THAN 10 GO TO BBB ELSE GO TO FINE. NC1344.2 +070300 BBB. NC1344.2 +070400 ADD 1 TO SUBSCRIPT-1. NC1344.2 +070500 MOVE 1 TO SUBSCRIPT-2. NC1344.2 +070600 FINE. NC1344.2 +070700 EXIT. NC1344.2 +070800 FIN-WRAPUP. NC1344.2 +070900 EXIT. NC1344.2 +071000 END-JOB. NC1344.2 +071100 CCVS-EXIT SECTION. NC1344.2 +071200 CCVS-999999. NC1344.2 +071300 GO TO CLOSE-FILES. NC1344.2 diff --git a/tests/cobol85/NC/NC135A.CBL b/tests/cobol85/NC/NC135A.CBL new file mode 100755 index 00000000..3a046774 --- /dev/null +++ b/tests/cobol85/NC/NC135A.CBL @@ -0,0 +1,521 @@ +000100 IDENTIFICATION DIVISION. NC1354.2 +000200 PROGRAM-ID. NC1354.2 +000300 NC135A. NC1354.2 +000400**************************************************************** NC1354.2 +000500* * NC1354.2 +000600* VALIDATION FOR:- * NC1354.2 +000700* * NC1354.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1354.2 +000900* * NC1354.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1354.2 +001100* * NC1354.2 +001200**************************************************************** NC1354.2 +001300* * NC1354.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1354.2 +001500* * NC1354.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1354.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1354.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1354.2 +001900* * NC1354.2 +002000**************************************************************** NC1354.2 +002100* NC1354.2 +002200* PROGRAM NC135A TESTS THE USE OF INDEX-NAMES TO REFERENCE NC1354.2 +002300* 3 DIMENSIONAL TABLE WHICH HAS BEEN REDEFINED. NC1354.2 +002400* FORMAT 2 OF THE SET STATEMENT AND RELATIVE INDEXING ARE NC1354.2 +002500* ALSO TESTED. NC1354.2 +002600* NC1354.2 +002700 ENVIRONMENT DIVISION. NC1354.2 +002800 CONFIGURATION SECTION. NC1354.2 +002900 SOURCE-COMPUTER. NC1354.2 +003000 Linux. NC1354.2 +003100 OBJECT-COMPUTER. NC1354.2 +003200 Linux. NC1354.2 +003300 INPUT-OUTPUT SECTION. NC1354.2 +003400 FILE-CONTROL. NC1354.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1354.2 +003600 "report.log". NC1354.2 +003700 DATA DIVISION. NC1354.2 +003800 FILE SECTION. NC1354.2 +003900 FD PRINT-FILE. NC1354.2 +004000 01 PRINT-REC PICTURE X(120). NC1354.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1354.2 +004200 WORKING-STORAGE SECTION. NC1354.2 +004300 77 ONE PICTURE 999 VALUE IS 001. NC1354.2 +004400 77 CTR-1 PICTURE 999 VALUE IS ZERO. NC1354.2 +004500 77 W-3 PICTURE 999 VALUE ZERO. NC1354.2 +004600 01 IDEN-1 PICTURE 99 VALUE 03. NC1354.2 +004700 01 TABLE-9. NC1354.2 +004800 02 TABLE-8 OCCURS 10 TIMES INDEXED BY INXEX1. NC1354.2 +004900 03 TABLE-7 OCCURS 10 TIMES INDEXED BY INXEX2. NC1354.2 +005000 04 TABLE-1 PICTURE 999 OCCURS 3 TIMES INDEXED BY INXEX3. NC1354.2 +005100 01 TABLE-6 REDEFINES TABLE-9. NC1354.2 +005200 02 TABLE-5 OCCURS 10 TIMES. NC1354.2 +005300 03 TABLE-4 OCCURS 10 TIMES. NC1354.2 +005400 04 TABLE-2 PICTURE 999 OCCURS 3 TIMES. NC1354.2 +005500 01 NUMBER-LIST. NC1354.2 +005600 02 FILLER PICTURE IS X VALUE IS SPACE. NC1354.2 +005700 02 LINE-1 OCCURS 20 TIMES. NC1354.2 +005800 03 BLANKSPACE PICTURE IS XX. NC1354.2 +005900 03 PRINT-ELE PICTURE IS 999. NC1354.2 +006000 01 DATA-NAMES USAGE IS INDEX. NC1354.2 +006100 02 KEY-1. NC1354.2 +006200 02 KEY-2. NC1354.2 +006300 02 KEY-3. NC1354.2 +006400 01 TEST-RESULTS. NC1354.2 +006500 02 FILLER PIC X VALUE SPACE. NC1354.2 +006600 02 FEATURE PIC X(20) VALUE SPACE. NC1354.2 +006700 02 FILLER PIC X VALUE SPACE. NC1354.2 +006800 02 P-OR-F PIC X(5) VALUE SPACE. NC1354.2 +006900 02 FILLER PIC X VALUE SPACE. NC1354.2 +007000 02 PAR-NAME. NC1354.2 +007100 03 FILLER PIC X(19) VALUE SPACE. NC1354.2 +007200 03 PARDOT-X PIC X VALUE SPACE. NC1354.2 +007300 03 DOTVALUE PIC 99 VALUE ZERO. NC1354.2 +007400 02 FILLER PIC X(8) VALUE SPACE. NC1354.2 +007500 02 RE-MARK PIC X(61). NC1354.2 +007600 01 TEST-COMPUTED. NC1354.2 +007700 02 FILLER PIC X(30) VALUE SPACE. NC1354.2 +007800 02 FILLER PIC X(17) VALUE NC1354.2 +007900 " COMPUTED=". NC1354.2 +008000 02 COMPUTED-X. NC1354.2 +008100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1354.2 +008200 03 COMPUTED-N REDEFINES COMPUTED-A NC1354.2 +008300 PIC -9(9).9(9). NC1354.2 +008400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1354.2 +008500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1354.2 +008600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1354.2 +008700 03 CM-18V0 REDEFINES COMPUTED-A. NC1354.2 +008800 04 COMPUTED-18V0 PIC -9(18). NC1354.2 +008900 04 FILLER PIC X. NC1354.2 +009000 03 FILLER PIC X(50) VALUE SPACE. NC1354.2 +009100 01 TEST-CORRECT. NC1354.2 +009200 02 FILLER PIC X(30) VALUE SPACE. NC1354.2 +009300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1354.2 +009400 02 CORRECT-X. NC1354.2 +009500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1354.2 +009600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1354.2 +009700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1354.2 +009800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1354.2 +009900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1354.2 +010000 03 CR-18V0 REDEFINES CORRECT-A. NC1354.2 +010100 04 CORRECT-18V0 PIC -9(18). NC1354.2 +010200 04 FILLER PIC X. NC1354.2 +010300 03 FILLER PIC X(2) VALUE SPACE. NC1354.2 +010400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1354.2 +010500 01 CCVS-C-1. NC1354.2 +010600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1354.2 +010700- "SS PARAGRAPH-NAME NC1354.2 +010800- " REMARKS". NC1354.2 +010900 02 FILLER PIC X(20) VALUE SPACE. NC1354.2 +011000 01 CCVS-C-2. NC1354.2 +011100 02 FILLER PIC X VALUE SPACE. NC1354.2 +011200 02 FILLER PIC X(6) VALUE "TESTED". NC1354.2 +011300 02 FILLER PIC X(15) VALUE SPACE. NC1354.2 +011400 02 FILLER PIC X(4) VALUE "FAIL". NC1354.2 +011500 02 FILLER PIC X(94) VALUE SPACE. NC1354.2 +011600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1354.2 +011700 01 REC-CT PIC 99 VALUE ZERO. NC1354.2 +011800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1354.2 +011900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1354.2 +012000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1354.2 +012100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1354.2 +012200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1354.2 +012300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1354.2 +012400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1354.2 +012500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1354.2 +012600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1354.2 +012700 01 CCVS-H-1. NC1354.2 +012800 02 FILLER PIC X(39) VALUE SPACES. NC1354.2 +012900 02 FILLER PIC X(42) VALUE NC1354.2 +013000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1354.2 +013100 02 FILLER PIC X(39) VALUE SPACES. NC1354.2 +013200 01 CCVS-H-2A. NC1354.2 +013300 02 FILLER PIC X(40) VALUE SPACE. NC1354.2 +013400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1354.2 +013500 02 FILLER PIC XXXX VALUE NC1354.2 +013600 "4.2 ". NC1354.2 +013700 02 FILLER PIC X(28) VALUE NC1354.2 +013800 " COPY - NOT FOR DISTRIBUTION". NC1354.2 +013900 02 FILLER PIC X(41) VALUE SPACE. NC1354.2 +014000 NC1354.2 +014100 01 CCVS-H-2B. NC1354.2 +014200 02 FILLER PIC X(15) VALUE NC1354.2 +014300 "TEST RESULT OF ". NC1354.2 +014400 02 TEST-ID PIC X(9). NC1354.2 +014500 02 FILLER PIC X(4) VALUE NC1354.2 +014600 " IN ". NC1354.2 +014700 02 FILLER PIC X(12) VALUE NC1354.2 +014800 " HIGH ". NC1354.2 +014900 02 FILLER PIC X(22) VALUE NC1354.2 +015000 " LEVEL VALIDATION FOR ". NC1354.2 +015100 02 FILLER PIC X(58) VALUE NC1354.2 +015200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1354.2 +015300 01 CCVS-H-3. NC1354.2 +015400 02 FILLER PIC X(34) VALUE NC1354.2 +015500 " FOR OFFICIAL USE ONLY ". NC1354.2 +015600 02 FILLER PIC X(58) VALUE NC1354.2 +015700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1354.2 +015800 02 FILLER PIC X(28) VALUE NC1354.2 +015900 " COPYRIGHT 1985 ". NC1354.2 +016000 01 CCVS-E-1. NC1354.2 +016100 02 FILLER PIC X(52) VALUE SPACE. NC1354.2 +016200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1354.2 +016300 02 ID-AGAIN PIC X(9). NC1354.2 +016400 02 FILLER PIC X(45) VALUE SPACES. NC1354.2 +016500 01 CCVS-E-2. NC1354.2 +016600 02 FILLER PIC X(31) VALUE SPACE. NC1354.2 +016700 02 FILLER PIC X(21) VALUE SPACE. NC1354.2 +016800 02 CCVS-E-2-2. NC1354.2 +016900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1354.2 +017000 03 FILLER PIC X VALUE SPACE. NC1354.2 +017100 03 ENDER-DESC PIC X(44) VALUE NC1354.2 +017200 "ERRORS ENCOUNTERED". NC1354.2 +017300 01 CCVS-E-3. NC1354.2 +017400 02 FILLER PIC X(22) VALUE NC1354.2 +017500 " FOR OFFICIAL USE ONLY". NC1354.2 +017600 02 FILLER PIC X(12) VALUE SPACE. NC1354.2 +017700 02 FILLER PIC X(58) VALUE NC1354.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1354.2 +017900 02 FILLER PIC X(13) VALUE SPACE. NC1354.2 +018000 02 FILLER PIC X(15) VALUE NC1354.2 +018100 " COPYRIGHT 1985". NC1354.2 +018200 01 CCVS-E-4. NC1354.2 +018300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1354.2 +018400 02 FILLER PIC X(4) VALUE " OF ". NC1354.2 +018500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1354.2 +018600 02 FILLER PIC X(40) VALUE NC1354.2 +018700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1354.2 +018800 01 XXINFO. NC1354.2 +018900 02 FILLER PIC X(19) VALUE NC1354.2 +019000 "*** INFORMATION ***". NC1354.2 +019100 02 INFO-TEXT. NC1354.2 +019200 04 FILLER PIC X(8) VALUE SPACE. NC1354.2 +019300 04 XXCOMPUTED PIC X(20). NC1354.2 +019400 04 FILLER PIC X(5) VALUE SPACE. NC1354.2 +019500 04 XXCORRECT PIC X(20). NC1354.2 +019600 02 INF-ANSI-REFERENCE PIC X(48). NC1354.2 +019700 01 HYPHEN-LINE. NC1354.2 +019800 02 FILLER PIC IS X VALUE IS SPACE. NC1354.2 +019900 02 FILLER PIC IS X(65) VALUE IS "************************NC1354.2 +020000- "*****************************************". NC1354.2 +020100 02 FILLER PIC IS X(54) VALUE IS "************************NC1354.2 +020200- "******************************". NC1354.2 +020300 01 CCVS-PGM-ID PIC X(9) VALUE NC1354.2 +020400 "NC135A". NC1354.2 +020500 PROCEDURE DIVISION. NC1354.2 +020600 CCVS1 SECTION. NC1354.2 +020700 OPEN-FILES. NC1354.2 +020800 OPEN OUTPUT PRINT-FILE. NC1354.2 +020900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1354.2 +021000 MOVE SPACE TO TEST-RESULTS. NC1354.2 +021100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1354.2 +021200 GO TO CCVS1-EXIT. NC1354.2 +021300 CLOSE-FILES. NC1354.2 +021400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1354.2 +021500 TERMINATE-CCVS. NC1354.2 +021600*S EXIT PROGRAM. NC1354.2 +021700*SERMINATE-CALL. NC1354.2 +021800 STOP RUN. NC1354.2 +021900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1354.2 +022000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1354.2 +022100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1354.2 +022200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1354.2 +022300 MOVE "****TEST DELETED****" TO RE-MARK. NC1354.2 +022400 PRINT-DETAIL. NC1354.2 +022500 IF REC-CT NOT EQUAL TO ZERO NC1354.2 +022600 MOVE "." TO PARDOT-X NC1354.2 +022700 MOVE REC-CT TO DOTVALUE. NC1354.2 +022800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1354.2 +022900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1354.2 +023000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1354.2 +023100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1354.2 +023200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1354.2 +023300 MOVE SPACE TO CORRECT-X. NC1354.2 +023400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1354.2 +023500 MOVE SPACE TO RE-MARK. NC1354.2 +023600 HEAD-ROUTINE. NC1354.2 +023700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +023800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +023900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1354.2 +024000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1354.2 +024100 COLUMN-NAMES-ROUTINE. NC1354.2 +024200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +024300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +024400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +024500 END-ROUTINE. NC1354.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1354.2 +024700 END-RTN-EXIT. NC1354.2 +024800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +024900 END-ROUTINE-1. NC1354.2 +025000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1354.2 +025100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1354.2 +025200 ADD PASS-COUNTER TO ERROR-HOLD. NC1354.2 +025300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1354.2 +025400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1354.2 +025500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1354.2 +025600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1354.2 +025700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1354.2 +025800 END-ROUTINE-12. NC1354.2 +025900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1354.2 +026000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1354.2 +026100 MOVE "NO " TO ERROR-TOTAL NC1354.2 +026200 ELSE NC1354.2 +026300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1354.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1354.2 +026500 PERFORM WRITE-LINE. NC1354.2 +026600 END-ROUTINE-13. NC1354.2 +026700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1354.2 +026800 MOVE "NO " TO ERROR-TOTAL ELSE NC1354.2 +026900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1354.2 +027000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1354.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +027200 IF INSPECT-COUNTER EQUAL TO ZERO NC1354.2 +027300 MOVE "NO " TO ERROR-TOTAL NC1354.2 +027400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1354.2 +027500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1354.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +027700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1354.2 +027800 WRITE-LINE. NC1354.2 +027900 ADD 1 TO RECORD-COUNT. NC1354.2 +028000 IF RECORD-COUNT GREATER 42 NC1354.2 +028100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1354.2 +028200 MOVE SPACE TO DUMMY-RECORD NC1354.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1354.2 +028400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1354.2 +028500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1354.2 +028600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1354.2 +028700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1354.2 +028800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1354.2 +028900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1354.2 +029000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1354.2 +029100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1354.2 +029200 MOVE ZERO TO RECORD-COUNT. NC1354.2 +029300 PERFORM WRT-LN. NC1354.2 +029400 WRT-LN. NC1354.2 +029500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1354.2 +029600 MOVE SPACE TO DUMMY-RECORD. NC1354.2 +029700 BLANK-LINE-PRINT. NC1354.2 +029800 PERFORM WRT-LN. NC1354.2 +029900 FAIL-ROUTINE. NC1354.2 +030000 IF COMPUTED-X NOT EQUAL TO SPACE NC1354.2 +030100 GO TO FAIL-ROUTINE-WRITE. NC1354.2 +030200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1354.2 +030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1354.2 +030400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1354.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1354.2 +030700 GO TO FAIL-ROUTINE-EX. NC1354.2 +030800 FAIL-ROUTINE-WRITE. NC1354.2 +030900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1354.2 +031000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1354.2 +031100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1354.2 +031200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1354.2 +031300 FAIL-ROUTINE-EX. EXIT. NC1354.2 +031400 BAIL-OUT. NC1354.2 +031500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1354.2 +031600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1354.2 +031700 BAIL-OUT-WRITE. NC1354.2 +031800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1354.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1354.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1354.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1354.2 +032200 BAIL-OUT-EX. EXIT. NC1354.2 +032300 CCVS1-EXIT. NC1354.2 +032400 EXIT. NC1354.2 +032500 SECT-NC135A-001 SECTION. NC1354.2 +032600 PARAGRAPH-NAME-4. NC1354.2 +032700 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1354.2 +032800 SET INXEX1 INXEX2 INXEX3 TO 001. NC1354.2 +032900 MOVE 001 TO W-3. NC1354.2 +033000 PARAGRAPH-NAME-5. NC1354.2 +033100 MOVE W-3 TO TABLE-1 (INXEX1 INXEX2 INXEX3). NC1354.2 +033200 ADD 01 TO W-3. NC1354.2 +033300 IF INXEX3 EQUAL TO 3 NC1354.2 +033400 GO TO PARAGRAPH-NAME-6. NC1354.2 +033500 SET INXEX3 UP BY 1. NC1354.2 +033600 GO TO PARAGRAPH-NAME-5. NC1354.2 +033700 PARAGRAPH-NAME-6. NC1354.2 +033800 SET INXEX3 TO 1 NC1354.2 +033900 IF INXEX2 EQUAL TO 10 NC1354.2 +034000 GO TO PARAGRAPH-NAME-7. NC1354.2 +034100 SET INXEX2 UP BY 001. NC1354.2 +034200 GO TO PARAGRAPH-NAME-5. NC1354.2 +034300 PARAGRAPH-NAME-7. NC1354.2 +034400 SET INXEX2 TO 1 NC1354.2 +034500 IF INXEX1 EQUAL TO 10 NC1354.2 +034600 GO TO PARAGRAPH-NAME-8. NC1354.2 +034700 SET INXEX1 UP BY 001. NC1354.2 +034800 GO TO PARAGRAPH-NAME-5. NC1354.2 +034900* THIS SECTION GENERATES VALUES FOR A 10X10X3 TABLE NC1354.2 +035000* AND THE TABLE IS USED IN THE TESTS IN THIS ROUTINE. NC1354.2 +035100 PARAGRAPH-NAME-8. NC1354.2 +035200 EXIT. NC1354.2 +035300 SECTION-NAME-2 SECTION. NC1354.2 +035400 PARAGRAPH-NAME-9. NC1354.2 +035500* NC1354.2 +035600 MOVE SPACE TO COMPUTED-A CORRECT-A. NC1354.2 +035700 MOVE "INDEXING" TO FEATURE. NC1354.2 +035800 SET INXEX1 INXEX2 INXEX3 TO 01. NC1354.2 +035900 INDEX-TEST-1. NC1354.2 +036000 IF TABLE-1 (INXEX1 INXEX2 INXEX3) EQUAL TO 001 NC1354.2 +036100 PERFORM PASS NC1354.2 +036200 GO TO WRITE-1. NC1354.2 +036300 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO COMPUTED-A. NC1354.2 +036400 MOVE 001 TO CORRECT-A. NC1354.2 +036500 PERFORM FAIL. NC1354.2 +036600 GO TO WRITE-1. NC1354.2 +036700 DELETE-1. NC1354.2 +036800 PERFORM DE-LETE. NC1354.2 +036900 WRITE-1. NC1354.2 +037000 MOVE "INDEX-TEST-1" TO PAR-NAME. NC1354.2 +037100 PERFORM PRINT-DETAIL. NC1354.2 +037200 INDEX-TEST-2. NC1354.2 +037300 SET INXEX1 INXEX2 INXEX3 TO 01. NC1354.2 +037400 IF TABLE-1 (INXEX1 INXEX2 + 1 INXEX3 + 1) EQUAL TO 005 NC1354.2 +037500 PERFORM PASS NC1354.2 +037600 GO TO WRITE-2. NC1354.2 +037700 MOVE TABLE-1 (INXEX1 INXEX2 + 1 INXEX3 + 1) TO NC1354.2 +037800 COMPUTED-A. NC1354.2 +037900 MOVE "005" TO CORRECT-A. NC1354.2 +038000 PERFORM FAIL. NC1354.2 +038100 GO TO WRITE-2. NC1354.2 +038200 DELETE-2. NC1354.2 +038300 PERFORM DE-LETE. NC1354.2 +038400 WRITE-2. NC1354.2 +038500 MOVE "INDEX-TEST-2" TO PAR-NAME. NC1354.2 +038600 PERFORM PRINT-DETAIL. NC1354.2 +038700 INDEX-TEST-3. NC1354.2 +038800 SET INXEX1 INXEX2 TO 10. NC1354.2 +038900 SET INXEX3 TO 03. NC1354.2 +039000 IF TABLE-1 (INXEX1 INXEX2 INXEX3 - 1) EQUAL TO 299 NC1354.2 +039100 PERFORM PASS NC1354.2 +039200 GO TO WRITE-3. NC1354.2 +039300 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3 - 1) TO COMPUTED-A. NC1354.2 +039400 MOVE "299" TO CORRECT-A. NC1354.2 +039500 PERFORM FAIL. NC1354.2 +039600 GO TO WRITE-3. NC1354.2 +039700 DELETE-3. NC1354.2 +039800 PERFORM DE-LETE. NC1354.2 +039900 WRITE-3. NC1354.2 +040000 MOVE "INDEX-TEST-3" TO PAR-NAME. NC1354.2 +040100 PERFORM PRINT-DETAIL. NC1354.2 +040200 INDEX-TEST-4. NC1354.2 +040300 SET INXEX1 INXEX2 TO 10. NC1354.2 +040400 SET INXEX3 TO 03. NC1354.2 +040500 IF TABLE-1 (INXEX1 - 5 INXEX2 - 7 INXEX3) EQUAL TO 129 NC1354.2 +040600 PERFORM PASS NC1354.2 +040700 GO TO WRITE-4. NC1354.2 +040800 MOVE TABLE-1 (INXEX1 - 5 INXEX2 - 7 INXEX3) TO NC1354.2 +040900 COMPUTED-A. NC1354.2 +041000 MOVE "129" TO CORRECT-A. NC1354.2 +041100 PERFORM FAIL. NC1354.2 +041200 GO TO WRITE-4. NC1354.2 +041300 DELETE-4. NC1354.2 +041400 PERFORM DE-LETE. NC1354.2 +041500 WRITE-4. NC1354.2 +041600 MOVE "INDEX-TEST-4" TO PAR-NAME. NC1354.2 +041700 PERFORM PRINT-DETAIL. NC1354.2 +041800 INDEX-TEST-5. NC1354.2 +041900 SET INXEX1 TO 10. NC1354.2 +042000 SET KEY-1 TO INXEX1. NC1354.2 +042100 SET INXEX1 TO 05. NC1354.2 +042200 SET INXEX2 TO 10. NC1354.2 +042300 SET INXEX3 TO 03. NC1354.2 +042400 SET INXEX1 TO KEY-1. NC1354.2 +042500 IF TABLE-1 (INXEX1 INXEX2 INXEX3) EQUAL TO 300 NC1354.2 +042600 PERFORM PASS NC1354.2 +042700 GO TO WRITE-5. NC1354.2 +042800 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO COMPUTED-A. NC1354.2 +042900 MOVE "300" TO CORRECT-A. NC1354.2 +043000 PERFORM FAIL. NC1354.2 +043100 GO TO WRITE-5. NC1354.2 +043200 DELETE-5. NC1354.2 +043300 PERFORM DE-LETE. NC1354.2 +043400 WRITE-5. NC1354.2 +043500 MOVE "INDEX-TEST-5" TO PAR-NAME. NC1354.2 +043600 PERFORM PRINT-DETAIL. NC1354.2 +043700 INDEX-TEST-6. NC1354.2 +043800 SET INXEX1 INXEX2 TO 10. NC1354.2 +043900 SET INXEX3 TO 03. NC1354.2 +044000 SET INXEX1 DOWN BY 01. NC1354.2 +044100 SET INXEX2 DOWN BY IDEN-1. NC1354.2 +044200* NOTE IDEN-1 IS EQUAL TO 03. NC1354.2 +044300 SET INXEX3 DOWN BY 2. NC1354.2 +044400 IF TABLE-1 (INXEX1 INXEX2 INXEX3) EQUAL TO 259 NC1354.2 +044500 PERFORM PASS NC1354.2 +044600 GO TO WRITE-6. NC1354.2 +044700 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO COMPUTED-A. NC1354.2 +044800 MOVE "259" TO CORRECT-A. NC1354.2 +044900 PERFORM FAIL. NC1354.2 +045000 GO TO WRITE-6. NC1354.2 +045100 DELETE-6. NC1354.2 +045200 PERFORM DE-LETE. NC1354.2 +045300 WRITE-6. NC1354.2 +045400 MOVE "INDEX-TEST-6" TO PAR-NAME. NC1354.2 +045500 PERFORM PRINT-DETAIL. NC1354.2 +045600 INDEX-TEST-7. NC1354.2 +045700 SET INXEX1 TO ONE. NC1354.2 +045800 SET INXEX2 INXEX3 TO INXEX1. NC1354.2 +045900 IF TABLE-1 (INXEX1 INXEX2 INXEX3) EQUAL TO 001 NC1354.2 +046000 PERFORM PASS NC1354.2 +046100 GO TO WRITE-7. NC1354.2 +046200 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO COMPUTED-A. NC1354.2 +046300 MOVE "001" TO CORRECT-A. NC1354.2 +046400 PERFORM FAIL. NC1354.2 +046500 GO TO WRITE-7. NC1354.2 +046600 DELETE-7. NC1354.2 +046700 PERFORM DE-LETE. NC1354.2 +046800 WRITE-7. NC1354.2 +046900 MOVE "INDEX-TEST-7" TO PAR-NAME. NC1354.2 +047000 PERFORM PRINT-DETAIL. NC1354.2 +047100 SECTION-NAME-3 SECTION. NC1354.2 +047200 PARAGRAPH-NAME-10. NC1354.2 +047300 PERFORM BLANK-LINE-PRINT 2 TIMES. NC1354.2 +047400 PERFORM INSPT. NC1354.2 +047500 MOVE SPACES TO PRINT-REC. NC1354.2 +047600 WRITE PRINT-REC. NC1354.2 +047700 MOVE "NOTE THIS SECTION WRITES A 20X15 TABLE OF THREE-DIGIT NC1354.2 +047800- "NUMBERS 001 TO 300 --- THERE SHOULD BE TWO" TO PRINT-REC.NC1354.2 +047900 WRITE PRINT-REC. NC1354.2 +048000 MOVE SPACES TO PRINT-REC. NC1354.2 +048100 MOVE "SPACES BETWEEN EACH NUMBER ON A LINE --- THE NUMBERS NC1354.2 +048200- "001 THRU 020 SHOULD FORM THE FIRST LINE ---" TO PRINT-REC.NC1354.2 +048300 WRITE PRINT-REC. NC1354.2 +048400 MOVE SPACES TO PRINT-REC. NC1354.2 +048500 MOVE "THE VALUES IN THIS TABLE WERE GENERATED IN NC1354.2 +048600- "SECTION-NAME-1 SECTION." TO PRINT-REC. NC1354.2 +048700 WRITE PRINT-REC. NC1354.2 +048800 MOVE SPACES TO PRINT-REC. NC1354.2 +048900 SET INXEX1 INXEX2 INXEX3 TO ONE. NC1354.2 +049000 MOVE 01 TO CTR-1. NC1354.2 +049100 PARAGRAPH-NAME-11. NC1354.2 +049200 MOVE TABLE-1 (INXEX1 INXEX2 INXEX3) TO NC1354.2 +049300 PRINT-ELE (CTR-1) NC1354.2 +049400 MOVE SPACE TO BLANKSPACE (CTR-1). NC1354.2 +049500 ADD 1 TO CTR-1 NC1354.2 +049600 IF CTR-1 EQUAL TO 21 PERFORM PARAGRAPH-NAME-15. NC1354.2 +049700 IF INXEX3 EQUAL TO 3 GO TO PARAGRAPH-NAME-12. NC1354.2 +049800 SET INXEX3 UP BY 1. NC1354.2 +049900 GO TO PARAGRAPH-NAME-11. NC1354.2 +050000 PARAGRAPH-NAME-12. NC1354.2 +050100 SET INXEX3 TO 1. NC1354.2 +050200 IF INXEX2 EQUAL TO 10 GO TO PARAGRAPH-NAME-13. NC1354.2 +050300 SET INXEX2 UP BY 1. NC1354.2 +050400 GO TO PARAGRAPH-NAME-11. NC1354.2 +050500 PARAGRAPH-NAME-13. NC1354.2 +050600 SET INXEX2 TO 1. NC1354.2 +050700 IF INXEX1 EQUAL TO 10 GO TO PARAGRAPH-NAME-14. NC1354.2 +050800 SET INXEX1 UP BY 1. NC1354.2 +050900 GO TO PARAGRAPH-NAME-11. NC1354.2 +051000 PARAGRAPH-NAME-14. NC1354.2 +051100 GO TO PARAGRAPH-NAME-16. NC1354.2 +051200 PARAGRAPH-NAME-15. NC1354.2 +051300 MOVE SPACE TO PRINT-REC. NC1354.2 +051400 MOVE NUMBER-LIST TO PRINT-REC. NC1354.2 +051500 WRITE PRINT-REC AFTER 1. NC1354.2 +051600 MOVE 01 TO CTR-1. NC1354.2 +051700 PARAGRAPH-NAME-16. NC1354.2 +051800 EXIT. NC1354.2 +051900 CCVS-EXIT SECTION. NC1354.2 +052000 CCVS-999999. NC1354.2 +052100 GO TO CLOSE-FILES. NC1354.2 diff --git a/tests/cobol85/NC/NC136A.CBL b/tests/cobol85/NC/NC136A.CBL new file mode 100755 index 00000000..ba1cf748 --- /dev/null +++ b/tests/cobol85/NC/NC136A.CBL @@ -0,0 +1,489 @@ +000100 IDENTIFICATION DIVISION. NC1364.2 +000200 PROGRAM-ID. NC1364.2 +000300 NC136A. NC1364.2 +000400**************************************************************** NC1364.2 +000500* * NC1364.2 +000600* VALIDATION FOR:- * NC1364.2 +000700* * NC1364.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1364.2 +000900* * NC1364.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1364.2 +001100* * NC1364.2 +001200**************************************************************** NC1364.2 +001300* * NC1364.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1364.2 +001500* * NC1364.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1364.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1364.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1364.2 +001900* * NC1364.2 +002000**************************************************************** NC1364.2 +002100* NC1364.2 +002200* PROGRAM NC136A VERIFIES THE ACCURACY OF BUILDING AND NC1364.2 +002300* ACCESSING A 3 DIMENSIONAL TABLE USING VARIOUS COMBINATIONS NC1364.2 +002400* OF NUMERIC LITERAL AND DATA-NAME SUBSCRIPTS. NC1364.2 +002500* NC1364.2 +002600 ENVIRONMENT DIVISION. NC1364.2 +002700 CONFIGURATION SECTION. NC1364.2 +002800 SOURCE-COMPUTER. NC1364.2 +002900 Linux. NC1364.2 +003000 OBJECT-COMPUTER. NC1364.2 +003100 Linux. NC1364.2 +003200 INPUT-OUTPUT SECTION. NC1364.2 +003300 FILE-CONTROL. NC1364.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1364.2 +003500 "report.log". NC1364.2 +003600 DATA DIVISION. NC1364.2 +003700 FILE SECTION. NC1364.2 +003800 FD PRINT-FILE. NC1364.2 +003900 01 PRINT-REC PICTURE X(120). NC1364.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1364.2 +004100 WORKING-STORAGE SECTION. NC1364.2 +004200 77 SUB-1 PICTURE S99 VALUE ZERO. NC1364.2 +004300 77 SUB-2 PICTURE 99 VALUE ZERO. NC1364.2 +004400 77 SUB-3 PICTURE 99 VALUE ZERO. NC1364.2 +004500 77 CON-7 PICTURE 99 VALUE 07. NC1364.2 +004600 77 CON-10 PICTURE 99 VALUE 10. NC1364.2 +004700 77 CON-5 PICTURE 99 VALUE 05. NC1364.2 +004800 77 CON-6 PICTURE 99 VALUE 06. NC1364.2 +004900 01 GRP-NAME. NC1364.2 +005000 02 FILLER PICTURE XXX VALUE "GRP". NC1364.2 +005100 02 ADD-GRP PICTURE 99 VALUE 01. NC1364.2 +005200 NC1364.2 +005300 01 SEC-NAME. NC1364.2 +005400 02 FILLER PICTURE X(5) VALUE "SEC (". NC1364.2 +005500 02 SEC-GRP PICTURE 99 VALUE 00. NC1364.2 +005600 02 FILLER PICTURE X VALUE " ". NC1364.2 +005700 02 ADD-SEC PICTURE 99 VALUE 01. NC1364.2 +005800 02 FILLER PICTURE X VALUE ")". NC1364.2 +005900 NC1364.2 +006000 01 ELEM-NAME. NC1364.2 +006100 02 FILLER PICTURE X(6) VALUE "ELEM (". NC1364.2 +006200 02 ELEM-GRP PICTURE 99 VALUE 00. NC1364.2 +006300 02 FILLER PICTURE X VALUE " ". NC1364.2 +006400 02 ELEM-SEC PICTURE 99 VALUE 00. NC1364.2 +006500 02 FILLER PICTURE X VALUE " ". NC1364.2 +006600 02 ADD-ELEM PICTURE 99 VALUE 01. NC1364.2 +006700 02 FILLER PICTURE X VALUE ")". NC1364.2 +006800 NC1364.2 +006900 01 THREE-DIMENSION-TBL. NC1364.2 +007000 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC1364.2 +007100 03 ENTRY-1 PICTURE X(5). NC1364.2 +007200 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC1364.2 +007300 04 ENTRY-2 PICTURE X(11). NC1364.2 +007400 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC1364.2 +007500 05 ENTRY-3 PICTURE X(15). NC1364.2 +007600 NC1364.2 +007700 01 TEST-RESULTS. NC1364.2 +007800 02 FILLER PIC X VALUE SPACE. NC1364.2 +007900 02 FEATURE PIC X(20) VALUE SPACE. NC1364.2 +008000 02 FILLER PIC X VALUE SPACE. NC1364.2 +008100 02 P-OR-F PIC X(5) VALUE SPACE. NC1364.2 +008200 02 FILLER PIC X VALUE SPACE. NC1364.2 +008300 02 PAR-NAME. NC1364.2 +008400 03 FILLER PIC X(19) VALUE SPACE. NC1364.2 +008500 03 PARDOT-X PIC X VALUE SPACE. NC1364.2 +008600 03 DOTVALUE PIC 99 VALUE ZERO. NC1364.2 +008700 02 FILLER PIC X(8) VALUE SPACE. NC1364.2 +008800 02 RE-MARK PIC X(61). NC1364.2 +008900 01 TEST-COMPUTED. NC1364.2 +009000 02 FILLER PIC X(30) VALUE SPACE. NC1364.2 +009100 02 FILLER PIC X(17) VALUE NC1364.2 +009200 " COMPUTED=". NC1364.2 +009300 02 COMPUTED-X. NC1364.2 +009400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1364.2 +009500 03 COMPUTED-N REDEFINES COMPUTED-A NC1364.2 +009600 PIC -9(9).9(9). NC1364.2 +009700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1364.2 +009800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1364.2 +009900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1364.2 +010000 03 CM-18V0 REDEFINES COMPUTED-A. NC1364.2 +010100 04 COMPUTED-18V0 PIC -9(18). NC1364.2 +010200 04 FILLER PIC X. NC1364.2 +010300 03 FILLER PIC X(50) VALUE SPACE. NC1364.2 +010400 01 TEST-CORRECT. NC1364.2 +010500 02 FILLER PIC X(30) VALUE SPACE. NC1364.2 +010600 02 FILLER PIC X(17) VALUE " CORRECT =". NC1364.2 +010700 02 CORRECT-X. NC1364.2 +010800 03 CORRECT-A PIC X(20) VALUE SPACE. NC1364.2 +010900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1364.2 +011000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1364.2 +011100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1364.2 +011200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1364.2 +011300 03 CR-18V0 REDEFINES CORRECT-A. NC1364.2 +011400 04 CORRECT-18V0 PIC -9(18). NC1364.2 +011500 04 FILLER PIC X. NC1364.2 +011600 03 FILLER PIC X(2) VALUE SPACE. NC1364.2 +011700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1364.2 +011800 01 CCVS-C-1. NC1364.2 +011900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1364.2 +012000- "SS PARAGRAPH-NAME NC1364.2 +012100- " REMARKS". NC1364.2 +012200 02 FILLER PIC X(20) VALUE SPACE. NC1364.2 +012300 01 CCVS-C-2. NC1364.2 +012400 02 FILLER PIC X VALUE SPACE. NC1364.2 +012500 02 FILLER PIC X(6) VALUE "TESTED". NC1364.2 +012600 02 FILLER PIC X(15) VALUE SPACE. NC1364.2 +012700 02 FILLER PIC X(4) VALUE "FAIL". NC1364.2 +012800 02 FILLER PIC X(94) VALUE SPACE. NC1364.2 +012900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1364.2 +013000 01 REC-CT PIC 99 VALUE ZERO. NC1364.2 +013100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1364.2 +013200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1364.2 +013300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1364.2 +013400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1364.2 +013500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1364.2 +013600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1364.2 +013700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1364.2 +013800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1364.2 +013900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1364.2 +014000 01 CCVS-H-1. NC1364.2 +014100 02 FILLER PIC X(39) VALUE SPACES. NC1364.2 +014200 02 FILLER PIC X(42) VALUE NC1364.2 +014300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1364.2 +014400 02 FILLER PIC X(39) VALUE SPACES. NC1364.2 +014500 01 CCVS-H-2A. NC1364.2 +014600 02 FILLER PIC X(40) VALUE SPACE. NC1364.2 +014700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1364.2 +014800 02 FILLER PIC XXXX VALUE NC1364.2 +014900 "4.2 ". NC1364.2 +015000 02 FILLER PIC X(28) VALUE NC1364.2 +015100 " COPY - NOT FOR DISTRIBUTION". NC1364.2 +015200 02 FILLER PIC X(41) VALUE SPACE. NC1364.2 +015300 NC1364.2 +015400 01 CCVS-H-2B. NC1364.2 +015500 02 FILLER PIC X(15) VALUE NC1364.2 +015600 "TEST RESULT OF ". NC1364.2 +015700 02 TEST-ID PIC X(9). NC1364.2 +015800 02 FILLER PIC X(4) VALUE NC1364.2 +015900 " IN ". NC1364.2 +016000 02 FILLER PIC X(12) VALUE NC1364.2 +016100 " HIGH ". NC1364.2 +016200 02 FILLER PIC X(22) VALUE NC1364.2 +016300 " LEVEL VALIDATION FOR ". NC1364.2 +016400 02 FILLER PIC X(58) VALUE NC1364.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1364.2 +016600 01 CCVS-H-3. NC1364.2 +016700 02 FILLER PIC X(34) VALUE NC1364.2 +016800 " FOR OFFICIAL USE ONLY ". NC1364.2 +016900 02 FILLER PIC X(58) VALUE NC1364.2 +017000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1364.2 +017100 02 FILLER PIC X(28) VALUE NC1364.2 +017200 " COPYRIGHT 1985 ". NC1364.2 +017300 01 CCVS-E-1. NC1364.2 +017400 02 FILLER PIC X(52) VALUE SPACE. NC1364.2 +017500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1364.2 +017600 02 ID-AGAIN PIC X(9). NC1364.2 +017700 02 FILLER PIC X(45) VALUE SPACES. NC1364.2 +017800 01 CCVS-E-2. NC1364.2 +017900 02 FILLER PIC X(31) VALUE SPACE. NC1364.2 +018000 02 FILLER PIC X(21) VALUE SPACE. NC1364.2 +018100 02 CCVS-E-2-2. NC1364.2 +018200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1364.2 +018300 03 FILLER PIC X VALUE SPACE. NC1364.2 +018400 03 ENDER-DESC PIC X(44) VALUE NC1364.2 +018500 "ERRORS ENCOUNTERED". NC1364.2 +018600 01 CCVS-E-3. NC1364.2 +018700 02 FILLER PIC X(22) VALUE NC1364.2 +018800 " FOR OFFICIAL USE ONLY". NC1364.2 +018900 02 FILLER PIC X(12) VALUE SPACE. NC1364.2 +019000 02 FILLER PIC X(58) VALUE NC1364.2 +019100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1364.2 +019200 02 FILLER PIC X(13) VALUE SPACE. NC1364.2 +019300 02 FILLER PIC X(15) VALUE NC1364.2 +019400 " COPYRIGHT 1985". NC1364.2 +019500 01 CCVS-E-4. NC1364.2 +019600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1364.2 +019700 02 FILLER PIC X(4) VALUE " OF ". NC1364.2 +019800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1364.2 +019900 02 FILLER PIC X(40) VALUE NC1364.2 +020000 " TESTS WERE EXECUTED SUCCESSFULLY". NC1364.2 +020100 01 XXINFO. NC1364.2 +020200 02 FILLER PIC X(19) VALUE NC1364.2 +020300 "*** INFORMATION ***". NC1364.2 +020400 02 INFO-TEXT. NC1364.2 +020500 04 FILLER PIC X(8) VALUE SPACE. NC1364.2 +020600 04 XXCOMPUTED PIC X(20). NC1364.2 +020700 04 FILLER PIC X(5) VALUE SPACE. NC1364.2 +020800 04 XXCORRECT PIC X(20). NC1364.2 +020900 02 INF-ANSI-REFERENCE PIC X(48). NC1364.2 +021000 01 HYPHEN-LINE. NC1364.2 +021100 02 FILLER PIC IS X VALUE IS SPACE. NC1364.2 +021200 02 FILLER PIC IS X(65) VALUE IS "************************NC1364.2 +021300- "*****************************************". NC1364.2 +021400 02 FILLER PIC IS X(54) VALUE IS "************************NC1364.2 +021500- "******************************". NC1364.2 +021600 01 CCVS-PGM-ID PIC X(9) VALUE NC1364.2 +021700 "NC136A". NC1364.2 +021800 PROCEDURE DIVISION. NC1364.2 +021900 CCVS1 SECTION. NC1364.2 +022000 OPEN-FILES. NC1364.2 +022100 OPEN OUTPUT PRINT-FILE. NC1364.2 +022200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1364.2 +022300 MOVE SPACE TO TEST-RESULTS. NC1364.2 +022400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1364.2 +022500 GO TO CCVS1-EXIT. NC1364.2 +022600 CLOSE-FILES. NC1364.2 +022700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1364.2 +022800 TERMINATE-CCVS. NC1364.2 +022900*S EXIT PROGRAM. NC1364.2 +023000*SERMINATE-CALL. NC1364.2 +023100 STOP RUN. NC1364.2 +023200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1364.2 +023300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1364.2 +023400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1364.2 +023500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1364.2 +023600 MOVE "****TEST DELETED****" TO RE-MARK. NC1364.2 +023700 PRINT-DETAIL. NC1364.2 +023800 IF REC-CT NOT EQUAL TO ZERO NC1364.2 +023900 MOVE "." TO PARDOT-X NC1364.2 +024000 MOVE REC-CT TO DOTVALUE. NC1364.2 +024100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1364.2 +024200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1364.2 +024300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1364.2 +024400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1364.2 +024500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1364.2 +024600 MOVE SPACE TO CORRECT-X. NC1364.2 +024700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1364.2 +024800 MOVE SPACE TO RE-MARK. NC1364.2 +024900 HEAD-ROUTINE. NC1364.2 +025000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +025100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +025200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1364.2 +025300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1364.2 +025400 COLUMN-NAMES-ROUTINE. NC1364.2 +025500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +025600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +025700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +025800 END-ROUTINE. NC1364.2 +025900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1364.2 +026000 END-RTN-EXIT. NC1364.2 +026100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +026200 END-ROUTINE-1. NC1364.2 +026300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1364.2 +026400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1364.2 +026500 ADD PASS-COUNTER TO ERROR-HOLD. NC1364.2 +026600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1364.2 +026700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1364.2 +026800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1364.2 +026900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1364.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1364.2 +027100 END-ROUTINE-12. NC1364.2 +027200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1364.2 +027300 IF ERROR-COUNTER IS EQUAL TO ZERO NC1364.2 +027400 MOVE "NO " TO ERROR-TOTAL NC1364.2 +027500 ELSE NC1364.2 +027600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1364.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1364.2 +027800 PERFORM WRITE-LINE. NC1364.2 +027900 END-ROUTINE-13. NC1364.2 +028000 IF DELETE-COUNTER IS EQUAL TO ZERO NC1364.2 +028100 MOVE "NO " TO ERROR-TOTAL ELSE NC1364.2 +028200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1364.2 +028300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1364.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +028500 IF INSPECT-COUNTER EQUAL TO ZERO NC1364.2 +028600 MOVE "NO " TO ERROR-TOTAL NC1364.2 +028700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1364.2 +028800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1364.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +029000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1364.2 +029100 WRITE-LINE. NC1364.2 +029200 ADD 1 TO RECORD-COUNT. NC1364.2 +029300 IF RECORD-COUNT GREATER 42 NC1364.2 +029400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1364.2 +029500 MOVE SPACE TO DUMMY-RECORD NC1364.2 +029600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1364.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1364.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1364.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1364.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1364.2 +030100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1364.2 +030200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1364.2 +030300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1364.2 +030400 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1364.2 +030500 MOVE ZERO TO RECORD-COUNT. NC1364.2 +030600 PERFORM WRT-LN. NC1364.2 +030700 WRT-LN. NC1364.2 +030800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1364.2 +030900 MOVE SPACE TO DUMMY-RECORD. NC1364.2 +031000 BLANK-LINE-PRINT. NC1364.2 +031100 PERFORM WRT-LN. NC1364.2 +031200 FAIL-ROUTINE. NC1364.2 +031300 IF COMPUTED-X NOT EQUAL TO SPACE NC1364.2 +031400 GO TO FAIL-ROUTINE-WRITE. NC1364.2 +031500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1364.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1364.2 +031700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1364.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1364.2 +032000 GO TO FAIL-ROUTINE-EX. NC1364.2 +032100 FAIL-ROUTINE-WRITE. NC1364.2 +032200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1364.2 +032300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1364.2 +032400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1364.2 +032500 MOVE SPACES TO COR-ANSI-REFERENCE. NC1364.2 +032600 FAIL-ROUTINE-EX. EXIT. NC1364.2 +032700 BAIL-OUT. NC1364.2 +032800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1364.2 +032900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1364.2 +033000 BAIL-OUT-WRITE. NC1364.2 +033100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1364.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1364.2 +033300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1364.2 +033400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1364.2 +033500 BAIL-OUT-EX. EXIT. NC1364.2 +033600 CCVS1-EXIT. NC1364.2 +033700 EXIT. NC1364.2 +033800 SECT-NC136A-001 SECTION. NC1364.2 +033900 NC136-001. NC1364.2 +034000 NC1364.2 +034100 BUILD-LEVEL-1. NC1364.2 +034200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1364.2 +034300 ADD 1 TO SUB-1. NC1364.2 +034400 IF SUB-1 EQUAL TO 11 GO TO CHECK-ENTRIES. NC1364.2 +034500 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC1364.2 +034600 ADD 1 TO ADD-GRP. NC1364.2 +034700 NC1364.2 +034800 BUILD-LEVEL-2. NC1364.2 +034900 ADD 1 TO SUB-2. NC1364.2 +035000 IF SUB-2 EQUAL TO 11 NC1364.2 +035100 MOVE ZERO TO SUB-2 NC1364.2 +035200 MOVE 01 TO ADD-SEC NC1364.2 +035300 GO TO BUILD-LEVEL-1. NC1364.2 +035400 MOVE SUB-1 TO SEC-GRP. NC1364.2 +035500 MOVE SEC-NAME TO ENTRY-2 (SUB-1 SUB-2). NC1364.2 +035600 ADD 1 TO ADD-SEC. NC1364.2 +035700 NC1364.2 +035800 BUILD-LEVEL-3. NC1364.2 +035900 ADD 1 TO SUB-3. NC1364.2 +036000 IF SUB-3 EQUAL TO 11 NC1364.2 +036100 MOVE ZERO TO SUB-3 NC1364.2 +036200 MOVE 01 TO ADD-ELEM NC1364.2 +036300 GO TO BUILD-LEVEL-2. NC1364.2 +036400 MOVE SUB-1 TO ELEM-GRP. NC1364.2 +036500 MOVE SUB-2 TO ELEM-SEC. NC1364.2 +036600 MOVE ELEM-NAME TO ENTRY-3 (SUB-1 SUB-2 SUB-3). NC1364.2 +036700 ADD 1 TO ADD-ELEM. NC1364.2 +036800 GO TO BUILD-LEVEL-3. NC1364.2 +036900 NC1364.2 +037000 CHECK-ENTRIES. NC1364.2 +037100 MOVE "LEVEL 1 TBL SUBSCRPT" TO FEATURE. NC1364.2 +037200 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC1364.2 +037300 IF ENTRY-1 (5) IS NOT EQUAL TO "GRP05" NC1364.2 +037400 MOVE "GRP05" TO CORRECT-A NC1364.2 +037500 MOVE ENTRY-1 (5) TO COMPUTED-A NC1364.2 +037600 NC1364.2 +037700 MOVE "NUMERIC LITERAL SUBSCRIPT " TO RE-MARK NC1364.2 +037800 PERFORM FAIL NC1364.2 +037900 GO TO TEST-1-WRITE. NC1364.2 +038000 NC1364.2 +038100 PERFORM PASS. NC1364.2 +038200 TEST-1-WRITE. NC1364.2 +038300 PERFORM PRINT-DETAIL. NC1364.2 +038400 NC1364.2 +038500 TEST-1-2. NC1364.2 +038600 MOVE "TEST-1-2 " TO PAR-NAME. NC1364.2 +038700 IF ENTRY-1 (CON-5) IS NOT EQUAL TO "GRP05" NC1364.2 +038800 MOVE "GRP05" TO CORRECT-A NC1364.2 +038900 MOVE ENTRY-1 (CON-5) TO COMPUTED-A NC1364.2 +039000 NC1364.2 +039100 MOVE "NUMERIC CONSTANT SUBSCRIPT " TO RE-MARK NC1364.2 +039200 PERFORM FAIL NC1364.2 +039300 GO TO TEST-1-2-WRITE. NC1364.2 +039400 NC1364.2 +039500 PERFORM PASS. NC1364.2 +039600 TEST-1-2-WRITE. NC1364.2 +039700 PERFORM PRINT-DETAIL. NC1364.2 +039800 NC1364.2 +039900 TEST-2. NC1364.2 +040000 MOVE "LEVEL 2 TBL SUBSCRPT" TO FEATURE. NC1364.2 +040100 MOVE "TEST-2 " TO PAR-NAME. NC1364.2 +040200 IF ENTRY-2 (5 6) IS NOT EQUAL TO "SEC (05 06)" NC1364.2 +040300 MOVE "SEC (05 06)" TO CORRECT-A NC1364.2 +040400 MOVE ENTRY-2 (5 6) TO COMPUTED-A NC1364.2 +040500 NC1364.2 +040600 MOVE "NUMERIC LITERAL SUBSCRIPT " TO RE-MARK NC1364.2 +040700 PERFORM FAIL NC1364.2 +040800 GO TO TEST-2-WRITE. NC1364.2 +040900 NC1364.2 +041000 PERFORM PASS. NC1364.2 +041100 TEST-2-WRITE. NC1364.2 +041200 PERFORM PRINT-DETAIL. NC1364.2 +041300 NC1364.2 +041400 TEST-2-2. NC1364.2 +041500 MOVE "TEST-2-2 " TO PAR-NAME. NC1364.2 +041600 IF ENTRY-2 (05 CON-6) IS NOT EQUAL TO "SEC (05 06)" NC1364.2 +041700 MOVE "SEC (05 06)" TO CORRECT-A NC1364.2 +041800 MOVE ENTRY-2 (05 CON-6) TO COMPUTED-A NC1364.2 +041900 NC1364.2 +042000 MOVE "NUM LITRL/CONSTANT SUBSCRPT" TO RE-MARK NC1364.2 +042100 PERFORM FAIL NC1364.2 +042200 GO TO TEST-2-2-WRITE. NC1364.2 +042300 NC1364.2 +042400 PERFORM PASS. NC1364.2 +042500 TEST-2-2-WRITE. NC1364.2 +042600 PERFORM PRINT-DETAIL. NC1364.2 +042700 NC1364.2 +042800 TEST-2-3. NC1364.2 +042900 MOVE "TEST-2-3 " TO PAR-NAME. NC1364.2 +043000 IF ENTRY-2 (CON-5 CON-6) IS NOT EQUAL TO "SEC (05 06)" NC1364.2 +043100 MOVE "SEC (05 06)" TO CORRECT-A NC1364.2 +043200 MOVE ENTRY-2 (CON-5 CON-6) TO COMPUTED-A NC1364.2 +043300 NC1364.2 +043400 MOVE "2 NUMERIC CONSTANT SUBSCRPT" TO RE-MARK NC1364.2 +043500 PERFORM FAIL NC1364.2 +043600 GO TO TEST-2-3-WRITE. NC1364.2 +043700 NC1364.2 +043800 PERFORM PASS. NC1364.2 +043900 TEST-2-3-WRITE. NC1364.2 +044000 PERFORM PRINT-DETAIL. NC1364.2 +044100 NC1364.2 +044200 TEST-3. NC1364.2 +044300 MOVE "LEVEL 3 TBL SUBSCRPT" TO FEATURE. NC1364.2 +044400 MOVE "TEST-3 " TO PAR-NAME. NC1364.2 +044500 IF ENTRY-3 (10 05 06) IS NOT EQUAL TO "ELEM (10 05 06)" NC1364.2 +044600 MOVE "ELEM (10 05 06)" TO CORRECT-A NC1364.2 +044700 MOVE ENTRY-3 (10 05 06) TO COMPUTED-A NC1364.2 +044800 NC1364.2 +044900 MOVE "3 NUMERIC LITERAL SUBSCRPTS" TO RE-MARK NC1364.2 +045000 PERFORM FAIL NC1364.2 +045100 GO TO TEST-3-WRITE. NC1364.2 +045200 NC1364.2 +045300 PERFORM PASS. NC1364.2 +045400 TEST-3-WRITE. NC1364.2 +045500 PERFORM PRINT-DETAIL. NC1364.2 +045600 NC1364.2 +045700 TEST-3-2. NC1364.2 +045800 MOVE "TEST-3-2 " TO PAR-NAME. NC1364.2 +045900 IF ENTRY-3 (10 CON-5 CON-6) IS NOT EQUAL TO NC1364.2 +046000 "ELEM (10 05 06)" NC1364.2 +046100 MOVE "ELEM (10 05 06)" TO CORRECT-A NC1364.2 +046200 MOVE ENTRY-3 (10 CON-5 CON-6) TO COMPUTED-A NC1364.2 +046300 NC1364.2 +046400 MOVE "1 NUM LTRL/2 CONSTANT SUBS " TO RE-MARK NC1364.2 +046500 PERFORM FAIL NC1364.2 +046600 GO TO TEST-3-2-WRITE. NC1364.2 +046700 NC1364.2 +046800 PERFORM PASS. NC1364.2 +046900 TEST-3-2-WRITE. NC1364.2 +047000 PERFORM PRINT-DETAIL. NC1364.2 +047100 NC1364.2 +047200 TEST-3-3. NC1364.2 +047300 MOVE "TEST-3-3 " TO PAR-NAME. NC1364.2 +047400 IF ENTRY-3 (CON-10 CON-5 CON-6) IS NOT EQUAL TO NC1364.2 +047500 "ELEM (10 05 06)" MOVE "ELEM (10 05 06)" TO CORRECT-A NC1364.2 +047600 MOVE ENTRY-3 (CON-10 CON-5 CON-6) TO COMPUTED-A NC1364.2 +047700 NC1364.2 +047800 MOVE "3 NUMERIC CONSTANT SUBSCRPT" TO RE-MARK NC1364.2 +047900 PERFORM FAIL NC1364.2 +048000 GO TO END-3LEVEL-SUBSCRPT-TEST. NC1364.2 +048100 NC1364.2 +048200 PERFORM PASS. NC1364.2 +048300 GO TO END-3LEVEL-SUBSCRPT-TEST. NC1364.2 +048400 NC1364.2 +048500 END-3LEVEL-SUBSCRPT-TEST. NC1364.2 +048600 PERFORM PRINT-DETAIL. NC1364.2 +048700 CCVS-EXIT SECTION. NC1364.2 +048800 CCVS-999999. NC1364.2 +048900 GO TO CLOSE-FILES. NC1364.2 diff --git a/tests/cobol85/NC/NC137A.CBL b/tests/cobol85/NC/NC137A.CBL new file mode 100755 index 00000000..9aee393e --- /dev/null +++ b/tests/cobol85/NC/NC137A.CBL @@ -0,0 +1,503 @@ +000100 IDENTIFICATION DIVISION. NC1374.2 +000200 PROGRAM-ID. NC1374.2 +000300 NC137A. NC1374.2 +000400**************************************************************** NC1374.2 +000500* * NC1374.2 +000600* VALIDATION FOR:- * NC1374.2 +000700* * NC1374.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1374.2 +000900* * NC1374.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1374.2 +001100* * NC1374.2 +001200**************************************************************** NC1374.2 +001300* * NC1374.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1374.2 +001500* * NC1374.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1374.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1374.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1374.2 +001900* * NC1374.2 +002000**************************************************************** NC1374.2 +002100* NC1374.2 +002200* PROGRAM NC137A VERIFIES THE ACCURACY OF BUILDING AND NC1374.2 +002300* ACCESSING A 3 DIMENSIONAL TABLE USING INDEXES. NC1374.2 +002400* NC1374.2 +002500 ENVIRONMENT DIVISION. NC1374.2 +002600 CONFIGURATION SECTION. NC1374.2 +002700 SOURCE-COMPUTER. NC1374.2 +002800 Linux. NC1374.2 +002900 OBJECT-COMPUTER. NC1374.2 +003000 Linux. NC1374.2 +003100 INPUT-OUTPUT SECTION. NC1374.2 +003200 FILE-CONTROL. NC1374.2 +003300 SELECT PRINT-FILE ASSIGN TO NC1374.2 +003400 "report.log". NC1374.2 +003500 DATA DIVISION. NC1374.2 +003600 FILE SECTION. NC1374.2 +003700 FD PRINT-FILE. NC1374.2 +003800 01 PRINT-REC PICTURE X(120). NC1374.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC1374.2 +004000 WORKING-STORAGE SECTION. NC1374.2 +004100 77 SUB-1 PICTURE S99 VALUE ZERO. NC1374.2 +004200 77 SUB-2 PICTURE 99 VALUE ZERO. NC1374.2 +004300 77 SUB-3 PICTURE 99 VALUE ZERO. NC1374.2 +004400 77 CON-7 PICTURE 99 VALUE 07. NC1374.2 +004500 77 CON-10 PICTURE 99 VALUE 10. NC1374.2 +004600 77 CON-5 PICTURE 99 VALUE 05. NC1374.2 +004700 77 CON-6 PICTURE 99 VALUE 06. NC1374.2 +004800 01 GRP-NAME. NC1374.2 +004900 02 FILLER PICTURE XXX VALUE "GRP". NC1374.2 +005000 02 ADD-GRP PICTURE 99 VALUE 01. NC1374.2 +005100 NC1374.2 +005200 01 SEC-NAME. NC1374.2 +005300 02 FILLER PICTURE X(5) VALUE "SEC (". NC1374.2 +005400 02 SEC-GRP PICTURE 99 VALUE 00. NC1374.2 +005500 02 FILLER PICTURE X VALUE " ". NC1374.2 +005600 02 ADD-SEC PICTURE 99 VALUE 01. NC1374.2 +005700 02 FILLER PICTURE X VALUE ")". NC1374.2 +005800 NC1374.2 +005900 01 ELEM-NAME. NC1374.2 +006000 02 FILLER PICTURE X(6) VALUE "ELEM (". NC1374.2 +006100 02 ELEM-GRP PICTURE 99 VALUE 00. NC1374.2 +006200 02 FILLER PICTURE X VALUE " ". NC1374.2 +006300 02 ELEM-SEC PICTURE 99 VALUE 00. NC1374.2 +006400 02 FILLER PICTURE X VALUE " ". NC1374.2 +006500 02 ADD-ELEM PICTURE 99 VALUE 01. NC1374.2 +006600 02 FILLER PICTURE X VALUE ")". NC1374.2 +006700 NC1374.2 +006800 01 THREE-DIMENSION-TBL. NC1374.2 +006900 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC1374.2 +007000 03 ENTRY-1 PICTURE X(5). NC1374.2 +007100 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC1374.2 +007200 04 ENTRY-2 PICTURE X(11). NC1374.2 +007300 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC1374.2 +007400 05 ENTRY-3 PICTURE X(15). NC1374.2 +007500 NC1374.2 +007600 01 TEST-RESULTS. NC1374.2 +007700 02 FILLER PIC X VALUE SPACE. NC1374.2 +007800 02 FEATURE PIC X(20) VALUE SPACE. NC1374.2 +007900 02 FILLER PIC X VALUE SPACE. NC1374.2 +008000 02 P-OR-F PIC X(5) VALUE SPACE. NC1374.2 +008100 02 FILLER PIC X VALUE SPACE. NC1374.2 +008200 02 PAR-NAME. NC1374.2 +008300 03 FILLER PIC X(19) VALUE SPACE. NC1374.2 +008400 03 PARDOT-X PIC X VALUE SPACE. NC1374.2 +008500 03 DOTVALUE PIC 99 VALUE ZERO. NC1374.2 +008600 02 FILLER PIC X(8) VALUE SPACE. NC1374.2 +008700 02 RE-MARK PIC X(61). NC1374.2 +008800 01 TEST-COMPUTED. NC1374.2 +008900 02 FILLER PIC X(30) VALUE SPACE. NC1374.2 +009000 02 FILLER PIC X(17) VALUE NC1374.2 +009100 " COMPUTED=". NC1374.2 +009200 02 COMPUTED-X. NC1374.2 +009300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1374.2 +009400 03 COMPUTED-N REDEFINES COMPUTED-A NC1374.2 +009500 PIC -9(9).9(9). NC1374.2 +009600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1374.2 +009700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1374.2 +009800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1374.2 +009900 03 CM-18V0 REDEFINES COMPUTED-A. NC1374.2 +010000 04 COMPUTED-18V0 PIC -9(18). NC1374.2 +010100 04 FILLER PIC X. NC1374.2 +010200 03 FILLER PIC X(50) VALUE SPACE. NC1374.2 +010300 01 TEST-CORRECT. NC1374.2 +010400 02 FILLER PIC X(30) VALUE SPACE. NC1374.2 +010500 02 FILLER PIC X(17) VALUE " CORRECT =". NC1374.2 +010600 02 CORRECT-X. NC1374.2 +010700 03 CORRECT-A PIC X(20) VALUE SPACE. NC1374.2 +010800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1374.2 +010900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1374.2 +011000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1374.2 +011100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1374.2 +011200 03 CR-18V0 REDEFINES CORRECT-A. NC1374.2 +011300 04 CORRECT-18V0 PIC -9(18). NC1374.2 +011400 04 FILLER PIC X. NC1374.2 +011500 03 FILLER PIC X(2) VALUE SPACE. NC1374.2 +011600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1374.2 +011700 01 CCVS-C-1. NC1374.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1374.2 +011900- "SS PARAGRAPH-NAME NC1374.2 +012000- " REMARKS". NC1374.2 +012100 02 FILLER PIC X(20) VALUE SPACE. NC1374.2 +012200 01 CCVS-C-2. NC1374.2 +012300 02 FILLER PIC X VALUE SPACE. NC1374.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". NC1374.2 +012500 02 FILLER PIC X(15) VALUE SPACE. NC1374.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". NC1374.2 +012700 02 FILLER PIC X(94) VALUE SPACE. NC1374.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1374.2 +012900 01 REC-CT PIC 99 VALUE ZERO. NC1374.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1374.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1374.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1374.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1374.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1374.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1374.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1374.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1374.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1374.2 +013900 01 CCVS-H-1. NC1374.2 +014000 02 FILLER PIC X(39) VALUE SPACES. NC1374.2 +014100 02 FILLER PIC X(42) VALUE NC1374.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1374.2 +014300 02 FILLER PIC X(39) VALUE SPACES. NC1374.2 +014400 01 CCVS-H-2A. NC1374.2 +014500 02 FILLER PIC X(40) VALUE SPACE. NC1374.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1374.2 +014700 02 FILLER PIC XXXX VALUE NC1374.2 +014800 "4.2 ". NC1374.2 +014900 02 FILLER PIC X(28) VALUE NC1374.2 +015000 " COPY - NOT FOR DISTRIBUTION". NC1374.2 +015100 02 FILLER PIC X(41) VALUE SPACE. NC1374.2 +015200 NC1374.2 +015300 01 CCVS-H-2B. NC1374.2 +015400 02 FILLER PIC X(15) VALUE NC1374.2 +015500 "TEST RESULT OF ". NC1374.2 +015600 02 TEST-ID PIC X(9). NC1374.2 +015700 02 FILLER PIC X(4) VALUE NC1374.2 +015800 " IN ". NC1374.2 +015900 02 FILLER PIC X(12) VALUE NC1374.2 +016000 " HIGH ". NC1374.2 +016100 02 FILLER PIC X(22) VALUE NC1374.2 +016200 " LEVEL VALIDATION FOR ". NC1374.2 +016300 02 FILLER PIC X(58) VALUE NC1374.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1374.2 +016500 01 CCVS-H-3. NC1374.2 +016600 02 FILLER PIC X(34) VALUE NC1374.2 +016700 " FOR OFFICIAL USE ONLY ". NC1374.2 +016800 02 FILLER PIC X(58) VALUE NC1374.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1374.2 +017000 02 FILLER PIC X(28) VALUE NC1374.2 +017100 " COPYRIGHT 1985 ". NC1374.2 +017200 01 CCVS-E-1. NC1374.2 +017300 02 FILLER PIC X(52) VALUE SPACE. NC1374.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1374.2 +017500 02 ID-AGAIN PIC X(9). NC1374.2 +017600 02 FILLER PIC X(45) VALUE SPACES. NC1374.2 +017700 01 CCVS-E-2. NC1374.2 +017800 02 FILLER PIC X(31) VALUE SPACE. NC1374.2 +017900 02 FILLER PIC X(21) VALUE SPACE. NC1374.2 +018000 02 CCVS-E-2-2. NC1374.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1374.2 +018200 03 FILLER PIC X VALUE SPACE. NC1374.2 +018300 03 ENDER-DESC PIC X(44) VALUE NC1374.2 +018400 "ERRORS ENCOUNTERED". NC1374.2 +018500 01 CCVS-E-3. NC1374.2 +018600 02 FILLER PIC X(22) VALUE NC1374.2 +018700 " FOR OFFICIAL USE ONLY". NC1374.2 +018800 02 FILLER PIC X(12) VALUE SPACE. NC1374.2 +018900 02 FILLER PIC X(58) VALUE NC1374.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1374.2 +019100 02 FILLER PIC X(13) VALUE SPACE. NC1374.2 +019200 02 FILLER PIC X(15) VALUE NC1374.2 +019300 " COPYRIGHT 1985". NC1374.2 +019400 01 CCVS-E-4. NC1374.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1374.2 +019600 02 FILLER PIC X(4) VALUE " OF ". NC1374.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1374.2 +019800 02 FILLER PIC X(40) VALUE NC1374.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". NC1374.2 +020000 01 XXINFO. NC1374.2 +020100 02 FILLER PIC X(19) VALUE NC1374.2 +020200 "*** INFORMATION ***". NC1374.2 +020300 02 INFO-TEXT. NC1374.2 +020400 04 FILLER PIC X(8) VALUE SPACE. NC1374.2 +020500 04 XXCOMPUTED PIC X(20). NC1374.2 +020600 04 FILLER PIC X(5) VALUE SPACE. NC1374.2 +020700 04 XXCORRECT PIC X(20). NC1374.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). NC1374.2 +020900 01 HYPHEN-LINE. NC1374.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. NC1374.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************NC1374.2 +021200- "*****************************************". NC1374.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************NC1374.2 +021400- "******************************". NC1374.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE NC1374.2 +021600 "NC137A". NC1374.2 +021700 PROCEDURE DIVISION. NC1374.2 +021800 CCVS1 SECTION. NC1374.2 +021900 OPEN-FILES. NC1374.2 +022000 OPEN OUTPUT PRINT-FILE. NC1374.2 +022100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1374.2 +022200 MOVE SPACE TO TEST-RESULTS. NC1374.2 +022300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1374.2 +022400 GO TO CCVS1-EXIT. NC1374.2 +022500 CLOSE-FILES. NC1374.2 +022600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1374.2 +022700 TERMINATE-CCVS. NC1374.2 +022800*S EXIT PROGRAM. NC1374.2 +022900*SERMINATE-CALL. NC1374.2 +023000 STOP RUN. NC1374.2 +023100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1374.2 +023200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1374.2 +023300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1374.2 +023400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1374.2 +023500 MOVE "****TEST DELETED****" TO RE-MARK. NC1374.2 +023600 PRINT-DETAIL. NC1374.2 +023700 IF REC-CT NOT EQUAL TO ZERO NC1374.2 +023800 MOVE "." TO PARDOT-X NC1374.2 +023900 MOVE REC-CT TO DOTVALUE. NC1374.2 +024000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1374.2 +024100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1374.2 +024200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1374.2 +024300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1374.2 +024400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1374.2 +024500 MOVE SPACE TO CORRECT-X. NC1374.2 +024600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1374.2 +024700 MOVE SPACE TO RE-MARK. NC1374.2 +024800 HEAD-ROUTINE. NC1374.2 +024900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +025000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +025100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1374.2 +025200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1374.2 +025300 COLUMN-NAMES-ROUTINE. NC1374.2 +025400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +025500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +025700 END-ROUTINE. NC1374.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1374.2 +025900 END-RTN-EXIT. NC1374.2 +026000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +026100 END-ROUTINE-1. NC1374.2 +026200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1374.2 +026300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1374.2 +026400 ADD PASS-COUNTER TO ERROR-HOLD. NC1374.2 +026500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1374.2 +026600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1374.2 +026700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1374.2 +026800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1374.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1374.2 +027000 END-ROUTINE-12. NC1374.2 +027100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1374.2 +027200 IF ERROR-COUNTER IS EQUAL TO ZERO NC1374.2 +027300 MOVE "NO " TO ERROR-TOTAL NC1374.2 +027400 ELSE NC1374.2 +027500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1374.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1374.2 +027700 PERFORM WRITE-LINE. NC1374.2 +027800 END-ROUTINE-13. NC1374.2 +027900 IF DELETE-COUNTER IS EQUAL TO ZERO NC1374.2 +028000 MOVE "NO " TO ERROR-TOTAL ELSE NC1374.2 +028100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1374.2 +028200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1374.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +028400 IF INSPECT-COUNTER EQUAL TO ZERO NC1374.2 +028500 MOVE "NO " TO ERROR-TOTAL NC1374.2 +028600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1374.2 +028700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1374.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +028900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1374.2 +029000 WRITE-LINE. NC1374.2 +029100 ADD 1 TO RECORD-COUNT. NC1374.2 +029200 IF RECORD-COUNT GREATER 42 NC1374.2 +029300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1374.2 +029400 MOVE SPACE TO DUMMY-RECORD NC1374.2 +029500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1374.2 +029600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1374.2 +029700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1374.2 +029800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1374.2 +029900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1374.2 +030000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1374.2 +030100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1374.2 +030200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1374.2 +030300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1374.2 +030400 MOVE ZERO TO RECORD-COUNT. NC1374.2 +030500 PERFORM WRT-LN. NC1374.2 +030600 WRT-LN. NC1374.2 +030700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1374.2 +030800 MOVE SPACE TO DUMMY-RECORD. NC1374.2 +030900 BLANK-LINE-PRINT. NC1374.2 +031000 PERFORM WRT-LN. NC1374.2 +031100 FAIL-ROUTINE. NC1374.2 +031200 IF COMPUTED-X NOT EQUAL TO SPACE NC1374.2 +031300 GO TO FAIL-ROUTINE-WRITE. NC1374.2 +031400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1374.2 +031500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1374.2 +031600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1374.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1374.2 +031900 GO TO FAIL-ROUTINE-EX. NC1374.2 +032000 FAIL-ROUTINE-WRITE. NC1374.2 +032100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1374.2 +032200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1374.2 +032300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1374.2 +032400 MOVE SPACES TO COR-ANSI-REFERENCE. NC1374.2 +032500 FAIL-ROUTINE-EX. EXIT. NC1374.2 +032600 BAIL-OUT. NC1374.2 +032700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1374.2 +032800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1374.2 +032900 BAIL-OUT-WRITE. NC1374.2 +033000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1374.2 +033100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1374.2 +033200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1374.2 +033300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1374.2 +033400 BAIL-OUT-EX. EXIT. NC1374.2 +033500 CCVS1-EXIT. NC1374.2 +033600 EXIT. NC1374.2 +033700 SECT-NC137A-001 SECTION. NC1374.2 +033800 NC137A-001. NC1374.2 +033900 NC1374.2 +034000 BUILD-LEVEL-1. NC1374.2 +034100 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1374.2 +034200 ADD 1 TO SUB-1. NC1374.2 +034300 IF SUB-1 EQUAL TO 11 GO TO CHECK-ENTRIES. NC1374.2 +034400 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC1374.2 +034500 ADD 1 TO ADD-GRP. NC1374.2 +034600 NC1374.2 +034700 BUILD-LEVEL-2. NC1374.2 +034800 ADD 1 TO SUB-2. NC1374.2 +034900 IF SUB-2 EQUAL TO 11 NC1374.2 +035000 MOVE ZERO TO SUB-2 NC1374.2 +035100 MOVE 01 TO ADD-SEC NC1374.2 +035200 GO TO BUILD-LEVEL-1. NC1374.2 +035300 MOVE SUB-1 TO SEC-GRP. NC1374.2 +035400 MOVE SEC-NAME TO ENTRY-2 (SUB-1 SUB-2). NC1374.2 +035500 ADD 1 TO ADD-SEC. NC1374.2 +035600 NC1374.2 +035700 BUILD-LEVEL-3. NC1374.2 +035800 ADD 1 TO SUB-3. NC1374.2 +035900 IF SUB-3 EQUAL TO 11 NC1374.2 +036000 MOVE ZERO TO SUB-3 NC1374.2 +036100 MOVE 01 TO ADD-ELEM NC1374.2 +036200 GO TO BUILD-LEVEL-2. NC1374.2 +036300 MOVE SUB-1 TO ELEM-GRP. NC1374.2 +036400 MOVE SUB-2 TO ELEM-SEC. NC1374.2 +036500 MOVE ELEM-NAME TO ENTRY-3 (SUB-1 SUB-2 SUB-3). NC1374.2 +036600 ADD 1 TO ADD-ELEM. NC1374.2 +036700 GO TO BUILD-LEVEL-3. NC1374.2 +036800 NC1374.2 +036900 CHECK-ENTRIES. NC1374.2 +037000 MOVE "LEVEL 1 INT INDEXING" TO FEATURE. NC1374.2 +037100 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC1374.2 +037200 SET IDX-1 TO 5. NC1374.2 +037300 IF ENTRY-1 (IDX-1) IS NOT EQUAL TO "GRP05" NC1374.2 +037400 MOVE "GRP05" TO CORRECT-A NC1374.2 +037500 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A NC1374.2 +037600 NC1374.2 +037700 MOVE "INTERNAL INDEXING LEVEL 1 " TO RE-MARK NC1374.2 +037800 PERFORM FAIL NC1374.2 +037900 GO TO TEST-1-WRITE. NC1374.2 +038000 NC1374.2 +038100 PERFORM PASS. NC1374.2 +038200 TEST-1-WRITE. NC1374.2 +038300 PERFORM PRINT-DETAIL. NC1374.2 +038400 NC1374.2 +038500 TEST-1-2. NC1374.2 +038600 MOVE "TEST-1-2 " TO PAR-NAME. NC1374.2 +038700 SET IDX-1 TO 8. NC1374.2 +038800 IF ENTRY-1 (IDX-1) IS NOT EQUAL TO "GRP08" NC1374.2 +038900 MOVE "GRP08" TO CORRECT-A NC1374.2 +039000 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A NC1374.2 +039100 NC1374.2 +039200 MOVE "INTERNAL INDEXING LEVEL 1 " TO RE-MARK NC1374.2 +039300 PERFORM FAIL NC1374.2 +039400 GO TO TEST-1-2-WRITE. NC1374.2 +039500 NC1374.2 +039600 PERFORM PASS. NC1374.2 +039700 TEST-1-2-WRITE. NC1374.2 +039800 PERFORM PRINT-DETAIL. NC1374.2 +039900 NC1374.2 +040000 TEST-2. NC1374.2 +040100 MOVE "LEVEL 2 INT INDEXING" TO FEATURE. NC1374.2 +040200 MOVE "TEST-2 " TO PAR-NAME. NC1374.2 +040300 SET IDX-1 TO 5. NC1374.2 +040400 SET IDX-2 TO 6. NC1374.2 +040500 IF ENTRY-2 (IDX-1 IDX-2) IS NOT EQUAL TO "SEC (05 06)" NC1374.2 +040600 MOVE "SEC (05 06)" TO CORRECT-A NC1374.2 +040700 MOVE ENTRY-2 (IDX-1 IDX-2) TO COMPUTED-A NC1374.2 +040800 NC1374.2 +040900 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC1374.2 +041000 PERFORM FAIL NC1374.2 +041100 GO TO TEST-2-WRITE. NC1374.2 +041200 NC1374.2 +041300 PERFORM PASS. NC1374.2 +041400 TEST-2-WRITE. NC1374.2 +041500 PERFORM PRINT-DETAIL. NC1374.2 +041600 NC1374.2 +041700 TEST-2-2. NC1374.2 +041800 MOVE "TEST-2-2 " TO PAR-NAME. NC1374.2 +041900 SET IDX-1 IDX-2 TO 8. NC1374.2 +042000 IF ENTRY-2 (IDX-1 IDX-2) IS NOT EQUAL TO "SEC (08 08)" NC1374.2 +042100 MOVE "SEC (08 08)" TO CORRECT-A NC1374.2 +042200 MOVE ENTRY-2 (IDX-1 IDX-2) TO COMPUTED-A NC1374.2 +042300 NC1374.2 +042400 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC1374.2 +042500 PERFORM FAIL NC1374.2 +042600 GO TO TEST-2-2-WRITE. NC1374.2 +042700 NC1374.2 +042800 PERFORM PASS. NC1374.2 +042900 TEST-2-2-WRITE. NC1374.2 +043000 PERFORM PRINT-DETAIL. NC1374.2 +043100 NC1374.2 +043200 TEST-2-3. NC1374.2 +043300 MOVE "TEST-2-3 " TO PAR-NAME. NC1374.2 +043400 SET IDX-1 TO 3. NC1374.2 +043500 SET IDX-2 TO 7. NC1374.2 +043600 IF ENTRY-2 (IDX-1 IDX-2) IS NOT EQUAL TO "SEC (03 07)" NC1374.2 +043700 MOVE "SEC (03 07)" TO CORRECT-A NC1374.2 +043800 MOVE ENTRY-2 (IDX-1 IDX-2) TO COMPUTED-A NC1374.2 +043900 NC1374.2 +044000 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC1374.2 +044100 PERFORM FAIL NC1374.2 +044200 GO TO TEST-2-3-WRITE. NC1374.2 +044300 NC1374.2 +044400 PERFORM PASS. NC1374.2 +044500 TEST-2-3-WRITE. NC1374.2 +044600 PERFORM PRINT-DETAIL. NC1374.2 +044700 NC1374.2 +044800 TEST-3. NC1374.2 +044900 MOVE "LEVEL 3 INT INDEXING" TO FEATURE. NC1374.2 +045000 MOVE "TEST-3 " TO PAR-NAME. NC1374.2 +045100 SET IDX-1 TO 2. NC1374.2 +045200 SET IDX-2 TO 6. NC1374.2 +045300 SET IDX-3 TO 10. NC1374.2 +045400 IF ENTRY-3 (IDX-1 IDX-2 IDX-3) IS NOT EQUAL TO NC1374.2 +045500 "ELEM (02 06 10)" NC1374.2 +045600 MOVE "ELEM (02 06 10)" TO CORRECT-A NC1374.2 +045700 MOVE ENTRY-3 (IDX-1 IDX-2 IDX-3) TO COMPUTED-A NC1374.2 +045800 NC1374.2 +045900 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC1374.2 +046000 PERFORM FAIL NC1374.2 +046100 GO TO TEST-3-WRITE. NC1374.2 +046200 NC1374.2 +046300 PERFORM PASS. NC1374.2 +046400 TEST-3-WRITE. NC1374.2 +046500 PERFORM PRINT-DETAIL. NC1374.2 +046600 NC1374.2 +046700 TEST-3-2. NC1374.2 +046800 MOVE "TEST-3-2 " TO PAR-NAME. NC1374.2 +046900 SET IDX-1 IDX-2 IDX-3 TO 6. NC1374.2 +047000 IF ENTRY-3 (IDX-1 IDX-2 IDX-3) IS NOT EQUAL TO NC1374.2 +047100 "ELEM (06 06 06)" NC1374.2 +047200 MOVE "ELEM (06 06 06)" TO CORRECT-A NC1374.2 +047300 MOVE ENTRY-3 (IDX-1 IDX-2 IDX-3) TO COMPUTED-A NC1374.2 +047400 NC1374.2 +047500 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC1374.2 +047600 PERFORM FAIL NC1374.2 +047700 GO TO TEST-3-2-WRITE. NC1374.2 +047800 NC1374.2 +047900 PERFORM PASS. NC1374.2 +048000 TEST-3-2-WRITE. NC1374.2 +048100 PERFORM PRINT-DETAIL. NC1374.2 +048200 NC1374.2 +048300 TEST-3-3. NC1374.2 +048400 MOVE "TEST-3-3 " TO PAR-NAME. NC1374.2 +048500 SET IDX-1 TO 9. NC1374.2 +048600 SET IDX-2 TO 8. NC1374.2 +048700 SET IDX-3 TO 7. NC1374.2 +048800 IF ENTRY-3 (IDX-1 IDX-2 IDX-3) IS NOT EQUAL TO NC1374.2 +048900 "ELEM (09 08 07)" MOVE "ELEM (09 08 07)" TO CORRECT-A NC1374.2 +049000 MOVE ENTRY-3 (IDX-1 IDX-2 IDX-3) TO COMPUTED-A NC1374.2 +049100 NC1374.2 +049200 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC1374.2 +049300 PERFORM FAIL NC1374.2 +049400 GO TO END-3LEVEL-SUBSCRPT-TEST. NC1374.2 +049500 NC1374.2 +049600 PERFORM PASS. NC1374.2 +049700 GO TO END-3LEVEL-SUBSCRPT-TEST. NC1374.2 +049800 NC1374.2 +049900 END-3LEVEL-SUBSCRPT-TEST. NC1374.2 +050000 PERFORM PRINT-DETAIL. NC1374.2 +050100 CCVS-EXIT SECTION. NC1374.2 +050200 CCVS-999999. NC1374.2 +050300 GO TO CLOSE-FILES. NC1374.2 diff --git a/tests/cobol85/NC/NC138A.CBL b/tests/cobol85/NC/NC138A.CBL new file mode 100755 index 00000000..c593d743 --- /dev/null +++ b/tests/cobol85/NC/NC138A.CBL @@ -0,0 +1,654 @@ +000100 IDENTIFICATION DIVISION. NC1384.2 +000200 PROGRAM-ID. NC1384.2 +000300 NC138A. NC1384.2 +000400**************************************************************** NC1384.2 +000500* * NC1384.2 +000600* VALIDATION FOR:- * NC1384.2 +000700* * NC1384.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1384.2 +000900* * NC1384.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1384.2 +001100* * NC1384.2 +001200**************************************************************** NC1384.2 +001300* * NC1384.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1384.2 +001500* * NC1384.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1384.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1384.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1384.2 +001900* * NC1384.2 +002000**************************************************************** NC1384.2 +002100* NC1384.2 +002200* PROGRAM NC138A TESTS THE USE OF SPACES, COMMAS, NC1384.2 +002300* SEMI-COLONS AND LEFT AND RIGHT PARENTHESIS AS SEPARATORS NC1384.2 +002400* IN STATEMENTS WHICH REFERENCE TABLE ITEMS. NC1384.2 +002500* NC1384.2 +002600 ENVIRONMENT DIVISION. NC1384.2 +002700 CONFIGURATION SECTION. NC1384.2 +002800 SOURCE-COMPUTER. NC1384.2 +002900 Linux. NC1384.2 +003000 OBJECT-COMPUTER. NC1384.2 +003100 Linux. NC1384.2 +003200 INPUT-OUTPUT SECTION. NC1384.2 +003300 FILE-CONTROL. NC1384.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1384.2 +003500 "report.log". NC1384.2 +003600 DATA DIVISION. NC1384.2 +003700 FILE SECTION. NC1384.2 +003800 FD PRINT-FILE. NC1384.2 +003900 01 PRINT-REC PICTURE X(120). NC1384.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1384.2 +004100 WORKING-STORAGE SECTION. NC1384.2 +004200 77 WRK1 PIC S999 VALUE ZERO. NC1384.2 +004300 77 TEMP PIC S9(5). NC1384.2 +004400 77 EXPECTED-VALUE PIC S9(5). NC1384.2 +004500* SUBSCRIPTS FOR REFERENCING TABLE ITEMS. NC1384.2 +004600 77 S1 PIC S999 VALUE 1. NC1384.2 +004700 77 S21 PIC S999 VALUE 1. NC1384.2 +004800 77 S22 PIC S999 SIGN IS LEADING SEPARATE CHARACTER NC1384.2 +004900 VALUE 1. NC1384.2 +005000 77 S31 PIC S999 COMPUTATIONAL VALUE 1. NC1384.2 +005100 77 S32 PIC S999 SYNC LEFT VALUE 1. NC1384.2 +005200 77 S33 PIC S999 VALUE 1. NC1384.2 +005300* ONE DIMENSIONAL TABLE. NC1384.2 +005400 01 GRP-TAB1. NC1384.2 +005500 02 ELEM1 PIC 99 NC1384.2 +005600 OCCURS 60 TIMES. NC1384.2 +005700* TWO DIMENSIONAL TABLE, 12 BY 5. NC1384.2 +005800 01 GRP-TAP2. NC1384.2 +005900 02 GRP-LEV2-O012F OCCURS 12 TIMES. NC1384.2 +006000 03 ELEM2 PIC 9999 COMPUTATIONAL NC1384.2 +006100 OCCURS 5 TIMES. NC1384.2 +006200* THREE DIMENSIONAL TABLE, 4 BY 3 BY 5. NC1384.2 +006300 01 GRP-TAB3. NC1384.2 +006400 02 GRP-LEV2-00004F NC1384.2 +006500 OCCURS 4 TIMES NC1384.2 +006600 INDEXED BY WRK-IX-0001. NC1384.2 +006700 03 GRP-LEV3-O0003F OCCURS 3 TIMES. NC1384.2 +006800 04 ELEM3 PICTURE IS S999 NC1384.2 +006900 USAGE IS DISPLAY SIGN IS LEADING SEPARATE CHARACTER NC1384.2 +007000 OCCURS 5 TIMES. NC1384.2 +007100 01 TEST-RESULTS. NC1384.2 +007200 02 FILLER PIC X VALUE SPACE. NC1384.2 +007300 02 FEATURE PIC X(20) VALUE SPACE. NC1384.2 +007400 02 FILLER PIC X VALUE SPACE. NC1384.2 +007500 02 P-OR-F PIC X(5) VALUE SPACE. NC1384.2 +007600 02 FILLER PIC X VALUE SPACE. NC1384.2 +007700 02 PAR-NAME. NC1384.2 +007800 03 FILLER PIC X(19) VALUE SPACE. NC1384.2 +007900 03 PARDOT-X PIC X VALUE SPACE. NC1384.2 +008000 03 DOTVALUE PIC 99 VALUE ZERO. NC1384.2 +008100 02 FILLER PIC X(8) VALUE SPACE. NC1384.2 +008200 02 RE-MARK PIC X(61). NC1384.2 +008300 01 TEST-COMPUTED. NC1384.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC1384.2 +008500 02 FILLER PIC X(17) VALUE NC1384.2 +008600 " COMPUTED=". NC1384.2 +008700 02 COMPUTED-X. NC1384.2 +008800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1384.2 +008900 03 COMPUTED-N REDEFINES COMPUTED-A NC1384.2 +009000 PIC -9(9).9(9). NC1384.2 +009100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1384.2 +009200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1384.2 +009300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1384.2 +009400 03 CM-18V0 REDEFINES COMPUTED-A. NC1384.2 +009500 04 COMPUTED-18V0 PIC -9(18). NC1384.2 +009600 04 FILLER PIC X. NC1384.2 +009700 03 FILLER PIC X(50) VALUE SPACE. NC1384.2 +009800 01 TEST-CORRECT. NC1384.2 +009900 02 FILLER PIC X(30) VALUE SPACE. NC1384.2 +010000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1384.2 +010100 02 CORRECT-X. NC1384.2 +010200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1384.2 +010300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1384.2 +010400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1384.2 +010500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1384.2 +010600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1384.2 +010700 03 CR-18V0 REDEFINES CORRECT-A. NC1384.2 +010800 04 CORRECT-18V0 PIC -9(18). NC1384.2 +010900 04 FILLER PIC X. NC1384.2 +011000 03 FILLER PIC X(2) VALUE SPACE. NC1384.2 +011100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1384.2 +011200 01 CCVS-C-1. NC1384.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1384.2 +011400- "SS PARAGRAPH-NAME NC1384.2 +011500- " REMARKS". NC1384.2 +011600 02 FILLER PIC X(20) VALUE SPACE. NC1384.2 +011700 01 CCVS-C-2. NC1384.2 +011800 02 FILLER PIC X VALUE SPACE. NC1384.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". NC1384.2 +012000 02 FILLER PIC X(15) VALUE SPACE. NC1384.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". NC1384.2 +012200 02 FILLER PIC X(94) VALUE SPACE. NC1384.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1384.2 +012400 01 REC-CT PIC 99 VALUE ZERO. NC1384.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1384.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1384.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1384.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1384.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1384.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1384.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1384.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1384.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1384.2 +013400 01 CCVS-H-1. NC1384.2 +013500 02 FILLER PIC X(39) VALUE SPACES. NC1384.2 +013600 02 FILLER PIC X(42) VALUE NC1384.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1384.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC1384.2 +013900 01 CCVS-H-2A. NC1384.2 +014000 02 FILLER PIC X(40) VALUE SPACE. NC1384.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1384.2 +014200 02 FILLER PIC XXXX VALUE NC1384.2 +014300 "4.2 ". NC1384.2 +014400 02 FILLER PIC X(28) VALUE NC1384.2 +014500 " COPY - NOT FOR DISTRIBUTION". NC1384.2 +014600 02 FILLER PIC X(41) VALUE SPACE. NC1384.2 +014700 NC1384.2 +014800 01 CCVS-H-2B. NC1384.2 +014900 02 FILLER PIC X(15) VALUE NC1384.2 +015000 "TEST RESULT OF ". NC1384.2 +015100 02 TEST-ID PIC X(9). NC1384.2 +015200 02 FILLER PIC X(4) VALUE NC1384.2 +015300 " IN ". NC1384.2 +015400 02 FILLER PIC X(12) VALUE NC1384.2 +015500 " HIGH ". NC1384.2 +015600 02 FILLER PIC X(22) VALUE NC1384.2 +015700 " LEVEL VALIDATION FOR ". NC1384.2 +015800 02 FILLER PIC X(58) VALUE NC1384.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1384.2 +016000 01 CCVS-H-3. NC1384.2 +016100 02 FILLER PIC X(34) VALUE NC1384.2 +016200 " FOR OFFICIAL USE ONLY ". NC1384.2 +016300 02 FILLER PIC X(58) VALUE NC1384.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1384.2 +016500 02 FILLER PIC X(28) VALUE NC1384.2 +016600 " COPYRIGHT 1985 ". NC1384.2 +016700 01 CCVS-E-1. NC1384.2 +016800 02 FILLER PIC X(52) VALUE SPACE. NC1384.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1384.2 +017000 02 ID-AGAIN PIC X(9). NC1384.2 +017100 02 FILLER PIC X(45) VALUE SPACES. NC1384.2 +017200 01 CCVS-E-2. NC1384.2 +017300 02 FILLER PIC X(31) VALUE SPACE. NC1384.2 +017400 02 FILLER PIC X(21) VALUE SPACE. NC1384.2 +017500 02 CCVS-E-2-2. NC1384.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1384.2 +017700 03 FILLER PIC X VALUE SPACE. NC1384.2 +017800 03 ENDER-DESC PIC X(44) VALUE NC1384.2 +017900 "ERRORS ENCOUNTERED". NC1384.2 +018000 01 CCVS-E-3. NC1384.2 +018100 02 FILLER PIC X(22) VALUE NC1384.2 +018200 " FOR OFFICIAL USE ONLY". NC1384.2 +018300 02 FILLER PIC X(12) VALUE SPACE. NC1384.2 +018400 02 FILLER PIC X(58) VALUE NC1384.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1384.2 +018600 02 FILLER PIC X(13) VALUE SPACE. NC1384.2 +018700 02 FILLER PIC X(15) VALUE NC1384.2 +018800 " COPYRIGHT 1985". NC1384.2 +018900 01 CCVS-E-4. NC1384.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1384.2 +019100 02 FILLER PIC X(4) VALUE " OF ". NC1384.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1384.2 +019300 02 FILLER PIC X(40) VALUE NC1384.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1384.2 +019500 01 XXINFO. NC1384.2 +019600 02 FILLER PIC X(19) VALUE NC1384.2 +019700 "*** INFORMATION ***". NC1384.2 +019800 02 INFO-TEXT. NC1384.2 +019900 04 FILLER PIC X(8) VALUE SPACE. NC1384.2 +020000 04 XXCOMPUTED PIC X(20). NC1384.2 +020100 04 FILLER PIC X(5) VALUE SPACE. NC1384.2 +020200 04 XXCORRECT PIC X(20). NC1384.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). NC1384.2 +020400 01 HYPHEN-LINE. NC1384.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. NC1384.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************NC1384.2 +020700- "*****************************************". NC1384.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************NC1384.2 +020900- "******************************". NC1384.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE NC1384.2 +021100 "NC138A". NC1384.2 +021200 PROCEDURE DIVISION. NC1384.2 +021300 CCVS1 SECTION. NC1384.2 +021400 OPEN-FILES. NC1384.2 +021500 OPEN OUTPUT PRINT-FILE. NC1384.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1384.2 +021700 MOVE SPACE TO TEST-RESULTS. NC1384.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1384.2 +021900 GO TO CCVS1-EXIT. NC1384.2 +022000 CLOSE-FILES. NC1384.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1384.2 +022200 TERMINATE-CCVS. NC1384.2 +022300*S EXIT PROGRAM. NC1384.2 +022400*SERMINATE-CALL. NC1384.2 +022500 STOP RUN. NC1384.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1384.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1384.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1384.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1384.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. NC1384.2 +023100 PRINT-DETAIL. NC1384.2 +023200 IF REC-CT NOT EQUAL TO ZERO NC1384.2 +023300 MOVE "." TO PARDOT-X NC1384.2 +023400 MOVE REC-CT TO DOTVALUE. NC1384.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1384.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1384.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1384.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1384.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1384.2 +024000 MOVE SPACE TO CORRECT-X. NC1384.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1384.2 +024200 MOVE SPACE TO RE-MARK. NC1384.2 +024300 HEAD-ROUTINE. NC1384.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1384.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1384.2 +024800 COLUMN-NAMES-ROUTINE. NC1384.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +025200 END-ROUTINE. NC1384.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1384.2 +025400 END-RTN-EXIT. NC1384.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +025600 END-ROUTINE-1. NC1384.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1384.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1384.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. NC1384.2 +026000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1384.2 +026100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1384.2 +026200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1384.2 +026300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1384.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1384.2 +026500 END-ROUTINE-12. NC1384.2 +026600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1384.2 +026700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1384.2 +026800 MOVE "NO " TO ERROR-TOTAL NC1384.2 +026900 ELSE NC1384.2 +027000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1384.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1384.2 +027200 PERFORM WRITE-LINE. NC1384.2 +027300 END-ROUTINE-13. NC1384.2 +027400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1384.2 +027500 MOVE "NO " TO ERROR-TOTAL ELSE NC1384.2 +027600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1384.2 +027700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1384.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +027900 IF INSPECT-COUNTER EQUAL TO ZERO NC1384.2 +028000 MOVE "NO " TO ERROR-TOTAL NC1384.2 +028100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1384.2 +028200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1384.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +028400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1384.2 +028500 WRITE-LINE. NC1384.2 +028600 ADD 1 TO RECORD-COUNT. NC1384.2 +028700 IF RECORD-COUNT GREATER 42 NC1384.2 +028800 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1384.2 +028900 MOVE SPACE TO DUMMY-RECORD NC1384.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1384.2 +029100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1384.2 +029200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1384.2 +029300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1384.2 +029400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1384.2 +029500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1384.2 +029600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1384.2 +029700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1384.2 +029800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1384.2 +029900 MOVE ZERO TO RECORD-COUNT. NC1384.2 +030000 PERFORM WRT-LN. NC1384.2 +030100 WRT-LN. NC1384.2 +030200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1384.2 +030300 MOVE SPACE TO DUMMY-RECORD. NC1384.2 +030400 BLANK-LINE-PRINT. NC1384.2 +030500 PERFORM WRT-LN. NC1384.2 +030600 FAIL-ROUTINE. NC1384.2 +030700 IF COMPUTED-X NOT EQUAL TO SPACE NC1384.2 +030800 GO TO FAIL-ROUTINE-WRITE. NC1384.2 +030900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1384.2 +031000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1384.2 +031100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1384.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1384.2 +031400 GO TO FAIL-ROUTINE-EX. NC1384.2 +031500 FAIL-ROUTINE-WRITE. NC1384.2 +031600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1384.2 +031700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1384.2 +031800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1384.2 +031900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1384.2 +032000 FAIL-ROUTINE-EX. EXIT. NC1384.2 +032100 BAIL-OUT. NC1384.2 +032200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1384.2 +032300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1384.2 +032400 BAIL-OUT-WRITE. NC1384.2 +032500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1384.2 +032600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1384.2 +032700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1384.2 +032800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1384.2 +032900 BAIL-OUT-EX. EXIT. NC1384.2 +033000 CCVS1-EXIT. NC1384.2 +033100 EXIT. NC1384.2 +033200 SECT-NC138A-0001 SECTION. NC1384.2 +033300 NC138A-0001. NC1384.2 +033400 MOVE "IV-4 4.2.1" TO ANSI-REFERENCE. NC1384.2 +033500* THIS SECTION STORES THE NUMBERS 1 THROUGH 60 IN THE 3 TABLES.NC1384.2 +033600 MOVE-VALUE. NC1384.2 +033700 ADD 1 TO WRK1. NC1384.2 +033800 MOVE WRK1 TO ELEM1 (S1) ELEM2 (S21, S22) NC1384.2 +033900 ELEM3 (S31, S32, S33). NC1384.2 +034000 IF WRK1 EQUAL TO 60 GO TO SECT-TH109-0002. NC1384.2 +034100 INCRE-SUBS. NC1384.2 +034200 ADD 1 TO S1. NC1384.2 +034300 ADD 1 TO S22. NC1384.2 +034400 ADD 1 TO S33. NC1384.2 +034500 IF S22 LESS THAN 6 GO TO MOVE-VALUE. NC1384.2 +034600 MOVE 1 TO S22 S33. NC1384.2 +034700 ADD 1 TO S21. NC1384.2 +034800 ADD 1 TO S32. NC1384.2 +034900 IF S32 LESS THAN 4 GO TO MOVE-VALUE. NC1384.2 +035000 MOVE 1 TO S32. NC1384.2 +035100 ADD 1 TO S31. NC1384.2 +035200 GO TO MOVE-VALUE. NC1384.2 +035300 SECT-TH109-0002 SECTION. NC1384.2 +035400 SECT-0002-INIT. NC1384.2 +035500 MOVE "LEFT PAREN SEPARATOR" TO FEATURE. NC1384.2 +035600* THIS SECTION TESTS THE USE OF LEFT PARENTHESIS AS A NC1384.2 +035700* SEPARATOR IN REFERENCING TABLE ITEMS. NC1384.2 +035800 SEP-INIT-001. NC1384.2 +035900 MOVE 6 TO S1. NC1384.2 +036000 SEP-TEST-001. NC1384.2 +036100 IF ELEM1(S1) IS EQUAL TO 6 NC1384.2 +036200 PERFORM PASS NC1384.2 +036300 GO TO SEP-WRITE-001. NC1384.2 +036400 PERFORM FAIL. NC1384.2 +036500 GO TO SEP-FAIL-001. NC1384.2 +036600 SEP-DELETE-001. NC1384.2 +036700 PERFORM DE-LETE. NC1384.2 +036800 GO TO SEP-WRITE-001. NC1384.2 +036900 SEP-FAIL-001. NC1384.2 +037000 MOVE ELEM1 (S1) TO COMPUTED-18V0. NC1384.2 +037100 MOVE 6 TO CORRECT-18V0. NC1384.2 +037200 SEP-WRITE-001. NC1384.2 +037300 MOVE "SEP-TEST-001" TO PAR-NAME. NC1384.2 +037400 PERFORM PRINT-DETAIL. NC1384.2 +037500 SEP-INIT-002. NC1384.2 +037600 MOVE 2 TO S21 S22. NC1384.2 +037700 SEP-TEST-002. NC1384.2 +037800 MOVE ELEM2(S21, S22) TO TEMP. NC1384.2 +037900 IF TEMP EQUAL TO 7 NC1384.2 +038000 PERFORM PASS NC1384.2 +038100 GO TO SEP-WRITE-002. NC1384.2 +038200 PERFORM FAIL. NC1384.2 +038300 GO TO SEP-FAIL-002. NC1384.2 +038400 SEP-DELETE-002. NC1384.2 +038500 PERFORM DE-LETE. NC1384.2 +038600 GO TO SEP-WRITE-002. NC1384.2 +038700 SEP-FAIL-002. NC1384.2 +038800 MOVE TEMP TO COMPUTED-18V0. NC1384.2 +038900 MOVE 7 TO CORRECT-18V0. NC1384.2 +039000 SEP-WRITE-002. NC1384.2 +039100 MOVE "SEP-TEST-002" TO PAR-NAME. NC1384.2 +039200 PERFORM PRINT-DETAIL. NC1384.2 +039300 SEP-INIT-003. NC1384.2 +039400 MOVE 3 TO S31 S32 S33. NC1384.2 +039500 SEP-TEST-003. NC1384.2 +039600 MOVE ELEM3(S31, S32, S33) TO TEMP. NC1384.2 +039700 IF TEMP EQUAL TO 43 NC1384.2 +039800 PERFORM PASS NC1384.2 +039900 GO TO SEP-WRITE-003. NC1384.2 +040000 PERFORM FAIL. NC1384.2 +040100 GO TO SEP-FAIL-003. NC1384.2 +040200 SEP-DELETE-003. NC1384.2 +040300 PERFORM DE-LETE. NC1384.2 +040400 GO TO SEP-WRITE-003. NC1384.2 +040500 SEP-FAIL-003. NC1384.2 +040600 MOVE TEMP TO COMPUTED-18V0. NC1384.2 +040700 MOVE 43 TO CORRECT-18V0. NC1384.2 +040800 SEP-WRITE-003. NC1384.2 +040900 MOVE "SEP-TEST-003" TO PAR-NAME. NC1384.2 +041000 PERFORM PRINT-DETAIL. NC1384.2 +041100 SEP-INIT-004. NC1384.2 +041200 MOVE "SPACES AS SEPARATOR" TO FEATURE. NC1384.2 +041300 MOVE "SEP-TEST-004" TO PAR-NAME. NC1384.2 +041400 MOVE 0 TO REC-CT. NC1384.2 +041500 MOVE 19 TO S1. NC1384.2 +041600* THIS TEST USES SPACES AS SEPARATORS IN REFERENCING NC1384.2 +041700* ONE DIMENSIONAL TABLE ELEMENTS. NC1384.2 +041800 MOVE ZERO TO TEMP. NC1384.2 +041900 MOVE 19 TO EXPECTED-VALUE. NC1384.2 +042000 SEP-TEST-004-01. NC1384.2 +042100 MOVE ELEM1 (S1 ) TO TEMP. NC1384.2 +042200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +042300 SEP-TEST-004-02. NC1384.2 +042400 MOVE ELEM1 (S1) TO TEMP. NC1384.2 +042500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +042600 SEP-TEST-004-03. NC1384.2 +042700 MOVE ELEM1 (S1 ) TO TEMP. NC1384.2 +042800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +042900 SEP-TEST-004-04. NC1384.2 +043000 MOVE ELEM1( S1) TO TEMP. NC1384.2 +043100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +043200 SEP-TEST-004-05. NC1384.2 +043300 MOVE ELEM1 ( S1) TO TEMP. NC1384.2 +043400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +043500 SEP-TEST-004-06. NC1384.2 +043600 MOVE ELEM1 ( S1 ) TO TEMP. NC1384.2 +043700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +043800 SEP-TEST-004-07. NC1384.2 +043900 MOVE ELEM1 ( 19) TO TEMP. NC1384.2 +044000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +044100 SEP-TEST-004-08. NC1384.2 +044200 MOVE ELEM1(S1 ) TO TEMP. NC1384.2 +044300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +044400 SEP-TEST-004-09. NC1384.2 +044500 MOVE ELEM1 ( 19 ) TO TEMP. NC1384.2 +044600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +044700 GO TO SEP-INIT-005. NC1384.2 +044800* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +044900* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +045000* AN * IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +045100* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +045200* OUTPUT REPORT. NC1384.2 +045300 SEP-DELETE-004. NC1384.2 +045400 PERFORM DE-LETE. NC1384.2 +045500 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +045600 SEP-INIT-005. NC1384.2 +045700 MOVE "SEP-TEST-005" TO PAR-NAME. NC1384.2 +045800 MOVE 0 TO REC-CT. NC1384.2 +045900 MOVE 10 TO S21. NC1384.2 +046000 MOVE 03 TO S22. NC1384.2 +046100 MOVE ZERO TO TEMP. NC1384.2 +046200 MOVE 48 TO EXPECTED-VALUE. NC1384.2 +046300* THIS TEST USES SPACES AND COMMAS AS SEPARATORS IN NC1384.2 +046400* REFERENCING TWO DIMENSIONAL TABLE ELEMENTS. NC1384.2 +046500 SEP-TEST-005-01. NC1384.2 +046600 MOVE ELEM2 (S21 S22) TO TEMP. NC1384.2 +046700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +046800 SEP-TEST-005-02. NC1384.2 +046900 MOVE ELEM2 (S21, S22) TO TEMP. NC1384.2 +047000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +047100 SEP-TEST-005-03. NC1384.2 +047200 MOVE ELEM2 (S21, S22) TO TEMP. NC1384.2 +047300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +047400 SEP-TEST-005-04. NC1384.2 +047500 ADD ELEM2 ( S21 S22 ) TO TEMP. NC1384.2 +047600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +047700 SEP-TEST-005-05. NC1384.2 +047800 MOVE 96 TO TEMP. NC1384.2 +047900 SUBTRACT ELEM2(S21 S22) FROM TEMP. NC1384.2 +048000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +048100 SEP-TEST-005-06. NC1384.2 +048200 MOVE ELEM2( S21, S22) TO TEMP. NC1384.2 +048300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +048400 SEP-TEST-005-07. NC1384.2 +048500 MOVE ELEM2 ( S21 S22 ) TO TEMP. NC1384.2 +048600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +048700 SEP-TEST-005-08. NC1384.2 +048800 MOVE ELEM2 (S21 , S22) TO TEMP. NC1384.2 +048900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +049000 SEP-TEST-005-09. NC1384.2 +049100 ADD ELEM2 (3 5) ELEM2(7, 3) TO TEMP. NC1384.2 +049200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +049300 SEP-TEST-005-10. NC1384.2 +049400 ADD ELEM2( 3 5 ) ELEM2 ( 7 3 ) TO TEMP. NC1384.2 +049500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +049600 GO TO SEP-INIT-006. NC1384.2 +049700* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +049800* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +049900* AN ASTERISK IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +050000* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +050100* OUTPUT REPORT. NC1384.2 +050200 SEP-DELETE-005. NC1384.2 +050300 PERFORM DE-LETE. NC1384.2 +050400 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +050500 SEP-INIT-006. NC1384.2 +050600 MOVE "SEP-TEST-006" TO PAR-NAME. NC1384.2 +050700 MOVE 0 TO REC-CT. NC1384.2 +050800 MOVE ZERO TO TEMP. NC1384.2 +050900 MOVE 3 TO S31. NC1384.2 +051000 MOVE 2 TO S32 S33. NC1384.2 +051100 MOVE 37 TO EXPECTED-VALUE. NC1384.2 +051200* THIS TEST USES SPACES AND COMMAS AS SEPARATORS IN NC1384.2 +051300* REFERENCING THREE DIMENSIONAL TABLE ELEMENTS. NC1384.2 +051400 SEP-TEST-006-01. NC1384.2 +051500 MOVE ELEM3(S31 S32 S33) TO TEMP. NC1384.2 +051600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +051700 SEP-TEST-006-02. NC1384.2 +051800 MOVE ELEM3(S31, S32 S33) TO TEMP. NC1384.2 +051900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +052000 SEP-TEST-006-03. NC1384.2 +052100 ADD ELEM3 ( S31 S32 S33 ) TO TEMP. NC1384.2 +052200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +052300 SEP-TEST-006-04. NC1384.2 +052400 MOVE 74 TO TEMP. NC1384.2 +052500 SUBTRACT ELEM3(S31 , S32 , S33) FROM TEMP. NC1384.2 +052600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +052700 SEP-TEST-006-05. NC1384.2 +052800 MOVE 37 TO TEMP. NC1384.2 +052900 IF ELEM3 ( S31, S32, S33 ) NC1384.2 +053000 NOT EQUAL TO TEMP NC1384.2 +053100 MOVE ZERO TO TEMP. NC1384.2 +053200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +053300 SEP-TEST-006-06. NC1384.2 +053400 MULTIPLY ELEM3 (3 2 2) BY 1 NC1384.2 +053500 GIVING TEMP. NC1384.2 +053600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +053700 SEP-TEST-006-07. NC1384.2 +053800 ADD ELEM3 (1, 1, 1) ELEM3( 3 2 1 ) NC1384.2 +053900 GIVING TEMP. NC1384.2 +054000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +054100 GO TO SEP-INIT-007. NC1384.2 +054200* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +054300* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +054400* AN * IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +054500* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +054600* OUTPUT REPORT. NC1384.2 +054700 SEP-DELETE-006. NC1384.2 +054800 PERFORM DE-LETE. NC1384.2 +054900 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +055000 SEP-INIT-007. NC1384.2 +055100 MOVE "SEP-TEST-007" TO PAR-NAME. NC1384.2 +055200 MOVE ZERO TO REC-CT. NC1384.2 +055300 MOVE ZERO TO TEMP. NC1384.2 +055400 MOVE 12 TO EXPECTED-VALUE. NC1384.2 +055500* THIS TEST USES SIGNED POSITIVE INTEGERS AS NC1384.2 +055600* SUBSCRIPTS AND SPACES AND COMMAS AS SEPARATORS. NC1384.2 +055700 SEP-TEST-007-01. NC1384.2 +055800 MOVE ELEM1(+12) TO TEMP. NC1384.2 +055900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +056000 SEP-TEST-007-02. NC1384.2 +056100 IF ELEM2(+3 +2) EQUAL TO 12 NC1384.2 +056200 MOVE 12 TO TEMP. NC1384.2 +056300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +056400 SEP-TEST-007-03. NC1384.2 +056500 ADD ELEM2 (+3, +2) TO TEMP. NC1384.2 +056600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +056700 SEP-TEST-007-04. NC1384.2 +056800 MOVE 24 TO TEMP. NC1384.2 +056900 SUBTRACT ELEM2 ( +3 +2 ) FROM TEMP. NC1384.2 +057000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +057100 SEP-TEST-007-05. NC1384.2 +057200 MULTIPLY ELEM3(+1, +3, +2) BY +1 NC1384.2 +057300 GIVING TEMP. NC1384.2 +057400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +057500 SEP-TEST-007-06. NC1384.2 +057600 DIVIDE ELEM3(+1 +3 +2) BY 1 NC1384.2 +057700 GIVING TEMP. NC1384.2 +057800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +057900 SEP-TEST-007-07. NC1384.2 +058000 MOVE ELEM3 ( +1, +3, +2 ) TO TEMP. NC1384.2 +058100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +058200 GO TO CCVS-EXIT. NC1384.2 +058300* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +058400* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +058500* AN * IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +058600* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +058700* OUTPUT REPORT. NC1384.2 +058800 SEP-DELETE-007. NC1384.2 +058900 PERFORM DE-LETE. NC1384.2 +059000 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +059100 GO TO CCVS-EXIT. NC1384.2 +059200 SEP-INIT-008. NC1384.2 +059300 MOVE "IV-4 4.2.1(2)" TO ANSI-REFERENCE. NC1384.2 +059400 MOVE "SEP-TEST-008" TO PAR-NAME. NC1384.2 +059500 MOVE 0 TO REC-CT. NC1384.2 +059600 MOVE ZERO TO TEMP. NC1384.2 +059700 MOVE 3 TO S31. NC1384.2 +059800 MOVE 2 TO S32 S33. NC1384.2 +059900 MOVE 37 TO EXPECTED-VALUE. NC1384.2 +060000* THIS TEST USES SPACES AND COMMAS AND SEMI-COLONS NC1384.2 +060100* AS SEPARATORS IN NC1384.2 +060200* REFERENCING THREE DIMENSIONAL TABLE ELEMENTS. NC1384.2 +060300 SEP-TEST-008-01. NC1384.2 +060400 MOVE ELEM3(S31 S32; S33) TO TEMP. NC1384.2 +060500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +060600 SEP-TEST-008-02. NC1384.2 +060700 MOVE ELEM3(S31, S32; S33) TO TEMP. NC1384.2 +060800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +060900 SEP-TEST-008-03. NC1384.2 +061000 ADD ELEM3 ( S31; S32 S33 ) TO TEMP. NC1384.2 +061100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +061200 SEP-TEST-008-04. NC1384.2 +061300 MOVE 74 TO TEMP. NC1384.2 +061400 SUBTRACT ELEM3(S31; S32 , S33) FROM TEMP. NC1384.2 +061500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +061600 SEP-TEST-008-05. NC1384.2 +061700 MOVE 37 TO TEMP. NC1384.2 +061800 IF ELEM3 ( S31; S32; S33 ) NC1384.2 +061900 NOT EQUAL TO TEMP NC1384.2 +062000 MOVE ZERO TO TEMP. NC1384.2 +062100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +062200 SEP-TEST-008-06. NC1384.2 +062300 MULTIPLY ELEM3 (3; 2, 2) BY 1 NC1384.2 +062400 GIVING TEMP. NC1384.2 +062500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +062600 SEP-TEST-008-07. NC1384.2 +062700 ADD ELEM3 (1; 1, 1) ELEM3( 3 2; 1 ) NC1384.2 +062800 GIVING TEMP. NC1384.2 +062900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1384.2 +063000 GO TO SEP-INIT-007. NC1384.2 +063100* IF THE COMPILER REJECTS ANY OF THE ABOVE TABLE NC1384.2 +063200* REFERENCES, DELETE THAT LINE OF CODE BY PLACING NC1384.2 +063300* AN * IN COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. NC1384.2 +063400* THE ELEMENT DELETED APPEARS AS A FAILURE ON THE NC1384.2 +063500* OUTPUT REPORT. NC1384.2 +063600 SEP-DELETE-008. NC1384.2 +063700 PERFORM DE-LETE. NC1384.2 +063800 PERFORM SYNTAX-CHECK-WRITE. NC1384.2 +063900 SECT-TH109-0003 SECTION. NC1384.2 +064000 SYNTAX-CHECK. NC1384.2 +064100 ADD 1 TO REC-CT. NC1384.2 +064200 IF TEMP EQUAL TO EXPECTED-VALUE NC1384.2 +064300 PERFORM PASS NC1384.2 +064400 GO TO SYNTAX-CHECK-WRITE. NC1384.2 +064500 SYNTAX-FAIL. NC1384.2 +064600 PERFORM FAIL. NC1384.2 +064700 MOVE TEMP TO COMPUTED-18V0. NC1384.2 +064800 MOVE EXPECTED-VALUE TO CORRECT-18V0. NC1384.2 +064900 SYNTAX-CHECK-WRITE. NC1384.2 +065000 PERFORM PRINT-DETAIL. NC1384.2 +065100 MOVE ZERO TO TEMP. NC1384.2 +065200 CCVS-EXIT SECTION. NC1384.2 +065300 CCVS-999999. NC1384.2 +065400 GO TO CLOSE-FILES. NC1384.2 diff --git a/tests/cobol85/NC/NC139A.CBL b/tests/cobol85/NC/NC139A.CBL new file mode 100755 index 00000000..c2a45f2a --- /dev/null +++ b/tests/cobol85/NC/NC139A.CBL @@ -0,0 +1,617 @@ +000100 IDENTIFICATION DIVISION. NC1394.2 +000200 PROGRAM-ID. NC1394.2 +000300 NC139A. NC1394.2 +000400**************************************************************** NC1394.2 +000500* * NC1394.2 +000600* VALIDATION FOR:- * NC1394.2 +000700* * NC1394.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1394.2 +000900* * NC1394.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1394.2 +001100* * NC1394.2 +001200**************************************************************** NC1394.2 +001300* * NC1394.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1394.2 +001500* * NC1394.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1394.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1394.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1394.2 +001900* * NC1394.2 +002000**************************************************************** NC1394.2 +002100* NC1394.2 +002200* PROGRAM NC139A TESTS THE USE OF NUMERIC LITERALS WITH NC1394.2 +002300* RELATIVE INDEXING WHEN ACCESSING 2 AND 3 DIMENSIONAL NC1394.2 +002400* TABLES. NC1394.2 +002500* THE USE OF INDEXES AND SUBSCRIPTS TOGETHER IS ALSO TESTED. NC1394.2 +002600* NC1394.2 +002700 ENVIRONMENT DIVISION. NC1394.2 +002800 CONFIGURATION SECTION. NC1394.2 +002900 SOURCE-COMPUTER. NC1394.2 +003000 Linux. NC1394.2 +003100 OBJECT-COMPUTER. NC1394.2 +003200 Linux. NC1394.2 +003300 INPUT-OUTPUT SECTION. NC1394.2 +003400 FILE-CONTROL. NC1394.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1394.2 +003600 "report.log". NC1394.2 +003700 DATA DIVISION. NC1394.2 +003800 FILE SECTION. NC1394.2 +003900 FD PRINT-FILE. NC1394.2 +004000 01 PRINT-REC PICTURE X(120). NC1394.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1394.2 +004200 WORKING-STORAGE SECTION. NC1394.2 +004300* LITERALS AND INDEX-NAMES MAY BE MIXED IN A TABLE NC1394.2 +004400* REFERENCE. THE LITERALS MAY BE SIGNED BUT MUST BE POSITIVE. NC1394.2 +004500* RELATIVE INDEXING WITH BOTH POSITIVE AND NEGATIVE INTEGERS NC1394.2 +004600* IS PERMITTED. NC1394.2 +004700 01 WS-2 PIC 9. NC1394.2 +004800 01 WS-PLUS-2 PIC S9. NC1394.2 +004900 01 WS-4 PIC 9. NC1394.2 +005000 01 WS-PLUS-4 PIC S9. NC1394.2 +005100 77 TEMP PIC XXX. NC1394.2 +005200 77 EXPECTED-VALUE PIC XXX. NC1394.2 +005300* TWO DIMENSIONAL TABLE, 6X4, WITH INDEXES. NC1394.2 +005400 01 GRP-TAB1. NC1394.2 +005500 02 GRP-1 OCCURS 6 TIMES NC1394.2 +005600 INDEXED BY IN1. NC1394.2 +005700 03 ELEM1 PIC XXX NC1394.2 +005800 OCCURS 4 TIMES NC1394.2 +005900 INDEXED BY IN2. NC1394.2 +006000* THREE DIMENSIONAL TABLE, 3X2X4, WITH INDEXES. NC1394.2 +006100 01 GRP-TAB2. NC1394.2 +006200 02 GRP-2 OCCURS 3 TIMES NC1394.2 +006300 INDEXED BY INDEX1. NC1394.2 +006400 03 GRP-3 OCCURS 2 TIMES NC1394.2 +006500 INDEXED BY INDEX2. NC1394.2 +006600 04 ELEM2 PIC XXX NC1394.2 +006700 OCCURS 4 TIMES NC1394.2 +006800 INDEXED BY INDEX3. NC1394.2 +006900 01 TABLE-VALUES. NC1394.2 +007000 02 VALUES-1 PIC X(12) NC1394.2 +007100 VALUE "AAABBBCCCDDD". NC1394.2 +007200 02 VALUES-2 PIC X(12) NC1394.2 +007300 VALUE "EEEFFFGGGHHH". NC1394.2 +007400 02 VALUES-3 PIC X(12) NC1394.2 +007500 VALUE "IIIJJJKKKLLL". NC1394.2 +007600 02 VALUES-4 PIC X(12) NC1394.2 +007700 VALUE "MMMNNNOOOPPP". NC1394.2 +007800 02 VALUES-5 PIC X(12) NC1394.2 +007900 VALUE "QQQRRRSSSTTT". NC1394.2 +008000 02 VALUES-6 PIC X(12) NC1394.2 +008100 VALUE "UUUVVVWWWXXX". NC1394.2 +008200 01 TEST-RESULTS. NC1394.2 +008300 02 FILLER PIC X VALUE SPACE. NC1394.2 +008400 02 FEATURE PIC X(20) VALUE SPACE. NC1394.2 +008500 02 FILLER PIC X VALUE SPACE. NC1394.2 +008600 02 P-OR-F PIC X(5) VALUE SPACE. NC1394.2 +008700 02 FILLER PIC X VALUE SPACE. NC1394.2 +008800 02 PAR-NAME. NC1394.2 +008900 03 FILLER PIC X(19) VALUE SPACE. NC1394.2 +009000 03 PARDOT-X PIC X VALUE SPACE. NC1394.2 +009100 03 DOTVALUE PIC 99 VALUE ZERO. NC1394.2 +009200 02 FILLER PIC X(8) VALUE SPACE. NC1394.2 +009300 02 RE-MARK PIC X(61). NC1394.2 +009400 01 TEST-COMPUTED. NC1394.2 +009500 02 FILLER PIC X(30) VALUE SPACE. NC1394.2 +009600 02 FILLER PIC X(17) VALUE NC1394.2 +009700 " COMPUTED=". NC1394.2 +009800 02 COMPUTED-X. NC1394.2 +009900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1394.2 +010000 03 COMPUTED-N REDEFINES COMPUTED-A NC1394.2 +010100 PIC -9(9).9(9). NC1394.2 +010200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1394.2 +010300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1394.2 +010400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1394.2 +010500 03 CM-18V0 REDEFINES COMPUTED-A. NC1394.2 +010600 04 COMPUTED-18V0 PIC -9(18). NC1394.2 +010700 04 FILLER PIC X. NC1394.2 +010800 03 FILLER PIC X(50) VALUE SPACE. NC1394.2 +010900 01 TEST-CORRECT. NC1394.2 +011000 02 FILLER PIC X(30) VALUE SPACE. NC1394.2 +011100 02 FILLER PIC X(17) VALUE " CORRECT =". NC1394.2 +011200 02 CORRECT-X. NC1394.2 +011300 03 CORRECT-A PIC X(20) VALUE SPACE. NC1394.2 +011400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1394.2 +011500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1394.2 +011600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1394.2 +011700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1394.2 +011800 03 CR-18V0 REDEFINES CORRECT-A. NC1394.2 +011900 04 CORRECT-18V0 PIC -9(18). NC1394.2 +012000 04 FILLER PIC X. NC1394.2 +012100 03 FILLER PIC X(2) VALUE SPACE. NC1394.2 +012200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1394.2 +012300 01 CCVS-C-1. NC1394.2 +012400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1394.2 +012500- "SS PARAGRAPH-NAME NC1394.2 +012600- " REMARKS". NC1394.2 +012700 02 FILLER PIC X(20) VALUE SPACE. NC1394.2 +012800 01 CCVS-C-2. NC1394.2 +012900 02 FILLER PIC X VALUE SPACE. NC1394.2 +013000 02 FILLER PIC X(6) VALUE "TESTED". NC1394.2 +013100 02 FILLER PIC X(15) VALUE SPACE. NC1394.2 +013200 02 FILLER PIC X(4) VALUE "FAIL". NC1394.2 +013300 02 FILLER PIC X(94) VALUE SPACE. NC1394.2 +013400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1394.2 +013500 01 REC-CT PIC 99 VALUE ZERO. NC1394.2 +013600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1394.2 +013700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1394.2 +013800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1394.2 +013900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1394.2 +014000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1394.2 +014100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1394.2 +014200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1394.2 +014300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1394.2 +014400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1394.2 +014500 01 CCVS-H-1. NC1394.2 +014600 02 FILLER PIC X(39) VALUE SPACES. NC1394.2 +014700 02 FILLER PIC X(42) VALUE NC1394.2 +014800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1394.2 +014900 02 FILLER PIC X(39) VALUE SPACES. NC1394.2 +015000 01 CCVS-H-2A. NC1394.2 +015100 02 FILLER PIC X(40) VALUE SPACE. NC1394.2 +015200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1394.2 +015300 02 FILLER PIC XXXX VALUE NC1394.2 +015400 "4.2 ". NC1394.2 +015500 02 FILLER PIC X(28) VALUE NC1394.2 +015600 " COPY - NOT FOR DISTRIBUTION". NC1394.2 +015700 02 FILLER PIC X(41) VALUE SPACE. NC1394.2 +015800 NC1394.2 +015900 01 CCVS-H-2B. NC1394.2 +016000 02 FILLER PIC X(15) VALUE NC1394.2 +016100 "TEST RESULT OF ". NC1394.2 +016200 02 TEST-ID PIC X(9). NC1394.2 +016300 02 FILLER PIC X(4) VALUE NC1394.2 +016400 " IN ". NC1394.2 +016500 02 FILLER PIC X(12) VALUE NC1394.2 +016600 " HIGH ". NC1394.2 +016700 02 FILLER PIC X(22) VALUE NC1394.2 +016800 " LEVEL VALIDATION FOR ". NC1394.2 +016900 02 FILLER PIC X(58) VALUE NC1394.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1394.2 +017100 01 CCVS-H-3. NC1394.2 +017200 02 FILLER PIC X(34) VALUE NC1394.2 +017300 " FOR OFFICIAL USE ONLY ". NC1394.2 +017400 02 FILLER PIC X(58) VALUE NC1394.2 +017500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1394.2 +017600 02 FILLER PIC X(28) VALUE NC1394.2 +017700 " COPYRIGHT 1985 ". NC1394.2 +017800 01 CCVS-E-1. NC1394.2 +017900 02 FILLER PIC X(52) VALUE SPACE. NC1394.2 +018000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1394.2 +018100 02 ID-AGAIN PIC X(9). NC1394.2 +018200 02 FILLER PIC X(45) VALUE SPACES. NC1394.2 +018300 01 CCVS-E-2. NC1394.2 +018400 02 FILLER PIC X(31) VALUE SPACE. NC1394.2 +018500 02 FILLER PIC X(21) VALUE SPACE. NC1394.2 +018600 02 CCVS-E-2-2. NC1394.2 +018700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1394.2 +018800 03 FILLER PIC X VALUE SPACE. NC1394.2 +018900 03 ENDER-DESC PIC X(44) VALUE NC1394.2 +019000 "ERRORS ENCOUNTERED". NC1394.2 +019100 01 CCVS-E-3. NC1394.2 +019200 02 FILLER PIC X(22) VALUE NC1394.2 +019300 " FOR OFFICIAL USE ONLY". NC1394.2 +019400 02 FILLER PIC X(12) VALUE SPACE. NC1394.2 +019500 02 FILLER PIC X(58) VALUE NC1394.2 +019600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1394.2 +019700 02 FILLER PIC X(13) VALUE SPACE. NC1394.2 +019800 02 FILLER PIC X(15) VALUE NC1394.2 +019900 " COPYRIGHT 1985". NC1394.2 +020000 01 CCVS-E-4. NC1394.2 +020100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1394.2 +020200 02 FILLER PIC X(4) VALUE " OF ". NC1394.2 +020300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1394.2 +020400 02 FILLER PIC X(40) VALUE NC1394.2 +020500 " TESTS WERE EXECUTED SUCCESSFULLY". NC1394.2 +020600 01 XXINFO. NC1394.2 +020700 02 FILLER PIC X(19) VALUE NC1394.2 +020800 "*** INFORMATION ***". NC1394.2 +020900 02 INFO-TEXT. NC1394.2 +021000 04 FILLER PIC X(8) VALUE SPACE. NC1394.2 +021100 04 XXCOMPUTED PIC X(20). NC1394.2 +021200 04 FILLER PIC X(5) VALUE SPACE. NC1394.2 +021300 04 XXCORRECT PIC X(20). NC1394.2 +021400 02 INF-ANSI-REFERENCE PIC X(48). NC1394.2 +021500 01 HYPHEN-LINE. NC1394.2 +021600 02 FILLER PIC IS X VALUE IS SPACE. NC1394.2 +021700 02 FILLER PIC IS X(65) VALUE IS "************************NC1394.2 +021800- "*****************************************". NC1394.2 +021900 02 FILLER PIC IS X(54) VALUE IS "************************NC1394.2 +022000- "******************************". NC1394.2 +022100 01 CCVS-PGM-ID PIC X(9) VALUE NC1394.2 +022200 "NC139A". NC1394.2 +022300 PROCEDURE DIVISION. NC1394.2 +022400 CCVS1 SECTION. NC1394.2 +022500 OPEN-FILES. NC1394.2 +022600 OPEN OUTPUT PRINT-FILE. NC1394.2 +022700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1394.2 +022800 MOVE SPACE TO TEST-RESULTS. NC1394.2 +022900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1394.2 +023000 GO TO CCVS1-EXIT. NC1394.2 +023100 CLOSE-FILES. NC1394.2 +023200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1394.2 +023300 TERMINATE-CCVS. NC1394.2 +023400*S EXIT PROGRAM. NC1394.2 +023500*SERMINATE-CALL. NC1394.2 +023600 STOP RUN. NC1394.2 +023700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1394.2 +023800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1394.2 +023900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1394.2 +024000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1394.2 +024100 MOVE "****TEST DELETED****" TO RE-MARK. NC1394.2 +024200 PRINT-DETAIL. NC1394.2 +024300 IF REC-CT NOT EQUAL TO ZERO NC1394.2 +024400 MOVE "." TO PARDOT-X NC1394.2 +024500 MOVE REC-CT TO DOTVALUE. NC1394.2 +024600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1394.2 +024700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1394.2 +024800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1394.2 +024900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1394.2 +025000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1394.2 +025100 MOVE SPACE TO CORRECT-X. NC1394.2 +025200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1394.2 +025300 MOVE SPACE TO RE-MARK. NC1394.2 +025400 HEAD-ROUTINE. NC1394.2 +025500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +025600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +025700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1394.2 +025800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1394.2 +025900 COLUMN-NAMES-ROUTINE. NC1394.2 +026000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +026100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +026300 END-ROUTINE. NC1394.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1394.2 +026500 END-RTN-EXIT. NC1394.2 +026600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +026700 END-ROUTINE-1. NC1394.2 +026800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1394.2 +026900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1394.2 +027000 ADD PASS-COUNTER TO ERROR-HOLD. NC1394.2 +027100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1394.2 +027200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1394.2 +027300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1394.2 +027400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1394.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1394.2 +027600 END-ROUTINE-12. NC1394.2 +027700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1394.2 +027800 IF ERROR-COUNTER IS EQUAL TO ZERO NC1394.2 +027900 MOVE "NO " TO ERROR-TOTAL NC1394.2 +028000 ELSE NC1394.2 +028100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1394.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1394.2 +028300 PERFORM WRITE-LINE. NC1394.2 +028400 END-ROUTINE-13. NC1394.2 +028500 IF DELETE-COUNTER IS EQUAL TO ZERO NC1394.2 +028600 MOVE "NO " TO ERROR-TOTAL ELSE NC1394.2 +028700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1394.2 +028800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1394.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +029000 IF INSPECT-COUNTER EQUAL TO ZERO NC1394.2 +029100 MOVE "NO " TO ERROR-TOTAL NC1394.2 +029200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1394.2 +029300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1394.2 +029400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +029500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1394.2 +029600 WRITE-LINE. NC1394.2 +029700 ADD 1 TO RECORD-COUNT. NC1394.2 +029800 IF RECORD-COUNT GREATER 42 NC1394.2 +029900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1394.2 +030000 MOVE SPACE TO DUMMY-RECORD NC1394.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1394.2 +030200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1394.2 +030300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1394.2 +030400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1394.2 +030500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1394.2 +030600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1394.2 +030700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1394.2 +030800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1394.2 +030900 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1394.2 +031000 MOVE ZERO TO RECORD-COUNT. NC1394.2 +031100 PERFORM WRT-LN. NC1394.2 +031200 WRT-LN. NC1394.2 +031300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1394.2 +031400 MOVE SPACE TO DUMMY-RECORD. NC1394.2 +031500 BLANK-LINE-PRINT. NC1394.2 +031600 PERFORM WRT-LN. NC1394.2 +031700 FAIL-ROUTINE. NC1394.2 +031800 IF COMPUTED-X NOT EQUAL TO SPACE NC1394.2 +031900 GO TO FAIL-ROUTINE-WRITE. NC1394.2 +032000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1394.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1394.2 +032200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1394.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1394.2 +032500 GO TO FAIL-ROUTINE-EX. NC1394.2 +032600 FAIL-ROUTINE-WRITE. NC1394.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1394.2 +032800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1394.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1394.2 +033000 MOVE SPACES TO COR-ANSI-REFERENCE. NC1394.2 +033100 FAIL-ROUTINE-EX. EXIT. NC1394.2 +033200 BAIL-OUT. NC1394.2 +033300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1394.2 +033400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1394.2 +033500 BAIL-OUT-WRITE. NC1394.2 +033600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1394.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1394.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1394.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1394.2 +034000 BAIL-OUT-EX. EXIT. NC1394.2 +034100 CCVS1-EXIT. NC1394.2 +034200 EXIT. NC1394.2 +034300********************************* NC1394.2 +034400* STATEMENT DELETION INSTRUCTIONS NC1394.2 +034500* IF THE COMPILER REJECTS ANY OF THE TABLE REFERENCES IN NC1394.2 +034600* THIS ROUTINE, DELETE THAT LINE OF CODE BY PLACING AN * IN NC1394.2 +034700* COLUMN 7. LEAVE THE PERFORM...THRU STATEMENT. THE TEST NC1394.2 +034800* ELEMENT DELETED APPEARS AS A FAILURE ON THE OUTPUT REPORT. NC1394.2 +034900***************************************** NC1394.2 +035000 SECT-NC139A-001 SECTION. NC1394.2 +035100 NC139A-001. NC1394.2 +035200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1394.2 +035300* THIS SECTION STORES AAA THRU XXX IN THE TWO TABLES NC1394.2 +035400* REFERENCED IN THE TESTS. NC1394.2 +035500 BUILD-TABLE. NC1394.2 +035600 SET IN1 TO 1. NC1394.2 +035700 MOVE VALUES-1 TO GRP-1 (IN1). NC1394.2 +035800 MOVE VALUES-2 TO GRP-1 (IN1 + 1). NC1394.2 +035900 MOVE VALUES-3 TO GRP-1 (IN1 + 2). NC1394.2 +036000 MOVE VALUES-4 TO GRP-1 (IN1 + 3). NC1394.2 +036100 MOVE VALUES-5 TO GRP-1 (IN1 + 4). NC1394.2 +036200 MOVE VALUES-6 TO GRP-1 (IN1 + 5). NC1394.2 +036300 MOVE GRP-TAB1 TO GRP-TAB2. NC1394.2 +036400 SECT-TH110-0002 SECTION. NC1394.2 +036500* THIS SECTION CONTAINS THE TESTS WHICH VALIDATE NC1394.2 +036600* THE HANDLING OF LITERALS MIXED WITH INDEX-NAMES NC1394.2 +036700* IN REFERENCING TWO AND THREE DIMENSIONAL TABLES. NC1394.2 +036800 IND-INIT-001. NC1394.2 +036900* THIS TEST MIXES UNSIGNED LITERALS WITH INDEX-NAMES. NC1394.2 +037000 SET IN1 IN2 TO 1. NC1394.2 +037100 SET INDEX1 INDEX2 INDEX3 TO 1. NC1394.2 +037200 MOVE "AAA" TO EXPECTED-VALUE. NC1394.2 +037300 MOVE SPACE TO TEMP. NC1394.2 +037400 MOVE ZERO TO REC-CT. NC1394.2 +037500 MOVE "IND-TEST-001" TO PAR-NAME. NC1394.2 +037600 MOVE "INDEXES AND LITERALS" TO FEATURE. NC1394.2 +037700 IND-TEST-001-01. NC1394.2 +037800 MOVE ELEM1 (IN1, 1) TO TEMP. NC1394.2 +037900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +038000 IND-TEST-001-02. NC1394.2 +038100 MOVE ELEM1(1 IN2) TO TEMP. NC1394.2 +038200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +038300 IND-TEST-001-03. NC1394.2 +038400 MOVE ELEM1(1, IN2) TO TEMP. NC1394.2 +038500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +038600 IND-TEST-001-04. NC1394.2 +038700 MOVE ELEM2 (1 INDEX2 1) TO TEMP. NC1394.2 +038800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +038900 IND-TEST-001-05. NC1394.2 +039000 MOVE ELEM2(INDEX1 INDEX2 1) TO TEMP. NC1394.2 +039100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +039200 IND-TEST-001-06. NC1394.2 +039300 MOVE ELEM2 (INDEX1, 1 INDEX3) TO TEMP. NC1394.2 +039400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +039500 IND-TEST-001-07. NC1394.2 +039600 MOVE ELEM2 (1 1 INDEX3) TO TEMP. NC1394.2 +039700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +039800 GO TO IND-INIT-002. NC1394.2 +039900 IND-DELETE-001. NC1394.2 +040000 PERFORM DE-LETE. NC1394.2 +040100 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +040200 IND-INIT-002. NC1394.2 +040300* THIS TEST MIXES SIGNED LITERALS WITH INDEX-NAMES. NC1394.2 +040400 MOVE ZERO TO REC-CT. NC1394.2 +040500 MOVE SPACE TO TEMP. NC1394.2 +040600 MOVE "GGG" TO EXPECTED-VALUE. NC1394.2 +040700 MOVE "IND-TEST-002" TO PAR-NAME. NC1394.2 +040800 SET INDEX1 TO 1. NC1394.2 +040900 SET IN1 INDEX2 TO 2. NC1394.2 +041000 SET IN2 INDEX3 TO 3. NC1394.2 +041100 IND-TEST-002-01. NC1394.2 +041200 MOVE ELEM1(IN1, +3) TO TEMP. NC1394.2 +041300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +041400 IND-TEST-002-02. NC1394.2 +041500 MOVE ELEM1(+2, IN2) TO TEMP. NC1394.2 +041600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +041700 IND-TEST-002-03. NC1394.2 +041800 IF ELEM1 (+2 IN2) EQUAL TO "GGG" NC1394.2 +041900 MOVE "GGG" TO TEMP. NC1394.2 +042000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +042100 IND-TEST-002-04. NC1394.2 +042200 IF ELEM1 (IN1 +3) IS EQUAL TO EXPECTED-VALUE NC1394.2 +042300 MOVE "GGG" TO TEMP. NC1394.2 +042400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +042500 IND-TEST-002-05. NC1394.2 +042600 MOVE ELEM2(+1, INDEX2, +3) TO TEMP. NC1394.2 +042700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +042800 IND-TEST-002-06. NC1394.2 +042900 MOVE ELEM2(+1 INDEX2 +3) TO TEMP. NC1394.2 +043000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +043100 IND-TEST-002-07. NC1394.2 +043200 MOVE ELEM2 (INDEX1 +2, +3) TO TEMP. NC1394.2 +043300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +043400 IND-TEST-002-08. NC1394.2 +043500 MOVE ELEM2 (INDEX1 INDEX2 +3) TO TEMP. NC1394.2 +043600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +043700 GO TO IND-INIT-003. NC1394.2 +043800 IND-DELETE-002. NC1394.2 +043900 PERFORM DE-LETE. NC1394.2 +044000 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +044100 IND-INIT-003. NC1394.2 +044200* THIS TEST MIXES UNSIGNED LITERALS WITH RELATIVE INDEXING. NC1394.2 +044300 MOVE ZERO TO REC-CT. NC1394.2 +044400 MOVE SPACE TO TEMP. NC1394.2 +044500 MOVE "SSS" TO EXPECTED-VALUE. NC1394.2 +044600 MOVE "IND-TEST-003" TO PAR-NAME. NC1394.2 +044700 SET IN1 TO 6. NC1394.2 +044800 SET INDEX3 TO 4. NC1394.2 +044900 SET INDEX2 TO 1. NC1394.2 +045000 SET IN2 INDEX1 TO 2. NC1394.2 +045100 IND-TEST-003-01. NC1394.2 +045200 MOVE ELEM1(IN1 - 1, 3) TO TEMP. NC1394.2 +045300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +045400 IND-TEST-003-02. NC1394.2 +045500 MOVE ELEM1 ( 5, IN2 + 1) TO TEMP. NC1394.2 +045600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +045700 IND-TEST-003-03. NC1394.2 +045800 MOVE ELEM1(IN1 - 1 3) TO TEMP. NC1394.2 +045900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +046000 IND-TEST-003-04. NC1394.2 +046100 MOVE ELEM1 (5 IN2 + 1) TO TEMP. NC1394.2 +046200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +046300 IND-TEST-003-05. NC1394.2 +046400 MOVE ELEM2 (3, INDEX2, INDEX3 - 1) TO TEMP. NC1394.2 +046500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +046600 IND-TEST-003-06. NC1394.2 +046700 MOVE ELEM2 (3 INDEX2 INDEX3 - 1) TO TEMP. NC1394.2 +046800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +046900 IND-TEST-003-07. NC1394.2 +047000 MOVE ELEM2(INDEX1 + 1, 1, 3) TO TEMP. NC1394.2 +047100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +047200 IND-TEST-003-08. NC1394.2 +047300 IF ELEM2(INDEX1 + 1 1 3) IS EQUAL TO "SSS" NC1394.2 +047400 MOVE "SSS" TO TEMP. NC1394.2 +047500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +047600 IND-TEST-003-09. NC1394.2 +047700 MOVE ELEM2 (INDEX1 + 1 INDEX2 3) TO TEMP. NC1394.2 +047800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +047900 IND-TEST-003-10. NC1394.2 +048000 MOVE ELEM2 (3 1 INDEX3 - 1) TO TEMP. NC1394.2 +048100 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +048200 IND-TEST-003-11. NC1394.2 +048300 MOVE ELEM2(INDEX1 + 1 1 INDEX3 - 1) TO TEMP. NC1394.2 +048400 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +048500 GO TO IND-INIT-004. NC1394.2 +048600 IND-DELETE-003. NC1394.2 +048700 PERFORM DE-LETE. NC1394.2 +048800 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +048900 IND-INIT-004. NC1394.2 +049000* THIS TEST MIXES SIGNED LITERALS WITH RELATIVE INDEXING. NC1394.2 +049100 MOVE ZERO TO REC-CT. NC1394.2 +049200 MOVE SPACE TO TEMP. NC1394.2 +049300 MOVE "VVV" TO EXPECTED-VALUE. NC1394.2 +049400 MOVE "IND-TEST-004" TO PAR-NAME. NC1394.2 +049500 SET IN1 TO 2. NC1394.2 +049600 SET IN2 TO 4. NC1394.2 +049700 SET INDEX1 TO 2. NC1394.2 +049800 SET INDEX2 TO 1. NC1394.2 +049900 SET INDEX3 TO 4. NC1394.2 +050000 IND-TEST-004-01. NC1394.2 +050100 MOVE ELEM1(IN1 + 4, +2) TO TEMP. NC1394.2 +050200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +050300 IND-TEST-004-02. NC1394.2 +050400 MOVE ELEM1 (IN1 + 4 +2) TO TEMP. NC1394.2 +050500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +050600 IND-TEST-004-03. NC1394.2 +050700 MOVE ELEM1 (+6, IN2 - 2) TO TEMP. NC1394.2 +050800 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +050900 IND-TEST-004-04. NC1394.2 +051000 IF ELEM1(+6 IN2 - 2) IS EQUAL TO "VVV" NC1394.2 +051100 MOVE "VVV" TO TEMP. NC1394.2 +051200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +051300 IND-TEST-004-05. NC1394.2 +051400 IF ELEM2 (INDEX1 + 1, +2, INDEX3 - 2) NC1394.2 +051500 IS EQUAL TO EXPECTED-VALUE NC1394.2 +051600 MOVE "VVV" TO TEMP. NC1394.2 +051700 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +051800 IND-TEST-004-06. NC1394.2 +051900 MOVE ELEM2(INDEX1 + 1 +2 INDEX3 - 2) TO TEMP. NC1394.2 +052000 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +052100 IND-TEST-004-07. NC1394.2 +052200 MOVE ELEM2 (+3 +2 INDEX3 - 2) TO TEMP. NC1394.2 +052300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +052400 IND-TEST-004-08. NC1394.2 +052500 MOVE ELEM2 (INDEX1 + 1 +2 +2) TO TEMP. NC1394.2 +052600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +052700 IND-TEST-004-09. NC1394.2 +052800 MOVE ELEM2(INDEX1 + 1, INDEX2 + 1, +2) TO TEMP. NC1394.2 +052900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +053000 IND-TEST-004-10. NC1394.2 +053100 MOVE ELEM2 (+3 INDEX2 + 1 +2) TO TEMP. NC1394.2 +053200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +053300 GO TO IND-INIT-005. NC1394.2 +053400 IND-DELETE-004. NC1394.2 +053500 PERFORM DE-LETE. NC1394.2 +053600 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +053700 IND-INIT-005. NC1394.2 +053800* THIS TEST MIXES SIGNED AND UNSIGNED LITERALS NC1394.2 +053900* WITH RELATIVE INDEXING. NC1394.2 +054000 MOVE ZERO TO REC-CT. NC1394.2 +054100 MOVE SPACE TO TEMP. NC1394.2 +054200 MOVE "PPP" TO EXPECTED-VALUE. NC1394.2 +054300 MOVE "IND-TEST-005" TO PAR-NAME. NC1394.2 +054400 SET INDEX1 TO 3. NC1394.2 +054500 SET INDEX2 TO 1. NC1394.2 +054600 SET INDEX3 TO 2. NC1394.2 +054700 IND-TEST-005-01. NC1394.2 +054800 MOVE ELEM2 (+2, INDEX2 + 1, 4) TO TEMP. NC1394.2 +054900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +055000 IND-TEST-005-02. NC1394.2 +055100 MOVE ELEM2(+2 INDEX2 + 1 4) TO TEMP. NC1394.2 +055200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +055300 IND-TEST-005-03. NC1394.2 +055400 MOVE ELEM2 (2 +2 INDEX3 + 2) TO TEMP. NC1394.2 +055500 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +055600 IND-TEST-005-04. NC1394.2 +055700 IF ELEM2 (INDEX1 - 1, 2 +4) IS EQUAL TO EXPECTED-VALUE NC1394.2 +055800 MOVE "PPP" TO TEMP. NC1394.2 +055900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +056000 IND-TEST-005-05. NC1394.2 +056100 MOVE ELEM2(+2 2 INDEX3 + 2) TO TEMP. NC1394.2 +056200 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +056300 GO TO CCVS-EXIT. NC1394.2 +056400 IND-DELETE-005. NC1394.2 +056500 PERFORM DE-LETE. NC1394.2 +056600 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +056700 IND-INIT-006. NC1394.2 +056800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC1394.2 +056900* THIS TEST MIXES DATA-NAMES WITH RELATIVE INDEXING. NC1394.2 +057000 MOVE ZERO TO REC-CT. NC1394.2 +057100 MOVE SPACE TO TEMP. NC1394.2 +057200 MOVE "PPP" TO EXPECTED-VALUE. NC1394.2 +057300 MOVE "IND-TEST-006" TO PAR-NAME. NC1394.2 +057400 SET INDEX1 TO 3. NC1394.2 +057500 SET INDEX2 TO 1. NC1394.2 +057600 SET INDEX3 TO 2. NC1394.2 +057700 MOVE 2 TO WS-2. NC1394.2 +057800 MOVE +2 TO WS-PLUS-2. NC1394.2 +057900 MOVE 4 TO WS-4. NC1394.2 +058000 MOVE +4 TO WS-PLUS-4. NC1394.2 +058100 IND-TEST-006-01. NC1394.2 +058200 MOVE ELEM2 (WS-PLUS-2, INDEX2 + 1, WS-4) TO TEMP. NC1394.2 +058300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +058400 IND-TEST-006-02. NC1394.2 +058500 MOVE ELEM2(WS-PLUS-2 INDEX2 + 1 WS-4) TO TEMP. NC1394.2 +058600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +058700 IND-TEST-006-03. NC1394.2 +058800 MOVE ELEM2 ( WS-2 WS-PLUS-2 INDEX3 + 2) TO TEMP. NC1394.2 +058900 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +059000 IND-TEST-006-04. NC1394.2 +059100 IF ELEM2 (INDEX1 - 1, WS-2 WS-PLUS-4) = EXPECTED-VALUE NC1394.2 +059200 MOVE "PPP" TO TEMP. NC1394.2 +059300 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +059400 IND-TEST-006-05. NC1394.2 +059500 MOVE ELEM2(WS-PLUS-2 WS-2 INDEX3 + 2) TO TEMP. NC1394.2 +059600 PERFORM SYNTAX-CHECK THRU SYNTAX-CHECK-WRITE. NC1394.2 +059700 GO TO CCVS-EXIT. NC1394.2 +059800 IND-DELETE-006. NC1394.2 +059900 PERFORM DE-LETE. NC1394.2 +060000 PERFORM SYNTAX-CHECK-WRITE. NC1394.2 +060100 GO TO CCVS-EXIT. NC1394.2 +060200 SECT-TH110-0003 SECTION. NC1394.2 +060300 SYNTAX-CHECK. NC1394.2 +060400 ADD 1 TO REC-CT. NC1394.2 +060500 IF TEMP IS EQUAL TO EXPECTED-VALUE NC1394.2 +060600 PERFORM PASS NC1394.2 +060700 GO TO SYNTAX-CHECK-WRITE. NC1394.2 +060800 SYNTAX-FAIL. NC1394.2 +060900 PERFORM FAIL. NC1394.2 +061000 MOVE TEMP TO COMPUTED-A. NC1394.2 +061100 MOVE EXPECTED-VALUE TO CORRECT-A. NC1394.2 +061200 SYNTAX-CHECK-WRITE. NC1394.2 +061300 PERFORM PRINT-DETAIL. NC1394.2 +061400 MOVE SPACE TO TEMP. NC1394.2 +061500 CCVS-EXIT SECTION. NC1394.2 +061600 CCVS-999999. NC1394.2 +061700 GO TO CLOSE-FILES. NC1394.2 diff --git a/tests/cobol85/NC/NC140A.CBL b/tests/cobol85/NC/NC140A.CBL new file mode 100755 index 00000000..2edf0b89 --- /dev/null +++ b/tests/cobol85/NC/NC140A.CBL @@ -0,0 +1,749 @@ +000100 IDENTIFICATION DIVISION. NC1404.2 +000200 PROGRAM-ID. NC1404.2 +000300 NC140A. NC1404.2 +000400**************************************************************** NC1404.2 +000500* * NC1404.2 +000600* VALIDATION FOR:- * NC1404.2 +000700* * NC1404.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1404.2 +000900* * NC1404.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1404.2 +001100* * NC1404.2 +001200**************************************************************** NC1404.2 +001300* * NC1404.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1404.2 +001500* * NC1404.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1404.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1404.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1404.2 +001900* * NC1404.2 +002000**************************************************************** NC1404.2 +002100* NC1404.2 +002200* PROGRAM NC140A TESTS FORMAT 2 OF THE "SET" STATEMENT NC1404.2 +002300* USING A VARIETY OF DATA-NAMES CONTAINING POSITIVE AND NC1404.2 +002400* NEGATIVE VALUES, AS WELL AS POSITIVE AND NEGATIVE INTEGERS. NC1404.2 +002500* NC1404.2 +002600**************************************************************** NC1404.2 +002700 ENVIRONMENT DIVISION. NC1404.2 +002800 CONFIGURATION SECTION. NC1404.2 +002900 SOURCE-COMPUTER. NC1404.2 +003000 Linux. NC1404.2 +003100 OBJECT-COMPUTER. NC1404.2 +003200 Linux. NC1404.2 +003300 INPUT-OUTPUT SECTION. NC1404.2 +003400 FILE-CONTROL. NC1404.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1404.2 +003600 "report.log". NC1404.2 +003700 DATA DIVISION. NC1404.2 +003800 FILE SECTION. NC1404.2 +003900 FD PRINT-FILE. NC1404.2 +004000 01 PRINT-REC PICTURE X(120). NC1404.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1404.2 +004200 WORKING-STORAGE SECTION. NC1404.2 +004300 01 GRP-TABLE1. NC1404.2 +004400 02 ELEM1 PIC S999 OCCURS 100 TIMES NC1404.2 +004500 INDEXED BY INDEX1. NC1404.2 +004600* TWO DIMENSIONAL TABLE. NC1404.2 +004700 01 GRP-TABLE2. NC1404.2 +004800 02 GROUP1 OCCURS 10 TIMES NC1404.2 +004900 INDEXED BY IN1. NC1404.2 +005000 03 ELEM2 PIC S9999 NC1404.2 +005100 USAGE IS COMPUTATIONAL NC1404.2 +005200 OCCURS 10 TIMES NC1404.2 +005300 INDEXED BY IN2. NC1404.2 +005400* SUBSCRIPTS FOR TABLE REFERENCES. NC1404.2 +005500 01 GRP-SUB. NC1404.2 +005600 02 S1 PIC S999 VALUE 1. NC1404.2 +005700 02 S21 PIC S999 VALUE 1. NC1404.2 +005800 02 S22 PIC S999 VALUE 1. NC1404.2 +005900* DATA ITEMS USED IN SET STATEMENTS, FORMAT 2. NC1404.2 +006000 77 CS-3 PICTURE S999 COMPUTATIONAL VALUE ZERO. NC1404.2 +006100 77 CU-3 PICTURE 999 COMPUTATIONAL VALUE ZERO. NC1404.2 +006200 77 DS-3 PICTURE S999 DISPLAY VALUE ZERO. NC1404.2 +006300 77 DU-3 PICTURE 999 DISPLAY VALUE ZERO. NC1404.2 +006400 77 DS-LS-3 PICTURE S999 SIGN IS LEADING SEPARATE CHARACTER NC1404.2 +006500 VALUE ZERO. NC1404.2 +006600 77 DS-TS-3 PICTURE S999 SIGN IS TRAILING SEPARATE NC1404.2 +006700 CHARACTER VALUE ZERO. NC1404.2 +006800 77 EXPECTED-VALUE PIC S999. NC1404.2 +006900 77 TEMP PICTURE S999. NC1404.2 +007000 77 WRK1 PIC S999 VALUE ZERO. NC1404.2 +007100 01 TEST-RESULTS. NC1404.2 +007200 02 FILLER PIC X VALUE SPACE. NC1404.2 +007300 02 FEATURE PIC X(20) VALUE SPACE. NC1404.2 +007400 02 FILLER PIC X VALUE SPACE. NC1404.2 +007500 02 P-OR-F PIC X(5) VALUE SPACE. NC1404.2 +007600 02 FILLER PIC X VALUE SPACE. NC1404.2 +007700 02 PAR-NAME. NC1404.2 +007800 03 FILLER PIC X(19) VALUE SPACE. NC1404.2 +007900 03 PARDOT-X PIC X VALUE SPACE. NC1404.2 +008000 03 DOTVALUE PIC 99 VALUE ZERO. NC1404.2 +008100 02 FILLER PIC X(8) VALUE SPACE. NC1404.2 +008200 02 RE-MARK PIC X(61). NC1404.2 +008300 01 TEST-COMPUTED. NC1404.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC1404.2 +008500 02 FILLER PIC X(17) VALUE NC1404.2 +008600 " COMPUTED=". NC1404.2 +008700 02 COMPUTED-X. NC1404.2 +008800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1404.2 +008900 03 COMPUTED-N REDEFINES COMPUTED-A NC1404.2 +009000 PIC -9(9).9(9). NC1404.2 +009100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1404.2 +009200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1404.2 +009300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1404.2 +009400 03 CM-18V0 REDEFINES COMPUTED-A. NC1404.2 +009500 04 COMPUTED-18V0 PIC -9(18). NC1404.2 +009600 04 FILLER PIC X. NC1404.2 +009700 03 FILLER PIC X(50) VALUE SPACE. NC1404.2 +009800 01 TEST-CORRECT. NC1404.2 +009900 02 FILLER PIC X(30) VALUE SPACE. NC1404.2 +010000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1404.2 +010100 02 CORRECT-X. NC1404.2 +010200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1404.2 +010300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1404.2 +010400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1404.2 +010500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1404.2 +010600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1404.2 +010700 03 CR-18V0 REDEFINES CORRECT-A. NC1404.2 +010800 04 CORRECT-18V0 PIC -9(18). NC1404.2 +010900 04 FILLER PIC X. NC1404.2 +011000 03 FILLER PIC X(2) VALUE SPACE. NC1404.2 +011100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1404.2 +011200 01 CCVS-C-1. NC1404.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1404.2 +011400- "SS PARAGRAPH-NAME NC1404.2 +011500- " REMARKS". NC1404.2 +011600 02 FILLER PIC X(20) VALUE SPACE. NC1404.2 +011700 01 CCVS-C-2. NC1404.2 +011800 02 FILLER PIC X VALUE SPACE. NC1404.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". NC1404.2 +012000 02 FILLER PIC X(15) VALUE SPACE. NC1404.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". NC1404.2 +012200 02 FILLER PIC X(94) VALUE SPACE. NC1404.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1404.2 +012400 01 REC-CT PIC 99 VALUE ZERO. NC1404.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1404.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1404.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1404.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1404.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1404.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1404.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1404.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1404.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1404.2 +013400 01 CCVS-H-1. NC1404.2 +013500 02 FILLER PIC X(39) VALUE SPACES. NC1404.2 +013600 02 FILLER PIC X(42) VALUE NC1404.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1404.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC1404.2 +013900 01 CCVS-H-2A. NC1404.2 +014000 02 FILLER PIC X(40) VALUE SPACE. NC1404.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1404.2 +014200 02 FILLER PIC XXXX VALUE NC1404.2 +014300 "4.2 ". NC1404.2 +014400 02 FILLER PIC X(28) VALUE NC1404.2 +014500 " COPY - NOT FOR DISTRIBUTION". NC1404.2 +014600 02 FILLER PIC X(41) VALUE SPACE. NC1404.2 +014700 NC1404.2 +014800 01 CCVS-H-2B. NC1404.2 +014900 02 FILLER PIC X(15) VALUE NC1404.2 +015000 "TEST RESULT OF ". NC1404.2 +015100 02 TEST-ID PIC X(9). NC1404.2 +015200 02 FILLER PIC X(4) VALUE NC1404.2 +015300 " IN ". NC1404.2 +015400 02 FILLER PIC X(12) VALUE NC1404.2 +015500 " HIGH ". NC1404.2 +015600 02 FILLER PIC X(22) VALUE NC1404.2 +015700 " LEVEL VALIDATION FOR ". NC1404.2 +015800 02 FILLER PIC X(58) VALUE NC1404.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1404.2 +016000 01 CCVS-H-3. NC1404.2 +016100 02 FILLER PIC X(34) VALUE NC1404.2 +016200 " FOR OFFICIAL USE ONLY ". NC1404.2 +016300 02 FILLER PIC X(58) VALUE NC1404.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1404.2 +016500 02 FILLER PIC X(28) VALUE NC1404.2 +016600 " COPYRIGHT 1985 ". NC1404.2 +016700 01 CCVS-E-1. NC1404.2 +016800 02 FILLER PIC X(52) VALUE SPACE. NC1404.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1404.2 +017000 02 ID-AGAIN PIC X(9). NC1404.2 +017100 02 FILLER PIC X(45) VALUE SPACES. NC1404.2 +017200 01 CCVS-E-2. NC1404.2 +017300 02 FILLER PIC X(31) VALUE SPACE. NC1404.2 +017400 02 FILLER PIC X(21) VALUE SPACE. NC1404.2 +017500 02 CCVS-E-2-2. NC1404.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1404.2 +017700 03 FILLER PIC X VALUE SPACE. NC1404.2 +017800 03 ENDER-DESC PIC X(44) VALUE NC1404.2 +017900 "ERRORS ENCOUNTERED". NC1404.2 +018000 01 CCVS-E-3. NC1404.2 +018100 02 FILLER PIC X(22) VALUE NC1404.2 +018200 " FOR OFFICIAL USE ONLY". NC1404.2 +018300 02 FILLER PIC X(12) VALUE SPACE. NC1404.2 +018400 02 FILLER PIC X(58) VALUE NC1404.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1404.2 +018600 02 FILLER PIC X(13) VALUE SPACE. NC1404.2 +018700 02 FILLER PIC X(15) VALUE NC1404.2 +018800 " COPYRIGHT 1985". NC1404.2 +018900 01 CCVS-E-4. NC1404.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1404.2 +019100 02 FILLER PIC X(4) VALUE " OF ". NC1404.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1404.2 +019300 02 FILLER PIC X(40) VALUE NC1404.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1404.2 +019500 01 XXINFO. NC1404.2 +019600 02 FILLER PIC X(19) VALUE NC1404.2 +019700 "*** INFORMATION ***". NC1404.2 +019800 02 INFO-TEXT. NC1404.2 +019900 04 FILLER PIC X(8) VALUE SPACE. NC1404.2 +020000 04 XXCOMPUTED PIC X(20). NC1404.2 +020100 04 FILLER PIC X(5) VALUE SPACE. NC1404.2 +020200 04 XXCORRECT PIC X(20). NC1404.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). NC1404.2 +020400 01 HYPHEN-LINE. NC1404.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. NC1404.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************NC1404.2 +020700- "*****************************************". NC1404.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************NC1404.2 +020900- "******************************". NC1404.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE NC1404.2 +021100 "NC140A". NC1404.2 +021200 PROCEDURE DIVISION. NC1404.2 +021300 CCVS1 SECTION. NC1404.2 +021400 OPEN-FILES. NC1404.2 +021500 OPEN OUTPUT PRINT-FILE. NC1404.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1404.2 +021700 MOVE SPACE TO TEST-RESULTS. NC1404.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1404.2 +021900 GO TO CCVS1-EXIT. NC1404.2 +022000 CLOSE-FILES. NC1404.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1404.2 +022200 TERMINATE-CCVS. NC1404.2 +022300*S EXIT PROGRAM. NC1404.2 +022400*SERMINATE-CALL. NC1404.2 +022500 STOP RUN. NC1404.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1404.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1404.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1404.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1404.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. NC1404.2 +023100 PRINT-DETAIL. NC1404.2 +023200 IF REC-CT NOT EQUAL TO ZERO NC1404.2 +023300 MOVE "." TO PARDOT-X NC1404.2 +023400 MOVE REC-CT TO DOTVALUE. NC1404.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1404.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1404.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1404.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1404.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1404.2 +024000 MOVE SPACE TO CORRECT-X. NC1404.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1404.2 +024200 MOVE SPACE TO RE-MARK. NC1404.2 +024300 HEAD-ROUTINE. NC1404.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1404.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1404.2 +024800 COLUMN-NAMES-ROUTINE. NC1404.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +025200 END-ROUTINE. NC1404.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1404.2 +025400 END-RTN-EXIT. NC1404.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +025600 END-ROUTINE-1. NC1404.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1404.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1404.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. NC1404.2 +026000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1404.2 +026100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1404.2 +026200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1404.2 +026300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1404.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1404.2 +026500 END-ROUTINE-12. NC1404.2 +026600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1404.2 +026700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1404.2 +026800 MOVE "NO " TO ERROR-TOTAL NC1404.2 +026900 ELSE NC1404.2 +027000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1404.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1404.2 +027200 PERFORM WRITE-LINE. NC1404.2 +027300 END-ROUTINE-13. NC1404.2 +027400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1404.2 +027500 MOVE "NO " TO ERROR-TOTAL ELSE NC1404.2 +027600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1404.2 +027700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1404.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +027900 IF INSPECT-COUNTER EQUAL TO ZERO NC1404.2 +028000 MOVE "NO " TO ERROR-TOTAL NC1404.2 +028100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1404.2 +028200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1404.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +028400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1404.2 +028500 WRITE-LINE. NC1404.2 +028600 ADD 1 TO RECORD-COUNT. NC1404.2 +028700 IF RECORD-COUNT GREATER 42 NC1404.2 +028800 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1404.2 +028900 MOVE SPACE TO DUMMY-RECORD NC1404.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1404.2 +029100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1404.2 +029200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1404.2 +029300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1404.2 +029400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1404.2 +029500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1404.2 +029600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1404.2 +029700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1404.2 +029800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1404.2 +029900 MOVE ZERO TO RECORD-COUNT. NC1404.2 +030000 PERFORM WRT-LN. NC1404.2 +030100 WRT-LN. NC1404.2 +030200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1404.2 +030300 MOVE SPACE TO DUMMY-RECORD. NC1404.2 +030400 BLANK-LINE-PRINT. NC1404.2 +030500 PERFORM WRT-LN. NC1404.2 +030600 FAIL-ROUTINE. NC1404.2 +030700 IF COMPUTED-X NOT EQUAL TO SPACE NC1404.2 +030800 GO TO FAIL-ROUTINE-WRITE. NC1404.2 +030900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1404.2 +031000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1404.2 +031100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1404.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1404.2 +031400 GO TO FAIL-ROUTINE-EX. NC1404.2 +031500 FAIL-ROUTINE-WRITE. NC1404.2 +031600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1404.2 +031700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1404.2 +031800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1404.2 +031900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1404.2 +032000 FAIL-ROUTINE-EX. EXIT. NC1404.2 +032100 BAIL-OUT. NC1404.2 +032200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1404.2 +032300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1404.2 +032400 BAIL-OUT-WRITE. NC1404.2 +032500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1404.2 +032600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1404.2 +032700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1404.2 +032800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1404.2 +032900 BAIL-OUT-EX. EXIT. NC1404.2 +033000 CCVS1-EXIT. NC1404.2 +033100 EXIT. NC1404.2 +033200********************************** NC1404.2 +033300*STATEMENT DELETION INSTRUCTIONS NC1404.2 +033400* IF THE COMPILER REJECTS ANY SET STATEMENTS IN THESE TESTS,NC1404.2 +033500* DELETE THAT LINE OF CODE BY PLACING AN * IN COLUMN 7. LEAVE NC1404.2 +033600* THE PERFORM ... THRU STATEMENT. THE TEST DELETED APPEARS AS NC1404.2 +033700* A FAILURE ON THE OUTPUT REPORT. NC1404.2 +033800********************************** NC1404.2 +033900 SECT-NC140A-0001 SECTION. NC1404.2 +034000 NC140A-0001. NC1404.2 +034100 MOVE "VI-127 6.22.4" TO ANSI-REFERENCE. NC1404.2 +034200* THIS SECTION STORES VALUES IN THE TWO TABLES NC1404.2 +034300* USED IN TESTING THE INDEX VALUES. NC1404.2 +034400 MOVE-VALUE. NC1404.2 +034500 ADD 1 TO WRK1. NC1404.2 +034600 MOVE WRK1 TO ELEM1 (S1) ELEM2 (S21 S22). NC1404.2 +034700 IF WRK1 IS EQUAL TO 100 NC1404.2 +034800 GO TO SECT-TH111-0002. NC1404.2 +034900 INCRE-SUBS. NC1404.2 +035000 ADD 1 TO S1. NC1404.2 +035100 ADD 1 TO S22. NC1404.2 +035200 IF S22 LESS THAN 11 NC1404.2 +035300 GO TO MOVE-VALUE. NC1404.2 +035400 MOVE 1 TO S22. NC1404.2 +035500 ADD 1 TO S21. NC1404.2 +035600 GO TO MOVE-VALUE. NC1404.2 +035700 SECT-TH111-0002 SECTION. NC1404.2 +035800 SET-INIT-001. NC1404.2 +035900 MOVE ZERO TO REC-CT. NC1404.2 +036000* THIS TEST VERIFIES THAT THE SET INDEX-NAME UP BY INTEGER NC1404.2 +036100* FUNCTIONS CORRECTLY. THE INTEGER MAY BE POSITIVE, NEGATIVE, NC1404.2 +036200* OR UNSIGNED. NC1404.2 +036300 MOVE ZERO TO TEMP. NC1404.2 +036400 MOVE 6 TO EXPECTED-VALUE. NC1404.2 +036500 MOVE "SET IN UP BY INTEGER" TO FEATURE. NC1404.2 +036600 MOVE "SET-TEST-001" TO PAR-NAME. NC1404.2 +036700 SET-TEST-001-01. NC1404.2 +036800 SET INDEX1 TO 1. NC1404.2 +036900 SET INDEX1 UP BY 5. NC1404.2 +037000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +037100 SET-TEST-001-02. NC1404.2 +037200 SET INDEX1 TO 1. NC1404.2 +037300 SET INDEX1 UP BY +5. NC1404.2 +037400 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +037500 SET-TEST-001-03. NC1404.2 +037600 SET INDEX1 TO 11. NC1404.2 +037700 SET INDEX1 UP BY -5. NC1404.2 +037800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +037900 SET-TEST-001-04. NC1404.2 +038000 SET IN1 TO 1. NC1404.2 +038100 SET IN2 INDEX1 TO 2. NC1404.2 +038200 SET IN2 INDEX1 UP BY 4. NC1404.2 +038300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +038400 SET-TEST-001-05. NC1404.2 +038500 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +038600 SET-TEST-001-06. NC1404.2 +038700 SET IN2 INDEX1 TO 2. NC1404.2 +038800 SET IN2 INDEX1 UP BY +4. NC1404.2 +038900 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +039000 SET-TEST-001-07. NC1404.2 +039100 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +039200 SET-TEST-001-08. NC1404.2 +039300 SET IN2 INDEX1 TO 10. NC1404.2 +039400 SET IN2 INDEX1 UP BY -4. NC1404.2 +039500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +039600 SET-TEST-001-09. NC1404.2 +039700 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +039800 SET-TEST-001-10. NC1404.2 +039900 SET IN1 TO 5. NC1404.2 +040000 SET IN2 TO 10. NC1404.2 +040100 SET IN1 IN2 UP BY -4. NC1404.2 +040200 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +040300 SET-TEST-001-11. NC1404.2 +040400 SET IN2 INDEX1 TO 10. NC1404.2 +040500 SET IN1 TO 5. NC1404.2 +040600 SET IN1 IN2 INDEX1 UP BY -4. NC1404.2 +040700 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +040800 SET-TEST-001-12. NC1404.2 +040900 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +041000 GO TO SET-INIT-002. NC1404.2 +041100 SET-DELETE-001. NC1404.2 +041200 PERFORM DE-LETE. NC1404.2 +041300 PERFORM TEST-WRITE. NC1404.2 +041400 SET-INIT-002. NC1404.2 +041500 MOVE ZERO TO REC-CT. NC1404.2 +041600 MOVE "SET-TEST-002" TO PAR-NAME. NC1404.2 +041700 MOVE ZERO TO TEMP. NC1404.2 +041800 MOVE 54 TO EXPECTED-VALUE. NC1404.2 +041900 MOVE "SET IN DOWN BY INTEG" TO FEATURE. NC1404.2 +042000* THIS TEST VERIFIES THAT THE SET INDEX-NAME DOWN BY NC1404.2 +042100* INTEGER FUNCTIONS CORRECTLY. THE INTEGER MAY BE POSITIVE, NC1404.2 +042200* NEGATIVE, OR UNSIGNED. NC1404.2 +042300 SET-TEST-002-01. NC1404.2 +042400 SET INDEX1 TO 95. NC1404.2 +042500 SET INDEX1 DOWN BY 41. NC1404.2 +042600 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +042700 SET-TEST-002-02. NC1404.2 +042800 SET INDEX1 TO 95. NC1404.2 +042900 SET INDEX1 DOWN BY +41. NC1404.2 +043000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +043100 SET-TEST-002-03. NC1404.2 +043200 SET INDEX1 TO 21. NC1404.2 +043300 SET INDEX1 DOWN BY -33. NC1404.2 +043400 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +043500 SET-TEST-002-04. NC1404.2 +043600 SET IN1 TO 9. NC1404.2 +043700 SET IN2 TO 4. NC1404.2 +043800 SET INDEX1 TO 57. NC1404.2 +043900 SET IN1 INDEX1 DOWN BY 3. NC1404.2 +044000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +044100 SET-TEST-002-05. NC1404.2 +044200 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +044300 SET-TEST-002-06. NC1404.2 +044400 SET IN1 TO 9. NC1404.2 +044500 SET INDEX1 TO 57. NC1404.2 +044600 SET IN1 INDEX1 DOWN BY +3. NC1404.2 +044700 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +044800 SET-TEST-002-07. NC1404.2 +044900 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +045000 SET-TEST-002-08. NC1404.2 +045100 SET IN1 TO 3. NC1404.2 +045200 SET INDEX1 TO 51. NC1404.2 +045300 SET INDEX1 IN1 DOWN BY -3. NC1404.2 +045400 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +045500 SET-TEST-002-09. NC1404.2 +045600 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +045700 SET-TEST-002-10. NC1404.2 +045800 SET IN1 TO 4. NC1404.2 +045900 SET IN2 TO 2. NC1404.2 +046000 SET IN1 IN2 DOWN BY -2. NC1404.2 +046100 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +046200 SET-TEST-002-11. NC1404.2 +046300 SET IN1 TO 5. NC1404.2 +046400 SET IN2 TO 3. NC1404.2 +046500 SET INDEX1 TO 53. NC1404.2 +046600 SET IN1 IN2 INDEX1 DOWN BY -1. NC1404.2 +046700 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +046800 SET-TEST-002-12. NC1404.2 +046900 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +047000 GO TO SET-INIT-003. NC1404.2 +047100 SET-DELETE-002. NC1404.2 +047200 PERFORM DE-LETE. NC1404.2 +047300 PERFORM TEST-WRITE. NC1404.2 +047400 SET-INIT-003. NC1404.2 +047500 MOVE ZERO TO REC-CT. NC1404.2 +047600 MOVE "SET-TEST-003" TO PAR-NAME. NC1404.2 +047700 MOVE ZERO TO TEMP. NC1404.2 +047800 MOVE 39 TO EXPECTED-VALUE. NC1404.2 +047900 MOVE "SET IN UP BY DATA-NM" TO FEATURE. NC1404.2 +048000* THIS TEST VERIFIES THAT THE SET INDEX-NAME UP BY NC1404.2 +048100* DATA-NAME FUNCTIONS CORRECTLY. THE VALUE STORED IN DATA-NAMENC1404.2 +048200* MAY BE POSITIVE, NEGATIVE OR ZERO. VARIOUS DATA TYPES ARE NC1404.2 +048300* USED IN THE TEST. NC1404.2 +048400 SET-TEST-003-01. NC1404.2 +048500 SET INDEX1 TO 21. NC1404.2 +048600 MOVE +18 TO CS-3. NC1404.2 +048700 SET INDEX1 UP BY CS-3. NC1404.2 +048800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +048900 SET-TEST-003-02. NC1404.2 +049000 SET INDEX1 TO 21. NC1404.2 +049100 MOVE +18 TO DS-3. NC1404.2 +049200 SET INDEX1 UP BY DS-3. NC1404.2 +049300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +049400 SET-TEST-003-03. NC1404.2 +049500 SET INDEX1 TO 21. NC1404.2 +049600 MOVE +18 TO DS-LS-3. NC1404.2 +049700 SET INDEX1 UP BY DS-LS-3. NC1404.2 +049800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +049900 SET-TEST-003-04. NC1404.2 +050000 SET INDEX1 TO 21. NC1404.2 +050100 MOVE +18 TO DS-TS-3. NC1404.2 +050200 SET INDEX1 UP BY DS-TS-3. NC1404.2 +050300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +050400 SET-TEST-003-05. NC1404.2 +050500 SET INDEX1 TO 21. NC1404.2 +050600 MOVE 18 TO CU-3. NC1404.2 +050700 SET INDEX1 UP BY CU-3. NC1404.2 +050800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +050900 SET-TEST-003-06. NC1404.2 +051000 SET INDEX1 TO 21. NC1404.2 +051100 MOVE 18 TO DU-3. NC1404.2 +051200 SET INDEX1 UP BY DU-3. NC1404.2 +051300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +051400 SET-TEST-003-07. NC1404.2 +051500 SET INDEX1 TO 39. NC1404.2 +051600 MOVE 0 TO CS-3. NC1404.2 +051700 SET INDEX1 UP BY CS-3. NC1404.2 +051800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +051900 SET-TEST-003-08. NC1404.2 +052000 SET INDEX1 TO 39. NC1404.2 +052100 MOVE ZERO TO DS-3. NC1404.2 +052200 SET INDEX1 UP BY DS-3. NC1404.2 +052300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +052400 SET-TEST-003-09. NC1404.2 +052500 SET INDEX1 TO 39. NC1404.2 +052600 MOVE 0 TO DS-LS-3. NC1404.2 +052700 SET INDEX1 UP BY DS-LS-3. NC1404.2 +052800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +052900 SET-TEST-003-10. NC1404.2 +053000 SET INDEX1 TO 39. NC1404.2 +053100 MOVE ZERO TO DS-TS-3. NC1404.2 +053200 SET INDEX1 UP BY DS-TS-3. NC1404.2 +053300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +053400 SET-TEST-003-11. NC1404.2 +053500 SET INDEX1 TO 39. NC1404.2 +053600 MOVE 0 TO CU-3. NC1404.2 +053700 SET INDEX1 UP BY CU-3. NC1404.2 +053800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +053900 SET-TEST-003-12. NC1404.2 +054000 SET INDEX1 TO 39. NC1404.2 +054100 MOVE ZERO TO DU-3. NC1404.2 +054200 SET INDEX1 UP BY DU-3. NC1404.2 +054300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +054400 SET-TEST-003-13. NC1404.2 +054500 SET INDEX1 TO 70. NC1404.2 +054600 MOVE -31 TO CS-3. NC1404.2 +054700 SET INDEX1 UP BY CS-3. NC1404.2 +054800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +054900 SET-TEST-003-14. NC1404.2 +055000 SET INDEX1 TO 70. NC1404.2 +055100 MOVE -31 TO DS-3. NC1404.2 +055200 SET INDEX1 UP BY DS-3. NC1404.2 +055300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +055400 SET-TEST-003-15. NC1404.2 +055500 SET INDEX1 TO 70. NC1404.2 +055600 MOVE -31 TO DS-LS-3. NC1404.2 +055700 SET INDEX1 UP BY DS-LS-3. NC1404.2 +055800 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +055900 SET-TEST-003-16. NC1404.2 +056000 SET INDEX1 TO 70. NC1404.2 +056100 MOVE -31 TO DS-TS-3. NC1404.2 +056200 SET INDEX1 UP BY DS-TS-3. NC1404.2 +056300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +056400 SET-TEST-003-17. NC1404.2 +056500 SET IN1 TO 1. NC1404.2 +056600 SET IN2 TO 6. NC1404.2 +056700 MOVE +3 TO DS-LS-3. NC1404.2 +056800 SET IN1 IN2 UP BY DS-LS-3. NC1404.2 +056900 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +057000 SET-TEST-003-18. NC1404.2 +057100 SET IN1 TO 1. NC1404.2 +057200 SET IN2 TO 6. NC1404.2 +057300 MOVE +3 TO CS-3. NC1404.2 +057400 SET INDEX1 TO 36. NC1404.2 +057500 SET IN1 IN2 INDEX1 UP BY CS-3. NC1404.2 +057600 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +057700 SET-TEST-003-19. NC1404.2 +057800 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +057900 SET-TEST-003-20. NC1404.2 +058000 SET IN1 TO 5. NC1404.2 +058100 SET IN2 TO 10. NC1404.2 +058200 SET INDEX1 TO 40. NC1404.2 +058300 MOVE -1 TO DS-TS-3. NC1404.2 +058400 SET IN1 IN2 INDEX1 UP BY DS-TS-3. NC1404.2 +058500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +058600 SET-TEST-003-21. NC1404.2 +058700 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +058800 SET-TEST-003-22. NC1404.2 +058900 SET IN1 TO 4. NC1404.2 +059000 SET IN2 TO 9. NC1404.2 +059100 SET INDEX1 TO 39. NC1404.2 +059200 MOVE ZERO TO CU-3. NC1404.2 +059300 SET IN1 IN2 INDEX1 UP BY CU-3. NC1404.2 +059400 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +059500 SET-TEST-003-23. NC1404.2 +059600 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +059700 GO TO SET-INIT-004. NC1404.2 +059800 SET-DELETE-003. NC1404.2 +059900 PERFORM DE-LETE. NC1404.2 +060000 PERFORM TEST-WRITE. NC1404.2 +060100 SET-INIT-004. NC1404.2 +060200 MOVE ZERO TO REC-CT. NC1404.2 +060300 MOVE "SET-TEST-004" TO PAR-NAME. NC1404.2 +060400 MOVE ZERO TO TEMP. NC1404.2 +060500 MOVE 77 TO EXPECTED-VALUE. NC1404.2 +060600 MOVE "SET IN DOWN BY DNAME" TO FEATURE. NC1404.2 +060700* THIS TEST VERIFIES THAT THE SET INDEX-NAME DOWN BY NC1404.2 +060800* DATA-NAME FUNCTIONS CORRECTLY. THE VALUE STORED IN DATA-NAMENC1404.2 +060900* MAY BE POSITIVE, NEGATIVE OR ZERO. VARIOUS DATA TYPES ARE NC1404.2 +061000* USED IN THE TEST. NC1404.2 +061100 SET-TEST-004-01. NC1404.2 +061200 SET INDEX1 TO 100. NC1404.2 +061300 MOVE +23 TO CS-3. NC1404.2 +061400 SET INDEX1 DOWN BY CS-3. NC1404.2 +061500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +061600 SET-TEST-004-02. NC1404.2 +061700 SET INDEX1 TO 100. NC1404.2 +061800 MOVE +23 TO DS-3. NC1404.2 +061900 SET INDEX1 DOWN BY DS-3. NC1404.2 +062000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +062100 SET-TEST-004-03. NC1404.2 +062200 SET INDEX1 TO 100. NC1404.2 +062300 MOVE +23 TO DS-LS-3. NC1404.2 +062400 SET INDEX1 DOWN BY DS-LS-3. NC1404.2 +062500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +062600 SET-TEST-004-04. NC1404.2 +062700 SET INDEX1 TO 100. NC1404.2 +062800 MOVE +23 TO DS-TS-3. NC1404.2 +062900 SET INDEX1 DOWN BY DS-TS-3. NC1404.2 +063000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +063100 SET-TEST-004-05. NC1404.2 +063200 SET INDEX1 TO 100. NC1404.2 +063300 MOVE 23 TO CU-3. NC1404.2 +063400 SET INDEX1 DOWN BY CU-3. NC1404.2 +063500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +063600 SET-TEST-004-06. NC1404.2 +063700 SET INDEX1 TO 100. NC1404.2 +063800 MOVE 23 TO DU-3. NC1404.2 +063900 SET INDEX1 DOWN BY DU-3. NC1404.2 +064000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +064100 SET-TEST-004-07. NC1404.2 +064200 MOVE ZERO TO CS-3. NC1404.2 +064300 SET INDEX1 TO 77. NC1404.2 +064400 SET INDEX1 DOWN BY CS-3. NC1404.2 +064500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +064600 SET-TEST-004-08. NC1404.2 +064700 MOVE 0 TO DS-3. NC1404.2 +064800 SET INDEX1 TO 77. NC1404.2 +064900 SET INDEX1 DOWN BY DS-3. NC1404.2 +065000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +065100 SET-TEST-004-09. NC1404.2 +065200 MOVE 0 TO DS-LS-3. NC1404.2 +065300 SET INDEX1 TO 77. NC1404.2 +065400 SET INDEX1 DOWN BY DS-LS-3. NC1404.2 +065500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +065600 SET-TEST-004-10. NC1404.2 +065700 MOVE ZERO TO DS-TS-3. NC1404.2 +065800 SET INDEX1 TO 77. NC1404.2 +065900 SET INDEX1 DOWN BY DS-TS-3. NC1404.2 +066000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +066100 SET-TEST-004-11. NC1404.2 +066200 MOVE 0 TO CU-3. NC1404.2 +066300 SET INDEX1 TO 77. NC1404.2 +066400 SET INDEX1 DOWN BY CU-3. NC1404.2 +066500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +066600 SET-TEST-004-12. NC1404.2 +066700 MOVE ZERO TO DU-3. NC1404.2 +066800 SET INDEX1 TO 77. NC1404.2 +066900 SET INDEX1 DOWN BY DU-3. NC1404.2 +067000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +067100 SET-TEST-004-13. NC1404.2 +067200 SET INDEX1 TO 2. NC1404.2 +067300 MOVE -75 TO CS-3. NC1404.2 +067400 SET INDEX1 DOWN BY CS-3. NC1404.2 +067500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +067600 SET-TEST-004-14. NC1404.2 +067700 SET INDEX1 TO 2. NC1404.2 +067800 MOVE -75 TO DS-3. NC1404.2 +067900 SET INDEX1 DOWN BY DS-3. NC1404.2 +068000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +068100 SET-TEST-004-15. NC1404.2 +068200 SET INDEX1 TO 2. NC1404.2 +068300 MOVE -75 TO DS-LS-3. NC1404.2 +068400 SET INDEX1 DOWN BY DS-LS-3. NC1404.2 +068500 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +068600 SET-TEST-004-16. NC1404.2 +068700 SET INDEX1 TO 2. NC1404.2 +068800 MOVE -75 TO DS-TS-3. NC1404.2 +068900 SET INDEX1 DOWN BY DS-TS-3. NC1404.2 +069000 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +069100 SET-TEST-004-17. NC1404.2 +069200 SET IN1 TO 10. NC1404.2 +069300 SET IN2 TO 9. NC1404.2 +069400 MOVE +2 TO DS-TS-3. NC1404.2 +069500 SET IN1 IN2 DOWN BY DS-TS-3. NC1404.2 +069600 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +069700 SET-TEST-004-18. NC1404.2 +069800 SET IN1 TO 10. NC1404.2 +069900 SET IN2 TO 9. NC1404.2 +070000 SET INDEX1 TO 79. NC1404.2 +070100 MOVE 2 TO CU-3. NC1404.2 +070200 SET IN1 IN2 INDEX1 DOWN BY CU-3. NC1404.2 +070300 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +070400 SET-TEST-004-19. NC1404.2 +070500 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +070600 SET-TEST-004-20. NC1404.2 +070700 SET IN1 TO 3. NC1404.2 +070800 SET IN2 TO 2. NC1404.2 +070900 SET INDEX1 TO 72. NC1404.2 +071000 MOVE -5 TO DS-3. NC1404.2 +071100 SET INDEX1 IN1 IN2 DOWN BY DS-3. NC1404.2 +071200 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +071300 SET-TEST-004-21. NC1404.2 +071400 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +071500 SET-TEST-004-22. NC1404.2 +071600 MOVE ZERO TO DS-TS-3. NC1404.2 +071700 SET IN1 TO 8. NC1404.2 +071800 SET IN2 TO 7. NC1404.2 +071900 SET INDEX1 TO 77. NC1404.2 +072000 SET IN1 IN2 INDEX1 DOWN BY DS-TS-3. NC1404.2 +072100 PERFORM TEST-CHECK1 THRU TEST-WRITE. NC1404.2 +072200 SET-TEST-004-23. NC1404.2 +072300 PERFORM TEST-CHECK2 THRU TEST-WRITE. NC1404.2 +072400 GO TO CCVS-EXIT. NC1404.2 +072500 SET-DELETE-004. NC1404.2 +072600 PERFORM DE-LETE. NC1404.2 +072700 PERFORM TEST-WRITE. NC1404.2 +072800 GO TO CCVS-EXIT. NC1404.2 +072900 SECT-TH111-0003 SECTION. NC1404.2 +073000 TEST-CHECK1. NC1404.2 +073100 MOVE ELEM1 (INDEX1) TO TEMP. NC1404.2 +073200 GO TO TEST-CHECK. NC1404.2 +073300 TEST-CHECK2. NC1404.2 +073400 MOVE ELEM2 (IN1 IN2) TO TEMP. NC1404.2 +073500 TEST-CHECK. NC1404.2 +073600 ADD 1 TO REC-CT. NC1404.2 +073700 IF TEMP IS EQUAL TO EXPECTED-VALUE NC1404.2 +073800 PERFORM PASS NC1404.2 +073900 GO TO TEST-WRITE. NC1404.2 +074000 TEST-FAIL. NC1404.2 +074100 PERFORM FAIL. NC1404.2 +074200 MOVE TEMP TO COMPUTED-18V0. NC1404.2 +074300 MOVE EXPECTED-VALUE TO CORRECT-18V0. NC1404.2 +074400 TEST-WRITE. NC1404.2 +074500 PERFORM PRINT-DETAIL. NC1404.2 +074600 MOVE ZERO TO TEMP. NC1404.2 +074700 CCVS-EXIT SECTION. NC1404.2 +074800 CCVS-999999. NC1404.2 +074900 GO TO CLOSE-FILES. NC1404.2 diff --git a/tests/cobol85/NC/NC141A.CBL b/tests/cobol85/NC/NC141A.CBL new file mode 100755 index 00000000..d1a5147a --- /dev/null +++ b/tests/cobol85/NC/NC141A.CBL @@ -0,0 +1,507 @@ +000100 IDENTIFICATION DIVISION. NC1414.2 +000200 PROGRAM-ID. NC1414.2 +000300 NC141A. NC1414.2 +000400**************************************************************** NC1414.2 +000500* * NC1414.2 +000600* VALIDATION FOR:- * NC1414.2 +000700* * NC1414.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1414.2 +000900* * NC1414.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1414.2 +001100* * NC1414.2 +001200**************************************************************** NC1414.2 +001300* * NC1414.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1414.2 +001500* * NC1414.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1414.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1414.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1414.2 +001900* * NC1414.2 +002000**************************************************************** NC1414.2 +002100* NC1414.2 +002200* PROGRAM NC141A TESTS FORMAT 1 AND 2 OF THE "SET" NC1414.2 +002300* STATEMENT USING IDENTIFIERS INDEXED BY RELATIVE INDEXES NC1414.2 +002400* AND NUMERIC LITERALS. NC1414.2 +002500* NC1414.2 +002600 ENVIRONMENT DIVISION. NC1414.2 +002700 CONFIGURATION SECTION. NC1414.2 +002800 SOURCE-COMPUTER. NC1414.2 +002900 Linux. NC1414.2 +003000 OBJECT-COMPUTER. NC1414.2 +003100 Linux. NC1414.2 +003200 INPUT-OUTPUT SECTION. NC1414.2 +003300 FILE-CONTROL. NC1414.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1414.2 +003500 "report.log". NC1414.2 +003600 DATA DIVISION. NC1414.2 +003700 FILE SECTION. NC1414.2 +003800 FD PRINT-FILE. NC1414.2 +003900 01 PRINT-REC PICTURE X(120). NC1414.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1414.2 +004100 WORKING-STORAGE SECTION. NC1414.2 +004200 01 TABLE1. NC1414.2 +004300 02 TABLE1-REC PICTURE 99 NC1414.2 +004400 OCCURS 100 TIMES NC1414.2 +004500 INDEXED BY INDEX1. NC1414.2 +004600 01 TABLE2. NC1414.2 +004700 02 TABLE2-REC PICTURE 99 NC1414.2 +004800 OCCURS 12 TIMES NC1414.2 +004900 INDEXED BY INDEX2. NC1414.2 +005000 01 INDEX-ID PIC 999 VALUE ZERO. NC1414.2 +005100 01 TEST-RESULTS. NC1414.2 +005200 02 FILLER PIC X VALUE SPACE. NC1414.2 +005300 02 FEATURE PIC X(20) VALUE SPACE. NC1414.2 +005400 02 FILLER PIC X VALUE SPACE. NC1414.2 +005500 02 P-OR-F PIC X(5) VALUE SPACE. NC1414.2 +005600 02 FILLER PIC X VALUE SPACE. NC1414.2 +005700 02 PAR-NAME. NC1414.2 +005800 03 FILLER PIC X(19) VALUE SPACE. NC1414.2 +005900 03 PARDOT-X PIC X VALUE SPACE. NC1414.2 +006000 03 DOTVALUE PIC 99 VALUE ZERO. NC1414.2 +006100 02 FILLER PIC X(8) VALUE SPACE. NC1414.2 +006200 02 RE-MARK PIC X(61). NC1414.2 +006300 01 TEST-COMPUTED. NC1414.2 +006400 02 FILLER PIC X(30) VALUE SPACE. NC1414.2 +006500 02 FILLER PIC X(17) VALUE NC1414.2 +006600 " COMPUTED=". NC1414.2 +006700 02 COMPUTED-X. NC1414.2 +006800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1414.2 +006900 03 COMPUTED-N REDEFINES COMPUTED-A NC1414.2 +007000 PIC -9(9).9(9). NC1414.2 +007100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1414.2 +007200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1414.2 +007300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1414.2 +007400 03 CM-18V0 REDEFINES COMPUTED-A. NC1414.2 +007500 04 COMPUTED-18V0 PIC -9(18). NC1414.2 +007600 04 FILLER PIC X. NC1414.2 +007700 03 FILLER PIC X(50) VALUE SPACE. NC1414.2 +007800 01 TEST-CORRECT. NC1414.2 +007900 02 FILLER PIC X(30) VALUE SPACE. NC1414.2 +008000 02 FILLER PIC X(17) VALUE " CORRECT =". NC1414.2 +008100 02 CORRECT-X. NC1414.2 +008200 03 CORRECT-A PIC X(20) VALUE SPACE. NC1414.2 +008300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1414.2 +008400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1414.2 +008500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1414.2 +008600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1414.2 +008700 03 CR-18V0 REDEFINES CORRECT-A. NC1414.2 +008800 04 CORRECT-18V0 PIC -9(18). NC1414.2 +008900 04 FILLER PIC X. NC1414.2 +009000 03 FILLER PIC X(2) VALUE SPACE. NC1414.2 +009100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1414.2 +009200 01 CCVS-C-1. NC1414.2 +009300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1414.2 +009400- "SS PARAGRAPH-NAME NC1414.2 +009500- " REMARKS". NC1414.2 +009600 02 FILLER PIC X(20) VALUE SPACE. NC1414.2 +009700 01 CCVS-C-2. NC1414.2 +009800 02 FILLER PIC X VALUE SPACE. NC1414.2 +009900 02 FILLER PIC X(6) VALUE "TESTED". NC1414.2 +010000 02 FILLER PIC X(15) VALUE SPACE. NC1414.2 +010100 02 FILLER PIC X(4) VALUE "FAIL". NC1414.2 +010200 02 FILLER PIC X(94) VALUE SPACE. NC1414.2 +010300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1414.2 +010400 01 REC-CT PIC 99 VALUE ZERO. NC1414.2 +010500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1414.2 +010600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1414.2 +010700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1414.2 +010800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1414.2 +010900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1414.2 +011000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1414.2 +011100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1414.2 +011200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1414.2 +011300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1414.2 +011400 01 CCVS-H-1. NC1414.2 +011500 02 FILLER PIC X(39) VALUE SPACES. NC1414.2 +011600 02 FILLER PIC X(42) VALUE NC1414.2 +011700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1414.2 +011800 02 FILLER PIC X(39) VALUE SPACES. NC1414.2 +011900 01 CCVS-H-2A. NC1414.2 +012000 02 FILLER PIC X(40) VALUE SPACE. NC1414.2 +012100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1414.2 +012200 02 FILLER PIC XXXX VALUE NC1414.2 +012300 "4.2 ". NC1414.2 +012400 02 FILLER PIC X(28) VALUE NC1414.2 +012500 " COPY - NOT FOR DISTRIBUTION". NC1414.2 +012600 02 FILLER PIC X(41) VALUE SPACE. NC1414.2 +012700 NC1414.2 +012800 01 CCVS-H-2B. NC1414.2 +012900 02 FILLER PIC X(15) VALUE NC1414.2 +013000 "TEST RESULT OF ". NC1414.2 +013100 02 TEST-ID PIC X(9). NC1414.2 +013200 02 FILLER PIC X(4) VALUE NC1414.2 +013300 " IN ". NC1414.2 +013400 02 FILLER PIC X(12) VALUE NC1414.2 +013500 " HIGH ". NC1414.2 +013600 02 FILLER PIC X(22) VALUE NC1414.2 +013700 " LEVEL VALIDATION FOR ". NC1414.2 +013800 02 FILLER PIC X(58) VALUE NC1414.2 +013900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1414.2 +014000 01 CCVS-H-3. NC1414.2 +014100 02 FILLER PIC X(34) VALUE NC1414.2 +014200 " FOR OFFICIAL USE ONLY ". NC1414.2 +014300 02 FILLER PIC X(58) VALUE NC1414.2 +014400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1414.2 +014500 02 FILLER PIC X(28) VALUE NC1414.2 +014600 " COPYRIGHT 1985 ". NC1414.2 +014700 01 CCVS-E-1. NC1414.2 +014800 02 FILLER PIC X(52) VALUE SPACE. NC1414.2 +014900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1414.2 +015000 02 ID-AGAIN PIC X(9). NC1414.2 +015100 02 FILLER PIC X(45) VALUE SPACES. NC1414.2 +015200 01 CCVS-E-2. NC1414.2 +015300 02 FILLER PIC X(31) VALUE SPACE. NC1414.2 +015400 02 FILLER PIC X(21) VALUE SPACE. NC1414.2 +015500 02 CCVS-E-2-2. NC1414.2 +015600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1414.2 +015700 03 FILLER PIC X VALUE SPACE. NC1414.2 +015800 03 ENDER-DESC PIC X(44) VALUE NC1414.2 +015900 "ERRORS ENCOUNTERED". NC1414.2 +016000 01 CCVS-E-3. NC1414.2 +016100 02 FILLER PIC X(22) VALUE NC1414.2 +016200 " FOR OFFICIAL USE ONLY". NC1414.2 +016300 02 FILLER PIC X(12) VALUE SPACE. NC1414.2 +016400 02 FILLER PIC X(58) VALUE NC1414.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1414.2 +016600 02 FILLER PIC X(13) VALUE SPACE. NC1414.2 +016700 02 FILLER PIC X(15) VALUE NC1414.2 +016800 " COPYRIGHT 1985". NC1414.2 +016900 01 CCVS-E-4. NC1414.2 +017000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1414.2 +017100 02 FILLER PIC X(4) VALUE " OF ". NC1414.2 +017200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1414.2 +017300 02 FILLER PIC X(40) VALUE NC1414.2 +017400 " TESTS WERE EXECUTED SUCCESSFULLY". NC1414.2 +017500 01 XXINFO. NC1414.2 +017600 02 FILLER PIC X(19) VALUE NC1414.2 +017700 "*** INFORMATION ***". NC1414.2 +017800 02 INFO-TEXT. NC1414.2 +017900 04 FILLER PIC X(8) VALUE SPACE. NC1414.2 +018000 04 XXCOMPUTED PIC X(20). NC1414.2 +018100 04 FILLER PIC X(5) VALUE SPACE. NC1414.2 +018200 04 XXCORRECT PIC X(20). NC1414.2 +018300 02 INF-ANSI-REFERENCE PIC X(48). NC1414.2 +018400 01 HYPHEN-LINE. NC1414.2 +018500 02 FILLER PIC IS X VALUE IS SPACE. NC1414.2 +018600 02 FILLER PIC IS X(65) VALUE IS "************************NC1414.2 +018700- "*****************************************". NC1414.2 +018800 02 FILLER PIC IS X(54) VALUE IS "************************NC1414.2 +018900- "******************************". NC1414.2 +019000 01 CCVS-PGM-ID PIC X(9) VALUE NC1414.2 +019100 "NC141A". NC1414.2 +019200 PROCEDURE DIVISION. NC1414.2 +019300 CCVS1 SECTION. NC1414.2 +019400 OPEN-FILES. NC1414.2 +019500 OPEN OUTPUT PRINT-FILE. NC1414.2 +019600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1414.2 +019700 MOVE SPACE TO TEST-RESULTS. NC1414.2 +019800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1414.2 +019900 GO TO CCVS1-EXIT. NC1414.2 +020000 CLOSE-FILES. NC1414.2 +020100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1414.2 +020200 TERMINATE-CCVS. NC1414.2 +020300*S EXIT PROGRAM. NC1414.2 +020400*SERMINATE-CALL. NC1414.2 +020500 STOP RUN. NC1414.2 +020600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1414.2 +020700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1414.2 +020800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1414.2 +020900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1414.2 +021000 MOVE "****TEST DELETED****" TO RE-MARK. NC1414.2 +021100 PRINT-DETAIL. NC1414.2 +021200 IF REC-CT NOT EQUAL TO ZERO NC1414.2 +021300 MOVE "." TO PARDOT-X NC1414.2 +021400 MOVE REC-CT TO DOTVALUE. NC1414.2 +021500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1414.2 +021600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1414.2 +021700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1414.2 +021800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1414.2 +021900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1414.2 +022000 MOVE SPACE TO CORRECT-X. NC1414.2 +022100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1414.2 +022200 MOVE SPACE TO RE-MARK. NC1414.2 +022300 HEAD-ROUTINE. NC1414.2 +022400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +022500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +022600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1414.2 +022700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1414.2 +022800 COLUMN-NAMES-ROUTINE. NC1414.2 +022900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +023000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +023100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +023200 END-ROUTINE. NC1414.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1414.2 +023400 END-RTN-EXIT. NC1414.2 +023500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +023600 END-ROUTINE-1. NC1414.2 +023700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1414.2 +023800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1414.2 +023900 ADD PASS-COUNTER TO ERROR-HOLD. NC1414.2 +024000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1414.2 +024100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1414.2 +024200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1414.2 +024300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1414.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1414.2 +024500 END-ROUTINE-12. NC1414.2 +024600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1414.2 +024700 IF ERROR-COUNTER IS EQUAL TO ZERO NC1414.2 +024800 MOVE "NO " TO ERROR-TOTAL NC1414.2 +024900 ELSE NC1414.2 +025000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1414.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1414.2 +025200 PERFORM WRITE-LINE. NC1414.2 +025300 END-ROUTINE-13. NC1414.2 +025400 IF DELETE-COUNTER IS EQUAL TO ZERO NC1414.2 +025500 MOVE "NO " TO ERROR-TOTAL ELSE NC1414.2 +025600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1414.2 +025700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1414.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +025900 IF INSPECT-COUNTER EQUAL TO ZERO NC1414.2 +026000 MOVE "NO " TO ERROR-TOTAL NC1414.2 +026100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1414.2 +026200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1414.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +026400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1414.2 +026500 WRITE-LINE. NC1414.2 +026600 ADD 1 TO RECORD-COUNT. NC1414.2 +026700 IF RECORD-COUNT GREATER 42 NC1414.2 +026800 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1414.2 +026900 MOVE SPACE TO DUMMY-RECORD NC1414.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1414.2 +027100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1414.2 +027200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1414.2 +027300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1414.2 +027400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1414.2 +027500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1414.2 +027600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1414.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1414.2 +027800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1414.2 +027900 MOVE ZERO TO RECORD-COUNT. NC1414.2 +028000 PERFORM WRT-LN. NC1414.2 +028100 WRT-LN. NC1414.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1414.2 +028300 MOVE SPACE TO DUMMY-RECORD. NC1414.2 +028400 BLANK-LINE-PRINT. NC1414.2 +028500 PERFORM WRT-LN. NC1414.2 +028600 FAIL-ROUTINE. NC1414.2 +028700 IF COMPUTED-X NOT EQUAL TO SPACE NC1414.2 +028800 GO TO FAIL-ROUTINE-WRITE. NC1414.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1414.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1414.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1414.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. NC1414.2 +029400 GO TO FAIL-ROUTINE-EX. NC1414.2 +029500 FAIL-ROUTINE-WRITE. NC1414.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1414.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1414.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1414.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. NC1414.2 +030000 FAIL-ROUTINE-EX. EXIT. NC1414.2 +030100 BAIL-OUT. NC1414.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1414.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1414.2 +030400 BAIL-OUT-WRITE. NC1414.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1414.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1414.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1414.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. NC1414.2 +030900 BAIL-OUT-EX. EXIT. NC1414.2 +031000 CCVS1-EXIT. NC1414.2 +031100 EXIT. NC1414.2 +031200 SECT-NC141A-001 SECTION. NC1414.2 +031300 INIT-PARA. NC1414.2 +031400 MOVE "VI-127 6.22.4" TO ANSI-REFERENCE. NC1414.2 +031500 BUILD-TABLE2. NC1414.2 +031600 MOVE 21 TO TABLE2-REC (1). NC1414.2 +031700 MOVE 02 TO TABLE2-REC (2). NC1414.2 +031800 MOVE 03 TO TABLE2-REC (3). NC1414.2 +031900 MOVE 11 TO TABLE2-REC (4). NC1414.2 +032000 MOVE 05 TO TABLE2-REC (5). NC1414.2 +032100 MOVE 10 TO TABLE2-REC (6). NC1414.2 +032200 MOVE 26 TO TABLE2-REC (7). NC1414.2 +032300 MOVE 02 TO TABLE2-REC (8). NC1414.2 +032400 MOVE 16 TO TABLE2-REC (9). NC1414.2 +032500 MOVE 62 TO TABLE2-REC (10). NC1414.2 +032600 MOVE 10 TO TABLE2-REC (11). NC1414.2 +032700 MOVE 04 TO TABLE2-REC (12). NC1414.2 +032800 SET-TEST-1. NC1414.2 +032900 MOVE "SET ... TO" TO FEATURE. NC1414.2 +033000 SET INDEX1 TO 1. NC1414.2 +033100 SET INDEX2 TO 7. NC1414.2 +033200 SET INDEX1 TO TABLE2-REC (INDEX2). NC1414.2 +033300 IF INDEX1 EQUAL TO 26 NC1414.2 +033400 PERFORM PASS NC1414.2 +033500 ELSE GO TO SET-FAIL-1. NC1414.2 +033600 GO TO SET-WRITE-1. NC1414.2 +033700 SET-DELETE-1. NC1414.2 +033800 PERFORM DE-LETE. NC1414.2 +033900 GO TO SET-WRITE-1. NC1414.2 +034000 SET-FAIL-1. NC1414.2 +034100 PERFORM FAIL. NC1414.2 +034200 SET INDEX-ID TO INDEX1. NC1414.2 +034300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +034400 MOVE 26 TO CORRECT-18V0. NC1414.2 +034500 SET-WRITE-1. NC1414.2 +034600 MOVE "SET-TEST-1" TO PAR-NAME. NC1414.2 +034700 PERFORM PRINT-DETAIL. NC1414.2 +034800 SET-TEST-2. NC1414.2 +034900 MOVE "SET ... UP BY" TO FEATURE. NC1414.2 +035000 SET INDEX1 TO 7. NC1414.2 +035100 SET INDEX2 TO 8. NC1414.2 +035200 SET INDEX1 UP BY TABLE2-REC (INDEX2). NC1414.2 +035300 IF INDEX1 EQUAL TO 9 NC1414.2 +035400 PERFORM PASS NC1414.2 +035500 ELSE GO TO SET-FAIL-2. NC1414.2 +035600 GO TO SET-WRITE-2. NC1414.2 +035700 SET-DELETE-2. NC1414.2 +035800 PERFORM DE-LETE. NC1414.2 +035900 GO TO SET-WRITE-2. NC1414.2 +036000 SET-FAIL-2. NC1414.2 +036100 PERFORM FAIL. NC1414.2 +036200 SET INDEX-ID TO INDEX1. NC1414.2 +036300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +036400 MOVE 09 TO CORRECT-18V0. NC1414.2 +036500 SET-WRITE-2. NC1414.2 +036600 MOVE "SET-TEST-2" TO PAR-NAME. NC1414.2 +036700 PERFORM PRINT-DETAIL. NC1414.2 +036800 SET-TEST-3. NC1414.2 +036900 MOVE "SET ... DOWN BY" TO FEATURE. NC1414.2 +037000 SET INDEX1 TO 56. NC1414.2 +037100 SET INDEX2 TO 9. NC1414.2 +037200 SET INDEX1 DOWN BY TABLE2-REC (INDEX2). NC1414.2 +037300 IF INDEX1 EQUAL TO 40 NC1414.2 +037400 PERFORM PASS NC1414.2 +037500 ELSE GO TO SET-FAIL-3. NC1414.2 +037600 GO TO SET-WRITE-3. NC1414.2 +037700 SET-DELETE-3. NC1414.2 +037800 PERFORM DE-LETE. NC1414.2 +037900 GO TO SET-WRITE-3. NC1414.2 +038000 SET-FAIL-3. NC1414.2 +038100 PERFORM FAIL. NC1414.2 +038200 SET INDEX-ID TO INDEX1. NC1414.2 +038300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +038400 MOVE 40 TO CORRECT-18V0. NC1414.2 +038500 SET-WRITE-3. NC1414.2 +038600 MOVE "SET-TEST-3" TO PAR-NAME. NC1414.2 +038700 PERFORM PRINT-DETAIL. NC1414.2 +038800 SET-TEST-4. NC1414.2 +038900 MOVE "SET ... TO" TO FEATURE. NC1414.2 +039000 SET INDEX1 TO 1. NC1414.2 +039100 SET INDEX2 TO 9. NC1414.2 +039200 SET INDEX1 TO TABLE2-REC (INDEX2 + 1). NC1414.2 +039300 IF INDEX1 EQUAL TO 62 NC1414.2 +039400 PERFORM PASS NC1414.2 +039500 ELSE GO TO SET-FAIL-4. NC1414.2 +039600 GO TO SET-WRITE-4. NC1414.2 +039700 SET-DELETE-4. NC1414.2 +039800 PERFORM DE-LETE. NC1414.2 +039900 GO TO SET-WRITE-4. NC1414.2 +040000 SET-FAIL-4. NC1414.2 +040100 PERFORM FAIL. NC1414.2 +040200 SET INDEX-ID TO INDEX1. NC1414.2 +040300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +040400 MOVE 62 TO CORRECT-18V0. NC1414.2 +040500 SET-WRITE-4. NC1414.2 +040600 MOVE "SET-TEST-4" TO PAR-NAME. NC1414.2 +040700 PERFORM PRINT-DETAIL. NC1414.2 +040800 SET-TEST-5. NC1414.2 +040900 MOVE "SET ... UP BY" TO FEATURE. NC1414.2 +041000 SET INDEX1 TO 10. NC1414.2 +041100 SET INDEX2 TO 12. NC1414.2 +041200 SET INDEX1 UP BY TABLE2-REC (INDEX2 - 1). NC1414.2 +041300 IF INDEX1 EQUAL TO 20 NC1414.2 +041400 PERFORM PASS NC1414.2 +041500 ELSE GO TO SET-FAIL-5. NC1414.2 +041600 GO TO SET-WRITE-5. NC1414.2 +041700 SET-DELETE-5. NC1414.2 +041800 PERFORM DE-LETE. NC1414.2 +041900 GO TO SET-WRITE-5. NC1414.2 +042000 SET-FAIL-5. NC1414.2 +042100 PERFORM FAIL. NC1414.2 +042200 SET INDEX-ID TO INDEX1. NC1414.2 +042300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +042400 MOVE 20 TO CORRECT-18V0. NC1414.2 +042500 SET-WRITE-5. NC1414.2 +042600 MOVE "SET-TEST-5" TO PAR-NAME. NC1414.2 +042700 PERFORM PRINT-DETAIL. NC1414.2 +042800 SET-TEST-6. NC1414.2 +042900 MOVE "SET ... DOWN BY" TO FEATURE. NC1414.2 +043000 SET INDEX1 TO 15. NC1414.2 +043100 SET INDEX2 TO 8. NC1414.2 +043200 SET INDEX1 DOWN BY TABLE2-REC (INDEX2 + 4). NC1414.2 +043300 IF INDEX1 EQUAL TO 11 NC1414.2 +043400 PERFORM PASS NC1414.2 +043500 ELSE GO TO SET-FAIL-6. NC1414.2 +043600 GO TO SET-WRITE-6. NC1414.2 +043700 SET-DELETE-6. NC1414.2 +043800 PERFORM DE-LETE. NC1414.2 +043900 GO TO SET-WRITE-6. NC1414.2 +044000 SET-FAIL-6. NC1414.2 +044100 PERFORM FAIL. NC1414.2 +044200 SET INDEX-ID TO INDEX1. NC1414.2 +044300 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +044400 MOVE 11 TO CORRECT-18V0. NC1414.2 +044500 SET-WRITE-6. NC1414.2 +044600 MOVE "SET-TEST-6" TO PAR-NAME. NC1414.2 +044700 PERFORM PRINT-DETAIL. NC1414.2 +044800 SET-TEST-7. NC1414.2 +044900 MOVE "SET ... TO" TO FEATURE. NC1414.2 +045000 SET INDEX1 TO 1. NC1414.2 +045100 SET INDEX1 TO TABLE2-REC (1). NC1414.2 +045200 IF INDEX1 EQUAL TO 21 NC1414.2 +045300 PERFORM PASS NC1414.2 +045400 ELSE GO TO SET-FAIL-7. NC1414.2 +045500 GO TO SET-WRITE-7. NC1414.2 +045600 SET-DELETE-7. NC1414.2 +045700 PERFORM DE-LETE. NC1414.2 +045800 GO TO SET-WRITE-7. NC1414.2 +045900 SET-FAIL-7. NC1414.2 +046000 PERFORM FAIL. NC1414.2 +046100 SET INDEX-ID TO INDEX1. NC1414.2 +046200 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +046300 MOVE 21 TO CORRECT-18V0. NC1414.2 +046400 SET-WRITE-7. NC1414.2 +046500 MOVE "SET-TEST-7" TO PAR-NAME. NC1414.2 +046600 PERFORM PRINT-DETAIL. NC1414.2 +046700 SET-TEST-8. NC1414.2 +046800 MOVE "SET ... UP BY" TO FEATURE. NC1414.2 +046900 SET INDEX1 TO 21. NC1414.2 +047000 SET INDEX1 UP BY TABLE2-REC (2). NC1414.2 +047100 IF INDEX1 EQUAL TO 23 NC1414.2 +047200 PERFORM PASS NC1414.2 +047300 ELSE GO TO SET-FAIL-8. NC1414.2 +047400 GO TO SET-WRITE-8. NC1414.2 +047500 SET-DELETE-8. NC1414.2 +047600 PERFORM DE-LETE. NC1414.2 +047700 GO TO SET-WRITE-8. NC1414.2 +047800 SET-FAIL-8. NC1414.2 +047900 PERFORM FAIL. NC1414.2 +048000 SET INDEX-ID TO INDEX1. NC1414.2 +048100 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +048200 MOVE 23 TO CORRECT-18V0. NC1414.2 +048300 SET-WRITE-8. NC1414.2 +048400 MOVE "SET-TEST-8" TO PAR-NAME. NC1414.2 +048500 PERFORM PRINT-DETAIL. NC1414.2 +048600 SET-TEST-9. NC1414.2 +048700 MOVE "SET ... DOWN BY" TO FEATURE. NC1414.2 +048800 SET INDEX1 TO 23. NC1414.2 +048900 SET INDEX1 DOWN BY TABLE2-REC (3). NC1414.2 +049000 IF INDEX1 EQUAL TO 20 NC1414.2 +049100 PERFORM PASS NC1414.2 +049200 ELSE GO TO SET-FAIL-9. NC1414.2 +049300 GO TO SET-WRITE-9. NC1414.2 +049400 SET-DELETE-9. NC1414.2 +049500 PERFORM DE-LETE. NC1414.2 +049600 GO TO SET-WRITE-9. NC1414.2 +049700 SET-FAIL-9. NC1414.2 +049800 PERFORM FAIL. NC1414.2 +049900 SET INDEX-ID TO INDEX1. NC1414.2 +050000 MOVE INDEX-ID TO COMPUTED-18V0. NC1414.2 +050100 MOVE 20 TO CORRECT-18V0. NC1414.2 +050200 SET-WRITE-9. NC1414.2 +050300 MOVE "SET-TEST-9" TO PAR-NAME. NC1414.2 +050400 PERFORM PRINT-DETAIL. NC1414.2 +050500 CCVS-EXIT SECTION. NC1414.2 +050600 CCVS-999999. NC1414.2 +050700 GO TO CLOSE-FILES. NC1414.2 diff --git a/tests/cobol85/NC/NC170A.CBL b/tests/cobol85/NC/NC170A.CBL new file mode 100755 index 00000000..7967deaa --- /dev/null +++ b/tests/cobol85/NC/NC170A.CBL @@ -0,0 +1,2015 @@ +000100 IDENTIFICATION DIVISION. NC1704.2 +000200 PROGRAM-ID. NC1704.2 +000300 NC170A. NC1704.2 +000400**************************************************************** NC1704.2 +000500* * NC1704.2 +000600* VALIDATION FOR:- * NC1704.2 +000700* * NC1704.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1704.2 +000900* * NC1704.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1704.2 +001100* * NC1704.2 +001200**************************************************************** NC1704.2 +001300* * NC1704.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1704.2 +001500* * NC1704.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1704.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1704.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1704.2 +001900* * NC1704.2 +002000**************************************************************** NC1704.2 +002100* NC1704.2 +002200* THIS PROGRAM TESTS THE FORMAT 2 MULTIPLY STATEMENT FOUND NC1704.2 +002300* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1704.2 +002400* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1704.2 +002500* TESTED, AS WELL AS THE ROUNDED OPTION. NC1704.2 +002600* NC1704.2 +002700* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1704.2 +002800* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1704.2 +002900* AS OPERANDS. NC1704.2 +003000* NC1704.2 +003100 NC1704.2 +003200 ENVIRONMENT DIVISION. NC1704.2 +003300 CONFIGURATION SECTION. NC1704.2 +003400 SOURCE-COMPUTER. NC1704.2 +003500 Linux. NC1704.2 +003600 OBJECT-COMPUTER. NC1704.2 +003700 Linux. NC1704.2 +003800 INPUT-OUTPUT SECTION. NC1704.2 +003900 FILE-CONTROL. NC1704.2 +004000 SELECT PRINT-FILE ASSIGN TO NC1704.2 +004100 "report.log". NC1704.2 +004200 DATA DIVISION. NC1704.2 +004300 FILE SECTION. NC1704.2 +004400 FD PRINT-FILE. NC1704.2 +004500 01 PRINT-REC PICTURE X(120). NC1704.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC1704.2 +004700 WORKING-STORAGE SECTION. NC1704.2 +004800 77 WRK-DS-18V00 PICTURE S9(18). NC1704.2 +004900 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1704.2 +005000 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1704.2 +005100 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1704.2 +005200 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1704.2 +005300 77 WRK-DS-10V00 PICTURE S9(10). NC1704.2 +005400 77 WRK-XN-00001 PICTURE X. NC1704.2 +005500 77 A10ONES-DS-10V00 PICTURE S9(10) NC1704.2 +005600 VALUE 1111111111. NC1704.2 +005700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1704.2 +005800 VALUE 333333.333333. NC1704.2 +005900 77 WRK-DS-02V00 PICTURE S99. NC1704.2 +006000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1704.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1704.2 +006200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1704.2 +006300 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1704.2 +006400 77 A12ONES-DS-12V00 PICTURE S9(12) NC1704.2 +006500 VALUE 111111111111. NC1704.2 +006600 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1704.2 +006700 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1704.2 +006800 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1704.2 +006900 77 A18ONES-DS-18V00 PICTURE S9(18) NC1704.2 +007000 VALUE 111111111111111111. NC1704.2 +007100 77 WRK-DS-0201P PICTURE S99P. NC1704.2 +007200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1704.2 +007300 77 WRK-DU-18V00 PICTURE 9(18). NC1704.2 +007400 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1704.2 +007500 VALUE 99. NC1704.2 +007600 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1704.2 +007700 VALUE .1. NC1704.2 +007800 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1704.2 +007900 77 WRK-DS-12V00 PICTURE S9(12). NC1704.2 +008000 77 WRK-DS-01V00 PICTURE S9. NC1704.2 +008100 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1704.2 +008200 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1704.2 +008300 VALUE 111111111.111111111. NC1704.2 +008400 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1704.2 +008500 77 WRK-DS-05V00 PICTURE S9(5). NC1704.2 +008600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1704.2 +008700 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1704.2 +008800 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1704.2 +008900 77 XRAY PICTURE X. NC1704.2 +009000 01 WRK-XN-18-1 PIC X(18). NC1704.2 +009100 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1704.2 +009200 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1704.2 +009300 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1704.2 +009400 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1704.2 +009500 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1704.2 +009600 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1704.2 +009700 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1704.2 +009800 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1704.2 +009900 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1704.2 +010000 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1704.2 +010100 01 WRK-DU-1V5-1 PIC 9V9(5). NC1704.2 +010200 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1704.2 +010300 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1704.2 +010400 01 WRK-DU-2V0-1 PIC 99. NC1704.2 +010500 01 WRK-DU-2V0-2 PIC 99. NC1704.2 +010600 01 WRK-DU-2V0-3 PIC 99. NC1704.2 +010700 01 WRK-DU-2V1-1 PIC 99V9. NC1704.2 +010800 01 WRK-DU-2V1-2 PIC 99V9. NC1704.2 +010900 01 WRK-DU-2V1-3 PIC 99V9. NC1704.2 +011000 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1704.2 +011100 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1704.2 +011200 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1704.2 +011300 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1704.2 +011400 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1704.2 +011500 01 WRK-DU-2V5-1 PIC 99V9(5). NC1704.2 +011600 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1704.2 +011700 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1704.2 +011800 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1704.2 +011900 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1704.2 +012000 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1704.2 +012100 01 WRK-NE-X-1 PIC 9(16).99. NC1704.2 +012200 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1704.2 +012300 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1704.2 +012400 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1704.2 +012500 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1704.2 +012600 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1704.2 +012700 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1704.2 +012800 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1704.2 +012900 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1704.2 +013000 01 WRK-NE-X-2 PIC -9(16).99. NC1704.2 +013100 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1704.2 +013200 01 WRK-NE-2 PIC $**.99. NC1704.2 +013300 01 WRK-NE-3 PIC $99.99CR. NC1704.2 +013400 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1704.2 +013500 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1704.2 +013600 VALUE +000000000000000001. NC1704.2 +013700 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1704.2 +013800 VALUE -000000000000000033. NC1704.2 +013900 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1704.2 +014000 VALUE 666666666666666666. NC1704.2 +014100 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1704.2 +014200 VALUE 009999999999999999. NC1704.2 +014300 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1704.2 +014400 VALUE 000022222222222222. NC1704.2 +014500 01 MULTIPLY-DATA. NC1704.2 +014600 02 MULT1 PICTURE IS 999V99 NC1704.2 +014700 VALUE IS 80.12. NC1704.2 +014800 02 MULT2 PICTURE IS 999V999. NC1704.2 +014900 02 MULT3 PICTURE IS $$99.99. NC1704.2 +015000 02 MULT4 PICTURE IS S99 NC1704.2 +015100 VALUE IS -56. NC1704.2 +015200 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1704.2 +015300 02 MULT6 PICTURE IS 99 VALUE IS NC1704.2 +015400 20. NC1704.2 +015500 01 DIVIDE-DATA. NC1704.2 +015600 02 DIV1 PICTURE IS 9(4)V99 NC1704.2 +015700 VALUE IS 1620.36. NC1704.2 +015800 02 DIV2 PICTURE IS 99V9 NC1704.2 +015900 VALUE IS 44.1. NC1704.2 +016000 02 DIV3 PICTURE IS 9(4)V9 NC1704.2 +016100 VALUE IS 1661.7. NC1704.2 +016200 02 DIV4 PICTURE IS S9V999 NC1704.2 +016300 VALUE IS -9.642. NC1704.2 +016400 02 DIV-02LEVEL-1. NC1704.2 +016500 03 DIV5 PICTURE IS V99 NC1704.2 +016600 VALUE IS .82. NC1704.2 +016700 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1704.2 +016800 03 DIV7 PICTURE IS 9V9 NC1704.2 +016900 VALUE IS 9.6. NC1704.2 +017000 01 DIV-DATA-2. NC1704.2 +017100 02 DIV8 PICTURE IS 99V9. NC1704.2 +017200 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1704.2 +017300 02 DIV10 PICTURE IS V999. NC1704.2 +017400 01 TEST-RESULTS. NC1704.2 +017500 02 FILLER PIC X VALUE SPACE. NC1704.2 +017600 02 FEATURE PIC X(20) VALUE SPACE. NC1704.2 +017700 02 FILLER PIC X VALUE SPACE. NC1704.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. NC1704.2 +017900 02 FILLER PIC X VALUE SPACE. NC1704.2 +018000 02 PAR-NAME. NC1704.2 +018100 03 FILLER PIC X(19) VALUE SPACE. NC1704.2 +018200 03 PARDOT-X PIC X VALUE SPACE. NC1704.2 +018300 03 DOTVALUE PIC 99 VALUE ZERO. NC1704.2 +018400 02 FILLER PIC X(8) VALUE SPACE. NC1704.2 +018500 02 RE-MARK PIC X(61). NC1704.2 +018600 01 TEST-COMPUTED. NC1704.2 +018700 02 FILLER PIC X(30) VALUE SPACE. NC1704.2 +018800 02 FILLER PIC X(17) VALUE NC1704.2 +018900 " COMPUTED=". NC1704.2 +019000 02 COMPUTED-X. NC1704.2 +019100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1704.2 +019200 03 COMPUTED-N REDEFINES COMPUTED-A NC1704.2 +019300 PIC -9(9).9(9). NC1704.2 +019400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1704.2 +019500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1704.2 +019600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1704.2 +019700 03 CM-18V0 REDEFINES COMPUTED-A. NC1704.2 +019800 04 COMPUTED-18V0 PIC -9(18). NC1704.2 +019900 04 FILLER PIC X. NC1704.2 +020000 03 FILLER PIC X(50) VALUE SPACE. NC1704.2 +020100 01 TEST-CORRECT. NC1704.2 +020200 02 FILLER PIC X(30) VALUE SPACE. NC1704.2 +020300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1704.2 +020400 02 CORRECT-X. NC1704.2 +020500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1704.2 +020600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1704.2 +020700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1704.2 +020800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1704.2 +020900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1704.2 +021000 03 CR-18V0 REDEFINES CORRECT-A. NC1704.2 +021100 04 CORRECT-18V0 PIC -9(18). NC1704.2 +021200 04 FILLER PIC X. NC1704.2 +021300 03 FILLER PIC X(2) VALUE SPACE. NC1704.2 +021400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1704.2 +021500 01 CCVS-C-1. NC1704.2 +021600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1704.2 +021700- "SS PARAGRAPH-NAME NC1704.2 +021800- " REMARKS". NC1704.2 +021900 02 FILLER PIC X(20) VALUE SPACE. NC1704.2 +022000 01 CCVS-C-2. NC1704.2 +022100 02 FILLER PIC X VALUE SPACE. NC1704.2 +022200 02 FILLER PIC X(6) VALUE "TESTED". NC1704.2 +022300 02 FILLER PIC X(15) VALUE SPACE. NC1704.2 +022400 02 FILLER PIC X(4) VALUE "FAIL". NC1704.2 +022500 02 FILLER PIC X(94) VALUE SPACE. NC1704.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1704.2 +022700 01 REC-CT PIC 99 VALUE ZERO. NC1704.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1704.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1704.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1704.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1704.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1704.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1704.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1704.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1704.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1704.2 +023700 01 CCVS-H-1. NC1704.2 +023800 02 FILLER PIC X(39) VALUE SPACES. NC1704.2 +023900 02 FILLER PIC X(42) VALUE NC1704.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1704.2 +024100 02 FILLER PIC X(39) VALUE SPACES. NC1704.2 +024200 01 CCVS-H-2A. NC1704.2 +024300 02 FILLER PIC X(40) VALUE SPACE. NC1704.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1704.2 +024500 02 FILLER PIC XXXX VALUE NC1704.2 +024600 "4.2 ". NC1704.2 +024700 02 FILLER PIC X(28) VALUE NC1704.2 +024800 " COPY - NOT FOR DISTRIBUTION". NC1704.2 +024900 02 FILLER PIC X(41) VALUE SPACE. NC1704.2 +025000 NC1704.2 +025100 01 CCVS-H-2B. NC1704.2 +025200 02 FILLER PIC X(15) VALUE NC1704.2 +025300 "TEST RESULT OF ". NC1704.2 +025400 02 TEST-ID PIC X(9). NC1704.2 +025500 02 FILLER PIC X(4) VALUE NC1704.2 +025600 " IN ". NC1704.2 +025700 02 FILLER PIC X(12) VALUE NC1704.2 +025800 " HIGH ". NC1704.2 +025900 02 FILLER PIC X(22) VALUE NC1704.2 +026000 " LEVEL VALIDATION FOR ". NC1704.2 +026100 02 FILLER PIC X(58) VALUE NC1704.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1704.2 +026300 01 CCVS-H-3. NC1704.2 +026400 02 FILLER PIC X(34) VALUE NC1704.2 +026500 " FOR OFFICIAL USE ONLY ". NC1704.2 +026600 02 FILLER PIC X(58) VALUE NC1704.2 +026700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1704.2 +026800 02 FILLER PIC X(28) VALUE NC1704.2 +026900 " COPYRIGHT 1985 ". NC1704.2 +027000 01 CCVS-E-1. NC1704.2 +027100 02 FILLER PIC X(52) VALUE SPACE. NC1704.2 +027200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1704.2 +027300 02 ID-AGAIN PIC X(9). NC1704.2 +027400 02 FILLER PIC X(45) VALUE SPACES. NC1704.2 +027500 01 CCVS-E-2. NC1704.2 +027600 02 FILLER PIC X(31) VALUE SPACE. NC1704.2 +027700 02 FILLER PIC X(21) VALUE SPACE. NC1704.2 +027800 02 CCVS-E-2-2. NC1704.2 +027900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1704.2 +028000 03 FILLER PIC X VALUE SPACE. NC1704.2 +028100 03 ENDER-DESC PIC X(44) VALUE NC1704.2 +028200 "ERRORS ENCOUNTERED". NC1704.2 +028300 01 CCVS-E-3. NC1704.2 +028400 02 FILLER PIC X(22) VALUE NC1704.2 +028500 " FOR OFFICIAL USE ONLY". NC1704.2 +028600 02 FILLER PIC X(12) VALUE SPACE. NC1704.2 +028700 02 FILLER PIC X(58) VALUE NC1704.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1704.2 +028900 02 FILLER PIC X(13) VALUE SPACE. NC1704.2 +029000 02 FILLER PIC X(15) VALUE NC1704.2 +029100 " COPYRIGHT 1985". NC1704.2 +029200 01 CCVS-E-4. NC1704.2 +029300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1704.2 +029400 02 FILLER PIC X(4) VALUE " OF ". NC1704.2 +029500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1704.2 +029600 02 FILLER PIC X(40) VALUE NC1704.2 +029700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1704.2 +029800 01 XXINFO. NC1704.2 +029900 02 FILLER PIC X(19) VALUE NC1704.2 +030000 "*** INFORMATION ***". NC1704.2 +030100 02 INFO-TEXT. NC1704.2 +030200 04 FILLER PIC X(8) VALUE SPACE. NC1704.2 +030300 04 XXCOMPUTED PIC X(20). NC1704.2 +030400 04 FILLER PIC X(5) VALUE SPACE. NC1704.2 +030500 04 XXCORRECT PIC X(20). NC1704.2 +030600 02 INF-ANSI-REFERENCE PIC X(48). NC1704.2 +030700 01 HYPHEN-LINE. NC1704.2 +030800 02 FILLER PIC IS X VALUE IS SPACE. NC1704.2 +030900 02 FILLER PIC IS X(65) VALUE IS "************************NC1704.2 +031000- "*****************************************". NC1704.2 +031100 02 FILLER PIC IS X(54) VALUE IS "************************NC1704.2 +031200- "******************************". NC1704.2 +031300 01 CCVS-PGM-ID PIC X(9) VALUE NC1704.2 +031400 "NC170A". NC1704.2 +031500 PROCEDURE DIVISION. NC1704.2 +031600 CCVS1 SECTION. NC1704.2 +031700 OPEN-FILES. NC1704.2 +031800 OPEN OUTPUT PRINT-FILE. NC1704.2 +031900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1704.2 +032000 MOVE SPACE TO TEST-RESULTS. NC1704.2 +032100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1704.2 +032200 GO TO CCVS1-EXIT. NC1704.2 +032300 CLOSE-FILES. NC1704.2 +032400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1704.2 +032500 TERMINATE-CCVS. NC1704.2 +032600*S EXIT PROGRAM. NC1704.2 +032700*SERMINATE-CALL. NC1704.2 +032800 STOP RUN. NC1704.2 +032900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1704.2 +033000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1704.2 +033100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1704.2 +033200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1704.2 +033300 MOVE "****TEST DELETED****" TO RE-MARK. NC1704.2 +033400 PRINT-DETAIL. NC1704.2 +033500 IF REC-CT NOT EQUAL TO ZERO NC1704.2 +033600 MOVE "." TO PARDOT-X NC1704.2 +033700 MOVE REC-CT TO DOTVALUE. NC1704.2 +033800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1704.2 +033900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1704.2 +034000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1704.2 +034100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1704.2 +034200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1704.2 +034300 MOVE SPACE TO CORRECT-X. NC1704.2 +034400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1704.2 +034500 MOVE SPACE TO RE-MARK. NC1704.2 +034600 HEAD-ROUTINE. NC1704.2 +034700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +034800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +034900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1704.2 +035000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1704.2 +035100 COLUMN-NAMES-ROUTINE. NC1704.2 +035200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +035300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +035400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +035500 END-ROUTINE. NC1704.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1704.2 +035700 END-RTN-EXIT. NC1704.2 +035800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +035900 END-ROUTINE-1. NC1704.2 +036000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1704.2 +036100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1704.2 +036200 ADD PASS-COUNTER TO ERROR-HOLD. NC1704.2 +036300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1704.2 +036400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1704.2 +036500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1704.2 +036600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1704.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1704.2 +036800 END-ROUTINE-12. NC1704.2 +036900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1704.2 +037000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1704.2 +037100 MOVE "NO " TO ERROR-TOTAL NC1704.2 +037200 ELSE NC1704.2 +037300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1704.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1704.2 +037500 PERFORM WRITE-LINE. NC1704.2 +037600 END-ROUTINE-13. NC1704.2 +037700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1704.2 +037800 MOVE "NO " TO ERROR-TOTAL ELSE NC1704.2 +037900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1704.2 +038000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1704.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +038200 IF INSPECT-COUNTER EQUAL TO ZERO NC1704.2 +038300 MOVE "NO " TO ERROR-TOTAL NC1704.2 +038400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1704.2 +038500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1704.2 +038600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +038700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1704.2 +038800 WRITE-LINE. NC1704.2 +038900 ADD 1 TO RECORD-COUNT. NC1704.2 +039000 IF RECORD-COUNT GREATER 42 NC1704.2 +039100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1704.2 +039200 MOVE SPACE TO DUMMY-RECORD NC1704.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1704.2 +039400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1704.2 +039500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1704.2 +039600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1704.2 +039700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1704.2 +039800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1704.2 +039900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1704.2 +040000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1704.2 +040100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1704.2 +040200 MOVE ZERO TO RECORD-COUNT. NC1704.2 +040300 PERFORM WRT-LN. NC1704.2 +040400 WRT-LN. NC1704.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1704.2 +040600 MOVE SPACE TO DUMMY-RECORD. NC1704.2 +040700 BLANK-LINE-PRINT. NC1704.2 +040800 PERFORM WRT-LN. NC1704.2 +040900 FAIL-ROUTINE. NC1704.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE NC1704.2 +041100 GO TO FAIL-ROUTINE-WRITE. NC1704.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1704.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1704.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1704.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1704.2 +041700 GO TO FAIL-ROUTINE-EX. NC1704.2 +041800 FAIL-ROUTINE-WRITE. NC1704.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1704.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1704.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1704.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1704.2 +042300 FAIL-ROUTINE-EX. EXIT. NC1704.2 +042400 BAIL-OUT. NC1704.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1704.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1704.2 +042700 BAIL-OUT-WRITE. NC1704.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1704.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1704.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1704.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1704.2 +043200 BAIL-OUT-EX. EXIT. NC1704.2 +043300 CCVS1-EXIT. NC1704.2 +043400 EXIT. NC1704.2 +043500 SECT-NC170A-001 SECTION. NC1704.2 +043600 NC1704.2 +043700 MPY-INIT-F2-1. NC1704.2 +043800 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +043900 MOVE "MULTIPLY BY GIVING" TO FEATURE. NC1704.2 +044000 MOVE 80.12 TO MULT1. NC1704.2 +044100 MOVE ZERO TO MULT2. NC1704.2 +044200 MPY-TEST-F2-1-0. NC1704.2 +044300 MULTIPLY MULT1 BY 4.3 GIVING MULT2. NC1704.2 +044400 MPY-TEST-F2-1-1. NC1704.2 +044500 IF MULT2 NOT EQUAL TO 344.516 NC1704.2 +044600 GO TO MPY-FAIL-F2-1-1. NC1704.2 +044700 PERFORM PASS NC1704.2 +044800 GO TO MPY-WRITE-F2-1-1. NC1704.2 +044900 MPY-DELETE-F2-1-1. NC1704.2 +045000 PERFORM DE-LETE. NC1704.2 +045100 GO TO MPY-WRITE-F2-1-1. NC1704.2 +045200 MPY-FAIL-F2-1-1. NC1704.2 +045300 PERFORM FAIL. NC1704.2 +045400 MOVE MULT2 TO COMPUTED-N. NC1704.2 +045500 MOVE +344.516 TO CORRECT-N. NC1704.2 +045600 MPY-WRITE-F2-1-1. NC1704.2 +045700 MOVE "MPY-TEST-F2-1-1" TO PAR-NAME. NC1704.2 +045800 PERFORM PRINT-DETAIL. NC1704.2 +045900 NC1704.2 +046000 MPY-INIT-F2-2. NC1704.2 +046100 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +046200 MOVE 80.12 TO MULT1. NC1704.2 +046300 MOVE ZERO TO MULT3. NC1704.2 +046400 MPY-TEST-F2-2-0. NC1704.2 +046500 MULTIPLY .9 BY MULT1 GIVING MULT3 ROUNDED. NC1704.2 +046600 MPY-TEST-F2-2-1. NC1704.2 +046700 IF MULT3 NOT EQUAL TO " $72.11" NC1704.2 +046800 GO TO MPY-FAIL-F2-2-1. NC1704.2 +046900 PERFORM PASS. NC1704.2 +047000 GO TO MPY-WRITE-F2-2-1. NC1704.2 +047100 MPY-DELETE-F2-2-1. NC1704.2 +047200 PERFORM DE-LETE. NC1704.2 +047300 GO TO MPY-WRITE-F2-2-1. NC1704.2 +047400 MPY-FAIL-F2-2-1. NC1704.2 +047500 PERFORM FAIL. NC1704.2 +047600 MOVE MULT3 TO COMPUTED-A. NC1704.2 +047700 MOVE " $72.11" TO CORRECT-A. NC1704.2 +047800 MPY-WRITE-F2-2-1. NC1704.2 +047900 MOVE "MPY-TEST-F2-2-1" TO PAR-NAME. NC1704.2 +048000 PERFORM PRINT-DETAIL. NC1704.2 +048100 NC1704.2 +048200 MPY-INIT-F2-3. NC1704.2 +048300 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +048400 MOVE 80.12 TO MULT1. NC1704.2 +048500 MOVE -56 TO MULT4. NC1704.2 +048600 MOVE 4 TO MULT5. NC1704.2 +048700 MOVE "A" TO XRAY. NC1704.2 +048800 MPY-TEST-F2-3-0. NC1704.2 +048900 MULTIPLY MULT4 BY MULT1 GIVING MULT5 ON SIZE ERROR NC1704.2 +049000 MOVE "H" TO XRAY. NC1704.2 +049100 MPY-TEST-F2-3-1. NC1704.2 +049200 IF XRAY EQUAL TO "H" NC1704.2 +049300 PERFORM PASS NC1704.2 +049400 ELSE NC1704.2 +049500 GO TO MPY-FAIL-F2-3-1. NC1704.2 +049600 GO TO MPY-WRITE-F2-3-1. NC1704.2 +049700 MPY-DELETE-F2-3-1. NC1704.2 +049800 PERFORM DE-LETE. NC1704.2 +049900 GO TO MPY-WRITE-F2-3-1. NC1704.2 +050000 MPY-FAIL-F2-3-1. NC1704.2 +050100 MOVE XRAY TO COMPUTED-X. NC1704.2 +050200 MOVE "H" TO CORRECT-X. NC1704.2 +050300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1704.2 +050400 PERFORM FAIL. NC1704.2 +050500 MPY-WRITE-F2-3-1. NC1704.2 +050600 MOVE "MPY-TEST-F2-3-1 " TO PAR-NAME. NC1704.2 +050700 PERFORM PRINT-DETAIL. NC1704.2 +050800 MPY-TEST-F2-3-2. NC1704.2 +050900 IF MULT5 NOT EQUAL TO 4 NC1704.2 +051000 GO TO MPY-FAIL-F2-3-2. NC1704.2 +051100 PERFORM PASS. NC1704.2 +051200 GO TO MPY-WRITE-F2-3-2. NC1704.2 +051300 MPY-DELETE-F2-3-2. NC1704.2 +051400 PERFORM DE-LETE. NC1704.2 +051500 GO TO MPY-WRITE-F2-3-2. NC1704.2 +051600 MPY-FAIL-F2-3-2. NC1704.2 +051700 PERFORM FAIL. NC1704.2 +051800 MOVE MULT5 TO COMPUTED-N. NC1704.2 +051900 MOVE +4 TO CORRECT-N. NC1704.2 +052000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1704.2 +052100 MPY-WRITE-F2-3-2. NC1704.2 +052200 MOVE "MPY-TEST-F2-3-2 " TO PAR-NAME. NC1704.2 +052300 PERFORM PRINT-DETAIL. NC1704.2 +052400 NC1704.2 +052500 MPY-INIT-F2-4. NC1704.2 +052600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +052700 MOVE 80.12 TO MULT1. NC1704.2 +052800 MOVE "A" TO XRAY. NC1704.2 +052900 MOVE 4 TO MULT5. NC1704.2 +053000 MPY-TEST-F2-4-0. NC1704.2 +053100 MULTIPLY 3.3 BY -3 GIVING MULT5 ROUNDED ON SIZE ERROR NC1704.2 +053200 MOVE "J" TO XRAY. NC1704.2 +053300 MPY-TEST-F2-4-1. NC1704.2 +053400 IF XRAY NOT EQUAL TO "J" NC1704.2 +053500 GO TO MPY-FAIL-F2-4-1 NC1704.2 +053600 ELSE NC1704.2 +053700 PERFORM PASS. NC1704.2 +053800 GO TO MPY-WRITE-F2-4-1. NC1704.2 +053900 MPY-DELETE-F2-4-1. NC1704.2 +054000 PERFORM DE-LETE. NC1704.2 +054100 GO TO MPY-WRITE-F2-4-1. NC1704.2 +054200 MPY-FAIL-F2-4-1. NC1704.2 +054300 MOVE XRAY TO COMPUTED-X. NC1704.2 +054400 MOVE "J" TO CORRECT-X. NC1704.2 +054500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1704.2 +054600 PERFORM FAIL. NC1704.2 +054700 MPY-WRITE-F2-4-1. NC1704.2 +054800 MOVE "MPY-TEST-F2-4-1 " TO PAR-NAME. NC1704.2 +054900 PERFORM PRINT-DETAIL. NC1704.2 +055000 MPY-TEST-F2-4-2. NC1704.2 +055100 IF MULT5 EQUAL TO 4 NC1704.2 +055200 PERFORM PASS NC1704.2 +055300 ELSE NC1704.2 +055400 GO TO MPY-FAIL-F2-4-2. NC1704.2 +055500 GO TO MPY-WRITE-F2-4-2. NC1704.2 +055600 MPY-DELETE-F2-4-2. NC1704.2 +055700 PERFORM DE-LETE. NC1704.2 +055800 GO TO MPY-WRITE-F2-4-2. NC1704.2 +055900 MPY-FAIL-F2-4-2. NC1704.2 +056000 PERFORM FAIL. NC1704.2 +056100 MOVE MULT5 TO COMPUTED-N. NC1704.2 +056200 MOVE +4 TO CORRECT-N. NC1704.2 +056300 MOVE 4 TO MULT5. NC1704.2 +056400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1704.2 +056500 MPY-WRITE-F2-4-2. NC1704.2 +056600 MOVE "MPY-TEST-F2-4-2 " TO PAR-NAME. NC1704.2 +056700 PERFORM PRINT-DETAIL. NC1704.2 +056800 NC1704.2 +056900 MPY-INIT-F2-5. NC1704.2 +057000 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +057100 MOVE ZERO TO WRK-DS-09V09. NC1704.2 +057200 MPY-TEST-F2-5-0. NC1704.2 +057300 MULTIPLY A06THREES-DS-03V03 BY A12THREES-DS-06V06 NC1704.2 +057400 GIVING WRK-DS-09V09. NC1704.2 +057500 MPY-TEST-F2-5-1. NC1704.2 +057600 IF WRK-DS-18V00-S EQUAL TO 111110999999888889 NC1704.2 +057700 PERFORM PASS NC1704.2 +057800 GO TO MPY-WRITE-F2-5. NC1704.2 +057900 GO TO MPY-FAIL-F2-5. NC1704.2 +058000 MPY-DELETE-F2-5. NC1704.2 +058100 PERFORM DE-LETE. NC1704.2 +058200 GO TO MPY-WRITE-F2-5. NC1704.2 +058300 MPY-FAIL-F2-5. NC1704.2 +058400 MOVE 111110999999888889 TO CORRECT-18V0. NC1704.2 +058500 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1704.2 +058600 PERFORM FAIL. NC1704.2 +058700 MPY-WRITE-F2-5. NC1704.2 +058800 MOVE "MPY-TEST-F2-5 " TO PAR-NAME. NC1704.2 +058900 PERFORM PRINT-DETAIL. NC1704.2 +059000 NC1704.2 +059100 MPY-INIT-F2-6. NC1704.2 +059200 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +059300 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +059400 MPY-TEST-F2-6-0. NC1704.2 +059500 MULTIPLY A06THREES-DS-03V03 BY A06THREES-DS-03V03 NC1704.2 +059600 GIVING WRK-DS-10V00 ROUNDED. NC1704.2 +059700 MPY-TEST-F2-6. NC1704.2 +059800 IF WRK-DS-10V00 EQUAL TO 0000111111 NC1704.2 +059900 PERFORM PASS NC1704.2 +060000 GO TO MPY-WRITE-F2-6. NC1704.2 +060100 GO TO MPY-FAIL-F2-6. NC1704.2 +060200 MPY-DELETE-F2-6. NC1704.2 +060300 PERFORM DE-LETE. NC1704.2 +060400 GO TO MPY-WRITE-F2-6. NC1704.2 +060500 MPY-FAIL-F2-6. NC1704.2 +060600 MOVE 0000111111 TO CORRECT-18V0. NC1704.2 +060700 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1704.2 +060800 PERFORM FAIL. NC1704.2 +060900 MPY-WRITE-F2-6. NC1704.2 +061000 MOVE "MPY-TEST-F2-6 " TO PAR-NAME. NC1704.2 +061100 PERFORM PRINT-DETAIL. NC1704.2 +061200 NC1704.2 +061300 MPY-INIT-F2-7. NC1704.2 +061400 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +061500 MOVE "0" TO WRK-XN-00001. NC1704.2 +061600 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +061700 MPY-TEST-F2-7-0. NC1704.2 +061800 MULTIPLY A05ONES-DS-00V05 BY A12ONES-DS-12V00 NC1704.2 +061900 GIVING WRK-DS-10V00 NC1704.2 +062000 ON SIZE ERROR NC1704.2 +062100 MOVE "1" TO WRK-XN-00001. NC1704.2 +062200 MPY-TEST-F2-7-1. NC1704.2 +062300 IF WRK-DS-10V00 EQUAL TO 0000000000 NC1704.2 +062400 PERFORM PASS NC1704.2 +062500 GO TO MPY-WRITE-F2-7-1. NC1704.2 +062600 GO TO MPY-FAIL-F2-7-1. NC1704.2 +062700 MPY-DELETE-F2-7-1. NC1704.2 +062800 PERFORM DE-LETE. NC1704.2 +062900 GO TO MPY-WRITE-F2-7-1. NC1704.2 +063000 MPY-FAIL-F2-7-1. NC1704.2 +063100 MOVE 0000000000 TO CORRECT-18V0. NC1704.2 +063200 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1704.2 +063300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1704.2 +063400 PERFORM FAIL. NC1704.2 +063500 MPY-WRITE-F2-7-1. NC1704.2 +063600 MOVE "MPY-TEST-F2-7-1 " TO PAR-NAME. NC1704.2 +063700 PERFORM PRINT-DETAIL. NC1704.2 +063800 MPY-TEST-F2-7-2. NC1704.2 +063900 IF WRK-XN-00001 EQUAL TO "1" NC1704.2 +064000 PERFORM PASS NC1704.2 +064100 GO TO MPY-WRITE-F2-7-2. NC1704.2 +064200 MOVE "1" TO CORRECT-A. NC1704.2 +064300 MOVE WRK-XN-00001 TO COMPUTED-A. NC1704.2 +064400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1704.2 +064500 PERFORM FAIL. NC1704.2 +064600 GO TO MPY-WRITE-F2-7-2. NC1704.2 +064700 MPY-DELETE-F2-7-2. NC1704.2 +064800 PERFORM DE-LETE. NC1704.2 +064900 MPY-WRITE-F2-7-2. NC1704.2 +065000 MOVE "MPY-TEST-F2-7-2 " TO PAR-NAME. NC1704.2 +065100 PERFORM PRINT-DETAIL. NC1704.2 +065200 NC1704.2 +065300 MPY-INIT-F2-8. NC1704.2 +065400 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +065500 MOVE "1" TO WRK-XN-00001. NC1704.2 +065600 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +065700 MPY-TEST-F2-8-0. NC1704.2 +065800 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +065900 GIVING WRK-DS-10V00 ON SIZE ERROR NC1704.2 +066000 MOVE "0" TO WRK-XN-00001. NC1704.2 +066100 MPY-TEST-F2-8-1. NC1704.2 +066200 IF WRK-DS-10V00 EQUAL TO 0000000111 NC1704.2 +066300 PERFORM PASS NC1704.2 +066400 GO TO MPY-WRITE-F2-8-1. NC1704.2 +066500 GO TO MPY-FAIL-F2-8-1. NC1704.2 +066600 MPY-DELETE-F2-8-1. NC1704.2 +066700 PERFORM DE-LETE. NC1704.2 +066800 GO TO MPY-WRITE-F2-8-1. NC1704.2 +066900 MPY-FAIL-F2-8-1. NC1704.2 +067000 MOVE 0000000111 TO CORRECT-18V0. NC1704.2 +067100 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1704.2 +067200 PERFORM FAIL. NC1704.2 +067300 MPY-WRITE-F2-8-1. NC1704.2 +067400 MOVE "MPY-TEST-F2-8-1 " TO PAR-NAME. NC1704.2 +067500 PERFORM PRINT-DETAIL. NC1704.2 +067600 MPY-TEST-F2-8-2. NC1704.2 +067700 IF WRK-XN-00001 EQUAL TO "1" NC1704.2 +067800 PERFORM PASS NC1704.2 +067900 GO TO MPY-WRITE-F2-8-2. NC1704.2 +068000 MOVE "1" TO CORRECT-A. NC1704.2 +068100 MOVE WRK-XN-00001 TO COMPUTED-A. NC1704.2 +068200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1704.2 +068300 PERFORM FAIL. NC1704.2 +068400 GO TO MPY-WRITE-F2-8-2. NC1704.2 +068500 MPY-DELETE-F2-8-2. NC1704.2 +068600 PERFORM DE-LETE. NC1704.2 +068700 MPY-WRITE-F2-8-2. NC1704.2 +068800 MOVE "MPY-TEST-F2-8-2 " TO PAR-NAME. NC1704.2 +068900 PERFORM PRINT-DETAIL. NC1704.2 +069000 NC1704.2 +069100 MPY-INIT-F2-9. NC1704.2 +069200 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +069300 MOVE "0" TO WRK-XN-00001. NC1704.2 +069400 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +069500 MPY-TEST-F2-9-0. NC1704.2 +069600 MULTIPLY 9.5 BY A10ONES-DS-10V00 NC1704.2 +069700 GIVING WRK-DS-10V00 ROUNDED ON SIZE ERROR NC1704.2 +069800 MOVE "1" TO WRK-XN-00001. NC1704.2 +069900 MPY-TEST-F2-9-1. NC1704.2 +070000 IF WRK-DS-10V00 EQUAL TO 0000000000 NC1704.2 +070100 PERFORM PASS NC1704.2 +070200 GO TO MPY-WRITE-F2-9-1. NC1704.2 +070300 MOVE 0000000000 TO CORRECT-18V0. NC1704.2 +070400 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1704.2 +070500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1704.2 +070600 PERFORM FAIL. NC1704.2 +070700 GO TO MPY-WRITE-F2-9-1. NC1704.2 +070800 MPY-DELETE-F2-9-1. NC1704.2 +070900 PERFORM DE-LETE. NC1704.2 +071000 MPY-WRITE-F2-9-1. NC1704.2 +071100 MOVE "MPY-TEST-F2-9-1 " TO PAR-NAME. NC1704.2 +071200 PERFORM PRINT-DETAIL. NC1704.2 +071300 MPY-TEST-F2-9-2. NC1704.2 +071400 IF WRK-XN-00001 EQUAL TO "1" NC1704.2 +071500 PERFORM PASS NC1704.2 +071600 GO TO MPY-WRITE-F2-9-2. NC1704.2 +071700 MPY-FAIL-F2-9-2. NC1704.2 +071800 MOVE "1" TO CORRECT-A. NC1704.2 +071900 MOVE WRK-XN-00001 TO COMPUTED-A. NC1704.2 +072000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1704.2 +072100 PERFORM FAIL. NC1704.2 +072200 GO TO MPY-WRITE-F2-9-2. NC1704.2 +072300 MPY-DELETE-F2-9-2. NC1704.2 +072400 PERFORM DE-LETE. NC1704.2 +072500 MPY-WRITE-F2-9-2. NC1704.2 +072600 MOVE "MPY-TEST-F2-9-2 " TO PAR-NAME. NC1704.2 +072700 PERFORM PRINT-DETAIL. NC1704.2 +072800 NC1704.2 +072900 MPY-INIT-F2-10-1. NC1704.2 +073000 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +073100 MOVE "1" TO WRK-XN-00001. NC1704.2 +073200 MOVE ZERO TO WRK-DS-09V08. NC1704.2 +073300 MPY-TEST-F2-10-0. NC1704.2 +073400 MULTIPLY A01ONE-DS-P0801 BY A18ONES-DS-18V00 NC1704.2 +073500 GIVING WRK-DS-09V08 ROUNDED ON SIZE ERROR NC1704.2 +073600 MOVE "0" TO WRK-XN-00001. NC1704.2 +073700 MPY-TEST-F2-10-1. NC1704.2 +073800 IF WRK-DS-17V00-S EQUAL TO 11111111111111111 NC1704.2 +073900 PERFORM PASS NC1704.2 +074000 GO TO MPY-WRITE-F2-10-1. NC1704.2 +074100 MOVE 11111111111111111 TO CORRECT-18V0. NC1704.2 +074200 MOVE WRK-DS-17V00-S TO COMPUTED-18V0. NC1704.2 +074300 PERFORM FAIL. NC1704.2 +074400 GO TO MPY-WRITE-F2-10-1. NC1704.2 +074500 MPY-DELETE-F2-10-1. NC1704.2 +074600 PERFORM DE-LETE. NC1704.2 +074700 MPY-WRITE-F2-10-1. NC1704.2 +074800 MOVE "MPY-TEST-F2-10-1 " TO PAR-NAME. NC1704.2 +074900 PERFORM PRINT-DETAIL. NC1704.2 +075000 MPY-TEST-F2-10-2. NC1704.2 +075100 IF WRK-XN-00001 EQUAL TO "1" NC1704.2 +075200 PERFORM PASS NC1704.2 +075300 GO TO MPY-WRITE-F2-10-2. NC1704.2 +075400 MOVE "1" TO CORRECT-A. NC1704.2 +075500 MOVE WRK-XN-00001 TO COMPUTED-A. NC1704.2 +075600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1704.2 +075700 PERFORM FAIL. NC1704.2 +075800 GO TO MPY-WRITE-F2-10-2. NC1704.2 +075900 MPY-DELETE-F2-10-2. NC1704.2 +076000 PERFORM DE-LETE. NC1704.2 +076100 MPY-WRITE-F2-10-2. NC1704.2 +076200 MOVE "MPY-TEST-F2-10-2 " TO PAR-NAME. NC1704.2 +076300 PERFORM PRINT-DETAIL. NC1704.2 +076400 NC1704.2 +076500 MPY-INIT-F2-11. NC1704.2 +076600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +076700 MOVE ZERO TO WRK-CS-02V02. NC1704.2 +076800 MPY-TEST-F2-11-0. NC1704.2 +076900 MULTIPLY A99-CS-02V00 BY A01ONE-CS-00V01 GIVING WRK-CS-02V02.NC1704.2 +077000 MPY-TEST-F2-11-1. NC1704.2 +077100 MOVE WRK-CS-02V02 TO WRK-DS-06V06. NC1704.2 +077200 IF WRK-DS-12V00-S EQUAL TO 000009900000 NC1704.2 +077300 PERFORM PASS NC1704.2 +077400 GO TO MPY-WRITE-F2-11. NC1704.2 +077500 MOVE 000009900000 TO CORRECT-18V0. NC1704.2 +077600 MOVE WRK-DS-12V00-S TO COMPUTED-18V0. NC1704.2 +077700 PERFORM FAIL. NC1704.2 +077800 GO TO MPY-WRITE-F2-11. NC1704.2 +077900 MPY-DELETE-F2-11. NC1704.2 +078000 PERFORM DE-LETE. NC1704.2 +078100 MPY-WRITE-F2-11. NC1704.2 +078200 MOVE "MPY-TEST-F2-11 " TO PAR-NAME. NC1704.2 +078300 PERFORM PRINT-DETAIL. NC1704.2 +078400 NC1704.2 +078500 MPY-INIT-F2-12. NC1704.2 +078600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +078700 MOVE ZERO TO WRK-CS-18V00. NC1704.2 +078800 MPY-TEST-F2-12-0. NC1704.2 +078900 MULTIPLY A01ONES-CS-18V00 BY A02THREES-CS-18V00 NC1704.2 +079000 GIVING WRK-CS-18V00. NC1704.2 +079100 MPY-TEST-F2-12-1. NC1704.2 +079200 IF WRK-CS-18V00 EQUAL TO -000000000000000033 NC1704.2 +079300 PERFORM PASS NC1704.2 +079400 GO TO MPY-WRITE-F2-12. NC1704.2 +079500 MOVE -000000000000000033 TO CORRECT-18V0. NC1704.2 +079600 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1704.2 +079700 PERFORM FAIL. NC1704.2 +079800 GO TO MPY-WRITE-F2-12. NC1704.2 +079900 MPY-DELETE-F2-12. NC1704.2 +080000 PERFORM DE-LETE. NC1704.2 +080100 MPY-WRITE-F2-12. NC1704.2 +080200 MOVE "MPY-TEST-F2-12 " TO PAR-NAME. NC1704.2 +080300 PERFORM PRINT-DETAIL. NC1704.2 +080400 NC1704.2 +080500 MPY-INIT-F2-13. NC1704.2 +080600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +080700 MOVE ZERO TO WRK-DU-18V00. NC1704.2 +080800 MPY-TEST-F2-13-0. NC1704.2 +080900 MULTIPLY A02THREES-CS-18V00 BY A14TWOS-CU-18V00 NC1704.2 +081000 GIVING WRK-DU-18V00. NC1704.2 +081100 MPY-TEST-F2-13. NC1704.2 +081200 IF WRK-DU-18V00 EQUAL TO 000733333333333326 NC1704.2 +081300 PERFORM PASS NC1704.2 +081400 GO TO MPY-WRITE-F2-13. NC1704.2 +081500 MOVE 000733333333333326 TO CORRECT-18V0. NC1704.2 +081600 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1704.2 +081700 PERFORM FAIL. NC1704.2 +081800 GO TO MPY-WRITE-F2-13. NC1704.2 +081900 MPY-DELETE-F2-13. NC1704.2 +082000 PERFORM DE-LETE. NC1704.2 +082100 MPY-WRITE-F2-13. NC1704.2 +082200 MOVE "MPY-TEST-F2-13 " TO PAR-NAME. NC1704.2 +082300 PERFORM PRINT-DETAIL. NC1704.2 +082400 NC1704.2 +082500 MPY-INIT-F2-14. NC1704.2 +082600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +082700 MOVE ZERO TO WRK-CS-18V00. NC1704.2 +082800 MPY-TEST-F2-14-0. NC1704.2 +082900 MULTIPLY A02THREES-CS-18V00 BY A16NINES-CU-18V00 NC1704.2 +083000 GIVING WRK-CS-18V00. NC1704.2 +083100 MPY-TEST-F2-14. NC1704.2 +083200 IF WRK-CS-18V00 EQUAL TO -329999999999999967 NC1704.2 +083300 PERFORM PASS NC1704.2 +083400 GO TO MPY-WRITE-F2-14. NC1704.2 +083500 MOVE -329999999999999967 TO CORRECT-18V0. NC1704.2 +083600 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1704.2 +083700 PERFORM FAIL. NC1704.2 +083800 GO TO MPY-WRITE-F2-14. NC1704.2 +083900 MPY-DELETE-F2-14. NC1704.2 +084000 PERFORM DE-LETE. NC1704.2 +084100 MPY-WRITE-F2-14. NC1704.2 +084200 MOVE "MPY-TEST-F2-14 " TO PAR-NAME. NC1704.2 +084300 PERFORM PRINT-DETAIL. NC1704.2 +084400 NC1704.2 +084500 MPY-INIT-F2-15. NC1704.2 +084600 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +084700 MOVE ZERO TO WRK-DU-18V00. NC1704.2 +084800 MPY-TEST-F2-15-0. NC1704.2 +084900 MULTIPLY A01ONES-CS-18V00 BY A18SIXES-CU-18V00 NC1704.2 +085000 GIVING WRK-DU-18V00. NC1704.2 +085100 MPY-TEST-F2-15. NC1704.2 +085200 IF WRK-DU-18V00 EQUAL TO 666666666666666666 NC1704.2 +085300 PERFORM PASS NC1704.2 +085400 GO TO MPY-WRITE-F2-15. NC1704.2 +085500 MOVE 666666666666666666 TO CORRECT-18V0. NC1704.2 +085600 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1704.2 +085700 PERFORM FAIL. NC1704.2 +085800 GO TO MPY-WRITE-F2-15. NC1704.2 +085900 MPY-DELETE-F2-15. NC1704.2 +086000 PERFORM DE-LETE. NC1704.2 +086100 MPY-WRITE-F2-15. NC1704.2 +086200 MOVE "MPY-TEST-F2-15 " TO PAR-NAME. NC1704.2 +086300 PERFORM PRINT-DETAIL. NC1704.2 +086400* NC1704.2 +086500* NC1704.2 +086600 MPY-INIT-F2-16. NC1704.2 +086700* ==--> NEW SIZE ERROR TESTS <--== NC1704.2 +086800 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +086900 MOVE "H" TO XRAY. NC1704.2 +087000 MOVE 80.12 TO MULT1. NC1704.2 +087100 MOVE -56 TO MULT4. NC1704.2 +087200 MOVE 0 TO MULT5. NC1704.2 +087300 MOVE 1 TO REC-CT. NC1704.2 +087400 MPY-TEST-F2-16-0. NC1704.2 +087500 MULTIPLY MULT4 BY MULT1 GIVING MULT5 NC1704.2 +087600 NOT ON SIZE ERROR MOVE "X" TO XRAY. NC1704.2 +087700 MPY-TEST-F2-16-1. NC1704.2 +087800 GO TO MPY-TEST-F2-16-2. NC1704.2 +087900 MPY-DELETE-F2-16-1. NC1704.2 +088000 PERFORM DE-LETE. NC1704.2 +088100 PERFORM PRINT-DETAIL. NC1704.2 +088200 GO TO MPY-INIT-F2-17. NC1704.2 +088300 MPY-TEST-F2-16-2. NC1704.2 +088400 MOVE "MPY-TEST-F2-16-2 " TO PAR-NAME. NC1704.2 +088500 IF XRAY = "H" NC1704.2 +088600 PERFORM PASS NC1704.2 +088700 PERFORM PRINT-DETAIL NC1704.2 +088800 ELSE NC1704.2 +088900 MOVE XRAY TO COMPUTED-X NC1704.2 +089000 MOVE "H" TO CORRECT-X NC1704.2 +089100 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +089200 PERFORM FAIL NC1704.2 +089300 PERFORM PRINT-DETAIL. NC1704.2 +089400 ADD 1 TO REC-CT. NC1704.2 +089500 MPY-TEST-F2-16-3. NC1704.2 +089600 MOVE "MPY-TEST-F2-16-3 " TO PAR-NAME. NC1704.2 +089700 IF MULT5 = 0 NC1704.2 +089800 PERFORM PASS NC1704.2 +089900 PERFORM PRINT-DETAIL NC1704.2 +090000 ELSE NC1704.2 +090100 MOVE MULT5 TO COMPUTED-N NC1704.2 +090200 MOVE 0 TO CORRECT-N NC1704.2 +090300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +090400 PERFORM FAIL NC1704.2 +090500 PERFORM PRINT-DETAIL. NC1704.2 +090600* NC1704.2 +090700* NC1704.2 +090800 MPY-INIT-F2-17. NC1704.2 +090900* ==--> NEW SIZE ERROR TESTS <--== NC1704.2 +091000 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +091100 MOVE "1" TO WRK-XN-00001. NC1704.2 +091200 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +091300 MOVE 1 TO REC-CT. NC1704.2 +091400 MPY-TEST-F2-17-0. NC1704.2 +091500 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +091600 GIVING WRK-DS-10V00 NC1704.2 +091700 NOT ON SIZE ERROR NC1704.2 +091800 MOVE "0" TO WRK-XN-00001. NC1704.2 +091900 MPY-TEST-F2-17-1. NC1704.2 +092000 GO TO MPY-TEST-F2-17-2. NC1704.2 +092100 MPY-DELETE-F2-17. NC1704.2 +092200 PERFORM DE-LETE. NC1704.2 +092300 PERFORM PRINT-DETAIL. NC1704.2 +092400 GO TO MPY-INIT-F2-18. NC1704.2 +092500 MPY-TEST-F2-17-2. NC1704.2 +092600 MOVE "MPY-TEST-F2-17-2 " TO PAR-NAME. NC1704.2 +092700 IF WRK-XN-00001 = "0" NC1704.2 +092800 PERFORM PASS NC1704.2 +092900 PERFORM PRINT-DETAIL NC1704.2 +093000 ELSE NC1704.2 +093100 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +093200 MOVE "0" TO CORRECT-X NC1704.2 +093300 MOVE "NOT ON SIZE ERROR SHOULD HAVE BEEN EXECUTED" NC1704.2 +093400 TO RE-MARK NC1704.2 +093500 PERFORM FAIL NC1704.2 +093600 PERFORM PRINT-DETAIL. NC1704.2 +093700 ADD 1 TO REC-CT. NC1704.2 +093800 MPY-TEST-F2-17-3. NC1704.2 +093900 MOVE "MPY-TEST-F2-17-3 " TO PAR-NAME. NC1704.2 +094000 IF WRK-DS-10V00 = 0000000111 NC1704.2 +094100 PERFORM PASS NC1704.2 +094200 PERFORM PRINT-DETAIL NC1704.2 +094300 ELSE NC1704.2 +094400 MOVE 0000000111 TO CORRECT-18V0 NC1704.2 +094500 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1704.2 +094600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +094700 PERFORM FAIL NC1704.2 +094800 PERFORM PRINT-DETAIL. NC1704.2 +094900* NC1704.2 +095000* NC1704.2 +095100 MPY-INIT-F2-18. NC1704.2 +095200* ==--> NEW SIZE ERROR TESTS <--== NC1704.2 +095300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +095400 MOVE 1 TO REC-CT. NC1704.2 +095500 MOVE 80.12 TO MULT1. NC1704.2 +095600 MOVE -56 TO MULT4. NC1704.2 +095700 MOVE 0 TO MULT5. NC1704.2 +095800 MOVE "H" TO XRAY. NC1704.2 +095900 MPY-TEST-F2-18-0. NC1704.2 +096000 MULTIPLY MULT4 BY MULT1 GIVING MULT5 NC1704.2 +096100 ON SIZE ERROR MOVE "A" TO XRAY NC1704.2 +096200 NOT ON SIZE ERROR MOVE "B" TO XRAY. NC1704.2 +096300 MPY-TEST-F2-18-1. NC1704.2 +096400 GO TO MPY-TEST-F2-18-2. NC1704.2 +096500 MPY-DELETE-F2-18. NC1704.2 +096600 PERFORM DE-LETE. NC1704.2 +096700 PERFORM PRINT-DETAIL. NC1704.2 +096800 GO TO MPY-INIT-F2-19. NC1704.2 +096900 MPY-TEST-F2-18-2. NC1704.2 +097000 MOVE "MPY-TEST-F2-18-2 " TO PAR-NAME. NC1704.2 +097100 IF XRAY = "A" NC1704.2 +097200 PERFORM PASS NC1704.2 +097300 PERFORM PRINT-DETAIL NC1704.2 +097400 ELSE NC1704.2 +097500 MOVE XRAY TO COMPUTED-X NC1704.2 +097600 MOVE "A" TO CORRECT-X NC1704.2 +097700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +097800 PERFORM FAIL NC1704.2 +097900 PERFORM PRINT-DETAIL. NC1704.2 +098000 ADD 1 TO REC-CT. NC1704.2 +098100 MPY-TEST-F2-18-3. NC1704.2 +098200 MOVE "MPY-TEST-F2-18-3 " TO PAR-NAME. NC1704.2 +098300 IF MULT5 = 0 NC1704.2 +098400 PERFORM PASS NC1704.2 +098500 PERFORM PRINT-DETAIL NC1704.2 +098600 ELSE NC1704.2 +098700 MOVE MULT5 TO COMPUTED-N NC1704.2 +098800 MOVE 0 TO CORRECT-N NC1704.2 +098900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +099000 PERFORM FAIL NC1704.2 +099100 PERFORM PRINT-DETAIL. NC1704.2 +099200* NC1704.2 +099300* NC1704.2 +099400 MPY-INIT-F2-19. NC1704.2 +099500* ==--> NEW SIZE ERROR TESTS <--== NC1704.2 +099600 MOVE 1 TO REC-CT. NC1704.2 +099700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +099800 MOVE "0" TO WRK-XN-00001. NC1704.2 +099900 MOVE ZERO TO WRK-DS-10V00. NC1704.2 +100000 MPY-TEST-F2-19-0. NC1704.2 +100100 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +100200 GIVING WRK-DS-10V00 NC1704.2 +100300 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1704.2 +100400 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1704.2 +100500 MPY-TEST-F2-19-1. NC1704.2 +100600 GO TO MPY-TEST-F2-19-2. NC1704.2 +100700 MPY-DELETE-F2-19. NC1704.2 +100800 PERFORM DE-LETE. NC1704.2 +100900 PERFORM PRINT-DETAIL. NC1704.2 +101000 GO TO MPY-INIT-F2-20. NC1704.2 +101100 MPY-TEST-F2-19-2. NC1704.2 +101200 MOVE "MPY-TEST-F2-19-2" TO PAR-NAME. NC1704.2 +101300 IF WRK-XN-00001 = "2" NC1704.2 +101400 PERFORM PASS NC1704.2 +101500 PERFORM PRINT-DETAIL NC1704.2 +101600 ELSE NC1704.2 +101700 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +101800 MOVE "2" TO CORRECT-X NC1704.2 +101900 MOVE "NOT ON SIZE ERROR SHOULD HAVE BEEN EXECUTED" NC1704.2 +102000 TO RE-MARK NC1704.2 +102100 PERFORM FAIL NC1704.2 +102200 PERFORM PRINT-DETAIL. NC1704.2 +102300 ADD 1 TO REC-CT. NC1704.2 +102400 MPY-TEST-F2-19-3. NC1704.2 +102500 MOVE "MPY-TEST-F2-19-3 " TO PAR-NAME. NC1704.2 +102600 IF WRK-DS-10V00 = 0000000111 NC1704.2 +102700 PERFORM PASS NC1704.2 +102800 PERFORM PRINT-DETAIL NC1704.2 +102900 ELSE NC1704.2 +103000 MOVE 0000000111 TO CORRECT-18V0 NC1704.2 +103100 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1704.2 +103200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +103300 PERFORM FAIL NC1704.2 +103400 PERFORM PRINT-DETAIL. NC1704.2 +103500* NC1704.2 +103600* NC1704.2 +103700 MPY-INIT-F2-20. NC1704.2 +103800* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +103900 MOVE "V1-107 6.19.4 GR2" TO ANSI-REFERENCE. NC1704.2 +104000 MOVE "MPY-TEST-F2-20" TO PAR-NAME. NC1704.2 +104100 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +104200 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +104300 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +104400 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +104500 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +104600 MOVE 0 TO WRK-NE-2. NC1704.2 +104700 MOVE 0 TO WRK-NE-3. NC1704.2 +104800 MOVE 1 TO REC-CT. NC1704.2 +104900 MPY-TEST-F2-20-0. NC1704.2 +105000 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-6V0-1 GIVING WRK-DU-2V0-1 NC1704.2 +105100 WRK-DU-2V0-2 ROUNDED WRK-DU-2V5-1 WRK-NE-2 ROUNDED NC1704.2 +105200 WRK-NE-3. NC1704.2 +105300 GO TO MPY-TEST-F2-20-1. NC1704.2 +105400 MPY-DELETE-F2-20. NC1704.2 +105500 PERFORM DE-LETE. NC1704.2 +105600 GO TO MPY-INIT-F2-21. NC1704.2 +105700 MPY-TEST-F2-20-1. NC1704.2 +105800 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +105900 ELSE NC1704.2 +106000 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 TO NC1704.2 +106100 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +106200 ADD 1 TO REC-CT. NC1704.2 +106300 MPY-TEST-F2-20-2. NC1704.2 +106400 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +106500 ELSE NC1704.2 +106600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 NC1704.2 +106700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +106800 ADD 1 TO REC-CT. NC1704.2 +106900 MPY-TEST-F2-20-3. NC1704.2 +107000 IF WRK-DU-2V5-1 = 9.99999 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +107100 ELSE NC1704.2 +107200 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 9.99999 TO NC1704.2 +107300 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +107400 ADD 1 TO REC-CT. NC1704.2 +107500 MPY-TEST-F2-20-4. NC1704.2 +107600 IF WRK-NE-2 = "$10.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +107700 ELSE NC1704.2 +107800 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$10.00" NC1704.2 +107900 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +108000 ADD 1 TO REC-CT. NC1704.2 +108100 MPY-TEST-F2-20-5. NC1704.2 +108200 IF WRK-NE-3 = "$09.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +108300 ELSE NC1704.2 +108400 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$09.99 " NC1704.2 +108500 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +108600* NC1704.2 +108700* NC1704.2 +108800 MPY-INIT-F2-21. NC1704.2 +108900* ==--> SIZE ERROR CONDITION <--== NC1704.2 +109000* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +109100 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +109200 MOVE "MPY-TEST-F2-21" TO PAR-NAME. NC1704.2 +109300 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +109400 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +109500 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +109600 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +109700 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +109800 MOVE 0 TO WRK-NE-2. NC1704.2 +109900 MOVE 0 TO WRK-NE-3. NC1704.2 +110000 MOVE 1 TO REC-CT. NC1704.2 +110100 MOVE "0" TO WRK-XN-00001. NC1704.2 +110200 MPY-TEST-F2-21-0. NC1704.2 +110300 MULTIPLY WRK-DU-6V0-1 BY WRK-DU-6V0-1 NC1704.2 +110400 GIVING WRK-DU-2V0-1 NC1704.2 +110500 WRK-DU-2V0-2 ROUNDED NC1704.2 +110600 WRK-DU-2V5-1 NC1704.2 +110700 WRK-NE-2 ROUNDED NC1704.2 +110800 WRK-NE-3 NC1704.2 +110900 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1704.2 +111000 GO TO MPY-TEST-F2-21-1. NC1704.2 +111100 MPY-DELETE-F2-21. NC1704.2 +111200 PERFORM DE-LETE. NC1704.2 +111300 GO TO MPY-INIT-F2-22. NC1704.2 +111400 MPY-TEST-F2-21-1. NC1704.2 +111500 IF WRK-DU-2V0-1 = 0 NC1704.2 +111600 PERFORM PASS NC1704.2 +111700 PERFORM PRINT-DETAIL NC1704.2 +111800 ELSE NC1704.2 +111900 PERFORM FAIL NC1704.2 +112000 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +112100 MOVE 0 TO CORRECT-N NC1704.2 +112200 PERFORM PRINT-DETAIL. NC1704.2 +112300 ADD 1 TO REC-CT. NC1704.2 +112400 MPY-TEST-F2-21-2. NC1704.2 +112500 IF WRK-DU-2V0-2 = 0 NC1704.2 +112600 PERFORM PASS NC1704.2 +112700 PERFORM PRINT-DETAIL NC1704.2 +112800 ELSE NC1704.2 +112900 PERFORM FAIL NC1704.2 +113000 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +113100 MOVE 0 TO CORRECT-N NC1704.2 +113200 PERFORM PRINT-DETAIL. NC1704.2 +113300 ADD 1 TO REC-CT. NC1704.2 +113400 MPY-TEST-F2-21-3. NC1704.2 +113500 IF WRK-DU-2V5-1 = 0.00000 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +113600 ELSE NC1704.2 +113700 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 0.00000 TO NC1704.2 +113800 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +113900 ADD 1 TO REC-CT. NC1704.2 +114000 MPY-TEST-F2-21-4. NC1704.2 +114100 IF WRK-NE-2 = "$**.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +114200 ELSE NC1704.2 +114300 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$**.00" NC1704.2 +114400 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +114500 ADD 1 TO REC-CT. NC1704.2 +114600 MPY-TEST-F2-21-5. NC1704.2 +114700 IF WRK-NE-3 = "$00.00 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +114800 ELSE NC1704.2 +114900 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$00.00 " NC1704.2 +115000 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +115100 ADD 1 TO REC-CT. NC1704.2 +115200 MPY-TEST-F2-21-6. NC1704.2 +115300 IF WRK-XN-00001 = "1" NC1704.2 +115400 PERFORM PASS NC1704.2 +115500 PERFORM PRINT-DETAIL NC1704.2 +115600 ELSE NC1704.2 +115700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +115800 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +115900 MOVE "1" TO CORRECT-X NC1704.2 +116000 PERFORM FAIL NC1704.2 +116100 PERFORM PRINT-DETAIL. NC1704.2 +116200* NC1704.2 +116300 MPY-INIT-F2-22. NC1704.2 +116400* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +116500* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +116600 MOVE "MPY-TEST-F2-22" TO PAR-NAME. NC1704.2 +116700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +116800 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +116900 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +117000 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +117100 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +117200 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +117300 MOVE 0 TO WRK-NE-2. NC1704.2 +117400 MOVE 0 TO WRK-NE-3. NC1704.2 +117500 MOVE 1 TO REC-CT. NC1704.2 +117600 MOVE "0" TO WRK-XN-00001. NC1704.2 +117700 MPY-TEST-F2-22-0. NC1704.2 +117800 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-6V0-1 NC1704.2 +117900 GIVING WRK-DU-2V0-1 NC1704.2 +118000 WRK-DU-2V0-2 ROUNDED NC1704.2 +118100 WRK-DU-2V5-1 NC1704.2 +118200 WRK-NE-2 ROUNDED NC1704.2 +118300 WRK-NE-3 NC1704.2 +118400 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1704.2 +118500 GO TO MPY-TEST-F2-22-1. NC1704.2 +118600 MPY-DELETE-F2-22. NC1704.2 +118700 PERFORM DE-LETE. NC1704.2 +118800 PERFORM PRINT-DETAIL. NC1704.2 +118900 GO TO MPY-INIT-F2-23. NC1704.2 +119000 MPY-TEST-F2-22-1. NC1704.2 +119100 IF WRK-DU-2V0-1 = 9 NC1704.2 +119200 PERFORM PASS NC1704.2 +119300 PERFORM PRINT-DETAIL NC1704.2 +119400 ELSE NC1704.2 +119500 PERFORM FAIL NC1704.2 +119600 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +119700 MOVE 9 TO CORRECT-N NC1704.2 +119800 PERFORM PRINT-DETAIL. NC1704.2 +119900 ADD 1 TO REC-CT. NC1704.2 +120000 MPY-TEST-F2-22-2. NC1704.2 +120100 IF WRK-DU-2V0-2 = 10 NC1704.2 +120200 PERFORM PASS NC1704.2 +120300 PERFORM PRINT-DETAIL NC1704.2 +120400 ELSE NC1704.2 +120500 PERFORM FAIL NC1704.2 +120600 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +120700 MOVE 10 TO CORRECT-N NC1704.2 +120800 PERFORM PRINT-DETAIL. NC1704.2 +120900 ADD 1 TO REC-CT. NC1704.2 +121000 MPY-TEST-F2-22-3. NC1704.2 +121100 IF WRK-DU-2V5-1 = 9.99999 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +121200 ELSE NC1704.2 +121300 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 9.99999 TO NC1704.2 +121400 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +121500 ADD 1 TO REC-CT. NC1704.2 +121600 MPY-TEST-F2-22-4. NC1704.2 +121700 IF WRK-NE-2 = "$10.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +121800 ELSE NC1704.2 +121900 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$10.00" NC1704.2 +122000 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +122100 ADD 1 TO REC-CT. NC1704.2 +122200 MPY-TEST-F2-22-5. NC1704.2 +122300 IF WRK-NE-3 = "$09.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +122400 ELSE NC1704.2 +122500 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$09.99 " NC1704.2 +122600 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +122700 ADD 1 TO REC-CT. NC1704.2 +122800 MPY-TEST-F2-22-6. NC1704.2 +122900 IF WRK-XN-00001 = "0" NC1704.2 +123000 PERFORM PASS NC1704.2 +123100 PERFORM PRINT-DETAIL NC1704.2 +123200 ELSE NC1704.2 +123300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +123400 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +123500 MOVE "0" TO CORRECT-X NC1704.2 +123600 PERFORM FAIL NC1704.2 +123700 PERFORM PRINT-DETAIL. NC1704.2 +123800* NC1704.2 +123900 MPY-INIT-F2-23. NC1704.2 +124000* ==--> SIZE ERROR CONDITION <--== NC1704.2 +124100* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +124200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +124300 MOVE "MPY-TEST-F2-23" TO PAR-NAME. NC1704.2 +124400 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +124500 MOVE 1 TO REC-CT. NC1704.2 +124600 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +124700 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +124800 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +124900 MOVE 0 TO WRK-NE-2. NC1704.2 +125000 MOVE 0 TO WRK-NE-3. NC1704.2 +125100 MOVE "0" TO WRK-XN-00001. NC1704.2 +125200 MPY-TEST-F2-23-0. NC1704.2 +125300 MULTIPLY WRK-DU-6V0-1 BY WRK-DU-6V0-1 NC1704.2 +125400 GIVING WRK-DU-2V0-1 NC1704.2 +125500 WRK-DU-2V0-2 ROUNDED NC1704.2 +125600 WRK-DU-2V5-1 NC1704.2 +125700 WRK-NE-2 ROUNDED NC1704.2 +125800 WRK-NE-3 NC1704.2 +125900 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1704.2 +126000 GO TO MPY-TEST-F2-23-1. NC1704.2 +126100 MPY-DELETE-F2-23. NC1704.2 +126200 PERFORM DE-LETE. NC1704.2 +126300 PERFORM PRINT-DETAIL. NC1704.2 +126400 GO TO MPY-INIT-F2-24. NC1704.2 +126500 MPY-TEST-F2-23-1. NC1704.2 +126600 IF WRK-DU-2V0-1 = 0 NC1704.2 +126700 PERFORM PASS NC1704.2 +126800 PERFORM PRINT-DETAIL NC1704.2 +126900 ELSE NC1704.2 +127000 PERFORM FAIL NC1704.2 +127100 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +127200 MOVE 0 TO CORRECT-N NC1704.2 +127300 PERFORM PRINT-DETAIL. NC1704.2 +127400 ADD 1 TO REC-CT. NC1704.2 +127500 MPY-TEST-F2-23-2. NC1704.2 +127600 IF WRK-DU-2V0-2 = 0 NC1704.2 +127700 PERFORM PASS NC1704.2 +127800 PERFORM PRINT-DETAIL NC1704.2 +127900 ELSE NC1704.2 +128000 PERFORM FAIL NC1704.2 +128100 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +128200 MOVE 0 TO CORRECT-N NC1704.2 +128300 PERFORM PRINT-DETAIL. NC1704.2 +128400 ADD 1 TO REC-CT. NC1704.2 +128500 MPY-TEST-F2-23-3. NC1704.2 +128600 IF WRK-DU-2V5-1 = 0.00000 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +128700 ELSE NC1704.2 +128800 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 0.00000 TO NC1704.2 +128900 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +129000 ADD 1 TO REC-CT. NC1704.2 +129100 MPY-TEST-F2-23-4. NC1704.2 +129200 IF WRK-NE-2 = "$**.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +129300 ELSE NC1704.2 +129400 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$**.00" NC1704.2 +129500 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +129600 ADD 1 TO REC-CT. NC1704.2 +129700 MPY-TEST-F2-23-5. NC1704.2 +129800 IF WRK-NE-3 = "$00.00 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +129900 ELSE NC1704.2 +130000 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$00.00 " NC1704.2 +130100 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +130200 ADD 1 TO REC-CT. NC1704.2 +130300 MPY-TEST-F2-23-6. NC1704.2 +130400 IF WRK-XN-00001 = "0" NC1704.2 +130500 PERFORM PASS NC1704.2 +130600 PERFORM PRINT-DETAIL NC1704.2 +130700 ELSE NC1704.2 +130800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +130900 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +131000 MOVE "0" TO CORRECT-X NC1704.2 +131100 PERFORM FAIL NC1704.2 +131200 PERFORM PRINT-DETAIL. NC1704.2 +131300* NC1704.2 +131400 MPY-INIT-F2-24. NC1704.2 +131500* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +131600* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +131700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +131800 MOVE "MPY-TEST-F2-24" TO PAR-NAME. NC1704.2 +131900 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +132000 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +132100 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +132200 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +132300 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +132400 MOVE 0 TO WRK-NE-2. NC1704.2 +132500 MOVE 0 TO WRK-NE-3. NC1704.2 +132600 MOVE 1 TO REC-CT. NC1704.2 +132700 MOVE "0" TO WRK-XN-00001. NC1704.2 +132800 MPY-TEST-F2-24-0. NC1704.2 +132900 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-6V0-1 NC1704.2 +133000 GIVING WRK-DU-2V0-1 NC1704.2 +133100 WRK-DU-2V0-2 ROUNDED NC1704.2 +133200 WRK-DU-2V5-1 NC1704.2 +133300 WRK-NE-2 ROUNDED NC1704.2 +133400 WRK-NE-3 NC1704.2 +133500 NOT ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1704.2 +133600 GO TO MPY-TEST-F2-24-1. NC1704.2 +133700 MPY-DELETE-F2-24. NC1704.2 +133800 PERFORM DE-LETE. NC1704.2 +133900 PERFORM PRINT-DETAIL. NC1704.2 +134000 GO TO MPY-INIT-F2-25. NC1704.2 +134100 MPY-TEST-F2-24-1. NC1704.2 +134200 IF WRK-DU-2V0-1 = 9 NC1704.2 +134300 PERFORM PASS NC1704.2 +134400 PERFORM PRINT-DETAIL NC1704.2 +134500 ELSE NC1704.2 +134600 PERFORM FAIL NC1704.2 +134700 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +134800 MOVE 9 TO CORRECT-N NC1704.2 +134900 PERFORM PRINT-DETAIL. NC1704.2 +135000 ADD 1 TO REC-CT. NC1704.2 +135100 MPY-TEST-F2-24-2. NC1704.2 +135200 IF WRK-DU-2V0-2 = 10 NC1704.2 +135300 PERFORM PASS NC1704.2 +135400 PERFORM PRINT-DETAIL NC1704.2 +135500 ELSE NC1704.2 +135600 PERFORM FAIL NC1704.2 +135700 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +135800 MOVE 10 TO CORRECT-N NC1704.2 +135900 PERFORM PRINT-DETAIL. NC1704.2 +136000 ADD 1 TO REC-CT. NC1704.2 +136100 MPY-TEST-F2-24-3. NC1704.2 +136200 IF WRK-DU-2V5-1 = 9.99999 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +136300 ELSE NC1704.2 +136400 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 9.99999 TO NC1704.2 +136500 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +136600 ADD 1 TO REC-CT. NC1704.2 +136700 MPY-TEST-F2-24-4. NC1704.2 +136800 IF WRK-NE-2 = "$10.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +136900 ELSE NC1704.2 +137000 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$10.00" NC1704.2 +137100 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +137200 ADD 1 TO REC-CT. NC1704.2 +137300 MPY-TEST-F2-24-5. NC1704.2 +137400 IF WRK-NE-3 = "$09.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +137500 ELSE NC1704.2 +137600 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$09.99 " NC1704.2 +137700 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +137800 ADD 1 TO REC-CT. NC1704.2 +137900 MPY-TEST-F2-24-6. NC1704.2 +138000 IF WRK-XN-00001 = "1" NC1704.2 +138100 PERFORM PASS NC1704.2 +138200 PERFORM PRINT-DETAIL NC1704.2 +138300 ELSE NC1704.2 +138400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +138500 MOVE WRK-DU-6V0-2 TO COMPUTED-X NC1704.2 +138600 MOVE "1" TO CORRECT-X NC1704.2 +138700 PERFORM FAIL NC1704.2 +138800 PERFORM PRINT-DETAIL. NC1704.2 +138900* NC1704.2 +139000 MPY-INIT-F2-25. NC1704.2 +139100* ==--> SIZE ERROR CONDITION <--== NC1704.2 +139200* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +139300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +139400 MOVE "MPY-TEST-F2-25" TO PAR-NAME. NC1704.2 +139500 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +139600 MOVE 1 TO REC-CT. NC1704.2 +139700 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +139800 MOVE 0 TO WRK-DU-2V0-2. NC1704.2 +139900 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +140000 MOVE 0 TO WRK-NE-2. NC1704.2 +140100 MOVE 0 TO WRK-NE-3. NC1704.2 +140200 MOVE "0" TO WRK-XN-00001. NC1704.2 +140300 MPY-TEST-F2-25-0. NC1704.2 +140400 MULTIPLY WRK-DU-6V0-1 BY WRK-DU-6V0-1 NC1704.2 +140500 GIVING WRK-DU-2V0-1 NC1704.2 +140600 WRK-DU-2V0-2 ROUNDED NC1704.2 +140700 WRK-DU-2V5-1 NC1704.2 +140800 WRK-NE-2 ROUNDED NC1704.2 +140900 WRK-NE-3 NC1704.2 +141000 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1704.2 +141100 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1704.2 +141200 GO TO MPY-TEST-F2-25-1. NC1704.2 +141300 MPY-DELETE-F2-25. NC1704.2 +141400 PERFORM DE-LETE. NC1704.2 +141500 PERFORM PRINT-DETAIL. NC1704.2 +141600 GO TO MPY-INIT-F2-26. NC1704.2 +141700 MPY-TEST-F2-25-1. NC1704.2 +141800 IF WRK-DU-2V0-1 = 0 NC1704.2 +141900 PERFORM PASS NC1704.2 +142000 PERFORM PRINT-DETAIL NC1704.2 +142100 ELSE NC1704.2 +142200 PERFORM FAIL NC1704.2 +142300 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +142400 MOVE 0 TO CORRECT-N NC1704.2 +142500 PERFORM PRINT-DETAIL. NC1704.2 +142600 ADD 1 TO REC-CT. NC1704.2 +142700 MPY-TEST-F2-25-2. NC1704.2 +142800 IF WRK-DU-2V0-2 = 00 NC1704.2 +142900 PERFORM PASS NC1704.2 +143000 PERFORM PRINT-DETAIL NC1704.2 +143100 ELSE NC1704.2 +143200 PERFORM FAIL NC1704.2 +143300 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +143400 MOVE 00 TO CORRECT-N NC1704.2 +143500 PERFORM PRINT-DETAIL. NC1704.2 +143600 ADD 1 TO REC-CT. NC1704.2 +143700 MPY-TEST-F2-25-3. NC1704.2 +143800 IF WRK-DU-2V5-1 = 0.00000 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +143900 ELSE NC1704.2 +144000 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 0.00000 TO NC1704.2 +144100 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +144200 ADD 1 TO REC-CT. NC1704.2 +144300 MPY-TEST-F2-25-4. NC1704.2 +144400 IF WRK-NE-2 = "$**.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +144500 ELSE NC1704.2 +144600 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$**.00" NC1704.2 +144700 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +144800 ADD 1 TO REC-CT. NC1704.2 +144900 MPY-TEST-F2-25-5. NC1704.2 +145000 IF WRK-NE-3 = "$00.00 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +145100 ELSE NC1704.2 +145200 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$00.00 " NC1704.2 +145300 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +145400 ADD 1 TO REC-CT. NC1704.2 +145500 MPY-TEST-F2-25-6. NC1704.2 +145600 IF WRK-XN-00001 = "1" NC1704.2 +145700 PERFORM PASS NC1704.2 +145800 PERFORM PRINT-DETAIL NC1704.2 +145900 ELSE NC1704.2 +146000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +146100 MOVE WRK-DU-6V0-2 TO COMPUTED-X NC1704.2 +146200 MOVE "1" TO CORRECT-X NC1704.2 +146300 PERFORM FAIL NC1704.2 +146400 PERFORM PRINT-DETAIL. NC1704.2 +146500* NC1704.2 +146600* NC1704.2 +146700 MPY-INIT-F2-26. NC1704.2 +146800* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +146900* ==--> MULTIPLE RESULT FIELDS <--== NC1704.2 +147000 MOVE "MPY-TEST-F2-26" TO PAR-NAME. NC1704.2 +147100 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1704.2 +147200 MOVE 999999 TO WRK-DU-6V0-1. NC1704.2 +147300 MOVE .00001 TO WRK-DU-4P1-1. NC1704.2 +147400 MOVE 1 TO REC-CT. NC1704.2 +147500 MOVE 0 TO WRK-DU-2V0-1. NC1704.2 +147600 MOVE 0 TO WRK-DU-2V5-1. NC1704.2 +147700 MOVE 0 TO WRK-NE-2. NC1704.2 +147800 MOVE 0 TO WRK-NE-3. NC1704.2 +147900 MOVE "0" TO WRK-XN-00001. NC1704.2 +148000 MPY-TEST-F2-26-0. NC1704.2 +148100 MULTIPLY WRK-DU-4P1-1 BY WRK-DU-6V0-1 NC1704.2 +148200 GIVING WRK-DU-2V0-1 NC1704.2 +148300 WRK-DU-2V0-2 ROUNDED NC1704.2 +148400 WRK-DU-2V5-1 NC1704.2 +148500 WRK-NE-2 ROUNDED NC1704.2 +148600 WRK-NE-3 NC1704.2 +148700 ON SIZE ERROR MOVE "1" TO WRK-XN-00001 NC1704.2 +148800 NOT ON SIZE ERROR MOVE "2" TO WRK-XN-00001. NC1704.2 +148900 GO TO MPY-TEST-F2-26-1. NC1704.2 +149000 MPY-DELETE-F2-26. NC1704.2 +149100 PERFORM DE-LETE. NC1704.2 +149200 PERFORM PRINT-DETAIL. NC1704.2 +149300 GO TO MPY-INIT-F2-27. NC1704.2 +149400 MPY-TEST-F2-26-1. NC1704.2 +149500 IF WRK-DU-2V0-1 = 9 NC1704.2 +149600 PERFORM PASS NC1704.2 +149700 PERFORM PRINT-DETAIL NC1704.2 +149800 ELSE NC1704.2 +149900 PERFORM FAIL NC1704.2 +150000 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1704.2 +150100 MOVE 9 TO CORRECT-N NC1704.2 +150200 PERFORM PRINT-DETAIL. NC1704.2 +150300 ADD 1 TO REC-CT. NC1704.2 +150400 MPY-TEST-F2-26-2. NC1704.2 +150500 IF WRK-DU-2V0-2 = 10 NC1704.2 +150600 PERFORM PASS NC1704.2 +150700 PERFORM PRINT-DETAIL NC1704.2 +150800 ELSE NC1704.2 +150900 PERFORM FAIL NC1704.2 +151000 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1704.2 +151100 MOVE 10 TO CORRECT-N NC1704.2 +151200 PERFORM PRINT-DETAIL. NC1704.2 +151300 ADD 1 TO REC-CT. NC1704.2 +151400 MPY-TEST-F2-26-3. NC1704.2 +151500 IF WRK-DU-2V5-1 = 9.99999 PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +151600 ELSE NC1704.2 +151700 PERFORM FAIL MOVE WRK-DU-2V5-1 TO COMPUTED-N MOVE 9.99999 TO NC1704.2 +151800 CORRECT-N PERFORM PRINT-DETAIL. NC1704.2 +151900 ADD 1 TO REC-CT. NC1704.2 +152000 MPY-TEST-F2-26-4. NC1704.2 +152100 IF WRK-NE-2 = "$10.00" PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +152200 ELSE NC1704.2 +152300 PERFORM FAIL MOVE WRK-NE-2 TO COMPUTED-A MOVE "$10.00" NC1704.2 +152400 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +152500 ADD 1 TO REC-CT. NC1704.2 +152600 MPY-TEST-F2-26-5. NC1704.2 +152700 IF WRK-NE-3 = "$09.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1704.2 +152800 ELSE NC1704.2 +152900 PERFORM FAIL MOVE WRK-NE-3 TO COMPUTED-A MOVE "$09.99 " NC1704.2 +153000 TO CORRECT-A PERFORM PRINT-DETAIL. NC1704.2 +153100 ADD 1 TO REC-CT. NC1704.2 +153200 MPY-TEST-F2-26-6. NC1704.2 +153300 IF WRK-XN-00001 = "2" NC1704.2 +153400 PERFORM PASS NC1704.2 +153500 PERFORM PRINT-DETAIL NC1704.2 +153600 ELSE NC1704.2 +153700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +153800 MOVE WRK-DU-6V0-2 TO COMPUTED-X NC1704.2 +153900 MOVE "2" TO CORRECT-X NC1704.2 +154000 PERFORM FAIL NC1704.2 +154100 PERFORM PRINT-DETAIL. NC1704.2 +154200* NC1704.2 +154300 MPY-INIT-F2-27. NC1704.2 +154400* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +154500 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +154600 MOVE "MPY-TEST-F2-27" TO PAR-NAME. NC1704.2 +154700 MOVE "A" TO XRAY. NC1704.2 +154800 MOVE 80.12 TO MULT1. NC1704.2 +154900 MOVE -56 TO MULT4. NC1704.2 +155000 MOVE 4 TO MULT5. NC1704.2 +155100 MOVE 0 TO WRK-DS-10V00. NC1704.2 +155200 MOVE 0 TO WRK-DS-02V00. NC1704.2 +155300 MOVE 1 TO REC-CT. NC1704.2 +155400 MPY-TEST-F2-27-0. NC1704.2 +155500 MULTIPLY MULT4 BY MULT1 NC1704.2 +155600 GIVING MULT5 NC1704.2 +155700 ON SIZE ERROR NC1704.2 +155800 MOVE "H" TO XRAY NC1704.2 +155900 MOVE 28 TO WRK-DS-10V00 NC1704.2 +156000 MOVE -19 TO WRK-DS-02V00 NC1704.2 +156100 END-MULTIPLY NC1704.2 +156200 MOVE 99 TO WRK-CS-18V00. NC1704.2 +156300 GO TO MPY-TEST-F2-27-1. NC1704.2 +156400 MPY-DELETE-F2-27-1. NC1704.2 +156500 PERFORM DE-LETE. NC1704.2 +156600 PERFORM PRINT-DETAIL. NC1704.2 +156700 GO TO MPY-INIT-F2-28. NC1704.2 +156800 MPY-TEST-F2-27-1. NC1704.2 +156900 MOVE "MPY-TEST-F2-27-1" TO PAR-NAME. NC1704.2 +157000 IF XRAY = "H" NC1704.2 +157100 PERFORM PASS NC1704.2 +157200 PERFORM PRINT-DETAIL NC1704.2 +157300 ELSE NC1704.2 +157400 MOVE XRAY TO COMPUTED-X NC1704.2 +157500 MOVE "H" TO CORRECT-X NC1704.2 +157600 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1704.2 +157700 PERFORM FAIL NC1704.2 +157800 PERFORM PRINT-DETAIL. NC1704.2 +157900 ADD 1 TO REC-CT. NC1704.2 +158000 MPY-TEST-F2-27-2. NC1704.2 +158100 MOVE "MPY-TEST-F2-27-2" TO PAR-NAME. NC1704.2 +158200 IF WRK-DS-10V00 = 0000000028 NC1704.2 +158300 PERFORM PASS NC1704.2 +158400 PERFORM PRINT-DETAIL NC1704.2 +158500 ELSE NC1704.2 +158600 MOVE WRK-DS-10V00 TO COMPUTED-N NC1704.2 +158700 MOVE 28 TO CORRECT-N NC1704.2 +158800 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1704.2 +158900 PERFORM FAIL NC1704.2 +159000 PERFORM PRINT-DETAIL. NC1704.2 +159100 ADD 1 TO REC-CT. NC1704.2 +159200 MPY-TEST-F2-27-3. NC1704.2 +159300 MOVE "MPY-TEST-F2-27-3" TO PAR-NAME. NC1704.2 +159400 IF WRK-DS-02V00 = -19 NC1704.2 +159500 PERFORM PASS NC1704.2 +159600 PERFORM PRINT-DETAIL NC1704.2 +159700 ELSE NC1704.2 +159800 MOVE WRK-DS-02V00 TO COMPUTED-N NC1704.2 +159900 MOVE -19 TO CORRECT-N NC1704.2 +160000 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1704.2 +160100 PERFORM FAIL NC1704.2 +160200 PERFORM PRINT-DETAIL. NC1704.2 +160300 ADD 1 TO REC-CT. NC1704.2 +160400 MPY-TEST-F2-27-4. NC1704.2 +160500 MOVE "MPY-TEST-F2-27-4" TO PAR-NAME. NC1704.2 +160600 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +160700 PERFORM PASS NC1704.2 +160800 PERFORM PRINT-DETAIL NC1704.2 +160900 ELSE NC1704.2 +161000 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +161100 MOVE 99 TO CORRECT-N NC1704.2 +161200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1704.2 +161300 PERFORM FAIL NC1704.2 +161400 PERFORM PRINT-DETAIL. NC1704.2 +161500 ADD 1 TO REC-CT. NC1704.2 +161600 MPY-TEST-F2-27-5. NC1704.2 +161700 MOVE "MPY-TEST-F2-27-5" TO PAR-NAME. NC1704.2 +161800 IF MULT5 = 4 NC1704.2 +161900 PERFORM PASS NC1704.2 +162000 PERFORM PRINT-DETAIL NC1704.2 +162100 ELSE NC1704.2 +162200 MOVE MULT5 TO COMPUTED-N NC1704.2 +162300 MOVE 4 TO CORRECT-N NC1704.2 +162400 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK NC1704.2 +162500 PERFORM FAIL NC1704.2 +162600 PERFORM PRINT-DETAIL. NC1704.2 +162700* NC1704.2 +162800 MPY-INIT-F2-28. NC1704.2 +162900* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +163000 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +163100 MOVE "MPY-TEST-F2-28" TO PAR-NAME. NC1704.2 +163200 MOVE "1" TO WRK-XN-00001. NC1704.2 +163300 MOVE 0 TO WRK-DS-05V00. NC1704.2 +163400 MOVE 0 TO WRK-DS-02V00. NC1704.2 +163500 MOVE 0 TO WRK-DS-10V00. NC1704.2 +163600 MOVE 1 TO REC-CT. NC1704.2 +163700 MPY-TEST-F2-28-0. NC1704.2 +163800 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +163900 GIVING WRK-DS-10V00 NC1704.2 +164000 ON SIZE ERROR NC1704.2 +164100 MOVE "0" TO WRK-XN-00001 NC1704.2 +164200 MOVE 38 TO WRK-DS-05V00 NC1704.2 +164300 MOVE -19 TO WRK-DS-02V00 NC1704.2 +164400 END-MULTIPLY NC1704.2 +164500 MOVE 99 TO WRK-CS-18V00. NC1704.2 +164600 GO TO MPY-TEST-F2-28-1. NC1704.2 +164700 MPY-DELETE-F2-28-1. NC1704.2 +164800 PERFORM DE-LETE. NC1704.2 +164900 PERFORM PRINT-DETAIL. NC1704.2 +165000 GO TO MPY-INIT-F2-29. NC1704.2 +165100 MPY-TEST-F2-28-1. NC1704.2 +165200 MOVE "MPY-TEST-F2-28-1" TO PAR-NAME. NC1704.2 +165300 IF WRK-XN-00001 = "1" NC1704.2 +165400 PERFORM PASS NC1704.2 +165500 PERFORM PRINT-DETAIL NC1704.2 +165600 ELSE NC1704.2 +165700 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +165800 MOVE "1" TO CORRECT-X NC1704.2 +165900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +166000 TO RE-MARK NC1704.2 +166100 PERFORM FAIL NC1704.2 +166200 PERFORM PRINT-DETAIL. NC1704.2 +166300 ADD 1 TO REC-CT. NC1704.2 +166400 MPY-TEST-F2-28-2. NC1704.2 +166500 MOVE "MPY-TEST-F2-28-2" TO PAR-NAME. NC1704.2 +166600 IF WRK-DS-10V00 = 0000000111 NC1704.2 +166700 PERFORM PASS NC1704.2 +166800 PERFORM PRINT-DETAIL NC1704.2 +166900 ELSE NC1704.2 +167000 MOVE WRK-DS-10V00 TO COMPUTED-N NC1704.2 +167100 MOVE 0000000111 TO CORRECT-N NC1704.2 +167200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +167300 PERFORM FAIL NC1704.2 +167400 PERFORM PRINT-DETAIL. NC1704.2 +167500 ADD 1 TO REC-CT. NC1704.2 +167600 MPY-TEST-F2-28-3. NC1704.2 +167700 MOVE "MPY-TEST-F2-28-3" TO PAR-NAME. NC1704.2 +167800 IF WRK-DS-05V00 = 0 NC1704.2 +167900 PERFORM PASS NC1704.2 +168000 PERFORM PRINT-DETAIL NC1704.2 +168100 ELSE NC1704.2 +168200 MOVE WRK-DS-05V00 TO COMPUTED-N NC1704.2 +168300 MOVE 0 TO CORRECT-N NC1704.2 +168400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +168500 TO RE-MARK NC1704.2 +168600 PERFORM FAIL NC1704.2 +168700 PERFORM PRINT-DETAIL. NC1704.2 +168800 ADD 1 TO REC-CT. NC1704.2 +168900 MPY-TEST-F2-28-4. NC1704.2 +169000 MOVE "MPY-TEST-F2-28-4" TO PAR-NAME. NC1704.2 +169100 IF WRK-DS-02V00 = 0 NC1704.2 +169200 PERFORM PASS NC1704.2 +169300 PERFORM PRINT-DETAIL NC1704.2 +169400 ELSE NC1704.2 +169500 MOVE WRK-DS-02V00 TO COMPUTED-N NC1704.2 +169600 MOVE 0 TO CORRECT-N NC1704.2 +169700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +169800 TO RE-MARK NC1704.2 +169900 PERFORM FAIL NC1704.2 +170000 PERFORM PRINT-DETAIL. NC1704.2 +170100 ADD 1 TO REC-CT. NC1704.2 +170200 MPY-TEST-F2-28-5. NC1704.2 +170300 MOVE "MPY-TEST-F2-28-5" TO PAR-NAME. NC1704.2 +170400 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +170500 PERFORM PASS NC1704.2 +170600 PERFORM PRINT-DETAIL NC1704.2 +170700 ELSE NC1704.2 +170800 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +170900 MOVE 99 TO CORRECT-N NC1704.2 +171000 MOVE "SCOPE TERMINATOR IGNORED" NC1704.2 +171100 TO RE-MARK NC1704.2 +171200 PERFORM FAIL NC1704.2 +171300 PERFORM PRINT-DETAIL. NC1704.2 +171400* NC1704.2 +171500 MPY-INIT-F2-29. NC1704.2 +171600* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +171700* ==--> SIZE ERROR CONDITION <--== NC1704.2 +171800 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +171900 MOVE "MPY-TEST-F2-29" TO PAR-NAME. NC1704.2 +172000 MOVE "A" TO XRAY. NC1704.2 +172100 MOVE 80.12 TO MULT1. NC1704.2 +172200 MOVE -56 TO MULT4. NC1704.2 +172300 MOVE 4 TO MULT5. NC1704.2 +172400 MOVE 1 TO REC-CT. NC1704.2 +172500 MOVE 0 TO WRK-DS-10V00. NC1704.2 +172600 MOVE 0 TO WRK-DS-02V00. NC1704.2 +172700 MPY-TEST-F2-29-0. NC1704.2 +172800 MULTIPLY MULT4 BY MULT1 NC1704.2 +172900 GIVING MULT5 NC1704.2 +173000 NOT ON SIZE ERROR NC1704.2 +173100 MOVE "H" TO XRAY NC1704.2 +173200 MOVE 38 TO WRK-DS-10V00 NC1704.2 +173300 MOVE -19 TO WRK-DS-02V00 NC1704.2 +173400 END-MULTIPLY NC1704.2 +173500 MOVE 99 TO WRK-CS-18V00. NC1704.2 +173600 GO TO MPY-TEST-F2-29-1. NC1704.2 +173700 MPY-DELETE-F2-29-1. NC1704.2 +173800 PERFORM DE-LETE. NC1704.2 +173900 PERFORM PRINT-DETAIL. NC1704.2 +174000 GO TO MPY-INIT-F2-30. NC1704.2 +174100 MPY-TEST-F2-29-1. NC1704.2 +174200 MOVE "MPY-TEST-F2-29-1" TO PAR-NAME. NC1704.2 +174300 IF XRAY = "A" NC1704.2 +174400 PERFORM PASS NC1704.2 +174500 PERFORM PRINT-DETAIL NC1704.2 +174600 ELSE NC1704.2 +174700 MOVE XRAY TO COMPUTED-X NC1704.2 +174800 MOVE "A" TO CORRECT-X NC1704.2 +174900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +175000 TO RE-MARK NC1704.2 +175100 PERFORM FAIL NC1704.2 +175200 PERFORM PRINT-DETAIL. NC1704.2 +175300 ADD 1 TO REC-CT. NC1704.2 +175400 MPY-TEST-F2-29-2. NC1704.2 +175500 MOVE "MPY-TEST-F2-29-2" TO PAR-NAME. NC1704.2 +175600 IF WRK-DS-10V00 = 0 NC1704.2 +175700 PERFORM PASS NC1704.2 +175800 PERFORM PRINT-DETAIL NC1704.2 +175900 ELSE NC1704.2 +176000 MOVE WRK-DS-10V00 TO COMPUTED-N NC1704.2 +176100 MOVE 0 TO CORRECT-N NC1704.2 +176200 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +176300 TO RE-MARK NC1704.2 +176400 PERFORM FAIL NC1704.2 +176500 PERFORM PRINT-DETAIL. NC1704.2 +176600 ADD 1 TO REC-CT. NC1704.2 +176700 MPY-TEST-F2-29-3. NC1704.2 +176800 MOVE "MPY-TEST-F2-29-3" TO PAR-NAME. NC1704.2 +176900 IF WRK-DS-02V00 = 0 NC1704.2 +177000 PERFORM PASS NC1704.2 +177100 PERFORM PRINT-DETAIL NC1704.2 +177200 ELSE NC1704.2 +177300 MOVE WRK-DS-02V00 TO COMPUTED-N NC1704.2 +177400 MOVE 0 TO CORRECT-N NC1704.2 +177500 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +177600 TO RE-MARK NC1704.2 +177700 PERFORM FAIL NC1704.2 +177800 PERFORM PRINT-DETAIL. NC1704.2 +177900 ADD 1 TO REC-CT. NC1704.2 +178000 MPY-TEST-F2-29-4. NC1704.2 +178100 MOVE "MPY-TEST-F2-29-4" TO PAR-NAME. NC1704.2 +178200 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +178300 PERFORM PASS NC1704.2 +178400 PERFORM PRINT-DETAIL NC1704.2 +178500 ELSE NC1704.2 +178600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +178700 MOVE 99 TO CORRECT-N NC1704.2 +178800 MOVE "SCOPE TERMINATOR IGNORED" NC1704.2 +178900 TO RE-MARK NC1704.2 +179000 PERFORM FAIL NC1704.2 +179100 PERFORM PRINT-DETAIL. NC1704.2 +179200 ADD 1 TO REC-CT. NC1704.2 +179300 MPY-TEST-F2-29-5. NC1704.2 +179400 MOVE "MPY-TEST-F2-29-5" TO PAR-NAME. NC1704.2 +179500 IF MULT5 = 4 NC1704.2 +179600 PERFORM PASS NC1704.2 +179700 PERFORM PRINT-DETAIL NC1704.2 +179800 ELSE NC1704.2 +179900 MOVE MULT5 TO COMPUTED-N NC1704.2 +180000 MOVE 4 TO CORRECT-N NC1704.2 +180100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1704.2 +180200 TO RE-MARK NC1704.2 +180300 PERFORM FAIL NC1704.2 +180400 PERFORM PRINT-DETAIL. NC1704.2 +180500* NC1704.2 +180600 MPY-INIT-F2-30. NC1704.2 +180700* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +180800* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +180900 MOVE "MPY-TEST-F2-30" TO PAR-NAME NC1704.2 +181000 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +181100 MOVE "1" TO WRK-XN-00001. NC1704.2 +181200 MOVE 0 TO WRK-DS-05V00. NC1704.2 +181300 MOVE 0 TO WRK-DS-02V00. NC1704.2 +181400 MOVE 0 TO WRK-DS-10V00. NC1704.2 +181500 MOVE 1 TO REC-CT. NC1704.2 +181600 MPY-TEST-F2-30-0. NC1704.2 +181700 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +181800 GIVING WRK-DS-10V00 NC1704.2 +181900 NOT ON SIZE ERROR NC1704.2 +182000 MOVE "0" TO WRK-XN-00001 NC1704.2 +182100 MOVE 38 TO WRK-DS-05V00 NC1704.2 +182200 MOVE -19 TO WRK-DS-02V00 NC1704.2 +182300 END-MULTIPLY NC1704.2 +182400 MOVE 99 TO WRK-CS-18V00. NC1704.2 +182500 GO TO MPY-TEST-F2-30-1. NC1704.2 +182600 MPY-DELETE-F2-30-1. NC1704.2 +182700 PERFORM DE-LETE. NC1704.2 +182800 PERFORM PRINT-DETAIL. NC1704.2 +182900 GO TO MPY-INIT-F2-31. NC1704.2 +183000 MPY-TEST-F2-30-1. NC1704.2 +183100 MOVE "MPY-TEST-F2-30-1" TO PAR-NAME. NC1704.2 +183200 IF WRK-XN-00001 = "0" NC1704.2 +183300 PERFORM PASS NC1704.2 +183400 PERFORM PRINT-DETAIL NC1704.2 +183500 ELSE NC1704.2 +183600 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +183700 MOVE "0" TO CORRECT-X NC1704.2 +183800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +183900 TO RE-MARK NC1704.2 +184000 PERFORM FAIL NC1704.2 +184100 PERFORM PRINT-DETAIL. NC1704.2 +184200 ADD 1 TO REC-CT. NC1704.2 +184300 MPY-TEST-F2-30-2. NC1704.2 +184400 MOVE "MPY-TEST-F2-30-2" TO PAR-NAME. NC1704.2 +184500 IF WRK-DS-10V00 = 0000000111 NC1704.2 +184600 PERFORM PASS NC1704.2 +184700 PERFORM PRINT-DETAIL NC1704.2 +184800 ELSE NC1704.2 +184900 MOVE WRK-DS-10V00 TO COMPUTED-N NC1704.2 +185000 MOVE 28 TO CORRECT-N NC1704.2 +185100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +185200 PERFORM FAIL NC1704.2 +185300 PERFORM PRINT-DETAIL. NC1704.2 +185400 ADD 1 TO REC-CT. NC1704.2 +185500 MPY-TEST-F2-30-3. NC1704.2 +185600 MOVE "MPY-TEST-F2-30-3" TO PAR-NAME. NC1704.2 +185700 IF WRK-DS-05V00 = 38 NC1704.2 +185800 PERFORM PASS NC1704.2 +185900 PERFORM PRINT-DETAIL NC1704.2 +186000 ELSE NC1704.2 +186100 MOVE WRK-DS-05V00 TO COMPUTED-N NC1704.2 +186200 MOVE 38 TO CORRECT-N NC1704.2 +186300 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" NC1704.2 +186400 TO RE-MARK NC1704.2 +186500 PERFORM FAIL NC1704.2 +186600 PERFORM PRINT-DETAIL. NC1704.2 +186700 ADD 1 TO REC-CT. NC1704.2 +186800 MPY-TEST-F2-30-4. NC1704.2 +186900 MOVE "MPY-TEST-F2-30-4" TO PAR-NAME. NC1704.2 +187000 IF WRK-DS-02V00 = -19 NC1704.2 +187100 PERFORM PASS NC1704.2 +187200 PERFORM PRINT-DETAIL NC1704.2 +187300 ELSE NC1704.2 +187400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1704.2 +187500 MOVE -19 TO CORRECT-N NC1704.2 +187600 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" NC1704.2 +187700 TO RE-MARK NC1704.2 +187800 PERFORM FAIL NC1704.2 +187900 PERFORM PRINT-DETAIL. NC1704.2 +188000 ADD 1 TO REC-CT. NC1704.2 +188100 MPY-TEST-F2-30-5. NC1704.2 +188200 MOVE "MPY-TEST-F2-30-5" TO PAR-NAME. NC1704.2 +188300 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +188400 PERFORM PASS NC1704.2 +188500 PERFORM PRINT-DETAIL NC1704.2 +188600 ELSE NC1704.2 +188700 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +188800 MOVE 99 TO CORRECT-N NC1704.2 +188900 MOVE "SCOPE TERMINATOR IGNORED" NC1704.2 +189000 TO RE-MARK NC1704.2 +189100 PERFORM FAIL NC1704.2 +189200 PERFORM PRINT-DETAIL. NC1704.2 +189300* NC1704.2 +189400 MPY-INIT-F2-31. NC1704.2 +189500* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +189600* ==--> NO SIZE ERROR CONDITION <--== NC1704.2 +189700 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +189800 MOVE "MPY-TEST-F2-31" TO PAR-NAME NC1704.2 +189900 MOVE 80.12 TO MULT1. NC1704.2 +190000 MOVE -56 TO MULT4. NC1704.2 +190100 MOVE 4 TO MULT5. NC1704.2 +190200 MOVE 1 TO REC-CT. NC1704.2 +190300 MOVE "A" TO XRAY. NC1704.2 +190400 MPY-TEST-F2-31-0. NC1704.2 +190500 MULTIPLY MULT4 BY MULT1 NC1704.2 +190600 GIVING MULT5 NC1704.2 +190700 ON SIZE ERROR NC1704.2 +190800 MOVE "B" TO XRAY NC1704.2 +190900 NOT ON SIZE ERROR NC1704.2 +191000 MOVE "C" TO XRAY NC1704.2 +191100 END-MULTIPLY NC1704.2 +191200 MOVE 99 TO WRK-CS-18V00. NC1704.2 +191300 GO TO MPY-TEST-F2-31-1. NC1704.2 +191400 MPY-DELETE-F2-31-1. NC1704.2 +191500 PERFORM DE-LETE. NC1704.2 +191600 PERFORM PRINT-DETAIL. NC1704.2 +191700 GO TO MPY-INIT-F2-32. NC1704.2 +191800 MPY-TEST-F2-31-1. NC1704.2 +191900 MOVE "MPY-TEST-F2-31-1" TO PAR-NAME. NC1704.2 +192000 IF XRAY = "B" NC1704.2 +192100 PERFORM PASS NC1704.2 +192200 PERFORM PRINT-DETAIL NC1704.2 +192300 ELSE NC1704.2 +192400 MOVE XRAY TO COMPUTED-X NC1704.2 +192500 MOVE "B" TO CORRECT-X NC1704.2 +192600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +192700 PERFORM FAIL NC1704.2 +192800 PERFORM PRINT-DETAIL. NC1704.2 +192900 ADD 1 TO REC-CT. NC1704.2 +193000 MPY-TEST-F2-31-2. NC1704.2 +193100 MOVE "MPY-TEST-F2-31-2" TO PAR-NAME. NC1704.2 +193200 IF MULT5 = 4 NC1704.2 +193300 PERFORM PASS NC1704.2 +193400 PERFORM PRINT-DETAIL NC1704.2 +193500 ELSE NC1704.2 +193600 MOVE MULT5 TO COMPUTED-N NC1704.2 +193700 MOVE 4 TO CORRECT-N NC1704.2 +193800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1704.2 +193900 PERFORM FAIL NC1704.2 +194000 PERFORM PRINT-DETAIL. NC1704.2 +194100 ADD 1 TO REC-CT. NC1704.2 +194200 MPY-TEST-F2-31-3. NC1704.2 +194300 MOVE "MPY-TEST-F2-31-3" TO PAR-NAME. NC1704.2 +194400 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +194500 PERFORM PASS NC1704.2 +194600 PERFORM PRINT-DETAIL NC1704.2 +194700 ELSE NC1704.2 +194800 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +194900 MOVE 99 TO CORRECT-N NC1704.2 +195000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1704.2 +195100 PERFORM FAIL NC1704.2 +195200 PERFORM PRINT-DETAIL. NC1704.2 +195300* NC1704.2 +195400 MPY-INIT-F2-32. NC1704.2 +195500* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1704.2 +195600 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1704.2 +195700 MOVE "MPY-TEST-F2-32" TO PAR-NAME NC1704.2 +195800 MOVE "0" TO WRK-XN-00001. NC1704.2 +195900 MOVE 0 TO WRK-DS-10V00. NC1704.2 +196000 MOVE 1 TO REC-CT. NC1704.2 +196100 MPY-TEST-F2-32-0. NC1704.2 +196200 MULTIPLY A01ONE-DS-P0801 BY A12ONES-DS-12V00 NC1704.2 +196300 GIVING WRK-DS-10V00 NC1704.2 +196400 ON SIZE ERROR NC1704.2 +196500 MOVE "1" TO WRK-XN-00001 NC1704.2 +196600 NOT ON SIZE ERROR NC1704.2 +196700 MOVE "2" TO WRK-XN-00001 NC1704.2 +196800 END-MULTIPLY NC1704.2 +196900 MOVE 99 TO WRK-CS-18V00. NC1704.2 +197000 GO TO MPY-TEST-F2-32-1. NC1704.2 +197100 MPY-DELETE-F2-32-1. NC1704.2 +197200 PERFORM DE-LETE. NC1704.2 +197300 PERFORM PRINT-DETAIL. NC1704.2 +197400 GO TO CCVS-EXIT. NC1704.2 +197500 MPY-TEST-F2-32-1. NC1704.2 +197600 MOVE "MPY-TEST-F2-32-1" TO PAR-NAME. NC1704.2 +197700 IF WRK-DS-10V00 = 0000000111 NC1704.2 +197800 PERFORM PASS NC1704.2 +197900 PERFORM PRINT-DETAIL NC1704.2 +198000 ELSE NC1704.2 +198100 MOVE 0000000111 TO CORRECT-18V0 NC1704.2 +198200 MOVE WRK-DS-10V00 TO COMPUTED-18V0 NC1704.2 +198300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1704.2 +198400 PERFORM FAIL NC1704.2 +198500 PERFORM PRINT-DETAIL. NC1704.2 +198600 ADD 1 TO REC-CT. NC1704.2 +198700 MPY-TEST-F2-32-2. NC1704.2 +198800 MOVE "MPY-TEST-F2-32-2" TO PAR-NAME. NC1704.2 +198900 IF WRK-XN-00001 = "2" NC1704.2 +199000 PERFORM PASS NC1704.2 +199100 PERFORM PRINT-DETAIL NC1704.2 +199200 ELSE NC1704.2 +199300 MOVE WRK-XN-00001 TO COMPUTED-X NC1704.2 +199400 MOVE "2" TO CORRECT-X NC1704.2 +199500 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" NC1704.2 +199600 TO RE-MARK NC1704.2 +199700 PERFORM FAIL NC1704.2 +199800 PERFORM PRINT-DETAIL. NC1704.2 +199900 ADD 1 TO REC-CT. NC1704.2 +200000 MPY-TEST-F2-32-3. NC1704.2 +200100 MOVE "MPY-TEST-F2-32-3" TO PAR-NAME. NC1704.2 +200200 IF WRK-CS-18V00 = 000000000000000099 NC1704.2 +200300 PERFORM PASS NC1704.2 +200400 PERFORM PRINT-DETAIL NC1704.2 +200500 ELSE NC1704.2 +200600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1704.2 +200700 MOVE 99 TO CORRECT-N NC1704.2 +200800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1704.2 +200900 PERFORM FAIL NC1704.2 +201000 PERFORM PRINT-DETAIL. NC1704.2 +201100* NC1704.2 +201200* NC1704.2 +201300 CCVS-EXIT SECTION. NC1704.2 +201400 CCVS-999999. NC1704.2 +201500 GO TO CLOSE-FILES. NC1704.2 diff --git a/tests/cobol85/NC/NC171A.CBL b/tests/cobol85/NC/NC171A.CBL new file mode 100755 index 00000000..ff8e99c1 --- /dev/null +++ b/tests/cobol85/NC/NC171A.CBL @@ -0,0 +1,2268 @@ +000100 IDENTIFICATION DIVISION. NC1714.2 +000200 PROGRAM-ID. NC1714.2 +000300 NC171A. NC1714.2 +000400**************************************************************** NC1714.2 +000500* * NC1714.2 +000600* VALIDATION FOR:- * NC1714.2 +000700* * NC1714.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1714.2 +000900* * NC1714.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1714.2 +001100* * NC1714.2 +001200**************************************************************** NC1714.2 +001300* * NC1714.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1714.2 +001500* * NC1714.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1714.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1714.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1714.2 +001900* * NC1714.2 +002000**************************************************************** NC1714.2 +002100* THIS PROGRAM TESTS THE FORMAT 1 DIVIDE STATEMENT FOUND NC1714.2 +002200* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1714.2 +002300* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1714.2 +002400* TESTED, AS WELL AS THE ROUNDED OPTION. NC1714.2 +002500* NC1714.2 +002600* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1714.2 +002700* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1714.2 +002800* AS OPERANDS. NC1714.2 +002900* NC1714.2 +003000 NC1714.2 +003100 NC1714.2 +003200 ENVIRONMENT DIVISION. NC1714.2 +003300 CONFIGURATION SECTION. NC1714.2 +003400 SOURCE-COMPUTER. NC1714.2 +003500 Linux. NC1714.2 +003600 OBJECT-COMPUTER. NC1714.2 +003700 Linux. NC1714.2 +003800 INPUT-OUTPUT SECTION. NC1714.2 +003900 FILE-CONTROL. NC1714.2 +004000 SELECT PRINT-FILE ASSIGN TO NC1714.2 +004100 "report.log". NC1714.2 +004200 DATA DIVISION. NC1714.2 +004300 FILE SECTION. NC1714.2 +004400 FD PRINT-FILE. NC1714.2 +004500 01 PRINT-REC PICTURE X(120). NC1714.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC1714.2 +004700 WORKING-STORAGE SECTION. NC1714.2 +004800 77 WRK-DS-18V00 PICTURE S9(18). NC1714.2 +004900 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1714.2 +005000 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1714.2 +005100 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1714.2 +005200 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1714.2 +005300 77 WRK-DS-10V00 PICTURE S9(10). NC1714.2 +005400 77 WRK-XN-00001 PICTURE X. NC1714.2 +005500 77 A10ONES-DS-10V00 PICTURE S9(10) NC1714.2 +005600 VALUE 1111111111. NC1714.2 +005700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1714.2 +005800 VALUE 333333.333333. NC1714.2 +005900 77 WRK-DS-02V00 PICTURE S99. NC1714.2 +006000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1714.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1714.2 +006200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1714.2 +006300 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1714.2 +006400 77 A12ONES-DS-12V00 PICTURE S9(12) NC1714.2 +006500 VALUE 111111111111. NC1714.2 +006600 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1714.2 +006700 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1714.2 +006800 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1714.2 +006900 77 A18ONES-DS-18V00 PICTURE S9(18) NC1714.2 +007000 VALUE 111111111111111111. NC1714.2 +007100 77 WRK-DS-0201P PICTURE S99P. NC1714.2 +007200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1714.2 +007300 77 WRK-DU-18V00 PICTURE 9(18). NC1714.2 +007400 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1714.2 +007500 VALUE 99. NC1714.2 +007600 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1714.2 +007700 VALUE .1. NC1714.2 +007800 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1714.2 +007900 77 WRK-DS-12V00 PICTURE S9(12). NC1714.2 +008000 77 WRK-DS-01V00 PICTURE S9. NC1714.2 +008100 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1714.2 +008200 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1714.2 +008300 VALUE 111111111.111111111. NC1714.2 +008400 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1714.2 +008500 77 WRK-DS-05V00 PICTURE S9(5). NC1714.2 +008600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1714.2 +008700 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1714.2 +008800 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1714.2 +008900 77 XRAY PICTURE X. NC1714.2 +009000 01 WRK-XN-18-1 PIC X(18). NC1714.2 +009100 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1714.2 +009200 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1714.2 +009300 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1714.2 +009400 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1714.2 +009500 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1714.2 +009600 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1714.2 +009700 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1714.2 +009800 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1714.2 +009900 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1714.2 +010000 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1714.2 +010100 01 WRK-DU-1V5-1 PIC 9V9(5). NC1714.2 +010200 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1714.2 +010300 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1714.2 +010400 01 WRK-DU-2V0-1 PIC 99. NC1714.2 +010500 01 WRK-DU-2V0-2 PIC 99. NC1714.2 +010600 01 WRK-DU-2V0-3 PIC 99. NC1714.2 +010700 01 WRK-DU-2V1-1 PIC 99V9. NC1714.2 +010800 01 WRK-DU-2V1-2 PIC 99V9. NC1714.2 +010900 01 WRK-DU-2V1-3 PIC 99V9. NC1714.2 +011000 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1714.2 +011100 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1714.2 +011200 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1714.2 +011300 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1714.2 +011400 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1714.2 +011500 01 WRK-DU-2V5-1 PIC 99V9(5). NC1714.2 +011600 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1714.2 +011700 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1714.2 +011800 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1714.2 +011900 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1714.2 +012000 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1714.2 +012100 01 WRK-NE-X-1 PIC 9(16).99. NC1714.2 +012200 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1714.2 +012300 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1714.2 +012400 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1714.2 +012500 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1714.2 +012600 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1714.2 +012700 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1714.2 +012800 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1714.2 +012900 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1714.2 +013000 01 WRK-NE-X-2 PIC -9(16).99. NC1714.2 +013100 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1714.2 +013200 01 WRK-NE-2 PIC $**.99. NC1714.2 +013300 01 WRK-NE-3 PIC $99.99CR. NC1714.2 +013400 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1714.2 +013500 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1714.2 +013600 VALUE +000000000000000001. NC1714.2 +013700 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1714.2 +013800 VALUE -000000000000000033. NC1714.2 +013900 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1714.2 +014000 VALUE 666666666666666666. NC1714.2 +014100 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1714.2 +014200 VALUE 009999999999999999. NC1714.2 +014300 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1714.2 +014400 VALUE 000022222222222222. NC1714.2 +014500 01 MULTIPLY-DATA. NC1714.2 +014600 02 MULT1 PICTURE IS 999V99 NC1714.2 +014700 VALUE IS 80.12. NC1714.2 +014800 02 MULT2 PICTURE IS 999V999. NC1714.2 +014900 02 MULT3 PICTURE IS $$99.99. NC1714.2 +015000 02 MULT4 PICTURE IS S99 NC1714.2 +015100 VALUE IS -56. NC1714.2 +015200 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1714.2 +015300 02 MULT6 PICTURE IS 99 VALUE IS NC1714.2 +015400 20. NC1714.2 +015500 01 DIVIDE-DATA. NC1714.2 +015600 02 DIV1 PICTURE IS 9(4)V99 NC1714.2 +015700 VALUE IS 1620.36. NC1714.2 +015800 02 DIV2 PICTURE IS 99V9 NC1714.2 +015900 VALUE IS 44.1. NC1714.2 +016000 02 DIV3 PICTURE IS 9(4)V9 NC1714.2 +016100 VALUE IS 1661.7. NC1714.2 +016200 02 DIV4 PICTURE IS S9V999 NC1714.2 +016300 VALUE IS -9.642. NC1714.2 +016400 02 DIV-02LEVEL-1. NC1714.2 +016500 03 DIV5 PICTURE IS V99 NC1714.2 +016600 VALUE IS .82. NC1714.2 +016700 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1714.2 +016800 03 DIV7 PICTURE IS 9V9 NC1714.2 +016900 VALUE IS 9.6. NC1714.2 +017000 01 DIV-DATA-2. NC1714.2 +017100 02 DIV8 PICTURE IS 99V9. NC1714.2 +017200 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1714.2 +017300 02 DIV10 PICTURE IS V999. NC1714.2 +017400 01 TEST-RESULTS. NC1714.2 +017500 02 FILLER PIC X VALUE SPACE. NC1714.2 +017600 02 FEATURE PIC X(20) VALUE SPACE. NC1714.2 +017700 02 FILLER PIC X VALUE SPACE. NC1714.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. NC1714.2 +017900 02 FILLER PIC X VALUE SPACE. NC1714.2 +018000 02 PAR-NAME. NC1714.2 +018100 03 FILLER PIC X(19) VALUE SPACE. NC1714.2 +018200 03 PARDOT-X PIC X VALUE SPACE. NC1714.2 +018300 03 DOTVALUE PIC 99 VALUE ZERO. NC1714.2 +018400 02 FILLER PIC X(8) VALUE SPACE. NC1714.2 +018500 02 RE-MARK PIC X(61). NC1714.2 +018600 01 TEST-COMPUTED. NC1714.2 +018700 02 FILLER PIC X(30) VALUE SPACE. NC1714.2 +018800 02 FILLER PIC X(17) VALUE NC1714.2 +018900 " COMPUTED=". NC1714.2 +019000 02 COMPUTED-X. NC1714.2 +019100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1714.2 +019200 03 COMPUTED-N REDEFINES COMPUTED-A NC1714.2 +019300 PIC -9(9).9(9). NC1714.2 +019400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1714.2 +019500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1714.2 +019600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1714.2 +019700 03 CM-18V0 REDEFINES COMPUTED-A. NC1714.2 +019800 04 COMPUTED-18V0 PIC -9(18). NC1714.2 +019900 04 FILLER PIC X. NC1714.2 +020000 03 FILLER PIC X(50) VALUE SPACE. NC1714.2 +020100 01 TEST-CORRECT. NC1714.2 +020200 02 FILLER PIC X(30) VALUE SPACE. NC1714.2 +020300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1714.2 +020400 02 CORRECT-X. NC1714.2 +020500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1714.2 +020600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1714.2 +020700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1714.2 +020800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1714.2 +020900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1714.2 +021000 03 CR-18V0 REDEFINES CORRECT-A. NC1714.2 +021100 04 CORRECT-18V0 PIC -9(18). NC1714.2 +021200 04 FILLER PIC X. NC1714.2 +021300 03 FILLER PIC X(2) VALUE SPACE. NC1714.2 +021400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1714.2 +021500 01 CCVS-C-1. NC1714.2 +021600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1714.2 +021700- "SS PARAGRAPH-NAME NC1714.2 +021800- " REMARKS". NC1714.2 +021900 02 FILLER PIC X(20) VALUE SPACE. NC1714.2 +022000 01 CCVS-C-2. NC1714.2 +022100 02 FILLER PIC X VALUE SPACE. NC1714.2 +022200 02 FILLER PIC X(6) VALUE "TESTED". NC1714.2 +022300 02 FILLER PIC X(15) VALUE SPACE. NC1714.2 +022400 02 FILLER PIC X(4) VALUE "FAIL". NC1714.2 +022500 02 FILLER PIC X(94) VALUE SPACE. NC1714.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1714.2 +022700 01 REC-CT PIC 99 VALUE ZERO. NC1714.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1714.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1714.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1714.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1714.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1714.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1714.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1714.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1714.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1714.2 +023700 01 CCVS-H-1. NC1714.2 +023800 02 FILLER PIC X(39) VALUE SPACES. NC1714.2 +023900 02 FILLER PIC X(42) VALUE NC1714.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1714.2 +024100 02 FILLER PIC X(39) VALUE SPACES. NC1714.2 +024200 01 CCVS-H-2A. NC1714.2 +024300 02 FILLER PIC X(40) VALUE SPACE. NC1714.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1714.2 +024500 02 FILLER PIC XXXX VALUE NC1714.2 +024600 "4.2 ". NC1714.2 +024700 02 FILLER PIC X(28) VALUE NC1714.2 +024800 " COPY - NOT FOR DISTRIBUTION". NC1714.2 +024900 02 FILLER PIC X(41) VALUE SPACE. NC1714.2 +025000 NC1714.2 +025100 01 CCVS-H-2B. NC1714.2 +025200 02 FILLER PIC X(15) VALUE NC1714.2 +025300 "TEST RESULT OF ". NC1714.2 +025400 02 TEST-ID PIC X(9). NC1714.2 +025500 02 FILLER PIC X(4) VALUE NC1714.2 +025600 " IN ". NC1714.2 +025700 02 FILLER PIC X(12) VALUE NC1714.2 +025800 " HIGH ". NC1714.2 +025900 02 FILLER PIC X(22) VALUE NC1714.2 +026000 " LEVEL VALIDATION FOR ". NC1714.2 +026100 02 FILLER PIC X(58) VALUE NC1714.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1714.2 +026300 01 CCVS-H-3. NC1714.2 +026400 02 FILLER PIC X(34) VALUE NC1714.2 +026500 " FOR OFFICIAL USE ONLY ". NC1714.2 +026600 02 FILLER PIC X(58) VALUE NC1714.2 +026700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1714.2 +026800 02 FILLER PIC X(28) VALUE NC1714.2 +026900 " COPYRIGHT 1985 ". NC1714.2 +027000 01 CCVS-E-1. NC1714.2 +027100 02 FILLER PIC X(52) VALUE SPACE. NC1714.2 +027200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1714.2 +027300 02 ID-AGAIN PIC X(9). NC1714.2 +027400 02 FILLER PIC X(45) VALUE SPACES. NC1714.2 +027500 01 CCVS-E-2. NC1714.2 +027600 02 FILLER PIC X(31) VALUE SPACE. NC1714.2 +027700 02 FILLER PIC X(21) VALUE SPACE. NC1714.2 +027800 02 CCVS-E-2-2. NC1714.2 +027900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1714.2 +028000 03 FILLER PIC X VALUE SPACE. NC1714.2 +028100 03 ENDER-DESC PIC X(44) VALUE NC1714.2 +028200 "ERRORS ENCOUNTERED". NC1714.2 +028300 01 CCVS-E-3. NC1714.2 +028400 02 FILLER PIC X(22) VALUE NC1714.2 +028500 " FOR OFFICIAL USE ONLY". NC1714.2 +028600 02 FILLER PIC X(12) VALUE SPACE. NC1714.2 +028700 02 FILLER PIC X(58) VALUE NC1714.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1714.2 +028900 02 FILLER PIC X(13) VALUE SPACE. NC1714.2 +029000 02 FILLER PIC X(15) VALUE NC1714.2 +029100 " COPYRIGHT 1985". NC1714.2 +029200 01 CCVS-E-4. NC1714.2 +029300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1714.2 +029400 02 FILLER PIC X(4) VALUE " OF ". NC1714.2 +029500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1714.2 +029600 02 FILLER PIC X(40) VALUE NC1714.2 +029700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1714.2 +029800 01 XXINFO. NC1714.2 +029900 02 FILLER PIC X(19) VALUE NC1714.2 +030000 "*** INFORMATION ***". NC1714.2 +030100 02 INFO-TEXT. NC1714.2 +030200 04 FILLER PIC X(8) VALUE SPACE. NC1714.2 +030300 04 XXCOMPUTED PIC X(20). NC1714.2 +030400 04 FILLER PIC X(5) VALUE SPACE. NC1714.2 +030500 04 XXCORRECT PIC X(20). NC1714.2 +030600 02 INF-ANSI-REFERENCE PIC X(48). NC1714.2 +030700 01 HYPHEN-LINE. NC1714.2 +030800 02 FILLER PIC IS X VALUE IS SPACE. NC1714.2 +030900 02 FILLER PIC IS X(65) VALUE IS "************************NC1714.2 +031000- "*****************************************". NC1714.2 +031100 02 FILLER PIC IS X(54) VALUE IS "************************NC1714.2 +031200- "******************************". NC1714.2 +031300 01 CCVS-PGM-ID PIC X(9) VALUE NC1714.2 +031400 "NC171A". NC1714.2 +031500 PROCEDURE DIVISION. NC1714.2 +031600 CCVS1 SECTION. NC1714.2 +031700 OPEN-FILES. NC1714.2 +031800 OPEN OUTPUT PRINT-FILE. NC1714.2 +031900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1714.2 +032000 MOVE SPACE TO TEST-RESULTS. NC1714.2 +032100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1714.2 +032200 GO TO CCVS1-EXIT. NC1714.2 +032300 CLOSE-FILES. NC1714.2 +032400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1714.2 +032500 TERMINATE-CCVS. NC1714.2 +032600*S EXIT PROGRAM. NC1714.2 +032700*SERMINATE-CALL. NC1714.2 +032800 STOP RUN. NC1714.2 +032900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1714.2 +033000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1714.2 +033100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1714.2 +033200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1714.2 +033300 MOVE "****TEST DELETED****" TO RE-MARK. NC1714.2 +033400 PRINT-DETAIL. NC1714.2 +033500 IF REC-CT NOT EQUAL TO ZERO NC1714.2 +033600 MOVE "." TO PARDOT-X NC1714.2 +033700 MOVE REC-CT TO DOTVALUE. NC1714.2 +033800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1714.2 +033900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1714.2 +034000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1714.2 +034100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1714.2 +034200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1714.2 +034300 MOVE SPACE TO CORRECT-X. NC1714.2 +034400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1714.2 +034500 MOVE SPACE TO RE-MARK. NC1714.2 +034600 HEAD-ROUTINE. NC1714.2 +034700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +034800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +034900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1714.2 +035000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1714.2 +035100 COLUMN-NAMES-ROUTINE. NC1714.2 +035200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +035300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +035400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +035500 END-ROUTINE. NC1714.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1714.2 +035700 END-RTN-EXIT. NC1714.2 +035800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +035900 END-ROUTINE-1. NC1714.2 +036000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1714.2 +036100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1714.2 +036200 ADD PASS-COUNTER TO ERROR-HOLD. NC1714.2 +036300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1714.2 +036400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1714.2 +036500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1714.2 +036600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1714.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1714.2 +036800 END-ROUTINE-12. NC1714.2 +036900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1714.2 +037000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1714.2 +037100 MOVE "NO " TO ERROR-TOTAL NC1714.2 +037200 ELSE NC1714.2 +037300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1714.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1714.2 +037500 PERFORM WRITE-LINE. NC1714.2 +037600 END-ROUTINE-13. NC1714.2 +037700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1714.2 +037800 MOVE "NO " TO ERROR-TOTAL ELSE NC1714.2 +037900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1714.2 +038000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1714.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +038200 IF INSPECT-COUNTER EQUAL TO ZERO NC1714.2 +038300 MOVE "NO " TO ERROR-TOTAL NC1714.2 +038400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1714.2 +038500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1714.2 +038600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +038700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1714.2 +038800 WRITE-LINE. NC1714.2 +038900 ADD 1 TO RECORD-COUNT. NC1714.2 +039000 IF RECORD-COUNT GREATER 42 NC1714.2 +039100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1714.2 +039200 MOVE SPACE TO DUMMY-RECORD NC1714.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1714.2 +039400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1714.2 +039500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1714.2 +039600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1714.2 +039700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1714.2 +039800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1714.2 +039900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1714.2 +040000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1714.2 +040100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1714.2 +040200 MOVE ZERO TO RECORD-COUNT. NC1714.2 +040300 PERFORM WRT-LN. NC1714.2 +040400 WRT-LN. NC1714.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1714.2 +040600 MOVE SPACE TO DUMMY-RECORD. NC1714.2 +040700 BLANK-LINE-PRINT. NC1714.2 +040800 PERFORM WRT-LN. NC1714.2 +040900 FAIL-ROUTINE. NC1714.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE NC1714.2 +041100 GO TO FAIL-ROUTINE-WRITE. NC1714.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1714.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1714.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1714.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1714.2 +041700 GO TO FAIL-ROUTINE-EX. NC1714.2 +041800 FAIL-ROUTINE-WRITE. NC1714.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1714.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1714.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1714.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1714.2 +042300 FAIL-ROUTINE-EX. EXIT. NC1714.2 +042400 BAIL-OUT. NC1714.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1714.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1714.2 +042700 BAIL-OUT-WRITE. NC1714.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1714.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1714.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1714.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1714.2 +043200 BAIL-OUT-EX. EXIT. NC1714.2 +043300 CCVS1-EXIT. NC1714.2 +043400 EXIT. NC1714.2 +043500 SECT-NC171A-001 SECTION. NC1714.2 +043600* NC1714.2 +043700* NC1714.2 +043800 DIV-INIT-F1-1. NC1714.2 +043900 MOVE "DIVIDE INTO" TO FEATURE. NC1714.2 +044000 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +044100 MOVE 1620.36 TO DIV1. NC1714.2 +044200 DIV-TEST-F1-1. NC1714.2 +044300 DIVIDE 64.3 INTO DIV1. NC1714.2 +044400 IF DIV1 EQUAL TO 25.2 NC1714.2 +044500 PERFORM PASS NC1714.2 +044600 ELSE NC1714.2 +044700 GO TO DIV-FAIL-F1-1. NC1714.2 +044800 GO TO DIV-WRITE-F1-1. NC1714.2 +044900 DIV-DELETE-F1-1. NC1714.2 +045000 PERFORM DE-LETE. NC1714.2 +045100 GO TO DIV-WRITE-F1-1. NC1714.2 +045200 DIV-FAIL-F1-1. NC1714.2 +045300 PERFORM FAIL. NC1714.2 +045400 MOVE DIV1 TO COMPUTED-N. NC1714.2 +045500 MOVE +25.2 TO CORRECT-N. NC1714.2 +045600 DIV-WRITE-F1-1. NC1714.2 +045700 MOVE "DIV-TEST-F1-1" TO PAR-NAME. NC1714.2 +045800 PERFORM PRINT-DETAIL. NC1714.2 +045900 DIV-INIT-F1-2. NC1714.2 +046000 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +046100 MOVE 44.1 TO DIV2. NC1714.2 +046200 MOVE 1661.7 TO DIV3. NC1714.2 +046300 DIV-TEST-F1-2. NC1714.2 +046400 DIVIDE DIV2 INTO DIV3 ROUNDED. NC1714.2 +046500 IF DIV3 EQUAL TO 37.7 NC1714.2 +046600 PERFORM PASS NC1714.2 +046700 ELSE NC1714.2 +046800 GO TO DIV-FAIL-F1-2. NC1714.2 +046900 GO TO DIV-WRITE-F1-2. NC1714.2 +047000 DIV-DELETE-F1-2. NC1714.2 +047100 PERFORM DE-LETE. NC1714.2 +047200 GO TO DIV-WRITE-F1-2. NC1714.2 +047300 DIV-FAIL-F1-2. NC1714.2 +047400 PERFORM FAIL. NC1714.2 +047500 MOVE DIV3 TO COMPUTED-N. NC1714.2 +047600 MOVE +37.7 TO CORRECT-N. NC1714.2 +047700 DIV-WRITE-F1-2. NC1714.2 +047800 MOVE "DIV-TEST-F1-2 " TO PAR-NAME. NC1714.2 +047900 PERFORM PRINT-DETAIL. NC1714.2 +048000 DIV-INIT-F1-3. NC1714.2 +048100 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +048200 MOVE -9.642 TO DIV4. NC1714.2 +048300 MOVE .82 TO DIV5. NC1714.2 +048400 DIV-TEST-F1-3-1. NC1714.2 +048500 DIVIDE DIV5 INTO DIV4 ON SIZE ERROR NC1714.2 +048600 MOVE "M" TO XRAY. NC1714.2 +048700 IF XRAY EQUAL TO "M" NC1714.2 +048800 PERFORM PASS NC1714.2 +048900 ELSE NC1714.2 +049000 GO TO DIV-FAIL-F1-3-1. NC1714.2 +049100 GO TO DIV-WRITE-F1-3-1. NC1714.2 +049200 DIV-DELETE-F1-3-1. NC1714.2 +049300 PERFORM DE-LETE. NC1714.2 +049400 GO TO DIV-WRITE-F1-3-1. NC1714.2 +049500 DIV-FAIL-F1-3-1. NC1714.2 +049600 MOVE XRAY TO COMPUTED-X. NC1714.2 +049700 MOVE "M" TO CORRECT-X. NC1714.2 +049800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +049900 PERFORM FAIL. NC1714.2 +050000 DIV-WRITE-F1-3-1. NC1714.2 +050100 MOVE "DIV-TEST-F1-3-1 " TO PAR-NAME. NC1714.2 +050200 PERFORM PRINT-DETAIL. NC1714.2 +050300 DIV-TEST-F1-3-2. NC1714.2 +050400 IF DIV4 EQUAL TO -9.642 NC1714.2 +050500 PERFORM PASS NC1714.2 +050600 ELSE NC1714.2 +050700 GO TO DIV-FAIL-F1-3-2. NC1714.2 +050800 GO TO DIV-WRITE-F1-3-2. NC1714.2 +050900 DIV-DELETE-F1-3-2. NC1714.2 +051000 PERFORM DE-LETE. NC1714.2 +051100 GO TO DIV-WRITE-F1-3-2. NC1714.2 +051200 DIV-FAIL-F1-3-2. NC1714.2 +051300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +051400 PERFORM FAIL. NC1714.2 +051500 MOVE DIV4 TO COMPUTED-N. NC1714.2 +051600 MOVE -9.642 TO CORRECT-N. NC1714.2 +051700 DIV-WRITE-F1-3-2. NC1714.2 +051800 MOVE "DIV-TEST-F1-3-2 " TO PAR-NAME. NC1714.2 +051900 PERFORM PRINT-DETAIL. NC1714.2 +052000 DIV-INIT-F1-4. NC1714.2 +052100 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +052200 MOVE 44.1 TO DIV2. NC1714.2 +052300 MOVE 0 TO DIV6. NC1714.2 +052400 MOVE "A" TO XRAY. NC1714.2 +052500 DIV-TEST-F1-4-0. NC1714.2 +052600 DIVIDE DIV6 INTO DIV2 ON SIZE ERROR NC1714.2 +052700 MOVE "N" TO XRAY. NC1714.2 +052800 DIV-TEST-F1-4-1. NC1714.2 +052900 IF XRAY EQUAL TO "N" NC1714.2 +053000 PERFORM PASS NC1714.2 +053100 ELSE NC1714.2 +053200 GO TO DIV-FAIL-F1-4-1. NC1714.2 +053300 GO TO DIV-WRITE-F1-4-1. NC1714.2 +053400 DIV-DELETE-F1-4-1. NC1714.2 +053500 PERFORM DE-LETE. NC1714.2 +053600 GO TO DIV-WRITE-F1-4-1. NC1714.2 +053700 DIV-FAIL-F1-4-1. NC1714.2 +053800 MOVE XRAY TO COMPUTED-X. NC1714.2 +053900 MOVE "N" TO CORRECT-X. NC1714.2 +054000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +054100 PERFORM FAIL. NC1714.2 +054200 DIV-WRITE-F1-4-1. NC1714.2 +054300 MOVE "DIV-TEST-F1-4-1 " TO PAR-NAME. NC1714.2 +054400 PERFORM PRINT-DETAIL. NC1714.2 +054500 DIV-TEST-F1-4-2. NC1714.2 +054600 IF DIV2 EQUAL TO 44.1 NC1714.2 +054700 PERFORM PASS NC1714.2 +054800 ELSE NC1714.2 +054900 GO TO DIV-FAIL-F1-4-2. NC1714.2 +055000 GO TO DIV-WRITE-F1-4-2. NC1714.2 +055100 DIV-DELETE-F1-4-2. NC1714.2 +055200 PERFORM DE-LETE. NC1714.2 +055300 GO TO DIV-WRITE-F1-4-2. NC1714.2 +055400 DIV-FAIL-F1-4-2. NC1714.2 +055500 PERFORM FAIL. NC1714.2 +055600 MOVE DIV2 TO COMPUTED-N. NC1714.2 +055700 MOVE +44.1000 TO CORRECT-N. NC1714.2 +055800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +055900 DIV-WRITE-F1-4-2. NC1714.2 +056000 MOVE "DIV-TEST-F1-4-2 " TO PAR-NAME. NC1714.2 +056100 PERFORM PRINT-DETAIL. NC1714.2 +056200 DIV-INIT-F1-5. NC1714.2 +056300 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +056400 MOVE 9.6 TO DIV7. NC1714.2 +056500 MOVE "B" TO XRAY. NC1714.2 +056600 DIV-TEST-F1-5-1. NC1714.2 +056700 DIVIDE 0.097 INTO DIV7 ROUNDED ON SIZE ERROR NC1714.2 +056800 MOVE "N" TO XRAY. NC1714.2 +056900 IF XRAY EQUAL TO "N" NC1714.2 +057000 PERFORM PASS NC1714.2 +057100 ELSE NC1714.2 +057200 GO TO DIV-FAIL-F1-5-1. NC1714.2 +057300 GO TO DIV-WRITE-F1-5-1. NC1714.2 +057400 DIV-DELETE-F1-5-1. NC1714.2 +057500 PERFORM DE-LETE. NC1714.2 +057600 GO TO DIV-WRITE-F1-5-1. NC1714.2 +057700 DIV-FAIL-F1-5-1. NC1714.2 +057800 MOVE XRAY TO COMPUTED-X. NC1714.2 +057900 MOVE "N" TO CORRECT-X. NC1714.2 +058000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +058100 PERFORM FAIL. NC1714.2 +058200 DIV-WRITE-F1-5-1. NC1714.2 +058300 MOVE "DIV-TEST-F1-5-1 " TO PAR-NAME. NC1714.2 +058400 PERFORM PRINT-DETAIL. NC1714.2 +058500 DIV-TEST-F1-5-2. NC1714.2 +058600 IF DIV7 NOT EQUAL TO 9.6 NC1714.2 +058700 GO TO DIV-FAIL-F1-5-2. NC1714.2 +058800 PERFORM PASS. NC1714.2 +058900 GO TO DIV-WRITE-F1-5-2. NC1714.2 +059000 DIV-DELETE-F1-5-2. NC1714.2 +059100 PERFORM DE-LETE. NC1714.2 +059200 GO TO DIV-WRITE-F1-5-2. NC1714.2 +059300 DIV-FAIL-F1-5-2. NC1714.2 +059400 PERFORM FAIL. NC1714.2 +059500 MOVE DIV7 TO COMPUTED-N. NC1714.2 +059600 MOVE +9.6 TO CORRECT-N. NC1714.2 +059700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +059800 DIV-WRITE-F1-5-2. NC1714.2 +059900 MOVE "DIV-TEST-F1-5-2 " TO PAR-NAME. NC1714.2 +060000 PERFORM PRINT-DETAIL. NC1714.2 +060100 DIV-INIT-F1-6. NC1714.2 +060200 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +060300 MOVE 99 TO WRK-DS-18V00. NC1714.2 +060400 MOVE 99 TO A99-DS-02V00. NC1714.2 +060500 DIV-TEST-F1-6-0. NC1714.2 +060600 DIVIDE A99-DS-02V00 INTO WRK-DS-18V00. NC1714.2 +060700 DIV-TEST-F1-6-1. NC1714.2 +060800 IF WRK-DS-18V00 EQUAL TO 000000000000000001 NC1714.2 +060900 PERFORM PASS NC1714.2 +061000 GO TO DIV-WRITE-F1-6. NC1714.2 +061100 GO TO DIV-FAIL-F1-6. NC1714.2 +061200 DIV-DELETE-F1-6. NC1714.2 +061300 PERFORM DE-LETE. NC1714.2 +061400 GO TO DIV-WRITE-F1-6. NC1714.2 +061500 DIV-FAIL-F1-6. NC1714.2 +061600 MOVE 000000000000000001 TO CORRECT-18V0. NC1714.2 +061700 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1714.2 +061800 PERFORM FAIL. NC1714.2 +061900 DIV-WRITE-F1-6. NC1714.2 +062000 MOVE "DIV-TEST-F1-6 " TO PAR-NAME. NC1714.2 +062100 PERFORM PRINT-DETAIL. NC1714.2 +062200 DIV-INIT-F1-7. NC1714.2 +062300 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +062400 MOVE 2 TO WRK-DS-12V00. NC1714.2 +062500 DIV-TEST-F1-7-0. NC1714.2 +062600 DIVIDE 4 INTO WRK-DS-12V00 ROUNDED. NC1714.2 +062700 DIV-TEST-F1-7-1. NC1714.2 +062800 IF WRK-DS-12V00 EQUAL TO 000000000001 NC1714.2 +062900 PERFORM PASS NC1714.2 +063000 GO TO DIV-WRITE-F1-7. NC1714.2 +063100 GO TO DIV-FAIL-F1-7. NC1714.2 +063200 DIV-DELETE-F1-7. NC1714.2 +063300 PERFORM DE-LETE. NC1714.2 +063400 GO TO DIV-WRITE-F1-7. NC1714.2 +063500 DIV-FAIL-F1-7. NC1714.2 +063600 MOVE WRK-DS-12V00 TO COMPUTED-18V0. NC1714.2 +063700 MOVE 000000000001 TO CORRECT-18V0. NC1714.2 +063800 PERFORM FAIL. NC1714.2 +063900 DIV-WRITE-F1-7. NC1714.2 +064000 MOVE "DIV-TEST-F1-7 " TO PAR-NAME. NC1714.2 +064100 PERFORM PRINT-DETAIL. NC1714.2 +064200 DIV-INIT-F1-8. NC1714.2 +064300 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +064400 MOVE 1 TO WRK-DS-01V00. NC1714.2 +064500 MOVE "0" TO WRK-XN-00001. NC1714.2 +064600 DIV-TEST-F1-8-0. NC1714.2 +064700 DIVIDE 0.1 INTO WRK-DS-01V00 ON SIZE ERROR NC1714.2 +064800 MOVE "1" TO WRK-XN-00001. NC1714.2 +064900 DIV-TEST-F1-8-1. NC1714.2 +065000 IF WRK-DS-01V00 EQUAL TO 1 NC1714.2 +065100 PERFORM PASS NC1714.2 +065200 GO TO DIV-WRITE-F1-8-1. NC1714.2 +065300 GO TO DIV-FAIL-F1-8-1. NC1714.2 +065400 DIV-DELETE-F1-8-1. NC1714.2 +065500 PERFORM DE-LETE. NC1714.2 +065600 GO TO DIV-WRITE-F1-8-1. NC1714.2 +065700 DIV-FAIL-F1-8-1. NC1714.2 +065800 MOVE 1 TO CORRECT-N. NC1714.2 +065900 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1714.2 +066000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +066100 PERFORM FAIL. NC1714.2 +066200 DIV-WRITE-F1-8-1. NC1714.2 +066300 MOVE "DIV-TEST-F1-8-1 " TO PAR-NAME. NC1714.2 +066400 PERFORM PRINT-DETAIL. NC1714.2 +066500 DIV-TEST-F1-8-2. NC1714.2 +066600 IF WRK-XN-00001 EQUAL TO "1" NC1714.2 +066700 PERFORM PASS NC1714.2 +066800 GO TO DIV-WRITE-F1-8-2. NC1714.2 +066900 MOVE "1" TO CORRECT-A. NC1714.2 +067000 MOVE WRK-XN-00001 TO COMPUTED-A. NC1714.2 +067100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +067200 PERFORM FAIL. NC1714.2 +067300 GO TO DIV-WRITE-F1-8-2. NC1714.2 +067400 DIV-DELETE-F1-8-2. NC1714.2 +067500 PERFORM DE-LETE. NC1714.2 +067600 DIV-WRITE-F1-8-2. NC1714.2 +067700 MOVE "DIV-TEST-F1-8-2 " TO PAR-NAME. NC1714.2 +067800 PERFORM PRINT-DETAIL. NC1714.2 +067900 DIV-INIT-F1-9. NC1714.2 +068000 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +068100 MOVE -.000000001 TO WRK-DS-09V09. NC1714.2 +068200 MOVE "1" TO WRK-XN-00001. NC1714.2 +068300 DIV-TEST-F1-9-0. NC1714.2 +068400 DIVIDE A01ONE-DS-P0801 INTO WRK-DS-09V09 ON SIZE ERROR NC1714.2 +068500 MOVE "0" TO WRK-XN-00001. NC1714.2 +068600 DIV-TEST-F1-9-1. NC1714.2 +068700 IF WRK-DS-18V00-S EQUAL TO -000000001000000000 NC1714.2 +068800 PERFORM PASS NC1714.2 +068900 GO TO DIV-WRITE-F1-9-1. NC1714.2 +069000 GO TO DIV-FAIL-F1-9-1. NC1714.2 +069100 DIV-DELETE-F1-9-1. NC1714.2 +069200 PERFORM DE-LETE. NC1714.2 +069300 GO TO DIV-WRITE-F1-9-1. NC1714.2 +069400 DIV-FAIL-F1-9-1. NC1714.2 +069500 MOVE -000000001000000000 TO CORRECT-18V0. NC1714.2 +069600 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1714.2 +069700 PERFORM FAIL. NC1714.2 +069800 DIV-WRITE-F1-9-1. NC1714.2 +069900 MOVE "DIV-TEST-F1-9-1 " TO PAR-NAME. NC1714.2 +070000 PERFORM PRINT-DETAIL. NC1714.2 +070100 DIV-TEST-F1-9-2. NC1714.2 +070200 IF WRK-XN-00001 EQUAL TO "0" NC1714.2 +070300 MOVE "1" TO CORRECT-A NC1714.2 +070400 MOVE "0" TO COMPUTED-A NC1714.2 +070500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1714.2 +070600 PERFORM FAIL NC1714.2 +070700 GO TO DIV-WRITE-F1-9-2. NC1714.2 +070800 PERFORM PASS. NC1714.2 +070900 GO TO DIV-WRITE-F1-9-2. NC1714.2 +071000 DIV-DELETE-F1-9-2. NC1714.2 +071100 PERFORM DE-LETE. NC1714.2 +071200 DIV-WRITE-F1-9-2. NC1714.2 +071300 MOVE "DIV-TEST-F1-9-2 " TO PAR-NAME. NC1714.2 +071400 PERFORM PRINT-DETAIL. NC1714.2 +071500 DIV-INIT-F1-10. NC1714.2 +071600 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +071700 MOVE ZERO TO WRK-DS-01V00 AZERO-DS-05V05. NC1714.2 +071800 MOVE "0" TO WRK-XN-00001. NC1714.2 +071900 DIV-TEST-F1-10-0. NC1714.2 +072000 DIVIDE AZERO-DS-05V05 INTO WRK-DS-01V00 ROUNDED NC1714.2 +072100 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1714.2 +072200 DIV-TEST-F1-10-1. NC1714.2 +072300 IF WRK-DS-01V00 EQUAL TO 0 NC1714.2 +072400 PERFORM PASS NC1714.2 +072500 GO TO DIV-WRITE-F1-10-1. NC1714.2 +072600 GO TO DIV-FAIL-F1-10-1. NC1714.2 +072700 DIV-DELETE-F1-10-1. NC1714.2 +072800 PERFORM DE-LETE. NC1714.2 +072900 GO TO DIV-WRITE-F1-10-1. NC1714.2 +073000 DIV-FAIL-F1-10-1. NC1714.2 +073100 MOVE 0 TO CORRECT-N. NC1714.2 +073200 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1714.2 +073300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1714.2 +073400 PERFORM FAIL. NC1714.2 +073500 DIV-WRITE-F1-10-1. NC1714.2 +073600 MOVE "DIV-TEST-F1-10-1 " TO PAR-NAME. NC1714.2 +073700 PERFORM PRINT-DETAIL. NC1714.2 +073800 DIV-TEST-F1-10-2. NC1714.2 +073900 IF WRK-XN-00001 EQUAL TO "1" NC1714.2 +074000 PERFORM PASS NC1714.2 +074100 GO TO DIV-WRITE-F1-10-2. NC1714.2 +074200 DIV-FAIL-F1-10-2. NC1714.2 +074300 MOVE "1" TO CORRECT-A. NC1714.2 +074400 MOVE WRK-XN-00001 TO COMPUTED-A. NC1714.2 +074500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1714.2 +074600 PERFORM FAIL. NC1714.2 +074700 GO TO DIV-WRITE-F1-10-2. NC1714.2 +074800 DIV-DELETE-F1-10-2. NC1714.2 +074900 PERFORM DE-LETE. NC1714.2 +075000 DIV-WRITE-F1-10-2. NC1714.2 +075100 MOVE "DIV-TEST-F1-10-2 " TO PAR-NAME. NC1714.2 +075200 PERFORM PRINT-DETAIL. NC1714.2 +075300 DIV-INIT-F1-11. NC1714.2 +075400 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +075500 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +075600 MOVE "1" TO WRK-XN-00001. NC1714.2 +075700 DIV-TEST-F1-11-0. NC1714.2 +075800 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 ROUNDED NC1714.2 +075900 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1714.2 +076000 DIV-TEST-F1-11-1. NC1714.2 +076100 IF WRK-DS-18V00-S EQUAL TO 000000001000000000 NC1714.2 +076200 PERFORM PASS NC1714.2 +076300 GO TO DIV-WRITE-F1-11-1. NC1714.2 +076400 GO TO DIV-FAIL-F1-11-1. NC1714.2 +076500 DIV-DELETE-F1-11-1. NC1714.2 +076600 PERFORM DE-LETE. NC1714.2 +076700 GO TO DIV-WRITE-F1-11-1. NC1714.2 +076800 DIV-FAIL-F1-11-1. NC1714.2 +076900 MOVE 000000001000000000 TO CORRECT-18V0. NC1714.2 +077000 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1714.2 +077100 PERFORM FAIL. NC1714.2 +077200 DIV-WRITE-F1-11-1. NC1714.2 +077300 MOVE "DIV-TEST-F1-11-1 " TO PAR-NAME. NC1714.2 +077400 PERFORM PRINT-DETAIL. NC1714.2 +077500 DIV-TEST-F1-11-2. NC1714.2 +077600 IF WRK-XN-00001 EQUAL TO "0" NC1714.2 +077700 MOVE WRK-XN-00001 TO COMPUTED-A NC1714.2 +077800 MOVE "1" TO CORRECT-A NC1714.2 +077900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1714.2 +078000 PERFORM FAIL NC1714.2 +078100 GO TO DIV-WRITE-F1-11-2. NC1714.2 +078200 PERFORM PASS. NC1714.2 +078300 GO TO DIV-WRITE-F1-11-2. NC1714.2 +078400 DIV-DELETE-F1-11-2. NC1714.2 +078500 PERFORM DE-LETE. NC1714.2 +078600 DIV-WRITE-F1-11-2. NC1714.2 +078700 MOVE "DIV-TEST-F1-11-2 " TO PAR-NAME. NC1714.2 +078800 PERFORM PRINT-DETAIL. NC1714.2 +078900 DIV-INIT-F1-12. NC1714.2 +079000 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +079100 MOVE -99 TO WRK-DS-02V00. NC1714.2 +079200 DIV-TEST-F1-12-0. NC1714.2 +079300 DIVIDE A99-DS-02V00 INTO WRK-DS-02V00. NC1714.2 +079400 DIV-TEST-F1-12-1. NC1714.2 +079500 IF WRK-DS-02V00 EQUAL TO -01 NC1714.2 +079600 PERFORM PASS NC1714.2 +079700 GO TO DIV-WRITE-F1-12. NC1714.2 +079800 DIV-FAIL-F1-12. NC1714.2 +079900 MOVE -01 TO CORRECT-N. NC1714.2 +080000 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1714.2 +080100 PERFORM FAIL. NC1714.2 +080200 GO TO DIV-WRITE-F1-12. NC1714.2 +080300 DIV-DELETE-F1-12. NC1714.2 +080400 PERFORM DE-LETE. NC1714.2 +080500 DIV-WRITE-F1-12. NC1714.2 +080600 MOVE "DIV-TEST-F1-12 " TO PAR-NAME. NC1714.2 +080700 PERFORM PRINT-DETAIL. NC1714.2 +080800 DIV-INIT-F1-13. NC1714.2 +080900 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +081000 MOVE -99.00 TO WRK-CS-02V02. NC1714.2 +081100 DIV-TEST-F1-13-0. NC1714.2 +081200 DIVIDE A990-DS-0201P INTO WRK-CS-02V02. NC1714.2 +081300 DIV-TEST-F1-13-1. NC1714.2 +081400 MOVE WRK-CS-02V02 TO WRK-DS-06V06. NC1714.2 +081500 IF WRK-DS-12V00-S EQUAL TO -000000100000 NC1714.2 +081600 PERFORM PASS NC1714.2 +081700 GO TO DIV-WRITE-F1-13. NC1714.2 +081800 MOVE -000000.100000 TO CORRECT-N. NC1714.2 +081900 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1714.2 +082000 PERFORM FAIL. NC1714.2 +082100 GO TO DIV-WRITE-F1-13. NC1714.2 +082200 DIV-DELETE-F1-13. NC1714.2 +082300 PERFORM DE-LETE. NC1714.2 +082400 DIV-WRITE-F1-13. NC1714.2 +082500 MOVE "DIV-TEST-F1-13 " TO PAR-NAME. NC1714.2 +082600 PERFORM PRINT-DETAIL. NC1714.2 +082700* NC1714.2 +082800* NC1714.2 +082900 DIV-INIT-F1-14. NC1714.2 +083000* ==--> NEW SIZE ERROR TESTS <--== NC1714.2 +083100 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1714.2 +083200 MOVE "DIV-TEST-F1-14 " TO PAR-NAME NC1714.2 +083300 MOVE "Z" TO XRAY. NC1714.2 +083400 MOVE 1 TO REC-CT. NC1714.2 +083500 MOVE 1620.36 TO DIV1. NC1714.2 +083600 MOVE 44.1 TO DIV2. NC1714.2 +083700 DIV-TEST-F1-14-0. NC1714.2 +083800 DIVIDE DIV2 INTO DIV1 NC1714.2 +083900 NOT ON SIZE ERROR NC1714.2 +084000 MOVE "N" TO XRAY. NC1714.2 +084100 GO TO DIV-TEST-F1-14-1. NC1714.2 +084200 DIV-DELETE-F1-14-1. NC1714.2 +084300 PERFORM DE-LETE. NC1714.2 +084400 PERFORM PRINT-DETAIL. NC1714.2 +084500 GO TO DIV-INIT-F1-15. NC1714.2 +084600 DIV-TEST-F1-14-1. NC1714.2 +084700 MOVE "DIV-TEST-F1-14-1 " TO PAR-NAME. NC1714.2 +084800 IF DIV1 = 36.74 NC1714.2 +084900 PERFORM PASS NC1714.2 +085000 PERFORM PRINT-DETAIL NC1714.2 +085100 ELSE NC1714.2 +085200 MOVE DIV1 TO COMPUTED-N NC1714.2 +085300 MOVE 36.74 TO CORRECT-N NC1714.2 +085400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +085500 PERFORM FAIL NC1714.2 +085600 PERFORM PRINT-DETAIL. NC1714.2 +085700 ADD 1 TO REC-CT. NC1714.2 +085800 DIV-TEST-F1-14-2. NC1714.2 +085900 MOVE "DIV-TEST-F1-14-2 " TO PAR-NAME. NC1714.2 +086000 IF XRAY = "N" NC1714.2 +086100 PERFORM PASS NC1714.2 +086200 PERFORM PRINT-DETAIL NC1714.2 +086300 ELSE NC1714.2 +086400 MOVE XRAY TO COMPUTED-X NC1714.2 +086500 MOVE "N" TO CORRECT-X NC1714.2 +086600 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1714.2 +086700 TO RE-MARK NC1714.2 +086800 PERFORM FAIL NC1714.2 +086900 PERFORM PRINT-DETAIL. NC1714.2 +087000* NC1714.2 +087100* NC1714.2 +087200 DIV-INIT-F1-15. NC1714.2 +087300* ==--> NEW SIZE ERROR TESTS <--== NC1714.2 +087400 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1714.2 +087500 MOVE "DIV-TEST-F1-15 " TO PAR-NAME NC1714.2 +087600 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +087700 MOVE "1" TO WRK-XN-00001. NC1714.2 +087800 MOVE 1 TO REC-CT. NC1714.2 +087900 DIV-TEST-F1-15-0. NC1714.2 +088000 DIVIDE A18ONES-DS-09V09 NC1714.2 +088100 INTO WRK-DS-09V09 ROUNDED NC1714.2 +088200 NOT ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1714.2 +088300 GO TO DIV-TEST-F1-15-1. NC1714.2 +088400 DIV-DELETE-F1-15-1. NC1714.2 +088500 PERFORM DE-LETE. NC1714.2 +088600 PERFORM PRINT-DETAIL. NC1714.2 +088700 GO TO DIV-INIT-F1-16. NC1714.2 +088800 DIV-TEST-F1-15-1. NC1714.2 +088900 MOVE "DIV-TEST-F1-15-1 " TO PAR-NAME. NC1714.2 +089000 IF WRK-XN-00001 = "0" NC1714.2 +089100 PERFORM PASS NC1714.2 +089200 PERFORM PRINT-DETAIL NC1714.2 +089300 ELSE NC1714.2 +089400 MOVE "0" TO CORRECT-X NC1714.2 +089500 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +089600 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +089700 TO RE-MARK NC1714.2 +089800 PERFORM FAIL NC1714.2 +089900 PERFORM PRINT-DETAIL. NC1714.2 +090000 ADD 1 TO REC-CT. NC1714.2 +090100 DIV-TEST-F1-15-2. NC1714.2 +090200 MOVE "DIV-TEST-F1-15-2 " TO PAR-NAME. NC1714.2 +090300 IF WRK-DS-09V09 = 1 NC1714.2 +090400 PERFORM PASS NC1714.2 +090500 PERFORM PRINT-DETAIL NC1714.2 +090600 ELSE NC1714.2 +090700 MOVE 1 TO CORRECT-N NC1714.2 +090800 MOVE WRK-DS-09V09 TO COMPUTED-18V0 NC1714.2 +090900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1714.2 +091000 TO RE-MARK NC1714.2 +091100 PERFORM FAIL NC1714.2 +091200 PERFORM PRINT-DETAIL. NC1714.2 +091300* NC1714.2 +091400* NC1714.2 +091500 DIV-INIT-F1-16. NC1714.2 +091600* ==--> NEW SIZE ERROR TESTS <--== NC1714.2 +091700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1714.2 +091800 MOVE "DIV-TEST-F1-16 " TO PAR-NAME. NC1714.2 +091900 MOVE "Z" TO XRAY. NC1714.2 +092000 MOVE 1620.36 TO DIV1. NC1714.2 +092100 MOVE 44.1 TO DIV2. NC1714.2 +092200 MOVE 1 TO REC-CT. NC1714.2 +092300 DIV-TEST-F1-16-0. NC1714.2 +092400 DIVIDE DIV2 INTO DIV1 NC1714.2 +092500 ON SIZE ERROR NC1714.2 +092600 MOVE "E" TO XRAY NC1714.2 +092700 NOT ON SIZE ERROR NC1714.2 +092800 MOVE "N" TO XRAY. NC1714.2 +092900 GO TO DIV-TEST-F1-16-1. NC1714.2 +093000 DIV-DELETE-F1-16-1. NC1714.2 +093100 PERFORM DE-LETE. NC1714.2 +093200 PERFORM PRINT-DETAIL. NC1714.2 +093300 GO TO DIV-INIT-F1-17. NC1714.2 +093400 DIV-TEST-F1-16-1. NC1714.2 +093500 MOVE "DIV-TEST-F1-16-1 " TO PAR-NAME. NC1714.2 +093600 IF XRAY = "N" NC1714.2 +093700 PERFORM PASS NC1714.2 +093800 PERFORM PRINT-DETAIL NC1714.2 +093900 ELSE NC1714.2 +094000 MOVE "N" TO CORRECT-X NC1714.2 +094100 MOVE XRAY TO COMPUTED-X NC1714.2 +094200 MOVE "NOT SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK NC1714.2 +094300 PERFORM FAIL NC1714.2 +094400 PERFORM PRINT-DETAIL. NC1714.2 +094500 ADD 1 TO REC-CT. NC1714.2 +094600 DIV-TEST-F1-16-2. NC1714.2 +094700 MOVE "DIV-TEST-F1-16-2" TO PAR-NAME. NC1714.2 +094800 IF DIV1 = 36.74 NC1714.2 +094900 PERFORM PASS NC1714.2 +095000 PERFORM PRINT-DETAIL NC1714.2 +095100 ELSE NC1714.2 +095200 ADD 1 TO REC-CT NC1714.2 +095300 MOVE DIV1 TO COMPUTED-N NC1714.2 +095400 MOVE 36.74 TO CORRECT-N NC1714.2 +095500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +095600 PERFORM FAIL NC1714.2 +095700 PERFORM PRINT-DETAIL. NC1714.2 +095800* NC1714.2 +095900* NC1714.2 +096000 DIV-INIT-F1-17. NC1714.2 +096100* ==--> NEW SIZE ERROR TESTS <--== NC1714.2 +096200 MOVE "DIV-TEST-F1-17 " TO PAR-NAME NC1714.2 +096300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1714.2 +096400 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +096500 MOVE "0" TO WRK-XN-00001. NC1714.2 +096600 MOVE 1 TO REC-CT. NC1714.2 +096700 DIV-TEST-F1-17-0. NC1714.2 +096800 DIVIDE A18ONES-DS-09V09 NC1714.2 +096900 INTO WRK-DS-09V09 ROUNDED NC1714.2 +097000 ON SIZE ERROR NC1714.2 +097100 MOVE "1" TO WRK-XN-00001 NC1714.2 +097200 NOT ON SIZE ERROR NC1714.2 +097300 MOVE "2" TO WRK-XN-00001. NC1714.2 +097400 GO TO DIV-TEST-F1-17-1. NC1714.2 +097500 DIV-DELETE-F1-17-1. NC1714.2 +097600 PERFORM DE-LETE. NC1714.2 +097700 PERFORM PRINT-DETAIL. NC1714.2 +097800 GO TO DIV-INIT-F1-18. NC1714.2 +097900 DIV-TEST-F1-17-1. NC1714.2 +098000 MOVE "DIV-TEST-F1-17-1 " TO PAR-NAME. NC1714.2 +098100 IF WRK-XN-00001 = "2" NC1714.2 +098200 PERFORM PASS NC1714.2 +098300 PERFORM PRINT-DETAIL NC1714.2 +098400 ELSE NC1714.2 +098500 MOVE "2" TO CORRECT-X NC1714.2 +098600 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +098700 PERFORM FAIL NC1714.2 +098800 PERFORM PRINT-DETAIL. NC1714.2 +098900 ADD 1 TO REC-CT. NC1714.2 +099000 DIV-TEST-F1-17-2. NC1714.2 +099100 MOVE "DIV-TEST-F1-17-2 " TO PAR-NAME. NC1714.2 +099200 IF WRK-DS-09V09 = 1 NC1714.2 +099300 PERFORM PASS NC1714.2 +099400 PERFORM PRINT-DETAIL NC1714.2 +099500 ELSE NC1714.2 +099600 MOVE 1 TO CORRECT-18V0 NC1714.2 +099700 MOVE WRK-DS-09V09 TO COMPUTED-18V0 NC1714.2 +099800 PERFORM FAIL NC1714.2 +099900 PERFORM PRINT-DETAIL. NC1714.2 +100000* NC1714.2 +100100* NC1714.2 +100200 DIV-INIT-F1-18. NC1714.2 +100300* ==--> MULTIPLE RESULT FIELDS <--== NC1714.2 +100400 MOVE "V1-81 6.11.4 GR1" TO ANSI-REFERENCE. NC1714.2 +100500 MOVE "DIV-TEST-F1-18" TO PAR-NAME. NC1714.2 +100600 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +100700 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +100800 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +100900 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +101000 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +101100 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +101200 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +101300 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +101400 MOVE 1 TO REC-CT. NC1714.2 +101500 DIV-TEST-F1-18-0. NC1714.2 +101600 DIVIDE WRK-DU-1V3-1 NC1714.2 +101700 INTO WRK-DU-2V2-1 NC1714.2 +101800 WRK-DU-2V2-2 ROUNDED NC1714.2 +101900 WRK-DU-2V2-3 NC1714.2 +102000 WRK-DU-2V2-4 ROUNDED NC1714.2 +102100 WRK-DU-1V3-2 NC1714.2 +102200 WRK-DU-2V2-5 NC1714.2 +102300 WRK-DU-2V1-1 ROUNDED. NC1714.2 +102400 GO TO DIV-TEST-F1-18-1. NC1714.2 +102500 DIV-DELETE-F1-18. NC1714.2 +102600 PERFORM DE-LETE. NC1714.2 +102700 PERFORM PRINT-DETAIL. NC1714.2 +102800 GO TO DIV-INIT-F1-19. NC1714.2 +102900 DIV-TEST-F1-18-1. NC1714.2 +103000 IF WRK-DU-2V2-1 = 15.42 NC1714.2 +103100 PERFORM PASS NC1714.2 +103200 PERFORM PRINT-DETAIL NC1714.2 +103300 ELSE NC1714.2 +103400 PERFORM FAIL NC1714.2 +103500 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +103600 MOVE 15.42 TO CORRECT-N NC1714.2 +103700 PERFORM PRINT-DETAIL. NC1714.2 +103800 ADD 1 TO REC-CT. NC1714.2 +103900 DIV-TEST-F1-18-2. NC1714.2 +104000 IF WRK-DU-2V2-2 = 60.83 NC1714.2 +104100 PERFORM PASS NC1714.2 +104200 PERFORM PRINT-DETAIL NC1714.2 +104300 ELSE NC1714.2 +104400 PERFORM FAIL NC1714.2 +104500 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +104600 MOVE 60.83 TO CORRECT-N NC1714.2 +104700 PERFORM PRINT-DETAIL. NC1714.2 +104800 ADD 1 TO REC-CT. NC1714.2 +104900 DIV-TEST-F1-18-3. NC1714.2 +105000 IF WRK-DU-2V2-3 = 60.92 NC1714.2 +105100 PERFORM PASS NC1714.2 +105200 PERFORM PRINT-DETAIL NC1714.2 +105300 ELSE NC1714.2 +105400 PERFORM FAIL NC1714.2 +105500 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +105600 MOVE 60.92 TO CORRECT-N NC1714.2 +105700 PERFORM PRINT-DETAIL. NC1714.2 +105800 ADD 1 TO REC-CT. NC1714.2 +105900 DIV-TEST-F1-18-4. NC1714.2 +106000 IF WRK-DU-2V2-4 = 60.93 NC1714.2 +106100 PERFORM PASS NC1714.2 +106200 PERFORM PRINT-DETAIL NC1714.2 +106300 ELSE NC1714.2 +106400 PERFORM FAIL NC1714.2 +106500 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +106600 MOVE 60.93 TO CORRECT-N NC1714.2 +106700 PERFORM PRINT-DETAIL. NC1714.2 +106800 ADD 1 TO REC-CT. NC1714.2 +106900 DIV-TEST-F1-18-5. NC1714.2 +107000 IF WRK-DU-1V3-2 = 1.000 NC1714.2 +107100 PERFORM PASS NC1714.2 +107200 PERFORM PRINT-DETAIL NC1714.2 +107300 ELSE NC1714.2 +107400 PERFORM FAIL NC1714.2 +107500 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +107600 MOVE 1.000 TO CORRECT-N NC1714.2 +107700 PERFORM PRINT-DETAIL. NC1714.2 +107800 ADD 1 TO REC-CT. NC1714.2 +107900 DIV-TEST-F1-18-6. NC1714.2 +108000 IF WRK-DU-2V2-5 = 09.99 NC1714.2 +108100 PERFORM PASS NC1714.2 +108200 PERFORM PRINT-DETAIL NC1714.2 +108300 ELSE NC1714.2 +108400 PERFORM FAIL NC1714.2 +108500 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +108600 MOVE 09.99 TO CORRECT-N NC1714.2 +108700 PERFORM PRINT-DETAIL. NC1714.2 +108800 ADD 1 TO REC-CT. NC1714.2 +108900 DIV-TEST-F1-18-7. NC1714.2 +109000 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +109100 PERFORM PASS NC1714.2 +109200 PERFORM PRINT-DETAIL NC1714.2 +109300 ELSE NC1714.2 +109400 PERFORM FAIL NC1714.2 +109500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +109600 MOVE 10.00 TO CORRECT-N NC1714.2 +109700 PERFORM PRINT-DETAIL. NC1714.2 +109800* NC1714.2 +109900* NC1714.2 +110000 DIV-INIT-F1-19. NC1714.2 +110100* ==--> SIZE ERROR CONDITION <--== NC1714.2 +110200* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +110300 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +110400 MOVE "DIV-TEST-F1-19" TO PAR-NAME. NC1714.2 +110500 MOVE .01 TO WRK-DU-0V2-1. NC1714.2 +110600 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +110700 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +110800 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +110900 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +111000 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +111100 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +111200 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +111300 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +111400 MOVE "0" TO WRK-XN-00001. NC1714.2 +111500 MOVE 1 TO REC-CT. NC1714.2 +111600 DIV-TEST-F1-19-0. NC1714.2 +111700 DIVIDE WRK-DU-0V2-1 NC1714.2 +111800 INTO WRK-DU-2V2-1 NC1714.2 +111900 WRK-DU-2V2-2 NC1714.2 +112000 WRK-DU-2V2-3 NC1714.2 +112100 WRK-DU-2V2-4 NC1714.2 +112200 WRK-DU-1V3-2 NC1714.2 +112300 WRK-DU-2V2-5 NC1714.2 +112400 WRK-DU-2V1-1 NC1714.2 +112500 ON SIZE ERROR NC1714.2 +112600 MOVE "1" TO WRK-XN-00001. NC1714.2 +112700 GO TO DIV-TEST-F1-19-1. NC1714.2 +112800 DIV-DELETE-F1-19. NC1714.2 +112900 PERFORM DE-LETE. NC1714.2 +113000 PERFORM PRINT-DETAIL. NC1714.2 +113100 GO TO DIV-INIT-F1-20. NC1714.2 +113200 DIV-TEST-F1-19-1. NC1714.2 +113300 IF WRK-DU-2V2-1 = 15.44 NC1714.2 +113400 PERFORM PASS NC1714.2 +113500 PERFORM PRINT-DETAIL NC1714.2 +113600 ELSE NC1714.2 +113700 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +113800 PERFORM FAIL NC1714.2 +113900 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +114000 MOVE 15.44 TO CORRECT-N NC1714.2 +114100 PERFORM PRINT-DETAIL. NC1714.2 +114200 ADD 1 TO REC-CT. NC1714.2 +114300 DIV-TEST-F1-19-2. NC1714.2 +114400 IF WRK-DU-2V2-2 = 60.89 NC1714.2 +114500 PERFORM PASS NC1714.2 +114600 PERFORM PRINT-DETAIL NC1714.2 +114700 ELSE NC1714.2 +114800 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +114900 PERFORM FAIL NC1714.2 +115000 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +115100 MOVE 60.89 TO CORRECT-N NC1714.2 +115200 PERFORM PRINT-DETAIL. NC1714.2 +115300 ADD 1 TO REC-CT. NC1714.2 +115400 DIV-TEST-F1-19-3. NC1714.2 +115500 IF WRK-DU-2V2-3 = 60.99 NC1714.2 +115600 PERFORM PASS NC1714.2 +115700 PERFORM PRINT-DETAIL NC1714.2 +115800 ELSE NC1714.2 +115900 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +116000 PERFORM FAIL NC1714.2 +116100 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +116200 MOVE 60.92 TO CORRECT-N NC1714.2 +116300 PERFORM PRINT-DETAIL. NC1714.2 +116400 ADD 1 TO REC-CT. NC1714.2 +116500 DIV-TEST-F1-19-4. NC1714.2 +116600 IF WRK-DU-2V2-4 = 60.99 NC1714.2 +116700 PERFORM PASS NC1714.2 +116800 PERFORM PRINT-DETAIL NC1714.2 +116900 ELSE NC1714.2 +117000 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +117100 PERFORM FAIL NC1714.2 +117200 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +117300 MOVE 60.99 TO CORRECT-N NC1714.2 +117400 PERFORM PRINT-DETAIL. NC1714.2 +117500 ADD 1 TO REC-CT. NC1714.2 +117600 DIV-TEST-F1-19-5. NC1714.2 +117700 IF WRK-DU-1V3-2 = 1.001 NC1714.2 +117800 PERFORM PASS NC1714.2 +117900 PERFORM PRINT-DETAIL NC1714.2 +118000 ELSE NC1714.2 +118100 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +118200 PERFORM FAIL NC1714.2 +118300 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +118400 MOVE 1.001 TO CORRECT-N NC1714.2 +118500 PERFORM PRINT-DETAIL. NC1714.2 +118600 ADD 1 TO REC-CT. NC1714.2 +118700 DIV-TEST-F1-19-6. NC1714.2 +118800 IF WRK-DU-2V2-5 = 10.00 NC1714.2 +118900 PERFORM PASS NC1714.2 +119000 PERFORM PRINT-DETAIL NC1714.2 +119100 ELSE NC1714.2 +119200 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +119300 PERFORM FAIL NC1714.2 +119400 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +119500 MOVE 09.99 TO CORRECT-N NC1714.2 +119600 PERFORM PRINT-DETAIL. NC1714.2 +119700 ADD 1 TO REC-CT. NC1714.2 +119800 DIV-TEST-F1-19-7. NC1714.2 +119900 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +120000 PERFORM PASS NC1714.2 +120100 PERFORM PRINT-DETAIL NC1714.2 +120200 ELSE NC1714.2 +120300 MOVE "NOT AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +120400 PERFORM FAIL NC1714.2 +120500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +120600 MOVE 10.0 TO CORRECT-N NC1714.2 +120700 PERFORM PRINT-DETAIL. NC1714.2 +120800 ADD 1 TO REC-CT. NC1714.2 +120900 DIV-TEST-F1-19-8. NC1714.2 +121000 IF WRK-XN-00001 = "1" NC1714.2 +121100 PERFORM PASS NC1714.2 +121200 PERFORM PRINT-DETAIL NC1714.2 +121300 ELSE NC1714.2 +121400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1714.2 +121500 PERFORM FAIL NC1714.2 +121600 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +121700 MOVE "1" TO CORRECT-X NC1714.2 +121800 PERFORM PRINT-DETAIL. NC1714.2 +121900* NC1714.2 +122000* NC1714.2 +122100 DIV-INIT-F1-20. NC1714.2 +122200* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +122300* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +122400 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +122500 MOVE "DIV-TEST-F1-20" TO PAR-NAME. NC1714.2 +122600 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +122700 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +122800 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +122900 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +123000 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +123100 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +123200 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +123300 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +123400 MOVE "0" TO WRK-XN-00001. NC1714.2 +123500 MOVE 1 TO REC-CT. NC1714.2 +123600 DIV-TEST-F1-20-0. NC1714.2 +123700 DIVIDE WRK-DU-1V3-1 NC1714.2 +123800 INTO WRK-DU-2V2-1 NC1714.2 +123900 WRK-DU-2V2-2 ROUNDED NC1714.2 +124000 WRK-DU-2V2-3 NC1714.2 +124100 WRK-DU-2V2-4 ROUNDED NC1714.2 +124200 WRK-DU-1V3-2 NC1714.2 +124300 WRK-DU-2V2-5 NC1714.2 +124400 WRK-DU-2V1-1 ROUNDED NC1714.2 +124500 ON SIZE ERROR NC1714.2 +124600 MOVE "1" TO WRK-XN-00001. NC1714.2 +124700 GO TO DIV-TEST-F1-20-1. NC1714.2 +124800 DIV-DELETE-F1-20. NC1714.2 +124900 PERFORM DE-LETE. NC1714.2 +125000 PERFORM PRINT-DETAIL. NC1714.2 +125100 GO TO DIV-INIT-F1-21. NC1714.2 +125200 DIV-TEST-F1-20-1. NC1714.2 +125300 IF WRK-DU-2V2-1 = 15.42 NC1714.2 +125400 PERFORM PASS NC1714.2 +125500 PERFORM PRINT-DETAIL NC1714.2 +125600 ELSE NC1714.2 +125700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +125800 PERFORM FAIL NC1714.2 +125900 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +126000 MOVE 15.42 TO CORRECT-N NC1714.2 +126100 PERFORM PRINT-DETAIL. NC1714.2 +126200 ADD 1 TO REC-CT. NC1714.2 +126300 DIV-TEST-F1-20-2. NC1714.2 +126400 IF WRK-DU-2V2-2 = 60.83 NC1714.2 +126500 PERFORM PASS NC1714.2 +126600 PERFORM PRINT-DETAIL NC1714.2 +126700 ELSE NC1714.2 +126800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +126900 PERFORM FAIL NC1714.2 +127000 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +127100 MOVE 60.83 TO CORRECT-N NC1714.2 +127200 PERFORM PRINT-DETAIL. NC1714.2 +127300 ADD 1 TO REC-CT. NC1714.2 +127400 DIV-TEST-F1-20-3. NC1714.2 +127500 IF WRK-DU-2V2-3 = 60.92 NC1714.2 +127600 PERFORM PASS NC1714.2 +127700 PERFORM PRINT-DETAIL NC1714.2 +127800 ELSE NC1714.2 +127900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +128000 PERFORM FAIL NC1714.2 +128100 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +128200 MOVE 60.92 TO CORRECT-N NC1714.2 +128300 PERFORM PRINT-DETAIL. NC1714.2 +128400 ADD 1 TO REC-CT. NC1714.2 +128500 DIV-TEST-F1-20-4. NC1714.2 +128600 IF WRK-DU-2V2-4 = 60.93 NC1714.2 +128700 PERFORM PASS NC1714.2 +128800 PERFORM PRINT-DETAIL NC1714.2 +128900 ELSE NC1714.2 +129000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +129100 PERFORM FAIL NC1714.2 +129200 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +129300 MOVE 60.93 TO CORRECT-N NC1714.2 +129400 PERFORM PRINT-DETAIL. NC1714.2 +129500 ADD 1 TO REC-CT. NC1714.2 +129600 DIV-TEST-F1-20-5. NC1714.2 +129700 IF WRK-DU-1V3-2 = 1.000 NC1714.2 +129800 PERFORM PASS NC1714.2 +129900 PERFORM PRINT-DETAIL NC1714.2 +130000 ELSE NC1714.2 +130100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +130200 PERFORM FAIL NC1714.2 +130300 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +130400 MOVE 1.000 TO CORRECT-N NC1714.2 +130500 PERFORM PRINT-DETAIL. NC1714.2 +130600 ADD 1 TO REC-CT. NC1714.2 +130700 DIV-TEST-F1-20-6. NC1714.2 +130800 IF WRK-DU-2V2-5 = 09.99 NC1714.2 +130900 PERFORM PASS NC1714.2 +131000 PERFORM PRINT-DETAIL NC1714.2 +131100 ELSE NC1714.2 +131200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +131300 PERFORM FAIL NC1714.2 +131400 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +131500 MOVE 09.99 TO CORRECT-N NC1714.2 +131600 PERFORM PRINT-DETAIL. NC1714.2 +131700 ADD 1 TO REC-CT. NC1714.2 +131800 DIV-TEST-F1-20-7. NC1714.2 +131900 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +132000 PERFORM PASS NC1714.2 +132100 PERFORM PRINT-DETAIL NC1714.2 +132200 ELSE NC1714.2 +132300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +132400 PERFORM FAIL NC1714.2 +132500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +132600 MOVE 10.00 TO CORRECT-N NC1714.2 +132700 PERFORM PRINT-DETAIL. NC1714.2 +132800 ADD 1 TO REC-CT. NC1714.2 +132900 DIV-TEST-F1-20-8. NC1714.2 +133000 IF WRK-XN-00001 = "0" NC1714.2 +133100 PERFORM PASS NC1714.2 +133200 PERFORM PRINT-DETAIL NC1714.2 +133300 ELSE NC1714.2 +133400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +133500 TO RE-MARK NC1714.2 +133600 PERFORM FAIL NC1714.2 +133700 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +133800 MOVE "0" TO CORRECT-X NC1714.2 +133900 PERFORM PRINT-DETAIL. NC1714.2 +134000* NC1714.2 +134100* NC1714.2 +134200 DIV-INIT-F1-21. NC1714.2 +134300* ==--> SIZE ERROR CONDITION <--== NC1714.2 +134400* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +134500 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +134600 MOVE "DIV-TEST-F1-21" TO PAR-NAME. NC1714.2 +134700 MOVE .01 TO WRK-DU-0V2-1. NC1714.2 +134800 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +134900 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +135000 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +135100 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +135200 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +135300 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +135400 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +135500 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +135600 MOVE "0" TO WRK-XN-00001. NC1714.2 +135700 MOVE 1 TO REC-CT. NC1714.2 +135800 DIV-TEST-F1-21-0. NC1714.2 +135900 DIVIDE WRK-DU-0V2-1 NC1714.2 +136000 INTO WRK-DU-2V2-1 NC1714.2 +136100 WRK-DU-2V2-2 NC1714.2 +136200 WRK-DU-2V2-3 NC1714.2 +136300 WRK-DU-2V2-4 NC1714.2 +136400 WRK-DU-1V3-2 NC1714.2 +136500 WRK-DU-2V2-5 NC1714.2 +136600 WRK-DU-2V1-1 NC1714.2 +136700 NOT ON SIZE ERROR NC1714.2 +136800 MOVE "1" TO WRK-XN-00001. NC1714.2 +136900 GO TO DIV-TEST-F1-21-1. NC1714.2 +137000 DIV-DELETE-F1-21. NC1714.2 +137100 PERFORM DE-LETE. NC1714.2 +137200 PERFORM PRINT-DETAIL. NC1714.2 +137300 GO TO DIV-INIT-F1-22. NC1714.2 +137400 DIV-TEST-F1-21-1. NC1714.2 +137500 IF WRK-DU-2V2-1 = 15.44 NC1714.2 +137600 PERFORM PASS NC1714.2 +137700 PERFORM PRINT-DETAIL NC1714.2 +137800 ELSE NC1714.2 +137900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +138000 PERFORM FAIL NC1714.2 +138100 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +138200 MOVE 15.44 TO CORRECT-N NC1714.2 +138300 PERFORM PRINT-DETAIL. NC1714.2 +138400 ADD 1 TO REC-CT. NC1714.2 +138500 DIV-TEST-F1-21-2. NC1714.2 +138600 IF WRK-DU-2V2-2 = 60.89 NC1714.2 +138700 PERFORM PASS NC1714.2 +138800 PERFORM PRINT-DETAIL NC1714.2 +138900 ELSE NC1714.2 +139000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +139100 PERFORM FAIL NC1714.2 +139200 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +139300 MOVE 60.89 TO CORRECT-N NC1714.2 +139400 PERFORM PRINT-DETAIL. NC1714.2 +139500 ADD 1 TO REC-CT. NC1714.2 +139600 DIV-TEST-F1-21-3. NC1714.2 +139700 IF WRK-DU-2V2-3 = 60.99 NC1714.2 +139800 PERFORM PASS NC1714.2 +139900 PERFORM PRINT-DETAIL NC1714.2 +140000 ELSE NC1714.2 +140100 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +140200 PERFORM FAIL NC1714.2 +140300 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +140400 MOVE 60.99 TO CORRECT-N NC1714.2 +140500 PERFORM PRINT-DETAIL. NC1714.2 +140600 ADD 1 TO REC-CT. NC1714.2 +140700 DIV-TEST-F1-21-4. NC1714.2 +140800 IF WRK-DU-2V2-4 = 60.99 NC1714.2 +140900 PERFORM PASS NC1714.2 +141000 PERFORM PRINT-DETAIL NC1714.2 +141100 ELSE NC1714.2 +141200 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +141300 PERFORM FAIL NC1714.2 +141400 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +141500 MOVE 60.99 TO CORRECT-N NC1714.2 +141600 PERFORM PRINT-DETAIL. NC1714.2 +141700 ADD 1 TO REC-CT. NC1714.2 +141800 DIV-TEST-F1-21-5. NC1714.2 +141900 IF WRK-DU-1V3-2 = 1.001 NC1714.2 +142000 PERFORM PASS NC1714.2 +142100 PERFORM PRINT-DETAIL NC1714.2 +142200 ELSE NC1714.2 +142300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +142400 PERFORM FAIL NC1714.2 +142500 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +142600 MOVE 1.001 TO CORRECT-N NC1714.2 +142700 PERFORM PRINT-DETAIL. NC1714.2 +142800 ADD 1 TO REC-CT. NC1714.2 +142900 DIV-TEST-F1-21-6. NC1714.2 +143000 IF WRK-DU-2V2-5 = 10.00 NC1714.2 +143100 PERFORM PASS NC1714.2 +143200 PERFORM PRINT-DETAIL NC1714.2 +143300 ELSE NC1714.2 +143400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +143500 PERFORM FAIL NC1714.2 +143600 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +143700 MOVE 10.00 TO CORRECT-N NC1714.2 +143800 PERFORM PRINT-DETAIL. NC1714.2 +143900 ADD 1 TO REC-CT. NC1714.2 +144000 DIV-TEST-F1-21-7. NC1714.2 +144100 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +144200 PERFORM PASS NC1714.2 +144300 PERFORM PRINT-DETAIL NC1714.2 +144400 ELSE NC1714.2 +144500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +144600 PERFORM FAIL NC1714.2 +144700 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +144800 MOVE 10.0 TO CORRECT-N NC1714.2 +144900 PERFORM PRINT-DETAIL. NC1714.2 +145000 ADD 1 TO REC-CT. NC1714.2 +145100 DIV-TEST-F1-21-8. NC1714.2 +145200 IF WRK-XN-00001 = "0" NC1714.2 +145300 PERFORM PASS NC1714.2 +145400 PERFORM PRINT-DETAIL NC1714.2 +145500 ELSE NC1714.2 +145600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +145700 TO RE-MARK NC1714.2 +145800 PERFORM FAIL NC1714.2 +145900 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +146000 MOVE "0" TO CORRECT-X NC1714.2 +146100 PERFORM PRINT-DETAIL. NC1714.2 +146200* NC1714.2 +146300* NC1714.2 +146400 DIV-INIT-F1-22. NC1714.2 +146500* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +146600* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +146700 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +146800 MOVE "DIV-TEST-F1-22" TO PAR-NAME. NC1714.2 +146900 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +147000 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +147100 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +147200 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +147300 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +147400 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +147500 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +147600 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +147700 MOVE "0" TO WRK-XN-00001. NC1714.2 +147800 MOVE 1 TO REC-CT. NC1714.2 +147900 DIV-TEST-F1-22-0. NC1714.2 +148000 DIVIDE WRK-DU-1V3-1 NC1714.2 +148100 INTO WRK-DU-2V2-1 NC1714.2 +148200 WRK-DU-2V2-2 ROUNDED NC1714.2 +148300 WRK-DU-2V2-3 NC1714.2 +148400 WRK-DU-2V2-4 ROUNDED NC1714.2 +148500 WRK-DU-1V3-2 NC1714.2 +148600 WRK-DU-2V2-5 NC1714.2 +148700 WRK-DU-2V1-1 ROUNDED NC1714.2 +148800 NOT ON SIZE ERROR NC1714.2 +148900 MOVE "1" TO WRK-XN-00001. NC1714.2 +149000 GO TO DIV-TEST-F1-22-1. NC1714.2 +149100 DIV-DELETE-F1-22. NC1714.2 +149200 PERFORM DE-LETE. NC1714.2 +149300 PERFORM PRINT-DETAIL. NC1714.2 +149400 GO TO DIV-INIT-F1-23. NC1714.2 +149500 DIV-TEST-F1-22-1. NC1714.2 +149600 IF WRK-DU-2V2-1 = 15.42 NC1714.2 +149700 PERFORM PASS NC1714.2 +149800 PERFORM PRINT-DETAIL NC1714.2 +149900 ELSE NC1714.2 +150000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +150100 PERFORM FAIL NC1714.2 +150200 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +150300 MOVE 15.42 TO CORRECT-N NC1714.2 +150400 PERFORM PRINT-DETAIL. NC1714.2 +150500 ADD 1 TO REC-CT. NC1714.2 +150600 DIV-TEST-F1-22-2. NC1714.2 +150700 IF WRK-DU-2V2-2 = 60.83 NC1714.2 +150800 PERFORM PASS NC1714.2 +150900 PERFORM PRINT-DETAIL NC1714.2 +151000 ELSE NC1714.2 +151100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +151200 PERFORM FAIL NC1714.2 +151300 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +151400 MOVE 60.83 TO CORRECT-N NC1714.2 +151500 PERFORM PRINT-DETAIL. NC1714.2 +151600 ADD 1 TO REC-CT. NC1714.2 +151700 DIV-TEST-F1-22-3. NC1714.2 +151800 IF WRK-DU-2V2-3 = 60.92 NC1714.2 +151900 PERFORM PASS NC1714.2 +152000 PERFORM PRINT-DETAIL NC1714.2 +152100 ELSE NC1714.2 +152200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +152300 PERFORM FAIL NC1714.2 +152400 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +152500 MOVE 60.92 TO CORRECT-N NC1714.2 +152600 PERFORM PRINT-DETAIL. NC1714.2 +152700 ADD 1 TO REC-CT. NC1714.2 +152800 DIV-TEST-F1-22-4. NC1714.2 +152900 IF WRK-DU-2V2-4 = 60.93 NC1714.2 +153000 PERFORM PASS NC1714.2 +153100 PERFORM PRINT-DETAIL NC1714.2 +153200 ELSE NC1714.2 +153300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +153400 PERFORM FAIL NC1714.2 +153500 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +153600 MOVE 60.93 TO CORRECT-N NC1714.2 +153700 PERFORM PRINT-DETAIL. NC1714.2 +153800 ADD 1 TO REC-CT. NC1714.2 +153900 DIV-TEST-F1-22-5. NC1714.2 +154000 IF WRK-DU-1V3-2 = 1.000 NC1714.2 +154100 PERFORM PASS NC1714.2 +154200 PERFORM PRINT-DETAIL NC1714.2 +154300 ELSE NC1714.2 +154400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +154500 PERFORM FAIL NC1714.2 +154600 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +154700 MOVE 1.000 TO CORRECT-N NC1714.2 +154800 PERFORM PRINT-DETAIL. NC1714.2 +154900 ADD 1 TO REC-CT. NC1714.2 +155000 DIV-TEST-F1-22-6. NC1714.2 +155100 IF WRK-DU-2V2-5 = 09.99 NC1714.2 +155200 PERFORM PASS NC1714.2 +155300 PERFORM PRINT-DETAIL NC1714.2 +155400 ELSE NC1714.2 +155500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +155600 PERFORM FAIL NC1714.2 +155700 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +155800 MOVE 09.99 TO CORRECT-N NC1714.2 +155900 PERFORM PRINT-DETAIL. NC1714.2 +156000 ADD 1 TO REC-CT. NC1714.2 +156100 DIV-TEST-F1-22-7. NC1714.2 +156200 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +156300 PERFORM PASS NC1714.2 +156400 PERFORM PRINT-DETAIL NC1714.2 +156500 ELSE NC1714.2 +156600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +156700 PERFORM FAIL NC1714.2 +156800 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +156900 MOVE 10.00 TO CORRECT-N NC1714.2 +157000 PERFORM PRINT-DETAIL. NC1714.2 +157100 ADD 1 TO REC-CT. NC1714.2 +157200 DIV-TEST-F1-22-8. NC1714.2 +157300 IF WRK-XN-00001 = "1" NC1714.2 +157400 PERFORM PASS NC1714.2 +157500 PERFORM PRINT-DETAIL NC1714.2 +157600 ELSE NC1714.2 +157700 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +157800 TO RE-MARK NC1714.2 +157900 PERFORM FAIL NC1714.2 +158000 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +158100 MOVE "1" TO CORRECT-X NC1714.2 +158200 PERFORM PRINT-DETAIL. NC1714.2 +158300* NC1714.2 +158400* NC1714.2 +158500 DIV-INIT-F1-23. NC1714.2 +158600* ==--> SIZE ERROR CONDITION <--== NC1714.2 +158700* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +158800 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +158900 MOVE "DIV-TEST-F1-23" TO PAR-NAME. NC1714.2 +159000 MOVE .01 TO WRK-DU-0V2-1. NC1714.2 +159100 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +159200 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +159300 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +159400 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +159500 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +159600 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +159700 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +159800 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +159900 MOVE "0" TO WRK-XN-00001. NC1714.2 +160000 MOVE 1 TO REC-CT. NC1714.2 +160100 DIV-TEST-F1-23-0. NC1714.2 +160200 DIVIDE WRK-DU-0V2-1 NC1714.2 +160300 INTO WRK-DU-2V2-1 NC1714.2 +160400 WRK-DU-2V2-2 NC1714.2 +160500 WRK-DU-2V2-3 NC1714.2 +160600 WRK-DU-2V2-4 NC1714.2 +160700 WRK-DU-1V3-2 NC1714.2 +160800 WRK-DU-2V2-5 NC1714.2 +160900 WRK-DU-2V1-1 NC1714.2 +161000 ON SIZE ERROR NC1714.2 +161100 MOVE "1" TO WRK-XN-00001 NC1714.2 +161200 NOT ON SIZE ERROR NC1714.2 +161300 MOVE "2" TO WRK-XN-00001. NC1714.2 +161400 GO TO DIV-TEST-F1-23-1. NC1714.2 +161500 DIV-DELETE-F1-23. NC1714.2 +161600 PERFORM DE-LETE. NC1714.2 +161700 PERFORM PRINT-DETAIL. NC1714.2 +161800 GO TO DIV-INIT-F1-24. NC1714.2 +161900 DIV-TEST-F1-23-1. NC1714.2 +162000 IF WRK-DU-2V2-1 = 15.44 NC1714.2 +162100 PERFORM PASS NC1714.2 +162200 PERFORM PRINT-DETAIL NC1714.2 +162300 ELSE NC1714.2 +162400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +162500 PERFORM FAIL NC1714.2 +162600 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +162700 MOVE 15.44 TO CORRECT-N NC1714.2 +162800 PERFORM PRINT-DETAIL. NC1714.2 +162900 ADD 1 TO REC-CT. NC1714.2 +163000 DIV-TEST-F1-23-2. NC1714.2 +163100 IF WRK-DU-2V2-2 = 60.89 NC1714.2 +163200 PERFORM PASS NC1714.2 +163300 PERFORM PRINT-DETAIL NC1714.2 +163400 ELSE NC1714.2 +163500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +163600 PERFORM FAIL NC1714.2 +163700 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +163800 MOVE 60.89 TO CORRECT-N NC1714.2 +163900 PERFORM PRINT-DETAIL. NC1714.2 +164000 ADD 1 TO REC-CT. NC1714.2 +164100 DIV-TEST-F1-23-3. NC1714.2 +164200 IF WRK-DU-2V2-3 = 60.99 NC1714.2 +164300 PERFORM PASS NC1714.2 +164400 PERFORM PRINT-DETAIL NC1714.2 +164500 ELSE NC1714.2 +164600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +164700 PERFORM FAIL NC1714.2 +164800 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +164900 MOVE 60.99 TO CORRECT-N NC1714.2 +165000 PERFORM PRINT-DETAIL. NC1714.2 +165100 ADD 1 TO REC-CT. NC1714.2 +165200 DIV-TEST-F1-23-4. NC1714.2 +165300 IF WRK-DU-2V2-4 = 60.99 NC1714.2 +165400 PERFORM PASS NC1714.2 +165500 PERFORM PRINT-DETAIL NC1714.2 +165600 ELSE NC1714.2 +165700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +165800 PERFORM FAIL NC1714.2 +165900 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +166000 MOVE 60.99 TO CORRECT-N NC1714.2 +166100 PERFORM PRINT-DETAIL. NC1714.2 +166200 ADD 1 TO REC-CT. NC1714.2 +166300 DIV-TEST-F1-23-5. NC1714.2 +166400 IF WRK-DU-1V3-2 = 1.001 NC1714.2 +166500 PERFORM PASS NC1714.2 +166600 PERFORM PRINT-DETAIL NC1714.2 +166700 ELSE NC1714.2 +166800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +166900 PERFORM FAIL NC1714.2 +167000 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +167100 MOVE 1.001 TO CORRECT-N NC1714.2 +167200 PERFORM PRINT-DETAIL. NC1714.2 +167300 ADD 1 TO REC-CT. NC1714.2 +167400 DIV-TEST-F1-23-6. NC1714.2 +167500 IF WRK-DU-2V2-5 = 10.00 NC1714.2 +167600 PERFORM PASS NC1714.2 +167700 PERFORM PRINT-DETAIL NC1714.2 +167800 ELSE NC1714.2 +167900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +168000 PERFORM FAIL NC1714.2 +168100 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +168200 MOVE 10.00 TO CORRECT-N NC1714.2 +168300 PERFORM PRINT-DETAIL. NC1714.2 +168400 ADD 1 TO REC-CT. NC1714.2 +168500 DIV-TEST-F1-23-7. NC1714.2 +168600 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +168700 PERFORM PASS NC1714.2 +168800 PERFORM PRINT-DETAIL NC1714.2 +168900 ELSE NC1714.2 +169000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1714.2 +169100 PERFORM FAIL NC1714.2 +169200 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +169300 MOVE 10.0 TO CORRECT-N NC1714.2 +169400 PERFORM PRINT-DETAIL. NC1714.2 +169500 ADD 1 TO REC-CT. NC1714.2 +169600 DIV-TEST-F1-23-8. NC1714.2 +169700 IF WRK-XN-00001 = "1" NC1714.2 +169800 PERFORM PASS NC1714.2 +169900 PERFORM PRINT-DETAIL NC1714.2 +170000 ELSE NC1714.2 +170100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1714.2 +170200 PERFORM FAIL NC1714.2 +170300 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +170400 MOVE "1" TO CORRECT-X NC1714.2 +170500 PERFORM PRINT-DETAIL. NC1714.2 +170600* NC1714.2 +170700* NC1714.2 +170800 DIV-INIT-F1-24. NC1714.2 +170900* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +171000* ==--> NEW SIZE ERRROR TESTS <--== NC1714.2 +171100 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1714.2 +171200 MOVE "DIV-TEST-F1-24" TO PAR-NAME. NC1714.2 +171300 MOVE 1.001 TO WRK-DU-1V3-1. NC1714.2 +171400 MOVE 15.44 TO WRK-DU-2V2-1. NC1714.2 +171500 MOVE 60.89 TO WRK-DU-2V2-2. NC1714.2 +171600 MOVE 60.99 TO WRK-DU-2V2-3. NC1714.2 +171700 MOVE 60.99 TO WRK-DU-2V2-4. NC1714.2 +171800 MOVE 10.0 TO WRK-DU-2V2-5. NC1714.2 +171900 MOVE 1.001 TO WRK-DU-1V3-2. NC1714.2 +172000 MOVE 10.0 TO WRK-DU-2V1-1. NC1714.2 +172100 MOVE 1 TO REC-CT. NC1714.2 +172200 DIV-TEST-F1-24-0. NC1714.2 +172300 DIVIDE WRK-DU-1V3-1 NC1714.2 +172400 INTO WRK-DU-2V2-1 NC1714.2 +172500 WRK-DU-2V2-2 ROUNDED NC1714.2 +172600 WRK-DU-2V2-3 NC1714.2 +172700 WRK-DU-2V2-4 ROUNDED NC1714.2 +172800 WRK-DU-1V3-2 NC1714.2 +172900 WRK-DU-2V2-5 NC1714.2 +173000 WRK-DU-2V1-1 ROUNDED NC1714.2 +173100 ON SIZE ERROR NC1714.2 +173200 MOVE "1" TO WRK-XN-00001 NC1714.2 +173300 NOT ON SIZE ERROR NC1714.2 +173400 MOVE "2" TO WRK-XN-00001. NC1714.2 +173500 GO TO DIV-TEST-F1-24-1. NC1714.2 +173600 DIV-DELETE-F1-24. NC1714.2 +173700 PERFORM DE-LETE. NC1714.2 +173800 PERFORM PRINT-DETAIL. NC1714.2 +173900 GO TO DIV-INIT-F1-25. NC1714.2 +174000 DIV-TEST-F1-24-1. NC1714.2 +174100 IF WRK-DU-2V2-1 = 15.42 NC1714.2 +174200 PERFORM PASS NC1714.2 +174300 PERFORM PRINT-DETAIL NC1714.2 +174400 ELSE NC1714.2 +174500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +174600 PERFORM FAIL NC1714.2 +174700 MOVE WRK-DU-2V2-1 TO COMPUTED-N NC1714.2 +174800 MOVE 15.42 TO CORRECT-N NC1714.2 +174900 PERFORM PRINT-DETAIL. NC1714.2 +175000 ADD 1 TO REC-CT. NC1714.2 +175100 DIV-TEST-F1-24-2. NC1714.2 +175200 IF WRK-DU-2V2-2 = 60.83 NC1714.2 +175300 PERFORM PASS NC1714.2 +175400 PERFORM PRINT-DETAIL NC1714.2 +175500 ELSE NC1714.2 +175600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +175700 PERFORM FAIL NC1714.2 +175800 MOVE WRK-DU-2V2-2 TO COMPUTED-N NC1714.2 +175900 MOVE 60.83 TO CORRECT-N NC1714.2 +176000 PERFORM PRINT-DETAIL. NC1714.2 +176100 ADD 1 TO REC-CT. NC1714.2 +176200 DIV-TEST-F1-24-3. NC1714.2 +176300 IF WRK-DU-2V2-3 = 60.92 NC1714.2 +176400 PERFORM PASS NC1714.2 +176500 PERFORM PRINT-DETAIL NC1714.2 +176600 ELSE NC1714.2 +176700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +176800 PERFORM FAIL NC1714.2 +176900 MOVE WRK-DU-2V2-3 TO COMPUTED-N NC1714.2 +177000 MOVE 60.92 TO CORRECT-N NC1714.2 +177100 PERFORM PRINT-DETAIL. NC1714.2 +177200 ADD 1 TO REC-CT. NC1714.2 +177300 DIV-TEST-F1-24-4. NC1714.2 +177400 IF WRK-DU-2V2-4 = 60.93 NC1714.2 +177500 PERFORM PASS NC1714.2 +177600 PERFORM PRINT-DETAIL NC1714.2 +177700 ELSE NC1714.2 +177800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +177900 PERFORM FAIL NC1714.2 +178000 MOVE WRK-DU-2V2-4 TO COMPUTED-N NC1714.2 +178100 MOVE 60.93 TO CORRECT-N NC1714.2 +178200 PERFORM PRINT-DETAIL. NC1714.2 +178300 ADD 1 TO REC-CT. NC1714.2 +178400 DIV-TEST-F1-24-5. NC1714.2 +178500 IF WRK-DU-1V3-2 = 1.000 NC1714.2 +178600 PERFORM PASS NC1714.2 +178700 PERFORM PRINT-DETAIL NC1714.2 +178800 ELSE NC1714.2 +178900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +179000 PERFORM FAIL NC1714.2 +179100 MOVE WRK-DU-1V3-2 TO COMPUTED-N NC1714.2 +179200 MOVE 1.000 TO CORRECT-N NC1714.2 +179300 PERFORM PRINT-DETAIL. NC1714.2 +179400 ADD 1 TO REC-CT. NC1714.2 +179500 DIV-TEST-F1-24-6. NC1714.2 +179600 IF WRK-DU-2V2-5 = 09.99 NC1714.2 +179700 PERFORM PASS NC1714.2 +179800 PERFORM PRINT-DETAIL NC1714.2 +179900 ELSE NC1714.2 +180000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +180100 PERFORM FAIL NC1714.2 +180200 MOVE WRK-DU-2V2-5 TO COMPUTED-N NC1714.2 +180300 MOVE 09.99 TO CORRECT-N NC1714.2 +180400 PERFORM PRINT-DETAIL. NC1714.2 +180500 ADD 1 TO REC-CT. NC1714.2 +180600 DIV-TEST-F1-24-7. NC1714.2 +180700 IF WRK-DU-2V1-1 = 10.0 NC1714.2 +180800 PERFORM PASS NC1714.2 +180900 PERFORM PRINT-DETAIL NC1714.2 +181000 ELSE NC1714.2 +181100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +181200 PERFORM FAIL NC1714.2 +181300 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1714.2 +181400 MOVE 10.00 TO CORRECT-N NC1714.2 +181500 PERFORM PRINT-DETAIL. NC1714.2 +181600 ADD 1 TO REC-CT. NC1714.2 +181700 DIV-TEST-F1-24-8. NC1714.2 +181800 IF WRK-XN-00001 = "2" NC1714.2 +181900 PERFORM PASS NC1714.2 +182000 PERFORM PRINT-DETAIL NC1714.2 +182100 ELSE NC1714.2 +182200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +182300 TO RE-MARK NC1714.2 +182400 PERFORM FAIL NC1714.2 +182500 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +182600 MOVE "2" TO CORRECT-X NC1714.2 +182700 PERFORM PRINT-DETAIL. NC1714.2 +182800* NC1714.2 +182900* NC1714.2 +183000 DIV-INIT-F1-25. NC1714.2 +183100* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +183200* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +183300 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +183400 MOVE "DIV-TEST-F1-25 " TO PAR-NAME. NC1714.2 +183500 MOVE "0" TO WRK-XN-00001. NC1714.2 +183600 MOVE 0 TO WRK-DS-05V00. NC1714.2 +183700 MOVE 0 TO WRK-DS-02V00. NC1714.2 +183800 MOVE 0 TO WRK-CS-18V00. NC1714.2 +183900 MOVE 1620.36 TO DIV1. NC1714.2 +184000 MOVE 44.1 TO DIV2. NC1714.2 +184100 MOVE 1 TO REC-CT. NC1714.2 +184200 DIV-TEST-F1-25-0. NC1714.2 +184300 DIVIDE DIV2 INTO DIV1 NC1714.2 +184400 ON SIZE ERROR NC1714.2 +184500 MOVE "1" TO WRK-XN-00001 NC1714.2 +184600 MOVE 23 TO WRK-DS-05V00 NC1714.2 +184700 MOVE -4 TO WRK-DS-02V00 NC1714.2 +184800 END-DIVIDE NC1714.2 +184900 MOVE 99 TO WRK-CS-18V00. NC1714.2 +185000 GO TO DIV-TEST-F1-25-1. NC1714.2 +185100 DIV-DELETE-F1-25-1. NC1714.2 +185200 PERFORM DE-LETE. NC1714.2 +185300 PERFORM PRINT-DETAIL. NC1714.2 +185400 GO TO DIV-INIT-F1-26. NC1714.2 +185500 DIV-TEST-F1-25-1. NC1714.2 +185600 IF WRK-XN-00001 = "0" NC1714.2 +185700 PERFORM PASS NC1714.2 +185800 PERFORM PRINT-DETAIL NC1714.2 +185900 ELSE NC1714.2 +186000 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +186100 MOVE "0" TO CORRECT-X NC1714.2 +186200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +186300 TO RE-MARK NC1714.2 +186400 PERFORM FAIL NC1714.2 +186500 PERFORM PRINT-DETAIL. NC1714.2 +186600 ADD 1 TO REC-CT. NC1714.2 +186700 DIV-TEST-F1-25-2. NC1714.2 +186800 IF WRK-DS-05V00 = 0 NC1714.2 +186900 PERFORM PASS NC1714.2 +187000 PERFORM PRINT-DETAIL NC1714.2 +187100 ELSE NC1714.2 +187200 MOVE WRK-DS-05V00 TO COMPUTED-N NC1714.2 +187300 MOVE 0 TO CORRECT-N NC1714.2 +187400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +187500 TO RE-MARK NC1714.2 +187600 PERFORM FAIL NC1714.2 +187700 PERFORM PRINT-DETAIL. NC1714.2 +187800 ADD 1 TO REC-CT. NC1714.2 +187900 DIV-TEST-F1-25-3. NC1714.2 +188000 IF WRK-DS-02V00 = 0 NC1714.2 +188100 PERFORM PASS NC1714.2 +188200 PERFORM PRINT-DETAIL NC1714.2 +188300 ELSE NC1714.2 +188400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1714.2 +188500 MOVE 0 TO CORRECT-N NC1714.2 +188600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +188700 TO RE-MARK NC1714.2 +188800 PERFORM FAIL NC1714.2 +188900 PERFORM PRINT-DETAIL. NC1714.2 +189000 DIV-TEST-F1-25-4. NC1714.2 +189100 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +189200 PERFORM PASS NC1714.2 +189300 PERFORM PRINT-DETAIL NC1714.2 +189400 ELSE NC1714.2 +189500 MOVE WRK-CS-18V00 TO COMPUTED-N NC1714.2 +189600 MOVE 0 TO CORRECT-N NC1714.2 +189700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1714.2 +189800 PERFORM FAIL NC1714.2 +189900 PERFORM PRINT-DETAIL. NC1714.2 +190000* NC1714.2 +190100* NC1714.2 +190200 DIV-INIT-F1-26. NC1714.2 +190300* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +190400* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +190500 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +190600 MOVE "DIV-TEST-F1-26 " TO PAR-NAME. NC1714.2 +190700 MOVE 111111111.111111111 TO A18ONES-DS-09V09. NC1714.2 +190800 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +190900 MOVE "0" TO WRK-XN-00001. NC1714.2 +191000 MOVE 0 TO WRK-DS-05V00. NC1714.2 +191100 MOVE 0 TO WRK-DS-02V00. NC1714.2 +191200 MOVE 0 TO WRK-CS-18V00. NC1714.2 +191300 MOVE 1 TO REC-CT. NC1714.2 +191400 DIV-TEST-F1-26-0. NC1714.2 +191500 DIVIDE A18ONES-DS-09V09 NC1714.2 +191600 INTO WRK-DS-09V09 ROUNDED NC1714.2 +191700 ON SIZE ERROR NC1714.2 +191800 MOVE "1" TO WRK-XN-00001 NC1714.2 +191900 MOVE 23 TO WRK-DS-05V00 NC1714.2 +192000 MOVE -4 TO WRK-DS-02V00 NC1714.2 +192100 END-DIVIDE NC1714.2 +192200 MOVE 99 TO WRK-CS-18V00. NC1714.2 +192300 GO TO DIV-TEST-F1-26-1. NC1714.2 +192400 DIV-DELETE-F1-26-1. NC1714.2 +192500 PERFORM DE-LETE. NC1714.2 +192600 PERFORM PRINT-DETAIL. NC1714.2 +192700 GO TO DIV-INIT-F1-27. NC1714.2 +192800 DIV-TEST-F1-26-1. NC1714.2 +192900 IF WRK-DS-18V00-S = 000000001000000000 NC1714.2 +193000 PERFORM PASS NC1714.2 +193100 PERFORM PRINT-DETAIL NC1714.2 +193200 ELSE NC1714.2 +193300 MOVE 000000001000000000 TO CORRECT-18V0 NC1714.2 +193400 MOVE WRK-DS-18V00 TO COMPUTED-18V0 NC1714.2 +193500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +193600 TO RE-MARK NC1714.2 +193700 PERFORM FAIL NC1714.2 +193800 PERFORM PRINT-DETAIL. NC1714.2 +193900 ADD 1 TO REC-CT. NC1714.2 +194000 DIV-TEST-F1-26-2. NC1714.2 +194100 IF WRK-XN-00001 = "0" NC1714.2 +194200 PERFORM PASS NC1714.2 +194300 PERFORM PRINT-DETAIL NC1714.2 +194400 ELSE NC1714.2 +194500 MOVE "0" TO CORRECT-X NC1714.2 +194600 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +194700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +194800 TO RE-MARK NC1714.2 +194900 PERFORM FAIL NC1714.2 +195000 PERFORM PRINT-DETAIL. NC1714.2 +195100 ADD 1 TO REC-CT. NC1714.2 +195200 DIV-TEST-F1-26-3. NC1714.2 +195300 IF WRK-DS-05V00 = 0 NC1714.2 +195400 PERFORM PASS NC1714.2 +195500 PERFORM PRINT-DETAIL NC1714.2 +195600 ELSE NC1714.2 +195700 MOVE 0 TO CORRECT-18V0 NC1714.2 +195800 MOVE WRK-DS-05V00 TO COMPUTED-18V0 NC1714.2 +195900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +196000 TO RE-MARK NC1714.2 +196100 PERFORM FAIL NC1714.2 +196200 PERFORM PRINT-DETAIL. NC1714.2 +196300 ADD 1 TO REC-CT. NC1714.2 +196400 DIV-TEST-F1-26-4. NC1714.2 +196500 IF WRK-DS-02V00 = 0 NC1714.2 +196600 PERFORM PASS NC1714.2 +196700 PERFORM PRINT-DETAIL NC1714.2 +196800 ELSE NC1714.2 +196900 MOVE 0 TO CORRECT-18V0 NC1714.2 +197000 MOVE WRK-DS-02V00 TO COMPUTED-18V0 NC1714.2 +197100 PERFORM FAIL NC1714.2 +197200 PERFORM PRINT-DETAIL. NC1714.2 +197300 ADD 1 TO REC-CT. NC1714.2 +197400 DIV-TEST-F1-26-5. NC1714.2 +197500 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +197600 PERFORM PASS NC1714.2 +197700 PERFORM PRINT-DETAIL NC1714.2 +197800 ELSE NC1714.2 +197900 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +198000 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +198100 PERFORM FAIL NC1714.2 +198200 PERFORM PRINT-DETAIL. NC1714.2 +198300* NC1714.2 +198400* NC1714.2 +198500 DIV-INIT-F1-27. NC1714.2 +198600* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +198700* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +198800 MOVE "DIV-TEST-F1-27 " TO PAR-NAME. NC1714.2 +198900 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +199000 MOVE "0" TO WRK-XN-00001. NC1714.2 +199100 MOVE 0 TO WRK-DS-05V00. NC1714.2 +199200 MOVE 0 TO WRK-DS-02V00. NC1714.2 +199300 MOVE 0 TO WRK-CS-18V00. NC1714.2 +199400 MOVE 1620.36 TO DIV1. NC1714.2 +199500 MOVE 44.1 TO DIV2. NC1714.2 +199600 MOVE 1 TO REC-CT. NC1714.2 +199700 DIV-TEST-F1-27-0. NC1714.2 +199800 DIVIDE DIV2 INTO DIV1 NC1714.2 +199900 NOT ON SIZE ERROR NC1714.2 +200000 MOVE "1" TO WRK-XN-00001 NC1714.2 +200100 MOVE 23 TO WRK-DS-05V00 NC1714.2 +200200 MOVE -4 TO WRK-DS-02V00 NC1714.2 +200300 END-DIVIDE NC1714.2 +200400 MOVE 99 TO WRK-CS-18V00. NC1714.2 +200500 GO TO DIV-TEST-F1-27-1. NC1714.2 +200600 DIV-DELETE-F1-27-1. NC1714.2 +200700 PERFORM DE-LETE. NC1714.2 +200800 PERFORM PRINT-DETAIL. NC1714.2 +200900 GO TO DIV-INIT-F1-28. NC1714.2 +201000 DIV-TEST-F1-27-1. NC1714.2 +201100 IF WRK-XN-00001 = "1" NC1714.2 +201200 PERFORM PASS NC1714.2 +201300 PERFORM PRINT-DETAIL NC1714.2 +201400 ELSE NC1714.2 +201500 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +201600 MOVE "1" TO CORRECT-X NC1714.2 +201700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +201800 TO RE-MARK NC1714.2 +201900 PERFORM FAIL NC1714.2 +202000 PERFORM PRINT-DETAIL. NC1714.2 +202100 ADD 1 TO REC-CT. NC1714.2 +202200 DIV-TEST-F1-27-2. NC1714.2 +202300 IF WRK-DS-05V00 = 23 NC1714.2 +202400 PERFORM PASS NC1714.2 +202500 PERFORM PRINT-DETAIL NC1714.2 +202600 ELSE NC1714.2 +202700 MOVE 23 TO CORRECT-18V0 NC1714.2 +202800 MOVE WRK-DS-05V00 TO COMPUTED-18V0 NC1714.2 +202900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1714.2 +203000 TO RE-MARK NC1714.2 +203100 PERFORM FAIL NC1714.2 +203200 PERFORM PRINT-DETAIL. NC1714.2 +203300 ADD 1 TO REC-CT. NC1714.2 +203400 DIV-TEST-F1-27-3. NC1714.2 +203500 IF WRK-DS-02V00 = -4 NC1714.2 +203600 PERFORM PASS NC1714.2 +203700 PERFORM PRINT-DETAIL NC1714.2 +203800 ELSE NC1714.2 +203900 MOVE -4 TO CORRECT-18V0 NC1714.2 +204000 MOVE WRK-DS-02V00 TO COMPUTED-18V0 NC1714.2 +204100 PERFORM FAIL NC1714.2 +204200 PERFORM PRINT-DETAIL. NC1714.2 +204300 ADD 1 TO REC-CT. NC1714.2 +204400 DIV-TEST-F1-27-4. NC1714.2 +204500 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +204600 PERFORM PASS NC1714.2 +204700 PERFORM PRINT-DETAIL NC1714.2 +204800 ELSE NC1714.2 +204900 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +205000 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +205100 PERFORM FAIL NC1714.2 +205200 PERFORM PRINT-DETAIL. NC1714.2 +205300 ADD 1 TO REC-CT. NC1714.2 +205400 DIV-TEST-F1-27-5. NC1714.2 +205500 IF DIV1 = 36.74 NC1714.2 +205600 PERFORM PASS NC1714.2 +205700 PERFORM PRINT-DETAIL NC1714.2 +205800 ELSE NC1714.2 +205900 MOVE DIV1 TO COMPUTED-N NC1714.2 +206000 MOVE 36.74 TO CORRECT-N NC1714.2 +206100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +206200 PERFORM FAIL NC1714.2 +206300 PERFORM PRINT-DETAIL. NC1714.2 +206400* NC1714.2 +206500* NC1714.2 +206600 DIV-INIT-F1-28. NC1714.2 +206700 MOVE "DIV-TEST-F1-28 " TO PAR-NAME. NC1714.2 +206800 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +206900 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +207000 MOVE "0" TO WRK-XN-00001. NC1714.2 +207100 MOVE 0 TO WRK-DS-05V00. NC1714.2 +207200 MOVE 0 TO WRK-DS-02V00. NC1714.2 +207300 MOVE 0 TO WRK-CS-18V00. NC1714.2 +207400 MOVE 1 TO REC-CT. NC1714.2 +207500 DIV-TEST-F1-28-0. NC1714.2 +207600 DIVIDE A18ONES-DS-09V09 NC1714.2 +207700 INTO WRK-DS-09V09 ROUNDED NC1714.2 +207800 NOT ON SIZE ERROR NC1714.2 +207900 MOVE "1" TO WRK-XN-00001 NC1714.2 +208000 MOVE 23 TO WRK-DS-05V00 NC1714.2 +208100 MOVE -4 TO WRK-DS-02V00 NC1714.2 +208200 END-DIVIDE NC1714.2 +208300 MOVE 99 TO WRK-CS-18V00. NC1714.2 +208400 GO TO DIV-TEST-F1-28-1. NC1714.2 +208500 DIV-DELETE-F1-28-1. NC1714.2 +208600 PERFORM DE-LETE. NC1714.2 +208700 PERFORM PRINT-DETAIL. NC1714.2 +208800 GO TO DIV-INIT-F1-29. NC1714.2 +208900 DIV-TEST-F1-28-1. NC1714.2 +209000 IF WRK-XN-00001 = "1" NC1714.2 +209100 PERFORM PASS NC1714.2 +209200 PERFORM PRINT-DETAIL NC1714.2 +209300 ELSE NC1714.2 +209400 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +209500 MOVE "1" TO CORRECT-X NC1714.2 +209600 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +209700 TO RE-MARK NC1714.2 +209800 PERFORM FAIL NC1714.2 +209900 PERFORM PRINT-DETAIL. NC1714.2 +210000 ADD 1 TO REC-CT. NC1714.2 +210100 DIV-TEST-F1-28-2. NC1714.2 +210200 IF WRK-DS-05V00 = 23 NC1714.2 +210300 PERFORM PASS NC1714.2 +210400 PERFORM PRINT-DETAIL NC1714.2 +210500 ELSE NC1714.2 +210600 MOVE 23 TO CORRECT-18V0 NC1714.2 +210700 MOVE WRK-DS-05V00 TO COMPUTED-18V0 NC1714.2 +210800 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +210900 TO RE-MARK NC1714.2 +211000 PERFORM FAIL NC1714.2 +211100 PERFORM PRINT-DETAIL. NC1714.2 +211200 ADD 1 TO REC-CT. NC1714.2 +211300 DIV-TEST-F1-28-3. NC1714.2 +211400 IF WRK-DS-02V00 = -4 NC1714.2 +211500 PERFORM PASS NC1714.2 +211600 PERFORM PRINT-DETAIL NC1714.2 +211700 ELSE NC1714.2 +211800 MOVE -4 TO CORRECT-18V0 NC1714.2 +211900 MOVE WRK-DS-02V00 TO COMPUTED-18V0 NC1714.2 +212000 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC1714.2 +212100 TO RE-MARK NC1714.2 +212200 PERFORM FAIL NC1714.2 +212300 PERFORM PRINT-DETAIL. NC1714.2 +212400 ADD 1 TO REC-CT. NC1714.2 +212500 DIV-TEST-F1-28-4. NC1714.2 +212600 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +212700 PERFORM PASS NC1714.2 +212800 PERFORM PRINT-DETAIL NC1714.2 +212900 ELSE NC1714.2 +213000 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +213100 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +213200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1714.2 +213300 PERFORM FAIL NC1714.2 +213400 PERFORM PRINT-DETAIL. NC1714.2 +213500 ADD 1 TO REC-CT. NC1714.2 +213600 DIV-TEST-F1-28-5. NC1714.2 +213700 IF WRK-DS-09V09 = 1 NC1714.2 +213800 PERFORM PASS NC1714.2 +213900 PERFORM PRINT-DETAIL NC1714.2 +214000 ELSE NC1714.2 +214100 MOVE 1 TO CORRECT-18V0 NC1714.2 +214200 MOVE WRK-DS-09V09 TO COMPUTED-18V0 NC1714.2 +214300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1714.2 +214400 TO RE-MARK NC1714.2 +214500 PERFORM FAIL NC1714.2 +214600 PERFORM PRINT-DETAIL. NC1714.2 +214700* NC1714.2 +214800* NC1714.2 +214900 DIV-INIT-F1-29. NC1714.2 +215000* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +215100* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +215200 MOVE "DIV-TEST-F1-29 " TO PAR-NAME. NC1714.2 +215300 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +215400 MOVE "0" TO WRK-XN-00001. NC1714.2 +215500 MOVE 0 TO WRK-CS-18V00. NC1714.2 +215600 MOVE 1620.36 TO DIV1. NC1714.2 +215700 MOVE 44.1 TO DIV2. NC1714.2 +215800 MOVE 1 TO REC-CT. NC1714.2 +215900 DIV-TEST-F1-29-0. NC1714.2 +216000 DIVIDE DIV2 INTO DIV1 NC1714.2 +216100 ON SIZE ERROR NC1714.2 +216200 MOVE "1" TO WRK-XN-00001 NC1714.2 +216300 NOT ON SIZE ERROR NC1714.2 +216400 MOVE "2" TO WRK-XN-00001 NC1714.2 +216500 END-DIVIDE NC1714.2 +216600 MOVE 99 TO WRK-CS-18V00. NC1714.2 +216700 GO TO DIV-TEST-F1-29-1. NC1714.2 +216800 DIV-DELETE-F1-29-1. NC1714.2 +216900 PERFORM DE-LETE. NC1714.2 +217000 PERFORM PRINT-DETAIL. NC1714.2 +217100 GO TO DIV-INIT-F1-30. NC1714.2 +217200 DIV-TEST-F1-29-1. NC1714.2 +217300 IF WRK-XN-00001 = "2" NC1714.2 +217400 PERFORM PASS NC1714.2 +217500 PERFORM PRINT-DETAIL NC1714.2 +217600 ELSE NC1714.2 +217700 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +217800 MOVE "2" TO CORRECT-X NC1714.2 +217900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1714.2 +218000 TO RE-MARK NC1714.2 +218100 PERFORM FAIL NC1714.2 +218200 PERFORM PRINT-DETAIL. NC1714.2 +218300 ADD 1 TO REC-CT. NC1714.2 +218400 DIV-TEST-F1-29-2. NC1714.2 +218500 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +218600 PERFORM PASS NC1714.2 +218700 PERFORM PRINT-DETAIL NC1714.2 +218800 ELSE NC1714.2 +218900 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +219000 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +219100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1714.2 +219200 PERFORM FAIL NC1714.2 +219300 PERFORM PRINT-DETAIL. NC1714.2 +219400 ADD 1 TO REC-CT. NC1714.2 +219500 DIV-TEST-F1-29-3. NC1714.2 +219600 IF DIV1 = 36.74 NC1714.2 +219700 PERFORM PASS NC1714.2 +219800 PERFORM PRINT-DETAIL NC1714.2 +219900 ELSE NC1714.2 +220000 MOVE DIV1 TO COMPUTED-N NC1714.2 +220100 MOVE 36.74 TO CORRECT-N NC1714.2 +220200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +220300 PERFORM FAIL NC1714.2 +220400 PERFORM PRINT-DETAIL. NC1714.2 +220500* NC1714.2 +220600* NC1714.2 +220700 DIV-INIT-F1-30. NC1714.2 +220800* ==--> NO SIZE ERROR CONDITION <--== NC1714.2 +220900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1714.2 +221000 MOVE "DIV-TEST-F1-30 " TO PAR-NAME. NC1714.2 +221100 MOVE "1V-41 6.4.3 " TO ANSI-REFERENCE. NC1714.2 +221200 MOVE 111111111.111111111 TO A18ONES-DS-09V09. NC1714.2 +221300 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1714.2 +221400 MOVE "0" TO WRK-XN-00001. NC1714.2 +221500 MOVE 0 TO WRK-CS-18V00. NC1714.2 +221600 MOVE 1 TO REC-CT. NC1714.2 +221700 DIV-TEST-F1-30-0. NC1714.2 +221800 DIVIDE A18ONES-DS-09V09 NC1714.2 +221900 INTO WRK-DS-09V09 ROUNDED NC1714.2 +222000 ON SIZE ERROR NC1714.2 +222100 MOVE "1" TO WRK-XN-00001 NC1714.2 +222200 NOT ON SIZE ERROR NC1714.2 +222300 MOVE "2" TO WRK-XN-00001 NC1714.2 +222400 END-DIVIDE NC1714.2 +222500 MOVE 99 TO WRK-CS-18V00. NC1714.2 +222600 GO TO DIV-TEST-F1-30-1. NC1714.2 +222700 DIV-DELETE-F1-30-1. NC1714.2 +222800 PERFORM DE-LETE. NC1714.2 +222900 PERFORM PRINT-DETAIL. NC1714.2 +223000 GO TO CCVS-EXIT. NC1714.2 +223100 DIV-TEST-F1-30-1. NC1714.2 +223200 IF WRK-XN-00001 = "2" NC1714.2 +223300 PERFORM PASS NC1714.2 +223400 PERFORM PRINT-DETAIL NC1714.2 +223500 ELSE NC1714.2 +223600 MOVE WRK-XN-00001 TO COMPUTED-X NC1714.2 +223700 MOVE "2" TO CORRECT-X NC1714.2 +223800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1714.2 +223900 TO RE-MARK NC1714.2 +224000 PERFORM FAIL NC1714.2 +224100 PERFORM PRINT-DETAIL. NC1714.2 +224200 ADD 1 TO REC-CT. NC1714.2 +224300 DIV-TEST-F1-30-2. NC1714.2 +224400 IF WRK-CS-18V00 = 000000000000000099 NC1714.2 +224500 PERFORM PASS NC1714.2 +224600 PERFORM PRINT-DETAIL NC1714.2 +224700 ELSE NC1714.2 +224800 MOVE 000000000000000099 TO CORRECT-18V0 NC1714.2 +224900 MOVE WRK-CS-18V00 TO COMPUTED-18V0 NC1714.2 +225000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1714.2 +225100 PERFORM FAIL NC1714.2 +225200 PERFORM PRINT-DETAIL. NC1714.2 +225300 ADD 1 TO REC-CT. NC1714.2 +225400 DIV-TEST-F1-30-3. NC1714.2 +225500 IF WRK-DS-18V00 = 1 NC1714.2 +225600 PERFORM PASS NC1714.2 +225700 PERFORM PRINT-DETAIL NC1714.2 +225800 ELSE NC1714.2 +225900 MOVE 1 TO CORRECT-18V0 NC1714.2 +226000 MOVE WRK-DS-18V00 TO COMPUTED-18V0 NC1714.2 +226100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1714.2 +226200 PERFORM FAIL NC1714.2 +226300 PERFORM PRINT-DETAIL. NC1714.2 +226400* NC1714.2 +226500* NC1714.2 +226600 CCVS-EXIT SECTION. NC1714.2 +226700 CCVS-999999. NC1714.2 +226800 GO TO CLOSE-FILES. NC1714.2 diff --git a/tests/cobol85/NC/NC172A.CBL b/tests/cobol85/NC/NC172A.CBL new file mode 100755 index 00000000..775f5d5e --- /dev/null +++ b/tests/cobol85/NC/NC172A.CBL @@ -0,0 +1,2215 @@ +000100 IDENTIFICATION DIVISION. NC1724.2 +000200 PROGRAM-ID. NC1724.2 +000300 NC172A. NC1724.2 +000400**************************************************************** NC1724.2 +000500* * NC1724.2 +000600* VALIDATION FOR:- * NC1724.2 +000700* * NC1724.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1724.2 +000900* * NC1724.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1724.2 +001100* * NC1724.2 +001200**************************************************************** NC1724.2 +001300* * NC1724.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1724.2 +001500* * NC1724.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1724.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1724.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1724.2 +001900* * NC1724.2 +002000**************************************************************** NC1724.2 +002100* THIS PROGRAM TESTS THE FORMAT 2 DIVIDE STATEMENT FOUND NC1724.2 +002200* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1724.2 +002300* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1724.2 +002400* TESTED, AS WELL AS THE ROUNDED OPTION. NC1724.2 +002500* NC1724.2 +002600* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1724.2 +002700* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1724.2 +002800* AS OPERANDS. NC1724.2 +002900* NC1724.2 +003000 NC1724.2 +003100 NC1724.2 +003200 ENVIRONMENT DIVISION. NC1724.2 +003300 CONFIGURATION SECTION. NC1724.2 +003400 SOURCE-COMPUTER. NC1724.2 +003500 Linux. NC1724.2 +003600 OBJECT-COMPUTER. NC1724.2 +003700 Linux. NC1724.2 +003800 INPUT-OUTPUT SECTION. NC1724.2 +003900 FILE-CONTROL. NC1724.2 +004000 SELECT PRINT-FILE ASSIGN TO NC1724.2 +004100 "report.log". NC1724.2 +004200 DATA DIVISION. NC1724.2 +004300 FILE SECTION. NC1724.2 +004400 FD PRINT-FILE. NC1724.2 +004500 01 PRINT-REC PICTURE X(120). NC1724.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC1724.2 +004700 WORKING-STORAGE SECTION. NC1724.2 +004800 77 WRK-DS-18V00 PICTURE S9(18). NC1724.2 +004900 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1724.2 +005000 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1724.2 +005100 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1724.2 +005200 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1724.2 +005300 77 WRK-DS-10V00 PICTURE S9(10). NC1724.2 +005400 77 WRK-XN-00001 PICTURE X. NC1724.2 +005500 77 A10ONES-DS-10V00 PICTURE S9(10) NC1724.2 +005600 VALUE 1111111111. NC1724.2 +005700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1724.2 +005800 VALUE 333333.333333. NC1724.2 +005900 77 WRK-DS-02V00 PICTURE S99. NC1724.2 +006000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1724.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1724.2 +006200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1724.2 +006300 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1724.2 +006400 77 A12ONES-DS-12V00 PICTURE S9(12) NC1724.2 +006500 VALUE 111111111111. NC1724.2 +006600 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1724.2 +006700 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1724.2 +006800 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1724.2 +006900 77 A18ONES-DS-18V00 PICTURE S9(18) NC1724.2 +007000 VALUE 111111111111111111. NC1724.2 +007100 77 WRK-DS-0201P PICTURE S99P. NC1724.2 +007200 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1724.2 +007300 77 WRK-DU-18V00 PICTURE 9(18). NC1724.2 +007400 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1724.2 +007500 VALUE 99. NC1724.2 +007600 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1724.2 +007700 VALUE .1. NC1724.2 +007800 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1724.2 +007900 77 WRK-DS-12V00 PICTURE S9(12). NC1724.2 +008000 77 WRK-DS-01V00 PICTURE S9. NC1724.2 +008100 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1724.2 +008200 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1724.2 +008300 VALUE 111111111.111111111. NC1724.2 +008400 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1724.2 +008500 77 WRK-DS-05V00 PICTURE S9(5). NC1724.2 +008600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1724.2 +008700 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1724.2 +008800 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1724.2 +008900 77 XRAY PICTURE X. NC1724.2 +009000 01 WRK-XN-18-1 PIC X(18). NC1724.2 +009100 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1724.2 +009200 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1724.2 +009300 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1724.2 +009400 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1724.2 +009500 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1724.2 +009600 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1724.2 +009700 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1724.2 +009800 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1724.2 +009900 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1724.2 +010000 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1724.2 +010100 01 WRK-DU-1V5-1 PIC 9V9(5). NC1724.2 +010200 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1724.2 +010300 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1724.2 +010400 01 WRK-DU-2V0-1 PIC 99. NC1724.2 +010500 01 WRK-DU-2V0-2 PIC 99. NC1724.2 +010600 01 WRK-DU-2V0-3 PIC 99. NC1724.2 +010700 01 WRK-DU-2V1-1 PIC 99V9. NC1724.2 +010800 01 WRK-DU-2V1-2 PIC 99V9. NC1724.2 +010900 01 WRK-DU-2V1-3 PIC 99V9. NC1724.2 +011000 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1724.2 +011100 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1724.2 +011200 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1724.2 +011300 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1724.2 +011400 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1724.2 +011500 01 WRK-DU-2V5-1 PIC 99V9(5). NC1724.2 +011600 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1724.2 +011700 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1724.2 +011800 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1724.2 +011900 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1724.2 +012000 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1724.2 +012100 01 WRK-NE-X-1 PIC 9(16).99. NC1724.2 +012200 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1724.2 +012300 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1724.2 +012400 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1724.2 +012500 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1724.2 +012600 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1724.2 +012700 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1724.2 +012800 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1724.2 +012900 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1724.2 +013000 01 WRK-NE-X-2 PIC -9(16).99. NC1724.2 +013100 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1724.2 +013200 01 WRK-NE-2 PIC $**.99. NC1724.2 +013300 01 WRK-NE-3 PIC $99.99CR. NC1724.2 +013400 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1724.2 +013500 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1724.2 +013600 VALUE +000000000000000001. NC1724.2 +013700 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1724.2 +013800 VALUE -000000000000000033. NC1724.2 +013900 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1724.2 +014000 VALUE 666666666666666666. NC1724.2 +014100 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1724.2 +014200 VALUE 009999999999999999. NC1724.2 +014300 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1724.2 +014400 VALUE 000022222222222222. NC1724.2 +014500 01 MULTIPLY-DATA. NC1724.2 +014600 02 MULT1 PICTURE IS 999V99 NC1724.2 +014700 VALUE IS 80.12. NC1724.2 +014800 02 MULT2 PICTURE IS 999V999. NC1724.2 +014900 02 MULT3 PICTURE IS $$99.99. NC1724.2 +015000 02 MULT4 PICTURE IS S99 NC1724.2 +015100 VALUE IS -56. NC1724.2 +015200 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1724.2 +015300 02 MULT6 PICTURE IS 99 VALUE IS NC1724.2 +015400 20. NC1724.2 +015500 01 DIVIDE-DATA. NC1724.2 +015600 02 DIV1 PICTURE IS 9(4)V99 NC1724.2 +015700 VALUE IS 1620.36. NC1724.2 +015800 02 DIV2 PICTURE IS 99V9 NC1724.2 +015900 VALUE IS 44.1. NC1724.2 +016000 02 DIV3 PICTURE IS 9(4)V9 NC1724.2 +016100 VALUE IS 1661.7. NC1724.2 +016200 02 DIV4 PICTURE IS S9V999 NC1724.2 +016300 VALUE IS -9.642. NC1724.2 +016400 02 DIV-02LEVEL-1. NC1724.2 +016500 03 DIV5 PICTURE IS V99 NC1724.2 +016600 VALUE IS .82. NC1724.2 +016700 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1724.2 +016800 03 DIV7 PICTURE IS 9V9 NC1724.2 +016900 VALUE IS 9.6. NC1724.2 +017000 01 DIV-DATA-2. NC1724.2 +017100 02 DIV8 PICTURE IS 99V9. NC1724.2 +017200 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1724.2 +017300 02 DIV10 PICTURE IS V999. NC1724.2 +017400 01 TEST-RESULTS. NC1724.2 +017500 02 FILLER PIC X VALUE SPACE. NC1724.2 +017600 02 FEATURE PIC X(20) VALUE SPACE. NC1724.2 +017700 02 FILLER PIC X VALUE SPACE. NC1724.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. NC1724.2 +017900 02 FILLER PIC X VALUE SPACE. NC1724.2 +018000 02 PAR-NAME. NC1724.2 +018100 03 FILLER PIC X(19) VALUE SPACE. NC1724.2 +018200 03 PARDOT-X PIC X VALUE SPACE. NC1724.2 +018300 03 DOTVALUE PIC 99 VALUE ZERO. NC1724.2 +018400 02 FILLER PIC X(8) VALUE SPACE. NC1724.2 +018500 02 RE-MARK PIC X(61). NC1724.2 +018600 01 TEST-COMPUTED. NC1724.2 +018700 02 FILLER PIC X(30) VALUE SPACE. NC1724.2 +018800 02 FILLER PIC X(17) VALUE NC1724.2 +018900 " COMPUTED=". NC1724.2 +019000 02 COMPUTED-X. NC1724.2 +019100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1724.2 +019200 03 COMPUTED-N REDEFINES COMPUTED-A NC1724.2 +019300 PIC -9(9).9(9). NC1724.2 +019400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1724.2 +019500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1724.2 +019600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1724.2 +019700 03 CM-18V0 REDEFINES COMPUTED-A. NC1724.2 +019800 04 COMPUTED-18V0 PIC -9(18). NC1724.2 +019900 04 FILLER PIC X. NC1724.2 +020000 03 FILLER PIC X(50) VALUE SPACE. NC1724.2 +020100 01 TEST-CORRECT. NC1724.2 +020200 02 FILLER PIC X(30) VALUE SPACE. NC1724.2 +020300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1724.2 +020400 02 CORRECT-X. NC1724.2 +020500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1724.2 +020600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1724.2 +020700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1724.2 +020800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1724.2 +020900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1724.2 +021000 03 CR-18V0 REDEFINES CORRECT-A. NC1724.2 +021100 04 CORRECT-18V0 PIC -9(18). NC1724.2 +021200 04 FILLER PIC X. NC1724.2 +021300 03 FILLER PIC X(2) VALUE SPACE. NC1724.2 +021400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1724.2 +021500 01 CCVS-C-1. NC1724.2 +021600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1724.2 +021700- "SS PARAGRAPH-NAME NC1724.2 +021800- " REMARKS". NC1724.2 +021900 02 FILLER PIC X(20) VALUE SPACE. NC1724.2 +022000 01 CCVS-C-2. NC1724.2 +022100 02 FILLER PIC X VALUE SPACE. NC1724.2 +022200 02 FILLER PIC X(6) VALUE "TESTED". NC1724.2 +022300 02 FILLER PIC X(15) VALUE SPACE. NC1724.2 +022400 02 FILLER PIC X(4) VALUE "FAIL". NC1724.2 +022500 02 FILLER PIC X(94) VALUE SPACE. NC1724.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1724.2 +022700 01 REC-CT PIC 99 VALUE ZERO. NC1724.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1724.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1724.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1724.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1724.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1724.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1724.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1724.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1724.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1724.2 +023700 01 CCVS-H-1. NC1724.2 +023800 02 FILLER PIC X(39) VALUE SPACES. NC1724.2 +023900 02 FILLER PIC X(42) VALUE NC1724.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1724.2 +024100 02 FILLER PIC X(39) VALUE SPACES. NC1724.2 +024200 01 CCVS-H-2A. NC1724.2 +024300 02 FILLER PIC X(40) VALUE SPACE. NC1724.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1724.2 +024500 02 FILLER PIC XXXX VALUE NC1724.2 +024600 "4.2 ". NC1724.2 +024700 02 FILLER PIC X(28) VALUE NC1724.2 +024800 " COPY - NOT FOR DISTRIBUTION". NC1724.2 +024900 02 FILLER PIC X(41) VALUE SPACE. NC1724.2 +025000 NC1724.2 +025100 01 CCVS-H-2B. NC1724.2 +025200 02 FILLER PIC X(15) VALUE NC1724.2 +025300 "TEST RESULT OF ". NC1724.2 +025400 02 TEST-ID PIC X(9). NC1724.2 +025500 02 FILLER PIC X(4) VALUE NC1724.2 +025600 " IN ". NC1724.2 +025700 02 FILLER PIC X(12) VALUE NC1724.2 +025800 " HIGH ". NC1724.2 +025900 02 FILLER PIC X(22) VALUE NC1724.2 +026000 " LEVEL VALIDATION FOR ". NC1724.2 +026100 02 FILLER PIC X(58) VALUE NC1724.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1724.2 +026300 01 CCVS-H-3. NC1724.2 +026400 02 FILLER PIC X(34) VALUE NC1724.2 +026500 " FOR OFFICIAL USE ONLY ". NC1724.2 +026600 02 FILLER PIC X(58) VALUE NC1724.2 +026700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1724.2 +026800 02 FILLER PIC X(28) VALUE NC1724.2 +026900 " COPYRIGHT 1985 ". NC1724.2 +027000 01 CCVS-E-1. NC1724.2 +027100 02 FILLER PIC X(52) VALUE SPACE. NC1724.2 +027200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1724.2 +027300 02 ID-AGAIN PIC X(9). NC1724.2 +027400 02 FILLER PIC X(45) VALUE SPACES. NC1724.2 +027500 01 CCVS-E-2. NC1724.2 +027600 02 FILLER PIC X(31) VALUE SPACE. NC1724.2 +027700 02 FILLER PIC X(21) VALUE SPACE. NC1724.2 +027800 02 CCVS-E-2-2. NC1724.2 +027900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1724.2 +028000 03 FILLER PIC X VALUE SPACE. NC1724.2 +028100 03 ENDER-DESC PIC X(44) VALUE NC1724.2 +028200 "ERRORS ENCOUNTERED". NC1724.2 +028300 01 CCVS-E-3. NC1724.2 +028400 02 FILLER PIC X(22) VALUE NC1724.2 +028500 " FOR OFFICIAL USE ONLY". NC1724.2 +028600 02 FILLER PIC X(12) VALUE SPACE. NC1724.2 +028700 02 FILLER PIC X(58) VALUE NC1724.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1724.2 +028900 02 FILLER PIC X(13) VALUE SPACE. NC1724.2 +029000 02 FILLER PIC X(15) VALUE NC1724.2 +029100 " COPYRIGHT 1985". NC1724.2 +029200 01 CCVS-E-4. NC1724.2 +029300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1724.2 +029400 02 FILLER PIC X(4) VALUE " OF ". NC1724.2 +029500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1724.2 +029600 02 FILLER PIC X(40) VALUE NC1724.2 +029700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1724.2 +029800 01 XXINFO. NC1724.2 +029900 02 FILLER PIC X(19) VALUE NC1724.2 +030000 "*** INFORMATION ***". NC1724.2 +030100 02 INFO-TEXT. NC1724.2 +030200 04 FILLER PIC X(8) VALUE SPACE. NC1724.2 +030300 04 XXCOMPUTED PIC X(20). NC1724.2 +030400 04 FILLER PIC X(5) VALUE SPACE. NC1724.2 +030500 04 XXCORRECT PIC X(20). NC1724.2 +030600 02 INF-ANSI-REFERENCE PIC X(48). NC1724.2 +030700 01 HYPHEN-LINE. NC1724.2 +030800 02 FILLER PIC IS X VALUE IS SPACE. NC1724.2 +030900 02 FILLER PIC IS X(65) VALUE IS "************************NC1724.2 +031000- "*****************************************". NC1724.2 +031100 02 FILLER PIC IS X(54) VALUE IS "************************NC1724.2 +031200- "******************************". NC1724.2 +031300 01 CCVS-PGM-ID PIC X(9) VALUE NC1724.2 +031400 "NC172A". NC1724.2 +031500 PROCEDURE DIVISION. NC1724.2 +031600 CCVS1 SECTION. NC1724.2 +031700 OPEN-FILES. NC1724.2 +031800 OPEN OUTPUT PRINT-FILE. NC1724.2 +031900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1724.2 +032000 MOVE SPACE TO TEST-RESULTS. NC1724.2 +032100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1724.2 +032200 GO TO CCVS1-EXIT. NC1724.2 +032300 CLOSE-FILES. NC1724.2 +032400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1724.2 +032500 TERMINATE-CCVS. NC1724.2 +032600*S EXIT PROGRAM. NC1724.2 +032700*SERMINATE-CALL. NC1724.2 +032800 STOP RUN. NC1724.2 +032900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1724.2 +033000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1724.2 +033100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1724.2 +033200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1724.2 +033300 MOVE "****TEST DELETED****" TO RE-MARK. NC1724.2 +033400 PRINT-DETAIL. NC1724.2 +033500 IF REC-CT NOT EQUAL TO ZERO NC1724.2 +033600 MOVE "." TO PARDOT-X NC1724.2 +033700 MOVE REC-CT TO DOTVALUE. NC1724.2 +033800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1724.2 +033900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1724.2 +034000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1724.2 +034100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1724.2 +034200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1724.2 +034300 MOVE SPACE TO CORRECT-X. NC1724.2 +034400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1724.2 +034500 MOVE SPACE TO RE-MARK. NC1724.2 +034600 HEAD-ROUTINE. NC1724.2 +034700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +034800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +034900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1724.2 +035000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1724.2 +035100 COLUMN-NAMES-ROUTINE. NC1724.2 +035200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +035300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +035400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +035500 END-ROUTINE. NC1724.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1724.2 +035700 END-RTN-EXIT. NC1724.2 +035800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +035900 END-ROUTINE-1. NC1724.2 +036000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1724.2 +036100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1724.2 +036200 ADD PASS-COUNTER TO ERROR-HOLD. NC1724.2 +036300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1724.2 +036400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1724.2 +036500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1724.2 +036600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1724.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1724.2 +036800 END-ROUTINE-12. NC1724.2 +036900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1724.2 +037000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1724.2 +037100 MOVE "NO " TO ERROR-TOTAL NC1724.2 +037200 ELSE NC1724.2 +037300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1724.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1724.2 +037500 PERFORM WRITE-LINE. NC1724.2 +037600 END-ROUTINE-13. NC1724.2 +037700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1724.2 +037800 MOVE "NO " TO ERROR-TOTAL ELSE NC1724.2 +037900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1724.2 +038000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1724.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +038200 IF INSPECT-COUNTER EQUAL TO ZERO NC1724.2 +038300 MOVE "NO " TO ERROR-TOTAL NC1724.2 +038400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1724.2 +038500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1724.2 +038600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +038700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1724.2 +038800 WRITE-LINE. NC1724.2 +038900 ADD 1 TO RECORD-COUNT. NC1724.2 +039000 IF RECORD-COUNT GREATER 42 NC1724.2 +039100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1724.2 +039200 MOVE SPACE TO DUMMY-RECORD NC1724.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1724.2 +039400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1724.2 +039500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1724.2 +039600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1724.2 +039700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1724.2 +039800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1724.2 +039900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1724.2 +040000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1724.2 +040100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1724.2 +040200 MOVE ZERO TO RECORD-COUNT. NC1724.2 +040300 PERFORM WRT-LN. NC1724.2 +040400 WRT-LN. NC1724.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1724.2 +040600 MOVE SPACE TO DUMMY-RECORD. NC1724.2 +040700 BLANK-LINE-PRINT. NC1724.2 +040800 PERFORM WRT-LN. NC1724.2 +040900 FAIL-ROUTINE. NC1724.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE NC1724.2 +041100 GO TO FAIL-ROUTINE-WRITE. NC1724.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1724.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1724.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1724.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1724.2 +041700 GO TO FAIL-ROUTINE-EX. NC1724.2 +041800 FAIL-ROUTINE-WRITE. NC1724.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1724.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1724.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1724.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1724.2 +042300 FAIL-ROUTINE-EX. EXIT. NC1724.2 +042400 BAIL-OUT. NC1724.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1724.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1724.2 +042700 BAIL-OUT-WRITE. NC1724.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1724.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1724.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1724.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1724.2 +043200 BAIL-OUT-EX. EXIT. NC1724.2 +043300 CCVS1-EXIT. NC1724.2 +043400 EXIT. NC1724.2 +043500 SECT-NC172A-001 SECTION. NC1724.2 +043600 DIV-INIT-F2-1. NC1724.2 +043700 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1724.2 +043800 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +043900 MOVE 44.1 TO DIV2. NC1724.2 +044000 MOVE ZERO TO DIV8. NC1724.2 +044100 DIV-TEST-F2-0. NC1724.2 +044200 DIVIDE DIV2 INTO 864.36 GIVING DIV8. NC1724.2 +044300 DIV-TEST-F2-1. NC1724.2 +044400 IF DIV8 EQUAL TO 19.6 NC1724.2 +044500 PERFORM PASS NC1724.2 +044600 ELSE NC1724.2 +044700 GO TO DIV-FAIL-F2-1. NC1724.2 +044800 GO TO DIV-WRITE-F2-1. NC1724.2 +044900 DIV-DELETE-F2-1. NC1724.2 +045000 PERFORM DE-LETE. NC1724.2 +045100 GO TO DIV-WRITE-F2-1. NC1724.2 +045200 DIV-FAIL-F2-1. NC1724.2 +045300 PERFORM FAIL. NC1724.2 +045400 MOVE DIV8 TO COMPUTED-N. NC1724.2 +045500 MOVE +19.6 TO CORRECT-N. NC1724.2 +045600 DIV-WRITE-F2-1. NC1724.2 +045700 MOVE "DIV-TEST-F2-1 " TO PAR-NAME. NC1724.2 +045800 PERFORM PRINT-DETAIL. NC1724.2 +045900 DIV-INIT-F2-2. NC1724.2 +046000 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +046100 MOVE 1620.36 TO DIV1. NC1724.2 +046200 MOVE ZERO TO DIV9. NC1724.2 +046300 DIV-TEST-F2-2-0. NC1724.2 +046400 DIVIDE 0.533 INTO DIV1 GIVING DIV9 ROUNDED. NC1724.2 +046500 DIV-TEST-F2-2-1. NC1724.2 +046600 IF DIV9 EQUAL TO " 3,040.1" NC1724.2 +046700 PERFORM PASS NC1724.2 +046800 ELSE NC1724.2 +046900 GO TO DIV-FAIL-F2-2. NC1724.2 +047000 GO TO DIV-WRITE-F2-2. NC1724.2 +047100 DIV-DELETE-F2-2. NC1724.2 +047200 PERFORM DE-LETE. NC1724.2 +047300 GO TO DIV-WRITE-F2-2. NC1724.2 +047400 DIV-FAIL-F2-2. NC1724.2 +047500 PERFORM FAIL. NC1724.2 +047600 MOVE DIV9 TO COMPUTED-A. NC1724.2 +047700 MOVE " 3,040.1" TO CORRECT-A. NC1724.2 +047800 DIV-WRITE-F2-2. NC1724.2 +047900 MOVE "DIV-TEST-F2-2" TO PAR-NAME. NC1724.2 +048000 PERFORM PRINT-DETAIL. NC1724.2 +048100 DIV-INIT-F2-3. NC1724.2 +048200 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +048300 MOVE -9.642 TO DIV4. NC1724.2 +048400 MOVE 44.1 TO DIV2. NC1724.2 +048500 MOVE ZERO TO DIV10. NC1724.2 +048600 MOVE "A" TO XRAY. NC1724.2 +048700 DIV-TEST-F2-3-0. NC1724.2 +048800 DIVIDE DIV4 INTO DIV2 GIVING DIV10 ON SIZE ERROR NC1724.2 +048900 MOVE "P" TO XRAY. NC1724.2 +049000 DIV-TEST-F2-3-1. NC1724.2 +049100 IF XRAY EQUAL TO "P" NC1724.2 +049200 PERFORM PASS NC1724.2 +049300 ELSE NC1724.2 +049400 GO TO DIV-FAIL-F2-3-1. NC1724.2 +049500 GO TO DIV-WRITE-F2-3-1. NC1724.2 +049600 DIV-DELETE-F2-3-1. NC1724.2 +049700 PERFORM DE-LETE. NC1724.2 +049800 GO TO DIV-WRITE-F2-3-1. NC1724.2 +049900 DIV-FAIL-F2-3-1. NC1724.2 +050000 MOVE XRAY TO COMPUTED-X. NC1724.2 +050100 MOVE "A" TO CORRECT-X. NC1724.2 +050200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1724.2 +050300 PERFORM FAIL. NC1724.2 +050400 DIV-WRITE-F2-3-1. NC1724.2 +050500 MOVE "DIV-TEST-F2-3-1" TO PAR-NAME. NC1724.2 +050600 PERFORM PRINT-DETAIL. NC1724.2 +050700 DIV-TEST-F2-3-2. NC1724.2 +050800 IF DIV10 NOT EQUAL TO ZERO NC1724.2 +050900 GO TO DIV-FAIL-F2-3-2. NC1724.2 +051000 PERFORM PASS. NC1724.2 +051100 GO TO DIV-WRITE-F2-3-2. NC1724.2 +051200 DIV-DELETE-F2-3-2. NC1724.2 +051300 PERFORM DE-LETE. NC1724.2 +051400 GO TO DIV-WRITE-F2-3-2. NC1724.2 +051500 DIV-FAIL-F2-3-2. NC1724.2 +051600 PERFORM FAIL. NC1724.2 +051700 MOVE DIV10 TO COMPUTED-N. NC1724.2 +051800 MOVE ZERO TO CORRECT-N. NC1724.2 +051900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1724.2 +052000 DIV-WRITE-F2-3-2. NC1724.2 +052100 MOVE "DIV-TEST-F2-3-2" TO PAR-NAME. NC1724.2 +052200 PERFORM PRINT-DETAIL. NC1724.2 +052300 DIV-INIT-F2-4. NC1724.2 +052400 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +052500 MOVE ZERO TO DIV8. NC1724.2 +052600 MOVE "B" TO XRAY. NC1724.2 +052700 DIV-TEST-F2-4-0. NC1724.2 +052800 DIVIDE 1.0051 INTO 100.50 GIVING DIV8 ROUNDED NC1724.2 +052900 ON SIZE ERROR NC1724.2 +053000 MOVE "Q" TO XRAY. NC1724.2 +053100 DIV-TEST-F2-4-1. NC1724.2 +053200 IF XRAY EQUAL TO "Q" NC1724.2 +053300 PERFORM PASS NC1724.2 +053400 ELSE NC1724.2 +053500 GO TO DIV-FAIL-F2-4-1. NC1724.2 +053600 GO TO DIV-WRITE-F2-4-1. NC1724.2 +053700 DIV-DELETE-F2-4-1. NC1724.2 +053800 PERFORM DE-LETE. NC1724.2 +053900 GO TO DIV-WRITE-F2-4-1. NC1724.2 +054000 DIV-FAIL-F2-4-1. NC1724.2 +054100 MOVE XRAY TO COMPUTED-X. NC1724.2 +054200 MOVE "B" TO COMPUTED-X. NC1724.2 +054300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1724.2 +054400 PERFORM FAIL. NC1724.2 +054500 DIV-WRITE-F2-4-1. NC1724.2 +054600 MOVE "DIV-TEST-F2-4-1" TO PAR-NAME. NC1724.2 +054700 PERFORM PRINT-DETAIL. NC1724.2 +054800 DIV-TEST-F2-4-2. NC1724.2 +054900 IF DIV8 NOT EQUAL TO ZERO NC1724.2 +055000 GO TO DIV-FAIL-F2-4-2. NC1724.2 +055100 PERFORM PASS. NC1724.2 +055200 GO TO DIV-WRITE-F2-4-2. NC1724.2 +055300 DIV-DELETE-F2-4-2. NC1724.2 +055400 PERFORM DE-LETE. NC1724.2 +055500 GO TO DIV-WRITE-F2-4-2. NC1724.2 +055600 DIV-FAIL-F2-4-2. NC1724.2 +055700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1724.2 +055800 PERFORM FAIL. NC1724.2 +055900 MOVE DIV8 TO COMPUTED-N. NC1724.2 +056000 MOVE 000 TO CORRECT-N. NC1724.2 +056100 DIV-WRITE-F2-4-2. NC1724.2 +056200 MOVE "DIV-TEST-F2-4-2" TO PAR-NAME. NC1724.2 +056300 PERFORM PRINT-DETAIL. NC1724.2 +056400 DIV-INIT-F2-5. NC1724.2 +056500 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +056600 MOVE ZERO TO WRK-DS-01V00. NC1724.2 +056700 DIV-TEST-F2-5-0. NC1724.2 +056800 DIVIDE -10.9 INTO A02TWOS-DU-02V00 GIVING WRK-DS-01V00. NC1724.2 +056900 DIV-TEST-F2-5-1. NC1724.2 +057000 IF WRK-DS-01V00 EQUAL TO -2 NC1724.2 +057100 PERFORM PASS NC1724.2 +057200 GO TO DIV-WRITE-F2-5. NC1724.2 +057300 GO TO DIV-FAIL-F2-5. NC1724.2 +057400 DIV-DELETE-F2-5. NC1724.2 +057500 PERFORM DE-LETE. NC1724.2 +057600 GO TO DIV-WRITE-F2-5. NC1724.2 +057700 DIV-FAIL-F2-5. NC1724.2 +057800 MOVE -2 TO CORRECT-N. NC1724.2 +057900 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1724.2 +058000 PERFORM FAIL. NC1724.2 +058100 DIV-WRITE-F2-5. NC1724.2 +058200 MOVE "DIV-TEST-F2-5 " TO PAR-NAME. NC1724.2 +058300 PERFORM PRINT-DETAIL. NC1724.2 +058400 DIV-INIT-F2-6. NC1724.2 +058500 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +058600 MOVE 0.0000000001 TO WRK-DS-03V10. NC1724.2 +058700 MOVE ZERO TO WRK-DS-18V00. NC1724.2 +058800 DIV-TEST-F2-6-0. NC1724.2 +058900 DIVIDE WRK-DS-03V10 INTO A01ONE-DS-P0801 NC1724.2 +059000 GIVING WRK-DS-18V00 ROUNDED. NC1724.2 +059100 DIV-TEST-F2-6-1. NC1724.2 +059200 IF WRK-DS-18V00 EQUAL TO 000000000000000010 NC1724.2 +059300 PERFORM PASS NC1724.2 +059400 GO TO DIV-WRITE-F2-6. NC1724.2 +059500 GO TO DIV-FAIL-F2-6. NC1724.2 +059600 DIV-DELETE-F2-6. NC1724.2 +059700 PERFORM DE-LETE. NC1724.2 +059800 GO TO DIV-WRITE-F2-6. NC1724.2 +059900 DIV-FAIL-F2-6. NC1724.2 +060000 MOVE 000000000000000010 TO CORRECT-18V0. NC1724.2 +060100 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1724.2 +060200 PERFORM FAIL. NC1724.2 +060300 DIV-WRITE-F2-6. NC1724.2 +060400 MOVE "DIV-TEST-F2-6 " TO PAR-NAME. NC1724.2 +060500 PERFORM PRINT-DETAIL. NC1724.2 +060600 DIV-INIT-F2-7. NC1724.2 +060700 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +060800 MOVE ZERO TO WRK-DS-18V00 AZERO-DS-05V05. NC1724.2 +060900 MOVE "0" TO WRK-XN-00001. NC1724.2 +061000 MOVE 99 TO A99-DS-02V00. NC1724.2 +061100 DIV-TEST-F2-7-0. NC1724.2 +061200 DIVIDE AZERO-DS-05V05 INTO A99-DS-02V00 NC1724.2 +061300 GIVING WRK-DS-18V00 ON SIZE ERROR NC1724.2 +061400 MOVE "1" TO WRK-XN-00001. NC1724.2 +061500 DIV-TEST-F2-7-1. NC1724.2 +061600 IF WRK-DS-18V00 EQUAL TO 000000000000000000 NC1724.2 +061700 PERFORM PASS NC1724.2 +061800 GO TO DIV-WRITE-F2-7-1. NC1724.2 +061900 GO TO DIV-FAIL-F2-7-1. NC1724.2 +062000 DIV-DELETE-F2-7-1. NC1724.2 +062100 PERFORM DE-LETE. NC1724.2 +062200 GO TO DIV-WRITE-F2-7-1. NC1724.2 +062300 DIV-FAIL-F2-7-1. NC1724.2 +062400 MOVE 000000000000000000 TO CORRECT-18V0. NC1724.2 +062500 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1724.2 +062600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1724.2 +062700 PERFORM FAIL. NC1724.2 +062800 DIV-WRITE-F2-7-1. NC1724.2 +062900 MOVE "DIV-TEST-F2-7-1 " TO PAR-NAME. NC1724.2 +063000 PERFORM PRINT-DETAIL. NC1724.2 +063100 DIV-TEST-F2-7-2. NC1724.2 +063200 IF WRK-XN-00001 EQUAL TO "1" NC1724.2 +063300 PERFORM PASS NC1724.2 +063400 GO TO DIV-WRITE-F2-7-2. NC1724.2 +063500 MOVE "1" TO CORRECT-A. NC1724.2 +063600 MOVE WRK-XN-00001 TO COMPUTED-A. NC1724.2 +063700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1724.2 +063800 PERFORM FAIL. NC1724.2 +063900 GO TO DIV-WRITE-F2-7-2. NC1724.2 +064000 DIV-DELETE-F2-7-2. NC1724.2 +064100 PERFORM DE-LETE. NC1724.2 +064200 DIV-WRITE-F2-7-2. NC1724.2 +064300 MOVE "DIV-TEST-F2-7-2 " TO PAR-NAME. NC1724.2 +064400 PERFORM PRINT-DETAIL. NC1724.2 +064500 DIV-INIT-F2-8. NC1724.2 +064600 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +064700 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +064800 MOVE "1" TO WRK-XN-00001. NC1724.2 +064900 DIV-TEST-F2-8-0. NC1724.2 +065000 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 GIVING NC1724.2 +065100 WRK-DS-09V09 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1724.2 +065200 DIV-TEST-F2-8-1. NC1724.2 +065300 IF WRK-DS-18V00-S EQUAL TO 000000001000000000 NC1724.2 +065400 PERFORM PASS NC1724.2 +065500 GO TO DIV-WRITE-F2-8-1. NC1724.2 +065600 GO TO DIV-FAIL-F2-8-1. NC1724.2 +065700 DIV-DELETE-F2-8-1. NC1724.2 +065800 PERFORM DE-LETE. NC1724.2 +065900 GO TO DIV-WRITE-F2-8-1. NC1724.2 +066000 DIV-FAIL-F2-8-1. NC1724.2 +066100 MOVE 000000001000000000 TO CORRECT-18V0. NC1724.2 +066200 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1724.2 +066300 PERFORM FAIL. NC1724.2 +066400 DIV-WRITE-F2-8-1. NC1724.2 +066500 MOVE "DIV-TEST-F2-8-1 " TO PAR-NAME. NC1724.2 +066600 PERFORM PRINT-DETAIL. NC1724.2 +066700 DIV-TEST-F2-8-2. NC1724.2 +066800 IF WRK-XN-00001 EQUAL TO "0" NC1724.2 +066900 MOVE "0" TO COMPUTED-A NC1724.2 +067000 MOVE "1" TO CORRECT-A NC1724.2 +067100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1724.2 +067200 PERFORM FAIL NC1724.2 +067300 GO TO DIV-WRITE-F2-8-2. NC1724.2 +067400 PERFORM PASS. NC1724.2 +067500 GO TO DIV-WRITE-F2-8-2. NC1724.2 +067600 DIV-DELETE-F2-8-2. NC1724.2 +067700 PERFORM DE-LETE. NC1724.2 +067800 DIV-WRITE-F2-8-2. NC1724.2 +067900 MOVE "DIV-TEST-F2-8-2 " TO PAR-NAME. NC1724.2 +068000 PERFORM PRINT-DETAIL. NC1724.2 +068100 DIV-INIT-F2-9. NC1724.2 +068200 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +068300 MOVE ZERO TO WRK-DS-0201P. NC1724.2 +068400 MOVE -0.005 TO WRK-DS-09V09. NC1724.2 +068500 MOVE "0" TO WRK-XN-00001. NC1724.2 +068600 DIV-TEST-F2-9-0. NC1724.2 +068700 DIVIDE WRK-DS-09V09 INTO A05ONES-DS-00V05 GIVING NC1724.2 +068800 WRK-DS-0201P ROUNDED ON SIZE ERROR NC1724.2 +068900 MOVE "1" TO WRK-XN-00001. NC1724.2 +069000 DIV-TEST-F2-9-1. NC1724.2 +069100 MOVE WRK-DS-0201P TO WRK-DS-05V00. NC1724.2 +069200 IF WRK-DS-05V00 EQUAL TO -00020 NC1724.2 +069300 PERFORM PASS NC1724.2 +069400 GO TO DIV-WRITE-F2-9-1. NC1724.2 +069500 GO TO DIV-FAIL-F2-9-1. NC1724.2 +069600 DIV-DELETE-F2-9-1. NC1724.2 +069700 PERFORM DE-LETE. NC1724.2 +069800 GO TO DIV-WRITE-F2-9-1. NC1724.2 +069900 DIV-FAIL-F2-9-1. NC1724.2 +070000 MOVE -00020 TO CORRECT-N. NC1724.2 +070100 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1724.2 +070200 PERFORM FAIL. NC1724.2 +070300 DIV-WRITE-F2-9-1. NC1724.2 +070400 MOVE "DIV-TEST-F2-9-1 " TO PAR-NAME. NC1724.2 +070500 PERFORM PRINT-DETAIL. NC1724.2 +070600 DIV-TEST-F2-9-2. NC1724.2 +070700 IF WRK-XN-00001 EQUAL TO "0" NC1724.2 +070800 PERFORM PASS NC1724.2 +070900 GO TO DIV-WRITE-F2-9-2. NC1724.2 +071000 MOVE "0" TO CORRECT-A. NC1724.2 +071100 MOVE WRK-XN-00001 TO COMPUTED-A. NC1724.2 +071200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1724.2 +071300 PERFORM FAIL. NC1724.2 +071400 GO TO DIV-WRITE-F2-9-2. NC1724.2 +071500 DIV-DELETE-F2-9-2. NC1724.2 +071600 PERFORM DE-LETE. NC1724.2 +071700 DIV-WRITE-F2-9-2. NC1724.2 +071800 MOVE "DIV-TEST-F2-9-2 " TO PAR-NAME. NC1724.2 +071900 PERFORM PRINT-DETAIL. NC1724.2 +072000 DIV-INIT-F2-10. NC1724.2 +072100 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +072200 MOVE "1" TO WRK-XN-00001. NC1724.2 +072300 MOVE ZERO TO WRK-DS-01V00. NC1724.2 +072400 DIV-TEST-F2-10-1. NC1724.2 +072500 DIVIDE A02TWOS-DU-02V00 INTO A02TWOS-DS-03V02 GIVING NC1724.2 +072600 WRK-DS-01V00 ROUNDED ON SIZE ERROR NC1724.2 +072700 MOVE "0" TO WRK-XN-00001. NC1724.2 +072800 IF WRK-DS-01V00 EQUAL TO +1 NC1724.2 +072900 PERFORM PASS NC1724.2 +073000 GO TO DIV-WRITE-F2-10-1. NC1724.2 +073100 GO TO DIV-FAIL-F2-10-1. NC1724.2 +073200 DIV-DELETE-F2-10-1. NC1724.2 +073300 PERFORM DE-LETE. NC1724.2 +073400 GO TO DIV-WRITE-F2-10-1. NC1724.2 +073500 DIV-FAIL-F2-10-1. NC1724.2 +073600 MOVE +1 TO CORRECT-N. NC1724.2 +073700 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1724.2 +073800 PERFORM FAIL. NC1724.2 +073900 DIV-WRITE-F2-10-1. NC1724.2 +074000 MOVE "DIV-TEST-F2-10-1 " TO PAR-NAME. NC1724.2 +074100 PERFORM PRINT-DETAIL. NC1724.2 +074200 DIV-TEST-F2-10-2. NC1724.2 +074300 IF WRK-XN-00001 EQUAL TO "1" NC1724.2 +074400 PERFORM PASS NC1724.2 +074500 GO TO DIV-WRITE-F2-10-2. NC1724.2 +074600 MOVE "1" TO CORRECT-A. NC1724.2 +074700 MOVE WRK-XN-00001 TO COMPUTED-A. NC1724.2 +074800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1724.2 +074900 PERFORM FAIL. NC1724.2 +075000 GO TO DIV-WRITE-F2-10-2. NC1724.2 +075100 DIV-DELETE-F2-10-2. NC1724.2 +075200 PERFORM DE-LETE. NC1724.2 +075300 DIV-WRITE-F2-10-2. NC1724.2 +075400 MOVE "DIV-TEST-F2-10-2 " TO PAR-NAME. NC1724.2 +075500 PERFORM PRINT-DETAIL. NC1724.2 +075600 DIV-INIT-F2-11. NC1724.2 +075700 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +075800 MOVE 0 TO WRK-DS-05V00. NC1724.2 +075900 DIV-TEST-F2-11. NC1724.2 +076000 DIVIDE A01ONE-CS-00V01 INTO A99-CS-02V00 GIVING NC1724.2 +076100 WRK-DS-05V00. NC1724.2 +076200 IF WRK-DS-05V00 EQUAL TO 00990 NC1724.2 +076300 PERFORM PASS NC1724.2 +076400 GO TO DIV-WRITE-F2-11. NC1724.2 +076500 GO TO DIV-FAIL-F2-11. NC1724.2 +076600 DIV-DELETE-F2-11. NC1724.2 +076700 PERFORM DE-LETE. NC1724.2 +076800 GO TO DIV-WRITE-F2-11. NC1724.2 +076900 DIV-FAIL-F2-11. NC1724.2 +077000 MOVE 00990 TO CORRECT-N. NC1724.2 +077100 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1724.2 +077200 PERFORM FAIL. NC1724.2 +077300 DIV-WRITE-F2-11. NC1724.2 +077400 MOVE "DIVIDE INTO GIVING " TO FEATURE. NC1724.2 +077500 MOVE "DIV-TEST-F2-11 " TO PAR-NAME. NC1724.2 +077600 PERFORM PRINT-DETAIL. NC1724.2 +077700 DIV-INIT-F2-12. NC1724.2 +077800 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +077900 MOVE ZERO TO WRK-CS-18V00. NC1724.2 +078000 DIV-TEST-F2-12-0. NC1724.2 +078100 DIVIDE A02THREES-CS-18V00 INTO A18SIXES-CU-18V00 GIVING NC1724.2 +078200 WRK-CS-18V00. NC1724.2 +078300 DIV-TEST-F2-12-1. NC1724.2 +078400 IF WRK-CS-18V00 EQUAL TO -020202020202020202 NC1724.2 +078500 PERFORM PASS NC1724.2 +078600 GO TO DIV-WRITE-F2-12. NC1724.2 +078700 MOVE -020202020202020202 TO CORRECT-18V0. NC1724.2 +078800 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1724.2 +078900 PERFORM FAIL. NC1724.2 +079000 GO TO DIV-WRITE-F2-12. NC1724.2 +079100 DIV-DELETE-F2-12. NC1724.2 +079200 PERFORM DE-LETE. NC1724.2 +079300 DIV-WRITE-F2-12. NC1724.2 +079400 MOVE "DIV-TEST-F2-12 " TO PAR-NAME. NC1724.2 +079500 PERFORM PRINT-DETAIL. NC1724.2 +079600 DIV-INIT-F2-13. NC1724.2 +079700 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +079800 MOVE ZERO TO WRK-CS-18V00. NC1724.2 +079900 DIV-TEST-F2-13. NC1724.2 +080000 DIVIDE A02THREES-CS-18V00 INTO A02THREES-CS-18V00 NC1724.2 +080100 GIVING WRK-CS-18V00. NC1724.2 +080200 IF WRK-CS-18V00 EQUAL TO 000000000000000001 NC1724.2 +080300 PERFORM PASS NC1724.2 +080400 GO TO DIV-WRITE-F2-13. NC1724.2 +080500 MOVE 000000000000000001 TO CORRECT-18V0. NC1724.2 +080600 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1724.2 +080700 PERFORM FAIL. NC1724.2 +080800 GO TO DIV-WRITE-F2-13. NC1724.2 +080900 DIV-DELETE-F2-13. NC1724.2 +081000 PERFORM DE-LETE. NC1724.2 +081100 DIV-WRITE-F2-13. NC1724.2 +081200 MOVE "DIV-TEST-F2-13 " TO PAR-NAME. NC1724.2 +081300 PERFORM PRINT-DETAIL. NC1724.2 +081400* NC1724.2 +081500* NC1724.2 +081600 DIV-INIT-F2-14. NC1724.2 +081700* ==--> SIZE ERROR CONDITION <--== NC1724.2 +081800* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +081900 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +082000 MOVE "DIV-TEST-F2-14-1" TO PAR-NAME. NC1724.2 +082100 MOVE "P" TO XRAY. NC1724.2 +082200 MOVE 0 TO DIV10. NC1724.2 +082300 MOVE 1 TO REC-CT. NC1724.2 +082400 MOVE 44.1 TO DIV2. NC1724.2 +082500 MOVE -9.642 TO DIV4. NC1724.2 +082600 DIV-TEST-F2-14-0. NC1724.2 +082700 DIVIDE DIV4 INTO DIV2 NC1724.2 +082800 GIVING DIV10 NC1724.2 +082900 NOT ON SIZE ERROR NC1724.2 +083000 MOVE "N" TO XRAY. NC1724.2 +083100 GO TO DIV-TEST-F2-14-1. NC1724.2 +083200 DIV-DELETE-F2-14-1. NC1724.2 +083300 PERFORM DE-LETE. NC1724.2 +083400 PERFORM PRINT-DETAIL. NC1724.2 +083500 GO TO DIV-INIT-F2-15. NC1724.2 +083600 DIV-TEST-F2-14-1. NC1724.2 +083700 MOVE "DIV-TEST-F2-14-1" TO PAR-NAME. NC1724.2 +083800 IF DIV10 NOT = 0 NC1724.2 +083900 MOVE DIV10 TO COMPUTED-N NC1724.2 +084000 MOVE 0 TO CORRECT-N NC1724.2 +084100 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +084200 PERFORM FAIL NC1724.2 +084300 PERFORM PRINT-DETAIL NC1724.2 +084400 ELSE NC1724.2 +084500 PERFORM PASS NC1724.2 +084600 PERFORM PRINT-DETAIL. NC1724.2 +084700 ADD 1 TO REC-CT. NC1724.2 +084800 DIV-TEST-F2-14-2. NC1724.2 +084900 MOVE "DIV-TEST-F2-14-2" TO PAR-NAME. NC1724.2 +085000 IF XRAY NOT = "P" NC1724.2 +085100 MOVE XRAY TO COMPUTED-X NC1724.2 +085200 MOVE "P" TO CORRECT-X NC1724.2 +085300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +085400 PERFORM FAIL NC1724.2 +085500 PERFORM PRINT-DETAIL NC1724.2 +085600 ELSE NC1724.2 +085700 PERFORM PASS NC1724.2 +085800 PERFORM PRINT-DETAIL. NC1724.2 +085900* NC1724.2 +086000* NC1724.2 +086100 DIV-INIT-F2-15. NC1724.2 +086200* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +086300* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +086400 MOVE "DIV-TEST-F2-15-1" TO PAR-NAME. NC1724.2 +086500 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +086600 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +086700 MOVE 1 TO REC-CT. NC1724.2 +086800 MOVE "1" TO WRK-XN-00001. NC1724.2 +086900 DIV-TEST-F2-15-0. NC1724.2 +087000 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +087100 GIVING WRK-DS-09V09 NC1724.2 +087200 NOT ON SIZE ERROR NC1724.2 +087300 MOVE "0" TO WRK-XN-00001. NC1724.2 +087400 GO TO DIV-TEST-F2-15-1. NC1724.2 +087500 DIV-DELETE-F2-15-1. NC1724.2 +087600 PERFORM DE-LETE. NC1724.2 +087700 PERFORM PRINT-DETAIL. NC1724.2 +087800 GO TO DIV-INIT-F2-16. NC1724.2 +087900 DIV-TEST-F2-15-1. NC1724.2 +088000 MOVE "DIV-TEST-F2-15-1 " TO PAR-NAME. NC1724.2 +088100 IF WRK-DS-18V00-S NOT = 000000001000000000 NC1724.2 +088200 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +088300 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1724.2 +088400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1724.2 +088500 TO RE-MARK NC1724.2 +088600 PERFORM FAIL NC1724.2 +088700 PERFORM PRINT-DETAIL NC1724.2 +088800 ELSE NC1724.2 +088900 PERFORM PASS NC1724.2 +089000 PERFORM PRINT-DETAIL. NC1724.2 +089100 ADD 1 TO REC-CT. NC1724.2 +089200 DIV-TEST-F2-15-2. NC1724.2 +089300 MOVE "DIV-TEST-F2-15-2" TO PAR-NAME. NC1724.2 +089400 IF WRK-XN-00001 NOT = "0" NC1724.2 +089500 MOVE "0" TO CORRECT-X NC1724.2 +089600 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +089700 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +089800 TO RE-MARK NC1724.2 +089900 PERFORM FAIL NC1724.2 +090000 PERFORM PRINT-DETAIL NC1724.2 +090100 ELSE NC1724.2 +090200 PERFORM PASS NC1724.2 +090300 PERFORM PRINT-DETAIL. NC1724.2 +090400* NC1724.2 +090500* NC1724.2 +090600 DIV-INIT-F2-16. NC1724.2 +090700* ==--> SIZE ERROR CONDITION <--== NC1724.2 +090800* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +090900 MOVE "DIV-TEST-F2-16-1" TO PAR-NAME. NC1724.2 +091000 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +091100 MOVE "P" TO XRAY. NC1724.2 +091200 MOVE 0 TO DIV10. NC1724.2 +091300 MOVE 1 TO REC-CT. NC1724.2 +091400 MOVE 44.1 TO DIV2. NC1724.2 +091500 MOVE -9.642 TO DIV4. NC1724.2 +091600 DIV-TEST-F2-16-0. NC1724.2 +091700 DIVIDE DIV4 INTO DIV2 NC1724.2 +091800 GIVING DIV10 NC1724.2 +091900 ON SIZE ERROR NC1724.2 +092000 MOVE "E" TO XRAY NC1724.2 +092100 NOT ON SIZE ERROR NC1724.2 +092200 MOVE "N" TO XRAY. NC1724.2 +092300 GO TO DIV-TEST-F2-16-1. NC1724.2 +092400 DIV-DELETE-F2-16-1. NC1724.2 +092500 PERFORM DE-LETE. NC1724.2 +092600 PERFORM PRINT-DETAIL. NC1724.2 +092700 GO TO DIV-INIT-F2-17. NC1724.2 +092800 DIV-TEST-F2-16-1. NC1724.2 +092900 MOVE "DIV-TEST-F2-16-1" TO PAR-NAME. NC1724.2 +093000 IF DIV10 NOT = 0 NC1724.2 +093100 MOVE DIV10 TO COMPUTED-N NC1724.2 +093200 MOVE 0 TO CORRECT-N NC1724.2 +093300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +093400 PERFORM FAIL NC1724.2 +093500 PERFORM PRINT-DETAIL NC1724.2 +093600 ELSE NC1724.2 +093700 PERFORM PASS NC1724.2 +093800 PERFORM PRINT-DETAIL. NC1724.2 +093900 ADD 1 TO REC-CT. NC1724.2 +094000 DIV-TEST-F2-16-2. NC1724.2 +094100 MOVE "DIV-TEST-F2-16-2" TO PAR-NAME. NC1724.2 +094200 IF XRAY NOT = "E" NC1724.2 +094300 MOVE XRAY TO COMPUTED-X NC1724.2 +094400 MOVE "E" TO CORRECT-X NC1724.2 +094500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +094600 PERFORM FAIL NC1724.2 +094700 PERFORM PRINT-DETAIL NC1724.2 +094800 ELSE NC1724.2 +094900 PERFORM PASS NC1724.2 +095000 PERFORM PRINT-DETAIL. NC1724.2 +095100* NC1724.2 +095200* NC1724.2 +095300 DIV-INIT-F2-17. NC1724.2 +095400* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +095500* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +095600 MOVE "DIV-TEST-F2-17-1" TO PAR-NAME. NC1724.2 +095700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +095800 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +095900 MOVE "0" TO WRK-XN-00001. NC1724.2 +096000 MOVE 1 TO REC-CT. NC1724.2 +096100 DIV-TEST-F2-17-0. NC1724.2 +096200 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +096300 GIVING WRK-DS-09V09 NC1724.2 +096400 ON SIZE ERROR NC1724.2 +096500 MOVE "1" TO WRK-XN-00001 NC1724.2 +096600 NOT ON SIZE ERROR NC1724.2 +096700 MOVE "2" TO WRK-XN-00001. NC1724.2 +096800 GO TO DIV-TEST-F2-17-1. NC1724.2 +096900 DIV-DELETE-F2-17-1. NC1724.2 +097000 PERFORM DE-LETE. NC1724.2 +097100 PERFORM PRINT-DETAIL. NC1724.2 +097200 GO TO DIV-INIT-F2-18. NC1724.2 +097300 DIV-TEST-F2-17-1. NC1724.2 +097400 MOVE "DIV-TEST-F2-17-1" TO PAR-NAME. NC1724.2 +097500 IF WRK-DS-18V00-S NOT = 000000001000000000 NC1724.2 +097600 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +097700 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1724.2 +097800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1724.2 +097900 TO RE-MARK NC1724.2 +098000 PERFORM FAIL NC1724.2 +098100 PERFORM PRINT-DETAIL NC1724.2 +098200 ELSE NC1724.2 +098300 PERFORM PASS NC1724.2 +098400 PERFORM PRINT-DETAIL. NC1724.2 +098500 ADD 1 TO REC-CT. NC1724.2 +098600 DIV-TEST-F2-17-2. NC1724.2 +098700 MOVE "DIV-TEST-F2-17-2" TO PAR-NAME. NC1724.2 +098800 IF WRK-XN-00001 NOT = "2" NC1724.2 +098900 MOVE "2" TO CORRECT-X NC1724.2 +099000 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +099100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +099200 TO RE-MARK NC1724.2 +099300 PERFORM FAIL NC1724.2 +099400 PERFORM PRINT-DETAIL NC1724.2 +099500 ELSE NC1724.2 +099600 PERFORM PASS NC1724.2 +099700 PERFORM PRINT-DETAIL. NC1724.2 +099800* NC1724.2 +099900* NC1724.2 +100000 DIV-INIT-F2-18. NC1724.2 +100100 MOVE "DIVIDE-INTO-GIVING" TO FEATURE. NC1724.2 +100200* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +100300* ==--> MULTIPLE RESULT FIELDS <--== NC1724.2 +100400 MOVE "DIV-TEST-F2-18" TO PAR-NAME. NC1724.2 +100500 MOVE "V1-81 6.11.4 GR2" TO ANSI-REFERENCE. NC1724.2 +100600 MOVE 1 TO REC-CT. NC1724.2 +100700 MOVE 10 TO WRK-DU-2V0-1. NC1724.2 +100800 MOVE 3.9 TO WRK-DU-1V1-2. NC1724.2 +100900 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +101000 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +101100 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +101200 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +101300 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +101400 DIV-TEST-F2-18-0. NC1724.2 +101500 DIVIDE WRK-DU-1V1-2 INTO WRK-DU-2V0-1 NC1724.2 +101600 GIVING WRK-DU-2V1-1 NC1724.2 +101700 WRK-DU-2V0-1 ROUNDED NC1724.2 +101800 WRK-DU-2V1-2 NC1724.2 +101900 WRK-DU-2V0-2 ROUNDED NC1724.2 +102000 WRK-DU-2V1-3 NC1724.2 +102100 WRK-DU-2V0-3. NC1724.2 +102200 GO TO DIV-TEST-F2-18-1. NC1724.2 +102300 DIV-DELETE-F2-18. NC1724.2 +102400 PERFORM DE-LETE. NC1724.2 +102500 PERFORM PRINT-DETAIL. NC1724.2 +102600 GO TO DIV-INIT-F2-19. NC1724.2 +102700 DIV-TEST-F2-18-1. NC1724.2 +102800 IF WRK-DU-2V1-1 = 2.5 NC1724.2 +102900 PERFORM PASS NC1724.2 +103000 PERFORM PRINT-DETAIL NC1724.2 +103100 ELSE NC1724.2 +103200 PERFORM FAIL NC1724.2 +103300 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +103400 MOVE 2.5 TO CORRECT-N NC1724.2 +103500 PERFORM PRINT-DETAIL. NC1724.2 +103600 ADD 1 TO REC-CT. NC1724.2 +103700 DIV-TEST-F2-18-2. NC1724.2 +103800 IF WRK-DU-2V0-1 = 3 NC1724.2 +103900 PERFORM PASS NC1724.2 +104000 PERFORM PRINT-DETAIL NC1724.2 +104100 ELSE NC1724.2 +104200 PERFORM FAIL NC1724.2 +104300 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +104400 MOVE 3 TO CORRECT-N NC1724.2 +104500 PERFORM PRINT-DETAIL. NC1724.2 +104600 ADD 1 TO REC-CT. NC1724.2 +104700 DIV-TEST-F2-18-3. NC1724.2 +104800 IF WRK-DU-2V1-2 = 2.5 NC1724.2 +104900 PERFORM PASS NC1724.2 +105000 PERFORM PRINT-DETAIL NC1724.2 +105100 ELSE NC1724.2 +105200 PERFORM FAIL NC1724.2 +105300 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +105400 MOVE 2.5 TO CORRECT-N NC1724.2 +105500 PERFORM PRINT-DETAIL. NC1724.2 +105600 ADD 1 TO REC-CT. NC1724.2 +105700 DIV-TEST-F2-18-4. NC1724.2 +105800 IF WRK-DU-2V0-2 = 3 NC1724.2 +105900 PERFORM PASS NC1724.2 +106000 PERFORM PRINT-DETAIL NC1724.2 +106100 ELSE NC1724.2 +106200 PERFORM FAIL NC1724.2 +106300 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +106400 MOVE 3 TO CORRECT-N NC1724.2 +106500 PERFORM PRINT-DETAIL. NC1724.2 +106600 ADD 1 TO REC-CT. NC1724.2 +106700 DIV-TEST-F2-18-5. NC1724.2 +106800 IF WRK-DU-2V1-3 = 2.5 NC1724.2 +106900 PERFORM PASS NC1724.2 +107000 PERFORM PRINT-DETAIL NC1724.2 +107100 ELSE NC1724.2 +107200 PERFORM FAIL NC1724.2 +107300 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +107400 MOVE 2.5 TO CORRECT-N NC1724.2 +107500 PERFORM PRINT-DETAIL. NC1724.2 +107600 ADD 1 TO REC-CT. NC1724.2 +107700 DIV-TEST-F2-18-6. NC1724.2 +107800 IF WRK-DU-2V0-3 = 2 NC1724.2 +107900 PERFORM PASS NC1724.2 +108000 PERFORM PRINT-DETAIL NC1724.2 +108100 ELSE NC1724.2 +108200 PERFORM FAIL NC1724.2 +108300 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +108400 MOVE 2 TO CORRECT-N NC1724.2 +108500 PERFORM PRINT-DETAIL. NC1724.2 +108600* NC1724.2 +108700* NC1724.2 +108800 DIV-INIT-F2-19. NC1724.2 +108900* ==--> SIZE ERROR CONDITION <--== NC1724.2 +109000* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +109100 MOVE "DIV-TEST-F2-19" TO PAR-NAME. NC1724.2 +109200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +109300 MOVE "0" TO WRK-XN-00001. NC1724.2 +109400 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +109500 MOVE 0 TO WRK-DU-2V0-1. NC1724.2 +109600 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +109700 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +109800 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +109900 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +110000 MOVE 1 TO REC-CT. NC1724.2 +110100 MOVE 99 TO WRK-DU-2V0-1. NC1724.2 +110200 MOVE .1 TO A01ONE-CS-00V01. NC1724.2 +110300 DIV-TEST-F2-19-0. NC1724.2 +110400 DIVIDE A01ONE-CS-00V01 INTO WRK-DU-2V0-1 NC1724.2 +110500 GIVING WRK-DU-2V1-1 NC1724.2 +110600 WRK-DU-2V0-1 ROUNDED NC1724.2 +110700 WRK-DU-2V1-2 NC1724.2 +110800 WRK-DU-2V0-2 ROUNDED NC1724.2 +110900 WRK-DU-2V1-3 NC1724.2 +111000 WRK-DU-2V0-3 NC1724.2 +111100 ON SIZE ERROR NC1724.2 +111200 MOVE "1" TO WRK-XN-00001. NC1724.2 +111300 GO TO DIV-TEST-F2-19-1. NC1724.2 +111400 DIV-DELETE-F2-19. NC1724.2 +111500 PERFORM DE-LETE. NC1724.2 +111600 PERFORM PRINT-DETAIL. NC1724.2 +111700 GO TO DIV-INIT-F2-20. NC1724.2 +111800 DIV-TEST-F2-19-1. NC1724.2 +111900 IF WRK-DU-2V1-1 = 0 NC1724.2 +112000 PERFORM PASS NC1724.2 +112100 PERFORM PRINT-DETAIL NC1724.2 +112200 ELSE NC1724.2 +112300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +112400 PERFORM FAIL NC1724.2 +112500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +112600 MOVE 0 TO CORRECT-N NC1724.2 +112700 PERFORM PRINT-DETAIL. NC1724.2 +112800 ADD 1 TO REC-CT. NC1724.2 +112900 DIV-TEST-F2-19-2. NC1724.2 +113000 IF WRK-DU-2V0-1 = 99 NC1724.2 +113100 PERFORM PASS NC1724.2 +113200 PERFORM PRINT-DETAIL NC1724.2 +113300 ELSE NC1724.2 +113400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +113500 PERFORM FAIL NC1724.2 +113600 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +113700 MOVE 99 TO CORRECT-N NC1724.2 +113800 PERFORM PRINT-DETAIL. NC1724.2 +113900 ADD 1 TO REC-CT. NC1724.2 +114000 DIV-TEST-F2-19-3. NC1724.2 +114100 IF WRK-DU-2V1-2 = 0 NC1724.2 +114200 PERFORM PASS NC1724.2 +114300 PERFORM PRINT-DETAIL NC1724.2 +114400 ELSE NC1724.2 +114500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +114600 PERFORM FAIL NC1724.2 +114700 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +114800 MOVE 0 TO CORRECT-N NC1724.2 +114900 PERFORM PRINT-DETAIL. NC1724.2 +115000 ADD 1 TO REC-CT. NC1724.2 +115100 DIV-TEST-F2-19-4. NC1724.2 +115200 IF WRK-DU-2V0-2 = 0 NC1724.2 +115300 PERFORM PASS NC1724.2 +115400 PERFORM PRINT-DETAIL NC1724.2 +115500 ELSE NC1724.2 +115600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +115700 PERFORM FAIL NC1724.2 +115800 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +115900 MOVE 0 TO CORRECT-N NC1724.2 +116000 PERFORM PRINT-DETAIL. NC1724.2 +116100 ADD 1 TO REC-CT. NC1724.2 +116200 DIV-TEST-F2-19-5. NC1724.2 +116300 IF WRK-DU-2V1-3 = 0 NC1724.2 +116400 PERFORM PASS NC1724.2 +116500 PERFORM PRINT-DETAIL NC1724.2 +116600 ELSE NC1724.2 +116700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +116800 PERFORM FAIL NC1724.2 +116900 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +117000 MOVE 0 TO CORRECT-N NC1724.2 +117100 PERFORM PRINT-DETAIL. NC1724.2 +117200 ADD 1 TO REC-CT. NC1724.2 +117300 DIV-TEST-F2-19-6. NC1724.2 +117400 IF WRK-DU-2V0-3 = 0 NC1724.2 +117500 PERFORM PASS NC1724.2 +117600 PERFORM PRINT-DETAIL NC1724.2 +117700 ELSE NC1724.2 +117800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +117900 PERFORM FAIL NC1724.2 +118000 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +118100 MOVE 0 TO CORRECT-N NC1724.2 +118200 PERFORM PRINT-DETAIL. NC1724.2 +118300 ADD 1 TO REC-CT. NC1724.2 +118400 DIV-TEST-F2-19-7. NC1724.2 +118500 IF WRK-XN-00001 = "1" NC1724.2 +118600 PERFORM PASS NC1724.2 +118700 PERFORM PRINT-DETAIL NC1724.2 +118800 ELSE NC1724.2 +118900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +119000 PERFORM FAIL NC1724.2 +119100 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +119200 MOVE "1" TO CORRECT-X NC1724.2 +119300 PERFORM PRINT-DETAIL. NC1724.2 +119400* NC1724.2 +119500* NC1724.2 +119600 DIV-INIT-F2-20. NC1724.2 +119700* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +119800* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +119900 MOVE "DIV-TEST-F2-20" TO PAR-NAME. NC1724.2 +120000 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +120100 MOVE "0" TO WRK-XN-00001. NC1724.2 +120200 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +120300 MOVE 0 TO WRK-DU-2V0-1. NC1724.2 +120400 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +120500 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +120600 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +120700 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +120800 MOVE 10 TO WRK-DU-2V0-1. NC1724.2 +120900 MOVE 3.9 TO WRK-DU-1V1-2. NC1724.2 +121000 MOVE 1 TO REC-CT. NC1724.2 +121100 DIV-TEST-F2-20-0. NC1724.2 +121200 DIVIDE WRK-DU-1V1-2 INTO WRK-DU-2V0-1 NC1724.2 +121300 GIVING WRK-DU-2V1-1 NC1724.2 +121400 WRK-DU-2V0-1 ROUNDED NC1724.2 +121500 WRK-DU-2V1-2 NC1724.2 +121600 WRK-DU-2V0-2 ROUNDED NC1724.2 +121700 WRK-DU-2V1-3 NC1724.2 +121800 WRK-DU-2V0-3 NC1724.2 +121900 ON SIZE ERROR NC1724.2 +122000 MOVE "1" TO WRK-XN-00001. NC1724.2 +122100 GO TO DIV-TEST-F2-20-1. NC1724.2 +122200 DIV-DELETE-F2-20. NC1724.2 +122300 PERFORM DE-LETE. NC1724.2 +122400 PERFORM PRINT-DETAIL. NC1724.2 +122500 GO TO DIV-INIT-F2-21. NC1724.2 +122600 DIV-TEST-F2-20-1. NC1724.2 +122700 IF WRK-DU-2V1-1 = 2.5 NC1724.2 +122800 PERFORM PASS NC1724.2 +122900 PERFORM PRINT-DETAIL NC1724.2 +123000 ELSE NC1724.2 +123100 PERFORM FAIL NC1724.2 +123200 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +123300 MOVE 2.5 TO CORRECT-N NC1724.2 +123400 PERFORM PRINT-DETAIL. NC1724.2 +123500 ADD 1 TO REC-CT. NC1724.2 +123600 DIV-TEST-F2-20-2. NC1724.2 +123700 IF WRK-DU-2V0-1 = 3 NC1724.2 +123800 PERFORM PASS NC1724.2 +123900 PERFORM PRINT-DETAIL NC1724.2 +124000 ELSE NC1724.2 +124100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +124200 PERFORM FAIL NC1724.2 +124300 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +124400 MOVE 3 TO CORRECT-N NC1724.2 +124500 PERFORM PRINT-DETAIL. NC1724.2 +124600 ADD 1 TO REC-CT. NC1724.2 +124700 DIV-TEST-F2-20-3. NC1724.2 +124800 IF WRK-DU-2V1-2 = 2.5 NC1724.2 +124900 PERFORM PASS NC1724.2 +125000 PERFORM PRINT-DETAIL NC1724.2 +125100 ELSE NC1724.2 +125200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +125300 PERFORM FAIL NC1724.2 +125400 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +125500 MOVE 2.5 TO CORRECT-N NC1724.2 +125600 PERFORM PRINT-DETAIL. NC1724.2 +125700 ADD 1 TO REC-CT. NC1724.2 +125800 DIV-TEST-F2-20-4. NC1724.2 +125900 IF WRK-DU-2V0-2 = 3 NC1724.2 +126000 PERFORM PASS NC1724.2 +126100 PERFORM PRINT-DETAIL NC1724.2 +126200 ELSE NC1724.2 +126300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +126400 PERFORM FAIL NC1724.2 +126500 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +126600 MOVE 3 TO CORRECT-N NC1724.2 +126700 PERFORM PRINT-DETAIL. NC1724.2 +126800 ADD 1 TO REC-CT. NC1724.2 +126900 DIV-TEST-F2-20-5. NC1724.2 +127000 IF WRK-DU-2V1-3 = 2.5 NC1724.2 +127100 PERFORM PASS NC1724.2 +127200 PERFORM PRINT-DETAIL NC1724.2 +127300 ELSE NC1724.2 +127400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +127500 PERFORM FAIL NC1724.2 +127600 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +127700 MOVE 2.5 TO CORRECT-N NC1724.2 +127800 PERFORM PRINT-DETAIL. NC1724.2 +127900 ADD 1 TO REC-CT. NC1724.2 +128000 DIV-TEST-F2-20-6. NC1724.2 +128100 IF WRK-DU-2V0-3 = 2 NC1724.2 +128200 PERFORM PASS NC1724.2 +128300 PERFORM PRINT-DETAIL NC1724.2 +128400 ELSE NC1724.2 +128500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +128600 PERFORM FAIL NC1724.2 +128700 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +128800 MOVE 2 TO CORRECT-N NC1724.2 +128900 PERFORM PRINT-DETAIL. NC1724.2 +129000 ADD 1 TO REC-CT. NC1724.2 +129100 DIV-TEST-F2-20-7. NC1724.2 +129200 IF WRK-XN-00001 = "0" NC1724.2 +129300 PERFORM PASS NC1724.2 +129400 PERFORM PRINT-DETAIL NC1724.2 +129500 ELSE NC1724.2 +129600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +129700 TO RE-MARK NC1724.2 +129800 PERFORM FAIL NC1724.2 +129900 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +130000 MOVE "0" TO CORRECT-X NC1724.2 +130100 PERFORM PRINT-DETAIL. NC1724.2 +130200* NC1724.2 +130300* NC1724.2 +130400 DIV-INIT-F2-21. NC1724.2 +130500* ==--> SIZE ERROR CONDITION <--== NC1724.2 +130600* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +130700 MOVE "DIV-TEST-F2-21" TO PAR-NAME. NC1724.2 +130800 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +130900 MOVE "0" TO WRK-XN-00001. NC1724.2 +131000 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +131100 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +131200 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +131300 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +131400 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +131500 MOVE 99 TO WRK-DU-2V0-1. NC1724.2 +131600 MOVE 1 TO REC-CT. NC1724.2 +131700 DIV-TEST-F2-21-0. NC1724.2 +131800 DIVIDE A01ONE-CS-00V01 INTO WRK-DU-2V0-1 NC1724.2 +131900 GIVING WRK-DU-2V1-1 NC1724.2 +132000 WRK-DU-2V0-1 ROUNDED NC1724.2 +132100 WRK-DU-2V1-2 NC1724.2 +132200 WRK-DU-2V0-2 ROUNDED NC1724.2 +132300 WRK-DU-2V1-3 NC1724.2 +132400 WRK-DU-2V0-3 NC1724.2 +132500 NOT ON SIZE ERROR NC1724.2 +132600 MOVE "1" TO WRK-XN-00001. NC1724.2 +132700 GO TO DIV-TEST-F2-21-1. NC1724.2 +132800 DIV-DELETE-F2-21. NC1724.2 +132900 PERFORM DE-LETE. NC1724.2 +133000 PERFORM PRINT-DETAIL. NC1724.2 +133100 GO TO DIV-INIT-F2-22. NC1724.2 +133200 DIV-TEST-F2-21-1. NC1724.2 +133300 IF WRK-DU-2V1-1 = 0 NC1724.2 +133400 PERFORM PASS NC1724.2 +133500 PERFORM PRINT-DETAIL NC1724.2 +133600 ELSE NC1724.2 +133700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +133800 PERFORM FAIL NC1724.2 +133900 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +134000 MOVE 0 TO CORRECT-N NC1724.2 +134100 PERFORM PRINT-DETAIL. NC1724.2 +134200 ADD 1 TO REC-CT. NC1724.2 +134300 DIV-TEST-F2-21-2. NC1724.2 +134400 IF WRK-DU-2V0-1 = 99 NC1724.2 +134500 PERFORM PASS NC1724.2 +134600 PERFORM PRINT-DETAIL NC1724.2 +134700 ELSE NC1724.2 +134800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +134900 PERFORM FAIL NC1724.2 +135000 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +135100 MOVE 99 TO CORRECT-N NC1724.2 +135200 PERFORM PRINT-DETAIL. NC1724.2 +135300 ADD 1 TO REC-CT. NC1724.2 +135400 DIV-TEST-F2-21-3. NC1724.2 +135500 IF WRK-DU-2V1-2 = 0 NC1724.2 +135600 PERFORM PASS NC1724.2 +135700 PERFORM PRINT-DETAIL NC1724.2 +135800 ELSE NC1724.2 +135900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +136000 PERFORM FAIL NC1724.2 +136100 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +136200 MOVE 0 TO CORRECT-N NC1724.2 +136300 PERFORM PRINT-DETAIL. NC1724.2 +136400 ADD 1 TO REC-CT. NC1724.2 +136500 DIV-TEST-F2-21-4. NC1724.2 +136600 IF WRK-DU-2V0-2 = 0 NC1724.2 +136700 PERFORM PASS NC1724.2 +136800 PERFORM PRINT-DETAIL NC1724.2 +136900 ELSE NC1724.2 +137000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +137100 PERFORM FAIL NC1724.2 +137200 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +137300 MOVE 0 TO CORRECT-N NC1724.2 +137400 PERFORM PRINT-DETAIL. NC1724.2 +137500 ADD 1 TO REC-CT. NC1724.2 +137600 DIV-TEST-F2-21-5. NC1724.2 +137700 IF WRK-DU-2V1-3 = 0 NC1724.2 +137800 PERFORM PASS NC1724.2 +137900 PERFORM PRINT-DETAIL NC1724.2 +138000 ELSE NC1724.2 +138100 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +138200 PERFORM FAIL NC1724.2 +138300 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +138400 MOVE 0 TO CORRECT-N NC1724.2 +138500 PERFORM PRINT-DETAIL. NC1724.2 +138600 ADD 1 TO REC-CT. NC1724.2 +138700 DIV-TEST-F2-21-6. NC1724.2 +138800 IF WRK-DU-2V0-3 = 0 NC1724.2 +138900 PERFORM PASS NC1724.2 +139000 PERFORM PRINT-DETAIL NC1724.2 +139100 ELSE NC1724.2 +139200 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +139300 PERFORM FAIL NC1724.2 +139400 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +139500 MOVE 0 TO CORRECT-N NC1724.2 +139600 PERFORM PRINT-DETAIL. NC1724.2 +139700 ADD 1 TO REC-CT. NC1724.2 +139800 DIV-TEST-F2-21-7. NC1724.2 +139900 IF WRK-XN-00001 = "0" NC1724.2 +140000 PERFORM PASS NC1724.2 +140100 PERFORM PRINT-DETAIL NC1724.2 +140200 ELSE NC1724.2 +140300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +140400 TO RE-MARK NC1724.2 +140500 PERFORM FAIL NC1724.2 +140600 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +140700 MOVE "0" TO CORRECT-X NC1724.2 +140800 PERFORM PRINT-DETAIL. NC1724.2 +140900* NC1724.2 +141000* NC1724.2 +141100 DIV-INIT-F2-22. NC1724.2 +141200* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +141300* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +141400 MOVE "DIV-TEST-F2-22" TO PAR-NAME. NC1724.2 +141500 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +141600 MOVE "0" TO WRK-XN-00001. NC1724.2 +141700 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +141800 MOVE 0 TO WRK-DU-2V0-1. NC1724.2 +141900 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +142000 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +142100 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +142200 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +142300 MOVE 1 TO REC-CT. NC1724.2 +142400 MOVE 10 TO WRK-DU-2V0-1. NC1724.2 +142500 MOVE 3.9 TO WRK-DU-1V1-2. NC1724.2 +142600 DIV-TEST-F2-22-0. NC1724.2 +142700 DIVIDE WRK-DU-1V1-2 INTO WRK-DU-2V0-1 NC1724.2 +142800 GIVING WRK-DU-2V1-1 NC1724.2 +142900 WRK-DU-2V0-1 ROUNDED NC1724.2 +143000 WRK-DU-2V1-2 NC1724.2 +143100 WRK-DU-2V0-2 ROUNDED NC1724.2 +143200 WRK-DU-2V1-3 NC1724.2 +143300 WRK-DU-2V0-3 NC1724.2 +143400 NOT ON SIZE ERROR NC1724.2 +143500 MOVE "1" TO WRK-XN-00001. NC1724.2 +143600 GO TO DIV-TEST-F2-22-1. NC1724.2 +143700 DIV-DELETE-F2-22. NC1724.2 +143800 PERFORM DE-LETE. NC1724.2 +143900 PERFORM PRINT-DETAIL. NC1724.2 +144000 GO TO DIV-INIT-F2-23. NC1724.2 +144100 DIV-TEST-F2-22-1. NC1724.2 +144200 IF WRK-DU-2V1-1 = 2.5 NC1724.2 +144300 PERFORM PASS NC1724.2 +144400 PERFORM PRINT-DETAIL NC1724.2 +144500 ELSE NC1724.2 +144600 PERFORM FAIL NC1724.2 +144700 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +144800 MOVE 2.5 TO CORRECT-N NC1724.2 +144900 PERFORM PRINT-DETAIL. NC1724.2 +145000 ADD 1 TO REC-CT. NC1724.2 +145100 DIV-TEST-F2-22-2. NC1724.2 +145200 IF WRK-DU-2V0-1 = 3 NC1724.2 +145300 PERFORM PASS NC1724.2 +145400 PERFORM PRINT-DETAIL NC1724.2 +145500 ELSE NC1724.2 +145600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +145700 PERFORM FAIL NC1724.2 +145800 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +145900 MOVE 3 TO CORRECT-N NC1724.2 +146000 PERFORM PRINT-DETAIL. NC1724.2 +146100 ADD 1 TO REC-CT. NC1724.2 +146200 DIV-TEST-F2-22-3. NC1724.2 +146300 IF WRK-DU-2V1-2 = 2.5 NC1724.2 +146400 PERFORM PASS NC1724.2 +146500 PERFORM PRINT-DETAIL NC1724.2 +146600 ELSE NC1724.2 +146700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +146800 PERFORM FAIL NC1724.2 +146900 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +147000 MOVE 2.5 TO CORRECT-N NC1724.2 +147100 PERFORM PRINT-DETAIL. NC1724.2 +147200 ADD 1 TO REC-CT. NC1724.2 +147300 DIV-TEST-F2-22-4. NC1724.2 +147400 IF WRK-DU-2V0-2 = 3 NC1724.2 +147500 PERFORM PASS NC1724.2 +147600 PERFORM PRINT-DETAIL NC1724.2 +147700 ELSE NC1724.2 +147800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +147900 PERFORM FAIL NC1724.2 +148000 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +148100 MOVE 3 TO CORRECT-N NC1724.2 +148200 PERFORM PRINT-DETAIL. NC1724.2 +148300 ADD 1 TO REC-CT. NC1724.2 +148400 DIV-TEST-F2-22-5. NC1724.2 +148500 IF WRK-DU-2V1-3 = 2.5 NC1724.2 +148600 PERFORM PASS NC1724.2 +148700 PERFORM PRINT-DETAIL NC1724.2 +148800 ELSE NC1724.2 +148900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +149000 PERFORM FAIL NC1724.2 +149100 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +149200 MOVE 2.5 TO CORRECT-N NC1724.2 +149300 PERFORM PRINT-DETAIL. NC1724.2 +149400 ADD 1 TO REC-CT. NC1724.2 +149500 DIV-TEST-F2-22-6. NC1724.2 +149600 IF WRK-DU-2V0-3 = 2 NC1724.2 +149700 PERFORM PASS NC1724.2 +149800 PERFORM PRINT-DETAIL NC1724.2 +149900 ELSE NC1724.2 +150000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +150100 PERFORM FAIL NC1724.2 +150200 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +150300 MOVE 2 TO CORRECT-N NC1724.2 +150400 PERFORM PRINT-DETAIL. NC1724.2 +150500 ADD 1 TO REC-CT. NC1724.2 +150600 DIV-TEST-F2-22-7. NC1724.2 +150700 IF WRK-XN-00001 = "1" NC1724.2 +150800 PERFORM PASS NC1724.2 +150900 PERFORM PRINT-DETAIL NC1724.2 +151000 ELSE NC1724.2 +151100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +151200 TO RE-MARK NC1724.2 +151300 PERFORM FAIL NC1724.2 +151400 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +151500 MOVE "0" TO CORRECT-X NC1724.2 +151600 PERFORM PRINT-DETAIL. NC1724.2 +151700* NC1724.2 +151800* NC1724.2 +151900 DIV-INIT-F2-23. NC1724.2 +152000* ==--> SIZE ERROR CONDITION <--== NC1724.2 +152100* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +152200 MOVE "DIV-TEST-F2-23" TO PAR-NAME. NC1724.2 +152300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +152400 MOVE "0" TO WRK-XN-00001. NC1724.2 +152500 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +152600 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +152700 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +152800 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +152900 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +153000 MOVE 1 TO REC-CT. NC1724.2 +153100 MOVE 99 TO WRK-DU-2V0-1. NC1724.2 +153200 MOVE .1 TO A01ONE-CS-00V01. NC1724.2 +153300 DIV-TEST-F2-23-0. NC1724.2 +153400 DIVIDE A01ONE-CS-00V01 INTO WRK-DU-2V0-1 NC1724.2 +153500 GIVING WRK-DU-2V1-1 NC1724.2 +153600 WRK-DU-2V0-1 ROUNDED NC1724.2 +153700 WRK-DU-2V1-2 NC1724.2 +153800 WRK-DU-2V0-2 ROUNDED NC1724.2 +153900 WRK-DU-2V1-3 NC1724.2 +154000 WRK-DU-2V0-3 NC1724.2 +154100 ON SIZE ERROR NC1724.2 +154200 MOVE "1" TO WRK-XN-00001 NC1724.2 +154300 NOT ON SIZE ERROR NC1724.2 +154400 MOVE "2" TO WRK-XN-00001. NC1724.2 +154500 GO TO DIV-TEST-F2-23-1. NC1724.2 +154600 DIV-DELETE-F2-23. NC1724.2 +154700 PERFORM DE-LETE. NC1724.2 +154800 PERFORM PRINT-DETAIL. NC1724.2 +154900 GO TO DIV-INIT-F2-24. NC1724.2 +155000 DIV-TEST-F2-23-1. NC1724.2 +155100 IF WRK-DU-2V1-1 = 0 NC1724.2 +155200 PERFORM PASS NC1724.2 +155300 PERFORM PRINT-DETAIL NC1724.2 +155400 ELSE NC1724.2 +155500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +155600 PERFORM FAIL NC1724.2 +155700 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +155800 MOVE 0 TO CORRECT-N NC1724.2 +155900 PERFORM PRINT-DETAIL. NC1724.2 +156000 ADD 1 TO REC-CT. NC1724.2 +156100 DIV-TEST-F2-23-2. NC1724.2 +156200 IF WRK-DU-2V0-1 = 99 NC1724.2 +156300 PERFORM PASS NC1724.2 +156400 PERFORM PRINT-DETAIL NC1724.2 +156500 ELSE NC1724.2 +156600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +156700 PERFORM FAIL NC1724.2 +156800 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +156900 MOVE 99 TO CORRECT-N NC1724.2 +157000 PERFORM PRINT-DETAIL. NC1724.2 +157100 ADD 1 TO REC-CT. NC1724.2 +157200 DIV-TEST-F2-23-3. NC1724.2 +157300 IF WRK-DU-2V1-2 = 0 NC1724.2 +157400 PERFORM PASS NC1724.2 +157500 PERFORM PRINT-DETAIL NC1724.2 +157600 ELSE NC1724.2 +157700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +157800 PERFORM FAIL NC1724.2 +157900 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +158000 MOVE 0 TO CORRECT-N NC1724.2 +158100 PERFORM PRINT-DETAIL. NC1724.2 +158200 ADD 1 TO REC-CT. NC1724.2 +158300 DIV-TEST-F2-23-4. NC1724.2 +158400 IF WRK-DU-2V0-2 = 0 NC1724.2 +158500 PERFORM PASS NC1724.2 +158600 PERFORM PRINT-DETAIL NC1724.2 +158700 ELSE NC1724.2 +158800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +158900 PERFORM FAIL NC1724.2 +159000 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +159100 MOVE 0 TO CORRECT-N NC1724.2 +159200 PERFORM PRINT-DETAIL. NC1724.2 +159300 ADD 1 TO REC-CT. NC1724.2 +159400 DIV-TEST-F2-23-5. NC1724.2 +159500 IF WRK-DU-2V1-3 = 0 NC1724.2 +159600 PERFORM PASS NC1724.2 +159700 PERFORM PRINT-DETAIL NC1724.2 +159800 ELSE NC1724.2 +159900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +160000 PERFORM FAIL NC1724.2 +160100 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +160200 MOVE 0 TO CORRECT-N NC1724.2 +160300 PERFORM PRINT-DETAIL. NC1724.2 +160400 ADD 1 TO REC-CT. NC1724.2 +160500 DIV-TEST-F2-23-6. NC1724.2 +160600 IF WRK-DU-2V0-3 = 0 NC1724.2 +160700 PERFORM PASS NC1724.2 +160800 PERFORM PRINT-DETAIL NC1724.2 +160900 ELSE NC1724.2 +161000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1724.2 +161100 PERFORM FAIL NC1724.2 +161200 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +161300 MOVE 0 TO CORRECT-N NC1724.2 +161400 PERFORM PRINT-DETAIL. NC1724.2 +161500 ADD 1 TO REC-CT. NC1724.2 +161600 DIV-TEST-F2-23-7. NC1724.2 +161700 IF WRK-XN-00001 = "1" NC1724.2 +161800 PERFORM PASS NC1724.2 +161900 PERFORM PRINT-DETAIL NC1724.2 +162000 ELSE NC1724.2 +162100 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +162200 TO RE-MARK NC1724.2 +162300 PERFORM FAIL NC1724.2 +162400 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +162500 MOVE "0" TO CORRECT-X NC1724.2 +162600 PERFORM PRINT-DETAIL. NC1724.2 +162700* NC1724.2 +162800* NC1724.2 +162900 DIV-INIT-F2-24. NC1724.2 +163000* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +163100* ==--> NEW SIZE ERROR TESTS <--== NC1724.2 +163200 MOVE "DIV-TEST-F2-24" TO PAR-NAME. NC1724.2 +163300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1724.2 +163400 MOVE "0" TO WRK-XN-00001. NC1724.2 +163500 MOVE 0 TO WRK-DU-2V1-1. NC1724.2 +163600 MOVE 0 TO WRK-DU-2V0-1. NC1724.2 +163700 MOVE 0 TO WRK-DU-2V1-2. NC1724.2 +163800 MOVE 0 TO WRK-DU-2V0-2. NC1724.2 +163900 MOVE 0 TO WRK-DU-2V1-3. NC1724.2 +164000 MOVE 0 TO WRK-DU-2V0-3. NC1724.2 +164100 MOVE 1 TO REC-CT. NC1724.2 +164200 MOVE 10 TO WRK-DU-2V0-1. NC1724.2 +164300 MOVE 3.9 TO WRK-DU-1V1-2. NC1724.2 +164400 DIV-TEST-F2-24-0. NC1724.2 +164500 DIVIDE WRK-DU-1V1-2 INTO WRK-DU-2V0-1 NC1724.2 +164600 GIVING WRK-DU-2V1-1 NC1724.2 +164700 WRK-DU-2V0-1 ROUNDED NC1724.2 +164800 WRK-DU-2V1-2 NC1724.2 +164900 WRK-DU-2V0-2 ROUNDED NC1724.2 +165000 WRK-DU-2V1-3 NC1724.2 +165100 WRK-DU-2V0-3 NC1724.2 +165200 ON SIZE ERROR NC1724.2 +165300 MOVE "1" TO WRK-XN-00001 NC1724.2 +165400 NOT ON SIZE ERROR NC1724.2 +165500 MOVE "2" TO WRK-XN-00001. NC1724.2 +165600 GO TO DIV-TEST-F2-24-1. NC1724.2 +165700 DIV-DELETE-F2-24. NC1724.2 +165800 PERFORM DE-LETE. NC1724.2 +165900 PERFORM PRINT-DETAIL. NC1724.2 +166000 GO TO DIV-INIT-F2-25. NC1724.2 +166100 DIV-TEST-F2-24-1. NC1724.2 +166200 IF WRK-DU-2V1-1 = 2.5 NC1724.2 +166300 PERFORM PASS NC1724.2 +166400 PERFORM PRINT-DETAIL NC1724.2 +166500 ELSE NC1724.2 +166600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +166700 PERFORM FAIL NC1724.2 +166800 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1724.2 +166900 MOVE 2.5 TO CORRECT-N NC1724.2 +167000 PERFORM PRINT-DETAIL. NC1724.2 +167100 ADD 1 TO REC-CT. NC1724.2 +167200 DIV-TEST-F2-24-2. NC1724.2 +167300 IF WRK-DU-2V0-1 = 3 NC1724.2 +167400 PERFORM PASS NC1724.2 +167500 PERFORM PRINT-DETAIL NC1724.2 +167600 ELSE NC1724.2 +167700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +167800 PERFORM FAIL NC1724.2 +167900 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1724.2 +168000 MOVE 3 TO CORRECT-N NC1724.2 +168100 PERFORM PRINT-DETAIL. NC1724.2 +168200 ADD 1 TO REC-CT. NC1724.2 +168300 DIV-TEST-F2-24-3. NC1724.2 +168400 IF WRK-DU-2V1-2 = 2.5 NC1724.2 +168500 PERFORM PASS NC1724.2 +168600 PERFORM PRINT-DETAIL NC1724.2 +168700 ELSE NC1724.2 +168800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +168900 PERFORM FAIL NC1724.2 +169000 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1724.2 +169100 MOVE 2.5 TO CORRECT-N NC1724.2 +169200 PERFORM PRINT-DETAIL. NC1724.2 +169300 ADD 1 TO REC-CT. NC1724.2 +169400 DIV-TEST-F2-24-4. NC1724.2 +169500 IF WRK-DU-2V0-2 = 3 NC1724.2 +169600 PERFORM PASS NC1724.2 +169700 PERFORM PRINT-DETAIL NC1724.2 +169800 ELSE NC1724.2 +169900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +170000 PERFORM FAIL NC1724.2 +170100 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1724.2 +170200 MOVE 3 TO CORRECT-N NC1724.2 +170300 PERFORM PRINT-DETAIL. NC1724.2 +170400 ADD 1 TO REC-CT. NC1724.2 +170500 DIV-TEST-F2-24-5. NC1724.2 +170600 IF WRK-DU-2V1-3 = 2.5 NC1724.2 +170700 PERFORM PASS NC1724.2 +170800 PERFORM PRINT-DETAIL NC1724.2 +170900 ELSE NC1724.2 +171000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +171100 PERFORM FAIL NC1724.2 +171200 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1724.2 +171300 MOVE 2.5 TO CORRECT-N NC1724.2 +171400 PERFORM PRINT-DETAIL. NC1724.2 +171500 ADD 1 TO REC-CT. NC1724.2 +171600 DIV-TEST-F2-24-6. NC1724.2 +171700 IF WRK-DU-2V0-3 = 2 NC1724.2 +171800 PERFORM PASS NC1724.2 +171900 PERFORM PRINT-DETAIL NC1724.2 +172000 ELSE NC1724.2 +172100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +172200 PERFORM FAIL NC1724.2 +172300 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1724.2 +172400 MOVE 2 TO CORRECT-N NC1724.2 +172500 PERFORM PRINT-DETAIL. NC1724.2 +172600 ADD 1 TO REC-CT. NC1724.2 +172700 DIV-TEST-F2-24-7. NC1724.2 +172800 IF WRK-XN-00001 = "2" NC1724.2 +172900 PERFORM PASS NC1724.2 +173000 PERFORM PRINT-DETAIL NC1724.2 +173100 ELSE NC1724.2 +173200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +173300 TO RE-MARK NC1724.2 +173400 PERFORM FAIL NC1724.2 +173500 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +173600 MOVE "2" TO CORRECT-X NC1724.2 +173700 PERFORM PRINT-DETAIL. NC1724.2 +173800* NC1724.2 +173900* NC1724.2 +174000 DIV-INIT-F2-25. NC1724.2 +174100* ==--> SIZE ERROR CONDITION <--== NC1724.2 +174200* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +174300 MOVE "DIV-TEST-F2-25" TO PAR-NAME. NC1724.2 +174400 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1724.2 +174500 MOVE "0" TO WRK-XN-00001. NC1724.2 +174600 MOVE 0 TO WRK-DS-05V00. NC1724.2 +174700 MOVE 0 TO WRK-DS-02V00. NC1724.2 +174800 MOVE 0 TO WRK-CS-18V00. NC1724.2 +174900 MOVE 0 TO DIV10. NC1724.2 +175000 MOVE 1 TO REC-CT. NC1724.2 +175100 MOVE 44.1 TO DIV2. NC1724.2 +175200 MOVE -9.642 TO DIV4. NC1724.2 +175300 DIV-TEST-F2-25-0. NC1724.2 +175400 DIVIDE DIV4 INTO DIV2 NC1724.2 +175500 GIVING DIV10 NC1724.2 +175600 ON SIZE ERROR NC1724.2 +175700 MOVE "1" TO WRK-XN-00001 NC1724.2 +175800 MOVE 23 TO WRK-DS-05V00 NC1724.2 +175900 MOVE -4 TO WRK-DS-02V00 NC1724.2 +176000 END-DIVIDE NC1724.2 +176100 MOVE 99 TO WRK-CS-18V00. NC1724.2 +176200 GO TO DIV-TEST-F2-25-1. NC1724.2 +176300 DIV-DELETE-F2-25-1. NC1724.2 +176400 PERFORM DE-LETE. NC1724.2 +176500 PERFORM PRINT-DETAIL. NC1724.2 +176600 GO TO DIV-INIT-F2-26. NC1724.2 +176700 DIV-TEST-F2-25-1. NC1724.2 +176800 MOVE "DIV-TEST-F2-25-1" TO PAR-NAME. NC1724.2 +176900 IF WRK-XN-00001 = "1" NC1724.2 +177000 PERFORM PASS NC1724.2 +177100 PERFORM PRINT-DETAIL NC1724.2 +177200 ELSE NC1724.2 +177300 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +177400 MOVE "1" TO CORRECT-X NC1724.2 +177500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +177600 PERFORM FAIL NC1724.2 +177700 PERFORM PRINT-DETAIL. NC1724.2 +177800 ADD 1 TO REC-CT. NC1724.2 +177900 DIV-TEST-F2-25-2. NC1724.2 +178000 MOVE "DIV-TEST-F2-25-2" TO PAR-NAME. NC1724.2 +178100 IF WRK-DS-02V00 = -4 NC1724.2 +178200 PERFORM PASS NC1724.2 +178300 PERFORM PRINT-DETAIL NC1724.2 +178400 ELSE NC1724.2 +178500 MOVE WRK-DS-02V00 TO COMPUTED-N NC1724.2 +178600 MOVE -4 TO CORRECT-N NC1724.2 +178700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +178800 PERFORM FAIL NC1724.2 +178900 PERFORM PRINT-DETAIL. NC1724.2 +179000 ADD 1 TO REC-CT. NC1724.2 +179100 DIV-TEST-F2-25-3. NC1724.2 +179200 MOVE "DIV-TEST-F2-25-3" TO PAR-NAME. NC1724.2 +179300 IF WRK-DS-05V00 = 23 NC1724.2 +179400 PERFORM PASS NC1724.2 +179500 PERFORM PRINT-DETAIL NC1724.2 +179600 ELSE NC1724.2 +179700 MOVE WRK-DS-05V00 TO COMPUTED-N NC1724.2 +179800 MOVE 23 TO CORRECT-N NC1724.2 +179900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +180000 PERFORM FAIL NC1724.2 +180100 PERFORM PRINT-DETAIL. NC1724.2 +180200 ADD 1 TO REC-CT. NC1724.2 +180300 DIV-TEST-F2-25-4. NC1724.2 +180400 MOVE "DIV-TEST-F2-25-4" TO PAR-NAME. NC1724.2 +180500 IF DIV10 = 0 NC1724.2 +180600 PERFORM PASS NC1724.2 +180700 PERFORM PRINT-DETAIL NC1724.2 +180800 ELSE NC1724.2 +180900 MOVE DIV10 TO COMPUTED-N NC1724.2 +181000 MOVE 0 TO CORRECT-N NC1724.2 +181100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1724.2 +181200 PERFORM FAIL NC1724.2 +181300 PERFORM PRINT-DETAIL. NC1724.2 +181400 ADD 1 TO REC-CT. NC1724.2 +181500 DIV-TEST-F2-25-5. NC1724.2 +181600 MOVE "DIV-TEST-F2-25-5" TO PAR-NAME. NC1724.2 +181700 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +181800 PERFORM PASS NC1724.2 +181900 PERFORM PRINT-DETAIL NC1724.2 +182000 ELSE NC1724.2 +182100 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +182200 MOVE 99 TO CORRECT-N NC1724.2 +182300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +182400 PERFORM FAIL NC1724.2 +182500 PERFORM PRINT-DETAIL. NC1724.2 +182600* NC1724.2 +182700* NC1724.2 +182800 DIV-INIT-F2-26. NC1724.2 +182900* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +183000* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +183100 MOVE "DIV-TEST-F2-26" TO PAR-NAME. NC1724.2 +183200 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1724.2 +183300 MOVE 1 TO REC-CT. NC1724.2 +183400 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +183500 MOVE 0 TO WRK-DS-05V00. NC1724.2 +183600 MOVE 0 TO WRK-DS-02V00. NC1724.2 +183700 MOVE "0" TO WRK-XN-00001. NC1724.2 +183800 MOVE 0 TO WRK-CS-18V00. NC1724.2 +183900 DIV-TEST-F2-26-0. NC1724.2 +184000 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +184100 GIVING WRK-DS-09V09 NC1724.2 +184200 ON SIZE ERROR NC1724.2 +184300 MOVE "1" TO WRK-XN-00001 NC1724.2 +184400 MOVE 23 TO WRK-DS-05V00 NC1724.2 +184500 MOVE -4 TO WRK-DS-02V00 NC1724.2 +184600 END-DIVIDE NC1724.2 +184700 MOVE 99 TO WRK-CS-18V00. NC1724.2 +184800 GO TO DIV-TEST-F2-26-1. NC1724.2 +184900 DIV-DELETE-F2-26-1. NC1724.2 +185000 PERFORM DE-LETE. NC1724.2 +185100 PERFORM PRINT-DETAIL. NC1724.2 +185200 GO TO DIV-INIT-F2-27. NC1724.2 +185300 DIV-TEST-F2-26-1. NC1724.2 +185400 MOVE "DIV-TEST-F2-26-1" TO PAR-NAME. NC1724.2 +185500 IF WRK-XN-00001 = "0" NC1724.2 +185600 PERFORM PASS NC1724.2 +185700 PERFORM PRINT-DETAIL NC1724.2 +185800 ELSE NC1724.2 +185900 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +186000 MOVE "0" TO CORRECT-X NC1724.2 +186100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +186200 TO RE-MARK NC1724.2 +186300 PERFORM FAIL NC1724.2 +186400 PERFORM PRINT-DETAIL. NC1724.2 +186500 ADD 1 TO REC-CT. NC1724.2 +186600 DIV-TEST-F2-26-2. NC1724.2 +186700 MOVE "DIV-TEST-F2-26-2" TO PAR-NAME. NC1724.2 +186800 IF WRK-DS-02V00 = 0 NC1724.2 +186900 PERFORM PASS NC1724.2 +187000 PERFORM PRINT-DETAIL NC1724.2 +187100 ELSE NC1724.2 +187200 MOVE WRK-DS-02V00 TO COMPUTED-N NC1724.2 +187300 MOVE 0 TO CORRECT-N NC1724.2 +187400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +187500 TO RE-MARK NC1724.2 +187600 PERFORM FAIL NC1724.2 +187700 PERFORM PRINT-DETAIL. NC1724.2 +187800 ADD 1 TO REC-CT. NC1724.2 +187900 DIV-TEST-F2-26-3. NC1724.2 +188000 MOVE "DIV-TEST-F2-26-3" TO PAR-NAME. NC1724.2 +188100 IF WRK-DS-05V00 = 0 NC1724.2 +188200 PERFORM PASS NC1724.2 +188300 PERFORM PRINT-DETAIL NC1724.2 +188400 ELSE NC1724.2 +188500 MOVE WRK-DS-05V00 TO COMPUTED-N NC1724.2 +188600 MOVE 0 TO CORRECT-N NC1724.2 +188700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +188800 TO RE-MARK NC1724.2 +188900 PERFORM FAIL NC1724.2 +189000 PERFORM PRINT-DETAIL. NC1724.2 +189100 ADD 1 TO REC-CT. NC1724.2 +189200 DIV-TEST-F2-26-4. NC1724.2 +189300 MOVE "DIV-TEST-F2-26-4" TO PAR-NAME. NC1724.2 +189400 IF WRK-DS-18V00-S = 000000001000000000 NC1724.2 +189500 PERFORM PASS NC1724.2 +189600 PERFORM PRINT-DETAIL NC1724.2 +189700 ELSE NC1724.2 +189800 MOVE WRK-DS-18V00-S TO COMPUTED-N NC1724.2 +189900 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +190000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +190100 PERFORM FAIL NC1724.2 +190200 PERFORM PRINT-DETAIL. NC1724.2 +190300 ADD 1 TO REC-CT. NC1724.2 +190400 DIV-TEST-F2-26-5. NC1724.2 +190500 MOVE "DIV-TEST-F2-26-5" TO PAR-NAME. NC1724.2 +190600 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +190700 PERFORM PASS NC1724.2 +190800 PERFORM PRINT-DETAIL NC1724.2 +190900 ELSE NC1724.2 +191000 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +191100 MOVE 99 TO CORRECT-N NC1724.2 +191200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +191300 PERFORM FAIL NC1724.2 +191400 PERFORM PRINT-DETAIL. NC1724.2 +191500* NC1724.2 +191600* NC1724.2 +191700 DIV-INIT-F2-27. NC1724.2 +191800 MOVE "DIVIDE INTO GIVING" TO FEATURE. NC1724.2 +191900* ==--> SIZE ERROR CONDITION <--== NC1724.2 +192000* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +192100 MOVE 0 TO WRK-CS-18V00. NC1724.2 +192200 MOVE "0" TO WRK-XN-00001. NC1724.2 +192300 MOVE 0 TO WRK-DS-05V00. NC1724.2 +192400 MOVE 0 TO WRK-DS-02V00. NC1724.2 +192500 MOVE 0 TO DIV10. NC1724.2 +192600 MOVE 1 TO REC-CT. NC1724.2 +192700 MOVE 44.1 TO DIV2. NC1724.2 +192800 MOVE -9.642 TO DIV4. NC1724.2 +192900 DIV-TEST-F2-27-0. NC1724.2 +193000 DIVIDE DIV4 INTO DIV2 NC1724.2 +193100 GIVING DIV10 NC1724.2 +193200 NOT ON SIZE ERROR NC1724.2 +193300 MOVE "1" TO WRK-XN-00001 NC1724.2 +193400 MOVE 23 TO WRK-DS-05V00 NC1724.2 +193500 MOVE -4 TO WRK-DS-02V00 NC1724.2 +193600 END-DIVIDE NC1724.2 +193700 MOVE 99 TO WRK-CS-18V00. NC1724.2 +193800 GO TO DIV-TEST-F2-27-1. NC1724.2 +193900 DIV-DELETE-F2-27-1. NC1724.2 +194000 PERFORM DE-LETE. NC1724.2 +194100 PERFORM PRINT-DETAIL. NC1724.2 +194200 GO TO DIV-INIT-F2-28. NC1724.2 +194300 DIV-TEST-F2-27-1. NC1724.2 +194400 MOVE "DIV-TEST-F2-27-1" TO PAR-NAME. NC1724.2 +194500 IF WRK-XN-00001 = "0" NC1724.2 +194600 PERFORM PASS NC1724.2 +194700 PERFORM PRINT-DETAIL NC1724.2 +194800 ELSE NC1724.2 +194900 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +195000 MOVE "0" TO CORRECT-X NC1724.2 +195100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +195200 TO RE-MARK NC1724.2 +195300 PERFORM FAIL NC1724.2 +195400 PERFORM PRINT-DETAIL. NC1724.2 +195500 ADD 1 TO REC-CT. NC1724.2 +195600 DIV-TEST-F2-27-2. NC1724.2 +195700 MOVE "DIV-TEST-F2-27-2" TO PAR-NAME. NC1724.2 +195800 IF WRK-DS-02V00 = 0 NC1724.2 +195900 PERFORM PASS NC1724.2 +196000 PERFORM PRINT-DETAIL NC1724.2 +196100 ELSE NC1724.2 +196200 MOVE WRK-DS-02V00 TO COMPUTED-N NC1724.2 +196300 MOVE 0 TO CORRECT-N NC1724.2 +196400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +196500 TO RE-MARK NC1724.2 +196600 PERFORM FAIL NC1724.2 +196700 PERFORM PRINT-DETAIL. NC1724.2 +196800 ADD 1 TO REC-CT. NC1724.2 +196900 DIV-TEST-F2-27-3. NC1724.2 +197000 MOVE "DIV-TEST-F2-27-3" TO PAR-NAME. NC1724.2 +197100 IF WRK-DS-05V00 = 0 NC1724.2 +197200 PERFORM PASS NC1724.2 +197300 PERFORM PRINT-DETAIL NC1724.2 +197400 ELSE NC1724.2 +197500 MOVE WRK-DS-05V00 TO COMPUTED-N NC1724.2 +197600 MOVE 0 TO CORRECT-N NC1724.2 +197700 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1724.2 +197800 TO RE-MARK NC1724.2 +197900 PERFORM FAIL NC1724.2 +198000 PERFORM PRINT-DETAIL. NC1724.2 +198100 ADD 1 TO REC-CT. NC1724.2 +198200 DIV-TEST-F2-27-4. NC1724.2 +198300 MOVE "DIV-TEST-F2-27-4" TO PAR-NAME. NC1724.2 +198400 IF DIV10 = 0 NC1724.2 +198500 PERFORM PASS NC1724.2 +198600 PERFORM PRINT-DETAIL NC1724.2 +198700 ELSE NC1724.2 +198800 MOVE DIV10 TO COMPUTED-N NC1724.2 +198900 MOVE 0 TO CORRECT-N NC1724.2 +199000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +199100 PERFORM FAIL NC1724.2 +199200 PERFORM PRINT-DETAIL. NC1724.2 +199300 ADD 1 TO REC-CT. NC1724.2 +199400 DIV-TEST-F2-27-5. NC1724.2 +199500 MOVE "DIV-TEST-F2-27-5" TO PAR-NAME. NC1724.2 +199600 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +199700 PERFORM PASS NC1724.2 +199800 PERFORM PRINT-DETAIL NC1724.2 +199900 ELSE NC1724.2 +200000 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +200100 MOVE 99 TO CORRECT-N NC1724.2 +200200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +200300 PERFORM FAIL NC1724.2 +200400 PERFORM PRINT-DETAIL. NC1724.2 +200500* NC1724.2 +200600* NC1724.2 +200700 DIV-INIT-F2-28. NC1724.2 +200800* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +200900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +201000 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +201100 MOVE 1 TO REC-CT. NC1724.2 +201200 MOVE 0 TO WRK-DS-05V00. NC1724.2 +201300 MOVE 0 TO WRK-DS-02V00. NC1724.2 +201400 MOVE "0" TO WRK-XN-00001. NC1724.2 +201500 MOVE 0 TO WRK-CS-18V00. NC1724.2 +201600 DIV-TEST-F2-28-0. NC1724.2 +201700 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +201800 GIVING WRK-DS-09V09 NC1724.2 +201900 NOT ON SIZE ERROR NC1724.2 +202000 MOVE "1" TO WRK-XN-00001 NC1724.2 +202100 MOVE 23 TO WRK-DS-05V00 NC1724.2 +202200 MOVE -4 TO WRK-DS-02V00 NC1724.2 +202300 END-DIVIDE NC1724.2 +202400 MOVE 99 TO WRK-CS-18V00. NC1724.2 +202500 GO TO DIV-TEST-F2-28-1. NC1724.2 +202600 DIV-DELETE-F2-28-1. NC1724.2 +202700 PERFORM DE-LETE. NC1724.2 +202800 PERFORM PRINT-DETAIL. NC1724.2 +202900 GO TO DIV-INIT-F2-29. NC1724.2 +203000 DIV-TEST-F2-28-1. NC1724.2 +203100 MOVE "DIV-TEST-F2-28-1" TO PAR-NAME. NC1724.2 +203200 IF WRK-XN-00001 = "1" NC1724.2 +203300 PERFORM PASS NC1724.2 +203400 PERFORM PRINT-DETAIL NC1724.2 +203500 ELSE NC1724.2 +203600 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +203700 MOVE "1" TO CORRECT-X NC1724.2 +203800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +203900 TO RE-MARK NC1724.2 +204000 PERFORM FAIL NC1724.2 +204100 PERFORM PRINT-DETAIL. NC1724.2 +204200 ADD 1 TO REC-CT. NC1724.2 +204300 DIV-TEST-F2-28-2. NC1724.2 +204400 MOVE "DIV-TEST-F2-28-2" TO PAR-NAME. NC1724.2 +204500 IF WRK-DS-02V00 = -4 NC1724.2 +204600 PERFORM PASS NC1724.2 +204700 PERFORM PRINT-DETAIL NC1724.2 +204800 ELSE NC1724.2 +204900 MOVE WRK-DS-02V00 TO COMPUTED-N NC1724.2 +205000 MOVE -4 TO CORRECT-N NC1724.2 +205100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +205200 TO RE-MARK NC1724.2 +205300 PERFORM FAIL NC1724.2 +205400 PERFORM PRINT-DETAIL. NC1724.2 +205500 ADD 1 TO REC-CT. NC1724.2 +205600 DIV-TEST-F2-28-3. NC1724.2 +205700 MOVE "DIV-TEST-F2-28-3" TO PAR-NAME. NC1724.2 +205800 IF WRK-DS-05V00 = 23 NC1724.2 +205900 PERFORM PASS NC1724.2 +206000 PERFORM PRINT-DETAIL NC1724.2 +206100 ELSE NC1724.2 +206200 MOVE WRK-DS-05V00 TO COMPUTED-N NC1724.2 +206300 MOVE 23 TO CORRECT-N NC1724.2 +206400 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +206500 TO RE-MARK NC1724.2 +206600 PERFORM FAIL NC1724.2 +206700 PERFORM PRINT-DETAIL. NC1724.2 +206800 ADD 1 TO REC-CT. NC1724.2 +206900 DIV-TEST-F2-28-4. NC1724.2 +207000 MOVE "DIV-TEST-F2-28-4" TO PAR-NAME. NC1724.2 +207100 IF WRK-DS-18V00-S = 000000001000000000 NC1724.2 +207200 PERFORM PASS NC1724.2 +207300 PERFORM PRINT-DETAIL NC1724.2 +207400 ELSE NC1724.2 +207500 MOVE WRK-DS-18V00-S TO COMPUTED-N NC1724.2 +207600 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +207700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +207800 PERFORM FAIL NC1724.2 +207900 PERFORM PRINT-DETAIL. NC1724.2 +208000 ADD 1 TO REC-CT. NC1724.2 +208100 DIV-TEST-F2-28-5. NC1724.2 +208200 MOVE "DIV-TEST-F2-28-5" TO PAR-NAME. NC1724.2 +208300 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +208400 PERFORM PASS NC1724.2 +208500 PERFORM PRINT-DETAIL NC1724.2 +208600 ELSE NC1724.2 +208700 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +208800 MOVE 99 TO CORRECT-N NC1724.2 +208900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +209000 PERFORM FAIL NC1724.2 +209100 PERFORM PRINT-DETAIL. NC1724.2 +209200* NC1724.2 +209300* NC1724.2 +209400 DIV-INIT-F2-29. NC1724.2 +209500* ==--> SIZE ERROR CONDITION <--== NC1724.2 +209600* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +209700 MOVE 1 TO REC-CT. NC1724.2 +209800 MOVE 0 TO WRK-CS-18V00. NC1724.2 +209900 MOVE "0" TO WRK-XN-00001. NC1724.2 +210000 MOVE 0 TO DIV10. NC1724.2 +210100 MOVE 44.1 TO DIV2. NC1724.2 +210200 MOVE -9.642 TO DIV4. NC1724.2 +210300 DIV-TEST-F2-29-0. NC1724.2 +210400 DIVIDE DIV4 INTO DIV2 NC1724.2 +210500 GIVING DIV10 NC1724.2 +210600 ON SIZE ERROR NC1724.2 +210700 MOVE "1" TO WRK-XN-00001 NC1724.2 +210800 NOT ON SIZE ERROR NC1724.2 +210900 MOVE "2" TO WRK-XN-00001 NC1724.2 +211000 END-DIVIDE NC1724.2 +211100 MOVE 99 TO WRK-CS-18V00. NC1724.2 +211200 GO TO DIV-TEST-F2-29-1. NC1724.2 +211300 DIV-DELETE-F2-29-1. NC1724.2 +211400 PERFORM DE-LETE. NC1724.2 +211500 PERFORM PRINT-DETAIL. NC1724.2 +211600 GO TO DIV-INIT-F2-30. NC1724.2 +211700 DIV-TEST-F2-29-1. NC1724.2 +211800 MOVE "DIV-TEST-F2-29-1" TO PAR-NAME. NC1724.2 +211900 IF WRK-XN-00001 = "1" NC1724.2 +212000 PERFORM PASS NC1724.2 +212100 PERFORM PRINT-DETAIL NC1724.2 +212200 ELSE NC1724.2 +212300 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +212400 MOVE "1" TO CORRECT-X NC1724.2 +212500 MOVE "ON SIZE ERROR NOT EXECUTED" NC1724.2 +212600 TO RE-MARK NC1724.2 +212700 PERFORM FAIL NC1724.2 +212800 PERFORM PRINT-DETAIL. NC1724.2 +212900 ADD 1 TO REC-CT. NC1724.2 +213000 DIV-TEST-F2-29-2. NC1724.2 +213100 MOVE "DIV-TEST-F2-29-2" TO PAR-NAME. NC1724.2 +213200 IF DIV10 = 0 NC1724.2 +213300 PERFORM PASS NC1724.2 +213400 PERFORM PRINT-DETAIL NC1724.2 +213500 ELSE NC1724.2 +213600 MOVE DIV10 TO COMPUTED-N NC1724.2 +213700 MOVE 0 TO CORRECT-N NC1724.2 +213800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +213900 PERFORM FAIL NC1724.2 +214000 PERFORM PRINT-DETAIL. NC1724.2 +214100 ADD 1 TO REC-CT. NC1724.2 +214200 DIV-TEST-F2-29-3. NC1724.2 +214300 MOVE "DIV-TEST-F2-29-3" TO PAR-NAME. NC1724.2 +214400 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +214500 PERFORM PASS NC1724.2 +214600 PERFORM PRINT-DETAIL NC1724.2 +214700 ELSE NC1724.2 +214800 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +214900 MOVE 99 TO CORRECT-N NC1724.2 +215000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +215100 PERFORM FAIL NC1724.2 +215200 PERFORM PRINT-DETAIL. NC1724.2 +215300* NC1724.2 +215400* NC1724.2 +215500 DIV-INIT-F2-30. NC1724.2 +215600* ==--> NO SIZE ERROR CONDITION <--== NC1724.2 +215700* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1724.2 +215800 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1724.2 +215900 MOVE "0" TO WRK-XN-00001. NC1724.2 +216000 MOVE 0 TO WRK-CS-18V00. NC1724.2 +216100 DIV-TEST-F2-30-0. NC1724.2 +216200 DIVIDE A18ONES-DS-09V09 INTO WRK-DS-09V09 NC1724.2 +216300 GIVING WRK-DS-09V09 NC1724.2 +216400 ON SIZE ERROR NC1724.2 +216500 MOVE "1" TO WRK-XN-00001 NC1724.2 +216600 NOT ON SIZE ERROR NC1724.2 +216700 MOVE "2" TO WRK-XN-00001 NC1724.2 +216800 END-DIVIDE NC1724.2 +216900 MOVE 99 TO WRK-CS-18V00. NC1724.2 +217000 GO TO DIV-TEST-F2-30-1. NC1724.2 +217100 DIV-DELETE-F2-30-1. NC1724.2 +217200 PERFORM DE-LETE. NC1724.2 +217300 PERFORM PRINT-DETAIL. NC1724.2 +217400 GO TO CCVS-EXIT. NC1724.2 +217500 DIV-TEST-F2-30-1. NC1724.2 +217600 MOVE "DIV-TEST-F2-30-1" TO PAR-NAME. NC1724.2 +217700 IF WRK-XN-00001 = "2" NC1724.2 +217800 PERFORM PASS NC1724.2 +217900 PERFORM PRINT-DETAIL NC1724.2 +218000 ELSE NC1724.2 +218100 MOVE WRK-XN-00001 TO COMPUTED-X NC1724.2 +218200 MOVE "2" TO CORRECT-X NC1724.2 +218300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1724.2 +218400 TO RE-MARK NC1724.2 +218500 PERFORM FAIL NC1724.2 +218600 PERFORM PRINT-DETAIL. NC1724.2 +218700 ADD 1 TO REC-CT. NC1724.2 +218800 DIV-TEST-F2-30-2. NC1724.2 +218900 MOVE "DIV-TEST-F2-30-2" TO PAR-NAME. NC1724.2 +219000 IF WRK-DS-18V00-S = 000000001000000000 NC1724.2 +219100 PERFORM PASS NC1724.2 +219200 PERFORM PRINT-DETAIL NC1724.2 +219300 ELSE NC1724.2 +219400 MOVE WRK-DS-18V00-S TO COMPUTED-N NC1724.2 +219500 MOVE 000000001000000000 TO CORRECT-18V0 NC1724.2 +219600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1724.2 +219700 PERFORM FAIL NC1724.2 +219800 PERFORM PRINT-DETAIL. NC1724.2 +219900 ADD 1 TO REC-CT. NC1724.2 +220000 DIV-TEST-F2-30-3. NC1724.2 +220100 MOVE "DIV-TEST-F2-30-3" TO PAR-NAME. NC1724.2 +220200 IF WRK-CS-18V00 = 000000000000000099 NC1724.2 +220300 PERFORM PASS NC1724.2 +220400 PERFORM PRINT-DETAIL NC1724.2 +220500 ELSE NC1724.2 +220600 MOVE WRK-CS-18V00 TO COMPUTED-N NC1724.2 +220700 MOVE 99 TO CORRECT-N NC1724.2 +220800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1724.2 +220900 PERFORM FAIL NC1724.2 +221000 PERFORM PRINT-DETAIL. NC1724.2 +221100* NC1724.2 +221200* NC1724.2 +221300 CCVS-EXIT SECTION. NC1724.2 +221400 CCVS-999999. NC1724.2 +221500 GO TO CLOSE-FILES. NC1724.2 diff --git a/tests/cobol85/NC/NC173A.CBL b/tests/cobol85/NC/NC173A.CBL new file mode 100755 index 00000000..64dfe753 --- /dev/null +++ b/tests/cobol85/NC/NC173A.CBL @@ -0,0 +1,2218 @@ +000100 IDENTIFICATION DIVISION. NC1734.2 +000200 PROGRAM-ID. NC1734.2 +000300 NC173A. NC1734.2 +000400**************************************************************** NC1734.2 +000500* * NC1734.2 +000600* VALIDATION FOR:- * NC1734.2 +000700* * NC1734.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1734.2 +000900* * NC1734.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1734.2 +001100* * NC1734.2 +001200**************************************************************** NC1734.2 +001300* * NC1734.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1734.2 +001500* * NC1734.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1734.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1734.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1734.2 +001900* * NC1734.2 +002000**************************************************************** NC1734.2 +002100* THIS PROGRAM TESTS THE FORMAT 3 DIVIDE STATEMENT FOUND NC1734.2 +002200* IN LEVEL 1. ALL COMBINATIONS OF THE OPTIONAL PHRASES NC1734.2 +002300* "SIZE ERROR", "NOT SIZE ERROR" AND "END-MULTIPLY" ARE NC1734.2 +002400* TESTED, AS WELL AS THE ROUNDED OPTION. NC1734.2 +002500* NC1734.2 +002600* VARIOUS COMBINATIONS OF SIGNED AND UNSIGNED NUMERIC NC1734.2 +002700* LITERALS, DISPLAY AND COMPUTATIONAL FIELDS ARE USED NC1734.2 +002800* AS OPERANDS. NC1734.2 +002900* NC1734.2 +003000* NC1734.2 +003100 ENVIRONMENT DIVISION. NC1734.2 +003200 CONFIGURATION SECTION. NC1734.2 +003300 SOURCE-COMPUTER. NC1734.2 +003400 Linux. NC1734.2 +003500 OBJECT-COMPUTER. NC1734.2 +003600 Linux. NC1734.2 +003700 INPUT-OUTPUT SECTION. NC1734.2 +003800 FILE-CONTROL. NC1734.2 +003900 SELECT PRINT-FILE ASSIGN TO NC1734.2 +004000 "report.log". NC1734.2 +004100 DATA DIVISION. NC1734.2 +004200 FILE SECTION. NC1734.2 +004300 FD PRINT-FILE. NC1734.2 +004400 01 PRINT-REC PICTURE X(120). NC1734.2 +004500 01 DUMMY-RECORD PICTURE X(120). NC1734.2 +004600 WORKING-STORAGE SECTION. NC1734.2 +004700 77 WRK-DS-18V00 PICTURE S9(18). NC1734.2 +004800 77 A06THREES-DS-03V03 PICTURE S999V999 VALUE 333.333. NC1734.2 +004900 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1734.2 +005000 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 PICTURE S9(12). NC1734.2 +005100 77 A08TWOS-DS-02V06 PICTURE S99V9(6) VALUE 22.222222.NC1734.2 +005200 77 WRK-DS-10V00 PICTURE S9(10). NC1734.2 +005300 77 WRK-XN-00001 PICTURE X. NC1734.2 +005400 77 A10ONES-DS-10V00 PICTURE S9(10) NC1734.2 +005500 VALUE 1111111111. NC1734.2 +005600 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1734.2 +005700 VALUE 333333.333333. NC1734.2 +005800 77 WRK-DS-02V00 PICTURE S99. NC1734.2 +005900 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1734.2 +006000 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1734.2 +006100 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC1734.2 +006200 77 A05ONES-DS-00V05 PICTURE SV9(5) VALUE .11111. NC1734.2 +006300 77 A12ONES-DS-12V00 PICTURE S9(12) NC1734.2 +006400 VALUE 111111111111. NC1734.2 +006500 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1734.2 +006600 77 WRK-DS-09V08 PICTURE S9(9)V9(8). NC1734.2 +006700 77 WRK-DS-17V00-S REDEFINES WRK-DS-09V08 PICTURE S9(17). NC1734.2 +006800 77 A18ONES-DS-18V00 PICTURE S9(18) NC1734.2 +006900 VALUE 111111111111111111. NC1734.2 +007000 77 WRK-DS-0201P PICTURE S99P. NC1734.2 +007100 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1734.2 +007200 77 WRK-DU-18V00 PICTURE 9(18). NC1734.2 +007300 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1734.2 +007400 VALUE 99. NC1734.2 +007500 77 A01ONE-CS-00V01 PICTURE SV9 COMPUTATIONAL NC1734.2 +007600 VALUE .1. NC1734.2 +007700 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC1734.2 +007800 77 WRK-DS-12V00 PICTURE S9(12). NC1734.2 +007900 77 WRK-DS-01V00 PICTURE S9. NC1734.2 +008000 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC1734.2 +008100 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1734.2 +008200 VALUE 111111111.111111111. NC1734.2 +008300 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1734.2 +008400 77 WRK-DS-05V00 PICTURE S9(5). NC1734.2 +008500 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1734.2 +008600 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1734.2 +008700 77 A990-DS-0201P PICTURE S99P VALUE +990. NC1734.2 +008800 77 XRAY PICTURE X. NC1734.2 +008900 01 WRK-XN-18-1 PIC X(18). NC1734.2 +009000 01 WRK-AN-X-18-1, REDEFINES WRK-XN-18-1 PIC A(18). NC1734.2 +009100 01 WRK-DU-X-18V0-1; REDEFINES WRK-XN-18-1 PIC 9(18). NC1734.2 +009200 01 WRK-DU-0V1-1 PIC V9 VALUE .3. NC1734.2 +009300 01 WRK-DU-0V2-1 PIC V99 VALUE .25. NC1734.2 +009400 01 WRK-DU-0V12-1 PIC V9(12) VALUE .00001. NC1734.2 +009500 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1734.2 +009600 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1734.2 +009700 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1734.2 +009800 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1734.2 +009900 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1734.2 +010000 01 WRK-DU-1V5-1 PIC 9V9(5). NC1734.2 +010100 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1734.2 +010200 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1734.2 +010300 01 WRK-DU-2V0-1 PIC 99. NC1734.2 +010400 01 WRK-DU-2V0-2 PIC 99. NC1734.2 +010500 01 WRK-DU-2V0-3 PIC 99. NC1734.2 +010600 01 WRK-DU-2V1-1 PIC 99V9. NC1734.2 +010700 01 WRK-DU-2V1-2 PIC 99V9. NC1734.2 +010800 01 WRK-DU-2V1-3 PIC 99V9. NC1734.2 +010900 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1734.2 +011000 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1734.2 +011100 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1734.2 +011200 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1734.2 +011300 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1734.2 +011400 01 WRK-DU-2V5-1 PIC 99V9(5). NC1734.2 +011500 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1734.2 +011600 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1734.2 +011700 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1734.2 +011800 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1734.2 +011900 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1734.2 +012000 01 WRK-NE-X-1 PIC 9(16).99. NC1734.2 +012100 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1734.2 +012200 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1734.2 +012300 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1734.2 +012400 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1734.2 +012500 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1734.2 +012600 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1734.2 +012700 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1734.2 +012800 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1734.2 +012900 01 WRK-NE-X-2 PIC -9(16).99. NC1734.2 +013000 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1734.2 +013100 01 WRK-NE-2 PIC $**.99. NC1734.2 +013200 01 WRK-NE-3 PIC $99.99CR. NC1734.2 +013300 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1734.2 +013400 77 A01ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1734.2 +013500 VALUE +000000000000000001. NC1734.2 +013600 77 A02THREES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1734.2 +013700 VALUE -000000000000000033. NC1734.2 +013800 77 A18SIXES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1734.2 +013900 VALUE 666666666666666666. NC1734.2 +014000 77 A16NINES-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1734.2 +014100 VALUE 009999999999999999. NC1734.2 +014200 77 A14TWOS-CU-18V00 PICTURE 9(18) COMPUTATIONAL NC1734.2 +014300 VALUE 000022222222222222. NC1734.2 +014400 01 MULTIPLY-DATA. NC1734.2 +014500 02 MULT1 PICTURE IS 999V99 NC1734.2 +014600 VALUE IS 80.12. NC1734.2 +014700 02 MULT2 PICTURE IS 999V999. NC1734.2 +014800 02 MULT3 PICTURE IS $$99.99. NC1734.2 +014900 02 MULT4 PICTURE IS S99 NC1734.2 +015000 VALUE IS -56. NC1734.2 +015100 02 MULT5 PICTURE IS 9 VALUE IS 4. NC1734.2 +015200 02 MULT6 PICTURE IS 99 VALUE IS NC1734.2 +015300 20. NC1734.2 +015400 01 DIVIDE-DATA. NC1734.2 +015500 02 DIV1 PICTURE IS 9(4)V99 NC1734.2 +015600 VALUE IS 1620.36. NC1734.2 +015700 02 DIV2 PICTURE IS 99V9 NC1734.2 +015800 VALUE IS 44.1. NC1734.2 +015900 02 DIV3 PICTURE IS 9(4)V9 NC1734.2 +016000 VALUE IS 1661.7. NC1734.2 +016100 02 DIV4 PICTURE IS S9V999 NC1734.2 +016200 VALUE IS -9.642. NC1734.2 +016300 02 DIV-02LEVEL-1. NC1734.2 +016400 03 DIV5 PICTURE IS V99 NC1734.2 +016500 VALUE IS .82. NC1734.2 +016600 03 DIV6 PICTURE IS 9 VALUE IS 0. NC1734.2 +016700 03 DIV7 PICTURE IS 9V9 NC1734.2 +016800 VALUE IS 9.6. NC1734.2 +016900 01 DIV-DATA-2. NC1734.2 +017000 02 DIV8 PICTURE IS 99V9. NC1734.2 +017100 02 DIV9 PICTURE IS ZZ,ZZZ.9. NC1734.2 +017200 02 DIV10 PICTURE IS V999. NC1734.2 +017300 01 TEST-RESULTS. NC1734.2 +017400 02 FILLER PIC X VALUE SPACE. NC1734.2 +017500 02 FEATURE PIC X(20) VALUE SPACE. NC1734.2 +017600 02 FILLER PIC X VALUE SPACE. NC1734.2 +017700 02 P-OR-F PIC X(5) VALUE SPACE. NC1734.2 +017800 02 FILLER PIC X VALUE SPACE. NC1734.2 +017900 02 PAR-NAME. NC1734.2 +018000 03 FILLER PIC X(19) VALUE SPACE. NC1734.2 +018100 03 PARDOT-X PIC X VALUE SPACE. NC1734.2 +018200 03 DOTVALUE PIC 99 VALUE ZERO. NC1734.2 +018300 02 FILLER PIC X(8) VALUE SPACE. NC1734.2 +018400 02 RE-MARK PIC X(61). NC1734.2 +018500 01 TEST-COMPUTED. NC1734.2 +018600 02 FILLER PIC X(30) VALUE SPACE. NC1734.2 +018700 02 FILLER PIC X(17) VALUE NC1734.2 +018800 " COMPUTED=". NC1734.2 +018900 02 COMPUTED-X. NC1734.2 +019000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1734.2 +019100 03 COMPUTED-N REDEFINES COMPUTED-A NC1734.2 +019200 PIC -9(9).9(9). NC1734.2 +019300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1734.2 +019400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1734.2 +019500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1734.2 +019600 03 CM-18V0 REDEFINES COMPUTED-A. NC1734.2 +019700 04 COMPUTED-18V0 PIC -9(18). NC1734.2 +019800 04 FILLER PIC X. NC1734.2 +019900 03 FILLER PIC X(50) VALUE SPACE. NC1734.2 +020000 01 TEST-CORRECT. NC1734.2 +020100 02 FILLER PIC X(30) VALUE SPACE. NC1734.2 +020200 02 FILLER PIC X(17) VALUE " CORRECT =". NC1734.2 +020300 02 CORRECT-X. NC1734.2 +020400 03 CORRECT-A PIC X(20) VALUE SPACE. NC1734.2 +020500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1734.2 +020600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1734.2 +020700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1734.2 +020800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1734.2 +020900 03 CR-18V0 REDEFINES CORRECT-A. NC1734.2 +021000 04 CORRECT-18V0 PIC -9(18). NC1734.2 +021100 04 FILLER PIC X. NC1734.2 +021200 03 FILLER PIC X(2) VALUE SPACE. NC1734.2 +021300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1734.2 +021400 01 CCVS-C-1. NC1734.2 +021500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1734.2 +021600- "SS PARAGRAPH-NAME NC1734.2 +021700- " REMARKS". NC1734.2 +021800 02 FILLER PIC X(20) VALUE SPACE. NC1734.2 +021900 01 CCVS-C-2. NC1734.2 +022000 02 FILLER PIC X VALUE SPACE. NC1734.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". NC1734.2 +022200 02 FILLER PIC X(15) VALUE SPACE. NC1734.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". NC1734.2 +022400 02 FILLER PIC X(94) VALUE SPACE. NC1734.2 +022500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1734.2 +022600 01 REC-CT PIC 99 VALUE ZERO. NC1734.2 +022700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1734.2 +022800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1734.2 +022900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1734.2 +023000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1734.2 +023100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1734.2 +023200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1734.2 +023300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1734.2 +023400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1734.2 +023500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1734.2 +023600 01 CCVS-H-1. NC1734.2 +023700 02 FILLER PIC X(39) VALUE SPACES. NC1734.2 +023800 02 FILLER PIC X(42) VALUE NC1734.2 +023900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1734.2 +024000 02 FILLER PIC X(39) VALUE SPACES. NC1734.2 +024100 01 CCVS-H-2A. NC1734.2 +024200 02 FILLER PIC X(40) VALUE SPACE. NC1734.2 +024300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1734.2 +024400 02 FILLER PIC XXXX VALUE NC1734.2 +024500 "4.2 ". NC1734.2 +024600 02 FILLER PIC X(28) VALUE NC1734.2 +024700 " COPY - NOT FOR DISTRIBUTION". NC1734.2 +024800 02 FILLER PIC X(41) VALUE SPACE. NC1734.2 +024900 NC1734.2 +025000 01 CCVS-H-2B. NC1734.2 +025100 02 FILLER PIC X(15) VALUE NC1734.2 +025200 "TEST RESULT OF ". NC1734.2 +025300 02 TEST-ID PIC X(9). NC1734.2 +025400 02 FILLER PIC X(4) VALUE NC1734.2 +025500 " IN ". NC1734.2 +025600 02 FILLER PIC X(12) VALUE NC1734.2 +025700 " HIGH ". NC1734.2 +025800 02 FILLER PIC X(22) VALUE NC1734.2 +025900 " LEVEL VALIDATION FOR ". NC1734.2 +026000 02 FILLER PIC X(58) VALUE NC1734.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1734.2 +026200 01 CCVS-H-3. NC1734.2 +026300 02 FILLER PIC X(34) VALUE NC1734.2 +026400 " FOR OFFICIAL USE ONLY ". NC1734.2 +026500 02 FILLER PIC X(58) VALUE NC1734.2 +026600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1734.2 +026700 02 FILLER PIC X(28) VALUE NC1734.2 +026800 " COPYRIGHT 1985 ". NC1734.2 +026900 01 CCVS-E-1. NC1734.2 +027000 02 FILLER PIC X(52) VALUE SPACE. NC1734.2 +027100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1734.2 +027200 02 ID-AGAIN PIC X(9). NC1734.2 +027300 02 FILLER PIC X(45) VALUE SPACES. NC1734.2 +027400 01 CCVS-E-2. NC1734.2 +027500 02 FILLER PIC X(31) VALUE SPACE. NC1734.2 +027600 02 FILLER PIC X(21) VALUE SPACE. NC1734.2 +027700 02 CCVS-E-2-2. NC1734.2 +027800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1734.2 +027900 03 FILLER PIC X VALUE SPACE. NC1734.2 +028000 03 ENDER-DESC PIC X(44) VALUE NC1734.2 +028100 "ERRORS ENCOUNTERED". NC1734.2 +028200 01 CCVS-E-3. NC1734.2 +028300 02 FILLER PIC X(22) VALUE NC1734.2 +028400 " FOR OFFICIAL USE ONLY". NC1734.2 +028500 02 FILLER PIC X(12) VALUE SPACE. NC1734.2 +028600 02 FILLER PIC X(58) VALUE NC1734.2 +028700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1734.2 +028800 02 FILLER PIC X(13) VALUE SPACE. NC1734.2 +028900 02 FILLER PIC X(15) VALUE NC1734.2 +029000 " COPYRIGHT 1985". NC1734.2 +029100 01 CCVS-E-4. NC1734.2 +029200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1734.2 +029300 02 FILLER PIC X(4) VALUE " OF ". NC1734.2 +029400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1734.2 +029500 02 FILLER PIC X(40) VALUE NC1734.2 +029600 " TESTS WERE EXECUTED SUCCESSFULLY". NC1734.2 +029700 01 XXINFO. NC1734.2 +029800 02 FILLER PIC X(19) VALUE NC1734.2 +029900 "*** INFORMATION ***". NC1734.2 +030000 02 INFO-TEXT. NC1734.2 +030100 04 FILLER PIC X(8) VALUE SPACE. NC1734.2 +030200 04 XXCOMPUTED PIC X(20). NC1734.2 +030300 04 FILLER PIC X(5) VALUE SPACE. NC1734.2 +030400 04 XXCORRECT PIC X(20). NC1734.2 +030500 02 INF-ANSI-REFERENCE PIC X(48). NC1734.2 +030600 01 HYPHEN-LINE. NC1734.2 +030700 02 FILLER PIC IS X VALUE IS SPACE. NC1734.2 +030800 02 FILLER PIC IS X(65) VALUE IS "************************NC1734.2 +030900- "*****************************************". NC1734.2 +031000 02 FILLER PIC IS X(54) VALUE IS "************************NC1734.2 +031100- "******************************". NC1734.2 +031200 01 CCVS-PGM-ID PIC X(9) VALUE NC1734.2 +031300 "NC173A". NC1734.2 +031400 PROCEDURE DIVISION. NC1734.2 +031500 CCVS1 SECTION. NC1734.2 +031600 OPEN-FILES. NC1734.2 +031700 OPEN OUTPUT PRINT-FILE. NC1734.2 +031800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1734.2 +031900 MOVE SPACE TO TEST-RESULTS. NC1734.2 +032000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1734.2 +032100 GO TO CCVS1-EXIT. NC1734.2 +032200 CLOSE-FILES. NC1734.2 +032300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1734.2 +032400 TERMINATE-CCVS. NC1734.2 +032500*S EXIT PROGRAM. NC1734.2 +032600*SERMINATE-CALL. NC1734.2 +032700 STOP RUN. NC1734.2 +032800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1734.2 +032900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1734.2 +033000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1734.2 +033100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1734.2 +033200 MOVE "****TEST DELETED****" TO RE-MARK. NC1734.2 +033300 PRINT-DETAIL. NC1734.2 +033400 IF REC-CT NOT EQUAL TO ZERO NC1734.2 +033500 MOVE "." TO PARDOT-X NC1734.2 +033600 MOVE REC-CT TO DOTVALUE. NC1734.2 +033700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1734.2 +033800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1734.2 +033900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1734.2 +034000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1734.2 +034100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1734.2 +034200 MOVE SPACE TO CORRECT-X. NC1734.2 +034300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1734.2 +034400 MOVE SPACE TO RE-MARK. NC1734.2 +034500 HEAD-ROUTINE. NC1734.2 +034600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +034700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +034800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1734.2 +034900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1734.2 +035000 COLUMN-NAMES-ROUTINE. NC1734.2 +035100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +035200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +035300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +035400 END-ROUTINE. NC1734.2 +035500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1734.2 +035600 END-RTN-EXIT. NC1734.2 +035700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +035800 END-ROUTINE-1. NC1734.2 +035900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1734.2 +036000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1734.2 +036100 ADD PASS-COUNTER TO ERROR-HOLD. NC1734.2 +036200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1734.2 +036300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1734.2 +036400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1734.2 +036500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1734.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1734.2 +036700 END-ROUTINE-12. NC1734.2 +036800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1734.2 +036900 IF ERROR-COUNTER IS EQUAL TO ZERO NC1734.2 +037000 MOVE "NO " TO ERROR-TOTAL NC1734.2 +037100 ELSE NC1734.2 +037200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1734.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1734.2 +037400 PERFORM WRITE-LINE. NC1734.2 +037500 END-ROUTINE-13. NC1734.2 +037600 IF DELETE-COUNTER IS EQUAL TO ZERO NC1734.2 +037700 MOVE "NO " TO ERROR-TOTAL ELSE NC1734.2 +037800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1734.2 +037900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1734.2 +038000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +038100 IF INSPECT-COUNTER EQUAL TO ZERO NC1734.2 +038200 MOVE "NO " TO ERROR-TOTAL NC1734.2 +038300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1734.2 +038400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1734.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +038600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1734.2 +038700 WRITE-LINE. NC1734.2 +038800 ADD 1 TO RECORD-COUNT. NC1734.2 +038900 IF RECORD-COUNT GREATER 42 NC1734.2 +039000 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1734.2 +039100 MOVE SPACE TO DUMMY-RECORD NC1734.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1734.2 +039300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1734.2 +039400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1734.2 +039500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1734.2 +039600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1734.2 +039700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1734.2 +039800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1734.2 +039900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1734.2 +040000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1734.2 +040100 MOVE ZERO TO RECORD-COUNT. NC1734.2 +040200 PERFORM WRT-LN. NC1734.2 +040300 WRT-LN. NC1734.2 +040400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1734.2 +040500 MOVE SPACE TO DUMMY-RECORD. NC1734.2 +040600 BLANK-LINE-PRINT. NC1734.2 +040700 PERFORM WRT-LN. NC1734.2 +040800 FAIL-ROUTINE. NC1734.2 +040900 IF COMPUTED-X NOT EQUAL TO SPACE NC1734.2 +041000 GO TO FAIL-ROUTINE-WRITE. NC1734.2 +041100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1734.2 +041200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1734.2 +041300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1734.2 +041400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +041500 MOVE SPACES TO INF-ANSI-REFERENCE. NC1734.2 +041600 GO TO FAIL-ROUTINE-EX. NC1734.2 +041700 FAIL-ROUTINE-WRITE. NC1734.2 +041800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1734.2 +041900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1734.2 +042000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1734.2 +042100 MOVE SPACES TO COR-ANSI-REFERENCE. NC1734.2 +042200 FAIL-ROUTINE-EX. EXIT. NC1734.2 +042300 BAIL-OUT. NC1734.2 +042400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1734.2 +042500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1734.2 +042600 BAIL-OUT-WRITE. NC1734.2 +042700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1734.2 +042800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1734.2 +042900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1734.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. NC1734.2 +043100 BAIL-OUT-EX. EXIT. NC1734.2 +043200 CCVS1-EXIT. NC1734.2 +043300 EXIT. NC1734.2 +043400 SECT-NC173A-001 SECTION. NC1734.2 +043500 DIV-INIT-F3-1. NC1734.2 +043600 MOVE "DIVIDE BY GIVING" TO FEATURE. NC1734.2 +043700 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +043800 MOVE 44.1 TO DIV2. NC1734.2 +043900 MOVE 0 TO DIV8. NC1734.2 +044000 DIV-TEST-F3-1-0. NC1734.2 +044100 DIVIDE 864.36 BY DIV2 GIVING DIV8. NC1734.2 +044200 DIV-TEST-F3-1. NC1734.2 +044300 IF DIV8 EQUAL TO 19.6 NC1734.2 +044400 PERFORM PASS NC1734.2 +044500 ELSE NC1734.2 +044600 GO TO DIV-FAIL-F3-1. NC1734.2 +044700 GO TO DIV-WRITE-F3-1. NC1734.2 +044800 DIV-DELETE-F3-1. NC1734.2 +044900 PERFORM DE-LETE. NC1734.2 +045000 GO TO DIV-WRITE-F3-1. NC1734.2 +045100 DIV-FAIL-F3-1. NC1734.2 +045200 PERFORM FAIL. NC1734.2 +045300 MOVE DIV8 TO COMPUTED-N. NC1734.2 +045400 MOVE 19.6 TO CORRECT-N. NC1734.2 +045500 DIV-WRITE-F3-1. NC1734.2 +045600 MOVE "DIV-TEST-F3-1" TO PAR-NAME. NC1734.2 +045700 PERFORM PRINT-DETAIL. NC1734.2 +045800 DIV-INIT-F3-2. NC1734.2 +045900 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +046000 MOVE 0 TO DIV9. NC1734.2 +046100 DIV-TEST-F3-2. NC1734.2 +046200 DIVIDE DIV1 BY 0.533 GIVING DIV9 ROUNDED. NC1734.2 +046300 IF DIV9 EQUAL TO " 3,040.1" NC1734.2 +046400 PERFORM PASS NC1734.2 +046500 ELSE NC1734.2 +046600 GO TO DIV-FAIL-F3-2. NC1734.2 +046700 GO TO DIV-WRITE-F3-2. NC1734.2 +046800 DIV-DELETE-F3-2. NC1734.2 +046900 PERFORM DE-LETE. NC1734.2 +047000 GO TO DIV-WRITE-F3-2. NC1734.2 +047100 DIV-FAIL-F3-2. NC1734.2 +047200 PERFORM FAIL. NC1734.2 +047300 MOVE DIV9 TO COMPUTED-A. NC1734.2 +047400 MOVE " 3,040.1" TO CORRECT-A. NC1734.2 +047500 DIV-WRITE-F3-2. NC1734.2 +047600 MOVE "DIV-TEST-F3-2" TO PAR-NAME. NC1734.2 +047700 PERFORM PRINT-DETAIL. NC1734.2 +047800 DIV-INIT-F3-3. NC1734.2 +047900 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +048000 MOVE 44.1 TO DIV2. NC1734.2 +048100 MOVE -9.642 TO DIV4. NC1734.2 +048200 MOVE 0 TO DIV10. NC1734.2 +048300 MOVE 1 TO REC-CT. NC1734.2 +048400 DIV-TEST-F3-3-0. NC1734.2 +048500 DIVIDE DIV2 BY DIV4 GIVING DIV10 ON SIZE ERROR NC1734.2 +048600 MOVE "P" TO XRAY. NC1734.2 +048700 GO TO DIV-TEST-F3-3-1. NC1734.2 +048800 DIV-DELETE-F3-3-1. NC1734.2 +048900 PERFORM DE-LETE. NC1734.2 +049000 PERFORM PRINT-DETAIL. NC1734.2 +049100 GO TO DIV-INIT-F3-4. NC1734.2 +049200 DIV-TEST-F3-3-1. NC1734.2 +049300 MOVE "DIV-TEST-F3-3-1" TO PAR-NAME. NC1734.2 +049400 IF XRAY = "P" NC1734.2 +049500 PERFORM PASS NC1734.2 +049600 PERFORM PRINT-DETAIL NC1734.2 +049700 ELSE NC1734.2 +049800 MOVE XRAY TO COMPUTED-X NC1734.2 +049900 MOVE "P" TO CORRECT-X NC1734.2 +050000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +050100 PERFORM FAIL NC1734.2 +050200 PERFORM PRINT-DETAIL. NC1734.2 +050300 ADD 1 TO REC-CT. NC1734.2 +050400 DIV-TEST-F3-3-2. NC1734.2 +050500 MOVE "DIV-TEST-F3-3-2" TO PAR-NAME. NC1734.2 +050600 IF DIV10 = 0 NC1734.2 +050700 PERFORM PASS NC1734.2 +050800 PERFORM PRINT-DETAIL NC1734.2 +050900 ELSE NC1734.2 +051000 MOVE DIV10 TO COMPUTED-N NC1734.2 +051100 MOVE 0 TO CORRECT-N NC1734.2 +051200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +051300 PERFORM FAIL NC1734.2 +051400 PERFORM PRINT-DETAIL. NC1734.2 +051500 DIV-INIT-F3-4. NC1734.2 +051600 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +051700 MOVE 0 TO DIV8. NC1734.2 +051800 MOVE 1 TO REC-CT. NC1734.2 +051900 DIV-TEST-F3-4-0. NC1734.2 +052000 DIVIDE 100.50 BY 1.0051 GIVING DIV8 ROUNDED ON SIZE ERROR NC1734.2 +052100 MOVE "Q" TO XRAY. NC1734.2 +052200 GO TO DIV-TEST-F3-4-1. NC1734.2 +052300 DIV-DELETE-F3-4. NC1734.2 +052400 PERFORM DE-LETE. NC1734.2 +052500 PERFORM PRINT-DETAIL. NC1734.2 +052600 GO TO DIV-INIT-F3-5. NC1734.2 +052700 DIV-TEST-F3-4-1. NC1734.2 +052800 MOVE "DIV-TEST-F3-4-1" TO PAR-NAME. NC1734.2 +052900 IF XRAY = "Q" NC1734.2 +053000 PERFORM PASS NC1734.2 +053100 PERFORM PRINT-DETAIL NC1734.2 +053200 ELSE NC1734.2 +053300 MOVE XRAY TO COMPUTED-X NC1734.2 +053400 MOVE "Q" TO CORRECT-X NC1734.2 +053500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +053600 PERFORM FAIL NC1734.2 +053700 PERFORM PRINT-DETAIL. NC1734.2 +053800 ADD 1 TO REC-CT. NC1734.2 +053900 DIV-TEST-F3-4-2. NC1734.2 +054000 MOVE "DIV-TEST-F3-4-2" TO PAR-NAME. NC1734.2 +054100 IF DIV8 = 0 NC1734.2 +054200 PERFORM PASS NC1734.2 +054300 PERFORM PRINT-DETAIL NC1734.2 +054400 ELSE NC1734.2 +054500 MOVE DIV8 TO COMPUTED-N NC1734.2 +054600 MOVE 0 TO CORRECT-N NC1734.2 +054700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +054800 PERFORM FAIL NC1734.2 +054900 PERFORM PRINT-DETAIL. NC1734.2 +055000 DIV-INIT-F3-5. NC1734.2 +055100 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +055200 MOVE ZERO TO REC-CT. NC1734.2 +055300 MOVE ZERO TO WRK-DS-01V00. NC1734.2 +055400 DIV-TEST-F3-5-0. NC1734.2 +055500 DIVIDE A02TWOS-DU-02V00 BY -10.9 GIVING WRK-DS-01V00. NC1734.2 +055600 DIV-TEST-F3-5-1. NC1734.2 +055700 IF WRK-DS-01V00 EQUAL TO -2 NC1734.2 +055800 PERFORM PASS NC1734.2 +055900 GO TO DIV-WRITE-F3-5. NC1734.2 +056000 GO TO DIV-FAIL-F3-5. NC1734.2 +056100 DIV-DELETE-F3-5. NC1734.2 +056200 PERFORM DE-LETE. NC1734.2 +056300 GO TO DIV-WRITE-F3-5. NC1734.2 +056400 DIV-FAIL-F3-5. NC1734.2 +056500 MOVE -2 TO CORRECT-N. NC1734.2 +056600 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1734.2 +056700 PERFORM FAIL. NC1734.2 +056800 DIV-WRITE-F3-5. NC1734.2 +056900 MOVE "DIV-TEST-F3-5 " TO PAR-NAME. NC1734.2 +057000 PERFORM PRINT-DETAIL. NC1734.2 +057100 DIV-INIT-F3-6. NC1734.2 +057200 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +057300 MOVE 0.0000000001 TO WRK-DS-03V10. NC1734.2 +057400 MOVE ZERO TO WRK-DS-18V00. NC1734.2 +057500 DIV-TEST-F3-6-0. NC1734.2 +057600 DIVIDE A01ONE-DS-P0801 BY WRK-DS-03V10 GIVING NC1734.2 +057700 WRK-DS-18V00 ROUNDED. NC1734.2 +057800 DIV-TEST-F3-6-1. NC1734.2 +057900 IF WRK-DS-18V00 EQUAL TO 000000000000000010 NC1734.2 +058000 PERFORM PASS NC1734.2 +058100 GO TO DIV-WRITE-F3-6. NC1734.2 +058200 GO TO DIV-FAIL-F3-6. NC1734.2 +058300 DIV-DELETE-F3-6. NC1734.2 +058400 PERFORM DE-LETE. NC1734.2 +058500 GO TO DIV-WRITE-F3-6. NC1734.2 +058600 DIV-FAIL-F3-6. NC1734.2 +058700 MOVE 000000000000000010 TO CORRECT-18V0. NC1734.2 +058800 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1734.2 +058900 PERFORM FAIL. NC1734.2 +059000 DIV-WRITE-F3-6. NC1734.2 +059100 MOVE "DIV-TEST-F3-6 " TO PAR-NAME. NC1734.2 +059200 PERFORM PRINT-DETAIL. NC1734.2 +059300 DIV-INIT-F3-7. NC1734.2 +059400 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +059500 MOVE ZERO TO WRK-DS-18V00. NC1734.2 +059600 MOVE "0" TO WRK-XN-00001. NC1734.2 +059700 MOVE 1 TO REC-CT. NC1734.2 +059800 DIV-TEST-F3-7-0. NC1734.2 +059900 DIVIDE A99-DS-02V00 BY AZERO-DS-05V05 GIVING NC1734.2 +060000 WRK-DS-18V00 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC1734.2 +060100 DIV-TEST-F3-7-1. NC1734.2 +060200 IF WRK-DS-18V00 EQUAL TO 000000000000000000 NC1734.2 +060300 PERFORM PASS NC1734.2 +060400 GO TO DIV-WRITE-F3-7-1. NC1734.2 +060500 MOVE 000000000000000000 TO CORRECT-18V0. NC1734.2 +060600 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1734.2 +060700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1734.2 +060800 PERFORM FAIL. NC1734.2 +060900 GO TO DIV-WRITE-F3-7-1. NC1734.2 +061000 DIV-DELETE-F3-7-1. NC1734.2 +061100 PERFORM DE-LETE. NC1734.2 +061200 DIV-WRITE-F3-7-1. NC1734.2 +061300 MOVE "DIV-TEST-F3-7-1" TO PAR-NAME. NC1734.2 +061400 PERFORM PRINT-DETAIL. NC1734.2 +061500 ADD 1 TO REC-CT. NC1734.2 +061600 DIV-TEST-F3-7-2. NC1734.2 +061700 IF WRK-XN-00001 EQUAL TO "1" NC1734.2 +061800 PERFORM PASS NC1734.2 +061900 GO TO DIV-WRITE-F3-7-2. NC1734.2 +062000 MOVE "1" TO CORRECT-A. NC1734.2 +062100 MOVE WRK-XN-00001 TO COMPUTED-A. NC1734.2 +062200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1734.2 +062300 PERFORM FAIL. NC1734.2 +062400 GO TO DIV-WRITE-F3-7-2. NC1734.2 +062500 DIV-DELETE-F3-7-2. NC1734.2 +062600 PERFORM DE-LETE. NC1734.2 +062700 DIV-WRITE-F3-7-2. NC1734.2 +062800 MOVE "DIV-TEST-F3-7-2 " TO PAR-NAME. NC1734.2 +062900 PERFORM PRINT-DETAIL. NC1734.2 +063000 DIV-INIT-F3-8. NC1734.2 +063100 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +063200 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +063300 MOVE "1" TO WRK-XN-00001. NC1734.2 +063400 MOVE 1 TO REC-CT. NC1734.2 +063500 DIV-TEST-F3-8-1. NC1734.2 +063600 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 GIVING NC1734.2 +063700 WRK-DS-09V09 ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1734.2 +063800 IF WRK-DS-18V00-S EQUAL TO 000000001000000000 NC1734.2 +063900 PERFORM PASS NC1734.2 +064000 GO TO DIV-WRITE-F3-8-1. NC1734.2 +064100 DIV-FAIL-F3-8-1. NC1734.2 +064200 MOVE 000000001000000000 TO CORRECT-18V0. NC1734.2 +064300 MOVE WRK-DS-18V00-S TO COMPUTED-18V0. NC1734.2 +064400 PERFORM FAIL. NC1734.2 +064500 GO TO DIV-WRITE-F3-8-1. NC1734.2 +064600 DIV-DELETE-F3-8-1. NC1734.2 +064700 PERFORM DE-LETE. NC1734.2 +064800 DIV-WRITE-F3-8-1. NC1734.2 +064900 MOVE "DIV-TEST-F3-8-1 " TO PAR-NAME. NC1734.2 +065000 PERFORM PRINT-DETAIL. NC1734.2 +065100 ADD 1 TO REC-CT. NC1734.2 +065200 DIV-TEST-F3-8-2. NC1734.2 +065300 IF WRK-XN-00001 EQUAL TO "0" NC1734.2 +065400 MOVE WRK-XN-00001 TO COMPUTED-A NC1734.2 +065500 MOVE "1" TO CORRECT-A NC1734.2 +065600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1734.2 +065700 PERFORM FAIL NC1734.2 +065800 GO TO DIV-WRITE-F3-8-2. NC1734.2 +065900 PERFORM PASS. NC1734.2 +066000 GO TO DIV-WRITE-F3-8-2. NC1734.2 +066100 DIV-DELETE-F3-8-2. NC1734.2 +066200 PERFORM DE-LETE. NC1734.2 +066300 DIV-WRITE-F3-8-2. NC1734.2 +066400 MOVE "DIV-TEST-F3-8-2 " TO PAR-NAME. NC1734.2 +066500 PERFORM PRINT-DETAIL. NC1734.2 +066600 DIV-INIT-F3-9. NC1734.2 +066700 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +066800 MOVE ZERO TO WRK-DS-0201P. NC1734.2 +066900 MOVE -0.005 TO WRK-DS-09V09. NC1734.2 +067000 MOVE "0" TO WRK-XN-00001. NC1734.2 +067100 MOVE 1 TO REC-CT. NC1734.2 +067200 DIV-TEST-F3-9-1-0. NC1734.2 +067300 DIVIDE A05ONES-DS-00V05 BY WRK-DS-09V09 GIVING NC1734.2 +067400 WRK-DS-0201P ROUNDED ON SIZE ERROR NC1734.2 +067500 MOVE "1" TO WRK-XN-00001. NC1734.2 +067600 DIV-TEST-F3-9-1-1. NC1734.2 +067700 MOVE WRK-DS-0201P TO WRK-DS-05V00. NC1734.2 +067800 IF WRK-DS-05V00 EQUAL TO -00020 NC1734.2 +067900 PERFORM PASS NC1734.2 +068000 GO TO DIV-WRITE-F3-9-1. NC1734.2 +068100 MOVE -00020 TO CORRECT-N. NC1734.2 +068200 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1734.2 +068300 PERFORM FAIL. NC1734.2 +068400 GO TO DIV-WRITE-F3-9-1. NC1734.2 +068500 DIV-DELETE-F3-9-1. NC1734.2 +068600 PERFORM DE-LETE. NC1734.2 +068700 DIV-WRITE-F3-9-1. NC1734.2 +068800 MOVE "DIV-TEST-F3-9-1 " TO PAR-NAME. NC1734.2 +068900 PERFORM PRINT-DETAIL. NC1734.2 +069000 ADD 1 TO REC-CT. NC1734.2 +069100 DIV-TEST-F3-9-2-1. NC1734.2 +069200 IF WRK-XN-00001 EQUAL TO "0" NC1734.2 +069300 PERFORM PASS NC1734.2 +069400 GO TO DIV-WRITE-F3-9-2. NC1734.2 +069500 MOVE "0" TO CORRECT-A. NC1734.2 +069600 MOVE WRK-XN-00001 TO COMPUTED-A. NC1734.2 +069700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC1734.2 +069800 PERFORM FAIL. NC1734.2 +069900 GO TO DIV-WRITE-F3-9-2. NC1734.2 +070000 DIV-DELETE-F3-9-2. NC1734.2 +070100 PERFORM DE-LETE. NC1734.2 +070200 DIV-WRITE-F3-9-2. NC1734.2 +070300 MOVE "DIV-TEST-F3-9-2 " TO PAR-NAME. NC1734.2 +070400 PERFORM PRINT-DETAIL. NC1734.2 +070500 DIV-INIT-F3-10. NC1734.2 +070600 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +070700 MOVE "1" TO WRK-XN-00001. NC1734.2 +070800 MOVE ZERO TO WRK-DS-01V00. NC1734.2 +070900 MOVE 1 TO REC-CT. NC1734.2 +071000 DIV-TEST-F3-10-0. NC1734.2 +071100 DIVIDE A02TWOS-DS-03V02 BY A02TWOS-DU-02V00 GIVING NC1734.2 +071200 WRK-DS-01V00 ROUNDED ON SIZE ERROR NC1734.2 +071300 MOVE "0" TO WRK-XN-00001. NC1734.2 +071400 DIV-TEST-F3-10-1. NC1734.2 +071500 IF WRK-DS-01V00 EQUAL TO +1 NC1734.2 +071600 PERFORM PASS NC1734.2 +071700 GO TO DIV-WRITE-F3-10-1. NC1734.2 +071800 MOVE +1 TO CORRECT-N. NC1734.2 +071900 MOVE WRK-DS-01V00 TO COMPUTED-N. NC1734.2 +072000 PERFORM FAIL. NC1734.2 +072100 GO TO DIV-WRITE-F3-10-1. NC1734.2 +072200 DIV-DELETE-F3-10-1. NC1734.2 +072300 PERFORM DE-LETE. NC1734.2 +072400 DIV-WRITE-F3-10-1. NC1734.2 +072500 MOVE "DIV-TEST-F3-10-1" TO PAR-NAME. NC1734.2 +072600 PERFORM PRINT-DETAIL. NC1734.2 +072700 ADD 1 TO REC-CT. NC1734.2 +072800 DIV-TEST-F3-10-2. NC1734.2 +072900 IF WRK-XN-00001 EQUAL TO "0" NC1734.2 +073000 MOVE "0" TO COMPUTED-A NC1734.2 +073100 MOVE "1" TO CORRECT-A NC1734.2 +073200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1734.2 +073300 PERFORM FAIL NC1734.2 +073400 GO TO DIV-WRITE-F3-10-2. NC1734.2 +073500 PERFORM PASS. NC1734.2 +073600 GO TO DIV-WRITE-F3-10-2. NC1734.2 +073700 DIV-DELETE-F3-10-2. NC1734.2 +073800 PERFORM DE-LETE. NC1734.2 +073900 DIV-WRITE-F3-10-2. NC1734.2 +074000 MOVE "DIV-TEST-F3-10-2 " TO PAR-NAME. NC1734.2 +074100 PERFORM PRINT-DETAIL. NC1734.2 +074200 DIV-INIT-F3-11. NC1734.2 +074300 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +074400 MOVE 0 TO WRK-DS-05V00. NC1734.2 +074500 DIV-TEST-F3-11-0. NC1734.2 +074600 DIVIDE A99-CS-02V00 BY A01ONE-CS-00V01 GIVING NC1734.2 +074700 WRK-DS-05V00. NC1734.2 +074800 DIV-TEST-F3-11-1. NC1734.2 +074900 IF WRK-DS-05V00 EQUAL TO 00990 NC1734.2 +075000 PERFORM PASS NC1734.2 +075100 GO TO DIV-WRITE-F3-11. NC1734.2 +075200 GO TO DIV-FAIL-F3-11. NC1734.2 +075300 DIV-DELETE-F3-11. NC1734.2 +075400 PERFORM DE-LETE. NC1734.2 +075500 GO TO DIV-WRITE-F3-11. NC1734.2 +075600 DIV-FAIL-F3-11. NC1734.2 +075700 MOVE 00990 TO CORRECT-N. NC1734.2 +075800 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1734.2 +075900 PERFORM FAIL. NC1734.2 +076000 DIV-WRITE-F3-11. NC1734.2 +076100 MOVE "DIV-TEST-F3-11 " TO PAR-NAME. NC1734.2 +076200 PERFORM PRINT-DETAIL. NC1734.2 +076300 DIV-INIT-F3-12. NC1734.2 +076400 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +076500 MOVE ZERO TO WRK-CS-18V00. NC1734.2 +076600 DIV-TEST-F3-12-0. NC1734.2 +076700 DIVIDE A16NINES-CU-18V00 BY A02THREES-CS-18V00 NC1734.2 +076800 GIVING WRK-CS-18V00. NC1734.2 +076900 DIV-TEST-F3-12-1. NC1734.2 +077000 IF WRK-CS-18V00 EQUAL TO -000303030303030303 NC1734.2 +077100 PERFORM PASS NC1734.2 +077200 GO TO DIV-WRITE-F3-12. NC1734.2 +077300 MOVE -00303030303030303 TO CORRECT-18V0. NC1734.2 +077400 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1734.2 +077500 PERFORM FAIL. NC1734.2 +077600 GO TO DIV-WRITE-F3-12. NC1734.2 +077700 DIV-DELETE-F3-12. NC1734.2 +077800 PERFORM DE-LETE. NC1734.2 +077900 DIV-WRITE-F3-12. NC1734.2 +078000 MOVE "DIV-TEST-F3-12 " TO PAR-NAME. NC1734.2 +078100 PERFORM PRINT-DETAIL. NC1734.2 +078200 DIV-INIT-F3-13. NC1734.2 +078300 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +078400 MOVE ZERO TO WRK-DU-18V00. NC1734.2 +078500 DIV-TEST-F3-13-0. NC1734.2 +078600 DIVIDE A18SIXES-CU-18V00 BY A14TWOS-CU-18V00 GIVING NC1734.2 +078700 WRK-DU-18V00. NC1734.2 +078800 DIV-TEST-F3-13-1. NC1734.2 +078900 IF WRK-DU-18V00 EQUAL TO 000000000000030000 NC1734.2 +079000 PERFORM PASS NC1734.2 +079100 GO TO DIV-WRITE-F3-13. NC1734.2 +079200 MOVE 000000000000030000 TO CORRECT-18V0. NC1734.2 +079300 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1734.2 +079400 PERFORM FAIL. NC1734.2 +079500 GO TO DIV-WRITE-F3-13. NC1734.2 +079600 DIV-DELETE-F3-13. NC1734.2 +079700 PERFORM DE-LETE. NC1734.2 +079800 DIV-WRITE-F3-13. NC1734.2 +079900 MOVE "DIV-TEST-F3-13 " TO PAR-NAME. NC1734.2 +080000 PERFORM PRINT-DETAIL. NC1734.2 +080100 DIV-INIT-F3-14. NC1734.2 +080200 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +080300 MOVE ZERO TO WRK-CS-18V00. NC1734.2 +080400 DIV-TEST-F3-14-0. NC1734.2 +080500 DIVIDE A02THREES-CS-18V00 BY A01ONES-CS-18V00 GIVING NC1734.2 +080600 WRK-CS-18V00 ROUNDED. NC1734.2 +080700 DIV-TEST-F3-14-1. NC1734.2 +080800 IF WRK-CS-18V00 EQUAL TO -000000000000000033 NC1734.2 +080900 PERFORM PASS NC1734.2 +081000 GO TO DIV-WRITE-F3-14. NC1734.2 +081100 MOVE -000000000000000033 TO CORRECT-18V0. NC1734.2 +081200 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1734.2 +081300 PERFORM FAIL. NC1734.2 +081400 GO TO DIV-WRITE-F3-14. NC1734.2 +081500 DIV-DELETE-F3-14. NC1734.2 +081600 PERFORM DE-LETE. NC1734.2 +081700 DIV-WRITE-F3-14. NC1734.2 +081800 MOVE "DIV-TEST-F3-14 " TO PAR-NAME. NC1734.2 +081900 PERFORM PRINT-DETAIL. NC1734.2 +082000* NC1734.2 +082100* NC1734.2 +082200 DIV-INIT-F3-15. NC1734.2 +082300* ==--> SIZE ERROR CONDITION <--== NC1734.2 +082400* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +082500 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1734.2 +082600 MOVE "DIV-TEST-F3-15" TO PAR-NAME. NC1734.2 +082700 MOVE 44.1 TO DIV2. NC1734.2 +082800 MOVE -9.642 TO DIV4. NC1734.2 +082900 MOVE 0 TO DIV10. NC1734.2 +083000 MOVE 1 TO REC-CT. NC1734.2 +083100 MOVE "A" TO XRAY. NC1734.2 +083200 DIV-TEST-F3-15-0. NC1734.2 +083300 DIVIDE DIV2 BY DIV4 NC1734.2 +083400 GIVING DIV10 NC1734.2 +083500 NOT ON SIZE ERROR NC1734.2 +083600 MOVE "P" TO XRAY. NC1734.2 +083700 GO TO DIV-TEST-F3-15-1. NC1734.2 +083800 DIV-DELETE-F3-15-1. NC1734.2 +083900 PERFORM DE-LETE. NC1734.2 +084000 PERFORM PRINT-DETAIL. NC1734.2 +084100 GO TO DIV-INIT-F3-16. NC1734.2 +084200 DIV-TEST-F3-15-1. NC1734.2 +084300 MOVE "DIV-TEST-F3-15-1" TO PAR-NAME. NC1734.2 +084400 IF XRAY = "A" NC1734.2 +084500 PERFORM PASS NC1734.2 +084600 PERFORM PRINT-DETAIL NC1734.2 +084700 ELSE NC1734.2 +084800 MOVE XRAY TO COMPUTED-X NC1734.2 +084900 MOVE "A" TO CORRECT-X NC1734.2 +085000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +085100 PERFORM FAIL NC1734.2 +085200 PERFORM PRINT-DETAIL. NC1734.2 +085300 ADD 1 TO REC-CT. NC1734.2 +085400 DIV-TEST-F3-15-2. NC1734.2 +085500 MOVE "DIV-TEST-F3-15-2" TO PAR-NAME. NC1734.2 +085600 IF DIV10 = 0 NC1734.2 +085700 PERFORM PASS NC1734.2 +085800 PERFORM PRINT-DETAIL NC1734.2 +085900 ELSE NC1734.2 +086000 MOVE DIV10 TO COMPUTED-N NC1734.2 +086100 MOVE 0 TO CORRECT-N NC1734.2 +086200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +086300 PERFORM FAIL NC1734.2 +086400 PERFORM PRINT-DETAIL. NC1734.2 +086500* NC1734.2 +086600* NC1734.2 +086700 DIV-INIT-F3-16. NC1734.2 +086800 MOVE "DIV-TEST-F3-16" TO PAR-NAME. NC1734.2 +086900 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1734.2 +087000* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +087100* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +087200 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +087300 MOVE 1 TO REC-CT. NC1734.2 +087400 MOVE "1" TO WRK-XN-00001. NC1734.2 +087500 DIV-TEST-F3-16-0. NC1734.2 +087600 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +087700 GIVING WRK-DS-09V09 NC1734.2 +087800 NOT ON SIZE ERROR MOVE "0" TO WRK-XN-00001. NC1734.2 +087900 GO TO DIV-TEST-F3-16-1. NC1734.2 +088000 DIV-DELETE-F3-16-1. NC1734.2 +088100 PERFORM DE-LETE. NC1734.2 +088200 PERFORM PRINT-DETAIL. NC1734.2 +088300 GO TO DIV-INIT-F3-17. NC1734.2 +088400 DIV-TEST-F3-16-1. NC1734.2 +088500 MOVE "DIV-TEST-F3-16-1" TO PAR-NAME. NC1734.2 +088600 IF WRK-DS-18V00-S EQUAL TO 000000001000000000 NC1734.2 +088700 PERFORM PASS NC1734.2 +088800 PERFORM PRINT-DETAIL NC1734.2 +088900 ELSE NC1734.2 +089000 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +089100 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +089200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +089300 PERFORM FAIL NC1734.2 +089400 PERFORM PRINT-DETAIL. NC1734.2 +089500 ADD 1 TO REC-CT. NC1734.2 +089600 DIV-TEST-F3-16-2. NC1734.2 +089700 MOVE "DIV-TEST-F3-16-2" TO PAR-NAME. NC1734.2 +089800 IF WRK-XN-00001 = "0" NC1734.2 +089900 PERFORM PASS NC1734.2 +090000 PERFORM PRINT-DETAIL NC1734.2 +090100 ELSE NC1734.2 +090200 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +090300 MOVE "0" TO CORRECT-X NC1734.2 +090400 MOVE "NOT ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +090500 PERFORM FAIL NC1734.2 +090600 PERFORM PRINT-DETAIL. NC1734.2 +090700* NC1734.2 +090800* NC1734.2 +090900 DIV-INIT-F3-17. NC1734.2 +091000* ==--> SIZE ERROR CONDITION <--== NC1734.2 +091100* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +091200 MOVE "DIV-TEST-F3-17" TO PAR-NAME. NC1734.2 +091300 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1734.2 +091400 MOVE 44.1 TO DIV2. NC1734.2 +091500 MOVE -9.642 TO DIV4. NC1734.2 +091600 MOVE 0 TO DIV10. NC1734.2 +091700 MOVE 1 TO REC-CT. NC1734.2 +091800 MOVE "A" TO XRAY. NC1734.2 +091900 DIV-TEST-F3-17-0. NC1734.2 +092000 DIVIDE DIV2 BY DIV4 NC1734.2 +092100 GIVING DIV10 NC1734.2 +092200 ON SIZE ERROR NC1734.2 +092300 MOVE "E" TO XRAY NC1734.2 +092400 NOT ON SIZE ERROR NC1734.2 +092500 MOVE "N" TO XRAY. NC1734.2 +092600 GO TO DIV-TEST-F3-17-1. NC1734.2 +092700 DIV-DELETE-F3-17-1. NC1734.2 +092800 PERFORM DE-LETE. NC1734.2 +092900 PERFORM PRINT-DETAIL. NC1734.2 +093000 GO TO DIV-INIT-F3-18. NC1734.2 +093100 DIV-TEST-F3-17-1. NC1734.2 +093200 MOVE "DIV-TEST-F3-17-1" TO PAR-NAME. NC1734.2 +093300 IF XRAY = "E" NC1734.2 +093400 PERFORM PASS NC1734.2 +093500 PERFORM PRINT-DETAIL NC1734.2 +093600 ELSE NC1734.2 +093700 MOVE XRAY TO COMPUTED-X NC1734.2 +093800 MOVE "E" TO CORRECT-X NC1734.2 +093900 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +094000 PERFORM FAIL NC1734.2 +094100 PERFORM PRINT-DETAIL. NC1734.2 +094200 ADD 1 TO REC-CT. NC1734.2 +094300 DIV-TEST-F3-17-2. NC1734.2 +094400 MOVE "DIV-TEST-F3-17-2" TO PAR-NAME. NC1734.2 +094500 IF DIV10 = 0 NC1734.2 +094600 PERFORM PASS NC1734.2 +094700 PERFORM PRINT-DETAIL NC1734.2 +094800 ELSE NC1734.2 +094900 MOVE DIV10 TO COMPUTED-N NC1734.2 +095000 MOVE 0 TO CORRECT-N NC1734.2 +095100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +095200 PERFORM FAIL NC1734.2 +095300 PERFORM PRINT-DETAIL. NC1734.2 +095400* NC1734.2 +095500* NC1734.2 +095600 DIV-INIT-F3-18. NC1734.2 +095700* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +095800* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +095900 MOVE "V1-67 6.4.2 " TO ANSI-REFERENCE. NC1734.2 +096000 MOVE 1 TO REC-CT. NC1734.2 +096100 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +096200 MOVE "1" TO WRK-XN-00001. NC1734.2 +096300 DIV-TEST-F3-18-0. NC1734.2 +096400 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +096500 GIVING WRK-DS-09V09 NC1734.2 +096600 ON SIZE ERROR NC1734.2 +096700 MOVE "1" TO WRK-XN-00001 NC1734.2 +096800 NOT ON SIZE ERROR NC1734.2 +096900 MOVE "2" TO WRK-XN-00001. NC1734.2 +097000 GO TO DIV-TEST-F3-18-1. NC1734.2 +097100 DIV-DELETE-F3-18-1. NC1734.2 +097200 PERFORM DE-LETE. NC1734.2 +097300 PERFORM PRINT-DETAIL. NC1734.2 +097400 GO TO DIV-INIT-F3-19. NC1734.2 +097500 DIV-TEST-F3-18-1. NC1734.2 +097600 MOVE "DIV-TEST-F3-18-1" TO PAR-NAME. NC1734.2 +097700 IF WRK-DS-09V09 EQUAL TO 1 NC1734.2 +097800 PERFORM PASS NC1734.2 +097900 PERFORM PRINT-DETAIL NC1734.2 +098000 ELSE NC1734.2 +098100 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +098200 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +098300 MOVE "DIV-TEST-F3-18-2" TO PAR-NAME NC1734.2 +098400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +098500 PERFORM FAIL NC1734.2 +098600 PERFORM PRINT-DETAIL. NC1734.2 +098700 MOVE 1 TO REC-CT. NC1734.2 +098800 DIV-TEST-F3-18-2. NC1734.2 +098900 MOVE "DIV-TEST-F3-18-2" TO PAR-NAME. NC1734.2 +099000 IF WRK-XN-00001 = "2" NC1734.2 +099100 PERFORM PASS NC1734.2 +099200 PERFORM PRINT-DETAIL NC1734.2 +099300 ELSE NC1734.2 +099400 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +099500 MOVE "2" TO CORRECT-X NC1734.2 +099600 MOVE "NOT ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +099700 PERFORM FAIL NC1734.2 +099800 PERFORM PRINT-DETAIL. NC1734.2 +099900* NC1734.2 +100000* NC1734.2 +100100 DIV-INIT-F3-19. NC1734.2 +100200 MOVE "DIV-TEST-F3-19" TO PAR-NAME. NC1734.2 +100300* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +100400* ==--> MULTIPLE RESULT FIELDS <--== NC1734.2 +100500 MOVE "V1-82 6.11.4 GR3" TO ANSI-REFERENCE. NC1734.2 +100600 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +100700 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +100800 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +100900 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +101000 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +101100 MOVE 1 TO REC-CT. NC1734.2 +101200 MOVE 10 TO WRK-DU-2V0-1. NC1734.2 +101300 MOVE 3.9 TO WRK-DU-1V1-2. NC1734.2 +101400 DIV-TEST-F3-19-0. NC1734.2 +101500 DIVIDE WRK-DU-2V0-1 BY WRK-DU-1V1-2 NC1734.2 +101600 GIVING WRK-DU-2V1-1 NC1734.2 +101700 WRK-DU-2V0-1 ROUNDED NC1734.2 +101800 WRK-DU-2V1-2 NC1734.2 +101900 WRK-DU-2V0-2 ROUNDED NC1734.2 +102000 WRK-DU-2V1-3 NC1734.2 +102100 WRK-DU-2V0-3. NC1734.2 +102200 GO TO DIV-TEST-F3-19-1. NC1734.2 +102300 DIV-DELETE-F3-19. NC1734.2 +102400 PERFORM DE-LETE. NC1734.2 +102500 PERFORM PRINT-DETAIL. NC1734.2 +102600 GO TO DIV-INIT-F3-20. NC1734.2 +102700 DIV-TEST-F3-19-1. NC1734.2 +102800 IF WRK-DU-2V1-1 = 2.5 NC1734.2 +102900 PERFORM PASS NC1734.2 +103000 PERFORM PRINT-DETAIL NC1734.2 +103100 ELSE NC1734.2 +103200 PERFORM FAIL NC1734.2 +103300 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +103400 MOVE 2.5 TO CORRECT-N NC1734.2 +103500 PERFORM PRINT-DETAIL. NC1734.2 +103600 ADD 1 TO REC-CT. NC1734.2 +103700 DIV-TEST-F3-19-2. NC1734.2 +103800 IF WRK-DU-2V0-1 = 3 NC1734.2 +103900 PERFORM PASS NC1734.2 +104000 PERFORM PRINT-DETAIL NC1734.2 +104100 ELSE NC1734.2 +104200 PERFORM FAIL NC1734.2 +104300 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +104400 MOVE 3 TO CORRECT-N NC1734.2 +104500 PERFORM PRINT-DETAIL. NC1734.2 +104600 ADD 1 TO REC-CT. NC1734.2 +104700 DIV-TEST-F3-19-3. NC1734.2 +104800 IF WRK-DU-2V1-2 = 2.5 NC1734.2 +104900 PERFORM PASS NC1734.2 +105000 PERFORM PRINT-DETAIL NC1734.2 +105100 ELSE NC1734.2 +105200 PERFORM FAIL NC1734.2 +105300 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +105400 MOVE 2.5 TO CORRECT-N NC1734.2 +105500 PERFORM PRINT-DETAIL. NC1734.2 +105600 ADD 1 TO REC-CT. NC1734.2 +105700 DIV-TEST-F3-19-4. NC1734.2 +105800 IF WRK-DU-2V0-2 = 3 NC1734.2 +105900 PERFORM PASS NC1734.2 +106000 PERFORM PRINT-DETAIL NC1734.2 +106100 ELSE NC1734.2 +106200 PERFORM FAIL NC1734.2 +106300 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +106400 MOVE 3 TO CORRECT-N NC1734.2 +106500 PERFORM PRINT-DETAIL. NC1734.2 +106600 ADD 1 TO REC-CT. NC1734.2 +106700 DIV-TEST-F3-19-5. NC1734.2 +106800 IF WRK-DU-2V1-3 = 2.5 NC1734.2 +106900 PERFORM PASS NC1734.2 +107000 PERFORM PRINT-DETAIL NC1734.2 +107100 ELSE NC1734.2 +107200 PERFORM FAIL NC1734.2 +107300 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +107400 MOVE 2.5 TO CORRECT-N NC1734.2 +107500 PERFORM PRINT-DETAIL. NC1734.2 +107600 ADD 1 TO REC-CT. NC1734.2 +107700 DIV-TEST-F3-19-6. NC1734.2 +107800 IF WRK-DU-2V0-3 = 2 NC1734.2 +107900 PERFORM PASS NC1734.2 +108000 PERFORM PRINT-DETAIL NC1734.2 +108100 ELSE NC1734.2 +108200 PERFORM FAIL NC1734.2 +108300 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +108400 MOVE 2 TO CORRECT-N NC1734.2 +108500 PERFORM PRINT-DETAIL. NC1734.2 +108600* NC1734.2 +108700* NC1734.2 +108800 DIV-INIT-F3-20. NC1734.2 +108900* ==--> SIZE ERROR CONDITION <--== NC1734.2 +109000* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +109100 MOVE "DIV-TEST-F3-20" TO PAR-NAME. NC1734.2 +109200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +109300 MOVE "0" TO WRK-XN-00001. NC1734.2 +109400 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +109500 MOVE 0 TO WRK-DU-2V0-1. NC1734.2 +109600 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +109700 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +109800 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +109900 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +110000 MOVE 1 TO REC-CT. NC1734.2 +110100 MOVE 99 TO WRK-DU-2V0-1. NC1734.2 +110200 DIV-TEST-F3-20-0. NC1734.2 +110300 DIVIDE WRK-DU-2V0-1 BY A01ONE-CS-00V01 NC1734.2 +110400 GIVING WRK-DU-2V1-1 NC1734.2 +110500 WRK-DU-2V0-1 ROUNDED NC1734.2 +110600 WRK-DU-2V1-2 NC1734.2 +110700 WRK-DU-2V0-2 ROUNDED NC1734.2 +110800 WRK-DU-2V1-3 NC1734.2 +110900 WRK-DU-2V0-3 NC1734.2 +111000 ON SIZE ERROR NC1734.2 +111100 MOVE "1" TO WRK-XN-00001. NC1734.2 +111200 GO TO DIV-TEST-F3-20-1. NC1734.2 +111300 DIV-DELETE-F3-20. NC1734.2 +111400 PERFORM DE-LETE. NC1734.2 +111500 PERFORM PRINT-DETAIL. NC1734.2 +111600 GO TO DIV-INIT-F3-21. NC1734.2 +111700 DIV-TEST-F3-20-1. NC1734.2 +111800 IF WRK-DU-2V1-1 = 0 NC1734.2 +111900 PERFORM PASS NC1734.2 +112000 PERFORM PRINT-DETAIL NC1734.2 +112100 ELSE NC1734.2 +112200 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +112300 PERFORM FAIL NC1734.2 +112400 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +112500 MOVE 0 TO CORRECT-N NC1734.2 +112600 PERFORM PRINT-DETAIL. NC1734.2 +112700 ADD 1 TO REC-CT. NC1734.2 +112800 DIV-TEST-F3-20-2. NC1734.2 +112900 IF WRK-DU-2V0-1 = 99 NC1734.2 +113000 PERFORM PASS NC1734.2 +113100 PERFORM PRINT-DETAIL NC1734.2 +113200 ELSE NC1734.2 +113300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +113400 PERFORM FAIL NC1734.2 +113500 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +113600 MOVE 99 TO CORRECT-N NC1734.2 +113700 PERFORM PRINT-DETAIL. NC1734.2 +113800 ADD 1 TO REC-CT. NC1734.2 +113900 DIV-TEST-F3-20-3. NC1734.2 +114000 IF WRK-DU-2V1-2 = 0 NC1734.2 +114100 PERFORM PASS NC1734.2 +114200 PERFORM PRINT-DETAIL NC1734.2 +114300 ELSE NC1734.2 +114400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +114500 PERFORM FAIL NC1734.2 +114600 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +114700 MOVE 0 TO CORRECT-N NC1734.2 +114800 PERFORM PRINT-DETAIL. NC1734.2 +114900 ADD 1 TO REC-CT. NC1734.2 +115000 DIV-TEST-F3-20-4. NC1734.2 +115100 IF WRK-DU-2V0-2 = 0 NC1734.2 +115200 PERFORM PASS NC1734.2 +115300 PERFORM PRINT-DETAIL NC1734.2 +115400 ELSE NC1734.2 +115500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +115600 PERFORM FAIL NC1734.2 +115700 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +115800 MOVE 0 TO CORRECT-N NC1734.2 +115900 PERFORM PRINT-DETAIL. NC1734.2 +116000 ADD 1 TO REC-CT. NC1734.2 +116100 DIV-TEST-F3-20-5. NC1734.2 +116200 IF WRK-DU-2V1-3 = 0 NC1734.2 +116300 PERFORM PASS NC1734.2 +116400 PERFORM PRINT-DETAIL NC1734.2 +116500 ELSE NC1734.2 +116600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +116700 PERFORM FAIL NC1734.2 +116800 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +116900 MOVE 0 TO CORRECT-N NC1734.2 +117000 PERFORM PRINT-DETAIL. NC1734.2 +117100 ADD 1 TO REC-CT. NC1734.2 +117200 DIV-TEST-F3-20-6. NC1734.2 +117300 IF WRK-DU-2V0-3 = 0 NC1734.2 +117400 PERFORM PASS NC1734.2 +117500 PERFORM PRINT-DETAIL NC1734.2 +117600 ELSE NC1734.2 +117700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +117800 PERFORM FAIL NC1734.2 +117900 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +118000 MOVE 0 TO CORRECT-N NC1734.2 +118100 PERFORM PRINT-DETAIL. NC1734.2 +118200 ADD 1 TO REC-CT. NC1734.2 +118300 DIV-TEST-F3-20-7. NC1734.2 +118400 IF WRK-XN-00001 = "1" NC1734.2 +118500 PERFORM PASS NC1734.2 +118600 PERFORM PRINT-DETAIL NC1734.2 +118700 ELSE NC1734.2 +118800 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +118900 MOVE "1" TO CORRECT-X NC1734.2 +119000 MOVE "DIV-TEST-F3-20-7" TO PAR-NAME NC1734.2 +119100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +119200 PERFORM FAIL NC1734.2 +119300 PERFORM PRINT-DETAIL. NC1734.2 +119400* NC1734.2 +119500* NC1734.2 +119600 DIV-INIT-F3-21. NC1734.2 +119700* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +119800* ==--> MULTIPLE RESULT FIELDS <--== NC1734.2 +119900 MOVE "DIV-TEST-F3-21" TO PAR-NAME. NC1734.2 +120000 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +120100 MOVE "0" TO WRK-XN-00001. NC1734.2 +120200 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +120300 MOVE 0 TO WRK-DU-2V0-1. NC1734.2 +120400 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +120500 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +120600 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +120700 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +120800 MOVE 1 TO REC-CT. NC1734.2 +120900 MOVE 10 TO WRK-DU-2V0-1. NC1734.2 +121000 MOVE 3.9 TO WRK-DU-1V1-2. NC1734.2 +121100 DIV-TEST-F3-21-0. NC1734.2 +121200 DIVIDE WRK-DU-2V0-1 BY WRK-DU-1V1-2 NC1734.2 +121300 GIVING WRK-DU-2V1-1 NC1734.2 +121400 WRK-DU-2V0-1 ROUNDED NC1734.2 +121500 WRK-DU-2V1-2 NC1734.2 +121600 WRK-DU-2V0-2 ROUNDED NC1734.2 +121700 WRK-DU-2V1-3 NC1734.2 +121800 WRK-DU-2V0-3 NC1734.2 +121900 ON SIZE ERROR NC1734.2 +122000 MOVE "1" TO WRK-XN-00001. NC1734.2 +122100 GO TO DIV-TEST-F3-21-1. NC1734.2 +122200 DIV-DELETE-F3-21. NC1734.2 +122300 PERFORM DE-LETE. NC1734.2 +122400 PERFORM PRINT-DETAIL. NC1734.2 +122500 GO TO DIV-INIT-F3-22. NC1734.2 +122600 DIV-TEST-F3-21-1. NC1734.2 +122700 IF WRK-DU-2V1-1 = 2.5 NC1734.2 +122800 PERFORM PASS NC1734.2 +122900 PERFORM PRINT-DETAIL NC1734.2 +123000 ELSE NC1734.2 +123100 PERFORM FAIL NC1734.2 +123200 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +123300 MOVE 2.5 TO CORRECT-N NC1734.2 +123400 PERFORM PRINT-DETAIL. NC1734.2 +123500 ADD 1 TO REC-CT. NC1734.2 +123600 DIV-TEST-F3-21-2. NC1734.2 +123700 IF WRK-DU-2V0-1 = 3 NC1734.2 +123800 PERFORM PASS NC1734.2 +123900 PERFORM PRINT-DETAIL NC1734.2 +124000 ELSE NC1734.2 +124100 PERFORM FAIL NC1734.2 +124200 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +124300 MOVE 3 TO CORRECT-N NC1734.2 +124400 PERFORM PRINT-DETAIL. NC1734.2 +124500 ADD 1 TO REC-CT. NC1734.2 +124600 DIV-TEST-F3-21-3. NC1734.2 +124700 IF WRK-DU-2V1-2 = 2.5 NC1734.2 +124800 PERFORM PASS NC1734.2 +124900 PERFORM PRINT-DETAIL NC1734.2 +125000 ELSE NC1734.2 +125100 PERFORM FAIL NC1734.2 +125200 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +125300 MOVE 2.5 TO CORRECT-N NC1734.2 +125400 PERFORM PRINT-DETAIL. NC1734.2 +125500 ADD 1 TO REC-CT. NC1734.2 +125600 DIV-TEST-F3-21-4. NC1734.2 +125700 IF WRK-DU-2V0-2 = 3 NC1734.2 +125800 PERFORM PASS NC1734.2 +125900 PERFORM PRINT-DETAIL NC1734.2 +126000 ELSE NC1734.2 +126100 PERFORM FAIL NC1734.2 +126200 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +126300 MOVE 3 TO CORRECT-N NC1734.2 +126400 PERFORM PRINT-DETAIL. NC1734.2 +126500 ADD 1 TO REC-CT. NC1734.2 +126600 DIV-TEST-F3-21-5. NC1734.2 +126700 IF WRK-DU-2V1-3 = 2.5 NC1734.2 +126800 PERFORM PASS NC1734.2 +126900 PERFORM PRINT-DETAIL NC1734.2 +127000 ELSE NC1734.2 +127100 PERFORM FAIL NC1734.2 +127200 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +127300 MOVE 2.5 TO CORRECT-N NC1734.2 +127400 PERFORM PRINT-DETAIL. NC1734.2 +127500 ADD 1 TO REC-CT. NC1734.2 +127600 DIV-TEST-F3-21-6. NC1734.2 +127700 IF WRK-DU-2V0-3 = 2 NC1734.2 +127800 PERFORM PASS NC1734.2 +127900 PERFORM PRINT-DETAIL NC1734.2 +128000 ELSE NC1734.2 +128100 PERFORM FAIL NC1734.2 +128200 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +128300 MOVE 2 TO CORRECT-N NC1734.2 +128400 PERFORM PRINT-DETAIL. NC1734.2 +128500 ADD 1 TO REC-CT. NC1734.2 +128600 DIV-TEST-F3-21-7. NC1734.2 +128700 IF WRK-XN-00001 = "0" NC1734.2 +128800 PERFORM PASS NC1734.2 +128900 PERFORM PRINT-DETAIL NC1734.2 +129000 ELSE NC1734.2 +129100 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +129200 MOVE "0" TO CORRECT-X NC1734.2 +129300 MOVE "DIV-TEST-F3-21-7" TO PAR-NAME NC1734.2 +129400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +129500 TO RE-MARK NC1734.2 +129600 PERFORM FAIL NC1734.2 +129700 PERFORM PRINT-DETAIL. NC1734.2 +129800* NC1734.2 +129900* NC1734.2 +130000 DIV-INIT-F3-22. NC1734.2 +130100* ==--> SIZE ERROR CONDITION <--== NC1734.2 +130200* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +130300 MOVE "DIV-TEST-F3-22" TO PAR-NAME. NC1734.2 +130400 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +130500 MOVE "0" TO WRK-XN-00001. NC1734.2 +130600 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +130700 MOVE 0 TO WRK-DU-2V0-1. NC1734.2 +130800 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +130900 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +131000 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +131100 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +131200 MOVE 1 TO REC-CT. NC1734.2 +131300 MOVE 99 TO WRK-DU-2V0-1. NC1734.2 +131400 DIV-TEST-F3-22-0. NC1734.2 +131500 DIVIDE WRK-DU-2V0-1 BY A01ONE-CS-00V01 NC1734.2 +131600 GIVING WRK-DU-2V1-1 NC1734.2 +131700 WRK-DU-2V0-1 ROUNDED NC1734.2 +131800 WRK-DU-2V1-2 NC1734.2 +131900 WRK-DU-2V0-2 ROUNDED NC1734.2 +132000 WRK-DU-2V1-3 NC1734.2 +132100 WRK-DU-2V0-3 NC1734.2 +132200 NOT ON SIZE ERROR NC1734.2 +132300 MOVE "1" TO WRK-XN-00001. NC1734.2 +132400 GO TO DIV-TEST-F3-22-1. NC1734.2 +132500 DIV-DELETE-F3-22. NC1734.2 +132600 PERFORM DE-LETE. NC1734.2 +132700 PERFORM PRINT-DETAIL. NC1734.2 +132800 GO TO DIV-INIT-F3-23. NC1734.2 +132900 DIV-TEST-F3-22-1. NC1734.2 +133000 IF WRK-DU-2V1-1 = 0 NC1734.2 +133100 PERFORM PASS NC1734.2 +133200 PERFORM PRINT-DETAIL NC1734.2 +133300 ELSE NC1734.2 +133400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +133500 PERFORM FAIL NC1734.2 +133600 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +133700 MOVE 0 TO CORRECT-N NC1734.2 +133800 PERFORM PRINT-DETAIL. NC1734.2 +133900 ADD 1 TO REC-CT. NC1734.2 +134000 DIV-TEST-F3-22-2. NC1734.2 +134100 IF WRK-DU-2V0-1 = 99 NC1734.2 +134200 PERFORM PASS NC1734.2 +134300 PERFORM PRINT-DETAIL NC1734.2 +134400 ELSE NC1734.2 +134500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +134600 PERFORM FAIL NC1734.2 +134700 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +134800 MOVE 99 TO CORRECT-N NC1734.2 +134900 PERFORM PRINT-DETAIL. NC1734.2 +135000 ADD 1 TO REC-CT. NC1734.2 +135100 DIV-TEST-F3-22-3. NC1734.2 +135200 IF WRK-DU-2V1-2 = 0 NC1734.2 +135300 PERFORM PASS NC1734.2 +135400 PERFORM PRINT-DETAIL NC1734.2 +135500 ELSE NC1734.2 +135600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +135700 PERFORM FAIL NC1734.2 +135800 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +135900 MOVE 0 TO CORRECT-N NC1734.2 +136000 PERFORM PRINT-DETAIL. NC1734.2 +136100 ADD 1 TO REC-CT. NC1734.2 +136200 DIV-TEST-F3-22-4. NC1734.2 +136300 IF WRK-DU-2V0-2 = 0 NC1734.2 +136400 PERFORM PASS NC1734.2 +136500 PERFORM PRINT-DETAIL NC1734.2 +136600 ELSE NC1734.2 +136700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +136800 PERFORM FAIL NC1734.2 +136900 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +137000 MOVE 0 TO CORRECT-N NC1734.2 +137100 PERFORM PRINT-DETAIL. NC1734.2 +137200 ADD 1 TO REC-CT. NC1734.2 +137300 DIV-TEST-F3-22-5. NC1734.2 +137400 IF WRK-DU-2V1-3 = 0 NC1734.2 +137500 PERFORM PASS NC1734.2 +137600 PERFORM PRINT-DETAIL NC1734.2 +137700 ELSE NC1734.2 +137800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +137900 PERFORM FAIL NC1734.2 +138000 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +138100 MOVE 0 TO CORRECT-N NC1734.2 +138200 PERFORM PRINT-DETAIL. NC1734.2 +138300 ADD 1 TO REC-CT. NC1734.2 +138400 DIV-TEST-F3-22-6. NC1734.2 +138500 IF WRK-DU-2V0-3 = 0 NC1734.2 +138600 PERFORM PASS NC1734.2 +138700 PERFORM PRINT-DETAIL NC1734.2 +138800 ELSE NC1734.2 +138900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +139000 PERFORM FAIL NC1734.2 +139100 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +139200 MOVE 0 TO CORRECT-N NC1734.2 +139300 PERFORM PRINT-DETAIL. NC1734.2 +139400 ADD 1 TO REC-CT. NC1734.2 +139500 DIV-TEST-F3-22-7. NC1734.2 +139600 IF WRK-XN-00001 = "0" NC1734.2 +139700 PERFORM PASS NC1734.2 +139800 PERFORM PRINT-DETAIL NC1734.2 +139900 ELSE NC1734.2 +140000 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +140100 MOVE "0" TO CORRECT-X NC1734.2 +140200 MOVE "DIV-TEST-F3-22-7" TO PAR-NAME NC1734.2 +140300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +140400 TO RE-MARK NC1734.2 +140500 PERFORM FAIL NC1734.2 +140600 PERFORM PRINT-DETAIL. NC1734.2 +140700* NC1734.2 +140800* NC1734.2 +140900 DIV-INIT-F3-23. NC1734.2 +141000* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +141100* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +141200 MOVE "DIV-TEST-F3-23" TO PAR-NAME. NC1734.2 +141300 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +141400 MOVE "0" TO WRK-XN-00001. NC1734.2 +141500 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +141600 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +141700 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +141800 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +141900 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +142000 MOVE 1 TO REC-CT. NC1734.2 +142100 MOVE 10 TO WRK-DU-2V0-1. NC1734.2 +142200 MOVE 3.9 TO WRK-DU-1V1-2. NC1734.2 +142300 DIV-TEST-F3-23-0. NC1734.2 +142400 DIVIDE WRK-DU-2V0-1 BY WRK-DU-1V1-2 NC1734.2 +142500 GIVING WRK-DU-2V1-1 NC1734.2 +142600 WRK-DU-2V0-1 ROUNDED NC1734.2 +142700 WRK-DU-2V1-2 NC1734.2 +142800 WRK-DU-2V0-2 ROUNDED NC1734.2 +142900 WRK-DU-2V1-3 NC1734.2 +143000 WRK-DU-2V0-3 NC1734.2 +143100 NOT ON SIZE ERROR NC1734.2 +143200 MOVE "1" TO WRK-XN-00001. NC1734.2 +143300 GO TO DIV-TEST-F3-23-1. NC1734.2 +143400 DIV-DELETE-F3-23. NC1734.2 +143500 PERFORM DE-LETE. NC1734.2 +143600 PERFORM PRINT-DETAIL. NC1734.2 +143700 GO TO DIV-INIT-F3-24. NC1734.2 +143800 DIV-TEST-F3-23-1. NC1734.2 +143900 IF WRK-DU-2V1-1 = 2.5 NC1734.2 +144000 PERFORM PASS NC1734.2 +144100 PERFORM PRINT-DETAIL NC1734.2 +144200 ELSE NC1734.2 +144300 PERFORM FAIL NC1734.2 +144400 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +144500 MOVE 2.5 TO CORRECT-N NC1734.2 +144600 PERFORM PRINT-DETAIL. NC1734.2 +144700 ADD 1 TO REC-CT. NC1734.2 +144800 DIV-TEST-F3-23-2. NC1734.2 +144900 IF WRK-DU-2V0-1 = 3 NC1734.2 +145000 PERFORM PASS NC1734.2 +145100 PERFORM PRINT-DETAIL NC1734.2 +145200 ELSE NC1734.2 +145300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +145400 PERFORM FAIL NC1734.2 +145500 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +145600 MOVE 3 TO CORRECT-N NC1734.2 +145700 PERFORM PRINT-DETAIL. NC1734.2 +145800 ADD 1 TO REC-CT. NC1734.2 +145900 DIV-TEST-F3-23-3. NC1734.2 +146000 IF WRK-DU-2V1-2 = 2.5 NC1734.2 +146100 PERFORM PASS NC1734.2 +146200 PERFORM PRINT-DETAIL NC1734.2 +146300 ELSE NC1734.2 +146400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +146500 PERFORM FAIL NC1734.2 +146600 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +146700 MOVE 2.5 TO CORRECT-N NC1734.2 +146800 PERFORM PRINT-DETAIL. NC1734.2 +146900 ADD 1 TO REC-CT. NC1734.2 +147000 DIV-TEST-F3-23-4. NC1734.2 +147100 IF WRK-DU-2V0-2 = 3 NC1734.2 +147200 PERFORM PASS NC1734.2 +147300 PERFORM PRINT-DETAIL NC1734.2 +147400 ELSE NC1734.2 +147500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +147600 PERFORM FAIL NC1734.2 +147700 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +147800 MOVE 3 TO CORRECT-N NC1734.2 +147900 PERFORM PRINT-DETAIL. NC1734.2 +148000 ADD 1 TO REC-CT. NC1734.2 +148100 DIV-TEST-F3-23-5. NC1734.2 +148200 IF WRK-DU-2V1-3 = 2.5 NC1734.2 +148300 PERFORM PASS NC1734.2 +148400 PERFORM PRINT-DETAIL NC1734.2 +148500 ELSE NC1734.2 +148600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +148700 PERFORM FAIL NC1734.2 +148800 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +148900 MOVE 2.5 TO CORRECT-N NC1734.2 +149000 PERFORM PRINT-DETAIL. NC1734.2 +149100 ADD 1 TO REC-CT. NC1734.2 +149200 DIV-TEST-F3-23-6. NC1734.2 +149300 IF WRK-DU-2V0-3 = 2 NC1734.2 +149400 PERFORM PASS NC1734.2 +149500 PERFORM PRINT-DETAIL NC1734.2 +149600 ELSE NC1734.2 +149700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +149800 PERFORM FAIL NC1734.2 +149900 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +150000 MOVE 2 TO CORRECT-N NC1734.2 +150100 PERFORM PRINT-DETAIL. NC1734.2 +150200 ADD 1 TO REC-CT. NC1734.2 +150300 DIV-TEST-F3-23-7. NC1734.2 +150400 IF WRK-XN-00001 = "1" NC1734.2 +150500 PERFORM PASS NC1734.2 +150600 PERFORM PRINT-DETAIL NC1734.2 +150700 ELSE NC1734.2 +150800 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +150900 MOVE "1" TO CORRECT-X NC1734.2 +151000 MOVE "DIV-TEST-F3-23-7" TO PAR-NAME NC1734.2 +151100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1734.2 +151200 TO RE-MARK NC1734.2 +151300 PERFORM FAIL NC1734.2 +151400 PERFORM PRINT-DETAIL. NC1734.2 +151500* NC1734.2 +151600* NC1734.2 +151700 DIV-INIT-F3-24. NC1734.2 +151800* ==--> SIZE ERROR CONDITION <--== NC1734.2 +151900* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +152000 MOVE "DIV-TEST-F3-24" TO PAR-NAME. NC1734.2 +152100 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +152200 MOVE "0" TO WRK-XN-00001. NC1734.2 +152300 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +152400 MOVE 0 TO WRK-DU-2V0-1. NC1734.2 +152500 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +152600 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +152700 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +152800 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +152900 MOVE 1 TO REC-CT. NC1734.2 +153000 MOVE 99 TO WRK-DU-2V0-1. NC1734.2 +153100 DIV-TEST-F3-24-0. NC1734.2 +153200 DIVIDE WRK-DU-2V0-1 BY A01ONE-CS-00V01 NC1734.2 +153300 GIVING WRK-DU-2V1-1 NC1734.2 +153400 WRK-DU-2V0-1 ROUNDED NC1734.2 +153500 WRK-DU-2V1-2 NC1734.2 +153600 WRK-DU-2V0-2 ROUNDED NC1734.2 +153700 WRK-DU-2V1-3 NC1734.2 +153800 WRK-DU-2V0-3 NC1734.2 +153900 ON SIZE ERROR NC1734.2 +154000 MOVE "1" TO WRK-XN-00001 NC1734.2 +154100 NOT ON SIZE ERROR NC1734.2 +154200 MOVE "2" TO WRK-XN-00001. NC1734.2 +154300 GO TO DIV-TEST-F3-24-1. NC1734.2 +154400 DIV-DELETE-F3-24. NC1734.2 +154500 PERFORM DE-LETE. NC1734.2 +154600 PERFORM PRINT-DETAIL. NC1734.2 +154700 GO TO DIV-INIT-F3-25. NC1734.2 +154800 DIV-TEST-F3-24-1. NC1734.2 +154900 IF WRK-DU-2V1-1 = 0 NC1734.2 +155000 PERFORM PASS NC1734.2 +155100 PERFORM PRINT-DETAIL NC1734.2 +155200 ELSE NC1734.2 +155300 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +155400 PERFORM FAIL NC1734.2 +155500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +155600 MOVE 0 TO CORRECT-N NC1734.2 +155700 PERFORM PRINT-DETAIL. NC1734.2 +155800 ADD 1 TO REC-CT. NC1734.2 +155900 DIV-TEST-F3-24-2. NC1734.2 +156000 IF WRK-DU-2V0-1 = 99 NC1734.2 +156100 PERFORM PASS NC1734.2 +156200 PERFORM PRINT-DETAIL NC1734.2 +156300 ELSE NC1734.2 +156400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +156500 PERFORM FAIL NC1734.2 +156600 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +156700 MOVE 99 TO CORRECT-N NC1734.2 +156800 PERFORM PRINT-DETAIL. NC1734.2 +156900 ADD 1 TO REC-CT. NC1734.2 +157000 DIV-TEST-F3-24-3. NC1734.2 +157100 IF WRK-DU-2V1-2 = 0 NC1734.2 +157200 PERFORM PASS NC1734.2 +157300 PERFORM PRINT-DETAIL NC1734.2 +157400 ELSE NC1734.2 +157500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +157600 PERFORM FAIL NC1734.2 +157700 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +157800 MOVE 0 TO CORRECT-N NC1734.2 +157900 PERFORM PRINT-DETAIL. NC1734.2 +158000 ADD 1 TO REC-CT. NC1734.2 +158100 DIV-TEST-F3-24-4. NC1734.2 +158200 IF WRK-DU-2V0-2 = 0 NC1734.2 +158300 PERFORM PASS NC1734.2 +158400 PERFORM PRINT-DETAIL NC1734.2 +158500 ELSE NC1734.2 +158600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +158700 PERFORM FAIL NC1734.2 +158800 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +158900 MOVE 0 TO CORRECT-N NC1734.2 +159000 PERFORM PRINT-DETAIL. NC1734.2 +159100 ADD 1 TO REC-CT. NC1734.2 +159200 DIV-TEST-F3-24-5. NC1734.2 +159300 IF WRK-DU-2V1-3 = 0 NC1734.2 +159400 PERFORM PASS NC1734.2 +159500 PERFORM PRINT-DETAIL NC1734.2 +159600 ELSE NC1734.2 +159700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +159800 PERFORM FAIL NC1734.2 +159900 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +160000 MOVE 0 TO CORRECT-N NC1734.2 +160100 PERFORM PRINT-DETAIL. NC1734.2 +160200 ADD 1 TO REC-CT. NC1734.2 +160300 DIV-TEST-F3-24-6. NC1734.2 +160400 IF WRK-DU-2V0-3 = 0 NC1734.2 +160500 PERFORM PASS NC1734.2 +160600 PERFORM PRINT-DETAIL NC1734.2 +160700 ELSE NC1734.2 +160800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC1734.2 +160900 PERFORM FAIL NC1734.2 +161000 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +161100 MOVE 0 TO CORRECT-N NC1734.2 +161200 PERFORM PRINT-DETAIL. NC1734.2 +161300 ADD 1 TO REC-CT. NC1734.2 +161400 DIV-TEST-F3-24-7. NC1734.2 +161500 IF WRK-XN-00001 = "1" NC1734.2 +161600 PERFORM PASS NC1734.2 +161700 PERFORM PRINT-DETAIL NC1734.2 +161800 ELSE NC1734.2 +161900 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +162000 MOVE "1" TO CORRECT-X NC1734.2 +162100 MOVE "DIV-TEST-F3-24-7" TO PAR-NAME NC1734.2 +162200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1734.2 +162300 TO RE-MARK NC1734.2 +162400 PERFORM FAIL NC1734.2 +162500 PERFORM PRINT-DETAIL. NC1734.2 +162600* NC1734.2 +162700* NC1734.2 +162800 DIV-INIT-F3-25. NC1734.2 +162900* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +163000* ==--> NEW SIZE ERROR TESTS <--== NC1734.2 +163100 MOVE "DIV-TEST-F3-25" TO PAR-NAME. NC1734.2 +163200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1734.2 +163300 MOVE "0" TO WRK-XN-00001. NC1734.2 +163400 MOVE 0 TO WRK-DU-2V1-1. NC1734.2 +163500 MOVE 0 TO WRK-DU-2V1-2. NC1734.2 +163600 MOVE 0 TO WRK-DU-2V0-2. NC1734.2 +163700 MOVE 0 TO WRK-DU-2V1-3. NC1734.2 +163800 MOVE 0 TO WRK-DU-2V0-3. NC1734.2 +163900 MOVE 1 TO REC-CT. NC1734.2 +164000 MOVE 10 TO WRK-DU-2V0-1. NC1734.2 +164100 MOVE 3.9 TO WRK-DU-1V1-2. NC1734.2 +164200 DIV-TEST-F3-25-0. NC1734.2 +164300 DIVIDE WRK-DU-2V0-1 BY WRK-DU-1V1-2 NC1734.2 +164400 GIVING WRK-DU-2V1-1 NC1734.2 +164500 WRK-DU-2V0-1 ROUNDED NC1734.2 +164600 WRK-DU-2V1-2 NC1734.2 +164700 WRK-DU-2V0-2 ROUNDED NC1734.2 +164800 WRK-DU-2V1-3 NC1734.2 +164900 WRK-DU-2V0-3 NC1734.2 +165000 ON SIZE ERROR NC1734.2 +165100 MOVE "1" TO WRK-XN-00001 NC1734.2 +165200 NOT ON SIZE ERROR NC1734.2 +165300 MOVE "2" TO WRK-XN-00001. NC1734.2 +165400 GO TO DIV-TEST-F3-25-1. NC1734.2 +165500 DIV-DELETE-F3-25. NC1734.2 +165600 PERFORM DE-LETE. NC1734.2 +165700 PERFORM PRINT-DETAIL. NC1734.2 +165800 GO TO DIV-INIT-F3-26. NC1734.2 +165900 DIV-TEST-F3-25-1. NC1734.2 +166000 IF WRK-DU-2V1-1 = 2.5 NC1734.2 +166100 PERFORM PASS NC1734.2 +166200 PERFORM PRINT-DETAIL NC1734.2 +166300 ELSE NC1734.2 +166400 PERFORM FAIL NC1734.2 +166500 MOVE WRK-DU-2V1-1 TO COMPUTED-N NC1734.2 +166600 MOVE 2.5 TO CORRECT-N NC1734.2 +166700 PERFORM PRINT-DETAIL. NC1734.2 +166800 ADD 1 TO REC-CT. NC1734.2 +166900 DIV-TEST-F3-25-2. NC1734.2 +167000 IF WRK-DU-2V0-1 = 3 NC1734.2 +167100 PERFORM PASS NC1734.2 +167200 PERFORM PRINT-DETAIL NC1734.2 +167300 ELSE NC1734.2 +167400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +167500 PERFORM FAIL NC1734.2 +167600 MOVE WRK-DU-2V0-1 TO COMPUTED-N NC1734.2 +167700 MOVE 3 TO CORRECT-N NC1734.2 +167800 PERFORM PRINT-DETAIL. NC1734.2 +167900 ADD 1 TO REC-CT. NC1734.2 +168000 DIV-TEST-F3-25-3. NC1734.2 +168100 IF WRK-DU-2V1-2 = 2.5 NC1734.2 +168200 PERFORM PASS NC1734.2 +168300 PERFORM PRINT-DETAIL NC1734.2 +168400 ELSE NC1734.2 +168500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +168600 PERFORM FAIL NC1734.2 +168700 MOVE WRK-DU-2V1-2 TO COMPUTED-N NC1734.2 +168800 MOVE 2.5 TO CORRECT-N NC1734.2 +168900 PERFORM PRINT-DETAIL. NC1734.2 +169000 ADD 1 TO REC-CT. NC1734.2 +169100 DIV-TEST-F3-25-4. NC1734.2 +169200 IF WRK-DU-2V0-2 = 3 NC1734.2 +169300 PERFORM PASS NC1734.2 +169400 PERFORM PRINT-DETAIL NC1734.2 +169500 ELSE NC1734.2 +169600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +169700 PERFORM FAIL NC1734.2 +169800 MOVE WRK-DU-2V0-2 TO COMPUTED-N NC1734.2 +169900 MOVE 3 TO CORRECT-N NC1734.2 +170000 PERFORM PRINT-DETAIL. NC1734.2 +170100 ADD 1 TO REC-CT. NC1734.2 +170200 DIV-TEST-F3-25-5. NC1734.2 +170300 IF WRK-DU-2V1-3 = 2.5 NC1734.2 +170400 PERFORM PASS NC1734.2 +170500 PERFORM PRINT-DETAIL NC1734.2 +170600 ELSE NC1734.2 +170700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +170800 PERFORM FAIL NC1734.2 +170900 MOVE WRK-DU-2V1-3 TO COMPUTED-N NC1734.2 +171000 MOVE 2.5 TO CORRECT-N NC1734.2 +171100 PERFORM PRINT-DETAIL. NC1734.2 +171200 ADD 1 TO REC-CT. NC1734.2 +171300 DIV-TEST-F3-25-6. NC1734.2 +171400 IF WRK-DU-2V0-3 = 2 NC1734.2 +171500 PERFORM PASS NC1734.2 +171600 PERFORM PRINT-DETAIL NC1734.2 +171700 ELSE NC1734.2 +171800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +171900 PERFORM FAIL NC1734.2 +172000 MOVE WRK-DU-2V0-3 TO COMPUTED-N NC1734.2 +172100 MOVE 2 TO CORRECT-N NC1734.2 +172200 PERFORM PRINT-DETAIL. NC1734.2 +172300 ADD 1 TO REC-CT. NC1734.2 +172400 DIV-TEST-F3-25-7. NC1734.2 +172500 IF WRK-XN-00001 = "2" NC1734.2 +172600 PERFORM PASS NC1734.2 +172700 PERFORM PRINT-DETAIL NC1734.2 +172800 ELSE NC1734.2 +172900 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +173000 MOVE "2" TO CORRECT-X NC1734.2 +173100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +173200 TO RE-MARK NC1734.2 +173300 PERFORM FAIL NC1734.2 +173400 PERFORM PRINT-DETAIL. NC1734.2 +173500* NC1734.2 +173600* NC1734.2 +173700 DIV-INIT-F3-26. NC1734.2 +173800* ==--> SIZE ERROR CONDITION <--== NC1734.2 +173900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +174000 MOVE "DIV-TEST-F3-26" TO PAR-NAME. NC1734.2 +174100 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +174200 MOVE 44.1 TO DIV2. NC1734.2 +174300 MOVE -9.642 TO DIV4. NC1734.2 +174400 MOVE 0 TO DIV10. NC1734.2 +174500 MOVE 0 TO WRK-XN-00001. NC1734.2 +174600 MOVE 0 TO WRK-DS-05V00. NC1734.2 +174700 MOVE "A" TO XRAY. NC1734.2 +174800 MOVE 1 TO REC-CT. NC1734.2 +174900 DIV-TEST-F3-26-0. NC1734.2 +175000 DIVIDE DIV2 BY DIV4 NC1734.2 +175100 GIVING DIV10 NC1734.2 +175200 ON SIZE ERROR NC1734.2 +175300 MOVE "P" TO XRAY NC1734.2 +175400 MOVE "1" TO WRK-XN-00001 NC1734.2 +175500 MOVE 23 TO WRK-DS-05V00 NC1734.2 +175600 END-DIVIDE NC1734.2 +175700 MOVE 99 TO WRK-CS-18V00. NC1734.2 +175800 GO TO DIV-TEST-F3-26-1. NC1734.2 +175900 DIV-DELETE-F3-26. NC1734.2 +176000 PERFORM DE-LETE. NC1734.2 +176100 PERFORM PRINT-DETAIL. NC1734.2 +176200 GO TO DIV-INIT-F3-27. NC1734.2 +176300 DIV-TEST-F3-26-1. NC1734.2 +176400 MOVE "DIV-TEST-F3-26-1" TO PAR-NAME. NC1734.2 +176500 IF DIV10 = 0 NC1734.2 +176600 PERFORM PASS NC1734.2 +176700 PERFORM PRINT-DETAIL NC1734.2 +176800 ELSE NC1734.2 +176900 MOVE DIV10 TO COMPUTED-N NC1734.2 +177000 MOVE 0 TO CORRECT-N NC1734.2 +177100 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +177200 PERFORM FAIL NC1734.2 +177300 PERFORM PRINT-DETAIL. NC1734.2 +177400 ADD 1 TO REC-CT. NC1734.2 +177500 DIV-TEST-F3-26-2. NC1734.2 +177600 MOVE "DIV-TEST-F3-26-2" TO PAR-NAME. NC1734.2 +177700 IF XRAY = "P" NC1734.2 +177800 PERFORM PASS NC1734.2 +177900 PERFORM PRINT-DETAIL NC1734.2 +178000 ELSE NC1734.2 +178100 MOVE XRAY TO COMPUTED-X NC1734.2 +178200 MOVE "P" TO CORRECT-X NC1734.2 +178300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +178400 PERFORM FAIL NC1734.2 +178500 PERFORM PRINT-DETAIL. NC1734.2 +178600 ADD 1 TO REC-CT. NC1734.2 +178700 DIV-TEST-F3-26-3. NC1734.2 +178800 MOVE "DIV-TEST-F3-26-3" TO PAR-NAME. NC1734.2 +178900 IF WRK-XN-00001 = "1" NC1734.2 +179000 PERFORM PASS NC1734.2 +179100 PERFORM PRINT-DETAIL NC1734.2 +179200 ELSE NC1734.2 +179300 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +179400 MOVE "1" TO CORRECT-X NC1734.2 +179500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +179600 PERFORM FAIL NC1734.2 +179700 PERFORM PRINT-DETAIL. NC1734.2 +179800 ADD 1 TO REC-CT. NC1734.2 +179900 DIV-TEST-F3-26-4. NC1734.2 +180000 MOVE "DIV-TEST-F3-26-4" TO PAR-NAME. NC1734.2 +180100 IF WRK-DS-05V00 = 23 NC1734.2 +180200 PERFORM PASS NC1734.2 +180300 PERFORM PRINT-DETAIL NC1734.2 +180400 ELSE NC1734.2 +180500 MOVE WRK-DS-05V00 TO COMPUTED-N NC1734.2 +180600 MOVE 23 TO CORRECT-N NC1734.2 +180700 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1734.2 +180800 PERFORM FAIL NC1734.2 +180900 PERFORM PRINT-DETAIL. NC1734.2 +181000 ADD 1 TO REC-CT. NC1734.2 +181100 DIV-TEST-F3-26-5. NC1734.2 +181200 MOVE "DIV-TEST-F3-26-5" TO PAR-NAME. NC1734.2 +181300 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +181400 PERFORM PASS NC1734.2 +181500 PERFORM PRINT-DETAIL NC1734.2 +181600 ELSE NC1734.2 +181700 MOVE WRK-CS-18V00 TO COMPUTED-N NC1734.2 +181800 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +181900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +182000 PERFORM FAIL NC1734.2 +182100 PERFORM PRINT-DETAIL. NC1734.2 +182200* NC1734.2 +182300* NC1734.2 +182400 DIV-INIT-F3-27. NC1734.2 +182500* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +182600* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +182700 MOVE "DIV-TEST-F3-27" TO PAR-NAME. NC1734.2 +182800 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +182900 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +183000 MOVE "0" TO WRK-XN-00001. NC1734.2 +183100 MOVE 0 TO WRK-DS-05V00. NC1734.2 +183200 MOVE 0 TO WRK-DS-02V00. NC1734.2 +183300 MOVE 0 TO WRK-CS-18V00. NC1734.2 +183400 MOVE 1 TO REC-CT. NC1734.2 +183500 DIV-TEST-F3-27-0. NC1734.2 +183600 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +183700 GIVING WRK-DS-09V09 NC1734.2 +183800 ON SIZE ERROR NC1734.2 +183900 MOVE "1" TO WRK-XN-00001 NC1734.2 +184000 MOVE 23 TO WRK-DS-05V00 NC1734.2 +184100 MOVE -4 TO WRK-DS-02V00 NC1734.2 +184200 END-DIVIDE NC1734.2 +184300 MOVE 99 TO WRK-CS-18V00. NC1734.2 +184400 GO TO DIV-TEST-F3-27-1. NC1734.2 +184500 DIV-DELETE-F3-27-1. NC1734.2 +184600 PERFORM DE-LETE. NC1734.2 +184700 PERFORM PRINT-DETAIL. NC1734.2 +184800 GO TO DIV-INIT-F3-28. NC1734.2 +184900 DIV-TEST-F3-27-1. NC1734.2 +185000 MOVE "DIV-TEST-F3-27-1" TO PAR-NAME. NC1734.2 +185100 IF WRK-DS-18V00-S = 000000001000000000 NC1734.2 +185200 PERFORM PASS NC1734.2 +185300 PERFORM PRINT-DETAIL NC1734.2 +185400 ELSE NC1734.2 +185500 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +185600 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +185700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +185800 PERFORM FAIL NC1734.2 +185900 PERFORM PRINT-DETAIL. NC1734.2 +186000 ADD 1 TO REC-CT. NC1734.2 +186100 DIV-TEST-F3-27-2. NC1734.2 +186200 MOVE "DIV-TEST-F3-27-2" TO PAR-NAME. NC1734.2 +186300 IF WRK-DS-02V00 = 00 NC1734.2 +186400 PERFORM PASS NC1734.2 +186500 PERFORM PRINT-DETAIL NC1734.2 +186600 ELSE NC1734.2 +186700 MOVE WRK-DS-02V00 TO COMPUTED-N NC1734.2 +186800 MOVE 00 TO CORRECT-N NC1734.2 +186900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +187000 TO RE-MARK NC1734.2 +187100 PERFORM FAIL NC1734.2 +187200 PERFORM PRINT-DETAIL. NC1734.2 +187300 ADD 1 TO REC-CT. NC1734.2 +187400 DIV-TEST-F3-27-3. NC1734.2 +187500 MOVE "DIV-TEST-F3-27-3" TO PAR-NAME. NC1734.2 +187600 IF WRK-XN-00001 = "0" NC1734.2 +187700 PERFORM PASS NC1734.2 +187800 PERFORM PRINT-DETAIL NC1734.2 +187900 ELSE NC1734.2 +188000 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +188100 MOVE "0" TO CORRECT-X NC1734.2 +188200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +188300 TO RE-MARK NC1734.2 +188400 PERFORM FAIL NC1734.2 +188500 PERFORM PRINT-DETAIL. NC1734.2 +188600 ADD 1 TO REC-CT. NC1734.2 +188700 DIV-TEST-F3-27-4. NC1734.2 +188800 MOVE "DIV-TEST-F3-27-4" TO PAR-NAME. NC1734.2 +188900 IF WRK-DS-05V00 = 0 NC1734.2 +189000 PERFORM PASS NC1734.2 +189100 PERFORM PRINT-DETAIL NC1734.2 +189200 ELSE NC1734.2 +189300 MOVE WRK-DS-05V00 TO COMPUTED-N NC1734.2 +189400 MOVE 0 TO CORRECT-N NC1734.2 +189500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +189600 TO RE-MARK NC1734.2 +189700 PERFORM FAIL NC1734.2 +189800 PERFORM PRINT-DETAIL. NC1734.2 +189900 ADD 1 TO REC-CT. NC1734.2 +190000 DIV-TEST-F3-27-5. NC1734.2 +190100 MOVE "DIV-TEST-F3-27-5" TO PAR-NAME. NC1734.2 +190200 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +190300 PERFORM PASS NC1734.2 +190400 PERFORM PRINT-DETAIL NC1734.2 +190500 ELSE NC1734.2 +190600 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +190700 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +190800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +190900 PERFORM FAIL NC1734.2 +191000 PERFORM PRINT-DETAIL. NC1734.2 +191100* NC1734.2 +191200 DIV-INIT-F3-28. NC1734.2 +191300* ==--> SIZE ERROR CONDITION <--== NC1734.2 +191400* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +191500 MOVE "DIV-TEST-F3-28" TO PAR-NAME. NC1734.2 +191600 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +191700 MOVE 44.1 TO DIV2. NC1734.2 +191800 MOVE -9.642 TO DIV4. NC1734.2 +191900 MOVE 0 TO DIV10. NC1734.2 +192000 MOVE "0" TO WRK-XN-00001. NC1734.2 +192100 MOVE 0 TO WRK-DS-05V00. NC1734.2 +192200 MOVE "A" TO XRAY. NC1734.2 +192300 MOVE 1 TO REC-CT. NC1734.2 +192400 DIV-TEST-F3-28-0. NC1734.2 +192500 DIVIDE DIV2 BY DIV4 NC1734.2 +192600 GIVING DIV10 NC1734.2 +192700 NOT ON SIZE ERROR NC1734.2 +192800 MOVE "P" TO XRAY NC1734.2 +192900 MOVE "1" TO WRK-XN-00001 NC1734.2 +193000 MOVE 23 TO WRK-DS-05V00 NC1734.2 +193100 END-DIVIDE NC1734.2 +193200 MOVE 99 TO WRK-CS-18V00. NC1734.2 +193300 GO TO DIV-TEST-F3-28-1. NC1734.2 +193400 DIV-DELETE-F3-28-1. NC1734.2 +193500 PERFORM DE-LETE. NC1734.2 +193600 PERFORM PRINT-DETAIL. NC1734.2 +193700 GO TO DIV-INIT-F3-29. NC1734.2 +193800 DIV-TEST-F3-28-1. NC1734.2 +193900 MOVE "DIV-TEST-F3-28-1" TO PAR-NAME. NC1734.2 +194000 IF DIV10 = 0 NC1734.2 +194100 PERFORM PASS NC1734.2 +194200 PERFORM PRINT-DETAIL NC1734.2 +194300 ELSE NC1734.2 +194400 MOVE DIV10 TO COMPUTED-N NC1734.2 +194500 MOVE 0 TO CORRECT-N NC1734.2 +194600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1734.2 +194700 TO RE-MARK NC1734.2 +194800 PERFORM FAIL NC1734.2 +194900 PERFORM PRINT-DETAIL. NC1734.2 +195000 ADD 1 TO REC-CT. NC1734.2 +195100 DIV-TEST-F3-28-2. NC1734.2 +195200 MOVE "DIV-TEST-F3-28-2" TO PAR-NAME. NC1734.2 +195300 IF XRAY = "A" NC1734.2 +195400 PERFORM PASS NC1734.2 +195500 PERFORM PRINT-DETAIL NC1734.2 +195600 ELSE NC1734.2 +195700 MOVE XRAY TO COMPUTED-X NC1734.2 +195800 MOVE "A" TO CORRECT-X NC1734.2 +195900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +196000 TO RE-MARK NC1734.2 +196100 PERFORM FAIL NC1734.2 +196200 PERFORM PRINT-DETAIL. NC1734.2 +196300 ADD 1 TO REC-CT. NC1734.2 +196400 DIV-TEST-F3-28-3. NC1734.2 +196500 MOVE "DIV-TEST-F3-28-3" TO PAR-NAME. NC1734.2 +196600 IF WRK-XN-00001 = "0" NC1734.2 +196700 PERFORM PASS NC1734.2 +196800 PERFORM PRINT-DETAIL NC1734.2 +196900 ELSE NC1734.2 +197000 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +197100 MOVE "0" TO CORRECT-X NC1734.2 +197200 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +197300 TO RE-MARK NC1734.2 +197400 PERFORM FAIL NC1734.2 +197500 PERFORM PRINT-DETAIL. NC1734.2 +197600 ADD 1 TO REC-CT. NC1734.2 +197700 DIV-TEST-F3-28-4. NC1734.2 +197800 MOVE "DIV-TEST-F3-28-4" TO PAR-NAME. NC1734.2 +197900 IF WRK-DS-05V00 = 00000 NC1734.2 +198000 PERFORM PASS NC1734.2 +198100 PERFORM PRINT-DETAIL NC1734.2 +198200 ELSE NC1734.2 +198300 MOVE WRK-DS-05V00 TO COMPUTED-N NC1734.2 +198400 MOVE 00000 TO CORRECT-N NC1734.2 +198500 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +198600 TO RE-MARK NC1734.2 +198700 PERFORM FAIL NC1734.2 +198800 PERFORM PRINT-DETAIL. NC1734.2 +198900 ADD 1 TO REC-CT. NC1734.2 +199000 DIV-TEST-F3-28-5. NC1734.2 +199100 MOVE "DIV-TEST-F3-28-5" TO PAR-NAME. NC1734.2 +199200 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +199300 PERFORM PASS NC1734.2 +199400 PERFORM PRINT-DETAIL NC1734.2 +199500 ELSE NC1734.2 +199600 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +199700 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +199800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +199900 PERFORM FAIL NC1734.2 +200000 PERFORM PRINT-DETAIL. NC1734.2 +200100* NC1734.2 +200200* NC1734.2 +200300 DIV-INIT-F3-29. NC1734.2 +200400* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +200500* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +200600 MOVE "DIV-TEST-F3-29" TO PAR-NAME. NC1734.2 +200700 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +200800 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +200900 MOVE "0" TO WRK-XN-00001. NC1734.2 +201000 MOVE 0 TO WRK-DS-05V00. NC1734.2 +201100 MOVE 0 TO WRK-DS-02V00. NC1734.2 +201200 MOVE 0 TO WRK-CS-18V00. NC1734.2 +201300 MOVE 1 TO REC-CT. NC1734.2 +201400 DIV-TEST-F3-29-0. NC1734.2 +201500 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +201600 GIVING WRK-DS-09V09 NC1734.2 +201700 NOT ON SIZE ERROR NC1734.2 +201800 MOVE "1" TO WRK-XN-00001 NC1734.2 +201900 MOVE 23 TO WRK-DS-05V00 NC1734.2 +202000 MOVE -4 TO WRK-DS-02V00 NC1734.2 +202100 END-DIVIDE NC1734.2 +202200 MOVE 99 TO WRK-CS-18V00. NC1734.2 +202300 GO TO DIV-TEST-F3-29-1. NC1734.2 +202400 DIV-DELETE-F3-29-1. NC1734.2 +202500 PERFORM DE-LETE. NC1734.2 +202600 PERFORM PRINT-DETAIL. NC1734.2 +202700 GO TO DIV-INIT-F3-30. NC1734.2 +202800 DIV-TEST-F3-29-1. NC1734.2 +202900 MOVE "DIV-TEST-F3-29-1" TO PAR-NAME. NC1734.2 +203000 IF WRK-DS-18V00-S = 000000001000000000 NC1734.2 +203100 PERFORM PASS NC1734.2 +203200 PERFORM PRINT-DETAIL NC1734.2 +203300 ELSE NC1734.2 +203400 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +203500 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +203600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +203700 PERFORM FAIL NC1734.2 +203800 PERFORM PRINT-DETAIL. NC1734.2 +203900 ADD 1 TO REC-CT. NC1734.2 +204000 DIV-TEST-F3-29-2. NC1734.2 +204100 MOVE "DIV-TEST-F3-29-2" TO PAR-NAME. NC1734.2 +204200 IF WRK-DS-02V00 = -4 NC1734.2 +204300 PERFORM PASS NC1734.2 +204400 PERFORM PRINT-DETAIL NC1734.2 +204500 ELSE NC1734.2 +204600 MOVE WRK-DS-02V00 TO COMPUTED-N NC1734.2 +204700 MOVE -4 TO CORRECT-N NC1734.2 +204800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +204900 TO RE-MARK NC1734.2 +205000 PERFORM FAIL NC1734.2 +205100 PERFORM PRINT-DETAIL. NC1734.2 +205200 ADD 1 TO REC-CT. NC1734.2 +205300 DIV-TEST-F3-29-3. NC1734.2 +205400 MOVE "DIV-TEST-F3-29-3" TO PAR-NAME. NC1734.2 +205500 IF WRK-XN-00001 = "1" NC1734.2 +205600 PERFORM PASS NC1734.2 +205700 PERFORM PRINT-DETAIL NC1734.2 +205800 ELSE NC1734.2 +205900 MOVE WRK-XN-00001 TO COMPUTED-X NC1734.2 +206000 MOVE "1" TO CORRECT-X NC1734.2 +206100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +206200 TO RE-MARK NC1734.2 +206300 PERFORM FAIL NC1734.2 +206400 PERFORM PRINT-DETAIL. NC1734.2 +206500 ADD 1 TO REC-CT. NC1734.2 +206600 DIV-TEST-F3-29-4. NC1734.2 +206700 MOVE "DIV-TEST-F3-29-4" TO PAR-NAME. NC1734.2 +206800 IF WRK-DS-05V00 = 23 NC1734.2 +206900 PERFORM PASS NC1734.2 +207000 PERFORM PRINT-DETAIL NC1734.2 +207100 ELSE NC1734.2 +207200 MOVE WRK-DS-05V00 TO COMPUTED-N NC1734.2 +207300 MOVE 23 TO CORRECT-N NC1734.2 +207400 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +207500 TO RE-MARK NC1734.2 +207600 PERFORM FAIL NC1734.2 +207700 PERFORM PRINT-DETAIL. NC1734.2 +207800 ADD 1 TO REC-CT. NC1734.2 +207900 DIV-TEST-F3-29-5. NC1734.2 +208000 MOVE "DIV-TEST-F3-29-5" TO PAR-NAME. NC1734.2 +208100 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +208200 PERFORM PASS NC1734.2 +208300 PERFORM PRINT-DETAIL NC1734.2 +208400 ELSE NC1734.2 +208500 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +208600 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +208700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +208800 PERFORM FAIL NC1734.2 +208900 PERFORM PRINT-DETAIL. NC1734.2 +209000* NC1734.2 +209100 DIV-INIT-F3-30. NC1734.2 +209200* ==--> SIZE ERROR CONDITION <--== NC1734.2 +209300* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +209400 MOVE "DIV-TEST-F3-30" TO PAR-NAME. NC1734.2 +209500 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +209600 MOVE 44.1 TO DIV2. NC1734.2 +209700 MOVE -9.642 TO DIV4. NC1734.2 +209800 MOVE 0 TO DIV10. NC1734.2 +209900 MOVE 0 TO WRK-CS-18V00. NC1734.2 +210000 MOVE "A" TO XRAY. NC1734.2 +210100 MOVE 1 TO REC-CT. NC1734.2 +210200 DIV-TEST-F3-30-0. NC1734.2 +210300 DIVIDE DIV2 BY DIV4 NC1734.2 +210400 GIVING DIV10 NC1734.2 +210500 ON SIZE ERROR NC1734.2 +210600 MOVE "E" TO XRAY NC1734.2 +210700 NOT ON SIZE ERROR NC1734.2 +210800 MOVE "N" TO XRAY NC1734.2 +210900 END-DIVIDE NC1734.2 +211000 MOVE 99 TO WRK-CS-18V00. NC1734.2 +211100 GO TO DIV-TEST-F3-30-1. NC1734.2 +211200 DIV-DELETE-F3-30. NC1734.2 +211300 PERFORM DE-LETE. NC1734.2 +211400 PERFORM PRINT-DETAIL. NC1734.2 +211500 GO TO DIV-INIT-F3-31. NC1734.2 +211600 DIV-TEST-F3-30-1. NC1734.2 +211700 MOVE "DIV-TEST-F3-30-1" TO PAR-NAME. NC1734.2 +211800 IF DIV10 = 0 NC1734.2 +211900 PERFORM PASS NC1734.2 +212000 PERFORM PRINT-DETAIL NC1734.2 +212100 ELSE NC1734.2 +212200 MOVE DIV10 TO COMPUTED-N NC1734.2 +212300 MOVE 0 TO CORRECT-N NC1734.2 +212400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1734.2 +212500 TO RE-MARK NC1734.2 +212600 PERFORM FAIL NC1734.2 +212700 PERFORM PRINT-DETAIL. NC1734.2 +212800 ADD 1 TO REC-CT. NC1734.2 +212900 DIV-TEST-F3-30-2. NC1734.2 +213000 MOVE "DIV-TEST-F3-30-2" TO PAR-NAME. NC1734.2 +213100 IF XRAY = "E" NC1734.2 +213200 PERFORM PASS NC1734.2 +213300 PERFORM PRINT-DETAIL NC1734.2 +213400 ELSE NC1734.2 +213500 MOVE XRAY TO COMPUTED-X NC1734.2 +213600 MOVE "E" TO CORRECT-X NC1734.2 +213700 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1734.2 +213800 TO RE-MARK NC1734.2 +213900 PERFORM FAIL NC1734.2 +214000 PERFORM PRINT-DETAIL. NC1734.2 +214100 ADD 1 TO REC-CT. NC1734.2 +214200 DIV-TEST-F3-30-3. NC1734.2 +214300 MOVE "DIV-TEST-F3-30-3" TO PAR-NAME. NC1734.2 +214400 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +214500 PERFORM PASS NC1734.2 +214600 PERFORM PRINT-DETAIL NC1734.2 +214700 ELSE NC1734.2 +214800 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +214900 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +215000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +215100 PERFORM FAIL NC1734.2 +215200 PERFORM PRINT-DETAIL. NC1734.2 +215300* NC1734.2 +215400 DIV-INIT-F3-31. NC1734.2 +215500* ==--> NO SIZE ERROR CONDITION <--== NC1734.2 +215600* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1734.2 +215700 MOVE "DIV-TEST-F3-31" TO PAR-NAME. NC1734.2 +215800 MOVE "1V-41 6.4.3" TO ANSI-REFERENCE. NC1734.2 +215900 MOVE 0 TO WRK-CS-18V00. NC1734.2 +216000 MOVE "A" TO XRAY. NC1734.2 +216100 MOVE 1 TO REC-CT. NC1734.2 +216200 MOVE A18ONES-DS-09V09 TO WRK-DS-09V09. NC1734.2 +216300 DIV-TEST-F3-31-0. NC1734.2 +216400 DIVIDE WRK-DS-09V09 BY A18ONES-DS-09V09 NC1734.2 +216500 GIVING WRK-DS-09V09 NC1734.2 +216600 ON SIZE ERROR NC1734.2 +216700 MOVE "E" TO XRAY NC1734.2 +216800 NOT ON SIZE ERROR NC1734.2 +216900 MOVE "N" TO XRAY NC1734.2 +217000 END-DIVIDE NC1734.2 +217100 MOVE 99 TO WRK-CS-18V00. NC1734.2 +217200 GO TO DIV-TEST-F3-31-1. NC1734.2 +217300 DIV-DELETE-F3-31. NC1734.2 +217400 PERFORM DE-LETE. NC1734.2 +217500 PERFORM PRINT-DETAIL. NC1734.2 +217600 GO TO CCVS-EXIT. NC1734.2 +217700 DIV-TEST-F3-31-1. NC1734.2 +217800 MOVE "DIV-TEST-F3-31-1" TO PAR-NAME. NC1734.2 +217900 IF WRK-DS-18V00-S = 000000001000000000 NC1734.2 +218000 PERFORM PASS NC1734.2 +218100 PERFORM PRINT-DETAIL NC1734.2 +218200 ELSE NC1734.2 +218300 MOVE 000000001000000000 TO CORRECT-18V0 NC1734.2 +218400 MOVE WRK-DS-18V00-S TO COMPUTED-18V0 NC1734.2 +218500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC1734.2 +218600 PERFORM FAIL NC1734.2 +218700 PERFORM PRINT-DETAIL. NC1734.2 +218800 ADD 1 TO REC-CT. NC1734.2 +218900 DIV-TEST-F3-31-2. NC1734.2 +219000 MOVE "DIV-TEST-F3-31-2" TO PAR-NAME. NC1734.2 +219100 IF XRAY = "N" NC1734.2 +219200 PERFORM PASS NC1734.2 +219300 PERFORM PRINT-DETAIL NC1734.2 +219400 ELSE NC1734.2 +219500 MOVE XRAY TO COMPUTED-X NC1734.2 +219600 MOVE "N" TO CORRECT-X NC1734.2 +219700 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1734.2 +219800 TO RE-MARK NC1734.2 +219900 PERFORM FAIL NC1734.2 +220000 PERFORM PRINT-DETAIL. NC1734.2 +220100 ADD 1 TO REC-CT. NC1734.2 +220200 DIV-TEST-F3-31-3. NC1734.2 +220300 MOVE "DIV-TEST-F3-31-3" TO PAR-NAME. NC1734.2 +220400 IF WRK-CS-18V00 = 000000000000000099 NC1734.2 +220500 PERFORM PASS NC1734.2 +220600 PERFORM PRINT-DETAIL NC1734.2 +220700 ELSE NC1734.2 +220800 MOVE WRK-DS-18V00 TO COMPUTED-N NC1734.2 +220900 MOVE 000000000000000099 TO CORRECT-N NC1734.2 +221000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1734.2 +221100 PERFORM FAIL NC1734.2 +221200 PERFORM PRINT-DETAIL. NC1734.2 +221300* NC1734.2 +221400* NC1734.2 +221500* NC1734.2 +221600 CCVS-EXIT SECTION. NC1734.2 +221700 CCVS-999999. NC1734.2 +221800 GO TO CLOSE-FILES. NC1734.2 diff --git a/tests/cobol85/NC/NC174A.CBL b/tests/cobol85/NC/NC174A.CBL new file mode 100755 index 00000000..9a1f21c2 --- /dev/null +++ b/tests/cobol85/NC/NC174A.CBL @@ -0,0 +1,1935 @@ +000100 IDENTIFICATION DIVISION. NC1744.2 +000200 PROGRAM-ID. NC1744.2 +000300 NC174A. NC1744.2 +000400**************************************************************** NC1744.2 +000500* * NC1744.2 +000600* VALIDATION FOR:- * NC1744.2 +000700* * NC1744.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1744.2 +000900* * NC1744.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1744.2 +001100* * NC1744.2 +001200**************************************************************** NC1744.2 +001300* * NC1744.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1744.2 +001500* * NC1744.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1744.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1744.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1744.2 +001900* * NC1744.2 +002000**************************************************************** NC1744.2 +002100* NC1744.2 +002200* PROGRAM NC174A TESTS THE FOLLOWING GENERAL FEATURES: NC1744.2 +002300* RELATIONAL OPERATORS NC1744.2 +002400* CLASS CONDITIONS NC1744.2 +002500* SWITCH SETTINGS NC1744.2 +002600* NC1744.2 +002700 ENVIRONMENT DIVISION. NC1744.2 +002800 CONFIGURATION SECTION. NC1744.2 +002900 SOURCE-COMPUTER. NC1744.2 +003000 Linux. NC1744.2 +003100 OBJECT-COMPUTER. NC1744.2 +003200 Linux. NC1744.2 +003300 SPECIAL-NAMES. NC1744.2 +003400 SWITCH-1 NC1744.2 +003500 IS SW-1 NC1744.2 +003600 ON STATUS IS ON-SWITCH-1 NC1744.2 +003700 OFF STATUS IS OFF-SWITCH-1 NC1744.2 +003800 SWITCH-2 NC1744.2 +003900 IS SW-2 NC1744.2 +004000 ON IS ON-SWITCH-2 NC1744.2 +004100 OFF IS OFF-SWITCH-2 NC1744.2 +004200 CLASS ORDINAL-A-ONLY IS NC1744.2 +004300 "A" NC1744.2 +004400 CLASS ORDINAL-A-THROUGH-D IS NC1744.2 +004500 "A" NC1744.2 +004600 THROUGH NC1744.2 +004700 "D" NC1744.2 +004800 CLASS ORDINAL-D-THRU-A NC1744.2 +004900 "D" NC1744.2 +005000 THRU NC1744.2 +005100 "A" NC1744.2 +005200 CLASS ACTUAL-A-ONLY "A" NC1744.2 +005300 CLASS ACTUAL-A-THRU-D IS "A" THRU "D" NC1744.2 +005400 CLASS ACTUAL-D-THROUGH-A IS "D" THROUGH "A" NC1744.2 +005500 CLASS ACTUAL-ABCD "ABCD". NC1744.2 +005600 INPUT-OUTPUT SECTION. NC1744.2 +005700 FILE-CONTROL. NC1744.2 +005800 SELECT PRINT-FILE ASSIGN TO NC1744.2 +005900 "report.log". NC1744.2 +006000 DATA DIVISION. NC1744.2 +006100 FILE SECTION. NC1744.2 +006200 FD PRINT-FILE. NC1744.2 +006300 01 PRINT-REC PICTURE X(120). NC1744.2 +006400 01 DUMMY-RECORD PICTURE X(120). NC1744.2 +006500 WORKING-STORAGE SECTION. NC1744.2 +006600 01 WS-A PIC X. NC1744.2 +006700 01 WS-B PIC X(5). NC1744.2 +006800 01 IF-D1 PICTURE IS S9(4)V9(2) NC1744.2 +006900 VALUE IS 0. NC1744.2 +007000 01 IF-D2 PICTURE IS S9(4)V9(2) NC1744.2 +007100 VALUE IS ZERO. NC1744.2 +007200 01 IF-D3 PICTURE IS X(10) NC1744.2 +007300 VALUE IS "0000000000". NC1744.2 +007400 01 IF-D4 PICTURE IS X(15) NC1744.2 +007500 VALUE IS " ". NC1744.2 +007600 01 IF-D6 PICTURE IS A(10) NC1744.2 +007700 VALUE IS "BABABABABA". NC1744.2 +007800 01 IF-D7 PICTURE IS S9(6)V9(4) NC1744.2 +007900 VALUE IS +123.45. NC1744.2 +008000 01 IF-D8 PICTURE IS 9(6)V9(4) NC1744.2 +008100 VALUE IS 12300. NC1744.2 +008200 01 IF-D9 PICTURE IS X(3) NC1744.2 +008300 VALUE IS "123". NC1744.2 +008400 01 IF-D11 PICTURE IS X(6) NC1744.2 +008500 VALUE IS "ABCDEF". NC1744.2 +008600 01 IF-D13 PICTURE IS 9(6)V9(4) NC1744.2 +008700 VALUE IS 12300. NC1744.2 +008800 01 IF-D14 PICTURE IS S9(4)V9(2) NC1744.2 +008900 VALUE IS +123.45. NC1744.2 +009000 01 IF-D15 PICTURE IS S999PP NC1744.2 +009100 VALUE IS 12300. NC1744.2 +009200 01 IF-D16 PICTURE IS PP99 NC1744.2 +009300 VALUE IS .0012. NC1744.2 +009400 01 IF-D17 PICTURE IS SV9(4) NC1744.2 +009500 VALUE IS .0012. NC1744.2 +009600 01 IF-D18 PICTURE IS X(10) NC1744.2 +009700 VALUE IS "BABABABABA". NC1744.2 +009800 01 IF-D19 PICTURE IS X(10) NC1744.2 +009900 VALUE IS "ABCDEF ". NC1744.2 +010000 01 IF-D23 PICTURE IS $9,9B9.90+. NC1744.2 +010100 01 IF-D24 PICTURE IS X(10) NC1744.2 +010200 VALUE IS "$1,2 3.40+". NC1744.2 +010300 01 IF-D25 PICTURE IS ABABX0A. NC1744.2 +010400 01 IF-D26 PIC X(7) NC1744.2 +010500 VALUE IS "A C D0E". NC1744.2 +010600 01 IF-D27 PICTURE 9(6)V9(4) VALUE 2137.45 NC1744.2 +010700 USAGE IS COMPUTATIONAL. NC1744.2 +010800 01 IF-D28 PICTURE IS 999999V9999 NC1744.2 +010900 VALUE IS 2137.45. NC1744.2 +011000 01 IF-D32 PICTURE IS 9 VALUE IS 0. NC1744.2 +011100 01 IF-D33 PICTURE S9 VALUE -0. NC1744.2 +011200 01 IF-D34 PICTURE S9 VALUE +0. NC1744.2 +011300 01 IF-D37 PICTURE 9(5) VALUE 0001234. NC1744.2 +011400 01 IF-D38 PICTURE X(20) VALUE " BABBAGE". NC1744.2 +011500 01 ALPHA-UPPER PIC X(20) VALUE " UPPERCASE CHARS". NC1744.2 +011600 01 ALPHA-LOWER PIC X(20) VALUE " lowercase chars". NC1744.2 +011700 01 NON-COBOL-CHARACTERS PICTURE X(8) VALUE NC1744.2 +011800 "12345678". NC1744.2 +011900 01 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC1744.2 +012000 01 A18ONES-DS-18V00 PICTURE S9(18) NC1744.2 +012100 VALUE 111111111111111111. NC1744.2 +012200 01 ONES-XN-00018 PICTURE X(18) NC1744.2 +012300 VALUE "111111111111111111". NC1744.2 +012400 01 A99-DS-02V00 PICTURE S99 VALUE 99. NC1744.2 +012500 01 WRK-DU-02V00 PICTURE 99. NC1744.2 +012600 01 TWOS-XN-00002 PICTURE XX VALUE "22". NC1744.2 +012700 01 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC1744.2 +012800 VALUE 111111111.111111111. NC1744.2 +012900 01 ONES-XN-00002 PICTURE XX VALUE "11". NC1744.2 +013000 01 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC1744.2 +013100 01 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC1744.2 +013200 01 A990-DS-0201P PICTURE S99P VALUE +990. NC1744.2 +013300 01 XDATA-XN-00018 PICTURE X(18) NC1744.2 +013400 VALUE "00ABCDEFGHI 4321 ". NC1744.2 +013500 01 XDATA-DS-18V00-S REDEFINES XDATA-XN-00018 PICTURE S9(18). NC1744.2 +013600 01 YADATA-XN-00010 PICTURE X(10) VALUE "ABCDEFGHIJ".NC1744.2 +013700 01 YADATA-XN-00010-U-AND-L PICTURE X(10) VALUE "AbCdEfGhIj".NC1744.2 +013800 01 DUMMY-DS-00001 PICTURE S9 VALUE -1. NC1744.2 +013900 01 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC1744.2 +014000 01 WRK-DS-18V0-1 PIC S9(18) VALUE NC1744.2 +014100 -123456789012345678. NC1744.2 +014200 01 WRK-XN-18-2 PIC X(18) VALUE NC1744.2 +014300 "123456789012345678". NC1744.2 +014400 NC1744.2 +014500 01 IF-D10. NC1744.2 +014600 02 FILLER PICTURE XX VALUE "01". NC1744.2 +014700 02 FILLER PICTURE XX VALUE "23". NC1744.2 +014800 02 IF-D10A. NC1744.2 +014900 03 FILLER PICTURE XXXX VALUE "4567". NC1744.2 +015000 03 FILLER PICTURE XXXX VALUE "8912". NC1744.2 +015100 01 IF-D12. NC1744.2 +015200 02 FILLER PICTURE XXX VALUE "ABC". NC1744.2 +015300 02 IF-D12A. NC1744.2 +015400 03 IF-D12B. NC1744.2 +015500 04 FILLER PICTURE XX VALUE "DE". NC1744.2 +015600 04 FILLER PICTURE X VALUE "F". NC1744.2 +015700 01 IF-D20. NC1744.2 +015800 02 FILLER PICTURE 9(5) VALUE ZERO. NC1744.2 +015900 02 FILLER PICTURE 99 VALUE 12. NC1744.2 +016000 02 FILLER PICTURE 9 VALUE 3. NC1744.2 +016100 02 FILLER PICTURE 99 VALUE 45. NC1744.2 +016200 01 IF-D21. NC1744.2 +016300 02 FILLER PICTURE 9(5) VALUE ZERO. NC1744.2 +016400 02 FILLER PICTURE 9(5) VALUE 12345. NC1744.2 +016500 01 IF-D22. NC1744.2 +016600 02 FILLER PICTURE AA VALUE "AB". NC1744.2 +016700 02 FILLER PICTURE AAAA VALUE "CDEF". NC1744.2 +016800 01 IF-D35. NC1744.2 +016900 02 IF-D35A VALUE "*ASTERISK". NC1744.2 +017000 03 FILLER PICTURE A(6). NC1744.2 +017100 03 FILLER PICTURE AAA. NC1744.2 +017200 02 IF-D35B VALUE "/SLASH". NC1744.2 +017300 03 FILLER PICTURE 9(6). NC1744.2 +017400 01 IF-D36 REDEFINES IF-D35. NC1744.2 +017500 02 IF-D36A PICTURE X(6). NC1744.2 +017600 02 IF-D36B PICTURE XXX. NC1744.2 +017700 02 IF-D36C PICTURE X(6). NC1744.2 +017800 01 IF-D39. NC1744.2 +017900 02 FILLER PICTURE A(6) VALUE "ABCDEF". NC1744.2 +018000 02 FILLER PICTURE A(4) VALUE SPACE. NC1744.2 +018100 01 LEVEL-01. NC1744.2 +018200 02 LEVEL-02. NC1744.2 +018300 03 LEVEL-03. NC1744.2 +018400 04 LEVEL-04. NC1744.2 +018500 05 LEVEL-05. NC1744.2 +018600 06 LEVEL-06. NC1744.2 +018700 07 LEVEL-07. NC1744.2 +018800 08 LEVEL-08. NC1744.2 +018900 09 LEVEL-09. NC1744.2 +019000 10 LEVEL-10 PICTURE IS X VALUE IS "R".NC1744.2 +019100 01 LEVEL-RECEIVER PICTURE IS X VALUE IS NC1744.2 +019200 SPACE. NC1744.2 +019300 01 LEVEL-SENDER PICTURE X VALUE "S". NC1744.2 +019400 01 VAL PICTURE IS 9 VALUE IS 0. NC1744.2 +019500 01 A-2 PICTURE IS A VALUE IS "A".NC1744.2 +019600 01 N-27 PICTURE IS 9999V9 NC1744.2 +019700 VALUE IS 9999.9. NC1744.2 +019800 01 N-30 PICTURE IS 9V9 NC1744.2 +019900 VALUE IS 2. NC1744.2 +020000 01 N-31 PICTURE IS 9(6). NC1744.2 +020100 01 X-32 REDEFINES N-31 PICTURE IS X(6). NC1744.2 +020200 01 N-33 PICTURE IS 9(5) NC1744.2 +020300 VALUE IS 29. NC1744.2 +020400 01 A-37 PICTURE IS A VALUE IS "X".NC1744.2 +020500 01 X-38 REDEFINES A-37 PICTURE IS X. NC1744.2 +020600 01 X-43 PIC X(10) VALUE " l75.63". NC1744.2 +020700 01 N-84 PICTURE IS 9999999999. NC1744.2 +020800 01 NUMERIC-GRP-TEST. NC1744.2 +020900 02 NUMERIC-1 PICTURE 9 VALUE 0. NC1744.2 +021000 02 NUMERIC-2. NC1744.2 +021100 03 NUMERIC-3 PICTURE 9(1)V9(1) VALUE ZERO. NC1744.2 +021200 03 NUMERIC-4. NC1744.2 +021300 04 NUMERIC-5 PICTURE 9(18) VALUE 1. NC1744.2 +021400 02 NUMERIC-6. NC1744.2 +021500 03 NUMERIC-7 PICTURE X VALUE "7". NC1744.2 +021600 03 NUMERIC-8 PICTURE 9 VALUE 8. NC1744.2 +021700 01 NUM-GRP. NC1744.2 +021800 02 NUM-SUB-GRP PIC 9. NC1744.2 +021900 01 GROUP-1000. NC1744.2 +022000 02 FILLER PIC X. NC1744.2 +022100 02 GROUP-X1000. NC1744.2 +022200 03 GROUP-1000-1 PIC X(500) VALUE ZERO. NC1744.2 +022300 03 XNAME PICTURE X(100) VALUE QUOTE. NC1744.2 +022400 03 GROUP-1000-2 PICTURE X(399) VALUE SPACE. NC1744.2 +022500 03 GROUP-1000-3 PICTURE X VALUE ".". NC1744.2 +022600 02 GROUP-X500-2. NC1744.2 +022700 03 GROUP-X500-A PICTURE X(500) VALUE ZERO. NC1744.2 +022800 03 GROUP-X500-1. NC1744.2 +022900 04 GROUP-X500-1-1 PICTURE X(50) VALUE QUOTE. NC1744.2 +023000 04 GROUP-X500-1-2 PICTURE X(50) VALUE QUOTE. NC1744.2 +023100 04 GROUP-X500-1-3 PICTURE X(398) VALUE SPACE. NC1744.2 +023200 04 GROUP-X500-1-4 PICTURE XX VALUE " .". NC1744.2 +023300 01 HI-LO-VALUES. NC1744.2 +023400 02 LOW-VAL PIC X VALUE LOW-VALUE. NC1744.2 +023500 02 ZERO-01 PICTURE 9(18) VALUE 1. NC1744.2 +023600 02 ABC PICTURE XXX VALUE "ABC". NC1744.2 +023700 02 NINE-17-8 PICTURE 9(18) VALUE 999999999999999998. NC1744.2 +023800 02 ZERO-NULL PIC 9(9) VALUE 0. NC1744.2 +023900 02 ZERO-ZERO PICTURE 9(9)V9(9) VALUE 0.0. NC1744.2 +024000 01 COMP-DATA. NC1744.2 +024100 02 COMP-DATA1 PICTURE 9(18) COMPUTATIONAL VALUE 300. NC1744.2 +024200 02 COMP-DATA2 PICTURE 9(10) COMPUTATIONAL VALUE 100000. NC1744.2 +024300 02 COMP-DATA3 PICTURE 9 COMPUTATIONAL VALUE 9. NC1744.2 +024400 02 COMP-DATA4 PICTURE 9(9)V9(7) COMPUTATIONAL VALUE 3.3. NC1744.2 +024500 02 COMP-DATA5 PICTURE 9(5)V9(2) COMPUTATIONAL VALUE 52.25. NC1744.2 +024600 02 COMP-DATA6 PICTURE 9V9 COMPUTATIONAL VALUE 8.8. NC1744.2 +024700 02 COMP-DATA7 PICTURE 9(3)V9(2) COMPUTATIONAL VALUE 300.00.NC1744.2 +024800 02 COMP-DATA8 PICTURE 9V9(9) COMPUTATIONAL VALUE 3.3000000.NC1744.2 +024900 02 COMP-DATA9 PICTURE 9(8) COMPUTATIONAL VALUE 100000. NC1744.2 +025000 01 DISP-DATA. NC1744.2 +025100 02 DISP-DATA1 PICTURE 9(18) VALUE 300. NC1744.2 +025200 02 DISP-DATA2 PICTURE 9(8) VALUE 100000. NC1744.2 +025300 02 DISP-DATA3 PICTURE 9 VALUE 9. NC1744.2 +025400 02 DISP-DATA4 PICTURE 9(7)V9(9) VALUE 3.3. NC1744.2 +025500 02 DISP-DATA5 PICTURE 9(2)V9(2) VALUE 52.25. NC1744.2 +025600 02 DISP-DATA6 PICTURE 9V9 VALUE 8.8. NC1744.2 +025700 01 DATA-5 PICTURE 9 VALUE 5. NC1744.2 +025800 01 DATA-99999 PICTURE S9(5) VALUE +99999. NC1744.2 +025900 01 DATA-Z PICTURE X VALUE "Z". NC1744.2 +026000 01 DATA-4 PICTURE 9 VALUE 4. NC1744.2 +026100 01 DATA-Y PICTURE X VALUE "Y". NC1744.2 +026200 01 DATA-VWXYZ PICTURE X(5) VALUE "VWXYZ". NC1744.2 +026300 01 DATA-ADCBA PICTURE X(5) VALUE "ADCBA". NC1744.2 +026400 01 TEST-RESULTS. NC1744.2 +026500 02 FILLER PIC X VALUE SPACE. NC1744.2 +026600 02 FEATURE PIC X(20) VALUE SPACE. NC1744.2 +026700 02 FILLER PIC X VALUE SPACE. NC1744.2 +026800 02 P-OR-F PIC X(5) VALUE SPACE. NC1744.2 +026900 02 FILLER PIC X VALUE SPACE. NC1744.2 +027000 02 PAR-NAME. NC1744.2 +027100 03 FILLER PIC X(19) VALUE SPACE. NC1744.2 +027200 03 PARDOT-X PIC X VALUE SPACE. NC1744.2 +027300 03 DOTVALUE PIC 99 VALUE ZERO. NC1744.2 +027400 02 FILLER PIC X(8) VALUE SPACE. NC1744.2 +027500 02 RE-MARK PIC X(61). NC1744.2 +027600 01 TEST-COMPUTED. NC1744.2 +027700 02 FILLER PIC X(30) VALUE SPACE. NC1744.2 +027800 02 FILLER PIC X(17) VALUE NC1744.2 +027900 " COMPUTED=". NC1744.2 +028000 02 COMPUTED-X. NC1744.2 +028100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1744.2 +028200 03 COMPUTED-N REDEFINES COMPUTED-A NC1744.2 +028300 PIC -9(9).9(9). NC1744.2 +028400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1744.2 +028500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1744.2 +028600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1744.2 +028700 03 CM-18V0 REDEFINES COMPUTED-A. NC1744.2 +028800 04 COMPUTED-18V0 PIC -9(18). NC1744.2 +028900 04 FILLER PIC X. NC1744.2 +029000 03 FILLER PIC X(50) VALUE SPACE. NC1744.2 +029100 01 TEST-CORRECT. NC1744.2 +029200 02 FILLER PIC X(30) VALUE SPACE. NC1744.2 +029300 02 FILLER PIC X(17) VALUE " CORRECT =". NC1744.2 +029400 02 CORRECT-X. NC1744.2 +029500 03 CORRECT-A PIC X(20) VALUE SPACE. NC1744.2 +029600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1744.2 +029700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1744.2 +029800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1744.2 +029900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1744.2 +030000 03 CR-18V0 REDEFINES CORRECT-A. NC1744.2 +030100 04 CORRECT-18V0 PIC -9(18). NC1744.2 +030200 04 FILLER PIC X. NC1744.2 +030300 03 FILLER PIC X(2) VALUE SPACE. NC1744.2 +030400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1744.2 +030500 01 CCVS-C-1. NC1744.2 +030600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1744.2 +030700- "SS PARAGRAPH-NAME NC1744.2 +030800- " REMARKS". NC1744.2 +030900 02 FILLER PIC X(20) VALUE SPACE. NC1744.2 +031000 01 CCVS-C-2. NC1744.2 +031100 02 FILLER PIC X VALUE SPACE. NC1744.2 +031200 02 FILLER PIC X(6) VALUE "TESTED". NC1744.2 +031300 02 FILLER PIC X(15) VALUE SPACE. NC1744.2 +031400 02 FILLER PIC X(4) VALUE "FAIL". NC1744.2 +031500 02 FILLER PIC X(94) VALUE SPACE. NC1744.2 +031600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1744.2 +031700 01 REC-CT PIC 99 VALUE ZERO. NC1744.2 +031800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1744.2 +031900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1744.2 +032000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1744.2 +032100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1744.2 +032200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1744.2 +032300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1744.2 +032400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1744.2 +032500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1744.2 +032600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1744.2 +032700 01 CCVS-H-1. NC1744.2 +032800 02 FILLER PIC X(39) VALUE SPACES. NC1744.2 +032900 02 FILLER PIC X(42) VALUE NC1744.2 +033000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1744.2 +033100 02 FILLER PIC X(39) VALUE SPACES. NC1744.2 +033200 01 CCVS-H-2A. NC1744.2 +033300 02 FILLER PIC X(40) VALUE SPACE. NC1744.2 +033400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1744.2 +033500 02 FILLER PIC XXXX VALUE NC1744.2 +033600 "4.2 ". NC1744.2 +033700 02 FILLER PIC X(28) VALUE NC1744.2 +033800 " COPY - NOT FOR DISTRIBUTION". NC1744.2 +033900 02 FILLER PIC X(41) VALUE SPACE. NC1744.2 +034000 NC1744.2 +034100 01 CCVS-H-2B. NC1744.2 +034200 02 FILLER PIC X(15) VALUE NC1744.2 +034300 "TEST RESULT OF ". NC1744.2 +034400 02 TEST-ID PIC X(9). NC1744.2 +034500 02 FILLER PIC X(4) VALUE NC1744.2 +034600 " IN ". NC1744.2 +034700 02 FILLER PIC X(12) VALUE NC1744.2 +034800 " HIGH ". NC1744.2 +034900 02 FILLER PIC X(22) VALUE NC1744.2 +035000 " LEVEL VALIDATION FOR ". NC1744.2 +035100 02 FILLER PIC X(58) VALUE NC1744.2 +035200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1744.2 +035300 01 CCVS-H-3. NC1744.2 +035400 02 FILLER PIC X(34) VALUE NC1744.2 +035500 " FOR OFFICIAL USE ONLY ". NC1744.2 +035600 02 FILLER PIC X(58) VALUE NC1744.2 +035700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1744.2 +035800 02 FILLER PIC X(28) VALUE NC1744.2 +035900 " COPYRIGHT 1985 ". NC1744.2 +036000 01 CCVS-E-1. NC1744.2 +036100 02 FILLER PIC X(52) VALUE SPACE. NC1744.2 +036200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1744.2 +036300 02 ID-AGAIN PIC X(9). NC1744.2 +036400 02 FILLER PIC X(45) VALUE SPACES. NC1744.2 +036500 01 CCVS-E-2. NC1744.2 +036600 02 FILLER PIC X(31) VALUE SPACE. NC1744.2 +036700 02 FILLER PIC X(21) VALUE SPACE. NC1744.2 +036800 02 CCVS-E-2-2. NC1744.2 +036900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1744.2 +037000 03 FILLER PIC X VALUE SPACE. NC1744.2 +037100 03 ENDER-DESC PIC X(44) VALUE NC1744.2 +037200 "ERRORS ENCOUNTERED". NC1744.2 +037300 01 CCVS-E-3. NC1744.2 +037400 02 FILLER PIC X(22) VALUE NC1744.2 +037500 " FOR OFFICIAL USE ONLY". NC1744.2 +037600 02 FILLER PIC X(12) VALUE SPACE. NC1744.2 +037700 02 FILLER PIC X(58) VALUE NC1744.2 +037800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1744.2 +037900 02 FILLER PIC X(13) VALUE SPACE. NC1744.2 +038000 02 FILLER PIC X(15) VALUE NC1744.2 +038100 " COPYRIGHT 1985". NC1744.2 +038200 01 CCVS-E-4. NC1744.2 +038300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1744.2 +038400 02 FILLER PIC X(4) VALUE " OF ". NC1744.2 +038500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1744.2 +038600 02 FILLER PIC X(40) VALUE NC1744.2 +038700 " TESTS WERE EXECUTED SUCCESSFULLY". NC1744.2 +038800 01 XXINFO. NC1744.2 +038900 02 FILLER PIC X(19) VALUE NC1744.2 +039000 "*** INFORMATION ***". NC1744.2 +039100 02 INFO-TEXT. NC1744.2 +039200 04 FILLER PIC X(8) VALUE SPACE. NC1744.2 +039300 04 XXCOMPUTED PIC X(20). NC1744.2 +039400 04 FILLER PIC X(5) VALUE SPACE. NC1744.2 +039500 04 XXCORRECT PIC X(20). NC1744.2 +039600 02 INF-ANSI-REFERENCE PIC X(48). NC1744.2 +039700 01 HYPHEN-LINE. NC1744.2 +039800 02 FILLER PIC IS X VALUE IS SPACE. NC1744.2 +039900 02 FILLER PIC IS X(65) VALUE IS "************************NC1744.2 +040000- "*****************************************". NC1744.2 +040100 02 FILLER PIC IS X(54) VALUE IS "************************NC1744.2 +040200- "******************************". NC1744.2 +040300 01 CCVS-PGM-ID PIC X(9) VALUE NC1744.2 +040400 "NC174A". NC1744.2 +040500 PROCEDURE DIVISION. NC1744.2 +040600 CCVS1 SECTION. NC1744.2 +040700 OPEN-FILES. NC1744.2 +040800 OPEN OUTPUT PRINT-FILE. NC1744.2 +040900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1744.2 +041000 MOVE SPACE TO TEST-RESULTS. NC1744.2 +041100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1744.2 +041200 GO TO CCVS1-EXIT. NC1744.2 +041300 CLOSE-FILES. NC1744.2 +041400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1744.2 +041500 TERMINATE-CCVS. NC1744.2 +041600*S EXIT PROGRAM. NC1744.2 +041700*SERMINATE-CALL. NC1744.2 +041800 STOP RUN. NC1744.2 +041900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1744.2 +042000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1744.2 +042100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1744.2 +042200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1744.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. NC1744.2 +042400 PRINT-DETAIL. NC1744.2 +042500 IF REC-CT NOT EQUAL TO ZERO NC1744.2 +042600 MOVE "." TO PARDOT-X NC1744.2 +042700 MOVE REC-CT TO DOTVALUE. NC1744.2 +042800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1744.2 +042900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1744.2 +043000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1744.2 +043100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1744.2 +043200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1744.2 +043300 MOVE SPACE TO CORRECT-X. NC1744.2 +043400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1744.2 +043500 MOVE SPACE TO RE-MARK. NC1744.2 +043600 HEAD-ROUTINE. NC1744.2 +043700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +043800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +043900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1744.2 +044000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1744.2 +044100 COLUMN-NAMES-ROUTINE. NC1744.2 +044200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +044300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +044400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +044500 END-ROUTINE. NC1744.2 +044600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1744.2 +044700 END-RTN-EXIT. NC1744.2 +044800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +044900 END-ROUTINE-1. NC1744.2 +045000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1744.2 +045100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1744.2 +045200 ADD PASS-COUNTER TO ERROR-HOLD. NC1744.2 +045300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1744.2 +045400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1744.2 +045500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1744.2 +045600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1744.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1744.2 +045800 END-ROUTINE-12. NC1744.2 +045900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1744.2 +046000 IF ERROR-COUNTER IS EQUAL TO ZERO NC1744.2 +046100 MOVE "NO " TO ERROR-TOTAL NC1744.2 +046200 ELSE NC1744.2 +046300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1744.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1744.2 +046500 PERFORM WRITE-LINE. NC1744.2 +046600 END-ROUTINE-13. NC1744.2 +046700 IF DELETE-COUNTER IS EQUAL TO ZERO NC1744.2 +046800 MOVE "NO " TO ERROR-TOTAL ELSE NC1744.2 +046900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1744.2 +047000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1744.2 +047100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +047200 IF INSPECT-COUNTER EQUAL TO ZERO NC1744.2 +047300 MOVE "NO " TO ERROR-TOTAL NC1744.2 +047400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1744.2 +047500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1744.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +047700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1744.2 +047800 WRITE-LINE. NC1744.2 +047900 ADD 1 TO RECORD-COUNT. NC1744.2 +048000 IF RECORD-COUNT GREATER 42 NC1744.2 +048100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1744.2 +048200 MOVE SPACE TO DUMMY-RECORD NC1744.2 +048300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1744.2 +048400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1744.2 +048500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1744.2 +048600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1744.2 +048700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1744.2 +048800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1744.2 +048900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1744.2 +049000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1744.2 +049100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1744.2 +049200 MOVE ZERO TO RECORD-COUNT. NC1744.2 +049300 PERFORM WRT-LN. NC1744.2 +049400 WRT-LN. NC1744.2 +049500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1744.2 +049600 MOVE SPACE TO DUMMY-RECORD. NC1744.2 +049700 BLANK-LINE-PRINT. NC1744.2 +049800 PERFORM WRT-LN. NC1744.2 +049900 FAIL-ROUTINE. NC1744.2 +050000 IF COMPUTED-X NOT EQUAL TO SPACE NC1744.2 +050100 GO TO FAIL-ROUTINE-WRITE. NC1744.2 +050200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1744.2 +050300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1744.2 +050400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1744.2 +050500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +050600 MOVE SPACES TO INF-ANSI-REFERENCE. NC1744.2 +050700 GO TO FAIL-ROUTINE-EX. NC1744.2 +050800 FAIL-ROUTINE-WRITE. NC1744.2 +050900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1744.2 +051000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1744.2 +051100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1744.2 +051200 MOVE SPACES TO COR-ANSI-REFERENCE. NC1744.2 +051300 FAIL-ROUTINE-EX. EXIT. NC1744.2 +051400 BAIL-OUT. NC1744.2 +051500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1744.2 +051600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1744.2 +051700 BAIL-OUT-WRITE. NC1744.2 +051800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1744.2 +051900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1744.2 +052000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1744.2 +052100 MOVE SPACES TO INF-ANSI-REFERENCE. NC1744.2 +052200 BAIL-OUT-EX. EXIT. NC1744.2 +052300 CCVS1-EXIT. NC1744.2 +052400 EXIT. NC1744.2 +052500 SECT-NC174A-001 SECTION. NC1744.2 +052600* NC1744.2 +052700* NC1744.2 +052800 NEXT-INIT-GF-1. NC1744.2 +052900* ==--> NEXT SENTENCE <--== NC1744.2 +053000 MOVE "V1-89 6.15.4 GR2 " TO ANSI-REFERENCE. NC1744.2 +053100 MOVE "A" TO A-2. NC1744.2 +053200 NEXT-TEST-GF-1. NC1744.2 +053300 IF A-2 EQUAL TO "A" NC1744.2 +053400 NEXT SENTENCE NC1744.2 +053500 ELSE NC1744.2 +053600 NEXT SENTENCE. NC1744.2 +053700 PERFORM PASS. NC1744.2 +053800 GO TO NEXT-WRITE-GF-1. NC1744.2 +053900 NEXT-DELETE-GF-1. NC1744.2 +054000 PERFORM DE-LETE. NC1744.2 +054100 NEXT-WRITE-GF-1. NC1744.2 +054200 MOVE "NEXT-TEST-1" TO PAR-NAME. NC1744.2 +054300 PERFORM PRINT-DETAIL. NC1744.2 +054400* NC1744.2 +054500* NC1744.2 +054600 ANOTHER-REMARK. NC1744.2 +054700 MOVE SPACE TO TEST-RESULTS. NC1744.2 +054800 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC1744.2 +054900 PERFORM PRINT-DETAIL. NC1744.2 +055000 MOVE "TEST THE COMPARISONS IN " TO RE-MARK. NC1744.2 +055100 PERFORM PRINT-DETAIL. NC1744.2 +055200 MOVE "SWITCH-STATUS, RELATION " TO RE-MARK. NC1744.2 +055300 PERFORM PRINT-DETAIL. NC1744.2 +055400 MOVE "AND CLASS CONDITIONALS. " TO RE-MARK. NC1744.2 +055500 PERFORM PRINT-DETAIL. NC1744.2 +055600 SWH-INIT-GF-1. NC1744.2 +055700 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC1744.2 +055800 MOVE "SWITCH-STATUS" TO FEATURE. NC1744.2 +055900 SWH-TEST-GF-1. NC1744.2 +056000 IF ON-SWITCH-1 NC1744.2 +056100 PERFORM PASS NC1744.2 +056200 ELSE NC1744.2 +056300 PERFORM FAIL. NC1744.2 +056400 GO TO SWH-WRITE-GF-1. NC1744.2 +056500 SWH-DELETE-GF-1. NC1744.2 +056600*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +056700 PERFORM DE-LETE. NC1744.2 +056800 SWH-WRITE-GF-1. NC1744.2 +056900 MOVE "SWH-TEST-GF-1" TO PAR-NAME. NC1744.2 +057000 PERFORM PRINT-DETAIL. NC1744.2 +057100 SWH-INIT-GF-2. NC1744.2 +057200 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC1744.2 +057300 SWH-TEST-GF-2. NC1744.2 +057400 IF OFF-SWITCH-1 NC1744.2 +057500 PERFORM FAIL NC1744.2 +057600 ELSE NC1744.2 +057700 PERFORM PASS. NC1744.2 +057800 GO TO SWH-WRITE-GF-2. NC1744.2 +057900 SWH-DELETE-GF-2. NC1744.2 +058000*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +058100 PERFORM DE-LETE. NC1744.2 +058200 SWH-WRITE-GF-2. NC1744.2 +058300 MOVE "SWH-TEST-GF-2" TO PAR-NAME. NC1744.2 +058400 PERFORM PRINT-DETAIL. NC1744.2 +058500 SWH-INIT-GF-3. NC1744.2 +058600 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC1744.2 +058700 SWH-TEST-GF-3. NC1744.2 +058800 IF OFF-SWITCH-2 NC1744.2 +058900 PERFORM PASS NC1744.2 +059000 ELSE NC1744.2 +059100 PERFORM FAIL. NC1744.2 +059200 GO TO SWH-WRITE-GF-3. NC1744.2 +059300 SWH-DELETE-GF-3. NC1744.2 +059400*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +059500 PERFORM DE-LETE. NC1744.2 +059600 SWH-WRITE-GF-3. NC1744.2 +059700 MOVE "SWH-TEST-GF-3" TO PAR-NAME. NC1744.2 +059800 PERFORM PRINT-DETAIL. NC1744.2 +059900 SWH-INIT-GF-4. NC1744.2 +060000 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC1744.2 +060100 SWH-TEST-GF-4. NC1744.2 +060200 IF ON-SWITCH-2 NC1744.2 +060300 PERFORM FAIL NC1744.2 +060400 ELSE NC1744.2 +060500 PERFORM PASS. NC1744.2 +060600 GO TO SWH-WRITE-GF-4. NC1744.2 +060700 SWH-DELETE-GF-4. NC1744.2 +060800*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +060900 PERFORM DE-LETE. NC1744.2 +061000 SWH-WRITE-GF-4. NC1744.2 +061100 MOVE "SWH-TEST-GF-4" TO PAR-NAME. NC1744.2 +061200 PERFORM PRINT-DETAIL. NC1744.2 +061300 SWH-TEST-5. NC1744.2 +061400* DELETE THE NEXT LINE TO DELETE THIS TEST NC1744.2 +061500 GO TO SWH-TEST-5-B. NC1744.2 +061600 SWH-TEST-5-A. NC1744.2 +061700 GO TO SWH-DELETE-5. NC1744.2 +061800 SWH-TEST-5-B. NC1744.2 +061900 IF NOT ON-SWITCH-1 NC1744.2 +062000 MOVE "SWITCH-1 OFF " TO COMPUTED-A NC1744.2 +062100 MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A NC1744.2 +062200 PERFORM FAIL NC1744.2 +062300 GO TO SWH-WRITE-5. NC1744.2 +062400 PERFORM PASS. NC1744.2 +062500 GO TO SWH-WRITE-5. NC1744.2 +062600 SWH-DELETE-5. NC1744.2 +062700*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +062800 PERFORM DE-LETE. NC1744.2 +062900 SWH-WRITE-5. NC1744.2 +063000 MOVE "SWH-TEST-5" TO PAR-NAME. NC1744.2 +063100 PERFORM PRINT-DETAIL. NC1744.2 +063200 SWH-TEST-6. NC1744.2 +063300* DELETE THE NEXT LINE TO DELETE THIS TEST NC1744.2 +063400 GO TO SWH-TEST-6-B. NC1744.2 +063500 SWH-TEST-6-A. NC1744.2 +063600 GO TO SWH-DELETE-6. NC1744.2 +063700 SWH-TEST-6-B. NC1744.2 +063800 IF NOT OFF-SWITCH-1 NC1744.2 +063900 PERFORM PASS NC1744.2 +064000 GO TO SWH-WRITE-6. NC1744.2 +064100 MOVE "SWITCH-1 OFF " TO COMPUTED-A. NC1744.2 +064200 MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A. NC1744.2 +064300 PERFORM FAIL. NC1744.2 +064400 GO TO SWH-WRITE-6. NC1744.2 +064500 SWH-DELETE-6. NC1744.2 +064600*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +064700 PERFORM DE-LETE. NC1744.2 +064800 SWH-WRITE-6. NC1744.2 +064900 MOVE "SWH-TEST-6" TO PAR-NAME. NC1744.2 +065000 PERFORM PRINT-DETAIL. NC1744.2 +065100 SWH-TEST-7. NC1744.2 +065200 GO TO SWH-DELETE-7. NC1744.2 +065300 IF NOT ON-SWITCH-2 NC1744.2 +065400 PERFORM PASS NC1744.2 +065500 GO TO SWH-WRITE-7. NC1744.2 +065600 MOVE "SWITCH-2 ON " TO COMPUTED-A. NC1744.2 +065700 MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A. NC1744.2 +065800 PERFORM FAIL. NC1744.2 +065900 GO TO SWH-WRITE-7. NC1744.2 +066000 SWH-DELETE-7. NC1744.2 +066100*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +066200 PERFORM DE-LETE. NC1744.2 +066300 SWH-WRITE-7. NC1744.2 +066400 MOVE "SWH-TEST-7" TO PAR-NAME. NC1744.2 +066500 PERFORM PRINT-DETAIL. NC1744.2 +066600 SWH-TEST-8. NC1744.2 +066700* DELETE THE NEXT LINE TO DELETE THIS TEST NC1744.2 +066800 GO TO SWH-TEST-8-B. NC1744.2 +066900 SWH-TEST-8-A. NC1744.2 +067000 GO TO SWH-DELETE-8. NC1744.2 +067100 SWH-TEST-8-B. NC1744.2 +067200 IF NOT OFF-SWITCH-2 NC1744.2 +067300 MOVE "SWITCH-2 ON " TO COMPUTED-A NC1744.2 +067400 MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A NC1744.2 +067500 PERFORM FAIL NC1744.2 +067600 GO TO SWH-WRITE-8. NC1744.2 +067700 PERFORM PASS. NC1744.2 +067800 GO TO SWH-WRITE-8. NC1744.2 +067900 SWH-DELETE-8. NC1744.2 +068000*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +068100 PERFORM DE-LETE. NC1744.2 +068200 SWH-WRITE-8. NC1744.2 +068300 MOVE "SWH-TEST-8" TO PAR-NAME. NC1744.2 +068400 PERFORM PRINT-DETAIL. NC1744.2 +068500* NC1744.2 +068600* NC1744.2 +068700 SWH-INIT-GF-9. NC1744.2 +068800 MOVE "SET SWITCH ON/OFF" TO FEATURE. NC1744.2 +068900 MOVE "V1-126 6.22.1(2)" TO ANSI-REFERENCE. NC1744.2 +069000 SET SW-1 TO ON. NC1744.2 +069100 SWH-TEST-GF-9. NC1744.2 +069200 IF ON-SWITCH-1 NC1744.2 +069300 PERFORM PASS NC1744.2 +069400 ELSE NC1744.2 +069500 PERFORM FAIL. NC1744.2 +069600 GO TO SWH-WRITE-GF-9. NC1744.2 +069700 SWH-DELETE-GF-9. NC1744.2 +069800*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +069900 PERFORM DE-LETE. NC1744.2 +070000 SWH-WRITE-GF-9. NC1744.2 +070100 MOVE "SWH-TEST-GF-9" TO PAR-NAME. NC1744.2 +070200 PERFORM PRINT-DETAIL. NC1744.2 +070300* NC1744.2 +070400* NC1744.2 +070500 SWH-INIT-GF-10. NC1744.2 +070600 MOVE "SET SWITCH ON/OFF" TO FEATURE. NC1744.2 +070700 MOVE "V1-126 6.22.1(2)" TO ANSI-REFERENCE. NC1744.2 +070800 SET SW-1 SW-2 TO OFF. NC1744.2 +070900 SWH-TEST-GF-10-1. NC1744.2 +071000 IF OFF-SWITCH-1 NC1744.2 +071100 PERFORM PASS NC1744.2 +071200 ELSE NC1744.2 +071300 PERFORM FAIL. NC1744.2 +071400 GO TO SWH-WRITE-GF-10-1. NC1744.2 +071500 SWH-DELETE-GF-10-1. NC1744.2 +071600*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +071700 PERFORM DE-LETE. NC1744.2 +071800 SWH-WRITE-GF-10-1. NC1744.2 +071900 MOVE "SWH-TEST-GF-10-1" TO PAR-NAME. NC1744.2 +072000 PERFORM PRINT-DETAIL. NC1744.2 +072100 SWH-TEST-GF-10-2. NC1744.2 +072200 IF OFF-SWITCH-2 NC1744.2 +072300 PERFORM PASS NC1744.2 +072400 ELSE NC1744.2 +072500 PERFORM FAIL. NC1744.2 +072600 GO TO SWH-WRITE-GF-10-2. NC1744.2 +072700 SWH-DELETE-GF-10-2. NC1744.2 +072800*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +072900 PERFORM DE-LETE. NC1744.2 +073000 SWH-WRITE-GF-10-2. NC1744.2 +073100 MOVE "SWH-TEST-GF-10-2" TO PAR-NAME. NC1744.2 +073200 PERFORM PRINT-DETAIL. NC1744.2 +073300* NC1744.2 +073400* NC1744.2 +073500 SWH-INIT-GF-11. NC1744.2 +073600 MOVE "SET SWITCH ON/OFF" TO FEATURE. NC1744.2 +073700 MOVE "V1-126 6.22.1(2)" TO ANSI-REFERENCE. NC1744.2 +073800 SET SW-1 TO ON NC1744.2 +073900 SW-2 TO OFF. NC1744.2 +074000 SWH-TEST-GF-11-1. NC1744.2 +074100 IF ON-SWITCH-1 NC1744.2 +074200 PERFORM PASS NC1744.2 +074300 ELSE NC1744.2 +074400 PERFORM FAIL. NC1744.2 +074500 GO TO SWH-WRITE-GF-11-1. NC1744.2 +074600 SWH-DELETE-GF-11-1. NC1744.2 +074700*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +074800 PERFORM DE-LETE. NC1744.2 +074900 SWH-WRITE-GF-11-1. NC1744.2 +075000 MOVE "SWH-TEST-GF-11-1" TO PAR-NAME. NC1744.2 +075100 PERFORM PRINT-DETAIL. NC1744.2 +075200 SWH-TEST-GF-11-2. NC1744.2 +075300 IF OFF-SWITCH-2 NC1744.2 +075400 PERFORM PASS NC1744.2 +075500 ELSE NC1744.2 +075600 PERFORM FAIL. NC1744.2 +075700 GO TO SWH-WRITE-GF-11-2. NC1744.2 +075800 SWH-DELETE-GF-11-2. NC1744.2 +075900*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +076000 PERFORM DE-LETE. NC1744.2 +076100 SWH-WRITE-GF-11-2. NC1744.2 +076200 MOVE "SWH-TEST-GF-11-2" TO PAR-NAME. NC1744.2 +076300 PERFORM PRINT-DETAIL. NC1744.2 +076400* NC1744.2 +076500* NC1744.2 +076600 SWH-INIT-GF-12. NC1744.2 +076700 MOVE "SET SWITCH ON/OFF" TO FEATURE. NC1744.2 +076800 MOVE "V1-126 6.22.1(2)" TO ANSI-REFERENCE. NC1744.2 +076900 SET SW-2 TO OFF. NC1744.2 +077000 SWH-TEST-GF-12. NC1744.2 +077100 IF OFF-SWITCH-2 NC1744.2 +077200 PERFORM PASS NC1744.2 +077300 ELSE NC1744.2 +077400 PERFORM FAIL. NC1744.2 +077500 GO TO SWH-WRITE-GF-12. NC1744.2 +077600 SWH-DELETE-GF-12. NC1744.2 +077700*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC1744.2 +077800 PERFORM DE-LETE. NC1744.2 +077900 SWH-WRITE-GF-12. NC1744.2 +078000 MOVE "SWH-TEST-GF-12" TO PAR-NAME. NC1744.2 +078100 PERFORM PRINT-DETAIL. NC1744.2 +078200* NC1744.2 +078300* NC1744.2 +078400 RELAT-INIT-GF-1. NC1744.2 +078500 MOVE "RELATION" TO FEATURE. NC1744.2 +078600 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +078700 MOVE ZERO TO VAL. NC1744.2 +078800 MOVE "A" TO A-2. NC1744.2 +078900 RELAT-TEST-GF-1. NC1744.2 +079000 IF "Z" GREATER THAN A-2 NC1744.2 +079100 ADD 1 VAL GIVING VAL. NC1744.2 +079200 NC1744.2 +079300 IF A-2 GREATER THAN "Z" NC1744.2 +079400 GO TO RELAT-CHECK-GF-1. NC1744.2 +079500 ADD 2 VAL GIVING VAL. NC1744.2 +079600 GO TO RELAT-CHECK-GF-1. NC1744.2 +079700 RELAT-DELETE-GF-1. NC1744.2 +079800 PERFORM DE-LETE. NC1744.2 +079900 GO TO RELAT-WRITE-GF-1. NC1744.2 +080000 RELAT-CHECK-GF-1. NC1744.2 +080100 IF VAL EQUAL TO 3 NC1744.2 +080200 PERFORM PASS NC1744.2 +080300 GO TO RELAT-WRITE-GF-1. NC1744.2 +080400 MOVE VAL TO COMPUTED-A. NC1744.2 +080500 MOVE 3 TO CORRECT-A. NC1744.2 +080600 PERFORM FAIL. NC1744.2 +080700 RELAT-WRITE-GF-1. NC1744.2 +080800 MOVE "RELAT-TEST-GF-1" TO PAR-NAME. NC1744.2 +080900 PERFORM PRINT-DETAIL. NC1744.2 +081000 RELAT-INIT-GF-2. NC1744.2 +081100 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +081200 MOVE ZERO TO VAL. NC1744.2 +081300 MOVE "A" TO A-2. NC1744.2 +081400 RELAT-TEST-GF-2. NC1744.2 +081500 IF A-2 NOT GREATER THAN "Z" NC1744.2 +081600 ADD 1 VAL GIVING VAL. NC1744.2 +081700 IF "Z" NOT GREATER THAN A-2 NC1744.2 +081800 GO TO RELAT-CHECK-GF-2. NC1744.2 +081900 ADD 2 VAL GIVING VAL. NC1744.2 +082000 GO TO RELAT-CHECK-GF-2. NC1744.2 +082100 RELAT-DELETE-GF-2. NC1744.2 +082200 PERFORM DE-LETE. NC1744.2 +082300 GO TO RELAT-WRITE-GF-2. NC1744.2 +082400 RELAT-CHECK-GF-2. NC1744.2 +082500 IF VAL EQUAL TO 3 NC1744.2 +082600 PERFORM PASS NC1744.2 +082700 GO TO RELAT-WRITE-GF-2. NC1744.2 +082800 MOVE VAL TO COMPUTED-A. NC1744.2 +082900 MOVE 3 TO CORRECT-A. NC1744.2 +083000 PERFORM FAIL. NC1744.2 +083100 RELAT-WRITE-GF-2. NC1744.2 +083200 MOVE "RELAT-TEST-GF-2" TO PAR-NAME. NC1744.2 +083300 PERFORM PRINT-DETAIL. NC1744.2 +083400 RELAT-INIT-GF-3. NC1744.2 +083500 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +083600 MOVE ZERO TO VAL. NC1744.2 +083700 MOVE 2 TO N-30. NC1744.2 +083800 MOVE 29 TO N-33. NC1744.2 +083900 RELAT-TEST-GF-3. NC1744.2 +084000 IF N-30 LESS THAN N-33 NC1744.2 +084100 ADD 1 VAL GIVING VAL. NC1744.2 +084200 IF N-33 LESS THAN N-30 NC1744.2 +084300 GO TO RELAT-CHECK-GF-3. NC1744.2 +084400 ADD 2 VAL GIVING VAL. NC1744.2 +084500 GO TO RELAT-CHECK-GF-3. NC1744.2 +084600 RELAT-DELETE-GF-3. NC1744.2 +084700 PERFORM DE-LETE. NC1744.2 +084800 GO TO RELAT-WRITE-GF-3. NC1744.2 +084900 RELAT-CHECK-GF-3. NC1744.2 +085000 IF VAL EQUAL TO 3 NC1744.2 +085100 PERFORM PASS NC1744.2 +085200 GO TO RELAT-WRITE-GF-3. NC1744.2 +085300 MOVE VAL TO COMPUTED-A. NC1744.2 +085400 MOVE 3 TO CORRECT-A. NC1744.2 +085500 PERFORM FAIL. NC1744.2 +085600 RELAT-WRITE-GF-3. NC1744.2 +085700 MOVE "RELAT-TEST-GF-3" TO PAR-NAME. NC1744.2 +085800 PERFORM PRINT-DETAIL. NC1744.2 +085900 RELAT-INIT-GF-4. NC1744.2 +086000 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +086100 MOVE ZERO TO VAL. NC1744.2 +086200 MOVE 9999.9 TO N-27. NC1744.2 +086300 RELAT-TEST-GF-4. NC1744.2 +086400 IF 5280 NOT LESS THAN N-27 NC1744.2 +086500 ADD 1 VAL GIVING VAL. NC1744.2 +086600 IF N-27 NOT LESS THAN 5280 NC1744.2 +086700 GO TO RELAT-CHECK-GF-4. NC1744.2 +086800 ADD 2 VAL GIVING VAL. NC1744.2 +086900 GO TO RELAT-CHECK-GF-4. NC1744.2 +087000 RELAT-DELETE-GF-4. NC1744.2 +087100 PERFORM DE-LETE. NC1744.2 +087200 GO TO RELAT-WRITE-GF-4. NC1744.2 +087300 RELAT-CHECK-GF-4. NC1744.2 +087400 IF VAL EQUAL TO ZERO NC1744.2 +087500 PERFORM PASS NC1744.2 +087600 GO TO RELAT-WRITE-GF-4. NC1744.2 +087700 MOVE VAL TO COMPUTED-A. NC1744.2 +087800 MOVE ZERO TO CORRECT-A. NC1744.2 +087900 PERFORM FAIL. NC1744.2 +088000 RELAT-WRITE-GF-4. NC1744.2 +088100 MOVE "RELAT-TEST-GF-4" TO PAR-NAME. NC1744.2 +088200 PERFORM PRINT-DETAIL. NC1744.2 +088300 RELAT-INIT-GF-5. NC1744.2 +088400 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +088500 MOVE ZERO TO VAL. NC1744.2 +088600 MOVE 29 TO N-33. NC1744.2 +088700 MOVE " $75.63" TO X-43. NC1744.2 +088800 RELAT-TEST-GF-5. NC1744.2 +088900 MOVE N-33 TO N-84. NC1744.2 +089000 IF N-33 EQUAL TO N-84 NC1744.2 +089100 ADD 1 VAL GIVING VAL. NC1744.2 +089200 IF N-84 EQUAL TO X-43 NC1744.2 +089300 GO TO RELAT-CHECK-GF-5. NC1744.2 +089400 ADD 2 VAL GIVING VAL. NC1744.2 +089500 GO TO RELAT-CHECK-GF-5. NC1744.2 +089600 RELAT-DELETE-GF-5. NC1744.2 +089700 PERFORM DE-LETE. NC1744.2 +089800 GO TO RELAT-WRITE-GF-5. NC1744.2 +089900 RELAT-CHECK-GF-5. NC1744.2 +090000 IF VAL EQUAL TO 3 NC1744.2 +090100 PERFORM PASS NC1744.2 +090200 GO TO RELAT-WRITE-GF-5. NC1744.2 +090300 MOVE VAL TO COMPUTED-A. NC1744.2 +090400 MOVE 3 TO CORRECT-A. NC1744.2 +090500 PERFORM FAIL. NC1744.2 +090600 RELAT-WRITE-GF-5. NC1744.2 +090700 MOVE "RELAT-TEST-GF-5" TO PAR-NAME. NC1744.2 +090800 PERFORM PRINT-DETAIL. NC1744.2 +090900 RELAT-INIT-GF-6. NC1744.2 +091000 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +091100 MOVE ZERO TO VAL. NC1744.2 +091200 MOVE 29 TO N-33. NC1744.2 +091300 MOVE 29 TO N-84. NC1744.2 +091400 MOVE " $75.63" TO X-43. NC1744.2 +091500 RELAT-TEST-GF-6. NC1744.2 +091600 IF N-84 NOT EQUAL TO X-43 NC1744.2 +091700 ADD 1 VAL GIVING VAL. NC1744.2 +091800 IF N-33 NOT EQUAL TO N-84 NC1744.2 +091900 GO TO RELAT-CHECK-GF-6. NC1744.2 +092000 ADD 2 VAL GIVING VAL. NC1744.2 +092100 GO TO RELAT-CHECK-GF-6. NC1744.2 +092200 RELAT-DELETE-GF-6. NC1744.2 +092300 PERFORM DE-LETE. NC1744.2 +092400 GO TO RELAT-WRITE-GF-6. NC1744.2 +092500 RELAT-CHECK-GF-6. NC1744.2 +092600 IF VAL EQUAL TO 3 NC1744.2 +092700 PERFORM PASS NC1744.2 +092800 GO TO RELAT-WRITE-GF-6. NC1744.2 +092900 MOVE VAL TO COMPUTED-A. NC1744.2 +093000 MOVE 3 TO CORRECT-A. NC1744.2 +093100 PERFORM FAIL. NC1744.2 +093200 RELAT-WRITE-GF-6. NC1744.2 +093300 MOVE "RELAT-TEST-GF-6" TO PAR-NAME. NC1744.2 +093400 PERFORM PRINT-DETAIL. NC1744.2 +093500 RELAT-INIT-GF-7. NC1744.2 +093600 MOVE "ABBREV. RELATION" TO FEATURE. NC1744.2 +093700 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +093800 MOVE ZERO TO VAL. NC1744.2 +093900 MOVE 29 TO N-33. NC1744.2 +094000 RELAT-TEST-GF-7. NC1744.2 +094100 IF N-33 GREATER 2 NC1744.2 +094200 PERFORM PASS NC1744.2 +094300 ELSE NC1744.2 +094400 PERFORM FAIL. NC1744.2 +094500 GO TO RELAT-WRITE-GF-7. NC1744.2 +094600 RELAT-DELETE-GF-7. NC1744.2 +094700 PERFORM DE-LETE. NC1744.2 +094800 RELAT-WRITE-GF-7. NC1744.2 +094900 MOVE "RELAT-TEST-GF-7" TO PAR-NAME. NC1744.2 +095000 PERFORM PRINT-DETAIL. NC1744.2 +095100 RELAT-INIT-GF-8. NC1744.2 +095200 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +095300 MOVE 29 TO N-33. NC1744.2 +095400 RELAT-TEST-GF-8. NC1744.2 +095500 IF 2 LESS N-33 NC1744.2 +095600 PERFORM PASS NC1744.2 +095700 ELSE NC1744.2 +095800 PERFORM FAIL. NC1744.2 +095900 GO TO RELAT-WRITE-GF-8. NC1744.2 +096000 RELAT-DELETE-GF-8. NC1744.2 +096100 PERFORM DE-LETE. NC1744.2 +096200 RELAT-WRITE-GF-8. NC1744.2 +096300 MOVE "RELAT-TEST-GF-8" TO PAR-NAME. NC1744.2 +096400 PERFORM PRINT-DETAIL. NC1744.2 +096500* NC1744.2 +096600* NC1744.2 +096700 RELAT-INIT-GF-9. NC1744.2 +096800 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +096900 MOVE 29 TO N-33. NC1744.2 +097000 RELAT-TEST-GF-9. NC1744.2 +097100 IF N-33 >= 2 NC1744.2 +097200 PERFORM PASS NC1744.2 +097300 ELSE NC1744.2 +097400 PERFORM FAIL. NC1744.2 +097500 GO TO RELAT-WRITE-GF-9. NC1744.2 +097600 RELAT-DELETE-GF-9. NC1744.2 +097700 PERFORM DE-LETE. NC1744.2 +097800 RELAT-WRITE-GF-9. NC1744.2 +097900 MOVE "RELAT-TEST-GF-9" TO PAR-NAME. NC1744.2 +098000 PERFORM PRINT-DETAIL. NC1744.2 +098100* NC1744.2 +098200* NC1744.2 +098300 RELAT-INIT-GF-10. NC1744.2 +098400 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +098500 RELAT-TEST-GF-10. NC1744.2 +098600 IF DATA-5 IS GREATER THAN OR EQUAL TO 4 NC1744.2 +098700 PERFORM PASS NC1744.2 +098800 ELSE NC1744.2 +098900 PERFORM FAIL. NC1744.2 +099000 GO TO RELAT-WRITE-GF-10. NC1744.2 +099100 RELAT-DELETE-GF-10. NC1744.2 +099200 PERFORM DE-LETE. NC1744.2 +099300 RELAT-WRITE-GF-10. NC1744.2 +099400 MOVE "RELAT-TEST-GF-10" TO PAR-NAME. NC1744.2 +099500 PERFORM PRINT-DETAIL. NC1744.2 +099600* NC1744.2 +099700* NC1744.2 +099800 RELAT-INIT-GF-11. NC1744.2 +099900 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +100000 MOVE "X" TO A-37. NC1744.2 +100100 RELAT-TEST-GF-11. NC1744.2 +100200 IF A-37 GREATER OR EQUAL "A" NC1744.2 +100300 PERFORM PASS NC1744.2 +100400 ELSE NC1744.2 +100500 PERFORM FAIL. NC1744.2 +100600 GO TO RELAT-WRITE-GF-11. NC1744.2 +100700 RELAT-DELETE-GF-11. NC1744.2 +100800 PERFORM DE-LETE. NC1744.2 +100900 RELAT-WRITE-GF-11. NC1744.2 +101000 MOVE "RELAT-TEST-GF-11" TO PAR-NAME. NC1744.2 +101100 PERFORM PRINT-DETAIL. NC1744.2 +101200* NC1744.2 +101300* NC1744.2 +101400 RELAT-INIT-GF-12. NC1744.2 +101500 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +101600 MOVE 29 TO N-33. NC1744.2 +101700 RELAT-TEST-GF-12. NC1744.2 +101800 IF N-33 GREATER THAN OR EQUAL 2 NC1744.2 +101900 PERFORM PASS NC1744.2 +102000 ELSE NC1744.2 +102100 PERFORM FAIL. NC1744.2 +102200 GO TO RELAT-WRITE-GF-12. NC1744.2 +102300 RELAT-DELETE-GF-12. NC1744.2 +102400 PERFORM DE-LETE. NC1744.2 +102500 RELAT-WRITE-GF-12. NC1744.2 +102600 MOVE "RELAT-TEST-GF-12" TO PAR-NAME. NC1744.2 +102700 PERFORM PRINT-DETAIL. NC1744.2 +102800* NC1744.2 +102900* NC1744.2 +103000 RELAT-INIT-GF-13. NC1744.2 +103100 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +103200 RELAT-TEST-GF-13. NC1744.2 +103300 IF DATA-99999 GREATER THAN OR EQUAL TO +99999 NC1744.2 +103400 PERFORM PASS NC1744.2 +103500 ELSE NC1744.2 +103600 PERFORM FAIL. NC1744.2 +103700 GO TO RELAT-WRITE-GF-13. NC1744.2 +103800 RELAT-DELETE-GF-13. NC1744.2 +103900 PERFORM DE-LETE. NC1744.2 +104000 RELAT-WRITE-GF-13. NC1744.2 +104100 MOVE "RELAT-TEST-GF-13" TO PAR-NAME. NC1744.2 +104200 PERFORM PRINT-DETAIL. NC1744.2 +104300* NC1744.2 +104400* NC1744.2 +104500 RELAT-INIT-GF-14. NC1744.2 +104600 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +104700 MOVE "X" TO A-37. NC1744.2 +104800 RELAT-TEST-GF-14. NC1744.2 +104900 IF A-37 IS GREATER OR EQUAL "A" NC1744.2 +105000 PERFORM PASS NC1744.2 +105100 ELSE NC1744.2 +105200 PERFORM FAIL. NC1744.2 +105300 GO TO RELAT-WRITE-GF-14. NC1744.2 +105400 RELAT-DELETE-GF-14. NC1744.2 +105500 PERFORM DE-LETE. NC1744.2 +105600 RELAT-WRITE-GF-14. NC1744.2 +105700 MOVE "RELAT-TEST-GF-14" TO PAR-NAME. NC1744.2 +105800 PERFORM PRINT-DETAIL. NC1744.2 +105900* NC1744.2 +106000* NC1744.2 +106100 RELAT-INIT-GF-15. NC1744.2 +106200 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +106300 MOVE "A" TO A-2. NC1744.2 +106400 MOVE "X" TO A-37. NC1744.2 +106500 RELAT-TEST-GF-15. NC1744.2 +106600 IF A-37 IS GREATER THAN OR EQUAL A-2 NC1744.2 +106700 PERFORM PASS NC1744.2 +106800 ELSE NC1744.2 +106900 PERFORM FAIL. NC1744.2 +107000 GO TO RELAT-WRITE-GF-15. NC1744.2 +107100 RELAT-DELETE-GF-15. NC1744.2 +107200 PERFORM DE-LETE. NC1744.2 +107300 RELAT-WRITE-GF-15. NC1744.2 +107400 MOVE "RELAT-TEST-GF-15" TO PAR-NAME. NC1744.2 +107500 PERFORM PRINT-DETAIL. NC1744.2 +107600* NC1744.2 +107700* NC1744.2 +107800 RELAT-INIT-GF-16. NC1744.2 +107900 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +108000 RELAT-TEST-GF-16. NC1744.2 +108100 IF DATA-Z IS >= "Y" NC1744.2 +108200 PERFORM PASS NC1744.2 +108300 ELSE NC1744.2 +108400 PERFORM FAIL. NC1744.2 +108500 GO TO RELAT-WRITE-GF-16. NC1744.2 +108600 RELAT-DELETE-GF-16. NC1744.2 +108700 PERFORM DE-LETE. NC1744.2 +108800 RELAT-WRITE-GF-16. NC1744.2 +108900 MOVE "RELAT-TEST-GF-16" TO PAR-NAME. NC1744.2 +109000 PERFORM PRINT-DETAIL. NC1744.2 +109100* NC1744.2 +109200* NC1744.2 +109300 RELAT-INIT-GF-17. NC1744.2 +109400 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +109500 MOVE 29 TO N-33. NC1744.2 +109600 RELAT-TEST-GF-17. NC1744.2 +109700 IF 2 <= N-33 NC1744.2 +109800 PERFORM PASS NC1744.2 +109900 ELSE NC1744.2 +110000 PERFORM FAIL. NC1744.2 +110100 GO TO RELAT-WRITE-GF-17. NC1744.2 +110200 RELAT-DELETE-GF-17. NC1744.2 +110300 PERFORM DE-LETE. NC1744.2 +110400 RELAT-WRITE-GF-17. NC1744.2 +110500 MOVE "RELAT-TEST-GF-17" TO PAR-NAME. NC1744.2 +110600 PERFORM PRINT-DETAIL. NC1744.2 +110700* NC1744.2 +110800* NC1744.2 +110900 RELAT-INIT-GF-18. NC1744.2 +111000 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +111100 RELAT-TEST-GF-18. NC1744.2 +111200 IF DATA-4 IS LESS THAN OR EQUAL TO 5 NC1744.2 +111300 PERFORM PASS NC1744.2 +111400 ELSE NC1744.2 +111500 PERFORM FAIL. NC1744.2 +111600 GO TO RELAT-WRITE-GF-18. NC1744.2 +111700 RELAT-DELETE-GF-18. NC1744.2 +111800 PERFORM DE-LETE. NC1744.2 +111900 RELAT-WRITE-GF-18. NC1744.2 +112000 MOVE "RELAT-TEST-GF-18" TO PAR-NAME. NC1744.2 +112100 PERFORM PRINT-DETAIL. NC1744.2 +112200* NC1744.2 +112300* NC1744.2 +112400 RELAT-INIT-GF-19. NC1744.2 +112500 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +112600 MOVE "X" TO A-37. NC1744.2 +112700 RELAT-TEST-GF-19. NC1744.2 +112800 IF "A" LESS OR EQUAL A-37 NC1744.2 +112900 PERFORM PASS NC1744.2 +113000 ELSE NC1744.2 +113100 PERFORM FAIL. NC1744.2 +113200 GO TO RELAT-WRITE-GF-19. NC1744.2 +113300 RELAT-DELETE-GF-19. NC1744.2 +113400 PERFORM DE-LETE. NC1744.2 +113500 RELAT-WRITE-GF-19. NC1744.2 +113600 MOVE "RELAT-TEST-GF-19" TO PAR-NAME. NC1744.2 +113700 PERFORM PRINT-DETAIL. NC1744.2 +113800* NC1744.2 +113900* NC1744.2 +114000 RELAT-INIT-GF-20. NC1744.2 +114100 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +114200 MOVE 29 TO N-33. NC1744.2 +114300 RELAT-TEST-GF-20. NC1744.2 +114400 IF 2 LESS THAN OR EQUAL N-33 NC1744.2 +114500 PERFORM PASS NC1744.2 +114600 ELSE NC1744.2 +114700 PERFORM FAIL. NC1744.2 +114800 GO TO RELAT-WRITE-GF-20. NC1744.2 +114900 RELAT-DELETE-GF-20. NC1744.2 +115000 PERFORM DE-LETE. NC1744.2 +115100 RELAT-WRITE-GF-20. NC1744.2 +115200 MOVE "RELAT-TEST-GF-20" TO PAR-NAME. NC1744.2 +115300 PERFORM PRINT-DETAIL. NC1744.2 +115400* NC1744.2 +115500* NC1744.2 +115600 RELAT-INIT-GF-21. NC1744.2 +115700 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +115800 RELAT-TEST-GF-21. NC1744.2 +115900 IF DATA-99999 LESS THAN OR EQUAL TO +99999 NC1744.2 +116000 PERFORM PASS NC1744.2 +116100 ELSE NC1744.2 +116200 PERFORM FAIL. NC1744.2 +116300 GO TO RELAT-WRITE-GF-21. NC1744.2 +116400 RELAT-DELETE-GF-21. NC1744.2 +116500 PERFORM DE-LETE. NC1744.2 +116600 RELAT-WRITE-GF-21. NC1744.2 +116700 MOVE "RELAT-TEST-GF-21" TO PAR-NAME. NC1744.2 +116800 PERFORM PRINT-DETAIL. NC1744.2 +116900* NC1744.2 +117000* NC1744.2 +117100 RELAT-INIT-GF-22. NC1744.2 +117200 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +117300 MOVE "X" TO A-37. NC1744.2 +117400 RELAT-TEST-GF-22. NC1744.2 +117500 IF "A" IS LESS OR EQUAL A-37 NC1744.2 +117600 PERFORM PASS NC1744.2 +117700 ELSE NC1744.2 +117800 PERFORM FAIL. NC1744.2 +117900 GO TO RELAT-WRITE-GF-22. NC1744.2 +118000 RELAT-DELETE-GF-22. NC1744.2 +118100 PERFORM DE-LETE. NC1744.2 +118200 RELAT-WRITE-GF-22. NC1744.2 +118300 MOVE "RELAT-TEST-GF-22" TO PAR-NAME. NC1744.2 +118400 PERFORM PRINT-DETAIL. NC1744.2 +118500* NC1744.2 +118600* NC1744.2 +118700 RELAT-INIT-GF-23. NC1744.2 +118800 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +118900 MOVE "A" TO A-2. NC1744.2 +119000 MOVE "X" TO A-37. NC1744.2 +119100 RELAT-TEST-GF-23. NC1744.2 +119200 IF A-2 IS LESS THAN OR EQUAL A-37 NC1744.2 +119300 PERFORM PASS NC1744.2 +119400 ELSE NC1744.2 +119500 PERFORM FAIL. NC1744.2 +119600 GO TO RELAT-WRITE-GF-23. NC1744.2 +119700 RELAT-DELETE-GF-23. NC1744.2 +119800 PERFORM DE-LETE. NC1744.2 +119900 RELAT-WRITE-GF-23. NC1744.2 +120000 MOVE "RELAT-TEST-GF-23" TO PAR-NAME. NC1744.2 +120100 PERFORM PRINT-DETAIL. NC1744.2 +120200* NC1744.2 +120300* NC1744.2 +120400 RELAT-INIT-GF-24. NC1744.2 +120500 MOVE "V1-54 6.3.1.1" TO ANSI-REFERENCE. NC1744.2 +120600 RELAT-TEST-GF-24. NC1744.2 +120700 IF DATA-Y IS <= "Z" NC1744.2 +120800 PERFORM PASS NC1744.2 +120900 ELSE NC1744.2 +121000 PERFORM FAIL. NC1744.2 +121100 GO TO RELAT-WRITE-GF-24. NC1744.2 +121200 RELAT-DELETE-GF-24. NC1744.2 +121300 PERFORM DE-LETE. NC1744.2 +121400 RELAT-WRITE-GF-24. NC1744.2 +121500 MOVE "RELAT-TEST-GF-24" TO PAR-NAME. NC1744.2 +121600 PERFORM PRINT-DETAIL. NC1744.2 +121700* NC1744.2 +121800* NC1744.2 +121900 CLASS-INIT-GF-1. NC1744.2 +122000 PERFORM END-ROUTINE. NC1744.2 +122100 MOVE "CLASS ---" TO FEATURE. NC1744.2 +122200 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +122300 PERFORM PRINT-DETAIL. NC1744.2 +122400 MOVE ZERO TO N-31. NC1744.2 +122500 CLASS-TEST-GF-1. NC1744.2 +122600 IF X-32 NUMERIC NC1744.2 +122700 PERFORM PASS NC1744.2 +122800 GO TO CLASS-WRITE-GF-1. NC1744.2 +122900 PERFORM FAIL. NC1744.2 +123000 GO TO CLASS-WRITE-GF-1. NC1744.2 +123100 CLASS-DELETE-GF-1. NC1744.2 +123200 PERFORM DE-LETE. NC1744.2 +123300 CLASS-WRITE-GF-1. NC1744.2 +123400 MOVE " NUMERIC " TO FEATURE. NC1744.2 +123500 MOVE "CLASS-TEST-GF-1" TO PAR-NAME. NC1744.2 +123600 PERFORM PRINT-DETAIL. NC1744.2 +123700 CLASS-INIT-GF-2. NC1744.2 +123800 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +123900 MOVE "X" TO A-37. NC1744.2 +124000 CLASS-TEST-GF-2. NC1744.2 +124100 IF X-38 NOT NUMERIC NC1744.2 +124200 PERFORM PASS NC1744.2 +124300 GO TO CLASS-WRITE-GF-2. NC1744.2 +124400 PERFORM FAIL. NC1744.2 +124500 GO TO CLASS-WRITE-GF-2. NC1744.2 +124600 CLASS-DELETE-GF-2. NC1744.2 +124700 PERFORM DE-LETE. NC1744.2 +124800 CLASS-WRITE-GF-2. NC1744.2 +124900 MOVE " NOT NUMERIC " TO FEATURE. NC1744.2 +125000 MOVE "CLASS-TEST-GF-2" TO PAR-NAME. NC1744.2 +125100 PERFORM PRINT-DETAIL. NC1744.2 +125200 CLASS-INIT-GF-3. NC1744.2 +125300 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +125400 MOVE "X" TO A-37. NC1744.2 +125500 CLASS-TEST-GF-3. NC1744.2 +125600 IF X-38 IS NOT NUMERIC NC1744.2 +125700 PERFORM PASS NC1744.2 +125800 GO TO CLASS-WRITE-GF-3. NC1744.2 +125900 PERFORM FAIL. NC1744.2 +126000 GO TO CLASS-WRITE-GF-3. NC1744.2 +126100 CLASS-DELETE-GF-3. NC1744.2 +126200 PERFORM DE-LETE. NC1744.2 +126300 CLASS-WRITE-GF-3. NC1744.2 +126400 MOVE " NOT NUMERIC " TO FEATURE. NC1744.2 +126500 MOVE "CLASS-TEST-GF-3" TO PAR-NAME. NC1744.2 +126600 PERFORM PRINT-DETAIL. NC1744.2 +126700 CLASS-INIT-GF-4. NC1744.2 +126800 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +126900 MOVE -1 TO DUMMY-DS-00001. NC1744.2 +127000 CLASS-TEST-GF-4. NC1744.2 +127100 IF DUMMY-DS-00001 IS NUMERIC NC1744.2 +127200 PERFORM PASS NC1744.2 +127300 GO TO CLASS-WRITE-GF-4. NC1744.2 +127400 PERFORM FAIL. NC1744.2 +127500 GO TO CLASS-WRITE-GF-4. NC1744.2 +127600 CLASS-DELETE-GF-4. NC1744.2 +127700 PERFORM DE-LETE. NC1744.2 +127800 CLASS-WRITE-GF-4. NC1744.2 +127900 MOVE "CLASS-TEST-GF-4" TO PAR-NAME. NC1744.2 +128000 PERFORM PRINT-DETAIL. NC1744.2 +128100 CLASS-INIT-GF-5. NC1744.2 +128200 MOVE " NUMERIC " TO FEATURE. NC1744.2 +128300 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +128400 MOVE "111111111111111111" TO ONES-XN-00018. NC1744.2 +128500 CLASS-TEST-GF-5. NC1744.2 +128600 IF ONES-XN-00018 IS NUMERIC NC1744.2 +128700 PERFORM PASS NC1744.2 +128800 GO TO CLASS-WRITE-GF-5. NC1744.2 +128900 MOVE ONES-XN-00018 TO COMPUTED-A. NC1744.2 +129000 MOVE "NUMERIC EXPECTED" TO CORRECT-A. NC1744.2 +129100 PERFORM FAIL. NC1744.2 +129200 GO TO CLASS-WRITE-GF-5. NC1744.2 +129300 CLASS-DELETE-GF-5. NC1744.2 +129400 PERFORM DE-LETE. NC1744.2 +129500 CLASS-WRITE-GF-5. NC1744.2 +129600 MOVE "CLASS-TEST-GF-5 " TO PAR-NAME. NC1744.2 +129700 PERFORM PRINT-DETAIL. NC1744.2 +129800 CLASS-INIT-GF-6. NC1744.2 +129900 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +130000 MOVE +022.00 TO A02TWOS-DS-03V02. NC1744.2 +130100 CLASS-TEST-GF-6. NC1744.2 +130200 IF A02TWOS-DS-03V02 IS NUMERIC NC1744.2 +130300 PERFORM PASS NC1744.2 +130400 GO TO CLASS-WRITE-GF-6. NC1744.2 +130500 MOVE A02TWOS-DS-03V02 TO COMPUTED-N. NC1744.2 +130600 MOVE "NUMERIC EXPECTED" TO CORRECT-A. NC1744.2 +130700 PERFORM FAIL. NC1744.2 +130800 GO TO CLASS-WRITE-GF-6. NC1744.2 +130900 CLASS-DELETE-GF-6. NC1744.2 +131000 PERFORM DE-LETE. NC1744.2 +131100 CLASS-WRITE-GF-6. NC1744.2 +131200 MOVE "CLASS-TEST-GF-6 " TO PAR-NAME. NC1744.2 +131300 PERFORM PRINT-DETAIL. NC1744.2 +131400 CLASS-INIT-GF-7. NC1744.2 +131500 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +131600 MOVE "00ABCDEFGHI 4321 " TO XDATA-XN-00018. NC1744.2 +131700 CLASS-TEST-GF-7. NC1744.2 +131800 IF XDATA-XN-00018 IS NUMERIC NC1744.2 +131900 MOVE XDATA-XN-00018 TO COMPUTED-A NC1744.2 +132000 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A NC1744.2 +132100 PERFORM FAIL NC1744.2 +132200 GO TO CLASS-WRITE-GF-7. NC1744.2 +132300 PERFORM PASS. NC1744.2 +132400 GO TO CLASS-WRITE-GF-7. NC1744.2 +132500 CLASS-DELETE-GF-7. NC1744.2 +132600 PERFORM DE-LETE. NC1744.2 +132700 CLASS-WRITE-GF-7. NC1744.2 +132800 MOVE "CLASS-TEST-GF-7 " TO PAR-NAME. NC1744.2 +132900 PERFORM PRINT-DETAIL. NC1744.2 +133000 CLASS-INIT-GF-8. NC1744.2 +133100 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +133200 MOVE "00ABCDEFGHI 4321 " TO XDATA-XN-00018. NC1744.2 +133300 CLASS-TEST-GF-8. NC1744.2 +133400 IF XDATA-DS-18V00-S IS NUMERIC NC1744.2 +133500 MOVE XDATA-DS-18V00-S TO COMPUTED-A NC1744.2 +133600 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A NC1744.2 +133700 PERFORM FAIL NC1744.2 +133800 GO TO CLASS-WRITE-GF-8. NC1744.2 +133900 PERFORM PASS. NC1744.2 +134000 GO TO CLASS-WRITE-GF-8. NC1744.2 +134100 CLASS-DELETE-GF-8. NC1744.2 +134200 PERFORM DE-LETE. NC1744.2 +134300 CLASS-WRITE-GF-8. NC1744.2 +134400 MOVE "CLASS-TEST-GF-8 " TO PAR-NAME. NC1744.2 +134500 PERFORM PRINT-DETAIL. NC1744.2 +134600 CLASS-INIT-GF-9. NC1744.2 +134700 MOVE " NOT NUMERIC " TO FEATURE. NC1744.2 +134800 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +134900 MOVE SPACE TO CORRECT-A. NC1744.2 +135000 CLASS-TEST-GF-9. NC1744.2 +135100 IF CORRECT-A NOT NUMERIC NC1744.2 +135200 PERFORM PASS NC1744.2 +135300 GO TO CLASS-WRITE-GF-9. NC1744.2 +135400 MOVE CORRECT-A TO COMPUTED-A. NC1744.2 +135500 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A. NC1744.2 +135600 PERFORM FAIL. NC1744.2 +135700 GO TO CLASS-WRITE-GF-9. NC1744.2 +135800 CLASS-DELETE-GF-9. NC1744.2 +135900 PERFORM DE-LETE. NC1744.2 +136000 CLASS-WRITE-GF-9. NC1744.2 +136100 MOVE "CLASS-TEST-GF-9 " TO PAR-NAME. NC1744.2 +136200 PERFORM PRINT-DETAIL. NC1744.2 +136300 CLASS-INIT-GF-10. NC1744.2 +136400 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +136500 MOVE "00ABCDEFGHI 4321 " TO XDATA-XN-00018. NC1744.2 +136600 CLASS-TEST-GF-10. NC1744.2 +136700 IF XDATA-DS-18V00-S NOT NUMERIC NC1744.2 +136800 PERFORM PASS NC1744.2 +136900 GO TO CLASS-WRITE-GF-10. NC1744.2 +137000 MOVE XDATA-DS-18V00-S TO COMPUTED-A NC1744.2 +137100 MOVE "NONNUMERIC EXPECTED" TO CORRECT-A. NC1744.2 +137200 PERFORM FAIL. NC1744.2 +137300 GO TO CLASS-WRITE-GF-10. NC1744.2 +137400 CLASS-DELETE-GF-10. NC1744.2 +137500 PERFORM DE-LETE. NC1744.2 +137600 CLASS-WRITE-GF-10. NC1744.2 +137700 MOVE "CLASS-TEST-GF-10" TO PAR-NAME. NC1744.2 +137800 PERFORM PRINT-DETAIL. NC1744.2 +137900 CLASS-INIT-GF-11. NC1744.2 +138000 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +138100 MOVE ZERO TO CORRECT-A. NC1744.2 +138200 CLASS-TEST-GF-11. NC1744.2 +138300 IF CORRECT-A IS NOT NUMERIC NC1744.2 +138400 MOVE CORRECT-A TO COMPUTED-A NC1744.2 +138500 MOVE "NUMERIC EXPECTED" TO CORRECT-A NC1744.2 +138600 PERFORM FAIL NC1744.2 +138700 GO TO CLASS-WRITE-GF-11. NC1744.2 +138800 PERFORM PASS. NC1744.2 +138900 MOVE SPACE TO CORRECT-A. NC1744.2 +139000 GO TO CLASS-WRITE-GF-11. NC1744.2 +139100 CLASS-DELETE-GF-11. NC1744.2 +139200 PERFORM DE-LETE. NC1744.2 +139300 CLASS-WRITE-GF-11. NC1744.2 +139400 MOVE "CLASS-TEST-GF-11" TO PAR-NAME. NC1744.2 +139500 PERFORM PRINT-DETAIL. NC1744.2 +139600 CLASS-INIT-GF-12. NC1744.2 +139700 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +139800 MOVE +990 TO A990-DS-0201P. NC1744.2 +139900 CLASS-TEST-GF-12. NC1744.2 +140000 IF A990-DS-0201P IS NOT NUMERIC NC1744.2 +140100 MOVE A990-DS-0201P TO CORRECT-N NC1744.2 +140200 MOVE "NUMERIC EXPECTED" TO COMPUTED-A NC1744.2 +140300 PERFORM FAIL NC1744.2 +140400 GO TO CLASS-WRITE-GF-12. NC1744.2 +140500 PERFORM PASS. NC1744.2 +140600 GO TO CLASS-WRITE-GF-12. NC1744.2 +140700 CLASS-DELETE-GF-12. NC1744.2 +140800 PERFORM DE-LETE. NC1744.2 +140900 CLASS-WRITE-GF-12. NC1744.2 +141000 MOVE "CLASS-TEST-GF-12" TO PAR-NAME. NC1744.2 +141100 PERFORM PRINT-DETAIL. NC1744.2 +141200 CLASS-INIT-13. NC1744.2 +141300 MOVE " ALPHABETIC " TO FEATURE. NC1744.2 +141400 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +141500 MOVE "ABCDEFGHIJ" TO YADATA-XN-00010. NC1744.2 +141600 CLASS-TEST-GF-13. NC1744.2 +141700 IF YADATA-XN-00010 IS ALPHABETIC NC1744.2 +141800 PERFORM PASS NC1744.2 +141900 GO TO CLASS-WRITE-GF-13. NC1744.2 +142000 MOVE YADATA-XN-00010 TO COMPUTED-A. NC1744.2 +142100 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A. NC1744.2 +142200 PERFORM FAIL. NC1744.2 +142300 GO TO CLASS-WRITE-GF-13. NC1744.2 +142400 CLASS-DELETE-GF-13. NC1744.2 +142500 PERFORM DE-LETE. NC1744.2 +142600 CLASS-WRITE-GF-13. NC1744.2 +142700 MOVE "CLASS-TEST-GF-13" TO PAR-NAME. NC1744.2 +142800 PERFORM PRINT-DETAIL. NC1744.2 +142900 CLASS-INIT-14. NC1744.2 +143000 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +143100 MOVE ZERO TO CORRECT-A. NC1744.2 +143200 CLASS-TEST-GF-14. NC1744.2 +143300 IF CORRECT-A ALPHABETIC NC1744.2 +143400 MOVE CORRECT-A TO COMPUTED-A NC1744.2 +143500 MOVE "NUMERIC EXPECTED" TO CORRECT-A NC1744.2 +143600 PERFORM FAIL NC1744.2 +143700 GO TO CLASS-WRITE-GF-14. NC1744.2 +143800 PERFORM PASS. NC1744.2 +143900 MOVE SPACE TO CORRECT-A NC1744.2 +144000 GO TO CLASS-WRITE-GF-14. NC1744.2 +144100 CLASS-DELETE-GF-14. NC1744.2 +144200 PERFORM DE-LETE. NC1744.2 +144300 CLASS-WRITE-GF-14. NC1744.2 +144400 MOVE "CLASS-TEST-GF-14" TO PAR-NAME. NC1744.2 +144500 PERFORM PRINT-DETAIL. NC1744.2 +144600 CLASS-INIT-GF-15. NC1744.2 +144700 MOVE " NOT ALPHABETIC " TO FEATURE. NC1744.2 +144800 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +144900 MOVE "00ABCDEFGHI 4321 " TO XDATA-XN-00018. NC1744.2 +145000 CLASS-TEST-GF-15. NC1744.2 +145100 IF XDATA-XN-00018 IS NOT ALPHABETIC NC1744.2 +145200 PERFORM PASS NC1744.2 +145300 GO TO CLASS-WRITE-GF-15. NC1744.2 +145400 MOVE XDATA-XN-00018 TO COMPUTED-A. NC1744.2 +145500 MOVE "NUMERIC EXPECTED" TO CORRECT-A. NC1744.2 +145600 PERFORM FAIL. NC1744.2 +145700 GO TO CLASS-WRITE-GF-15. NC1744.2 +145800 CLASS-DELETE-GF-15. NC1744.2 +145900 PERFORM DE-LETE. NC1744.2 +146000 CLASS-WRITE-GF-15. NC1744.2 +146100 MOVE "CLASS-TEST-GF-15" TO PAR-NAME. NC1744.2 +146200 PERFORM PRINT-DETAIL. NC1744.2 +146300 CLASS-INIT-GF-16. NC1744.2 +146400 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +146500 MOVE "ABCDEFGHIJ" TO YADATA-XN-00010. NC1744.2 +146600 CLASS-TEST-GF-16. NC1744.2 +146700 IF YADATA-XN-00010 IS NOT ALPHABETIC NC1744.2 +146800 MOVE YADATA-XN-00010 TO COMPUTED-A NC1744.2 +146900 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A NC1744.2 +147000 PERFORM FAIL NC1744.2 +147100 GO TO CLASS-WRITE-GF-16. NC1744.2 +147200 PERFORM PASS. NC1744.2 +147300 GO TO CLASS-WRITE-GF-16. NC1744.2 +147400 CLASS-DELETE-GF-16. NC1744.2 +147500 PERFORM DE-LETE. NC1744.2 +147600 CLASS-WRITE-GF-16. NC1744.2 +147700 MOVE "CLASS-TEST-GF-16" TO PAR-NAME. NC1744.2 +147800 PERFORM PRINT-DETAIL. NC1744.2 +147900*CLASS-TEST-17. NC1744.2 +148000* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1744.2 +148100* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1744.2 +148200 CLASS-INIT-GF-17. NC1744.2 +148300 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +148400 MOVE 0 TO NUMERIC-1. NC1744.2 +148500 MOVE ZERO TO NUMERIC-3. NC1744.2 +148600 MOVE 1 TO NUMERIC-5. NC1744.2 +148700 MOVE "7" TO NUMERIC-7. NC1744.2 +148800 MOVE 8 TO NUMERIC-8. NC1744.2 +148900 CLASS-TEST-GF-17. NC1744.2 +149000 IF NUMERIC-GRP-TEST NUMERIC NC1744.2 +149100 PERFORM PASS NC1744.2 +149200 GO TO CLASS-WRITE-GF-17. NC1744.2 +149300 MOVE "NUMERIC EXPECTED " TO CORRECT-A. NC1744.2 +149400 MOVE "SEE PROGRAM FOR RESULTS " TO RE-MARK. NC1744.2 +149500 PERFORM FAIL. NC1744.2 +149600 GO TO CLASS-WRITE-GF-17. NC1744.2 +149700 CLASS-DELETE-GF-17. NC1744.2 +149800 PERFORM DE-LETE. NC1744.2 +149900 CLASS-WRITE-GF-17. NC1744.2 +150000 MOVE "CLASS-TEST-GF-17" TO PAR-NAME. NC1744.2 +150100 PERFORM PRINT-DETAIL. NC1744.2 +150200 CLASS-INIT-GF-18. NC1744.2 +150300 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +150400 MOVE ZERO TO NUMERIC-3. NC1744.2 +150500 MOVE 1 TO NUMERIC-5. NC1744.2 +150600 CLASS-TEST-GF-18. NC1744.2 +150700 IF NUMERIC-2 NUMERIC NC1744.2 +150800 PERFORM PASS NC1744.2 +150900 GO TO CLASS-WRITE-GF-18. NC1744.2 +151000 MOVE "NUMERIC EXPECTED " TO CORRECT-A. NC1744.2 +151100 MOVE "SEE PROGRAM FOR RESULTS " TO RE-MARK. NC1744.2 +151200 PERFORM FAIL. NC1744.2 +151300 GO TO CLASS-WRITE-GF-18. NC1744.2 +151400 CLASS-DELETE-GF-18. NC1744.2 +151500 PERFORM DE-LETE. NC1744.2 +151600 CLASS-WRITE-GF-18. NC1744.2 +151700 MOVE "CLASS-TEST-GF-18" TO PAR-NAME. NC1744.2 +151800 PERFORM PRINT-DETAIL. NC1744.2 +151900 CLASS-INIT-GF-19. NC1744.2 +152000 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +152100 MOVE 1 TO NUMERIC-5. NC1744.2 +152200 CLASS-TEST-GF-19. NC1744.2 +152300 IF NUMERIC-4 NUMERIC NC1744.2 +152400 PERFORM PASS NC1744.2 +152500 GO TO CLASS-WRITE-GF-19. NC1744.2 +152600 MOVE "NUMERIC EXPECTED " TO CORRECT-A. NC1744.2 +152700 MOVE "SEE PROGRAM FOR RESULTS " TO RE-MARK. NC1744.2 +152800 PERFORM FAIL. NC1744.2 +152900 GO TO CLASS-WRITE-GF-19. NC1744.2 +153000 CLASS-DELETE-GF-19. NC1744.2 +153100 PERFORM DE-LETE. NC1744.2 +153200 CLASS-WRITE-GF-19. NC1744.2 +153300 MOVE "CLASS-TEST-GF-19" TO PAR-NAME. NC1744.2 +153400 PERFORM PRINT-DETAIL. NC1744.2 +153500 CLASS-INIT-GF-20. NC1744.2 +153600 MOVE "V1-56 6.3.1.2" TO ANSI-REFERENCE. NC1744.2 +153700 MOVE "7" TO NUMERIC-7. NC1744.2 +153800 MOVE 8 TO NUMERIC-8. NC1744.2 +153900 CLASS-TEST-GF-20. NC1744.2 +154000 IF NUMERIC-6 NUMERIC NC1744.2 +154100 PERFORM PASS NC1744.2 +154200 GO TO CLASS-WRITE-GF-20. NC1744.2 +154300 MOVE "NUMERIC EXPECTED " TO CORRECT-A. NC1744.2 +154400 MOVE "SEE PROGRAM FOR RESULTS " TO RE-MARK. NC1744.2 +154500 PERFORM FAIL. NC1744.2 +154600 GO TO CLASS-WRITE-GF-20. NC1744.2 +154700 CLASS-DELETE-GF-20. NC1744.2 +154800 PERFORM DE-LETE. NC1744.2 +154900 CLASS-WRITE-GF-20. NC1744.2 +155000 MOVE "CLASS-TEST-GF-20" TO PAR-NAME. NC1744.2 +155100 PERFORM PRINT-DETAIL. NC1744.2 +155200*CLASS-TEST-22. NC1744.2 +155300* THIS TEST WAS DELETED BY THE FCCTS SINCE IT DID NOT NC1744.2 +155400* APPLY TO THE REVISED FEDERAL STANDARD - FIPS PUB 21-1. NC1744.2 +155500* NC1744.2 +155600* NC1744.2 +155700 CLASS-INIT-35. NC1744.2 +155800 MOVE "V1-56 6.3.1.2(3,4)" TO ANSI-REFERENCE. NC1744.2 +155900 MOVE " ALPHABETIC-UPPER " TO FEATURE. NC1744.2 +156000 MOVE " UPPERCASE CHARS" TO ALPHA-UPPER. NC1744.2 +156100 CLASS-TEST-GF-35. NC1744.2 +156200 IF ALPHA-UPPER ALPHABETIC-UPPER NC1744.2 +156300 PERFORM PASS NC1744.2 +156400 GO TO CLASS-WRITE-GF-35. NC1744.2 +156500 MOVE "SEE PROGRAM FOR RESULTS " TO CORRECT-A. NC1744.2 +156600 MOVE "UPPERCASE CHARS " TO COMPUTED-A. NC1744.2 +156700 MOVE "UPPERCASE CHARS NOT ACCEPTED AS ALPHABETIC-UPPER" NC1744.2 +156800 TO RE-MARK. NC1744.2 +156900 PERFORM FAIL. NC1744.2 +157000 GO TO CLASS-WRITE-GF-35. NC1744.2 +157100 CLASS-DELETE-GF-35. NC1744.2 +157200 PERFORM DE-LETE. NC1744.2 +157300 CLASS-WRITE-GF-35. NC1744.2 +157400 MOVE "CLASS-TEST-GF-35" TO PAR-NAME. NC1744.2 +157500 PERFORM PRINT-DETAIL. NC1744.2 +157600* NC1744.2 +157700* NC1744.2 +157800* NC1744.2 +157900* NC1744.2 +158000 CLASS-INIT-36. NC1744.2 +158100 MOVE " ALPHABETIC-LOWER " TO FEATURE. NC1744.2 +158200 MOVE " lowercase chars" TO ALPHA-LOWER. NC1744.2 +158300 MOVE "V1-56 6.3.1.2(3,4)" TO ANSI-REFERENCE. NC1744.2 +158400 CLASS-TEST-GF-36. NC1744.2 +158500 IF ALPHA-LOWER ALPHABETIC-LOWER NC1744.2 +158600 PERFORM PASS NC1744.2 +158700 GO TO CLASS-WRITE-GF-36. NC1744.2 +158800 MOVE "SEE PROGRAM" TO CORRECT-A. NC1744.2 +158900 MOVE "lowercase chars" TO COMPUTED-A. NC1744.2 +159000 MOVE "LOWERCASE CHARS NOT ACCEPTED AS ALPHABETIC-LOWER" NC1744.2 +159100 TO RE-MARK. NC1744.2 +159200 PERFORM FAIL. NC1744.2 +159300 GO TO CLASS-WRITE-GF-36. NC1744.2 +159400 CLASS-DELETE-GF-36. NC1744.2 +159500 PERFORM DE-LETE. NC1744.2 +159600 CLASS-WRITE-GF-36. NC1744.2 +159700 MOVE "CLASS-TEST-GF-36" TO PAR-NAME. NC1744.2 +159800 PERFORM PRINT-DETAIL. NC1744.2 +159900* NC1744.2 +160000* NC1744.2 +160100 CLASS-INIT-37. NC1744.2 +160200 MOVE "V1-56 6.3.1.2(2)" TO ANSI-REFERENCE. NC1744.2 +160300 MOVE "UPPER & LOWER CASE " TO FEATURE. NC1744.2 +160400 move "AbCdEfGhIj" TO YADATA-XN-00010-U-AND-L. NC1744.2 +160500 CLASS-TEST-GF-37. NC1744.2 +160600 IF YADATA-XN-00010-U-AND-L IS ALPHABETIC NC1744.2 +160700 PERFORM PASS NC1744.2 +160800 GO TO CLASS-WRITE-GF-37. NC1744.2 +160900 MOVE YADATA-XN-00010-U-AND-L TO COMPUTED-A. NC1744.2 +161000 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A. NC1744.2 +161100 MOVE "UPPER & LOWER CASE NOT ACCEPTED AS ALPHABETIC" NC1744.2 +161200 TO RE-MARK. NC1744.2 +161300 PERFORM FAIL. NC1744.2 +161400 GO TO CLASS-WRITE-GF-37. NC1744.2 +161500 CLASS-DELETE-GF-37. NC1744.2 +161600 PERFORM DE-LETE. NC1744.2 +161700 CLASS-WRITE-GF-37. NC1744.2 +161800 MOVE "CLASS-TEST-GF-37" TO PAR-NAME. NC1744.2 +161900 PERFORM PRINT-DETAIL. NC1744.2 +162000* NC1744.2 +162100* NC1744.2 +162200 CLASS-INIT-38. NC1744.2 +162300 MOVE "V1-56 6.3.1.2(2)" TO ANSI-REFERENCE. NC1744.2 +162400 move "AbCdEfGhIj" TO YADATA-XN-00010-U-AND-L. NC1744.2 +162500 CLASS-TEST-GF-38. NC1744.2 +162600 IF YADATA-XN-00010-U-AND-L IS NOT ALPHABETIC NC1744.2 +162700 MOVE YADATA-XN-00010-U-AND-L TO COMPUTED-A NC1744.2 +162800 MOVE "ALPHABETIC EXPECTED" TO CORRECT-A NC1744.2 +162900 MOVE "UPPER & LOWER CASE NOT ACCEPTED AS ALPHABETIC"NC1744.2 +163000 TO RE-MARK NC1744.2 +163100 PERFORM FAIL NC1744.2 +163200 GO TO CLASS-WRITE-GF-38. NC1744.2 +163300 PERFORM PASS. NC1744.2 +163400 GO TO CLASS-WRITE-GF-38. NC1744.2 +163500 CLASS-DELETE-GF-38. NC1744.2 +163600 PERFORM DE-LETE. NC1744.2 +163700 CLASS-WRITE-GF-38. NC1744.2 +163800 MOVE "CLASS-TEST-GF-38" TO PAR-NAME. NC1744.2 +163900 PERFORM PRINT-DETAIL. NC1744.2 +164000* NC1744.2 +164100* NC1744.2 +164200 CLASS-INIT-39. NC1744.2 +164300 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +164400 TO ANSI-REFERENCE. NC1744.2 +164500 MOVE "NEW CLASS TESTS" TO FEATURE. NC1744.2 +164600 MOVE "CLASS-TEST-GF-39" TO PAR-NAME. NC1744.2 +164700 MOVE "A" TO WS-A. NC1744.2 +164800 GO TO CLASS-TEST-GF-39. NC1744.2 +164900 CLASS-DELETE-GF-39. NC1744.2 +165000 PERFORM DE-LETE. NC1744.2 +165100 PERFORM PRINT-DETAIL. NC1744.2 +165200 GO TO CLASS-INIT-40. NC1744.2 +165300 CLASS-TEST-GF-39. NC1744.2 +165400 IF WS-A ORDINAL-A-ONLY NC1744.2 +165500 PERFORM PASS NC1744.2 +165600 PERFORM PRINT-DETAIL NC1744.2 +165700 ELSE NC1744.2 +165800 MOVE "LETTER 'A' SHOULD BE ORDINAL-A-ONLY" NC1744.2 +165900 TO RE-MARK NC1744.2 +166000 PERFORM FAIL NC1744.2 +166100 PERFORM PRINT-DETAIL. NC1744.2 +166200* NC1744.2 +166300* NC1744.2 +166400 CLASS-INIT-40. NC1744.2 +166500 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +166600 TO ANSI-REFERENCE. NC1744.2 +166700 MOVE "CLASS-TEST-GF-40" TO PAR-NAME. NC1744.2 +166800 MOVE "Z" TO WS-A. NC1744.2 +166900 GO TO CLASS-TEST-GF-40. NC1744.2 +167000 CLASS-DELETE-GF-40. NC1744.2 +167100 PERFORM DE-LETE. NC1744.2 +167200 PERFORM PRINT-DETAIL. NC1744.2 +167300 GO TO CLASS-INIT-41. NC1744.2 +167400 CLASS-TEST-GF-40. NC1744.2 +167500 IF WS-A NOT ORDINAL-A-ONLY NC1744.2 +167600 PERFORM PASS NC1744.2 +167700 PERFORM PRINT-DETAIL NC1744.2 +167800 ELSE NC1744.2 +167900 MOVE "LETTER 'Z' SHOULD NOT BE ORDINAL-A-ONLY" NC1744.2 +168000 TO RE-MARK NC1744.2 +168100 PERFORM FAIL NC1744.2 +168200 PERFORM PRINT-DETAIL. NC1744.2 +168300* NC1744.2 +168400* NC1744.2 +168500 CLASS-INIT-41. NC1744.2 +168600 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +168700 TO ANSI-REFERENCE. NC1744.2 +168800 MOVE "CLASS-TEST-GF-41" TO PAR-NAME. NC1744.2 +168900 MOVE "ADCBA" TO WS-B. NC1744.2 +169000 GO TO CLASS-TEST-GF-41. NC1744.2 +169100 CLASS-DELETE-GF-41. NC1744.2 +169200 PERFORM DE-LETE. NC1744.2 +169300 PERFORM PRINT-DETAIL. NC1744.2 +169400 GO TO CLASS-INIT-42. NC1744.2 +169500 CLASS-TEST-GF-41. NC1744.2 +169600 IF WS-B ORDINAL-A-THROUGH-D NC1744.2 +169700 PERFORM PASS NC1744.2 +169800 PERFORM PRINT-DETAIL NC1744.2 +169900 ELSE NC1744.2 +170000 MOVE "'ADCBA' SHOULD BE ORDINAL-A-THROUGH-D" NC1744.2 +170100 TO RE-MARK NC1744.2 +170200 PERFORM FAIL NC1744.2 +170300 PERFORM PRINT-DETAIL. NC1744.2 +170400* NC1744.2 +170500* NC1744.2 +170600 CLASS-INIT-42. NC1744.2 +170700 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +170800 TO ANSI-REFERENCE. NC1744.2 +170900 MOVE "CLASS-TEST-GF-42" TO PAR-NAME. NC1744.2 +171000 MOVE "VWXYZ" TO WS-B. NC1744.2 +171100 GO TO CLASS-TEST-GF-42. NC1744.2 +171200 CLASS-DELETE-GF-42. NC1744.2 +171300 PERFORM DE-LETE. NC1744.2 +171400 PERFORM PRINT-DETAIL. NC1744.2 +171500 GO TO CLASS-INIT-43. NC1744.2 +171600 CLASS-TEST-GF-42. NC1744.2 +171700 IF WS-B NOT ORDINAL-A-THROUGH-D NC1744.2 +171800 PERFORM PASS NC1744.2 +171900 PERFORM PRINT-DETAIL NC1744.2 +172000 ELSE NC1744.2 +172100 MOVE "'VWXYZ' SHOULD NOT BE ORDINAL-A-THROUGH-D" NC1744.2 +172200 TO RE-MARK NC1744.2 +172300 PERFORM FAIL NC1744.2 +172400 PERFORM PRINT-DETAIL. NC1744.2 +172500* NC1744.2 +172600* NC1744.2 +172700 CLASS-INIT-43. NC1744.2 +172800 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +172900 TO ANSI-REFERENCE. NC1744.2 +173000 MOVE "CLASS-TEST-GF-43" TO PAR-NAME. NC1744.2 +173100 MOVE "ADCBA" TO WS-B. NC1744.2 +173200 GO TO CLASS-TEST-GF-43. NC1744.2 +173300 CLASS-DELETE-GF-43. NC1744.2 +173400 PERFORM DE-LETE. NC1744.2 +173500 PERFORM PRINT-DETAIL. NC1744.2 +173600 GO TO CLASS-INIT-44. NC1744.2 +173700 CLASS-TEST-GF-43. NC1744.2 +173800 IF WS-B ORDINAL-D-THRU-A NC1744.2 +173900 PERFORM PASS NC1744.2 +174000 PERFORM PRINT-DETAIL NC1744.2 +174100 ELSE NC1744.2 +174200 MOVE "'ADCBA' SHOULD BE ORDINAL-D-THRU-A" NC1744.2 +174300 TO RE-MARK NC1744.2 +174400 PERFORM FAIL NC1744.2 +174500 PERFORM PRINT-DETAIL. NC1744.2 +174600* NC1744.2 +174700* NC1744.2 +174800 CLASS-INIT-44. NC1744.2 +174900 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +175000 TO ANSI-REFERENCE. NC1744.2 +175100 MOVE "CLASS-TEST-GF-44" TO PAR-NAME. NC1744.2 +175200 MOVE "VWXYZ" TO WS-B. NC1744.2 +175300 GO TO CLASS-TEST-GF-44. NC1744.2 +175400 CLASS-DELETE-GF-44. NC1744.2 +175500 PERFORM DE-LETE. NC1744.2 +175600 PERFORM PRINT-DETAIL. NC1744.2 +175700 GO TO CLASS-INIT-45. NC1744.2 +175800 CLASS-TEST-GF-44. NC1744.2 +175900 IF WS-B NOT ORDINAL-D-THRU-A NC1744.2 +176000 PERFORM PASS NC1744.2 +176100 PERFORM PRINT-DETAIL NC1744.2 +176200 ELSE NC1744.2 +176300 MOVE "'VWXYZ' SHOULD NOT BE ORDINAL-D-THRU-A" NC1744.2 +176400 TO RE-MARK NC1744.2 +176500 PERFORM FAIL NC1744.2 +176600 PERFORM PRINT-DETAIL. NC1744.2 +176700* NC1744.2 +176800* NC1744.2 +176900 CLASS-INIT-45. NC1744.2 +177000 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +177100 TO ANSI-REFERENCE. NC1744.2 +177200 MOVE "CLASS-TEST-GF-45" TO PAR-NAME. NC1744.2 +177300 MOVE "A" TO WS-A. NC1744.2 +177400 GO TO CLASS-TEST-GF-45. NC1744.2 +177500 CLASS-DELETE-GF-45. NC1744.2 +177600 PERFORM DE-LETE. NC1744.2 +177700 PERFORM PRINT-DETAIL. NC1744.2 +177800 GO TO CLASS-INIT-46. NC1744.2 +177900 CLASS-TEST-GF-45. NC1744.2 +178000 IF WS-A ACTUAL-A-ONLY NC1744.2 +178100 PERFORM PASS NC1744.2 +178200 PERFORM PRINT-DETAIL NC1744.2 +178300 ELSE NC1744.2 +178400 MOVE "'A' SHOULD BE ACTUAL-A-ONLY" NC1744.2 +178500 TO RE-MARK NC1744.2 +178600 PERFORM FAIL NC1744.2 +178700 PERFORM PRINT-DETAIL. NC1744.2 +178800* NC1744.2 +178900* NC1744.2 +179000 CLASS-INIT-46. NC1744.2 +179100 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +179200 TO ANSI-REFERENCE. NC1744.2 +179300 MOVE "CLASS-TEST-GF-46" TO PAR-NAME. NC1744.2 +179400 GO TO CLASS-TEST-GF-46. NC1744.2 +179500 CLASS-DELETE-GF-46. NC1744.2 +179600 PERFORM DE-LETE. NC1744.2 +179700 PERFORM PRINT-DETAIL. NC1744.2 +179800 GO TO CLASS-INIT-47. NC1744.2 +179900 CLASS-TEST-GF-46. NC1744.2 +180000 IF DATA-Z NOT ACTUAL-A-ONLY NC1744.2 +180100 PERFORM PASS NC1744.2 +180200 PERFORM PRINT-DETAIL NC1744.2 +180300 ELSE NC1744.2 +180400 MOVE "'Z' SHOULD NOT BE ACTUAL-A-ONLY" NC1744.2 +180500 TO RE-MARK NC1744.2 +180600 PERFORM FAIL NC1744.2 +180700 PERFORM PRINT-DETAIL. NC1744.2 +180800* NC1744.2 +180900* NC1744.2 +181000 CLASS-INIT-47. NC1744.2 +181100 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +181200 TO ANSI-REFERENCE. NC1744.2 +181300 MOVE "CLASS-TEST-GF-47" TO PAR-NAME. NC1744.2 +181400 MOVE "ADCBA" TO WS-B. NC1744.2 +181500 GO TO CLASS-TEST-GF-47. NC1744.2 +181600 CLASS-DELETE-GF-47. NC1744.2 +181700 PERFORM DE-LETE. NC1744.2 +181800 PERFORM PRINT-DETAIL. NC1744.2 +181900 GO TO CLASS-INIT-48. NC1744.2 +182000 CLASS-TEST-GF-47. NC1744.2 +182100 IF WS-B ACTUAL-A-THRU-D NC1744.2 +182200 PERFORM PASS NC1744.2 +182300 PERFORM PRINT-DETAIL NC1744.2 +182400 ELSE NC1744.2 +182500 MOVE "'ADCBA' SHOULD BE ACTUAL-A-THRU-D" NC1744.2 +182600 TO RE-MARK NC1744.2 +182700 PERFORM FAIL NC1744.2 +182800 PERFORM PRINT-DETAIL. NC1744.2 +182900* NC1744.2 +183000* NC1744.2 +183100 CLASS-INIT-48. NC1744.2 +183200 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +183300 TO ANSI-REFERENCE. NC1744.2 +183400 MOVE "CLASS-TEST-GF-48" TO PAR-NAME. NC1744.2 +183500 GO TO CLASS-TEST-GF-48. NC1744.2 +183600 CLASS-DELETE-GF-48. NC1744.2 +183700 PERFORM DE-LETE. NC1744.2 +183800 PERFORM PRINT-DETAIL. NC1744.2 +183900 GO TO CLASS-INIT-49. NC1744.2 +184000 CLASS-TEST-GF-48. NC1744.2 +184100 IF DATA-VWXYZ NOT ACTUAL-A-THRU-D NC1744.2 +184200 PERFORM PASS NC1744.2 +184300 PERFORM PRINT-DETAIL NC1744.2 +184400 ELSE NC1744.2 +184500 MOVE "'VWXYZ' SHOULD NOT BE ACTUAL-A-THRU-D" NC1744.2 +184600 TO RE-MARK NC1744.2 +184700 PERFORM FAIL NC1744.2 +184800 PERFORM PRINT-DETAIL. NC1744.2 +184900* NC1744.2 +185000* NC1744.2 +185100 CLASS-INIT-49. NC1744.2 +185200 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +185300 TO ANSI-REFERENCE. NC1744.2 +185400 MOVE "CLASS-TEST-GF-49" TO PAR-NAME. NC1744.2 +185500 GO TO CLASS-TEST-GF-49. NC1744.2 +185600 CLASS-DELETE-GF-49. NC1744.2 +185700 PERFORM DE-LETE. NC1744.2 +185800 PERFORM PRINT-DETAIL. NC1744.2 +185900 GO TO CLASS-INIT-50. NC1744.2 +186000 CLASS-TEST-GF-49. NC1744.2 +186100 IF DATA-ADCBA ACTUAL-D-THROUGH-A NC1744.2 +186200 PERFORM PASS NC1744.2 +186300 PERFORM PRINT-DETAIL NC1744.2 +186400 ELSE NC1744.2 +186500 MOVE "'ADCBA' SHOULD BE ACTUAL-D-THROUGH-A" NC1744.2 +186600 TO RE-MARK NC1744.2 +186700 PERFORM FAIL NC1744.2 +186800 PERFORM PRINT-DETAIL. NC1744.2 +186900* NC1744.2 +187000* NC1744.2 +187100 CLASS-INIT-50. NC1744.2 +187200 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +187300 TO ANSI-REFERENCE. NC1744.2 +187400 MOVE "CLASS-TEST-GF-50" TO PAR-NAME. NC1744.2 +187500 MOVE "VWXYZ" TO WS-B. NC1744.2 +187600 GO TO CLASS-TEST-GF-50. NC1744.2 +187700 CLASS-DELETE-GF-50. NC1744.2 +187800 PERFORM DE-LETE. NC1744.2 +187900 PERFORM PRINT-DETAIL. NC1744.2 +188000 GO TO CLASS-INIT-51. NC1744.2 +188100 CLASS-TEST-GF-50. NC1744.2 +188200 IF WS-B NOT ACTUAL-D-THROUGH-A NC1744.2 +188300 PERFORM PASS NC1744.2 +188400 PERFORM PRINT-DETAIL NC1744.2 +188500 ELSE NC1744.2 +188600 MOVE "'VWXYZ' SHOULD NOT BE ACTUAL-D-THROUGH-A" NC1744.2 +188700 TO RE-MARK NC1744.2 +188800 PERFORM FAIL NC1744.2 +188900 PERFORM PRINT-DETAIL. NC1744.2 +189000* NC1744.2 +189100* NC1744.2 +189200 CLASS-INIT-51. NC1744.2 +189300 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +189400 TO ANSI-REFERENCE. NC1744.2 +189500 MOVE "CLASS-TEST-GF-51" TO PAR-NAME. NC1744.2 +189600 MOVE "ADCBA" TO WS-B. NC1744.2 +189700 GO TO CLASS-TEST-GF-51. NC1744.2 +189800 CLASS-DELETE-GF-51. NC1744.2 +189900 PERFORM DE-LETE. NC1744.2 +190000 PERFORM PRINT-DETAIL. NC1744.2 +190100 GO TO CLASS-INIT-52. NC1744.2 +190200 CLASS-TEST-GF-51. NC1744.2 +190300 IF WS-B ACTUAL-ABCD NC1744.2 +190400 PERFORM PASS NC1744.2 +190500 PERFORM PRINT-DETAIL NC1744.2 +190600 ELSE NC1744.2 +190700 MOVE "'ADCBA' SHOULD BE ACTUAL-ABCD" NC1744.2 +190800 TO RE-MARK NC1744.2 +190900 PERFORM FAIL NC1744.2 +191000 PERFORM PRINT-DETAIL. NC1744.2 +191100* NC1744.2 +191200* NC1744.2 +191300 CLASS-INIT-52. NC1744.2 +191400 MOVE "V1-17 4.5.4 (GR10) & VI-57 6.3.1.2" NC1744.2 +191500 TO ANSI-REFERENCE. NC1744.2 +191600 MOVE "CLASS-TEST-GF-52" TO PAR-NAME. NC1744.2 +191700 GO TO CLASS-TEST-GF-52. NC1744.2 +191800 CLASS-DELETE-GF-52. NC1744.2 +191900 PERFORM DE-LETE. NC1744.2 +192000 PERFORM PRINT-DETAIL. NC1744.2 +192100 GO TO CCVS-EXIT. NC1744.2 +192200 CLASS-TEST-GF-52. NC1744.2 +192300 IF DATA-VWXYZ NOT ACTUAL-ABCD NC1744.2 +192400 PERFORM PASS NC1744.2 +192500 PERFORM PRINT-DETAIL NC1744.2 +192600 ELSE NC1744.2 +192700 MOVE "'VWXYZ' SHOULD NOT BE ACTUAL-ABCD" NC1744.2 +192800 TO RE-MARK NC1744.2 +192900 PERFORM FAIL NC1744.2 +193000 PERFORM PRINT-DETAIL. NC1744.2 +193100* NC1744.2 +193200* NC1744.2 +193300 CCVS-EXIT SECTION. NC1744.2 +193400 CCVS-999999. NC1744.2 +193500 GO TO CLOSE-FILES. NC1744.2 diff --git a/tests/cobol85/NC/NC175A.CBL b/tests/cobol85/NC/NC175A.CBL new file mode 100755 index 00000000..b082a8fc --- /dev/null +++ b/tests/cobol85/NC/NC175A.CBL @@ -0,0 +1,2079 @@ +000100 IDENTIFICATION DIVISION. NC1754.2 +000200 PROGRAM-ID. NC1754.2 +000300 NC175A. NC1754.2 +000400**************************************************************** NC1754.2 +000500* * NC1754.2 +000600* VALIDATION FOR:- * NC1754.2 +000700* * NC1754.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1754.2 +000900* * NC1754.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1754.2 +001100* * NC1754.2 +001200**************************************************************** NC1754.2 +001300* * NC1754.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1754.2 +001500* * NC1754.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1754.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1754.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1754.2 +001900* * NC1754.2 +002000**************************************************************** NC1754.2 +002100* NC1754.2 +002200* PROGRAM NC175A TESTS FORMAT 2 OF THE SUBTRACT NC1754.2 +002300* STATEMENT. VARIOUS COMBINATINS OF DATA-ITEMS AND ALL NC1754.2 +002400* OPTIONAL PHRASES ARE TESTED. NC1754.2 +002500* NC1754.2 +002600 NC1754.2 +002700 ENVIRONMENT DIVISION. NC1754.2 +002800 CONFIGURATION SECTION. NC1754.2 +002900 SOURCE-COMPUTER. NC1754.2 +003000 Linux. NC1754.2 +003100 OBJECT-COMPUTER. NC1754.2 +003200 Linux. NC1754.2 +003300 INPUT-OUTPUT SECTION. NC1754.2 +003400 FILE-CONTROL. NC1754.2 +003500 SELECT PRINT-FILE ASSIGN TO NC1754.2 +003600 "report.log". NC1754.2 +003700 DATA DIVISION. NC1754.2 +003800 FILE SECTION. NC1754.2 +003900 FD PRINT-FILE. NC1754.2 +004000 01 PRINT-REC PICTURE X(120). NC1754.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC1754.2 +004200 WORKING-STORAGE SECTION. NC1754.2 +004300 01 WRK-XN-00001 PIC X. NC1754.2 +004400 01 WRK-DU-0V1-1 PIC V9. NC1754.2 +004500 01 WRK-DU-2V0-1 PIC 99. NC1754.2 +004600 01 WRK-DU-2V0-2 PIC 99. NC1754.2 +004700 01 WRK-DU-2V0-3 PIC 99. NC1754.2 +004800 01 WRK-DU-2V1-1 PIC 99V9. NC1754.2 +004900 01 WRK-DU-2V1-2 PIC 99V9. NC1754.2 +005000 01 WRK-DU-2V1-3 PIC 99V9. NC1754.2 +005100 01 WRK-DU-2V2-1 PIC 99V99 VALUE 15.44. NC1754.2 +005200 01 WRK-DU-2V2-2 PIC 99V99 VALUE 60.89. NC1754.2 +005300 01 WRK-DU-2V2-3 PIC 99V99 VALUE 60.99. NC1754.2 +005400 01 WRK-DU-2V2-4 PIC 99V99 VALUE 60.99. NC1754.2 +005500 01 WRK-DU-2V2-5 PIC 99V99 VALUE 10.00. NC1754.2 +005600 01 WRK-DU-2V5-1 PIC 99V9(5). NC1754.2 +005700 01 WRK-DU-4P1-1 PIC P(4)9 VALUE .00001. NC1754.2 +005800 01 WRK-DU-5V1-1 PIC 9(5)V9 VALUE 12345.6. NC1754.2 +005900 01 WRK-DU-6V0-1 PIC 9(6) VALUE 99999. NC1754.2 +006000 01 WRK-DU-6V0-2 PIC 9(6) VALUE 99999. NC1754.2 +006100 01 WRK-DU-16V2-1 PIC 9(16)V99 VALUE 9999999999999999.99. NC1754.2 +006200 01 WRK-NE-X-1 PIC 9(16).99. NC1754.2 +006300 01 WRK-DS-1V0-1 PIC S9 VALUE -3. NC1754.2 +006400 01 WRK-DS-1V0-2 PIC S9 VALUE 2. NC1754.2 +006500 01 WRK-DS-1V2-1 PIC S9V99 VALUE ZERO. NC1754.2 +006600 01 WRK-DS-2V0-1 PIC S99 VALUE ZERO. NC1754.2 +006700 01 WRK-DS-2V1-1 PIC S99V9 VALUE ZERO. NC1754.2 +006800 01 WRK-DS-2V2-1 PIC S99V99 VALUE ZERO. NC1754.2 +006900 01 WRK-DS-2V2-2 PIC S99V99 VALUE -12.34. NC1754.2 +007000 01 WRK-DS-16V2-1 PIC S9(16)V99 VALUE -9999999999999999.99. NC1754.2 +007100 01 WRK-NE-X-2 PIC -9(16).99. NC1754.2 +007200 01 WRK-NE-1 PIC .9999/99999,99999,99. NC1754.2 +007300 01 WRK-NE-2 PIC $**.99. NC1754.2 +007400 01 WRK-NE-3 PIC $99.99CR. NC1754.2 +007500 01 WRK-NE-4 PIC $*9.99 VALUE ZERO. NC1754.2 +007600 01 WRK-NE-5 PIC $.** VALUE ZERO. NC1754.2 +007700 01 WRK-NE-6 PIC $**.**CR VALUE ZERO. NC1754.2 +007800 01 WRK-NE-7 PIC $*9.99DB VALUE ZERO. NC1754.2 +007900 77 SIZE-ERR PICTURE X VALUE SPACE. NC1754.2 +008000 77 SIZE-ERR2 PICTURE X VALUE SPACE. NC1754.2 +008100 77 SIZE-ERR3 PICTURE X VALUE SPACE. NC1754.2 +008200 77 SIZE-ERR4 PICTURE X VALUE SPACE. NC1754.2 +008300 77 A16TWOS-DS-16V00 PICTURE S9(16) NC1754.2 +008400 VALUE 2222222222222222. NC1754.2 +008500 77 A18ONES-DS-18V00 PICTURE S9(18) NC1754.2 +008600 VALUE 111111111111111111. NC1754.2 +008700 77 WRK-DS-10V00 PICTURE S9(10). NC1754.2 +008800 77 A10ONES-DS-10V00 PICTURE S9(10) NC1754.2 +008900 VALUE 1111111111. NC1754.2 +009000 77 A05ONES-DS-05V00 PICTURE S9(5) NC1754.2 +009100 VALUE 11111. NC1754.2 +009200 77 A02ONES-DS-02V00 PICTURE S99 NC1754.2 +009300 VALUE 11. NC1754.2 +009400 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1754.2 +009500 77 WRK-DS-18V00 REDEFINES WRK-DS-09V09 NC1754.2 +009600 PICTURE S9(18). NC1754.2 +009700 77 A06THREES-DS-03V03 PICTURE S999V999 NC1754.2 +009800 VALUE 333.333. NC1754.2 +009900 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1754.2 +010000 VALUE 333333.333333. NC1754.2 +010100 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1754.2 +010200 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC1754.2 +010300 PICTURE S9(12). NC1754.2 +010400 77 A05ONES-DS-00V05 PICTURE SV9(5) NC1754.2 +010500 VALUE .11111. NC1754.2 +010600 77 WRK-DS-05V00 PICTURE S9(5). NC1754.2 +010700 77 WRK-DS-02V00 PICTURE S99. NC1754.2 +010800 77 A12ONES-DS-12V00 PICTURE S9(12) NC1754.2 +010900 VALUE 111111111111. NC1754.2 +011000 77 WRK-DS-03V10 PICTURE S999V9(10). NC1754.2 +011100 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1754.2 +011200 PICTURE S9(13). NC1754.2 +011300 77 A99-DS-02V00 PICTURE S99 NC1754.2 +011400 VALUE 99. NC1754.2 +011500 77 A03ONES-DS-02V01 PICTURE S99V9 NC1754.2 +011600 VALUE 11.1. NC1754.2 +011700 77 A06ONES-DS-03V03 PICTURE S999V999 NC1754.2 +011800 VALUE 111.111. NC1754.2 +011900 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1754.2 +012000 VALUE 22.222222. NC1754.2 +012100 77 A01ONE-DS-P0801 PICTURE SP(8)9 NC1754.2 +012200 VALUE .000000001. NC1754.2 +012300 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1754.2 +012400 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1754.2 +012500 VALUE 111111111111111111. NC1754.2 +012600 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1754.2 +012700 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1754.2 +012800 VALUE 99. NC1754.2 +012900 77 WRK-DS-0201P PICTURE S99P. NC1754.2 +013000 77 WRK-DS-06V00 PICTURE S9(6). NC1754.2 +013100 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) NC1754.2 +013200 VALUE ZERO. NC1754.2 +013300 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1754.2 +013400 VALUE +012345678.876543210. NC1754.2 +013500 77 XDATA-XN-00018 PICTURE X(18) NC1754.2 +013600 VALUE "00ABCDEFGHI 4321 ". NC1754.2 +013700 77 WRK-XN-00018 PICTURE X(18). NC1754.2 +013800 77 ADD-12 PICTURE PP9 VALUE .001. NC1754.2 +013900 77 ADD-13 PICTURE 9PP VALUE 100. NC1754.2 +014000 77 ADD-14 PICTURE 999V999. NC1754.2 +014100 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1754.2 +014200 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1754.2 +014300 COMPUTATIONAL. NC1754.2 +014400 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1754.2 +014500 COMPUTATIONAL. NC1754.2 +014600 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1754.2 +014700 COMPUTATIONAL. NC1754.2 +014800 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1754.2 +014900 COMPUTATIONAL. NC1754.2 +015000 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1754.2 +015100 COMPUTATIONAL. NC1754.2 +015200 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1754.2 +015300 COMPUTATIONAL. NC1754.2 +015400 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1754.2 +015500 COMPUTATIONAL. NC1754.2 +015600 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1754.2 +015700 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1754.2 +015800 COMPUTATIONAL. NC1754.2 +015900 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1754.2 +016000 01 SUBTRACT-DATA. NC1754.2 +016100 02 SUBTR-1 PICTURE 9 VALUE 1. NC1754.2 +016200 02 SUBTR-2 PICTURE S99 VALUE 99. NC1754.2 +016300 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1754.2 +016400 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1754.2 +016500 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1754.2 +016600 02 SUBTR-6 PICTURE 9 VALUE 1. NC1754.2 +016700 02 SUBTR-7 PICTURE S99 VALUE 99. NC1754.2 +016800 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1754.2 +016900 02 SUBTR-10 PICTURE S999 VALUE 100. NC1754.2 +017000 02 SUBTR-11 PICTURE S999V999. NC1754.2 +017100 01 N-3 PICTURE IS 99999. NC1754.2 +017200 01 N-4 PICTURE IS 9(5) NC1754.2 +017300 VALUE IS 52800. NC1754.2 +017400 01 N-5 PICTURE IS S9(9)V99 NC1754.2 +017500 VALUE IS 000000001.00. NC1754.2 +017600 01 N-7 PICTURE IS S9(7)V9(4) NC1754.2 +017700 VALUE IS 0000001.0000. NC1754.2 +017800 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1754.2 +017900 01 N-10 PICTURE IS S99999V NC1754.2 +018000 VALUE IS -00001. NC1754.2 +018100 01 N-11 PICTURE IS 9 VALUE IS 9. NC1754.2 +018200 01 N-12 PICTURE IS 9 VALUE IS 9. NC1754.2 +018300 01 N-13 PICTURE IS 9(5) NC1754.2 +018400 VALUE IS 99999. NC1754.2 +018500 01 N-14 PICTURE IS 9 VALUE IS 1. NC1754.2 +018600 01 N-15 PICTURE IS 9(16). NC1754.2 +018700 01 N-16 PICTURE IS S999999V99 NC1754.2 +018800 VALUE IS 5.90. NC1754.2 +018900 01 N-17 PICTURE IS S9(3)V99 NC1754.2 +019000 VALUE IS +3.6. NC1754.2 +019100 01 N-18 PICTURE IS S9(10) NC1754.2 +019200 VALUE IS -5. NC1754.2 +019300 01 N-19 PICTURE IS $9.00. NC1754.2 +019400 01 N-20 PICTURE IS S9(9) NC1754.2 +019500 VALUE IS -999999999. NC1754.2 +019600 01 N-21 PICTURE IS 9 VALUE IS 5. NC1754.2 +019700 01 N-22 PICTURE IS 999V99 NC1754.2 +019800 VALUE IS 005.55. NC1754.2 +019900 01 N-23 PICTURE IS $$$.99CR. NC1754.2 +020000 01 N-25 PICTURE IS 9 VALUE IS 1. NC1754.2 +020100 01 N-26 PICTURE 9(5). NC1754.2 +020200 01 N-27 PICTURE IS 9999V9 NC1754.2 +020300 VALUE IS 9999.9. NC1754.2 +020400 01 N-28 PICTURE IS $9999.00. NC1754.2 +020500 01 N-40 PICTURE IS 9(7) NC1754.2 +020600 VALUE IS 7777777. NC1754.2 +020700 01 N-41 PICTURE IS 9(7) NC1754.2 +020800 VALUE IS 1111111. NC1754.2 +020900 01 N-42 PICTURE IS 9(3)P(4). NC1754.2 +021000 01 TRUNC-DATA. NC1754.2 +021100 02 N-43 PICTURE S9V9 VALUE +1.6. NC1754.2 +021200 02 N-44 PICTURE S9V9 VALUE -1.6. NC1754.2 +021300 02 N-45 PICTURE S9. NC1754.2 +021400 01 MINUS-NAMES. NC1754.2 +021500 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1754.2 +021600 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1754.2 +021700 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1754.2 +021800 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1754.2 +021900 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1754.2 +022000 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1754.2 +022100 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1754.2 +022200 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1754.2 +022300 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1754.2 +022400 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1754.2 +022500 02 WHOLE-FIELD PICTURE S9(18). NC1754.2 +022600 02 DECMAL-FIELD PICTURE SV9(18). NC1754.2 +022700 01 TEST-RESULTS. NC1754.2 +022800 02 FILLER PIC X VALUE SPACE. NC1754.2 +022900 02 FEATURE PIC X(20) VALUE SPACE. NC1754.2 +023000 02 FILLER PIC X VALUE SPACE. NC1754.2 +023100 02 P-OR-F PIC X(5) VALUE SPACE. NC1754.2 +023200 02 FILLER PIC X VALUE SPACE. NC1754.2 +023300 02 PAR-NAME. NC1754.2 +023400 03 FILLER PIC X(19) VALUE SPACE. NC1754.2 +023500 03 PARDOT-X PIC X VALUE SPACE. NC1754.2 +023600 03 DOTVALUE PIC 99 VALUE ZERO. NC1754.2 +023700 02 FILLER PIC X(8) VALUE SPACE. NC1754.2 +023800 02 RE-MARK PIC X(61). NC1754.2 +023900 01 TEST-COMPUTED. NC1754.2 +024000 02 FILLER PIC X(30) VALUE SPACE. NC1754.2 +024100 02 FILLER PIC X(17) VALUE NC1754.2 +024200 " COMPUTED=". NC1754.2 +024300 02 COMPUTED-X. NC1754.2 +024400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1754.2 +024500 03 COMPUTED-N REDEFINES COMPUTED-A NC1754.2 +024600 PIC -9(9).9(9). NC1754.2 +024700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1754.2 +024800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1754.2 +024900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1754.2 +025000 03 CM-18V0 REDEFINES COMPUTED-A. NC1754.2 +025100 04 COMPUTED-18V0 PIC -9(18). NC1754.2 +025200 04 FILLER PIC X. NC1754.2 +025300 03 FILLER PIC X(50) VALUE SPACE. NC1754.2 +025400 01 TEST-CORRECT. NC1754.2 +025500 02 FILLER PIC X(30) VALUE SPACE. NC1754.2 +025600 02 FILLER PIC X(17) VALUE " CORRECT =". NC1754.2 +025700 02 CORRECT-X. NC1754.2 +025800 03 CORRECT-A PIC X(20) VALUE SPACE. NC1754.2 +025900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1754.2 +026000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1754.2 +026100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1754.2 +026200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1754.2 +026300 03 CR-18V0 REDEFINES CORRECT-A. NC1754.2 +026400 04 CORRECT-18V0 PIC -9(18). NC1754.2 +026500 04 FILLER PIC X. NC1754.2 +026600 03 FILLER PIC X(2) VALUE SPACE. NC1754.2 +026700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1754.2 +026800 01 CCVS-C-1. NC1754.2 +026900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1754.2 +027000- "SS PARAGRAPH-NAME NC1754.2 +027100- " REMARKS". NC1754.2 +027200 02 FILLER PIC X(20) VALUE SPACE. NC1754.2 +027300 01 CCVS-C-2. NC1754.2 +027400 02 FILLER PIC X VALUE SPACE. NC1754.2 +027500 02 FILLER PIC X(6) VALUE "TESTED". NC1754.2 +027600 02 FILLER PIC X(15) VALUE SPACE. NC1754.2 +027700 02 FILLER PIC X(4) VALUE "FAIL". NC1754.2 +027800 02 FILLER PIC X(94) VALUE SPACE. NC1754.2 +027900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1754.2 +028000 01 REC-CT PIC 99 VALUE ZERO. NC1754.2 +028100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1754.2 +028200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1754.2 +028300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1754.2 +028400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1754.2 +028500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1754.2 +028600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1754.2 +028700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1754.2 +028800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1754.2 +028900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1754.2 +029000 01 CCVS-H-1. NC1754.2 +029100 02 FILLER PIC X(39) VALUE SPACES. NC1754.2 +029200 02 FILLER PIC X(42) VALUE NC1754.2 +029300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1754.2 +029400 02 FILLER PIC X(39) VALUE SPACES. NC1754.2 +029500 01 CCVS-H-2A. NC1754.2 +029600 02 FILLER PIC X(40) VALUE SPACE. NC1754.2 +029700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1754.2 +029800 02 FILLER PIC XXXX VALUE NC1754.2 +029900 "4.2 ". NC1754.2 +030000 02 FILLER PIC X(28) VALUE NC1754.2 +030100 " COPY - NOT FOR DISTRIBUTION". NC1754.2 +030200 02 FILLER PIC X(41) VALUE SPACE. NC1754.2 +030300 NC1754.2 +030400 01 CCVS-H-2B. NC1754.2 +030500 02 FILLER PIC X(15) VALUE NC1754.2 +030600 "TEST RESULT OF ". NC1754.2 +030700 02 TEST-ID PIC X(9). NC1754.2 +030800 02 FILLER PIC X(4) VALUE NC1754.2 +030900 " IN ". NC1754.2 +031000 02 FILLER PIC X(12) VALUE NC1754.2 +031100 " HIGH ". NC1754.2 +031200 02 FILLER PIC X(22) VALUE NC1754.2 +031300 " LEVEL VALIDATION FOR ". NC1754.2 +031400 02 FILLER PIC X(58) VALUE NC1754.2 +031500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1754.2 +031600 01 CCVS-H-3. NC1754.2 +031700 02 FILLER PIC X(34) VALUE NC1754.2 +031800 " FOR OFFICIAL USE ONLY ". NC1754.2 +031900 02 FILLER PIC X(58) VALUE NC1754.2 +032000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1754.2 +032100 02 FILLER PIC X(28) VALUE NC1754.2 +032200 " COPYRIGHT 1985 ". NC1754.2 +032300 01 CCVS-E-1. NC1754.2 +032400 02 FILLER PIC X(52) VALUE SPACE. NC1754.2 +032500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1754.2 +032600 02 ID-AGAIN PIC X(9). NC1754.2 +032700 02 FILLER PIC X(45) VALUE SPACES. NC1754.2 +032800 01 CCVS-E-2. NC1754.2 +032900 02 FILLER PIC X(31) VALUE SPACE. NC1754.2 +033000 02 FILLER PIC X(21) VALUE SPACE. NC1754.2 +033100 02 CCVS-E-2-2. NC1754.2 +033200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1754.2 +033300 03 FILLER PIC X VALUE SPACE. NC1754.2 +033400 03 ENDER-DESC PIC X(44) VALUE NC1754.2 +033500 "ERRORS ENCOUNTERED". NC1754.2 +033600 01 CCVS-E-3. NC1754.2 +033700 02 FILLER PIC X(22) VALUE NC1754.2 +033800 " FOR OFFICIAL USE ONLY". NC1754.2 +033900 02 FILLER PIC X(12) VALUE SPACE. NC1754.2 +034000 02 FILLER PIC X(58) VALUE NC1754.2 +034100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1754.2 +034200 02 FILLER PIC X(13) VALUE SPACE. NC1754.2 +034300 02 FILLER PIC X(15) VALUE NC1754.2 +034400 " COPYRIGHT 1985". NC1754.2 +034500 01 CCVS-E-4. NC1754.2 +034600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1754.2 +034700 02 FILLER PIC X(4) VALUE " OF ". NC1754.2 +034800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1754.2 +034900 02 FILLER PIC X(40) VALUE NC1754.2 +035000 " TESTS WERE EXECUTED SUCCESSFULLY". NC1754.2 +035100 01 XXINFO. NC1754.2 +035200 02 FILLER PIC X(19) VALUE NC1754.2 +035300 "*** INFORMATION ***". NC1754.2 +035400 02 INFO-TEXT. NC1754.2 +035500 04 FILLER PIC X(8) VALUE SPACE. NC1754.2 +035600 04 XXCOMPUTED PIC X(20). NC1754.2 +035700 04 FILLER PIC X(5) VALUE SPACE. NC1754.2 +035800 04 XXCORRECT PIC X(20). NC1754.2 +035900 02 INF-ANSI-REFERENCE PIC X(48). NC1754.2 +036000 01 HYPHEN-LINE. NC1754.2 +036100 02 FILLER PIC IS X VALUE IS SPACE. NC1754.2 +036200 02 FILLER PIC IS X(65) VALUE IS "************************NC1754.2 +036300- "*****************************************". NC1754.2 +036400 02 FILLER PIC IS X(54) VALUE IS "************************NC1754.2 +036500- "******************************". NC1754.2 +036600 01 CCVS-PGM-ID PIC X(9) VALUE NC1754.2 +036700 "NC175A". NC1754.2 +036800 PROCEDURE DIVISION. NC1754.2 +036900 CCVS1 SECTION. NC1754.2 +037000 OPEN-FILES. NC1754.2 +037100 OPEN OUTPUT PRINT-FILE. NC1754.2 +037200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1754.2 +037300 MOVE SPACE TO TEST-RESULTS. NC1754.2 +037400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1754.2 +037500 GO TO CCVS1-EXIT. NC1754.2 +037600 CLOSE-FILES. NC1754.2 +037700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1754.2 +037800 TERMINATE-CCVS. NC1754.2 +037900*S EXIT PROGRAM. NC1754.2 +038000*SERMINATE-CALL. NC1754.2 +038100 STOP RUN. NC1754.2 +038200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1754.2 +038300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1754.2 +038400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1754.2 +038500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1754.2 +038600 MOVE "****TEST DELETED****" TO RE-MARK. NC1754.2 +038700 PRINT-DETAIL. NC1754.2 +038800 IF REC-CT NOT EQUAL TO ZERO NC1754.2 +038900 MOVE "." TO PARDOT-X NC1754.2 +039000 MOVE REC-CT TO DOTVALUE. NC1754.2 +039100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1754.2 +039200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1754.2 +039300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1754.2 +039400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1754.2 +039500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1754.2 +039600 MOVE SPACE TO CORRECT-X. NC1754.2 +039700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1754.2 +039800 MOVE SPACE TO RE-MARK. NC1754.2 +039900 HEAD-ROUTINE. NC1754.2 +040000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +040100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +040200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1754.2 +040300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1754.2 +040400 COLUMN-NAMES-ROUTINE. NC1754.2 +040500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +040600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +040700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +040800 END-ROUTINE. NC1754.2 +040900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1754.2 +041000 END-RTN-EXIT. NC1754.2 +041100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +041200 END-ROUTINE-1. NC1754.2 +041300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1754.2 +041400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1754.2 +041500 ADD PASS-COUNTER TO ERROR-HOLD. NC1754.2 +041600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1754.2 +041700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1754.2 +041800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1754.2 +041900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1754.2 +042000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1754.2 +042100 END-ROUTINE-12. NC1754.2 +042200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1754.2 +042300 IF ERROR-COUNTER IS EQUAL TO ZERO NC1754.2 +042400 MOVE "NO " TO ERROR-TOTAL NC1754.2 +042500 ELSE NC1754.2 +042600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1754.2 +042700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1754.2 +042800 PERFORM WRITE-LINE. NC1754.2 +042900 END-ROUTINE-13. NC1754.2 +043000 IF DELETE-COUNTER IS EQUAL TO ZERO NC1754.2 +043100 MOVE "NO " TO ERROR-TOTAL ELSE NC1754.2 +043200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1754.2 +043300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1754.2 +043400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +043500 IF INSPECT-COUNTER EQUAL TO ZERO NC1754.2 +043600 MOVE "NO " TO ERROR-TOTAL NC1754.2 +043700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1754.2 +043800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1754.2 +043900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +044000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1754.2 +044100 WRITE-LINE. NC1754.2 +044200 ADD 1 TO RECORD-COUNT. NC1754.2 +044300 IF RECORD-COUNT GREATER 42 NC1754.2 +044400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1754.2 +044500 MOVE SPACE TO DUMMY-RECORD NC1754.2 +044600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1754.2 +044700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1754.2 +044800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1754.2 +044900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1754.2 +045000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1754.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1754.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1754.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1754.2 +045400 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1754.2 +045500 MOVE ZERO TO RECORD-COUNT. NC1754.2 +045600 PERFORM WRT-LN. NC1754.2 +045700 WRT-LN. NC1754.2 +045800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1754.2 +045900 MOVE SPACE TO DUMMY-RECORD. NC1754.2 +046000 BLANK-LINE-PRINT. NC1754.2 +046100 PERFORM WRT-LN. NC1754.2 +046200 FAIL-ROUTINE. NC1754.2 +046300 IF COMPUTED-X NOT EQUAL TO SPACE NC1754.2 +046400 GO TO FAIL-ROUTINE-WRITE. NC1754.2 +046500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1754.2 +046600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1754.2 +046700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1754.2 +046800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +046900 MOVE SPACES TO INF-ANSI-REFERENCE. NC1754.2 +047000 GO TO FAIL-ROUTINE-EX. NC1754.2 +047100 FAIL-ROUTINE-WRITE. NC1754.2 +047200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1754.2 +047300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1754.2 +047400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1754.2 +047500 MOVE SPACES TO COR-ANSI-REFERENCE. NC1754.2 +047600 FAIL-ROUTINE-EX. EXIT. NC1754.2 +047700 BAIL-OUT. NC1754.2 +047800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1754.2 +047900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1754.2 +048000 BAIL-OUT-WRITE. NC1754.2 +048100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1754.2 +048200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1754.2 +048300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1754.2 +048400 MOVE SPACES TO INF-ANSI-REFERENCE. NC1754.2 +048500 BAIL-OUT-EX. EXIT. NC1754.2 +048600 CCVS1-EXIT. NC1754.2 +048700 EXIT. NC1754.2 +048800 SECT-NC175A-001 SECTION. NC1754.2 +048900 SUB-INIT-F2-1. NC1754.2 +049000 MOVE "VI-134 6.25.4 GR2" TO ANSI-REFERENCE. NC1754.2 +049100 MOVE "SUBTRACT FROM GIVING" TO FEATURE. NC1754.2 +049200 SUB-TEST-F2-1. NC1754.2 +049300 MOVE -2 TO N-10. NC1754.2 +049400 SUBTRACT N-10 FROM 0 GIVING N-19. NC1754.2 +049500 IF N-19 EQUAL TO "$2.00" NC1754.2 +049600 PERFORM PASS NC1754.2 +049700 GO TO SUB-WRITE-F2-1. NC1754.2 +049800 GO TO SUB-FAIL-F2-1. NC1754.2 +049900 SUB-DELETE-F2-1. NC1754.2 +050000 PERFORM DE-LETE. NC1754.2 +050100 GO TO SUB-WRITE-F2-1. NC1754.2 +050200 SUB-FAIL-F2-1. NC1754.2 +050300 MOVE N-19 TO COMPUTED-A. NC1754.2 +050400 MOVE " $2.00" TO CORRECT-A. NC1754.2 +050500 PERFORM FAIL. NC1754.2 +050600 SUB-WRITE-F2-1. NC1754.2 +050700 MOVE "SUB-TEST-F2-1 " TO PAR-NAME. NC1754.2 +050800 PERFORM PRINT-DETAIL. NC1754.2 +050900 SUB-TEST-F2-2. NC1754.2 +051000 SUBTRACT N-21 FROM N-22 GIVING N-23 ROUNDED. NC1754.2 +051100 IF N-23 EQUAL TO " $.55 " NC1754.2 +051200 PERFORM PASS NC1754.2 +051300 GO TO SUB-WRITE-F2-2. NC1754.2 +051400 GO TO SUB-FAIL-F2-2. NC1754.2 +051500 SUB-DELETE-F2-2. NC1754.2 +051600 PERFORM DE-LETE. NC1754.2 +051700 GO TO SUB-WRITE-F2-2. NC1754.2 +051800 SUB-FAIL-F2-2. NC1754.2 +051900 MOVE N-23 TO COMPUTED-A. NC1754.2 +052000 MOVE " $.55" TO CORRECT-A. NC1754.2 +052100 PERFORM FAIL. NC1754.2 +052200 SUB-WRITE-F2-2. NC1754.2 +052300 MOVE "SUB-TEST-F2-2 " TO PAR-NAME. NC1754.2 +052400 PERFORM PRINT-DETAIL. NC1754.2 +052500 SUB-INIT-F2-3-1. NC1754.2 +052600 MOVE 1 TO N-25. NC1754.2 +052700 MOVE ZERO TO N-26. NC1754.2 +052800 SUB-TEST-F2-3-1. NC1754.2 +052900 SUBTRACT N-25 FROM -99999 GIVING N-26 ON SIZE ERROR NC1754.2 +053000 PERFORM PASS NC1754.2 +053100 GO TO SUB-WRITE-F2-3-1. NC1754.2 +053200 GO TO SUB-FAIL-F2-3-1. NC1754.2 +053300 SUB-DELETE-F2-3-1. NC1754.2 +053400 PERFORM DE-LETE. NC1754.2 +053500 GO TO SUB-WRITE-F2-3-1. NC1754.2 +053600 SUB-FAIL-F2-3-1. NC1754.2 +053700 MOVE N-26 TO COMPUTED-N. NC1754.2 +053800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +053900 PERFORM FAIL. NC1754.2 +054000 SUB-WRITE-F2-3-1. NC1754.2 +054100 MOVE "SUB-TEST-F2-3-1 " TO PAR-NAME. NC1754.2 +054200 PERFORM PRINT-DETAIL. NC1754.2 +054300 SUB-TEST-F2-3-2. NC1754.2 +054400 IF N-26 = ZERO NC1754.2 +054500 PERFORM PASS NC1754.2 +054600 GO TO SUB-WRITE-F2-3-2. NC1754.2 +054700 GO TO SUB-FAIL-F2-3-2. NC1754.2 +054800 SUB-DELETE-F2-3-2. NC1754.2 +054900 PERFORM DE-LETE. NC1754.2 +055000 GO TO SUB-WRITE-F2-3-2. NC1754.2 +055100 SUB-FAIL-F2-3-2. NC1754.2 +055200 MOVE N-26 TO COMPUTED-N. NC1754.2 +055300 MOVE ZERO TO CORRECT-N. NC1754.2 +055400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +055500 PERFORM FAIL. NC1754.2 +055600 SUB-WRITE-F2-3-2. NC1754.2 +055700 MOVE "SUB-TEST-F2-3-2 " TO PAR-NAME. NC1754.2 +055800 PERFORM PRINT-DETAIL. NC1754.2 +055900 SUB-INIT-F2-4-1. NC1754.2 +056000 MOVE 9999.9 TO N-27. NC1754.2 +056100 MOVE ZERO TO N-28. NC1754.2 +056200 SUB-TEST-F2-4-1. NC1754.2 +056300 SUBTRACT -9 FROM N-27 GIVING N-28 ROUNDED ON SIZE ERROR NC1754.2 +056400 PERFORM PASS NC1754.2 +056500 GO TO SUB-WRITE-F2-4-1. NC1754.2 +056600 GO TO SUB-FAIL-F2-4-1. NC1754.2 +056700 SUB-DELETE-F2-4-1. NC1754.2 +056800 PERFORM DE-LETE. NC1754.2 +056900 GO TO SUB-WRITE-F2-4-1. NC1754.2 +057000 SUB-FAIL-F2-4-1. NC1754.2 +057100 MOVE N-28 TO COMPUTED-A. NC1754.2 +057200 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +057300 PERFORM FAIL. NC1754.2 +057400 SUB-WRITE-F2-4-1. NC1754.2 +057500 MOVE "SUB-TEST-F2-4-1 " TO PAR-NAME. NC1754.2 +057600 PERFORM PRINT-DETAIL. NC1754.2 +057700 SUB-TEST-F2-4-2. NC1754.2 +057800 IF N-28 = "$0000.00" NC1754.2 +057900 PERFORM PASS NC1754.2 +058000 GO TO SUB-WRITE-F2-4-2. NC1754.2 +058100 GO TO SUB-FAIL-F2-4-2. NC1754.2 +058200 SUB-DELETE-F2-4-2. NC1754.2 +058300 PERFORM DE-LETE. NC1754.2 +058400 GO TO SUB-WRITE-F2-4-2. NC1754.2 +058500 SUB-FAIL-F2-4-2. NC1754.2 +058600 MOVE N-28 TO COMPUTED-X. NC1754.2 +058700 MOVE "$0000.00" TO CORRECT-X. NC1754.2 +058800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +058900 PERFORM FAIL. NC1754.2 +059000 SUB-WRITE-F2-4-2. NC1754.2 +059100 MOVE "SUB-TEST-F2-4-2 " TO PAR-NAME. NC1754.2 +059200 PERFORM PRINT-DETAIL. NC1754.2 +059300 SUB-INIT-F2-5. NC1754.2 +059400 MOVE " GIVING" TO FEATURE. NC1754.2 +059500 SUB-TEST-F2-5. NC1754.2 +059600 MOVE ZERO TO WRK-DS-09V09. NC1754.2 +059700 SUBTRACT A06THREES-DS-03V03 FROM A12THREES-DS-06V06 NC1754.2 +059800 GIVING WRK-DS-06V06. NC1754.2 +059900 IF WRK-DS-06V06 EQUAL TO 333000.000333 NC1754.2 +060000 PERFORM PASS GO TO SUB-WRITE-F2-5. NC1754.2 +060100 GO TO SUB-FAIL-F2-5. NC1754.2 +060200 SUB-DELETE-F2-5. NC1754.2 +060300 PERFORM DE-LETE. NC1754.2 +060400 GO TO SUB-WRITE-F2-5. NC1754.2 +060500 SUB-FAIL-F2-5. NC1754.2 +060600 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1754.2 +060700 MOVE 333000.000333 TO CORRECT-N. NC1754.2 +060800 PERFORM FAIL. NC1754.2 +060900 SUB-WRITE-F2-5. NC1754.2 +061000 MOVE "SUB-TEST-F2-5" TO PAR-NAME. NC1754.2 +061100 PERFORM PRINT-DETAIL. NC1754.2 +061200 SUB-TEST-F2-6. NC1754.2 +061300 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +061400 SUBTRACT A05ONES-DS-05V00 NC1754.2 +061500 A05ONES-DS-00V05 NC1754.2 +061600 A12THREES-DS-06V06 NC1754.2 +061700 A06THREES-DS-03V03 FROM ZERO GIVING WRK-DS-06V06. NC1754.2 +061800 IF WRK-DS-06V06 EQUAL TO -344777.777443 NC1754.2 +061900 PERFORM PASS GO TO SUB-WRITE-F2-6. NC1754.2 +062000 GO TO SUB-FAIL-F2-6. NC1754.2 +062100 SUB-DELETE-F2-6. NC1754.2 +062200 PERFORM DE-LETE. NC1754.2 +062300 GO TO SUB-WRITE-F2-6. NC1754.2 +062400 SUB-FAIL-F2-6. NC1754.2 +062500 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1754.2 +062600 MOVE -344777.777443 TO CORRECT-N. NC1754.2 +062700 PERFORM FAIL. NC1754.2 +062800 SUB-WRITE-F2-6. NC1754.2 +062900 MOVE "SUB-TEST-F2-6" TO PAR-NAME. NC1754.2 +063000 PERFORM PRINT-DETAIL. NC1754.2 +063100 SUB-TEST-F2-7. NC1754.2 +063200 MOVE -099999.999999 TO WRK-DS-06V06. NC1754.2 +063300 SUBTRACT A05ONES-DS-05V00 NC1754.2 +063400 -11111 NC1754.2 +063500 AZERO-DS-05V05 FROM WRK-DS-06V06 NC1754.2 +063600 GIVING WRK-DS-06V00 ROUNDED. NC1754.2 +063700 IF WRK-DS-06V00 EQUAL TO -100000 NC1754.2 +063800 PERFORM PASS GO TO SUB-WRITE-F2-7. NC1754.2 +063900 GO TO SUB-FAIL-F2-7. NC1754.2 +064000 SUB-DELETE-F2-7. NC1754.2 +064100 PERFORM DE-LETE. NC1754.2 +064200 GO TO SUB-WRITE-F2-7. NC1754.2 +064300 SUB-FAIL-F2-7. NC1754.2 +064400 MOVE WRK-DS-06V00 TO COMPUTED-N. NC1754.2 +064500 MOVE -100000 TO CORRECT-N. NC1754.2 +064600 PERFORM FAIL. NC1754.2 +064700 SUB-WRITE-F2-7. NC1754.2 +064800 MOVE "SUB-TEST-F2-7" TO PAR-NAME. NC1754.2 +064900 PERFORM PRINT-DETAIL. NC1754.2 +065000 SUB-TEST-F2-8-1. NC1754.2 +065100 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +065200 SUBTRACT A12ONES-DS-12V00 NC1754.2 +065300 FROM ZERO GIVING WRK-DS-10V00 ON SIZE ERROR NC1754.2 +065400 PERFORM PASS GO TO SUB-WRITE-F2-8-1. NC1754.2 +065500 GO TO SUB-FAIL-F2-8-1. NC1754.2 +065600 SUB-DELETE-F2-8-1. NC1754.2 +065700 PERFORM DE-LETE. NC1754.2 +065800 GO TO SUB-WRITE-F2-8-1. NC1754.2 +065900 SUB-FAIL-F2-8-1. NC1754.2 +066000 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +066100 PERFORM FAIL. NC1754.2 +066200 SUB-WRITE-F2-8-1. NC1754.2 +066300 MOVE "SUB-TEST-F2-8-1" TO PAR-NAME. NC1754.2 +066400 PERFORM PRINT-DETAIL. NC1754.2 +066500 SUB-TEST-F2-8-2. NC1754.2 +066600 IF WRK-DS-10V00 EQUAL TO ZERO NC1754.2 +066700 PERFORM PASS GO TO SUB-WRITE-F2-8-2. NC1754.2 +066800* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F2-8-1 NC1754.2 +066900 GO TO SUB-FAIL-F2-8-2. NC1754.2 +067000 SUB-DELETE-F2-8-2. NC1754.2 +067100 PERFORM DE-LETE. NC1754.2 +067200 GO TO SUB-WRITE-F2-8-2. NC1754.2 +067300 SUB-FAIL-F2-8-2. NC1754.2 +067400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +067500 MOVE WRK-DS-10V00 TO COMPUTED-14V4. NC1754.2 +067600 MOVE ZERO TO CORRECT-14V4. NC1754.2 +067700 PERFORM FAIL. NC1754.2 +067800 SUB-WRITE-F2-8-2. NC1754.2 +067900 MOVE "SUB-TEST-F2-8-2" TO PAR-NAME. NC1754.2 +068000 PERFORM PRINT-DETAIL. NC1754.2 +068100 SUB-TEST-F2-9-1. NC1754.2 +068200 MOVE ZERO TO WRK-DS-05V00. NC1754.2 +068300 SUBTRACT 33333 NC1754.2 +068400 A06THREES-DS-03V03 NC1754.2 +068500 A12THREES-DS-06V06 NC1754.2 +068600 FROM -1000000 GIVING WRK-DS-05V00 NC1754.2 +068700 ROUNDED ON SIZE ERROR NC1754.2 +068800 PERFORM PASS GO TO SUB-WRITE-F2-9-1. NC1754.2 +068900 GO TO SUB-FAIL-F2-9-1. NC1754.2 +069000 SUB-DELETE-F2-9-1. NC1754.2 +069100 PERFORM DE-LETE. NC1754.2 +069200 GO TO SUB-WRITE-F2-9-1. NC1754.2 +069300 SUB-FAIL-F2-9-1. NC1754.2 +069400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +069500 PERFORM FAIL. NC1754.2 +069600 SUB-WRITE-F2-9-1. NC1754.2 +069700 MOVE "SUB-TEST-F2-9-1" TO PAR-NAME. NC1754.2 +069800 PERFORM PRINT-DETAIL. NC1754.2 +069900 SUB-TEST-F2-9-2. NC1754.2 +070000 IF WRK-DS-05V00 EQUAL TO ZERO NC1754.2 +070100 PERFORM PASS GO TO SUB-WRITE-F2-9-2. NC1754.2 +070200* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F2-9-1 NC1754.2 +070300 GO TO SUB-FAIL-F2-9-2. NC1754.2 +070400 SUB-DELETE-F2-9-2. NC1754.2 +070500 PERFORM DE-LETE. NC1754.2 +070600 GO TO SUB-WRITE-F2-9-2. NC1754.2 +070700 SUB-FAIL-F2-9-2. NC1754.2 +070800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +070900 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1754.2 +071000 MOVE ZERO TO CORRECT-N. NC1754.2 +071100 PERFORM FAIL. NC1754.2 +071200 SUB-WRITE-F2-9-2. NC1754.2 +071300 MOVE "SUB-TEST-F2-9-2" TO PAR-NAME. NC1754.2 +071400 PERFORM PRINT-DETAIL. NC1754.2 +071500 SUB-TEST-F2-10-1. NC1754.2 +071600 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +071700 SUBTRACT A12THREES-DS-06V06 NC1754.2 +071800 333333 NC1754.2 +071900 A06THREES-DS-03V03 NC1754.2 +072000 -.0000009 FROM 0000000 NC1754.2 +072100 GIVING WRK-DS-06V06 ROUNDED ON SIZE ERROR NC1754.2 +072200 GO TO SUB-FAIL-F2-10-1. NC1754.2 +072300 PERFORM PASS. NC1754.2 +072400 GO TO SUB-WRITE-F2-10-1. NC1754.2 +072500 SUB-DELETE-F2-10-1. NC1754.2 +072600 PERFORM DE-LETE. NC1754.2 +072700 GO TO SUB-WRITE-F2-10-1. NC1754.2 +072800 SUB-FAIL-F2-10-1. NC1754.2 +072900 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1754.2 +073000 PERFORM FAIL. NC1754.2 +073100 SUB-WRITE-F2-10-1. NC1754.2 +073200 MOVE "SUB-TEST-F2-10-1" TO PAR-NAME. NC1754.2 +073300 PERFORM PRINT-DETAIL. NC1754.2 +073400 SUB-TEST-F2-10-2. NC1754.2 +073500 IF WRK-DS-06V06 EQUAL TO -666999.666332 NC1754.2 +073600 PERFORM PASS GO TO SUB-WRITE-F2-10-2. NC1754.2 +073700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F2-10-1 NC1754.2 +073800 GO TO SUB-FAIL-F2-10-2. NC1754.2 +073900 SUB-DELETE-F2-10-2. NC1754.2 +074000 PERFORM DE-LETE. NC1754.2 +074100 GO TO SUB-WRITE-F2-10-2. NC1754.2 +074200 SUB-FAIL-F2-10-2. NC1754.2 +074300 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1754.2 +074400 MOVE -666999.666332 TO CORRECT-N. NC1754.2 +074500 PERFORM FAIL. NC1754.2 +074600 SUB-WRITE-F2-10-2. NC1754.2 +074700 MOVE "SUB-TEST-F2-10-2" TO PAR-NAME. NC1754.2 +074800 PERFORM PRINT-DETAIL. NC1754.2 +074900 SUB-INIT-F2-11. NC1754.2 +075000 MOVE " SERIES" TO FEATURE. NC1754.2 +075100 SUB-TEST-F2-11. NC1754.2 +075200 MOVE ZERO TO WRK-DS-03V10. NC1754.2 +075300 SUBTRACT A99-DS-02V00 NC1754.2 +075400 A03ONES-DS-02V01 NC1754.2 +075500 A06ONES-DS-03V03 NC1754.2 +075600 A08TWOS-DS-02V06 NC1754.2 +075700 -1.1111111 NC1754.2 +075800 +.11111111 NC1754.2 +075900 A01ONE-DS-P0801 FROM 0000.000000 NC1754.2 +076000 GIVING WRK-DS-03V10. NC1754.2 +076100 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1754.2 +076200 PERFORM PASS GO TO SUB-WRITE-F2-11. NC1754.2 +076300 GO TO SUB-FAIL-F2-11. NC1754.2 +076400 SUB-DELETE-F2-11. NC1754.2 +076500 PERFORM DE-LETE. NC1754.2 +076600 GO TO SUB-WRITE-F2-11. NC1754.2 +076700 SUB-FAIL-F2-11. NC1754.2 +076800 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1754.2 +076900 MOVE -242.4332220110 TO CORRECT-4V14. NC1754.2 +077000 PERFORM FAIL. NC1754.2 +077100 SUB-WRITE-F2-11. NC1754.2 +077200 MOVE "SUB-TEST-F2-11" TO PAR-NAME. NC1754.2 +077300 PERFORM PRINT-DETAIL. NC1754.2 +077400 SUB-TEST-F2-12. NC1754.2 +077500 MOVE ZERO TO WRK-DS-03V10. NC1754.2 +077600 SUBTRACT A01ONE-DS-P0801 NC1754.2 +077700 +.11111111 NC1754.2 +077800 -1.1111111 NC1754.2 +077900 A08TWOS-DS-02V06 NC1754.2 +078000 A06ONES-DS-03V03 NC1754.2 +078100 A03ONES-DS-02V01 NC1754.2 +078200 A99-DS-02V00 FROM 0000.000000 GIVING WRK-DS-03V10. NC1754.2 +078300 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1754.2 +078400 PERFORM PASS GO TO SUB-WRITE-F2-12. NC1754.2 +078500 GO TO SUB-FAIL-F2-12. NC1754.2 +078600 SUB-DELETE-F2-12. NC1754.2 +078700 PERFORM DE-LETE. NC1754.2 +078800 GO TO SUB-WRITE-F2-12. NC1754.2 +078900 SUB-FAIL-F2-12. NC1754.2 +079000 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1754.2 +079100 MOVE -242.4332220110 TO CORRECT-4V14. NC1754.2 +079200 PERFORM FAIL. NC1754.2 +079300 SUB-WRITE-F2-12. NC1754.2 +079400 MOVE "SUB-TEST-F2-12" TO PAR-NAME. NC1754.2 +079500 PERFORM PRINT-DETAIL. NC1754.2 +079600 SUB-TEST-F2-13. NC1754.2 +079700 MOVE ZERO TO WRK-DS-03V10. NC1754.2 +079800 SUBTRACT A08TWOS-DS-02V06 NC1754.2 +079900 A99-DS-02V00 NC1754.2 +080000 -1.1111111 NC1754.2 +080100 A03ONES-DS-02V01 NC1754.2 +080200 A01ONE-DS-P0801 NC1754.2 +080300 +.11111111 NC1754.2 +080400 A06ONES-DS-03V03 FROM 0000.000000 NC1754.2 +080500 GIVING WRK-DS-03V10. NC1754.2 +080600 IF WRK-DS-03V10 EQUAL TO -242.4332220110 NC1754.2 +080700 PERFORM PASS GO TO SUB-WRITE-F2-13. NC1754.2 +080800 GO TO SUB-FAIL-F2-13. NC1754.2 +080900 SUB-DELETE-F2-13. NC1754.2 +081000 PERFORM DE-LETE. NC1754.2 +081100 GO TO SUB-WRITE-F2-13. NC1754.2 +081200 SUB-FAIL-F2-13. NC1754.2 +081300 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1754.2 +081400 MOVE -242.4332220110 TO CORRECT-4V14. NC1754.2 +081500 PERFORM FAIL. NC1754.2 +081600 SUB-WRITE-F2-13. NC1754.2 +081700 MOVE "SUB-TEST-F2-13" TO PAR-NAME. NC1754.2 +081800 PERFORM PRINT-DETAIL. NC1754.2 +081900 SUB-TEST-F2-14. NC1754.2 +082000 SUBTRACT SUBTR-4 SUBTR-5 .499 FROM SUBTR-2 GIVING SUBTR-11. NC1754.2 +082100 IF SUBTR-11 EQUAL TO -1.5 NC1754.2 +082200 PERFORM PASS GO TO SUB-WRITE-F2-14. NC1754.2 +082300 GO TO SUB-FAIL-F2-14. NC1754.2 +082400 SUB-DELETE-F2-14. NC1754.2 +082500 PERFORM DE-LETE. NC1754.2 +082600 GO TO SUB-WRITE-F2-14. NC1754.2 +082700 SUB-FAIL-F2-14. NC1754.2 +082800 MOVE SUBTR-11 TO COMPUTED-N. NC1754.2 +082900 MOVE -1.5 TO CORRECT-N. NC1754.2 +083000 PERFORM FAIL. NC1754.2 +083100 SUB-WRITE-F2-14. NC1754.2 +083200 MOVE "SUB-TEST-F2-14" TO PAR-NAME. NC1754.2 +083300 PERFORM PRINT-DETAIL. NC1754.2 +083400 SUB-TEST-F2-15-1. NC1754.2 +083500 SUBTRACT SUBTR-1 SUBTR-3 FROM SUBTR-5 GIVING SUBTR-7 ON NC1754.2 +083600 SIZE ERROR NC1754.2 +083700 PERFORM PASS GO TO SUB-WRITE-F2-15-1. NC1754.2 +083800 GO TO SUB-FAIL-F2-15-1. NC1754.2 +083900 SUB-DELETE-F2-15-1. NC1754.2 +084000 PERFORM DE-LETE. NC1754.2 +084100 GO TO SUB-WRITE-F2-15-1. NC1754.2 +084200 SUB-FAIL-F2-15-1. NC1754.2 +084300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1754.2 +084400 PERFORM FAIL. NC1754.2 +084500 SUB-WRITE-F2-15-1. NC1754.2 +084600 MOVE "SUB-TEST-F2-15-1" TO PAR-NAME. NC1754.2 +084700 PERFORM PRINT-DETAIL. NC1754.2 +084800 SUB-TEST-F2-15-2. NC1754.2 +084900 IF SUBTR-7 EQUAL TO 99 NC1754.2 +085000 PERFORM PASS GO TO SUB-WRITE-F2-15-2. NC1754.2 +085100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF SUB-TEST-F2-15-2 NC1754.2 +085200 GO TO SUB-FAIL-F2-15-2. NC1754.2 +085300 SUB-DELETE-F2-15-2. NC1754.2 +085400 PERFORM DE-LETE. NC1754.2 +085500 GO TO SUB-WRITE-F2-15-2. NC1754.2 +085600 SUB-FAIL-F2-15-2. NC1754.2 +085700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1754.2 +085800 MOVE SUBTR-7 TO COMPUTED-N. NC1754.2 +085900 MOVE ZERO TO CORRECT-N. NC1754.2 +086000 PERFORM FAIL. NC1754.2 +086100 SUB-WRITE-F2-15-2. NC1754.2 +086200 MOVE "SUB-TEST-F2-15-2" TO PAR-NAME. NC1754.2 +086300 PERFORM PRINT-DETAIL. NC1754.2 +086400 SUB-TEST-F2-16-1. NC1754.2 +086500 MOVE SPACE TO SIZE-ERR. NC1754.2 +086600 SUBTRACT MINUS-NAME1 MINUS-NAME2 -34 -1 PLUS-NAME1 NC1754.2 +086700 PLUS-NAME2 EVEN-NAME1 35 FROM EVEN-NAME1 GIVING NC1754.2 +086800 WHOLE-FIELD NC1754.2 +086900 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1754.2 +087000 IF WHOLE-FIELD EQUAL TO 0 NC1754.2 +087100 PERFORM PASS NC1754.2 +087200 GO TO SUB-WRITE-F2-16-1. NC1754.2 +087300 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC1754.2 +087400 MOVE 0 TO CORRECT-18V0. NC1754.2 +087500 PERFORM FAIL. NC1754.2 +087600 GO TO SUB-WRITE-F2-16-1. NC1754.2 +087700 SUB-DELETE-F2-16-1. NC1754.2 +087800 PERFORM DE-LETE. NC1754.2 +087900 SUB-WRITE-F2-16-1. NC1754.2 +088000 MOVE "SUB-TEST-F2-16-1" TO PAR-NAME. NC1754.2 +088100 PERFORM PRINT-DETAIL. NC1754.2 +088200 SUB-TEST-F2-16-2. NC1754.2 +088300 IF SIZE-ERR EQUAL TO "1" NC1754.2 +088400 PERFORM FAIL NC1754.2 +088500 MOVE SPACE TO CORRECT-A NC1754.2 +088600 MOVE 1 TO COMPUTED-A NC1754.2 +088700 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1754.2 +088800 GO TO SUB-WRITE-F2-16-2. NC1754.2 +088900 PERFORM PASS. NC1754.2 +089000 GO TO SUB-WRITE-F2-16-2. NC1754.2 +089100 SUB-DELETE-F2-16-2. NC1754.2 +089200 PERFORM DE-LETE. NC1754.2 +089300 SUB-WRITE-F2-16-2. NC1754.2 +089400 MOVE "SUB-TEST-F2-16-2" TO PAR-NAME. NC1754.2 +089500 PERFORM PRINT-DETAIL. NC1754.2 +089600 SUB-TEST-F2-17-1. NC1754.2 +089700 MOVE SPACE TO SIZE-ERR. NC1754.2 +089800 SUBTRACT MINUS-NAME3 MINUS-NAME4 -.34 -.01 PLUS-NAME3 NC1754.2 +089900 PLUS-NAME4 EVEN-NAME2 .35 FROM EVEN-NAME2 NC1754.2 +090000 GIVING DECMAL-FIELD NC1754.2 +090100 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1754.2 +090200 IF DECMAL-FIELD EQUAL TO .0 NC1754.2 +090300 PERFORM PASS NC1754.2 +090400 GO TO SUB-WRITE-F2-17-1. NC1754.2 +090500 MOVE DECMAL-FIELD TO COMPUTED-0V18. NC1754.2 +090600 MOVE .0 TO CORRECT-0V18. NC1754.2 +090700 PERFORM FAIL. NC1754.2 +090800 GO TO SUB-WRITE-F2-17-1. NC1754.2 +090900 SUB-DELETE-F2-17-1. NC1754.2 +091000 PERFORM DE-LETE. NC1754.2 +091100 SUB-WRITE-F2-17-1. NC1754.2 +091200 MOVE "SUB-TEST-F2-17-1" TO PAR-NAME. NC1754.2 +091300 PERFORM PRINT-DETAIL. NC1754.2 +091400 SUB-TEST-F2-17-2. NC1754.2 +091500 IF SIZE-ERR EQUAL TO "1" NC1754.2 +091600 PERFORM FAIL NC1754.2 +091700 MOVE SPACE TO CORRECT-A NC1754.2 +091800 MOVE 1 TO COMPUTED-A NC1754.2 +091900 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1754.2 +092000 GO TO SUB-WRITE-F2-17-2. NC1754.2 +092100 PERFORM PASS. NC1754.2 +092200 GO TO SUB-WRITE-F2-17-2. NC1754.2 +092300 SUB-DELETE-F2-17-2. NC1754.2 +092400 PERFORM DE-LETE. NC1754.2 +092500 SUB-WRITE-F2-17-2. NC1754.2 +092600 MOVE "SUB-TEST-F2-17-2" TO PAR-NAME. NC1754.2 +092700 PERFORM PRINT-DETAIL. NC1754.2 +092800 SUB-TEST-F2-18. NC1754.2 +092900 MOVE ZERO TO WRK-CS-18V00. NC1754.2 +093000 SUBTRACT A12THREES-CU-18V00 FROM A14TWOS-CS-18V00 NC1754.2 +093100 GIVING WRK-CS-18V00. NC1754.2 +093200 IF WRK-CS-18V00 EQUAL TO -000022555555555555 NC1754.2 +093300 PERFORM PASS NC1754.2 +093400 GO TO SUB-WRITE-F2-18. NC1754.2 +093500 MOVE -000022555555555555 TO CORRECT-18V0. NC1754.2 +093600 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1754.2 +093700 PERFORM FAIL. NC1754.2 +093800 GO TO SUB-WRITE-F2-18. NC1754.2 +093900 SUB-DELETE-F2-18. NC1754.2 +094000 PERFORM DE-LETE. NC1754.2 +094100 SUB-WRITE-F2-18. NC1754.2 +094200 MOVE "SUB-TEST-F2-18 " TO PAR-NAME. NC1754.2 +094300 PERFORM PRINT-DETAIL. NC1754.2 +094400 SUB-TEST-F2-19. NC1754.2 +094500 MOVE ZERO TO WRK-DU-18V00. NC1754.2 +094600 SUBTRACT A18SIXES-CS-18V00 FROM A18THREES-CS-18V00 NC1754.2 +094700 GIVING WRK-DU-18V00. NC1754.2 +094800 IF WRK-DU-18V00 EQUAL TO 999999999999999999 NC1754.2 +094900 PERFORM PASS NC1754.2 +095000 GO TO SUB-WRITE-F2-19. NC1754.2 +095100 MOVE 999999999999999999 TO CORRECT-18V0. NC1754.2 +095200 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1754.2 +095300 PERFORM FAIL. NC1754.2 +095400 GO TO SUB-WRITE-F2-19. NC1754.2 +095500 SUB-DELETE-F2-19. NC1754.2 +095600 PERFORM DE-LETE. NC1754.2 +095700 SUB-WRITE-F2-19. NC1754.2 +095800 MOVE "SUB-TEST-F2-19 " TO PAR-NAME. NC1754.2 +095900 PERFORM PRINT-DETAIL. NC1754.2 +096000 SUB-TEST-F2-20. NC1754.2 +096100 MOVE ZERO TO WRK-CS-18V00. NC1754.2 +096200 SUBTRACT A16FOURS-CS-18V00 FROM A12THREES-CU-18V00 NC1754.2 +096300 GIVING WRK-CS-18V00. NC1754.2 +096400 IF WRK-CS-18V00 EQUAL TO -004444111111111111 NC1754.2 +096500 PERFORM PASS NC1754.2 +096600 GO TO SUB-WRITE-F2-20. NC1754.2 +096700 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1754.2 +096800 MOVE -004444111111111111 TO CORRECT-18V0. NC1754.2 +096900 PERFORM FAIL. NC1754.2 +097000 GO TO SUB-WRITE-F2-20. NC1754.2 +097100 SUB-DELETE-F2-20. NC1754.2 +097200 PERFORM DE-LETE. NC1754.2 +097300 SUB-WRITE-F2-20. NC1754.2 +097400 MOVE "SUB-TEST-F2-20 " TO PAR-NAME. NC1754.2 +097500 PERFORM PRINT-DETAIL. NC1754.2 +097600 SUB-TEST-F2-21. NC1754.2 +097700 MOVE ZERO TO WRK-DU-18V00. NC1754.2 +097800 SUBTRACT A18THREES-CS-18V00 FROM A18ONES-CS-18V00 NC1754.2 +097900 GIVING WRK-DU-18V00. NC1754.2 +098000 IF WRK-DU-18V00 EQUAL TO 444444444444444444 NC1754.2 +098100 PERFORM PASS NC1754.2 +098200 GO TO SUB-WRITE-F2-21. NC1754.2 +098300 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1754.2 +098400 MOVE 444444444444444444 TO CORRECT-18V0. NC1754.2 +098500 PERFORM FAIL. NC1754.2 +098600 GO TO SUB-WRITE-F2-21. NC1754.2 +098700 SUB-DELETE-F2-21. NC1754.2 +098800 PERFORM DE-LETE. NC1754.2 +098900 SUB-WRITE-F2-21. NC1754.2 +099000 MOVE "SUB-TEST-F2-21 " TO PAR-NAME. NC1754.2 +099100 PERFORM PRINT-DETAIL. NC1754.2 +099200 SUB-TEST-F2-22. NC1754.2 +099300 MOVE ZERO TO WRK-CS-18V00. NC1754.2 +099400 SUBTRACT A18SIXES-CS-18V00 FROM A18THREES-CS-18V00 NC1754.2 +099500 GIVING WRK-CS-18V00. NC1754.2 +099600 IF WRK-CS-18V00 EQUAL TO -999999999999999999 NC1754.2 +099700 PERFORM PASS NC1754.2 +099800 GO TO SUB-WRITE-F2-22. NC1754.2 +099900 MOVE -999999999999999999 TO CORRECT-18V0. NC1754.2 +100000 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1754.2 +100100 PERFORM FAIL. NC1754.2 +100200 GO TO SUB-WRITE-F2-22. NC1754.2 +100300 SUB-DELETE-F2-22. NC1754.2 +100400 PERFORM DE-LETE. NC1754.2 +100500 SUB-WRITE-F2-22. NC1754.2 +100600 MOVE "SUB-TEST-F2-22 " TO PAR-NAME. NC1754.2 +100700 PERFORM PRINT-DETAIL. NC1754.2 +100800* NC1754.2 +100900 SUB-INIT-F2-23. NC1754.2 +101000* ===--> NEW SIZE ERROR TESTS <--=== NC1754.2 +101100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +101200 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +101300 SUB-TEST-F2-23. NC1754.2 +101400 SUBTRACT A12ONES-DS-12V00 NC1754.2 +101500 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +101600 NOT ON SIZE ERROR NC1754.2 +101700 MOVE "NOT ON SIZE ERROR SHOULD NOT EXECUTED" NC1754.2 +101800 TO RE-MARK NC1754.2 +101900 PERFORM FAIL GO TO SUB-WRITE-F2-23. NC1754.2 +102000 GO TO SUB-PASS-F2-23. NC1754.2 +102100 SUB-DELETE-F2-23. NC1754.2 +102200 PERFORM DE-LETE. NC1754.2 +102300 GO TO SUB-WRITE-F2-23. NC1754.2 +102400 SUB-PASS-F2-23. NC1754.2 +102500 PERFORM PASS. NC1754.2 +102600 SUB-WRITE-F2-23. NC1754.2 +102700 MOVE "SUB-TEST-F2-23" TO PAR-NAME. NC1754.2 +102800 PERFORM PRINT-DETAIL. NC1754.2 +102900* NC1754.2 +103000 SUB-INIT-F2-24. NC1754.2 +103100* ===--> NEW SIZE ERROR TESTS <--=== NC1754.2 +103200 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +103300 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +103400 SUB-TEST-F2-24. NC1754.2 +103500 SUBTRACT A12THREES-DS-06V06 NC1754.2 +103600 333333 NC1754.2 +103700 A06THREES-DS-03V03 NC1754.2 +103800 -.0000009 FROM 0000000 NC1754.2 +103900 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +104000 NOT ON SIZE ERROR NC1754.2 +104100 PERFORM PASS NC1754.2 +104200 GO TO SUB-WRITE-F2-24. NC1754.2 +104300 GO TO SUB-FAIL-F2-24. NC1754.2 +104400 SUB-DELETE-F2-24. NC1754.2 +104500 PERFORM DE-LETE. NC1754.2 +104600 GO TO SUB-WRITE-F2-24. NC1754.2 +104700 SUB-FAIL-F2-24. NC1754.2 +104800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1754.2 +104900 PERFORM FAIL. NC1754.2 +105000 SUB-WRITE-F2-24. NC1754.2 +105100 MOVE "SUB-TEST-F2-24" TO PAR-NAME. NC1754.2 +105200 PERFORM PRINT-DETAIL. NC1754.2 +105300* NC1754.2 +105400 SUB-INIT-F2-25. NC1754.2 +105500* ===--> NEW SIZE ERROR TESTS <--=== NC1754.2 +105600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +105700 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +105800 SUB-TEST-F2-25. NC1754.2 +105900 SUBTRACT A12ONES-DS-12V00 NC1754.2 +106000 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +106100 ON SIZE ERROR NC1754.2 +106200 GO TO SUB-PASS-F2-25 NC1754.2 +106300 NOT ON SIZE ERROR NC1754.2 +106400 MOVE "NOT ON SIZE ERROR SHOULD NOT EXECUTED" NC1754.2 +106500 TO RE-MARK NC1754.2 +106600 PERFORM FAIL GO TO SUB-WRITE-F2-25. NC1754.2 +106700 SUB-DELETE-F2-25. NC1754.2 +106800 PERFORM DE-LETE. NC1754.2 +106900 GO TO SUB-WRITE-F2-25. NC1754.2 +107000 SUB-PASS-F2-25. NC1754.2 +107100 PERFORM PASS. NC1754.2 +107200 SUB-WRITE-F2-25. NC1754.2 +107300 MOVE "SUB-TEST-F2-25" TO PAR-NAME. NC1754.2 +107400 PERFORM PRINT-DETAIL. NC1754.2 +107500* NC1754.2 +107600 SUB-INIT-F2-26. NC1754.2 +107700* ===--> NEW SIZE ERROR TESTS <--=== NC1754.2 +107800 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +107900 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +108000 SUB-TEST-F2-26. NC1754.2 +108100 SUBTRACT A12THREES-DS-06V06 NC1754.2 +108200 333333 NC1754.2 +108300 A06THREES-DS-03V03 NC1754.2 +108400 -.0000009 FROM 0000000 NC1754.2 +108500 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +108600 ON SIZE ERROR NC1754.2 +108700 GO TO SUB-FAIL-F2-26 NC1754.2 +108800 NOT ON SIZE ERROR NC1754.2 +108900 PERFORM PASS NC1754.2 +109000 GO TO SUB-WRITE-F2-26. NC1754.2 +109100 SUB-DELETE-F2-26. NC1754.2 +109200 PERFORM DE-LETE. NC1754.2 +109300 GO TO SUB-WRITE-F2-26. NC1754.2 +109400 SUB-FAIL-F2-26. NC1754.2 +109500 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1754.2 +109600 PERFORM FAIL. NC1754.2 +109700 SUB-WRITE-F2-26. NC1754.2 +109800 MOVE "SUB-TEST-F2-26" TO PAR-NAME. NC1754.2 +109900 PERFORM PRINT-DETAIL. NC1754.2 +110000* NC1754.2 +110100 SUB-INIT-F2-27. NC1754.2 +110200* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +110300 MOVE "VI-134 6.25.4 GR2" TO ANSI-REFERENCE. NC1754.2 +110400 MOVE "SUB-TEST-F2-27" TO PAR-NAME. NC1754.2 +110500 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +110600 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +110700 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +110800 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +110900 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +111000 MOVE ZERO TO WRK-NE-4. NC1754.2 +111100 MOVE ZERO TO WRK-NE-6. NC1754.2 +111200 MOVE ZERO TO REC-CT. NC1754.2 +111300 SUB-TEST-F2-27-0. NC1754.2 +111400 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DS-2V2-1 NC1754.2 +111500 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +111600 WRK-NE-6 ROUNDED NC1754.2 +111700 GO TO SUB-TEST-F2-27-1. NC1754.2 +111800 SUB-DELETE-F2-27. NC1754.2 +111900 PERFORM DE-LETE. NC1754.2 +112000 PERFORM PRINT-DETAIL. NC1754.2 +112100 GO TO SUB-INIT-F2-28. NC1754.2 +112200 SUB-TEST-F2-27-1. NC1754.2 +112300 MOVE "SUB-TEST-F2-27-1" TO PAR-NAME. NC1754.2 +112400 MOVE 1 TO REC-CT. NC1754.2 +112500 IF WRK-DS-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +112600 ELSE NC1754.2 +112700 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE 09.99 NC1754.2 +112800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +112900 ADD 1 TO REC-CT. NC1754.2 +113000 SUB-TEST-F2-27-2. NC1754.2 +113100 MOVE "SUB-TEST-F2-27-2" TO PAR-NAME. NC1754.2 +113200 IF WRK-DS-2V1-1 = 10.0 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +113300 ELSE NC1754.2 +113400 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE 10.0 NC1754.2 +113500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +113600 ADD 1 TO REC-CT. NC1754.2 +113700 SUB-TEST-F2-27-3. NC1754.2 +113800 MOVE "SUB-TEST-F2-27-3" TO PAR-NAME. NC1754.2 +113900 IF WRK-NE-4 = "$*9.99" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +114000 ELSE NC1754.2 +114100 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*0.00" TO NC1754.2 +114200 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +114300 ADD 1 TO REC-CT. NC1754.2 +114400 SUB-TEST-F2-27-4. NC1754.2 +114500 MOVE "SUB-TEST-F2-27-4" TO PAR-NAME. NC1754.2 +114600 IF WRK-NE-6 = "$*9.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +114700 ELSE NC1754.2 +114800 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "$*9.99 " TO NC1754.2 +114900 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +115000* NC1754.2 +115100 SUB-INIT-F2-28. NC1754.2 +115200* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +115300* ==--> SIZE ERROR <--== NC1754.2 +115400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +115500 MOVE "SUB-TEST-F2-28" TO PAR-NAME. NC1754.2 +115600 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +115700 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +115800 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +115900 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +116000 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +116100 MOVE ZERO TO WRK-NE-4. NC1754.2 +116200 MOVE ZERO TO WRK-NE-5 NC1754.2 +116300 MOVE ZERO TO WRK-NE-6. NC1754.2 +116400 MOVE ZERO TO REC-CT. NC1754.2 +116500 MOVE SPACE TO SIZE-ERR2. NC1754.2 +116600 SUB-TEST-F2-28-0. NC1754.2 +116700 SUBTRACT A16TWOS-DS-16V00 NC1754.2 +116800 2 WRK-DU-0V1-1 .04 NC1754.2 +116900 FROM WRK-DS-2V2-1 NC1754.2 +117000 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +117100 WRK-NE-5 WRK-NE-6 ROUNDED NC1754.2 +117200 ON SIZE ERROR NC1754.2 +117300 MOVE "A" TO SIZE-ERR2. NC1754.2 +117400 GO TO SUB-TEST-F2-28-1. NC1754.2 +117500 SUB-DELETE-F2-28. NC1754.2 +117600 PERFORM DE-LETE. NC1754.2 +117700 PERFORM PRINT-DETAIL. NC1754.2 +117800 GO TO SUB-INIT-F2-29. NC1754.2 +117900 SUB-TEST-F2-28-1. NC1754.2 +118000 MOVE "SUB-TEST-F2-28-1" TO PAR-NAME. NC1754.2 +118100 MOVE 1 TO REC-CT. NC1754.2 +118200 IF WRK-DS-2V2-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +118300 ELSE NC1754.2 +118400 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE ZERO NC1754.2 +118500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +118600 ADD 1 TO REC-CT. NC1754.2 +118700 SUB-TEST-F2-28-2. NC1754.2 +118800 MOVE "SUB-TEST-F2-28-2" TO PAR-NAME. NC1754.2 +118900 IF WRK-DS-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +119000 ELSE NC1754.2 +119100 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE ZERO NC1754.2 +119200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +119300 ADD 1 TO REC-CT. NC1754.2 +119400 SUB-TEST-F2-28-3. NC1754.2 +119500 MOVE "SUB-TEST-F2-28-3" TO PAR-NAME. NC1754.2 +119600 IF WRK-NE-4 = "$*0.00" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +119700 ELSE NC1754.2 +119800 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*0.00" TO NC1754.2 +119900 CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +120000 ADD 1 TO REC-CT. NC1754.2 +120100 SUB-TEST-F2-28-4. NC1754.2 +120200 MOVE "SUB-TEST-F2-28-4" TO PAR-NAME. NC1754.2 +120300 IF WRK-NE-5 = "*.**" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +120400 ELSE NC1754.2 +120500 PERFORM FAIL MOVE WRK-NE-5 TO COMPUTED-A MOVE "*.**" NC1754.2 +120600 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +120700 ADD 1 TO REC-CT. NC1754.2 +120800 SUB-TEST-F2-28-5. NC1754.2 +120900 MOVE "SUB-TEST-F2-28-5" TO PAR-NAME. NC1754.2 +121000 IF WRK-NE-6 = "***.****" NC1754.2 +121100 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +121200 ELSE NC1754.2 +121300 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "***.****" NC1754.2 +121400 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +121500 ADD 1 TO REC-CT. NC1754.2 +121600 SUB-TEST-F2-28-6. NC1754.2 +121700 MOVE "SUB-TEST-F2-28-6" TO PAR-NAME. NC1754.2 +121800 IF SIZE-ERR2 = "A" NC1754.2 +121900 PERFORM PASS NC1754.2 +122000 PERFORM PRINT-DETAIL NC1754.2 +122100 ELSE NC1754.2 +122200 MOVE "A" TO CORRECT-X NC1754.2 +122300 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +122400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +122500 TO RE-MARK NC1754.2 +122600 PERFORM FAIL NC1754.2 +122700 PERFORM PRINT-DETAIL. NC1754.2 +122800* NC1754.2 +122900 SUB-INIT-F2-29. NC1754.2 +123000* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +123100* ==--> NO SIZE ERROR <--== NC1754.2 +123200 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +123300 MOVE "SUB-TEST-F2-29" TO PAR-NAME. NC1754.2 +123400 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +123500 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +123600 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +123700 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +123800 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +123900 MOVE ZERO TO WRK-NE-4. NC1754.2 +124000 MOVE ZERO TO WRK-NE-6. NC1754.2 +124100 MOVE ZERO TO REC-CT. NC1754.2 +124200 MOVE SPACE TO SIZE-ERR2. NC1754.2 +124300 SUB-TEST-F2-29-0. NC1754.2 +124400 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DS-2V2-1 NC1754.2 +124500 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +124600 WRK-NE-6 ROUNDED NC1754.2 +124700 ON SIZE ERROR NC1754.2 +124800 MOVE "A" TO SIZE-ERR2. NC1754.2 +124900 GO TO SUB-TEST-F2-29-1. NC1754.2 +125000 SUB-DELETE-F2-29. NC1754.2 +125100 PERFORM DE-LETE. NC1754.2 +125200 PERFORM PRINT-DETAIL. NC1754.2 +125300 GO TO SUB-INIT-F2-30. NC1754.2 +125400 SUB-TEST-F2-29-1. NC1754.2 +125500 MOVE "SUB-TEST-F2-29-1" TO PAR-NAME. NC1754.2 +125600 MOVE 1 TO REC-CT. NC1754.2 +125700 IF WRK-DS-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +125800 ELSE NC1754.2 +125900 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE 09.99 NC1754.2 +126000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +126100 ADD 1 TO REC-CT. NC1754.2 +126200 SUB-TEST-F2-29-2. NC1754.2 +126300 MOVE "SUB-TEST-F2-29-2" TO PAR-NAME. NC1754.2 +126400 IF WRK-DS-2V1-1 = 10.0 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +126500 ELSE NC1754.2 +126600 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE 10.0 NC1754.2 +126700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +126800 ADD 1 TO REC-CT. NC1754.2 +126900 SUB-TEST-F2-29-3. NC1754.2 +127000 MOVE "SUB-TEST-F2-29-3" TO PAR-NAME. NC1754.2 +127100 IF WRK-NE-4 = "$*9.99" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +127200 ELSE NC1754.2 +127300 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*9.99" TO NC1754.2 +127400 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +127500 ADD 1 TO REC-CT. NC1754.2 +127600 SUB-TEST-F2-29-4. NC1754.2 +127700 MOVE "SUB-TEST-F2-29-4" TO PAR-NAME. NC1754.2 +127800 IF WRK-NE-6 = "$*9.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +127900 ELSE NC1754.2 +128000 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "$*9.99 " TO NC1754.2 +128100 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +128200 ADD 1 TO REC-CT. NC1754.2 +128300 SUB-TEST-F2-29-5. NC1754.2 +128400 MOVE "SUB-TEST-F2-29-5" TO PAR-NAME. NC1754.2 +128500 IF SIZE-ERR2 = SPACE NC1754.2 +128600 PERFORM PASS NC1754.2 +128700 PERFORM PRINT-DETAIL NC1754.2 +128800 ELSE NC1754.2 +128900 MOVE SPACE TO CORRECT-X NC1754.2 +129000 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +129100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +129200 TO RE-MARK NC1754.2 +129300 PERFORM FAIL NC1754.2 +129400 PERFORM PRINT-DETAIL. NC1754.2 +129500* NC1754.2 +129600 SUB-INIT-F2-30. NC1754.2 +129700* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +129800* ==--> SIZE ERROR <--== NC1754.2 +129900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +130000 MOVE "SUB-TEST-F2-30" TO PAR-NAME. NC1754.2 +130100 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +130200 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +130300 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +130400 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +130500 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +130600 MOVE ZERO TO WRK-NE-4. NC1754.2 +130700 MOVE ZERO TO WRK-NE-5 NC1754.2 +130800 MOVE ZERO TO WRK-NE-6. NC1754.2 +130900 MOVE ZERO TO REC-CT. NC1754.2 +131000 MOVE SPACE TO SIZE-ERR2. NC1754.2 +131100 SUB-TEST-F2-30-0. NC1754.2 +131200 SUBTRACT A16TWOS-DS-16V00 NC1754.2 +131300 2 WRK-DU-0V1-1 .04 NC1754.2 +131400 FROM WRK-DS-2V2-1 NC1754.2 +131500 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +131600 WRK-NE-5 WRK-NE-6 ROUNDED NC1754.2 +131700 NOT ON SIZE ERROR NC1754.2 +131800 MOVE "A" TO SIZE-ERR2. NC1754.2 +131900 GO TO SUB-TEST-F2-30-1. NC1754.2 +132000 SUB-DELETE-F2-30. NC1754.2 +132100 PERFORM DE-LETE. NC1754.2 +132200 PERFORM PRINT-DETAIL. NC1754.2 +132300 GO TO SUB-INIT-F2-31. NC1754.2 +132400 SUB-TEST-F2-30-1. NC1754.2 +132500 MOVE "SUB-TEST-F2-30-1" TO PAR-NAME. NC1754.2 +132600 MOVE 1 TO REC-CT. NC1754.2 +132700 IF WRK-DS-2V2-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +132800 ELSE NC1754.2 +132900 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE ZERO NC1754.2 +133000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +133100 ADD 1 TO REC-CT. NC1754.2 +133200 SUB-TEST-F2-30-2. NC1754.2 +133300 MOVE "SUB-TEST-F2-30-2" TO PAR-NAME. NC1754.2 +133400 IF WRK-DS-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +133500 ELSE NC1754.2 +133600 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE ZERO NC1754.2 +133700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +133800 ADD 1 TO REC-CT. NC1754.2 +133900 SUB-TEST-F2-30-3. NC1754.2 +134000 MOVE "SUB-TEST-F2-30-3" TO PAR-NAME. NC1754.2 +134100 IF WRK-NE-4 = "$*0.00" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +134200 ELSE NC1754.2 +134300 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*0.00" to NC1754.2 +134400 CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +134500 ADD 1 TO REC-CT. NC1754.2 +134600 SUB-TEST-F2-30-4. NC1754.2 +134700 MOVE "SUB-TEST-F2-30-4" TO PAR-NAME. NC1754.2 +134800 IF WRK-NE-5 = "*.**" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +134900 ELSE NC1754.2 +135000 PERFORM FAIL MOVE WRK-NE-5 TO COMPUTED-A MOVE "*.**" NC1754.2 +135100 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +135200 ADD 1 TO REC-CT. NC1754.2 +135300 SUB-TEST-F2-30-5. NC1754.2 +135400 MOVE "SUB-TEST-F2-30-5" TO PAR-NAME. NC1754.2 +135500 IF WRK-NE-6 = "***.****" NC1754.2 +135600 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +135700 ELSE NC1754.2 +135800 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "***.****" NC1754.2 +135900 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +136000 ADD 1 TO REC-CT. NC1754.2 +136100 SUB-TEST-F2-30-6. NC1754.2 +136200 MOVE "SUB-TEST-F2-30-6" TO PAR-NAME. NC1754.2 +136300 IF SIZE-ERR2 = SPACE NC1754.2 +136400 PERFORM PASS NC1754.2 +136500 PERFORM PRINT-DETAIL NC1754.2 +136600 ELSE NC1754.2 +136700 MOVE SPACE TO CORRECT-X NC1754.2 +136800 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +136900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +137000 TO RE-MARK NC1754.2 +137100 PERFORM FAIL NC1754.2 +137200 PERFORM PRINT-DETAIL. NC1754.2 +137300* NC1754.2 +137400 SUB-INIT-F2-31. NC1754.2 +137500* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +137600* ==--> NO SIZE ERROR <--== NC1754.2 +137700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +137800 MOVE "SUB-TEST-F2-31" TO PAR-NAME. NC1754.2 +137900 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +138000 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +138100 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +138200 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +138300 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +138400 MOVE ZERO TO WRK-NE-4. NC1754.2 +138500 MOVE ZERO TO WRK-NE-6. NC1754.2 +138600 MOVE ZERO TO REC-CT. NC1754.2 +138700 MOVE SPACE TO SIZE-ERR2. NC1754.2 +138800 SUB-TEST-F2-31-0. NC1754.2 +138900 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DS-2V2-1 NC1754.2 +139000 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +139100 WRK-NE-6 ROUNDED NC1754.2 +139200 NOT ON SIZE ERROR NC1754.2 +139300 MOVE "A" TO SIZE-ERR2. NC1754.2 +139400 GO TO SUB-TEST-F2-31-1. NC1754.2 +139500 SUB-DELETE-F2-31. NC1754.2 +139600 PERFORM DE-LETE. NC1754.2 +139700 PERFORM PRINT-DETAIL. NC1754.2 +139800 GO TO SUB-INIT-F2-32. NC1754.2 +139900 SUB-TEST-F2-31-1. NC1754.2 +140000 MOVE "SUB-TEST-F2-31-1" TO PAR-NAME. NC1754.2 +140100 MOVE 1 TO REC-CT. NC1754.2 +140200 IF WRK-DS-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +140300 ELSE NC1754.2 +140400 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE 09.99 NC1754.2 +140500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +140600 ADD 1 TO REC-CT. NC1754.2 +140700 SUB-TEST-F2-31-2. NC1754.2 +140800 MOVE "SUB-TEST-F2-31-2" TO PAR-NAME. NC1754.2 +140900 IF WRK-DS-2V1-1 = 10.0 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +141000 ELSE NC1754.2 +141100 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE 10.0 NC1754.2 +141200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +141300 ADD 1 TO REC-CT. NC1754.2 +141400 SUB-TEST-F2-31-3. NC1754.2 +141500 MOVE "SUB-TEST-F2-31-3" TO PAR-NAME. NC1754.2 +141600 IF WRK-NE-4 = "$*9.99" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +141700 ELSE NC1754.2 +141800 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*9.99" TO NC1754.2 +141900 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +142000 ADD 1 TO REC-CT. NC1754.2 +142100 SUB-TEST-F2-31-4. NC1754.2 +142200 MOVE "SUB-TEST-F2-31-4" TO PAR-NAME. NC1754.2 +142300 IF WRK-NE-6 = "$*9.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +142400 ELSE NC1754.2 +142500 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "$*9.99 " TO NC1754.2 +142600 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +142700 ADD 1 TO REC-CT. NC1754.2 +142800 SUB-TEST-F2-31-5. NC1754.2 +142900 MOVE "SUB-TEST-F2-31-5" TO PAR-NAME. NC1754.2 +143000 IF SIZE-ERR2 = "A" NC1754.2 +143100 PERFORM PASS NC1754.2 +143200 PERFORM PRINT-DETAIL NC1754.2 +143300 ELSE NC1754.2 +143400 MOVE "A" TO CORRECT-X NC1754.2 +143500 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +143600 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +143700 TO RE-MARK NC1754.2 +143800 PERFORM FAIL NC1754.2 +143900 PERFORM PRINT-DETAIL. NC1754.2 +144000* NC1754.2 +144100 SUB-INIT-F2-32. NC1754.2 +144200* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +144300* ==--> SIZE ERROR <--== NC1754.2 +144400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +144500 MOVE "SUB-TEST-F2-32" TO PAR-NAME. NC1754.2 +144600 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +144700 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +144800 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +144900 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +145000 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +145100 MOVE ZERO TO WRK-NE-4. NC1754.2 +145200 MOVE ZERO TO WRK-NE-5 NC1754.2 +145300 MOVE ZERO TO WRK-NE-6. NC1754.2 +145400 MOVE ZERO TO REC-CT. NC1754.2 +145500 MOVE SPACE TO SIZE-ERR2. NC1754.2 +145600 SUB-TEST-F2-32-0. NC1754.2 +145700 SUBTRACT A16TWOS-DS-16V00 NC1754.2 +145800 2 WRK-DU-0V1-1 .04 NC1754.2 +145900 FROM WRK-DS-2V2-1 NC1754.2 +146000 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +146100 WRK-NE-5 WRK-NE-6 ROUNDED NC1754.2 +146200 ON SIZE ERROR NC1754.2 +146300 MOVE "A" TO SIZE-ERR2 NC1754.2 +146400 NOT ON SIZE ERROR NC1754.2 +146500 MOVE "B" TO SIZE-ERR2. NC1754.2 +146600 GO TO SUB-TEST-F2-32-1. NC1754.2 +146700 SUB-DELETE-F2-32. NC1754.2 +146800 PERFORM DE-LETE. NC1754.2 +146900 PERFORM PRINT-DETAIL. NC1754.2 +147000 GO TO SUB-INIT-F2-33. NC1754.2 +147100 SUB-TEST-F2-32-1. NC1754.2 +147200 MOVE "SUB-TEST-F2-32-1" TO PAR-NAME. NC1754.2 +147300 MOVE 1 TO REC-CT. NC1754.2 +147400 IF WRK-DS-2V2-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +147500 ELSE NC1754.2 +147600 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE ZERO NC1754.2 +147700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +147800 ADD 1 TO REC-CT. NC1754.2 +147900 SUB-TEST-F2-32-2. NC1754.2 +148000 MOVE "SUB-TEST-F2-32-2" TO PAR-NAME. NC1754.2 +148100 IF WRK-DS-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +148200 ELSE NC1754.2 +148300 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE ZERO NC1754.2 +148400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +148500 ADD 1 TO REC-CT. NC1754.2 +148600 SUB-TEST-F2-32-3. NC1754.2 +148700 MOVE "SUB-TEST-F2-32-3" TO PAR-NAME. NC1754.2 +148800 IF WRK-NE-4 = "$*0.00" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +148900 ELSE NC1754.2 +149000 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*0.00" NC1754.2 +149100 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +149200 ADD 1 TO REC-CT. NC1754.2 +149300 SUB-TEST-F2-32-4. NC1754.2 +149400 MOVE "SUB-TEST-F2-32-4" TO PAR-NAME. NC1754.2 +149500 IF WRK-NE-5 = "*.**" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +149600 ELSE NC1754.2 +149700 PERFORM FAIL MOVE WRK-NE-5 TO COMPUTED-A MOVE "*.**" NC1754.2 +149800 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +149900 ADD 1 TO REC-CT. NC1754.2 +150000 SUB-TEST-F2-32-5. NC1754.2 +150100 MOVE "SUB-TEST-F2-32-5" TO PAR-NAME. NC1754.2 +150200 IF WRK-NE-6 = "***.****" NC1754.2 +150300 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +150400 ELSE NC1754.2 +150500 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "***.****" NC1754.2 +150600 TO CORRECT-X PERFORM PRINT-DETAIL. NC1754.2 +150700 ADD 1 TO REC-CT. NC1754.2 +150800 SUB-TEST-F2-32-6. NC1754.2 +150900 MOVE "SUB-TEST-F2-32-6" TO PAR-NAME. NC1754.2 +151000 IF SIZE-ERR2 = "A" NC1754.2 +151100 PERFORM PASS NC1754.2 +151200 PERFORM PRINT-DETAIL NC1754.2 +151300 ELSE NC1754.2 +151400 MOVE "A" TO CORRECT-X NC1754.2 +151500 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +151600 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +151700 TO RE-MARK NC1754.2 +151800 PERFORM FAIL NC1754.2 +151900 PERFORM PRINT-DETAIL. NC1754.2 +152000* NC1754.2 +152100 SUB-INIT-F2-33. NC1754.2 +152200* ==--> MULTIPLE RESULT FIELDS <--== NC1754.2 +152300* ==--> NO SIZE ERROR <--== NC1754.2 +152400 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1754.2 +152500 MOVE "SUB-TEST-F2-33" TO PAR-NAME. NC1754.2 +152600 MOVE 10 TO WRK-DU-2V0-1. NC1754.2 +152700 MOVE 22.33 TO WRK-DS-2V2-1. NC1754.2 +152800 MOVE .3 TO WRK-DU-0V1-1. NC1754.2 +152900 MOVE ZERO TO WRK-DS-2V2-2. NC1754.2 +153000 MOVE ZERO TO WRK-DS-2V1-1. NC1754.2 +153100 MOVE ZERO TO WRK-NE-4. NC1754.2 +153200 MOVE ZERO TO WRK-NE-6. NC1754.2 +153300 MOVE ZERO TO REC-CT. NC1754.2 +153400 MOVE SPACE TO SIZE-ERR2. NC1754.2 +153500 SUB-TEST-F2-33-0. NC1754.2 +153600 SUBTRACT WRK-DU-2V0-1 2 WRK-DU-0V1-1 .04 FROM WRK-DS-2V2-1 NC1754.2 +153700 GIVING WRK-DS-2V2-2 WRK-DS-2V1-1 ROUNDED WRK-NE-4 NC1754.2 +153800 WRK-NE-6 ROUNDED NC1754.2 +153900 ON SIZE ERROR NC1754.2 +154000 MOVE "A" TO SIZE-ERR2 NC1754.2 +154100 NOT ON SIZE ERROR NC1754.2 +154200 MOVE "B" TO SIZE-ERR2. NC1754.2 +154300 GO TO SUB-TEST-F2-33-1. NC1754.2 +154400 SUB-DELETE-F2-33. NC1754.2 +154500 PERFORM DE-LETE. NC1754.2 +154600 PERFORM PRINT-DETAIL. NC1754.2 +154700 GO TO SUB-INIT-F2-34. NC1754.2 +154800 SUB-TEST-F2-33-1. NC1754.2 +154900 MOVE "SUB-TEST-F2-33-1" TO PAR-NAME. NC1754.2 +155000 MOVE 1 TO REC-CT. NC1754.2 +155100 IF WRK-DS-2V2-2 = 09.99 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +155200 ELSE NC1754.2 +155300 PERFORM FAIL MOVE WRK-DS-2V2-2 TO COMPUTED-N MOVE 09.99 NC1754.2 +155400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +155500 ADD 1 TO REC-CT. NC1754.2 +155600 SUB-TEST-F2-33-2. NC1754.2 +155700 MOVE "SUB-TEST-F2-33-2" TO PAR-NAME. NC1754.2 +155800 IF WRK-DS-2V1-1 = 10.0 PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +155900 ELSE NC1754.2 +156000 PERFORM FAIL MOVE WRK-DS-2V1-1 TO COMPUTED-N MOVE 10.0 NC1754.2 +156100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1754.2 +156200 ADD 1 TO REC-CT. NC1754.2 +156300 SUB-TEST-F2-33-3. NC1754.2 +156400 MOVE "SUB-TEST-F2-33-3" TO PAR-NAME. NC1754.2 +156500 IF WRK-NE-4 = "$*9.99" PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +156600 ELSE NC1754.2 +156700 PERFORM FAIL MOVE WRK-NE-4 TO COMPUTED-A MOVE "$*9.99" TO NC1754.2 +156800 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +156900 ADD 1 TO REC-CT. NC1754.2 +157000 SUB-TEST-F2-33-4. NC1754.2 +157100 MOVE "SUB-TEST-F2-33-4" TO PAR-NAME. NC1754.2 +157200 IF WRK-NE-6 = "$*9.99 " PERFORM PASS PERFORM PRINT-DETAIL NC1754.2 +157300 ELSE NC1754.2 +157400 PERFORM FAIL MOVE WRK-NE-6 TO COMPUTED-A MOVE "$*9.99 " TO NC1754.2 +157500 CORRECT-A PERFORM PRINT-DETAIL. NC1754.2 +157600 ADD 1 TO REC-CT. NC1754.2 +157700 SUB-TEST-F2-33-5. NC1754.2 +157800 MOVE "SUB-TEST-F2-33-5" TO PAR-NAME. NC1754.2 +157900 IF SIZE-ERR2 = "B" NC1754.2 +158000 PERFORM PASS NC1754.2 +158100 PERFORM PRINT-DETAIL NC1754.2 +158200 ELSE NC1754.2 +158300 MOVE "B" TO CORRECT-X NC1754.2 +158400 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +158500 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +158600 TO RE-MARK NC1754.2 +158700 PERFORM FAIL NC1754.2 +158800 PERFORM PRINT-DETAIL. NC1754.2 +158900* NC1754.2 +159000 SUB-INIT-F2-34. NC1754.2 +159100* ==--> EXPLICIT SCOPE TERMINATOR <--== NC1754.2 +159200* ==--> SIZE ERROR <--== NC1754.2 +159300 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +159400 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +159500 MOVE SPACE TO WRK-XN-00001. NC1754.2 +159600 MOVE SPACE TO SIZE-ERR2. NC1754.2 +159700 MOVE SPACE TO SIZE-ERR3. NC1754.2 +159800 MOVE SPACE TO SIZE-ERR4. NC1754.2 +159900 MOVE 1 TO REC-CT. NC1754.2 +160000 SUB-TEST-F2-34-0. NC1754.2 +160100 SUBTRACT A12ONES-DS-12V00 NC1754.2 +160200 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +160300 ON SIZE ERROR NC1754.2 +160400 MOVE "1" TO WRK-XN-00001 NC1754.2 +160500 MOVE "A" TO SIZE-ERR2 NC1754.2 +160600 MOVE "B" TO SIZE-ERR3 NC1754.2 +160700 END-SUBTRACT NC1754.2 +160800 MOVE "C" TO SIZE-ERR4. NC1754.2 +160900 GO TO SUB-TEST-F2-34-1. NC1754.2 +161000 SUB-DELETE-F2-34. NC1754.2 +161100 PERFORM DE-LETE. NC1754.2 +161200 PERFORM PRINT-DETAIL. NC1754.2 +161300 GO TO SUB-INIT-F2-35. NC1754.2 +161400 SUB-TEST-F2-34-1. NC1754.2 +161500 MOVE "SUB-TEST-F2-34-1" TO PAR-NAME. NC1754.2 +161600 IF WRK-XN-00001 = "1" NC1754.2 +161700 PERFORM PASS NC1754.2 +161800 PERFORM PRINT-DETAIL NC1754.2 +161900 ELSE NC1754.2 +162000 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +162100 TO RE-MARK NC1754.2 +162200 MOVE "1" TO CORRECT-X NC1754.2 +162300 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +162400 PERFORM FAIL NC1754.2 +162500 PERFORM PRINT-DETAIL. NC1754.2 +162600 ADD 1 TO REC-CT. NC1754.2 +162700 SUB-TEST-F2-34-2. NC1754.2 +162800 MOVE "SUB-TEST-F2-34-2" TO PAR-NAME. NC1754.2 +162900 IF SIZE-ERR2 = "A" NC1754.2 +163000 PERFORM PASS NC1754.2 +163100 PERFORM PRINT-DETAIL NC1754.2 +163200 ELSE NC1754.2 +163300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +163400 TO RE-MARK NC1754.2 +163500 MOVE "A" TO CORRECT-X NC1754.2 +163600 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +163700 PERFORM FAIL NC1754.2 +163800 PERFORM PRINT-DETAIL. NC1754.2 +163900 ADD 1 TO REC-CT. NC1754.2 +164000 SUB-TEST-F2-34-3. NC1754.2 +164100 MOVE "SUB-TEST-F2-34-3" TO PAR-NAME. NC1754.2 +164200 IF SIZE-ERR3 = "B" NC1754.2 +164300 PERFORM PASS NC1754.2 +164400 PERFORM PRINT-DETAIL NC1754.2 +164500 ELSE NC1754.2 +164600 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +164700 TO RE-MARK NC1754.2 +164800 MOVE "B" TO CORRECT-X NC1754.2 +164900 MOVE SIZE-ERR3 TO COMPUTED-X NC1754.2 +165000 PERFORM FAIL NC1754.2 +165100 PERFORM PRINT-DETAIL. NC1754.2 +165200 ADD 1 TO REC-CT. NC1754.2 +165300 SUB-TEST-F2-34-4. NC1754.2 +165400 MOVE "SUB-TEST-F2-34-4" TO PAR-NAME. NC1754.2 +165500 IF SIZE-ERR4 = "C" NC1754.2 +165600 PERFORM PASS NC1754.2 +165700 PERFORM PRINT-DETAIL NC1754.2 +165800 ELSE NC1754.2 +165900 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +166000 TO RE-MARK NC1754.2 +166100 MOVE "C" TO CORRECT-X NC1754.2 +166200 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +166300 PERFORM FAIL NC1754.2 +166400 PERFORM PRINT-DETAIL NC1754.2 +166500 ADD 1 TO REC-CT. NC1754.2 +166600 SUB-TEST-F2-34-5. NC1754.2 +166700 MOVE "SUB-TEST-F2-34-5" TO PAR-NAME. NC1754.2 +166800 IF WRK-DS-10V00 = ZERO NC1754.2 +166900 PERFORM PASS NC1754.2 +167000 PERFORM PRINT-DETAIL NC1754.2 +167100 ELSE NC1754.2 +167200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +167300 TO RE-MARK NC1754.2 +167400 MOVE ZERO TO CORRECT-N NC1754.2 +167500 MOVE WRK-DS-10V00 TO COMPUTED-N NC1754.2 +167600 PERFORM FAIL NC1754.2 +167700 PERFORM PRINT-DETAIL. NC1754.2 +167800* NC1754.2 +167900 SUB-INIT-F2-35. NC1754.2 +168000* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +168100 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +168200 MOVE "SUB-TEST-F2-35" TO PAR-NAME. NC1754.2 +168300 MOVE SPACE TO WRK-XN-00001. NC1754.2 +168400 MOVE SPACE TO SIZE-ERR2. NC1754.2 +168500 MOVE SPACE TO SIZE-ERR3. NC1754.2 +168600 MOVE SPACE TO SIZE-ERR4. NC1754.2 +168700 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +168800 MOVE 1 TO REC-CT. NC1754.2 +168900 SUB-TEST-F2-35-0. NC1754.2 +169000 SUBTRACT A12THREES-DS-06V06 NC1754.2 +169100 333333 NC1754.2 +169200 A06THREES-DS-03V03 NC1754.2 +169300 -.0000009 FROM 0000000 NC1754.2 +169400 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +169500 ON SIZE ERROR NC1754.2 +169600 MOVE "1" TO WRK-XN-00001 NC1754.2 +169700 MOVE "A" TO SIZE-ERR2 NC1754.2 +169800 MOVE "B" TO SIZE-ERR3 NC1754.2 +169900 END-SUBTRACT NC1754.2 +170000 MOVE "C" TO SIZE-ERR4. NC1754.2 +170100 GO TO SUB-TEST-F2-35-1. NC1754.2 +170200 SUB-DELETE-F2-35. NC1754.2 +170300 PERFORM DE-LETE. NC1754.2 +170400 PERFORM PRINT-DETAIL. NC1754.2 +170500 GO TO SUB-INIT-F2-36. NC1754.2 +170600 SUB-TEST-F2-35-1. NC1754.2 +170700 MOVE "SUB-TEST-F2-35-1" TO PAR-NAME. NC1754.2 +170800 IF WRK-XN-00001 = SPACE NC1754.2 +170900 PERFORM PASS NC1754.2 +171000 PERFORM PRINT-DETAIL NC1754.2 +171100 ELSE NC1754.2 +171200 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +171300 TO RE-MARK NC1754.2 +171400 MOVE SPACE TO CORRECT-X NC1754.2 +171500 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +171600 PERFORM FAIL NC1754.2 +171700 PERFORM PRINT-DETAIL. NC1754.2 +171800 ADD 1 TO REC-CT. NC1754.2 +171900 SUB-TEST-F2-35-2. NC1754.2 +172000 MOVE "SUB-TEST-F2-35-2" TO PAR-NAME. NC1754.2 +172100 IF SIZE-ERR2 = SPACE NC1754.2 +172200 PERFORM PASS NC1754.2 +172300 PERFORM PRINT-DETAIL NC1754.2 +172400 ELSE NC1754.2 +172500 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +172600 TO RE-MARK NC1754.2 +172700 MOVE SPACE TO CORRECT-X NC1754.2 +172800 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +172900 PERFORM FAIL NC1754.2 +173000 PERFORM PRINT-DETAIL. NC1754.2 +173100 ADD 1 TO REC-CT. NC1754.2 +173200 SUB-TEST-F2-35-3. NC1754.2 +173300 MOVE "SUB-TEST-F2-35-3" TO PAR-NAME. NC1754.2 +173400 IF SIZE-ERR3 = SPACE NC1754.2 +173500 PERFORM PASS NC1754.2 +173600 PERFORM PRINT-DETAIL NC1754.2 +173700 ELSE NC1754.2 +173800 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +173900 TO RE-MARK NC1754.2 +174000 MOVE SPACE TO CORRECT-X NC1754.2 +174100 MOVE SIZE-ERR3 TO COMPUTED-X NC1754.2 +174200 PERFORM FAIL NC1754.2 +174300 PERFORM PRINT-DETAIL. NC1754.2 +174400 ADD 1 TO REC-CT. NC1754.2 +174500 SUB-TEST-F2-35-4. NC1754.2 +174600 MOVE "SUB-TEST-F2-35-4" TO PAR-NAME. NC1754.2 +174700 IF SIZE-ERR4 = "C" NC1754.2 +174800 PERFORM PASS NC1754.2 +174900 PERFORM PRINT-DETAIL NC1754.2 +175000 ELSE NC1754.2 +175100 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +175200 TO RE-MARK NC1754.2 +175300 MOVE "C" TO CORRECT-X NC1754.2 +175400 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +175500 PERFORM FAIL NC1754.2 +175600 PERFORM PRINT-DETAIL. NC1754.2 +175700 ADD 1 TO REC-CT. NC1754.2 +175800 SUB-TEST-F2-35-5. NC1754.2 +175900 MOVE "SUB-TEST-F1-35-5" TO PAR-NAME. NC1754.2 +176000 IF WRK-DS-06V06 = -666999.666332 NC1754.2 +176100 PERFORM PASS NC1754.2 +176200 PERFORM PRINT-DETAIL NC1754.2 +176300 ELSE NC1754.2 +176400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +176500 TO RE-MARK NC1754.2 +176600 MOVE -666999.666332 TO CORRECT-N NC1754.2 +176700 MOVE WRK-DS-06V06 TO COMPUTED-N NC1754.2 +176800 PERFORM FAIL NC1754.2 +176900 PERFORM PRINT-DETAIL. NC1754.2 +177000* NC1754.2 +177100 SUB-INIT-F2-36. NC1754.2 +177200* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +177300 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +177400 MOVE "SUB-TEST-F2-36" TO PAR-NAME. NC1754.2 +177500 MOVE SPACE TO WRK-XN-00001. NC1754.2 +177600 MOVE SPACE TO SIZE-ERR2. NC1754.2 +177700 MOVE SPACE TO SIZE-ERR3. NC1754.2 +177800 MOVE SPACE TO SIZE-ERR4. NC1754.2 +177900 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +178000 MOVE 1 TO REC-CT. NC1754.2 +178100 SUB-TEST-F2-36-0. NC1754.2 +178200 SUBTRACT A12ONES-DS-12V00 NC1754.2 +178300 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +178400 NOT ON SIZE ERROR NC1754.2 +178500 MOVE "1" TO WRK-XN-00001 NC1754.2 +178600 MOVE "A" TO SIZE-ERR2 NC1754.2 +178700 MOVE "B" TO SIZE-ERR3 NC1754.2 +178800 END-SUBTRACT NC1754.2 +178900 MOVE "C" TO SIZE-ERR4. NC1754.2 +179000 GO TO SUB-TEST-F2-36-1. NC1754.2 +179100 SUB-DELETE-F2-36. NC1754.2 +179200 PERFORM DE-LETE. NC1754.2 +179300 PERFORM PRINT-DETAIL. NC1754.2 +179400 GO TO SUB-INIT-F2-37. NC1754.2 +179500 SUB-TEST-F2-36-1. NC1754.2 +179600 MOVE "SUB-TEST-F2-36-1" TO PAR-NAME. NC1754.2 +179700 IF WRK-XN-00001 = SPACE NC1754.2 +179800 PERFORM PASS NC1754.2 +179900 PERFORM PRINT-DETAIL NC1754.2 +180000 ELSE NC1754.2 +180100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +180200 TO RE-MARK NC1754.2 +180300 MOVE SPACE TO CORRECT-X NC1754.2 +180400 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +180500 PERFORM FAIL NC1754.2 +180600 PERFORM PRINT-DETAIL. NC1754.2 +180700 ADD 1 TO REC-CT. NC1754.2 +180800 SUB-TEST-F2-36-2. NC1754.2 +180900 MOVE "SUB-TEST-F2-36-2" TO PAR-NAME. NC1754.2 +181000 IF SIZE-ERR2 = SPACE NC1754.2 +181100 PERFORM PASS NC1754.2 +181200 PERFORM PRINT-DETAIL NC1754.2 +181300 ELSE NC1754.2 +181400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +181500 TO RE-MARK NC1754.2 +181600 MOVE SPACE TO CORRECT-X NC1754.2 +181700 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +181800 PERFORM FAIL NC1754.2 +181900 PERFORM PRINT-DETAIL. NC1754.2 +182000 ADD 1 TO REC-CT. NC1754.2 +182100 SUB-TEST-F2-36-3. NC1754.2 +182200 MOVE "SUB-TEST-F2-36-3" TO PAR-NAME. NC1754.2 +182300 IF SIZE-ERR3 = SPACE NC1754.2 +182400 PERFORM PASS NC1754.2 +182500 PERFORM PRINT-DETAIL NC1754.2 +182600 ELSE NC1754.2 +182700 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1754.2 +182800 TO RE-MARK NC1754.2 +182900 MOVE SPACE TO CORRECT-X NC1754.2 +183000 MOVE SIZE-ERR3 TO COMPUTED-X NC1754.2 +183100 PERFORM FAIL NC1754.2 +183200 PERFORM PRINT-DETAIL. NC1754.2 +183300 ADD 1 TO REC-CT. NC1754.2 +183400 SUB-TEST-F2-36-4. NC1754.2 +183500 MOVE "SUB-TEST-F2-36-4" TO PAR-NAME. NC1754.2 +183600 IF SIZE-ERR4 = "C" NC1754.2 +183700 PERFORM PASS NC1754.2 +183800 PERFORM PRINT-DETAIL NC1754.2 +183900 ELSE NC1754.2 +184000 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +184100 TO RE-MARK NC1754.2 +184200 MOVE "C" TO CORRECT-X NC1754.2 +184300 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +184400 PERFORM FAIL NC1754.2 +184500 PERFORM PRINT-DETAIL NC1754.2 +184600 ADD 1 TO REC-CT. NC1754.2 +184700 SUB-TEST-F2-36-5. NC1754.2 +184800 MOVE "SUB-TEST-F2-36-5" TO PAR-NAME. NC1754.2 +184900 IF WRK-DS-10V00 = ZERO NC1754.2 +185000 PERFORM PASS NC1754.2 +185100 PERFORM PRINT-DETAIL NC1754.2 +185200 ELSE NC1754.2 +185300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +185400 TO RE-MARK NC1754.2 +185500 MOVE ZERO TO CORRECT-N NC1754.2 +185600 MOVE WRK-DS-10V00 TO COMPUTED-N NC1754.2 +185700 PERFORM FAIL NC1754.2 +185800 PERFORM PRINT-DETAIL. NC1754.2 +185900* NC1754.2 +186000 SUB-INIT-F2-37. NC1754.2 +186100* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +186200 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +186300 MOVE "SUB-TEST-F2-37" TO PAR-NAME. NC1754.2 +186400 MOVE SPACE TO WRK-XN-00001. NC1754.2 +186500 MOVE SPACE TO SIZE-ERR2. NC1754.2 +186600 MOVE SPACE TO SIZE-ERR3. NC1754.2 +186700 MOVE SPACE TO SIZE-ERR4. NC1754.2 +186800 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +186900 MOVE 1 TO REC-CT. NC1754.2 +187000 SUB-TEST-F2-37-0. NC1754.2 +187100 SUBTRACT A12THREES-DS-06V06 NC1754.2 +187200 333333 NC1754.2 +187300 A06THREES-DS-03V03 NC1754.2 +187400 -.0000009 FROM 0000000 NC1754.2 +187500 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +187600 NOT ON SIZE ERROR NC1754.2 +187700 MOVE "1" TO WRK-XN-00001 NC1754.2 +187800 MOVE "A" TO SIZE-ERR2 NC1754.2 +187900 MOVE "B" TO SIZE-ERR3 NC1754.2 +188000 END-SUBTRACT NC1754.2 +188100 MOVE "C" TO SIZE-ERR4. NC1754.2 +188200 GO TO SUB-TEST-F2-37-1. NC1754.2 +188300 SUB-DELETE-F2-37. NC1754.2 +188400 PERFORM DE-LETE. NC1754.2 +188500 PERFORM PRINT-DETAIL. NC1754.2 +188600 GO TO SUB-INIT-F2-38. NC1754.2 +188700 SUB-TEST-F2-37-1. NC1754.2 +188800 MOVE "SUB-TEST-F2-37-1" TO PAR-NAME. NC1754.2 +188900 IF WRK-XN-00001 = "1" NC1754.2 +189000 PERFORM PASS NC1754.2 +189100 PERFORM PRINT-DETAIL NC1754.2 +189200 ELSE NC1754.2 +189300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +189400 TO RE-MARK NC1754.2 +189500 MOVE "1" TO CORRECT-X NC1754.2 +189600 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +189700 PERFORM FAIL NC1754.2 +189800 PERFORM PRINT-DETAIL. NC1754.2 +189900 ADD 1 TO REC-CT. NC1754.2 +190000 SUB-TEST-F2-37-2. NC1754.2 +190100 MOVE "SUB-TEST-F2-37-2" TO PAR-NAME. NC1754.2 +190200 IF SIZE-ERR2 = "A" NC1754.2 +190300 PERFORM PASS NC1754.2 +190400 PERFORM PRINT-DETAIL NC1754.2 +190500 ELSE NC1754.2 +190600 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +190700 TO RE-MARK NC1754.2 +190800 MOVE "A" TO CORRECT-X NC1754.2 +190900 MOVE SIZE-ERR2 TO COMPUTED-X NC1754.2 +191000 PERFORM FAIL NC1754.2 +191100 PERFORM PRINT-DETAIL. NC1754.2 +191200 ADD 1 TO REC-CT. NC1754.2 +191300 SUB-TEST-F2-37-3. NC1754.2 +191400 MOVE "SUB-TEST-F2-37-3" TO PAR-NAME. NC1754.2 +191500 IF SIZE-ERR3 = "B" NC1754.2 +191600 PERFORM PASS NC1754.2 +191700 PERFORM PRINT-DETAIL NC1754.2 +191800 ELSE NC1754.2 +191900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +192000 TO RE-MARK NC1754.2 +192100 MOVE "B" TO CORRECT-X NC1754.2 +192200 MOVE SIZE-ERR3 TO COMPUTED-X NC1754.2 +192300 PERFORM FAIL NC1754.2 +192400 PERFORM PRINT-DETAIL. NC1754.2 +192500 ADD 1 TO REC-CT. NC1754.2 +192600 SUB-TEST-F2-37-4. NC1754.2 +192700 MOVE "SUB-TEST-F2-37-4" TO PAR-NAME. NC1754.2 +192800 IF SIZE-ERR4 = "C" NC1754.2 +192900 PERFORM PASS NC1754.2 +193000 PERFORM PRINT-DETAIL NC1754.2 +193100 ELSE NC1754.2 +193200 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +193300 TO RE-MARK NC1754.2 +193400 MOVE "C" TO CORRECT-X NC1754.2 +193500 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +193600 PERFORM FAIL NC1754.2 +193700 PERFORM PRINT-DETAIL. NC1754.2 +193800 ADD 1 TO REC-CT. NC1754.2 +193900 SUB-TEST-F2-37-5. NC1754.2 +194000 MOVE "SUB-TEST-F2-37-5" TO PAR-NAME. NC1754.2 +194100 IF WRK-DS-06V06 = -666999.666332 NC1754.2 +194200 PERFORM PASS NC1754.2 +194300 PERFORM PRINT-DETAIL NC1754.2 +194400 ELSE NC1754.2 +194500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +194600 TO RE-MARK NC1754.2 +194700 MOVE -666999.666332 TO CORRECT-N NC1754.2 +194800 MOVE WRK-DS-06V06 TO COMPUTED-N NC1754.2 +194900 PERFORM FAIL NC1754.2 +195000 PERFORM PRINT-DETAIL. NC1754.2 +195100* NC1754.2 +195200 SUB-INIT-F2-38. NC1754.2 +195300* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +195400 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +195500 MOVE "SUB-TEST-F2-38" TO PAR-NAME. NC1754.2 +195600 MOVE "0" TO WRK-XN-00001. NC1754.2 +195700 MOVE "0" TO SIZE-ERR4. NC1754.2 +195800 MOVE ZERO TO WRK-DS-10V00. NC1754.2 +195900 MOVE 1 TO REC-CT. NC1754.2 +196000 SUB-TEST-F2-38-0. NC1754.2 +196100 SUBTRACT A12ONES-DS-12V00 NC1754.2 +196200 FROM ZERO GIVING WRK-DS-10V00 NC1754.2 +196300 ON SIZE ERROR NC1754.2 +196400 MOVE SPACE TO WRK-XN-00001 NC1754.2 +196500 NOT ON SIZE ERROR NC1754.2 +196600 MOVE "1" TO WRK-XN-00001 NC1754.2 +196700 END-SUBTRACT NC1754.2 +196800 MOVE "C" TO SIZE-ERR4. NC1754.2 +196900 GO TO SUB-TEST-F2-38-1. NC1754.2 +197000 SUB-DELETE-F2-38. NC1754.2 +197100 PERFORM DE-LETE. NC1754.2 +197200 PERFORM PRINT-DETAIL. NC1754.2 +197300 GO TO SUB-INIT-F2-39. NC1754.2 +197400 SUB-TEST-F2-38-1. NC1754.2 +197500 MOVE "SUB-TEST-F2-38-1" TO PAR-NAME. NC1754.2 +197600 IF WRK-XN-00001 = SPACE NC1754.2 +197700 PERFORM PASS NC1754.2 +197800 PERFORM PRINT-DETAIL NC1754.2 +197900 ELSE NC1754.2 +198000 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +198100 TO RE-MARK NC1754.2 +198200 MOVE SPACE TO CORRECT-X NC1754.2 +198300 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +198400 PERFORM FAIL NC1754.2 +198500 PERFORM PRINT-DETAIL. NC1754.2 +198600 ADD 1 TO REC-CT. NC1754.2 +198700 SUB-TEST-F2-38-2. NC1754.2 +198800 MOVE "SUB-TEST-F2-38-2" TO PAR-NAME. NC1754.2 +198900 IF SIZE-ERR4 = "C" NC1754.2 +199000 PERFORM PASS NC1754.2 +199100 PERFORM PRINT-DETAIL NC1754.2 +199200 ELSE NC1754.2 +199300 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +199400 TO RE-MARK NC1754.2 +199500 MOVE "C" TO CORRECT-X NC1754.2 +199600 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +199700 PERFORM FAIL NC1754.2 +199800 PERFORM PRINT-DETAIL. NC1754.2 +199900 ADD 1 TO REC-CT. NC1754.2 +200000 SUB-TEST-F2-38-3. NC1754.2 +200100 MOVE "SUB-TEST-F2-38-3" TO PAR-NAME. NC1754.2 +200200 IF WRK-DS-10V00 = ZERO NC1754.2 +200300 PERFORM PASS NC1754.2 +200400 PERFORM PRINT-DETAIL NC1754.2 +200500 ELSE NC1754.2 +200600 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +200700 TO RE-MARK NC1754.2 +200800 MOVE ZERO TO CORRECT-N NC1754.2 +200900 MOVE WRK-DS-02V00 TO COMPUTED-N NC1754.2 +201000 PERFORM FAIL NC1754.2 +201100 PERFORM PRINT-DETAIL. NC1754.2 +201200* NC1754.2 +201300 SUB-INIT-F2-39. NC1754.2 +201400* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1754.2 +201500 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1754.2 +201600 MOVE "SUB-TEST-F2-39" TO PAR-NAME. NC1754.2 +201700 MOVE SPACE TO WRK-XN-00001. NC1754.2 +201800 MOVE SPACE TO SIZE-ERR4. NC1754.2 +201900 MOVE ZERO TO WRK-DS-06V06. NC1754.2 +202000 MOVE 1 TO REC-CT. NC1754.2 +202100 SUB-TEST-F2-39-0. NC1754.2 +202200 SUBTRACT A12THREES-DS-06V06 NC1754.2 +202300 333333 NC1754.2 +202400 A06THREES-DS-03V03 NC1754.2 +202500 -.0000009 FROM 0000000 NC1754.2 +202600 GIVING WRK-DS-06V06 ROUNDED NC1754.2 +202700 ON SIZE ERROR NC1754.2 +202800 MOVE "X" TO WRK-XN-00001 NC1754.2 +202900 NOT ON SIZE ERROR NC1754.2 +203000 MOVE "1" TO WRK-XN-00001 NC1754.2 +203100 END-SUBTRACT NC1754.2 +203200 MOVE "C" TO SIZE-ERR4. NC1754.2 +203300 GO TO SUB-TEST-F2-39-1. NC1754.2 +203400 SUB-DELETE-F2-39. NC1754.2 +203500 PERFORM DE-LETE. NC1754.2 +203600 PERFORM PRINT-DETAIL. NC1754.2 +203700 GO TO CCVS-EXIT. NC1754.2 +203800 SUB-TEST-F2-39-1. NC1754.2 +203900 MOVE "SUB-TEST-F2-39-1" TO PAR-NAME. NC1754.2 +204000 IF WRK-XN-00001 = "1" NC1754.2 +204100 PERFORM PASS NC1754.2 +204200 PERFORM PRINT-DETAIL NC1754.2 +204300 ELSE NC1754.2 +204400 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1754.2 +204500 TO RE-MARK NC1754.2 +204600 MOVE "1" TO CORRECT-X NC1754.2 +204700 MOVE WRK-XN-00001 TO COMPUTED-X NC1754.2 +204800 PERFORM FAIL NC1754.2 +204900 PERFORM PRINT-DETAIL. NC1754.2 +205000 ADD 1 TO REC-CT. NC1754.2 +205100 SUB-TEST-F2-39-2. NC1754.2 +205200 MOVE "SUB-TEST-F2-39-2" TO PAR-NAME. NC1754.2 +205300 IF SIZE-ERR4 = "C" NC1754.2 +205400 PERFORM PASS NC1754.2 +205500 PERFORM PRINT-DETAIL NC1754.2 +205600 ELSE NC1754.2 +205700 MOVE "SCOPE TERMINATOR IGNORED" NC1754.2 +205800 TO RE-MARK NC1754.2 +205900 MOVE "C" TO CORRECT-X NC1754.2 +206000 MOVE SIZE-ERR4 TO COMPUTED-X NC1754.2 +206100 PERFORM FAIL NC1754.2 +206200 PERFORM PRINT-DETAIL. NC1754.2 +206300 ADD 1 TO REC-CT. NC1754.2 +206400 SUB-TEST-F2-39-3. NC1754.2 +206500 MOVE "SUB-TEST-F2-39-3" TO PAR-NAME. NC1754.2 +206600 IF WRK-DS-06V06 = -666999.666332 NC1754.2 +206700 PERFORM PASS NC1754.2 +206800 PERFORM PRINT-DETAIL NC1754.2 +206900 ELSE NC1754.2 +207000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1754.2 +207100 TO RE-MARK NC1754.2 +207200 MOVE -666999.666332 TO CORRECT-N NC1754.2 +207300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1754.2 +207400 PERFORM FAIL NC1754.2 +207500 PERFORM PRINT-DETAIL. NC1754.2 +207600* NC1754.2 +207700 CCVS-EXIT SECTION. NC1754.2 +207800 CCVS-999999. NC1754.2 +207900 GO TO CLOSE-FILES. NC1754.2 diff --git a/tests/cobol85/NC/NC176A.CBL b/tests/cobol85/NC/NC176A.CBL new file mode 100755 index 00000000..a21f45a4 --- /dev/null +++ b/tests/cobol85/NC/NC176A.CBL @@ -0,0 +1,2417 @@ +000100 IDENTIFICATION DIVISION. NC1764.2 +000200 PROGRAM-ID. NC1764.2 +000300 NC176A. NC1764.2 +000400**************************************************************** NC1764.2 +000500* * NC1764.2 +000600* VALIDATION FOR:- * NC1764.2 +000700* * NC1764.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1764.2 +000900* * NC1764.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1764.2 +001100* * NC1764.2 +001200**************************************************************** NC1764.2 +001300* * NC1764.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1764.2 +001500* * NC1764.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1764.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1764.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1764.2 +001900* * NC1764.2 +002000**************************************************************** NC1764.2 +002100* NC1764.2 +002200* PROGRAM NC176A TESTS FORMAT 1 OF THE ADD STATEMENT. NC1764.2 +002300* VARIOUS COMBINATINS OF DATA-ITEMS AND ALL NC1764.2 +002400* OPTIONAL PHRASES ARE TESTED. NC1764.2 +002500* NC1764.2 +002600 ENVIRONMENT DIVISION. NC1764.2 +002700 CONFIGURATION SECTION. NC1764.2 +002800 SOURCE-COMPUTER. NC1764.2 +002900 Linux. NC1764.2 +003000 OBJECT-COMPUTER. NC1764.2 +003100 Linux. NC1764.2 +003200 INPUT-OUTPUT SECTION. NC1764.2 +003300 FILE-CONTROL. NC1764.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1764.2 +003500 "report.log". NC1764.2 +003600 DATA DIVISION. NC1764.2 +003700 FILE SECTION. NC1764.2 +003800 FD PRINT-FILE. NC1764.2 +003900 01 PRINT-REC PICTURE X(120). NC1764.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1764.2 +004100 WORKING-STORAGE SECTION. NC1764.2 +004200 01 42-DATANAMES. NC1764.2 +004300 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC1764.2 +004400 02 DNAME2 PICTURE 99 VALUE 1 COMPUTATIONAL. NC1764.2 +004500 02 DNAME3 PICTURE 999 VALUE 1 COMPUTATIONAL. NC1764.2 +004600 02 DNAME4 PICTURE 9(4) VALUE 1 COMPUTATIONAL. NC1764.2 +004700 02 DNAME5 PICTURE 9(5) VALUE 1 COMPUTATIONAL. NC1764.2 +004800 02 DNAME6 PICTURE 9(6) VALUE 1 COMPUTATIONAL. NC1764.2 +004900 02 DNAME7 PICTURE 9(7) VALUE 1 COMPUTATIONAL. NC1764.2 +005000 02 DNAME8 PICTURE 9(8) VALUE 1 COMPUTATIONAL. NC1764.2 +005100 02 DNAME9 PICTURE 9(9) VALUE 1 COMPUTATIONAL. NC1764.2 +005200 02 DNAME10 PICTURE 9(10) VALUE 1. NC1764.2 +005300 02 DNAME11 PICTURE 9(11) VALUE 1. NC1764.2 +005400 02 DNAME12 PICTURE 9(12) VALUE 1. NC1764.2 +005500 02 DNAME13 PICTURE 9(13) VALUE 1. NC1764.2 +005600 02 DNAME14 PICTURE 9(14) VALUE 1. NC1764.2 +005700 02 DNAME15 PICTURE 9(15) VALUE 1. NC1764.2 +005800 02 DNAME16 PICTURE 9(16) VALUE 1. NC1764.2 +005900 02 DNAME17 PICTURE 9(17) VALUE 1. NC1764.2 +006000 02 DNAME18 PICTURE 9(18) VALUE 1. NC1764.2 +006100 02 DNAME19 PICTURE 9 VALUE 1. NC1764.2 +006200 02 DNAME20 PICTURE 99 VALUE 1. NC1764.2 +006300 02 DNAME21 PICTURE 999 VALUE 1. NC1764.2 +006400 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC1764.2 +006500 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC1764.2 +006600 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC1764.2 +006700 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC1764.2 +006800 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC1764.2 +006900 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC1764.2 +007000 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC1764.2 +007100 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC1764.2 +007200 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007300 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007400 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007500 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007600 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007700 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007800 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +007900 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008000 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008100 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008200 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008300 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008400 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +008500 77 SIZE-ERR PICTURE X VALUE SPACE. NC1764.2 +008600 77 SIZE-ERR2 PICTURE X VALUE SPACE. NC1764.2 +008700 77 SIZE-ERR3 PICTURE X VALUE SPACE. NC1764.2 +008800 77 SIZE-ERR4 PICTURE X VALUE SPACE. NC1764.2 +008900 77 A18TWOS-DS-18V00 PICTURE S9(18) NC1764.2 +009000 VALUE 222222222222222222. NC1764.2 +009100 77 A18ONES-DS-18V00 PICTURE S9(18) NC1764.2 +009200 VALUE 111111111111111111. NC1764.2 +009300 77 WRK-DS-10V00 PICTURE S9(10). NC1764.2 +009400 77 A17TWOS-DS-17V00 PICTURE S9(17) NC1764.2 +009500 VALUE 22222222222222222. NC1764.2 +009600 77 A10ONES-DS-10V00 PICTURE S9(10) NC1764.2 +009700 VALUE 1111111111. NC1764.2 +009800 77 A05ONES-DS-05V00 PICTURE S9(5) NC1764.2 +009900 VALUE 11111. NC1764.2 +010000 77 A02ONES-DS-02V00 PICTURE S99 NC1764.2 +010100 VALUE 11. NC1764.2 +010200 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1764.2 +010300 77 WRK-DS-18V00 REDEFINES WRK-DS-09V09 NC1764.2 +010400 PICTURE S9(18). NC1764.2 +010500 77 A06THREES-DS-03V03 PICTURE S999V999 NC1764.2 +010600 VALUE 333.333. NC1764.2 +010700 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1764.2 +010800 VALUE 333333.333333. NC1764.2 +010900 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1764.2 +011000 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC1764.2 +011100 PICTURE S9(12). NC1764.2 +011200 77 A05ONES-DS-00V05 PICTURE SV9(5) NC1764.2 +011300 VALUE .11111. NC1764.2 +011400 77 WRK-DS-05V00 PICTURE S9(5). NC1764.2 +011500 77 WRK-DS-02V00 PICTURE S99. NC1764.2 +011600 77 A12ONES-DS-12V00 PICTURE S9(12) NC1764.2 +011700 VALUE 111111111111. NC1764.2 +011800 77 WRK-DS-03V10 PICTURE S999V9(10). NC1764.2 +011900 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1764.2 +012000 PICTURE S9(13). NC1764.2 +012100 77 A99-DS-02V00 PICTURE S99 NC1764.2 +012200 VALUE 99. NC1764.2 +012300 77 A03ONES-DS-02V01 PICTURE S99V9 NC1764.2 +012400 VALUE 11.1. NC1764.2 +012500 77 A06ONES-DS-03V03 PICTURE S999V999 NC1764.2 +012600 VALUE 111.111. NC1764.2 +012700 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1764.2 +012800 VALUE 22.222222. NC1764.2 +012900 77 A01ONE-DS-P0801 PICTURE SP(8)9 NC1764.2 +013000 VALUE .000000001. NC1764.2 +013100 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1764.2 +013200 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1764.2 +013300 VALUE 111111111111111111. NC1764.2 +013400 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1764.2 +013500 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1764.2 +013600 VALUE 99. NC1764.2 +013700 77 WRK-DS-0201P PICTURE S99P. NC1764.2 +013800 77 WRK-DS-06V00 PICTURE S9(6). NC1764.2 +013900 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) NC1764.2 +014000 VALUE ZERO. NC1764.2 +014100 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1764.2 +014200 VALUE +012345678.876543210. NC1764.2 +014300 77 XDATA-XN-00018 PICTURE X(18) NC1764.2 +014400 VALUE "00ABCDEFGHI 4321 ". NC1764.2 +014500 77 WRK-XN-00018 PICTURE X(18). NC1764.2 +014600 77 WRK-XN-00001 PICTURE X. NC1764.2 +014700 77 ADD-12 PICTURE PP9 VALUE .001. NC1764.2 +014800 77 ADD-13 PICTURE 9PP VALUE 100. NC1764.2 +014900 77 ADD-14 PICTURE 999V999. NC1764.2 +015000 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1764.2 +015100 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1764.2 +015200 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1764.2 +015300 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1764.2 +015400 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1764.2 +015500 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1764.2 +015600 01 WRK-DU-1V5-1 PIC 9V9(5). NC1764.2 +015700 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1764.2 +015800 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1764.2 +015900 01 WRK-DU-2V0-1 PIC 99. NC1764.2 +016000 01 WRK-DU-2V0-2 PIC 99. NC1764.2 +016100 01 WRK-DU-2V0-3 PIC 99. NC1764.2 +016200 01 WRK-DU-2V1-1 PIC 99V9. NC1764.2 +016300 01 WRK-DU-2V1-2 PIC 99V9. NC1764.2 +016400 01 WRK-DU-2V1-3 PIC 99V9. NC1764.2 +016500 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1764.2 +016600 COMPUTATIONAL. NC1764.2 +016700 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1764.2 +016800 COMPUTATIONAL. NC1764.2 +016900 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1764.2 +017000 COMPUTATIONAL. NC1764.2 +017100 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1764.2 +017200 COMPUTATIONAL. NC1764.2 +017300 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1764.2 +017400 COMPUTATIONAL. NC1764.2 +017500 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1764.2 +017600 COMPUTATIONAL. NC1764.2 +017700 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1764.2 +017800 COMPUTATIONAL. NC1764.2 +017900 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1764.2 +018000 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1764.2 +018100 COMPUTATIONAL. NC1764.2 +018200 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1764.2 +018300 01 SUBTRACT-DATA. NC1764.2 +018400 02 SUBTR-1 PICTURE 9 VALUE 1. NC1764.2 +018500 02 SUBTR-2 PICTURE S99 VALUE 99. NC1764.2 +018600 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1764.2 +018700 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1764.2 +018800 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1764.2 +018900 02 SUBTR-6 PICTURE 9 VALUE 1. NC1764.2 +019000 02 SUBTR-7 PICTURE S99 VALUE 99. NC1764.2 +019100 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1764.2 +019200 02 SUBTR-10 PICTURE S999 VALUE 100. NC1764.2 +019300 02 SUBTR-11 PICTURE S999V999. NC1764.2 +019400 01 N-3 PICTURE IS 99999. NC1764.2 +019500 01 N-4 PICTURE IS 9(5) NC1764.2 +019600 VALUE IS 52800. NC1764.2 +019700 01 N-5 PICTURE IS S9(9)V99 NC1764.2 +019800 VALUE IS 000000001.00. NC1764.2 +019900 01 N-7 PICTURE IS S9(7)V9(4) NC1764.2 +020000 VALUE IS 0000001.0000. NC1764.2 +020100 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1764.2 +020200 01 N-10 PICTURE IS S99999V NC1764.2 +020300 VALUE IS -00001. NC1764.2 +020400 01 N-11 PICTURE IS 9 VALUE IS 9. NC1764.2 +020500 01 N-12 PICTURE IS 9 VALUE IS 9. NC1764.2 +020600 01 N-13 PICTURE IS 9(5) NC1764.2 +020700 VALUE IS 99999. NC1764.2 +020800 01 N-14 PICTURE IS 9 VALUE IS 1. NC1764.2 +020900 01 N-15 PICTURE IS 9(16). NC1764.2 +021000 01 N-16 PICTURE IS S999999V99 NC1764.2 +021100 VALUE IS 5.90. NC1764.2 +021200 01 N-17 PICTURE IS S9(3)V99 NC1764.2 +021300 VALUE IS +3.6. NC1764.2 +021400 01 N-18 PICTURE IS S9(10) NC1764.2 +021500 VALUE IS -5. NC1764.2 +021600 01 N-19 PICTURE IS $9.00. NC1764.2 +021700 01 N-20 PICTURE IS S9(9) NC1764.2 +021800 VALUE IS -999999999. NC1764.2 +021900 01 N-21 PICTURE IS 9 VALUE IS 5. NC1764.2 +022000 01 N-22 PICTURE IS 999V99 NC1764.2 +022100 VALUE IS 005.55. NC1764.2 +022200 01 N-23 PICTURE IS $$$.99CR. NC1764.2 +022300 01 N-25 PICTURE IS 9 VALUE IS 1. NC1764.2 +022400 01 N-26 PICTURE 9(5). NC1764.2 +022500 01 N-27 PICTURE IS 9999V9 NC1764.2 +022600 VALUE IS 9999.9. NC1764.2 +022700 01 N-28 PICTURE IS $9999.00. NC1764.2 +022800 01 N-40 PICTURE IS 9(7) NC1764.2 +022900 VALUE IS 7777777. NC1764.2 +023000 01 N-41 PICTURE IS 9(7) NC1764.2 +023100 VALUE IS 1111111. NC1764.2 +023200 01 N-42 PICTURE IS 9(3)P(4). NC1764.2 +023300 01 TRUNC-DATA. NC1764.2 +023400 02 N-43 PICTURE S9V9 VALUE +1.6. NC1764.2 +023500 02 N-44 PICTURE S9V9 VALUE -1.6. NC1764.2 +023600 02 N-45 PICTURE S9. NC1764.2 +023700 01 MINUS-NAMES. NC1764.2 +023800 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1764.2 +023900 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1764.2 +024000 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1764.2 +024100 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1764.2 +024200 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1764.2 +024300 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1764.2 +024400 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1764.2 +024500 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1764.2 +024600 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1764.2 +024700 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1764.2 +024800 02 WHOLE-FIELD PICTURE S9(18). NC1764.2 +024900 02 DECMAL-FIELD PICTURE SV9(18). NC1764.2 +025000 01 TEST-RESULTS. NC1764.2 +025100 02 FILLER PIC X VALUE SPACE. NC1764.2 +025200 02 FEATURE PIC X(20) VALUE SPACE. NC1764.2 +025300 02 FILLER PIC X VALUE SPACE. NC1764.2 +025400 02 P-OR-F PIC X(5) VALUE SPACE. NC1764.2 +025500 02 FILLER PIC X VALUE SPACE. NC1764.2 +025600 02 PAR-NAME. NC1764.2 +025700 03 FILLER PIC X(19) VALUE SPACE. NC1764.2 +025800 03 PARDOT-X PIC X VALUE SPACE. NC1764.2 +025900 03 DOTVALUE PIC 99 VALUE ZERO. NC1764.2 +026000 02 FILLER PIC X(8) VALUE SPACE. NC1764.2 +026100 02 RE-MARK PIC X(61). NC1764.2 +026200 01 TEST-COMPUTED. NC1764.2 +026300 02 FILLER PIC X(30) VALUE SPACE. NC1764.2 +026400 02 FILLER PIC X(17) VALUE NC1764.2 +026500 " COMPUTED=". NC1764.2 +026600 02 COMPUTED-X. NC1764.2 +026700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1764.2 +026800 03 COMPUTED-N REDEFINES COMPUTED-A NC1764.2 +026900 PIC -9(9).9(9). NC1764.2 +027000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1764.2 +027100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1764.2 +027200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1764.2 +027300 03 CM-18V0 REDEFINES COMPUTED-A. NC1764.2 +027400 04 COMPUTED-18V0 PIC -9(18). NC1764.2 +027500 04 FILLER PIC X. NC1764.2 +027600 03 FILLER PIC X(50) VALUE SPACE. NC1764.2 +027700 01 TEST-CORRECT. NC1764.2 +027800 02 FILLER PIC X(30) VALUE SPACE. NC1764.2 +027900 02 FILLER PIC X(17) VALUE " CORRECT =". NC1764.2 +028000 02 CORRECT-X. NC1764.2 +028100 03 CORRECT-A PIC X(20) VALUE SPACE. NC1764.2 +028200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1764.2 +028300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1764.2 +028400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1764.2 +028500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1764.2 +028600 03 CR-18V0 REDEFINES CORRECT-A. NC1764.2 +028700 04 CORRECT-18V0 PIC -9(18). NC1764.2 +028800 04 FILLER PIC X. NC1764.2 +028900 03 FILLER PIC X(2) VALUE SPACE. NC1764.2 +029000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1764.2 +029100 01 CCVS-C-1. NC1764.2 +029200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1764.2 +029300- "SS PARAGRAPH-NAME NC1764.2 +029400- " REMARKS". NC1764.2 +029500 02 FILLER PIC X(20) VALUE SPACE. NC1764.2 +029600 01 CCVS-C-2. NC1764.2 +029700 02 FILLER PIC X VALUE SPACE. NC1764.2 +029800 02 FILLER PIC X(6) VALUE "TESTED". NC1764.2 +029900 02 FILLER PIC X(15) VALUE SPACE. NC1764.2 +030000 02 FILLER PIC X(4) VALUE "FAIL". NC1764.2 +030100 02 FILLER PIC X(94) VALUE SPACE. NC1764.2 +030200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1764.2 +030300 01 REC-CT PIC 99 VALUE ZERO. NC1764.2 +030400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1764.2 +030500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1764.2 +030600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1764.2 +030700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1764.2 +030800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1764.2 +030900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1764.2 +031000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1764.2 +031100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1764.2 +031200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1764.2 +031300 01 CCVS-H-1. NC1764.2 +031400 02 FILLER PIC X(39) VALUE SPACES. NC1764.2 +031500 02 FILLER PIC X(42) VALUE NC1764.2 +031600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1764.2 +031700 02 FILLER PIC X(39) VALUE SPACES. NC1764.2 +031800 01 CCVS-H-2A. NC1764.2 +031900 02 FILLER PIC X(40) VALUE SPACE. NC1764.2 +032000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1764.2 +032100 02 FILLER PIC XXXX VALUE NC1764.2 +032200 "4.2 ". NC1764.2 +032300 02 FILLER PIC X(28) VALUE NC1764.2 +032400 " COPY - NOT FOR DISTRIBUTION". NC1764.2 +032500 02 FILLER PIC X(41) VALUE SPACE. NC1764.2 +032600 NC1764.2 +032700 01 CCVS-H-2B. NC1764.2 +032800 02 FILLER PIC X(15) VALUE NC1764.2 +032900 "TEST RESULT OF ". NC1764.2 +033000 02 TEST-ID PIC X(9). NC1764.2 +033100 02 FILLER PIC X(4) VALUE NC1764.2 +033200 " IN ". NC1764.2 +033300 02 FILLER PIC X(12) VALUE NC1764.2 +033400 " HIGH ". NC1764.2 +033500 02 FILLER PIC X(22) VALUE NC1764.2 +033600 " LEVEL VALIDATION FOR ". NC1764.2 +033700 02 FILLER PIC X(58) VALUE NC1764.2 +033800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1764.2 +033900 01 CCVS-H-3. NC1764.2 +034000 02 FILLER PIC X(34) VALUE NC1764.2 +034100 " FOR OFFICIAL USE ONLY ". NC1764.2 +034200 02 FILLER PIC X(58) VALUE NC1764.2 +034300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1764.2 +034400 02 FILLER PIC X(28) VALUE NC1764.2 +034500 " COPYRIGHT 1985 ". NC1764.2 +034600 01 CCVS-E-1. NC1764.2 +034700 02 FILLER PIC X(52) VALUE SPACE. NC1764.2 +034800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1764.2 +034900 02 ID-AGAIN PIC X(9). NC1764.2 +035000 02 FILLER PIC X(45) VALUE SPACES. NC1764.2 +035100 01 CCVS-E-2. NC1764.2 +035200 02 FILLER PIC X(31) VALUE SPACE. NC1764.2 +035300 02 FILLER PIC X(21) VALUE SPACE. NC1764.2 +035400 02 CCVS-E-2-2. NC1764.2 +035500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1764.2 +035600 03 FILLER PIC X VALUE SPACE. NC1764.2 +035700 03 ENDER-DESC PIC X(44) VALUE NC1764.2 +035800 "ERRORS ENCOUNTERED". NC1764.2 +035900 01 CCVS-E-3. NC1764.2 +036000 02 FILLER PIC X(22) VALUE NC1764.2 +036100 " FOR OFFICIAL USE ONLY". NC1764.2 +036200 02 FILLER PIC X(12) VALUE SPACE. NC1764.2 +036300 02 FILLER PIC X(58) VALUE NC1764.2 +036400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1764.2 +036500 02 FILLER PIC X(13) VALUE SPACE. NC1764.2 +036600 02 FILLER PIC X(15) VALUE NC1764.2 +036700 " COPYRIGHT 1985". NC1764.2 +036800 01 CCVS-E-4. NC1764.2 +036900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1764.2 +037000 02 FILLER PIC X(4) VALUE " OF ". NC1764.2 +037100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1764.2 +037200 02 FILLER PIC X(40) VALUE NC1764.2 +037300 " TESTS WERE EXECUTED SUCCESSFULLY". NC1764.2 +037400 01 XXINFO. NC1764.2 +037500 02 FILLER PIC X(19) VALUE NC1764.2 +037600 "*** INFORMATION ***". NC1764.2 +037700 02 INFO-TEXT. NC1764.2 +037800 04 FILLER PIC X(8) VALUE SPACE. NC1764.2 +037900 04 XXCOMPUTED PIC X(20). NC1764.2 +038000 04 FILLER PIC X(5) VALUE SPACE. NC1764.2 +038100 04 XXCORRECT PIC X(20). NC1764.2 +038200 02 INF-ANSI-REFERENCE PIC X(48). NC1764.2 +038300 01 HYPHEN-LINE. NC1764.2 +038400 02 FILLER PIC IS X VALUE IS SPACE. NC1764.2 +038500 02 FILLER PIC IS X(65) VALUE IS "************************NC1764.2 +038600- "*****************************************". NC1764.2 +038700 02 FILLER PIC IS X(54) VALUE IS "************************NC1764.2 +038800- "******************************". NC1764.2 +038900 01 CCVS-PGM-ID PIC X(9) VALUE NC1764.2 +039000 "NC176A". NC1764.2 +039100 PROCEDURE DIVISION. NC1764.2 +039200 CCVS1 SECTION. NC1764.2 +039300 OPEN-FILES. NC1764.2 +039400 OPEN OUTPUT PRINT-FILE. NC1764.2 +039500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1764.2 +039600 MOVE SPACE TO TEST-RESULTS. NC1764.2 +039700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1764.2 +039800 GO TO CCVS1-EXIT. NC1764.2 +039900 CLOSE-FILES. NC1764.2 +040000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1764.2 +040100 TERMINATE-CCVS. NC1764.2 +040200*S EXIT PROGRAM. NC1764.2 +040300*SERMINATE-CALL. NC1764.2 +040400 STOP RUN. NC1764.2 +040500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1764.2 +040600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1764.2 +040700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1764.2 +040800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1764.2 +040900 MOVE "****TEST DELETED****" TO RE-MARK. NC1764.2 +041000 PRINT-DETAIL. NC1764.2 +041100 IF REC-CT NOT EQUAL TO ZERO NC1764.2 +041200 MOVE "." TO PARDOT-X NC1764.2 +041300 MOVE REC-CT TO DOTVALUE. NC1764.2 +041400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1764.2 +041500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1764.2 +041600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1764.2 +041700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1764.2 +041800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1764.2 +041900 MOVE SPACE TO CORRECT-X. NC1764.2 +042000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1764.2 +042100 MOVE SPACE TO RE-MARK. NC1764.2 +042200 HEAD-ROUTINE. NC1764.2 +042300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +042400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +042500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1764.2 +042600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1764.2 +042700 COLUMN-NAMES-ROUTINE. NC1764.2 +042800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +042900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +043000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +043100 END-ROUTINE. NC1764.2 +043200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1764.2 +043300 END-RTN-EXIT. NC1764.2 +043400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +043500 END-ROUTINE-1. NC1764.2 +043600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1764.2 +043700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1764.2 +043800 ADD PASS-COUNTER TO ERROR-HOLD. NC1764.2 +043900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1764.2 +044000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1764.2 +044100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1764.2 +044200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1764.2 +044300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1764.2 +044400 END-ROUTINE-12. NC1764.2 +044500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1764.2 +044600 IF ERROR-COUNTER IS EQUAL TO ZERO NC1764.2 +044700 MOVE "NO " TO ERROR-TOTAL NC1764.2 +044800 ELSE NC1764.2 +044900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1764.2 +045000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1764.2 +045100 PERFORM WRITE-LINE. NC1764.2 +045200 END-ROUTINE-13. NC1764.2 +045300 IF DELETE-COUNTER IS EQUAL TO ZERO NC1764.2 +045400 MOVE "NO " TO ERROR-TOTAL ELSE NC1764.2 +045500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1764.2 +045600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1764.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +045800 IF INSPECT-COUNTER EQUAL TO ZERO NC1764.2 +045900 MOVE "NO " TO ERROR-TOTAL NC1764.2 +046000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1764.2 +046100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1764.2 +046200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +046300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1764.2 +046400 WRITE-LINE. NC1764.2 +046500 ADD 1 TO RECORD-COUNT. NC1764.2 +046600 IF RECORD-COUNT GREATER 42 NC1764.2 +046700 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1764.2 +046800 MOVE SPACE TO DUMMY-RECORD NC1764.2 +046900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1764.2 +047000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1764.2 +047100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1764.2 +047200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1764.2 +047300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1764.2 +047400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1764.2 +047500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1764.2 +047600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1764.2 +047700 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1764.2 +047800 MOVE ZERO TO RECORD-COUNT. NC1764.2 +047900 PERFORM WRT-LN. NC1764.2 +048000 WRT-LN. NC1764.2 +048100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1764.2 +048200 MOVE SPACE TO DUMMY-RECORD. NC1764.2 +048300 BLANK-LINE-PRINT. NC1764.2 +048400 PERFORM WRT-LN. NC1764.2 +048500 FAIL-ROUTINE. NC1764.2 +048600 IF COMPUTED-X NOT EQUAL TO SPACE NC1764.2 +048700 GO TO FAIL-ROUTINE-WRITE. NC1764.2 +048800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1764.2 +048900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1764.2 +049000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1764.2 +049100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +049200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1764.2 +049300 GO TO FAIL-ROUTINE-EX. NC1764.2 +049400 FAIL-ROUTINE-WRITE. NC1764.2 +049500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1764.2 +049600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1764.2 +049700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1764.2 +049800 MOVE SPACES TO COR-ANSI-REFERENCE. NC1764.2 +049900 FAIL-ROUTINE-EX. EXIT. NC1764.2 +050000 BAIL-OUT. NC1764.2 +050100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1764.2 +050200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1764.2 +050300 BAIL-OUT-WRITE. NC1764.2 +050400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1764.2 +050500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1764.2 +050600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1764.2 +050700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1764.2 +050800 BAIL-OUT-EX. EXIT. NC1764.2 +050900 CCVS1-EXIT. NC1764.2 +051000 EXIT. NC1764.2 +051100 SECT-NC176A-001 SECTION. NC1764.2 +051200 ADD-INIT-F1-1. NC1764.2 +051300 MOVE "ADD" TO FEATURE. NC1764.2 +051400 MOVE "VI-74 6.6.4 GR4" TO ANSI-REFERENCE. NC1764.2 +051500 ADD-TEST-F1-1. NC1764.2 +051600 ADD N-5 TO N-7. NC1764.2 +051700 IF N-7 IS EQUAL TO 2 NC1764.2 +051800 PERFORM PASS NC1764.2 +051900 GO TO ADD-WRITE-F1-1. NC1764.2 +052000 GO TO ADD-FAIL-F1-1. NC1764.2 +052100 ADD-DELETE-F1-1. NC1764.2 +052200 PERFORM DE-LETE. NC1764.2 +052300 GO TO ADD-WRITE-F1-1. NC1764.2 +052400 ADD-FAIL-F1-1. NC1764.2 +052500 MOVE N-7 TO COMPUTED-N. NC1764.2 +052600 MOVE 2 TO CORRECT-N. NC1764.2 +052700 PERFORM FAIL. NC1764.2 +052800 ADD-WRITE-F1-1. NC1764.2 +052900 MOVE "ADD-TEST-F1-1 " TO PAR-NAME. NC1764.2 +053000 PERFORM PRINT-DETAIL. NC1764.2 +053100 ADD-TEST-F1-2. NC1764.2 +053200 ADD -.6 TO N-10 ROUNDED. NC1764.2 +053300 IF N-10 EQUAL TO -2 NC1764.2 +053400 PERFORM PASS NC1764.2 +053500 GO TO ADD-WRITE-F1-2. NC1764.2 +053600 GO TO ADD-FAIL-F1-2. NC1764.2 +053700 ADD-DELETE-F1-2. NC1764.2 +053800 PERFORM DE-LETE. NC1764.2 +053900 GO TO ADD-WRITE-F1-2. NC1764.2 +054000 ADD-FAIL-F1-2. NC1764.2 +054100 MOVE N-10 TO COMPUTED-N. NC1764.2 +054200 MOVE -2 TO CORRECT-N. NC1764.2 +054300 PERFORM FAIL. NC1764.2 +054400 ADD-WRITE-F1-2. NC1764.2 +054500 MOVE "ADD-TEST-F1-2 " TO PAR-NAME. NC1764.2 +054600 PERFORM PRINT-DETAIL. NC1764.2 +054700 MOVE -2 TO N-10. NC1764.2 +054800 ADD-TEST-F1-3-0. NC1764.2 +054900 ADD N-11 TO N-12 ON SIZE ERROR NC1764.2 +055000 PERFORM PASS NC1764.2 +055100 GO TO ADD-WRITE-F1-3. NC1764.2 +055200 GO TO ADD-FAIL-F1-3. NC1764.2 +055300 ADD-DELETE-F1-3. NC1764.2 +055400 PERFORM DE-LETE. NC1764.2 +055500 GO TO ADD-WRITE-F1-3. NC1764.2 +055600 ADD-FAIL-F1-3. NC1764.2 +055700 MOVE N-12 TO COMPUTED-N. NC1764.2 +055800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +055900 PERFORM FAIL. NC1764.2 +056000 ADD-WRITE-F1-3. NC1764.2 +056100 MOVE "ADD-TEST-F1-3 " TO PAR-NAME. NC1764.2 +056200 PERFORM PRINT-DETAIL. NC1764.2 +056300 ADD-TEST-F1-4-1. NC1764.2 +056400 ADD 1.5 TO N-13 ROUNDED ON SIZE ERROR NC1764.2 +056500 PERFORM PASS NC1764.2 +056600 GO TO ADD-WRITE-F1-4-1. NC1764.2 +056700* NOTE WHEN SIZE ERROR CONDITION OCCURS, VALUE OF NC1764.2 +056800* N-13 SHOULD NOT BE CHANGED. NC1764.2 +056900 GO TO ADD-FAIL-F1-4-1. NC1764.2 +057000 ADD-DELETE-F1-4-1. NC1764.2 +057100 PERFORM DE-LETE. NC1764.2 +057200 GO TO ADD-WRITE-F1-4-1. NC1764.2 +057300 ADD-FAIL-F1-4-1. NC1764.2 +057400 MOVE N-13 TO COMPUTED-N. NC1764.2 +057500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +057600 PERFORM FAIL. NC1764.2 +057700 ADD-WRITE-F1-4-1. NC1764.2 +057800 MOVE "ADD-TEST-F1-4-1 " TO PAR-NAME. NC1764.2 +057900 PERFORM PRINT-DETAIL. NC1764.2 +058000 ADD-TEST-F1-4-2. NC1764.2 +058100 IF N-13 IS EQUAL TO 99999 NC1764.2 +058200 PERFORM PASS NC1764.2 +058300 GO TO ADD-WRITE-F1-4-2. NC1764.2 +058400 GO TO ADD-FAIL-F1-4-2. NC1764.2 +058500 ADD-DELETE-F1-4-2. NC1764.2 +058600 PERFORM DE-LETE. NC1764.2 +058700 GO TO ADD-WRITE-F1-4-2. NC1764.2 +058800 ADD-FAIL-F1-4-2. NC1764.2 +058900 MOVE N-13 TO COMPUTED-N. NC1764.2 +059000 MOVE 99999 TO CORRECT-N. NC1764.2 +059100 PERFORM FAIL. NC1764.2 +059200 ADD-WRITE-F1-4-2. NC1764.2 +059300 MOVE "ADD-TEST-F1-4-2 " TO PAR-NAME. NC1764.2 +059400 PERFORM PRINT-DETAIL. NC1764.2 +059500 ADD-INIT-F1-5. NC1764.2 +059600 MOVE "ADD ---" TO FEATURE. NC1764.2 +059700 PERFORM PRINT-DETAIL. NC1764.2 +059800 MOVE " TO" TO FEATURE. NC1764.2 +059900 ADD-TEST-F1-5. NC1764.2 +060000 MOVE A18TWOS-DS-18V00 TO WRK-DS-18V00. NC1764.2 +060100 ADD A18ONES-DS-18V00 TO WRK-DS-18V00. NC1764.2 +060200 IF WRK-DS-18V00 EQUAL TO 333333333333333333 NC1764.2 +060300 PERFORM PASS GO TO ADD-WRITE-F1-5. NC1764.2 +060400 GO TO ADD-FAIL-F1-5. NC1764.2 +060500 ADD-DELETE-F1-5. NC1764.2 +060600 PERFORM DE-LETE. NC1764.2 +060700 GO TO ADD-WRITE-F1-5. NC1764.2 +060800 ADD-FAIL-F1-5. NC1764.2 +060900 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1764.2 +061000 MOVE 333333333333333333 TO CORRECT-18V0. NC1764.2 +061100 PERFORM FAIL. NC1764.2 +061200 ADD-WRITE-F1-5. NC1764.2 +061300 MOVE "ADD-TEST-F1-5" TO PAR-NAME. NC1764.2 +061400 PERFORM PRINT-DETAIL. NC1764.2 +061500 ADD-TEST-F1-6. NC1764.2 +061600 MOVE ZERO TO WRK-DS-10V00. NC1764.2 +061700 ADD A10ONES-DS-10V00 A05ONES-DS-05V00 TO WRK-DS-10V00. NC1764.2 +061800 IF WRK-DS-10V00 EQUAL TO 1111122222 NC1764.2 +061900 PERFORM PASS GO TO ADD-WRITE-F1-6. NC1764.2 +062000 GO TO ADD-FAIL-F1-6. NC1764.2 +062100 ADD-DELETE-F1-6. NC1764.2 +062200 PERFORM DE-LETE. NC1764.2 +062300 GO TO ADD-WRITE-F1-6. NC1764.2 +062400 ADD-FAIL-F1-6. NC1764.2 +062500 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1764.2 +062600 MOVE 1111122222 TO CORRECT-18V0. NC1764.2 +062700 PERFORM FAIL. NC1764.2 +062800 ADD-WRITE-F1-6. NC1764.2 +062900 MOVE "ADD-TEST-F1-6" TO PAR-NAME. NC1764.2 +063000 PERFORM PRINT-DETAIL. NC1764.2 +063100 ADD-TEST-F1-7. NC1764.2 +063200 MOVE ZERO TO WRK-DS-10V00. NC1764.2 +063300 ADD A02ONES-DS-02V00 NC1764.2 +063400 A10ONES-DS-10V00 NC1764.2 +063500 A05ONES-DS-05V00 TO WRK-DS-10V00. NC1764.2 +063600 IF WRK-DS-10V00 EQUAL TO 1111122233 NC1764.2 +063700 PERFORM PASS GO TO ADD-WRITE-F1-7. NC1764.2 +063800 GO TO ADD-FAIL-F1-7. NC1764.2 +063900 ADD-DELETE-F1-7. NC1764.2 +064000 PERFORM DE-LETE. NC1764.2 +064100 GO TO ADD-WRITE-F1-7. NC1764.2 +064200 ADD-FAIL-F1-7. NC1764.2 +064300 MOVE WRK-DS-10V00 TO COMPUTED-18V0. NC1764.2 +064400 MOVE 1111122233 TO CORRECT-18V0. NC1764.2 +064500 PERFORM FAIL. NC1764.2 +064600 ADD-WRITE-F1-7. NC1764.2 +064700 MOVE "ADD-TEST-F1-7" TO PAR-NAME. NC1764.2 +064800 PERFORM PRINT-DETAIL. NC1764.2 +064900 ADD-INIT-F1-8. NC1764.2 +065000 MOVE " ROUNDED" TO FEATURE. NC1764.2 +065100 ADD-TEST-F1-8. NC1764.2 +065200 MOVE ZERO TO WRK-DS-05V00. NC1764.2 +065300 ADD 55554.5 TO WRK-DS-05V00 ROUNDED. NC1764.2 +065400 IF WRK-DS-05V00 EQUAL TO 55555 NC1764.2 +065500 PERFORM PASS GO TO ADD-WRITE-F1-8. NC1764.2 +065600 GO TO ADD-FAIL-F1-8. NC1764.2 +065700 ADD-DELETE-F1-8. NC1764.2 +065800 PERFORM DE-LETE. NC1764.2 +065900 GO TO ADD-WRITE-F1-8. NC1764.2 +066000 ADD-FAIL-F1-8. NC1764.2 +066100 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1764.2 +066200 MOVE 55555 TO CORRECT-N. NC1764.2 +066300 PERFORM FAIL. NC1764.2 +066400 ADD-WRITE-F1-8. NC1764.2 +066500 MOVE "ADD-TEST-F1-8" TO PAR-NAME. NC1764.2 +066600 PERFORM PRINT-DETAIL. NC1764.2 +066700 ADD-INIT-F1-9-1. NC1764.2 +066800 MOVE " SIZE ERROR" TO FEATURE. NC1764.2 +066900 MOVE -11 TO WRK-DS-02V00. NC1764.2 +067000 ADD-TEST-F1-9-1. NC1764.2 +067100 ADD -99 TO WRK-DS-02V00 ON SIZE ERROR NC1764.2 +067200 PERFORM PASS GO TO ADD-WRITE-F1-9-1. NC1764.2 +067300 GO TO ADD-FAIL-F1-9-1. NC1764.2 +067400 ADD-DELETE-F1-9-1. NC1764.2 +067500 PERFORM DE-LETE. NC1764.2 +067600 GO TO ADD-WRITE-F1-9-1. NC1764.2 +067700 ADD-FAIL-F1-9-1. NC1764.2 +067800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +067900 PERFORM FAIL. NC1764.2 +068000 ADD-WRITE-F1-9-1. NC1764.2 +068100 MOVE "ADD-TEST-F1-9-1" TO PAR-NAME. NC1764.2 +068200 PERFORM PRINT-DETAIL. NC1764.2 +068300 ADD-TEST-F1-9-2. NC1764.2 +068400 IF WRK-DS-02V00 EQUAL TO -11 NC1764.2 +068500 PERFORM PASS GO TO ADD-WRITE-F1-9-2. NC1764.2 +068600* THIS TEST DEPENDS ON THE RESULTS OF TEST-F1-9-1 ABOVE. NC1764.2 +068700 GO TO ADD-FAIL-F1-9-2. NC1764.2 +068800 ADD-DELETE-F1-9-2. NC1764.2 +068900 PERFORM DE-LETE. NC1764.2 +069000 GO TO ADD-WRITE-F1-9-2. NC1764.2 +069100 ADD-FAIL-F1-9-2. NC1764.2 +069200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1764.2 +069300 MOVE WRK-DS-02V00 TO COMPUTED-N. NC1764.2 +069400 MOVE -11 TO CORRECT-N. NC1764.2 +069500 PERFORM FAIL. NC1764.2 +069600 ADD-WRITE-F1-9-2. NC1764.2 +069700 MOVE "ADD-TEST-F1-9-2" TO PAR-NAME. NC1764.2 +069800 PERFORM PRINT-DETAIL. NC1764.2 +069900 ADD-INIT-F1-10-1. NC1764.2 +070000 MOVE " ROUNDED,SIZE ERROR" TO FEATURE. NC1764.2 +070100 ADD-TEST-F1-10-1. NC1764.2 +070200 MOVE ZERO TO WRK-DS-05V00 NC1764.2 +070300 ADD 33333 NC1764.2 +070400 A06THREES-DS-03V03 NC1764.2 +070500 A12THREES-DS-06V06 NC1764.2 +070600 TO WRK-DS-05V00 ROUNDED ON SIZE ERROR NC1764.2 +070700 PERFORM PASS GO TO ADD-WRITE-F1-10-1. NC1764.2 +070800 GO TO ADD-FAIL-F1-10-1. NC1764.2 +070900 ADD-DELETE-F1-10-1. NC1764.2 +071000 PERFORM DE-LETE. NC1764.2 +071100 GO TO ADD-WRITE-F1-10-1. NC1764.2 +071200 ADD-FAIL-F1-10-1. NC1764.2 +071300 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +071400 PERFORM FAIL. NC1764.2 +071500 ADD-WRITE-F1-10-1. NC1764.2 +071600 MOVE "ADD-TEST-F1-10-1" TO PAR-NAME. NC1764.2 +071700 PERFORM PRINT-DETAIL. NC1764.2 +071800 ADD-TEST-F1-10-2. NC1764.2 +071900 IF WRK-DS-05V00 EQUAL TO ZERO NC1764.2 +072000 PERFORM PASS GO TO ADD-WRITE-F1-10-2. NC1764.2 +072100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F1-10-1 NC1764.2 +072200 GO TO ADD-FAIL-F1-10-2. NC1764.2 +072300 ADD-DELETE-F1-10-2. NC1764.2 +072400 PERFORM DE-LETE. NC1764.2 +072500 GO TO ADD-WRITE-F1-10-2. NC1764.2 +072600 ADD-FAIL-F1-10-2. NC1764.2 +072700 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1764.2 +072800 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1764.2 +072900 MOVE ZERO TO CORRECT-N. NC1764.2 +073000 PERFORM FAIL. NC1764.2 +073100 ADD-WRITE-F1-10-2. NC1764.2 +073200 MOVE "ADD-TEST-F1-10-2" TO PAR-NAME. NC1764.2 +073300 PERFORM PRINT-DETAIL. NC1764.2 +073400 ADD-TEST-F1-11-1. NC1764.2 +073500 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +073600 ADD A12THREES-DS-06V06 NC1764.2 +073700 333333 NC1764.2 +073800 A06THREES-DS-03V03 NC1764.2 +073900 TO WRK-DS-06V06 ROUNDED ON SIZE ERROR NC1764.2 +074000 GO TO ADD-FAIL-F1-11-1. NC1764.2 +074100 PERFORM PASS. NC1764.2 +074200 GO TO ADD-WRITE-F1-11-1. NC1764.2 +074300 ADD-DELETE-F1-11-1. NC1764.2 +074400 PERFORM DE-LETE. NC1764.2 +074500 GO TO ADD-WRITE-F1-11-1. NC1764.2 +074600 ADD-FAIL-F1-11-1. NC1764.2 +074700 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1764.2 +074800 PERFORM FAIL. NC1764.2 +074900 ADD-WRITE-F1-11-1. NC1764.2 +075000 MOVE "ADD-TEST-F1-11-1" TO PAR-NAME. NC1764.2 +075100 PERFORM PRINT-DETAIL. NC1764.2 +075200 ADD-TEST-F1-11-2. NC1764.2 +075300 IF WRK-DS-06V06 EQUAL TO 666999.666333 NC1764.2 +075400 PERFORM PASS GO TO ADD-WRITE-F1-11-2. NC1764.2 +075500* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F1-11-1 NC1764.2 +075600 GO TO ADD-FAIL-F1-11-2. NC1764.2 +075700 ADD-DELETE-F1-11-2. NC1764.2 +075800 PERFORM DE-LETE. NC1764.2 +075900 GO TO ADD-WRITE-F1-11-2. NC1764.2 +076000 ADD-FAIL-F1-11-2. NC1764.2 +076100 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1764.2 +076200 MOVE 666999.666333 TO CORRECT-N. NC1764.2 +076300 PERFORM FAIL. NC1764.2 +076400 ADD-WRITE-F1-11-2. NC1764.2 +076500 MOVE "ADD-TEST-F1-11-2" TO PAR-NAME. NC1764.2 +076600 PERFORM PRINT-DETAIL. NC1764.2 +076700 ADD-INIT-F1-12. NC1764.2 +076800 MOVE " COMP VS. DISPLAY" TO FEATURE. NC1764.2 +076900 ADD-TEST-F1-12. NC1764.2 +077000 MOVE A18ONES-DS-18V00 TO WRK-CS-18V00. NC1764.2 +077100 ADD A18ONES-DS-18V00 TO WRK-CS-18V00. NC1764.2 +077200 IF WRK-CS-18V00 EQUAL TO 222222222222222222 NC1764.2 +077300 PERFORM PASS GO TO ADD-WRITE-F1-12. NC1764.2 +077400 GO TO ADD-FAIL-F1-12. NC1764.2 +077500 ADD-DELETE-F1-12. NC1764.2 +077600 PERFORM DE-LETE. NC1764.2 +077700 GO TO ADD-WRITE-F1-12. NC1764.2 +077800 ADD-FAIL-F1-12. NC1764.2 +077900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1764.2 +078000 MOVE 222222222222222222 TO CORRECT-18V0. NC1764.2 +078100 PERFORM FAIL. NC1764.2 +078200 ADD-WRITE-F1-12. NC1764.2 +078300 MOVE "ADD-TEST-F1-12" TO PAR-NAME. NC1764.2 +078400 PERFORM PRINT-DETAIL. NC1764.2 +078500 ADD-TEST-F1-13. NC1764.2 +078600 MOVE A18ONES-DS-18V00 TO WRK-DS-18V00. NC1764.2 +078700 ADD A18ONES-CS-18V00 TO WRK-DS-18V00. NC1764.2 +078800 IF WRK-DS-18V00 EQUAL TO 222222222222222222 NC1764.2 +078900 PERFORM PASS GO TO ADD-WRITE-F1-13. NC1764.2 +079000 GO TO ADD-FAIL-F1-13. NC1764.2 +079100 ADD-DELETE-F1-13. NC1764.2 +079200 PERFORM DE-LETE. NC1764.2 +079300 GO TO ADD-WRITE-F1-13. NC1764.2 +079400 ADD-FAIL-F1-13. NC1764.2 +079500 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1764.2 +079600 MOVE 222222222222222222 TO CORRECT-18V0. NC1764.2 +079700 PERFORM FAIL. NC1764.2 +079800 ADD-WRITE-F1-13. NC1764.2 +079900 MOVE "ADD-TEST-F1-13" TO PAR-NAME. NC1764.2 +080000 PERFORM PRINT-DETAIL. NC1764.2 +080100 ADD-TEST-F1-14. NC1764.2 +080200 MOVE ZERO TO WRK-CS-02V02. NC1764.2 +080300 ADD A99-CS-02V00 TO WRK-CS-02V02. NC1764.2 +080400 IF WRK-CS-02V02 EQUAL TO 99.00 NC1764.2 +080500 PERFORM PASS GO TO ADD-WRITE-F1-14. NC1764.2 +080600 GO TO ADD-FAIL-F1-14. NC1764.2 +080700 ADD-DELETE-F1-14. NC1764.2 +080800 PERFORM DE-LETE. NC1764.2 +080900 GO TO ADD-WRITE-F1-14. NC1764.2 +081000 ADD-FAIL-F1-14. NC1764.2 +081100 MOVE WRK-CS-02V02 TO COMPUTED-N. NC1764.2 +081200 MOVE 99.00 TO CORRECT-N. NC1764.2 +081300 PERFORM FAIL. NC1764.2 +081400 ADD-WRITE-F1-14. NC1764.2 +081500 MOVE "ADD-TEST-F1-14" TO PAR-NAME. NC1764.2 +081600 PERFORM PRINT-DETAIL. NC1764.2 +081700 ADD-TEST-F1-15-1. NC1764.2 +081800 MOVE A99-CS-02V00 TO WRK-CS-02V02. NC1764.2 +081900 ADD A99-CS-02V00 TO WRK-CS-02V02 ON SIZE ERROR NC1764.2 +082000 PERFORM PASS GO TO ADD-WRITE-F1-15-1. NC1764.2 +082100 GO TO ADD-FAIL-F1-15-1. NC1764.2 +082200 ADD-DELETE-F1-15-1. NC1764.2 +082300 PERFORM DE-LETE. NC1764.2 +082400 GO TO ADD-WRITE-F1-15-1. NC1764.2 +082500 ADD-FAIL-F1-15-1. NC1764.2 +082600 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1764.2 +082700 PERFORM FAIL. NC1764.2 +082800 ADD-WRITE-F1-15-1. NC1764.2 +082900 MOVE "ADD-TEST-F1-15-1" TO PAR-NAME. NC1764.2 +083000 PERFORM PRINT-DETAIL. NC1764.2 +083100 ADD-TEST-F1-15-2. NC1764.2 +083200 IF WRK-CS-02V02 EQUAL TO 99.00 NC1764.2 +083300 PERFORM PASS GO TO ADD-WRITE-F1-15-2. NC1764.2 +083400* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F1-15-1 NC1764.2 +083500 GO TO ADD-FAIL-F1-15-2. NC1764.2 +083600 ADD-DELETE-F1-15-2. NC1764.2 +083700 PERFORM DE-LETE. NC1764.2 +083800 GO TO ADD-WRITE-F1-15-2. NC1764.2 +083900 ADD-FAIL-F1-15-2. NC1764.2 +084000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1764.2 +084100 MOVE WRK-CS-02V02 TO COMPUTED-N. NC1764.2 +084200 MOVE 99.00 TO CORRECT-N. NC1764.2 +084300 PERFORM FAIL. NC1764.2 +084400 ADD-WRITE-F1-15-2. NC1764.2 +084500 MOVE "ADD-TEST-F1-15-2" TO PAR-NAME. NC1764.2 +084600 PERFORM PRINT-DETAIL. NC1764.2 +084700 ADD-TEST-F1-16. NC1764.2 +084800 MOVE A14TWOS-CS-18V00 TO WRK-CS-18V00. NC1764.2 +084900 ADD A18FIVES-CS-18V00 TO WRK-CS-18V00. NC1764.2 +085000 IF WRK-CS-18V00 EQUAL TO -555577777777777777 NC1764.2 +085100 PERFORM PASS NC1764.2 +085200 GO TO ADD-WRITE-F1-16. NC1764.2 +085300 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1764.2 +085400 MOVE -555577777777777777 TO CORRECT-18V0. NC1764.2 +085500 PERFORM FAIL. NC1764.2 +085600 GO TO ADD-WRITE-F1-16. NC1764.2 +085700 ADD-DELETE-F1-16. NC1764.2 +085800 PERFORM DE-LETE. NC1764.2 +085900 ADD-WRITE-F1-16. NC1764.2 +086000 MOVE "ADD-TEST-F1-16 " TO PAR-NAME. NC1764.2 +086100 PERFORM PRINT-DETAIL. NC1764.2 +086200 ADD-TEST-F1-17. NC1764.2 +086300 MOVE A12SEVENS-CU-18V00 TO WRK-CS-18V00. NC1764.2 +086400 ADD A18SIXES-CS-18V00 TO WRK-CS-18V00. NC1764.2 +086500 IF WRK-CS-18V00 EQUAL TO +666667444444444443 NC1764.2 +086600 PERFORM PASS NC1764.2 +086700 GO TO ADD-WRITE-F1-17. NC1764.2 +086800 MOVE +666667444444444443 TO CORRECT-18V0. NC1764.2 +086900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1764.2 +087000 PERFORM FAIL. NC1764.2 +087100 GO TO ADD-WRITE-F1-17. NC1764.2 +087200 ADD-DELETE-F1-17. NC1764.2 +087300 PERFORM DE-LETE. NC1764.2 +087400 ADD-WRITE-F1-17. NC1764.2 +087500 MOVE "ADD-TEST-F1-17 " TO PAR-NAME. NC1764.2 +087600 PERFORM PRINT-DETAIL. NC1764.2 +087700 ADD-TEST-F1-18. NC1764.2 +087800 MOVE A12SEVENS-CU-18V00 TO WRK-DU-18V00. NC1764.2 +087900 ADD A18FIVES-CS-18V00 TO WRK-DU-18V00. NC1764.2 +088000 IF WRK-DU-18V00 EQUAL TO 555554777777777778 NC1764.2 +088100 PERFORM PASS NC1764.2 +088200 GO TO ADD-WRITE-F1-18. NC1764.2 +088300 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1764.2 +088400 MOVE 555554777777777778 TO CORRECT-18V0. NC1764.2 +088500 PERFORM FAIL. NC1764.2 +088600 GO TO ADD-WRITE-F1-18. NC1764.2 +088700 ADD-DELETE-F1-18. NC1764.2 +088800 PERFORM DE-LETE. NC1764.2 +088900 ADD-WRITE-F1-18. NC1764.2 +089000 MOVE "ADD-TEST-F1-18 " TO PAR-NAME. NC1764.2 +089100 PERFORM PRINT-DETAIL. NC1764.2 +089200 ADD-TEST-F1-19. NC1764.2 +089300 MOVE +980 TO WRK-CS-03V00. NC1764.2 +089400 MOVE SPACE TO SIZE-ERR. NC1764.2 +089500* NOTE IN THIS TEST, 1 IS ADDED TO A 3-DIGIT COMP SYNC NC1764.2 +089600* FIELD UNTIL A SIZE ERROR OCCURS --- IF THE VALUE OF NC1764.2 +089700* THE FIELD REACHES 1180 WITHOUT A SIZE ERROR THE NC1764.2 +089800* ATTEMPTED ADDITIONS ARE TERMINATED. NC1764.2 +089900 PERFORM ADD-A-F1-19 THRU ADD-B-F1-19 200 TIMES. NC1764.2 +090000 IF SIZE-ERR EQUAL TO SPACE NC1764.2 +090100 MOVE "SIZE ERROR NOT ENCOUNTERED" TO RE-MARK NC1764.2 +090200 MOVE "AT LEAST 1180" TO COMPUTED-A NC1764.2 +090300 MOVE "999 IN PIC 999 FIELD" TO CORRECT-A NC1764.2 +090400 PERFORM FAIL NC1764.2 +090500 GO TO ADD-WRITE-F1-19. NC1764.2 +090600 IF WRK-CS-03V00 EQUAL TO 999 NC1764.2 +090700 PERFORM PASS GO TO ADD-WRITE-F1-19. NC1764.2 +090800 PERFORM FAIL. NC1764.2 +090900 MOVE WRK-CS-03V00 TO COMPUTED-N. NC1764.2 +091000 MOVE 999 TO CORRECT-N. NC1764.2 +091100 GO TO ADD-WRITE-F1-19. NC1764.2 +091200 ADD-DELETE-F1-19. NC1764.2 +091300 PERFORM DE-LETE. NC1764.2 +091400 GO TO ADD-WRITE-F1-19. NC1764.2 +091500 ADD-A-F1-19. NC1764.2 +091600 IF SIZE-ERR EQUAL TO "E" GO TO ADD-B-F1-19. NC1764.2 +091700 ADD 1 TO WRK-CS-03V00 ON SIZE ERROR NC1764.2 +091800 MOVE "E" TO SIZE-ERR. NC1764.2 +091900 ADD-B-F1-19. NC1764.2 +092000 EXIT. NC1764.2 +092100 ADD-WRITE-F1-19. NC1764.2 +092200 MOVE "ADD, COMP, SIZE ERR" TO FEATURE. NC1764.2 +092300 MOVE "ADD-TEST-F1-19" TO PAR-NAME. NC1764.2 +092400 PERFORM PRINT-DETAIL. NC1764.2 +092500* NC1764.2 +092600 ADD-INIT-F1-20. NC1764.2 +092700* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +092800 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +092900 MOVE -11 TO WRK-DS-02V00. NC1764.2 +093000 ADD-TEST-F1-20. NC1764.2 +093100 ADD -99 TO WRK-DS-02V00 NC1764.2 +093200 NOT ON SIZE ERROR NC1764.2 +093300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +093400 TO RE-MARK NC1764.2 +093500 PERFORM FAIL NC1764.2 +093600 GO TO ADD-WRITE-F1-20. NC1764.2 +093700 GO TO ADD-PASS-F1-20. NC1764.2 +093800 ADD-DELETE-F1-20. NC1764.2 +093900 PERFORM DE-LETE. NC1764.2 +094000 GO TO ADD-WRITE-F1-20. NC1764.2 +094100 ADD-PASS-F1-20. NC1764.2 +094200 PERFORM PASS. NC1764.2 +094300 ADD-WRITE-F1-20. NC1764.2 +094400 MOVE "ADD-TEST-F1-20" TO PAR-NAME. NC1764.2 +094500 PERFORM PRINT-DETAIL. NC1764.2 +094600* NC1764.2 +094700 ADD-INIT-F1-21. NC1764.2 +094800* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +094900 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +095000 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +095100 ADD-TEST-F1-21-0. NC1764.2 +095200 ADD A12THREES-DS-06V06 NC1764.2 +095300 333333 NC1764.2 +095400 A06THREES-DS-03V03 NC1764.2 +095500 TO WRK-DS-06V06 ROUNDED NC1764.2 +095600 NOT ON SIZE ERROR NC1764.2 +095700 GO TO ADD-PASS-F1-21. NC1764.2 +095800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC1764.2 +095900 PERFORM FAIL. NC1764.2 +096000 GO TO ADD-WRITE-F1-21. NC1764.2 +096100 ADD-DELETE-F1-21. NC1764.2 +096200 PERFORM DE-LETE. NC1764.2 +096300 GO TO ADD-WRITE-F1-21. NC1764.2 +096400 ADD-PASS-F1-21. NC1764.2 +096500 PERFORM PASS. NC1764.2 +096600 ADD-WRITE-F1-21. NC1764.2 +096700 MOVE "ADD-TEST-F1-21" TO PAR-NAME. NC1764.2 +096800 PERFORM PRINT-DETAIL. NC1764.2 +096900* NC1764.2 +097000 ADD-INIT-F1-22. NC1764.2 +097100* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +097200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +097300 MOVE -11 TO WRK-DS-02V00. NC1764.2 +097400 ADD-TEST-F1-22-0. NC1764.2 +097500 ADD -99 TO WRK-DS-02V00 NC1764.2 +097600 ON SIZE ERROR NC1764.2 +097700 PERFORM PASS NC1764.2 +097800 GO TO ADD-WRITE-F1-22 NC1764.2 +097900 NOT ON SIZE ERROR NC1764.2 +098000 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +098100 TO RE-MARK NC1764.2 +098200 PERFORM FAIL NC1764.2 +098300 GO TO ADD-WRITE-F1-22. NC1764.2 +098400 ADD-DELETE-F1-22. NC1764.2 +098500 PERFORM DE-LETE. NC1764.2 +098600 ADD-WRITE-F1-22. NC1764.2 +098700 MOVE "ADD-TEST-F1-22" TO PAR-NAME. NC1764.2 +098800 PERFORM PRINT-DETAIL. NC1764.2 +098900* NC1764.2 +099000 ADD-INIT-F1-23. NC1764.2 +099100* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +099200 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +099300 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +099400 ADD-TEST-F1-23-0. NC1764.2 +099500 ADD A12THREES-DS-06V06 NC1764.2 +099600 333333 NC1764.2 +099700 A06THREES-DS-03V03 NC1764.2 +099800 TO WRK-DS-06V06 ROUNDED NC1764.2 +099900 ON SIZE ERROR NC1764.2 +100000 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +100100 TO RE-MARK NC1764.2 +100200 PERFORM FAIL NC1764.2 +100300 GO TO ADD-WRITE-F1-23 NC1764.2 +100400 NOT ON SIZE ERROR NC1764.2 +100500 GO TO ADD-PASS-F1-23. NC1764.2 +100600 ADD-DELETE-F1-23. NC1764.2 +100700 PERFORM DE-LETE. NC1764.2 +100800 GO TO ADD-WRITE-F1-23. NC1764.2 +100900 ADD-PASS-F1-23. NC1764.2 +101000 PERFORM PASS. NC1764.2 +101100 ADD-WRITE-F1-23. NC1764.2 +101200 MOVE "ADD-TEST-F1-23" TO PAR-NAME. NC1764.2 +101300 PERFORM PRINT-DETAIL. NC1764.2 +101400* NC1764.2 +101500 ADD-INIT-F1-24. NC1764.2 +101600* ==--> MULTIPLE OPERANDS <--== NC1764.2 +101700 MOVE "V1-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +101800 MOVE "ADD LIMIT TESTS " TO FEATURE. NC1764.2 +101900 MOVE 1 TO DNAME1 DNAME2 DNAME3 DNAME4 DNAME5. NC1764.2 +102000 MOVE 1 TO DNAME6 DNAME7 DNAME8 DNAME9 DNAME10. NC1764.2 +102100 MOVE 1 TO DNAME11 DNAME12 DNAME13 DNAME14 DNAME15. NC1764.2 +102200 MOVE 1 TO DNAME16 DNAME17 DNAME18 DNAME19 DNAME20. NC1764.2 +102300 MOVE 1 TO DNAME21. NC1764.2 +102400 MOVE 0 TO DNAME22. NC1764.2 +102500* THE FOLLOWING 22 TESTS VERIFY THE ABILITY OF THE COMPILER NC1764.2 +102600* TO HANDLE A MAXIMUM OF 42 OPERANDS. A DELETION IN THIS NC1764.2 +102700* PARAGRAPH WILL SKIP THE LIMIT TESTS. NC1764.2 +102800 GO TO ADD-TEST-F1-24. NC1764.2 +102900 ADD-INIT-DELETE. NC1764.2 +103000 PERFORM DE-LETE. NC1764.2 +103100 MOVE "ADD-TEST-F1-24 TO F1-45" TO PAR-NAME. NC1764.2 +103200 MOVE "ADD LIMIT TESTS " TO FEATURE. NC1764.2 +103300 ADD 21 TO DELETE-COUNTER. NC1764.2 +103400 PERFORM PRINT-DETAIL. NC1764.2 +103500 GO TO ADD-INIT-F1-46. NC1764.2 +103600 ADD-TEST-F1-24. NC1764.2 +103700 ADD DNAME1 NC1764.2 +103800 DNAME2 NC1764.2 +103900 DNAME3 NC1764.2 +104000 DNAME4 NC1764.2 +104100 DNAME5 NC1764.2 +104200 DNAME6 NC1764.2 +104300 DNAME7 NC1764.2 +104400 DNAME8 NC1764.2 +104500 DNAME9 NC1764.2 +104600 DNAME10 NC1764.2 +104700 DNAME11 NC1764.2 +104800 DNAME12 NC1764.2 +104900 DNAME13 NC1764.2 +105000 DNAME14 NC1764.2 +105100 DNAME15 NC1764.2 +105200 DNAME16 NC1764.2 +105300 DNAME17 NC1764.2 +105400 DNAME18 NC1764.2 +105500 DNAME19 NC1764.2 +105600 DNAME20 NC1764.2 +105700 DNAME21 NC1764.2 +105800 TO DNAME22. NC1764.2 +105900* THE NUMBER OF OPERANDS CAPABLE OF BEING ADDED TO ONE NC1764.2 +106000* DATANAME WILL BE REFLECTED BY THE COMPUTED-ANSWER. NC1764.2 +106100 IF DNAME22 EQUAL TO 21 NC1764.2 +106200 PERFORM PASS NC1764.2 +106300 GO TO ADD-WRITE-F1-24. NC1764.2 +106400 MOVE 21 TO CORRECT-18V0. NC1764.2 +106500 MOVE DNAME22 TO COMPUTED-18V0. NC1764.2 +106600 PERFORM FAIL. NC1764.2 +106700 GO TO ADD-WRITE-F1-24. NC1764.2 +106800 ADD-DELETE-F1-24. NC1764.2 +106900 PERFORM DE-LETE. NC1764.2 +107000 ADD-WRITE-F1-24. NC1764.2 +107100 MOVE "ADD-TEST-F1-24 " TO PAR-NAME. NC1764.2 +107200 PERFORM PRINT-DETAIL. NC1764.2 +107300 ADD-INIT-F1-25. NC1764.2 +107400 MOVE ZERO TO DNAME22 DNAME23 DNAME24 DNAME25 DNAME26. NC1764.2 +107500 MOVE ZERO TO DNAME27 DNAME28 DNAME29 DNAME30 DNAME31. NC1764.2 +107600 MOVE ZERO TO DNAME32 DNAME33 DNAME34 DNAME35 DNAME36. NC1764.2 +107700 MOVE ZERO TO DNAME37 DNAME38 DNAME39 DNAME40 DNAME41. NC1764.2 +107800 MOVE ZERO TO DNAME42. NC1764.2 +107900 ADD-TEST-F1-25. NC1764.2 +108000 ADD DNAME1 NC1764.2 +108100 DNAME2 NC1764.2 +108200 DNAME3 NC1764.2 +108300 DNAME4 NC1764.2 +108400 DNAME5 NC1764.2 +108500 DNAME6 NC1764.2 +108600 DNAME7 NC1764.2 +108700 DNAME8 NC1764.2 +108800 DNAME9 NC1764.2 +108900 DNAME10 NC1764.2 +109000 DNAME11 NC1764.2 +109100 DNAME12 NC1764.2 +109200 DNAME13 NC1764.2 +109300 DNAME14 NC1764.2 +109400 DNAME15 NC1764.2 +109500 DNAME16 NC1764.2 +109600 DNAME17 NC1764.2 +109700 DNAME18 NC1764.2 +109800 DNAME19 NC1764.2 +109900 DNAME20 NC1764.2 +110000 DNAME21 NC1764.2 +110100 TO DNAME22 NC1764.2 +110200 DNAME23 NC1764.2 +110300 DNAME24 NC1764.2 +110400 DNAME25 NC1764.2 +110500 DNAME26 NC1764.2 +110600 DNAME27 NC1764.2 +110700 DNAME28 NC1764.2 +110800 DNAME29 NC1764.2 +110900 DNAME30 NC1764.2 +111000 DNAME31 NC1764.2 +111100 DNAME32 NC1764.2 +111200 DNAME33 NC1764.2 +111300 DNAME34 NC1764.2 +111400 DNAME35 NC1764.2 +111500 DNAME36 NC1764.2 +111600 DNAME37 NC1764.2 +111700 DNAME38 NC1764.2 +111800 DNAME39 NC1764.2 +111900 DNAME40 NC1764.2 +112000 DNAME41 NC1764.2 +112100 DNAME42. NC1764.2 +112200 IF DNAME22 EQUAL TO 21 NC1764.2 +112300 PERFORM PASS NC1764.2 +112400 GO TO ADD-WRITE-F1-25. NC1764.2 +112500 MOVE 21 TO CORRECT-18V0. NC1764.2 +112600 MOVE DNAME22 TO COMPUTED-18V0. NC1764.2 +112700 PERFORM FAIL. NC1764.2 +112800 GO TO ADD-WRITE-F1-25. NC1764.2 +112900 ADD-DELETE-F1-25. NC1764.2 +113000 PERFORM DE-LETE. NC1764.2 +113100 ADD-WRITE-F1-25. NC1764.2 +113200 MOVE "ADD-TEST-F1-25 " TO PAR-NAME. NC1764.2 +113300 PERFORM PRINT-DETAIL. NC1764.2 +113400 ADD-TEST-F1-26. NC1764.2 +113500 IF DNAME23 EQUAL TO 21 NC1764.2 +113600 PERFORM PASS NC1764.2 +113700 GO TO ADD-WRITE-F1-26. NC1764.2 +113800 MOVE 21 TO CORRECT-18V0. NC1764.2 +113900 MOVE DNAME23 TO COMPUTED-18V0. NC1764.2 +114000 PERFORM FAIL. NC1764.2 +114100 GO TO ADD-WRITE-F1-26. NC1764.2 +114200 ADD-DELETE-F1-26. NC1764.2 +114300 PERFORM DE-LETE. NC1764.2 +114400 ADD-WRITE-F1-26. NC1764.2 +114500 MOVE "ADD-TEST-F1-26 " TO PAR-NAME. NC1764.2 +114600 PERFORM PRINT-DETAIL. NC1764.2 +114700 ADD-TEST-F1-27. NC1764.2 +114800 IF DNAME24 EQUAL TO 21 NC1764.2 +114900 PERFORM PASS NC1764.2 +115000 GO TO ADD-WRITE-F1-27. NC1764.2 +115100 MOVE 21 TO CORRECT-18V0. NC1764.2 +115200 MOVE DNAME24 TO COMPUTED-18V0. NC1764.2 +115300 PERFORM FAIL. NC1764.2 +115400 GO TO ADD-WRITE-F1-27. NC1764.2 +115500 ADD-DELETE-F1-27. NC1764.2 +115600 PERFORM DE-LETE. NC1764.2 +115700 ADD-WRITE-F1-27. NC1764.2 +115800 MOVE "ADD-TEST-F1-27 " TO PAR-NAME. NC1764.2 +115900 PERFORM PRINT-DETAIL. NC1764.2 +116000 ADD-TEST-F1-28. NC1764.2 +116100 IF DNAME25 EQUAL TO 21 NC1764.2 +116200 PERFORM PASS NC1764.2 +116300 GO TO ADD-WRITE-F1-28. NC1764.2 +116400 MOVE 21 TO CORRECT-18V0. NC1764.2 +116500 MOVE DNAME25 TO COMPUTED-18V0. NC1764.2 +116600 PERFORM FAIL. NC1764.2 +116700 GO TO ADD-WRITE-F1-28. NC1764.2 +116800 ADD-DELETE-F1-28. NC1764.2 +116900 PERFORM DE-LETE. NC1764.2 +117000 ADD-WRITE-F1-28. NC1764.2 +117100 MOVE "ADD-TEST-F1-28 " TO PAR-NAME. NC1764.2 +117200 PERFORM PRINT-DETAIL. NC1764.2 +117300 ADD-TEST-F1-29. NC1764.2 +117400 IF DNAME26 EQUAL TO 21 NC1764.2 +117500 PERFORM PASS NC1764.2 +117600 GO TO ADD-WRITE-F1-29. NC1764.2 +117700 MOVE 21 TO CORRECT-18V0. NC1764.2 +117800 MOVE DNAME26 TO COMPUTED-18V0. NC1764.2 +117900 PERFORM FAIL. NC1764.2 +118000 GO TO ADD-WRITE-F1-29. NC1764.2 +118100 ADD-DELETE-F1-29. NC1764.2 +118200 PERFORM DE-LETE. NC1764.2 +118300 ADD-WRITE-F1-29. NC1764.2 +118400 MOVE "ADD-TEST-F1-29 " TO PAR-NAME. NC1764.2 +118500 PERFORM PRINT-DETAIL. NC1764.2 +118600 ADD-TEST-F1-30. NC1764.2 +118700 IF DNAME27 EQUAL TO 21 NC1764.2 +118800 PERFORM PASS NC1764.2 +118900 GO TO ADD-WRITE-F1-30. NC1764.2 +119000 MOVE 21 TO CORRECT-18V0. NC1764.2 +119100 MOVE DNAME27 TO COMPUTED-18V0. NC1764.2 +119200 PERFORM FAIL. NC1764.2 +119300 GO TO ADD-WRITE-F1-30. NC1764.2 +119400 ADD-DELETE-F1-30. NC1764.2 +119500 PERFORM DE-LETE. NC1764.2 +119600 ADD-WRITE-F1-30. NC1764.2 +119700 MOVE "ADD-TEST-F1-30 " TO PAR-NAME. NC1764.2 +119800 PERFORM PRINT-DETAIL. NC1764.2 +119900 ADD-TEST-F1-31. NC1764.2 +120000 IF DNAME28 EQUAL TO 21 NC1764.2 +120100 PERFORM PASS NC1764.2 +120200 GO TO ADD-WRITE-F1-31. NC1764.2 +120300 MOVE 21 TO CORRECT-18V0. NC1764.2 +120400 MOVE DNAME28 TO COMPUTED-18V0. NC1764.2 +120500 PERFORM FAIL. NC1764.2 +120600 GO TO ADD-WRITE-F1-31. NC1764.2 +120700 ADD-DELETE-F1-31. NC1764.2 +120800 PERFORM DE-LETE. NC1764.2 +120900 ADD-WRITE-F1-31. NC1764.2 +121000 MOVE "ADD-TEST-F1-31 " TO PAR-NAME. NC1764.2 +121100 PERFORM PRINT-DETAIL. NC1764.2 +121200 ADD-TEST-F1-32. NC1764.2 +121300 IF DNAME29 EQUAL TO 21 NC1764.2 +121400 PERFORM PASS NC1764.2 +121500 GO TO ADD-WRITE-F1-32. NC1764.2 +121600 MOVE 21 TO CORRECT-18V0. NC1764.2 +121700 MOVE DNAME29 TO COMPUTED-18V0. NC1764.2 +121800 PERFORM FAIL. NC1764.2 +121900 GO TO ADD-WRITE-F1-32. NC1764.2 +122000 ADD-DELETE-F1-32. NC1764.2 +122100 PERFORM DE-LETE. NC1764.2 +122200 ADD-WRITE-F1-32. NC1764.2 +122300 MOVE "ADD-TEST-F1-32 " TO PAR-NAME. NC1764.2 +122400 PERFORM PRINT-DETAIL. NC1764.2 +122500 ADD-TEST-F1-33. NC1764.2 +122600 IF DNAME30 EQUAL TO 21 NC1764.2 +122700 PERFORM PASS NC1764.2 +122800 GO TO ADD-WRITE-F1-33. NC1764.2 +122900 MOVE 21 TO CORRECT-18V0. NC1764.2 +123000 MOVE DNAME30 TO COMPUTED-18V0. NC1764.2 +123100 PERFORM FAIL. NC1764.2 +123200 GO TO ADD-WRITE-F1-33. NC1764.2 +123300 ADD-DELETE-F1-33. NC1764.2 +123400 PERFORM DE-LETE. NC1764.2 +123500 ADD-WRITE-F1-33. NC1764.2 +123600 MOVE "ADD-TEST-F1-33 " TO PAR-NAME. NC1764.2 +123700 PERFORM PRINT-DETAIL. NC1764.2 +123800 ADD-TEST-F1-34. NC1764.2 +123900 IF DNAME31 EQUAL TO 21 NC1764.2 +124000 PERFORM PASS NC1764.2 +124100 GO TO ADD-WRITE-F1-34. NC1764.2 +124200 MOVE 21 TO CORRECT-18V0. NC1764.2 +124300 MOVE DNAME31 TO COMPUTED-18V0. NC1764.2 +124400 PERFORM FAIL. NC1764.2 +124500 GO TO ADD-WRITE-F1-34. NC1764.2 +124600 ADD-DELETE-F1-34. NC1764.2 +124700 PERFORM DE-LETE. NC1764.2 +124800 ADD-WRITE-F1-34. NC1764.2 +124900 MOVE "ADD-TEST-F1-34 " TO PAR-NAME. NC1764.2 +125000 PERFORM PRINT-DETAIL. NC1764.2 +125100 ADD-TEST-F1-35. NC1764.2 +125200 IF DNAME32 EQUAL TO 21 NC1764.2 +125300 PERFORM PASS NC1764.2 +125400 GO TO ADD-WRITE-F1-35. NC1764.2 +125500 MOVE 21 TO CORRECT-18V0. NC1764.2 +125600 MOVE DNAME32 TO COMPUTED-18V0. NC1764.2 +125700 PERFORM FAIL. NC1764.2 +125800 GO TO ADD-WRITE-F1-35. NC1764.2 +125900 ADD-DELETE-F1-35. NC1764.2 +126000 PERFORM DE-LETE. NC1764.2 +126100 ADD-WRITE-F1-35. NC1764.2 +126200 MOVE "ADD-TEST-F1-35 " TO PAR-NAME. NC1764.2 +126300 PERFORM PRINT-DETAIL. NC1764.2 +126400 ADD-TEST-F1-36. NC1764.2 +126500 IF DNAME33 EQUAL TO 21 NC1764.2 +126600 PERFORM PASS NC1764.2 +126700 GO TO ADD-WRITE-F1-36. NC1764.2 +126800 MOVE 21 TO CORRECT-18V0. NC1764.2 +126900 MOVE DNAME33 TO COMPUTED-18V0. NC1764.2 +127000 PERFORM FAIL. NC1764.2 +127100 GO TO ADD-WRITE-F1-36. NC1764.2 +127200 ADD-DELETE-F1-36. NC1764.2 +127300 PERFORM DE-LETE. NC1764.2 +127400 ADD-WRITE-F1-36. NC1764.2 +127500 MOVE "ADD-TEST-F1-36 " TO PAR-NAME. NC1764.2 +127600 PERFORM PRINT-DETAIL. NC1764.2 +127700 ADD-TEST-F1-37. NC1764.2 +127800 IF DNAME34 EQUAL TO 21 NC1764.2 +127900 PERFORM PASS NC1764.2 +128000 GO TO ADD-WRITE-F1-37. NC1764.2 +128100 MOVE 21 TO CORRECT-18V0. NC1764.2 +128200 MOVE DNAME34 TO COMPUTED-18V0. NC1764.2 +128300 PERFORM FAIL. NC1764.2 +128400 GO TO ADD-WRITE-F1-37. NC1764.2 +128500 ADD-DELETE-F1-37. NC1764.2 +128600 PERFORM DE-LETE. NC1764.2 +128700 ADD-WRITE-F1-37. NC1764.2 +128800 MOVE "ADD-TEST-F1-37 " TO PAR-NAME. NC1764.2 +128900 PERFORM PRINT-DETAIL. NC1764.2 +129000 ADD-TEST-F1-38. NC1764.2 +129100 IF DNAME35 EQUAL TO 21 NC1764.2 +129200 PERFORM PASS NC1764.2 +129300 GO TO ADD-WRITE-F1-38. NC1764.2 +129400 MOVE 21 TO CORRECT-18V0. NC1764.2 +129500 MOVE DNAME35 TO COMPUTED-18V0. NC1764.2 +129600 PERFORM FAIL. NC1764.2 +129700 GO TO ADD-WRITE-F1-38. NC1764.2 +129800 ADD-DELETE-F1-38. NC1764.2 +129900 PERFORM DE-LETE. NC1764.2 +130000 ADD-WRITE-F1-38. NC1764.2 +130100 MOVE "ADD-TEST-F1-38 " TO PAR-NAME. NC1764.2 +130200 PERFORM PRINT-DETAIL. NC1764.2 +130300 ADD-TEST-F1-39. NC1764.2 +130400 IF DNAME36 EQUAL TO 21 NC1764.2 +130500 PERFORM PASS NC1764.2 +130600 GO TO ADD-WRITE-F1-39. NC1764.2 +130700 MOVE 21 TO CORRECT-18V0. NC1764.2 +130800 MOVE DNAME36 TO COMPUTED-18V0. NC1764.2 +130900 PERFORM FAIL. NC1764.2 +131000 GO TO ADD-WRITE-F1-39. NC1764.2 +131100 ADD-DELETE-F1-39. NC1764.2 +131200 PERFORM DE-LETE. NC1764.2 +131300 ADD-WRITE-F1-39. NC1764.2 +131400 MOVE "ADD-TEST-F1-39 " TO PAR-NAME. NC1764.2 +131500 PERFORM PRINT-DETAIL. NC1764.2 +131600 ADD-TEST-F1-40. NC1764.2 +131700 IF DNAME37 EQUAL TO 21 NC1764.2 +131800 PERFORM PASS NC1764.2 +131900 GO TO ADD-WRITE-F1-40. NC1764.2 +132000 MOVE 21 TO CORRECT-18V0. NC1764.2 +132100 MOVE DNAME37 TO COMPUTED-18V0. NC1764.2 +132200 PERFORM FAIL. NC1764.2 +132300 GO TO ADD-WRITE-F1-40. NC1764.2 +132400 ADD-DELETE-F1-40. NC1764.2 +132500 PERFORM DE-LETE. NC1764.2 +132600 ADD-WRITE-F1-40. NC1764.2 +132700 MOVE "ADD-TEST-F1-40 " TO PAR-NAME. NC1764.2 +132800 PERFORM PRINT-DETAIL. NC1764.2 +132900 ADD-TEST-F1-41. NC1764.2 +133000 IF DNAME38 EQUAL TO 21 NC1764.2 +133100 PERFORM PASS NC1764.2 +133200 GO TO ADD-WRITE-F1-41. NC1764.2 +133300 MOVE 21 TO CORRECT-18V0. NC1764.2 +133400 MOVE DNAME38 TO COMPUTED-18V0. NC1764.2 +133500 PERFORM FAIL. NC1764.2 +133600 GO TO ADD-WRITE-F1-41. NC1764.2 +133700 ADD-DELETE-F1-41. NC1764.2 +133800 PERFORM DE-LETE. NC1764.2 +133900 ADD-WRITE-F1-41. NC1764.2 +134000 MOVE "ADD-TEST-F1-41 " TO PAR-NAME. NC1764.2 +134100 PERFORM PRINT-DETAIL. NC1764.2 +134200 ADD-TEST-F1-42. NC1764.2 +134300 IF DNAME39 EQUAL TO 21 NC1764.2 +134400 PERFORM PASS NC1764.2 +134500 GO TO ADD-WRITE-F1-42. NC1764.2 +134600 MOVE 21 TO CORRECT-18V0. NC1764.2 +134700 MOVE DNAME39 TO COMPUTED-18V0. NC1764.2 +134800 PERFORM FAIL. NC1764.2 +134900 GO TO ADD-WRITE-F1-42. NC1764.2 +135000 ADD-DELETE-F1-42. NC1764.2 +135100 PERFORM DE-LETE. NC1764.2 +135200 ADD-WRITE-F1-42. NC1764.2 +135300 MOVE "ADD-TEST-F1-42 " TO PAR-NAME. NC1764.2 +135400 PERFORM PRINT-DETAIL. NC1764.2 +135500 ADD-TEST-F1-43. NC1764.2 +135600 IF DNAME40 EQUAL TO 21 NC1764.2 +135700 PERFORM PASS NC1764.2 +135800 GO TO ADD-WRITE-F1-43. NC1764.2 +135900 MOVE 21 TO CORRECT-18V0. NC1764.2 +136000 MOVE DNAME40 TO COMPUTED-18V0. NC1764.2 +136100 PERFORM FAIL. NC1764.2 +136200 GO TO ADD-WRITE-F1-43. NC1764.2 +136300 ADD-DELETE-F1-43. NC1764.2 +136400 PERFORM DE-LETE. NC1764.2 +136500 ADD-WRITE-F1-43. NC1764.2 +136600 MOVE "ADD-TEST-F1-43 " TO PAR-NAME. NC1764.2 +136700 PERFORM PRINT-DETAIL. NC1764.2 +136800 ADD-TEST-F1-44. NC1764.2 +136900 IF DNAME41 EQUAL TO 21 NC1764.2 +137000 PERFORM PASS NC1764.2 +137100 GO TO ADD-WRITE-F1-44. NC1764.2 +137200 MOVE 21 TO CORRECT-18V0. NC1764.2 +137300 MOVE DNAME41 TO COMPUTED-18V0. NC1764.2 +137400 PERFORM FAIL. NC1764.2 +137500 GO TO ADD-WRITE-F1-44. NC1764.2 +137600 ADD-DELETE-F1-44. NC1764.2 +137700 PERFORM DE-LETE. NC1764.2 +137800 ADD-WRITE-F1-44. NC1764.2 +137900 MOVE "ADD-TEST-F1-44 " TO PAR-NAME. NC1764.2 +138000 PERFORM PRINT-DETAIL. NC1764.2 +138100 ADD-TEST-F1-45. NC1764.2 +138200 IF DNAME42 EQUAL TO 21 NC1764.2 +138300 PERFORM PASS NC1764.2 +138400 GO TO ADD-WRITE-F1-45. NC1764.2 +138500 MOVE 21 TO CORRECT-18V0. NC1764.2 +138600 MOVE DNAME42 TO COMPUTED-18V0. NC1764.2 +138700 PERFORM FAIL. NC1764.2 +138800 GO TO ADD-WRITE-F1-45. NC1764.2 +138900 ADD-DELETE-F1-45. NC1764.2 +139000 PERFORM DE-LETE. NC1764.2 +139100 ADD-WRITE-F1-45. NC1764.2 +139200 MOVE "ADD-TEST-F1-45 " TO PAR-NAME. NC1764.2 +139300 PERFORM PRINT-DETAIL. NC1764.2 +139400* NC1764.2 +139500 ADD-INIT-F1-46. NC1764.2 +139600* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +139700 MOVE "VI-74 6.6.4 GR1" TO ANSI-REFERENCE. NC1764.2 +139800 MOVE "ADD-TEST-F1-46" TO PAR-NAME. NC1764.2 +139900 MOVE "ADD-TO-SERIES" TO FEATURE. NC1764.2 +140000 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +140100 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +140200 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +140300 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +140400 MOVE 1 TO REC-CT. NC1764.2 +140500 ADD-TEST-F1-46-0. NC1764.2 +140600 ADD WRK-DU-1V1-1 WRK-DU-1V1-2 6 TO WRK-DU-2V1-1, NC1764.2 +140700 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1764.2 +140800 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +140900 GO TO ADD-TEST-F1-46-1. NC1764.2 +141000 ADD-DELETE-F1-46. NC1764.2 +141100 PERFORM DE-LETE. NC1764.2 +141200 PERFORM PRINT-DETAIL. NC1764.2 +141300 GO TO ADD-INIT-F1-47. NC1764.2 +141400 ADD-TEST-F1-46-1. NC1764.2 +141500 IF WRK-DU-2V1-1 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +141600 ELSE NC1764.2 +141700 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.5 NC1764.2 +141800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +141900 ADD 1 TO REC-CT. NC1764.2 +142000 ADD-TEST-F1-46-2. NC1764.2 +142100 IF WRK-DU-2V0-1 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +142200 ELSE NC1764.2 +142300 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 10 TO NC1764.2 +142400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +142500 ADD 1 TO REC-CT. NC1764.2 +142600 ADD-TEST-F1-46-3. NC1764.2 +142700 IF WRK-DU-2V1-2 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +142800 ELSE NC1764.2 +142900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +143000 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +143100 ADD 1 TO REC-CT. NC1764.2 +143200 ADD-TEST-F1-46-4. NC1764.2 +143300 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +143400 ELSE NC1764.2 +143500 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 TO NC1764.2 +143600 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +143700 ADD 1 TO REC-CT. NC1764.2 +143800 ADD-TEST-F1-46-5. NC1764.2 +143900 IF WRK-DU-2V1-3 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +144000 ELSE NC1764.2 +144100 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +144200 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +144300 ADD 1 TO REC-CT. NC1764.2 +144400 ADD-TEST-F1-46-6. NC1764.2 +144500 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +144600 ELSE NC1764.2 +144700 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 TO NC1764.2 +144800 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +144900* NC1764.2 +145000 ADD-INIT-F1-47. NC1764.2 +145100* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +145200* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +145300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +145400 MOVE "ADD-TEST-F1-47" TO PAR-NAME. NC1764.2 +145500 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +145600 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +145700 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +145800 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +145900 MOVE "0" TO WRK-XN-00001. NC1764.2 +146000 MOVE 1 TO REC-CT. NC1764.2 +146100 ADD-TEST-F1-47-0. NC1764.2 +146200 ADD WRK-DU-1V1-1 WRK-DU-1V1-2 6 TO WRK-DU-2V1-1, NC1764.2 +146300 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1764.2 +146400 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1764.2 +146500 ON SIZE ERROR NC1764.2 +146600 MOVE "1" TO WRK-XN-00001. NC1764.2 +146700 GO TO ADD-TEST-F1-47-1. NC1764.2 +146800 ADD-DELETE-F1-47. NC1764.2 +146900 PERFORM DE-LETE. NC1764.2 +147000 PERFORM PRINT-DETAIL. NC1764.2 +147100 GO TO ADD-INIT-F1-48. NC1764.2 +147200 ADD-TEST-F1-47-1. NC1764.2 +147300 MOVE "ADD-TEST-F1-47-1" TO PAR-NAME. NC1764.2 +147400 IF WRK-DU-2V1-1 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +147500 ELSE NC1764.2 +147600 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.5 NC1764.2 +147700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +147800 ADD 1 TO REC-CT. NC1764.2 +147900 ADD-TEST-F1-47-2. NC1764.2 +148000 MOVE "ADD-TEST-F1-47-2" TO PAR-NAME. NC1764.2 +148100 IF WRK-DU-2V0-1 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +148200 ELSE NC1764.2 +148300 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 10 TO NC1764.2 +148400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +148500 ADD 1 TO REC-CT. NC1764.2 +148600 ADD-TEST-F1-47-3. NC1764.2 +148700 MOVE "ADD-TEST-F1-47-3" TO PAR-NAME. NC1764.2 +148800 IF WRK-DU-2V1-2 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +148900 ELSE NC1764.2 +149000 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +149100 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +149200 ADD 1 TO REC-CT. NC1764.2 +149300 ADD-TEST-F1-47-4. NC1764.2 +149400 MOVE "ADD-TEST-F1-47-4" TO PAR-NAME. NC1764.2 +149500 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +149600 ELSE NC1764.2 +149700 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 TO NC1764.2 +149800 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +149900 ADD 1 TO REC-CT. NC1764.2 +150000 ADD-TEST-F1-47-5. NC1764.2 +150100 MOVE "ADD-TEST-F1-47-5" TO PAR-NAME. NC1764.2 +150200 IF WRK-DU-2V1-3 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +150300 ELSE NC1764.2 +150400 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +150500 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +150600 ADD 1 TO REC-CT. NC1764.2 +150700 ADD-TEST-F1-47-6. NC1764.2 +150800 MOVE "ADD-TEST-F1-47-6" TO PAR-NAME. NC1764.2 +150900 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +151000 ELSE NC1764.2 +151100 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 TO NC1764.2 +151200 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +151300 ADD 1 TO REC-CT. NC1764.2 +151400 ADD-TEST-F1-47-7. NC1764.2 +151500 MOVE "ADD-TEST-F1-47-7" TO PAR-NAME. NC1764.2 +151600 IF WRK-XN-00001 = "0" NC1764.2 +151700 PERFORM PASS NC1764.2 +151800 PERFORM PRINT-DETAIL NC1764.2 +151900 ELSE NC1764.2 +152000 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +152100 TO RE-MARK NC1764.2 +152200 MOVE "0" TO CORRECT-X NC1764.2 +152300 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +152400 PERFORM FAIL NC1764.2 +152500 PERFORM PRINT-DETAIL. NC1764.2 +152600* NC1764.2 +152700 ADD-INIT-F1-48. NC1764.2 +152800* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +152900* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +153000 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +153100 MOVE "ADD-TEST-F1-48" TO PAR-NAME. NC1764.2 +153200 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +153300 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +153400 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +153500 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +153600 MOVE "0" TO WRK-XN-00001. NC1764.2 +153700 MOVE 1 TO REC-CT. NC1764.2 +153800 ADD-TEST-F1-48-0. NC1764.2 +153900 ADD A17TWOS-DS-17V00 NC1764.2 +154000 WRK-DU-1V1-2 6 NC1764.2 +154100 TO WRK-DU-2V1-1 NC1764.2 +154200 WRK-DU-2V0-1 ROUNDED NC1764.2 +154300 WRK-DU-2V1-2 NC1764.2 +154400 WRK-DU-2V0-2 ROUNDED NC1764.2 +154500 WRK-DU-2V1-3 NC1764.2 +154600 WRK-DU-2V0-3 NC1764.2 +154700 ON SIZE ERROR NC1764.2 +154800 MOVE "1" TO WRK-XN-00001. NC1764.2 +154900 GO TO ADD-TEST-F1-48-1. NC1764.2 +155000 ADD-DELETE-F1-48. NC1764.2 +155100 PERFORM DE-LETE. NC1764.2 +155200 PERFORM PRINT-DETAIL. NC1764.2 +155300 GO TO ADD-INIT-F1-49. NC1764.2 +155400 ADD-TEST-F1-48-1. NC1764.2 +155500 MOVE "ADD-TEST-F1-48-1" TO PAR-NAME. NC1764.2 +155600 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +155700 ELSE NC1764.2 +155800 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 0 NC1764.2 +155900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +156000 ADD 1 TO REC-CT. NC1764.2 +156100 ADD-TEST-F1-48-2. NC1764.2 +156200 MOVE "ADD-TEST-F1-48-2" TO PAR-NAME. NC1764.2 +156300 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +156400 ELSE NC1764.2 +156500 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 0 TO NC1764.2 +156600 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +156700 ADD 1 TO REC-CT. NC1764.2 +156800 ADD-TEST-F1-48-3. NC1764.2 +156900 MOVE "ADD-TEST-F1-48-3" TO PAR-NAME. NC1764.2 +157000 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +157100 ELSE NC1764.2 +157200 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +157300 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +157400 ADD 1 TO REC-CT. NC1764.2 +157500 ADD-TEST-F1-48-4. NC1764.2 +157600 MOVE "ADD-TEST-F1-48-4" TO PAR-NAME. NC1764.2 +157700 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +157800 ELSE NC1764.2 +157900 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +158000 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +158100 ADD 1 TO REC-CT. NC1764.2 +158200 ADD-TEST-F1-48-5. NC1764.2 +158300 MOVE "ADD-TEST-F1-48-5" TO PAR-NAME. NC1764.2 +158400 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +158500 ELSE NC1764.2 +158600 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +158700 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +158800 ADD 1 TO REC-CT. NC1764.2 +158900 ADD-TEST-F1-48-6. NC1764.2 +159000 MOVE "ADD-TEST-F1-48-6" TO PAR-NAME. NC1764.2 +159100 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +159200 ELSE NC1764.2 +159300 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +159400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +159500 ADD 1 TO REC-CT. NC1764.2 +159600 ADD-TEST-F1-48-7. NC1764.2 +159700 MOVE "ADD-TEST-F1-48-7" TO PAR-NAME. NC1764.2 +159800 IF WRK-XN-00001 = "1" NC1764.2 +159900 PERFORM PASS NC1764.2 +160000 PERFORM PRINT-DETAIL NC1764.2 +160100 ELSE NC1764.2 +160200 MOVE "SIZE ERROR NOT EXECUTED" TO RE-MARK NC1764.2 +160300 MOVE "1" TO CORRECT-X NC1764.2 +160400 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +160500 PERFORM FAIL NC1764.2 +160600 PERFORM PRINT-DETAIL. NC1764.2 +160700* NC1764.2 +160800 ADD-INIT-F1-49. NC1764.2 +160900* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +161000* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +161100 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +161200 MOVE "ADD-TEST-F1-49" TO PAR-NAME. NC1764.2 +161300 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +161400 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +161500 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +161600 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +161700 MOVE "0" TO WRK-XN-00001. NC1764.2 +161800 MOVE 1 TO REC-CT. NC1764.2 +161900 ADD-TEST-F1-49-0. NC1764.2 +162000 ADD WRK-DU-1V1-1 WRK-DU-1V1-2 6 TO WRK-DU-2V1-1, NC1764.2 +162100 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1764.2 +162200 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1764.2 +162300 NOT ON SIZE ERROR NC1764.2 +162400 MOVE "1" TO WRK-XN-00001. NC1764.2 +162500 GO TO ADD-TEST-F1-49-1. NC1764.2 +162600 ADD-DELETE-F1-49. NC1764.2 +162700 PERFORM DE-LETE. NC1764.2 +162800 PERFORM PRINT-DETAIL. NC1764.2 +162900 GO TO ADD-INIT-F1-50. NC1764.2 +163000 ADD-TEST-F1-49-1. NC1764.2 +163100 MOVE "ADD-TEST-F1-49-1" TO PAR-NAME. NC1764.2 +163200 IF WRK-DU-2V1-1 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +163300 ELSE NC1764.2 +163400 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.5 NC1764.2 +163500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +163600 ADD 1 TO REC-CT. NC1764.2 +163700 ADD-TEST-F1-49-2. NC1764.2 +163800 MOVE "ADD-TEST-F1-49-2" TO PAR-NAME. NC1764.2 +163900 IF WRK-DU-2V0-1 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +164000 ELSE NC1764.2 +164100 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 10 TO NC1764.2 +164200 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +164300 ADD 1 TO REC-CT. NC1764.2 +164400 ADD-TEST-F1-49-3. NC1764.2 +164500 MOVE "ADD-TEST-F1-49-3" TO PAR-NAME. NC1764.2 +164600 IF WRK-DU-2V1-2 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +164700 ELSE NC1764.2 +164800 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +164900 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +165000 ADD 1 TO REC-CT. NC1764.2 +165100 ADD-TEST-F1-49-4. NC1764.2 +165200 MOVE "ADD-TEST-F1-49-4" TO PAR-NAME. NC1764.2 +165300 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +165400 ELSE NC1764.2 +165500 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 TO NC1764.2 +165600 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +165700 ADD 1 TO REC-CT. NC1764.2 +165800 ADD-TEST-F1-49-5. NC1764.2 +165900 MOVE "ADD-TEST-F1-49-5" TO PAR-NAME. NC1764.2 +166000 IF WRK-DU-2V1-3 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +166100 ELSE NC1764.2 +166200 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +166300 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +166400 ADD 1 TO REC-CT. NC1764.2 +166500 ADD-TEST-F1-49-6. NC1764.2 +166600 MOVE "ADD-TEST-F1-49-6" TO PAR-NAME. NC1764.2 +166700 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +166800 ELSE NC1764.2 +166900 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 TO NC1764.2 +167000 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +167100 ADD 1 TO REC-CT. NC1764.2 +167200 ADD-TEST-F1-49-7. NC1764.2 +167300 MOVE "ADD-TEST-F1-49-7" TO PAR-NAME. NC1764.2 +167400 IF WRK-XN-00001 = "1" NC1764.2 +167500 PERFORM PASS NC1764.2 +167600 PERFORM PRINT-DETAIL NC1764.2 +167700 ELSE NC1764.2 +167800 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +167900 TO RE-MARK NC1764.2 +168000 MOVE "1" TO CORRECT-X NC1764.2 +168100 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +168200 PERFORM FAIL NC1764.2 +168300 PERFORM PRINT-DETAIL. NC1764.2 +168400* NC1764.2 +168500 ADD-INIT-F1-50. NC1764.2 +168600* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +168700* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +168800 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +168900 MOVE "ADD-TEST-F1-50" TO PAR-NAME. NC1764.2 +169000 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +169100 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +169200 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +169300 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +169400 MOVE "0" TO WRK-XN-00001. NC1764.2 +169500 MOVE 1 TO REC-CT. NC1764.2 +169600 ADD-TEST-F1-50-0. NC1764.2 +169700 ADD A17TWOS-DS-17V00 NC1764.2 +169800 WRK-DU-1V1-2 6 NC1764.2 +169900 TO WRK-DU-2V1-1 NC1764.2 +170000 WRK-DU-2V0-1 ROUNDED NC1764.2 +170100 WRK-DU-2V1-2 NC1764.2 +170200 WRK-DU-2V0-2 ROUNDED NC1764.2 +170300 WRK-DU-2V1-3 NC1764.2 +170400 WRK-DU-2V0-3 NC1764.2 +170500 NOT ON SIZE ERROR NC1764.2 +170600 MOVE "1" TO WRK-XN-00001. NC1764.2 +170700 GO TO ADD-TEST-F1-50-1. NC1764.2 +170800 ADD-DELETE-F1-50. NC1764.2 +170900 PERFORM DE-LETE. NC1764.2 +171000 PERFORM PRINT-DETAIL. NC1764.2 +171100 GO TO ADD-INIT-F1-51. NC1764.2 +171200 ADD-TEST-F1-50-1. NC1764.2 +171300 MOVE "ADD-TEST-F1-50-1" TO PAR-NAME. NC1764.2 +171400 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +171500 ELSE NC1764.2 +171600 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 0 NC1764.2 +171700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +171800 ADD 1 TO REC-CT. NC1764.2 +171900 ADD-TEST-F1-50-2. NC1764.2 +172000 MOVE "ADD-TEST-F1-50-2" TO PAR-NAME. NC1764.2 +172100 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +172200 ELSE NC1764.2 +172300 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 0 TO NC1764.2 +172400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +172500 ADD 1 TO REC-CT. NC1764.2 +172600 ADD-TEST-F1-50-3. NC1764.2 +172700 MOVE "ADD-TEST-F1-50-3" TO PAR-NAME. NC1764.2 +172800 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +172900 ELSE NC1764.2 +173000 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +173100 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +173200 ADD 1 TO REC-CT. NC1764.2 +173300 ADD-TEST-F1-50-4. NC1764.2 +173400 MOVE "ADD-TEST-F1-50-4" TO PAR-NAME. NC1764.2 +173500 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +173600 ELSE NC1764.2 +173700 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +173800 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +173900 ADD 1 TO REC-CT. NC1764.2 +174000 ADD-TEST-F1-50-5. NC1764.2 +174100 MOVE "ADD-TEST-F1-50-5" TO PAR-NAME. NC1764.2 +174200 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +174300 ELSE NC1764.2 +174400 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +174500 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +174600 ADD 1 TO REC-CT. NC1764.2 +174700 ADD-TEST-F1-50-6. NC1764.2 +174800 MOVE "ADD-TEST-F1-50-6" TO PAR-NAME. NC1764.2 +174900 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +175000 ELSE NC1764.2 +175100 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +175200 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +175300 ADD 1 TO REC-CT. NC1764.2 +175400 ADD-TEST-F1-50-7. NC1764.2 +175500 MOVE "ADD-TEST-F1-50-7" TO PAR-NAME. NC1764.2 +175600 IF WRK-XN-00001 = "0" NC1764.2 +175700 PERFORM PASS NC1764.2 +175800 PERFORM PRINT-DETAIL NC1764.2 +175900 ELSE NC1764.2 +176000 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +176100 TO RE-MARK NC1764.2 +176200 MOVE "0" TO CORRECT-X NC1764.2 +176300 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +176400 PERFORM FAIL NC1764.2 +176500 PERFORM PRINT-DETAIL. NC1764.2 +176600* NC1764.2 +176700 ADD-INIT-F1-51. NC1764.2 +176800* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +176900* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +177000 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +177100 MOVE "ADD-TEST-F1-51" TO PAR-NAME. NC1764.2 +177200 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +177300 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +177400 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +177500 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +177600 MOVE "0" TO WRK-XN-00001. NC1764.2 +177700 MOVE 1 TO REC-CT. NC1764.2 +177800 ADD-TEST-F1-51-0. NC1764.2 +177900 ADD WRK-DU-1V1-1 WRK-DU-1V1-2 6 TO WRK-DU-2V1-1, NC1764.2 +178000 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1764.2 +178100 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1764.2 +178200 ON SIZE ERROR NC1764.2 +178300 MOVE "1" TO WRK-XN-00001 NC1764.2 +178400 NOT ON SIZE ERROR NC1764.2 +178500 MOVE "2" TO WRK-XN-00001. NC1764.2 +178600 GO TO ADD-TEST-F1-51-1. NC1764.2 +178700 ADD-DELETE-F1-51. NC1764.2 +178800 PERFORM DE-LETE. NC1764.2 +178900 PERFORM PRINT-DETAIL. NC1764.2 +179000 GO TO ADD-INIT-F1-52. NC1764.2 +179100 ADD-TEST-F1-51-1. NC1764.2 +179200 MOVE "ADD-TEST-F1-51-1" TO PAR-NAME. NC1764.2 +179300 IF WRK-DU-2V1-1 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +179400 ELSE NC1764.2 +179500 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.5 NC1764.2 +179600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +179700 ADD 1 TO REC-CT. NC1764.2 +179800 ADD-TEST-F1-51-2. NC1764.2 +179900 MOVE "ADD-TEST-F1-51-2" TO PAR-NAME. NC1764.2 +180000 IF WRK-DU-2V0-1 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +180100 ELSE NC1764.2 +180200 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 10 TO NC1764.2 +180300 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +180400 ADD 1 TO REC-CT. NC1764.2 +180500 ADD-TEST-F1-51-3. NC1764.2 +180600 MOVE "ADD-TEST-F1-51-3" TO PAR-NAME. NC1764.2 +180700 IF WRK-DU-2V1-2 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +180800 ELSE NC1764.2 +180900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +181000 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +181100 ADD 1 TO REC-CT. NC1764.2 +181200 ADD-TEST-F1-51-4. NC1764.2 +181300 MOVE "ADD-TEST-F1-51-4" TO PAR-NAME. NC1764.2 +181400 IF WRK-DU-2V0-2 = 10 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +181500 ELSE NC1764.2 +181600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 10 TO NC1764.2 +181700 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +181800 ADD 1 TO REC-CT. NC1764.2 +181900 ADD-TEST-F1-51-5. NC1764.2 +182000 MOVE "ADD-TEST-F1-51-5" TO PAR-NAME. NC1764.2 +182100 IF WRK-DU-2V1-3 = 9.5 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +182200 ELSE NC1764.2 +182300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.5 TO NC1764.2 +182400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +182500 ADD 1 TO REC-CT. NC1764.2 +182600 ADD-TEST-F1-51-6. NC1764.2 +182700 MOVE "ADD-TEST-F1-51-6" TO PAR-NAME. NC1764.2 +182800 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +182900 ELSE NC1764.2 +183000 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 TO NC1764.2 +183100 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +183200 ADD 1 TO REC-CT. NC1764.2 +183300 ADD-TEST-F1-51-7. NC1764.2 +183400 MOVE "ADD-TEST-F1-51-7" TO PAR-NAME. NC1764.2 +183500 IF WRK-XN-00001 = "2" NC1764.2 +183600 PERFORM PASS NC1764.2 +183700 PERFORM PRINT-DETAIL NC1764.2 +183800 ELSE NC1764.2 +183900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +184000 TO RE-MARK NC1764.2 +184100 MOVE "2" TO CORRECT-X NC1764.2 +184200 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +184300 PERFORM FAIL NC1764.2 +184400 PERFORM PRINT-DETAIL. NC1764.2 +184500* NC1764.2 +184600 ADD-INIT-F1-52. NC1764.2 +184700* ==--> MULTIPLE RESULT FIELDS <--== NC1764.2 +184800* ==--> NEW SIZE ERROR TESTS <--== NC1764.2 +184900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1764.2 +185000 MOVE "ADD-TEST-F1-52" TO PAR-NAME. NC1764.2 +185100 MOVE ZERO TO WRK-DU-2V1-1 WRK-DU-2V0-1 WRK-DU-2V1-2 NC1764.2 +185200 WRK-DU-2V0-2 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1764.2 +185300 MOVE 1.1 TO WRK-DU-1V1-1. NC1764.2 +185400 MOVE 2.4 TO WRK-DU-1V1-2. NC1764.2 +185500 MOVE "0" TO WRK-XN-00001. NC1764.2 +185600 MOVE 1 TO REC-CT. NC1764.2 +185700 ADD-TEST-F1-52-0. NC1764.2 +185800 ADD A17TWOS-DS-17V00 NC1764.2 +185900 WRK-DU-1V1-2 6 NC1764.2 +186000 TO WRK-DU-2V1-1 NC1764.2 +186100 WRK-DU-2V0-1 ROUNDED NC1764.2 +186200 WRK-DU-2V1-2 NC1764.2 +186300 WRK-DU-2V0-2 ROUNDED NC1764.2 +186400 WRK-DU-2V1-3 NC1764.2 +186500 WRK-DU-2V0-3 NC1764.2 +186600 ON SIZE ERROR NC1764.2 +186700 MOVE "1" TO WRK-XN-00001 NC1764.2 +186800 NOT ON SIZE ERROR NC1764.2 +186900 MOVE "2" TO WRK-XN-00001. NC1764.2 +187000 GO TO ADD-TEST-F1-52-1. NC1764.2 +187100 ADD-DELETE-F1-52. NC1764.2 +187200 PERFORM DE-LETE. NC1764.2 +187300 PERFORM PRINT-DETAIL. NC1764.2 +187400 GO TO ADD-INIT-F1-53. NC1764.2 +187500 ADD-TEST-F1-52-1. NC1764.2 +187600 MOVE "ADD-TEST-F1-52-1" TO PAR-NAME. NC1764.2 +187700 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +187800 ELSE NC1764.2 +187900 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 0 NC1764.2 +188000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +188100 ADD 1 TO REC-CT. NC1764.2 +188200 ADD-TEST-F1-52-2. NC1764.2 +188300 MOVE "ADD-TEST-F1-52-2" TO PAR-NAME. NC1764.2 +188400 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +188500 ELSE NC1764.2 +188600 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 0 TO NC1764.2 +188700 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +188800 ADD 1 TO REC-CT. NC1764.2 +188900 ADD-TEST-F1-52-3. NC1764.2 +189000 MOVE "ADD-TEST-F1-52-3" TO PAR-NAME. NC1764.2 +189100 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +189200 ELSE NC1764.2 +189300 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +189400 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +189500 ADD 1 TO REC-CT. NC1764.2 +189600 ADD-TEST-F1-52-4. NC1764.2 +189700 MOVE "ADD-TEST-F1-52-4" TO PAR-NAME. NC1764.2 +189800 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +189900 ELSE NC1764.2 +190000 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 0 TO NC1764.2 +190100 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +190200 ADD 1 TO REC-CT. NC1764.2 +190300 ADD-TEST-F1-52-5. NC1764.2 +190400 MOVE "ADD-TEST-F1-52-5" TO PAR-NAME. NC1764.2 +190500 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +190600 ELSE NC1764.2 +190700 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +190800 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +190900 ADD 1 TO REC-CT. NC1764.2 +191000 ADD-TEST-F1-52-6. NC1764.2 +191100 MOVE "ADD-TEST-F1-52-6" TO PAR-NAME. NC1764.2 +191200 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1764.2 +191300 ELSE NC1764.2 +191400 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 0 TO NC1764.2 +191500 CORRECT-N PERFORM PRINT-DETAIL. NC1764.2 +191600 ADD 1 TO REC-CT. NC1764.2 +191700 ADD-TEST-F1-52-7. NC1764.2 +191800 MOVE "ADD-TEST-F1-52-7" TO PAR-NAME. NC1764.2 +191900 IF WRK-XN-00001 = "1" NC1764.2 +192000 PERFORM PASS NC1764.2 +192100 PERFORM PRINT-DETAIL NC1764.2 +192200 ELSE NC1764.2 +192300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +192400 TO RE-MARK NC1764.2 +192500 MOVE "1" TO CORRECT-X NC1764.2 +192600 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +192700 PERFORM FAIL NC1764.2 +192800 PERFORM PRINT-DETAIL. NC1764.2 +192900* NC1764.2 +193000 ADD-INIT-F1-53. NC1764.2 +193100* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +193200 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +193300 MOVE "ADD-TEST-F1-53" TO PAR-NAME. NC1764.2 +193400 MOVE SPACE TO WRK-XN-00001. NC1764.2 +193500 MOVE SPACE TO SIZE-ERR2. NC1764.2 +193600 MOVE SPACE TO SIZE-ERR3. NC1764.2 +193700 MOVE SPACE TO SIZE-ERR4. NC1764.2 +193800 MOVE -11 TO WRK-DS-02V00. NC1764.2 +193900 MOVE 1 TO REC-CT. NC1764.2 +194000 ADD-TEST-F1-53-0. NC1764.2 +194100 ADD -99 TO WRK-DS-02V00 NC1764.2 +194200 ON SIZE ERROR NC1764.2 +194300 MOVE "1" TO WRK-XN-00001 NC1764.2 +194400 MOVE "A" TO SIZE-ERR2 NC1764.2 +194500 MOVE "B" TO SIZE-ERR3 NC1764.2 +194600 END-ADD NC1764.2 +194700 MOVE "C" TO SIZE-ERR4. NC1764.2 +194800 GO TO ADD-TEST-F1-53-1. NC1764.2 +194900 ADD-DELETE-F1-53. NC1764.2 +195000 PERFORM DE-LETE. NC1764.2 +195100 PERFORM PRINT-DETAIL. NC1764.2 +195200 GO TO ADD-INIT-F1-54. NC1764.2 +195300 ADD-TEST-F1-53-1. NC1764.2 +195400 MOVE "ADD-TEST-F1-53-1" TO PAR-NAME. NC1764.2 +195500 IF WRK-XN-00001 = "1" NC1764.2 +195600 PERFORM PASS NC1764.2 +195700 PERFORM PRINT-DETAIL NC1764.2 +195800 ELSE NC1764.2 +195900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +196000 TO RE-MARK NC1764.2 +196100 MOVE "1" TO CORRECT-X NC1764.2 +196200 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +196300 PERFORM FAIL NC1764.2 +196400 PERFORM PRINT-DETAIL. NC1764.2 +196500 ADD 1 TO REC-CT. NC1764.2 +196600 ADD-TEST-F1-53-2. NC1764.2 +196700 MOVE "ADD-TEST-F1-53-2" TO PAR-NAME. NC1764.2 +196800 IF SIZE-ERR2 = "A" NC1764.2 +196900 PERFORM PASS NC1764.2 +197000 PERFORM PRINT-DETAIL NC1764.2 +197100 ELSE NC1764.2 +197200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +197300 TO RE-MARK NC1764.2 +197400 MOVE "A" TO CORRECT-X NC1764.2 +197500 MOVE SIZE-ERR2 TO COMPUTED-X NC1764.2 +197600 PERFORM FAIL NC1764.2 +197700 PERFORM PRINT-DETAIL. NC1764.2 +197800 ADD 1 TO REC-CT. NC1764.2 +197900 ADD-TEST-F1-53-3. NC1764.2 +198000 MOVE "ADD-TEST-F1-53-3" TO PAR-NAME. NC1764.2 +198100 IF SIZE-ERR3 = "B" NC1764.2 +198200 PERFORM PASS NC1764.2 +198300 PERFORM PRINT-DETAIL NC1764.2 +198400 ELSE NC1764.2 +198500 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +198600 TO RE-MARK NC1764.2 +198700 MOVE "B" TO CORRECT-X NC1764.2 +198800 MOVE SIZE-ERR3 TO COMPUTED-X NC1764.2 +198900 PERFORM FAIL NC1764.2 +199000 PERFORM PRINT-DETAIL. NC1764.2 +199100 ADD 1 TO REC-CT. NC1764.2 +199200 ADD-TEST-F1-53-4. NC1764.2 +199300 MOVE "ADD-TEST-F1-53-4" TO PAR-NAME. NC1764.2 +199400 IF SIZE-ERR4 = "C" NC1764.2 +199500 PERFORM PASS NC1764.2 +199600 PERFORM PRINT-DETAIL NC1764.2 +199700 ELSE NC1764.2 +199800 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +199900 TO RE-MARK NC1764.2 +200000 MOVE "C" TO CORRECT-X NC1764.2 +200100 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +200200 PERFORM FAIL NC1764.2 +200300 PERFORM PRINT-DETAIL. NC1764.2 +200400 ADD 1 TO REC-CT. NC1764.2 +200500 ADD-TEST-F1-53-5. NC1764.2 +200600 MOVE "ADD-TEST-F1-53-5" TO PAR-NAME. NC1764.2 +200700 IF WRK-DS-02V00 = -11 NC1764.2 +200800 PERFORM PASS NC1764.2 +200900 PERFORM PRINT-DETAIL NC1764.2 +201000 ELSE NC1764.2 +201100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +201200 TO RE-MARK NC1764.2 +201300 MOVE -11 TO CORRECT-N NC1764.2 +201400 MOVE WRK-DS-02V00 TO COMPUTED-N NC1764.2 +201500 PERFORM FAIL NC1764.2 +201600 PERFORM PRINT-DETAIL. NC1764.2 +201700* NC1764.2 +201800 ADD-INIT-F1-54. NC1764.2 +201900* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +202000 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +202100 MOVE "ADD-TEST-F1-54" TO PAR-NAME. NC1764.2 +202200 MOVE SPACE TO WRK-XN-00001. NC1764.2 +202300 MOVE SPACE TO SIZE-ERR2. NC1764.2 +202400 MOVE SPACE TO SIZE-ERR3. NC1764.2 +202500 MOVE SPACE TO SIZE-ERR4. NC1764.2 +202600 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +202700 MOVE 1 TO REC-CT. NC1764.2 +202800 ADD-TEST-F1-54-0. NC1764.2 +202900 ADD A12THREES-DS-06V06 NC1764.2 +203000 333333 NC1764.2 +203100 A06THREES-DS-03V03 NC1764.2 +203200 TO WRK-DS-06V06 ROUNDED NC1764.2 +203300 ON SIZE ERROR NC1764.2 +203400 MOVE "1" TO WRK-XN-00001 NC1764.2 +203500 MOVE "A" TO SIZE-ERR2 NC1764.2 +203600 MOVE "B" TO SIZE-ERR3 NC1764.2 +203700 END-ADD NC1764.2 +203800 MOVE "C" TO SIZE-ERR4. NC1764.2 +203900 GO TO ADD-TEST-F1-54-1. NC1764.2 +204000 ADD-DELETE-F1-54. NC1764.2 +204100 PERFORM DE-LETE. NC1764.2 +204200 PERFORM PRINT-DETAIL. NC1764.2 +204300 GO TO ADD-INIT-F1-55. NC1764.2 +204400 ADD-TEST-F1-54-1. NC1764.2 +204500 MOVE "ADD-TEST-F1-54-1" TO PAR-NAME. NC1764.2 +204600 IF WRK-XN-00001 = SPACE NC1764.2 +204700 PERFORM PASS NC1764.2 +204800 PERFORM PRINT-DETAIL NC1764.2 +204900 ELSE NC1764.2 +205000 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +205100 TO RE-MARK NC1764.2 +205200 MOVE SPACE TO CORRECT-X NC1764.2 +205300 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +205400 PERFORM FAIL NC1764.2 +205500 PERFORM PRINT-DETAIL. NC1764.2 +205600 ADD 1 TO REC-CT. NC1764.2 +205700 ADD-TEST-F1-54-2. NC1764.2 +205800 MOVE "ADD-TEST-F1-54-2" TO PAR-NAME. NC1764.2 +205900 IF SIZE-ERR2 = SPACE NC1764.2 +206000 PERFORM PASS NC1764.2 +206100 PERFORM PRINT-DETAIL NC1764.2 +206200 ELSE NC1764.2 +206300 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +206400 TO RE-MARK NC1764.2 +206500 MOVE SPACE TO CORRECT-X NC1764.2 +206600 MOVE SIZE-ERR2 TO COMPUTED-X NC1764.2 +206700 PERFORM FAIL NC1764.2 +206800 PERFORM PRINT-DETAIL. NC1764.2 +206900 ADD 1 TO REC-CT. NC1764.2 +207000 ADD-TEST-F1-54-3. NC1764.2 +207100 MOVE "ADD-TEST-F1-54-3" TO PAR-NAME. NC1764.2 +207200 IF SIZE-ERR3 = SPACE NC1764.2 +207300 PERFORM PASS NC1764.2 +207400 PERFORM PRINT-DETAIL NC1764.2 +207500 ELSE NC1764.2 +207600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +207700 TO RE-MARK NC1764.2 +207800 MOVE SPACE TO CORRECT-X NC1764.2 +207900 MOVE SIZE-ERR3 TO COMPUTED-X NC1764.2 +208000 PERFORM FAIL NC1764.2 +208100 PERFORM PRINT-DETAIL. NC1764.2 +208200 ADD 1 TO REC-CT. NC1764.2 +208300 ADD-TEST-F1-54-4. NC1764.2 +208400 MOVE "ADD-TEST-F1-54-4" TO PAR-NAME. NC1764.2 +208500 IF SIZE-ERR4 = "C" NC1764.2 +208600 PERFORM PASS NC1764.2 +208700 PERFORM PRINT-DETAIL NC1764.2 +208800 ELSE NC1764.2 +208900 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +209000 TO RE-MARK NC1764.2 +209100 MOVE "C" TO CORRECT-X NC1764.2 +209200 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +209300 PERFORM FAIL NC1764.2 +209400 PERFORM PRINT-DETAIL NC1764.2 +209500 ADD 1 TO REC-CT. NC1764.2 +209600 ADD-TEST-F1-54-5. NC1764.2 +209700 MOVE "ADD-TEST-F1-54-5" TO PAR-NAME. NC1764.2 +209800 IF WRK-DS-06V06 = 666999.666333 NC1764.2 +209900 PERFORM PASS NC1764.2 +210000 PERFORM PRINT-DETAIL NC1764.2 +210100 ELSE NC1764.2 +210200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +210300 TO RE-MARK NC1764.2 +210400 MOVE 666999.666333 TO CORRECT-N NC1764.2 +210500 MOVE WRK-DS-06V06 TO COMPUTED-N NC1764.2 +210600 PERFORM FAIL NC1764.2 +210700 PERFORM PRINT-DETAIL. NC1764.2 +210800* NC1764.2 +210900 ADD-INIT-F1-55. NC1764.2 +211000* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +211100 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +211200 MOVE "ADD-TEST-F1-55" TO PAR-NAME. NC1764.2 +211300 MOVE SPACE TO WRK-XN-00001. NC1764.2 +211400 MOVE SPACE TO SIZE-ERR2. NC1764.2 +211500 MOVE SPACE TO SIZE-ERR3. NC1764.2 +211600 MOVE SPACE TO SIZE-ERR4. NC1764.2 +211700 MOVE -11 TO WRK-DS-02V00. NC1764.2 +211800 MOVE 1 TO REC-CT. NC1764.2 +211900 ADD-TEST-F1-55-0. NC1764.2 +212000 ADD -99 TO WRK-DS-02V00 NC1764.2 +212100 NOT ON SIZE ERROR NC1764.2 +212200 MOVE "1" TO WRK-XN-00001 NC1764.2 +212300 MOVE "A" TO SIZE-ERR2 NC1764.2 +212400 MOVE "B" TO SIZE-ERR3 NC1764.2 +212500 END-ADD NC1764.2 +212600 MOVE "C" TO SIZE-ERR4. NC1764.2 +212700 GO TO ADD-TEST-F1-55-1. NC1764.2 +212800 ADD-DELETE-F1-55. NC1764.2 +212900 PERFORM DE-LETE. NC1764.2 +213000 PERFORM PRINT-DETAIL. NC1764.2 +213100 GO TO ADD-INIT-F1-56. NC1764.2 +213200 ADD-TEST-F1-55-1. NC1764.2 +213300 MOVE "ADD-TEST-F1-55-1" TO PAR-NAME. NC1764.2 +213400 IF WRK-XN-00001 = SPACE NC1764.2 +213500 PERFORM PASS NC1764.2 +213600 PERFORM PRINT-DETAIL NC1764.2 +213700 ELSE NC1764.2 +213800 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +213900 TO RE-MARK NC1764.2 +214000 MOVE SPACE TO CORRECT-X NC1764.2 +214100 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +214200 PERFORM FAIL NC1764.2 +214300 PERFORM PRINT-DETAIL. NC1764.2 +214400 ADD 1 TO REC-CT. NC1764.2 +214500 ADD-TEST-F1-55-2. NC1764.2 +214600 MOVE "ADD-TEST-F1-55-2" TO PAR-NAME. NC1764.2 +214700 IF SIZE-ERR2 = SPACE NC1764.2 +214800 PERFORM PASS NC1764.2 +214900 PERFORM PRINT-DETAIL NC1764.2 +215000 ELSE NC1764.2 +215100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +215200 TO RE-MARK NC1764.2 +215300 MOVE SPACE TO CORRECT-X NC1764.2 +215400 MOVE SIZE-ERR2 TO COMPUTED-X NC1764.2 +215500 PERFORM FAIL NC1764.2 +215600 PERFORM PRINT-DETAIL. NC1764.2 +215700 ADD 1 TO REC-CT. NC1764.2 +215800 ADD-TEST-F1-55-3. NC1764.2 +215900 MOVE "ADD-TEST-F1-55-3" TO PAR-NAME. NC1764.2 +216000 IF SIZE-ERR3 = SPACE NC1764.2 +216100 PERFORM PASS NC1764.2 +216200 PERFORM PRINT-DETAIL NC1764.2 +216300 ELSE NC1764.2 +216400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1764.2 +216500 TO RE-MARK NC1764.2 +216600 MOVE SPACE TO CORRECT-X NC1764.2 +216700 MOVE SIZE-ERR3 TO COMPUTED-X NC1764.2 +216800 PERFORM FAIL NC1764.2 +216900 PERFORM PRINT-DETAIL. NC1764.2 +217000 ADD 1 TO REC-CT. NC1764.2 +217100 ADD-TEST-F1-55-4. NC1764.2 +217200 MOVE "ADD-TEST-F1-55-4" TO PAR-NAME. NC1764.2 +217300 IF SIZE-ERR4 = "C" NC1764.2 +217400 PERFORM PASS NC1764.2 +217500 PERFORM PRINT-DETAIL NC1764.2 +217600 ELSE NC1764.2 +217700 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +217800 TO RE-MARK NC1764.2 +217900 MOVE "C" TO CORRECT-X NC1764.2 +218000 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +218100 PERFORM FAIL NC1764.2 +218200 PERFORM PRINT-DETAIL. NC1764.2 +218300 ADD 1 TO REC-CT. NC1764.2 +218400 ADD-TEST-F1-55-5. NC1764.2 +218500 MOVE "ADD-TEST-F1-55-5" TO PAR-NAME. NC1764.2 +218600 IF WRK-DS-02V00 = -11 NC1764.2 +218700 PERFORM PASS NC1764.2 +218800 PERFORM PRINT-DETAIL NC1764.2 +218900 ELSE NC1764.2 +219000 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +219100 TO RE-MARK NC1764.2 +219200 MOVE -11 TO CORRECT-N NC1764.2 +219300 MOVE WRK-DS-02V00 TO COMPUTED-N NC1764.2 +219400 PERFORM FAIL NC1764.2 +219500 PERFORM PRINT-DETAIL. NC1764.2 +219600* NC1764.2 +219700 ADD-INIT-F1-56. NC1764.2 +219800* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +219900 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +220000 MOVE "ADD-TEST-F1-56" TO PAR-NAME. NC1764.2 +220100 MOVE SPACE TO WRK-XN-00001. NC1764.2 +220200 MOVE SPACE TO SIZE-ERR2. NC1764.2 +220300 MOVE SPACE TO SIZE-ERR3. NC1764.2 +220400 MOVE SPACE TO SIZE-ERR4. NC1764.2 +220500 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +220600 MOVE 1 TO REC-CT. NC1764.2 +220700 ADD-TEST-F1-56-0. NC1764.2 +220800 ADD A12THREES-DS-06V06 NC1764.2 +220900 333333 NC1764.2 +221000 A06THREES-DS-03V03 NC1764.2 +221100 TO WRK-DS-06V06 ROUNDED NC1764.2 +221200 NOT ON SIZE ERROR NC1764.2 +221300 MOVE "1" TO WRK-XN-00001 NC1764.2 +221400 MOVE "A" TO SIZE-ERR2 NC1764.2 +221500 MOVE "B" TO SIZE-ERR3 NC1764.2 +221600 END-ADD NC1764.2 +221700 MOVE "C" TO SIZE-ERR4. NC1764.2 +221800 GO TO ADD-TEST-F1-56-1. NC1764.2 +221900 ADD-DELETE-F1-56. NC1764.2 +222000 PERFORM DE-LETE. NC1764.2 +222100 PERFORM PRINT-DETAIL. NC1764.2 +222200 GO TO ADD-INIT-F1-57. NC1764.2 +222300 ADD-TEST-F1-56-1. NC1764.2 +222400 MOVE "ADD-TEST-F1-56-1" TO PAR-NAME. NC1764.2 +222500 IF WRK-XN-00001 = "1" NC1764.2 +222600 PERFORM PASS NC1764.2 +222700 PERFORM PRINT-DETAIL NC1764.2 +222800 ELSE NC1764.2 +222900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +223000 TO RE-MARK NC1764.2 +223100 MOVE "1" TO CORRECT-X NC1764.2 +223200 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +223300 PERFORM FAIL NC1764.2 +223400 PERFORM PRINT-DETAIL. NC1764.2 +223500 ADD 1 TO REC-CT. NC1764.2 +223600 ADD-TEST-F1-56-2. NC1764.2 +223700 MOVE "ADD-TEST-F1-56-2" TO PAR-NAME. NC1764.2 +223800 IF SIZE-ERR2 = "A" NC1764.2 +223900 PERFORM PASS NC1764.2 +224000 PERFORM PRINT-DETAIL NC1764.2 +224100 ELSE NC1764.2 +224200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +224300 TO RE-MARK NC1764.2 +224400 MOVE "A" TO CORRECT-X NC1764.2 +224500 MOVE SIZE-ERR2 TO COMPUTED-X NC1764.2 +224600 PERFORM FAIL NC1764.2 +224700 PERFORM PRINT-DETAIL. NC1764.2 +224800 ADD 1 TO REC-CT. NC1764.2 +224900 ADD-TEST-F1-56-3. NC1764.2 +225000 MOVE "ADD-TEST-F1-56-3" TO PAR-NAME. NC1764.2 +225100 IF SIZE-ERR3 = "B" NC1764.2 +225200 PERFORM PASS NC1764.2 +225300 PERFORM PRINT-DETAIL NC1764.2 +225400 ELSE NC1764.2 +225500 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +225600 TO RE-MARK NC1764.2 +225700 MOVE "B" TO CORRECT-X NC1764.2 +225800 MOVE SIZE-ERR3 TO COMPUTED-X NC1764.2 +225900 PERFORM FAIL NC1764.2 +226000 PERFORM PRINT-DETAIL. NC1764.2 +226100 ADD 1 TO REC-CT. NC1764.2 +226200 ADD-TEST-F1-56-4. NC1764.2 +226300 MOVE "ADD-TEST-F1-56-4" TO PAR-NAME. NC1764.2 +226400 IF SIZE-ERR4 = "C" NC1764.2 +226500 PERFORM PASS NC1764.2 +226600 PERFORM PRINT-DETAIL NC1764.2 +226700 ELSE NC1764.2 +226800 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +226900 TO RE-MARK NC1764.2 +227000 MOVE "C" TO CORRECT-X NC1764.2 +227100 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +227200 PERFORM FAIL NC1764.2 +227300 PERFORM PRINT-DETAIL. NC1764.2 +227400 ADD 1 TO REC-CT. NC1764.2 +227500 ADD-TEST-F1-56-5. NC1764.2 +227600 MOVE "ADD-TEST-F1-56-5" TO PAR-NAME. NC1764.2 +227700 IF WRK-DS-06V06 = 666999.666333 NC1764.2 +227800 PERFORM PASS NC1764.2 +227900 PERFORM PRINT-DETAIL NC1764.2 +228000 ELSE NC1764.2 +228100 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +228200 TO RE-MARK NC1764.2 +228300 MOVE 666999.666333 TO CORRECT-N NC1764.2 +228400 MOVE WRK-DS-06V06 TO COMPUTED-N NC1764.2 +228500 PERFORM FAIL NC1764.2 +228600 PERFORM PRINT-DETAIL. NC1764.2 +228700* NC1764.2 +228800 ADD-INIT-F1-57. NC1764.2 +228900* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +229000 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +229100 MOVE "ADD-TEST-F1-57" TO PAR-NAME. NC1764.2 +229200 MOVE "0" TO WRK-XN-00001. NC1764.2 +229300 MOVE "0" TO SIZE-ERR2. NC1764.2 +229400 MOVE "0" TO SIZE-ERR3. NC1764.2 +229500 MOVE "0" TO SIZE-ERR4. NC1764.2 +229600 MOVE -11 TO WRK-DS-02V00. NC1764.2 +229700 MOVE 1 TO REC-CT. NC1764.2 +229800 ADD-TEST-F1-57-0. NC1764.2 +229900 ADD -99 TO WRK-DS-02V00 NC1764.2 +230000 ON SIZE ERROR NC1764.2 +230100 MOVE SPACE TO WRK-XN-00001 NC1764.2 +230200 NOT ON SIZE ERROR NC1764.2 +230300 MOVE "1" TO WRK-XN-00001 NC1764.2 +230400 END-ADD NC1764.2 +230500 MOVE "C" TO SIZE-ERR4. NC1764.2 +230600 GO TO ADD-TEST-F1-57-1. NC1764.2 +230700 ADD-DELETE-F1-57. NC1764.2 +230800 PERFORM DE-LETE. NC1764.2 +230900 PERFORM PRINT-DETAIL. NC1764.2 +231000 GO TO ADD-INIT-F1-58. NC1764.2 +231100 ADD-TEST-F1-57-1. NC1764.2 +231200 MOVE "ADD-TEST-F1-57-1" TO PAR-NAME. NC1764.2 +231300 IF WRK-XN-00001 = SPACE NC1764.2 +231400 PERFORM PASS NC1764.2 +231500 PERFORM PRINT-DETAIL NC1764.2 +231600 ELSE NC1764.2 +231700 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +231800 TO RE-MARK NC1764.2 +231900 MOVE SPACE TO CORRECT-X NC1764.2 +232000 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +232100 PERFORM FAIL NC1764.2 +232200 PERFORM PRINT-DETAIL. NC1764.2 +232300 ADD 1 TO REC-CT. NC1764.2 +232400 ADD-TEST-F1-57-2. NC1764.2 +232500 MOVE "ADD-TEST-F1-57-2" TO PAR-NAME. NC1764.2 +232600 IF SIZE-ERR4 = "C" NC1764.2 +232700 PERFORM PASS NC1764.2 +232800 PERFORM PRINT-DETAIL NC1764.2 +232900 ELSE NC1764.2 +233000 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +233100 TO RE-MARK NC1764.2 +233200 MOVE "C" TO CORRECT-X NC1764.2 +233300 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +233400 PERFORM FAIL NC1764.2 +233500 PERFORM PRINT-DETAIL. NC1764.2 +233600 ADD 1 TO REC-CT. NC1764.2 +233700 ADD-TEST-F1-57-3. NC1764.2 +233800 MOVE "ADD-TEST-F1-57-3" TO PAR-NAME. NC1764.2 +233900 IF WRK-DS-02V00 = -11 NC1764.2 +234000 PERFORM PASS NC1764.2 +234100 PERFORM PRINT-DETAIL NC1764.2 +234200 ELSE NC1764.2 +234300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +234400 TO RE-MARK NC1764.2 +234500 MOVE -11 TO CORRECT-N NC1764.2 +234600 MOVE WRK-DS-02V00 TO COMPUTED-N NC1764.2 +234700 PERFORM FAIL NC1764.2 +234800 PERFORM PRINT-DETAIL. NC1764.2 +234900* NC1764.2 +235000 ADD-INIT-F1-58. NC1764.2 +235100* ==--> EXPLICIT SCOPE TERMINATOR<--== NC1764.2 +235200 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC1764.2 +235300 MOVE "ADD-TEST-F1-58" TO PAR-NAME. NC1764.2 +235400 MOVE SPACE TO WRK-XN-00001. NC1764.2 +235500 MOVE SPACE TO SIZE-ERR2. NC1764.2 +235600 MOVE SPACE TO SIZE-ERR3. NC1764.2 +235700 MOVE SPACE TO SIZE-ERR4. NC1764.2 +235800 MOVE ZERO TO WRK-DS-06V06. NC1764.2 +235900 MOVE 1 TO REC-CT. NC1764.2 +236000 ADD-TEST-F1-58-0. NC1764.2 +236100 ADD A12THREES-DS-06V06 NC1764.2 +236200 333333 NC1764.2 +236300 A06THREES-DS-03V03 NC1764.2 +236400 TO WRK-DS-06V06 ROUNDED NC1764.2 +236500 ON SIZE ERROR NC1764.2 +236600 MOVE "X" TO WRK-XN-00001 NC1764.2 +236700 NOT ON SIZE ERROR NC1764.2 +236800 MOVE "1" TO WRK-XN-00001 NC1764.2 +236900 END-ADD NC1764.2 +237000 MOVE "C" TO SIZE-ERR4. NC1764.2 +237100 GO TO ADD-TEST-F1-58-1. NC1764.2 +237200 ADD-DELETE-F1-58. NC1764.2 +237300 PERFORM DE-LETE. NC1764.2 +237400 PERFORM PRINT-DETAIL. NC1764.2 +237500 GO TO CCVS-EXIT. NC1764.2 +237600 ADD-TEST-F1-58-1. NC1764.2 +237700 MOVE "ADD-TEST-F1-58-1" TO PAR-NAME. NC1764.2 +237800 IF WRK-XN-00001 = "1" NC1764.2 +237900 PERFORM PASS NC1764.2 +238000 PERFORM PRINT-DETAIL NC1764.2 +238100 ELSE NC1764.2 +238200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1764.2 +238300 TO RE-MARK NC1764.2 +238400 MOVE "1" TO CORRECT-X NC1764.2 +238500 MOVE WRK-XN-00001 TO COMPUTED-X NC1764.2 +238600 PERFORM FAIL NC1764.2 +238700 PERFORM PRINT-DETAIL. NC1764.2 +238800 ADD 1 TO REC-CT. NC1764.2 +238900 ADD-TEST-F1-58-2. NC1764.2 +239000 MOVE "ADD-TEST-F1-58-2" TO PAR-NAME. NC1764.2 +239100 IF SIZE-ERR4 = "C" NC1764.2 +239200 PERFORM PASS NC1764.2 +239300 PERFORM PRINT-DETAIL NC1764.2 +239400 ELSE NC1764.2 +239500 MOVE "SCOPE TERMINATOR IGNORED" NC1764.2 +239600 TO RE-MARK NC1764.2 +239700 MOVE "C" TO CORRECT-X NC1764.2 +239800 MOVE SIZE-ERR4 TO COMPUTED-X NC1764.2 +239900 PERFORM FAIL NC1764.2 +240000 PERFORM PRINT-DETAIL. NC1764.2 +240100 ADD 1 TO REC-CT. NC1764.2 +240200 ADD-TEST-F1-58-3. NC1764.2 +240300 MOVE "ADD-TEST-F1-58-3" TO PAR-NAME. NC1764.2 +240400 IF WRK-DS-06V06 = 666999.666333 NC1764.2 +240500 PERFORM PASS NC1764.2 +240600 PERFORM PRINT-DETAIL NC1764.2 +240700 ELSE NC1764.2 +240800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1764.2 +240900 TO RE-MARK NC1764.2 +241000 MOVE 666999.666333 TO CORRECT-N NC1764.2 +241100 MOVE WRK-DS-06V06 TO COMPUTED-N NC1764.2 +241200 PERFORM FAIL NC1764.2 +241300 PERFORM PRINT-DETAIL. NC1764.2 +241400* NC1764.2 +241500 CCVS-EXIT SECTION. NC1764.2 +241600 CCVS-999999. NC1764.2 +241700 GO TO CLOSE-FILES. NC1764.2 diff --git a/tests/cobol85/NC/NC177A.CBL b/tests/cobol85/NC/NC177A.CBL new file mode 100755 index 00000000..1fdd201c --- /dev/null +++ b/tests/cobol85/NC/NC177A.CBL @@ -0,0 +1,2137 @@ +000100 IDENTIFICATION DIVISION. NC1774.2 +000200 PROGRAM-ID. NC1774.2 +000300 NC177A. NC1774.2 +000400**************************************************************** NC1774.2 +000500* * NC1774.2 +000600* VALIDATION FOR:- * NC1774.2 +000700* * NC1774.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1774.2 +000900* * NC1774.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1774.2 +001100* * NC1774.2 +001200**************************************************************** NC1774.2 +001300* * NC1774.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC1774.2 +001500* * NC1774.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC1774.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC1774.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC1774.2 +001900* * NC1774.2 +002000**************************************************************** NC1774.2 +002100* NC1774.2 +002200* PROGRAM NC177A TESTS FORMAT 2 OF THE ADD STATEMENT. NC1774.2 +002300* VARIOUS COMBINATINS OF DATA-ITEMS AND ALL NC1774.2 +002400* OPTIONAL PHRASES ARE TESTED. NC1774.2 +002500* NC1774.2 +002600 ENVIRONMENT DIVISION. NC1774.2 +002700 CONFIGURATION SECTION. NC1774.2 +002800 SOURCE-COMPUTER. NC1774.2 +002900 Linux. NC1774.2 +003000 OBJECT-COMPUTER. NC1774.2 +003100 Linux. NC1774.2 +003200 INPUT-OUTPUT SECTION. NC1774.2 +003300 FILE-CONTROL. NC1774.2 +003400 SELECT PRINT-FILE ASSIGN TO NC1774.2 +003500 "report.log". NC1774.2 +003600 DATA DIVISION. NC1774.2 +003700 FILE SECTION. NC1774.2 +003800 FD PRINT-FILE. NC1774.2 +003900 01 PRINT-REC PICTURE X(120). NC1774.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC1774.2 +004100 WORKING-STORAGE SECTION. NC1774.2 +004200 77 SIZE-ERR PICTURE X VALUE SPACE. NC1774.2 +004300 77 SIZE-ERR2 PICTURE X VALUE SPACE. NC1774.2 +004400 77 SIZE-ERR3 PICTURE X VALUE SPACE. NC1774.2 +004500 77 SIZE-ERR4 PICTURE X VALUE SPACE. NC1774.2 +004600 77 A17TWOS-DS-17V00 PICTURE S9(17) NC1774.2 +004700 VALUE 22222222222222222. NC1774.2 +004800 77 A18ONES-DS-18V00 PICTURE S9(18) NC1774.2 +004900 VALUE 111111111111111111. NC1774.2 +005000 77 WRK-DS-10V00 PICTURE S9(10). NC1774.2 +005100 77 A10ONES-DS-10V00 PICTURE S9(10) NC1774.2 +005200 VALUE 1111111111. NC1774.2 +005300 77 A05ONES-DS-05V00 PICTURE S9(5) NC1774.2 +005400 VALUE 11111. NC1774.2 +005500 77 A02ONES-DS-02V00 PICTURE S99 NC1774.2 +005600 VALUE 11. NC1774.2 +005700 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC1774.2 +005800 77 WRK-DS-18V00 REDEFINES WRK-DS-09V09 NC1774.2 +005900 PICTURE S9(18). NC1774.2 +006000 77 A06THREES-DS-03V03 PICTURE S999V999 NC1774.2 +006100 VALUE 333.333. NC1774.2 +006200 77 A12THREES-DS-06V06 PICTURE S9(6)V9(6) NC1774.2 +006300 VALUE 333333.333333. NC1774.2 +006400 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC1774.2 +006500 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC1774.2 +006600 PICTURE S9(12). NC1774.2 +006700 77 A05ONES-DS-00V05 PICTURE SV9(5) NC1774.2 +006800 VALUE .11111. NC1774.2 +006900 77 WRK-DS-05V00 PICTURE S9(5). NC1774.2 +007000 77 WRK-DS-02V00 PICTURE S99. NC1774.2 +007100 77 A12ONES-DS-12V00 PICTURE S9(12) NC1774.2 +007200 VALUE 111111111111. NC1774.2 +007300 77 WRK-DS-03V10 PICTURE S999V9(10). NC1774.2 +007400 77 WRK-DS-13V00-S REDEFINES WRK-DS-03V10 NC1774.2 +007500 PICTURE S9(13). NC1774.2 +007600 77 A99-DS-02V00 PICTURE S99 NC1774.2 +007700 VALUE 99. NC1774.2 +007800 77 A03ONES-DS-02V01 PICTURE S99V9 NC1774.2 +007900 VALUE 11.1. NC1774.2 +008000 77 A06ONES-DS-03V03 PICTURE S999V999 NC1774.2 +008100 VALUE 111.111. NC1774.2 +008200 77 A08TWOS-DS-02V06 PICTURE S99V9(6) NC1774.2 +008300 VALUE 22.222222. NC1774.2 +008400 77 A01ONE-DS-P0801 PICTURE SP(8)9 NC1774.2 +008500 VALUE .000000001. NC1774.2 +008600 77 WRK-CS-18V00 PICTURE S9(18) COMPUTATIONAL. NC1774.2 +008700 77 A18ONES-CS-18V00 PICTURE S9(18) COMPUTATIONAL NC1774.2 +008800 VALUE 111111111111111111. NC1774.2 +008900 77 WRK-CS-02V02 PICTURE S99V99 COMPUTATIONAL. NC1774.2 +009000 77 A99-CS-02V00 PICTURE S99 COMPUTATIONAL NC1774.2 +009100 VALUE 99. NC1774.2 +009200 77 WRK-DS-0201P PICTURE S99P. NC1774.2 +009300 77 WRK-DS-06V00 PICTURE S9(6). NC1774.2 +009400 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) NC1774.2 +009500 VALUE ZERO. NC1774.2 +009600 77 NDATA-DS-09V09 PICTURE S9(9)V9(9) NC1774.2 +009700 VALUE +012345678.876543210. NC1774.2 +009800 77 XDATA-XN-00018 PICTURE X(18) NC1774.2 +009900 VALUE "00ABCDEFGHI 4321 ". NC1774.2 +010000 77 WRK-XN-00018 PICTURE X(18). NC1774.2 +010100 77 WRK-XN-00001 PICTURE X. NC1774.2 +010200 77 ADD-12 PICTURE PP9 VALUE .001. NC1774.2 +010300 77 ADD-13 PICTURE 9PP VALUE 100. NC1774.2 +010400 77 ADD-14 PICTURE 999V999. NC1774.2 +010500 77 WRK-CU-18V00 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC1774.2 +010600 01 WRK-DU-1V0-1 PIC 9 VALUE ZERO. NC1774.2 +010700 01 WRK-DU-1V1-1 PIC 9V9 VALUE 1.1. NC1774.2 +010800 01 WRK-DU-1V1-2 PIC 9V9 VALUE 2.4. NC1774.2 +010900 01 WRK-DU-1V3-1 PIC 9V999 VALUE 1.001. NC1774.2 +011000 01 WRK-DU-1V3-2 PIC 9V999 VALUE 1.001. NC1774.2 +011100 01 WRK-DU-1V5-1 PIC 9V9(5). NC1774.2 +011200 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC1774.2 +011300 01 WRK-DU-2P6-1 PIC 99P(6) VALUE 99000000. NC1774.2 +011400 01 WRK-DU-2V0-1 PIC 99. NC1774.2 +011500 01 WRK-DU-2V0-2 PIC 99. NC1774.2 +011600 01 WRK-DU-2V0-3 PIC 99. NC1774.2 +011700 01 WRK-DU-2V1-1 PIC 99V9. NC1774.2 +011800 01 WRK-DU-2V1-2 PIC 99V9. NC1774.2 +011900 01 WRK-DU-2V1-3 PIC 99V9. NC1774.2 +012000 77 A18EIGHTS-CS-18V00 PICTURE S9(18) VALUE -888888888888888888 NC1774.2 +012100 COMPUTATIONAL. NC1774.2 +012200 77 A14TWOS-CS-18V00 PICTURE S9(18) VALUE -000022222222222222 NC1774.2 +012300 COMPUTATIONAL. NC1774.2 +012400 77 A12THREES-CU-18V00 PICTURE 9(18) VALUE 000000333333333333 NC1774.2 +012500 COMPUTATIONAL. NC1774.2 +012600 77 A16FOURS-CS-18V00 PICTURE S9(18) VALUE 004444444444444444 NC1774.2 +012700 COMPUTATIONAL. NC1774.2 +012800 77 A18FIVES-CS-18V00 PICTURE S9(18) VALUE -555555555555555555 NC1774.2 +012900 COMPUTATIONAL. NC1774.2 +013000 77 A18SIXES-CS-18V00 PICTURE S9(18) VALUE 666666666666666666 NC1774.2 +013100 COMPUTATIONAL. NC1774.2 +013200 77 A12SEVENS-CU-18V00 PICTURE 9(18) VALUE 000000777777777777 NC1774.2 +013300 COMPUTATIONAL. NC1774.2 +013400 77 WRK-DU-18V00 PICTURE 9(18) VALUE ZERO. NC1774.2 +013500 77 A18THREES-CS-18V00 PICTURE S9(18) VALUE -333333333333333333 NC1774.2 +013600 COMPUTATIONAL. NC1774.2 +013700 77 WRK-CS-03V00 PICTURE S999 COMPUTATIONAL SYNCHRONIZED RIGHT. NC1774.2 +013800 01 SUBTRACT-DATA. NC1774.2 +013900 02 SUBTR-1 PICTURE 9 VALUE 1. NC1774.2 +014000 02 SUBTR-2 PICTURE S99 VALUE 99. NC1774.2 +014100 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC1774.2 +014200 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC1774.2 +014300 02 SUBTR-5 PICTURE S9PP VALUE 100. NC1774.2 +014400 02 SUBTR-6 PICTURE 9 VALUE 1. NC1774.2 +014500 02 SUBTR-7 PICTURE S99 VALUE 99. NC1774.2 +014600 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC1774.2 +014700 02 SUBTR-10 PICTURE S999 VALUE 100. NC1774.2 +014800 02 SUBTR-11 PICTURE S999V999. NC1774.2 +014900 01 N-3 PICTURE IS 99999. NC1774.2 +015000 01 N-4 PICTURE IS 9(5) NC1774.2 +015100 VALUE IS 52800. NC1774.2 +015200 01 N-5 PICTURE IS S9(9)V99 NC1774.2 +015300 VALUE IS 000000001.00. NC1774.2 +015400 01 N-7 PICTURE IS S9(7)V9(4) NC1774.2 +015500 VALUE IS 0000001.0000. NC1774.2 +015600 01 X-8 REDEFINES N-7 PICTURE IS X(11). NC1774.2 +015700 01 N-10 PICTURE IS S99999V NC1774.2 +015800 VALUE IS -00001. NC1774.2 +015900 01 N-11 PICTURE IS 9 VALUE IS 9. NC1774.2 +016000 01 N-12 PICTURE IS 9 VALUE IS 9. NC1774.2 +016100 01 N-13 PICTURE IS 9(5) NC1774.2 +016200 VALUE IS 99999. NC1774.2 +016300 01 N-14 PICTURE IS 9 VALUE IS 1. NC1774.2 +016400 01 N-15 PICTURE IS 9(16). NC1774.2 +016500 01 N-16 PICTURE IS S999999V99 NC1774.2 +016600 VALUE IS 5.90. NC1774.2 +016700 01 N-17 PICTURE IS S9(3)V99 NC1774.2 +016800 VALUE IS +3.6. NC1774.2 +016900 01 N-18 PICTURE IS S9(10) NC1774.2 +017000 VALUE IS -5. NC1774.2 +017100 01 N-19 PICTURE IS $9.00. NC1774.2 +017200 01 N-20 PICTURE IS S9(9) NC1774.2 +017300 VALUE IS -999999999. NC1774.2 +017400 01 N-21 PICTURE IS 9 VALUE IS 5. NC1774.2 +017500 01 N-22 PICTURE IS 999V99 NC1774.2 +017600 VALUE IS 005.55. NC1774.2 +017700 01 N-23 PICTURE IS $$$.99CR. NC1774.2 +017800 01 N-25 PICTURE IS 9 VALUE IS 1. NC1774.2 +017900 01 N-26 PICTURE 9(5). NC1774.2 +018000 01 N-27 PICTURE IS 9999V9 NC1774.2 +018100 VALUE IS 9999.9. NC1774.2 +018200 01 N-28 PICTURE IS $9999.00. NC1774.2 +018300 01 N-40 PICTURE IS 9(7) NC1774.2 +018400 VALUE IS 7777777. NC1774.2 +018500 01 N-41 PICTURE IS 9(7) NC1774.2 +018600 VALUE IS 1111111. NC1774.2 +018700 01 N-42 PICTURE IS 9(3)P(4). NC1774.2 +018800 01 TRUNC-DATA. NC1774.2 +018900 02 N-43 PICTURE S9V9 VALUE +1.6. NC1774.2 +019000 02 N-44 PICTURE S9V9 VALUE -1.6. NC1774.2 +019100 02 N-45 PICTURE S9. NC1774.2 +019200 01 MINUS-NAMES. NC1774.2 +019300 02 MINUS-NAME1 PICTURE S9(18) VALUE -999999999999999999. NC1774.2 +019400 02 MINUS-NAME2 PICTURE S9(18) VALUE -999999999999999999. NC1774.2 +019500 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC1774.2 +019600 02 PLUS-NAME1 PICTURE S9(18) VALUE +999999999999999999. NC1774.2 +019700 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC1774.2 +019800 02 MINUS-NAME3 PICTURE SV9(18) VALUE -.999999999999999999. NC1774.2 +019900 02 MINUS-NAME4 PICTURE SV9(18) VALUE -.999999999999999999. NC1774.2 +020000 02 EVEN-NAME2 PICTURE SV9(18) VALUE +.1. NC1774.2 +020100 02 PLUS-NAME3 PICTURE SV9(18) VALUE +.999999999999999999. NC1774.2 +020200 02 PLUS-NAME4 PICTURE SV9(18) VALUE +.999999999999999999. NC1774.2 +020300 02 WHOLE-FIELD PICTURE S9(18). NC1774.2 +020400 02 DECMAL-FIELD PICTURE SV9(18). NC1774.2 +020500 01 TEST-RESULTS. NC1774.2 +020600 02 FILLER PIC X VALUE SPACE. NC1774.2 +020700 02 FEATURE PIC X(20) VALUE SPACE. NC1774.2 +020800 02 FILLER PIC X VALUE SPACE. NC1774.2 +020900 02 P-OR-F PIC X(5) VALUE SPACE. NC1774.2 +021000 02 FILLER PIC X VALUE SPACE. NC1774.2 +021100 02 PAR-NAME. NC1774.2 +021200 03 FILLER PIC X(19) VALUE SPACE. NC1774.2 +021300 03 PARDOT-X PIC X VALUE SPACE. NC1774.2 +021400 03 DOTVALUE PIC 99 VALUE ZERO. NC1774.2 +021500 02 FILLER PIC X(8) VALUE SPACE. NC1774.2 +021600 02 RE-MARK PIC X(61). NC1774.2 +021700 01 TEST-COMPUTED. NC1774.2 +021800 02 FILLER PIC X(30) VALUE SPACE. NC1774.2 +021900 02 FILLER PIC X(17) VALUE NC1774.2 +022000 " COMPUTED=". NC1774.2 +022100 02 COMPUTED-X. NC1774.2 +022200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC1774.2 +022300 03 COMPUTED-N REDEFINES COMPUTED-A NC1774.2 +022400 PIC -9(9).9(9). NC1774.2 +022500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC1774.2 +022600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC1774.2 +022700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC1774.2 +022800 03 CM-18V0 REDEFINES COMPUTED-A. NC1774.2 +022900 04 COMPUTED-18V0 PIC -9(18). NC1774.2 +023000 04 FILLER PIC X. NC1774.2 +023100 03 FILLER PIC X(50) VALUE SPACE. NC1774.2 +023200 01 TEST-CORRECT. NC1774.2 +023300 02 FILLER PIC X(30) VALUE SPACE. NC1774.2 +023400 02 FILLER PIC X(17) VALUE " CORRECT =". NC1774.2 +023500 02 CORRECT-X. NC1774.2 +023600 03 CORRECT-A PIC X(20) VALUE SPACE. NC1774.2 +023700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC1774.2 +023800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC1774.2 +023900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC1774.2 +024000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC1774.2 +024100 03 CR-18V0 REDEFINES CORRECT-A. NC1774.2 +024200 04 CORRECT-18V0 PIC -9(18). NC1774.2 +024300 04 FILLER PIC X. NC1774.2 +024400 03 FILLER PIC X(2) VALUE SPACE. NC1774.2 +024500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC1774.2 +024600 01 CCVS-C-1. NC1774.2 +024700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC1774.2 +024800- "SS PARAGRAPH-NAME NC1774.2 +024900- " REMARKS". NC1774.2 +025000 02 FILLER PIC X(20) VALUE SPACE. NC1774.2 +025100 01 CCVS-C-2. NC1774.2 +025200 02 FILLER PIC X VALUE SPACE. NC1774.2 +025300 02 FILLER PIC X(6) VALUE "TESTED". NC1774.2 +025400 02 FILLER PIC X(15) VALUE SPACE. NC1774.2 +025500 02 FILLER PIC X(4) VALUE "FAIL". NC1774.2 +025600 02 FILLER PIC X(94) VALUE SPACE. NC1774.2 +025700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC1774.2 +025800 01 REC-CT PIC 99 VALUE ZERO. NC1774.2 +025900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC1774.2 +026000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC1774.2 +026100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC1774.2 +026200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC1774.2 +026300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC1774.2 +026400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC1774.2 +026500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC1774.2 +026600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC1774.2 +026700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC1774.2 +026800 01 CCVS-H-1. NC1774.2 +026900 02 FILLER PIC X(39) VALUE SPACES. NC1774.2 +027000 02 FILLER PIC X(42) VALUE NC1774.2 +027100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC1774.2 +027200 02 FILLER PIC X(39) VALUE SPACES. NC1774.2 +027300 01 CCVS-H-2A. NC1774.2 +027400 02 FILLER PIC X(40) VALUE SPACE. NC1774.2 +027500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC1774.2 +027600 02 FILLER PIC XXXX VALUE NC1774.2 +027700 "4.2 ". NC1774.2 +027800 02 FILLER PIC X(28) VALUE NC1774.2 +027900 " COPY - NOT FOR DISTRIBUTION". NC1774.2 +028000 02 FILLER PIC X(41) VALUE SPACE. NC1774.2 +028100 NC1774.2 +028200 01 CCVS-H-2B. NC1774.2 +028300 02 FILLER PIC X(15) VALUE NC1774.2 +028400 "TEST RESULT OF ". NC1774.2 +028500 02 TEST-ID PIC X(9). NC1774.2 +028600 02 FILLER PIC X(4) VALUE NC1774.2 +028700 " IN ". NC1774.2 +028800 02 FILLER PIC X(12) VALUE NC1774.2 +028900 " HIGH ". NC1774.2 +029000 02 FILLER PIC X(22) VALUE NC1774.2 +029100 " LEVEL VALIDATION FOR ". NC1774.2 +029200 02 FILLER PIC X(58) VALUE NC1774.2 +029300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1774.2 +029400 01 CCVS-H-3. NC1774.2 +029500 02 FILLER PIC X(34) VALUE NC1774.2 +029600 " FOR OFFICIAL USE ONLY ". NC1774.2 +029700 02 FILLER PIC X(58) VALUE NC1774.2 +029800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC1774.2 +029900 02 FILLER PIC X(28) VALUE NC1774.2 +030000 " COPYRIGHT 1985 ". NC1774.2 +030100 01 CCVS-E-1. NC1774.2 +030200 02 FILLER PIC X(52) VALUE SPACE. NC1774.2 +030300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC1774.2 +030400 02 ID-AGAIN PIC X(9). NC1774.2 +030500 02 FILLER PIC X(45) VALUE SPACES. NC1774.2 +030600 01 CCVS-E-2. NC1774.2 +030700 02 FILLER PIC X(31) VALUE SPACE. NC1774.2 +030800 02 FILLER PIC X(21) VALUE SPACE. NC1774.2 +030900 02 CCVS-E-2-2. NC1774.2 +031000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC1774.2 +031100 03 FILLER PIC X VALUE SPACE. NC1774.2 +031200 03 ENDER-DESC PIC X(44) VALUE NC1774.2 +031300 "ERRORS ENCOUNTERED". NC1774.2 +031400 01 CCVS-E-3. NC1774.2 +031500 02 FILLER PIC X(22) VALUE NC1774.2 +031600 " FOR OFFICIAL USE ONLY". NC1774.2 +031700 02 FILLER PIC X(12) VALUE SPACE. NC1774.2 +031800 02 FILLER PIC X(58) VALUE NC1774.2 +031900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC1774.2 +032000 02 FILLER PIC X(13) VALUE SPACE. NC1774.2 +032100 02 FILLER PIC X(15) VALUE NC1774.2 +032200 " COPYRIGHT 1985". NC1774.2 +032300 01 CCVS-E-4. NC1774.2 +032400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC1774.2 +032500 02 FILLER PIC X(4) VALUE " OF ". NC1774.2 +032600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC1774.2 +032700 02 FILLER PIC X(40) VALUE NC1774.2 +032800 " TESTS WERE EXECUTED SUCCESSFULLY". NC1774.2 +032900 01 XXINFO. NC1774.2 +033000 02 FILLER PIC X(19) VALUE NC1774.2 +033100 "*** INFORMATION ***". NC1774.2 +033200 02 INFO-TEXT. NC1774.2 +033300 04 FILLER PIC X(8) VALUE SPACE. NC1774.2 +033400 04 XXCOMPUTED PIC X(20). NC1774.2 +033500 04 FILLER PIC X(5) VALUE SPACE. NC1774.2 +033600 04 XXCORRECT PIC X(20). NC1774.2 +033700 02 INF-ANSI-REFERENCE PIC X(48). NC1774.2 +033800 01 HYPHEN-LINE. NC1774.2 +033900 02 FILLER PIC IS X VALUE IS SPACE. NC1774.2 +034000 02 FILLER PIC IS X(65) VALUE IS "************************NC1774.2 +034100- "*****************************************". NC1774.2 +034200 02 FILLER PIC IS X(54) VALUE IS "************************NC1774.2 +034300- "******************************". NC1774.2 +034400 01 CCVS-PGM-ID PIC X(9) VALUE NC1774.2 +034500 "NC177A". NC1774.2 +034600 PROCEDURE DIVISION. NC1774.2 +034700 CCVS1 SECTION. NC1774.2 +034800 OPEN-FILES. NC1774.2 +034900 OPEN OUTPUT PRINT-FILE. NC1774.2 +035000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC1774.2 +035100 MOVE SPACE TO TEST-RESULTS. NC1774.2 +035200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC1774.2 +035300 GO TO CCVS1-EXIT. NC1774.2 +035400 CLOSE-FILES. NC1774.2 +035500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC1774.2 +035600 TERMINATE-CCVS. NC1774.2 +035700*S EXIT PROGRAM. NC1774.2 +035800*SERMINATE-CALL. NC1774.2 +035900 STOP RUN. NC1774.2 +036000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC1774.2 +036100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC1774.2 +036200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC1774.2 +036300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC1774.2 +036400 MOVE "****TEST DELETED****" TO RE-MARK. NC1774.2 +036500 PRINT-DETAIL. NC1774.2 +036600 IF REC-CT NOT EQUAL TO ZERO NC1774.2 +036700 MOVE "." TO PARDOT-X NC1774.2 +036800 MOVE REC-CT TO DOTVALUE. NC1774.2 +036900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC1774.2 +037000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC1774.2 +037100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC1774.2 +037200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC1774.2 +037300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC1774.2 +037400 MOVE SPACE TO CORRECT-X. NC1774.2 +037500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC1774.2 +037600 MOVE SPACE TO RE-MARK. NC1774.2 +037700 HEAD-ROUTINE. NC1774.2 +037800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +037900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +038000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1774.2 +038100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC1774.2 +038200 COLUMN-NAMES-ROUTINE. NC1774.2 +038300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +038400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +038500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +038600 END-ROUTINE. NC1774.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC1774.2 +038800 END-RTN-EXIT. NC1774.2 +038900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +039000 END-ROUTINE-1. NC1774.2 +039100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC1774.2 +039200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC1774.2 +039300 ADD PASS-COUNTER TO ERROR-HOLD. NC1774.2 +039400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC1774.2 +039500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC1774.2 +039600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC1774.2 +039700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC1774.2 +039800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC1774.2 +039900 END-ROUTINE-12. NC1774.2 +040000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC1774.2 +040100 IF ERROR-COUNTER IS EQUAL TO ZERO NC1774.2 +040200 MOVE "NO " TO ERROR-TOTAL NC1774.2 +040300 ELSE NC1774.2 +040400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC1774.2 +040500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC1774.2 +040600 PERFORM WRITE-LINE. NC1774.2 +040700 END-ROUTINE-13. NC1774.2 +040800 IF DELETE-COUNTER IS EQUAL TO ZERO NC1774.2 +040900 MOVE "NO " TO ERROR-TOTAL ELSE NC1774.2 +041000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC1774.2 +041100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC1774.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +041300 IF INSPECT-COUNTER EQUAL TO ZERO NC1774.2 +041400 MOVE "NO " TO ERROR-TOTAL NC1774.2 +041500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC1774.2 +041600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC1774.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +041800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC1774.2 +041900 WRITE-LINE. NC1774.2 +042000 ADD 1 TO RECORD-COUNT. NC1774.2 +042100 IF RECORD-COUNT GREATER 42 NC1774.2 +042200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC1774.2 +042300 MOVE SPACE TO DUMMY-RECORD NC1774.2 +042400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC1774.2 +042500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1774.2 +042600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC1774.2 +042700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1774.2 +042800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC1774.2 +042900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC1774.2 +043000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC1774.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC1774.2 +043200 MOVE DUMMY-HOLD TO DUMMY-RECORD NC1774.2 +043300 MOVE ZERO TO RECORD-COUNT. NC1774.2 +043400 PERFORM WRT-LN. NC1774.2 +043500 WRT-LN. NC1774.2 +043600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC1774.2 +043700 MOVE SPACE TO DUMMY-RECORD. NC1774.2 +043800 BLANK-LINE-PRINT. NC1774.2 +043900 PERFORM WRT-LN. NC1774.2 +044000 FAIL-ROUTINE. NC1774.2 +044100 IF COMPUTED-X NOT EQUAL TO SPACE NC1774.2 +044200 GO TO FAIL-ROUTINE-WRITE. NC1774.2 +044300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC1774.2 +044400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1774.2 +044500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC1774.2 +044600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +044700 MOVE SPACES TO INF-ANSI-REFERENCE. NC1774.2 +044800 GO TO FAIL-ROUTINE-EX. NC1774.2 +044900 FAIL-ROUTINE-WRITE. NC1774.2 +045000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC1774.2 +045100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC1774.2 +045200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC1774.2 +045300 MOVE SPACES TO COR-ANSI-REFERENCE. NC1774.2 +045400 FAIL-ROUTINE-EX. EXIT. NC1774.2 +045500 BAIL-OUT. NC1774.2 +045600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC1774.2 +045700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC1774.2 +045800 BAIL-OUT-WRITE. NC1774.2 +045900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC1774.2 +046000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC1774.2 +046100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC1774.2 +046200 MOVE SPACES TO INF-ANSI-REFERENCE. NC1774.2 +046300 BAIL-OUT-EX. EXIT. NC1774.2 +046400 CCVS1-EXIT. NC1774.2 +046500 EXIT. NC1774.2 +046600 SECT-NC177A-001 SECTION. NC1774.2 +046700 ADD-INIT-F2-1. NC1774.2 +046800 MOVE "ADD GIVING" TO FEATURE. NC1774.2 +046900 MOVE "VI-74 6.6.4 GR2" TO ANSI-REFERENCE. NC1774.2 +047000 ADD-TEST-F2-1. NC1774.2 +047100 ADD 1 N-14 GIVING N-15. NC1774.2 +047200 IF N-15 EQUAL TO 2 NC1774.2 +047300 PERFORM PASS NC1774.2 +047400 GO TO ADD-WRITE-F2-1. NC1774.2 +047500 GO TO ADD-FAIL-F2-1. NC1774.2 +047600 ADD-DELETE-F2-1. NC1774.2 +047700 PERFORM DE-LETE. NC1774.2 +047800 GO TO ADD-WRITE-F2-1. NC1774.2 +047900 ADD-FAIL-F2-1. NC1774.2 +048000 MOVE N-15 TO COMPUTED-N. NC1774.2 +048100 MOVE 2 TO CORRECT-N. NC1774.2 +048200 PERFORM FAIL. NC1774.2 +048300 ADD-WRITE-F2-1. NC1774.2 +048400 MOVE "ADD-TEST-F2-1 " TO PAR-NAME. NC1774.2 +048500 PERFORM PRINT-DETAIL. NC1774.2 +048600 ADD-TEST-F2-2. NC1774.2 +048700 ADD N-16 N-4 GIVING N-3 ROUNDED. NC1774.2 +048800 IF N-3 EQUAL TO 52806 NC1774.2 +048900 PERFORM PASS NC1774.2 +049000 GO TO ADD-WRITE-F2-2. NC1774.2 +049100 GO TO ADD-FAIL-F2-2. NC1774.2 +049200 ADD-DELETE-F2-2. NC1774.2 +049300 PERFORM DE-LETE. NC1774.2 +049400 GO TO ADD-WRITE-F2-2. NC1774.2 +049500 ADD-FAIL-F2-2. NC1774.2 +049600 MOVE N-3 TO COMPUTED-N. NC1774.2 +049700 MOVE 52806 TO CORRECT-N. NC1774.2 +049800 PERFORM FAIL. NC1774.2 +049900 ADD-WRITE-F2-2. NC1774.2 +050000 MOVE "ADD-TEST-F2-2 " TO PAR-NAME. NC1774.2 +050100 PERFORM PRINT-DETAIL. NC1774.2 +050200 MOVE 52806 TO N-3. NC1774.2 +050300 ADD-TEST-F2-3-1. NC1774.2 +050400 ADD N-13 1 GIVING N-3 ON SIZE ERROR NC1774.2 +050500 PERFORM PASS NC1774.2 +050600 GO TO ADD-WRITE-F2-3-1. NC1774.2 +050700* NOTE WHEN SIZE ERROR CONDITION OCCURS, VALUE OF NC1774.2 +050800* N-3 SHOULD NOT BE CHANGED. NC1774.2 +050900 GO TO ADD-FAIL-F2-3-1. NC1774.2 +051000 ADD-DELETE-F2-3-1. NC1774.2 +051100 PERFORM DE-LETE. NC1774.2 +051200 GO TO ADD-WRITE-F2-3-1. NC1774.2 +051300 ADD-FAIL-F2-3-1. NC1774.2 +051400 MOVE N-3 TO COMPUTED-N. NC1774.2 +051500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1774.2 +051600 PERFORM FAIL. NC1774.2 +051700 ADD-WRITE-F2-3-1. NC1774.2 +051800 MOVE "ADD-TEST-F2-3-1 " TO PAR-NAME. NC1774.2 +051900 PERFORM PRINT-DETAIL. NC1774.2 +052000 ADD-TEST-F2-3-2. NC1774.2 +052100 IF N-3 NOT = 52806 NC1774.2 +052200 MOVE N-3 TO COMPUTED-N NC1774.2 +052300 MOVE 42806 TO CORRECT-N NC1774.2 +052400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK NC1774.2 +052500 MOVE "ADD-TEST-F2-3-2 " TO PAR-NAME NC1774.2 +052600 PERFORM FAIL NC1774.2 +052700 PERFORM PRINT-DETAIL. NC1774.2 +052800 ADD-TEST-F2-4-1. NC1774.2 +052900 ADD 1.6 N-13 GIVING N-3 ROUNDED ON SIZE ERROR NC1774.2 +053000 PERFORM PASS NC1774.2 +053100 GO TO ADD-WRITE-F2-4-1. NC1774.2 +053200 GO TO ADD-FAIL-F2-4-1. NC1774.2 +053300 ADD-DELETE-F2-4-1. NC1774.2 +053400 PERFORM DE-LETE. NC1774.2 +053500 GO TO ADD-WRITE-F2-4-1. NC1774.2 +053600 ADD-FAIL-F2-4-1. NC1774.2 +053700 MOVE N-3 TO COMPUTED-N. NC1774.2 +053800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1774.2 +053900 PERFORM FAIL. NC1774.2 +054000 ADD-WRITE-F2-4-1. NC1774.2 +054100 MOVE "ADD-TEST-F2-4-1 " TO PAR-NAME. NC1774.2 +054200 PERFORM PRINT-DETAIL. NC1774.2 +054300 ADD-TEST-F2-4-2. NC1774.2 +054400 IF N-3 EQUAL TO 52806 NC1774.2 +054500 PERFORM PASS NC1774.2 +054600 GO TO ADD-WRITE-F2-4-2. NC1774.2 +054700 GO TO ADD-FAIL-F2-4-2. NC1774.2 +054800 ADD-DELETE-F2-4-2. NC1774.2 +054900 PERFORM DE-LETE. NC1774.2 +055000 GO TO ADD-WRITE-F2-4-2. NC1774.2 +055100 ADD-FAIL-F2-4-2. NC1774.2 +055200 MOVE N-3 TO COMPUTED-N. NC1774.2 +055300 MOVE 52806 TO CORRECT-N. NC1774.2 +055400 PERFORM FAIL. NC1774.2 +055500 ADD-WRITE-F2-4-2. NC1774.2 +055600 MOVE "ADD-TEST-F2-4-2" TO PAR-NAME. NC1774.2 +055700 PERFORM PRINT-DETAIL. NC1774.2 +055800 ADD-INIT-F2-5. NC1774.2 +055900 MOVE " GIVING" TO FEATURE. NC1774.2 +056000 ADD-TEST-F2-5. NC1774.2 +056100 MOVE ZERO TO WRK-DS-09V09. NC1774.2 +056200 ADD A06THREES-DS-03V03 NC1774.2 +056300 A12THREES-DS-06V06 GIVING WRK-DS-09V09. NC1774.2 +056400 IF WRK-DS-09V09 EQUAL TO 000333666.666333000 NC1774.2 +056500 PERFORM PASS GO TO ADD-WRITE-F2-5. NC1774.2 +056600 GO TO ADD-FAIL-F2-5. NC1774.2 +056700 ADD-DELETE-F2-5. NC1774.2 +056800 PERFORM DE-LETE. NC1774.2 +056900 GO TO ADD-WRITE-F2-5. NC1774.2 +057000 ADD-FAIL-F2-5. NC1774.2 +057100 MOVE WRK-DS-09V09 TO COMPUTED-N. NC1774.2 +057200 MOVE 000333666.666333000 TO CORRECT-N. NC1774.2 +057300 PERFORM FAIL. NC1774.2 +057400 ADD-WRITE-F2-5. NC1774.2 +057500 MOVE "ADD-TEST-F2-5" TO PAR-NAME. NC1774.2 +057600 PERFORM PRINT-DETAIL. NC1774.2 +057700 ADD-TEST-F2-6. NC1774.2 +057800 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +057900 ADD A05ONES-DS-05V00 NC1774.2 +058000 A05ONES-DS-00V05 NC1774.2 +058100 A12THREES-DS-06V06 NC1774.2 +058200 A06THREES-DS-03V03 GIVING WRK-DS-06V06. NC1774.2 +058300 IF WRK-DS-06V06 EQUAL TO 344777.777443 NC1774.2 +058400 PERFORM PASS GO TO ADD-WRITE-F2-6. NC1774.2 +058500 GO TO ADD-FAIL-F2-6. NC1774.2 +058600 ADD-DELETE-F2-6. NC1774.2 +058700 PERFORM DE-LETE. NC1774.2 +058800 GO TO ADD-WRITE-F2-6. NC1774.2 +058900 ADD-FAIL-F2-6. NC1774.2 +059000 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1774.2 +059100 MOVE 344777.777443 TO CORRECT-N. NC1774.2 +059200 PERFORM FAIL. NC1774.2 +059300 ADD-WRITE-F2-6. NC1774.2 +059400 MOVE "ADD-TEST-F2-6" TO PAR-NAME. NC1774.2 +059500 PERFORM PRINT-DETAIL. NC1774.2 +059600 ADD-TEST-F2-7. NC1774.2 +059700 MOVE ZERO TO WRK-DS-06V00. NC1774.2 +059800 ADD A05ONES-DS-00V05 NC1774.2 +059900 A12THREES-DS-06V06 NC1774.2 +060000 A05ONES-DS-00V05 GIVING WRK-DS-06V00 ROUNDED. NC1774.2 +060100 IF WRK-DS-06V00 EQUAL TO 333334 NC1774.2 +060200 PERFORM PASS GO TO ADD-WRITE-F2-7. NC1774.2 +060300 GO TO ADD-FAIL-F2-7. NC1774.2 +060400 ADD-DELETE-F2-7. NC1774.2 +060500 PERFORM DE-LETE. NC1774.2 +060600 GO TO ADD-WRITE-F2-7. NC1774.2 +060700 ADD-FAIL-F2-7. NC1774.2 +060800 MOVE WRK-DS-06V00 TO COMPUTED-N. NC1774.2 +060900 MOVE 333334 TO CORRECT-N. NC1774.2 +061000 PERFORM FAIL. NC1774.2 +061100 ADD-WRITE-F2-7. NC1774.2 +061200 MOVE "ADD-TEST-F2-7" TO PAR-NAME. NC1774.2 +061300 PERFORM PRINT-DETAIL. NC1774.2 +061400 ADD-INIT-F2-8-1. NC1774.2 +061500 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +061600 ADD-TEST-F2-8-1. NC1774.2 +061700 ADD A12ONES-DS-12V00 NC1774.2 +061800 ZERO GIVING WRK-DS-10V00 ON SIZE ERROR NC1774.2 +061900 PERFORM PASS GO TO ADD-WRITE-F2-8-1. NC1774.2 +062000 GO TO ADD-FAIL-F2-8-1. NC1774.2 +062100 ADD-DELETE-F2-8-1. NC1774.2 +062200 PERFORM DE-LETE. NC1774.2 +062300 GO TO ADD-WRITE-F2-8-1. NC1774.2 +062400 ADD-FAIL-F2-8-1. NC1774.2 +062500 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1774.2 +062600 PERFORM FAIL. NC1774.2 +062700 ADD-WRITE-F2-8-1. NC1774.2 +062800 MOVE "ADD-TEST-F2-8-1" TO PAR-NAME. NC1774.2 +062900 PERFORM PRINT-DETAIL. NC1774.2 +063000 ADD-TEST-F2-8-2. NC1774.2 +063100 IF WRK-DS-10V00 EQUAL TO ZERO NC1774.2 +063200 PERFORM PASS GO TO ADD-WRITE-F2-8-2. NC1774.2 +063300* NOTE THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F2-8-1NC1774.2 +063400 GO TO ADD-FAIL-F2-8-2. NC1774.2 +063500 ADD-DELETE-F2-8-2. NC1774.2 +063600 PERFORM DE-LETE. NC1774.2 +063700 GO TO ADD-WRITE-F2-8-2. NC1774.2 +063800 ADD-FAIL-F2-8-2. NC1774.2 +063900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1774.2 +064000 MOVE WRK-DS-10V00 TO COMPUTED-14V4. NC1774.2 +064100 MOVE ZERO TO CORRECT-14V4. NC1774.2 +064200 PERFORM FAIL. NC1774.2 +064300 ADD-WRITE-F2-8-2. NC1774.2 +064400 MOVE "ADD-TEST-F2-8-2" TO PAR-NAME. NC1774.2 +064500 PERFORM PRINT-DETAIL. NC1774.2 +064600 ADD-TEST-F2-9-1. NC1774.2 +064700 MOVE ZERO TO WRK-DS-05V00 NC1774.2 +064800 ADD 33333 NC1774.2 +064900 A06THREES-DS-03V03 NC1774.2 +065000 A12THREES-DS-06V06 NC1774.2 +065100 GIVING WRK-DS-05V00 ROUNDED ON SIZE ERROR NC1774.2 +065200 PERFORM PASS GO TO ADD-WRITE-F2-9-1. NC1774.2 +065300 GO TO ADD-FAIL-F2-9-1. NC1774.2 +065400 ADD-DELETE-F2-9-1. NC1774.2 +065500 PERFORM DE-LETE. NC1774.2 +065600 GO TO ADD-WRITE-F2-9-1. NC1774.2 +065700 ADD-FAIL-F2-9-1. NC1774.2 +065800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC1774.2 +065900 PERFORM FAIL. NC1774.2 +066000 ADD-WRITE-F2-9-1. NC1774.2 +066100 MOVE "ADD-TEST-F2-9-1" TO PAR-NAME. NC1774.2 +066200 PERFORM PRINT-DETAIL. NC1774.2 +066300 ADD-TEST-F2-9-2. NC1774.2 +066400 IF WRK-DS-05V00 EQUAL TO ZERO NC1774.2 +066500 PERFORM PASS GO TO ADD-WRITE-F2-9-2. NC1774.2 +066600 GO TO ADD-FAIL-F2-9-2. NC1774.2 +066700* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F2-9-1 NC1774.2 +066800 ADD-DELETE-F2-9-2. NC1774.2 +066900 PERFORM DE-LETE. NC1774.2 +067000 GO TO ADD-WRITE-F2-9-2. NC1774.2 +067100 ADD-FAIL-F2-9-2. NC1774.2 +067200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC1774.2 +067300 MOVE WRK-DS-05V00 TO COMPUTED-N. NC1774.2 +067400 MOVE ZERO TO CORRECT-N. NC1774.2 +067500 PERFORM FAIL. NC1774.2 +067600 ADD-WRITE-F2-9-2. NC1774.2 +067700 MOVE "ADD-TEST-F2-9-2" TO PAR-NAME. NC1774.2 +067800 PERFORM PRINT-DETAIL. NC1774.2 +067900 ADD-INIT-F2-10. NC1774.2 +068000 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +068100 ADD-TEST-F2-10-1. NC1774.2 +068200 ADD A12THREES-DS-06V06 NC1774.2 +068300 333333 NC1774.2 +068400 A06THREES-DS-03V03 NC1774.2 +068500 GIVING WRK-DS-06V06 ROUNDED ON SIZE ERROR NC1774.2 +068600 GO TO ADD-FAIL-F2-10-1. NC1774.2 +068700 PERFORM PASS. NC1774.2 +068800 GO TO ADD-WRITE-F2-10-1. NC1774.2 +068900 ADD-DELETE-F2-10-1. NC1774.2 +069000 PERFORM DE-LETE. NC1774.2 +069100 GO TO ADD-WRITE-F2-10-1. NC1774.2 +069200 ADD-FAIL-F2-10-1. NC1774.2 +069300 MOVE "SIZE ERR SHOULD NOT EXECUTE" TO RE-MARK. NC1774.2 +069400 PERFORM FAIL. NC1774.2 +069500 ADD-WRITE-F2-10-1. NC1774.2 +069600 MOVE "ADD-TEST-F2-10-1" TO PAR-NAME. NC1774.2 +069700 PERFORM PRINT-DETAIL. NC1774.2 +069800 ADD-TEST-F2-10-2. NC1774.2 +069900 IF WRK-DS-06V06 EQUAL TO 666999.666333 NC1774.2 +070000 PERFORM PASS GO TO ADD-WRITE-F2-10-2. NC1774.2 +070100* NOTE: THIS TEST DEPENDS UPON THE RESULT OF ADD-TEST-F2-10-1 NC1774.2 +070200 GO TO ADD-FAIL-F2-10-2. NC1774.2 +070300 ADD-DELETE-F2-10-2. NC1774.2 +070400 PERFORM DE-LETE. NC1774.2 +070500 GO TO ADD-WRITE-F2-10-2. NC1774.2 +070600 ADD-FAIL-F2-10-2. NC1774.2 +070700 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1774.2 +070800 MOVE 666999.666333 TO CORRECT-N. NC1774.2 +070900 PERFORM FAIL. NC1774.2 +071000 ADD-WRITE-F2-10-2. NC1774.2 +071100 MOVE "ADD-TEST-F2-10-2" TO PAR-NAME. NC1774.2 +071200 PERFORM PRINT-DETAIL. NC1774.2 +071300 ADD-INIT-F2-11. NC1774.2 +071400 MOVE " SERIES" TO FEATURE. NC1774.2 +071500 ADD-TEST-F2-11. NC1774.2 +071600 MOVE ZERO TO WRK-DS-03V10. NC1774.2 +071700 ADD A99-DS-02V00 NC1774.2 +071800 A03ONES-DS-02V01 NC1774.2 +071900 A06ONES-DS-03V03 NC1774.2 +072000 A08TWOS-DS-02V06 NC1774.2 +072100 -1.1111111 NC1774.2 +072200 +.11111111 NC1774.2 +072300 A01ONE-DS-P0801 GIVING WRK-DS-03V10. NC1774.2 +072400 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1774.2 +072500 PERFORM PASS GO TO ADD-WRITE-F2-11. NC1774.2 +072600 GO TO ADD-FAIL-F2-11. NC1774.2 +072700 ADD-DELETE-F2-11. NC1774.2 +072800 PERFORM DE-LETE. NC1774.2 +072900 GO TO ADD-WRITE-F2-11. NC1774.2 +073000 ADD-FAIL-F2-11. NC1774.2 +073100 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1774.2 +073200 MOVE 242.4332220110 TO CORRECT-4V14. NC1774.2 +073300 PERFORM FAIL. NC1774.2 +073400 ADD-WRITE-F2-11. NC1774.2 +073500 MOVE "ADD-TEST-F2-11" TO PAR-NAME. NC1774.2 +073600 PERFORM PRINT-DETAIL. NC1774.2 +073700 ADD-TEST-F2-12. NC1774.2 +073800 MOVE ZERO TO WRK-DS-03V10. NC1774.2 +073900 ADD A01ONE-DS-P0801 NC1774.2 +074000 +.11111111 NC1774.2 +074100 -1.1111111 NC1774.2 +074200 A08TWOS-DS-02V06 NC1774.2 +074300 A06ONES-DS-03V03 NC1774.2 +074400 A03ONES-DS-02V01 NC1774.2 +074500 A99-DS-02V00 GIVING WRK-DS-03V10. NC1774.2 +074600 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1774.2 +074700 PERFORM PASS GO TO ADD-WRITE-F2-12. NC1774.2 +074800 GO TO ADD-FAIL-F2-12. NC1774.2 +074900 ADD-DELETE-F2-12. NC1774.2 +075000 PERFORM DE-LETE. NC1774.2 +075100 GO TO ADD-WRITE-F2-12. NC1774.2 +075200 ADD-FAIL-F2-12. NC1774.2 +075300 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1774.2 +075400 MOVE 242.4332220110 TO CORRECT-4V14. NC1774.2 +075500 PERFORM FAIL. NC1774.2 +075600 ADD-WRITE-F2-12. NC1774.2 +075700 MOVE "ADD-TEST-F2-12" TO PAR-NAME. NC1774.2 +075800 PERFORM PRINT-DETAIL. NC1774.2 +075900 ADD-TEST-F2-13. NC1774.2 +076000 MOVE ZERO TO WRK-DS-03V10. NC1774.2 +076100 ADD A08TWOS-DS-02V06 NC1774.2 +076200 A99-DS-02V00 NC1774.2 +076300 -1.1111111 NC1774.2 +076400 A03ONES-DS-02V01 NC1774.2 +076500 A01ONE-DS-P0801 NC1774.2 +076600 +.11111111 NC1774.2 +076700 A06ONES-DS-03V03 GIVING WRK-DS-03V10. NC1774.2 +076800 IF WRK-DS-03V10 EQUAL TO 242.4332220110 NC1774.2 +076900 PERFORM PASS GO TO ADD-WRITE-F2-13. NC1774.2 +077000 GO TO ADD-FAIL-F2-13. NC1774.2 +077100 ADD-DELETE-F2-13. NC1774.2 +077200 PERFORM DE-LETE. NC1774.2 +077300 GO TO ADD-WRITE-F2-13. NC1774.2 +077400 ADD-FAIL-F2-13. NC1774.2 +077500 MOVE WRK-DS-03V10 TO COMPUTED-4V14. NC1774.2 +077600 MOVE 242.4332220110 TO CORRECT-4V14. NC1774.2 +077700 PERFORM FAIL. NC1774.2 +077800 ADD-WRITE-F2-13. NC1774.2 +077900 MOVE "ADD-TEST-F2-13" TO PAR-NAME. NC1774.2 +078000 PERFORM PRINT-DETAIL. NC1774.2 +078100 ADD-TEST-F2-14. NC1774.2 +078200 ADD ADD-12 ADD-13 GIVING ADD-14. NC1774.2 +078300 IF ADD-14 EQUAL TO 100.001 NC1774.2 +078400 PERFORM PASS GO TO ADD-WRITE-F2-14. NC1774.2 +078500 GO TO ADD-FAIL-F2-14. NC1774.2 +078600 ADD-DELETE-F2-14. NC1774.2 +078700 PERFORM DE-LETE. NC1774.2 +078800 GO TO ADD-WRITE-F2-14. NC1774.2 +078900 ADD-FAIL-F2-14. NC1774.2 +079000 MOVE ADD-14 TO COMPUTED-N. NC1774.2 +079100 MOVE 100.001 TO CORRECT-N. NC1774.2 +079200 PERFORM FAIL. NC1774.2 +079300 ADD-WRITE-F2-14. NC1774.2 +079400 MOVE "ADD-TEST-F2-14" TO PAR-NAME. NC1774.2 +079500 PERFORM PRINT-DETAIL. NC1774.2 +079600 ADD-TEST-F2-15-1. NC1774.2 +079700 MOVE SPACE TO SIZE-ERR. NC1774.2 +079800 ADD MINUS-NAME1 MINUS-NAME2 -34 -1 PLUS-NAME1 NC1774.2 +079900 PLUS-NAME2 EVEN-NAME1 35 GIVING WHOLE-FIELD NC1774.2 +080000 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1774.2 +080100 IF WHOLE-FIELD EQUAL TO +1 NC1774.2 +080200 PERFORM PASS NC1774.2 +080300 GO TO ADD-WRITE-F2-15-1. NC1774.2 +080400 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC1774.2 +080500 MOVE +1 TO CORRECT-18V0. NC1774.2 +080600 PERFORM FAIL. NC1774.2 +080700 GO TO ADD-WRITE-F2-15-1. NC1774.2 +080800 ADD-DELETE-F2-15-1. NC1774.2 +080900 PERFORM DE-LETE. NC1774.2 +081000 ADD-WRITE-F2-15-1. NC1774.2 +081100 MOVE "ADD-TEST-F2-15-1" TO PAR-NAME. NC1774.2 +081200 PERFORM PRINT-DETAIL. NC1774.2 +081300 ADD-TEST-F2-15-2. NC1774.2 +081400 IF SIZE-ERR EQUAL TO "1" NC1774.2 +081500 PERFORM FAIL NC1774.2 +081600 MOVE SPACE TO CORRECT-A NC1774.2 +081700 MOVE 1 TO COMPUTED-A NC1774.2 +081800 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK NC1774.2 +081900 GO TO ADD-WRITE-F2-15-2. NC1774.2 +082000 PERFORM PASS. NC1774.2 +082100 GO TO ADD-WRITE-F2-15-2. NC1774.2 +082200 ADD-DELETE-F2-15-2. NC1774.2 +082300 PERFORM DE-LETE. NC1774.2 +082400 ADD-WRITE-F2-15-2. NC1774.2 +082500 MOVE "ADD-TEST-F2-15-2" TO PAR-NAME. NC1774.2 +082600 PERFORM PRINT-DETAIL. NC1774.2 +082700 ADD-TEST-F2-16-1. NC1774.2 +082800 MOVE SPACE TO SIZE-ERR. NC1774.2 +082900 ADD MINUS-NAME3 MINUS-NAME4 -.34 -.01 PLUS-NAME3 NC1774.2 +083000 PLUS-NAME4 EVEN-NAME2 .35 GIVING DECMAL-FIELD NC1774.2 +083100 ON SIZE ERROR MOVE "1" TO SIZE-ERR. NC1774.2 +083200 IF DECMAL-FIELD EQUAL TO +.1 NC1774.2 +083300 PERFORM PASS NC1774.2 +083400 GO TO ADD-WRITE-F2-16-1. NC1774.2 +083500 MOVE DECMAL-FIELD TO COMPUTED-0V18. NC1774.2 +083600 MOVE +.1 TO CORRECT-0V18. NC1774.2 +083700 PERFORM FAIL. NC1774.2 +083800 GO TO ADD-WRITE-F2-16-1. NC1774.2 +083900 ADD-DELETE-F2-16-1. NC1774.2 +084000 PERFORM DE-LETE. NC1774.2 +084100 ADD-WRITE-F2-16-1. NC1774.2 +084200 MOVE "ADD-TEST-F2-16-1" TO PAR-NAME. NC1774.2 +084300 PERFORM PRINT-DETAIL. NC1774.2 +084400 ADD-TEST-F2-16-2. NC1774.2 +084500 IF SIZE-ERR EQUAL TO "1" NC1774.2 +084600 PERFORM FAIL NC1774.2 +084700 MOVE SPACE TO CORRECT-A NC1774.2 +084800 MOVE 1 TO COMPUTED-A NC1774.2 +084900 MOVE "SIZE ERROR PRECEDING TEST " TO RE-MARK NC1774.2 +085000 GO TO ADD-WRITE-F2-16-2. NC1774.2 +085100 PERFORM PASS. NC1774.2 +085200 GO TO ADD-WRITE-F2-16-2. NC1774.2 +085300 ADD-DELETE-F2-16-2. NC1774.2 +085400 PERFORM DE-LETE. NC1774.2 +085500 ADD-WRITE-F2-16-2. NC1774.2 +085600 MOVE "ADD-TEST-F2-16-2" TO PAR-NAME. NC1774.2 +085700 PERFORM PRINT-DETAIL. NC1774.2 +085800 ADD-TEST-F2-17. NC1774.2 +085900 MOVE ZERO TO WRK-CS-18V00. NC1774.2 +086000 ADD A18ONES-CS-18V00 A18ONES-DS-18V00 GIVING WRK-CS-18V00. NC1774.2 +086100 IF WRK-CS-18V00 EQUAL TO 222222222222222222 NC1774.2 +086200 PERFORM PASS NC1774.2 +086300 GO TO ADD-WRITE-F2-17. NC1774.2 +086400 MOVE 222222222222222222 TO CORRECT-18V0. NC1774.2 +086500 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1774.2 +086600 PERFORM FAIL. NC1774.2 +086700 GO TO ADD-WRITE-F2-17. NC1774.2 +086800 ADD-DELETE-F2-17. NC1774.2 +086900 PERFORM DE-LETE. NC1774.2 +087000 ADD-WRITE-F2-17. NC1774.2 +087100 MOVE "ADD-TEST-F2-17 " TO PAR-NAME. NC1774.2 +087200 PERFORM PRINT-DETAIL. NC1774.2 +087300 ADD-TEST-F2-18. NC1774.2 +087400 MOVE ZERO TO WRK-CS-18V00. NC1774.2 +087500 ADD A18FIVES-CS-18V00 A18SIXES-CS-18V00 GIVING NC1774.2 +087600 WRK-CS-18V00. NC1774.2 +087700 IF WRK-CS-18V00 EQUAL TO 111111111111111111 NC1774.2 +087800 PERFORM PASS NC1774.2 +087900 GO TO ADD-WRITE-F2-18. NC1774.2 +088000 MOVE 111111111111111111 TO CORRECT-18V0. NC1774.2 +088100 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1774.2 +088200 PERFORM FAIL. NC1774.2 +088300 GO TO ADD-WRITE-F2-18. NC1774.2 +088400 ADD-DELETE-F2-18. NC1774.2 +088500 PERFORM DE-LETE. NC1774.2 +088600 ADD-WRITE-F2-18. NC1774.2 +088700 MOVE "ADD-TEST-F2-18 " TO PAR-NAME. NC1774.2 +088800 PERFORM PRINT-DETAIL. NC1774.2 +088900 ADD-TEST-F2-19. NC1774.2 +089000 MOVE ZERO TO WRK-DS-18V00. NC1774.2 +089100 ADD A18SIXES-CS-18V00 A12SEVENS-CU-18V00 GIVING NC1774.2 +089200 WRK-DS-18V00. NC1774.2 +089300 IF WRK-DS-18V00 EQUAL TO 666667444444444443 NC1774.2 +089400 PERFORM PASS NC1774.2 +089500 GO TO ADD-WRITE-F2-19. NC1774.2 +089600 MOVE 666667444444444443 TO CORRECT-18V0. NC1774.2 +089700 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC1774.2 +089800 PERFORM FAIL. NC1774.2 +089900 GO TO ADD-WRITE-F2-19. NC1774.2 +090000 ADD-DELETE-F2-19. NC1774.2 +090100 PERFORM DE-LETE. NC1774.2 +090200 ADD-WRITE-F2-19. NC1774.2 +090300 MOVE "ADD-TEST-F2-19 " TO PAR-NAME. NC1774.2 +090400 PERFORM PRINT-DETAIL. NC1774.2 +090500 ADD-TEST-F2-20. NC1774.2 +090600 MOVE ZERO TO WRK-CS-18V00. NC1774.2 +090700 ADD A14TWOS-CS-18V00 A12THREES-CU-18V00 GIVING NC1774.2 +090800 WRK-CS-18V00 ROUNDED. NC1774.2 +090900 IF WRK-CS-18V00 EQUAL TO -000021888888888889 NC1774.2 +091000 PERFORM PASS NC1774.2 +091100 GO TO ADD-WRITE-F2-20. NC1774.2 +091200 MOVE -000021888888888889 TO CORRECT-18V0. NC1774.2 +091300 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1774.2 +091400 PERFORM FAIL. NC1774.2 +091500 GO TO ADD-WRITE-F2-20. NC1774.2 +091600 ADD-DELETE-F2-20. NC1774.2 +091700 PERFORM DE-LETE. NC1774.2 +091800 ADD-WRITE-F2-20. NC1774.2 +091900 MOVE "ADD-TEST-F2-20 " TO PAR-NAME. NC1774.2 +092000 PERFORM PRINT-DETAIL. NC1774.2 +092100 ADD-TEST-F2-21. NC1774.2 +092200 MOVE ZERO TO WRK-CS-18V00. NC1774.2 +092300 ADD A14TWOS-CS-18V00 A14TWOS-CS-18V00 NC1774.2 +092400 GIVING WRK-CS-18V00. NC1774.2 +092500 IF WRK-CS-18V00 EQUAL TO -000044444444444444 NC1774.2 +092600 PERFORM PASS NC1774.2 +092700 GO TO ADD-WRITE-F2-21. NC1774.2 +092800 MOVE -000044444444444444 TO CORRECT-18V0. NC1774.2 +092900 MOVE WRK-CS-18V00 TO COMPUTED-18V0. NC1774.2 +093000 PERFORM FAIL. NC1774.2 +093100 GO TO ADD-WRITE-F2-21. NC1774.2 +093200 ADD-DELETE-F2-21. NC1774.2 +093300 PERFORM DE-LETE. NC1774.2 +093400 ADD-WRITE-F2-21. NC1774.2 +093500 MOVE "ADD-TEST-F2-21 " TO PAR-NAME. NC1774.2 +093600 PERFORM PRINT-DETAIL. NC1774.2 +093700 ADD-TEST-F2-22. NC1774.2 +093800 MOVE ZERO TO WRK-DU-18V00. NC1774.2 +093900 ADD A14TWOS-CS-18V00 A18FIVES-CS-18V00 GIVING NC1774.2 +094000 WRK-DU-18V00. NC1774.2 +094100 IF WRK-DU-18V00 EQUAL TO 555577777777777777 NC1774.2 +094200 PERFORM PASS NC1774.2 +094300 GO TO ADD-WRITE-F2-22. NC1774.2 +094400 MOVE WRK-DU-18V00 TO COMPUTED-18V0. NC1774.2 +094500 MOVE 555577777777777777 TO CORRECT-18V0. NC1774.2 +094600 PERFORM FAIL. NC1774.2 +094700 GO TO ADD-WRITE-F2-22. NC1774.2 +094800 ADD-DELETE-F2-22. NC1774.2 +094900 PERFORM DE-LETE. NC1774.2 +095000 ADD-WRITE-F2-22. NC1774.2 +095100 MOVE "ADD-TEST-F2-22 " TO PAR-NAME. NC1774.2 +095200 PERFORM PRINT-DETAIL. NC1774.2 +095300* NC1774.2 +095400 ADD-INIT-F2-23. NC1774.2 +095500* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +095600 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +095700 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +095800 ADD-TEST-F2-23. NC1774.2 +095900 ADD A12ONES-DS-12V00 NC1774.2 +096000 ZERO GIVING WRK-DS-10V00 NC1774.2 +096100 NOT ON SIZE ERROR NC1774.2 +096200 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +096300 TO RE-MARK NC1774.2 +096400 PERFORM FAIL GO TO ADD-WRITE-F2-23. NC1774.2 +096500 GO TO ADD-PASS-F2-23. NC1774.2 +096600 ADD-DELETE-F2-23. NC1774.2 +096700 PERFORM DE-LETE. NC1774.2 +096800 GO TO ADD-WRITE-F2-23. NC1774.2 +096900 ADD-PASS-F2-23. NC1774.2 +097000 PERFORM PASS. NC1774.2 +097100 ADD-WRITE-F2-23. NC1774.2 +097200 MOVE "ADD-TEST-F2-23" TO PAR-NAME. NC1774.2 +097300 PERFORM PRINT-DETAIL. NC1774.2 +097400* NC1774.2 +097500 ADD-INIT-F2-24. NC1774.2 +097600* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +097700 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +097800 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +097900 ADD-TEST-F2-24. NC1774.2 +098000 ADD A12THREES-DS-06V06 NC1774.2 +098100 333333 NC1774.2 +098200 A06THREES-DS-03V03 NC1774.2 +098300 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +098400 NOT ON SIZE ERROR NC1774.2 +098500 PERFORM PASS NC1774.2 +098600 GO TO ADD-WRITE-F2-24. NC1774.2 +098700 GO TO ADD-FAIL-F2-24. NC1774.2 +098800 ADD-DELETE-F2-24. NC1774.2 +098900 PERFORM DE-LETE. NC1774.2 +099000 GO TO ADD-WRITE-F2-24. NC1774.2 +099100 ADD-FAIL-F2-24. NC1774.2 +099200 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" TO RE-MARK. NC1774.2 +099300 PERFORM FAIL. NC1774.2 +099400 ADD-WRITE-F2-24. NC1774.2 +099500 MOVE "ADD-TEST-F2-24" TO PAR-NAME. NC1774.2 +099600 PERFORM PRINT-DETAIL. NC1774.2 +099700* NC1774.2 +099800 ADD-INIT-F2-25. NC1774.2 +099900* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +100000 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +100100 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +100200 ADD-TEST-F2-25. NC1774.2 +100300 ADD A12ONES-DS-12V00 NC1774.2 +100400 ZERO GIVING WRK-DS-10V00 NC1774.2 +100500 ON SIZE ERROR NC1774.2 +100600 GO TO ADD-PASS-F2-25 NC1774.2 +100700 NOT ON SIZE ERROR NC1774.2 +100800 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +100900 TO RE-MARK NC1774.2 +101000 PERFORM FAIL GO TO ADD-WRITE-F2-25. NC1774.2 +101100 ADD-DELETE-F2-25. NC1774.2 +101200 PERFORM DE-LETE. NC1774.2 +101300 GO TO ADD-WRITE-F2-25. NC1774.2 +101400 ADD-PASS-F2-25. NC1774.2 +101500 PERFORM PASS. NC1774.2 +101600 ADD-WRITE-F2-25. NC1774.2 +101700 MOVE "ADD-TEST-F2-25" TO PAR-NAME. NC1774.2 +101800 PERFORM PRINT-DETAIL. NC1774.2 +101900* NC1774.2 +102000 ADD-INIT-F2-26. NC1774.2 +102100* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +102200 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +102300 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +102400 ADD-TEST-F2-26. NC1774.2 +102500 ADD A12THREES-DS-06V06 NC1774.2 +102600 333333 NC1774.2 +102700 A06THREES-DS-03V03 NC1774.2 +102800 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +102900 ON SIZE ERROR NC1774.2 +103000 GO TO ADD-FAIL-F2-26 NC1774.2 +103100 NOT ON SIZE ERROR NC1774.2 +103200 PERFORM PASS NC1774.2 +103300 GO TO ADD-WRITE-F2-26. NC1774.2 +103400 ADD-DELETE-F2-26. NC1774.2 +103500 PERFORM DE-LETE. NC1774.2 +103600 GO TO ADD-WRITE-F2-26. NC1774.2 +103700 ADD-FAIL-F2-26. NC1774.2 +103800 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" TO RE-MARK. NC1774.2 +103900 PERFORM FAIL. NC1774.2 +104000 ADD-WRITE-F2-26. NC1774.2 +104100 MOVE "ADD-TEST-F2-26" TO PAR-NAME. NC1774.2 +104200 PERFORM PRINT-DETAIL. NC1774.2 +104300* NC1774.2 +104400 ADD-INIT-F2-27. NC1774.2 +104500* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +104600 MOVE "VI-74 6.6.4 GR2" TO ANSI-REFERENCE. NC1774.2 +104700 MOVE "ADD-TEST-F2-27" TO PAR-NAME. NC1774.2 +104800 MOVE 1 TO REC-CT. NC1774.2 +104900 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +105000 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +105100 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +105200 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +105300 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +105400 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +105500 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +105600 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +105700 ADD-GIVING-TEST-F2-27-0. NC1774.2 +105800 ADD WRK-DU-1V1-1 6 WRK-DU-1V1-2 GIVING WRK-DU-2V1-1 NC1774.2 +105900 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +106000 WRK-DU-2V1-3 WRK-DU-2V0-3. NC1774.2 +106100 GO TO ADD-TEST-F2-27-1. NC1774.2 +106200 ADD-DELETE-F2-27. NC1774.2 +106300 PERFORM DE-LETE. NC1774.2 +106400 PERFORM PRINT-DETAIL. NC1774.2 +106500 GO TO ADD-INIT-F2-28. NC1774.2 +106600 ADD-TEST-F2-27-1. NC1774.2 +106700 IF WRK-DU-2V1-1 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +106800 ELSE NC1774.2 +106900 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.4 NC1774.2 +107000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +107100 ADD 1 TO REC-CT. NC1774.2 +107200 ADD-TEST-F2-27-2. NC1774.2 +107300 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +107400 ELSE NC1774.2 +107500 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 NC1774.2 +107600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +107700 ADD 1 TO REC-CT. NC1774.2 +107800 ADD-ADD-TEST-F2-27-3. NC1774.2 +107900 IF WRK-DU-2V1-2 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +108000 ELSE NC1774.2 +108100 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.4 NC1774.2 +108200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +108300 ADD 1 TO REC-CT. NC1774.2 +108400 ADD-TEST-F2-27-4. NC1774.2 +108500 IF WRK-DU-2V0-2 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +108600 ELSE NC1774.2 +108700 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 9 NC1774.2 +108800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +108900 ADD 1 TO REC-CT. NC1774.2 +109000 ADD-TEST-F2-27-5. NC1774.2 +109100 IF WRK-DU-2V1-3 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +109200 ELSE NC1774.2 +109300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.4 NC1774.2 +109400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +109500 ADD 1 TO REC-CT. NC1774.2 +109600 ADD-TEST-F2-27-6. NC1774.2 +109700 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +109800 ELSE NC1774.2 +109900 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 NC1774.2 +110000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +110100* NC1774.2 +110200 ADD-INIT-F2-28. NC1774.2 +110300* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +110400* ==--> SIZE ERROR <--== NC1774.2 +110500 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +110600 MOVE 1 TO REC-CT. NC1774.2 +110700 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +110800 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +110900 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +111000 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +111100 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +111200 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +111300 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +111400 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +111500 MOVE SPACE TO SIZE-ERR2. NC1774.2 +111600 ADD-GIVING-TEST-F2-28-0. NC1774.2 +111700 ADD A17TWOS-DS-17V00 NC1774.2 +111800 WRK-DU-1V1-1 NC1774.2 +111900 6 NC1774.2 +112000 WRK-DU-1V1-2 NC1774.2 +112100 GIVING WRK-DU-2V1-1 NC1774.2 +112200 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +112300 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +112400 ON SIZE ERROR NC1774.2 +112500 MOVE "A" TO SIZE-ERR2. NC1774.2 +112600 GO TO ADD-TEST-F2-28-1. NC1774.2 +112700 ADD-DELETE-F2-28. NC1774.2 +112800 PERFORM DE-LETE. NC1774.2 +112900 PERFORM PRINT-DETAIL. NC1774.2 +113000 GO TO ADD-INIT-F2-29. NC1774.2 +113100 ADD-TEST-F2-28-1. NC1774.2 +113200 MOVE "ADD-TEST-F2-28-1" TO PAR-NAME. NC1774.2 +113300 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +113400 ELSE NC1774.2 +113500 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE ZERO NC1774.2 +113600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +113700 ADD 1 TO REC-CT. NC1774.2 +113800 ADD-TEST-F2-28-2. NC1774.2 +113900 MOVE "ADD-TEST-F2-28-2" TO PAR-NAME. NC1774.2 +114000 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +114100 ELSE NC1774.2 +114200 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE ZERO NC1774.2 +114300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +114400 ADD 1 TO REC-CT. NC1774.2 +114500 ADD-ADD-TEST-F2-28-3. NC1774.2 +114600 MOVE "ADD-TEST-F2-28-3" TO PAR-NAME. NC1774.2 +114700 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +114800 ELSE NC1774.2 +114900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE ZERO NC1774.2 +115000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +115100 ADD 1 TO REC-CT. NC1774.2 +115200 ADD-TEST-F2-28-4. NC1774.2 +115300 MOVE "ADD-TEST-F2-28-4" TO PAR-NAME. NC1774.2 +115400 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +115500 ELSE NC1774.2 +115600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE ZERO NC1774.2 +115700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +115800 ADD 1 TO REC-CT. NC1774.2 +115900 ADD-TEST-F2-28-5. NC1774.2 +116000 MOVE "ADD-TEST-F2-28-5" TO PAR-NAME. NC1774.2 +116100 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +116200 ELSE NC1774.2 +116300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE ZERO NC1774.2 +116400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +116500 ADD 1 TO REC-CT. NC1774.2 +116600 ADD-TEST-F2-28-6. NC1774.2 +116700 MOVE "ADD-TEST-F2-28-6" TO PAR-NAME. NC1774.2 +116800 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +116900 ELSE NC1774.2 +117000 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE ZERO NC1774.2 +117100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +117200 ADD 1 TO REC-CT. NC1774.2 +117300 ADD-TEST-F2-28-7. NC1774.2 +117400 MOVE "ADD-TEST-F2-28-7" TO PAR-NAME. NC1774.2 +117500 IF SIZE-ERR2 = "A" NC1774.2 +117600 PERFORM PASS NC1774.2 +117700 PERFORM PRINT-DETAIL NC1774.2 +117800 ELSE NC1774.2 +117900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +118000 TO RE-MARK NC1774.2 +118100 MOVE "A" TO CORRECT-X NC1774.2 +118200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +118300 PERFORM FAIL NC1774.2 +118400 PERFORM PRINT-DETAIL. NC1774.2 +118500* NC1774.2 +118600 ADD-INIT-F2-29. NC1774.2 +118700* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +118800* ==--> NO SIZE ERROR <--== NC1774.2 +118900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +119000 MOVE 1 TO REC-CT. NC1774.2 +119100 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +119200 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +119300 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +119400 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +119500 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +119600 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +119700 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +119800 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +119900 MOVE SPACE TO SIZE-ERR2. NC1774.2 +120000 ADD-GIVING-TEST-F2-29-0. NC1774.2 +120100 ADD WRK-DU-1V1-1 6 WRK-DU-1V1-2 GIVING WRK-DU-2V1-1 NC1774.2 +120200 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +120300 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +120400 ON SIZE ERROR NC1774.2 +120500 MOVE "A" TO SIZE-ERR2. NC1774.2 +120600 GO TO ADD-TEST-F2-29-1. NC1774.2 +120700 ADD-DELETE-F2-29. NC1774.2 +120800 PERFORM DE-LETE. NC1774.2 +120900 PERFORM PRINT-DETAIL. NC1774.2 +121000 GO TO ADD-INIT-F2-30. NC1774.2 +121100 ADD-TEST-F2-29-1. NC1774.2 +121200 MOVE "ADD-TEST-F2-29-1" TO PAR-NAME. NC1774.2 +121300 IF WRK-DU-2V1-1 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +121400 ELSE NC1774.2 +121500 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.4 NC1774.2 +121600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +121700 ADD 1 TO REC-CT. NC1774.2 +121800 ADD-TEST-F2-29-2. NC1774.2 +121900 MOVE "ADD-TEST-F2-29-2" TO PAR-NAME. NC1774.2 +122000 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +122100 ELSE NC1774.2 +122200 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 NC1774.2 +122300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +122400 ADD 1 TO REC-CT. NC1774.2 +122500 ADD-ADD-TEST-F2-29-3. NC1774.2 +122600 MOVE "ADD-TEST-F2-29-3" TO PAR-NAME. NC1774.2 +122700 IF WRK-DU-2V1-2 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +122800 ELSE NC1774.2 +122900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.4 NC1774.2 +123000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +123100 ADD 1 TO REC-CT. NC1774.2 +123200 ADD-TEST-F2-29-4. NC1774.2 +123300 MOVE "ADD-TEST-F2-29-4" TO PAR-NAME. NC1774.2 +123400 IF WRK-DU-2V0-2 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +123500 ELSE NC1774.2 +123600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 9 NC1774.2 +123700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +123800 ADD 1 TO REC-CT. NC1774.2 +123900 ADD-TEST-F2-29-5. NC1774.2 +124000 MOVE "ADD-TEST-F2-29-5" TO PAR-NAME. NC1774.2 +124100 IF WRK-DU-2V1-3 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +124200 ELSE NC1774.2 +124300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.4 NC1774.2 +124400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +124500 ADD 1 TO REC-CT. NC1774.2 +124600 ADD-TEST-F2-29-6. NC1774.2 +124700 MOVE "ADD-TEST-F2-29-6" TO PAR-NAME. NC1774.2 +124800 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +124900 ELSE NC1774.2 +125000 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 NC1774.2 +125100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +125200 ADD 1 TO REC-CT. NC1774.2 +125300 ADD-TEST-F2-29-7. NC1774.2 +125400 MOVE "ADD-TEST-F2-29-7" TO PAR-NAME. NC1774.2 +125500 IF SIZE-ERR2 = SPACE NC1774.2 +125600 PERFORM PASS NC1774.2 +125700 PERFORM PRINT-DETAIL NC1774.2 +125800 ELSE NC1774.2 +125900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +126000 TO RE-MARK NC1774.2 +126100 MOVE SPACE TO CORRECT-X NC1774.2 +126200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +126300 PERFORM FAIL NC1774.2 +126400 PERFORM PRINT-DETAIL. NC1774.2 +126500* NC1774.2 +126600 ADD-INIT-F2-30. NC1774.2 +126700* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +126800* ==--> SIZE ERROR <--== NC1774.2 +126900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +127000 MOVE 1 TO REC-CT. NC1774.2 +127100 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +127200 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +127300 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +127400 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +127500 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +127600 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +127700 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +127800 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +127900 MOVE SPACE TO SIZE-ERR2. NC1774.2 +128000 ADD-GIVING-TEST-F2-30-0. NC1774.2 +128100 ADD A17TWOS-DS-17V00 NC1774.2 +128200 WRK-DU-1V1-1 NC1774.2 +128300 6 NC1774.2 +128400 WRK-DU-1V1-2 NC1774.2 +128500 GIVING WRK-DU-2V1-1 NC1774.2 +128600 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +128700 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +128800 NOT ON SIZE ERROR NC1774.2 +128900 MOVE "A" TO SIZE-ERR2. NC1774.2 +129000 GO TO ADD-TEST-F2-30-1. NC1774.2 +129100 ADD-DELETE-F2-30. NC1774.2 +129200 PERFORM DE-LETE. NC1774.2 +129300 PERFORM PRINT-DETAIL. NC1774.2 +129400 GO TO ADD-INIT-F2-31. NC1774.2 +129500 ADD-TEST-F2-30-1. NC1774.2 +129600 MOVE "ADD-TEST-F2-30-1" TO PAR-NAME. NC1774.2 +129700 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +129800 ELSE NC1774.2 +129900 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE ZERO NC1774.2 +130000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +130100 ADD 1 TO REC-CT. NC1774.2 +130200 ADD-TEST-F2-30-2. NC1774.2 +130300 MOVE "ADD-TEST-F2-30-2" TO PAR-NAME. NC1774.2 +130400 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +130500 ELSE NC1774.2 +130600 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE ZERO NC1774.2 +130700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +130800 ADD 1 TO REC-CT. NC1774.2 +130900 ADD-ADD-TEST-F2-30-3. NC1774.2 +131000 MOVE "ADD-TEST-F2-30-3" TO PAR-NAME. NC1774.2 +131100 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +131200 ELSE NC1774.2 +131300 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE ZERO NC1774.2 +131400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +131500 ADD 1 TO REC-CT. NC1774.2 +131600 ADD-TEST-F2-30-4. NC1774.2 +131700 MOVE "ADD-TEST-F2-30-4" TO PAR-NAME. NC1774.2 +131800 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +131900 ELSE NC1774.2 +132000 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE ZERO NC1774.2 +132100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +132200 ADD 1 TO REC-CT. NC1774.2 +132300 ADD-TEST-F2-30-5. NC1774.2 +132400 MOVE "ADD-TEST-F2-30-5" TO PAR-NAME. NC1774.2 +132500 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +132600 ELSE NC1774.2 +132700 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE ZERO NC1774.2 +132800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +132900 ADD 1 TO REC-CT. NC1774.2 +133000 ADD-TEST-F2-30-6. NC1774.2 +133100 MOVE "ADD-TEST-F2-30-6" TO PAR-NAME. NC1774.2 +133200 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +133300 ELSE NC1774.2 +133400 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE ZERO NC1774.2 +133500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +133600 ADD 1 TO REC-CT. NC1774.2 +133700 ADD-TEST-F2-30-7. NC1774.2 +133800 MOVE "ADD-TEST-F2-30-7" TO PAR-NAME. NC1774.2 +133900 IF SIZE-ERR2 = SPACE NC1774.2 +134000 PERFORM PASS NC1774.2 +134100 PERFORM PRINT-DETAIL NC1774.2 +134200 ELSE NC1774.2 +134300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +134400 TO RE-MARK NC1774.2 +134500 MOVE SPACE TO CORRECT-X NC1774.2 +134600 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +134700 PERFORM FAIL NC1774.2 +134800 PERFORM PRINT-DETAIL. NC1774.2 +134900* NC1774.2 +135000 ADD-INIT-F2-31. NC1774.2 +135100* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +135200* ==--> NO SIZE ERROR <--== NC1774.2 +135300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +135400 MOVE 1 TO REC-CT. NC1774.2 +135500 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +135600 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +135700 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +135800 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +135900 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +136000 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +136100 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +136200 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +136300 MOVE SPACE TO SIZE-ERR2. NC1774.2 +136400 ADD-GIVING-TEST-F2-31-0. NC1774.2 +136500 ADD WRK-DU-1V1-1 6 WRK-DU-1V1-2 GIVING WRK-DU-2V1-1 NC1774.2 +136600 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +136700 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +136800 NOT ON SIZE ERROR NC1774.2 +136900 MOVE "A" TO SIZE-ERR2. NC1774.2 +137000 GO TO ADD-TEST-F2-31-1. NC1774.2 +137100 ADD-DELETE-F2-31. NC1774.2 +137200 PERFORM DE-LETE. NC1774.2 +137300 PERFORM PRINT-DETAIL. NC1774.2 +137400 GO TO ADD-INIT-F2-32. NC1774.2 +137500 ADD-TEST-F2-31-1. NC1774.2 +137600 MOVE "ADD-TEST-F2-31-1" TO PAR-NAME. NC1774.2 +137700 IF WRK-DU-2V1-1 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +137800 ELSE NC1774.2 +137900 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.4 NC1774.2 +138000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +138100 ADD 1 TO REC-CT. NC1774.2 +138200 ADD-TEST-F2-31-2. NC1774.2 +138300 MOVE "ADD-TEST-F2-31-2" TO PAR-NAME. NC1774.2 +138400 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +138500 ELSE NC1774.2 +138600 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 NC1774.2 +138700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +138800 ADD 1 TO REC-CT. NC1774.2 +138900 ADD-ADD-TEST-F2-31-3. NC1774.2 +139000 MOVE "ADD-TEST-F2-31-3" TO PAR-NAME. NC1774.2 +139100 IF WRK-DU-2V1-2 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +139200 ELSE NC1774.2 +139300 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.4 NC1774.2 +139400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +139500 ADD 1 TO REC-CT. NC1774.2 +139600 ADD-TEST-F2-31-4. NC1774.2 +139700 MOVE "ADD-TEST-F2-31-4" TO PAR-NAME. NC1774.2 +139800 IF WRK-DU-2V0-2 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +139900 ELSE NC1774.2 +140000 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 9 NC1774.2 +140100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +140200 ADD 1 TO REC-CT. NC1774.2 +140300 ADD-TEST-F2-31-5. NC1774.2 +140400 MOVE "ADD-TEST-F2-31-5" TO PAR-NAME. NC1774.2 +140500 IF WRK-DU-2V1-3 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +140600 ELSE NC1774.2 +140700 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.4 NC1774.2 +140800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +140900 ADD 1 TO REC-CT. NC1774.2 +141000 ADD-TEST-F2-31-6. NC1774.2 +141100 MOVE "ADD-TEST-F2-31-6" TO PAR-NAME. NC1774.2 +141200 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +141300 ELSE NC1774.2 +141400 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 NC1774.2 +141500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +141600 ADD 1 TO REC-CT. NC1774.2 +141700 ADD-TEST-F2-31-7. NC1774.2 +141800 MOVE "ADD-TEST-F2-31-7" TO PAR-NAME. NC1774.2 +141900 IF SIZE-ERR2 = "A" NC1774.2 +142000 PERFORM PASS NC1774.2 +142100 PERFORM PRINT-DETAIL NC1774.2 +142200 ELSE NC1774.2 +142300 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +142400 TO RE-MARK NC1774.2 +142500 MOVE "A" TO CORRECT-X NC1774.2 +142600 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +142700 PERFORM FAIL NC1774.2 +142800 PERFORM PRINT-DETAIL. NC1774.2 +142900* NC1774.2 +143000 ADD-INIT-F2-32. NC1774.2 +143100* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +143200* ==--> SIZE ERROR <--== NC1774.2 +143300 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +143400 MOVE 1 TO REC-CT. NC1774.2 +143500 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +143600 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +143700 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +143800 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +143900 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +144000 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +144100 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +144200 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +144300 MOVE SPACE TO SIZE-ERR2. NC1774.2 +144400 ADD-GIVING-TEST-F2-32-0. NC1774.2 +144500 ADD A17TWOS-DS-17V00 NC1774.2 +144600 WRK-DU-1V1-1 NC1774.2 +144700 6 NC1774.2 +144800 WRK-DU-1V1-2 NC1774.2 +144900 GIVING WRK-DU-2V1-1 NC1774.2 +145000 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +145100 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +145200 ON SIZE ERROR NC1774.2 +145300 MOVE "A" TO SIZE-ERR2 NC1774.2 +145400 NOT ON SIZE ERROR NC1774.2 +145500 MOVE "B" TO SIZE-ERR2. NC1774.2 +145600 GO TO ADD-TEST-F2-32-1. NC1774.2 +145700 ADD-DELETE-F2-32. NC1774.2 +145800 PERFORM DE-LETE. NC1774.2 +145900 PERFORM PRINT-DETAIL. NC1774.2 +146000 GO TO ADD-INIT-F2-33. NC1774.2 +146100 ADD-TEST-F2-32-1. NC1774.2 +146200 MOVE "ADD-TEST-F2-32-1" TO PAR-NAME. NC1774.2 +146300 IF WRK-DU-2V1-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +146400 ELSE NC1774.2 +146500 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE ZERO NC1774.2 +146600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +146700 ADD 1 TO REC-CT. NC1774.2 +146800 ADD-TEST-F2-32-2. NC1774.2 +146900 MOVE "ADD-TEST-F2-32-2" TO PAR-NAME. NC1774.2 +147000 IF WRK-DU-2V0-1 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +147100 ELSE NC1774.2 +147200 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE ZERO NC1774.2 +147300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +147400 ADD 1 TO REC-CT. NC1774.2 +147500 ADD-ADD-TEST-F2-32-3. NC1774.2 +147600 MOVE "ADD-TEST-F2-32-3" TO PAR-NAME. NC1774.2 +147700 IF WRK-DU-2V1-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +147800 ELSE NC1774.2 +147900 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE ZERO NC1774.2 +148000 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +148100 ADD 1 TO REC-CT. NC1774.2 +148200 ADD-TEST-F2-32-4. NC1774.2 +148300 MOVE "ADD-TEST-F2-32-4" TO PAR-NAME. NC1774.2 +148400 IF WRK-DU-2V0-2 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +148500 ELSE NC1774.2 +148600 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE ZERO NC1774.2 +148700 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +148800 ADD 1 TO REC-CT. NC1774.2 +148900 ADD-TEST-F2-32-5. NC1774.2 +149000 MOVE "ADD-TEST-F2-32-5" TO PAR-NAME. NC1774.2 +149100 IF WRK-DU-2V1-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +149200 ELSE NC1774.2 +149300 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE ZERO NC1774.2 +149400 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +149500 ADD 1 TO REC-CT. NC1774.2 +149600 ADD-TEST-F2-32-6. NC1774.2 +149700 MOVE "ADD-TEST-F2-32-6" TO PAR-NAME. NC1774.2 +149800 IF WRK-DU-2V0-3 = ZERO PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +149900 ELSE NC1774.2 +150000 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE ZERO NC1774.2 +150100 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +150200 ADD 1 TO REC-CT. NC1774.2 +150300 ADD-TEST-F2-32-7. NC1774.2 +150400 MOVE "ADD-TEST-F2-32-7" TO PAR-NAME. NC1774.2 +150500 IF SIZE-ERR2 = "A" NC1774.2 +150600 PERFORM PASS NC1774.2 +150700 PERFORM PRINT-DETAIL NC1774.2 +150800 ELSE NC1774.2 +150900 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +151000 TO RE-MARK NC1774.2 +151100 MOVE "A" TO CORRECT-X NC1774.2 +151200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +151300 PERFORM FAIL NC1774.2 +151400 PERFORM PRINT-DETAIL. NC1774.2 +151500* NC1774.2 +151600 ADD-INIT-F2-33. NC1774.2 +151700* ==--> NEW SIZE ERROR TESTS <--== NC1774.2 +151800* ==--> NO SIZE ERROR <--== NC1774.2 +151900 MOVE "VI-67 6.4.2" TO ANSI-REFERENCE. NC1774.2 +152000 MOVE 1 TO REC-CT. NC1774.2 +152100 MOVE 1.1 TO WRK-DU-1V1-1. NC1774.2 +152200 MOVE 2.3 TO WRK-DU-1V1-2. NC1774.2 +152300 MOVE ZERO TO WRK-DU-2V0-1. NC1774.2 +152400 MOVE ZERO TO WRK-DU-2V1-1. NC1774.2 +152500 MOVE ZERO TO WRK-DU-2V0-2. NC1774.2 +152600 MOVE ZERO TO WRK-DU-2V1-2. NC1774.2 +152700 MOVE ZERO TO WRK-DU-2V0-3. NC1774.2 +152800 MOVE ZERO TO WRK-DU-2V1-3. NC1774.2 +152900 MOVE SPACE TO SIZE-ERR2. NC1774.2 +153000 ADD-GIVING-TEST-F2-33-0. NC1774.2 +153100 ADD WRK-DU-1V1-1 6 WRK-DU-1V1-2 GIVING WRK-DU-2V1-1 NC1774.2 +153200 WRK-DU-2V0-1 ROUNDED WRK-DU-2V1-2 WRK-DU-2V0-2 ROUNDED NC1774.2 +153300 WRK-DU-2V1-3 WRK-DU-2V0-3 NC1774.2 +153400 ON SIZE ERROR NC1774.2 +153500 MOVE "A" TO SIZE-ERR2 NC1774.2 +153600 NOT ON SIZE ERROR NC1774.2 +153700 MOVE "B" TO SIZE-ERR2. NC1774.2 +153800 GO TO ADD-TEST-F2-33-1. NC1774.2 +153900 ADD-DELETE-F2-33. NC1774.2 +154000 PERFORM DE-LETE. NC1774.2 +154100 PERFORM PRINT-DETAIL. NC1774.2 +154200 GO TO ADD-INIT-F2-34. NC1774.2 +154300 ADD-TEST-F2-33-1. NC1774.2 +154400 MOVE "ADD-TEST-F2-33-1" TO PAR-NAME. NC1774.2 +154500 IF WRK-DU-2V1-1 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +154600 ELSE NC1774.2 +154700 PERFORM FAIL MOVE WRK-DU-2V1-1 TO COMPUTED-N MOVE 9.4 NC1774.2 +154800 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +154900 ADD 1 TO REC-CT. NC1774.2 +155000 ADD-TEST-F2-33-2. NC1774.2 +155100 MOVE "ADD-TEST-F2-33-2" TO PAR-NAME. NC1774.2 +155200 IF WRK-DU-2V0-1 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +155300 ELSE NC1774.2 +155400 PERFORM FAIL MOVE WRK-DU-2V0-1 TO COMPUTED-N MOVE 9 NC1774.2 +155500 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +155600 ADD 1 TO REC-CT. NC1774.2 +155700 ADD-ADD-TEST-F2-33-3. NC1774.2 +155800 MOVE "ADD-TEST-F2-33-3" TO PAR-NAME. NC1774.2 +155900 IF WRK-DU-2V1-2 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +156000 ELSE NC1774.2 +156100 PERFORM FAIL MOVE WRK-DU-2V1-2 TO COMPUTED-N MOVE 9.4 NC1774.2 +156200 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +156300 ADD 1 TO REC-CT. NC1774.2 +156400 ADD-TEST-F2-33-4. NC1774.2 +156500 MOVE "ADD-TEST-F2-33-4" TO PAR-NAME. NC1774.2 +156600 IF WRK-DU-2V0-2 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +156700 ELSE NC1774.2 +156800 PERFORM FAIL MOVE WRK-DU-2V0-2 TO COMPUTED-N MOVE 9 NC1774.2 +156900 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +157000 ADD 1 TO REC-CT. NC1774.2 +157100 ADD-TEST-F2-33-5. NC1774.2 +157200 MOVE "ADD-TEST-F2-33-5" TO PAR-NAME. NC1774.2 +157300 IF WRK-DU-2V1-3 = 9.4 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +157400 ELSE NC1774.2 +157500 PERFORM FAIL MOVE WRK-DU-2V1-3 TO COMPUTED-N MOVE 9.4 NC1774.2 +157600 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +157700 ADD 1 TO REC-CT. NC1774.2 +157800 ADD-TEST-F2-33-6. NC1774.2 +157900 MOVE "ADD-TEST-F2-33-6" TO PAR-NAME. NC1774.2 +158000 IF WRK-DU-2V0-3 = 9 PERFORM PASS PERFORM PRINT-DETAIL NC1774.2 +158100 ELSE NC1774.2 +158200 PERFORM FAIL MOVE WRK-DU-2V0-3 TO COMPUTED-N MOVE 9 NC1774.2 +158300 TO CORRECT-N PERFORM PRINT-DETAIL. NC1774.2 +158400 ADD 1 TO REC-CT. NC1774.2 +158500 ADD-TEST-F2-33-7. NC1774.2 +158600 MOVE "ADD-TEST-F2-33-7" TO PAR-NAME. NC1774.2 +158700 IF SIZE-ERR2 = "B" NC1774.2 +158800 PERFORM PASS NC1774.2 +158900 PERFORM PRINT-DETAIL NC1774.2 +159000 ELSE NC1774.2 +159100 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +159200 TO RE-MARK NC1774.2 +159300 MOVE "B" TO CORRECT-X NC1774.2 +159400 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +159500 PERFORM FAIL NC1774.2 +159600 PERFORM PRINT-DETAIL. NC1774.2 +159700* NC1774.2 +159800 ADD-INIT-F2-34. NC1774.2 +159900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +160000* ==--> SIZE ERROR <--== NC1774.2 +160100 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +160200 MOVE "ADD-TEST-F2-34" TO PAR-NAME. NC1774.2 +160300 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +160400 MOVE 1 TO REC-CT. NC1774.2 +160500 MOVE SPACE TO WRK-XN-00001. NC1774.2 +160600 MOVE SPACE TO SIZE-ERR2. NC1774.2 +160700 MOVE SPACE TO SIZE-ERR3. NC1774.2 +160800 MOVE SPACE TO SIZE-ERR4. NC1774.2 +160900 ADD-TEST-F2-34-0. NC1774.2 +161000 ADD A12ONES-DS-12V00 NC1774.2 +161100 ZERO NC1774.2 +161200 GIVING WRK-DS-10V00 NC1774.2 +161300 ON SIZE ERROR NC1774.2 +161400 MOVE "A" TO SIZE-ERR2 NC1774.2 +161500 MOVE "B" TO SIZE-ERR3 NC1774.2 +161600 MOVE "C" TO SIZE-ERR4 NC1774.2 +161700 END-ADD NC1774.2 +161800 MOVE "1" TO WRK-XN-00001. NC1774.2 +161900 GO TO ADD-TEST-F2-34-1. NC1774.2 +162000 ADD-DELETE-F2-34. NC1774.2 +162100 PERFORM DE-LETE. NC1774.2 +162200 PERFORM PRINT-DETAIL. NC1774.2 +162300 GO TO ADD-INIT-F2-35. NC1774.2 +162400 ADD-TEST-F2-34-1. NC1774.2 +162500 MOVE "ADD-TEST-F2-34-1" TO PAR-NAME. NC1774.2 +162600 IF SIZE-ERR2 = "A" NC1774.2 +162700 PERFORM PASS NC1774.2 +162800 PERFORM PRINT-DETAIL NC1774.2 +162900 ELSE NC1774.2 +163000 MOVE "A" TO CORRECT-X NC1774.2 +163100 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +163200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +163300 TO RE-MARK NC1774.2 +163400 PERFORM FAIL NC1774.2 +163500 PERFORM PRINT-DETAIL. NC1774.2 +163600 ADD 1 TO REC-CT. NC1774.2 +163700 ADD-TEST-F2-34-2. NC1774.2 +163800 MOVE "ADD-TEST-F2-34-2" TO PAR-NAME. NC1774.2 +163900 IF SIZE-ERR3 = "B" NC1774.2 +164000 PERFORM PASS NC1774.2 +164100 PERFORM PRINT-DETAIL NC1774.2 +164200 ELSE NC1774.2 +164300 MOVE "B" TO CORRECT-X NC1774.2 +164400 MOVE SIZE-ERR3 TO COMPUTED-X NC1774.2 +164500 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +164600 TO RE-MARK NC1774.2 +164700 PERFORM FAIL NC1774.2 +164800 PERFORM PRINT-DETAIL. NC1774.2 +164900 ADD 1 TO REC-CT. NC1774.2 +165000 ADD-TEST-F2-34-3. NC1774.2 +165100 MOVE "ADD-TEST-F2-34-3" TO PAR-NAME. NC1774.2 +165200 IF SIZE-ERR4 = "C" NC1774.2 +165300 PERFORM PASS NC1774.2 +165400 PERFORM PRINT-DETAIL NC1774.2 +165500 ELSE NC1774.2 +165600 MOVE "C" TO CORRECT-X NC1774.2 +165700 MOVE SIZE-ERR4 TO COMPUTED-X NC1774.2 +165800 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +165900 TO RE-MARK NC1774.2 +166000 PERFORM FAIL NC1774.2 +166100 PERFORM PRINT-DETAIL. NC1774.2 +166200 ADD 1 TO REC-CT. NC1774.2 +166300 ADD-TEST-F2-34-4. NC1774.2 +166400 MOVE "ADD-TEST-F2-34-4" TO PAR-NAME. NC1774.2 +166500 IF WRK-XN-00001 = "1" NC1774.2 +166600 PERFORM PASS NC1774.2 +166700 PERFORM PRINT-DETAIL NC1774.2 +166800 ELSE NC1774.2 +166900 MOVE "1" TO CORRECT-X NC1774.2 +167000 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +167100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +167200 PERFORM FAIL NC1774.2 +167300 PERFORM PRINT-DETAIL. NC1774.2 +167400 ADD 1 TO REC-CT. NC1774.2 +167500 ADD-TEST-F2-34-5. NC1774.2 +167600 MOVE "ADD-TEST-F2-34-5" TO PAR-NAME. NC1774.2 +167700 IF WRK-DS-10V00 = ZERO NC1774.2 +167800 PERFORM PASS NC1774.2 +167900 PERFORM PRINT-DETAIL NC1774.2 +168000 ELSE NC1774.2 +168100 MOVE ZERO TO CORRECT-N NC1774.2 +168200 MOVE WRK-DS-10V00 TO COMPUTED-N NC1774.2 +168300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +168400 TO RE-MARK NC1774.2 +168500 PERFORM FAIL NC1774.2 +168600 PERFORM PRINT-DETAIL. NC1774.2 +168700* NC1774.2 +168800 ADD-INIT-F2-35. NC1774.2 +168900* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +169000* ==--> NO SIZE ERROR <--== NC1774.2 +169100 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +169200 MOVE "ADD-TEST-F2-35" TO PAR-NAME. NC1774.2 +169300 MOVE 1 TO REC-CT. NC1774.2 +169400 MOVE SPACE TO WRK-XN-00001. NC1774.2 +169500 MOVE SPACE TO SIZE-ERR2. NC1774.2 +169600 MOVE SPACE TO SIZE-ERR3. NC1774.2 +169700 MOVE SPACE TO SIZE-ERR4. NC1774.2 +169800 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +169900 ADD-TEST-F2-35-0. NC1774.2 +170000 ADD A12THREES-DS-06V06 NC1774.2 +170100 333333 NC1774.2 +170200 A06THREES-DS-03V03 NC1774.2 +170300 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +170400 ON SIZE ERROR NC1774.2 +170500 MOVE "A" TO SIZE-ERR2 NC1774.2 +170600 MOVE "B" TO SIZE-ERR3 NC1774.2 +170700 MOVE "C" TO SIZE-ERR4 NC1774.2 +170800 END-ADD NC1774.2 +170900 MOVE "1" TO WRK-XN-00001. NC1774.2 +171000 GO TO ADD-TEST-F2-35-1. NC1774.2 +171100 ADD-DELETE-F2-35. NC1774.2 +171200 PERFORM DE-LETE. NC1774.2 +171300 PERFORM PRINT-DETAIL. NC1774.2 +171400 GO TO ADD-INIT-F2-36. NC1774.2 +171500 ADD-TEST-F2-35-1. NC1774.2 +171600 MOVE "ADD-TEST-F2-35-1" TO PAR-NAME. NC1774.2 +171700 IF SIZE-ERR2 = SPACE NC1774.2 +171800 PERFORM PASS NC1774.2 +171900 PERFORM PRINT-DETAIL NC1774.2 +172000 ELSE NC1774.2 +172100 MOVE SPACE TO CORRECT-X NC1774.2 +172200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +172300 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +172400 TO RE-MARK NC1774.2 +172500 PERFORM FAIL NC1774.2 +172600 PERFORM PRINT-DETAIL. NC1774.2 +172700 ADD 1 TO REC-CT. NC1774.2 +172800 ADD-TEST-F2-35-2. NC1774.2 +172900 MOVE "ADD-TEST-F2-35-2" TO PAR-NAME. NC1774.2 +173000 IF SIZE-ERR3 = SPACE NC1774.2 +173100 PERFORM PASS NC1774.2 +173200 PERFORM PRINT-DETAIL NC1774.2 +173300 ELSE NC1774.2 +173400 MOVE SPACE TO CORRECT-X NC1774.2 +173500 MOVE SIZE-ERR3 TO COMPUTED-X NC1774.2 +173600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +173700 TO RE-MARK NC1774.2 +173800 PERFORM FAIL NC1774.2 +173900 PERFORM PRINT-DETAIL. NC1774.2 +174000 ADD 1 TO REC-CT. NC1774.2 +174100 ADD-TEST-F2-35-3. NC1774.2 +174200 MOVE "ADD-TEST-F2-35-3" TO PAR-NAME. NC1774.2 +174300 IF SIZE-ERR4 = SPACE NC1774.2 +174400 PERFORM PASS NC1774.2 +174500 PERFORM PRINT-DETAIL NC1774.2 +174600 ELSE NC1774.2 +174700 MOVE "C" TO CORRECT-X NC1774.2 +174800 MOVE SIZE-ERR4 TO COMPUTED-X NC1774.2 +174900 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +175000 TO RE-MARK NC1774.2 +175100 PERFORM FAIL NC1774.2 +175200 PERFORM PRINT-DETAIL. NC1774.2 +175300 ADD 1 TO REC-CT. NC1774.2 +175400 ADD-TEST-F2-35-4. NC1774.2 +175500 MOVE "ADD-TEST-F2-35-4" TO PAR-NAME. NC1774.2 +175600 IF WRK-XN-00001 = "1" NC1774.2 +175700 PERFORM PASS NC1774.2 +175800 PERFORM PRINT-DETAIL NC1774.2 +175900 ELSE NC1774.2 +176000 MOVE "1" TO CORRECT-X NC1774.2 +176100 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +176200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +176300 PERFORM FAIL NC1774.2 +176400 PERFORM PRINT-DETAIL NC1774.2 +176500 ADD 1 TO REC-CT. NC1774.2 +176600 ADD-TEST-F2-35-5. NC1774.2 +176700 MOVE "ADD-TEST-F2-35-5" TO PAR-NAME. NC1774.2 +176800 IF WRK-DS-06V06 = 666999.666333 NC1774.2 +176900 PERFORM PASS NC1774.2 +177000 PERFORM PRINT-DETAIL NC1774.2 +177100 ELSE NC1774.2 +177200 MOVE 666999.666333 TO CORRECT-N NC1774.2 +177300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1774.2 +177400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +177500 TO RE-MARK NC1774.2 +177600 PERFORM FAIL NC1774.2 +177700 PERFORM PRINT-DETAIL. NC1774.2 +177800* NC1774.2 +177900 ADD-INIT-F2-36. NC1774.2 +178000* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +178100* ==--> SIZE ERROR <--== NC1774.2 +178200 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +178300 MOVE "ADD-TEST-F2-36" TO PAR-NAME. NC1774.2 +178400 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +178500 MOVE 1 TO REC-CT. NC1774.2 +178600 MOVE SPACE TO WRK-XN-00001. NC1774.2 +178700 MOVE SPACE TO SIZE-ERR2. NC1774.2 +178800 MOVE SPACE TO SIZE-ERR3. NC1774.2 +178900 MOVE SPACE TO SIZE-ERR4. NC1774.2 +179000 ADD-TEST-F2-36-0. NC1774.2 +179100 ADD A12ONES-DS-12V00 NC1774.2 +179200 ZERO NC1774.2 +179300 GIVING WRK-DS-10V00 NC1774.2 +179400 NOT ON SIZE ERROR NC1774.2 +179500 MOVE "A" TO SIZE-ERR2 NC1774.2 +179600 MOVE "B" TO SIZE-ERR3 NC1774.2 +179700 MOVE "C" TO SIZE-ERR4 NC1774.2 +179800 END-ADD NC1774.2 +179900 MOVE "1" TO WRK-XN-00001. NC1774.2 +180000 GO TO ADD-TEST-F2-36-1. NC1774.2 +180100 ADD-DELETE-F2-36. NC1774.2 +180200 PERFORM DE-LETE. NC1774.2 +180300 PERFORM PRINT-DETAIL. NC1774.2 +180400 GO TO ADD-INIT-F2-37. NC1774.2 +180500 ADD-TEST-F2-36-1. NC1774.2 +180600 MOVE "ADD-TEST-F2-36-1" TO PAR-NAME. NC1774.2 +180700 IF SIZE-ERR2 = SPACE NC1774.2 +180800 PERFORM PASS NC1774.2 +180900 PERFORM PRINT-DETAIL NC1774.2 +181000 ELSE NC1774.2 +181100 MOVE SPACE TO CORRECT-X NC1774.2 +181200 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +181300 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +181400 TO RE-MARK NC1774.2 +181500 PERFORM FAIL NC1774.2 +181600 PERFORM PRINT-DETAIL. NC1774.2 +181700 ADD 1 TO REC-CT. NC1774.2 +181800 ADD-TEST-F2-36-2. NC1774.2 +181900 MOVE "ADD-TEST-F2-36-2" TO PAR-NAME. NC1774.2 +182000 IF SIZE-ERR3 = SPACE NC1774.2 +182100 PERFORM PASS NC1774.2 +182200 PERFORM PRINT-DETAIL NC1774.2 +182300 ELSE NC1774.2 +182400 MOVE SPACE TO CORRECT-X NC1774.2 +182500 MOVE SIZE-ERR3 TO COMPUTED-X NC1774.2 +182600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +182700 TO RE-MARK NC1774.2 +182800 PERFORM FAIL NC1774.2 +182900 PERFORM PRINT-DETAIL. NC1774.2 +183000 ADD 1 TO REC-CT. NC1774.2 +183100 ADD-TEST-F2-36-3. NC1774.2 +183200 MOVE "ADD-TEST-F2-36-3" TO PAR-NAME. NC1774.2 +183300 IF SIZE-ERR4 = SPACE NC1774.2 +183400 PERFORM PASS NC1774.2 +183500 PERFORM PRINT-DETAIL NC1774.2 +183600 ELSE NC1774.2 +183700 MOVE SPACE TO CORRECT-X NC1774.2 +183800 MOVE SIZE-ERR4 TO COMPUTED-X NC1774.2 +183900 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC1774.2 +184000 TO RE-MARK NC1774.2 +184100 PERFORM FAIL NC1774.2 +184200 PERFORM PRINT-DETAIL. NC1774.2 +184300 ADD 1 TO REC-CT. NC1774.2 +184400 ADD-TEST-F2-36-4. NC1774.2 +184500 MOVE "ADD-TEST-F2-36-4" TO PAR-NAME. NC1774.2 +184600 IF WRK-XN-00001 = "1" NC1774.2 +184700 PERFORM PASS NC1774.2 +184800 PERFORM PRINT-DETAIL NC1774.2 +184900 ELSE NC1774.2 +185000 MOVE "1" TO CORRECT-X NC1774.2 +185100 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +185200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +185300 PERFORM FAIL NC1774.2 +185400 PERFORM PRINT-DETAIL. NC1774.2 +185500 ADD 1 TO REC-CT. NC1774.2 +185600 ADD-TEST-F2-36-5. NC1774.2 +185700 MOVE "ADD-TEST-F2-36-5" TO PAR-NAME. NC1774.2 +185800 IF WRK-DS-10V00 = ZERO NC1774.2 +185900 PERFORM PASS NC1774.2 +186000 PERFORM PRINT-DETAIL NC1774.2 +186100 ELSE NC1774.2 +186200 MOVE ZERO TO CORRECT-N NC1774.2 +186300 MOVE WRK-DS-10V00 TO COMPUTED-N NC1774.2 +186400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +186500 TO RE-MARK NC1774.2 +186600 PERFORM FAIL NC1774.2 +186700 PERFORM PRINT-DETAIL. NC1774.2 +186800* NC1774.2 +186900 ADD-INIT-F2-37. NC1774.2 +187000* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +187100* ==--> NO SIZE ERROR <--== NC1774.2 +187200 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +187300 MOVE "ADD-TEST-F2-37" TO PAR-NAME. NC1774.2 +187400 MOVE 1 TO REC-CT. NC1774.2 +187500 MOVE SPACE TO WRK-XN-00001. NC1774.2 +187600 MOVE SPACE TO SIZE-ERR2. NC1774.2 +187700 MOVE SPACE TO SIZE-ERR3. NC1774.2 +187800 MOVE SPACE TO SIZE-ERR4. NC1774.2 +187900 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +188000 ADD-TEST-F2-37-0. NC1774.2 +188100 ADD A12THREES-DS-06V06 NC1774.2 +188200 333333 NC1774.2 +188300 A06THREES-DS-03V03 NC1774.2 +188400 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +188500 NOT ON SIZE ERROR NC1774.2 +188600 MOVE "A" TO SIZE-ERR2 NC1774.2 +188700 MOVE "B" TO SIZE-ERR3 NC1774.2 +188800 MOVE "C" TO SIZE-ERR4 NC1774.2 +188900 END-ADD NC1774.2 +189000 MOVE "1" TO WRK-XN-00001. NC1774.2 +189100 GO TO ADD-TEST-F2-37-1. NC1774.2 +189200 ADD-DELETE-F2-37. NC1774.2 +189300 PERFORM DE-LETE. NC1774.2 +189400 PERFORM PRINT-DETAIL. NC1774.2 +189500 GO TO ADD-INIT-F2-38. NC1774.2 +189600 ADD-TEST-F2-37-1. NC1774.2 +189700 MOVE "ADD-TEST-F2-37-1" TO PAR-NAME. NC1774.2 +189800 IF SIZE-ERR2 = "A" NC1774.2 +189900 PERFORM PASS NC1774.2 +190000 PERFORM PRINT-DETAIL NC1774.2 +190100 ELSE NC1774.2 +190200 MOVE "A" TO CORRECT-X NC1774.2 +190300 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +190400 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +190500 TO RE-MARK NC1774.2 +190600 PERFORM FAIL NC1774.2 +190700 PERFORM PRINT-DETAIL. NC1774.2 +190800 ADD 1 TO REC-CT. NC1774.2 +190900 ADD-TEST-F2-37-2. NC1774.2 +191000 MOVE "ADD-TEST-F2-37-2" TO PAR-NAME. NC1774.2 +191100 IF SIZE-ERR3 = "B" NC1774.2 +191200 PERFORM PASS NC1774.2 +191300 PERFORM PRINT-DETAIL NC1774.2 +191400 ELSE NC1774.2 +191500 MOVE "B" TO CORRECT-X NC1774.2 +191600 MOVE SIZE-ERR3 TO COMPUTED-X NC1774.2 +191700 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +191800 TO RE-MARK NC1774.2 +191900 PERFORM FAIL NC1774.2 +192000 PERFORM PRINT-DETAIL. NC1774.2 +192100 ADD 1 TO REC-CT. NC1774.2 +192200 ADD-TEST-F2-37-3. NC1774.2 +192300 MOVE "ADD-TEST-F2-37-3" TO PAR-NAME NC1774.2 +192400 IF SIZE-ERR4 = "C" NC1774.2 +192500 PERFORM PASS NC1774.2 +192600 PERFORM PRINT-DETAIL NC1774.2 +192700 ELSE NC1774.2 +192800 MOVE "C" TO CORRECT-X NC1774.2 +192900 MOVE SIZE-ERR4 TO COMPUTED-X NC1774.2 +193000 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +193100 TO RE-MARK NC1774.2 +193200 PERFORM FAIL NC1774.2 +193300 PERFORM PRINT-DETAIL. NC1774.2 +193400 ADD 1 TO REC-CT. NC1774.2 +193500 ADD-TEST-F2-37-4. NC1774.2 +193600 MOVE "ADD-TEST-F2-37-4" TO PAR-NAME. NC1774.2 +193700 IF WRK-XN-00001 = "1" NC1774.2 +193800 PERFORM PASS NC1774.2 +193900 PERFORM PRINT-DETAIL NC1774.2 +194000 ELSE NC1774.2 +194100 MOVE "1" TO CORRECT-X NC1774.2 +194200 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +194300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +194400 PERFORM FAIL NC1774.2 +194500 PERFORM PRINT-DETAIL. NC1774.2 +194600 ADD 1 TO REC-CT. NC1774.2 +194700 ADD-TEST-F2-37-5. NC1774.2 +194800 MOVE "ADD-TEST-F2-37-5" TO PAR-NAME. NC1774.2 +194900 IF WRK-DS-06V06 = 666999.666333 NC1774.2 +195000 PERFORM PASS NC1774.2 +195100 PERFORM PRINT-DETAIL NC1774.2 +195200 ELSE NC1774.2 +195300 MOVE 666999.666333 TO CORRECT-N NC1774.2 +195400 MOVE WRK-DS-06V06 TO COMPUTED-N NC1774.2 +195500 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +195600 TO RE-MARK NC1774.2 +195700 PERFORM FAIL NC1774.2 +195800 PERFORM PRINT-DETAIL. NC1774.2 +195900* NC1774.2 +196000 ADD-INIT-F2-38. NC1774.2 +196100* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +196200* ==--> SIZE ERROR <--== NC1774.2 +196300 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +196400 MOVE "ADD-TEST-F2-38" TO PAR-NAME. NC1774.2 +196500 MOVE ZERO TO WRK-DS-10V00. NC1774.2 +196600 MOVE 1 TO REC-CT. NC1774.2 +196700 MOVE SPACE TO WRK-XN-00001. NC1774.2 +196800 MOVE SPACE TO SIZE-ERR2. NC1774.2 +196900 MOVE SPACE TO SIZE-ERR3. NC1774.2 +197000 MOVE SPACE TO SIZE-ERR4. NC1774.2 +197100 ADD-TEST-F2-38-0. NC1774.2 +197200 ADD A12ONES-DS-12V00 NC1774.2 +197300 ZERO NC1774.2 +197400 GIVING WRK-DS-10V00 NC1774.2 +197500 ON SIZE ERROR NC1774.2 +197600 MOVE "A" TO SIZE-ERR2 NC1774.2 +197700 NOT ON SIZE ERROR NC1774.2 +197800 MOVE "X" TO SIZE-ERR2 NC1774.2 +197900 END-ADD NC1774.2 +198000 MOVE "1" TO WRK-XN-00001. NC1774.2 +198100 GO TO ADD-TEST-F2-38-1. NC1774.2 +198200 ADD-DELETE-F2-38. NC1774.2 +198300 PERFORM DE-LETE. NC1774.2 +198400 PERFORM PRINT-DETAIL. NC1774.2 +198500 GO TO ADD-INIT-F2-39. NC1774.2 +198600 ADD-TEST-F2-38-1. NC1774.2 +198700 MOVE "ADD-TEST-F2-38-1" TO PAR-NAME. NC1774.2 +198800 IF SIZE-ERR2 = "A" NC1774.2 +198900 PERFORM PASS NC1774.2 +199000 PERFORM PRINT-DETAIL NC1774.2 +199100 ELSE NC1774.2 +199200 MOVE "A" TO CORRECT-X NC1774.2 +199300 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +199400 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +199500 TO RE-MARK NC1774.2 +199600 PERFORM FAIL NC1774.2 +199700 PERFORM PRINT-DETAIL. NC1774.2 +199800 ADD 1 TO REC-CT. NC1774.2 +199900 ADD-TEST-F2-38-2. NC1774.2 +200000 MOVE "ADD-TEST-F2-38-2" TO PAR-NAME. NC1774.2 +200100 IF WRK-XN-00001 = "1" NC1774.2 +200200 PERFORM PASS NC1774.2 +200300 PERFORM PRINT-DETAIL NC1774.2 +200400 ELSE NC1774.2 +200500 MOVE "1" TO CORRECT-X NC1774.2 +200600 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +200700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +200800 PERFORM FAIL NC1774.2 +200900 PERFORM PRINT-DETAIL. NC1774.2 +201000 ADD 1 TO REC-CT. NC1774.2 +201100 ADD-TEST-F2-38-3. NC1774.2 +201200 MOVE "ADD-TEST-F2-38-3" TO PAR-NAME. NC1774.2 +201300 IF WRK-DS-10V00 = ZERO NC1774.2 +201400 PERFORM PASS NC1774.2 +201500 PERFORM PRINT-DETAIL NC1774.2 +201600 ELSE NC1774.2 +201700 MOVE ZERO TO CORRECT-N NC1774.2 +201800 MOVE WRK-DS-10V00 TO COMPUTED-N NC1774.2 +201900 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +202000 TO RE-MARK NC1774.2 +202100 PERFORM FAIL NC1774.2 +202200 PERFORM PRINT-DETAIL. NC1774.2 +202300* NC1774.2 +202400 ADD-INIT-F2-39. NC1774.2 +202500* ==-->EXPLICIT SCOPE TERMINATOR<--== NC1774.2 +202600* ==--> NO SIZE ERROR <--== NC1774.2 +202700 MOVE "VI-67 6.4.3" TO ANSI-REFERENCE. NC1774.2 +202800 MOVE "ADD-TEST-F2-39" TO PAR-NAME. NC1774.2 +202900 MOVE 1 TO REC-CT. NC1774.2 +203000 MOVE SPACE TO WRK-XN-00001. NC1774.2 +203100 MOVE SPACE TO SIZE-ERR2. NC1774.2 +203200 MOVE SPACE TO SIZE-ERR3. NC1774.2 +203300 MOVE SPACE TO SIZE-ERR4. NC1774.2 +203400 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +203500 ADD-TEST-F2-39-0. NC1774.2 +203600 ADD A12THREES-DS-06V06 NC1774.2 +203700 333333 NC1774.2 +203800 A06THREES-DS-03V03 NC1774.2 +203900 GIVING WRK-DS-06V06 ROUNDED NC1774.2 +204000 ON SIZE ERROR NC1774.2 +204100 MOVE "1" TO SIZE-ERR2 NC1774.2 +204200 NOT ON SIZE ERROR NC1774.2 +204300 MOVE "A" TO SIZE-ERR2 NC1774.2 +204400 END-ADD NC1774.2 +204500 MOVE "1" TO WRK-XN-00001. NC1774.2 +204600 GO TO ADD-TEST-F2-39-1. NC1774.2 +204700 ADD-DELETE-F2-39. NC1774.2 +204800 PERFORM DE-LETE. NC1774.2 +204900 PERFORM PRINT-DETAIL. NC1774.2 +205000 GO TO ADD-INIT-F2-40. NC1774.2 +205100 ADD-TEST-F2-39-1. NC1774.2 +205200 MOVE "ADD-TEST-F2-39-1" TO PAR-NAME. NC1774.2 +205300 IF SIZE-ERR2 = "A" NC1774.2 +205400 PERFORM PASS NC1774.2 +205500 PERFORM PRINT-DETAIL NC1774.2 +205600 ELSE NC1774.2 +205700 MOVE "A" TO CORRECT-X NC1774.2 +205800 MOVE SIZE-ERR2 TO COMPUTED-X NC1774.2 +205900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC1774.2 +206000 TO RE-MARK NC1774.2 +206100 PERFORM FAIL NC1774.2 +206200 PERFORM PRINT-DETAIL. NC1774.2 +206300 ADD 1 TO REC-CT. NC1774.2 +206400 ADD-TEST-F2-39-2. NC1774.2 +206500 MOVE "ADD-TEST-F2-39-2" TO PAR-NAME. NC1774.2 +206600 IF WRK-XN-00001 = "1" NC1774.2 +206700 PERFORM PASS NC1774.2 +206800 PERFORM PRINT-DETAIL NC1774.2 +206900 ELSE NC1774.2 +207000 MOVE "1" TO CORRECT-X NC1774.2 +207100 MOVE WRK-XN-00001 TO COMPUTED-X NC1774.2 +207200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC1774.2 +207300 PERFORM FAIL NC1774.2 +207400 PERFORM PRINT-DETAIL. NC1774.2 +207500 ADD 1 TO REC-CT. NC1774.2 +207600 ADD-TEST-F2-39-3. NC1774.2 +207700 MOVE "ADD-TEST-F2-39-3" TO PAR-NAME. NC1774.2 +207800 IF WRK-DS-06V06 = 666999.666333 NC1774.2 +207900 PERFORM PASS NC1774.2 +208000 PERFORM PRINT-DETAIL NC1774.2 +208100 ELSE NC1774.2 +208200 MOVE 666999.666333 TO CORRECT-N NC1774.2 +208300 MOVE WRK-DS-06V06 TO COMPUTED-N NC1774.2 +208400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" NC1774.2 +208500 TO RE-MARK NC1774.2 +208600 PERFORM FAIL NC1774.2 +208700 PERFORM PRINT-DETAIL. NC1774.2 +208800* NC1774.2 +208900 ADD-INIT-F2-40. NC1774.2 +209000 MOVE "VI-73 6.6.2" TO ANSI-REFERENCE. NC1774.2 +209100* ==--> OPTIONAL WORD "TO" <--== NC1774.2 +209200 MOVE ZERO TO WRK-DS-09V09. NC1774.2 +209300 ADD-TEST-F2-40-0. NC1774.2 +209400 ADD A06THREES-DS-03V03 NC1774.2 +209500 TO A12THREES-DS-06V06 GIVING WRK-DS-09V09. NC1774.2 +209600 ADD-TEST-F2-40-1. NC1774.2 +209700 IF WRK-DS-09V09 EQUAL TO 000333666.666333000 NC1774.2 +209800 PERFORM PASS GO TO ADD-WRITE-F2-40. NC1774.2 +209900 GO TO ADD-FAIL-F2-40. NC1774.2 +210000 ADD-DELETE-F2-40. NC1774.2 +210100 PERFORM DE-LETE. NC1774.2 +210200 GO TO ADD-WRITE-F2-40. NC1774.2 +210300 ADD-FAIL-F2-40. NC1774.2 +210400 MOVE WRK-DS-09V09 TO COMPUTED-N. NC1774.2 +210500 MOVE 000333666.666333000 TO CORRECT-N. NC1774.2 +210600 PERFORM FAIL. NC1774.2 +210700 ADD-WRITE-F2-40. NC1774.2 +210800 MOVE "ADD-TEST-F2-40" TO PAR-NAME. NC1774.2 +210900 PERFORM PRINT-DETAIL. NC1774.2 +211000* NC1774.2 +211100 ADD-INIT-F2-41. NC1774.2 +211200 MOVE "VI-73 6.6.2" TO ANSI-REFERENCE. NC1774.2 +211300* ==--> OPTIONAL WORD "TO" <--== NC1774.2 +211400 MOVE ZERO TO WRK-DS-06V06. NC1774.2 +211500 ADD-TEST-F2-41-0. NC1774.2 +211600 ADD A05ONES-DS-05V00 NC1774.2 +211700 A05ONES-DS-00V05 NC1774.2 +211800 A12THREES-DS-06V06 NC1774.2 +211900 TO A06THREES-DS-03V03 GIVING WRK-DS-06V06. NC1774.2 +212000 ADD-TEST-F2-41-1. NC1774.2 +212100 IF WRK-DS-06V06 EQUAL TO 344777.777443 NC1774.2 +212200 PERFORM PASS GO TO ADD-WRITE-F2-41. NC1774.2 +212300 GO TO ADD-FAIL-F2-41. NC1774.2 +212400 ADD-DELETE-F2-41. NC1774.2 +212500 PERFORM DE-LETE. NC1774.2 +212600 GO TO ADD-WRITE-F2-41. NC1774.2 +212700 ADD-FAIL-F2-41. NC1774.2 +212800 MOVE WRK-DS-06V06 TO COMPUTED-N. NC1774.2 +212900 MOVE 344777.777443 TO CORRECT-N. NC1774.2 +213000 PERFORM FAIL. NC1774.2 +213100 ADD-WRITE-F2-41. NC1774.2 +213200 MOVE "ADD-TEST-F2-41" TO PAR-NAME. NC1774.2 +213300 PERFORM PRINT-DETAIL. NC1774.2 +213400* NC1774.2 +213500 CCVS-EXIT SECTION. NC1774.2 +213600 CCVS-999999. NC1774.2 +213700 GO TO CLOSE-FILES. NC1774.2 diff --git a/tests/cobol85/NC/NC201A.CBL b/tests/cobol85/NC/NC201A.CBL new file mode 100755 index 00000000..aeace190 --- /dev/null +++ b/tests/cobol85/NC/NC201A.CBL @@ -0,0 +1,2120 @@ +000100 IDENTIFICATION DIVISION. NC2014.2 +000200 PROGRAM-ID. NC2014.2 +000300 NC201A. NC2014.2 +000400**************************************************************** NC2014.2 +000500* * NC2014.2 +000600* VALIDATION FOR:- * NC2014.2 +000700* * NC2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2014.2 +000900* * NC2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2014.2 +001100* * NC2014.2 +001200**************************************************************** NC2014.2 +001300* * NC2014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2014.2 +001500* * NC2014.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2014.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2014.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2014.2 +001900* * NC2014.2 +002000**************************************************************** NC2014.2 +002100* PROGRAM NC201A TESTS FORMAT 3 AND 4 OF THE "PERFORM" NC2014.2 +002200* STATEMENT. NC2014.2 +002300* A VARIETY OF QUALIFIED DATA-NAMES AND CONDITION-NAMES NC2014.2 +002400* ARE USED. NC2014.2 +002500* NC2014.2 +002600* NC2014.2 +002700 NC2014.2 +002800 ENVIRONMENT DIVISION. NC2014.2 +002900 CONFIGURATION SECTION. NC2014.2 +003000 SOURCE-COMPUTER. NC2014.2 +003100 Linux. NC2014.2 +003200 OBJECT-COMPUTER. NC2014.2 +003300 Linux. NC2014.2 +003400 INPUT-OUTPUT SECTION. NC2014.2 +003500 FILE-CONTROL. NC2014.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2014.2 +003700 "report.log". NC2014.2 +003800 DATA DIVISION. NC2014.2 +003900 FILE SECTION. NC2014.2 +004000 FD PRINT-FILE. NC2014.2 +004100 01 PRINT-REC PICTURE X(120). NC2014.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2014.2 +004300 WORKING-STORAGE SECTION. NC2014.2 +004400 01 WRK-DU-2V1-1 PIC 99V9 VALUE ZERO. NC2014.2 +004500 01 WRK-DU-0V1-1 PIC V9 VALUE .1. NC2014.2 +004600 01 WRK-DU-2V1-2 PIC 99V9 VALUE 0.1. NC2014.2 +004700 01 WRK-DU-2V1-3 PIC 99V9 VALUE 11.1. NC2014.2 +004800 01 WRK-DU-1V0-1 PIC 9 VALUE 1. NC2014.2 +004900 01 WRK-DU-1V0-2 PIC 9 VALUE 2. NC2014.2 +005000 01 WRK-DU-1V0-3 PIC 9 VALUE 3. NC2014.2 +005100 01 WRK-DU-1V0-4 PIC 9 VALUE ZERO. NC2014.2 +005200 01 WRK-DU-2V0-1 PIC 99 VALUE 10. NC2014.2 +005300 01 WRK-DU-2V0-2 PIC 99 VALUE 11. NC2014.2 +005400 01 WRK-DU-2V0-3 PIC 99 VALUE 12. NC2014.2 +005500 01 COUNT-DU-6V0 PIC 9(6). NC2014.2 +005600 77 SMALL-VALU PICTURE 99 VALUE 7. NC2014.2 +005700 77 SMALLER-VALU PICTURE 99 VALUE 6. NC2014.2 +005800 77 SMALLEST-VALU PICTURE 99 VALUE 5. NC2014.2 +005900 77 EVEN-SMALLER PICTURE 99 VALUE 1. NC2014.2 +006000 77 WRK-DS-02V00 PICTURE S99. NC2014.2 +006100 88 TEST-2NUC-COND-99 VALUE 99. NC2014.2 +006200 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2014.2 +006300 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC2014.2 +006400 PICTURE S9(12). NC2014.2 +006500 77 A02TWOS-DS-02V00 PICTURE S99 VALUE 22. NC2014.2 +006600 77 WRK-DS-01V00 PICTURE S9. NC2014.2 +006700 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2014.2 +006800 77 A990-DS-0201P PICTURE S99P VALUE 990. NC2014.2 +006900 77 A02ONES-DS-02V00 PICTURE S99 VALUE 11. NC2014.2 +007000 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001.NC2014.2 +007100 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2014.2 +007200 77 WRK-XN-00001 PICTURE X. NC2014.2 +007300 77 WRK-XN-00005 PICTURE X(5). NC2014.2 +007400 77 TWO PICTURE 9 VALUE 2. NC2014.2 +007500 77 THREE PICTURE 9 VALUE 3. NC2014.2 +007600 77 SEVEN PICTURE 9 VALUE 7. NC2014.2 +007700 77 NINE PICTURE 9 VALUE 9. NC2014.2 +007800 77 TEN PICTURE 99 VALUE 10. NC2014.2 +007900 77 ALTERCOUNT PICTURE 999 VALUE ZERO. NC2014.2 +008000 77 XRAY PICTURE IS X. NC2014.2 +008100 77 IF-D1 PICTURE S9(4)V9(2) VALUE 0. NC2014.2 +008200 77 IF-D2 PICTURE S9(4)V9(2) VALUE ZERO. NC2014.2 +008300 77 IF-D3 PICTURE X(10) VALUE "0000000000". NC2014.2 +008400 77 IF-D4 PICTURE X(15) VALUE " ". NC2014.2 +008500 77 IF-D5 PICTURE X(10) VALUE ALL QUOTE. NC2014.2 +008600 77 IF-D6 PICTURE A(10) VALUE "BABABABABA". NC2014.2 +008700 77 IF-D7 PICTURE S9(6)V9(4) VALUE +123.45. NC2014.2 +008800 77 IF-D8 PICTURE 9(6)V9(4) VALUE 12300. NC2014.2 +008900 77 IF-D9 PICTURE X(3) VALUE "123". NC2014.2 +009000 77 IF-D11 PICTURE X(6) VALUE "ABCDEF". NC2014.2 +009100 77 IF-D13 PICTURE 9(6)V9(4) VALUE 12300. NC2014.2 +009200 77 IF-D14 PICTURE S9(4)V9(2) VALUE +123.45. NC2014.2 +009300 77 IF-D15 PICTURE S999PP VALUE 12300. NC2014.2 +009400 77 IF-D16 PICTURE PP99 VALUE .0012. NC2014.2 +009500 77 IF-D17 PICTURE SV9(4) VALUE .0012. NC2014.2 +009600 77 IF-D18 PICTURE X(10) VALUE "BABABABABA". NC2014.2 +009700 77 IF-D19 PICTURE X(10) VALUE "ABCDEF ". NC2014.2 +009800 77 IF-D23 PICTURE $9,9B9.90+. NC2014.2 +009900 77 IF-D24 PICTURE X(10) VALUE "$1,2 3.40+". NC2014.2 +010000 77 IF-D25 PICTURE ABABX0A. NC2014.2 +010100 77 IF-D26 PICTURE X(8) VALUE "A C D0E". NC2014.2 +010200 77 IF-D27 PICTURE IS 9(6)V9(4) VALUE IS 2137.45 NC2014.2 +010300 USAGE IS COMPUTATIONAL. NC2014.2 +010400 77 IF-D28 PICTURE IS 999999V9999 VALUE IS 2137.45. NC2014.2 +010500 77 IF-D31 PICTURE S9(6) VALUE -123. NC2014.2 +010600 77 IF-D32 PICTURE S9(4)V99. NC2014.2 +010700 88 A VALUE 1. NC2014.2 +010800 88 B VALUES ARE 2 THRU 4. NC2014.2 +010900 88 C VALUE IS ZERO. NC2014.2 +011000 88 D VALUE IS +12.34. NC2014.2 +011100 88 E VALUE IS .01, .11, .21 .81. NC2014.2 +011200 88 F VALUE IS 100 THRU 128 1000 THRU 1280 -9 THRU -2. NC2014.2 +011300 88 G VALUE IS 8765.43 1234 THRU 5678 5 -9999 THRU 10. NC2014.2 +011400 77 IF-D33 PICTURE X(4). NC2014.2 +011500 88 B VALUE QUOTE. NC2014.2 +011600 88 C VALUE SPACE. NC2014.2 +011700 88 D VALUE ALL "BAC". NC2014.2 +011800 77 IF-D34 PICTURE A(4). NC2014.2 +011900 88 B VALUE "A A ". NC2014.2 +012000 77 IF-D37 PICTURE 9(5) VALUE 12345. NC2014.2 +012100 77 IF-D38 PICTURE X(9) VALUE "12345 ". NC2014.2 +012200 77 CCON-1 PICTURE 99 VALUE 11. NC2014.2 +012300 77 CCON-2 PICTURE 99 VALUE 12. NC2014.2 +012400 77 CCON-3 PICTURE 99 VALUE 13. NC2014.2 +012500 77 COMP-SGN1 PICTURE S9(1) VALUE +9 COMPUTATIONAL. NC2014.2 +012600 77 COMP-SGN2 PICTURE S9(18) VALUE +3 COMPUTATIONAL. NC2014.2 +012700 77 COMP-SGN3 PICTURE S9(1) VALUE -5 COMPUTATIONAL. NC2014.2 +012800 77 COMP-SGN4 PICTURE S9(18) VALUE -3167598765431 COMPUTATIONAL.NC2014.2 +012900 77 START-POINT PICTURE 9(6) COMPUTATIONAL. NC2014.2 +013000 77 INC-VALUE PICTURE 9(6) COMPUTATIONAL. NC2014.2 +013100 77 SWITCH-PFM-1 PICTURE 9 VALUE ZERO. NC2014.2 +013200 77 SWITCH-PFM-2 PICTURE 9 VALUE ZERO. NC2014.2 +013300 77 PFM-11-COUNTER PICTURE 999 VALUE ZERO. NC2014.2 +013400 77 PFM-12-COUNTER PICTURE 999 VALUE 100. NC2014.2 +013500 77 PFM-12-ANS1 PICTURE 999 VALUE ZERO. NC2014.2 +013600 77 PFM-12-ANS2 PICTURE 999 VALUE ZERO. NC2014.2 +013700 01 SUBSCRIPT-6 PICTURE 99999 VALUE ZERO. NC2014.2 +013800 01 IF-TABLE. NC2014.2 +013900 02 IF-ELEM PICTURE X OCCURS 12 TIMES. NC2014.2 +014000 01 QUOTE-DATA. NC2014.2 +014100 02 QU-1 PICTURE X(3) VALUE "123". NC2014.2 +014200 02 QU-2 PICTURE X VALUE QUOTE. NC2014.2 +014300 02 QU-3 PICTURE X(6) VALUE "ABC456". NC2014.2 +014400 01 IF-D10. NC2014.2 +014500 02 D1 PICTURE X(2) VALUE "01". NC2014.2 +014600 02 D2 PICTURE X(2) VALUE "23". NC2014.2 +014700 02 D3. NC2014.2 +014800 03 D4 PICTURE X(4) VALUE "4567". NC2014.2 +014900 03 D5 PICTURE X(4) VALUE "8912". NC2014.2 +015000 01 IF-D12. NC2014.2 +015100 02 D1 PICTURE X(3) VALUE "ABC". NC2014.2 +015200 02 D2. NC2014.2 +015300 03 D3. NC2014.2 +015400 04 D4 PICTURE XX VALUE "DE". NC2014.2 +015500 04 D5 PICTURE X VALUE "F". NC2014.2 +015600 01 IF-D20. NC2014.2 +015700 02 FILLER PICTURE 9(5) VALUE ZERO. NC2014.2 +015800 02 D1 PICTURE 9(2) VALUE 12. NC2014.2 +015900 02 D2 PICTURE 9 VALUE 3. NC2014.2 +016000 02 D3 PICTURE 9(2) VALUE 45. NC2014.2 +016100 01 IF-D21. NC2014.2 +016200 02 D1 PICTURE 9(5) VALUE ZEROS. NC2014.2 +016300 02 D2 PICTURE 9(5) VALUE 12345. NC2014.2 +016400 01 IF-D22. NC2014.2 +016500 02 D1 PICTURE A(2) VALUE "AB". NC2014.2 +016600 02 D2 PICTURE A(4) VALUE "CDEF". NC2014.2 +016700 01 IF-D35. NC2014.2 +016800 02 AA PICTURE X(2). NC2014.2 +016900 88 A1 VALUE "AA". NC2014.2 +017000 88 A2 VALUE "AB". NC2014.2 +017100 02 BB PICTURE IS X(2). NC2014.2 +017200 88 B1 VALUE "CC". NC2014.2 +017300 88 B2 VALUE "CD". NC2014.2 +017400 02 BB-2 REDEFINES BB. NC2014.2 +017500 03 AAA PICTURE X. NC2014.2 +017600 88 AA1 VALUE "A". NC2014.2 +017700 88 AA2 VALUE "C". NC2014.2 +017800 03 BBB PICTURE X. NC2014.2 +017900 88 BB1 VALUE "B". NC2014.2 +018000 88 BB2 VALUE "D". NC2014.2 +018100 01 IF-D36 PICTURE X(120) VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYNC2014.2 +018200- "Z1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCDEFGHIJKLMNC2014.2 +018300- "NOPQRSTUVWXYZ1234567890ABCDEFGHIJKL". NC2014.2 +018400 01 IF-D40 PICTURE 9(5) VALUE 12345 NC2014.2 +018500 COMPUTATIONAL SYNCHRONIZED RIGHT. NC2014.2 +018600 88 IF-D40A VALUE ZERO THRU 10000. NC2014.2 +018700 88 IF-D40B VALUE 10001 THRU 99999. NC2014.2 +018800 88 IF-D40C VALUE 99999. NC2014.2 +018900 01 PERFORM1 PICTURE XXX VALUE SPACES. NC2014.2 +019000 01 PERFORM2 PICTURE S999 VALUE 20. NC2014.2 +019100 01 PERFORM3 PICTURE 9 VALUE 5. NC2014.2 +019200 01 PERFORM4 PICTURE S99V9. NC2014.2 +019300 01 PERFORM5 PICTURE S99V9 VALUE 10.0. NC2014.2 +019400 01 PERFORM6 PICTURE 99V9. NC2014.2 +019500 01 PERFORM7. NC2014.2 +019600 02 PERFORM8 OCCURS 7 TIMES PICTURE 99V9. NC2014.2 +019700 01 PERFORM9 PICTURE 9 VALUE 3. NC2014.2 +019800 01 PERFORM10 PICTURE S9 VALUE -1. NC2014.2 +019900 01 PERFORM11 PICTURE 99 VALUE 6. NC2014.2 +020000 01 PERFORM12. NC2014.2 +020100 02 PERFORM13 OCCURS 4 TIMES. NC2014.2 +020200 03 PERFORM14 OCCURS 20 TIMES PICTURE 99V9. NC2014.2 +020300 03 PERFORM15 OCCURS 10 TIMES. NC2014.2 +020400 04 PERFORM16 OCCURS 5 TIMES PICTURE 99V9. NC2014.2 +020500 01 PERFORM17 PICTURE 9(6) COMPUTATIONAL. NC2014.2 +020600 01 PERFORM18 PICTURE 9(6) COMPUTATIONAL. NC2014.2 +020700 01 PERFORM-KEY PICTURE 9. NC2014.2 +020800 01 PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +020900 03 PFM71 OCCURS 2. NC2014.2 +021000 05 PFM72 OCCURS 2. NC2014.2 +021100 07 PFM73 OCCURS 2. NC2014.2 +021200 09 PFM74 OCCURS 2. NC2014.2 +021300 11 PFM75 OCCURS 2. NC2014.2 +021400 13 PFM76 OCCURS 2. NC2014.2 +021500 15 PFM77 OCCURS 2. NC2014.2 +021600 17 PFM77-1 PIC X. NC2014.2 +021700 01 S1 PIC S9(5) COMP. NC2014.2 +021800 01 S2 PIC S9(5) COMP. NC2014.2 +021900 01 S3 PIC S9(5) COMP. NC2014.2 +022000 01 S4 PIC S9(5) COMP. NC2014.2 +022100 01 S5 PIC S9(5) COMP. NC2014.2 +022200 01 S6 PIC S9(5) COMP. NC2014.2 +022300 01 S7 PIC S9(5) COMP. NC2014.2 +022400 01 PFM-7-TOT PIC S9(5) COMP. NC2014.2 +022500 01 PFM-F4-23-TOT PIC S9(5) COMP. NC2014.2 +022600 01 PFM-A1 PIC S9(5) COMP. NC2014.2 +022700 01 PFM-B1 PIC S9(5) COMP. NC2014.2 +022800 01 FILLER-A. NC2014.2 +022900 03 PFM-F4-24-A PIC S9(3) COMP OCCURS 10. NC2014.2 +023000 01 FILLER-B. NC2014.2 +023100 03 PFM-F4-24-B PIC S9(3) COMP OCCURS 10. NC2014.2 +023200 01 FILLER-C. NC2014.2 +023300 03 PFM-F4-24-C PIC S9(3) COMP OCCURS 10. NC2014.2 +023400 01 RECEIVING-TABLE. NC2014.2 +023500 03 TBL-ELEMEN-A. NC2014.2 +023600 05 TBL-ELEMEN-B PICTURE X(18). NC2014.2 +023700 05 TBL-ELEMEN-C PICTURE X(18). NC2014.2 +023800 03 TBL-ELEMEN-D. NC2014.2 +023900 05 TBL-ELEMEN-E PICTURE X OCCURS 36 TIMES. NC2014.2 +024000 01 LITERAL-SPLITTER. NC2014.2 +024100 02 PART1 PICTURE X(20). NC2014.2 +024200 02 PART2 PICTURE X(20). NC2014.2 +024300 02 PART3 PICTURE X(20). NC2014.2 +024400 02 PART4 PICTURE X(20). NC2014.2 +024500 01 LITERAL-TABLE REDEFINES LITERAL-SPLITTER. NC2014.2 +024600 02 80PARTS PICTURE X OCCURS 80 TIMES. NC2014.2 +024700 01 GRP-FOR-88-LEVELS. NC2014.2 +024800 03 WRK-DS-02V00-COND PICTURE 99. NC2014.2 +024900 88 COND-1 VALUE IS 01 THRU 05. NC2014.2 +025000 88 COND-2 VALUES ARE 06 THRU 10 NC2014.2 +025100 16 THRU 20 00. NC2014.2 +025200 88 COND-3 VALUES 11 THRU 15. NC2014.2 +025300 01 GRP-MOVE-CONSTANTS. NC2014.2 +025400 03 GRP-GROUP-MOVE-FROM. NC2014.2 +025500 04 GRP-ALPHABETIC. NC2014.2 +025600 05 ALPHABET-AN-00026 PICTURE A(26) NC2014.2 +025700 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2014.2 +025800 04 GRP-NUMERIC. NC2014.2 +025900 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789. NC2014.2 +026000 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 NC2014.2 +026100 PICTURE 9(6)V9999. NC2014.2 +026200 04 GRP-ALPHANUMERIC. NC2014.2 +026300 05 ALPHANUMERIC-XN-00049 PICTURE X(50) NC2014.2 +026400 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-><=$,;.()/* 0123456789". NC2014.2 +026500 05 FILLER PICTURE X VALUE QUOTE. NC2014.2 +026600 01 GRP-FOR-2N058. NC2014.2 +026700 02 SUB-GRP-FOR-2N058-A. NC2014.2 +026800 03 ELEM-FOR-2N058-A PICTURE 999 VALUE ZEROES. NC2014.2 +026900 03 ELEM-FOR-2N058-B PICTURE XXX VALUE ZEROS. NC2014.2 +027000 03 ELEM-FOR-2N058-C PICTURE XXX VALUE SPACES. NC2014.2 +027100 03 ELEM-FOR-2N058-D PICTURE X(6) VALUE ALL "ABC". NC2014.2 +027200 03 ELEM-FOR-2N058-E PICTURE XXX VALUE ALL "Z". NC2014.2 +027300 03 ELEM-FOR-2N058-F PICTURE XXX VALUE ALL SPACES. NC2014.2 +027400 03 ELEM-FOR-2N058-G PICTURE XXX VALUE ALL ZEROES. NC2014.2 +027500 03 ELEM-FOR-2N058-H PICTURE 999 VALUE ALL ZEROS. NC2014.2 +027600 03 ELEM-FOR-2N058-I PICTURE XXX VALUE QUOTES. NC2014.2 +027700 03 ELEM-FOR-2N058-J PICTURE XXX VALUE ALL QUOTES. NC2014.2 +027800 03 ELEM-FOR-2N058-K PICTURE XXX VALUE ALL HIGH-VALUES. NC2014.2 +027900 03 ELEM-FOR-2N058-L PICTURE XXX VALUE ALL LOW-VALUES. NC2014.2 +028000 03 ELEM-FOR-2N058-M PICTURE XXX VALUE HIGH-VALUES. NC2014.2 +028100 03 ELEM-FOR-2N058-N PICTURE XXX VALUE LOW-VALUES. NC2014.2 +028200 02 SUB-GRP-FOR-2N058-B. NC2014.2 +028300 03 SUB-SUB-BA. NC2014.2 +028400 04 ELEM-FOR-2N058-A PICTURE 999. NC2014.2 +028500 04 ELEM-FOR-2N058-B PICTURE XXX. NC2014.2 +028600 04 ELEM-FOR-2N058-C PICTURE XXX. NC2014.2 +028700 04 ELEM-FOR-2N058-D PICTURE X(6). NC2014.2 +028800 03 SUB-SUB-BB. NC2014.2 +028900 04 ELEM-FOR-2N058-E PICTURE XXX. NC2014.2 +029000 04 ELEM-FOR-2N058-F PICTURE XXX. NC2014.2 +029100 04 ELEM-FOR-2N058-G PICTURE XXX. NC2014.2 +029200 04 ELEM-FOR-2N058-H PICTURE 999. NC2014.2 +029300 03 SUB-SUB-BC. NC2014.2 +029400 04 ELEM-FOR-2N058-I PICTURE XXX. NC2014.2 +029500 04 ELEM-FOR-2N058-J PICTURE XXX. NC2014.2 +029600 04 ELEM-FOR-2N058-K PICTURE XXX. NC2014.2 +029700 04 ELEM-FOR-2N058-L PICTURE XXX. NC2014.2 +029800 04 ELEM-FOR-2N058-M PICTURE XXX. NC2014.2 +029900 04 ELEM-FOR-2N058-N PICTURE XXX. NC2014.2 +030000 01 CHARACTER-BREAKDOWN-S. NC2014.2 +030100 02 FIRST-20S PICTURE X(20). NC2014.2 +030200 02 SECOND-20S PICTURE X(20). NC2014.2 +030300 02 THIRD-20S PICTURE X(20). NC2014.2 +030400 02 FOURTH-20S PICTURE X(20). NC2014.2 +030500 02 FIFTH-20S PICTURE X(20). NC2014.2 +030600 02 SIXTH-20S PICTURE X(20). NC2014.2 +030700 02 SEVENTH-20S PICTURE X(20). NC2014.2 +030800 02 EIGHTH-20S PICTURE X(20). NC2014.2 +030900 02 NINTH-20S PICTURE X(20). NC2014.2 +031000 02 TENTH-20S PICTURE X(20). NC2014.2 +031100 01 CHARACTER-BREAKDOWN-R. NC2014.2 +031200 02 FIRST-20R PICTURE X(20). NC2014.2 +031300 02 SECOND-20R PICTURE X(20). NC2014.2 +031400 02 THIRD-20R PICTURE X(20). NC2014.2 +031500 02 FOURTH-20R PICTURE X(20). NC2014.2 +031600 02 FIFTH-20R PICTURE X(20). NC2014.2 +031700 02 SIXTH-20R PICTURE X(20). NC2014.2 +031800 02 SEVENTH-20R PICTURE X(20). NC2014.2 +031900 02 EIGHTH-20R PICTURE X(20). NC2014.2 +032000 02 NINTH-20R PICTURE X(20). NC2014.2 +032100 02 TENTH-20R PICTURE X(20). NC2014.2 +032200 01 TABLE-80. NC2014.2 +032300 02 ELMT OCCURS 3 TIMES PIC 9. NC2014.2 +032400 88 A80 VALUES ARE ZERO THRU 7. NC2014.2 +032500 88 B80 VALUE 8. NC2014.2 +032600 88 C80 VALUES ARE 7, 8 THROUGH 9. NC2014.2 +032700 NC2014.2 +032800 01 TABLE-86. NC2014.2 +032900 88 A86 VALUE "ABC". NC2014.2 +033000 88 B86 VALUE "ABCABC". NC2014.2 +033100 88 C86 VALUE " ABC". NC2014.2 +033200 02 DATANAME-86 PIC XXX VALUE "ABC". NC2014.2 +033300 02 DNAME-86. NC2014.2 +033400 03 FILLER PIC X VALUE "A". NC2014.2 +033500 03 FILLER PIC X VALUE "B". NC2014.2 +033600 03 FILLER PIC X VALUE "C". NC2014.2 +033700 01 FIGCON-DATA. NC2014.2 +033800 02 SPACE-X PICTURE X(10) VALUE " ". NC2014.2 +033900 02 QUOTE-X PICTURE X(5) VALUE QUOTE. NC2014.2 +034000 02 LOW-VAL PICTURE X(5) VALUE LOW-VALUE. NC2014.2 +034100 02 ABC PICTURE XXX VALUE "ABC". NC2014.2 +034200 02 ONE23 PICTURE 9999 VALUE 123. NC2014.2 +034300 02 ZERO-C PICTURE 9(10) VALUE 0 COMPUTATIONAL. NC2014.2 +034400 02 ZERO-D PICTURE 9 VALUE ZERO USAGE DISPLAY. NC2014.2 +034500 01 TEST-RESULTS. NC2014.2 +034600 02 FILLER PIC X VALUE SPACE. NC2014.2 +034700 02 FEATURE PIC X(20) VALUE SPACE. NC2014.2 +034800 02 FILLER PIC X VALUE SPACE. NC2014.2 +034900 02 P-OR-F PIC X(5) VALUE SPACE. NC2014.2 +035000 02 FILLER PIC X VALUE SPACE. NC2014.2 +035100 02 PAR-NAME. NC2014.2 +035200 03 FILLER PIC X(19) VALUE SPACE. NC2014.2 +035300 03 PARDOT-X PIC X VALUE SPACE. NC2014.2 +035400 03 DOTVALUE PIC 99 VALUE ZERO. NC2014.2 +035500 02 FILLER PIC X(8) VALUE SPACE. NC2014.2 +035600 02 RE-MARK PIC X(61). NC2014.2 +035700 01 TEST-COMPUTED. NC2014.2 +035800 02 FILLER PIC X(30) VALUE SPACE. NC2014.2 +035900 02 FILLER PIC X(17) VALUE NC2014.2 +036000 " COMPUTED=". NC2014.2 +036100 02 COMPUTED-X. NC2014.2 +036200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2014.2 +036300 03 COMPUTED-N REDEFINES COMPUTED-A NC2014.2 +036400 PIC -9(9).9(9). NC2014.2 +036500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2014.2 +036600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2014.2 +036700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2014.2 +036800 03 CM-18V0 REDEFINES COMPUTED-A. NC2014.2 +036900 04 COMPUTED-18V0 PIC -9(18). NC2014.2 +037000 04 FILLER PIC X. NC2014.2 +037100 03 FILLER PIC X(50) VALUE SPACE. NC2014.2 +037200 01 TEST-CORRECT. NC2014.2 +037300 02 FILLER PIC X(30) VALUE SPACE. NC2014.2 +037400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2014.2 +037500 02 CORRECT-X. NC2014.2 +037600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2014.2 +037700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2014.2 +037800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2014.2 +037900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2014.2 +038000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2014.2 +038100 03 CR-18V0 REDEFINES CORRECT-A. NC2014.2 +038200 04 CORRECT-18V0 PIC -9(18). NC2014.2 +038300 04 FILLER PIC X. NC2014.2 +038400 03 FILLER PIC X(2) VALUE SPACE. NC2014.2 +038500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2014.2 +038600 01 CCVS-C-1. NC2014.2 +038700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2014.2 +038800- "SS PARAGRAPH-NAME NC2014.2 +038900- " REMARKS". NC2014.2 +039000 02 FILLER PIC X(20) VALUE SPACE. NC2014.2 +039100 01 CCVS-C-2. NC2014.2 +039200 02 FILLER PIC X VALUE SPACE. NC2014.2 +039300 02 FILLER PIC X(6) VALUE "TESTED". NC2014.2 +039400 02 FILLER PIC X(15) VALUE SPACE. NC2014.2 +039500 02 FILLER PIC X(4) VALUE "FAIL". NC2014.2 +039600 02 FILLER PIC X(94) VALUE SPACE. NC2014.2 +039700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2014.2 +039800 01 REC-CT PIC 99 VALUE ZERO. NC2014.2 +039900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2014.2 +040000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2014.2 +040100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2014.2 +040200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2014.2 +040300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2014.2 +040400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2014.2 +040500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2014.2 +040600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2014.2 +040700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2014.2 +040800 01 CCVS-H-1. NC2014.2 +040900 02 FILLER PIC X(39) VALUE SPACES. NC2014.2 +041000 02 FILLER PIC X(42) VALUE NC2014.2 +041100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2014.2 +041200 02 FILLER PIC X(39) VALUE SPACES. NC2014.2 +041300 01 CCVS-H-2A. NC2014.2 +041400 02 FILLER PIC X(40) VALUE SPACE. NC2014.2 +041500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2014.2 +041600 02 FILLER PIC XXXX VALUE NC2014.2 +041700 "4.2 ". NC2014.2 +041800 02 FILLER PIC X(28) VALUE NC2014.2 +041900 " COPY - NOT FOR DISTRIBUTION". NC2014.2 +042000 02 FILLER PIC X(41) VALUE SPACE. NC2014.2 +042100 NC2014.2 +042200 01 CCVS-H-2B. NC2014.2 +042300 02 FILLER PIC X(15) VALUE NC2014.2 +042400 "TEST RESULT OF ". NC2014.2 +042500 02 TEST-ID PIC X(9). NC2014.2 +042600 02 FILLER PIC X(4) VALUE NC2014.2 +042700 " IN ". NC2014.2 +042800 02 FILLER PIC X(12) VALUE NC2014.2 +042900 " HIGH ". NC2014.2 +043000 02 FILLER PIC X(22) VALUE NC2014.2 +043100 " LEVEL VALIDATION FOR ". NC2014.2 +043200 02 FILLER PIC X(58) VALUE NC2014.2 +043300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2014.2 +043400 01 CCVS-H-3. NC2014.2 +043500 02 FILLER PIC X(34) VALUE NC2014.2 +043600 " FOR OFFICIAL USE ONLY ". NC2014.2 +043700 02 FILLER PIC X(58) VALUE NC2014.2 +043800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2014.2 +043900 02 FILLER PIC X(28) VALUE NC2014.2 +044000 " COPYRIGHT 1985 ". NC2014.2 +044100 01 CCVS-E-1. NC2014.2 +044200 02 FILLER PIC X(52) VALUE SPACE. NC2014.2 +044300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2014.2 +044400 02 ID-AGAIN PIC X(9). NC2014.2 +044500 02 FILLER PIC X(45) VALUE SPACES. NC2014.2 +044600 01 CCVS-E-2. NC2014.2 +044700 02 FILLER PIC X(31) VALUE SPACE. NC2014.2 +044800 02 FILLER PIC X(21) VALUE SPACE. NC2014.2 +044900 02 CCVS-E-2-2. NC2014.2 +045000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2014.2 +045100 03 FILLER PIC X VALUE SPACE. NC2014.2 +045200 03 ENDER-DESC PIC X(44) VALUE NC2014.2 +045300 "ERRORS ENCOUNTERED". NC2014.2 +045400 01 CCVS-E-3. NC2014.2 +045500 02 FILLER PIC X(22) VALUE NC2014.2 +045600 " FOR OFFICIAL USE ONLY". NC2014.2 +045700 02 FILLER PIC X(12) VALUE SPACE. NC2014.2 +045800 02 FILLER PIC X(58) VALUE NC2014.2 +045900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2014.2 +046000 02 FILLER PIC X(13) VALUE SPACE. NC2014.2 +046100 02 FILLER PIC X(15) VALUE NC2014.2 +046200 " COPYRIGHT 1985". NC2014.2 +046300 01 CCVS-E-4. NC2014.2 +046400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2014.2 +046500 02 FILLER PIC X(4) VALUE " OF ". NC2014.2 +046600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2014.2 +046700 02 FILLER PIC X(40) VALUE NC2014.2 +046800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2014.2 +046900 01 XXINFO. NC2014.2 +047000 02 FILLER PIC X(19) VALUE NC2014.2 +047100 "*** INFORMATION ***". NC2014.2 +047200 02 INFO-TEXT. NC2014.2 +047300 04 FILLER PIC X(8) VALUE SPACE. NC2014.2 +047400 04 XXCOMPUTED PIC X(20). NC2014.2 +047500 04 FILLER PIC X(5) VALUE SPACE. NC2014.2 +047600 04 XXCORRECT PIC X(20). NC2014.2 +047700 02 INF-ANSI-REFERENCE PIC X(48). NC2014.2 +047800 01 HYPHEN-LINE. NC2014.2 +047900 02 FILLER PIC IS X VALUE IS SPACE. NC2014.2 +048000 02 FILLER PIC IS X(65) VALUE IS "************************NC2014.2 +048100- "*****************************************". NC2014.2 +048200 02 FILLER PIC IS X(54) VALUE IS "************************NC2014.2 +048300- "******************************". NC2014.2 +048400 01 CCVS-PGM-ID PIC X(9) VALUE NC2014.2 +048500 "NC201A". NC2014.2 +048600 PROCEDURE DIVISION. NC2014.2 +048700 CCVS1 SECTION. NC2014.2 +048800 OPEN-FILES. NC2014.2 +048900 OPEN OUTPUT PRINT-FILE. NC2014.2 +049000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2014.2 +049100 MOVE SPACE TO TEST-RESULTS. NC2014.2 +049200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2014.2 +049300 GO TO CCVS1-EXIT. NC2014.2 +049400 CLOSE-FILES. NC2014.2 +049500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2014.2 +049600 TERMINATE-CCVS. NC2014.2 +049700*S EXIT PROGRAM. NC2014.2 +049800*SERMINATE-CALL. NC2014.2 +049900 STOP RUN. NC2014.2 +050000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2014.2 +050100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2014.2 +050200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2014.2 +050300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2014.2 +050400 MOVE "****TEST DELETED****" TO RE-MARK. NC2014.2 +050500 PRINT-DETAIL. NC2014.2 +050600 IF REC-CT NOT EQUAL TO ZERO NC2014.2 +050700 MOVE "." TO PARDOT-X NC2014.2 +050800 MOVE REC-CT TO DOTVALUE. NC2014.2 +050900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2014.2 +051000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2014.2 +051100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2014.2 +051200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2014.2 +051300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2014.2 +051400 MOVE SPACE TO CORRECT-X. NC2014.2 +051500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2014.2 +051600 MOVE SPACE TO RE-MARK. NC2014.2 +051700 HEAD-ROUTINE. NC2014.2 +051800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +051900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +052000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2014.2 +052100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2014.2 +052200 COLUMN-NAMES-ROUTINE. NC2014.2 +052300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +052400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +052500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +052600 END-ROUTINE. NC2014.2 +052700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2014.2 +052800 END-RTN-EXIT. NC2014.2 +052900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +053000 END-ROUTINE-1. NC2014.2 +053100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2014.2 +053200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2014.2 +053300 ADD PASS-COUNTER TO ERROR-HOLD. NC2014.2 +053400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2014.2 +053500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2014.2 +053600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2014.2 +053700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2014.2 +053800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2014.2 +053900 END-ROUTINE-12. NC2014.2 +054000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2014.2 +054100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2014.2 +054200 MOVE "NO " TO ERROR-TOTAL NC2014.2 +054300 ELSE NC2014.2 +054400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2014.2 +054500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2014.2 +054600 PERFORM WRITE-LINE. NC2014.2 +054700 END-ROUTINE-13. NC2014.2 +054800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2014.2 +054900 MOVE "NO " TO ERROR-TOTAL ELSE NC2014.2 +055000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2014.2 +055100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2014.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +055300 IF INSPECT-COUNTER EQUAL TO ZERO NC2014.2 +055400 MOVE "NO " TO ERROR-TOTAL NC2014.2 +055500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2014.2 +055600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2014.2 +055700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +055800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2014.2 +055900 WRITE-LINE. NC2014.2 +056000 ADD 1 TO RECORD-COUNT. NC2014.2 +056100 IF RECORD-COUNT GREATER 50 NC2014.2 +056200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2014.2 +056300 MOVE SPACE TO DUMMY-RECORD NC2014.2 +056400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2014.2 +056500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2014.2 +056600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2014.2 +056700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2014.2 +056800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2014.2 +056900 MOVE ZERO TO RECORD-COUNT. NC2014.2 +057000 PERFORM WRT-LN. NC2014.2 +057100 WRT-LN. NC2014.2 +057200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2014.2 +057300 MOVE SPACE TO DUMMY-RECORD. NC2014.2 +057400 BLANK-LINE-PRINT. NC2014.2 +057500 PERFORM WRT-LN. NC2014.2 +057600 FAIL-ROUTINE. NC2014.2 +057700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2014.2 +057800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2014.2 +057900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2014.2 +058000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2014.2 +058100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +058200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2014.2 +058300 GO TO FAIL-ROUTINE-EX. NC2014.2 +058400 FAIL-ROUTINE-WRITE. NC2014.2 +058500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2014.2 +058600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2014.2 +058700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2014.2 +058800 MOVE SPACES TO COR-ANSI-REFERENCE. NC2014.2 +058900 FAIL-ROUTINE-EX. EXIT. NC2014.2 +059000 BAIL-OUT. NC2014.2 +059100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2014.2 +059200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2014.2 +059300 BAIL-OUT-WRITE. NC2014.2 +059400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2014.2 +059500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2014.2 +059600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2014.2 +059700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2014.2 +059800 BAIL-OUT-EX. EXIT. NC2014.2 +059900 CCVS1-EXIT. NC2014.2 +060000 EXIT. NC2014.2 +060100 SECT-NC201A-001 SECTION. NC2014.2 +060200 PFM-INIT-F3-1. NC2014.2 +060300 MOVE "PFM-TEST-F3-1" TO PAR-NAME. NC2014.2 +060400 MOVE "VI-112 6.20.4 GR10(d)" TO ANSI-REFERENCE. NC2014.2 +060500 MOVE "PERFORM UNTIL" TO FEATURE. NC2014.2 +060600 MOVE 1 TO PERFORM2. NC2014.2 +060700 PFM-TEST-F3-0. NC2014.2 +060800 PERFORM PFM-A THRU PFM-AA UNTIL PERFORM2 EQUAL TO 48. NC2014.2 +060900* NOTE IN THIS TEST THE CONDITION IS NOT SATISFIED NC2014.2 +061000* ORIGINALLY WHEN THE PERFORM IS ENTERED. NC2014.2 +061100 PFM-TEST-F3-1. NC2014.2 +061200 IF PERFORM2 EQUAL TO 48 PERFORM PASS NC2014.2 +061300 GO TO PFM-WRITE-F3-1. NC2014.2 +061400 GO TO PFM-FAIL-F3-1. NC2014.2 +061500 PFM-DELETE-F3-1. NC2014.2 +061600 PERFORM DE-LETE. NC2014.2 +061700 GO TO PFM-WRITE-F3-1. NC2014.2 +061800 PFM-FAIL-F3-1. NC2014.2 +061900 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +062000 MOVE 48 TO CORRECT-N. NC2014.2 +062100 PERFORM FAIL. NC2014.2 +062200 PFM-WRITE-F3-1. NC2014.2 +062300 PERFORM PRINT-DETAIL. NC2014.2 +062400* NC2014.2 +062500 PFM-INIT-F3-2. NC2014.2 +062600 MOVE "PFM-TEST-F3-2" TO PAR-NAME. NC2014.2 +062700 MOVE 50 TO PERFORM2. NC2014.2 +062800* NOTE IN THIS TEST CONDITION IS SATISFIED WHEN PERFORM IS NC2014.2 +062900* ENTERED AND CONTROL SHOULD NOT BE PASSED TO PFM-C. NC2014.2 +063000 PFM-TEST-F3-2. NC2014.2 +063100 PERFORM PFM-C UNTIL PERFORM2 GREATER THAN 25. NC2014.2 +063200 IF PERFORM2 EQUAL TO 50 PERFORM PASS NC2014.2 +063300 GO TO PFM-WRITE-F3-2. NC2014.2 +063400 GO TO PFM-FAIL-F3-2. NC2014.2 +063500 PFM-DELETE-F3-2. NC2014.2 +063600 PERFORM DE-LETE. NC2014.2 +063700 GO TO PFM-WRITE-F3-2. NC2014.2 +063800 PFM-FAIL-F3-2. NC2014.2 +063900 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +064000 MOVE 50 TO CORRECT-N. NC2014.2 +064100 PERFORM FAIL. NC2014.2 +064200 PFM-WRITE-F3-2. NC2014.2 +064300 PERFORM PRINT-DETAIL. NC2014.2 +064400* NC2014.2 +064500 PFM-INIT-F4-1. NC2014.2 +064600 MOVE "PFM-TEST-F4-1" TO PAR-NAME. NC2014.2 +064700 MOVE "PERFORM VARYING" TO FEATURE. NC2014.2 +064800 PFM-TEST-F4-1. NC2014.2 +064900 PERFORM PFM-E VARYING PERFORM4 FROM PERFORM5 BY -0.2 NC2014.2 +065000 UNTIL PERFORM4 LESS THAN 9.0. NC2014.2 +065100 IF PERFORM4 EQUAL TO 8.8 AND PERFORM6 EQUAL TO 12.5 NC2014.2 +065200 PERFORM PASS NC2014.2 +065300 GO TO PFM-WRITE-F4-1. NC2014.2 +065400 GO TO PFM-FAIL-F4-1. NC2014.2 +065500 PFM-DELETE-F4-1. NC2014.2 +065600 PERFORM PRINT-DETAIL. NC2014.2 +065700 GO TO PFM-WRITE-F4-1. NC2014.2 +065800 PFM-FAIL-F4-1. NC2014.2 +065900 MOVE PERFORM4 TO COMPUTED-N. NC2014.2 +066000 MOVE 8.8 TO CORRECT-N. NC2014.2 +066100 PERFORM FAIL. NC2014.2 +066200 PERFORM PRINT-DETAIL. NC2014.2 +066300 MOVE SPACE TO P-OR-F. NC2014.2 +066400 MOVE PERFORM6 TO COMPUTED-N. NC2014.2 +066500 MOVE 12.5 TO CORRECT-N. NC2014.2 +066600 PFM-WRITE-F4-1. NC2014.2 +066700 PERFORM PRINT-DETAIL. NC2014.2 +066800* NC2014.2 +066900 PFM-INIT-F4-2. NC2014.2 +067000 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +067100 MOVE 5.5 TO PERFORM4. NC2014.2 +067200 MOVE 5.5 TO PERFORM8 (7). NC2014.2 +067300 PFM-TEST-F4-2. NC2014.2 +067400* NOTE IN THIS TEST ONE SUBSCRIPT IS VARIED. NC2014.2 +067500* NOTE THIS ALSO TESTS THAT WHEN THE CONDITION IS TRUE, NC2014.2 +067600* CONTROL FALLS THRU AND THE PROCEDURE IS NOT EXECUTED. NC2014.2 +067700 PERFORM PFM-G VARYING PERFORM3 FROM 1 BY 2 UNTIL NC2014.2 +067800 PERFORM3 GREATER THAN 5. NC2014.2 +067900 IF PERFORM8 (1) EQUAL TO 13.5 AND PERFORM8 (3) EQUAL TO 13.8 NC2014.2 +068000 AND PERFORM8 (5) EQUAL TO 14.1 AND PERFORM8 (7) EQUAL TO NC2014.2 +068100 5.5 AND PERFORM3 EQUAL TO 7 NC2014.2 +068200 PERFORM PASS NC2014.2 +068300 GO TO PFM-WRITE-F4-2. NC2014.2 +068400* NOTE THE OCCURS CLAUSE IS NEEDED IN THE DATA DESCRIPTION NC2014.2 +068500* FOR THESE PERFORM TESTS --- MORE EXHAUSTIVE TESTS OF THE NC2014.2 +068600* OCCURS CLAUSE CAN BE FOUND IN THE TABLE HANDLING TESTS. NC2014.2 +068700 GO TO PFM-FAIL-F4-2. NC2014.2 +068800 PFM-DELETE-F4-2. NC2014.2 +068900 PERFORM DE-LETE. NC2014.2 +069000 GO TO PFM-WRITE-F4-2. NC2014.2 +069100 PFM-FAIL-F4-2. NC2014.2 +069200 MOVE PERFORM8 (1) TO COMPUTED-N. NC2014.2 +069300 MOVE 13.5 TO CORRECT-N. NC2014.2 +069400 PERFORM FAIL. NC2014.2 +069500 PERFORM PRINT-DETAIL. NC2014.2 +069600 MOVE SPACE TO P-OR-F. NC2014.2 +069700 MOVE PERFORM8 (3) TO COMPUTED-N. NC2014.2 +069800 MOVE 13.8 TO CORRECT-N. NC2014.2 +069900 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +070000 PERFORM PRINT-DETAIL. NC2014.2 +070100 MOVE PERFORM8 (5) TO COMPUTED-N. NC2014.2 +070200 MOVE 14.1 TO CORRECT-N. NC2014.2 +070300 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +070400 PERFORM PRINT-DETAIL. NC2014.2 +070500 MOVE PERFORM8 (7) TO COMPUTED-N. NC2014.2 +070600 MOVE 5.5 TO CORRECT-N. NC2014.2 +070700 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +070800 PERFORM PRINT-DETAIL. NC2014.2 +070900 MOVE PERFORM3 TO COMPUTED-N. NC2014.2 +071000 MOVE 7 TO CORRECT-N. NC2014.2 +071100 MOVE "PFM-TEST-F4-2" TO PAR-NAME. NC2014.2 +071200 PFM-WRITE-F4-2. NC2014.2 +071300 PERFORM PRINT-DETAIL. NC2014.2 +071400* NC2014.2 +071500 PFM-INIT-F4-3. NC2014.2 +071600 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +071700 MOVE 1.5 TO PERFORM4. NC2014.2 +071800 PFM-TEST-F4-3. NC2014.2 +071900* NOTE IN THIS TEST TWO SUBSCRIPTS ARE VARIED. NC2014.2 +072000 PERFORM PFM-I THRU PFM-J VARYING PERFORM3 NC2014.2 +072100 FROM PERFORM9 BY PERFORM10 UNTIL PERFORM3 EQUAL TO 1 NC2014.2 +072200 AFTER PERFORM2 FROM 2 BY PERFORM11 UNTIL PERFORM2 NC2014.2 +072300 GREATER THAN 20. NC2014.2 +072400 IF PERFORM14 (3, 2) EQUAL TO 15.0 AND PERFORM14 (3, 8) NC2014.2 +072500 EQUAL TO 20.0 AND PERFORM14 (3, 14) EQUAL TO 25.0 NC2014.2 +072600 AND PERFORM14 (3, 20) EQUAL TO 30.0 AND PERFORM14 (2, 2) NC2014.2 +072700 EQUAL TO 35.0 MOVE "A" TO XRAY. NC2014.2 +072800 IF PERFORM14 (2, 8) EQUAL TO 40.0 AND NC2014.2 +072900 PERFORM14 (2, 14) EQUAL TO 45.0 AND PERFORM14 (2, 20) NC2014.2 +073000 EQUAL TO 50.0 AND PERFORM2 EQUAL TO 2 AND PERFORM3 NC2014.2 +073100 EQUAL TO 1 AND XRAY EQUAL TO "A" PERFORM PASS NC2014.2 +073200 GO TO PFM-WRITE-F4-3. NC2014.2 +073300 GO TO PFM-FAIL-F4-3. NC2014.2 +073400 PFM-DELETE-F4-3. NC2014.2 +073500 PERFORM DE-LETE. NC2014.2 +073600 GO TO PFM-WRITE-F4-3. NC2014.2 +073700 PFM-FAIL-F4-3. NC2014.2 +073800 MOVE PERFORM14 (3, 2) TO COMPUTED-N. NC2014.2 +073900 MOVE 15.0 TO CORRECT-N. NC2014.2 +074000 PERFORM FAIL. NC2014.2 +074100 PERFORM PRINT-DETAIL. NC2014.2 +074200 MOVE SPACE TO P-OR-F. NC2014.2 +074300 MOVE PERFORM14 (3, 8) TO COMPUTED-N. NC2014.2 +074400 MOVE 20.0 TO CORRECT-N. NC2014.2 +074500 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +074600 PERFORM PRINT-DETAIL. NC2014.2 +074700 MOVE PERFORM14 (3, 14) TO COMPUTED-N. NC2014.2 +074800 MOVE 25.0 TO CORRECT-N. NC2014.2 +074900 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +075000 PERFORM PRINT-DETAIL. NC2014.2 +075100 MOVE PERFORM14 (3, 20) TO COMPUTED-N. NC2014.2 +075200 MOVE 30.0 TO CORRECT-N. NC2014.2 +075300 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +075400 PERFORM PRINT-DETAIL. NC2014.2 +075500 MOVE PERFORM14 (2, 2) TO COMPUTED-N. NC2014.2 +075600 MOVE 35.0 TO CORRECT-N. NC2014.2 +075700 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +075800 PERFORM PRINT-DETAIL. NC2014.2 +075900 MOVE PERFORM14 (2, 8) TO COMPUTED-N. NC2014.2 +076000 MOVE 40.0 TO CORRECT-N. NC2014.2 +076100 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +076200 PERFORM PRINT-DETAIL. NC2014.2 +076300 MOVE PERFORM14 (2, 14) TO COMPUTED-N. NC2014.2 +076400 MOVE 45.0 TO CORRECT-N. NC2014.2 +076500 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +076600 PERFORM PRINT-DETAIL. NC2014.2 +076700 MOVE PERFORM14 (2, 20) TO COMPUTED-N. NC2014.2 +076800 MOVE 50.0 TO CORRECT-N. NC2014.2 +076900 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +077000 PERFORM PRINT-DETAIL. NC2014.2 +077100 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +077200 MOVE 2 TO CORRECT-N. NC2014.2 +077300 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +077400 PERFORM PRINT-DETAIL. NC2014.2 +077500 MOVE PERFORM3 TO COMPUTED-N. NC2014.2 +077600 MOVE 1 TO CORRECT-N. NC2014.2 +077700 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +077800 PERFORM PRINT-DETAIL. NC2014.2 +077900 MOVE XRAY TO COMPUTED-A. NC2014.2 +078000 MOVE "A" TO CORRECT-A. NC2014.2 +078100 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2014.2 +078200 PFM-WRITE-F4-3. NC2014.2 +078300 PERFORM PRINT-DETAIL. NC2014.2 +078400* NC2014.2 +078500 PFM-INIT-F4-4. NC2014.2 +078600 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +078700 MOVE 2 TO PERFORM9. NC2014.2 +078800 MOVE 2 TO PERFORM10. NC2014.2 +078900 PFM-TEST-F4-4. NC2014.2 +079000* NOTE IN THIS TEST THREE SUBSCRIPTS ARE VARIED. NC2014.2 +079100 PERFORM PFM-L VARYING PERFORM3 FROM PERFORM9 BY 2 NC2014.2 +079200 UNTIL PERFORM3 GREATER THAN 4 AFTER PERFORM2 FROM 10 NC2014.2 +079300 BY -5 UNTIL PERFORM2 EQUAL TO 0 AFTER PERFORM11 NC2014.2 +079400 FROM 3 BY PERFORM10 UNTIL PERFORM11 GREATER THAN 5. NC2014.2 +079500 IF PERFORM16 (2, 10, 3) EQUAL TO 5.0 AND PERFORM16 (2, 10, 5)NC2014.2 +079600 EQUAL TO 5.7 AND PERFORM16 (2, 5, 3) EQUAL TO 6.4 AND NC2014.2 +079700 PERFORM16 (2, 5, 5) EQUAL TO 7.1 AND PERFORM16 (4, 10, 3) NC2014.2 +079800 EQUAL TO 7.8 AND PERFORM16 (4, 10, 5) EQUAL TO 8.5 NC2014.2 +079900 MOVE "B" TO XRAY. IF NC2014.2 +080000 PERFORM16 (4, 5, 3) EQUAL TO 9.2 AND PERFORM16 (4, 5, 5) NC2014.2 +080100 EQUAL TO 9.9 AND PERFORM11 EQUAL TO 3 AND PERFORM2 EQUAL NC2014.2 +080200 TO 10 AND PERFORM3 EQUAL TO 6 AND XRAY EQUAL TO "B" NC2014.2 +080300 PERFORM PASS GO TO PFM-WRITE-F4-4. NC2014.2 +080400 GO TO PFM-FAIL-F4-4. NC2014.2 +080500 PFM-DELETE-F4-4. NC2014.2 +080600 PERFORM DE-LETE. NC2014.2 +080700 GO TO PFM-WRITE-F4-4. NC2014.2 +080800 PFM-FAIL-F4-4. NC2014.2 +080900 MOVE PERFORM16 (2, 10, 3) TO COMPUTED-N. NC2014.2 +081000 MOVE 5.0 TO CORRECT-N. NC2014.2 +081100 PERFORM FAIL. NC2014.2 +081200 PERFORM PRINT-DETAIL. NC2014.2 +081300 MOVE SPACE TO P-OR-F. NC2014.2 +081400 MOVE PERFORM16 (2, 10, 3) TO COMPUTED-N. NC2014.2 +081500 MOVE 5.0 TO CORRECT-N. NC2014.2 +081600 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +081700 PERFORM PRINT-DETAIL. NC2014.2 +081800 MOVE PERFORM16 (2, 10, 5) TO COMPUTED-N. NC2014.2 +081900 MOVE 5.7 TO CORRECT-N. NC2014.2 +082000 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +082100 PERFORM PRINT-DETAIL. NC2014.2 +082200 MOVE PERFORM16 (2, 5, 3) TO COMPUTED-N. NC2014.2 +082300 MOVE 6.4 TO CORRECT-N. NC2014.2 +082400 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +082500 PERFORM PRINT-DETAIL. NC2014.2 +082600 MOVE PERFORM16 (2, 5, 5) TO COMPUTED-N. NC2014.2 +082700 MOVE 7.1 TO CORRECT-N. NC2014.2 +082800 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +082900 PERFORM PRINT-DETAIL. NC2014.2 +083000 MOVE PERFORM16 (4, 10, 3) TO COMPUTED-N. NC2014.2 +083100 MOVE 7.8 TO CORRECT-N. NC2014.2 +083200 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +083300 PERFORM PRINT-DETAIL. NC2014.2 +083400 MOVE PERFORM16 (4, 10, 5) TO COMPUTED-N. NC2014.2 +083500 MOVE 8.5 TO CORRECT-N. NC2014.2 +083600 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +083700 PERFORM PRINT-DETAIL. NC2014.2 +083800 MOVE PERFORM16 (4, 5, 3) TO COMPUTED-N. NC2014.2 +083900 MOVE 9.2 TO CORRECT-N. NC2014.2 +084000 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +084100 PERFORM PRINT-DETAIL. NC2014.2 +084200 MOVE PERFORM16 (4, 5, 5) TO COMPUTED-N. NC2014.2 +084300 MOVE 9.9 TO CORRECT-N. NC2014.2 +084400 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +084500 PERFORM PRINT-DETAIL. NC2014.2 +084600 MOVE PERFORM11 TO COMPUTED-N. NC2014.2 +084700 MOVE 3 TO CORRECT-N. NC2014.2 +084800 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +084900 PERFORM PRINT-DETAIL. NC2014.2 +085000 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +085100 MOVE 10 TO CORRECT-N. NC2014.2 +085200 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +085300 PERFORM PRINT-DETAIL. NC2014.2 +085400 MOVE PERFORM3 TO COMPUTED-N. NC2014.2 +085500 MOVE 6 TO CORRECT-N. NC2014.2 +085600 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +085700 PERFORM PRINT-DETAIL. NC2014.2 +085800 MOVE XRAY TO COMPUTED-A. NC2014.2 +085900 MOVE "B" TO CORRECT-A. NC2014.2 +086000 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2014.2 +086100 PFM-WRITE-F4-4. NC2014.2 +086200 PERFORM PRINT-DETAIL. NC2014.2 +086300 GO TO PFM-CONTINUE. NC2014.2 +086400 PFM-A. NC2014.2 +086500 MULTIPLY PERFORM3 BY 6 GIVING PERFORM2. NC2014.2 +086600 PFM-AA. NC2014.2 +086700 ADD 1 TO PERFORM3. NC2014.2 +086800 PFM-B. NC2014.2 +086900 PERFORM FAIL. NC2014.2 +087000 MOVE "PFM-B ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +087100* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +087200* THE PREVIOUS ONE. NC2014.2 +087300 GO TO PFM-WRITE-F3-1. NC2014.2 +087400 PFM-C. NC2014.2 +087500 ADD 1 TO PERFORM2. NC2014.2 +087600 PFM-D. NC2014.2 +087700 PERFORM FAIL. NC2014.2 +087800 MOVE "PFM-D ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +087900* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +088000* THE PREVIOUS ONE. NC2014.2 +088100 GO TO PFM-WRITE-F3-2. NC2014.2 +088200 PFM-E. NC2014.2 +088300 ADD PERFORM4 3.5 GIVING PERFORM6. NC2014.2 +088400 PFM-F. NC2014.2 +088500 PERFORM FAIL. NC2014.2 +088600 MOVE "PFM-F ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +088700* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +088800* THE PREVIOUS ONE. NC2014.2 +088900 GO TO PFM-WRITE-F4-1. NC2014.2 +089000 PFM-G. NC2014.2 +089100 ADD PERFORM4 8 GIVING PERFORM8 (PERFORM3). NC2014.2 +089200 ADD .3 TO PERFORM4. NC2014.2 +089300 PFM-H. NC2014.2 +089400 PERFORM FAIL. NC2014.2 +089500 MOVE "PFM-H ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +089600* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +089700* THE PREVIOUS ONE. NC2014.2 +089800 GO TO PFM-WRITE-F4-2. NC2014.2 +089900 PFM-I. NC2014.2 +090000 MULTIPLY PERFORM4 BY 10 GIVING PERFORM14 NC2014.2 +090100 (PERFORM3, PERFORM2). NC2014.2 +090200 PFM-J. NC2014.2 +090300 ADD .5 TO PERFORM4. NC2014.2 +090400 PFM-K. NC2014.2 +090500 PERFORM FAIL. NC2014.2 +090600 MOVE "PFM-K ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +090700* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +090800* THE PREVIOUS ONE. NC2014.2 +090900 GO TO PFM-WRITE-F4-3. NC2014.2 +091000 PFM-L. NC2014.2 +091100 SUBTRACT 5.0 FROM PERFORM5 GIVING PERFORM16 NC2014.2 +091200 (PERFORM3, PERFORM2, PERFORM11). NC2014.2 +091300 ADD .7 TO PERFORM5. NC2014.2 +091400 PFM-M. NC2014.2 +091500 PERFORM FAIL. NC2014.2 +091600 MOVE "PFM-M ERRONIOUSLY ENTERED" TO RE-MARK. NC2014.2 +091700* NOTE CONTROL SHOULD NEVER FALL THRU TO THIS PARAGRAPH FROM NC2014.2 +091800* THE PREVIOUS ONE. NC2014.2 +091900 GO TO PFM-WRITE-F4-4. NC2014.2 +092000 PFM-CONTINUE. NC2014.2 +092100 EXIT. NC2014.2 +092200* NC2014.2 +092300 PFM-INIT-F3-3. NC2014.2 +092400 MOVE "PFM-TEST-F3-3 " TO PAR-NAME. NC2014.2 +092500 MOVE "VI-122 6.20.4 GR10(C)" TO ANSI-REFERENCE. NC2014.2 +092600 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +092700 GO TO PFM-TEST-F3-3. NC2014.2 +092800 PFM-A-3-3. NC2014.2 +092900 EXIT. NC2014.2 +093000 PFM-B-3-3. NC2014.2 +093100 ADD 1 TO WRK-DS-02V00. NC2014.2 +093200 PFM-TEST-F3-3. NC2014.2 +093300 PERFORM PFM-A-3-3 THROUGH PFM-B-3-3 UNTIL TEST-2NUC-COND-99. NC2014.2 +093400 IF WRK-DS-02V00 EQUAL TO 99 NC2014.2 +093500 PERFORM PASS GO TO PFM-WRITE-F3-3. NC2014.2 +093600 GO TO PFM-FAIL-F3-3. NC2014.2 +093700 PFM-DELETE-F3-3. NC2014.2 +093800 PERFORM DE-LETE. NC2014.2 +093900 GO TO PFM-WRITE-F3-3. NC2014.2 +094000 PFM-FAIL-F3-3. NC2014.2 +094100 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2014.2 +094200 MOVE 99 TO CORRECT-N. NC2014.2 +094300 PERFORM FAIL. NC2014.2 +094400 PFM-WRITE-F3-3. NC2014.2 +094500 PERFORM PRINT-DETAIL. NC2014.2 +094600* NC2014.2 +094700 PFM-INIT-F4-5. NC2014.2 +094800 MOVE "PFM-TEST-F4-5" TO PAR-NAME. NC2014.2 +094900 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +095000 MOVE ZERO TO WRK-DS-06V06. NC2014.2 +095100 PERFORM PFM-A-4-5 THROUGH PFM-C-4-5 VARYING WRK-DS-02V00 NC2014.2 +095200 FROM 1 BY 1 UNTIL TEST-2NUC-COND-99. NC2014.2 +095300 GO TO PFM-TEST-F4-5. NC2014.2 +095400 PFM-A-4-5. NC2014.2 +095500 ADD 0.000001 TO WRK-DS-06V06. NC2014.2 +095600 PFM-B-4-5. NC2014.2 +095700 ADD 1 TO WRK-DS-06V06. NC2014.2 +095800 PFM-C-4-5. NC2014.2 +095900 SUBTRACT 1 FROM WRK-DS-06V06. NC2014.2 +096000 PFM-TEST-F4-5. NC2014.2 +096100 ADD WRK-DS-02V00 TO WRK-DS-06V06. NC2014.2 +096200 IF WRK-DS-06V06 EQUAL TO 99.000098 NC2014.2 +096300 PERFORM PASS GO TO PFM-WRITE-F4-5. NC2014.2 +096400 GO TO PFM-FAIL-F4-5. NC2014.2 +096500 PFM-DELETE-F4-5. NC2014.2 +096600 PERFORM DE-LETE. NC2014.2 +096700 GO TO PFM-WRITE-F4-5. NC2014.2 +096800 PFM-FAIL-F4-5. NC2014.2 +096900 MOVE WRK-DS-06V06 TO COMPUTED-N. NC2014.2 +097000 MOVE 99.000098 TO CORRECT-N. NC2014.2 +097100 PERFORM FAIL. NC2014.2 +097200 PFM-WRITE-F4-5. NC2014.2 +097300 PERFORM PRINT-DETAIL. NC2014.2 +097400* NC2014.2 +097500 PFM-INIT-F4-6. NC2014.2 +097600 MOVE "PFM-TEST-F4-6" TO PAR-NAME. NC2014.2 +097700 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +097800 MOVE ZERO TO WRK-DS-06V06. NC2014.2 +097900 PERFORM PFM-A-4-6 VARYING WRK-DS-02V00 FROM A02TWOS-DS-02V00NC2014.2 +098000 BY A02TWOS-DS-02V00 UNTIL (WRK-DS-02V00 + 12) = 100.NC2014.2 +098100 PFM-A-4-6. NC2014.2 +098200 ADD 0.000001 TO WRK-DS-06V06. NC2014.2 +098300 PFM-TEST-F4-6. NC2014.2 +098400 ADD WRK-DS-02V00 TO WRK-DS-06V06. NC2014.2 +098500 IF WRK-DS-06V06 EQUAL TO 88.000004 NC2014.2 +098600 PERFORM PASS GO TO PFM-WRITE-F4-6. NC2014.2 +098700 GO TO PFM-FAIL-F4-6. NC2014.2 +098800 PFM-DELETE-F4-6. NC2014.2 +098900 PERFORM DE-LETE. NC2014.2 +099000 GO TO PFM-WRITE-F4-6. NC2014.2 +099100 PFM-FAIL-F4-6. NC2014.2 +099200 MOVE WRK-DS-06V06 TO COMPUTED-N. NC2014.2 +099300 MOVE 88.000004 TO CORRECT-N. NC2014.2 +099400 PERFORM FAIL. NC2014.2 +099500 PFM-WRITE-F4-6. NC2014.2 +099600 PERFORM PRINT-DETAIL. NC2014.2 +099700* NC2014.2 +099800 PFM-INIT-F4-7. NC2014.2 +099900 MOVE "PFM-TEST-F4-7" TO PAR-NAME. NC2014.2 +100000 GO TO PFM-TEST-F4-7. NC2014.2 +100100 PFM-A-10. NC2014.2 +100200 EXIT. NC2014.2 +100300 PFM-TEST-F4-7. NC2014.2 +100400 PERFORM PFM-A-10 NC2014.2 +100500 VARYING PERFORM4 NC2014.2 +100600 FROM -5.5 NC2014.2 +100700 BY 0.1 NC2014.2 +100800 UNTIL PERFORM4 > 90. NC2014.2 +100900 IF PERFORM4 EQUAL TO 90.1 NC2014.2 +101000 PERFORM PASS GO TO PFM-WRITE-F4-7. NC2014.2 +101100 GO TO PFM-FAIL-F4-7. NC2014.2 +101200* NOTE PFM-A-10 SHOULD BE "EXECUTED" UNTIL PERFORM4 IS 90.1NC2014.2 +101300* EVEN THOUGH PFM-A-10 IS NOTHING BUT AN EXIT. NC2014.2 +101400 PFM-DELETE-F4-7. NC2014.2 +101500 PERFORM DE-LETE. NC2014.2 +101600 GO TO PFM-WRITE-F4-7. NC2014.2 +101700 PFM-FAIL-F4-7. NC2014.2 +101800 PERFORM FAIL. NC2014.2 +101900 MOVE PERFORM4 TO COMPUTED-N. NC2014.2 +102000 MOVE 90.1 TO CORRECT-N. NC2014.2 +102100 PFM-WRITE-F4-7. NC2014.2 +102200 PERFORM PRINT-DETAIL. NC2014.2 +102300* NC2014.2 +102400 PFM-INIT-F4-8. NC2014.2 +102500 MOVE "PFM-TEST-F4-8" TO PAR-NAME. NC2014.2 +102600 MOVE ZERO TO PFM-11-COUNTER. NC2014.2 +102700 MOVE ZERO TO SWITCH-PFM-1. NC2014.2 +102800* NOTE THIS AUDIT ROUTINE TESTS NESTED PERFORMS NC2014.2 +102900* IF THE PROGRAM CANNOT SET RETURNS AT THE PROPER PLACE NC2014.2 +103000* OR EXECUTE THEM IN PROPER SEQUENCE A FAIL WILL NC2014.2 +103100* RESULT. NC2014.2 +103200 PFM-TEST-F4-8. NC2014.2 +103300 GO TO PFM-PART-A. NC2014.2 +103400 PFM-DELETE-F4-8. NC2014.2 +103500 PERFORM DE-LETE. NC2014.2 +103600 GO TO PFM-WRITE-F4-8. NC2014.2 +103700 PFM-PART-A SECTION. NC2014.2 +103800 PARA-PART-A. NC2014.2 +103900 IF SWITCH-PFM-1 = 1 NC2014.2 +104000 GO TO PFM-SEC-A3. NC2014.2 +104100 PFM-SEC-A2. NC2014.2 +104200 PERFORM PFM-SEC-B1 THRU PFM-SEC-B6. NC2014.2 +104300 GO TO PFM-SEC-A4. NC2014.2 +104400 PFM-SEC-A3. NC2014.2 +104500 ADD 2 TO PFM-11-COUNTER. NC2014.2 +104600 MOVE 1 TO SWITCH-PFM-2. NC2014.2 +104700 PERFORM PFM-SEC-B1 THRU PFM-SEC-B5. NC2014.2 +104800 PFM-SEC-A4. NC2014.2 +104900 EXIT. NC2014.2 +105000 PFM-PART-B SECTION. NC2014.2 +105100 PFM-SEC-B1. NC2014.2 +105200 MULTIPLY PFM-11-COUNTER BY 10 GIVING PFM-11-COUNTER. NC2014.2 +105300 IF SWITCH-PFM-2 EQUAL TO 1 NC2014.2 +105400 GO TO PFM-SEC-B5. NC2014.2 +105500 PFM-SEC-B2. NC2014.2 +105600 MOVE 1 TO SWITCH-PFM-1. NC2014.2 +105700 PFM-SEC-B3. NC2014.2 +105800 PERFORM PFM-PART-A. NC2014.2 +105900 PFM-SEC-B4. NC2014.2 +106000 EXIT. NC2014.2 +106100 PFM-SEC-B5. NC2014.2 +106200 EXIT. NC2014.2 +106300 PFM-SEC-B6. NC2014.2 +106400 EXIT. NC2014.2 +106500 PFM-SEC-B7. NC2014.2 +106600 EXIT. NC2014.2 +106700 PFM-SEC-STOP. NC2014.2 +106800 IF PFM-11-COUNTER EQUAL TO 200 NC2014.2 +106900 PERFORM PASS NC2014.2 +107000 GO TO PFM-WRITE-F4-8. NC2014.2 +107100 PERFORM FAIL. NC2014.2 +107200 MOVE "200" TO CORRECT-A. NC2014.2 +107300 MOVE PFM-11-COUNTER TO COMPUTED-A. NC2014.2 +107400 PFM-WRITE-F4-8. NC2014.2 +107500 PERFORM PRINT-DETAIL. NC2014.2 +107600* NC2014.2 +107700 PFM-INIT-F4-9. NC2014.2 +107800 MOVE "PFM-TEST-F4-9" TO PAR-NAME. NC2014.2 +107900 ADD 44 TO PFM-12-ANS1. NC2014.2 +108000 ADD 46 TO PFM-12-ANS2. NC2014.2 +108100* NOTE THIS PROGRAM TESTS THE ABILITY OF THE COMPILER TO NC2014.2 +108200* PERFORM A STATEMENT WITH A VARYING CLAUSE INCLUDED. NC2014.2 +108300 GO TO PFM-TEST-F4-9. NC2014.2 +108400 PFM-F4-9-A. NC2014.2 +108500 ADD 1 TO PFM-12-ANS2. NC2014.2 +108600 SUBTRACT 2 FROM PFM-12-ANS1. NC2014.2 +108700 IF PFM-12-ANS2 LESS THAN PFM-12-ANS1 NC2014.2 +108800 GO TO PFM-F4-9-B ELSE NC2014.2 +108900 DIVIDE PFM-12-COUNTER BY 2 GIVING PFM-12-COUNTER. NC2014.2 +109000 IF PFM-12-COUNTER LESS THAN 36 SUBTRACT 4 FROM NC2014.2 +109100 PFM-12-COUNTER. NC2014.2 +109200 PFM-F4-9-B. NC2014.2 +109300 EXIT. NC2014.2 +109400 PFM-TEST-F4-9. NC2014.2 +109500 PERFORM PFM-F4-9-A VARYING PFM-12-COUNTER FROM 100 BY 4 NC2014.2 +109600 UNTIL PFM-12-COUNTER NOT GREATER THAN 15 NC2014.2 +109700 AND PFM-12-ANS1 LESS THAN PFM-12-ANS2 NC2014.2 +109800 OR PFM-12-ANS2 GREATER THAN 50. NC2014.2 +109900 IF PFM-12-COUNTER EQUAL TO 13 NC2014.2 +110000 PERFORM PASS NC2014.2 +110100 GO TO PFM-WRITE-F4-9. NC2014.2 +110200 GO TO PFM-FAIL-F4-9. NC2014.2 +110300 PFM-DELETE-F4-9. NC2014.2 +110400 PERFORM DE-LETE. NC2014.2 +110500 GO TO PFM-WRITE-F4-9. NC2014.2 +110600 PFM-FAIL-F4-9. NC2014.2 +110700 PERFORM FAIL. NC2014.2 +110800 MOVE PFM-12-COUNTER TO COMPUTED-A. NC2014.2 +110900 MOVE "13" TO CORRECT-A. NC2014.2 +111000 PFM-WRITE-F4-9. NC2014.2 +111100 PERFORM PRINT-DETAIL. NC2014.2 +111200* NC2014.2 +111300 PFM-INIT-F4-10. NC2014.2 +111400 MOVE "PFM-TEST-F4-10" TO PAR-NAME. NC2014.2 +111500 MOVE 0 TO PERFORM18. NC2014.2 +111600 MOVE 1 TO START-POINT. NC2014.2 +111700 MOVE 3 TO INC-VALUE. NC2014.2 +111800 GO TO PFM-TEST-F4-10. NC2014.2 +111900 PFM-F4-10-A. NC2014.2 +112000 ADD 1 TO PERFORM18. NC2014.2 +112100 ADD 3 TO PERFORM17. NC2014.2 +112200* NOTE MANIPULATING PERFORM17 IS SUPPOSED TO AFFECT THE NC2014.2 +112300* NUMBER OF TIMES THIS PARAGRAPH IS PERFORMED --- IN NC2014.2 +112400* PARTICULAR PFM-F4-10-A WOULD HAVE BEEN EXECUTED 15 NC2014.2 +112500* TIMES WITHOUT THE ABOVE ADDITION TO PERFORM17, BUT NC2014.2 +112600* IN FACT IT SHOULD NOW BE EXECUTED ONLY 8 TIMES. NC2014.2 +112700 PFM-TEST-F4-10. NC2014.2 +112800 PERFORM PFM-F4-10-A NC2014.2 +112900 VARYING PERFORM17 NC2014.2 +113000 FROM START-POINT NC2014.2 +113100 BY INC-VALUE NC2014.2 +113200 UNTIL PERFORM17 GREATER THAN 45 NC2014.2 +113300 IF PERFORM18 EQUAL TO 8 PERFORM PASS NC2014.2 +113400 GO TO PFM-WRITE-F4-10. NC2014.2 +113500 GO TO PFM-FAIL-F4-10. NC2014.2 +113600 PFM-DELETE-F4-10. NC2014.2 +113700 PERFORM DE-LETE. NC2014.2 +113800 GO TO PFM-WRITE-F4-10. NC2014.2 +113900 PFM-FAIL-F4-10. NC2014.2 +114000 PERFORM FAIL. NC2014.2 +114100 MOVE PERFORM18 TO COMPUTED-N. NC2014.2 +114200 MOVE 8 TO CORRECT-N. NC2014.2 +114300 PFM-WRITE-F4-10. NC2014.2 +114400 PERFORM PRINT-DETAIL. NC2014.2 +114500* NC2014.2 +114600 PFM-INIT-F4-11. NC2014.2 +114700 MOVE "PFM-TEST-F4-11" TO PAR-NAME. NC2014.2 +114800 MOVE 0 TO PERFORM18. NC2014.2 +114900 MOVE 1 TO START-POINT. NC2014.2 +115000 MOVE 3 TO INC-VALUE. NC2014.2 +115100 GO TO PFM-TEST-F4-11. NC2014.2 +115200 PFM-F4-11-A. NC2014.2 +115300 ADD 1 TO PERFORM18. NC2014.2 +115400 MOVE 46 TO START-POINT. NC2014.2 +115500* NOTE THE ABOVE MOVE HAS NO EFFECT ON THE NUMBER OF TIMES NC2014.2 +115600* PFM-F4-11-A IS EXECUTED (15). NC2014.2 +115700 PFM-TEST-F4-11. NC2014.2 +115800 PERFORM PFM-F4-11-A NC2014.2 +115900 VARYING PERFORM17 NC2014.2 +116000 FROM START-POINT NC2014.2 +116100 BY INC-VALUE NC2014.2 +116200 UNTIL PERFORM17 GREATER THAN 45 NC2014.2 +116300 IF PERFORM18 EQUAL TO 15 PERFORM PASS NC2014.2 +116400 GO TO PFM-WRITE-F4-11. NC2014.2 +116500 GO TO PFM-FAIL-F4-11. NC2014.2 +116600 PFM-DELETE-F4-11. NC2014.2 +116700 PERFORM DE-LETE. NC2014.2 +116800 GO TO PFM-WRITE-F4-11. NC2014.2 +116900 PFM-FAIL-F4-11. NC2014.2 +117000 PERFORM FAIL. NC2014.2 +117100 MOVE PERFORM18 TO COMPUTED-N. NC2014.2 +117200 MOVE 15 TO CORRECT-N. NC2014.2 +117300 PFM-WRITE-F4-11. NC2014.2 +117400 PERFORM PRINT-DETAIL. NC2014.2 +117500* NC2014.2 +117600 PFM-INIT-F4-12. NC2014.2 +117700 MOVE "PFM-TEST-F4-12" TO PAR-NAME. NC2014.2 +117800 MOVE 0 TO PERFORM18. NC2014.2 +117900 MOVE 1 TO START-POINT. NC2014.2 +118000 MOVE 3 TO INC-VALUE. NC2014.2 +118100 GO TO PFM-TEST-F4-12. NC2014.2 +118200 PFM-F4-12-A. NC2014.2 +118300 ADD 1 TO PERFORM18. NC2014.2 +118400 ADD 1 TO INC-VALUE. NC2014.2 +118500* NOTE THE ABOVE ADD TO INC-VALUE SHOULD ACCELERATE THE NC2014.2 +118600* SPEED AT WHICH PERFORM17 APPROACHES 46 --- THEREFORENC2014.2 +118700* PFM-F4-12-A IS EXECUTED ONLY 7 TIMES INSTEAD OF 15. NC2014.2 +118800 PFM-TEST-F4-12. NC2014.2 +118900 PERFORM PFM-F4-12-A NC2014.2 +119000 VARYING PERFORM17 NC2014.2 +119100 FROM START-POINT NC2014.2 +119200 BY INC-VALUE NC2014.2 +119300 UNTIL PERFORM17 GREATER THAN 45 NC2014.2 +119400 IF PERFORM18 EQUAL TO 7 PERFORM PASS NC2014.2 +119500 GO TO PFM-WRITE-F4-12. NC2014.2 +119600 GO TO PFM-FAIL-F4-12. NC2014.2 +119700 PFM-DELETE-F4-12. NC2014.2 +119800 PERFORM DE-LETE. NC2014.2 +119900 GO TO PFM-WRITE-F4-12. NC2014.2 +120000 PFM-FAIL-F4-12. NC2014.2 +120100 PERFORM FAIL. NC2014.2 +120200 MOVE PERFORM18 TO COMPUTED-N. NC2014.2 +120300 MOVE 7 TO CORRECT-N. NC2014.2 +120400 PFM-WRITE-F4-12. NC2014.2 +120500 PERFORM PRINT-DETAIL. NC2014.2 +120600 PFM-INIT-F3-4. NC2014.2 +120700* ===--> "TEST BEFORE" PHRASE <--=== NC2014.2 +120800 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +120900 MOVE 1 TO PERFORM2. NC2014.2 +121000* NOTE IN THIS TEST THE CONDITION IS NOT SATISFIED NC2014.2 +121100* ORIGINALLY WHEN THE PERFORM IS ENTERED. NC2014.2 +121200 PFM-TEST-F3-4-0. NC2014.2 +121300 PERFORM PFM-A THRU PFM-AA TEST BEFORE NC2014.2 +121400 UNTIL PERFORM2 EQUAL TO 48. NC2014.2 +121500 PFM-TEST-F3-4-1. NC2014.2 +121600 IF PERFORM2 EQUAL TO 48 PERFORM PASS GO TO PFM-WRITE-F3-4. NC2014.2 +121700 GO TO PFM-FAIL-F3-4. NC2014.2 +121800 PFM-DELETE-F3-4. NC2014.2 +121900 PERFORM DE-LETE. NC2014.2 +122000 GO TO PFM-WRITE-F3-4. NC2014.2 +122100 PFM-FAIL-F3-4. NC2014.2 +122200 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +122300 MOVE 48 TO CORRECT-N. NC2014.2 +122400 PERFORM FAIL. NC2014.2 +122500 PFM-WRITE-F3-4. NC2014.2 +122600 MOVE "PFM-TEST-F3-4" TO PAR-NAME. NC2014.2 +122700 PERFORM PRINT-DETAIL. NC2014.2 +122800 PFM-INIT-F3-5. NC2014.2 +122900* ===--> "TEST BEFORE" PHRASE <--=== NC2014.2 +123000 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +123100 MOVE 50 TO PERFORM2. NC2014.2 +123200* NOTE IN THIS TEST CONDITION IS SATISFIED WHEN PERFORM IS NC2014.2 +123300* ENTERED AND CONTROL SHOULD NOT BE PASSED TO PFM-C. NC2014.2 +123400 PFM-TEST-F3-5-0. NC2014.2 +123500 PERFORM PFM-F3-5-C TEST BEFORE NC2014.2 +123600 UNTIL PERFORM2 GREATER THAN 25. NC2014.2 +123700 PFM-TEST-F3-5-1. NC2014.2 +123800 IF PERFORM2 EQUAL TO 50 PERFORM PASS GO TO PFM-WRITE-F3-5. NC2014.2 +123900 GO TO PFM-FAIL-F3-5. NC2014.2 +124000 PFM-DELETE-F3-5. NC2014.2 +124100 PERFORM DE-LETE. NC2014.2 +124200 GO TO PFM-WRITE-F3-5. NC2014.2 +124300 PFM-F3-5-C. NC2014.2 +124400 ADD 1 TO PERFORM2. NC2014.2 +124500 PFM-FAIL-F3-5. NC2014.2 +124600 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +124700 MOVE 50 TO CORRECT-N. NC2014.2 +124800 PERFORM FAIL. NC2014.2 +124900 PFM-WRITE-F3-5. NC2014.2 +125000 MOVE "PFM-TEST-F3-5" TO PAR-NAME. NC2014.2 +125100 PERFORM PRINT-DETAIL. NC2014.2 +125200 PFM-INIT-F3-6. NC2014.2 +125300* ===--> "TEST BEFORE" PHRASE <--=== NC2014.2 +125400 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +125500 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +125600 PFM-TEST-F3-6-0. NC2014.2 +125700 PERFORM PFM-A-F3-6 THROUGH PFM-B-F3-6 NC2014.2 +125800 WITH TEST BEFORE NC2014.2 +125900 UNTIL TEST-2NUC-COND-99. NC2014.2 +126000 PFM-TEST-F3-6. NC2014.2 +126100 GO TO PFM-TESTT-F3-6. NC2014.2 +126200 PFM-A-F3-6. NC2014.2 +126300 EXIT. NC2014.2 +126400 PFM-B-F3-6. NC2014.2 +126500 ADD 1 TO WRK-DS-02V00. NC2014.2 +126600 PFM-TESTT-F3-6. NC2014.2 +126700 IF WRK-DS-02V00 EQUAL TO 99 NC2014.2 +126800 PERFORM PASS GO TO PFM-WRITE-F3-6. NC2014.2 +126900 GO TO PFM-FAIL-F3-6. NC2014.2 +127000 PFM-DELETE-F3-6. NC2014.2 +127100 PERFORM DE-LETE. NC2014.2 +127200 GO TO PFM-WRITE-F3-6. NC2014.2 +127300 PFM-FAIL-F3-6. NC2014.2 +127400 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2014.2 +127500 MOVE 99 TO CORRECT-N. NC2014.2 +127600 PERFORM FAIL. NC2014.2 +127700 PFM-WRITE-F3-6. NC2014.2 +127800 MOVE "PFM-TEST-F3-6 " TO PAR-NAME. NC2014.2 +127900 PERFORM PRINT-DETAIL. NC2014.2 +128000 PFM-INIT-F3-7. NC2014.2 +128100* ===--> "TEST AFTER" PHRASE <--=== NC2014.2 +128200 MOVE "VI-112 6.20.4 GR10(C)" TO ANSI-REFERENCE. NC2014.2 +128300 MOVE 1 TO PERFORM2. NC2014.2 +128400 MOVE 5 TO PERFORM3. NC2014.2 +128500* NOTE IN THIS TEST THE CONDITION IS NOT SATISFIED NC2014.2 +128600* ORIGINALLY WHEN THE PERFORM IS ENTERED. NC2014.2 +128700 PFM-TEST-F3-7-0. NC2014.2 +128800 PERFORM PFM-A THRU PFM-AA TEST AFTER NC2014.2 +128900 UNTIL PERFORM2 EQUAL TO 48. NC2014.2 +129000 PFM-TEST-F3-7-1. NC2014.2 +129100 IF PERFORM2 EQUAL TO 48 PERFORM PASS GO TO PFM-WRITE-F3-7. NC2014.2 +129200 GO TO PFM-FAIL-F3-7. NC2014.2 +129300 PFM-DELETE-F3-7. NC2014.2 +129400 PERFORM DE-LETE. NC2014.2 +129500 GO TO PFM-WRITE-F3-7. NC2014.2 +129600 PFM-FAIL-F3-7. NC2014.2 +129700 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +129800 MOVE 48 TO CORRECT-N. NC2014.2 +129900 PERFORM FAIL. NC2014.2 +130000 PFM-WRITE-F3-7. NC2014.2 +130100 MOVE "PFM-TEST-F3-7" TO PAR-NAME. NC2014.2 +130200 PERFORM PRINT-DETAIL. NC2014.2 +130300 PFM-INIT-F3-8. NC2014.2 +130400* ===--> "TEST AFTER" PHRASE <--=== NC2014.2 +130500 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +130600 MOVE 50 TO PERFORM2. NC2014.2 +130700* NOTE IN THIS TEST CONDITION IS SATISFIED AFTER PERFORM IS NC2014.2 +130800* ENTERED AND CONTROL SHOULD BE PASSED TO PFM-C ONCE. NC2014.2 +130900 PFM-TEST-F3-8-0. NC2014.2 +131000 PERFORM PFM-F3-8-C TEST AFTER NC2014.2 +131100 UNTIL PERFORM2 GREATER THAN 25. NC2014.2 +131200 PFM-TEST-F3-8-1. NC2014.2 +131300 IF PERFORM2 EQUAL TO 51 PERFORM PASS GO TO PFM-WRITE-F3-8. NC2014.2 +131400 GO TO PFM-FAIL-F3-8. NC2014.2 +131500 PFM-DELETE-F3-8. NC2014.2 +131600 PERFORM DE-LETE. NC2014.2 +131700 GO TO PFM-WRITE-F3-8. NC2014.2 +131800 PFM-F3-8-C. NC2014.2 +131900 ADD 1 TO PERFORM2. NC2014.2 +132000 PFM-FAIL-F3-8. NC2014.2 +132100 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +132200 MOVE 51 TO CORRECT-N. NC2014.2 +132300 PERFORM FAIL. NC2014.2 +132400 PFM-WRITE-F3-8. NC2014.2 +132500 MOVE "PFM-TEST-F3-8" TO PAR-NAME. NC2014.2 +132600 PERFORM PRINT-DETAIL. NC2014.2 +132700 PFM-INIT-F3-9. NC2014.2 +132800* ===--> "TEST AFTER " PHRASE <--=== NC2014.2 +132900 MOVE "VI-112 6.20.2 GR10" TO ANSI-REFERENCE. NC2014.2 +133000 MOVE ZERO TO WRK-DS-02V00. NC2014.2 +133100 PFM-TEST-F3-9-0. NC2014.2 +133200 PERFORM PFM-A-F3-9 THROUGH PFM-B-F3-9 NC2014.2 +133300 WITH TEST AFTER NC2014.2 +133400 UNTIL TEST-2NUC-COND-99. NC2014.2 +133500 PFM-TEST-F3-9. NC2014.2 +133600 GO TO PFM-TESTT-F3-9. NC2014.2 +133700 PFM-A-F3-9. NC2014.2 +133800 EXIT. NC2014.2 +133900 PFM-B-F3-9. NC2014.2 +134000 ADD 1 TO WRK-DS-02V00. NC2014.2 +134100 PFM-TESTT-F3-9. NC2014.2 +134200 IF WRK-DS-02V00 EQUAL TO 99 NC2014.2 +134300 PERFORM PASS GO TO PFM-WRITE-F3-9. NC2014.2 +134400 GO TO PFM-FAIL-F3-9. NC2014.2 +134500 PFM-DELETE-F3-9. NC2014.2 +134600 PERFORM DE-LETE. NC2014.2 +134700 GO TO PFM-WRITE-F3-9. NC2014.2 +134800 PFM-FAIL-F3-9. NC2014.2 +134900 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2014.2 +135000 MOVE 99 TO CORRECT-N. NC2014.2 +135100 PERFORM FAIL. NC2014.2 +135200 PFM-WRITE-F3-9. NC2014.2 +135300 MOVE "PFM-TEST-F3-9" TO PAR-NAME. NC2014.2 +135400 PERFORM PRINT-DETAIL. NC2014.2 +135500* NC2014.2 +135600 PFM-INIT-F4-13. NC2014.2 +135700* ===--> "WITH TEST BEFORE" PHRASE <--=== NC2014.2 +135800 MOVE "VI-114 6.20.4 GR10(d)1" TO ANSI-REFERENCE. NC2014.2 +135900 MOVE 20 TO PERFORM2. NC2014.2 +136000 MOVE 9 TO PERFORM3. NC2014.2 +136100 MOVE 1.5 TO PERFORM4. NC2014.2 +136200 MOVE 3 TO PERFORM9. NC2014.2 +136300 MOVE -1 TO PERFORM10. NC2014.2 +136400 MOVE 6 TO PERFORM11. NC2014.2 +136500 MOVE ZEROS TO PERFORM12. NC2014.2 +136600 MOVE SPACE TO XRAY. NC2014.2 +136700* NOTE IN THIS TEST TWO SUBSCRIPTS ARE VARIED. NC2014.2 +136800 PFM-TEST-F4-13-0. NC2014.2 +136900 PERFORM PFM-I-F4-13 THRU PFM-J-F4-13 WITH TEST BEFORE NC2014.2 +137000 VARYING PERFORM3 FROM PERFORM9 BY PERFORM10 NC2014.2 +137100 UNTIL PERFORM3 EQUAL TO 1 NC2014.2 +137200 AFTER PERFORM2 FROM 2 BY PERFORM11 NC2014.2 +137300 UNTIL PERFORM2 GREATER THAN 20. NC2014.2 +137400 GO TO PFM-TEST-F4-13-1. NC2014.2 +137500 PFM-I-F4-13. NC2014.2 +137600 MULTIPLY PERFORM4 BY 10 GIVING PERFORM14 NC2014.2 +137700 (PERFORM3, PERFORM2). NC2014.2 +137800 PFM-J-F4-13. NC2014.2 +137900 ADD .5 TO PERFORM4. NC2014.2 +138000 PFM-TEST-F4-13-1. NC2014.2 +138100 IF PERFORM14 (3, 2) EQUAL TO 15.0 AND PERFORM14 (3, 8) NC2014.2 +138200 EQUAL TO 20.0 AND PERFORM14 (3, 14) EQUAL TO 25.0 NC2014.2 +138300 AND PERFORM14 (3, 20) EQUAL TO 30.0 AND PERFORM14 (2, 2) NC2014.2 +138400 EQUAL TO 35.0 MOVE "A" TO XRAY. NC2014.2 +138500 IF PERFORM14 (2, 8) EQUAL TO 40.0 AND NC2014.2 +138600 PERFORM14 (2, 14) EQUAL TO 45.0 AND PERFORM14 (2, 20) NC2014.2 +138700 EQUAL TO 50.0 AND PERFORM2 EQUAL TO 2 AND PERFORM3 NC2014.2 +138800 EQUAL TO 1 AND XRAY EQUAL TO "A" PERFORM PASS NC2014.2 +138900 GO TO PFM-WRITE-F4-13. NC2014.2 +139000 GO TO PFM-FAIL-F4-13. NC2014.2 +139100 PFM-DELETE-F4-13. NC2014.2 +139200 PERFORM DE-LETE. NC2014.2 +139300 GO TO PFM-WRITE-F4-13. NC2014.2 +139400 PFM-FAIL-F4-13. NC2014.2 +139500 MOVE PERFORM14 (3, 2) TO COMPUTED-N. NC2014.2 +139600 MOVE 15.0 TO CORRECT-N. NC2014.2 +139700 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +139800 PERFORM FAIL. NC2014.2 +139900 PERFORM PRINT-DETAIL. NC2014.2 +140000 MOVE SPACE TO P-OR-F. NC2014.2 +140100 MOVE PERFORM14 (3, 8) TO COMPUTED-N. NC2014.2 +140200 MOVE 20.0 TO CORRECT-N. NC2014.2 +140300 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +140400 PERFORM PRINT-DETAIL. NC2014.2 +140500 MOVE PERFORM14 (3, 14) TO COMPUTED-N. NC2014.2 +140600 MOVE 25.0 TO CORRECT-N. NC2014.2 +140700 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +140800 PERFORM PRINT-DETAIL. NC2014.2 +140900 MOVE PERFORM14 (3, 20) TO COMPUTED-N. NC2014.2 +141000 MOVE 30.0 TO CORRECT-N. NC2014.2 +141100 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +141200 PERFORM PRINT-DETAIL. NC2014.2 +141300 MOVE PERFORM14 (2, 2) TO COMPUTED-N. NC2014.2 +141400 MOVE 35.0 TO CORRECT-N. NC2014.2 +141500 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +141600 PERFORM PRINT-DETAIL. NC2014.2 +141700 MOVE PERFORM14 (2, 8) TO COMPUTED-N. NC2014.2 +141800 MOVE 40.0 TO CORRECT-N. NC2014.2 +141900 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +142000 PERFORM PRINT-DETAIL. NC2014.2 +142100 MOVE PERFORM14 (2, 14) TO COMPUTED-N. NC2014.2 +142200 MOVE 45.0 TO CORRECT-N. NC2014.2 +142300 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +142400 PERFORM PRINT-DETAIL. NC2014.2 +142500 MOVE PERFORM14 (2, 20) TO COMPUTED-N. NC2014.2 +142600 MOVE 50.0 TO CORRECT-N. NC2014.2 +142700 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +142800 PERFORM PRINT-DETAIL. NC2014.2 +142900 MOVE PERFORM2 TO COMPUTED-N. NC2014.2 +143000 MOVE 2 TO CORRECT-N. NC2014.2 +143100 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +143200 PERFORM PRINT-DETAIL. NC2014.2 +143300 MOVE PERFORM3 TO COMPUTED-N. NC2014.2 +143400 MOVE 1 TO CORRECT-N. NC2014.2 +143500 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +143600 PERFORM PRINT-DETAIL. NC2014.2 +143700 MOVE XRAY TO COMPUTED-A. NC2014.2 +143800 MOVE "A" TO CORRECT-A. NC2014.2 +143900 PFM-WRITE-F4-13. NC2014.2 +144000 MOVE "PFM-TEST-F4-13" TO PAR-NAME. NC2014.2 +144100 PERFORM PRINT-DETAIL. NC2014.2 +144200* NC2014.2 +144300 PFM-INIT-F4-14. NC2014.2 +144400* ===--> "WITH TEST AFTER" PHRASE <--=== NC2014.2 +144500 MOVE "VI-117/8 6.20.4 GR10(d)2" TO ANSI-REFERENCE. NC2014.2 +144600 MOVE "PFM-TEST-F4-14" TO PAR-NAME. NC2014.2 +144700 MOVE ZEROS TO PERFORM12. NC2014.2 +144800 MOVE SPACE TO XRAY. NC2014.2 +144900 MOVE 6 TO PERFORM11. NC2014.2 +145000 MOVE -1 TO PERFORM10. NC2014.2 +145100 MOVE 2 TO PERFORM9. NC2014.2 +145200 MOVE 1 TO PERFORM4. NC2014.2 +145300 MOVE 2 TO PERFORM3. NC2014.2 +145400 MOVE 20 TO PERFORM2. NC2014.2 +145500 MOVE 1 TO REC-CT. NC2014.2 +145600* NOTE: IN THIS TEST TWO SUBSCRIPTS ARE VARIED. NC2014.2 +145700 PFM-TEST-F4-14-0. NC2014.2 +145800 PERFORM PFM-I-F4-14 THRU PFM-J-F4-14 WITH TEST AFTER NC2014.2 +145900 VARYING PERFORM3 FROM PERFORM9 BY PERFORM10 NC2014.2 +146000 UNTIL PERFORM3 EQUAL TO 1 NC2014.2 +146100 AFTER PERFORM2 FROM 2 BY PERFORM11 NC2014.2 +146200 UNTIL PERFORM2 GREATER THAN 19. NC2014.2 +146300 GO TO PFM-TEST-F4-14-1. NC2014.2 +146400 PFM-I-F4-14. NC2014.2 +146500 MULTIPLY PERFORM4 BY 10 GIVING PERFORM14 NC2014.2 +146600 (PERFORM3, PERFORM2). NC2014.2 +146700 PFM-J-F4-14. NC2014.2 +146800 ADD .5 TO PERFORM4. NC2014.2 +146900 MOVE 1 TO PERFORM3. NC2014.2 +147000 MOVE 99 TO PERFORM2. NC2014.2 +147100 PFM-DELETE-F4-14. NC2014.2 +147200 PERFORM DE-LETE. NC2014.2 +147300 PERFORM PRINT-DETAIL. NC2014.2 +147400 GO TO PFM-INIT-F4-15. NC2014.2 +147500 PFM-TEST-F4-14-1. NC2014.2 +147600 MOVE "PFM-TEST-F4-14-1" TO PAR-NAME. NC2014.2 +147700 IF PERFORM14 (2, 2) NOT EQUAL TO 10.0 NC2014.2 +147800 MOVE PERFORM14 (2, 2) TO COMPUTED-N NC2014.2 +147900 MOVE 10.0 TO CORRECT-N NC2014.2 +148000 PERFORM FAIL NC2014.2 +148100 PERFORM PRINT-DETAIL NC2014.2 +148200 ELSE NC2014.2 +148300 PERFORM PASS NC2014.2 +148400 PERFORM PRINT-DETAIL. NC2014.2 +148500 MOVE SPACE TO P-OR-F. NC2014.2 +148600 ADD 1 TO REC-CT. NC2014.2 +148700 PFM-TEST-F4-14-2. NC2014.2 +148800 MOVE "PFM-TEST-F4-14-2" TO PAR-NAME. NC2014.2 +148900 IF PERFORM4 NOT = 1.5 NC2014.2 +149000 MOVE PERFORM4 TO COMPUTED-N NC2014.2 +149100 MOVE 1.5 TO CORRECT-N NC2014.2 +149200 PERFORM FAIL NC2014.2 +149300 PERFORM PRINT-DETAIL NC2014.2 +149400 ELSE NC2014.2 +149500 PERFORM PASS NC2014.2 +149600 PERFORM PRINT-DETAIL. NC2014.2 +149700* NC2014.2 +149800 PFM-INIT-F4-15. NC2014.2 +149900* ===--> " TEST AFTER " PHRASE <--=== NC2014.2 +150000 MOVE "VI-117/8 6.20.4 GR10(d)2" TO ANSI-REFERENCE. NC2014.2 +150100 MOVE "PFM-TEST-F4-15" TO PAR-NAME. NC2014.2 +150200 MOVE ZEROS TO PERFORM12. NC2014.2 +150300 MOVE 1 TO REC-CT. NC2014.2 +150400 MOVE 20 TO PERFORM2. NC2014.2 +150500 MOVE 5 TO PERFORM3. NC2014.2 +150600 MOVE 1 TO PERFORM4. NC2014.2 +150700 MOVE 3 TO PERFORM9. NC2014.2 +150800 MOVE -1 TO PERFORM10. NC2014.2 +150900 MOVE 6 TO PERFORM11. NC2014.2 +151000* NOTE IN THIS TEST TWO SUBSCRIPTS ARE VARIED. NC2014.2 +151100 PFM-TEST-F4-15-0. NC2014.2 +151200 PERFORM PFM-I-F4-15 THRU PFM-J-F4-15 TEST AFTER NC2014.2 +151300 VARYING PERFORM3 FROM PERFORM9 BY PERFORM10 NC2014.2 +151400 UNTIL PERFORM3 EQUAL TO 2 NC2014.2 +151500 AFTER PERFORM2 FROM 2 BY PERFORM11 NC2014.2 +151600 UNTIL PERFORM2 GREATER THAN 19. NC2014.2 +151700 GO TO PFM-TEST-F4-15-1. NC2014.2 +151800 PFM-I-F4-15. NC2014.2 +151900 MULTIPLY PERFORM4 BY 10 GIVING PERFORM14 NC2014.2 +152000 (PERFORM3, PERFORM2). NC2014.2 +152100 PFM-J-F4-15. NC2014.2 +152200 ADD .5 TO PERFORM4. NC2014.2 +152300 MOVE 20 TO PERFORM2. NC2014.2 +152400 PFM-DELETE-F4-15. NC2014.2 +152500 PERFORM DE-LETE. NC2014.2 +152600 PERFORM PRINT-DETAIL. NC2014.2 +152700 GO TO PFM-INIT-F4-16. NC2014.2 +152800 PFM-TEST-F4-15-1. NC2014.2 +152900 IF PERFORM14 (2, 2) NOT = 15.0 NC2014.2 +153000 MOVE PERFORM14 (2, 2) TO COMPUTED-N NC2014.2 +153100 MOVE 15.0 TO CORRECT-N NC2014.2 +153200 PERFORM FAIL NC2014.2 +153300 PERFORM PRINT-DETAIL NC2014.2 +153400 ELSE NC2014.2 +153500 PERFORM PASS NC2014.2 +153600 PERFORM PRINT-DETAIL. NC2014.2 +153700 ADD 1 TO REC-CT. NC2014.2 +153800 PFM-TEST-F4-15-2. NC2014.2 +153900 IF PERFORM14 (3, 2) NOT = 10.0 NC2014.2 +154000 MOVE PERFORM14 (3, 2) TO COMPUTED-N NC2014.2 +154100 MOVE 10.0 TO CORRECT-N NC2014.2 +154200 PERFORM FAIL NC2014.2 +154300 PERFORM PRINT-DETAIL NC2014.2 +154400 ELSE NC2014.2 +154500 PERFORM PASS NC2014.2 +154600 PERFORM PRINT-DETAIL. NC2014.2 +154700* NC2014.2 +154800 PFM-INIT-F4-16. NC2014.2 +154900* ===--> 6 AFTER PHRASES <--=== NC2014.2 +155000 MOVE "VI-110 6.20.3 SR12" TO ANSI-REFERENCE. NC2014.2 +155100 MOVE "PFM-TEST-F4-16" TO PAR-NAME. NC2014.2 +155200 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +155300 MOVE 0 TO PFM-7-TOT. NC2014.2 +155400 MOVE 1 TO REC-CT. NC2014.2 +155500 MOVE 1 TO S1 S2 S3 S4 S5 S6 S7. NC2014.2 +155600* NOTE IN THIS TEST SEVEN SUBSCRIPTS ARE VARIED. NC2014.2 +155700 PFM-TEST-F4-16-0. NC2014.2 +155800 PERFORM PFM-I-F4-16 THRU PFM-J-F4-16 NC2014.2 +155900 VARYING S1 FROM 1 BY 1 NC2014.2 +156000 UNTIL S1 = 3 NC2014.2 +156100 AFTER S2 FROM 1 BY 1 NC2014.2 +156200 UNTIL S2 = 3 NC2014.2 +156300 AFTER S3 FROM 1 BY 1 NC2014.2 +156400 UNTIL S3 = 3 NC2014.2 +156500 AFTER S4 FROM 1 BY 1 NC2014.2 +156600 UNTIL S4 = 3 NC2014.2 +156700 AFTER S5 FROM 1 BY 1 NC2014.2 +156800 UNTIL S5 = 3 NC2014.2 +156900 AFTER S6 FROM 1 BY 1 NC2014.2 +157000 UNTIL S6 = 3 NC2014.2 +157100 AFTER S7 FROM 1 BY 1 NC2014.2 +157200 UNTIL S7 = 3. NC2014.2 +157300 GO TO PFM-TEST-F4-16-1. NC2014.2 +157400 PFM-I-F4-16. NC2014.2 +157500 MOVE "*" TO PFM77-1 (S1 S2 S3 S4 S5 S6 S7). NC2014.2 +157600 PFM-J-F4-16. NC2014.2 +157700 ADD 1 TO PFM-7-TOT. NC2014.2 +157800 PFM-DELETE-F4-16. NC2014.2 +157900 PERFORM DE-LETE. NC2014.2 +158000 PERFORM PRINT-DETAIL. NC2014.2 +158100 GO TO PFM-INIT-F4-17. NC2014.2 +158200 PFM-TEST-F4-16-1. NC2014.2 +158300 IF PFM77-1 (1 1 1 1 1 1 1) NOT = "*" NC2014.2 +158400 MOVE PFM77-1 (1 1 1 1 1 1 1) TO COMPUTED-A NC2014.2 +158500 MOVE "*" TO CORRECT-A NC2014.2 +158600 PERFORM FAIL NC2014.2 +158700 PERFORM PRINT-DETAIL NC2014.2 +158800 ELSE NC2014.2 +158900 PERFORM PASS NC2014.2 +159000 PERFORM PRINT-DETAIL. NC2014.2 +159100 ADD 1 TO REC-CT. NC2014.2 +159200 PFM-TEST-F4-16-2. NC2014.2 +159300 IF PFM77-1 (1 1 1 1 1 1 2) NOT = "*" NC2014.2 +159400 MOVE PFM77-1 (1 1 1 1 1 1 2) TO COMPUTED-A NC2014.2 +159500 MOVE "*" TO CORRECT-A NC2014.2 +159600 PERFORM FAIL NC2014.2 +159700 PERFORM PRINT-DETAIL NC2014.2 +159800 ELSE NC2014.2 +159900 PERFORM PASS NC2014.2 +160000 PERFORM PRINT-DETAIL. NC2014.2 +160100 ADD 1 TO REC-CT. NC2014.2 +160200 PFM-TEST-F4-16-3. NC2014.2 +160300 IF PFM77-1 (1 1 1 1 1 2 1) NOT = "*" NC2014.2 +160400 MOVE PFM77-1 (1 1 1 1 1 2 1) TO COMPUTED-A NC2014.2 +160500 MOVE "*" TO CORRECT-A NC2014.2 +160600 PERFORM FAIL NC2014.2 +160700 PERFORM PRINT-DETAIL NC2014.2 +160800 ELSE NC2014.2 +160900 PERFORM PASS NC2014.2 +161000 PERFORM PRINT-DETAIL. NC2014.2 +161100 ADD 1 TO REC-CT. NC2014.2 +161200 PFM-TEST-F4-16-4. NC2014.2 +161300 IF PFM77-1 (1 1 1 1 1 2 2) NOT = "*" NC2014.2 +161400 MOVE PFM77-1 (1 1 1 1 1 2 2) TO COMPUTED-A NC2014.2 +161500 MOVE "*" TO CORRECT-A NC2014.2 +161600 PERFORM FAIL NC2014.2 +161700 PERFORM PRINT-DETAIL NC2014.2 +161800 ELSE NC2014.2 +161900 PERFORM PASS NC2014.2 +162000 PERFORM PRINT-DETAIL. NC2014.2 +162100 ADD 1 TO REC-CT. NC2014.2 +162200 PFM-TEST-F4-16-5. NC2014.2 +162300 IF PFM77-1 (1 1 1 1 2 1 1) NOT = "*" NC2014.2 +162400 MOVE PFM77-1 (1 1 1 1 2 1 1) TO COMPUTED-A NC2014.2 +162500 MOVE "*" TO CORRECT-A NC2014.2 +162600 PERFORM FAIL NC2014.2 +162700 PERFORM PRINT-DETAIL NC2014.2 +162800 ELSE NC2014.2 +162900 PERFORM PASS NC2014.2 +163000 PERFORM PRINT-DETAIL. NC2014.2 +163100 ADD 1 TO REC-CT. NC2014.2 +163200 PFM-TEST-F4-16-6. NC2014.2 +163300 IF PFM77-1 (1 1 1 1 2 1 2) NOT = "*" NC2014.2 +163400 MOVE PFM77-1 (1 1 1 1 2 1 2) TO COMPUTED-A NC2014.2 +163500 MOVE "*" TO CORRECT-A NC2014.2 +163600 PERFORM FAIL NC2014.2 +163700 PERFORM PRINT-DETAIL NC2014.2 +163800 ELSE NC2014.2 +163900 PERFORM PASS NC2014.2 +164000 PERFORM PRINT-DETAIL. NC2014.2 +164100 ADD 1 TO REC-CT. NC2014.2 +164200 PFM-TEST-F4-16-7. NC2014.2 +164300 IF PFM77-1 (1 1 1 2 1 1 1) NOT = "*" NC2014.2 +164400 MOVE PFM77-1 (1 1 1 2 1 1 1) TO COMPUTED-A NC2014.2 +164500 MOVE "*" TO CORRECT-A NC2014.2 +164600 PERFORM FAIL NC2014.2 +164700 PERFORM PRINT-DETAIL NC2014.2 +164800 ELSE NC2014.2 +164900 PERFORM PASS NC2014.2 +165000 PERFORM PRINT-DETAIL. NC2014.2 +165100 ADD 1 TO REC-CT. NC2014.2 +165200 PFM-TEST-F4-16-9. NC2014.2 +165300 IF PFM77-1 (1 1 1 2 1 1 2) NOT = "*" NC2014.2 +165400 MOVE PFM77-1 (1 1 1 2 1 1 2) TO COMPUTED-A NC2014.2 +165500 MOVE "*" TO CORRECT-A NC2014.2 +165600 PERFORM FAIL NC2014.2 +165700 PERFORM PRINT-DETAIL NC2014.2 +165800 ELSE NC2014.2 +165900 PERFORM PASS NC2014.2 +166000 PERFORM PRINT-DETAIL. NC2014.2 +166100 ADD 1 TO REC-CT. NC2014.2 +166200 PFM-TEST-F4-16-10. NC2014.2 +166300 IF PFM-7-TOT NOT = 128 NC2014.2 +166400 MOVE PFM-7-TOT TO COMPUTED-18V0 NC2014.2 +166500 MOVE 128 TO CORRECT-18V0 NC2014.2 +166600 PERFORM FAIL NC2014.2 +166700 PERFORM PRINT-DETAIL NC2014.2 +166800 ELSE NC2014.2 +166900 PERFORM PASS NC2014.2 +167000 PERFORM PRINT-DETAIL. NC2014.2 +167100* NC2014.2 +167200 PFM-INIT-F4-17. NC2014.2 +167300* ===--> 6 AFTER PHRASES <--=== NC2014.2 +167400* ===--> "WITH TEST BEFORE" PHRASE <--=== NC2014.2 +167500 MOVE "PFM-TEST-F4-17" TO PAR-NAME. NC2014.2 +167600 MOVE "VI-114 6.20.4 GR10(d)2" TO ANSI-REFERENCE. NC2014.2 +167700 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +167800 MOVE 101 TO COUNT-DU-6V0. NC2014.2 +167900 MOVE 0 TO PFM-7-TOT. NC2014.2 +168000 MOVE 1 TO REC-CT. NC2014.2 +168100* NOTE IN THIS TEST SEVEN SUBSCRIPTS ARE VARIED. NC2014.2 +168200 PFM-TEST-F4-17-0. NC2014.2 +168300 PERFORM PFM-I-F4-17 THRU PFM-J-F4-17 WITH TEST BEFORE NC2014.2 +168400 VARYING S1 FROM 1 BY 1 NC2014.2 +168500 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +168600 AFTER S2 FROM 1 BY 1 NC2014.2 +168700 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +168800 AFTER S3 FROM 1 BY 1 NC2014.2 +168900 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +169000 AFTER S4 FROM 1 BY 1 NC2014.2 +169100 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +169200 AFTER S5 FROM 1 BY 1 NC2014.2 +169300 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +169400 AFTER S6 FROM 1 BY 1 NC2014.2 +169500 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +169600 AFTER S7 FROM 1 BY 1 NC2014.2 +169700 UNTIL COUNT-DU-6V0 > 100. NC2014.2 +169800 GO TO PFM-TEST-F4-17-1. NC2014.2 +169900 PFM-I-F4-17. NC2014.2 +170000 MOVE "*" TO PFM77-1 (S1 S2 S3 S4 S5 S6 S7). NC2014.2 +170100 PFM-J-F4-17. NC2014.2 +170200 ADD 1 TO PFM-7-TOT. NC2014.2 +170300 PFM-DELETE-F4-17. NC2014.2 +170400 PERFORM DE-LETE. NC2014.2 +170500 PERFORM PRINT-DETAIL. NC2014.2 +170600 GO TO PFM-INIT-F4-18. NC2014.2 +170700 PFM-TEST-F4-17-1. NC2014.2 +170800 IF PFM77-1 (1 1 1 1 1 1 1) NOT = SPACE NC2014.2 +170900 MOVE PFM77-1 (1 1 1 1 1 1 1) TO COMPUTED-A NC2014.2 +171000 MOVE SPACE TO CORRECT-A NC2014.2 +171100 PERFORM FAIL NC2014.2 +171200 PERFORM PRINT-DETAIL NC2014.2 +171300 ELSE NC2014.2 +171400 PERFORM PASS NC2014.2 +171500 PERFORM PRINT-DETAIL. NC2014.2 +171600 ADD 1 TO REC-CT. NC2014.2 +171700 PFM-TEST-F4-17-2. NC2014.2 +171800 IF PFM77-1 (1 1 1 1 1 1 2) NOT = SPACE NC2014.2 +171900 MOVE PFM77-1 (1 1 1 1 1 1 2) TO COMPUTED-A NC2014.2 +172000 MOVE SPACE TO CORRECT-A NC2014.2 +172100 PERFORM FAIL NC2014.2 +172200 PERFORM PRINT-DETAIL NC2014.2 +172300 ELSE NC2014.2 +172400 PERFORM PASS NC2014.2 +172500 PERFORM PRINT-DETAIL. NC2014.2 +172600 ADD 1 TO REC-CT. NC2014.2 +172700 PFM-TEST-F4-17-3. NC2014.2 +172800 IF PFM77-1 (1 1 1 1 1 2 1) NOT = SPACE NC2014.2 +172900 MOVE PFM77-1 (1 1 1 1 1 2 1) TO COMPUTED-A NC2014.2 +173000 MOVE SPACE TO CORRECT-A NC2014.2 +173100 PERFORM FAIL NC2014.2 +173200 PERFORM PRINT-DETAIL NC2014.2 +173300 ELSE NC2014.2 +173400 PERFORM PASS NC2014.2 +173500 PERFORM PRINT-DETAIL. NC2014.2 +173600 ADD 1 TO REC-CT. NC2014.2 +173700 PFM-TEST-F4-17-4. NC2014.2 +173800 IF PFM77-1 (1 1 1 1 1 2 2) NOT = SPACE NC2014.2 +173900 MOVE PFM77-1 (1 1 1 1 1 2 2) TO COMPUTED-A NC2014.2 +174000 MOVE SPACE TO CORRECT-A NC2014.2 +174100 PERFORM FAIL NC2014.2 +174200 PERFORM PRINT-DETAIL NC2014.2 +174300 ELSE NC2014.2 +174400 PERFORM PASS NC2014.2 +174500 PERFORM PRINT-DETAIL. NC2014.2 +174600 ADD 1 TO REC-CT. NC2014.2 +174700 PFM-TEST-F4-17-5. NC2014.2 +174800 IF PFM77-1 (1 1 1 1 2 1 1) NOT = SPACE NC2014.2 +174900 MOVE PFM77-1 (1 1 1 1 2 1 1) TO COMPUTED-A NC2014.2 +175000 MOVE SPACE TO CORRECT-A NC2014.2 +175100 PERFORM FAIL NC2014.2 +175200 PERFORM PRINT-DETAIL NC2014.2 +175300 ELSE NC2014.2 +175400 PERFORM PASS NC2014.2 +175500 PERFORM PRINT-DETAIL. NC2014.2 +175600 ADD 1 TO REC-CT. NC2014.2 +175700 PFM-TEST-F4-17-6. NC2014.2 +175800 IF PFM77-1 (1 1 1 1 2 1 2) NOT = SPACE NC2014.2 +175900 MOVE PFM77-1 (1 1 1 1 2 1 2) TO COMPUTED-A NC2014.2 +176000 MOVE SPACE TO CORRECT-A NC2014.2 +176100 PERFORM FAIL NC2014.2 +176200 PERFORM PRINT-DETAIL NC2014.2 +176300 ELSE NC2014.2 +176400 PERFORM PASS NC2014.2 +176500 PERFORM PRINT-DETAIL. NC2014.2 +176600 ADD 1 TO REC-CT. NC2014.2 +176700 PFM-TEST-F4-17-7. NC2014.2 +176800 IF PFM77-1 (1 1 1 2 1 1 1) NOT = SPACE NC2014.2 +176900 MOVE PFM77-1 (1 1 1 2 1 1 1) TO COMPUTED-A NC2014.2 +177000 MOVE SPACE TO CORRECT-A NC2014.2 +177100 PERFORM FAIL NC2014.2 +177200 PERFORM PRINT-DETAIL NC2014.2 +177300 ELSE NC2014.2 +177400 PERFORM PASS NC2014.2 +177500 PERFORM PRINT-DETAIL. NC2014.2 +177600 ADD 1 TO REC-CT. NC2014.2 +177700 PFM-TEST-F4-17-8. NC2014.2 +177800 IF PFM77-1 (1 1 1 2 1 1 2) NOT = SPACE NC2014.2 +177900 MOVE PFM77-1 (1 1 1 2 1 1 2) TO COMPUTED-A NC2014.2 +178000 MOVE SPACE TO CORRECT-A NC2014.2 +178100 PERFORM FAIL NC2014.2 +178200 PERFORM PRINT-DETAIL NC2014.2 +178300 ELSE NC2014.2 +178400 PERFORM PASS NC2014.2 +178500 PERFORM PRINT-DETAIL. NC2014.2 +178600 ADD 1 TO REC-CT. NC2014.2 +178700 PFM-TEST-F4-17-9. NC2014.2 +178800 IF PFM-7-TOT NOT = ZERO NC2014.2 +178900 MOVE PFM-7-TOT TO COMPUTED-18V0 NC2014.2 +179000 MOVE ZERO TO CORRECT-18V0 NC2014.2 +179100 PERFORM FAIL NC2014.2 +179200 PERFORM PRINT-DETAIL NC2014.2 +179300 ELSE NC2014.2 +179400 PERFORM PASS NC2014.2 +179500 PERFORM PRINT-DETAIL. NC2014.2 +179600* NC2014.2 +179700 PFM-INIT-F4-18. NC2014.2 +179800* ===--> 6 AFTER PHRASES <--=== NC2014.2 +179900* ===--> TEST AFTER" PHRASE <--=== NC2014.2 +180000 MOVE "PFM-TEST-F4-18" TO PAR-NAME. NC2014.2 +180100 MOVE "VI-119 6.20.4 GR10(d)2" TO ANSI-REFERENCE. NC2014.2 +180200 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +180300 MOVE 0 TO COUNT-DU-6V0. NC2014.2 +180400 MOVE 0 TO PFM-7-TOT. NC2014.2 +180500 MOVE 1 TO REC-CT. NC2014.2 +180600* NOTE IN THIS TEST SEVEN SUBSCRIPTS ARE VARIED. NC2014.2 +180700 PFM-TEST-F4-18-0. NC2014.2 +180800 PERFORM PFM-I-F4-18 THRU PFM-J-F4-18 TEST AFTER NC2014.2 +180900 VARYING S1 FROM 1 BY 1 NC2014.2 +181000 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181100 AFTER S2 FROM 1 BY 1 NC2014.2 +181200 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181300 AFTER S3 FROM 1 BY 1 NC2014.2 +181400 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181500 AFTER S4 FROM 1 BY 1 NC2014.2 +181600 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181700 AFTER S5 FROM 1 BY 1 NC2014.2 +181800 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +181900 AFTER S6 FROM 1 BY 1 NC2014.2 +182000 UNTIL COUNT-DU-6V0 > 100 NC2014.2 +182100 AFTER S7 FROM 1 BY 1 NC2014.2 +182200 UNTIL COUNT-DU-6V0 > 100. NC2014.2 +182300 GO TO PFM-TEST-F4-18-1. NC2014.2 +182400 PFM-I-F4-18. NC2014.2 +182500 MOVE "*" TO PFM77-1 (S1 S2 S3 S4 S5 S6 S7). NC2014.2 +182600 MOVE 101 TO COUNT-DU-6V0. NC2014.2 +182700 PFM-J-F4-18. NC2014.2 +182800 ADD 1 TO PFM-7-TOT. NC2014.2 +182900 PFM-DELETE-F4-18. NC2014.2 +183000 PERFORM DE-LETE. NC2014.2 +183100 PERFORM PRINT-DETAIL. NC2014.2 +183200 GO TO PFM-INIT-F4-20. NC2014.2 +183300 PFM-TEST-F4-18-1. NC2014.2 +183400 IF PFM77-1 (1 1 1 1 1 1 1) NOT = "*" NC2014.2 +183500 MOVE PFM77-1 (1 1 1 1 1 1 1) TO COMPUTED-A NC2014.2 +183600 MOVE "*" TO CORRECT-A NC2014.2 +183700 PERFORM FAIL NC2014.2 +183800 PERFORM PRINT-DETAIL NC2014.2 +183900 ELSE NC2014.2 +184000 PERFORM PASS NC2014.2 +184100 PERFORM PRINT-DETAIL. NC2014.2 +184200 ADD 1 TO REC-CT. NC2014.2 +184300 PFM-TEST-F4-18-2. NC2014.2 +184400 IF PFM77-1 (1 1 1 1 1 1 2) NOT = SPACE NC2014.2 +184500 MOVE PFM77-1 (1 1 1 1 1 1 2) TO COMPUTED-A NC2014.2 +184600 MOVE SPACE TO CORRECT-A NC2014.2 +184700 PERFORM FAIL NC2014.2 +184800 PERFORM PRINT-DETAIL NC2014.2 +184900 ELSE NC2014.2 +185000 PERFORM PASS NC2014.2 +185100 PERFORM PRINT-DETAIL. NC2014.2 +185200 ADD 1 TO REC-CT. NC2014.2 +185300 PFM-TEST-F4-18-3. NC2014.2 +185400 IF PFM77-1 (1 1 1 1 1 2 1) NOT = SPACE NC2014.2 +185500 MOVE PFM77-1 (1 1 1 1 1 2 1) TO COMPUTED-A NC2014.2 +185600 MOVE SPACE TO CORRECT-A NC2014.2 +185700 PERFORM FAIL NC2014.2 +185800 PERFORM PRINT-DETAIL NC2014.2 +185900 ELSE NC2014.2 +186000 PERFORM PASS NC2014.2 +186100 PERFORM PRINT-DETAIL. NC2014.2 +186200 ADD 1 TO REC-CT. NC2014.2 +186300 PFM-TEST-F4-18-4. NC2014.2 +186400 IF PFM77-1 (1 1 1 1 1 2 2) NOT = SPACE NC2014.2 +186500 MOVE PFM77-1 (1 1 1 1 1 2 2) TO COMPUTED-A NC2014.2 +186600 MOVE SPACE TO CORRECT-A NC2014.2 +186700 PERFORM FAIL NC2014.2 +186800 PERFORM PRINT-DETAIL NC2014.2 +186900 ELSE NC2014.2 +187000 PERFORM PASS NC2014.2 +187100 PERFORM PRINT-DETAIL. NC2014.2 +187200 ADD 1 TO REC-CT. NC2014.2 +187300 PFM-TEST-F4-18-5. NC2014.2 +187400 IF PFM77-1 (1 1 1 1 2 1 1) NOT = SPACE NC2014.2 +187500 MOVE PFM77-1 (1 1 1 1 2 1 1) TO COMPUTED-A NC2014.2 +187600 MOVE SPACE TO CORRECT-A NC2014.2 +187700 PERFORM FAIL NC2014.2 +187800 PERFORM PRINT-DETAIL NC2014.2 +187900 ELSE NC2014.2 +188000 PERFORM PASS NC2014.2 +188100 PERFORM PRINT-DETAIL. NC2014.2 +188200 ADD 1 TO REC-CT. NC2014.2 +188300 PFM-TEST-F4-18-6. NC2014.2 +188400 IF PFM77-1 (1 1 1 1 2 1 2) NOT = SPACE NC2014.2 +188500 MOVE PFM77-1 (1 1 1 1 2 1 2) TO COMPUTED-A NC2014.2 +188600 MOVE SPACE TO CORRECT-A NC2014.2 +188700 PERFORM FAIL NC2014.2 +188800 PERFORM PRINT-DETAIL NC2014.2 +188900 ELSE NC2014.2 +189000 PERFORM PASS NC2014.2 +189100 PERFORM PRINT-DETAIL. NC2014.2 +189200 ADD 1 TO REC-CT. NC2014.2 +189300 PFM-TEST-F4-18-7. NC2014.2 +189400 IF PFM77-1 (1 1 1 2 1 1 1) NOT = SPACE NC2014.2 +189500 MOVE PFM77-1 (1 1 1 2 1 1 1) TO COMPUTED-A NC2014.2 +189600 MOVE SPACE TO CORRECT-A NC2014.2 +189700 MOVE "PFM-TEST-F4-18-8" TO PAR-NAME NC2014.2 +189800 PERFORM FAIL NC2014.2 +189900 PERFORM PRINT-DETAIL NC2014.2 +190000 ELSE NC2014.2 +190100 PERFORM PASS NC2014.2 +190200 PERFORM PRINT-DETAIL. NC2014.2 +190300 ADD 1 TO REC-CT. NC2014.2 +190400 PFM-TEST-F4-18-8. NC2014.2 +190500 IF PFM77-1 (1 1 1 2 1 1 2) NOT = SPACE NC2014.2 +190600 MOVE PFM77-1 (1 1 1 2 1 1 2) TO COMPUTED-A NC2014.2 +190700 MOVE SPACE TO CORRECT-A NC2014.2 +190800 PERFORM FAIL NC2014.2 +190900 PERFORM PRINT-DETAIL NC2014.2 +191000 ELSE NC2014.2 +191100 PERFORM PASS NC2014.2 +191200 PERFORM PRINT-DETAIL. NC2014.2 +191300 ADD 1 TO REC-CT. NC2014.2 +191400 PFM-TEST-F4-18-9. NC2014.2 +191500 IF PFM-7-TOT NOT = 1 NC2014.2 +191600 MOVE PFM-7-TOT TO COMPUTED-18V0 NC2014.2 +191700 MOVE 1 TO CORRECT-18V0 NC2014.2 +191800 PERFORM FAIL NC2014.2 +191900 PERFORM PRINT-DETAIL NC2014.2 +192000 ELSE NC2014.2 +192100 PERFORM PASS NC2014.2 +192200 PERFORM PRINT-DETAIL. NC2014.2 +192300* NC2014.2 +192400* NC2014.2 +192500 PFM-INIT-F4-20. NC2014.2 +192600 MOVE "VI-112 6.20.4 GR10(d)" TO ANSI-REFERENCE NC2014.2 +192700 MOVE "PFM-TEST-F4-20" TO PAR-NAME. NC2014.2 +192800 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +192900 MOVE "VARYING BY FRAC." TO FEATURE. NC2014.2 +193000 MOVE "PERFORM VARYING" TO RE-MARK. NC2014.2 +193100 MOVE ZERO TO COUNT-DU-6V0. NC2014.2 +193200 MOVE ZERO TO REC-CT. NC2014.2 +193300 PFM-TEST-F4-20-0. NC2014.2 +193400 PERFORM PFM-LOOP-F4-20 THROUGH PFM-LOOP-F4-20-EXIT NC2014.2 +193500 VARYING WRK-DU-2V1-1 NC2014.2 +193600 FROM WRK-DU-0V1-1 BY .1 NC2014.2 +193700 UNTIL WRK-DU-2V1-1 + WRK-DU-2V1-3 > 12.1. NC2014.2 +193800 GO TO PFM-TEST-F4-20-1. NC2014.2 +193900 PFM-DELETE-F4-20. NC2014.2 +194000 PERFORM DE-LETE. NC2014.2 +194100 PERFORM PRINT-DETAIL. NC2014.2 +194200 GO TO PFM-INIT-F4-21. NC2014.2 +194300 PFM-LOOP-F4-20. NC2014.2 +194400 ADD 1 TO COUNT-DU-6V0. NC2014.2 +194500 PFM-LOOP-F4-20-EXIT. NC2014.2 +194600 EXIT. NC2014.2 +194700 PFM-TEST-F4-20-1. NC2014.2 +194800 IF COUNT-DU-6V0 = 10 NC2014.2 +194900 PERFORM PASS NC2014.2 +195000 PERFORM PRINT-DETAIL NC2014.2 +195100 ELSE NC2014.2 +195200 PERFORM FAIL NC2014.2 +195300 MOVE COUNT-DU-6V0 TO COMPUTED-N NC2014.2 +195400 MOVE 10 TO CORRECT-N NC2014.2 +195500 PERFORM PRINT-DETAIL. NC2014.2 +195600* NC2014.2 +195700 PFM-INIT-F4-21. NC2014.2 +195800 MOVE "VI-112 6.20.4 GR10(d)" TO ANSI-REFERENCE NC2014.2 +195900 MOVE "PFM-TEST-F4-21" TO PAR-NAME. NC2014.2 +196000 MOVE "CHANGE BY INCR." TO FEATURE. NC2014.2 +196100 MOVE "PERFORM VARYING" TO RE-MARK. NC2014.2 +196200 MOVE ZERO TO COUNT-DU-6V0. NC2014.2 +196300 PFM-TEST-F4-21-0. NC2014.2 +196400 PERFORM LOOP-FOR-F4-21 THRU LOOP-F4-21-EXIT NC2014.2 +196500 VARYING WRK-DU-2V1-1 FROM WRK-DU-0V1-1 BY WRK-DU-2V1-2 NC2014.2 +196600 UNTIL WRK-DU-2V1-1 + 11.1 > 12.1. NC2014.2 +196700 GO TO PFM-TEST-F4-21-1. NC2014.2 +196800 PFM-DELETE-F4-21. NC2014.2 +196900 PERFORM DE-LETE. NC2014.2 +197000 PERFORM PRINT-DETAIL. NC2014.2 +197100 GO TO PFM-INIT-F4-22. NC2014.2 +197200 LOOP-FOR-F4-21. NC2014.2 +197300 ADD 1 TO COUNT-DU-6V0. NC2014.2 +197400 ADD .1 TO WRK-DU-2V1-2. NC2014.2 +197500 LOOP-F4-21-EXIT. NC2014.2 +197600 EXIT. NC2014.2 +197700 PFM-TEST-F4-21-1. NC2014.2 +197800 IF COUNT-DU-6V0 = 4 NC2014.2 +197900 PERFORM PASS NC2014.2 +198000 PERFORM PRINT-DETAIL NC2014.2 +198100 ELSE NC2014.2 +198200 PERFORM FAIL NC2014.2 +198300 MOVE COUNT-DU-6V0 TO COMPUTED-N NC2014.2 +198400 MOVE 4 TO CORRECT-N NC2014.2 +198500 PERFORM PRINT-DETAIL. NC2014.2 +198600* NC2014.2 +198700 PFM-INIT-F4-22. NC2014.2 +198800* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2014.2 +198900 MOVE "VI-110 6.20.4 GR5" TO ANSI-REFERENCE. NC2014.2 +199000 MOVE "PFM-TEST-F4-22" TO PAR-NAME. NC2014.2 +199100 MOVE "CHANGE BY INCR." TO FEATURE. NC2014.2 +199200 MOVE "PERFORM VARYING" TO RE-MARK. NC2014.2 +199300 MOVE 44 TO PFM-12-ANS1. NC2014.2 +199400 MOVE 46 TO PFM-12-ANS2. NC2014.2 +199500* NOTE THIS PROGRAM TESTS THE ABILITY OF THE COMPILER TO NC2014.2 +199600* PERFORM A STATEMENT WITH A VARYING CLAUSE INCLUDED. NC2014.2 +199700 PFM-TEST-F4-22-0. NC2014.2 +199800 PERFORM VARYING PFM-12-COUNTER FROM 100 BY 4 NC2014.2 +199900 UNTIL PFM-12-COUNTER NOT GREATER THAN 15 NC2014.2 +200000 AND PFM-12-ANS1 LESS THAN PFM-12-ANS2 NC2014.2 +200100 OR PFM-12-ANS2 GREATER THAN 50 NC2014.2 +200200 ADD 1 TO PFM-12-ANS2 NC2014.2 +200300 SUBTRACT 2 FROM PFM-12-ANS1 NC2014.2 +200400 IF PFM-12-ANS2 GREATER THAN OR EQUAL TO NC2014.2 +200500 PFM-12-ANS1 NC2014.2 +200600 DIVIDE PFM-12-COUNTER BY 2 NC2014.2 +200700 GIVING PFM-12-COUNTER NC2014.2 +200800 IF PFM-12-COUNTER LESS THAN 36 NC2014.2 +200900 SUBTRACT 4 FROM PFM-12-COUNTER NC2014.2 +201000 END-IF NC2014.2 +201100 END-IF NC2014.2 +201200 END-PERFORM. NC2014.2 +201300 GO TO PFM-TEST-F4-22-1. NC2014.2 +201400 PFM-DELETE-F4-22. NC2014.2 +201500 PERFORM DE-LETE. NC2014.2 +201600 GO TO PFM-WRITE-F4-22. NC2014.2 +201700 PFM-TEST-F4-22-1. NC2014.2 +201800 IF PFM-12-COUNTER EQUAL TO 13 NC2014.2 +201900 PERFORM PASS NC2014.2 +202000 GO TO PFM-WRITE-F4-22. NC2014.2 +202100 PERFORM FAIL. NC2014.2 +202200 MOVE PFM-12-COUNTER TO COMPUTED-A. NC2014.2 +202300 MOVE "13" TO CORRECT-A. NC2014.2 +202400 PFM-WRITE-F4-22. NC2014.2 +202500 MOVE "PFM-TEST-F4-22" TO PAR-NAME. NC2014.2 +202600 PERFORM PRINT-DETAIL. NC2014.2 +202700* NC2014.2 +202800* NC2014.2 +202900 PFM-INIT-F4-23. NC2014.2 +203000* ===--> ORDER OF INITIALISATION <--=== NC2014.2 +203100* ===--> OF VARYING IDENTIFIERS. <--=== NC2014.2 +203200 MOVE "VI-114 6.20.4 GR10(d)1" TO ANSI-REFERENCE. NC2014.2 +203300 MOVE "PFM-TEST-F4-23" TO PAR-NAME. NC2014.2 +203400 MOVE SPACES TO PERFORM-SEVEN-LEVEL-TABLE. NC2014.2 +203500 MOVE 0 TO PFM-F4-23-TOT. NC2014.2 +203600 PFM-TEST-F4-23-0. NC2014.2 +203700 PERFORM PFM-F4-23-PROC NC2014.2 +203800 VARYING PFM-A1 FROM 1 BY 1 NC2014.2 +203900 UNTIL PFM-A1 > 3 NC2014.2 +204000 AFTER PFM-B1 FROM PFM-A1 BY 1 NC2014.2 +204100 UNTIL PFM-B1 > 3. NC2014.2 +204200 GO TO PFM-TEST-F4-23-1. NC2014.2 +204300 PFM-DELETE-F4-23. NC2014.2 +204400 PERFORM DE-LETE. NC2014.2 +204500 PERFORM PRINT-DETAIL. NC2014.2 +204600 GO TO PFM-INIT-F4-24. NC2014.2 +204700 PFM-F4-23-PROC. NC2014.2 +204800 ADD 1 TO PFM-F4-23-TOT. NC2014.2 +204900 PFM-TEST-F4-23-1. NC2014.2 +205000 IF PFM-F4-23-TOT = 6 NC2014.2 +205100 PERFORM PASS NC2014.2 +205200 PERFORM PRINT-DETAIL NC2014.2 +205300 ELSE NC2014.2 +205400 MOVE 6 TO CORRECT-18V0 NC2014.2 +205500 MOVE PFM-F4-23-TOT TO COMPUTED-18V0 NC2014.2 +205600 PERFORM FAIL NC2014.2 +205700 PERFORM PRINT-DETAIL. NC2014.2 +205800 MOVE 2 TO PERFORM9. NC2014.2 +205900 MOVE 2 TO PERFORM10. NC2014.2 +206000* NC2014.2 +206100 PFM-INIT-F4-24. NC2014.2 +206200* ===--> MANIPULATING SUBSCRIPTS <--=== NC2014.2 +206300 MOVE "VI-112 6.20.4 GR10(d)" TO ANSI-REFERENCE. NC2014.2 +206400 MOVE "PFM-TEST-F4-24" TO PAR-NAME. NC2014.2 +206500 INITIALIZE FILLER-A. NC2014.2 +206600 MOVE 1 TO S1 S2 S3. NC2014.2 +206700 MOVE 10 TO PFM-F4-24-B (1) MOVE 20 TO PFM-F4-24-B (2). NC2014.2 +206800 MOVE 30 TO PFM-F4-24-B (3) MOVE 40 TO PFM-F4-24-B (4). NC2014.2 +206900 MOVE 50 TO PFM-F4-24-B (5) MOVE 60 TO PFM-F4-24-B (6). NC2014.2 +207000 MOVE 70 TO PFM-F4-24-B (7) MOVE 80 TO PFM-F4-24-B (8). NC2014.2 +207100 MOVE 90 TO PFM-F4-24-B (9) MOVE 100 TO PFM-F4-24-B (10). NC2014.2 +207200 MOVE 10 TO PFM-F4-24-C (1) MOVE 20 TO PFM-F4-24-C (2). NC2014.2 +207300 MOVE 30 TO PFM-F4-24-C (3) MOVE 40 TO PFM-F4-24-C (4). NC2014.2 +207400 MOVE 50 TO PFM-F4-24-C (5) MOVE 60 TO PFM-F4-24-C (6). NC2014.2 +207500 MOVE 70 TO PFM-F4-24-C (7) MOVE 80 TO PFM-F4-24-C (8). NC2014.2 +207600 MOVE 90 TO PFM-F4-24-C (9) MOVE 100 TO PFM-F4-24-C (10). NC2014.2 +207700 MOVE 0 TO PERFORM18. NC2014.2 +207800 PFM-TEST-F4-24-0. NC2014.2 +207900 PERFORM PFM-A-F4-24 NC2014.2 +208000 VARYING PFM-F4-24-A (S1) NC2014.2 +208100 FROM 10 NC2014.2 +208200 BY PFM-F4-24-C (S2) NC2014.2 +208300 UNTIL PFM-F4-24-A (S1) > 70. NC2014.2 +208400 PFM-TEST-F4-24-1. NC2014.2 +208500 IF PFM-F4-24-A (S1) EQUAL TO 80 NC2014.2 +208600 PERFORM PASS GO TO PFM-WRITE-F4-24-1. NC2014.2 +208700 PERFORM FAIL. NC2014.2 +208800 MOVE PFM-F4-24-A (S1) TO COMPUTED-N. NC2014.2 +208900 MOVE 80 TO CORRECT-N. NC2014.2 +209000 GO TO PFM-WRITE-F4-24-1. NC2014.2 +209100 PFM-DELETE-F4-24-1. NC2014.2 +209200 PERFORM DE-LETE. NC2014.2 +209300 GO TO PFM-WRITE-F4-24-1. NC2014.2 +209400 PFM-A-F4-24. NC2014.2 +209500 ADD 1 TO PERFORM18. NC2014.2 +209600 MULTIPLY 2 BY S2. NC2014.2 +209700 ADD 1 TO S1 S3. NC2014.2 +209800 PFM-WRITE-F4-24-1. NC2014.2 +209900 MOVE "PFM-TEST-F4-24" TO PAR-NAME. NC2014.2 +210000 PERFORM PRINT-DETAIL. NC2014.2 +210100 PFM-TEST-F4-24-2. NC2014.2 +210200 IF S1 EQUAL TO 4 NC2014.2 +210300 PERFORM PASS GO TO PFM-WRITE-F4-24-2. NC2014.2 +210400 PERFORM FAIL. NC2014.2 +210500 MOVE S1 TO COMPUTED-N. NC2014.2 +210600 MOVE 4 TO CORRECT-N. NC2014.2 +210700 GO TO PFM-WRITE-F4-24-2. NC2014.2 +210800 PFM-DELETE-F4-24-2. NC2014.2 +210900 PERFORM DE-LETE. NC2014.2 +211000 GO TO PFM-WRITE-F4-24-2. NC2014.2 +211100 PFM-A-F4-24-2. NC2014.2 +211200 ADD 1 TO PERFORM18. NC2014.2 +211300 MULTIPLY 2 BY S2. NC2014.2 +211400 ADD 1 TO S1 S3. NC2014.2 +211500 PFM-WRITE-F4-24-2. NC2014.2 +211600 MOVE "PFM-TEST-F4-24" TO PAR-NAME. NC2014.2 +211700 PERFORM PRINT-DETAIL. NC2014.2 +211800 CCVS-EXIT SECTION. NC2014.2 +211900 CCVS-999999. NC2014.2 +212000 GO TO CLOSE-FILES. NC2014.2 diff --git a/tests/cobol85/NC/NC202A.CBL b/tests/cobol85/NC/NC202A.CBL new file mode 100755 index 00000000..07301ac9 --- /dev/null +++ b/tests/cobol85/NC/NC202A.CBL @@ -0,0 +1,2219 @@ +000100 IDENTIFICATION DIVISION. NC2024.2 +000200 PROGRAM-ID. NC2024.2 +000300 NC202A. NC2024.2 +000400 NC2024.2 +000500**************************************************************** NC2024.2 +000600* * NC2024.2 +000700* VALIDATION FOR:- * NC2024.2 +000800* * NC2024.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2024.2 +001000* * NC2024.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2024.2 +001200* * NC2024.2 +001300**************************************************************** NC2024.2 +001400* * NC2024.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2024.2 +001600* * NC2024.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2024.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2024.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2024.2 +002000* * NC2024.2 +002100**************************************************************** NC2024.2 +002200* NC2024.2 +002300* PROGRAM NC202A TESTS FORMAT3 OF THE ADD STATEMENT. NC2024.2 +002400* NC2024.2 +002500 ENVIRONMENT DIVISION. NC2024.2 +002600 CONFIGURATION SECTION. NC2024.2 +002700 SOURCE-COMPUTER. NC2024.2 +002800 Linux. NC2024.2 +002900 OBJECT-COMPUTER. NC2024.2 +003000 Linux. NC2024.2 +003100 INPUT-OUTPUT SECTION. NC2024.2 +003200 FILE-CONTROL. NC2024.2 +003300 SELECT PRINT-FILE ASSIGN TO NC2024.2 +003400 "report.log". NC2024.2 +003500 DATA DIVISION. NC2024.2 +003600 FILE SECTION. NC2024.2 +003700 FD PRINT-FILE. NC2024.2 +003800 01 PRINT-REC PICTURE X(120). NC2024.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC2024.2 +004000 WORKING-STORAGE SECTION. NC2024.2 +004100 01 TABLE1. NC2024.2 +004200 02 RECORD1 PICTURE 99. NC2024.2 +004300 02 RECORD2 PICTURE 99 NC2024.2 +004400 OCCURS 2 TIMES NC2024.2 +004500 INDEXED BY INDEX1. NC2024.2 +004600 02 RECORD3 PICTURE 99. NC2024.2 +004700 01 TABLE2. NC2024.2 +004800 02 RECORD1 PICTURE 99. NC2024.2 +004900 02 RECORD2 PICTURE 99 NC2024.2 +005000 OCCURS 2 TIMES NC2024.2 +005100 INDEXED BY INDEX2. NC2024.2 +005200 02 RECORD3 PICTURE 99. NC2024.2 +005300 77 WRK-AN-00001 PICTURE X. NC2024.2 +005400 77 WRK-XN-00001 PICTURE X. NC2024.2 +005500 77 WRK-DS-01V00 PICTURE S9. NC2024.2 +005600 77 WRK-DS-02V00 PICTURE S99. NC2024.2 +005700 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2024.2 +005800 77 WRK-DS-05V00 PICTURE S9(5). NC2024.2 +005900 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2024.2 +006000 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2024.2 +006100 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC2024.2 +006200 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2024.2 +006300 VALUE 111111111.111111111. NC2024.2 +006400 77 WRK-DS-18V00 PICTURE S9(18) VALUE 111111111111111111. NC2024.2 +006500 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2024.2 +006600 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2024.2 +006700 77 WRK-DS-03V00 PICTURE S999. NC2024.2 +006800 77 WRK-DS-06V00 PICTURE S9(6). NC2024.2 +006900 77 WRK-DS-0201P PICTURE S99P. NC2024.2 +007000 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC2024.2 +007100 77 ADD-1 PICTURE S9(8)V99 VALUE 1. NC2024.2 +007200 77 ADD-2 PICTURE S9(6)V9(4) VALUE 1. NC2024.2 +007300 77 ADD-3 PICTURE S9(5) VALUE -1. NC2024.2 +007400 77 ADD-4 PICTURE 9 VALUE 9. NC2024.2 +007500 77 ADD-5 PICTURE 9 VALUE 9. NC2024.2 +007600 77 ADD-6 PICTURE 9(5) VALUE 99999. NC2024.2 +007700 77 ADD-7 PICTURE 9 VALUE 1. NC2024.2 +007800 77 ADD-8 PICTURE 9. NC2024.2 +007900 77 ADD-9 PICTURE S9(8)V99 VALUE 5.9. NC2024.2 +008000 77 ADD-10 PICTURE 9(5) VALUE 52800. NC2024.2 +008100 77 ADD-11 PICTURE 99999. NC2024.2 +008200 77 ADD-12 PICTURE PP9 VALUE .001. NC2024.2 +008300 77 ADD-13 PICTURE 9PP VALUE 100. NC2024.2 +008400 77 ADD-14 PICTURE 999V999. NC2024.2 +008500 77 W-1 PICTURE IS 9. NC2024.2 +008600 77 W-2 PICTURE IS 99. NC2024.2 +008700 77 W-3 PICTURE IS 999. NC2024.2 +008800 77 W-4 PICTURE 9 VALUE 0. NC2024.2 +008900 77 W-6 PICTURE IS 999 VALUE IS ZERO. NC2024.2 +009000 77 W-9 PICTURE 999. NC2024.2 +009100 77 D-5 PICTURE S999 VALUE -1. NC2024.2 +009200 77 D-9 PICTURE 9(4)V9(4) VALUE 111.1189. NC2024.2 +009300 77 ONE PICTURE 9 VALUE 1. NC2024.2 +009400 77 TWO PICTURE S9 VALUE 2. NC2024.2 +009500 77 THREE PICTURE S9 VALUE 3. NC2024.2 +009600 77 FOUR PICTURE S9 VALUE 4. NC2024.2 +009700 77 FIVE PICTURE S9 VALUE 5. NC2024.2 +009800 77 SIX PICTURE S9 VALUE 6. NC2024.2 +009900 77 SEVEN PICTURE S9 VALUE 7. NC2024.2 +010000 77 EIGHT PICTURE 9 VALUE 8. NC2024.2 +010100 77 NINE PICTURE S9 VALUE 9. NC2024.2 +010200 77 TEN PICTURE S99 VALUE 10. NC2024.2 +010300 77 FIFTEEN PICTURE S99 VALUE 15. NC2024.2 +010400 77 TWENTY PICTURE S99 VALUE 20. NC2024.2 +010500 77 TWENTY-5 PICTURE S99 VALUE 25. NC2024.2 +010600 01 WRK-DS-09V00 PICTURE S9(9) VALUE ZERO. NC2024.2 +010700 01 GRP-FOR-ADD-CORR-1. NC2024.2 +010800 02 GRP-SUBTRACT-CORR-1. NC2024.2 +010900 03 FILLER PICTURE S99 VALUE 91. NC2024.2 +011000 03 ADD-CORR-2 PICTURE S99 VALUE 22. NC2024.2 +011100 03 ADD-CORR-1 PICTURE S99 VALUE 11. NC2024.2 +011200 03 ADD-CORR-A PICTURE S99 VALUE 93. NC2024.2 +011300 03 ADD-CORR-4 PICTURE S99 VALUE 44. NC2024.2 +011400 03 ADD-CORR-3 PICTURE S99 VALUE 33. NC2024.2 +011500 03 ADD-CORR-6 PICTURE S99 VALUE 66. NC2024.2 +011600 03 ADD-CORR-5 PICTURE S99 VALUE 55. NC2024.2 +011700 03 ADD-CORR-8 PICTURE S99 VALUE 88. NC2024.2 +011800 03 ADD-CORR-7 PICTURE S99 VALUE 77. NC2024.2 +011900 03 ADD-CORR-9 PICTURE S99 VALUE 99. NC2024.2 +012000 01 GRP-FOR-ADD-CORR-R. NC2024.2 +012100 02 GRP-SUBTRACT-CORR-1. NC2024.2 +012200 05 ADD-CORR-1 PICTURE 99. NC2024.2 +012300 05 ADD-CORR-2 PICTURE 99. NC2024.2 +012400 05 ADD-CORR-3 PICTURE 99. NC2024.2 +012500 05 ADD-CORR-4 PICTURE 99. NC2024.2 +012600 05 ADD-CORR-5 PICTURE 9P. NC2024.2 +012700 05 ADD-CORR-6 PICTURE 999. NC2024.2 +012800 05 ADD-CORR-7 PICTURE 99. NC2024.2 +012900 05 ADD-CORR-8 PICTURE 99. NC2024.2 +013000 05 ADD-CORR-9 PICTURE 99. NC2024.2 +013100 05 FILLER PICTURE 99. NC2024.2 +013200 01 GRP-FOR-ADD-CORR-2. NC2024.2 +013300 02 GRP-ADD-SUB-CORR. NC2024.2 +013400 03 GRP-SUBTRACT-CORR-1. NC2024.2 +013500 04 ADD-CORR-1 PICTURE S99 VALUE 11. NC2024.2 +013600 04 ADD-CORR-2 PICTURE S99 VALUE 22. NC2024.2 +013700 04 ADD-CORR-5 PICTURE S99 VALUE 55. NC2024.2 +013800 04 ADD-CORR-4 PICTURE S99 VALUE 44. NC2024.2 +013900 04 ADD-CORR-3 PICTURE S99 VALUE 33. NC2024.2 +014000 04 ADD-CORR-6 PICTURE S99 VALUE 66. NC2024.2 +014100 04 ADD-CORR-7 PICTURE S99 VALUE 77. NC2024.2 +014200 04 ADD-CORR-8 PICTURE S99 VALUE 88. NC2024.2 +014300 04 ADD-CORR-9 PICTURE S99 VALUE 99. NC2024.2 +014400 04 ADD-CORR-B PICTURE S99 VALUE 92. NC2024.2 +014500 04 ADD-CORR-0 PICTURE S99 VALUE 00. NC2024.2 +014600 01 GRP-FOR-ADD-CORR-A. NC2024.2 +014700 02 GRP-SUBTRACT-CORR-3. NC2024.2 +014800 03 GRP-SUBTRACT-CORR-1. NC2024.2 +014900 05 ADD-CORR-4 PICTURE S999 VALUE 044. NC2024.2 +015000 05 ADD-CORR-3 PICTURE S999 VALUE 033. NC2024.2 +015100 05 ADD-CORR-2 PICTURE S999 VALUE 022. NC2024.2 +015200 05 ADD-CORR-1 PICTURE S999 VALUE 111. NC2024.2 +015300 01 ADD-15. NC2024.2 +015400 02 FIELD1 PICTURE 99999 VALUE 1. NC2024.2 +015500 02 FIELD2 PICTURE 999V99 VALUE 32.1. NC2024.2 +015600 02 FIELD3 PICTURE 999V9 VALUE 123.4. NC2024.2 +015700 01 ADD-16. NC2024.2 +015800 02 FIELD1 PICTURE 99999 VALUE 99999. NC2024.2 +015900 02 FIELD2 PICTURE 999V99 VALUE 745.67. NC2024.2 +016000 02 FIELD3 PICTURE 999V9 VALUE 432.1. NC2024.2 +016100 01 SUBTRACT-DATA. NC2024.2 +016200 02 SUBTR-1 PICTURE 9 VALUE 1. NC2024.2 +016300 02 SUBTR-2 PICTURE S99 VALUE 99. NC2024.2 +016400 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC2024.2 +016500 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC2024.2 +016600 02 SUBTR-5 PICTURE S9PP VALUE 100. NC2024.2 +016700 02 SUBTR-6 PICTURE 9 VALUE 1. NC2024.2 +016800 02 SUBTR-7 PICTURE S99 VALUE 99. NC2024.2 +016900 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC2024.2 +017000 02 SUBTR-9 PICTURE SV999. NC2024.2 +017100 02 SUBTR-10 PICTURE S999 VALUE 100. NC2024.2 +017200 02 SUBTR-11 PICTURE S999V999. NC2024.2 +017300 02 SUBTR-12. NC2024.2 +017400 03 SUBTR-13 PICTURE 9 VALUE 1. NC2024.2 +017500 03 SUBTR-14 PICTURE S9V999 VALUE -1.725. NC2024.2 +017600 03 SUBTR-15 PICTURE S99V99 VALUE 76.76. NC2024.2 +017700 02 SUBTR-16. NC2024.2 +017800 03 SUBTR-13 PICTURE 9 VALUE 2. NC2024.2 +017900 03 SUBTR-14 PICTURE S9V99 VALUE .23. NC2024.2 +018000 03 SUBTR-15 PICTURE S9V99 VALUE 1. NC2024.2 +018100 01 CORR-DATA-1. NC2024.2 +018200 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018300 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018400 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018500 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018600 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018700 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +018800 01 CORR-DATA-2. NC2024.2 +018900 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019000 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019100 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019200 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019300 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019400 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019500 01 CORR-DATA-3. NC2024.2 +019600 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019700 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019800 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +019900 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +020000 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +020100 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2024.2 +020200 01 CORR-DATA-4. NC2024.2 +020300 03 XYZ-11 PICTURE IS 99. NC2024.2 +020400 03 XYZ-12 PICTURE IS 99. NC2024.2 +020500 03 XYZ-13 PICTURE IS 99. NC2024.2 +020600 03 XYZ-14 PICTURE IS 99. NC2024.2 +020700 03 XYZ-15 PICTURE IS 99. NC2024.2 +020800 03 XYZ-16 PICTURE IS 99. NC2024.2 +020900 01 CORR-DATA-5. NC2024.2 +021000 03 XYZ-1 PICTURE 99. NC2024.2 +021100 03 XYZ-2 PICTURE 99. NC2024.2 +021200 03 XYZ-13 PICTURE IS 99. NC2024.2 +021300 03 XYZ-14 PICTURE IS 99. NC2024.2 +021400 03 FILLER PICTURE IS 99. NC2024.2 +021500 03 XYZ-11 PICTURE IS 99. NC2024.2 +021600 03 XYZ-12 PICTURE IS 99. NC2024.2 +021700 01 CORR-DATA-6. NC2024.2 +021800 03 XYZ-11 PICTURE IS 99. NC2024.2 +021900 03 XYZ-12 PICTURE IS 99. NC2024.2 +022000 03 FILLER PICTURE IS 99. NC2024.2 +022100 03 XYZ-1 PICTURE IS 99. NC2024.2 +022200 03 XYZ-2 PICTURE IS 9(2). NC2024.2 +022300 03 FILLER PICTURE IS 99. NC2024.2 +022400 01 CORR-DATA-7. NC2024.2 +022500 02 XYZ-1 PICTURE 99V99 VALUE 10.45. NC2024.2 +022600 02 XYZ-6 PICTURE 999V9 VALUE 100.5. NC2024.2 +022700 02 XYZ-11 PICTURE 99V9 VALUE ZERO. NC2024.2 +022800 02 XYZ-2 PICTURE 99V9 VALUE 0.9. NC2024.2 +022900 01 42-DATANAMES. NC2024.2 +023000 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC2024.2 +023100 02 DNAME2 PICTURE 99 VALUE 1 COMPUTATIONAL. NC2024.2 +023200 02 DNAME3 PICTURE 999 VALUE 1 COMPUTATIONAL. NC2024.2 +023300 02 DNAME4 PICTURE 9(4) VALUE 1 COMPUTATIONAL. NC2024.2 +023400 02 DNAME5 PICTURE 9(5) VALUE 1 COMPUTATIONAL. NC2024.2 +023500 02 DNAME6 PICTURE 9(6) VALUE 1 COMPUTATIONAL. NC2024.2 +023600 02 DNAME7 PICTURE 9(7) VALUE 1 COMPUTATIONAL. NC2024.2 +023700 02 DNAME8 PICTURE 9(8) VALUE 1 COMPUTATIONAL. NC2024.2 +023800 02 DNAME9 PICTURE 9(9) VALUE 1 COMPUTATIONAL. NC2024.2 +023900 02 DNAME10 PICTURE 9(10) VALUE 1. NC2024.2 +024000 02 DNAME11 PICTURE 9(11) VALUE 1. NC2024.2 +024100 02 DNAME12 PICTURE 9(12) VALUE 1. NC2024.2 +024200 02 DNAME13 PICTURE 9(13) VALUE 1. NC2024.2 +024300 02 DNAME14 PICTURE 9(14) VALUE 1. NC2024.2 +024400 02 DNAME15 PICTURE 9(15) VALUE 1. NC2024.2 +024500 02 DNAME16 PICTURE 9(16) VALUE 1. NC2024.2 +024600 02 DNAME17 PICTURE 9(17) VALUE 1. NC2024.2 +024700 02 DNAME18 PICTURE 9(18) VALUE 1. NC2024.2 +024800 02 DNAME19 PICTURE 9 VALUE 1. NC2024.2 +024900 02 DNAME20 PICTURE 99 VALUE 1. NC2024.2 +025000 02 DNAME21 PICTURE 999 VALUE 1. NC2024.2 +025100 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC2024.2 +025200 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC2024.2 +025300 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC2024.2 +025400 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC2024.2 +025500 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC2024.2 +025600 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC2024.2 +025700 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC2024.2 +025800 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC2024.2 +025900 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026000 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026100 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026200 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026300 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026400 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026500 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026600 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026700 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026800 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +026900 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +027000 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +027100 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2024.2 +027200 01 TEST-RESULTS. NC2024.2 +027300 02 FILLER PIC X VALUE SPACE. NC2024.2 +027400 02 FEATURE PIC X(20) VALUE SPACE. NC2024.2 +027500 02 FILLER PIC X VALUE SPACE. NC2024.2 +027600 02 P-OR-F PIC X(5) VALUE SPACE. NC2024.2 +027700 02 FILLER PIC X VALUE SPACE. NC2024.2 +027800 02 PAR-NAME. NC2024.2 +027900 03 FILLER PIC X(19) VALUE SPACE. NC2024.2 +028000 03 PARDOT-X PIC X VALUE SPACE. NC2024.2 +028100 03 DOTVALUE PIC 99 VALUE ZERO. NC2024.2 +028200 02 FILLER PIC X(8) VALUE SPACE. NC2024.2 +028300 02 RE-MARK PIC X(61). NC2024.2 +028400 01 TEST-COMPUTED. NC2024.2 +028500 02 FILLER PIC X(30) VALUE SPACE. NC2024.2 +028600 02 FILLER PIC X(17) VALUE NC2024.2 +028700 " COMPUTED=". NC2024.2 +028800 02 COMPUTED-X. NC2024.2 +028900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2024.2 +029000 03 COMPUTED-N REDEFINES COMPUTED-A NC2024.2 +029100 PIC -9(9).9(9). NC2024.2 +029200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2024.2 +029300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2024.2 +029400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2024.2 +029500 03 CM-18V0 REDEFINES COMPUTED-A. NC2024.2 +029600 04 COMPUTED-18V0 PIC -9(18). NC2024.2 +029700 04 FILLER PIC X. NC2024.2 +029800 03 FILLER PIC X(50) VALUE SPACE. NC2024.2 +029900 01 TEST-CORRECT. NC2024.2 +030000 02 FILLER PIC X(30) VALUE SPACE. NC2024.2 +030100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2024.2 +030200 02 CORRECT-X. NC2024.2 +030300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2024.2 +030400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2024.2 +030500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2024.2 +030600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2024.2 +030700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2024.2 +030800 03 CR-18V0 REDEFINES CORRECT-A. NC2024.2 +030900 04 CORRECT-18V0 PIC -9(18). NC2024.2 +031000 04 FILLER PIC X. NC2024.2 +031100 03 FILLER PIC X(2) VALUE SPACE. NC2024.2 +031200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2024.2 +031300 01 CCVS-C-1. NC2024.2 +031400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2024.2 +031500- "SS PARAGRAPH-NAME NC2024.2 +031600- " REMARKS". NC2024.2 +031700 02 FILLER PIC X(20) VALUE SPACE. NC2024.2 +031800 01 CCVS-C-2. NC2024.2 +031900 02 FILLER PIC X VALUE SPACE. NC2024.2 +032000 02 FILLER PIC X(6) VALUE "TESTED". NC2024.2 +032100 02 FILLER PIC X(15) VALUE SPACE. NC2024.2 +032200 02 FILLER PIC X(4) VALUE "FAIL". NC2024.2 +032300 02 FILLER PIC X(94) VALUE SPACE. NC2024.2 +032400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2024.2 +032500 01 REC-CT PIC 99 VALUE ZERO. NC2024.2 +032600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2024.2 +032700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2024.2 +032800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2024.2 +032900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2024.2 +033000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2024.2 +033100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2024.2 +033200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2024.2 +033300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2024.2 +033400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2024.2 +033500 01 CCVS-H-1. NC2024.2 +033600 02 FILLER PIC X(39) VALUE SPACES. NC2024.2 +033700 02 FILLER PIC X(42) VALUE NC2024.2 +033800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2024.2 +033900 02 FILLER PIC X(39) VALUE SPACES. NC2024.2 +034000 01 CCVS-H-2A. NC2024.2 +034100 02 FILLER PIC X(40) VALUE SPACE. NC2024.2 +034200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2024.2 +034300 02 FILLER PIC XXXX VALUE NC2024.2 +034400 "4.2 ". NC2024.2 +034500 02 FILLER PIC X(28) VALUE NC2024.2 +034600 " COPY - NOT FOR DISTRIBUTION". NC2024.2 +034700 02 FILLER PIC X(41) VALUE SPACE. NC2024.2 +034800 NC2024.2 +034900 01 CCVS-H-2B. NC2024.2 +035000 02 FILLER PIC X(15) VALUE NC2024.2 +035100 "TEST RESULT OF ". NC2024.2 +035200 02 TEST-ID PIC X(9). NC2024.2 +035300 02 FILLER PIC X(4) VALUE NC2024.2 +035400 " IN ". NC2024.2 +035500 02 FILLER PIC X(12) VALUE NC2024.2 +035600 " HIGH ". NC2024.2 +035700 02 FILLER PIC X(22) VALUE NC2024.2 +035800 " LEVEL VALIDATION FOR ". NC2024.2 +035900 02 FILLER PIC X(58) VALUE NC2024.2 +036000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2024.2 +036100 01 CCVS-H-3. NC2024.2 +036200 02 FILLER PIC X(34) VALUE NC2024.2 +036300 " FOR OFFICIAL USE ONLY ". NC2024.2 +036400 02 FILLER PIC X(58) VALUE NC2024.2 +036500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2024.2 +036600 02 FILLER PIC X(28) VALUE NC2024.2 +036700 " COPYRIGHT 1985 ". NC2024.2 +036800 01 CCVS-E-1. NC2024.2 +036900 02 FILLER PIC X(52) VALUE SPACE. NC2024.2 +037000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2024.2 +037100 02 ID-AGAIN PIC X(9). NC2024.2 +037200 02 FILLER PIC X(45) VALUE SPACES. NC2024.2 +037300 01 CCVS-E-2. NC2024.2 +037400 02 FILLER PIC X(31) VALUE SPACE. NC2024.2 +037500 02 FILLER PIC X(21) VALUE SPACE. NC2024.2 +037600 02 CCVS-E-2-2. NC2024.2 +037700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2024.2 +037800 03 FILLER PIC X VALUE SPACE. NC2024.2 +037900 03 ENDER-DESC PIC X(44) VALUE NC2024.2 +038000 "ERRORS ENCOUNTERED". NC2024.2 +038100 01 CCVS-E-3. NC2024.2 +038200 02 FILLER PIC X(22) VALUE NC2024.2 +038300 " FOR OFFICIAL USE ONLY". NC2024.2 +038400 02 FILLER PIC X(12) VALUE SPACE. NC2024.2 +038500 02 FILLER PIC X(58) VALUE NC2024.2 +038600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2024.2 +038700 02 FILLER PIC X(13) VALUE SPACE. NC2024.2 +038800 02 FILLER PIC X(15) VALUE NC2024.2 +038900 " COPYRIGHT 1985". NC2024.2 +039000 01 CCVS-E-4. NC2024.2 +039100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2024.2 +039200 02 FILLER PIC X(4) VALUE " OF ". NC2024.2 +039300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2024.2 +039400 02 FILLER PIC X(40) VALUE NC2024.2 +039500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2024.2 +039600 01 XXINFO. NC2024.2 +039700 02 FILLER PIC X(19) VALUE NC2024.2 +039800 "*** INFORMATION ***". NC2024.2 +039900 02 INFO-TEXT. NC2024.2 +040000 04 FILLER PIC X(8) VALUE SPACE. NC2024.2 +040100 04 XXCOMPUTED PIC X(20). NC2024.2 +040200 04 FILLER PIC X(5) VALUE SPACE. NC2024.2 +040300 04 XXCORRECT PIC X(20). NC2024.2 +040400 02 INF-ANSI-REFERENCE PIC X(48). NC2024.2 +040500 01 HYPHEN-LINE. NC2024.2 +040600 02 FILLER PIC IS X VALUE IS SPACE. NC2024.2 +040700 02 FILLER PIC IS X(65) VALUE IS "************************NC2024.2 +040800- "*****************************************". NC2024.2 +040900 02 FILLER PIC IS X(54) VALUE IS "************************NC2024.2 +041000- "******************************". NC2024.2 +041100 01 CCVS-PGM-ID PIC X(9) VALUE NC2024.2 +041200 "NC202A". NC2024.2 +041300 PROCEDURE DIVISION. NC2024.2 +041400 CCVS1 SECTION. NC2024.2 +041500 OPEN-FILES. NC2024.2 +041600 OPEN OUTPUT PRINT-FILE. NC2024.2 +041700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2024.2 +041800 MOVE SPACE TO TEST-RESULTS. NC2024.2 +041900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2024.2 +042000 GO TO CCVS1-EXIT. NC2024.2 +042100 CLOSE-FILES. NC2024.2 +042200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2024.2 +042300 TERMINATE-CCVS. NC2024.2 +042400*S EXIT PROGRAM. NC2024.2 +042500*SERMINATE-CALL. NC2024.2 +042600 STOP RUN. NC2024.2 +042700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2024.2 +042800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2024.2 +042900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2024.2 +043000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2024.2 +043100 MOVE "****TEST DELETED****" TO RE-MARK. NC2024.2 +043200 PRINT-DETAIL. NC2024.2 +043300 IF REC-CT NOT EQUAL TO ZERO NC2024.2 +043400 MOVE "." TO PARDOT-X NC2024.2 +043500 MOVE REC-CT TO DOTVALUE. NC2024.2 +043600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2024.2 +043700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2024.2 +043800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2024.2 +043900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2024.2 +044000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2024.2 +044100 MOVE SPACE TO CORRECT-X. NC2024.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2024.2 +044300 MOVE SPACE TO RE-MARK. NC2024.2 +044400 HEAD-ROUTINE. NC2024.2 +044500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +044600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +044700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2024.2 +044800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2024.2 +044900 COLUMN-NAMES-ROUTINE. NC2024.2 +045000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +045100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +045200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +045300 END-ROUTINE. NC2024.2 +045400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2024.2 +045500 END-RTN-EXIT. NC2024.2 +045600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +045700 END-ROUTINE-1. NC2024.2 +045800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2024.2 +045900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2024.2 +046000 ADD PASS-COUNTER TO ERROR-HOLD. NC2024.2 +046100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2024.2 +046200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2024.2 +046300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2024.2 +046400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2024.2 +046500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2024.2 +046600 END-ROUTINE-12. NC2024.2 +046700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2024.2 +046800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2024.2 +046900 MOVE "NO " TO ERROR-TOTAL NC2024.2 +047000 ELSE NC2024.2 +047100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2024.2 +047200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2024.2 +047300 PERFORM WRITE-LINE. NC2024.2 +047400 END-ROUTINE-13. NC2024.2 +047500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2024.2 +047600 MOVE "NO " TO ERROR-TOTAL ELSE NC2024.2 +047700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2024.2 +047800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2024.2 +047900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +048000 IF INSPECT-COUNTER EQUAL TO ZERO NC2024.2 +048100 MOVE "NO " TO ERROR-TOTAL NC2024.2 +048200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2024.2 +048300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2024.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +048500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2024.2 +048600 WRITE-LINE. NC2024.2 +048700 ADD 1 TO RECORD-COUNT. NC2024.2 +048800 IF RECORD-COUNT GREATER 50 NC2024.2 +048900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2024.2 +049000 MOVE SPACE TO DUMMY-RECORD NC2024.2 +049100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2024.2 +049200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2024.2 +049300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2024.2 +049400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2024.2 +049500 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2024.2 +049600 MOVE ZERO TO RECORD-COUNT. NC2024.2 +049700 PERFORM WRT-LN. NC2024.2 +049800 WRT-LN. NC2024.2 +049900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2024.2 +050000 MOVE SPACE TO DUMMY-RECORD. NC2024.2 +050100 BLANK-LINE-PRINT. NC2024.2 +050200 PERFORM WRT-LN. NC2024.2 +050300 FAIL-ROUTINE. NC2024.2 +050400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2024.2 +050500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2024.2 +050600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2024.2 +050700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2024.2 +050800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +050900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2024.2 +051000 GO TO FAIL-ROUTINE-EX. NC2024.2 +051100 FAIL-ROUTINE-WRITE. NC2024.2 +051200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2024.2 +051300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2024.2 +051400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2024.2 +051500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2024.2 +051600 FAIL-ROUTINE-EX. EXIT. NC2024.2 +051700 BAIL-OUT. NC2024.2 +051800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2024.2 +051900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2024.2 +052000 BAIL-OUT-WRITE. NC2024.2 +052100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2024.2 +052200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2024.2 +052300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2024.2 +052400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2024.2 +052500 BAIL-OUT-EX. EXIT. NC2024.2 +052600 CCVS1-EXIT. NC2024.2 +052700 EXIT. NC2024.2 +052800 SECT-NC202A-001 SECTION. NC2024.2 +052900 ADD-INIT-F3-1. NC2024.2 +053000 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +053100 MOVE "ADD CORRESPONDING " TO FEATURE. NC2024.2 +053200 MOVE "ADD-TEST-F3-1" TO PAR-NAME. NC2024.2 +053300 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2024.2 +053400 MOVE 11 TO ADD-CORR-1 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053500 MOVE 22 TO ADD-CORR-2 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053600 MOVE 33 TO ADD-CORR-3 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053700 MOVE 44 TO ADD-CORR-4 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053800 MOVE 55 TO ADD-CORR-5 OF GRP-FOR-ADD-CORR-1. NC2024.2 +053900 MOVE 66 TO ADD-CORR-6 OF GRP-FOR-ADD-CORR-1. NC2024.2 +054000 MOVE 77 TO ADD-CORR-7 OF GRP-FOR-ADD-CORR-1. NC2024.2 +054100 MOVE 88 TO ADD-CORR-8 OF GRP-FOR-ADD-CORR-1. NC2024.2 +054200 MOVE 99 TO ADD-CORR-9 OF GRP-FOR-ADD-CORR-1. NC2024.2 +054300 ADD-TEST-F3-1. NC2024.2 +054400 ADD CORRESPONDING GRP-FOR-ADD-CORR-1 TO GRP-FOR-ADD-CORR-R. NC2024.2 +054500 IF GRP-FOR-ADD-CORR-R EQUAL TO "11223344506677889900" NC2024.2 +054600 PERFORM PASS NC2024.2 +054700 GO TO ADD-WRITE-F3-1. NC2024.2 +054800 GO TO ADD-FAIL-F3-1. NC2024.2 +054900 ADD-DELETE-F3-1. NC2024.2 +055000 PERFORM DE-LETE. NC2024.2 +055100 GO TO ADD-WRITE-F3-1. NC2024.2 +055200 ADD-FAIL-F3-1. NC2024.2 +055300 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2024.2 +055400 MOVE "11223344506677889900" TO CORRECT-A. NC2024.2 +055500 PERFORM FAIL. NC2024.2 +055600 ADD-WRITE-F3-1. NC2024.2 +055700 PERFORM PRINT-DETAIL. NC2024.2 +055800* NC2024.2 +055900 ADD-INIT-F3-2. NC2024.2 +056000 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +056100 MOVE "ADD-TEST-F3-2" TO PAR-NAME. NC2024.2 +056200 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2024.2 +056300 MOVE 11 TO ADD-CORR-1 OF GRP-ADD-SUB-CORR. NC2024.2 +056400 MOVE 22 TO ADD-CORR-2 OF GRP-ADD-SUB-CORR. NC2024.2 +056500 MOVE 33 TO ADD-CORR-3 OF GRP-ADD-SUB-CORR. NC2024.2 +056600 MOVE 44 TO ADD-CORR-4 OF GRP-ADD-SUB-CORR. NC2024.2 +056700 MOVE 55 TO ADD-CORR-5 OF GRP-ADD-SUB-CORR. NC2024.2 +056800 MOVE 66 TO ADD-CORR-6 OF GRP-ADD-SUB-CORR. NC2024.2 +056900 MOVE 77 TO ADD-CORR-7 OF GRP-ADD-SUB-CORR. NC2024.2 +057000 MOVE 88 TO ADD-CORR-8 OF GRP-ADD-SUB-CORR. NC2024.2 +057100 MOVE 99 TO ADD-CORR-9 OF GRP-ADD-SUB-CORR. NC2024.2 +057200 ADD-TEST-F3-2. NC2024.2 +057300 ADD CORRESPONDING GRP-ADD-SUB-CORR TO NC2024.2 +057400 GRP-FOR-ADD-CORR-R ROUNDED. NC2024.2 +057500 IF GRP-FOR-ADD-CORR-R EQUAL TO "11223344606677889900" NC2024.2 +057600 PERFORM PASS NC2024.2 +057700 GO TO ADD-WRITE-F3-2. NC2024.2 +057800 GO TO ADD-FAIL-F3-2. NC2024.2 +057900 ADD-DELETE-F3-2. NC2024.2 +058000 PERFORM DE-LETE. NC2024.2 +058100 GO TO ADD-WRITE-F3-2. NC2024.2 +058200 ADD-FAIL-F3-2. NC2024.2 +058300 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2024.2 +058400 MOVE "11223344606677889900" TO CORRECT-A. NC2024.2 +058500 PERFORM FAIL. NC2024.2 +058600 ADD-WRITE-F3-2. NC2024.2 +058700 PERFORM PRINT-DETAIL. NC2024.2 +058800* NC2024.2 +058900 ADD-INIT-F3-3. NC2024.2 +059000 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +059100 MOVE ZERO TO GRP-FOR-ADD-CORR-R, WRK-XN-00001. NC2024.2 +059200 MOVE 111 TO ADD-CORR-1 OF GRP-SUBTRACT-CORR-3. NC2024.2 +059300 MOVE 22 TO ADD-CORR-2 OF GRP-SUBTRACT-CORR-3. NC2024.2 +059400 MOVE 33 TO ADD-CORR-3 OF GRP-SUBTRACT-CORR-3. NC2024.2 +059500 MOVE 44 TO ADD-CORR-4 OF GRP-SUBTRACT-CORR-3. NC2024.2 +059600 ADD-INIT-F3-3-1. NC2024.2 +059700 MOVE "ADD-TEST-F3-3-1" TO PAR-NAME. NC2024.2 +059800 ADD-TEST-F3-3-1. NC2024.2 +059900 ADD CORRESPONDING GRP-SUBTRACT-CORR-3 TO GRP-FOR-ADD-CORR-R NC2024.2 +060000 ON SIZE ERROR MOVE "1" TO WRK-XN-00001. NC2024.2 +060100 IF GRP-FOR-ADD-CORR-R EQUAL TO "00223344000000000000" NC2024.2 +060200 PERFORM PASS NC2024.2 +060300 GO TO ADD-WRITE-F3-3-1. NC2024.2 +060400 GO TO ADD-FAIL-F3-3-1. NC2024.2 +060500 ADD-DELETE-F3-3-1. NC2024.2 +060600 PERFORM DE-LETE. NC2024.2 +060700 GO TO ADD-WRITE-F3-3-1. NC2024.2 +060800 ADD-FAIL-F3-3-1. NC2024.2 +060900 MOVE "00223344000000000000" TO CORRECT-A. NC2024.2 +061000 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2024.2 +061100 PERFORM FAIL. NC2024.2 +061200 ADD-WRITE-F3-3-1. NC2024.2 +061300 PERFORM PRINT-DETAIL. NC2024.2 +061400* NC2024.2 +061500 ADD-INIT-F3-3-2. NC2024.2 +061600 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +061700 MOVE "ADD-TEST-F3-3-2" TO PAR-NAME. NC2024.2 +061800 ADD-TEST-F3-3-2. NC2024.2 +061900 IF WRK-XN-00001 EQUAL TO "1" NC2024.2 +062000 PERFORM PASS NC2024.2 +062100 GO TO ADD-WRITE-F3-3-2. NC2024.2 +062200 GO TO ADD-FAIL-F3-3-2. NC2024.2 +062300 ADD-DELETE-F3-3-2. NC2024.2 +062400 PERFORM DE-LETE. NC2024.2 +062500 GO TO ADD-WRITE-F3-3-2. NC2024.2 +062600 ADD-FAIL-F3-3-2. NC2024.2 +062700 MOVE 1 TO CORRECT-A. NC2024.2 +062800 MOVE WRK-XN-00001 TO COMPUTED-A. NC2024.2 +062900 PERFORM FAIL. NC2024.2 +063000 ADD-WRITE-F3-3-2. NC2024.2 +063100 PERFORM PRINT-DETAIL. NC2024.2 +063200* NC2024.2 +063300 ADD-INIT-F3-4. NC2024.2 +063400 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +063500 MOVE "ADD-TEST-F3-4" TO PAR-NAME. NC2024.2 +063600 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2024.2 +063700 MOVE ZERO TO ADD-CORR-1 OF GRP-FOR-ADD-CORR-A. NC2024.2 +063800 ADD-TEST-F3-4. NC2024.2 +063900 ADD CORRESPONDING GRP-SUBTRACT-CORR-1 OF GRP-SUBTRACT-CORR-3 NC2024.2 +064000 TO GRP-SUBTRACT-CORR-1 OF GRP-FOR-ADD-CORR-R. NC2024.2 +064100 IF GRP-FOR-ADD-CORR-R EQUAL TO "00223344000000000000" NC2024.2 +064200 PERFORM PASS NC2024.2 +064300 GO TO ADD-WRITE-F3-4. NC2024.2 +064400 GO TO ADD-FAIL-F3-4. NC2024.2 +064500 ADD-DELETE-F3-4. NC2024.2 +064600 PERFORM DE-LETE. NC2024.2 +064700 GO TO ADD-WRITE-F3-4. NC2024.2 +064800 ADD-FAIL-F3-4. NC2024.2 +064900 MOVE "00223344000000000000" TO CORRECT-A. NC2024.2 +065000 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2024.2 +065100 PERFORM FAIL. NC2024.2 +065200 ADD-WRITE-F3-4. NC2024.2 +065300 PERFORM PRINT-DETAIL. NC2024.2 +065400* NC2024.2 +065500 ADD-INIT-F3-5-1. NC2024.2 +065600 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +065700 MOVE "ADD-TEST-F3-5-1" TO PAR-NAME. NC2024.2 +065800 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +065900 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +066000 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +066100 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +066200 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +066300 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +066400 ADD-TEST-F3-5-1. NC2024.2 +066500 ADD CORRESPONDING ADD-15 TO ADD-16 ON SIZE ERROR NC2024.2 +066600 PERFORM PASS NC2024.2 +066700 GO TO ADD-WRITE-F3-5-1. NC2024.2 +066800 GO TO ADD-FAIL-F3-5-1. NC2024.2 +066900 ADD-DELETE-F3-5-1. NC2024.2 +067000 PERFORM DE-LETE. NC2024.2 +067100 GO TO ADD-WRITE-F3-5-1. NC2024.2 +067200 ADD-FAIL-F3-5-1. NC2024.2 +067300 PERFORM FAIL. NC2024.2 +067400 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC2024.2 +067500 ADD-WRITE-F3-5-1. NC2024.2 +067600 PERFORM PRINT-DETAIL. NC2024.2 +067700* NC2024.2 +067800 ADD-INIT-F3-5-2. NC2024.2 +067900 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +068000 MOVE "ADD-TEST-F3-5-2" TO PAR-NAME. NC2024.2 +068100 ADD-TEST-F3-5-2. NC2024.2 +068200 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +068300 PERFORM PASS NC2024.2 +068400 GO TO ADD-WRITE-F3-5-2. NC2024.2 +068500 GO TO ADD-FAIL-F3-5-2. NC2024.2 +068600 ADD-DELETE-F3-5-2. NC2024.2 +068700 PERFORM DE-LETE. NC2024.2 +068800 GO TO ADD-WRITE-F3-5-2. NC2024.2 +068900 ADD-FAIL-F3-5-2. NC2024.2 +069000 MOVE FIELD1 OF ADD-16 TO COMPUTED-N. NC2024.2 +069100 MOVE 99999 TO CORRECT-N. NC2024.2 +069200 PERFORM FAIL. NC2024.2 +069300 ADD-WRITE-F3-5-2. NC2024.2 +069400 PERFORM PRINT-DETAIL. NC2024.2 +069500* NC2024.2 +069600 ADD-INIT-F3-5-3. NC2024.2 +069700 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +069800 MOVE "ADD-TEST-F3-5-3" TO PAR-NAME. NC2024.2 +069900 ADD-TEST-F3-5-3. NC2024.2 +070000 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +070100 PERFORM PASS NC2024.2 +070200 GO TO ADD-WRITE-F3-5-3. NC2024.2 +070300 GO TO ADD-FAIL-F3-5-3. NC2024.2 +070400 ADD-DELETE-F3-5-3. NC2024.2 +070500 PERFORM DE-LETE. NC2024.2 +070600 GO TO ADD-WRITE-F3-5-3. NC2024.2 +070700 ADD-FAIL-F3-5-3. NC2024.2 +070800 PERFORM FAIL. NC2024.2 +070900 MOVE FIELD2 OF ADD-16 TO COMPUTED-N. NC2024.2 +071000 MOVE "+777.77" TO CORRECT-A. NC2024.2 +071100 ADD-WRITE-F3-5-3. NC2024.2 +071200 PERFORM PRINT-DETAIL. NC2024.2 +071300* NC2024.2 +071400 ADD-INIT-F3-5-4. NC2024.2 +071500 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +071600 MOVE "ADD-TEST-F3-5-4" TO PAR-NAME. NC2024.2 +071700 ADD-TEST-F3-5-4. NC2024.2 +071800 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +071900 PERFORM PASS NC2024.2 +072000 GO TO ADD-WRITE-F3-5-4. NC2024.2 +072100 GO TO ADD-FAIL-F3-5-4. NC2024.2 +072200 ADD-DELETE-F3-5-4. NC2024.2 +072300 PERFORM DE-LETE. NC2024.2 +072400 GO TO ADD-WRITE-F3-5-4. NC2024.2 +072500 ADD-FAIL-F3-5-4. NC2024.2 +072600 PERFORM FAIL. NC2024.2 +072700 MOVE FIELD3 OF ADD-16 TO COMPUTED-N. NC2024.2 +072800 MOVE 555.5 TO CORRECT-N. NC2024.2 +072900 ADD-WRITE-F3-5-4. NC2024.2 +073000 PERFORM PRINT-DETAIL. NC2024.2 +073100* NC2024.2 +073200 ADD-INIT-F3-6. NC2024.2 +073300 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +073400 MOVE "ADD-TEST-F3-6" TO PAR-NAME. NC2024.2 +073500 MOVE "ADD CORRESPONDING " TO FEATURE. NC2024.2 +073600 MOVE 03 TO XYZ-1 OF CORR-DATA-1. NC2024.2 +073700 MOVE 04 TO XYZ-2 OF CORR-DATA-1 NC2024.2 +073800 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2024.2 +073900 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2024.2 +074000 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2024.2 +074100 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2024.2 +074200 MOVE ZEROES TO CORR-DATA-2. NC2024.2 +074300 ADD-TEST-F3-6. NC2024.2 +074400 ADD CORRESPONDING CORR-DATA-1 TO CORR-DATA-2. NC2024.2 +074500 IF XYZ-4 OF CORR-DATA-2 EQUAL TO ZERO NC2024.2 +074600 PERFORM PASS NC2024.2 +074700 GO TO ADD-WRITE-F3-6. NC2024.2 +074800 GO TO ADD-FAIL-F3-6. NC2024.2 +074900 ADD-DELETE-F3-6. NC2024.2 +075000 PERFORM DE-LETE. NC2024.2 +075100 GO TO ADD-WRITE-F3-6. NC2024.2 +075200 ADD-FAIL-F3-6. NC2024.2 +075300 PERFORM FAIL. NC2024.2 +075400 MOVE XYZ-4 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +075500 MOVE 00 TO CORRECT-A. NC2024.2 +075600 ADD-WRITE-F3-6. NC2024.2 +075700 PERFORM PRINT-DETAIL. NC2024.2 +075800* NC2024.2 +075900 ADD-INIT-F3-7. NC2024.2 +076000 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +076100 MOVE 03 TO XYZ-1 OF CORR-DATA-1. NC2024.2 +076200 MOVE 04 TO XYZ-2 OF CORR-DATA-1 NC2024.2 +076300 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2024.2 +076400 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2024.2 +076500 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2024.2 +076600 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2024.2 +076700 MOVE 060820000200 TO CORR-DATA-2. NC2024.2 +076800 ADD-INIT-F3-7-1. NC2024.2 +076900 MOVE "ADD-TEST-F3-7-1" TO PAR-NAME. NC2024.2 +077000 ADD-TEST-F3-7-1. NC2024.2 +077100 ADD CORRESPONDING CORR-DATA-1 TO CORR-DATA-2. NC2024.2 +077200 IF XYZ-1 OF CORR-DATA-2 EQUAL TO 09 NC2024.2 +077300 PERFORM PASS NC2024.2 +077400 GO TO ADD-WRITE-F3-7-1. NC2024.2 +077500 GO TO ADD-FAIL-F3-7-1. NC2024.2 +077600 ADD-DELETE-F3-7-1. NC2024.2 +077700 PERFORM DE-LETE. NC2024.2 +077800 GO TO ADD-WRITE-F3-7-1. NC2024.2 +077900 ADD-FAIL-F3-7-1. NC2024.2 +078000 PERFORM FAIL. NC2024.2 +078100 MOVE XYZ-1 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +078200 MOVE "09" TO CORRECT-A. NC2024.2 +078300 ADD-WRITE-F3-7-1. NC2024.2 +078400 PERFORM PRINT-DETAIL. NC2024.2 +078500* NC2024.2 +078600 ADD-INIT-F3-7-2. NC2024.2 +078700 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +078800 MOVE "ADD-TEST-F3-7-2" TO PAR-NAME. NC2024.2 +078900 ADD-TEST-F3-7-2. NC2024.2 +079000 IF XYZ-2 OF CORR-DATA-2 EQUAL TO 12 NC2024.2 +079100 PERFORM PASS NC2024.2 +079200 GO TO ADD-WRITE-F3-7-2. NC2024.2 +079300 GO TO ADD-FAIL-F3-7-2. NC2024.2 +079400 ADD-DELETE-F3-7-2. NC2024.2 +079500 PERFORM DE-LETE. NC2024.2 +079600 GO TO ADD-WRITE-F3-7-2. NC2024.2 +079700 ADD-FAIL-F3-7-2. NC2024.2 +079800 PERFORM FAIL. NC2024.2 +079900 MOVE XYZ-2 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +080000 MOVE "12" TO CORRECT-A. NC2024.2 +080100 ADD-WRITE-F3-7-2. NC2024.2 +080200 PERFORM PRINT-DETAIL. NC2024.2 +080300* NC2024.2 +080400 ADD-INIT-F3-7-3. NC2024.2 +080500 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +080600 MOVE "ADD-TEST-F3-7-3" TO PAR-NAME. NC2024.2 +080700 ADD-TEST-F3-7-3. NC2024.2 +080800 IF XYZ-3 OF CORR-DATA-2 EQUAL TO 30 NC2024.2 +080900 PERFORM PASS NC2024.2 +081000 GO TO ADD-WRITE-F3-7-3. NC2024.2 +081100 GO TO ADD-FAIL-F3-7-3. NC2024.2 +081200 ADD-DELETE-F3-7-3. NC2024.2 +081300 PERFORM DE-LETE. NC2024.2 +081400 GO TO ADD-WRITE-F3-7-3. NC2024.2 +081500 ADD-FAIL-F3-7-3. NC2024.2 +081600 PERFORM FAIL. NC2024.2 +081700 MOVE XYZ-3 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +081800 MOVE "30" TO CORRECT-A. NC2024.2 +081900 ADD-WRITE-F3-7-3. NC2024.2 +082000 PERFORM PRINT-DETAIL. NC2024.2 +082100* NC2024.2 +082200 ADD-INIT-F3-7-4. NC2024.2 +082300 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +082400 MOVE "ADD-TEST-F3-7-4" TO PAR-NAME. NC2024.2 +082500 ADD-TEST-F3-7-4. NC2024.2 +082600 IF XYZ-4 OF CORR-DATA-2 EQUAL TO 00 NC2024.2 +082700 PERFORM PASS NC2024.2 +082800 GO TO ADD-WRITE-F3-7-4. NC2024.2 +082900 GO TO ADD-FAIL-F3-7-4. NC2024.2 +083000 ADD-DELETE-F3-7-4. NC2024.2 +083100 PERFORM DE-LETE. NC2024.2 +083200 GO TO ADD-WRITE-F3-7-4. NC2024.2 +083300 ADD-FAIL-F3-7-4. NC2024.2 +083400 PERFORM FAIL. NC2024.2 +083500 MOVE XYZ-4 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +083600 MOVE "00" TO CORRECT-A. NC2024.2 +083700 ADD-WRITE-F3-7-4. NC2024.2 +083800 PERFORM PRINT-DETAIL. NC2024.2 +083900* NC2024.2 +084000 ADD-INIT-F3-7-5. NC2024.2 +084100 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +084200 MOVE "ADD-TEST-F3-7-5" TO PAR-NAME. NC2024.2 +084300 ADD-TEST-F3-7-5. NC2024.2 +084400 IF XYZ-5 IN CORR-DATA-2 EQUAL TO 03 NC2024.2 +084500 PERFORM PASS NC2024.2 +084600 GO TO ADD-WRITE-F3-7-5. NC2024.2 +084700 GO TO ADD-FAIL-F3-7-5. NC2024.2 +084800 DELETE-F3-7-5. NC2024.2 +084900 PERFORM DE-LETE. NC2024.2 +085000 GO TO ADD-WRITE-F3-7-5. NC2024.2 +085100 ADD-FAIL-F3-7-5. NC2024.2 +085200 MOVE XYZ-5 OF CORR-DATA-2 TO COMPUTED-A. NC2024.2 +085300 MOVE "03" TO CORRECT-A. NC2024.2 +085400 PERFORM FAIL. NC2024.2 +085500 ADD-WRITE-F3-7-5. NC2024.2 +085600 PERFORM PRINT-DETAIL. NC2024.2 +085700* NC2024.2 +085800 ADD-INIT-F3-8. NC2024.2 +085900 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +086000 MOVE ZERO TO WRK-AN-00001. NC2024.2 +086100 MOVE 03 TO XYZ-1 OF CORR-DATA-1. NC2024.2 +086200 MOVE 04 TO XYZ-2 OF CORR-DATA-1 NC2024.2 +086300 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2024.2 +086400 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2024.2 +086500 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2024.2 +086600 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2024.2 +086700 MOVE 999999999999 TO CORR-DATA-2. NC2024.2 +086800 ADD-INIT-F3-8-1. NC2024.2 +086900 MOVE "ADD-TEST-F3-8-1" TO PAR-NAME. NC2024.2 +087000 ADD-TEST-F3-8-1. NC2024.2 +087100 ADD CORRESPONDING CORR-DATA-1 TO CORR-DATA-2 ON SIZE ERROR NC2024.2 +087200 MOVE 4 TO WRK-AN-00001. NC2024.2 +087300 IF WRK-AN-00001 EQUAL TO "4" NC2024.2 +087400 PERFORM PASS NC2024.2 +087500 GO TO ADD-WRITE-F3-8-1. NC2024.2 +087600 GO TO ADD-FAIL-F3-8-1. NC2024.2 +087700 ADD-DELETE-F3-8-1. NC2024.2 +087800 PERFORM DE-LETE. NC2024.2 +087900 GO TO ADD-WRITE-F3-8-1. NC2024.2 +088000 ADD-FAIL-F3-8-1. NC2024.2 +088100 PERFORM FAIL. NC2024.2 +088200 MOVE WRK-AN-00001 TO COMPUTED-A. NC2024.2 +088300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC2024.2 +088400 ADD-WRITE-F3-8-1. NC2024.2 +088500 PERFORM PRINT-DETAIL. NC2024.2 +088600* NC2024.2 +088700 ADD-INIT-F3-8-2. NC2024.2 +088800 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +088900 MOVE "ADD-TEST-F3-8-2" TO PAR-NAME. NC2024.2 +089000 ADD-TEST-F3-8-2. NC2024.2 +089100 IF CORR-DATA-2 EQUAL TO "999999999999" NC2024.2 +089200 PERFORM PASS NC2024.2 +089300 GO TO ADD-WRITE-F3-8-2. NC2024.2 +089400 GO TO ADD-FAIL-F3-8-2. NC2024.2 +089500 ADD-DELETE-F3-8-2. NC2024.2 +089600 PERFORM DE-LETE. NC2024.2 +089700 GO TO ADD-WRITE-F3-8-2. NC2024.2 +089800 ADD-FAIL-F3-8-2. NC2024.2 +089900 PERFORM FAIL. NC2024.2 +090000 MOVE CORR-DATA-2 TO COMPUTED-A. NC2024.2 +090100 MOVE "999999999999" TO CORRECT-A. NC2024.2 +090200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC2024.2 +090300 ADD-WRITE-F3-8-2. NC2024.2 +090400 PERFORM PRINT-DETAIL. NC2024.2 +090500* NC2024.2 +090600 ADD-INIT-F3-9-1. NC2024.2 +090700 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +090800 MOVE "ADD-TEST-F3-9-1" TO PAR-NAME. NC2024.2 +090900 MOVE ZEROES TO CORR-DATA-5. NC2024.2 +091000 MOVE 222222222222 TO CORR-DATA-1. NC2024.2 +091100 ADD-TEST-F3-9-1. NC2024.2 +091200 ADD CORRESPONDING CORR-DATA-1 TO CORR-DATA-5. NC2024.2 +091300 IF XYZ-1 OF CORR-DATA-5 EQUAL TO 22 NC2024.2 +091400 PERFORM PASS NC2024.2 +091500 GO TO ADD-WRITE-F3-9-1. NC2024.2 +091600 GO TO ADD-FAIL-F3-9-1. NC2024.2 +091700 ADD-DELETE-F3-9-1. NC2024.2 +091800 PERFORM DE-LETE. NC2024.2 +091900 GO TO ADD-WRITE-F3-9-1. NC2024.2 +092000 ADD-FAIL-F3-9-1. NC2024.2 +092100 MOVE XYZ-1 OF CORR-DATA-5 TO COMPUTED-A. NC2024.2 +092200 MOVE "22" TO CORRECT-A. NC2024.2 +092300 PERFORM FAIL. NC2024.2 +092400 ADD-WRITE-F3-9-1. NC2024.2 +092500 PERFORM PRINT-DETAIL. NC2024.2 +092600* NC2024.2 +092700 ADD-INIT-F3-9-2. NC2024.2 +092800 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +092900 MOVE "ADD-TEST-F3-9-2" TO PAR-NAME. NC2024.2 +093000 ADD-TEST-F3-9-2. NC2024.2 +093100 IF XYZ-13 OF CORR-DATA-5 EQUAL TO 00 NC2024.2 +093200 PERFORM PASS NC2024.2 +093300 GO TO ADD-WRITE-F3-9-2. NC2024.2 +093400 GO TO ADD-FAIL-F3-9-2. NC2024.2 +093500 ADD-DELETE-F3-9-2. NC2024.2 +093600 PERFORM DE-LETE. NC2024.2 +093700 GO TO ADD-WRITE-F3-9-2. NC2024.2 +093800 ADD-FAIL-F3-9-2. NC2024.2 +093900 MOVE XYZ-13 OF CORR-DATA-5 TO COMPUTED-A. NC2024.2 +094000 MOVE "00" TO CORRECT-A. NC2024.2 +094100 PERFORM FAIL. NC2024.2 +094200 ADD-WRITE-F3-9-2. NC2024.2 +094300 PERFORM PRINT-DETAIL. NC2024.2 +094400* NC2024.2 +094500 ADD-INIT-F3-9-3. NC2024.2 +094600 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +094700 MOVE "ADD-TEST-F3-9-3" TO PAR-NAME. NC2024.2 +094800 ADD-TEST-F3-9-3. NC2024.2 +094900 IF XYZ-11 OF CORR-DATA-5 EQUAL TO 00 NC2024.2 +095000 PERFORM PASS NC2024.2 +095100 GO TO ADD-WRITE-F3-9-3. NC2024.2 +095200 GO TO ADD-FAIL-F3-9-3. NC2024.2 +095300 ADD-DELETE-F3-9-3. NC2024.2 +095400 PERFORM DE-LETE. NC2024.2 +095500 GO TO ADD-WRITE-F3-9-3. NC2024.2 +095600 ADD-FAIL-F3-9-3. NC2024.2 +095700 MOVE XYZ-11 OF CORR-DATA-5 TO COMPUTED-A. NC2024.2 +095800 MOVE "00" TO CORRECT-A. NC2024.2 +095900 PERFORM FAIL. NC2024.2 +096000 ADD-WRITE-F3-9-3. NC2024.2 +096100 PERFORM PRINT-DETAIL. NC2024.2 +096200* NC2024.2 +096300 ADD-INIT-F3-10. NC2024.2 +096400 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +096500 MOVE ZERO TO CORR-DATA-5. NC2024.2 +096600 MOVE 10 TO XYZ-1 OF CORR-DATA-5. NC2024.2 +096700 MOVE 98 TO XYZ-2 OF CORR-DATA-5. NC2024.2 +096800 MOVE 01 TO XYZ-11 OF CORR-DATA-5. NC2024.2 +096900 MOVE 10.45 TO XYZ-1 OF CORR-DATA-7. NC2024.2 +097000 MOVE 0.9 TO XYZ-2 OF CORR-DATA-7. NC2024.2 +097100 MOVE ZERO TO XYZ-11 OF CORR-DATA-7. NC2024.2 +097200 ADD-INIT-F3-10-1. NC2024.2 +097300 MOVE "ADD-TEST-F3-10-1" TO PAR-NAME. NC2024.2 +097400 ADD-TEST-F3-10-1. NC2024.2 +097500 ADD CORRESPONDING CORR-DATA-7 TO CORR-DATA-5. NC2024.2 +097600 IF XYZ-1 IN CORR-DATA-5 EQUAL TO 20 NC2024.2 +097700 PERFORM PASS NC2024.2 +097800 GO TO ADD-WRITE-F3-10-1. NC2024.2 +097900 GO TO ADD-FAIL-F3-10-1. NC2024.2 +098000 ADD-DELETE-F3-10-1. NC2024.2 +098100 PERFORM DE-LETE. NC2024.2 +098200 GO TO ADD-WRITE-F3-10-1. NC2024.2 +098300 ADD-FAIL-F3-10-1. NC2024.2 +098400 PERFORM FAIL. NC2024.2 +098500 MOVE XYZ-1 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +098600 MOVE "+20.0000" TO CORRECT-A. NC2024.2 +098700 ADD-WRITE-F3-10-1. NC2024.2 +098800 PERFORM PRINT-DETAIL. NC2024.2 +098900* NC2024.2 +099000 ADD-INIT-F3-10-2. NC2024.2 +099100 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +099200 MOVE "ADD-TEST-F3-10-2" TO PAR-NAME. NC2024.2 +099300 ADD-TEST-F3-10-2. NC2024.2 +099400 IF XYZ-2 IN CORR-DATA-5 EQUAL TO 98 NC2024.2 +099500 PERFORM PASS NC2024.2 +099600 GO TO ADD-WRITE-F3-10-2. NC2024.2 +099700 GO TO ADD-FAIL-F3-10-2. NC2024.2 +099800 ADD-DELETE-F3-10-2. NC2024.2 +099900 PERFORM DE-LETE. NC2024.2 +100000 GO TO ADD-WRITE-F3-10-2. NC2024.2 +100100 ADD-FAIL-F3-10-2. NC2024.2 +100200 PERFORM FAIL. NC2024.2 +100300 MOVE XYZ-2 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +100400 MOVE "98.0000" TO CORRECT-A. NC2024.2 +100500 ADD-WRITE-F3-10-2. NC2024.2 +100600 PERFORM PRINT-DETAIL. NC2024.2 +100700* NC2024.2 +100800 ADD-INIT-F3-10-3. NC2024.2 +100900 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +101000 MOVE "ADD-TEST-F3-10-3" TO PAR-NAME. NC2024.2 +101100 ADD-TEST-F3-10-3. NC2024.2 +101200 IF XYZ-11 OF CORR-DATA-5 EQUAL TO 01 NC2024.2 +101300 PERFORM PASS NC2024.2 +101400 GO TO ADD-WRITE-F3-10-3. NC2024.2 +101500 GO TO ADD-FAIL-F3-10-3. NC2024.2 +101600 ADD-DELETE-F3-10-3. NC2024.2 +101700 PERFORM DE-LETE. NC2024.2 +101800 GO TO ADD-WRITE-F3-10-3. NC2024.2 +101900 ADD-FAIL-F3-10-3. NC2024.2 +102000 PERFORM FAIL. NC2024.2 +102100 MOVE XYZ-11 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +102200 MOVE "+01.0000" TO CORRECT-A. NC2024.2 +102300 ADD-WRITE-F3-10-3. NC2024.2 +102400 PERFORM PRINT-DETAIL. NC2024.2 +102500* NC2024.2 +102600 ADD-INIT-F3-11. NC2024.2 +102700 MOVE ZERO TO CORR-DATA-5. NC2024.2 +102800 MOVE 10 TO XYZ-1 OF CORR-DATA-5. NC2024.2 +102900 MOVE 98 TO XYZ-2 OF CORR-DATA-5. NC2024.2 +103000 MOVE 01 TO XYZ-11 OF CORR-DATA-5. NC2024.2 +103100 MOVE 10.45 TO XYZ-1 OF CORR-DATA-7. NC2024.2 +103200 MOVE 0.9 TO XYZ-2 OF CORR-DATA-7. NC2024.2 +103300 MOVE ZERO TO XYZ-11 OF CORR-DATA-7. NC2024.2 +103400 ADD-INIT-F3-11-1. NC2024.2 +103500 MOVE "ADD-TEST-F3-11-1" TO PAR-NAME. NC2024.2 +103600 ADD-TEST-F3-11-1. NC2024.2 +103700 ADD CORRESPONDING CORR-DATA-7 TO CORR-DATA-5 ROUNDED. NC2024.2 +103800 IF XYZ-1 OF CORR-DATA-5 EQUAL TO 20 NC2024.2 +103900 PERFORM PASS NC2024.2 +104000 GO TO ADD-WRITE-F3-11-1. NC2024.2 +104100 GO TO ADD-FAIL-F3-11-1. NC2024.2 +104200 ADD-DELETE-F3-11-1. NC2024.2 +104300 PERFORM DE-LETE. NC2024.2 +104400 GO TO ADD-WRITE-F3-11-1. NC2024.2 +104500 ADD-FAIL-F3-11-1. NC2024.2 +104600 PERFORM FAIL. NC2024.2 +104700 MOVE XYZ-1 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +104800 MOVE 20.0000 TO CORRECT-N. NC2024.2 +104900 ADD-WRITE-F3-11-1. NC2024.2 +105000 PERFORM PRINT-DETAIL. NC2024.2 +105100* NC2024.2 +105200 ADD-INIT-F3-11-2. NC2024.2 +105300 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +105400 MOVE "ADD-TEST-F3-11-2" TO PAR-NAME. NC2024.2 +105500 ADD-TEST-F3-11-2. NC2024.2 +105600 IF XYZ-2 OF CORR-DATA-5 EQUAL TO 99 NC2024.2 +105700 PERFORM PASS NC2024.2 +105800 GO TO ADD-WRITE-F3-11-2. NC2024.2 +105900 GO TO ADD-FAIL-F3-11-2. NC2024.2 +106000 ADD-DELETE-F3-11-2. NC2024.2 +106100 PERFORM DE-LETE. NC2024.2 +106200 GO TO ADD-WRITE-F3-11-2. NC2024.2 +106300 ADD-FAIL-F3-11-2. NC2024.2 +106400 MOVE XYZ-2 OF CORR-DATA-5 TO COMPUTED-N. NC2024.2 +106500 MOVE "+99.0000" TO CORRECT-A. NC2024.2 +106600 PERFORM FAIL. NC2024.2 +106700 ADD-WRITE-F3-11-2. NC2024.2 +106800 PERFORM PRINT-DETAIL. NC2024.2 +106900* NC2024.2 +107000 ADD-INIT-F3-12. NC2024.2 +107100 MOVE "VI-74 6.6.4 GR3" TO ANSI-REFERENCE. NC2024.2 +107200 MOVE "ADD-TEST-F3-12" TO PAR-NAME. NC2024.2 +107300 MOVE ZERO TO CORR-DATA-5. NC2024.2 +107400 MOVE 10 TO XYZ-1 OF CORR-DATA-5. NC2024.2 +107500 MOVE 99 TO XYZ-2 OF CORR-DATA-5. NC2024.2 +107600 MOVE 01 TO XYZ-11 OF CORR-DATA-5. NC2024.2 +107700 MOVE 10.45 TO XYZ-1 OF CORR-DATA-7. NC2024.2 +107800 MOVE 0.9 TO XYZ-2 OF CORR-DATA-7. NC2024.2 +107900 MOVE ZERO TO XYZ-11 OF CORR-DATA-7. NC2024.2 +108000 MOVE SPACE TO WRK-AN-00001. NC2024.2 +108100 ADD-TEST-F3-12. NC2024.2 +108200 ADD CORRESPONDING CORR-DATA-7 TO CORR-DATA-5 ROUNDED NC2024.2 +108300 ON SIZE ERROR MOVE "W" TO WRK-AN-00001. NC2024.2 +108400 IF WRK-AN-00001 EQUAL TO "W" NC2024.2 +108500 PERFORM PASS NC2024.2 +108600 GO TO ADD-WRITE-F3-12. NC2024.2 +108700 GO TO ADD-FAIL-F3-12. NC2024.2 +108800 ADD-DELETE-F3-12. NC2024.2 +108900 PERFORM DE-LETE. NC2024.2 +109000 GO TO ADD-WRITE-F3-12. NC2024.2 +109100 ADD-FAIL-F3-12. NC2024.2 +109200 PERFORM FAIL. NC2024.2 +109300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC2024.2 +109400 ADD-WRITE-F3-12. NC2024.2 +109500 PERFORM PRINT-DETAIL. NC2024.2 +109600* NC2024.2 +109700 ADD-INIT-F3-13. NC2024.2 +109800 MOVE "ADD-TEST-F3-13" TO PAR-NAME. NC2024.2 +109900 MOVE "VI-74 6.6.4" TO ANSI-REFERENCE. NC2024.2 +110000 MOVE "ADD CORRESPONDING" TO FEATURE. NC2024.2 +110100 BUILD-TABLE1. NC2024.2 +110200 MOVE 06 TO RECORD1 OF TABLE1. NC2024.2 +110300 MOVE 01 TO RECORD2 OF TABLE1 (1). NC2024.2 +110400 MOVE 02 TO RECORD2 OF TABLE1 (2). NC2024.2 +110500 MOVE 07 TO RECORD3 OF TABLE1. NC2024.2 +110600 BUILD-TABLE2. NC2024.2 +110700 MOVE 08 TO RECORD1 OF TABLE2. NC2024.2 +110800 MOVE 03 TO RECORD2 OF TABLE2 (1). NC2024.2 +110900 MOVE 04 TO RECORD2 OF TABLE2 (2). NC2024.2 +111000 MOVE 09 TO RECORD3 OF TABLE2. NC2024.2 +111100 ADD-TEST-F3-13. NC2024.2 +111200 ADD CORRESPONDING TABLE1 TO TABLE2. NC2024.2 +111300 IF RECORD1 OF TABLE2 = 14 AND NC2024.2 +111400 RECORD2 OF TABLE2 (1) = 03 AND NC2024.2 +111500 RECORD2 OF TABLE2 (2) = 04 AND NC2024.2 +111600 RECORD3 OF TABLE2 = 16 NC2024.2 +111700 PERFORM PASS NC2024.2 +111800 GO TO ADD-WRITE-F3-13. NC2024.2 +111900 GO TO ADD-FAIL-F3-13. NC2024.2 +112000 ADD-DELETE-F3-13. NC2024.2 +112100 PERFORM DE-LETE. NC2024.2 +112200 GO TO ADD-WRITE-F3-13. NC2024.2 +112300 ADD-FAIL-F3-13. NC2024.2 +112400 PERFORM FAIL. NC2024.2 +112500 MOVE TABLE2 TO COMPUTED-A. NC2024.2 +112600 MOVE "14030416" TO CORRECT-A. NC2024.2 +112700 ADD-WRITE-F3-13. NC2024.2 +112800 PERFORM PRINT-DETAIL. NC2024.2 +112900* NC2024.2 +113000 ADD-INIT-F3-14. NC2024.2 +113100 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +113200* ===--> NO SIZE ERROR <--=== NC2024.2 +113300 MOVE 1 TO REC-CT. NC2024.2 +113400 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +113500 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +113600 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +113700 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +113800 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +113900 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +114000 MOVE "ADD-TEST-F3-14-0" TO PAR-NAME. NC2024.2 +114100 ADD-TEST-F3-14-1. NC2024.2 +114200 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +114300 ON SIZE ERROR NC2024.2 +114400 GO TO ADD-FAIL-F3-14-1. NC2024.2 +114500 PERFORM PASS. NC2024.2 +114600 GO TO ADD-WRITE-F3-14-1. NC2024.2 +114700 ADD-DELETE-F3-14-1. NC2024.2 +114800 PERFORM DE-LETE. NC2024.2 +114900 GO TO ADD-WRITE-F3-14-1. NC2024.2 +115000 ADD-FAIL-F3-14-1. NC2024.2 +115100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +115200 TO RE-MARK NC2024.2 +115300 PERFORM FAIL. NC2024.2 +115400 ADD-WRITE-F3-14-1. NC2024.2 +115500 PERFORM PRINT-DETAIL. NC2024.2 +115600* NC2024.2 +115700 ADD-INIT-F3-14-2. NC2024.2 +115800 MOVE "ADD-TEST-F3-14-2" TO PAR-NAME. NC2024.2 +115900 ADD 1 TO REC-CT. NC2024.2 +116000 ADD-TEST-F3-14-2. NC2024.2 +116100 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +116200 PERFORM PASS NC2024.2 +116300 GO TO ADD-WRITE-F3-14-2. NC2024.2 +116400 GO TO ADD-FAIL-F3-14-2. NC2024.2 +116500 ADD-DELETE-F3-14-2. NC2024.2 +116600 PERFORM DE-LETE NC2024.2 +116700 GO TO ADD-WRITE-F3-14-2. NC2024.2 +116800 ADD-FAIL-F3-14-2. NC2024.2 +116900 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +117000 MOVE 88889 TO CORRECT-N NC2024.2 +117100 PERFORM FAIL. NC2024.2 +117200 ADD-WRITE-F3-14-2. NC2024.2 +117300 PERFORM PRINT-DETAIL. NC2024.2 +117400* NC2024.2 +117500 ADD-INIT-F3-14-3. NC2024.2 +117600 MOVE "ADD-TEST-F3-14-3" TO PAR-NAME. NC2024.2 +117700 ADD 1 TO REC-CT. NC2024.2 +117800 ADD-TEST-F3-14-3. NC2024.2 +117900 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +118000 PERFORM PASS NC2024.2 +118100 GO TO ADD-WRITE-F3-14-3. NC2024.2 +118200 GO TO ADD-FAIL-F3-14-3. NC2024.2 +118300 ADD-DELETE-F3-14-3. NC2024.2 +118400 PERFORM DE-LETE. NC2024.2 +118500 GO TO ADD-WRITE-F3-14-3. NC2024.2 +118600 ADD-FAIL-F3-14-3. NC2024.2 +118700 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +118800 MOVE "+777.77" TO CORRECT-A NC2024.2 +118900 PERFORM FAIL. NC2024.2 +119000 ADD-WRITE-F3-14-3. NC2024.2 +119100 PERFORM PRINT-DETAIL. NC2024.2 +119200* NC2024.2 +119300 ADD-INIT-F3-14-4. NC2024.2 +119400 MOVE "ADD-TEST-F3-14-4" TO PAR-NAME. NC2024.2 +119500 ADD 1 TO REC-CT. NC2024.2 +119600 ADD-TEST-F3-14-4. NC2024.2 +119700 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +119800 PERFORM PASS NC2024.2 +119900 GO TO ADD-WRITE-F3-14-4. NC2024.2 +120000 GO TO ADD-FAIL-F3-14-4. NC2024.2 +120100 ADD-DELETE-F3-14-4. NC2024.2 +120200 PERFORM DE-LETE. NC2024.2 +120300 GO TO ADD-WRITE-F3-14-4. NC2024.2 +120400 ADD-FAIL-F3-14-4. NC2024.2 +120500 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +120600 MOVE 555.5 TO CORRECT-N NC2024.2 +120700 PERFORM FAIL. NC2024.2 +120800 ADD-WRITE-F3-14-4. NC2024.2 +120900 PERFORM PRINT-DETAIL. NC2024.2 +121000* NC2024.2 +121100 ADD-INIT-F3-15. NC2024.2 +121200* ===--> NEW SIZE ERROR TESTS <--=== NC2024.2 +121300* ===--> SIZE ERROR <--=== NC2024.2 +121400 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +121500 MOVE 0 TO REC-CT. NC2024.2 +121600 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +121700 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +121800 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +121900 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +122000 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +122100 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +122200* NC2024.2 +122300 ADD-INIT-F3-15-1. NC2024.2 +122400 MOVE "ADD-TEST-F3-15-1" TO PAR-NAME. NC2024.2 +122500 ADD 1 TO REC-CT. NC2024.2 +122600 ADD-TEST-F3-15-1. NC2024.2 +122700 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +122800 NOT ON SIZE ERROR NC2024.2 +122900 GO TO ADD-FAIL-F3-15-1. NC2024.2 +123000 PERFORM PASS. NC2024.2 +123100 GO TO ADD-WRITE-F3-15-1. NC2024.2 +123200 ADD-DELETE-F3-15-1. NC2024.2 +123300 PERFORM DE-LETE. NC2024.2 +123400 GO TO ADD-WRITE-F3-15-1. NC2024.2 +123500 ADD-FAIL-F3-15-1. NC2024.2 +123600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +123700 TO RE-MARK NC2024.2 +123800 PERFORM FAIL. NC2024.2 +123900 ADD-WRITE-F3-15-1. NC2024.2 +124000 PERFORM PRINT-DETAIL. NC2024.2 +124100* NC2024.2 +124200 ADD-INIT-F3-15-2. NC2024.2 +124300 MOVE "ADD-TEST-F3-15-2" TO PAR-NAME. NC2024.2 +124400 ADD 1 TO REC-CT. NC2024.2 +124500 ADD-TEST-F3-15-2. NC2024.2 +124600 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +124700 PERFORM PASS NC2024.2 +124800 GO TO ADD-WRITE-F3-15-2. NC2024.2 +124900 GO TO ADD-FAIL-F3-15-2. NC2024.2 +125000 ADD-DELETE-F3-15-2. NC2024.2 +125100 PERFORM DE-LETE. NC2024.2 +125200 GO TO ADD-WRITE-F3-15-2. NC2024.2 +125300 ADD-FAIL-F3-15-2. NC2024.2 +125400 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +125500 MOVE 99999 TO CORRECT-N NC2024.2 +125600 PERFORM FAIL. NC2024.2 +125700 ADD-WRITE-F3-15-2. NC2024.2 +125800 PERFORM PRINT-DETAIL. NC2024.2 +125900* NC2024.2 +126000 ADD-INIT-F3-15-3. NC2024.2 +126100 MOVE "ADD-TEST-F3-15-3" TO PAR-NAME. NC2024.2 +126200 ADD 1 TO REC-CT. NC2024.2 +126300 ADD-TEST-F3-15-3. NC2024.2 +126400 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +126500 PERFORM PASS NC2024.2 +126600 GO TO ADD-WRITE-F3-15-3. NC2024.2 +126700 GO TO ADD-FAIL-F3-15-3. NC2024.2 +126800 ADD-DELETE-F3-15-3. NC2024.2 +126900 PERFORM DE-LETE. NC2024.2 +127000 GO TO ADD-WRITE-F3-15-3. NC2024.2 +127100 ADD-FAIL-F3-15-3. NC2024.2 +127200 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +127300 MOVE "+777.77" TO CORRECT-A NC2024.2 +127400 PERFORM FAIL. NC2024.2 +127500 ADD-WRITE-F3-15-3. NC2024.2 +127600 PERFORM PRINT-DETAIL. NC2024.2 +127700* NC2024.2 +127800 ADD-INIT-F3-15-4. NC2024.2 +127900 MOVE "ADD-TEST-F3-15-4" TO PAR-NAME. NC2024.2 +128000 ADD 1 TO REC-CT. NC2024.2 +128100 ADD-TEST-F3-15-4. NC2024.2 +128200 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +128300 PERFORM PASS NC2024.2 +128400 GO TO ADD-WRITE-F3-15-4. NC2024.2 +128500 GO TO ADD-FAIL-F3-15-4. NC2024.2 +128600 ADD-DELETE-F3-15-4. NC2024.2 +128700 PERFORM DE-LETE. NC2024.2 +128800 GO TO ADD-WRITE-F3-15-4. NC2024.2 +128900 ADD-FAIL-F3-15-4. NC2024.2 +129000 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +129100 MOVE 555.5 TO CORRECT-N NC2024.2 +129200 PERFORM FAIL. NC2024.2 +129300 ADD-WRITE-F3-15-4. NC2024.2 +129400 PERFORM PRINT-DETAIL. NC2024.2 +129500* NC2024.2 +129600 ADD-INIT-F3-16. NC2024.2 +129700* ===--> NEW SIZE ERROR TESTS <--=== NC2024.2 +129800* ===--> NO SIZE ERROR <--=== NC2024.2 +129900 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +130000 MOVE 1 TO REC-CT. NC2024.2 +130100 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +130200 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +130300 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +130400 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +130500 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +130600 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +130700 ADD-INIT-F3-16-1. NC2024.2 +130800 MOVE "ADD-TEST-F3-16-1" TO PAR-NAME. NC2024.2 +130900 ADD-TEST-F3-16-1. NC2024.2 +131000 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +131100 NOT ON SIZE ERROR NC2024.2 +131200 PERFORM PASS NC2024.2 +131300 GO TO ADD-WRITE-F3-16-1. NC2024.2 +131400 GO TO ADD-FAIL-F3-16-1. NC2024.2 +131500 ADD-DELETE-F3-16-1. NC2024.2 +131600 PERFORM DE-LETE. NC2024.2 +131700 GO TO ADD-WRITE-F3-16-1. NC2024.2 +131800 ADD-FAIL-F3-16-1. NC2024.2 +131900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC2024.2 +132000 PERFORM FAIL. NC2024.2 +132100 ADD-WRITE-F3-16-1. NC2024.2 +132200 PERFORM PRINT-DETAIL. NC2024.2 +132300* NC2024.2 +132400 ADD-INIT-F3-16-2. NC2024.2 +132500 MOVE "ADD-TEST-F3-16-2" TO PAR-NAME. NC2024.2 +132600 ADD 1 TO REC-CT. NC2024.2 +132700 ADD-TEST-F3-16-2. NC2024.2 +132800 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +132900 PERFORM PASS NC2024.2 +133000 GO TO ADD-WRITE-F3-16-2. NC2024.2 +133100 GO TO ADD-FAIL-F3-16-2. NC2024.2 +133200 ADD-DELETE-F3-16-2. NC2024.2 +133300 PERFORM DE-LETE. NC2024.2 +133400 GO TO ADD-WRITE-F3-16-2. NC2024.2 +133500 ADD-FAIL-F3-16-2. NC2024.2 +133600 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +133700 MOVE 88889 TO CORRECT-N NC2024.2 +133800 PERFORM FAIL. NC2024.2 +133900 ADD-WRITE-F3-16-2. NC2024.2 +134000 PERFORM PRINT-DETAIL. NC2024.2 +134100* NC2024.2 +134200 ADD-INIT-F3-16-3. NC2024.2 +134300 MOVE "ADD-TEST-F3-16-3" TO PAR-NAME. NC2024.2 +134400 ADD 1 TO REC-CT. NC2024.2 +134500 ADD-TEST-F3-16-3. NC2024.2 +134600 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +134700 PERFORM PASS NC2024.2 +134800 GO TO ADD-WRITE-F3-16-3. NC2024.2 +134900 GO TO ADD-FAIL-F3-16-3. NC2024.2 +135000 ADD-DELETE-F3-16-3. NC2024.2 +135100 PERFORM DE-LETE. NC2024.2 +135200 GO TO ADD-WRITE-F3-16-3. NC2024.2 +135300 ADD-FAIL-F3-16-3. NC2024.2 +135400 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +135500 MOVE "+777.77" TO CORRECT-A NC2024.2 +135600 PERFORM FAIL. NC2024.2 +135700 ADD-WRITE-F3-16-3. NC2024.2 +135800 PERFORM PRINT-DETAIL. NC2024.2 +135900* NC2024.2 +136000 ADD-INIT-F3-16-4. NC2024.2 +136100 MOVE "ADD-TEST-F3-16-4" TO PAR-NAME. NC2024.2 +136200 ADD 1 TO REC-CT. NC2024.2 +136300 ADD-TEST-F3-16-4. NC2024.2 +136400 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +136500 PERFORM PASS NC2024.2 +136600 GO TO ADD-WRITE-F3-16-4. NC2024.2 +136700 GO TO ADD-FAIL-F3-16-4. NC2024.2 +136800 ADD-DELETE-F3-16-4. NC2024.2 +136900 PERFORM DE-LETE. NC2024.2 +137000 GO TO ADD-WRITE-F3-16-4. NC2024.2 +137100 ADD-FAIL-F3-16-4. NC2024.2 +137200 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +137300 MOVE 555.5 TO CORRECT-N NC2024.2 +137400 PERFORM FAIL. NC2024.2 +137500 ADD-WRITE-F3-16-4. NC2024.2 +137600 PERFORM PRINT-DETAIL. NC2024.2 +137700* NC2024.2 +137800 ADD-INIT-F3-17. NC2024.2 +137900* ===--> NEW SIZE ERROR TESTS <--=== NC2024.2 +138000* ===--> SIZE ERROR <--=== NC2024.2 +138100 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +138200 MOVE 1 TO REC-CT. NC2024.2 +138300 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +138400 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +138500 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +138600 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +138700 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +138800 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +138900 ADD-INIT-F3-17-1. NC2024.2 +139000 MOVE "ADD-TEST-F3-17-1" TO PAR-NAME. NC2024.2 +139100 ADD-TEST-F3-17-1. NC2024.2 +139200 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +139300 ON SIZE ERROR NC2024.2 +139400 PERFORM PASS NC2024.2 +139500 GO TO ADD-WRITE-F3-17-1 NC2024.2 +139600 NOT ON SIZE ERROR NC2024.2 +139700 GO TO ADD-FAIL-F3-17-1. NC2024.2 +139800 ADD-DELETE-F3-17. NC2024.2 +139900 PERFORM DE-LETE. NC2024.2 +140000 GO TO ADD-WRITE-F3-17-1. NC2024.2 +140100 ADD-FAIL-F3-17-1. NC2024.2 +140200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2024.2 +140300 TO RE-MARK NC2024.2 +140400 PERFORM FAIL. NC2024.2 +140500 ADD-WRITE-F3-17-1. NC2024.2 +140600 PERFORM PRINT-DETAIL. NC2024.2 +140700* NC2024.2 +140800 ADD-INIT-F3-17-2. NC2024.2 +140900 MOVE "ADD-TEST-F3-17-2" TO PAR-NAME. NC2024.2 +141000 ADD 1 TO REC-CT. NC2024.2 +141100 ADD-TEST-F3-17-2. NC2024.2 +141200 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +141300 PERFORM PASS NC2024.2 +141400 GO TO ADD-WRITE-F3-17-2. NC2024.2 +141500 GO TO ADD-FAIL-F3-17-2. NC2024.2 +141600 ADD-DELETE-F3-17-2. NC2024.2 +141700 PERFORM DE-LETE. NC2024.2 +141800 GO TO ADD-WRITE-F3-17-2. NC2024.2 +141900 ADD-FAIL-F3-17-2. NC2024.2 +142000 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +142100 MOVE 99999 TO CORRECT-N NC2024.2 +142200 PERFORM FAIL. NC2024.2 +142300 ADD-WRITE-F3-17-2. NC2024.2 +142400 PERFORM PRINT-DETAIL. NC2024.2 +142500* NC2024.2 +142600 ADD-INIT-F3-17-3. NC2024.2 +142700 MOVE "ADD-TEST-F3-17-3" TO PAR-NAME. NC2024.2 +142800 ADD 1 TO REC-CT. NC2024.2 +142900 ADD-TEST-F3-17-3. NC2024.2 +143000 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +143100 PERFORM PASS NC2024.2 +143200 GO TO ADD-WRITE-F3-17-3. NC2024.2 +143300 GO TO ADD-FAIL-F3-17-3. NC2024.2 +143400 ADD-DELETE-F3-17-3. NC2024.2 +143500 PERFORM DE-LETE. NC2024.2 +143600 GO TO ADD-WRITE-F3-17-3. NC2024.2 +143700 ADD-FAIL-F3-17-3. NC2024.2 +143800 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +143900 MOVE "+777.77" TO CORRECT-A NC2024.2 +144000 PERFORM FAIL. NC2024.2 +144100 ADD-WRITE-F3-17-3. NC2024.2 +144200 PERFORM PRINT-DETAIL. NC2024.2 +144300* NC2024.2 +144400 ADD-INIT-F3-17-4. NC2024.2 +144500 MOVE "ADD-TEST-F3-17-4" TO PAR-NAME. NC2024.2 +144600 ADD 1 TO REC-CT. NC2024.2 +144700 ADD-TEST-F3-17-4. NC2024.2 +144800 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +144900 PERFORM PASS NC2024.2 +145000 GO TO ADD-WRITE-F3-17-4. NC2024.2 +145100 GO TO ADD-FAIL-F3-17-4. NC2024.2 +145200 ADD-DELETE-F3-17-4. NC2024.2 +145300 PERFORM DE-LETE. NC2024.2 +145400 GO TO ADD-WRITE-F3-17-4. NC2024.2 +145500 ADD-FAIL-F3-17-4. NC2024.2 +145600 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +145700 MOVE 555.5 TO CORRECT-N NC2024.2 +145800 PERFORM FAIL. NC2024.2 +145900 ADD-WRITE-F3-17-4. NC2024.2 +146000 PERFORM PRINT-DETAIL. NC2024.2 +146100* NC2024.2 +146200 ADD-INIT-F3-18. NC2024.2 +146300* ===--> NEW SIZE ERROR TESTS <--=== NC2024.2 +146400* ===--> NO SIZE ERROR <--=== NC2024.2 +146500 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +146600 MOVE 1 TO REC-CT. NC2024.2 +146700 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +146800 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +146900 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +147000 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +147100 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +147200 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +147300 ADD-INIT-F3-18-1. NC2024.2 +147400 MOVE "ADD-TEST-F3-18-1" TO PAR-NAME. NC2024.2 +147500 ADD-TEST-F3-18-1. NC2024.2 +147600 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +147700 ON SIZE ERROR NC2024.2 +147800 GO TO ADD-FAIL-F3-18-1 NC2024.2 +147900 NOT ON SIZE ERROR NC2024.2 +148000 PERFORM PASS NC2024.2 +148100 GO TO ADD-WRITE-F3-18-1. NC2024.2 +148200 ADD-DELETE-F3-18-1. NC2024.2 +148300 PERFORM DE-LETE. NC2024.2 +148400 GO TO ADD-WRITE-F3-18-1. NC2024.2 +148500 ADD-FAIL-F3-18-1. NC2024.2 +148600 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +148700 TO RE-MARK NC2024.2 +148800 PERFORM FAIL. NC2024.2 +148900 ADD-WRITE-F3-18-1. NC2024.2 +149000 PERFORM PRINT-DETAIL. NC2024.2 +149100* NC2024.2 +149200 ADD-INIT-F3-18-2. NC2024.2 +149300 MOVE "ADD-TEST-F3-18-2" TO PAR-NAME. NC2024.2 +149400 ADD 1 TO REC-CT. NC2024.2 +149500 ADD-TEST-F3-18-2. NC2024.2 +149600 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +149700 PERFORM PASS NC2024.2 +149800 GO TO ADD-WRITE-F3-18-2. NC2024.2 +149900 GO TO ADD-FAIL-F3-18-2. NC2024.2 +150000 ADD-DELETE-F3-18-2. NC2024.2 +150100 PERFORM DE-LETE NC2024.2 +150200 GO TO ADD-WRITE-F3-18-2. NC2024.2 +150300 ADD-FAIL-F3-18-2. NC2024.2 +150400 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +150500 MOVE 88889 TO CORRECT-N NC2024.2 +150600 PERFORM FAIL. NC2024.2 +150700 ADD-WRITE-F3-18-2. NC2024.2 +150800 PERFORM PRINT-DETAIL. NC2024.2 +150900* NC2024.2 +151000 ADD-INIT-F3-18-3. NC2024.2 +151100 MOVE "ADD-TEST-F3-18-3" TO PAR-NAME. NC2024.2 +151200 ADD 1 TO REC-CT. NC2024.2 +151300 ADD-TEST-F3-18-3. NC2024.2 +151400 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +151500 PERFORM PASS NC2024.2 +151600 GO TO ADD-WRITE-F3-18-3. NC2024.2 +151700 GO TO ADD-FAIL-F3-18-3. NC2024.2 +151800 ADD-DELETE-F3-18-3. NC2024.2 +151900 PERFORM DE-LETE. NC2024.2 +152000 GO TO ADD-WRITE-F3-18-3. NC2024.2 +152100 ADD-FAIL-F3-18-3. NC2024.2 +152200 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +152300 MOVE "+777.77" TO CORRECT-A NC2024.2 +152400 PERFORM FAIL. NC2024.2 +152500 ADD-WRITE-F3-18-3. NC2024.2 +152600 PERFORM PRINT-DETAIL. NC2024.2 +152700* NC2024.2 +152800 ADD-INIT-F3-18-4. NC2024.2 +152900 MOVE "ADD-TEST-F3-18-4" TO PAR-NAME. NC2024.2 +153000 ADD 1 TO REC-CT. NC2024.2 +153100 ADD-TEST-F3-18-4. NC2024.2 +153200 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +153300 PERFORM PASS NC2024.2 +153400 GO TO ADD-WRITE-F3-18-4. NC2024.2 +153500 GO TO ADD-FAIL-F3-18-4. NC2024.2 +153600 ADD-DELETE-F3-18-4. NC2024.2 +153700 PERFORM DE-LETE. NC2024.2 +153800 GO TO ADD-WRITE-F3-18-4. NC2024.2 +153900 ADD-FAIL-F3-18-4. NC2024.2 +154000 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +154100 MOVE 555.5 TO CORRECT-N NC2024.2 +154200 PERFORM FAIL. NC2024.2 +154300 ADD-WRITE-F3-18-4. NC2024.2 +154400 PERFORM PRINT-DETAIL. NC2024.2 +154500* NC2024.2 +154600 ADD-INIT-F3-19. NC2024.2 +154700* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +154800* ===--> SIZE ERROR <--=== NC2024.2 +154900 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +155000 MOVE SPACE TO WRK-XN-00001. NC2024.2 +155100 MOVE SPACE TO WRK-AN-00001. NC2024.2 +155200 MOVE 0 TO REC-CT. NC2024.2 +155300 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +155400 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +155500 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +155600 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +155700 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +155800 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +155900 MOVE "ADD-TEST-F3-19-0" TO PAR-NAME. NC2024.2 +156000 ADD-TEST-F3-19-0. NC2024.2 +156100 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +156200 ON SIZE ERROR NC2024.2 +156300 MOVE "A" TO WRK-AN-00001 NC2024.2 +156400 END-ADD NC2024.2 +156500 MOVE "B" TO WRK-XN-00001. NC2024.2 +156600* NC2024.2 +156700 ADD-INIT-F3-19-1. NC2024.2 +156800 MOVE "ADD-TEST-F3-19-1" TO PAR-NAME. NC2024.2 +156900 ADD 1 TO REC-CT. NC2024.2 +157000 ADD-TEST-F3-19-1. NC2024.2 +157100 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +157200 PERFORM PASS NC2024.2 +157300 GO TO ADD-WRITE-F3-19-1. NC2024.2 +157400 GO TO ADD-FAIL-F3-19-1. NC2024.2 +157500 ADD-DELETE-F3-19-1. NC2024.2 +157600 PERFORM DE-LETE. NC2024.2 +157700 GO TO ADD-WRITE-F3-19-1. NC2024.2 +157800 ADD-FAIL-F3-19-1. NC2024.2 +157900 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +158000 MOVE 99999 TO CORRECT-N NC2024.2 +158100 PERFORM FAIL. NC2024.2 +158200 ADD-WRITE-F3-19-1. NC2024.2 +158300 PERFORM PRINT-DETAIL. NC2024.2 +158400* NC2024.2 +158500 ADD-INIT-F3-19-2. NC2024.2 +158600 MOVE "ADD-TEST-F3-19-2" TO PAR-NAME. NC2024.2 +158700 ADD 1 TO REC-CT. NC2024.2 +158800 ADD-TEST-F3-19-2. NC2024.2 +158900 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +159000 PERFORM PASS NC2024.2 +159100 GO TO ADD-WRITE-F3-19-2. NC2024.2 +159200 GO TO ADD-FAIL-F3-19-2. NC2024.2 +159300 ADD-DELETE-F3-19-2. NC2024.2 +159400 PERFORM DE-LETE. NC2024.2 +159500 GO TO ADD-WRITE-F3-19-2. NC2024.2 +159600 ADD-FAIL-F3-19-2. NC2024.2 +159700 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +159800 MOVE "+777.77" TO CORRECT-A NC2024.2 +159900 PERFORM FAIL. NC2024.2 +160000 ADD-WRITE-F3-19-2. NC2024.2 +160100 PERFORM PRINT-DETAIL. NC2024.2 +160200* NC2024.2 +160300 ADD-INIT-F3-19-3. NC2024.2 +160400 MOVE "ADD-TEST-F3-19-3" TO PAR-NAME. NC2024.2 +160500 ADD 1 TO REC-CT. NC2024.2 +160600 ADD-TEST-F3-19-3. NC2024.2 +160700 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +160800 PERFORM PASS NC2024.2 +160900 GO TO ADD-WRITE-F3-19-3. NC2024.2 +161000 GO TO ADD-FAIL-F3-19-3. NC2024.2 +161100 ADD-DELETE-F3-19-3. NC2024.2 +161200 PERFORM DE-LETE. NC2024.2 +161300 GO TO ADD-WRITE-F3-19-3. NC2024.2 +161400 ADD-FAIL-F3-19-3. NC2024.2 +161500 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +161600 MOVE 555.5 TO CORRECT-N NC2024.2 +161700 PERFORM FAIL. NC2024.2 +161800 ADD-WRITE-F3-19-3. NC2024.2 +161900 PERFORM PRINT-DETAIL. NC2024.2 +162000* NC2024.2 +162100 ADD-INIT-F3-19-4. NC2024.2 +162200 MOVE "ADD-TEST-F3-19-4" TO PAR-NAME. NC2024.2 +162300 ADD 1 TO REC-CT. NC2024.2 +162400 ADD-TEST-F3-19-4. NC2024.2 +162500 IF WRK-AN-00001 = SPACE NC2024.2 +162600 GO TO ADD-FAIL-F3-19-4. NC2024.2 +162700 PERFORM PASS NC2024.2 +162800 GO TO ADD-WRITE-F3-19-4. NC2024.2 +162900 ADD-DELETE-F3-19-4. NC2024.2 +163000 PERFORM DE-LETE. NC2024.2 +163100 GO TO ADD-WRITE-F3-19-4. NC2024.2 +163200 ADD-FAIL-F3-19-4. NC2024.2 +163300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2024.2 +163400 TO RE-MARK NC2024.2 +163500 MOVE "A" TO COMPUTED-X NC2024.2 +163600 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +163700 PERFORM FAIL. NC2024.2 +163800 ADD-WRITE-F3-19-4. NC2024.2 +163900 PERFORM PRINT-DETAIL. NC2024.2 +164000* NC2024.2 +164100 ADD-INIT-F3-19-5. NC2024.2 +164200 MOVE "ADD-TEST-F3-19-5" TO PAR-NAME. NC2024.2 +164300 ADD 1 TO REC-CT. NC2024.2 +164400 ADD-TEST-F3-19-5. NC2024.2 +164500 IF WRK-XN-00001 = SPACE NC2024.2 +164600 GO TO ADD-FAIL-F3-19-5. NC2024.2 +164700 PERFORM PASS NC2024.2 +164800 GO TO ADD-WRITE-F3-19-5. NC2024.2 +164900 ADD-DELETE-F3-19-5. NC2024.2 +165000 PERFORM DE-LETE. NC2024.2 +165100 GO TO ADD-WRITE-F3-19-5. NC2024.2 +165200 ADD-FAIL-F3-19-5. NC2024.2 +165300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +165400 MOVE "B" TO COMPUTED-X NC2024.2 +165500 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +165600 PERFORM FAIL. NC2024.2 +165700 ADD-WRITE-F3-19-5. NC2024.2 +165800 PERFORM PRINT-DETAIL. NC2024.2 +165900* NC2024.2 +166000 ADD-INIT-F3-20. NC2024.2 +166100* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +166200* ===--> NO SIZE ERROR <--=== NC2024.2 +166300 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +166400 MOVE "ADD-TEST-F3-20-0" TO PAR-NAME. NC2024.2 +166500 MOVE SPACE TO WRK-XN-00001. NC2024.2 +166600 MOVE SPACE TO WRK-AN-00001. NC2024.2 +166700 MOVE 0 TO REC-CT. NC2024.2 +166800 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +166900 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +167000 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +167100 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +167200 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +167300 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +167400 ADD-TEST-F3-20-0. NC2024.2 +167500 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +167600 ON SIZE ERROR NC2024.2 +167700 MOVE "A" TO WRK-AN-00001 NC2024.2 +167800 END-ADD NC2024.2 +167900 MOVE "B" TO WRK-XN-00001. NC2024.2 +168000* NC2024.2 +168100 ADD-INIT-F3-20-1. NC2024.2 +168200 MOVE "ADD-TEST-F3-20-1" TO PAR-NAME. NC2024.2 +168300 ADD 1 TO REC-CT. NC2024.2 +168400 ADD-TEST-F3-20-1. NC2024.2 +168500 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +168600 PERFORM PASS NC2024.2 +168700 GO TO ADD-WRITE-F3-20-1. NC2024.2 +168800 GO TO ADD-FAIL-F3-20-1. NC2024.2 +168900 ADD-DELETE-F3-20-1. NC2024.2 +169000 PERFORM DE-LETE. NC2024.2 +169100 GO TO ADD-WRITE-F3-20-1. NC2024.2 +169200 ADD-FAIL-F3-20-1. NC2024.2 +169300 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +169400 MOVE 88889 TO CORRECT-N NC2024.2 +169500 PERFORM FAIL. NC2024.2 +169600 ADD-WRITE-F3-20-1. NC2024.2 +169700 PERFORM PRINT-DETAIL. NC2024.2 +169800* NC2024.2 +169900 ADD-INIT-F3-20-2. NC2024.2 +170000 MOVE "ADD-TEST-F3-20-2" TO PAR-NAME. NC2024.2 +170100 ADD 1 TO REC-CT. NC2024.2 +170200 ADD-TEST-F3-20-2. NC2024.2 +170300 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +170400 PERFORM PASS NC2024.2 +170500 GO TO ADD-WRITE-F3-20-2. NC2024.2 +170600 GO TO ADD-FAIL-F3-20-2. NC2024.2 +170700 ADD-DELETE-F3-20-2. NC2024.2 +170800 PERFORM DE-LETE. NC2024.2 +170900 GO TO ADD-WRITE-F3-20-2. NC2024.2 +171000 ADD-FAIL-F3-20-2. NC2024.2 +171100 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +171200 MOVE "+777.77" TO CORRECT-A NC2024.2 +171300 PERFORM FAIL. NC2024.2 +171400 ADD-WRITE-F3-20-2. NC2024.2 +171500 PERFORM PRINT-DETAIL. NC2024.2 +171600* NC2024.2 +171700 ADD-INIT-F3-20-3. NC2024.2 +171800 MOVE "ADD-TEST-F3-20-3" TO PAR-NAME. NC2024.2 +171900 ADD 1 TO REC-CT. NC2024.2 +172000 ADD-TEST-F3-20-3. NC2024.2 +172100 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +172200 PERFORM PASS NC2024.2 +172300 GO TO ADD-WRITE-F3-20-3. NC2024.2 +172400 GO TO ADD-FAIL-F3-20-3. NC2024.2 +172500 ADD-DELETE-F3-20-3. NC2024.2 +172600 PERFORM DE-LETE. NC2024.2 +172700 GO TO ADD-WRITE-F3-20-3. NC2024.2 +172800 ADD-FAIL-F3-20-3. NC2024.2 +172900 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +173000 MOVE 555.5 TO CORRECT-N NC2024.2 +173100 PERFORM FAIL. NC2024.2 +173200 ADD-WRITE-F3-20-3. NC2024.2 +173300 PERFORM PRINT-DETAIL. NC2024.2 +173400* NC2024.2 +173500 ADD-INIT-F3-20-4. NC2024.2 +173600 MOVE "ADD-TEST-F3-20-4" TO PAR-NAME. NC2024.2 +173700 ADD 1 TO REC-CT. NC2024.2 +173800 ADD-TEST-F3-20-4. NC2024.2 +173900 IF WRK-AN-00001 = SPACE NC2024.2 +174000 PERFORM PASS NC2024.2 +174100 GO TO ADD-WRITE-F3-20-4. NC2024.2 +174200 GO TO ADD-FAIL-F3-20-4. NC2024.2 +174300 ADD-DELETE-F3-20-4. NC2024.2 +174400 PERFORM DE-LETE. NC2024.2 +174500 GO TO ADD-WRITE-F3-20-4. NC2024.2 +174600 ADD-FAIL-F3-20-4. NC2024.2 +174700 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +174800 TO RE-MARK. NC2024.2 +174900 MOVE SPACE TO CORRECT-X. NC2024.2 +175000 MOVE WRK-AN-00001 TO COMPUTED-X. NC2024.2 +175100 PERFORM FAIL. NC2024.2 +175200 ADD-WRITE-F3-20-4. NC2024.2 +175300 PERFORM PRINT-DETAIL. NC2024.2 +175400* NC2024.2 +175500 ADD-INIT-F3-20-5. NC2024.2 +175600 MOVE "ADD-TEST-F3-20-5" TO PAR-NAME. NC2024.2 +175700 ADD 1 TO REC-CT. NC2024.2 +175800 ADD-TEST-F3-20-5. NC2024.2 +175900 IF WRK-XN-00001 = SPACE NC2024.2 +176000 GO TO ADD-FAIL-F3-20-5. NC2024.2 +176100 PERFORM PASS NC2024.2 +176200 GO TO ADD-WRITE-F3-20-5. NC2024.2 +176300 ADD-DELETE-F3-20-5. NC2024.2 +176400 PERFORM DE-LETE. NC2024.2 +176500 GO TO ADD-WRITE-F3-20-5. NC2024.2 +176600 ADD-FAIL-F3-20-5. NC2024.2 +176700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +176800 MOVE "B" TO COMPUTED-X NC2024.2 +176900 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +177000 PERFORM FAIL. NC2024.2 +177100 ADD-WRITE-F3-20-5. NC2024.2 +177200 PERFORM PRINT-DETAIL. NC2024.2 +177300* NC2024.2 +177400 ADD-INIT-F3-21. NC2024.2 +177500* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +177600* ===--> SIZE ERROR <--=== NC2024.2 +177700 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +177800 MOVE "ADD-TEST-F3-21-0" TO PAR-NAME. NC2024.2 +177900 MOVE SPACE TO WRK-XN-00001. NC2024.2 +178000 MOVE SPACE TO WRK-AN-00001. NC2024.2 +178100 MOVE 1 TO REC-CT. NC2024.2 +178200 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +178300 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +178400 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +178500 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +178600 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +178700 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +178800 ADD-TEST-F3-21-0. NC2024.2 +178900 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +179000 NOT ON SIZE ERROR NC2024.2 +179100 MOVE "A" TO WRK-AN-00001 NC2024.2 +179200 END-ADD NC2024.2 +179300 MOVE "B" TO WRK-XN-00001. NC2024.2 +179400* NC2024.2 +179500 ADD-INIT-F3-21-1. NC2024.2 +179600 MOVE "ADD-TEST-F3-21-1" TO PAR-NAME. NC2024.2 +179700 ADD 1 TO REC-CT. NC2024.2 +179800 ADD-TEST-F3-21-1. NC2024.2 +179900 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +180000 PERFORM PASS NC2024.2 +180100 GO TO ADD-WRITE-F3-21-1. NC2024.2 +180200 GO TO ADD-FAIL-F3-21-1. NC2024.2 +180300 ADD-DELETE-F3-21-1. NC2024.2 +180400 PERFORM DE-LETE. NC2024.2 +180500 GO TO ADD-WRITE-F3-21-1. NC2024.2 +180600 ADD-FAIL-F3-21-1. NC2024.2 +180700 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +180800 MOVE 99999 TO CORRECT-N NC2024.2 +180900 PERFORM FAIL. NC2024.2 +181000 ADD-WRITE-F3-21-1. NC2024.2 +181100 PERFORM PRINT-DETAIL. NC2024.2 +181200* NC2024.2 +181300 ADD-INIT-F3-21-2. NC2024.2 +181400 MOVE "ADD-TEST-F3-21-2" TO PAR-NAME. NC2024.2 +181500 ADD 1 TO REC-CT. NC2024.2 +181600 ADD-TEST-F3-21-2. NC2024.2 +181700 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +181800 PERFORM PASS NC2024.2 +181900 GO TO ADD-WRITE-F3-21-2. NC2024.2 +182000 GO TO ADD-FAIL-F3-21-2. NC2024.2 +182100 ADD-DELETE-F3-21-2. NC2024.2 +182200 PERFORM DE-LETE. NC2024.2 +182300 GO TO ADD-WRITE-F3-21-2. NC2024.2 +182400 ADD-FAIL-F3-21-2. NC2024.2 +182500 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +182600 MOVE "+777.77" TO CORRECT-A NC2024.2 +182700 PERFORM FAIL. NC2024.2 +182800 ADD-WRITE-F3-21-2. NC2024.2 +182900 PERFORM PRINT-DETAIL. NC2024.2 +183000* NC2024.2 +183100 ADD-INIT-F3-21-3. NC2024.2 +183200 MOVE "ADD-TEST-F3-21-3" TO PAR-NAME. NC2024.2 +183300 ADD 1 TO REC-CT. NC2024.2 +183400 ADD-TEST-F3-21-3. NC2024.2 +183500 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +183600 PERFORM PASS NC2024.2 +183700 GO TO ADD-WRITE-F3-21-3. NC2024.2 +183800 GO TO ADD-FAIL-F3-21-3. NC2024.2 +183900 ADD-DELETE-F3-21-3. NC2024.2 +184000 PERFORM DE-LETE. NC2024.2 +184100 GO TO ADD-WRITE-F3-21-3. NC2024.2 +184200 ADD-FAIL-F3-21-3. NC2024.2 +184300 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +184400 MOVE 555.5 TO CORRECT-N NC2024.2 +184500 PERFORM FAIL. NC2024.2 +184600 ADD-WRITE-F3-21-3. NC2024.2 +184700 PERFORM PRINT-DETAIL. NC2024.2 +184800* NC2024.2 +184900 ADD-INIT-F3-21-4. NC2024.2 +185000 MOVE "ADD-TEST-F3-21-4" TO PAR-NAME. NC2024.2 +185100 ADD 1 TO REC-CT. NC2024.2 +185200 ADD-TEST-F3-21-4. NC2024.2 +185300 IF WRK-AN-00001 = "A" NC2024.2 +185400 GO TO ADD-FAIL-F3-21-4. NC2024.2 +185500 PERFORM PASS NC2024.2 +185600 GO TO ADD-WRITE-F3-21-4. NC2024.2 +185700 ADD-DELETE-F3-21-4. NC2024.2 +185800 PERFORM DE-LETE. NC2024.2 +185900 GO TO ADD-WRITE-F3-21-4. NC2024.2 +186000 ADD-FAIL-F3-21-4. NC2024.2 +186100 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +186200 TO RE-MARK NC2024.2 +186300 MOVE SPACE TO COMPUTED-X NC2024.2 +186400 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +186500 PERFORM FAIL. NC2024.2 +186600 ADD-WRITE-F3-21-4. NC2024.2 +186700 PERFORM PRINT-DETAIL. NC2024.2 +186800* NC2024.2 +186900 ADD-INIT-F3-21-5. NC2024.2 +187000 MOVE "ADD-TEST-F3-21-5" TO PAR-NAME. NC2024.2 +187100 ADD 1 TO REC-CT. NC2024.2 +187200 ADD-TEST-F3-21-5. NC2024.2 +187300 IF WRK-XN-00001 = SPACE NC2024.2 +187400 GO TO ADD-FAIL-F3-21-5. NC2024.2 +187500 PERFORM PASS NC2024.2 +187600 GO TO ADD-WRITE-F3-21-5. NC2024.2 +187700 ADD-DELETE-F3-21-5. NC2024.2 +187800 PERFORM DE-LETE. NC2024.2 +187900 GO TO ADD-WRITE-F3-21-5. NC2024.2 +188000 ADD-FAIL-F3-21-5. NC2024.2 +188100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +188200 MOVE "B" TO COMPUTED-X NC2024.2 +188300 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +188400 PERFORM FAIL. NC2024.2 +188500 ADD-WRITE-F3-21-5. NC2024.2 +188600 PERFORM PRINT-DETAIL. NC2024.2 +188700* NC2024.2 +188800 ADD-INIT-F3-22. NC2024.2 +188900* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +189000* ===--> NO SIZE ERROR <--=== NC2024.2 +189100 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +189200 MOVE "ADD-TEST-F3-22-0" TO PAR-NAME. NC2024.2 +189300 MOVE SPACE TO WRK-XN-00001. NC2024.2 +189400 MOVE SPACE TO WRK-AN-00001. NC2024.2 +189500 MOVE 0 TO REC-CT. NC2024.2 +189600 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +189700 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +189800 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +189900 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +190000 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +190100 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +190200 ADD-TEST-F3-22-0. NC2024.2 +190300 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +190400 NOT ON SIZE ERROR NC2024.2 +190500 MOVE "A" TO WRK-AN-00001 NC2024.2 +190600 PERFORM PASS NC2024.2 +190700 PERFORM PRINT-DETAIL NC2024.2 +190800 END-ADD NC2024.2 +190900 MOVE "B" TO WRK-XN-00001. NC2024.2 +191000* NC2024.2 +191100 ADD-INIT-F3-22-1. NC2024.2 +191200 MOVE "ADD-TEST-F3-22-1" TO PAR-NAME. NC2024.2 +191300 ADD 1 TO REC-CT. NC2024.2 +191400 ADD-TEST-F3-22-1. NC2024.2 +191500 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +191600 PERFORM PASS NC2024.2 +191700 GO TO ADD-WRITE-F3-22-1. NC2024.2 +191800 GO TO ADD-FAIL-F3-22-1. NC2024.2 +191900 ADD-DELETE-F3-22-1. NC2024.2 +192000 PERFORM DE-LETE. NC2024.2 +192100 GO TO ADD-WRITE-F3-22-1. NC2024.2 +192200 ADD-FAIL-F3-22-1. NC2024.2 +192300 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +192400 MOVE 88889 TO CORRECT-N NC2024.2 +192500 PERFORM FAIL. NC2024.2 +192600 ADD-WRITE-F3-22-1. NC2024.2 +192700 PERFORM PRINT-DETAIL. NC2024.2 +192800* NC2024.2 +192900 ADD-INIT-F3-22-2. NC2024.2 +193000 MOVE "ADD-TEST-F3-22-2" TO PAR-NAME. NC2024.2 +193100 ADD 1 TO REC-CT. NC2024.2 +193200 ADD-TEST-F3-22-2. NC2024.2 +193300 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +193400 PERFORM PASS NC2024.2 +193500 GO TO ADD-WRITE-F3-22-2. NC2024.2 +193600 GO TO ADD-FAIL-F3-22-2. NC2024.2 +193700 ADD-DELETE-F3-22-2. NC2024.2 +193800 PERFORM DE-LETE. NC2024.2 +193900 GO TO ADD-WRITE-F3-22-2. NC2024.2 +194000 ADD-FAIL-F3-22-2. NC2024.2 +194100 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +194200 MOVE "+777.77" TO CORRECT-A NC2024.2 +194300 PERFORM FAIL. NC2024.2 +194400 ADD-WRITE-F3-22-2. NC2024.2 +194500 PERFORM PRINT-DETAIL. NC2024.2 +194600* NC2024.2 +194700 ADD-INIT-F3-22-3. NC2024.2 +194800 MOVE "ADD-TEST-F3-22-3" TO PAR-NAME. NC2024.2 +194900 ADD 1 TO REC-CT. NC2024.2 +195000 ADD-TEST-F3-22-3. NC2024.2 +195100 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +195200 PERFORM PASS NC2024.2 +195300 GO TO ADD-WRITE-F3-22-3. NC2024.2 +195400 GO TO ADD-FAIL-F3-22-3. NC2024.2 +195500 ADD-DELETE-F3-22-3. NC2024.2 +195600 PERFORM DE-LETE. NC2024.2 +195700 GO TO ADD-WRITE-F3-22-3. NC2024.2 +195800 ADD-FAIL-F3-22-3. NC2024.2 +195900 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +196000 MOVE 555.5 TO CORRECT-N NC2024.2 +196100 PERFORM FAIL. NC2024.2 +196200 ADD-WRITE-F3-22-3. NC2024.2 +196300 PERFORM PRINT-DETAIL. NC2024.2 +196400* NC2024.2 +196500 ADD-INIT-F3-22-4. NC2024.2 +196600 MOVE "ADD-TEST-F3-22-4" TO PAR-NAME. NC2024.2 +196700 ADD 1 TO REC-CT. NC2024.2 +196800 ADD-TEST-F3-22-4. NC2024.2 +196900 IF WRK-XN-00001 = SPACE NC2024.2 +197000 GO TO ADD-FAIL-F3-22-4. NC2024.2 +197100 PERFORM PASS NC2024.2 +197200 GO TO ADD-WRITE-F3-22-4. NC2024.2 +197300 ADD-DELETE-F3-22-4. NC2024.2 +197400 PERFORM DE-LETE. NC2024.2 +197500 GO TO ADD-WRITE-F3-22-4. NC2024.2 +197600 ADD-FAIL-F3-22-4. NC2024.2 +197700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +197800 MOVE "B" TO COMPUTED-X NC2024.2 +197900 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +198000 PERFORM FAIL. NC2024.2 +198100 ADD-WRITE-F3-22-4. NC2024.2 +198200 PERFORM PRINT-DETAIL. NC2024.2 +198300* NC2024.2 +198400 ADD-INIT-F3-23. NC2024.2 +198500* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +198600* ===--> SIZE ERROR <--=== NC2024.2 +198700 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +198800 MOVE "ADD-TEST-F3-23-0" TO PAR-NAME. NC2024.2 +198900 MOVE SPACE TO WRK-XN-00001. NC2024.2 +199000 MOVE SPACE TO WRK-AN-00001. NC2024.2 +199100 MOVE 0 TO REC-CT. NC2024.2 +199200 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +199300 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +199400 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +199500 MOVE 99999 TO FIELD1 OF ADD-16. NC2024.2 +199600 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +199700 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +199800 ADD-TEST-F3-23-0. NC2024.2 +199900 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +200000 ON SIZE ERROR NC2024.2 +200100 MOVE "A" TO WRK-AN-00001 NC2024.2 +200200 NOT ON SIZE ERROR NC2024.2 +200300 MOVE "B" TO WRK-AN-00001 NC2024.2 +200400 END-ADD NC2024.2 +200500 MOVE "B" TO WRK-XN-00001. NC2024.2 +200600 GO TO ADD-TEST-F3-23-1. NC2024.2 +200700* NC2024.2 +200800 ADD-INIT-F3-23-1. NC2024.2 +200900 MOVE "ADD-TEST-F3-23-1" TO PAR-NAME. NC2024.2 +201000 ADD 1 TO REC-CT. NC2024.2 +201100 ADD-TEST-F3-23-1. NC2024.2 +201200 IF FIELD1 OF ADD-16 EQUAL TO 99999 NC2024.2 +201300 PERFORM PASS NC2024.2 +201400 GO TO ADD-WRITE-F3-23-1. NC2024.2 +201500 GO TO ADD-FAIL-F3-23-1. NC2024.2 +201600 ADD-DELETE-F3-23-1. NC2024.2 +201700 PERFORM DE-LETE NC2024.2 +201800 GO TO ADD-WRITE-F3-23-1. NC2024.2 +201900 ADD-FAIL-F3-23-1. NC2024.2 +202000 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +202100 MOVE 99999 TO CORRECT-N NC2024.2 +202200 PERFORM FAIL. NC2024.2 +202300 ADD-WRITE-F3-23-1. NC2024.2 +202400 PERFORM PRINT-DETAIL. NC2024.2 +202500* NC2024.2 +202600 ADD-INIT-F3-23-2. NC2024.2 +202700 MOVE "ADD-TEST-F3-23-2" TO PAR-NAME. NC2024.2 +202800 ADD 1 TO REC-CT. NC2024.2 +202900 ADD-TEST-F3-23-2. NC2024.2 +203000 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +203100 PERFORM PASS NC2024.2 +203200 GO TO ADD-WRITE-F3-23-2. NC2024.2 +203300 GO TO ADD-FAIL-F3-23-2. NC2024.2 +203400 ADD-DELETE-F3-23-2. NC2024.2 +203500 PERFORM DE-LETE. NC2024.2 +203600 GO TO ADD-WRITE-F3-23-2. NC2024.2 +203700 ADD-FAIL-F3-23-2. NC2024.2 +203800 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +203900 MOVE "+777.77" TO CORRECT-A NC2024.2 +204000 PERFORM FAIL. NC2024.2 +204100 ADD-WRITE-F3-23-2. NC2024.2 +204200 PERFORM PRINT-DETAIL. NC2024.2 +204300* NC2024.2 +204400 ADD-INIT-F3-23-3. NC2024.2 +204500 MOVE "ADD-TEST-F3-23-3" TO PAR-NAME. NC2024.2 +204600 ADD 1 TO REC-CT. NC2024.2 +204700 ADD-TEST-F3-23-3. NC2024.2 +204800 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +204900 PERFORM PASS NC2024.2 +205000 GO TO ADD-WRITE-F3-23-3. NC2024.2 +205100 GO TO ADD-FAIL-F3-23-3. NC2024.2 +205200 ADD-DELETE-F3-23-3. NC2024.2 +205300 PERFORM DE-LETE. NC2024.2 +205400 GO TO ADD-WRITE-F3-23-3. NC2024.2 +205500 ADD-FAIL-F3-23-3. NC2024.2 +205600 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +205700 MOVE 555.5 TO CORRECT-N NC2024.2 +205800 PERFORM FAIL. NC2024.2 +205900 ADD-WRITE-F3-23-3. NC2024.2 +206000 PERFORM PRINT-DETAIL. NC2024.2 +206100* NC2024.2 +206200 ADD-INIT-F3-23-4. NC2024.2 +206300 MOVE "ADD-TEST-F3-23-4" TO PAR-NAME. NC2024.2 +206400 ADD 1 TO REC-CT. NC2024.2 +206500 ADD-TEST-F3-23-4. NC2024.2 +206600 IF WRK-AN-00001 = "B" NC2024.2 +206700 GO TO ADD-FAIL-F3-23-4. NC2024.2 +206800 PERFORM PASS NC2024.2 +206900 GO TO ADD-WRITE-F3-23-4. NC2024.2 +207000 ADD-DELETE-F3-23-4. NC2024.2 +207100 PERFORM DE-LETE. NC2024.2 +207200 GO TO ADD-WRITE-F3-23-4. NC2024.2 +207300 ADD-FAIL-F3-23-4. NC2024.2 +207400 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2024.2 +207500 TO RE-MARK NC2024.2 +207600 MOVE "B" TO COMPUTED-X NC2024.2 +207700 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +207800 PERFORM FAIL. NC2024.2 +207900 ADD-WRITE-F3-23-4. NC2024.2 +208000 PERFORM PRINT-DETAIL. NC2024.2 +208100* NC2024.2 +208200 ADD-INIT-F3-23-5. NC2024.2 +208300 MOVE "ADD-TEST-F3-23-5" TO PAR-NAME. NC2024.2 +208400 ADD 1 TO REC-CT. NC2024.2 +208500 ADD-TEST-F3-23-5. NC2024.2 +208600 IF WRK-XN-00001 = SPACE NC2024.2 +208700 GO TO ADD-FAIL-F3-23-5. NC2024.2 +208800 PERFORM PASS NC2024.2 +208900 GO TO ADD-WRITE-F3-23-5. NC2024.2 +209000 ADD-DELETE-F3-23-5. NC2024.2 +209100 PERFORM DE-LETE. NC2024.2 +209200 GO TO ADD-WRITE-F3-23-5. NC2024.2 +209300 ADD-FAIL-F3-23-5. NC2024.2 +209400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +209500 MOVE "B" TO COMPUTED-X NC2024.2 +209600 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +209700 PERFORM FAIL. NC2024.2 +209800 ADD-WRITE-F3-23-5. NC2024.2 +209900 PERFORM PRINT-DETAIL. NC2024.2 +210000* NC2024.2 +210100 ADD-INIT-F3-24. NC2024.2 +210200* ===--> EXPLICIT SCOPE TERMINATOR<--=== NC2024.2 +210300* ===--> NO SIZE ERROR <--=== NC2024.2 +210400 MOVE "VI-73 6.6" TO ANSI-REFERENCE. NC2024.2 +210500 MOVE "ADD-TEST-F3-24-0" TO PAR-NAME. NC2024.2 +210600 MOVE SPACE TO WRK-XN-00001. NC2024.2 +210700 MOVE SPACE TO WRK-AN-00001. NC2024.2 +210800 MOVE 0 TO REC-CT. NC2024.2 +210900 MOVE 1 TO FIELD1 OF ADD-15. NC2024.2 +211000 MOVE 32.1 TO FIELD2 OF ADD-15. NC2024.2 +211100 MOVE 123.4 TO FIELD3 OF ADD-15. NC2024.2 +211200 MOVE 88888 TO FIELD1 OF ADD-16. NC2024.2 +211300 MOVE 745.67 TO FIELD2 OF ADD-16. NC2024.2 +211400 MOVE 432.1 TO FIELD3 OF ADD-16. NC2024.2 +211500 ADD-TEST-F3-24-0. NC2024.2 +211600 ADD CORRESPONDING ADD-15 TO ADD-16 NC2024.2 +211700 ON SIZE ERROR NC2024.2 +211800 MOVE "A" TO WRK-AN-00001 NC2024.2 +211900 NOT ON SIZE ERROR NC2024.2 +212000 MOVE "B" TO WRK-AN-00001 NC2024.2 +212100 END-ADD NC2024.2 +212200 MOVE "B" TO WRK-XN-00001. NC2024.2 +212300* NC2024.2 +212400 ADD-INIT-F3-24-1. NC2024.2 +212500 MOVE "ADD-TEST-F3-24-1" TO PAR-NAME. NC2024.2 +212600 ADD 1 TO REC-CT. NC2024.2 +212700 ADD-TEST-F3-24-1. NC2024.2 +212800 IF FIELD1 OF ADD-16 EQUAL TO 88889 NC2024.2 +212900 PERFORM PASS NC2024.2 +213000 GO TO ADD-WRITE-F3-24-1. NC2024.2 +213100 GO TO ADD-FAIL-F3-24-1. NC2024.2 +213200 ADD-DELETE-F3-24-1. NC2024.2 +213300 PERFORM DE-LETE. NC2024.2 +213400 GO TO ADD-WRITE-F3-24-1. NC2024.2 +213500 ADD-FAIL-F3-24-1. NC2024.2 +213600 MOVE FIELD1 OF ADD-16 TO COMPUTED-N NC2024.2 +213700 MOVE 88889 TO CORRECT-N NC2024.2 +213800 PERFORM FAIL. NC2024.2 +213900 ADD-WRITE-F3-24-1. NC2024.2 +214000 PERFORM PRINT-DETAIL. NC2024.2 +214100* NC2024.2 +214200 ADD-INIT-F3-24-2. NC2024.2 +214300 MOVE "ADD-TEST-F3-24-2" TO PAR-NAME. NC2024.2 +214400 ADD 1 TO REC-CT. NC2024.2 +214500 ADD-TEST-F3-24-2. NC2024.2 +214600 IF FIELD2 OF ADD-16 IS EQUAL TO 777.77 NC2024.2 +214700 PERFORM PASS NC2024.2 +214800 GO TO ADD-WRITE-F3-24-2. NC2024.2 +214900 GO TO ADD-FAIL-F3-24-2. NC2024.2 +215000 ADD-DELETE-F3-24-2. NC2024.2 +215100 PERFORM DE-LETE. NC2024.2 +215200 GO TO ADD-WRITE-F3-24-2. NC2024.2 +215300 ADD-FAIL-F3-24-2. NC2024.2 +215400 MOVE FIELD2 OF ADD-16 TO COMPUTED-N NC2024.2 +215500 MOVE "+777.77" TO CORRECT-A NC2024.2 +215600 PERFORM FAIL. NC2024.2 +215700 ADD-WRITE-F3-24-2. NC2024.2 +215800 PERFORM PRINT-DETAIL. NC2024.2 +215900* NC2024.2 +216000 ADD-INIT-F3-24-3. NC2024.2 +216100 MOVE "ADD-TEST-F3-24-3" TO PAR-NAME. NC2024.2 +216200 ADD 1 TO REC-CT. NC2024.2 +216300 ADD-TEST-F3-24-3. NC2024.2 +216400 IF FIELD3 OF ADD-16 IS EQUAL TO 555.5 NC2024.2 +216500 PERFORM PASS NC2024.2 +216600 GO TO ADD-WRITE-F3-24-3. NC2024.2 +216700 GO TO ADD-FAIL-F3-24-3. NC2024.2 +216800 ADD-DELETE-F3-24-3. NC2024.2 +216900 PERFORM DE-LETE. NC2024.2 +217000 GO TO ADD-WRITE-F3-24-3. NC2024.2 +217100 ADD-FAIL-F3-24-3. NC2024.2 +217200 MOVE FIELD3 OF ADD-16 TO COMPUTED-N NC2024.2 +217300 MOVE 555.5 TO CORRECT-N NC2024.2 +217400 PERFORM FAIL. NC2024.2 +217500 ADD-WRITE-F3-24-3. NC2024.2 +217600 PERFORM PRINT-DETAIL. NC2024.2 +217700* NC2024.2 +217800 ADD-INIT-F3-24-4. NC2024.2 +217900 MOVE "ADD-TEST-F3-24-4" TO PAR-NAME. NC2024.2 +218000 ADD 1 TO REC-CT. NC2024.2 +218100 ADD-TEST-F3-24-4. NC2024.2 +218200 IF WRK-AN-00001 = "B" NC2024.2 +218300 PERFORM PASS NC2024.2 +218400 GO TO ADD-WRITE-F3-24-4. NC2024.2 +218500 GO TO ADD-FAIL-F3-24-4. NC2024.2 +218600 ADD-DELETE-F3-24-4. NC2024.2 +218700 PERFORM DE-LETE. NC2024.2 +218800 GO TO ADD-WRITE-F3-24-4. NC2024.2 +218900 ADD-FAIL-F3-24-4. NC2024.2 +219000 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2024.2 +219100 TO RE-MARK NC2024.2 +219200 MOVE "B" TO COMPUTED-X NC2024.2 +219300 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +219400 PERFORM FAIL. NC2024.2 +219500 ADD-WRITE-F3-24-4. NC2024.2 +219600 PERFORM PRINT-DETAIL. NC2024.2 +219700* NC2024.2 +219800 ADD-INIT-F3-24-5. NC2024.2 +219900 MOVE "ADD-TEST-F3-24-5" TO PAR-NAME. NC2024.2 +220000 ADD 1 TO REC-CT. NC2024.2 +220100 ADD-TEST-F3-24-5. NC2024.2 +220200 IF WRK-XN-00001 = SPACE NC2024.2 +220300 GO TO ADD-FAIL-F3-24-5. NC2024.2 +220400 PERFORM PASS NC2024.2 +220500 GO TO ADD-WRITE-F3-24-5. NC2024.2 +220600 ADD-DELETE-F3-24-5. NC2024.2 +220700 PERFORM DE-LETE. NC2024.2 +220800 GO TO ADD-WRITE-F3-24-5. NC2024.2 +220900 ADD-FAIL-F3-24-5. NC2024.2 +221000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2024.2 +221100 MOVE "B" TO COMPUTED-X NC2024.2 +221200 MOVE WRK-AN-00001 TO CORRECT-X NC2024.2 +221300 PERFORM FAIL. NC2024.2 +221400 ADD-WRITE-F3-24-5. NC2024.2 +221500 PERFORM PRINT-DETAIL. NC2024.2 +221600* NC2024.2 +221700 CCVS-EXIT SECTION. NC2024.2 +221800 CCVS-999999. NC2024.2 +221900 GO TO CLOSE-FILES. NC2024.2 diff --git a/tests/cobol85/NC/NC203A.CBL b/tests/cobol85/NC/NC203A.CBL new file mode 100755 index 00000000..e3ea7cba --- /dev/null +++ b/tests/cobol85/NC/NC203A.CBL @@ -0,0 +1,1693 @@ +000100 IDENTIFICATION DIVISION. NC2034.2 +000200 PROGRAM-ID. NC2034.2 +000300 NC203A. NC2034.2 +000400* NC2034.2 +000500**************************************************************** NC2034.2 +000600* * NC2034.2 +000700* VALIDATION FOR:- * NC2034.2 +000800* * NC2034.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2034.2 +001000* * NC2034.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2034.2 +001200* * NC2034.2 +001300**************************************************************** NC2034.2 +001400* * NC2034.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2034.2 +001600* * NC2034.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2034.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2034.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2034.2 +002000* * NC2034.2 +002100**************************************************************** NC2034.2 +002200* THIS PROGRAM TESTS FORMAT 4 OF THE DIVIDE STATEMENT. * NC2034.2 +002300* NC2034.2 +002400**************************************************************** NC2034.2 +002500* THIS COMMENT ENTRY SHOULD APPEAR AS THE LAST LINE BEFORE NC2034.2 +002600* THE ENVIRONMENT DIVISION. NC2034.2 +002700 ENVIRONMENT DIVISION. NC2034.2 +002800 CONFIGURATION SECTION. NC2034.2 +002900 SOURCE-COMPUTER. NC2034.2 +003000 Linux. NC2034.2 +003100 OBJECT-COMPUTER. NC2034.2 +003200 Linux. NC2034.2 +003300 INPUT-OUTPUT SECTION. NC2034.2 +003400 FILE-CONTROL. NC2034.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2034.2 +003600 "report.log". NC2034.2 +003700 DATA DIVISION. NC2034.2 +003800 FILE SECTION. NC2034.2 +003900 FD PRINT-FILE. NC2034.2 +004000 01 PRINT-REC PICTURE X(120). NC2034.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2034.2 +004200 WORKING-STORAGE SECTION. NC2034.2 +004300 01 WS-REMAINDERS. NC2034.2 +004400 03 WS-REM PIC 99 OCCURS 20. NC2034.2 +004500 01 WRK-XN-00001-1 PIC X. NC2034.2 +004600 01 WRK-XN-00001-2 PIC X. NC2034.2 +004700 01 WS-46. NC2034.2 +004800 03 WS-1-20 PIC X(20). NC2034.2 +004900 03 WS-21-40 PIC X(20). NC2034.2 +005000 03 WS-41-46 PIC X(6). NC2034.2 +005100 77 11A PICTURE 9999 VALUE 9. NC2034.2 +005200 77 11B PICTURE 99; VALUE 8. NC2034.2 +005300 77 1111C PICTURE 99 VALUE 9. NC2034.2 +005400 77 WRK-DS-02V00 PICTURE S99. NC2034.2 +005500 88 TEST-2NUC-COND-99 VALUE 99. NC2034.2 +005600 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2034.2 +005700 77 WRK-DS-18V00 PICTURE S9(18). NC2034.2 +005800 77 A18ONES-DS-18V00 PICTURE S9(18) NC2034.2 +005900 VALUE 111111111111111111. NC2034.2 +006000 77 A18TWOS-DS-18V00 PICTURE S9(18) NC2034.2 +006100 VALUE 222222222222222222. NC2034.2 +006200 77 WRK-DS-05V00 PICTURE S9(5). NC2034.2 +006300 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2034.2 +006400 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2034.2 +006500 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2034.2 +006600 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2034.2 +006700 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2034.2 +006800 77 WRK-DS-0201P PICTURE S99P. NC2034.2 +006900 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2034.2 +007000 77 WRK-DS-09V00 PICTURE S9(9). NC2034.2 +007100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2034.2 +007200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 NC2034.2 +007300 PICTURE S9(18). NC2034.2 +007400 77 XRAY PICTURE IS X. NC2034.2 +007500 77 W-1 PICTURE IS 9. NC2034.2 +007600 77 W-2 PICTURE IS 99. NC2034.2 +007700 77 W-3 PICTURE IS 999. NC2034.2 +007800 77 W-5 PICTURE 99 VALUE ZERO. NC2034.2 +007900 77 W-9 PICTURE 999. NC2034.2 +008000 77 W-11 PICTURE S99V9. NC2034.2 +008100 77 D-1 PICTURE S9V99 VALUE 1.06. NC2034.2 +008200 77 D-7 PICTURE S99V99 VALUE 1.09. NC2034.2 +008300 77 ONE PICTURE IS 9 VALUE IS 1. NC2034.2 +008400 77 TWO PICTURE IS S9 VALUE IS 2. NC2034.2 +008500 77 THREE PICTURE IS S9 VALUE IS 3. NC2034.2 +008600 77 FOUR PICTURE IS S9 VALUE IS 4. NC2034.2 +008700 77 FIVE PICTURE IS S9 VALUE IS 5. NC2034.2 +008800 77 SIX PICTURE IS S9 VALUE IS 6. NC2034.2 +008900 77 SEVEN PICTURE IS S9 VALUE IS 7. NC2034.2 +009000 77 EIGHT PICTURE IS 9 VALUE IS 8. NC2034.2 +009100 77 NINE PICTURE IS S9 VALUE IS 9. NC2034.2 +009200 77 TEN PICTURE IS S99 VALUE IS 10. NC2034.2 +009300 77 FIFTEEN PICTURE IS S99 VALUE IS 15. NC2034.2 +009400 77 TWENTY PICTURE IS S99 VALUE IS 20. NC2034.2 +009500 77 TWENTY-5 PICTURE IS S99 VALUE IS 25. NC2034.2 +009600 77 25COUNT PICTURE 999 VALUE ZERO. NC2034.2 +009700 77 25ANS PICTURE 99 VALUE ZERO. NC2034.2 +009800 77 25REM PICTURE 99 VALUE ZERO. NC2034.2 +009900 77 DIV-30-Y1 PICTURE 999 USAGE COMP SYNC RIGHT VALUE 31. NC2034.2 +010000 77 DIV-30-Y2 PICTURE 999 USAGE COMP VALUE 54. NC2034.2 +010100 77 DIV-30-Y3 PICTURE 999 VALUE 151. NC2034.2 +010200 77 DIV-30-Y4 PICTURE 9(4) SYNC RIGHT VALUE 1010. NC2034.2 +010300 77 DIV-Z1-30 PICTURE 999 USAGE COMP VALUE ZERO. NC2034.2 +010400 77 DIV-Z2-30 PICTURE 999 SYNC RIGHT VALUE ZERO. NC2034.2 +010500 77 DIV-Z3-30 PICTURE 999 USAGE COMP SYNC RIGHT VALUE ZERO. NC2034.2 +010600 77 DIV-Z4-30 PICTURE 999 VALUE ZERO. NC2034.2 +010700 77 DIV-30-A1 PICTURE 999 SYNC RIGHT VALUE ZERO. NC2034.2 +010800 77 DIV-30-A2 PICTURE 999 VALUE ZERO. NC2034.2 +010900 77 DIV-30-A3 PICTURE 999 USAGE COMP SYNC RIGHT VALUE ZERO. NC2034.2 +011000 77 DIV-30-A4 PICTURE 999 USAGE COMP VALUE ZERO. NC2034.2 +011100 01 DIV-ENTRIES. NC2034.2 +011200 02 DIV11 PICTURE 999 VALUE 105. NC2034.2 +011300 02 DIV12 PICTURE 9999 VALUE 1000. NC2034.2 +011400 02 DIV13 PICTURE 999. NC2034.2 +011500 02 DIV14 PICTURE 99. NC2034.2 +011600 02 DIV15 PICTURE 9V9 VALUE 1.1. NC2034.2 +011700 02 DIV16 PICTURE 99V99 VALUE 89.10. NC2034.2 +011800 02 DIV17 PICTURE 99V99. NC2034.2 +011900 02 DIV18 PICTURE 9999. NC2034.2 +012000 02 DIV19 PICTURE 99 VALUE 14. NC2034.2 +012100 02 DIV20 PICTURE 9999 VALUE 2147. NC2034.2 +012200 02 DIV21 PICTURE 999. NC2034.2 +012300 02 DIV22 PICTURE 99. NC2034.2 +012400 01 WRK-DU-1V17-1 PIC 9V9(17). NC2034.2 +012500 01 WRK-DU-1V5-1 PIC 9V9(5). NC2034.2 +012600 01 WRK-DU-2V1-1 PIC 99V9. NC2034.2 +012700 01 WRK-DU-05V00-0001 PIC 9(5). NC2034.2 +012800 01 WRK-DS-05V00-0002 PIC S9(5). NC2034.2 +012900 01 WRK-CS-05V00-0003 PIC S9(5) COMP. NC2034.2 +013000 01 WRK-DU-04V02-0004 PIC 9(4)V9(2). NC2034.2 +013100 01 WRK-DS-04V01-0005 PIC S9(4)V9. NC2034.2 +013200 01 WRK-NE-1 PIC .9999/99999,99999,99. NC2034.2 +013300 01 NE-0008 PIC $9(4).99-. NC2034.2 +013400 01 NE-0009 PIC ***99. NC2034.2 +013500 01 NE-04V01-0006 PIC ****.9. NC2034.2 +013600 01 GRP-0010. NC2034.2 +013700 02 WRK-DU-03V00-L-0011 PIC 9(03) SYNC LEFT. NC2034.2 +013800 02 WRK-O005F-0012 OCCURS 5 TIMES. NC2034.2 +013900 03 WRK-O003F-0013 OCCURS 3 TIMES. NC2034.2 +014000 05 WRK-DS-03V04-O003F-0014 PIC S9(3)V9999 NC2034.2 +014100 OCCURS 3 TIMES. NC2034.2 +014200 01 DS-02V00-0001 PIC S99 VALUE 16. NC2034.2 +014300 01 DS-03V00-0002 PIC S999 VALUE 174. NC2034.2 +014400 01 CS-05V00-0003 PIC S9(5) COMP VALUE 10. NC2034.2 +014500 01 TA--X PIC 9(5) COMP VALUE ZERO. NC2034.2 +014600 01 MINUS-NAMES. NC2034.2 +014700 02 WHOLE-FIELD PICTURE S9(18). NC2034.2 +014800 02 PLUS-NAME1 PICTURE S9(18) VALUE +333333333333333333. NC2034.2 +014900 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC2034.2 +015000 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC2034.2 +015100 02 ALPHA-LIT PICTURE X(5) VALUE SPACE. NC2034.2 +015200 02 SNEG-LIT2 PICTURE S9(5) VALUE -70718. NC2034.2 +015300 01 TEST-RESULTS. NC2034.2 +015400 02 FILLER PIC X VALUE SPACE. NC2034.2 +015500 02 FEATURE PIC X(20) VALUE SPACE. NC2034.2 +015600 02 FILLER PIC X VALUE SPACE. NC2034.2 +015700 02 P-OR-F PIC X(5) VALUE SPACE. NC2034.2 +015800 02 FILLER PIC X VALUE SPACE. NC2034.2 +015900 02 PAR-NAME. NC2034.2 +016000 03 FILLER PIC X(19) VALUE SPACE. NC2034.2 +016100 03 PARDOT-X PIC X VALUE SPACE. NC2034.2 +016200 03 DOTVALUE PIC 99 VALUE ZERO. NC2034.2 +016300 02 FILLER PIC X(8) VALUE SPACE. NC2034.2 +016400 02 RE-MARK PIC X(61). NC2034.2 +016500 01 TEST-COMPUTED. NC2034.2 +016600 02 FILLER PIC X(30) VALUE SPACE. NC2034.2 +016700 02 FILLER PIC X(17) VALUE NC2034.2 +016800 " COMPUTED=". NC2034.2 +016900 02 COMPUTED-X. NC2034.2 +017000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2034.2 +017100 03 COMPUTED-N REDEFINES COMPUTED-A NC2034.2 +017200 PIC -9(9).9(9). NC2034.2 +017300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2034.2 +017400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2034.2 +017500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2034.2 +017600 03 CM-18V0 REDEFINES COMPUTED-A. NC2034.2 +017700 04 COMPUTED-18V0 PIC -9(18). NC2034.2 +017800 04 FILLER PIC X. NC2034.2 +017900 03 FILLER PIC X(50) VALUE SPACE. NC2034.2 +018000 01 TEST-CORRECT. NC2034.2 +018100 02 FILLER PIC X(30) VALUE SPACE. NC2034.2 +018200 02 FILLER PIC X(17) VALUE " CORRECT =". NC2034.2 +018300 02 CORRECT-X. NC2034.2 +018400 03 CORRECT-A PIC X(20) VALUE SPACE. NC2034.2 +018500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2034.2 +018600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2034.2 +018700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2034.2 +018800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2034.2 +018900 03 CR-18V0 REDEFINES CORRECT-A. NC2034.2 +019000 04 CORRECT-18V0 PIC -9(18). NC2034.2 +019100 04 FILLER PIC X. NC2034.2 +019200 03 FILLER PIC X(2) VALUE SPACE. NC2034.2 +019300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2034.2 +019400 01 CCVS-C-1. NC2034.2 +019500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2034.2 +019600- "SS PARAGRAPH-NAME NC2034.2 +019700- " REMARKS". NC2034.2 +019800 02 FILLER PIC X(20) VALUE SPACE. NC2034.2 +019900 01 CCVS-C-2. NC2034.2 +020000 02 FILLER PIC X VALUE SPACE. NC2034.2 +020100 02 FILLER PIC X(6) VALUE "TESTED". NC2034.2 +020200 02 FILLER PIC X(15) VALUE SPACE. NC2034.2 +020300 02 FILLER PIC X(4) VALUE "FAIL". NC2034.2 +020400 02 FILLER PIC X(94) VALUE SPACE. NC2034.2 +020500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2034.2 +020600 01 REC-CT PIC 99 VALUE ZERO. NC2034.2 +020700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2034.2 +020800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2034.2 +020900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2034.2 +021000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2034.2 +021100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2034.2 +021200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2034.2 +021300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2034.2 +021400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2034.2 +021500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2034.2 +021600 01 CCVS-H-1. NC2034.2 +021700 02 FILLER PIC X(39) VALUE SPACES. NC2034.2 +021800 02 FILLER PIC X(42) VALUE NC2034.2 +021900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2034.2 +022000 02 FILLER PIC X(39) VALUE SPACES. NC2034.2 +022100 01 CCVS-H-2A. NC2034.2 +022200 02 FILLER PIC X(40) VALUE SPACE. NC2034.2 +022300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2034.2 +022400 02 FILLER PIC XXXX VALUE NC2034.2 +022500 "4.2 ". NC2034.2 +022600 02 FILLER PIC X(28) VALUE NC2034.2 +022700 " COPY - NOT FOR DISTRIBUTION". NC2034.2 +022800 02 FILLER PIC X(41) VALUE SPACE. NC2034.2 +022900 NC2034.2 +023000 01 CCVS-H-2B. NC2034.2 +023100 02 FILLER PIC X(15) VALUE NC2034.2 +023200 "TEST RESULT OF ". NC2034.2 +023300 02 TEST-ID PIC X(9). NC2034.2 +023400 02 FILLER PIC X(4) VALUE NC2034.2 +023500 " IN ". NC2034.2 +023600 02 FILLER PIC X(12) VALUE NC2034.2 +023700 " HIGH ". NC2034.2 +023800 02 FILLER PIC X(22) VALUE NC2034.2 +023900 " LEVEL VALIDATION FOR ". NC2034.2 +024000 02 FILLER PIC X(58) VALUE NC2034.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2034.2 +024200 01 CCVS-H-3. NC2034.2 +024300 02 FILLER PIC X(34) VALUE NC2034.2 +024400 " FOR OFFICIAL USE ONLY ". NC2034.2 +024500 02 FILLER PIC X(58) VALUE NC2034.2 +024600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2034.2 +024700 02 FILLER PIC X(28) VALUE NC2034.2 +024800 " COPYRIGHT 1985 ". NC2034.2 +024900 01 CCVS-E-1. NC2034.2 +025000 02 FILLER PIC X(52) VALUE SPACE. NC2034.2 +025100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2034.2 +025200 02 ID-AGAIN PIC X(9). NC2034.2 +025300 02 FILLER PIC X(45) VALUE SPACES. NC2034.2 +025400 01 CCVS-E-2. NC2034.2 +025500 02 FILLER PIC X(31) VALUE SPACE. NC2034.2 +025600 02 FILLER PIC X(21) VALUE SPACE. NC2034.2 +025700 02 CCVS-E-2-2. NC2034.2 +025800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2034.2 +025900 03 FILLER PIC X VALUE SPACE. NC2034.2 +026000 03 ENDER-DESC PIC X(44) VALUE NC2034.2 +026100 "ERRORS ENCOUNTERED". NC2034.2 +026200 01 CCVS-E-3. NC2034.2 +026300 02 FILLER PIC X(22) VALUE NC2034.2 +026400 " FOR OFFICIAL USE ONLY". NC2034.2 +026500 02 FILLER PIC X(12) VALUE SPACE. NC2034.2 +026600 02 FILLER PIC X(58) VALUE NC2034.2 +026700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2034.2 +026800 02 FILLER PIC X(13) VALUE SPACE. NC2034.2 +026900 02 FILLER PIC X(15) VALUE NC2034.2 +027000 " COPYRIGHT 1985". NC2034.2 +027100 01 CCVS-E-4. NC2034.2 +027200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2034.2 +027300 02 FILLER PIC X(4) VALUE " OF ". NC2034.2 +027400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2034.2 +027500 02 FILLER PIC X(40) VALUE NC2034.2 +027600 " TESTS WERE EXECUTED SUCCESSFULLY". NC2034.2 +027700 01 XXINFO. NC2034.2 +027800 02 FILLER PIC X(19) VALUE NC2034.2 +027900 "*** INFORMATION ***". NC2034.2 +028000 02 INFO-TEXT. NC2034.2 +028100 04 FILLER PIC X(8) VALUE SPACE. NC2034.2 +028200 04 XXCOMPUTED PIC X(20). NC2034.2 +028300 04 FILLER PIC X(5) VALUE SPACE. NC2034.2 +028400 04 XXCORRECT PIC X(20). NC2034.2 +028500 02 INF-ANSI-REFERENCE PIC X(48). NC2034.2 +028600 01 HYPHEN-LINE. NC2034.2 +028700 02 FILLER PIC IS X VALUE IS SPACE. NC2034.2 +028800 02 FILLER PIC IS X(65) VALUE IS "************************NC2034.2 +028900- "*****************************************". NC2034.2 +029000 02 FILLER PIC IS X(54) VALUE IS "************************NC2034.2 +029100- "******************************". NC2034.2 +029200 01 CCVS-PGM-ID PIC X(9) VALUE NC2034.2 +029300 "NC203A". NC2034.2 +029400 PROCEDURE DIVISION. NC2034.2 +029500 CCVS1 SECTION. NC2034.2 +029600 OPEN-FILES. NC2034.2 +029700 OPEN OUTPUT PRINT-FILE. NC2034.2 +029800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2034.2 +029900 MOVE SPACE TO TEST-RESULTS. NC2034.2 +030000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2034.2 +030100 GO TO CCVS1-EXIT. NC2034.2 +030200 CLOSE-FILES. NC2034.2 +030300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2034.2 +030400 TERMINATE-CCVS. NC2034.2 +030500*S EXIT PROGRAM. NC2034.2 +030600*SERMINATE-CALL. NC2034.2 +030700 STOP RUN. NC2034.2 +030800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2034.2 +030900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2034.2 +031000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2034.2 +031100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2034.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. NC2034.2 +031300 PRINT-DETAIL. NC2034.2 +031400 IF REC-CT NOT EQUAL TO ZERO NC2034.2 +031500 MOVE "." TO PARDOT-X NC2034.2 +031600 MOVE REC-CT TO DOTVALUE. NC2034.2 +031700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2034.2 +031800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2034.2 +031900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2034.2 +032000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2034.2 +032100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2034.2 +032200 MOVE SPACE TO CORRECT-X. NC2034.2 +032300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2034.2 +032400 MOVE SPACE TO RE-MARK. NC2034.2 +032500 HEAD-ROUTINE. NC2034.2 +032600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +032700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +032800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2034.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2034.2 +033000 COLUMN-NAMES-ROUTINE. NC2034.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +033400 END-ROUTINE. NC2034.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2034.2 +033600 END-RTN-EXIT. NC2034.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +033800 END-ROUTINE-1. NC2034.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2034.2 +034000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2034.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. NC2034.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2034.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2034.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2034.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2034.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2034.2 +034700 END-ROUTINE-12. NC2034.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2034.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO NC2034.2 +035000 MOVE "NO " TO ERROR-TOTAL NC2034.2 +035100 ELSE NC2034.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2034.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2034.2 +035400 PERFORM WRITE-LINE. NC2034.2 +035500 END-ROUTINE-13. NC2034.2 +035600 IF DELETE-COUNTER IS EQUAL TO ZERO NC2034.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE NC2034.2 +035800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2034.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2034.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO NC2034.2 +036200 MOVE "NO " TO ERROR-TOTAL NC2034.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2034.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2034.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2034.2 +036700 WRITE-LINE. NC2034.2 +036800 ADD 1 TO RECORD-COUNT. NC2034.2 +036900 IF RECORD-COUNT GREATER 50 NC2034.2 +037000 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2034.2 +037100 MOVE SPACE TO DUMMY-RECORD NC2034.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2034.2 +037300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2034.2 +037400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2034.2 +037500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2034.2 +037600 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2034.2 +037700 MOVE ZERO TO RECORD-COUNT. NC2034.2 +037800 PERFORM WRT-LN. NC2034.2 +037900 WRT-LN. NC2034.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2034.2 +038100 MOVE SPACE TO DUMMY-RECORD. NC2034.2 +038200 BLANK-LINE-PRINT. NC2034.2 +038300 PERFORM WRT-LN. NC2034.2 +038400 FAIL-ROUTINE. NC2034.2 +038500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2034.2 +038600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2034.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2034.2 +038800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2034.2 +038900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +039000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2034.2 +039100 GO TO FAIL-ROUTINE-EX. NC2034.2 +039200 FAIL-ROUTINE-WRITE. NC2034.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2034.2 +039400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2034.2 +039500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2034.2 +039600 MOVE SPACES TO COR-ANSI-REFERENCE. NC2034.2 +039700 FAIL-ROUTINE-EX. EXIT. NC2034.2 +039800 BAIL-OUT. NC2034.2 +039900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2034.2 +040000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2034.2 +040100 BAIL-OUT-WRITE. NC2034.2 +040200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2034.2 +040300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2034.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2034.2 +040500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2034.2 +040600 BAIL-OUT-EX. EXIT. NC2034.2 +040700 CCVS1-EXIT. NC2034.2 +040800 EXIT. NC2034.2 +040900 SECT-NC203A-001 SECTION. NC2034.2 +041000 DIV-INIT-F4-1. NC2034.2 +041100 MOVE "DIV-TEST-F4-1" TO PAR-NAME. NC2034.2 +041200 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +041300 MOVE "DIVIDE" TO FEATURE. NC2034.2 +041400 MOVE 111111.0 TO WRK-DS-06V06. NC2034.2 +041500 DIV-TEST-F4-1. NC2034.2 +041600 DIVIDE 22 INTO WRK-DS-06V06 GIVING WRK-DS-05V00 NC2034.2 +041700 REMAINDER WRK-DS-02V00. NC2034.2 +041800 ADD WRK-DS-02V00 TO WRK-DS-05V00. NC2034.2 +041900 IF WRK-DS-05V00 EQUAL TO 5061 NC2034.2 +042000 PERFORM PASS NC2034.2 +042100 GO TO DIV-WRITE-F4-1. NC2034.2 +042200 GO TO DIV-FAIL-F4-1. NC2034.2 +042300 DIV-DELETE-F4-1. NC2034.2 +042400 PERFORM DE-LETE. NC2034.2 +042500 GO TO DIV-WRITE-F4-1. NC2034.2 +042600 DIV-FAIL-F4-1. NC2034.2 +042700 MOVE WRK-DS-05V00 TO COMPUTED-N. NC2034.2 +042800 MOVE 5061 TO CORRECT-N. NC2034.2 +042900 PERFORM FAIL. NC2034.2 +043000 DIV-WRITE-F4-1. NC2034.2 +043100 PERFORM PRINT-DETAIL. NC2034.2 +043200* NC2034.2 +043300 DIV-INIT-F4-2. NC2034.2 +043400 MOVE "DIV-TEST-F4-2" TO PAR-NAME. NC2034.2 +043500 MOVE 105 TO DIV11. NC2034.2 +043600 MOVE 1000 TO DIV12. NC2034.2 +043700 DIV-TEST-F4-2. NC2034.2 +043800 DIVIDE DIV11 INTO DIV12 GIVING DIV13 REMAINDER DIV14. NC2034.2 +043900 IF DIV14 IS EQUAL TO 55 NC2034.2 +044000 PERFORM PASS NC2034.2 +044100 GO TO DIV-WRITE-F4-2. NC2034.2 +044200 GO TO DIV-FAIL-F4-2. NC2034.2 +044300 DIV-DELETE-F4-2. NC2034.2 +044400 PERFORM DE-LETE. NC2034.2 +044500 GO TO DIV-WRITE-F4-2. NC2034.2 +044600 DIV-FAIL-F4-2. NC2034.2 +044700 PERFORM FAIL. NC2034.2 +044800 MOVE DIV14 TO COMPUTED-N. NC2034.2 +044900 MOVE "+55" TO CORRECT-A. NC2034.2 +045000 DIV-WRITE-F4-2. NC2034.2 +045100 PERFORM PRINT-DETAIL. NC2034.2 +045200* NC2034.2 +045300 DIV-INIT-F4-3. NC2034.2 +045400 MOVE "DIV-TEST-F4-3" TO PAR-NAME. NC2034.2 +045500 MOVE 14 TO DIV19. NC2034.2 +045600 MOVE 2147 TO DIV20. NC2034.2 +045700 DIV-TEST-F4-3. NC2034.2 +045800 DIVIDE DIV19 INTO DIV20 GIVING DIV21 ROUNDED REMAINDER NC2034.2 +045900 DIV22. NC2034.2 +046000 IF DIV22 IS EQUAL TO 05 NC2034.2 +046100 PERFORM PASS NC2034.2 +046200 GO TO DIV-WRITE-F4-3. NC2034.2 +046300 GO TO DIV-FAIL-F4-3. NC2034.2 +046400 DIV-DELETE-F4-3. NC2034.2 +046500 PERFORM DE-LETE. NC2034.2 +046600 GO TO DIV-WRITE-F4-3. NC2034.2 +046700 DIV-FAIL-F4-3. NC2034.2 +046800 PERFORM FAIL. NC2034.2 +046900 MOVE DIV22 TO COMPUTED-N. NC2034.2 +047000 MOVE "+05" TO CORRECT-A. NC2034.2 +047100 DIV-WRITE-F4-3. NC2034.2 +047200 PERFORM PRINT-DETAIL. NC2034.2 +047300* NC2034.2 +047400 DIV-INIT-F4-4. NC2034.2 +047500 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +047600 MOVE ZERO TO 25COUNT. NC2034.2 +047700 MOVE ZERO TO 25ANS. NC2034.2 +047800 MOVE ZERO TO 25REM. NC2034.2 +047900 MOVE 1 TO REC-CT. NC2034.2 +048000 DIV-INIT-F4-4-0. NC2034.2 +048100 MOVE "DIV-TEST-F4-4-0" TO PAR-NAME. NC2034.2 +048200 DIV-TEST-F4-4-0. NC2034.2 +048300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +048400 ON SIZE ERROR NC2034.2 +048500 PERFORM PASS NC2034.2 +048600 GO TO DIV-WRITE-F4-4-0. NC2034.2 +048700 GO TO DIV-FAIL-F4-4-0. NC2034.2 +048800 DIV-FAIL-F4-4-0. NC2034.2 +048900 MOVE "SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK. NC2034.2 +049000 PERFORM FAIL. NC2034.2 +049100 DIV-WRITE-F4-4-0. NC2034.2 +049200 PERFORM PRINT-DETAIL. NC2034.2 +049300* NC2034.2 +049400 DIV-INIT-F4-4-1. NC2034.2 +049500 MOVE "DIV-TEST-F4-4-1" TO PAR-NAME. NC2034.2 +049600 ADD 1 TO REC-CT. NC2034.2 +049700 DIV-TEST-F4-4-1. NC2034.2 +049800 IF 25ANS NOT = ZERO NC2034.2 +049900 GO TO DIV-FAIL-F4-4-1. NC2034.2 +050000 PERFORM PASS NC2034.2 +050100 GO TO DIV-WRITE-F4-4-1. NC2034.2 +050200 DIV-DELETE-F4-4-1. NC2034.2 +050300 PERFORM DE-LETE. NC2034.2 +050400 GO TO DIV-WRITE-F4-4-1. NC2034.2 +050500 DIV-FAIL-F4-4-1. NC2034.2 +050600 MOVE 25ANS TO COMPUTED-N NC2034.2 +050700 MOVE ZERO TO CORRECT-N NC2034.2 +050800 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +050900 PERFORM FAIL. NC2034.2 +051000 DIV-WRITE-F4-4-1. NC2034.2 +051100 PERFORM PRINT-DETAIL. NC2034.2 +051200* NC2034.2 +051300 DIV-INIT-F4-4-2. NC2034.2 +051400 MOVE "DIV-TEST-F4-4-2" TO PAR-NAME. NC2034.2 +051500 ADD 1 TO REC-CT. NC2034.2 +051600 DIV-TEST-F4-4-2. NC2034.2 +051700 IF 25REM NOT = ZERO NC2034.2 +051800 GO TO DIV-FAIL-F4-4-2. NC2034.2 +051900 PERFORM PASS NC2034.2 +052000 GO TO DIV-WRITE-F4-4-2. NC2034.2 +052100 DIV-DELETE-F4-4-2. NC2034.2 +052200 PERFORM DE-LETE. NC2034.2 +052300 GO TO DIV-WRITE-F4-4-2. NC2034.2 +052400 DIV-FAIL-F4-4-2. NC2034.2 +052500 MOVE 25REM TO COMPUTED-N NC2034.2 +052600 MOVE ZERO TO CORRECT-N NC2034.2 +052700 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +052800 PERFORM FAIL. NC2034.2 +052900 DIV-WRITE-F4-4-2. NC2034.2 +053000 PERFORM PRINT-DETAIL. NC2034.2 +053100* NC2034.2 +053200 DIV-INIT-F4-5. NC2034.2 +053300 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +053400 MOVE ZERO TO 25ANS. NC2034.2 +053500 MOVE ZERO TO 25REM. NC2034.2 +053600 MOVE 3 TO 25COUNT. NC2034.2 +053700 MOVE 1 TO REC-CT. NC2034.2 +053800 DIV-INIT-F4-5-0. NC2034.2 +053900 MOVE "DIV-TEST-F4-5-0" TO PAR-NAME. NC2034.2 +054000 DIV-TEST-F4-5-0. NC2034.2 +054100 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +054200 ON SIZE ERROR NC2034.2 +054300 GO TO DIV-FAIL-F4-5-0. NC2034.2 +054400 PERFORM PASS. NC2034.2 +054500 GO TO DIV-WRITE-F4-5-0. NC2034.2 +054600 DIV-DELETE-F4-5-0. NC2034.2 +054700 PERFORM DE-LETE. NC2034.2 +054800 GO TO DIV-WRITE-F4-5-0. NC2034.2 +054900 DIV-FAIL-F4-5-0. NC2034.2 +055000 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2034.2 +055100 TO RE-MARK NC2034.2 +055200 PERFORM FAIL. NC2034.2 +055300 DIV-WRITE-F4-5-0. NC2034.2 +055400 PERFORM PRINT-DETAIL. NC2034.2 +055500* NC2034.2 +055600 DIV-INIT-F4-5-1. NC2034.2 +055700 MOVE "DIV-TEST-F4-5-1" TO PAR-NAME. NC2034.2 +055800 ADD 1 TO REC-CT. NC2034.2 +055900 DIV-TEST-F4-5-1. NC2034.2 +056000 IF 25ANS NOT = 33 NC2034.2 +056100 GO TO DIV-FAIL-F4-5-1. NC2034.2 +056200 PERFORM PASS NC2034.2 +056300 GO TO DIV-WRITE-F4-5-1. NC2034.2 +056400 DIV-DELETE-F4-5-1. NC2034.2 +056500 PERFORM DE-LETE. NC2034.2 +056600 GO TO DIV-WRITE-F4-5-1. NC2034.2 +056700 DIV-FAIL-F4-5-1. NC2034.2 +056800 MOVE 33 TO CORRECT-N NC2034.2 +056900 MOVE 25ANS TO COMPUTED-N NC2034.2 +057000 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +057100 PERFORM FAIL. NC2034.2 +057200 DIV-WRITE-F4-5-1. NC2034.2 +057300 PERFORM PRINT-DETAIL. NC2034.2 +057400* NC2034.2 +057500 DIV-INIT-F4-5-2. NC2034.2 +057600 MOVE "DIV-TEST-F4-5-2" TO PAR-NAME. NC2034.2 +057700 ADD 1 TO REC-CT. NC2034.2 +057800 DIV-TEST-F4-5-2. NC2034.2 +057900 IF 25REM NOT = 1 NC2034.2 +058000 GO TO DIV-FAIL-F4-5-2. NC2034.2 +058100 PERFORM PASS NC2034.2 +058200 GO TO DIV-WRITE-F4-5-2. NC2034.2 +058300 DIV-DELETE-F4-5-2. NC2034.2 +058400 PERFORM DE-LETE. NC2034.2 +058500 GO TO DIV-WRITE-F4-5-2. NC2034.2 +058600 DIV-FAIL-F4-5-2. NC2034.2 +058700 MOVE 25REM TO COMPUTED-N NC2034.2 +058800 MOVE 1 TO CORRECT-N NC2034.2 +058900 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +059000 PERFORM FAIL. NC2034.2 +059100 DIV-WRITE-F4-5-2. NC2034.2 +059200 PERFORM PRINT-DETAIL. NC2034.2 +059300* NC2034.2 +059400 DIV-INIT-F4-6. NC2034.2 +059500 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +059600 MOVE 40 TO 25COUNT. NC2034.2 +059700 MOVE ZERO TO 25ANS. NC2034.2 +059800 MOVE ZERO TO 25REM. NC2034.2 +059900 MOVE 1 TO REC-CT. NC2034.2 +060000 DIV-INIT-F4-6-0. NC2034.2 +060100 MOVE "DIV-TEST-F4-6-0" TO PAR-NAME. NC2034.2 +060200 DIV-TEST-F4-6-0. NC2034.2 +060300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +060400 ON SIZE ERROR NC2034.2 +060500 GO TO DIV-FAIL-F4-6-0. NC2034.2 +060600 PERFORM PASS. NC2034.2 +060700 GO TO DIV-WRITE-F4-6-0. NC2034.2 +060800 DIV-DELETE-F4-6-0. NC2034.2 +060900 PERFORM DE-LETE. NC2034.2 +061000 GO TO DIV-WRITE-F4-6-0. NC2034.2 +061100 DIV-FAIL-F4-6-0. NC2034.2 +061200 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2034.2 +061300 TO RE-MARK NC2034.2 +061400 PERFORM FAIL. NC2034.2 +061500 DIV-WRITE-F4-6-0. NC2034.2 +061600 PERFORM PRINT-DETAIL. NC2034.2 +061700* NC2034.2 +061800 DIV-INIT-F4-6-1. NC2034.2 +061900 MOVE "DIV-TEST-F4-6-1" TO PAR-NAME. NC2034.2 +062000 ADD 1 TO REC-CT. NC2034.2 +062100 DIV-TEST-F4-6-1. NC2034.2 +062200 IF 25ANS NOT = 2 NC2034.2 +062300 GO TO DIV-FAIL-F4-6-1. NC2034.2 +062400 PERFORM PASS NC2034.2 +062500 GO TO DIV-WRITE-F4-6-1. NC2034.2 +062600 DIV-DELETE-F4-6-1. NC2034.2 +062700 PERFORM DE-LETE. NC2034.2 +062800 GO TO DIV-WRITE-F4-6-1. NC2034.2 +062900 DIV-FAIL-F4-6-1. NC2034.2 +063000 MOVE 2 TO CORRECT-N NC2034.2 +063100 MOVE 25ANS TO COMPUTED-N NC2034.2 +063200 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +063300 PERFORM FAIL. NC2034.2 +063400 DIV-WRITE-F4-6-1. NC2034.2 +063500 PERFORM PRINT-DETAIL. NC2034.2 +063600* NC2034.2 +063700 DIV-INIT-F4-6-2. NC2034.2 +063800 MOVE "DIV-TEST-F4-6-2" TO PAR-NAME. NC2034.2 +063900 DIV-TEST-F4-6-2. NC2034.2 +064000 ADD 1 TO REC-CT. NC2034.2 +064100 IF 25REM NOT = 20 NC2034.2 +064200 GO TO DIV-FAIL-F4-6-2. NC2034.2 +064300 PERFORM PASS NC2034.2 +064400 GO TO DIV-WRITE-F4-6-2. NC2034.2 +064500 DIV-DELETE-F4-6-2. NC2034.2 +064600 PERFORM DE-LETE. NC2034.2 +064700 GO TO DIV-WRITE-F4-6-2. NC2034.2 +064800 DIV-FAIL-F4-6-2. NC2034.2 +064900 MOVE 25REM TO COMPUTED-N NC2034.2 +065000 MOVE 20 TO CORRECT-N NC2034.2 +065100 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +065200 PERFORM FAIL. NC2034.2 +065300 DIV-WRITE-F4-6-2. NC2034.2 +065400 PERFORM PRINT-DETAIL. NC2034.2 +065500* NC2034.2 +065600 DIV-INIT-F4-7. NC2034.2 +065700 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +065800 MOVE "DIV-TEST-F4-7-0" TO PAR-NAME. NC2034.2 +065900 MOVE 16 TO DS-02V00-0001. NC2034.2 +066000 MOVE 174 TO DS-03V00-0002. NC2034.2 +066100 MOVE ZERO TO WRK-DS-04V01-0005. NC2034.2 +066200 MOVE ZERO TO NE-0009. NC2034.2 +066300 MOVE 1 TO REC-CT. NC2034.2 +066400 DIV-TEST-F4-7-0. NC2034.2 +066500 DIVIDE DS-02V00-0001 INTO DS-03V00-0002 NC2034.2 +066600 GIVING WRK-DS-04V01-0005 REMAINDER NE-0009. NC2034.2 +066700* NC2034.2 +066800* REMAINDER RECEIVING FIELD DESCRIBED AS NUMERIC EDITED. NC2034.2 +066900* I1 = 16 NC2034.2 +067000* I2 = 174 NC2034.2 +067100* NC2034.2 +067200 DIV-INIT-F4-7-1. NC2034.2 +067300 MOVE "DIV-TEST-F4-7-1" TO PAR-NAME. NC2034.2 +067400 DIV-TEST-F4-7-1. NC2034.2 +067500 IF NE-0009 EQUAL TO "***01" NC2034.2 +067600 PERFORM PASS NC2034.2 +067700 GO TO DIV-WRITE-F4-7-1. NC2034.2 +067800 GO TO DIV-FAIL-F4-7-1. NC2034.2 +067900 DIV-FAIL-F4-7-1. NC2034.2 +068000 PERFORM FAIL. NC2034.2 +068100 MOVE "***01" TO CORRECT-A. NC2034.2 +068200 MOVE NE-0009 TO COMPUTED-A. NC2034.2 +068300 DIV-DELETE-F4-7-1. NC2034.2 +068400 PERFORM DE-LETE. NC2034.2 +068500 GO TO DIV-WRITE-F4-7-1. NC2034.2 +068600 DIV-WRITE-F4-7-1. NC2034.2 +068700 PERFORM PRINT-DETAIL. NC2034.2 +068800* NC2034.2 +068900 DIV-INIT-F4-7-2. NC2034.2 +069000 MOVE "DIV-TEST-F4-7-2" TO PAR-NAME. NC2034.2 +069100 ADD 1 TO REC-CT. NC2034.2 +069200 DIV-TEST-F4-7-2. NC2034.2 +069300 IF WRK-DS-04V01-0005 NOT = 10.8 NC2034.2 +069400 GO TO DIV-FAIL-F4-7-2. NC2034.2 +069500 PERFORM PASS NC2034.2 +069600 GO TO DIV-WRITE-F4-7-2. NC2034.2 +069700 DIV-DELETE-F4-7-2. NC2034.2 +069800 PERFORM DE-LETE. NC2034.2 +069900 GO TO DIV-WRITE-F4-7-2. NC2034.2 +070000 DIV-FAIL-F4-7-2. NC2034.2 +070100 MOVE WRK-DS-04V01-0005 TO COMPUTED-N NC2034.2 +070200 MOVE 10.8 TO CORRECT-N NC2034.2 +070300 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +070400 PERFORM FAIL. NC2034.2 +070500 DIV-WRITE-F4-7-2. NC2034.2 +070600 PERFORM PRINT-DETAIL. NC2034.2 +070700* NC2034.2 +070800 DIV-INIT-F4-8. NC2034.2 +070900 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +071000 MOVE 16 TO DS-02V00-0001. NC2034.2 +071100 MOVE 174 TO DS-03V00-0002. NC2034.2 +071200 MOVE ZERO TO WRK-DS-04V01-0005. NC2034.2 +071300 MOVE ZERO TO NE-04V01-0006. NC2034.2 +071400 MOVE 1 TO REC-CT. NC2034.2 +071500 MOVE "DIV-TEST-F4-8-0" TO PAR-NAME. NC2034.2 +071600 MOVE "DIVIDE" TO FEATURE. NC2034.2 +071700* NC2034.2 +071800 DIV-TEST-F4-8-0. NC2034.2 +071900 DIVIDE DS-02V00-0001 INTO DS-03V00-0002 NC2034.2 +072000 GIVING NE-04V01-0006 REMAINDER WRK-DS-05V00-0002. NC2034.2 +072100* NC2034.2 +072200* GIVING RECEIVING FIELD DESCRIBED AS NUMERIC EDITED. NC2034.2 +072300* INTERMEDIATE STORAGE SHOULD BE USED TO CALCULATE THE NC2034.2 +072400* REMAINDER NC2034.2 +072500* I1 = 16 NC2034.2 +072600* I2 = 174 NC2034.2 +072700* NC2034.2 +072800 DIV-INIT-F4-8-1. NC2034.2 +072900 MOVE "DIV-TEST-F4-8-1" TO PAR-NAME. NC2034.2 +073000 DIV-TEST-F4-8-1. NC2034.2 +073100 IF WRK-DS-05V00-0002 EQUAL TO 00001 NC2034.2 +073200 PERFORM PASS NC2034.2 +073300 GO TO DIV-WRITE-F4-8-1. NC2034.2 +073400 GO TO DIV-FAIL-F4-8-1. NC2034.2 +073500 DIV-DELETE-F4-8-1. NC2034.2 +073600 PERFORM DE-LETE. NC2034.2 +073700 GO TO DIV-WRITE-F4-8-1. NC2034.2 +073800 DIV-FAIL-F4-8-1. NC2034.2 +073900 PERFORM FAIL. NC2034.2 +074000 MOVE 00001 TO CORRECT-A. NC2034.2 +074100 MOVE WRK-DS-05V00-0002 TO COMPUTED-A. NC2034.2 +074200 DIV-WRITE-F4-8-1. NC2034.2 +074300 PERFORM PRINT-DETAIL. NC2034.2 +074400* NC2034.2 +074500 DIV-INIT-F4-8-2. NC2034.2 +074600 MOVE "DIV-TEST-F4-8-2" TO PAR-NAME. NC2034.2 +074700 ADD 1 TO REC-CT. NC2034.2 +074800 DIV-TEST-F4-8-2. NC2034.2 +074900 IF NE-04V01-0006 NOT = "**10.8" NC2034.2 +075000 GO TO DIV-FAIL-F4-8-2. NC2034.2 +075100 PERFORM PASS NC2034.2 +075200 GO TO DIV-WRITE-F4-8-2. NC2034.2 +075300 DIV-DELETE-F4-8-2. NC2034.2 +075400 PERFORM DE-LETE. NC2034.2 +075500 GO TO DIV-WRITE-F4-8-2. NC2034.2 +075600 DIV-FAIL-F4-8-2. NC2034.2 +075700 MOVE NE-04V01-0006 TO COMPUTED-A NC2034.2 +075800 MOVE "**10.8" TO CORRECT-A NC2034.2 +075900 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +076000 PERFORM FAIL. NC2034.2 +076100 DIV-WRITE-F4-8-2. NC2034.2 +076200 PERFORM PRINT-DETAIL. NC2034.2 +076300* NC2034.2 +076400 DIV-INIT-F4-9. NC2034.2 +076500 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +076600 MOVE ZERO TO 25COUNT. NC2034.2 +076700 MOVE ZERO TO 25ANS. NC2034.2 +076800 MOVE ZERO TO 25REM. NC2034.2 +076900 MOVE 1 TO REC-CT. NC2034.2 +077000 DIV-INIT-F4-9-0. NC2034.2 +077100 MOVE "DIV-TEST-F4-9-0" TO PAR-NAME. NC2034.2 +077200 DIV-TEST-F4-9-0. NC2034.2 +077300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +077400 NOT ON SIZE ERROR NC2034.2 +077500 GO TO DIV-FAIL-F4-9-0. NC2034.2 +077600 PERFORM PASS. NC2034.2 +077700 GO TO DIV-WRITE-F4-9-0. NC2034.2 +077800 DIV-DELETE-F4-9-0. NC2034.2 +077900 PERFORM DE-LETE. NC2034.2 +078000 GO TO DIV-WRITE-F4-9-0. NC2034.2 +078100 DIV-FAIL-F4-9-0. NC2034.2 +078200 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +078300 TO RE-MARK NC2034.2 +078400 PERFORM FAIL. NC2034.2 +078500 DIV-WRITE-F4-9-0. NC2034.2 +078600 PERFORM PRINT-DETAIL. NC2034.2 +078700* NC2034.2 +078800 DIV-INIT-F4-9-1. NC2034.2 +078900 MOVE "DIV-TEST-F4-9-1" TO PAR-NAME. NC2034.2 +079000 ADD 1 TO REC-CT. NC2034.2 +079100 DIV-TEST-F4-9-1. NC2034.2 +079200 IF 25ANS NOT = ZERO NC2034.2 +079300 GO TO DIV-FAIL-F4-9-1. NC2034.2 +079400 PERFORM PASS NC2034.2 +079500 GO TO DIV-WRITE-F4-9-1. NC2034.2 +079600 DIV-DELETE-F4-9-1. NC2034.2 +079700 PERFORM DE-LETE. NC2034.2 +079800 GO TO DIV-WRITE-F4-9-1. NC2034.2 +079900 DIV-FAIL-F4-9-1. NC2034.2 +080000 MOVE 25ANS TO COMPUTED-N NC2034.2 +080100 MOVE ZERO TO CORRECT-N NC2034.2 +080200 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +080300 PERFORM FAIL. NC2034.2 +080400 DIV-WRITE-F4-9-1. NC2034.2 +080500 PERFORM PRINT-DETAIL. NC2034.2 +080600* NC2034.2 +080700 DIV-INIT-F4-9-2. NC2034.2 +080800 MOVE "DIV-TEST-F4-9-2" TO PAR-NAME. NC2034.2 +080900 ADD 1 TO REC-CT. NC2034.2 +081000 DIV-TEST-F4-9-2. NC2034.2 +081100 IF 25REM NOT = ZERO NC2034.2 +081200 GO TO DIV-FAIL-F4-9-2. NC2034.2 +081300 PERFORM PASS NC2034.2 +081400 GO TO DIV-WRITE-F4-9-2. NC2034.2 +081500 DIV-DELETE-F4-9-2. NC2034.2 +081600 PERFORM DE-LETE. NC2034.2 +081700 GO TO DIV-WRITE-F4-9-2. NC2034.2 +081800 DIV-FAIL-F4-9-2. NC2034.2 +081900 MOVE 25REM TO COMPUTED-N NC2034.2 +082000 MOVE ZERO TO CORRECT-N NC2034.2 +082100 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +082200 PERFORM FAIL. NC2034.2 +082300 DIV-WRITE-F4-9-2. NC2034.2 +082400 PERFORM PRINT-DETAIL. NC2034.2 +082500* NC2034.2 +082600 DIV-INIT-F4-10. NC2034.2 +082700 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +082800 MOVE ZERO TO 25ANS. NC2034.2 +082900 MOVE ZERO TO 25REM. NC2034.2 +083000 MOVE 3 TO 25COUNT. NC2034.2 +083100 MOVE 1 TO REC-CT. NC2034.2 +083200 DIV-INIT-F4-10-0. NC2034.2 +083300 MOVE "DIV-TEST-F4-10-0" TO PAR-NAME. NC2034.2 +083400 DIV-TEST-F4-10-0. NC2034.2 +083500 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +083600 NOT ON SIZE ERROR NC2034.2 +083700 PERFORM PASS NC2034.2 +083800 GO TO DIV-WRITE-F4-10-0. NC2034.2 +083900 GO TO DIV-FAIL-F4-10-0. NC2034.2 +084000 DIV-DELETE-F4-10-0. NC2034.2 +084100 PERFORM DE-LETE. NC2034.2 +084200 GO TO DIV-WRITE-F4-10-0. NC2034.2 +084300 DIV-FAIL-F4-10-0. NC2034.2 +084400 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" TO RE-MARK. NC2034.2 +084500 PERFORM FAIL. NC2034.2 +084600 DIV-WRITE-F4-10-0. NC2034.2 +084700 PERFORM PRINT-DETAIL. NC2034.2 +084800* NC2034.2 +084900 DIV-INIT-F4-10-1. NC2034.2 +085000 MOVE "DIV-TEST-F4-10-1" TO PAR-NAME. NC2034.2 +085100 ADD 1 TO REC-CT. NC2034.2 +085200 DIV-TEST-F4-10-1. NC2034.2 +085300 IF 25ANS NOT = 33 NC2034.2 +085400 GO TO DIV-FAIL-F4-10-1. NC2034.2 +085500 PERFORM PASS NC2034.2 +085600 GO TO DIV-WRITE-F4-10-1. NC2034.2 +085700 DIV-DELETE-F4-10-1. NC2034.2 +085800 PERFORM DE-LETE. NC2034.2 +085900 GO TO DIV-WRITE-F4-10-1. NC2034.2 +086000 DIV-FAIL-F4-10-1. NC2034.2 +086100 MOVE 33 TO CORRECT-N NC2034.2 +086200 MOVE 25ANS TO COMPUTED-N NC2034.2 +086300 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +086400 PERFORM FAIL. NC2034.2 +086500 DIV-WRITE-F4-10-1. NC2034.2 +086600 PERFORM PRINT-DETAIL. NC2034.2 +086700* NC2034.2 +086800 DIV-INIT-F4-10-2. NC2034.2 +086900 MOVE "DIV-TEST-F4-10-2" TO PAR-NAME. NC2034.2 +087000 ADD 1 TO REC-CT. NC2034.2 +087100 DIV-TEST-F4-10-2. NC2034.2 +087200 IF 25REM NOT = 1 NC2034.2 +087300 GO TO DIV-FAIL-F4-10-2. NC2034.2 +087400 PERFORM PASS NC2034.2 +087500 GO TO DIV-WRITE-F4-10-2. NC2034.2 +087600 DIV-DELETE-F4-10-2. NC2034.2 +087700 PERFORM DE-LETE. NC2034.2 +087800 GO TO DIV-WRITE-F4-10-2. NC2034.2 +087900 DIV-FAIL-F4-10-2. NC2034.2 +088000 MOVE 25REM TO COMPUTED-N NC2034.2 +088100 MOVE 1 TO CORRECT-N NC2034.2 +088200 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +088300 PERFORM FAIL. NC2034.2 +088400 DIV-WRITE-F4-10-2. NC2034.2 +088500 PERFORM PRINT-DETAIL. NC2034.2 +088600* NC2034.2 +088700 DIV-INIT-F4-11. NC2034.2 +088800 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +088900 MOVE ZERO TO 25COUNT. NC2034.2 +089000 MOVE ZERO TO 25ANS. NC2034.2 +089100 MOVE ZERO TO 25REM. NC2034.2 +089200 MOVE 1 TO REC-CT. NC2034.2 +089300 DIV-INIT-F4-11-0. NC2034.2 +089400 MOVE "DIV-TEST-F4-11-0" TO PAR-NAME. NC2034.2 +089500 DIV-TEST-F4-11-0. NC2034.2 +089600 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +089700 ON SIZE ERROR NC2034.2 +089800 PERFORM PASS NC2034.2 +089900 GO TO DIV-WRITE-F4-11-0 NC2034.2 +090000 NOT ON SIZE ERROR NC2034.2 +090100 GO TO DIV-FAIL-F4-11-0. NC2034.2 +090200 DIV-DELETE-F4-11-0. NC2034.2 +090300 PERFORM DE-LETE. NC2034.2 +090400 GO TO DIV-WRITE-F4-11-0. NC2034.2 +090500 DIV-FAIL-F4-11-0. NC2034.2 +090600 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +090700 TO RE-MARK NC2034.2 +090800 PERFORM FAIL. NC2034.2 +090900 DIV-WRITE-F4-11-0. NC2034.2 +091000 PERFORM PRINT-DETAIL. NC2034.2 +091100* NC2034.2 +091200 DIV-INIT-F4-11-1. NC2034.2 +091300 MOVE "DIV-TEST-F4-11-1" TO PAR-NAME. NC2034.2 +091400 ADD 1 TO REC-CT. NC2034.2 +091500 DIV-TEST-F4-11-1. NC2034.2 +091600 IF 25ANS NOT = ZERO NC2034.2 +091700 GO TO DIV-FAIL-F4-11-1. NC2034.2 +091800 PERFORM PASS NC2034.2 +091900 GO TO DIV-WRITE-F4-11-1. NC2034.2 +092000 DIV-DELETE-F4-11-1. NC2034.2 +092100 PERFORM DE-LETE. NC2034.2 +092200 GO TO DIV-WRITE-F4-11-1. NC2034.2 +092300 DIV-FAIL-F4-11-1. NC2034.2 +092400 MOVE 25ANS TO COMPUTED-N NC2034.2 +092500 MOVE ZERO TO CORRECT-N NC2034.2 +092600 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +092700 PERFORM FAIL. NC2034.2 +092800 DIV-WRITE-F4-11-1. NC2034.2 +092900 PERFORM PRINT-DETAIL. NC2034.2 +093000* NC2034.2 +093100 DIV-INIT-F4-11-2. NC2034.2 +093200 MOVE "DIV-TEST-F4-11-2" TO PAR-NAME. NC2034.2 +093300 ADD 1 TO REC-CT. NC2034.2 +093400 DIV-TEST-F4-11-2. NC2034.2 +093500 IF 25REM NOT = ZERO NC2034.2 +093600 GO TO DIV-FAIL-F4-11-2. NC2034.2 +093700 PERFORM PASS NC2034.2 +093800 GO TO DIV-WRITE-F4-11-2. NC2034.2 +093900 DIV-DELETE-F4-11-2. NC2034.2 +094000 PERFORM DE-LETE. NC2034.2 +094100 GO TO DIV-WRITE-F4-11-2. NC2034.2 +094200 DIV-FAIL-F4-11-2. NC2034.2 +094300 MOVE 25REM TO COMPUTED-N NC2034.2 +094400 MOVE ZERO TO CORRECT-N NC2034.2 +094500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +094600 PERFORM FAIL. NC2034.2 +094700 DIV-WRITE-F4-11-2. NC2034.2 +094800 PERFORM PRINT-DETAIL. NC2034.2 +094900* NC2034.2 +095000 DIV-INIT-F4-12. NC2034.2 +095100 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +095200 MOVE ZERO TO 25ANS. NC2034.2 +095300 MOVE ZERO TO 25REM. NC2034.2 +095400 MOVE 3 TO 25COUNT. NC2034.2 +095500 MOVE 1 TO REC-CT. NC2034.2 +095600 DIV-INIT-F4-12-0. NC2034.2 +095700 MOVE "DIV-TEST-F4-12-0" TO PAR-NAME. NC2034.2 +095800 DIV-TEST-F4-12-0. NC2034.2 +095900 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +096000 ON SIZE ERROR NC2034.2 +096100 GO TO DIV-FAIL-F4-12-0 NC2034.2 +096200 NOT ON SIZE ERROR NC2034.2 +096300 PERFORM PASS NC2034.2 +096400 GO TO DIV-WRITE-F4-12-0. NC2034.2 +096500 DIV-DELETE-F4-12-0. NC2034.2 +096600 PERFORM DE-LETE. NC2034.2 +096700 GO TO DIV-WRITE-F4-12-0. NC2034.2 +096800 DIV-FAIL-F4-12-0. NC2034.2 +096900 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +097000 TO RE-MARK NC2034.2 +097100 PERFORM FAIL. NC2034.2 +097200 DIV-WRITE-F4-12-0. NC2034.2 +097300 PERFORM PRINT-DETAIL. NC2034.2 +097400* NC2034.2 +097500 DIV-INIT-F4-12-1. NC2034.2 +097600 MOVE "DIV-TEST-F4-12-1" TO PAR-NAME. NC2034.2 +097700 ADD 1 TO REC-CT. NC2034.2 +097800 DIV-TEST-F4-12-1. NC2034.2 +097900 IF 25ANS NOT = 33 NC2034.2 +098000 GO TO DIV-FAIL-F4-12-1. NC2034.2 +098100 PERFORM PASS NC2034.2 +098200 GO TO DIV-WRITE-F4-12-1. NC2034.2 +098300 DIV-DELETE-F4-12-1. NC2034.2 +098400 PERFORM DE-LETE. NC2034.2 +098500 GO TO DIV-WRITE-F4-12-1. NC2034.2 +098600 DIV-FAIL-F4-12-1. NC2034.2 +098700 MOVE 33 TO CORRECT-N NC2034.2 +098800 MOVE 25ANS TO COMPUTED-N NC2034.2 +098900 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +099000 PERFORM FAIL. NC2034.2 +099100 DIV-WRITE-F4-12-1. NC2034.2 +099200 PERFORM PRINT-DETAIL. NC2034.2 +099300* NC2034.2 +099400 DIV-INIT-F4-12-2. NC2034.2 +099500 MOVE "DIV-TEST-F4-12-2" TO PAR-NAME. NC2034.2 +099600 ADD 1 TO REC-CT. NC2034.2 +099700 DIV-TEST-F4-12-2. NC2034.2 +099800 IF 25REM NOT = 1 NC2034.2 +099900 GO TO DIV-FAIL-F4-12-2. NC2034.2 +100000 PERFORM PASS NC2034.2 +100100 GO TO DIV-WRITE-F4-12-2. NC2034.2 +100200 DIV-DELETE-F4-12-2. NC2034.2 +100300 PERFORM DE-LETE. NC2034.2 +100400 GO TO DIV-WRITE-F4-12-2. NC2034.2 +100500 DIV-FAIL-F4-12-2. NC2034.2 +100600 MOVE 25REM TO COMPUTED-N NC2034.2 +100700 MOVE 1 TO CORRECT-N NC2034.2 +100800 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +100900 PERFORM FAIL. NC2034.2 +101000 DIV-WRITE-F4-12-2. NC2034.2 +101100 PERFORM PRINT-DETAIL. NC2034.2 +101200* NC2034.2 +101300 DIV-INIT-F4-13. NC2034.2 +101400 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +101500 MOVE ZERO TO 25COUNT. NC2034.2 +101600 MOVE ZERO TO 25ANS. NC2034.2 +101700 MOVE ZERO TO 25REM. NC2034.2 +101800 MOVE 1 TO REC-CT. NC2034.2 +101900 MOVE "DIV-TEST-F4-13-0" TO PAR-NAME. NC2034.2 +102000 DIV-TEST-F4-13-0. NC2034.2 +102100 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +102200 ON SIZE ERROR NC2034.2 +102300 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +102400 END-DIVIDE NC2034.2 +102500 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +102600* NC2034.2 +102700 DIV-INIT-F4-13-1. NC2034.2 +102800 MOVE "DIV-TEST-F4-13-1" TO PAR-NAME. NC2034.2 +102900 DIV-TEST-F4-13-1. NC2034.2 +103000 IF 25ANS NOT = ZERO NC2034.2 +103100 GO TO DIV-FAIL-F4-13-1. NC2034.2 +103200 PERFORM PASS NC2034.2 +103300 GO TO DIV-WRITE-F4-13-1. NC2034.2 +103400 DIV-DELETE-F4-13-1. NC2034.2 +103500 PERFORM DE-LETE. NC2034.2 +103600 GO TO DIV-WRITE-F4-13-1. NC2034.2 +103700 DIV-FAIL-F4-13-1. NC2034.2 +103800 MOVE 25ANS TO COMPUTED-N NC2034.2 +103900 MOVE ZERO TO CORRECT-N NC2034.2 +104000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +104100 PERFORM FAIL. NC2034.2 +104200 DIV-WRITE-F4-13-1. NC2034.2 +104300 PERFORM PRINT-DETAIL. NC2034.2 +104400* NC2034.2 +104500 DIV-INIT-F4-13-2. NC2034.2 +104600 MOVE "DIV-TEST-F4-13-2" TO PAR-NAME. NC2034.2 +104700 ADD 1 TO REC-CT. NC2034.2 +104800 DIV-TEST-F4-13-2. NC2034.2 +104900 IF 25REM NOT = ZERO NC2034.2 +105000 GO TO DIV-FAIL-F4-13-2. NC2034.2 +105100 PERFORM PASS NC2034.2 +105200 GO TO DIV-WRITE-F4-13-2. NC2034.2 +105300 DIV-DELETE-F4-13-2. NC2034.2 +105400 PERFORM DE-LETE. NC2034.2 +105500 GO TO DIV-WRITE-F4-13-2. NC2034.2 +105600 DIV-FAIL-F4-13-2. NC2034.2 +105700 MOVE 25REM TO COMPUTED-N NC2034.2 +105800 MOVE ZERO TO CORRECT-N NC2034.2 +105900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +106000 PERFORM FAIL. NC2034.2 +106100 DIV-WRITE-F4-13-2. NC2034.2 +106200 PERFORM PRINT-DETAIL. NC2034.2 +106300* NC2034.2 +106400 DIV-INIT-F4-13-3. NC2034.2 +106500 MOVE "DIV-TEST-F4-13-3" TO PAR-NAME. NC2034.2 +106600 ADD 1 TO REC-CT. NC2034.2 +106700 DIV-TEST-F4-13-3. NC2034.2 +106800 IF WRK-XN-00001-1 NOT = "A" NC2034.2 +106900 GO TO DIV-FAIL-F4-13-3. NC2034.2 +107000 PERFORM PASS NC2034.2 +107100 GO TO DIV-WRITE-F4-13-3. NC2034.2 +107200 DIV-DELETE-F4-13-3. NC2034.2 +107300 PERFORM DE-LETE. NC2034.2 +107400 GO TO DIV-WRITE-F4-13-3. NC2034.2 +107500 DIV-FAIL-F4-13-3. NC2034.2 +107600 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC2034.2 +107700 TO RE-MARK NC2034.2 +107800 MOVE "A" TO CORRECT-A NC2034.2 +107900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +108000 PERFORM FAIL. NC2034.2 +108100 DIV-WRITE-F4-13-3. NC2034.2 +108200 PERFORM PRINT-DETAIL. NC2034.2 +108300* NC2034.2 +108400 DIV-INIT-F4-13-4. NC2034.2 +108500 MOVE "DIV-TEST-F4-13-4" TO PAR-NAME. NC2034.2 +108600 ADD 1 TO REC-CT. NC2034.2 +108700 DIV-TEST-F4-13-4. NC2034.2 +108800 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +108900 GO TO DIV-FAIL-F4-13-4. NC2034.2 +109000 PERFORM PASS NC2034.2 +109100 GO TO DIV-WRITE-F4-13-4. NC2034.2 +109200 DIV-DELETE-F4-13-4. NC2034.2 +109300 PERFORM DE-LETE. NC2034.2 +109400 GO TO DIV-WRITE-F4-13-4. NC2034.2 +109500 DIV-FAIL-F4-13-4. NC2034.2 +109600 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +109700 MOVE "B" TO CORRECT-A NC2034.2 +109800 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +109900 PERFORM FAIL. NC2034.2 +110000 DIV-WRITE-F4-13-4. NC2034.2 +110100 PERFORM PRINT-DETAIL. NC2034.2 +110200* NC2034.2 +110300 DIV-INIT-F4-14. NC2034.2 +110400 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +110500 MOVE "DIV-TEST-F4-14-0" TO PAR-NAME. NC2034.2 +110600 MOVE ZERO TO 25ANS. NC2034.2 +110700 MOVE ZERO TO 25REM. NC2034.2 +110800 MOVE SPACE TO WRK-XN-00001-1. NC2034.2 +110900 MOVE SPACE TO WRK-XN-00001-2. NC2034.2 +111000 MOVE 3 TO 25COUNT. NC2034.2 +111100 MOVE 1 TO REC-CT. NC2034.2 +111200 DIV-TEST-F4-14-0. NC2034.2 +111300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +111400 ON SIZE ERROR NC2034.2 +111500 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +111600 END-DIVIDE NC2034.2 +111700 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +111800* NC2034.2 +111900 DIV-INIT-F4-14-1. NC2034.2 +112000 MOVE "DIV-TEST-F4-14-1" TO PAR-NAME. NC2034.2 +112100 DIV-TEST-F4-14-1. NC2034.2 +112200 IF 25ANS NOT = 33 NC2034.2 +112300 GO TO DIV-FAIL-F4-14-1. NC2034.2 +112400 PERFORM PASS NC2034.2 +112500 GO TO DIV-WRITE-F4-14-1. NC2034.2 +112600 DIV-DELETE-F4-14-1. NC2034.2 +112700 PERFORM DE-LETE. NC2034.2 +112800 GO TO DIV-WRITE-F4-14-1. NC2034.2 +112900 DIV-FAIL-F4-14-1. NC2034.2 +113000 MOVE 33 TO CORRECT-N NC2034.2 +113100 MOVE 25ANS TO COMPUTED-N NC2034.2 +113200 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +113300 PERFORM FAIL. NC2034.2 +113400 DIV-WRITE-F4-14-1. NC2034.2 +113500 PERFORM PRINT-DETAIL. NC2034.2 +113600* NC2034.2 +113700 DIV-INIT-F4-14-2. NC2034.2 +113800 MOVE "DIV-TEST-F4-14-2" TO PAR-NAME. NC2034.2 +113900 ADD 1 TO REC-CT. NC2034.2 +114000 DIV-TEST-F4-14-2. NC2034.2 +114100 IF 25REM NOT = 1 NC2034.2 +114200 GO TO DIV-FAIL-F4-14-2. NC2034.2 +114300 PERFORM PASS NC2034.2 +114400 GO TO DIV-WRITE-F4-14-2. NC2034.2 +114500 DIV-DELETE-F4-14-2. NC2034.2 +114600 PERFORM DE-LETE. NC2034.2 +114700 GO TO DIV-WRITE-F4-14-2. NC2034.2 +114800 DIV-FAIL-F4-14-2. NC2034.2 +114900 MOVE 25REM TO COMPUTED-N NC2034.2 +115000 MOVE 1 TO CORRECT-N NC2034.2 +115100 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +115200 PERFORM FAIL. NC2034.2 +115300 DIV-WRITE-F4-14-2. NC2034.2 +115400 PERFORM PRINT-DETAIL. NC2034.2 +115500* NC2034.2 +115600 DIV-INIT-F4-14-3. NC2034.2 +115700 MOVE "DIV-TEST-F4-14-3" TO PAR-NAME. NC2034.2 +115800 ADD 1 TO REC-CT. NC2034.2 +115900 DIV-TEST-F4-14-3. NC2034.2 +116000 IF WRK-XN-00001-1 NOT = SPACE NC2034.2 +116100 GO TO DIV-FAIL-F4-14-3. NC2034.2 +116200 PERFORM PASS NC2034.2 +116300 GO TO DIV-WRITE-F4-14-3. NC2034.2 +116400 DIV-DELETE-F4-14-3. NC2034.2 +116500 PERFORM DE-LETE. NC2034.2 +116600 GO TO DIV-WRITE-F4-14-3. NC2034.2 +116700 DIV-FAIL-F4-14-3. NC2034.2 +116800 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +116900 TO RE-MARK. NC2034.2 +117000 MOVE SPACE TO CORRECT-A NC2034.2 +117100 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +117200 PERFORM FAIL. NC2034.2 +117300 DIV-WRITE-F4-14-3. NC2034.2 +117400 PERFORM PRINT-DETAIL. NC2034.2 +117500* NC2034.2 +117600 DIV-INIT-F4-14-4. NC2034.2 +117700 MOVE "DIV-TEST-F4-14-4" TO PAR-NAME. NC2034.2 +117800 ADD 1 TO REC-CT. NC2034.2 +117900 DIV-TEST-F4-14-4. NC2034.2 +118000 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +118100 GO TO DIV-FAIL-F4-14-4. NC2034.2 +118200 PERFORM PASS NC2034.2 +118300 GO TO DIV-WRITE-F4-14-4. NC2034.2 +118400 DIV-DELETE-F4-14-4. NC2034.2 +118500 PERFORM DE-LETE. NC2034.2 +118600 GO TO DIV-WRITE-F4-14-4. NC2034.2 +118700 DIV-FAIL-F4-14-4. NC2034.2 +118800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +118900 MOVE "B" TO CORRECT-A NC2034.2 +119000 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +119100 PERFORM FAIL. NC2034.2 +119200 DIV-WRITE-F4-14-4. NC2034.2 +119300 PERFORM PRINT-DETAIL. NC2034.2 +119400* NC2034.2 +119500 DIV-INIT-F4-15. NC2034.2 +119600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2034.2 +119700 MOVE ZERO TO 25COUNT. NC2034.2 +119800 MOVE ZERO TO 25ANS. NC2034.2 +119900 MOVE ZERO TO 25REM. NC2034.2 +120000 MOVE 1 TO REC-CT. NC2034.2 +120100 MOVE SPACE TO WRK-XN-00001-1. NC2034.2 +120200 MOVE SPACE TO WRK-XN-00001-2. NC2034.2 +120300 MOVE "DIV-TEST-F4-15-0" TO PAR-NAME. NC2034.2 +120400 DIV-TEST-F4-15-0. NC2034.2 +120500 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +120600 NOT ON SIZE ERROR NC2034.2 +120700 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +120800 END-DIVIDE NC2034.2 +120900 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +121000* NC2034.2 +121100 DIV-INIT-F4-15-1. NC2034.2 +121200 MOVE "DIV-TEST-F4-15-1" TO PAR-NAME. NC2034.2 +121300 ADD 1 TO REC-CT. NC2034.2 +121400 DIV-TEST-F4-15-1. NC2034.2 +121500 IF 25ANS NOT = ZERO NC2034.2 +121600 GO TO DIV-FAIL-F4-15-1. NC2034.2 +121700 PERFORM PASS NC2034.2 +121800 GO TO DIV-WRITE-F4-15-1. NC2034.2 +121900 DIV-DELETE-F4-15-1. NC2034.2 +122000 PERFORM DE-LETE. NC2034.2 +122100 GO TO DIV-WRITE-F4-15-1. NC2034.2 +122200 DIV-FAIL-F4-15-1. NC2034.2 +122300 MOVE 25ANS TO COMPUTED-N NC2034.2 +122400 MOVE ZERO TO CORRECT-N NC2034.2 +122500 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +122600 PERFORM FAIL. NC2034.2 +122700 DIV-WRITE-F4-15-1. NC2034.2 +122800 PERFORM PRINT-DETAIL. NC2034.2 +122900* NC2034.2 +123000 DIV-INIT-F4-15-2. NC2034.2 +123100 MOVE "DIV-TEST-F4-15-2" TO PAR-NAME. NC2034.2 +123200 ADD 1 TO REC-CT. NC2034.2 +123300 DIV-TEST-F4-15-2. NC2034.2 +123400 IF 25REM NOT = ZERO NC2034.2 +123500 GO TO DIV-FAIL-F4-15-2. NC2034.2 +123600 PERFORM PASS NC2034.2 +123700 GO TO DIV-WRITE-F4-15-2. NC2034.2 +123800 DIV-DELETE-F4-15-2. NC2034.2 +123900 PERFORM DE-LETE. NC2034.2 +124000 GO TO DIV-WRITE-F4-15-2. NC2034.2 +124100 DIV-FAIL-F4-15-2. NC2034.2 +124200 MOVE 25REM TO COMPUTED-N NC2034.2 +124300 MOVE ZERO TO CORRECT-N NC2034.2 +124400 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +124500 PERFORM FAIL. NC2034.2 +124600 DIV-WRITE-F4-15-2. NC2034.2 +124700 PERFORM PRINT-DETAIL. NC2034.2 +124800* NC2034.2 +124900 DIV-INIT-F4-15-3. NC2034.2 +125000 MOVE "DIV-TEST-F4-15-3" TO PAR-NAME. NC2034.2 +125100 ADD 1 TO REC-CT. NC2034.2 +125200 DIV-TEST-F4-15-3. NC2034.2 +125300 IF WRK-XN-00001-1 = "A" NC2034.2 +125400 GO TO DIV-FAIL-F4-15-3. NC2034.2 +125500 PERFORM PASS NC2034.2 +125600 GO TO DIV-WRITE-F4-15-3. NC2034.2 +125700 DIV-DELETE-F4-15-3. NC2034.2 +125800 PERFORM DE-LETE. NC2034.2 +125900 GO TO DIV-WRITE-F4-15-3. NC2034.2 +126000 DIV-FAIL-F4-15-3. NC2034.2 +126100 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2034.2 +126200 TO RE-MARK NC2034.2 +126300 MOVE SPACE TO CORRECT-A NC2034.2 +126400 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +126500 PERFORM FAIL. NC2034.2 +126600 DIV-WRITE-F4-15-3. NC2034.2 +126700 PERFORM PRINT-DETAIL. NC2034.2 +126800* NC2034.2 +126900 DIV-INIT-F4-15-4. NC2034.2 +127000 MOVE "DIV-TEST-F4-15-4" TO PAR-NAME. NC2034.2 +127100 ADD 1 TO REC-CT. NC2034.2 +127200 DIV-TEST-F4-15-4. NC2034.2 +127300 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +127400 GO TO DIV-FAIL-F4-15-4. NC2034.2 +127500 PERFORM PASS NC2034.2 +127600 GO TO DIV-WRITE-F4-15-4. NC2034.2 +127700 DIV-DELETE-F4-15-4. NC2034.2 +127800 PERFORM DE-LETE. NC2034.2 +127900 GO TO DIV-WRITE-F4-15-4. NC2034.2 +128000 DIV-FAIL-F4-15-4. NC2034.2 +128100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +128200 MOVE "B" TO CORRECT-A NC2034.2 +128300 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +128400 PERFORM FAIL. NC2034.2 +128500 DIV-WRITE-F4-15-4. NC2034.2 +128600 PERFORM PRINT-DETAIL. NC2034.2 +128700* NC2034.2 +128800 DIV-INIT-F4-16. NC2034.2 +128900 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +129000 MOVE ZERO TO 25ANS. NC2034.2 +129100 MOVE ZERO TO 25REM. NC2034.2 +129200 MOVE 3 TO 25COUNT. NC2034.2 +129300 MOVE 1 TO REC-CT. NC2034.2 +129400 MOVE "DIV-TEST-F4-16-0" TO PAR-NAME. NC2034.2 +129500 DIV-TEST-F4-16-0. NC2034.2 +129600 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +129700 NOT ON SIZE ERROR NC2034.2 +129800 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +129900 END-DIVIDE NC2034.2 +130000 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +130100* NC2034.2 +130200 DIV-INIT-F4-16-1. NC2034.2 +130300 MOVE "DIV-TEST-F4-16-1" TO PAR-NAME. NC2034.2 +130400 DIV-TEST-F4-16-1. NC2034.2 +130500 IF 25ANS NOT = 33 NC2034.2 +130600 GO TO DIV-FAIL-F4-16-1. NC2034.2 +130700 PERFORM PASS NC2034.2 +130800 GO TO DIV-WRITE-F4-16-1. NC2034.2 +130900 DIV-DELETE-F4-16-1. NC2034.2 +131000 PERFORM DE-LETE. NC2034.2 +131100 GO TO DIV-WRITE-F4-16-1. NC2034.2 +131200 DIV-FAIL-F4-16-1. NC2034.2 +131300 MOVE 33 TO CORRECT-N NC2034.2 +131400 MOVE 25ANS TO COMPUTED-N NC2034.2 +131500 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +131600 PERFORM FAIL. NC2034.2 +131700 DIV-WRITE-F4-16-1. NC2034.2 +131800 PERFORM PRINT-DETAIL. NC2034.2 +131900* NC2034.2 +132000 DIV-INIT-F4-16-2. NC2034.2 +132100 MOVE "DIV-TEST-F4-16-2" TO PAR-NAME. NC2034.2 +132200 ADD 1 TO REC-CT. NC2034.2 +132300 DIV-TEST-F4-16-2. NC2034.2 +132400 IF 25REM NOT = 1 NC2034.2 +132500 GO TO DIV-FAIL-F4-16-2. NC2034.2 +132600 PERFORM PASS NC2034.2 +132700 GO TO DIV-WRITE-F4-16-2. NC2034.2 +132800 DIV-DELETE-F4-16-2. NC2034.2 +132900 PERFORM DE-LETE. NC2034.2 +133000 GO TO DIV-WRITE-F4-16-2. NC2034.2 +133100 DIV-FAIL-F4-16-2. NC2034.2 +133200 MOVE 25REM TO COMPUTED-N NC2034.2 +133300 MOVE 1 TO CORRECT-N NC2034.2 +133400 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +133500 PERFORM FAIL. NC2034.2 +133600 DIV-WRITE-F4-16-2. NC2034.2 +133700 PERFORM PRINT-DETAIL. NC2034.2 +133800* NC2034.2 +133900 DIV-INIT-F4-16-3. NC2034.2 +134000 MOVE "DIV-TEST-F4-16-3" TO PAR-NAME. NC2034.2 +134100 ADD 1 TO REC-CT. NC2034.2 +134200 DIV-TEST-F4-16-3. NC2034.2 +134300 IF WRK-XN-00001-1 NOT = "A" NC2034.2 +134400 GO TO DIV-FAIL-F4-16-3. NC2034.2 +134500 PERFORM PASS NC2034.2 +134600 GO TO DIV-WRITE-F4-16-3. NC2034.2 +134700 DIV-DELETE-F4-16-3. NC2034.2 +134800 PERFORM DE-LETE. NC2034.2 +134900 GO TO DIV-WRITE-F4-16-3. NC2034.2 +135000 DIV-FAIL-F4-16-3. NC2034.2 +135100 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC2034.2 +135200 TO RE-MARK NC2034.2 +135300 MOVE "A" TO CORRECT-A NC2034.2 +135400 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +135500 PERFORM FAIL. NC2034.2 +135600 DIV-WRITE-F4-16-3. NC2034.2 +135700 PERFORM PRINT-DETAIL. NC2034.2 +135800* NC2034.2 +135900 DIV-INIT-F4-16-4. NC2034.2 +136000 MOVE "DIV-TEST-F4-16-4" TO PAR-NAME. NC2034.2 +136100 ADD 1 TO REC-CT. NC2034.2 +136200 DIV-TEST-F4-16-4. NC2034.2 +136300 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +136400 GO TO DIV-FAIL-F4-16-4. NC2034.2 +136500 PERFORM PASS NC2034.2 +136600 GO TO DIV-WRITE-F4-16-4. NC2034.2 +136700 DIV-DELETE-F4-16-4. NC2034.2 +136800 PERFORM DE-LETE. NC2034.2 +136900 GO TO DIV-WRITE-F4-16-4. NC2034.2 +137000 DIV-FAIL-F4-16-4. NC2034.2 +137100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +137200 MOVE "B" TO CORRECT-A NC2034.2 +137300 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +137400 PERFORM FAIL. NC2034.2 +137500 DIV-WRITE-F4-16-4. NC2034.2 +137600 PERFORM PRINT-DETAIL. NC2034.2 +137700* NC2034.2 +137800 DIV-INIT-F4-17. NC2034.2 +137900 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +138000 MOVE ZERO TO 25COUNT. NC2034.2 +138100 MOVE ZERO TO 25ANS. NC2034.2 +138200 MOVE ZERO TO 25REM. NC2034.2 +138300 MOVE 1 TO REC-CT. NC2034.2 +138400 MOVE SPACE TO WRK-XN-00001-1. NC2034.2 +138500 MOVE SPACE TO WRK-XN-00001-2. NC2034.2 +138600 MOVE "DIV-TEST-F4-17-0" TO PAR-NAME. NC2034.2 +138700 DIV-TEST-F4-17-0. NC2034.2 +138800 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +138900 ON SIZE ERROR NC2034.2 +139000 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +139100 NOT ON SIZE ERROR NC2034.2 +139200 MOVE "B" TO WRK-XN-00001-1 NC2034.2 +139300 END-DIVIDE NC2034.2 +139400 MOVE "C" TO WRK-XN-00001-2. NC2034.2 +139500* NC2034.2 +139600 DIV-INIT-F4-17-1. NC2034.2 +139700 MOVE "DIV-TEST-F4-17-1" TO PAR-NAME. NC2034.2 +139800 ADD 1 TO REC-CT. NC2034.2 +139900 DIV-TEST-F4-17-1. NC2034.2 +140000 IF 25ANS NOT = ZERO NC2034.2 +140100 GO TO DIV-FAIL-F4-17-1. NC2034.2 +140200 PERFORM PASS NC2034.2 +140300 GO TO DIV-WRITE-F4-17-1. NC2034.2 +140400 DIV-DELETE-F4-17-1. NC2034.2 +140500 PERFORM DE-LETE. NC2034.2 +140600 GO TO DIV-WRITE-F4-17-1. NC2034.2 +140700 DIV-FAIL-F4-17-1. NC2034.2 +140800 MOVE 25ANS TO COMPUTED-N NC2034.2 +140900 MOVE ZERO TO CORRECT-N NC2034.2 +141000 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +141100 PERFORM FAIL. NC2034.2 +141200 DIV-WRITE-F4-17-1. NC2034.2 +141300 PERFORM PRINT-DETAIL. NC2034.2 +141400* NC2034.2 +141500 DIV-INIT-F4-17-2. NC2034.2 +141600 MOVE "DIV-TEST-F4-17-2" TO PAR-NAME. NC2034.2 +141700 ADD 1 TO REC-CT. NC2034.2 +141800 DIV-TEST-F4-17-2. NC2034.2 +141900 IF 25REM NOT = ZERO NC2034.2 +142000 GO TO DIV-FAIL-F4-17-2. NC2034.2 +142100 PERFORM PASS NC2034.2 +142200 GO TO DIV-WRITE-F4-17-2. NC2034.2 +142300 DIV-DELETE-F4-17-2. NC2034.2 +142400 PERFORM DE-LETE. NC2034.2 +142500 GO TO DIV-WRITE-F4-17-2. NC2034.2 +142600 DIV-FAIL-F4-17-2. NC2034.2 +142700 MOVE 25REM TO COMPUTED-N NC2034.2 +142800 MOVE ZERO TO CORRECT-N NC2034.2 +142900 MOVE "SIZE ERROR SHOULD HAVE OCCURED" TO RE-MARK NC2034.2 +143000 PERFORM FAIL. NC2034.2 +143100 DIV-WRITE-F4-17-2. NC2034.2 +143200 PERFORM PRINT-DETAIL. NC2034.2 +143300* NC2034.2 +143400 DIV-INIT-F4-17-3. NC2034.2 +143500 MOVE "DIV-TEST-F4-17-3" TO PAR-NAME. NC2034.2 +143600 ADD 1 TO REC-CT. NC2034.2 +143700 DIV-TEST-F4-17-3. NC2034.2 +143800 IF WRK-XN-00001-1 NOT = "A" NC2034.2 +143900 GO TO DIV-FAIL-F4-17-3. NC2034.2 +144000 PERFORM PASS NC2034.2 +144100 GO TO DIV-WRITE-F4-17-3. NC2034.2 +144200 DIV-DELETE-F4-17-3. NC2034.2 +144300 PERFORM DE-LETE. NC2034.2 +144400 GO TO DIV-WRITE-F4-17-3. NC2034.2 +144500 DIV-FAIL-F4-17-3. NC2034.2 +144600 MOVE "ON SIZE ERROR SHOULD HAVE BEEN EXECUTED" NC2034.2 +144700 TO RE-MARK NC2034.2 +144800 MOVE "A" TO CORRECT-A NC2034.2 +144900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +145000 PERFORM FAIL. NC2034.2 +145100 DIV-WRITE-F4-17-3. NC2034.2 +145200 PERFORM PRINT-DETAIL. NC2034.2 +145300* NC2034.2 +145400 DIV-INIT-F4-17-4. NC2034.2 +145500 MOVE "DIV-TEST-F4-17-4" TO PAR-NAME. NC2034.2 +145600 ADD 1 TO REC-CT. NC2034.2 +145700 DIV-TEST-F4-17-4. NC2034.2 +145800 IF WRK-XN-00001-2 NOT = "C" NC2034.2 +145900 GO TO DIV-FAIL-F4-17-4. NC2034.2 +146000 PERFORM PASS NC2034.2 +146100 GO TO DIV-WRITE-F4-17-4. NC2034.2 +146200 DIV-DELETE-F4-17-4. NC2034.2 +146300 PERFORM DE-LETE. NC2034.2 +146400 GO TO DIV-WRITE-F4-17-4. NC2034.2 +146500 DIV-FAIL-F4-17-4. NC2034.2 +146600 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +146700 MOVE "C" TO CORRECT-A NC2034.2 +146800 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +146900 PERFORM FAIL. NC2034.2 +147000 DIV-WRITE-F4-17-4. NC2034.2 +147100 PERFORM PRINT-DETAIL. NC2034.2 +147200* NC2034.2 +147300 DIV-INIT-F4-18. NC2034.2 +147400 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2034.2 +147500 MOVE SPACE TO WRK-XN-00001-1. NC2034.2 +147600 MOVE SPACE TO WRK-XN-00001-2. NC2034.2 +147700 MOVE ZERO TO 25ANS. NC2034.2 +147800 MOVE ZERO TO 25REM. NC2034.2 +147900 MOVE 3 TO 25COUNT. NC2034.2 +148000 MOVE 1 TO REC-CT. NC2034.2 +148100 MOVE "DIV-TEST-F4-18-0" TO PAR-NAME. NC2034.2 +148200 DIV-TEST-F4-18-0. NC2034.2 +148300 DIVIDE 25COUNT INTO 100 GIVING 25ANS REMAINDER 25REM NC2034.2 +148400 ON SIZE ERROR NC2034.2 +148500 MOVE "A" TO WRK-XN-00001-1 NC2034.2 +148600 NOT ON SIZE ERROR NC2034.2 +148700 MOVE "B" TO WRK-XN-00001-1 NC2034.2 +148800 END-DIVIDE NC2034.2 +148900 MOVE "B" TO WRK-XN-00001-2. NC2034.2 +149000* NC2034.2 +149100 DIV-INIT-F4-18-1. NC2034.2 +149200 MOVE "DIV-TEST-F4-18-1" TO PAR-NAME. NC2034.2 +149300 DIV-TEST-F4-18-1. NC2034.2 +149400 IF 25ANS NOT = 33 NC2034.2 +149500 GO TO DIV-FAIL-F4-18-1. NC2034.2 +149600 PERFORM PASS NC2034.2 +149700 GO TO DIV-WRITE-F4-18-1. NC2034.2 +149800 DIV-DELETE-F4-18-1. NC2034.2 +149900 PERFORM DE-LETE. NC2034.2 +150000 GO TO DIV-WRITE-F4-18-1. NC2034.2 +150100 DIV-FAIL-F4-18-1. NC2034.2 +150200 MOVE 33 TO CORRECT-N NC2034.2 +150300 MOVE 25ANS TO COMPUTED-N NC2034.2 +150400 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +150500 PERFORM FAIL. NC2034.2 +150600 DIV-WRITE-F4-18-1. NC2034.2 +150700 PERFORM PRINT-DETAIL. NC2034.2 +150800* NC2034.2 +150900 DIV-INIT-F4-18-2. NC2034.2 +151000 MOVE "DIV-TEST-F4-18-2" TO PAR-NAME. NC2034.2 +151100 ADD 1 TO REC-CT. NC2034.2 +151200 DIV-TEST-F4-18-2. NC2034.2 +151300 IF 25REM NOT = 1 NC2034.2 +151400 GO TO DIV-FAIL-F4-18-2. NC2034.2 +151500 PERFORM PASS NC2034.2 +151600 GO TO DIV-WRITE-F4-18-2. NC2034.2 +151700 DIV-DELETE-F4-18-2. NC2034.2 +151800 PERFORM DE-LETE. NC2034.2 +151900 GO TO DIV-WRITE-F4-18-2. NC2034.2 +152000 DIV-FAIL-F4-18-2. NC2034.2 +152100 MOVE 25REM TO COMPUTED-N NC2034.2 +152200 MOVE 1 TO CORRECT-N NC2034.2 +152300 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +152400 PERFORM FAIL. NC2034.2 +152500 DIV-WRITE-F4-18-2. NC2034.2 +152600 PERFORM PRINT-DETAIL. NC2034.2 +152700* NC2034.2 +152800 DIV-INIT-F4-18-3. NC2034.2 +152900 MOVE "DIV-TEST-F4-18-3" TO PAR-NAME. NC2034.2 +153000 ADD 1 TO REC-CT. NC2034.2 +153100 DIV-TEST-F4-18-3. NC2034.2 +153200 IF WRK-XN-00001-1 NOT = "B" NC2034.2 +153300 GO TO DIV-FAIL-F4-18-3. NC2034.2 +153400 PERFORM PASS NC2034.2 +153500 GO TO DIV-WRITE-F4-18-3. NC2034.2 +153600 DIV-DELETE-F4-18-3. NC2034.2 +153700 PERFORM DE-LETE. NC2034.2 +153800 GO TO DIV-WRITE-F4-18-3. NC2034.2 +153900 DIV-FAIL-F4-18-3. NC2034.2 +154000 MOVE "ON SIZE ERROR SHOULD HAVE BEEN EXECUTED" NC2034.2 +154100 TO RE-MARK NC2034.2 +154200 MOVE "B" TO CORRECT-A NC2034.2 +154300 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2034.2 +154400 PERFORM FAIL. NC2034.2 +154500 DIV-WRITE-F4-18-3. NC2034.2 +154600 PERFORM PRINT-DETAIL. NC2034.2 +154700* NC2034.2 +154800 DIV-INIT-F4-18-4. NC2034.2 +154900 MOVE "DIV-TEST-F4-18-4" TO PAR-NAME. NC2034.2 +155000 ADD 1 TO REC-CT. NC2034.2 +155100 DIV-TEST-F4-18-4. NC2034.2 +155200 IF WRK-XN-00001-2 NOT = "B" NC2034.2 +155300 GO TO DIV-FAIL-F4-18-4. NC2034.2 +155400 PERFORM PASS NC2034.2 +155500 GO TO DIV-WRITE-F4-18-4. NC2034.2 +155600 DIV-DELETE-F4-18-4. NC2034.2 +155700 PERFORM DE-LETE. NC2034.2 +155800 GO TO DIV-WRITE-F4-18-4. NC2034.2 +155900 DIV-FAIL-F4-18-4. NC2034.2 +156000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2034.2 +156100 MOVE "B" TO CORRECT-A NC2034.2 +156200 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2034.2 +156300 PERFORM FAIL. NC2034.2 +156400 DIV-WRITE-F4-18-4. NC2034.2 +156500 PERFORM PRINT-DETAIL. NC2034.2 +156600* NC2034.2 +156700 DIV-INIT-F4-19. NC2034.2 +156800 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2034.2 +156900 MOVE ZERO TO 25ANS. NC2034.2 +157000 MOVE ZERO TO 25REM. NC2034.2 +157100 MOVE ZERO TO WS-REMAINDERS. NC2034.2 +157200 MOVE 6 TO 25COUNT. NC2034.2 +157300 MOVE 1 TO REC-CT. NC2034.2 +157400 MOVE "DIV-TEST-F4-19-0" TO PAR-NAME. NC2034.2 +157500 DIV-TEST-F4-19-0. NC2034.2 +157600 DIVIDE 25COUNT INTO 100 GIVING 25ANS NC2034.2 +157700 REMAINDER WS-REM (25ANS) NC2034.2 +157800 ON SIZE ERROR NC2034.2 +157900 GO TO DIV-FAIL-F4-19-0. NC2034.2 +158000 PERFORM PASS. NC2034.2 +158100 GO TO DIV-WRITE-F4-19-0. NC2034.2 +158200 DIV-DELETE-F4-19-0. NC2034.2 +158300 PERFORM DE-LETE. NC2034.2 +158400 GO TO DIV-WRITE-F4-19-0. NC2034.2 +158500 DIV-FAIL-F4-19-0. NC2034.2 +158600 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2034.2 +158700 TO RE-MARK NC2034.2 +158800 PERFORM FAIL. NC2034.2 +158900 DIV-WRITE-F4-19-0. NC2034.2 +159000 PERFORM PRINT-DETAIL. NC2034.2 +159100* NC2034.2 +159200 DIV-INIT-F4-19-1. NC2034.2 +159300 MOVE "DIV-TEST-F4-19-1" TO PAR-NAME. NC2034.2 +159400 ADD 1 TO REC-CT. NC2034.2 +159500 DIV-TEST-F4-19-1. NC2034.2 +159600 IF 25ANS NOT = 16 NC2034.2 +159700 GO TO DIV-FAIL-F4-19-1. NC2034.2 +159800 PERFORM PASS NC2034.2 +159900 GO TO DIV-WRITE-F4-19-1. NC2034.2 +160000 DIV-DELETE-F4-19-1. NC2034.2 +160100 PERFORM DE-LETE. NC2034.2 +160200 GO TO DIV-WRITE-F4-19-1. NC2034.2 +160300 DIV-FAIL-F4-19-1. NC2034.2 +160400 MOVE 16 TO CORRECT-N NC2034.2 +160500 MOVE 25ANS TO COMPUTED-N NC2034.2 +160600 MOVE "INVALID QUOTIENT" TO RE-MARK NC2034.2 +160700 PERFORM FAIL. NC2034.2 +160800 DIV-WRITE-F4-19-1. NC2034.2 +160900 PERFORM PRINT-DETAIL. NC2034.2 +161000* NC2034.2 +161100 DIV-INIT-F4-19-2. NC2034.2 +161200 MOVE "DIV-TEST-F4-19-2" TO PAR-NAME. NC2034.2 +161300 ADD 1 TO REC-CT. NC2034.2 +161400 DIV-TEST-F4-19-2. NC2034.2 +161500 IF WS-REM (25ANS) NOT = 4 NC2034.2 +161600 GO TO DIV-FAIL-F4-19-2. NC2034.2 +161700 PERFORM PASS NC2034.2 +161800 GO TO DIV-WRITE-F4-19-2. NC2034.2 +161900 DIV-DELETE-F4-19-2. NC2034.2 +162000 PERFORM DE-LETE. NC2034.2 +162100 GO TO DIV-WRITE-F4-19-2. NC2034.2 +162200 DIV-FAIL-F4-19-2. NC2034.2 +162300 MOVE WS-REM (25ANS) TO COMPUTED-N NC2034.2 +162400 MOVE 4 TO CORRECT-N NC2034.2 +162500 MOVE "INVALID REMAINDER" TO RE-MARK NC2034.2 +162600 PERFORM FAIL NC2034.2 +162700 PERFORM PRINT-DETAIL NC2034.2 +162800 ADD 1 TO REC-CT NC2034.2 +162900 MOVE 25ANS TO COMPUTED-N NC2034.2 +163000 MOVE 16 TO CORRECT-N NC2034.2 +163100 MOVE "INVALID SUBSCRIPT FOR REMAINDER" TO RE-MARK NC2034.2 +163200 PERFORM FAIL. NC2034.2 +163300 DIV-WRITE-F4-19-2. NC2034.2 +163400 PERFORM PRINT-DETAIL. NC2034.2 +163500* NC2034.2 +163600 DIV-INIT-F4-20. NC2034.2 +163700 MOVE "DIV-TEST-F4-20" TO PAR-NAME. NC2034.2 +163800 MOVE 10.0 TO WRK-DU-2V1-1. NC2034.2 +163900 MOVE 3.14159265358979323 TO WRK-DU-1V17-1. NC2034.2 +164000 MOVE ZERO TO REC-CT. NC2034.2 +164100 DIV-TEST-F4-20. NC2034.2 +164200 DIVIDE WRK-DU-2V1-1 INTO WRK-DU-1V17-1 GIVING WRK-DU-1V5-1 NC2034.2 +164300 ROUNDED REMAINDER WRK-NE-1 NC2034.2 +164400 ON SIZE ERROR GO TO DIV-FAIL-F4-20. NC2034.2 +164500 GO TO DIV-TEST-F4-20-1. NC2034.2 +164600 DIV-DELETE-F4-20. NC2034.2 +164700 PERFORM DE-LETE. NC2034.2 +164800 PERFORM PRINT-DETAIL. NC2034.2 +164900 GO TO CCVS-EXIT. NC2034.2 +165000 DIV-FAIL-F4-20. NC2034.2 +165100 PERFORM FAIL. NC2034.2 +165200 MOVE "SIZE ERROR SHOULD NOT BE EXECUTED" TO RE-MARK. NC2034.2 +165300 PERFORM PRINT-DETAIL. NC2034.2 +165400* NC2034.2 +165500 DIV-TEST-F4-20-1. NC2034.2 +165600 MOVE "DIV-TEST-F4-20-1" TO PAR-NAME. NC2034.2 +165700 MOVE 1 TO REC-CT. NC2034.2 +165800 IF WRK-DU-1V5-1 = 0.31416 NC2034.2 +165900 PERFORM PASS NC2034.2 +166000 GO TO DIV-WRITE-F4-20-1 NC2034.2 +166100 ELSE NC2034.2 +166200 GO TO DIV-FAIL-F4-20-1. NC2034.2 +166300 DIV-DELETE-F4-20-1. NC2034.2 +166400 PERFORM DE-LETE. NC2034.2 +166500 GO TO DIV-WRITE-F4-20-1. NC2034.2 +166600 DIV-FAIL-F4-20-1. NC2034.2 +166700 PERFORM FAIL NC2034.2 +166800 MOVE WRK-DU-1V5-1 TO COMPUTED-N NC2034.2 +166900 MOVE 0.31416 TO CORRECT-N. NC2034.2 +167000 DIV-WRITE-F4-20-1. NC2034.2 +167100 PERFORM PRINT-DETAIL. NC2034.2 +167200* NC2034.2 +167300 DIV-TEST-F4-20-2. NC2034.2 +167400 ADD 1 TO REC-CT. NC2034.2 +167500 MOVE "DIV-TEST-F4-20-2" TO PAR-NAME. NC2034.2 +167600 IF WRK-NE-1 = ".0000/92653,58979,32" NC2034.2 +167700 PERFORM PASS NC2034.2 +167800 GO TO DIV-WRITE-F4-20-2 NC2034.2 +167900 ELSE NC2034.2 +168000 GO TO DIV-FAIL-F4-20-2. NC2034.2 +168100 DIV-DELETE-F4-20-2. NC2034.2 +168200 PERFORM DE-LETE. NC2034.2 +168300 GO TO DIV-WRITE-F4-20-2. NC2034.2 +168400 DIV-FAIL-F4-20-2. NC2034.2 +168500 PERFORM FAIL NC2034.2 +168600 MOVE WRK-NE-1 TO COMPUTED-A NC2034.2 +168700 MOVE ".0000/92653,58979,32" TO CORRECT-A. NC2034.2 +168800 DIV-WRITE-F4-20-2. NC2034.2 +168900 PERFORM PRINT-DETAIL. NC2034.2 +169000* NC2034.2 +169100 CCVS-EXIT SECTION. NC2034.2 +169200 CCVS-999999. NC2034.2 +169300 GO TO CLOSE-FILES. NC2034.2 diff --git a/tests/cobol85/NC/NC204M.CBL b/tests/cobol85/NC/NC204M.CBL new file mode 100755 index 00000000..9e97682f --- /dev/null +++ b/tests/cobol85/NC/NC204M.CBL @@ -0,0 +1,1207 @@ +000100 IDENTIFICATION DIVISION. NC2044.2 +000200 PROGRAM-ID. NC2044.2 +000300 NC204M. NC2044.2 +000400**************************************************************** NC2044.2 +000500* * NC2044.2 +000600* VALIDATION FOR:- * NC2044.2 +000700* * NC2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2044.2 +000900* * NC2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2044.2 +001100* * NC2044.2 +001200**************************************************************** NC2044.2 +001300* * NC2044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2044.2 +001500* * NC2044.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2044.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2044.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2044.2 +001900* * NC2044.2 +002000**************************************************************** NC2044.2 +002100* * NC2044.2 +002200* PROGRAM NC204M TESTS FORMAT 1 OF THE ACCEPT STATEMENT AND * NC2044.2 +002300* THE GENERAL FORMAT OF THE DISPLAY STATEMENT. * NC2044.2 +002400* * NC2044.2 +002500* X CARDS USED ARE:- * NC2044.2 +002600* * NC2044.2 +002700* X-55 - SYSTEM PRINTER NAME. * NC2044.2 +002800* X-56 - DISPLAY MNEMONIC NAME. * NC2044.2 +002900* X-57 - ACCEPT MNEMONIC NAME. * NC2044.2 +003000* X-82 - SOURCE COMPUTER NAME. * NC2044.2 +003100* X-83 - OBJECT COMPUTER NAME. * NC2044.2 +003200* * NC2044.2 +003300**************************************************************** NC2044.2 +003400 ENVIRONMENT DIVISION. NC2044.2 +003500 CONFIGURATION SECTION. NC2044.2 +003600 SOURCE-COMPUTER. NC2044.2 +003700 Linux. NC2044.2 +003800 OBJECT-COMPUTER. NC2044.2 +003900 Linux. NC2044.2 +004000 SPECIAL-NAMES. NC2044.2 +004100 SYSIN NC2044.2 +004200 IS ACCEPT-INPUT-DEVICE NC2044.2 +004300 SYSOUT NC2044.2 +004400 IS DISPLAY-OUTPUT-DEVICE. NC2044.2 +004500 INPUT-OUTPUT SECTION. NC2044.2 +004600 FILE-CONTROL. NC2044.2 +004700 SELECT PRINT-FILE ASSIGN TO NC2044.2 +004800 "report.log". NC2044.2 +004900 DATA DIVISION. NC2044.2 +005000 FILE SECTION. NC2044.2 +005100 FD PRINT-FILE. NC2044.2 +005200 01 PRINT-REC PICTURE X(120). NC2044.2 +005300 01 DUMMY-RECORD PICTURE X(120). NC2044.2 +005400 WORKING-STORAGE SECTION. NC2044.2 +005500 77 SUB PICTURE 9 USAGE COMPUTATIONAL VALUE 5. NC2044.2 +005600 01 ACCEPT-DATA. NC2044.2 +005700 02 ACCEPT-D1. NC2044.2 +005800 03 ACCEPT-D1-A PICTURE X(20). NC2044.2 +005900 03 ACCEPT-D1-B PICTURE X(7). NC2044.2 +006000 02 ACCEPT-D2 PICTURE X(27) VALUE "ABCDEFGHIJKLMNOPQRSTUVWXY ZNC2044.2 +006100- "". NC2044.2 +006200 02 ACCEPT-D3 PICTURE 9(10) USAGE DISPLAY. NC2044.2 +006300 02 ACCEPT-D4 PICTURE 9(10) USAGE DISPLAY VALUE 0123456789. NC2044.2 +006400 02 ACCEPT-D5 PICTURE X(11) . NC2044.2 +006500 02 ACCEPT-D6 PICTURE X(11) VALUE "().+-*/l, =". NC2044.2 +006600 02 ACCEPT-D7 PICTURE X. NC2044.2 +006700 02 ACCEPT-D8 PICTURE X VALUE "9". NC2044.2 +006800 02 ACCEPT-D9 PICTURE X. NC2044.2 +006900 02 ACCEPT-D10 PICTURE X VALUE "0". NC2044.2 +007000 02 ACCEPT-D11 PICTURE A(20). NC2044.2 +007100 02 ACCEPT-D12 PICTURE A(20) NC2044.2 +007200 VALUE " ABC XYZ ". NC2044.2 +007300 02 ACCEPT-D13 PICTURE X(200). NC2044.2 +007400 02 ACCEPT-D15 PICTURE XX. NC2044.2 +007500 02 ACCEPT-D16 PICTURE XX VALUE " 9". NC2044.2 +007600 02 ACCEPT-D17. NC2044.2 +007700 03 QUAL-ACCEPT PICTURE X. NC2044.2 +007800 02 ACCEPT-D18 PICTURE X VALUE QUOTE. NC2044.2 +007900 02 ACCEPT-D19. NC2044.2 +008000 03 QUAL-ACCEPT PICTURE X. NC2044.2 +008100 02 ACCEPT-D20 PICTURE X VALUE "Q". NC2044.2 +008200 02 ACCEPT-VALUE21 PICTURE X(12) VALUE "............". NC2044.2 +008300 02 ACCEPT-D21 REDEFINES ACCEPT-VALUE21. NC2044.2 +008400 03 TAB-ACCEPT OCCURS 3 TIMES. NC2044.2 +008500 04 TAB-A PICTURE XXXX. NC2044.2 +008600 02 ACCEPT-D22 PICTURE X(12) VALUE "....ABCD....". NC2044.2 +008700 02 ACCEPT-D23. NC2044.2 +008800 03 TAB-A PICTURE XXXX OCCURS 5 TIMES. NC2044.2 +008900 02 ACCEPT-D24 PICTURE X(20) VALUE "----------------ABCD". NC2044.2 +009000 02 ACCEPT-TEST-14-DATA PIC X(15). NC2044.2 +009100 02 FILLER REDEFINES ACCEPT-TEST-14-DATA. NC2044.2 +009200 03 ACC-14-CHARS-1-10 PIC X(10). NC2044.2 +009300 02 FILLER REDEFINES ACCEPT-TEST-14-DATA. NC2044.2 +009400 03 ACC-14-CHARS-11-15 PIC X(5). NC2044.2 +009500 NC2044.2 +009600 01 GRP-CONSTANTS. NC2044.2 +009700 04 GRP-ALPHABETIC. NC2044.2 +009800 05 ALPHABET-AN-00026 PICTURE A(26) NC2044.2 +009900 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2044.2 +010000 04 GRP-NUMERIC. NC2044.2 +010100 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789.NC2044.2 +010200 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 NC2044.2 +010300 PICTURE 9(6)V9999. NC2044.2 +010400 04 GRP-ALPHANUMERIC. NC2044.2 +010500 05 ALPHANUMERIC-XN-00049 PICTURE X(50) NC2044.2 +010600 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-<>=l,;.()/* 0123456789". NC2044.2 +010700 05 FILLER PICTURE X VALUE QUOTE. NC2044.2 +010800 01 ACCEPT-RESULTS. NC2044.2 +010900 02 FILLER PICTURE X(80) VALUE NC2044.2 +011000 "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456NC2044.2 +011100- "789 ". NC2044.2 +011200 01 80X-CHARACTER-FIELD. NC2044.2 +011300 02 FILLER PICTURE X(80). NC2044.2 +011400 01 DISPLAY-DATA. NC2044.2 +011500 02 DISPLAY-A. NC2044.2 +011600 03 DISPLAY-A1 PICTURE A VALUE "A". NC2044.2 +011700 03 DISPLAY-A2. NC2044.2 +011800 04 DISPLAY-A2A PICTURE A VALUE "L". NC2044.2 +011900 04 DISPLAY-A3. NC2044.2 +012000 05 DISPLAY-A3A PICTURE A VALUE "P". NC2044.2 +012100 05 DISPLAY-A4. NC2044.2 +012200 06 DISPLAY-A4A PICTURE A VALUE "H". NC2044.2 +012300 06 DISPLAY-A5. NC2044.2 +012400 07 DISPLAY-A5A PICTURE A VALUE "A". NC2044.2 +012500 07 DISPLAY-A6. NC2044.2 +012600 08 DISPLAY-A6A PICTURE A VALUE "B". NC2044.2 +012700 08 DISPLAY-A7. NC2044.2 +012800 09 DISPLAY-A7A PICTURE A VALUE "E". NC2044.2 +012900 09 DISPLAY-A8. NC2044.2 +013000 10 DISPLAY-A8A PICTURE AAA VALUE "TIC". NC2044.2 +013100 02 DISPLAY-N PICTURE 9(10) VALUE 0123456789. NC2044.2 +013200 02 DISPLAY-X PICTURE X(10) VALUE "A1B2C3D4E5". NC2044.2 +013300 02 DISPLAY-B PICTURE X(13). NC2044.2 +013400 02 DISPLAY-C REDEFINES DISPLAY-B. NC2044.2 +013500 03 DISPLAY-D PICTURE X(8). NC2044.2 +013600 03 DISPLAY-E PICTURE X(5). NC2044.2 +013700 02 DISPLAY-F. NC2044.2 +013800 03 DISPLAY-G PICTURE X(100) VALUE IS "D001*002*003*004*005*00NC2044.2 +013900- "6*007*008*009*010*011*012*013*014*015*016*017*018*019*020D02NC2044.2 +014000- "1*022*023*024*025". NC2044.2 +014100 03 DISPLAY-H PICTURE IS X(100) VALUE IS "*026*027*028*029*030NC2044.2 +014200- "*031*032*033*034*035*036*037*038*039*040D041*042*043*044*045NC2044.2 +014300- "*046*047*048*049*050". NC2044.2 +014400 02 SEE-ABOVE PICTURE X(9) VALUE "SEE ABOVE". NC2044.2 +014500 02 SEE-BELOW PICTURE X(9) VALUE "SEE BELOW". NC2044.2 +014600 02 CORRECT-FOLLOWS PICTURE X(20) NC2044.2 +014700 VALUE "CORRECT DATA FOLLOWS". NC2044.2 +014800 02 END-CORRECT PICTURE X(16) VALUE "END CORRECT DATA". NC2044.2 +014900 02 DISPLAY-WRITER. NC2044.2 +015000 03 DIS-PLAYER PICTURE X(119). NC2044.2 +015100 02 DISPLAY-SWITCH PICTURE 9 VALUE ZERO. NC2044.2 +015200 02 ZERO-SPACE-QUOTE. NC2044.2 +015300 03 FILLER PICTURE X VALUE "0". NC2044.2 +015400 03 FILLER PICTURE X VALUE SPACE. NC2044.2 +015500 03 FILLER PICTURE X VALUE QUOTE. NC2044.2 +015600 02 QUAL-TAB-VALUE PICTURE X(21) NC2044.2 +015700 VALUE "ABCDEFGHIJKLMNOPQRSTU". NC2044.2 +015800 02 NO-QUAL-TAB-RECORD REDEFINES QUAL-TAB-VALUE. NC2044.2 +015900 03 X1 PICTURE X. NC2044.2 +016000 03 X2 PICTURE X. NC2044.2 +016100 03 X3 PICTURE X. NC2044.2 +016200 03 X4 PICTURE X. NC2044.2 +016300 03 X5 PICTURE X. NC2044.2 +016400 03 X6 PICTURE X. NC2044.2 +016500 03 X7 PICTURE X. NC2044.2 +016600 03 X8 PICTURE X. NC2044.2 +016700 03 X9 PICTURE X. NC2044.2 +016800 03 X10 PICTURE X. NC2044.2 +016900 03 X11 PICTURE X. NC2044.2 +017000 03 X12 PICTURE X. NC2044.2 +017100 03 X13 PICTURE X. NC2044.2 +017200 03 X14 PICTURE X. NC2044.2 +017300 03 X15 PICTURE X. NC2044.2 +017400 03 X16 PICTURE X. NC2044.2 +017500 03 X17 PICTURE X. NC2044.2 +017600 03 X18 PICTURE X. NC2044.2 +017700 03 X19 PICTURE X. NC2044.2 +017800 03 X20 PICTURE X. NC2044.2 +017900 03 X21 PICTURE X. NC2044.2 +018000 02 QUAL-TAB-RECORD REDEFINES QUAL-TAB-VALUE. NC2044.2 +018100 03 XTAB PICTURE X OCCURS 9 TIMES. NC2044.2 +018200 03 GRP-1. NC2044.2 +018300 04 ELEM-1 PICTURE X. NC2044.2 +018400 04 ELEM-2 PICTURE X. NC2044.2 +018500 04 ELEM-3 PICTURE X. NC2044.2 +018600 04 SUB-TAB PICTURE X OCCURS 3 TIMES. NC2044.2 +018700 03 GRP-2. NC2044.2 +018800 04 ELEM-1 PICTURE X. NC2044.2 +018900 04 ELEM-2 PICTURE X. NC2044.2 +019000 04 ELEM-3 PICTURE X. NC2044.2 +019100 04 SUB-TAB PICTURE X OCCURS 3 TIMES. NC2044.2 +019200 02 DISPLAY-MIXTURE. NC2044.2 +019300 03 FILLER PICTURE X(6) VALUE "QUOTE ". NC2044.2 +019400 03 FILLER PICTURE X VALUE QUOTE. NC2044.2 +019500 03 FILLER PICTURE X(36) VALUE NC2044.2 +019600 " ASTERISK * NUMERIC LITERALS 21 1325". NC2044.2 +019700 03 I-DATA PICTURE X(17) NC2044.2 +019800 VALUE " IDENTIFIER DATA ". NC2044.2 +019900 03 TA-VALUE PICTURE X(20) NC2044.2 +020000 VALUE "A B C D E 1 2 3 4 5 ". NC2044.2 +020100 03 TA-BLE REDEFINES TA-VALUE. NC2044.2 +020200 04 ROW OCCURS 2 TIMES. NC2044.2 +020300 05 PIECE PICTURE XX OCCURS 5 TIMES. NC2044.2 +020400 03 TRUE-PAIR. NC2044.2 +020500 04 A1 PICTURE X(20) NC2044.2 +020600 VALUE "(TOTAL 21 OPERANDS) ".NC2044.2 +020700 04 A2 PICTURE X(11) NC2044.2 +020800 VALUE "END OF DATA". NC2044.2 +020900 02 FALSE-PAIR. NC2044.2 +021000 04 A1 PICTURE X(20) NC2044.2 +021100 VALUE "(SOME BAD OPERANDS) ".NC2044.2 +021200 04 A2 PICTURE X(11) NC2044.2 +021300 VALUE "ERROR DATA". NC2044.2 +021400 01 CHARACTER-BREAKDOWN-S. NC2044.2 +021500 02 FIRST-20S PICTURE X(20). NC2044.2 +021600 02 SECOND-20S PICTURE X(20). NC2044.2 +021700 02 THIRD-20S PICTURE X(20). NC2044.2 +021800 02 FOURTH-20S PICTURE X(20). NC2044.2 +021900 02 FIFTH-20S PICTURE X(20). NC2044.2 +022000 02 SIXTH-20S PICTURE X(20). NC2044.2 +022100 02 SEVENTH-20S PICTURE X(20). NC2044.2 +022200 02 EIGHTH-20S PICTURE X(20). NC2044.2 +022300 02 NINTH-20S PICTURE X(20). NC2044.2 +022400 02 TENTH-20S PICTURE X(20). NC2044.2 +022500 01 CHARACTER-BREAKDOWN-R. NC2044.2 +022600 02 FIRST-20R PICTURE X(20). NC2044.2 +022700 02 SECOND-20R PICTURE X(20). NC2044.2 +022800 02 THIRD-20R PICTURE X(20). NC2044.2 +022900 02 FOURTH-20R PICTURE X(20). NC2044.2 +023000 02 FIFTH-20R PICTURE X(20). NC2044.2 +023100 02 SIXTH-20R PICTURE X(20). NC2044.2 +023200 02 SEVENTH-20R PICTURE X(20). NC2044.2 +023300 02 EIGHTH-20R PICTURE X(20). NC2044.2 +023400 02 NINTH-20R PICTURE X(20). NC2044.2 +023500 02 TENTH-20R PICTURE X(20). NC2044.2 +023600 01 TEST-RESULTS. NC2044.2 +023700 02 FILLER PIC X VALUE SPACE. NC2044.2 +023800 02 FEATURE PIC X(20) VALUE SPACE. NC2044.2 +023900 02 FILLER PIC X VALUE SPACE. NC2044.2 +024000 02 P-OR-F PIC X(5) VALUE SPACE. NC2044.2 +024100 02 FILLER PIC X VALUE SPACE. NC2044.2 +024200 02 PAR-NAME. NC2044.2 +024300 03 FILLER PIC X(19) VALUE SPACE. NC2044.2 +024400 03 PARDOT-X PIC X VALUE SPACE. NC2044.2 +024500 03 DOTVALUE PIC 99 VALUE ZERO. NC2044.2 +024600 02 FILLER PIC X(8) VALUE SPACE. NC2044.2 +024700 02 RE-MARK PIC X(61). NC2044.2 +024800 01 TEST-COMPUTED. NC2044.2 +024900 02 FILLER PIC X(30) VALUE SPACE. NC2044.2 +025000 02 FILLER PIC X(17) VALUE NC2044.2 +025100 " COMPUTED=". NC2044.2 +025200 02 COMPUTED-X. NC2044.2 +025300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2044.2 +025400 03 COMPUTED-N REDEFINES COMPUTED-A NC2044.2 +025500 PIC -9(9).9(9). NC2044.2 +025600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2044.2 +025700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2044.2 +025800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2044.2 +025900 03 CM-18V0 REDEFINES COMPUTED-A. NC2044.2 +026000 04 COMPUTED-18V0 PIC -9(18). NC2044.2 +026100 04 FILLER PIC X. NC2044.2 +026200 03 FILLER PIC X(50) VALUE SPACE. NC2044.2 +026300 01 TEST-CORRECT. NC2044.2 +026400 02 FILLER PIC X(30) VALUE SPACE. NC2044.2 +026500 02 FILLER PIC X(17) VALUE " CORRECT =". NC2044.2 +026600 02 CORRECT-X. NC2044.2 +026700 03 CORRECT-A PIC X(20) VALUE SPACE. NC2044.2 +026800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2044.2 +026900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2044.2 +027000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2044.2 +027100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2044.2 +027200 03 CR-18V0 REDEFINES CORRECT-A. NC2044.2 +027300 04 CORRECT-18V0 PIC -9(18). NC2044.2 +027400 04 FILLER PIC X. NC2044.2 +027500 03 FILLER PIC X(2) VALUE SPACE. NC2044.2 +027600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2044.2 +027700 01 CCVS-C-1. NC2044.2 +027800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2044.2 +027900- "SS PARAGRAPH-NAME NC2044.2 +028000- " REMARKS". NC2044.2 +028100 02 FILLER PIC X(20) VALUE SPACE. NC2044.2 +028200 01 CCVS-C-2. NC2044.2 +028300 02 FILLER PIC X VALUE SPACE. NC2044.2 +028400 02 FILLER PIC X(6) VALUE "TESTED". NC2044.2 +028500 02 FILLER PIC X(15) VALUE SPACE. NC2044.2 +028600 02 FILLER PIC X(4) VALUE "FAIL". NC2044.2 +028700 02 FILLER PIC X(94) VALUE SPACE. NC2044.2 +028800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2044.2 +028900 01 REC-CT PIC 99 VALUE ZERO. NC2044.2 +029000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2044.2 +029100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2044.2 +029200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2044.2 +029300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2044.2 +029400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2044.2 +029500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2044.2 +029600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2044.2 +029700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2044.2 +029800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2044.2 +029900 01 CCVS-H-1. NC2044.2 +030000 02 FILLER PIC X(39) VALUE SPACES. NC2044.2 +030100 02 FILLER PIC X(42) VALUE NC2044.2 +030200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2044.2 +030300 02 FILLER PIC X(39) VALUE SPACES. NC2044.2 +030400 01 CCVS-H-2A. NC2044.2 +030500 02 FILLER PIC X(40) VALUE SPACE. NC2044.2 +030600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2044.2 +030700 02 FILLER PIC XXXX VALUE NC2044.2 +030800 "4.2 ". NC2044.2 +030900 02 FILLER PIC X(28) VALUE NC2044.2 +031000 " COPY - NOT FOR DISTRIBUTION". NC2044.2 +031100 02 FILLER PIC X(41) VALUE SPACE. NC2044.2 +031200 NC2044.2 +031300 01 CCVS-H-2B. NC2044.2 +031400 02 FILLER PIC X(15) VALUE NC2044.2 +031500 "TEST RESULT OF ". NC2044.2 +031600 02 TEST-ID PIC X(9). NC2044.2 +031700 02 FILLER PIC X(4) VALUE NC2044.2 +031800 " IN ". NC2044.2 +031900 02 FILLER PIC X(12) VALUE NC2044.2 +032000 " HIGH ". NC2044.2 +032100 02 FILLER PIC X(22) VALUE NC2044.2 +032200 " LEVEL VALIDATION FOR ". NC2044.2 +032300 02 FILLER PIC X(58) VALUE NC2044.2 +032400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2044.2 +032500 01 CCVS-H-3. NC2044.2 +032600 02 FILLER PIC X(34) VALUE NC2044.2 +032700 " FOR OFFICIAL USE ONLY ". NC2044.2 +032800 02 FILLER PIC X(58) VALUE NC2044.2 +032900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2044.2 +033000 02 FILLER PIC X(28) VALUE NC2044.2 +033100 " COPYRIGHT 1985 ". NC2044.2 +033200 01 CCVS-E-1. NC2044.2 +033300 02 FILLER PIC X(52) VALUE SPACE. NC2044.2 +033400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2044.2 +033500 02 ID-AGAIN PIC X(9). NC2044.2 +033600 02 FILLER PIC X(45) VALUE SPACES. NC2044.2 +033700 01 CCVS-E-2. NC2044.2 +033800 02 FILLER PIC X(31) VALUE SPACE. NC2044.2 +033900 02 FILLER PIC X(21) VALUE SPACE. NC2044.2 +034000 02 CCVS-E-2-2. NC2044.2 +034100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2044.2 +034200 03 FILLER PIC X VALUE SPACE. NC2044.2 +034300 03 ENDER-DESC PIC X(44) VALUE NC2044.2 +034400 "ERRORS ENCOUNTERED". NC2044.2 +034500 01 CCVS-E-3. NC2044.2 +034600 02 FILLER PIC X(22) VALUE NC2044.2 +034700 " FOR OFFICIAL USE ONLY". NC2044.2 +034800 02 FILLER PIC X(12) VALUE SPACE. NC2044.2 +034900 02 FILLER PIC X(58) VALUE NC2044.2 +035000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2044.2 +035100 02 FILLER PIC X(13) VALUE SPACE. NC2044.2 +035200 02 FILLER PIC X(15) VALUE NC2044.2 +035300 " COPYRIGHT 1985". NC2044.2 +035400 01 CCVS-E-4. NC2044.2 +035500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2044.2 +035600 02 FILLER PIC X(4) VALUE " OF ". NC2044.2 +035700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2044.2 +035800 02 FILLER PIC X(40) VALUE NC2044.2 +035900 " TESTS WERE EXECUTED SUCCESSFULLY". NC2044.2 +036000 01 XXINFO. NC2044.2 +036100 02 FILLER PIC X(19) VALUE NC2044.2 +036200 "*** INFORMATION ***". NC2044.2 +036300 02 INFO-TEXT. NC2044.2 +036400 04 FILLER PIC X(8) VALUE SPACE. NC2044.2 +036500 04 XXCOMPUTED PIC X(20). NC2044.2 +036600 04 FILLER PIC X(5) VALUE SPACE. NC2044.2 +036700 04 XXCORRECT PIC X(20). NC2044.2 +036800 02 INF-ANSI-REFERENCE PIC X(48). NC2044.2 +036900 01 HYPHEN-LINE. NC2044.2 +037000 02 FILLER PIC IS X VALUE IS SPACE. NC2044.2 +037100 02 FILLER PIC IS X(65) VALUE IS "************************NC2044.2 +037200- "*****************************************". NC2044.2 +037300 02 FILLER PIC IS X(54) VALUE IS "************************NC2044.2 +037400- "******************************". NC2044.2 +037500 01 CCVS-PGM-ID PIC X(9) VALUE NC2044.2 +037600 "NC204M". NC2044.2 +037700 PROCEDURE DIVISION. NC2044.2 +037800 CCVS1 SECTION. NC2044.2 +037900 OPEN-FILES. NC2044.2 +038000 OPEN OUTPUT PRINT-FILE. NC2044.2 +038100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2044.2 +038200 MOVE SPACE TO TEST-RESULTS. NC2044.2 +038300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2044.2 +038400 GO TO CCVS1-EXIT. NC2044.2 +038500 CLOSE-FILES. NC2044.2 +038600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2044.2 +038700 TERMINATE-CCVS. NC2044.2 +038800*S EXIT PROGRAM. NC2044.2 +038900*SERMINATE-CALL. NC2044.2 +039000 STOP RUN. NC2044.2 +039100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2044.2 +039200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2044.2 +039300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2044.2 +039400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2044.2 +039500 MOVE "****TEST DELETED****" TO RE-MARK. NC2044.2 +039600 PRINT-DETAIL. NC2044.2 +039700 IF REC-CT NOT EQUAL TO ZERO NC2044.2 +039800 MOVE "." TO PARDOT-X NC2044.2 +039900 MOVE REC-CT TO DOTVALUE. NC2044.2 +040000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2044.2 +040100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2044.2 +040200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2044.2 +040300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2044.2 +040400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2044.2 +040500 MOVE SPACE TO CORRECT-X. NC2044.2 +040600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2044.2 +040700 MOVE SPACE TO RE-MARK. NC2044.2 +040800 HEAD-ROUTINE. NC2044.2 +040900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +041000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +041100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2044.2 +041200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2044.2 +041300 COLUMN-NAMES-ROUTINE. NC2044.2 +041400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +041500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +041600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +041700 END-ROUTINE. NC2044.2 +041800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2044.2 +041900 END-RTN-EXIT. NC2044.2 +042000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +042100 END-ROUTINE-1. NC2044.2 +042200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2044.2 +042300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2044.2 +042400 ADD PASS-COUNTER TO ERROR-HOLD. NC2044.2 +042500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2044.2 +042600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2044.2 +042700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2044.2 +042800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2044.2 +042900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2044.2 +043000 END-ROUTINE-12. NC2044.2 +043100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2044.2 +043200 IF ERROR-COUNTER IS EQUAL TO ZERO NC2044.2 +043300 MOVE "NO " TO ERROR-TOTAL NC2044.2 +043400 ELSE NC2044.2 +043500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2044.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2044.2 +043700 PERFORM WRITE-LINE. NC2044.2 +043800 END-ROUTINE-13. NC2044.2 +043900 IF DELETE-COUNTER IS EQUAL TO ZERO NC2044.2 +044000 MOVE "NO " TO ERROR-TOTAL ELSE NC2044.2 +044100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2044.2 +044200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2044.2 +044300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +044400 IF INSPECT-COUNTER EQUAL TO ZERO NC2044.2 +044500 MOVE "NO " TO ERROR-TOTAL NC2044.2 +044600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2044.2 +044700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2044.2 +044800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +044900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2044.2 +045000 WRITE-LINE. NC2044.2 +045100 ADD 1 TO RECORD-COUNT. NC2044.2 +045200 IF RECORD-COUNT GREATER 50 NC2044.2 +045300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2044.2 +045400 MOVE SPACE TO DUMMY-RECORD NC2044.2 +045500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2044.2 +045600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2044.2 +045700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2044.2 +045800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2044.2 +045900 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2044.2 +046000 MOVE ZERO TO RECORD-COUNT. NC2044.2 +046100 PERFORM WRT-LN. NC2044.2 +046200 WRT-LN. NC2044.2 +046300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2044.2 +046400 MOVE SPACE TO DUMMY-RECORD. NC2044.2 +046500 BLANK-LINE-PRINT. NC2044.2 +046600 PERFORM WRT-LN. NC2044.2 +046700 FAIL-ROUTINE. NC2044.2 +046800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2044.2 +046900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2044.2 +047000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2044.2 +047100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2044.2 +047200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +047300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2044.2 +047400 GO TO FAIL-ROUTINE-EX. NC2044.2 +047500 FAIL-ROUTINE-WRITE. NC2044.2 +047600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2044.2 +047700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2044.2 +047800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2044.2 +047900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2044.2 +048000 FAIL-ROUTINE-EX. EXIT. NC2044.2 +048100 BAIL-OUT. NC2044.2 +048200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2044.2 +048300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2044.2 +048400 BAIL-OUT-WRITE. NC2044.2 +048500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2044.2 +048600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2044.2 +048700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2044.2 +048800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2044.2 +048900 BAIL-OUT-EX. EXIT. NC2044.2 +049000 CCVS1-EXIT. NC2044.2 +049100 EXIT. NC2044.2 +049200 SECT-NC204M-001 SECTION. NC2044.2 +049300 DIS-INIT-GF. NC2044.2 +049400 MOVE "VI-78 6.10" TO ANSI-REFERENCE. NC2044.2 +049500 MOVE SPACE TO FEATURE. NC2044.2 +049600 PERFORM BLANK-LINE-PRINT. NC2044.2 +049700 MOVE "SEE NOTE IN DIS-INIT-GF." TO RE-MARK. NC2044.2 +049800 PERFORM PRINT-DETAIL. NC2044.2 +049900 PERFORM BLANK-LINE-PRINT. NC2044.2 +050000 MOVE "DISPLAY UPON" TO FEATURE. NC2044.2 +050100* NOTE FOR THE SAKE OF CONVENIENCE IN READING THE OUTPUT, NC2044.2 +050200* THE DISPLAY TESTS ARE CONSTRUCTED ON THE ASSUMPTION NC2044.2 +050300* THAT THE DISPLAYED OUTPUT WILL BE PRINTED ALONG NC2044.2 +050400* WITH THE OUTPUT FROM THE WRITE STATEMENTS. NOTE , NC2044.2 +050500* HOWEVER, IT IS NOT CONSIDERED NONSTANDARD IF THE NC2044.2 +050600* DISPLAYED OUTPUT APPEARS ELSEWHERE IN THE LISTING. NC2044.2 +050700* NC2044.2 +050800 DIS-INIT-GF-1. NC2044.2 +050900 MOVE "DIS-TEST-GF-1 " TO PAR-NAME. NC2044.2 +051000 MOVE "ALPHABETIC" TO DISPLAY-A. NC2044.2 +051100 DIS-TEST-GF-1. NC2044.2 +051200 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +051300 DISPLAY DISPLAY-A UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +051400 MOVE DISPLAY-A TO DIS-PLAYER. NC2044.2 +051500 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +051600 GO TO DIS-WRITE-GF-1. NC2044.2 +051700 DIS-DELETE-GF-1. NC2044.2 +051800 PERFORM DE-LETE. NC2044.2 +051900 DIS-WRITE-GF-1. NC2044.2 +052000 MOVE "DIS-TEST-GF-1 " TO PAR-NAME. NC2044.2 +052100 PERFORM PRINT-DETAIL. NC2044.2 +052200* NC2044.2 +052300 DIS-INIT-GF-2. NC2044.2 +052400 MOVE "DIS-TEST-GF-2 " TO PAR-NAME. NC2044.2 +052500 DIS-TEST-GF-2. NC2044.2 +052600 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +052700 DISPLAY "ALPHABETIC LITERAL" UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +052800 MOVE "ALPHABETIC LITERAL" TO DIS-PLAYER. NC2044.2 +052900 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +053000 GO TO DIS-WRITE-GF-2. NC2044.2 +053100 DIS-DELETE-GF-2. NC2044.2 +053200 PERFORM DE-LETE. NC2044.2 +053300 DIS-WRITE-GF-2. NC2044.2 +053400 MOVE "DIS-TEST-GF-2 " TO PAR-NAME. NC2044.2 +053500 PERFORM PRINT-DETAIL. NC2044.2 +053600* NC2044.2 +053700 DIS-INIT-GF-3. NC2044.2 +053800 MOVE "DIS-TEST-GF-3 " TO PAR-NAME. NC2044.2 +053900 MOVE 0123456789 TO DISPLAY-N. NC2044.2 +054000 DIS-TEST-GF-3. NC2044.2 +054100 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +054200 DISPLAY DISPLAY-N UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +054300 MOVE DISPLAY-N TO DIS-PLAYER. NC2044.2 +054400 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +054500 GO TO DIS-WRITE-GF-3. NC2044.2 +054600 DIS-DELETE-GF-3. NC2044.2 +054700 PERFORM DE-LETE. NC2044.2 +054800 DIS-WRITE-GF-3. NC2044.2 +054900 MOVE "DIS-TEST-GF-3 " TO PAR-NAME. NC2044.2 +055000 PERFORM PRINT-DETAIL. NC2044.2 +055100* NC2044.2 +055200 DIS-INIT-GF-4. NC2044.2 +055300 MOVE "DIS-TEST-GF-4 " TO PAR-NAME. NC2044.2 +055400 DIS-TEST-GF-4. NC2044.2 +055500 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +055600 DISPLAY 9876543210 UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +055700 MOVE "9876543210" TO DIS-PLAYER. NC2044.2 +055800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +055900 GO TO DIS-WRITE-GF-4. NC2044.2 +056000 DIS-DELETE-GF-4. NC2044.2 +056100 PERFORM DE-LETE. NC2044.2 +056200 DIS-WRITE-GF-4. NC2044.2 +056300 MOVE "DIS-TEST-GF-4 " TO PAR-NAME. NC2044.2 +056400 PERFORM PRINT-DETAIL. NC2044.2 +056500* NC2044.2 +056600 DIS-INIT-GF-5. NC2044.2 +056700 MOVE "DIS-TEST-GF-5 " TO PAR-NAME. NC2044.2 +056800 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC2044.2 +056900 DIS-TEST-GF-5. NC2044.2 +057000 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +057100 DISPLAY DISPLAY-X UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +057200 MOVE DISPLAY-X TO DIS-PLAYER. NC2044.2 +057300 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +057400 GO TO DIS-WRITE-GF-5. NC2044.2 +057500 DIS-DELETE-GF-5. NC2044.2 +057600 PERFORM DE-LETE. NC2044.2 +057700 DIS-WRITE-GF-5. NC2044.2 +057800 MOVE "DIS-TEST-GF-5 " TO PAR-NAME. NC2044.2 +057900 PERFORM PRINT-DETAIL. NC2044.2 +058000* NC2044.2 +058100 DIS-INIT-GF-6. NC2044.2 +058200 MOVE "DIS-TEST-GF-6 " TO PAR-NAME. NC2044.2 +058300 DIS-TEST-GF-6. NC2044.2 +058400 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +058500 DISPLAY "A1B2C3D4E5 ALPHANUMERIC LITERAL" UPON NC2044.2 +058600 DISPLAY-OUTPUT-DEVICE. NC2044.2 +058700 MOVE "A1B2C3D4E5 ALPHANUMERIC LITERAL" TO DIS-PLAYER. NC2044.2 +058800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +058900 GO TO DIS-WRITE-GF-6. NC2044.2 +059000 DIS-DELETE-GF-6. NC2044.2 +059100 PERFORM DE-LETE. NC2044.2 +059200 DIS-WRITE-GF-6. NC2044.2 +059300 MOVE "DIS-TEST-GF-6 " TO PAR-NAME. NC2044.2 +059400 PERFORM PRINT-DETAIL. NC2044.2 +059500* NC2044.2 +059600 DIS-INIT-GF-7. NC2044.2 +059700 MOVE "DIS-TEST-GF-7 " TO PAR-NAME. NC2044.2 +059800 MOVE "ALPHABETIC" TO DISPLAY-A. NC2044.2 +059900 MOVE 0123456789 TO DISPLAY-N. NC2044.2 +060000 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC2044.2 +060100 DIS-TEST-GF-7. NC2044.2 +060200 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +060300 DISPLAY DISPLAY-A DISPLAY-N DISPLAY-X " SERIES" UPON NC2044.2 +060400 DISPLAY-OUTPUT-DEVICE. NC2044.2 +060500 MOVE "ALPHABETIC0123456789A1B2C3D4E5 SERIES" NC2044.2 +060600 TO DIS-PLAYER. NC2044.2 +060700 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +060800 GO TO DIS-WRITE-GF-7. NC2044.2 +060900 DIS-DELETE-GF-7. NC2044.2 +061000 PERFORM DE-LETE. NC2044.2 +061100 DIS-WRITE-GF-7. NC2044.2 +061200 MOVE "DIS-TEST-GF-7 " TO PAR-NAME. NC2044.2 +061300 PERFORM PRINT-DETAIL. NC2044.2 +061400* NC2044.2 +061500 DIS-INIT-GF-8. NC2044.2 +061600 MOVE "DIS-TEST-GF-8 " TO PAR-NAME. NC2044.2 +061700 DIS-TEST-GF-8. NC2044.2 +061800 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +061900 DISPLAY ZERO SPACE QUOTE UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +062000* DISPLAY FIGURATIVE CONSTANT ONE ZERO EXPECTED. NC2044.2 +062100 MOVE ZERO-SPACE-QUOTE TO DIS-PLAYER. NC2044.2 +062200 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +062300 GO TO DIS-WRITE-GF-8. NC2044.2 +062400 DIS-DELETE-GF-8. NC2044.2 +062500 PERFORM DE-LETE. NC2044.2 +062600 DIS-WRITE-GF-8. NC2044.2 +062700 MOVE "DIS-TEST-GF-8 " TO PAR-NAME. NC2044.2 +062800 PERFORM PRINT-DETAIL. NC2044.2 +062900* NC2044.2 +063000 DIS-INIT-GF-9. NC2044.2 +063100 MOVE "DIS-TEST-GF-9 " TO PAR-NAME. NC2044.2 +063200 MOVE "REDEFINE-INFO" TO DISPLAY-B. NC2044.2 +063300 DIS-TEST-GF-9. NC2044.2 +063400 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +063500 DISPLAY DISPLAY-C UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +063600* DISPLAY REDEFINES FIELD. NC2044.2 +063700 MOVE "REDEFINE-INFO" TO DIS-PLAYER. NC2044.2 +063800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +063900 GO TO DIS-WRITE-GF-9. NC2044.2 +064000 DIS-DELETE-GF-9. NC2044.2 +064100 PERFORM DE-LETE. NC2044.2 +064200 DIS-WRITE-GF-9. NC2044.2 +064300 MOVE "DIS-TEST-GF-9 " TO PAR-NAME. NC2044.2 +064400 PERFORM PRINT-DETAIL. NC2044.2 +064500* NC2044.2 +064600 DIS-INIT-GF-10. NC2044.2 +064700 MOVE "DIS-TEST-GF-10" TO PAR-NAME. NC2044.2 +064800 MOVE "D001*002*003*004*005*006*007*008*009*010*011*012*013*01NC2044.2 +064900- "4*015*016*017*018*019*020*021*022*023*024*025" TO DISPLAY-G.NC2044.2 +065000 MOVE "*026*027*028*029*030*031*032*033*034*035*036*037*038*03NC2044.2 +065100- "9*040*041*042*043*044*045*046*047*048*049*050" TO DISPLAY-H.NC2044.2 +065200 DIS-TEST-GF-10. NC2044.2 +065300 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +065400 DISPLAY DISPLAY-F UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +065500 MOVE DISPLAY-G TO DIS-PLAYER. NC2044.2 +065600 MOVE 1 TO DISPLAY-SWITCH. NC2044.2 +065700 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +065800* NOTE THE "CORRECT" RESULT IS WRITTEN AS TWO NC2044.2 +065900* 100-CHARACTER LINES, BUT THE WAY THAT THE NC2044.2 +066000* "COMPUTED" RESULT IS SPLIT UP IS NOT NC2044.2 +066100* DEFINED BY THE STANDARD --- REGARDLESS OF NC2044.2 +066200* THIS, ALL 200 CHARACTERS MUST BE DISPLAYED. NC2044.2 +066300 GO TO DIS-WRITE-GF-10. NC2044.2 +066400 DIS-DELETE-GF-10. NC2044.2 +066500 PERFORM DE-LETE. NC2044.2 +066600 DIS-WRITE-GF-10. NC2044.2 +066700 MOVE "DIS-TEST-GF-10" TO PAR-NAME. NC2044.2 +066800 PERFORM PRINT-DETAIL. NC2044.2 +066900* NC2044.2 +067000 DIS-INIT-GF-11. NC2044.2 +067100 MOVE "DIS-TEST-GF-11" TO PAR-NAME. NC2044.2 +067200 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO GRP-ALPHABETIC. NC2044.2 +067300 MOVE 0123456789 TO DIGITS-DV-10V00. NC2044.2 +067400 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-<>=l,:.()/* 0123456789" NC2044.2 +067500 TO GRP-ALPHANUMERIC. NC2044.2 +067600 DIS-TEST-GF-11. NC2044.2 +067700 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +067800 DISPLAY GRP-ALPHABETIC UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +067900 DISPLAY GRP-NUMERIC UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +068000 DISPLAY GRP-ALPHANUMERIC UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +068100 MOVE GRP-ALPHABETIC TO DIS-PLAYER NC2044.2 +068200 MOVE 2 TO DISPLAY-SWITCH. NC2044.2 +068300 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +068400 GO TO DIS-WRITE-GF-11. NC2044.2 +068500 DIS-DELETE-GF-11. NC2044.2 +068600 PERFORM DE-LETE. NC2044.2 +068700 DIS-WRITE-GF-11. NC2044.2 +068800 MOVE "DIS-TEST-GF-11" TO PAR-NAME. NC2044.2 +068900 PERFORM PRINT-DETAIL. NC2044.2 +069000* NC2044.2 +069100 DIS-INIT-GF-12. NC2044.2 +069200 MOVE "DIS-TEST-GF-12" TO PAR-NAME. NC2044.2 +069300 DIS-TEST-GF-12. NC2044.2 +069400 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +069500 DISPLAY X21 X20 X19 X18 X17 X16 X15 X14 X13 X12 X11 X10 X9 NC2044.2 +069600 X8 X7 X6 X5 X4 X3 X2 X1 UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +069700 MOVE "UTSRQPONMLKJIHGFEDCBA" TO DIS-PLAYER. NC2044.2 +069800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +069900 GO TO DIS-WRITE-GF-12. NC2044.2 +070000 DIS-DELETE-GF-12. NC2044.2 +070100 PERFORM DE-LETE. NC2044.2 +070200 DIS-WRITE-GF-12. NC2044.2 +070300 MOVE "DIS-TEST-GF-12" TO PAR-NAME. NC2044.2 +070400 PERFORM PRINT-DETAIL. NC2044.2 +070500* NC2044.2 +070600 DIS-INIT-GF-13. NC2044.2 +070700 MOVE "DIS-TEST-GF-13" TO PAR-NAME. NC2044.2 +070800 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO QUAL-TAB-VALUE. NC2044.2 +070900 DIS-TEST-GF-13. NC2044.2 +071000 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +071100 DISPLAY XTAB (1), XTAB (2), XTAB (3), XTAB (4), NC2044.2 +071200 XTAB (5), XTAB (6), XTAB (7), XTAB (8), NC2044.2 +071300 XTAB (9), NC2044.2 +071400 ELEM-1 OF GRP-1, NC2044.2 +071500 ELEM-2 OF GRP-1, NC2044.2 +071600 ELEM-3 OF GRP-1, NC2044.2 +071700 SUB-TAB OF GRP-1 (1), NC2044.2 +071800 SUB-TAB OF GRP-1 (2), NC2044.2 +071900 SUB-TAB OF GRP-1 (3), NC2044.2 +072000 ELEM-1 IN GRP-2, NC2044.2 +072100 ELEM-2 IN GRP-2, NC2044.2 +072200 ELEM-3 IN GRP-2, NC2044.2 +072300 SUB-TAB OF GRP-2 (1), NC2044.2 +072400 SUB-TAB OF GRP-2 (2), NC2044.2 +072500 SUB-TAB OF GRP-2 (3) UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +072600* NOTE DISPLAY 21 VARIABLES, SUBSCRIPTED, QUALIFIED, BOTH. NC2044.2 +072700 MOVE QUAL-TAB-VALUE TO DIS-PLAYER. NC2044.2 +072800 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +072900 GO TO DIS-WRITE-GF-13. NC2044.2 +073000 DIS-DELETE-GF-13. NC2044.2 +073100 PERFORM DE-LETE. NC2044.2 +073200 DIS-WRITE-GF-13. NC2044.2 +073300 MOVE "DIS-TEST-GF-13" TO PAR-NAME. NC2044.2 +073400 PERFORM PRINT-DETAIL. NC2044.2 +073500* NC2044.2 +073600 DIS-INIT-GF-14. NC2044.2 +073700 MOVE "DIS-TEST-GF-14" TO PAR-NAME. NC2044.2 +073800 MOVE "SEE NOTE IN DIS-TEST-GF-14" TO RE-MARK. NC2044.2 +073900 DIS-TEST-GF-14. NC2044.2 +074000 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +074100 DISPLAY "QUOTE " NC2044.2 +074200 QUOTES NC2044.2 +074300 " ASTERISK " NC2044.2 +074400 "*" NC2044.2 +074500 " NUMERIC LITERALS " NC2044.2 +074600 21 NC2044.2 +074700 SPACES NC2044.2 +074800 1325 NC2044.2 +074900 I-DATA NC2044.2 +075000 PIECE (1, 1) NC2044.2 +075100 PIECE (1, 2) NC2044.2 +075200 PIECE (1, 3) NC2044.2 +075300 PIECE (1, 4) NC2044.2 +075400 PIECE (1, 5) NC2044.2 +075500 PIECE (2, 1) NC2044.2 +075600 PIECE (2, 2) NC2044.2 +075700 PIECE (2, 3) NC2044.2 +075800 PIECE (2, 4) NC2044.2 +075900 PIECE (2, 5) NC2044.2 +076000 A1 OF TRUE-PAIR NC2044.2 +076100 A2 IN TRUE-PAIR UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +076200* NOTE 21 OPERANDS, 111 CHARACTERS. NC2044.2 +076300 MOVE DISPLAY-MIXTURE TO DIS-PLAYER. NC2044.2 +076400 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +076500 GO TO DIS-WRITE-GF-14. NC2044.2 +076600 DIS-DELETE-GF-14. NC2044.2 +076700 PERFORM DE-LETE. NC2044.2 +076800 DIS-WRITE-GF-14. NC2044.2 +076900 MOVE "DIS-TEST-GF-14" TO PAR-NAME. NC2044.2 +077000 PERFORM PRINT-DETAIL. NC2044.2 +077100* NC2044.2 +077200 DISP-INIT-GF-15. NC2044.2 +077300* ==--> SINGLE IDENTIFIER WITH "WITH NO ADVANCING" PHRASE <--==NC2044.2 +077400 MOVE "VI-79 6.10.4 GR8" TO ANSI-REFERENCE. NC2044.2 +077500 MOVE "DIS-TEST-GF-15 " TO PAR-NAME. NC2044.2 +077600 MOVE "PLEASE PERFORM A VISUAL CHECK ON THE POSITIONING" NC2044.2 +077700 TO RE-MARK. NC2044.2 +077800 PERFORM PRINT-DETAIL. NC2044.2 +077900 MOVE "OF THE HARDWARE DEVICE AFTER THIS TEST." NC2044.2 +078000 TO RE-MARK. NC2044.2 +078100 PERFORM PRINT-DETAIL. NC2044.2 +078200 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +078300 DIS-TEST-GF-15. NC2044.2 +078400 DISPLAY 9876543210 UPON DISPLAY-OUTPUT-DEVICE NC2044.2 +078500 WITH NO ADVANCING. NC2044.2 +078600 MOVE "9876543210" TO DIS-PLAYER. NC2044.2 +078700 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +078800 GO TO DIS-WRITE-GF-15. NC2044.2 +078900 DIS-DELETE-GF-15. NC2044.2 +079000 PERFORM DE-LETE. NC2044.2 +079100 DIS-WRITE-GF-15. NC2044.2 +079200 PERFORM PRINT-DETAIL. NC2044.2 +079300* NC2044.2 +079400 DISP-INIT-GF-16. NC2044.2 +079500* ==--> MULTPL IDENTIFIERS WITH "WITH NO ADVANCING" PHRASE <--=NC2044.2 +079600 MOVE "VI-79 6.10.4 GR8" TO ANSI-REFERENCE. NC2044.2 +079700 MOVE "DIS-TEST-GF-16 " TO PAR-NAME. NC2044.2 +079800 MOVE "PLEASE PERFORM A VISUAL CHECK ON THE POSITIONING" NC2044.2 +079900 TO RE-MARK. NC2044.2 +080000 PERFORM PRINT-DETAIL. NC2044.2 +080100 MOVE "OF THE HARDWARE DEVICE AFTER THIS TEST." NC2044.2 +080200 TO RE-MARK. NC2044.2 +080300 PERFORM PRINT-DETAIL. NC2044.2 +080400 PERFORM DISPLAY-SUPPORT-1. NC2044.2 +080500 MOVE "ALPHABETIC" TO DISPLAY-A. NC2044.2 +080600 MOVE 0123456789 TO DISPLAY-N. NC2044.2 +080700 MOVE "A1B2C3D4E5" TO DISPLAY-X. NC2044.2 +080800 DIS-TEST-GF-16. NC2044.2 +080900 DISPLAY DISPLAY-A DISPLAY-N DISPLAY-X " SERIES" NC2044.2 +081000 UPON DISPLAY-OUTPUT-DEVICE WITH NO ADVANCING. NC2044.2 +081100 MOVE "ALPHABETIC0123456789A1B2C3D4E5 SERIES" NC2044.2 +081200 TO DIS-PLAYER. NC2044.2 +081300 PERFORM DISPLAY-SUPPORT-2. NC2044.2 +081400 GO TO DIS-WRITE-GF-16. NC2044.2 +081500 DIS-DELETE-GF-16. NC2044.2 +081600 PERFORM DE-LETE. NC2044.2 +081700 DIS-WRITE-GF-16. NC2044.2 +081800 MOVE "DIS-TEST-GF-16 " TO PAR-NAME. NC2044.2 +081900 PERFORM PRINT-DETAIL. NC2044.2 +082000* NC2044.2 +082100 AC-CEPT SECTION. NC2044.2 +082200 ACC-INIT-F1. NC2044.2 +082300 MOVE "ACCEPT " TO FEATURE. NC2044.2 +082400 MOVE "VI-71 6.5.2" TO ANSI-REFERENCE. NC2044.2 +082500 ACC-INIT-F1-1. NC2044.2 +082600 MOVE "ACC-TEST-F1-1 " TO PAR-NAME. NC2044.2 +082700 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXY Z" TO ACCEPT-D2. NC2044.2 +082800 ACC-TEST-F1-1. NC2044.2 +082900 ACCEPT ACCEPT-D1 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +083000 IF ACCEPT-D1 EQUAL TO ACCEPT-D2 NC2044.2 +083100 PERFORM PASS GO TO ACC-WRITE-F1-1. NC2044.2 +083200 GO TO ACC-FAIL-F1-1. NC2044.2 +083300 ACC-DELETE-F1-1. NC2044.2 +083400 PERFORM DE-LETE. NC2044.2 +083500 GO TO ACC-WRITE-F1-1. NC2044.2 +083600 ACC-FAIL-F1-1. NC2044.2 +083700 MOVE ACCEPT-D1-A TO COMPUTED-A. NC2044.2 +083800 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-A. NC2044.2 +083900 PERFORM PRINT-DETAIL. NC2044.2 +084000 MOVE ACCEPT-D1-B TO COMPUTED-A. NC2044.2 +084100 MOVE "UVWXY Z" TO CORRECT-A. NC2044.2 +084200 PERFORM FAIL. NC2044.2 +084300 MOVE "LAST 7 OF 27-CHAR FIELD" TO RE-MARK. NC2044.2 +084400 ACC-WRITE-F1-1. NC2044.2 +084500 PERFORM PRINT-DETAIL. NC2044.2 +084600* NC2044.2 +084700 ACC-INIT-F1-2. NC2044.2 +084800 MOVE "ACC-TEST-F1-2 " TO PAR-NAME. NC2044.2 +084900 MOVE 0123456789 TO ACCEPT-D4. NC2044.2 +085000 ACC-TEST-F1-2. NC2044.2 +085100 ACCEPT ACCEPT-D3 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +085200 IF ACCEPT-D3 EQUAL TO ACCEPT-D4 NC2044.2 +085300 PERFORM PASS GO TO ACC-WRITE-F1-2. NC2044.2 +085400 GO TO ACC-FAIL-F1-2. NC2044.2 +085500 ACC-DELETE-F1-2. NC2044.2 +085600 PERFORM DE-LETE. NC2044.2 +085700 GO TO ACC-WRITE-F1-2. NC2044.2 +085800 ACC-FAIL-F1-2. NC2044.2 +085900 MOVE ACCEPT-D3 TO COMPUTED-18V0. NC2044.2 +086000 MOVE ACCEPT-D4 TO CORRECT-18V0. NC2044.2 +086100 PERFORM FAIL. NC2044.2 +086200 ACC-WRITE-F1-2. NC2044.2 +086300 PERFORM PRINT-DETAIL. NC2044.2 +086400* NC2044.2 +086500 ACC-INIT-F1-3. NC2044.2 +086600 MOVE "ACC-TEST-F1-3 " TO PAR-NAME. NC2044.2 +086700 MOVE "().+-*/$, =" TO ACCEPT-D6. NC2044.2 +086800 ACC-TEST-F1-3. NC2044.2 +086900 ACCEPT ACCEPT-D5 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +087000 IF ACCEPT-D5 EQUAL TO ACCEPT-D6 NC2044.2 +087100 PERFORM PASS GO TO ACC-WRITE-F1-3. NC2044.2 +087200* NOTE ACCEPT SPECIAL CHARACTERS. NC2044.2 +087300 GO TO ACC-FAIL-F1-3. NC2044.2 +087400 ACC-DELETE-F1-3. NC2044.2 +087500 PERFORM DE-LETE. NC2044.2 +087600 GO TO ACC-WRITE-F1-3. NC2044.2 +087700 ACC-FAIL-F1-3. NC2044.2 +087800 MOVE ACCEPT-D5 TO COMPUTED-A. NC2044.2 +087900 MOVE ACCEPT-D6 TO CORRECT-A. NC2044.2 +088000 PERFORM FAIL. NC2044.2 +088100 ACC-WRITE-F1-3. NC2044.2 +088200 PERFORM PRINT-DETAIL. NC2044.2 +088300* NC2044.2 +088400 ACC-INIT-F1-4. NC2044.2 +088500 MOVE "ACC-TEST-F1-4 " TO PAR-NAME. NC2044.2 +088600 MOVE "9" TO ACCEPT-D8. NC2044.2 +088700 ACC-TEST-F1-4. NC2044.2 +088800 ACCEPT ACCEPT-D7 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +088900 IF ACCEPT-D7 EQUAL TO ACCEPT-D8 NC2044.2 +089000 PERFORM PASS GO TO ACC-WRITE-F1-4. NC2044.2 +089100 GO TO ACC-FAIL-F1-4. NC2044.2 +089200 ACC-DELETE-F1-4. NC2044.2 +089300 PERFORM DE-LETE. NC2044.2 +089400 GO TO ACC-WRITE-F1-4. NC2044.2 +089500 ACC-FAIL-F1-4. NC2044.2 +089600 MOVE ACCEPT-D7 TO COMPUTED-A. NC2044.2 +089700 MOVE ACCEPT-D8 TO CORRECT-A. NC2044.2 +089800 MOVE "9 EXPECTED" TO RE-MARK. NC2044.2 +089900 PERFORM FAIL. NC2044.2 +090000 ACC-WRITE-F1-4. NC2044.2 +090100 PERFORM PRINT-DETAIL. NC2044.2 +090200* NC2044.2 +090300 ACC-INIT-F1-5. NC2044.2 +090400 MOVE "ACC-TEST-F1-5 " TO PAR-NAME. NC2044.2 +090500 MOVE "0" TO ACCEPT-D10. NC2044.2 +090600 ACC-TEST-F1-5. NC2044.2 +090700 ACCEPT ACCEPT-D9 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +090800 IF ACCEPT-D9 EQUAL TO ACCEPT-D10 NC2044.2 +090900 PERFORM PASS GO TO ACC-WRITE-F1-5. NC2044.2 +091000 GO TO ACC-FAIL-F1-5. NC2044.2 +091100 ACC-DELETE-F1-5. NC2044.2 +091200 PERFORM DE-LETE. NC2044.2 +091300 GO TO ACC-WRITE-F1-5. NC2044.2 +091400 ACC-FAIL-F1-5. NC2044.2 +091500 MOVE ACCEPT-D9 TO COMPUTED-A. NC2044.2 +091600 MOVE ACCEPT-D10 TO CORRECT-A. NC2044.2 +091700 MOVE "0 EXPECTED" TO RE-MARK. NC2044.2 +091800 PERFORM FAIL. NC2044.2 +091900 ACC-WRITE-F1-5. NC2044.2 +092000 PERFORM PRINT-DETAIL. NC2044.2 +092100* NC2044.2 +092200 ACC-INIT-F1-6. NC2044.2 +092300 MOVE "ACC-TEST-F1-6 " TO PAR-NAME. NC2044.2 +092400 MOVE " ABC XYZ " TO ACCEPT-D12. NC2044.2 +092500 ACC-TEST-F1-6. NC2044.2 +092600 ACCEPT ACCEPT-D11 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +092700 IF ACCEPT-D11 EQUAL TO ACCEPT-D12 NC2044.2 +092800 PERFORM PASS GO TO ACC-WRITE-F1-6. NC2044.2 +092900 GO TO ACC-FAIL-F1-6. NC2044.2 +093000 ACC-DELETE-F1-6. NC2044.2 +093100 PERFORM DE-LETE. NC2044.2 +093200 GO TO ACC-WRITE-F1-6. NC2044.2 +093300 ACC-FAIL-F1-6. NC2044.2 +093400 MOVE ACCEPT-D11 TO COMPUTED-A. NC2044.2 +093500 MOVE ACCEPT-D12 TO CORRECT-A. NC2044.2 +093600 PERFORM FAIL. NC2044.2 +093700 ACC-WRITE-F1-6. NC2044.2 +093800 PERFORM PRINT-DETAIL. NC2044.2 +093900* NC2044.2 +094000 ACC-INIT-F1-7. NC2044.2 +094100 MOVE "ACC-TEST-F1-7 " TO PAR-NAME. NC2044.2 +094200 MOVE " 9" TO ACCEPT-D16. NC2044.2 +094300 ACC-TEST-F1-7. NC2044.2 +094400 ACCEPT ACCEPT-D15 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +094500 IF ACCEPT-D15 EQUAL TO ACCEPT-D16 NC2044.2 +094600 PERFORM PASS GO TO ACC-WRITE-F1-7. NC2044.2 +094700 GO TO ACC-FAIL-F1-7. NC2044.2 +094800 ACC-DELETE-F1-7. NC2044.2 +094900 PERFORM DE-LETE. NC2044.2 +095000 GO TO ACC-WRITE-F1-7. NC2044.2 +095100 ACC-FAIL-F1-7. NC2044.2 +095200 PERFORM FAIL. NC2044.2 +095300 MOVE ACCEPT-D15 TO COMPUTED-A. NC2044.2 +095400 MOVE " 9 (SPACE 9)" TO CORRECT-A. NC2044.2 +095500 ACC-WRITE-F1-7. NC2044.2 +095600 PERFORM PRINT-DETAIL. NC2044.2 +095700* NC2044.2 +095800 ACC-INIT-F1-8. NC2044.2 +095900 MOVE "ACC-TEST-F1-8 " TO PAR-NAME. NC2044.2 +096000 MOVE QUOTE TO ACCEPT-D18. NC2044.2 +096100 ACC-TEST-F1-8. NC2044.2 +096200 ACCEPT ACCEPT-D17 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +096300 IF ACCEPT-D17 EQUAL TO ACCEPT-D18 NC2044.2 +096400 PERFORM PASS GO TO ACC-WRITE-F1-8. NC2044.2 +096500 GO TO ACC-FAIL-F1-8. NC2044.2 +096600 ACC-DELETE-F1-8. NC2044.2 +096700 PERFORM DE-LETE. NC2044.2 +096800 GO TO ACC-WRITE-F1-8. NC2044.2 +096900 ACC-FAIL-F1-8. NC2044.2 +097000 PERFORM FAIL. NC2044.2 +097100 MOVE ACCEPT-D17 TO COMPUTED-A. NC2044.2 +097200 MOVE ACCEPT-D18 TO CORRECT-A. NC2044.2 +097300 ACC-WRITE-F1-8. NC2044.2 +097400 PERFORM PRINT-DETAIL. NC2044.2 +097500* NC2044.2 +097600 ACC-INIT-F1-9. NC2044.2 +097700 MOVE "ACC-TEST-F1-9 " TO PAR-NAME. NC2044.2 +097800 MOVE "Q" TO ACCEPT-D20. NC2044.2 +097900 ACC-TEST-F1-9. NC2044.2 +098000 ACCEPT QUAL-ACCEPT OF ACCEPT-D19 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +098100 IF ACCEPT-D19 EQUAL TO ACCEPT-D20 NC2044.2 +098200 PERFORM PASS GO TO ACC-WRITE-F1-9. NC2044.2 +098300 GO TO ACC-FAIL-F1-9. NC2044.2 +098400 ACC-DELETE-F1-9. NC2044.2 +098500 PERFORM DE-LETE. NC2044.2 +098600 GO TO ACC-WRITE-F1-9. NC2044.2 +098700 ACC-FAIL-F1-9. NC2044.2 +098800 PERFORM FAIL. NC2044.2 +098900 MOVE ACCEPT-D19 TO COMPUTED-A. NC2044.2 +099000 MOVE ACCEPT-D20 TO CORRECT-A. NC2044.2 +099100 ACC-WRITE-F1-9. NC2044.2 +099200 PERFORM PRINT-DETAIL. NC2044.2 +099300* NC2044.2 +099400 ACC-INIT-F1-10. NC2044.2 +099500 MOVE "ACC-TEST-F1-10" TO PAR-NAME. NC2044.2 +099600 MOVE "....ABCD...." TO ACCEPT-D22. NC2044.2 +099700 ACC-TEST-F1-10. NC2044.2 +099800 ACCEPT TAB-ACCEPT (2) FROM ACCEPT-INPUT-DEVICE. NC2044.2 +099900 IF ACCEPT-D21 EQUAL TO ACCEPT-D22 NC2044.2 +100000 PERFORM PASS GO TO ACC-WRITE-F1-10. NC2044.2 +100100 GO TO ACC-FAIL-F1-10. NC2044.2 +100200 ACC-DELETE-F1-10. NC2044.2 +100300 PERFORM DE-LETE. NC2044.2 +100400 GO TO ACC-WRITE-F1-10. NC2044.2 +100500 ACC-FAIL-F1-10. NC2044.2 +100600 PERFORM FAIL. NC2044.2 +100700 MOVE ACCEPT-D21 TO COMPUTED-A. NC2044.2 +100800 MOVE ACCEPT-D22 TO CORRECT-A. NC2044.2 +100900 ACC-WRITE-F1-10. NC2044.2 +101000 PERFORM PRINT-DETAIL. NC2044.2 +101100* NC2044.2 +101200 ACC-INIT-F1-11. NC2044.2 +101300 MOVE "ACC-TEST-F1-11" TO PAR-NAME. NC2044.2 +101400 MOVE "--------------------" TO ACCEPT-D23. NC2044.2 +101500 MOVE "----------------ABCD" TO ACCEPT-D24. NC2044.2 +101600 ACC-TEST-F1-11. NC2044.2 +101700 ACCEPT TAB-A IN ACCEPT-D23 (SUB) FROM ACCEPT-INPUT-DEVICE. NC2044.2 +101800 IF ACCEPT-D23 EQUAL TO ACCEPT-D24 NC2044.2 +101900 PERFORM PASS GO TO ACC-WRITE-F1-11. NC2044.2 +102000 GO TO ACC-FAIL-F1-11. NC2044.2 +102100 ACC-DELETE-F1-11. NC2044.2 +102200 PERFORM DE-LETE. NC2044.2 +102300 GO TO ACC-WRITE-F1-11. NC2044.2 +102400 ACC-FAIL-F1-11. NC2044.2 +102500 PERFORM FAIL. NC2044.2 +102600 MOVE ACCEPT-D23 TO COMPUTED-A. NC2044.2 +102700 MOVE ACCEPT-D24 TO CORRECT-A. NC2044.2 +102800 ACC-WRITE-F1-11. NC2044.2 +102900 PERFORM PRINT-DETAIL. NC2044.2 +103000* NC2044.2 +103100 ACC-INIT-F1-12. NC2044.2 +103200 MOVE "ACC-TEST-F1-12" TO PAR-NAME. NC2044.2 +103300 MOVE NC2044.2 +103400 "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456NC2044.2 +103500- "789 " TO ACCEPT-RESULTS. NC2044.2 +103600 ACC-TEST-F1-12. NC2044.2 +103700 ACCEPT 80X-CHARACTER-FIELD FROM ACCEPT-INPUT-DEVICE. NC2044.2 +103800 IF 80X-CHARACTER-FIELD EQUAL TO ACCEPT-RESULTS NC2044.2 +103900 PERFORM PASS GO TO ACC-WRITE-F1-12. NC2044.2 +104000 GO TO ACC-FAIL-F1-12. NC2044.2 +104100 ACC-DELETE-F1-12. NC2044.2 +104200 PERFORM DE-LETE. NC2044.2 +104300 GO TO ACC-WRITE-F1-12. NC2044.2 +104400 ACC-FAIL-F1-12. NC2044.2 +104500 MOVE 80X-CHARACTER-FIELD TO CHARACTER-BREAKDOWN-R. NC2044.2 +104600 MOVE ACCEPT-RESULTS TO CHARACTER-BREAKDOWN-S. NC2044.2 +104700 MOVE FIRST-20R TO COMPUTED-A. NC2044.2 +104800 MOVE FIRST-20S TO CORRECT-A. NC2044.2 +104900 PERFORM PRINT-DETAIL. NC2044.2 +105000 MOVE SECOND-20R TO COMPUTED-A. NC2044.2 +105100 MOVE SECOND-20S TO CORRECT-A. NC2044.2 +105200 PERFORM PRINT-DETAIL. NC2044.2 +105300 MOVE THIRD-20R TO COMPUTED-A. NC2044.2 +105400 MOVE THIRD-20S TO CORRECT-A. NC2044.2 +105500 PERFORM PRINT-DETAIL. NC2044.2 +105600 MOVE FOURTH-20R TO COMPUTED-A. NC2044.2 +105700 MOVE FOURTH-20S TO CORRECT-A. NC2044.2 +105800 PERFORM FAIL. NC2044.2 +105900 MOVE "LAST 20 OF 80 CHAR FIELD" TO RE-MARK. NC2044.2 +106000 ACC-WRITE-F1-12. NC2044.2 +106100 MOVE "ACC-TEST-F1-12" TO PAR-NAME. NC2044.2 +106200 PERFORM PRINT-DETAIL. NC2044.2 +106300* NC2044.2 +106400 ACC-INIT-F1-13. NC2044.2 +106500 MOVE "ACC-TEST-F1-13" TO PAR-NAME. NC2044.2 +106600 MOVE "D001*002*003*004*005*006*007*008*009*010*011*012*013*01NC2044.2 +106700- "4*015*016*017*018*019*020D021*022*023*024*025" TO DISPLAY-G.NC2044.2 +106800 MOVE "*026*027*028*029*030*031*032*033*034*035*036*037*038*03NC2044.2 +106900- "9*040D041*042*043*044*045*046*047*048*049*050" TO DISPLAY-H.NC2044.2 +107000 ACC-TEST-F1-13. NC2044.2 +107100 ACCEPT ACCEPT-D13 FROM ACCEPT-INPUT-DEVICE. NC2044.2 +107200 IF ACCEPT-D13 EQUAL TO DISPLAY-F NC2044.2 +107300 PERFORM PASS GO TO ACC-WRITE-F1-13. NC2044.2 +107400 GO TO ACC-FAIL-F1-13. NC2044.2 +107500 ACC-DELETE-F1-13. NC2044.2 +107600 PERFORM DE-LETE. NC2044.2 +107700 GO TO ACC-WRITE-F1-13. NC2044.2 +107800 ACC-FAIL-F1-13. NC2044.2 +107900 MOVE ACCEPT-D13 TO CHARACTER-BREAKDOWN-R. NC2044.2 +108000 MOVE DISPLAY-F TO CHARACTER-BREAKDOWN-S. NC2044.2 +108100 MOVE FIRST-20R TO COMPUTED-A. NC2044.2 +108200 MOVE FIRST-20S TO CORRECT-A. NC2044.2 +108300 PERFORM PRINT-DETAIL. NC2044.2 +108400 MOVE SECOND-20R TO COMPUTED-A. NC2044.2 +108500 MOVE SECOND-20S TO CORRECT-A. NC2044.2 +108600 PERFORM PRINT-DETAIL. NC2044.2 +108700 MOVE THIRD-20R TO COMPUTED-A. NC2044.2 +108800 MOVE THIRD-20S TO CORRECT-A. NC2044.2 +108900 PERFORM PRINT-DETAIL. NC2044.2 +109000 MOVE FOURTH-20R TO COMPUTED-A. NC2044.2 +109100 MOVE FOURTH-20S TO CORRECT-A. NC2044.2 +109200 PERFORM PRINT-DETAIL. NC2044.2 +109300 MOVE FIFTH-20R TO COMPUTED-A. NC2044.2 +109400 MOVE FIFTH-20S TO CORRECT-A. NC2044.2 +109500 PERFORM PRINT-DETAIL. NC2044.2 +109600 MOVE SIXTH-20R TO COMPUTED-A. NC2044.2 +109700 MOVE SIXTH-20S TO CORRECT-A. NC2044.2 +109800 PERFORM PRINT-DETAIL. NC2044.2 +109900 MOVE SEVENTH-20R TO COMPUTED-A. NC2044.2 +110000 MOVE SEVENTH-20S TO CORRECT-A. NC2044.2 +110100 PERFORM PRINT-DETAIL. NC2044.2 +110200 MOVE EIGHTH-20R TO COMPUTED-A. NC2044.2 +110300 MOVE EIGHTH-20S TO CORRECT-A. NC2044.2 +110400 PERFORM PRINT-DETAIL. NC2044.2 +110500 MOVE NINTH-20R TO COMPUTED-A. NC2044.2 +110600 MOVE NINTH-20S TO CORRECT-A. NC2044.2 +110700 PERFORM PRINT-DETAIL. NC2044.2 +110800 MOVE TENTH-20R TO COMPUTED-A. NC2044.2 +110900 MOVE TENTH-20S TO CORRECT-A. NC2044.2 +111000 PERFORM FAIL. NC2044.2 +111100 MOVE "LAST 20 OF 200CHAR FIELD" TO RE-MARK. NC2044.2 +111200 ACC-WRITE-F1-13. NC2044.2 +111300 MOVE "ACC-TEST-F1-13" TO PAR-NAME. NC2044.2 +111400 PERFORM PRINT-DETAIL. NC2044.2 +111500* NC2044.2 +111600 ACC-INIT-F1-14. NC2044.2 +111700 MOVE "VI-71 6.5.4 GR4(A)" TO ANSI-REFERENCE. NC2044.2 +111800 MOVE SPACES TO ACCEPT-TEST-14-DATA. NC2044.2 +111900 MOVE "ACC-TEST-F1-14-1" TO PAR-NAME. NC2044.2 +112000 MOVE "PLEASE PERFORM A VISUAL CHECK TO ENSURE THAT" NC2044.2 +112100 TO RE-MARK. NC2044.2 +112200 PERFORM PRINT-DETAIL. NC2044.2 +112300 MOVE "A REQUEST FOR FURTHER INPUT IS MADE BY THE" NC2044.2 +112400 TO RE-MARK. NC2044.2 +112500 PERFORM PRINT-DETAIL. NC2044.2 +112600 MOVE "HARDWARE DEVICE" TO RE-MARK NC2044.2 +112700 PERFORM PRINT-DETAIL. NC2044.2 +112800 ACC-INIT-F1-14-1. NC2044.2 +112900 MOVE "ACC-TEST-F1-14-1" TO PAR-NAME. NC2044.2 +113000 ACC-TEST-F1-14-1. NC2044.2 +113100 ACCEPT ACCEPT-TEST-14-DATA FROM ACCEPT-INPUT-DEVICE. NC2044.2 +113200 IF ACC-14-CHARS-1-10 = "ABCDEFGHIJ" NC2044.2 +113300 PERFORM PASS NC2044.2 +113400 GO TO ACC-WRITE-F1-14-1. NC2044.2 +113500 GO TO ACC-FAIL-F1-14-1. NC2044.2 +113600 ACC-DELETE-F1-14-1. NC2044.2 +113700 PERFORM DE-LETE. NC2044.2 +113800 GO TO ACC-WRITE-F1-14-1. NC2044.2 +113900 ACC-FAIL-F1-14-1. NC2044.2 +114000 MOVE "ABCDEFGHIJ" TO CORRECT-A NC2044.2 +114100 MOVE ACC-14-CHARS-1-10 TO COMPUTED-A NC2044.2 +114200 PERFORM FAIL. NC2044.2 +114300 ACC-WRITE-F1-14-1. NC2044.2 +114400 PERFORM PRINT-DETAIL. NC2044.2 +114500* NC2044.2 +114600 ACC-INIT-F1-14-2. NC2044.2 +114700 MOVE "ACC-TEST-F1-14-2" TO PAR-NAME. NC2044.2 +114800 ACC-TEST-F1-14-2. NC2044.2 +114900 ACCEPT ACCEPT-TEST-14-DATA FROM ACCEPT-INPUT-DEVICE. NC2044.2 +115000 IF ACC-14-CHARS-11-15 = "KLMNO" NC2044.2 +115100 PERFORM PASS NC2044.2 +115200 GO TO ACC-WRITE-F1-14-2. NC2044.2 +115300 GO TO ACC-FAIL-F1-14-2. NC2044.2 +115400 ACC-DELETE-F1-14-2. NC2044.2 +115500 PERFORM DE-LETE. NC2044.2 +115600 GO TO ACC-WRITE-F1-14-2. NC2044.2 +115700 ACC-FAIL-F1-14-2. NC2044.2 +115800 MOVE "KLMNO" TO CORRECT-A NC2044.2 +115900 MOVE ACC-14-CHARS-11-15 TO COMPUTED-A NC2044.2 +116000 PERFORM FAIL. NC2044.2 +116100 ACC-WRITE-F1-14-2. NC2044.2 +116200 PERFORM PRINT-DETAIL. NC2044.2 +116300 ACCEPT-EXIT. NC2044.2 +116400 GO TO CCVS-EXIT. NC2044.2 +116500 DISPLAY-SUPPORT-1. NC2044.2 +116600 PERFORM BLANK-LINE-PRINT. NC2044.2 +116700 MOVE SPACE TO P-OR-F. NC2044.2 +116800 MOVE SEE-BELOW TO COMPUTED-A. NC2044.2 +116900 MOVE SEE-BELOW TO CORRECT-A. NC2044.2 +117000 PERFORM PRINT-DETAIL. NC2044.2 +117100 MOVE SPACE TO FEATURE. NC2044.2 +117200 DISPLAY TEST-RESULTS UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +117300 DISPLAY-SUPPORT-2. NC2044.2 +117400 MOVE SPACE TO TEST-RESULTS. NC2044.2 +117500 DISPLAY TEST-RESULTS UPON DISPLAY-OUTPUT-DEVICE. NC2044.2 +117600 MOVE SPACE TO TEST-RESULTS. NC2044.2 +117700 PERFORM PRINT-DETAIL. NC2044.2 +117800 MOVE CORRECT-FOLLOWS TO RE-MARK. NC2044.2 +117900 PERFORM PRINT-DETAIL. NC2044.2 +118000 PERFORM BLANK-LINE-PRINT. NC2044.2 +118100 MOVE DISPLAY-WRITER TO TEST-RESULTS. NC2044.2 +118200 PERFORM PRINT-DETAIL. NC2044.2 +118300 IF DISPLAY-SWITCH EQUAL TO 1 NC2044.2 +118400 MOVE ZERO TO DISPLAY-SWITCH NC2044.2 +118500 MOVE DISPLAY-H TO DIS-PLAYER NC2044.2 +118600 MOVE DISPLAY-WRITER TO TEST-RESULTS NC2044.2 +118700 PERFORM PRINT-DETAIL. NC2044.2 +118800 IF DISPLAY-SWITCH EQUAL TO 2 NC2044.2 +118900 MOVE ZERO TO DISPLAY-SWITCH NC2044.2 +119000 MOVE GRP-NUMERIC TO DIS-PLAYER NC2044.2 +119100 MOVE DISPLAY-WRITER TO TEST-RESULTS NC2044.2 +119200 PERFORM PRINT-DETAIL NC2044.2 +119300 MOVE GRP-ALPHANUMERIC TO DIS-PLAYER NC2044.2 +119400 MOVE DISPLAY-WRITER TO TEST-RESULTS NC2044.2 +119500 PERFORM PRINT-DETAIL. NC2044.2 +119600 MOVE SPACE TO TEST-RESULTS. NC2044.2 +119700 PERFORM BLANK-LINE-PRINT. NC2044.2 +119800 IF DISPLAY-SWITCH EQUAL TO 1 NC2044.2 +119900 MOVE "SEE NOTE IN DIS-TEST-GF-10" TO RE-MARK NC2044.2 +120000 PERFORM PRINT-DETAIL. NC2044.2 +120100 MOVE "DISPLAY UPON" TO FEATURE. NC2044.2 +120200 MOVE SEE-ABOVE TO COMPUTED-A. NC2044.2 +120300 MOVE SEE-ABOVE TO CORRECT-A. NC2044.2 +120400 MOVE END-CORRECT TO RE-MARK. NC2044.2 +120500 CCVS-EXIT SECTION. NC2044.2 +120600 CCVS-999999. NC2044.2 +120700 GO TO CLOSE-FILES. NC2044.2 diff --git a/tests/cobol85/NC/NC204M.DAT b/tests/cobol85/NC/NC204M.DAT new file mode 100755 index 00000000..4adf9319 --- /dev/null +++ b/tests/cobol85/NC/NC204M.DAT @@ -0,0 +1,15 @@ +ABCDEFGHIJKLMNOPQRSTUVWXY Z +0123456789 +().+-*/$, = +9 +0 + ABC XYZ + 9 +" +Q +ABCD +ABCD +A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456789 +D001*002*003*004*005*006*007*008*009*010*011*012*013*014*015*016*017*018*019*020D021*022*023*024*025*026*027*028*029*030*031*032*033*034*035*036*037*038*039*040D041*042*043*044*045*046*047*048*049*050 +ABCDEFGHIJ +KLMNOPQRST diff --git a/tests/cobol85/NC/NC205A.CBL b/tests/cobol85/NC/NC205A.CBL new file mode 100755 index 00000000..fc4186b3 --- /dev/null +++ b/tests/cobol85/NC/NC205A.CBL @@ -0,0 +1,804 @@ +000100 IDENTIFICATION DIVISION. NC2054.2 +000200 PROGRAM-ID. NC2054.2 +000300 NC205A. NC2054.2 +000400* * NC2054.2 +000500**************************************************************** NC2054.2 +000600* * NC2054.2 +000700* VALIDATION FOR:- * NC2054.2 +000800* * NC2054.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2054.2 +001000* * NC2054.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2054.2 +001200* * NC2054.2 +001300**************************************************************** NC2054.2 +001400* * NC2054.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2054.2 +001600* * NC2054.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2054.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2054.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2054.2 +002000* * NC2054.2 +002100**************************************************************** NC2054.2 +002200* * NC2054.2 +002300* PROGRAM NC205A TESTS THE CONTINUATION OF COBOL WORDS, * NC2054.2 +002400* NUMERIC AND NON-NUMERIC LITERALS AND PICTURE STRINGS USING* NC2054.2 +002500* A HYPHEN IN THE INDICATOR AREA OF CONTINUATION LINES. * NC2054.2 +002600* * NC2054.2 +002700**************************************************************** NC2054.2 +002800 ENVIRONMENT DIVISION. NC2054.2 +002900 CONFIGURATION SECTION. NC2054.2 +003000 SOURCE-COMPUTER. NC2054.2 +003100 Linux. NC2054.2 +003200 OBJECT-COMPUTER. NC2054.2 +003300 Linux. NC2054.2 +003400 INPUT-OUTPUT SECTION. NC2054.2 +003500 FILE-CONTROL. NC2054.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2054.2 +003700 "report.log". NC2054.2 +003800 DATA DIVISION. NC2054.2 +003900 FILE SECTION. NC2054.2 +004000 FD PRINT-FILE. NC2054.2 +004100 01 PRINT-REC PICTURE X(120). NC2054.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2054.2 +004300 WORKING-STORAGE SECTION. NC2054.2 +004400 77 WS-TEST-12-DATA NC2054.2 +004500 PIC S9( NC2054.2 +004600- 6)V9(6). NC2054.2 +004700 77 PROCEDURE NC2054.2 +004800- DIVISION PICTURE X. NC2054.2 +004900 77 CONT- NC2054.2 +005000- A PIC NC2054.2 +005100- TURE X(10) VAL NC2054.2 +005200- UE "GOVERNMNC2054.2 +005300- "ENT". NC2054.2 +005400 77 CONT-B PICTURE S9(5)V9(5) VALUE ZERO. NC2054.2 +005500 77 CONT-C PICTURE 9(8). NC2054.2 +005600 77 CONT-D PICTURE 9(5). NC2054.2 +005700 77 CONT-E PICTURE 9999. NC2054.2 +005800 77 CONT-F PICTURE 9(5). NC2054.2 +005900 77 CONT-88 PICTURE S99. NC2054.2 +006000 88 GREATERZERO VALUE -10. NC2054.2 +006100 88 NEGATIVEZERO VALUE +10. NC2054.2 +006200 77 NC2054.2 +006300 NC2054.2 +006400 SPACING-77 NC2054.2 +006500 PICTURE NC2054.2 +006600 NC2054.2 +006700 X(10) VALUENC2054.2 +006800 NC2054.2 +006900 "ABCDE12345". NC2054.2 +007000 77 SPACING-SEND PICTURE 9(10) VALUE 1234567890. NC2054.2 +007100 77 SPACING-RECEIVE PICTURE NC2054.2 +007200 NC2054.2 +007300 NC2054.2 +007400 NC2054.2 +007500 NC2054.2 +007600 NC2054.2 +007700 NC2054.2 +007800 NC2054.2 +007900 NC2054.2 +008000 NC2054.2 +008100 NC2054.2 +008200 NC2054.2 +008300 NC2054.2 +008400 NC2054.2 +008500 NC2054.2 +008600 NC2054.2 +008700 NC2054.2 +008800 NC2054.2 +008900 NC2054.2 +009000 NC2054.2 +009100 NC2054.2 +009200 NC2054.2 +009300 NC2054.2 +009400 NC2054.2 +009500 NC2054.2 +009600 NC2054.2 +009700 NC2054.2 +009800 NC2054.2 +009900 NC2054.2 +010000 NC2054.2 +010100 NC2054.2 +010200 NC2054.2 +010300 NC2054.2 +010400 NC2054.2 +010500 NC2054.2 +010600 NC2054.2 +010700 NC2054.2 +010800 NC2054.2 +010900 NC2054.2 +011000 NC2054.2 +011100 NC2054.2 +011200 NC2054.2 +011300 NC2054.2 +011400 NC2054.2 +011500 NC2054.2 +011600 NC2054.2 +011700 NC2054.2 +011800 NC2054.2 +011900 NC2054.2 +012000 NC2054.2 +012100 NC2054.2 +012200 NC2054.2 +012300 NC2054.2 +012400 NC2054.2 +012500 NC2054.2 +012600 NC2054.2 +012700 NC2054.2 +012800 NC2054.2 +012900 NC2054.2 +013000 NC2054.2 +013100 NC2054.2 +013200 9999999999. NC2054.2 +013300 01 SPACING-01. 02 SPACING-02. 03 SPACING-03 PICTURE XX. 02 NC2054.2 +013400 SPACING-2. 03 SPACING-3. 04 SPACING-4 PICTURE X(8). NC2054.2 +013500 01 CONT-G NC2054.2 +013600- RP. NC2054.2 +013700 02 LEVEL-02. NC2054.2 +013800 03 LEVEL-03.NC2054.2 +013900 04 NC2054.2 +014000 LEVEL- NC2054.2 +014100- 04 PICTURE XXXXXXXXXX. NC2054.2 +014200 01 TEST-RESULTS. NC2054.2 +014300 02 FILLER PIC X VALUE SPACE. NC2054.2 +014400 02 FEATURE PIC X(20) VALUE SPACE. NC2054.2 +014500 02 FILLER PIC X VALUE SPACE. NC2054.2 +014600 02 P-OR-F PIC X(5) VALUE SPACE. NC2054.2 +014700 02 FILLER PIC X VALUE SPACE. NC2054.2 +014800 02 PAR-NAME. NC2054.2 +014900 03 FILLER PIC X(19) VALUE SPACE. NC2054.2 +015000 03 PARDOT-X PIC X VALUE SPACE. NC2054.2 +015100 03 DOTVALUE PIC 99 VALUE ZERO. NC2054.2 +015200 02 FILLER PIC X(8) VALUE SPACE. NC2054.2 +015300 02 RE-MARK PIC X(61). NC2054.2 +015400 01 TEST-COMPUTED. NC2054.2 +015500 02 FILLER PIC X(30) VALUE SPACE. NC2054.2 +015600 02 FILLER PIC X(17) VALUE NC2054.2 +015700 " COMPUTED=". NC2054.2 +015800 02 COMPUTED-X. NC2054.2 +015900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2054.2 +016000 03 COMPUTED-N REDEFINES COMPUTED-A NC2054.2 +016100 PIC -9(9).9(9). NC2054.2 +016200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2054.2 +016300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2054.2 +016400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2054.2 +016500 03 CM-18V0 REDEFINES COMPUTED-A. NC2054.2 +016600 04 COMPUTED-18V0 PIC -9(18). NC2054.2 +016700 04 FILLER PIC X. NC2054.2 +016800 03 FILLER PIC X(50) VALUE SPACE. NC2054.2 +016900 01 TEST-CORRECT. NC2054.2 +017000 02 FILLER PIC X(30) VALUE SPACE. NC2054.2 +017100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2054.2 +017200 02 CORRECT-X. NC2054.2 +017300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2054.2 +017400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2054.2 +017500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2054.2 +017600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2054.2 +017700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2054.2 +017800 03 CR-18V0 REDEFINES CORRECT-A. NC2054.2 +017900 04 CORRECT-18V0 PIC -9(18). NC2054.2 +018000 04 FILLER PIC X. NC2054.2 +018100 03 FILLER PIC X(2) VALUE SPACE. NC2054.2 +018200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2054.2 +018300 01 CCVS-C-1. NC2054.2 +018400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2054.2 +018500- "SS PARAGRAPH-NAME NC2054.2 +018600- " REMARKS". NC2054.2 +018700 02 FILLER PIC X(20) VALUE SPACE. NC2054.2 +018800 01 CCVS-C-2. NC2054.2 +018900 02 FILLER PIC X VALUE SPACE. NC2054.2 +019000 02 FILLER PIC X(6) VALUE "TESTED". NC2054.2 +019100 02 FILLER PIC X(15) VALUE SPACE. NC2054.2 +019200 02 FILLER PIC X(4) VALUE "FAIL". NC2054.2 +019300 02 FILLER PIC X(94) VALUE SPACE. NC2054.2 +019400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2054.2 +019500 01 REC-CT PIC 99 VALUE ZERO. NC2054.2 +019600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2054.2 +019700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2054.2 +019800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2054.2 +019900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2054.2 +020000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2054.2 +020100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2054.2 +020200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2054.2 +020300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2054.2 +020400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2054.2 +020500 01 CCVS-H-1. NC2054.2 +020600 02 FILLER PIC X(39) VALUE SPACES. NC2054.2 +020700 02 FILLER PIC X(42) VALUE NC2054.2 +020800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2054.2 +020900 02 FILLER PIC X(39) VALUE SPACES. NC2054.2 +021000 01 CCVS-H-2A. NC2054.2 +021100 02 FILLER PIC X(40) VALUE SPACE. NC2054.2 +021200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2054.2 +021300 02 FILLER PIC XXXX VALUE NC2054.2 +021400 "4.2 ". NC2054.2 +021500 02 FILLER PIC X(28) VALUE NC2054.2 +021600 " COPY - NOT FOR DISTRIBUTION". NC2054.2 +021700 02 FILLER PIC X(41) VALUE SPACE. NC2054.2 +021800 NC2054.2 +021900 01 CCVS-H-2B. NC2054.2 +022000 02 FILLER PIC X(15) VALUE NC2054.2 +022100 "TEST RESULT OF ". NC2054.2 +022200 02 TEST-ID PIC X(9). NC2054.2 +022300 02 FILLER PIC X(4) VALUE NC2054.2 +022400 " IN ". NC2054.2 +022500 02 FILLER PIC X(12) VALUE NC2054.2 +022600 " HIGH ". NC2054.2 +022700 02 FILLER PIC X(22) VALUE NC2054.2 +022800 " LEVEL VALIDATION FOR ". NC2054.2 +022900 02 FILLER PIC X(58) VALUE NC2054.2 +023000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2054.2 +023100 01 CCVS-H-3. NC2054.2 +023200 02 FILLER PIC X(34) VALUE NC2054.2 +023300 " FOR OFFICIAL USE ONLY ". NC2054.2 +023400 02 FILLER PIC X(58) VALUE NC2054.2 +023500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2054.2 +023600 02 FILLER PIC X(28) VALUE NC2054.2 +023700 " COPYRIGHT 1985 ". NC2054.2 +023800 01 CCVS-E-1. NC2054.2 +023900 02 FILLER PIC X(52) VALUE SPACE. NC2054.2 +024000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2054.2 +024100 02 ID-AGAIN PIC X(9). NC2054.2 +024200 02 FILLER PIC X(45) VALUE SPACES. NC2054.2 +024300 01 CCVS-E-2. NC2054.2 +024400 02 FILLER PIC X(31) VALUE SPACE. NC2054.2 +024500 02 FILLER PIC X(21) VALUE SPACE. NC2054.2 +024600 02 CCVS-E-2-2. NC2054.2 +024700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2054.2 +024800 03 FILLER PIC X VALUE SPACE. NC2054.2 +024900 03 ENDER-DESC PIC X(44) VALUE NC2054.2 +025000 "ERRORS ENCOUNTERED". NC2054.2 +025100 01 CCVS-E-3. NC2054.2 +025200 02 FILLER PIC X(22) VALUE NC2054.2 +025300 " FOR OFFICIAL USE ONLY". NC2054.2 +025400 02 FILLER PIC X(12) VALUE SPACE. NC2054.2 +025500 02 FILLER PIC X(58) VALUE NC2054.2 +025600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2054.2 +025700 02 FILLER PIC X(13) VALUE SPACE. NC2054.2 +025800 02 FILLER PIC X(15) VALUE NC2054.2 +025900 " COPYRIGHT 1985". NC2054.2 +026000 01 CCVS-E-4. NC2054.2 +026100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2054.2 +026200 02 FILLER PIC X(4) VALUE " OF ". NC2054.2 +026300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2054.2 +026400 02 FILLER PIC X(40) VALUE NC2054.2 +026500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2054.2 +026600 01 XXINFO. NC2054.2 +026700 02 FILLER PIC X(19) VALUE NC2054.2 +026800 "*** INFORMATION ***". NC2054.2 +026900 02 INFO-TEXT. NC2054.2 +027000 04 FILLER PIC X(8) VALUE SPACE. NC2054.2 +027100 04 XXCOMPUTED PIC X(20). NC2054.2 +027200 04 FILLER PIC X(5) VALUE SPACE. NC2054.2 +027300 04 XXCORRECT PIC X(20). NC2054.2 +027400 02 INF-ANSI-REFERENCE PIC X(48). NC2054.2 +027500 01 HYPHEN-LINE. NC2054.2 +027600 02 FILLER PIC IS X VALUE IS SPACE. NC2054.2 +027700 02 FILLER PIC IS X(65) VALUE IS "************************NC2054.2 +027800- "*****************************************". NC2054.2 +027900 02 FILLER PIC IS X(54) VALUE IS "************************NC2054.2 +028000- "******************************". NC2054.2 +028100 01 CCVS-PGM-ID PIC X(9) VALUE NC2054.2 +028200 "NC205A". NC2054.2 +028300 PROCEDURE DIVISION. NC2054.2 +028400 CCVS1 SECTION. NC2054.2 +028500 OPEN-FILES. NC2054.2 +028600 OPEN OUTPUT PRINT-FILE. NC2054.2 +028700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2054.2 +028800 MOVE SPACE TO TEST-RESULTS. NC2054.2 +028900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2054.2 +029000 GO TO CCVS1-EXIT. NC2054.2 +029100 CLOSE-FILES. NC2054.2 +029200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2054.2 +029300 TERMINATE-CCVS. NC2054.2 +029400*S EXIT PROGRAM. NC2054.2 +029500*SERMINATE-CALL. NC2054.2 +029600 STOP RUN. NC2054.2 +029700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2054.2 +029800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2054.2 +029900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2054.2 +030000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2054.2 +030100 MOVE "****TEST DELETED****" TO RE-MARK. NC2054.2 +030200 PRINT-DETAIL. NC2054.2 +030300 IF REC-CT NOT EQUAL TO ZERO NC2054.2 +030400 MOVE "." TO PARDOT-X NC2054.2 +030500 MOVE REC-CT TO DOTVALUE. NC2054.2 +030600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2054.2 +030700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2054.2 +030800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2054.2 +030900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2054.2 +031000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2054.2 +031100 MOVE SPACE TO CORRECT-X. NC2054.2 +031200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2054.2 +031300 MOVE SPACE TO RE-MARK. NC2054.2 +031400 HEAD-ROUTINE. NC2054.2 +031500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +031600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +031700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2054.2 +031800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2054.2 +031900 COLUMN-NAMES-ROUTINE. NC2054.2 +032000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +032100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +032200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +032300 END-ROUTINE. NC2054.2 +032400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2054.2 +032500 END-RTN-EXIT. NC2054.2 +032600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +032700 END-ROUTINE-1. NC2054.2 +032800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2054.2 +032900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2054.2 +033000 ADD PASS-COUNTER TO ERROR-HOLD. NC2054.2 +033100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2054.2 +033200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2054.2 +033300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2054.2 +033400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2054.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2054.2 +033600 END-ROUTINE-12. NC2054.2 +033700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2054.2 +033800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2054.2 +033900 MOVE "NO " TO ERROR-TOTAL NC2054.2 +034000 ELSE NC2054.2 +034100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2054.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2054.2 +034300 PERFORM WRITE-LINE. NC2054.2 +034400 END-ROUTINE-13. NC2054.2 +034500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2054.2 +034600 MOVE "NO " TO ERROR-TOTAL ELSE NC2054.2 +034700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2054.2 +034800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2054.2 +034900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +035000 IF INSPECT-COUNTER EQUAL TO ZERO NC2054.2 +035100 MOVE "NO " TO ERROR-TOTAL NC2054.2 +035200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2054.2 +035300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2054.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +035500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2054.2 +035600 WRITE-LINE. NC2054.2 +035700 ADD 1 TO RECORD-COUNT. NC2054.2 +035800 IF RECORD-COUNT GREATER 50 NC2054.2 +035900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2054.2 +036000 MOVE SPACE TO DUMMY-RECORD NC2054.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2054.2 +036200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2054.2 +036300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2054.2 +036400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2054.2 +036500 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2054.2 +036600 MOVE ZERO TO RECORD-COUNT. NC2054.2 +036700 PERFORM WRT-LN. NC2054.2 +036800 WRT-LN. NC2054.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2054.2 +037000 MOVE SPACE TO DUMMY-RECORD. NC2054.2 +037100 BLANK-LINE-PRINT. NC2054.2 +037200 PERFORM WRT-LN. NC2054.2 +037300 FAIL-ROUTINE. NC2054.2 +037400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2054.2 +037500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2054.2 +037600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2054.2 +037700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2054.2 +037800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +037900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2054.2 +038000 GO TO FAIL-ROUTINE-EX. NC2054.2 +038100 FAIL-ROUTINE-WRITE. NC2054.2 +038200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2054.2 +038300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2054.2 +038400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2054.2 +038500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2054.2 +038600 FAIL-ROUTINE-EX. EXIT. NC2054.2 +038700 BAIL-OUT. NC2054.2 +038800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2054.2 +038900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2054.2 +039000 BAIL-OUT-WRITE. NC2054.2 +039100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2054.2 +039200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2054.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2054.2 +039400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2054.2 +039500 BAIL-OUT-EX. EXIT. NC2054.2 +039600 CCVS1-EXIT. NC2054.2 +039700 EXIT. NC2054.2 +039800 SECT-NC205A-001 SECTION. NC2054.2 +039900 CON-INIT-GF. NC2054.2 +040000 MOVE "CONTINUATION ---" TO FEATURE. NC2054.2 +040100 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC2054.2 +040200 PERFORM PRINT-DETAIL. NC2054.2 +040300 CON-INIT-GF-1. NC2054.2 +040400 MOVE "CON-TEST-GF-1" TO PAR-NAME NC2054.2 +040500 MOVE " NUMERIC INTEGER" TO FEATURE. NC2054.2 +040600 CON-TEST-GF-1. NC2054.2 +040700 MOVE 4 NC2054.2 +040800- 5 NC2054.2 +040900- 6 NC2054.2 +041000- 7 NC2054.2 +041100- 8 TO CONT-B. NC2054.2 +041200 IF CONT-B EQUAL TO 45678 NC2054.2 +041300 PERFORM PASS NC2054.2 +041400 GO TO CON-WRITE-GF-1. NC2054.2 +041500 GO TO CON-FAIL-GF-1. NC2054.2 +041600 CON-DELETE-GF-1. NC2054.2 +041700 PERFORM DE-LETE. NC2054.2 +041800 GO TO CON-WRITE-GF-1. NC2054.2 +041900 CON-FAIL-GF-1. NC2054.2 +042000 PERFORM FAIL. NC2054.2 +042100 MOVE CONT-B TO COMPUTED-N. NC2054.2 +042200 MOVE 45678 TO CORRECT-N. NC2054.2 +042300 CON-WRITE-GF-1. NC2054.2 +042400 PERFORM PRINT-DETAIL. NC2054.2 +042500* NC2054.2 +042600 CON-INIT-GF-2. NC2054.2 +042700 MOVE "CON-TEST-GF-2" TO PAR-NAME. NC2054.2 +042800 MOVE " NUM NON-INTEGER" TO FEATURE. NC2054.2 +042900 CON-TEST-GF-2. NC2054.2 +043000 MOVE - NC2054.2 +043100- 9 NC2054.2 +043200- 9 NC2054.2 +043300- 9 NC2054.2 +043400- . NC2054.2 +043500- 7 NC2054.2 +043600- 7 NC2054.2 +043700- 7 TO CONT-B. NC2054.2 +043800 IF CONT-B EQUAL TO -999.777 NC2054.2 +043900 PERFORM PASS NC2054.2 +044000 GO TO CON-WRITE-GF-2. NC2054.2 +044100 GO TO CON-FAIL-GF-2. NC2054.2 +044200 CON-DELETE-GF-2. NC2054.2 +044300 PERFORM DE-LETE. NC2054.2 +044400 GO TO CON-WRITE-GF-2. NC2054.2 +044500 CON-FAIL-GF-2. NC2054.2 +044600 PERFORM FAIL. NC2054.2 +044700 MOVE CONT-B TO COMPUTED-N. NC2054.2 +044800 MOVE -999.777 TO CORRECT-N. NC2054.2 +044900 CON-WRITE-GF-2. NC2054.2 +045000 PERFORM PRINT-DETAIL. NC2054.2 +045100* NC2054.2 +045200* N.B. CONTIN-TEST-3 HAS BEEN REMOVED, AND SUBSEQUENT NC2054.2 +045300* TESTS HAVE BEEN RE-NUMBERED. NC2054.2 +045400 CON-INIT-GF-3. NC2054.2 +045500 MOVE " COMP CONDITIONAL" TO FEATURE. NC2054.2 +045600 MOVE "CON-TEST-GF-3" TO PAR-NAME. NC2054.2 +045700 CON-TEST-GF-3. NC2054.2 +045800 MOVE -10 TO CONT-B. NC2054.2 +045900 MOVE 10 TO CONT-C. NC2054.2 +046000 MOVE 1 TO CONT-D. NC2054.2 +046100 MOVE 0 TO CONT-E. NC2054.2 +046200 MOVE 10 TO CONT-F. NC2054.2 +046300 MOVE -10 TO CONT-88. NC2054.2 +046400 IF CONT-E EQUA NC2054.2 +046500- L TO ZERO NC2054.2 +046600- S AN NC2054.2 +046700- D GREATER NC2054.2 +046800- ZERO AND CONT-B NC2054.2 +046900 EQUAL TO CONT-C OR ((((((0 NC2054.2 +047000 NC2054.2 +047100 NC2054.2 +047200 NC2054.2 +047300 NC2054.2 +047400 NC2054.2 +047500 NC2054.2 +047600 NC2054.2 +047700 NC2054.2 +047800 NC2054.2 +047900 NC2054.2 +048000 NC2054.2 +048100 NC2054.2 +048200 NC2054.2 +048300 NC2054.2 +048400 NC2054.2 +048500 NC2054.2 +048600 NC2054.2 +048700 NC2054.2 +048800 NC2054.2 +048900 NC2054.2 +049000 NC2054.2 +049100 NC2054.2 +049200 NC2054.2 +049300 NC2054.2 +049400 NC2054.2 +049500 NC2054.2 +049600 NC2054.2 +049700 NC2054.2 +049800 NC2054.2 +049900 NC2054.2 +050000 NC2054.2 +050100 NC2054.2 +050200 NC2054.2 +050300 NC2054.2 +050400 NC2054.2 +050500 NC2054.2 +050600 NC2054.2 +050700 NC2054.2 +050800 NC2054.2 +050900 NC2054.2 +051000 NC2054.2 +051100 NC2054.2 +051200 NC2054.2 +051300 NC2054.2 +051400 NC2054.2 +051500 NC2054.2 +051600 NC2054.2 +051700 NC2054.2 +051800 NC2054.2 +051900 NC2054.2 +052000 NC2054.2 +052100 NC2054.2 +052200 NC2054.2 +052300 NC2054.2 +052400 NC2054.2 +052500 NC2054.2 +052600 NC2054.2 +052700 NC2054.2 +052800 NC2054.2 +052900 NC2054.2 +053000 NC2054.2 +053100 NC2054.2 +053200 NC2054.2 +053300 NC2054.2 +053400 NC2054.2 +053500 NC2054.2 +053600 NC2054.2 +053700 NC2054.2 +053800 NC2054.2 +053900 NC2054.2 +054000 NC2054.2 +054100 NC2054.2 +054200 NC2054.2 +054300 NC2054.2 +054400 NC2054.2 +054500 NC2054.2 +054600 NC2054.2 +054700 NC2054.2 +054800 NC2054.2 +054900 NC2054.2 +055000 - CONT-D EQUAL TO CONT-D O NC2054.2 +055100- R -11 + CONT-F))))))NC2054.2 +055200 AND N NC2054.2 +055300- OT NEGATIVE NC2054.2 +055400- ZERO NC2054.2 +055500 PERFORM PASS NC2054.2 +055600 EL NC2054.2 +055700- SE NC2054.2 +055800 GO TO CON-FAIL-GF-3. NC2054.2 +055900 GO TO CON-WRITE-GF-3. NC2054.2 +056000 CON-DELETE-GF-3. NC2054.2 +056100 PERFORM DE-LETE. NC2054.2 +056200 GO TO CON-WRITE-GF-3. NC2054.2 +056300 NC2054.2 +056400 NC2054.2 +056500 NC2054.2 +056600 NC2054.2 +056700 CON-FAIL-GF-3. NC2054.2 +056800 PERFORM FAIL. NC2054.2 +056900 CON-WRITE-GF-3. NC2054.2 +057000 PERFORM PRINT-DETAIL. NC2054.2 +057100* NC2054.2 +057200 CON-INIT-GF-4. NC2054.2 +057300 MOVE " RESERVED WORDS" TO FEATURE NC2054.2 +057400 MOVE "CON-TEST-GF-4" TO PAR-NAME. NC2054.2 +057500 MOVE 54321 TO CONT-D. NC2054.2 +057600 MOVE 12 TO CONT-E. NC2054.2 +057700 MOVE 1199997 TO CONT-C. NC2054.2 +057800 CON-TEST-GF-4. NC2054.2 +057900 DIV NC2054.2 +058000- ID NC2054.2 +058100- E CONT-E IN NC2054.2 +058200- TO CONT-C GIV NC2054.2 +058300- IN NC2054.2 +058400- G CONT-D ROUN NC2054.2 +058500- DE NC2054.2 +058600- D O NC2054.2 +058700- N SIZE ERRNC2054.2 +058800- OR PERFOR NC2054.2 +058900- M PASS G NC2054.2 +059000- O T NC2054.2 +059100- O CON-WRITE-GF-4. NC2054.2 +059200 GO TO CON-FAIL-GF-4. NC2054.2 +059300 CON-DELETE-GF-4. NC2054.2 +059400 PERFORM DE-LETE. NC2054.2 +059500 GO TO CON-WRITE-GF-4. NC2054.2 +059600 CON-FAIL-GF-4. NC2054.2 +059700 PERFORM FAIL. NC2054.2 +059800 MOVE CONT-D TO COMPUTED-N. NC2054.2 +059900 MOVE 54321 TO CORRECT-N. NC2054.2 +060000 MOVE "SIZE ERROR EXPECTED" TO RE-MARK. NC2054.2 +060100 CON-WRITE-GF-4. NC2054.2 +060200 PERFORM PRINT-DETAIL. NC2054.2 +060300* NC2054.2 +060400 CON-INIT-GF-5. NC2054.2 +060500 MOVE " DATA-NAMES" TO FEATURE. NC2054.2 +060600 MOVE "CON-TEST-GF-5" TO PAR-NAME. NC2054.2 +060700 MOVE 10000 TO CONT-D. NC2054.2 +060800 MOVE 1000 TO CONT-F. NC2054.2 +060900 MOVE ZERO TO CONT-C. NC2054.2 +061000 CON-TEST-GF-5. NC2054.2 +061100 IF CONT NC2054.2 +061200- -D EQUAL TO 10000 ADD CONT NC2054.2 +061300- -D CONT NC2054.2 +061400- -F GIVING CONT-NC2054.2 +061500- C. NC2054.2 +061600 IF CONT-C EQUAL TO 11000 NC2054.2 +061700 PERFORM PASS GO TO CON-WRITE-GF-5. NC2054.2 +061800 GO TO CON-FAIL-GF-5. NC2054.2 +061900 CON-DELETE-GF-5. NC2054.2 +062000 PERFORM DE-LETE. NC2054.2 +062100 GO TO CON-WRITE-GF-5. NC2054.2 +062200 CON-FAIL-GF-5. NC2054.2 +062300 PERFORM FAIL. NC2054.2 +062400 MOVE CONT-C TO COMPUTED-A. NC2054.2 +062500 MOVE 11000 TO CORRECT-A. NC2054.2 +062600 CON-WRITE-GF-5. NC2054.2 +062700 PERFORM PRINT-DETAIL. NC2054.2 +062800* NC2054.2 +062900 CON-TEST-GF-6. NC2054.2 +063000 MOVE "CON-TEST-GF-6" TO PAR-NAME. NC2054.2 +063100 MOVE " PARAGRAPH-NAMES" TO FEATURE. NC2054.2 +063200 PERFORM PA NC2054.2 +063300- SS. NC2054.2 +063400 IF P-OR-F NOT EQUAL TO "PASS" GO TO CON-FAIL-GF-6. NC2054.2 +063500 GO TO CON NC2054.2 +063600- -WRITE-GF-6. NC2054.2 +063700 CON-TEST-GF-6-1. NC2054.2 +063800 GO TO CON-FAIL-GF-6. NC2054.2 +063900 CON-DELETE-GF-6. NC2054.2 +064000 PERFORM DE-LETE. NC2054.2 +064100 GO TO CON-WRITE-GF-6. NC2054.2 +064200 CON-FAIL-GF-6. NC2054.2 +064300 PERFORM FAIL. NC2054.2 +064400 MOVE "CNTD PARA-NAME NOT FOUND" TO RE-MARK. NC2054.2 +064500 CON-WRITE-GF-6. NC2054.2 +064600 PERFORM PRINT-DETAIL. NC2054.2 +064700* NC2054.2 +064800* N.B. THE REFERENCE TO THE OLD TEST CALLED NC2054.2 +064900* CONTIN-TEST-8 HAS BEEN REMOVED. NC2054.2 +065000* NOTE TEST MOVED TO SQ215. NC2054.2 +065100* NC2054.2 +065200 CON-INIT-GF-7. NC2054.2 +065300 MOVE " RECORD, ITEM DESCR" TO FEATURE. NC2054.2 +065400 MOVE "CON-TEST-GF-7" TO PAR-NAME. NC2054.2 +065500* N.B. CONT-A IS NOT EXPLICITLY INITIALISED HERE NC2054.2 +065600* BECAUSE THE -VALUE IS- CLAUSE OF THE NC2054.2 +065700* DEFINITION IS UNDER TEST IN THE NEXT PARAGRAPH. NC2054.2 +065800 CON-TEST-GF-7. NC2054.2 +065900 MOVE CONT-A TO CONT-GRP. NC2054.2 +066000 IF LEVEL-04 EQUAL TO "GOVERNMENT" NC2054.2 +066100 PERFORM PASS NC2054.2 +066200 GO TO CON-WRITE-GF-7. NC2054.2 +066300 GO TO CON-FAIL-GF-7. NC2054.2 +066400 CON-DELETE-GF-7. NC2054.2 +066500 PERFORM DE-LETE. NC2054.2 +066600 GO TO CON-WRITE-GF-7. NC2054.2 +066700 CON-FAIL-GF-7. NC2054.2 +066800 PERFORM FAIL. NC2054.2 +066900 MOVE LEVEL-04 TO COMPUTED-A. NC2054.2 +067000 MOVE "GOVERNMENT" TO CORRECT-A. NC2054.2 +067100 CON-WRITE-GF-7. NC2054.2 +067200 PERFORM PRINT-DETAIL. NC2054.2 +067300 CON-INIT-GF-8. NC2054.2 +067400 MOVE "SPACES BETWEEN WORDS" TO FEATURE. NC2054.2 +067500 MOVE "CON-TEST-GF-10" TO PAR-NAME. NC2054.2 +067600 MOVE "ABCDE12345" TO SPACING-77. NC2054.2 +067700 CON-TEST-GF-8. NC2054.2 +067800 MOVE SPACING-77 TO SPACING-01. NC2054.2 +067900 IF SPACING-4 EQUAL TO "CDE12345" NC2054.2 +068000 PERFORM PASS GO TO CON-WRITE-GF-8. NC2054.2 +068100 GO TO CON-FAIL-GF-8. NC2054.2 +068200 CON-DELETE-GF-8. NC2054.2 +068300 PERFORM DE-LETE. NC2054.2 +068400 GO TO CON-WRITE-GF-8. NC2054.2 +068500 CON-FAIL-GF-8. NC2054.2 +068600 PERFORM FAIL. NC2054.2 +068700 MOVE SPACING-4 TO COMPUTED-A. NC2054.2 +068800 MOVE "CDE12345" TO CORRECT-A. NC2054.2 +068900 CON-WRITE-GF-8. NC2054.2 +069000 PERFORM PRINT-DETAIL. NC2054.2 +069100* NC2054.2 +069200 CON-INIT-GF-9. NC2054.2 +069300 MOVE "CON-WRITE-GF-9" TO PAR-NAME. NC2054.2 +069400 MOVE 1234567890 TO SPACING-SEND. NC2054.2 +069500 MOVE SPACING-SEND TO SPACING-RECEIVE. NC2054.2 +069600 CON-TEST-GF-9. NC2054.2 +069700 IF SPACING-RECEIVE EQUAL TO 1234567890 NC2054.2 +069800 PERFORM NC2054.2 +069900 NC2054.2 +070000 NC2054.2 +070100 NC2054.2 +070200 NC2054.2 +070300 NC2054.2 +070400 NC2054.2 +070500 NC2054.2 +070600 NC2054.2 +070700 NC2054.2 +070800 NC2054.2 +070900 NC2054.2 +071000 NC2054.2 +071100 NC2054.2 +071200 NC2054.2 +071300 NC2054.2 +071400 NC2054.2 +071500 NC2054.2 +071600 NC2054.2 +071700 NC2054.2 +071800 NC2054.2 +071900 NC2054.2 +072000 NC2054.2 +072100 NC2054.2 +072200 NC2054.2 +072300 NC2054.2 +072400 NC2054.2 +072500 NC2054.2 +072600 NC2054.2 +072700 NC2054.2 +072800 NC2054.2 +072900 NC2054.2 +073000 NC2054.2 +073100 NC2054.2 +073200 NC2054.2 +073300 NC2054.2 +073400 NC2054.2 +073500 NC2054.2 +073600 NC2054.2 +073700 NC2054.2 +073800 NC2054.2 +073900 NC2054.2 +074000 NC2054.2 +074100 NC2054.2 +074200 NC2054.2 +074300 NC2054.2 +074400 NC2054.2 +074500 NC2054.2 +074600 NC2054.2 +074700 NC2054.2 +074800 NC2054.2 +074900 NC2054.2 +075000 NC2054.2 +075100 NC2054.2 +075200 NC2054.2 +075300 NC2054.2 +075400 NC2054.2 +075500 NC2054.2 +075600 NC2054.2 +075700 NC2054.2 +075800 NC2054.2 +075900 NC2054.2 +076000 NC2054.2 +076100 NC2054.2 +076200 NC2054.2 +076300 NC2054.2 +076400 NC2054.2 +076500 NC2054.2 +076600 NC2054.2 +076700 NC2054.2 +076800 NC2054.2 +076900 PA NC2054.2 +077000- SS GO TO CON-WRITE-GF-9. NC2054.2 +077100 GO TO CON-FAIL-GF-9. NC2054.2 +077200 CON-DELETE-GF-9. NC2054.2 +077300 PERFORM DE-LETE. NC2054.2 +077400 GO TO CON-WRITE-GF-9. NC2054.2 +077500 CON-FAIL-GF-9. NC2054.2 +077600 PERFORM FAIL. NC2054.2 +077700 MOVE SPACING-RECEIVE TO COMPUTED-18V0. NC2054.2 +077800 MOVE 1234567890 TO CORRECT-18V0. NC2054.2 +077900 CON-WRITE-GF-9. NC2054.2 +078000 PERFORM PRINT-DETAIL. NC2054.2 +078100* NC2054.2 +078200 CON-INIT-GF-10. NC2054.2 +078300* ===--> PICTURE CHARACTER STRING CONTINUED <--=== NC2054.2 +078400 MOVE "IV-44 7.2.2" TO ANSI-REFERENCE. NC2054.2 +078500 MOVE "PICTURE STRING CONTINUED" TO FEATURE NC2054.2 +078600 MOVE "CON-TEST-GF-10" TO PAR-NAME. NC2054.2 +078700 CON-TEST-GF-10-1. NC2054.2 +078800 MOVE 654321.987654 TO WS-TEST-12-DATA. NC2054.2 +078900 IF WS-TEST-12-DATA = 654321.987654 NC2054.2 +079000 PERFORM PASS NC2054.2 +079100 GO TO CON-WRITE-GF-10. NC2054.2 +079200 GO TO CON-FAIL-GF-10. NC2054.2 +079300 CON-DELETE-GF-10. NC2054.2 +079400 PERFORM DE-LETE. NC2054.2 +079500 GO TO CON-WRITE-GF-10. NC2054.2 +079600 CON-FAIL-GF-10. NC2054.2 +079700 PERFORM FAIL. NC2054.2 +079800 MOVE WS-TEST-12-DATA TO COMPUTED-N. NC2054.2 +079900 MOVE 654321.987654 TO CORRECT-N. NC2054.2 +080000 CON-WRITE-GF-10. NC2054.2 +080100 PERFORM PRINT-DETAIL. NC2054.2 +080200 CCVS-EXIT SECTION. NC2054.2 +080300 CCVS-999999. NC2054.2 +080400 GO TO CLOSE-FILES. NC2054.2 diff --git a/tests/cobol85/NC/NC206A.CBL b/tests/cobol85/NC/NC206A.CBL new file mode 100755 index 00000000..8622e1b4 --- /dev/null +++ b/tests/cobol85/NC/NC206A.CBL @@ -0,0 +1,1695 @@ +000100 IDENTIFICATION DIVISION. NC2064.2 +000200 PROGRAM-ID. NC2064.2 +000300**************************************************************** NC2064.2 +000400* * NC2064.2 +000500* VALIDATION FOR:- * NC2064.2 +000600* * NC2064.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2064.2 +000800* * NC2064.2 +000900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2064.2 +001000* * NC2064.2 +001100**************************************************************** NC2064.2 +001200* * NC2064.2 +001300* X-CARDS USED BY THIS PROGRAM ARE :- * NC2064.2 +001400* * NC2064.2 +001500* X-55 - SYSTEM PRINTER NAME. * NC2064.2 +001600* X-82 - SOURCE COMPUTER NAME. * NC2064.2 +001700* X-83 - OBJECT COMPUTER NAME. * NC2064.2 +001800* * NC2064.2 +001900**************************************************************** NC2064.2 +002000 NC206A. NC2064.2 +002100* * NC2064.2 +002200* PROGRAM NC206A TESTS THE ACCESSING OF ELEMENTARY ITEMS * NC2064.2 +002300* USING FORMAT 1 QUALIFICATION WITH UP TO 5 LEVELS OF * NC2064.2 +002400* QUALIFIERS. SINGLE DIMENSION TABLES ARE ALSO ACCESSES * NC2064.2 +002500* USING SUBSCRIPTS QUALIFIED TO ONE LEVEL. * NC2064.2 +002600* * NC2064.2 +002700**************************************************************** NC2064.2 +002800 ENVIRONMENT DIVISION. NC2064.2 +002900 CONFIGURATION SECTION. NC2064.2 +003000 SOURCE-COMPUTER. NC2064.2 +003100 Linux. NC2064.2 +003200 OBJECT-COMPUTER. NC2064.2 +003300 Linux. NC2064.2 +003400 INPUT-OUTPUT SECTION. NC2064.2 +003500 FILE-CONTROL. NC2064.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2064.2 +003700 "report.log". NC2064.2 +003800 DATA DIVISION. NC2064.2 +003900 FILE SECTION. NC2064.2 +004000 FD PRINT-FILE. NC2064.2 +004100 01 PRINT-REC PICTURE X(120). NC2064.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2064.2 +004300 WORKING-STORAGE SECTION. NC2064.2 +004400 77 MAX-NAME-1 PICTURE S9(18) VALUE +1. NC2064.2 +004500 01 TABLE-LEVEL-5A. NC2064.2 +004600 02 TABLE-LEVEL-4A. NC2064.2 +004700 03 TABLE-LEVEL-3A. NC2064.2 +004800 04 TABLE-LEVEL-2A. NC2064.2 +004900 05 TABLE-LEVEL-1A. NC2064.2 +005000 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3A2A1A0A".NC2064.2 +005100 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3A2A1A0B".NC2064.2 +005200 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3A2A1A0C".NC2064.2 +005300 06 TBL-LEVEL-0D PIC X(12) VALUE "5A4A3A2A1A0D".NC2064.2 +005400 05 TABLE-LEVEL-1B. NC2064.2 +005500 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3A2A1B0A".NC2064.2 +005600 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3A2A1B0B".NC2064.2 +005700 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3A2A1B0C".NC2064.2 +005800 04 TABLE-LEVEL-2B. NC2064.2 +005900 05 TABLE-LEVEL-1A. NC2064.2 +006000 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3A2B1A0A".NC2064.2 +006100 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3A2B1A0B".NC2064.2 +006200 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3A2B1A0C".NC2064.2 +006300 05 TABLE-LEVEL-1B. NC2064.2 +006400 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3A2B1B0A".NC2064.2 +006500 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3A2B1B0B".NC2064.2 +006600 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3A2B1B0C".NC2064.2 +006700 03 TABLE-LEVEL-3B. NC2064.2 +006800 04 TABLE-LEVEL-2A. NC2064.2 +006900 05 TABLE-LEVEL-1A. NC2064.2 +007000 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3B2A1A0A".NC2064.2 +007100 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3B2A1A0B".NC2064.2 +007200 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3B2A1A0C".NC2064.2 +007300 05 TABLE-LEVEL-1B. NC2064.2 +007400 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3B2A1B0A".NC2064.2 +007500 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3B2A1B0B".NC2064.2 +007600 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3B2A1B0C".NC2064.2 +007700 04 TABLE-LEVEL-2B. NC2064.2 +007800 05 TABLE-LEVEL-1A. NC2064.2 +007900 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3B2B1A0A".NC2064.2 +008000 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3B2B1A0B".NC2064.2 +008100 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3B2B1A0C".NC2064.2 +008200 05 TABLE-LEVEL-1B. NC2064.2 +008300 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4A3B2B1B0A".NC2064.2 +008400 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4A3B2B1B0B".NC2064.2 +008500 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4A3B2B1B0C".NC2064.2 +008600 02 TABLE-LEVEL-4B. NC2064.2 +008700 03 TABLE-LEVEL-3A. NC2064.2 +008800 04 TABLE-LEVEL-2A. NC2064.2 +008900 05 TABLE-LEVEL-1A. NC2064.2 +009000 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3A2A1A0A".NC2064.2 +009100 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3A2A1A0B".NC2064.2 +009200 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3A2A1A0C".NC2064.2 +009300 05 TABLE-LEVEL-1B. NC2064.2 +009400 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3A2A1B0A".NC2064.2 +009500 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3A2A1B0B".NC2064.2 +009600 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3A2A1B0C".NC2064.2 +009700 04 TABLE-LEVEL-2B. NC2064.2 +009800 05 TABLE-LEVEL-1A. NC2064.2 +009900 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3A2B1A0A".NC2064.2 +010000 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3A2B1A0B".NC2064.2 +010100 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3A2B1A0C".NC2064.2 +010200 05 TABLE-LEVEL-1B. NC2064.2 +010300 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3A2B1B0A".NC2064.2 +010400 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3A2B1B0B".NC2064.2 +010500 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3A2B1B0C".NC2064.2 +010600 03 TABLE-LEVEL-3B. NC2064.2 +010700 04 TABLE-LEVEL-2A. NC2064.2 +010800 05 TABLE-LEVEL-1A. NC2064.2 +010900 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3B2A1A0A".NC2064.2 +011000 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3B2A1A0B".NC2064.2 +011100 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3B2A1A0C".NC2064.2 +011200 05 TABLE-LEVEL-1B. NC2064.2 +011300 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3B2A1B0A".NC2064.2 +011400 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3B2A1B0B".NC2064.2 +011500 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3B2A1B0C".NC2064.2 +011600 04 TABLE-LEVEL-2B. NC2064.2 +011700 05 TABLE-LEVEL-1A. NC2064.2 +011800 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3B2B1A0A".NC2064.2 +011900 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3B2B1A0B".NC2064.2 +012000 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3B2B1A0C".NC2064.2 +012100 05 TABLE-LEVEL-1B. NC2064.2 +012200 06 TBL-LEVEL-0A PIC X(12) VALUE "5A4B3B2B1B0A".NC2064.2 +012300 06 TBL-LEVEL-0B PIC X(12) VALUE "5A4B3B2B1B0B".NC2064.2 +012400 06 TBL-LEVEL-0C PIC X(12) VALUE "5A4B3B2B1B0C".NC2064.2 +012500 01 TABLE-LEVEL-5B. NC2064.2 +012600 02 TABLE-LEVEL-4A. NC2064.2 +012700 03 TABLE-LEVEL-3A. NC2064.2 +012800 04 TABLE-LEVEL-2A. NC2064.2 +012900 05 TABLE-LEVEL-1A. NC2064.2 +013000 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +013100 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +013200 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +013300 05 TABLE-LEVEL-1B. NC2064.2 +013400 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +013500 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +013600 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +013700 04 TABLE-LEVEL-2B. NC2064.2 +013800 05 TABLE-LEVEL-1A. NC2064.2 +013900 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +014000 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +014100 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +014200 05 TABLE-LEVEL-1B. NC2064.2 +014300 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +014400 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +014500 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +014600 03 TABLE-LEVEL-3B. NC2064.2 +014700 04 TABLE-LEVEL-2A. NC2064.2 +014800 05 TABLE-LEVEL-1A. NC2064.2 +014900 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +015000 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +015100 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +015200 05 TABLE-LEVEL-1B. NC2064.2 +015300 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +015400 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +015500 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +015600 04 TABLE-LEVEL-2B. NC2064.2 +015700 05 TABLE-LEVEL-1A. NC2064.2 +015800 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +015900 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +016000 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +016100 05 TABLE-LEVEL-1B. NC2064.2 +016200 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +016300 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +016400 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +016500 02 TABLE-LEVEL-4B. NC2064.2 +016600 03 TABLE-LEVEL-3A. NC2064.2 +016700 04 TABLE-LEVEL-2A. NC2064.2 +016800 05 TABLE-LEVEL-1A. NC2064.2 +016900 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +017000 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +017100 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +017200 05 TABLE-LEVEL-1B. NC2064.2 +017300 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +017400 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +017500 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +017600 04 TABLE-LEVEL-2B. NC2064.2 +017700 05 TABLE-LEVEL-1A. NC2064.2 +017800 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +017900 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +018000 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +018100 05 TABLE-LEVEL-1B. NC2064.2 +018200 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +018300 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +018400 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +018500 03 TABLE-LEVEL-3B. NC2064.2 +018600 04 TABLE-LEVEL-2A. NC2064.2 +018700 05 TABLE-LEVEL-1A. NC2064.2 +018800 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +018900 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +019000 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +019100 05 TABLE-LEVEL-1B. NC2064.2 +019200 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +019300 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +019400 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +019500 04 TABLE-LEVEL-2B. NC2064.2 +019600 05 TABLE-LEVEL-1A. NC2064.2 +019700 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +019800 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +019900 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +020000 05 TABLE-LEVEL-1B. NC2064.2 +020100 06 TBL-LEVEL-0A PIC X VALUE SPACE. NC2064.2 +020200 06 TBL-LEVEL-0B PIC X VALUE SPACE. NC2064.2 +020300 06 TBL-LEVEL-0C PIC X VALUE SPACE. NC2064.2 +020400 01 QUAL-SUB-TABLE. NC2064.2 +020500 02 AX. NC2064.2 +020600 03 AX-1 OCCURS 5 TIMES. NC2064.2 +020700 04 AX-2 PIC X. NC2064.2 +020800 04 AX-3 PIC X. NC2064.2 +020900 02 BX. NC2064.2 +021000 03 AX-1 OCCURS 2 TIMES. NC2064.2 +021100 04 AX-2 PIC 9. NC2064.2 +021200 04 AX-3 PIC 9. NC2064.2 +021300 02 CX. NC2064.2 +021400 03 CX-SUB PIC 9 VALUE 2. NC2064.2 +021500 02 DX. NC2064.2 +021600 03 CX-SUB USAGE IS INDEX. NC2064.2 +021700 01 TEST-RESULTS. NC2064.2 +021800 02 FILLER PIC X VALUE SPACE. NC2064.2 +021900 02 FEATURE PIC X(20) VALUE SPACE. NC2064.2 +022000 02 FILLER PIC X VALUE SPACE. NC2064.2 +022100 02 P-OR-F PIC X(5) VALUE SPACE. NC2064.2 +022200 02 FILLER PIC X VALUE SPACE. NC2064.2 +022300 02 PAR-NAME. NC2064.2 +022400 03 FILLER PIC X(19) VALUE SPACE. NC2064.2 +022500 03 PARDOT-X PIC X VALUE SPACE. NC2064.2 +022600 03 DOTVALUE PIC 99 VALUE ZERO. NC2064.2 +022700 02 FILLER PIC X(8) VALUE SPACE. NC2064.2 +022800 02 RE-MARK PIC X(61). NC2064.2 +022900 01 TEST-COMPUTED. NC2064.2 +023000 02 FILLER PIC X(30) VALUE SPACE. NC2064.2 +023100 02 FILLER PIC X(17) VALUE NC2064.2 +023200 " COMPUTED=". NC2064.2 +023300 02 COMPUTED-X. NC2064.2 +023400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2064.2 +023500 03 COMPUTED-N REDEFINES COMPUTED-A NC2064.2 +023600 PIC -9(9).9(9). NC2064.2 +023700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2064.2 +023800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2064.2 +023900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2064.2 +024000 03 CM-18V0 REDEFINES COMPUTED-A. NC2064.2 +024100 04 COMPUTED-18V0 PIC -9(18). NC2064.2 +024200 04 FILLER PIC X. NC2064.2 +024300 03 FILLER PIC X(50) VALUE SPACE. NC2064.2 +024400 01 TEST-CORRECT. NC2064.2 +024500 02 FILLER PIC X(30) VALUE SPACE. NC2064.2 +024600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2064.2 +024700 02 CORRECT-X. NC2064.2 +024800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2064.2 +024900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2064.2 +025000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2064.2 +025100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2064.2 +025200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2064.2 +025300 03 CR-18V0 REDEFINES CORRECT-A. NC2064.2 +025400 04 CORRECT-18V0 PIC -9(18). NC2064.2 +025500 04 FILLER PIC X. NC2064.2 +025600 03 FILLER PIC X(2) VALUE SPACE. NC2064.2 +025700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2064.2 +025800 01 CCVS-C-1. NC2064.2 +025900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2064.2 +026000- "SS PARAGRAPH-NAME NC2064.2 +026100- " REMARKS". NC2064.2 +026200 02 FILLER PIC X(20) VALUE SPACE. NC2064.2 +026300 01 CCVS-C-2. NC2064.2 +026400 02 FILLER PIC X VALUE SPACE. NC2064.2 +026500 02 FILLER PIC X(6) VALUE "TESTED". NC2064.2 +026600 02 FILLER PIC X(15) VALUE SPACE. NC2064.2 +026700 02 FILLER PIC X(4) VALUE "FAIL". NC2064.2 +026800 02 FILLER PIC X(94) VALUE SPACE. NC2064.2 +026900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2064.2 +027000 01 REC-CT PIC 99 VALUE ZERO. NC2064.2 +027100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2064.2 +027200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2064.2 +027300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2064.2 +027400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2064.2 +027500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2064.2 +027600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2064.2 +027700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2064.2 +027800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2064.2 +027900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2064.2 +028000 01 CCVS-H-1. NC2064.2 +028100 02 FILLER PIC X(39) VALUE SPACES. NC2064.2 +028200 02 FILLER PIC X(42) VALUE NC2064.2 +028300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2064.2 +028400 02 FILLER PIC X(39) VALUE SPACES. NC2064.2 +028500 01 CCVS-H-2A. NC2064.2 +028600 02 FILLER PIC X(40) VALUE SPACE. NC2064.2 +028700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2064.2 +028800 02 FILLER PIC XXXX VALUE NC2064.2 +028900 "4.2 ". NC2064.2 +029000 02 FILLER PIC X(28) VALUE NC2064.2 +029100 " COPY - NOT FOR DISTRIBUTION". NC2064.2 +029200 02 FILLER PIC X(41) VALUE SPACE. NC2064.2 +029300 NC2064.2 +029400 01 CCVS-H-2B. NC2064.2 +029500 02 FILLER PIC X(15) VALUE NC2064.2 +029600 "TEST RESULT OF ". NC2064.2 +029700 02 TEST-ID PIC X(9). NC2064.2 +029800 02 FILLER PIC X(4) VALUE NC2064.2 +029900 " IN ". NC2064.2 +030000 02 FILLER PIC X(12) VALUE NC2064.2 +030100 " HIGH ". NC2064.2 +030200 02 FILLER PIC X(22) VALUE NC2064.2 +030300 " LEVEL VALIDATION FOR ". NC2064.2 +030400 02 FILLER PIC X(58) VALUE NC2064.2 +030500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2064.2 +030600 01 CCVS-H-3. NC2064.2 +030700 02 FILLER PIC X(34) VALUE NC2064.2 +030800 " FOR OFFICIAL USE ONLY ". NC2064.2 +030900 02 FILLER PIC X(58) VALUE NC2064.2 +031000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2064.2 +031100 02 FILLER PIC X(28) VALUE NC2064.2 +031200 " COPYRIGHT 1985 ". NC2064.2 +031300 01 CCVS-E-1. NC2064.2 +031400 02 FILLER PIC X(52) VALUE SPACE. NC2064.2 +031500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2064.2 +031600 02 ID-AGAIN PIC X(9). NC2064.2 +031700 02 FILLER PIC X(45) VALUE SPACES. NC2064.2 +031800 01 CCVS-E-2. NC2064.2 +031900 02 FILLER PIC X(31) VALUE SPACE. NC2064.2 +032000 02 FILLER PIC X(21) VALUE SPACE. NC2064.2 +032100 02 CCVS-E-2-2. NC2064.2 +032200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2064.2 +032300 03 FILLER PIC X VALUE SPACE. NC2064.2 +032400 03 ENDER-DESC PIC X(44) VALUE NC2064.2 +032500 "ERRORS ENCOUNTERED". NC2064.2 +032600 01 CCVS-E-3. NC2064.2 +032700 02 FILLER PIC X(22) VALUE NC2064.2 +032800 " FOR OFFICIAL USE ONLY". NC2064.2 +032900 02 FILLER PIC X(12) VALUE SPACE. NC2064.2 +033000 02 FILLER PIC X(58) VALUE NC2064.2 +033100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2064.2 +033200 02 FILLER PIC X(13) VALUE SPACE. NC2064.2 +033300 02 FILLER PIC X(15) VALUE NC2064.2 +033400 " COPYRIGHT 1985". NC2064.2 +033500 01 CCVS-E-4. NC2064.2 +033600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2064.2 +033700 02 FILLER PIC X(4) VALUE " OF ". NC2064.2 +033800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2064.2 +033900 02 FILLER PIC X(40) VALUE NC2064.2 +034000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2064.2 +034100 01 XXINFO. NC2064.2 +034200 02 FILLER PIC X(19) VALUE NC2064.2 +034300 "*** INFORMATION ***". NC2064.2 +034400 02 INFO-TEXT. NC2064.2 +034500 04 FILLER PIC X(8) VALUE SPACE. NC2064.2 +034600 04 XXCOMPUTED PIC X(20). NC2064.2 +034700 04 FILLER PIC X(5) VALUE SPACE. NC2064.2 +034800 04 XXCORRECT PIC X(20). NC2064.2 +034900 02 INF-ANSI-REFERENCE PIC X(48). NC2064.2 +035000 01 HYPHEN-LINE. NC2064.2 +035100 02 FILLER PIC IS X VALUE IS SPACE. NC2064.2 +035200 02 FILLER PIC IS X(65) VALUE IS "************************NC2064.2 +035300- "*****************************************". NC2064.2 +035400 02 FILLER PIC IS X(54) VALUE IS "************************NC2064.2 +035500- "******************************". NC2064.2 +035600 01 CCVS-PGM-ID PIC X(9) VALUE NC2064.2 +035700 "NC206A". NC2064.2 +035800 PROCEDURE DIVISION. NC2064.2 +035900 CCVS1 SECTION. NC2064.2 +036000 OPEN-FILES. NC2064.2 +036100 OPEN OUTPUT PRINT-FILE. NC2064.2 +036200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2064.2 +036300 MOVE SPACE TO TEST-RESULTS. NC2064.2 +036400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2064.2 +036500 GO TO CCVS1-EXIT. NC2064.2 +036600 CLOSE-FILES. NC2064.2 +036700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2064.2 +036800 TERMINATE-CCVS. NC2064.2 +036900*S EXIT PROGRAM. NC2064.2 +037000*SERMINATE-CALL. NC2064.2 +037100 STOP RUN. NC2064.2 +037200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2064.2 +037300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2064.2 +037400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2064.2 +037500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2064.2 +037600 MOVE "****TEST DELETED****" TO RE-MARK. NC2064.2 +037700 PRINT-DETAIL. NC2064.2 +037800 IF REC-CT NOT EQUAL TO ZERO NC2064.2 +037900 MOVE "." TO PARDOT-X NC2064.2 +038000 MOVE REC-CT TO DOTVALUE. NC2064.2 +038100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2064.2 +038200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2064.2 +038300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2064.2 +038400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2064.2 +038500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2064.2 +038600 MOVE SPACE TO CORRECT-X. NC2064.2 +038700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2064.2 +038800 MOVE SPACE TO RE-MARK. NC2064.2 +038900 HEAD-ROUTINE. NC2064.2 +039000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +039100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +039200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2064.2 +039300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2064.2 +039400 COLUMN-NAMES-ROUTINE. NC2064.2 +039500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +039600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +039700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +039800 END-ROUTINE. NC2064.2 +039900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2064.2 +040000 END-RTN-EXIT. NC2064.2 +040100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +040200 END-ROUTINE-1. NC2064.2 +040300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2064.2 +040400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2064.2 +040500 ADD PASS-COUNTER TO ERROR-HOLD. NC2064.2 +040600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2064.2 +040700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2064.2 +040800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2064.2 +040900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2064.2 +041000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2064.2 +041100 END-ROUTINE-12. NC2064.2 +041200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2064.2 +041300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2064.2 +041400 MOVE "NO " TO ERROR-TOTAL NC2064.2 +041500 ELSE NC2064.2 +041600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2064.2 +041700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2064.2 +041800 PERFORM WRITE-LINE. NC2064.2 +041900 END-ROUTINE-13. NC2064.2 +042000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2064.2 +042100 MOVE "NO " TO ERROR-TOTAL ELSE NC2064.2 +042200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2064.2 +042300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2064.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +042500 IF INSPECT-COUNTER EQUAL TO ZERO NC2064.2 +042600 MOVE "NO " TO ERROR-TOTAL NC2064.2 +042700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2064.2 +042800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2064.2 +042900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +043000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2064.2 +043100 WRITE-LINE. NC2064.2 +043200 ADD 1 TO RECORD-COUNT. NC2064.2 +043300 IF RECORD-COUNT GREATER 50 NC2064.2 +043400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2064.2 +043500 MOVE SPACE TO DUMMY-RECORD NC2064.2 +043600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2064.2 +043700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2064.2 +043800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2064.2 +043900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2064.2 +044000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2064.2 +044100 MOVE ZERO TO RECORD-COUNT. NC2064.2 +044200 PERFORM WRT-LN. NC2064.2 +044300 WRT-LN. NC2064.2 +044400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2064.2 +044500 MOVE SPACE TO DUMMY-RECORD. NC2064.2 +044600 BLANK-LINE-PRINT. NC2064.2 +044700 PERFORM WRT-LN. NC2064.2 +044800 FAIL-ROUTINE. NC2064.2 +044900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2064.2 +045000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2064.2 +045100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2064.2 +045200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2064.2 +045300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +045400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2064.2 +045500 GO TO FAIL-ROUTINE-EX. NC2064.2 +045600 FAIL-ROUTINE-WRITE. NC2064.2 +045700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2064.2 +045800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2064.2 +045900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2064.2 +046000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2064.2 +046100 FAIL-ROUTINE-EX. EXIT. NC2064.2 +046200 BAIL-OUT. NC2064.2 +046300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2064.2 +046400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2064.2 +046500 BAIL-OUT-WRITE. NC2064.2 +046600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2064.2 +046700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2064.2 +046800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2064.2 +046900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2064.2 +047000 BAIL-OUT-EX. EXIT. NC2064.2 +047100 CCVS1-EXIT. NC2064.2 +047200 EXIT. NC2064.2 +047300 SECT-NC206A-001 SECTION. NC2064.2 +047400 NC-06-001. NC2064.2 +047500* 5 LEVELS OF QUALIFICATION ARE USED IN ORDER TO MAKE THE NC2064.2 +047600* IDENTIFIERS UNIQUE. SEE THE 01 WORKING-STORAGE ENTRIES NC2064.2 +047700* CALLED TABLE-LEVEL-5A AND TABLE-LEVEL-5B. NC2064.2 +047800 QAL-INIT-F1-1. NC2064.2 +047900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +048000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +048100 MOVE "QAL-TEST-F1-1 " TO PAR-NAME. NC2064.2 +048200 QAL-TEST-F1-1. NC2064.2 +048300 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +048400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +048500 TO "5A4A3A2A1A0A" NC2064.2 +048600 PERFORM PASS NC2064.2 +048700 GO TO QAL-WRITE-F1-1. NC2064.2 +048800 GO TO QAL-FAIL-F1-1. NC2064.2 +048900 QAL-DELETE-F1-1. NC2064.2 +049000 PERFORM DE-LETE. NC2064.2 +049100 GO TO QAL-WRITE-F1-1. NC2064.2 +049200 QAL-FAIL-F1-1. NC2064.2 +049300 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +049400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +049500 COMPUTED-A. NC2064.2 +049600 MOVE "5A4A3A2A1A0A" TO CORRECT-A. NC2064.2 +049700 PERFORM FAIL. NC2064.2 +049800 QAL-WRITE-F1-1. NC2064.2 +049900 PERFORM PRINT-DETAIL. NC2064.2 +050000* NC2064.2 +050100 QAL-INIT-F1-2. NC2064.2 +050200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +050300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +050400 MOVE "QAL-TEST-F1-2 " TO PAR-NAME. NC2064.2 +050500 QAL-TEST-F1-2. NC2064.2 +050600 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +050700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +050800 TO "5A4A3A2A1B0A" NC2064.2 +050900 PERFORM PASS NC2064.2 +051000 GO TO QAL-WRITE-F1-2. NC2064.2 +051100 GO TO QAL-FAIL-F1-2. NC2064.2 +051200 QAL-DELETE-F1-2. NC2064.2 +051300 PERFORM DE-LETE. NC2064.2 +051400 GO TO QAL-WRITE-F1-2. NC2064.2 +051500 QAL-FAIL-F1-2. NC2064.2 +051600 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +051700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +051800 COMPUTED-A. NC2064.2 +051900 MOVE "5A4A3A2A1B0A" TO CORRECT-A. NC2064.2 +052000 PERFORM FAIL. NC2064.2 +052100 QAL-WRITE-F1-2. NC2064.2 +052200 PERFORM PRINT-DETAIL. NC2064.2 +052300* NC2064.2 +052400 QAL-INIT-F1-3. NC2064.2 +052500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +052600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +052700 MOVE "QAL-TEST-F1-3" TO PAR-NAME. NC2064.2 +052800 QAL-TEST-F1-3. NC2064.2 +052900 IF TBL-LEVEL-0A IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +053000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +053100 TO "5A4A3A2B1A0A" NC2064.2 +053200 PERFORM PASS NC2064.2 +053300 GO TO QAL-WRITE-F1-3. NC2064.2 +053400 GO TO QAL-FAIL-F1-3. NC2064.2 +053500 QAL-DELETE-F1-3. NC2064.2 +053600 PERFORM DE-LETE. NC2064.2 +053700 GO TO QAL-WRITE-F1-3. NC2064.2 +053800 QAL-FAIL-F1-3. NC2064.2 +053900 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +054000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +054100 COMPUTED-A. NC2064.2 +054200 MOVE "5A4A3A2B1A0A" TO CORRECT-A. NC2064.2 +054300 PERFORM FAIL. NC2064.2 +054400 QAL-WRITE-F1-3. NC2064.2 +054500 PERFORM PRINT-DETAIL. NC2064.2 +054600* NC2064.2 +054700 QAL-INIT-F1-4. NC2064.2 +054800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +054900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +055000 MOVE "QAL-TEST-F1-4 " TO PAR-NAME. NC2064.2 +055100 QAL-TEST-F1-4. NC2064.2 +055200 IF TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +055300 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +055400 TO "5A4A3A2B1B0A" NC2064.2 +055500 PERFORM PASS NC2064.2 +055600 GO TO QAL-WRITE-F1-4. NC2064.2 +055700 GO TO QAL-FAIL-F1-4. NC2064.2 +055800 QAL-DELETE-F1-4. NC2064.2 +055900 PERFORM DE-LETE. NC2064.2 +056000 GO TO QAL-WRITE-F1-4. NC2064.2 +056100 QAL-FAIL-F1-4. NC2064.2 +056200 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +056300 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +056400 COMPUTED-A. NC2064.2 +056500 MOVE "5A4A3A2B1B0A" TO CORRECT-A. NC2064.2 +056600 PERFORM FAIL. NC2064.2 +056700 QAL-WRITE-F1-4. NC2064.2 +056800 PERFORM PRINT-DETAIL. NC2064.2 +056900* NC2064.2 +057000 QAL-INIT-F1-5. NC2064.2 +057100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +057200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +057300 MOVE "QAL-TEST-F1-5 " TO PAR-NAME. NC2064.2 +057400 QAL-TEST-F1-5. NC2064.2 +057500 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +057600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +057700 TO "5A4A3B2A1A0A" NC2064.2 +057800 PERFORM PASS NC2064.2 +057900 GO TO QAL-WRITE-F1-5. NC2064.2 +058000 GO TO QAL-FAIL-F1-5. NC2064.2 +058100 QAL-DELETE-F1-5. NC2064.2 +058200 PERFORM DE-LETE. NC2064.2 +058300 GO TO QAL-WRITE-F1-5. NC2064.2 +058400 QAL-FAIL-F1-5. NC2064.2 +058500 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +058600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +058700 COMPUTED-A. NC2064.2 +058800 MOVE "5A4A3B2A1A0A" TO CORRECT-A. NC2064.2 +058900 PERFORM FAIL. NC2064.2 +059000 QAL-WRITE-F1-5. NC2064.2 +059100 PERFORM PRINT-DETAIL. NC2064.2 +059200* NC2064.2 +059300 QAL-INIT-F1-6. NC2064.2 +059400 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +059500 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +059600 MOVE "QAL-TEST-F1-6 " TO PAR-NAME. NC2064.2 +059700 QAL-TEST-F1-6. NC2064.2 +059800 IF TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +059900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +060000 TO "5A4A3B2A1B0A" NC2064.2 +060100 PERFORM PASS NC2064.2 +060200 GO TO QAL-WRITE-F1-6. NC2064.2 +060300 GO TO QAL-FAIL-F1-6. NC2064.2 +060400 QAL-DELETE-F1-6. NC2064.2 +060500 PERFORM DE-LETE. NC2064.2 +060600 GO TO QAL-WRITE-F1-6. NC2064.2 +060700 QAL-FAIL-F1-6. NC2064.2 +060800 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +060900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +061000 COMPUTED-A. NC2064.2 +061100 MOVE "5A4A3B2A1B0A" TO CORRECT-A. NC2064.2 +061200 PERFORM FAIL. NC2064.2 +061300 QAL-WRITE-F1-6. NC2064.2 +061400 PERFORM PRINT-DETAIL. NC2064.2 +061500* NC2064.2 +061600 QAL-INIT-F1-7. NC2064.2 +061700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +061800 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +061900 MOVE "QAL-TEST-F1-7 " TO PAR-NAME. NC2064.2 +062000 QAL-TEST-F1-7. NC2064.2 +062100 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +062200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +062300 TO "5A4A3B2B1A0A" NC2064.2 +062400 PERFORM PASS NC2064.2 +062500 GO TO QAL-WRITE-F1-7. NC2064.2 +062600 GO TO QAL-FAIL-F1-7. NC2064.2 +062700 QAL-DELETE-F1-7. NC2064.2 +062800 PERFORM DE-LETE. NC2064.2 +062900 GO TO QAL-WRITE-F1-7. NC2064.2 +063000 QAL-FAIL-F1-7. NC2064.2 +063100 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +063200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +063300 COMPUTED-A. NC2064.2 +063400 MOVE "5A4A3B2B1A0A" TO CORRECT-A. NC2064.2 +063500 PERFORM FAIL. NC2064.2 +063600 QAL-WRITE-F1-7. NC2064.2 +063700 PERFORM PRINT-DETAIL. NC2064.2 +063800* NC2064.2 +063900 QAL-INIT-F1-8. NC2064.2 +064000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +064100 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +064200 MOVE "QAL-TEST-F1-8 " TO PAR-NAME. NC2064.2 +064300 QAL-TEST-F1-8. NC2064.2 +064400 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +064500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +064600 TO "5A4A3B2B1B0A" NC2064.2 +064700 PERFORM PASS NC2064.2 +064800 GO TO QAL-WRITE-F1-8. NC2064.2 +064900 GO TO QAL-FAIL-F1-8. NC2064.2 +065000 QAL-DELETE-F1-8. NC2064.2 +065100 PERFORM DE-LETE. NC2064.2 +065200 GO TO QAL-WRITE-F1-8. NC2064.2 +065300 QAL-FAIL-F1-8. NC2064.2 +065400 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +065500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +065600 COMPUTED-A. NC2064.2 +065700 MOVE "5A4A3B2B1B0A" TO CORRECT-A. NC2064.2 +065800 PERFORM FAIL. NC2064.2 +065900 QAL-WRITE-F1-8. NC2064.2 +066000 PERFORM PRINT-DETAIL. NC2064.2 +066100* NC2064.2 +066200 QAL-INIT-F1-9. NC2064.2 +066300 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +066400 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +066500 MOVE "QAL-TEST-F1-9 " TO PAR-NAME. NC2064.2 +066600 QAL-TEST-F1-9. NC2064.2 +066700 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +066800 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +066900 TO "5A4B3A2A1A0A" NC2064.2 +067000 PERFORM PASS NC2064.2 +067100 GO TO QAL-WRITE-F1-9. NC2064.2 +067200 GO TO QAL-FAIL-F1-9. NC2064.2 +067300 QAL-DELETE-F1-9. NC2064.2 +067400 PERFORM DE-LETE. NC2064.2 +067500 GO TO QAL-WRITE-F1-9. NC2064.2 +067600 QAL-FAIL-F1-9. NC2064.2 +067700 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +067800 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +067900 COMPUTED-A. NC2064.2 +068000 MOVE "5A4B3A2A1A0A" TO CORRECT-A. NC2064.2 +068100 PERFORM FAIL. NC2064.2 +068200 QAL-WRITE-F1-9. NC2064.2 +068300 PERFORM PRINT-DETAIL. NC2064.2 +068400* NC2064.2 +068500 QAL-INIT-F1-10. NC2064.2 +068600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +068700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +068800 MOVE "QAL-TEST-F1-10 " TO PAR-NAME. NC2064.2 +068900 QAL-TEST-F1-10. NC2064.2 +069000 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +069100 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +069200 TO "5A4B3A2A1B0A" NC2064.2 +069300 PERFORM PASS NC2064.2 +069400 GO TO QAL-WRITE-F1-10. NC2064.2 +069500 GO TO QAL-FAIL-F1-10. NC2064.2 +069600 QAL-DELETE-F1-10. NC2064.2 +069700 PERFORM DE-LETE. NC2064.2 +069800 GO TO QAL-WRITE-F1-10. NC2064.2 +069900 QAL-FAIL-F1-10. NC2064.2 +070000 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +070100 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +070200 COMPUTED-A. NC2064.2 +070300 MOVE "5A4B3A2A1B0A" TO CORRECT-A. NC2064.2 +070400 PERFORM FAIL. NC2064.2 +070500 QAL-WRITE-F1-10. NC2064.2 +070600 PERFORM PRINT-DETAIL. NC2064.2 +070700* NC2064.2 +070800 QAL-INIT-F1-11. NC2064.2 +070900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +071000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +071100 MOVE "QAL-TEST-F1-11 " TO PAR-NAME. NC2064.2 +071200 QAL-TEST-F1-11. NC2064.2 +071300 IF TBL-LEVEL-0A IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +071400 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +071500 TO "5A4B3A2B1A0A" NC2064.2 +071600 PERFORM PASS NC2064.2 +071700 GO TO QAL-WRITE-F1-11. NC2064.2 +071800 GO TO QAL-FAIL-F1-11. NC2064.2 +071900 QAL-DELETE-F1-11. NC2064.2 +072000 PERFORM DE-LETE. NC2064.2 +072100 GO TO QAL-WRITE-F1-11. NC2064.2 +072200 QAL-FAIL-F1-11. NC2064.2 +072300 MOVE "5A4B3A2B1A0A" TO CORRECT-A. NC2064.2 +072400 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +072500 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +072600 COMPUTED-A. NC2064.2 +072700 PERFORM FAIL. NC2064.2 +072800 QAL-WRITE-F1-11. NC2064.2 +072900 PERFORM PRINT-DETAIL. NC2064.2 +073000* NC2064.2 +073100 QAL-INIT-F1-12. NC2064.2 +073200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +073300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +073400 MOVE "QAL-TEST-F1-12 " TO PAR-NAME. NC2064.2 +073500 QAL-TEST-F1-12. NC2064.2 +073600 IF TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +073700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +073800 TO "5A4B3A2B1B0A" NC2064.2 +073900 PERFORM PASS NC2064.2 +074000 GO TO QAL-WRITE-F1-12. NC2064.2 +074100 GO TO QAL-FAIL-F1-12. NC2064.2 +074200 QAL-DELETE-F1-12. NC2064.2 +074300 PERFORM DE-LETE. NC2064.2 +074400 GO TO QAL-WRITE-F1-12. NC2064.2 +074500 QAL-FAIL-F1-12. NC2064.2 +074600 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +074700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +074800 COMPUTED-A. NC2064.2 +074900 MOVE "5A4B3A2B1B0A" TO CORRECT-A. NC2064.2 +075000 PERFORM FAIL. NC2064.2 +075100 QAL-WRITE-F1-12. NC2064.2 +075200 PERFORM PRINT-DETAIL. NC2064.2 +075300* NC2064.2 +075400 QAL-INIT-F1-13. NC2064.2 +075500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +075600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +075700 MOVE "QAL-TEST-F1-13 " TO PAR-NAME. NC2064.2 +075800 QAL-TEST-F1-13. NC2064.2 +075900 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +076000 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +076100 TO "5A4B3B2A1A0A" NC2064.2 +076200 PERFORM PASS NC2064.2 +076300 GO TO QAL-WRITE-F1-13. NC2064.2 +076400 GO TO QAL-FAIL-F1-13. NC2064.2 +076500 QAL-DELETE-F1-13. NC2064.2 +076600 PERFORM DE-LETE. NC2064.2 +076700 GO TO QAL-WRITE-F1-13. NC2064.2 +076800 QAL-FAIL-F1-13. NC2064.2 +076900 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +077000 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2064.2 +077100 TO COMPUTED-A. NC2064.2 +077200 MOVE "5A4B3B2A1A0A" TO CORRECT-A. NC2064.2 +077300 PERFORM FAIL. NC2064.2 +077400 QAL-WRITE-F1-13. NC2064.2 +077500 PERFORM PRINT-DETAIL. NC2064.2 +077600* NC2064.2 +077700 QAL-INIT-F1-14. NC2064.2 +077800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +077900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +078000 MOVE "QAL-TEST-F1-14 " TO PAR-NAME. NC2064.2 +078100 QAL-TEST-F1-14. NC2064.2 +078200 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +078300 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +078400 TO "5A4B3B2A1B0A" NC2064.2 +078500 PERFORM PASS NC2064.2 +078600 GO TO QAL-WRITE-F1-14. NC2064.2 +078700 GO TO QAL-FAIL-F1-14. NC2064.2 +078800 QAL-DELETE-F1-14. NC2064.2 +078900 PERFORM DE-LETE. NC2064.2 +079000 GO TO QAL-WRITE-F1-14. NC2064.2 +079100 QAL-FAIL-F1-14. NC2064.2 +079200 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +079300 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +079400 COMPUTED-A. NC2064.2 +079500 MOVE "5A4B3B2A1B0A" TO CORRECT-A. NC2064.2 +079600 PERFORM FAIL. NC2064.2 +079700 QAL-WRITE-F1-14. NC2064.2 +079800 PERFORM PRINT-DETAIL. NC2064.2 +079900* NC2064.2 +080000 QAL-INIT-F1-15. NC2064.2 +080100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +080200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +080300 MOVE "QAL-TEST-F1-15 " TO PAR-NAME. NC2064.2 +080400 QAL-TEST-F1-15. NC2064.2 +080500 IF TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +080600 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +080700 TO "5A4B3B2B1A0A" NC2064.2 +080800 PERFORM PASS NC2064.2 +080900 GO TO QAL-WRITE-F1-15. NC2064.2 +081000 GO TO QAL-FAIL-F1-15. NC2064.2 +081100 QAL-DELETE-F1-15. NC2064.2 +081200 PERFORM DE-LETE. NC2064.2 +081300 GO TO QAL-WRITE-F1-15. NC2064.2 +081400 QAL-FAIL-F1-15. NC2064.2 +081500 MOVE "5A4B3B2B1A0A" TO CORRECT-A. NC2064.2 +081600 MOVE TBL-LEVEL-0A OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +081700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +081800 COMPUTED-A. NC2064.2 +081900 PERFORM FAIL. NC2064.2 +082000 QAL-WRITE-F1-15. NC2064.2 +082100 PERFORM PRINT-DETAIL. NC2064.2 +082200* NC2064.2 +082300 QAL-INIT-F1-16. NC2064.2 +082400 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +082500 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +082600 MOVE "QAL-TEST-F1-16 " TO PAR-NAME. NC2064.2 +082700 QAL-TEST-F1-16. NC2064.2 +082800 IF TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +082900 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +083000 TO "5A4B3B2B1B0A" NC2064.2 +083100 PERFORM PASS NC2064.2 +083200 GO TO QAL-WRITE-F1-16. NC2064.2 +083300 GO TO QAL-FAIL-F1-16. NC2064.2 +083400 QAL-DELETE-F1-16. NC2064.2 +083500 PERFORM DE-LETE. NC2064.2 +083600 GO TO QAL-WRITE-F1-16. NC2064.2 +083700 QAL-FAIL-F1-16. NC2064.2 +083800 MOVE TBL-LEVEL-0A IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +083900 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +084000 COMPUTED-A. NC2064.2 +084100 MOVE "5A4B3B2B1B0A" TO CORRECT-A. NC2064.2 +084200 PERFORM FAIL. NC2064.2 +084300 QAL-WRITE-F1-16. NC2064.2 +084400 PERFORM PRINT-DETAIL. NC2064.2 +084500* NC2064.2 +084600 QAL-INIT-F1-17. NC2064.2 +084700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +084800 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +084900 MOVE "QAL-TEST-F1-17" TO PAR-NAME. NC2064.2 +085000 QAL-TEST-F1-17. NC2064.2 +085100 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +085200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +085300 TO "5A4A3A2A1A0B" NC2064.2 +085400 PERFORM PASS NC2064.2 +085500 GO TO QAL-WRITE-F1-17. NC2064.2 +085600 GO TO QAL-FAIL-F1-17. NC2064.2 +085700 QAL-DELETE-F1-17. NC2064.2 +085800 PERFORM DE-LETE. NC2064.2 +085900 GO TO QAL-WRITE-F1-17. NC2064.2 +086000 QAL-FAIL-F1-17. NC2064.2 +086100 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +086200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +086300 COMPUTED-A. NC2064.2 +086400 MOVE "5A4A3A2A1A0B" TO CORRECT-A. NC2064.2 +086500 PERFORM FAIL. NC2064.2 +086600 QAL-WRITE-F1-17. NC2064.2 +086700 PERFORM PRINT-DETAIL. NC2064.2 +086800* NC2064.2 +086900 QAL-INIT-F1-18. NC2064.2 +087000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +087100 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +087200 MOVE "QAL-TEST-F1-18" TO PAR-NAME. NC2064.2 +087300 QAL-TEST-F1-18. NC2064.2 +087400 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +087500 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +087600 TO "5A4A3A2A1B0B" NC2064.2 +087700 PERFORM PASS NC2064.2 +087800 GO TO QAL-WRITE-F1-18. NC2064.2 +087900 GO TO QAL-FAIL-F1-18. NC2064.2 +088000 QAL-DELETE-F1-18. NC2064.2 +088100 PERFORM DE-LETE. NC2064.2 +088200 GO TO QAL-WRITE-F1-18. NC2064.2 +088300 QAL-FAIL-F1-18. NC2064.2 +088400 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +088500 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +088600 COMPUTED-A. NC2064.2 +088700 MOVE "5A4A3A2A1B0B" TO CORRECT-A. NC2064.2 +088800 PERFORM FAIL. NC2064.2 +088900 QAL-WRITE-F1-18. NC2064.2 +089000 PERFORM PRINT-DETAIL. NC2064.2 +089100* NC2064.2 +089200 QAL-INIT-F1-19. NC2064.2 +089300 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +089400 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +089500 MOVE "QAL-TEST-F1-19" TO PAR-NAME. NC2064.2 +089600 QAL-TEST-F1-19. NC2064.2 +089700 IF TBL-LEVEL-0B IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +089800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +089900 TO "5A4A3A2B1A0B" NC2064.2 +090000 PERFORM PASS NC2064.2 +090100 GO TO QAL-WRITE-F1-19. NC2064.2 +090200 GO TO QAL-FAIL-F1-19. NC2064.2 +090300 QAL-DELETE-F1-19. NC2064.2 +090400 PERFORM DE-LETE. NC2064.2 +090500 GO TO QAL-WRITE-F1-19. NC2064.2 +090600 QAL-FAIL-F1-19. NC2064.2 +090700 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +090800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +090900 COMPUTED-A. NC2064.2 +091000 MOVE "5A4A3A2B1A0B" TO CORRECT-A. NC2064.2 +091100 PERFORM FAIL. NC2064.2 +091200 QAL-WRITE-F1-19. NC2064.2 +091300 PERFORM PRINT-DETAIL. NC2064.2 +091400* NC2064.2 +091500 QAL-INIT-F1-20. NC2064.2 +091600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +091700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +091800 MOVE "QAL-TEST-F1-20" TO PAR-NAME. NC2064.2 +091900 QAL-TEST-F1-20. NC2064.2 +092000 IF TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +092100 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +092200 TO "5A4A3A2B1B0B" NC2064.2 +092300 PERFORM PASS NC2064.2 +092400 GO TO QAL-WRITE-F1-20. NC2064.2 +092500 GO TO QAL-FAIL-F1-20. NC2064.2 +092600 QAL-DELETE-F1-20. NC2064.2 +092700 PERFORM DE-LETE. NC2064.2 +092800 GO TO QAL-WRITE-F1-20. NC2064.2 +092900 QAL-FAIL-F1-20. NC2064.2 +093000 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +093100 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +093200 COMPUTED-A. NC2064.2 +093300 MOVE "5A4A3A2B1B0B" TO CORRECT-A. NC2064.2 +093400 PERFORM FAIL. NC2064.2 +093500 QAL-WRITE-F1-20. NC2064.2 +093600 PERFORM PRINT-DETAIL. NC2064.2 +093700* NC2064.2 +093800 QAL-INIT-F1-21. NC2064.2 +093900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +094000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +094100 MOVE "QAL-TEST-F1-21" TO PAR-NAME. NC2064.2 +094200 QAL-TEST-F1-21. NC2064.2 +094300 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +094400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +094500 TO "5A4A3B2A1A0B" NC2064.2 +094600 PERFORM PASS NC2064.2 +094700 GO TO QAL-WRITE-F1-21. NC2064.2 +094800 GO TO QAL-FAIL-F1-21. NC2064.2 +094900 QAL-DELETE-F1-21. NC2064.2 +095000 PERFORM DE-LETE. NC2064.2 +095100 GO TO QAL-WRITE-F1-21. NC2064.2 +095200 QAL-FAIL-F1-21. NC2064.2 +095300 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +095400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +095500 COMPUTED-A. NC2064.2 +095600 MOVE "5A4A3B2A1A0B" TO CORRECT-A. NC2064.2 +095700 PERFORM FAIL. NC2064.2 +095800 QAL-WRITE-F1-21. NC2064.2 +095900 PERFORM PRINT-DETAIL. NC2064.2 +096000* NC2064.2 +096100 QAL-INIT-F1-22. NC2064.2 +096200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +096300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +096400 MOVE "QAL-TEST-F1-22" TO PAR-NAME. NC2064.2 +096500 QAL-TEST-F1-22. NC2064.2 +096600 IF TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +096700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +096800 TO "5A4A3B2A1B0B" NC2064.2 +096900 PERFORM PASS NC2064.2 +097000 GO TO QAL-WRITE-F1-22. NC2064.2 +097100 GO TO QAL-FAIL-F1-22. NC2064.2 +097200 QAL-DELETE-F1-22. NC2064.2 +097300 PERFORM DE-LETE. NC2064.2 +097400 GO TO QAL-WRITE-F1-22. NC2064.2 +097500 QAL-FAIL-F1-22. NC2064.2 +097600 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +097700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +097800 COMPUTED-A. NC2064.2 +097900 MOVE "5A4A3B2A1B0B" TO CORRECT-A. NC2064.2 +098000 PERFORM FAIL. NC2064.2 +098100 QAL-WRITE-F1-22. NC2064.2 +098200 PERFORM PRINT-DETAIL. NC2064.2 +098300* NC2064.2 +098400 QAL-INIT-F1-23. NC2064.2 +098500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +098600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +098700 MOVE "QAL-TEST-F1-23" TO PAR-NAME. NC2064.2 +098800 QAL-TEST-F1-23. NC2064.2 +098900 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +099000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +099100 TO "5A4A3B2B1A0B" NC2064.2 +099200 PERFORM PASS NC2064.2 +099300 GO TO QAL-WRITE-F1-23. NC2064.2 +099400 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +099500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +099600 COMPUTED-A. NC2064.2 +099700 MOVE "5A4A3B2B1A0B" TO CORRECT-A. NC2064.2 +099800 PERFORM FAIL. NC2064.2 +099900 GO TO QAL-WRITE-F1-23. NC2064.2 +100000 QAL-DELETE-F1-23. NC2064.2 +100100 PERFORM DE-LETE. NC2064.2 +100200 QAL-WRITE-F1-23. NC2064.2 +100300 PERFORM PRINT-DETAIL. NC2064.2 +100400* NC2064.2 +100500 QAL-INIT-F1-24. NC2064.2 +100600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +100700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +100800 MOVE "QAL-TEST-F1-24" TO PAR-NAME. NC2064.2 +100900 QAL-TEST-F1-24. NC2064.2 +101000 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +101100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +101200 TO "5A4A3B2B1B0B" NC2064.2 +101300 PERFORM PASS NC2064.2 +101400 GO TO QAL-WRITE-F1-24. NC2064.2 +101500 GO TO QAL-FAIL-F1-24. NC2064.2 +101600 QAL-DELETE-F1-24. NC2064.2 +101700 PERFORM DE-LETE. NC2064.2 +101800 GO TO QAL-WRITE-F1-24. NC2064.2 +101900 QAL-FAIL-F1-24. NC2064.2 +102000 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +102100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +102200 COMPUTED-A. NC2064.2 +102300 MOVE "5A4A3B2B1B0B" TO CORRECT-A. NC2064.2 +102400 PERFORM FAIL. NC2064.2 +102500 QAL-WRITE-F1-24. NC2064.2 +102600 PERFORM PRINT-DETAIL. NC2064.2 +102700* NC2064.2 +102800 QAL-INIT-F1-25. NC2064.2 +102900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +103000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +103100 MOVE "QAL-TEST-F1-25" TO PAR-NAME. NC2064.2 +103200 QAL-TEST-F1-25. NC2064.2 +103300 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +103400 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +103500 TO "5A4B3A2A1A0B" NC2064.2 +103600 PERFORM PASS NC2064.2 +103700 GO TO QAL-WRITE-F1-25. NC2064.2 +103800 GO TO QAL-FAIL-F1-25. NC2064.2 +103900 QAL-DELETE-F1-25. NC2064.2 +104000 PERFORM DE-LETE. NC2064.2 +104100 GO TO QAL-WRITE-F1-25. NC2064.2 +104200 QAL-FAIL-F1-25. NC2064.2 +104300 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +104400 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +104500 COMPUTED-A. NC2064.2 +104600 MOVE "5A4B3A2A1A0B" TO CORRECT-A. NC2064.2 +104700 PERFORM FAIL. NC2064.2 +104800 QAL-WRITE-F1-25. NC2064.2 +104900 PERFORM PRINT-DETAIL. NC2064.2 +105000* NC2064.2 +105100 QAL-INIT-F1-26. NC2064.2 +105200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +105300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +105400 MOVE "QAL-TEST-F1-26" TO PAR-NAME. NC2064.2 +105500 QAL-TEST-F1-26. NC2064.2 +105600 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +105700 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +105800 TO "5A4B3A2A1B0B" NC2064.2 +105900 PERFORM PASS NC2064.2 +106000 GO TO QAL-WRITE-F1-26. NC2064.2 +106100 GO TO QAL-FAIL-F1-26. NC2064.2 +106200 QAL-DELETE-F1-26. NC2064.2 +106300 PERFORM DE-LETE. NC2064.2 +106400 GO TO QAL-WRITE-F1-26. NC2064.2 +106500 QAL-FAIL-F1-26. NC2064.2 +106600 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +106700 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +106800 COMPUTED-A. NC2064.2 +106900 MOVE "5A4B3A2A1B0B" TO CORRECT-A. NC2064.2 +107000 PERFORM FAIL. NC2064.2 +107100 QAL-WRITE-F1-26. NC2064.2 +107200 PERFORM PRINT-DETAIL. NC2064.2 +107300* NC2064.2 +107400 QAL-INIT-F1-27. NC2064.2 +107500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +107600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +107700 MOVE "QAL-TEST-F1-27" TO PAR-NAME. NC2064.2 +107800 QAL-TEST-F1-27. NC2064.2 +107900 IF TBL-LEVEL-0B IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +108000 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +108100 TO "5A4B3A2B1A0B" NC2064.2 +108200 PERFORM PASS NC2064.2 +108300 GO TO QAL-WRITE-F1-27. NC2064.2 +108400 GO TO QAL-FAIL-F1-27. NC2064.2 +108500 QAL-DELETE-F1-27. NC2064.2 +108600 PERFORM DE-LETE. NC2064.2 +108700 GO TO QAL-WRITE-F1-27. NC2064.2 +108800 QAL-FAIL-F1-27. NC2064.2 +108900 MOVE "5A4B3A2B1A0B" TO CORRECT-A. NC2064.2 +109000 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +109100 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +109200 COMPUTED-A. NC2064.2 +109300 PERFORM FAIL. NC2064.2 +109400 QAL-WRITE-F1-27. NC2064.2 +109500 PERFORM PRINT-DETAIL. NC2064.2 +109600* NC2064.2 +109700 QAL-INIT-F1-28. NC2064.2 +109800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +109900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +110000 MOVE "QAL-TEST-F1-28" TO PAR-NAME. NC2064.2 +110100 QAL-TEST-F1-28. NC2064.2 +110200 IF TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +110300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +110400 TO "5A4B3A2B1B0B" NC2064.2 +110500 PERFORM PASS NC2064.2 +110600 GO TO QAL-WRITE-F1-28. NC2064.2 +110700 GO TO QAL-FAIL-F1-28. NC2064.2 +110800 QAL-DELETE-F1-28. NC2064.2 +110900 PERFORM DE-LETE. NC2064.2 +111000 GO TO QAL-WRITE-F1-28. NC2064.2 +111100 QAL-FAIL-F1-28. NC2064.2 +111200 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +111300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +111400 COMPUTED-A. NC2064.2 +111500 MOVE "5A4B3A2B1B0B" TO CORRECT-A. NC2064.2 +111600 PERFORM FAIL. NC2064.2 +111700 QAL-WRITE-F1-28. NC2064.2 +111800 PERFORM PRINT-DETAIL. NC2064.2 +111900* NC2064.2 +112000 QAL-INIT-F1-29. NC2064.2 +112100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +112200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +112300 MOVE "QAL-TEST-F1-29" TO PAR-NAME. NC2064.2 +112400 QAL-TEST-F1-29. NC2064.2 +112500 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +112600 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +112700 TO "5A4B3B2A1A0B" NC2064.2 +112800 PERFORM PASS NC2064.2 +112900 GO TO QAL-WRITE-F1-29. NC2064.2 +113000 GO TO QAL-FAIL-F1-29. NC2064.2 +113100 QAL-DELETE-F1-29. NC2064.2 +113200 PERFORM DE-LETE. NC2064.2 +113300 GO TO QAL-WRITE-F1-29. NC2064.2 +113400 QAL-FAIL-F1-29. NC2064.2 +113500 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +113600 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2064.2 +113700 TO COMPUTED-A. NC2064.2 +113800 MOVE "5A4B3B2A1A0B" TO CORRECT-A. NC2064.2 +113900 PERFORM FAIL. NC2064.2 +114000 QAL-WRITE-F1-29. NC2064.2 +114100 PERFORM PRINT-DETAIL. NC2064.2 +114200* NC2064.2 +114300 QAL-INIT-F1-30. NC2064.2 +114400 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +114500 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +114600 MOVE "QAL-TEST-F1-30" TO PAR-NAME. NC2064.2 +114700 QAL-TEST-F1-30. NC2064.2 +114800 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +114900 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +115000 TO "5A4B3B2A1B0B" NC2064.2 +115100 PERFORM PASS NC2064.2 +115200 GO TO QAL-WRITE-F1-30. NC2064.2 +115300 GO TO QAL-FAIL-F1-30. NC2064.2 +115400 QAL-DELETE-F1-30. NC2064.2 +115500 PERFORM DE-LETE. NC2064.2 +115600 GO TO QAL-WRITE-F1-30. NC2064.2 +115700 QAL-FAIL-F1-30. NC2064.2 +115800 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +115900 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +116000 COMPUTED-A. NC2064.2 +116100 MOVE "5A4B3B2A1B0B" TO CORRECT-A. NC2064.2 +116200 PERFORM FAIL. NC2064.2 +116300 QAL-WRITE-F1-30. NC2064.2 +116400 PERFORM PRINT-DETAIL. NC2064.2 +116500* NC2064.2 +116600 QAL-INIT-F1-31. NC2064.2 +116700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +116800 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +116900 MOVE "QAL-TEST-F1-31" TO PAR-NAME. NC2064.2 +117000 QAL-TEST-F1-31. NC2064.2 +117100 IF TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +117200 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +117300 TO "5A4B3B2B1A0B" NC2064.2 +117400 PERFORM PASS NC2064.2 +117500 GO TO QAL-WRITE-F1-31. NC2064.2 +117600 GO TO QAL-FAIL-F1-31. NC2064.2 +117700 QAL-DELETE-F1-31. NC2064.2 +117800 PERFORM DE-LETE. NC2064.2 +117900 GO TO QAL-WRITE-F1-31. NC2064.2 +118000 QAL-FAIL-F1-31. NC2064.2 +118100 MOVE "5A4B3B2B1A0B" TO CORRECT-A. NC2064.2 +118200 MOVE TBL-LEVEL-0B OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +118300 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +118400 COMPUTED-A. NC2064.2 +118500 PERFORM FAIL. NC2064.2 +118600 QAL-WRITE-F1-31. NC2064.2 +118700 PERFORM PRINT-DETAIL. NC2064.2 +118800* NC2064.2 +118900 QAL-INIT-F1-32. NC2064.2 +119000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +119100 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +119200 MOVE "QAL-TEST-F1-32" TO PAR-NAME. NC2064.2 +119300 QAL-TEST-F1-32. NC2064.2 +119400 IF TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +119500 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +119600 TO "5A4B3B2B1B0B" NC2064.2 +119700 PERFORM PASS NC2064.2 +119800 GO TO QAL-WRITE-F1-32. NC2064.2 +119900 GO TO QAL-FAIL-F1-32. NC2064.2 +120000 QAL-DELETE-F1-32. NC2064.2 +120100 PERFORM DE-LETE. NC2064.2 +120200 GO TO QAL-WRITE-F1-32. NC2064.2 +120300 QAL-FAIL-F1-32. NC2064.2 +120400 MOVE TBL-LEVEL-0B IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +120500 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +120600 COMPUTED-A. NC2064.2 +120700 MOVE "5A4B3B2B1B0B" TO CORRECT-A. NC2064.2 +120800 PERFORM FAIL. NC2064.2 +120900 QAL-WRITE-F1-32. NC2064.2 +121000 PERFORM PRINT-DETAIL. NC2064.2 +121100* NC2064.2 +121200 QAL-INIT-F1-33. NC2064.2 +121300 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +121400 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +121500 MOVE "QAL-TEST-F1-33" TO PAR-NAME. NC2064.2 +121600 QAL-TEST-F1-33. NC2064.2 +121700 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +121800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +121900 TO "5A4A3A2A1A0C" NC2064.2 +122000 PERFORM PASS NC2064.2 +122100 GO TO QAL-WRITE-F1-33. NC2064.2 +122200 GO TO QAL-FAIL-F1-33. NC2064.2 +122300 QAL-DELETE-F1-33. NC2064.2 +122400 PERFORM DE-LETE. NC2064.2 +122500 GO TO QAL-WRITE-F1-33. NC2064.2 +122600 QAL-FAIL-F1-33. NC2064.2 +122700 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +122800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +122900 COMPUTED-A. NC2064.2 +123000 MOVE "5A4A3A2A1A0C" TO CORRECT-A. NC2064.2 +123100 PERFORM FAIL. NC2064.2 +123200 QAL-WRITE-F1-33. NC2064.2 +123300 PERFORM PRINT-DETAIL. NC2064.2 +123400* NC2064.2 +123500 QAL-INIT-F1-34. NC2064.2 +123600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +123700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +123800 MOVE "QAL-TEST-F1-34" TO PAR-NAME. NC2064.2 +123900 QAL-TEST-F1-34. NC2064.2 +124000 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +124100 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +124200 TO "5A4A3A2A1B0C" NC2064.2 +124300 PERFORM PASS NC2064.2 +124400 GO TO QAL-WRITE-F1-34. NC2064.2 +124500 GO TO QAL-FAIL-F1-34. NC2064.2 +124600 QAL-DELETE-F1-34. NC2064.2 +124700 PERFORM DE-LETE. NC2064.2 +124800 GO TO QAL-WRITE-F1-34. NC2064.2 +124900 QAL-FAIL-F1-34. NC2064.2 +125000 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +125100 TABLE-LEVEL-3A OF TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +125200 COMPUTED-A. NC2064.2 +125300 MOVE "5A4A3A2A1B0C" TO CORRECT-A. NC2064.2 +125400 PERFORM FAIL. NC2064.2 +125500 QAL-WRITE-F1-34. NC2064.2 +125600 PERFORM PRINT-DETAIL. NC2064.2 +125700* NC2064.2 +125800 QAL-INIT-F1-35. NC2064.2 +125900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +126000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +126100 MOVE "QAL-TEST-F1-35" TO PAR-NAME. NC2064.2 +126200 QAL-TEST-F1-35. NC2064.2 +126300 IF TBL-LEVEL-0C IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +126400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +126500 TO "5A4A3A2B1A0C" NC2064.2 +126600 PERFORM PASS NC2064.2 +126700 GO TO QAL-WRITE-F1-35. NC2064.2 +126800 GO TO QAL-FAIL-F1-35. NC2064.2 +126900 QAL-DELETE-F1-35. NC2064.2 +127000 PERFORM DE-LETE. NC2064.2 +127100 GO TO QAL-WRITE-F1-35. NC2064.2 +127200 QAL-FAIL-F1-35. NC2064.2 +127300 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +127400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +127500 COMPUTED-A. NC2064.2 +127600 MOVE "5A4A3A2B1A0C" TO CORRECT-A. NC2064.2 +127700 PERFORM FAIL. NC2064.2 +127800 QAL-WRITE-F1-35. NC2064.2 +127900 PERFORM PRINT-DETAIL. NC2064.2 +128000* NC2064.2 +128100 QAL-INIT-F1-36. NC2064.2 +128200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +128300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +128400 MOVE "QAL-TEST-F1-36" TO PAR-NAME. NC2064.2 +128500 QAL-TEST-F1-36. NC2064.2 +128600 IF TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +128700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +128800 TO "5A4A3A2B1B0C" NC2064.2 +128900 PERFORM PASS NC2064.2 +129000 GO TO QAL-WRITE-F1-36. NC2064.2 +129100 GO TO QAL-FAIL-F1-36. NC2064.2 +129200 QAL-DELETE-F1-36. NC2064.2 +129300 PERFORM DE-LETE. NC2064.2 +129400 GO TO QAL-WRITE-F1-36. NC2064.2 +129500 QAL-FAIL-F1-36. NC2064.2 +129600 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +129700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +129800 COMPUTED-A. NC2064.2 +129900 MOVE "5A4A3A2B1B0C" TO CORRECT-A. NC2064.2 +130000 PERFORM FAIL. NC2064.2 +130100 QAL-WRITE-F1-36. NC2064.2 +130200 PERFORM PRINT-DETAIL. NC2064.2 +130300* NC2064.2 +130400 QAL-INIT-F1-37. NC2064.2 +130500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +130600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +130700 MOVE "QAL-TEST-F1-37" TO PAR-NAME. NC2064.2 +130800 QAL-TEST-F1-37. NC2064.2 +130900 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +131000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +131100 TO "5A4A3B2A1A0C" NC2064.2 +131200 PERFORM PASS NC2064.2 +131300 GO TO QAL-WRITE-F1-37. NC2064.2 +131400 GO TO QAL-FAIL-F1-37. NC2064.2 +131500 QAL-DELETE-F1-37. NC2064.2 +131600 PERFORM DE-LETE. NC2064.2 +131700 GO TO QAL-WRITE-F1-37. NC2064.2 +131800 QAL-FAIL-F1-37. NC2064.2 +131900 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +132000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +132100 COMPUTED-A. NC2064.2 +132200 MOVE "5A4A3B2A1A0C" TO CORRECT-A. NC2064.2 +132300 PERFORM FAIL. NC2064.2 +132400 QAL-WRITE-F1-37. NC2064.2 +132500 PERFORM PRINT-DETAIL. NC2064.2 +132600* NC2064.2 +132700 QAL-INIT-F1-38. NC2064.2 +132800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +132900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +133000 MOVE "QAL-TEST-F1-38" TO PAR-NAME. NC2064.2 +133100 QAL-TEST-F1-38. NC2064.2 +133200 IF TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +133300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +133400 TO "5A4A3B2A1B0C" NC2064.2 +133500 PERFORM PASS NC2064.2 +133600 GO TO QAL-WRITE-F1-38. NC2064.2 +133700 GO TO QAL-FAIL-F1-38. NC2064.2 +133800 QAL-DELETE-F1-38. NC2064.2 +133900 PERFORM DE-LETE. NC2064.2 +134000 GO TO QAL-WRITE-F1-38. NC2064.2 +134100 QAL-FAIL-F1-38. NC2064.2 +134200 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2064.2 +134300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +134400 COMPUTED-A. NC2064.2 +134500 MOVE "5A4A3B2A1B0C" TO CORRECT-A. NC2064.2 +134600 PERFORM FAIL. NC2064.2 +134700 QAL-WRITE-F1-38. NC2064.2 +134800 PERFORM PRINT-DETAIL. NC2064.2 +134900* NC2064.2 +135000 QAL-INIT-F1-39. NC2064.2 +135100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +135200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +135300 MOVE "QAL-TEST-F1-39" TO PAR-NAME. NC2064.2 +135400 QAL-TEST-F1-39. NC2064.2 +135500 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +135600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A EQUAL NC2064.2 +135700 TO "5A4A3B2B1A0C" NC2064.2 +135800 PERFORM PASS NC2064.2 +135900 GO TO QAL-WRITE-F1-39. NC2064.2 +136000 GO TO QAL-FAIL-F1-39. NC2064.2 +136100 QAL-DELETE-F1-39. NC2064.2 +136200 PERFORM DE-LETE. NC2064.2 +136300 GO TO QAL-WRITE-F1-39. NC2064.2 +136400 QAL-FAIL-F1-39. NC2064.2 +136500 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2064.2 +136600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2064.2 +136700 COMPUTED-A. NC2064.2 +136800 MOVE "5A4A3B2B1A0C" TO CORRECT-A. NC2064.2 +136900 PERFORM FAIL. NC2064.2 +137000 QAL-WRITE-F1-39. NC2064.2 +137100 PERFORM PRINT-DETAIL. NC2064.2 +137200* NC2064.2 +137300 QAL-INIT-F1-40. NC2064.2 +137400 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +137500 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +137600 MOVE "QAL-TEST-F1-40" TO PAR-NAME. NC2064.2 +137700 QAL-TEST-F1-40. NC2064.2 +137800 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +137900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A EQUAL NC2064.2 +138000 TO "5A4A3B2B1B0C" NC2064.2 +138100 PERFORM PASS NC2064.2 +138200 GO TO QAL-WRITE-F1-40. NC2064.2 +138300 GO TO QAL-FAIL-F1-40. NC2064.2 +138400 QAL-DELETE-F1-40. NC2064.2 +138500 PERFORM DE-LETE. NC2064.2 +138600 GO TO QAL-WRITE-F1-40. NC2064.2 +138700 QAL-FAIL-F1-40. NC2064.2 +138800 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2064.2 +138900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2064.2 +139000 COMPUTED-A. NC2064.2 +139100 MOVE "5A4A3B2B1B0C" TO CORRECT-A. NC2064.2 +139200 PERFORM FAIL. NC2064.2 +139300 QAL-WRITE-F1-40. NC2064.2 +139400 PERFORM PRINT-DETAIL. NC2064.2 +139500* NC2064.2 +139600 QAL-INIT-F1-41. NC2064.2 +139700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +139800 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +139900 MOVE "QAL-TEST-F1-41" TO PAR-NAME. NC2064.2 +140000 QAL-TEST-F1-41. NC2064.2 +140100 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2064.2 +140200 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +140300 TO "5A4B3A2A1A0C" NC2064.2 +140400 PERFORM PASS NC2064.2 +140500 GO TO QAL-WRITE-F1-41. NC2064.2 +140600 GO TO QAL-FAIL-F1-41. NC2064.2 +140700 QAL-DELETE-F1-41. NC2064.2 +140800 PERFORM DE-LETE. NC2064.2 +140900 GO TO QAL-WRITE-F1-41. NC2064.2 +141000 QAL-FAIL-F1-41. NC2064.2 +141100 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +141200 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +141300 COMPUTED-A. NC2064.2 +141400 MOVE "5A4B3A2A1A0C" TO CORRECT-A. NC2064.2 +141500 PERFORM FAIL. NC2064.2 +141600 QAL-WRITE-F1-41. NC2064.2 +141700 PERFORM PRINT-DETAIL. NC2064.2 +141800* NC2064.2 +141900 QAL-INIT-F1-42. NC2064.2 +142000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +142100 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +142200 MOVE "QAL-TEST-F1-42" TO PAR-NAME. NC2064.2 +142300 QAL-TEST-F1-42. NC2064.2 +142400 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +142500 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +142600 TO "5A4B3A2A1B0C" NC2064.2 +142700 PERFORM PASS NC2064.2 +142800 GO TO QAL-WRITE-F1-42. NC2064.2 +142900 GO TO QAL-FAIL-F1-42. NC2064.2 +143000 QAL-DELETE-F1-42. NC2064.2 +143100 PERFORM DE-LETE. NC2064.2 +143200 GO TO QAL-WRITE-F1-42. NC2064.2 +143300 QAL-FAIL-F1-42. NC2064.2 +143400 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2064.2 +143500 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +143600 COMPUTED-A. NC2064.2 +143700 MOVE "5A4B3A2A1B0C" TO CORRECT-A. NC2064.2 +143800 PERFORM FAIL. NC2064.2 +143900 QAL-WRITE-F1-42. NC2064.2 +144000 PERFORM PRINT-DETAIL. NC2064.2 +144100* NC2064.2 +144200 QAL-INIT-F1-43. NC2064.2 +144300 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +144400 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +144500 MOVE "QAL-TEST-F1-43" TO PAR-NAME. NC2064.2 +144600 QAL-TEST-F1-43. NC2064.2 +144700 IF TBL-LEVEL-0C IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +144800 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +144900 TO "5A4B3A2B1A0C" NC2064.2 +145000 PERFORM PASS NC2064.2 +145100 GO TO QAL-WRITE-F1-43. NC2064.2 +145200 GO TO QAL-FAIL-F1-43. NC2064.2 +145300 QAL-DELETE-F1-43. NC2064.2 +145400 PERFORM DE-LETE. NC2064.2 +145500 GO TO QAL-WRITE-F1-43. NC2064.2 +145600 QAL-FAIL-F1-43. NC2064.2 +145700 MOVE "5A4B3A2B1A0C" TO CORRECT-A. NC2064.2 +145800 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2064.2 +145900 TABLE-LEVEL-3A OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +146000 COMPUTED-A. NC2064.2 +146100 PERFORM FAIL. NC2064.2 +146200 QAL-WRITE-F1-43. NC2064.2 +146300 PERFORM PRINT-DETAIL. NC2064.2 +146400* NC2064.2 +146500 QAL-INIT-F1-44. NC2064.2 +146600 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +146700 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +146800 MOVE "QAL-TEST-F1-44" TO PAR-NAME. NC2064.2 +146900 QAL-TEST-F1-44. NC2064.2 +147000 IF TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +147100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +147200 TO "5A4B3A2B1B0C" NC2064.2 +147300 PERFORM PASS NC2064.2 +147400 GO TO QAL-WRITE-F1-44. NC2064.2 +147500 GO TO QAL-FAIL-F1-44. NC2064.2 +147600 QAL-DELETE-F1-44. NC2064.2 +147700 PERFORM DE-LETE. NC2064.2 +147800 GO TO QAL-WRITE-F1-44. NC2064.2 +147900 QAL-FAIL-F1-44. NC2064.2 +148000 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +148100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +148200 COMPUTED-A. NC2064.2 +148300 MOVE "5A4B3A2B1B0C" TO CORRECT-A. NC2064.2 +148400 PERFORM FAIL. NC2064.2 +148500 QAL-WRITE-F1-44. NC2064.2 +148600 PERFORM PRINT-DETAIL. NC2064.2 +148700* NC2064.2 +148800 QAL-INIT-F1-45. NC2064.2 +148900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +149000 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +149100 MOVE "QAL-TEST-F1-45" TO PAR-NAME. NC2064.2 +149200 QAL-TEST-F1-45. NC2064.2 +149300 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +149400 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +149500 TO "5A4B3B2A1A0C" NC2064.2 +149600 PERFORM PASS NC2064.2 +149700 GO TO QAL-WRITE-F1-45. NC2064.2 +149800 GO TO QAL-FAIL-F1-45. NC2064.2 +149900 QAL-DELETE-F1-45. NC2064.2 +150000 PERFORM DE-LETE. NC2064.2 +150100 GO TO QAL-WRITE-F1-45. NC2064.2 +150200 QAL-FAIL-F1-45. NC2064.2 +150300 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2064.2 +150400 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2064.2 +150500 TO COMPUTED-A. NC2064.2 +150600 MOVE "5A4B3B2A1A0C" TO CORRECT-A. NC2064.2 +150700 PERFORM FAIL. NC2064.2 +150800 QAL-WRITE-F1-45. NC2064.2 +150900 PERFORM PRINT-DETAIL. NC2064.2 +151000* NC2064.2 +151100 QAL-INIT-F1-46. NC2064.2 +151200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +151300 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +151400 MOVE "QAL-TEST-F1-46" TO PAR-NAME. NC2064.2 +151500 QAL-TEST-F1-46. NC2064.2 +151600 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +151700 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +151800 TO "5A4B3B2A1B0C" NC2064.2 +151900 PERFORM PASS NC2064.2 +152000 GO TO QAL-WRITE-F1-46. NC2064.2 +152100 GO TO QAL-FAIL-F1-46. NC2064.2 +152200 QAL-DELETE-F1-46. NC2064.2 +152300 PERFORM DE-LETE. NC2064.2 +152400 GO TO QAL-WRITE-F1-46. NC2064.2 +152500 QAL-FAIL-F1-46. NC2064.2 +152600 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2064.2 +152700 TABLE-LEVEL-3B OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +152800 COMPUTED-A. NC2064.2 +152900 MOVE "5A4B3B2A1B0C" TO CORRECT-A. NC2064.2 +153000 PERFORM FAIL. NC2064.2 +153100 QAL-WRITE-F1-46. NC2064.2 +153200 PERFORM PRINT-DETAIL. NC2064.2 +153300* NC2064.2 +153400 QAL-INIT-F1-47. NC2064.2 +153500 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +153600 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +153700 MOVE "QAL-TEST-F1-47" TO PAR-NAME. NC2064.2 +153800 QAL-TEST-F1-47. NC2064.2 +153900 IF TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +154000 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A EQUAL NC2064.2 +154100 TO "5A4B3B2B1A0C" NC2064.2 +154200 PERFORM PASS NC2064.2 +154300 GO TO QAL-WRITE-F1-47. NC2064.2 +154400 GO TO QAL-FAIL-F1-47. NC2064.2 +154500 QAL-DELETE-F1-47. NC2064.2 +154600 PERFORM DE-LETE. NC2064.2 +154700 GO TO QAL-WRITE-F1-47. NC2064.2 +154800 QAL-FAIL-F1-47. NC2064.2 +154900 MOVE "5A4B3B2B1A0C" TO CORRECT-A. NC2064.2 +155000 MOVE TBL-LEVEL-0C OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2064.2 +155100 TABLE-LEVEL-3B IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A TO NC2064.2 +155200 COMPUTED-A. NC2064.2 +155300 PERFORM FAIL. NC2064.2 +155400 QAL-WRITE-F1-47. NC2064.2 +155500 PERFORM PRINT-DETAIL. NC2064.2 +155600* NC2064.2 +155700 QAL-INIT-F1-48. NC2064.2 +155800 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +155900 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +156000 MOVE "QAL-TEST-F1-48" TO PAR-NAME. NC2064.2 +156100 QAL-TEST-F1-48. NC2064.2 +156200 IF TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +156300 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A EQUAL NC2064.2 +156400 TO "5A4B3B2B1B0C" NC2064.2 +156500 PERFORM PASS NC2064.2 +156600 GO TO QAL-WRITE-F1-48. NC2064.2 +156700 GO TO QAL-FAIL-F1-48. NC2064.2 +156800 QAL-DELETE-F1-48. NC2064.2 +156900 PERFORM DE-LETE. NC2064.2 +157000 GO TO QAL-WRITE-F1-48. NC2064.2 +157100 QAL-FAIL-F1-48. NC2064.2 +157200 MOVE TBL-LEVEL-0C IN TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2064.2 +157300 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A TO NC2064.2 +157400 COMPUTED-A. NC2064.2 +157500 MOVE "5A4B3B2B1B0C" TO CORRECT-A. NC2064.2 +157600 PERFORM FAIL. NC2064.2 +157700 QAL-WRITE-F1-48. NC2064.2 +157800 PERFORM PRINT-DETAIL. NC2064.2 +157900* NC2064.2 +158000 QAL-INIT-F1-49. NC2064.2 +158100 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +158200 MOVE "QUAL LIMITS " TO FEATURE. NC2064.2 +158300 MOVE "QAL-TEST-F1-49" TO PAR-NAME. NC2064.2 +158400 QAL-TEST-F1-49. NC2064.2 +158500 IF TBL-LEVEL-0D EQUAL TO "5A4A3A2A1A0D" NC2064.2 +158600 PERFORM PASS NC2064.2 +158700 GO TO QAL-WRITE-F1-49. NC2064.2 +158800 GO TO QAL-FAIL-F1-49. NC2064.2 +158900 QAL-DELETE-F1-49. NC2064.2 +159000 PERFORM DE-LETE. NC2064.2 +159100 GO TO QAL-WRITE-F1-49. NC2064.2 +159200 QAL-FAIL-F1-49. NC2064.2 +159300 MOVE "5A4A3A2A1A0D" TO CORRECT-A. NC2064.2 +159400 MOVE TBL-LEVEL-0D IN TABLE-LEVEL-5A TO COMPUTED-A. NC2064.2 +159500* NOTE TBL-LEVEL-0D IS UNIQUE AND NEED NOT BE QUALIFIED NC2064.2 +159600* HOWEVER, REFERENCE IS MADE TO IT BOTH QUALIFIED AND NC2064.2 +159700* UNQUALIFIED TO INSURE THE ABILITY TO DO SO. NC2064.2 +159800 PERFORM FAIL. NC2064.2 +159900 QAL-WRITE-F1-49. NC2064.2 +160000 PERFORM PRINT-DETAIL. NC2064.2 +160100* NC2064.2 +160200 PERFORM END-ROUTINE. NC2064.2 +160300* NC2064.2 +160400 SUB-INIT-F1-0. NC2064.2 +160500 PERFORM END-ROUTINE. NC2064.2 +160600 MOVE "AA1122DD33" TO AX. NC2064.2 +160700 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +160800 MOVE "QUALIFIED SUBSCRIPTS" TO FEATURE. NC2064.2 +160900* NC2064.2 +161000 SUB-INIT-F1-1. NC2064.2 +161100 MOVE "SUB-TEST-F1-1" TO PAR-NAME. NC2064.2 +161200 SUB-TEST-F1-1. NC2064.2 +161300 IF AX-2 IN AX (CX-SUB OF CX) EQUAL TO "1" NC2064.2 +161400 PERFORM PASS NC2064.2 +161500 GO TO SUB-WRITE-F1-1. NC2064.2 +161600 GO TO SUB-FAIL-F1-1. NC2064.2 +161700 SUB-DELETE-F1-1. NC2064.2 +161800 PERFORM DE-LETE. NC2064.2 +161900 GO TO SUB-WRITE-F1-1. NC2064.2 +162000 SUB-FAIL-F1-1. NC2064.2 +162100 MOVE AX-2 IN AX (CX-SUB OF CX) TO COMPUTED-A. NC2064.2 +162200 MOVE 1 TO CORRECT-A. NC2064.2 +162300 PERFORM FAIL. NC2064.2 +162400 SUB-WRITE-F1-1. NC2064.2 +162500 PERFORM PRINT-DETAIL. NC2064.2 +162600* NC2064.2 +162700 SUB-INIT-F1-2. NC2064.2 +162800 MOVE "SUB-TEST-F1-2" TO PAR-NAME. NC2064.2 +162900 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +163000 MOVE "QUALIFIED SUBSCRIPTS" TO FEATURE. NC2064.2 +163100 MOVE 4 TO CX. NC2064.2 +163200 MOVE "DD" TO CORRECT-A. NC2064.2 +163300 SUB-TEST-F1-2. NC2064.2 +163400 MOVE AX-1 OF AX (CX-SUB OF CX) TO COMPUTED-A. NC2064.2 +163500 IF COMPUTED-A EQUAL TO CORRECT-A NC2064.2 +163600 PERFORM PASS NC2064.2 +163700 MOVE SPACE TO COMPUTED-A CORRECT-A NC2064.2 +163800 GO TO SUB-WRITE-F1-2. NC2064.2 +163900 GO TO SUB-FAIL-F1-2. NC2064.2 +164000 SUB-DELETE-F1-2. NC2064.2 +164100 PERFORM DE-LETE. NC2064.2 +164200 GO TO SUB-WRITE-F1-2. NC2064.2 +164300 SUB-FAIL-F1-2. NC2064.2 +164400 PERFORM FAIL. NC2064.2 +164500 SUB-WRITE-F1-2. NC2064.2 +164600 PERFORM PRINT-DETAIL. NC2064.2 +164700* NC2064.2 +164800 SUB-INIT-F1-3. NC2064.2 +164900 MOVE "SUB-TEST-F1-3" TO PAR-NAME. NC2064.2 +165000 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +165100 MOVE "QUALIFIED SUBSCRIPTS" TO FEATURE. NC2064.2 +165200 MOVE 5 TO CX. NC2064.2 +165300 MOVE 5 TO AX-3 OF BX (1) AX-2 OF BX (1). NC2064.2 +165400 MOVE AX-1 IN BX (1) TO AX-1 OF AX (CX-SUB OF CX). NC2064.2 +165500 SUB-TEST-F1-3. NC2064.2 +165600 IF AX-1 OF BX (1) EQUAL TO AX-1 IN AX (CX-SUB IN CX) NC2064.2 +165700 PERFORM PASS NC2064.2 +165800 GO TO SUB-WRITE-F1-3. NC2064.2 +165900 GO TO SUB-FAIL-F1-3. NC2064.2 +166000 SUB-DELETE-F1-3. NC2064.2 +166100 PERFORM DE-LETE. NC2064.2 +166200 GO TO SUB-WRITE-F1-3. NC2064.2 +166300 SUB-FAIL-F1-3. NC2064.2 +166400 MOVE AX-1 OF BX (1) TO COMPUTED-A. NC2064.2 +166500 MOVE AX-1 IN AX (CX-SUB IN CX) TO CORRECT-A. NC2064.2 +166600 PERFORM FAIL. NC2064.2 +166700 MOVE "UNEQUAL COMPARISON" TO RE-MARK. NC2064.2 +166800 SUB-WRITE-F1-3. NC2064.2 +166900 PERFORM PRINT-DETAIL. NC2064.2 +167000* NC2064.2 +167100 SUB-INIT-F1-4. NC2064.2 +167200 MOVE "IV-19 4.3.8.1" TO ANSI-REFERENCE. NC2064.2 +167300 MOVE "QUALIFIED SUBSCRIPTS" TO FEATURE. NC2064.2 +167400 MOVE "SUB-TEST-F1-4" TO PAR-NAME. NC2064.2 +167500 MOVE 1 TO CX. NC2064.2 +167600 MOVE 11 TO AX-1 OF BX (CX-SUB IN CX). NC2064.2 +167700 ADD AX-3 IN BX (CX-SUB OF CX) TO AX-2 IN BX (CX-SUB IN CX). NC2064.2 +167800 SUB-TEST-F1-4. NC2064.2 +167900 IF AX-2 IN BX (CX-SUB IN CX) EQUAL TO AX-2 IN AX (3) NC2064.2 +168000 PERFORM PASS NC2064.2 +168100 GO TO SUB-WRITE-F1-4. NC2064.2 +168200 GO TO SUB-FAIL-F1-4. NC2064.2 +168300 SUB-DELETE-F1-4. NC2064.2 +168400 PERFORM DE-LETE. NC2064.2 +168500 GO TO SUB-WRITE-F1-4. NC2064.2 +168600 SUB-FAIL-F1-4. NC2064.2 +168700 MOVE AX-2 IN BX (CX-SUB IN CX) TO COMPUTED-A. NC2064.2 +168800 MOVE AX-2 IN AX (3) TO CORRECT-A. NC2064.2 +168900 MOVE "UNEQUAL COMPARISON" TO RE-MARK. NC2064.2 +169000 PERFORM FAIL. NC2064.2 +169100 SUB-WRITE-F1-4. NC2064.2 +169200 PERFORM PRINT-DETAIL. NC2064.2 +169300 CCVS-EXIT SECTION. NC2064.2 +169400 CCVS-999999. NC2064.2 +169500 GO TO CLOSE-FILES. NC2064.2 diff --git a/tests/cobol85/NC/NC207A.CBL b/tests/cobol85/NC/NC207A.CBL new file mode 100755 index 00000000..7fb7f039 --- /dev/null +++ b/tests/cobol85/NC/NC207A.CBL @@ -0,0 +1,2723 @@ +000100 IDENTIFICATION DIVISION. NC2074.2 +000200 PROGRAM-ID. NC2074.2 +000300 NC207A. NC2074.2 +000400**************************************************************** NC2074.2 +000500* * NC2074.2 +000600* VALIDATION FOR:- * NC2074.2 +000700* * NC2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2074.2 +000900* * NC2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2074.2 +001100* * NC2074.2 +001200**************************************************************** NC2074.2 +001300* * NC2074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2074.2 +001500* * NC2074.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2074.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2074.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2074.2 +001900* * NC2074.2 +002000**************************************************************** NC2074.2 +002100* * NC2074.2 +002200* PROGRAM NC207A TESTS THE USE OF FORMAT 1 QUALIFICATION * NC2074.2 +002300* USING FORMATS 1, 2 AND 3 OF THE "ADD" STATEMENT, FORMATS * NC2074.2 +002400* 2 AND 3 OF THE "SUBTRACT" STATEMENT, FORMAT 2 OF THE * NC2074.2 +002500* "MULTIPLY" STATEMENT AND FORMAT 3 OF THE "DIVIDE"* NC2074.2 +002600* STATEMENT. * NC2074.2 +002700* THE MAJORITY OF TESTST USE UP TO FIVE LEVELS OF * NC2074.2 +002800* QUALIFICATION BUT THE MINIMUM REQUIREMENT OF 49 LEVELS IN * NC2074.2 +002900* THE NUCLEUS IS ALSO TESTED. * NC2074.2 +003000* * NC2074.2 +003100**************************************************************** NC2074.2 +003200 ENVIRONMENT DIVISION. NC2074.2 +003300 CONFIGURATION SECTION. NC2074.2 +003400 SOURCE-COMPUTER. NC2074.2 +003500 Linux. NC2074.2 +003600 OBJECT-COMPUTER. NC2074.2 +003700 Linux. NC2074.2 +003800 INPUT-OUTPUT SECTION. NC2074.2 +003900 FILE-CONTROL. NC2074.2 +004000 SELECT PRINT-FILE ASSIGN TO NC2074.2 +004100 "report.log". NC2074.2 +004200 DATA DIVISION. NC2074.2 +004300 FILE SECTION. NC2074.2 +004400 FD PRINT-FILE. NC2074.2 +004500 01 PRINT-REC PICTURE X(120). NC2074.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC2074.2 +004700 WORKING-STORAGE SECTION. NC2074.2 +004800 77 ACCUMULATOR1 PIC 9(18) VALUE ZERO. NC2074.2 +004900 77 ACCUMULATOR2 PIC 9(18) VALUE ZERO. NC2074.2 +005000 01 TABLE-LEVEL-5A. NC2074.2 +005100 02 TABLE-LEVEL-4A. NC2074.2 +005200 03 TABLE-LEVEL-3A. NC2074.2 +005300 04 TABLE-LEVEL-2A. NC2074.2 +005400 05 TABLE-LEVEL-1A. NC2074.2 +005500 06 TBL-ITEM-1 PIC 9 VALUE 1. NC2074.2 +005600 05 TABLE-LEVEL-1B. NC2074.2 +005700 06 TBL-ITEM-1 PIC 9(2) VALUE 2. NC2074.2 +005800 04 TABLE-LEVEL-2B. NC2074.2 +005900 05 TABLE-LEVEL-1A. NC2074.2 +006000 06 TBL-ITEM-1 PIC 9(3) VALUE 3. NC2074.2 +006100 05 TABLE-LEVEL-1B. NC2074.2 +006200 06 TBL-ITEM-1 PIC 9(4) VALUE 4. NC2074.2 +006300 03 TABLE-LEVEL-3B. NC2074.2 +006400 04 TABLE-LEVEL-2A. NC2074.2 +006500 05 TABLE-LEVEL-1A. NC2074.2 +006600 06 TBL-ITEM-1 PIC 9(5) VALUE 5. NC2074.2 +006700 05 TABLE-LEVEL-1B. NC2074.2 +006800 06 TBL-ITEM-1 PIC 9(6) VALUE 6. NC2074.2 +006900 04 TABLE-LEVEL-2B. NC2074.2 +007000 05 TABLE-LEVEL-1A. NC2074.2 +007100 06 TBL-ITEM-1 PIC 9(7) VALUE 7. NC2074.2 +007200 05 TABLE-LEVEL-1B. NC2074.2 +007300 06 TBL-ITEM-1 PIC 9(8) VALUE 8. NC2074.2 +007400 02 TABLE-LEVEL-4B. NC2074.2 +007500 03 TABLE-LEVEL-3A. NC2074.2 +007600 04 TABLE-LEVEL-2A. NC2074.2 +007700 05 TABLE-LEVEL-1A. NC2074.2 +007800 06 TBL-ITEM-1 PIC 9(9) VALUE 9. NC2074.2 +007900 05 TABLE-LEVEL-1B. NC2074.2 +008000 06 TBL-ITEM-1 PIC 9(10) VALUE 10. NC2074.2 +008100 04 TABLE-LEVEL-2B. NC2074.2 +008200 05 TABLE-LEVEL-1A. NC2074.2 +008300 06 TBL-ITEM-1 PIC 9(11) VALUE 11. NC2074.2 +008400 05 TABLE-LEVEL-1B. NC2074.2 +008500 06 TBL-ITEM-1 PIC 9(12) VALUE 12. NC2074.2 +008600 03 TABLE-LEVEL-3B. NC2074.2 +008700 04 TABLE-LEVEL-2A. NC2074.2 +008800 05 TABLE-LEVEL-1A. NC2074.2 +008900 06 TBL-ITEM-1 PIC 9(13) VALUE 13. NC2074.2 +009000 05 TABLE-LEVEL-1B. NC2074.2 +009100 06 TBL-ITEM-1 PIC 9(14) VALUE 14. NC2074.2 +009200 04 TABLE-LEVEL-2B. NC2074.2 +009300 05 TABLE-LEVEL-1A. NC2074.2 +009400 06 TBL-ITEM-1 PIC 9(15) VALUE 15. NC2074.2 +009500 05 TABLE-LEVEL-1B. NC2074.2 +009600 06 TBL-ITEM-1 PIC 9(16) VALUE 16. NC2074.2 +009700 01 TABLE-LEVEL-5B. NC2074.2 +009800 02 TABLE-LEVEL-4A. NC2074.2 +009900 03 TABLE-LEVEL-3A. NC2074.2 +010000 04 TABLE-LEVEL-2A. NC2074.2 +010100 05 TABLE-LEVEL-1A. NC2074.2 +010200 06 TBL-ITEM-1 PIC 9(16) VALUE 16. NC2074.2 +010300 05 TABLE-LEVEL-1B. NC2074.2 +010400 06 TBL-ITEM-1 PIC 9(15) VALUE 15. NC2074.2 +010500 04 TABLE-LEVEL-2B. NC2074.2 +010600 05 TABLE-LEVEL-1A. NC2074.2 +010700 06 TBL-ITEM-1 PIC 9(14) VALUE 14. NC2074.2 +010800 05 TABLE-LEVEL-1B. NC2074.2 +010900 06 TBL-ITEM-1 PIC 9(13) VALUE 13. NC2074.2 +011000 03 TABLE-LEVEL-3B. NC2074.2 +011100 04 TABLE-LEVEL-2A. NC2074.2 +011200 05 TABLE-LEVEL-1A. NC2074.2 +011300 06 TBL-ITEM-1 PIC 9(12) VALUE 12. NC2074.2 +011400 05 TABLE-LEVEL-1B. NC2074.2 +011500 06 TBL-ITEM-1 PIC 9(11) VALUE 11. NC2074.2 +011600 04 TABLE-LEVEL-2B. NC2074.2 +011700 05 TABLE-LEVEL-1A. NC2074.2 +011800 06 TBL-ITEM-1 PIC 9(10) VALUE 10. NC2074.2 +011900 05 TABLE-LEVEL-1B. NC2074.2 +012000 06 TBL-ITEM-1 PIC 9(9) VALUE 9. NC2074.2 +012100 02 TABLE-LEVEL-4B. NC2074.2 +012200 03 TABLE-LEVEL-3A. NC2074.2 +012300 04 TABLE-LEVEL-2A. NC2074.2 +012400 05 TABLE-LEVEL-1A. NC2074.2 +012500 06 TBL-ITEM-1 PIC 9(8) VALUE 8. NC2074.2 +012600 05 TABLE-LEVEL-1B. NC2074.2 +012700 06 TBL-ITEM-1 PIC 9(7) VALUE 7. NC2074.2 +012800 04 TABLE-LEVEL-2B. NC2074.2 +012900 05 TABLE-LEVEL-1A. NC2074.2 +013000 06 TBL-ITEM-1 PIC 9(6) VALUE 6. NC2074.2 +013100 05 TABLE-LEVEL-1B. NC2074.2 +013200 06 TBL-ITEM-1 PIC 9(5) VALUE 5. NC2074.2 +013300 03 TABLE-LEVEL-3B. NC2074.2 +013400 04 TABLE-LEVEL-2A. NC2074.2 +013500 05 TABLE-LEVEL-1A. NC2074.2 +013600 06 TBL-ITEM-1 PIC 9(4) VALUE 4. NC2074.2 +013700 05 TABLE-LEVEL-1B. NC2074.2 +013800 06 TBL-ITEM-1 PIC 9(3) VALUE 3. NC2074.2 +013900 04 TABLE-LEVEL-2B. NC2074.2 +014000 05 TABLE-LEVEL-1A. NC2074.2 +014100 06 TBL-ITEM-1 PIC 9(2) VALUE 2. NC2074.2 +014200 05 TABLE-LEVEL-1B. NC2074.2 +014300 06 TBL-ITEM-1 PIC 99 VALUE 1. NC2074.2 +014400 NC2074.2 +014500 01 TABLE-LEVEL-5C. NC2074.2 +014600 02 TABLE-LEVEL-4A. NC2074.2 +014700 03 TABLE-LEVEL-3A. NC2074.2 +014800 04 TABLE-LEVEL-2A. NC2074.2 +014900 05 TABLE-LEVEL-1A. NC2074.2 +015000 06 TBL-ITEM-1 PIC 9 VALUE 1. NC2074.2 +015100 05 TABLE-LEVEL-1B. NC2074.2 +015200 06 TBL-ITEM-1 PIC 9(2) VALUE 2. NC2074.2 +015300 04 TABLE-LEVEL-2B. NC2074.2 +015400 05 TABLE-LEVEL-1A. NC2074.2 +015500 06 TBL-ITEM-1 PIC 9(3) VALUE 3. NC2074.2 +015600 05 TABLE-LEVEL-1B. NC2074.2 +015700 06 TBL-ITEM-1 PIC 9(4) VALUE 4. NC2074.2 +015800 03 TABLE-LEVEL-3B. NC2074.2 +015900 04 TABLE-LEVEL-2A. NC2074.2 +016000 05 TABLE-LEVEL-1A. NC2074.2 +016100 06 TBL-ITEM-1 PIC 9(5) VALUE 5. NC2074.2 +016200 05 TABLE-LEVEL-1B. NC2074.2 +016300 06 TBL-ITEM-1 PIC 9(6) VALUE 6. NC2074.2 +016400 04 TABLE-LEVEL-2B. NC2074.2 +016500 05 TABLE-LEVEL-1A. NC2074.2 +016600 06 TBL-ITEM-1 PIC 9(7) VALUE 7. NC2074.2 +016700 05 TABLE-LEVEL-1B. NC2074.2 +016800 06 TBL-ITEM-1 PIC 9(8) VALUE 8. NC2074.2 +016900 02 TABLE-LEVEL-4B. NC2074.2 +017000 03 TABLE-LEVEL-3A. NC2074.2 +017100 04 TABLE-LEVEL-2A. NC2074.2 +017200 05 TABLE-LEVEL-1A. NC2074.2 +017300 06 TBL-ITEM-1 PIC 9(9) VALUE 9. NC2074.2 +017400 05 TABLE-LEVEL-1B. NC2074.2 +017500 06 TBL-ITEM-1 PIC 9(10) VALUE 10. NC2074.2 +017600 04 TABLE-LEVEL-2B. NC2074.2 +017700 05 TABLE-LEVEL-1A. NC2074.2 +017800 06 TBL-ITEM-1 PIC 9(11) VALUE 11. NC2074.2 +017900 05 TABLE-LEVEL-1B. NC2074.2 +018000 06 TBL-ITEM-1 PIC 9(12) VALUE 12. NC2074.2 +018100 03 TABLE-LEVEL-3B. NC2074.2 +018200 04 TABLE-LEVEL-2A. NC2074.2 +018300 05 TABLE-LEVEL-1A. NC2074.2 +018400 06 TBL-ITEM-1 PIC 9(13) VALUE 13. NC2074.2 +018500 05 TABLE-LEVEL-1B. NC2074.2 +018600 06 TBL-ITEM-1 PIC 9(14) VALUE 14. NC2074.2 +018700 04 TABLE-LEVEL-2B. NC2074.2 +018800 05 TABLE-LEVEL-1A. NC2074.2 +018900 06 TBL-ITEM-1 PIC 9(15) VALUE 15. NC2074.2 +019000 05 TABLE-LEVEL-1B. NC2074.2 +019100 06 TBL-ITEM-1 PIC 9(16) VALUE 16. NC2074.2 +019200 01 TABLE-5B-INIT. NC2074.2 +019300 02 FILLER PIC 9(16) VALUE 16. NC2074.2 +019400 02 FILLER PIC 9(15) VALUE 15. NC2074.2 +019500 02 FILLER PIC 9(14) VALUE 14. NC2074.2 +019600 02 FILLER PIC 9(13) VALUE 13. NC2074.2 +019700 02 FILLER PIC 9(12) VALUE 12. NC2074.2 +019800 02 FILLER PIC 9(11) VALUE 11. NC2074.2 +019900 02 FILLER PIC 9(10) VALUE 10. NC2074.2 +020000 02 FILLER PIC 9(9) VALUE 9. NC2074.2 +020100 02 FILLER PIC 9(8) VALUE 8. NC2074.2 +020200 02 FILLER PIC 9(7) VALUE 7. NC2074.2 +020300 02 FILLER PIC 9(6) VALUE 6. NC2074.2 +020400 02 FILLER PIC 9(5) VALUE 5. NC2074.2 +020500 02 FILLER PIC 9(4) VALUE 4. NC2074.2 +020600 02 FILLER PIC 9(3) VALUE 3. NC2074.2 +020700 02 FILLER PIC 9(2) VALUE 2. NC2074.2 +020800 02 FILLER PIC 9(2) VALUE 1. NC2074.2 +020900 01 FIRST-GROUP. NC2074.2 +021000 02 GROUP-02. NC2074.2 +021100 03 GROUP-03. NC2074.2 +021200 04 GROUP-04. NC2074.2 +021300 05 GROUP-05. NC2074.2 +021400 06 GROUP-06. NC2074.2 +021500 07 GROUP-07. NC2074.2 +021600 08 GROUP-08. NC2074.2 +021700 09 GROUP-09. NC2074.2 +021800 10 GROUP-10. NC2074.2 +021900 11 GROUP-11. NC2074.2 +022000 12 GROUP-12. NC2074.2 +022100 13 GROUP-13. NC2074.2 +022200 14 GROUP-14. NC2074.2 +022300 15 GROUP-15. NC2074.2 +022400 16 GROUP-16. NC2074.2 +022500 17 GROUP-17. NC2074.2 +022600 18 GROUP-18. NC2074.2 +022700 19 GROUP-19. NC2074.2 +022800 20 GROUP-20. NC2074.2 +022900 21 GROUP-21. NC2074.2 +023000 22 GROUP-22. NC2074.2 +023100 23 GROUP-23. NC2074.2 +023200 24 GROUP-24. NC2074.2 +023300 25 GROUP-25. NC2074.2 +023400 26 GROUP-26. NC2074.2 +023500 27 GROUP-27. NC2074.2 +023600 28 GROUP-28. NC2074.2 +023700 29 GROUP-29. NC2074.2 +023800 30 GROUP-30. NC2074.2 +023900 31 GROUP-31. NC2074.2 +024000 32 GROUP-32. NC2074.2 +024100 33 GROUP-33. NC2074.2 +024200 34 GROUP-34. NC2074.2 +024300 35 GROUP-35. NC2074.2 +024400 36 GROUP-36. NC2074.2 +024500 37 GROUP-37. NC2074.2 +024600 38 GROUP-38. NC2074.2 +024700 39 GROUP-39. NC2074.2 +024800 40 GROUP-40. NC2074.2 +024900 41 GROUP-41. NC2074.2 +025000 42 GROUP-42. NC2074.2 +025100 43 GROUP-43. NC2074.2 +025200 44 GROUP-44. NC2074.2 +025300 45 GROUP-45. NC2074.2 +025400 46 GROUP-46. NC2074.2 +025500 47 GROUP-47. NC2074.2 +025600 48 GROUP-48. NC2074.2 +025700 49 GROUP-49-1 PIC 9(4) VALUE 1. NC2074.2 +025800 49 GROUP-49-2 PIC S9(3) COMP VALUE 2. NC2074.2 +025900 49 GROUP-49-3 PIC S9(15) COMP VALUE 3. NC2074.2 +026000 49 GROUP-49-4 PIC S9(8) COMP VALUE 4. NC2074.2 +026100 49 GROUP-49-5 PIC 9(8) VALUE 5. NC2074.2 +026200 01 SECOND-GROUP. NC2074.2 +026300 02 GROUP-02. NC2074.2 +026400 03 GROUP-03. NC2074.2 +026500 04 GROUP-04. NC2074.2 +026600 05 GROUP-05. NC2074.2 +026700 06 GROUP-06. NC2074.2 +026800 07 GROUP-07. NC2074.2 +026900 08 GROUP-08. NC2074.2 +027000 09 GROUP-09. NC2074.2 +027100 10 GROUP-10. NC2074.2 +027200 11 GROUP-11. NC2074.2 +027300 12 GROUP-12. NC2074.2 +027400 13 GROUP-13. NC2074.2 +027500 14 GROUP-14. NC2074.2 +027600 15 GROUP-15. NC2074.2 +027700 16 GROUP-16. NC2074.2 +027800 17 GROUP-17. NC2074.2 +027900 18 GROUP-18. NC2074.2 +028000 19 GROUP-19. NC2074.2 +028100 20 GROUP-20. NC2074.2 +028200 21 GROUP-21. NC2074.2 +028300 22 GROUP-22. NC2074.2 +028400 23 GROUP-23. NC2074.2 +028500 24 GROUP-24. NC2074.2 +028600 25 GROUP-25. NC2074.2 +028700 26 GROUP-26. NC2074.2 +028800 27 GROUP-27. NC2074.2 +028900 28 GROUP-28. NC2074.2 +029000 29 GROUP-29. NC2074.2 +029100 30 GROUP-30. NC2074.2 +029200 31 GROUP-31. NC2074.2 +029300 32 GROUP-32. NC2074.2 +029400 33 GROUP-33. NC2074.2 +029500 34 GROUP-34. NC2074.2 +029600 35 GROUP-35. NC2074.2 +029700 36 GROUP-36. NC2074.2 +029800 37 GROUP-37. NC2074.2 +029900 38 GROUP-38. NC2074.2 +030000 39 GROUP-39. NC2074.2 +030100 40 GROUP-40. NC2074.2 +030200 41 GROUP-41. NC2074.2 +030300 42 GROUP-42. NC2074.2 +030400 43 GROUP-43. NC2074.2 +030500 44 GROUP-44. NC2074.2 +030600 45 GROUP-45. NC2074.2 +030700 46 GROUP-46. NC2074.2 +030800 47 GROUP-47. NC2074.2 +030900 48 GROUP-48. NC2074.2 +031000 49 GROUP-49-1 PIC 9(4) VALUE 100. NC2074.2 +031100 49 GROUP-49-2 PIC S9(3) COMP VALUE 200. NC2074.2 +031200 49 GROUP-49-3 PIC S9(15) COMP VALUE 300. NC2074.2 +031300 49 GROUP-49-4 PIC S9(8) COMP VALUE 400. NC2074.2 +031400 49 GROUP-49-5 PIC 9(8) VALUE 500. NC2074.2 +031500 88 LEVEL-49-OK VALUE 500. NC2074.2 +031600 01 TEST-RESULTS. NC2074.2 +031700 02 FILLER PIC X VALUE SPACE. NC2074.2 +031800 02 FEATURE PIC X(20) VALUE SPACE. NC2074.2 +031900 02 FILLER PIC X VALUE SPACE. NC2074.2 +032000 02 P-OR-F PIC X(5) VALUE SPACE. NC2074.2 +032100 02 FILLER PIC X VALUE SPACE. NC2074.2 +032200 02 PAR-NAME. NC2074.2 +032300 03 FILLER PIC X(19) VALUE SPACE. NC2074.2 +032400 03 PARDOT-X PIC X VALUE SPACE. NC2074.2 +032500 03 DOTVALUE PIC 99 VALUE ZERO. NC2074.2 +032600 02 FILLER PIC X(8) VALUE SPACE. NC2074.2 +032700 02 RE-MARK PIC X(61). NC2074.2 +032800 01 TEST-COMPUTED. NC2074.2 +032900 02 FILLER PIC X(30) VALUE SPACE. NC2074.2 +033000 02 FILLER PIC X(17) VALUE NC2074.2 +033100 " COMPUTED=". NC2074.2 +033200 02 COMPUTED-X. NC2074.2 +033300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2074.2 +033400 03 COMPUTED-N REDEFINES COMPUTED-A NC2074.2 +033500 PIC -9(9).9(9). NC2074.2 +033600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2074.2 +033700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2074.2 +033800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2074.2 +033900 03 CM-18V0 REDEFINES COMPUTED-A. NC2074.2 +034000 04 COMPUTED-18V0 PIC -9(18). NC2074.2 +034100 04 FILLER PIC X. NC2074.2 +034200 03 FILLER PIC X(50) VALUE SPACE. NC2074.2 +034300 01 TEST-CORRECT. NC2074.2 +034400 02 FILLER PIC X(30) VALUE SPACE. NC2074.2 +034500 02 FILLER PIC X(17) VALUE " CORRECT =". NC2074.2 +034600 02 CORRECT-X. NC2074.2 +034700 03 CORRECT-A PIC X(20) VALUE SPACE. NC2074.2 +034800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2074.2 +034900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2074.2 +035000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2074.2 +035100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2074.2 +035200 03 CR-18V0 REDEFINES CORRECT-A. NC2074.2 +035300 04 CORRECT-18V0 PIC -9(18). NC2074.2 +035400 04 FILLER PIC X. NC2074.2 +035500 03 FILLER PIC X(2) VALUE SPACE. NC2074.2 +035600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2074.2 +035700 01 CCVS-C-1. NC2074.2 +035800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2074.2 +035900- "SS PARAGRAPH-NAME NC2074.2 +036000- " REMARKS". NC2074.2 +036100 02 FILLER PIC X(20) VALUE SPACE. NC2074.2 +036200 01 CCVS-C-2. NC2074.2 +036300 02 FILLER PIC X VALUE SPACE. NC2074.2 +036400 02 FILLER PIC X(6) VALUE "TESTED". NC2074.2 +036500 02 FILLER PIC X(15) VALUE SPACE. NC2074.2 +036600 02 FILLER PIC X(4) VALUE "FAIL". NC2074.2 +036700 02 FILLER PIC X(94) VALUE SPACE. NC2074.2 +036800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2074.2 +036900 01 REC-CT PIC 99 VALUE ZERO. NC2074.2 +037000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2074.2 +037100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2074.2 +037200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2074.2 +037300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2074.2 +037400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2074.2 +037500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2074.2 +037600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2074.2 +037700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2074.2 +037800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2074.2 +037900 01 CCVS-H-1. NC2074.2 +038000 02 FILLER PIC X(39) VALUE SPACES. NC2074.2 +038100 02 FILLER PIC X(42) VALUE NC2074.2 +038200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2074.2 +038300 02 FILLER PIC X(39) VALUE SPACES. NC2074.2 +038400 01 CCVS-H-2A. NC2074.2 +038500 02 FILLER PIC X(40) VALUE SPACE. NC2074.2 +038600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2074.2 +038700 02 FILLER PIC XXXX VALUE NC2074.2 +038800 "4.2 ". NC2074.2 +038900 02 FILLER PIC X(28) VALUE NC2074.2 +039000 " COPY - NOT FOR DISTRIBUTION". NC2074.2 +039100 02 FILLER PIC X(41) VALUE SPACE. NC2074.2 +039200 NC2074.2 +039300 01 CCVS-H-2B. NC2074.2 +039400 02 FILLER PIC X(15) VALUE NC2074.2 +039500 "TEST RESULT OF ". NC2074.2 +039600 02 TEST-ID PIC X(9). NC2074.2 +039700 02 FILLER PIC X(4) VALUE NC2074.2 +039800 " IN ". NC2074.2 +039900 02 FILLER PIC X(12) VALUE NC2074.2 +040000 " HIGH ". NC2074.2 +040100 02 FILLER PIC X(22) VALUE NC2074.2 +040200 " LEVEL VALIDATION FOR ". NC2074.2 +040300 02 FILLER PIC X(58) VALUE NC2074.2 +040400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2074.2 +040500 01 CCVS-H-3. NC2074.2 +040600 02 FILLER PIC X(34) VALUE NC2074.2 +040700 " FOR OFFICIAL USE ONLY ". NC2074.2 +040800 02 FILLER PIC X(58) VALUE NC2074.2 +040900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2074.2 +041000 02 FILLER PIC X(28) VALUE NC2074.2 +041100 " COPYRIGHT 1985 ". NC2074.2 +041200 01 CCVS-E-1. NC2074.2 +041300 02 FILLER PIC X(52) VALUE SPACE. NC2074.2 +041400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2074.2 +041500 02 ID-AGAIN PIC X(9). NC2074.2 +041600 02 FILLER PIC X(45) VALUE SPACES. NC2074.2 +041700 01 CCVS-E-2. NC2074.2 +041800 02 FILLER PIC X(31) VALUE SPACE. NC2074.2 +041900 02 FILLER PIC X(21) VALUE SPACE. NC2074.2 +042000 02 CCVS-E-2-2. NC2074.2 +042100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2074.2 +042200 03 FILLER PIC X VALUE SPACE. NC2074.2 +042300 03 ENDER-DESC PIC X(44) VALUE NC2074.2 +042400 "ERRORS ENCOUNTERED". NC2074.2 +042500 01 CCVS-E-3. NC2074.2 +042600 02 FILLER PIC X(22) VALUE NC2074.2 +042700 " FOR OFFICIAL USE ONLY". NC2074.2 +042800 02 FILLER PIC X(12) VALUE SPACE. NC2074.2 +042900 02 FILLER PIC X(58) VALUE NC2074.2 +043000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2074.2 +043100 02 FILLER PIC X(13) VALUE SPACE. NC2074.2 +043200 02 FILLER PIC X(15) VALUE NC2074.2 +043300 " COPYRIGHT 1985". NC2074.2 +043400 01 CCVS-E-4. NC2074.2 +043500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2074.2 +043600 02 FILLER PIC X(4) VALUE " OF ". NC2074.2 +043700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2074.2 +043800 02 FILLER PIC X(40) VALUE NC2074.2 +043900 " TESTS WERE EXECUTED SUCCESSFULLY". NC2074.2 +044000 01 XXINFO. NC2074.2 +044100 02 FILLER PIC X(19) VALUE NC2074.2 +044200 "*** INFORMATION ***". NC2074.2 +044300 02 INFO-TEXT. NC2074.2 +044400 04 FILLER PIC X(8) VALUE SPACE. NC2074.2 +044500 04 XXCOMPUTED PIC X(20). NC2074.2 +044600 04 FILLER PIC X(5) VALUE SPACE. NC2074.2 +044700 04 XXCORRECT PIC X(20). NC2074.2 +044800 02 INF-ANSI-REFERENCE PIC X(48). NC2074.2 +044900 01 HYPHEN-LINE. NC2074.2 +045000 02 FILLER PIC IS X VALUE IS SPACE. NC2074.2 +045100 02 FILLER PIC IS X(65) VALUE IS "************************NC2074.2 +045200- "*****************************************". NC2074.2 +045300 02 FILLER PIC IS X(54) VALUE IS "************************NC2074.2 +045400- "******************************". NC2074.2 +045500 01 CCVS-PGM-ID PIC X(9) VALUE NC2074.2 +045600 "NC207". NC2074.2 +045700 PROCEDURE DIVISION. NC2074.2 +045800 CCVS1 SECTION. NC2074.2 +045900 OPEN-FILES. NC2074.2 +046000 OPEN OUTPUT PRINT-FILE. NC2074.2 +046100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2074.2 +046200 MOVE SPACE TO TEST-RESULTS. NC2074.2 +046300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2074.2 +046400 GO TO CCVS1-EXIT. NC2074.2 +046500 CLOSE-FILES. NC2074.2 +046600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2074.2 +046700 TERMINATE-CCVS. NC2074.2 +046800*S EXIT PROGRAM. NC2074.2 +046900*SERMINATE-CALL. NC2074.2 +047000 STOP RUN. NC2074.2 +047100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2074.2 +047200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2074.2 +047300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2074.2 +047400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2074.2 +047500 MOVE "****TEST DELETED****" TO RE-MARK. NC2074.2 +047600 PRINT-DETAIL. NC2074.2 +047700 IF REC-CT NOT EQUAL TO ZERO NC2074.2 +047800 MOVE "." TO PARDOT-X NC2074.2 +047900 MOVE REC-CT TO DOTVALUE. NC2074.2 +048000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2074.2 +048100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2074.2 +048200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2074.2 +048300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2074.2 +048400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2074.2 +048500 MOVE SPACE TO CORRECT-X. NC2074.2 +048600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2074.2 +048700 MOVE SPACE TO RE-MARK. NC2074.2 +048800 HEAD-ROUTINE. NC2074.2 +048900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +049000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +049100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2074.2 +049200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2074.2 +049300 COLUMN-NAMES-ROUTINE. NC2074.2 +049400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +049500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +049600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +049700 END-ROUTINE. NC2074.2 +049800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2074.2 +049900 END-RTN-EXIT. NC2074.2 +050000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +050100 END-ROUTINE-1. NC2074.2 +050200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2074.2 +050300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2074.2 +050400 ADD PASS-COUNTER TO ERROR-HOLD. NC2074.2 +050500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2074.2 +050600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2074.2 +050700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2074.2 +050800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2074.2 +050900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2074.2 +051000 END-ROUTINE-12. NC2074.2 +051100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2074.2 +051200 IF ERROR-COUNTER IS EQUAL TO ZERO NC2074.2 +051300 MOVE "NO " TO ERROR-TOTAL NC2074.2 +051400 ELSE NC2074.2 +051500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2074.2 +051600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2074.2 +051700 PERFORM WRITE-LINE. NC2074.2 +051800 END-ROUTINE-13. NC2074.2 +051900 IF DELETE-COUNTER IS EQUAL TO ZERO NC2074.2 +052000 MOVE "NO " TO ERROR-TOTAL ELSE NC2074.2 +052100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2074.2 +052200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2074.2 +052300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +052400 IF INSPECT-COUNTER EQUAL TO ZERO NC2074.2 +052500 MOVE "NO " TO ERROR-TOTAL NC2074.2 +052600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2074.2 +052700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2074.2 +052800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +052900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2074.2 +053000 WRITE-LINE. NC2074.2 +053100 ADD 1 TO RECORD-COUNT. NC2074.2 +053200 IF RECORD-COUNT GREATER 50 NC2074.2 +053300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2074.2 +053400 MOVE SPACE TO DUMMY-RECORD NC2074.2 +053500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2074.2 +053600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2074.2 +053700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2074.2 +053800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2074.2 +053900 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2074.2 +054000 MOVE ZERO TO RECORD-COUNT. NC2074.2 +054100 PERFORM WRT-LN. NC2074.2 +054200 WRT-LN. NC2074.2 +054300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2074.2 +054400 MOVE SPACE TO DUMMY-RECORD. NC2074.2 +054500 BLANK-LINE-PRINT. NC2074.2 +054600 PERFORM WRT-LN. NC2074.2 +054700 FAIL-ROUTINE. NC2074.2 +054800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2074.2 +054900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2074.2 +055000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2074.2 +055100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2074.2 +055200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +055300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2074.2 +055400 GO TO FAIL-ROUTINE-EX. NC2074.2 +055500 FAIL-ROUTINE-WRITE. NC2074.2 +055600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2074.2 +055700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2074.2 +055800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2074.2 +055900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2074.2 +056000 FAIL-ROUTINE-EX. EXIT. NC2074.2 +056100 BAIL-OUT. NC2074.2 +056200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2074.2 +056300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2074.2 +056400 BAIL-OUT-WRITE. NC2074.2 +056500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2074.2 +056600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2074.2 +056700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2074.2 +056800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2074.2 +056900 BAIL-OUT-EX. EXIT. NC2074.2 +057000 CCVS1-EXIT. NC2074.2 +057100 EXIT. NC2074.2 +057200 SECT-NC207A-001 SECTION. NC2074.2 +057300 ADD-INIT-F1-1. NC2074.2 +057400 MOVE "ADD-TEST-F1-1 " TO PAR-NAME. NC2074.2 +057500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +057600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +057700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +057800 ADD-TEST-F1-1. NC2074.2 +057900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +058000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +058100 TO ACCUMULATOR1. NC2074.2 +058200 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +058300 PERFORM PASS NC2074.2 +058400 GO TO ADD-WRITE-F1-1. NC2074.2 +058500 GO TO ADD-FAIL-F1-1. NC2074.2 +058600 ADD-DELETE-F1-1. NC2074.2 +058700 PERFORM DE-LETE. NC2074.2 +058800 GO TO ADD-WRITE-F1-1. NC2074.2 +058900 ADD-FAIL-F1-1. NC2074.2 +059000 MOVE 1 TO CORRECT-N. NC2074.2 +059100 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +059200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +059300 TO COMPUTED-N. NC2074.2 +059400 PERFORM FAIL. NC2074.2 +059500 ADD-WRITE-F1-1. NC2074.2 +059600 PERFORM PRINT-DETAIL. NC2074.2 +059700* NC2074.2 +059800 ADD-INIT-F1-2. NC2074.2 +059900 MOVE "ADD-TEST-F1-2 " TO PAR-NAME. NC2074.2 +060000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +060100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +060200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +060300 ADD-TEST-F1-2. NC2074.2 +060400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2074.2 +060500 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +060600 ACCUMULATOR1. NC2074.2 +060700 IF ACCUMULATOR1 EQUAL TO 2 NC2074.2 +060800 PERFORM PASS NC2074.2 +060900 GO TO ADD-WRITE-F1-2. NC2074.2 +061000 GO TO ADD-FAIL-F1-2. NC2074.2 +061100 ADD-DELETE-F1-2. NC2074.2 +061200 PERFORM DE-LETE. NC2074.2 +061300 GO TO ADD-WRITE-F1-2. NC2074.2 +061400 ADD-FAIL-F1-2. NC2074.2 +061500 MOVE 2 TO CORRECT-N. NC2074.2 +061600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2074.2 +061700 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +061800 COMPUTED-N. NC2074.2 +061900 PERFORM FAIL. NC2074.2 +062000 ADD-WRITE-F1-2. NC2074.2 +062100 PERFORM PRINT-DETAIL. NC2074.2 +062200* NC2074.2 +062300 ADD-INIT-F1-3. NC2074.2 +062400 MOVE "ADD-TEST-F1-3 " TO PAR-NAME. NC2074.2 +062500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +062600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +062700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +062800 ADD-TEST-F1-3. NC2074.2 +062900 ADD TBL-ITEM-1 IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2074.2 +063000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +063100 ACCUMULATOR1. NC2074.2 +063200 IF ACCUMULATOR1 EQUAL TO 3 NC2074.2 +063300 PERFORM PASS NC2074.2 +063400 GO TO ADD-WRITE-F1-3. NC2074.2 +063500 GO TO ADD-FAIL-F1-3. NC2074.2 +063600 ADD-DELETE-F1-3. NC2074.2 +063700 PERFORM DE-LETE. NC2074.2 +063800 GO TO ADD-WRITE-F1-3. NC2074.2 +063900 ADD-FAIL-F1-3. NC2074.2 +064000 MOVE TBL-ITEM-1 IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2074.2 +064100 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +064200 COMPUTED-N. NC2074.2 +064300 MOVE 3 TO CORRECT-N. NC2074.2 +064400 PERFORM FAIL. NC2074.2 +064500 ADD-WRITE-F1-3. NC2074.2 +064600 PERFORM PRINT-DETAIL. NC2074.2 +064700* NC2074.2 +064800 ADD-INIT-F1-4. NC2074.2 +064900 MOVE "ADD-TEST-F1-4 " TO PAR-NAME. NC2074.2 +065000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +065100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +065200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +065300 ADD-TEST-F1-4. NC2074.2 +065400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2074.2 +065500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +065600 ACCUMULATOR1. NC2074.2 +065700 IF ACCUMULATOR1 EQUAL TO 4 NC2074.2 +065800 PERFORM PASS NC2074.2 +065900 GO TO ADD-WRITE-F1-4. NC2074.2 +066000 GO TO ADD-FAIL-F1-4. NC2074.2 +066100 ADD-DELETE-F1-4. NC2074.2 +066200 PERFORM DE-LETE. NC2074.2 +066300 GO TO ADD-WRITE-F1-4. NC2074.2 +066400 ADD-FAIL-F1-4. NC2074.2 +066500 MOVE 4 TO CORRECT-N. NC2074.2 +066600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2074.2 +066700 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +066800 COMPUTED-N. NC2074.2 +066900 PERFORM FAIL. NC2074.2 +067000 ADD-WRITE-F1-4. NC2074.2 +067100 PERFORM PRINT-DETAIL. NC2074.2 +067200* NC2074.2 +067300 ADD-INIT-F1-5. NC2074.2 +067400 MOVE "ADD-TEST-F1-5 " TO PAR-NAME. NC2074.2 +067500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +067600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +067700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +067800 ADD-TEST-F1-5. NC2074.2 +067900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +068000 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +068100 ACCUMULATOR1. NC2074.2 +068200 IF ACCUMULATOR1 EQUAL TO 5 NC2074.2 +068300 PERFORM PASS NC2074.2 +068400 GO TO ADD-WRITE-F1-5. NC2074.2 +068500 GO TO ADD-FAIL-F1-5. NC2074.2 +068600 ADD-DELETE-F1-5. NC2074.2 +068700 PERFORM DE-LETE. NC2074.2 +068800 GO TO ADD-WRITE-F1-5. NC2074.2 +068900 ADD-FAIL-F1-5. NC2074.2 +069000 MOVE 5 TO CORRECT-N. NC2074.2 +069100 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +069200 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +069300 COMPUTED-N. NC2074.2 +069400 PERFORM FAIL. NC2074.2 +069500 ADD-WRITE-F1-5. NC2074.2 +069600 PERFORM PRINT-DETAIL. NC2074.2 +069700* NC2074.2 +069800 ADD-INIT-F1-6. NC2074.2 +069900 MOVE "ADD-TEST-F1-6 " TO PAR-NAME. NC2074.2 +070000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +070100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +070200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +070300 ADD-TEST-F1-6. NC2074.2 +070400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +070500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +070600 ACCUMULATOR1. NC2074.2 +070700 IF ACCUMULATOR1 EQUAL TO 6 NC2074.2 +070800 PERFORM PASS NC2074.2 +070900 GO TO ADD-WRITE-F1-6. NC2074.2 +071000 GO TO ADD-FAIL-F1-6. NC2074.2 +071100 ADD-DELETE-F1-6. NC2074.2 +071200 PERFORM DE-LETE. NC2074.2 +071300 GO TO ADD-WRITE-F1-6. NC2074.2 +071400 ADD-FAIL-F1-6. NC2074.2 +071500 MOVE 6 TO CORRECT-N. NC2074.2 +071600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +071700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +071800 COMPUTED-N. NC2074.2 +071900 PERFORM FAIL. NC2074.2 +072000 ADD-WRITE-F1-6. NC2074.2 +072100 PERFORM PRINT-DETAIL. NC2074.2 +072200* NC2074.2 +072300 ADD-INIT-F1-7. NC2074.2 +072400 MOVE "ADD-TEST-F1-7" TO PAR-NAME. NC2074.2 +072500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +072600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +072700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +072800 ADD-TEST-F1-7. NC2074.2 +072900 ADD TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +073000 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +073100 ACCUMULATOR1. NC2074.2 +073200 IF ACCUMULATOR1 EQUAL TO 7 NC2074.2 +073300 PERFORM PASS NC2074.2 +073400 GO TO ADD-WRITE-F1-7. NC2074.2 +073500 GO TO ADD-FAIL-F1-7. NC2074.2 +073600 ADD-DELETE-F1-7. NC2074.2 +073700 PERFORM DE-LETE. NC2074.2 +073800 GO TO ADD-WRITE-F1-7. NC2074.2 +073900 ADD-FAIL-F1-7. NC2074.2 +074000 MOVE TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +074100 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5A TO NC2074.2 +074200 COMPUTED-N. NC2074.2 +074300 MOVE 7 TO CORRECT-N. NC2074.2 +074400 PERFORM FAIL. NC2074.2 +074500 ADD-WRITE-F1-7. NC2074.2 +074600 PERFORM PRINT-DETAIL. NC2074.2 +074700* NC2074.2 +074800 ADD-INIT-F1-8. NC2074.2 +074900 MOVE "ADD-TEST-F1-8 " TO PAR-NAME. NC2074.2 +075000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +075100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +075200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +075300 ADD-TEST-F1-8. NC2074.2 +075400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +075500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +075600 ACCUMULATOR1. NC2074.2 +075700 IF ACCUMULATOR1 EQUAL TO 8 NC2074.2 +075800 PERFORM PASS NC2074.2 +075900 GO TO ADD-WRITE-F1-8. NC2074.2 +076000 GO TO ADD-FAIL-F1-8. NC2074.2 +076100 ADD-DELETE-F1-8. NC2074.2 +076200 PERFORM DE-LETE. NC2074.2 +076300 GO TO ADD-WRITE-F1-8. NC2074.2 +076400 ADD-FAIL-F1-8. NC2074.2 +076500 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +076600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5A TO NC2074.2 +076700 COMPUTED-N. NC2074.2 +076800 MOVE 8 TO CORRECT-N. NC2074.2 +076900 PERFORM FAIL. NC2074.2 +077000 ADD-WRITE-F1-8. NC2074.2 +077100 PERFORM PRINT-DETAIL. NC2074.2 +077200* NC2074.2 +077300 ADD-INIT-F2-9. NC2074.2 +077400 MOVE "ADD-TEST-F2-9 " TO PAR-NAME. NC2074.2 +077500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +077600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +077700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +077800 ADD-TEST-F2-9. NC2074.2 +077900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +078000 TABLE-LEVEL-3A IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +078100 TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +078200 TABLE-LEVEL-3A IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +078300 GIVING ACCUMULATOR2. NC2074.2 +078400 IF ACCUMULATOR2 EQUAL TO 18 NC2074.2 +078500 PERFORM PASS NC2074.2 +078600 GO TO ADD-WRITE-F2-9. NC2074.2 +078700 GO TO ADD-FAIL-F2-9. NC2074.2 +078800 ADD-DELETE-F2-9. NC2074.2 +078900 PERFORM DE-LETE. NC2074.2 +079000 GO TO ADD-WRITE-F2-9. NC2074.2 +079100 ADD-FAIL-F2-9. NC2074.2 +079200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +079300 MOVE 18 TO CORRECT-N. NC2074.2 +079400 PERFORM FAIL. NC2074.2 +079500 ADD-WRITE-F2-9. NC2074.2 +079600 PERFORM PRINT-DETAIL. NC2074.2 +079700* NC2074.2 +079800 ADD-INIT-F2-10. NC2074.2 +079900 MOVE "ADD-TEST-F2-10 " TO PAR-NAME. NC2074.2 +080000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +080100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +080200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +080300 ADD-TEST-F2-10. NC2074.2 +080400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +080500 TABLE-LEVEL-3A IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +080600 TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +080700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +080800 GIVING ACCUMULATOR2. NC2074.2 +080900 IF ACCUMULATOR2 EQUAL TO 20 NC2074.2 +081000 PERFORM PASS NC2074.2 +081100 GO TO ADD-WRITE-F2-10. NC2074.2 +081200 GO TO ADD-FAIL-F2-10. NC2074.2 +081300 ADD-DELETE-F2-10. NC2074.2 +081400 PERFORM DE-LETE. NC2074.2 +081500 GO TO ADD-WRITE-F2-10. NC2074.2 +081600 ADD-FAIL-F2-10. NC2074.2 +081700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +081800 MOVE 20 TO CORRECT-N. NC2074.2 +081900 PERFORM FAIL. NC2074.2 +082000 ADD-WRITE-F2-10. NC2074.2 +082100 PERFORM PRINT-DETAIL. NC2074.2 +082200* NC2074.2 +082300 ADD-INIT-F2-11. NC2074.2 +082400 MOVE "ADD-TEST-F2-11 " TO PAR-NAME. NC2074.2 +082500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +082600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +082700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +082800 ADD-TEST-F2-11. NC2074.2 +082900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +083000 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +083100 TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +083200 TABLE-LEVEL-3A OF TABLE-LEVEL-4B IN TABLE-LEVEL-5A NC2074.2 +083300 GIVING ACCUMULATOR2. NC2074.2 +083400 IF ACCUMULATOR2 EQUAL TO 22 NC2074.2 +083500 PERFORM PASS NC2074.2 +083600 GO TO ADD-WRITE-F2-11. NC2074.2 +083700 GO TO ADD-FAIL-F2-11. NC2074.2 +083800 ADD-DELETE-F2-11. NC2074.2 +083900 PERFORM DE-LETE. NC2074.2 +084000 GO TO ADD-WRITE-F2-11. NC2074.2 +084100 ADD-FAIL-F2-11. NC2074.2 +084200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +084300 MOVE 22 TO CORRECT-N. NC2074.2 +084400 PERFORM FAIL. NC2074.2 +084500 ADD-WRITE-F2-11. NC2074.2 +084600 PERFORM PRINT-DETAIL. NC2074.2 +084700* NC2074.2 +084800 ADD-INIT-F2-12. NC2074.2 +084900 MOVE "ADD-TEST-F2-12 " TO PAR-NAME. NC2074.2 +085000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +085100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +085200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +085300 ADD-TEST-F2-12. NC2074.2 +085400 ADD TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +085500 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +085600 TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +085700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +085800 GIVING ACCUMULATOR2. NC2074.2 +085900 IF ACCUMULATOR2 EQUAL TO 24 NC2074.2 +086000 PERFORM PASS NC2074.2 +086100 GO TO ADD-WRITE-F2-12. NC2074.2 +086200 GO TO ADD-FAIL-F2-12. NC2074.2 +086300 ADD-DELETE-F2-12. NC2074.2 +086400 PERFORM DE-LETE. NC2074.2 +086500 GO TO ADD-WRITE-F2-12. NC2074.2 +086600 ADD-FAIL-F2-12. NC2074.2 +086700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +086800 MOVE 24 TO CORRECT-N. NC2074.2 +086900 PERFORM FAIL. NC2074.2 +087000 ADD-WRITE-F2-12. NC2074.2 +087100 PERFORM PRINT-DETAIL. NC2074.2 +087200* NC2074.2 +087300 ADD-INIT-F2-13. NC2074.2 +087400 MOVE "ADD-TEST-F2-13 " TO PAR-NAME. NC2074.2 +087500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +087600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +087700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +087800 ADD-TEST-F2-13. NC2074.2 +087900 ADD TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A IN NC2074.2 +088000 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +088100 TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A IN NC2074.2 +088200 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +088300 GIVING ACCUMULATOR2. NC2074.2 +088400 IF ACCUMULATOR2 EQUAL TO 26 NC2074.2 +088500 PERFORM PASS NC2074.2 +088600 GO TO ADD-WRITE-F2-13. NC2074.2 +088700 GO TO ADD-FAIL-F2-13. NC2074.2 +088800 ADD-DELETE-F2-13. NC2074.2 +088900 PERFORM DE-LETE. NC2074.2 +089000 GO TO ADD-WRITE-F2-13. NC2074.2 +089100 ADD-FAIL-F2-13. NC2074.2 +089200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +089300 MOVE 26 TO CORRECT-N. NC2074.2 +089400 PERFORM FAIL. NC2074.2 +089500 ADD-WRITE-F2-13. NC2074.2 +089600 PERFORM PRINT-DETAIL. NC2074.2 +089700* NC2074.2 +089800 ADD-INIT-F2-14. NC2074.2 +089900 MOVE "ADD-TEST-F2-14 " TO PAR-NAME. NC2074.2 +090000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +090100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +090200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +090300 ADD-TEST-F2-14. NC2074.2 +090400 ADD TBL-ITEM-1 IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2074.2 +090500 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +090600 TBL-ITEM-1 IN TABLE-LEVEL-1B IN TABLE-LEVEL-2A IN NC2074.2 +090700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +090800 GIVING ACCUMULATOR2. NC2074.2 +090900 IF ACCUMULATOR2 EQUAL TO 28 NC2074.2 +091000 PERFORM PASS NC2074.2 +091100 GO TO ADD-WRITE-F2-14. NC2074.2 +091200 GO TO ADD-FAIL-F2-14. NC2074.2 +091300 ADD-DELETE-F2-14. NC2074.2 +091400 PERFORM DE-LETE. NC2074.2 +091500 GO TO ADD-WRITE-F2-14. NC2074.2 +091600 ADD-FAIL-F2-14. NC2074.2 +091700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +091800 MOVE 28 TO CORRECT-N. NC2074.2 +091900 PERFORM FAIL. NC2074.2 +092000 ADD-WRITE-F2-14. NC2074.2 +092100 PERFORM PRINT-DETAIL. NC2074.2 +092200* NC2074.2 +092300 ADD-INIT-F2-15. NC2074.2 +092400 MOVE "ADD-TEST-F2-15 " TO PAR-NAME. NC2074.2 +092500 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +092600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +092700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +092800 ADD-TEST-F2-15. NC2074.2 +092900 ADD TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2074.2 +093000 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +093100 TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B IN NC2074.2 +093200 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +093300 GIVING ACCUMULATOR2. NC2074.2 +093400 IF ACCUMULATOR2 EQUAL TO 30 NC2074.2 +093500 PERFORM PASS NC2074.2 +093600 GO TO ADD-WRITE-F2-15. NC2074.2 +093700 GO TO ADD-FAIL-F2-15. NC2074.2 +093800 ADD-DELETE-F2-15. NC2074.2 +093900 PERFORM DE-LETE. NC2074.2 +094000 GO TO ADD-WRITE-F2-15. NC2074.2 +094100 ADD-FAIL-F2-15. NC2074.2 +094200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +094300 MOVE 30 TO CORRECT-N. NC2074.2 +094400 PERFORM FAIL. NC2074.2 +094500 ADD-WRITE-F2-15. NC2074.2 +094600 PERFORM PRINT-DETAIL. NC2074.2 +094700* NC2074.2 +094800 ADD-INIT-F2-16. NC2074.2 +094900 MOVE "ADD-TEST-F2-16 " TO PAR-NAME. NC2074.2 +095000 MOVE "QUALIFIED ADDITION" TO FEATURE. NC2074.2 +095100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +095200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +095300 ADD-TEST-F2-16. NC2074.2 +095400 ADD TBL-ITEM-1 IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +095500 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +095600 TBL-ITEM-1 IN TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +095700 TABLE-LEVEL-3B OF TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +095800 GIVING ACCUMULATOR2. NC2074.2 +095900 IF ACCUMULATOR2 EQUAL TO 32 NC2074.2 +096000 PERFORM PASS NC2074.2 +096100 GO TO ADD-WRITE-F2-16. NC2074.2 +096200 GO TO ADD-FAIL-F2-16. NC2074.2 +096300 ADD-DELETE-F2-16. NC2074.2 +096400 PERFORM DE-LETE. NC2074.2 +096500 GO TO ADD-WRITE-F2-16. NC2074.2 +096600 ADD-FAIL-F2-16. NC2074.2 +096700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +096800 MOVE 32 TO CORRECT-N. NC2074.2 +096900 PERFORM FAIL. NC2074.2 +097000 ADD-WRITE-F2-16. NC2074.2 +097100 PERFORM PRINT-DETAIL. NC2074.2 +097200* NC2074.2 +097300 ADD-INIT-F3-17. NC2074.2 +097400 MOVE "ADD-TEST-F3-17" TO PAR-NAME. NC2074.2 +097500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +097600 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +097700 ADD CORRESPONDING TABLE-LEVEL-5A TO TABLE-LEVEL-5B. NC2074.2 +097800 ADD-TEST-F3-17. NC2074.2 +097900 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +098000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +098100 EQUAL TO 17 NC2074.2 +098200 PERFORM PASS NC2074.2 +098300 GO TO ADD-WRITE-F3-17. NC2074.2 +098400 GO TO ADD-FAIL-F3-17. NC2074.2 +098500 ADD-DELETE-F3-17. NC2074.2 +098600 PERFORM DE-LETE. NC2074.2 +098700 GO TO ADD-WRITE-F3-17. NC2074.2 +098800 ADD-FAIL-F3-17. NC2074.2 +098900 MOVE 17 TO CORRECT-N. NC2074.2 +099000 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +099100 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +099200 TO COMPUTED-N. NC2074.2 +099300 PERFORM FAIL. NC2074.2 +099400 ADD-WRITE-F3-17. NC2074.2 +099500 PERFORM PRINT-DETAIL. NC2074.2 +099600* NC2074.2 +099700 ADD-INIT-F3-18. NC2074.2 +099800 MOVE "ADD-TEST-F3-18" TO PAR-NAME. NC2074.2 +099900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +100000 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +100100 ADD-TEST-F3-18. NC2074.2 +100200 IF TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2074.2 +100300 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +100400 EQUAL TO 17 NC2074.2 +100500 PERFORM PASS NC2074.2 +100600 GO TO ADD-WRITE-F3-18. NC2074.2 +100700 ADD-DELETE-F3-18. NC2074.2 +100800 PERFORM DE-LETE. NC2074.2 +100900 GO TO ADD-WRITE-F3-18. NC2074.2 +101000 ADD-FAIL-F3-18. NC2074.2 +101100 MOVE 17 TO CORRECT-N. NC2074.2 +101200 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A OF NC2074.2 +101300 TABLE-LEVEL-3A OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +101400 TO COMPUTED-N. NC2074.2 +101500 PERFORM FAIL. NC2074.2 +101600 ADD-WRITE-F3-18. NC2074.2 +101700 PERFORM PRINT-DETAIL. NC2074.2 +101800* NC2074.2 +101900 ADD-INIT-F3-19. NC2074.2 +102000 MOVE "ADD-TEST-F3-19" TO PAR-NAME. NC2074.2 +102100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +102200 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +102300 ADD-TEST-F3-19. NC2074.2 +102400 IF TBL-ITEM-1 IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2074.2 +102500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +102600 EQUAL TO 17 NC2074.2 +102700 PERFORM PASS NC2074.2 +102800 GO TO ADD-WRITE-F3-19. NC2074.2 +102900 GO TO ADD-FAIL-F3-19. NC2074.2 +103000 ADD-DELETE-F3-19. NC2074.2 +103100 PERFORM DE-LETE. NC2074.2 +103200 GO TO ADD-WRITE-F3-19. NC2074.2 +103300 ADD-FAIL-F3-19. NC2074.2 +103400 MOVE 17 TO CORRECT-N. NC2074.2 +103500 MOVE TBL-ITEM-1 IN TABLE-LEVEL-1A IN TABLE-LEVEL-2B IN NC2074.2 +103600 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +103700 TO COMPUTED-N. NC2074.2 +103800 PERFORM FAIL. NC2074.2 +103900 ADD-WRITE-F3-19. NC2074.2 +104000 PERFORM PRINT-DETAIL. NC2074.2 +104100* NC2074.2 +104200 ADD-INIT-F3-20. NC2074.2 +104300 MOVE "ADD-TEST-F3-20" TO PAR-NAME. NC2074.2 +104400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +104500 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +104600 ADD-TEST-F3-20. NC2074.2 +104700 IF TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2074.2 +104800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +104900 EQUAL TO 17 NC2074.2 +105000 PERFORM PASS NC2074.2 +105100 GO TO ADD-WRITE-F3-20. NC2074.2 +105200 GO TO ADD-FAIL-F3-20. NC2074.2 +105300 ADD-DELETE-F3-20. NC2074.2 +105400 PERFORM DE-LETE. NC2074.2 +105500 GO TO ADD-WRITE-F3-20. NC2074.2 +105600 ADD-FAIL-F3-20. NC2074.2 +105700 MOVE 17 TO CORRECT-N. NC2074.2 +105800 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2B OF NC2074.2 +105900 TABLE-LEVEL-3A IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +106000 TO COMPUTED-N. NC2074.2 +106100 PERFORM FAIL. NC2074.2 +106200 ADD-WRITE-F3-20. NC2074.2 +106300 PERFORM PRINT-DETAIL. NC2074.2 +106400* NC2074.2 +106500 ADD-INIT-F3-21. NC2074.2 +106600 MOVE "ADD-TEST-F3-21" TO PAR-NAME. NC2074.2 +106700 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +106800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +106900 ADD-TEST-F3-21. NC2074.2 +107000 IF TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +107100 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +107200 EQUAL TO 17 NC2074.2 +107300 PERFORM PASS NC2074.2 +107400 GO TO ADD-WRITE-F3-21. NC2074.2 +107500 GO TO ADD-FAIL-F3-21. NC2074.2 +107600 ADD-DELETE-F3-21. NC2074.2 +107700 PERFORM DE-LETE. NC2074.2 +107800 GO TO ADD-WRITE-F3-21. NC2074.2 +107900 ADD-FAIL-F3-21. NC2074.2 +108000 MOVE 17 TO CORRECT-N. NC2074.2 +108100 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A OF TABLE-LEVEL-2A OF NC2074.2 +108200 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +108300 TO COMPUTED-N. NC2074.2 +108400 PERFORM FAIL. NC2074.2 +108500 ADD-WRITE-F3-21. NC2074.2 +108600 PERFORM PRINT-DETAIL. NC2074.2 +108700* NC2074.2 +108800 ADD-INIT-F3-22. NC2074.2 +108900 MOVE "ADD-TEST-F3-22" TO PAR-NAME. NC2074.2 +109000 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +109100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +109200 ADD-TEST-F3-22. NC2074.2 +109300 IF TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +109400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +109500 EQUAL TO 17 NC2074.2 +109600 PERFORM PASS NC2074.2 +109700 GO TO ADD-WRITE-F3-22. NC2074.2 +109800 GO TO ADD-FAIL-F3-22. NC2074.2 +109900 ADD-DELETE-F3-22. NC2074.2 +110000 PERFORM DE-LETE. NC2074.2 +110100 GO TO ADD-WRITE-F3-22. NC2074.2 +110200 ADD-FAIL-F3-22. NC2074.2 +110300 MOVE 17 TO CORRECT-N. NC2074.2 +110400 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B OF TABLE-LEVEL-2A IN NC2074.2 +110500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B TO NC2074.2 +110600 COMPUTED-N. NC2074.2 +110700 PERFORM FAIL. NC2074.2 +110800 ADD-WRITE-F3-22. NC2074.2 +110900 PERFORM PRINT-DETAIL. NC2074.2 +111000* NC2074.2 +111100 ADD-INIT-F3-23. NC2074.2 +111200 MOVE "ADD-TEST-F3-23" TO PAR-NAME. NC2074.2 +111300 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +111400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +111500 ADD-TEST-F3-23. NC2074.2 +111600 IF TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +111700 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +111800 EQUAL TO 17 NC2074.2 +111900 PERFORM PASS NC2074.2 +112000 GO TO ADD-WRITE-F3-23. NC2074.2 +112100 GO TO ADD-FAIL-F3-23. NC2074.2 +112200 ADD-DELETE-F3-23. NC2074.2 +112300 PERFORM DE-LETE. NC2074.2 +112400 GO TO ADD-WRITE-F3-23. NC2074.2 +112500 ADD-FAIL-F3-23. NC2074.2 +112600 MOVE 17 TO CORRECT-N. NC2074.2 +112700 MOVE TBL-ITEM-1 IN TABLE-LEVEL-1A OF TABLE-LEVEL-2B OF NC2074.2 +112800 TABLE-LEVEL-3B OF TABLE-LEVEL-4A OF TABLE-LEVEL-5B TO NC2074.2 +112900 COMPUTED-N. NC2074.2 +113000 PERFORM FAIL. NC2074.2 +113100 ADD-WRITE-F3-23. NC2074.2 +113200 PERFORM PRINT-DETAIL. NC2074.2 +113300* NC2074.2 +113400 ADD-INIT-F3-24. NC2074.2 +113500 MOVE "ADD-TEST-F3-24" TO PAR-NAME. NC2074.2 +113600 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +113700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +113800 ADD-TEST-F3-24. NC2074.2 +113900 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +114000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B NC2074.2 +114100 EQUAL TO 17 NC2074.2 +114200 PERFORM PASS NC2074.2 +114300 GO TO ADD-WRITE-F3-24. NC2074.2 +114400 GO TO ADD-FAIL-F3-24. NC2074.2 +114500 ADD-DELETE-F3-24. NC2074.2 +114600 PERFORM DE-LETE. NC2074.2 +114700 GO TO ADD-WRITE-F3-24. NC2074.2 +114800 ADD-FAIL-F3-24. NC2074.2 +114900 MOVE 17 TO CORRECT-N. NC2074.2 +115000 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B IN NC2074.2 +115100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A IN TABLE-LEVEL-5B TO NC2074.2 +115200 COMPUTED-N. NC2074.2 +115300 PERFORM FAIL. NC2074.2 +115400 ADD-WRITE-F3-24. NC2074.2 +115500 PERFORM PRINT-DETAIL. NC2074.2 +115600 PERFORM END-ROUTINE. NC2074.2 +115700* NC2074.2 +115800 ADD-INIT-F1-25. NC2074.2 +115900* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +116000 MOVE "ADD-TEST-F1-25 " TO PAR-NAME. NC2074.2 +116100 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +116200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +116300 ADD-TEST-F1-25. NC2074.2 +116400 ADD GROUP-49-1 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +116500 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +116600 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +116700 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +116800 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +116900 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +117000 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +117100 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +117200 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +117300 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +117400 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +117500 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +117600 IN SECOND-GROUP NC2074.2 +117700 TO ACCUMULATOR2. NC2074.2 +117800 IF ACCUMULATOR2 EQUAL TO 100 NC2074.2 +117900 PERFORM PASS NC2074.2 +118000 GO TO ADD-WRITE-F1-25. NC2074.2 +118100 GO TO ADD-FAIL-F1-25. NC2074.2 +118200 ADD-DELETE-F1-25. NC2074.2 +118300 PERFORM DE-LETE. NC2074.2 +118400 GO TO ADD-WRITE-F1-25. NC2074.2 +118500 ADD-FAIL-F1-25. NC2074.2 +118600 MOVE 100 TO CORRECT-N. NC2074.2 +118700 MOVE GROUP-49-1 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +118800 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +118900 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +119000 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +119100 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +119200 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +119300 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +119400 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +119500 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +119600 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +119700 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +119800 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +119900 IN SECOND-GROUP NC2074.2 +120000 TO COMPUTED-N. NC2074.2 +120100 PERFORM FAIL. NC2074.2 +120200 ADD-WRITE-F1-25. NC2074.2 +120300 PERFORM PRINT-DETAIL. NC2074.2 +120400* NC2074.2 +120500 SUB-INIT-F2-1. NC2074.2 +120600 MOVE "SUB-TEST-F2-1 " TO PAR-NAME. NC2074.2 +120700 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +120800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +120900 MOVE TABLE-5B-INIT TO TABLE-LEVEL-5B. NC2074.2 +121000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +121100 SUB-TEST-F2-1. NC2074.2 +121200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +121300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +121400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +121500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +121600 GIVING ACCUMULATOR1. NC2074.2 +121700 IF ACCUMULATOR1 EQUAL TO 15 NC2074.2 +121800 PERFORM PASS NC2074.2 +121900 GO TO SUB-WRITE-F2-1. NC2074.2 +122000 GO TO SUB-FAIL-F2-1. NC2074.2 +122100 SUB-DELETE-F2-1. NC2074.2 +122200 PERFORM DE-LETE. NC2074.2 +122300 GO TO SUB-WRITE-F2-1. NC2074.2 +122400 SUB-FAIL-F2-1. NC2074.2 +122500 MOVE 15 TO CORRECT-N. NC2074.2 +122600 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +122700 PERFORM FAIL. NC2074.2 +122800 SUB-WRITE-F2-1. NC2074.2 +122900 PERFORM PRINT-DETAIL. NC2074.2 +123000* NC2074.2 +123100 SUB-INIT-F2-2. NC2074.2 +123200 MOVE "SUB-TEST-F2-2 " TO PAR-NAME. NC2074.2 +123300 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +123400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +123500 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +123600 SUB-TEST-F2-2. NC2074.2 +123700 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +123800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +123900 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +124000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +124100 GIVING ACCUMULATOR1. NC2074.2 +124200 IF ACCUMULATOR1 EQUAL TO 13 NC2074.2 +124300 PERFORM PASS NC2074.2 +124400 GO TO SUB-WRITE-F2-2. NC2074.2 +124500 GO TO SUB-FAIL-F2-2. NC2074.2 +124600 SUB-DELETE-F2-2. NC2074.2 +124700 PERFORM DE-LETE. NC2074.2 +124800 GO TO SUB-WRITE-F2-2. NC2074.2 +124900 SUB-FAIL-F2-2. NC2074.2 +125000 MOVE 13 TO CORRECT-N. NC2074.2 +125100 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +125200 PERFORM FAIL. NC2074.2 +125300 SUB-WRITE-F2-2. NC2074.2 +125400 PERFORM PRINT-DETAIL. NC2074.2 +125500* NC2074.2 +125600 SUB-INIT-F2-3. NC2074.2 +125700 MOVE "SUB-TEST-F2-3 " TO PAR-NAME. NC2074.2 +125800 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +125900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +126000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +126100 SUB-TEST-F2-3. NC2074.2 +126200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +126300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +126400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +126500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +126600 GIVING ACCUMULATOR1. NC2074.2 +126700 IF ACCUMULATOR1 EQUAL TO 11 NC2074.2 +126800 PERFORM PASS NC2074.2 +126900 GO TO SUB-WRITE-F2-3. NC2074.2 +127000 GO TO SUB-FAIL-F2-3. NC2074.2 +127100 SUB-DELETE-F2-3. NC2074.2 +127200 PERFORM DE-LETE. NC2074.2 +127300 GO TO SUB-WRITE-F2-3. NC2074.2 +127400 SUB-FAIL-F2-3. NC2074.2 +127500 MOVE 11 TO CORRECT-N. NC2074.2 +127600 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +127700 PERFORM FAIL. NC2074.2 +127800 SUB-WRITE-F2-3. NC2074.2 +127900 PERFORM PRINT-DETAIL. NC2074.2 +128000* NC2074.2 +128100 SUB-INIT-F2-4. NC2074.2 +128200 MOVE "SUB-TEST-F2-4 " TO PAR-NAME. NC2074.2 +128300 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +128400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +128500 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +128600 SUB-TEST-F2-4. NC2074.2 +128700 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +128800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +128900 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +129000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +129100 GIVING ACCUMULATOR1. NC2074.2 +129200 IF ACCUMULATOR1 EQUAL TO 9 NC2074.2 +129300 PERFORM PASS NC2074.2 +129400 GO TO SUB-WRITE-F2-4. NC2074.2 +129500 GO TO SUB-FAIL-F2-4. NC2074.2 +129600 SUB-DELETE-F2-4. NC2074.2 +129700 PERFORM DE-LETE. NC2074.2 +129800 GO TO SUB-WRITE-F2-4. NC2074.2 +129900 SUB-FAIL-F2-4. NC2074.2 +130000 MOVE 9 TO CORRECT-N. NC2074.2 +130100 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +130200 PERFORM FAIL. NC2074.2 +130300 SUB-WRITE-F2-4. NC2074.2 +130400 PERFORM PRINT-DETAIL. NC2074.2 +130500* NC2074.2 +130600 SUB-INIT-F2-5. NC2074.2 +130700 MOVE "QUALIFIED SUBTRACT" TO FEATURE. NC2074.2 +130800 MOVE "SUB-TEST-F2-5 " TO PAR-NAME. NC2074.2 +130900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +131000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +131100 SUB-TEST-F2-5. NC2074.2 +131200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +131300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +131400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +131500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +131600 GIVING ACCUMULATOR1. NC2074.2 +131700 IF ACCUMULATOR1 EQUAL TO 7 NC2074.2 +131800 PERFORM PASS NC2074.2 +131900 GO TO SUB-WRITE-F2-5. NC2074.2 +132000 GO TO SUB-FAIL-F2-5. NC2074.2 +132100 SUB-DELETE-F2-5. NC2074.2 +132200 PERFORM DE-LETE. NC2074.2 +132300 GO TO SUB-WRITE-F2-5. NC2074.2 +132400 SUB-FAIL-F2-5. NC2074.2 +132500 MOVE 7 TO CORRECT-N. NC2074.2 +132600 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +132700 PERFORM FAIL. NC2074.2 +132800 SUB-WRITE-F2-5. NC2074.2 +132900 PERFORM PRINT-DETAIL. NC2074.2 +133000* NC2074.2 +133100 SUB-INIT-F2-6. NC2074.2 +133200 MOVE "SUB-TEST-F2-6 " TO PAR-NAME. NC2074.2 +133300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +133400 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +133500 SUB-TEST-F2-6. NC2074.2 +133600 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +133700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +133800 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +133900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +134000 GIVING ACCUMULATOR1. NC2074.2 +134100 IF ACCUMULATOR1 EQUAL TO 5 NC2074.2 +134200 PERFORM PASS NC2074.2 +134300 GO TO SUB-WRITE-F2-6. NC2074.2 +134400 GO TO SUB-FAIL-F2-6. NC2074.2 +134500 SUB-DELETE-F2-6. NC2074.2 +134600 PERFORM DE-LETE. NC2074.2 +134700 GO TO SUB-WRITE-F2-6. NC2074.2 +134800 SUB-FAIL-F2-6. NC2074.2 +134900 MOVE 5 TO CORRECT-N. NC2074.2 +135000 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +135100 PERFORM FAIL. NC2074.2 +135200 SUB-WRITE-F2-6. NC2074.2 +135300 PERFORM PRINT-DETAIL. NC2074.2 +135400* NC2074.2 +135500 SUB-INIT-F2-7. NC2074.2 +135600 MOVE "SUB-TEST-F2-7 " TO PAR-NAME. NC2074.2 +135700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +135800 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +135900 SUB-TEST-F2-7. NC2074.2 +136000 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +136100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +136200 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +136300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +136400 GIVING ACCUMULATOR1. NC2074.2 +136500 IF ACCUMULATOR1 EQUAL TO 3 NC2074.2 +136600 PERFORM PASS NC2074.2 +136700 GO TO SUB-WRITE-F2-7. NC2074.2 +136800 GO TO SUB-FAIL-F2-7. NC2074.2 +136900 SUB-DELETE-F2-7. NC2074.2 +137000 PERFORM DE-LETE. NC2074.2 +137100 GO TO SUB-WRITE-F2-7. NC2074.2 +137200 SUB-FAIL-F2-7. NC2074.2 +137300 MOVE 3 TO CORRECT-N. NC2074.2 +137400 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +137500 PERFORM FAIL. NC2074.2 +137600 SUB-WRITE-F2-7. NC2074.2 +137700 PERFORM PRINT-DETAIL. NC2074.2 +137800* NC2074.2 +137900 SUB-INIT-F2-8. NC2074.2 +138000 MOVE "SUB-TEST-F2-8 " TO PAR-NAME. NC2074.2 +138100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +138200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +138300 SUB-TEST-F2-8. NC2074.2 +138400 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +138500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +138600 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +138700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5B NC2074.2 +138800 GIVING ACCUMULATOR1. NC2074.2 +138900 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +139000 PERFORM PASS NC2074.2 +139100 GO TO SUB-WRITE-F2-8. NC2074.2 +139200 GO TO SUB-FAIL-F2-8. NC2074.2 +139300 SUB-DELETE-F2-8. NC2074.2 +139400 PERFORM DE-LETE. NC2074.2 +139500 GO TO SUB-WRITE-F2-8. NC2074.2 +139600 SUB-FAIL-F2-8. NC2074.2 +139700 MOVE 1 TO CORRECT-N. NC2074.2 +139800 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +139900 PERFORM FAIL. NC2074.2 +140000 SUB-WRITE-F2-8. NC2074.2 +140100 PERFORM PRINT-DETAIL. NC2074.2 +140200* NC2074.2 +140300 SUB-INIT-F2-9. NC2074.2 +140400 MOVE "SUB-TEST-F2-9 " TO PAR-NAME. NC2074.2 +140500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +140600 MOVE 5 TO ACCUMULATOR2. NC2074.2 +140700 SUB-TEST-F2-9. NC2074.2 +140800 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +140900 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +141000 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +141100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +141200 GIVING ACCUMULATOR2. NC2074.2 +141300 IF ACCUMULATOR2 EQUAL TO ZERO NC2074.2 +141400 PERFORM PASS NC2074.2 +141500 GO TO SUB-WRITE-F2-9. NC2074.2 +141600 GO TO SUB-FAIL-F2-9. NC2074.2 +141700 SUB-DELETE-F2-9. NC2074.2 +141800 PERFORM DE-LETE. NC2074.2 +141900 GO TO SUB-WRITE-F2-9. NC2074.2 +142000 SUB-FAIL-F2-9. NC2074.2 +142100 MOVE ZERO TO CORRECT-N. NC2074.2 +142200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +142300 PERFORM FAIL. NC2074.2 +142400 SUB-WRITE-F2-9. NC2074.2 +142500 PERFORM PRINT-DETAIL. NC2074.2 +142600* NC2074.2 +142700 SUB-INIT-F2-10. NC2074.2 +142800 MOVE "SUB-TEST-F2-10 " TO PAR-NAME. NC2074.2 +142900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +143000 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +143100 SUB-TEST-F2-10. NC2074.2 +143200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +143300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +143400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +143500 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +143600 GIVING ACCUMULATOR2. NC2074.2 +143700 IF ACCUMULATOR2 EQUAL TO 3 NC2074.2 +143800 PERFORM PASS NC2074.2 +143900 GO TO SUB-WRITE-F2-10. NC2074.2 +144000 GO TO SUB-FAIL-F2-10. NC2074.2 +144100 SUB-DELETE-F2-10. NC2074.2 +144200 PERFORM DE-LETE. NC2074.2 +144300 GO TO SUB-WRITE-F2-10. NC2074.2 +144400 SUB-FAIL-F2-10. NC2074.2 +144500 MOVE 3 TO CORRECT-N. NC2074.2 +144600 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +144700 PERFORM FAIL. NC2074.2 +144800 SUB-WRITE-F2-10. NC2074.2 +144900 PERFORM PRINT-DETAIL. NC2074.2 +145000* NC2074.2 +145100 SUB-INIT-F2-11. NC2074.2 +145200 MOVE "SUB-TEST-F2-11 " TO PAR-NAME. NC2074.2 +145300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +145400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +145500 SUB-TEST-F2-11. NC2074.2 +145600 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +145700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +145800 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +145900 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +146000 GIVING ACCUMULATOR2. NC2074.2 +146100 IF ACCUMULATOR2 EQUAL TO 5 NC2074.2 +146200 PERFORM PASS NC2074.2 +146300 GO TO SUB-WRITE-F2-11. NC2074.2 +146400 GO TO SUB-FAIL-F2-11. NC2074.2 +146500 SUB-DELETE-F2-11. NC2074.2 +146600 PERFORM DE-LETE. NC2074.2 +146700 GO TO SUB-WRITE-F2-11. NC2074.2 +146800 SUB-FAIL-F2-11. NC2074.2 +146900 MOVE 5 TO CORRECT-N. NC2074.2 +147000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +147100 PERFORM FAIL. NC2074.2 +147200 SUB-WRITE-F2-11. NC2074.2 +147300 PERFORM PRINT-DETAIL. NC2074.2 +147400* NC2074.2 +147500 SUB-INIT-F2-12. NC2074.2 +147600 MOVE "SUB-TEST-F2-12 " TO PAR-NAME. NC2074.2 +147700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +147800 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +147900 SUB-TEST-F2-12. NC2074.2 +148000 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +148100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +148200 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +148300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +148400 GIVING ACCUMULATOR2. NC2074.2 +148500 IF ACCUMULATOR2 EQUAL TO 7 NC2074.2 +148600 PERFORM PASS NC2074.2 +148700 GO TO SUB-WRITE-F2-12. NC2074.2 +148800 GO TO SUB-FAIL-F2-12. NC2074.2 +148900 SUB-DELETE-F2-12. NC2074.2 +149000 PERFORM DE-LETE. NC2074.2 +149100 GO TO SUB-WRITE-F2-12. NC2074.2 +149200 SUB-FAIL-F2-12. NC2074.2 +149300 MOVE 7 TO CORRECT-N. NC2074.2 +149400 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +149500 PERFORM FAIL. NC2074.2 +149600 SUB-WRITE-F2-12. NC2074.2 +149700 PERFORM PRINT-DETAIL. NC2074.2 +149800* NC2074.2 +149900 SUB-INIT-F2-13. NC2074.2 +150000 MOVE "SUB-TEST-F2-13 " TO PAR-NAME. NC2074.2 +150100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +150200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +150300 SUB-TEST-F2-13. NC2074.2 +150400 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +150500 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +150600 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +150700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +150800 GIVING ACCUMULATOR2. NC2074.2 +150900 IF ACCUMULATOR2 EQUAL TO 9 NC2074.2 +151000 PERFORM PASS NC2074.2 +151100 GO TO SUB-WRITE-F2-13. NC2074.2 +151200 GO TO SUB-FAIL-F2-13. NC2074.2 +151300 SUB-DELETE-F2-13. NC2074.2 +151400 PERFORM DE-LETE. NC2074.2 +151500 GO TO SUB-WRITE-F2-13. NC2074.2 +151600 SUB-FAIL-F2-13. NC2074.2 +151700 MOVE 9 TO CORRECT-N. NC2074.2 +151800 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +151900 PERFORM FAIL. NC2074.2 +152000 SUB-WRITE-F2-13. NC2074.2 +152100 PERFORM PRINT-DETAIL. NC2074.2 +152200* NC2074.2 +152300 SUB-INIT-F2-14. NC2074.2 +152400 MOVE "SUB-TEST-F2-14 " TO PAR-NAME. NC2074.2 +152500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +152600 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +152700 SUB-TEST-F2-14. NC2074.2 +152800 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +152900 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +153000 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +153100 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +153200 GIVING ACCUMULATOR2. NC2074.2 +153300 IF ACCUMULATOR2 EQUAL TO 11 NC2074.2 +153400 PERFORM PASS NC2074.2 +153500 GO TO SUB-WRITE-F2-14. NC2074.2 +153600 GO TO SUB-FAIL-F2-14. NC2074.2 +153700 SUB-DELETE-F2-14. NC2074.2 +153800 PERFORM DE-LETE. NC2074.2 +153900 GO TO SUB-WRITE-F2-14. NC2074.2 +154000 SUB-FAIL-F2-14. NC2074.2 +154100 MOVE 11 TO CORRECT-N. NC2074.2 +154200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +154300 PERFORM FAIL. NC2074.2 +154400 SUB-WRITE-F2-14. NC2074.2 +154500 PERFORM PRINT-DETAIL. NC2074.2 +154600* NC2074.2 +154700 SUB-INIT-F2-15. NC2074.2 +154800 MOVE "SUB-TEST-F2-15 " TO PAR-NAME. NC2074.2 +154900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +155000 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +155100 SUB-TEST-F2-15. NC2074.2 +155200 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +155300 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +155400 FROM TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +155500 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +155600 GIVING ACCUMULATOR2. NC2074.2 +155700 IF ACCUMULATOR2 EQUAL TO 13 NC2074.2 +155800 PERFORM PASS NC2074.2 +155900 GO TO SUB-WRITE-F2-15. NC2074.2 +156000 GO TO SUB-FAIL-F2-15. NC2074.2 +156100 SUB-DELETE-F2-15. NC2074.2 +156200 PERFORM DE-LETE. NC2074.2 +156300 GO TO SUB-WRITE-F2-15. NC2074.2 +156400 SUB-FAIL-F2-15. NC2074.2 +156500 MOVE 13 TO CORRECT-N. NC2074.2 +156600 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +156700 PERFORM FAIL. NC2074.2 +156800 SUB-WRITE-F2-15. NC2074.2 +156900 PERFORM PRINT-DETAIL. NC2074.2 +157000* NC2074.2 +157100 SUB-INIT-F2-16. NC2074.2 +157200 MOVE "SUB-TEST-F2-16 " TO PAR-NAME. NC2074.2 +157300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +157400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +157500 SUB-TEST-F2-16. NC2074.2 +157600 SUBTRACT TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +157700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5B NC2074.2 +157800 FROM TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +157900 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +158000 GIVING ACCUMULATOR2. NC2074.2 +158100 IF ACCUMULATOR2 EQUAL TO 15 NC2074.2 +158200 PERFORM PASS NC2074.2 +158300 GO TO SUB-WRITE-F2-16. NC2074.2 +158400 GO TO SUB-FAIL-F2-16. NC2074.2 +158500 SUB-DELETE-F2-16. NC2074.2 +158600 PERFORM DE-LETE. NC2074.2 +158700 GO TO SUB-WRITE-F2-16. NC2074.2 +158800 SUB-FAIL-F2-16. NC2074.2 +158900 MOVE 15 TO CORRECT-N. NC2074.2 +159000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +159100 PERFORM FAIL. NC2074.2 +159200 SUB-WRITE-F2-16. NC2074.2 +159300 PERFORM PRINT-DETAIL. NC2074.2 +159400* NC2074.2 +159500 SUB-INIT-F3-17. NC2074.2 +159600 MOVE "SUB-TEST-F3-17" TO PAR-NAME. NC2074.2 +159700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +159800 MOVE " CORRESPONDING" TO FEATURE. NC2074.2 +159900 SUBTRACT CORRESPONDING TABLE-LEVEL-5A FROM TABLE-LEVEL-5C. NC2074.2 +160000 SUB-TEST-F3-17. NC2074.2 +160100 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +160200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +160300 EQUAL TO ZERO NC2074.2 +160400 PERFORM PASS NC2074.2 +160500 GO TO SUB-WRITE-F3-17. NC2074.2 +160600 GO TO SUB-FAIL-F3-17. NC2074.2 +160700 SUB-DELETE-F3-17. NC2074.2 +160800 PERFORM DE-LETE. NC2074.2 +160900 GO TO SUB-WRITE-F3-17. NC2074.2 +161000 SUB-FAIL-F3-17. NC2074.2 +161100 MOVE 00 TO CORRECT-N. NC2074.2 +161200 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +161300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +161400 TO COMPUTED-N. NC2074.2 +161500 PERFORM FAIL. NC2074.2 +161600 SUB-WRITE-F3-17. NC2074.2 +161700 PERFORM PRINT-DETAIL. NC2074.2 +161800* NC2074.2 +161900 SUB-INIT-F3-18. NC2074.2 +162000 MOVE "SUB-TEST-F3-18" TO PAR-NAME. NC2074.2 +162100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +162200 SUB-TEST-F3-18. NC2074.2 +162300 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +162400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +162500 EQUAL TO ZERO NC2074.2 +162600 PERFORM PASS NC2074.2 +162700 GO TO SUB-WRITE-F3-18. NC2074.2 +162800 GO TO SUB-FAIL-F3-18. NC2074.2 +162900 SUB-DELETE-F3-18. NC2074.2 +163000 PERFORM DE-LETE. NC2074.2 +163100 GO TO SUB-WRITE-F3-18. NC2074.2 +163200 SUB-FAIL-F3-18. NC2074.2 +163300 MOVE 00 TO CORRECT-N. NC2074.2 +163400 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +163500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +163600 TO COMPUTED-N. NC2074.2 +163700 PERFORM FAIL. NC2074.2 +163800 SUB-WRITE-F3-18. NC2074.2 +163900 PERFORM PRINT-DETAIL. NC2074.2 +164000* NC2074.2 +164100 SUB-INIT-F3-19. NC2074.2 +164200 MOVE "SUB-TEST-F3-19" TO PAR-NAME. NC2074.2 +164300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +164400 SUB-TEST-F3-19. NC2074.2 +164500 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +164600 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +164700 EQUAL TO ZERO NC2074.2 +164800 PERFORM PASS NC2074.2 +164900 GO TO SUB-WRITE-F3-19. NC2074.2 +165000 GO TO SUB-FAIL-F3-19. NC2074.2 +165100 SUB-DELETE-F3-19. NC2074.2 +165200 PERFORM DE-LETE. NC2074.2 +165300 GO TO SUB-WRITE-F3-19. NC2074.2 +165400 SUB-FAIL-F3-19. NC2074.2 +165500 MOVE 00 TO CORRECT-N. NC2074.2 +165600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +165700 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +165800 TO COMPUTED-N. NC2074.2 +165900 PERFORM FAIL. NC2074.2 +166000 SUB-WRITE-F3-19. NC2074.2 +166100 PERFORM PRINT-DETAIL. NC2074.2 +166200* NC2074.2 +166300 SUB-INIT-F3-20. NC2074.2 +166400 MOVE "SUB-TEST-F3-20" TO PAR-NAME. NC2074.2 +166500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +166600 SUB-TEST-F3-20. NC2074.2 +166700 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +166800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +166900 EQUAL TO ZERO NC2074.2 +167000 PERFORM PASS NC2074.2 +167100 GO TO SUB-WRITE-F3-20. NC2074.2 +167200 GO TO SUB-FAIL-F3-20. NC2074.2 +167300 SUB-DELETE-F3-20. NC2074.2 +167400 PERFORM DE-LETE. NC2074.2 +167500 GO TO SUB-WRITE-F3-20. NC2074.2 +167600 SUB-FAIL-F3-20. NC2074.2 +167700 MOVE 00 TO CORRECT-N. NC2074.2 +167800 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +167900 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +168000 TO COMPUTED-N. NC2074.2 +168100 PERFORM FAIL. NC2074.2 +168200 SUB-WRITE-F3-20. NC2074.2 +168300 PERFORM PRINT-DETAIL. NC2074.2 +168400* NC2074.2 +168500 SUB-INIT-F3-21. NC2074.2 +168600 MOVE "SUB-TEST-F3-21" TO PAR-NAME. NC2074.2 +168700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +168800 SUB-TEST-F3-21. NC2074.2 +168900 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +169000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +169100 EQUAL TO ZERO NC2074.2 +169200 PERFORM PASS NC2074.2 +169300 GO TO SUB-WRITE-F3-21. NC2074.2 +169400 GO TO SUB-FAIL-F3-21. NC2074.2 +169500 SUB-DELETE-F3-21. NC2074.2 +169600 PERFORM DE-LETE. NC2074.2 +169700 GO TO SUB-WRITE-F3-21. NC2074.2 +169800 SUB-FAIL-F3-21. NC2074.2 +169900 MOVE 00 TO CORRECT-N. NC2074.2 +170000 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +170100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +170200 TO COMPUTED-N. NC2074.2 +170300 PERFORM FAIL. NC2074.2 +170400 SUB-WRITE-F3-21. NC2074.2 +170500 PERFORM PRINT-DETAIL. NC2074.2 +170600* NC2074.2 +170700 SUB-INIT-F3-22. NC2074.2 +170800 MOVE "SUB-TEST-F3-22" TO PAR-NAME. NC2074.2 +170900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +171000 SUB-TEST-F3-22. NC2074.2 +171100 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +171200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +171300 EQUAL TO ZERO NC2074.2 +171400 PERFORM PASS NC2074.2 +171500 GO TO SUB-WRITE-F3-22. NC2074.2 +171600 GO TO SUB-FAIL-F3-22. NC2074.2 +171700 SUB-DELETE-F3-22. NC2074.2 +171800 PERFORM DE-LETE. NC2074.2 +171900 GO TO SUB-WRITE-F3-22. NC2074.2 +172000 SUB-FAIL-F3-22. NC2074.2 +172100 MOVE 00 TO CORRECT-N. NC2074.2 +172200 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +172300 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +172400 TO COMPUTED-N. NC2074.2 +172500 PERFORM FAIL. NC2074.2 +172600 SUB-WRITE-F3-22. NC2074.2 +172700 PERFORM PRINT-DETAIL. NC2074.2 +172800* NC2074.2 +172900 SUB-INIT-F3-23. NC2074.2 +173000 MOVE "SUB-TEST-F3-23" TO PAR-NAME. NC2074.2 +173100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +173200 SUB-TEST-F3-23. NC2074.2 +173300 IF TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +173400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +173500 EQUAL TO ZERO NC2074.2 +173600 PERFORM PASS NC2074.2 +173700 GO TO SUB-WRITE-F3-23. NC2074.2 +173800 GO TO SUB-FAIL-F3-23. NC2074.2 +173900 SUB-DELETE-F3-23. NC2074.2 +174000 PERFORM DE-LETE. NC2074.2 +174100 GO TO SUB-WRITE-F3-23. NC2074.2 +174200 SUB-FAIL-F3-23. NC2074.2 +174300 MOVE 00 TO CORRECT-N. NC2074.2 +174400 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +174500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +174600 TO COMPUTED-N. NC2074.2 +174700 PERFORM FAIL. NC2074.2 +174800 SUB-WRITE-F3-23. NC2074.2 +174900 PERFORM PRINT-DETAIL. NC2074.2 +175000* NC2074.2 +175100 SUB-INIT-F3-24. NC2074.2 +175200 MOVE "SUB-TEST-F3-24" TO PAR-NAME. NC2074.2 +175300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +175400 SUB-TEST-F3-24. NC2074.2 +175500 IF TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +175600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +175700 EQUAL TO ZERO NC2074.2 +175800 PERFORM PASS NC2074.2 +175900 GO TO SUB-WRITE-F3-24. NC2074.2 +176000 GO TO SUB-FAIL-F3-24. NC2074.2 +176100 SUB-DELETE-F3-24. NC2074.2 +176200 PERFORM DE-LETE. NC2074.2 +176300 GO TO SUB-WRITE-F3-24. NC2074.2 +176400 SUB-FAIL-F3-24. NC2074.2 +176500 MOVE 00 TO CORRECT-N. NC2074.2 +176600 MOVE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +176700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5C NC2074.2 +176800 TO COMPUTED-N. NC2074.2 +176900 PERFORM FAIL. NC2074.2 +177000 SUB-WRITE-F3-24. NC2074.2 +177100 PERFORM PRINT-DETAIL. NC2074.2 +177200* NC2074.2 +177300 SUB-INIT-F2-25. NC2074.2 +177400* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +177500 MOVE "SUB-TEST-F2-25 " TO PAR-NAME. NC2074.2 +177600 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +177700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +177800 SUB-TEST-F2-25. NC2074.2 +177900 SUBTRACT GROUP-49-2 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +178000 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +178100 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +178200 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +178300 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +178400 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +178500 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +178600 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +178700 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +178800 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +178900 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +179000 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +179100 IN SECOND-GROUP NC2074.2 +179200 FROM 200 NC2074.2 +179300 GIVING ACCUMULATOR1. NC2074.2 +179400 IF ACCUMULATOR1 EQUAL TO ZERO NC2074.2 +179500 PERFORM PASS NC2074.2 +179600 GO TO SUB-WRITE-F2-25. NC2074.2 +179700 GO TO SUB-FAIL-F2-25. NC2074.2 +179800 SUB-DELETE-F2-25. NC2074.2 +179900 PERFORM DE-LETE. NC2074.2 +180000 GO TO SUB-WRITE-F2-25. NC2074.2 +180100 SUB-FAIL-F2-25. NC2074.2 +180200 MOVE 200 TO CORRECT-N. NC2074.2 +180300 MOVE GROUP-49-2 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +180400 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +180500 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +180600 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +180700 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +180800 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +180900 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +181000 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +181100 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +181200 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +181300 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +181400 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +181500 IN SECOND-GROUP NC2074.2 +181600 TO COMPUTED-N. NC2074.2 +181700 PERFORM FAIL. NC2074.2 +181800 SUB-WRITE-F2-25. NC2074.2 +181900 PERFORM PRINT-DETAIL. NC2074.2 +182000 PERFORM END-ROUTINE. NC2074.2 +182100* NC2074.2 +182200 MPY-INIT-F2-1. NC2074.2 +182300 MOVE "MPY-TEST-F2-1 " TO PAR-NAME. NC2074.2 +182400 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +182500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +182600 MPY-TEST-F2-1. NC2074.2 +182700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +182800 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +182900 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +183000 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +183100 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +183200 GIVING ACCUMULATOR1. NC2074.2 +183300 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +183400 PERFORM PASS NC2074.2 +183500 GO TO MPY-WRITE-F2-1. NC2074.2 +183600 GO TO MPY-FAIL-F2-1. NC2074.2 +183700 MPY-DELETE-F2-1. NC2074.2 +183800 PERFORM DE-LETE. NC2074.2 +183900 GO TO MPY-WRITE-F2-1. NC2074.2 +184000 MPY-FAIL-F2-1. NC2074.2 +184100 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +184200 MOVE 1 TO CORRECT-N. NC2074.2 +184300 PERFORM FAIL. NC2074.2 +184400 MPY-WRITE-F2-1. NC2074.2 +184500 PERFORM PRINT-DETAIL. NC2074.2 +184600* NC2074.2 +184700 MPY-INIT-F2-2. NC2074.2 +184800 MOVE "MPY-TEST-F2-2 " TO PAR-NAME. NC2074.2 +184900 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +185000 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +185100 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +185200 MPY-TEST-F2-2. NC2074.2 +185300 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +185400 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +185500 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +185600 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +185700 GIVING ACCUMULATOR1. NC2074.2 +185800 IF ACCUMULATOR1 EQUAL TO 4 NC2074.2 +185900 PERFORM PASS NC2074.2 +186000 GO TO MPY-WRITE-F2-2. NC2074.2 +186100 GO TO MPY-FAIL-F2-2. NC2074.2 +186200 MPY-DELETE-F2-2. NC2074.2 +186300 PERFORM DE-LETE. NC2074.2 +186400 GO TO MPY-WRITE-F2-2. NC2074.2 +186500 MPY-FAIL-F2-2. NC2074.2 +186600 MOVE 4 TO CORRECT-N. NC2074.2 +186700 PERFORM FAIL NC2074.2 +186800 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +186900 MPY-WRITE-F2-2. NC2074.2 +187000 PERFORM PRINT-DETAIL. NC2074.2 +187100* NC2074.2 +187200 MPY-INIT-F2-3. NC2074.2 +187300 MOVE "MPY-TEST-F2-3 " TO PAR-NAME. NC2074.2 +187400 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +187500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +187600 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +187700 MPY-TEST-F2-3. NC2074.2 +187800 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +187900 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 1 NC2074.2 +188000 GIVING ACCUMULATOR1. NC2074.2 +188100 IF ACCUMULATOR1 EQUAL TO 3 NC2074.2 +188200 PERFORM PASS NC2074.2 +188300 GO TO MPY-WRITE-F2-3. NC2074.2 +188400 GO TO MPY-FAIL-F2-3. NC2074.2 +188500 MPY-DELETE-F2-3. NC2074.2 +188600 PERFORM DE-LETE. NC2074.2 +188700 GO TO MPY-WRITE-F2-3. NC2074.2 +188800 MPY-FAIL-F2-3. NC2074.2 +188900 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +189000 MOVE 3 TO CORRECT-N. NC2074.2 +189100 PERFORM FAIL. NC2074.2 +189200 MPY-WRITE-F2-3. NC2074.2 +189300 PERFORM PRINT-DETAIL. NC2074.2 +189400* NC2074.2 +189500 MPY-INIT-F2-4. NC2074.2 +189600 MOVE "MPY-TEST-F2-4 " TO PAR-NAME. NC2074.2 +189700 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +189800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +189900 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +190000 MPY-TEST-F2-4. NC2074.2 +190100 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +190200 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 1 NC2074.2 +190300 GIVING ACCUMULATOR1. NC2074.2 +190400 IF ACCUMULATOR1 EQUAL TO 4 NC2074.2 +190500 PERFORM PASS NC2074.2 +190600 GO TO MPY-WRITE-F2-4. NC2074.2 +190700 GO TO MPY-FAIL-F2-4. NC2074.2 +190800 MPY-DELETE-F2-4. NC2074.2 +190900 PERFORM DE-LETE. NC2074.2 +191000 GO TO MPY-WRITE-F2-4. NC2074.2 +191100 MPY-FAIL-F2-4. NC2074.2 +191200 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +191300 MOVE 4 TO CORRECT-N. NC2074.2 +191400 PERFORM FAIL. NC2074.2 +191500 MPY-WRITE-F2-4. NC2074.2 +191600 PERFORM PRINT-DETAIL. NC2074.2 +191700* NC2074.2 +191800 MPY-INIT-F2-5. NC2074.2 +191900 MOVE "MPY-TEST-F2-5 " TO PAR-NAME. NC2074.2 +192000 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +192100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +192200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +192300 MPY-TEST-F2-5. NC2074.2 +192400 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +192500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +192600 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +192700 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +192800 GIVING ACCUMULATOR1. NC2074.2 +192900 IF ACCUMULATOR1 EQUAL TO 25 NC2074.2 +193000 PERFORM PASS NC2074.2 +193100 GO TO MPY-WRITE-F2-5. NC2074.2 +193200 GO TO MPY-FAIL-F2-5. NC2074.2 +193300 MPY-DELETE-F2-5. NC2074.2 +193400 PERFORM DE-LETE. NC2074.2 +193500 GO TO MPY-WRITE-F2-5. NC2074.2 +193600 MPY-FAIL-F2-5. NC2074.2 +193700 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +193800 MOVE 25 TO CORRECT-N. NC2074.2 +193900 PERFORM FAIL. NC2074.2 +194000 MPY-WRITE-F2-5. NC2074.2 +194100 PERFORM PRINT-DETAIL. NC2074.2 +194200* NC2074.2 +194300 MPY-INIT-F2-6. NC2074.2 +194400 MOVE "MPY-TEST-F2-6 " TO PAR-NAME. NC2074.2 +194500 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +194600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +194700 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +194800 MPY-TEST-F2-6. NC2074.2 +194900 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +195000 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +195100 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +195200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +195300 GIVING ACCUMULATOR1. NC2074.2 +195400 IF ACCUMULATOR1 EQUAL TO 36 NC2074.2 +195500 PERFORM PASS NC2074.2 +195600 GO TO MPY-WRITE-F2-6. NC2074.2 +195700 GO TO MPY-FAIL-F2-6. NC2074.2 +195800 MPY-DELETE-F2-6. NC2074.2 +195900 PERFORM DE-LETE. NC2074.2 +196000 GO TO MPY-WRITE-F2-6. NC2074.2 +196100 MPY-FAIL-F2-6. NC2074.2 +196200 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +196300 MOVE 36 TO CORRECT-N. NC2074.2 +196400 PERFORM FAIL. NC2074.2 +196500 MPY-WRITE-F2-6. NC2074.2 +196600 PERFORM PRINT-DETAIL. NC2074.2 +196700* NC2074.2 +196800 MPY-INIT-F2-7. NC2074.2 +196900 MOVE "MPY-TEST-F2-7 " TO PAR-NAME. NC2074.2 +197000 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +197100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +197200 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +197300 MPY-TEST-F2-7. NC2074.2 +197400 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +197500 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 1 NC2074.2 +197600 GIVING ACCUMULATOR1. NC2074.2 +197700 IF ACCUMULATOR1 EQUAL TO 7 NC2074.2 +197800 PERFORM PASS NC2074.2 +197900 GO TO MPY-WRITE-F2-7. NC2074.2 +198000 GO TO MPY-FAIL-F2-7. NC2074.2 +198100 MPY-DELETE-F2-7. NC2074.2 +198200 PERFORM DE-LETE. NC2074.2 +198300 GO TO MPY-WRITE-F2-7. NC2074.2 +198400 MPY-FAIL-F2-7. NC2074.2 +198500 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +198600 MOVE 7 TO CORRECT-N. NC2074.2 +198700 PERFORM FAIL. NC2074.2 +198800 MPY-WRITE-F2-7. NC2074.2 +198900 PERFORM PRINT-DETAIL. NC2074.2 +199000* NC2074.2 +199100 MPY-INIT-F2-8. NC2074.2 +199200 MOVE "MPY-TEST-F2-8 " TO PAR-NAME. NC2074.2 +199300 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +199400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +199500 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +199600 MPY-TEST-F2-8. NC2074.2 +199700 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +199800 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 1 NC2074.2 +199900 GIVING ACCUMULATOR1. NC2074.2 +200000 IF ACCUMULATOR1 EQUAL TO 8 NC2074.2 +200100 PERFORM PASS NC2074.2 +200200 GO TO MPY-WRITE-F2-8. NC2074.2 +200300 GO TO MPY-FAIL-F2-8. NC2074.2 +200400 MPY-DELETE-F2-8. NC2074.2 +200500 PERFORM DE-LETE. NC2074.2 +200600 GO TO MPY-WRITE-F2-8. NC2074.2 +200700 MPY-FAIL-F2-8. NC2074.2 +200800 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +200900 MOVE 8 TO CORRECT-N. NC2074.2 +201000 PERFORM FAIL. NC2074.2 +201100 MPY-WRITE-F2-8. NC2074.2 +201200 PERFORM PRINT-DETAIL. NC2074.2 +201300* NC2074.2 +201400 MPY-INIT-F2-9. NC2074.2 +201500 MOVE "MPY-TEST-F2-9 " TO PAR-NAME. NC2074.2 +201600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +201700 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +201800 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +201900 MPY-TEST-F2-9. NC2074.2 +202000 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +202100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 1 NC2074.2 +202200 GIVING ACCUMULATOR2. NC2074.2 +202300 IF ACCUMULATOR2 EQUAL TO 9 NC2074.2 +202400 PERFORM PASS NC2074.2 +202500 GO TO MPY-WRITE-F2-9. NC2074.2 +202600 GO TO MPY-FAIL-F2-9. NC2074.2 +202700 MPY-DELETE-F2-9. NC2074.2 +202800 PERFORM DE-LETE. NC2074.2 +202900 GO TO MPY-WRITE-F2-9. NC2074.2 +203000 MPY-FAIL-F2-9. NC2074.2 +203100 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +203200 MOVE 9 TO CORRECT-N. NC2074.2 +203300 PERFORM FAIL. NC2074.2 +203400 MPY-WRITE-F2-9. NC2074.2 +203500 PERFORM PRINT-DETAIL. NC2074.2 +203600* NC2074.2 +203700 MPY-INIT-F2-10. NC2074.2 +203800 MOVE "MPY-TEST-F2-10 " TO PAR-NAME. NC2074.2 +203900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +204000 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +204100 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +204200 MPY-TEST-F2-10. NC2074.2 +204300 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +204400 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 1 NC2074.2 +204500 GIVING ACCUMULATOR2. NC2074.2 +204600 IF ACCUMULATOR2 EQUAL TO 10 NC2074.2 +204700 PERFORM PASS NC2074.2 +204800 GO TO MPY-WRITE-F2-10. NC2074.2 +204900 GO TO MPY-FAIL-F2-10. NC2074.2 +205000 MPY-DELETE-F2-10. NC2074.2 +205100 PERFORM DE-LETE. NC2074.2 +205200 GO TO MPY-WRITE-F2-10. NC2074.2 +205300 MPY-FAIL-F2-10. NC2074.2 +205400 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +205500 MOVE 10 TO CORRECT-N. NC2074.2 +205600 PERFORM FAIL. NC2074.2 +205700 MPY-WRITE-F2-10. NC2074.2 +205800 PERFORM PRINT-DETAIL. NC2074.2 +205900* NC2074.2 +206000 MPY-INIT-F2-11. NC2074.2 +206100 MOVE "MPY-TEST-F2-11 " TO PAR-NAME. NC2074.2 +206200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +206300 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +206400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +206500 MPY-TEST-F2-11. NC2074.2 +206600 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +206700 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +206800 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +206900 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +207000 GIVING ACCUMULATOR2. NC2074.2 +207100 IF ACCUMULATOR2 EQUAL TO 121 NC2074.2 +207200 PERFORM PASS NC2074.2 +207300 GO TO MPY-WRITE-F2-11. NC2074.2 +207400 GO TO MPY-FAIL-F2-11. NC2074.2 +207500 MPY-DELETE-F2-11. NC2074.2 +207600 PERFORM DE-LETE. NC2074.2 +207700 GO TO MPY-WRITE-F2-11. NC2074.2 +207800 MPY-FAIL-F2-11. NC2074.2 +207900 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +208000 MOVE 121 TO CORRECT-N. NC2074.2 +208100 PERFORM FAIL. NC2074.2 +208200 MPY-WRITE-F2-11. NC2074.2 +208300 PERFORM PRINT-DETAIL. NC2074.2 +208400* NC2074.2 +208500 MPY-INIT-F2-12. NC2074.2 +208600 MOVE "MPY-TEST-F2-12 " TO PAR-NAME. NC2074.2 +208700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +208800 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +208900 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +209000 MPY-TEST-F2-12. NC2074.2 +209100 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +209200 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +209300 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +209400 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +209500 GIVING ACCUMULATOR2. NC2074.2 +209600 IF ACCUMULATOR2 EQUAL TO 144 NC2074.2 +209700 PERFORM PASS NC2074.2 +209800 GO TO MPY-WRITE-F2-12. NC2074.2 +209900 GO TO MPY-FAIL-F2-12. NC2074.2 +210000 MPY-DELETE-F2-12. NC2074.2 +210100 PERFORM DE-LETE. NC2074.2 +210200 GO TO MPY-WRITE-F2-12. NC2074.2 +210300 MPY-FAIL-F2-12. NC2074.2 +210400 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +210500 MOVE 144 TO CORRECT-N. NC2074.2 +210600 PERFORM FAIL. NC2074.2 +210700 MPY-WRITE-F2-12. NC2074.2 +210800 PERFORM PRINT-DETAIL. NC2074.2 +210900* NC2074.2 +211000 MPY-INIT-F2-13. NC2074.2 +211100 MOVE "MPY-TEST-F2-13 " TO PAR-NAME. NC2074.2 +211200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +211300 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +211400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +211500 MPY-TEST-F2-13. NC2074.2 +211600 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +211700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 1 NC2074.2 +211800 GIVING ACCUMULATOR2. NC2074.2 +211900 IF ACCUMULATOR2 EQUAL TO 13 NC2074.2 +212000 PERFORM PASS NC2074.2 +212100 GO TO MPY-WRITE-F2-13. NC2074.2 +212200 GO TO MPY-FAIL-F2-13. NC2074.2 +212300 MPY-DELETE-F2-13. NC2074.2 +212400 PERFORM DE-LETE. NC2074.2 +212500 GO TO MPY-WRITE-F2-13. NC2074.2 +212600 MPY-FAIL-F2-13. NC2074.2 +212700 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +212800 MOVE 13 TO CORRECT-N. NC2074.2 +212900 PERFORM FAIL. NC2074.2 +213000 MPY-WRITE-F2-13. NC2074.2 +213100 PERFORM PRINT-DETAIL. NC2074.2 +213200* NC2074.2 +213300 MPY-INIT-F2-14. NC2074.2 +213400 MOVE "MPY-TEST-F2-14 " TO PAR-NAME. NC2074.2 +213500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +213600 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +213700 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +213800 MPY-TEST-F2-14. NC2074.2 +213900 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +214000 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 1 NC2074.2 +214100 GIVING ACCUMULATOR2. NC2074.2 +214200 IF ACCUMULATOR2 EQUAL TO 14 NC2074.2 +214300 PERFORM PASS NC2074.2 +214400 GO TO MPY-WRITE-F2-14. NC2074.2 +214500 GO TO MPY-FAIL-F2-14. NC2074.2 +214600 MPY-DELETE-F2-14. NC2074.2 +214700 PERFORM DE-LETE. NC2074.2 +214800 GO TO MPY-WRITE-F2-14. NC2074.2 +214900 MPY-FAIL-F2-14. NC2074.2 +215000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +215100 MOVE 14 TO CORRECT-N. NC2074.2 +215200 PERFORM FAIL. NC2074.2 +215300 MPY-WRITE-F2-14. NC2074.2 +215400 PERFORM PRINT-DETAIL. NC2074.2 +215500* NC2074.2 +215600 MPY-INIT-F2-15. NC2074.2 +215700 MOVE "MPY-TEST-F2-15 " TO PAR-NAME. NC2074.2 +215800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +215900 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +216000 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +216100 MPY-TEST-F2-15. NC2074.2 +216200 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +216300 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +216400 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +216500 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +216600 GIVING ACCUMULATOR2. NC2074.2 +216700 IF ACCUMULATOR2 EQUAL TO 225 NC2074.2 +216800 PERFORM PASS NC2074.2 +216900 GO TO MPY-WRITE-F2-15. NC2074.2 +217000 GO TO MPY-FAIL-F2-15. NC2074.2 +217100 MPY-DELETE-F2-15. NC2074.2 +217200 PERFORM DE-LETE. NC2074.2 +217300 GO TO MPY-WRITE-F2-15. NC2074.2 +217400 MPY-FAIL-F2-15. NC2074.2 +217500 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +217600 MOVE 225 TO CORRECT-N. NC2074.2 +217700 PERFORM FAIL. NC2074.2 +217800 MPY-WRITE-F2-15. NC2074.2 +217900 PERFORM PRINT-DETAIL. NC2074.2 +218000* NC2074.2 +218100 MPY-INIT-F2-16. NC2074.2 +218200 MOVE "MPY-TEST-F2-16 " TO PAR-NAME. NC2074.2 +218300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +218400 MOVE "QUALIFIED MULTIPLY" TO FEATURE. NC2074.2 +218500 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +218600 MPY-TEST-F2-16. NC2074.2 +218700 MULTIPLY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +218800 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +218900 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +219000 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +219100 GIVING ACCUMULATOR2. NC2074.2 +219200 IF ACCUMULATOR2 EQUAL TO 256 NC2074.2 +219300 PERFORM PASS NC2074.2 +219400 GO TO MPY-WRITE-F2-16. NC2074.2 +219500 GO TO MPY-FAIL-F2-16. NC2074.2 +219600 MPY-DELETE-F2-16. NC2074.2 +219700 PERFORM DE-LETE. NC2074.2 +219800 GO TO MPY-WRITE-F2-16. NC2074.2 +219900 MPY-FAIL-F2-16. NC2074.2 +220000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +220100 MOVE 256 TO CORRECT-N. NC2074.2 +220200 PERFORM FAIL. NC2074.2 +220300 MPY-WRITE-F2-16. NC2074.2 +220400 PERFORM PRINT-DETAIL. NC2074.2 +220500* NC2074.2 +220600 MPY-INIT-F2-17. NC2074.2 +220700* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +220800 MOVE "MPY-TEST-F2-17 " TO PAR-NAME. NC2074.2 +220900 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +221000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +221100 MPY-TEST-F2-17. NC2074.2 +221200 MULTIPLY GROUP-49-3 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +221300 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +221400 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +221500 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +221600 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +221700 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +221800 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +221900 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +222000 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +222100 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +222200 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +222300 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +222400 IN FIRST-GROUP NC2074.2 +222500 BY 3 NC2074.2 +222600 GIVING ACCUMULATOR1. NC2074.2 +222700 IF ACCUMULATOR1 EQUAL TO 9 NC2074.2 +222800 PERFORM PASS NC2074.2 +222900 GO TO MPY-WRITE-F2-17. NC2074.2 +223000 GO TO MPY-FAIL-F2-17. NC2074.2 +223100 MPY-DELETE-F2-17. NC2074.2 +223200 PERFORM DE-LETE. NC2074.2 +223300 GO TO MPY-WRITE-F2-17. NC2074.2 +223400 MPY-FAIL-F2-17. NC2074.2 +223500 MOVE 9 TO CORRECT-N. NC2074.2 +223600 MOVE GROUP-49-3 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +223700 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +223800 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +223900 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +224000 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +224100 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +224200 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +224300 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +224400 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +224500 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +224600 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +224700 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +224800 IN FIRST-GROUP NC2074.2 +224900 TO COMPUTED-N. NC2074.2 +225000 MOVE "3 TIMES 3 SHOULD BE 9" TO RE-MARK. NC2074.2 +225100 PERFORM FAIL. NC2074.2 +225200 MPY-WRITE-F2-17. NC2074.2 +225300 PERFORM PRINT-DETAIL. NC2074.2 +225400 PERFORM END-ROUTINE. NC2074.2 +225500* NC2074.2 +225600 DIV-INIT-F3-1. NC2074.2 +225700 MOVE "DIV-TEST-F3-1 " TO PAR-NAME NC2074.2 +225800 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +225900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +226000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +226100 DIV-TEST-F3-1. NC2074.2 +226200 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +226300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +226400 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +226500 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +226600 GIVING ACCUMULATOR1. NC2074.2 +226700 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +226800 PERFORM PASS NC2074.2 +226900 GO TO DIV-WRITE-F3-1. NC2074.2 +227000 GO TO DIV-FAIL-F3-1. NC2074.2 +227100 DIV-DELETE-F3-1. NC2074.2 +227200 PERFORM DE-LETE. NC2074.2 +227300 GO TO DIV-WRITE-F3-1. NC2074.2 +227400 DIV-FAIL-F3-1. NC2074.2 +227500 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +227600 MOVE 1 TO CORRECT-N. NC2074.2 +227700 PERFORM FAIL. NC2074.2 +227800 DIV-WRITE-F3-1. NC2074.2 +227900 PERFORM PRINT-DETAIL. NC2074.2 +228000* NC2074.2 +228100 DIV-INIT-F3-2. NC2074.2 +228200 MOVE "DIV-TEST-F3-2 " TO PAR-NAME NC2074.2 +228300 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +228400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +228500 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +228600 DIV-TEST-F3-2. NC2074.2 +228700 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +228800 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +228900 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +229000 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +229100 GIVING ACCUMULATOR1. NC2074.2 +229200 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +229300 PERFORM PASS NC2074.2 +229400 GO TO DIV-WRITE-F3-2. NC2074.2 +229500 GO TO DIV-FAIL-F3-2. NC2074.2 +229600 DIV-DELETE-F3-2. NC2074.2 +229700 PERFORM DE-LETE. NC2074.2 +229800 GO TO DIV-WRITE-F3-2. NC2074.2 +229900 DIV-FAIL-F3-2. NC2074.2 +230000 MOVE 1 TO CORRECT-N. NC2074.2 +230100 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +230200 PERFORM FAIL. NC2074.2 +230300 DIV-WRITE-F3-2. NC2074.2 +230400 PERFORM PRINT-DETAIL. NC2074.2 +230500* NC2074.2 +230600 DIV-INIT-F3-3. NC2074.2 +230700 MOVE "DIV-TEST-F3-3 " TO PAR-NAME NC2074.2 +230800 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +230900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +231000 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +231100 DIV-TEST-F3-3. NC2074.2 +231200 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +231300 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 3 NC2074.2 +231400 GIVING ACCUMULATOR1. NC2074.2 +231500 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +231600 PERFORM PASS NC2074.2 +231700 GO TO DIV-WRITE-F3-3. NC2074.2 +231800 GO TO DIV-FAIL-F3-3. NC2074.2 +231900 DIV-DELETE-F3-3. NC2074.2 +232000 PERFORM DE-LETE. NC2074.2 +232100 GO TO DIV-WRITE-F3-3. NC2074.2 +232200 DIV-FAIL-F3-3. NC2074.2 +232300 MOVE 1 TO CORRECT-N. NC2074.2 +232400 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +232500 PERFORM FAIL. NC2074.2 +232600 DIV-WRITE-F3-3. NC2074.2 +232700 PERFORM PRINT-DETAIL. NC2074.2 +232800* NC2074.2 +232900 DIV-INIT-F3-4. NC2074.2 +233000 MOVE "DIV-TEST-F3-4 " TO PAR-NAME NC2074.2 +233100 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +233200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +233300 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +233400 DIV-TEST-F3-4. NC2074.2 +233500 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +233600 TABLE-LEVEL-3A IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 3 NC2074.2 +233700 GIVING ACCUMULATOR1. NC2074.2 +233800 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +233900 PERFORM PASS NC2074.2 +234000 GO TO DIV-WRITE-F3-4. NC2074.2 +234100 GO TO DIV-FAIL-F3-4. NC2074.2 +234200 DIV-DELETE-F3-4. NC2074.2 +234300 PERFORM DE-LETE. NC2074.2 +234400 GO TO DIV-WRITE-F3-4. NC2074.2 +234500 DIV-FAIL-F3-4. NC2074.2 +234600 MOVE 1 TO CORRECT-N. NC2074.2 +234700 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +234800 PERFORM FAIL. NC2074.2 +234900 DIV-WRITE-F3-4. NC2074.2 +235000 PERFORM PRINT-DETAIL. NC2074.2 +235100* NC2074.2 +235200 DIV-INIT-F3-5. NC2074.2 +235300 MOVE "DIV-TEST-F3-5 " TO PAR-NAME NC2074.2 +235400 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +235500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +235600 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +235700 DIV-TEST-F3-5. NC2074.2 +235800 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +235900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +236000 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +236100 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +236200 GIVING ACCUMULATOR1. NC2074.2 +236300 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +236400 PERFORM PASS NC2074.2 +236500 GO TO DIV-WRITE-F3-5. NC2074.2 +236600 GO TO DIV-FAIL-F3-5. NC2074.2 +236700 DIV-DELETE-F3-5. NC2074.2 +236800 PERFORM DE-LETE. NC2074.2 +236900 GO TO DIV-WRITE-F3-5. NC2074.2 +237000 DIV-FAIL-F3-5. NC2074.2 +237100 MOVE 1 TO CORRECT-N. NC2074.2 +237200 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +237300 PERFORM FAIL. NC2074.2 +237400 DIV-WRITE-F3-5. NC2074.2 +237500 PERFORM PRINT-DETAIL. NC2074.2 +237600* NC2074.2 +237700 DIV-INIT-F3-6. NC2074.2 +237800 MOVE "DIV-TEST-F3-6 " TO PAR-NAME NC2074.2 +237900 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +238000 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +238100 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +238200 DIV-TEST-F3-6. NC2074.2 +238300 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +238400 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +238500 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +238600 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A NC2074.2 +238700 GIVING ACCUMULATOR1. NC2074.2 +238800 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +238900 PERFORM PASS NC2074.2 +239000 GO TO DIV-WRITE-F3-6. NC2074.2 +239100 GO TO DIV-FAIL-F3-6. NC2074.2 +239200 DIV-DELETE-F3-6. NC2074.2 +239300 PERFORM DE-LETE. NC2074.2 +239400 GO TO DIV-WRITE-F3-6. NC2074.2 +239500 DIV-FAIL-F3-6. NC2074.2 +239600 MOVE 1 TO CORRECT-N. NC2074.2 +239700 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +239800 PERFORM FAIL. NC2074.2 +239900 DIV-WRITE-F3-6. NC2074.2 +240000 PERFORM PRINT-DETAIL. NC2074.2 +240100* NC2074.2 +240200 DIV-INIT-F3-7. NC2074.2 +240300 MOVE "DIV-TEST-F3-7 " TO PAR-NAME NC2074.2 +240400 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +240500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +240600 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +240700 DIV-TEST-F3-7. NC2074.2 +240800 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +240900 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 7 NC2074.2 +241000 GIVING ACCUMULATOR1. NC2074.2 +241100 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +241200 PERFORM PASS NC2074.2 +241300 GO TO DIV-WRITE-F3-7. NC2074.2 +241400 GO TO DIV-FAIL-F3-7. NC2074.2 +241500 DIV-DELETE-F3-7. NC2074.2 +241600 PERFORM DE-LETE. NC2074.2 +241700 GO TO DIV-WRITE-F3-7. NC2074.2 +241800 DIV-FAIL-F3-7. NC2074.2 +241900 MOVE 1 TO CORRECT-N. NC2074.2 +242000 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +242100 PERFORM FAIL. NC2074.2 +242200 DIV-WRITE-F3-7. NC2074.2 +242300 PERFORM PRINT-DETAIL. NC2074.2 +242400* NC2074.2 +242500 DIV-INIT-F3-8. NC2074.2 +242600 MOVE "DIV-TEST-F3-8 " TO PAR-NAME NC2074.2 +242700 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +242800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +242900 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +243000 DIV-TEST-F3-8. NC2074.2 +243100 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +243200 TABLE-LEVEL-3B IN TABLE-LEVEL-4A OF TABLE-LEVEL-5A BY 8 NC2074.2 +243300 GIVING ACCUMULATOR1. NC2074.2 +243400 IF ACCUMULATOR1 EQUAL TO 1 NC2074.2 +243500 PERFORM PASS NC2074.2 +243600 GO TO DIV-WRITE-F3-8. NC2074.2 +243700 GO TO DIV-FAIL-F3-8. NC2074.2 +243800 DIV-DELETE-F3-8. NC2074.2 +243900 PERFORM DE-LETE. NC2074.2 +244000 GO TO DIV-WRITE-F3-8. NC2074.2 +244100 DIV-FAIL-F3-8. NC2074.2 +244200 MOVE 1 TO CORRECT-N. NC2074.2 +244300 MOVE ACCUMULATOR1 TO COMPUTED-N. NC2074.2 +244400 PERFORM FAIL. NC2074.2 +244500 DIV-WRITE-F3-8. NC2074.2 +244600 PERFORM PRINT-DETAIL. NC2074.2 +244700* NC2074.2 +244800 DIV-INIT-F3-9. NC2074.2 +244900 MOVE "DIV-TEST-F3-9 " TO PAR-NAME NC2074.2 +245000 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +245100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +245200 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +245300 DIV-TEST-F3-9. NC2074.2 +245400 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +245500 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 9 NC2074.2 +245600 GIVING ACCUMULATOR2. NC2074.2 +245700 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +245800 PERFORM PASS NC2074.2 +245900 GO TO DIV-WRITE-F3-9. NC2074.2 +246000 GO TO DIV-FAIL-F3-9. NC2074.2 +246100 DIV-DELETE-F3-9. NC2074.2 +246200 PERFORM DE-LETE. NC2074.2 +246300 GO TO DIV-WRITE-F3-9. NC2074.2 +246400 DIV-FAIL-F3-9. NC2074.2 +246500 MOVE 1 TO CORRECT-N. NC2074.2 +246600 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +246700 PERFORM FAIL. NC2074.2 +246800 DIV-WRITE-F3-9. NC2074.2 +246900 PERFORM PRINT-DETAIL. NC2074.2 +247000* NC2074.2 +247100 DIV-INIT-F3-10. NC2074.2 +247200 MOVE "DIV-TEST-F3-10 " TO PAR-NAME NC2074.2 +247300 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +247400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +247500 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +247600 DIV-TEST-F3-10. NC2074.2 +247700 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +247800 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 10 NC2074.2 +247900 GIVING ACCUMULATOR2. NC2074.2 +248000 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +248100 PERFORM PASS NC2074.2 +248200 GO TO DIV-WRITE-F3-10. NC2074.2 +248300 GO TO DIV-FAIL-F3-10. NC2074.2 +248400 DIV-DELETE-F3-10. NC2074.2 +248500 PERFORM DE-LETE. NC2074.2 +248600 GO TO DIV-WRITE-F3-10. NC2074.2 +248700 DIV-FAIL-F3-10. NC2074.2 +248800 MOVE 1 TO CORRECT-N. NC2074.2 +248900 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +249000 PERFORM FAIL. NC2074.2 +249100 DIV-WRITE-F3-10. NC2074.2 +249200 PERFORM PRINT-DETAIL. NC2074.2 +249300* NC2074.2 +249400 DIV-INIT-F3-11. NC2074.2 +249500 MOVE "DIV-TEST-F3-11 " TO PAR-NAME NC2074.2 +249600 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +249700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +249800 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +249900 DIV-TEST-F3-11. NC2074.2 +250000 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +250100 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +250200 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +250300 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +250400 GIVING ACCUMULATOR2. NC2074.2 +250500 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +250600 PERFORM PASS NC2074.2 +250700 GO TO DIV-WRITE-F3-11. NC2074.2 +250800 GO TO DIV-FAIL-F3-11. NC2074.2 +250900 DIV-DELETE-F3-11. NC2074.2 +251000 PERFORM DE-LETE. NC2074.2 +251100 GO TO DIV-WRITE-F3-11. NC2074.2 +251200 DIV-FAIL-F3-11. NC2074.2 +251300 MOVE 1 TO CORRECT-N. NC2074.2 +251400 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +251500 PERFORM FAIL. NC2074.2 +251600 DIV-WRITE-F3-11. NC2074.2 +251700 PERFORM PRINT-DETAIL. NC2074.2 +251800* NC2074.2 +251900 DIV-INIT-F3-12. NC2074.2 +252000 MOVE "DIV-TEST-F3-12 " TO PAR-NAME NC2074.2 +252100 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +252200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +252300 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +252400 DIV-TEST-F3-12. NC2074.2 +252500 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +252600 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +252700 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +252800 TABLE-LEVEL-3A IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +252900 GIVING ACCUMULATOR2. NC2074.2 +253000 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +253100 PERFORM PASS NC2074.2 +253200 GO TO DIV-WRITE-F3-12. NC2074.2 +253300 GO TO DIV-FAIL-F3-12. NC2074.2 +253400 DIV-DELETE-F3-12. NC2074.2 +253500 PERFORM DE-LETE. NC2074.2 +253600 GO TO DIV-WRITE-F3-12. NC2074.2 +253700 DIV-FAIL-F3-12. NC2074.2 +253800 MOVE 1 TO CORRECT-N. NC2074.2 +253900 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +254000 PERFORM FAIL. NC2074.2 +254100 DIV-WRITE-F3-12. NC2074.2 +254200 PERFORM PRINT-DETAIL. NC2074.2 +254300* NC2074.2 +254400 DIV-INIT-F3-13. NC2074.2 +254500 MOVE "DIV-TEST-F3-13 " TO PAR-NAME NC2074.2 +254600 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +254700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +254800 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +254900 DIV-TEST-F3-13. NC2074.2 +255000 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2A OF NC2074.2 +255100 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 13 NC2074.2 +255200 GIVING ACCUMULATOR2. NC2074.2 +255300 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +255400 PERFORM PASS NC2074.2 +255500 GO TO DIV-WRITE-F3-13. NC2074.2 +255600 GO TO DIV-FAIL-F3-13. NC2074.2 +255700 DIV-DELETE-F3-13. NC2074.2 +255800 PERFORM DE-LETE. NC2074.2 +255900 GO TO DIV-WRITE-F3-13. NC2074.2 +256000 DIV-FAIL-F3-13. NC2074.2 +256100 MOVE 1 TO CORRECT-N. NC2074.2 +256200 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +256300 PERFORM FAIL. NC2074.2 +256400 DIV-WRITE-F3-13. NC2074.2 +256500 PERFORM PRINT-DETAIL. NC2074.2 +256600* NC2074.2 +256700 DIV-INIT-F3-14. NC2074.2 +256800 MOVE "DIV-TEST-F3-14 " TO PAR-NAME NC2074.2 +256900 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +257000 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +257100 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +257200 DIV-TEST-F3-14. NC2074.2 +257300 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2A OF NC2074.2 +257400 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A BY 14 NC2074.2 +257500 GIVING ACCUMULATOR2. NC2074.2 +257600 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +257700 PERFORM PASS NC2074.2 +257800 GO TO DIV-WRITE-F3-14. NC2074.2 +257900 GO TO DIV-FAIL-F3-14. NC2074.2 +258000 DIV-DELETE-F3-14. NC2074.2 +258100 PERFORM DE-LETE. NC2074.2 +258200 GO TO DIV-WRITE-F3-14. NC2074.2 +258300 DIV-FAIL-F3-14. NC2074.2 +258400 MOVE 1 TO CORRECT-N. NC2074.2 +258500 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +258600 PERFORM FAIL. NC2074.2 +258700 DIV-WRITE-F3-14. NC2074.2 +258800 PERFORM PRINT-DETAIL. NC2074.2 +258900* NC2074.2 +259000 DIV-INIT-F3-15. NC2074.2 +259100 MOVE "DIV-TEST-F3-15 " TO PAR-NAME NC2074.2 +259200 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +259300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +259400 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +259500 DIV-TEST-F3-15. NC2074.2 +259600 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +259700 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +259800 BY TBL-ITEM-1 OF TABLE-LEVEL-1A IN TABLE-LEVEL-2B OF NC2074.2 +259900 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +260000 GIVING ACCUMULATOR2. NC2074.2 +260100 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +260200 PERFORM PASS NC2074.2 +260300 GO TO DIV-WRITE-F3-15. NC2074.2 +260400 GO TO DIV-FAIL-F3-15. NC2074.2 +260500 DIV-DELETE-F3-15. NC2074.2 +260600 PERFORM DE-LETE. NC2074.2 +260700 GO TO DIV-WRITE-F3-15. NC2074.2 +260800 DIV-FAIL-F3-15. NC2074.2 +260900 MOVE 1 TO CORRECT-N. NC2074.2 +261000 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +261100 PERFORM FAIL. NC2074.2 +261200 DIV-WRITE-F3-15. NC2074.2 +261300 PERFORM PRINT-DETAIL. NC2074.2 +261400* NC2074.2 +261500 DIV-INIT-F3-16. NC2074.2 +261600 MOVE "DIV-TEST-F3-16 " TO PAR-NAME NC2074.2 +261700 MOVE "QUALIFIED DIVIDE " TO FEATURE. NC2074.2 +261800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2074.2 +261900 MOVE ZERO TO ACCUMULATOR2. NC2074.2 +262000 DIV-TEST-F3-16. NC2074.2 +262100 DIVIDE TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +262200 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +262300 BY TBL-ITEM-1 OF TABLE-LEVEL-1B IN TABLE-LEVEL-2B OF NC2074.2 +262400 TABLE-LEVEL-3B IN TABLE-LEVEL-4B OF TABLE-LEVEL-5A NC2074.2 +262500 GIVING ACCUMULATOR2. NC2074.2 +262600 IF ACCUMULATOR2 EQUAL TO 1 NC2074.2 +262700 PERFORM PASS NC2074.2 +262800 GO TO DIV-WRITE-F3-16. NC2074.2 +262900 GO TO DIV-FAIL-F3-16. NC2074.2 +263000 DIV-DELETE-F3-16. NC2074.2 +263100 PERFORM DE-LETE. NC2074.2 +263200 GO TO DIV-WRITE-F3-16. NC2074.2 +263300 DIV-FAIL-F3-16. NC2074.2 +263400 MOVE 1 TO CORRECT-N. NC2074.2 +263500 MOVE ACCUMULATOR2 TO COMPUTED-N. NC2074.2 +263600 PERFORM FAIL. NC2074.2 +263700 DIV-WRITE-F3-16. NC2074.2 +263800 PERFORM PRINT-DETAIL. NC2074.2 +263900* NC2074.2 +264000 DIV-INIT-F3-17. NC2074.2 +264100* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +264200 MOVE "DIV-TEST-F3-17 " TO PAR-NAME. NC2074.2 +264300 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +264400 MOVE ZERO TO ACCUMULATOR1. NC2074.2 +264500 DIV-TEST-F3-17. NC2074.2 +264600 DIVIDE GROUP-49-4 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +264700 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +264800 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +264900 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +265000 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +265100 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +265200 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +265300 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +265400 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +265500 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +265600 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +265700 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +265800 IN SECOND-GROUP NC2074.2 +265900 BY 40 NC2074.2 +266000 GIVING ACCUMULATOR1. NC2074.2 +266100 IF ACCUMULATOR1 EQUAL TO 10 NC2074.2 +266200 PERFORM PASS NC2074.2 +266300 GO TO DIV-WRITE-F3-17. NC2074.2 +266400 GO TO DIV-FAIL-F3-17. NC2074.2 +266500 DIV-DELETE-F3-17. NC2074.2 +266600 PERFORM DE-LETE. NC2074.2 +266700 GO TO DIV-WRITE-F3-17. NC2074.2 +266800 DIV-FAIL-F3-17. NC2074.2 +266900 MOVE 10 TO CORRECT-N. NC2074.2 +267000 MOVE GROUP-49-4 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +267100 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +267200 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +267300 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +267400 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +267500 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +267600 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +267700 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +267800 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +267900 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +268000 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +268100 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +268200 IN SECOND-GROUP NC2074.2 +268300 TO COMPUTED-N. NC2074.2 +268400 PERFORM FAIL. NC2074.2 +268500 DIV-WRITE-F3-17. NC2074.2 +268600 PERFORM PRINT-DETAIL. NC2074.2 +268700 PERFORM END-ROUTINE. NC2074.2 +268800* NC2074.2 +268900 CND-INIT-GF-1. NC2074.2 +269000* ===--> 48 LEVELS OF QUALIFICATION <--=== NC2074.2 +269100 MOVE "CND-TEST-GF-1 " TO PAR-NAME. NC2074.2 +269200 MOVE "VI-2 1.3.2" TO ANSI-REFERENCE. NC2074.2 +269300 MOVE "CONDITION NAME " TO FEATURE. NC2074.2 +269400 CND-TEST-GF-1. NC2074.2 +269500 IF LEVEL-49-OK NC2074.2 +269600 PERFORM PASS NC2074.2 +269700 GO TO CND-WRITE-GF-1. NC2074.2 +269800 GO TO CND-FAIL-GF-1. NC2074.2 +269900 CND-DELETE-GF-1. NC2074.2 +270000 PERFORM DE-LETE. NC2074.2 +270100 GO TO CND-WRITE-GF-1. NC2074.2 +270200 CND-FAIL-GF-1. NC2074.2 +270300 MOVE 500 TO CORRECT-N. NC2074.2 +270400 MOVE GROUP-49-5 OF GROUP-48 IN GROUP-47 OF GROUP-46 NC2074.2 +270500 IN GROUP-45 OF GROUP-44 IN GROUP-43 OF GROUP-42 NC2074.2 +270600 IN GROUP-41 OF GROUP-40 IN GROUP-39 OF GROUP-38 NC2074.2 +270700 IN GROUP-37 OF GROUP-36 IN GROUP-35 OF GROUP-34 NC2074.2 +270800 IN GROUP-33 OF GROUP-32 IN GROUP-31 OF GROUP-30 NC2074.2 +270900 IN GROUP-29 OF GROUP-28 IN GROUP-27 OF GROUP-26 NC2074.2 +271000 IN GROUP-25 OF GROUP-24 IN GROUP-23 OF GROUP-22 NC2074.2 +271100 IN GROUP-21 OF GROUP-20 IN GROUP-19 OF GROUP-18 NC2074.2 +271200 IN GROUP-17 OF GROUP-16 IN GROUP-15 OF GROUP-14 NC2074.2 +271300 IN GROUP-13 OF GROUP-12 IN GROUP-11 OF GROUP-10 NC2074.2 +271400 IN GROUP-09 OF GROUP-08 IN GROUP-07 OF GROUP-06 NC2074.2 +271500 IN GROUP-05 OF GROUP-04 IN GROUP-03 OF GROUP-02 NC2074.2 +271600 IN SECOND-GROUP NC2074.2 +271700 TO COMPUTED-N. NC2074.2 +271800 PERFORM FAIL. NC2074.2 +271900 CND-WRITE-GF-1. NC2074.2 +272000 PERFORM PRINT-DETAIL. NC2074.2 +272100 CCVS-EXIT SECTION. NC2074.2 +272200 CCVS-999999. NC2074.2 +272300 GO TO CLOSE-FILES. NC2074.2 diff --git a/tests/cobol85/NC/NC208A.CBL b/tests/cobol85/NC/NC208A.CBL new file mode 100755 index 00000000..dd0539f3 --- /dev/null +++ b/tests/cobol85/NC/NC208A.CBL @@ -0,0 +1,1130 @@ +000100 IDENTIFICATION DIVISION. NC2084.2 +000200 PROGRAM-ID. NC2084.2 +000300 NC208A. NC2084.2 +000400**************************************************************** NC2084.2 +000500* * NC2084.2 +000600* VALIDATION FOR:- * NC2084.2 +000700* * NC2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2084.2 +000900* * NC2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2084.2 +001100* * NC2084.2 +001200**************************************************************** NC2084.2 +001300* * NC2084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2084.2 +001500* * NC2084.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2084.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2084.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2084.2 +001900* * NC2084.2 +002000**************************************************************** NC2084.2 +002100 NC2084.2 +002200* * NC2084.2 +002300* PROGRAM NC208A TESTS FORMATS 1 AND 2 OF QUALIFICATION* NC2084.2 +002400* USING FORMATS 1 AND 2 OF THE "MOVE" STATEMENT, FORMAT 1 OF* NC2084.2 +002500* THE "ADD" STATEMENT AND THE FORMAT 2 "MULTIPLY" STATEMENT.* NC2084.2 +002600* * NC2084.2 +002700**************************************************************** NC2084.2 +002800 ENVIRONMENT DIVISION. NC2084.2 +002900 CONFIGURATION SECTION. NC2084.2 +003000 SOURCE-COMPUTER. NC2084.2 +003100 Linux. NC2084.2 +003200 OBJECT-COMPUTER. NC2084.2 +003300 Linux. NC2084.2 +003400 INPUT-OUTPUT SECTION. NC2084.2 +003500 FILE-CONTROL. NC2084.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2084.2 +003700 "report.log". NC2084.2 +003800 DATA DIVISION. NC2084.2 +003900 FILE SECTION. NC2084.2 +004000 FD PRINT-FILE. NC2084.2 +004100 01 PRINT-REC PICTURE X(120). NC2084.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2084.2 +004300 WORKING-STORAGE SECTION. NC2084.2 +004400 77 QT1 PICTURE XXXX VALUE SPACE. NC2084.2 +004500 77 QT2 PICTURE XXXX VALUE SPACE. NC2084.2 +004600 77 QT3 PICTURE XXXX VALUE SPACE. NC2084.2 +004700 77 QT4 PICTURE XXXX VALUE SPACE. NC2084.2 +004800 77 QT5 PICTURE XXXX VALUE SPACE. NC2084.2 +004900 77 WRK-XN-00001 PICTURE X. NC2084.2 +005000 77 WRK-DS-01V00 PICTURE S9. NC2084.2 +005100 77 WRK-DS-02V00 PICTURE S99. NC2084.2 +005200 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2084.2 +005300 77 WRK-DS-05V00 PICTURE S9(5). NC2084.2 +005400 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2084.2 +005500 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2084.2 +005600 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC2084.2 +005700 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2084.2 +005800 VALUE 111111111.111111111. NC2084.2 +005900 77 WRK-DS-18V00 PICTURE S9(18) VALUE 111111111111111111. NC2084.2 +006000 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2084.2 +006100 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2084.2 +006200 77 WRK-DS-03V00 PICTURE S999. NC2084.2 +006300 77 WRK-DS-06V00 PICTURE S9(6). NC2084.2 +006400 77 WRK-DS-0201P PICTURE S99P. NC2084.2 +006500 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC2084.2 +006600 77 XRAY PICTURE IS X. NC2084.2 +006700 77 W-1 PICTURE IS 9. NC2084.2 +006800 77 W-2 PICTURE IS 99. NC2084.2 +006900 77 W-3 PICTURE IS 999. NC2084.2 +007000 77 W-4 PICTURE 9 VALUE 0. NC2084.2 +007100 77 W-6 PICTURE IS 999 VALUE IS ZERO. NC2084.2 +007200 77 W-9 PICTURE 999. NC2084.2 +007300 77 D-5 PICTURE S999 VALUE -1. NC2084.2 +007400 77 D-9 PICTURE 9(4)V9(4) VALUE 111.1189. NC2084.2 +007500 77 ONE PICTURE 9 VALUE 1. NC2084.2 +007600 77 TWO PICTURE S9 VALUE 2. NC2084.2 +007700 77 THREE PICTURE S9 VALUE 3. NC2084.2 +007800 77 FOUR PICTURE S9 VALUE 4. NC2084.2 +007900 77 FIVE PICTURE S9 VALUE 5. NC2084.2 +008000 77 SIX PICTURE S9 VALUE 6. NC2084.2 +008100 77 SEVEN PICTURE S9 VALUE 7. NC2084.2 +008200 77 EIGHT PICTURE 9 VALUE 8. NC2084.2 +008300 77 NINE PICTURE S9 VALUE 9. NC2084.2 +008400 77 TEN PICTURE S99 VALUE 10. NC2084.2 +008500 77 FIFTEEN PICTURE S99 VALUE 15. NC2084.2 +008600 77 TWENTY PICTURE S99 VALUE 20. NC2084.2 +008700 77 TWENTY-5 PICTURE S99 VALUE 25. NC2084.2 +008800 01 MOVE54. NC2084.2 +008900 02 MOVE55 PICTURE X VALUE "W". NC2084.2 +009000 02 MOVE56 PICTURE X VALUE "X". NC2084.2 +009100 02 MOVE57. NC2084.2 +009200 03 MOVE58 PICTURE X VALUE "Y". NC2084.2 +009300 03 MOVE59 PICTURE X VALUE "Z". NC2084.2 +009400 01 MOVE60. NC2084.2 +009500 02 MOVE56 PICTURE X. NC2084.2 +009600 02 MOVE57. NC2084.2 +009700 03 MOVE58 PICTURE X. NC2084.2 +009800 03 MOVE64. NC2084.2 +009900 04 MOVE65 PICTURE X VALUE "A". NC2084.2 +010000 01 SEND-BREAKDOWN. NC2084.2 +010100 02 SEND-20 PIC X(20). NC2084.2 +010200 02 SEND-40 PIC X(20). NC2084.2 +010300 02 SEND-60 PIC X(20). NC2084.2 +010400 01 RECEIVE-BREAKDOWN. NC2084.2 +010500 02 RECEIVE-20 PIC X(20). NC2084.2 +010600 02 RECEIVE-40 PIC X(20). NC2084.2 +010700 02 RECEIVE-60 PIC X(20). NC2084.2 +010800 01 GRP-FOR-QUAL-FROM. NC2084.2 +010900 02 QUAL-TEST-SUB-GRP-1. NC2084.2 +011000 03 QUAL-TEST-1 PICTURE X(26) VALUE NC2084.2 +011100 "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2084.2 +011200 03 QUAL-TEST-1-FROM REDEFINES QUAL-TEST-1 PICTURE X(26). NC2084.2 +011300 03 QUAL-TEST-2 PICTURE S9(10) VALUE +9999999999.NC2084.2 +011400 03 QUAL-TEST-2-FROM REDEFINES QUAL-TEST-2 PICTURE S9(10). NC2084.2 +011500 03 QUAL-TEST-3 PICTURE S999 VALUE 2. NC2084.2 +011600 03 QUAL-TEST-3-FROM REDEFINES QUAL-TEST-3 PICTURE S999. NC2084.2 +011700 02 QUAL-TEST-SUB-GRP-2. NC2084.2 +011800 03 QUAL-TEST-4 PICTURE X OCCURS 5 TIMES. NC2084.2 +011900 03 QUAL-TEST-4-FROM PICTURE X OCCURS 4 TIMES. NC2084.2 +012000 01 GRP-FOR-QUAL-TO. NC2084.2 +012100 02 DUMMY-LEVELZ. NC2084.2 +012200 03 QUAL-TEST-1 PICTURE X(26). NC2084.2 +012300 03 QUAL-TEST-1-TO REDEFINES QUAL-TEST-1 PICTURE X(26). NC2084.2 +012400 03 QUAL-TEST-2 PICTURE S9(10). NC2084.2 +012500 03 QUAL-TEST-2-TO REDEFINES QUAL-TEST-2 PICTURE S9(10). NC2084.2 +012600 03 QUAL-TEST-3 PICTURE S999. NC2084.2 +012700 03 QUAL-TEST-3-TO REDEFINES QUAL-TEST-3 PICTURE S999. NC2084.2 +012800 02 QUAL-TEST1. NC2084.2 +012900 03 QUAL-TEST-4 PICTURE X OCCURS 5 TIMES. NC2084.2 +013000 02 QUAL-TEST2. NC2084.2 +013100 03 QUAL-TEST-4-TO PICTURE X OCCURS 4 TIMES. NC2084.2 +013200 01 GRP-MOVE-CORR-1. NC2084.2 +013300 09 MOVE-CORR-5 PICTURE 999 VALUE 555. NC2084.2 +013400 09 MOVE-CORR-3 PICTURE 999 VALUE 333. NC2084.2 +013500 09 MOVE-CORR-2 PICTURE 999 VALUE 222. NC2084.2 +013600 09 MOVE-CORR-1 PICTURE 999 VALUE 111. NC2084.2 +013700 09 FILLER PICTURE XXX VALUE ZEROS. NC2084.2 +013800 09 MOVE-CORR-4 PICTURE XXX VALUE "XYZ". NC2084.2 +013900 09 MOVE-CORR-6 PICTURE XXX VALUE ALL "6". NC2084.2 +014000 09 MOVE-CORR-7 PICTURE 999 VALUE 777. NC2084.2 +014100 01 GRP-MOVE-CORR-R. NC2084.2 +014200 05 FILLER PICTURE XXX. NC2084.2 +014300 05 MOVE-CORR-1 PICTURE XXX. NC2084.2 +014400 05 MOVE-CORR-2 PICTURE 999. NC2084.2 +014500 05 MOVE-CORR-3 PICTURE ZZZ. NC2084.2 +014600 05 MOVE-CORR-4. NC2084.2 +014700 06 FILLER PICTURE 999. NC2084.2 +014800 06 FILLER PICTURE XXX. NC2084.2 +014900 01 GRP-TO-MOVE-CORR. NC2084.2 +015000 03 GRP-TO-MOVE-CORR-1. NC2084.2 +015100 05 MOVE-CORR-G1. NC2084.2 +015200 06 MOVE-CORR-G2. NC2084.2 +015300 09 MOVE-CORR-E1 PICTURE 999 VALUE 111. NC2084.2 +015400 09 MOVE-CORR-E2 PICTURE 999 VALUE 222. NC2084.2 +015500 09 FILLER PICTURE 999 VALUE 333. NC2084.2 +015600 06 MOVE-CORR-G3. NC2084.2 +015700 07 MOVE-CORR-E3 PICTURE XXX VALUE "123". NC2084.2 +015800 07 MOVE-CORR-G4. NC2084.2 +015900 08 MOVE-CORR-G5. NC2084.2 +016000 09 MOVE-CORR-E4 PICTURE XXX VALUE "ABC".NC2084.2 +016100 09 MOVE-CORR-E5 PICTURE 99 VALUE 45. NC2084.2 +016200 01 GRP-TO-MOVE-CORR-TO. NC2084.2 +016300 02 MOVE-CORR-G1. NC2084.2 +016400 04 MOVE-CORR-G2. NC2084.2 +016500 05 MOVE-CORR-E1 PICTURE XXX. NC2084.2 +016600 05 MOVE-CORR-E2 PICTURE 999 OCCURS 2. NC2084.2 +016700 05 FILLER PICTURE 999. NC2084.2 +016800 04 MOVE-CORR-G3. NC2084.2 +016900 06 MOVE-CORR-E3 PICTURE 999. NC2084.2 +017000 06 MOVE-CORR-G4. NC2084.2 +017100 07 MOVE-CORR-G5 PICTURE X(5). NC2084.2 +017200 01 GRP-FOR-MULT-REC-A. NC2084.2 +017300 03 WRK-DS-01V00-IN-GRP PICTURE S9 VALUE ZERO. NC2084.2 +017400 03 WRK-DS-05V00-IN-GRP PICTURE S9(5) VALUE ZERO. NC2084.2 +017500 03 WRK-DS-06V06-IN-GRP PICTURE S9(6)V9(6) VALUE ZERO. NC2084.2 +017600 01 GRP-FOR-MULT-REC-B. NC2084.2 +017700 03 WRK-DS-03V10-IN-GRP PICTURE S9(3)V9(10) VALUE ZERO. NC2084.2 +017800 03 WRK-DS-0201P-IN-GRP PICTURE S99P VALUE ZERO. NC2084.2 +017900 03 WRK-DS-03V00-IN-GRP PICTURE S999 VALUE ZERO. NC2084.2 +018000 01 GRP-FOR-MULT-REC-C. NC2084.2 +018100 03 WRK-DS-02V00-IN-GRP PICTURE S99 VALUE ZERO. NC2084.2 +018200 03 WRK-DS-18V00-IN-GRP PICTURE S9(18) VALUE ZERO. NC2084.2 +018300 03 WRK-DS-09V09-IN-GRP PICTURE S9(9)V9(9) VALUE ZERO. NC2084.2 +018400 01 WRK-DS-09V00 PICTURE S9(9) VALUE ZERO. NC2084.2 +018500 01 CORR-DATA-1. NC2084.2 +018600 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +018700 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +018800 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +018900 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019000 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019100 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019200 01 CORR-DATA-2. NC2084.2 +019300 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019400 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019500 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019600 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019700 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019800 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +019900 01 CORR-DATA-3. NC2084.2 +020000 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020100 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020200 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020300 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020400 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020500 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2084.2 +020600 01 CORR-DATA-4. NC2084.2 +020700 03 XYZ-11 PICTURE IS 99. NC2084.2 +020800 03 XYZ-12 PICTURE IS 99. NC2084.2 +020900 03 XYZ-13 PICTURE IS 99. NC2084.2 +021000 03 XYZ-14 PICTURE IS 99. NC2084.2 +021100 03 XYZ-15 PICTURE IS 99. NC2084.2 +021200 03 XYZ-16 PICTURE IS 99. NC2084.2 +021300 01 CORR-DATA-5. NC2084.2 +021400 03 XYZ-1 PICTURE 99. NC2084.2 +021500 03 XYZ-2 PICTURE 99. NC2084.2 +021600 03 XYZ-13 PICTURE IS 99. NC2084.2 +021700 03 XYZ-14 PICTURE IS 99. NC2084.2 +021800 03 FILLER PICTURE IS 99. NC2084.2 +021900 03 XYZ-11 PICTURE IS 99. NC2084.2 +022000 03 XYZ-12 PICTURE IS 99. NC2084.2 +022100 01 CORR-DATA-6. NC2084.2 +022200 03 XYZ-11 PICTURE IS 99. NC2084.2 +022300 03 XYZ-12 PICTURE IS 99. NC2084.2 +022400 03 FILLER PICTURE IS 99. NC2084.2 +022500 03 XYZ-1 PICTURE IS 99. NC2084.2 +022600 03 XYZ-2 PICTURE IS 9(2). NC2084.2 +022700 03 FILLER PICTURE IS 99. NC2084.2 +022800 01 CORR-DATA-7. NC2084.2 +022900 02 XYZ-1 PICTURE 99V99 VALUE 10.45. NC2084.2 +023000 02 XYZ-6 PICTURE 999V9 VALUE 100.5. NC2084.2 +023100 02 XYZ-11 PICTURE 99V9 VALUE ZERO. NC2084.2 +023200 02 XYZ-2 PICTURE 99V9 VALUE 0.9. NC2084.2 +023300 01 AN-DATANAMES. NC2084.2 +023400 02 ANDATA1 PICTURE X VALUE SPACE. NC2084.2 +023500 02 ANDATA2 PICTURE XX VALUE SPACE. NC2084.2 +023600 02 ANDATA3 PICTURE XXX VALUE SPACE. NC2084.2 +023700 02 ANDATA4 PICTURE X(4) VALUE SPACE. NC2084.2 +023800 02 ANDATA5 PICTURE X(5) VALUE SPACE. NC2084.2 +023900 02 ANDATA6 PICTURE X(6) VALUE SPACE. NC2084.2 +024000 02 ANDATA7 PICTURE X(7) VALUE SPACE. NC2084.2 +024100 02 ANDATA8 PICTURE X(8) VALUE SPACE. NC2084.2 +024200 02 ANDATA9 PICTURE X(9) VALUE SPACE. NC2084.2 +024300 02 ANDATA10 PICTURE X(10) VALUE SPACE. NC2084.2 +024400 02 ANDATA11 PICTURE X(11) VALUE SPACE. NC2084.2 +024500 02 ANDATA12 PICTURE X(12) VALUE SPACE. NC2084.2 +024600 02 ANDATA13 PICTURE X(13) VALUE SPACE. NC2084.2 +024700 02 ANDATA14 PICTURE X(14) VALUE SPACE. NC2084.2 +024800 02 ANDATA15 PICTURE X(15) VALUE SPACE. NC2084.2 +024900 02 ANDATA16 PICTURE X(16) VALUE SPACE. NC2084.2 +025000 02 ANDATA17 PICTURE X(17) VALUE SPACE. NC2084.2 +025100 02 ANDATA18 PICTURE X(18) VALUE SPACE. NC2084.2 +025200 02 ANDATA19 PICTURE X(19) VALUE SPACE. NC2084.2 +025300 02 ANDATA20 PICTURE X(20) VALUE SPACE. NC2084.2 +025400 02 ANDATA21 PICTURE X(120) VALUE SPACE. NC2084.2 +025500 01 42-DATANAMES. NC2084.2 +025600 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC2084.2 +025700 02 DNAME2 PICTURE 99 VALUE 01 COMPUTATIONAL. NC2084.2 +025800 02 DNAME3 PICTURE 999 VALUE 001 COMPUTATIONAL. NC2084.2 +025900 02 DNAME4 PICTURE 9(4) VALUE 0001 COMPUTATIONAL. NC2084.2 +026000 02 DNAME5 PICTURE 9(5) VALUE 00001 COMPUTATIONAL. NC2084.2 +026100 02 DNAME6 PICTURE 9(6) VALUE 000001 COMPUTATIONAL. NC2084.2 +026200 02 DNAME7 PICTURE 9(7) VALUE 0000001 COMPUTATIONAL. NC2084.2 +026300 02 DNAME8 PICTURE 9(8) VALUE 00000001 COMPUTATIONAL. NC2084.2 +026400 02 DNAME9 PICTURE 9(9) VALUE 000000001. NC2084.2 +026500 02 DNAME10 PICTURE 9(10) VALUE 0000000001. NC2084.2 +026600 02 DNAME11 PICTURE 9(11) VALUE 00000000001. NC2084.2 +026700 02 DNAME12 PICTURE 9(12) VALUE 000000000001. NC2084.2 +026800 02 DNAME13 PICTURE 9(13) VALUE 0000000000001. NC2084.2 +026900 02 DNAME14 PICTURE 9(14) VALUE 00000000000001. NC2084.2 +027000 02 DNAME15 PICTURE 9(15) VALUE 000000000000001. NC2084.2 +027100 02 DNAME16 PICTURE 9(16) VALUE 0000000000000001. NC2084.2 +027200 02 DNAME17 PICTURE 9(17) VALUE 00000000000000001. NC2084.2 +027300 02 DNAME18 PICTURE 9(18) VALUE 000000000000000001. NC2084.2 +027400 02 DNAME19 PICTURE 9 VALUE 1. NC2084.2 +027500 02 DNAME20 PICTURE 99 VALUE 11. NC2084.2 +027600 02 DNAME21 PICTURE 999 VALUE 111. NC2084.2 +027700 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC2084.2 +027800 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC2084.2 +027900 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC2084.2 +028000 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC2084.2 +028100 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC2084.2 +028200 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC2084.2 +028300 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC2084.2 +028400 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC2084.2 +028500 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +028600 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +028700 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +028800 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +028900 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029000 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029100 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029200 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029300 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029400 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029500 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029600 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029700 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2084.2 +029800 01 TEST-RESULTS. NC2084.2 +029900 02 FILLER PIC X VALUE SPACE. NC2084.2 +030000 02 FEATURE PIC X(20) VALUE SPACE. NC2084.2 +030100 02 FILLER PIC X VALUE SPACE. NC2084.2 +030200 02 P-OR-F PIC X(5) VALUE SPACE. NC2084.2 +030300 02 FILLER PIC X VALUE SPACE. NC2084.2 +030400 02 PAR-NAME. NC2084.2 +030500 03 FILLER PIC X(19) VALUE SPACE. NC2084.2 +030600 03 PARDOT-X PIC X VALUE SPACE. NC2084.2 +030700 03 DOTVALUE PIC 99 VALUE ZERO. NC2084.2 +030800 02 FILLER PIC X(8) VALUE SPACE. NC2084.2 +030900 02 RE-MARK PIC X(61). NC2084.2 +031000 01 TEST-COMPUTED. NC2084.2 +031100 02 FILLER PIC X(30) VALUE SPACE. NC2084.2 +031200 02 FILLER PIC X(17) VALUE NC2084.2 +031300 " COMPUTED=". NC2084.2 +031400 02 COMPUTED-X. NC2084.2 +031500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2084.2 +031600 03 COMPUTED-N REDEFINES COMPUTED-A NC2084.2 +031700 PIC -9(9).9(9). NC2084.2 +031800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2084.2 +031900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2084.2 +032000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2084.2 +032100 03 CM-18V0 REDEFINES COMPUTED-A. NC2084.2 +032200 04 COMPUTED-18V0 PIC -9(18). NC2084.2 +032300 04 FILLER PIC X. NC2084.2 +032400 03 FILLER PIC X(50) VALUE SPACE. NC2084.2 +032500 01 TEST-CORRECT. NC2084.2 +032600 02 FILLER PIC X(30) VALUE SPACE. NC2084.2 +032700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2084.2 +032800 02 CORRECT-X. NC2084.2 +032900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2084.2 +033000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2084.2 +033100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2084.2 +033200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2084.2 +033300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2084.2 +033400 03 CR-18V0 REDEFINES CORRECT-A. NC2084.2 +033500 04 CORRECT-18V0 PIC -9(18). NC2084.2 +033600 04 FILLER PIC X. NC2084.2 +033700 03 FILLER PIC X(2) VALUE SPACE. NC2084.2 +033800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2084.2 +033900 01 CCVS-C-1. NC2084.2 +034000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2084.2 +034100- "SS PARAGRAPH-NAME NC2084.2 +034200- " REMARKS". NC2084.2 +034300 02 FILLER PIC X(20) VALUE SPACE. NC2084.2 +034400 01 CCVS-C-2. NC2084.2 +034500 02 FILLER PIC X VALUE SPACE. NC2084.2 +034600 02 FILLER PIC X(6) VALUE "TESTED". NC2084.2 +034700 02 FILLER PIC X(15) VALUE SPACE. NC2084.2 +034800 02 FILLER PIC X(4) VALUE "FAIL". NC2084.2 +034900 02 FILLER PIC X(94) VALUE SPACE. NC2084.2 +035000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2084.2 +035100 01 REC-CT PIC 99 VALUE ZERO. NC2084.2 +035200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2084.2 +035300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2084.2 +035400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2084.2 +035500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2084.2 +035600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2084.2 +035700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2084.2 +035800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2084.2 +035900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2084.2 +036000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2084.2 +036100 01 CCVS-H-1. NC2084.2 +036200 02 FILLER PIC X(39) VALUE SPACES. NC2084.2 +036300 02 FILLER PIC X(42) VALUE NC2084.2 +036400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2084.2 +036500 02 FILLER PIC X(39) VALUE SPACES. NC2084.2 +036600 01 CCVS-H-2A. NC2084.2 +036700 02 FILLER PIC X(40) VALUE SPACE. NC2084.2 +036800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2084.2 +036900 02 FILLER PIC XXXX VALUE NC2084.2 +037000 "4.2 ". NC2084.2 +037100 02 FILLER PIC X(28) VALUE NC2084.2 +037200 " COPY - NOT FOR DISTRIBUTION". NC2084.2 +037300 02 FILLER PIC X(41) VALUE SPACE. NC2084.2 +037400 NC2084.2 +037500 01 CCVS-H-2B. NC2084.2 +037600 02 FILLER PIC X(15) VALUE NC2084.2 +037700 "TEST RESULT OF ". NC2084.2 +037800 02 TEST-ID PIC X(9). NC2084.2 +037900 02 FILLER PIC X(4) VALUE NC2084.2 +038000 " IN ". NC2084.2 +038100 02 FILLER PIC X(12) VALUE NC2084.2 +038200 " HIGH ". NC2084.2 +038300 02 FILLER PIC X(22) VALUE NC2084.2 +038400 " LEVEL VALIDATION FOR ". NC2084.2 +038500 02 FILLER PIC X(58) VALUE NC2084.2 +038600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2084.2 +038700 01 CCVS-H-3. NC2084.2 +038800 02 FILLER PIC X(34) VALUE NC2084.2 +038900 " FOR OFFICIAL USE ONLY ". NC2084.2 +039000 02 FILLER PIC X(58) VALUE NC2084.2 +039100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2084.2 +039200 02 FILLER PIC X(28) VALUE NC2084.2 +039300 " COPYRIGHT 1985 ". NC2084.2 +039400 01 CCVS-E-1. NC2084.2 +039500 02 FILLER PIC X(52) VALUE SPACE. NC2084.2 +039600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2084.2 +039700 02 ID-AGAIN PIC X(9). NC2084.2 +039800 02 FILLER PIC X(45) VALUE SPACES. NC2084.2 +039900 01 CCVS-E-2. NC2084.2 +040000 02 FILLER PIC X(31) VALUE SPACE. NC2084.2 +040100 02 FILLER PIC X(21) VALUE SPACE. NC2084.2 +040200 02 CCVS-E-2-2. NC2084.2 +040300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2084.2 +040400 03 FILLER PIC X VALUE SPACE. NC2084.2 +040500 03 ENDER-DESC PIC X(44) VALUE NC2084.2 +040600 "ERRORS ENCOUNTERED". NC2084.2 +040700 01 CCVS-E-3. NC2084.2 +040800 02 FILLER PIC X(22) VALUE NC2084.2 +040900 " FOR OFFICIAL USE ONLY". NC2084.2 +041000 02 FILLER PIC X(12) VALUE SPACE. NC2084.2 +041100 02 FILLER PIC X(58) VALUE NC2084.2 +041200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2084.2 +041300 02 FILLER PIC X(13) VALUE SPACE. NC2084.2 +041400 02 FILLER PIC X(15) VALUE NC2084.2 +041500 " COPYRIGHT 1985". NC2084.2 +041600 01 CCVS-E-4. NC2084.2 +041700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2084.2 +041800 02 FILLER PIC X(4) VALUE " OF ". NC2084.2 +041900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2084.2 +042000 02 FILLER PIC X(40) VALUE NC2084.2 +042100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2084.2 +042200 01 XXINFO. NC2084.2 +042300 02 FILLER PIC X(19) VALUE NC2084.2 +042400 "*** INFORMATION ***". NC2084.2 +042500 02 INFO-TEXT. NC2084.2 +042600 04 FILLER PIC X(8) VALUE SPACE. NC2084.2 +042700 04 XXCOMPUTED PIC X(20). NC2084.2 +042800 04 FILLER PIC X(5) VALUE SPACE. NC2084.2 +042900 04 XXCORRECT PIC X(20). NC2084.2 +043000 02 INF-ANSI-REFERENCE PIC X(48). NC2084.2 +043100 01 HYPHEN-LINE. NC2084.2 +043200 02 FILLER PIC IS X VALUE IS SPACE. NC2084.2 +043300 02 FILLER PIC IS X(65) VALUE IS "************************NC2084.2 +043400- "*****************************************". NC2084.2 +043500 02 FILLER PIC IS X(54) VALUE IS "************************NC2084.2 +043600- "******************************". NC2084.2 +043700 01 CCVS-PGM-ID PIC X(9) VALUE NC2084.2 +043800 "NC208A". NC2084.2 +043900 PROCEDURE DIVISION. NC2084.2 +044000 CCVS1 SECTION. NC2084.2 +044100 OPEN-FILES. NC2084.2 +044200 OPEN OUTPUT PRINT-FILE. NC2084.2 +044300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2084.2 +044400 MOVE SPACE TO TEST-RESULTS. NC2084.2 +044500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2084.2 +044600 GO TO CCVS1-EXIT. NC2084.2 +044700 CLOSE-FILES. NC2084.2 +044800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2084.2 +044900 TERMINATE-CCVS. NC2084.2 +045000*S EXIT PROGRAM. NC2084.2 +045100*SERMINATE-CALL. NC2084.2 +045200 STOP RUN. NC2084.2 +045300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2084.2 +045400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2084.2 +045500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2084.2 +045600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2084.2 +045700 MOVE "****TEST DELETED****" TO RE-MARK. NC2084.2 +045800 PRINT-DETAIL. NC2084.2 +045900 IF REC-CT NOT EQUAL TO ZERO NC2084.2 +046000 MOVE "." TO PARDOT-X NC2084.2 +046100 MOVE REC-CT TO DOTVALUE. NC2084.2 +046200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2084.2 +046300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2084.2 +046400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2084.2 +046500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2084.2 +046600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2084.2 +046700 MOVE SPACE TO CORRECT-X. NC2084.2 +046800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2084.2 +046900 MOVE SPACE TO RE-MARK. NC2084.2 +047000 HEAD-ROUTINE. NC2084.2 +047100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +047200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +047300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2084.2 +047400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2084.2 +047500 COLUMN-NAMES-ROUTINE. NC2084.2 +047600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +047700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +047800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +047900 END-ROUTINE. NC2084.2 +048000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2084.2 +048100 END-RTN-EXIT. NC2084.2 +048200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +048300 END-ROUTINE-1. NC2084.2 +048400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2084.2 +048500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2084.2 +048600 ADD PASS-COUNTER TO ERROR-HOLD. NC2084.2 +048700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2084.2 +048800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2084.2 +048900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2084.2 +049000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2084.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2084.2 +049200 END-ROUTINE-12. NC2084.2 +049300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2084.2 +049400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2084.2 +049500 MOVE "NO " TO ERROR-TOTAL NC2084.2 +049600 ELSE NC2084.2 +049700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2084.2 +049800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2084.2 +049900 PERFORM WRITE-LINE. NC2084.2 +050000 END-ROUTINE-13. NC2084.2 +050100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2084.2 +050200 MOVE "NO " TO ERROR-TOTAL ELSE NC2084.2 +050300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2084.2 +050400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2084.2 +050500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +050600 IF INSPECT-COUNTER EQUAL TO ZERO NC2084.2 +050700 MOVE "NO " TO ERROR-TOTAL NC2084.2 +050800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2084.2 +050900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2084.2 +051000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +051100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2084.2 +051200 WRITE-LINE. NC2084.2 +051300 ADD 1 TO RECORD-COUNT. NC2084.2 +051400 IF RECORD-COUNT GREATER 50 NC2084.2 +051500 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2084.2 +051600 MOVE SPACE TO DUMMY-RECORD NC2084.2 +051700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2084.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2084.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2084.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2084.2 +052100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2084.2 +052200 MOVE ZERO TO RECORD-COUNT. NC2084.2 +052300 PERFORM WRT-LN. NC2084.2 +052400 WRT-LN. NC2084.2 +052500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2084.2 +052600 MOVE SPACE TO DUMMY-RECORD. NC2084.2 +052700 BLANK-LINE-PRINT. NC2084.2 +052800 PERFORM WRT-LN. NC2084.2 +052900 FAIL-ROUTINE. NC2084.2 +053000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2084.2 +053100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2084.2 +053200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2084.2 +053300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2084.2 +053400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +053500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2084.2 +053600 GO TO FAIL-ROUTINE-EX. NC2084.2 +053700 FAIL-ROUTINE-WRITE. NC2084.2 +053800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2084.2 +053900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2084.2 +054000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2084.2 +054100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2084.2 +054200 FAIL-ROUTINE-EX. EXIT. NC2084.2 +054300 BAIL-OUT. NC2084.2 +054400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2084.2 +054500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2084.2 +054600 BAIL-OUT-WRITE. NC2084.2 +054700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2084.2 +054800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2084.2 +054900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2084.2 +055000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2084.2 +055100 BAIL-OUT-EX. EXIT. NC2084.2 +055200 CCVS1-EXIT. NC2084.2 +055300 EXIT. NC2084.2 +055400 QUAL-SECTION-1 SECTION. NC2084.2 +055500 PAR-INIT-F2-1. NC2084.2 +055600 MOVE "PAR-TEST-F2-1 " TO PAR-NAME. NC2084.2 +055700 MOVE "IV-20 4.3.8.1 RULE 6" TO ANSI-REFERENCE. NC2084.2 +055800 PAR-TEST-F2-1. NC2084.2 +055900 PERFORM PAR-1A OF QUAL-SECTION-1. NC2084.2 +056000 IF QT1 EQUAL TO "PASS" NC2084.2 +056100 PERFORM PASS NC2084.2 +056200 GO TO PAR-WRITE-F2-1. NC2084.2 +056300 GO TO PAR-FAIL-F2-1. NC2084.2 +056400 PAR-DELETE-F2-1. NC2084.2 +056500 PERFORM DE-LETE. NC2084.2 +056600 GO TO PAR-WRITE-F2-1. NC2084.2 +056700 PAR-FAIL-F2-1. NC2084.2 +056800 PERFORM FAIL. NC2084.2 +056900* NOTE NC2084.2 +057000* PERFORM PARAGRAPH IN SAME SECTION. NC2084.2 +057100 PAR-WRITE-F2-1. NC2084.2 +057200 PERFORM PRINT-DETAIL. NC2084.2 +057300 GO TO PAR-1-EXIT. NC2084.2 +057400* NC2084.2 +057500 PAR-1A. NC2084.2 +057600 MOVE "PASS" TO QT1. NC2084.2 +057700 PAR-1-EXIT. NC2084.2 +057800 EXIT. NC2084.2 +057900* NC2084.2 +058000 PAR-INIT-F2-2. NC2084.2 +058100 MOVE "PAR-TEST-F2-2" TO PAR-NAME. NC2084.2 +058200 MOVE "IV-20 4.3.8.1 RULE 6" TO ANSI-REFERENCE. NC2084.2 +058300 PAR-TEST-F2-2. NC2084.2 +058400 PERFORM PAR-2A OF QUAL-SECTION-2. NC2084.2 +058500 IF QT2 EQUAL TO "PASS" NC2084.2 +058600 PERFORM PASS NC2084.2 +058700 GO TO PAR-WRITE-F2-2. NC2084.2 +058800 GO TO PAR-FAIL-F2-2. NC2084.2 +058900 PAR-DELETE-F2-2. NC2084.2 +059000 PERFORM DE-LETE. NC2084.2 +059100 GO TO PAR-WRITE-F2-2. NC2084.2 +059200 PAR-FAIL-F2-2. NC2084.2 +059300 PERFORM FAIL. NC2084.2 +059400* NOTE NC2084.2 +059500* PERFORM PARAGRAPH IN A DIFFERENT SECTION. NC2084.2 +059600 PAR-WRITE-F2-2. NC2084.2 +059700 PERFORM PRINT-DETAIL. NC2084.2 +059800 GO TO PAR-2-EXIT. NC2084.2 +059900 PAR-2A. NC2084.2 +060000 MOVE "FAIL" TO QT2. NC2084.2 +060100 PAR-2-EXIT. NC2084.2 +060200 EXIT. NC2084.2 +060300* NC2084.2 +060400 PAR-INIT-F2-3. NC2084.2 +060500 MOVE "PAR-TEST-F2-3" TO PAR-NAME. NC2084.2 +060600 MOVE "IV-20 4.3.8.1 RULE 6" TO ANSI-REFERENCE. NC2084.2 +060700 PAR-TEST-F2-3. NC2084.2 +060800 GO TO PAR-3B IN QUAL-SECTION-1. NC2084.2 +060900* NOTE NC2084.2 +061000* GO TO IN SAME SECTION. NC2084.2 +061100 PAR-3A. NC2084.2 +061200 MOVE "FAIL" TO QT3. NC2084.2 +061300 GO TO PAR-3C. NC2084.2 +061400 PAR-3B. NC2084.2 +061500 MOVE "PASS" TO QT3. NC2084.2 +061600 PAR-3C. NC2084.2 +061700 IF QT3 EQUAL TO "PASS" NC2084.2 +061800 PERFORM PASS NC2084.2 +061900 GO TO PAR-WRITE-F2-3. NC2084.2 +062000 GO TO PAR-FAIL-F2-3. NC2084.2 +062100 PAR-DELETE-F2-3. NC2084.2 +062200 PERFORM DE-LETE. NC2084.2 +062300 GO TO PAR-WRITE-F2-3. NC2084.2 +062400 PAR-FAIL-F2-3. NC2084.2 +062500 PERFORM FAIL. NC2084.2 +062600 PAR-WRITE-F2-3. NC2084.2 +062700 PERFORM PRINT-DETAIL. NC2084.2 +062800 PAR-3-EXIT. NC2084.2 +062900 EXIT. NC2084.2 +063000* NC2084.2 +063100 PAR-INIT-F2-4. NC2084.2 +063200 MOVE "PAR-TEST-F2-4" TO PAR-NAME. NC2084.2 +063300 MOVE "IV-20 4.3.8.1 RULE 6" TO ANSI-REFERENCE. NC2084.2 +063400 PAR-TEST-F2-4. NC2084.2 +063500 GO TO PAR-4B IN QUAL-SECTION-2. NC2084.2 +063600* NOTE NC2084.2 +063700* GO TO IN DIFFERENT SECTION. NC2084.2 +063800 PAR-4A. NC2084.2 +063900 MOVE "FAIL" TO QT4. NC2084.2 +064000 GO TO PAR-4C. NC2084.2 +064100 PAR-4B. NC2084.2 +064200 MOVE "FAIL" TO QT4. NC2084.2 +064300 PAR-4C. NC2084.2 +064400 IF QT4 EQUAL TO "PASS" NC2084.2 +064500 PERFORM PASS NC2084.2 +064600 GO TO PAR-WRITE-F2-4. NC2084.2 +064700 GO TO PAR-FAIL-F2-4. NC2084.2 +064800 PAR-DELETE-F2-4. NC2084.2 +064900 PERFORM DE-LETE. NC2084.2 +065000 GO TO PAR-WRITE-F2-4. NC2084.2 +065100 PAR-FAIL-F2-4. NC2084.2 +065200 PERFORM FAIL. NC2084.2 +065300 PAR-WRITE-F2-4. NC2084.2 +065400 PERFORM PRINT-DETAIL. NC2084.2 +065500 PAR-4-EXIT. NC2084.2 +065600 PERFORM END-ROUTINE. NC2084.2 +065700 GO TO QUAL-EXIT. NC2084.2 +065800 QUAL-SECTION-2 SECTION. NC2084.2 +065900 PAR-1A. NC2084.2 +066000 MOVE "FAIL" TO QT1. NC2084.2 +066100 PAR-2A. NC2084.2 +066200 MOVE "PASS" TO QT2. NC2084.2 +066300 PAR-3B. NC2084.2 +066400 MOVE "FAIL" TO QT3. NC2084.2 +066500 GO TO PAR-3C OF QUAL-SECTION-1. NC2084.2 +066600 PAR-3C. NC2084.2 +066700 PERFORM FAIL. NC2084.2 +066800* NOTE THIS PARAGRAPH SHOULD NEVER BE ENTERED. NC2084.2 +066900 GO TO PAR-INIT-F2-4 IN QUAL-SECTION-1. NC2084.2 +067000 PAR-4. NC2084.2 +067100 GO TO QUAL-EXIT. NC2084.2 +067200* NOTE NC2084.2 +067300* IF NC2084.2 +067400* GO TO DIFFERENT SECTION FAILS END QUALIFICATION TEST. NC2084.2 +067500 PAR-4B. NC2084.2 +067600 MOVE "PASS" TO QT4. NC2084.2 +067700 GO TO PAR-4C IN QUAL-SECTION-1. NC2084.2 +067800 QUAL-EXIT. NC2084.2 +067900 EXIT. NC2084.2 +068000 DATA-NAME-QUAL SECTION. NC2084.2 +068100 QAL-INIT-F1-1. NC2084.2 +068200 MOVE "QAL-TEST-F1-1 " TO PAR-NAME. NC2084.2 +068300 MOVE SPACE TO TEST-RESULTS. NC2084.2 +068400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +068500 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +068600 QAL-TEST-F1-1. NC2084.2 +068700 MOVE "123456789" TO QUAL-TEST-SUB-GRP-2. NC2084.2 +068800 MOVE ZERO TO GRP-FOR-QUAL-TO. NC2084.2 +068900 MOVE 2 TO WRK-DS-01V00. NC2084.2 +069000 MOVE QUAL-TEST-1 OF GRP-FOR-QUAL-FROM NC2084.2 +069100 TO QUAL-TEST-1 OF GRP-FOR-QUAL-TO. NC2084.2 +069200 IF QUAL-TEST-1 OF GRP-FOR-QUAL-TO EQUAL TO NC2084.2 +069300 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" NC2084.2 +069400 PERFORM PASS NC2084.2 +069500 GO TO QAL-WRITE-F1-1. NC2084.2 +069600 GO TO QAL-FAIL-F1-1. NC2084.2 +069700 QAL-DELETE-F1-1. NC2084.2 +069800 PERFORM DE-LETE. NC2084.2 +069900 GO TO QAL-WRITE-F1-1. NC2084.2 +070000 QAL-FAIL-F1-1. NC2084.2 +070100 MOVE "ABCDEFGGHIJKLMNOPQRSTUVWXYZ" TO SEND-BREAKDOWN NC2084.2 +070200 MOVE QUAL-TEST-1 OF GRP-FOR-QUAL-TO TO RECEIVE-BREAKDOWN NC2084.2 +070300 PERFORM FAIL NC2084.2 +070400 MOVE SEND-20 TO CORRECT-A NC2084.2 +070500 MOVE RECEIVE-20 TO COMPUTED-A NC2084.2 +070600 MOVE "1ST 20 POSITIONS OF ANSWERS" TO RE-MARK NC2084.2 +070700 MOVE TEST-RESULTS TO PRINT-REC. NC2084.2 +070800 WRITE PRINT-REC NC2084.2 +070900 MOVE SPACES TO P-OR-F NC2084.2 +071000 MOVE SEND-40 TO CORRECT-A NC2084.2 +071100 MOVE RECEIVE-40 TO COMPUTED-A NC2084.2 +071200 MOVE "QAL-TEST-F1-1 " TO PAR-NAME. NC2084.2 +071300 MOVE "2ND 20 POSITIONS OF ANSWERS" TO RE-MARK. NC2084.2 +071400 QAL-WRITE-F1-1. NC2084.2 +071500 PERFORM PRINT-DETAIL. NC2084.2 +071600* NC2084.2 +071700 QAL-INIT-F1-2. NC2084.2 +071800 MOVE "QAL-TEST-F1-2 " TO PAR-NAME. NC2084.2 +071900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +072000 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +072100 MOVE ZERO TO QUAL-TEST-2-TO. NC2084.2 +072200 QAL-TEST-F1-2. NC2084.2 +072300 ADD QUAL-TEST-2 OF GRP-FOR-QUAL-FROM NC2084.2 +072400 TO QUAL-TEST-2 OF GRP-FOR-QUAL-TO. NC2084.2 +072500 IF QUAL-TEST-2 OF GRP-FOR-QUAL-TO EQUAL TO 9999999999 NC2084.2 +072600 PERFORM PASS NC2084.2 +072700 GO TO QAL-WRITE-F1-2. NC2084.2 +072800 GO TO QAL-FAIL-F1-2. NC2084.2 +072900 QAL-DELETE-F1-2. NC2084.2 +073000 PERFORM DE-LETE. NC2084.2 +073100 GO TO QAL-WRITE-F1-2. NC2084.2 +073200 QAL-FAIL-F1-2. NC2084.2 +073300 MOVE 9999999999 TO CORRECT-18V0. NC2084.2 +073400 MOVE QUAL-TEST-2 OF GRP-FOR-QUAL-TO TO COMPUTED-18V0. NC2084.2 +073500 PERFORM FAIL. NC2084.2 +073600 QAL-WRITE-F1-2. NC2084.2 +073700 PERFORM PRINT-DETAIL. NC2084.2 +073800* NC2084.2 +073900 QAL-INIT-F1-3. NC2084.2 +074000 MOVE "QAL-TEST-F1-3 " TO PAR-NAME. NC2084.2 +074100 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +074200 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +074300 QAL-TEST-F1-3. NC2084.2 +074400 MULTIPLY QUAL-TEST-3 OF GRP-FOR-QUAL-FROM BY WRK-DS-01V00 NC2084.2 +074500 GIVING QUAL-TEST-3 OF GRP-FOR-QUAL-TO. NC2084.2 +074600 IF QUAL-TEST-3 OF GRP-FOR-QUAL-TO EQUAL TO 004 NC2084.2 +074700 PERFORM PASS NC2084.2 +074800 GO TO QAL-WRITE-F1-3. NC2084.2 +074900 GO TO QAL-FAIL-F1-3. NC2084.2 +075000 QAL-DELETE-F1-3. NC2084.2 +075100 PERFORM DE-LETE. NC2084.2 +075200 GO TO QAL-WRITE-F1-3. NC2084.2 +075300 QAL-FAIL-F1-3. NC2084.2 +075400 MOVE 004 TO CORRECT-N. NC2084.2 +075500 MOVE QUAL-TEST-3 OF GRP-FOR-QUAL-TO TO COMPUTED-N. NC2084.2 +075600 PERFORM FAIL. NC2084.2 +075700 QAL-WRITE-F1-3. NC2084.2 +075800 PERFORM PRINT-DETAIL. NC2084.2 +075900* NC2084.2 +076000 QAL-INIT-F1-4. NC2084.2 +076100 MOVE "QAL-TEST-F1-4 " TO PAR-NAME. NC2084.2 +076200 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +076300 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +076400 QAL-TEST-F1-4. NC2084.2 +076500 MOVE QUAL-TEST-4 OF GRP-FOR-QUAL-FROM (WRK-DS-01V00) NC2084.2 +076600 TO QUAL-TEST-4 OF GRP-FOR-QUAL-TO (WRK-DS-01V00). NC2084.2 +076700 IF QUAL-TEST1 OF GRP-FOR-QUAL-TO EQUAL TO "02000" NC2084.2 +076800 PERFORM PASS NC2084.2 +076900 GO TO QAL-WRITE-F1-4. NC2084.2 +077000 GO TO QAL-FAIL-F1-4. NC2084.2 +077100 QAL-DELETE-F1-4. NC2084.2 +077200 PERFORM DE-LETE. NC2084.2 +077300 GO TO QAL-WRITE-F1-4. NC2084.2 +077400 QAL-FAIL-F1-4. NC2084.2 +077500 MOVE "02000" TO CORRECT-A. NC2084.2 +077600 MOVE QUAL-TEST1 OF GRP-FOR-QUAL-TO TO COMPUTED-A. NC2084.2 +077700 PERFORM FAIL. NC2084.2 +077800 QAL-WRITE-F1-4. NC2084.2 +077900 PERFORM PRINT-DETAIL. NC2084.2 +078000* NC2084.2 +078100 QAL-INIT-F1-5. NC2084.2 +078200 MOVE "QAL-TEST-F1-5 " TO PAR-NAME. NC2084.2 +078300 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +078400 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +078500 QAL-TEST-F1-5. NC2084.2 +078600 MOVE QUAL-TEST-1-FROM IN GRP-FOR-QUAL-FROM TO NC2084.2 +078700 QUAL-TEST-1-TO IN GRP-FOR-QUAL-TO. NC2084.2 +078800 IF QUAL-TEST-1-TO IN GRP-FOR-QUAL-TO EQUAL TO NC2084.2 +078900 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" NC2084.2 +079000 PERFORM PASS NC2084.2 +079100 GO TO QAL-WRITE-F1-5. NC2084.2 +079200 GO TO QAL-FAIL-F1-5. NC2084.2 +079300 QAL-DELETE-F1-5. NC2084.2 +079400 PERFORM DE-LETE. NC2084.2 +079500 GO TO QAL-WRITE-F1-5. NC2084.2 +079600 QAL-FAIL-F1-5. NC2084.2 +079700 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO SEND-BREAKDOWN. NC2084.2 +079800 MOVE QUAL-TEST-1-TO IN GRP-FOR-QUAL-TO TO RECEIVE-BREAKDOWN. NC2084.2 +079900 PERFORM FAIL. NC2084.2 +080000 MOVE SEND-20 TO CORRECT-A. NC2084.2 +080100 MOVE RECEIVE-20 TO COMPUTED-A. NC2084.2 +080200 PERFORM QAL-WRITE-F1-5. NC2084.2 +080300 MOVE SPACES TO P-OR-F. NC2084.2 +080400 MOVE SEND-40 TO CORRECT-A. NC2084.2 +080500 MOVE RECEIVE-40 TO COMPUTED-A. NC2084.2 +080600 MOVE "2ND 20 POSITIONS OF ANSWERS" TO RE-MARK. NC2084.2 +080700 MOVE TEST-RESULTS TO PRINT-REC. NC2084.2 +080800 WRITE PRINT-REC. NC2084.2 +080900 QAL-WRITE-F1-5. NC2084.2 +081000 PERFORM PRINT-DETAIL. NC2084.2 +081100* NC2084.2 +081200 QAL-INIT-F1-6. NC2084.2 +081300 MOVE "QAL-TEST-F1-6 " TO PAR-NAME. NC2084.2 +081400 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +081500 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +081600 QAL-TEST-F1-6. NC2084.2 +081700 MOVE 0000000000 TO QUAL-TEST-2-TO IN GRP-FOR-QUAL-TO. NC2084.2 +081800 ADD QUAL-TEST-2-FROM IN GRP-FOR-QUAL-FROM TO NC2084.2 +081900 QUAL-TEST-2-TO IN GRP-FOR-QUAL-TO. NC2084.2 +082000 IF QUAL-TEST-2-TO IN GRP-FOR-QUAL-TO EQUAL TO 9999999999 NC2084.2 +082100 PERFORM PASS NC2084.2 +082200 GO TO QAL-WRITE-F1-6. NC2084.2 +082300 GO TO QAL-FAIL-F1-6. NC2084.2 +082400 QAL-DELETE-F1-6. NC2084.2 +082500 PERFORM DE-LETE. NC2084.2 +082600 GO TO QAL-WRITE-F1-6. NC2084.2 +082700 QAL-FAIL-F1-6. NC2084.2 +082800 MOVE 9999999999 TO CORRECT-18V0. NC2084.2 +082900 MOVE QUAL-TEST-2-TO IN GRP-FOR-QUAL-TO TO COMPUTED-18V0. NC2084.2 +083000 PERFORM FAIL. NC2084.2 +083100 QAL-WRITE-F1-6. NC2084.2 +083200 PERFORM PRINT-DETAIL. NC2084.2 +083300* NC2084.2 +083400 QAL-INIT-F1-7. NC2084.2 +083500 MOVE "QAL-TEST-F1-7 " TO PAR-NAME. NC2084.2 +083600 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +083700 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +083800 QAL-TEST-F1-7. NC2084.2 +083900 MULTIPLY QUAL-TEST-3-FROM IN GRP-FOR-QUAL-FROM BY NC2084.2 +084000 WRK-DS-01V00 GIVING QUAL-TEST-3-TO IN GRP-FOR-QUAL-TO. NC2084.2 +084100 IF QUAL-TEST-3-TO IN GRP-FOR-QUAL-TO EQUAL TO 004 NC2084.2 +084200 PERFORM PASS NC2084.2 +084300 GO TO QAL-WRITE-F1-7. NC2084.2 +084400 GO TO QAL-FAIL-F1-7. NC2084.2 +084500 QAL-DELETE-F1-7. NC2084.2 +084600 PERFORM DE-LETE. NC2084.2 +084700 GO TO QAL-WRITE-F1-7. NC2084.2 +084800 QAL-FAIL-F1-7. NC2084.2 +084900 MOVE 004 TO CORRECT-N. NC2084.2 +085000 MOVE QUAL-TEST-3-TO IN GRP-FOR-QUAL-TO TO COMPUTED-N. NC2084.2 +085100 PERFORM FAIL. NC2084.2 +085200 QAL-WRITE-F1-7. NC2084.2 +085300 PERFORM PRINT-DETAIL. NC2084.2 +085400* NC2084.2 +085500 QAL-INIT-F1-8. NC2084.2 +085600 MOVE "QAL-TEST-F1-8 " TO PAR-NAME. NC2084.2 +085700 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +085800 MOVE "DATA-NAME QUAL " TO FEATURE. NC2084.2 +085900 QAL-TEST-F1-8. NC2084.2 +086000 MOVE QUAL-TEST-4-FROM IN GRP-FOR-QUAL-FROM (WRK-DS-01V00) NC2084.2 +086100 TO QUAL-TEST-4-TO IN GRP-FOR-QUAL-TO (WRK-DS-01V00). NC2084.2 +086200 IF QUAL-TEST2 IN GRP-FOR-QUAL-TO EQUAL TO "0700" NC2084.2 +086300 PERFORM PASS NC2084.2 +086400 GO TO QAL-WRITE-F1-8. NC2084.2 +086500 GO TO QAL-FAIL-F1-8. NC2084.2 +086600 QAL-DELETE-F1-8. NC2084.2 +086700 PERFORM DE-LETE. NC2084.2 +086800 GO TO QAL-WRITE-F1-8. NC2084.2 +086900 QAL-FAIL-F1-8. NC2084.2 +087000 MOVE "0700" TO CORRECT-A. NC2084.2 +087100 MOVE QUAL-TEST2 TO COMPUTED-A. NC2084.2 +087200 PERFORM FAIL. NC2084.2 +087300 QAL-WRITE-F1-8. NC2084.2 +087400 PERFORM PRINT-DETAIL. NC2084.2 +087500 PERFORM END-ROUTINE. NC2084.2 +087600* NC2084.2 +087700 MOVE-CORR-ROUTINE SECTION. NC2084.2 +087800 MOV-INIT-F1-1. NC2084.2 +087900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +088000 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +088100 MOVE THREE TO XYZ-1 OF CORR-DATA-1. NC2084.2 +088200 MOVE FOUR TO XYZ-2 OF CORR-DATA-1. NC2084.2 +088300 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2084.2 +088400 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2084.2 +088500 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2084.2 +088600 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2084.2 +088700 MOV-INIT-F1-1-1. NC2084.2 +088800 MOVE "MOV-TEST-F1-1-1" TO PAR-NAME. NC2084.2 +088900 MOV-TEST-F1-1-1. NC2084.2 +089000 MOVE CORRESPONDING CORR-DATA-1 TO CORR-DATA-2. NC2084.2 +089100 IF XYZ-2 OF CORR-DATA-2 EQUAL TO 4 NC2084.2 +089200 PERFORM PASS ELSE NC2084.2 +089300 GO TO MOV-FAIL-F1-1-1. NC2084.2 +089400 GO TO MOV-WRITE-F1-1-1. NC2084.2 +089500 MOV-DELETE-F1-1-1. NC2084.2 +089600 PERFORM DE-LETE. NC2084.2 +089700 GO TO MOV-WRITE-F1-1-1. NC2084.2 +089800 MOV-FAIL-F1-1-1. NC2084.2 +089900 PERFORM FAIL. NC2084.2 +090000 MOVE XYZ-2 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +090100 MOVE 04 TO CORRECT-A. NC2084.2 +090200 MOV-WRITE-F1-1-1. NC2084.2 +090300 PERFORM PRINT-DETAIL. NC2084.2 +090400* NC2084.2 +090500 MOV-INIT-F1-1-2. NC2084.2 +090600 MOVE "MOV-TEST-F1-1-2" TO PAR-NAME. NC2084.2 +090700 MOV-TEST-F1-1-2. NC2084.2 +090800 IF XYZ-1 OF CORR-DATA-2 EQUAL TO THREE NC2084.2 +090900 PERFORM PASS ELSE NC2084.2 +091000 GO TO MOV-FAIL-F1-1-2. NC2084.2 +091100 GO TO MOV-WRITE-F1-1-2. NC2084.2 +091200 MOV-DELETE-F1-1-2. NC2084.2 +091300 PERFORM DE-LETE. NC2084.2 +091400 GO TO MOV-WRITE-F1-1-2. NC2084.2 +091500 MOV-FAIL-F1-1-2. NC2084.2 +091600 PERFORM FAIL. NC2084.2 +091700 MOVE XYZ-1 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +091800 MOVE THREE TO CORRECT-A. NC2084.2 +091900 MOV-WRITE-F1-1-2. NC2084.2 +092000 PERFORM PRINT-DETAIL. NC2084.2 +092100* NC2084.2 +092200 MOV-INIT-F1-1-3. NC2084.2 +092300 MOVE "MOV-TEST-F1-1-3" TO PAR-NAME. NC2084.2 +092400 MOV-TEST-F1-1-3. NC2084.2 +092500 IF XYZ-3 OF CORR-DATA-2 EQUAL TO TEN NC2084.2 +092600 PERFORM PASS ELSE NC2084.2 +092700 GO TO MOV-FAIL-F1-1-3. NC2084.2 +092800 GO TO MOV-WRITE-F1-1-3. NC2084.2 +092900 MOV-DELETE-F1-1-3. NC2084.2 +093000 PERFORM DE-LETE. NC2084.2 +093100 GO TO MOV-WRITE-F1-1-3. NC2084.2 +093200 MOV-FAIL-F1-1-3. NC2084.2 +093300 MOVE XYZ-3 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +093400 MOVE "10" TO CORRECT-A. NC2084.2 +093500 PERFORM FAIL. NC2084.2 +093600 MOV-WRITE-F1-1-3. NC2084.2 +093700 PERFORM PRINT-DETAIL. NC2084.2 +093800* NC2084.2 +093900 MOV-INIT-F1-1-4. NC2084.2 +094000 MOVE "MOV-TEST-F1-1-4" TO PAR-NAME. NC2084.2 +094100 MOV-TEST-F1-1-4. NC2084.2 +094200 IF XYZ-4 OF CORR-DATA-2 EQUAL TO XYZ-4 OF NC2084.2 +094300 CORR-DATA-1 NC2084.2 +094400 PERFORM PASS ELSE NC2084.2 +094500 GO TO MOV-FAIL-F1-1-4. NC2084.2 +094600 GO TO MOV-WRITE-F1-1-4. NC2084.2 +094700 MOV-DELETE-F1-1-4. NC2084.2 +094800 PERFORM DE-LETE. NC2084.2 +094900 GO TO MOV-WRITE-F1-1-4. NC2084.2 +095000 MOV-FAIL-F1-1-4. NC2084.2 +095100 PERFORM FAIL. NC2084.2 +095200 MOVE XYZ-4 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +095300 MOVE XYZ-4 OF CORR-DATA-1 TO CORRECT-A. NC2084.2 +095400 MOV-WRITE-F1-1-4. NC2084.2 +095500 PERFORM PRINT-DETAIL. NC2084.2 +095600* NC2084.2 +095700 MOV-INIT-F1-1-5. NC2084.2 +095800 MOVE "MOV-TEST-F1-1-5" TO PAR-NAME. NC2084.2 +095900 MOV-TEST-F1-1-5. NC2084.2 +096000 IF XYZ-5 OF CORR-DATA-2 EQUAL TO 01 NC2084.2 +096100 PERFORM PASS ELSE NC2084.2 +096200 GO TO MOV-FAIL-F1-1-5. NC2084.2 +096300 GO TO MOV-WRITE-F1-1-5. NC2084.2 +096400 MOV-DELETE-F1-1-5. NC2084.2 +096500 PERFORM DE-LETE. NC2084.2 +096600 GO TO MOV-WRITE-F1-1-5. NC2084.2 +096700 MOV-FAIL-F1-1-5. NC2084.2 +096800 MOVE XYZ-5 OF CORR-DATA-2 TO COMPUTED-A. NC2084.2 +096900 MOVE "01" TO CORRECT-A. NC2084.2 +097000 PERFORM FAIL. NC2084.2 +097100 MOV-WRITE-F1-1-5. NC2084.2 +097200 PERFORM PRINT-DETAIL. NC2084.2 +097300* NC2084.2 +097400 MOV-INIT-F1-2. NC2084.2 +097500 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +097600 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +097700 MOVE THREE TO XYZ-1 OF CORR-DATA-1. NC2084.2 +097800 MOVE FOUR TO XYZ-2 OF CORR-DATA-1. NC2084.2 +097900 MOVE TEN TO XYZ-3 OF CORR-DATA-1. NC2084.2 +098000 MOVE ZERO TO XYZ-4 OF CORR-DATA-1. NC2084.2 +098100 MOVE 01 TO XYZ-5 OF CORR-DATA-1. NC2084.2 +098200 MOVE 00 TO XYZ-6 OF CORR-DATA-1. NC2084.2 +098300 MOVE CORRESPONDING CORR-DATA-1 TO CORR-DATA-3. NC2084.2 +098400 MOV-INIT-F1-2-1. NC2084.2 +098500 MOVE "MOV-TEST-F1-2-1" TO PAR-NAME. NC2084.2 +098600 MOV-TEST-F1-2-1. NC2084.2 +098700 IF XYZ-1 OF CORR-DATA-3 EQUAL TO 03 NC2084.2 +098800 PERFORM PASS ELSE NC2084.2 +098900 GO TO MOV-FAIL-F1-2-1. NC2084.2 +099000 GO TO MOV-WRITE-F1-2-1. NC2084.2 +099100 MOV-DELETE-F1-2-1. NC2084.2 +099200 PERFORM DE-LETE. NC2084.2 +099300 GO TO MOV-WRITE-F1-2-1. NC2084.2 +099400 MOV-FAIL-F1-2-1. NC2084.2 +099500 PERFORM FAIL. NC2084.2 +099600 MOVE XYZ-1 OF CORR-DATA-3 TO COMPUTED-A. NC2084.2 +099700 MOVE "03" TO CORRECT-A. NC2084.2 +099800 MOV-WRITE-F1-2-1. NC2084.2 +099900 PERFORM PRINT-DETAIL. NC2084.2 +100000* NC2084.2 +100100 MOV-INIT-F1-2-2. NC2084.2 +100200 MOVE "MOV-TEST-F1-2-2" TO PAR-NAME. NC2084.2 +100300 MOV-TEST-F1-2-2. NC2084.2 +100400 IF XYZ-3 OF CORR-DATA-3 EQUAL TO 10 NC2084.2 +100500 PERFORM PASS ELSE NC2084.2 +100600 GO TO MOV-FAIL-F1-2-2. NC2084.2 +100700 GO TO MOV-WRITE-F1-2-2. NC2084.2 +100800 MOV-DELETE-F1-2-2. NC2084.2 +100900 PERFORM DE-LETE. NC2084.2 +101000 GO TO MOV-WRITE-F1-2-2. NC2084.2 +101100 MOV-FAIL-F1-2-2. NC2084.2 +101200 PERFORM FAIL. NC2084.2 +101300 MOVE XYZ-3 OF CORR-DATA-3 TO COMPUTED-A. NC2084.2 +101400 MOVE "10" TO CORRECT-A. NC2084.2 +101500 MOV-WRITE-F1-2-2. NC2084.2 +101600 PERFORM PRINT-DETAIL. NC2084.2 +101700* NC2084.2 +101800 MOV-INIT-F1-3. NC2084.2 +101900 MOVE "MOV-TEST-F1-3" TO PAR-NAME. NC2084.2 +102000 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +102100 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +102200 MOVE ZERO TO CORR-DATA-5. NC2084.2 +102300 MOVE 123456789012 TO CORR-DATA-3. NC2084.2 +102400 MOVE CORRESPONDING CORR-DATA-3 TO CORR-DATA-5. NC2084.2 +102500 MOV-TEST-F1-3. NC2084.2 +102600 IF XYZ-1 OF CORR-DATA-5 EQUAL TO 12 NEXT NC2084.2 +102700 SENTENCE ELSE NC2084.2 +102800 GO TO MOV-FAIL-F1-3. NC2084.2 +102900 IF XYZ-2 OF CORR-DATA-5 EQUAL TO 90 NEXT NC2084.2 +103000 SENTENCE ELSE NC2084.2 +103100 GO TO MOV-FAIL-F1-3. NC2084.2 +103200 IF XYZ-13 OF CORR-DATA-5 EQUAL TO 0 NC2084.2 +103300 PERFORM PASS ELSE NC2084.2 +103400 GO TO MOV-FAIL-F1-3. NC2084.2 +103500 GO TO MOV-WRITE-F1-3. NC2084.2 +103600 MOV-DELETE-F1-3. NC2084.2 +103700 PERFORM DE-LETE. NC2084.2 +103800 GO TO MOV-WRITE-F1-3. NC2084.2 +103900 MOV-FAIL-F1-3. NC2084.2 +104000 MOVE CORR-DATA-5 TO COMPUTED-A. NC2084.2 +104100 MOVE "9012000000000000" TO CORRECT-A. NC2084.2 +104200 PERFORM FAIL. NC2084.2 +104300 MOV-WRITE-F1-3. NC2084.2 +104400 PERFORM PRINT-DETAIL. NC2084.2 +104500* NC2084.2 +104600 MOV-INIT-F1-4. NC2084.2 +104700 MOVE "MOV-TEST-F1-4 " TO PAR-NAME. NC2084.2 +104800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +104900 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +105000 MOVE SPACE TO GRP-MOVE-CORR-R. NC2084.2 +105100 MOVE CORRESPONDING GRP-MOVE-CORR-1 TO GRP-MOVE-CORR-R. NC2084.2 +105200 MOV-TEST-F1-4. NC2084.2 +105300 IF GRP-MOVE-CORR-R EQUAL TO " 111222333XYZ " NC2084.2 +105400 PERFORM PASS GO TO MOV-WRITE-F1-4. NC2084.2 +105500 GO TO MOVE-FAIL-F1-4. NC2084.2 +105600 MOV-DELETE-F1-4. NC2084.2 +105700 PERFORM DE-LETE. NC2084.2 +105800 GO TO MOV-WRITE-F1-4. NC2084.2 +105900 MOVE-FAIL-F1-4. NC2084.2 +106000 MOVE GRP-MOVE-CORR-R TO COMPUTED-A. NC2084.2 +106100 MOVE " 111222333XYZ " TO CORRECT-A. NC2084.2 +106200 PERFORM FAIL. NC2084.2 +106300 MOV-WRITE-F1-4. NC2084.2 +106400 PERFORM PRINT-DETAIL. NC2084.2 +106500* NC2084.2 +106600 MOV-INIT-F1-5. NC2084.2 +106700 MOVE "MOV-TEST-F1-5" TO PAR-NAME. NC2084.2 +106800 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +106900 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +107000 MOVE SPACE TO GRP-TO-MOVE-CORR-TO. NC2084.2 +107100 MOVE CORRESPONDING GRP-TO-MOVE-CORR-1 TO NC2084.2 +107200 GRP-TO-MOVE-CORR-TO. NC2084.2 +107300 MOV-TEST-F1-5. NC2084.2 +107400 IF GRP-TO-MOVE-CORR-TO EQUAL TO "111 123ABC45" NC2084.2 +107500 PERFORM PASS GO TO MOV-WRITE-F1-5. NC2084.2 +107600 GO TO MOVE-FAIL-F1-5. NC2084.2 +107700 MOV-DELETE-F1-5. NC2084.2 +107800 PERFORM DE-LETE. NC2084.2 +107900 GO TO MOV-WRITE-F1-5. NC2084.2 +108000 MOVE-FAIL-F1-5. NC2084.2 +108100 MOVE GRP-TO-MOVE-CORR-TO TO COMPUTED-A. NC2084.2 +108200 MOVE "111 123ABC45" TO CORRECT-A. NC2084.2 +108300 PERFORM FAIL. NC2084.2 +108400 MOV-WRITE-F1-5. NC2084.2 +108500 PERFORM PRINT-DETAIL. NC2084.2 +108600* NC2084.2 +108700 MOV-INIT-F1-6. NC2084.2 +108800 MOVE "MOV-TEST-F1-6" TO PAR-NAME. NC2084.2 +108900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +109000 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +109100 MOVE CORRESPONDING MOVE54 TO MOVE60. NC2084.2 +109200 MOV-TEST-F1-6. NC2084.2 +109300 IF MOVE60 EQUAL TO "XYA" NC2084.2 +109400 PERFORM PASS NC2084.2 +109500 GO TO MOV-WRITE-F1-6. NC2084.2 +109600 GO TO MOV-FAIL-F1-6. NC2084.2 +109700 MOV-DELETE-F1-6. NC2084.2 +109800 PERFORM DE-LETE. NC2084.2 +109900 GO TO MOV-WRITE-F1-6. NC2084.2 +110000 MOV-FAIL-F1-6. NC2084.2 +110100 MOVE MOVE60 TO COMPUTED-A NC2084.2 +110200 MOVE "XYA" TO CORRECT-A NC2084.2 +110300 PERFORM FAIL. NC2084.2 +110400 MOV-WRITE-F1-6. NC2084.2 +110500 PERFORM PRINT-DETAIL. NC2084.2 +110600* NC2084.2 +110700 MOV-INIT-F1-7. NC2084.2 +110800 MOVE "MOV-TEST-F1-7" TO PAR-NAME. NC2084.2 +110900 MOVE "IV-18 4.3.8.1" TO ANSI-REFERENCE. NC2084.2 +111000 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2084.2 +111100 MOVE "*" TO MOVE56 OF MOVE60 MOVE58 OF MOVE60 MOVE65. NC2084.2 +111200 MOV-TEST-F1-7. NC2084.2 +111300 IF MOVE60 EQUAL TO "***" NC2084.2 +111400 PERFORM PASS NC2084.2 +111500 GO TO MOV-WRITE-F1-7. NC2084.2 +111600 GO TO MOV-FAIL-F1-7. NC2084.2 +111700 MOV-DELETE-F1-7. NC2084.2 +111800 PERFORM DE-LETE. NC2084.2 +111900 GO TO MOV-WRITE-F1-7. NC2084.2 +112000 MOV-FAIL-F1-7. NC2084.2 +112100 MOVE MOVE60 TO COMPUTED-A NC2084.2 +112200 MOVE "***" TO CORRECT-A NC2084.2 +112300 PERFORM FAIL. NC2084.2 +112400 MOV-WRITE-F1-7. NC2084.2 +112500 PERFORM PRINT-DETAIL. NC2084.2 +112600 PERFORM END-ROUTINE. NC2084.2 +112700 NUMERIC-OPERAND-LIMITS-TESTS SECTION. NC2084.2 +112800 CCVS-EXIT SECTION. NC2084.2 +112900 CCVS-999999. NC2084.2 +113000 GO TO CLOSE-FILES. NC2084.2 diff --git a/tests/cobol85/NC/NC209A.CBL b/tests/cobol85/NC/NC209A.CBL new file mode 100755 index 00000000..296b7d64 --- /dev/null +++ b/tests/cobol85/NC/NC209A.CBL @@ -0,0 +1,966 @@ +000100 IDENTIFICATION DIVISION. NC2094.2 +000200 PROGRAM-ID. NC2094.2 +000300 NC209A. NC2094.2 +000400* * NC2094.2 +000500**************************************************************** NC2094.2 +000600* * NC2094.2 +000700* VALIDATION FOR:- * NC2094.2 +000800* * NC2094.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2094.2 +001000* * NC2094.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2094.2 +001200* * NC2094.2 +001300**************************************************************** NC2094.2 +001400* * NC2094.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2094.2 +001600* * NC2094.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2094.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2094.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2094.2 +002000* * NC2094.2 +002100**************************************************************** NC2094.2 +002200* PROGRAM NC209A TESTS FORMAT 2 OF THE "MOVE" STATEMENT, * NC2094.2 +002300* USING QUALIFIED AND SUBSCRIPTED IDENTIFIERS. * NC2094.2 +002400* * NC2094.2 +002500**************************************************************** NC2094.2 +002600 ENVIRONMENT DIVISION. NC2094.2 +002700 CONFIGURATION SECTION. NC2094.2 +002800 SOURCE-COMPUTER. NC2094.2 +002900 Linux. NC2094.2 +003000 OBJECT-COMPUTER. NC2094.2 +003100 Linux. NC2094.2 +003200 INPUT-OUTPUT SECTION. NC2094.2 +003300 FILE-CONTROL. NC2094.2 +003400 SELECT PRINT-FILE ASSIGN TO NC2094.2 +003500 "report.log". NC2094.2 +003600 DATA DIVISION. NC2094.2 +003700 FILE SECTION. NC2094.2 +003800 FD PRINT-FILE. NC2094.2 +003900 01 PRINT-REC PICTURE X(120). NC2094.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC2094.2 +004100 WORKING-STORAGE SECTION. NC2094.2 +004200 01 A-LEVEL. NC2094.2 +004300 02 B-LEVEL. NC2094.2 +004400 03 C-LEVEL. NC2094.2 +004500 04 D-LEVEL. NC2094.2 +004600 05 TOM PICTURE XXX VALUE "TOM". NC2094.2 +004700 05 DICK PICTURE XXXX VALUE "DICK". NC2094.2 +004800 04 DD-LEVEL. NC2094.2 +004900 05 HARRY PICTURE X(5) VALUE "HARRY". NC2094.2 +005000 04 DDD-LEVEL. NC2094.2 +005100 05 JOE PICTURE XXX VALUE "JOE". NC2094.2 +005200 02 AL PICTURE XX VALUE "AL". NC2094.2 +005300 02 BB-LEVEL. NC2094.2 +005400 04 BOB PICTURE XXX VALUE "BOB". NC2094.2 +005500 01 A-GROUP. NC2094.2 +005600 02 B-GROUP. NC2094.2 +005700 10 C-LEVEL. NC2094.2 +005800 12 D-LEVEL. NC2094.2 +005900 13 TOM PICTURE XXX VALUE "ZZZ". NC2094.2 +006000 13 DICK PICTURE XXXX VALUE "ZZZZ". NC2094.2 +006100 12 DD-LEVEL-FALSE. NC2094.2 +006200 13 HARRY PICTURE X(5) VALUE "ZZZZZ". NC2094.2 +006300 12 DDD-LEVEL. NC2094.2 +006400 13 JOE PICTURE XXX VALUE "ZZZ". NC2094.2 +006500 01 A-BUNCH. NC2094.2 +006600 49 TOM PICTURE XXX VALUE "YYY". NC2094.2 +006700 49 DICK PICTURE XXXX VALUE "YYYY". NC2094.2 +006800 49 HARRY PICTURE X(5) VALUE "YYYYY". NC2094.2 +006900 49 JOE PICTURE XXX VALUE "YYY". NC2094.2 +007000 49 AL PICTURE XX VALUE "YY". NC2094.2 +007100 49 BOB PICTURE XXX VALUE "YYY". NC2094.2 +007200 01 A-SET. NC2094.2 +007300 02 B-SET. NC2094.2 +007400 04 D-LEVEL. NC2094.2 +007500 05 TOM PICTURE XXX VALUE "WWW". NC2094.2 +007600 05 DICK PICTURE XXXX VALUE "WWWW". NC2094.2 +007700 04 HARRY PICTURE X(5) VALUE "WWWWW". NC2094.2 +007800 04 BOB PICTURE XXX VALUE "WWW". NC2094.2 +007900 01 C-STACK. NC2094.2 +008000 04 D-LEVEL. NC2094.2 +008100 05 TOM PICTURE XXX VALUE "VVV". NC2094.2 +008200 04 DD-LEVEL. NC2094.2 +008300 05 DICK PICTURE XXXX VALUE "VVVV". NC2094.2 +008400 05 HARRY PICTURE X(5) VALUE "VVVVV". NC2094.2 +008500 01 A-GLOB. NC2094.2 +008600 02 B-LEVEL. NC2094.2 +008700 03 C-LEVEL. NC2094.2 +008800 04 D-LEVEL. NC2094.2 +008900 05 TOM PICTURE XXX VALUE "UUU". NC2094.2 +009000 05 DICK PICTURE XXXX VALUE "UUUU". NC2094.2 +009100 04 DD-LEVEL. NC2094.2 +009200 05 HARRY-A PICTURE XX VALUE "UU". NC2094.2 +009300 05 HARRY-B PICTURE XXX VALUE "UUU". NC2094.2 +009400 04 DDD-LEVEL. NC2094.2 +009500 05 JOE PICTURE XXX VALUE "UUU". NC2094.2 +009600 02 AL PICTURE XX VALUE "UU". NC2094.2 +009700 02 BB-LEVEL-FALSE. NC2094.2 +009800 04 BOB PICTURE XXX VALUE "UUU". NC2094.2 +009900 66 AL-BOB RENAMES AL OF A-GLOB THRU BOB OF A-GLOB. NC2094.2 +010000 66 HARRY RENAMES HARRY-A THRU HARRY-B. NC2094.2 +010100 01 A-COLLECTION. NC2094.2 +010200 02 B-COLLECTION. NC2094.2 +010300 03 C-COLLECTION. NC2094.2 +010400 04 D-LEVEL. NC2094.2 +010500 05 TOM OCCURS 3 TIMES PICTURE X. NC2094.2 +010600 05 DICK. NC2094.2 +010700 06 RICHARD OCCURS 2 PICTURE XX. NC2094.2 +010800 04 DD-LEVEL-FALSE PICTURE 9(5). NC2094.2 +010900 04 DD-LEVEL REDEFINES DD-LEVEL-FALSE. NC2094.2 +011000 05 HARRY PICTURE X(5). NC2094.2 +011100 04 DDD-LEVEL. NC2094.2 +011200 05 JOE PICTURE XXX. NC2094.2 +011300 05 JOSEPH REDEFINES JOE PICTURE 999. NC2094.2 +011400 01 WORK-AREA. NC2094.2 +011500 02 WORK-TOM PICTURE XXX. NC2094.2 +011600 02 FILLER PICTURE XXXX. NC2094.2 +011700 01 A-COVEY. NC2094.2 +011800 02 FILLER PICTURE X(45). NC2094.2 +011900 02 B-COVEY. NC2094.2 +012000 03 TOMMY PICTURE XXX VALUE "SSS". NC2094.2 +012100 03 DICKY PICTURE XXXX VALUE "SSSS". NC2094.2 +012200 03 JOEY PICTURE XXX VALUE "SSS". NC2094.2 +012300 03 HAROLD PICTURE X(5) VALUE "SSSSS". NC2094.2 +012400 01 A-FLOCK REDEFINES A-COVEY. NC2094.2 +012500 02 B-FLOCK OCCURS 4 TIMES. NC2094.2 +012600 03 C-FLOCK. NC2094.2 +012700 04 D-LEVEL. NC2094.2 +012800 05 TOM PICTURE XXX. NC2094.2 +012900 05 DICK PICTURE XXXX. NC2094.2 +013000 04 DDD-LEVEL. NC2094.2 +013100 05 JOE PICTURE XXX. NC2094.2 +013200 04 DD-LEVEL. NC2094.2 +013300 05 HARRY PICTURE X(5). NC2094.2 +013400 01 A-CROWD. NC2094.2 +013500 02 BB-CROWD. NC2094.2 +013600 03 BOBBY PICTURE XXX VALUE "RRR". NC2094.2 +013700 03 FILLER PICTURE X(15). NC2094.2 +013800 02 BB-MOB REDEFINES BB-CROWD OCCURS 6 TIMES. NC2094.2 +013900 03 BOB PICTURE XXX. NC2094.2 +014000 01 TEST-RESULTS. NC2094.2 +014100 02 FILLER PIC X VALUE SPACE. NC2094.2 +014200 02 FEATURE PIC X(20) VALUE SPACE. NC2094.2 +014300 02 FILLER PIC X VALUE SPACE. NC2094.2 +014400 02 P-OR-F PIC X(5) VALUE SPACE. NC2094.2 +014500 02 FILLER PIC X VALUE SPACE. NC2094.2 +014600 02 PAR-NAME. NC2094.2 +014700 03 FILLER PIC X(19) VALUE SPACE. NC2094.2 +014800 03 PARDOT-X PIC X VALUE SPACE. NC2094.2 +014900 03 DOTVALUE PIC 99 VALUE ZERO. NC2094.2 +015000 02 FILLER PIC X(8) VALUE SPACE. NC2094.2 +015100 02 RE-MARK PIC X(61). NC2094.2 +015200 01 TEST-COMPUTED. NC2094.2 +015300 02 FILLER PIC X(30) VALUE SPACE. NC2094.2 +015400 02 FILLER PIC X(17) VALUE NC2094.2 +015500 " COMPUTED=". NC2094.2 +015600 02 COMPUTED-X. NC2094.2 +015700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2094.2 +015800 03 COMPUTED-N REDEFINES COMPUTED-A NC2094.2 +015900 PIC -9(9).9(9). NC2094.2 +016000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2094.2 +016100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2094.2 +016200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2094.2 +016300 03 CM-18V0 REDEFINES COMPUTED-A. NC2094.2 +016400 04 COMPUTED-18V0 PIC -9(18). NC2094.2 +016500 04 FILLER PIC X. NC2094.2 +016600 03 FILLER PIC X(50) VALUE SPACE. NC2094.2 +016700 01 TEST-CORRECT. NC2094.2 +016800 02 FILLER PIC X(30) VALUE SPACE. NC2094.2 +016900 02 FILLER PIC X(17) VALUE " CORRECT =". NC2094.2 +017000 02 CORRECT-X. NC2094.2 +017100 03 CORRECT-A PIC X(20) VALUE SPACE. NC2094.2 +017200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2094.2 +017300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2094.2 +017400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2094.2 +017500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2094.2 +017600 03 CR-18V0 REDEFINES CORRECT-A. NC2094.2 +017700 04 CORRECT-18V0 PIC -9(18). NC2094.2 +017800 04 FILLER PIC X. NC2094.2 +017900 03 FILLER PIC X(2) VALUE SPACE. NC2094.2 +018000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2094.2 +018100 01 CCVS-C-1. NC2094.2 +018200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2094.2 +018300- "SS PARAGRAPH-NAME NC2094.2 +018400- " REMARKS". NC2094.2 +018500 02 FILLER PIC X(20) VALUE SPACE. NC2094.2 +018600 01 CCVS-C-2. NC2094.2 +018700 02 FILLER PIC X VALUE SPACE. NC2094.2 +018800 02 FILLER PIC X(6) VALUE "TESTED". NC2094.2 +018900 02 FILLER PIC X(15) VALUE SPACE. NC2094.2 +019000 02 FILLER PIC X(4) VALUE "FAIL". NC2094.2 +019100 02 FILLER PIC X(94) VALUE SPACE. NC2094.2 +019200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2094.2 +019300 01 REC-CT PIC 99 VALUE ZERO. NC2094.2 +019400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2094.2 +019500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2094.2 +019600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2094.2 +019700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2094.2 +019800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2094.2 +019900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2094.2 +020000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2094.2 +020100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2094.2 +020200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2094.2 +020300 01 CCVS-H-1. NC2094.2 +020400 02 FILLER PIC X(39) VALUE SPACES. NC2094.2 +020500 02 FILLER PIC X(42) VALUE NC2094.2 +020600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2094.2 +020700 02 FILLER PIC X(39) VALUE SPACES. NC2094.2 +020800 01 CCVS-H-2A. NC2094.2 +020900 02 FILLER PIC X(40) VALUE SPACE. NC2094.2 +021000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2094.2 +021100 02 FILLER PIC XXXX VALUE NC2094.2 +021200 "4.2 ". NC2094.2 +021300 02 FILLER PIC X(28) VALUE NC2094.2 +021400 " COPY - NOT FOR DISTRIBUTION". NC2094.2 +021500 02 FILLER PIC X(41) VALUE SPACE. NC2094.2 +021600 NC2094.2 +021700 01 CCVS-H-2B. NC2094.2 +021800 02 FILLER PIC X(15) VALUE NC2094.2 +021900 "TEST RESULT OF ". NC2094.2 +022000 02 TEST-ID PIC X(9). NC2094.2 +022100 02 FILLER PIC X(4) VALUE NC2094.2 +022200 " IN ". NC2094.2 +022300 02 FILLER PIC X(12) VALUE NC2094.2 +022400 " HIGH ". NC2094.2 +022500 02 FILLER PIC X(22) VALUE NC2094.2 +022600 " LEVEL VALIDATION FOR ". NC2094.2 +022700 02 FILLER PIC X(58) VALUE NC2094.2 +022800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2094.2 +022900 01 CCVS-H-3. NC2094.2 +023000 02 FILLER PIC X(34) VALUE NC2094.2 +023100 " FOR OFFICIAL USE ONLY ". NC2094.2 +023200 02 FILLER PIC X(58) VALUE NC2094.2 +023300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2094.2 +023400 02 FILLER PIC X(28) VALUE NC2094.2 +023500 " COPYRIGHT 1985 ". NC2094.2 +023600 01 CCVS-E-1. NC2094.2 +023700 02 FILLER PIC X(52) VALUE SPACE. NC2094.2 +023800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2094.2 +023900 02 ID-AGAIN PIC X(9). NC2094.2 +024000 02 FILLER PIC X(45) VALUE SPACES. NC2094.2 +024100 01 CCVS-E-2. NC2094.2 +024200 02 FILLER PIC X(31) VALUE SPACE. NC2094.2 +024300 02 FILLER PIC X(21) VALUE SPACE. NC2094.2 +024400 02 CCVS-E-2-2. NC2094.2 +024500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2094.2 +024600 03 FILLER PIC X VALUE SPACE. NC2094.2 +024700 03 ENDER-DESC PIC X(44) VALUE NC2094.2 +024800 "ERRORS ENCOUNTERED". NC2094.2 +024900 01 CCVS-E-3. NC2094.2 +025000 02 FILLER PIC X(22) VALUE NC2094.2 +025100 " FOR OFFICIAL USE ONLY". NC2094.2 +025200 02 FILLER PIC X(12) VALUE SPACE. NC2094.2 +025300 02 FILLER PIC X(58) VALUE NC2094.2 +025400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2094.2 +025500 02 FILLER PIC X(13) VALUE SPACE. NC2094.2 +025600 02 FILLER PIC X(15) VALUE NC2094.2 +025700 " COPYRIGHT 1985". NC2094.2 +025800 01 CCVS-E-4. NC2094.2 +025900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2094.2 +026000 02 FILLER PIC X(4) VALUE " OF ". NC2094.2 +026100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2094.2 +026200 02 FILLER PIC X(40) VALUE NC2094.2 +026300 " TESTS WERE EXECUTED SUCCESSFULLY". NC2094.2 +026400 01 XXINFO. NC2094.2 +026500 02 FILLER PIC X(19) VALUE NC2094.2 +026600 "*** INFORMATION ***". NC2094.2 +026700 02 INFO-TEXT. NC2094.2 +026800 04 FILLER PIC X(8) VALUE SPACE. NC2094.2 +026900 04 XXCOMPUTED PIC X(20). NC2094.2 +027000 04 FILLER PIC X(5) VALUE SPACE. NC2094.2 +027100 04 XXCORRECT PIC X(20). NC2094.2 +027200 02 INF-ANSI-REFERENCE PIC X(48). NC2094.2 +027300 01 HYPHEN-LINE. NC2094.2 +027400 02 FILLER PIC IS X VALUE IS SPACE. NC2094.2 +027500 02 FILLER PIC IS X(65) VALUE IS "************************NC2094.2 +027600- "*****************************************". NC2094.2 +027700 02 FILLER PIC IS X(54) VALUE IS "************************NC2094.2 +027800- "******************************". NC2094.2 +027900 01 CCVS-PGM-ID PIC X(9) VALUE NC2094.2 +028000 "NC209A". NC2094.2 +028100 PROCEDURE DIVISION. NC2094.2 +028200 CCVS1 SECTION. NC2094.2 +028300 OPEN-FILES. NC2094.2 +028400 OPEN OUTPUT PRINT-FILE. NC2094.2 +028500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2094.2 +028600 MOVE SPACE TO TEST-RESULTS. NC2094.2 +028700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2094.2 +028800 GO TO CCVS1-EXIT. NC2094.2 +028900 CLOSE-FILES. NC2094.2 +029000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2094.2 +029100 TERMINATE-CCVS. NC2094.2 +029200*S EXIT PROGRAM. NC2094.2 +029300*SERMINATE-CALL. NC2094.2 +029400 STOP RUN. NC2094.2 +029500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2094.2 +029600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2094.2 +029700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2094.2 +029800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2094.2 +029900 MOVE "****TEST DELETED****" TO RE-MARK. NC2094.2 +030000 PRINT-DETAIL. NC2094.2 +030100 IF REC-CT NOT EQUAL TO ZERO NC2094.2 +030200 MOVE "." TO PARDOT-X NC2094.2 +030300 MOVE REC-CT TO DOTVALUE. NC2094.2 +030400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2094.2 +030500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2094.2 +030600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2094.2 +030700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2094.2 +030800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2094.2 +030900 MOVE SPACE TO CORRECT-X. NC2094.2 +031000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2094.2 +031100 MOVE SPACE TO RE-MARK. NC2094.2 +031200 HEAD-ROUTINE. NC2094.2 +031300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +031400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +031500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2094.2 +031600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2094.2 +031700 COLUMN-NAMES-ROUTINE. NC2094.2 +031800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +031900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +032000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +032100 END-ROUTINE. NC2094.2 +032200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2094.2 +032300 END-RTN-EXIT. NC2094.2 +032400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +032500 END-ROUTINE-1. NC2094.2 +032600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2094.2 +032700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2094.2 +032800 ADD PASS-COUNTER TO ERROR-HOLD. NC2094.2 +032900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2094.2 +033000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2094.2 +033100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2094.2 +033200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2094.2 +033300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2094.2 +033400 END-ROUTINE-12. NC2094.2 +033500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2094.2 +033600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2094.2 +033700 MOVE "NO " TO ERROR-TOTAL NC2094.2 +033800 ELSE NC2094.2 +033900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2094.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2094.2 +034100 PERFORM WRITE-LINE. NC2094.2 +034200 END-ROUTINE-13. NC2094.2 +034300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2094.2 +034400 MOVE "NO " TO ERROR-TOTAL ELSE NC2094.2 +034500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2094.2 +034600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2094.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +034800 IF INSPECT-COUNTER EQUAL TO ZERO NC2094.2 +034900 MOVE "NO " TO ERROR-TOTAL NC2094.2 +035000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2094.2 +035100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2094.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +035300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2094.2 +035400 WRITE-LINE. NC2094.2 +035500 ADD 1 TO RECORD-COUNT. NC2094.2 +035600 IF RECORD-COUNT GREATER 50 NC2094.2 +035700 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2094.2 +035800 MOVE SPACE TO DUMMY-RECORD NC2094.2 +035900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2094.2 +036000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2094.2 +036100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2094.2 +036200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2094.2 +036300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2094.2 +036400 MOVE ZERO TO RECORD-COUNT. NC2094.2 +036500 PERFORM WRT-LN. NC2094.2 +036600 WRT-LN. NC2094.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2094.2 +036800 MOVE SPACE TO DUMMY-RECORD. NC2094.2 +036900 BLANK-LINE-PRINT. NC2094.2 +037000 PERFORM WRT-LN. NC2094.2 +037100 FAIL-ROUTINE. NC2094.2 +037200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2094.2 +037300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2094.2 +037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2094.2 +037500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2094.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2094.2 +037800 GO TO FAIL-ROUTINE-EX. NC2094.2 +037900 FAIL-ROUTINE-WRITE. NC2094.2 +038000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2094.2 +038100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2094.2 +038200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2094.2 +038300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2094.2 +038400 FAIL-ROUTINE-EX. EXIT. NC2094.2 +038500 BAIL-OUT. NC2094.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2094.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2094.2 +038800 BAIL-OUT-WRITE. NC2094.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2094.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2094.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2094.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2094.2 +039300 BAIL-OUT-EX. EXIT. NC2094.2 +039400 CCVS1-EXIT. NC2094.2 +039500 EXIT. NC2094.2 +039600 SECT-NC209A-001 SECTION. NC2094.2 +039700 NC-209A-001. NC2094.2 +039800 MOV-INIT-F2-1. NC2094.2 +039900 MOVE "MOV-TEST-F2-1" TO PAR-NAME. NC2094.2 +040000 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +040100 MOVE "MOVE CORRESPONDING -" TO FEATURE. NC2094.2 +040200 PERFORM PRINT-DETAIL. NC2094.2 +040300 MOVE " DIFFERENT LEVELS " TO FEATURE. NC2094.2 +040400 MOVE CORRESPONDING B-LEVEL OF A-LEVEL TO B-GROUP. NC2094.2 +040500 MOVE 1 TO REC-CT. NC2094.2 +040600* TOM DICK AND JOE SHOULD BE MOVED. NC2094.2 +040700* NC2094.2 +040800 MOV-TEST-F2-1-1. NC2094.2 +040900 IF TOM OF A-GROUP EQUAL TO "TOM" NC2094.2 +041000 PERFORM PASS NC2094.2 +041100 GO TO MOV-WRITE-F2-1-1. NC2094.2 +041200 GO TO MOV-FAIL-F2-1-1. NC2094.2 +041300 MOV-DELETE-F2-1-1. NC2094.2 +041400 PERFORM DE-LETE. NC2094.2 +041500 GO TO MOV-WRITE-F2-1-1. NC2094.2 +041600 MOV-FAIL-F2-1-1. NC2094.2 +041700 PERFORM FAIL. NC2094.2 +041800 MOVE TOM OF A-GROUP TO COMPUTED-A. NC2094.2 +041900 MOVE "TOM" TO CORRECT-A. NC2094.2 +042000 MOV-WRITE-F2-1-1. NC2094.2 +042100 PERFORM PRINT-DETAIL. NC2094.2 +042200* NC2094.2 +042300 MOV-TEST-F2-1-2. NC2094.2 +042400 ADD 1 TO REC-CT. NC2094.2 +042500 IF DICK OF A-GROUP EQUAL TO "DICK" NC2094.2 +042600 PERFORM PASS NC2094.2 +042700 GO TO MOV-WRITE-F2-1-2. NC2094.2 +042800 GO TO MOV-FAIL-F2-1-2. NC2094.2 +042900 MOV-DELETE-F2-1-2. NC2094.2 +043000 PERFORM DE-LETE. NC2094.2 +043100 GO TO MOV-WRITE-F2-1-2. NC2094.2 +043200 MOV-FAIL-F2-1-2. NC2094.2 +043300 PERFORM FAIL. NC2094.2 +043400 MOVE DICK OF A-GROUP TO COMPUTED-A. NC2094.2 +043500 MOVE "DICK" TO CORRECT-A. NC2094.2 +043600 MOV-WRITE-F2-1-2. NC2094.2 +043700 PERFORM PRINT-DETAIL. NC2094.2 +043800* NC2094.2 +043900 MOV-TEST-F2-1-3. NC2094.2 +044000 ADD 1 TO REC-CT. NC2094.2 +044100 IF HARRY OF A-GROUP EQUAL TO "ZZZZZ" NC2094.2 +044200 PERFORM PASS NC2094.2 +044300 GO TO MOV-WRITE-F2-1-3. NC2094.2 +044400 GO TO MOV-FAIL-F2-1-3. NC2094.2 +044500 MOV-DELETE-F2-1-3. NC2094.2 +044600 PERFORM DE-LETE. NC2094.2 +044700 GO TO MOV-WRITE-F2-1-3. NC2094.2 +044800 MOV-FAIL-F2-1-3. NC2094.2 +044900 PERFORM FAIL. NC2094.2 +045000 MOVE HARRY OF A-GROUP TO COMPUTED-A. NC2094.2 +045100 MOVE "ZZZZZ" TO CORRECT-A. NC2094.2 +045200 MOV-WRITE-F2-1-3. NC2094.2 +045300 PERFORM PRINT-DETAIL. NC2094.2 +045400* NC2094.2 +045500 MOV-TEST-F2-1-4. NC2094.2 +045600 ADD 1 TO REC-CT. NC2094.2 +045700 IF JOE OF A-GROUP EQUAL TO "JOE" NC2094.2 +045800 PERFORM PASS NC2094.2 +045900 GO TO MOV-WRITE-F2-1-4. NC2094.2 +046000 GO TO MOV-FAIL-F2-1-4. NC2094.2 +046100 MOV-DELETE-F2-1-4. NC2094.2 +046200 PERFORM DE-LETE. NC2094.2 +046300 GO TO MOV-WRITE-F2-1-4. NC2094.2 +046400 MOV-FAIL-F2-1-4. NC2094.2 +046500 PERFORM FAIL. NC2094.2 +046600 MOVE JOE OF A-GROUP TO COMPUTED-A. NC2094.2 +046700 MOVE "JOE" TO CORRECT-A. NC2094.2 +046800 MOV-WRITE-F2-1-4. NC2094.2 +046900 PERFORM PRINT-DETAIL. NC2094.2 +047000* NC2094.2 +047100 MOV-INIT-F2-2. NC2094.2 +047200 MOVE "MOV-TEST-F2-2" TO PAR-NAME. NC2094.2 +047300 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +047400 MOVE CORRESPONDING A-LEVEL TO A-BUNCH. NC2094.2 +047500 MOVE 1 TO REC-CT. NC2094.2 +047600* NOTE AL SHOULD BE MOVED. NC2094.2 +047700 MOV-TEST-F2-2-1. NC2094.2 +047800 IF TOM OF A-BUNCH EQUAL TO "YYY" NC2094.2 +047900 PERFORM PASS NC2094.2 +048000 GO TO MOV-WRITE-F2-2-1. NC2094.2 +048100 GO TO MOV-FAIL-F2-2-1. NC2094.2 +048200 MOV-DELETE-F2-2-1. NC2094.2 +048300 PERFORM DE-LETE. NC2094.2 +048400 GO TO MOV-WRITE-F2-2-1. NC2094.2 +048500 MOV-FAIL-F2-2-1. NC2094.2 +048600 PERFORM FAIL. NC2094.2 +048700 MOVE TOM OF A-BUNCH TO COMPUTED-A. NC2094.2 +048800 MOVE "YYY" TO CORRECT-A. NC2094.2 +048900 MOV-WRITE-F2-2-1. NC2094.2 +049000 PERFORM PRINT-DETAIL. NC2094.2 +049100* NC2094.2 +049200 MOV-TEST-F2-2-2. NC2094.2 +049300 ADD 1 TO REC-CT. NC2094.2 +049400 IF DICK OF A-BUNCH EQUAL TO "YYYY" NC2094.2 +049500 PERFORM PASS NC2094.2 +049600 GO TO MOV-WRITE-F2-2-2. NC2094.2 +049700 GO TO MOV-FAIL-F2-2-2. NC2094.2 +049800 MOV-DELETE-F2-2-2. NC2094.2 +049900 PERFORM DE-LETE. NC2094.2 +050000 GO TO MOV-WRITE-F2-2-2. NC2094.2 +050100 MOV-FAIL-F2-2-2. NC2094.2 +050200 PERFORM FAIL. NC2094.2 +050300 MOVE DICK OF A-BUNCH TO COMPUTED-A. NC2094.2 +050400 MOVE "YYYY" TO CORRECT-A. NC2094.2 +050500 MOV-WRITE-F2-2-2. NC2094.2 +050600 PERFORM PRINT-DETAIL. NC2094.2 +050700* NC2094.2 +050800 MOV-TEST-F2-2-3. NC2094.2 +050900 ADD 1 TO REC-CT. NC2094.2 +051000 IF HARRY OF A-BUNCH EQUAL TO "YYYYY" NC2094.2 +051100 PERFORM PASS NC2094.2 +051200 GO TO MOV-WRITE-F2-2-3. NC2094.2 +051300 GO TO MOV-FAIL-F2-2-3. NC2094.2 +051400 MOV-DELETE-F2-2-3. NC2094.2 +051500 PERFORM DE-LETE. NC2094.2 +051600 GO TO MOV-WRITE-F2-2-3. NC2094.2 +051700 MOV-FAIL-F2-2-3. NC2094.2 +051800 PERFORM FAIL. NC2094.2 +051900 MOVE HARRY OF A-BUNCH TO COMPUTED-A. NC2094.2 +052000 MOVE "YYYYY" TO CORRECT-A. NC2094.2 +052100 MOV-WRITE-F2-2-3. NC2094.2 +052200 PERFORM PRINT-DETAIL. NC2094.2 +052300* NC2094.2 +052400 MOV-TEST-F2-2-4. NC2094.2 +052500 ADD 1 TO REC-CT. NC2094.2 +052600 IF JOE OF A-BUNCH EQUAL TO "YYY" NC2094.2 +052700 PERFORM PASS NC2094.2 +052800 GO TO MOV-WRITE-F2-2-4. NC2094.2 +052900 GO TO MOV-FAIL-F2-2-4. NC2094.2 +053000 MOV-DELETE-F2-2-4. NC2094.2 +053100 PERFORM DE-LETE. NC2094.2 +053200 GO TO MOV-WRITE-F2-2-4. NC2094.2 +053300 MOV-FAIL-F2-2-4. NC2094.2 +053400 PERFORM FAIL. NC2094.2 +053500 MOVE JOE OF A-BUNCH TO COMPUTED-A. NC2094.2 +053600 MOVE "YYY" TO CORRECT-A. NC2094.2 +053700 MOV-WRITE-F2-2-4. NC2094.2 +053800 PERFORM PRINT-DETAIL. NC2094.2 +053900* NC2094.2 +054000 MOV-TEST-F2-2-5. NC2094.2 +054100 ADD 1 TO REC-CT. NC2094.2 +054200 IF AL OF A-BUNCH EQUAL TO "AL" NC2094.2 +054300 PERFORM PASS NC2094.2 +054400 GO TO MOV-WRITE-F2-2-5. NC2094.2 +054500 GO TO MOV-FAIL-F2-2-5. NC2094.2 +054600 MOV-DELETE-F2-2-5. NC2094.2 +054700 PERFORM DE-LETE. NC2094.2 +054800 GO TO MOV-WRITE-F2-2-5. NC2094.2 +054900 MOV-FAIL-F2-2-5. NC2094.2 +055000 PERFORM FAIL. NC2094.2 +055100 MOVE AL OF A-BUNCH TO COMPUTED-A. NC2094.2 +055200 MOVE "AL" TO CORRECT-A. NC2094.2 +055300 MOV-WRITE-F2-2-5. NC2094.2 +055400 PERFORM PRINT-DETAIL. NC2094.2 +055500* NC2094.2 +055600 MOV-TEST-F2-2-6. NC2094.2 +055700 ADD 1 TO REC-CT. NC2094.2 +055800 IF BOB OF A-BUNCH EQUAL TO "YYY" NC2094.2 +055900 PERFORM PASS NC2094.2 +056000 GO TO MOV-WRITE-F2-2-6. NC2094.2 +056100 GO TO MOV-FAIL-F2-2-6. NC2094.2 +056200 MOV-DELETE-F2-2-6. NC2094.2 +056300 PERFORM DE-LETE. NC2094.2 +056400 GO TO MOV-WRITE-F2-2-6. NC2094.2 +056500 MOV-FAIL-F2-2-6. NC2094.2 +056600 PERFORM FAIL. NC2094.2 +056700 MOVE BOB OF A-BUNCH TO COMPUTED-A. NC2094.2 +056800 MOVE "YYY" TO CORRECT-A. NC2094.2 +056900 MOV-WRITE-F2-2-6. NC2094.2 +057000 PERFORM PRINT-DETAIL. NC2094.2 +057100* NC2094.2 +057200 MOV-INIT-F2-3. NC2094.2 +057300 MOVE "MOV-TEST-F2-3" TO PAR-NAME. NC2094.2 +057400 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +057500 MOVE CORR B-LEVEL OF A-LEVEL TO B-SET. NC2094.2 +057600 MOVE 1 TO REC-CT. NC2094.2 +057700* NOTE CORR IS A LEGAL ABBREVIATION. NC2094.2 +057800* NOTE NO MOVES SHOULD TAKE PLACE. NC2094.2 +057900* NC2094.2 +058000 MOV-TEST-F2-3-1. NC2094.2 +058100 ADD 1 TO REC-CT. NC2094.2 +058200 IF TOM OF A-SET EQUAL TO "WWW" NC2094.2 +058300 PERFORM PASS NC2094.2 +058400 GO TO MOV-WRITE-F2-3-1. NC2094.2 +058500 GO TO MOV-FAIL-F2-3-1. NC2094.2 +058600 MOV-DELETE-F2-3-1. NC2094.2 +058700 PERFORM DE-LETE. NC2094.2 +058800 GO TO MOV-WRITE-F2-3-1. NC2094.2 +058900 MOV-FAIL-F2-3-1. NC2094.2 +059000 PERFORM FAIL. NC2094.2 +059100 MOVE TOM OF A-SET TO COMPUTED-A. NC2094.2 +059200 MOVE "WWW" TO CORRECT-A. NC2094.2 +059300 MOV-WRITE-F2-3-1. NC2094.2 +059400 PERFORM PRINT-DETAIL. NC2094.2 +059500* NC2094.2 +059600 MOV-TEST-F2-3-2. NC2094.2 +059700 ADD 1 TO REC-CT. NC2094.2 +059800 IF DICK OF A-SET EQUAL TO "WWWW" NC2094.2 +059900 PERFORM PASS NC2094.2 +060000 GO TO MOV-WRITE-F2-3-2. NC2094.2 +060100 GO TO MOV-FAIL-F2-3-2. NC2094.2 +060200 MOV-DELETE-F2-3-2. NC2094.2 +060300 PERFORM DE-LETE. NC2094.2 +060400 GO TO MOV-WRITE-F2-3-2. NC2094.2 +060500 MOV-FAIL-F2-3-2. NC2094.2 +060600 PERFORM FAIL. NC2094.2 +060700 MOVE DICK OF A-SET TO COMPUTED-A. NC2094.2 +060800 MOVE "WWWW" TO CORRECT-A. NC2094.2 +060900 MOV-WRITE-F2-3-2. NC2094.2 +061000 PERFORM PRINT-DETAIL. NC2094.2 +061100* NC2094.2 +061200 MOV-TEST-F2-3-3. NC2094.2 +061300 ADD 1 TO REC-CT. NC2094.2 +061400 IF HARRY OF A-SET EQUAL TO "WWWWW" NC2094.2 +061500 PERFORM PASS NC2094.2 +061600 GO TO MOV-WRITE-F2-3-3. NC2094.2 +061700 GO TO MOV-FAIL-F2-3-3. NC2094.2 +061800 MOV-DELETE-F2-3-3. NC2094.2 +061900 PERFORM DE-LETE. NC2094.2 +062000 GO TO MOV-WRITE-F2-3-3. NC2094.2 +062100 MOV-FAIL-F2-3-3. NC2094.2 +062200 PERFORM FAIL. NC2094.2 +062300 MOVE HARRY OF A-SET TO COMPUTED-A. NC2094.2 +062400 MOVE "WWWWW" TO CORRECT-A. NC2094.2 +062500 MOV-WRITE-F2-3-3. NC2094.2 +062600 PERFORM PRINT-DETAIL. NC2094.2 +062700* NC2094.2 +062800 MOV-TEST-F2-3-4. NC2094.2 +062900 ADD 1 TO REC-CT. NC2094.2 +063000 IF BOB OF A-SET EQUAL TO "WWW" NC2094.2 +063100 PERFORM PASS NC2094.2 +063200 GO TO MOV-WRITE-F2-3-4. NC2094.2 +063300 GO TO MOV-FAIL-F2-3-4. NC2094.2 +063400 MOV-DELETE-F2-3-4. NC2094.2 +063500 PERFORM DE-LETE. NC2094.2 +063600 GO TO MOV-WRITE-F2-3-4. NC2094.2 +063700 MOV-FAIL-F2-3-4. NC2094.2 +063800 PERFORM FAIL. NC2094.2 +063900 MOVE BOB OF A-SET TO COMPUTED-A. NC2094.2 +064000 MOVE "WWW" TO CORRECT-A. NC2094.2 +064100 MOV-WRITE-F2-3-4. NC2094.2 +064200 PERFORM PRINT-DETAIL. NC2094.2 +064300* NC2094.2 +064400 MOV-INIT-F2-4. NC2094.2 +064500 MOVE "MOV-TEST-F2-4" TO PAR-NAME. NC2094.2 +064600 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +064700 MOVE CORRESPONDING C-LEVEL OF A-LEVEL TO C-STACK. NC2094.2 +064800 MOVE 1 TO REC-CT. NC2094.2 +064900* NOTE TOM AND HARRY SHOULD BE MOVED. NC2094.2 +065000 MOV-TEST-F2-4-1. NC2094.2 +065100 IF TOM OF C-STACK EQUAL TO "TOM" NC2094.2 +065200 PERFORM PASS NC2094.2 +065300 GO TO MOV-WRITE-F2-4-1. NC2094.2 +065400 GO TO MOV-FAIL-F2-4-1. NC2094.2 +065500 MOV-DELETE-F2-4-1. NC2094.2 +065600 PERFORM DE-LETE. NC2094.2 +065700 GO TO MOV-WRITE-F2-4-1. NC2094.2 +065800 MOV-FAIL-F2-4-1. NC2094.2 +065900 PERFORM FAIL. NC2094.2 +066000 MOVE TOM OF C-STACK TO COMPUTED-A. NC2094.2 +066100 MOVE "TOM" TO CORRECT-A. NC2094.2 +066200 MOV-WRITE-F2-4-1. NC2094.2 +066300 PERFORM PRINT-DETAIL. NC2094.2 +066400* NC2094.2 +066500 MOV-TEST-F2-4-2. NC2094.2 +066600 ADD 1 TO REC-CT. NC2094.2 +066700 IF DICK OF C-STACK EQUAL TO "VVVV" NC2094.2 +066800 PERFORM PASS NC2094.2 +066900 GO TO MOV-WRITE-F2-4-2. NC2094.2 +067000 GO TO MOV-FAIL-F2-4-2. NC2094.2 +067100 MOV-DELETE-F2-4-2. NC2094.2 +067200 PERFORM DE-LETE. NC2094.2 +067300 GO TO MOV-WRITE-F2-4-2. NC2094.2 +067400 MOV-FAIL-F2-4-2. NC2094.2 +067500 PERFORM FAIL. NC2094.2 +067600 MOVE DICK OF C-STACK TO COMPUTED-A. NC2094.2 +067700 MOVE "VVVV" TO CORRECT-A. NC2094.2 +067800 MOV-WRITE-F2-4-2. NC2094.2 +067900 PERFORM PRINT-DETAIL. NC2094.2 +068000* NC2094.2 +068100 MOV-TEST-F2-4-3. NC2094.2 +068200 ADD 1 TO REC-CT. NC2094.2 +068300 IF HARRY OF C-STACK EQUAL TO "HARRY" NC2094.2 +068400 PERFORM PASS NC2094.2 +068500 GO TO MOV-WRITE-F2-4-3. NC2094.2 +068600 GO TO MOV-FAIL-F2-4-3. NC2094.2 +068700 MOV-DELETE-F2-4-3. NC2094.2 +068800 PERFORM DE-LETE. NC2094.2 +068900 GO TO MOV-WRITE-F2-4-3. NC2094.2 +069000 MOV-FAIL-F2-4-3. NC2094.2 +069100 PERFORM FAIL. NC2094.2 +069200 MOVE HARRY OF C-STACK TO COMPUTED-A. NC2094.2 +069300 MOVE "HARRY" TO CORRECT-A. NC2094.2 +069400 MOV-WRITE-F2-4-3. NC2094.2 +069500 PERFORM PRINT-DETAIL. NC2094.2 +069600* NC2094.2 +069700 MOV-INIT-F2-5. NC2094.2 +069800 MOVE "MOV-TEST-F2-5" TO PAR-NAME. NC2094.2 +069900 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +070000 MOVE " WITH RENAMES " TO FEATURE. NC2094.2 +070100 MOVE CORRESPONDING A-LEVEL TO A-GLOB. NC2094.2 +070200 MOVE 1 TO REC-CT. NC2094.2 +070300* NOTE TOM, DICK, JOE, AND AL SHOULD BE MOVED. NC2094.2 +070400* NC2094.2 +070500 MOV-TEST-F2-5-1. NC2094.2 +070600 IF TOM OF A-GLOB EQUAL TO "TOM" NC2094.2 +070700 PERFORM PASS NC2094.2 +070800 GO TO MOV-WRITE-F2-5-1. NC2094.2 +070900 GO TO MOV-FAIL-F2-5-1. NC2094.2 +071000 MOV-DELETE-F2-5-1. NC2094.2 +071100 PERFORM DE-LETE. NC2094.2 +071200 GO TO MOV-WRITE-F2-5-1. NC2094.2 +071300 MOV-FAIL-F2-5-1. NC2094.2 +071400 PERFORM FAIL. NC2094.2 +071500 MOVE TOM OF A-GLOB TO COMPUTED-A. NC2094.2 +071600 MOVE "TOM" TO CORRECT-A. NC2094.2 +071700 MOV-WRITE-F2-5-1. NC2094.2 +071800 PERFORM PRINT-DETAIL. NC2094.2 +071900* NC2094.2 +072000 MOV-TEST-F2-5-2. NC2094.2 +072100 ADD 1 TO REC-CT. NC2094.2 +072200 IF DICK OF A-GLOB EQUAL TO "DICK" NC2094.2 +072300 PERFORM PASS NC2094.2 +072400 GO TO MOV-WRITE-F2-5-2. NC2094.2 +072500 GO TO MOV-FAIL-F2-5-2. NC2094.2 +072600 MOV-DELETE-F2-5-2. NC2094.2 +072700 PERFORM DE-LETE. NC2094.2 +072800 GO TO MOV-WRITE-F2-5-2. NC2094.2 +072900 MOV-FAIL-F2-5-2. NC2094.2 +073000 PERFORM FAIL. NC2094.2 +073100 MOVE DICK OF A-GLOB TO COMPUTED-A. NC2094.2 +073200 MOVE "DICK" TO CORRECT-A. NC2094.2 +073300 MOV-WRITE-F2-5-2. NC2094.2 +073400 PERFORM PRINT-DETAIL. NC2094.2 +073500* NC2094.2 +073600 MOV-TEST-F2-5-3. NC2094.2 +073700 ADD 1 TO REC-CT. NC2094.2 +073800 IF HARRY OF A-GLOB EQUAL TO "UUUUU" NC2094.2 +073900 PERFORM PASS NC2094.2 +074000 GO TO MOV-WRITE-F2-5-3. NC2094.2 +074100 GO TO MOV-FAIL-F2-5-3. NC2094.2 +074200 MOV-DELETE-F2-5-3. NC2094.2 +074300 PERFORM DE-LETE. NC2094.2 +074400 GO TO MOV-WRITE-F2-5-3. NC2094.2 +074500 MOV-FAIL-F2-5-3. NC2094.2 +074600 PERFORM FAIL. NC2094.2 +074700 MOVE HARRY OF A-GLOB TO COMPUTED-A. NC2094.2 +074800 MOVE "UUUUU" TO CORRECT-A. NC2094.2 +074900 MOV-WRITE-F2-5-3. NC2094.2 +075000 PERFORM PRINT-DETAIL. NC2094.2 +075100* NC2094.2 +075200 MOV-TEST-F2-5-4. NC2094.2 +075300 ADD 1 TO REC-CT. NC2094.2 +075400 IF JOE OF A-GLOB EQUAL TO "JOE" NC2094.2 +075500 PERFORM PASS NC2094.2 +075600 GO TO MOV-WRITE-F2-5-4. NC2094.2 +075700 GO TO MOV-FAIL-F2-5-4. NC2094.2 +075800 MOV-DELETE-F2-5-4. NC2094.2 +075900 PERFORM DE-LETE. NC2094.2 +076000 GO TO MOV-WRITE-F2-5-4. NC2094.2 +076100 MOV-FAIL-F2-5-4. NC2094.2 +076200 PERFORM FAIL. NC2094.2 +076300 MOVE JOE OF A-GLOB TO COMPUTED-A. NC2094.2 +076400 MOVE "JOE" TO CORRECT-A. NC2094.2 +076500 MOV-WRITE-F2-5-4. NC2094.2 +076600 PERFORM PRINT-DETAIL. NC2094.2 +076700* NC2094.2 +076800 MOV-TEST-F2-5-5. NC2094.2 +076900 ADD 1 TO REC-CT. NC2094.2 +077000 IF AL OF A-GLOB EQUAL TO "AL" NC2094.2 +077100 PERFORM PASS NC2094.2 +077200 GO TO MOV-WRITE-F2-5-5. NC2094.2 +077300 GO TO MOV-FAIL-F2-5-5. NC2094.2 +077400 MOV-DELETE-F2-5-5. NC2094.2 +077500 PERFORM DE-LETE. NC2094.2 +077600 GO TO MOV-WRITE-F2-5-5. NC2094.2 +077700 MOV-FAIL-F2-5-5. NC2094.2 +077800 PERFORM FAIL. NC2094.2 +077900 MOVE AL OF A-GLOB TO COMPUTED-A. NC2094.2 +078000 MOVE "AL" TO CORRECT-A. NC2094.2 +078100 MOV-WRITE-F2-5-5. NC2094.2 +078200 PERFORM PRINT-DETAIL. NC2094.2 +078300* NC2094.2 +078400 MOV-TEST-F2-5-6. NC2094.2 +078500 ADD 1 TO REC-CT. NC2094.2 +078600 IF BOB OF A-GLOB EQUAL TO "UUU" NC2094.2 +078700 PERFORM PASS NC2094.2 +078800 GO TO MOV-WRITE-F2-5-6. NC2094.2 +078900 GO TO MOV-FAIL-F2-5-6. NC2094.2 +079000 MOV-DELETE-F2-5-6. NC2094.2 +079100 PERFORM DE-LETE. NC2094.2 +079200 GO TO MOV-WRITE-F2-5-6. NC2094.2 +079300 MOV-FAIL-F2-5-6. NC2094.2 +079400 PERFORM FAIL. NC2094.2 +079500 MOVE BOB OF A-GLOB TO COMPUTED-A. NC2094.2 +079600 MOVE "UUU" TO CORRECT-A. NC2094.2 +079700 MOV-WRITE-F2-5-6. NC2094.2 +079800 PERFORM PRINT-DETAIL. NC2094.2 +079900* NC2094.2 +080000 MOV-INIT-F2-6. NC2094.2 +080100 MOVE "MOV-TEST-F2-6" TO PAR-NAME. NC2094.2 +080200 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +080300 MOVE " WITH REDEF, OCCURS" TO FEATURE. NC2094.2 +080400 MOVE D-LEVEL IN C-COLLECTION TO WORK-AREA. NC2094.2 +080500 MOVE "TTTTTTTTTTTTTTT" TO C-COLLECTION NC2094.2 +080600 MOVE 1 TO REC-CT. NC2094.2 +080700 MOVE CORRESPONDING C-LEVEL IN A-LEVEL TO C-COLLECTION. NC2094.2 +080800* NOTE DICK AND JOE SHOULD BE MOVED. NC2094.2 +080900* NC2094.2 +081000 MOV-TEST-F2-6-1. NC2094.2 +081100 MOVE D-LEVEL IN C-COLLECTION TO WORK-AREA. NC2094.2 +081200 IF WORK-TOM EQUAL TO "TTT" NC2094.2 +081300 PERFORM PASS NC2094.2 +081400 GO TO MOV-WRITE-F2-6-1. NC2094.2 +081500 GO TO MOV-FAIL-F2-6-1. NC2094.2 +081600 MOV-DELETE-F2-6-1. NC2094.2 +081700 PERFORM DE-LETE. NC2094.2 +081800 GO TO MOV-WRITE-F2-6-1. NC2094.2 +081900 MOV-FAIL-F2-6-1. NC2094.2 +082000 PERFORM FAIL. NC2094.2 +082100 MOVE D-LEVEL OF A-COLLECTION TO COMPUTED-A. NC2094.2 +082200 MOVE "TTT" TO CORRECT-A. NC2094.2 +082300 MOV-WRITE-F2-6-1. NC2094.2 +082400 PERFORM PRINT-DETAIL. NC2094.2 +082500* NC2094.2 +082600 MOV-TEST-F2-6-2. NC2094.2 +082700 ADD 1 TO REC-CT. NC2094.2 +082800 IF DICK OF A-COLLECTION EQUAL TO "DICK" NC2094.2 +082900 PERFORM PASS NC2094.2 +083000 GO TO MOV-WRITE-F2-6-2. NC2094.2 +083100 GO TO MOV-FAIL-F2-6-2. NC2094.2 +083200 MOV-DELETE-F2-6-2. NC2094.2 +083300 PERFORM DE-LETE. NC2094.2 +083400 GO TO MOV-WRITE-F2-6-2. NC2094.2 +083500 MOV-FAIL-F2-6-2. NC2094.2 +083600 PERFORM FAIL. NC2094.2 +083700 MOVE DICK OF A-COLLECTION TO COMPUTED-A. NC2094.2 +083800 MOVE "DICK" TO CORRECT-A. NC2094.2 +083900 MOV-WRITE-F2-6-2. NC2094.2 +084000 PERFORM PRINT-DETAIL. NC2094.2 +084100* NC2094.2 +084200 MOV-TEST-F2-6-3. NC2094.2 +084300 ADD 1 TO REC-CT. NC2094.2 +084400 IF HARRY OF A-COLLECTION EQUAL TO "TTTTT" NC2094.2 +084500 PERFORM PASS NC2094.2 +084600 GO TO MOV-WRITE-F2-6-3. NC2094.2 +084700 GO TO MOV-FAIL-F2-6-3. NC2094.2 +084800 MOV-DELETE-F2-6-3. NC2094.2 +084900 PERFORM DE-LETE. NC2094.2 +085000 GO TO MOV-WRITE-F2-6-3. NC2094.2 +085100 MOV-FAIL-F2-6-3. NC2094.2 +085200 PERFORM FAIL. NC2094.2 +085300 MOVE HARRY OF A-COLLECTION TO COMPUTED-A. NC2094.2 +085400 MOVE "TTTTT" TO CORRECT-A. NC2094.2 +085500 MOV-WRITE-F2-6-3. NC2094.2 +085600 PERFORM PRINT-DETAIL. NC2094.2 +085700* NC2094.2 +085800 MOV-TEST-F2-6-4. NC2094.2 +085900 ADD 1 TO REC-CT. NC2094.2 +086000 IF JOE OF A-COLLECTION EQUAL TO "JOE" NC2094.2 +086100 PERFORM PASS NC2094.2 +086200 GO TO MOV-WRITE-F2-6-4. NC2094.2 +086300 GO TO MOV-FAIL-F2-6-4. NC2094.2 +086400 MOV-DELETE-F2-6-4. NC2094.2 +086500 PERFORM DE-LETE. NC2094.2 +086600 GO TO MOV-WRITE-F2-6-4. NC2094.2 +086700 MOV-FAIL-F2-6-4. NC2094.2 +086800 PERFORM FAIL. NC2094.2 +086900 MOVE JOE OF A-COLLECTION TO COMPUTED-A. NC2094.2 +087000 MOVE "JOE" TO CORRECT-A. NC2094.2 +087100 MOV-WRITE-F2-6-4. NC2094.2 +087200 PERFORM PRINT-DETAIL. NC2094.2 +087300* NC2094.2 +087400 MOV-INIT-F2-7. NC2094.2 +087500 MOVE "MOV-TEST-F2-7" TO PAR-NAME. NC2094.2 +087600 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +087700 MOVE CORRESPONDING C-LEVEL IN A-LEVEL TO C-FLOCK (4). NC2094.2 +087800 MOVE 1 TO REC-CT. NC2094.2 +087900* NOTE TOM, DICK, HARRY, AND JOE SHOULD BE MOVED. NC2094.2 +088000 MOV-TEST-F2-7-1. NC2094.2 +088100 IF TOMMY OF A-COVEY EQUAL TO "TOM" NC2094.2 +088200 PERFORM PASS NC2094.2 +088300 GO TO MOV-WRITE-F2-7-1. NC2094.2 +088400 GO TO MOV-FAIL-F2-7-1. NC2094.2 +088500 MOV-DELETE-F2-7-1. NC2094.2 +088600 PERFORM DE-LETE. NC2094.2 +088700 GO TO MOV-WRITE-F2-7-1. NC2094.2 +088800 MOV-FAIL-F2-7-1. NC2094.2 +088900 PERFORM FAIL. NC2094.2 +089000 MOVE TOMMY OF A-COVEY TO COMPUTED-A. NC2094.2 +089100 MOVE "TOM" TO CORRECT-A. NC2094.2 +089200 MOV-WRITE-F2-7-1. NC2094.2 +089300 PERFORM PRINT-DETAIL. NC2094.2 +089400* NC2094.2 +089500 MOV-TEST-F2-7-2. NC2094.2 +089600 ADD 1 TO REC-CT. NC2094.2 +089700 IF DICKY OF A-COVEY EQUAL TO "DICK" NC2094.2 +089800 PERFORM PASS NC2094.2 +089900 GO TO MOV-WRITE-F2-7-2. NC2094.2 +090000 GO TO MOV-FAIL-F2-7-2. NC2094.2 +090100 MOV-DELETE-F2-7-2. NC2094.2 +090200 PERFORM DE-LETE. NC2094.2 +090300 GO TO MOV-WRITE-F2-7-2. NC2094.2 +090400 MOV-FAIL-F2-7-2. NC2094.2 +090500 PERFORM FAIL. NC2094.2 +090600 MOVE DICKY OF A-COVEY TO COMPUTED-A. NC2094.2 +090700 MOVE "DICK" TO CORRECT-A. NC2094.2 +090800 MOV-WRITE-F2-7-2. NC2094.2 +090900 PERFORM PRINT-DETAIL. NC2094.2 +091000* NC2094.2 +091100 MOV-TEST-F2-7-3. NC2094.2 +091200 ADD 1 TO REC-CT. NC2094.2 +091300 IF JOEY OF A-COVEY EQUAL TO "JOE" NC2094.2 +091400 PERFORM PASS NC2094.2 +091500 GO TO MOV-WRITE-F2-7-3. NC2094.2 +091600 GO TO MOV-FAIL-F2-7-3. NC2094.2 +091700 MOV-DELETE-F2-7-3. NC2094.2 +091800 PERFORM DE-LETE. NC2094.2 +091900 GO TO MOV-WRITE-F2-7-3. NC2094.2 +092000 MOV-FAIL-F2-7-3. NC2094.2 +092100 PERFORM FAIL. NC2094.2 +092200 MOVE JOEY OF A-COVEY TO COMPUTED-A. NC2094.2 +092300 MOVE "JOE" TO CORRECT-A. NC2094.2 +092400 MOV-WRITE-F2-7-3. NC2094.2 +092500 PERFORM PRINT-DETAIL. NC2094.2 +092600* NC2094.2 +092700 MOV-TEST-F2-7-4. NC2094.2 +092800 ADD 1 TO REC-CT. NC2094.2 +092900 IF HAROLD OF A-COVEY EQUAL TO "HARRY" NC2094.2 +093000 PERFORM PASS NC2094.2 +093100 GO TO MOV-WRITE-F2-7-4. NC2094.2 +093200 GO TO MOV-FAIL-F2-7-4. NC2094.2 +093300 MOV-DELETE-F2-7-4. NC2094.2 +093400 PERFORM DE-LETE. NC2094.2 +093500 GO TO MOV-WRITE-F2-7-4. NC2094.2 +093600 MOV-FAIL-F2-7-4. NC2094.2 +093700 PERFORM FAIL. NC2094.2 +093800 MOVE HAROLD OF A-COVEY TO COMPUTED-A. NC2094.2 +093900 MOVE "HARRY" TO CORRECT-A. NC2094.2 +094000 MOV-WRITE-F2-7-4. NC2094.2 +094100 PERFORM PRINT-DETAIL. NC2094.2 +094200* NC2094.2 +094300 MOV-INIT-F2-8. NC2094.2 +094400 MOVE "MOV-TEST-F2-8" TO PAR-NAME. NC2094.2 +094500 MOVE CORRESPONDING BB-LEVEL TO BB-MOB (1). NC2094.2 +094600 MOVE "VI-102 6.18.4 GR1" TO ANSI-REFERENCE. NC2094.2 +094700 MOVE 0 TO REC-CT. NC2094.2 +094800* NOTE BOB SHOULD BE MOVED. NC2094.2 +094900 MOV-TEST-F2-8. NC2094.2 +095000 IF BOBBY OF A-CROWD EQUAL TO "BOB" NC2094.2 +095100 PERFORM PASS NC2094.2 +095200 GO TO MOV-WRITE-F2-8. NC2094.2 +095300 GO TO MOV-FAIL-F2-8. NC2094.2 +095400 MOV-DELETE-F2-8. NC2094.2 +095500 PERFORM DE-LETE. NC2094.2 +095600 GO TO MOV-WRITE-F2-8. NC2094.2 +095700 MOV-FAIL-F2-8. NC2094.2 +095800 PERFORM FAIL. NC2094.2 +095900 MOVE BOBBY OF A-CROWD TO COMPUTED-A. NC2094.2 +096000 MOVE "BOB" TO CORRECT-A. NC2094.2 +096100 MOV-WRITE-F2-8. NC2094.2 +096200 PERFORM PRINT-DETAIL. NC2094.2 +096300* NC2094.2 +096400 CCVS-EXIT SECTION. NC2094.2 +096500 CCVS-999999. NC2094.2 +096600 GO TO CLOSE-FILES. NC2094.2 diff --git a/tests/cobol85/NC/NC210A.CBL b/tests/cobol85/NC/NC210A.CBL new file mode 100755 index 00000000..cce6c85f --- /dev/null +++ b/tests/cobol85/NC/NC210A.CBL @@ -0,0 +1,737 @@ +000100 IDENTIFICATION DIVISION. NC2104.2 +000200 PROGRAM-ID. NC2104.2 +000300 NC210A. NC2104.2 +000400**************************************************************** NC2104.2 +000500* * NC2104.2 +000600* VALIDATION FOR:- * NC2104.2 +000700* * NC2104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2104.2 +000900* * NC2104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2104.2 +001100* * NC2104.2 +001200**************************************************************** NC2104.2 +001300* * NC2104.2 +001400* PROGRAM NC210A TESTS NESTED "IF" STATEMENTS, USING 63 * NC2104.2 +001500* STATEMENTS AND 6 LEVELS OF NESTING IN ONE SENTENCE AND * NC2104.2 +001600* 22 LEVELS OF NESTING IN A SECOND TEST. * NC2104.2 +001700* * NC2104.2 +001800* X-CARDS USED ARE :- * NC2104.2 +001900* * NC2104.2 +002000* X-55 - SYSTEM PRINTER NAME. * NC2104.2 +002100* X-82 - SOURCE COMPUTER NAME. * NC2104.2 +002200* X-83 - OBJECT COMPUTER NAME. * NC2104.2 +002300* * NC2104.2 +002400**************************************************************** NC2104.2 +002500 ENVIRONMENT DIVISION. NC2104.2 +002600 CONFIGURATION SECTION. NC2104.2 +002700 SOURCE-COMPUTER. NC2104.2 +002800 Linux. NC2104.2 +002900 OBJECT-COMPUTER. NC2104.2 +003000 Linux. NC2104.2 +003100 INPUT-OUTPUT SECTION. NC2104.2 +003200 FILE-CONTROL. NC2104.2 +003300 SELECT PRINT-FILE ASSIGN TO NC2104.2 +003400 "report.log". NC2104.2 +003500 DATA DIVISION. NC2104.2 +003600 FILE SECTION. NC2104.2 +003700 FD PRINT-FILE. NC2104.2 +003800 01 PRINT-REC PICTURE X(120). NC2104.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC2104.2 +004000 WORKING-STORAGE SECTION. NC2104.2 +004100 77 ACCUM-DATANAME PIC 99 VALUE ZERO. NC2104.2 +004200 77 DATANAME-A PIC 9 VALUE 0. NC2104.2 +004300 77 DATANAME-B PIC 9 VALUE 0. NC2104.2 +004400 77 DATANAME-C PIC 9 VALUE 0. NC2104.2 +004500 77 DATANAME-D PIC 9 VALUE 0. NC2104.2 +004600 77 DATANAME-E PIC 9 VALUE 0. NC2104.2 +004700 77 DATANAME-F PIC 9 VALUE 0. NC2104.2 +004800 77 SUB-SCRIPT PIC 99 VALUE 01. NC2104.2 +004900 01 DATA-NAMES. NC2104.2 +005000 02 ONE-A PIC 9 VALUE 0. NC2104.2 +005100 02 ONE-B PIC 9 VALUE 0. NC2104.2 +005200 02 ONE-C PIC 9 VALUE 0. NC2104.2 +005300 02 ONE-D PIC 9 VALUE 0. NC2104.2 +005400 02 ONE-E PIC 9 VALUE 0. NC2104.2 +005500 02 ONE-F PIC 9 VALUE 0. NC2104.2 +005600 01 ONE-X REDEFINES DATA-NAMES PIC 9(6). NC2104.2 +005700 01 BUILT-TABLE. NC2104.2 +005800 02 A-POS PIC XX. NC2104.2 +005900 02 B-POS PIC XX. NC2104.2 +006000 02 C-POS PIC XX. NC2104.2 +006100 02 D-POS PIC XXX. NC2104.2 +006200 02 E-POS PIC XXX. NC2104.2 +006300 02 F-POS PIC XXX. NC2104.2 +006400 01 PARAGRAPH-NAME. NC2104.2 +006500 02 FILLER PIC X(11) VALUE "IF-TEST-GF-". NC2104.2 +006600 02 PAR-NUMBER PIC 99 VALUE 00. NC2104.2 +006700 01 COMPARISON-TABLE. NC2104.2 +006800 02 FILLER PIC X(15) VALUE "A1B1C1D01E01F01". NC2104.2 +006900 02 FILLER PIC X(15) VALUE "A1B1C1D01E01F02". NC2104.2 +007000 02 FILLER PIC X(15) VALUE "A1B1C1D01E02F03". NC2104.2 +007100 02 FILLER PIC X(15) VALUE "A1B1C1D01E02F04". NC2104.2 +007200 02 FILLER PIC X(15) VALUE "A1B1C1D02E03F05". NC2104.2 +007300 02 FILLER PIC X(15) VALUE "A1B1C1D02E03F06". NC2104.2 +007400 02 FILLER PIC X(15) VALUE "A1B1C1D02E04F07". NC2104.2 +007500 02 FILLER PIC X(15) VALUE "A1B1C1D02E04F08". NC2104.2 +007600 02 FILLER PIC X(15) VALUE "A1B1C2D03E05F09". NC2104.2 +007700 02 FILLER PIC X(15) VALUE "A1B1C2D03E05F10". NC2104.2 +007800 02 FILLER PIC X(15) VALUE "A1B1C2D03E06F11". NC2104.2 +007900 02 FILLER PIC X(15) VALUE "A1B1C2D03E06F12". NC2104.2 +008000 02 FILLER PIC X(15) VALUE "A1B1C2D04E07F13". NC2104.2 +008100 02 FILLER PIC X(15) VALUE "A1B1C2D04E07F14". NC2104.2 +008200 02 FILLER PIC X(15) VALUE "A1B1C2D04E08F15". NC2104.2 +008300 02 FILLER PIC X(15) VALUE "A1B1C2D04E08F16". NC2104.2 +008400 02 FILLER PIC X(15) VALUE "A1B2C3D05E09F17". NC2104.2 +008500 02 FILLER PIC X(15) VALUE "A1B2C3D05E09F18". NC2104.2 +008600 02 FILLER PIC X(15) VALUE "A1B2C3D05E10F19". NC2104.2 +008700 02 FILLER PIC X(15) VALUE "A1B2C3D05E10F20". NC2104.2 +008800 02 FILLER PIC X(15) VALUE "A1B2C3D06E11F21". NC2104.2 +008900 02 FILLER PIC X(15) VALUE "A1B2C3D06E11F22". NC2104.2 +009000 02 FILLER PIC X(15) VALUE "A1B2C3D06E12F23". NC2104.2 +009100 02 FILLER PIC X(15) VALUE "A1B2C3D06E12F24". NC2104.2 +009200 02 FILLER PIC X(15) VALUE "A1B2C4D07E13F25". NC2104.2 +009300 02 FILLER PIC X(15) VALUE "A1B2C4D07E13F26". NC2104.2 +009400 02 FILLER PIC X(15) VALUE "A1B2C4D07E14F27". NC2104.2 +009500 02 FILLER PIC X(15) VALUE "A1B2C4D07E14F28". NC2104.2 +009600 02 FILLER PIC X(15) VALUE "A1B2C4D08E15F29". NC2104.2 +009700 02 FILLER PIC X(15) VALUE "A1B2C4D08E15F30". NC2104.2 +009800 02 FILLER PIC X(15) VALUE "A1B2C4D08E16F31". NC2104.2 +009900 02 FILLER PIC X(15) VALUE "A1B2C4D08E16F32". NC2104.2 +010000 02 FILLER PIC X(15) VALUE "A2B3C5D09E17F33". NC2104.2 +010100 02 FILLER PIC X(15) VALUE "A2B3C5D09E17F34". NC2104.2 +010200 02 FILLER PIC X(15) VALUE "A2B3C5D09E18F35". NC2104.2 +010300 02 FILLER PIC X(15) VALUE "A2B3C5D09E18F36". NC2104.2 +010400 02 FILLER PIC X(15) VALUE "A2B3C5D10E19F37". NC2104.2 +010500 02 FILLER PIC X(15) VALUE "A2B3C5D10E19F38". NC2104.2 +010600 02 FILLER PIC X(15) VALUE "A2B3C5D10E20F39". NC2104.2 +010700 02 FILLER PIC X(15) VALUE "A2B3C5D10E20F40". NC2104.2 +010800 02 FILLER PIC X(15) VALUE "A2B3C6D11E21F41". NC2104.2 +010900 02 FILLER PIC X(15) VALUE "A2B3C6D11E21F42". NC2104.2 +011000 02 FILLER PIC X(15) VALUE "A2B3C6D11E22F43". NC2104.2 +011100 02 FILLER PIC X(15) VALUE "A2B3C6D11E22F44". NC2104.2 +011200 02 FILLER PIC X(15) VALUE "A2B3C6D12E23F45". NC2104.2 +011300 02 FILLER PIC X(15) VALUE "A2B3C6D12E23F46". NC2104.2 +011400 02 FILLER PIC X(15) VALUE "A2B3C6D12E24F47". NC2104.2 +011500 02 FILLER PIC X(15) VALUE "A2B3C6D12E24F48". NC2104.2 +011600 02 FILLER PIC X(15) VALUE "A2B4C7D13E25F49". NC2104.2 +011700 02 FILLER PIC X(15) VALUE "A2B4C7D13E25F50". NC2104.2 +011800 02 FILLER PIC X(15) VALUE "A2B4C7D13E26F51". NC2104.2 +011900 02 FILLER PIC X(15) VALUE "A2B4C7D13E26F52". NC2104.2 +012000 02 FILLER PIC X(15) VALUE "A2B4C7D14E27F53". NC2104.2 +012100 02 FILLER PIC X(15) VALUE "A2B4C7D14E27F54". NC2104.2 +012200 02 FILLER PIC X(15) VALUE "A2B4C7D14E28F55". NC2104.2 +012300 02 FILLER PIC X(15) VALUE "A2B4C7D14E28F56". NC2104.2 +012400 02 FILLER PIC X(15) VALUE "A2B4C8D15E29F57". NC2104.2 +012500 02 FILLER PIC X(15) VALUE "A2B4C8D15E29F58". NC2104.2 +012600 02 FILLER PIC X(15) VALUE "A2B4C8D15E30F59". NC2104.2 +012700 02 FILLER PIC X(15) VALUE "A2B4C8D15E30F60". NC2104.2 +012800 02 FILLER PIC X(15) VALUE "A2B4C8D16E31F61". NC2104.2 +012900 02 FILLER PIC X(15) VALUE "A2B4C8D16E31F62". NC2104.2 +013000 02 FILLER PIC X(15) VALUE "A2B4C8D16E32F63". NC2104.2 +013100 02 FILLER PIC X(15) VALUE "A2B4C8D16E32F64". NC2104.2 +013200 01 COMP-TBL REDEFINES COMPARISON-TABLE. NC2104.2 +013300 02 CORRECT-ENTRY OCCURS 64 TIMES PIC X(15). NC2104.2 +013400 01 T-F PIC X(5) VALUE "FALSE". NC2104.2 +013500 01 CHECK-PARA. NC2104.2 +013600 02 FILLER PIC X(21) VALUE "VALUE OF DATANAME AT ". NC2104.2 +013700 02 CHECK-VALU PIC 99. NC2104.2 +013800 02 FILLER PIC X(4) VALUE SPACES. NC2104.2 +013900 01 TEST-RESULTS. NC2104.2 +014000 02 FILLER PIC X VALUE SPACE. NC2104.2 +014100 02 FEATURE PIC X(20) VALUE SPACE. NC2104.2 +014200 02 FILLER PIC X VALUE SPACE. NC2104.2 +014300 02 P-OR-F PIC X(5) VALUE SPACE. NC2104.2 +014400 02 FILLER PIC X VALUE SPACE. NC2104.2 +014500 02 PAR-NAME. NC2104.2 +014600 03 FILLER PIC X(19) VALUE SPACE. NC2104.2 +014700 03 PARDOT-X PIC X VALUE SPACE. NC2104.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. NC2104.2 +014900 02 FILLER PIC X(8) VALUE SPACE. NC2104.2 +015000 02 RE-MARK PIC X(61). NC2104.2 +015100 01 TEST-COMPUTED. NC2104.2 +015200 02 FILLER PIC X(30) VALUE SPACE. NC2104.2 +015300 02 FILLER PIC X(17) VALUE NC2104.2 +015400 " COMPUTED=". NC2104.2 +015500 02 COMPUTED-X. NC2104.2 +015600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2104.2 +015700 03 COMPUTED-N REDEFINES COMPUTED-A NC2104.2 +015800 PIC -9(9).9(9). NC2104.2 +015900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2104.2 +016000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2104.2 +016100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2104.2 +016200 03 CM-18V0 REDEFINES COMPUTED-A. NC2104.2 +016300 04 COMPUTED-18V0 PIC -9(18). NC2104.2 +016400 04 FILLER PIC X. NC2104.2 +016500 03 FILLER PIC X(50) VALUE SPACE. NC2104.2 +016600 01 TEST-CORRECT. NC2104.2 +016700 02 FILLER PIC X(30) VALUE SPACE. NC2104.2 +016800 02 FILLER PIC X(17) VALUE " CORRECT =". NC2104.2 +016900 02 CORRECT-X. NC2104.2 +017000 03 CORRECT-A PIC X(20) VALUE SPACE. NC2104.2 +017100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2104.2 +017200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2104.2 +017300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2104.2 +017400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2104.2 +017500 03 CR-18V0 REDEFINES CORRECT-A. NC2104.2 +017600 04 CORRECT-18V0 PIC -9(18). NC2104.2 +017700 04 FILLER PIC X. NC2104.2 +017800 03 FILLER PIC X(2) VALUE SPACE. NC2104.2 +017900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2104.2 +018000 01 CCVS-C-1. NC2104.2 +018100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2104.2 +018200- "SS PARAGRAPH-NAME NC2104.2 +018300- " REMARKS". NC2104.2 +018400 02 FILLER PIC X(20) VALUE SPACE. NC2104.2 +018500 01 CCVS-C-2. NC2104.2 +018600 02 FILLER PIC X VALUE SPACE. NC2104.2 +018700 02 FILLER PIC X(6) VALUE "TESTED". NC2104.2 +018800 02 FILLER PIC X(15) VALUE SPACE. NC2104.2 +018900 02 FILLER PIC X(4) VALUE "FAIL". NC2104.2 +019000 02 FILLER PIC X(94) VALUE SPACE. NC2104.2 +019100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2104.2 +019200 01 REC-CT PIC 99 VALUE ZERO. NC2104.2 +019300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2104.2 +019400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2104.2 +019500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2104.2 +019600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2104.2 +019700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2104.2 +019800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2104.2 +019900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2104.2 +020000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2104.2 +020100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2104.2 +020200 01 CCVS-H-1. NC2104.2 +020300 02 FILLER PIC X(39) VALUE SPACES. NC2104.2 +020400 02 FILLER PIC X(42) VALUE NC2104.2 +020500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2104.2 +020600 02 FILLER PIC X(39) VALUE SPACES. NC2104.2 +020700 01 CCVS-H-2A. NC2104.2 +020800 02 FILLER PIC X(40) VALUE SPACE. NC2104.2 +020900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2104.2 +021000 02 FILLER PIC XXXX VALUE NC2104.2 +021100 "4.2 ". NC2104.2 +021200 02 FILLER PIC X(28) VALUE NC2104.2 +021300 " COPY - NOT FOR DISTRIBUTION". NC2104.2 +021400 02 FILLER PIC X(41) VALUE SPACE. NC2104.2 +021500 NC2104.2 +021600 01 CCVS-H-2B. NC2104.2 +021700 02 FILLER PIC X(15) VALUE NC2104.2 +021800 "TEST RESULT OF ". NC2104.2 +021900 02 TEST-ID PIC X(9). NC2104.2 +022000 02 FILLER PIC X(4) VALUE NC2104.2 +022100 " IN ". NC2104.2 +022200 02 FILLER PIC X(12) VALUE NC2104.2 +022300 " HIGH ". NC2104.2 +022400 02 FILLER PIC X(22) VALUE NC2104.2 +022500 " LEVEL VALIDATION FOR ". NC2104.2 +022600 02 FILLER PIC X(58) VALUE NC2104.2 +022700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2104.2 +022800 01 CCVS-H-3. NC2104.2 +022900 02 FILLER PIC X(34) VALUE NC2104.2 +023000 " FOR OFFICIAL USE ONLY ". NC2104.2 +023100 02 FILLER PIC X(58) VALUE NC2104.2 +023200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2104.2 +023300 02 FILLER PIC X(28) VALUE NC2104.2 +023400 " COPYRIGHT 1985 ". NC2104.2 +023500 01 CCVS-E-1. NC2104.2 +023600 02 FILLER PIC X(52) VALUE SPACE. NC2104.2 +023700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2104.2 +023800 02 ID-AGAIN PIC X(9). NC2104.2 +023900 02 FILLER PIC X(45) VALUE SPACES. NC2104.2 +024000 01 CCVS-E-2. NC2104.2 +024100 02 FILLER PIC X(31) VALUE SPACE. NC2104.2 +024200 02 FILLER PIC X(21) VALUE SPACE. NC2104.2 +024300 02 CCVS-E-2-2. NC2104.2 +024400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2104.2 +024500 03 FILLER PIC X VALUE SPACE. NC2104.2 +024600 03 ENDER-DESC PIC X(44) VALUE NC2104.2 +024700 "ERRORS ENCOUNTERED". NC2104.2 +024800 01 CCVS-E-3. NC2104.2 +024900 02 FILLER PIC X(22) VALUE NC2104.2 +025000 " FOR OFFICIAL USE ONLY". NC2104.2 +025100 02 FILLER PIC X(12) VALUE SPACE. NC2104.2 +025200 02 FILLER PIC X(58) VALUE NC2104.2 +025300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2104.2 +025400 02 FILLER PIC X(13) VALUE SPACE. NC2104.2 +025500 02 FILLER PIC X(15) VALUE NC2104.2 +025600 " COPYRIGHT 1985". NC2104.2 +025700 01 CCVS-E-4. NC2104.2 +025800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2104.2 +025900 02 FILLER PIC X(4) VALUE " OF ". NC2104.2 +026000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2104.2 +026100 02 FILLER PIC X(40) VALUE NC2104.2 +026200 " TESTS WERE EXECUTED SUCCESSFULLY". NC2104.2 +026300 01 XXINFO. NC2104.2 +026400 02 FILLER PIC X(19) VALUE NC2104.2 +026500 "*** INFORMATION ***". NC2104.2 +026600 02 INFO-TEXT. NC2104.2 +026700 04 FILLER PIC X(8) VALUE SPACE. NC2104.2 +026800 04 XXCOMPUTED PIC X(20). NC2104.2 +026900 04 FILLER PIC X(5) VALUE SPACE. NC2104.2 +027000 04 XXCORRECT PIC X(20). NC2104.2 +027100 02 INF-ANSI-REFERENCE PIC X(48). NC2104.2 +027200 01 HYPHEN-LINE. NC2104.2 +027300 02 FILLER PIC IS X VALUE IS SPACE. NC2104.2 +027400 02 FILLER PIC IS X(65) VALUE IS "************************NC2104.2 +027500- "*****************************************". NC2104.2 +027600 02 FILLER PIC IS X(54) VALUE IS "************************NC2104.2 +027700- "******************************". NC2104.2 +027800 01 CCVS-PGM-ID PIC X(9) VALUE NC2104.2 +027900 "NC210A". NC2104.2 +028000 PROCEDURE DIVISION. NC2104.2 +028100 CCVS1 SECTION. NC2104.2 +028200 OPEN-FILES. NC2104.2 +028300 OPEN OUTPUT PRINT-FILE. NC2104.2 +028400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2104.2 +028500 MOVE SPACE TO TEST-RESULTS. NC2104.2 +028600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2104.2 +028700 GO TO CCVS1-EXIT. NC2104.2 +028800 CLOSE-FILES. NC2104.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2104.2 +029000 TERMINATE-CCVS. NC2104.2 +029100 STOP RUN. NC2104.2 +029200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2104.2 +029300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2104.2 +029400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2104.2 +029500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2104.2 +029600 MOVE "****TEST DELETED****" TO RE-MARK. NC2104.2 +029700 PRINT-DETAIL. NC2104.2 +029800 IF REC-CT NOT EQUAL TO ZERO NC2104.2 +029900 MOVE "." TO PARDOT-X NC2104.2 +030000 MOVE REC-CT TO DOTVALUE. NC2104.2 +030100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2104.2 +030200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2104.2 +030300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2104.2 +030400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2104.2 +030500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2104.2 +030600 MOVE SPACE TO CORRECT-X. NC2104.2 +030700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2104.2 +030800 MOVE SPACE TO RE-MARK. NC2104.2 +030900 HEAD-ROUTINE. NC2104.2 +031000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +031100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +031200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2104.2 +031300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2104.2 +031400 COLUMN-NAMES-ROUTINE. NC2104.2 +031500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +031600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +031700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +031800 END-ROUTINE. NC2104.2 +031900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2104.2 +032000 END-RTN-EXIT. NC2104.2 +032100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +032200 END-ROUTINE-1. NC2104.2 +032300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2104.2 +032400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2104.2 +032500 ADD PASS-COUNTER TO ERROR-HOLD. NC2104.2 +032600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2104.2 +032700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2104.2 +032800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2104.2 +032900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2104.2 +033000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2104.2 +033100 END-ROUTINE-12. NC2104.2 +033200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2104.2 +033300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2104.2 +033400 MOVE "NO " TO ERROR-TOTAL NC2104.2 +033500 ELSE NC2104.2 +033600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2104.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2104.2 +033800 PERFORM WRITE-LINE. NC2104.2 +033900 END-ROUTINE-13. NC2104.2 +034000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2104.2 +034100 MOVE "NO " TO ERROR-TOTAL ELSE NC2104.2 +034200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2104.2 +034300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2104.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +034500 IF INSPECT-COUNTER EQUAL TO ZERO NC2104.2 +034600 MOVE "NO " TO ERROR-TOTAL NC2104.2 +034700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2104.2 +034800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2104.2 +034900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +035000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2104.2 +035100 WRITE-LINE. NC2104.2 +035200 ADD 1 TO RECORD-COUNT. NC2104.2 +035300 IF RECORD-COUNT GREATER 50 NC2104.2 +035400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2104.2 +035500 MOVE SPACE TO DUMMY-RECORD NC2104.2 +035600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2104.2 +035700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2104.2 +035800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2104.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2104.2 +036000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2104.2 +036100 MOVE ZERO TO RECORD-COUNT. NC2104.2 +036200 PERFORM WRT-LN. NC2104.2 +036300 WRT-LN. NC2104.2 +036400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2104.2 +036500 MOVE SPACE TO DUMMY-RECORD. NC2104.2 +036600 BLANK-LINE-PRINT. NC2104.2 +036700 PERFORM WRT-LN. NC2104.2 +036800 FAIL-ROUTINE. NC2104.2 +036900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2104.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2104.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2104.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2104.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2104.2 +037500 GO TO FAIL-ROUTINE-EX. NC2104.2 +037600 FAIL-ROUTINE-WRITE. NC2104.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2104.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2104.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2104.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2104.2 +038100 FAIL-ROUTINE-EX. EXIT. NC2104.2 +038200 BAIL-OUT. NC2104.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2104.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2104.2 +038500 BAIL-OUT-WRITE. NC2104.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2104.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2104.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2104.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2104.2 +039000 BAIL-OUT-EX. EXIT. NC2104.2 +039100 CCVS1-EXIT. NC2104.2 +039200 EXIT. NC2104.2 +039300 SECT-NC210A-001 SECTION. NC2104.2 +039400 IF-INIT-GF-X. NC2104.2 +039500 MOVE "VI-89 6.15.4 GR1(C)" TO ANSI-REFERENCE. NC2104.2 +039600 IF-TEST-GF-X. NC2104.2 +039700 IF DATANAME-A EQUAL TO ONE-A NC2104.2 +039800 MOVE "A1" TO A-POS NC2104.2 +039900 IF DATANAME-B EQUAL TO ONE-B NC2104.2 +040000 MOVE "B1" TO B-POS NC2104.2 +040100 IF DATANAME-C EQUAL TO ONE-C NC2104.2 +040200 MOVE "C1" TO C-POS NC2104.2 +040300 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +040400 MOVE "D01" TO D-POS NC2104.2 +040500 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +040600 MOVE "E01" TO E-POS NC2104.2 +040700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +040800 MOVE "F01" TO F-POS NC2104.2 +040900 ELSE NC2104.2 +041000 MOVE "F02" TO F-POS NC2104.2 +041100 ELSE NC2104.2 +041200 MOVE "E02" TO E-POS NC2104.2 +041300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +041400 MOVE "F03" TO F-POS NC2104.2 +041500 ELSE NC2104.2 +041600 MOVE "F04" TO F-POS NC2104.2 +041700 ELSE NC2104.2 +041800 MOVE "D02" TO D-POS NC2104.2 +041900 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +042000 MOVE "E03" TO E-POS NC2104.2 +042100 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +042200 MOVE "F05" TO F-POS NC2104.2 +042300 ELSE NC2104.2 +042400 MOVE "F06" TO F-POS NC2104.2 +042500 ELSE NC2104.2 +042600 MOVE "E04" TO E-POS NC2104.2 +042700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +042800 MOVE "F07" TO F-POS NC2104.2 +042900 ELSE NC2104.2 +043000 MOVE "F08" TO F-POS NC2104.2 +043100 ELSE NC2104.2 +043200 MOVE "C2" TO C-POS NC2104.2 +043300 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +043400 MOVE "D03" TO D-POS NC2104.2 +043500 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +043600 MOVE "E05" TO E-POS NC2104.2 +043700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +043800 MOVE "F09" TO F-POS NC2104.2 +043900 ELSE NC2104.2 +044000 MOVE "F10" TO F-POS NC2104.2 +044100 ELSE NC2104.2 +044200 MOVE "E06" TO E-POS NC2104.2 +044300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +044400 MOVE "F11" TO F-POS NC2104.2 +044500 ELSE NC2104.2 +044600 MOVE "F12" TO F-POS NC2104.2 +044700 ELSE NC2104.2 +044800 MOVE "D04" TO D-POS NC2104.2 +044900 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +045000 MOVE "E07" TO E-POS NC2104.2 +045100 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +045200 MOVE "F13" TO F-POS NC2104.2 +045300 ELSE NC2104.2 +045400 MOVE "F14" TO F-POS NC2104.2 +045500 ELSE NC2104.2 +045600 MOVE "E08" TO E-POS NC2104.2 +045700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +045800 MOVE "F15" TO F-POS NC2104.2 +045900 ELSE NC2104.2 +046000 MOVE "F16" TO F-POS NC2104.2 +046100 ELSE NC2104.2 +046200 MOVE "B2" TO B-POS NC2104.2 +046300 IF DATANAME-C EQUAL TO ONE-C NC2104.2 +046400 MOVE "C3" TO C-POS NC2104.2 +046500 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +046600 MOVE "D05" TO D-POS NC2104.2 +046700 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +046800 MOVE "E09" TO E-POS NC2104.2 +046900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +047000 MOVE "F17" TO F-POS NC2104.2 +047100 ELSE NC2104.2 +047200 MOVE "F18" TO F-POS NC2104.2 +047300 ELSE NC2104.2 +047400 MOVE "E10" TO E-POS NC2104.2 +047500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +047600 MOVE "F19" TO F-POS NC2104.2 +047700 ELSE NC2104.2 +047800 MOVE "F20" TO F-POS NC2104.2 +047900 ELSE NC2104.2 +048000 MOVE "D06" TO D-POS NC2104.2 +048100 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +048200 MOVE "E11" TO E-POS NC2104.2 +048300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +048400 MOVE "F21" TO F-POS NC2104.2 +048500 ELSE NC2104.2 +048600 MOVE "F22" TO F-POS NC2104.2 +048700 ELSE NC2104.2 +048800 MOVE "E12" TO E-POS NC2104.2 +048900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +049000 MOVE "F23" TO F-POS NC2104.2 +049100 ELSE NC2104.2 +049200 MOVE "F24" TO F-POS NC2104.2 +049300 ELSE NC2104.2 +049400 MOVE "C4" TO C-POS NC2104.2 +049500 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +049600 MOVE "D07" TO D-POS NC2104.2 +049700 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +049800 MOVE "E13" TO E-POS NC2104.2 +049900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +050000 MOVE "F25" TO F-POS NC2104.2 +050100 ELSE NC2104.2 +050200 MOVE "F26" TO F-POS NC2104.2 +050300 ELSE NC2104.2 +050400 MOVE "E14" TO E-POS NC2104.2 +050500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +050600 MOVE "F27" TO F-POS NC2104.2 +050700 ELSE NC2104.2 +050800 MOVE "F28" TO F-POS NC2104.2 +050900 ELSE NC2104.2 +051000 MOVE "D08" TO D-POS NC2104.2 +051100 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +051200 MOVE "E15" TO E-POS NC2104.2 +051300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +051400 MOVE "F29" TO F-POS NC2104.2 +051500 ELSE NC2104.2 +051600 MOVE "F30" TO F-POS NC2104.2 +051700 ELSE NC2104.2 +051800 MOVE "E16" TO E-POS NC2104.2 +051900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +052000 MOVE "F31" TO F-POS NC2104.2 +052100 ELSE NC2104.2 +052200 MOVE "F32" TO F-POS NC2104.2 +052300 ELSE NC2104.2 +052400 MOVE "A2" TO A-POS NC2104.2 +052500 IF DATANAME-B EQUAL TO ONE-B NC2104.2 +052600 MOVE "B3" TO B-POS NC2104.2 +052700 IF DATANAME-C EQUAL TO ONE-C NC2104.2 +052800 MOVE "C5" TO C-POS NC2104.2 +052900 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +053000 MOVE "D09" TO D-POS NC2104.2 +053100 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +053200 MOVE "E17" TO E-POS NC2104.2 +053300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +053400 MOVE "F33" TO F-POS NC2104.2 +053500 ELSE NC2104.2 +053600 MOVE "F34" TO F-POS NC2104.2 +053700 ELSE NC2104.2 +053800 MOVE "E18" TO E-POS NC2104.2 +053900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +054000 MOVE "F35" TO F-POS NC2104.2 +054100 ELSE NC2104.2 +054200 MOVE "F36" TO F-POS NC2104.2 +054300 ELSE NC2104.2 +054400 MOVE "D10" TO D-POS NC2104.2 +054500 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +054600 MOVE "E19" TO E-POS NC2104.2 +054700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +054800 MOVE "F37" TO F-POS NC2104.2 +054900 ELSE NC2104.2 +055000 MOVE "F38" TO F-POS NC2104.2 +055100 ELSE NC2104.2 +055200 MOVE "E20" TO E-POS NC2104.2 +055300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +055400 MOVE "F39" TO F-POS NC2104.2 +055500 ELSE NC2104.2 +055600 MOVE "F40" TO F-POS NC2104.2 +055700 ELSE NC2104.2 +055800 MOVE "C6" TO C-POS NC2104.2 +055900 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +056000 MOVE "D11" TO D-POS NC2104.2 +056100 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +056200 MOVE "E21" TO E-POS NC2104.2 +056300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +056400 MOVE "F41" TO F-POS NC2104.2 +056500 ELSE NC2104.2 +056600 MOVE "F42" TO F-POS NC2104.2 +056700 ELSE NC2104.2 +056800 MOVE "E22" TO E-POS NC2104.2 +056900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +057000 MOVE "F43" TO F-POS NC2104.2 +057100 ELSE NC2104.2 +057200 MOVE "F44" TO F-POS NC2104.2 +057300 ELSE NC2104.2 +057400 MOVE "D12" TO D-POS NC2104.2 +057500 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +057600 MOVE "E23" TO E-POS NC2104.2 +057700 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +057800 MOVE "F45" TO F-POS NC2104.2 +057900 ELSE NC2104.2 +058000 MOVE "F46" TO F-POS NC2104.2 +058100 ELSE NC2104.2 +058200 MOVE "E24" TO E-POS NC2104.2 +058300 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +058400 MOVE "F47" TO F-POS NC2104.2 +058500 ELSE NC2104.2 +058600 MOVE "F48" TO F-POS NC2104.2 +058700 ELSE NC2104.2 +058800 MOVE "B4" TO B-POS NC2104.2 +058900 IF DATANAME-C EQUAL TO ONE-C NC2104.2 +059000 MOVE "C7" TO C-POS NC2104.2 +059100 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +059200 MOVE "D13" TO D-POS NC2104.2 +059300 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +059400 MOVE "E25" TO E-POS NC2104.2 +059500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +059600 MOVE "F49" TO F-POS NC2104.2 +059700 ELSE NC2104.2 +059800 MOVE "F50" TO F-POS NC2104.2 +059900 ELSE NC2104.2 +060000 MOVE "E26" TO E-POS NC2104.2 +060100 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +060200 MOVE "F51" TO F-POS NC2104.2 +060300 ELSE NC2104.2 +060400 MOVE "F52" TO F-POS NC2104.2 +060500 ELSE NC2104.2 +060600 MOVE "D14" TO D-POS NC2104.2 +060700 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +060800 MOVE "E27" TO E-POS NC2104.2 +060900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +061000 MOVE "F53" TO F-POS NC2104.2 +061100 ELSE NC2104.2 +061200 MOVE "F54" TO F-POS NC2104.2 +061300 ELSE NC2104.2 +061400 MOVE "E28" TO E-POS NC2104.2 +061500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +061600 MOVE "F55" TO F-POS NC2104.2 +061700 ELSE NC2104.2 +061800 MOVE "F56" TO F-POS NC2104.2 +061900 ELSE NC2104.2 +062000 MOVE "C8" TO C-POS NC2104.2 +062100 IF DATANAME-D EQUAL TO ONE-D NC2104.2 +062200 MOVE "D15" TO D-POS NC2104.2 +062300 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +062400 MOVE "E29" TO E-POS NC2104.2 +062500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +062600 MOVE "F57" TO F-POS NC2104.2 +062700 ELSE NC2104.2 +062800 MOVE "F58" TO F-POS NC2104.2 +062900 ELSE NC2104.2 +063000 MOVE "E30" TO E-POS NC2104.2 +063100 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +063200 MOVE "F59" TO F-POS NC2104.2 +063300 ELSE NC2104.2 +063400 MOVE "F60" TO F-POS NC2104.2 +063500 ELSE NC2104.2 +063600 MOVE "D16" TO D-POS NC2104.2 +063700 IF DATANAME-E EQUAL TO ONE-E NC2104.2 +063800 MOVE "E31" TO E-POS NC2104.2 +063900 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +064000 MOVE "F61" TO F-POS NC2104.2 +064100 ELSE NC2104.2 +064200 MOVE "F62" TO F-POS NC2104.2 +064300 ELSE NC2104.2 +064400 MOVE "E32" TO E-POS NC2104.2 +064500 IF DATANAME-F EQUAL TO ONE-F NC2104.2 +064600 MOVE "F63" TO F-POS NC2104.2 +064700 ELSE NC2104.2 +064800 MOVE "F64" TO F-POS. NC2104.2 +064900 IF BUILT-TABLE EQUAL TO CORRECT-ENTRY (SUB-SCRIPT) NC2104.2 +065000 PERFORM PASS NC2104.2 +065100 GO TO IF-WRITE-GF-X. NC2104.2 +065200 GO TO IF-FAIL-GF-X. NC2104.2 +065300 IF-DELETE-GF-X. NC2104.2 +065400 MOVE 63 TO PAR-NUMBER. NC2104.2 +065500 PERFORM DE-LETE. NC2104.2 +065600 ADD 63 TO DELETE-COUNTER. NC2104.2 +065700 GO TO IF-WRITE-GF-X. NC2104.2 +065800 IF-FAIL-GF-X. NC2104.2 +065900 MOVE BUILT-TABLE TO COMPUTED-A. NC2104.2 +066000 MOVE CORRECT-ENTRY (SUB-SCRIPT) TO CORRECT-A. NC2104.2 +066100 PERFORM FAIL. NC2104.2 +066200 IF-WRITE-GF-X. NC2104.2 +066300 ADD 1 TO PAR-NUMBER. NC2104.2 +066400 MOVE PARAGRAPH-NAME TO PAR-NAME. NC2104.2 +066500 PERFORM PRINT-DETAIL. NC2104.2 +066600 IF PAR-NUMBER EQUAL TO 64 GO TO IF-INIT-GF-Y. NC2104.2 +066700 ADD 1 TO SUB-SCRIPT. NC2104.2 +066800 MOVE SPACES TO BUILT-TABLE. NC2104.2 +066900 ADD 1 TO ONE-X. NC2104.2 +067000 IF ONE-F EQUAL TO 2 ADD 8 TO ONE-X. NC2104.2 +067100 IF ONE-E EQUAL TO 2 ADD 80 TO ONE-X. NC2104.2 +067200 IF ONE-D EQUAL TO 2 ADD 800 TO ONE-X. NC2104.2 +067300 IF ONE-C EQUAL TO 2 ADD 8000 TO ONE-X. NC2104.2 +067400 IF ONE-B EQUAL TO 2 ADD 80000 TO ONE-X. NC2104.2 +067500 GO TO IF-INIT-GF-X. NC2104.2 +067600* NC2104.2 +067700 IF-INIT-GF-Y. NC2104.2 +067800 MOVE "VI-89 6.15.4 GR1(C)" TO ANSI-REFERENCE. NC2104.2 +067900 ADD 1 TO PAR-NUMBER. NC2104.2 +068000 MOVE 22 TO ACCUM-DATANAME. NC2104.2 +068100 IF-TEST-GF-Y. NC2104.2 +068200 MOVE "FALSE" TO T-F. NC2104.2 +068300 IF ACCUM-DATANAME NOT EQUAL TO 1 NC2104.2 +068400 IF ACCUM-DATANAME NOT EQUAL TO 2 NC2104.2 +068500 IF ACCUM-DATANAME NOT EQUAL TO 3 NC2104.2 +068600 IF ACCUM-DATANAME NOT EQUAL TO 4 NC2104.2 +068700 IF ACCUM-DATANAME NOT EQUAL TO 5 NC2104.2 +068800 IF ACCUM-DATANAME NOT EQUAL TO 6 NC2104.2 +068900 IF ACCUM-DATANAME NOT EQUAL TO 7 NC2104.2 +069000 IF ACCUM-DATANAME NOT EQUAL TO 8 NC2104.2 +069100 IF ACCUM-DATANAME NOT EQUAL TO 9 NC2104.2 +069200 IF ACCUM-DATANAME NOT EQUAL TO 10 NC2104.2 +069300 IF ACCUM-DATANAME NOT EQUAL TO 11 NC2104.2 +069400 IF ACCUM-DATANAME NOT EQUAL TO 12 NC2104.2 +069500 IF ACCUM-DATANAME NOT EQUAL TO 13 NC2104.2 +069600 IF ACCUM-DATANAME NOT EQUAL TO 14 NC2104.2 +069700 IF ACCUM-DATANAME NOT EQUAL TO 15 NC2104.2 +069800 IF ACCUM-DATANAME NOT EQUAL TO 16 NC2104.2 +069900 IF ACCUM-DATANAME NOT EQUAL TO 17 NC2104.2 +070000 IF ACCUM-DATANAME NOT EQUAL TO 18 NC2104.2 +070100 IF ACCUM-DATANAME NOT EQUAL TO 19 NC2104.2 +070200 IF ACCUM-DATANAME NOT EQUAL TO 20 NC2104.2 +070300 IF ACCUM-DATANAME NOT EQUAL TO 21 NC2104.2 +070400 MOVE "TRUE" TO T-F. NC2104.2 +070500 IF ACCUM-DATANAME EQUAL TO 22 AND T-F EQUAL TO "TRUE" NC2104.2 +070600 PERFORM PASS NC2104.2 +070700 PERFORM IF-WRITE-GF-Y NC2104.2 +070800 SUBTRACT 1 FROM ACCUM-DATANAME NC2104.2 +070900 GO TO IF-TEST-GF-Y. NC2104.2 +071000 IF ACCUM-DATANAME LESS THAN 22 AND T-F EQUAL TO "FALSE" NC2104.2 +071100 PERFORM PASS NC2104.2 +071200 GO TO IF-WRITE-GF-Y NC2104.2 +071300 ELSE GO TO IF-FAIL-GF-Y. NC2104.2 +071400 IF-DELETE-GF-Y. NC2104.2 +071500 ADD 21 TO PAR-NUMBER. NC2104.2 +071600 PERFORM DE-LETE. NC2104.2 +071700 ADD 21 TO DELETE-COUNTER. NC2104.2 +071800 MOVE 1 TO ACCUM-DATANAME. NC2104.2 +071900 GO TO IF-WRITE-GF-Y. NC2104.2 +072000 IF-FAIL-GF-Y. NC2104.2 +072100 MOVE "*****" TO COMPUTED-A CORRECT-A. NC2104.2 +072200 MOVE ACCUM-DATANAME TO CHECK-VALU. NC2104.2 +072300 MOVE CHECK-PARA TO RE-MARK. NC2104.2 +072400 PERFORM FAIL. NC2104.2 +072500 IF-WRITE-GF-Y. NC2104.2 +072600 MOVE PARAGRAPH-NAME TO PAR-NAME. NC2104.2 +072700 ADD 1 TO PAR-NUMBER. NC2104.2 +072800 PERFORM PRINT-DETAIL. NC2104.2 +072900 IF ACCUM-DATANAME EQUAL TO 1 GO TO TEST-EXIT. NC2104.2 +073000 SUBTRACT 1 FROM ACCUM-DATANAME. NC2104.2 +073100 IF-RETURN-GF-Y. NC2104.2 +073200 GO TO IF-TEST-GF-Y. NC2104.2 +073300 TEST-EXIT. NC2104.2 +073400 EXIT. NC2104.2 +073500 CCVS-EXIT SECTION. NC2104.2 +073600 CCVS-999999. NC2104.2 +073700 GO TO CLOSE-FILES. NC2104.2 diff --git a/tests/cobol85/NC/NC211A.CBL b/tests/cobol85/NC/NC211A.CBL new file mode 100755 index 00000000..1599b1a3 --- /dev/null +++ b/tests/cobol85/NC/NC211A.CBL @@ -0,0 +1,1896 @@ +000100 IDENTIFICATION DIVISION. NC2114.2 +000200 PROGRAM-ID. NC2114.2 +000300 NC211A. NC2114.2 +000400**************************************************************** NC2114.2 +000500* * NC2114.2 +000600* VALIDATION FOR:- * NC2114.2 +000700* * NC2114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2114.2 +000900* * NC2114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2114.2 +001100* * NC2114.2 +001200**************************************************************** NC2114.2 +001300* * NC2114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2114.2 +001500* * NC2114.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2114.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2114.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2114.2 +001900* * NC2114.2 +002000**************************************************************** NC2114.2 +002100* NC2114.2 +002200* * NC2114.2 +002300* PROGRAM NC211A TESTS THE GENERAL FORMAT OF THE "IF" * NC2114.2 +002400* STATEMENT USING COMPOUND CONDITIONAL STATEMENTS WITH * NC2114.2 +002500* ABREVIATED CONDITIONS, CONDITION NAMES AND QUALIFIED * NC2114.2 +002600* DATA-NAMES. * NC2114.2 +002700* * NC2114.2 +002800**************************************************************** NC2114.2 +002900 ENVIRONMENT DIVISION. NC2114.2 +003000 CONFIGURATION SECTION. NC2114.2 +003100 SOURCE-COMPUTER. NC2114.2 +003200 Linux. NC2114.2 +003300 OBJECT-COMPUTER. NC2114.2 +003400 Linux. NC2114.2 +003500 SPECIAL-NAMES. NC2114.2 +003600 SWITCH-1 NC2114.2 +003700 IS WRK-SWITCH-1 NC2114.2 +003800 ON STATUS IS ON-WRK-SWITCH-1 NC2114.2 +003900 OFF STATUS IS OFF-WRK-SWITCH-1 NC2114.2 +004000 SWITCH-2 NC2114.2 +004100 IS WRK-SWITCH-2 NC2114.2 +004200 OFF STATUS IS OFF-WRK-SWITCH-2. NC2114.2 +004300 INPUT-OUTPUT SECTION. NC2114.2 +004400 FILE-CONTROL. NC2114.2 +004500 SELECT PRINT-FILE ASSIGN TO NC2114.2 +004600 "report.log". NC2114.2 +004700 DATA DIVISION. NC2114.2 +004800 FILE SECTION. NC2114.2 +004900 FD PRINT-FILE. NC2114.2 +005000 01 PRINT-REC PICTURE X(120). NC2114.2 +005100 01 DUMMY-RECORD PICTURE X(120). NC2114.2 +005200 WORKING-STORAGE SECTION. NC2114.2 +005300 77 WRK-DS-02V00 PICTURE S99. NC2114.2 +005400 88 TEST-2NUC-COND-99 VALUE 99. NC2114.2 +005500 77 WRK-DS-06V06 PICTURE 9(6)V9(6). NC2114.2 +005600 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC2114.2 +005700 PICTURE S9(12). NC2114.2 +005800 77 A02TWOS-DS-02V00 PICTURE S99 VALUE 22. NC2114.2 +005900 77 WRK-DS-01V00 PICTURE S9. NC2114.2 +006000 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2114.2 +006100 77 A990-DS-0201P PICTURE S99P VALUE 990. NC2114.2 +006200 77 A02ONES-DS-02V00 PICTURE S99 VALUE 11. NC2114.2 +006300 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001.NC2114.2 +006400 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2114.2 +006500 77 WRK-XN-00001 PICTURE X. NC2114.2 +006600 77 WRK-XN-00005 PICTURE X(5). NC2114.2 +006700 77 MINUS-TWO PICTURE S9 VALUE -2. NC2114.2 +006800 77 MINUS-ONE PICTURE S9 VALUE -1. NC2114.2 +006900 77 MINUS-UNO PICTURE S9 VALUE -1. NC2114.2 +007000 77 NAUGHT PICTURE S9 VALUE 0. NC2114.2 +007100 77 NOTHING PICTURE S9 VALUE ZERO. NC2114.2 +007200 77 ONE PICTURE S9 VALUE 1. NC2114.2 +007300 77 UNO PICTURE S9 VALUE +1. NC2114.2 +007400 77 TWO PICTURE 9 VALUE 2. NC2114.2 +007500 77 DOS PICTURE S9 VALUE +2. NC2114.2 +007600 77 THREE PICTURE 9 VALUE 3. NC2114.2 +007700 77 TRES PICTURE S9 VALUE +3. NC2114.2 +007800 77 FOUR PICTURE S9 VALUE 4. NC2114.2 +007900 77 QUATROS PICTURE S9 VALUE +4. NC2114.2 +008000 77 FIVE PICTURE S9 VALUE 5. NC2114.2 +008100 77 SIX PICTURE S9 VALUE 6. NC2114.2 +008200 77 SEVEN PICTURE 9 VALUE 7. NC2114.2 +008300 77 EIGHT PICTURE S9 VALUE 8. NC2114.2 +008400 77 NINE PICTURE 9 VALUE 9. NC2114.2 +008500 77 TEN PICTURE 99 VALUE 10. NC2114.2 +008600 77 ONE-THIRD PIC SV9(18) VALUE +.333333333333333333. NC2114.2 +008700 77 THREE-SEVENTHS PIC SV9(10) VALUE +.4285714286. NC2114.2 +008800 77 ALTERCOUNT PICTURE 999 VALUE ZERO. NC2114.2 +008900 77 XRAY PICTURE IS X. NC2114.2 +009000 77 IF-D1 PICTURE S9(4)V9(2) VALUE 0. NC2114.2 +009100 77 IF-D2 PICTURE S9(4)V9(2) VALUE ZERO. NC2114.2 +009200 77 IF-D3 PICTURE X(10) VALUE "0000000000". NC2114.2 +009300 77 IF-D4 PICTURE X(15) VALUE " ". NC2114.2 +009400 77 IF-D5 PICTURE X(10) VALUE ALL QUOTE. NC2114.2 +009500 77 IF-D6 PICTURE A(10) VALUE "BABABABABA". NC2114.2 +009600 77 IF-D7 PICTURE S9(6)V9(4) VALUE +123.45. NC2114.2 +009700 77 IF-D8 PICTURE 9(6)V9(4) VALUE 12300. NC2114.2 +009800 77 IF-D9 PICTURE X(3) VALUE "123". NC2114.2 +009900 77 IF-D11 PICTURE X(6) VALUE "ABCDEF". NC2114.2 +010000 77 IF-D13 PICTURE 9(6)V9(4) VALUE 12300. NC2114.2 +010100 77 IF-D14 PICTURE S9(4)V9(2) VALUE +123.45. NC2114.2 +010200 77 IF-D15 PICTURE S999PP VALUE 12300. NC2114.2 +010300 77 IF-D16 PICTURE PP99 VALUE .0012. NC2114.2 +010400 77 IF-D17 PICTURE SV9(4) VALUE .0012. NC2114.2 +010500 77 IF-D18 PICTURE X(10) VALUE "BABABABABA". NC2114.2 +010600 77 IF-D19 PICTURE X(10) VALUE "ABCDEF ". NC2114.2 +010700 77 IF-D23 PICTURE $9,9B9.90+. NC2114.2 +010800 77 IF-D24 PICTURE X(10) VALUE "l1,2 3.40+". NC2114.2 +010900 77 IF-D25 PICTURE ABABX0A. NC2114.2 +011000 77 IF-D26 PICTURE X(8) VALUE "A C D0E". NC2114.2 +011100 77 IF-D27 PICTURE IS 9(6)V9(4) VALUE IS 2137.45 NC2114.2 +011200 USAGE IS COMPUTATIONAL. NC2114.2 +011300 77 IF-D28 PICTURE IS 999999V9999 VALUE IS 2137.45. NC2114.2 +011400 77 IF-D31 PICTURE S9(6) VALUE -123. NC2114.2 +011500 77 IF-D32 PICTURE S9(4)V99. NC2114.2 +011600 88 A; VALUE 1. NC2114.2 +011700 88 B VALUES ARE 2 THRU 4. NC2114.2 +011800 88 C VALUE IS ZERO. NC2114.2 +011900 88 D VALUE IS +12.34. NC2114.2 +012000 88 E VALUE IS .01, .11, .21 .81. NC2114.2 +012100 88 F VALUE IS 100 THRU 128 1000 THRU 1280 -9 THRU -2. NC2114.2 +012200 88 G VALUE IS 8765.43 1234 THRU 5678 5 -9999 THRU 10. NC2114.2 +012300 77 IF-D33 PICTURE X(4). NC2114.2 +012400 88 B VALUE QUOTE. NC2114.2 +012500 88 C VALUE SPACE. NC2114.2 +012600 88 D VALUE ALL "BAC". NC2114.2 +012700 77 IF-D34 PICTURE A(4). NC2114.2 +012800 88 B VALUE "A A ". NC2114.2 +012900 77 IF-D37 PICTURE 9(5) VALUE 12345. NC2114.2 +013000 77 IF-D38 PICTURE X(9) VALUE "12345 ". NC2114.2 +013100 77 CCON-1 PICTURE 99 VALUE 11. NC2114.2 +013200 77 CCON-2 PICTURE 99 VALUE 12. NC2114.2 +013300 77 CCON-3 PICTURE 99 VALUE 13. NC2114.2 +013400 77 CCON-4 PICTURE 99 VALUE 14. NC2114.2 +013500 77 CLASS-1 PICTURE X(5). NC2114.2 +013600 77 CLASS-2 PICTURE X(5). NC2114.2 +013700 77 CLASS-3 PICTURE X(5). NC2114.2 +013800 77 SIGN-1 PICTURE S9(5). NC2114.2 +013900 77 SIGN-2 PICTURE S9(5). NC2114.2 +014000 77 SIGN-3 PICTURE S9(5). NC2114.2 +014100 77 AZE PICTURE X(5) VALUE "AAAAA". NC2114.2 +014200 77 BEEZE PICTURE X(5) VALUE "BBBBB". NC2114.2 +014300 77 CEEZE PICTURE X(5) VALUE "CCCCC". NC2114.2 +014400 01 SUBSCRIPT-6 PICTURE 99999 VALUE ZERO. NC2114.2 +014500 01 IF-TABLE. NC2114.2 +014600 02 IF-ELEM PICTURE X OCCURS 12 TIMES. NC2114.2 +014700 01 QUOTE-DATA. NC2114.2 +014800 02 QU-1 PICTURE X(3) VALUE "123". NC2114.2 +014900 02 QU-2 PICTURE X VALUE QUOTE. NC2114.2 +015000 02 QU-3 PICTURE X(6) VALUE "ABC456". NC2114.2 +015100 01 IF-D10. NC2114.2 +015200 02 D1 PICTURE X(2) VALUE "01". NC2114.2 +015300 02 D2 PICTURE X(2) VALUE "23". NC2114.2 +015400 02 D3. NC2114.2 +015500 03 D4 PICTURE X(4) VALUE "4567". NC2114.2 +015600 03 D5 PICTURE X(4) VALUE "8912". NC2114.2 +015700 01 IF-D12. NC2114.2 +015800 02 D1 PICTURE X(3) VALUE "ABC". NC2114.2 +015900 02 D2. NC2114.2 +016000 03 D3. NC2114.2 +016100 04 D4 PICTURE XX VALUE "DE". NC2114.2 +016200 04 D5 PICTURE X VALUE "F". NC2114.2 +016300 01 IF-D20. NC2114.2 +016400 02 FILLER PICTURE 9(5) VALUE ZERO. NC2114.2 +016500 02 D1 PICTURE 9(2) VALUE 12. NC2114.2 +016600 02 D2 PICTURE 9 VALUE 3. NC2114.2 +016700 02 D3 PICTURE 9(2) VALUE 45. NC2114.2 +016800 01 IF-D21. NC2114.2 +016900 02 D1 PICTURE 9(5) VALUE ZEROS. NC2114.2 +017000 02 D2 PICTURE 9(5) VALUE 12345. NC2114.2 +017100 01 IF-D22. NC2114.2 +017200 02 D1 PICTURE A(2) VALUE "AB". NC2114.2 +017300 02 D2 PICTURE A(4) VALUE "CDEF". NC2114.2 +017400 01 IF-D35. NC2114.2 +017500 02 AA PICTURE X(2). NC2114.2 +017600 88 A1 VALUE "AA". NC2114.2 +017700 88 A2 VALUE "AB". NC2114.2 +017800 02 BB PICTURE IS X(2). NC2114.2 +017900 88 B1 VALUE "CC". NC2114.2 +018000 88 B2 VALUE "CD". NC2114.2 +018100 02 BB-2 REDEFINES BB. NC2114.2 +018200 03 AAA PICTURE X. NC2114.2 +018300 88 AA1 VALUE "A". NC2114.2 +018400 88 AA2 VALUE "C". NC2114.2 +018500 03 BBB PICTURE X. NC2114.2 +018600 88 BB1 VALUE "B". NC2114.2 +018700 88 BB2 VALUE "D". NC2114.2 +018800 01 IF-D36 PICTURE X(120) VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYNC2114.2 +018900- "Z1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCDEFGHIJKLMNC2114.2 +019000- "NOPQRSTUVWXYZ1234567890ABCDEFGHIJKL". NC2114.2 +019100 01 IF-D40 PICTURE 9(5) VALUE 12345 NC2114.2 +019200 COMPUTATIONAL SYNCHRONIZED RIGHT. NC2114.2 +019300 88 IF-D40A VALUE ZERO THRU 10000. NC2114.2 +019400 88 IF-D40B VALUE 10001 THRU 99999. NC2114.2 +019500 88 IF-D40C VALUE 99999. NC2114.2 +019600 01 PERFORM1 PICTURE XXX VALUE SPACES. NC2114.2 +019700 01 PERFORM2 PICTURE S999 VALUE 20. NC2114.2 +019800 01 PERFORM3 PICTURE 9 VALUE 5. NC2114.2 +019900 01 PERFORM4 PICTURE S99V9. NC2114.2 +020000 01 PERFORM5 PICTURE S99V9 VALUE 10.0. NC2114.2 +020100 01 PERFORM6 PICTURE 99V9. NC2114.2 +020200 01 PERFORM7. NC2114.2 +020300 02 PERFORM8 OCCURS 7 TIMES PICTURE 99V9. NC2114.2 +020400 01 PERFORM9 PICTURE 9 VALUE 3. NC2114.2 +020500 01 PERFORM10 PICTURE S9 VALUE -1. NC2114.2 +020600 01 PERFORM11 PICTURE 99 VALUE 6. NC2114.2 +020700 01 PERFORM12. NC2114.2 +020800 02 PERFORM13 OCCURS 4 TIMES. NC2114.2 +020900 03 PERFORM14 OCCURS 20 TIMES PICTURE 99V9. NC2114.2 +021000 03 PERFORM15 OCCURS 10 TIMES. NC2114.2 +021100 04 PERFORM16 OCCURS 5 TIMES PICTURE 99V9. NC2114.2 +021200 01 PERFORM-KEY PICTURE 9. NC2114.2 +021300 01 RECEIVING-TABLE. NC2114.2 +021400 03 TBL-ELEMEN-A. NC2114.2 +021500 05 TBL-ELEMEN-B PICTURE X(18). NC2114.2 +021600 05 TBL-ELEMEN-C PICTURE X(18). NC2114.2 +021700 03 TBL-ELEMEN-D. NC2114.2 +021800 05 TBL-ELEMEN-E PICTURE X OCCURS 36 TIMES. NC2114.2 +021900 01 LITERAL-SPLITTER. NC2114.2 +022000 02 PART1 PICTURE X(20). NC2114.2 +022100 02 PART2 PICTURE X(20). NC2114.2 +022200 02 PART3 PICTURE X(20). NC2114.2 +022300 02 PART4 PICTURE X(20). NC2114.2 +022400 01 LITERAL-TABLE REDEFINES LITERAL-SPLITTER. NC2114.2 +022500 02 80PARTS PICTURE X OCCURS 80 TIMES. NC2114.2 +022600 01 GRP-FOR-88-LEVELS. NC2114.2 +022700 03 WRK-DS-02V00-COND PICTURE 99. NC2114.2 +022800 88 COND-1 VALUE IS 01 THRU 05. NC2114.2 +022900 88 COND-2 VALUES ARE 06 THRU 10 NC2114.2 +023000 16 THRU 20 00. NC2114.2 +023100 88 COND-3 VALUES 11 THRU 15. NC2114.2 +023200 01 GRP-MOVE-CONSTANTS. NC2114.2 +023300 03 GRP-GROUP-MOVE-FROM. NC2114.2 +023400 04 GRP-ALPHABETIC. NC2114.2 +023500 05 ALPHABET-AN-00026 PICTURE A(26) NC2114.2 +023600 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2114.2 +023700 04 GRP-NUMERIC. NC2114.2 +023800 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789. NC2114.2 +023900 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 NC2114.2 +024000 PICTURE 9(6)V9999. NC2114.2 +024100 04 GRP-ALPHANUMERIC. NC2114.2 +024200 05 ALPHANUMERIC-XN-00049 PICTURE X(50) NC2114.2 +024300 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-><=l,;.()/* 0123456789". NC2114.2 +024400 05 FILLER PICTURE X VALUE QUOTE. NC2114.2 +024500 01 GRP-FOR-2N058. NC2114.2 +024600 02 SUB-GRP-FOR-2N058-A. NC2114.2 +024700 03 ELEM-FOR-2N058-A PICTURE 999 VALUE ZEROES. NC2114.2 +024800 03 ELEM-FOR-2N058-B PICTURE XXX VALUE ZEROS. NC2114.2 +024900 03 ELEM-FOR-2N058-C PICTURE XXX VALUE SPACES. NC2114.2 +025000 03 ELEM-FOR-2N058-D PICTURE X(6) VALUE ALL "ABC". NC2114.2 +025100 03 ELEM-FOR-2N058-E PICTURE XXX VALUE ALL "Z". NC2114.2 +025200 03 ELEM-FOR-2N058-F PICTURE XXX VALUE ALL SPACES. NC2114.2 +025300 03 ELEM-FOR-2N058-G PICTURE XXX VALUE ALL ZEROES. NC2114.2 +025400 03 ELEM-FOR-2N058-H PICTURE 999 VALUE ALL ZEROS. NC2114.2 +025500 03 ELEM-FOR-2N058-I PICTURE XXX VALUE QUOTES. NC2114.2 +025600 03 ELEM-FOR-2N058-J PICTURE XXX VALUE ALL QUOTES. NC2114.2 +025700 03 ELEM-FOR-2N058-K PICTURE XXX VALUE ALL HIGH-VALUES. NC2114.2 +025800 03 ELEM-FOR-2N058-L PICTURE XXX VALUE ALL LOW-VALUES. NC2114.2 +025900 03 ELEM-FOR-2N058-M PICTURE XXX VALUE HIGH-VALUES. NC2114.2 +026000 03 ELEM-FOR-2N058-N PICTURE XXX VALUE LOW-VALUES. NC2114.2 +026100 02 SUB-GRP-FOR-2N058-B. NC2114.2 +026200 03 SUB-SUB-BA. NC2114.2 +026300 04 ELEM-FOR-2N058-A PICTURE 999. NC2114.2 +026400 04 ELEM-FOR-2N058-B PICTURE XXX. NC2114.2 +026500 04 ELEM-FOR-2N058-C PICTURE XXX. NC2114.2 +026600 04 ELEM-FOR-2N058-D PICTURE X(6). NC2114.2 +026700 03 SUB-SUB-BB. NC2114.2 +026800 04 ELEM-FOR-2N058-E PICTURE XXX. NC2114.2 +026900 04 ELEM-FOR-2N058-F PICTURE XXX. NC2114.2 +027000 04 ELEM-FOR-2N058-G PICTURE XXX. NC2114.2 +027100 04 ELEM-FOR-2N058-H PICTURE 999. NC2114.2 +027200 03 SUB-SUB-BC. NC2114.2 +027300 04 ELEM-FOR-2N058-I PICTURE XXX. NC2114.2 +027400 04 ELEM-FOR-2N058-J PICTURE XXX. NC2114.2 +027500 04 ELEM-FOR-2N058-K PICTURE XXX. NC2114.2 +027600 04 ELEM-FOR-2N058-L PICTURE XXX. NC2114.2 +027700 04 ELEM-FOR-2N058-M PICTURE XXX. NC2114.2 +027800 04 ELEM-FOR-2N058-N PICTURE XXX. NC2114.2 +027900 01 CHARACTER-BREAKDOWN-S. NC2114.2 +028000 02 FIRST-20S PICTURE X(20). NC2114.2 +028100 02 SECOND-20S PICTURE X(20). NC2114.2 +028200 02 THIRD-20S PICTURE X(20). NC2114.2 +028300 02 FOURTH-20S PICTURE X(20). NC2114.2 +028400 02 FIFTH-20S PICTURE X(20). NC2114.2 +028500 02 SIXTH-20S PICTURE X(20). NC2114.2 +028600 02 SEVENTH-20S PICTURE X(20). NC2114.2 +028700 02 EIGHTH-20S PICTURE X(20). NC2114.2 +028800 02 NINTH-20S PICTURE X(20). NC2114.2 +028900 02 TENTH-20S PICTURE X(20). NC2114.2 +029000 01 CHARACTER-BREAKDOWN-R. NC2114.2 +029100 02 FIRST-20R PICTURE X(20). NC2114.2 +029200 02 SECOND-20R PICTURE X(20). NC2114.2 +029300 02 THIRD-20R PICTURE X(20). NC2114.2 +029400 02 FOURTH-20R PICTURE X(20). NC2114.2 +029500 02 FIFTH-20R PICTURE X(20). NC2114.2 +029600 02 SIXTH-20R PICTURE X(20). NC2114.2 +029700 02 SEVENTH-20R PICTURE X(20). NC2114.2 +029800 02 EIGHTH-20R PICTURE X(20). NC2114.2 +029900 02 NINTH-20R PICTURE X(20). NC2114.2 +030000 02 TENTH-20R PICTURE X(20). NC2114.2 +030100 01 TABLE-80. NC2114.2 +030200 02 ELMT OCCURS 3 TIMES PIC 9. NC2114.2 +030300 88 A80 VALUES ARE ZERO THRU 7. NC2114.2 +030400 88 B80 VALUE 8. NC2114.2 +030500 88 C80 VALUES ARE 7, 8 THROUGH 9. NC2114.2 +030600 NC2114.2 +030700 01 TABLE-86. NC2114.2 +030800 88 A86 VALUE "ABC". NC2114.2 +030900 88 B86 VALUE "ABCABC". NC2114.2 +031000 88 C86 VALUE " ABC". NC2114.2 +031100 02 DATANAME-86 PIC XXX VALUE "ABC". NC2114.2 +031200 02 DNAME-86. NC2114.2 +031300 03 FILLER PIC X VALUE "A". NC2114.2 +031400 03 FILLER PIC X VALUE "B". NC2114.2 +031500 03 FILLER PIC X VALUE "C". NC2114.2 +031600*B1 DNAME-SWITCH PICTURE 9 VALUE 1. NC2114.2 +031700*B 88 ON-WRK-SWITCH-1 VALUE 1. NC2114.2 +031800*B 88 OFF-WRK-SWITCH-1 VALUE 0. NC2114.2 +031900*B1 DNAME-SWITCH2 PICTURE 9 VALUE 0. NC2114.2 +032000*B 88 ON-WRK-SWITCH-2 VALUE 1. NC2114.2 +032100*B 88 OFF-WRK-SWITCH-2 VALUE 0. NC2114.2 +032200 01 FIGCON-DATA. NC2114.2 +032300 02 SPACE-X PICTURE X(10) VALUE " ". NC2114.2 +032400 02 QUOTE-X PICTURE X(5) VALUE QUOTE. NC2114.2 +032500 02 LOW-VAL PICTURE X(5) VALUE LOW-VALUE. NC2114.2 +032600 02 ABC PICTURE XXX VALUE "ABC". NC2114.2 +032700 02 ONE23 PICTURE 9999 VALUE 123. NC2114.2 +032800 02 ZERO-C PICTURE 9(10) VALUE 0 COMPUTATIONAL. NC2114.2 +032900 02 ZERO-D PICTURE 9 VALUE ZERO USAGE DISPLAY. NC2114.2 +033000 01 XX-TALLY PIC S9(5) USAGE COMP. NC2114.2 +033100 01 TEST-RESULTS. NC2114.2 +033200 02 FILLER PIC X VALUE SPACE. NC2114.2 +033300 02 FEATURE PIC X(20) VALUE SPACE. NC2114.2 +033400 02 FILLER PIC X VALUE SPACE. NC2114.2 +033500 02 P-OR-F PIC X(5) VALUE SPACE. NC2114.2 +033600 02 FILLER PIC X VALUE SPACE. NC2114.2 +033700 02 PAR-NAME. NC2114.2 +033800 03 FILLER PIC X(19) VALUE SPACE. NC2114.2 +033900 03 PARDOT-X PIC X VALUE SPACE. NC2114.2 +034000 03 DOTVALUE PIC 99 VALUE ZERO. NC2114.2 +034100 02 FILLER PIC X(8) VALUE SPACE. NC2114.2 +034200 02 RE-MARK PIC X(61). NC2114.2 +034300 01 TEST-COMPUTED. NC2114.2 +034400 02 FILLER PIC X(30) VALUE SPACE. NC2114.2 +034500 02 FILLER PIC X(17) VALUE NC2114.2 +034600 " COMPUTED=". NC2114.2 +034700 02 COMPUTED-X. NC2114.2 +034800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2114.2 +034900 03 COMPUTED-N REDEFINES COMPUTED-A NC2114.2 +035000 PIC -9(9).9(9). NC2114.2 +035100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2114.2 +035200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2114.2 +035300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2114.2 +035400 03 CM-18V0 REDEFINES COMPUTED-A. NC2114.2 +035500 04 COMPUTED-18V0 PIC -9(18). NC2114.2 +035600 04 FILLER PIC X. NC2114.2 +035700 03 FILLER PIC X(50) VALUE SPACE. NC2114.2 +035800 01 TEST-CORRECT. NC2114.2 +035900 02 FILLER PIC X(30) VALUE SPACE. NC2114.2 +036000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2114.2 +036100 02 CORRECT-X. NC2114.2 +036200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2114.2 +036300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2114.2 +036400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2114.2 +036500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2114.2 +036600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2114.2 +036700 03 CR-18V0 REDEFINES CORRECT-A. NC2114.2 +036800 04 CORRECT-18V0 PIC -9(18). NC2114.2 +036900 04 FILLER PIC X. NC2114.2 +037000 03 FILLER PIC X(2) VALUE SPACE. NC2114.2 +037100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2114.2 +037200 01 CCVS-C-1. NC2114.2 +037300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2114.2 +037400- "SS PARAGRAPH-NAME NC2114.2 +037500- " REMARKS". NC2114.2 +037600 02 FILLER PIC X(20) VALUE SPACE. NC2114.2 +037700 01 CCVS-C-2. NC2114.2 +037800 02 FILLER PIC X VALUE SPACE. NC2114.2 +037900 02 FILLER PIC X(6) VALUE "TESTED". NC2114.2 +038000 02 FILLER PIC X(15) VALUE SPACE. NC2114.2 +038100 02 FILLER PIC X(4) VALUE "FAIL". NC2114.2 +038200 02 FILLER PIC X(94) VALUE SPACE. NC2114.2 +038300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2114.2 +038400 01 REC-CT PIC 99 VALUE ZERO. NC2114.2 +038500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2114.2 +038600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2114.2 +038700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2114.2 +038800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2114.2 +038900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2114.2 +039000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2114.2 +039100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2114.2 +039200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2114.2 +039300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2114.2 +039400 01 CCVS-H-1. NC2114.2 +039500 02 FILLER PIC X(39) VALUE SPACES. NC2114.2 +039600 02 FILLER PIC X(42) VALUE NC2114.2 +039700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2114.2 +039800 02 FILLER PIC X(39) VALUE SPACES. NC2114.2 +039900 01 CCVS-H-2A. NC2114.2 +040000 02 FILLER PIC X(40) VALUE SPACE. NC2114.2 +040100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2114.2 +040200 02 FILLER PIC XXXX VALUE NC2114.2 +040300 "4.2 ". NC2114.2 +040400 02 FILLER PIC X(28) VALUE NC2114.2 +040500 " COPY - NOT FOR DISTRIBUTION". NC2114.2 +040600 02 FILLER PIC X(41) VALUE SPACE. NC2114.2 +040700 NC2114.2 +040800 01 CCVS-H-2B. NC2114.2 +040900 02 FILLER PIC X(15) VALUE NC2114.2 +041000 "TEST RESULT OF ". NC2114.2 +041100 02 TEST-ID PIC X(9). NC2114.2 +041200 02 FILLER PIC X(4) VALUE NC2114.2 +041300 " IN ". NC2114.2 +041400 02 FILLER PIC X(12) VALUE NC2114.2 +041500 " HIGH ". NC2114.2 +041600 02 FILLER PIC X(22) VALUE NC2114.2 +041700 " LEVEL VALIDATION FOR ". NC2114.2 +041800 02 FILLER PIC X(58) VALUE NC2114.2 +041900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2114.2 +042000 01 CCVS-H-3. NC2114.2 +042100 02 FILLER PIC X(34) VALUE NC2114.2 +042200 " FOR OFFICIAL USE ONLY ". NC2114.2 +042300 02 FILLER PIC X(58) VALUE NC2114.2 +042400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2114.2 +042500 02 FILLER PIC X(28) VALUE NC2114.2 +042600 " COPYRIGHT 1985 ". NC2114.2 +042700 01 CCVS-E-1. NC2114.2 +042800 02 FILLER PIC X(52) VALUE SPACE. NC2114.2 +042900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2114.2 +043000 02 ID-AGAIN PIC X(9). NC2114.2 +043100 02 FILLER PIC X(45) VALUE SPACES. NC2114.2 +043200 01 CCVS-E-2. NC2114.2 +043300 02 FILLER PIC X(31) VALUE SPACE. NC2114.2 +043400 02 FILLER PIC X(21) VALUE SPACE. NC2114.2 +043500 02 CCVS-E-2-2. NC2114.2 +043600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2114.2 +043700 03 FILLER PIC X VALUE SPACE. NC2114.2 +043800 03 ENDER-DESC PIC X(44) VALUE NC2114.2 +043900 "ERRORS ENCOUNTERED". NC2114.2 +044000 01 CCVS-E-3. NC2114.2 +044100 02 FILLER PIC X(22) VALUE NC2114.2 +044200 " FOR OFFICIAL USE ONLY". NC2114.2 +044300 02 FILLER PIC X(12) VALUE SPACE. NC2114.2 +044400 02 FILLER PIC X(58) VALUE NC2114.2 +044500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2114.2 +044600 02 FILLER PIC X(13) VALUE SPACE. NC2114.2 +044700 02 FILLER PIC X(15) VALUE NC2114.2 +044800 " COPYRIGHT 1985". NC2114.2 +044900 01 CCVS-E-4. NC2114.2 +045000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2114.2 +045100 02 FILLER PIC X(4) VALUE " OF ". NC2114.2 +045200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2114.2 +045300 02 FILLER PIC X(40) VALUE NC2114.2 +045400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2114.2 +045500 01 XXINFO. NC2114.2 +045600 02 FILLER PIC X(19) VALUE NC2114.2 +045700 "*** INFORMATION ***". NC2114.2 +045800 02 INFO-TEXT. NC2114.2 +045900 04 FILLER PIC X(8) VALUE SPACE. NC2114.2 +046000 04 XXCOMPUTED PIC X(20). NC2114.2 +046100 04 FILLER PIC X(5) VALUE SPACE. NC2114.2 +046200 04 XXCORRECT PIC X(20). NC2114.2 +046300 02 INF-ANSI-REFERENCE PIC X(48). NC2114.2 +046400 01 HYPHEN-LINE. NC2114.2 +046500 02 FILLER PIC IS X VALUE IS SPACE. NC2114.2 +046600 02 FILLER PIC IS X(65) VALUE IS "************************NC2114.2 +046700- "*****************************************". NC2114.2 +046800 02 FILLER PIC IS X(54) VALUE IS "************************NC2114.2 +046900- "******************************". NC2114.2 +047000 01 CCVS-PGM-ID PIC X(9) VALUE NC2114.2 +047100 "NC211A". NC2114.2 +047200 PROCEDURE DIVISION. NC2114.2 +047300 CCVS1 SECTION. NC2114.2 +047400 OPEN-FILES. NC2114.2 +047500 OPEN OUTPUT PRINT-FILE. NC2114.2 +047600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2114.2 +047700 MOVE SPACE TO TEST-RESULTS. NC2114.2 +047800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2114.2 +047900 GO TO CCVS1-EXIT. NC2114.2 +048000 CLOSE-FILES. NC2114.2 +048100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2114.2 +048200 TERMINATE-CCVS. NC2114.2 +048300*S EXIT PROGRAM. NC2114.2 +048400*SERMINATE-CALL. NC2114.2 +048500 STOP RUN. NC2114.2 +048600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2114.2 +048700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2114.2 +048800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2114.2 +048900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2114.2 +049000 MOVE "****TEST DELETED****" TO RE-MARK. NC2114.2 +049100 PRINT-DETAIL. NC2114.2 +049200 IF REC-CT NOT EQUAL TO ZERO NC2114.2 +049300 MOVE "." TO PARDOT-X NC2114.2 +049400 MOVE REC-CT TO DOTVALUE. NC2114.2 +049500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2114.2 +049600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2114.2 +049700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2114.2 +049800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2114.2 +049900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2114.2 +050000 MOVE SPACE TO CORRECT-X. NC2114.2 +050100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2114.2 +050200 MOVE SPACE TO RE-MARK. NC2114.2 +050300 HEAD-ROUTINE. NC2114.2 +050400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +050500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +050600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2114.2 +050700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2114.2 +050800 COLUMN-NAMES-ROUTINE. NC2114.2 +050900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +051000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +051100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +051200 END-ROUTINE. NC2114.2 +051300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2114.2 +051400 END-RTN-EXIT. NC2114.2 +051500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +051600 END-ROUTINE-1. NC2114.2 +051700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2114.2 +051800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2114.2 +051900 ADD PASS-COUNTER TO ERROR-HOLD. NC2114.2 +052000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2114.2 +052100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2114.2 +052200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2114.2 +052300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2114.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2114.2 +052500 END-ROUTINE-12. NC2114.2 +052600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2114.2 +052700 IF ERROR-COUNTER IS EQUAL TO ZERO NC2114.2 +052800 MOVE "NO " TO ERROR-TOTAL NC2114.2 +052900 ELSE NC2114.2 +053000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2114.2 +053100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2114.2 +053200 PERFORM WRITE-LINE. NC2114.2 +053300 END-ROUTINE-13. NC2114.2 +053400 IF DELETE-COUNTER IS EQUAL TO ZERO NC2114.2 +053500 MOVE "NO " TO ERROR-TOTAL ELSE NC2114.2 +053600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2114.2 +053700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2114.2 +053800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +053900 IF INSPECT-COUNTER EQUAL TO ZERO NC2114.2 +054000 MOVE "NO " TO ERROR-TOTAL NC2114.2 +054100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2114.2 +054200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2114.2 +054300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +054400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2114.2 +054500 WRITE-LINE. NC2114.2 +054600 ADD 1 TO RECORD-COUNT. NC2114.2 +054700 IF RECORD-COUNT GREATER 50 NC2114.2 +054800 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2114.2 +054900 MOVE SPACE TO DUMMY-RECORD NC2114.2 +055000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2114.2 +055100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2114.2 +055200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2114.2 +055300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2114.2 +055400 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2114.2 +055500 MOVE ZERO TO RECORD-COUNT. NC2114.2 +055600 PERFORM WRT-LN. NC2114.2 +055700 WRT-LN. NC2114.2 +055800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2114.2 +055900 MOVE SPACE TO DUMMY-RECORD. NC2114.2 +056000 BLANK-LINE-PRINT. NC2114.2 +056100 PERFORM WRT-LN. NC2114.2 +056200 FAIL-ROUTINE. NC2114.2 +056300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2114.2 +056400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2114.2 +056500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2114.2 +056600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2114.2 +056700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +056800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2114.2 +056900 GO TO FAIL-ROUTINE-EX. NC2114.2 +057000 FAIL-ROUTINE-WRITE. NC2114.2 +057100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2114.2 +057200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2114.2 +057300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2114.2 +057400 MOVE SPACES TO COR-ANSI-REFERENCE. NC2114.2 +057500 FAIL-ROUTINE-EX. EXIT. NC2114.2 +057600 BAIL-OUT. NC2114.2 +057700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2114.2 +057800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2114.2 +057900 BAIL-OUT-WRITE. NC2114.2 +058000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2114.2 +058100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2114.2 +058200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2114.2 +058300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2114.2 +058400 BAIL-OUT-EX. EXIT. NC2114.2 +058500 CCVS1-EXIT. NC2114.2 +058600 EXIT. NC2114.2 +058700 SECT-NC211A-001 SECTION. NC2114.2 +058800 NC-211A-001. NC2114.2 +058900 CC--INIT-GF-1. NC2114.2 +059000 MOVE "CC--TEST-GF-1 " TO PAR-NAME. NC2114.2 +059100 MOVE "COMPOUND CONDITIONS" TO FEATURE. NC2114.2 +059200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +059300 PERFORM PRINT-DETAIL. NC2114.2 +059400 MOVE " NOT ABBREVIATED " TO FEATURE. NC2114.2 +059500 MOVE 11 TO CCON-1. NC2114.2 +059600 MOVE 12 TO CCON-2. NC2114.2 +059700 MOVE 13 TO CCON-3. NC2114.2 +059800 CC--TEST-GF-1. NC2114.2 +059900 IF CCON-1 IS LESS THAN CCON-2 AND CCON-3 IS GREATER THAN 10 NC2114.2 +060000 PERFORM PASS NC2114.2 +060100 GO TO CC--WRITE-GF-1. NC2114.2 +060200 GO TO CC--FAIL-GF-1. NC2114.2 +060300 CC--DELETE-GF-1. NC2114.2 +060400 PERFORM DE-LETE. NC2114.2 +060500 GO TO CC--WRITE-GF-1. NC2114.2 +060600 CC--FAIL-GF-1. NC2114.2 +060700 PERFORM FAIL. NC2114.2 +060800 CC--WRITE-GF-1. NC2114.2 +060900 PERFORM PRINT-DETAIL. NC2114.2 +061000* NC2114.2 +061100 CC--INIT-GF-2. NC2114.2 +061200 MOVE "CC--TEST-GF-2 " TO PAR-NAME. NC2114.2 +061300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +061400 MOVE 11 TO CCON-1. NC2114.2 +061500 MOVE 12 TO CCON-2. NC2114.2 +061600 MOVE 13 TO CCON-3. NC2114.2 +061700 CC--TEST-GF-2. NC2114.2 +061800 IF CCON-2 GREATER THAN CCON-1 AND 20 LESS THAN CCON-3 NC2114.2 +061900 GO TO CC--FAIL-GF-2. NC2114.2 +062000 PERFORM PASS. NC2114.2 +062100 GO TO CC--WRITE-GF-2. NC2114.2 +062200 CC--DELETE-GF-2. NC2114.2 +062300 PERFORM DE-LETE. NC2114.2 +062400 GO TO CC--WRITE-GF-2. NC2114.2 +062500 CC--FAIL-GF-2. NC2114.2 +062600 PERFORM FAIL. NC2114.2 +062700 CC--WRITE-GF-2. NC2114.2 +062800 PERFORM PRINT-DETAIL. NC2114.2 +062900* NC2114.2 +063000 CC--INIT-GF-3. NC2114.2 +063100 MOVE "CC--TEST-GF-3 " TO PAR-NAME. NC2114.2 +063200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +063300 MOVE 11 TO CCON-1. NC2114.2 +063400 MOVE 12 TO CCON-2. NC2114.2 +063500 MOVE 13 TO CCON-3. NC2114.2 +063600 CC--TEST-GF-3. NC2114.2 +063700 IF CCON-1 GREATER THAN CCON-2 AND 20 GREATER THAN CCON-3 NC2114.2 +063800 GO TO CC--FAIL-GF-3. NC2114.2 +063900 PERFORM PASS. NC2114.2 +064000 GO TO CC--WRITE-GF-3. NC2114.2 +064100 CC--DELETE-GF-3. NC2114.2 +064200 PERFORM DE-LETE. NC2114.2 +064300 GO TO CC--WRITE-GF-3. NC2114.2 +064400 CC--FAIL-GF-3. NC2114.2 +064500 PERFORM FAIL. NC2114.2 +064600 CC--WRITE-GF-3. NC2114.2 +064700 PERFORM PRINT-DETAIL. NC2114.2 +064800* NC2114.2 +064900 CC--INIT-GF-4. NC2114.2 +065000 MOVE "CC--TEST-GF-4 " TO PAR-NAME. NC2114.2 +065100 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +065200 MOVE 11 TO CCON-1. NC2114.2 +065300 MOVE 13 TO CCON-3. NC2114.2 +065400 CC--TEST-GF-4. NC2114.2 +065500 IF CCON-1 GREATER THAN 10 OR 20 LESS THAN CCON-3 NC2114.2 +065600 PERFORM PASS NC2114.2 +065700 GO TO CC--WRITE-GF-4. NC2114.2 +065800 GO TO CC--FAIL-GF-4. NC2114.2 +065900 CC--DELETE-GF-4. NC2114.2 +066000 PERFORM DE-LETE. NC2114.2 +066100 GO TO CC--WRITE-GF-4. NC2114.2 +066200 CC--FAIL-GF-4. NC2114.2 +066300 PERFORM FAIL. NC2114.2 +066400 CC--WRITE-GF-4. NC2114.2 +066500 PERFORM PRINT-DETAIL. NC2114.2 +066600* NC2114.2 +066700 CC--INIT-GF-5. NC2114.2 +066800 MOVE "CC--TEST-GF-5 " TO PAR-NAME. NC2114.2 +066900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +067000 MOVE 11 TO CCON-1. NC2114.2 +067100 MOVE 12 TO CCON-2. NC2114.2 +067200 MOVE 13 TO CCON-3. NC2114.2 +067300 CC--TEST-GF-5. NC2114.2 +067400 IF CCON-3 LESS THAN CCON-2 OR 20 GREATER THAN CCON-1 NC2114.2 +067500 PERFORM PASS NC2114.2 +067600 GO TO CC--WRITE-GF-5. NC2114.2 +067700 GO TO CC--FAIL-GF-5. NC2114.2 +067800 CC--DELETE-GF-5. NC2114.2 +067900 PERFORM DE-LETE. NC2114.2 +068000 GO TO CC--WRITE-GF-5. NC2114.2 +068100 CC--FAIL-GF-5. NC2114.2 +068200 PERFORM FAIL. NC2114.2 +068300 CC--WRITE-GF-5. NC2114.2 +068400 PERFORM PRINT-DETAIL. NC2114.2 +068500* NC2114.2 +068600 CC--INIT-GF-6. NC2114.2 +068700 MOVE "CC--TEST-GF-6 " TO PAR-NAME. NC2114.2 +068800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +068900 MOVE 11 TO CCON-1. NC2114.2 +069000 MOVE 12 TO CCON-2. NC2114.2 +069100 MOVE 13 TO CCON-3. NC2114.2 +069200 CC--TEST-GF-6. NC2114.2 +069300 IF CCON-1 EQUAL TO 11 AND CCON-3 GREATER THAN 12 OR CCON-2 NC2114.2 +069400 LESS THAN 20 AND CCON-1 GREATER THAN 12 NC2114.2 +069500 PERFORM PASS NC2114.2 +069600 GO TO CC--WRITE-GF-6. NC2114.2 +069700 GO TO CC--FAIL-GF-6. NC2114.2 +069800 CC--DELETE-GF-6. NC2114.2 +069900 PERFORM DE-LETE. NC2114.2 +070000 GO TO CC--WRITE-GF-6. NC2114.2 +070100 CC--FAIL-GF-6. NC2114.2 +070200 PERFORM FAIL. NC2114.2 +070300 CC--WRITE-GF-6. NC2114.2 +070400 PERFORM PRINT-DETAIL. NC2114.2 +070500* NC2114.2 +070600 CC--INIT-GF-7. NC2114.2 +070700 MOVE "CC--TEST-GF-7 " TO PAR-NAME. NC2114.2 +070800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +070900 MOVE 11 TO CCON-1. NC2114.2 +071000 MOVE 12 TO CCON-2. NC2114.2 +071100 MOVE 13 TO CCON-3. NC2114.2 +071200 CC--TEST-GF-7. NC2114.2 +071300 IF CCON-1 LESS THAN 9 AND CCON-3 GREATER THAN 12 OR CCON-2 NC2114.2 +071400 GREATER THAN 10 AND CCON-1 GREATER THAN 8 NC2114.2 +071500 PERFORM PASS NC2114.2 +071600 GO TO CC--WRITE-GF-7. NC2114.2 +071700 GO TO CC--FAIL-GF-7. NC2114.2 +071800 CC--DELETE-GF-7. NC2114.2 +071900 PERFORM DE-LETE. NC2114.2 +072000 GO TO CC--WRITE-GF-7. NC2114.2 +072100 CC--FAIL-GF-7. NC2114.2 +072200 PERFORM FAIL. NC2114.2 +072300 CC--WRITE-GF-7. NC2114.2 +072400 PERFORM PRINT-DETAIL. NC2114.2 +072500* NC2114.2 +072600 CC--INIT-GF-8. NC2114.2 +072700 MOVE "CC--TEST-GF-8 " TO PAR-NAME. NC2114.2 +072800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +072900 MOVE 11 TO CCON-1. NC2114.2 +073000 MOVE 12 TO CCON-2. NC2114.2 +073100 CC--TEST-GF-8. NC2114.2 +073200 IF CCON-1 NOT EQUAL TO 11 OR CCON-2 NOT LESS THAN 10 NC2114.2 +073300 PERFORM PASS ELSE PERFORM FAIL. NC2114.2 +073400 GO TO CC--WRITE-GF-8. NC2114.2 +073500 CC--DELETE-GF-8. NC2114.2 +073600 PERFORM DE-LETE. NC2114.2 +073700 GO TO CC--WRITE-GF-8. NC2114.2 +073800 CC--FAIL-GF-8. NC2114.2 +073900 PERFORM FAIL. NC2114.2 +074000 CC--WRITE-GF-8. NC2114.2 +074100 PERFORM PRINT-DETAIL. NC2114.2 +074200* NC2114.2 +074300 CC--INIT-GF-9. NC2114.2 +074400 MOVE "CC--TEST-GF-9 " TO PAR-NAME. NC2114.2 +074500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +074600 MOVE 11 TO CCON-1. NC2114.2 +074700 MOVE 12 TO CCON-2. NC2114.2 +074800 MOVE 13 TO CCON-3. NC2114.2 +074900 CC--TEST-GF-9. NC2114.2 +075000 IF CCON-2 NOT EQUAL TO CCON-3 AND CCON-1 NOT GREATER THAN 12 NC2114.2 +075100 PERFORM PASS NC2114.2 +075200 GO TO CC--WRITE-GF-9. NC2114.2 +075300 GO TO CC--FAIL-GF-9. NC2114.2 +075400 CC--DELETE-GF-9. NC2114.2 +075500 PERFORM DE-LETE. NC2114.2 +075600 GO TO CC--WRITE-GF-9. NC2114.2 +075700 CC--FAIL-GF-9. NC2114.2 +075800 PERFORM FAIL. NC2114.2 +075900 CC--WRITE-GF-9. NC2114.2 +076000 PERFORM PRINT-DETAIL. NC2114.2 +076100* NC2114.2 +076200 CC--INIT-GF-10. NC2114.2 +076300 MOVE "CC--TEST-GF-10" TO PAR-NAME. NC2114.2 +076400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +076500 MOVE 12 TO CCON-2. NC2114.2 +076600 MOVE 13 TO CCON-3. NC2114.2 +076700 CC--TEST-GF-10. NC2114.2 +076800 IF CCON-3 NOT EQUAL TO 13 OR CCON-2 NOT LESS THAN 13 NC2114.2 +076900 GO TO CC--FAIL-GF-10. NC2114.2 +077000 PERFORM PASS. NC2114.2 +077100 GO TO CC--WRITE-GF-10. NC2114.2 +077200 CC--DELETE-GF-10. NC2114.2 +077300 PERFORM DE-LETE. NC2114.2 +077400 GO TO CC--WRITE-GF-10. NC2114.2 +077500 CC--FAIL-GF-10. NC2114.2 +077600 PERFORM FAIL. NC2114.2 +077700 CC--WRITE-GF-10. NC2114.2 +077800 PERFORM PRINT-DETAIL. NC2114.2 +077900* NC2114.2 +078000 CC--INIT-GF-11. NC2114.2 +078100 MOVE "CC--TEST-GF-11" TO PAR-NAME. NC2114.2 +078200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +078300 MOVE " ABBREVIATED " TO FEATURE. NC2114.2 +078400 MOVE 13 TO CCON-3. NC2114.2 +078500 CC--TEST-GF-11. NC2114.2 +078600 IF CCON-3 NOT EQUAL TO 12 AND GREATER THAN 10 NC2114.2 +078700 PERFORM PASS NC2114.2 +078800 GO TO CC--WRITE-GF-11. NC2114.2 +078900 GO TO CC--FAIL-GF-11. NC2114.2 +079000 CC--DELETE-GF-11. NC2114.2 +079100 PERFORM DE-LETE. NC2114.2 +079200 GO TO CC--WRITE-GF-11. NC2114.2 +079300 CC--FAIL-GF-11. NC2114.2 +079400 PERFORM FAIL. NC2114.2 +079500 CC--WRITE-GF-11. NC2114.2 +079600 PERFORM PRINT-DETAIL. NC2114.2 +079700* NC2114.2 +079800 CC--INIT-GF-12. NC2114.2 +079900 MOVE "CC--TEST-GF-12" TO PAR-NAME. NC2114.2 +080000 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +080100 MOVE 12 TO CCON-2. NC2114.2 +080200 CC--TEST-GF-12. NC2114.2 +080300 IF CCON-2 LESS THAN 10 OR EQUAL TO 12 PERFORM PASS NC2114.2 +080400 GO TO CC--WRITE-GF-12. NC2114.2 +080500 GO TO CC--FAIL-GF-12. NC2114.2 +080600 CC--DELETE-GF-12. NC2114.2 +080700 PERFORM DE-LETE. NC2114.2 +080800 GO TO CC--WRITE-GF-12. NC2114.2 +080900 CC--FAIL-GF-12. NC2114.2 +081000 PERFORM FAIL. NC2114.2 +081100 CC--WRITE-GF-12. NC2114.2 +081200 PERFORM PRINT-DETAIL. NC2114.2 +081300* NC2114.2 +081400 CC--INIT-GF-13. NC2114.2 +081500 MOVE "CC--TEST-GF-13" TO PAR-NAME. NC2114.2 +081600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +081700 MOVE 11 TO CCON-1. NC2114.2 +081800 MOVE 12 TO CCON-2. NC2114.2 +081900 CC--TEST-GF-13. NC2114.2 +082000 IF CCON-1 EQUAL TO CCON-2 OR 10 OR 11 PERFORM PASS NC2114.2 +082100 GO TO CC--WRITE-GF-13. NC2114.2 +082200 GO TO CC--FAIL-GF-13. NC2114.2 +082300 CC--DELETE-GF-13. NC2114.2 +082400 PERFORM DE-LETE. NC2114.2 +082500 GO TO CC--WRITE-GF-13. NC2114.2 +082600 CC--FAIL-GF-13. NC2114.2 +082700 PERFORM FAIL. NC2114.2 +082800 CC--WRITE-GF-13. NC2114.2 +082900 PERFORM PRINT-DETAIL. NC2114.2 +083000* NC2114.2 +083100 CC--INIT-GF-14. NC2114.2 +083200 MOVE "CC--TEST-GF-14" TO PAR-NAME. NC2114.2 +083300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +083400 MOVE 11 TO CCON-1. NC2114.2 +083500 MOVE 12 TO CCON-2. NC2114.2 +083600 MOVE 13 TO CCON-3. NC2114.2 +083700 CC--TEST-GF-14. NC2114.2 +083800 IF CCON-2 GREATER THAN CCON-3 OR EQUAL TO CCON-1 OR 8 OR NC2114.2 +083900 CCON-3 - 1; PERFORM PASS NC2114.2 +084000 GO TO CC--WRITE-GF-14. NC2114.2 +084100 GO TO CC--FAIL-GF-14. NC2114.2 +084200 CC--DELETE-GF-14. NC2114.2 +084300 PERFORM DE-LETE. NC2114.2 +084400 GO TO CC--WRITE-GF-14. NC2114.2 +084500 CC--FAIL-GF-14. NC2114.2 +084600 PERFORM FAIL. NC2114.2 +084700 CC--WRITE-GF-14. NC2114.2 +084800 PERFORM PRINT-DETAIL. NC2114.2 +084900* NC2114.2 +085000 CC--INIT-GF-15. NC2114.2 +085100 MOVE "CC--TEST-GF-15" TO PAR-NAME. NC2114.2 +085200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +085300 MOVE "ABCDEF" TO IF-D11. NC2114.2 +085400 MOVE "ABC" TO D1 OF IF-D12. NC2114.2 +085500 MOVE "DE" TO D4 OF IF-D12. NC2114.2 +085600 MOVE "F" TO D5 OF IF-D12. NC2114.2 +085700 MOVE "AB" TO D1 OF IF-D22. NC2114.2 +085800 MOVE "CDEF" TO D2 OF IF-D22. NC2114.2 +085900 CC--TEST-GF-15. NC2114.2 +086000 IF IF-D11 EQUAL TO IF-D12 OR IF-D22 AND "ABCDEF" NC2114.2 +086100 PERFORM PASS NC2114.2 +086200 GO TO CC--WRITE-GF-15. NC2114.2 +086300 GO TO CC--FAIL-GF-15. NC2114.2 +086400 CC--DELETE-GF-15. NC2114.2 +086500 PERFORM DE-LETE. NC2114.2 +086600 GO TO CC--WRITE-GF-15. NC2114.2 +086700 CC--FAIL-GF-15. NC2114.2 +086800 PERFORM FAIL. NC2114.2 +086900 CC--WRITE-GF-15. NC2114.2 +087000 PERFORM PRINT-DETAIL. NC2114.2 +087100* NC2114.2 +087200 CC--INIT-GF-16. NC2114.2 +087300 MOVE "CC--TEST-GF-16" TO PAR-NAME. NC2114.2 +087400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +087500 MOVE "ABCDEF" TO IF-D11. NC2114.2 +087600 MOVE "ABC" TO D1 OF IF-D12. NC2114.2 +087700 MOVE "DE" TO D4 OF IF-D12. NC2114.2 +087800 MOVE "F" TO D5 OF IF-D12. NC2114.2 +087900 MOVE "AB" TO D1 OF IF-D22. NC2114.2 +088000 MOVE "CDEF" TO D2 OF IF-D22. NC2114.2 +088100 CC--TEST-GF-16. NC2114.2 +088200 IF IF-D11 NOT EQUAL TO IF-D12 AND IF-D22 OR "ABCDEF" NC2114.2 +088300 PERFORM FAIL NC2114.2 +088400 GO TO CC--WRITE-GF-16. NC2114.2 +088500 GO TO CC--PASS-GF-16. NC2114.2 +088600 CC--DELETE-GF-16. NC2114.2 +088700 PERFORM DE-LETE. NC2114.2 +088800 GO TO CC--WRITE-GF-16. NC2114.2 +088900 CC--PASS-GF-16. NC2114.2 +089000 PERFORM PASS. NC2114.2 +089100 CC--WRITE-GF-16. NC2114.2 +089200 PERFORM PRINT-DETAIL. NC2114.2 +089300* NC2114.2 +089400 CC--INIT-GF-17. NC2114.2 +089500 MOVE "CC--TEST-GF-17" TO PAR-NAME. NC2114.2 +089600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +089700 MOVE +123.45 TO IF-D7. NC2114.2 +089800 MOVE 12300 TO IF-D13. NC2114.2 +089900 MOVE 2137.45 TO IF-D27. NC2114.2 +090000 MOVE 2137.45 TO IF-D28. NC2114.2 +090100 CC--TEST-GF-17. NC2114.2 +090200 IF IF-D27 GREATER THAN IF-D13 OR (IF-D27 IS EQUAL TO IF-D28 NC2114.2 +090300 AND IF-D27 NOT LESS THAN IF-D7) PERFORM PASS NC2114.2 +090400 GO TO CC--WRITE-GF-17. NC2114.2 +090500 GO TO CC--FAIL-GF-17. NC2114.2 +090600 CC--DELETE-GF-17. NC2114.2 +090700 PERFORM DE-LETE. NC2114.2 +090800 GO TO CC--WRITE-GF-17. NC2114.2 +090900 CC--FAIL-GF-17. NC2114.2 +091000 PERFORM FAIL. NC2114.2 +091100 CC--WRITE-GF-17. NC2114.2 +091200 PERFORM PRINT-DETAIL. NC2114.2 +091300* NC2114.2 +091400 CC--INIT-GF-18. NC2114.2 +091500 MOVE "CC--TEST-GF-18" TO PAR-NAME. NC2114.2 +091600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +091700 MOVE 11 TO CCON-1. NC2114.2 +091800 MOVE 12 TO CCON-2. NC2114.2 +091900 MOVE 13 TO CCON-3. NC2114.2 +092000 CC--TEST-GF-18. NC2114.2 +092100 IF CCON-2 GREATER THAN CCON-1 AND NOT GREATER THAN CCON-3 OR NC2114.2 +092200 CCON-1 PERFORM PASS NC2114.2 +092300 GO TO CC--WRITE-GF-18. NC2114.2 +092400 GO TO CC--FAIL-GF-18. NC2114.2 +092500* NOTE THE STANDARD SAYS THAT THE ABOVE IS EQUIVALENT TO --- NC2114.2 +092600* IF CCON-2 GREATER THAN CCON-1 AND CCON-2 NOT GREATER THANNC2114.2 +092700* CCON-3 OR CCON-2 NOT GREATER THAN CCON-1 PERFORM PASS NC2114.2 +092800* ELSE PERFORM FAIL. NC2114.2 +092900 CC--DELETE-GF-18. NC2114.2 +093000 PERFORM DE-LETE. NC2114.2 +093100 GO TO CC--WRITE-GF-18. NC2114.2 +093200 CC--FAIL-GF-18. NC2114.2 +093300 PERFORM FAIL. NC2114.2 +093400 CC--WRITE-GF-18. NC2114.2 +093500 PERFORM PRINT-DETAIL. NC2114.2 +093600* NC2114.2 +093700 CC--INIT-GF-19. NC2114.2 +093800 MOVE "CC--TEST-GF-19" TO PAR-NAME. NC2114.2 +093900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +094000 MOVE " ABBREV. W/PARENS " TO FEATURE. NC2114.2 +094100 MOVE 11 TO CCON-1. NC2114.2 +094200 MOVE 12 TO CCON-2. NC2114.2 +094300 MOVE 13 TO CCON-3. NC2114.2 +094400 CC--TEST-GF-19. NC2114.2 +094500 IF CCON-1 NOT LESS THAN 9 AND (CCON-3 GREATER THAN 12 OR NC2114.2 +094600 CCON-2 GREATER THAN 10) AND CCON-1 GREATER THAN 8 NC2114.2 +094700 PERFORM PASS NC2114.2 +094800 GO TO CC--WRITE-GF-19. NC2114.2 +094900 GO TO CC--FAIL-GF-19. NC2114.2 +095000 CC--DELETE-GF-19. NC2114.2 +095100 PERFORM DE-LETE. NC2114.2 +095200 GO TO CC--WRITE-GF-19. NC2114.2 +095300 CC--FAIL-GF-19. NC2114.2 +095400 PERFORM FAIL. NC2114.2 +095500 CC--WRITE-GF-19. NC2114.2 +095600 PERFORM PRINT-DETAIL. NC2114.2 +095700* NC2114.2 +095800 CC--INIT-GF-20. NC2114.2 +095900 MOVE "CC--TEST-GF-20" TO PAR-NAME. NC2114.2 +096000 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +096100 MOVE " ABBREV. W/PARENS " TO FEATURE. NC2114.2 +096200 MOVE 0 TO IF-D1. NC2114.2 +096300 MOVE ZERO TO IF-D2. NC2114.2 +096400 MOVE " " TO IF-D4. NC2114.2 +096500 MOVE .0012 TO IF-D16. NC2114.2 +096600 MOVE .0012 TO IF-D17. NC2114.2 +096700 MOVE 12 TO D1 OF IF-D20. NC2114.2 +096800 MOVE 3 TO D2 OF IF-D20. NC2114.2 +096900 MOVE 45 TO D3 OF IF-D20. NC2114.2 +097000 MOVE ZEROS TO D1 OF IF-D21. NC2114.2 +097100 MOVE 12345 TO D2 OF IF-D21. NC2114.2 +097200 CC--TEST-GF-20. NC2114.2 +097300 IF IF-D4 EQUAL TO ZEROS OR (IF-D1 NOT LESS THAN NC2114.2 +097400 IF-D2 AND (IF-D16 GREATER THAN IF-D17 OR IF-D20 EQUAL TO NC2114.2 +097500 IF-D21)) PERFORM PASS NC2114.2 +097600 GO TO CC--WRITE-GF-20. NC2114.2 +097700 GO TO CC--FAIL-GF-20. NC2114.2 +097800 CC--DELETE-GF-20. NC2114.2 +097900 PERFORM DE-LETE. NC2114.2 +098000 GO TO CC--WRITE-GF-20. NC2114.2 +098100 CC--FAIL-GF-20. NC2114.2 +098200 PERFORM FAIL. NC2114.2 +098300 CC--WRITE-GF-20. NC2114.2 +098400 PERFORM PRINT-DETAIL. NC2114.2 +098500* NC2114.2 +098600 CC--INIT-GF-21. NC2114.2 +098700 MOVE "CC--TEST-GF-21" TO PAR-NAME. NC2114.2 +098800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +098900 MOVE " NESTED IF " TO FEATURE. NC2114.2 +099000 MOVE .0012 TO IF-D16. NC2114.2 +099100 MOVE .0012 TO IF-D17. NC2114.2 +099200 MOVE 12 TO D1 OF IF-D20. NC2114.2 +099300 MOVE 3 TO D2 OF IF-D20. NC2114.2 +099400 MOVE 45 TO D3 OF IF-D20. NC2114.2 +099500 MOVE ZEROS TO D1 OF IF-D21. NC2114.2 +099600 MOVE 12345 TO D2 OF IF-D21. NC2114.2 +099700 CC--TEST-GF-21. NC2114.2 +099800 IF IF-D20 NOT LESS THAN IF-D21 NC2114.2 +099900 IF IF-D16 EQUAL TO IF-D17 NC2114.2 +100000 PERFORM PASS NC2114.2 +100100 GO TO CC--WRITE-GF-21 NC2114.2 +100200 ELSE NC2114.2 +100300 PERFORM CC--FAIL-GF-21 NC2114.2 +100400 ELSE NC2114.2 +100500 NEXT SENTENCE. NC2114.2 +100600 GO TO CC--FAIL-GF-21. NC2114.2 +100700 CC--DELETE-GF-21. NC2114.2 +100800 PERFORM DE-LETE. NC2114.2 +100900 GO TO CC--WRITE-GF-21. NC2114.2 +101000 CC--FAIL-GF-21. NC2114.2 +101100 PERFORM FAIL. NC2114.2 +101200 CC--WRITE-GF-21. NC2114.2 +101300 PERFORM PRINT-DETAIL. NC2114.2 +101400* NC2114.2 +101500 CC--INIT-GF-22. NC2114.2 +101600 MOVE "CC--TEST-GF-22" TO PAR-NAME. NC2114.2 +101700 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +101800 MOVE " NESTED IF " TO FEATURE. NC2114.2 +101900 MOVE 12 TO D1 OF IF-D20. NC2114.2 +102000 MOVE 3 TO D2 OF IF-D20. NC2114.2 +102100 MOVE 45 TO D3 OF IF-D20. NC2114.2 +102200 MOVE ZEROS TO D1 OF IF-D21. NC2114.2 +102300 MOVE 12345 TO D2 OF IF-D21. NC2114.2 +102400 CC--TEST-GF-22. NC2114.2 +102500 IF IF-D20 NOT EQUAL TO IF-D21 NC2114.2 +102600 NEXT SENTENCE NC2114.2 +102700 ELSE NC2114.2 +102800 IF IF-D20 NOT GREATER THAN IF-D21 NC2114.2 +102900 PERFORM PASS NC2114.2 +103000 GO TO CC--WRITE-GF-22 NC2114.2 +103100 ELSE NC2114.2 +103200 GO TO CC--FAIL-GF-22. NC2114.2 +103300* NC2114.2 +103400 GO TO CC--FAIL-GF-22. NC2114.2 +103500 CC--DELETE-GF-22. NC2114.2 +103600 PERFORM DE-LETE. NC2114.2 +103700 GO TO CC--WRITE-GF-22. NC2114.2 +103800 CC--FAIL-GF-22. NC2114.2 +103900 PERFORM FAIL. NC2114.2 +104000 CC--WRITE-GF-22. NC2114.2 +104100 PERFORM PRINT-DETAIL. NC2114.2 +104200* NC2114.2 +104300 CC--INIT-GF-23. NC2114.2 +104400 MOVE "CC--TEST-GF-23" TO PAR-NAME. NC2114.2 +104500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +104600 MOVE " NESTED IF " TO FEATURE. NC2114.2 +104700 MOVE "X" TO WRK-XN-00001. NC2114.2 +104800 MOVE ZERO TO WRK-DS-01V00. NC2114.2 +104900 MOVE 1 TO XX-TALLY. NC2114.2 +105000 MOVE SPACE TO IF-TABLE. NC2114.2 +105100 PERFORM CC--TEST-GF-23. NC2114.2 +105200 CC--TEST-GF-23. NC2114.2 +105300 IF WRK-XN-00001 IS EQUAL TO "X" NC2114.2 +105400 MOVE "Z" TO WRK-XN-00001 NC2114.2 +105500 IF WRK-DS-01V00 IS EQUAL TO ZERO NC2114.2 +105600 MOVE 1 TO WRK-DS-01V00 NC2114.2 +105700 ELSE NC2114.2 +105800 MOVE 2 TO WRK-DS-01V00 NC2114.2 +105900 ELSE NC2114.2 +106000 MOVE "W" TO WRK-XN-00001 NC2114.2 +106100 IF WRK-DS-01V00 IS GREATER THAN ZERO NC2114.2 +106200 MOVE "1" TO IF-ELEM (7). NC2114.2 +106300 MOVE WRK-XN-00001 TO IF-ELEM (XX-TALLY). NC2114.2 +106400 ADD 1 TO XX-TALLY. NC2114.2 +106500 MOVE WRK-DS-01V00 TO IF-ELEM (XX-TALLY). NC2114.2 +106600 ADD 1 TO XX-TALLY. NC2114.2 +106700 MOVE SPACE TO IF-ELEM (XX-TALLY) NC2114.2 +106800 ADD 1 TO XX-TALLY. NC2114.2 +106900 CC--TEST-GF-23-1. NC2114.2 +107000 IF IF-TABLE EQUAL TO "Z1 W1 1 " NC2114.2 +107100 PERFORM PASS GO TO CC--WRITE-GF-23. NC2114.2 +107200 GO TO CC--FAIL-GF-23. NC2114.2 +107300 CC--DELETE-GF-23. NC2114.2 +107400 PERFORM DE-LETE. NC2114.2 +107500 GO TO CC--WRITE-GF-23. NC2114.2 +107600 CC--FAIL-GF-23. NC2114.2 +107700 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +107800 MOVE "Z1 W1 1" TO CORRECT-A. NC2114.2 +107900 PERFORM FAIL. NC2114.2 +108000 CC--WRITE-GF-23. NC2114.2 +108100 PERFORM PRINT-DETAIL. NC2114.2 +108200* NC2114.2 +108300 CC--INIT-GF-24. NC2114.2 +108400 MOVE "CC--TEST-GF-24" TO PAR-NAME. NC2114.2 +108500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +108600 MOVE " NOT ABBREVIATED " TO FEATURE. NC2114.2 +108700 MOVE SPACE TO WRK-XN-00001. NC2114.2 +108800 MOVE ZERO TO WRK-DS-01V00. NC2114.2 +108900 CC--TEST-GF-24. NC2114.2 +109000 IF WRK-XN-00001 EQUAL TO SPACE NC2114.2 +109100 OR NC2114.2 +109200 WRK-DS-01V00 EQUAL TO ZERO NC2114.2 +109300 PERFORM PASS NC2114.2 +109400 ELSE NC2114.2 +109500 GO TO CC--FAIL-GF-24. NC2114.2 +109600* NOTE BOTH CONDITIONS ARE TRUE. NC2114.2 +109700 GO TO CC--WRITE-GF-24. NC2114.2 +109800 CC--DELETE-GF-24. NC2114.2 +109900 PERFORM DE-LETE. NC2114.2 +110000 GO TO CC--WRITE-GF-24. NC2114.2 +110100 CC--FAIL-GF-24. NC2114.2 +110200 PERFORM FAIL. NC2114.2 +110300 CC--WRITE-GF-24. NC2114.2 +110400 PERFORM PRINT-DETAIL. NC2114.2 +110500* NC2114.2 +110600 CC--INIT-GF-25. NC2114.2 +110700 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +110800 MOVE "CC--TEST-GF-25" TO PAR-NAME. NC2114.2 +110900 MOVE "0" TO WRK-XN-00001. NC2114.2 +111000 MOVE 0 TO WRK-DS-01V00. NC2114.2 +111100 CC--TEST-GF-25. NC2114.2 +111200 IF WRK-XN-00001 EQUAL TO "0" NC2114.2 +111300 AND NC2114.2 +111400 WRK-DS-01V00 EQUAL TO 0 NC2114.2 +111500 PERFORM PASS NC2114.2 +111600 ELSE NC2114.2 +111700 GO TO CC--FAIL-GF-25. NC2114.2 +111800* NOTE BOTH CONDITIONS ARE TRUE. NC2114.2 +111900 GO TO CC--WRITE-GF-25. NC2114.2 +112000 CC--DELETE-GF-25. NC2114.2 +112100 PERFORM DE-LETE. NC2114.2 +112200 GO TO CC--WRITE-GF-25. NC2114.2 +112300 CC--FAIL-GF-25. NC2114.2 +112400 PERFORM FAIL. NC2114.2 +112500 CC--WRITE-GF-25. NC2114.2 +112600 PERFORM PRINT-DETAIL. NC2114.2 +112700* NC2114.2 +112800 CC--INIT-GF-26. NC2114.2 +112900 MOVE "CC--TEST-GF-26" TO PAR-NAME. NC2114.2 +113000 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +113100 MOVE " NOT ABBR, W/PARENS" TO FEATURE. NC2114.2 +113200 MOVE SPACE TO IF-TABLE. NC2114.2 +113300 MOVE ZERO TO WRK-DS-01V00. NC2114.2 +113400 MOVE ZERO TO WRK-XN-00001. NC2114.2 +113500 PERFORM CC--TEST-GF-26. NC2114.2 +113600 MOVE "X" TO IF-ELEM (5). NC2114.2 +113700 CC--TEST-GF-26. NC2114.2 +113800 IF (WRK-DS-01V00 IS EQUAL TO 0 NC2114.2 +113900 OR NC2114.2 +114000 WRK-XN-00001 EQUAL TO "0") NC2114.2 +114100 AND NC2114.2 +114200 SPACE IS EQUAL TO IF-TABLE NC2114.2 +114300 MOVE "1" TO IF-ELEM (1) NC2114.2 +114400 ELSE NC2114.2 +114500 MOVE "1" TO IF-ELEM (3). NC2114.2 +114600* NOTE ALL CONDITIONS ARE TRUE THE FIRST TIME, THEN THE NC2114.2 +114700* FIRST TWO ARE TRUE THE SECOND TIME. NC2114.2 +114800 CC--TEST-GF-26-1. NC2114.2 +114900 IF IF-TABLE EQUAL TO "1 1 X" NC2114.2 +115000 PERFORM PASS GO TO CC--WRITE-GF-26. NC2114.2 +115100 GO TO CC--FAIL-GF-26. NC2114.2 +115200 CC--DELETE-GF-26. NC2114.2 +115300 PERFORM DE-LETE. NC2114.2 +115400 GO TO CC--WRITE-GF-26. NC2114.2 +115500 CC--FAIL-GF-26. NC2114.2 +115600 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +115700 MOVE "1 1 X" TO CORRECT-A. NC2114.2 +115800 PERFORM FAIL. NC2114.2 +115900 CC--WRITE-GF-26. NC2114.2 +116000 PERFORM PRINT-DETAIL. NC2114.2 +116100* NC2114.2 +116200 CC--INIT-GF-27. NC2114.2 +116300 MOVE "CC--TEST-GF-27" TO PAR-NAME. NC2114.2 +116400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +116500 MOVE " NOT ABBR, W/PARENS" TO FEATURE. NC2114.2 +116600 MOVE SPACE TO IF-TABLE. NC2114.2 +116700 MOVE ZERO TO WRK-DS-01V00. NC2114.2 +116800 MOVE ZERO TO WRK-XN-00001. NC2114.2 +116900 PERFORM CC--TEST-GF-27. NC2114.2 +117000 MOVE "X" TO IF-ELEM (5). NC2114.2 +117100 CC--TEST-GF-27. NC2114.2 +117200 IF NOT (WRK-DS-01V00 IS EQUAL TO 0 NC2114.2 +117300 AND NC2114.2 +117400 WRK-XN-00001 IS EQUAL TO "0") NC2114.2 +117500 OR NC2114.2 +117600 SPACE IS EQUAL TO IF-TABLE NC2114.2 +117700 MOVE "1" TO IF-ELEM (1) NC2114.2 +117800 ELSE NC2114.2 +117900 MOVE "1" TO IF-ELEM (3). NC2114.2 +118000* NOTE THE FIRST PART IS ALWAYS FALSE, AND THE PORTION NC2114.2 +118100* AFTER THE "OR" IS FIRST TRUE, THEN FALSE. NC2114.2 +118200 CC--TEST-GF-27-1. NC2114.2 +118300 IF IF-TABLE EQUAL TO "1 1 X" NC2114.2 +118400 PERFORM PASS GO TO CC--WRITE-GF-27. NC2114.2 +118500 GO TO CC--FAIL-GF-27. NC2114.2 +118600 CC--DELETE-GF-27. NC2114.2 +118700 PERFORM DE-LETE. NC2114.2 +118800 GO TO CC--WRITE-GF-27. NC2114.2 +118900 CC--FAIL-GF-27. NC2114.2 +119000 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +119100 MOVE "1 1 X" TO CORRECT-A. NC2114.2 +119200 PERFORM FAIL. NC2114.2 +119300 CC--WRITE-GF-27. NC2114.2 +119400 PERFORM PRINT-DETAIL. NC2114.2 +119500* NC2114.2 +119600 CC--INIT-GF-28. NC2114.2 +119700 MOVE "CC--TEST-GF-28" TO PAR-NAME. NC2114.2 +119800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +119900 MOVE " ABBREVIATED " TO FEATURE. NC2114.2 +120000 MOVE ZERO TO IF-TABLE NC2114.2 +120100 MOVE ZERO TO WRK-XN-00001. NC2114.2 +120200 MOVE 1 TO XX-TALLY. NC2114.2 +120300 PERFORM CC--TEST-GF-28. NC2114.2 +120400 MOVE "X" TO IF-ELEM (5). NC2114.2 +120500 CC--TEST-GF-28. NC2114.2 +120600 IF WRK-XN-00001 = "0" OR = "1" OR = IF-TABLE NC2114.2 +120700 AND = IF-ELEM (5) NC2114.2 +120800 MOVE "1" TO IF-ELEM (XX-TALLY) NC2114.2 +120900 ADD 1 TO XX-TALLY NC2114.2 +121000 ELSE NC2114.2 +121100 MOVE "2" TO IF-ELEM (XX-TALLY) NC2114.2 +121200 ADD 1 TO XX-TALLY. NC2114.2 +121300 CC--TEST-GF-28-1. NC2114.2 +121400 IF IF-TABLE EQUAL TO "1100X0000000" NC2114.2 +121500 PERFORM PASS GO TO CC--WRITE-GF-28. NC2114.2 +121600 GO TO CC--FAIL-GF-28. NC2114.2 +121700 CC--DELETE-GF-28. NC2114.2 +121800 PERFORM DE-LETE. NC2114.2 +121900 GO TO CC--WRITE-GF-28. NC2114.2 +122000 CC--FAIL-GF-28. NC2114.2 +122100 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +122200 MOVE "1100X0000000" TO CORRECT-A. NC2114.2 +122300 PERFORM FAIL. NC2114.2 +122400 CC--WRITE-GF-28. NC2114.2 +122500 PERFORM PRINT-DETAIL. NC2114.2 +122600* NC2114.2 +122700 CC--INIT-GF-29. NC2114.2 +122800 MOVE "CC--TEST-GF-29" TO PAR-NAME. NC2114.2 +122900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +123000 MOVE ZERO TO IF-TABLE. NC2114.2 +123100 MOVE ZERO TO WRK-XN-00001. NC2114.2 +123200 MOVE 1 TO XX-TALLY. NC2114.2 +123300 PERFORM CC--TEST-GF-29. NC2114.2 +123400 MOVE "X" TO WRK-XN-00001. NC2114.2 +123500 CC--TEST-GF-29. NC2114.2 +123600 IF WRK-XN-00001 = "0" OR "1" OR "2" OR IF-TABLE OR "3" NC2114.2 +123700 MOVE "1" TO IF-ELEM (XX-TALLY) NC2114.2 +123800 ADD 1 TO XX-TALLY NC2114.2 +123900 ELSE NC2114.2 +124000 MOVE "2" TO IF-ELEM (XX-TALLY) NC2114.2 +124100 ADD 1 TO XX-TALLY. NC2114.2 +124200 CC--TEST-GF-29-1. NC2114.2 +124300 IF IF-TABLE EQUAL TO "120000000000" NC2114.2 +124400 PERFORM PASS GO TO CC--WRITE-GF-29. NC2114.2 +124500 GO TO CC--FAIL-GF-29. NC2114.2 +124600 CC--DELETE-GF-29. NC2114.2 +124700 PERFORM DE-LETE. NC2114.2 +124800 GO TO CC--WRITE-GF-29. NC2114.2 +124900 CC--FAIL-GF-29. NC2114.2 +125000 MOVE IF-TABLE TO COMPUTED-A. NC2114.2 +125100 MOVE "120000000000" TO CORRECT-A. NC2114.2 +125200 PERFORM FAIL. NC2114.2 +125300 CC--WRITE-GF-29. NC2114.2 +125400 PERFORM PRINT-DETAIL. NC2114.2 +125500* NC2114.2 +125600 CC--INIT-GF-30. NC2114.2 +125700 MOVE "CC--TEST-GF-30" TO PAR-NAME. NC2114.2 +125800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +125900 MOVE " LOGICAL *NOT*" TO FEATURE. NC2114.2 +126000 MOVE "AAAAA" TO AZE. NC2114.2 +126100 MOVE -2 TO MINUS-TWO. NC2114.2 +126200 MOVE 2 TO TWO. NC2114.2 +126300 CC--TEST-GF-30. NC2114.2 +126400 IF NOT AZE < "AAAAA" NC2114.2 +126500 AND NC2114.2 +126600 MINUS-TWO < TWO NC2114.2 +126700 PERFORM PASS NC2114.2 +126800 ELSE NC2114.2 +126900 GO TO CC--FAIL-GF-30. NC2114.2 +127000* NOTE CC--TEST-GF-30 TESTS LOGICAL "NOT" PLUS "AND" --- NC2114.2 +127100* FIRST LINE TRUE, NC2114.2 +127200* SECOND LINE TRUE. NC2114.2 +127300 GO TO CC--WRITE-GF-30. NC2114.2 +127400 CC--DELETE-GF-30. NC2114.2 +127500 PERFORM DE-LETE. NC2114.2 +127600 GO TO CC--WRITE-GF-30. NC2114.2 +127700 CC--FAIL-GF-30. NC2114.2 +127800 PERFORM FAIL. NC2114.2 +127900 CC--WRITE-GF-30. NC2114.2 +128000 PERFORM PRINT-DETAIL. NC2114.2 +128100* NC2114.2 +128200 CC--INIT-GF-31. NC2114.2 +128300 MOVE "CC--TEST-GF-31" TO PAR-NAME. NC2114.2 +128400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +128500 MOVE 10 TO TEN. NC2114.2 +128600 MOVE 3 TO THREE. NC2114.2 +128700 CC--TEST-GF-31. NC2114.2 +128800 IF NOT TEN = 10.00000000 NC2114.2 +128900 OR NC2114.2 +129000 THREE = TEN NC2114.2 +129100 GO TO CC--FAIL-GF-31 NC2114.2 +129200 ELSE NC2114.2 +129300 PERFORM PASS. NC2114.2 +129400* NOTE CC--TEST-GF-31 TESTS LOGICAL "NOT" PLUS "OR" --- NC2114.2 +129500* FIRST LINE FALSE, NC2114.2 +129600* SECOND LINE FALSE. NC2114.2 +129700 GO TO CC--WRITE-GF-31. NC2114.2 +129800 CC--DELETE-GF-31. NC2114.2 +129900 PERFORM DE-LETE. NC2114.2 +130000 GO TO CC--WRITE-GF-31. NC2114.2 +130100 CC--FAIL-GF-31. NC2114.2 +130200 PERFORM FAIL. NC2114.2 +130300 CC--WRITE-GF-31. NC2114.2 +130400 PERFORM PRINT-DETAIL. NC2114.2 +130500* NC2114.2 +130600 CC--INIT-GF-32. NC2114.2 +130700 MOVE "CC--TEST-GF-32" TO PAR-NAME. NC2114.2 +130800 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +130900 MOVE 0 TO NAUGHT. NC2114.2 +131000 MOVE 3 TO THREE. NC2114.2 +131100 MOVE 6 TO SIX. NC2114.2 +131200 CC--TEST-GF-32. NC2114.2 +131300 IF NOT (NAUGHT > THREE NC2114.2 +131400 OR NC2114.2 +131500 NAUGHT < ZERO) NC2114.2 +131600 AND NC2114.2 +131700 6.00000000000000001 NOT EQUAL TO SIX NC2114.2 +131800 PERFORM PASS NC2114.2 +131900 ELSE NC2114.2 +132000 GO TO CC--FAIL-GF-32. NC2114.2 +132100* NOTE CC--TEST-GF-32 TESTS LOGICAL "NOT" OF PARENTHESIZED NC2114.2 +132200* CONDITION PLUS "AND" --- NC2114.2 +132300* FIRST LINE (WITHIN PARENTHESES) FALSE NC2114.2 +132400* SECOND LINE (WITHIN PARENTHESES) FALSE NC2114.2 +132500* FIRST PLUS SECOND LINE (WITHIN PARENS) FALSE NC2114.2 +132600* FIRST PLUS SECOND LINE TRUE NC2114.2 +132700* THIRD LINE TRUE. NC2114.2 +132800 GO TO CC--WRITE-GF-32. NC2114.2 +132900 CC--DELETE-GF-32. NC2114.2 +133000 PERFORM DE-LETE. NC2114.2 +133100 GO TO CC--WRITE-GF-32. NC2114.2 +133200 CC--FAIL-GF-32. NC2114.2 +133300 PERFORM FAIL. NC2114.2 +133400 CC--WRITE-GF-32. NC2114.2 +133500 PERFORM PRINT-DETAIL. NC2114.2 +133600* NC2114.2 +133700 CC--INIT-GF-33. NC2114.2 +133800 MOVE "CC--TEST-GF-33" TO PAR-NAME. NC2114.2 +133900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +134000 MOVE +.333333333333333333 TO ONE-THIRD. NC2114.2 +134100 MOVE "AAAAA" TO AZE. NC2114.2 +134200 MOVE "CCCCC" TO CEEZE. NC2114.2 +134300 CC--TEST-GF-33. NC2114.2 +134400 IF ( .3703703333 ) EQUAL TO ONE-THIRD NC2114.2 +134500 AND NOT AZE EQUAL TO CEEZE NC2114.2 +134600 GO TO CC--FAIL-GF-33 NC2114.2 +134700 ELSE NC2114.2 +134800 PERFORM PASS. NC2114.2 +134900* NOTE CC--TEST-GF-33 TESTS LOGICAL "NOT" FOLLOWING AN "AND"NC2114.2 +135000* FIRST LINE FALSE, NC2114.2 +135100* SECOND LINE TRUE. NC2114.2 +135200 GO TO CC--WRITE-GF-33. NC2114.2 +135300 CC--DELETE-GF-33. NC2114.2 +135400 PERFORM DE-LETE. NC2114.2 +135500 GO TO CC--WRITE-GF-33. NC2114.2 +135600 CC--FAIL-GF-33. NC2114.2 +135700 PERFORM FAIL. NC2114.2 +135800 CC--WRITE-GF-33. NC2114.2 +135900 PERFORM PRINT-DETAIL. NC2114.2 +136000* NC2114.2 +136100 CC--INIT-GF-34. NC2114.2 +136200 MOVE "CC--TEST-GF-34" TO PAR-NAME. NC2114.2 +136300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +136400 MOVE 11 TO CCON-1. NC2114.2 +136500 MOVE 12 TO CCON-2. NC2114.2 +136600 MOVE 13 TO CCON-3. NC2114.2 +136700 MOVE 14 TO CCON-4. NC2114.2 +136800 CC--TEST-GF-34. NC2114.2 +136900 IF NOT (CCON-4 NOT GREATER THAN CCON-2 AND CCON-3 NC2114.2 +137000 AND NOT CCON-1) NC2114.2 +137100 PERFORM PASS NC2114.2 +137200 ELSE NC2114.2 +137300 GO TO CC--FAIL-GF-34. NC2114.2 +137400* NC2114.2 +137500* NOTE THE ABOVE STATEMENT TESTS THE USE OF A COMPLEX NC2114.2 +137600* CONDITION WITH COMBINATIONS OF LOGICAL OPERATORS NC2114.2 +137700* ABREVIATED RELATIONAL OPERATORS AND OMITTED NC2114.2 +137800* CONDITION SUBJECTS. NC2114.2 +137900* THE EXPANDED EQUIVALENT OF THIS STATEMENT IS - NC2114.2 +138000* "NOT (((CCON-4 NOT > CCON-2) AND (CCON-4 NOT > NC2114.2 +138100* CCON-3)) AND (NOT (CCON-4 NOT > CCON-1)))" NC2114.2 +138200 GO TO CC--WRITE-GF-34. NC2114.2 +138300 CC--DELETE-GF-34. NC2114.2 +138400 PERFORM DE-LETE. NC2114.2 +138500 GO TO CC--WRITE-GF-34. NC2114.2 +138600 CC--FAIL-GF-34. NC2114.2 +138700 PERFORM FAIL. NC2114.2 +138800 CC--WRITE-GF-34. NC2114.2 +138900 PERFORM PRINT-DETAIL. NC2114.2 +139000* NC2114.2 +139100 CC--INIT-GF-35. NC2114.2 +139200 MOVE "CC--TEST-GF-35" TO PAR-NAME. NC2114.2 +139300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +139400 MOVE -1 TO MINUS-ONE. NC2114.2 +139500 MOVE +.4285714286 TO THREE-SEVENTHS. NC2114.2 +139600 MOVE 1 TO ONE. NC2114.2 +139700 MOVE 2 TO TWO. NC2114.2 +139800 MOVE +2 TO DOS. NC2114.2 +139900 MOVE 5 TO FIVE. NC2114.2 +140000 CC--TEST-GF-35. NC2114.2 +140100 IF TWO > DOS NC2114.2 +140200 OR NC2114.2 +140300 NOT ( THREE-SEVENTHS ) EQUAL TO FIVE NC2114.2 +140400 AND NC2114.2 +140500 MINUS-ONE = ONE NC2114.2 +140600 GO TO CC--FAIL-GF-35 NC2114.2 +140700 ELSE NC2114.2 +140800 PERFORM PASS. NC2114.2 +140900* NOTE CC--TEST-GF-35 TESTS LOGICAL "NOT" WHICH FOLLOWS AN NC2114.2 +141000* "OR" AND PRECEDES AN "AND" --- NC2114.2 +141100* FIRST LINE FALSE NC2114.2 +141200* SECOND LINE TRUE NC2114.2 +141300* THIRD LINE FALSE. NC2114.2 +141400 GO TO CC--WRITE-GF-35. NC2114.2 +141500 CC--DELETE-GF-35. NC2114.2 +141600 PERFORM DE-LETE. NC2114.2 +141700 GO TO CC--WRITE-GF-35. NC2114.2 +141800 CC--FAIL-GF-35. NC2114.2 +141900 PERFORM FAIL. NC2114.2 +142000 CC--WRITE-GF-35. NC2114.2 +142100 PERFORM PRINT-DETAIL. NC2114.2 +142200* NC2114.2 +142300 CC--INIT-GF-36. NC2114.2 +142400 MOVE "CC--TEST-GF-36" TO PAR-NAME. NC2114.2 +142500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +142600 MOVE "AAAAA" TO AZE. NC2114.2 +142700 MOVE "BBBBB" TO BEEZE. NC2114.2 +142800 MOVE 5 TO FIVE. NC2114.2 +142900 CC--TEST-GF-36. NC2114.2 +143000 IF AZE = BEEZE NC2114.2 +143100 OR NOT (5 > FIVE AND NC2114.2 +143200 NOT 5 > FIVE) NC2114.2 +143300 PERFORM PASS NC2114.2 +143400 ELSE NC2114.2 +143500 GO TO CC--FAIL-GF-36. NC2114.2 +143600* NOTE CC--TEST-GF-36 TESTS LOGICAL "NOT" WHICH FOLLOWS AN NC2114.2 +143700* "OR" AND PRECEDES A PARENTHESIZED CONDITION --- NC2114.2 +143800* FIRST LINE FALSE, NC2114.2 +143900* SECOND LINE (WITHIN PARENS) FALSE NC2114.2 +144000* THIRD LINE (WITHIN PARENS) TRUE NC2114.2 +144100* SECOND PLUS THIRD LINE (WITHIN PARENS) FALSE NC2114.2 +144200* SECOND PLUS THIRD LINE TRUE. NC2114.2 +144300 GO TO CC--WRITE-GF-36. NC2114.2 +144400 CC--DELETE-GF-36. NC2114.2 +144500 PERFORM DE-LETE. NC2114.2 +144600 GO TO CC--WRITE-GF-36. NC2114.2 +144700 CC--FAIL-GF-36. NC2114.2 +144800 PERFORM FAIL. NC2114.2 +144900 CC--WRITE-GF-36. NC2114.2 +145000 PERFORM PRINT-DETAIL. NC2114.2 +145100* NC2114.2 +145200 CC--INIT-GF-37. NC2114.2 +145300 MOVE "CC--TEST-GF-37" TO PAR-NAME. NC2114.2 +145400 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +145500 MOVE 0 TO NAUGHT. NC2114.2 +145600 MOVE 1 TO ONE. NC2114.2 +145700 MOVE +1 TO UNO. NC2114.2 +145800 MOVE 2 TO TWO. NC2114.2 +145900 MOVE +2 TO DOS. NC2114.2 +146000 CC--TEST-GF-37. NC2114.2 +146100 IF ((NAUGHT EQUAL TO ONE) NC2114.2 +146200 OR (NOT ((UNO = ONE) OR NC2114.2 +146300 (TWO = DOS)))) NC2114.2 +146400 GO TO CC--FAIL-GF-37 NC2114.2 +146500 ELSE NC2114.2 +146600 PERFORM PASS. NC2114.2 +146700* NOTE CC--TEST-GF-37 TESTS LOGICAL "NOT" THAT IS CONTAINEDNC2114.2 +146800* PARENTHESES AND WHICH PRECEDES A PARENTHESIZED NC2114.2 +146900* CONDITION --- NC2114.2 +147000* FIRST LINE (IN INNER PARENS) FALSE NC2114.2 +147100* SECOND LINE (IN INNER PARENS) TRUE NC2114.2 +147200* THIRD LINE (IN INNER PARENS) FALSE NC2114.2 +147300* SECOND PLUS THIRD LINE (IN MIDDLE PARENS) TRUE NC2114.2 +147400* SECOND PLUS THIRD LINE (IN OUTER PARENS) FALSE NC2114.2 +147500* PARENS AROUND ENTIRE CONDITION ARE REDUNDANT. NC2114.2 +147600 GO TO CC--WRITE-GF-37. NC2114.2 +147700 CC--DELETE-GF-37. NC2114.2 +147800 PERFORM DE-LETE. NC2114.2 +147900 GO TO CC--WRITE-GF-37. NC2114.2 +148000 CC--FAIL-GF-37. NC2114.2 +148100 PERFORM FAIL. NC2114.2 +148200 CC--WRITE-GF-37. NC2114.2 +148300 PERFORM PRINT-DETAIL. NC2114.2 +148400* NC2114.2 +148500 CC--INIT-GF-38. NC2114.2 +148600 MOVE "CC--TEST-GF-38" TO PAR-NAME. NC2114.2 +148700 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +148800 MOVE "AAAAA" TO AZE. NC2114.2 +148900 MOVE 1 TO ONE. NC2114.2 +149000 MOVE 2 TO TWO. NC2114.2 +149100 MOVE 3 TO THREE. NC2114.2 +149200 CC--TEST-GF-38. NC2114.2 +149300 IF NOT AZE LESS THAN ONE AND NC2114.2 +149400 NOT ONE < AZE NC2114.2 +149500 OR TWO AND NC2114.2 +149600 NOT THREE LESS THAN TWO NC2114.2 +149700 PERFORM PASS NC2114.2 +149800 ELSE NC2114.2 +149900 GO TO CC--FAIL-GF-38. NC2114.2 +150000* NOTE CC--TEST-GF-38 TESTS LOGICAL "NOT" FOLLOWING "AND" ANC2114.2 +150100* IN COMBINATION WITH AN ABBREVIATION --- NC2114.2 +150200* EITHER FIRST LINE OR SECOND LINE MUST BE FALSE, NC2114.2 +150300* THEREFORE, NC2114.2 +150400* FIRST PLUS SECOND LINES FALSE NC2114.2 +150500* ABBREVIATED THIRD LINE TRUE NC2114.2 +150600* FOURTH LINE TRUE NC2114.2 +150700* THIRD PLUS FOURTH LINES TRUE. NC2114.2 +150800 GO TO CC--WRITE-GF-38. NC2114.2 +150900 CC--DELETE-GF-38. NC2114.2 +151000 PERFORM DE-LETE. NC2114.2 +151100 GO TO CC--WRITE-GF-38. NC2114.2 +151200 CC--FAIL-GF-38. NC2114.2 +151300 PERFORM FAIL. NC2114.2 +151400 CC--WRITE-GF-38. NC2114.2 +151500 PERFORM PRINT-DETAIL. NC2114.2 +151600* NC2114.2 +151700 CC--INIT-GF-39. NC2114.2 +151800 MOVE "CC--TEST-GF-39" TO PAR-NAME. NC2114.2 +151900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +152000 MOVE " SIGN CONDITIONS" TO FEATURE. NC2114.2 +152100 MOVE 0 TO SIGN-1. NC2114.2 +152200 MOVE 0 TO SIGN-2. NC2114.2 +152300 MOVE 9 TO SIGN-3. NC2114.2 +152400 CC--TEST-GF-39. NC2114.2 +152500 IF NOT (SIGN-1 POSITIVE OR NC2114.2 +152600 SIGN-2 NEGATIVE) NC2114.2 +152700 AND SIGN-3 NOT ZERO NC2114.2 +152800 PERFORM PASS NC2114.2 +152900 ELSE NC2114.2 +153000 GO TO CC--FAIL-GF-39. NC2114.2 +153100* NOTE CC--TEST-GF-39 TESTS SIGN CONDITIONS WITH SEVERAL TYNC2114.2 +153200* OF LOGICAL CONNECTORS INCLUDING PARENTHESES --- NC2114.2 +153300* FIRST LINE FALSE NC2114.2 +153400* SECOND LINE FALSE NC2114.2 +153500* FIRST PLUS SECOND LINES (WITHIN PARENS) FALSE NC2114.2 +153600* FIRST PLUS SECOND LINES TRUE NC2114.2 +153700* THIRD LINE TRUE. NC2114.2 +153800 GO TO CC--WRITE-GF-39. NC2114.2 +153900 CC--DELETE-GF-39. NC2114.2 +154000 PERFORM DE-LETE. NC2114.2 +154100 GO TO CC--WRITE-GF-39. NC2114.2 +154200 CC--FAIL-GF-39. NC2114.2 +154300 PERFORM FAIL. NC2114.2 +154400 CC--WRITE-GF-39. NC2114.2 +154500 PERFORM PRINT-DETAIL. NC2114.2 +154600* NC2114.2 +154700 CC--INIT-GF-40. NC2114.2 +154800 MOVE "CC--TEST-GF-40" TO PAR-NAME. NC2114.2 +154900 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +155000 MOVE " SIGN CONDITIONS" TO FEATURE. NC2114.2 +155100 MOVE -5 TO SIGN-1. NC2114.2 +155200 MOVE -1 TO SIGN-2. NC2114.2 +155300 MOVE 0 TO SIGN-3. NC2114.2 +155400 CC--TEST-GF-40. NC2114.2 +155500 IF SIGN-1 IS POSITIVE NC2114.2 +155600 OR NOT SIGN-2 IS NEGATIVE NC2114.2 +155700 AND SIGN-3 IS ZERO NC2114.2 +155800 GO TO CC--FAIL-GF-40 NC2114.2 +155900 ELSE NC2114.2 +156000 PERFORM PASS. NC2114.2 +156100* NOTE CC--TEST-GF-40 TESTS SIGN CONDITIONS WITH SEVERAL TYNC2114.2 +156200* OF LOGICAL CONNECTORS BUT NO PARENTHESES --- NC2114.2 +156300* FIRST LINE FALSE NC2114.2 +156400* SECOND LINE FALSE NC2114.2 +156500* THIRD LINE TRUE. NC2114.2 +156600 GO TO CC--WRITE-GF-40. NC2114.2 +156700 CC--DELETE-GF-40. NC2114.2 +156800 PERFORM DE-LETE. NC2114.2 +156900 GO TO CC--WRITE-GF-40. NC2114.2 +157000 CC--FAIL-GF-40. NC2114.2 +157100 PERFORM FAIL. NC2114.2 +157200 CC--WRITE-GF-40. NC2114.2 +157300 PERFORM PRINT-DETAIL. NC2114.2 +157400* NC2114.2 +157500 CC--INIT-GF-41. NC2114.2 +157600 MOVE "CC--TEST-GF-41" TO PAR-NAME. NC2114.2 +157700 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +157800 MOVE " CLASS CONDITIONS" TO FEATURE. NC2114.2 +157900 MOVE SPACE TO CLASS-1. NC2114.2 +158000 MOVE ZERO TO CLASS-2. NC2114.2 +158100 MOVE ZERO TO CLASS-3. NC2114.2 +158200 CC--TEST-GF-41. NC2114.2 +158300 IF NOT (CLASS-1 NUMERIC OR NC2114.2 +158400 CLASS-2 ALPHABETIC) NC2114.2 +158500 AND CLASS-3 NOT NUMERIC NC2114.2 +158600 GO TO CC--FAIL-GF-41 NC2114.2 +158700 ELSE NC2114.2 +158800 PERFORM PASS. NC2114.2 +158900* NOTE CC--TEST-GF-41 TESTS CLASS CONDITIONS WITH SEVERAL NC2114.2 +159000* TYPES OF LOGICAL CONNECTORS INCLUDING PARENTHESES --NC2114.2 +159100* FIRST LINE FALSE NC2114.2 +159200* SECOND LINE FALSE NC2114.2 +159300* FIRST PLUS SECOND LINES (WITHIN PARENS) FALSE NC2114.2 +159400* FIRST PLUS SECOND LINES TRUE NC2114.2 +159500* THIRD LINE FALSE. NC2114.2 +159600 GO TO CC--WRITE-GF-41. NC2114.2 +159700 CC--DELETE-GF-41. NC2114.2 +159800 PERFORM DE-LETE. NC2114.2 +159900 GO TO CC--WRITE-GF-41. NC2114.2 +160000 CC--FAIL-GF-41. NC2114.2 +160100 PERFORM FAIL. NC2114.2 +160200 CC--WRITE-GF-41. NC2114.2 +160300 PERFORM PRINT-DETAIL. NC2114.2 +160400* NC2114.2 +160500 CC--INIT-GF-42. NC2114.2 +160600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +160700 MOVE " CLASS CONDITIONS" TO FEATURE. NC2114.2 +160800 MOVE "CC--TEST-GF-42" TO PAR-NAME. NC2114.2 +160900 MOVE 12345 TO CLASS-1. NC2114.2 +161000 MOVE 12345 TO CLASS-2. NC2114.2 +161100 MOVE 12345 TO CLASS-3. NC2114.2 +161200 CC--TEST-GF-42. NC2114.2 +161300 IF CLASS-1 NUMERIC NC2114.2 +161400 OR NOT CLASS-2 ALPHABETIC NC2114.2 +161500 AND CLASS-3 NUMERIC NC2114.2 +161600 PERFORM PASS NC2114.2 +161700 ELSE NC2114.2 +161800 GO TO CC--FAIL-GF-42. NC2114.2 +161900* NOTE CC--TEST-GF-42 TESTS CLASS CONDITIONS WITH SEVERAL NC2114.2 +162000* TYPES OF LOGICAL CONNECTORS BUT NO PARENTHESES --- NC2114.2 +162100* FIRST LINE TRUE NC2114.2 +162200* SECOND LINE TRUE NC2114.2 +162300* THIRD LINE TRUE. NC2114.2 +162400 GO TO CC--WRITE-GF-42. NC2114.2 +162500 CC--DELETE-GF-42. NC2114.2 +162600 PERFORM DE-LETE. NC2114.2 +162700 GO TO CC--WRITE-GF-42. NC2114.2 +162800 CC--FAIL-GF-42. NC2114.2 +162900 PERFORM FAIL. NC2114.2 +163000 CC--WRITE-GF-42. NC2114.2 +163100 PERFORM PRINT-DETAIL. NC2114.2 +163200* NC2114.2 +163300 CC--INIT-GF-43. NC2114.2 +163400 MOVE "CC--TEST-GF-43" TO PAR-NAME. NC2114.2 +163500 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +163600 MOVE " SWITCH CONDITIONS" TO FEATURE. NC2114.2 +163700 CC--TEST-GF-43. NC2114.2 +163800 IF NOT (ON-WRK-SWITCH-1 OR NC2114.2 +163900 OFF-WRK-SWITCH-2) NC2114.2 +164000 AND NOT OFF-WRK-SWITCH-1 NC2114.2 +164100 GO TO CC--FAIL-GF-43 NC2114.2 +164200 ELSE NC2114.2 +164300 PERFORM PASS. NC2114.2 +164400* NOTE *** *** *** IF SWITCHES ARE NOT IMPLEMENTED NC2114.2 +164500* THE CONDITION-NAMES WILL AUTOMATICALLY BE ASSIGNED TO AN NC2114.2 +164600* 01 IN WORKING-STORAGE THEREBY SATISFYING THE TEST. NC2114.2 +164700* NOTE CC--TEST-GF-43 TESTS SWITCH-STATUS CONDITIONS WITH NC2114.2 +164800* SEVERAL TYPES OF LOGICAL CONNECTORS INCLUDING NC2114.2 +164900* PARENTHESES --- NC2114.2 +165000* FIRST LINE TRUE NC2114.2 +165100* SECOND LINE TRUE NC2114.2 +165200* FIRST PLUS SECOND LINES (WITHIN PARENS) TRUE NC2114.2 +165300* FIRST PLUS SECOND LINES FALSE NC2114.2 +165400* THIRD LINE TRUE. NC2114.2 +165500 GO TO CC--WRITE-GF-43. NC2114.2 +165600 CC--DELETE-GF-43. NC2114.2 +165700 PERFORM DE-LETE. NC2114.2 +165800 GO TO CC--WRITE-GF-43. NC2114.2 +165900 CC--FAIL-GF-43. NC2114.2 +166000 PERFORM FAIL. NC2114.2 +166100 CC--WRITE-GF-43. NC2114.2 +166200 PERFORM PRINT-DETAIL. NC2114.2 +166300* NC2114.2 +166400 CC--INIT-GF-44. NC2114.2 +166500 MOVE "CC--TEST-GF-44" TO PAR-NAME. NC2114.2 +166600 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +166700 MOVE " SWITCH CONDITIONS" TO FEATURE. NC2114.2 +166800 CC--TEST-GF-44. NC2114.2 +166900 IF ON-WRK-SWITCH-1 NC2114.2 +167000 OR NOT OFF-WRK-SWITCH-2 NC2114.2 +167100 AND OFF-WRK-SWITCH-1 NC2114.2 +167200 PERFORM PASS NC2114.2 +167300 ELSE NC2114.2 +167400 GO TO CC--FAIL-GF-44. NC2114.2 +167500* NOTE CC--TEST-GF-44 TESTS SWITCH-STATUS CONDITIONS WITH NC2114.2 +167600* SEVERAL TYPES OF LOGICAL CONNECTORS BUT WITHOUT NC2114.2 +167700* PARENTHESES --- NC2114.2 +167800* FIRST LINE TRUE NC2114.2 +167900* SECOND LINE FALSE NC2114.2 +168000* THIRD LINE FALSE. NC2114.2 +168100 GO TO CC--WRITE-GF-44. NC2114.2 +168200 CC--DELETE-GF-44. NC2114.2 +168300 PERFORM DE-LETE. NC2114.2 +168400 GO TO CC--WRITE-GF-44. NC2114.2 +168500 CC--FAIL-GF-44. NC2114.2 +168600 PERFORM FAIL. NC2114.2 +168700 CC--WRITE-GF-44. NC2114.2 +168800 PERFORM PRINT-DETAIL. NC2114.2 +168900* NC2114.2 +169000 CC--INIT-GF-45. NC2114.2 +169100 MOVE "CC--TEST-GF-45" TO PAR-NAME. NC2114.2 +169200 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +169300 MOVE " CONDITION-NAMES" TO FEATURE. NC2114.2 +169400 MOVE "AA" TO AA. NC2114.2 +169500 MOVE "CD" TO BB. NC2114.2 +169600 MOVE "C" TO AAA. NC2114.2 +169700 CC--TEST-GF-45. NC2114.2 +169800 IF NOT (A1 OR NC2114.2 +169900 B1) NC2114.2 +170000 AND NOT AA1 NC2114.2 +170100 GO TO CC--FAIL-GF-45 NC2114.2 +170200 ELSE NC2114.2 +170300 PERFORM PASS. NC2114.2 +170400* NOTE CC--TEST-GF-45 TESTS CONDITION-NAME CONDITIONS WITH NC2114.2 +170500* SEVERAL TYPES OF LOGICAL CONNECTORS INCLUDING NC2114.2 +170600* PARENTHESES --- NC2114.2 +170700* FIRST LINE TRUE NC2114.2 +170800* SECOND LINE FALSE NC2114.2 +170900* FIRST PLUS SECOND LINE (WITHIN PARENS) TRUE NC2114.2 +171000* FIRST PLUS SECOND LINE FALSE NC2114.2 +171100* THIRD LINE TRUE. NC2114.2 +171200 GO TO CC--WRITE-GF-45. NC2114.2 +171300 CC--DELETE-GF-45. NC2114.2 +171400 PERFORM DE-LETE. NC2114.2 +171500 GO TO CC--WRITE-GF-45. NC2114.2 +171600 CC--FAIL-GF-45. NC2114.2 +171700 PERFORM FAIL. NC2114.2 +171800 CC--WRITE-GF-45. NC2114.2 +171900 PERFORM PRINT-DETAIL. NC2114.2 +172000* NC2114.2 +172100 CC--INIT-GF-46. NC2114.2 +172200 MOVE "CC--TEST-GF-46" TO PAR-NAME. NC2114.2 +172300 MOVE "VI-89 6.15.3/4" TO ANSI-REFERENCE. NC2114.2 +172400 MOVE " CONDITION-NAMES" TO FEATURE. NC2114.2 +172500 MOVE "AB" TO AA. NC2114.2 +172600 MOVE "CD" TO BB. NC2114.2 +172700 MOVE "A" TO AAA. NC2114.2 +172800 CC--TEST-GF-46. NC2114.2 +172900 IF A1 NC2114.2 +173000 OR NOT B1 NC2114.2 +173100 AND AA1 NC2114.2 +173200 PERFORM PASS NC2114.2 +173300 ELSE NC2114.2 +173400 GO TO CC--FAIL-GF-46. NC2114.2 +173500* NOTE CC--TEST-GF-46 TESTS CONDITION-NAME CONDITIONS WITH NC2114.2 +173600* SEVERAL TYPES OF LOGICAL CONNECTORS BUT NO NC2114.2 +173700* PARENTHESES --- NC2114.2 +173800* FIRST LINE FALSE NC2114.2 +173900* SECOND LINE TRUE NC2114.2 +174000* THIRD LINE TRUE. NC2114.2 +174100 GO TO CC--WRITE-GF-46. NC2114.2 +174200 CC--DELETE-GF-46. NC2114.2 +174300 PERFORM DE-LETE. NC2114.2 +174400 GO TO CC--WRITE-GF-46. NC2114.2 +174500 CC--FAIL-GF-46. NC2114.2 +174600 PERFORM FAIL. NC2114.2 +174700 CC--WRITE-GF-46. NC2114.2 +174800 PERFORM PRINT-DETAIL. NC2114.2 +174900* PAUL WOZ UPTO HERE. NC2114.2 +175000 CC--INIT-GF-47. NC2114.2 +175100 MOVE " MIXED CONDITIONS" TO FEATURE. NC2114.2 +175200 MOVE -1 TO IF-D32. NC2114.2 +175300 MOVE "ABCD4" TO CLASS-1. NC2114.2 +175400 MOVE -1 TO SIGN-1. NC2114.2 +175500 CC--TEST-GF-47. NC2114.2 +175600* NOTE IF SWITCHES ARE NOT IMPLEMENTED SWITCH-1 WILL NC2114.2 +175700* BE AUTOMATICALLY TURNED ON TO FULFILL THE REQUIREMENTS NC2114.2 +175800* OF THIS TEST. NC2114.2 +175900 IF NOT TWO > THREE NC2114.2 +176000 AND NOT (ON-WRK-SWITCH-1 AND NC2114.2 +176100 F OR NC2114.2 +176200 CLASS-1 ALPHABETIC) NC2114.2 +176300 OR TWO = THREE NC2114.2 +176400 AND SIGN-1 ZERO NC2114.2 +176500 PERFORM PASS ELSE PERFORM FAIL. NC2114.2 +176600* NOTE CC--TEST-GF-47 TESTS A COMPOUND CONDITION WHICH NC2114.2 +176700* CONTAINS ALL OF THE TYPES OF SIMPLE CONDITIONS AND NC2114.2 +176800* SEVERAL TYPES OF LOGICAL CONNECTORS --- NC2114.2 +176900* FIRST LINE TRUE NC2114.2 +177000* SECOND LINE TRUE NC2114.2 +177100* THIRD LINE FALSE NC2114.2 +177200* FOURTH LINE FALSE NC2114.2 +177300* SECOND THRU FOURTH LINES (WITHIN PARENS) FALSE NC2114.2 +177400* SECOND THRU FOURTH LINES TRUE NC2114.2 +177500* FIRST THRU FOURTH LINES TRUE NC2114.2 +177600* FIFTH LINE FALSE NC2114.2 +177700* SIXTH LINE FALSE NC2114.2 +177800* FIFTH THRU SIXTH LINES FALSE. NC2114.2 +177900 GO TO CC--WRITE-GF-47. NC2114.2 +178000 CC--DELETE-GF-47. NC2114.2 +178100 PERFORM DE-LETE. NC2114.2 +178200 CC--WRITE-GF-47. NC2114.2 +178300 MOVE "CC--TEST-GF-47" TO PAR-NAME. NC2114.2 +178400 PERFORM PRINT-DETAIL. NC2114.2 +178500 CC--TEST-GF-48. NC2114.2 +178600 MOVE +9 TO SIGN-1. NC2114.2 +178700 MOVE -5 TO SIGN-2. NC2114.2 +178800 MOVE "+1234" TO CLASS-1. NC2114.2 +178900 MOVE 1235 TO IF-D32. NC2114.2 +179000* NOTE IF SWITCHES ARE NOT IMPLEMENTED SWITCH-1 WILL BE NC2114.2 +179100* AUTOMATICALLY TURNED ON TO FULFILL THE REQUIREMENTS NC2114.2 +179200* OF THIS TEST. NC2114.2 +179300 IF FOUR GREATER THAN 2.5 NC2114.2 +179400 AND EQUAL TO QUATROS NC2114.2 +179500 AND (FOUR = TEN OR NC2114.2 +179600 NOT < TEN OR NC2114.2 +179700 SIGN-1 POSITIVE AND NC2114.2 +179800 (SIGN-2 NOT NEGATIVE OR NC2114.2 +179900 CLASS-1 NOT NUMERIC)) NC2114.2 +180000 AND NOT OFF-WRK-SWITCH-1 NC2114.2 +180100 OR E NC2114.2 +180200 AND F NC2114.2 +180300 OR NOT G NC2114.2 +180400 PERFORM PASS ELSE PERFORM FAIL. NC2114.2 +180500* NOTE CC--TEST-GF-48 TESTS A COMPOUND CONDITION WHICH NC2114.2 +180600* CONTAINS ALL OF THE TYPES OF SIMPLE CONDITIONS AND NC2114.2 +180700* SEVERAL TYPES OF LOGICAL CONNECTORS --- NC2114.2 +180800* * FIRST LINE TRUE NC2114.2 +180900* * SECOND ABBREVIATED LINE TRUE NC2114.2 +181000* THIRD LINE FALSE NC2114.2 +181100* FOURTH LINE FALSE NC2114.2 +181200* FIFTH LINE TRUE NC2114.2 +181300* SIXTH LINE FALSE NC2114.2 +181400* SEVENTH LINE TRUE NC2114.2 +181500* SIXTH PLUS SEVENTH LINES TRUE NC2114.2 +181600* * THIRD THRU SEVENTH LINES TRUE NC2114.2 +181700* * EIGHTH LINE TRUE NC2114.2 +181800* ** FIRST THRU EIGHTH LINES TRUE NC2114.2 +181900* NINTH LINE FALSE NC2114.2 +182000* TENTH LINE TRUE NC2114.2 +182100* ** NINTH PLUS TENTH LINES FALSE NC2114.2 +182200* ** ELEVENTH LINE FALSE. NC2114.2 +182300 GO TO CC--WRITE-GF-48. NC2114.2 +182400 CC--DELETE-GF-48. NC2114.2 +182500 PERFORM DE-LETE. NC2114.2 +182600 CC--WRITE-GF-48. NC2114.2 +182700 MOVE "CC--TEST-GF-48" TO PAR-NAME. NC2114.2 +182800 PERFORM PRINT-DETAIL. NC2114.2 +182900 FIG-INIT-A. NC2114.2 +183000 PERFORM END-ROUTINE. NC2114.2 +183100 MOVE "FIGURATIVE CONSTANTS" TO FEATURE. NC2114.2 +183200 FIG-TEST-1. NC2114.2 +183300 MOVE SUB-GRP-FOR-2N058-A TO SUB-GRP-FOR-2N058-B. NC2114.2 +183400 IF SUB-SUB-BA EQUAL TO "000000 ABCABC" NC2114.2 +183500 PERFORM PASS GO TO FIG-WRITE-1. NC2114.2 +183600 GO TO FIG-FAIL-1. NC2114.2 +183700 FIG-DELETE-1. NC2114.2 +183800 PERFORM DE-LETE. NC2114.2 +183900 GO TO FIG-WRITE-1. NC2114.2 +184000 FIG-FAIL-1. NC2114.2 +184100 MOVE SUB-SUB-BA TO COMPUTED-A. NC2114.2 +184200 MOVE "000000 ABCABC" TO CORRECT-A. NC2114.2 +184300 PERFORM FAIL. NC2114.2 +184400 FIG-WRITE-1. NC2114.2 +184500 MOVE "FIG-TEST-1" TO PAR-NAME. NC2114.2 +184600 PERFORM PRINT-DETAIL. NC2114.2 +184700 FIG-TEST-2. NC2114.2 +184800 IF SUB-SUB-BB EQUAL TO "ZZZ 000000" NC2114.2 +184900 PERFORM PASS GO TO FIG-WRITE-2. NC2114.2 +185000* NOTE THIS TEST DEPENDS UPON THE RESULT OF FIG-TEST-1. NC2114.2 +185100 GO TO FIG-FAIL-2. NC2114.2 +185200 FIG-DELETE-2. NC2114.2 +185300 PERFORM DE-LETE. NC2114.2 +185400 GO TO FIG-WRITE-2. NC2114.2 +185500 FIG-FAIL-2. NC2114.2 +185600 MOVE SUB-SUB-BB TO COMPUTED-A. NC2114.2 +185700 MOVE "ZZZ 000000" TO CORRECT-A. NC2114.2 +185800 PERFORM FAIL. NC2114.2 +185900 FIG-WRITE-2. NC2114.2 +186000 MOVE "FIG-TEST-2" TO PAR-NAME. NC2114.2 +186100 PERFORM PRINT-DETAIL. NC2114.2 +186200 FIG-TEST-3. NC2114.2 +186300 IF ELEM-FOR-2N058-I OF SUB-SUB-BC NOT EQUAL TO QUOTE NC2114.2 +186400 GO TO FIG-FAIL-3. NC2114.2 +186500 IF ELEM-FOR-2N058-J OF SUB-SUB-BC NOT EQUAL TO QUOTE NC2114.2 +186600 GO TO FIG-FAIL-3. NC2114.2 +186700 IF ELEM-FOR-2N058-K OF SUB-SUB-BC NOT EQUAL TO HIGH-VALUE NC2114.2 +186800 GO TO FIG-FAIL-3. NC2114.2 +186900 IF ELEM-FOR-2N058-L OF SUB-SUB-BC NOT EQUAL TO LOW-VALUE NC2114.2 +187000 GO TO FIG-FAIL-3. NC2114.2 +187100 IF ELEM-FOR-2N058-M OF SUB-SUB-BC NOT EQUAL TO HIGH-VALUE NC2114.2 +187200 GO TO FIG-FAIL-3. NC2114.2 +187300 IF ELEM-FOR-2N058-N OF SUB-SUB-BC NOT EQUAL TO LOW-VALUE NC2114.2 +187400 GO TO FIG-FAIL-3. NC2114.2 +187500 PERFORM PASS. NC2114.2 +187600 GO TO FIG-WRITE-3. NC2114.2 +187700 FIG-DELETE-3. NC2114.2 +187800 PERFORM DE-LETE. NC2114.2 +187900 GO TO FIG-WRITE-3. NC2114.2 +188000 FIG-FAIL-3. NC2114.2 +188100 MOVE SPACE TO FEATURE. NC2114.2 +188200 MOVE "6 QUOTES, 3 HIGH-VALUES," TO RE-MARK. NC2114.2 +188300 PERFORM PRINT-DETAIL. NC2114.2 +188400 MOVE "3 LOW-VALUES, 3 HIGH-VALUES" TO RE-MARK. NC2114.2 +188500 PERFORM PRINT-DETAIL. NC2114.2 +188600 MOVE "FIGURATIVE CONSTANTS" TO FEATURE. NC2114.2 +188700 MOVE SUB-SUB-BC TO COMPUTED-A. NC2114.2 +188800 MOVE "SEE REMARKS" TO CORRECT-A. NC2114.2 +188900 MOVE "3 LOW-VALUES" TO RE-MARK. NC2114.2 +189000 PERFORM FAIL. NC2114.2 +189100 FIG-WRITE-3. NC2114.2 +189200 MOVE "FIG-TEST-3" TO PAR-NAME. NC2114.2 +189300 PERFORM PRINT-DETAIL. NC2114.2 +189400 CCVS-EXIT SECTION. NC2114.2 +189500 CCVS-999999. NC2114.2 +189600 GO TO CLOSE-FILES. NC2114.2 diff --git a/tests/cobol85/NC/NC214M.CBL b/tests/cobol85/NC/NC214M.CBL new file mode 100755 index 00000000..44131699 --- /dev/null +++ b/tests/cobol85/NC/NC214M.CBL @@ -0,0 +1,409 @@ +000100 IDENTIFICATION DIVISION. NC2144.2 +000200 PROGRAM-ID. NC2144.2 +000300 NC214M. NC2144.2 +000400**************************************************************** NC2144.2 +000500* * NC2144.2 +000600* VALIDATION FOR:- * NC2144.2 +000700* * NC2144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2144.2 +000900* * NC2144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2144.2 +001100* * NC2144.2 +001200**************************************************************** NC2144.2 +001300* * NC2144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2144.2 +001500* * NC2144.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2144.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2144.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2144.2 +001900* * NC2144.2 +002000**************************************************************** NC2144.2 +002100* * NC2144.2 +002200* PROGRAM NC214M TESTS FORMAT 2 OF THE "ACCEPT" STATEMENT. * NC2144.2 +002300* * NC2144.2 +002400**************************************************************** NC2144.2 +002500 ENVIRONMENT DIVISION. NC2144.2 +002600 CONFIGURATION SECTION. NC2144.2 +002700 SOURCE-COMPUTER. NC2144.2 +002800 Linux. NC2144.2 +002900 OBJECT-COMPUTER. NC2144.2 +003000 Linux NC2144.2 +003100 PROGRAM COLLATING SEQUENCE IS N-A-T-I-V-E. NC2144.2 +003200 SPECIAL-NAMES. NC2144.2 +003300* NC2144.2 +003400* NC2144.2 +003500* THE FOLLOWING IS THE ALPHABET FOR THE PROGRAM COLLATING NC2144.2 +003600* SEQUENCE CLAUSE. NC2144.2 +003700* NC2144.2 +003800 ALPHABET NC2144.2 +003900 N-A-T-I-V-E IS NATIVE NC2144.2 +004000* NC2144.2 +004100* NC2144.2 +004200* NC2144.2 +004300* NC2144.2 +004400 ALPHABET NC2144.2 +004500 THE-ONE-CHARACTER-ALPHABET IS "Q" ALSO LOW-VALUE NC2144.2 +004600 ALSO HIGH-VALUE NC2144.2 +004700 ALSO QUOTE NC2144.2 +004800 ALSO SPACES. NC2144.2 +004900* NC2144.2 +005000* NC2144.2 +005100* COLLATING-AND-ALPHABET-TEST-9 ***** TEST OF SYNTAX NC2144.2 +005200* ON THE PROGRAM COLLATING SEQUENCE CLAUSE AND ALPHABET-NAME NC2144.2 +005300* CLAUSES. NC2144.2 +005400* NC2144.2 +005500* NC2144.2 +005600 INPUT-OUTPUT SECTION. NC2144.2 +005700 FILE-CONTROL. NC2144.2 +005800 SELECT PRINT-FILE ASSIGN TO NC2144.2 +005900 "report.log". NC2144.2 +006000 DATA DIVISION. NC2144.2 +006100 FILE SECTION. NC2144.2 +006200 FD PRINT-FILE. NC2144.2 +006300 01 PRINT-REC PICTURE X(120). NC2144.2 +006400 01 DUMMY-RECORD PICTURE X(120). NC2144.2 +006500 WORKING-STORAGE SECTION. NC2144.2 +006600 01 WRK-DU-6V0-1 PIC 9(6) VALUE ZERO. NC2144.2 +006700 01 WRK-DU-5V0-1 PIC 9(5) VALUE ZERO. NC2144.2 +006800 01 WRK-DU-8V0-1 PIC 9(8) VALUE ZERO. NC2144.2 +006900 01 WRK-XN-120-1 PIC X(120) VALUE NC2144.2 +007000 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC2144.2 +007100- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC2144.2 +007200- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC2144.2 +007300- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""NC2144.2 +007400- "". NC2144.2 +007500 01 WRK-DU-2V1-1 PIC 99V9 VALUE ZERO. NC2144.2 +007600 01 WRK-DU-0V1-1 PIC V9 VALUE .1. NC2144.2 +007700 01 WRK-DU-2V1-2 PIC 99V9 VALUE 0.1. NC2144.2 +007800 01 WRK-DU-2V1-3 PIC 99V9 VALUE 11.1. NC2144.2 +007900 01 WRK-DU-1V0-1 PIC 9 VALUE 9. NC2144.2 +008000 01 WRK-DU-1V0-2 PIC 9 VALUE 2. NC2144.2 +008100 01 WRK-DU-1V0-3 PIC 9 VALUE 3. NC2144.2 +008200 01 WRK-DU-1V0-4 PIC 9 VALUE ZERO. NC2144.2 +008300 01 WRK-DU-2V0-1 PIC 99 VALUE 10. NC2144.2 +008400 01 WRK-DU-2V0-2 PIC 99 VALUE 11. NC2144.2 +008500 01 WRK-DU-2V0-3 PIC 99 VALUE 12. NC2144.2 +008600 01 COUNT-DU-6V0 PIC 9(6). NC2144.2 +008700 01 TEST-RESULTS. NC2144.2 +008800 02 FILLER PIC X VALUE SPACE. NC2144.2 +008900 02 FEATURE PIC X(20) VALUE SPACE. NC2144.2 +009000 02 FILLER PIC X VALUE SPACE. NC2144.2 +009100 02 P-OR-F PIC X(5) VALUE SPACE. NC2144.2 +009200 02 FILLER PIC X VALUE SPACE. NC2144.2 +009300 02 PAR-NAME. NC2144.2 +009400 03 FILLER PIC X(19) VALUE SPACE. NC2144.2 +009500 03 PARDOT-X PIC X VALUE SPACE. NC2144.2 +009600 03 DOTVALUE PIC 99 VALUE ZERO. NC2144.2 +009700 02 FILLER PIC X(8) VALUE SPACE. NC2144.2 +009800 02 RE-MARK PIC X(61). NC2144.2 +009900 01 TEST-COMPUTED. NC2144.2 +010000 02 FILLER PIC X(30) VALUE SPACE. NC2144.2 +010100 02 FILLER PIC X(17) VALUE NC2144.2 +010200 " COMPUTED=". NC2144.2 +010300 02 COMPUTED-X. NC2144.2 +010400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2144.2 +010500 03 COMPUTED-N REDEFINES COMPUTED-A NC2144.2 +010600 PIC -9(9).9(9). NC2144.2 +010700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2144.2 +010800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2144.2 +010900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2144.2 +011000 03 CM-18V0 REDEFINES COMPUTED-A. NC2144.2 +011100 04 COMPUTED-18V0 PIC -9(18). NC2144.2 +011200 04 FILLER PIC X. NC2144.2 +011300 03 FILLER PIC X(50) VALUE SPACE. NC2144.2 +011400 01 TEST-CORRECT. NC2144.2 +011500 02 FILLER PIC X(30) VALUE SPACE. NC2144.2 +011600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2144.2 +011700 02 CORRECT-X. NC2144.2 +011800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2144.2 +011900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2144.2 +012000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2144.2 +012100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2144.2 +012200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2144.2 +012300 03 CR-18V0 REDEFINES CORRECT-A. NC2144.2 +012400 04 CORRECT-18V0 PIC -9(18). NC2144.2 +012500 04 FILLER PIC X. NC2144.2 +012600 03 FILLER PIC X(2) VALUE SPACE. NC2144.2 +012700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2144.2 +012800 01 CCVS-C-1. NC2144.2 +012900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2144.2 +013000- "SS PARAGRAPH-NAME NC2144.2 +013100- " REMARKS". NC2144.2 +013200 02 FILLER PIC X(20) VALUE SPACE. NC2144.2 +013300 01 CCVS-C-2. NC2144.2 +013400 02 FILLER PIC X VALUE SPACE. NC2144.2 +013500 02 FILLER PIC X(6) VALUE "TESTED". NC2144.2 +013600 02 FILLER PIC X(15) VALUE SPACE. NC2144.2 +013700 02 FILLER PIC X(4) VALUE "FAIL". NC2144.2 +013800 02 FILLER PIC X(94) VALUE SPACE. NC2144.2 +013900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2144.2 +014000 01 REC-CT PIC 99 VALUE ZERO. NC2144.2 +014100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2144.2 +014200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2144.2 +014300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2144.2 +014400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2144.2 +014500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2144.2 +014600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2144.2 +014700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2144.2 +014800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2144.2 +014900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2144.2 +015000 01 CCVS-H-1. NC2144.2 +015100 02 FILLER PIC X(39) VALUE SPACES. NC2144.2 +015200 02 FILLER PIC X(42) VALUE NC2144.2 +015300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2144.2 +015400 02 FILLER PIC X(39) VALUE SPACES. NC2144.2 +015500 01 CCVS-H-2A. NC2144.2 +015600 02 FILLER PIC X(40) VALUE SPACE. NC2144.2 +015700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2144.2 +015800 02 FILLER PIC XXXX VALUE NC2144.2 +015900 "4.2 ". NC2144.2 +016000 02 FILLER PIC X(28) VALUE NC2144.2 +016100 " COPY - NOT FOR DISTRIBUTION". NC2144.2 +016200 02 FILLER PIC X(41) VALUE SPACE. NC2144.2 +016300 NC2144.2 +016400 01 CCVS-H-2B. NC2144.2 +016500 02 FILLER PIC X(15) VALUE NC2144.2 +016600 "TEST RESULT OF ". NC2144.2 +016700 02 TEST-ID PIC X(9). NC2144.2 +016800 02 FILLER PIC X(4) VALUE NC2144.2 +016900 " IN ". NC2144.2 +017000 02 FILLER PIC X(12) VALUE NC2144.2 +017100 " HIGH ". NC2144.2 +017200 02 FILLER PIC X(22) VALUE NC2144.2 +017300 " LEVEL VALIDATION FOR ". NC2144.2 +017400 02 FILLER PIC X(58) VALUE NC2144.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2144.2 +017600 01 CCVS-H-3. NC2144.2 +017700 02 FILLER PIC X(34) VALUE NC2144.2 +017800 " FOR OFFICIAL USE ONLY ". NC2144.2 +017900 02 FILLER PIC X(58) VALUE NC2144.2 +018000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2144.2 +018100 02 FILLER PIC X(28) VALUE NC2144.2 +018200 " COPYRIGHT 1985 ". NC2144.2 +018300 01 CCVS-E-1. NC2144.2 +018400 02 FILLER PIC X(52) VALUE SPACE. NC2144.2 +018500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2144.2 +018600 02 ID-AGAIN PIC X(9). NC2144.2 +018700 02 FILLER PIC X(45) VALUE SPACES. NC2144.2 +018800 01 CCVS-E-2. NC2144.2 +018900 02 FILLER PIC X(31) VALUE SPACE. NC2144.2 +019000 02 FILLER PIC X(21) VALUE SPACE. NC2144.2 +019100 02 CCVS-E-2-2. NC2144.2 +019200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2144.2 +019300 03 FILLER PIC X VALUE SPACE. NC2144.2 +019400 03 ENDER-DESC PIC X(44) VALUE NC2144.2 +019500 "ERRORS ENCOUNTERED". NC2144.2 +019600 01 CCVS-E-3. NC2144.2 +019700 02 FILLER PIC X(22) VALUE NC2144.2 +019800 " FOR OFFICIAL USE ONLY". NC2144.2 +019900 02 FILLER PIC X(12) VALUE SPACE. NC2144.2 +020000 02 FILLER PIC X(58) VALUE NC2144.2 +020100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2144.2 +020200 02 FILLER PIC X(13) VALUE SPACE. NC2144.2 +020300 02 FILLER PIC X(15) VALUE NC2144.2 +020400 " COPYRIGHT 1985". NC2144.2 +020500 01 CCVS-E-4. NC2144.2 +020600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2144.2 +020700 02 FILLER PIC X(4) VALUE " OF ". NC2144.2 +020800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2144.2 +020900 02 FILLER PIC X(40) VALUE NC2144.2 +021000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2144.2 +021100 01 XXINFO. NC2144.2 +021200 02 FILLER PIC X(19) VALUE NC2144.2 +021300 "*** INFORMATION ***". NC2144.2 +021400 02 INFO-TEXT. NC2144.2 +021500 04 FILLER PIC X(8) VALUE SPACE. NC2144.2 +021600 04 XXCOMPUTED PIC X(20). NC2144.2 +021700 04 FILLER PIC X(5) VALUE SPACE. NC2144.2 +021800 04 XXCORRECT PIC X(20). NC2144.2 +021900 02 INF-ANSI-REFERENCE PIC X(48). NC2144.2 +022000 01 HYPHEN-LINE. NC2144.2 +022100 02 FILLER PIC IS X VALUE IS SPACE. NC2144.2 +022200 02 FILLER PIC IS X(65) VALUE IS "************************NC2144.2 +022300- "*****************************************". NC2144.2 +022400 02 FILLER PIC IS X(54) VALUE IS "************************NC2144.2 +022500- "******************************". NC2144.2 +022600 01 CCVS-PGM-ID PIC X(9) VALUE NC2144.2 +022700 "NC214M". NC2144.2 +022800 PROCEDURE DIVISION. NC2144.2 +022900 CCVS1 SECTION. NC2144.2 +023000 OPEN-FILES. NC2144.2 +023100 OPEN OUTPUT PRINT-FILE. NC2144.2 +023200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2144.2 +023300 MOVE SPACE TO TEST-RESULTS. NC2144.2 +023400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2144.2 +023500 GO TO CCVS1-EXIT. NC2144.2 +023600 CLOSE-FILES. NC2144.2 +023700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2144.2 +023800 TERMINATE-CCVS. NC2144.2 +023900*S EXIT PROGRAM. NC2144.2 +024000*SERMINATE-CALL. NC2144.2 +024100 STOP RUN. NC2144.2 +024200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2144.2 +024300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2144.2 +024400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2144.2 +024500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2144.2 +024600 MOVE "****TEST DELETED****" TO RE-MARK. NC2144.2 +024700 PRINT-DETAIL. NC2144.2 +024800 IF REC-CT NOT EQUAL TO ZERO NC2144.2 +024900 MOVE "." TO PARDOT-X NC2144.2 +025000 MOVE REC-CT TO DOTVALUE. NC2144.2 +025100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2144.2 +025200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2144.2 +025300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2144.2 +025400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2144.2 +025500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2144.2 +025600 MOVE SPACE TO CORRECT-X. NC2144.2 +025700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2144.2 +025800 MOVE SPACE TO RE-MARK. NC2144.2 +025900 HEAD-ROUTINE. NC2144.2 +026000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +026100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +026200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2144.2 +026300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2144.2 +026400 COLUMN-NAMES-ROUTINE. NC2144.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +026800 END-ROUTINE. NC2144.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2144.2 +027000 END-RTN-EXIT. NC2144.2 +027100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +027200 END-ROUTINE-1. NC2144.2 +027300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2144.2 +027400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2144.2 +027500 ADD PASS-COUNTER TO ERROR-HOLD. NC2144.2 +027600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2144.2 +027700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2144.2 +027800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2144.2 +027900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2144.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2144.2 +028100 END-ROUTINE-12. NC2144.2 +028200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2144.2 +028300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2144.2 +028400 MOVE "NO " TO ERROR-TOTAL NC2144.2 +028500 ELSE NC2144.2 +028600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2144.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2144.2 +028800 PERFORM WRITE-LINE. NC2144.2 +028900 END-ROUTINE-13. NC2144.2 +029000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2144.2 +029100 MOVE "NO " TO ERROR-TOTAL ELSE NC2144.2 +029200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2144.2 +029300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2144.2 +029400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +029500 IF INSPECT-COUNTER EQUAL TO ZERO NC2144.2 +029600 MOVE "NO " TO ERROR-TOTAL NC2144.2 +029700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2144.2 +029800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2144.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +030000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2144.2 +030100 WRITE-LINE. NC2144.2 +030200 ADD 1 TO RECORD-COUNT. NC2144.2 +030300 IF RECORD-COUNT GREATER 50 NC2144.2 +030400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2144.2 +030500 MOVE SPACE TO DUMMY-RECORD NC2144.2 +030600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2144.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2144.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2144.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2144.2 +031000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2144.2 +031100 MOVE ZERO TO RECORD-COUNT. NC2144.2 +031200 PERFORM WRT-LN. NC2144.2 +031300 WRT-LN. NC2144.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2144.2 +031500 MOVE SPACE TO DUMMY-RECORD. NC2144.2 +031600 BLANK-LINE-PRINT. NC2144.2 +031700 PERFORM WRT-LN. NC2144.2 +031800 FAIL-ROUTINE. NC2144.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2144.2 +032000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2144.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2144.2 +032200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2144.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2144.2 +032500 GO TO FAIL-ROUTINE-EX. NC2144.2 +032600 FAIL-ROUTINE-WRITE. NC2144.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2144.2 +032800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2144.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2144.2 +033000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2144.2 +033100 FAIL-ROUTINE-EX. EXIT. NC2144.2 +033200 BAIL-OUT. NC2144.2 +033300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2144.2 +033400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2144.2 +033500 BAIL-OUT-WRITE. NC2144.2 +033600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2144.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2144.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2144.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2144.2 +034000 BAIL-OUT-EX. EXIT. NC2144.2 +034100 CCVS1-EXIT. NC2144.2 +034200 EXIT. NC2144.2 +034300 SECT-NC214M-001 SECTION. NC2144.2 +034400 ACC-INIT-F2-1. NC2144.2 +034500* ===---> TEST THE ACCEPT FROM DATE STATEMENT <---=== NC2144.2 +034600 MOVE "ACC-TEST-F2-1" TO PAR-NAME. NC2144.2 +034700 MOVE "VI-72 6.5.4 GR7" TO ANSI-REFERENCE. NC2144.2 +034800 MOVE "ACCEPT DATE" TO FEATURE. NC2144.2 +034900 ACC-TEST-F2-1. NC2144.2 +035000 ACCEPT WRK-DU-6V0-1 FROM DATE. NC2144.2 +035100 MOVE WRK-DU-6V0-1 TO COMPUTED-N. NC2144.2 +035200 MOVE "DATE YYMMDD FORMAT" TO CORRECT-A. NC2144.2 +035300 MOVE "CHECK VISUALLY" TO RE-MARK. NC2144.2 +035400 GO TO ACC-WRITE-F2-1. NC2144.2 +035500 ACC-DELETE-F2-1. NC2144.2 +035600 PERFORM DE-LETE. NC2144.2 +035700 ACC-WRITE-F2-1. NC2144.2 +035800 PERFORM PRINT-DETAIL. NC2144.2 +035900* NC2144.2 +036000 ACC-INIT-F2-2. NC2144.2 +036100* ===---> TEST THE ACCEPT FROM DAY STATEMENT <---=== NC2144.2 +036200 MOVE "ACC-TEST-F2-2" TO PAR-NAME. NC2144.2 +036300 MOVE "VI-72 6.5.4 GR8" TO ANSI-REFERENCE. NC2144.2 +036400 MOVE "ACCEPT DAY" TO FEATURE. NC2144.2 +036500 ACC-TEST-F2-2. NC2144.2 +036600 ACCEPT WRK-DU-5V0-1 FROM DAY. NC2144.2 +036700 MOVE WRK-DU-5V0-1 TO COMPUTED-N. NC2144.2 +036800 MOVE "DAY YYDDD FORMAT" TO CORRECT-A. NC2144.2 +036900 MOVE "CHECK VISUALLY" TO RE-MARK. NC2144.2 +037000 GO TO ACC-WRITE-F2-2. NC2144.2 +037100 ACC-DELETE-F2-2. NC2144.2 +037200 PERFORM DE-LETE. NC2144.2 +037300 ACC-WRITE-F2-2. NC2144.2 +037400 PERFORM PRINT-DETAIL. NC2144.2 +037500* NC2144.2 +037600 ACC-INIT-F2-3. NC2144.2 +037700* ===---> TEST THE ACCEPT FROM TIME STATEMENT <---=== NC2144.2 +037800 MOVE "ACC-TEST-F2-3" TO PAR-NAME. NC2144.2 +037900 MOVE "VI-72 6.5.4 GR9" TO ANSI-REFERENCE. NC2144.2 +038000 MOVE "ACCEPT TIME" TO FEATURE. NC2144.2 +038100 ACC-TEST-F2-3. NC2144.2 +038200 ACCEPT WRK-DU-8V0-1 FROM TIME. NC2144.2 +038300 MOVE WRK-DU-8V0-1 TO COMPUTED-N. NC2144.2 +038400 MOVE "HHMMSSFF FORMAT" TO CORRECT-A. NC2144.2 +038500 MOVE "CHECK VISUALLY" TO RE-MARK. NC2144.2 +038600 GO TO ACC-WRITE-F2-3. NC2144.2 +038700 ACC-DELETE-F2-3. NC2144.2 +038800 PERFORM DE-LETE. NC2144.2 +038900 ACC-WRITE-F2-3. NC2144.2 +039000 PERFORM PRINT-DETAIL. NC2144.2 +039100* NC2144.2 +039200 ACC-INIT-F2-4. NC2144.2 +039300* ===---> TEST THE ACCEPT FROM DAY-OF-WEEK STATEMENT <---=== NC2144.2 +039400 MOVE "ACC-TEST-F2-4" TO PAR-NAME. NC2144.2 +039500 MOVE "VI-72 6.5.4 GR10" TO ANSI-REFERENCE. NC2144.2 +039600 MOVE "ACCEPT DAY-OF-WEEK" TO FEATURE. NC2144.2 +039700 ACC-TEST-F2-4. NC2144.2 +039800 ACCEPT WRK-DU-1V0-1 FROM DAY-OF-WEEK. NC2144.2 +039900 MOVE WRK-DU-1V0-1 TO COMPUTED-N. NC2144.2 +040000 MOVE "SINGLE DIGIT INTEGER REPRESENTING DAY" TO CORRECT-A. NC2144.2 +040100 MOVE "CHECK VISUALLY" TO RE-MARK. NC2144.2 +040200 GO TO ACC-WRITE-F2-4. NC2144.2 +040300 ACC-DELETE-F2-4. NC2144.2 +040400 PERFORM DE-LETE. NC2144.2 +040500 ACC-WRITE-F2-4. NC2144.2 +040600 PERFORM PRINT-DETAIL. NC2144.2 +040700 CCVS-EXIT SECTION. NC2144.2 +040800 CCVS-999999. NC2144.2 +040900 GO TO CLOSE-FILES. NC2144.2 diff --git a/tests/cobol85/NC/NC215A.CBL b/tests/cobol85/NC/NC215A.CBL new file mode 100755 index 00000000..78ce6dcc --- /dev/null +++ b/tests/cobol85/NC/NC215A.CBL @@ -0,0 +1,483 @@ +000100 IDENTIFICATION DIVISION. NC2154.2 +000200 PROGRAM-ID. NC2154.2 +000300 NC215A. NC2154.2 +000400**************************************************************** NC2154.2 +000500* * NC2154.2 +000600* VALIDATION FOR:- * NC2154.2 +000700* * NC2154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2154.2 +000900* * NC2154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2154.2 +001100* * NC2154.2 +001200**************************************************************** NC2154.2 +001300* * NC2154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2154.2 +001500* * NC2154.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2154.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2154.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2154.2 +001900* * NC2154.2 +002000**************************************************************** NC2154.2 +002100* NC2154.2 +002200* * NC2154.2 +002300* PROGRAM NC215A TESTS THE LITERAL PHRASE OF THE "ALPHABET" * NC2154.2 +002400* CLAUSE OF THE "SPECIAL-NAMES" PARAGRAPH AND THE * NC2154.2 +002500* "PROGRAM COLLATING SEQUENCE" OF THE "OBJECT COMPUTER * NC2154.2 +002600* PARAGRAPH. * NC2154.2 +002700* * NC2154.2 +002800**************************************************************** NC2154.2 +002900 ENVIRONMENT DIVISION. NC2154.2 +003000 CONFIGURATION SECTION. NC2154.2 +003100 SOURCE-COMPUTER. NC2154.2 +003200 Linux. NC2154.2 +003300 OBJECT-COMPUTER. NC2154.2 +003400 Linux NC2154.2 +003500 PROGRAM COLLATING SEQUENCE IS THE-WILD-ONE. NC2154.2 +003600 SPECIAL-NAMES. NC2154.2 +003700 ALPHABET NC2154.2 +003800 THE-WILD-ONE IS "A" THRU "H" "I" ALSO "J", ALSO "K", ALSO NC2154.2 +003900 "L" ALSO "M" ALSO "N" "O" THROUGH "Z" "0" THRU "9", NC2154.2 +004000* NC2154.2 +004100* NC2154.2 +004200*ALPHABET-TEST-10 ***** THE WHOLE ALPHABET IS ONE LITERAL NC2154.2 +004300* WITH ALL 51 CHARACTERS IN THE COBOL CHARACTER SET. TEST-10 NC2154.2 +004400* IS ONLY A SYNTAX CHECK ON NC2154.2 +004500* ALPHABET-NAME IS LITERAL. NC2154.2 +004600* NC2154.2 +004700* NC2154.2 +004800 ALPHABET NC2154.2 +004900 THE-BIG-OL-LITERAL-ALPHABET IS "A+0B-1C*2D/3E=4Fl5G,6H;7I.8J"NC2154.2 +005000- ""9K(L)M>N B-AN-1 PERFORM PASS NC2154.2 +036100 ELSE NC2154.2 +036200 GO TO SEQ-FAIL-GF-2. NC2154.2 +036300 GO TO SEQ-WRITE-GF-2. NC2154.2 +036400 SEQ-DELETE-GF-2. NC2154.2 +036500 PERFORM DE-LETE. NC2154.2 +036600 GO TO SEQ-WRITE-GF-2. NC2154.2 +036700 SEQ-FAIL-GF-2. NC2154.2 +036800 MOVE "H I J B NOT SEQUENCED" TO COMPUTED-A. NC2154.2 +036900 PERFORM FAIL. NC2154.2 +037000 SEQ-WRITE-GF-2. NC2154.2 +037100 PERFORM PRINT-DETAIL. NC2154.2 +037200* NC2154.2 +037300 SEQ-INIT-GF-3. NC2154.2 +037400 MOVE "SEQ-TEST-GF-3" TO PAR-NAME. NC2154.2 +037500 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +037600 MOVE "I J K L M N EQUAL" TO FEATURE. NC2154.2 +037700 MOVE "I" TO I-AN-1. NC2154.2 +037800 MOVE "J" TO J-AN-1. NC2154.2 +037900 MOVE "K" TO K-AN-1. NC2154.2 +038000 MOVE "L" TO L-AN-1. NC2154.2 +038100 MOVE "M" TO M-AN-1. NC2154.2 +038200 MOVE "N" TO N-AN-1. NC2154.2 +038300 SEQ-TEST-GF-3. NC2154.2 +038400 IF I-AN-1 = J-AN-1 AND K-AN-1 AND L-AN-1 AND M-AN-1 NC2154.2 +038500 AND N-AN-1 PERFORM PASS NC2154.2 +038600 ELSE NC2154.2 +038700 GO TO SEQ-FAIL-GF-3. NC2154.2 +038800 GO TO SEQ-WRITE-GF-3. NC2154.2 +038900 SEQ-DELETE-GF-3. NC2154.2 +039000 PERFORM DE-LETE. NC2154.2 +039100 GO TO SEQ-WRITE-GF-3. NC2154.2 +039200 SEQ-FAIL-GF-3. NC2154.2 +039300 MOVE "I J K L M N NOT =" TO COMPUTED-A. NC2154.2 +039400 PERFORM FAIL. NC2154.2 +039500 SEQ-WRITE-GF-3. NC2154.2 +039600 PERFORM PRINT-DETAIL. NC2154.2 +039700* NC2154.2 +039800 SEQ-INIT-GF-4. NC2154.2 +039900 MOVE "SEQ-TEST-GF-4" TO PAR-NAME. NC2154.2 +040000 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +040100 MOVE "O > THAN N" TO FEATURE. NC2154.2 +040200 MOVE "O" TO O-AN-1. NC2154.2 +040300 MOVE "N" TO N-AN-1. NC2154.2 +040400 SEQ-TEST-GF-4. NC2154.2 +040500 IF O-AN-1 > N-AN-1 PERFORM PASS NC2154.2 +040600 ELSE NC2154.2 +040700 GO TO SEQ-FAIL-GF-4. NC2154.2 +040800 GO TO SEQ-WRITE-GF-4. NC2154.2 +040900 SEQ-DELETE-GF-4. NC2154.2 +041000 PERFORM DE-LETE. NC2154.2 +041100 GO TO SEQ-WRITE-GF-4. NC2154.2 +041200 SEQ-FAIL-GF-4. NC2154.2 +041300 MOVE "O NOT > THAN N" TO COMPUTED-A. NC2154.2 +041400 PERFORM FAIL. NC2154.2 +041500 SEQ-WRITE-GF-4. NC2154.2 +041600 PERFORM PRINT-DETAIL. NC2154.2 +041700* NC2154.2 +041800 SEQ-INIT-GF-5. NC2154.2 +041900 MOVE "SEQ-TEST-GF-5" TO PAR-NAME. NC2154.2 +042000 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +042100 MOVE "A < THAN ZERO" TO FEATURE. NC2154.2 +042200 MOVE "A" TO A-AN-1. NC2154.2 +042300 MOVE ZERO TO ZERO-DU-9V0-1. NC2154.2 +042400 SEQ-TEST-GF-5. NC2154.2 +042500 IF A-AN-1 < ZERO-DU-9V0-1 PERFORM PASS NC2154.2 +042600 ELSE NC2154.2 +042700 GO TO SEQ-FAIL-GF-5. NC2154.2 +042800 GO TO SEQ-WRITE-GF-5. NC2154.2 +042900 SEQ-DELETE-GF-5. NC2154.2 +043000 PERFORM DE-LETE. NC2154.2 +043100 GO TO SEQ-WRITE-GF-5. NC2154.2 +043200 SEQ-FAIL-GF-5. NC2154.2 +043300 MOVE "A FOUND > THAN ZERO" TO COMPUTED-A. NC2154.2 +043400 PERFORM FAIL. NC2154.2 +043500 SEQ-WRITE-GF-5. NC2154.2 +043600 PERFORM PRINT-DETAIL. NC2154.2 +043700* NC2154.2 +043800 SEQ-INIT-GF-6. NC2154.2 +043900 MOVE "SEQ-TEST-GF-6" TO PAR-NAME. NC2154.2 +044000 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +044100 MOVE "NINE < THAN SPACE" TO FEATURE. NC2154.2 +044200 MOVE 9 TO NINE-DU-9V0-1. NC2154.2 +044300 SEQ-TEST-GF-6. NC2154.2 +044400 IF NINE-DU-9V0-1 < SPACE PERFORM PASS NC2154.2 +044500 ELSE NC2154.2 +044600 GO TO SEQ-FAIL-GF-6. NC2154.2 +044700 GO TO SEQ-WRITE-GF-6. NC2154.2 +044800 SEQ-DELETE-GF-6. NC2154.2 +044900 PERFORM DE-LETE. NC2154.2 +045000 GO TO SEQ-WRITE-GF-6. NC2154.2 +045100 SEQ-FAIL-GF-6. NC2154.2 +045200 MOVE "9 FOUND > THAN SPACE" TO COMPUTED-A. NC2154.2 +045300 PERFORM FAIL. NC2154.2 +045400 SEQ-WRITE-GF-6. NC2154.2 +045500 PERFORM PRINT-DETAIL. NC2154.2 +045600* NC2154.2 +045700 SEQ-INIT-GF-7. NC2154.2 +045800 MOVE "SEQ-TEST-GF-7" TO PAR-NAME. NC2154.2 +045900 MOVE "VI-15 4.5.4 GR4(D)" TO ANSI-REFERENCE. NC2154.2 +046000 MOVE "NINE < THAN QUOTE" TO FEATURE. NC2154.2 +046100 MOVE 9 TO NINE-DU-9V0-1. NC2154.2 +046200 SEQ-TEST-GF-7. NC2154.2 +046300 IF NINE-DU-9V0-1 < QUOTE PERFORM PASS NC2154.2 +046400 ELSE NC2154.2 +046500 GO TO SEQ-FAIL-GF-7. NC2154.2 +046600 GO TO SEQ-WRITE-GF-7. NC2154.2 +046700 SEQ-DELETE-GF-7. NC2154.2 +046800 PERFORM DE-LETE. NC2154.2 +046900 GO TO SEQ-WRITE-GF-7. NC2154.2 +047000 SEQ-FAIL-GF-7. NC2154.2 +047100 MOVE "NINE FOUND > QUOTE" TO COMPUTED-A. NC2154.2 +047200 PERFORM FAIL. NC2154.2 +047300 SEQ-WRITE-GF-7. NC2154.2 +047400 PERFORM PRINT-DETAIL. NC2154.2 +047500* NC2154.2 +047600 ALPHABET-TEST-10. NC2154.2 +047700 PERFORM END-ROUTINE. NC2154.2 +047800 MOVE " ALPHABET-NAME ***** CHECK THE ALPHABET-NAMENC2154.2 +047900- " IN THE SPECIAL-NAMES PARAGRAPH" TO TEST-RESULTS. NC2154.2 +048000 PERFORM PRINT-DETAIL. NC2154.2 +048100 CCVS-EXIT SECTION. NC2154.2 +048200 CCVS-999999. NC2154.2 +048300 GO TO CLOSE-FILES. NC2154.2 diff --git a/tests/cobol85/NC/NC216A.CBL b/tests/cobol85/NC/NC216A.CBL new file mode 100755 index 00000000..93fb43fb --- /dev/null +++ b/tests/cobol85/NC/NC216A.CBL @@ -0,0 +1,2227 @@ +000100 IDENTIFICATION DIVISION. NC2164.2 +000200 PROGRAM-ID. NC2164.2 +000300 NC216A. NC2164.2 +000400**************************************************************** NC2164.2 +000500* * NC2164.2 +000600* VALIDATION FOR:- * NC2164.2 +000700* * NC2164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2164.2 +000900* * NC2164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2164.2 +001100* * NC2164.2 +001200**************************************************************** NC2164.2 +001300* * NC2164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2164.2 +001500* * NC2164.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2164.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2164.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2164.2 +001900* * NC2164.2 +002000**************************************************************** NC2164.2 +002100* * NC2164.2 +002200* PROGRAM NC216A TESTS ALL FOUR FORMATS OF THE "INSPECT" * NC2164.2 +002300* STATEMENT USING VARIOUS COMBINATIONS OF THE OPTIONAL * NC2164.2 +002400* PHRASES: CHARACTERS, ALL, LEADING, FIRST, BEFORE, AFTER. * NC2164.2 +002500* * NC2164.2 +002600**************************************************************** NC2164.2 +002700 ENVIRONMENT DIVISION. NC2164.2 +002800 CONFIGURATION SECTION. NC2164.2 +002900 SOURCE-COMPUTER. NC2164.2 +003000 Linux. NC2164.2 +003100 OBJECT-COMPUTER. NC2164.2 +003200 Linux. NC2164.2 +003300 INPUT-OUTPUT SECTION. NC2164.2 +003400 FILE-CONTROL. NC2164.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2164.2 +003600 "report.log". NC2164.2 +003700 DATA DIVISION. NC2164.2 +003800 FILE SECTION. NC2164.2 +003900 FD PRINT-FILE. NC2164.2 +004000 01 PRINT-REC PICTURE X(120). NC2164.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2164.2 +004200 WORKING-STORAGE SECTION. NC2164.2 +004300 01 WRK-DU-999-1 PIC 999. NC2164.2 +004400 01 WRK-DU-999-2 PIC 999. NC2164.2 +004500 01 WRK-DU-999-3 PIC 999. NC2164.2 +004600 01 WRK-DU-999-4 PIC 999. NC2164.2 +004700 01 JUST-XN-20-1 PIC X(20) JUSTIFIED. NC2164.2 +004800 01 SPACE-XN-1-1 PIC X VALUE SPACE. NC2164.2 +004900 01 COMMA-XN-1-1 PIC X VALUE ",". NC2164.2 +005000 01 HYPEN-XN-1-1 PIC X VALUE "-". NC2164.2 +005100 01 A-XN-1-1 PIC X VALUE "A". NC2164.2 +005200 01 D-XN-1-1 PIC X VALUE "D". NC2164.2 +005300 01 G-XN-1-1 PIC X VALUE "G". NC2164.2 +005400 01 H-XN-1-1 PIC X VALUE "H". NC2164.2 +005500 01 L-XN-1-1 PIC X VALUE "L". NC2164.2 +005600 01 O-XN-1-1 PIC X VALUE "O". NC2164.2 +005700 01 P-XN-1-1 PIC X VALUE "P". NC2164.2 +005800 01 S-XN-1-1 PIC X VALUE "S". NC2164.2 +005900 01 Z-XN-1-1 PIC X VALUE "Z". NC2164.2 +006000 01 AH-XN-2 PIC X(2) VALUE "AH". NC2164.2 +006100 01 HSPACE-XN-2 PIC X(2) VALUE "H ". NC2164.2 +006200 01 OH-XN-2 PIC X(2) VALUE "OH". NC2164.2 +006300 01 ALL-XN-3 PIC X(3) VALUE "ALL". NC2164.2 +006400 01 YES-XN-3 PIC X(3) VALUE "YES". NC2164.2 +006500 01 X-SPACE-X-XN-3 PICTURE X(3) VALUE "X X". NC2164.2 +006600 01 AABA-XN-4 PICTURE X(4) VALUE "AABA". NC2164.2 +006700 01 WRK-XN-83-1 PIC X(83). NC2164.2 +006800 01 WRK-XN-83-2 PIC X(83). NC2164.2 +006900 01 WRK-DS-5V0-1 PIC S9(5) VALUE -12345. NC2164.2 +007000 01 WRK-NE-1 PIC -999,999.99/9 VALUE "-123,456.78/9". NC2164.2 +007100 01 KIDS-CAN-NOT-BE PIC X(15) VALUE "KIDS CAN NOT BE". NC2164.2 +007200 01 BLANK-PERIOD PIC X(2) VALUE " ." . NC2164.2 +007300 01 WC-XN-83 PIC X(83) VALUE NC2164.2 +007400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +007500- "IDS CAN NOT BE ALL BAD.". NC2164.2 +007600 01 ANS-XN-83-1 PIC X(83) VALUE NC2164.2 +007700 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +007800- "IDS CAN NOT BE ALL BAD.". NC2164.2 +007900 01 ANS-XN-83-2 PIC X(83) VALUE NC2164.2 +008000 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +008100- "IDS CAN NOT BE ALL BAD.". NC2164.2 +008200 01 ANS-XN-83-3 PIC X(83) VALUE NC2164.2 +008300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +008400- "IDS CAN NOT BE ALL-BAD.". NC2164.2 +008500 01 ANS-XN-83-4 PIC X(83) VALUE NC2164.2 +008600 "EH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +008700- "IDS CAN NOT BE ALL BAD.". NC2164.2 +008800 01 ANS-XN-83-5 PIC X(83) VALUE NC2164.2 +008900 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +009000- "IDS CAN NOT BE ALL BAD.". NC2164.2 +009100 01 ANS-XN-83-6 PIC X(83) VALUE NC2164.2 +009200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +009300- "IDS CAN NOT BE ALZZZZZZ". NC2164.2 +009400 01 ANS-XN-83-7 PIC X(83) VALUE NC2164.2 +009500 "OH-YES-AH-YES-W.P.-ZRITOES-HERE.-ANYONE-WHO-HATES-DOGS-AND-KNC2164.2 +009600- "IDS-CAN-NOT-BE-ALZZZZZZ". NC2164.2 +009700 01 ANS-XN-83-8 PIC X(83) VALUE NC2164.2 +009800 "AH-YES-AH-YES-W.C.-FRITOES-HERE.-ANYONE-WHO-HATES-DOGS-AND-KNC2164.2 +009900- "IDS-CAN-NOT-BE-ALL-BAD.". NC2164.2 +010000 01 ANS-XN-83-9 PIC X(83) VALUE NC2164.2 +010100 "OH YES AH YES W.C. FROTOES HERE, ANYONE WHO HATES DOGS AND KNC2164.2 +010200- "IDS CAN NOT BE ALL BAD.". NC2164.2 +010300 01 ANS-XN-83-10 PIC X(83) VALUE NC2164.2 +010400 "OH YES AH YES W.C. FRITOES HE NC2164.2 +010500- " BE ALL BAD.". NC2164.2 +010600 01 ANS-XN-83-11 PIC X(83) VALUE NC2164.2 +010700 "OH YES AH NC2164.2 +010800- " D.". NC2164.2 +010900 NC2164.2 +011000 NC2164.2 +011100 01 WS-RIGHT-1-83. NC2164.2 +011200 03 WS-RIGHT-1-20 PIC X(20). NC2164.2 +011300 03 WS-RIGHT-21-40 PIC X(20). NC2164.2 +011400 03 WS-RIGHT-41-60 PIC X(20). NC2164.2 +011500 03 WS-RIGHT-61-80 PIC X(20). NC2164.2 +011600 03 WS-RIGHT-81-83 PIC X(3). NC2164.2 +011700 01 WS-WRONG-1-83. NC2164.2 +011800 03 WS-WRONG-1-20 PIC X(20). NC2164.2 +011900 03 WS-WRONG-21-40 PIC X(20). NC2164.2 +012000 03 WS-WRONG-41-60 PIC X(20). NC2164.2 +012100 03 WS-WRONG-61-80 PIC X(20). NC2164.2 +012200 03 WS-WRONG-81-83 PIC X(3). NC2164.2 +012300 NC2164.2 +012400 01 INSPECT-FIELDS. NC2164.2 +012500 03 GRP-A. NC2164.2 +012600 05 PIC X(7) VALUE "XXXXXXX". NC2164.2 +012700 05 PIC X(7) VALUE "YYYYYYY". NC2164.2 +012800 05 PIC X(7) VALUE "AAABAAA". NC2164.2 +012900 05 PIC X(7) VALUE "SSSSSSS". NC2164.2 +013000 05 PIC X(7) VALUE "TTTTTTT". NC2164.2 +013100 03 GRP-B REDEFINES GRP-A. NC2164.2 +013200 05 DATA-FIELD PIC X(7) OCCURS 5. NC2164.2 +013300 01 LOCATE-CHARS. NC2164.2 +013400 03 GRP-C. NC2164.2 +013500 05 PIC X VALUE "G". NC2164.2 +013600 05 PIC X VALUE "H". NC2164.2 +013700 05 PIC X VALUE "B". NC2164.2 +013800 05 PIC X VALUE "D". NC2164.2 +013900 05 PIC X VALUE "C". NC2164.2 +014000 03 GRP-D REDEFINES GRP-C. NC2164.2 +014100 05 END-CHAR PIC X OCCURS 5. NC2164.2 +014200 01 SUB PIC 9 COMP. NC2164.2 +014300 01 WS-BB PIC XX VALUE "BB". NC2164.2 +014400 01 WS-Y PIC X VALUE "Y". NC2164.2 +014500 01 WS-3 PIC X VALUE "3". NC2164.2 +014600 01 WS-E PIC X VALUE "E". NC2164.2 +014700 01 XN-DF PIC XX VALUE "DF". NC2164.2 +014800 01 XN-67 PIC XX VALUE "67". NC2164.2 +014900 01 XN-B PIC X VALUE "B". NC2164.2 +015000 01 TEST-31-DATA. NC2164.2 +015100 03 FILLER PIC X(48) VALUE NC2164.2 +015200 "AABBCCDDEBBBBGHDDIJJXXAABBCCDDEEEFFGGHHIIJJKKLLM". NC2164.2 +015300 01 TEST-32-DATA. NC2164.2 +015400 03 FILLER PIC X(48) VALUE NC2164.2 +015500 "AABSSSSSEBBTTTT1URSTSTSTVVDYYDEEEFFGSSSSTZSTZSTM". NC2164.2 +015600 01 TEST-34-DATA. NC2164.2 +015700 03 FILLER PIC X(20) VALUE NC2164.2 +015800 "AAFSSA ET U V W H S". NC2164.2 +015900 01 TEST-34-ANSWER. NC2164.2 +016000 03 FILLER PIC X(20) VALUE NC2164.2 +016100 "AAFXXA ET Y Y Y H S". NC2164.2 +016200 01 TEST-35-DATA. NC2164.2 +016300 03 FILLER PIC X(20) VALUE NC2164.2 +016400 "AX SSA YEG U V W H S". NC2164.2 +016500 01 TEST-35-ANSWER. NC2164.2 +016600 03 FILLER PIC X(20) VALUE NC2164.2 +016700 "AX AAA YEG H S". NC2164.2 +016800 01 TEST-38-DATA. NC2164.2 +016900 03 FILLER PIC X(20) VALUE NC2164.2 +017000 "AXESSA YEGTUASSW H S". NC2164.2 +017100 01 TEST-39-DATA. NC2164.2 +017200 03 FILLER PIC X(20) VALUE NC2164.2 +017300 "ABESSA YE TUTCGW H S". NC2164.2 +017400 01 TEST-40-DATA. NC2164.2 +017500 03 FILLER PIC X(13) VALUE NC2164.2 +017600 "GADQAUZTABAGA". NC2164.2 +017700 01 TEST-RESULTS. NC2164.2 +017800 02 FILLER PIC X VALUE SPACE. NC2164.2 +017900 02 FEATURE PIC X(20) VALUE SPACE. NC2164.2 +018000 02 FILLER PIC X VALUE SPACE. NC2164.2 +018100 02 P-OR-F PIC X(5) VALUE SPACE. NC2164.2 +018200 02 FILLER PIC X VALUE SPACE. NC2164.2 +018300 02 PAR-NAME. NC2164.2 +018400 03 FILLER PIC X(19) VALUE SPACE. NC2164.2 +018500 03 PARDOT-X PIC X VALUE SPACE. NC2164.2 +018600 03 DOTVALUE PIC 99 VALUE ZERO. NC2164.2 +018700 02 FILLER PIC X(8) VALUE SPACE. NC2164.2 +018800 02 RE-MARK PIC X(61). NC2164.2 +018900 01 TEST-COMPUTED. NC2164.2 +019000 02 FILLER PIC X(30) VALUE SPACE. NC2164.2 +019100 02 FILLER PIC X(17) VALUE NC2164.2 +019200 " COMPUTED=". NC2164.2 +019300 02 COMPUTED-X. NC2164.2 +019400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2164.2 +019500 03 COMPUTED-N REDEFINES COMPUTED-A NC2164.2 +019600 PIC -9(9).9(9). NC2164.2 +019700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2164.2 +019800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2164.2 +019900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2164.2 +020000 03 CM-18V0 REDEFINES COMPUTED-A. NC2164.2 +020100 04 COMPUTED-18V0 PIC -9(18). NC2164.2 +020200 04 FILLER PIC X. NC2164.2 +020300 03 FILLER PIC X(50) VALUE SPACE. NC2164.2 +020400 01 TEST-CORRECT. NC2164.2 +020500 02 FILLER PIC X(30) VALUE SPACE. NC2164.2 +020600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2164.2 +020700 02 CORRECT-X. NC2164.2 +020800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2164.2 +020900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2164.2 +021000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2164.2 +021100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2164.2 +021200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2164.2 +021300 03 CR-18V0 REDEFINES CORRECT-A. NC2164.2 +021400 04 CORRECT-18V0 PIC -9(18). NC2164.2 +021500 04 FILLER PIC X. NC2164.2 +021600 03 FILLER PIC X(2) VALUE SPACE. NC2164.2 +021700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2164.2 +021800 01 CCVS-C-1. NC2164.2 +021900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2164.2 +022000- "SS PARAGRAPH-NAME NC2164.2 +022100- " REMARKS". NC2164.2 +022200 02 FILLER PIC X(20) VALUE SPACE. NC2164.2 +022300 01 CCVS-C-2. NC2164.2 +022400 02 FILLER PIC X VALUE SPACE. NC2164.2 +022500 02 FILLER PIC X(6) VALUE "TESTED". NC2164.2 +022600 02 FILLER PIC X(15) VALUE SPACE. NC2164.2 +022700 02 FILLER PIC X(4) VALUE "FAIL". NC2164.2 +022800 02 FILLER PIC X(94) VALUE SPACE. NC2164.2 +022900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2164.2 +023000 01 REC-CT PIC 99 VALUE ZERO. NC2164.2 +023100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2164.2 +023200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2164.2 +023300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2164.2 +023400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2164.2 +023500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2164.2 +023600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2164.2 +023700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2164.2 +023800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2164.2 +023900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2164.2 +024000 01 CCVS-H-1. NC2164.2 +024100 02 FILLER PIC X(39) VALUE SPACES. NC2164.2 +024200 02 FILLER PIC X(42) VALUE NC2164.2 +024300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2164.2 +024400 02 FILLER PIC X(39) VALUE SPACES. NC2164.2 +024500 01 CCVS-H-2A. NC2164.2 +024600 02 FILLER PIC X(40) VALUE SPACE. NC2164.2 +024700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2164.2 +024800 02 FILLER PIC XXXX VALUE NC2164.2 +024900 "4.2 ". NC2164.2 +025000 02 FILLER PIC X(28) VALUE NC2164.2 +025100 " COPY - NOT FOR DISTRIBUTION". NC2164.2 +025200 02 FILLER PIC X(41) VALUE SPACE. NC2164.2 +025300 NC2164.2 +025400 01 CCVS-H-2B. NC2164.2 +025500 02 FILLER PIC X(15) VALUE NC2164.2 +025600 "TEST RESULT OF ". NC2164.2 +025700 02 TEST-ID PIC X(9). NC2164.2 +025800 02 FILLER PIC X(4) VALUE NC2164.2 +025900 " IN ". NC2164.2 +026000 02 FILLER PIC X(12) VALUE NC2164.2 +026100 " HIGH ". NC2164.2 +026200 02 FILLER PIC X(22) VALUE NC2164.2 +026300 " LEVEL VALIDATION FOR ". NC2164.2 +026400 02 FILLER PIC X(58) VALUE NC2164.2 +026500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2164.2 +026600 01 CCVS-H-3. NC2164.2 +026700 02 FILLER PIC X(34) VALUE NC2164.2 +026800 " FOR OFFICIAL USE ONLY ". NC2164.2 +026900 02 FILLER PIC X(58) VALUE NC2164.2 +027000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2164.2 +027100 02 FILLER PIC X(28) VALUE NC2164.2 +027200 " COPYRIGHT 1985 ". NC2164.2 +027300 01 CCVS-E-1. NC2164.2 +027400 02 FILLER PIC X(52) VALUE SPACE. NC2164.2 +027500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2164.2 +027600 02 ID-AGAIN PIC X(9). NC2164.2 +027700 02 FILLER PIC X(45) VALUE SPACES. NC2164.2 +027800 01 CCVS-E-2. NC2164.2 +027900 02 FILLER PIC X(31) VALUE SPACE. NC2164.2 +028000 02 FILLER PIC X(21) VALUE SPACE. NC2164.2 +028100 02 CCVS-E-2-2. NC2164.2 +028200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2164.2 +028300 03 FILLER PIC X VALUE SPACE. NC2164.2 +028400 03 ENDER-DESC PIC X(44) VALUE NC2164.2 +028500 "ERRORS ENCOUNTERED". NC2164.2 +028600 01 CCVS-E-3. NC2164.2 +028700 02 FILLER PIC X(22) VALUE NC2164.2 +028800 " FOR OFFICIAL USE ONLY". NC2164.2 +028900 02 FILLER PIC X(12) VALUE SPACE. NC2164.2 +029000 02 FILLER PIC X(58) VALUE NC2164.2 +029100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2164.2 +029200 02 FILLER PIC X(13) VALUE SPACE. NC2164.2 +029300 02 FILLER PIC X(15) VALUE NC2164.2 +029400 " COPYRIGHT 1985". NC2164.2 +029500 01 CCVS-E-4. NC2164.2 +029600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2164.2 +029700 02 FILLER PIC X(4) VALUE " OF ". NC2164.2 +029800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2164.2 +029900 02 FILLER PIC X(40) VALUE NC2164.2 +030000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2164.2 +030100 01 XXINFO. NC2164.2 +030200 02 FILLER PIC X(19) VALUE NC2164.2 +030300 "*** INFORMATION ***". NC2164.2 +030400 02 INFO-TEXT. NC2164.2 +030500 04 FILLER PIC X(8) VALUE SPACE. NC2164.2 +030600 04 XXCOMPUTED PIC X(20). NC2164.2 +030700 04 FILLER PIC X(5) VALUE SPACE. NC2164.2 +030800 04 XXCORRECT PIC X(20). NC2164.2 +030900 02 INF-ANSI-REFERENCE PIC X(48). NC2164.2 +031000 01 HYPHEN-LINE. NC2164.2 +031100 02 FILLER PIC IS X VALUE IS SPACE. NC2164.2 +031200 02 FILLER PIC IS X(65) VALUE IS "************************NC2164.2 +031300- "*****************************************". NC2164.2 +031400 02 FILLER PIC IS X(54) VALUE IS "************************NC2164.2 +031500- "******************************". NC2164.2 +031600 01 CCVS-PGM-ID PIC X(9) VALUE NC2164.2 +031700 "NC216A". NC2164.2 +031800 PROCEDURE DIVISION. NC2164.2 +031900 CCVS1 SECTION. NC2164.2 +032000 OPEN-FILES. NC2164.2 +032100 OPEN OUTPUT PRINT-FILE. NC2164.2 +032200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2164.2 +032300 MOVE SPACE TO TEST-RESULTS. NC2164.2 +032400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2164.2 +032500 GO TO CCVS1-EXIT. NC2164.2 +032600 CLOSE-FILES. NC2164.2 +032700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2164.2 +032800 TERMINATE-CCVS. NC2164.2 +032900*S EXIT PROGRAM. NC2164.2 +033000*SERMINATE-CALL. NC2164.2 +033100 STOP RUN. NC2164.2 +033200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2164.2 +033300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2164.2 +033400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2164.2 +033500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2164.2 +033600 MOVE "****TEST DELETED****" TO RE-MARK. NC2164.2 +033700 PRINT-DETAIL. NC2164.2 +033800 IF REC-CT NOT EQUAL TO ZERO NC2164.2 +033900 MOVE "." TO PARDOT-X NC2164.2 +034000 MOVE REC-CT TO DOTVALUE. NC2164.2 +034100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2164.2 +034200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2164.2 +034300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2164.2 +034400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2164.2 +034500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2164.2 +034600 MOVE SPACE TO CORRECT-X. NC2164.2 +034700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2164.2 +034800 MOVE SPACE TO RE-MARK. NC2164.2 +034900 HEAD-ROUTINE. NC2164.2 +035000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +035100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +035200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2164.2 +035300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2164.2 +035400 COLUMN-NAMES-ROUTINE. NC2164.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +035800 END-ROUTINE. NC2164.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2164.2 +036000 END-RTN-EXIT. NC2164.2 +036100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +036200 END-ROUTINE-1. NC2164.2 +036300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2164.2 +036400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2164.2 +036500 ADD PASS-COUNTER TO ERROR-HOLD. NC2164.2 +036600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2164.2 +036700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2164.2 +036800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2164.2 +036900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2164.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2164.2 +037100 END-ROUTINE-12. NC2164.2 +037200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2164.2 +037300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2164.2 +037400 MOVE "NO " TO ERROR-TOTAL NC2164.2 +037500 ELSE NC2164.2 +037600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2164.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2164.2 +037800 PERFORM WRITE-LINE. NC2164.2 +037900 END-ROUTINE-13. NC2164.2 +038000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2164.2 +038100 MOVE "NO " TO ERROR-TOTAL ELSE NC2164.2 +038200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2164.2 +038300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2164.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +038500 IF INSPECT-COUNTER EQUAL TO ZERO NC2164.2 +038600 MOVE "NO " TO ERROR-TOTAL NC2164.2 +038700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2164.2 +038800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2164.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +039000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2164.2 +039100 WRITE-LINE. NC2164.2 +039200 ADD 1 TO RECORD-COUNT. NC2164.2 +039300 IF RECORD-COUNT GREATER 50 NC2164.2 +039400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2164.2 +039500 MOVE SPACE TO DUMMY-RECORD NC2164.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2164.2 +039700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2164.2 +039800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2164.2 +039900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2164.2 +040000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2164.2 +040100 MOVE ZERO TO RECORD-COUNT. NC2164.2 +040200 PERFORM WRT-LN. NC2164.2 +040300 WRT-LN. NC2164.2 +040400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2164.2 +040500 MOVE SPACE TO DUMMY-RECORD. NC2164.2 +040600 BLANK-LINE-PRINT. NC2164.2 +040700 PERFORM WRT-LN. NC2164.2 +040800 FAIL-ROUTINE. NC2164.2 +040900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2164.2 +041000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2164.2 +041100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2164.2 +041200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2164.2 +041300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +041400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2164.2 +041500 GO TO FAIL-ROUTINE-EX. NC2164.2 +041600 FAIL-ROUTINE-WRITE. NC2164.2 +041700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2164.2 +041800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2164.2 +041900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2164.2 +042000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2164.2 +042100 FAIL-ROUTINE-EX. EXIT. NC2164.2 +042200 BAIL-OUT. NC2164.2 +042300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2164.2 +042400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2164.2 +042500 BAIL-OUT-WRITE. NC2164.2 +042600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2164.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2164.2 +042800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2164.2 +042900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2164.2 +043000 BAIL-OUT-EX. EXIT. NC2164.2 +043100 CCVS1-EXIT. NC2164.2 +043200 EXIT. NC2164.2 +043300 SECT-NC216A-001 SECTION. NC2164.2 +043400* NC2164.2 +043500 INS-INIT-F1-1. NC2164.2 +043600 MOVE "INS-TEST-F1-1" TO PAR-NAME. NC2164.2 +043700 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +043800 MOVE "TALLY FOR CHARACTERS" TO FEATURE. NC2164.2 +043900 MOVE NC2164.2 +044000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +044100- "IDS CAN NOT BE ALL BAD." NC2164.2 +044200 TO WC-XN-83. NC2164.2 +044300 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +044400 INS-TEST-F1-1. NC2164.2 +044500 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS. NC2164.2 +044600 IF WRK-DU-999-1 EQUAL TO 83 NC2164.2 +044700 PERFORM PASS NC2164.2 +044800 GO TO INS-WRITE-F1-1. NC2164.2 +044900 GO TO INS-FAIL-F1-1. NC2164.2 +045000 INS-DELETE-F1-1. NC2164.2 +045100 PERFORM DE-LETE. NC2164.2 +045200 GO TO INS-WRITE-F1-1. NC2164.2 +045300 INS-FAIL-F1-1. NC2164.2 +045400 PERFORM FAIL. NC2164.2 +045500 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +045600 MOVE 83 TO CORRECT-N. NC2164.2 +045700 INS-WRITE-F1-1. NC2164.2 +045800 PERFORM PRINT-DETAIL. NC2164.2 +045900* NC2164.2 +046000 INS-INIT-F1-2. NC2164.2 +046100 MOVE "INS-TEST-F1-2" TO PAR-NAME. NC2164.2 +046200 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +046300 MOVE "TALLY ALL LITERAL" TO FEATURE. NC2164.2 +046400 MOVE NC2164.2 +046500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +046600- "IDS CAN NOT BE ALL BAD." NC2164.2 +046700 TO WC-XN-83. NC2164.2 +046800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +046900 INS-TEST-F1-2. NC2164.2 +047000 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL "A". NC2164.2 +047100 IF WRK-DU-999-1 EQUAL TO 8 NC2164.2 +047200 PERFORM PASS NC2164.2 +047300 GO TO INS-WRITE-F1-2. NC2164.2 +047400 GO TO INS-FAIL-F1-2. NC2164.2 +047500 INS-DELETE-F1-2. NC2164.2 +047600 PERFORM DE-LETE. NC2164.2 +047700 GO TO INS-WRITE-F1-2. NC2164.2 +047800 INS-FAIL-F1-2. NC2164.2 +047900 PERFORM FAIL. NC2164.2 +048000 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +048100 MOVE 8 TO CORRECT-N. NC2164.2 +048200 INS-WRITE-F1-2. NC2164.2 +048300 PERFORM PRINT-DETAIL. NC2164.2 +048400* NC2164.2 +048500 INS-INIT-F1-3. NC2164.2 +048600 MOVE "INS-TEST-F1-3" TO PAR-NAME. NC2164.2 +048700 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +048800 MOVE "TALLY FOR ALL SPACES" TO FEATURE. NC2164.2 +048900 MOVE NC2164.2 +049000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +049100- "IDS CAN NOT BE ALL BAD." NC2164.2 +049200 TO WC-XN-83. NC2164.2 +049300 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +049400 INS-TEST-F1-3. NC2164.2 +049500 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL SPACES. NC2164.2 +049600 IF WRK-DU-999-1 EQUAL TO 17 NC2164.2 +049700 PERFORM PASS NC2164.2 +049800 GO TO INS-WRITE-F1-3. NC2164.2 +049900 GO TO INS-FAIL-F1-3. NC2164.2 +050000 INS-DELETE-F1-3. NC2164.2 +050100 PERFORM DE-LETE. NC2164.2 +050200 GO TO INS-WRITE-F1-3. NC2164.2 +050300 INS-FAIL-F1-3. NC2164.2 +050400 PERFORM FAIL. NC2164.2 +050500 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +050600 MOVE 17 TO CORRECT-N. NC2164.2 +050700 INS-WRITE-F1-3. NC2164.2 +050800 PERFORM PRINT-DETAIL. NC2164.2 +050900* NC2164.2 +051000 INS-INIT-F1-4. NC2164.2 +051100 MOVE "INS-TEST-F1-4" TO PAR-NAME. NC2164.2 +051200 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +051300 MOVE "TALLY LEADING LIT" TO FEATURE. NC2164.2 +051400 MOVE NC2164.2 +051500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +051600- "IDS CAN NOT BE ALL BAD." NC2164.2 +051700 TO WC-XN-83. NC2164.2 +051800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +051900 INS-TEST-F1-4. NC2164.2 +052000 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR LEADING "AH". NC2164.2 +052100 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +052200 PERFORM PASS NC2164.2 +052300 GO TO INS-WRITE-F1-4. NC2164.2 +052400 GO TO INS-FAIL-F1-4. NC2164.2 +052500 INS-DELETE-F1-4. NC2164.2 +052600 PERFORM DE-LETE. NC2164.2 +052700 GO TO INS-WRITE-F1-4. NC2164.2 +052800 INS-FAIL-F1-4. NC2164.2 +052900 PERFORM FAIL. NC2164.2 +053000 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +053100 MOVE 1 TO CORRECT-N. NC2164.2 +053200 INS-WRITE-F1-4. NC2164.2 +053300 PERFORM PRINT-DETAIL. NC2164.2 +053400* NC2164.2 +053500 INS-INIT-F1-5. NC2164.2 +053600 MOVE "INS-TEST-F1-5" TO PAR-NAME. NC2164.2 +053700 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +053800 MOVE "FOR CHARS AFTER LIT" TO FEATURE. NC2164.2 +053900 MOVE NC2164.2 +054000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +054100- "IDS CAN NOT BE ALL BAD." NC2164.2 +054200 TO WC-XN-83. NC2164.2 +054300 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +054400 INS-TEST-F1-5. NC2164.2 +054500 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +054600 AFTER " W". NC2164.2 +054700 IF WRK-DU-999-1 EQUAL TO 68 NC2164.2 +054800 PERFORM PASS NC2164.2 +054900 GO TO INS-WRITE-F1-5. NC2164.2 +055000 GO TO INS-FAIL-F1-5. NC2164.2 +055100 INS-DELETE-F1-5. NC2164.2 +055200 PERFORM DE-LETE. NC2164.2 +055300 GO TO INS-WRITE-F1-5. NC2164.2 +055400 INS-FAIL-F1-5. NC2164.2 +055500 PERFORM FAIL. NC2164.2 +055600 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +055700 MOVE 68 TO CORRECT-N. NC2164.2 +055800 INS-WRITE-F1-5. NC2164.2 +055900 PERFORM PRINT-DETAIL. NC2164.2 +056000* NC2164.2 +056100 INS-INIT-F1-6. NC2164.2 +056200 MOVE "INS-TEST-F1-6" TO PAR-NAME. NC2164.2 +056300 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +056400 MOVE "ALL BEFORE INITIAL" TO FEATURE. NC2164.2 +056500 MOVE NC2164.2 +056600 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +056700- "IDS CAN NOT BE ALL BAD." NC2164.2 +056800 TO WC-XN-83. NC2164.2 +056900 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +057000 INS-TEST-F1-6. NC2164.2 +057100 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL " " NC2164.2 +057200 BEFORE INITIAL "W.C.". NC2164.2 +057300 IF WRK-DU-999-1 EQUAL TO 4 NC2164.2 +057400 PERFORM PASS NC2164.2 +057500 GO TO INS-WRITE-F1-6. NC2164.2 +057600 GO TO INS-FAIL-F1-6. NC2164.2 +057700 INS-DELETE-F1-6. NC2164.2 +057800 PERFORM DE-LETE. NC2164.2 +057900 GO TO INS-WRITE-F1-6. NC2164.2 +058000 INS-FAIL-F1-6. NC2164.2 +058100 PERFORM FAIL. NC2164.2 +058200 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +058300 MOVE 4 TO CORRECT-N. NC2164.2 +058400 INS-WRITE-F1-6. NC2164.2 +058500 PERFORM PRINT-DETAIL. NC2164.2 +058600* NC2164.2 +058700 INS-INIT-F1-7. NC2164.2 +058800 MOVE "INS-TEST-F1-7" TO PAR-NAME. NC2164.2 +058900 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +059000 MOVE "LEAD LIT INITIAL FIG" TO FEATURE. NC2164.2 +059100 MOVE NC2164.2 +059200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +059300- "IDS CAN NOT BE ALL BAD." NC2164.2 +059400 TO WC-XN-83. NC2164.2 +059500 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +059600 INS-TEST-F1-7. NC2164.2 +059700 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR LEADING "Y" NC2164.2 +059800 AFTER INITIAL SPACES. NC2164.2 +059900 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +060000 PERFORM PASS NC2164.2 +060100 GO TO INS-WRITE-F1-7. NC2164.2 +060200 GO TO INS-FAIL-F1-7. NC2164.2 +060300 INS-DELETE-F1-7. NC2164.2 +060400 PERFORM DE-LETE. NC2164.2 +060500 GO TO INS-WRITE-F1-7. NC2164.2 +060600 INS-FAIL-F1-7. NC2164.2 +060700 PERFORM FAIL. NC2164.2 +060800 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +060900 MOVE 1 TO CORRECT-N. NC2164.2 +061000 INS-WRITE-F1-7. NC2164.2 +061100 PERFORM PRINT-DETAIL. NC2164.2 +061200* NC2164.2 +061300 INS-INIT-F2-8. NC2164.2 +061400 MOVE "INS-TEST-F2-8" TO PAR-NAME. NC2164.2 +061500 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +061600 MOVE "REP CHARS BY SPACES" TO FEATURE. NC2164.2 +061700 MOVE NC2164.2 +061800 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +061900- "IDS CAN NOT BE ALL BAD." NC2164.2 +062000 TO WC-XN-83. NC2164.2 +062100 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +062200 MOVE NC2164.2 +062300 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +062400- "IDS CAN NOT BE ALL BAD." NC2164.2 +062500 TO ANS-XN-83-5. NC2164.2 +062600 INS-TEST-F2-8. NC2164.2 +062700 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY SPACES. NC2164.2 +062800 IF WRK-XN-83-1 EQUAL TO SPACES NC2164.2 +062900 PERFORM PASS NC2164.2 +063000 GO TO INS-WRITE-F2-8. NC2164.2 +063100 GO TO INS-FAIL-F2-8. NC2164.2 +063200 INS-DELETE-F2-8. NC2164.2 +063300 PERFORM DE-LETE. NC2164.2 +063400 GO TO INS-WRITE-F2-8. NC2164.2 +063500 INS-FAIL-F2-8. NC2164.2 +063600 PERFORM FAIL. NC2164.2 +063700 MOVE "83 SPACES" TO RE-MARK. NC2164.2 +063800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83. NC2164.2 +063900 MOVE SPACES TO WS-RIGHT-1-83. NC2164.2 +064000 PERFORM FAIL. NC2164.2 +064100 MOVE WRK-XN-83-1 TO WS-WRONG-1-83. NC2164.2 +064200 MOVE ANS-XN-83-5 TO WS-RIGHT-1-83. NC2164.2 +064300 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2164.2 +064400 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2164.2 +064500 PERFORM PRINT-DETAIL. NC2164.2 +064600 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2164.2 +064700 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2164.2 +064800 PERFORM PRINT-DETAIL. NC2164.2 +064900 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2164.2 +065000 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2164.2 +065100 PERFORM PRINT-DETAIL. NC2164.2 +065200 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +065300 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +065400 PERFORM PRINT-DETAIL. NC2164.2 +065500 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +065600 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +065700 INS-WRITE-F2-8. NC2164.2 +065800 PERFORM PRINT-DETAIL. NC2164.2 +065900* NC2164.2 +066000 INS-INIT-F2-9. NC2164.2 +066100 MOVE "INS-TEST-F2-9" TO PAR-NAME. NC2164.2 +066200 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +066300 MOVE "CHARS BEFORE INITIAL" TO FEATURE. NC2164.2 +066400 MOVE NC2164.2 +066500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +066600- "IDS CAN NOT BE ALL BAD." NC2164.2 +066700 TO WC-XN-83. NC2164.2 +066800 MOVE NC2164.2 +066900 "OH YES AH YES W.C. FROTOES HERE, ANYONE WHO HATES DOGS AND KNC2164.2 +067000- "IDS CAN NOT BE ALL BAD." NC2164.2 +067100 TO ANS-XN-83-9. NC2164.2 +067200 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +067300 MOVE 1 TO REC-CT. NC2164.2 +067400 INS-TEST-F2-9. NC2164.2 +067500 INSPECT WRK-XN-83-1 NC2164.2 +067600 REPLACING LEADING "AH" BY "OH" BEFORE INITIAL " AH YES" NC2164.2 +067700 FIRST "I" BY "O" AFTER INITIAL "." NC2164.2 +067800 ALL ". " BY ", " AFTER INITIAL "HE". NC2164.2 +067900 MOVE WRK-XN-83-1 TO WRK-XN-83-2. NC2164.2 +068000 INSPECT WRK-XN-83-1 NC2164.2 +068100 REPLACING ALL "OT" BY "IT" BEFORE "HE" NC2164.2 +068200 LEADING ", " BY ". " AFTER "RE" NC2164.2 +068300 FIRST "KIDS CAN NOT BE" BY KIDS-CAN-NOT-BE NC2164.2 +068400 ALL BLANK-PERIOD BY " ." AFTER "BAD". NC2164.2 +068500 GO TO INS-TEST-F2-9-1. NC2164.2 +068600 INS-DELETE-F2-9. NC2164.2 +068700 PERFORM DE-LETE. NC2164.2 +068800 PERFORM PRINT-DETAIL. NC2164.2 +068900 GO TO INS-TEST-F2-10. NC2164.2 +069000* NC2164.2 +069100 INS-TEST-F2-9-1. NC2164.2 +069200 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC2164.2 +069300 PERFORM PASS NC2164.2 +069400 GO TO INS-WRITE-F2-9-1 NC2164.2 +069500 ELSE NC2164.2 +069600 GO TO INS-FAIL-F2-9-1. NC2164.2 +069700 INS-DELETE-F2-9-1. NC2164.2 +069800 PERFORM DE-LETE. NC2164.2 +069900 GO TO INS-WRITE-F2-9-1. NC2164.2 +070000 INS-FAIL-F2-9-1. NC2164.2 +070100 PERFORM FAIL NC2164.2 +070200 MOVE WRK-XN-83-1 TO COMPUTED-A NC2164.2 +070300 MOVE ANS-XN-83-1 TO CORRECT-A. NC2164.2 +070400 INS-WRITE-F2-9-1. NC2164.2 +070500 PERFORM PRINT-DETAIL. NC2164.2 +070600* NC2164.2 +070700 INS-TEST-F2-9-2. NC2164.2 +070800 ADD 1 TO REC-CT. NC2164.2 +070900 IF WRK-XN-83-2 EQUAL TO ANS-XN-83-9 NC2164.2 +071000 PERFORM PASS NC2164.2 +071100 GO TO INS-WRITE-F2-9-2 NC2164.2 +071200 ELSE NC2164.2 +071300 GO TO INS-FAIL-F2-9-2. NC2164.2 +071400 INS-FAIL-F2-9-2. NC2164.2 +071500 PERFORM FAIL NC2164.2 +071600 MOVE WRK-XN-83-2 TO WS-WRONG-1-83 NC2164.2 +071700 MOVE ANS-XN-83-9 TO WS-RIGHT-1-83 NC2164.2 +071800 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +071900 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +072000 PERFORM PRINT-DETAIL NC2164.2 +072100 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +072200 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +072300 PERFORM PRINT-DETAIL NC2164.2 +072400 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +072500 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +072600 PERFORM PRINT-DETAIL NC2164.2 +072700 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +072800 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +072900 PERFORM PRINT-DETAIL NC2164.2 +073000 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +073100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +073200 INS-WRITE-F2-9-2. NC2164.2 +073300 PERFORM PRINT-DETAIL. NC2164.2 +073400* NC2164.2 +073500 INS-INIT-F2-10. NC2164.2 +073600 MOVE "INS-TEST-F2-10" TO PAR-NAME. NC2164.2 +073700 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +073800 MOVE "LEAD AFTER INIT ID" TO FEATURE. NC2164.2 +073900 MOVE ZERO TO REC-CT. NC2164.2 +074000 MOVE NC2164.2 +074100 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +074200- "IDS CAN NOT BE ALL BAD." NC2164.2 +074300 TO WC-XN-83. NC2164.2 +074400 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +074500 INS-TEST-F2-10. NC2164.2 +074600 INSPECT WRK-XN-83-1 REPLACING LEADING SPACE-XN-1-1 NC2164.2 +074700 BY COMMA-XN-1-1 AFTER INITIAL YES-XN-3. NC2164.2 +074800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-2 NC2164.2 +074900 PERFORM PASS NC2164.2 +075000 GO TO INS-WRITE-F2-10. NC2164.2 +075100 GO TO INS-FAIL-F2-10. NC2164.2 +075200 INS-DELETE-F2-10. NC2164.2 +075300 PERFORM DE-LETE. NC2164.2 +075400 GO TO INS-WRITE-F2-10. NC2164.2 +075500 INS-FAIL-F2-10. NC2164.2 +075600 PERFORM FAIL. NC2164.2 +075700 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +075800 MOVE ANS-XN-83-2 TO WS-RIGHT-1-83 NC2164.2 +075900 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +076000 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +076100 PERFORM PRINT-DETAIL NC2164.2 +076200 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +076300 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +076400 PERFORM PRINT-DETAIL NC2164.2 +076500 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +076600 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +076700 PERFORM PRINT-DETAIL NC2164.2 +076800 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +076900 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +077000 PERFORM PRINT-DETAIL NC2164.2 +077100 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +077200 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +077300 INS-WRITE-F2-10. NC2164.2 +077400 PERFORM PRINT-DETAIL. NC2164.2 +077500* NC2164.2 +077600 INS-INIT-F2-11. NC2164.2 +077700 MOVE "INS-TEST-F2-11" TO PAR-NAME. NC2164.2 +077800 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +077900 MOVE "FIRST BY ID BEFORE" TO FEATURE. NC2164.2 +078000 MOVE NC2164.2 +078100 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +078200- "IDS CAN NOT BE ALL BAD." NC2164.2 +078300 TO WC-XN-83. NC2164.2 +078400 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +078500 MOVE "O" TO O-XN-1-1. NC2164.2 +078600 INS-TEST-F2-11. NC2164.2 +078700 INSPECT WRK-XN-83-1 REPLACING FIRST "A" BY O-XN-1-1 NC2164.2 +078800 BEFORE INITIAL "H YES". NC2164.2 +078900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC2164.2 +079000 PERFORM PASS NC2164.2 +079100 GO TO INS-WRITE-F2-11. NC2164.2 +079200 GO TO INS-FAIL-F2-11. NC2164.2 +079300 INS-DELETE-F2-11. NC2164.2 +079400 PERFORM DE-LETE. NC2164.2 +079500 GO TO INS-WRITE-F2-11. NC2164.2 +079600 INS-FAIL-F2-11. NC2164.2 +079700 PERFORM FAIL. NC2164.2 +079800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +079900 MOVE ANS-XN-83-1 TO WS-RIGHT-1-83 NC2164.2 +080000 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +080100 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +080200 PERFORM PRINT-DETAIL NC2164.2 +080300 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +080400 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +080500 PERFORM PRINT-DETAIL NC2164.2 +080600 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +080700 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +080800 PERFORM PRINT-DETAIL NC2164.2 +080900 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +081000 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +081100 PERFORM PRINT-DETAIL NC2164.2 +081200 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +081300 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +081400 INS-WRITE-F2-11. NC2164.2 +081500 PERFORM PRINT-DETAIL. NC2164.2 +081600* NC2164.2 +081700 INS-INIT-F2-12. NC2164.2 +081800 MOVE "INS-TEST-F2-12" TO PAR-NAME. NC2164.2 +081900 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +082000 MOVE "ALL ID BY LIT AFTER" TO FEATURE. NC2164.2 +082100 MOVE NC2164.2 +082200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +082300- "IDS CAN NOT BE ALL BAD." NC2164.2 +082400 TO WC-XN-83. NC2164.2 +082500 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +082600 INS-TEST-F2-12. NC2164.2 +082700 INSPECT WRK-XN-83-1 REPLACING ALL SPACE-XN-1-1 BY "-" NC2164.2 +082800 AFTER ALL-XN-3. NC2164.2 +082900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-3 NC2164.2 +083000 PERFORM PASS NC2164.2 +083100 GO TO INS-WRITE-F2-12. NC2164.2 +083200 GO TO INS-FAIL-F2-12. NC2164.2 +083300 INS-DELETE-F2-12. NC2164.2 +083400 PERFORM DE-LETE. NC2164.2 +083500 GO TO INS-WRITE-F2-12. NC2164.2 +083600 INS-FAIL-F2-12. NC2164.2 +083700 PERFORM FAIL. NC2164.2 +083800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +083900 MOVE ANS-XN-83-3 TO WS-RIGHT-1-83 NC2164.2 +084000 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +084100 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +084200 PERFORM PRINT-DETAIL NC2164.2 +084300 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +084400 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +084500 PERFORM PRINT-DETAIL NC2164.2 +084600 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +084700 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +084800 PERFORM PRINT-DETAIL NC2164.2 +084900 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +085000 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +085100 PERFORM PRINT-DETAIL NC2164.2 +085200 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +085300 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +085400 INS-WRITE-F2-12. NC2164.2 +085500 PERFORM PRINT-DETAIL. NC2164.2 +085600* NC2164.2 +085700 INS-INIT-F3-13. NC2164.2 +085800 MOVE "INS-TEST-F3-13" TO PAR-NAME. NC2164.2 +085900 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +086000 MOVE "TALLY-REPLACE CHARS" TO FEATURE. NC2164.2 +086100 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +086200 MOVE NC2164.2 +086300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +086400- "IDS CAN NOT BE ALL BAD." NC2164.2 +086500 TO WC-XN-83. NC2164.2 +086600 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +086700 MOVE 1 TO REC-CT. NC2164.2 +086800 INS-TEST-F3-13-0. NC2164.2 +086900 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +087000 REPLACING CHARACTERS BY SPACES. NC2164.2 +087100 GO TO INS-TEST-F3-13-1. NC2164.2 +087200 INS-DELETE-F3-13. NC2164.2 +087300 PERFORM DE-LETE. NC2164.2 +087400 PERFORM PRINT-DETAIL. NC2164.2 +087500 GO TO INS-INIT-F3-14. NC2164.2 +087600* NC2164.2 +087700 INS-TEST-F3-13-1. NC2164.2 +087800 IF WRK-DU-999-1 EQUAL TO 83 NC2164.2 +087900 PERFORM PASS NC2164.2 +088000 GO TO INS-WRITE-F3-13-1 NC2164.2 +088100 ELSE NC2164.2 +088200 GO TO INS-FAIL-F3-13-1. NC2164.2 +088300 INS-DELETE-F3-13-1. NC2164.2 +088400 PERFORM DE-LETE. NC2164.2 +088500 GO TO INS-WRITE-F3-13-1. NC2164.2 +088600 INS-FAIL-F3-13-1. NC2164.2 +088700 PERFORM FAIL NC2164.2 +088800 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +088900 MOVE 83 TO CORRECT-N. NC2164.2 +089000 INS-WRITE-F3-13-1. NC2164.2 +089100 PERFORM PRINT-DETAIL. NC2164.2 +089200* NC2164.2 +089300 TEST-13-2. NC2164.2 +089400 ADD 1 TO REC-CT. NC2164.2 +089500 IF WRK-XN-83-1 EQUAL TO SPACES NC2164.2 +089600 PERFORM PASS NC2164.2 +089700 GO TO INS-WRITE-F3-13-2 NC2164.2 +089800 ELSE NC2164.2 +089900 GO TO INS-FAIL-F3-13-2. NC2164.2 +090000 INS-DELETE-F3-13-2. NC2164.2 +090100 PERFORM DE-LETE. NC2164.2 +090200 GO TO INS-WRITE-F3-13-2. NC2164.2 +090300 INS-FAIL-F3-13-2. NC2164.2 +090400 PERFORM FAIL NC2164.2 +090500 MOVE WRK-XN-83-1 TO COMPUTED-A NC2164.2 +090600 MOVE "83 SPACES" TO CORRECT-A. NC2164.2 +090700 INS-WRITE-F3-13-2. NC2164.2 +090800 PERFORM PRINT-DETAIL. NC2164.2 +090900* NC2164.2 +091000 INS-INIT-F3-14. NC2164.2 +091100 MOVE "INS-TEST-F3-14" TO PAR-NAME. NC2164.2 +091200 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +091300 MOVE "LIT BY BEFORE INIT" TO FEATURE. NC2164.2 +091400 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +091500 MOVE NC2164.2 +091600 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +091700- "IDS CAN NOT BE ALL BAD." NC2164.2 +091800 TO WC-XN-83. NC2164.2 +091900 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +092000 MOVE 1 TO REC-CT. NC2164.2 +092100 INS-TEST-F3-14-0. NC2164.2 +092200 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +092300 AFTER L-XN-1-1 REPLACING ALL "A" BY "E" BEFORE INITIAL NC2164.2 +092400 HSPACE-XN-2. NC2164.2 +092500 GO TO INS-TEST-F3-14-1. NC2164.2 +092600 INS-DELETE-F3-14. NC2164.2 +092700 PERFORM DE-LETE. NC2164.2 +092800 PERFORM PRINT-DETAIL. NC2164.2 +092900 GO TO INS-INIT-F3-15. NC2164.2 +093000* NC2164.2 +093100 INS-TEST-F3-14-1. NC2164.2 +093200 IF WRK-DU-999-1 EQUAL TO 6 NC2164.2 +093300 PERFORM PASS NC2164.2 +093400 GO TO INS-WRITE-F3-14-1 NC2164.2 +093500 ELSE NC2164.2 +093600 PERFORM FAIL NC2164.2 +093700 GO TO INS-FAIL-F3-14-1. NC2164.2 +093800 INS-DELETE-F3-14-1. NC2164.2 +093900 PERFORM DE-LETE. NC2164.2 +094000 GO TO INS-WRITE-F3-14-1. NC2164.2 +094100 INS-FAIL-F3-14-1. NC2164.2 +094200 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +094300 MOVE 6 TO CORRECT-N. NC2164.2 +094400 INS-WRITE-F3-14-1. NC2164.2 +094500 PERFORM PRINT-DETAIL. NC2164.2 +094600* NC2164.2 +094700 INS-TEST-F3-14-2. NC2164.2 +094800 ADD 1 TO REC-CT. NC2164.2 +094900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-4 NC2164.2 +095000 PERFORM PASS NC2164.2 +095100 GO TO INS-WRITE-F3-14-2 NC2164.2 +095200 ELSE NC2164.2 +095300 PERFORM FAIL NC2164.2 +095400 GO TO INS-FAIL-F3-14-2. NC2164.2 +095500 INS-DELETE-F3-14-2. NC2164.2 +095600 PERFORM DE-LETE. NC2164.2 +095700 GO TO INS-WRITE-F3-14-2. NC2164.2 +095800 INS-FAIL-F3-14-2. NC2164.2 +095900 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +096000 MOVE ANS-XN-83-4 TO WS-RIGHT-1-83 NC2164.2 +096100 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +096200 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +096300 PERFORM PRINT-DETAIL NC2164.2 +096400 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +096500 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +096600 PERFORM PRINT-DETAIL NC2164.2 +096700 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +096800 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +096900 PERFORM PRINT-DETAIL NC2164.2 +097000 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +097100 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +097200 PERFORM PRINT-DETAIL NC2164.2 +097300 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +097400 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +097500 INS-WRITE-F3-14-2. NC2164.2 +097600 PERFORM PRINT-DETAIL. NC2164.2 +097700* NC2164.2 +097800 INS-INIT-F3-15. NC2164.2 +097900 MOVE "INS-TEST-F3-15" TO PAR-NAME. NC2164.2 +098000 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +098100 MOVE "REPL FIRST AFTER" TO FEATURE. NC2164.2 +098200 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +098300 MOVE NC2164.2 +098400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +098500- "IDS CAN NOT BE ALL BAD." NC2164.2 +098600 TO WC-XN-83. NC2164.2 +098700 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +098800 MOVE NC2164.2 +098900 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +099000- "IDS CAN NOT BE ALL BAD." NC2164.2 +099100 TO ANS-XN-83-5. NC2164.2 +099200 MOVE 1 TO REC-CT. NC2164.2 +099300 INS-TEST-F3-15-0. NC2164.2 +099400 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" BEFORE NC2164.2 +099500 L-XN-1-1 REPLACING FIRST AH-XN-2 BY "OH" AFTER NC2164.2 +099600 INITIAL HSPACE-XN-2. NC2164.2 +099700 GO TO INS-TEST-F3-15-1. NC2164.2 +099800 INS-DELETE-F3-15. NC2164.2 +099900 PERFORM DE-LETE. NC2164.2 +100000 PERFORM PRINT-DETAIL. NC2164.2 +100100 GO TO INS-INIT-F3-16. NC2164.2 +100200* NC2164.2 +100300 INS-TEST-F3-15-1. NC2164.2 +100400 IF WRK-DU-999-1 EQUAL TO 7 NC2164.2 +100500 PERFORM PASS NC2164.2 +100600 GO TO INS-WRITE-F3-15-1 NC2164.2 +100700 ELSE NC2164.2 +100800 PERFORM FAIL NC2164.2 +100900 GO TO INS-FAIL-F3-15-1. NC2164.2 +101000 INS-DELETE-F3-15-1. NC2164.2 +101100 PERFORM DE-LETE. NC2164.2 +101200 GO TO INS-WRITE-F3-15-1. NC2164.2 +101300 INS-FAIL-F3-15-1. NC2164.2 +101400 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +101500 MOVE 7 TO CORRECT-N. NC2164.2 +101600 INS-WRITE-F3-15-1. NC2164.2 +101700 PERFORM PRINT-DETAIL. NC2164.2 +101800* NC2164.2 +101900 INS-TEST-F3-15-2. NC2164.2 +102000 ADD 1 TO REC-CT. NC2164.2 +102100 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC2164.2 +102200 PERFORM PASS NC2164.2 +102300 GO TO INS-WRITE-F3-15-2 NC2164.2 +102400 ELSE NC2164.2 +102500 PERFORM FAIL NC2164.2 +102600 GO TO INS-FAIL-F3-15-2. NC2164.2 +102700 INS-DELETE-F3-15-2. NC2164.2 +102800 PERFORM DE-LETE. NC2164.2 +102900 GO TO INS-WRITE-F3-15-2. NC2164.2 +103000 INS-FAIL-F3-15-2. NC2164.2 +103100 MOVE WRK-XN-83-1 TO COMPUTED-A NC2164.2 +103200 MOVE ANS-XN-83-5 TO CORRECT-A. NC2164.2 +103300 INS-WRITE-F3-15-2. NC2164.2 +103400 PERFORM PRINT-DETAIL. NC2164.2 +103500* NC2164.2 +103600 INS-INIT-F3-16. NC2164.2 +103700 MOVE "INS-TEST-F3-16" TO PAR-NAME. NC2164.2 +103800 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +103900 MOVE "FOR LEADING" TO FEATURE. NC2164.2 +104000 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +104100 MOVE NC2164.2 +104200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +104300- "IDS CAN NOT BE ALL BAD." NC2164.2 +104400 TO WC-XN-83. NC2164.2 +104500 MOVE NC2164.2 +104600 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +104700- "IDS CAN NOT BE ALL BAD." NC2164.2 +104800 TO ANS-XN-83-5. NC2164.2 +104900 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +105000 MOVE 1 TO REC-CT. NC2164.2 +105100 INS-TEST-F3-16-0. NC2164.2 +105200 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR LEADING NC2164.2 +105300 AH-XN-2 REPLACING LEADING AH-XN-2 BY "OH". NC2164.2 +105400 GO TO INS-TEST-F3-16-1. NC2164.2 +105500 INS-DELETE-F3-16. NC2164.2 +105600 PERFORM DE-LETE. NC2164.2 +105700 PERFORM PRINT-DETAIL. NC2164.2 +105800 GO TO INS-INIT-F3-17. NC2164.2 +105900* NC2164.2 +106000 INS-TEST-F3-16-1. NC2164.2 +106100 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +106200 PERFORM PASS NC2164.2 +106300 GO TO INS-WRITE-F3-16-1 NC2164.2 +106400 ELSE NC2164.2 +106500 PERFORM FAIL NC2164.2 +106600 GO TO INS-FAIL-F3-16-1. NC2164.2 +106700 INS-DELETE-F3-16-1. NC2164.2 +106800 PERFORM DE-LETE. NC2164.2 +106900 GO TO INS-WRITE-F3-16-1. NC2164.2 +107000 INS-FAIL-F3-16-1. NC2164.2 +107100 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +107200 MOVE 1 TO CORRECT-N. NC2164.2 +107300 INS-WRITE-F3-16-1. NC2164.2 +107400 PERFORM PRINT-DETAIL. NC2164.2 +107500* NC2164.2 +107600 INS-TEST-F3-16-2. NC2164.2 +107700 ADD 1 TO REC-CT. NC2164.2 +107800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC2164.2 +107900 PERFORM PASS NC2164.2 +108000 GO TO INS-WRITE-F3-16-2 NC2164.2 +108100 ELSE NC2164.2 +108200 PERFORM FAIL NC2164.2 +108300 GO TO INS-FAIL-F3-16-2. NC2164.2 +108400 INS-DELETE-F3-16-2. NC2164.2 +108500 PERFORM DE-LETE. NC2164.2 +108600 GO TO INS-WRITE-F3-16-2. NC2164.2 +108700 INS-FAIL-F3-16-2. NC2164.2 +108800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +108900 MOVE ANS-XN-83-1 TO WS-RIGHT-1-83 NC2164.2 +109000 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +109100 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +109200 PERFORM PRINT-DETAIL NC2164.2 +109300 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +109400 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +109500 PERFORM PRINT-DETAIL NC2164.2 +109600 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +109700 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +109800 PERFORM PRINT-DETAIL NC2164.2 +109900 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +110000 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +110100 PERFORM PRINT-DETAIL NC2164.2 +110200 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +110300 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +110400 INS-WRITE-F3-16-2. NC2164.2 +110500 PERFORM PRINT-DETAIL. NC2164.2 +110600* NC2164.2 +110700 INS-INIT-F3-17. NC2164.2 +110800 MOVE "INS-TEST-F3-17" TO PAR-NAME. NC2164.2 +110900 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +111000 MOVE "LIT BY AFTER INIT" TO FEATURE. NC2164.2 +111100 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +111200 MOVE NC2164.2 +111300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +111400- "IDS CAN NOT BE ALL BAD." NC2164.2 +111500 TO WC-XN-83. NC2164.2 +111600 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +111700 MOVE NC2164.2 +111800 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +111900- "IDS CAN NOT BE ALL BAD." NC2164.2 +112000 TO ANS-XN-83-5. NC2164.2 +112100 MOVE 1 TO REC-CT. NC2164.2 +112200 INS-TEST-F3-17-0. NC2164.2 +112300 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" NC2164.2 +112400 REPLACING FIRST "AH" BY "OH" AFTER INITIAL "YES". NC2164.2 +112500 GO TO INS-TEST-F3-17-1. NC2164.2 +112600 INS-DELETE-F3-17. NC2164.2 +112700 PERFORM DE-LETE. NC2164.2 +112800 PERFORM PRINT-DETAIL. NC2164.2 +112900 GO TO INS-INIT-F3-18. NC2164.2 +113000* NC2164.2 +113100 INS-TEST-F3-17-1. NC2164.2 +113200 IF WRK-DU-999-1 EQUAL TO 8 NC2164.2 +113300 PERFORM PASS NC2164.2 +113400 GO TO INS-WRITE-F3-17-1 NC2164.2 +113500 ELSE NC2164.2 +113600 PERFORM FAIL NC2164.2 +113700 GO TO INS-FAIL-F3-17-1. NC2164.2 +113800 INS-DELETE-F3-17-1. NC2164.2 +113900 PERFORM DE-LETE. NC2164.2 +114000 GO TO INS-WRITE-F3-17-1. NC2164.2 +114100 INS-FAIL-F3-17-1. NC2164.2 +114200 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +114300 MOVE 8 TO CORRECT-N. NC2164.2 +114400 INS-WRITE-F3-17-1. NC2164.2 +114500 PERFORM PRINT-DETAIL. NC2164.2 +114600* NC2164.2 +114700 INS-TEST-F3-17-2. NC2164.2 +114800 ADD 1 TO REC-CT. NC2164.2 +114900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC2164.2 +115000 PERFORM PASS NC2164.2 +115100 GO TO INS-WRITE-F3-17-2 NC2164.2 +115200 ELSE NC2164.2 +115300 PERFORM FAIL NC2164.2 +115400 GO TO INS-FAIL-F3-17-2. NC2164.2 +115500 INS-DELETE-F3-17-2. NC2164.2 +115600 PERFORM DE-LETE. NC2164.2 +115700 GO TO INS-WRITE-F3-17-2. NC2164.2 +115800 INS-FAIL-F3-17-2. NC2164.2 +115900 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +116000 MOVE ANS-XN-83-5 TO WS-RIGHT-1-83 NC2164.2 +116100 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +116200 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +116300 PERFORM PRINT-DETAIL NC2164.2 +116400 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +116500 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +116600 PERFORM PRINT-DETAIL NC2164.2 +116700 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +116800 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +116900 PERFORM PRINT-DETAIL NC2164.2 +117000 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +117100 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +117200 PERFORM PRINT-DETAIL NC2164.2 +117300 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +117400 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +117500 INS-WRITE-F3-17-2. NC2164.2 +117600 PERFORM PRINT-DETAIL. NC2164.2 +117700* NC2164.2 +117800 INS-INIT-F3-18. NC2164.2 +117900 MOVE "INS-TEST-F3-18" TO PAR-NAME. NC2164.2 +118000 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +118100 MOVE "CHAR AFTER ALL BEF" TO FEATURE. NC2164.2 +118200 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +118300 MOVE NC2164.2 +118400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +118500- "IDS CAN NOT BE ALL BAD." NC2164.2 +118600 TO WC-XN-83. NC2164.2 +118700 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +118800 MOVE 1 TO REC-CT. NC2164.2 +118900 INS-TEST-F3-18-0. NC2164.2 +119000 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +119100 AFTER AH-XN-2 REPLACING ALL "AH" BY "OH" BEFORE YES-XN-3.NC2164.2 +119200 GO TO INS-TEST-F3-18-1. NC2164.2 +119300 INS-DELETE-F3-18. NC2164.2 +119400 PERFORM DE-LETE. NC2164.2 +119500 PERFORM PRINT-DETAIL. NC2164.2 +119600 GO TO INS-INIT-F3-19. NC2164.2 +119700* NC2164.2 +119800 INS-TEST-F3-18-1. NC2164.2 +119900 IF WRK-DU-999-1 EQUAL TO 81 NC2164.2 +120000 PERFORM PASS NC2164.2 +120100 GO TO INS-WRITE-F3-18-1 NC2164.2 +120200 ELSE NC2164.2 +120300 PERFORM FAIL NC2164.2 +120400 GO TO INS-FAIL-F3-18-1. NC2164.2 +120500 INS-DELETE-F3-18-1. NC2164.2 +120600 PERFORM DE-LETE. NC2164.2 +120700 GO TO INS-WRITE-F3-18-1. NC2164.2 +120800 INS-FAIL-F3-18-1. NC2164.2 +120900 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +121000 MOVE 81 TO CORRECT-N. NC2164.2 +121100 INS-WRITE-F3-18-1. NC2164.2 +121200 PERFORM PRINT-DETAIL. NC2164.2 +121300* NC2164.2 +121400 INS-TEST-F3-18-2. NC2164.2 +121500 ADD 1 TO REC-CT. NC2164.2 +121600 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-1 NC2164.2 +121700 PERFORM PASS NC2164.2 +121800 GO TO INS-WRITE-F3-18-2 NC2164.2 +121900 ELSE NC2164.2 +122000 PERFORM FAIL NC2164.2 +122100 GO TO INS-FAIL-F3-18-2. NC2164.2 +122200 INS-DELETE-F3-18-2. NC2164.2 +122300 PERFORM DE-LETE. NC2164.2 +122400 GO TO INS-WRITE-F3-18-2. NC2164.2 +122500 INS-FAIL-F3-18-2. NC2164.2 +122600 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +122700 MOVE ANS-XN-83-1 TO WS-RIGHT-1-83 NC2164.2 +122800 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +122900 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +123000 PERFORM PRINT-DETAIL NC2164.2 +123100 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +123200 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +123300 PERFORM PRINT-DETAIL NC2164.2 +123400 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +123500 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +123600 PERFORM PRINT-DETAIL NC2164.2 +123700 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +123800 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +123900 PERFORM PRINT-DETAIL NC2164.2 +124000 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +124100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +124200 INS-WRITE-F3-18-2. NC2164.2 +124300 PERFORM PRINT-DETAIL. NC2164.2 +124400* NC2164.2 +124500 INS-INIT-F3-19. NC2164.2 +124600 MOVE "INS-TEST-F3-19" TO PAR-NAME. NC2164.2 +124700 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +124800 MOVE "TALLY SERIES" TO FEATURE. NC2164.2 +124900 MOVE ZERO TO WRK-DU-999-1 WRK-DU-999-2 WRK-DU-999-3 NC2164.2 +125000 WRK-DU-999-4. NC2164.2 +125100 MOVE NC2164.2 +125200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +125300- "IDS CAN NOT BE ALL BAD." NC2164.2 +125400 TO WC-XN-83. NC2164.2 +125500 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +125600 MOVE 1 TO REC-CT. NC2164.2 +125700 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR ALL "A" NC2164.2 +125800 WRK-DU-999-2 FOR LEADING "AH" NC2164.2 +125900 WRK-DU-999-3 FOR CHARACTERS BEFORE "." NC2164.2 +126000 WRK-DU-999-4 FOR CHARACTERS AFTER "AL" NC2164.2 +126100 REPLACING NC2164.2 +126200 FIRST "L " BY "ZZ" AFTER INITIAL "AL" NC2164.2 +126300 FIRST "BAD" BY "ZZZ" AFTER "L " NC2164.2 +126400 LEADING "BAD" BY "ZZZ" BEFORE INITIAL "Q" NC2164.2 +126500 FIRST "BAD" BY "ZZZ" BEFORE INITIAL "Z" NC2164.2 +126600 FIRST "BAD" BY "ZZZ" AFTER "ALL " NC2164.2 +126700 ALL "." BY "Z" AFTER "AL". NC2164.2 +126800 GO TO INS-TEST-F3-19-1. NC2164.2 +126900 INS-DELETE-F3-19. NC2164.2 +127000 PERFORM DE-LETE. NC2164.2 +127100 PERFORM PRINT-DETAIL. NC2164.2 +127200 GO TO INS-INIT-F3-20. NC2164.2 +127300* NC2164.2 +127400 INS-TEST-F3-19-1. NC2164.2 +127500 IF WRK-DU-999-1 = 8 NC2164.2 +127600 PERFORM PASS NC2164.2 +127700 GO TO INS-WRITE-F3-19-1 NC2164.2 +127800 ELSE NC2164.2 +127900 GO TO INS-FAIL-F3-19-1. NC2164.2 +128000 INS-DELETE-F3-19-1. NC2164.2 +128100 PERFORM DE-LETE. NC2164.2 +128200 GO TO INS-WRITE-F3-19-1. NC2164.2 +128300 INS-FAIL-F3-19-1. NC2164.2 +128400 PERFORM FAIL NC2164.2 +128500 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +128600 MOVE 8 TO CORRECT-N. NC2164.2 +128700 INS-WRITE-F3-19-1. NC2164.2 +128800 PERFORM PRINT-DETAIL. NC2164.2 +128900* NC2164.2 +129000 INS-TEST-F3-19-2. NC2164.2 +129100 ADD 1 TO REC-CT. NC2164.2 +129200 IF WRK-DU-999-2 = 0 NC2164.2 +129300 PERFORM PASS NC2164.2 +129400 GO TO INS-WRITE-F3-19-2 NC2164.2 +129500 ELSE NC2164.2 +129600 GO TO INS-FAIL-F3-19-2. NC2164.2 +129700 INS-DELETE-F3-19-2. NC2164.2 +129800 PERFORM DE-LETE. NC2164.2 +129900 GO TO INS-WRITE-F3-19-2. NC2164.2 +130000 INS-FAIL-F3-19-2. NC2164.2 +130100 PERFORM FAIL NC2164.2 +130200 MOVE WRK-DU-999-2 TO COMPUTED-N NC2164.2 +130300 MOVE 0 TO CORRECT-N. NC2164.2 +130400 INS-WRITE-F3-19-2. NC2164.2 +130500 PERFORM PRINT-DETAIL. NC2164.2 +130600* NC2164.2 +130700 INS-TEST-F3-19-3. NC2164.2 +130800 ADD 1 TO REC-CT. NC2164.2 +130900 IF WRK-DU-999-3 = 13 NC2164.2 +131000 PERFORM PASS NC2164.2 +131100 GO TO INS-WRITE-F3-19-3 NC2164.2 +131200 ELSE NC2164.2 +131300 PERFORM FAIL NC2164.2 +131400 GO TO INS-FAIL-F3-19-3. NC2164.2 +131500 INS-DELETE-F3-19-3. NC2164.2 +131600 PERFORM DE-LETE. NC2164.2 +131700 GO TO INS-WRITE-F3-19-3. NC2164.2 +131800 INS-FAIL-F3-19-3. NC2164.2 +131900 MOVE WRK-DU-999-3 TO COMPUTED-N NC2164.2 +132000 MOVE 13 TO CORRECT-N. NC2164.2 +132100 INS-WRITE-F3-19-3. NC2164.2 +132200 PERFORM PRINT-DETAIL. NC2164.2 +132300* NC2164.2 +132400 INS-TEST-F3-19-4. NC2164.2 +132500 ADD 1 TO REC-CT. NC2164.2 +132600 IF WRK-DU-999-4 = 5 NC2164.2 +132700 PERFORM PASS NC2164.2 +132800 GO TO INS-WRITE-F3-19-4 NC2164.2 +132900 ELSE NC2164.2 +133000 GO TO INS-FAIL-F3-19-4. NC2164.2 +133100 INS-DELETE-F3-19-4. NC2164.2 +133200 PERFORM DE-LETE. NC2164.2 +133300 GO TO INS-WRITE-F3-19-4. NC2164.2 +133400 INS-FAIL-F3-19-4. NC2164.2 +133500 PERFORM FAIL NC2164.2 +133600 MOVE WRK-DU-999-4 TO COMPUTED-N NC2164.2 +133700 MOVE 5 TO CORRECT-N. NC2164.2 +133800 INS-WRITE-F3-19-4. NC2164.2 +133900 PERFORM PRINT-DETAIL. NC2164.2 +134000* NC2164.2 +134100 INS-TEST-F3-19-5. NC2164.2 +134200 ADD 1 TO REC-CT. NC2164.2 +134300 IF WRK-XN-83-1 = ANS-XN-83-6 NC2164.2 +134400 PERFORM PASS NC2164.2 +134500 GO TO INS-WRITE-F3-19-5 NC2164.2 +134600 ELSE NC2164.2 +134700 GO TO INS-FAIL-F3-19-5. NC2164.2 +134800 INS-DELETE-F3-19-5. NC2164.2 +134900 PERFORM DE-LETE. NC2164.2 +135000 GO TO INS-WRITE-F3-19-5. NC2164.2 +135100 INS-FAIL-F3-19-5. NC2164.2 +135200 PERFORM FAIL NC2164.2 +135300 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +135400 MOVE ANS-XN-83-6 TO WS-RIGHT-1-83 NC2164.2 +135500 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +135600 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +135700 PERFORM PRINT-DETAIL NC2164.2 +135800 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +135900 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +136000 PERFORM PRINT-DETAIL NC2164.2 +136100 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +136200 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +136300 PERFORM PRINT-DETAIL NC2164.2 +136400 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +136500 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +136600 PERFORM PRINT-DETAIL NC2164.2 +136700 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +136800 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +136900 INS-WRITE-F3-19-5. NC2164.2 +137000 PERFORM PRINT-DETAIL. NC2164.2 +137100* NC2164.2 +137200 INS-INIT-F3-20. NC2164.2 +137300 MOVE "INS-TEST-F3-20" TO PAR-NAME. NC2164.2 +137400 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +137500 MOVE "REPLACE SERIES" TO FEATURE. NC2164.2 +137600 MOVE ZERO TO REC-CT WRK-DU-999-1. NC2164.2 +137700 MOVE NC2164.2 +137800 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +137900- "IDS CAN NOT BE ALL BAD." NC2164.2 +138000 TO WC-XN-83. NC2164.2 +138100 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +138200 MOVE 1 TO REC-CT. NC2164.2 +138300 INS-TEST-F3-20-0. NC2164.2 +138400 INSPECT WRK-XN-83-1 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +138500 BEFORE "." NC2164.2 +138600 REPLACING NC2164.2 +138700 ALL "L BAD." BY "ZZZZZZ" AFTER L-XN-1-1 NC2164.2 +138800 ALL " " BY HYPEN-XN-1-1 NC2164.2 +138900 FIRST "C" BY P-XN-1-1 NC2164.2 +139000 LEADING AH-XN-2 BY OH-XN-2 NC2164.2 +139100 ALL "F" BY "Z" BEFORE G-XN-1-1. NC2164.2 +139200 GO TO INS-TEST-F3-20-1. NC2164.2 +139300 INS-DELETE-F3-20. NC2164.2 +139400 PERFORM DE-LETE. NC2164.2 +139500 PERFORM PRINT-DETAIL. NC2164.2 +139600 GO TO CCVS-999999. NC2164.2 +139700* NC2164.2 +139800 INS-TEST-F3-20-1. NC2164.2 +139900 IF WRK-DU-999-1 EQUAL TO 15 NC2164.2 +140000 PERFORM PASS NC2164.2 +140100 GO TO INS-WRITE-F3-20-1 NC2164.2 +140200 ELSE NC2164.2 +140300 GO TO INS-FAIL-F3-20-1. NC2164.2 +140400 INS-DELETE-F3-20-1. NC2164.2 +140500 PERFORM DE-LETE. NC2164.2 +140600 GO TO INS-WRITE-F3-20-1. NC2164.2 +140700 INS-FAIL-F3-20-1. NC2164.2 +140800 PERFORM FAIL NC2164.2 +140900 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +141000 MOVE 15 TO CORRECT-N. NC2164.2 +141100 INS-WRITE-F3-20-1. NC2164.2 +141200 PERFORM PRINT-DETAIL. NC2164.2 +141300* NC2164.2 +141400 INS-TEST-F3-20-2. NC2164.2 +141500 ADD 1 TO REC-CT. NC2164.2 +141600 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-7 NC2164.2 +141700 PERFORM PASS NC2164.2 +141800 GO TO INS-WRITE-F3-20-2 NC2164.2 +141900 ELSE NC2164.2 +142000 GO TO INS-FAIL-F3-20-2. NC2164.2 +142100 INS-DELETE-F3-20-2. NC2164.2 +142200 PERFORM DE-LETE. NC2164.2 +142300 GO TO INS-WRITE-F3-20-2. NC2164.2 +142400 INS-FAIL-F3-20-2. NC2164.2 +142500 PERFORM FAIL NC2164.2 +142600 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +142700 MOVE ANS-XN-83-7 TO WS-RIGHT-1-83 NC2164.2 +142800 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +142900 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +143000 PERFORM PRINT-DETAIL NC2164.2 +143100 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +143200 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +143300 PERFORM PRINT-DETAIL NC2164.2 +143400 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +143500 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +143600 PERFORM PRINT-DETAIL NC2164.2 +143700 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +143800 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +143900 PERFORM PRINT-DETAIL NC2164.2 +144000 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +144100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +144200 INS-WRITE-F3-20-2. NC2164.2 +144300 PERFORM PRINT-DETAIL. NC2164.2 +144400* NC2164.2 +144500 INS-INIT-F2-21. NC2164.2 +144600 MOVE ZERO TO REC-CT. NC2164.2 +144700 MOVE SPACES TO PAR-NAME. NC2164.2 +144800 MOVE "INS-TEST-F2-21" TO PAR-NAME. NC2164.2 +144900 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +145000 MOVE "REPLACE BEFORE" TO FEATURE. NC2164.2 +145100 MOVE NC2164.2 +145200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +145300- "IDS CAN NOT BE ALL BAD." NC2164.2 +145400 TO WC-XN-83. NC2164.2 +145500 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +145600 INS-TEST-F2-21. NC2164.2 +145700 INSPECT WRK-XN-83-1 NC2164.2 +145800 REPLACING ALL SPACE-XN-1-1 BY "-" BEFORE INITIAL "Z". NC2164.2 +145900 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-8 NC2164.2 +146000 PERFORM PASS NC2164.2 +146100 GO TO INS-WRITE-F2-21-1 NC2164.2 +146200 ELSE NC2164.2 +146300 GO TO INS-FAIL-F2-21-1. NC2164.2 +146400 INS-DELETE-F2-21-1. NC2164.2 +146500 PERFORM DE-LETE. NC2164.2 +146600 GO TO INS-WRITE-F2-21-1. NC2164.2 +146700 INS-FAIL-F2-21-1. NC2164.2 +146800 PERFORM FAIL NC2164.2 +146900 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +147000 MOVE ANS-XN-83-8 TO WS-RIGHT-1-83 NC2164.2 +147100 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +147200 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +147300 PERFORM PRINT-DETAIL NC2164.2 +147400 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +147500 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +147600 PERFORM PRINT-DETAIL NC2164.2 +147700 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +147800 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +147900 PERFORM PRINT-DETAIL NC2164.2 +148000 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +148100 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +148200 PERFORM PRINT-DETAIL NC2164.2 +148300 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +148400 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +148500 INS-WRITE-F2-21-1. NC2164.2 +148600 PERFORM PRINT-DETAIL. NC2164.2 +148700* NC2164.2 +148800 INS-INIT-F2-22. NC2164.2 +148900 MOVE "INS-TEST-F2-22" TO PAR-NAME. NC2164.2 +149000 MOVE "VI-94 6.17.3" TO ANSI-REFERENCE. NC2164.2 +149100 MOVE "REPLACE AFTER" TO FEATURE. NC2164.2 +149200 MOVE NC2164.2 +149300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +149400- "IDS CAN NOT BE ALL BAD." NC2164.2 +149500 TO WC-XN-83. NC2164.2 +149600 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +149700 INS-TEST-F2-22. NC2164.2 +149800 INSPECT WRK-XN-83-1 NC2164.2 +149900 REPLACING ALL SPACE-XN-1-1 BY "-" AFTER INITIAL "Z". NC2164.2 +150000 IF WRK-XN-83-1 EQUAL TO WC-XN-83 NC2164.2 +150100 PERFORM PASS NC2164.2 +150200 GO TO INS-WRITE-F2-22 NC2164.2 +150300 ELSE NC2164.2 +150400 GO TO INS-FAIL-F2-22. NC2164.2 +150500 INS-DELETE-F2-22. NC2164.2 +150600 PERFORM DE-LETE. NC2164.2 +150700 GO TO INS-WRITE-F2-22. NC2164.2 +150800 INS-FAIL-F2-22. NC2164.2 +150900 PERFORM FAIL NC2164.2 +151000 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +151100 MOVE WC-XN-83 TO WS-RIGHT-1-83 NC2164.2 +151200 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +151300 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +151400 PERFORM PRINT-DETAIL NC2164.2 +151500 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +151600 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +151700 PERFORM PRINT-DETAIL NC2164.2 +151800 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +151900 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +152000 PERFORM PRINT-DETAIL NC2164.2 +152100 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +152200 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +152300 PERFORM PRINT-DETAIL NC2164.2 +152400 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +152500 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +152600 INS-WRITE-F2-22. NC2164.2 +152700 PERFORM PRINT-DETAIL. NC2164.2 +152800* NC2164.2 +152900 INS-INIT-F1-23. NC2164.2 +153000 MOVE "INS-TEST-F1-23" TO PAR-NAME. NC2164.2 +153100 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +153200 MOVE "TALLY SIGNED NUM." TO FEATURE. NC2164.2 +153300 MOVE -12345 TO WRK-DS-5V0-1. NC2164.2 +153400 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +153500 MOVE ZERO TO WRK-DU-999-2. NC2164.2 +153600 MOVE 1 TO REC-CT. NC2164.2 +153700 INS-TEST-F1-23-0. NC2164.2 +153800 INSPECT WRK-DS-5V0-1 NC2164.2 +153900 TALLYING WRK-DU-999-1 FOR ALL "-" NC2164.2 +154000 WRK-DU-999-2 FOR ALL "5". NC2164.2 +154100 GO TO INS-TEST-F1-23-1. NC2164.2 +154200 INS-DELETE-F1-23. NC2164.2 +154300 PERFORM DE-LETE. NC2164.2 +154400 PERFORM PRINT-DETAIL. NC2164.2 +154500 GO TO INS-INIT-F1-24. NC2164.2 +154600* NC2164.2 +154700 INS-TEST-F1-23-1. NC2164.2 +154800 IF WRK-DU-999-1 EQUAL 0 NC2164.2 +154900 PERFORM PASS NC2164.2 +155000 GO TO INS-WRITE-F1-23-1 NC2164.2 +155100 ELSE NC2164.2 +155200 PERFORM FAIL NC2164.2 +155300 GO TO INS-FAIL-F1-23-1. NC2164.2 +155400 INS-DELETE-F1-23-1. NC2164.2 +155500 PERFORM DE-LETE. NC2164.2 +155600 GO TO INS-WRITE-F1-23-1. NC2164.2 +155700 INS-FAIL-F1-23-1. NC2164.2 +155800 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +155900 MOVE ZERO TO CORRECT-N. NC2164.2 +156000 INS-WRITE-F1-23-1. NC2164.2 +156100 PERFORM PRINT-DETAIL. NC2164.2 +156200* NC2164.2 +156300 INS-TEST-F1-23-2. NC2164.2 +156400 ADD 1 TO REC-CT. NC2164.2 +156500 IF WRK-DU-999-2 EQUAL TO 1 NC2164.2 +156600 PERFORM PASS NC2164.2 +156700 GO TO INS-WRITE-F1-23-2 NC2164.2 +156800 ELSE NC2164.2 +156900 PERFORM FAIL NC2164.2 +157000 GO TO INS-FAIL-F1-23-2. NC2164.2 +157100 INS-DELETE-F1-23-2. NC2164.2 +157200 PERFORM DE-LETE. NC2164.2 +157300 GO TO INS-WRITE-F1-23-2. NC2164.2 +157400 INS-FAIL-F1-23-2. NC2164.2 +157500 MOVE WRK-DU-999-2 TO COMPUTED-N NC2164.2 +157600 MOVE 1 TO CORRECT-N. NC2164.2 +157700 INS-WRITE-F1-23-2. NC2164.2 +157800 PERFORM PRINT-DETAIL. NC2164.2 +157900* NC2164.2 +158000 INS-INIT-F1-24. NC2164.2 +158100 MOVE "INS-TEST-F1-24" TO PAR-NAME. NC2164.2 +158200 MOVE "NUMERIC EDITED FIELD" TO FEATURE. NC2164.2 +158300 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +158400 MOVE 123456.789 TO WRK-NE-1. NC2164.2 +158500 MOVE ZERO TO REC-CT. NC2164.2 +158600 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +158700 INS-TEST-F1-24. NC2164.2 +158800 INSPECT WRK-NE-1 TALLYING WRK-DU-999-1 FOR ALL ",". NC2164.2 +158900 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +159000 PERFORM PASS NC2164.2 +159100 GO TO INS-WRITE-F1-24 NC2164.2 +159200 ELSE NC2164.2 +159300 GO TO INS-FAIL-F1-24. NC2164.2 +159400 INS-DELETE-F1-24. NC2164.2 +159500 PERFORM DE-LETE. NC2164.2 +159600 GO TO INS-WRITE-F1-24. NC2164.2 +159700 INS-FAIL-F1-24. NC2164.2 +159800 PERFORM FAIL NC2164.2 +159900 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +160000 MOVE 1 TO CORRECT-N. NC2164.2 +160100 INS-WRITE-F1-24. NC2164.2 +160200 PERFORM PRINT-DETAIL. NC2164.2 +160300* NC2164.2 +160400 INS-INIT-F1-25. NC2164.2 +160500 MOVE "INS-TEST-F1-25" TO PAR-NAME. NC2164.2 +160600 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +160700 MOVE "NUMERIC EDITED FIELD" TO FEATURE. NC2164.2 +160800 MOVE 123456.789 TO WRK-NE-1. NC2164.2 +160900 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +161000 INS-TEST-F1-25. NC2164.2 +161100 INSPECT WRK-NE-1 TALLYING WRK-DU-999-1 FOR ALL "-". NC2164.2 +161200 IF WRK-DU-999-1 EQUAL TO ZERO NC2164.2 +161300 PERFORM PASS NC2164.2 +161400 GO TO INS-WRITE-F1-25 NC2164.2 +161500 ELSE NC2164.2 +161600 GO TO INS-FAIL-F1-25. NC2164.2 +161700 INS-DELETE-F1-25. NC2164.2 +161800 PERFORM DE-LETE. NC2164.2 +161900 GO TO INS-WRITE-F1-25. NC2164.2 +162000 INS-FAIL-F1-25. NC2164.2 +162100 PERFORM FAIL NC2164.2 +162200 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +162300 MOVE ZERO TO CORRECT-N. NC2164.2 +162400 INS-WRITE-F1-25. NC2164.2 +162500 PERFORM PRINT-DETAIL. NC2164.2 +162600* NC2164.2 +162700 INS-INIT-F1-26. NC2164.2 +162800 MOVE "INS-TEST-F1-26" TO PAR-NAME. NC2164.2 +162900 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +163000 MOVE "2 CHARACTER MASK" TO FEATURE. NC2164.2 +163100 MOVE "X X" TO X-SPACE-X-XN-3. NC2164.2 +163200 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +163300 INS-TEST-F1-26. NC2164.2 +163400 INSPECT X-SPACE-X-XN-3 TALLYING WRK-DU-999-1 FOR ALL "X ". NC2164.2 +163500 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +163600 PERFORM PASS NC2164.2 +163700 GO TO INS-WRITE-F1-26 NC2164.2 +163800 ELSE NC2164.2 +163900 GO TO INS-FAIL-F1-26. NC2164.2 +164000 INS-DELETE-F1-26. NC2164.2 +164100 PERFORM DE-LETE. NC2164.2 +164200 GO TO INS-WRITE-F1-26. NC2164.2 +164300 INS-FAIL-F1-26. NC2164.2 +164400 PERFORM FAIL NC2164.2 +164500 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +164600 MOVE 1 TO CORRECT-N. NC2164.2 +164700 INS-WRITE-F1-26. NC2164.2 +164800 PERFORM PRINT-DETAIL. NC2164.2 +164900* NC2164.2 +165000 INS-INIT-F1-27. NC2164.2 +165100 MOVE "INS-TEST-F1-27" TO PAR-NAME. NC2164.2 +165200 MOVE "VI-94" TO ANSI-REFERENCE. NC2164.2 +165300 MOVE "ORDER OF COMPARE" TO FEATURE. NC2164.2 +165400 MOVE "AABA" TO AABA-XN-4. NC2164.2 +165500 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +165600 MOVE ZERO TO WRK-DU-999-2. NC2164.2 +165700 INS-TEST-F1-27. NC2164.2 +165800 INSPECT AABA-XN-4 TALLYING WRK-DU-999-1 FOR ALL "AA" NC2164.2 +165900 WRK-DU-999-2 FOR ALL "A". NC2164.2 +166000 IF WRK-DU-999-1 EQUAL TO 1 NC2164.2 +166100 AND NC2164.2 +166200 WRK-DU-999-2 EQUAL TO 1 NC2164.2 +166300 PERFORM PASS NC2164.2 +166400 GO TO INS-WRITE-F1-27 NC2164.2 +166500 ELSE NC2164.2 +166600 GO TO INS-FAIL-F1-27. NC2164.2 +166700 INS-DELETE-F1-27. NC2164.2 +166800 PERFORM DE-LETE. NC2164.2 +166900 GO TO INS-WRITE-F1-27. NC2164.2 +167000 INS-FAIL-F1-27. NC2164.2 +167100 PERFORM FAIL NC2164.2 +167200 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +167300 MOVE WRK-DU-999-2 TO CORRECT-N NC2164.2 +167400 MOVE "BOTH SHOULD BE 1" TO RE-MARK. NC2164.2 +167500 INS-WRITE-F1-27. NC2164.2 +167600 PERFORM PRINT-DETAIL. NC2164.2 +167700* NC2164.2 +167800 INS-INIT-F1-28. NC2164.2 +167900* ===--> BEFORE AND AFTER PHRASES <--=== NC2164.2 +168000 MOVE "INS-TEST-F1-28" TO PAR-NAME. NC2164.2 +168100 MOVE "VI-94 6.17.3 SR4" TO ANSI-REFERENCE. NC2164.2 +168200 MOVE "TALLY FOR ALL SPACES" TO FEATURE. NC2164.2 +168300 MOVE NC2164.2 +168400 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +168500- "IDS CAN NOT BE ALL BAD." NC2164.2 +168600 TO WC-XN-83. NC2164.2 +168700 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +168800 INS-TEST-F1-28. NC2164.2 +168900 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR ALL SPACES NC2164.2 +169000 AFTER "C." NC2164.2 +169100 BEFORE "DO". NC2164.2 +169200 IF WRK-DU-999-1 EQUAL TO 6 NC2164.2 +169300 PERFORM PASS NC2164.2 +169400 GO TO INS-WRITE-F1-28. NC2164.2 +169500 GO TO INS-FAIL-F1-28. NC2164.2 +169600 INS-DELETE-F1-28. NC2164.2 +169700 PERFORM DE-LETE. NC2164.2 +169800 GO TO INS-WRITE-F1-28. NC2164.2 +169900 INS-FAIL-F1-28. NC2164.2 +170000 PERFORM FAIL. NC2164.2 +170100 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +170200 MOVE 6 TO CORRECT-N. NC2164.2 +170300 INS-WRITE-F1-28. NC2164.2 +170400 PERFORM PRINT-DETAIL. NC2164.2 +170500* NC2164.2 +170600 INS-INIT-F1-29. NC2164.2 +170700* ===--> BEFORE AND AFTER PHRASES <--=== NC2164.2 +170800 MOVE "INS-TEST-F1-29" TO PAR-NAME. NC2164.2 +170900 MOVE "VI-94 6.17.3 SR4" TO ANSI-REFERENCE. NC2164.2 +171000 MOVE "FOR CHARS AFTER LIT" TO FEATURE. NC2164.2 +171100 MOVE NC2164.2 +171200 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +171300- "IDS CAN NOT BE ALL BAD." NC2164.2 +171400 TO WC-XN-83. NC2164.2 +171500 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +171600 INS-TEST-F1-29. NC2164.2 +171700 INSPECT WC-XN-83 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +171800 BEFORE "KI" NC2164.2 +171900 AFTER " W". NC2164.2 +172000 IF WRK-DU-999-1 EQUAL TO 44 NC2164.2 +172100 PERFORM PASS NC2164.2 +172200 GO TO INS-WRITE-F1-29. NC2164.2 +172300 GO TO INS-FAIL-F1-29. NC2164.2 +172400 INS-DELETE-F1-29. NC2164.2 +172500 PERFORM DE-LETE. NC2164.2 +172600 GO TO INS-WRITE-F1-29. NC2164.2 +172700 INS-FAIL-F1-29. NC2164.2 +172800 PERFORM FAIL. NC2164.2 +172900 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +173000 MOVE 44 TO CORRECT-N. NC2164.2 +173100 INS-WRITE-F1-29. NC2164.2 +173200 PERFORM PRINT-DETAIL. NC2164.2 +173300* NC2164.2 +173400 INS-INIT-F1-30. NC2164.2 +173500* ===--> EVALUATION OF SUBSCRIPTED IDENTIFIERS <--=== NC2164.2 +173600 MOVE "INS-TEST-F1-30" TO PAR-NAME. NC2164.2 +173700 MOVE "VI-95 6.17.4 GR4 & VI-97 6.17.4 GR8" NC2164.2 +173800 TO ANSI-REFERENCE. NC2164.2 +173900 MOVE "FOR CHARS AFTER LIT" TO FEATURE. NC2164.2 +174000 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +174100 MOVE "XXXXXXXYYYYYYYAAABAAASSSSSSSTTTTTTT" NC2164.2 +174200 TO INSPECT-FIELDS. NC2164.2 +174300 MOVE "GHBDC" TO LOCATE-CHARS. NC2164.2 +174400 MOVE 3 TO SUB. NC2164.2 +174500 INS-TEST-F1-30-0. NC2164.2 +174600 INSPECT DATA-FIELD (SUB) NC2164.2 +174700 TALLYING WRK-DU-999-1 NC2164.2 +174800 FOR ALL "A" BEFORE END-CHAR (SUB) NC2164.2 +174900 ALL END-CHAR (SUB). NC2164.2 +175000 INS-TEST-F1-30-1. NC2164.2 +175100 IF WRK-DU-999-1 EQUAL TO 4 NC2164.2 +175200 PERFORM PASS NC2164.2 +175300 GO TO INS-WRITE-F1-30-1. NC2164.2 +175400 GO TO INS-FAIL-F1-30-1. NC2164.2 +175500 INS-DELETE-F1-30-1. NC2164.2 +175600 PERFORM DE-LETE. NC2164.2 +175700 GO TO INS-WRITE-F1-30-1. NC2164.2 +175800 INS-FAIL-F1-30-1. NC2164.2 +175900 PERFORM FAIL. NC2164.2 +176000 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +176100 MOVE 4 TO CORRECT-N. NC2164.2 +176200 INS-WRITE-F1-30-1. NC2164.2 +176300 PERFORM PRINT-DETAIL. NC2164.2 +176400* NC2164.2 +176500 INS-INIT-F1-31. NC2164.2 +176600 MOVE "INS-TEST-F1-31" TO PAR-NAME. NC2164.2 +176700 MOVE "VI-93" TO ANSI-REFERENCE. NC2164.2 +176800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +176900 MOVE "AABBCCDDEBBBBGHDDIJJXXAABBCCDDEEEFFGGHHIIJJKKLLM" NC2164.2 +177000 TO TEST-31-DATA. NC2164.2 +177100 MOVE "BB" TO WS-BB. NC2164.2 +177200 INS-TEST-F1-31-0. NC2164.2 +177300 INSPECT TEST-31-DATA TALLYING WRK-DU-999-1 NC2164.2 +177400 FOR ALL "A" BEFORE "X" NC2164.2 +177500 ALL WS-BB BEFORE "X" NC2164.2 +177600 ALL "D" BEFORE "X". NC2164.2 +177700 INS-TEST-F1-31-1. NC2164.2 +177800 IF WRK-DU-999-1 EQUAL TO 9 NC2164.2 +177900 PERFORM PASS NC2164.2 +178000 GO TO INS-WRITE-F1-31-1. NC2164.2 +178100 GO TO INS-FAIL-F1-31-1. NC2164.2 +178200 INS-DELETE-F1-31-1. NC2164.2 +178300 PERFORM DE-LETE. NC2164.2 +178400 GO TO INS-WRITE-F1-31-1. NC2164.2 +178500 INS-FAIL-F1-31-1. NC2164.2 +178600 PERFORM FAIL. NC2164.2 +178700 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +178800 MOVE 10 TO CORRECT-N. NC2164.2 +178900 INS-WRITE-F1-31-1. NC2164.2 +179000 PERFORM PRINT-DETAIL. NC2164.2 +179100* NC2164.2 +179200 INS-INIT-F1-32. NC2164.2 +179300 MOVE "INS-TEST-F1-32" TO PAR-NAME. NC2164.2 +179400 MOVE "VI-93" TO ANSI-REFERENCE. NC2164.2 +179500 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +179600 MOVE "AABSSSSSEBBTTTT1URSTSTSTVVDYYDEEEFFGSSSSTZSTZSTM" NC2164.2 +179700 TO TEST-32-DATA. NC2164.2 +179800 MOVE "Y" TO WS-Y. NC2164.2 +179900 INS-TEST-F1-32-0. NC2164.2 +180000 INSPECT TEST-32-DATA TALLYING WRK-DU-999-1 NC2164.2 +180100 FOR LEADING "S" AFTER WS-Y NC2164.2 +180200 "S" AFTER "U" NC2164.2 +180300 "T" AFTER WS-Y NC2164.2 +180400 "T" AFTER "U". NC2164.2 +180500 INS-TEST-F1-32-1. NC2164.2 +180600 IF WRK-DU-999-1 EQUAL TO 0 NC2164.2 +180700 PERFORM PASS NC2164.2 +180800 GO TO INS-WRITE-F1-32-1. NC2164.2 +180900 GO TO INS-FAIL-F1-32-1. NC2164.2 +181000 INS-DELETE-F1-32-1. NC2164.2 +181100 PERFORM DE-LETE. NC2164.2 +181200 GO TO INS-WRITE-F1-32-1. NC2164.2 +181300 INS-FAIL-F1-32-1. NC2164.2 +181400 PERFORM FAIL. NC2164.2 +181500 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +181600 MOVE 0 TO CORRECT-N. NC2164.2 +181700 INS-WRITE-F1-32-1. NC2164.2 +181800 PERFORM PRINT-DETAIL. NC2164.2 +181900* NC2164.2 +182000 INS-INIT-F2-33. NC2164.2 +182100* ===--> "BEFORE" AND "AFTER" PHRASES <--=== NC2164.2 +182200 MOVE "INS-TEST-F2-33" TO PAR-NAME. NC2164.2 +182300 MOVE "VI-94 6.17.3 SR4" TO ANSI-REFERENCE. NC2164.2 +182400 MOVE "REP CHARS BY SPACES" TO FEATURE. NC2164.2 +182500 MOVE NC2164.2 +182600 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +182700- "IDS CAN NOT BE ALL BAD." NC2164.2 +182800 TO WC-XN-83. NC2164.2 +182900 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +183000 MOVE NC2164.2 +183100 "AH YES AH YES W.C NC2164.2 +183200- " BE ALL BAD." NC2164.2 +183300 TO ANS-XN-83-10. NC2164.2 +183400 INS-TEST-F2-33-0. NC2164.2 +183500 INSPECT WRK-XN-83-1 REPLACING CHARACTERS BY SPACES NC2164.2 +183600 BEFORE "B" AFTER "C". NC2164.2 +183700 INS-TEST-F2-33-1. NC2164.2 +183800 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-10 NC2164.2 +183900 PERFORM PASS NC2164.2 +184000 GO TO INS-WRITE-F2-33-1. NC2164.2 +184100 GO TO INS-FAIL-F2-33-1. NC2164.2 +184200 INS-DELETE-F2-33-1. NC2164.2 +184300 PERFORM DE-LETE. NC2164.2 +184400 GO TO INS-WRITE-F2-33-1. NC2164.2 +184500 INS-FAIL-F2-33-1. NC2164.2 +184600 PERFORM FAIL. NC2164.2 +184700 MOVE WRK-XN-83-1 TO WS-WRONG-1-83. NC2164.2 +184800 MOVE ANS-XN-83-10 TO WS-RIGHT-1-83. NC2164.2 +184900 MOVE "THERE SHOUD BE 55 SPACES BETWEEN ""B"" AND ""C""." NC2164.2 +185000 TO RE-MARK. NC2164.2 +185100 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2164.2 +185200 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2164.2 +185300 PERFORM PRINT-DETAIL. NC2164.2 +185400 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2164.2 +185500 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2164.2 +185600 PERFORM PRINT-DETAIL. NC2164.2 +185700 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2164.2 +185800 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2164.2 +185900 PERFORM PRINT-DETAIL. NC2164.2 +186000 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2164.2 +186100 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2164.2 +186200 PERFORM PRINT-DETAIL. NC2164.2 +186300 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2164.2 +186400 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +186500 INS-WRITE-F2-33-1. NC2164.2 +186600 PERFORM PRINT-DETAIL. NC2164.2 +186700* NC2164.2 +186800 INS-INIT-F2-34. NC2164.2 +186900* ===--> MULTIPLE "CHARACTERS" PHRASES WITH <--=== NC2164.2 +187000* ===--> "BEFORE" AND "AFTER" <--=== NC2164.2 +187100 MOVE "INS-TEST-F2-34" TO PAR-NAME. NC2164.2 +187200 MOVE "VI-93 6.17.2" TO ANSI-REFERENCE. NC2164.2 +187300 MOVE "AAFSSQ ET U V W H S" TO TEST-34-DATA. NC2164.2 +187400 MOVE "AAFXXQ ETYYYYYYYH S" TO TEST-34-ANSWER. NC2164.2 +187500 INS-TEST-F2-34-0. NC2164.2 +187600 INSPECT TEST-34-DATA NC2164.2 +187700 REPLACING NC2164.2 +187800 CHARACTERS BY "X" AFTER "F" BEFORE "Q" NC2164.2 +187900 CHARACTERS BY "Y" AFTER "T" BEFORE "H". NC2164.2 +188000 INS-TEST-F2-34-1. NC2164.2 +188100 IF TEST-34-DATA = TEST-34-ANSWER NC2164.2 +188200 PERFORM PASS NC2164.2 +188300 GO TO INS-WRITE-F2-34-1. NC2164.2 +188400 GO TO INS-FAIL-F2-34-1. NC2164.2 +188500 INS-DELETE-F2-34-1. NC2164.2 +188600 PERFORM DE-LETE. NC2164.2 +188700 GO TO INS-WRITE-F2-34-1. NC2164.2 +188800 INS-FAIL-F2-34-1. NC2164.2 +188900 PERFORM FAIL. NC2164.2 +189000 MOVE TEST-34-DATA TO COMPUTED-A. NC2164.2 +189100 MOVE TEST-34-ANSWER TO CORRECT-A. NC2164.2 +189200 INS-WRITE-F2-34-1. NC2164.2 +189300 PERFORM PRINT-DETAIL. NC2164.2 +189400* NC2164.2 +189500 INS-INIT-F3-35. NC2164.2 +189600* ===--> MULTIPLE "CHARACTERS" PHRASES WITH <--=== NC2164.2 +189700* ===--> "BEFORE" AND "AFTER" <--=== NC2164.2 +189800 MOVE "INS-TEST-F3-35-1" TO PAR-NAME. NC2164.2 +189900 MOVE "VI-93 6.17.2" TO ANSI-REFERENCE. NC2164.2 +190000 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +190100 MOVE "AX SSA YEG U V W H S" TO TEST-35-DATA. NC2164.2 +190200 MOVE "AXAAAAAYEG H S" TO TEST-35-ANSWER. NC2164.2 +190300 INS-TEST-F3-35-0. NC2164.2 +190400 INSPECT TEST-35-DATA TALLYING WRK-DU-999-1 NC2164.2 +190500 FOR CHARACTERS NC2164.2 +190600 REPLACING NC2164.2 +190700 CHARACTERS BY "A" AFTER "X" BEFORE "Y" NC2164.2 +190800 CHARACTERS BY SPACE AFTER "G" BEFORE "H". NC2164.2 +190900 INS-TEST-F3-35-1. NC2164.2 +191000 IF TEST-35-DATA = TEST-35-ANSWER NC2164.2 +191100 PERFORM PASS NC2164.2 +191200 GO TO INS-WRITE-F3-35-1. NC2164.2 +191300 GO TO INS-FAIL-F3-35-1. NC2164.2 +191400 INS-DELETE-F3-35-1. NC2164.2 +191500 PERFORM DE-LETE. NC2164.2 +191600 GO TO INS-WRITE-F3-35-1. NC2164.2 +191700 INS-FAIL-F3-35-1. NC2164.2 +191800 PERFORM FAIL. NC2164.2 +191900 MOVE TEST-35-DATA TO COMPUTED-A. NC2164.2 +192000 MOVE TEST-35-ANSWER TO CORRECT-A. NC2164.2 +192100 INS-WRITE-F3-35-1. NC2164.2 +192200 PERFORM PRINT-DETAIL. NC2164.2 +192300* NC2164.2 +192400 INS-INIT-F3-36. NC2164.2 +192500* ===--> "BEFORE" AND "AFTER" PHRASES <--=== NC2164.2 +192600 MOVE "INS-TEST-F3-36" TO PAR-NAME. NC2164.2 +192700 MOVE "TALLY-REPLACE CHARS" TO FEATURE. NC2164.2 +192800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +192900 MOVE NC2164.2 +193000 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +193100- "IDS CAN NOT BE ALL BAZ." NC2164.2 +193200 TO WC-XN-83. NC2164.2 +193300 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +193400 MOVE NC2164.2 +193500 "AH NC2164.2 +193600- " Z." NC2164.2 +193700 TO ANS-XN-83-11. NC2164.2 +193800 MOVE 1 TO REC-CT. NC2164.2 +193900 INS-TEST-F3-36-0. NC2164.2 +194000 INSPECT WRK-XN-83-1 NC2164.2 +194100 TALLYING WRK-DU-999-1 FOR CHARACTERS NC2164.2 +194200 BEFORE "LL" AFTER "ES" NC2164.2 +194300 REPLACING CHARACTERS BY SPACES NC2164.2 +194400 AFTER "H" BEFORE "Z". NC2164.2 +194500 GO TO INS-TEST-F3-36-1. NC2164.2 +194600 INS-DELETE-F3-36. NC2164.2 +194700 PERFORM DE-LETE. NC2164.2 +194800 PERFORM PRINT-DETAIL. NC2164.2 +194900 GO TO INS-INIT-F3-37. NC2164.2 +195000 INS-TEST-F3-36-1. NC2164.2 +195100 IF WRK-DU-999-1 EQUAL TO 70 NC2164.2 +195200 PERFORM PASS NC2164.2 +195300 GO TO INS-WRITE-F3-36-1 NC2164.2 +195400 ELSE NC2164.2 +195500 GO TO INS-FAIL-F3-36-1. NC2164.2 +195600 INS-DELETE-F3-36-1. NC2164.2 +195700 PERFORM DE-LETE. NC2164.2 +195800 GO TO INS-WRITE-F3-36-1. NC2164.2 +195900 INS-FAIL-F3-36-1. NC2164.2 +196000 PERFORM FAIL NC2164.2 +196100 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +196200 MOVE 70 TO CORRECT-N. NC2164.2 +196300 INS-WRITE-F3-36-1. NC2164.2 +196400 PERFORM PRINT-DETAIL. NC2164.2 +196500* NC2164.2 +196600 INS-TEST-F3-36-2. NC2164.2 +196700 ADD 1 TO REC-CT. NC2164.2 +196800 IF WRK-XN-83-1 = ANS-XN-83-11 NC2164.2 +196900 PERFORM PASS NC2164.2 +197000 GO TO INS-WRITE-F3-36-2 NC2164.2 +197100 ELSE NC2164.2 +197200 GO TO INS-FAIL-F3-36-2. NC2164.2 +197300 INS-DELETE-F3-36-2. NC2164.2 +197400 PERFORM DE-LETE. NC2164.2 +197500 GO TO INS-WRITE-F3-36-2. NC2164.2 +197600 INS-FAIL-F3-36-2. NC2164.2 +197700 PERFORM FAIL NC2164.2 +197800 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +197900 MOVE ANS-XN-83-11 TO WS-RIGHT-1-83 NC2164.2 +198000 MOVE "THERE SHOULD BE 81 SPACES BETWEEN ""H"" AND ""Z""." NC2164.2 +198100 TO RE-MARK NC2164.2 +198200 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +198300 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +198400 PERFORM PRINT-DETAIL NC2164.2 +198500 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +198600 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +198700 PERFORM PRINT-DETAIL NC2164.2 +198800 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +198900 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +199000 PERFORM PRINT-DETAIL NC2164.2 +199100 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +199200 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +199300 PERFORM PRINT-DETAIL NC2164.2 +199400 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +199500 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +199600 INS-WRITE-F3-36-2. NC2164.2 +199700 PERFORM PRINT-DETAIL. NC2164.2 +199800* NC2164.2 +199900 INS-INIT-F3-37. NC2164.2 +200000* ===--> "BEFORE" AND "AFTER" PHRASES <--=== NC2164.2 +200100 MOVE "INS-TEST-F3-37" TO PAR-NAME. NC2164.2 +200200 MOVE "REPL FIRST AFTER" TO FEATURE. NC2164.2 +200300 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +200400 MOVE NC2164.2 +200500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +200600- "IDS CAN NOT BE ALL BAD." NC2164.2 +200700 TO WC-XN-83. NC2164.2 +200800 MOVE WC-XN-83 TO WRK-XN-83-1. NC2164.2 +200900 MOVE NC2164.2 +201000 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2164.2 +201100- "IDS CAN NOT BE ALL BAD." NC2164.2 +201200 TO ANS-XN-83-5. NC2164.2 +201300 MOVE 1 TO REC-CT. NC2164.2 +201400 INS-TEST-F3-37-0. NC2164.2 +201500 INSPECT WRK-XN-83-1 NC2164.2 +201600 TALLYING WRK-DU-999-1 FOR ALL "A" NC2164.2 +201700 BEFORE L-XN-1-1 NC2164.2 +201800 AFTER "YE" NC2164.2 +201900 REPLACING FIRST AH-XN-2 BY "OH" NC2164.2 +202000 AFTER INITIAL HSPACE-XN-2 NC2164.2 +202100 BEFORE "F". NC2164.2 +202200 GO TO INS-TEST-F3-37-1. NC2164.2 +202300 INS-DELETE-F3-37. NC2164.2 +202400 PERFORM DE-LETE. NC2164.2 +202500 PERFORM PRINT-DETAIL. NC2164.2 +202600 GO TO INS-INIT-F3-38. NC2164.2 +202700 INS-TEST-F3-37-1. NC2164.2 +202800 IF WRK-DU-999-1 EQUAL TO 6 NC2164.2 +202900 PERFORM PASS NC2164.2 +203000 GO TO INS-WRITE-F3-37-1 NC2164.2 +203100 ELSE NC2164.2 +203200 GO TO INS-FAIL-F3-37-1. NC2164.2 +203300 INS-DELETE-F3-37-1. NC2164.2 +203400 PERFORM DE-LETE. NC2164.2 +203500 GO TO INS-WRITE-F3-37-1. NC2164.2 +203600 INS-FAIL-F3-37-1. NC2164.2 +203700 PERFORM FAIL NC2164.2 +203800 MOVE WRK-DU-999-1 TO COMPUTED-N NC2164.2 +203900 MOVE 6 TO CORRECT-N. NC2164.2 +204000 INS-WRITE-F3-37-1. NC2164.2 +204100 PERFORM PRINT-DETAIL. NC2164.2 +204200* NC2164.2 +204300 INS-TEST-F3-37-2. NC2164.2 +204400 ADD 1 TO REC-CT. NC2164.2 +204500 IF WRK-XN-83-1 EQUAL TO ANS-XN-83-5 NC2164.2 +204600 PERFORM PASS NC2164.2 +204700 GO TO INS-WRITE-F3-37-2 NC2164.2 +204800 ELSE NC2164.2 +204900 GO TO INS-FAIL-F3-37-2. NC2164.2 +205000 INS-DELETE-F3-37-2. NC2164.2 +205100 PERFORM DE-LETE. NC2164.2 +205200 GO TO INS-WRITE-F3-37-2. NC2164.2 +205300 INS-FAIL-F3-37-2. NC2164.2 +205400 PERFORM FAIL NC2164.2 +205500 MOVE WRK-XN-83-1 TO WS-WRONG-1-83 NC2164.2 +205600 MOVE ANS-XN-83-5 TO WS-RIGHT-1-83 NC2164.2 +205700 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2164.2 +205800 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2164.2 +205900 PERFORM PRINT-DETAIL NC2164.2 +206000 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2164.2 +206100 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2164.2 +206200 PERFORM PRINT-DETAIL NC2164.2 +206300 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2164.2 +206400 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2164.2 +206500 PERFORM PRINT-DETAIL NC2164.2 +206600 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2164.2 +206700 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2164.2 +206800 PERFORM PRINT-DETAIL NC2164.2 +206900 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2164.2 +207000 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2164.2 +207100 INS-WRITE-F3-37-2. NC2164.2 +207200 PERFORM PRINT-DETAIL. NC2164.2 +207300* NC2164.2 +207400 INS-INIT-F3-38. NC2164.2 +207500* ===--> MULTIPLE OPERANDS FOR "ALL" <--=== NC2164.2 +207600 MOVE "INS-TEST-F3-38" TO PAR-NAME. NC2164.2 +207700 MOVE "VI-93 6.17.2" TO ANSI-REFERENCE. NC2164.2 +207800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +207900 MOVE "E" TO WS-E. NC2164.2 +208000 MOVE "AXESSA YEGTUASSW H S" TO TEST-38-DATA. NC2164.2 +208100 MOVE ZERO TO REC-CT. NC2164.2 +208200 INS-TEST-F3-38-0. NC2164.2 +208300 INSPECT TEST-38-DATA TALLYING WRK-DU-999-1 NC2164.2 +208400 FOR NC2164.2 +208500 ALL "A" AFTER WS-E NC2164.2 +208600 "A" AFTER "T" NC2164.2 +208700 "S" AFTER WS-E NC2164.2 +208800 "S" AFTER "T". NC2164.2 +208900 INS-TEST-F3-38-1. NC2164.2 +209000 IF WRK-DU-999-1 = 7 NC2164.2 +209100 PERFORM PASS NC2164.2 +209200 GO TO INS-WRITE-F3-38. NC2164.2 +209300 GO TO INS-FAIL-F3-38. NC2164.2 +209400 INS-DELETE-F3-38. NC2164.2 +209500 PERFORM DE-LETE. NC2164.2 +209600 GO TO INS-WRITE-F3-38. NC2164.2 +209700 INS-FAIL-F3-38. NC2164.2 +209800 PERFORM FAIL. NC2164.2 +209900 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +210000 MOVE 7 TO CORRECT-N. NC2164.2 +210100 INS-WRITE-F3-38. NC2164.2 +210200 PERFORM PRINT-DETAIL. NC2164.2 +210300* NC2164.2 +210400 INS-INIT-F3-39. NC2164.2 +210500* ===--> MULTIPLE OPERANDS FOR "LEADING" <--=== NC2164.2 +210600 MOVE "INS-TEST-F3-39" TO PAR-NAME. NC2164.2 +210700 MOVE "VI-93 6.17.2" TO ANSI-REFERENCE. NC2164.2 +210800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +210900 MOVE "ABESSA YE TUTCGW H S" TO TEST-39-DATA. NC2164.2 +211000 INS-TEST-F3-39-0. NC2164.2 +211100 INSPECT TEST-39-DATA NC2164.2 +211200 TALLYING WRK-DU-999-1 NC2164.2 +211300 FOR LEADING "B" NC2164.2 +211400 LEADING WS-E NC2164.2 +211500 BEFORE "C" NC2164.2 +211600 REPLACING NC2164.2 +211700 CHARACTERS BY "A" AFTER "X" BEFORE "Y" NC2164.2 +211800 CHARACTERS BY SPACE AFTER "G" BEFORE "H". NC2164.2 +211900 INS-TEST-F3-39-1. NC2164.2 +212000 IF WRK-DU-999-1 = 0 NC2164.2 +212100 PERFORM PASS NC2164.2 +212200 GO TO INS-WRITE-F3-39-1. NC2164.2 +212300 GO TO INS-FAIL-F3-39-1. NC2164.2 +212400 INS-DELETE-F3-39-1. NC2164.2 +212500 PERFORM DE-LETE. NC2164.2 +212600 GO TO INS-WRITE-F3-39-1. NC2164.2 +212700 INS-FAIL-F3-39-1. NC2164.2 +212800 PERFORM FAIL. NC2164.2 +212900 MOVE WRK-DU-999-1 TO COMPUTED-N. NC2164.2 +213000 MOVE 0 TO CORRECT-N. NC2164.2 +213100 INS-WRITE-F3-39-1. NC2164.2 +213200 PERFORM PRINT-DETAIL. NC2164.2 +213300* NC2164.2 +213400 INS-INIT-F4-40. NC2164.2 +213500* ===--> INSPECT CONVERTING <--=== NC2164.2 +213600 MOVE "INS-TEST-F4-40" TO PAR-NAME. NC2164.2 +213700 MOVE "VI-943" TO ANSI-REFERENCE. NC2164.2 +213800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +213900 MOVE "GADQAUZTABAGA" TO TEST-40-DATA. NC2164.2 +214000 INS-TEST-F4-40-0. NC2164.2 +214100 INSPECT TEST-40-DATA NC2164.2 +214200 CONVERTING "AU" TO "23" BEFORE "B" AFTER "Q". NC2164.2 +214300 GO TO INS-TEST-F4-40-1. NC2164.2 +214400 INS-DELETE-F4-40. NC2164.2 +214500 PERFORM DE-LETE. NC2164.2 +214600 PERFORM PRINT-DETAIL. NC2164.2 +214700 GO TO INS-INIT-F4-41. NC2164.2 +214800 INS-TEST-F4-40-1. NC2164.2 +214900 IF TEST-40-DATA = "GADQ23ZT2BAGA" NC2164.2 +215000 PERFORM PASS NC2164.2 +215100 GO TO INS-WRITE-F4-40-1 NC2164.2 +215200 ELSE NC2164.2 +215300 GO TO INS-FAIL-F4-40-1. NC2164.2 +215400 INS-DELETE-F4-40-1. NC2164.2 +215500 PERFORM DE-LETE. NC2164.2 +215600 GO TO INS-WRITE-F4-40-1. NC2164.2 +215700 INS-FAIL-F4-40-1. NC2164.2 +215800 MOVE "GADQ23ZT2BAGA" TO CORRECT-A NC2164.2 +215900 MOVE TEST-40-DATA TO COMPUTED-A NC2164.2 +216000 PERFORM FAIL. NC2164.2 +216100 INS-WRITE-F4-40-1. NC2164.2 +216200 PERFORM PRINT-DETAIL. NC2164.2 +216300 INS-INIT-F4-41. NC2164.2 +216400* ===--> INSPECT CONVERTING <--=== NC2164.2 +216500 MOVE "INS-TEST-F4-41" TO PAR-NAME. NC2164.2 +216600 MOVE "VI-943" TO ANSI-REFERENCE. NC2164.2 +216700 MOVE "GADQ23ZT2BAGA" TO TEST-40-DATA. NC2164.2 +216800 MOVE "DF" TO XN-DF. NC2164.2 +216900 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +217000 INS-TEST-F4-41-0. NC2164.2 +217100 INSPECT TEST-40-DATA NC2164.2 +217200 CONVERTING XN-DF TO "45". NC2164.2 +217300 GO TO INS-TEST-F4-41-1. NC2164.2 +217400 INS-DELETE-F4-41. NC2164.2 +217500 PERFORM DE-LETE. NC2164.2 +217600 PERFORM PRINT-DETAIL. NC2164.2 +217700 GO TO INS-INIT-F4-42. NC2164.2 +217800 INS-TEST-F4-41-1. NC2164.2 +217900 IF TEST-40-DATA = "GA4Q23ZT2BAGA" NC2164.2 +218000 PERFORM PASS NC2164.2 +218100 GO TO INS-WRITE-F4-41-1 NC2164.2 +218200 ELSE NC2164.2 +218300 GO TO INS-FAIL-F4-41-1. NC2164.2 +218400 INS-DELETE-F4-41-1. NC2164.2 +218500 PERFORM DE-LETE. NC2164.2 +218600 GO TO INS-WRITE-F4-41-1. NC2164.2 +218700 INS-FAIL-F4-41-1. NC2164.2 +218800 MOVE "GA4Q23ZT2BAGA" TO CORRECT-A NC2164.2 +218900 MOVE TEST-40-DATA TO COMPUTED-A NC2164.2 +219000 PERFORM FAIL. NC2164.2 +219100 INS-WRITE-F4-41-1. NC2164.2 +219200 PERFORM PRINT-DETAIL. NC2164.2 +219300* NC2164.2 +219400 INS-INIT-F4-42. NC2164.2 +219500* ===--> INSPECT CONVERTING <--=== NC2164.2 +219600 MOVE "INS-TEST-F4-42" TO PAR-NAME. NC2164.2 +219700 MOVE "VI-943" TO ANSI-REFERENCE. NC2164.2 +219800 MOVE ZERO TO WRK-DU-999-1. NC2164.2 +219900 MOVE "GA4Q23ZT2BAGA" TO TEST-40-DATA. NC2164.2 +220000 MOVE "67" TO XN-67. NC2164.2 +220100 INS-TEST-F4-42-0. NC2164.2 +220200 INSPECT TEST-40-DATA NC2164.2 +220300 CONVERTING "GA" TO XN-67 BEFORE XN-B. NC2164.2 +220400 GO TO INS-TEST-F4-42-1. NC2164.2 +220500 INS-DELETE-F4-42. NC2164.2 +220600 PERFORM DE-LETE. NC2164.2 +220700 PERFORM PRINT-DETAIL. NC2164.2 +220800 GO TO CCVS-EXIT. NC2164.2 +220900 INS-TEST-F4-42-1. NC2164.2 +221000 IF TEST-40-DATA = "674Q23ZT2BAGA" NC2164.2 +221100 PERFORM PASS NC2164.2 +221200 GO TO INS-WRITE-F4-42-1 NC2164.2 +221300 ELSE NC2164.2 +221400 GO TO INS-FAIL-F4-42-1. NC2164.2 +221500 INS-DELETE-F4-42-1. NC2164.2 +221600 PERFORM DE-LETE. NC2164.2 +221700 GO TO INS-WRITE-F4-42-1. NC2164.2 +221800 INS-FAIL-F4-42-1. NC2164.2 +221900 MOVE "674Q23ZT2BAGA" TO CORRECT-A NC2164.2 +222000 MOVE TEST-40-DATA TO COMPUTED-A NC2164.2 +222100 PERFORM FAIL. NC2164.2 +222200 INS-WRITE-F4-42-1. NC2164.2 +222300 PERFORM PRINT-DETAIL. NC2164.2 +222400* NC2164.2 +222500 CCVS-EXIT SECTION. NC2164.2 +222600 CCVS-999999. NC2164.2 +222700 GO TO CLOSE-FILES. NC2164.2 diff --git a/tests/cobol85/NC/NC217A.CBL b/tests/cobol85/NC/NC217A.CBL new file mode 100755 index 00000000..b4d9559f --- /dev/null +++ b/tests/cobol85/NC/NC217A.CBL @@ -0,0 +1,2187 @@ +000100 IDENTIFICATION DIVISION. NC2174.2 +000200 PROGRAM-ID. NC2174.2 +000300 NC217A. NC2174.2 +000400**************************************************************** NC2174.2 +000500* * NC2174.2 +000600* VALIDATION FOR:- * NC2174.2 +000700* * NC2174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2174.2 +000900* * NC2174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2174.2 +001100* * NC2174.2 +001200**************************************************************** NC2174.2 +001300* * NC2174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2174.2 +001500* * NC2174.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2174.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2174.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2174.2 +001900* * NC2174.2 +002000**************************************************************** NC2174.2 +002100* * NC2174.2 +002200* PROGRAM NC217A TESTS THE USE OF THE "STRING" STATEMENT, * NC2174.2 +002300* INCLUDING THE OPTIONAL PHRASES "POINTER", "OVERFLOW", * NC2174.2 +002400* "NOT OVERFLOW" AND "END-STRING". * NC2174.2 +002500* * NC2174.2 +002600* * NC2174.2 +002700**************************************************************** NC2174.2 +002800 ENVIRONMENT DIVISION. NC2174.2 +002900 CONFIGURATION SECTION. NC2174.2 +003000 SOURCE-COMPUTER. NC2174.2 +003100 Linux. NC2174.2 +003200 OBJECT-COMPUTER. NC2174.2 +003300 Linux. NC2174.2 +003400 INPUT-OUTPUT SECTION. NC2174.2 +003500 FILE-CONTROL. NC2174.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2174.2 +003700 "report.log". NC2174.2 +003800 DATA DIVISION. NC2174.2 +003900 FILE SECTION. NC2174.2 +004000 FD PRINT-FILE. NC2174.2 +004100 01 PRINT-REC PICTURE X(120). NC2174.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2174.2 +004300 WORKING-STORAGE SECTION. NC2174.2 +004400 01 WRK-XN-00001-1 PIC X. NC2174.2 +004500 01 WRK-XN-00001-2 PIC X. NC2174.2 +004600 01 WRK-XN-00001-3 PIC X. NC2174.2 +004700 01 ID8-DU-2V0 PIC 99. NC2174.2 +004800 01 ISUB-DU-2V0 PIC 99. NC2174.2 +004900 01 MY-BOSS-DU-2V0 PIC 99 VALUE ZERO. NC2174.2 +005000 01 ID1-DS-LS-4 PIC S9(4) VALUE +1001 SIGN IS LEADING SEPARATE. NC2174.2 +005100 01 ID1-DS-TS-4 PIC S9(4) VALUE +1001 SIGN IS TRAILING SEPARATE. NC2174.2 +005200 01 ID1-XN-25 PIC X(25) VALUE NC2174.2 +005300 "A2345B2345C2345D2345E2345". NC2174.2 +005400 01 ID1-XN-X-25 REDEFINES ID1-XN-25. NC2174.2 +005500 10 ID1-1 PIC X OCCURS 5 TIMES. NC2174.2 +005600 10 ID1-2 PIC X OCCURS 5 TIMES. NC2174.2 +005700 10 ID1-3 PIC X OCCURS 5 TIMES. NC2174.2 +005800 10 ID1-4 PIC X OCCURS 5 TIMES. NC2174.2 +005900 10 ID1-5 PIC X OCCURS 5 TIMES. NC2174.2 +006000 01 ZEROX-XN-1 PIC X VALUE ZERO. NC2174.2 +006100 01 A-XN-1 PIC X VALUE "A". NC2174.2 +006200 01 B-XN-1 PIC X VALUE "B". NC2174.2 +006300 01 AB-XN-2 PIC XX VALUE "AB". NC2174.2 +006400 01 ID7-XN-5 PIC X(5). NC2174.2 +006500 01 ASTER-XN-5 PIC X(5) VALUE "*****". NC2174.2 +006600 01 ANS-XN-5-1. NC2174.2 +006700 10 FILLER PIC X VALUE LOW-VALUE. NC2174.2 +006800 10 FILLER PIC X(4) VALUE "ABCD". NC2174.2 +006900 01 ANS-XN-5-2. NC2174.2 +007000 10 FILLER PIC X VALUE HIGH-VALUE. NC2174.2 +007100 10 FILLER PIC X(4) VALUE "****". NC2174.2 +007200 01 DELIM-TABLE-XN-5 PIC X(5) VALUE "CDEFF". NC2174.2 +007300 01 DELIM-XN-X-1 REDEFINES DELIM-TABLE-XN-5. NC2174.2 +007400 10 ID3-XN-1 PIC X OCCURS 5 TIMES. NC2174.2 +007500 01 ABCDEFG-XN-7 PIC X(7) VALUE "ABCDEFG". NC2174.2 +007600 01 ID7-XN-15 PIC X(15) VALUE SPACES. NC2174.2 +007700 01 WISH-LIST-XN-37 PIC X(37) VALUE SPACES. NC2174.2 +007800 01 ANS-XN-37 PIC X(37) VALUE NC2174.2 +007900 "GEE I WISH I WAS A FORTRAN PROGRAMMER". NC2174.2 +008000 01 TEST-21-GROUP. NC2174.2 +008100 03 TEST-21-A PIC XX. NC2174.2 +008200 03 TEST-21-B PIC XX. NC2174.2 +008300 03 TEST-21-C PIC X. NC2174.2 +008400 NC2174.2 +008500 01 TEST-RESULTS. NC2174.2 +008600 02 FILLER PIC X VALUE SPACE. NC2174.2 +008700 02 FEATURE PIC X(20) VALUE SPACE. NC2174.2 +008800 02 FILLER PIC X VALUE SPACE. NC2174.2 +008900 02 P-OR-F PIC X(5) VALUE SPACE. NC2174.2 +009000 02 FILLER PIC X VALUE SPACE. NC2174.2 +009100 02 PAR-NAME. NC2174.2 +009200 03 FILLER PIC X(19) VALUE SPACE. NC2174.2 +009300 03 PARDOT-X PIC X VALUE SPACE. NC2174.2 +009400 03 DOTVALUE PIC 99 VALUE ZERO. NC2174.2 +009500 02 FILLER PIC X(8) VALUE SPACE. NC2174.2 +009600 02 RE-MARK PIC X(61). NC2174.2 +009700 01 TEST-COMPUTED. NC2174.2 +009800 02 FILLER PIC X(30) VALUE SPACE. NC2174.2 +009900 02 FILLER PIC X(17) VALUE NC2174.2 +010000 " COMPUTED=". NC2174.2 +010100 02 COMPUTED-X. NC2174.2 +010200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2174.2 +010300 03 COMPUTED-N REDEFINES COMPUTED-A NC2174.2 +010400 PIC -9(9).9(9). NC2174.2 +010500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2174.2 +010600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2174.2 +010700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2174.2 +010800 03 CM-18V0 REDEFINES COMPUTED-A. NC2174.2 +010900 04 COMPUTED-18V0 PIC -9(18). NC2174.2 +011000 04 FILLER PIC X. NC2174.2 +011100 03 FILLER PIC X(50) VALUE SPACE. NC2174.2 +011200 01 TEST-CORRECT. NC2174.2 +011300 02 FILLER PIC X(30) VALUE SPACE. NC2174.2 +011400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2174.2 +011500 02 CORRECT-X. NC2174.2 +011600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2174.2 +011700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2174.2 +011800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2174.2 +011900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2174.2 +012000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2174.2 +012100 03 CR-18V0 REDEFINES CORRECT-A. NC2174.2 +012200 04 CORRECT-18V0 PIC -9(18). NC2174.2 +012300 04 FILLER PIC X. NC2174.2 +012400 03 FILLER PIC X(2) VALUE SPACE. NC2174.2 +012500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2174.2 +012600 01 CCVS-C-1. NC2174.2 +012700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2174.2 +012800- "SS PARAGRAPH-NAME NC2174.2 +012900- " REMARKS". NC2174.2 +013000 02 FILLER PIC X(20) VALUE SPACE. NC2174.2 +013100 01 CCVS-C-2. NC2174.2 +013200 02 FILLER PIC X VALUE SPACE. NC2174.2 +013300 02 FILLER PIC X(6) VALUE "TESTED". NC2174.2 +013400 02 FILLER PIC X(15) VALUE SPACE. NC2174.2 +013500 02 FILLER PIC X(4) VALUE "FAIL". NC2174.2 +013600 02 FILLER PIC X(94) VALUE SPACE. NC2174.2 +013700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2174.2 +013800 01 REC-CT PIC 99 VALUE ZERO. NC2174.2 +013900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2174.2 +014000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2174.2 +014100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2174.2 +014200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2174.2 +014300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2174.2 +014400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2174.2 +014500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2174.2 +014600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2174.2 +014700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2174.2 +014800 01 CCVS-H-1. NC2174.2 +014900 02 FILLER PIC X(39) VALUE SPACES. NC2174.2 +015000 02 FILLER PIC X(42) VALUE NC2174.2 +015100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2174.2 +015200 02 FILLER PIC X(39) VALUE SPACES. NC2174.2 +015300 01 CCVS-H-2A. NC2174.2 +015400 02 FILLER PIC X(40) VALUE SPACE. NC2174.2 +015500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2174.2 +015600 02 FILLER PIC XXXX VALUE NC2174.2 +015700 "4.2 ". NC2174.2 +015800 02 FILLER PIC X(28) VALUE NC2174.2 +015900 " COPY - NOT FOR DISTRIBUTION". NC2174.2 +016000 02 FILLER PIC X(41) VALUE SPACE. NC2174.2 +016100 NC2174.2 +016200 01 CCVS-H-2B. NC2174.2 +016300 02 FILLER PIC X(15) VALUE NC2174.2 +016400 "TEST RESULT OF ". NC2174.2 +016500 02 TEST-ID PIC X(9). NC2174.2 +016600 02 FILLER PIC X(4) VALUE NC2174.2 +016700 " IN ". NC2174.2 +016800 02 FILLER PIC X(12) VALUE NC2174.2 +016900 " HIGH ". NC2174.2 +017000 02 FILLER PIC X(22) VALUE NC2174.2 +017100 " LEVEL VALIDATION FOR ". NC2174.2 +017200 02 FILLER PIC X(58) VALUE NC2174.2 +017300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2174.2 +017400 01 CCVS-H-3. NC2174.2 +017500 02 FILLER PIC X(34) VALUE NC2174.2 +017600 " FOR OFFICIAL USE ONLY ". NC2174.2 +017700 02 FILLER PIC X(58) VALUE NC2174.2 +017800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2174.2 +017900 02 FILLER PIC X(28) VALUE NC2174.2 +018000 " COPYRIGHT 1985 ". NC2174.2 +018100 01 CCVS-E-1. NC2174.2 +018200 02 FILLER PIC X(52) VALUE SPACE. NC2174.2 +018300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2174.2 +018400 02 ID-AGAIN PIC X(9). NC2174.2 +018500 02 FILLER PIC X(45) VALUE SPACES. NC2174.2 +018600 01 CCVS-E-2. NC2174.2 +018700 02 FILLER PIC X(31) VALUE SPACE. NC2174.2 +018800 02 FILLER PIC X(21) VALUE SPACE. NC2174.2 +018900 02 CCVS-E-2-2. NC2174.2 +019000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2174.2 +019100 03 FILLER PIC X VALUE SPACE. NC2174.2 +019200 03 ENDER-DESC PIC X(44) VALUE NC2174.2 +019300 "ERRORS ENCOUNTERED". NC2174.2 +019400 01 CCVS-E-3. NC2174.2 +019500 02 FILLER PIC X(22) VALUE NC2174.2 +019600 " FOR OFFICIAL USE ONLY". NC2174.2 +019700 02 FILLER PIC X(12) VALUE SPACE. NC2174.2 +019800 02 FILLER PIC X(58) VALUE NC2174.2 +019900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2174.2 +020000 02 FILLER PIC X(13) VALUE SPACE. NC2174.2 +020100 02 FILLER PIC X(15) VALUE NC2174.2 +020200 " COPYRIGHT 1985". NC2174.2 +020300 01 CCVS-E-4. NC2174.2 +020400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2174.2 +020500 02 FILLER PIC X(4) VALUE " OF ". NC2174.2 +020600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2174.2 +020700 02 FILLER PIC X(40) VALUE NC2174.2 +020800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2174.2 +020900 01 XXINFO. NC2174.2 +021000 02 FILLER PIC X(19) VALUE NC2174.2 +021100 "*** INFORMATION ***". NC2174.2 +021200 02 INFO-TEXT. NC2174.2 +021300 04 FILLER PIC X(8) VALUE SPACE. NC2174.2 +021400 04 XXCOMPUTED PIC X(20). NC2174.2 +021500 04 FILLER PIC X(5) VALUE SPACE. NC2174.2 +021600 04 XXCORRECT PIC X(20). NC2174.2 +021700 02 INF-ANSI-REFERENCE PIC X(48). NC2174.2 +021800 01 HYPHEN-LINE. NC2174.2 +021900 02 FILLER PIC IS X VALUE IS SPACE. NC2174.2 +022000 02 FILLER PIC IS X(65) VALUE IS "************************NC2174.2 +022100- "*****************************************". NC2174.2 +022200 02 FILLER PIC IS X(54) VALUE IS "************************NC2174.2 +022300- "******************************". NC2174.2 +022400 01 CCVS-PGM-ID PIC X(9) VALUE NC2174.2 +022500 "NC217A". NC2174.2 +022600 PROCEDURE DIVISION. NC2174.2 +022700 CCVS1 SECTION. NC2174.2 +022800 OPEN-FILES. NC2174.2 +022900 OPEN OUTPUT PRINT-FILE. NC2174.2 +023000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2174.2 +023100 MOVE SPACE TO TEST-RESULTS. NC2174.2 +023200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2174.2 +023300 GO TO CCVS1-EXIT. NC2174.2 +023400 CLOSE-FILES. NC2174.2 +023500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2174.2 +023600 TERMINATE-CCVS. NC2174.2 +023700*S EXIT PROGRAM. NC2174.2 +023800*SERMINATE-CALL. NC2174.2 +023900 STOP RUN. NC2174.2 +024000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2174.2 +024100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2174.2 +024200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2174.2 +024300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2174.2 +024400 MOVE "****TEST DELETED****" TO RE-MARK. NC2174.2 +024500 PRINT-DETAIL. NC2174.2 +024600 IF REC-CT NOT EQUAL TO ZERO NC2174.2 +024700 MOVE "." TO PARDOT-X NC2174.2 +024800 MOVE REC-CT TO DOTVALUE. NC2174.2 +024900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2174.2 +025000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2174.2 +025100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2174.2 +025200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2174.2 +025300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2174.2 +025400 MOVE SPACE TO CORRECT-X. NC2174.2 +025500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2174.2 +025600 MOVE SPACE TO RE-MARK. NC2174.2 +025700 HEAD-ROUTINE. NC2174.2 +025800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +025900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +026000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2174.2 +026100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2174.2 +026200 COLUMN-NAMES-ROUTINE. NC2174.2 +026300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +026400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +026500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +026600 END-ROUTINE. NC2174.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2174.2 +026800 END-RTN-EXIT. NC2174.2 +026900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +027000 END-ROUTINE-1. NC2174.2 +027100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2174.2 +027200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2174.2 +027300 ADD PASS-COUNTER TO ERROR-HOLD. NC2174.2 +027400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2174.2 +027500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2174.2 +027600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2174.2 +027700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2174.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2174.2 +027900 END-ROUTINE-12. NC2174.2 +028000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2174.2 +028100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2174.2 +028200 MOVE "NO " TO ERROR-TOTAL NC2174.2 +028300 ELSE NC2174.2 +028400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2174.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2174.2 +028600 PERFORM WRITE-LINE. NC2174.2 +028700 END-ROUTINE-13. NC2174.2 +028800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2174.2 +028900 MOVE "NO " TO ERROR-TOTAL ELSE NC2174.2 +029000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2174.2 +029100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2174.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +029300 IF INSPECT-COUNTER EQUAL TO ZERO NC2174.2 +029400 MOVE "NO " TO ERROR-TOTAL NC2174.2 +029500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2174.2 +029600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2174.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +029800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2174.2 +029900 WRITE-LINE. NC2174.2 +030000 ADD 1 TO RECORD-COUNT. NC2174.2 +030100 IF RECORD-COUNT GREATER 50 NC2174.2 +030200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2174.2 +030300 MOVE SPACE TO DUMMY-RECORD NC2174.2 +030400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2174.2 +030500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2174.2 +030600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2174.2 +030700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2174.2 +030800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2174.2 +030900 MOVE ZERO TO RECORD-COUNT. NC2174.2 +031000 PERFORM WRT-LN. NC2174.2 +031100 WRT-LN. NC2174.2 +031200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2174.2 +031300 MOVE SPACE TO DUMMY-RECORD. NC2174.2 +031400 BLANK-LINE-PRINT. NC2174.2 +031500 PERFORM WRT-LN. NC2174.2 +031600 FAIL-ROUTINE. NC2174.2 +031700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2174.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2174.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2174.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2174.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2174.2 +032300 GO TO FAIL-ROUTINE-EX. NC2174.2 +032400 FAIL-ROUTINE-WRITE. NC2174.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2174.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2174.2 +032700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2174.2 +032800 MOVE SPACES TO COR-ANSI-REFERENCE. NC2174.2 +032900 FAIL-ROUTINE-EX. EXIT. NC2174.2 +033000 BAIL-OUT. NC2174.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2174.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2174.2 +033300 BAIL-OUT-WRITE. NC2174.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2174.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2174.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2174.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2174.2 +033800 BAIL-OUT-EX. EXIT. NC2174.2 +033900 CCVS1-EXIT. NC2174.2 +034000 EXIT. NC2174.2 +034100 SECT-NC217A-001 SECTION. NC2174.2 +034200 STR-INIT-GF-1. NC2174.2 +034300 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +034400 MOVE "STR-TEST-GF-1" TO PAR-NAME. NC2174.2 +034500 MOVE "LIT DEL BY SIZE" TO FEATURE. NC2174.2 +034600 MOVE "*****" TO ID7-XN-5. NC2174.2 +034700 MOVE 1 TO ID8-DU-2V0. NC2174.2 +034800 MOVE 1 TO REC-CT. NC2174.2 +034900 STR-TEST-GF-1. NC2174.2 +035000 STRING "ABCDEF" DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +035100 WITH POINTER ID8-DU-2V0. NC2174.2 +035200 GO TO STR-TEST-GF-1-1. NC2174.2 +035300 STR-DELETE-GF-1. NC2174.2 +035400 PERFORM DE-LETE. NC2174.2 +035500 PERFORM PRINT-DETAIL. NC2174.2 +035600 GO TO STR-INIT-GF-2. NC2174.2 +035700 STR-TEST-GF-1-1. NC2174.2 +035800 IF ID7-XN-5 = "ABCDE" NC2174.2 +035900 PERFORM PASS NC2174.2 +036000 GO TO STR-WRITE-GF-1-1 NC2174.2 +036100 ELSE NC2174.2 +036200 GO TO STR-FAIL-GF-1-1. NC2174.2 +036300 STR-DELETE-GF-1-1. NC2174.2 +036400 PERFORM DE-LETE. NC2174.2 +036500 GO TO STR-WRITE-GF-1-1. NC2174.2 +036600 STR-FAIL-GF-1-1. NC2174.2 +036700 PERFORM FAIL NC2174.2 +036800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +036900 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +037000 STR-WRITE-GF-1-1. NC2174.2 +037100 PERFORM PRINT-DETAIL. NC2174.2 +037200* NC2174.2 +037300 STR-TEST-GF-1-2. NC2174.2 +037400 ADD 1 TO REC-CT. NC2174.2 +037500 IF ID8-DU-2V0 = 6 NC2174.2 +037600 PERFORM PASS NC2174.2 +037700 GO TO STR-WRITE-GF-1-2 NC2174.2 +037800 ELSE NC2174.2 +037900 GO TO STR-FAIL-GF-1-2. NC2174.2 +038000 STR-DELETE-GF-1-2. NC2174.2 +038100 PERFORM DE-LETE. NC2174.2 +038200 GO TO STR-WRITE-GF-1-2. NC2174.2 +038300 STR-FAIL-GF-1-2. NC2174.2 +038400 PERFORM FAIL NC2174.2 +038500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +038600 MOVE 6 TO CORRECT-N. NC2174.2 +038700 STR-WRITE-GF-1-2. NC2174.2 +038800 PERFORM PRINT-DETAIL. NC2174.2 +038900* NC2174.2 +039000 STR-INIT-GF-2. NC2174.2 +039100 MOVE "STR-TEST-GF-2" TO PAR-NAME. NC2174.2 +039200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +039300 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +039400 MOVE "*****" TO ID7-XN-5. NC2174.2 +039500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +039600 MOVE 1 TO REC-CT. NC2174.2 +039700 STR-TEST-GF-2-0. NC2174.2 +039800 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +039900 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +040000 ON OVERFLOW PERFORM PASS NC2174.2 +040100 GO TO STR-WRITE-GF-2-1. NC2174.2 +040200 GO TO STR-FAIL-GF-2-1. NC2174.2 +040300 STR-DELETE-GF-2. NC2174.2 +040400 PERFORM DE-LETE. NC2174.2 +040500 PERFORM PRINT-DETAIL. NC2174.2 +040600 GO TO STR-INIT-GF-3. NC2174.2 +040700 STR-TEST-GF-2-1. NC2174.2 +040800* THIS IS THE BLOCK TO WHICH CONTROL WILL BE SENT BY NC2174.2 +040900* PARAGRAPH "STR-TEST-GF-2-0". NC2174.2 +041000 STR-DELETE-GF-2-1. NC2174.2 +041100* GO TO STR-DELETE-GF-2. NC2174.2 +041200 STR-FAIL-GF-2-1. NC2174.2 +041300 PERFORM FAIL. NC2174.2 +041400 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2174.2 +041500 STR-WRITE-GF-2-1. NC2174.2 +041600 PERFORM PRINT-DETAIL. NC2174.2 +041700* NC2174.2 +041800 STR-TEST-GF-2-2. NC2174.2 +041900 ADD 1 TO REC-CT. NC2174.2 +042000 IF ID7-XN-5 = "ABCDE" NC2174.2 +042100 PERFORM PASS NC2174.2 +042200 GO TO STR-WRITE-GF-2-2 NC2174.2 +042300 ELSE NC2174.2 +042400 GO TO STR-FAIL-GF-2-2. NC2174.2 +042500 STR-DELETE-GF-2-2. NC2174.2 +042600 PERFORM DE-LETE. NC2174.2 +042700 GO TO STR-WRITE-GF-2-2. NC2174.2 +042800 STR-FAIL-GF-2-2. NC2174.2 +042900 PERFORM FAIL NC2174.2 +043000 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +043100 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +043200 STR-WRITE-GF-2-2. NC2174.2 +043300 PERFORM PRINT-DETAIL. NC2174.2 +043400* NC2174.2 +043500 STR-TEST-GF-2-3. NC2174.2 +043600 ADD 1 TO REC-CT. NC2174.2 +043700 IF ID8-DU-2V0 = 6 NC2174.2 +043800 PERFORM PASS NC2174.2 +043900 GO TO STR-WRITE-GF-2-3 NC2174.2 +044000 ELSE NC2174.2 +044100 GO TO STR-FAIL-GF-2-3. NC2174.2 +044200 STR-DELETE-GF-2-3. NC2174.2 +044300 PERFORM DE-LETE. NC2174.2 +044400 GO TO STR-WRITE-GF-2-3. NC2174.2 +044500 STR-FAIL-GF-2-3. NC2174.2 +044600 PERFORM FAIL NC2174.2 +044700 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +044800 MOVE 6 TO CORRECT-N. NC2174.2 +044900 STR-WRITE-GF-2-3. NC2174.2 +045000 PERFORM PRINT-DETAIL. NC2174.2 +045100* NC2174.2 +045200 STR-INIT-GF-3. NC2174.2 +045300 MOVE "STR-TEST-GF-3" TO PAR-NAME. NC2174.2 +045400 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +045500 MOVE "ID DEL BY QUAL ID" TO FEATURE. NC2174.2 +045600 MOVE "*****" TO ID7-XN-5. NC2174.2 +045700 MOVE 1 TO ID8-DU-2V0. NC2174.2 +045800 MOVE 5 TO ISUB-DU-2V0. NC2174.2 +045900 MOVE 1 TO REC-CT. NC2174.2 +046000* NC2174.2 +046100 STR-TEST-GF-3. NC2174.2 +046200 STRING ABCDEFG-XN-7 DELIMITED BY ID3-XN-1 (ISUB-DU-2V0) NC2174.2 +046300 INTO ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +046400 GO TO STR-TEST-GF-3-1. NC2174.2 +046500 STR-DELETE-GF-3. NC2174.2 +046600 PERFORM DE-LETE. NC2174.2 +046700 PERFORM PRINT-DETAIL. NC2174.2 +046800 GO TO STRING-INIT-4. NC2174.2 +046900* NC2174.2 +047000 STR-TEST-GF-3-1. NC2174.2 +047100 IF ID7-XN-5 = "ABCDE" NC2174.2 +047200 PERFORM PASS NC2174.2 +047300 GO TO STR-WRITE-GF-3-1 NC2174.2 +047400 ELSE NC2174.2 +047500 GO TO STR-FAIL-GF-3-1. NC2174.2 +047600 STR-DELETE-GF-3-1. NC2174.2 +047700 PERFORM DE-LETE. NC2174.2 +047800 GO TO STR-WRITE-GF-3-1. NC2174.2 +047900 STR-FAIL-GF-3-1. NC2174.2 +048000 PERFORM FAIL NC2174.2 +048100 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +048200 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +048300 STR-WRITE-GF-3-1. NC2174.2 +048400 PERFORM PRINT-DETAIL. NC2174.2 +048500* NC2174.2 +048600 STR-TEST-GF-3-2. NC2174.2 +048700 ADD 1 TO REC-CT. NC2174.2 +048800 IF ID8-DU-2V0 = 6 NC2174.2 +048900 PERFORM PASS NC2174.2 +049000 GO TO STR-WRITE-GF-3-2 NC2174.2 +049100 ELSE NC2174.2 +049200 GO TO STR-FAIL-GF-3-2. NC2174.2 +049300 STR-DELETE-GF-3-2. NC2174.2 +049400 PERFORM DE-LETE. NC2174.2 +049500 GO TO STR-WRITE-GF-3-2. NC2174.2 +049600 STR-FAIL-GF-3-2. NC2174.2 +049700 PERFORM FAIL NC2174.2 +049800 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +049900 MOVE 6 TO CORRECT-N. NC2174.2 +050000 STR-WRITE-GF-3-2. NC2174.2 +050100 PERFORM PRINT-DETAIL. NC2174.2 +050200* NC2174.2 +050300 STRING-INIT-4. NC2174.2 +050400 MOVE "STR-TEST-GF-4" TO PAR-NAME. NC2174.2 +050500 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +050600 MOVE "SUBSCRIPTED IDS" TO FEATURE. NC2174.2 +050700 MOVE "*****" TO ID7-XN-5. NC2174.2 +050800 MOVE 1 TO ID8-DU-2V0. NC2174.2 +050900 MOVE ZERO TO REC-CT. NC2174.2 +051000 MOVE "**** " TO P-OR-F. NC2174.2 +051100* NC2174.2 +051200 STRING-TEST-4. NC2174.2 +051300* STRING ID1-1 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051400* ID1-2 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051500* ID1-3 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051600* ID1-4 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051700* ID1-5 OF ID1-XN-X-25 (ID8-DU-2V0) NC2174.2 +051800* DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +051900* POINTER ID8-DU-2V0. NC2174.2 +052000* GO TO STRING-TEST-4-1. NC2174.2 +052100 STRING-DELETE-4. NC2174.2 +052200 PERFORM DE-LETE. NC2174.2 +052300 MOVE "*DELETED - ANSC INTERPRETATION*" TO RE-MARK. NC2174.2 +052400 PERFORM PRINT-DETAIL. NC2174.2 +052500 GO TO STR-INIT-GF-5. NC2174.2 +052600 STRING-TEST-4-1. NC2174.2 +052700 IF ID7-XN-5 = "ABCDE" NC2174.2 +052800 PERFORM PASS NC2174.2 +052900 PERFORM PRINT-DETAIL NC2174.2 +053000 ELSE NC2174.2 +053100 PERFORM FAIL NC2174.2 +053200 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +053300 MOVE "ABCDE" TO CORRECT-A NC2174.2 +053400 PERFORM PRINT-DETAIL. NC2174.2 +053500 ADD 1 TO REC-CT. NC2174.2 +053600 STRING-TEST-4-2. NC2174.2 +053700 IF ID8-DU-2V0 = 6 NC2174.2 +053800 PERFORM PASS NC2174.2 +053900 PERFORM PRINT-DETAIL NC2174.2 +054000 ELSE NC2174.2 +054100 PERFORM FAIL NC2174.2 +054200 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +054300 MOVE 6 TO CORRECT-N NC2174.2 +054400 PERFORM PRINT-DETAIL. NC2174.2 +054500* NC2174.2 +054600 STR-INIT-GF-5. NC2174.2 +054700 MOVE "STR-TEST-GF-5" TO PAR-NAME. NC2174.2 +054800 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +054900 MOVE "IMMEDIATE OVERFLOW" TO FEATURE. NC2174.2 +055000 MOVE "*****" TO ID7-XN-5. NC2174.2 +055100 MOVE "*****" TO ASTER-XN-5. NC2174.2 +055200* NOTE THAT THE POINTER IS SET TO A VALUE GREATER THAN NC2174.2 +055300* THE LENGTH OF THE RECEIVING ITEM ID7-XN-5.......... NC2174.2 +055400 MOVE 7 TO ID8-DU-2V0. NC2174.2 +055500 MOVE 1 TO REC-CT. NC2174.2 +055600* NC2174.2 +055700 STR-TEST-GF-5-1. NC2174.2 +055800 STRING "ABCDE" DELIMITED BY ABCDEFG-XN-7 INTO ID7-XN-5 NC2174.2 +055900 POINTER ID8-DU-2V0 NC2174.2 +056000 ON OVERFLOW PERFORM PASS NC2174.2 +056100 GO TO STR-WRITE-GF-5-1. NC2174.2 +056200 GO TO STR-FAIL-GF-5-1. NC2174.2 +056300 STR-DELETE-GF-5-1. NC2174.2 +056400 PERFORM DE-LETE. NC2174.2 +056500 PERFORM PRINT-DETAIL. NC2174.2 +056600 GO TO STR-INIT-GF-6. NC2174.2 +056700 STR-FAIL-GF-5-1. NC2174.2 +056800 PERFORM FAIL. NC2174.2 +056900 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2174.2 +057000 STR-WRITE-GF-5-1. NC2174.2 +057100 PERFORM PRINT-DETAIL. NC2174.2 +057200* NC2174.2 +057300 STR-TEST-GF-5-2. NC2174.2 +057400 ADD 1 TO REC-CT. NC2174.2 +057500 IF ID7-XN-5 = ASTER-XN-5 NC2174.2 +057600 PERFORM PASS NC2174.2 +057700 GO TO STR-WRITE-GF-5-2 NC2174.2 +057800 ELSE NC2174.2 +057900 GO TO STR-FAIL-GF-5-2. NC2174.2 +058000 STR-DELETE-GF-5-2. NC2174.2 +058100 PERFORM DE-LETE. NC2174.2 +058200 GO TO STR-WRITE-GF-5-2. NC2174.2 +058300 STR-FAIL-GF-5-2. NC2174.2 +058400 PERFORM FAIL NC2174.2 +058500 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +058600 MOVE "*****" TO CORRECT-A. NC2174.2 +058700 STR-WRITE-GF-5-2. NC2174.2 +058800 PERFORM PRINT-DETAIL. NC2174.2 +058900* NC2174.2 +059000 STR-TEST-GF-5-3. NC2174.2 +059100 ADD 1 TO REC-CT. NC2174.2 +059200 IF ID8-DU-2V0 = 7 NC2174.2 +059300 PERFORM PASS NC2174.2 +059400 GO TO STR-WRITE-GF-5-3 NC2174.2 +059500 ELSE NC2174.2 +059600 GO TO STR-FAIL-GF-5-3. NC2174.2 +059700 STR-DELETE-GF-5-3. NC2174.2 +059800 PERFORM DE-LETE. NC2174.2 +059900 GO TO STR-WRITE-GF-5-3. NC2174.2 +060000 STR-FAIL-GF-5-3. NC2174.2 +060100 PERFORM FAIL NC2174.2 +060200 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +060300 MOVE 7 TO CORRECT-N. NC2174.2 +060400 STR-WRITE-GF-5-3. NC2174.2 +060500 PERFORM PRINT-DETAIL. NC2174.2 +060600* NC2174.2 +060700 STR-INIT-GF-6. NC2174.2 +060800 MOVE "STR-TEST-GF-6" TO PAR-NAME. NC2174.2 +060900 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +061000 MOVE "SPACE LIT OVERFLOWS" TO FEATURE. NC2174.2 +061100 MOVE "*****" TO ID7-XN-5. NC2174.2 +061200 MOVE 1 TO ID8-DU-2V0. NC2174.2 +061300 MOVE 1 TO REC-CT. NC2174.2 +061400* NC2174.2 +061500 STR-TEST-GF-6-1. NC2174.2 +061600 STRING SPACE "ABCDE" DELIMITED BY " ABCDE" NC2174.2 +061700 INTO ID7-XN-5 OVERFLOW PERFORM PASS NC2174.2 +061800 GO TO STR-WRITE-GF-6-1. NC2174.2 +061900 GO TO STR-FAIL-GF-6-1. NC2174.2 +062000 STR-DELETE-GF-6-1. NC2174.2 +062100 PERFORM DE-LETE. NC2174.2 +062200 PERFORM PRINT-DETAIL. NC2174.2 +062300 GO TO STR-INIT-GF-7. NC2174.2 +062400 STR-FAIL-GF-6-1. NC2174.2 +062500 PERFORM FAIL. NC2174.2 +062600 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2174.2 +062700 STR-WRITE-GF-6-1. NC2174.2 +062800 PERFORM PRINT-DETAIL. NC2174.2 +062900* NC2174.2 +063000 STR-TEST-GF-6-2. NC2174.2 +063100 ADD 1 TO REC-CT. NC2174.2 +063200 IF ID7-XN-5 = " ABCD" NC2174.2 +063300 PERFORM PASS NC2174.2 +063400 GO TO STR-WRITE-GF-6-2 NC2174.2 +063500 ELSE NC2174.2 +063600 GO TO STR-FAIL-GF-6-2. NC2174.2 +063700 STR-DELETE-GF-6-2. NC2174.2 +063800 PERFORM DE-LETE. NC2174.2 +063900 GO TO STR-WRITE-GF-6-2. NC2174.2 +064000 STR-FAIL-GF-6-2. NC2174.2 +064100 PERFORM FAIL NC2174.2 +064200 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +064300 MOVE " ABCD" TO CORRECT-A. NC2174.2 +064400 STR-WRITE-GF-6-2. NC2174.2 +064500 PERFORM PRINT-DETAIL. NC2174.2 +064600* NC2174.2 +064700 STR-INIT-GF-7. NC2174.2 +064800 MOVE "STR-TEST-GF-7" TO PAR-NAME. NC2174.2 +064900 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +065000 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +065100 MOVE "*****" TO ID7-XN-5. NC2174.2 +065200 MOVE 1 TO ID8-DU-2V0. NC2174.2 +065300 MOVE 1 TO REC-CT. NC2174.2 +065400* NC2174.2 +065500 STR-TEST-GF-7-1. NC2174.2 +065600 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +065700 POINTER ID8-DU-2V0 OVERFLOW GO TO STR-FAIL-GF-7-1. NC2174.2 +065800 PERFORM PASS. NC2174.2 +065900 GO TO STR-WRITE-GF-7-1. NC2174.2 +066000 STR-DELETE-GF-7-1. NC2174.2 +066100 PERFORM DE-LETE. NC2174.2 +066200 PERFORM PRINT-DETAIL. NC2174.2 +066300 GO TO STR-INIT-GF-8. NC2174.2 +066400 STR-FAIL-GF-7-1. NC2174.2 +066500 PERFORM FAIL. NC2174.2 +066600 MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +066700 STR-WRITE-GF-7-1. NC2174.2 +066800 PERFORM PRINT-DETAIL. NC2174.2 +066900* NC2174.2 +067000 STR-TEST-GF-7-2. NC2174.2 +067100 ADD 1 TO REC-CT. NC2174.2 +067200 IF ID7-XN-5 = "ABCDE" NC2174.2 +067300 PERFORM PASS NC2174.2 +067400 GO TO STR-WRITE-GF-7-2 NC2174.2 +067500 ELSE NC2174.2 +067600 GO TO STR-FAIL-GF-7-2. NC2174.2 +067700 STR-DELETE-GF-7-2. NC2174.2 +067800 PERFORM DE-LETE. NC2174.2 +067900 GO TO STR-WRITE-GF-7-2. NC2174.2 +068000 STR-FAIL-GF-7-2. NC2174.2 +068100 PERFORM FAIL NC2174.2 +068200 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +068300 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +068400 STR-WRITE-GF-7-2. NC2174.2 +068500 PERFORM PRINT-DETAIL. NC2174.2 +068600* NC2174.2 +068700 STR-TEST-GF-7-3. NC2174.2 +068800 ADD 1 TO REC-CT. NC2174.2 +068900 IF ID8-DU-2V0 = 6 NC2174.2 +069000 PERFORM PASS NC2174.2 +069100 GO TO STR-WRITE-GF-7-3 NC2174.2 +069200 ELSE NC2174.2 +069300 GO TO STR-FAIL-GF-7-3. NC2174.2 +069400 STR-DELETE-GF-7-3. NC2174.2 +069500 PERFORM DE-LETE. NC2174.2 +069600 GO TO STR-WRITE-GF-7-3. NC2174.2 +069700 STR-FAIL-GF-7-3. NC2174.2 +069800 PERFORM FAIL NC2174.2 +069900 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +070000 MOVE 6 TO CORRECT-N. NC2174.2 +070100 STR-WRITE-GF-7-3. NC2174.2 +070200 PERFORM PRINT-DETAIL. NC2174.2 +070300* NC2174.2 +070400 STR-INIT-GF-8. NC2174.2 +070500 MOVE "STR-TEST-GF-8" TO PAR-NAME. NC2174.2 +070600 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +070700 MOVE "LOW-VALUE OVERFLOW" TO FEATURE. NC2174.2 +070800 MOVE "*****" TO ID7-XN-5. NC2174.2 +070900 MOVE 1 TO ID8-DU-2V0. NC2174.2 +071000 MOVE 1 TO REC-CT. NC2174.2 +071100* NC2174.2 +071200 STR-TEST-GF-8-1. NC2174.2 +071300 STRING LOW-VALUE "ABCDE" DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +071400 WITH POINTER ID8-DU-2V0 NC2174.2 +071500 ON OVERFLOW PERFORM PASS NC2174.2 +071600 GO TO STR-WRITE-GF-8-1. NC2174.2 +071700 GO TO STR-FAIL-GF-8-1. NC2174.2 +071800 STR-DELETE-GF-8-1. NC2174.2 +071900 PERFORM DE-LETE. NC2174.2 +072000 PERFORM PRINT-DETAIL. NC2174.2 +072100 GO TO STR-INIT-GF-9. NC2174.2 +072200 STR-FAIL-GF-8-1. NC2174.2 +072300 PERFORM FAIL. NC2174.2 +072400 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2174.2 +072500 STR-WRITE-GF-8-1. NC2174.2 +072600 PERFORM PRINT-DETAIL. NC2174.2 +072700* NC2174.2 +072800 STR-TEST-GF-8-2. NC2174.2 +072900 ADD 1 TO REC-CT. NC2174.2 +073000 IF ID7-XN-5 = ANS-XN-5-1 NC2174.2 +073100 PERFORM PASS NC2174.2 +073200 GO TO STR-WRITE-GF-8-2 NC2174.2 +073300 ELSE NC2174.2 +073400 GO TO STR-FAIL-GF-8-2. NC2174.2 +073500 STR-DELETE-GF-8-2. NC2174.2 +073600 PERFORM DE-LETE. NC2174.2 +073700 GO TO STR-WRITE-GF-8-2. NC2174.2 +073800 STR-FAIL-GF-8-2. NC2174.2 +073900 PERFORM FAIL NC2174.2 +074000 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +074100 MOVE ANS-XN-5-1 TO CORRECT-A. NC2174.2 +074200 STR-WRITE-GF-8-2. NC2174.2 +074300 PERFORM PRINT-DETAIL. NC2174.2 +074400* NC2174.2 +074500 STR-TEST-GF-8-3. NC2174.2 +074600 ADD 1 TO REC-CT. NC2174.2 +074700 IF ID8-DU-2V0 = 6 NC2174.2 +074800 PERFORM PASS NC2174.2 +074900 GO TO STR-WRITE-GF-8-3 NC2174.2 +075000 ELSE NC2174.2 +075100 GO TO STR-FAIL-GF-8-3. NC2174.2 +075200 STR-DELETE-GF-8-3. NC2174.2 +075300 PERFORM DE-LETE. NC2174.2 +075400 GO TO STR-WRITE-GF-8-3. NC2174.2 +075500 STR-FAIL-GF-8-3. NC2174.2 +075600 PERFORM FAIL NC2174.2 +075700 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +075800 MOVE 6 TO CORRECT-N. NC2174.2 +075900 STR-WRITE-GF-8-3. NC2174.2 +076000 PERFORM PRINT-DETAIL. NC2174.2 +076100* NC2174.2 +076200 STR-INIT-GF-9. NC2174.2 +076300 MOVE "STR-TEST-GF-9" TO PAR-NAME. NC2174.2 +076400 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +076500 MOVE "HIGH-VALUE DEL SIZE" TO FEATURE. NC2174.2 +076600 MOVE "*****" TO ID7-XN-5. NC2174.2 +076700 MOVE 1 TO ID8-DU-2V0. NC2174.2 +076800 MOVE 1 TO REC-CT. NC2174.2 +076900* NC2174.2 +077000 STR-TEST-GF-9-1. NC2174.2 +077100 STRING HIGH-VALUE DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +077200 POINTER ID8-DU-2V0 NC2174.2 +077300 OVERFLOW GO TO STR-FAIL-GF-9-1. NC2174.2 +077400 PERFORM PASS. NC2174.2 +077500 GO TO STR-WRITE-GF-9-1. NC2174.2 +077600 STR-DELETE-GF-9-1. NC2174.2 +077700 PERFORM DE-LETE. NC2174.2 +077800 PERFORM PRINT-DETAIL. NC2174.2 +077900 GO TO STR-INIT-GF-10. NC2174.2 +078000 STR-FAIL-GF-9-1. NC2174.2 +078100 PERFORM FAIL. NC2174.2 +078200 MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +078300 STR-WRITE-GF-9-1. NC2174.2 +078400 PERFORM PRINT-DETAIL. NC2174.2 +078500* NC2174.2 +078600 STR-TEST-GF-9-2. NC2174.2 +078700 ADD 1 TO REC-CT. NC2174.2 +078800 IF ID7-XN-5 = ANS-XN-5-2 NC2174.2 +078900 PERFORM PASS NC2174.2 +079000 GO TO STR-WRITE-GF-9-2 NC2174.2 +079100 ELSE NC2174.2 +079200 GO TO STR-FAIL-GF-9-2. NC2174.2 +079300 STR-DELETE-GF-9-2. NC2174.2 +079400 PERFORM DE-LETE. NC2174.2 +079500 GO TO STR-WRITE-GF-9-2. NC2174.2 +079600 STR-FAIL-GF-9-2. NC2174.2 +079700 PERFORM FAIL NC2174.2 +079800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +079900 MOVE ANS-XN-5-2 TO CORRECT-A. NC2174.2 +080000 STR-WRITE-GF-9-2. NC2174.2 +080100 PERFORM PRINT-DETAIL. NC2174.2 +080200* NC2174.2 +080300 STR-TEST-GF-9-3. NC2174.2 +080400 ADD 1 TO REC-CT. NC2174.2 +080500 IF ID8-DU-2V0 = 2 NC2174.2 +080600 PERFORM PASS NC2174.2 +080700 GO TO STR-WRITE-GF-9-3 NC2174.2 +080800 ELSE NC2174.2 +080900 GO TO STR-FAIL-GF-9-3. NC2174.2 +081000 STR-DELETE-GF-9-3. NC2174.2 +081100 PERFORM DE-LETE. NC2174.2 +081200 GO TO STR-WRITE-GF-9-3. NC2174.2 +081300 STR-FAIL-GF-9-3. NC2174.2 +081400 PERFORM FAIL NC2174.2 +081500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +081600 MOVE 2 TO CORRECT-N. NC2174.2 +081700 STR-WRITE-GF-9-3. NC2174.2 +081800 PERFORM PRINT-DETAIL. NC2174.2 +081900* NC2174.2 +082000 STR-INIT-GF-10. NC2174.2 +082100 MOVE "STR-TEST-GF-10" TO PAR-NAME. NC2174.2 +082200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +082300 MOVE "LIT DEL ZERO" TO FEATURE. NC2174.2 +082400 MOVE "*****" TO ID7-XN-5. NC2174.2 +082500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +082600 MOVE 1 TO REC-CT. NC2174.2 +082700* NC2174.2 +082800 STR-TEST-GF-10-0. NC2174.2 +082900 STRING "A0" "B0D" "C0LKJSD" "D0321" "E0987LKJALKJKLLKJSD" NC2174.2 +083000 DELIMITED BY ZERO INTO ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +083100 GO TO STR-TEST-GF-10-1. NC2174.2 +083200 STR-DELETE-GF-10. NC2174.2 +083300 PERFORM DE-LETE. NC2174.2 +083400 PERFORM PRINT-DETAIL. NC2174.2 +083500 GO TO STR-INIT-GF-11. NC2174.2 +083600* NC2174.2 +083700 STR-TEST-GF-10-1. NC2174.2 +083800 IF ID7-XN-5 = "ABCDE" NC2174.2 +083900 PERFORM PASS NC2174.2 +084000 GO TO STR-WRITE-GF-10-1 NC2174.2 +084100 ELSE NC2174.2 +084200 GO TO STR-FAIL-GF-10-1. NC2174.2 +084300 STR-DELETE-GF-10-1. NC2174.2 +084400 PERFORM DE-LETE. NC2174.2 +084500 GO TO STR-WRITE-GF-10-1. NC2174.2 +084600 STR-FAIL-GF-10-1. NC2174.2 +084700 PERFORM FAIL NC2174.2 +084800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +084900 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +085000 STR-WRITE-GF-10-1. NC2174.2 +085100 PERFORM PRINT-DETAIL. NC2174.2 +085200* NC2174.2 +085300 STR-TEST-GF-10-2. NC2174.2 +085400 ADD 1 TO REC-CT. NC2174.2 +085500 IF ID8-DU-2V0 = 6 NC2174.2 +085600 PERFORM PASS NC2174.2 +085700 GO TO STR-WRITE-GF-10-2 NC2174.2 +085800 ELSE NC2174.2 +085900 GO TO STR-FAIL-GF-10-2. NC2174.2 +086000 STR-DELETE-GF-10-2. NC2174.2 +086100 PERFORM DE-LETE. NC2174.2 +086200 GO TO STR-WRITE-GF-10-2. NC2174.2 +086300 STR-FAIL-GF-10-2. NC2174.2 +086400 PERFORM FAIL NC2174.2 +086500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +086600 MOVE 6 TO CORRECT-N. NC2174.2 +086700 STR-WRITE-GF-10-2. NC2174.2 +086800 PERFORM PRINT-DETAIL. NC2174.2 +086900* NC2174.2 +087000 STR-INIT-GF-11. NC2174.2 +087100 MOVE "STR-TEST-GF-11" TO PAR-NAME. NC2174.2 +087200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +087300 MOVE "LIT DEL BY QUOTE" TO FEATURE. NC2174.2 +087400 MOVE "*****" TO ID7-XN-5. NC2174.2 +087500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +087600 MOVE 1 TO REC-CT. NC2174.2 +087700* NC2174.2 +087800 STR-TEST-GF-11. NC2174.2 +087900 STRING "A""" "B""KJHSF" "C""321654987LLKJHAF" "D""=,l." NC2174.2 +088000 "E""********" DELIMITED BY QUOTE INTO ID7-XN-5 NC2174.2 +088100 POINTER ID8-DU-2V0. NC2174.2 +088200 GO TO STR-TEST-GF-11-1. NC2174.2 +088300 STR-DELETE-GF-11-0. NC2174.2 +088400 PERFORM DE-LETE. NC2174.2 +088500 PERFORM PRINT-DETAIL. NC2174.2 +088600 GO TO STR-INIT-GF-12. NC2174.2 +088700* NC2174.2 +088800 STR-TEST-GF-11-1. NC2174.2 +088900 IF ID7-XN-5 = "ABCDE" NC2174.2 +089000 PERFORM PASS NC2174.2 +089100 GO TO STR-WRITE-GF-11-1 NC2174.2 +089200 ELSE NC2174.2 +089300 GO TO STR-FAIL-GF-11-1. NC2174.2 +089400 STR-DELETE-GF-11-1. NC2174.2 +089500 PERFORM DE-LETE. NC2174.2 +089600 GO TO STR-WRITE-GF-11-1. NC2174.2 +089700 STR-FAIL-GF-11-1. NC2174.2 +089800 PERFORM FAIL NC2174.2 +089900 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +090000 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +090100 STR-WRITE-GF-11-1. NC2174.2 +090200 PERFORM PRINT-DETAIL. NC2174.2 +090300 ADD 1 TO REC-CT. NC2174.2 +090400* NC2174.2 +090500 STR-TEST-GF-11-2. NC2174.2 +090600 IF ID8-DU-2V0 = 6 NC2174.2 +090700 PERFORM PASS NC2174.2 +090800 GO TO STR-WRITE-GF-11-2 NC2174.2 +090900 ELSE NC2174.2 +091000 GO TO STR-FAIL-GF-11-2. NC2174.2 +091100 STR-DELETE-GF-11-2. NC2174.2 +091200 PERFORM DE-LETE. NC2174.2 +091300 GO TO STR-WRITE-GF-11-2. NC2174.2 +091400 STR-FAIL-GF-11-2. NC2174.2 +091500 PERFORM FAIL NC2174.2 +091600 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +091700 MOVE 6 TO CORRECT-N. NC2174.2 +091800 STR-WRITE-GF-11-2. NC2174.2 +091900 PERFORM PRINT-DETAIL. NC2174.2 +092000* NC2174.2 +092100 STR-INIT-GF-12. NC2174.2 +092200 MOVE "STR-TEST-GF-12" TO PAR-NAME. NC2174.2 +092300 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +092400 MOVE "ZERO ID DEL SIZE" TO FEATURE. NC2174.2 +092500 MOVE 0 TO REC-CT. NC2174.2 +092600 MOVE ALL "*" TO ID7-XN-15. NC2174.2 +092700* NC2174.2 +092800 STR-TEST-GF-12-1. NC2174.2 +092900 STRING ZERO ABCDEFG-XN-7 DELIMITED BY SIZE ZERO ABCDEFG-XN-7NC2174.2 +093000 DELIMITED BY SIZE INTO ID7-XN-15. NC2174.2 +093100 IF ID7-XN-15 = "0ABCDEFG0ABCDEF" NC2174.2 +093200 PERFORM PASS NC2174.2 +093300 GO TO STR-WRITE-GF-12-1 NC2174.2 +093400 ELSE NC2174.2 +093500 GO TO STR-FAIL-GF-12-1. NC2174.2 +093600 STR-DELETE-GF-12-1. NC2174.2 +093700 PERFORM DE-LETE. NC2174.2 +093800 GO TO STR-WRITE-GF-12-1. NC2174.2 +093900 STR-FAIL-GF-12-1. NC2174.2 +094000 PERFORM FAIL NC2174.2 +094100 MOVE ID7-XN-15 TO COMPUTED-A NC2174.2 +094200 MOVE "0ABCDEFG0ABCDEF" TO CORRECT-A. NC2174.2 +094300 STR-WRITE-GF-12-1. NC2174.2 +094400 PERFORM PRINT-DETAIL. NC2174.2 +094500* NC2174.2 +094600 STR-INIT-GF-13. NC2174.2 +094700 MOVE "STR-TEST-GF-13" TO PAR-NAME. NC2174.2 +094800 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +094900 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +095000 MOVE "*****" TO ID7-XN-5. NC2174.2 +095100* NC2174.2 +095200 STR-TEST-GF-13. NC2174.2 +095300 STRING "A" "B" "C" DELIMITED BY SIZE "D" "E" "F" DELIMITED NC2174.2 +095400 BY SIZE INTO ID7-XN-5. NC2174.2 +095500 IF ID7-XN-5 = "ABCDE" NC2174.2 +095600 PERFORM PASS NC2174.2 +095700 GO TO STR-WRITE-GF-13 NC2174.2 +095800 ELSE NC2174.2 +095900 GO TO STR-FAIL-GF-13. NC2174.2 +096000 STR-DELETE-GF-13. NC2174.2 +096100 PERFORM DE-LETE. NC2174.2 +096200 GO TO STR-WRITE-GF-13. NC2174.2 +096300 STR-FAIL-GF-13. NC2174.2 +096400 PERFORM FAIL NC2174.2 +096500 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +096600 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +096700 STR-WRITE-GF-13. NC2174.2 +096800 PERFORM PRINT-DETAIL. NC2174.2 +096900* NC2174.2 +097000 STR-INIT-GF-14. NC2174.2 +097100 MOVE "STR-TEST-GF-14" TO PAR-NAME. NC2174.2 +097200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +097300 MOVE "IDENTIFIER SERIES" TO FEATURE. NC2174.2 +097400 MOVE "*****" TO ID7-XN-5. NC2174.2 +097500* NC2174.2 +097600 STR-TEST-GF-14. NC2174.2 +097700 STRING AB-XN-2 AB-XN-2 AB-XN-2 DELIMITED BY B-XN-1 NC2174.2 +097800 AB-XN-2 AB-XN-2 DELIMITED BY B-XN-1 INTO ID7-XN-5. NC2174.2 +097900 IF ID7-XN-5 = "AAAAA" NC2174.2 +098000 PERFORM PASS NC2174.2 +098100 GO TO STR-WRITE-GF-14 NC2174.2 +098200 ELSE NC2174.2 +098300 GO TO STR-FAIL-GF-14. NC2174.2 +098400 STR-DELETE-GF-14. NC2174.2 +098500 PERFORM DE-LETE. NC2174.2 +098600 GO TO STR-WRITE-GF-14. NC2174.2 +098700 STR-FAIL-GF-14. NC2174.2 +098800 PERFORM FAIL NC2174.2 +098900 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +099000 MOVE "AAAAA" TO CORRECT-A. NC2174.2 +099100 STR-WRITE-GF-14. NC2174.2 +099200 PERFORM PRINT-DETAIL. NC2174.2 +099300* NC2174.2 +099400 STR-INIT-GF-15. NC2174.2 +099500 MOVE "STR-TEST-GF-15" TO PAR-NAME. NC2174.2 +099600 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +099700 MOVE "SIGN LEADING" TO FEATURE. NC2174.2 +099800 MOVE "*****" TO ID7-XN-5. NC2174.2 +099900 MOVE +1001 TO ID1-DS-LS-4. NC2174.2 +100000 MOVE ZERO TO ZEROX-XN-1. NC2174.2 +100100 MOVE 1 TO ID8-DU-2V0. NC2174.2 +100200 MOVE 1 TO REC-CT. NC2174.2 +100300* NC2174.2 +100400 STR-TEST-GF-15-0. NC2174.2 +100500 STRING ID1-DS-LS-4 DELIMITED BY ZEROX-XN-1 SPACE DELIMITED NC2174.2 +100600 BY SIZE ID1-DS-LS-4 DELIMITED "0" INTO NC2174.2 +100700 ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +100800 GO TO STR-TEST-GF-15-1. NC2174.2 +100900 STR-DELETE-GF-15. NC2174.2 +101000 PERFORM DE-LETE. NC2174.2 +101100 PERFORM PRINT-DETAIL. NC2174.2 +101200 GO TO STR-INIT-GF-16. NC2174.2 +101300* NC2174.2 +101400 STR-TEST-GF-15-1. NC2174.2 +101500 IF ID7-XN-5 = "+1 +1" NC2174.2 +101600 PERFORM PASS NC2174.2 +101700 GO TO STR-WRITE-GF-15-1 NC2174.2 +101800 ELSE NC2174.2 +101900 GO TO STR-FAIL-GF-15-1. NC2174.2 +102000 STR-DELETE-GF-15-1. NC2174.2 +102100 PERFORM DE-LETE. NC2174.2 +102200 GO TO STR-WRITE-GF-15-1. NC2174.2 +102300 STR-FAIL-GF-15-1. NC2174.2 +102400 PERFORM FAIL NC2174.2 +102500 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +102600 MOVE "+1 +1" TO CORRECT-A. NC2174.2 +102700 STR-WRITE-GF-15-1. NC2174.2 +102800 PERFORM PRINT-DETAIL. NC2174.2 +102900* NC2174.2 +103000 STR-TEST-GF-15-2. NC2174.2 +103100 ADD 1 TO REC-CT. NC2174.2 +103200 IF ID8-DU-2V0 = 6 NC2174.2 +103300 PERFORM PASS NC2174.2 +103400 GO TO STR-WRITE-GF-15-2 NC2174.2 +103500 ELSE NC2174.2 +103600 GO TO STR-FAIL-GF-15-2. NC2174.2 +103700 STR-DELETE-GF-15-2. NC2174.2 +103800 PERFORM DE-LETE. NC2174.2 +103900 GO TO STR-WRITE-GF-15-2. NC2174.2 +104000 STR-FAIL-GF-15-2. NC2174.2 +104100 PERFORM FAIL NC2174.2 +104200 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +104300 MOVE 6 TO CORRECT-N. NC2174.2 +104400 STR-WRITE-GF-15-2. NC2174.2 +104500 PERFORM PRINT-DETAIL. NC2174.2 +104600* NC2174.2 +104700 STR-INIT-GF-16. NC2174.2 +104800 MOVE "STR-TEST-GF-16" TO PAR-NAME. NC2174.2 +104900 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +105000 MOVE "SIGN LEADING" TO FEATURE. NC2174.2 +105100 MOVE "*****" TO ID7-XN-5. NC2174.2 +105200 MOVE +1001 TO ID1-DS-LS-4. NC2174.2 +105300 MOVE ZERO TO ZEROX-XN-1. NC2174.2 +105400 MOVE 1 TO ID8-DU-2V0. NC2174.2 +105500 MOVE 1 TO REC-CT. NC2174.2 +105600* NC2174.2 +105700 STR-TEST-GF-16-0. NC2174.2 +105800 STRING ID1-DS-LS-4 DELIMITED "0" " " DELIMITED BY SIZE NC2174.2 +105900 ID1-DS-LS-4 DELIMITED BY ZEROX-XN-1 INTO ID7-XN-5 NC2174.2 +106000 POINTER ID8-DU-2V0. NC2174.2 +106100 GO TO STR-TEST-GF-16-1. NC2174.2 +106200 STR-DELETE-GF-16. NC2174.2 +106300 PERFORM DE-LETE. NC2174.2 +106400 PERFORM PRINT-DETAIL. NC2174.2 +106500 GO TO STR-INIT-GF-17. NC2174.2 +106600* NC2174.2 +106700 STR-TEST-GF-16-1. NC2174.2 +106800 IF ID7-XN-5 = "+1 +1" NC2174.2 +106900 PERFORM PASS NC2174.2 +107000 GO TO STR-WRITE-GF-16-1 NC2174.2 +107100 ELSE NC2174.2 +107200 GO TO STR-FAIL-GF-16-1. NC2174.2 +107300 STR-DELETE-GF-16-1. NC2174.2 +107400 PERFORM DE-LETE. NC2174.2 +107500 GO TO STR-WRITE-GF-16-1. NC2174.2 +107600 STR-FAIL-GF-16-1. NC2174.2 +107700 PERFORM FAIL NC2174.2 +107800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +107900 MOVE "+1 +1" TO CORRECT-A. NC2174.2 +108000 STR-WRITE-GF-16-1. NC2174.2 +108100 PERFORM PRINT-DETAIL. NC2174.2 +108200* NC2174.2 +108300 STR-TEST-GF-16-2. NC2174.2 +108400 ADD 1 TO REC-CT. NC2174.2 +108500 IF ID8-DU-2V0 = 6 NC2174.2 +108600 PERFORM PASS NC2174.2 +108700 GO TO STR-WRITE-GF-16-2 NC2174.2 +108800 ELSE NC2174.2 +108900 GO TO STR-FAIL-GF-16-2. NC2174.2 +109000 STR-DELETE-GF-16-2. NC2174.2 +109100 PERFORM DE-LETE. NC2174.2 +109200 GO TO STR-WRITE-GF-16-2. NC2174.2 +109300 STR-FAIL-GF-16-2. NC2174.2 +109400 PERFORM FAIL NC2174.2 +109500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +109600 MOVE 6 TO CORRECT-N. NC2174.2 +109700 STR-WRITE-GF-16-2. NC2174.2 +109800 PERFORM PRINT-DETAIL. NC2174.2 +109900* NC2174.2 +110000 STR-INIT-GF-17. NC2174.2 +110100 MOVE "STR-TEST-GF-17" TO PAR-NAME. NC2174.2 +110200 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +110300 MOVE "SIGN TRAILING" TO FEATURE. NC2174.2 +110400 MOVE "*****" TO ID7-XN-5. NC2174.2 +110500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +110600 MOVE +1001 TO ID1-DS-TS-4. NC2174.2 +110700 MOVE 1 TO REC-CT. NC2174.2 +110800* NC2174.2 +110900 STR-TEST-GF-17-0. NC2174.2 +111000 STRING ID1-DS-TS-4 DELIMITED BY SIZE SPACE DELIMITED SIZE NC2174.2 +111100 ID1-DS-TS-4 DELIMITED BY SIZE NC2174.2 +111200 INTO ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +111300 GO TO STR-TEST-GF-17-1. NC2174.2 +111400 STR-DELETE-GF-17. NC2174.2 +111500 PERFORM DE-LETE. NC2174.2 +111600 PERFORM PRINT-DETAIL. NC2174.2 +111700 GO TO STR-INIT-GF-18. NC2174.2 +111800* NC2174.2 +111900 STR-TEST-GF-17-1. NC2174.2 +112000 IF ID7-XN-5 = "1001+" NC2174.2 +112100 PERFORM PASS NC2174.2 +112200 GO TO STR-WRITE-GF-17-1 NC2174.2 +112300 ELSE NC2174.2 +112400 GO TO STR-FAIL-GF-17-1. NC2174.2 +112500 STR-DELETE-GF-17-1. NC2174.2 +112600 PERFORM DE-LETE. NC2174.2 +112700 GO TO STR-WRITE-GF-17-1. NC2174.2 +112800 STR-FAIL-GF-17-1. NC2174.2 +112900 PERFORM FAIL NC2174.2 +113000 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +113100 MOVE "1001+" TO CORRECT-A. NC2174.2 +113200 STR-WRITE-GF-17-1. NC2174.2 +113300 PERFORM PRINT-DETAIL. NC2174.2 +113400* NC2174.2 +113500 STR-TEST-GF-17-2. NC2174.2 +113600 ADD 1 TO REC-CT. NC2174.2 +113700 IF ID8-DU-2V0 = 6 NC2174.2 +113800 PERFORM PASS NC2174.2 +113900 GO TO STR-WRITE-GF-17-2 NC2174.2 +114000 ELSE NC2174.2 +114100 GO TO STR-FAIL-GF-17-2. NC2174.2 +114200 STR-DELETE-GF-17-2. NC2174.2 +114300 PERFORM DE-LETE. NC2174.2 +114400 GO TO STR-WRITE-GF-17-2. NC2174.2 +114500 STR-FAIL-GF-17-2. NC2174.2 +114600 PERFORM FAIL NC2174.2 +114700 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +114800 MOVE 6 TO CORRECT-N. NC2174.2 +114900 STR-WRITE-GF-17-2. NC2174.2 +115000 PERFORM PRINT-DETAIL. NC2174.2 +115100* NC2174.2 +115200 STR-INIT-GF-18. NC2174.2 +115300 MOVE "STR-TEST-GF-18" TO PAR-NAME. NC2174.2 +115400 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +115500 MOVE "NEG LEADING SEPARATE" TO FEATURE. NC2174.2 +115600 MOVE -1001 TO ID1-DS-LS-4. NC2174.2 +115700 MOVE "*****" TO ID7-XN-5. NC2174.2 +115800 MOVE ZERO TO ZEROX-XN-1. NC2174.2 +115900 MOVE 1 TO ID8-DU-2V0. NC2174.2 +116000 MOVE 1 TO REC-CT. NC2174.2 +116100* NC2174.2 +116200 STR-TEST-GF-18-0. NC2174.2 +116300 STRING ID1-DS-LS-4 DELIMITED BY ZEROX-XN-1 SPACE DELIMITED NC2174.2 +116400 BY SIZE ID1-DS-LS-4 DELIMITED BY "0" INTO NC2174.2 +116500 ID7-XN-5 POINTER ID8-DU-2V0. NC2174.2 +116600 GO TO STR-TEST-GF-18-1. NC2174.2 +116700 STR-DELETE-GF-18. NC2174.2 +116800 PERFORM DE-LETE. NC2174.2 +116900 PERFORM PRINT-DETAIL. NC2174.2 +117000 GO TO STR-INIT-GF-19. NC2174.2 +117100* NC2174.2 +117200 STR-TEST-GF-18-1. NC2174.2 +117300 IF ID7-XN-5 = "-1 -1" NC2174.2 +117400 PERFORM PASS NC2174.2 +117500 GO TO STR-WRITE-GF-18-1 NC2174.2 +117600 ELSE NC2174.2 +117700 GO TO STR-FAIL-GF-18-1. NC2174.2 +117800 STR-DELETE-GF-18-1. NC2174.2 +117900 PERFORM DE-LETE. NC2174.2 +118000 GO TO STR-WRITE-GF-18-1. NC2174.2 +118100 STR-FAIL-GF-18-1. NC2174.2 +118200 PERFORM FAIL NC2174.2 +118300 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +118400 MOVE "-1 -1" TO CORRECT-A. NC2174.2 +118500 STR-WRITE-GF-18-1. NC2174.2 +118600 PERFORM PRINT-DETAIL. NC2174.2 +118700* NC2174.2 +118800 STR-TEST-GF-18-2. NC2174.2 +118900 ADD 1 TO REC-CT. NC2174.2 +119000 IF ID8-DU-2V0 = 6 NC2174.2 +119100 PERFORM PASS NC2174.2 +119200 GO TO STR-WRITE-GF-18-2 NC2174.2 +119300 ELSE NC2174.2 +119400 GO TO STR-FAIL-GF-18-2. NC2174.2 +119500 STR-DELETE-GF-18-2. NC2174.2 +119600 PERFORM DE-LETE. NC2174.2 +119700 GO TO STR-WRITE-GF-18-2. NC2174.2 +119800 STR-FAIL-GF-18-2. NC2174.2 +119900 PERFORM FAIL NC2174.2 +120000 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +120100 MOVE 6 TO CORRECT-N. NC2174.2 +120200 STR-WRITE-GF-18-2. NC2174.2 +120300 PERFORM PRINT-DETAIL. NC2174.2 +120400* NC2174.2 +120500 STR-INIT-GF-19. NC2174.2 +120600 MOVE "STR-TEST-GF-19" TO PAR-NAME. NC2174.2 +120700 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +120800 MOVE "NEGATIVE SIGN TRAIL" TO FEATURE. NC2174.2 +120900 MOVE "*****" TO ID7-XN-5. NC2174.2 +121000 MOVE 1 TO ID8-DU-2V0. NC2174.2 +121100 MOVE -1001 TO ID1-DS-TS-4. NC2174.2 +121200 MOVE 1 TO REC-CT. NC2174.2 +121300* NC2174.2 +121400 STR-TEST-GF-19-0. NC2174.2 +121500 STRING ID1-DS-TS-4 DELIMITED BY SIZE SPACE DELIMITED SIZE NC2174.2 +121600 ID1-DS-TS-4 DELIMITED BY SIZE INTO ID7-XN-5 NC2174.2 +121700 POINTER ID8-DU-2V0. NC2174.2 +121800 GO TO STR-TEST-GF-19-1. NC2174.2 +121900 STR-DELETE-GF-19. NC2174.2 +122000 PERFORM DE-LETE. NC2174.2 +122100 PERFORM PRINT-DETAIL. NC2174.2 +122200 GO TO STR-INIT-GF-20. NC2174.2 +122300* NC2174.2 +122400 STR-TEST-GF-19-1. NC2174.2 +122500 IF ID7-XN-5 = "1001-" NC2174.2 +122600 PERFORM PASS NC2174.2 +122700 GO TO STR-WRITE-GF-19-1 NC2174.2 +122800 ELSE NC2174.2 +122900 GO TO STR-FAIL-GF-19-1. NC2174.2 +123000 STR-DELETE-GF-19-1. NC2174.2 +123100 PERFORM DE-LETE. NC2174.2 +123200 GO TO STR-WRITE-GF-19-1. NC2174.2 +123300 STR-FAIL-GF-19-1. NC2174.2 +123400 PERFORM FAIL NC2174.2 +123500 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +123600 MOVE "1001-" TO CORRECT-A. NC2174.2 +123700 STR-WRITE-GF-19-1. NC2174.2 +123800 PERFORM PRINT-DETAIL. NC2174.2 +123900* NC2174.2 +124000 STR-TEST-GF-19-2. NC2174.2 +124100 ADD 1 TO REC-CT. NC2174.2 +124200 IF ID8-DU-2V0 = 6 NC2174.2 +124300 PERFORM PASS NC2174.2 +124400 GO TO STR-WRITE-GF-19-2 NC2174.2 +124500 ELSE NC2174.2 +124600 GO TO STR-FAIL-GF-19-2. NC2174.2 +124700 STR-DELETE-GF-19-2. NC2174.2 +124800 PERFORM DE-LETE. NC2174.2 +124900 GO TO STR-WRITE-GF-19-2. NC2174.2 +125000 STR-FAIL-GF-19-2. NC2174.2 +125100 PERFORM FAIL NC2174.2 +125200 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +125300 MOVE 6 TO CORRECT-N. NC2174.2 +125400 STR-WRITE-GF-19-2. NC2174.2 +125500 PERFORM PRINT-DETAIL. NC2174.2 +125600* NC2174.2 +125700 STR-INIT-GF-20. NC2174.2 +125800 MOVE "STR-TEST-GF-20" TO PAR-NAME. NC2174.2 +125900 MOVE "VI-130 6.24.3+4" TO ANSI-REFERENCE. NC2174.2 +126000 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +126100 MOVE ALL "*" TO WISH-LIST-XN-37. NC2174.2 +126200 MOVE "GEE I WISH I WAS A FORTRAN PROGRAMMER" TO ANS-XN-37. NC2174.2 +126300 MOVE 1 TO MY-BOSS-DU-2V0. NC2174.2 +126400 MOVE 1 TO REC-CT. NC2174.2 +126500* NC2174.2 +126600 STR-TEST-GF-20-1. NC2174.2 +126700 STRING "GEE" SPACE "I WISH I" SPACES "WAS A FORTRAN" " " NC2174.2 +126800 "PROGRAMMER" NC2174.2 +126900 DELIMITED BY SIZE INTO WISH-LIST-XN-37 NC2174.2 +127000 WITH POINTER MY-BOSS-DU-2V0 NC2174.2 +127100 ON OVERFLOW GO TO STR-FAIL-GF-20-1. NC2174.2 +127200 PERFORM PASS. NC2174.2 +127300 GO TO STR-WRITE-GF-20-1. NC2174.2 +127400 STR-DELETE-GF-20. NC2174.2 +127500 PERFORM DE-LETE. NC2174.2 +127600 PERFORM PRINT-DETAIL. NC2174.2 +127700 GO TO STR-INIT-GF-21. NC2174.2 +127800 STR-FAIL-GF-20-1. NC2174.2 +127900 PERFORM FAIL. NC2174.2 +128000 MOVE "OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +128100 STR-WRITE-GF-20-1. NC2174.2 +128200 PERFORM PRINT-DETAIL. NC2174.2 +128300* NC2174.2 +128400 STR-TEST-GF-20-2. NC2174.2 +128500 MOVE "STR-TEST-GF-20" TO PAR-NAME. NC2174.2 +128600 MOVE 1 TO REC-CT. NC2174.2 +128700 IF WISH-LIST-XN-37 = ANS-XN-37 NC2174.2 +128800 PERFORM PASS NC2174.2 +128900 GO TO STR-WRITE-GF-20-2 NC2174.2 +129000 ELSE NC2174.2 +129100 GO TO STR-FAIL-GF-20-2. NC2174.2 +129200 STR-DELETE-GF-20-2. NC2174.2 +129300 PERFORM DE-LETE. NC2174.2 +129400 GO TO STR-WRITE-GF-20-2. NC2174.2 +129500 STR-FAIL-GF-20-2. NC2174.2 +129600 PERFORM FAIL NC2174.2 +129700 MOVE WISH-LIST-XN-37 TO COMPUTED-A NC2174.2 +129800 MOVE ANS-XN-37 TO CORRECT-A. NC2174.2 +129900 STR-WRITE-GF-20-2. NC2174.2 +130000 PERFORM PRINT-DETAIL. NC2174.2 +130100* NC2174.2 +130200 STR-TEST-GF-20-3. NC2174.2 +130300 ADD 1 TO REC-CT. NC2174.2 +130400 IF MY-BOSS-DU-2V0 = 38 NC2174.2 +130500 PERFORM PASS NC2174.2 +130600 GO TO STR-WRITE-GF-20-3 NC2174.2 +130700 ELSE NC2174.2 +130800 GO TO STR-FAIL-GF-20-3. NC2174.2 +130900 STR-DELETE-GF-20-3. NC2174.2 +131000 PERFORM DE-LETE. NC2174.2 +131100 GO TO STR-WRITE-GF-20-3. NC2174.2 +131200 STR-FAIL-GF-20-3. NC2174.2 +131300 PERFORM FAIL NC2174.2 +131400 MOVE MY-BOSS-DU-2V0 TO COMPUTED-N NC2174.2 +131500 MOVE 38 TO CORRECT-N. NC2174.2 +131600 STR-WRITE-GF-20-3. NC2174.2 +131700 PERFORM PRINT-DETAIL. NC2174.2 +131800* NC2174.2 +131900* NC2174.2 +132000 STR-INIT-GF-21. NC2174.2 +132100* ===--> INTO GROUP FIELD <--=== NC2174.2 +132200 MOVE "VI-130 6.24.3 GR4" TO ANSI-REFERENCE. NC2174.2 +132300 MOVE "STR-TEST-GF-21" TO PAR-NAME. NC2174.2 +132400 MOVE "LIT DEL BY SIZE" TO FEATURE. NC2174.2 +132500 MOVE "*****" TO ID7-XN-5. NC2174.2 +132600 MOVE 1 TO ID8-DU-2V0. NC2174.2 +132700 MOVE 1 TO REC-CT. NC2174.2 +132800* NC2174.2 +132900 STR-TEST-GF-21-0. NC2174.2 +133000 STRING "ABCDEF" DELIMITED BY SIZE INTO TEST-21-GROUP NC2174.2 +133100 WITH POINTER ID8-DU-2V0. NC2174.2 +133200 GO TO STR-TEST-GF-21-1. NC2174.2 +133300 STR-DELETE-GF-21. NC2174.2 +133400 PERFORM DE-LETE. NC2174.2 +133500 PERFORM PRINT-DETAIL. NC2174.2 +133600 GO TO STR-INIT-GF-22. NC2174.2 +133700* NC2174.2 +133800 STR-TEST-GF-21-1. NC2174.2 +133900 IF TEST-21-GROUP = "ABCDE" NC2174.2 +134000 PERFORM PASS NC2174.2 +134100 GO TO STR-WRITE-GF-21-1 NC2174.2 +134200 ELSE NC2174.2 +134300 GO TO STR-FAIL-GF-21-1. NC2174.2 +134400 STR-DELETE-GF-21-1. NC2174.2 +134500 PERFORM DE-LETE. NC2174.2 +134600 GO TO STR-WRITE-GF-21-1. NC2174.2 +134700 STR-FAIL-GF-21-1. NC2174.2 +134800 PERFORM FAIL NC2174.2 +134900 MOVE TEST-21-GROUP TO COMPUTED-A NC2174.2 +135000 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +135100 STR-WRITE-GF-21-1. NC2174.2 +135200 PERFORM PRINT-DETAIL. NC2174.2 +135300* NC2174.2 +135400 STR-TEST-GF-21-2. NC2174.2 +135500 ADD 1 TO REC-CT. NC2174.2 +135600 IF ID8-DU-2V0 = 6 NC2174.2 +135700 PERFORM PASS NC2174.2 +135800 GO TO STR-WRITE-GF-21-2 NC2174.2 +135900 ELSE NC2174.2 +136000 GO TO STR-FAIL-GF-21-2. NC2174.2 +136100 STR-DELETE-GF-21-2. NC2174.2 +136200 PERFORM DE-LETE. NC2174.2 +136300 GO TO STR-WRITE-GF-21-2. NC2174.2 +136400 STR-FAIL-GF-21-2. NC2174.2 +136500 PERFORM FAIL NC2174.2 +136600 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +136700 MOVE 6 TO CORRECT-N. NC2174.2 +136800 STR-WRITE-GF-21-2. NC2174.2 +136900 PERFORM PRINT-DETAIL. NC2174.2 +137000* NC2174.2 +137100 STR-INIT-GF-22. NC2174.2 +137200* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +137300 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +137400 MOVE "STR-TEST-GF-22" TO PAR-NAME. NC2174.2 +137500 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +137600 MOVE "*****" TO ID7-XN-5. NC2174.2 +137700 MOVE 1 TO ID8-DU-2V0. NC2174.2 +137800 MOVE 1 TO REC-CT. NC2174.2 +137900* NC2174.2 +138000 STR-TEST-GF-22-1. NC2174.2 +138100 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +138200 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +138300 NOT ON OVERFLOW GO TO STR-FAIL-GF-22-1. NC2174.2 +138400 PERFORM PASS. NC2174.2 +138500 GO TO STR-WRITE-GF-22-1. NC2174.2 +138600 STR-DELETE-GF-22. NC2174.2 +138700 PERFORM DE-LETE. NC2174.2 +138800 PERFORM PRINT-DETAIL. NC2174.2 +138900 GO TO STR-INIT-GF-23. NC2174.2 +139000 STR-FAIL-GF-22-1. NC2174.2 +139100 PERFORM FAIL. NC2174.2 +139200 MOVE "NOT ON OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +139300 STR-WRITE-GF-22-1. NC2174.2 +139400 PERFORM PRINT-DETAIL. NC2174.2 +139500* NC2174.2 +139600 STR-TEST-GF-22-2. NC2174.2 +139700 ADD 1 TO REC-CT. NC2174.2 +139800 IF ID7-XN-5 = "ABCDE" NC2174.2 +139900 PERFORM PASS NC2174.2 +140000 GO TO STR-WRITE-GF-22-2 NC2174.2 +140100 ELSE NC2174.2 +140200 GO TO STR-FAIL-GF-22-2. NC2174.2 +140300 STR-DELETE-GF-22-2. NC2174.2 +140400 PERFORM DE-LETE. NC2174.2 +140500 GO TO STR-WRITE-GF-22-2. NC2174.2 +140600 STR-FAIL-GF-22-2. NC2174.2 +140700 PERFORM FAIL. NC2174.2 +140800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +140900 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +141000 STR-WRITE-GF-22-2. NC2174.2 +141100 PERFORM PRINT-DETAIL. NC2174.2 +141200* NC2174.2 +141300 STR-TEST-GF-22-3. NC2174.2 +141400 ADD 1 TO REC-CT. NC2174.2 +141500 IF ID8-DU-2V0 = 6 NC2174.2 +141600 PERFORM PASS NC2174.2 +141700 GO TO STR-WRITE-GF-22-3 NC2174.2 +141800 ELSE NC2174.2 +141900 GO TO STR-FAIL-GF-22-3. NC2174.2 +142000 STR-DELETE-GF-22-3. NC2174.2 +142100 PERFORM DE-LETE. NC2174.2 +142200 GO TO STR-WRITE-GF-22-3. NC2174.2 +142300 STR-FAIL-GF-22-3. NC2174.2 +142400 PERFORM FAIL NC2174.2 +142500 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +142600 MOVE 6 TO CORRECT-N. NC2174.2 +142700 STR-WRITE-GF-22-3. NC2174.2 +142800 PERFORM PRINT-DETAIL. NC2174.2 +142900* NC2174.2 +143000 STR-INIT-GF-23. NC2174.2 +143100* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +143200 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +143300 MOVE "STR-TEST-GF-23" TO PAR-NAME. NC2174.2 +143400 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +143500 MOVE "*****" TO ID7-XN-5. NC2174.2 +143600 MOVE 1 TO ID8-DU-2V0. NC2174.2 +143700 MOVE 1 TO REC-CT. NC2174.2 +143800* NC2174.2 +143900 STR-TEST-GF-23-1. NC2174.2 +144000 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +144100 POINTER ID8-DU-2V0 NC2174.2 +144200 NOT ON OVERFLOW PERFORM PASS NC2174.2 +144300 GO TO STR-WRITE-GF-23-1. NC2174.2 +144400 GO TO STR-FAIL-GF-23-1. NC2174.2 +144500 STR-DELETE-GF-23. NC2174.2 +144600 PERFORM DE-LETE. NC2174.2 +144700 PERFORM PRINT-DETAIL. NC2174.2 +144800 GO TO STR-INIT-GF-24. NC2174.2 +144900 STR-FAIL-GF-23-1. NC2174.2 +145000 PERFORM FAIL. NC2174.2 +145100 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK. NC2174.2 +145200 STR-WRITE-GF-23-1. NC2174.2 +145300 PERFORM PRINT-DETAIL. NC2174.2 +145400* NC2174.2 +145500 STR-TEST-GF-23-2. NC2174.2 +145600 ADD 1 TO REC-CT. NC2174.2 +145700 IF ID7-XN-5 = "ABCDE" NC2174.2 +145800 PERFORM PASS NC2174.2 +145900 GO TO STR-WRITE-GF-23-2 NC2174.2 +146000 ELSE NC2174.2 +146100 GO TO STR-FAIL-GF-23-2. NC2174.2 +146200 STR-DELETE-GF-23-2. NC2174.2 +146300 PERFORM DE-LETE. NC2174.2 +146400 GO TO STR-WRITE-GF-23-2. NC2174.2 +146500 STR-FAIL-GF-23-2. NC2174.2 +146600 PERFORM FAIL NC2174.2 +146700 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +146800 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +146900 STR-WRITE-GF-23-2. NC2174.2 +147000 PERFORM PRINT-DETAIL. NC2174.2 +147100* NC2174.2 +147200 STR-TEST-GF-23-3. NC2174.2 +147300 ADD 1 TO REC-CT. NC2174.2 +147400 IF ID8-DU-2V0 = 6 NC2174.2 +147500 PERFORM PASS NC2174.2 +147600 GO TO STR-WRITE-GF-23-3 NC2174.2 +147700 ELSE NC2174.2 +147800 GO TO STR-FAIL-GF-23-3. NC2174.2 +147900 STR-DELETE-GF-23-3. NC2174.2 +148000 PERFORM DE-LETE. NC2174.2 +148100 GO TO STR-WRITE-GF-23-3. NC2174.2 +148200 STR-FAIL-GF-23-3. NC2174.2 +148300 PERFORM FAIL NC2174.2 +148400 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +148500 MOVE 6 TO CORRECT-N. NC2174.2 +148600 STR-WRITE-GF-23-3. NC2174.2 +148700 PERFORM PRINT-DETAIL. NC2174.2 +148800* NC2174.2 +148900 STR-INIT-GF-24. NC2174.2 +149000* ===--> BOTH "OVERFLOW" PHRASES <--=== NC2174.2 +149100 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +149200 MOVE "STR-TEST-GF-24" TO PAR-NAME. NC2174.2 +149300 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +149400 MOVE "*****" TO ID7-XN-5. NC2174.2 +149500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +149600 MOVE 1 TO REC-CT. NC2174.2 +149700* NC2174.2 +149800 STR-TEST-GF-24-1. NC2174.2 +149900 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +150000 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +150100 ON OVERFLOW PERFORM PASS NC2174.2 +150200 GO TO STR-WRITE-GF-24-1 NC2174.2 +150300 NOT ON OVERFLOW GO TO STR-FAIL-GF-24-1. NC2174.2 +150400 STR-DELETE-GF-24. NC2174.2 +150500 PERFORM DE-LETE. NC2174.2 +150600 PERFORM PRINT-DETAIL. NC2174.2 +150700 GO TO STR-INIT-GF-25. NC2174.2 +150800 STR-FAIL-GF-24-1. NC2174.2 +150900 PERFORM FAIL. NC2174.2 +151000 MOVE "NOT ON OVERFLOW SHOULD NOT OCCUR" TO RE-MARK. NC2174.2 +151100 STR-WRITE-GF-24-1. NC2174.2 +151200 PERFORM PRINT-DETAIL. NC2174.2 +151300* NC2174.2 +151400 STR-TEST-GF-24-2. NC2174.2 +151500 ADD 1 TO REC-CT. NC2174.2 +151600 IF ID7-XN-5 = "ABCDE" NC2174.2 +151700 PERFORM PASS NC2174.2 +151800 GO TO STR-WRITE-GF-24-2 NC2174.2 +151900 ELSE NC2174.2 +152000 GO TO STR-FAIL-GF-24-2. NC2174.2 +152100 STR-DELETE-GF-24-2. NC2174.2 +152200 PERFORM DE-LETE. NC2174.2 +152300 GO TO STR-WRITE-GF-24-2. NC2174.2 +152400 STR-FAIL-GF-24-2. NC2174.2 +152500 PERFORM FAIL NC2174.2 +152600 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +152700 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +152800 STR-WRITE-GF-24-2. NC2174.2 +152900 PERFORM PRINT-DETAIL. NC2174.2 +153000* NC2174.2 +153100 STR-TEST-GF-24-3. NC2174.2 +153200 ADD 1 TO REC-CT. NC2174.2 +153300 IF ID8-DU-2V0 = 6 NC2174.2 +153400 PERFORM PASS NC2174.2 +153500 GO TO STR-WRITE-GF-24-3 NC2174.2 +153600 ELSE NC2174.2 +153700 GO TO STR-FAIL-GF-24-3. NC2174.2 +153800 STR-DELETE-GF-24-3. NC2174.2 +153900 PERFORM DE-LETE. NC2174.2 +154000 GO TO STR-WRITE-GF-24-3. NC2174.2 +154100 STR-FAIL-GF-24-3. NC2174.2 +154200 PERFORM FAIL NC2174.2 +154300 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +154400 MOVE 6 TO CORRECT-N. NC2174.2 +154500 STR-WRITE-GF-24-3. NC2174.2 +154600 PERFORM PRINT-DETAIL. NC2174.2 +154700* NC2174.2 +154800 STR-INIT-GF-25. NC2174.2 +154900* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +155000 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +155100 MOVE "STR-TEST-GF-25" TO PAR-NAME. NC2174.2 +155200 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +155300 MOVE "*****" TO ID7-XN-5. NC2174.2 +155400 MOVE 1 TO ID8-DU-2V0. NC2174.2 +155500 MOVE ZERO TO REC-CT. NC2174.2 +155600* NC2174.2 +155700 STR-TEST-GF-25-1. NC2174.2 +155800 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +155900 POINTER ID8-DU-2V0 NC2174.2 +156000 ON OVERFLOW GO TO STR-FAIL-GF-25-1 NC2174.2 +156100 NOT ON OVERFLOW PERFORM PASS NC2174.2 +156200 GO TO STR-WRITE-GF-25-1. NC2174.2 +156300 STR-DELETE-GF-25-1. NC2174.2 +156400 PERFORM DE-LETE. NC2174.2 +156500 PERFORM PRINT-DETAIL. NC2174.2 +156600 GO TO STR-INIT-GF-26. NC2174.2 +156700 STR-FAIL-GF-25-1. NC2174.2 +156800 PERFORM FAIL. NC2174.2 +156900 MOVE "ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK. NC2174.2 +157000 STR-WRITE-GF-25-1. NC2174.2 +157100 PERFORM PRINT-DETAIL. NC2174.2 +157200* NC2174.2 +157300 STR-TEST-GF-25-2. NC2174.2 +157400 MOVE "STR-TEST-GF-25-1" TO PAR-NAME. NC2174.2 +157500 MOVE 1 TO REC-CT. NC2174.2 +157600 IF ID7-XN-5 = "ABCDE" NC2174.2 +157700 PERFORM PASS NC2174.2 +157800 GO TO STR-WRITE-GF-25-2 NC2174.2 +157900 ELSE NC2174.2 +158000 GO TO STR-FAIL-GF-25-2. NC2174.2 +158100 STR-DELETE-GF-25-2. NC2174.2 +158200 PERFORM DE-LETE. NC2174.2 +158300 GO TO STR-WRITE-GF-25-2. NC2174.2 +158400 STR-FAIL-GF-25-2. NC2174.2 +158500 PERFORM FAIL NC2174.2 +158600 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +158700 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +158800 STR-WRITE-GF-25-2. NC2174.2 +158900 PERFORM PRINT-DETAIL. NC2174.2 +159000* NC2174.2 +159100 STR-TEST-GF-25-3. NC2174.2 +159200 ADD 1 TO REC-CT. NC2174.2 +159300 IF ID8-DU-2V0 = 6 NC2174.2 +159400 PERFORM PASS NC2174.2 +159500 GO TO STR-WRITE-GF-25-3 NC2174.2 +159600 ELSE NC2174.2 +159700 GO TO STR-FAIL-GF-25-3. NC2174.2 +159800 STR-DELETE-GF-25-3. NC2174.2 +159900 PERFORM DE-LETE. NC2174.2 +160000 GO TO STR-WRITE-GF-25-3. NC2174.2 +160100 STR-FAIL-GF-25-3. NC2174.2 +160200 PERFORM FAIL NC2174.2 +160300 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +160400 MOVE 6 TO CORRECT-N. NC2174.2 +160500 STR-WRITE-GF-25-3. NC2174.2 +160600 PERFORM PRINT-DETAIL. NC2174.2 +160700* NC2174.2 +160800 STR-INIT-GF-26. NC2174.2 +160900* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2174.2 +161000 MOVE "VI-132 6.24.4 GR11" TO ANSI-REFERENCE. NC2174.2 +161100 MOVE "STR-TEST-GF-26" TO PAR-NAME. NC2174.2 +161200 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +161300 MOVE "*****" TO ID7-XN-5. NC2174.2 +161400 MOVE 1 TO ID8-DU-2V0. NC2174.2 +161500 MOVE 1 TO REC-CT. NC2174.2 +161600 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +161700 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +161800 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +161900* NC2174.2 +162000 STR-TEST-GF-26-0. NC2174.2 +162100 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +162200 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +162300 ON OVERFLOW NC2174.2 +162400 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +162500 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +162600 NOT ON OVERFLOW NC2174.2 +162700 MOVE "C" TO WRK-XN-00001-1 NC2174.2 +162800 MOVE "D" TO WRK-XN-00001-2 NC2174.2 +162900 END-STRING NC2174.2 +163000 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +163100 GO TO STR-TEST-GF-26-1. NC2174.2 +163200 STR-DELETE-GF-26. NC2174.2 +163300 PERFORM DE-LETE. NC2174.2 +163400 PERFORM PRINT-DETAIL. NC2174.2 +163500 GO TO STR-INIT-GF-27. NC2174.2 +163600* NC2174.2 +163700 STR-TEST-GF-26-1. NC2174.2 +163800 IF ID7-XN-5 = "ABCDE" NC2174.2 +163900 PERFORM PASS NC2174.2 +164000 GO TO STR-WRITE-GF-26-1 NC2174.2 +164100 ELSE NC2174.2 +164200 GO TO STR-FAIL-GF-26-1. NC2174.2 +164300 STR-DELETE-GF-26-1. NC2174.2 +164400 PERFORM DE-LETE. NC2174.2 +164500 GO TO STR-WRITE-GF-26-1. NC2174.2 +164600 STR-FAIL-GF-26-1. NC2174.2 +164700 PERFORM FAIL NC2174.2 +164800 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +164900 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +165000 STR-WRITE-GF-26-1. NC2174.2 +165100 PERFORM PRINT-DETAIL. NC2174.2 +165200* NC2174.2 +165300 STR-TEST-GF-26-2. NC2174.2 +165400 ADD 1 TO REC-CT. NC2174.2 +165500 MOVE "STR-TEST-GF-26-2" TO PAR-NAME. NC2174.2 +165600 IF ID8-DU-2V0 = 6 NC2174.2 +165700 PERFORM PASS NC2174.2 +165800 GO TO STR-WRITE-GF-26-2 NC2174.2 +165900 ELSE NC2174.2 +166000 GO TO STR-FAIL-GF-26-2. NC2174.2 +166100 STR-DELETE-GF-26-2. NC2174.2 +166200 PERFORM DE-LETE. NC2174.2 +166300 GO TO STR-WRITE-GF-26-2. NC2174.2 +166400 STR-FAIL-GF-26-2. NC2174.2 +166500 PERFORM FAIL NC2174.2 +166600 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +166700 MOVE 6 TO CORRECT-N. NC2174.2 +166800 STR-WRITE-GF-26-2. NC2174.2 +166900 PERFORM PRINT-DETAIL. NC2174.2 +167000* NC2174.2 +167100 STR-TEST-GF-26-3. NC2174.2 +167200 ADD 1 TO REC-CT. NC2174.2 +167300 IF WRK-XN-00001-1 = "A" NC2174.2 +167400 PERFORM PASS NC2174.2 +167500 GO TO STR-WRITE-GF-26-3 NC2174.2 +167600 ELSE NC2174.2 +167700 GO TO STR-FAIL-GF-26-3. NC2174.2 +167800 STR-DELETE-GF-26-3. NC2174.2 +167900 PERFORM DE-LETE. NC2174.2 +168000 GO TO STR-WRITE-GF-26-3. NC2174.2 +168100 STR-FAIL-GF-26-3. NC2174.2 +168200 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +168300 MOVE "A" TO CORRECT-X NC2174.2 +168400 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2174.2 +168500 PERFORM FAIL. NC2174.2 +168600 STR-WRITE-GF-26-3. NC2174.2 +168700 PERFORM PRINT-DETAIL. NC2174.2 +168800* NC2174.2 +168900 STR-TEST-GF-26-4. NC2174.2 +169000 ADD 1 TO REC-CT. NC2174.2 +169100 IF WRK-XN-00001-2 = "B" NC2174.2 +169200 PERFORM PASS NC2174.2 +169300 GO TO STR-WRITE-GF-26-4 NC2174.2 +169400 ELSE NC2174.2 +169500 GO TO STR-FAIL-GF-26-4. NC2174.2 +169600 STR-DELETE-GF-26-4. NC2174.2 +169700 PERFORM DE-LETE. NC2174.2 +169800 GO TO STR-WRITE-GF-26-4. NC2174.2 +169900 STR-FAIL-GF-26-4. NC2174.2 +170000 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +170100 MOVE "B" TO CORRECT-X NC2174.2 +170200 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2174.2 +170300 PERFORM FAIL. NC2174.2 +170400 STR-WRITE-GF-26-4. NC2174.2 +170500 PERFORM PRINT-DETAIL. NC2174.2 +170600* NC2174.2 +170700 STR-TEST-GF-26-5. NC2174.2 +170800 ADD 1 TO REC-CT. NC2174.2 +170900 IF WRK-XN-00001-3 = "Z" NC2174.2 +171000 PERFORM PASS NC2174.2 +171100 GO TO STR-WRITE-GF-26-5 NC2174.2 +171200 ELSE NC2174.2 +171300 GO TO STR-FAIL-GF-26-5. NC2174.2 +171400 STR-DELETE-GF-26-5. NC2174.2 +171500 PERFORM DE-LETE. NC2174.2 +171600 GO TO STR-WRITE-GF-26-5. NC2174.2 +171700 STR-FAIL-GF-26-5. NC2174.2 +171800 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +171900 MOVE "Z" TO CORRECT-X NC2174.2 +172000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +172100 PERFORM FAIL. NC2174.2 +172200 STR-WRITE-GF-26-5. NC2174.2 +172300 PERFORM PRINT-DETAIL. NC2174.2 +172400* NC2174.2 +172500 STR-INIT-GF-27. NC2174.2 +172600* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +172700 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +172800 MOVE "STR-TEST-GF-27" TO PAR-NAME. NC2174.2 +172900 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +173000 MOVE "*****" TO ID7-XN-5. NC2174.2 +173100 MOVE 1 TO ID8-DU-2V0. NC2174.2 +173200 MOVE ZERO TO REC-CT. NC2174.2 +173300 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +173400 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +173500 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +173600* NC2174.2 +173700 STR-TEST-GF-27-0. NC2174.2 +173800 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +173900 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +174000 ON OVERFLOW NC2174.2 +174100 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +174200 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +174300 END-STRING NC2174.2 +174400 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +174500 GO TO STR-TEST-GF-27-1. NC2174.2 +174600 STR-DELETE-GF-27. NC2174.2 +174700 PERFORM DE-LETE. NC2174.2 +174800 PERFORM PRINT-DETAIL. NC2174.2 +174900 GO TO STR-INIT-GF-28. NC2174.2 +175000* NC2174.2 +175100 STR-TEST-GF-27-1. NC2174.2 +175200 MOVE 1 TO REC-CT. NC2174.2 +175300 IF ID7-XN-5 = "ABCDE" NC2174.2 +175400 PERFORM PASS NC2174.2 +175500 GO TO STR-WRITE-GF-27-1 NC2174.2 +175600 ELSE NC2174.2 +175700 GO TO STR-FAIL-GF-27-1. NC2174.2 +175800 STR-DELETE-GF-27-1. NC2174.2 +175900 PERFORM DE-LETE. NC2174.2 +176000 GO TO STR-WRITE-GF-27-1. NC2174.2 +176100 STR-FAIL-GF-27-1. NC2174.2 +176200 PERFORM FAIL NC2174.2 +176300 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +176400 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +176500 STR-WRITE-GF-27-1. NC2174.2 +176600 PERFORM PRINT-DETAIL. NC2174.2 +176700* NC2174.2 +176800 STR-TEST-GF-27-2. NC2174.2 +176900 ADD 1 TO REC-CT. NC2174.2 +177000 IF ID8-DU-2V0 = 6 NC2174.2 +177100 PERFORM PASS NC2174.2 +177200 GO TO STR-WRITE-GF-27-2 NC2174.2 +177300 ELSE NC2174.2 +177400 GO TO STR-FAIL-GF-27-2. NC2174.2 +177500 STR-DELETE-GF-27-2. NC2174.2 +177600 PERFORM DE-LETE. NC2174.2 +177700 GO TO STR-WRITE-GF-27-2. NC2174.2 +177800 STR-FAIL-GF-27-2. NC2174.2 +177900 PERFORM FAIL NC2174.2 +178000 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +178100 MOVE 6 TO CORRECT-N. NC2174.2 +178200 STR-WRITE-GF-27-2. NC2174.2 +178300 PERFORM PRINT-DETAIL. NC2174.2 +178400* NC2174.2 +178500 STR-TEST-GF-27-3. NC2174.2 +178600 ADD 1 TO REC-CT. NC2174.2 +178700 IF WRK-XN-00001-1 = "A" NC2174.2 +178800 PERFORM PASS NC2174.2 +178900 GO TO STR-WRITE-GF-27-3 NC2174.2 +179000 ELSE NC2174.2 +179100 GO TO STR-FAIL-GF-27-3. NC2174.2 +179200 STR-DELETE-GF-27-3. NC2174.2 +179300 PERFORM DE-LETE. NC2174.2 +179400 GO TO STR-WRITE-GF-27-3. NC2174.2 +179500 STR-FAIL-GF-27-3. NC2174.2 +179600 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +179700 MOVE "A" TO CORRECT-X NC2174.2 +179800 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2174.2 +179900 PERFORM FAIL. NC2174.2 +180000 STR-WRITE-GF-27-3. NC2174.2 +180100 PERFORM PRINT-DETAIL. NC2174.2 +180200* NC2174.2 +180300 STR-TEST-GF-27-4. NC2174.2 +180400 ADD 1 TO REC-CT. NC2174.2 +180500 IF WRK-XN-00001-2 = "B" NC2174.2 +180600 PERFORM PASS NC2174.2 +180700 GO TO STR-WRITE-GF-27-4 NC2174.2 +180800 ELSE NC2174.2 +180900 GO TO STR-FAIL-GF-27-4. NC2174.2 +181000 STR-DELETE-GF-27-4. NC2174.2 +181100 PERFORM DE-LETE. NC2174.2 +181200 GO TO STR-WRITE-GF-27-4. NC2174.2 +181300 STR-FAIL-GF-27-4. NC2174.2 +181400 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +181500 MOVE "B" TO CORRECT-X NC2174.2 +181600 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2174.2 +181700 PERFORM FAIL. NC2174.2 +181800 STR-WRITE-GF-27-4. NC2174.2 +181900 PERFORM PRINT-DETAIL. NC2174.2 +182000* NC2174.2 +182100 STR-TEST-GF-27-5. NC2174.2 +182200 ADD 1 TO REC-CT. NC2174.2 +182300 IF WRK-XN-00001-3 = "Z" NC2174.2 +182400 PERFORM PASS NC2174.2 +182500 GO TO STR-WRITE-GF-27-5 NC2174.2 +182600 ELSE NC2174.2 +182700 GO TO STR-FAIL-GF-27-5. NC2174.2 +182800 STR-DELETE-GF-27-5. NC2174.2 +182900 PERFORM DE-LETE. NC2174.2 +183000 GO TO STR-WRITE-GF-27-5. NC2174.2 +183100 STR-FAIL-GF-27-5. NC2174.2 +183200 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +183300 MOVE "Z" TO CORRECT-X NC2174.2 +183400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +183500 PERFORM FAIL. NC2174.2 +183600 STR-WRITE-GF-27-5. NC2174.2 +183700 PERFORM PRINT-DETAIL. NC2174.2 +183800* NC2174.2 +183900 STR-INIT-GF-28. NC2174.2 +184000* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +184100 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +184200 MOVE "STR-TEST-GF-28" TO PAR-NAME. NC2174.2 +184300 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +184400 MOVE "*****" TO ID7-XN-5. NC2174.2 +184500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +184600 MOVE ZERO TO REC-CT. NC2174.2 +184700 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +184800 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +184900 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +185000* NC2174.2 +185100 STR-TEST-GF-28-0. NC2174.2 +185200 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +185300 POINTER ID8-DU-2V0 NC2174.2 +185400 ON OVERFLOW NC2174.2 +185500 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +185600 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +185700 END-STRING NC2174.2 +185800 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +185900 GO TO STR-TEST-GF-28-1. NC2174.2 +186000 STR-DELETE-GF-28. NC2174.2 +186100 PERFORM DE-LETE. NC2174.2 +186200 PERFORM PRINT-DETAIL. NC2174.2 +186300 GO TO STR-INIT-GF-29. NC2174.2 +186400* NC2174.2 +186500 STR-TEST-GF-28-1. NC2174.2 +186600 MOVE 1 TO REC-CT. NC2174.2 +186700 IF ID7-XN-5 = "ABCDE" NC2174.2 +186800 PERFORM PASS NC2174.2 +186900 GO TO STR-WRITE-GF-28-1 NC2174.2 +187000 ELSE NC2174.2 +187100 GO TO STR-FAIL-GF-28-1. NC2174.2 +187200 STR-DELETE-GF-28-1. NC2174.2 +187300 PERFORM DE-LETE. NC2174.2 +187400 GO TO STR-WRITE-GF-28-1. NC2174.2 +187500 STR-FAIL-GF-28-1. NC2174.2 +187600 PERFORM FAIL NC2174.2 +187700 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +187800 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +187900 STR-WRITE-GF-28-1. NC2174.2 +188000 PERFORM PRINT-DETAIL. NC2174.2 +188100* NC2174.2 +188200 STR-TEST-GF-28-2. NC2174.2 +188300 ADD 1 TO REC-CT. NC2174.2 +188400 IF ID8-DU-2V0 = 6 NC2174.2 +188500 PERFORM PASS NC2174.2 +188600 GO TO STR-WRITE-GF-28-2 NC2174.2 +188700 ELSE NC2174.2 +188800 GO TO STR-FAIL-GF-28-2. NC2174.2 +188900 STR-DELETE-GF-28-2. NC2174.2 +189000 PERFORM DE-LETE. NC2174.2 +189100 GO TO STR-WRITE-GF-28-2. NC2174.2 +189200 STR-FAIL-GF-28-2. NC2174.2 +189300 PERFORM FAIL NC2174.2 +189400 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +189500 MOVE 6 TO CORRECT-N. NC2174.2 +189600 STR-WRITE-GF-28-2. NC2174.2 +189700 PERFORM PRINT-DETAIL. NC2174.2 +189800* NC2174.2 +189900 STR-TEST-GF-28-3. NC2174.2 +190000 ADD 1 TO REC-CT. NC2174.2 +190100 IF WRK-XN-00001-1 = SPACE NC2174.2 +190200 PERFORM PASS NC2174.2 +190300 GO TO STR-WRITE-GF-28-3 NC2174.2 +190400 ELSE NC2174.2 +190500 GO TO STR-FAIL-GF-28-3. NC2174.2 +190600 STR-DELETE-GF-28-3. NC2174.2 +190700 PERFORM DE-LETE. NC2174.2 +190800 GO TO STR-WRITE-GF-28-3. NC2174.2 +190900 STR-FAIL-GF-28-3. NC2174.2 +191000 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +191100 MOVE SPACE TO CORRECT-X NC2174.2 +191200 MOVE "ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK NC2174.2 +191300 PERFORM FAIL. NC2174.2 +191400 STR-WRITE-GF-28-3. NC2174.2 +191500 PERFORM PRINT-DETAIL. NC2174.2 +191600* NC2174.2 +191700 STR-TEST-GF-28-4. NC2174.2 +191800 ADD 1 TO REC-CT. NC2174.2 +191900 IF WRK-XN-00001-2 = SPACE NC2174.2 +192000 PERFORM PASS NC2174.2 +192100 GO TO STR-WRITE-GF-28-4 NC2174.2 +192200 ELSE NC2174.2 +192300 GO TO STR-FAIL-GF-28-4. NC2174.2 +192400 STR-DELETE-GF-28-4. NC2174.2 +192500 PERFORM DE-LETE. NC2174.2 +192600 GO TO STR-WRITE-GF-28-4. NC2174.2 +192700 STR-FAIL-GF-28-4. NC2174.2 +192800 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +192900 MOVE SPACE TO CORRECT-X NC2174.2 +193000 MOVE "ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK NC2174.2 +193100 PERFORM FAIL. NC2174.2 +193200 STR-WRITE-GF-28-4. NC2174.2 +193300 PERFORM PRINT-DETAIL. NC2174.2 +193400* NC2174.2 +193500 STR-TEST-GF-28-5. NC2174.2 +193600 ADD 1 TO REC-CT. NC2174.2 +193700 IF WRK-XN-00001-3 = "Z" NC2174.2 +193800 PERFORM PASS NC2174.2 +193900 GO TO STR-WRITE-GF-28-5 NC2174.2 +194000 ELSE NC2174.2 +194100 GO TO STR-FAIL-GF-28-5. NC2174.2 +194200 STR-DELETE-GF-28-5. NC2174.2 +194300 PERFORM DE-LETE. NC2174.2 +194400 GO TO STR-WRITE-GF-28-5. NC2174.2 +194500 STR-FAIL-GF-28-5. NC2174.2 +194600 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +194700 MOVE "Z" TO CORRECT-X NC2174.2 +194800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +194900 PERFORM FAIL. NC2174.2 +195000 STR-WRITE-GF-28-5. NC2174.2 +195100 PERFORM PRINT-DETAIL. NC2174.2 +195200* NC2174.2 +195300 STR-INIT-GF-29. NC2174.2 +195400* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +195500 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +195600 MOVE "STR-TEST-GF-29" TO PAR-NAME. NC2174.2 +195700 MOVE "LIT DEL BY LIT" TO FEATURE. NC2174.2 +195800 MOVE "*****" TO ID7-XN-5. NC2174.2 +195900 MOVE 1 TO ID8-DU-2V0. NC2174.2 +196000 MOVE ZERO TO REC-CT. NC2174.2 +196100 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +196200 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +196300 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +196400* NC2174.2 +196500 STR-TEST-GF-29. NC2174.2 +196600 STRING "ABCDEF" DELIMITED BY "ABCDEFG" NC2174.2 +196700 INTO ID7-XN-5 WITH POINTER ID8-DU-2V0 NC2174.2 +196800 NOT ON OVERFLOW NC2174.2 +196900 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +197000 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +197100 END-STRING NC2174.2 +197200 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +197300 GO TO STR-TEST-GF-29-1. NC2174.2 +197400 STR-DELETE-GF-29. NC2174.2 +197500 PERFORM DE-LETE. NC2174.2 +197600 PERFORM PRINT-DETAIL. NC2174.2 +197700 GO TO STR-INIT-GF-30. NC2174.2 +197800* NC2174.2 +197900 STR-TEST-GF-29-1. NC2174.2 +198000 MOVE 1 TO REC-CT. NC2174.2 +198100 IF ID7-XN-5 = "ABCDE" NC2174.2 +198200 PERFORM PASS NC2174.2 +198300 GO TO STR-WRITE-GF-29-1 NC2174.2 +198400 ELSE NC2174.2 +198500 GO TO STR-FAIL-GF-29-1. NC2174.2 +198600 STR-DELETE-GF-29-1. NC2174.2 +198700 PERFORM DE-LETE. NC2174.2 +198800 GO TO STR-WRITE-GF-29-1. NC2174.2 +198900 STR-FAIL-GF-29-1. NC2174.2 +199000 PERFORM FAIL NC2174.2 +199100 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +199200 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +199300 STR-WRITE-GF-29-1. NC2174.2 +199400 PERFORM PRINT-DETAIL. NC2174.2 +199500* NC2174.2 +199600 STR-TEST-GF-29-2. NC2174.2 +199700 ADD 1 TO REC-CT. NC2174.2 +199800 IF ID8-DU-2V0 = 6 NC2174.2 +199900 PERFORM PASS NC2174.2 +200000 GO TO STR-WRITE-GF-29-2 NC2174.2 +200100 ELSE NC2174.2 +200200 GO TO STR-FAIL-GF-29-2. NC2174.2 +200300 STR-DELETE-GF-29-2. NC2174.2 +200400 PERFORM DE-LETE. NC2174.2 +200500 GO TO STR-WRITE-GF-29-2. NC2174.2 +200600 STR-FAIL-GF-29-2. NC2174.2 +200700 PERFORM FAIL NC2174.2 +200800 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +200900 MOVE 6 TO CORRECT-N. NC2174.2 +201000 STR-WRITE-GF-29-2. NC2174.2 +201100 PERFORM PRINT-DETAIL. NC2174.2 +201200* NC2174.2 +201300 STR-TEST-GF-29-3. NC2174.2 +201400 ADD 1 TO REC-CT. NC2174.2 +201500 IF WRK-XN-00001-1 = SPACE NC2174.2 +201600 PERFORM PASS NC2174.2 +201700 GO TO STR-WRITE-GF-29-3 NC2174.2 +201800 ELSE NC2174.2 +201900 GO TO STR-FAIL-GF-29-3. NC2174.2 +202000 STR-DELETE-GF-29-3. NC2174.2 +202100 PERFORM DE-LETE. NC2174.2 +202200 GO TO STR-WRITE-GF-29-3. NC2174.2 +202300 STR-FAIL-GF-29-3. NC2174.2 +202400 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +202500 MOVE SPACE TO CORRECT-X NC2174.2 +202600 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" NC2174.2 +202700 TO RE-MARK NC2174.2 +202800 PERFORM FAIL. NC2174.2 +202900 STR-WRITE-GF-29-3. NC2174.2 +203000 PERFORM PRINT-DETAIL. NC2174.2 +203100* NC2174.2 +203200 STR-TEST-GF-29-4. NC2174.2 +203300 ADD 1 TO REC-CT. NC2174.2 +203400 IF WRK-XN-00001-2 = SPACE NC2174.2 +203500 PERFORM PASS NC2174.2 +203600 GO TO STR-WRITE-GF-29-4 NC2174.2 +203700 ELSE NC2174.2 +203800 GO TO STR-FAIL-GF-29-4. NC2174.2 +203900 STR-DELETE-GF-29-4. NC2174.2 +204000 PERFORM DE-LETE. NC2174.2 +204100 GO TO STR-WRITE-GF-29-4. NC2174.2 +204200 STR-FAIL-GF-29-4. NC2174.2 +204300 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +204400 MOVE SPACE TO CORRECT-X NC2174.2 +204500 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" NC2174.2 +204600 TO RE-MARK NC2174.2 +204700 PERFORM FAIL. NC2174.2 +204800 STR-WRITE-GF-29-4. NC2174.2 +204900 PERFORM PRINT-DETAIL. NC2174.2 +205000* NC2174.2 +205100 STR-TEST-GF-29-5. NC2174.2 +205200 ADD 1 TO REC-CT. NC2174.2 +205300 IF WRK-XN-00001-3 = "Z" NC2174.2 +205400 PERFORM PASS NC2174.2 +205500 GO TO STR-WRITE-GF-29-5 NC2174.2 +205600 ELSE NC2174.2 +205700 GO TO STR-FAIL-GF-29-5. NC2174.2 +205800 STR-DELETE-GF-29-5. NC2174.2 +205900 PERFORM DE-LETE. NC2174.2 +206000 GO TO STR-WRITE-GF-29-5. NC2174.2 +206100 STR-FAIL-GF-29-5. NC2174.2 +206200 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +206300 MOVE "Z" TO CORRECT-X NC2174.2 +206400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +206500 PERFORM FAIL. NC2174.2 +206600 STR-WRITE-GF-29-5. NC2174.2 +206700 PERFORM PRINT-DETAIL. NC2174.2 +206800* NC2174.2 +206900 STR-INIT-GF-30. NC2174.2 +207000* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2174.2 +207100 MOVE "VI-132 6.24.4 GR9, 10" TO ANSI-REFERENCE. NC2174.2 +207200 MOVE "STR-TEST-GF-30" TO PAR-NAME. NC2174.2 +207300 MOVE "LITERAL SERIES" TO FEATURE. NC2174.2 +207400 MOVE "*****" TO ID7-XN-5. NC2174.2 +207500 MOVE 1 TO ID8-DU-2V0. NC2174.2 +207600 MOVE ZERO TO REC-CT. NC2174.2 +207700 MOVE SPACE TO WRK-XN-00001-1. NC2174.2 +207800 MOVE SPACE TO WRK-XN-00001-2. NC2174.2 +207900 MOVE SPACE TO WRK-XN-00001-3. NC2174.2 +208000* NC2174.2 +208100 STR-TEST-GF-30. NC2174.2 +208200 STRING "A" "B" "C" "D" "E" DELIMITED "ABCDE" INTO ID7-XN-5 NC2174.2 +208300 POINTER ID8-DU-2V0 NC2174.2 +208400 NOT ON OVERFLOW NC2174.2 +208500 MOVE "A" TO WRK-XN-00001-1 NC2174.2 +208600 MOVE "B" TO WRK-XN-00001-2 NC2174.2 +208700 END-STRING NC2174.2 +208800 MOVE "Z" TO WRK-XN-00001-3. NC2174.2 +208900 GO TO STR-TEST-GF-30-1. NC2174.2 +209000 STR-DELETE-GF-30. NC2174.2 +209100 PERFORM DE-LETE. NC2174.2 +209200 PERFORM PRINT-DETAIL. NC2174.2 +209300 GO TO CCVS-EXIT. NC2174.2 +209400* NC2174.2 +209500 STR-TEST-GF-30-1. NC2174.2 +209600 MOVE 1 TO REC-CT. NC2174.2 +209700 IF ID7-XN-5 = "ABCDE" NC2174.2 +209800 PERFORM PASS NC2174.2 +209900 GO TO STR-WRITE-GF-30-1 NC2174.2 +210000 ELSE NC2174.2 +210100 GO TO STR-FAIL-GF-30-1. NC2174.2 +210200 STR-DELETE-GF-30-1. NC2174.2 +210300 PERFORM DE-LETE. NC2174.2 +210400 GO TO STR-WRITE-GF-30-1. NC2174.2 +210500 STR-FAIL-GF-30-1. NC2174.2 +210600 PERFORM FAIL NC2174.2 +210700 MOVE ID7-XN-5 TO COMPUTED-A NC2174.2 +210800 MOVE "ABCDE" TO CORRECT-A. NC2174.2 +210900 STR-WRITE-GF-30-1. NC2174.2 +211000 PERFORM PRINT-DETAIL. NC2174.2 +211100* NC2174.2 +211200 STR-TEST-GF-30-2. NC2174.2 +211300 ADD 1 TO REC-CT. NC2174.2 +211400 IF ID8-DU-2V0 = 6 NC2174.2 +211500 PERFORM PASS NC2174.2 +211600 GO TO STR-WRITE-GF-30-2 NC2174.2 +211700 ELSE NC2174.2 +211800 GO TO STR-FAIL-GF-30-2. NC2174.2 +211900 STR-DELETE-GF-30-2. NC2174.2 +212000 PERFORM DE-LETE. NC2174.2 +212100 GO TO STR-WRITE-GF-30-2. NC2174.2 +212200 STR-FAIL-GF-30-2. NC2174.2 +212300 PERFORM FAIL NC2174.2 +212400 MOVE ID8-DU-2V0 TO COMPUTED-N NC2174.2 +212500 MOVE 6 TO CORRECT-N. NC2174.2 +212600 STR-WRITE-GF-30-2. NC2174.2 +212700 PERFORM PRINT-DETAIL. NC2174.2 +212800* NC2174.2 +212900 STR-TEST-GF-30-3. NC2174.2 +213000 ADD 1 TO REC-CT. NC2174.2 +213100 IF WRK-XN-00001-1 = "A" NC2174.2 +213200 PERFORM PASS NC2174.2 +213300 GO TO STR-WRITE-GF-30-3 NC2174.2 +213400 ELSE NC2174.2 +213500 GO TO STR-FAIL-GF-30-3. NC2174.2 +213600 STR-DELETE-GF-30-3. NC2174.2 +213700 PERFORM DE-LETE. NC2174.2 +213800 GO TO STR-WRITE-GF-30-3. NC2174.2 +213900 STR-FAIL-GF-30-3. NC2174.2 +214000 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2174.2 +214100 MOVE "A" TO CORRECT-X NC2174.2 +214200 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" NC2174.2 +214300 TO RE-MARK NC2174.2 +214400 PERFORM FAIL. NC2174.2 +214500 STR-WRITE-GF-30-3. NC2174.2 +214600 PERFORM PRINT-DETAIL. NC2174.2 +214700* NC2174.2 +214800 STR-TEST-GF-30-4. NC2174.2 +214900 ADD 1 TO REC-CT. NC2174.2 +215000 IF WRK-XN-00001-2 = "B" NC2174.2 +215100 PERFORM PASS NC2174.2 +215200 GO TO STR-WRITE-GF-30-4 NC2174.2 +215300 ELSE NC2174.2 +215400 GO TO STR-FAIL-GF-30-4. NC2174.2 +215500 STR-DELETE-GF-30-4. NC2174.2 +215600 PERFORM DE-LETE. NC2174.2 +215700 GO TO STR-WRITE-GF-30-4. NC2174.2 +215800 STR-FAIL-GF-30-4. NC2174.2 +215900 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2174.2 +216000 MOVE "B" TO CORRECT-X NC2174.2 +216100 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" NC2174.2 +216200 TO RE-MARK NC2174.2 +216300 PERFORM FAIL. NC2174.2 +216400 STR-WRITE-GF-30-4. NC2174.2 +216500 PERFORM PRINT-DETAIL. NC2174.2 +216600* NC2174.2 +216700 STR-TEST-GF-30-5. NC2174.2 +216800 ADD 1 TO REC-CT. NC2174.2 +216900 IF WRK-XN-00001-3 = "Z" NC2174.2 +217000 PERFORM PASS NC2174.2 +217100 GO TO STR-WRITE-GF-30-5 NC2174.2 +217200 ELSE NC2174.2 +217300 GO TO STR-FAIL-GF-30-5. NC2174.2 +217400 STR-DELETE-GF-30-5. NC2174.2 +217500 PERFORM DE-LETE. NC2174.2 +217600 GO TO STR-WRITE-GF-30-5. NC2174.2 +217700 STR-FAIL-GF-30-5. NC2174.2 +217800 MOVE WRK-XN-00001-3 TO COMPUTED-X NC2174.2 +217900 MOVE "Z" TO CORRECT-X NC2174.2 +218000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2174.2 +218100 PERFORM FAIL. NC2174.2 +218200 STR-WRITE-GF-30-5. NC2174.2 +218300 PERFORM PRINT-DETAIL. NC2174.2 +218400* NC2174.2 +218500 CCVS-EXIT SECTION. NC2174.2 +218600 CCVS-999999. NC2174.2 +218700 GO TO CLOSE-FILES. NC2174.2 diff --git a/tests/cobol85/NC/NC218A.CBL b/tests/cobol85/NC/NC218A.CBL new file mode 100755 index 00000000..78992f64 --- /dev/null +++ b/tests/cobol85/NC/NC218A.CBL @@ -0,0 +1,3077 @@ +000100 IDENTIFICATION DIVISION. NC2184.2 +000200 PROGRAM-ID. NC2184.2 +000300 NC218A. NC2184.2 +000400**************************************************************** NC2184.2 +000500* * NC2184.2 +000600* VALIDATION FOR:- * NC2184.2 +000700* * NC2184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2184.2 +000900* * NC2184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2184.2 +001100* * NC2184.2 +001200**************************************************************** NC2184.2 +001300* * NC2184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2184.2 +001500* * NC2184.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2184.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2184.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2184.2 +001900* * NC2184.2 +002000**************************************************************** NC2184.2 +002100* * NC2184.2 +002200* PROGRAM NC218A TESTS TYHE USE OF THE "UNSTRING" STATEMENT * NC2184.2 +002300* INCLUDING THE OPTIONAL PHRASES "POINTER", "TALLYING", * NC2184.2 +002400* "OVERFLOW", "NOT OVERFLOW" AND "END-STRING". * NC2184.2 +002500* * NC2184.2 +002600**************************************************************** NC2184.2 +002700 ENVIRONMENT DIVISION. NC2184.2 +002800 CONFIGURATION SECTION. NC2184.2 +002900 SOURCE-COMPUTER. NC2184.2 +003000 Linux. NC2184.2 +003100 OBJECT-COMPUTER. NC2184.2 +003200 Linux. NC2184.2 +003300 INPUT-OUTPUT SECTION. NC2184.2 +003400 FILE-CONTROL. NC2184.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2184.2 +003600 "report.log". NC2184.2 +003700 DATA DIVISION. NC2184.2 +003800 FILE SECTION. NC2184.2 +003900 FD PRINT-FILE. NC2184.2 +004000 01 PRINT-REC PICTURE X(120). NC2184.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2184.2 +004200 WORKING-STORAGE SECTION. NC2184.2 +004300 01 WRK-XN-00001-1 PIC X. NC2184.2 +004400 01 WRK-XN-00001-2 PIC X. NC2184.2 +004500 01 WRK-XN-00001-3 PIC X. NC2184.2 +004600 01 ZERO-XN-1 PIC X VALUE "0". NC2184.2 +004700 01 GRP1-XN-6 PIC X(6) VALUE "ABCDEF". NC2184.2 +004800 01 ID1-XN-7 PIC X(7) VALUE "1200000". NC2184.2 +004900 01 GRP1-XN-7 PIC X(7) VALUE "ABCDEFG". NC2184.2 +005000 01 GRP1-XN-10 PIC X(10) VALUE "ABCDEFGHIJ". NC2184.2 +005100 01 ID1-XN-12 PIC X(12) VALUE "ABCDEFGHIJKL". NC2184.2 +005200 01 GRP1-XN-36 PIC X(36) VALUE NC2184.2 +005300 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789". NC2184.2 +005400 01 GRP1-XN-X-36 REDEFINES GRP1-XN-36. NC2184.2 +005500 10 ID1 PIC X(6) OCCURS 6 TIMES. NC2184.2 +005600 01 GRP2-XN-2 PIC XX VALUE "CE". NC2184.2 +005700 01 GRP2-XN-X-2 REDEFINES GRP2-XN-2. NC2184.2 +005800 10 ID2A PIC X OCCURS 2 TIMES. NC2184.2 +005900 01 GRP2-XN-7 PIC X(7) VALUE "BCDEFGH". NC2184.2 +006000 01 GRP2-XN-X-7 REDEFINES GRP2-XN-7. NC2184.2 +006100 10 ID2 PIC X OCCURS 7 TIMES. NC2184.2 +006200 01 ID4-X PIC X VALUE SPACE. NC2184.2 +006300 01 ID4-XJ PIC X JUSTIFIED RIGHT VALUE SPACE. NC2184.2 +006400 01 ID4-XXX PIC XXX VALUE SPACES. NC2184.2 +006500 01 ID4-XXXJ PIC XXX JUST RIGHT VALUE SPACES. NC2184.2 +006600 01 ID4-DU-1V0 PIC 9 VALUE ZERO. NC2184.2 +006700 01 ID4-DS-1V0 PIC S9 VALUE ZERO. NC2184.2 +006800 01 ID4-DU-2V0 PIC 99 VALUE ZERO. NC2184.2 +006900 01 ID4-DS-2V0 PIC S99 VALUE ZERO. NC2184.2 +007000 01 ID4-DS-TS-1V0 PIC S9 TRAILING VALUE ZERO. NC2184.2 +007100 01 ID4-DS-LS-1V0 PIC S9 LEADING VALUE ZERO. NC2184.2 +007200 01 GRP4-XN-6. NC2184.2 +007300 10 ID4A-XXXXX PIC X(5). NC2184.2 +007400 10 ID4B-X PIC X. NC2184.2 +007500 01 ID4C-XXXX PIC X(4) VALUE SPACES. NC2184.2 +007600 01 ID4D-X PIC X VALUE SPACE. NC2184.2 +007700 01 GRP4-XN-10. NC2184.2 +007800 10 ID4A-X PIC X. NC2184.2 +007900 10 ID4B-XX PIC XX. NC2184.2 +008000 10 ID4C-XXX PIC XXX. NC2184.2 +008100 10 ID4D-XXXX PIC XXXX. NC2184.2 +008200 01 ASTER-XN-4 PIC X(4) VALUE "****". NC2184.2 +008300 01 ID5-XN-4 PIC X(4) VALUE SPACES. NC2184.2 +008400 01 ID5-XN-4-2 PIC X(4) VALUE SPACES. NC2184.2 +008500 01 ID5-XN-6 PIC X(6) VALUE SPACES. NC2184.2 +008600 01 ID6-DU-2V0 PIC 99 VALUE ZERO. NC2184.2 +008700 01 ID6-DU-2V0-2 PIC 99 VALUE ZERO. NC2184.2 +008800 01 ID10-DU-2V0 PIC 99 VALUE ZERO. NC2184.2 +008900 01 ID11-DU-2V0 PIC 99 VALUE ZERO. NC2184.2 +009000 01 TEST-RESULTS. NC2184.2 +009100 02 FILLER PIC X VALUE SPACE. NC2184.2 +009200 02 FEATURE PIC X(20) VALUE SPACE. NC2184.2 +009300 02 FILLER PIC X VALUE SPACE. NC2184.2 +009400 02 P-OR-F PIC X(5) VALUE SPACE. NC2184.2 +009500 02 FILLER PIC X VALUE SPACE. NC2184.2 +009600 02 PAR-NAME. NC2184.2 +009700 03 FILLER PIC X(19) VALUE SPACE. NC2184.2 +009800 03 PARDOT-X PIC X VALUE SPACE. NC2184.2 +009900 03 DOTVALUE PIC 99 VALUE ZERO. NC2184.2 +010000 02 FILLER PIC X(8) VALUE SPACE. NC2184.2 +010100 02 RE-MARK PIC X(61). NC2184.2 +010200 01 TEST-COMPUTED. NC2184.2 +010300 02 FILLER PIC X(30) VALUE SPACE. NC2184.2 +010400 02 FILLER PIC X(17) VALUE NC2184.2 +010500 " COMPUTED=". NC2184.2 +010600 02 COMPUTED-X. NC2184.2 +010700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2184.2 +010800 03 COMPUTED-N REDEFINES COMPUTED-A NC2184.2 +010900 PIC -9(9).9(9). NC2184.2 +011000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2184.2 +011100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2184.2 +011200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2184.2 +011300 03 CM-18V0 REDEFINES COMPUTED-A. NC2184.2 +011400 04 COMPUTED-18V0 PIC -9(18). NC2184.2 +011500 04 FILLER PIC X. NC2184.2 +011600 03 FILLER PIC X(50) VALUE SPACE. NC2184.2 +011700 01 TEST-CORRECT. NC2184.2 +011800 02 FILLER PIC X(30) VALUE SPACE. NC2184.2 +011900 02 FILLER PIC X(17) VALUE " CORRECT =". NC2184.2 +012000 02 CORRECT-X. NC2184.2 +012100 03 CORRECT-A PIC X(20) VALUE SPACE. NC2184.2 +012200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2184.2 +012300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2184.2 +012400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2184.2 +012500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2184.2 +012600 03 CR-18V0 REDEFINES CORRECT-A. NC2184.2 +012700 04 CORRECT-18V0 PIC -9(18). NC2184.2 +012800 04 FILLER PIC X. NC2184.2 +012900 03 FILLER PIC X(2) VALUE SPACE. NC2184.2 +013000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2184.2 +013100 01 CCVS-C-1. NC2184.2 +013200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2184.2 +013300- "SS PARAGRAPH-NAME NC2184.2 +013400- " REMARKS". NC2184.2 +013500 02 FILLER PIC X(20) VALUE SPACE. NC2184.2 +013600 01 CCVS-C-2. NC2184.2 +013700 02 FILLER PIC X VALUE SPACE. NC2184.2 +013800 02 FILLER PIC X(6) VALUE "TESTED". NC2184.2 +013900 02 FILLER PIC X(15) VALUE SPACE. NC2184.2 +014000 02 FILLER PIC X(4) VALUE "FAIL". NC2184.2 +014100 02 FILLER PIC X(94) VALUE SPACE. NC2184.2 +014200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2184.2 +014300 01 REC-CT PIC 99 VALUE ZERO. NC2184.2 +014400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2184.2 +014500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2184.2 +014600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2184.2 +014700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2184.2 +014800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2184.2 +014900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2184.2 +015000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2184.2 +015100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2184.2 +015200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2184.2 +015300 01 CCVS-H-1. NC2184.2 +015400 02 FILLER PIC X(39) VALUE SPACES. NC2184.2 +015500 02 FILLER PIC X(42) VALUE NC2184.2 +015600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2184.2 +015700 02 FILLER PIC X(39) VALUE SPACES. NC2184.2 +015800 01 CCVS-H-2A. NC2184.2 +015900 02 FILLER PIC X(40) VALUE SPACE. NC2184.2 +016000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2184.2 +016100 02 FILLER PIC XXXX VALUE NC2184.2 +016200 "4.2 ". NC2184.2 +016300 02 FILLER PIC X(28) VALUE NC2184.2 +016400 " COPY - NOT FOR DISTRIBUTION". NC2184.2 +016500 02 FILLER PIC X(41) VALUE SPACE. NC2184.2 +016600 NC2184.2 +016700 01 CCVS-H-2B. NC2184.2 +016800 02 FILLER PIC X(15) VALUE NC2184.2 +016900 "TEST RESULT OF ". NC2184.2 +017000 02 TEST-ID PIC X(9). NC2184.2 +017100 02 FILLER PIC X(4) VALUE NC2184.2 +017200 " IN ". NC2184.2 +017300 02 FILLER PIC X(12) VALUE NC2184.2 +017400 " HIGH ". NC2184.2 +017500 02 FILLER PIC X(22) VALUE NC2184.2 +017600 " LEVEL VALIDATION FOR ". NC2184.2 +017700 02 FILLER PIC X(58) VALUE NC2184.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2184.2 +017900 01 CCVS-H-3. NC2184.2 +018000 02 FILLER PIC X(34) VALUE NC2184.2 +018100 " FOR OFFICIAL USE ONLY ". NC2184.2 +018200 02 FILLER PIC X(58) VALUE NC2184.2 +018300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2184.2 +018400 02 FILLER PIC X(28) VALUE NC2184.2 +018500 " COPYRIGHT 1985 ". NC2184.2 +018600 01 CCVS-E-1. NC2184.2 +018700 02 FILLER PIC X(52) VALUE SPACE. NC2184.2 +018800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2184.2 +018900 02 ID-AGAIN PIC X(9). NC2184.2 +019000 02 FILLER PIC X(45) VALUE SPACES. NC2184.2 +019100 01 CCVS-E-2. NC2184.2 +019200 02 FILLER PIC X(31) VALUE SPACE. NC2184.2 +019300 02 FILLER PIC X(21) VALUE SPACE. NC2184.2 +019400 02 CCVS-E-2-2. NC2184.2 +019500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2184.2 +019600 03 FILLER PIC X VALUE SPACE. NC2184.2 +019700 03 ENDER-DESC PIC X(44) VALUE NC2184.2 +019800 "ERRORS ENCOUNTERED". NC2184.2 +019900 01 CCVS-E-3. NC2184.2 +020000 02 FILLER PIC X(22) VALUE NC2184.2 +020100 " FOR OFFICIAL USE ONLY". NC2184.2 +020200 02 FILLER PIC X(12) VALUE SPACE. NC2184.2 +020300 02 FILLER PIC X(58) VALUE NC2184.2 +020400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2184.2 +020500 02 FILLER PIC X(13) VALUE SPACE. NC2184.2 +020600 02 FILLER PIC X(15) VALUE NC2184.2 +020700 " COPYRIGHT 1985". NC2184.2 +020800 01 CCVS-E-4. NC2184.2 +020900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2184.2 +021000 02 FILLER PIC X(4) VALUE " OF ". NC2184.2 +021100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2184.2 +021200 02 FILLER PIC X(40) VALUE NC2184.2 +021300 " TESTS WERE EXECUTED SUCCESSFULLY". NC2184.2 +021400 01 XXINFO. NC2184.2 +021500 02 FILLER PIC X(19) VALUE NC2184.2 +021600 "*** INFORMATION ***". NC2184.2 +021700 02 INFO-TEXT. NC2184.2 +021800 04 FILLER PIC X(8) VALUE SPACE. NC2184.2 +021900 04 XXCOMPUTED PIC X(20). NC2184.2 +022000 04 FILLER PIC X(5) VALUE SPACE. NC2184.2 +022100 04 XXCORRECT PIC X(20). NC2184.2 +022200 02 INF-ANSI-REFERENCE PIC X(48). NC2184.2 +022300 01 HYPHEN-LINE. NC2184.2 +022400 02 FILLER PIC IS X VALUE IS SPACE. NC2184.2 +022500 02 FILLER PIC IS X(65) VALUE IS "************************NC2184.2 +022600- "*****************************************". NC2184.2 +022700 02 FILLER PIC IS X(54) VALUE IS "************************NC2184.2 +022800- "******************************". NC2184.2 +022900 01 CCVS-PGM-ID PIC X(9) VALUE NC2184.2 +023000 "NC218A". NC2184.2 +023100 PROCEDURE DIVISION. NC2184.2 +023200 CCVS1 SECTION. NC2184.2 +023300 OPEN-FILES. NC2184.2 +023400 OPEN OUTPUT PRINT-FILE. NC2184.2 +023500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2184.2 +023600 MOVE SPACE TO TEST-RESULTS. NC2184.2 +023700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2184.2 +023800 GO TO CCVS1-EXIT. NC2184.2 +023900 CLOSE-FILES. NC2184.2 +024000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2184.2 +024100 TERMINATE-CCVS. NC2184.2 +024200*S EXIT PROGRAM. NC2184.2 +024300*SERMINATE-CALL. NC2184.2 +024400 STOP RUN. NC2184.2 +024500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2184.2 +024600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2184.2 +024700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2184.2 +024800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2184.2 +024900 MOVE "****TEST DELETED****" TO RE-MARK. NC2184.2 +025000 PRINT-DETAIL. NC2184.2 +025100 IF REC-CT NOT EQUAL TO ZERO NC2184.2 +025200 MOVE "." TO PARDOT-X NC2184.2 +025300 MOVE REC-CT TO DOTVALUE. NC2184.2 +025400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2184.2 +025500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2184.2 +025600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2184.2 +025700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2184.2 +025800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2184.2 +025900 MOVE SPACE TO CORRECT-X. NC2184.2 +026000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2184.2 +026100 MOVE SPACE TO RE-MARK. NC2184.2 +026200 HEAD-ROUTINE. NC2184.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +026400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +026500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2184.2 +026600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2184.2 +026700 COLUMN-NAMES-ROUTINE. NC2184.2 +026800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +026900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +027100 END-ROUTINE. NC2184.2 +027200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2184.2 +027300 END-RTN-EXIT. NC2184.2 +027400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +027500 END-ROUTINE-1. NC2184.2 +027600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2184.2 +027700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2184.2 +027800 ADD PASS-COUNTER TO ERROR-HOLD. NC2184.2 +027900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2184.2 +028000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2184.2 +028100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2184.2 +028200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2184.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2184.2 +028400 END-ROUTINE-12. NC2184.2 +028500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2184.2 +028600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2184.2 +028700 MOVE "NO " TO ERROR-TOTAL NC2184.2 +028800 ELSE NC2184.2 +028900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2184.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2184.2 +029100 PERFORM WRITE-LINE. NC2184.2 +029200 END-ROUTINE-13. NC2184.2 +029300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2184.2 +029400 MOVE "NO " TO ERROR-TOTAL ELSE NC2184.2 +029500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2184.2 +029600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2184.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +029800 IF INSPECT-COUNTER EQUAL TO ZERO NC2184.2 +029900 MOVE "NO " TO ERROR-TOTAL NC2184.2 +030000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2184.2 +030100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2184.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +030300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2184.2 +030400 WRITE-LINE. NC2184.2 +030500 ADD 1 TO RECORD-COUNT. NC2184.2 +030600 IF RECORD-COUNT GREATER 50 NC2184.2 +030700 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2184.2 +030800 MOVE SPACE TO DUMMY-RECORD NC2184.2 +030900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2184.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2184.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2184.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2184.2 +031300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2184.2 +031400 MOVE ZERO TO RECORD-COUNT. NC2184.2 +031500 PERFORM WRT-LN. NC2184.2 +031600 WRT-LN. NC2184.2 +031700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2184.2 +031800 MOVE SPACE TO DUMMY-RECORD. NC2184.2 +031900 BLANK-LINE-PRINT. NC2184.2 +032000 PERFORM WRT-LN. NC2184.2 +032100 FAIL-ROUTINE. NC2184.2 +032200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2184.2 +032300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2184.2 +032400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2184.2 +032500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2184.2 +032600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +032700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2184.2 +032800 GO TO FAIL-ROUTINE-EX. NC2184.2 +032900 FAIL-ROUTINE-WRITE. NC2184.2 +033000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2184.2 +033100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2184.2 +033200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2184.2 +033300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2184.2 +033400 FAIL-ROUTINE-EX. EXIT. NC2184.2 +033500 BAIL-OUT. NC2184.2 +033600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2184.2 +033700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2184.2 +033800 BAIL-OUT-WRITE. NC2184.2 +033900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2184.2 +034000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2184.2 +034100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2184.2 +034200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2184.2 +034300 BAIL-OUT-EX. EXIT. NC2184.2 +034400 CCVS1-EXIT. NC2184.2 +034500 EXIT. NC2184.2 +034600 SECT-NC218A-001 SECTION. NC2184.2 +034700 NC2184.2 +034800 UST-INIT-GF-1. NC2184.2 +034900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +035000 MOVE "UST-TEST-GF-1" TO PAR-NAME. NC2184.2 +035100 MOVE "PIC X " TO FEATURE. NC2184.2 +035200 MOVE ZERO TO ID4-X. NC2184.2 +035300 MOVE "1200000" TO ID1-XN-7. NC2184.2 +035400 MOVE "****" TO ID5-XN-4. NC2184.2 +035500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +035600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +035700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +035800 MOVE 1 TO REC-CT. NC2184.2 +035900 UST-TEST-GF-1. NC2184.2 +036000 UNSTRING ID1-XN-7 DELIMITED BY ZERO NC2184.2 +036100 INTO ID4-X DELIMITER IN ID5-XN-4 NC2184.2 +036200 COUNT IN ID6-DU-2V0 NC2184.2 +036300 WITH POINTER ID10-DU-2V0 NC2184.2 +036400 TALLYING ID11-DU-2V0 NC2184.2 +036500 ON OVERFLOW PERFORM PASS NC2184.2 +036600 GO TO UST-WRITE-GF-1. NC2184.2 +036700 GO TO UST-FAIL-GF-1. NC2184.2 +036800 UST-DELETE-GF-1. NC2184.2 +036900 PERFORM DE-LETE. NC2184.2 +037000 PERFORM PRINT-DETAIL. NC2184.2 +037100 GO TO UST-INIT-GF-2. NC2184.2 +037200 UST-FAIL-GF-1. NC2184.2 +037300 PERFORM FAIL. NC2184.2 +037400 MOVE "OVERFLOW SHOULD OCCUR" TO RE-MARK. NC2184.2 +037500 UST-WRITE-GF-1. NC2184.2 +037600 PERFORM PRINT-DETAIL. NC2184.2 +037700* NC2184.2 +037800 UST-TEST-GF-1-1. NC2184.2 +037900 ADD 1 TO REC-CT. NC2184.2 +038000 IF ID4-X = "1" NC2184.2 +038100 PERFORM PASS NC2184.2 +038200 GO TO UST-WRITE-GF-1-1 NC2184.2 +038300 ELSE NC2184.2 +038400 GO TO UST-FAIL-GF-1-1. NC2184.2 +038500 UST-DELETE-GF-1-1. NC2184.2 +038600 PERFORM DE-LETE. NC2184.2 +038700 GO TO UST-WRITE-GF-1-1. NC2184.2 +038800 UST-FAIL-GF-1-1. NC2184.2 +038900 PERFORM FAIL NC2184.2 +039000 MOVE ID4-X TO COMPUTED-A NC2184.2 +039100 MOVE "1" TO CORRECT-A. NC2184.2 +039200 UST-WRITE-GF-1-1. NC2184.2 +039300 PERFORM PRINT-DETAIL. NC2184.2 +039400* NC2184.2 +039500 UST-TEST-GF-1-2. NC2184.2 +039600 ADD 1 TO REC-CT. NC2184.2 +039700 IF ID5-XN-4 = "0 " NC2184.2 +039800 PERFORM PASS NC2184.2 +039900 GO TO UST-WRITE-GF-1-2 NC2184.2 +040000 ELSE NC2184.2 +040100 GO TO UST-FAIL-GF-1-2. NC2184.2 +040200 UST-DELETE-GF-1-2. NC2184.2 +040300 PERFORM DE-LETE. NC2184.2 +040400 GO TO UST-WRITE-GF-1-2. NC2184.2 +040500 UST-FAIL-GF-1-2. NC2184.2 +040600 PERFORM FAIL NC2184.2 +040700 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +040800 MOVE "0 " TO CORRECT-A. NC2184.2 +040900 UST-WRITE-GF-1-2. NC2184.2 +041000 PERFORM PRINT-DETAIL. NC2184.2 +041100* NC2184.2 +041200 UST-TEST-GF-1-3. NC2184.2 +041300 ADD 1 TO REC-CT. NC2184.2 +041400 IF ID6-DU-2V0 = 2 NC2184.2 +041500 PERFORM PASS NC2184.2 +041600 GO TO UST-WRITE-GF-1-3 NC2184.2 +041700 ELSE NC2184.2 +041800 GO TO UST-FAIL-GF-1-3. NC2184.2 +041900 UST-DELETE-GF-1-3. NC2184.2 +042000 PERFORM DE-LETE. NC2184.2 +042100 GO TO UST-WRITE-GF-1-3. NC2184.2 +042200 UST-FAIL-GF-1-3. NC2184.2 +042300 PERFORM FAIL NC2184.2 +042400 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +042500 MOVE 2 TO CORRECT-N. NC2184.2 +042600 UST-WRITE-GF-1-3. NC2184.2 +042700 PERFORM PRINT-DETAIL. NC2184.2 +042800* NC2184.2 +042900 UST-TEST-GF-1-4. NC2184.2 +043000 ADD 1 TO REC-CT. NC2184.2 +043100 IF ID10-DU-2V0 = 4 NC2184.2 +043200 PERFORM PASS NC2184.2 +043300 GO TO UST-WRITE-GF-1-4 NC2184.2 +043400 ELSE NC2184.2 +043500 GO TO UST-FAIL-GF-1-4. NC2184.2 +043600 UST-DELETE-GF-1-4. NC2184.2 +043700 PERFORM DE-LETE. NC2184.2 +043800 GO TO UST-WRITE-GF-1-4. NC2184.2 +043900 UST-FAIL-GF-1-4. NC2184.2 +044000 PERFORM FAIL NC2184.2 +044100 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +044200 MOVE 4 TO CORRECT-N. NC2184.2 +044300 UST-WRITE-GF-1-4. NC2184.2 +044400 PERFORM PRINT-DETAIL. NC2184.2 +044500* NC2184.2 +044600 UST-TEST-GF-1-5. NC2184.2 +044700 ADD 1 TO REC-CT. NC2184.2 +044800 IF ID11-DU-2V0 = 1 NC2184.2 +044900 PERFORM PASS NC2184.2 +045000 GO TO UST-WRITE-GF-1-5 NC2184.2 +045100 ELSE NC2184.2 +045200 GO TO UST-FAIL-GF-1-5. NC2184.2 +045300 UST-DELETE-GF-1-5. NC2184.2 +045400 PERFORM DE-LETE. NC2184.2 +045500 GO TO UST-WRITE-GF-1-5. NC2184.2 +045600 UST-FAIL-GF-1-5. NC2184.2 +045700 PERFORM FAIL NC2184.2 +045800 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +045900 MOVE 1 TO CORRECT-N. NC2184.2 +046000 UST-WRITE-GF-1-5. NC2184.2 +046100 PERFORM PRINT-DETAIL. NC2184.2 +046200* NC2184.2 +046300 UST-INIT-GF-2. NC2184.2 +046400 MOVE "UST-TEST-GF-2" TO PAR-NAME. NC2184.2 +046500 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +046600 MOVE "PIC X JUST" TO FEATURE. NC2184.2 +046700 MOVE "1200000" TO ID1-XN-7. NC2184.2 +046800 MOVE ZERO TO ID4-XJ. NC2184.2 +046900 MOVE "****" TO ID5-XN-4. NC2184.2 +047000 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +047100 MOVE 1 TO ID10-DU-2V0. NC2184.2 +047200 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +047300 MOVE 1 TO REC-CT. NC2184.2 +047400* NC2184.2 +047500 UST-TEST-GF-2. NC2184.2 +047600 UNSTRING ID1-XN-7 DELIMITED ZERO INTO ID4-XJ NC2184.2 +047700 DELIMITER ID5-XN-4 NC2184.2 +047800 COUNT ID6-DU-2V0 NC2184.2 +047900 POINTER ID10-DU-2V0 NC2184.2 +048000 TALLYING ID11-DU-2V0 NC2184.2 +048100 OVERFLOW PERFORM PASS NC2184.2 +048200 GO TO UST-WRITE-GF-2. NC2184.2 +048300 GO TO UST-FAIL-GF-2. NC2184.2 +048400 UST-DELETE-GF-2. NC2184.2 +048500 PERFORM DE-LETE. NC2184.2 +048600 PERFORM PRINT-DETAIL. NC2184.2 +048700 GO TO UST-INIT-GF-3. NC2184.2 +048800 UST-FAIL-GF-2. NC2184.2 +048900 PERFORM FAIL. NC2184.2 +049000 MOVE "OVERFLOW SHOULD HAVE OCCURED" TO RE-MARK. NC2184.2 +049100 UST-WRITE-GF-2. NC2184.2 +049200 PERFORM PRINT-DETAIL. NC2184.2 +049300* NC2184.2 +049400 UST-TEST-GF-2-1. NC2184.2 +049500 ADD 1 TO REC-CT. NC2184.2 +049600 IF ID4-XJ = "2" NC2184.2 +049700 PERFORM PASS NC2184.2 +049800 GO TO UST-WRITE-GF-2-1 NC2184.2 +049900 ELSE NC2184.2 +050000 GO TO UST-FAIL-GF-2-1. NC2184.2 +050100 UST-DELETE-GF-2-1. NC2184.2 +050200 PERFORM DE-LETE. NC2184.2 +050300 GO TO UST-WRITE-GF-2-1. NC2184.2 +050400 UST-FAIL-GF-2-1. NC2184.2 +050500 PERFORM FAIL NC2184.2 +050600 MOVE ID4-XJ TO COMPUTED-A NC2184.2 +050700 MOVE "2" TO CORRECT-A. NC2184.2 +050800 UST-WRITE-GF-2-1. NC2184.2 +050900 PERFORM PRINT-DETAIL. NC2184.2 +051000* NC2184.2 +051100 UST-TEST-GF-2-2. NC2184.2 +051200 ADD 1 TO REC-CT. NC2184.2 +051300 IF ID5-XN-4 = "0 " NC2184.2 +051400 PERFORM PASS NC2184.2 +051500 GO TO UST-WRITE-GF-2-2 NC2184.2 +051600 ELSE NC2184.2 +051700 GO TO UST-FAIL-GF-2-2. NC2184.2 +051800 UST-DELETE-GF-2-2. NC2184.2 +051900 PERFORM DE-LETE. NC2184.2 +052000 GO TO UST-WRITE-GF-2-2. NC2184.2 +052100 UST-FAIL-GF-2-2. NC2184.2 +052200 PERFORM FAIL NC2184.2 +052300 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +052400 MOVE "0 " TO CORRECT-A. NC2184.2 +052500 UST-WRITE-GF-2-2. NC2184.2 +052600 PERFORM PRINT-DETAIL. NC2184.2 +052700* NC2184.2 +052800 UST-TEST-GF-2-3. NC2184.2 +052900 ADD 1 TO REC-CT. NC2184.2 +053000 IF ID6-DU-2V0 = 2 NC2184.2 +053100 PERFORM PASS NC2184.2 +053200 GO TO UST-WRITE-GF-2-3 NC2184.2 +053300 ELSE NC2184.2 +053400 GO TO UST-FAIL-GF-2-3. NC2184.2 +053500 UST-DELETE-GF-2-3. NC2184.2 +053600 PERFORM DE-LETE. NC2184.2 +053700 GO TO UST-WRITE-GF-2-3. NC2184.2 +053800 UST-FAIL-GF-2-3. NC2184.2 +053900 PERFORM FAIL NC2184.2 +054000 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +054100 MOVE 2 TO CORRECT-N. NC2184.2 +054200 UST-WRITE-GF-2-3. NC2184.2 +054300 PERFORM PRINT-DETAIL. NC2184.2 +054400* NC2184.2 +054500 UST-TEST-GF-2-4. NC2184.2 +054600 ADD 1 TO REC-CT. NC2184.2 +054700 IF ID10-DU-2V0 = 4 NC2184.2 +054800 PERFORM PASS NC2184.2 +054900 GO TO UST-WRITE-GF-2-4 NC2184.2 +055000 ELSE NC2184.2 +055100 GO TO UST-FAIL-GF-2-4. NC2184.2 +055200 UST-DELETE-GF-2-4. NC2184.2 +055300 PERFORM DE-LETE. NC2184.2 +055400 GO TO UST-WRITE-GF-2-4. NC2184.2 +055500 UST-FAIL-GF-2-4. NC2184.2 +055600 PERFORM FAIL NC2184.2 +055700 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +055800 MOVE 4 TO CORRECT-N. NC2184.2 +055900 UST-WRITE-GF-2-4. NC2184.2 +056000 PERFORM PRINT-DETAIL. NC2184.2 +056100* NC2184.2 +056200 UST-TEST-GF-2-5. NC2184.2 +056300 ADD 1 TO REC-CT. NC2184.2 +056400 IF ID11-DU-2V0 = 1 NC2184.2 +056500 PERFORM PASS NC2184.2 +056600 GO TO UST-WRITE-GF-2-5 NC2184.2 +056700 ELSE NC2184.2 +056800 GO TO UST-FAIL-GF-2-5. NC2184.2 +056900 UST-DELETE-GF-2-5. NC2184.2 +057000 PERFORM DE-LETE. NC2184.2 +057100 GO TO UST-WRITE-GF-2-5. NC2184.2 +057200 UST-FAIL-GF-2-5. NC2184.2 +057300 PERFORM FAIL NC2184.2 +057400 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +057500 MOVE 1 TO CORRECT-N. NC2184.2 +057600 UST-WRITE-GF-2-5. NC2184.2 +057700 PERFORM PRINT-DETAIL. NC2184.2 +057800* NC2184.2 +057900 UST-INIT-GF-3. NC2184.2 +058000 MOVE "UST-TEST-GF-3" TO PAR-NAME. NC2184.2 +058100 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +058200 MOVE "PIC XXX" TO FEATURE. NC2184.2 +058300 MOVE "1200000" TO ID1-XN-7. NC2184.2 +058400 MOVE ZERO TO ID4-XXX. NC2184.2 +058500 MOVE "****" TO ID5-XN-4. NC2184.2 +058600 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +058700 MOVE 1 TO ID10-DU-2V0. NC2184.2 +058800 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +058900 MOVE 1 TO REC-CT. NC2184.2 +059000* NC2184.2 +059100 UST-TEST-GF-3. NC2184.2 +059200 UNSTRING ID1-XN-7 DELIMITED "0" INTO ID4-XXX NC2184.2 +059300 DELIMITER ID5-XN-4 NC2184.2 +059400 COUNT ID6-DU-2V0 NC2184.2 +059500 POINTER ID10-DU-2V0 NC2184.2 +059600 TALLYING ID11-DU-2V0. NC2184.2 +059700 GO TO UST-TEST-GF-3-1. NC2184.2 +059800 UST-DELETE-GF-3. NC2184.2 +059900 PERFORM DE-LETE. NC2184.2 +060000 PERFORM PRINT-DETAIL. NC2184.2 +060100 GO TO UST-INIT-GF-4. NC2184.2 +060200* NC2184.2 +060300 UST-TEST-GF-3-1. NC2184.2 +060400 IF ID4-XXX = "12 " NC2184.2 +060500 PERFORM PASS NC2184.2 +060600 GO TO UST-WRITE-GF-3-1 NC2184.2 +060700 ELSE NC2184.2 +060800 GO TO UST-FAIL-GF-3-1. NC2184.2 +060900 UST-DELETE-GF-3-1. NC2184.2 +061000 PERFORM DE-LETE. NC2184.2 +061100 GO TO UST-WRITE-GF-3-1. NC2184.2 +061200 UST-FAIL-GF-3-1. NC2184.2 +061300 PERFORM FAIL NC2184.2 +061400 MOVE ID4-XXX TO COMPUTED-A NC2184.2 +061500 MOVE "12 " TO CORRECT-A. NC2184.2 +061600 UST-WRITE-GF-3-1. NC2184.2 +061700 PERFORM PRINT-DETAIL. NC2184.2 +061800* NC2184.2 +061900 UST-TEST-GF-3-2. NC2184.2 +062000 ADD 1 TO REC-CT. NC2184.2 +062100 IF ID5-XN-4 = "0 " NC2184.2 +062200 PERFORM PASS NC2184.2 +062300 GO TO UST-WRITE-GF-3-2 NC2184.2 +062400 ELSE NC2184.2 +062500 GO TO UST-FAIL-GF-3-2. NC2184.2 +062600 UST-DELETE-GF-3-2. NC2184.2 +062700 PERFORM DE-LETE. NC2184.2 +062800 GO TO UST-WRITE-GF-3-2. NC2184.2 +062900 UST-FAIL-GF-3-2. NC2184.2 +063000 PERFORM FAIL NC2184.2 +063100 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +063200 MOVE "0 " TO CORRECT-A. NC2184.2 +063300 UST-WRITE-GF-3-2. NC2184.2 +063400 PERFORM PRINT-DETAIL. NC2184.2 +063500* NC2184.2 +063600 UST-TEST-GF-3-3. NC2184.2 +063700 ADD 1 TO REC-CT. NC2184.2 +063800 IF ID6-DU-2V0 = 2 NC2184.2 +063900 PERFORM PASS NC2184.2 +064000 GO TO UST-WRITE-GF-3-3 NC2184.2 +064100 ELSE NC2184.2 +064200 GO TO UST-FAIL-GF-3-3. NC2184.2 +064300 UST-DELETE-GF-3-3. NC2184.2 +064400 PERFORM DE-LETE. NC2184.2 +064500 GO TO UST-WRITE-GF-3-3. NC2184.2 +064600 UST-FAIL-GF-3-3. NC2184.2 +064700 PERFORM FAIL NC2184.2 +064800 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +064900 MOVE 2 TO CORRECT-N. NC2184.2 +065000 UST-WRITE-GF-3-3. NC2184.2 +065100 PERFORM PRINT-DETAIL. NC2184.2 +065200* NC2184.2 +065300 UST-TEST-GF-3-4. NC2184.2 +065400 ADD 1 TO REC-CT. NC2184.2 +065500 IF ID10-DU-2V0 = 4 NC2184.2 +065600 PERFORM PASS NC2184.2 +065700 GO TO UST-WRITE-GF-3-4 NC2184.2 +065800 ELSE NC2184.2 +065900 GO TO UST-FAIL-GF-3-4. NC2184.2 +066000 UST-DELETE-GF-3-4. NC2184.2 +066100 PERFORM DE-LETE. NC2184.2 +066200 GO TO UST-WRITE-GF-3-4. NC2184.2 +066300 UST-FAIL-GF-3-4. NC2184.2 +066400 PERFORM FAIL NC2184.2 +066500 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +066600 MOVE 4 TO CORRECT-N. NC2184.2 +066700 UST-WRITE-GF-3-4. NC2184.2 +066800 PERFORM PRINT-DETAIL. NC2184.2 +066900* NC2184.2 +067000 UST-TEST-GF-3-5. NC2184.2 +067100 ADD 1 TO REC-CT. NC2184.2 +067200 IF ID11-DU-2V0 = 1 NC2184.2 +067300 PERFORM PASS NC2184.2 +067400 GO TO UST-WRITE-GF-3-5 NC2184.2 +067500 ELSE NC2184.2 +067600 GO TO UST-FAIL-GF-3-5. NC2184.2 +067700 UST-DELETE-GF-3-5. NC2184.2 +067800 PERFORM DE-LETE. NC2184.2 +067900 GO TO UST-WRITE-GF-3-5. NC2184.2 +068000 UST-FAIL-GF-3-5. NC2184.2 +068100 PERFORM FAIL NC2184.2 +068200 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +068300 MOVE 1 TO CORRECT-N. NC2184.2 +068400 UST-WRITE-GF-3-5. NC2184.2 +068500 PERFORM PRINT-DETAIL. NC2184.2 +068600* NC2184.2 +068700 UST-INIT-GF-4. NC2184.2 +068800 MOVE "UST-TEST-GF-4" TO PAR-NAME. NC2184.2 +068900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +069000 MOVE "PIC XXX JUST" TO FEATURE. NC2184.2 +069100 MOVE "1200000" TO ID1-XN-7. NC2184.2 +069200 MOVE "0" TO ZERO-XN-1. NC2184.2 +069300 MOVE ZERO TO ID4-XXXJ. NC2184.2 +069400 MOVE "****" TO ID5-XN-4. NC2184.2 +069500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +069600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +069700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +069800 MOVE 1 TO REC-CT. NC2184.2 +069900* NC2184.2 +070000 UST-TEST-GF-4. NC2184.2 +070100 UNSTRING ID1-XN-7 DELIMITED BY ZERO-XN-1 INTO ID4-XXXJ NC2184.2 +070200 DELIMITER ID5-XN-4 NC2184.2 +070300 COUNT IN ID6-DU-2V0 NC2184.2 +070400 POINTER ID10-DU-2V0 NC2184.2 +070500 TALLYING IN ID11-DU-2V0. NC2184.2 +070600 GO TO UST-TEST-GF-4-1. NC2184.2 +070700 UST-DELETE-GF-4. NC2184.2 +070800 PERFORM DE-LETE. NC2184.2 +070900 PERFORM PRINT-DETAIL. NC2184.2 +071000 GO TO UST-INIT-GF-5. NC2184.2 +071100* NC2184.2 +071200 UST-TEST-GF-4-1. NC2184.2 +071300 IF ID4-XXXJ = " 12" NC2184.2 +071400 PERFORM PASS NC2184.2 +071500 GO TO UST-WRITE-GF-4-1 NC2184.2 +071600 ELSE NC2184.2 +071700 GO TO UST-FAIL-GF-4-1. NC2184.2 +071800 UST-DELETE-GF-4-1. NC2184.2 +071900 PERFORM DE-LETE. NC2184.2 +072000 GO TO UST-WRITE-GF-4-1. NC2184.2 +072100 UST-FAIL-GF-4-1. NC2184.2 +072200 PERFORM FAIL NC2184.2 +072300 MOVE ID4-XXXJ TO COMPUTED-A NC2184.2 +072400 MOVE " 12" TO CORRECT-A. NC2184.2 +072500 UST-WRITE-GF-4-1. NC2184.2 +072600 PERFORM PRINT-DETAIL. NC2184.2 +072700* NC2184.2 +072800 UST-TEST-GF-4-2. NC2184.2 +072900 ADD 1 TO REC-CT. NC2184.2 +073000 IF ID5-XN-4 = "0 " NC2184.2 +073100 PERFORM PASS NC2184.2 +073200 GO TO UST-WRITE-GF-4-2 NC2184.2 +073300 ELSE NC2184.2 +073400 GO TO UST-FAIL-GF-4-2. NC2184.2 +073500 UST-DELETE-GF-4-2. NC2184.2 +073600 PERFORM DE-LETE. NC2184.2 +073700 GO TO UST-WRITE-GF-4-2. NC2184.2 +073800 UST-FAIL-GF-4-2. NC2184.2 +073900 PERFORM FAIL NC2184.2 +074000 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +074100 MOVE "0 " TO CORRECT-A. NC2184.2 +074200 UST-WRITE-GF-4-2. NC2184.2 +074300 PERFORM PRINT-DETAIL. NC2184.2 +074400* NC2184.2 +074500 UST-TEST-GF-4-3. NC2184.2 +074600 ADD 1 TO REC-CT. NC2184.2 +074700 IF ID6-DU-2V0 = 2 NC2184.2 +074800 PERFORM PASS NC2184.2 +074900 GO TO UST-WRITE-GF-4-3 NC2184.2 +075000 ELSE NC2184.2 +075100 GO TO UST-FAIL-GF-4-3. NC2184.2 +075200 UST-DELETE-GF-4-3. NC2184.2 +075300 PERFORM DE-LETE. NC2184.2 +075400 GO TO UST-WRITE-GF-4-3. NC2184.2 +075500 UST-FAIL-GF-4-3. NC2184.2 +075600 PERFORM FAIL NC2184.2 +075700 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +075800 MOVE 2 TO CORRECT-N. NC2184.2 +075900 UST-WRITE-GF-4-3. NC2184.2 +076000 PERFORM PRINT-DETAIL. NC2184.2 +076100* NC2184.2 +076200 UST-TEST-GF-4-4. NC2184.2 +076300 ADD 1 TO REC-CT. NC2184.2 +076400 IF ID10-DU-2V0 = 4 NC2184.2 +076500 PERFORM PASS NC2184.2 +076600 GO TO UST-WRITE-GF-4-4 NC2184.2 +076700 ELSE NC2184.2 +076800 GO TO UST-FAIL-GF-4-4. NC2184.2 +076900 UST-DELETE-GF-4-4. NC2184.2 +077000 PERFORM DE-LETE. NC2184.2 +077100 GO TO UST-WRITE-GF-4-4. NC2184.2 +077200 UST-FAIL-GF-4-4. NC2184.2 +077300 PERFORM FAIL NC2184.2 +077400 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +077500 MOVE 4 TO CORRECT-N. NC2184.2 +077600 UST-WRITE-GF-4-4. NC2184.2 +077700 PERFORM PRINT-DETAIL. NC2184.2 +077800* NC2184.2 +077900 UST-TEST-GF-4-5. NC2184.2 +078000 ADD 1 TO REC-CT. NC2184.2 +078100 IF ID11-DU-2V0 = 1 NC2184.2 +078200 PERFORM PASS NC2184.2 +078300 GO TO UST-WRITE-GF-4-5 NC2184.2 +078400 ELSE NC2184.2 +078500 GO TO UST-FAIL-GF-4-5. NC2184.2 +078600 UST-DELETE-GF-4-5. NC2184.2 +078700 PERFORM DE-LETE. NC2184.2 +078800 GO TO UST-WRITE-GF-4-5. NC2184.2 +078900 UST-FAIL-GF-4-5. NC2184.2 +079000 PERFORM FAIL NC2184.2 +079100 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +079200 MOVE 1 TO CORRECT-N. NC2184.2 +079300 UST-WRITE-GF-4-5. NC2184.2 +079400 PERFORM PRINT-DETAIL. NC2184.2 +079500* NC2184.2 +079600 UST-INIT-GF-5. NC2184.2 +079700 MOVE "UST-TEST-GF-5" TO PAR-NAME. NC2184.2 +079800 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +079900 MOVE "PIC 9" TO FEATURE. NC2184.2 +080000 MOVE ZERO TO ID4-DU-1V0. NC2184.2 +080100 MOVE "****" TO ID5-XN-4. NC2184.2 +080200 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +080300 MOVE "1200000" TO ID1-XN-7. NC2184.2 +080400 MOVE 1 TO ID10-DU-2V0. NC2184.2 +080500 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +080600 MOVE 1 TO REC-CT. NC2184.2 +080700* NC2184.2 +080800 UST-TEST-GF-5. NC2184.2 +080900 UNSTRING ID1-XN-7 DELIMITED "0" INTO ID4-DU-1V0 NC2184.2 +081000 DELIMITER IN ID5-XN-4 NC2184.2 +081100 COUNT ID6-DU-2V0 NC2184.2 +081200 WITH POINTER ID10-DU-2V0 NC2184.2 +081300 TALLYING ID11-DU-2V0. NC2184.2 +081400 GO TO UST-TEST-GF-5-1. NC2184.2 +081500 UST-DELETE-GF-5. NC2184.2 +081600 PERFORM DE-LETE. NC2184.2 +081700 PERFORM PRINT-DETAIL. NC2184.2 +081800 GO TO UST-INIT-GF-6. NC2184.2 +081900* NC2184.2 +082000 UST-TEST-GF-5-1. NC2184.2 +082100 IF ID4-DU-1V0 = 2 NC2184.2 +082200 PERFORM PASS NC2184.2 +082300 GO TO UST-WRITE-GF-5-1 NC2184.2 +082400 ELSE NC2184.2 +082500 GO TO UST-FAIL-GF-5-1. NC2184.2 +082600 UST-DELETE-GF-5-1. NC2184.2 +082700 PERFORM DE-LETE. NC2184.2 +082800 GO TO UST-WRITE-GF-5-1. NC2184.2 +082900 UST-FAIL-GF-5-1. NC2184.2 +083000 PERFORM FAIL NC2184.2 +083100 MOVE ID4-DU-1V0 TO COMPUTED-N NC2184.2 +083200 MOVE 2 TO CORRECT-N. NC2184.2 +083300 UST-WRITE-GF-5-1. NC2184.2 +083400 PERFORM PRINT-DETAIL. NC2184.2 +083500* NC2184.2 +083600 UST-TEST-GF-5-2. NC2184.2 +083700 ADD 1 TO REC-CT. NC2184.2 +083800 IF ID5-XN-4 = "0 " NC2184.2 +083900 PERFORM PASS NC2184.2 +084000 GO TO UST-WRITE-GF-5-2 NC2184.2 +084100 ELSE NC2184.2 +084200 GO TO UST-FAIL-GF-5-2. NC2184.2 +084300 UST-DELETE-GF-5-2. NC2184.2 +084400 PERFORM DE-LETE. NC2184.2 +084500 GO TO UST-WRITE-GF-5-2. NC2184.2 +084600 UST-FAIL-GF-5-2. NC2184.2 +084700 PERFORM FAIL NC2184.2 +084800 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +084900 MOVE "0 " TO CORRECT-A. NC2184.2 +085000 UST-WRITE-GF-5-2. NC2184.2 +085100 PERFORM PRINT-DETAIL. NC2184.2 +085200* NC2184.2 +085300 UST-TEST-GF-5-3. NC2184.2 +085400 ADD 1 TO REC-CT. NC2184.2 +085500 IF ID6-DU-2V0 = 2 NC2184.2 +085600 PERFORM PASS NC2184.2 +085700 GO TO UST-WRITE-GF-5-3 NC2184.2 +085800 ELSE NC2184.2 +085900 GO TO UST-FAIL-GF-5-3. NC2184.2 +086000 UST-DELETE-GF-5-3. NC2184.2 +086100 PERFORM DE-LETE. NC2184.2 +086200 GO TO UST-WRITE-GF-5-3. NC2184.2 +086300 UST-FAIL-GF-5-3. NC2184.2 +086400 PERFORM FAIL NC2184.2 +086500 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +086600 MOVE 2 TO CORRECT-N. NC2184.2 +086700 UST-WRITE-GF-5-3. NC2184.2 +086800 PERFORM PRINT-DETAIL. NC2184.2 +086900* NC2184.2 +087000 UST-TEST-GF-5-4. NC2184.2 +087100 ADD 1 TO REC-CT. NC2184.2 +087200 IF ID10-DU-2V0 = 4 NC2184.2 +087300 PERFORM PASS NC2184.2 +087400 GO TO UST-WRITE-GF-5-4 NC2184.2 +087500 ELSE NC2184.2 +087600 GO TO UST-FAIL-GF-5-4. NC2184.2 +087700 UST-DELETE-GF-5-4. NC2184.2 +087800 PERFORM DE-LETE. NC2184.2 +087900 GO TO UST-WRITE-GF-5-4. NC2184.2 +088000 UST-FAIL-GF-5-4. NC2184.2 +088100 PERFORM FAIL NC2184.2 +088200 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +088300 MOVE 4 TO CORRECT-N. NC2184.2 +088400 UST-WRITE-GF-5-4. NC2184.2 +088500 PERFORM PRINT-DETAIL. NC2184.2 +088600* NC2184.2 +088700 UST-TEST-GF-5-5. NC2184.2 +088800 ADD 1 TO REC-CT. NC2184.2 +088900 IF ID11-DU-2V0 = 1 NC2184.2 +089000 PERFORM PASS NC2184.2 +089100 GO TO UST-WRITE-GF-5-5 NC2184.2 +089200 ELSE NC2184.2 +089300 GO TO UST-FAIL-GF-5-5. NC2184.2 +089400 UST-DELETE-GF-5-5. NC2184.2 +089500 PERFORM DE-LETE. NC2184.2 +089600 GO TO UST-WRITE-GF-5-5. NC2184.2 +089700 UST-FAIL-GF-5-5. NC2184.2 +089800 PERFORM FAIL NC2184.2 +089900 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +090000 MOVE 1 TO CORRECT-N. NC2184.2 +090100 UST-WRITE-GF-5-5. NC2184.2 +090200 PERFORM PRINT-DETAIL. NC2184.2 +090300* NC2184.2 +090400 UST-INIT-GF-6. NC2184.2 +090500 MOVE "UST-TEST-GF-6" TO PAR-NAME. NC2184.2 +090600 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +090700 MOVE "PIC S9" TO FEATURE. NC2184.2 +090800 MOVE ZERO TO ID4-DS-1V0. NC2184.2 +090900 MOVE "****" TO ID5-XN-4. NC2184.2 +091000 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +091100 MOVE "1200000" TO ID1-XN-7. NC2184.2 +091200 MOVE 1 TO ID10-DU-2V0. NC2184.2 +091300 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +091400 MOVE 1 TO REC-CT. NC2184.2 +091500* NC2184.2 +091600 UST-TEST-GF-6. NC2184.2 +091700 UNSTRING ID1-XN-7 DELIMITED BY ALL ZERO INTO ID4-DS-1V0 NC2184.2 +091800 DELIMITER ID5-XN-4 NC2184.2 +091900 COUNT ID6-DU-2V0 NC2184.2 +092000 POINTER ID10-DU-2V0 NC2184.2 +092100 TALLYING ID11-DU-2V0. NC2184.2 +092200 GO TO UST-TEST-GF-6-1. NC2184.2 +092300 UST-DELETE-GF-6. NC2184.2 +092400 PERFORM DE-LETE. NC2184.2 +092500 PERFORM PRINT-DETAIL. NC2184.2 +092600 GO TO UST-INIT-GF-7. NC2184.2 +092700* NC2184.2 +092800 UST-TEST-GF-6-1. NC2184.2 +092900 IF ID4-DS-1V0 = +2 NC2184.2 +093000 PERFORM PASS NC2184.2 +093100 GO TO UST-WRITE-GF-6-1 NC2184.2 +093200 ELSE NC2184.2 +093300 GO TO UST-FAIL-GF-6-1. NC2184.2 +093400 UST-DELETE-GF-6-1. NC2184.2 +093500 PERFORM DE-LETE. NC2184.2 +093600 GO TO UST-WRITE-GF-6-1. NC2184.2 +093700 UST-FAIL-GF-6-1. NC2184.2 +093800 PERFORM FAIL NC2184.2 +093900 MOVE ID4-DS-1V0 TO COMPUTED-N NC2184.2 +094000 MOVE +2 TO CORRECT-N. NC2184.2 +094100 UST-WRITE-GF-6-1. NC2184.2 +094200 PERFORM PRINT-DETAIL. NC2184.2 +094300* NC2184.2 +094400 UST-TEST-GF-6-2. NC2184.2 +094500 ADD 1 TO REC-CT. NC2184.2 +094600 IF ID5-XN-4 = "0 " NC2184.2 +094700 PERFORM PASS NC2184.2 +094800 GO TO UST-WRITE-GF-6-2 NC2184.2 +094900 ELSE NC2184.2 +095000 GO TO UST-FAIL-GF-6-2. NC2184.2 +095100 UST-DELETE-GF-6-2. NC2184.2 +095200 PERFORM DE-LETE. NC2184.2 +095300 GO TO UST-WRITE-GF-6-2. NC2184.2 +095400 UST-FAIL-GF-6-2. NC2184.2 +095500 PERFORM FAIL NC2184.2 +095600 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +095700 MOVE "0 " TO CORRECT-A. NC2184.2 +095800 UST-WRITE-GF-6-2. NC2184.2 +095900 PERFORM PRINT-DETAIL. NC2184.2 +096000* NC2184.2 +096100 UST-TEST-GF-6-3. NC2184.2 +096200 ADD 1 TO REC-CT. NC2184.2 +096300 IF ID6-DU-2V0 = 2 NC2184.2 +096400 PERFORM PASS NC2184.2 +096500 GO TO UST-WRITE-GF-6-3 NC2184.2 +096600 ELSE NC2184.2 +096700 GO TO UST-FAIL-GF-6-3. NC2184.2 +096800 UST-DELETE-GF-6-3. NC2184.2 +096900 PERFORM DE-LETE. NC2184.2 +097000 GO TO UST-WRITE-GF-6-3. NC2184.2 +097100 UST-FAIL-GF-6-3. NC2184.2 +097200 PERFORM FAIL NC2184.2 +097300 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +097400 MOVE 2 TO CORRECT-N. NC2184.2 +097500 UST-WRITE-GF-6-3. NC2184.2 +097600 PERFORM PRINT-DETAIL. NC2184.2 +097700* NC2184.2 +097800 UST-TEST-GF-6-4. NC2184.2 +097900 ADD 1 TO REC-CT. NC2184.2 +098000 IF ID10-DU-2V0 = 8 NC2184.2 +098100 PERFORM PASS NC2184.2 +098200 GO TO UST-WRITE-GF-6-4 NC2184.2 +098300 ELSE NC2184.2 +098400 GO TO UST-FAIL-GF-6-4. NC2184.2 +098500 UST-DELETE-GF-6-4. NC2184.2 +098600 PERFORM DE-LETE. NC2184.2 +098700 GO TO UST-WRITE-GF-6-4. NC2184.2 +098800 UST-FAIL-GF-6-4. NC2184.2 +098900 PERFORM FAIL NC2184.2 +099000 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +099100 MOVE 8 TO CORRECT-N. NC2184.2 +099200 UST-WRITE-GF-6-4. NC2184.2 +099300 PERFORM PRINT-DETAIL. NC2184.2 +099400* NC2184.2 +099500 UST-TEST-GF-6-5. NC2184.2 +099600 ADD 1 TO REC-CT. NC2184.2 +099700 IF ID11-DU-2V0 = 1 NC2184.2 +099800 PERFORM PASS NC2184.2 +099900 GO TO UST-WRITE-GF-6-5 NC2184.2 +100000 ELSE NC2184.2 +100100 GO TO UST-FAIL-GF-6-5. NC2184.2 +100200 UST-DELETE-GF-6-5. NC2184.2 +100300 PERFORM DE-LETE. NC2184.2 +100400 GO TO UST-WRITE-GF-6-5. NC2184.2 +100500 UST-FAIL-GF-6-5. NC2184.2 +100600 PERFORM FAIL NC2184.2 +100700 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +100800 MOVE 1 TO CORRECT-N. NC2184.2 +100900 UST-WRITE-GF-6-5. NC2184.2 +101000 PERFORM PRINT-DETAIL. NC2184.2 +101100* NC2184.2 +101200 UST-INIT-GF-7. NC2184.2 +101300 MOVE "UST-TEST-GF-7" TO PAR-NAME. NC2184.2 +101400 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +101500 MOVE "PIC 99" TO FEATURE. NC2184.2 +101600 MOVE "1200000" TO ID1-XN-7. NC2184.2 +101700 MOVE ZERO TO ID4-DU-2V0. NC2184.2 +101800 MOVE "****" TO ID5-XN-4. NC2184.2 +101900 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +102000 MOVE 1 TO ID10-DU-2V0. NC2184.2 +102100 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +102200 MOVE 1 TO REC-CT. NC2184.2 +102300* NC2184.2 +102400 UST-TEST-GF-7. NC2184.2 +102500 UNSTRING ID1-XN-7 DELIMITED ALL "0" INTO ID4-DU-2V0 NC2184.2 +102600 DELIMITER ID5-XN-4 NC2184.2 +102700 COUNT ID6-DU-2V0 NC2184.2 +102800 POINTER ID10-DU-2V0 NC2184.2 +102900 TALLYING ID11-DU-2V0. NC2184.2 +103000 GO TO UST-TEST-GF-7-1. NC2184.2 +103100 UST-DELETE-GF-7. NC2184.2 +103200 PERFORM DE-LETE. NC2184.2 +103300 PERFORM PRINT-DETAIL. NC2184.2 +103400 GO TO UST-INIT-GF-8. NC2184.2 +103500* NC2184.2 +103600 UST-TEST-GF-7-1. NC2184.2 +103700 IF ID4-DU-2V0 = 12 NC2184.2 +103800 PERFORM PASS NC2184.2 +103900 GO TO UST-WRITE-GF-7-1 NC2184.2 +104000 ELSE NC2184.2 +104100 GO TO UST-FAIL-GF-7-1. NC2184.2 +104200 UST-DELETE-GF-7-1. NC2184.2 +104300 PERFORM DE-LETE. NC2184.2 +104400 GO TO UST-WRITE-GF-7-1. NC2184.2 +104500 UST-FAIL-GF-7-1. NC2184.2 +104600 PERFORM FAIL NC2184.2 +104700 MOVE ID4-DU-2V0 TO COMPUTED-N NC2184.2 +104800 MOVE 12 TO CORRECT-N. NC2184.2 +104900 UST-WRITE-GF-7-1. NC2184.2 +105000 PERFORM PRINT-DETAIL. NC2184.2 +105100* NC2184.2 +105200 UST-TEST-GF-7-2. NC2184.2 +105300 ADD 1 TO REC-CT. NC2184.2 +105400 IF ID5-XN-4 = "0 " NC2184.2 +105500 PERFORM PASS NC2184.2 +105600 GO TO UST-WRITE-GF-7-2 NC2184.2 +105700 ELSE NC2184.2 +105800 GO TO UST-FAIL-GF-7-2. NC2184.2 +105900 UST-DELETE-GF-7-2. NC2184.2 +106000 PERFORM DE-LETE. NC2184.2 +106100 GO TO UST-WRITE-GF-7-2. NC2184.2 +106200 UST-FAIL-GF-7-2. NC2184.2 +106300 PERFORM FAIL NC2184.2 +106400 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +106500 MOVE "0 " TO CORRECT-A. NC2184.2 +106600 UST-WRITE-GF-7-2. NC2184.2 +106700 PERFORM PRINT-DETAIL. NC2184.2 +106800* NC2184.2 +106900 UST-TEST-GF-7-3. NC2184.2 +107000 ADD 1 TO REC-CT. NC2184.2 +107100 IF ID6-DU-2V0 = 2 NC2184.2 +107200 PERFORM PASS NC2184.2 +107300 GO TO UST-WRITE-GF-7-3 NC2184.2 +107400 ELSE NC2184.2 +107500 GO TO UST-FAIL-GF-7-3. NC2184.2 +107600 UST-DELETE-GF-7-3. NC2184.2 +107700 PERFORM DE-LETE. NC2184.2 +107800 GO TO UST-WRITE-GF-7-3. NC2184.2 +107900 UST-FAIL-GF-7-3. NC2184.2 +108000 PERFORM FAIL NC2184.2 +108100 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +108200 MOVE 2 TO CORRECT-N. NC2184.2 +108300 UST-WRITE-GF-7-3. NC2184.2 +108400 PERFORM PRINT-DETAIL. NC2184.2 +108500* NC2184.2 +108600 UST-TEST-GF-7-4. NC2184.2 +108700 ADD 1 TO REC-CT. NC2184.2 +108800 IF ID10-DU-2V0 = 8 NC2184.2 +108900 PERFORM PASS NC2184.2 +109000 GO TO UST-WRITE-GF-7-4 NC2184.2 +109100 ELSE NC2184.2 +109200 GO TO UST-FAIL-GF-7-4. NC2184.2 +109300 UST-DELETE-GF-7-4. NC2184.2 +109400 PERFORM DE-LETE. NC2184.2 +109500 GO TO UST-WRITE-GF-7-4. NC2184.2 +109600 UST-FAIL-GF-7-4. NC2184.2 +109700 PERFORM FAIL NC2184.2 +109800 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +109900 MOVE 8 TO CORRECT-N. NC2184.2 +110000 UST-WRITE-GF-7-4. NC2184.2 +110100 PERFORM PRINT-DETAIL. NC2184.2 +110200* NC2184.2 +110300 UST-TEST-GF-7-5. NC2184.2 +110400 ADD 1 TO REC-CT. NC2184.2 +110500 IF ID11-DU-2V0 = 1 NC2184.2 +110600 PERFORM PASS NC2184.2 +110700 GO TO UST-WRITE-GF-7-5 NC2184.2 +110800 ELSE NC2184.2 +110900 GO TO UST-FAIL-GF-7-5. NC2184.2 +111000 UST-DELETE-GF-7-5. NC2184.2 +111100 PERFORM DE-LETE. NC2184.2 +111200 GO TO UST-WRITE-GF-7-5. NC2184.2 +111300 UST-FAIL-GF-7-5. NC2184.2 +111400 PERFORM FAIL NC2184.2 +111500 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +111600 MOVE 1 TO CORRECT-N. NC2184.2 +111700 UST-WRITE-GF-7-5. NC2184.2 +111800 PERFORM PRINT-DETAIL. NC2184.2 +111900* NC2184.2 +112000 UST-INIT-GF-8. NC2184.2 +112100 MOVE "UST-TEST-GF-8" TO PAR-NAME. NC2184.2 +112200 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +112300 MOVE "PIC S99" TO FEATURE. NC2184.2 +112400 MOVE "1200000" TO ID1-XN-7. NC2184.2 +112500 MOVE ZERO TO ID4-DS-2V0. NC2184.2 +112600 MOVE "****" TO ID5-XN-4. NC2184.2 +112700 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +112800 MOVE 1 TO ID10-DU-2V0. NC2184.2 +112900 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +113000 MOVE 1 TO REC-CT. NC2184.2 +113100* NC2184.2 +113200 UST-TEST-GF-8. NC2184.2 +113300 UNSTRING ID1-XN-7 DELIMITED ZERO-XN-1 INTO ID4-DS-2V0 NC2184.2 +113400 DELIMITER ID5-XN-4 NC2184.2 +113500 COUNT ID6-DU-2V0 NC2184.2 +113600 POINTER ID10-DU-2V0 NC2184.2 +113700 TALLYING IN ID11-DU-2V0. NC2184.2 +113800 GO TO UST-TEST-GF-8-1. NC2184.2 +113900 UST-DELETE-GF-8. NC2184.2 +114000 PERFORM DE-LETE. NC2184.2 +114100 PERFORM PRINT-DETAIL. NC2184.2 +114200 GO TO UST-INIT-GF-9. NC2184.2 +114300* NC2184.2 +114400 UST-TEST-GF-8-1. NC2184.2 +114500 IF ID4-DS-2V0 = +12 NC2184.2 +114600 PERFORM PASS NC2184.2 +114700 GO TO UST-WRITE-GF-8-1 NC2184.2 +114800 ELSE NC2184.2 +114900 GO TO UST-FAIL-GF-8-1. NC2184.2 +115000 UST-DELETE-GF-8-1. NC2184.2 +115100 PERFORM DE-LETE. NC2184.2 +115200 GO TO UST-WRITE-GF-8-1. NC2184.2 +115300 UST-FAIL-GF-8-1. NC2184.2 +115400 PERFORM FAIL NC2184.2 +115500 MOVE ID4-DS-2V0 TO COMPUTED-N NC2184.2 +115600 MOVE +12 TO CORRECT-N. NC2184.2 +115700 UST-WRITE-GF-8-1. NC2184.2 +115800 PERFORM PRINT-DETAIL. NC2184.2 +115900* NC2184.2 +116000 UST-TEST-GF-8-2. NC2184.2 +116100 ADD 1 TO REC-CT. NC2184.2 +116200 IF ID5-XN-4 = "0 " NC2184.2 +116300 PERFORM PASS NC2184.2 +116400 GO TO UST-WRITE-GF-8-2 NC2184.2 +116500 ELSE NC2184.2 +116600 GO TO UST-FAIL-GF-8-2. NC2184.2 +116700 UST-DELETE-GF-8-2. NC2184.2 +116800 PERFORM DE-LETE. NC2184.2 +116900 GO TO UST-WRITE-GF-8-2. NC2184.2 +117000 UST-FAIL-GF-8-2. NC2184.2 +117100 PERFORM FAIL NC2184.2 +117200 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +117300 MOVE "0 " TO CORRECT-A. NC2184.2 +117400 UST-WRITE-GF-8-2. NC2184.2 +117500 PERFORM PRINT-DETAIL. NC2184.2 +117600* NC2184.2 +117700 UST-TEST-GF-8-3. NC2184.2 +117800 ADD 1 TO REC-CT. NC2184.2 +117900 IF ID6-DU-2V0 = 2 NC2184.2 +118000 PERFORM PASS NC2184.2 +118100 GO TO UST-WRITE-GF-8-3 NC2184.2 +118200 ELSE NC2184.2 +118300 GO TO UST-FAIL-GF-8-3. NC2184.2 +118400 UST-DELETE-GF-8-3. NC2184.2 +118500 PERFORM DE-LETE. NC2184.2 +118600 GO TO UST-WRITE-GF-8-3. NC2184.2 +118700 UST-FAIL-GF-8-3. NC2184.2 +118800 PERFORM FAIL NC2184.2 +118900 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +119000 MOVE 2 TO CORRECT-N. NC2184.2 +119100 UST-WRITE-GF-8-3. NC2184.2 +119200 PERFORM PRINT-DETAIL. NC2184.2 +119300* NC2184.2 +119400 UST-TEST-GF-8-4. NC2184.2 +119500 ADD 1 TO REC-CT. NC2184.2 +119600 IF ID10-DU-2V0 = 4 NC2184.2 +119700 PERFORM PASS NC2184.2 +119800 GO TO UST-WRITE-GF-8-4 NC2184.2 +119900 ELSE NC2184.2 +120000 GO TO UST-FAIL-GF-8-4. NC2184.2 +120100 UST-DELETE-GF-8-4. NC2184.2 +120200 PERFORM DE-LETE. NC2184.2 +120300 GO TO UST-WRITE-GF-8-4. NC2184.2 +120400 UST-FAIL-GF-8-4. NC2184.2 +120500 PERFORM FAIL NC2184.2 +120600 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +120700 MOVE 4 TO CORRECT-N. NC2184.2 +120800 UST-WRITE-GF-8-4. NC2184.2 +120900 PERFORM PRINT-DETAIL. NC2184.2 +121000* NC2184.2 +121100 UST-TEST-GF-8-5. NC2184.2 +121200 ADD 1 TO REC-CT. NC2184.2 +121300 IF ID11-DU-2V0 = 1 NC2184.2 +121400 PERFORM PASS NC2184.2 +121500 GO TO UST-WRITE-GF-8-5 NC2184.2 +121600 ELSE NC2184.2 +121700 GO TO UST-FAIL-GF-8-5. NC2184.2 +121800 UST-DELETE-GF-8-5. NC2184.2 +121900 PERFORM DE-LETE. NC2184.2 +122000 GO TO UST-WRITE-GF-8-5. NC2184.2 +122100 UST-FAIL-GF-8-5. NC2184.2 +122200 PERFORM FAIL NC2184.2 +122300 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +122400 MOVE 1 TO CORRECT-N. NC2184.2 +122500 UST-WRITE-GF-8-5. NC2184.2 +122600 PERFORM PRINT-DETAIL. NC2184.2 +122700* NC2184.2 +122800 UST-INIT-GF-9. NC2184.2 +122900 MOVE "UST-TEST-GF-9" TO PAR-NAME. NC2184.2 +123000 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +123100 MOVE "PIC S9 TRAIL SEP" TO FEATURE. NC2184.2 +123200 MOVE "1200000" TO ID1-XN-7. NC2184.2 +123300 MOVE ZERO TO ID4-DS-TS-1V0. NC2184.2 +123400 MOVE "****" TO ID5-XN-4. NC2184.2 +123500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +123600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +123700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +123800 MOVE 1 TO REC-CT. NC2184.2 +123900* NC2184.2 +124000 UST-TEST-GF-9. NC2184.2 +124100 UNSTRING ID1-XN-7 DELIMITED ALL ZERO-XN-1 INTO ID4-DS-TS-1V0 NC2184.2 +124200 DELIMITER ID5-XN-4 NC2184.2 +124300 COUNT ID6-DU-2V0 NC2184.2 +124400 POINTER ID10-DU-2V0 NC2184.2 +124500 TALLYING IN ID11-DU-2V0. NC2184.2 +124600 GO TO UST-TEST-GF-9-1. NC2184.2 +124700 UST-DELETE-GF-9. NC2184.2 +124800 PERFORM DE-LETE. NC2184.2 +124900 PERFORM PRINT-DETAIL. NC2184.2 +125000 GO TO UST-INIT-GF-10. NC2184.2 +125100* NC2184.2 +125200 UST-TEST-GF-9-1. NC2184.2 +125300 IF ID4-DS-TS-1V0 = +2 NC2184.2 +125400 PERFORM PASS NC2184.2 +125500 GO TO UST-WRITE-GF-9-1 NC2184.2 +125600 ELSE NC2184.2 +125700 GO TO UST-FAIL-GF-9-1. NC2184.2 +125800 UST-DELETE-GF-9-1. NC2184.2 +125900 PERFORM DE-LETE. NC2184.2 +126000 GO TO UST-WRITE-GF-9-1. NC2184.2 +126100 UST-FAIL-GF-9-1. NC2184.2 +126200 PERFORM FAIL NC2184.2 +126300 MOVE ID4-DS-TS-1V0 TO COMPUTED-N NC2184.2 +126400 MOVE +2 TO CORRECT-N. NC2184.2 +126500 UST-WRITE-GF-9-1. NC2184.2 +126600 PERFORM PRINT-DETAIL. NC2184.2 +126700* NC2184.2 +126800 UST-TEST-GF-9-2. NC2184.2 +126900 ADD 1 TO REC-CT. NC2184.2 +127000 IF ID5-XN-4 = "0 " NC2184.2 +127100 PERFORM PASS NC2184.2 +127200 GO TO UST-WRITE-GF-9-2 NC2184.2 +127300 ELSE NC2184.2 +127400 GO TO UST-FAIL-GF-9-2. NC2184.2 +127500 UST-DELETE-GF-9-2. NC2184.2 +127600 PERFORM DE-LETE. NC2184.2 +127700 GO TO UST-WRITE-GF-9-2. NC2184.2 +127800 UST-FAIL-GF-9-2. NC2184.2 +127900 PERFORM FAIL NC2184.2 +128000 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +128100 MOVE "0 " TO CORRECT-A. NC2184.2 +128200 UST-WRITE-GF-9-2. NC2184.2 +128300 PERFORM PRINT-DETAIL. NC2184.2 +128400* NC2184.2 +128500 UST-TEST-GF-9-3. NC2184.2 +128600 IF ID6-DU-2V0 = 2 NC2184.2 +128700 PERFORM PASS NC2184.2 +128800 GO TO UST-WRITE-GF-9-3 NC2184.2 +128900 ELSE NC2184.2 +129000 GO TO UST-FAIL-GF-9-3. NC2184.2 +129100 UST-DELETE-GF-9-3. NC2184.2 +129200 PERFORM DE-LETE. NC2184.2 +129300 GO TO UST-WRITE-GF-9-3. NC2184.2 +129400 UST-FAIL-GF-9-3. NC2184.2 +129500 PERFORM FAIL NC2184.2 +129600 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +129700 MOVE 2 TO CORRECT-N. NC2184.2 +129800 UST-WRITE-GF-9-3. NC2184.2 +129900 PERFORM PRINT-DETAIL. NC2184.2 +130000* NC2184.2 +130100 UST-TEST-GF-9-4. NC2184.2 +130200 ADD 1 TO REC-CT. NC2184.2 +130300 IF ID10-DU-2V0 = 8 NC2184.2 +130400 PERFORM PASS NC2184.2 +130500 GO TO UST-WRITE-GF-9-4 NC2184.2 +130600 ELSE NC2184.2 +130700 GO TO UST-FAIL-GF-9-4. NC2184.2 +130800 UST-DELETE-GF-9-4. NC2184.2 +130900 PERFORM DE-LETE. NC2184.2 +131000 GO TO UST-WRITE-GF-9-4. NC2184.2 +131100 UST-FAIL-GF-9-4. NC2184.2 +131200 PERFORM FAIL NC2184.2 +131300 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +131400 MOVE 8 TO CORRECT-N. NC2184.2 +131500 UST-WRITE-GF-9-4. NC2184.2 +131600 PERFORM PRINT-DETAIL. NC2184.2 +131700* NC2184.2 +131800 UST-TEST-GF-9-5. NC2184.2 +131900 ADD 1 TO REC-CT. NC2184.2 +132000 IF ID11-DU-2V0 = 1 NC2184.2 +132100 PERFORM PASS NC2184.2 +132200 GO TO UST-WRITE-GF-9-5 NC2184.2 +132300 ELSE NC2184.2 +132400 GO TO UST-FAIL-GF-9-5. NC2184.2 +132500 UST-DELETE-GF-9-5. NC2184.2 +132600 PERFORM DE-LETE. NC2184.2 +132700 GO TO UST-WRITE-GF-9-5. NC2184.2 +132800 UST-FAIL-GF-9-5. NC2184.2 +132900 PERFORM FAIL NC2184.2 +133000 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +133100 MOVE 1 TO CORRECT-N. NC2184.2 +133200 UST-WRITE-GF-9-5. NC2184.2 +133300 PERFORM PRINT-DETAIL. NC2184.2 +133400* NC2184.2 +133500 UST-INIT-GF-10. NC2184.2 +133600 MOVE "UST-TEST-GF-10" TO PAR-NAME. NC2184.2 +133700 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +133800 MOVE "PIC S9 LEAD SEP" TO FEATURE. NC2184.2 +133900 MOVE "1200000" TO ID1-XN-7. NC2184.2 +134000 MOVE ZERO TO ID4-DS-LS-1V0. NC2184.2 +134100 MOVE "****" TO ID5-XN-4. NC2184.2 +134200 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +134300 MOVE 1 TO ID10-DU-2V0. NC2184.2 +134400 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +134500 MOVE 1 TO REC-CT. NC2184.2 +134600* NC2184.2 +134700 UST-TEST-GF-10. NC2184.2 +134800 UNSTRING ID1-XN-7 DELIMITED BY "0" INTO ID4-DS-LS-1V0 NC2184.2 +134900 DELIMITER ID5-XN-4 NC2184.2 +135000 COUNT ID6-DU-2V0 NC2184.2 +135100 POINTER ID10-DU-2V0 NC2184.2 +135200 TALLYING ID11-DU-2V0. NC2184.2 +135300 GO TO UST-TEST-GF-10-1. NC2184.2 +135400 UST-DELETE-GF-10. NC2184.2 +135500 PERFORM DE-LETE. NC2184.2 +135600 PERFORM PRINT-DETAIL. NC2184.2 +135700 GO TO UST-INIT-GF-11. NC2184.2 +135800* NC2184.2 +135900 UST-TEST-GF-10-1. NC2184.2 +136000 IF ID4-DS-LS-1V0 = +2 NC2184.2 +136100 PERFORM PASS NC2184.2 +136200 GO TO UST-WRITE-GF-10-1 NC2184.2 +136300 ELSE NC2184.2 +136400 GO TO UST-FAIL-GF-10-1. NC2184.2 +136500 UST-DELETE-GF-10-1. NC2184.2 +136600 PERFORM DE-LETE. NC2184.2 +136700 GO TO UST-WRITE-GF-10-1. NC2184.2 +136800 UST-FAIL-GF-10-1. NC2184.2 +136900 PERFORM FAIL NC2184.2 +137000 MOVE ID4-DS-LS-1V0 TO COMPUTED-N NC2184.2 +137100 MOVE +2 TO CORRECT-N. NC2184.2 +137200 UST-WRITE-GF-10-1. NC2184.2 +137300 PERFORM PRINT-DETAIL. NC2184.2 +137400* NC2184.2 +137500 UST-TEST-GF-10-2. NC2184.2 +137600 ADD 1 TO REC-CT. NC2184.2 +137700 IF ID5-XN-4 = "0 " NC2184.2 +137800 PERFORM PASS NC2184.2 +137900 GO TO UST-WRITE-GF-10-2 NC2184.2 +138000 ELSE NC2184.2 +138100 GO TO UST-FAIL-GF-10-2. NC2184.2 +138200 UST-DELETE-GF-10-2. NC2184.2 +138300 PERFORM DE-LETE. NC2184.2 +138400 GO TO UST-WRITE-GF-10-2. NC2184.2 +138500 UST-FAIL-GF-10-2. NC2184.2 +138600 PERFORM FAIL NC2184.2 +138700 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +138800 MOVE "0 " TO CORRECT-A. NC2184.2 +138900 UST-WRITE-GF-10-2. NC2184.2 +139000 PERFORM PRINT-DETAIL. NC2184.2 +139100* NC2184.2 +139200 UST-TEST-GF-10-3. NC2184.2 +139300 ADD 1 TO REC-CT. NC2184.2 +139400 IF ID6-DU-2V0 = 2 NC2184.2 +139500 PERFORM PASS NC2184.2 +139600 GO TO UST-WRITE-GF-10-3 NC2184.2 +139700 ELSE NC2184.2 +139800 GO TO UST-FAIL-GF-10-3. NC2184.2 +139900 UST-DELETE-GF-10-3. NC2184.2 +140000 PERFORM DE-LETE. NC2184.2 +140100 GO TO UST-WRITE-GF-10-3. NC2184.2 +140200 UST-FAIL-GF-10-3. NC2184.2 +140300 PERFORM FAIL NC2184.2 +140400 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +140500 MOVE 2 TO CORRECT-N. NC2184.2 +140600 UST-WRITE-GF-10-3. NC2184.2 +140700 PERFORM PRINT-DETAIL. NC2184.2 +140800* NC2184.2 +140900 UST-TEST-GF-10-4. NC2184.2 +141000 ADD 1 TO REC-CT. NC2184.2 +141100 IF ID10-DU-2V0 = 4 NC2184.2 +141200 PERFORM PASS NC2184.2 +141300 GO TO UST-WRITE-GF-10-4 NC2184.2 +141400 ELSE NC2184.2 +141500 GO TO UST-FAIL-GF-10-4. NC2184.2 +141600 UST-DELETE-GF-10-4. NC2184.2 +141700 PERFORM DE-LETE. NC2184.2 +141800 GO TO UST-WRITE-GF-10-4. NC2184.2 +141900 UST-FAIL-GF-10-4. NC2184.2 +142000 PERFORM FAIL NC2184.2 +142100 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +142200 MOVE 4 TO CORRECT-N. NC2184.2 +142300 UST-WRITE-GF-10-4. NC2184.2 +142400 PERFORM PRINT-DETAIL. NC2184.2 +142500* NC2184.2 +142600 UST-TEST-GF-10-5. NC2184.2 +142700 ADD 1 TO REC-CT. NC2184.2 +142800 IF ID11-DU-2V0 = 1 NC2184.2 +142900 PERFORM PASS NC2184.2 +143000 GO TO UST-WRITE-GF-10-5 NC2184.2 +143100 ELSE NC2184.2 +143200 GO TO UST-FAIL-GF-10-5. NC2184.2 +143300 UST-DELETE-GF-10-5. NC2184.2 +143400 PERFORM DE-LETE. NC2184.2 +143500 GO TO UST-WRITE-GF-10-5. NC2184.2 +143600 UST-FAIL-GF-10-5. NC2184.2 +143700 PERFORM FAIL NC2184.2 +143800 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +143900 MOVE 1 TO CORRECT-N. NC2184.2 +144000 UST-WRITE-GF-10-5. NC2184.2 +144100 PERFORM PRINT-DETAIL. NC2184.2 +144200* NC2184.2 +144300 UST-INIT-GF-11. NC2184.2 +144400 MOVE "UST-TEST-GF-11" TO PAR-NAME. NC2184.2 +144500 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +144600 MOVE "GROUP BOTTOM UP" TO FEATURE. NC2184.2 +144700 MOVE "ABCDEFGHIJ" TO GRP1-XN-10. NC2184.2 +144800 MOVE SPACES TO GRP4-XN-10. NC2184.2 +144900 MOVE "****" TO ID5-XN-4. NC2184.2 +145000 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +145100 MOVE 1 TO ID10-DU-2V0. NC2184.2 +145200 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +145300 MOVE ZERO TO REC-CT. NC2184.2 +145400* NC2184.2 +145500 UST-TEST-GF-11. NC2184.2 +145600 UNSTRING GRP1-XN-10 INTO ID4D-XXXX ID4C-XXX ID4B-XX ID4A-X. NC2184.2 +145700 IF GRP4-XN-10 = "JHIEFGABCD" NC2184.2 +145800 PERFORM PASS NC2184.2 +145900 GO TO UST-WRITE-GF-11-1 NC2184.2 +146000 ELSE NC2184.2 +146100 GO TO UST-FAIL-GF-11-1. NC2184.2 +146200 UST-DELETE-GF-11-1. NC2184.2 +146300 PERFORM DE-LETE. NC2184.2 +146400 GO TO UST-WRITE-GF-11-1. NC2184.2 +146500 UST-FAIL-GF-11-1. NC2184.2 +146600 PERFORM FAIL NC2184.2 +146700 MOVE GRP4-XN-10 TO COMPUTED-A NC2184.2 +146800 MOVE "JHIEFGABCD" TO CORRECT-A. NC2184.2 +146900 UST-WRITE-GF-11-1. NC2184.2 +147000 PERFORM PRINT-DETAIL. NC2184.2 +147100* NC2184.2 +147200 UST-INIT-GF-12. NC2184.2 +147300 MOVE "UST-TEST-GF-12" TO PAR-NAME. NC2184.2 +147400 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +147500 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +147600 MOVE SPACES TO GRP4-XN-6. NC2184.2 +147700 MOVE "****" TO ID5-XN-4. NC2184.2 +147800 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +147900 MOVE 1 TO ID10-DU-2V0. NC2184.2 +148000 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +148100 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +148200 MOVE 1 TO REC-CT. NC2184.2 +148300* NC2184.2 +148400 UST-TEST-GF-12-1. NC2184.2 +148500 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +148600 ON OVERFLOW GO TO UST-FAIL-GF-12-1. NC2184.2 +148700 PERFORM PASS. NC2184.2 +148800 GO TO UST-WRITE-GF-12-1. NC2184.2 +148900 UST-DELETE-GF-12-1. NC2184.2 +149000 PERFORM DE-LETE. NC2184.2 +149100 PERFORM PRINT-DETAIL. NC2184.2 +149200 GO TO UST-INIT-GF-13. NC2184.2 +149300 UST-FAIL-GF-12-1. NC2184.2 +149400 PERFORM FAIL. NC2184.2 +149500 MOVE "OVERFLOW SHOULD NOT HAVE OCCURED" TO RE-MARK. NC2184.2 +149600 UST-WRITE-GF-12-1. NC2184.2 +149700 PERFORM PRINT-DETAIL. NC2184.2 +149800* NC2184.2 +149900 UST-TEST-GF-12-2. NC2184.2 +150000 MOVE "UST-TEST-GF-12" TO PAR-NAME. NC2184.2 +150100 ADD 1 TO REC-CT. NC2184.2 +150200 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +150300 PERFORM PASS NC2184.2 +150400 GO TO UST-WRITE-GF-12-2 NC2184.2 +150500 ELSE NC2184.2 +150600 GO TO UST-FAIL-GF-12-2. NC2184.2 +150700 UST-DELETE-GF-12-2. NC2184.2 +150800 PERFORM DE-LETE. NC2184.2 +150900 GO TO UST-WRITE-GF-12-2. NC2184.2 +151000 UST-FAIL-GF-12-2. NC2184.2 +151100 PERFORM FAIL NC2184.2 +151200 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +151300 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +151400 UST-WRITE-GF-12-2. NC2184.2 +151500 PERFORM PRINT-DETAIL. NC2184.2 +151600* NC2184.2 +151700 UST-INIT-GF-13. NC2184.2 +151800 MOVE "UST-TEST-GF-13" TO PAR-NAME. NC2184.2 +151900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +152000 MOVE "OVERFLOW EXPECTED" TO FEATURE. NC2184.2 +152100 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +152200 MOVE SPACES TO GRP4-XN-6. NC2184.2 +152300 MOVE "****" TO ID5-XN-4. NC2184.2 +152400 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +152500 MOVE 1 TO ID10-DU-2V0. NC2184.2 +152600 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +152700 MOVE 1 TO REC-CT. NC2184.2 +152800 UST-TEST-GF-13-1. NC2184.2 +152900 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX OVERFLOW PERFORM PASS NC2184.2 +153000 GO TO UST-WRITE-GF-13-1. NC2184.2 +153100 GO TO UST-FAIL-GF-13-1. NC2184.2 +153200 UST-DELETE-GF-13-1. NC2184.2 +153300 PERFORM DE-LETE. NC2184.2 +153400 PERFORM PRINT-DETAIL. NC2184.2 +153500 GO TO UST-INIT-GF-14. NC2184.2 +153600 UST-FAIL-GF-13-1. NC2184.2 +153700 PERFORM FAIL. NC2184.2 +153800 MOVE "OVERFLOW SHOULD HAVE OCCURED" TO RE-MARK. NC2184.2 +153900 UST-WRITE-GF-13-1. NC2184.2 +154000 PERFORM PRINT-DETAIL. NC2184.2 +154100* NC2184.2 +154200 UST-TEST-GF-13-2. NC2184.2 +154300 ADD 1 TO REC-CT. NC2184.2 +154400 IF GRP4-XN-6 = "ABCDE " NC2184.2 +154500 PERFORM PASS NC2184.2 +154600 GO TO UST-WRITE-GF-13-2 NC2184.2 +154700 ELSE NC2184.2 +154800 GO TO UST-FAIL-GF-13-2. NC2184.2 +154900 UST-DELETE-GF-13-2. NC2184.2 +155000 PERFORM DE-LETE. NC2184.2 +155100 GO TO UST-WRITE-GF-13-2. NC2184.2 +155200 UST-FAIL-GF-13-2. NC2184.2 +155300 PERFORM FAIL NC2184.2 +155400 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +155500 MOVE "ABCDE " TO CORRECT-A. NC2184.2 +155600 UST-WRITE-GF-13-2. NC2184.2 +155700 PERFORM PRINT-DETAIL. NC2184.2 +155800* NC2184.2 +155900 UST-INIT-GF-14. NC2184.2 +156000 MOVE "UST-TEST-GF-14" TO PAR-NAME. NC2184.2 +156100 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +156200 MOVE "INSTANT OVERFLOW" TO FEATURE. NC2184.2 +156300 MOVE SPACES TO GRP4-XN-6. NC2184.2 +156400 MOVE "****" TO ID5-XN-4. NC2184.2 +156500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +156600 MOVE 7 TO ID10-DU-2V0. NC2184.2 +156700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +156800 MOVE 1 TO REC-CT. NC2184.2 +156900* NC2184.2 +157000 UST-TEST-GF-14-1. NC2184.2 +157100 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X POINTER ID10-DU-2V0NC2184.2 +157200 OVERFLOW PERFORM PASS NC2184.2 +157300 GO TO UST-WRITE-GF-14-1. NC2184.2 +157400 GO TO UST-FAIL-GF-14-1. NC2184.2 +157500 UST-DELETE-GF-14-1. NC2184.2 +157600 PERFORM DE-LETE. NC2184.2 +157700 PERFORM PRINT-DETAIL. NC2184.2 +157800 GO TO UST-INIT-GF-15. NC2184.2 +157900 UST-FAIL-GF-14-1. NC2184.2 +158000 PERFORM FAIL. NC2184.2 +158100 MOVE "OVERFLOW SHOULD HAVE OCCURED" TO RE-MARK. NC2184.2 +158200 UST-WRITE-GF-14-1. NC2184.2 +158300 PERFORM PRINT-DETAIL. NC2184.2 +158400* NC2184.2 +158500 UST-TEST-GF-14-2. NC2184.2 +158600 MOVE "UST-TEST-GF-14" TO PAR-NAME. NC2184.2 +158700 ADD 1 TO REC-CT. NC2184.2 +158800 IF GRP4-XN-6 = SPACES NC2184.2 +158900 PERFORM PASS NC2184.2 +159000 GO TO UST-WRITE-GF-14-2 NC2184.2 +159100 ELSE NC2184.2 +159200 GO TO UST-FAIL-GF-14-2. NC2184.2 +159300 UST-DELETE-GF-14-2. NC2184.2 +159400 PERFORM DE-LETE. NC2184.2 +159500 GO TO UST-WRITE-GF-14-2. NC2184.2 +159600 UST-FAIL-GF-14-2. NC2184.2 +159700 PERFORM FAIL NC2184.2 +159800 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +159900 MOVE "ALL SPACES" TO CORRECT-A. NC2184.2 +160000 UST-WRITE-GF-14-2. NC2184.2 +160100 PERFORM PRINT-DETAIL. NC2184.2 +160200* NC2184.2 +160300 UST-TEST-GF-14-3. NC2184.2 +160400 ADD 1 TO REC-CT. NC2184.2 +160500 IF ID10-DU-2V0 = 7 NC2184.2 +160600 PERFORM PASS NC2184.2 +160700 GO TO UST-WRITE-GF-14-3 NC2184.2 +160800 ELSE NC2184.2 +160900 GO TO UST-FAIL-GF-14-3. NC2184.2 +161000 UST-DELETE-GF-14-3. NC2184.2 +161100 PERFORM DE-LETE. NC2184.2 +161200 GO TO UST-WRITE-GF-14-3. NC2184.2 +161300 UST-FAIL-GF-14-3. NC2184.2 +161400 PERFORM FAIL NC2184.2 +161500 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +161600 MOVE 7 TO CORRECT-N. NC2184.2 +161700 UST-WRITE-GF-14-3. NC2184.2 +161800 PERFORM PRINT-DETAIL. NC2184.2 +161900* NC2184.2 +162000 UST-INIT-GF-15. NC2184.2 +162100 MOVE "UST-TEST-GF-15" TO PAR-NAME. NC2184.2 +162200 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +162300 MOVE "POINTER NOT = 1" TO FEATURE. NC2184.2 +162400 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +162500 MOVE SPACES TO GRP4-XN-6. NC2184.2 +162600 MOVE "****" TO ID5-XN-4. NC2184.2 +162700 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +162800 MOVE 3 TO ID10-DU-2V0. NC2184.2 +162900 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +163000 MOVE 1 TO REC-CT. NC2184.2 +163100* NC2184.2 +163200 UST-TEST-GF-15-1. NC2184.2 +163300 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X POINTER ID10-DU-2V0NC2184.2 +163400 OVERFLOW GO TO UST-FAIL-GF-15-1. NC2184.2 +163500 PERFORM PASS NC2184.2 +163600 GO TO UST-WRITE-GF-15-1. NC2184.2 +163700 UST-DELETE-GF-15-1. NC2184.2 +163800 PERFORM DE-LETE. NC2184.2 +163900 PERFORM PRINT-DETAIL. NC2184.2 +164000 GO TO UST-INIT-GF-16. NC2184.2 +164100 UST-FAIL-GF-15-1. NC2184.2 +164200 PERFORM FAIL. NC2184.2 +164300 MOVE "OVERFLOW SHOULD NOT HAVE OCCURED" TO RE-MARK. NC2184.2 +164400 UST-WRITE-GF-15-1. NC2184.2 +164500 PERFORM PRINT-DETAIL. NC2184.2 +164600* NC2184.2 +164700 UST-TEST-GF-15-2. NC2184.2 +164800 ADD 1 TO REC-CT. NC2184.2 +164900 IF GRP4-XN-6 = "CDEF " NC2184.2 +165000 PERFORM PASS NC2184.2 +165100 GO TO UST-WRITE-GF-15-2 NC2184.2 +165200 ELSE NC2184.2 +165300 GO TO UST-FAIL-GF-15-2. NC2184.2 +165400 UST-DELETE-GF-15-2. NC2184.2 +165500 PERFORM DE-LETE. NC2184.2 +165600 GO TO UST-WRITE-GF-15-2. NC2184.2 +165700 UST-FAIL-GF-15-2. NC2184.2 +165800 PERFORM FAIL NC2184.2 +165900 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +166000 MOVE "CDEF " TO CORRECT-A. NC2184.2 +166100 UST-WRITE-GF-15-2. NC2184.2 +166200 PERFORM PRINT-DETAIL. NC2184.2 +166300* NC2184.2 +166400 UST-TEST-GF-15-3. NC2184.2 +166500 ADD 1 TO REC-CT. NC2184.2 +166600 IF ID10-DU-2V0 = 7 NC2184.2 +166700 PERFORM PASS NC2184.2 +166800 GO TO UST-WRITE-GF-15-3 NC2184.2 +166900 ELSE NC2184.2 +167000 GO TO UST-FAIL-GF-15-3. NC2184.2 +167100 UST-DELETE-GF-15-3. NC2184.2 +167200 PERFORM DE-LETE. NC2184.2 +167300 GO TO UST-WRITE-GF-15-3. NC2184.2 +167400 UST-FAIL-GF-15-3. NC2184.2 +167500 PERFORM FAIL NC2184.2 +167600 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +167700 MOVE 7 TO CORRECT-N. NC2184.2 +167800 UST-WRITE-GF-15-3. NC2184.2 +167900 PERFORM PRINT-DETAIL. NC2184.2 +168000* NC2184.2 +168100 UST-INIT-GF-16. NC2184.2 +168200 MOVE "UST-TEST-GF-16" TO PAR-NAME. NC2184.2 +168300 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +168400 MOVE "TALLY 3 FIELDS TEST" TO FEATURE. NC2184.2 +168500 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +168600 MOVE SPACES TO GRP4-XN-6. NC2184.2 +168700 MOVE "****" TO ID4C-XXXX. NC2184.2 +168800 MOVE "****" TO ID5-XN-4. NC2184.2 +168900 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +169000 MOVE 1 TO ID10-DU-2V0. NC2184.2 +169100 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +169200 MOVE 1 TO REC-CT. NC2184.2 +169300* NC2184.2 +169400 UST-TEST-GF-16-0. NC2184.2 +169500 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X ID4C-XXXX NC2184.2 +169600 TALLYING ID11-DU-2V0. NC2184.2 +169700 GO TO UST-TEST-GF-16-1. NC2184.2 +169800 UST-DELETE-GF-16. NC2184.2 +169900 PERFORM DE-LETE. NC2184.2 +170000 PERFORM PRINT-DETAIL. NC2184.2 +170100 GO TO UST-INIT-GF-17. NC2184.2 +170200* NC2184.2 +170300 UST-TEST-GF-16-1. NC2184.2 +170400 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +170500 PERFORM PASS NC2184.2 +170600 GO TO UST-WRITE-GF-16-1 NC2184.2 +170700 ELSE NC2184.2 +170800 GO TO UST-FAIL-GF-16-1. NC2184.2 +170900 UST-DELETE-GF-16-1. NC2184.2 +171000 PERFORM DE-LETE. NC2184.2 +171100 GO TO UST-WRITE-GF-16-1. NC2184.2 +171200 UST-FAIL-GF-16-1. NC2184.2 +171300 PERFORM FAIL NC2184.2 +171400 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +171500 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +171600 UST-WRITE-GF-16-1. NC2184.2 +171700 PERFORM PRINT-DETAIL. NC2184.2 +171800* NC2184.2 +171900 UST-TEST-GF-16-2. NC2184.2 +172000 ADD 1 TO REC-CT. NC2184.2 +172100 IF ID4C-XXXX = "****" NC2184.2 +172200 PERFORM PASS NC2184.2 +172300 GO TO UST-WRITE-GF-16-2 NC2184.2 +172400 ELSE NC2184.2 +172500 GO TO UST-FAIL-GF-16-2. NC2184.2 +172600 UST-DELETE-GF-16-2. NC2184.2 +172700 PERFORM DE-LETE. NC2184.2 +172800 GO TO UST-WRITE-GF-16-2. NC2184.2 +172900 UST-FAIL-GF-16-2. NC2184.2 +173000 PERFORM FAIL NC2184.2 +173100 MOVE ID4C-XXXX TO COMPUTED-A NC2184.2 +173200 MOVE "****" TO CORRECT-A. NC2184.2 +173300 UST-WRITE-GF-16-2. NC2184.2 +173400 PERFORM PRINT-DETAIL. NC2184.2 +173500* NC2184.2 +173600 UST-TEST-GF-16-3. NC2184.2 +173700 ADD 1 TO REC-CT. NC2184.2 +173800 IF ID11-DU-2V0 = 2 NC2184.2 +173900 PERFORM PASS NC2184.2 +174000 GO TO UST-WRITE-GF-16-3 NC2184.2 +174100 ELSE NC2184.2 +174200 GO TO UST-FAIL-GF-16-3. NC2184.2 +174300 UST-DELETE-GF-16-3. NC2184.2 +174400 PERFORM DE-LETE. NC2184.2 +174500 GO TO UST-WRITE-GF-16-3. NC2184.2 +174600 UST-FAIL-GF-16-3. NC2184.2 +174700 PERFORM FAIL NC2184.2 +174800 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +174900 MOVE 2 TO CORRECT-N. NC2184.2 +175000 UST-WRITE-GF-16-3. NC2184.2 +175100 PERFORM PRINT-DETAIL. NC2184.2 +175200* NC2184.2 +175300 UST-INIT-GF-17. NC2184.2 +175400 MOVE "UST-TEST-GF-17" TO PAR-NAME. NC2184.2 +175500 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +175600 MOVE "QUAL DEL BY POINT" TO FEATURE. NC2184.2 +175700 MOVE "ABCDEFG" TO GRP1-XN-7. NC2184.2 +175800 MOVE "BCDEFGH" TO GRP2-XN-7. NC2184.2 +175900 MOVE SPACES TO GRP4-XN-6. NC2184.2 +176000 MOVE ALL "*" TO ID5-XN-6. NC2184.2 +176100 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +176200 MOVE 2 TO ID10-DU-2V0. NC2184.2 +176300 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +176400 MOVE 1 TO REC-CT. NC2184.2 +176500* NC2184.2 +176600 UST-TEST-GF-17. NC2184.2 +176700 UNSTRING GRP1-XN-7 DELIMITED BY ID2 (ID10-DU-2V0) NC2184.2 +176800 INTO GRP4-XN-6 NC2184.2 +176900 DELIMITER IN ID5-XN-6 NC2184.2 +177000 COUNT ID6-DU-2V0 NC2184.2 +177100 POINTER ID10-DU-2V0. NC2184.2 +177200 GO TO UST-TEST-GF-17-1. NC2184.2 +177300 UST-DELETE-GF-17. NC2184.2 +177400 PERFORM DE-LETE. NC2184.2 +177500 PERFORM PRINT-DETAIL. NC2184.2 +177600 GO TO UST-INIT-GF-18. NC2184.2 +177700* NC2184.2 +177800 UST-TEST-GF-17-1. NC2184.2 +177900 IF GRP4-XN-6 = "B " NC2184.2 +178000 PERFORM PASS NC2184.2 +178100 GO TO UST-WRITE-GF-17-1 NC2184.2 +178200 ELSE NC2184.2 +178300 GO TO UST-FAIL-GF-17-1. NC2184.2 +178400 UST-DELETE-GF-17-1. NC2184.2 +178500 PERFORM DE-LETE. NC2184.2 +178600 GO TO UST-WRITE-GF-17-1. NC2184.2 +178700 UST-FAIL-GF-17-1. NC2184.2 +178800 PERFORM FAIL NC2184.2 +178900 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +179000 MOVE "B " TO CORRECT-A. NC2184.2 +179100 UST-WRITE-GF-17-1. NC2184.2 +179200 PERFORM PRINT-DETAIL. NC2184.2 +179300* NC2184.2 +179400 UST-TEST-GF-17-2. NC2184.2 +179500 ADD 1 TO REC-CT. NC2184.2 +179600 IF ID5-XN-6 = "C " NC2184.2 +179700 PERFORM PASS NC2184.2 +179800 GO TO UST-WRITE-GF-17-2 NC2184.2 +179900 ELSE NC2184.2 +180000 GO TO UST-FAIL-GF-17-2. NC2184.2 +180100 UST-DELETE-GF-17-2. NC2184.2 +180200 PERFORM DE-LETE. NC2184.2 +180300 GO TO UST-WRITE-GF-17-2. NC2184.2 +180400 UST-FAIL-GF-17-2. NC2184.2 +180500 PERFORM FAIL NC2184.2 +180600 MOVE ID5-XN-6 TO COMPUTED-A NC2184.2 +180700 MOVE "C " TO CORRECT-A. NC2184.2 +180800 UST-WRITE-GF-17-2. NC2184.2 +180900 PERFORM PRINT-DETAIL. NC2184.2 +181000* NC2184.2 +181100 UST-TEST-GF-17-3. NC2184.2 +181200 ADD 1 TO REC-CT. NC2184.2 +181300 IF ID6-DU-2V0 = 1 NC2184.2 +181400 PERFORM PASS NC2184.2 +181500 GO TO UST-WRITE-GF-17-3 NC2184.2 +181600 ELSE NC2184.2 +181700 GO TO UST-FAIL-GF-17-3. NC2184.2 +181800 UST-DELETE-GF-17-3. NC2184.2 +181900 PERFORM DE-LETE. NC2184.2 +182000 GO TO UST-WRITE-GF-17-3. NC2184.2 +182100 UST-FAIL-GF-17-3. NC2184.2 +182200 PERFORM FAIL NC2184.2 +182300 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +182400 MOVE 1 TO CORRECT-N. NC2184.2 +182500 UST-WRITE-GF-17-3. NC2184.2 +182600 PERFORM PRINT-DETAIL. NC2184.2 +182700* NC2184.2 +182800 UST-TEST-GF-17-4. NC2184.2 +182900 ADD 1 TO REC-CT. NC2184.2 +183000 IF ID10-DU-2V0 = 4 NC2184.2 +183100 PERFORM PASS NC2184.2 +183200 GO TO UST-WRITE-GF-17-4 NC2184.2 +183300 ELSE NC2184.2 +183400 GO TO UST-FAIL-GF-17-4. NC2184.2 +183500 UST-DELETE-GF-17-4. NC2184.2 +183600 PERFORM DE-LETE. NC2184.2 +183700 GO TO UST-WRITE-GF-17-4. NC2184.2 +183800 UST-FAIL-GF-17-4. NC2184.2 +183900 PERFORM FAIL NC2184.2 +184000 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +184100 MOVE 4 TO CORRECT-N. NC2184.2 +184200 UST-WRITE-GF-17-4. NC2184.2 +184300 PERFORM PRINT-DETAIL. NC2184.2 +184400* NC2184.2 +184500 UST-INIT-GF-18. NC2184.2 +184600 ADD 1 TO REC-CT. NC2184.2 +184700 MOVE "UST-TEST-GF-18" TO PAR-NAME. NC2184.2 +184800 MOVE "VI-136" TO ANSI-REFERENCE. NC2184.2 +184900 MOVE "QUAL DEL BY TALLY" TO FEATURE. NC2184.2 +185000 MOVE "ABCDEFG" TO GRP1-XN-7. NC2184.2 +185100 MOVE "CE" TO GRP2-XN-2. NC2184.2 +185200 MOVE SPACES TO GRP4-XN-6. NC2184.2 +185300 MOVE "****" TO ID5-XN-4. NC2184.2 +185400 MOVE "****" TO ID5-XN-4-2. NC2184.2 +185500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +185600 MOVE ZERO TO ID6-DU-2V0-2. NC2184.2 +185700 MOVE 1 TO ID10-DU-2V0. NC2184.2 +185800 MOVE 1 TO ID11-DU-2V0. NC2184.2 +185900 MOVE 1 TO REC-CT. NC2184.2 +186000* NC2184.2 +186100 UST-TEST-GF-18. NC2184.2 +186200 UNSTRING GRP1-XN-7 DELIMITED ID2A (ID10-DU-2V0) NC2184.2 +186300 INTO ID4A-XXXXX NC2184.2 +186400 DELIMITER IN ID5-XN-4 NC2184.2 +186500 COUNT ID6-DU-2V0 NC2184.2 +186600 ID4B-X DELIMITER IN ID5-XN-4-2 NC2184.2 +186700 COUNT ID6-DU-2V0-2 NC2184.2 +186800 TALLYING ID11-DU-2V0. NC2184.2 +186900 GO TO UST-TEST-GF-18-1. NC2184.2 +187000 UST-DELETE-GF-18. NC2184.2 +187100 PERFORM DE-LETE. NC2184.2 +187200 PERFORM PRINT-DETAIL. NC2184.2 +187300 GO TO UST-INIT-GF-19. NC2184.2 +187400* NC2184.2 +187500 UST-TEST-GF-18-1. NC2184.2 +187600 IF GRP4-XN-6 = "AB D" NC2184.2 +187700 PERFORM PASS NC2184.2 +187800 GO TO UST-WRITE-GF-18-1 NC2184.2 +187900 ELSE NC2184.2 +188000 GO TO UST-FAIL-GF-18-1. NC2184.2 +188100 UST-DELETE-GF-18-1. NC2184.2 +188200 PERFORM DE-LETE. NC2184.2 +188300 GO TO UST-WRITE-GF-18-1. NC2184.2 +188400 UST-FAIL-GF-18-1. NC2184.2 +188500 PERFORM FAIL NC2184.2 +188600 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +188700 MOVE "AB D" TO CORRECT-A. NC2184.2 +188800 UST-WRITE-GF-18-1. NC2184.2 +188900 PERFORM PRINT-DETAIL. NC2184.2 +189000* NC2184.2 +189100 UST-TEST-GF-18-2. NC2184.2 +189200 ADD 1 TO REC-CT. NC2184.2 +189300 IF ID5-XN-4 = "C " NC2184.2 +189400 PERFORM PASS NC2184.2 +189500 GO TO UST-WRITE-GF-18-2 NC2184.2 +189600 ELSE NC2184.2 +189700 GO TO UST-FAIL-GF-18-2. NC2184.2 +189800 UST-DELETE-GF-18-2. NC2184.2 +189900 PERFORM DE-LETE. NC2184.2 +190000 GO TO UST-WRITE-GF-18-2. NC2184.2 +190100 UST-FAIL-GF-18-2. NC2184.2 +190200 PERFORM FAIL NC2184.2 +190300 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +190400 MOVE "C " TO CORRECT-A. NC2184.2 +190500 UST-WRITE-GF-18-2. NC2184.2 +190600 PERFORM PRINT-DETAIL. NC2184.2 +190700* NC2184.2 +190800 UST-TEST-GF-18-3. NC2184.2 +190900 ADD 1 TO REC-CT. NC2184.2 +191000 IF ID6-DU-2V0 = 2 NC2184.2 +191100 PERFORM PASS NC2184.2 +191200 GO TO UST-WRITE-GF-18-3 NC2184.2 +191300 ELSE NC2184.2 +191400 GO TO UST-FAIL-GF-18-3. NC2184.2 +191500 UST-DELETE-GF-18-3. NC2184.2 +191600 PERFORM DE-LETE. NC2184.2 +191700 GO TO UST-WRITE-GF-18-3. NC2184.2 +191800 UST-FAIL-GF-18-3. NC2184.2 +191900 PERFORM FAIL NC2184.2 +192000 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +192100 MOVE 2 TO CORRECT-N. NC2184.2 +192200 UST-WRITE-GF-18-3. NC2184.2 +192300 PERFORM PRINT-DETAIL. NC2184.2 +192400* NC2184.2 +192500 UST-TEST-GF-18-4. NC2184.2 +192600 ADD 1 TO REC-CT. NC2184.2 +192700 IF ID6-DU-2V0-2 EQUAL TO 4 NC2184.2 +192800 PERFORM PASS NC2184.2 +192900 GO TO UST-WRITE-GF-18-4 NC2184.2 +193000 ELSE NC2184.2 +193100 GO TO UST-FAIL-GF-18-4. NC2184.2 +193200 UST-DELETE-GF-18-4. NC2184.2 +193300 PERFORM DE-LETE. NC2184.2 +193400 GO TO UST-WRITE-GF-18-4. NC2184.2 +193500 UST-FAIL-GF-18-4. NC2184.2 +193600 PERFORM FAIL NC2184.2 +193700 MOVE ID6-DU-2V0-2 TO COMPUTED-N NC2184.2 +193800 MOVE 4 TO CORRECT-N. NC2184.2 +193900 UST-WRITE-GF-18-4. NC2184.2 +194000 PERFORM PRINT-DETAIL. NC2184.2 +194100* NC2184.2 +194200 UST-TEST-GF-18-5. NC2184.2 +194300 ADD 1 TO REC-CT. NC2184.2 +194400 IF ID11-DU-2V0 = 3 NC2184.2 +194500 PERFORM PASS NC2184.2 +194600 GO TO UST-WRITE-GF-18-5 NC2184.2 +194700 ELSE NC2184.2 +194800 GO TO UST-FAIL-GF-18-5. NC2184.2 +194900 UST-DELETE-GF-18-5. NC2184.2 +195000 PERFORM DE-LETE. NC2184.2 +195100 GO TO UST-WRITE-GF-18-5. NC2184.2 +195200 UST-FAIL-GF-18-5. NC2184.2 +195300 PERFORM FAIL NC2184.2 +195400 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +195500 MOVE 3 TO CORRECT-N. NC2184.2 +195600 UST-WRITE-GF-18-5. NC2184.2 +195700 PERFORM PRINT-DETAIL. NC2184.2 +195800* NC2184.2 +195900 UST-TEST-GF-18-6. NC2184.2 +196000 ADD 1 TO REC-CT. NC2184.2 +196100 IF ID5-XN-4-2 = SPACES AND ID6-DU-2V0-2 = 4 NC2184.2 +196200 PERFORM PASS NC2184.2 +196300 GO TO UST-WRITE-GF-18-6 NC2184.2 +196400 ELSE NC2184.2 +196500 GO TO UST-FAIL-GF-18-6. NC2184.2 +196600 UST-DELETE-GF-18-6. NC2184.2 +196700 PERFORM DE-LETE. NC2184.2 +196800 GO TO UST-WRITE-GF-18-6. NC2184.2 +196900 UST-FAIL-GF-18-6. NC2184.2 +197000 PERFORM FAIL NC2184.2 +197100 MOVE ID5-XN-4-2 TO COMPUTED-A NC2184.2 +197200 MOVE 4 TO CORRECT-A. NC2184.2 +197300 UST-WRITE-GF-18-6. NC2184.2 +197400 PERFORM PRINT-DETAIL. NC2184.2 +197500* NC2184.2 +197600 UST-INIT-GF-19. NC2184.2 +197700 MOVE "UST-TEST-GF-19" TO PAR-NAME. NC2184.2 +197800 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +197900 MOVE "QUALIFIED ID1" TO FEATURE. NC2184.2 +198000 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" TO GRP1-XN-X-36. NC2184.2 +198100 MOVE SPACES TO GRP4-XN-6. NC2184.2 +198200 MOVE "****" TO ID5-XN-4. NC2184.2 +198300 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +198400 MOVE 1 TO ID10-DU-2V0. NC2184.2 +198500 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +198600 MOVE 1 TO REC-CT. NC2184.2 +198700* NC2184.2 +198800 UST-TEST-GF-19-0. NC2184.2 +198900 UNSTRING ID1 OF GRP1-XN-X-36 (ID10-DU-2V0) INTO GRP4-XN-6 NC2184.2 +199000 POINTER ID10-DU-2V0. NC2184.2 +199100 GO TO UST-TEST-GF-19-1. NC2184.2 +199200 UST-DELETE-GF-19. NC2184.2 +199300 PERFORM DE-LETE. NC2184.2 +199400 PERFORM PRINT-DETAIL. NC2184.2 +199500 GO TO UST-INIT-GF-20. NC2184.2 +199600* NC2184.2 +199700 UST-TEST-GF-19-1. NC2184.2 +199800 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +199900 PERFORM PASS NC2184.2 +200000 GO TO UST-WRITE-GF-19-1 NC2184.2 +200100 ELSE NC2184.2 +200200 GO TO UST-FAIL-GF-19-1. NC2184.2 +200300 UST-DELETE-GF-19-1. NC2184.2 +200400 PERFORM DE-LETE. NC2184.2 +200500 GO TO UST-WRITE-GF-19-1. NC2184.2 +200600 UST-FAIL-GF-19-1. NC2184.2 +200700 PERFORM FAIL NC2184.2 +200800 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +200900 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +201000 UST-WRITE-GF-19-1. NC2184.2 +201100 PERFORM PRINT-DETAIL. NC2184.2 +201200* NC2184.2 +201300 UST-TEST-GF-19-2. NC2184.2 +201400 ADD 1 TO REC-CT. NC2184.2 +201500 IF ID10-DU-2V0 = 7 NC2184.2 +201600 PERFORM PASS NC2184.2 +201700 GO TO UST-WRITE-GF-19-2 NC2184.2 +201800 ELSE NC2184.2 +201900 GO TO UST-FAIL-GF-19-2. NC2184.2 +202000 UST-DELETE-GF-19-2. NC2184.2 +202100 PERFORM DE-LETE. NC2184.2 +202200 GO TO UST-WRITE-GF-19-2. NC2184.2 +202300 UST-FAIL-GF-19-2. NC2184.2 +202400 PERFORM FAIL NC2184.2 +202500 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +202600 MOVE 7 TO CORRECT-N. NC2184.2 +202700 UST-WRITE-GF-19-2. NC2184.2 +202800 PERFORM PRINT-DETAIL. NC2184.2 +202900* NC2184.2 +203000 UST-TEST-GF-19-3. NC2184.2 +203100 ADD 1 TO REC-CT. NC2184.2 +203200 IF ID11-DU-2V0 = ZERO NC2184.2 +203300 PERFORM PASS NC2184.2 +203400 GO TO UST-WRITE-GF-19-3 NC2184.2 +203500 ELSE NC2184.2 +203600 GO TO UST-FAIL-GF-19-3. NC2184.2 +203700 UST-DELETE-GF-19-3. NC2184.2 +203800 PERFORM DE-LETE. NC2184.2 +203900 GO TO UST-WRITE-GF-19-3. NC2184.2 +204000 UST-FAIL-GF-19-3. NC2184.2 +204100 PERFORM FAIL NC2184.2 +204200 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +204300 MOVE ZERO TO CORRECT-N. NC2184.2 +204400 UST-WRITE-GF-19-3. NC2184.2 +204500 PERFORM PRINT-DETAIL. NC2184.2 +204600* NC2184.2 +204700 UST-INIT-GF-20. NC2184.2 +204800 MOVE "UST-TEST-GF-20" TO PAR-NAME. NC2184.2 +204900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +205000 MOVE "MULT RECEIVE AREAS" TO FEATURE. NC2184.2 +205100 MOVE SPACES TO GRP4-XN-6. NC2184.2 +205200 MOVE "****" TO ID4C-XXXX. NC2184.2 +205300 MOVE "*" TO ID4D-X. NC2184.2 +205400 MOVE "****" TO ID5-XN-4. NC2184.2 +205500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +205600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +205700 MOVE 1 TO ID11-DU-2V0. NC2184.2 +205800 MOVE 1 TO REC-CT. NC2184.2 +205900* NC2184.2 +206000 UST-TEST-GF-20. NC2184.2 +206100 UNSTRING ID1 OF GRP1-XN-X-36 (ID11-DU-2V0) NC2184.2 +206200 INTO ID4A-XXXXX ID4B-X ID4C-XXXX ID4D-X NC2184.2 +206300 TALLYING ID11-DU-2V0. NC2184.2 +206400 GO TO UST-TEST-GF-20-1. NC2184.2 +206500 UST-DELETE-GF-20. NC2184.2 +206600 PERFORM DE-LETE. NC2184.2 +206700 PERFORM PRINT-DETAIL. NC2184.2 +206800 GO TO UST-INIT-GF-21. NC2184.2 +206900* NC2184.2 +207000 UST-TEST-GF-20-1. NC2184.2 +207100 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +207200 PERFORM PASS NC2184.2 +207300 GO TO UST-WRITE-GF-20-1 NC2184.2 +207400 ELSE NC2184.2 +207500 GO TO UST-FAIL-GF-20-1. NC2184.2 +207600 UST-DELETE-GF-20-1. NC2184.2 +207700 PERFORM DE-LETE. NC2184.2 +207800 GO TO UST-WRITE-GF-20-1. NC2184.2 +207900 UST-FAIL-GF-20-1. NC2184.2 +208000 PERFORM FAIL NC2184.2 +208100 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +208200 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +208300 UST-WRITE-GF-20-1. NC2184.2 +208400 PERFORM PRINT-DETAIL. NC2184.2 +208500* NC2184.2 +208600 UST-TEST-GF-20-2. NC2184.2 +208700 ADD 1 TO REC-CT. NC2184.2 +208800 IF ID4C-XXXX = "****" NC2184.2 +208900 PERFORM PASS NC2184.2 +209000 GO TO UST-WRITE-GF-20-2 NC2184.2 +209100 ELSE NC2184.2 +209200 GO TO UST-FAIL-GF-20-2. NC2184.2 +209300 UST-DELETE-GF-20-2. NC2184.2 +209400 PERFORM DE-LETE. NC2184.2 +209500 GO TO UST-WRITE-GF-20-2. NC2184.2 +209600 UST-FAIL-GF-20-2. NC2184.2 +209700 PERFORM FAIL NC2184.2 +209800 MOVE ID4C-XXXX TO COMPUTED-A NC2184.2 +209900 MOVE "****" TO CORRECT-A. NC2184.2 +210000 UST-WRITE-GF-20-2. NC2184.2 +210100 PERFORM PRINT-DETAIL. NC2184.2 +210200* NC2184.2 +210300 UST-TEST-GF-20-3. NC2184.2 +210400 ADD 1 TO REC-CT. NC2184.2 +210500 IF ID4D-X = "*" NC2184.2 +210600 PERFORM PASS NC2184.2 +210700 GO TO UST-WRITE-GF-20-3 NC2184.2 +210800 ELSE NC2184.2 +210900 GO TO UST-FAIL-GF-20-3. NC2184.2 +211000 UST-DELETE-GF-20-3. NC2184.2 +211100 PERFORM DE-LETE. NC2184.2 +211200 GO TO UST-WRITE-GF-20-3. NC2184.2 +211300 UST-FAIL-GF-20-3. NC2184.2 +211400 PERFORM FAIL NC2184.2 +211500 MOVE ID4D-X TO COMPUTED-A NC2184.2 +211600 MOVE "*" TO CORRECT-A. NC2184.2 +211700 UST-WRITE-GF-20-3. NC2184.2 +211800 PERFORM PRINT-DETAIL. NC2184.2 +211900* NC2184.2 +212000 UST-TEST-GF-20-4. NC2184.2 +212100 ADD 1 TO REC-CT. NC2184.2 +212200 IF ID11-DU-2V0 = 3 NC2184.2 +212300 PERFORM PASS NC2184.2 +212400 GO TO UST-WRITE-GF-20-4 NC2184.2 +212500 ELSE NC2184.2 +212600 GO TO UST-FAIL-GF-20-4. NC2184.2 +212700 UST-DELETE-GF-20-4. NC2184.2 +212800 PERFORM DE-LETE. NC2184.2 +212900 GO TO UST-WRITE-GF-20-4. NC2184.2 +213000 UST-FAIL-GF-20-4. NC2184.2 +213100 PERFORM FAIL NC2184.2 +213200 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +213300 MOVE 3 TO CORRECT-N. NC2184.2 +213400 UST-WRITE-GF-20-4. NC2184.2 +213500 PERFORM PRINT-DETAIL. NC2184.2 +213600* NC2184.2 +213700 UST-INIT-GF-21. NC2184.2 +213800 MOVE "UST-TEST-GF-21" TO PAR-NAME. NC2184.2 +213900 MOVE "VI-135" TO ANSI-REFERENCE. NC2184.2 +214000 MOVE "TRUNCATION CHECKS" TO FEATURE. NC2184.2 +214100 MOVE "ABCDEFGHIJKL" TO ID1-XN-12. NC2184.2 +214200 MOVE ALL "*" TO GRP4-XN-10. NC2184.2 +214300 MOVE 1 TO ID11-DU-2V0. NC2184.2 +214400 MOVE 1 TO REC-CT. NC2184.2 +214500* NC2184.2 +214600 UST-TEST-GF-21. NC2184.2 +214700 UNSTRING ID1-XN-12 NC2184.2 +214800 DELIMITED BY "E" OR "H" OR "K" OR "L" NC2184.2 +214900 INTO ID4C-XXX ID4B-XX ID4A-X NC2184.2 +215000 TALLYING IN ID11-DU-2V0. NC2184.2 +215100 GO TO UST-TEST-GF-21-1. NC2184.2 +215200 UNSTRING-DELETE. NC2184.2 +215300 PERFORM DE-LETE. NC2184.2 +215400 PERFORM PRINT-DETAIL. NC2184.2 +215500 GO TO UST-INIT-GF-22. NC2184.2 +215600* NC2184.2 +215700 UST-TEST-GF-21-1. NC2184.2 +215800 IF ID4C-XXX = "ABC" NC2184.2 +215900 PERFORM PASS NC2184.2 +216000 GO TO UST-WRITE-GF-21-1 NC2184.2 +216100 ELSE NC2184.2 +216200 GO TO UST-FAIL-GF-21-1. NC2184.2 +216300 UST-DELETE-GF-21-1. NC2184.2 +216400 PERFORM DE-LETE. NC2184.2 +216500 GO TO UST-WRITE-GF-21-1. NC2184.2 +216600 UST-FAIL-GF-21-1. NC2184.2 +216700 PERFORM FAIL NC2184.2 +216800 MOVE ID4C-XXX TO COMPUTED-A NC2184.2 +216900 MOVE "ABC" TO CORRECT-A. NC2184.2 +217000 UST-WRITE-GF-21-1. NC2184.2 +217100 PERFORM PRINT-DETAIL. NC2184.2 +217200* NC2184.2 +217300 UST-TEST-GF-21-2. NC2184.2 +217400 ADD 1 TO REC-CT. NC2184.2 +217500 IF ID4B-XX = "FG" NC2184.2 +217600 PERFORM PASS NC2184.2 +217700 GO TO UST-WRITE-GF-21-2 NC2184.2 +217800 ELSE NC2184.2 +217900 GO TO UST-FAIL-GF-21-2. NC2184.2 +218000 UST-DELETE-GF-21-2. NC2184.2 +218100 PERFORM DE-LETE. NC2184.2 +218200 GO TO UST-WRITE-GF-21-2. NC2184.2 +218300 UST-FAIL-GF-21-2. NC2184.2 +218400 PERFORM FAIL NC2184.2 +218500 MOVE ID4B-XX TO COMPUTED-A NC2184.2 +218600 MOVE "FG" TO CORRECT-A. NC2184.2 +218700 UST-WRITE-GF-21-2. NC2184.2 +218800 PERFORM PRINT-DETAIL. NC2184.2 +218900* NC2184.2 +219000 UST-TEST-GF-21-3. NC2184.2 +219100 ADD 1 TO REC-CT. NC2184.2 +219200 IF ID4A-X = "I" NC2184.2 +219300 PERFORM PASS NC2184.2 +219400 GO TO UST-WRITE-GF-21-3 NC2184.2 +219500 ELSE NC2184.2 +219600 GO TO UST-FAIL-GF-21-3. NC2184.2 +219700 UST-DELETE-GF-21-3. NC2184.2 +219800 PERFORM DE-LETE. NC2184.2 +219900 GO TO UST-WRITE-GF-21-3. NC2184.2 +220000 UST-FAIL-GF-21-3. NC2184.2 +220100 PERFORM FAIL NC2184.2 +220200 MOVE ID4A-X TO COMPUTED-A NC2184.2 +220300 MOVE "I" TO CORRECT-A. NC2184.2 +220400 UST-WRITE-GF-21-3. NC2184.2 +220500 PERFORM PRINT-DETAIL. NC2184.2 +220600* NC2184.2 +220700 UST-TEST-GF-21-4. NC2184.2 +220800 ADD 1 TO REC-CT. NC2184.2 +220900 IF ID11-DU-2V0 = 4 NC2184.2 +221000 PERFORM PASS NC2184.2 +221100 GO TO UST-WRITE-GF-21-4 NC2184.2 +221200 ELSE NC2184.2 +221300 GO TO UST-FAIL-GF-21-4. NC2184.2 +221400 UST-DELETE-GF-21-4. NC2184.2 +221500 PERFORM DE-LETE. NC2184.2 +221600 GO TO UST-WRITE-GF-21-4. NC2184.2 +221700 UST-FAIL-GF-21-4. NC2184.2 +221800 PERFORM FAIL NC2184.2 +221900 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +222000 MOVE 4 TO CORRECT-N. NC2184.2 +222100 UST-WRITE-GF-21-4. NC2184.2 +222200 PERFORM PRINT-DETAIL. NC2184.2 +222300* NC2184.2 +222400 UST-INIT-GF-22. NC2184.2 +222500* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2184.2 +222600 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +222700 MOVE "UST-TEST-GF-22" TO PAR-NAME. NC2184.2 +222800 MOVE "PIC X " TO FEATURE. NC2184.2 +222900 MOVE ZERO TO ID4-X. NC2184.2 +223000 MOVE "****" TO ID5-XN-4. NC2184.2 +223100 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +223200 MOVE 1 TO ID10-DU-2V0. NC2184.2 +223300 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +223400 MOVE 1 TO REC-CT. NC2184.2 +223500* NC2184.2 +223600 UST-TEST-GF-22-1. NC2184.2 +223700 UNSTRING ID1-XN-7 DELIMITED BY ZERO INTO ID4-X DELIMITER IN NC2184.2 +223800 ID5-XN-4 COUNT IN ID6-DU-2V0 WITH POINTER ID10-DU-2V0NC2184.2 +223900 TALLYING ID11-DU-2V0 NC2184.2 +224000 NOT ON OVERFLOW GO TO UST-FAIL-GF-22-1. NC2184.2 +224100 PERFORM PASS. NC2184.2 +224200 GO TO UST-WRITE-GF-22-1. NC2184.2 +224300 UST-DELETE-GF-22-1. NC2184.2 +224400 PERFORM DE-LETE. NC2184.2 +224500 PERFORM PRINT-DETAIL. NC2184.2 +224600 GO TO UST-INIT-GF-23. NC2184.2 +224700 UST-FAIL-GF-22-1. NC2184.2 +224800 PERFORM FAIL. NC2184.2 +224900 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK.NC2184.2 +225000 UST-WRITE-GF-22-1. NC2184.2 +225100 PERFORM PRINT-DETAIL. NC2184.2 +225200* NC2184.2 +225300 UST-TEST-GF-22-2. NC2184.2 +225400 ADD 1 TO REC-CT. NC2184.2 +225500 IF ID4-X = "1" NC2184.2 +225600 PERFORM PASS NC2184.2 +225700 GO TO UST-WRITE-GF-22-2 NC2184.2 +225800 ELSE NC2184.2 +225900 GO TO UST-FAIL-GF-22-2. NC2184.2 +226000 UST-DELETE-GF-22-2. NC2184.2 +226100 PERFORM DE-LETE. NC2184.2 +226200 GO TO UST-WRITE-GF-22-2. NC2184.2 +226300 UST-FAIL-GF-22-2. NC2184.2 +226400 PERFORM FAIL NC2184.2 +226500 MOVE ID4-X TO COMPUTED-A NC2184.2 +226600 MOVE "1" TO CORRECT-A. NC2184.2 +226700 UST-WRITE-GF-22-2. NC2184.2 +226800 PERFORM PRINT-DETAIL. NC2184.2 +226900* NC2184.2 +227000 UST-TEST-GF-22-3. NC2184.2 +227100 ADD 1 TO REC-CT. NC2184.2 +227200 IF ID5-XN-4 = "0 " NC2184.2 +227300 PERFORM PASS NC2184.2 +227400 GO TO UST-WRITE-GF-22-3 NC2184.2 +227500 ELSE NC2184.2 +227600 GO TO UST-FAIL-GF-22-3. NC2184.2 +227700 UST-DELETE-GF-22-3. NC2184.2 +227800 PERFORM DE-LETE. NC2184.2 +227900 GO TO UST-WRITE-GF-22-3. NC2184.2 +228000 UST-FAIL-GF-22-3. NC2184.2 +228100 PERFORM FAIL NC2184.2 +228200 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +228300 MOVE "0 " TO CORRECT-A. NC2184.2 +228400 UST-WRITE-GF-22-3. NC2184.2 +228500 PERFORM PRINT-DETAIL. NC2184.2 +228600* NC2184.2 +228700 UST-TEST-GF-22-4. NC2184.2 +228800 ADD 1 TO REC-CT. NC2184.2 +228900 IF ID6-DU-2V0 = 2 NC2184.2 +229000 PERFORM PASS NC2184.2 +229100 GO TO UST-WRITE-GF-22-4 NC2184.2 +229200 ELSE NC2184.2 +229300 GO TO UST-FAIL-GF-22-4. NC2184.2 +229400 UST-DELETE-GF-22-4. NC2184.2 +229500 PERFORM DE-LETE. NC2184.2 +229600 GO TO UST-WRITE-GF-22-4. NC2184.2 +229700 UST-FAIL-GF-22-4. NC2184.2 +229800 PERFORM FAIL NC2184.2 +229900 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +230000 MOVE 2 TO CORRECT-N. NC2184.2 +230100 UST-WRITE-GF-22-4. NC2184.2 +230200 PERFORM PRINT-DETAIL. NC2184.2 +230300* NC2184.2 +230400 UST-TEST-GF-22-5. NC2184.2 +230500 ADD 1 TO REC-CT. NC2184.2 +230600 IF ID10-DU-2V0 = 4 NC2184.2 +230700 PERFORM PASS NC2184.2 +230800 GO TO UST-WRITE-GF-22-5 NC2184.2 +230900 ELSE NC2184.2 +231000 GO TO UST-FAIL-GF-22-5. NC2184.2 +231100 UST-DELETE-GF-22-5. NC2184.2 +231200 PERFORM DE-LETE. NC2184.2 +231300 GO TO UST-WRITE-GF-22-5. NC2184.2 +231400 UST-FAIL-GF-22-5. NC2184.2 +231500 PERFORM FAIL NC2184.2 +231600 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +231700 MOVE 4 TO CORRECT-N. NC2184.2 +231800 UST-WRITE-GF-22-5. NC2184.2 +231900 PERFORM PRINT-DETAIL. NC2184.2 +232000* NC2184.2 +232100 UST-TEST-GF-22-6. NC2184.2 +232200 ADD 1 TO REC-CT. NC2184.2 +232300 IF ID11-DU-2V0 = 1 NC2184.2 +232400 PERFORM PASS NC2184.2 +232500 GO TO UST-WRITE-GF-22-6 NC2184.2 +232600 ELSE NC2184.2 +232700 GO TO UST-FAIL-GF-22-6. NC2184.2 +232800 UST-DELETE-GF-22-6. NC2184.2 +232900 PERFORM DE-LETE. NC2184.2 +233000 GO TO UST-WRITE-GF-22-6. NC2184.2 +233100 UST-FAIL-GF-22-6. NC2184.2 +233200 PERFORM FAIL NC2184.2 +233300 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +233400 MOVE 1 TO CORRECT-N. NC2184.2 +233500 UST-WRITE-GF-22-6. NC2184.2 +233600 PERFORM PRINT-DETAIL. NC2184.2 +233700* NC2184.2 +233800 UST-INIT-GF-23. NC2184.2 +233900* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2184.2 +234000 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +234100 MOVE "UST-TEST-GF-23" TO PAR-NAME. NC2184.2 +234200 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +234300 MOVE SPACES TO GRP4-XN-6. NC2184.2 +234400 MOVE "****" TO ID5-XN-4. NC2184.2 +234500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +234600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +234700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +234800 MOVE 1 TO REC-CT. NC2184.2 +234900* NC2184.2 +235000 UST-TEST-GF-23-1. NC2184.2 +235100 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +235200 NOT ON OVERFLOW PERFORM PASS NC2184.2 +235300 GO TO UST-WRITE-GF-23-1. NC2184.2 +235400 GO TO UST-FAIL-GF-23-1. NC2184.2 +235500 UST-DELETE-GF-23-1. NC2184.2 +235600 PERFORM DE-LETE. NC2184.2 +235700 PERFORM PRINT-DETAIL. NC2184.2 +235800 GO TO UST-INIT-GF-24. NC2184.2 +235900 UST-FAIL-GF-23-1. NC2184.2 +236000 PERFORM FAIL. NC2184.2 +236100 MOVE "OVERFLOW SHOULD NOT HAVE OCCURED" TO RE-MARK. NC2184.2 +236200 UST-WRITE-GF-23-1. NC2184.2 +236300 PERFORM PRINT-DETAIL. NC2184.2 +236400* NC2184.2 +236500 UST-TEST-GF-23-2. NC2184.2 +236600 ADD 1 TO REC-CT. NC2184.2 +236700 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +236800 PERFORM PASS NC2184.2 +236900 GO TO UST-WRITE-GF-23-2 NC2184.2 +237000 ELSE NC2184.2 +237100 GO TO UST-FAIL-GF-23-2. NC2184.2 +237200 UST-DELETE-GF-23-2. NC2184.2 +237300 PERFORM DE-LETE. NC2184.2 +237400 GO TO UST-WRITE-GF-23-2. NC2184.2 +237500 UST-FAIL-GF-23-2. NC2184.2 +237600 PERFORM FAIL NC2184.2 +237700 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +237800 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +237900 UST-WRITE-GF-23-2. NC2184.2 +238000 PERFORM PRINT-DETAIL. NC2184.2 +238100* NC2184.2 +238200 UST-INIT-GF-24. NC2184.2 +238300* ===--> BOTH "OVERFLOW" PHRASES <--=== NC2184.2 +238400 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +238500 MOVE "UST-TEST-GF-24" TO PAR-NAME. NC2184.2 +238600 MOVE "PIC X " TO FEATURE. NC2184.2 +238700 MOVE ZERO TO ID4-X. NC2184.2 +238800 MOVE "****" TO ID5-XN-4. NC2184.2 +238900 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +239000 MOVE 1 TO ID10-DU-2V0. NC2184.2 +239100 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +239200 MOVE 1 TO REC-CT. NC2184.2 +239300* NC2184.2 +239400 UST-TEST-GF-24-1. NC2184.2 +239500 UNSTRING ID1-XN-7 DELIMITED BY ZERO INTO ID4-X NC2184.2 +239600 DELIMITER IN ID5-XN-4 NC2184.2 +239700 COUNT IN ID6-DU-2V0 NC2184.2 +239800 WITH POINTER ID10-DU-2V0 NC2184.2 +239900 TALLYING ID11-DU-2V0 NC2184.2 +240000 ON OVERFLOW PERFORM PASS NC2184.2 +240100 GO TO UST-WRITE-GF-24-1 NC2184.2 +240200 NOT ON OVERFLOW GO TO UST-FAIL-GF-24-1. NC2184.2 +240300 UST-DELETE-GF-24-1. NC2184.2 +240400 PERFORM DE-LETE. NC2184.2 +240500 PERFORM PRINT-DETAIL. NC2184.2 +240600 GO TO UST-INIT-GF-25. NC2184.2 +240700 UST-FAIL-GF-24-1. NC2184.2 +240800 PERFORM FAIL. NC2184.2 +240900 MOVE "ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK. NC2184.2 +241000 UST-WRITE-GF-24-1. NC2184.2 +241100 PERFORM PRINT-DETAIL. NC2184.2 +241200* NC2184.2 +241300 UST-TEST-GF-24-2. NC2184.2 +241400 ADD 1 TO REC-CT. NC2184.2 +241500 IF ID4-X = "1" NC2184.2 +241600 PERFORM PASS NC2184.2 +241700 GO TO UST-WRITE-GF-24-2 NC2184.2 +241800 ELSE NC2184.2 +241900 GO TO UST-FAIL-GF-24-2. NC2184.2 +242000 UST-DELETE-GF-24-2. NC2184.2 +242100 PERFORM DE-LETE. NC2184.2 +242200 GO TO UST-WRITE-GF-24-2. NC2184.2 +242300 UST-FAIL-GF-24-2. NC2184.2 +242400 PERFORM FAIL NC2184.2 +242500 MOVE ID4-X TO COMPUTED-A NC2184.2 +242600 MOVE "1" TO CORRECT-A. NC2184.2 +242700 UST-WRITE-GF-24-2. NC2184.2 +242800 PERFORM PRINT-DETAIL. NC2184.2 +242900* NC2184.2 +243000 UST-TEST-GF-24-3. NC2184.2 +243100 ADD 1 TO REC-CT. NC2184.2 +243200 IF ID5-XN-4 = "0 " NC2184.2 +243300 PERFORM PASS NC2184.2 +243400 GO TO UST-WRITE-GF-24-3 NC2184.2 +243500 ELSE NC2184.2 +243600 GO TO UST-FAIL-GF-24-3. NC2184.2 +243700 UST-DELETE-GF-24-3. NC2184.2 +243800 PERFORM DE-LETE. NC2184.2 +243900 GO TO UST-WRITE-GF-24-3. NC2184.2 +244000 UST-FAIL-GF-24-3. NC2184.2 +244100 PERFORM FAIL NC2184.2 +244200 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +244300 MOVE "0 " TO CORRECT-A. NC2184.2 +244400 UST-WRITE-GF-24-3. NC2184.2 +244500 PERFORM PRINT-DETAIL. NC2184.2 +244600* NC2184.2 +244700 UST-TEST-GF-24-4. NC2184.2 +244800 ADD 1 TO REC-CT. NC2184.2 +244900 IF ID6-DU-2V0 = 2 NC2184.2 +245000 PERFORM PASS NC2184.2 +245100 GO TO UST-WRITE-GF-24-4 NC2184.2 +245200 ELSE NC2184.2 +245300 GO TO UST-FAIL-GF-24-4. NC2184.2 +245400 UST-DELETE-GF-24-4. NC2184.2 +245500 PERFORM DE-LETE. NC2184.2 +245600 GO TO UST-WRITE-GF-24-4. NC2184.2 +245700 UST-FAIL-GF-24-4. NC2184.2 +245800 PERFORM FAIL NC2184.2 +245900 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +246000 MOVE 2 TO CORRECT-N. NC2184.2 +246100 UST-WRITE-GF-24-4. NC2184.2 +246200 PERFORM PRINT-DETAIL. NC2184.2 +246300* NC2184.2 +246400 UST-TEST-GF-24-5. NC2184.2 +246500 ADD 1 TO REC-CT. NC2184.2 +246600 IF ID10-DU-2V0 = 4 NC2184.2 +246700 PERFORM PASS NC2184.2 +246800 GO TO UST-WRITE-GF-24-5 NC2184.2 +246900 ELSE NC2184.2 +247000 GO TO UST-FAIL-GF-24-5. NC2184.2 +247100 UST-DELETE-GF-24-5. NC2184.2 +247200 PERFORM DE-LETE. NC2184.2 +247300 GO TO UST-WRITE-GF-24-5. NC2184.2 +247400 UST-FAIL-GF-24-5. NC2184.2 +247500 PERFORM FAIL NC2184.2 +247600 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +247700 MOVE 4 TO CORRECT-N. NC2184.2 +247800 UST-WRITE-GF-24-5. NC2184.2 +247900 PERFORM PRINT-DETAIL. NC2184.2 +248000* NC2184.2 +248100 UST-TEST-GF-24-6. NC2184.2 +248200 ADD 1 TO REC-CT. NC2184.2 +248300 IF ID11-DU-2V0 = 1 NC2184.2 +248400 PERFORM PASS NC2184.2 +248500 GO TO UST-WRITE-GF-24-6 NC2184.2 +248600 ELSE NC2184.2 +248700 GO TO UST-FAIL-GF-24-6. NC2184.2 +248800 UST-DELETE-GF-24-6. NC2184.2 +248900 PERFORM DE-LETE. NC2184.2 +249000 GO TO UST-WRITE-GF-24-6. NC2184.2 +249100 UST-FAIL-GF-24-6. NC2184.2 +249200 PERFORM FAIL NC2184.2 +249300 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +249400 MOVE 1 TO CORRECT-N. NC2184.2 +249500 UST-WRITE-GF-24-6. NC2184.2 +249600 PERFORM PRINT-DETAIL. NC2184.2 +249700* NC2184.2 +249800 UST-INIT-GF-25. NC2184.2 +249900* ===--> BOTH "OVERFLOW" PHRASES <--=== NC2184.2 +250000 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +250100 MOVE "UST-TEST-GF-25" TO PAR-NAME. NC2184.2 +250200 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +250300 MOVE SPACES TO GRP4-XN-6. NC2184.2 +250400 MOVE "****" TO ID5-XN-4. NC2184.2 +250500 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +250600 MOVE 1 TO ID10-DU-2V0. NC2184.2 +250700 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +250800 MOVE 1 TO REC-CT. NC2184.2 +250900* NC2184.2 +251000 UST-TEST-GF-25-1. NC2184.2 +251100 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +251200 ON OVERFLOW GO TO UST-FAIL-GF-25-1 NC2184.2 +251300 NOT ON OVERFLOW PERFORM PASS NC2184.2 +251400 GO TO UST-WRITE-GF-25-1. NC2184.2 +251500 UST-DELETE-GF-25-1. NC2184.2 +251600 PERFORM DE-LETE. NC2184.2 +251700 PERFORM PRINT-DETAIL. NC2184.2 +251800 GO TO UST-INIT-GF-26. NC2184.2 +251900 UST-FAIL-GF-25-1. NC2184.2 +252000 PERFORM FAIL. NC2184.2 +252100 MOVE "ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK. NC2184.2 +252200 UST-WRITE-GF-25-1. NC2184.2 +252300 PERFORM PRINT-DETAIL. NC2184.2 +252400* NC2184.2 +252500 UST-TEST-GF-25-2. NC2184.2 +252600 ADD 1 TO REC-CT. NC2184.2 +252700 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +252800 PERFORM PASS NC2184.2 +252900 GO TO UST-WRITE-GF-25-2 NC2184.2 +253000 ELSE NC2184.2 +253100 GO TO UST-FAIL-GF-25-2. NC2184.2 +253200 UST-DELETE-GF-25-2. NC2184.2 +253300 PERFORM DE-LETE. NC2184.2 +253400 GO TO UST-WRITE-GF-25-2. NC2184.2 +253500 UST-FAIL-GF-25-2. NC2184.2 +253600 PERFORM FAIL NC2184.2 +253700 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +253800 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +253900 UST-WRITE-GF-25-2. NC2184.2 +254000 PERFORM PRINT-DETAIL. NC2184.2 +254100* NC2184.2 +254200 UST-INIT-GF-26. NC2184.2 +254300* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2184.2 +254400 MOVE "VI-138 6.26.4 GR19" TO ANSI-REFERENCE. NC2184.2 +254500 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +254600 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +254700 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +254800 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +254900 MOVE ZERO TO REC-CT. NC2184.2 +255000* NC2184.2 +255100 UST-TEST-GF-26-0. NC2184.2 +255200 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +255300 ON OVERFLOW NC2184.2 +255400 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +255500 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +255600 NOT ON OVERFLOW NC2184.2 +255700 MOVE "C" TO WRK-XN-00001-1 NC2184.2 +255800 MOVE "D" TO WRK-XN-00001-2 NC2184.2 +255900 END-UNSTRING NC2184.2 +256000 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +256100 GO TO UST-TEST-GF-26-1. NC2184.2 +256200 UST-DELETE-GF-26. NC2184.2 +256300 PERFORM DE-LETE. NC2184.2 +256400 PERFORM PRINT-DETAIL. NC2184.2 +256500 GO TO UST-INIT-GF-27. NC2184.2 +256600* NC2184.2 +256700 UST-TEST-GF-26-1. NC2184.2 +256800 ADD 1 TO REC-CT. NC2184.2 +256900 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +257000 PERFORM PASS NC2184.2 +257100 GO TO UST-WRITE-GF-26-1 NC2184.2 +257200 ELSE NC2184.2 +257300 GO TO UST-FAIL-GF-26-1. NC2184.2 +257400 UST-DELETE-GF-26-1. NC2184.2 +257500 PERFORM DE-LETE. NC2184.2 +257600 GO TO UST-WRITE-GF-26-1. NC2184.2 +257700 UST-FAIL-GF-26-1. NC2184.2 +257800 PERFORM FAIL NC2184.2 +257900 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +258000 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +258100 UST-WRITE-GF-26-1. NC2184.2 +258200 PERFORM PRINT-DETAIL. NC2184.2 +258300* NC2184.2 +258400 UST-TEST-GF-26-2. NC2184.2 +258500 ADD 1 TO REC-CT. NC2184.2 +258600 IF WRK-XN-00001-1 = "C" NC2184.2 +258700 PERFORM PASS NC2184.2 +258800 GO TO UST-WRITE-GF-26-2 NC2184.2 +258900 ELSE NC2184.2 +259000 GO TO UST-FAIL-GF-26-2. NC2184.2 +259100 UST-DELETE-GF-26-2. NC2184.2 +259200 PERFORM DE-LETE. NC2184.2 +259300 GO TO UST-WRITE-GF-26-2. NC2184.2 +259400 UST-FAIL-GF-26-2. NC2184.2 +259500 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2184.2 +259600 MOVE "C" TO CORRECT-A. NC2184.2 +259700 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2184.2 +259800 PERFORM FAIL. NC2184.2 +259900 UST-WRITE-GF-26-2. NC2184.2 +260000 PERFORM PRINT-DETAIL. NC2184.2 +260100* NC2184.2 +260200 UST-TEST-GF-26-3. NC2184.2 +260300 ADD 1 TO REC-CT. NC2184.2 +260400 IF WRK-XN-00001-2 = "D" NC2184.2 +260500 PERFORM PASS NC2184.2 +260600 GO TO UST-WRITE-GF-26-3 NC2184.2 +260700 ELSE NC2184.2 +260800 GO TO UST-FAIL-GF-26-3. NC2184.2 +260900 UST-DELETE-GF-26-3. NC2184.2 +261000 PERFORM DE-LETE. NC2184.2 +261100 GO TO UST-WRITE-GF-26-3. NC2184.2 +261200 UST-FAIL-GF-26-3. NC2184.2 +261300 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2184.2 +261400 MOVE "D" TO CORRECT-A. NC2184.2 +261500 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK NC2184.2 +261600 PERFORM FAIL. NC2184.2 +261700 UST-WRITE-GF-26-3. NC2184.2 +261800 PERFORM PRINT-DETAIL. NC2184.2 +261900* NC2184.2 +262000 UST-TEST-GF-26-4. NC2184.2 +262100 ADD 1 TO REC-CT. NC2184.2 +262200 IF WRK-XN-00001-3 = "Z" NC2184.2 +262300 PERFORM PASS NC2184.2 +262400 GO TO UST-WRITE-GF-26-4 NC2184.2 +262500 ELSE NC2184.2 +262600 GO TO UST-FAIL-GF-26-4. NC2184.2 +262700 UST-DELETE-GF-26-4. NC2184.2 +262800 PERFORM DE-LETE. NC2184.2 +262900 GO TO UST-WRITE-GF-26-4. NC2184.2 +263000 UST-FAIL-GF-26-4. NC2184.2 +263100 MOVE WRK-XN-00001-3 TO COMPUTED-A NC2184.2 +263200 MOVE "Z" TO CORRECT-A. NC2184.2 +263300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2184.2 +263400 PERFORM FAIL. NC2184.2 +263500 UST-WRITE-GF-26-4. NC2184.2 +263600 PERFORM PRINT-DETAIL. NC2184.2 +263700* NC2184.2 +263800 UST-INIT-GF-27. NC2184.2 +263900* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2184.2 +264000 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +264100 MOVE "UST-TEST-GF-27" TO PAR-NAME. NC2184.2 +264200 MOVE "PIC X " TO FEATURE. NC2184.2 +264300 MOVE "1200000" TO ID1-XN-7. NC2184.2 +264400 MOVE ZERO TO ID4-X. NC2184.2 +264500 MOVE "****" TO ID5-XN-4. NC2184.2 +264600 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +264700 MOVE 1 TO ID10-DU-2V0. NC2184.2 +264800 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +264900 MOVE ZERO TO REC-CT. NC2184.2 +265000 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +265100 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +265200 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +265300* NC2184.2 +265400 UST-TEST-GF-27-0. NC2184.2 +265500 UNSTRING ID1-XN-7 DELIMITED BY ZERO INTO ID4-X NC2184.2 +265600 DELIMITER IN ID5-XN-4 NC2184.2 +265700 COUNT IN ID6-DU-2V0 NC2184.2 +265800 WITH POINTER ID10-DU-2V0 NC2184.2 +265900 TALLYING ID11-DU-2V0 NC2184.2 +266000 ON OVERFLOW NC2184.2 +266100 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +266200 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +266300 END-UNSTRING NC2184.2 +266400 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +266500 GO TO UST-TEST-GF-27-1. NC2184.2 +266600 UST-DELETE-GF-27. NC2184.2 +266700 PERFORM DE-LETE. NC2184.2 +266800 PERFORM PRINT-DETAIL. NC2184.2 +266900 GO TO UST-INIT-GF-28. NC2184.2 +267000* NC2184.2 +267100 UST-TEST-GF-27-1. NC2184.2 +267200 ADD 1 TO REC-CT. NC2184.2 +267300 IF ID4-X = "1" NC2184.2 +267400 PERFORM PASS NC2184.2 +267500 GO TO UST-WRITE-GF-27-1 NC2184.2 +267600 ELSE NC2184.2 +267700 GO TO UST-FAIL-GF-27-1. NC2184.2 +267800 UST-DELETE-GF-27-1. NC2184.2 +267900 PERFORM DE-LETE. NC2184.2 +268000 GO TO UST-WRITE-GF-27-1. NC2184.2 +268100 UST-FAIL-GF-27-1. NC2184.2 +268200 PERFORM FAIL NC2184.2 +268300 MOVE ID4-X TO COMPUTED-A NC2184.2 +268400 MOVE "1" TO CORRECT-A. NC2184.2 +268500 UST-WRITE-GF-27-1. NC2184.2 +268600 PERFORM PRINT-DETAIL. NC2184.2 +268700* NC2184.2 +268800 UST-TEST-GF-27-2. NC2184.2 +268900 ADD 1 TO REC-CT. NC2184.2 +269000 IF ID5-XN-4 = "0 " NC2184.2 +269100 PERFORM PASS NC2184.2 +269200 GO TO UST-WRITE-GF-27-2 NC2184.2 +269300 ELSE NC2184.2 +269400 GO TO UST-FAIL-GF-27-2. NC2184.2 +269500 UST-DELETE-GF-27-2. NC2184.2 +269600 PERFORM DE-LETE. NC2184.2 +269700 GO TO UST-WRITE-GF-27-2. NC2184.2 +269800 UST-FAIL-GF-27-2. NC2184.2 +269900 PERFORM FAIL NC2184.2 +270000 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +270100 MOVE "0 " TO CORRECT-A. NC2184.2 +270200 UST-WRITE-GF-27-2. NC2184.2 +270300 PERFORM PRINT-DETAIL. NC2184.2 +270400* NC2184.2 +270500 UST-TEST-GF-27-3. NC2184.2 +270600 ADD 1 TO REC-CT. NC2184.2 +270700 IF ID6-DU-2V0 = 2 NC2184.2 +270800 PERFORM PASS NC2184.2 +270900 GO TO UST-WRITE-GF-27-3 NC2184.2 +271000 ELSE NC2184.2 +271100 GO TO UST-FAIL-GF-27-3. NC2184.2 +271200 UST-DELETE-GF-27-3. NC2184.2 +271300 PERFORM DE-LETE. NC2184.2 +271400 GO TO UST-WRITE-GF-27-3. NC2184.2 +271500 UST-FAIL-GF-27-3. NC2184.2 +271600 PERFORM FAIL NC2184.2 +271700 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +271800 MOVE 2 TO CORRECT-N. NC2184.2 +271900 UST-WRITE-GF-27-3. NC2184.2 +272000 PERFORM PRINT-DETAIL. NC2184.2 +272100* NC2184.2 +272200 UST-TEST-GF-27-4. NC2184.2 +272300 ADD 1 TO REC-CT. NC2184.2 +272400 IF ID10-DU-2V0 = 4 NC2184.2 +272500 PERFORM PASS NC2184.2 +272600 GO TO UST-WRITE-GF-27-4 NC2184.2 +272700 ELSE NC2184.2 +272800 GO TO UST-FAIL-GF-27-4. NC2184.2 +272900 UST-DELETE-GF-27-4. NC2184.2 +273000 PERFORM DE-LETE. NC2184.2 +273100 GO TO UST-WRITE-GF-27-4. NC2184.2 +273200 UST-FAIL-GF-27-4. NC2184.2 +273300 PERFORM FAIL NC2184.2 +273400 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +273500 MOVE 4 TO CORRECT-N. NC2184.2 +273600 UST-WRITE-GF-27-4. NC2184.2 +273700 PERFORM PRINT-DETAIL. NC2184.2 +273800* NC2184.2 +273900 UST-TEST-GF-27-5. NC2184.2 +274000 ADD 1 TO REC-CT. NC2184.2 +274100 IF ID11-DU-2V0 = 1 NC2184.2 +274200 PERFORM PASS NC2184.2 +274300 GO TO UST-WRITE-GF-27-5 NC2184.2 +274400 ELSE NC2184.2 +274500 GO TO UST-FAIL-GF-27-5. NC2184.2 +274600 UST-DELETE-GF-27-5. NC2184.2 +274700 PERFORM DE-LETE. NC2184.2 +274800 GO TO UST-WRITE-GF-27-5. NC2184.2 +274900 UST-FAIL-GF-27-5. NC2184.2 +275000 PERFORM FAIL NC2184.2 +275100 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +275200 MOVE 1 TO CORRECT-N. NC2184.2 +275300 UST-WRITE-GF-27-5. NC2184.2 +275400* NC2184.2 +275500 UST-INIT-GF-28. NC2184.2 +275600* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2184.2 +275700 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +275800 MOVE "UST-TEST-GF-28" TO PAR-NAME. NC2184.2 +275900 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +276000 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +276100 MOVE SPACES TO GRP4-XN-6. NC2184.2 +276200 MOVE "****" TO ID5-XN-4. NC2184.2 +276300 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +276400 MOVE 1 TO ID10-DU-2V0. NC2184.2 +276500 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +276600 MOVE ZERO TO REC-CT. NC2184.2 +276700 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +276800 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +276900 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +277000* NC2184.2 +277100 UST-TEST-GF-28-0. NC2184.2 +277200 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +277300 ON OVERFLOW NC2184.2 +277400 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +277500 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +277600 END-UNSTRING NC2184.2 +277700 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +277800 GO TO UST-TEST-GF-28-1. NC2184.2 +277900 UST-DELETE-GF-28. NC2184.2 +278000 PERFORM DE-LETE. NC2184.2 +278100 PERFORM PRINT-DETAIL. NC2184.2 +278200 GO TO UST-INIT-GF-29. NC2184.2 +278300* NC2184.2 +278400 UST-TEST-GF-28-1. NC2184.2 +278500 ADD 1 TO REC-CT. NC2184.2 +278600 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +278700 PERFORM PASS NC2184.2 +278800 GO TO UST-WRITE-GF-28-1 NC2184.2 +278900 ELSE NC2184.2 +279000 GO TO UST-FAIL-GF-28-1. NC2184.2 +279100 UST-DELETE-GF-28-1. NC2184.2 +279200 PERFORM DE-LETE. NC2184.2 +279300 GO TO UST-WRITE-GF-28-1. NC2184.2 +279400 UST-FAIL-GF-28-1. NC2184.2 +279500 PERFORM FAIL NC2184.2 +279600 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +279700 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +279800 UST-WRITE-GF-28-1. NC2184.2 +279900 PERFORM PRINT-DETAIL. NC2184.2 +280000* NC2184.2 +280100* NC2184.2 +280200 UST-INIT-GF-29. NC2184.2 +280300* ===--> EXPLICIT SCOPE TERMINATOR <--=== NC2184.2 +280400 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +280500 MOVE "UST-TEST-GF-29" TO PAR-NAME. NC2184.2 +280600 MOVE "PIC X " TO FEATURE. NC2184.2 +280700 MOVE "1200000" TO ID1-XN-7. NC2184.2 +280800 MOVE ZERO TO ID4-X. NC2184.2 +280900 MOVE "****" TO ID5-XN-4. NC2184.2 +281000 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +281100 MOVE 1 TO ID10-DU-2V0. NC2184.2 +281200 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +281300 MOVE ZERO TO REC-CT. NC2184.2 +281400 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +281500 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +281600 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +281700* NC2184.2 +281800 UST-TEST-GF-29-0. NC2184.2 +281900 UNSTRING ID1-XN-7 DELIMITED BY ZERO INTO ID4-X NC2184.2 +282000 DELIMITER IN ID5-XN-4 NC2184.2 +282100 COUNT IN ID6-DU-2V0 NC2184.2 +282200 WITH POINTER ID10-DU-2V0 NC2184.2 +282300 TALLYING ID11-DU-2V0 NC2184.2 +282400 NOT ON OVERFLOW NC2184.2 +282500 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +282600 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +282700 END-UNSTRING NC2184.2 +282800 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +282900 GO TO UST-TEST-GF-29-1. NC2184.2 +283000 UST-DELETE-GF-29. NC2184.2 +283100 PERFORM DE-LETE. NC2184.2 +283200 PERFORM PRINT-DETAIL. NC2184.2 +283300 GO TO UST-INIT-GF-30. NC2184.2 +283400* NC2184.2 +283500 UST-TEST-GF-29-1. NC2184.2 +283600 MOVE "UST-TEST-GF-29-1" TO PAR-NAME. NC2184.2 +283700 ADD 1 TO REC-CT. NC2184.2 +283800 IF ID4-X = "1" NC2184.2 +283900 PERFORM PASS NC2184.2 +284000 GO TO UST-WRITE-GF-29-1 NC2184.2 +284100 ELSE NC2184.2 +284200 GO TO UST-FAIL-GF-29-1. NC2184.2 +284300 UST-DELETE-GF-29-1. NC2184.2 +284400 PERFORM DE-LETE. NC2184.2 +284500 GO TO UST-WRITE-GF-29-1. NC2184.2 +284600 UST-FAIL-GF-29-1. NC2184.2 +284700 PERFORM FAIL NC2184.2 +284800 MOVE ID4-X TO COMPUTED-A NC2184.2 +284900 MOVE "1" TO CORRECT-A. NC2184.2 +285000 UST-WRITE-GF-29-1. NC2184.2 +285100 PERFORM PRINT-DETAIL. NC2184.2 +285200* NC2184.2 +285300 UST-TEST-GF-29-2. NC2184.2 +285400 ADD 1 TO REC-CT. NC2184.2 +285500 IF ID5-XN-4 = "0 " NC2184.2 +285600 PERFORM PASS NC2184.2 +285700 GO TO UST-WRITE-GF-29-2 NC2184.2 +285800 ELSE NC2184.2 +285900 GO TO UST-FAIL-GF-29-2. NC2184.2 +286000 UST-DELETE-GF-29-2. NC2184.2 +286100 PERFORM DE-LETE. NC2184.2 +286200 GO TO UST-WRITE-GF-29-2. NC2184.2 +286300 UST-FAIL-GF-29-2. NC2184.2 +286400 PERFORM FAIL NC2184.2 +286500 MOVE ID5-XN-4 TO COMPUTED-A NC2184.2 +286600 MOVE "0 " TO CORRECT-A. NC2184.2 +286700 UST-WRITE-GF-29-2. NC2184.2 +286800 PERFORM PRINT-DETAIL. NC2184.2 +286900* NC2184.2 +287000 UST-TEST-GF-29-3. NC2184.2 +287100 ADD 1 TO REC-CT. NC2184.2 +287200 IF ID6-DU-2V0 = 2 NC2184.2 +287300 PERFORM PASS NC2184.2 +287400 GO TO UST-WRITE-GF-29-3 NC2184.2 +287500 ELSE NC2184.2 +287600 GO TO UST-FAIL-GF-29-3. NC2184.2 +287700 UST-DELETE-GF-29-3. NC2184.2 +287800 PERFORM DE-LETE. NC2184.2 +287900 GO TO UST-WRITE-GF-29-3. NC2184.2 +288000 UST-FAIL-GF-29-3. NC2184.2 +288100 PERFORM FAIL NC2184.2 +288200 MOVE ID6-DU-2V0 TO COMPUTED-N NC2184.2 +288300 MOVE 2 TO CORRECT-N. NC2184.2 +288400 UST-WRITE-GF-29-3. NC2184.2 +288500 PERFORM PRINT-DETAIL. NC2184.2 +288600* NC2184.2 +288700 UST-TEST-GF-29-4. NC2184.2 +288800 ADD 1 TO REC-CT. NC2184.2 +288900 IF ID10-DU-2V0 = 4 NC2184.2 +289000 PERFORM PASS NC2184.2 +289100 GO TO UST-WRITE-GF-29-4 NC2184.2 +289200 ELSE NC2184.2 +289300 GO TO UST-FAIL-GF-29-4. NC2184.2 +289400 UST-DELETE-GF-29-4. NC2184.2 +289500 PERFORM DE-LETE. NC2184.2 +289600 GO TO UST-WRITE-GF-29-4. NC2184.2 +289700 UST-FAIL-GF-29-4. NC2184.2 +289800 PERFORM FAIL NC2184.2 +289900 MOVE ID10-DU-2V0 TO COMPUTED-N NC2184.2 +290000 MOVE 4 TO CORRECT-N. NC2184.2 +290100 UST-WRITE-GF-29-4. NC2184.2 +290200 PERFORM PRINT-DETAIL. NC2184.2 +290300* NC2184.2 +290400 UST-TEST-GF-29-5. NC2184.2 +290500 ADD 1 TO REC-CT. NC2184.2 +290600 IF ID11-DU-2V0 = 1 NC2184.2 +290700 PERFORM PASS NC2184.2 +290800 GO TO UST-WRITE-GF-29-5 NC2184.2 +290900 ELSE NC2184.2 +291000 GO TO UST-FAIL-GF-29-5. NC2184.2 +291100 UST-DELETE-GF-29-5. NC2184.2 +291200 PERFORM DE-LETE. NC2184.2 +291300 GO TO UST-WRITE-GF-29-5. NC2184.2 +291400 UST-FAIL-GF-29-5. NC2184.2 +291500 PERFORM FAIL NC2184.2 +291600 MOVE ID11-DU-2V0 TO COMPUTED-N NC2184.2 +291700 MOVE 1 TO CORRECT-N. NC2184.2 +291800 UST-WRITE-GF-29-5. NC2184.2 +291900 PERFORM PRINT-DETAIL. NC2184.2 +292000* NC2184.2 +292100 UST-TEST-GF-29-6. NC2184.2 +292200 ADD 1 TO REC-CT. NC2184.2 +292300 IF WRK-XN-00001-1 = SPACE NC2184.2 +292400 PERFORM PASS NC2184.2 +292500 GO TO UST-WRITE-GF-29-6 NC2184.2 +292600 ELSE NC2184.2 +292700 GO TO UST-FAIL-GF-29-6. NC2184.2 +292800 UST-DELETE-GF-29-6. NC2184.2 +292900 PERFORM DE-LETE. NC2184.2 +293000 GO TO UST-WRITE-GF-29-6. NC2184.2 +293100 UST-FAIL-GF-29-6. NC2184.2 +293200 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2184.2 +293300 MOVE SPACE TO CORRECT-A. NC2184.2 +293400 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK NC2184.2 +293500 PERFORM FAIL. NC2184.2 +293600 UST-WRITE-GF-29-6. NC2184.2 +293700 PERFORM PRINT-DETAIL. NC2184.2 +293800* NC2184.2 +293900 UST-TEST-GF-29-7. NC2184.2 +294000 ADD 1 TO REC-CT. NC2184.2 +294100 IF WRK-XN-00001-2 = SPACE NC2184.2 +294200 PERFORM PASS NC2184.2 +294300 GO TO UST-WRITE-GF-29-7 NC2184.2 +294400 ELSE NC2184.2 +294500 GO TO UST-FAIL-GF-29-7. NC2184.2 +294600 UST-DELETE-GF-29-7. NC2184.2 +294700 PERFORM DE-LETE. NC2184.2 +294800 GO TO UST-WRITE-GF-29-7. NC2184.2 +294900 UST-FAIL-GF-29-7. NC2184.2 +295000 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2184.2 +295100 MOVE SPACE TO CORRECT-A. NC2184.2 +295200 MOVE "NOT ON OVERFLOW SHOULD NOT HAVE EXECUTED" TO RE-MARK. NC2184.2 +295300 PERFORM FAIL. NC2184.2 +295400 UST-WRITE-GF-29-7. NC2184.2 +295500 PERFORM PRINT-DETAIL. NC2184.2 +295600* NC2184.2 +295700 UST-TEST-GF-29-8. NC2184.2 +295800 ADD 1 TO REC-CT. NC2184.2 +295900 IF WRK-XN-00001-3 = "Z" NC2184.2 +296000 PERFORM PASS NC2184.2 +296100 GO TO UST-WRITE-GF-29-8 NC2184.2 +296200 ELSE NC2184.2 +296300 GO TO UST-FAIL-GF-29-8. NC2184.2 +296400 UST-DELETE-GF-29-8. NC2184.2 +296500 PERFORM DE-LETE. NC2184.2 +296600 GO TO UST-WRITE-GF-29-8. NC2184.2 +296700 UST-FAIL-GF-29-8. NC2184.2 +296800 MOVE WRK-XN-00001-3 TO COMPUTED-A NC2184.2 +296900 MOVE "Z" TO CORRECT-A. NC2184.2 +297000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2184.2 +297100 PERFORM FAIL. NC2184.2 +297200 UST-WRITE-GF-29-8. NC2184.2 +297300 PERFORM PRINT-DETAIL. NC2184.2 +297400* NC2184.2 +297500 UST-INIT-GF-30. NC2184.2 +297600* ===--> "NOT ON OVERFLOW" PHRASE <--=== NC2184.2 +297700 MOVE "VI-138 6.26.4 GR17" TO ANSI-REFERENCE. NC2184.2 +297800 MOVE "UST-TEST-GF-30" TO PAR-NAME. NC2184.2 +297900 MOVE "OVERFLOW TEST" TO FEATURE. NC2184.2 +298000 MOVE "ABCDEF" TO GRP1-XN-6. NC2184.2 +298100 MOVE SPACES TO GRP4-XN-6. NC2184.2 +298200 MOVE "****" TO ID5-XN-4. NC2184.2 +298300 MOVE ZERO TO ID6-DU-2V0. NC2184.2 +298400 MOVE 1 TO ID10-DU-2V0. NC2184.2 +298500 MOVE ZERO TO ID11-DU-2V0. NC2184.2 +298600 MOVE ZERO TO REC-CT. NC2184.2 +298700 MOVE SPACE TO WRK-XN-00001-1. NC2184.2 +298800 MOVE SPACE TO WRK-XN-00001-2. NC2184.2 +298900 MOVE SPACE TO WRK-XN-00001-3. NC2184.2 +299000* NC2184.2 +299100 UST-TEST-GF-30-0. NC2184.2 +299200 UNSTRING GRP1-XN-6 INTO ID4A-XXXXX ID4B-X NC2184.2 +299300 NOT ON OVERFLOW NC2184.2 +299400 MOVE "A" TO WRK-XN-00001-1 NC2184.2 +299500 MOVE "B" TO WRK-XN-00001-2 NC2184.2 +299600 END-UNSTRING NC2184.2 +299700 MOVE "Z" TO WRK-XN-00001-3. NC2184.2 +299800 GO TO UST-TEST-GF-30-1. NC2184.2 +299900 UST-DELETE-GF-30. NC2184.2 +300000 PERFORM DE-LETE. NC2184.2 +300100 PERFORM PRINT-DETAIL. NC2184.2 +300200 GO TO CCVS-EXIT. NC2184.2 +300300* NC2184.2 +300400 UST-TEST-GF-30-1. NC2184.2 +300500 MOVE 1 TO REC-CT. NC2184.2 +300600 IF GRP4-XN-6 = "ABCDEF" NC2184.2 +300700 PERFORM PASS NC2184.2 +300800 GO TO UST-WRITE-GF-30-1 NC2184.2 +300900 ELSE NC2184.2 +301000 GO TO UST-FAIL-GF-30-1. NC2184.2 +301100 UST-DELETE-GF-30-1. NC2184.2 +301200 PERFORM DE-LETE. NC2184.2 +301300 GO TO UST-WRITE-GF-30-1. NC2184.2 +301400 UST-FAIL-GF-30-1. NC2184.2 +301500 PERFORM FAIL NC2184.2 +301600 MOVE GRP4-XN-6 TO COMPUTED-A NC2184.2 +301700 MOVE "ABCDEF" TO CORRECT-A. NC2184.2 +301800 UST-WRITE-GF-30-1. NC2184.2 +301900 PERFORM PRINT-DETAIL. NC2184.2 +302000* NC2184.2 +302100 UST-TEST-GF-30-2. NC2184.2 +302200 ADD 1 TO REC-CT. NC2184.2 +302300 IF WRK-XN-00001-1 = "A" NC2184.2 +302400 PERFORM PASS NC2184.2 +302500 GO TO UST-WRITE-GF-30-2 NC2184.2 +302600 ELSE NC2184.2 +302700 GO TO UST-FAIL-GF-30-2. NC2184.2 +302800 UST-DELETE-GF-30-2. NC2184.2 +302900 PERFORM DE-LETE. NC2184.2 +303000 GO TO UST-WRITE-GF-30-2. NC2184.2 +303100 UST-FAIL-GF-30-2. NC2184.2 +303200 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2184.2 +303300 MOVE "A" TO CORRECT-A. NC2184.2 +303400 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK. NC2184.2 +303500 PERFORM FAIL. NC2184.2 +303600 UST-WRITE-GF-30-2. NC2184.2 +303700 PERFORM PRINT-DETAIL. NC2184.2 +303800* NC2184.2 +303900 UST-TEST-GF-30-3. NC2184.2 +304000 ADD 1 TO REC-CT. NC2184.2 +304100 IF WRK-XN-00001-2 = "B" NC2184.2 +304200 PERFORM PASS NC2184.2 +304300 GO TO UST-WRITE-GF-30-3 NC2184.2 +304400 ELSE NC2184.2 +304500 GO TO UST-FAIL-GF-30-3. NC2184.2 +304600 UST-DELETE-GF-30-3. NC2184.2 +304700 PERFORM DE-LETE. NC2184.2 +304800 GO TO UST-WRITE-GF-30-3. NC2184.2 +304900 UST-FAIL-GF-30-3. NC2184.2 +305000 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2184.2 +305100 MOVE "B" TO CORRECT-A. NC2184.2 +305200 MOVE "NOT ON OVERFLOW SHOULD HAVE EXECUTED" TO RE-MARK. NC2184.2 +305300 PERFORM FAIL. NC2184.2 +305400 UST-WRITE-GF-30-3. NC2184.2 +305500 PERFORM PRINT-DETAIL. NC2184.2 +305600* NC2184.2 +305700 UST-TEST-GF-30-4. NC2184.2 +305800 ADD 1 TO REC-CT. NC2184.2 +305900 IF WRK-XN-00001-3 = "Z" NC2184.2 +306000 PERFORM PASS NC2184.2 +306100 GO TO UST-WRITE-GF-30-4 NC2184.2 +306200 ELSE NC2184.2 +306300 GO TO UST-FAIL-GF-30-4. NC2184.2 +306400 UST-DELETE-GF-30-4. NC2184.2 +306500 PERFORM DE-LETE. NC2184.2 +306600 GO TO UST-WRITE-GF-30-4. NC2184.2 +306700 UST-FAIL-GF-30-4. NC2184.2 +306800 MOVE WRK-XN-00001-3 TO COMPUTED-A NC2184.2 +306900 MOVE "Z" TO CORRECT-A. NC2184.2 +307000 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2184.2 +307100 PERFORM FAIL. NC2184.2 +307200 UST-WRITE-GF-30-4. NC2184.2 +307300 PERFORM PRINT-DETAIL. NC2184.2 +307400* NC2184.2 +307500 CCVS-EXIT SECTION. NC2184.2 +307600 CCVS-999999. NC2184.2 +307700 GO TO CLOSE-FILES. NC2184.2 diff --git a/tests/cobol85/NC/NC219A.CBL b/tests/cobol85/NC/NC219A.CBL new file mode 100755 index 00000000..908fbdab --- /dev/null +++ b/tests/cobol85/NC/NC219A.CBL @@ -0,0 +1,591 @@ +000100 IDENTIFICATION DIVISION. NC2194.2 +000200 PROGRAM-ID. NC2194.2 +000300 NC219A. NC2194.2 +000400* NC2194.2 +000500**************************************************************** NC2194.2 +000600* * NC2194.2 +000700* VALIDATION FOR:- * NC2194.2 +000800* * NC2194.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2194.2 +001000* * NC2194.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2194.2 +001200* * NC2194.2 +001300**************************************************************** NC2194.2 +001400* * NC2194.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2194.2 +001600* * NC2194.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2194.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2194.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2194.2 +002000* * NC2194.2 +002100**************************************************************** NC2194.2 +002200* PROGRAM NC219A TESTS THE USE OF "HIGH-VALUE" & "LOW-VALUE" NC2194.2 +002300* IN THE LITERAL PHRASE OF THE "ALPHABET" CLAUSE OF THE NC2194.2 +002400* "SPECIAL-NAMES" PARAGRAPH AND THE "PROGRAM COLLATING NC2194.2 +002500* SEQUENCE" OF THE "OBJECT-COMPUTER PARAGRAPH. NC2194.2 +002600* NC2194.2 +002700**************************************************************** NC2194.2 +002800* NC2194.2 +002900* NC2194.2 +003000* ACCORDING TO THE RULES FOR PROGRAM COLLATING SEQUENCE NC2194.2 +003100* THE LOWEST CHARACTER SHOULD BE THE LETTER F FOLLOWED BY NC2194.2 +003200* THE LETTER U FOLLOWED IN ASCENDING ORDER BY THE LETTER N NC2194.2 +003300* WHICH IS SET ON AN EVEN PAR WITH THE COMPUTER VALUES FOR NC2194.2 +003400* HIGH-VALUE AND LOW-VALUE. THE NEXT HIGHEST CHARACTER IS THE NC2194.2 +003500* LETTER Y. THE REMAINDER OF THE CHARACTERS IN THE COBOL NC2194.2 +003600* CHARACTER SET THEN FOLLOW IN ASCENDING ORDER BUT EXCLUDE NC2194.2 +003700* THE CHARACTERS AND VALUES PREVIOUSLY METIONED (F,U,N,HIGH- NC2194.2 +003800* VALUE, LOW-VALUE, AND Y). LOW-VALUE FOR THE NEW PROGRAM NC2194.2 +003900* COLLATING SEQUENCE JUST EVALUATED SHOULD BE THE LETTER F. NC2194.2 +004000* HIGH-VALUE SHOULD NOW BE EVALUATED AS THE HIGHEST ORDER NC2194.2 +004100* CHARACTER FROM THE REMAINDER OF THE NATIVE COLLATING SEQUENCENC2194.2 +004200* NOT INCLUDING THE CHARACTERS F,U,N,**PREVIOUS** HIGH-VALUE NC2194.2 +004300* OR **PREVIOUS** LOW-VALUE, AND THE LETTER Y. NC2194.2 +004400* NC2194.2 +004500* THE ALPHABET-NAME COLLATING-SEQ-2 IS NOT USED IN NC2194.2 +004600* THE PROGRAM EXCEPT TO TEST WHETHER THE LETTER Q HAS BEEN NC2194.2 +004700* SET TO AN EQUAL PAR WITH THE NEW HIGH-VALUE AND NEW LOW-VALUENC2194.2 +004800* FOR PURPOSES OF THE PROGRAM COLLATING SEQUENCE. THIS WOULD NC2194.2 +004900* BE TRUE IF THE ALPHABET-NAME COLLATING-SEQ-2 WERE REFERENCED NC2194.2 +005000* IN A SORT, MERGE, OR CODE-SET CLAUSE. NC2194.2 +005100* NC2194.2 +005200* NC2194.2 +005300* NC2194.2 +005400 ENVIRONMENT DIVISION. NC2194.2 +005500 CONFIGURATION SECTION. NC2194.2 +005600 SOURCE-COMPUTER. NC2194.2 +005700 Linux. NC2194.2 +005800 OBJECT-COMPUTER. NC2194.2 +005900 Linux NC2194.2 +006000 PROGRAM COLLATING SEQUENCE IS COLLATING-SEQ-1. NC2194.2 +006100 SPECIAL-NAMES. NC2194.2 +006200 ALPHABET NC2194.2 +006300 COLLATING-SEQ-1 IS "F" "U" "N" NC2194.2 +006400 ALSO HIGH-VALUE NC2194.2 +006500 ALSO LOW-VALUE NC2194.2 +006600 "Y" NC2194.2 +006700 ALPHABET NC2194.2 +006800 COLLATING-SEQ-2 IS "Q" NC2194.2 +006900 ALSO HIGH-VALUE NC2194.2 +007000 ALSO LOW-VALUE. NC2194.2 +007100 INPUT-OUTPUT SECTION. NC2194.2 +007200 FILE-CONTROL. NC2194.2 +007300 SELECT PRINT-FILE ASSIGN TO NC2194.2 +007400 "report.log". NC2194.2 +007500 DATA DIVISION. NC2194.2 +007600 FILE SECTION. NC2194.2 +007700 FD PRINT-FILE. NC2194.2 +007800 01 PRINT-REC PICTURE X(120). NC2194.2 +007900 01 DUMMY-RECORD PICTURE X(120). NC2194.2 +008000 WORKING-STORAGE SECTION. NC2194.2 +008100 01 F-AN-1 PICTURE A VALUE "F". NC2194.2 +008200 01 U-AN-1 PICTURE A VALUE "U". NC2194.2 +008300 01 N-AN-1 PICTURE A VALUE "N". NC2194.2 +008400 01 Y-AN-1 PICTURE A VALUE "Y". NC2194.2 +008500 01 Q-AN-1 PICTURE A VALUE "Q". NC2194.2 +008600 01 NEW-LOW PICTURE X VALUE LOW-VALUE. NC2194.2 +008700 01 TEST-RESULTS. NC2194.2 +008800 02 FILLER PIC X VALUE SPACE. NC2194.2 +008900 02 FEATURE PIC X(20) VALUE SPACE. NC2194.2 +009000 02 FILLER PIC X VALUE SPACE. NC2194.2 +009100 02 P-OR-F PIC X(5) VALUE SPACE. NC2194.2 +009200 02 FILLER PIC X VALUE SPACE. NC2194.2 +009300 02 PAR-NAME. NC2194.2 +009400 03 FILLER PIC X(19) VALUE SPACE. NC2194.2 +009500 03 PARDOT-X PIC X VALUE SPACE. NC2194.2 +009600 03 DOTVALUE PIC 99 VALUE ZERO. NC2194.2 +009700 02 FILLER PIC X(8) VALUE SPACE. NC2194.2 +009800 02 RE-MARK PIC X(61). NC2194.2 +009900 01 TEST-COMPUTED. NC2194.2 +010000 02 FILLER PIC X(30) VALUE SPACE. NC2194.2 +010100 02 FILLER PIC X(17) VALUE NC2194.2 +010200 " COMPUTED=". NC2194.2 +010300 02 COMPUTED-X. NC2194.2 +010400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2194.2 +010500 03 COMPUTED-N REDEFINES COMPUTED-A NC2194.2 +010600 PIC -9(9).9(9). NC2194.2 +010700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2194.2 +010800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2194.2 +010900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2194.2 +011000 03 CM-18V0 REDEFINES COMPUTED-A. NC2194.2 +011100 04 COMPUTED-18V0 PIC -9(18). NC2194.2 +011200 04 FILLER PIC X. NC2194.2 +011300 03 FILLER PIC X(50) VALUE SPACE. NC2194.2 +011400 01 TEST-CORRECT. NC2194.2 +011500 02 FILLER PIC X(30) VALUE SPACE. NC2194.2 +011600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2194.2 +011700 02 CORRECT-X. NC2194.2 +011800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2194.2 +011900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2194.2 +012000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2194.2 +012100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2194.2 +012200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2194.2 +012300 03 CR-18V0 REDEFINES CORRECT-A. NC2194.2 +012400 04 CORRECT-18V0 PIC -9(18). NC2194.2 +012500 04 FILLER PIC X. NC2194.2 +012600 03 FILLER PIC X(2) VALUE SPACE. NC2194.2 +012700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2194.2 +012800 01 CCVS-C-1. NC2194.2 +012900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2194.2 +013000- "SS PARAGRAPH-NAME NC2194.2 +013100- " REMARKS". NC2194.2 +013200 02 FILLER PIC X(20) VALUE SPACE. NC2194.2 +013300 01 CCVS-C-2. NC2194.2 +013400 02 FILLER PIC X VALUE SPACE. NC2194.2 +013500 02 FILLER PIC X(6) VALUE "TESTED". NC2194.2 +013600 02 FILLER PIC X(15) VALUE SPACE. NC2194.2 +013700 02 FILLER PIC X(4) VALUE "FAIL". NC2194.2 +013800 02 FILLER PIC X(94) VALUE SPACE. NC2194.2 +013900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2194.2 +014000 01 REC-CT PIC 99 VALUE ZERO. NC2194.2 +014100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2194.2 +014200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2194.2 +014300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2194.2 +014400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2194.2 +014500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2194.2 +014600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2194.2 +014700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2194.2 +014800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2194.2 +014900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2194.2 +015000 01 CCVS-H-1. NC2194.2 +015100 02 FILLER PIC X(39) VALUE SPACES. NC2194.2 +015200 02 FILLER PIC X(42) VALUE NC2194.2 +015300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2194.2 +015400 02 FILLER PIC X(39) VALUE SPACES. NC2194.2 +015500 01 CCVS-H-2A. NC2194.2 +015600 02 FILLER PIC X(40) VALUE SPACE. NC2194.2 +015700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2194.2 +015800 02 FILLER PIC XXXX VALUE NC2194.2 +015900 "4.2 ". NC2194.2 +016000 02 FILLER PIC X(28) VALUE NC2194.2 +016100 " COPY - NOT FOR DISTRIBUTION". NC2194.2 +016200 02 FILLER PIC X(41) VALUE SPACE. NC2194.2 +016300 NC2194.2 +016400 01 CCVS-H-2B. NC2194.2 +016500 02 FILLER PIC X(15) VALUE NC2194.2 +016600 "TEST RESULT OF ". NC2194.2 +016700 02 TEST-ID PIC X(9). NC2194.2 +016800 02 FILLER PIC X(4) VALUE NC2194.2 +016900 " IN ". NC2194.2 +017000 02 FILLER PIC X(12) VALUE NC2194.2 +017100 " HIGH ". NC2194.2 +017200 02 FILLER PIC X(22) VALUE NC2194.2 +017300 " LEVEL VALIDATION FOR ". NC2194.2 +017400 02 FILLER PIC X(58) VALUE NC2194.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2194.2 +017600 01 CCVS-H-3. NC2194.2 +017700 02 FILLER PIC X(34) VALUE NC2194.2 +017800 " FOR OFFICIAL USE ONLY ". NC2194.2 +017900 02 FILLER PIC X(58) VALUE NC2194.2 +018000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2194.2 +018100 02 FILLER PIC X(28) VALUE NC2194.2 +018200 " COPYRIGHT 1985 ". NC2194.2 +018300 01 CCVS-E-1. NC2194.2 +018400 02 FILLER PIC X(52) VALUE SPACE. NC2194.2 +018500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2194.2 +018600 02 ID-AGAIN PIC X(9). NC2194.2 +018700 02 FILLER PIC X(45) VALUE SPACES. NC2194.2 +018800 01 CCVS-E-2. NC2194.2 +018900 02 FILLER PIC X(31) VALUE SPACE. NC2194.2 +019000 02 FILLER PIC X(21) VALUE SPACE. NC2194.2 +019100 02 CCVS-E-2-2. NC2194.2 +019200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2194.2 +019300 03 FILLER PIC X VALUE SPACE. NC2194.2 +019400 03 ENDER-DESC PIC X(44) VALUE NC2194.2 +019500 "ERRORS ENCOUNTERED". NC2194.2 +019600 01 CCVS-E-3. NC2194.2 +019700 02 FILLER PIC X(22) VALUE NC2194.2 +019800 " FOR OFFICIAL USE ONLY". NC2194.2 +019900 02 FILLER PIC X(12) VALUE SPACE. NC2194.2 +020000 02 FILLER PIC X(58) VALUE NC2194.2 +020100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2194.2 +020200 02 FILLER PIC X(13) VALUE SPACE. NC2194.2 +020300 02 FILLER PIC X(15) VALUE NC2194.2 +020400 " COPYRIGHT 1985". NC2194.2 +020500 01 CCVS-E-4. NC2194.2 +020600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2194.2 +020700 02 FILLER PIC X(4) VALUE " OF ". NC2194.2 +020800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2194.2 +020900 02 FILLER PIC X(40) VALUE NC2194.2 +021000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2194.2 +021100 01 XXINFO. NC2194.2 +021200 02 FILLER PIC X(19) VALUE NC2194.2 +021300 "*** INFORMATION ***". NC2194.2 +021400 02 INFO-TEXT. NC2194.2 +021500 04 FILLER PIC X(8) VALUE SPACE. NC2194.2 +021600 04 XXCOMPUTED PIC X(20). NC2194.2 +021700 04 FILLER PIC X(5) VALUE SPACE. NC2194.2 +021800 04 XXCORRECT PIC X(20). NC2194.2 +021900 02 INF-ANSI-REFERENCE PIC X(48). NC2194.2 +022000 01 HYPHEN-LINE. NC2194.2 +022100 02 FILLER PIC IS X VALUE IS SPACE. NC2194.2 +022200 02 FILLER PIC IS X(65) VALUE IS "************************NC2194.2 +022300- "*****************************************". NC2194.2 +022400 02 FILLER PIC IS X(54) VALUE IS "************************NC2194.2 +022500- "******************************". NC2194.2 +022600 01 CCVS-PGM-ID PIC X(9) VALUE NC2194.2 +022700 "NC219A". NC2194.2 +022800 PROCEDURE DIVISION. NC2194.2 +022900 CCVS1 SECTION. NC2194.2 +023000 OPEN-FILES. NC2194.2 +023100 OPEN OUTPUT PRINT-FILE. NC2194.2 +023200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2194.2 +023300 MOVE SPACE TO TEST-RESULTS. NC2194.2 +023400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2194.2 +023500 GO TO CCVS1-EXIT. NC2194.2 +023600 CLOSE-FILES. NC2194.2 +023700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2194.2 +023800 TERMINATE-CCVS. NC2194.2 +023900*S EXIT PROGRAM. NC2194.2 +024000*SERMINATE-CALL. NC2194.2 +024100 STOP RUN. NC2194.2 +024200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2194.2 +024300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2194.2 +024400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2194.2 +024500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2194.2 +024600 MOVE "****TEST DELETED****" TO RE-MARK. NC2194.2 +024700 PRINT-DETAIL. NC2194.2 +024800 IF REC-CT NOT EQUAL TO ZERO NC2194.2 +024900 MOVE "." TO PARDOT-X NC2194.2 +025000 MOVE REC-CT TO DOTVALUE. NC2194.2 +025100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2194.2 +025200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2194.2 +025300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2194.2 +025400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2194.2 +025500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2194.2 +025600 MOVE SPACE TO CORRECT-X. NC2194.2 +025700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2194.2 +025800 MOVE SPACE TO RE-MARK. NC2194.2 +025900 HEAD-ROUTINE. NC2194.2 +026000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +026100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +026200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2194.2 +026300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2194.2 +026400 COLUMN-NAMES-ROUTINE. NC2194.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +026800 END-ROUTINE. NC2194.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2194.2 +027000 END-RTN-EXIT. NC2194.2 +027100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +027200 END-ROUTINE-1. NC2194.2 +027300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2194.2 +027400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2194.2 +027500 ADD PASS-COUNTER TO ERROR-HOLD. NC2194.2 +027600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2194.2 +027700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2194.2 +027800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2194.2 +027900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2194.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2194.2 +028100 END-ROUTINE-12. NC2194.2 +028200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2194.2 +028300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2194.2 +028400 MOVE "NO " TO ERROR-TOTAL NC2194.2 +028500 ELSE NC2194.2 +028600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2194.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2194.2 +028800 PERFORM WRITE-LINE. NC2194.2 +028900 END-ROUTINE-13. NC2194.2 +029000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2194.2 +029100 MOVE "NO " TO ERROR-TOTAL ELSE NC2194.2 +029200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2194.2 +029300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2194.2 +029400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +029500 IF INSPECT-COUNTER EQUAL TO ZERO NC2194.2 +029600 MOVE "NO " TO ERROR-TOTAL NC2194.2 +029700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2194.2 +029800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2194.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +030000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2194.2 +030100 WRITE-LINE. NC2194.2 +030200 ADD 1 TO RECORD-COUNT. NC2194.2 +030300 IF RECORD-COUNT GREATER 50 NC2194.2 +030400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2194.2 +030500 MOVE SPACE TO DUMMY-RECORD NC2194.2 +030600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2194.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2194.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2194.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2194.2 +031000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2194.2 +031100 MOVE ZERO TO RECORD-COUNT. NC2194.2 +031200 PERFORM WRT-LN. NC2194.2 +031300 WRT-LN. NC2194.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2194.2 +031500 MOVE SPACE TO DUMMY-RECORD. NC2194.2 +031600 BLANK-LINE-PRINT. NC2194.2 +031700 PERFORM WRT-LN. NC2194.2 +031800 FAIL-ROUTINE. NC2194.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2194.2 +032000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2194.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2194.2 +032200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2194.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2194.2 +032500 GO TO FAIL-ROUTINE-EX. NC2194.2 +032600 FAIL-ROUTINE-WRITE. NC2194.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2194.2 +032800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2194.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2194.2 +033000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2194.2 +033100 FAIL-ROUTINE-EX. EXIT. NC2194.2 +033200 BAIL-OUT. NC2194.2 +033300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2194.2 +033400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2194.2 +033500 BAIL-OUT-WRITE. NC2194.2 +033600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2194.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2194.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2194.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2194.2 +034000 BAIL-OUT-EX. EXIT. NC2194.2 +034100 CCVS1-EXIT. NC2194.2 +034200 EXIT. NC2194.2 +034300 SECT-NC219A-001 SECTION. NC2194.2 +034400* NC2194.2 +034500* NC2194.2 +034600* THE LETTER F IS THE LOWEST CHARACTER IN THE PROGRAM NC2194.2 +034700* COLLATING SEQUENCE FOLLOWED IN ASCENDING ORDER BY THE NC2194.2 +034800* LETTER U. THIS IS SHOWN IN THE ALPHABET-NAME NC2194.2 +034900* COLLATING-SEQ-1. NC2194.2 +035000* NC2194.2 +035100* F SHOULD BE LESS THAN U. NC2194.2 +035200* NC2194.2 +035300* NC2194.2 +035400 SEQ-INIT-GF-1. NC2194.2 +035500 MOVE "SEQ-TEST-GF-1" TO PAR-NAME. NC2194.2 +035600 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +035700 MOVE "F < U" TO FEATURE. NC2194.2 +035800 SEQ-TEST-GF-1. NC2194.2 +035900 IF F-AN-1 IS LESS THAN U-AN-1 NC2194.2 +036000 PERFORM PASS NC2194.2 +036100 ELSE NC2194.2 +036200 GO TO SEQ-FAIL-GF-1. NC2194.2 +036300 GO TO SEQ-WRITE-GF-1. NC2194.2 +036400 SEQ-DELETE-GF-1. NC2194.2 +036500 PERFORM DE-LETE. NC2194.2 +036600 GO TO SEQ-WRITE-GF-1. NC2194.2 +036700 SEQ-FAIL-GF-1. NC2194.2 +036800 PERFORM FAIL NC2194.2 +036900 MOVE "F NOT < THAN U" TO COMPUTED-A. NC2194.2 +037000 SEQ-WRITE-GF-1. NC2194.2 +037100 PERFORM PRINT-DETAIL. NC2194.2 +037200* NC2194.2 +037300* NC2194.2 +037400* THE LETTER U IS THE SECOND LOWEST CHARACTER IN THE NC2194.2 +037500* PROGRAM COLLATING SEQUENCE FOLLOWED IN ASCENDING ORDER BY THENC2194.2 +037600* LETTER N. THIS IS SHOWN IN THE ALPHABET-NAME NC2194.2 +037700* COLLATING-SEQ-1. NC2194.2 +037800* NC2194.2 +037900* U SHOULD BE LESS THAN N. NC2194.2 +038000* NC2194.2 +038100* NC2194.2 +038200 SEQ-INIT-GF-2. NC2194.2 +038300 MOVE "SEQ-TEST-GF-2" TO PAR-NAME. NC2194.2 +038400 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +038500 MOVE "U < N" TO FEATURE. NC2194.2 +038600 SEQ-TEST-GF-2. NC2194.2 +038700* NC2194.2 +038800 IF U-AN-1 IS LESS THAN N-AN-1 NC2194.2 +038900 PERFORM PASS NC2194.2 +039000 ELSE NC2194.2 +039100 GO TO SEQ-FAIL-GF-2. NC2194.2 +039200 GO TO SEQ-WRITE-GF-2. NC2194.2 +039300 SEQ-DELETE-GF-2. NC2194.2 +039400 PERFORM DE-LETE. NC2194.2 +039500 GO TO SEQ-WRITE-GF-2. NC2194.2 +039600 SEQ-FAIL-GF-2. NC2194.2 +039700 PERFORM FAIL NC2194.2 +039800 MOVE "U NOT < THAN N" TO COMPUTED-A. NC2194.2 +039900 SEQ-WRITE-GF-2. NC2194.2 +040000 PERFORM PRINT-DETAIL. NC2194.2 +040100* NC2194.2 +040200* NC2194.2 +040300* THE LETTER N IS SET TO AN EVEN PAR WITH THE **OLD** NC2194.2 +040400* HIGH-VALUE BUT NOT EQUAL TO THE **NEW** HIGH-VALUE. NC2194.2 +040500* NC2194.2 +040600* N SHOULD NOT = HIGH-VALUE. NC2194.2 +040700* NC2194.2 +040800* NC2194.2 +040900 SEQ-INIT-GF-3. NC2194.2 +041000 MOVE "SEQ-TEST-GF-3" TO PAR-NAME. NC2194.2 +041100 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +041200 MOVE "N = HIGH-VALUE" TO FEATURE. NC2194.2 +041300 SEQ-TEST-GF-3. NC2194.2 +041400* NC2194.2 +041500 IF N-AN-1 IS EQUAL TO HIGH-VALUE NC2194.2 +041600 GO TO SEQ-FAIL-GF-3 NC2194.2 +041700 ELSE NC2194.2 +041800 PERFORM PASS. NC2194.2 +041900 GO TO SEQ-WRITE-GF-3. NC2194.2 +042000 SEQ-DELETE-GF-3. NC2194.2 +042100 PERFORM DE-LETE. NC2194.2 +042200 GO TO SEQ-WRITE-GF-3. NC2194.2 +042300 SEQ-FAIL-GF-3. NC2194.2 +042400 PERFORM FAIL NC2194.2 +042500 MOVE "N = HIGH-VALUE" TO COMPUTED-A. NC2194.2 +042600 SEQ-WRITE-GF-3. NC2194.2 +042700 PERFORM PRINT-DETAIL. NC2194.2 +042800* NC2194.2 +042900* NC2194.2 +043000* LOW-VALUE SHOULD BE SET TO THE LETTER F SINCE IT NC2194.2 +043100* IS THE LOWEST CHARACTER IN THE PROGRAM COLLATING SEQUENCE. NC2194.2 +043200* NC2194.2 +043300* F SHOULD BE EQUAL TO LOW-VALUE. NC2194.2 +043400* NC2194.2 +043500* NC2194.2 +043600 SEQ-INIT-GF-4. NC2194.2 +043700 MOVE "SEQ-TEST-GF-4" TO PAR-NAME. NC2194.2 +043800 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +043900 MOVE "F = LOW-VALUE" TO FEATURE. NC2194.2 +044000 SEQ-TEST-GF-4. NC2194.2 +044100* NC2194.2 +044200 IF F-AN-1 IS EQUAL TO LOW-VALUE NC2194.2 +044300 PERFORM PASS NC2194.2 +044400 ELSE NC2194.2 +044500 GO TO SEQ-FAIL-GF-4. NC2194.2 +044600 GO TO SEQ-WRITE-GF-4. NC2194.2 +044700 SEQ-DELETE-GF-4. NC2194.2 +044800 PERFORM DE-LETE. NC2194.2 +044900 GO TO SEQ-WRITE-GF-4. NC2194.2 +045000 SEQ-FAIL-GF-4. NC2194.2 +045100 PERFORM FAIL NC2194.2 +045200 MOVE "F NOT = LOW-VALUE" TO COMPUTED-A. NC2194.2 +045300 SEQ-WRITE-GF-4. NC2194.2 +045400 PERFORM PRINT-DETAIL. NC2194.2 +045500* NC2194.2 +045600* NC2194.2 +045700* THE **NEW** LOW-VALUE SHOULD BE SET TO THE LETTER F. NC2194.2 +045800* THE **NEW** HIGH-VALUE SHOULD BE SET TO THE HIGHEST ORDER NC2194.2 +045900* CHARACTER IN THE EVALUATED PROGRAM COLLATING SEQUENCE. NC2194.2 +046000* NC2194.2 +046100* HIGH-VALUE SHOULD BE GREATER THAN LOW-VALUE. NC2194.2 +046200* NC2194.2 +046300* NC2194.2 +046400 SEQ-INIT-GF-5. NC2194.2 +046500 MOVE "SEQ-TEST-GF-5" TO PAR-NAME. NC2194.2 +046600 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +046700 MOVE "H-VALUE > L-VALUE" TO FEATURE. NC2194.2 +046800 SEQ-TEST-GF-5. NC2194.2 +046900* NC2194.2 +047000 IF HIGH-VALUE IS GREATER THAN NEW-LOW NC2194.2 +047100 PERFORM PASS NC2194.2 +047200 ELSE NC2194.2 +047300 GO TO SEQ-FAIL-GF-5. NC2194.2 +047400 GO TO SEQ-WRITE-GF-5. NC2194.2 +047500 SEQ-DELETE-GF-5. NC2194.2 +047600 PERFORM DE-LETE. NC2194.2 +047700 GO TO SEQ-WRITE-GF-5. NC2194.2 +047800 SEQ-FAIL-GF-5. NC2194.2 +047900 PERFORM FAIL NC2194.2 +048000 MOVE "H-VALU NOT > L-VALU" TO COMPUTED-A. NC2194.2 +048100 SEQ-WRITE-GF-5. NC2194.2 +048200 PERFORM PRINT-DETAIL. NC2194.2 +048300* NC2194.2 +048400* NC2194.2 +048500* LOW-VALUE SHOULD BE LESS THAN HIGH-VALUE. NC2194.2 +048600* NC2194.2 +048700* NC2194.2 +048800 SEQ-INIT-GF-6. NC2194.2 +048900 MOVE "SEQ-TEST-GF-6" TO PAR-NAME. NC2194.2 +049000 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +049100 MOVE "L-VALUE < H-VALUE" TO FEATURE. NC2194.2 +049200 SEQ-TEST-GF-6. NC2194.2 +049300* NC2194.2 +049400 IF NEW-LOW IS LESS THAN HIGH-VALUE NC2194.2 +049500 PERFORM PASS NC2194.2 +049600 ELSE NC2194.2 +049700 GO TO SEQ-FAIL-GF-6. NC2194.2 +049800 GO TO SEQ-WRITE-GF-6. NC2194.2 +049900 SEQ-DELETE-GF-6. NC2194.2 +050000 PERFORM DE-LETE. NC2194.2 +050100 GO TO SEQ-WRITE-GF-6. NC2194.2 +050200 SEQ-FAIL-GF-6. NC2194.2 +050300 PERFORM FAIL NC2194.2 +050400 MOVE "L-VALU NOT < H-VALU" TO COMPUTED-A. NC2194.2 +050500 SEQ-WRITE-GF-6. NC2194.2 +050600 PERFORM PRINT-DETAIL. NC2194.2 +050700* NC2194.2 +050800* NC2194.2 +050900* LOW-VALUE SHOULD NOT BE EQUAL TO HIGH-VALUE. NC2194.2 +051000* NC2194.2 +051100* NC2194.2 +051200 SEQ-INIT-GF-7. NC2194.2 +051300 MOVE "SEQ-TEST-GF-7" TO PAR-NAME. NC2194.2 +051400 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +051500 MOVE "H-VALUE = L-VALUE" TO FEATURE. NC2194.2 +051600 SEQ-TEST-GF-7. NC2194.2 +051700* NC2194.2 +051800 IF HIGH-VALUE IS EQUAL TO NEW-LOW NC2194.2 +051900 GO TO SEQ-FAIL-GF-7 NC2194.2 +052000 ELSE NC2194.2 +052100 PERFORM PASS. NC2194.2 +052200 GO TO SEQ-WRITE-GF-7. NC2194.2 +052300 SEQ-DELETE-GF-7. NC2194.2 +052400 PERFORM DE-LETE. NC2194.2 +052500 GO TO SEQ-WRITE-GF-7. NC2194.2 +052600 SEQ-FAIL-GF-7. NC2194.2 +052700 PERFORM FAIL NC2194.2 +052800 MOVE "H-VALUE = L-VALUE" TO COMPUTED-A. NC2194.2 +052900 SEQ-WRITE-GF-7. NC2194.2 +053000 PERFORM PRINT-DETAIL. NC2194.2 +053100* NC2194.2 +053200* NC2194.2 +053300* LOW-VALUE SHOULD BE SET TO THE LETTER F. NC2194.2 +053400* NC2194.2 +053500* THE LETTER Y SHOULD NOT BE EQUAL TO LOW-VALUE. NC2194.2 +053600* NC2194.2 +053700* NC2194.2 +053800 SEQ-INIT-GF-8. NC2194.2 +053900 MOVE "SEQ-TEST-GF-8" TO PAR-NAME. NC2194.2 +054000 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +054100 MOVE "Y = LOW-VALUE" TO FEATURE. NC2194.2 +054200 SEQ-TEST-GF-8. NC2194.2 +054300* NC2194.2 +054400 IF Y-AN-1 IS EQUAL TO LOW-VALUE NC2194.2 +054500 GO TO SEQ-FAIL-GF-8 NC2194.2 +054600 ELSE NC2194.2 +054700 PERFORM PASS. NC2194.2 +054800 GO TO SEQ-WRITE-GF-8. NC2194.2 +054900 SEQ-DELETE-GF-8. NC2194.2 +055000 PERFORM DE-LETE. NC2194.2 +055100 GO TO SEQ-WRITE-GF-8. NC2194.2 +055200 SEQ-FAIL-GF-8. NC2194.2 +055300 PERFORM FAIL NC2194.2 +055400 MOVE "Y = LOW-VALUE" TO COMPUTED-A. NC2194.2 +055500 SEQ-WRITE-GF-8. NC2194.2 +055600 PERFORM PRINT-DETAIL. NC2194.2 +055700* NC2194.2 +055800* NC2194.2 +055900* THE LETTER Q IS MENTIONED IN THE ALPHABET-NAME NC2194.2 +056000* COLLATING-SEQ-2. THIS ALPHABET-NAME CLAUSE SHOULD HAVE NO NC2194.2 +056100* EFFECT ON THE PROGRAM COLLATING SEQUENCE. NC2194.2 +056200* NC2194.2 +056300* FOR OUR PROGRAM COLLATING SEQUENCE Q SHOULD NOT NC2194.2 +056400* BE THE LOW ORDER CHARACTER THEREFORE IT SHOULD NOT NC2194.2 +056500* BE EQUAL TO THE **NEW** LOW-VALUE. NC2194.2 +056600* NC2194.2 +056700* NC2194.2 +056800 SEQ-INIT-GF-9. NC2194.2 +056900 MOVE "SEQ-TEST-GF-9" TO PAR-NAME. NC2194.2 +057000 MOVE "VI-16 4.5.4 GR5/7" TO ANSI-REFERENCE. NC2194.2 +057100 MOVE "Q = LOW-VALUE" TO FEATURE. NC2194.2 +057200 SEQ-TEST-GF-9. NC2194.2 +057300* NC2194.2 +057400 IF Q-AN-1 IS EQUAL TO LOW-VALUE NC2194.2 +057500 GO TO SEQ-FAIL-GF-9 NC2194.2 +057600 ELSE NC2194.2 +057700 PERFORM PASS. NC2194.2 +057800 GO TO SEQ-WRITE-GF-9. NC2194.2 +057900 SEQ-DELETE-GF-9. NC2194.2 +058000 PERFORM DE-LETE. NC2194.2 +058100 GO TO SEQ-WRITE-GF-9. NC2194.2 +058200 SEQ-FAIL-GF-9. NC2194.2 +058300 PERFORM FAIL NC2194.2 +058400 MOVE "Q = LOW-VALUE" TO COMPUTED-A. NC2194.2 +058500 SEQ-WRITE-GF-9. NC2194.2 +058600 PERFORM PRINT-DETAIL. NC2194.2 +058700* NC2194.2 +058800* NC2194.2 +058900 CCVS-EXIT SECTION. NC2194.2 +059000 CCVS-999999. NC2194.2 +059100 GO TO CLOSE-FILES. NC2194.2 diff --git a/tests/cobol85/NC/NC220M.CBL b/tests/cobol85/NC/NC220M.CBL new file mode 100755 index 00000000..890c2e04 --- /dev/null +++ b/tests/cobol85/NC/NC220M.CBL @@ -0,0 +1,1037 @@ +000100 IDENTIFICATION DIVISION. NC2204.2 +000200 PROGRAM-ID. NC2204.2 +000300 NC220M. NC2204.2 +000400**************************************************************** NC2204.2 +000500* * NC2204.2 +000600* VALIDATION FOR:- * NC2204.2 +000700* * NC2204.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2204.2 +000900* * NC2204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2204.2 +001100* * NC2204.2 +001200**************************************************************** NC2204.2 +001300* * NC2204.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2204.2 +001500* * NC2204.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2204.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2204.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2204.2 +001900* * NC2204.2 +002000**************************************************************** NC2204.2 +002100* * NC2204.2 +002200* PROGRAM NC220M TESTS THE USE OF INDEXED IDENTIFIERS AND * NC2204.2 +002300* QUALIFIED DATANAMES WITH FORMAT 1 OF THE "MULTIPLY" * NC2204.2 +002400* STATEMENT, FORMATS 3 & 4 OF THE "PERFORM" STATEMENT AND * NC2204.2 +002500* THE GENERAL FORMAT OF THE "DISPLAY" STATEMENT. * NC2204.2 +002600* * NC2204.2 +002700* * NC2204.2 +002800**************************************************************** NC2204.2 +002900 ENVIRONMENT DIVISION. NC2204.2 +003000 CONFIGURATION SECTION. NC2204.2 +003100 SOURCE-COMPUTER. NC2204.2 +003200 Linux. NC2204.2 +003300 OBJECT-COMPUTER. NC2204.2 +003400 Linux. NC2204.2 +003500 SPECIAL-NAMES. NC2204.2 +003600 SYSOUT NC2204.2 +003700 IS DISPLAY-OUTPUT-DEVICE. NC2204.2 +003800 INPUT-OUTPUT SECTION. NC2204.2 +003900 FILE-CONTROL. NC2204.2 +004000 SELECT PRINT-FILE ASSIGN TO NC2204.2 +004100 "report.log". NC2204.2 +004200 DATA DIVISION. NC2204.2 +004300 FILE SECTION. NC2204.2 +004400 FD PRINT-FILE. NC2204.2 +004500 01 PRINT-REC PICTURE X(120). NC2204.2 +004600 01 DUMMY-RECORD PICTURE X(120). NC2204.2 +004700 WORKING-STORAGE SECTION. NC2204.2 +004800 01 TABLE1. NC2204.2 +004900 02 TABLE1-REC PICTURE X(10) NC2204.2 +005000 OCCURS 2 TIMES NC2204.2 +005100 INDEXED BY INDEX1. NC2204.2 +005200 01 TABLE2. NC2204.2 +005300 02 NUMBER1 PICTURE 99 VALUE 03. NC2204.2 +005400 02 NUMBER2 PICTURE 99 NC2204.2 +005500 OCCURS 4 TIMES NC2204.2 +005600 INDEXED BY INDEX2. NC2204.2 +005700 02 NUMBER3 PICTURE 99 VALUE 06. NC2204.2 +005800 01 TABLE3. NC2204.2 +005900 02 NUMBER1 PICTURE 99 VALUE 10. NC2204.2 +006000 02 NUMBER2 PICTURE 99 NC2204.2 +006100 OCCURS 4 TIMES NC2204.2 +006200 INDEXED BY INDEX3. NC2204.2 +006300 02 NUMBER3 PICTURE 99 VALUE 13. NC2204.2 +006400 01 TABLE4. NC2204.2 +006500 02 TABLE4-NUM1 OCCURS 3 TIMES NC2204.2 +006600 INDEXED BY INDEX4-1. NC2204.2 +006700 03 TABLE4-NUM2 PICTURE 99 NC2204.2 +006800 OCCURS 3 TIMES NC2204.2 +006900 INDEXED BY INDEX4-2. NC2204.2 +007000 01 TABLE5. NC2204.2 +007100 02 TABLE5-NUM PICTURE 999 NC2204.2 +007200 OCCURS 6 TIMES NC2204.2 +007300 INDEXED BY INDEX5. NC2204.2 +007400 01 TABLE6. NC2204.2 +007500 02 TABLE6-NUM PICTURE 999 NC2204.2 +007600 OCCURS 6 TIMES NC2204.2 +007700 INDEXED BY INDEX6. NC2204.2 +007800 01 TABLE7. NC2204.2 +007900 02 TABLE7-NUM PICTURE 9 NC2204.2 +008000 OCCURS 2 TIMES NC2204.2 +008100 INDEXED BY INDEX7. NC2204.2 +008200 01 TABLE8. NC2204.2 +008300 02 TABLE8-NUM PICTURE 9 NC2204.2 +008400 OCCURS 3 TIMES NC2204.2 +008500 INDEXED BY INDEX8. NC2204.2 +008600 01 NUM-9 PICTURE 9. NC2204.2 +008700 01 NUM-999 PICTURE 999. NC2204.2 +008800 01 TEST-RESULTS. NC2204.2 +008900 02 FILLER PIC X VALUE SPACE. NC2204.2 +009000 02 FEATURE PIC X(20) VALUE SPACE. NC2204.2 +009100 02 FILLER PIC X VALUE SPACE. NC2204.2 +009200 02 P-OR-F PIC X(5) VALUE SPACE. NC2204.2 +009300 02 FILLER PIC X VALUE SPACE. NC2204.2 +009400 02 PAR-NAME. NC2204.2 +009500 03 FILLER PIC X(19) VALUE SPACE. NC2204.2 +009600 03 PARDOT-X PIC X VALUE SPACE. NC2204.2 +009700 03 DOTVALUE PIC 99 VALUE ZERO. NC2204.2 +009800 02 FILLER PIC X(8) VALUE SPACE. NC2204.2 +009900 02 RE-MARK PIC X(61). NC2204.2 +010000 01 TEST-COMPUTED. NC2204.2 +010100 02 FILLER PIC X(30) VALUE SPACE. NC2204.2 +010200 02 FILLER PIC X(17) VALUE NC2204.2 +010300 " COMPUTED=". NC2204.2 +010400 02 COMPUTED-X. NC2204.2 +010500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2204.2 +010600 03 COMPUTED-N REDEFINES COMPUTED-A NC2204.2 +010700 PIC -9(9).9(9). NC2204.2 +010800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2204.2 +010900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2204.2 +011000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2204.2 +011100 03 CM-18V0 REDEFINES COMPUTED-A. NC2204.2 +011200 04 COMPUTED-18V0 PIC -9(18). NC2204.2 +011300 04 FILLER PIC X. NC2204.2 +011400 03 FILLER PIC X(50) VALUE SPACE. NC2204.2 +011500 01 TEST-CORRECT. NC2204.2 +011600 02 FILLER PIC X(30) VALUE SPACE. NC2204.2 +011700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2204.2 +011800 02 CORRECT-X. NC2204.2 +011900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2204.2 +012000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2204.2 +012100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2204.2 +012200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2204.2 +012300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2204.2 +012400 03 CR-18V0 REDEFINES CORRECT-A. NC2204.2 +012500 04 CORRECT-18V0 PIC -9(18). NC2204.2 +012600 04 FILLER PIC X. NC2204.2 +012700 03 FILLER PIC X(2) VALUE SPACE. NC2204.2 +012800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2204.2 +012900 01 CCVS-C-1. NC2204.2 +013000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2204.2 +013100- "SS PARAGRAPH-NAME NC2204.2 +013200- " REMARKS". NC2204.2 +013300 02 FILLER PIC X(20) VALUE SPACE. NC2204.2 +013400 01 CCVS-C-2. NC2204.2 +013500 02 FILLER PIC X VALUE SPACE. NC2204.2 +013600 02 FILLER PIC X(6) VALUE "TESTED". NC2204.2 +013700 02 FILLER PIC X(15) VALUE SPACE. NC2204.2 +013800 02 FILLER PIC X(4) VALUE "FAIL". NC2204.2 +013900 02 FILLER PIC X(94) VALUE SPACE. NC2204.2 +014000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2204.2 +014100 01 REC-CT PIC 99 VALUE ZERO. NC2204.2 +014200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2204.2 +014300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2204.2 +014400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2204.2 +014500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2204.2 +014600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2204.2 +014700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2204.2 +014800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2204.2 +014900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2204.2 +015000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2204.2 +015100 01 CCVS-H-1. NC2204.2 +015200 02 FILLER PIC X(39) VALUE SPACES. NC2204.2 +015300 02 FILLER PIC X(42) VALUE NC2204.2 +015400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2204.2 +015500 02 FILLER PIC X(39) VALUE SPACES. NC2204.2 +015600 01 CCVS-H-2A. NC2204.2 +015700 02 FILLER PIC X(40) VALUE SPACE. NC2204.2 +015800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2204.2 +015900 02 FILLER PIC XXXX VALUE NC2204.2 +016000 "4.2 ". NC2204.2 +016100 02 FILLER PIC X(28) VALUE NC2204.2 +016200 " COPY - NOT FOR DISTRIBUTION". NC2204.2 +016300 02 FILLER PIC X(41) VALUE SPACE. NC2204.2 +016400 NC2204.2 +016500 01 CCVS-H-2B. NC2204.2 +016600 02 FILLER PIC X(15) VALUE NC2204.2 +016700 "TEST RESULT OF ". NC2204.2 +016800 02 TEST-ID PIC X(9). NC2204.2 +016900 02 FILLER PIC X(4) VALUE NC2204.2 +017000 " IN ". NC2204.2 +017100 02 FILLER PIC X(12) VALUE NC2204.2 +017200 " HIGH ". NC2204.2 +017300 02 FILLER PIC X(22) VALUE NC2204.2 +017400 " LEVEL VALIDATION FOR ". NC2204.2 +017500 02 FILLER PIC X(58) VALUE NC2204.2 +017600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2204.2 +017700 01 CCVS-H-3. NC2204.2 +017800 02 FILLER PIC X(34) VALUE NC2204.2 +017900 " FOR OFFICIAL USE ONLY ". NC2204.2 +018000 02 FILLER PIC X(58) VALUE NC2204.2 +018100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2204.2 +018200 02 FILLER PIC X(28) VALUE NC2204.2 +018300 " COPYRIGHT 1985 ". NC2204.2 +018400 01 CCVS-E-1. NC2204.2 +018500 02 FILLER PIC X(52) VALUE SPACE. NC2204.2 +018600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2204.2 +018700 02 ID-AGAIN PIC X(9). NC2204.2 +018800 02 FILLER PIC X(45) VALUE SPACES. NC2204.2 +018900 01 CCVS-E-2. NC2204.2 +019000 02 FILLER PIC X(31) VALUE SPACE. NC2204.2 +019100 02 FILLER PIC X(21) VALUE SPACE. NC2204.2 +019200 02 CCVS-E-2-2. NC2204.2 +019300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2204.2 +019400 03 FILLER PIC X VALUE SPACE. NC2204.2 +019500 03 ENDER-DESC PIC X(44) VALUE NC2204.2 +019600 "ERRORS ENCOUNTERED". NC2204.2 +019700 01 CCVS-E-3. NC2204.2 +019800 02 FILLER PIC X(22) VALUE NC2204.2 +019900 " FOR OFFICIAL USE ONLY". NC2204.2 +020000 02 FILLER PIC X(12) VALUE SPACE. NC2204.2 +020100 02 FILLER PIC X(58) VALUE NC2204.2 +020200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2204.2 +020300 02 FILLER PIC X(13) VALUE SPACE. NC2204.2 +020400 02 FILLER PIC X(15) VALUE NC2204.2 +020500 " COPYRIGHT 1985". NC2204.2 +020600 01 CCVS-E-4. NC2204.2 +020700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2204.2 +020800 02 FILLER PIC X(4) VALUE " OF ". NC2204.2 +020900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2204.2 +021000 02 FILLER PIC X(40) VALUE NC2204.2 +021100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2204.2 +021200 01 XXINFO. NC2204.2 +021300 02 FILLER PIC X(19) VALUE NC2204.2 +021400 "*** INFORMATION ***". NC2204.2 +021500 02 INFO-TEXT. NC2204.2 +021600 04 FILLER PIC X(8) VALUE SPACE. NC2204.2 +021700 04 XXCOMPUTED PIC X(20). NC2204.2 +021800 04 FILLER PIC X(5) VALUE SPACE. NC2204.2 +021900 04 XXCORRECT PIC X(20). NC2204.2 +022000 02 INF-ANSI-REFERENCE PIC X(48). NC2204.2 +022100 01 HYPHEN-LINE. NC2204.2 +022200 02 FILLER PIC IS X VALUE IS SPACE. NC2204.2 +022300 02 FILLER PIC IS X(65) VALUE IS "************************NC2204.2 +022400- "*****************************************". NC2204.2 +022500 02 FILLER PIC IS X(54) VALUE IS "************************NC2204.2 +022600- "******************************". NC2204.2 +022700 01 CCVS-PGM-ID PIC X(9) VALUE NC2204.2 +022800 "NC220M". NC2204.2 +022900 PROCEDURE DIVISION. NC2204.2 +023000 CCVS1 SECTION. NC2204.2 +023100 OPEN-FILES. NC2204.2 +023200 OPEN OUTPUT PRINT-FILE. NC2204.2 +023300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2204.2 +023400 MOVE SPACE TO TEST-RESULTS. NC2204.2 +023500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2204.2 +023600 GO TO CCVS1-EXIT. NC2204.2 +023700 CLOSE-FILES. NC2204.2 +023800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2204.2 +023900 TERMINATE-CCVS. NC2204.2 +024000*S EXIT PROGRAM. NC2204.2 +024100*SERMINATE-CALL. NC2204.2 +024200 STOP RUN. NC2204.2 +024300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2204.2 +024400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2204.2 +024500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2204.2 +024600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2204.2 +024700 MOVE "****TEST DELETED****" TO RE-MARK. NC2204.2 +024800 PRINT-DETAIL. NC2204.2 +024900 IF REC-CT NOT EQUAL TO ZERO NC2204.2 +025000 MOVE "." TO PARDOT-X NC2204.2 +025100 MOVE REC-CT TO DOTVALUE. NC2204.2 +025200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2204.2 +025300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2204.2 +025400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2204.2 +025500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2204.2 +025600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2204.2 +025700 MOVE SPACE TO CORRECT-X. NC2204.2 +025800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2204.2 +025900 MOVE SPACE TO RE-MARK. NC2204.2 +026000 HEAD-ROUTINE. NC2204.2 +026100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +026200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +026300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2204.2 +026400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2204.2 +026500 COLUMN-NAMES-ROUTINE. NC2204.2 +026600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +026700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +026800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +026900 END-ROUTINE. NC2204.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2204.2 +027100 END-RTN-EXIT. NC2204.2 +027200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +027300 END-ROUTINE-1. NC2204.2 +027400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2204.2 +027500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2204.2 +027600 ADD PASS-COUNTER TO ERROR-HOLD. NC2204.2 +027700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2204.2 +027800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2204.2 +027900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2204.2 +028000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2204.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2204.2 +028200 END-ROUTINE-12. NC2204.2 +028300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2204.2 +028400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2204.2 +028500 MOVE "NO " TO ERROR-TOTAL NC2204.2 +028600 ELSE NC2204.2 +028700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2204.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2204.2 +028900 PERFORM WRITE-LINE. NC2204.2 +029000 END-ROUTINE-13. NC2204.2 +029100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2204.2 +029200 MOVE "NO " TO ERROR-TOTAL ELSE NC2204.2 +029300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2204.2 +029400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2204.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +029600 IF INSPECT-COUNTER EQUAL TO ZERO NC2204.2 +029700 MOVE "NO " TO ERROR-TOTAL NC2204.2 +029800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2204.2 +029900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2204.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +030100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2204.2 +030200 WRITE-LINE. NC2204.2 +030300 ADD 1 TO RECORD-COUNT. NC2204.2 +030400 IF RECORD-COUNT GREATER 50 NC2204.2 +030500 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2204.2 +030600 MOVE SPACE TO DUMMY-RECORD NC2204.2 +030700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2204.2 +030800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2204.2 +030900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2204.2 +031000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2204.2 +031100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2204.2 +031200 MOVE ZERO TO RECORD-COUNT. NC2204.2 +031300 PERFORM WRT-LN. NC2204.2 +031400 WRT-LN. NC2204.2 +031500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2204.2 +031600 MOVE SPACE TO DUMMY-RECORD. NC2204.2 +031700 BLANK-LINE-PRINT. NC2204.2 +031800 PERFORM WRT-LN. NC2204.2 +031900 FAIL-ROUTINE. NC2204.2 +032000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2204.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2204.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2204.2 +032300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2204.2 +032400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +032500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2204.2 +032600 GO TO FAIL-ROUTINE-EX. NC2204.2 +032700 FAIL-ROUTINE-WRITE. NC2204.2 +032800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2204.2 +032900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2204.2 +033000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2204.2 +033100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2204.2 +033200 FAIL-ROUTINE-EX. EXIT. NC2204.2 +033300 BAIL-OUT. NC2204.2 +033400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2204.2 +033500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2204.2 +033600 BAIL-OUT-WRITE. NC2204.2 +033700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2204.2 +033800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2204.2 +033900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2204.2 +034000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2204.2 +034100 BAIL-OUT-EX. EXIT. NC2204.2 +034200 CCVS1-EXIT. NC2204.2 +034300 EXIT. NC2204.2 +034400 SECT-NC220M-001 SECTION. NC2204.2 +034500 BUILD-TABLE1. NC2204.2 +034600 MOVE "LITERAL-02" TO TABLE1-REC (1). NC2204.2 +034700 MOVE "9876543210" TO TABLE1-REC (2). NC2204.2 +034800 BUILD-TABLE2. NC2204.2 +034900 MOVE 04 TO NUMBER2 OF TABLE2 (1). NC2204.2 +035000 MOVE 23 TO NUMBER2 OF TABLE2 (2). NC2204.2 +035100 MOVE 02 TO NUMBER2 OF TABLE2 (3). NC2204.2 +035200 MOVE 06 TO NUMBER2 OF TABLE2 (4). NC2204.2 +035300 BUILD-TABLE3. NC2204.2 +035400 MOVE 11 TO NUMBER2 OF TABLE3 (1). NC2204.2 +035500 MOVE 04 TO NUMBER2 OF TABLE3 (2). NC2204.2 +035600 MOVE 04 TO NUMBER2 OF TABLE3 (3). NC2204.2 +035700 MOVE 24 TO NUMBER2 OF TABLE3 (4). NC2204.2 +035800 BUILD-TABLE4. NC2204.2 +035900 MOVE 03 TO TABLE4-NUM2 (1, 1). NC2204.2 +036000 MOVE 04 TO TABLE4-NUM2 (1, 2). NC2204.2 +036100 MOVE 05 TO TABLE4-NUM2 (1, 3). NC2204.2 +036200 MOVE 12 TO TABLE4-NUM2 (2, 1). NC2204.2 +036300 MOVE 13 TO TABLE4-NUM2 (2, 2). NC2204.2 +036400 MOVE 14 TO TABLE4-NUM2 (2, 3). NC2204.2 +036500 MOVE 31 TO TABLE4-NUM2 (3, 1). NC2204.2 +036600 MOVE 32 TO TABLE4-NUM2 (3, 2). NC2204.2 +036700 MOVE 33 TO TABLE4-NUM2 (3, 3). NC2204.2 +036800 BUILD-TABLE5. NC2204.2 +036900 MOVE 011 TO TABLE5-NUM (1). NC2204.2 +037000 MOVE 005 TO TABLE5-NUM (2). NC2204.2 +037100 MOVE 597 TO TABLE5-NUM (3). NC2204.2 +037200 MOVE 036 TO TABLE5-NUM (4). NC2204.2 +037300 MOVE 082 TO TABLE5-NUM (5). NC2204.2 +037400 MOVE 125 TO TABLE5-NUM (6). NC2204.2 +037500 BUILD-TABLE7. NC2204.2 +037600 MOVE 1 TO TABLE7-NUM (1). NC2204.2 +037700 MOVE 9 TO TABLE7-NUM (2). NC2204.2 +037800 BUILD-TABLE8. NC2204.2 +037900 MOVE 4 TO TABLE8-NUM (1). NC2204.2 +038000 MOVE 7 TO TABLE8-NUM (2). NC2204.2 +038100 MOVE 2 TO TABLE8-NUM (3). NC2204.2 +038200* NC2204.2 +038300 DIS-INIT-GF-1. NC2204.2 +038400 MOVE "DIS-TEST-GF-1" TO PAR-NAME. NC2204.2 +038500 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +038600 MOVE "DISPLAY UPON" TO FEATURE. NC2204.2 +038700 MOVE "RESULTS MUST BE" TO RE-MARK. NC2204.2 +038800 MOVE "LITERAL-02" TO CORRECT-A. NC2204.2 +038900 PERFORM BUILD-TABLE1. NC2204.2 +039000 SET INDEX1 TO 1. NC2204.2 +039100 DIS-TEST-GF-1. NC2204.2 +039200 DISPLAY " " UPON DISPLAY-OUTPUT-DEVICE. NC2204.2 +039300 DISPLAY TABLE1-REC (INDEX1) UPON DISPLAY-OUTPUT-DEVICE. NC2204.2 +039400 PERFORM INSPT. NC2204.2 +039500 GO TO DIS-WRITE-GF-1. NC2204.2 +039600 DIS-DELETE-GF-1. NC2204.2 +039700 PERFORM DE-LETE. NC2204.2 +039800 DIS-WRITE-GF-1. NC2204.2 +039900 PERFORM PRINT-DETAIL. NC2204.2 +040000* NC2204.2 +040100 DIS-INIT-GF-2. NC2204.2 +040200 MOVE "DIS-TEST-GF-2" TO PAR-NAME. NC2204.2 +040300 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +040400 MOVE "DISPLAY UPON" TO FEATURE. NC2204.2 +040500 MOVE "VISUALLY CHECKED" TO RE-MARK. NC2204.2 +040600 MOVE "9876543210" TO CORRECT-A. NC2204.2 +040700 PERFORM BUILD-TABLE1. NC2204.2 +040800 SET INDEX1 TO 1. NC2204.2 +040900 DIS-TEST-GF-2. NC2204.2 +041000 DISPLAY TABLE1-REC (INDEX1 + 1) NC2204.2 +041100 UPON DISPLAY-OUTPUT-DEVICE. NC2204.2 +041200 PERFORM INSPT. NC2204.2 +041300 GO TO DIS-WRITE-GF-2. NC2204.2 +041400 DIS-DELETE-GF-2. NC2204.2 +041500 PERFORM DE-LETE. NC2204.2 +041600 DIS-WRITE-GF-2. NC2204.2 +041700 PERFORM PRINT-DETAIL. NC2204.2 +041800* NC2204.2 +041900 MLT-INIT-F1-1. NC2204.2 +042000 MOVE "MLT-TEST-F1-1" TO PAR-NAME. NC2204.2 +042100 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +042200 MOVE "MULTIPLY BY" TO FEATURE. NC2204.2 +042300 PERFORM BUILD-TABLE2. NC2204.2 +042400 PERFORM BUILD-TABLE3. NC2204.2 +042500 SET INDEX2 TO 1. NC2204.2 +042600 SET INDEX3 TO 1. NC2204.2 +042700 MLT-TEST-F1-1. NC2204.2 +042800 MULTIPLY NUMBER2 OF TABLE2 (INDEX2) NC2204.2 +042900 BY NUMBER2 OF TABLE3 (INDEX3). NC2204.2 +043000 IF NUMBER2 OF TABLE3 (INDEX3) = 44 NC2204.2 +043100 PERFORM PASS NC2204.2 +043200 ELSE GO TO MLT-FAIL-F1-1. NC2204.2 +043300 GO TO MLT-WRITE-F1-1. NC2204.2 +043400 MLT-DELETE-F1-1. NC2204.2 +043500 PERFORM DE-LETE. NC2204.2 +043600 GO TO MLT-WRITE-F1-1. NC2204.2 +043700 MLT-FAIL-F1-1. NC2204.2 +043800 PERFORM FAIL. NC2204.2 +043900 MOVE NUMBER2 OF TABLE3 (INDEX3) TO COMPUTED-18V0. NC2204.2 +044000 MOVE 44 TO CORRECT-18V0. NC2204.2 +044100 MLT-WRITE-F1-1. NC2204.2 +044200 PERFORM PRINT-DETAIL. NC2204.2 +044300* NC2204.2 +044400 MLT-INIT-F1-2. NC2204.2 +044500 MOVE "MLT-TEST-F1-2" TO PAR-NAME. NC2204.2 +044600 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +044700 MOVE "MULTIPLY BY" TO FEATURE. NC2204.2 +044800 PERFORM BUILD-TABLE2. NC2204.2 +044900 PERFORM BUILD-TABLE3. NC2204.2 +045000 PERFORM BUILD-TABLE4. NC2204.2 +045100 SET INDEX2 TO 1. NC2204.2 +045200 SET INDEX3 TO 1. NC2204.2 +045300 MLT-TEST-F1-2. NC2204.2 +045400 MULTIPLY NUMBER2 OF TABLE2 (INDEX2 + 1) NC2204.2 +045500 BY NUMBER2 OF TABLE3 (INDEX3 + 1). NC2204.2 +045600 IF NUMBER2 OF TABLE3 (INDEX3 + 1) = 92 NC2204.2 +045700 PERFORM PASS NC2204.2 +045800 ELSE GO TO MLT-FAIL-F1-2. NC2204.2 +045900 GO TO MLT-WRITE-F1-2. NC2204.2 +046000 MLT-DELETE-F1-2. NC2204.2 +046100 PERFORM DE-LETE. NC2204.2 +046200 GO TO MLT-WRITE-F1-2. NC2204.2 +046300 MLT-FAIL-F1-2. NC2204.2 +046400 PERFORM FAIL. NC2204.2 +046500 MOVE NUMBER2 OF TABLE3 (INDEX3 + 1) TO COMPUTED-18V0. NC2204.2 +046600 MOVE 92 TO CORRECT-18V0. NC2204.2 +046700 MLT-WRITE-F1-2. NC2204.2 +046800 PERFORM PRINT-DETAIL. NC2204.2 +046900* NC2204.2 +047000 MLT-INIT-F1-3. NC2204.2 +047100 MOVE "MLT-TEST-F1-3" TO PAR-NAME. NC2204.2 +047200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +047300 MOVE "MULTIPLY BY" TO FEATURE. NC2204.2 +047400 PERFORM BUILD-TABLE4. NC2204.2 +047500 SET INDEX4-1 TO 2. NC2204.2 +047600 SET INDEX4-2 TO 1. NC2204.2 +047700 MLT-TEST-F1-3. NC2204.2 +047800 MULTIPLY TABLE4-NUM2 (1, 3) NC2204.2 +047900 BY TABLE4-NUM2 (INDEX4-1, INDEX4-2). NC2204.2 +048000 IF TABLE4-NUM2 (INDEX4-1, INDEX4-2) = 60 NC2204.2 +048100 PERFORM PASS NC2204.2 +048200 ELSE GO TO MLT-FAIL-F1-3. NC2204.2 +048300 GO TO MLT-WRITE-F1-3. NC2204.2 +048400 MLT-DELETE-F1-3. NC2204.2 +048500 PERFORM DE-LETE. NC2204.2 +048600 GO TO MLT-WRITE-F1-3. NC2204.2 +048700 MLT-FAIL-F1-3. NC2204.2 +048800 PERFORM FAIL. NC2204.2 +048900 MOVE TABLE4-NUM2 (INDEX4-1, INDEX4-2) TO COMPUTED-18V0. NC2204.2 +049000 MOVE 60 TO CORRECT-18V0. NC2204.2 +049100 MLT-WRITE-F1-3. NC2204.2 +049200 PERFORM PRINT-DETAIL. NC2204.2 +049300* NC2204.2 +049400 DIV-INIT-F5-1. NC2204.2 +049500 MOVE "DIV-TEST-F5-1" TO PAR-NAME. NC2204.2 +049600 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +049700 MOVE "DIVIDE BY REMAINDER" TO FEATURE. NC2204.2 +049800 MOVE 1 TO REC-CT. NC2204.2 +049900 MOVE ZEROS TO TABLE6. NC2204.2 +050000 MOVE ZEROS TO NUM-999. NC2204.2 +050100 PERFORM BUILD-TABLE5. NC2204.2 +050200 SET INDEX5 TO 1. NC2204.2 +050300 SET INDEX6 TO 1. NC2204.2 +050400 DIV-TEST-F5-1. NC2204.2 +050500 DIVIDE TABLE5-NUM (INDEX5) BY TABLE5-NUM (INDEX5 + 1) NC2204.2 +050600 GIVING TABLE6-NUM (INDEX6) REMAINDER NUM-999. NC2204.2 +050700 GO TO DIV-TEST-F5-1-1. NC2204.2 +050800 DIV-DELETE-F5-1. NC2204.2 +050900 PERFORM DE-LETE. NC2204.2 +051000 PERFORM PRINT-DETAIL. NC2204.2 +051100 GO TO DIV-TEST-F5-2. NC2204.2 +051200* NC2204.2 +051300 DIV-TEST-F5-1-1. NC2204.2 +051400 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +051500 IF TABLE6-NUM (INDEX6) = 2 NC2204.2 +051600 PERFORM PASS NC2204.2 +051700 GO TO DIV-WRITE-F5-1-1 NC2204.2 +051800 ELSE NC2204.2 +051900 GO TO DIV-FAIL-F5-1-1. NC2204.2 +052000 DIV-DELETE-F5-1-1. NC2204.2 +052100 PERFORM DE-LETE. NC2204.2 +052200 GO TO DIV-WRITE-F5-1-1. NC2204.2 +052300 DIV-FAIL-F5-1-1. NC2204.2 +052400 PERFORM FAIL NC2204.2 +052500 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +052600 MOVE 2 TO CORRECT-18V0. NC2204.2 +052700 DIV-WRITE-F5-1-1. NC2204.2 +052800 PERFORM PRINT-DETAIL. NC2204.2 +052900* NC2204.2 +053000 DIV-TEST-F5-1-2. NC2204.2 +053100 ADD 1 TO REC-CT. NC2204.2 +053200 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +053300 IF NUM-999 = 1 NC2204.2 +053400 PERFORM PASS NC2204.2 +053500 GO TO DIV-WRITE-F5-1-2 NC2204.2 +053600 ELSE NC2204.2 +053700 GO TO DIV-FAIL-F5-1-2. NC2204.2 +053800 DIV-DELETE-F5-1-2. NC2204.2 +053900 PERFORM DE-LETE. NC2204.2 +054000 GO TO DIV-WRITE-F5-1-2. NC2204.2 +054100 DIV-FAIL-F5-1-2. NC2204.2 +054200 PERFORM FAIL NC2204.2 +054300 MOVE NUM-999 TO COMPUTED-18V0 NC2204.2 +054400 MOVE 1 TO CORRECT-18V0. NC2204.2 +054500 DIV-WRITE-F5-1-2. NC2204.2 +054600 PERFORM PRINT-DETAIL. NC2204.2 +054700* NC2204.2 +054800 DIV-INIT-F5-2. NC2204.2 +054900 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +055000 MOVE "DIV-TEST-F5-2" TO PAR-NAME. NC2204.2 +055100 MOVE "DIVIDE BY REMAINDER" TO FEATURE. NC2204.2 +055200 MOVE 1 TO REC-CT. NC2204.2 +055300 MOVE ZEROS TO TABLE6. NC2204.2 +055400 MOVE ZEROS TO NUM-999. NC2204.2 +055500 SET INDEX5 TO 3. NC2204.2 +055600 SET INDEX6 TO 3. NC2204.2 +055700 DIV-TEST-F5-2. NC2204.2 +055800 DIVIDE TABLE5-NUM (INDEX5) BY TABLE5-NUM (INDEX5 + 1) NC2204.2 +055900 GIVING NUM-999 REMAINDER TABLE6-NUM (INDEX6). NC2204.2 +056000 GO TO DIV-TEST-F5-2-1. NC2204.2 +056100 DIV-DELETE-F5-2. NC2204.2 +056200 PERFORM DE-LETE. NC2204.2 +056300 PERFORM PRINT-DETAIL. NC2204.2 +056400 GO TO DIV-TEST-F5-3. NC2204.2 +056500* NC2204.2 +056600 DIV-TEST-F5-2-1. NC2204.2 +056700 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +056800 IF NUM-999 = 16 NC2204.2 +056900 PERFORM PASS NC2204.2 +057000 GO TO DIV-WRITE-F5-2-1 NC2204.2 +057100 ELSE NC2204.2 +057200 GO TO DIV-FAIL-F5-2-1. NC2204.2 +057300 DIV-DELETE-F5-2-1. NC2204.2 +057400 PERFORM DE-LETE. NC2204.2 +057500 GO TO DIV-WRITE-F5-2-1. NC2204.2 +057600 DIV-FAIL-F5-2-1. NC2204.2 +057700 PERFORM FAIL NC2204.2 +057800 MOVE NUM-999 TO COMPUTED-18V0 NC2204.2 +057900 MOVE 16 TO CORRECT-18V0. NC2204.2 +058000 DIV-WRITE-F5-2-1. NC2204.2 +058100 PERFORM PRINT-DETAIL. NC2204.2 +058200* NC2204.2 +058300 DIV-TEST-F5-2-2. NC2204.2 +058400 ADD 1 TO REC-CT. NC2204.2 +058500 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +058600 IF TABLE6-NUM (INDEX6) = 21 NC2204.2 +058700 PERFORM PASS NC2204.2 +058800 GO TO DIV-WRITE-F5-2-2 NC2204.2 +058900 ELSE NC2204.2 +059000 GO TO DIV-FAIL-F5-2-2. NC2204.2 +059100 DIV-DELETE-F5-2-2. NC2204.2 +059200 PERFORM DE-LETE. NC2204.2 +059300 GO TO DIV-WRITE-F5-2-2. NC2204.2 +059400 DIV-FAIL-F5-2-2. NC2204.2 +059500 PERFORM FAIL NC2204.2 +059600 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +059700 MOVE 21 TO CORRECT-18V0. NC2204.2 +059800 DIV-WRITE-F5-2-2. NC2204.2 +059900 PERFORM PRINT-DETAIL. NC2204.2 +060000* NC2204.2 +060100 DIV-INIT-F5-3. NC2204.2 +060200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +060300 MOVE "DIV-TEST-F5-3" TO PAR-NAME. NC2204.2 +060400 MOVE "DIVIDE BY REMAINDER" TO FEATURE. NC2204.2 +060500 MOVE 1 TO REC-CT. NC2204.2 +060600 MOVE ZEROS TO TABLE6. NC2204.2 +060700 SET INDEX5 TO 5. NC2204.2 +060800 SET INDEX6 TO 5. NC2204.2 +060900 DIV-TEST-F5-3. NC2204.2 +061000 DIVIDE TABLE5-NUM (INDEX5) BY TABLE5-NUM (INDEX5 + 1) NC2204.2 +061100 GIVING TABLE6-NUM (INDEX6) NC2204.2 +061200 REMAINDER TABLE6-NUM (INDEX6 + 1). NC2204.2 +061300 GO TO DIV-TEST-F5-3-1. NC2204.2 +061400 DIV-DELETE-F5-3. NC2204.2 +061500 PERFORM DE-LETE. NC2204.2 +061600 PERFORM PRINT-DETAIL. NC2204.2 +061700 GO TO DIV-TEST-F4-4. NC2204.2 +061800* NC2204.2 +061900 DIV-TEST-F5-3-1. NC2204.2 +062000 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +062100 IF TABLE6-NUM (INDEX6) = 0 NC2204.2 +062200 PERFORM PASS NC2204.2 +062300 GO TO DIV-WRITE-F5-3-1 NC2204.2 +062400 ELSE NC2204.2 +062500 GO TO DIV-FAIL-F5-3-1. NC2204.2 +062600 DIV-DELETE-F5-3-1. NC2204.2 +062700 PERFORM DE-LETE. NC2204.2 +062800 GO TO DIV-WRITE-F5-3-1. NC2204.2 +062900 DIV-FAIL-F5-3-1. NC2204.2 +063000 PERFORM FAIL NC2204.2 +063100 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +063200 MOVE 0 TO CORRECT-18V0. NC2204.2 +063300 DIV-WRITE-F5-3-1. NC2204.2 +063400 PERFORM PRINT-DETAIL. NC2204.2 +063500* NC2204.2 +063600 DIV-TEST-F5-3-2. NC2204.2 +063700 ADD 1 TO REC-CT. NC2204.2 +063800 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +063900 IF TABLE6-NUM (INDEX6 + 1) = 82 NC2204.2 +064000 PERFORM PASS NC2204.2 +064100 GO TO DIV-WRITE-F5-3-2 NC2204.2 +064200 ELSE NC2204.2 +064300 GO TO DIV-FAIL-F5-3-2. NC2204.2 +064400 DIV-DELETE-F5-3-2. NC2204.2 +064500 PERFORM DE-LETE. NC2204.2 +064600 GO TO DIV-WRITE-F5-3-2. NC2204.2 +064700 DIV-FAIL-F5-3-2. NC2204.2 +064800 PERFORM FAIL NC2204.2 +064900 MOVE TABLE6-NUM (INDEX6 + 1) TO COMPUTED-18V0 NC2204.2 +065000 MOVE 82 TO CORRECT-18V0. NC2204.2 +065100 DIV-WRITE-F5-3-2. NC2204.2 +065200 PERFORM PRINT-DETAIL. NC2204.2 +065300* NC2204.2 +065400 DIV-INIT-F4-4. NC2204.2 +065500 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +065600 MOVE "DIV-TEST-F4-4" TO PAR-NAME. NC2204.2 +065700 MOVE "DIVIDE INTO REMNDER" TO FEATURE. NC2204.2 +065800 MOVE 1 TO REC-CT. NC2204.2 +065900 MOVE ZEROS TO TABLE6. NC2204.2 +066000 MOVE ZEROS TO NUM-999. NC2204.2 +066100 SET INDEX5 TO 1. NC2204.2 +066200 SET INDEX6 TO 1. NC2204.2 +066300 DIV-TEST-F4-4. NC2204.2 +066400 DIVIDE TABLE5-NUM (INDEX5 + 1) INTO TABLE5-NUM (INDEX5) NC2204.2 +066500 GIVING TABLE6-NUM (INDEX6) REMAINDER NUM-999. NC2204.2 +066600 GO TO DIV-TEST-F4-4-1. NC2204.2 +066700 DIV-DELETE-F4-4. NC2204.2 +066800 PERFORM DE-LETE. NC2204.2 +066900 PERFORM PRINT-DETAIL. NC2204.2 +067000 GO TO DIV-TEST-F4-5. NC2204.2 +067100* NC2204.2 +067200 DIV-TEST-F4-4-1. NC2204.2 +067300 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +067400 IF TABLE6-NUM (INDEX6) = 2 NC2204.2 +067500 PERFORM PASS NC2204.2 +067600 GO TO DIV-WRITE-F4-4-1 NC2204.2 +067700 ELSE NC2204.2 +067800 GO TO DIV-FAIL-F4-4-1. NC2204.2 +067900 DIV-DELETE-F4-4-1. NC2204.2 +068000 PERFORM DE-LETE. NC2204.2 +068100 GO TO DIV-WRITE-F4-4-1. NC2204.2 +068200 DIV-FAIL-F4-4-1. NC2204.2 +068300 PERFORM FAIL NC2204.2 +068400 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +068500 MOVE 2 TO CORRECT-18V0. NC2204.2 +068600 DIV-WRITE-F4-4-1. NC2204.2 +068700 PERFORM PRINT-DETAIL. NC2204.2 +068800 ADD 1 TO REC-CT. NC2204.2 +068900* NC2204.2 +069000 DIV-TEST-F4-4-2. NC2204.2 +069100 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +069200 IF NUM-999 = 1 NC2204.2 +069300 PERFORM PASS NC2204.2 +069400 GO TO DIV-WRITE-F4-4-2 NC2204.2 +069500 ELSE NC2204.2 +069600 GO TO DIV-FAIL-F4-4-2. NC2204.2 +069700 DIV-DELETE-F4-4-2. NC2204.2 +069800 PERFORM DE-LETE. NC2204.2 +069900 GO TO DIV-WRITE-F4-4-2. NC2204.2 +070000 DIV-FAIL-F4-4-2. NC2204.2 +070100 PERFORM FAIL NC2204.2 +070200 MOVE NUM-999 TO COMPUTED-18V0 NC2204.2 +070300 MOVE 1 TO CORRECT-18V0. NC2204.2 +070400 DIV-WRITE-F4-4-2. NC2204.2 +070500 PERFORM PRINT-DETAIL. NC2204.2 +070600* NC2204.2 +070700 DIV-INIT-F4-5. NC2204.2 +070800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +070900 MOVE "DIV-TEST-F4-5" TO PAR-NAME. NC2204.2 +071000 MOVE "DIVIDE INTO REMNDER" TO FEATURE. NC2204.2 +071100 MOVE 1 TO REC-CT. NC2204.2 +071200 MOVE ZEROS TO TABLE6. NC2204.2 +071300 MOVE ZEROS TO NUM-999. NC2204.2 +071400 SET INDEX5 TO 3. NC2204.2 +071500 SET INDEX6 TO 3. NC2204.2 +071600 DIV-TEST-F4-5. NC2204.2 +071700 DIVIDE TABLE5-NUM (INDEX5 + 1) INTO TABLE5-NUM (INDEX5) NC2204.2 +071800 GIVING NUM-999 REMAINDER TABLE6-NUM (INDEX6). NC2204.2 +071900 GO TO DIV-TEST-F4-5-1. NC2204.2 +072000 DIV-DELETE-F4-5. NC2204.2 +072100 PERFORM DE-LETE. NC2204.2 +072200 PERFORM PRINT-DETAIL. NC2204.2 +072300 GO TO DIV-TEST-F4-6. NC2204.2 +072400* NC2204.2 +072500 DIV-TEST-F4-5-1. NC2204.2 +072600 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +072700 IF NUM-999 = 16 NC2204.2 +072800 PERFORM PASS NC2204.2 +072900 GO TO DIV-WRITE-F4-5-1 NC2204.2 +073000 ELSE NC2204.2 +073100 GO TO DIV-FAIL-F4-5-1. NC2204.2 +073200 DIV-DELETE-F4-5-1. NC2204.2 +073300 PERFORM DE-LETE. NC2204.2 +073400 GO TO DIV-WRITE-F4-5-1. NC2204.2 +073500 DIV-FAIL-F4-5-1. NC2204.2 +073600 PERFORM FAIL NC2204.2 +073700 MOVE NUM-999 TO COMPUTED-18V0 NC2204.2 +073800 MOVE 16 TO CORRECT-18V0. NC2204.2 +073900 DIV-WRITE-F4-5-1. NC2204.2 +074000 PERFORM PRINT-DETAIL. NC2204.2 +074100 ADD 1 TO REC-CT. NC2204.2 +074200* NC2204.2 +074300 DIV-TEST-F4-5-2. NC2204.2 +074400 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +074500 IF TABLE6-NUM (INDEX6) = 21 NC2204.2 +074600 PERFORM PASS NC2204.2 +074700 GO TO DIV-WRITE-F4-5-2 NC2204.2 +074800 ELSE NC2204.2 +074900 GO TO DIV-FAIL-F4-5-2. NC2204.2 +075000 DIV-DELETE-F4-5-2. NC2204.2 +075100 PERFORM DE-LETE. NC2204.2 +075200 GO TO DIV-WRITE-F4-5-2. NC2204.2 +075300 DIV-FAIL-F4-5-2. NC2204.2 +075400 PERFORM FAIL NC2204.2 +075500 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +075600 MOVE 21 TO CORRECT-18V0. NC2204.2 +075700 DIV-WRITE-F4-5-2. NC2204.2 +075800 PERFORM PRINT-DETAIL. NC2204.2 +075900* NC2204.2 +076000 DIV-INIT-F4-6. NC2204.2 +076100 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +076200 MOVE "DIV-TEST-F4-6" TO PAR-NAME. NC2204.2 +076300 MOVE "DIVIDE INTO REMNDER" TO FEATURE. NC2204.2 +076400 MOVE 1 TO REC-CT. NC2204.2 +076500 MOVE ZEROS TO TABLE6. NC2204.2 +076600 MOVE ZEROS TO NUM-999. NC2204.2 +076700 SET INDEX5 TO 5. NC2204.2 +076800 SET INDEX6 TO 5. NC2204.2 +076900 DIV-TEST-F4-6. NC2204.2 +077000 DIVIDE TABLE5-NUM (INDEX5 + 1) INTO TABLE5-NUM (INDEX5) NC2204.2 +077100 GIVING TABLE6-NUM (INDEX6) NC2204.2 +077200 REMAINDER TABLE6-NUM (INDEX6 + 1). NC2204.2 +077300 GO TO DIV-TEST-F4-6-1. NC2204.2 +077400 DIV-DELETE-F4-6. NC2204.2 +077500 PERFORM DE-LETE. NC2204.2 +077600 PERFORM PRINT-DETAIL. NC2204.2 +077700 GO TO DIV-TEST-F1-7. NC2204.2 +077800* NC2204.2 +077900 DIV-TEST-F4-6-1. NC2204.2 +078000 MOVE "QUOTIENT" TO RE-MARK. NC2204.2 +078100 IF TABLE6-NUM (INDEX6) = 0 NC2204.2 +078200 PERFORM PASS NC2204.2 +078300 GO TO DIV-WRITE-F4-6-1 NC2204.2 +078400 ELSE NC2204.2 +078500 GO TO DIV-FAIL-F4-6-1. NC2204.2 +078600 DIV-DELETE-F4-6-1. NC2204.2 +078700 PERFORM DE-LETE. NC2204.2 +078800 GO TO DIV-WRITE-F4-6-1. NC2204.2 +078900 DIV-FAIL-F4-6-1. NC2204.2 +079000 PERFORM FAIL NC2204.2 +079100 MOVE TABLE6-NUM (INDEX6) TO COMPUTED-18V0 NC2204.2 +079200 MOVE 0 TO CORRECT-18V0. NC2204.2 +079300 DIV-WRITE-F4-6-1. NC2204.2 +079400 PERFORM PRINT-DETAIL. NC2204.2 +079500 ADD 1 TO REC-CT. NC2204.2 +079600* NC2204.2 +079700 DIV-TEST-F4-6-2. NC2204.2 +079800 MOVE "REMAINDER" TO RE-MARK. NC2204.2 +079900 IF TABLE6-NUM (INDEX6 + 1) = 82 NC2204.2 +080000 PERFORM PASS NC2204.2 +080100 GO TO DIV-WRITE-F4-6-2 NC2204.2 +080200 ELSE NC2204.2 +080300 GO TO DIV-FAIL-F4-6-2. NC2204.2 +080400 DIV-DELETE-F4-6-2. NC2204.2 +080500 PERFORM DE-LETE. NC2204.2 +080600 GO TO DIV-WRITE-F4-6-2. NC2204.2 +080700 DIV-FAIL-F4-6-2. NC2204.2 +080800 PERFORM FAIL NC2204.2 +080900 MOVE TABLE6-NUM (INDEX6 + 1) TO COMPUTED-18V0 NC2204.2 +081000 MOVE 82 TO CORRECT-18V0. NC2204.2 +081100 DIV-WRITE-F4-6-2. NC2204.2 +081200 PERFORM PRINT-DETAIL. NC2204.2 +081300* NC2204.2 +081400 DIV-INIT-F1-7. NC2204.2 +081500 MOVE "DIV-TEST-F1-7" TO PAR-NAME. NC2204.2 +081600 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +081700 MOVE ZEROS TO REC-CT. NC2204.2 +081800 PERFORM BUILD-TABLE2. NC2204.2 +081900 PERFORM BUILD-TABLE3. NC2204.2 +082000 MOVE "DIVIDE INTO" TO FEATURE. NC2204.2 +082100 SET INDEX2 TO 3. NC2204.2 +082200 SET INDEX3 TO 3. NC2204.2 +082300 DIV-TEST-F1-7. NC2204.2 +082400 DIVIDE NUMBER2 OF TABLE2 (INDEX2) NC2204.2 +082500 INTO NUMBER2 OF TABLE3 (INDEX3). NC2204.2 +082600 IF NUMBER2 OF TABLE3 (INDEX3) = 2 NC2204.2 +082700 PERFORM PASS NC2204.2 +082800 ELSE GO TO DIV-FAIL-F1-7. NC2204.2 +082900 GO TO DIV-WRITE-F1-7. NC2204.2 +083000 DIV-DELETE-F1-7. NC2204.2 +083100 PERFORM DE-LETE. NC2204.2 +083200 GO TO DIV-WRITE-F1-7. NC2204.2 +083300 DIV-FAIL-F1-7. NC2204.2 +083400 PERFORM FAIL. NC2204.2 +083500 MOVE NUMBER2 OF TABLE3 (INDEX3) TO COMPUTED-18V0. NC2204.2 +083600 MOVE 2 TO CORRECT-18V0. NC2204.2 +083700 DIV-WRITE-F1-7. NC2204.2 +083800 PERFORM PRINT-DETAIL. NC2204.2 +083900* NC2204.2 +084000 DIV-INIT-F1-8. NC2204.2 +084100 MOVE "DIV-TEST-F1-8" TO PAR-NAME. NC2204.2 +084200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +084300 MOVE ZEROS TO REC-CT. NC2204.2 +084400 PERFORM BUILD-TABLE2. NC2204.2 +084500 PERFORM BUILD-TABLE3. NC2204.2 +084600 MOVE "DIVIDE INTO" TO FEATURE. NC2204.2 +084700 SET INDEX2 TO 3. NC2204.2 +084800 SET INDEX3 TO 3. NC2204.2 +084900 DIV-TEST-F1-8. NC2204.2 +085000 DIVIDE NUMBER2 OF TABLE2 (INDEX2 + 1) NC2204.2 +085100 INTO NUMBER2 OF TABLE3 (INDEX3 + 1). NC2204.2 +085200 IF NUMBER2 OF TABLE3 (INDEX3 + 1) = 4 NC2204.2 +085300 PERFORM PASS NC2204.2 +085400 ELSE GO TO DIV-FAIL-F1-8. NC2204.2 +085500 GO TO DIV-WRITE-F1-8. NC2204.2 +085600 DIV-DELETE-F1-8. NC2204.2 +085700 PERFORM DE-LETE. NC2204.2 +085800 GO TO DIV-WRITE-F1-8. NC2204.2 +085900 DIV-FAIL-F1-8. NC2204.2 +086000 PERFORM FAIL. NC2204.2 +086100 MOVE NUMBER2 OF TABLE3 (INDEX3 + 1) TO COMPUTED-18V0. NC2204.2 +086200 MOVE 4 TO CORRECT-18V0. NC2204.2 +086300 DIV-WRITE-F1-8. NC2204.2 +086400 PERFORM PRINT-DETAIL. NC2204.2 +086500* NC2204.2 +086600 DIV-INIT-F5-9. NC2204.2 +086700 MOVE "DIV-TEST-F5-9" TO PAR-NAME. NC2204.2 +086800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +086900 MOVE ZEROS TO REC-CT. NC2204.2 +087000 PERFORM BUILD-TABLE2. NC2204.2 +087100 PERFORM BUILD-TABLE3. NC2204.2 +087200 MOVE "DIVIDE BY GIVING" TO FEATURE. NC2204.2 +087300 SET INDEX2 TO 1. NC2204.2 +087400 SET INDEX3 TO 2. NC2204.2 +087500 DIV-TEST-F5-9. NC2204.2 +087600 DIVIDE NUMBER2 OF TABLE2 (INDEX2) NC2204.2 +087700 BY NUMBER2 OF TABLE3 (INDEX3) NC2204.2 +087800 GIVING NUMBER2 OF TABLE3 (INDEX3 + 1). NC2204.2 +087900 IF NUMBER2 OF TABLE3 (INDEX3 + 1) = 1 NC2204.2 +088000 PERFORM PASS NC2204.2 +088100 ELSE GO TO DIV-FAIL-F5-9. NC2204.2 +088200 GO TO DIV-WRITE-F5-9. NC2204.2 +088300 DIV-DELETE-F5-9. NC2204.2 +088400 PERFORM DE-LETE. NC2204.2 +088500 GO TO DIV-WRITE-F5-9. NC2204.2 +088600 DIV-FAIL-F5-9. NC2204.2 +088700 PERFORM FAIL. NC2204.2 +088800 MOVE NUMBER2 OF TABLE3 (INDEX3 + 1) TO COMPUTED-18V0. NC2204.2 +088900 MOVE 1 TO CORRECT-18V0. NC2204.2 +089000 DIV-WRITE-F5-9. NC2204.2 +089100 PERFORM PRINT-DETAIL. NC2204.2 +089200* NC2204.2 +089300 DIV-INIT-F5-10. NC2204.2 +089400 MOVE "DIV-TEST-F5-10" TO PAR-NAME. NC2204.2 +089500 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +089600 MOVE ZEROS TO REC-CT. NC2204.2 +089700 PERFORM BUILD-TABLE2. NC2204.2 +089800 PERFORM BUILD-TABLE3. NC2204.2 +089900 MOVE "DIVIDE BY GIVING" TO FEATURE. NC2204.2 +090000 SET INDEX2 TO 2. NC2204.2 +090100 SET INDEX3 TO 3. NC2204.2 +090200 DIV-TEST-F5-10. NC2204.2 +090300 DIVIDE NUMBER2 OF TABLE3 (INDEX3 + 1) NC2204.2 +090400 BY NUMBER2 OF TABLE2 (INDEX2 + 2) NC2204.2 +090500 GIVING NUMBER2 OF TABLE2 (INDEX2). NC2204.2 +090600 IF NUMBER2 OF TABLE2 (INDEX2) = 4 NC2204.2 +090700 PERFORM PASS NC2204.2 +090800 ELSE GO TO DIV-FAIL-F5-10. NC2204.2 +090900 GO TO DIV-WRITE-F5-10. NC2204.2 +091000 DIV-DELETE-F5-10. NC2204.2 +091100 PERFORM DE-LETE. NC2204.2 +091200 GO TO DIV-WRITE-F5-10. NC2204.2 +091300 DIV-FAIL-F5-10. NC2204.2 +091400 PERFORM FAIL. NC2204.2 +091500 MOVE NUMBER2 OF TABLE2 (INDEX2) TO COMPUTED-18V0. NC2204.2 +091600 MOVE 4 TO CORRECT-18V0. NC2204.2 +091700 DIV-WRITE-F5-10. NC2204.2 +091800 PERFORM PRINT-DETAIL. NC2204.2 +091900* NC2204.2 +092000 PFM-INIT-F3-1. NC2204.2 +092100 MOVE "PFM-TEST-F3-1" TO PAR-NAME. NC2204.2 +092200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +092300 MOVE ZEROS TO REC-CT. NC2204.2 +092400 MOVE "PERFORM UNTIL" TO FEATURE. NC2204.2 +092500 PERFORM BUILD-TABLE7. NC2204.2 +092600 PERFORM BUILD-TABLE8. NC2204.2 +092700 SET INDEX7 TO 1. NC2204.2 +092800 SET INDEX8 TO 1. NC2204.2 +092900 PFM-TEST-F3-1. NC2204.2 +093000 PERFORM PARAGRAPH-A UNTIL TABLE7-NUM (INDEX7) NC2204.2 +093100 IS EQUAL TO TABLE8-NUM (INDEX8). NC2204.2 +093200 IF TABLE7-NUM (INDEX7) = 4 NC2204.2 +093300 PERFORM PASS NC2204.2 +093400 ELSE GO TO PFM-FAIL-F3-1. NC2204.2 +093500 GO TO PFM-WRITE-F3-1. NC2204.2 +093600 PFM-DELETE-F3-1. NC2204.2 +093700 PERFORM DE-LETE. NC2204.2 +093800 GO TO PFM-WRITE-F3-1. NC2204.2 +093900 PFM-FAIL-F3-1. NC2204.2 +094000 PERFORM FAIL. NC2204.2 +094100 MOVE TABLE7-NUM (INDEX7) TO COMPUTED-18V0. NC2204.2 +094200 MOVE 4 TO CORRECT-18V0. NC2204.2 +094300 PFM-WRITE-F3-1. NC2204.2 +094400 PERFORM PRINT-DETAIL. NC2204.2 +094500* NC2204.2 +094600 PFM-INIT-F3-2. NC2204.2 +094700 MOVE "PFM-TEST-F3-2" TO PAR-NAME. NC2204.2 +094800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +094900 MOVE ZEROS TO REC-CT. NC2204.2 +095000 MOVE "PERFORM UNTIL" TO FEATURE. NC2204.2 +095100 PERFORM BUILD-TABLE7. NC2204.2 +095200 PERFORM BUILD-TABLE8. NC2204.2 +095300 SET INDEX7 TO 1. NC2204.2 +095400 SET INDEX8 TO 1. NC2204.2 +095500 PFM-TEST-F3-2. NC2204.2 +095600 PERFORM PARAGRAPH-A UNTIL TABLE7-NUM (INDEX7) NC2204.2 +095700 IS GREATER THAN TABLE8-NUM (INDEX8). NC2204.2 +095800 IF TABLE7-NUM (INDEX7) = 5 NC2204.2 +095900 PERFORM PASS NC2204.2 +096000 ELSE GO TO PFM-FAIL-F3-2. NC2204.2 +096100 GO TO PFM-WRITE-F3-2. NC2204.2 +096200 PFM-DELETE-F3-2. NC2204.2 +096300 PERFORM DE-LETE. NC2204.2 +096400 GO TO PFM-WRITE-F3-2. NC2204.2 +096500 PFM-FAIL-F3-2. NC2204.2 +096600 PERFORM FAIL. NC2204.2 +096700 MOVE TABLE7-NUM (INDEX7) TO COMPUTED-18V0. NC2204.2 +096800 MOVE 5 TO CORRECT-18V0. NC2204.2 +096900 PFM-WRITE-F3-2. NC2204.2 +097000 PERFORM PRINT-DETAIL. NC2204.2 +097100* NC2204.2 +097200 PFM-INIT-F4-3. NC2204.2 +097300 MOVE "PFM-TEST-F4-3" TO PAR-NAME. NC2204.2 +097400 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +097500 MOVE ZEROS TO REC-CT. NC2204.2 +097600 MOVE "PERFORM VARYING" TO FEATURE. NC2204.2 +097700 MOVE ZEROS TO NUM-9. NC2204.2 +097800 PERFORM BUILD-TABLE7. NC2204.2 +097900 PERFORM BUILD-TABLE8. NC2204.2 +098000 SET INDEX7 TO 2. NC2204.2 +098100 SET INDEX8 TO 2. NC2204.2 +098200 PFM-TEST-F4-3. NC2204.2 +098300 PERFORM PARAGRAPH-B VARYING NUM-9 NC2204.2 +098400 FROM 1 BY 1 NC2204.2 +098500 UNTIL NUM-9 > TABLE8-NUM (INDEX8). NC2204.2 +098600 IF NUM-9 = 8 NC2204.2 +098700 PERFORM PASS NC2204.2 +098800 ELSE GO TO PFM-FAIL-F4-3. NC2204.2 +098900 GO TO PFM-WRITE-F4-3. NC2204.2 +099000 PFM-DELETE-F4-3. NC2204.2 +099100 PERFORM DE-LETE. NC2204.2 +099200 GO TO PFM-WRITE-F4-3. NC2204.2 +099300 PFM-FAIL-F4-3. NC2204.2 +099400 PERFORM FAIL. NC2204.2 +099500 MOVE NUM-9 TO COMPUTED-18V0. NC2204.2 +099600 MOVE 8 TO CORRECT-18V0. NC2204.2 +099700 PFM-WRITE-F4-3. NC2204.2 +099800 PERFORM PRINT-DETAIL. NC2204.2 +099900* NC2204.2 +100000 PFM-INIT-F4-4. NC2204.2 +100100 MOVE "PFM-TEST-F4-4" TO PAR-NAME. NC2204.2 +100200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2204.2 +100300 MOVE ZEROS TO REC-CT. NC2204.2 +100400 MOVE "PERFORM VARYING" TO FEATURE. NC2204.2 +100500 MOVE ZEROS TO NUM-9. NC2204.2 +100600 PERFORM BUILD-TABLE7. NC2204.2 +100700 PERFORM BUILD-TABLE8. NC2204.2 +100800 SET INDEX7 TO 2. NC2204.2 +100900 SET INDEX8 TO 3. NC2204.2 +101000 PFM-TEST-F4-4. NC2204.2 +101100 PERFORM PARAGRAPH-B VARYING NUM-9 NC2204.2 +101200 FROM 7 BY -1 NC2204.2 +101300 UNTIL NUM-9 < TABLE8-NUM (INDEX8). NC2204.2 +101400 IF NUM-9 = 1 NC2204.2 +101500 PERFORM PASS NC2204.2 +101600 ELSE GO TO PFM-FAIL-F4-4. NC2204.2 +101700 GO TO PFM-WRITE-F4-4. NC2204.2 +101800 PFM-DELETE-F4-4. NC2204.2 +101900 PERFORM DE-LETE. NC2204.2 +102000 GO TO PFM-WRITE-F4-4. NC2204.2 +102100 PFM-FAIL-F4-4. NC2204.2 +102200 PERFORM FAIL. NC2204.2 +102300 MOVE NUM-9 TO COMPUTED-18V0. NC2204.2 +102400 MOVE 1 TO CORRECT-18V0. NC2204.2 +102500 PFM-WRITE-F4-4. NC2204.2 +102600 PERFORM PRINT-DETAIL. NC2204.2 +102700 GO TO CCVS-999999. NC2204.2 +102800* NC2204.2 +102900 PARAGRAPH-A. NC2204.2 +103000 ADD 1 TO TABLE7-NUM (INDEX7). NC2204.2 +103100* NC2204.2 +103200 PARAGRAPH-B. NC2204.2 +103300 MOVE NUM-9 TO TABLE7-NUM (INDEX7). NC2204.2 +103400* NC2204.2 +103500 CCVS-EXIT SECTION. NC2204.2 +103600 CCVS-999999. NC2204.2 +103700 GO TO CLOSE-FILES. NC2204.2 diff --git a/tests/cobol85/NC/NC221A.CBL b/tests/cobol85/NC/NC221A.CBL new file mode 100755 index 00000000..45f0099d --- /dev/null +++ b/tests/cobol85/NC/NC221A.CBL @@ -0,0 +1,961 @@ +000100 IDENTIFICATION DIVISION. NC2214.2 +000200 PROGRAM-ID. NC2214.2 +000300 NC221A. NC2214.2 +000400**************************************************************** NC2214.2 +000500* * NC2214.2 +000600* VALIDATION FOR:- * NC2214.2 +000700* * NC2214.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2214.2 +000900* * NC2214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2214.2 +001100* * NC2214.2 +001200**************************************************************** NC2214.2 +001300* * NC2214.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2214.2 +001500* * NC2214.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2214.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2214.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2214.2 +001900* * NC2214.2 +002000**************************************************************** NC2214.2 +002100* * NC2214.2 +002200* PROGRAM NC221A TEST THE USE OF INDEXED IDENTIFIERS WITH * NC2214.2 +002300* FORMATS 1, 2 AND 3 OF THE "INSPECT" STATEMENT. * NC2214.2 +002400* * NC2214.2 +002500**************************************************************** NC2214.2 +002600 ENVIRONMENT DIVISION. NC2214.2 +002700 CONFIGURATION SECTION. NC2214.2 +002800 SOURCE-COMPUTER. NC2214.2 +002900 Linux. NC2214.2 +003000 OBJECT-COMPUTER. NC2214.2 +003100 Linux. NC2214.2 +003200 INPUT-OUTPUT SECTION. NC2214.2 +003300 FILE-CONTROL. NC2214.2 +003400 SELECT PRINT-FILE ASSIGN TO NC2214.2 +003500 "report.log". NC2214.2 +003600 DATA DIVISION. NC2214.2 +003700 FILE SECTION. NC2214.2 +003800 FD PRINT-FILE. NC2214.2 +003900 01 PRINT-REC PICTURE X(120). NC2214.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC2214.2 +004100 WORKING-STORAGE SECTION. NC2214.2 +004200 NC2214.2 +004300 01 WS-RIGHT-1-83. NC2214.2 +004400 03 WS-RIGHT-1-20 PIC X(20). NC2214.2 +004500 03 WS-RIGHT-21-40 PIC X(20). NC2214.2 +004600 03 WS-RIGHT-41-60 PIC X(20). NC2214.2 +004700 03 WS-RIGHT-61-80 PIC X(20). NC2214.2 +004800 03 WS-RIGHT-81-83 PIC X(3). NC2214.2 +004900 01 WS-WRONG-1-83. NC2214.2 +005000 03 WS-WRONG-1-20 PIC X(20). NC2214.2 +005100 03 WS-WRONG-21-40 PIC X(20). NC2214.2 +005200 03 WS-WRONG-41-60 PIC X(20). NC2214.2 +005300 03 WS-WRONG-61-80 PIC X(20). NC2214.2 +005400 03 WS-WRONG-81-83 PIC X(3). NC2214.2 +005500 NC2214.2 +005600 01 TABLE1. NC2214.2 +005700 02 TABLE1-REC PICTURE X(83) NC2214.2 +005800 OCCURS 4 TIMES NC2214.2 +005900 INDEXED BY INDEX1. NC2214.2 +006000 01 TABLE2. NC2214.2 +006100 02 WRK-DU-999 PICTURE 999 NC2214.2 +006200 OCCURS 4 TIMES NC2214.2 +006300 INDEXED BY INDEX2. NC2214.2 +006400 01 TABLE3. NC2214.2 +006500 02 TABLE3-SYMBOL PICTURE X NC2214.2 +006600 OCCURS 3 TIMES NC2214.2 +006700 INDEXED BY INDEX3. NC2214.2 +006800 01 TABLE4. NC2214.2 +006900 02 TABLE4-LETTER PICTURE XX NC2214.2 +007000 OCCURS 5 TIMES NC2214.2 +007100 INDEXED BY INDEX4. NC2214.2 +007200 01 WC-XN-83 PIC X(83) VALUE NC2214.2 +007300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +007400- "IDS CAN NOT BE ALL BAD.". NC2214.2 +007500 01 ANS-XN-83-1 PIC X(83) VALUE NC2214.2 +007600 "OH YES AH YES W.C. FROTOES HERE, ANYONE WHO HATES DOGS AND KNC2214.2 +007700- "IDS CAN NOT BE ALL BAD.". NC2214.2 +007800 01 ANS-XN-83-2 PIC X(83) VALUE NC2214.2 +007900 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +008000- "IDS CAN NOT BE ALL BAD.". NC2214.2 +008100 01 ANS-XN-83-3 PIC X(83) VALUE NC2214.2 +008200 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +008300- "IDS CAN NOT BE ALL BAD.". NC2214.2 +008400 01 ANS-XN-83-4 PIC X(83) VALUE NC2214.2 +008500 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +008600- "IDS CAN NOT BE ALL-BAD.". NC2214.2 +008700 01 ANS-XN-83-5 PIC X(83) VALUE NC2214.2 +008800 "EH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +008900- "IDS CAN NOT BE ALL BAD.". NC2214.2 +009000 01 ANS-XN-83-6 PIC X(83) VALUE NC2214.2 +009100 "AH YES OH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +009200- "IDS CAN NOT BE ALL BAD.". NC2214.2 +009300*01 TEST-RESULTS. NC2214.2 +009400* 02 FILLER PIC X VALUE SPACE. NC2214.2 +009500* 02 FEATURE PIC X(20) VALUE SPACE. NC2214.2 +009600* 02 FILLER PIC X VALUE SPACE. NC2214.2 +009700* 02 P-OR-F PIC X(5) VALUE SPACE. NC2214.2 +009800* 02 FILLER PIC X VALUE SPACE. NC2214.2 +009900* 02 PAR-NAME. NC2214.2 +010000* 03 FILLER PIC X(19) VALUE SPACE. NC2214.2 +010100* 03 PARDOT-X PIC X VALUE SPACE. NC2214.2 +010200* 03 DOTVALUE PIC 99 VALUE ZERO. NC2214.2 +010300* 02 FILLER PIC X(8) VALUE SPACE. NC2214.2 +010400* 02 RE-MARK PIC X(61). NC2214.2 +010500 01 TEST-RESULTS. NC2214.2 +010600 02 FILLER PIC X VALUE SPACE. NC2214.2 +010700 02 FEATURE PIC X(20) VALUE SPACE. NC2214.2 +010800 02 FILLER PIC X VALUE SPACE. NC2214.2 +010900 02 P-OR-F PIC X(5) VALUE SPACE. NC2214.2 +011000 02 FILLER PIC X VALUE SPACE. NC2214.2 +011100 02 PAR-NAME. NC2214.2 +011200 03 FILLER PIC X(19) VALUE SPACE. NC2214.2 +011300 03 PARDOT-X PIC X VALUE SPACE. NC2214.2 +011400 03 DOTVALUE PIC 99 VALUE ZERO. NC2214.2 +011500 02 FILLER PIC X(8) VALUE SPACE. NC2214.2 +011600 02 RE-MARK PIC X(61). NC2214.2 +011700 01 TEST-COMPUTED. NC2214.2 +011800 02 FILLER PIC X(30) VALUE SPACE. NC2214.2 +011900 02 FILLER PIC X(17) VALUE NC2214.2 +012000 " COMPUTED=". NC2214.2 +012100 02 COMPUTED-X. NC2214.2 +012200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2214.2 +012300 03 COMPUTED-N REDEFINES COMPUTED-A NC2214.2 +012400 PIC -9(9).9(9). NC2214.2 +012500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2214.2 +012600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2214.2 +012700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2214.2 +012800 03 CM-18V0 REDEFINES COMPUTED-A. NC2214.2 +012900 04 COMPUTED-18V0 PIC -9(18). NC2214.2 +013000 04 FILLER PIC X. NC2214.2 +013100 03 FILLER PIC X(50) VALUE SPACE. NC2214.2 +013200 01 TEST-CORRECT. NC2214.2 +013300 02 FILLER PIC X(30) VALUE SPACE. NC2214.2 +013400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2214.2 +013500 02 CORRECT-X. NC2214.2 +013600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2214.2 +013700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2214.2 +013800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2214.2 +013900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2214.2 +014000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2214.2 +014100 03 CR-18V0 REDEFINES CORRECT-A. NC2214.2 +014200 04 CORRECT-18V0 PIC -9(18). NC2214.2 +014300 04 FILLER PIC X. NC2214.2 +014400 03 FILLER PIC X(2) VALUE SPACE. NC2214.2 +014500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2214.2 +014600 01 CCVS-C-1. NC2214.2 +014700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2214.2 +014800- "SS PARAGRAPH-NAME NC2214.2 +014900- " REMARKS". NC2214.2 +015000 02 FILLER PIC X(20) VALUE SPACE. NC2214.2 +015100 01 CCVS-C-2. NC2214.2 +015200 02 FILLER PIC X VALUE SPACE. NC2214.2 +015300 02 FILLER PIC X(6) VALUE "TESTED". NC2214.2 +015400 02 FILLER PIC X(15) VALUE SPACE. NC2214.2 +015500 02 FILLER PIC X(4) VALUE "FAIL". NC2214.2 +015600 02 FILLER PIC X(94) VALUE SPACE. NC2214.2 +015700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2214.2 +015800 01 REC-CT PIC 99 VALUE ZERO. NC2214.2 +015900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2214.2 +016000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2214.2 +016100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2214.2 +016200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2214.2 +016300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2214.2 +016400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2214.2 +016500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2214.2 +016600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2214.2 +016700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2214.2 +016800 01 CCVS-H-1. NC2214.2 +016900 02 FILLER PIC X(39) VALUE SPACES. NC2214.2 +017000 02 FILLER PIC X(42) VALUE NC2214.2 +017100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2214.2 +017200 02 FILLER PIC X(39) VALUE SPACES. NC2214.2 +017300 01 CCVS-H-2A. NC2214.2 +017400 02 FILLER PIC X(40) VALUE SPACE. NC2214.2 +017500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2214.2 +017600 02 FILLER PIC XXXX VALUE NC2214.2 +017700 "4.2 ". NC2214.2 +017800 02 FILLER PIC X(28) VALUE NC2214.2 +017900 " COPY - NOT FOR DISTRIBUTION". NC2214.2 +018000 02 FILLER PIC X(41) VALUE SPACE. NC2214.2 +018100 NC2214.2 +018200 01 CCVS-H-2B. NC2214.2 +018300 02 FILLER PIC X(15) VALUE NC2214.2 +018400 "TEST RESULT OF ". NC2214.2 +018500 02 TEST-ID PIC X(9). NC2214.2 +018600 02 FILLER PIC X(4) VALUE NC2214.2 +018700 " IN ". NC2214.2 +018800 02 FILLER PIC X(12) VALUE NC2214.2 +018900 " HIGH ". NC2214.2 +019000 02 FILLER PIC X(22) VALUE NC2214.2 +019100 " LEVEL VALIDATION FOR ". NC2214.2 +019200 02 FILLER PIC X(58) VALUE NC2214.2 +019300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2214.2 +019400 01 CCVS-H-3. NC2214.2 +019500 02 FILLER PIC X(34) VALUE NC2214.2 +019600 " FOR OFFICIAL USE ONLY ". NC2214.2 +019700 02 FILLER PIC X(58) VALUE NC2214.2 +019800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2214.2 +019900 02 FILLER PIC X(28) VALUE NC2214.2 +020000 " COPYRIGHT 1985 ". NC2214.2 +020100 01 CCVS-E-1. NC2214.2 +020200 02 FILLER PIC X(52) VALUE SPACE. NC2214.2 +020300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2214.2 +020400 02 ID-AGAIN PIC X(9). NC2214.2 +020500 02 FILLER PIC X(45) VALUE SPACES. NC2214.2 +020600 01 CCVS-E-2. NC2214.2 +020700 02 FILLER PIC X(31) VALUE SPACE. NC2214.2 +020800 02 FILLER PIC X(21) VALUE SPACE. NC2214.2 +020900 02 CCVS-E-2-2. NC2214.2 +021000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2214.2 +021100 03 FILLER PIC X VALUE SPACE. NC2214.2 +021200 03 ENDER-DESC PIC X(44) VALUE NC2214.2 +021300 "ERRORS ENCOUNTERED". NC2214.2 +021400 01 CCVS-E-3. NC2214.2 +021500 02 FILLER PIC X(22) VALUE NC2214.2 +021600 " FOR OFFICIAL USE ONLY". NC2214.2 +021700 02 FILLER PIC X(12) VALUE SPACE. NC2214.2 +021800 02 FILLER PIC X(58) VALUE NC2214.2 +021900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2214.2 +022000 02 FILLER PIC X(13) VALUE SPACE. NC2214.2 +022100 02 FILLER PIC X(15) VALUE NC2214.2 +022200 " COPYRIGHT 1985". NC2214.2 +022300 01 CCVS-E-4. NC2214.2 +022400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2214.2 +022500 02 FILLER PIC X(4) VALUE " OF ". NC2214.2 +022600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2214.2 +022700 02 FILLER PIC X(40) VALUE NC2214.2 +022800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2214.2 +022900 01 XXINFO. NC2214.2 +023000 02 FILLER PIC X(19) VALUE NC2214.2 +023100 "*** INFORMATION ***". NC2214.2 +023200 02 INFO-TEXT. NC2214.2 +023300 04 FILLER PIC X(8) VALUE SPACE. NC2214.2 +023400 04 XXCOMPUTED PIC X(20). NC2214.2 +023500 04 FILLER PIC X(5) VALUE SPACE. NC2214.2 +023600 04 XXCORRECT PIC X(20). NC2214.2 +023700 02 INF-ANSI-REFERENCE PIC X(48). NC2214.2 +023800 01 HYPHEN-LINE. NC2214.2 +023900 02 FILLER PIC IS X VALUE IS SPACE. NC2214.2 +024000 02 FILLER PIC IS X(65) VALUE IS "************************NC2214.2 +024100- "*****************************************". NC2214.2 +024200 02 FILLER PIC IS X(54) VALUE IS "************************NC2214.2 +024300- "******************************". NC2214.2 +024400 01 CCVS-PGM-ID PIC X(9) VALUE NC2214.2 +024500 "NC221A". NC2214.2 +024600 PROCEDURE DIVISION. NC2214.2 +024700 CCVS1 SECTION. NC2214.2 +024800 OPEN-FILES. NC2214.2 +024900 OPEN OUTPUT PRINT-FILE. NC2214.2 +025000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2214.2 +025100 MOVE SPACE TO TEST-RESULTS. NC2214.2 +025200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2214.2 +025300 GO TO CCVS1-EXIT. NC2214.2 +025400 CLOSE-FILES. NC2214.2 +025500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2214.2 +025600 TERMINATE-CCVS. NC2214.2 +025700*S EXIT PROGRAM. NC2214.2 +025800*SERMINATE-CALL. NC2214.2 +025900 STOP RUN. NC2214.2 +026000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2214.2 +026100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2214.2 +026200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2214.2 +026300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2214.2 +026400 MOVE "****TEST DELETED****" TO RE-MARK. NC2214.2 +026500 PRINT-DETAIL. NC2214.2 +026600 IF REC-CT NOT EQUAL TO ZERO NC2214.2 +026700 MOVE "." TO PARDOT-X NC2214.2 +026800 MOVE REC-CT TO DOTVALUE. NC2214.2 +026900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2214.2 +027000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2214.2 +027100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2214.2 +027200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2214.2 +027300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2214.2 +027400 MOVE SPACE TO CORRECT-X. NC2214.2 +027500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2214.2 +027600 MOVE SPACE TO RE-MARK. NC2214.2 +027700 HEAD-ROUTINE. NC2214.2 +027800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +027900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +028000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2214.2 +028100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2214.2 +028200 COLUMN-NAMES-ROUTINE. NC2214.2 +028300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +028400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +028600 END-ROUTINE. NC2214.2 +028700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2214.2 +028800 END-RTN-EXIT. NC2214.2 +028900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +029000 END-ROUTINE-1. NC2214.2 +029100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2214.2 +029200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2214.2 +029300 ADD PASS-COUNTER TO ERROR-HOLD. NC2214.2 +029400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2214.2 +029500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2214.2 +029600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2214.2 +029700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2214.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2214.2 +029900 END-ROUTINE-12. NC2214.2 +030000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2214.2 +030100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2214.2 +030200 MOVE "NO " TO ERROR-TOTAL NC2214.2 +030300 ELSE NC2214.2 +030400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2214.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2214.2 +030600 PERFORM WRITE-LINE. NC2214.2 +030700 END-ROUTINE-13. NC2214.2 +030800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2214.2 +030900 MOVE "NO " TO ERROR-TOTAL ELSE NC2214.2 +031000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2214.2 +031100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2214.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +031300 IF INSPECT-COUNTER EQUAL TO ZERO NC2214.2 +031400 MOVE "NO " TO ERROR-TOTAL NC2214.2 +031500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2214.2 +031600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2214.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +031800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2214.2 +031900 WRITE-LINE. NC2214.2 +032000 ADD 1 TO RECORD-COUNT. NC2214.2 +032100 IF RECORD-COUNT GREATER 50 NC2214.2 +032200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2214.2 +032300 MOVE SPACE TO DUMMY-RECORD NC2214.2 +032400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2214.2 +032500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2214.2 +032600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2214.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2214.2 +032800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2214.2 +032900 MOVE ZERO TO RECORD-COUNT. NC2214.2 +033000 PERFORM WRT-LN. NC2214.2 +033100 WRT-LN. NC2214.2 +033200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2214.2 +033300 MOVE SPACE TO DUMMY-RECORD. NC2214.2 +033400 BLANK-LINE-PRINT. NC2214.2 +033500 PERFORM WRT-LN. NC2214.2 +033600 FAIL-ROUTINE. NC2214.2 +033700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2214.2 +033800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2214.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2214.2 +034000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2214.2 +034100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +034200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2214.2 +034300 GO TO FAIL-ROUTINE-EX. NC2214.2 +034400 FAIL-ROUTINE-WRITE. NC2214.2 +034500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2214.2 +034600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2214.2 +034700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2214.2 +034800 MOVE SPACES TO COR-ANSI-REFERENCE. NC2214.2 +034900 FAIL-ROUTINE-EX. EXIT. NC2214.2 +035000 BAIL-OUT. NC2214.2 +035100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2214.2 +035200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2214.2 +035300 BAIL-OUT-WRITE. NC2214.2 +035400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2214.2 +035500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2214.2 +035600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2214.2 +035700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2214.2 +035800 BAIL-OUT-EX. EXIT. NC2214.2 +035900 CCVS1-EXIT. NC2214.2 +036000 EXIT. NC2214.2 +036100 INIT-TABLE1. NC2214.2 +036200 MOVE NC2214.2 +036300 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +036400- "IDS CAN NOT BE ALL BAD." NC2214.2 +036500 TO WC-XN-83. NC2214.2 +036600 MOVE WC-XN-83 TO TABLE1-REC (1). NC2214.2 +036700 MOVE WC-XN-83 TO TABLE1-REC (2). NC2214.2 +036800 MOVE WC-XN-83 TO TABLE1-REC (3). NC2214.2 +036900 MOVE WC-XN-83 TO TABLE1-REC (4). NC2214.2 +037000 INIT-TABLE3. NC2214.2 +037100 MOVE " " TO TABLE3-SYMBOL (1). NC2214.2 +037200 MOVE "," TO TABLE3-SYMBOL (2). NC2214.2 +037300 MOVE "-" TO TABLE3-SYMBOL (3). NC2214.2 +037400 INIT-TABLE4. NC2214.2 +037500 MOVE "AH" TO TABLE4-LETTER (1). NC2214.2 +037600 MOVE "OH" TO TABLE4-LETTER (2). NC2214.2 +037700 MOVE "HE" TO TABLE4-LETTER (3). NC2214.2 +037800 MOVE "LL" TO TABLE4-LETTER (4). NC2214.2 +037900 MOVE "H " TO TABLE4-LETTER (5). NC2214.2 +038000* NC2214.2 +038100 INS-INIT-F1-1. NC2214.2 +038200 MOVE "INS-TEST-F1-1" TO PAR-NAME. NC2214.2 +038300 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +038400 MOVE "TALLY FOR LEADING" TO FEATURE. NC2214.2 +038500 MOVE ZEROS TO TABLE2. NC2214.2 +038600 SET INDEX1 TO 1. NC2214.2 +038700 SET INDEX2 TO 1. NC2214.2 +038800 INS-TEST-F1-1. NC2214.2 +038900 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +039000 FOR LEADING "AH" NC2214.2 +039100 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC2214.2 +039200 PERFORM PASS NC2214.2 +039300 GO TO INS-WRITE-F1-1. NC2214.2 +039400 GO TO INS-FAIL-F1-1. NC2214.2 +039500 INS-DELETE-F1-1. NC2214.2 +039600 PERFORM DE-LETE. NC2214.2 +039700 GO TO INS-WRITE-F1-1. NC2214.2 +039800 INS-FAIL-F1-1. NC2214.2 +039900 PERFORM FAIL. NC2214.2 +040000 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N. NC2214.2 +040100 MOVE 1 TO CORRECT-N. NC2214.2 +040200 INS-WRITE-F1-1. NC2214.2 +040300 PERFORM PRINT-DETAIL. NC2214.2 +040400* NC2214.2 +040500 INS-INIT-F1-2. NC2214.2 +040600 MOVE "INS-TEST-F1-2" TO PAR-NAME. NC2214.2 +040700 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +040800 MOVE "TALLY FOR CHAR AFTER" TO FEATURE. NC2214.2 +040900 MOVE ZEROS TO TABLE2. NC2214.2 +041000 SET INDEX1 TO 2. NC2214.2 +041100 SET INDEX2 TO 2. NC2214.2 +041200 INS-TEST-F1-2. NC2214.2 +041300 INSPECT TABLE1-REC (INDEX1 + 1) NC2214.2 +041400 TALLYING WRK-DU-999 (INDEX2 + 1) NC2214.2 +041500 FOR CHARACTERS AFTER " W". NC2214.2 +041600 IF WRK-DU-999 (INDEX2 + 1) EQUAL TO 68 NC2214.2 +041700 PERFORM PASS NC2214.2 +041800 GO TO INS-WRITE-F1-2. NC2214.2 +041900 GO TO INS-FAIL-F1-2. NC2214.2 +042000 INS-DELETE-F1-2. NC2214.2 +042100 PERFORM DE-LETE. NC2214.2 +042200 GO TO INS-WRITE-F1-2. NC2214.2 +042300 INS-FAIL-F1-2. NC2214.2 +042400 PERFORM FAIL. NC2214.2 +042500 MOVE WRK-DU-999 (INDEX2 + 1) TO COMPUTED-N. NC2214.2 +042600 MOVE 68 TO CORRECT-N. NC2214.2 +042700 INS-WRITE-F1-2. NC2214.2 +042800 PERFORM PRINT-DETAIL. NC2214.2 +042900* NC2214.2 +043000 INS-INIT-F1-3. NC2214.2 +043100 MOVE "INS-TEST-F1-3" TO PAR-NAME. NC2214.2 +043200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +043300 MOVE "TALLY FOR ALL BEFORE" TO FEATURE. NC2214.2 +043400 MOVE ZEROS TO TABLE2. NC2214.2 +043500 SET INDEX1 TO 3. NC2214.2 +043600 SET INDEX2 TO 3. NC2214.2 +043700 INS-TEST-F1-3. NC2214.2 +043800 INSPECT TABLE1-REC (INDEX1 - 1) NC2214.2 +043900 TALLYING WRK-DU-999 (INDEX2 - 2) NC2214.2 +044000 FOR ALL " " BEFORE INITIAL "W.C.". NC2214.2 +044100 IF WRK-DU-999 (INDEX2 - 2) EQUAL TO 4 NC2214.2 +044200 PERFORM PASS NC2214.2 +044300 GO TO INS-WRITE-F1-3. NC2214.2 +044400 GO TO INS-FAIL-F1-3. NC2214.2 +044500 INS-DELETE-F1-3. NC2214.2 +044600 PERFORM DE-LETE. NC2214.2 +044700 GO TO INS-WRITE-F1-3. NC2214.2 +044800 INS-FAIL-F1-3. NC2214.2 +044900 PERFORM FAIL. NC2214.2 +045000 MOVE WRK-DU-999 (INDEX2 - 2) TO COMPUTED-N. NC2214.2 +045100 MOVE 4 TO CORRECT-N. NC2214.2 +045200 INS-WRITE-F1-3. NC2214.2 +045300 PERFORM PRINT-DETAIL. NC2214.2 +045400* NC2214.2 +045500 INS-INIT-F2-4. NC2214.2 +045600 MOVE "INS-TEST-F2-4" TO PAR-NAME. NC2214.2 +045700 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +045800 MOVE "REPLACE BEFORE FIRST" TO FEATURE. NC2214.2 +045900 SET INDEX1 TO 4. NC2214.2 +046000 SET INDEX4 TO 1. NC2214.2 +046100 INS-TEST-F2-4. NC2214.2 +046200 INSPECT TABLE1-REC (INDEX1) REPLACING LEADING NC2214.2 +046300 TABLE4-LETTER (INDEX4) BY TABLE4-LETTER (INDEX4 + 1) NC2214.2 +046400 BEFORE INITIAL " AH YES" FIRST "I" BY "O" NC2214.2 +046500 AFTER INITIAL "." ALL ". " BY ", " AFTER INITIAL NC2214.2 +046600 TABLE4-LETTER (INDEX4 + 2). NC2214.2 +046700 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-1 NC2214.2 +046800 PERFORM PASS NC2214.2 +046900 GO TO INS-WRITE-F2-4. NC2214.2 +047000 GO TO INS-FAIL-F2-4. NC2214.2 +047100 INS-DELETE-F2-4. NC2214.2 +047200 PERFORM DE-LETE. NC2214.2 +047300 GO TO INS-WRITE-F2-4. NC2214.2 +047400 INS-FAIL-F2-4. NC2214.2 +047500 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83. NC2214.2 +047600 MOVE ANS-XN-83-1 TO WS-RIGHT-1-83. NC2214.2 +047700 PERFORM FAIL. NC2214.2 +047800 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2214.2 +047900 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2214.2 +048000 PERFORM PRINT-DETAIL. NC2214.2 +048100 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2214.2 +048200 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2214.2 +048300 PERFORM PRINT-DETAIL. NC2214.2 +048400 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2214.2 +048500 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2214.2 +048600 PERFORM PRINT-DETAIL. NC2214.2 +048700 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2214.2 +048800 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2214.2 +048900 PERFORM PRINT-DETAIL. NC2214.2 +049000 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2214.2 +049100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +049200 PERFORM PRINT-DETAIL. NC2214.2 +049300 INS-WRITE-F2-4. NC2214.2 +049400 PERFORM PRINT-DETAIL. NC2214.2 +049500* NC2214.2 +049600 INS-INIT-F2-5. NC2214.2 +049700 MOVE "INS-TEST-F2-5" TO PAR-NAME. NC2214.2 +049800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +049900 MOVE "REPLACE LEAD AFTER" TO FEATURE NC2214.2 +050000 PERFORM INIT-TABLE1. NC2214.2 +050100 MOVE NC2214.2 +050200 "AH YES,AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +050300- "IDS CAN NOT BE ALL BAD." NC2214.2 +050400 TO ANS-XN-83-2. NC2214.2 +050500 SET INDEX1 TO 1. NC2214.2 +050600 SET INDEX3 TO 1. NC2214.2 +050700 INS-TEST-F2-5. NC2214.2 +050800 INSPECT TABLE1-REC (INDEX1) REPLACING LEADING NC2214.2 +050900 TABLE3-SYMBOL (INDEX3) BY TABLE3-SYMBOL (INDEX3 + 1) NC2214.2 +051000 AFTER INITIAL "YES". NC2214.2 +051100 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-2 NC2214.2 +051200 PERFORM PASS NC2214.2 +051300 GO TO INS-WRITE-F2-5. NC2214.2 +051400 GO TO INS-FAIL-F2-5. NC2214.2 +051500 INS-DELETE-F2-5. NC2214.2 +051600 PERFORM DE-LETE. NC2214.2 +051700 GO TO INS-WRITE-F2-5. NC2214.2 +051800 INS-FAIL-F2-5. NC2214.2 +051900 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83. NC2214.2 +052000 MOVE ANS-XN-83-2 TO WS-RIGHT-1-83. NC2214.2 +052100 PERFORM FAIL. NC2214.2 +052200 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2214.2 +052300 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2214.2 +052400 PERFORM PRINT-DETAIL. NC2214.2 +052500 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2214.2 +052600 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2214.2 +052700 PERFORM PRINT-DETAIL. NC2214.2 +052800 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2214.2 +052900 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2214.2 +053000 PERFORM PRINT-DETAIL. NC2214.2 +053100 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2214.2 +053200 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2214.2 +053300 PERFORM PRINT-DETAIL. NC2214.2 +053400 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2214.2 +053500 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +053600 PERFORM PRINT-DETAIL. NC2214.2 +053700 INS-WRITE-F2-5. NC2214.2 +053800 PERFORM PRINT-DETAIL. NC2214.2 +053900* NC2214.2 +054000 INS-INIT-F2-6. NC2214.2 +054100 MOVE "INS-TEST-F2-6" TO PAR-NAME. NC2214.2 +054200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +054300 MOVE "REPLACE FIRST BEFORE" TO FEATURE. NC2214.2 +054400 PERFORM INIT-TABLE1. NC2214.2 +054500 SET INDEX1 TO 3. NC2214.2 +054600 MOVE NC2214.2 +054700 "OH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +054800- "IDS CAN NOT BE ALL BAD." NC2214.2 +054900 TO ANS-XN-83-3. NC2214.2 +055000 INS-TEST-F2-6. NC2214.2 +055100 INSPECT TABLE1-REC (INDEX1 - 1) REPLACING FIRST "A" BY "O" NC2214.2 +055200 BEFORE INITIAL "H YES". NC2214.2 +055300 IF TABLE1-REC (INDEX1 - 1) EQUAL TO ANS-XN-83-3 NC2214.2 +055400 PERFORM PASS NC2214.2 +055500 GO TO INS-WRITE-F2-6. NC2214.2 +055600 GO TO INS-FAIL-F2-6. NC2214.2 +055700 INS-DELETE-F2-6. NC2214.2 +055800 PERFORM DE-LETE. NC2214.2 +055900 GO TO INS-WRITE-F2-6. NC2214.2 +056000 INS-FAIL-F2-6. NC2214.2 +056100 MOVE TABLE1-REC (INDEX1 - 1) TO WS-WRONG-1-83. NC2214.2 +056200 MOVE ANS-XN-83-3 TO WS-RIGHT-1-83. NC2214.2 +056300 PERFORM FAIL. NC2214.2 +056400 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2214.2 +056500 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2214.2 +056600 PERFORM PRINT-DETAIL. NC2214.2 +056700 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2214.2 +056800 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2214.2 +056900 PERFORM PRINT-DETAIL. NC2214.2 +057000 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2214.2 +057100 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2214.2 +057200 PERFORM PRINT-DETAIL. NC2214.2 +057300 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2214.2 +057400 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2214.2 +057500 PERFORM PRINT-DETAIL. NC2214.2 +057600 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2214.2 +057700 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +057800 PERFORM PRINT-DETAIL. NC2214.2 +057900 INS-WRITE-F2-6. NC2214.2 +058000 PERFORM PRINT-DETAIL. NC2214.2 +058100* NC2214.2 +058200 INS-INIT-F2-7. NC2214.2 +058300 MOVE "INS-TEST-F2-7" TO PAR-NAME. NC2214.2 +058400 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +058500 MOVE "REPLACE ALL AFTER" TO FEATURE. NC2214.2 +058600 PERFORM INIT-TABLE1. NC2214.2 +058700 PERFORM INIT-TABLE4. NC2214.2 +058800 MOVE NC2214.2 +058900 "AH YES AH YES W.C. FRITOES HERE. ANYONE WHO HATES DOGS AND KNC2214.2 +059000- "IDS CAN NOT BE ALL-BAD." NC2214.2 +059100 TO ANS-XN-83-4. NC2214.2 +059200 SET INDEX1 TO 1. NC2214.2 +059300 SET INDEX4 TO 4. NC2214.2 +059400 INS-TEST-F2-7. NC2214.2 +059500 INSPECT TABLE1-REC (INDEX1 + 1) REPLACING ALL SPACES BY "-" NC2214.2 +059600 AFTER TABLE4-LETTER (INDEX4). NC2214.2 +059700 IF TABLE1-REC (INDEX1 + 1) EQUAL TO ANS-XN-83-4 NC2214.2 +059800 PERFORM PASS NC2214.2 +059900 GO TO INS-WRITE-F2-7. NC2214.2 +060000 GO TO INS-FAIL-F2-7. NC2214.2 +060100 INS-DELETE-F2-7. NC2214.2 +060200 PERFORM DE-LETE. NC2214.2 +060300 GO TO INS-WRITE-F2-7. NC2214.2 +060400 INS-FAIL-F2-7. NC2214.2 +060500 MOVE TABLE1-REC (INDEX1 + 1) TO WS-WRONG-1-83. NC2214.2 +060600 MOVE ANS-XN-83-4 TO WS-RIGHT-1-83. NC2214.2 +060700 PERFORM FAIL. NC2214.2 +060800 MOVE WS-RIGHT-1-20 TO CORRECT-A. NC2214.2 +060900 MOVE WS-WRONG-1-20 TO COMPUTED-A. NC2214.2 +061000 PERFORM PRINT-DETAIL. NC2214.2 +061100 MOVE WS-RIGHT-21-40 TO CORRECT-A. NC2214.2 +061200 MOVE WS-WRONG-21-40 TO COMPUTED-A. NC2214.2 +061300 PERFORM PRINT-DETAIL. NC2214.2 +061400 MOVE WS-RIGHT-41-60 TO CORRECT-A. NC2214.2 +061500 MOVE WS-WRONG-41-60 TO COMPUTED-A. NC2214.2 +061600 PERFORM PRINT-DETAIL. NC2214.2 +061700 MOVE WS-RIGHT-61-80 TO CORRECT-A. NC2214.2 +061800 MOVE WS-WRONG-61-80 TO COMPUTED-A. NC2214.2 +061900 PERFORM PRINT-DETAIL. NC2214.2 +062000 MOVE WS-RIGHT-81-83 TO CORRECT-A. NC2214.2 +062100 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +062200 PERFORM PRINT-DETAIL. NC2214.2 +062300 INS-WRITE-F2-7. NC2214.2 +062400 PERFORM PRINT-DETAIL. NC2214.2 +062500* NC2214.2 +062600 INS-INIT-F3-8. NC2214.2 +062700 MOVE "INS-TEST-F3-8" TO PAR-NAME. NC2214.2 +062800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +062900 MOVE "TALLY REPLACE CHARS" TO FEATURE. NC2214.2 +063000 MOVE 1 TO REC-CT. NC2214.2 +063100 PERFORM INIT-TABLE1. NC2214.2 +063200 PERFORM INIT-TABLE4. NC2214.2 +063300 MOVE ZEROS TO TABLE2. NC2214.2 +063400 SET INDEX1 TO 4. NC2214.2 +063500 SET INDEX2 TO 1. NC2214.2 +063600 SET INDEX4 TO 5. NC2214.2 +063700 INS-TEST-F3-8-0. NC2214.2 +063800 INSPECT TABLE1-REC (INDEX1 - 2) NC2214.2 +063900 TALLYING WRK-DU-999 (INDEX2 + 2) FOR CHARACTERS NC2214.2 +064000 AFTER "L" REPLACING ALL "A" BY "E" NC2214.2 +064100 BEFORE INITIAL TABLE4-LETTER (INDEX4). NC2214.2 +064200 GO TO INS-TEST-F3-8-1. NC2214.2 +064300 INS-DELETE-F3-8. NC2214.2 +064400 PERFORM DE-LETE. NC2214.2 +064500 PERFORM PRINT-DETAIL. NC2214.2 +064600 GO TO INS-INIT-F3-9. NC2214.2 +064700 INS-TEST-F3-8-1. NC2214.2 +064800 IF WRK-DU-999 (INDEX2 + 2) EQUAL TO 6 NC2214.2 +064900 PERFORM PASS NC2214.2 +065000 GO TO INS-WRITE-F3-8-1 NC2214.2 +065100 ELSE GO TO INS-FAIL-F3-8-1. NC2214.2 +065200 INS-DELETE-F3-8-1. NC2214.2 +065300 PERFORM DE-LETE. NC2214.2 +065400 GO TO INS-WRITE-F3-8-1. NC2214.2 +065500 INS-FAIL-F3-8-1. NC2214.2 +065600 MOVE WRK-DU-999 (INDEX2 + 2) TO COMPUTED-N NC2214.2 +065700 MOVE 6 TO CORRECT-N . NC2214.2 +065800 PERFORM FAIL. NC2214.2 +065900 INS-WRITE-F3-8-1. NC2214.2 +066000 PERFORM PRINT-DETAIL. NC2214.2 +066100* NC2214.2 +066200 INS-TEST-F3-8-2. NC2214.2 +066300 ADD 1 TO REC-CT. NC2214.2 +066400 IF TABLE1-REC (INDEX1 - 2) EQUAL TO ANS-XN-83-5 NC2214.2 +066500 PERFORM PASS NC2214.2 +066600 GO TO INS-WRITE-F3-8-2 NC2214.2 +066700 ELSE NC2214.2 +066800 GO TO INS-FAIL-F3-8-2. NC2214.2 +066900 INS-DELETE-F3-8-2. NC2214.2 +067000 PERFORM DE-LETE. NC2214.2 +067100 GO TO INS-WRITE-F3-8-2. NC2214.2 +067200 INS-FAIL-F3-8-2. NC2214.2 +067300 MOVE TABLE1-REC (INDEX1 - 2) TO WS-WRONG-1-83 NC2214.2 +067400 MOVE ANS-XN-83-5 TO WS-RIGHT-1-83 NC2214.2 +067500 PERFORM FAIL NC2214.2 +067600 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +067700 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +067800 PERFORM PRINT-DETAIL NC2214.2 +067900 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +068000 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +068100 PERFORM PRINT-DETAIL NC2214.2 +068200 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +068300 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +068400 PERFORM PRINT-DETAIL NC2214.2 +068500 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +068600 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +068700 PERFORM PRINT-DETAIL NC2214.2 +068800 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +068900 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +069000 INS-WRITE-F3-8-2. NC2214.2 +069100 PERFORM PRINT-DETAIL. NC2214.2 +069200* NC2214.2 +069300 INS-INIT-F3-9. NC2214.2 +069400 MOVE "INS-TEST-F3-9" TO PAR-NAME. NC2214.2 +069500 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +069600 MOVE "TALLY BEFORE REPLACE" TO FEATURE. NC2214.2 +069700 MOVE 1 TO REC-CT. NC2214.2 +069800 PERFORM INIT-TABLE1. NC2214.2 +069900 MOVE ZEROS TO TABLE2. NC2214.2 +070000 PERFORM INIT-TABLE4. NC2214.2 +070100 SET INDEX1 TO 4. NC2214.2 +070200 SET INDEX2 TO 2. NC2214.2 +070300 SET INDEX4 TO 1. NC2214.2 +070400 INS-TEST-F3-9-0. NC2214.2 +070500 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +070600 FOR ALL "A" BEFORE "L" REPLACING FIRST NC2214.2 +070700 TABLE4-LETTER (INDEX4) BY TABLE4-LETTER (INDEX4 + 1) NC2214.2 +070800 AFTER INITIAL "H". NC2214.2 +070900 GO TO INS-TEST-F3-9-1. NC2214.2 +071000 INS-DELETE-F3-9. NC2214.2 +071100 PERFORM DE-LETE. NC2214.2 +071200 PERFORM PRINT-DETAIL. NC2214.2 +071300 GO TO INS-INIT-F3-10. NC2214.2 +071400 INS-TEST-F3-9-1. NC2214.2 +071500 IF WRK-DU-999 (INDEX2) EQUAL TO 7 NC2214.2 +071600 PERFORM PASS NC2214.2 +071700 GO TO INS-WRITE-F3-9-1 NC2214.2 +071800 ELSE GO TO INS-FAIL-F3-9-1. NC2214.2 +071900 INS-DELETE-F3-9-1. NC2214.2 +072000 PERFORM DE-LETE. NC2214.2 +072100 GO TO INS-WRITE-F3-9-1. NC2214.2 +072200 INS-FAIL-F3-9-1. NC2214.2 +072300 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC2214.2 +072400 MOVE 7 TO CORRECT-N NC2214.2 +072500 PERFORM FAIL. NC2214.2 +072600 INS-WRITE-F3-9-1. NC2214.2 +072700 PERFORM PRINT-DETAIL. NC2214.2 +072800* NC2214.2 +072900 INS-TEST-F3-9-2. NC2214.2 +073000 ADD 1 TO REC-CT. NC2214.2 +073100 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-6 NC2214.2 +073200 PERFORM PASS NC2214.2 +073300 GO TO INS-WRITE-F3-9-2 NC2214.2 +073400 ELSE NC2214.2 +073500 GO TO INS-FAIL-F3-9-2. NC2214.2 +073600 INS-DELETE-F3-9-2. NC2214.2 +073700 PERFORM DE-LETE. NC2214.2 +073800 GO TO INS-WRITE-F3-9-2. NC2214.2 +073900 INS-FAIL-F3-9-2. NC2214.2 +074000 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83 NC2214.2 +074100 MOVE ANS-XN-83-6 TO WS-RIGHT-1-83 NC2214.2 +074200 PERFORM FAIL NC2214.2 +074300 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +074400 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +074500 PERFORM PRINT-DETAIL NC2214.2 +074600 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +074700 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +074800 PERFORM PRINT-DETAIL NC2214.2 +074900 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +075000 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +075100 PERFORM PRINT-DETAIL NC2214.2 +075200 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +075300 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +075400 PERFORM PRINT-DETAIL NC2214.2 +075500 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +075600 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +075700 INS-WRITE-F3-9-2. NC2214.2 +075800 PERFORM PRINT-DETAIL. NC2214.2 +075900* NC2214.2 +076000 INS-INIT-F3-10. NC2214.2 +076100 MOVE "INS-TEST-F3-10" TO PAR-NAME. NC2214.2 +076200 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +076300 MOVE "TALLY LEAD REPL LEAD" TO FEATURE. NC2214.2 +076400 MOVE 1 TO REC-CT. NC2214.2 +076500 PERFORM INIT-TABLE1. NC2214.2 +076600 MOVE ZEROS TO TABLE2. NC2214.2 +076700 PERFORM INIT-TABLE4. NC2214.2 +076800 SET INDEX1 TO 1. NC2214.2 +076900 SET INDEX2 TO 1. NC2214.2 +077000 SET INDEX4 TO 1. NC2214.2 +077100 INS-TEST-F3-10-0. NC2214.2 +077200 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +077300 FOR LEADING TABLE4-LETTER (INDEX4) REPLACING NC2214.2 +077400 LEADING TABLE4-LETTER (INDEX4) BY "OH". NC2214.2 +077500 GO TO INS-TEST-F3-10-1. NC2214.2 +077600 INS-DELETE-F3-10. NC2214.2 +077700 PERFORM DE-LETE. NC2214.2 +077800 PERFORM PRINT-DETAIL. NC2214.2 +077900 GO TO INS-INIT-F3-11. NC2214.2 +078000 INS-TEST-F3-10-1. NC2214.2 +078100 IF WRK-DU-999 (INDEX2) EQUAL TO 1 NC2214.2 +078200 PERFORM PASS NC2214.2 +078300 GO TO INS-WRITE-F3-10-1 NC2214.2 +078400 ELSE NC2214.2 +078500 GO TO INS-FAIL-F3-10-1. NC2214.2 +078600 INS-DELETE-F3-10-1. NC2214.2 +078700 PERFORM DE-LETE. NC2214.2 +078800 GO TO INS-WRITE-F3-10-1. NC2214.2 +078900 INS-FAIL-F3-10-1. NC2214.2 +079000 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC2214.2 +079100 MOVE 1 TO CORRECT-N NC2214.2 +079200 PERFORM FAIL. NC2214.2 +079300 INS-WRITE-F3-10-1. NC2214.2 +079400 PERFORM PRINT-DETAIL. NC2214.2 +079500* NC2214.2 +079600 INS-TEST-F3-10-2. NC2214.2 +079700 ADD 1 TO REC-CT. NC2214.2 +079800 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-3 NC2214.2 +079900 PERFORM PASS NC2214.2 +080000 GO TO INS-WRITE-F3-10-2 NC2214.2 +080100 ELSE NC2214.2 +080200 GO TO INS-FAIL-F3-10-2. NC2214.2 +080300 INS-DELETE-F3-10-2. NC2214.2 +080400 PERFORM DE-LETE. NC2214.2 +080500 GO TO INS-WRITE-F3-10-2. NC2214.2 +080600 INS-FAIL-F3-10-2. NC2214.2 +080700 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83 NC2214.2 +080800 MOVE ANS-XN-83-3 TO WS-RIGHT-1-83 NC2214.2 +080900 PERFORM FAIL NC2214.2 +081000 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +081100 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +081200 PERFORM PRINT-DETAIL NC2214.2 +081300 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +081400 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +081500 PERFORM PRINT-DETAIL NC2214.2 +081600 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +081700 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +081800 PERFORM PRINT-DETAIL NC2214.2 +081900 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +082000 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +082100 PERFORM PRINT-DETAIL NC2214.2 +082200 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +082300 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +082400 INS-WRITE-F3-10-2. NC2214.2 +082500 PERFORM PRINT-DETAIL. NC2214.2 +082600* NC2214.2 +082700 INS-INIT-F3-11. NC2214.2 +082800 MOVE "INS-TEST-F3-11" TO PAR-NAME. NC2214.2 +082900 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +083000 MOVE "TALLY REPL FIRST AFT" TO FEATURE. NC2214.2 +083100 MOVE 1 TO REC-CT. NC2214.2 +083200 PERFORM INIT-TABLE1. NC2214.2 +083300 MOVE ZEROS TO TABLE2. NC2214.2 +083400 SET INDEX1 TO 2. NC2214.2 +083500 SET INDEX2 TO 2. NC2214.2 +083600 INS-TEST-F3-11-0. NC2214.2 +083700 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +083800 FOR ALL "A" REPLACING FIRST "AH" BY "OH" AFTER NC2214.2 +083900 INITIAL "YES". NC2214.2 +084000 GO TO INS-TEST-F3-11-1. NC2214.2 +084100 INS-DELETE-F3-11. NC2214.2 +084200 PERFORM DE-LETE. NC2214.2 +084300 PERFORM PRINT-DETAIL. NC2214.2 +084400 GO TO INS-INIT-F3-12. NC2214.2 +084500 INS-TEST-F3-11-1. NC2214.2 +084600 IF WRK-DU-999 (INDEX2) EQUAL TO 8 NC2214.2 +084700 PERFORM PASS NC2214.2 +084800 GO TO INS-WRITE-F3-11-1 NC2214.2 +084900 ELSE NC2214.2 +085000 GO TO INS-FAIL-F3-11-1. NC2214.2 +085100 INS-DELETE-F3-11-1. NC2214.2 +085200 PERFORM DE-LETE. NC2214.2 +085300 GO TO INS-WRITE-F3-11-1. NC2214.2 +085400 INS-FAIL-F3-11-1. NC2214.2 +085500 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC2214.2 +085600 MOVE 8 TO CORRECT-N NC2214.2 +085700 PERFORM FAIL. NC2214.2 +085800 INS-WRITE-F3-11-1. NC2214.2 +085900 PERFORM PRINT-DETAIL. NC2214.2 +086000* NC2214.2 +086100 INS-TEST-F3-11-2. NC2214.2 +086200 ADD 1 TO REC-CT. NC2214.2 +086300 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-6 NC2214.2 +086400 PERFORM PASS NC2214.2 +086500 GO TO INS-WRITE-F3-11-2 NC2214.2 +086600 ELSE NC2214.2 +086700 GO TO INS-FAIL-F3-11-2. NC2214.2 +086800 INS-DELETE-F3-11-2. NC2214.2 +086900 PERFORM DE-LETE. NC2214.2 +087000 GO TO INS-WRITE-F3-11-2. NC2214.2 +087100 INS-FAIL-F3-11-2. NC2214.2 +087200 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83 NC2214.2 +087300 MOVE ANS-XN-83-6 TO WS-RIGHT-1-83 NC2214.2 +087400 PERFORM FAIL NC2214.2 +087500 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +087600 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +087700 PERFORM PRINT-DETAIL NC2214.2 +087800 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +087900 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +088000 PERFORM PRINT-DETAIL NC2214.2 +088100 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +088200 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +088300 PERFORM PRINT-DETAIL NC2214.2 +088400 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +088500 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +088600 PERFORM PRINT-DETAIL NC2214.2 +088700 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +088800 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +088900 INS-WRITE-F3-11-2. NC2214.2 +089000 PERFORM PRINT-DETAIL. NC2214.2 +089100* NC2214.2 +089200 INS-INIT-F3-12. NC2214.2 +089300 MOVE "INS-TEST-F3-12" TO PAR-NAME. NC2214.2 +089400 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2214.2 +089500 MOVE "TALLY CHARS REPL BEF" TO FEATURE. NC2214.2 +089600 MOVE 1 TO REC-CT. NC2214.2 +089700 PERFORM INIT-TABLE1. NC2214.2 +089800 MOVE ZEROS TO TABLE2. NC2214.2 +089900 PERFORM INIT-TABLE4. NC2214.2 +090000 SET INDEX1 TO 3. NC2214.2 +090100 SET INDEX2 TO 3. NC2214.2 +090200 SET INDEX4 TO 1. NC2214.2 +090300 INS-TEST-F3-12-0. NC2214.2 +090400 INSPECT TABLE1-REC (INDEX1) TALLYING WRK-DU-999 (INDEX2) NC2214.2 +090500 FOR CHARACTERS AFTER TABLE4-LETTER (INDEX4) NC2214.2 +090600 REPLACING ALL "AH" BY "OH" NC2214.2 +090700 BEFORE "YES". NC2214.2 +090800 GO TO INS-TEST-F3-12-1. NC2214.2 +090900 INS-DELETE-F3-12. NC2214.2 +091000 PERFORM DE-LETE. NC2214.2 +091100 PERFORM PRINT-DETAIL. NC2214.2 +091200 GO TO CCVS-999999. NC2214.2 +091300 INS-TEST-F3-12-1. NC2214.2 +091400 IF WRK-DU-999 (INDEX2) EQUAL TO 81 NC2214.2 +091500 PERFORM PASS NC2214.2 +091600 GO TO INS-WRITE-F3-12-1 NC2214.2 +091700 ELSE NC2214.2 +091800 GO TO INS-FAIL-F3-12-1. NC2214.2 +091900 INS-DELETE-F3-12-1. NC2214.2 +092000 PERFORM DE-LETE. NC2214.2 +092100 GO TO INS-WRITE-F3-12-1. NC2214.2 +092200 INS-FAIL-F3-12-1. NC2214.2 +092300 MOVE WRK-DU-999 (INDEX2) TO COMPUTED-N NC2214.2 +092400 MOVE 81 TO CORRECT-N NC2214.2 +092500 PERFORM FAIL. NC2214.2 +092600 INS-WRITE-F3-12-1. NC2214.2 +092700 PERFORM PRINT-DETAIL. NC2214.2 +092800* NC2214.2 +092900 INS-TEST-F3-12-2. NC2214.2 +093000 ADD 1 TO REC-CT. NC2214.2 +093100 IF TABLE1-REC (INDEX1) EQUAL TO ANS-XN-83-3 NC2214.2 +093200 PERFORM PASS NC2214.2 +093300 GO TO INS-WRITE-F3-12-2 NC2214.2 +093400 ELSE NC2214.2 +093500 GO TO INS-FAIL-F3-12-2. NC2214.2 +093600 INS-DELETE-F3-12-2. NC2214.2 +093700 PERFORM DE-LETE. NC2214.2 +093800 GO TO INS-WRITE-F3-12-2. NC2214.2 +093900 INS-FAIL-F3-12-2. NC2214.2 +094000 MOVE TABLE1-REC (INDEX1) TO WS-WRONG-1-83 NC2214.2 +094100 MOVE ANS-XN-83-3 TO WS-RIGHT-1-83 NC2214.2 +094200 PERFORM FAIL NC2214.2 +094300 MOVE WS-RIGHT-1-20 TO CORRECT-A NC2214.2 +094400 MOVE WS-WRONG-1-20 TO COMPUTED-A NC2214.2 +094500 PERFORM PRINT-DETAIL NC2214.2 +094600 MOVE WS-RIGHT-21-40 TO CORRECT-A NC2214.2 +094700 MOVE WS-WRONG-21-40 TO COMPUTED-A NC2214.2 +094800 PERFORM PRINT-DETAIL NC2214.2 +094900 MOVE WS-RIGHT-41-60 TO CORRECT-A NC2214.2 +095000 MOVE WS-WRONG-41-60 TO COMPUTED-A NC2214.2 +095100 PERFORM PRINT-DETAIL NC2214.2 +095200 MOVE WS-RIGHT-61-80 TO CORRECT-A NC2214.2 +095300 MOVE WS-WRONG-61-80 TO COMPUTED-A NC2214.2 +095400 PERFORM PRINT-DETAIL NC2214.2 +095500 MOVE WS-RIGHT-81-83 TO CORRECT-A NC2214.2 +095600 MOVE WS-WRONG-81-83 TO COMPUTED-A. NC2214.2 +095700 INS-WRITE-F3-12-2. NC2214.2 +095800 PERFORM PRINT-DETAIL. NC2214.2 +095900 CCVS-EXIT SECTION. NC2214.2 +096000 CCVS-999999. NC2214.2 +096100 GO TO CLOSE-FILES. NC2214.2 diff --git a/tests/cobol85/NC/NC222A.CBL b/tests/cobol85/NC/NC222A.CBL new file mode 100755 index 00000000..40165ee4 --- /dev/null +++ b/tests/cobol85/NC/NC222A.CBL @@ -0,0 +1,552 @@ +000100 IDENTIFICATION DIVISION. NC2224.2 +000200 PROGRAM-ID. NC2224.2 +000300 NC222A. NC2224.2 +000400* * NC2224.2 +000500**************************************************************** NC2224.2 +000600* * NC2224.2 +000700* VALIDATION FOR:- * NC2224.2 +000800* * NC2224.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2224.2 +001000* * NC2224.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2224.2 +001200* * NC2224.2 +001300**************************************************************** NC2224.2 +001400* * NC2224.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2224.2 +001600* * NC2224.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2224.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2224.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2224.2 +002000* * NC2224.2 +002100**************************************************************** NC2224.2 +002200* PROGRAM NC222A TESTS THE USE OF INDEXED IDENTIFIERS WITH * NC2224.2 +002300* FORMAT 2 OF THE "ADD", "SUBTRACT" AND "MOVE" STATEMENTS. * NC2224.2 +002400* DE-EDITING BY USE OF THE "MOVE" STATEMENT IS ALSO TESTED. * NC2224.2 +002500* * NC2224.2 +002600**************************************************************** NC2224.2 +002700 ENVIRONMENT DIVISION. NC2224.2 +002800 CONFIGURATION SECTION. NC2224.2 +002900 SOURCE-COMPUTER. NC2224.2 +003000 Linux. NC2224.2 +003100 OBJECT-COMPUTER. NC2224.2 +003200 Linux. NC2224.2 +003300 INPUT-OUTPUT SECTION. NC2224.2 +003400 FILE-CONTROL. NC2224.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2224.2 +003600 "report.log". NC2224.2 +003700 DATA DIVISION. NC2224.2 +003800 FILE SECTION. NC2224.2 +003900 FD PRINT-FILE. NC2224.2 +004000 01 PRINT-REC PICTURE X(120). NC2224.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2224.2 +004200 WORKING-STORAGE SECTION. NC2224.2 +004300 01 TABLE1. NC2224.2 +004400 02 RECORD1 PICTURE 99. NC2224.2 +004500 02 RECORD2 PICTURE 99 NC2224.2 +004600 OCCURS 2 TIMES NC2224.2 +004700 INDEXED BY INDEX1. NC2224.2 +004800 02 RECORD3 PICTURE 99. NC2224.2 +004900 01 TABLE2. NC2224.2 +005000 02 RECORD1 PICTURE 99. NC2224.2 +005100 02 RECORD2 PICTURE 99 NC2224.2 +005200 OCCURS 2 TIMES NC2224.2 +005300 INDEXED BY INDEX2. NC2224.2 +005400 02 RECORD3 PICTURE 99. NC2224.2 +005500 01 TABLE3. NC2224.2 +005600 02 RECORD1 PICTURE XX VALUE "AA". NC2224.2 +005700 02 RECORD2 PICTURE XX NC2224.2 +005800 OCCURS 2 TIMES NC2224.2 +005900 INDEXED BY INDEX3. NC2224.2 +006000 02 RECORD3 PICTURE XX VALUE "DD". NC2224.2 +006100 01 TABLE4. NC2224.2 +006200 02 RECORD1 PICTURE XX VALUE "EE". NC2224.2 +006300 02 RECORD2 PICTURE XX NC2224.2 +006400 OCCURS 2 TIMES NC2224.2 +006500 INDEXED BY INDEX4. NC2224.2 +006600 02 RECORD3 PICTURE XX VALUE "HH". NC2224.2 +006700 01 MOVE-TEST-3-A PIC $(4)9.99CR. NC2224.2 +006800 01 MOVE-TEST-3-B PIC S9(4)V99. NC2224.2 +006900 01 MOVE-TEST-4-A PIC --9B.99B99/99. NC2224.2 +007000 01 MOVE-TEST-4-B PIC S99V9(6). NC2224.2 +007100 01 TEST-RESULTS. NC2224.2 +007200 02 FILLER PIC X VALUE SPACE. NC2224.2 +007300 02 FEATURE PIC X(20) VALUE SPACE. NC2224.2 +007400 02 FILLER PIC X VALUE SPACE. NC2224.2 +007500 02 P-OR-F PIC X(5) VALUE SPACE. NC2224.2 +007600 02 FILLER PIC X VALUE SPACE. NC2224.2 +007700 02 PAR-NAME. NC2224.2 +007800 03 FILLER PIC X(19) VALUE SPACE. NC2224.2 +007900 03 PARDOT-X PIC X VALUE SPACE. NC2224.2 +008000 03 DOTVALUE PIC 99 VALUE ZERO. NC2224.2 +008100 02 FILLER PIC X(8) VALUE SPACE. NC2224.2 +008200 02 RE-MARK PIC X(61). NC2224.2 +008300 01 TEST-COMPUTED. NC2224.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC2224.2 +008500 02 FILLER PIC X(17) VALUE NC2224.2 +008600 " COMPUTED=". NC2224.2 +008700 02 COMPUTED-X. NC2224.2 +008800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2224.2 +008900 03 COMPUTED-N REDEFINES COMPUTED-A NC2224.2 +009000 PIC -9(9).9(9). NC2224.2 +009100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2224.2 +009200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2224.2 +009300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2224.2 +009400 03 CM-18V0 REDEFINES COMPUTED-A. NC2224.2 +009500 04 COMPUTED-18V0 PIC -9(18). NC2224.2 +009600 04 FILLER PIC X. NC2224.2 +009700 03 FILLER PIC X(50) VALUE SPACE. NC2224.2 +009800 01 TEST-CORRECT. NC2224.2 +009900 02 FILLER PIC X(30) VALUE SPACE. NC2224.2 +010000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2224.2 +010100 02 CORRECT-X. NC2224.2 +010200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2224.2 +010300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2224.2 +010400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2224.2 +010500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2224.2 +010600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2224.2 +010700 03 CR-18V0 REDEFINES CORRECT-A. NC2224.2 +010800 04 CORRECT-18V0 PIC -9(18). NC2224.2 +010900 04 FILLER PIC X. NC2224.2 +011000 03 FILLER PIC X(2) VALUE SPACE. NC2224.2 +011100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2224.2 +011200 01 CCVS-C-1. NC2224.2 +011300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2224.2 +011400- "SS PARAGRAPH-NAME NC2224.2 +011500- " REMARKS". NC2224.2 +011600 02 FILLER PIC X(20) VALUE SPACE. NC2224.2 +011700 01 CCVS-C-2. NC2224.2 +011800 02 FILLER PIC X VALUE SPACE. NC2224.2 +011900 02 FILLER PIC X(6) VALUE "TESTED". NC2224.2 +012000 02 FILLER PIC X(15) VALUE SPACE. NC2224.2 +012100 02 FILLER PIC X(4) VALUE "FAIL". NC2224.2 +012200 02 FILLER PIC X(94) VALUE SPACE. NC2224.2 +012300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2224.2 +012400 01 REC-CT PIC 99 VALUE ZERO. NC2224.2 +012500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2224.2 +012600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2224.2 +012700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2224.2 +012800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2224.2 +012900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2224.2 +013000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2224.2 +013100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2224.2 +013200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2224.2 +013300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2224.2 +013400 01 CCVS-H-1. NC2224.2 +013500 02 FILLER PIC X(39) VALUE SPACES. NC2224.2 +013600 02 FILLER PIC X(42) VALUE NC2224.2 +013700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2224.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC2224.2 +013900 01 CCVS-H-2A. NC2224.2 +014000 02 FILLER PIC X(40) VALUE SPACE. NC2224.2 +014100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2224.2 +014200 02 FILLER PIC XXXX VALUE NC2224.2 +014300 "4.2 ". NC2224.2 +014400 02 FILLER PIC X(28) VALUE NC2224.2 +014500 " COPY - NOT FOR DISTRIBUTION". NC2224.2 +014600 02 FILLER PIC X(41) VALUE SPACE. NC2224.2 +014700 NC2224.2 +014800 01 CCVS-H-2B. NC2224.2 +014900 02 FILLER PIC X(15) VALUE NC2224.2 +015000 "TEST RESULT OF ". NC2224.2 +015100 02 TEST-ID PIC X(9). NC2224.2 +015200 02 FILLER PIC X(4) VALUE NC2224.2 +015300 " IN ". NC2224.2 +015400 02 FILLER PIC X(12) VALUE NC2224.2 +015500 " HIGH ". NC2224.2 +015600 02 FILLER PIC X(22) VALUE NC2224.2 +015700 " LEVEL VALIDATION FOR ". NC2224.2 +015800 02 FILLER PIC X(58) VALUE NC2224.2 +015900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2224.2 +016000 01 CCVS-H-3. NC2224.2 +016100 02 FILLER PIC X(34) VALUE NC2224.2 +016200 " FOR OFFICIAL USE ONLY ". NC2224.2 +016300 02 FILLER PIC X(58) VALUE NC2224.2 +016400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2224.2 +016500 02 FILLER PIC X(28) VALUE NC2224.2 +016600 " COPYRIGHT 1985 ". NC2224.2 +016700 01 CCVS-E-1. NC2224.2 +016800 02 FILLER PIC X(52) VALUE SPACE. NC2224.2 +016900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2224.2 +017000 02 ID-AGAIN PIC X(9). NC2224.2 +017100 02 FILLER PIC X(45) VALUE SPACES. NC2224.2 +017200 01 CCVS-E-2. NC2224.2 +017300 02 FILLER PIC X(31) VALUE SPACE. NC2224.2 +017400 02 FILLER PIC X(21) VALUE SPACE. NC2224.2 +017500 02 CCVS-E-2-2. NC2224.2 +017600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2224.2 +017700 03 FILLER PIC X VALUE SPACE. NC2224.2 +017800 03 ENDER-DESC PIC X(44) VALUE NC2224.2 +017900 "ERRORS ENCOUNTERED". NC2224.2 +018000 01 CCVS-E-3. NC2224.2 +018100 02 FILLER PIC X(22) VALUE NC2224.2 +018200 " FOR OFFICIAL USE ONLY". NC2224.2 +018300 02 FILLER PIC X(12) VALUE SPACE. NC2224.2 +018400 02 FILLER PIC X(58) VALUE NC2224.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2224.2 +018600 02 FILLER PIC X(13) VALUE SPACE. NC2224.2 +018700 02 FILLER PIC X(15) VALUE NC2224.2 +018800 " COPYRIGHT 1985". NC2224.2 +018900 01 CCVS-E-4. NC2224.2 +019000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2224.2 +019100 02 FILLER PIC X(4) VALUE " OF ". NC2224.2 +019200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2224.2 +019300 02 FILLER PIC X(40) VALUE NC2224.2 +019400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2224.2 +019500 01 XXINFO. NC2224.2 +019600 02 FILLER PIC X(19) VALUE NC2224.2 +019700 "*** INFORMATION ***". NC2224.2 +019800 02 INFO-TEXT. NC2224.2 +019900 04 FILLER PIC X(8) VALUE SPACE. NC2224.2 +020000 04 XXCOMPUTED PIC X(20). NC2224.2 +020100 04 FILLER PIC X(5) VALUE SPACE. NC2224.2 +020200 04 XXCORRECT PIC X(20). NC2224.2 +020300 02 INF-ANSI-REFERENCE PIC X(48). NC2224.2 +020400 01 HYPHEN-LINE. NC2224.2 +020500 02 FILLER PIC IS X VALUE IS SPACE. NC2224.2 +020600 02 FILLER PIC IS X(65) VALUE IS "************************NC2224.2 +020700- "*****************************************". NC2224.2 +020800 02 FILLER PIC IS X(54) VALUE IS "************************NC2224.2 +020900- "******************************". NC2224.2 +021000 01 CCVS-PGM-ID PIC X(9) VALUE NC2224.2 +021100 "NC222A". NC2224.2 +021200 PROCEDURE DIVISION. NC2224.2 +021300 CCVS1 SECTION. NC2224.2 +021400 OPEN-FILES. NC2224.2 +021500 OPEN OUTPUT PRINT-FILE. NC2224.2 +021600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2224.2 +021700 MOVE SPACE TO TEST-RESULTS. NC2224.2 +021800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2224.2 +021900 GO TO CCVS1-EXIT. NC2224.2 +022000 CLOSE-FILES. NC2224.2 +022100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2224.2 +022200 TERMINATE-CCVS. NC2224.2 +022300*S EXIT PROGRAM. NC2224.2 +022400*SERMINATE-CALL. NC2224.2 +022500 STOP RUN. NC2224.2 +022600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2224.2 +022700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2224.2 +022800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2224.2 +022900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2224.2 +023000 MOVE "****TEST DELETED****" TO RE-MARK. NC2224.2 +023100 PRINT-DETAIL. NC2224.2 +023200 IF REC-CT NOT EQUAL TO ZERO NC2224.2 +023300 MOVE "." TO PARDOT-X NC2224.2 +023400 MOVE REC-CT TO DOTVALUE. NC2224.2 +023500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2224.2 +023600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2224.2 +023700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2224.2 +023800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2224.2 +023900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2224.2 +024000 MOVE SPACE TO CORRECT-X. NC2224.2 +024100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2224.2 +024200 MOVE SPACE TO RE-MARK. NC2224.2 +024300 HEAD-ROUTINE. NC2224.2 +024400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +024500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +024600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2224.2 +024700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2224.2 +024800 COLUMN-NAMES-ROUTINE. NC2224.2 +024900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +025000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +025200 END-ROUTINE. NC2224.2 +025300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2224.2 +025400 END-RTN-EXIT. NC2224.2 +025500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +025600 END-ROUTINE-1. NC2224.2 +025700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2224.2 +025800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2224.2 +025900 ADD PASS-COUNTER TO ERROR-HOLD. NC2224.2 +026000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2224.2 +026100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2224.2 +026200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2224.2 +026300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2224.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2224.2 +026500 END-ROUTINE-12. NC2224.2 +026600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2224.2 +026700 IF ERROR-COUNTER IS EQUAL TO ZERO NC2224.2 +026800 MOVE "NO " TO ERROR-TOTAL NC2224.2 +026900 ELSE NC2224.2 +027000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2224.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2224.2 +027200 PERFORM WRITE-LINE. NC2224.2 +027300 END-ROUTINE-13. NC2224.2 +027400 IF DELETE-COUNTER IS EQUAL TO ZERO NC2224.2 +027500 MOVE "NO " TO ERROR-TOTAL ELSE NC2224.2 +027600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2224.2 +027700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2224.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +027900 IF INSPECT-COUNTER EQUAL TO ZERO NC2224.2 +028000 MOVE "NO " TO ERROR-TOTAL NC2224.2 +028100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2224.2 +028200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2224.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +028400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2224.2 +028500 WRITE-LINE. NC2224.2 +028600 ADD 1 TO RECORD-COUNT. NC2224.2 +028700 IF RECORD-COUNT GREATER 50 NC2224.2 +028800 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2224.2 +028900 MOVE SPACE TO DUMMY-RECORD NC2224.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2224.2 +029100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2224.2 +029200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2224.2 +029300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2224.2 +029400 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2224.2 +029500 MOVE ZERO TO RECORD-COUNT. NC2224.2 +029600 PERFORM WRT-LN. NC2224.2 +029700 WRT-LN. NC2224.2 +029800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2224.2 +029900 MOVE SPACE TO DUMMY-RECORD. NC2224.2 +030000 BLANK-LINE-PRINT. NC2224.2 +030100 PERFORM WRT-LN. NC2224.2 +030200 FAIL-ROUTINE. NC2224.2 +030300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2224.2 +030400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2224.2 +030500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2224.2 +030600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2224.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2224.2 +030900 GO TO FAIL-ROUTINE-EX. NC2224.2 +031000 FAIL-ROUTINE-WRITE. NC2224.2 +031100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2224.2 +031200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2224.2 +031300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2224.2 +031400 MOVE SPACES TO COR-ANSI-REFERENCE. NC2224.2 +031500 FAIL-ROUTINE-EX. EXIT. NC2224.2 +031600 BAIL-OUT. NC2224.2 +031700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2224.2 +031800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2224.2 +031900 BAIL-OUT-WRITE. NC2224.2 +032000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2224.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2224.2 +032200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2224.2 +032300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2224.2 +032400 BAIL-OUT-EX. EXIT. NC2224.2 +032500 CCVS1-EXIT. NC2224.2 +032600 EXIT. NC2224.2 +032700 INITIALISE-TABLE1. NC2224.2 +032800 MOVE 06 TO RECORD1 OF TABLE1. NC2224.2 +032900 MOVE 01 TO RECORD2 OF TABLE1 (1). NC2224.2 +033000 MOVE 02 TO RECORD2 OF TABLE1 (2). NC2224.2 +033100 MOVE 07 TO RECORD3 OF TABLE1. NC2224.2 +033200 INITIALISE-TABLE2. NC2224.2 +033300 MOVE 08 TO RECORD1 OF TABLE2. NC2224.2 +033400 MOVE 03 TO RECORD2 OF TABLE2 (1). NC2224.2 +033500 MOVE 04 TO RECORD2 OF TABLE2 (2). NC2224.2 +033600 MOVE 09 TO RECORD3 OF TABLE2. NC2224.2 +033700* NC2224.2 +033800 ADD-INIT-F2-1. NC2224.2 +033900 MOVE "ADD-TEST-F2-1" TO PAR-NAME. NC2224.2 +034000 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2224.2 +034100 MOVE "ADD - QUALIFICATION" TO FEATURE. NC2224.2 +034200 PERFORM INITIALISE-TABLE1. NC2224.2 +034300 PERFORM INITIALISE-TABLE2. NC2224.2 +034400 SET INDEX1 TO 1. NC2224.2 +034500 SET INDEX2 TO 1. NC2224.2 +034600 ADD-TEST-F2-1. NC2224.2 +034700 ADD RECORD2 OF TABLE1 (INDEX1) TO RECORD2 OF TABLE2 (INDEX2).NC2224.2 +034800 IF RECORD2 OF TABLE2 (1) = 04 NC2224.2 +034900 AND RECORD2 OF TABLE2 (2) = 04 NC2224.2 +035000 AND RECORD1 OF TABLE2 = 08 NC2224.2 +035100 AND RECORD3 OF TABLE2 = 09 NC2224.2 +035200 PERFORM PASS NC2224.2 +035300 ELSE NC2224.2 +035400 GO TO ADD-FAIL-F2-1. NC2224.2 +035500 GO TO ADD-WRITE-F2-1. NC2224.2 +035600 ADD-DELETE-F2-1. NC2224.2 +035700 PERFORM DE-LETE. NC2224.2 +035800 GO TO ADD-WRITE-F2-1. NC2224.2 +035900 ADD-FAIL-F2-1. NC2224.2 +036000 PERFORM FAIL. NC2224.2 +036100 MOVE TABLE2 TO COMPUTED-A. NC2224.2 +036200 MOVE "08040409" TO CORRECT-A. NC2224.2 +036300 ADD-WRITE-F2-1. NC2224.2 +036400 PERFORM PRINT-DETAIL. NC2224.2 +036500 NC2224.2 +036600 SUBTRACT-INIT-F2-1. NC2224.2 +036700 MOVE "SUBTRACT-TEST-F2-1" TO PAR-NAME. NC2224.2 +036800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2224.2 +036900 MOVE "SUBTRACT - QUAL." TO FEATURE. NC2224.2 +037000 PERFORM INITIALISE-TABLE1. NC2224.2 +037100 PERFORM INITIALISE-TABLE2. NC2224.2 +037200 SET INDEX1 TO 1. NC2224.2 +037300 SET INDEX2 TO 1. NC2224.2 +037400 SUBTRACT-TEST-F2-1-0. NC2224.2 +037500 SUBTRACT RECORD2 OF TABLE1 (INDEX1) NC2224.2 +037600 FROM RECORD2 OF TABLE2 (INDEX2). NC2224.2 +037700 SUBTRACT-TEST-F2-1-1. NC2224.2 +037800 IF RECORD2 OF TABLE2 (1) = 02 NC2224.2 +037900 AND RECORD2 OF TABLE2 (2) = 04 NC2224.2 +038000 AND RECORD1 OF TABLE2 = 08 NC2224.2 +038100 AND RECORD3 OF TABLE2 = 09 NC2224.2 +038200 PERFORM PASS NC2224.2 +038300 ELSE NC2224.2 +038400 GO TO SUBTRACT-FAIL-F2-1. NC2224.2 +038500 GO TO SUBTRACT-WRITE-F2-1. NC2224.2 +038600 SUBTRACT-DELETE-F2-1. NC2224.2 +038700 PERFORM DE-LETE. NC2224.2 +038800 GO TO SUBTRACT-WRITE-F2-1. NC2224.2 +038900 SUBTRACT-FAIL-F2-1. NC2224.2 +039000 PERFORM FAIL. NC2224.2 +039100 MOVE TABLE2 TO COMPUTED-A. NC2224.2 +039200 MOVE "08020409" TO CORRECT-A. NC2224.2 +039300 SUBTRACT-WRITE-F2-1. NC2224.2 +039400 PERFORM PRINT-DETAIL. NC2224.2 +039500* NC2224.2 +039600 MOV-INIT-F2-1. NC2224.2 +039700 MOVE "MOV-TEST-F2-1" TO PAR-NAME. NC2224.2 +039800 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2224.2 +039900 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2224.2 +040000 PERFORM INITIALISE-TABLE1. NC2224.2 +040100 PERFORM INITIALISE-TABLE2. NC2224.2 +040200 MOV-TEST-F2-1. NC2224.2 +040300 MOVE CORRESPONDING TABLE1 TO TABLE2. NC2224.2 +040400 IF RECORD1 OF TABLE2 = 06 AND NC2224.2 +040500 RECORD2 OF TABLE2 (1) = 03 AND NC2224.2 +040600 RECORD2 OF TABLE2 (2) = 04 AND NC2224.2 +040700 RECORD3 OF TABLE2 = 07 NC2224.2 +040800 PERFORM PASS NC2224.2 +040900 ELSE GO TO MOV-FAIL-F2-1. NC2224.2 +041000 GO TO MOV-WRITE-F2-1. NC2224.2 +041100 MOV-DELETE-F2-1. NC2224.2 +041200 PERFORM DE-LETE. NC2224.2 +041300 GO TO MOV-WRITE-F2-1. NC2224.2 +041400 MOV-FAIL-F2-1. NC2224.2 +041500 PERFORM FAIL. NC2224.2 +041600 MOVE TABLE2 TO COMPUTED-A. NC2224.2 +041700 MOVE "06030407" TO CORRECT-A. NC2224.2 +041800 MOV-WRITE-F2-1. NC2224.2 +041900 PERFORM PRINT-DETAIL. NC2224.2 +042000* NC2224.2 +042100 INITIALISE-TABLE3. NC2224.2 +042200 MOVE "BB" TO RECORD2 OF TABLE3 (1). NC2224.2 +042300 MOVE "CC" TO RECORD2 OF TABLE3 (2). NC2224.2 +042400 INITIALISE-TABLE4. NC2224.2 +042500 MOVE "FF" TO RECORD2 OF TABLE4 (1). NC2224.2 +042600 MOVE "GG" TO RECORD2 OF TABLE4 (2). NC2224.2 +042700* NC2224.2 +042800 MOV-INIT-F2-2. NC2224.2 +042900 MOVE "MOV-TEST-F2-2" TO PAR-NAME. NC2224.2 +043000 MOVE "IV-21 4.3.8.2" TO ANSI-REFERENCE. NC2224.2 +043100 MOVE "MOVE CORRESPONDING" TO FEATURE. NC2224.2 +043200 MOV-TEST-F2-2. NC2224.2 +043300 MOVE CORRESPONDING TABLE3 TO TABLE4. NC2224.2 +043400 IF RECORD1 OF TABLE4 = "AA" AND NC2224.2 +043500 RECORD2 OF TABLE4 (1) = "FF" AND NC2224.2 +043600 RECORD2 OF TABLE4 (2) = "GG" AND NC2224.2 +043700 RECORD3 OF TABLE4 = "DD" NC2224.2 +043800 PERFORM PASS NC2224.2 +043900 ELSE GO TO MOV-FAIL-F2-2. NC2224.2 +044000 GO TO MOV-WRITE-F2-2. NC2224.2 +044100 MOV-DELETE-F2-2. NC2224.2 +044200 PERFORM DE-LETE. NC2224.2 +044300 GO TO MOV-WRITE-F2-2. NC2224.2 +044400 MOV-FAIL-F2-2. NC2224.2 +044500 PERFORM FAIL. NC2224.2 +044600 MOVE TABLE4 TO COMPUTED-A. NC2224.2 +044700 MOVE "AAFFGGDD" TO CORRECT-A. NC2224.2 +044800 MOV-WRITE-F2-2. NC2224.2 +044900 PERFORM PRINT-DETAIL. NC2224.2 +045000* NC2224.2 +045100 MOV-INIT-F2-3. NC2224.2 +045200* ===--> DE-EDITING <--=== NC2224.2 +045300 MOVE "VI-104 6.18.4 GR4(b)" TO ANSI-REFERENCE. NC2224.2 +045400 MOVE -123.45 TO MOVE-TEST-3-A. NC2224.2 +045500 MOVE 1 TO REC-CT. NC2224.2 +045600 MOV-TEST-F2-3-0. NC2224.2 +045700 MOVE MOVE-TEST-3-A TO MOVE-TEST-3-B. NC2224.2 +045800 GO TO MOV-TEST-F2-3-1. NC2224.2 +045900 MOV-DELETE-F2-3. NC2224.2 +046000 PERFORM DE-LETE. NC2224.2 +046100 PERFORM PRINT-DETAIL. NC2224.2 +046200 GO TO MOV-INIT-F2-4. NC2224.2 +046300 MOV-TEST-F2-3-1. NC2224.2 +046400 MOVE "MOV-TEST-F2-3-1" TO PAR-NAME. NC2224.2 +046500 IF MOVE-TEST-3-B = -123.45 NC2224.2 +046600 PERFORM PASS NC2224.2 +046700 GO TO MOV-WRITE-F2-3-1 NC2224.2 +046800 ELSE NC2224.2 +046900 GO TO MOV-FAIL-F2-3-1. NC2224.2 +047000 MOV-DELETE-F2-3-1. NC2224.2 +047100 PERFORM DE-LETE. NC2224.2 +047200 GO TO MOV-WRITE-F2-3-1. NC2224.2 +047300 MOV-FAIL-F2-3-1. NC2224.2 +047400 MOVE -123.45 TO CORRECT-N NC2224.2 +047500 MOVE MOVE-TEST-3-B TO COMPUTED-N NC2224.2 +047600 MOVE "DE-EDITING MOVE ERROR" TO RE-MARK NC2224.2 +047700 PERFORM FAIL. NC2224.2 +047800 MOV-WRITE-F2-3-1. NC2224.2 +047900 PERFORM PRINT-DETAIL. NC2224.2 +048000* NC2224.2 +048100 MOV-INIT-F2-3-2. NC2224.2 +048200 ADD 1 TO REC-CT. NC2224.2 +048300 MOVE "MOV-TEST-F2-3-2" TO PAR-NAME. NC2224.2 +048400 MOV-TEST-F2-3-2. NC2224.2 +048500 IF MOVE-TEST-3-A = " $123.45CR" NC2224.2 +048600 PERFORM PASS NC2224.2 +048700 GO TO MOV-WRITE-F2-3-2 NC2224.2 +048800 ELSE NC2224.2 +048900 GO TO MOV-FAIL-F2-3-2. NC2224.2 +049000 MOV-DELETE-F2-3-2. NC2224.2 +049100 PERFORM DE-LETE. NC2224.2 +049200 GO TO MOV-WRITE-F2-3-2. NC2224.2 +049300 MOV-FAIL-F2-3-2. NC2224.2 +049400 MOVE " $123.45" TO CORRECT-X NC2224.2 +049500 MOVE MOVE-TEST-3-A TO COMPUTED-X NC2224.2 +049600 MOVE "EDITED DATA MOVE ERROR" TO RE-MARK NC2224.2 +049700 PERFORM FAIL. NC2224.2 +049800 MOV-WRITE-F2-3-2. NC2224.2 +049900 PERFORM PRINT-DETAIL. NC2224.2 +050000* NC2224.2 +050100 MOV-INIT-F2-4. NC2224.2 +050200* ===--> DE-EDITING <--=== NC2224.2 +050300 MOVE "VI-104 6.18.4 GR4(b)" TO ANSI-REFERENCE. NC2224.2 +050400 MOVE -42.9876 TO MOVE-TEST-4-A. NC2224.2 +050500 MOVE 1 TO REC-CT. NC2224.2 +050600 MOV-TEST-F2-4-0. NC2224.2 +050700 MOVE MOVE-TEST-4-A TO MOVE-TEST-4-B. NC2224.2 +050800 GO TO MOV-TEST-F2-4-1. NC2224.2 +050900 MOV-DELETE-F2-4. NC2224.2 +051000 PERFORM DE-LETE. NC2224.2 +051100 PERFORM PRINT-DETAIL. NC2224.2 +051200 GO TO CCVS-999999. NC2224.2 +051300 MOV-TEST-F2-4-1. NC2224.2 +051400 MOVE "MOV-TEST-F2-4-1" TO PAR-NAME. NC2224.2 +051500 IF MOVE-TEST-4-B = -42.987600 NC2224.2 +051600 PERFORM PASS NC2224.2 +051700 GO TO MOV-WRITE-F2-4-1 NC2224.2 +051800 ELSE NC2224.2 +051900 GO TO MOV-FAIL-F2-4-1. NC2224.2 +052000 MOV-DELETE-F2-4-1. NC2224.2 +052100 PERFORM DE-LETE. NC2224.2 +052200 GO TO MOV-WRITE-F2-4-1. NC2224.2 +052300 MOV-FAIL-F2-4-1. NC2224.2 +052400 MOVE -42.987600 TO CORRECT-N NC2224.2 +052500 MOVE MOVE-TEST-4-B TO COMPUTED-N NC2224.2 +052600 MOVE "DE-EDITING MOVE ERROR" TO RE-MARK NC2224.2 +052700 PERFORM FAIL. NC2224.2 +052800 MOV-WRITE-F2-4-1. NC2224.2 +052900 PERFORM PRINT-DETAIL. NC2224.2 +053000* NC2224.2 +053100 MOV-TEST-F2-4-2. NC2224.2 +053200 ADD 1 TO REC-CT. NC2224.2 +053300 MOVE "MOV-TEST-F2-4-2" TO PAR-NAME. NC2224.2 +053400 IF MOVE-TEST-4-A = "-42 .98 76/00" NC2224.2 +053500 PERFORM PASS NC2224.2 +053600 GO TO MOV-WRITE-F2-4-2 NC2224.2 +053700 ELSE NC2224.2 +053800 GO TO MOV-FAIL-F2-4-2. NC2224.2 +053900 MOV-DELETE-F2-4-2. NC2224.2 +054000 PERFORM DE-LETE. NC2224.2 +054100 GO TO MOV-WRITE-F2-4-2. NC2224.2 +054200 MOV-FAIL-F2-4-2. NC2224.2 +054300 MOVE "-42 .98 76/00" TO CORRECT-X NC2224.2 +054400 MOVE MOVE-TEST-4-A TO COMPUTED-X NC2224.2 +054500 MOVE "EDITED DATA MOVE ERROR" TO RE-MARK NC2224.2 +054600 PERFORM FAIL. NC2224.2 +054700 MOV-WRITE-F2-4-2. NC2224.2 +054800 PERFORM PRINT-DETAIL. NC2224.2 +054900* NC2224.2 +055000 CCVS-EXIT SECTION. NC2224.2 +055100 CCVS-999999. NC2224.2 +055200 GO TO CLOSE-FILES. NC2224.2 diff --git a/tests/cobol85/NC/NC223A.CBL b/tests/cobol85/NC/NC223A.CBL new file mode 100755 index 00000000..f1e5c00b --- /dev/null +++ b/tests/cobol85/NC/NC223A.CBL @@ -0,0 +1,2290 @@ +000100 IDENTIFICATION DIVISION. NC2234.2 +000200 PROGRAM-ID. NC2234.2 +000300 NC223A. NC2234.2 +000400**************************************************************** NC2234.2 +000500* * NC2234.2 +000600* VALIDATION FOR:- * NC2234.2 +000700* * NC2234.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2234.2 +000900* * NC2234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2234.2 +001100* * NC2234.2 +001200**************************************************************** NC2234.2 +001300* * NC2234.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2234.2 +001500* * NC2234.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2234.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2234.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2234.2 +001900* * NC2234.2 +002000**************************************************************** NC2234.2 +002100* PROGRAM NC223A TESTS THE "INITIALISE" STATEMENT USING * NC2234.2 +002200* USING VARIOUS COMBINATIONS OD OPTIONAL PHRASES AND A * NC2234.2 +002300* VARIETY OF RECEIVING AREAS. * NC2234.2 +002400* * NC2234.2 +002500**************************************************************** NC2234.2 +002600 ENVIRONMENT DIVISION. NC2234.2 +002700 CONFIGURATION SECTION. NC2234.2 +002800 SOURCE-COMPUTER. NC2234.2 +002900 Linux. NC2234.2 +003000 OBJECT-COMPUTER. NC2234.2 +003100 Linux. NC2234.2 +003200 INPUT-OUTPUT SECTION. NC2234.2 +003300 FILE-CONTROL. NC2234.2 +003400 SELECT PRINT-FILE ASSIGN TO NC2234.2 +003500 "report.log". NC2234.2 +003600 DATA DIVISION. NC2234.2 +003700 FILE SECTION. NC2234.2 +003800 FD PRINT-FILE. NC2234.2 +003900 01 PRINT-REC PICTURE X(120). NC2234.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC2234.2 +004100 WORKING-STORAGE SECTION. NC2234.2 +004200 01 TEST-1-DATA. NC2234.2 +004300 03 TEST-1-1 PIC 9(6). NC2234.2 +004400 03 TEST-1-2 PIC $(3)9.99. NC2234.2 +004500 03 TEST-1-3 PIC X(10). NC2234.2 +004600 03 TEST-1-4 PIC XXBXX/XX. NC2234.2 +004700 03 TEST-1-5 PIC A(6). NC2234.2 +004800 03 TEST-1-6 PIC 9(6). NC2234.2 +004900 03 TEST-1-7 PIC $(3)9.99. NC2234.2 +005000 03 TEST-1-8 PIC X(10). NC2234.2 +005100 03 TEST-1-9 PIC XXBXX/XX. NC2234.2 +005200 03 TEST-1-10 PIC A(6). NC2234.2 +005300 01 NUM-1234 PIC 9(4) VALUE 1234. NC2234.2 +005400 01 TEST-8-DATA-1 PIC $(3)9.99. NC2234.2 +005500 01 TEST-8-DATA-2 PIC A(10). NC2234.2 +005600 01 TEST-RESULTS. NC2234.2 +005700 02 FILLER PIC X VALUE SPACE. NC2234.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. NC2234.2 +005900 02 FILLER PIC X VALUE SPACE. NC2234.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. NC2234.2 +006100 02 FILLER PIC X VALUE SPACE. NC2234.2 +006200 02 PAR-NAME. NC2234.2 +006300 03 FILLER PIC X(19) VALUE SPACE. NC2234.2 +006400 03 PARDOT-X PIC X VALUE SPACE. NC2234.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. NC2234.2 +006600 02 FILLER PIC X(8) VALUE SPACE. NC2234.2 +006700 02 RE-MARK PIC X(61). NC2234.2 +006800 01 TEST-COMPUTED. NC2234.2 +006900 02 FILLER PIC X(30) VALUE SPACE. NC2234.2 +007000 02 FILLER PIC X(17) VALUE NC2234.2 +007100 " COMPUTED=". NC2234.2 +007200 02 COMPUTED-X. NC2234.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2234.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A NC2234.2 +007500 PIC -9(9).9(9). NC2234.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2234.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2234.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2234.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. NC2234.2 +008000 04 COMPUTED-18V0 PIC -9(18). NC2234.2 +008100 04 FILLER PIC X. NC2234.2 +008200 03 FILLER PIC X(50) VALUE SPACE. NC2234.2 +008300 01 TEST-CORRECT. NC2234.2 +008400 02 FILLER PIC X(30) VALUE SPACE. NC2234.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". NC2234.2 +008600 02 CORRECT-X. NC2234.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. NC2234.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2234.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2234.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2234.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2234.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. NC2234.2 +009300 04 CORRECT-18V0 PIC -9(18). NC2234.2 +009400 04 FILLER PIC X. NC2234.2 +009500 03 FILLER PIC X(2) VALUE SPACE. NC2234.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2234.2 +009700 01 CCVS-C-1. NC2234.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2234.2 +009900- "SS PARAGRAPH-NAME NC2234.2 +010000- " REMARKS". NC2234.2 +010100 02 FILLER PIC X(20) VALUE SPACE. NC2234.2 +010200 01 CCVS-C-2. NC2234.2 +010300 02 FILLER PIC X VALUE SPACE. NC2234.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". NC2234.2 +010500 02 FILLER PIC X(15) VALUE SPACE. NC2234.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". NC2234.2 +010700 02 FILLER PIC X(94) VALUE SPACE. NC2234.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2234.2 +010900 01 REC-CT PIC 99 VALUE ZERO. NC2234.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2234.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2234.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2234.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2234.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2234.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2234.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2234.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2234.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2234.2 +011900 01 CCVS-H-1. NC2234.2 +012000 02 FILLER PIC X(39) VALUE SPACES. NC2234.2 +012100 02 FILLER PIC X(42) VALUE NC2234.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2234.2 +012300 02 FILLER PIC X(39) VALUE SPACES. NC2234.2 +012400 01 CCVS-H-2A. NC2234.2 +012500 02 FILLER PIC X(40) VALUE SPACE. NC2234.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2234.2 +012700 02 FILLER PIC XXXX VALUE NC2234.2 +012800 "4.2 ". NC2234.2 +012900 02 FILLER PIC X(28) VALUE NC2234.2 +013000 " COPY - NOT FOR DISTRIBUTION". NC2234.2 +013100 02 FILLER PIC X(41) VALUE SPACE. NC2234.2 +013200 NC2234.2 +013300 01 CCVS-H-2B. NC2234.2 +013400 02 FILLER PIC X(15) VALUE NC2234.2 +013500 "TEST RESULT OF ". NC2234.2 +013600 02 TEST-ID PIC X(9). NC2234.2 +013700 02 FILLER PIC X(4) VALUE NC2234.2 +013800 " IN ". NC2234.2 +013900 02 FILLER PIC X(12) VALUE NC2234.2 +014000 " HIGH ". NC2234.2 +014100 02 FILLER PIC X(22) VALUE NC2234.2 +014200 " LEVEL VALIDATION FOR ". NC2234.2 +014300 02 FILLER PIC X(58) VALUE NC2234.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2234.2 +014500 01 CCVS-H-3. NC2234.2 +014600 02 FILLER PIC X(34) VALUE NC2234.2 +014700 " FOR OFFICIAL USE ONLY ". NC2234.2 +014800 02 FILLER PIC X(58) VALUE NC2234.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2234.2 +015000 02 FILLER PIC X(28) VALUE NC2234.2 +015100 " COPYRIGHT 1985 ". NC2234.2 +015200 01 CCVS-E-1. NC2234.2 +015300 02 FILLER PIC X(52) VALUE SPACE. NC2234.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2234.2 +015500 02 ID-AGAIN PIC X(9). NC2234.2 +015600 02 FILLER PIC X(45) VALUE SPACES. NC2234.2 +015700 01 CCVS-E-2. NC2234.2 +015800 02 FILLER PIC X(31) VALUE SPACE. NC2234.2 +015900 02 FILLER PIC X(21) VALUE SPACE. NC2234.2 +016000 02 CCVS-E-2-2. NC2234.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2234.2 +016200 03 FILLER PIC X VALUE SPACE. NC2234.2 +016300 03 ENDER-DESC PIC X(44) VALUE NC2234.2 +016400 "ERRORS ENCOUNTERED". NC2234.2 +016500 01 CCVS-E-3. NC2234.2 +016600 02 FILLER PIC X(22) VALUE NC2234.2 +016700 " FOR OFFICIAL USE ONLY". NC2234.2 +016800 02 FILLER PIC X(12) VALUE SPACE. NC2234.2 +016900 02 FILLER PIC X(58) VALUE NC2234.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2234.2 +017100 02 FILLER PIC X(13) VALUE SPACE. NC2234.2 +017200 02 FILLER PIC X(15) VALUE NC2234.2 +017300 " COPYRIGHT 1985". NC2234.2 +017400 01 CCVS-E-4. NC2234.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2234.2 +017600 02 FILLER PIC X(4) VALUE " OF ". NC2234.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2234.2 +017800 02 FILLER PIC X(40) VALUE NC2234.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". NC2234.2 +018000 01 XXINFO. NC2234.2 +018100 02 FILLER PIC X(19) VALUE NC2234.2 +018200 "*** INFORMATION ***". NC2234.2 +018300 02 INFO-TEXT. NC2234.2 +018400 04 FILLER PIC X(8) VALUE SPACE. NC2234.2 +018500 04 XXCOMPUTED PIC X(20). NC2234.2 +018600 04 FILLER PIC X(5) VALUE SPACE. NC2234.2 +018700 04 XXCORRECT PIC X(20). NC2234.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). NC2234.2 +018900 01 HYPHEN-LINE. NC2234.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. NC2234.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************NC2234.2 +019200- "*****************************************". NC2234.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************NC2234.2 +019400- "******************************". NC2234.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE NC2234.2 +019600 "NC223A". NC2234.2 +019700 PROCEDURE DIVISION. NC2234.2 +019800 CCVS1 SECTION. NC2234.2 +019900 OPEN-FILES. NC2234.2 +020000 OPEN OUTPUT PRINT-FILE. NC2234.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2234.2 +020200 MOVE SPACE TO TEST-RESULTS. NC2234.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2234.2 +020400 GO TO CCVS1-EXIT. NC2234.2 +020500 CLOSE-FILES. NC2234.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2234.2 +020700 TERMINATE-CCVS. NC2234.2 +020800*S EXIT PROGRAM. NC2234.2 +020900*SERMINATE-CALL. NC2234.2 +021000 STOP RUN. NC2234.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2234.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2234.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2234.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2234.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. NC2234.2 +021600 PRINT-DETAIL. NC2234.2 +021700 IF REC-CT NOT EQUAL TO ZERO NC2234.2 +021800 MOVE "." TO PARDOT-X NC2234.2 +021900 MOVE REC-CT TO DOTVALUE. NC2234.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2234.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2234.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2234.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2234.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2234.2 +022500 MOVE SPACE TO CORRECT-X. NC2234.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2234.2 +022700 MOVE SPACE TO RE-MARK. NC2234.2 +022800 HEAD-ROUTINE. NC2234.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2234.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2234.2 +023300 COLUMN-NAMES-ROUTINE. NC2234.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +023700 END-ROUTINE. NC2234.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2234.2 +023900 END-RTN-EXIT. NC2234.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +024100 END-ROUTINE-1. NC2234.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2234.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2234.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. NC2234.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2234.2 +024600 NC2234.2 +024700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2234.2 +024800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2234.2 +024900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2234.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2234.2 +025100 END-ROUTINE-12. NC2234.2 +025200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2234.2 +025300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2234.2 +025400 MOVE "NO " TO ERROR-TOTAL NC2234.2 +025500 ELSE NC2234.2 +025600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2234.2 +025700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2234.2 +025800 PERFORM WRITE-LINE. NC2234.2 +025900 END-ROUTINE-13. NC2234.2 +026000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2234.2 +026100 MOVE "NO " TO ERROR-TOTAL ELSE NC2234.2 +026200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2234.2 +026300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2234.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +026500 IF INSPECT-COUNTER EQUAL TO ZERO NC2234.2 +026600 MOVE "NO " TO ERROR-TOTAL NC2234.2 +026700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2234.2 +026800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2234.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +027000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2234.2 +027100 WRITE-LINE. NC2234.2 +027200 ADD 1 TO RECORD-COUNT. NC2234.2 +027300 IF RECORD-COUNT GREATER 50 NC2234.2 +027400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2234.2 +027500 MOVE SPACE TO DUMMY-RECORD NC2234.2 +027600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2234.2 +027700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2234.2 +027800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2234.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2234.2 +028000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2234.2 +028100 MOVE ZERO TO RECORD-COUNT. NC2234.2 +028200 PERFORM WRT-LN. NC2234.2 +028300 WRT-LN. NC2234.2 +028400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2234.2 +028500 MOVE SPACE TO DUMMY-RECORD. NC2234.2 +028600 BLANK-LINE-PRINT. NC2234.2 +028700 PERFORM WRT-LN. NC2234.2 +028800 FAIL-ROUTINE. NC2234.2 +028900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2234.2 +029000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2234.2 +029100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2234.2 +029200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2234.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2234.2 +029500 GO TO FAIL-ROUTINE-EX. NC2234.2 +029600 FAIL-ROUTINE-WRITE. NC2234.2 +029700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2234.2 +029800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2234.2 +029900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2234.2 +030000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2234.2 +030100 FAIL-ROUTINE-EX. EXIT. NC2234.2 +030200 BAIL-OUT. NC2234.2 +030300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2234.2 +030400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2234.2 +030500 BAIL-OUT-WRITE. NC2234.2 +030600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2234.2 +030700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2234.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2234.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2234.2 +031000 BAIL-OUT-EX. EXIT. NC2234.2 +031100 CCVS1-EXIT. NC2234.2 +031200 EXIT. NC2234.2 +031300 SECT-NC223A-001 SECTION. NC2234.2 +031400* NC2234.2 +031500 INI-INIT-GF-1. NC2234.2 +031600 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +031700 MOVE "VI-92 6.16.2 GR5" TO ANSI-REFERENCE. NC2234.2 +031800 MOVE 1 TO REC-CT. NC2234.2 +031900 INI-TEST-GF-1-0. NC2234.2 +032000 INITIALIZE TEST-1-DATA. NC2234.2 +032100 GO TO INI-TEST-GF-1-1. NC2234.2 +032200 INI-DELETE-GF-1. NC2234.2 +032300 PERFORM DE-LETE. NC2234.2 +032400 PERFORM PRINT-DETAIL. NC2234.2 +032500 GO TO INI-INIT-GF-2. NC2234.2 +032600 INI-TEST-GF-1-1. NC2234.2 +032700 MOVE "INI-TEST-GF-1-1" TO PAR-NAME. NC2234.2 +032800 IF TEST-1-1 = ZERO NC2234.2 +032900 PERFORM PASS NC2234.2 +033000 GO TO INI-WRITE-GF-1-1 NC2234.2 +033100 ELSE NC2234.2 +033200 GO TO INI-FAIL-GF-1-1. NC2234.2 +033300 INI-DELETE-GF-1-1. NC2234.2 +033400 PERFORM DE-LETE. NC2234.2 +033500 GO TO INI-WRITE-GF-1-1. NC2234.2 +033600 INI-FAIL-GF-1-1. NC2234.2 +033700 MOVE ZERO TO CORRECT-N NC2234.2 +033800 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +033900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +034000 PERFORM FAIL. NC2234.2 +034100 INI-WRITE-GF-1-1. NC2234.2 +034200 PERFORM PRINT-DETAIL. NC2234.2 +034300* NC2234.2 +034400 INI-TEST-GF-1-2. NC2234.2 +034500 ADD 1 TO REC-CT. NC2234.2 +034600 MOVE "INI-TEST-GF-1-2" TO PAR-NAME. NC2234.2 +034700 IF TEST-1-2 = " $0.00" NC2234.2 +034800 PERFORM PASS NC2234.2 +034900 GO TO INI-WRITE-GF-1-2 NC2234.2 +035000 ELSE NC2234.2 +035100 GO TO INI-FAIL-GF-1-2. NC2234.2 +035200 INI-DELETE-GF-1-2. NC2234.2 +035300 PERFORM DE-LETE. NC2234.2 +035400 GO TO INI-WRITE-GF-1-2. NC2234.2 +035500 INI-FAIL-GF-1-2. NC2234.2 +035600 MOVE " $0.00" TO CORRECT-X NC2234.2 +035700 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +035800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +035900 PERFORM FAIL. NC2234.2 +036000 INI-WRITE-GF-1-2. NC2234.2 +036100 PERFORM PRINT-DETAIL. NC2234.2 +036200* NC2234.2 +036300 INI-TEST-GF-1-3. NC2234.2 +036400 ADD 1 TO REC-CT. NC2234.2 +036500 MOVE "INI-TEST-GF-1-3" TO PAR-NAME. NC2234.2 +036600 IF TEST-1-3 = SPACES NC2234.2 +036700 PERFORM PASS NC2234.2 +036800 GO TO INI-WRITE-GF-1-3 NC2234.2 +036900 ELSE NC2234.2 +037000 GO TO INI-FAIL-GF-1-3. NC2234.2 +037100 INI-DELETE-GF-1-3. NC2234.2 +037200 PERFORM DE-LETE. NC2234.2 +037300 GO TO INI-WRITE-GF-1-3. NC2234.2 +037400 INI-FAIL-GF-1-3. NC2234.2 +037500 MOVE SPACES TO CORRECT-X NC2234.2 +037600 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +037700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +037800 PERFORM FAIL. NC2234.2 +037900 INI-WRITE-GF-1-3. NC2234.2 +038000 PERFORM PRINT-DETAIL. NC2234.2 +038100* NC2234.2 +038200 INI-TEST-GF-1-4. NC2234.2 +038300 ADD 1 TO REC-CT. NC2234.2 +038400 MOVE "INI-TEST-GF-1-4" TO PAR-NAME. NC2234.2 +038500 IF TEST-1-4 = " / " NC2234.2 +038600 PERFORM PASS NC2234.2 +038700 GO TO INI-WRITE-GF-1-4 NC2234.2 +038800 ELSE NC2234.2 +038900 GO TO INI-FAIL-GF-1-4. NC2234.2 +039000 INI-DELETE-GF-1-4. NC2234.2 +039100 PERFORM DE-LETE. NC2234.2 +039200 GO TO INI-WRITE-GF-1-4. NC2234.2 +039300 INI-FAIL-GF-1-4. NC2234.2 +039400 MOVE " / " TO CORRECT-X NC2234.2 +039500 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +039600 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +039700 PERFORM FAIL. NC2234.2 +039800 INI-WRITE-GF-1-4. NC2234.2 +039900 PERFORM PRINT-DETAIL. NC2234.2 +040000* NC2234.2 +040100 INI-TEST-GF-1-5. NC2234.2 +040200 ADD 1 TO REC-CT. NC2234.2 +040300 MOVE "INI-TEST-GF-1-5" TO PAR-NAME. NC2234.2 +040400 IF TEST-1-5 = SPACES NC2234.2 +040500 PERFORM PASS NC2234.2 +040600 GO TO INI-WRITE-GF-1-5 NC2234.2 +040700 ELSE NC2234.2 +040800 GO TO INI-FAIL-GF-1-5. NC2234.2 +040900 INI-DELETE-GF-1-5. NC2234.2 +041000 PERFORM DE-LETE. NC2234.2 +041100 GO TO INI-WRITE-GF-1-5. NC2234.2 +041200 INI-FAIL-GF-1-5. NC2234.2 +041300 MOVE SPACES TO CORRECT-X NC2234.2 +041400 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +041500 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +041600 PERFORM FAIL. NC2234.2 +041700 INI-WRITE-GF-1-5. NC2234.2 +041800 PERFORM PRINT-DETAIL. NC2234.2 +041900* NC2234.2 +042000 INI-TEST-GF-1-6. NC2234.2 +042100 ADD 1 TO REC-CT. NC2234.2 +042200 MOVE "INI-TEST-GF-1-6" TO PAR-NAME. NC2234.2 +042300 IF TEST-1-6 = ZERO NC2234.2 +042400 PERFORM PASS NC2234.2 +042500 GO TO INI-WRITE-GF-1-6 NC2234.2 +042600 ELSE NC2234.2 +042700 GO TO INI-FAIL-GF-1-6. NC2234.2 +042800 INI-DELETE-GF-1-6. NC2234.2 +042900 PERFORM DE-LETE. NC2234.2 +043000 GO TO INI-WRITE-GF-1-6. NC2234.2 +043100 INI-FAIL-GF-1-6. NC2234.2 +043200 MOVE ZERO TO CORRECT-N NC2234.2 +043300 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +043400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +043500 PERFORM FAIL. NC2234.2 +043600 INI-WRITE-GF-1-6. NC2234.2 +043700 PERFORM PRINT-DETAIL. NC2234.2 +043800* NC2234.2 +043900 INI-TEST-GF-1-7. NC2234.2 +044000 ADD 1 TO REC-CT. NC2234.2 +044100 MOVE "INI-TEST-GF-1-7" TO PAR-NAME. NC2234.2 +044200 IF TEST-1-7 = " $0.00" NC2234.2 +044300 PERFORM PASS NC2234.2 +044400 GO TO INI-WRITE-GF-1-7 NC2234.2 +044500 ELSE NC2234.2 +044600 GO TO INI-FAIL-GF-1-7. NC2234.2 +044700 INI-DELETE-GF-1-7. NC2234.2 +044800 PERFORM DE-LETE. NC2234.2 +044900 GO TO INI-WRITE-GF-1-7. NC2234.2 +045000 INI-FAIL-GF-1-7. NC2234.2 +045100 MOVE " $0.00" TO CORRECT-X. NC2234.2 +045200 MOVE TEST-1-7 TO COMPUTED-X. NC2234.2 +045300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK. NC2234.2 +045400 PERFORM FAIL. NC2234.2 +045500 INI-WRITE-GF-1-7. NC2234.2 +045600 PERFORM PRINT-DETAIL. NC2234.2 +045700* NC2234.2 +045800 INI-TEST-GF-1-8. NC2234.2 +045900 ADD 1 TO REC-CT. NC2234.2 +046000 MOVE "INI-TEST-GF-1-8" TO PAR-NAME. NC2234.2 +046100 IF TEST-1-8 = SPACES NC2234.2 +046200 PERFORM PASS NC2234.2 +046300 GO TO INI-WRITE-GF-1-8 NC2234.2 +046400 ELSE NC2234.2 +046500 GO TO INI-FAIL-GF-1-8. NC2234.2 +046600 INI-DELETE-GF-1-8. NC2234.2 +046700 PERFORM DE-LETE. NC2234.2 +046800 GO TO INI-WRITE-GF-1-8. NC2234.2 +046900 INI-FAIL-GF-1-8. NC2234.2 +047000 MOVE SPACES TO CORRECT-X NC2234.2 +047100 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +047200 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +047300 PERFORM FAIL. NC2234.2 +047400 INI-WRITE-GF-1-8. NC2234.2 +047500 PERFORM PRINT-DETAIL. NC2234.2 +047600* NC2234.2 +047700 INI-TEST-GF-1-9. NC2234.2 +047800 ADD 1 TO REC-CT. NC2234.2 +047900 MOVE "INI-TEST-GF-1-9" TO PAR-NAME. NC2234.2 +048000 IF TEST-1-9 = " / " NC2234.2 +048100 PERFORM PASS NC2234.2 +048200 GO TO INI-WRITE-GF-1-9 NC2234.2 +048300 ELSE NC2234.2 +048400 GO TO INI-FAIL-GF-1-9. NC2234.2 +048500 INI-DELETE-GF-1-9. NC2234.2 +048600 PERFORM DE-LETE. NC2234.2 +048700 GO TO INI-WRITE-GF-1-9. NC2234.2 +048800 INI-FAIL-GF-1-9. NC2234.2 +048900 MOVE " / " TO CORRECT-X NC2234.2 +049000 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +049100 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +049200 PERFORM FAIL. NC2234.2 +049300 INI-WRITE-GF-1-9. NC2234.2 +049400 PERFORM PRINT-DETAIL. NC2234.2 +049500* NC2234.2 +049600 INI-TEST-GF-1-10. NC2234.2 +049700 ADD 1 TO REC-CT. NC2234.2 +049800 MOVE "INI-TEST-GF-1-10" TO PAR-NAME. NC2234.2 +049900 IF TEST-1-10 = SPACES NC2234.2 +050000 PERFORM PASS NC2234.2 +050100 GO TO INI-WRITE-GF-1-10 NC2234.2 +050200 ELSE NC2234.2 +050300 GO TO INI-FAIL-GF-1-10. NC2234.2 +050400 INI-DELETE-GF-1-10. NC2234.2 +050500 PERFORM DE-LETE. NC2234.2 +050600 GO TO INI-WRITE-GF-1-10. NC2234.2 +050700 INI-FAIL-GF-1-10. NC2234.2 +050800 MOVE SPACES TO CORRECT-X NC2234.2 +050900 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +051000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +051100 PERFORM FAIL. NC2234.2 +051200 INI-WRITE-GF-1-10. NC2234.2 +051300 PERFORM PRINT-DETAIL. NC2234.2 +051400* NC2234.2 +051500 INI-INIT-GF-2. NC2234.2 +051600 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +051700 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +051800 MOVE 1 TO REC-CT. NC2234.2 +051900 INI-TEST-GF-2-0. NC2234.2 +052000 INITIALIZE TEST-1-DATA NC2234.2 +052100 REPLACING ALPHABETIC DATA BY "AAAAAA". NC2234.2 +052200 GO TO INI-TEST-GF-2-1. NC2234.2 +052300 INI-DELETE-GF-2. NC2234.2 +052400 PERFORM DE-LETE. NC2234.2 +052500 PERFORM PRINT-DETAIL. NC2234.2 +052600 GO TO INI-INIT-GF-3. NC2234.2 +052700* NC2234.2 +052800 INI-TEST-GF-2-1. NC2234.2 +052900 MOVE "INI-TEST-GF-2-1" TO PAR-NAME. NC2234.2 +053000 IF TEST-1-5 = "AAAAAA" NC2234.2 +053100 PERFORM PASS NC2234.2 +053200 GO TO INI-WRITE-GF-2-1 NC2234.2 +053300 ELSE NC2234.2 +053400 GO TO INI-FAIL-GF-2-1. NC2234.2 +053500 INI-DELETE-GF-2-1. NC2234.2 +053600 PERFORM DE-LETE. NC2234.2 +053700 GO TO INI-WRITE-GF-2-1. NC2234.2 +053800 INI-FAIL-GF-2-1. NC2234.2 +053900 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +054000 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +054100 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +054200 PERFORM FAIL. NC2234.2 +054300 INI-WRITE-GF-2-1. NC2234.2 +054400 PERFORM PRINT-DETAIL. NC2234.2 +054500* NC2234.2 +054600 INI-TEST-GF-2-2. NC2234.2 +054700 ADD 1 TO REC-CT. NC2234.2 +054800 MOVE "INI-TEST-GF-2-2" TO PAR-NAME. NC2234.2 +054900 IF TEST-1-10 = "AAAAAA" NC2234.2 +055000 PERFORM PASS NC2234.2 +055100 GO TO INI-WRITE-GF-2-2 NC2234.2 +055200 ELSE NC2234.2 +055300 GO TO INI-FAIL-GF-2-2. NC2234.2 +055400 INI-DELETE-GF-2-2. NC2234.2 +055500 PERFORM DE-LETE. NC2234.2 +055600 GO TO INI-WRITE-GF-2-2. NC2234.2 +055700 INI-FAIL-GF-2-2. NC2234.2 +055800 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +055900 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +056000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +056100 PERFORM FAIL. NC2234.2 +056200 INI-WRITE-GF-2-2. NC2234.2 +056300 PERFORM PRINT-DETAIL. NC2234.2 +056400* NC2234.2 +056500 INI-TEST-GF-2-3. NC2234.2 +056600 ADD 1 TO REC-CT. NC2234.2 +056700 MOVE "INI-TEST-GF-2-3" TO PAR-NAME. NC2234.2 +056800 IF TEST-1-1 = ZERO NC2234.2 +056900 PERFORM PASS NC2234.2 +057000 GO TO INI-WRITE-GF-2-3 NC2234.2 +057100 ELSE NC2234.2 +057200 GO TO INI-FAIL-GF-2-3. NC2234.2 +057300 INI-DELETE-GF-2-3. NC2234.2 +057400 PERFORM DE-LETE. NC2234.2 +057500 GO TO INI-WRITE-GF-2-3. NC2234.2 +057600 INI-FAIL-GF-2-3. NC2234.2 +057700 MOVE ZERO TO CORRECT-N NC2234.2 +057800 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +057900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +058000 TO RE-MARK NC2234.2 +058100 PERFORM FAIL. NC2234.2 +058200 INI-WRITE-GF-2-3. NC2234.2 +058300 PERFORM PRINT-DETAIL. NC2234.2 +058400* NC2234.2 +058500 INI-TEST-GF-2-4. NC2234.2 +058600 ADD 1 TO REC-CT. NC2234.2 +058700 MOVE "INI-TEST-GF-2-4" TO PAR-NAME. NC2234.2 +058800 IF TEST-1-2 = " $0.00" NC2234.2 +058900 PERFORM PASS NC2234.2 +059000 GO TO INI-WRITE-GF-2-4 NC2234.2 +059100 ELSE NC2234.2 +059200 GO TO INI-FAIL-GF-2-4. NC2234.2 +059300 INI-DELETE-GF-2-4. NC2234.2 +059400 PERFORM DE-LETE. NC2234.2 +059500 GO TO INI-WRITE-GF-2-4. NC2234.2 +059600 INI-FAIL-GF-2-4. NC2234.2 +059700 MOVE " $0.00" TO CORRECT-X NC2234.2 +059800 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +059900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +060000 TO RE-MARK NC2234.2 +060100 PERFORM FAIL. NC2234.2 +060200 INI-WRITE-GF-2-4. NC2234.2 +060300 PERFORM PRINT-DETAIL. NC2234.2 +060400* NC2234.2 +060500 INI-TEST-GF-2-5. NC2234.2 +060600 ADD 1 TO REC-CT. NC2234.2 +060700 MOVE "INI-TEST-GF-2-5" TO PAR-NAME. NC2234.2 +060800 IF TEST-1-3 = SPACES NC2234.2 +060900 PERFORM PASS NC2234.2 +061000 GO TO INI-WRITE-GF-2-5 NC2234.2 +061100 ELSE NC2234.2 +061200 GO TO INI-FAIL-GF-2-5. NC2234.2 +061300 INI-DELETE-GF-2-5. NC2234.2 +061400 PERFORM DE-LETE. NC2234.2 +061500 GO TO INI-WRITE-GF-2-5. NC2234.2 +061600 INI-FAIL-GF-2-5. NC2234.2 +061700 MOVE SPACES TO CORRECT-X NC2234.2 +061800 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +061900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +062000 TO RE-MARK NC2234.2 +062100 PERFORM FAIL. NC2234.2 +062200 INI-WRITE-GF-2-5. NC2234.2 +062300 PERFORM PRINT-DETAIL. NC2234.2 +062400* NC2234.2 +062500 INI-TEST-GF-2-6. NC2234.2 +062600 ADD 1 TO REC-CT. NC2234.2 +062700 MOVE "INI-TEST-GF-2-6" TO PAR-NAME. NC2234.2 +062800 IF TEST-1-4 = " / " NC2234.2 +062900 PERFORM PASS NC2234.2 +063000 GO TO INI-WRITE-GF-2-6 NC2234.2 +063100 ELSE NC2234.2 +063200 GO TO INI-FAIL-GF-2-6. NC2234.2 +063300 INI-DELETE-GF-2-6. NC2234.2 +063400 PERFORM DE-LETE. NC2234.2 +063500 GO TO INI-WRITE-GF-2-6. NC2234.2 +063600 INI-FAIL-GF-2-6. NC2234.2 +063700 MOVE " / " TO CORRECT-X NC2234.2 +063800 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +063900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +064000 TO RE-MARK NC2234.2 +064100 PERFORM FAIL. NC2234.2 +064200 INI-WRITE-GF-2-6. NC2234.2 +064300 PERFORM PRINT-DETAIL. NC2234.2 +064400* NC2234.2 +064500 INI-TEST-GF-2-7. NC2234.2 +064600 ADD 1 TO REC-CT. NC2234.2 +064700 MOVE "INI-TEST-GF-2-7" TO PAR-NAME. NC2234.2 +064800 IF TEST-1-6 = ZERO NC2234.2 +064900 PERFORM PASS NC2234.2 +065000 GO TO INI-WRITE-GF-2-7 NC2234.2 +065100 ELSE NC2234.2 +065200 GO TO INI-FAIL-GF-2-7. NC2234.2 +065300 INI-DELETE-GF-2-7. NC2234.2 +065400 PERFORM DE-LETE. NC2234.2 +065500 GO TO INI-WRITE-GF-2-7. NC2234.2 +065600 INI-FAIL-GF-2-7. NC2234.2 +065700 MOVE ZERO TO CORRECT-N NC2234.2 +065800 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +065900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +066000 TO RE-MARK NC2234.2 +066100 PERFORM FAIL. NC2234.2 +066200 INI-WRITE-GF-2-7. NC2234.2 +066300 PERFORM PRINT-DETAIL. NC2234.2 +066400* NC2234.2 +066500 INI-TEST-GF-2-8. NC2234.2 +066600 ADD 1 TO REC-CT. NC2234.2 +066700 MOVE "INI-TEST-GF-2-8" TO PAR-NAME. NC2234.2 +066800 IF TEST-1-7 = " $0.00" NC2234.2 +066900 PERFORM PASS NC2234.2 +067000 GO TO INI-WRITE-GF-2-8 NC2234.2 +067100 ELSE NC2234.2 +067200 GO TO INI-FAIL-GF-2-8. NC2234.2 +067300 INI-DELETE-GF-2-8. NC2234.2 +067400 PERFORM DE-LETE. NC2234.2 +067500 GO TO INI-WRITE-GF-2-8. NC2234.2 +067600 INI-FAIL-GF-2-8. NC2234.2 +067700 MOVE " $0.00" TO CORRECT-X NC2234.2 +067800 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +067900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +068000 TO RE-MARK NC2234.2 +068100 PERFORM FAIL. NC2234.2 +068200 INI-WRITE-GF-2-8. NC2234.2 +068300 PERFORM PRINT-DETAIL. NC2234.2 +068400* NC2234.2 +068500 INI-TEST-GF-2-9. NC2234.2 +068600 ADD 1 TO REC-CT. NC2234.2 +068700 MOVE "INI-TEST-GF-2-9" TO PAR-NAME. NC2234.2 +068800 IF TEST-1-8 = SPACES NC2234.2 +068900 PERFORM PASS NC2234.2 +069000 GO TO INI-WRITE-GF-2-9 NC2234.2 +069100 ELSE NC2234.2 +069200 GO TO INI-FAIL-GF-2-9. NC2234.2 +069300 INI-DELETE-GF-2-9. NC2234.2 +069400 PERFORM DE-LETE. NC2234.2 +069500 GO TO INI-WRITE-GF-2-9. NC2234.2 +069600 INI-FAIL-GF-2-9. NC2234.2 +069700 MOVE SPACES TO CORRECT-X NC2234.2 +069800 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +069900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +070000 TO RE-MARK NC2234.2 +070100 PERFORM FAIL. NC2234.2 +070200 INI-WRITE-GF-2-9. NC2234.2 +070300 PERFORM PRINT-DETAIL. NC2234.2 +070400* NC2234.2 +070500 INI-TEST-GF-2-10. NC2234.2 +070600 ADD 1 TO REC-CT. NC2234.2 +070700 MOVE "INI-TEST-GF-2-10" TO PAR-NAME. NC2234.2 +070800 IF TEST-1-9 = " / " NC2234.2 +070900 PERFORM PASS NC2234.2 +071000 GO TO INI-WRITE-GF-2-10 NC2234.2 +071100 ELSE NC2234.2 +071200 GO TO INI-FAIL-GF-2-10. NC2234.2 +071300 INI-DELETE-GF-2-10. NC2234.2 +071400 PERFORM DE-LETE. NC2234.2 +071500 GO TO INI-WRITE-GF-2-10. NC2234.2 +071600 INI-FAIL-GF-2-10. NC2234.2 +071700 MOVE " / " TO CORRECT-X NC2234.2 +071800 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +071900 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +072000 TO RE-MARK NC2234.2 +072100 PERFORM FAIL. NC2234.2 +072200 INI-WRITE-GF-2-10. NC2234.2 +072300 PERFORM PRINT-DETAIL. NC2234.2 +072400* NC2234.2 +072500 INI-INIT-GF-3. NC2234.2 +072600 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +072700 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +072800 MOVE 1 TO REC-CT. NC2234.2 +072900 INI-TEST-GF-3-0. NC2234.2 +073000 INITIALIZE TEST-1-DATA NC2234.2 +073100 REPLACING ALPHANUMERIC BY "**********". NC2234.2 +073200 GO TO INI-TEST-GF-3-1. NC2234.2 +073300 INI-DELETE-GF-3. NC2234.2 +073400 PERFORM DE-LETE. NC2234.2 +073500 PERFORM PRINT-DETAIL. NC2234.2 +073600 GO TO INI-INIT-GF-4. NC2234.2 +073700 INI-TEST-GF-3-1. NC2234.2 +073800 MOVE "INI-TEST-GF-3-1" TO PAR-NAME. NC2234.2 +073900 IF TEST-1-3 = "**********" NC2234.2 +074000 PERFORM PASS NC2234.2 +074100 GO TO INI-WRITE-GF-3-1 NC2234.2 +074200 ELSE NC2234.2 +074300 GO TO INI-FAIL-GF-3-1. NC2234.2 +074400 INI-DELETE-GF-3-1. NC2234.2 +074500 PERFORM DE-LETE. NC2234.2 +074600 GO TO INI-WRITE-GF-3-1. NC2234.2 +074700 INI-FAIL-GF-3-1. NC2234.2 +074800 MOVE "**********" TO CORRECT-X NC2234.2 +074900 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +075000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +075100 PERFORM FAIL. NC2234.2 +075200 INI-WRITE-GF-3-1. NC2234.2 +075300 PERFORM PRINT-DETAIL. NC2234.2 +075400* NC2234.2 +075500 INI-TEST-GF-3-2. NC2234.2 +075600 ADD 1 TO REC-CT. NC2234.2 +075700 MOVE "INI-TEST-GF-3-2" TO PAR-NAME. NC2234.2 +075800 IF TEST-1-8 = "**********" NC2234.2 +075900 PERFORM PASS NC2234.2 +076000 GO TO INI-WRITE-GF-3-2 NC2234.2 +076100 ELSE NC2234.2 +076200 GO TO INI-FAIL-GF-3-2. NC2234.2 +076300 INI-DELETE-GF-3-2. NC2234.2 +076400 PERFORM DE-LETE. NC2234.2 +076500 GO TO INI-WRITE-GF-3-2. NC2234.2 +076600 INI-FAIL-GF-3-2. NC2234.2 +076700 MOVE "**********" TO CORRECT-X NC2234.2 +076800 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +076900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +077000 PERFORM FAIL. NC2234.2 +077100 INI-WRITE-GF-3-2. NC2234.2 +077200 PERFORM PRINT-DETAIL. NC2234.2 +077300* NC2234.2 +077400 INI-TEST-GF-3-3. NC2234.2 +077500 ADD 1 TO REC-CT. NC2234.2 +077600 MOVE "INI-TEST-GF-3-3" TO PAR-NAME. NC2234.2 +077700 IF TEST-1-1 = ZERO NC2234.2 +077800 PERFORM PASS NC2234.2 +077900 GO TO INI-WRITE-GF-3-3 NC2234.2 +078000 ELSE NC2234.2 +078100 GO TO INI-FAIL-GF-3-3. NC2234.2 +078200 INI-DELETE-GF-3-3. NC2234.2 +078300 PERFORM DE-LETE. NC2234.2 +078400 GO TO INI-WRITE-GF-3-3. NC2234.2 +078500 INI-FAIL-GF-3-3. NC2234.2 +078600 MOVE ZERO TO CORRECT-N NC2234.2 +078700 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +078800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +078900 TO RE-MARK NC2234.2 +079000 PERFORM FAIL. NC2234.2 +079100 INI-WRITE-GF-3-3. NC2234.2 +079200 PERFORM PRINT-DETAIL. NC2234.2 +079300* NC2234.2 +079400 INI-TEST-GF-3-4. NC2234.2 +079500 ADD 1 TO REC-CT. NC2234.2 +079600 MOVE "INI-TEST-GF-3-4" TO PAR-NAME. NC2234.2 +079700 IF TEST-1-2 = " $0.00" NC2234.2 +079800 PERFORM PASS NC2234.2 +079900 GO TO INI-WRITE-GF-3-4 NC2234.2 +080000 ELSE NC2234.2 +080100 GO TO INI-FAIL-GF-3-4. NC2234.2 +080200 INI-DELETE-GF-3-4. NC2234.2 +080300 PERFORM DE-LETE. NC2234.2 +080400 GO TO INI-WRITE-GF-3-4. NC2234.2 +080500 INI-FAIL-GF-3-4. NC2234.2 +080600 MOVE " $0.00" TO CORRECT-X NC2234.2 +080700 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +080800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +080900 TO RE-MARK NC2234.2 +081000 PERFORM FAIL. NC2234.2 +081100 INI-WRITE-GF-3-4. NC2234.2 +081200 PERFORM PRINT-DETAIL. NC2234.2 +081300* NC2234.2 +081400 INI-TEST-GF-3-5. NC2234.2 +081500 ADD 1 TO REC-CT. NC2234.2 +081600 MOVE "INI-TEST-GF-3-5" TO PAR-NAME. NC2234.2 +081700 IF TEST-1-4 = " / " NC2234.2 +081800 PERFORM PASS NC2234.2 +081900 GO TO INI-WRITE-GF-3-5 NC2234.2 +082000 ELSE NC2234.2 +082100 GO TO INI-FAIL-GF-3-5. NC2234.2 +082200 INI-DELETE-GF-3-5. NC2234.2 +082300 PERFORM DE-LETE. NC2234.2 +082400 GO TO INI-WRITE-GF-3-5. NC2234.2 +082500 INI-FAIL-GF-3-5. NC2234.2 +082600 MOVE " / " TO CORRECT-X NC2234.2 +082700 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +082800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +082900 TO RE-MARK NC2234.2 +083000 PERFORM FAIL. NC2234.2 +083100 INI-WRITE-GF-3-5. NC2234.2 +083200 PERFORM PRINT-DETAIL. NC2234.2 +083300* NC2234.2 +083400 INI-TEST-GF-3-6. NC2234.2 +083500 ADD 1 TO REC-CT. NC2234.2 +083600 MOVE "INI-TEST-GF-3-6" TO PAR-NAME. NC2234.2 +083700 IF TEST-1-5 = "AAAAAA" NC2234.2 +083800 PERFORM PASS NC2234.2 +083900 GO TO INI-WRITE-GF-3-6 NC2234.2 +084000 ELSE NC2234.2 +084100 GO TO INI-FAIL-GF-3-6. NC2234.2 +084200 INI-DELETE-GF-3-6. NC2234.2 +084300 PERFORM DE-LETE. NC2234.2 +084400 GO TO INI-WRITE-GF-3-6. NC2234.2 +084500 INI-FAIL-GF-3-6. NC2234.2 +084600 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +084700 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +084800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +084900 TO RE-MARK NC2234.2 +085000 PERFORM FAIL. NC2234.2 +085100 INI-WRITE-GF-3-6. NC2234.2 +085200 PERFORM PRINT-DETAIL. NC2234.2 +085300* NC2234.2 +085400 INI-TEST-GF-3-7. NC2234.2 +085500 ADD 1 TO REC-CT. NC2234.2 +085600 MOVE "INI-TEST-GF-3-7" TO PAR-NAME. NC2234.2 +085700 IF TEST-1-6 = ZERO NC2234.2 +085800 PERFORM PASS NC2234.2 +085900 GO TO INI-WRITE-GF-3-7 NC2234.2 +086000 ELSE NC2234.2 +086100 GO TO INI-FAIL-GF-3-7. NC2234.2 +086200 INI-DELETE-GF-3-7. NC2234.2 +086300 PERFORM DE-LETE. NC2234.2 +086400 GO TO INI-WRITE-GF-3-7. NC2234.2 +086500 INI-FAIL-GF-3-7. NC2234.2 +086600 MOVE ZERO TO CORRECT-N NC2234.2 +086700 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +086800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +086900 TO RE-MARK NC2234.2 +087000 PERFORM FAIL. NC2234.2 +087100 INI-WRITE-GF-3-7. NC2234.2 +087200 PERFORM PRINT-DETAIL. NC2234.2 +087300* NC2234.2 +087400 INI-TEST-GF-3-8. NC2234.2 +087500 ADD 1 TO REC-CT. NC2234.2 +087600 MOVE "INI-TEST-GF-3-8" TO PAR-NAME. NC2234.2 +087700 IF TEST-1-7 = " $0.00" NC2234.2 +087800 PERFORM PASS NC2234.2 +087900 GO TO INI-WRITE-GF-3-8 NC2234.2 +088000 ELSE NC2234.2 +088100 GO TO INI-FAIL-GF-3-8. NC2234.2 +088200 INI-DELETE-GF-3-8. NC2234.2 +088300 PERFORM DE-LETE. NC2234.2 +088400 GO TO INI-WRITE-GF-3-8. NC2234.2 +088500 INI-FAIL-GF-3-8. NC2234.2 +088600 MOVE " $0.00" TO CORRECT-X NC2234.2 +088700 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +088800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +088900 TO RE-MARK NC2234.2 +089000 PERFORM FAIL. NC2234.2 +089100 INI-WRITE-GF-3-8. NC2234.2 +089200 PERFORM PRINT-DETAIL. NC2234.2 +089300* NC2234.2 +089400 INI-TEST-GF-3-9. NC2234.2 +089500 ADD 1 TO REC-CT. NC2234.2 +089600 MOVE "INI-TEST-GF-3-9" TO PAR-NAME. NC2234.2 +089700 IF TEST-1-9 = " / " NC2234.2 +089800 PERFORM PASS NC2234.2 +089900 GO TO INI-WRITE-GF-3-9 NC2234.2 +090000 ELSE NC2234.2 +090100 GO TO INI-FAIL-GF-3-9. NC2234.2 +090200 INI-DELETE-GF-3-9. NC2234.2 +090300 PERFORM DE-LETE. NC2234.2 +090400 GO TO INI-WRITE-GF-3-9. NC2234.2 +090500 INI-FAIL-GF-3-9. NC2234.2 +090600 MOVE " / " TO CORRECT-X NC2234.2 +090700 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +090800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +090900 TO RE-MARK NC2234.2 +091000 PERFORM FAIL. NC2234.2 +091100 INI-WRITE-GF-3-9. NC2234.2 +091200 PERFORM PRINT-DETAIL. NC2234.2 +091300* NC2234.2 +091400 INI-TEST-GF-3-10. NC2234.2 +091500 ADD 1 TO REC-CT. NC2234.2 +091600 MOVE "INI-TEST-GF-3-10" TO PAR-NAME. NC2234.2 +091700 IF TEST-1-10 = "AAAAAA" NC2234.2 +091800 PERFORM PASS NC2234.2 +091900 GO TO INI-WRITE-GF-3-10 NC2234.2 +092000 ELSE NC2234.2 +092100 GO TO INI-FAIL-GF-3-10. NC2234.2 +092200 INI-DELETE-GF-3-10. NC2234.2 +092300 PERFORM DE-LETE. NC2234.2 +092400 GO TO INI-WRITE-GF-3-10. NC2234.2 +092500 INI-FAIL-GF-3-10. NC2234.2 +092600 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +092700 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +092800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +092900 TO RE-MARK NC2234.2 +093000 PERFORM FAIL. NC2234.2 +093100 INI-WRITE-GF-3-10. NC2234.2 +093200 PERFORM PRINT-DETAIL. NC2234.2 +093300* NC2234.2 +093400 INI-INIT-GF-4. NC2234.2 +093500 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +093600 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +093700 MOVE 1 TO REC-CT. NC2234.2 +093800 INI-TEST-GF-4-0. NC2234.2 +093900 INITIALIZE TEST-1-DATA NC2234.2 +094000 REPLACING ALPHANUMERIC-EDITED BY "DDDDDD". NC2234.2 +094100 GO TO INI-TEST-GF-4-1. NC2234.2 +094200 INI-DELETE-GF-4. NC2234.2 +094300 PERFORM DE-LETE. NC2234.2 +094400 PERFORM PRINT-DETAIL. NC2234.2 +094500 GO TO INI-INIT-GF-5. NC2234.2 +094600 INI-TEST-GF-4-1. NC2234.2 +094700 MOVE "INI-TEST-GF-4-1" TO PAR-NAME. NC2234.2 +094800 IF TEST-1-4 = "DD DD/DD" NC2234.2 +094900 PERFORM PASS NC2234.2 +095000 GO TO INI-WRITE-GF-4-1 NC2234.2 +095100 ELSE NC2234.2 +095200 GO TO INI-FAIL-GF-4-1. NC2234.2 +095300 INI-DELETE-GF-4-1. NC2234.2 +095400 PERFORM DE-LETE. NC2234.2 +095500 GO TO INI-WRITE-GF-4-1. NC2234.2 +095600 INI-FAIL-GF-4-1. NC2234.2 +095700 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +095800 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +095900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +096000 PERFORM FAIL. NC2234.2 +096100 INI-WRITE-GF-4-1. NC2234.2 +096200 PERFORM PRINT-DETAIL. NC2234.2 +096300* NC2234.2 +096400 INI-TEST-GF-4-2. NC2234.2 +096500 ADD 1 TO REC-CT. NC2234.2 +096600 MOVE "INI-TEST-GF-4-2" TO PAR-NAME. NC2234.2 +096700 IF TEST-1-9 = "DD DD/DD" NC2234.2 +096800 PERFORM PASS NC2234.2 +096900 GO TO INI-WRITE-GF-4-2 NC2234.2 +097000 ELSE NC2234.2 +097100 GO TO INI-FAIL-GF-4-2. NC2234.2 +097200 INI-DELETE-GF-4-2. NC2234.2 +097300 PERFORM DE-LETE. NC2234.2 +097400 GO TO INI-WRITE-GF-4-2. NC2234.2 +097500 INI-FAIL-GF-4-2. NC2234.2 +097600 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +097700 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +097800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +097900 PERFORM FAIL. NC2234.2 +098000 INI-WRITE-GF-4-2. NC2234.2 +098100 PERFORM PRINT-DETAIL. NC2234.2 +098200* NC2234.2 +098300 INI-TEST-GF-4-3. NC2234.2 +098400 ADD 1 TO REC-CT. NC2234.2 +098500 MOVE "INI-TEST-GF-4-3" TO PAR-NAME. NC2234.2 +098600 IF TEST-1-1 = ZERO NC2234.2 +098700 PERFORM PASS NC2234.2 +098800 GO TO INI-WRITE-GF-4-3 NC2234.2 +098900 ELSE NC2234.2 +099000 GO TO INI-FAIL-GF-4-3. NC2234.2 +099100 INI-DELETE-GF-4-3. NC2234.2 +099200 PERFORM DE-LETE. NC2234.2 +099300 GO TO INI-WRITE-GF-4-3. NC2234.2 +099400 INI-FAIL-GF-4-3. NC2234.2 +099500 MOVE ZERO TO CORRECT-N NC2234.2 +099600 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +099700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +099800 TO RE-MARK NC2234.2 +099900 PERFORM FAIL. NC2234.2 +100000 INI-WRITE-GF-4-3. NC2234.2 +100100 PERFORM PRINT-DETAIL. NC2234.2 +100200* NC2234.2 +100300 INI-TEST-GF-4-4. NC2234.2 +100400 ADD 1 TO REC-CT. NC2234.2 +100500 MOVE "INI-TEST-GF-4-4" TO PAR-NAME. NC2234.2 +100600 IF TEST-1-2 = " $0.00" NC2234.2 +100700 PERFORM PASS NC2234.2 +100800 GO TO INI-WRITE-GF-4-4 NC2234.2 +100900 ELSE NC2234.2 +101000 GO TO INI-FAIL-GF-4-4. NC2234.2 +101100 INI-DELETE-GF-4-4. NC2234.2 +101200 PERFORM DE-LETE. NC2234.2 +101300 GO TO INI-WRITE-GF-4-4. NC2234.2 +101400 INI-FAIL-GF-4-4. NC2234.2 +101500 MOVE " $0.00" TO CORRECT-X NC2234.2 +101600 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +101700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +101800 TO RE-MARK NC2234.2 +101900 PERFORM FAIL. NC2234.2 +102000 INI-WRITE-GF-4-4. NC2234.2 +102100 PERFORM PRINT-DETAIL. NC2234.2 +102200* NC2234.2 +102300 INI-TEST-GF-4-5. NC2234.2 +102400 ADD 1 TO REC-CT. NC2234.2 +102500 MOVE "INI-TEST-GF-4-5" TO PAR-NAME. NC2234.2 +102600 IF TEST-1-3 = "**********" NC2234.2 +102700 PERFORM PASS NC2234.2 +102800 GO TO INI-WRITE-GF-4-5 NC2234.2 +102900 ELSE NC2234.2 +103000 GO TO INI-FAIL-GF-4-5. NC2234.2 +103100 INI-DELETE-GF-4-5. NC2234.2 +103200 PERFORM DE-LETE. NC2234.2 +103300 GO TO INI-WRITE-GF-4-5. NC2234.2 +103400 INI-FAIL-GF-4-5. NC2234.2 +103500 MOVE "**********" TO CORRECT-X NC2234.2 +103600 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +103700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +103800 TO RE-MARK NC2234.2 +103900 PERFORM FAIL. NC2234.2 +104000 INI-WRITE-GF-4-5. NC2234.2 +104100 PERFORM PRINT-DETAIL. NC2234.2 +104200* NC2234.2 +104300 INI-TEST-GF-4-6. NC2234.2 +104400 ADD 1 TO REC-CT. NC2234.2 +104500 MOVE "INI-TEST-GF-4-6" TO PAR-NAME. NC2234.2 +104600 IF TEST-1-5 = "AAAAAA" NC2234.2 +104700 PERFORM PASS NC2234.2 +104800 GO TO INI-WRITE-GF-4-6 NC2234.2 +104900 ELSE NC2234.2 +105000 GO TO INI-FAIL-GF-4-6. NC2234.2 +105100 INI-DELETE-GF-4-6. NC2234.2 +105200 PERFORM DE-LETE. NC2234.2 +105300 GO TO INI-WRITE-GF-4-6. NC2234.2 +105400 INI-FAIL-GF-4-6. NC2234.2 +105500 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +105600 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +105700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +105800 TO RE-MARK NC2234.2 +105900 PERFORM FAIL. NC2234.2 +106000 INI-WRITE-GF-4-6. NC2234.2 +106100 PERFORM PRINT-DETAIL. NC2234.2 +106200* NC2234.2 +106300 INI-TEST-GF-4-7. NC2234.2 +106400 ADD 1 TO REC-CT. NC2234.2 +106500 MOVE "INI-TEST-GF-4-7" TO PAR-NAME. NC2234.2 +106600 IF TEST-1-6 = ZERO NC2234.2 +106700 PERFORM PASS NC2234.2 +106800 GO TO INI-WRITE-GF-4-7 NC2234.2 +106900 ELSE NC2234.2 +107000 GO TO INI-FAIL-GF-4-7. NC2234.2 +107100 INI-DELETE-GF-4-7. NC2234.2 +107200 PERFORM DE-LETE. NC2234.2 +107300 GO TO INI-WRITE-GF-4-7. NC2234.2 +107400 INI-FAIL-GF-4-7. NC2234.2 +107500 MOVE ZERO TO CORRECT-N NC2234.2 +107600 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +107700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +107800 TO RE-MARK NC2234.2 +107900 PERFORM FAIL. NC2234.2 +108000 INI-WRITE-GF-4-7. NC2234.2 +108100 PERFORM PRINT-DETAIL. NC2234.2 +108200* NC2234.2 +108300 INI-TEST-GF-4-8. NC2234.2 +108400 ADD 1 TO REC-CT. NC2234.2 +108500 MOVE "INI-TEST-GF-4-8" TO PAR-NAME. NC2234.2 +108600 IF TEST-1-7 = " $0.00" NC2234.2 +108700 PERFORM PASS NC2234.2 +108800 GO TO INI-WRITE-GF-4-8 NC2234.2 +108900 ELSE NC2234.2 +109000 GO TO INI-FAIL-GF-4-8. NC2234.2 +109100 INI-DELETE-GF-4-8. NC2234.2 +109200 PERFORM DE-LETE. NC2234.2 +109300 GO TO INI-WRITE-GF-4-8. NC2234.2 +109400 INI-FAIL-GF-4-8. NC2234.2 +109500 MOVE " $0.00" TO CORRECT-X NC2234.2 +109600 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +109700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +109800 TO RE-MARK NC2234.2 +109900 PERFORM FAIL. NC2234.2 +110000 INI-WRITE-GF-4-8. NC2234.2 +110100 PERFORM PRINT-DETAIL. NC2234.2 +110200* NC2234.2 +110300 INI-TEST-GF-4-9. NC2234.2 +110400 ADD 1 TO REC-CT. NC2234.2 +110500 MOVE "INI-TEST-GF-4-9" TO PAR-NAME. NC2234.2 +110600 IF TEST-1-8 = "**********" NC2234.2 +110700 PERFORM PASS NC2234.2 +110800 GO TO INI-WRITE-GF-4-9 NC2234.2 +110900 ELSE NC2234.2 +111000 GO TO INI-FAIL-GF-4-9. NC2234.2 +111100 INI-DELETE-GF-4-9. NC2234.2 +111200 PERFORM DE-LETE. NC2234.2 +111300 GO TO INI-WRITE-GF-4-9. NC2234.2 +111400 INI-FAIL-GF-4-9. NC2234.2 +111500 MOVE "**********" TO CORRECT-X NC2234.2 +111600 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +111700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +111800 TO RE-MARK NC2234.2 +111900 PERFORM FAIL. NC2234.2 +112000 INI-WRITE-GF-4-9. NC2234.2 +112100 PERFORM PRINT-DETAIL. NC2234.2 +112200* NC2234.2 +112300 INI-TEST-GF-4-10. NC2234.2 +112400 ADD 1 TO REC-CT. NC2234.2 +112500 MOVE "INI-TEST-GF-4-10" TO PAR-NAME. NC2234.2 +112600 IF TEST-1-10 = "AAAAAA" NC2234.2 +112700 PERFORM PASS NC2234.2 +112800 GO TO INI-WRITE-GF-4-10 NC2234.2 +112900 ELSE NC2234.2 +113000 GO TO INI-FAIL-GF-4-10. NC2234.2 +113100 INI-DELETE-GF-4-10. NC2234.2 +113200 PERFORM DE-LETE. NC2234.2 +113300 GO TO INI-WRITE-GF-4-10. NC2234.2 +113400 INI-FAIL-GF-4-10. NC2234.2 +113500 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +113600 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +113700 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +113800 TO RE-MARK NC2234.2 +113900 PERFORM FAIL. NC2234.2 +114000 INI-WRITE-GF-4-10. NC2234.2 +114100 PERFORM PRINT-DETAIL. NC2234.2 +114200* NC2234.2 +114300 INI-INIT-GF-5. NC2234.2 +114400 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +114500 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +114600 MOVE 1 TO REC-CT. NC2234.2 +114700 INI-TEST-GF-5-0. NC2234.2 +114800 INITIALIZE TEST-1-DATA NC2234.2 +114900 REPLACING NUMERIC DATA BY 1234. NC2234.2 +115000 GO TO INI-TEST-GF-5-1. NC2234.2 +115100 INI-DELETE-GF-5. NC2234.2 +115200 PERFORM DE-LETE. NC2234.2 +115300 PERFORM PRINT-DETAIL. NC2234.2 +115400 GO TO INI-INIT-GF-6. NC2234.2 +115500 INI-TEST-GF-5-1. NC2234.2 +115600 MOVE "INI-TEST-GF-5-1" TO PAR-NAME. NC2234.2 +115700 IF TEST-1-1 = 001234 NC2234.2 +115800 PERFORM PASS NC2234.2 +115900 GO TO INI-WRITE-GF-5-1 NC2234.2 +116000 ELSE NC2234.2 +116100 GO TO INI-FAIL-GF-5-1. NC2234.2 +116200 INI-DELETE-GF-5-1. NC2234.2 +116300 PERFORM DE-LETE. NC2234.2 +116400 GO TO INI-WRITE-GF-5-1. NC2234.2 +116500 INI-FAIL-GF-5-1. NC2234.2 +116600 MOVE 001234 TO CORRECT-N NC2234.2 +116700 MOVE TEST-1-1 TO COMPUTED-N NC2234.2 +116800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +116900 PERFORM FAIL. NC2234.2 +117000 INI-WRITE-GF-5-1. NC2234.2 +117100 PERFORM PRINT-DETAIL. NC2234.2 +117200* NC2234.2 +117300 INI-TEST-GF-5-2. NC2234.2 +117400 ADD 1 TO REC-CT. NC2234.2 +117500 MOVE "INI-TEST-GF-5-2" TO PAR-NAME. NC2234.2 +117600 IF TEST-1-6 = 001234 NC2234.2 +117700 PERFORM PASS NC2234.2 +117800 GO TO INI-WRITE-GF-5-2 NC2234.2 +117900 ELSE NC2234.2 +118000 GO TO INI-FAIL-GF-5-2. NC2234.2 +118100 INI-DELETE-GF-5-2. NC2234.2 +118200 PERFORM DE-LETE. NC2234.2 +118300 GO TO INI-WRITE-GF-5-2. NC2234.2 +118400 INI-FAIL-GF-5-2. NC2234.2 +118500 MOVE 001234 TO CORRECT-N NC2234.2 +118600 MOVE TEST-1-6 TO COMPUTED-N NC2234.2 +118700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +118800 PERFORM FAIL. NC2234.2 +118900 INI-WRITE-GF-5-2. NC2234.2 +119000 PERFORM PRINT-DETAIL. NC2234.2 +119100* NC2234.2 +119200 INI-TEST-GF-5-3. NC2234.2 +119300 ADD 1 TO REC-CT. NC2234.2 +119400 MOVE "INI-TEST-GF-5-3" TO PAR-NAME. NC2234.2 +119500 IF TEST-1-2 = " $0.00" NC2234.2 +119600 PERFORM PASS NC2234.2 +119700 GO TO INI-WRITE-GF-5-3 NC2234.2 +119800 ELSE NC2234.2 +119900 GO TO INI-FAIL-GF-5-3. NC2234.2 +120000 INI-DELETE-GF-5-3. NC2234.2 +120100 PERFORM DE-LETE. NC2234.2 +120200 GO TO INI-WRITE-GF-5-3. NC2234.2 +120300 INI-FAIL-GF-5-3. NC2234.2 +120400 MOVE " $0.00" TO CORRECT-X NC2234.2 +120500 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +120600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +120700 TO RE-MARK NC2234.2 +120800 PERFORM FAIL. NC2234.2 +120900 INI-WRITE-GF-5-3. NC2234.2 +121000 PERFORM PRINT-DETAIL. NC2234.2 +121100* NC2234.2 +121200 INI-TEST-GF-5-4. NC2234.2 +121300 ADD 1 TO REC-CT. NC2234.2 +121400 MOVE "INI-TEST-GF-5-4" TO PAR-NAME. NC2234.2 +121500 IF TEST-1-3 = "**********" NC2234.2 +121600 PERFORM PASS NC2234.2 +121700 GO TO INI-WRITE-GF-5-4 NC2234.2 +121800 ELSE NC2234.2 +121900 GO TO INI-FAIL-GF-5-4. NC2234.2 +122000 INI-DELETE-GF-5-4. NC2234.2 +122100 PERFORM DE-LETE. NC2234.2 +122200 GO TO INI-WRITE-GF-5-4. NC2234.2 +122300 INI-FAIL-GF-5-4. NC2234.2 +122400 MOVE "**********" TO CORRECT-X NC2234.2 +122500 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +122600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +122700 TO RE-MARK NC2234.2 +122800 PERFORM FAIL. NC2234.2 +122900 INI-WRITE-GF-5-4. NC2234.2 +123000 PERFORM PRINT-DETAIL. NC2234.2 +123100* NC2234.2 +123200 INI-TEST-GF-5-5. NC2234.2 +123300 ADD 1 TO REC-CT. NC2234.2 +123400 MOVE "INI-TEST-GF-5-5" TO PAR-NAME. NC2234.2 +123500 IF TEST-1-4 = "DD DD/DD" NC2234.2 +123600 PERFORM PASS NC2234.2 +123700 GO TO INI-WRITE-GF-5-5 NC2234.2 +123800 ELSE NC2234.2 +123900 GO TO INI-FAIL-GF-5-5. NC2234.2 +124000 INI-DELETE-GF-5-5. NC2234.2 +124100 PERFORM DE-LETE. NC2234.2 +124200 GO TO INI-WRITE-GF-5-5. NC2234.2 +124300 INI-FAIL-GF-5-5. NC2234.2 +124400 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +124500 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +124600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +124700 TO RE-MARK NC2234.2 +124800 PERFORM FAIL. NC2234.2 +124900 INI-WRITE-GF-5-5. NC2234.2 +125000 PERFORM PRINT-DETAIL. NC2234.2 +125100* NC2234.2 +125200 INI-TEST-GF-5-6. NC2234.2 +125300 ADD 1 TO REC-CT. NC2234.2 +125400 MOVE "INI-TEST-GF-5-6" TO PAR-NAME. NC2234.2 +125500 IF TEST-1-5 = "AAAAAA" NC2234.2 +125600 PERFORM PASS NC2234.2 +125700 GO TO INI-WRITE-GF-5-6 NC2234.2 +125800 ELSE NC2234.2 +125900 GO TO INI-FAIL-GF-5-6. NC2234.2 +126000 INI-DELETE-GF-5-6. NC2234.2 +126100 PERFORM DE-LETE. NC2234.2 +126200 GO TO INI-WRITE-GF-5-6. NC2234.2 +126300 INI-FAIL-GF-5-6. NC2234.2 +126400 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +126500 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +126600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +126700 TO RE-MARK NC2234.2 +126800 PERFORM FAIL. NC2234.2 +126900 INI-WRITE-GF-5-6. NC2234.2 +127000 PERFORM PRINT-DETAIL. NC2234.2 +127100* NC2234.2 +127200 INI-TEST-GF-5-7. NC2234.2 +127300 ADD 1 TO REC-CT. NC2234.2 +127400 MOVE "INI-TEST-GF-5-7" TO PAR-NAME. NC2234.2 +127500 IF TEST-1-7 = " $0.00" NC2234.2 +127600 PERFORM PASS NC2234.2 +127700 GO TO INI-WRITE-GF-5-7 NC2234.2 +127800 ELSE NC2234.2 +127900 GO TO INI-FAIL-GF-5-7. NC2234.2 +128000 INI-DELETE-GF-5-7. NC2234.2 +128100 PERFORM DE-LETE. NC2234.2 +128200 GO TO INI-WRITE-GF-5-7. NC2234.2 +128300 INI-FAIL-GF-5-7. NC2234.2 +128400 MOVE " $0.00" TO CORRECT-X NC2234.2 +128500 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +128600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +128700 TO RE-MARK NC2234.2 +128800 PERFORM FAIL. NC2234.2 +128900 INI-WRITE-GF-5-7. NC2234.2 +129000 PERFORM PRINT-DETAIL. NC2234.2 +129100* NC2234.2 +129200 INI-TEST-GF-5-8. NC2234.2 +129300 ADD 1 TO REC-CT. NC2234.2 +129400 MOVE "INI-TEST-GF-5-8" TO PAR-NAME. NC2234.2 +129500 IF TEST-1-8 = "**********" NC2234.2 +129600 PERFORM PASS NC2234.2 +129700 GO TO INI-WRITE-GF-5-8 NC2234.2 +129800 ELSE NC2234.2 +129900 GO TO INI-FAIL-GF-5-8. NC2234.2 +130000 INI-DELETE-GF-5-8. NC2234.2 +130100 PERFORM DE-LETE. NC2234.2 +130200 GO TO INI-WRITE-GF-5-8. NC2234.2 +130300 INI-FAIL-GF-5-8. NC2234.2 +130400 MOVE "**********" TO CORRECT-X NC2234.2 +130500 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +130600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +130700 TO RE-MARK NC2234.2 +130800 PERFORM FAIL. NC2234.2 +130900 INI-WRITE-GF-5-8. NC2234.2 +131000 PERFORM PRINT-DETAIL. NC2234.2 +131100* NC2234.2 +131200 INI-TEST-GF-5-9. NC2234.2 +131300 ADD 1 TO REC-CT. NC2234.2 +131400 MOVE "INI-TEST-GF-5-9" TO PAR-NAME. NC2234.2 +131500 IF TEST-1-9 = "DD DD/DD" NC2234.2 +131600 PERFORM PASS NC2234.2 +131700 GO TO INI-WRITE-GF-5-9 NC2234.2 +131800 ELSE NC2234.2 +131900 GO TO INI-FAIL-GF-5-9. NC2234.2 +132000 INI-DELETE-GF-5-9. NC2234.2 +132100 PERFORM DE-LETE. NC2234.2 +132200 GO TO INI-WRITE-GF-5-9. NC2234.2 +132300 INI-FAIL-GF-5-9. NC2234.2 +132400 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +132500 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +132600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +132700 TO RE-MARK NC2234.2 +132800 PERFORM FAIL. NC2234.2 +132900 INI-WRITE-GF-5-9. NC2234.2 +133000 PERFORM PRINT-DETAIL. NC2234.2 +133100* NC2234.2 +133200 INI-TEST-GF-5-10. NC2234.2 +133300 ADD 1 TO REC-CT. NC2234.2 +133400 MOVE "INI-TEST-GF-5-10" TO PAR-NAME. NC2234.2 +133500 IF TEST-1-10 = "AAAAAA" NC2234.2 +133600 PERFORM PASS NC2234.2 +133700 GO TO INI-WRITE-GF-5-10 NC2234.2 +133800 ELSE NC2234.2 +133900 GO TO INI-FAIL-GF-5-10. NC2234.2 +134000 INI-DELETE-GF-5-10. NC2234.2 +134100 PERFORM DE-LETE. NC2234.2 +134200 GO TO INI-WRITE-GF-5-10. NC2234.2 +134300 INI-FAIL-GF-5-10. NC2234.2 +134400 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +134500 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +134600 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +134700 TO RE-MARK NC2234.2 +134800 PERFORM FAIL. NC2234.2 +134900 INI-WRITE-GF-5-10. NC2234.2 +135000 PERFORM PRINT-DETAIL. NC2234.2 +135100* NC2234.2 +135200 INI-INIT-GF-6. NC2234.2 +135300 MOVE "VI-91/2 6.16.2 GR2" TO ANSI-REFERENCE. NC2234.2 +135400 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +135500 MOVE 1 TO REC-CT. NC2234.2 +135600 INI-TEST-GF-6-0. NC2234.2 +135700 INITIALIZE TEST-1-DATA NC2234.2 +135800 REPLACING NUMERIC-EDITED DATA BY NUM-1234. NC2234.2 +135900 GO TO INI-TEST-GF-6-1. NC2234.2 +136000 INI-DELETE-GF-6. NC2234.2 +136100 PERFORM DE-LETE. NC2234.2 +136200 PERFORM PRINT-DETAIL. NC2234.2 +136300 GO TO INI-INIT-GF-7. NC2234.2 +136400 INI-TEST-GF-6-1. NC2234.2 +136500 MOVE "INI-TEST-GF-6-1" TO PAR-NAME. NC2234.2 +136600 IF TEST-1-2 = "$234.00" NC2234.2 +136700 PERFORM PASS NC2234.2 +136800 GO TO INI-WRITE-GF-6-1 NC2234.2 +136900 ELSE NC2234.2 +137000 GO TO INI-FAIL-GF-6-1. NC2234.2 +137100 INI-DELETE-GF-6-1. NC2234.2 +137200 PERFORM DE-LETE. NC2234.2 +137300 GO TO INI-WRITE-GF-6-1. NC2234.2 +137400 INI-FAIL-GF-6-1. NC2234.2 +137500 MOVE "$234.00" TO CORRECT-X NC2234.2 +137600 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +137700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +137800 PERFORM FAIL. NC2234.2 +137900 INI-WRITE-GF-6-1. NC2234.2 +138000 PERFORM PRINT-DETAIL. NC2234.2 +138100* NC2234.2 +138200 INI-TEST-GF-6-2. NC2234.2 +138300 ADD 1 TO REC-CT. NC2234.2 +138400 MOVE "INI-TEST-GF-6-2" TO PAR-NAME. NC2234.2 +138500 IF TEST-1-7 = "$234.00" NC2234.2 +138600 PERFORM PASS NC2234.2 +138700 GO TO INI-WRITE-GF-6-2 NC2234.2 +138800 ELSE NC2234.2 +138900 GO TO INI-FAIL-GF-6-2. NC2234.2 +139000 INI-DELETE-GF-6-2. NC2234.2 +139100 PERFORM DE-LETE. NC2234.2 +139200 GO TO INI-WRITE-GF-6-2. NC2234.2 +139300 INI-FAIL-GF-6-2. NC2234.2 +139400 MOVE "$234.00" TO CORRECT-X NC2234.2 +139500 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +139600 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +139700 PERFORM FAIL. NC2234.2 +139800 INI-WRITE-GF-6-2. NC2234.2 +139900 PERFORM PRINT-DETAIL. NC2234.2 +140000* NC2234.2 +140100 INI-TEST-GF-6-3. NC2234.2 +140200 ADD 1 TO REC-CT. NC2234.2 +140300 MOVE "INI-TEST-GF-6-3" TO PAR-NAME. NC2234.2 +140400 IF TEST-1-1 = 001234 NC2234.2 +140500 PERFORM PASS NC2234.2 +140600 GO TO INI-WRITE-GF-6-3 NC2234.2 +140700 ELSE NC2234.2 +140800 GO TO INI-FAIL-GF-6-3. NC2234.2 +140900 INI-DELETE-GF-6-3. NC2234.2 +141000 PERFORM DE-LETE. NC2234.2 +141100 GO TO INI-WRITE-GF-6-3. NC2234.2 +141200 INI-FAIL-GF-6-3. NC2234.2 +141300 MOVE 001234 TO CORRECT-N NC2234.2 +141400 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +141500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +141600 TO RE-MARK NC2234.2 +141700 PERFORM FAIL. NC2234.2 +141800 INI-WRITE-GF-6-3. NC2234.2 +141900 PERFORM PRINT-DETAIL. NC2234.2 +142000* NC2234.2 +142100 INI-TEST-GF-6-4. NC2234.2 +142200 ADD 1 TO REC-CT. NC2234.2 +142300 MOVE "INI-TEST-GF-6-4" TO PAR-NAME. NC2234.2 +142400 IF TEST-1-3 = "**********" NC2234.2 +142500 PERFORM PASS NC2234.2 +142600 GO TO INI-WRITE-GF-6-4 NC2234.2 +142700 ELSE NC2234.2 +142800 GO TO INI-FAIL-GF-6-4. NC2234.2 +142900 INI-DELETE-GF-6-4. NC2234.2 +143000 PERFORM DE-LETE. NC2234.2 +143100 GO TO INI-WRITE-GF-6-4. NC2234.2 +143200 INI-FAIL-GF-6-4. NC2234.2 +143300 MOVE "**********" TO CORRECT-X NC2234.2 +143400 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +143500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +143600 TO RE-MARK NC2234.2 +143700 PERFORM FAIL. NC2234.2 +143800 INI-WRITE-GF-6-4. NC2234.2 +143900 PERFORM PRINT-DETAIL. NC2234.2 +144000* NC2234.2 +144100 INI-TEST-GF-6-5. NC2234.2 +144200 ADD 1 TO REC-CT. NC2234.2 +144300 MOVE "INI-TEST-GF-6-5" TO PAR-NAME. NC2234.2 +144400 IF TEST-1-4 = "DD DD/DD" NC2234.2 +144500 PERFORM PASS NC2234.2 +144600 GO TO INI-WRITE-GF-6-5 NC2234.2 +144700 ELSE NC2234.2 +144800 GO TO INI-FAIL-GF-6-5. NC2234.2 +144900 INI-DELETE-GF-6-5. NC2234.2 +145000 PERFORM DE-LETE. NC2234.2 +145100 GO TO INI-WRITE-GF-6-5. NC2234.2 +145200 INI-FAIL-GF-6-5. NC2234.2 +145300 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +145400 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +145500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +145600 TO RE-MARK NC2234.2 +145700 PERFORM FAIL. NC2234.2 +145800 INI-WRITE-GF-6-5. NC2234.2 +145900 PERFORM PRINT-DETAIL. NC2234.2 +146000* NC2234.2 +146100 INI-TEST-GF-6-6. NC2234.2 +146200 ADD 1 TO REC-CT. NC2234.2 +146300 MOVE "INI-TEST-GF-6-6" TO PAR-NAME. NC2234.2 +146400 IF TEST-1-5 = "AAAAAA" NC2234.2 +146500 PERFORM PASS NC2234.2 +146600 GO TO INI-WRITE-GF-6-6 NC2234.2 +146700 ELSE NC2234.2 +146800 GO TO INI-FAIL-GF-6-6. NC2234.2 +146900 INI-DELETE-GF-6-6. NC2234.2 +147000 PERFORM DE-LETE. NC2234.2 +147100 GO TO INI-WRITE-GF-6-6. NC2234.2 +147200 INI-FAIL-GF-6-6. NC2234.2 +147300 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +147400 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +147500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +147600 TO RE-MARK NC2234.2 +147700 PERFORM FAIL. NC2234.2 +147800 INI-WRITE-GF-6-6. NC2234.2 +147900 PERFORM PRINT-DETAIL. NC2234.2 +148000* NC2234.2 +148100 INI-TEST-GF-6-7. NC2234.2 +148200 ADD 1 TO REC-CT. NC2234.2 +148300 MOVE "INI-TEST-GF-6-7" TO PAR-NAME. NC2234.2 +148400 IF TEST-1-6 = 1234 NC2234.2 +148500 PERFORM PASS NC2234.2 +148600 GO TO INI-WRITE-GF-6-7 NC2234.2 +148700 ELSE NC2234.2 +148800 GO TO INI-FAIL-GF-6-7. NC2234.2 +148900 INI-DELETE-GF-6-7. NC2234.2 +149000 PERFORM DE-LETE. NC2234.2 +149100 GO TO INI-WRITE-GF-6-7. NC2234.2 +149200 INI-FAIL-GF-6-7. NC2234.2 +149300 MOVE 1234 TO CORRECT-N NC2234.2 +149400 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +149500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +149600 TO RE-MARK NC2234.2 +149700 PERFORM FAIL. NC2234.2 +149800 INI-WRITE-GF-6-7. NC2234.2 +149900 PERFORM PRINT-DETAIL. NC2234.2 +150000* NC2234.2 +150100 INI-TEST-GF-6-8. NC2234.2 +150200 ADD 1 TO REC-CT. NC2234.2 +150300 MOVE "INI-TEST-GF-6-8" TO PAR-NAME. NC2234.2 +150400 IF TEST-1-8 = "**********" NC2234.2 +150500 PERFORM PASS NC2234.2 +150600 GO TO INI-WRITE-GF-6-8 NC2234.2 +150700 ELSE NC2234.2 +150800 GO TO INI-FAIL-GF-6-8. NC2234.2 +150900 INI-DELETE-GF-6-8. NC2234.2 +151000 PERFORM DE-LETE. NC2234.2 +151100 GO TO INI-WRITE-GF-6-8. NC2234.2 +151200 INI-FAIL-GF-6-8. NC2234.2 +151300 MOVE "**********" TO CORRECT-X NC2234.2 +151400 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +151500 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +151600 TO RE-MARK NC2234.2 +151700 PERFORM FAIL. NC2234.2 +151800 INI-WRITE-GF-6-8. NC2234.2 +151900 PERFORM PRINT-DETAIL. NC2234.2 +152000* NC2234.2 +152100 INI-TEST-GF-6-9. NC2234.2 +152200 ADD 1 TO REC-CT. NC2234.2 +152300 MOVE "INI-TEST-GF-6-9" TO PAR-NAME. NC2234.2 +152400 IF TEST-1-9 = "DD DD/DD" NC2234.2 +152500 PERFORM PASS NC2234.2 +152600 GO TO INI-WRITE-GF-6-9 NC2234.2 +152700 ELSE NC2234.2 +152800 GO TO INI-FAIL-GF-6-9. NC2234.2 +152900 INI-DELETE-GF-6-9. NC2234.2 +153000 PERFORM DE-LETE. NC2234.2 +153100 GO TO INI-WRITE-GF-6-9. NC2234.2 +153200 INI-FAIL-GF-6-9. NC2234.2 +153300 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +153400 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +153500 TO RE-MARK NC2234.2 +153600 PERFORM FAIL. NC2234.2 +153700 INI-WRITE-GF-6-9. NC2234.2 +153800 PERFORM PRINT-DETAIL. NC2234.2 +153900* NC2234.2 +154000 INI-TEST-GF-6-10. NC2234.2 +154100 ADD 1 TO REC-CT. NC2234.2 +154200 MOVE "INI-TEST-GF-6-10" TO PAR-NAME. NC2234.2 +154300 IF TEST-1-10 = "AAAAAA" NC2234.2 +154400 PERFORM PASS NC2234.2 +154500 GO TO INI-WRITE-GF-6-10 NC2234.2 +154600 ELSE NC2234.2 +154700 GO TO INI-FAIL-GF-6-10. NC2234.2 +154800 INI-DELETE-GF-6-10. NC2234.2 +154900 PERFORM DE-LETE. NC2234.2 +155000 GO TO INI-WRITE-GF-6-10. NC2234.2 +155100 INI-FAIL-GF-6-10. NC2234.2 +155200 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +155300 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +155400 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +155500 TO RE-MARK NC2234.2 +155600 PERFORM FAIL. NC2234.2 +155700 INI-WRITE-GF-6-10. NC2234.2 +155800 PERFORM PRINT-DETAIL. NC2234.2 +155900* NC2234.2 +156000 INI-INIT-GF-7. NC2234.2 +156100* ===--> MULTIPLE "REPLACING" PHRASES" <--=== NC2234.2 +156200 MOVE "VI-91 6.16.2" TO ANSI-REFERENCE. NC2234.2 +156300 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +156400 MOVE 1 TO REC-CT. NC2234.2 +156500 MOVE ZEROS TO TEST-1-1. NC2234.2 +156600 MOVE ZEROS TO TEST-1-2. NC2234.2 +156700 MOVE SPACES TO TEST-1-3. NC2234.2 +156800 MOVE SPACES TO TEST-1-4. NC2234.2 +156900 MOVE SPACES TO TEST-1-5. NC2234.2 +157000 MOVE ZEROS TO TEST-1-6. NC2234.2 +157100 MOVE ZEROS TO TEST-1-7. NC2234.2 +157200 MOVE SPACES TO TEST-1-8. NC2234.2 +157300 MOVE SPACES TO TEST-1-9. NC2234.2 +157400 MOVE SPACES TO TEST-1-10. NC2234.2 +157500 INI-TEST-GF-7-0. NC2234.2 +157600 INITIALIZE TEST-1-DATA NC2234.2 +157700 REPLACING ALPHABETIC DATA BY "AAAAAA" NC2234.2 +157800 ALPHANUMERIC BY "**********" NC2234.2 +157900 ALPHANUMERIC-EDITED BY "DDDDDD" NC2234.2 +158000 NUMERIC DATA BY 1234 NC2234.2 +158100 NUMERIC-EDITED BY NUM-1234. NC2234.2 +158200 GO TO INI-TEST-GF-7-1. NC2234.2 +158300 INI-DELETE-GF-7. NC2234.2 +158400 PERFORM DE-LETE. NC2234.2 +158500 PERFORM PRINT-DETAIL. NC2234.2 +158600 GO TO INI-INIT-GF-8. NC2234.2 +158700 INI-TEST-GF-7-1. NC2234.2 +158800 MOVE "INI-TEST-GF-7-1" TO PAR-NAME. NC2234.2 +158900 IF TEST-1-2 = "$234.00" NC2234.2 +159000 PERFORM PASS NC2234.2 +159100 GO TO INI-WRITE-GF-7-1 NC2234.2 +159200 ELSE NC2234.2 +159300 GO TO INI-FAIL-GF-7-1. NC2234.2 +159400 INI-DELETE-GF-7-1. NC2234.2 +159500 PERFORM DE-LETE. NC2234.2 +159600 GO TO INI-WRITE-GF-7-1. NC2234.2 +159700 INI-FAIL-GF-7-1. NC2234.2 +159800 MOVE "$234.00" TO CORRECT-X NC2234.2 +159900 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +160000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +160100 PERFORM FAIL. NC2234.2 +160200 INI-WRITE-GF-7-1. NC2234.2 +160300 PERFORM PRINT-DETAIL. NC2234.2 +160400* NC2234.2 +160500 INI-TEST-GF-7-2. NC2234.2 +160600 ADD 1 TO REC-CT. NC2234.2 +160700 MOVE "INI-TEST-GF-7-2" TO PAR-NAME. NC2234.2 +160800 IF TEST-1-7 = "$234.00" NC2234.2 +160900 PERFORM PASS NC2234.2 +161000 GO TO INI-WRITE-GF-7-2 NC2234.2 +161100 ELSE NC2234.2 +161200 GO TO INI-FAIL-GF-7-2. NC2234.2 +161300 INI-DELETE-GF-7-2. NC2234.2 +161400 PERFORM DE-LETE. NC2234.2 +161500 GO TO INI-WRITE-GF-7-2. NC2234.2 +161600 INI-FAIL-GF-7-2. NC2234.2 +161700 MOVE "$234.00" TO CORRECT-X NC2234.2 +161800 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +161900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +162000 PERFORM FAIL. NC2234.2 +162100 INI-WRITE-GF-7-2. NC2234.2 +162200 PERFORM PRINT-DETAIL. NC2234.2 +162300* NC2234.2 +162400 INI-TEST-GF-7-3. NC2234.2 +162500 ADD 1 TO REC-CT. NC2234.2 +162600 MOVE "INI-TEST-GF-7-3" TO PAR-NAME. NC2234.2 +162700 IF TEST-1-1 = 001234 NC2234.2 +162800 PERFORM PASS NC2234.2 +162900 GO TO INI-WRITE-GF-7-3 NC2234.2 +163000 ELSE NC2234.2 +163100 GO TO INI-FAIL-GF-7-3. NC2234.2 +163200 INI-DELETE-GF-7-3. NC2234.2 +163300 PERFORM DE-LETE. NC2234.2 +163400 GO TO INI-WRITE-GF-7-3. NC2234.2 +163500 INI-FAIL-GF-7-3. NC2234.2 +163600 MOVE 001234 TO CORRECT-N NC2234.2 +163700 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +163800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +163900 TO RE-MARK NC2234.2 +164000 PERFORM FAIL. NC2234.2 +164100 INI-WRITE-GF-7-3. NC2234.2 +164200 PERFORM PRINT-DETAIL. NC2234.2 +164300* NC2234.2 +164400 INI-TEST-GF-7-4. NC2234.2 +164500 ADD 1 TO REC-CT. NC2234.2 +164600 MOVE "INI-TEST-GF-7-4" TO PAR-NAME. NC2234.2 +164700 IF TEST-1-3 = "**********" NC2234.2 +164800 PERFORM PASS NC2234.2 +164900 GO TO INI-WRITE-GF-7-4 NC2234.2 +165000 ELSE NC2234.2 +165100 GO TO INI-FAIL-GF-7-4. NC2234.2 +165200 INI-DELETE-GF-7-4. NC2234.2 +165300 PERFORM DE-LETE. NC2234.2 +165400 GO TO INI-WRITE-GF-7-4. NC2234.2 +165500 INI-FAIL-GF-7-4. NC2234.2 +165600 MOVE "**********" TO CORRECT-X NC2234.2 +165700 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +165800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +165900 TO RE-MARK NC2234.2 +166000 PERFORM FAIL. NC2234.2 +166100 INI-WRITE-GF-7-4. NC2234.2 +166200 PERFORM PRINT-DETAIL. NC2234.2 +166300* NC2234.2 +166400 INI-TEST-GF-7-5. NC2234.2 +166500 ADD 1 TO REC-CT. NC2234.2 +166600 MOVE "INI-TEST-GF-7-5" TO PAR-NAME. NC2234.2 +166700 IF TEST-1-4 = "DD DD/DD" NC2234.2 +166800 PERFORM PASS NC2234.2 +166900 GO TO INI-WRITE-GF-7-5 NC2234.2 +167000 ELSE NC2234.2 +167100 GO TO INI-FAIL-GF-7-5. NC2234.2 +167200 INI-DELETE-GF-7-5. NC2234.2 +167300 PERFORM DE-LETE. NC2234.2 +167400 GO TO INI-WRITE-GF-7-5. NC2234.2 +167500 INI-FAIL-GF-7-5. NC2234.2 +167600 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +167700 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +167800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +167900 TO RE-MARK NC2234.2 +168000 PERFORM FAIL. NC2234.2 +168100 INI-WRITE-GF-7-5. NC2234.2 +168200 PERFORM PRINT-DETAIL. NC2234.2 +168300* NC2234.2 +168400 INI-TEST-GF-7-6. NC2234.2 +168500 ADD 1 TO REC-CT. NC2234.2 +168600 MOVE "INI-TEST-GF-7-6" TO PAR-NAME. NC2234.2 +168700 IF TEST-1-5 = "AAAAAA" NC2234.2 +168800 PERFORM PASS NC2234.2 +168900 GO TO INI-WRITE-GF-7-6 NC2234.2 +169000 ELSE NC2234.2 +169100 GO TO INI-FAIL-GF-7-6. NC2234.2 +169200 INI-DELETE-GF-7-6. NC2234.2 +169300 PERFORM DE-LETE. NC2234.2 +169400 GO TO INI-WRITE-GF-7-6. NC2234.2 +169500 INI-FAIL-GF-7-6. NC2234.2 +169600 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +169700 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +169800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +169900 TO RE-MARK NC2234.2 +170000 PERFORM FAIL. NC2234.2 +170100 INI-WRITE-GF-7-6. NC2234.2 +170200 PERFORM PRINT-DETAIL. NC2234.2 +170300* NC2234.2 +170400 INI-TEST-GF-7-7. NC2234.2 +170500 ADD 1 TO REC-CT. NC2234.2 +170600 MOVE "INI-TEST-GF-7-7" TO PAR-NAME. NC2234.2 +170700 IF TEST-1-6 = 001234 NC2234.2 +170800 PERFORM PASS NC2234.2 +170900 GO TO INI-WRITE-GF-7-7 NC2234.2 +171000 ELSE NC2234.2 +171100 GO TO INI-FAIL-GF-7-7. NC2234.2 +171200 INI-DELETE-GF-7-7. NC2234.2 +171300 PERFORM DE-LETE. NC2234.2 +171400 GO TO INI-WRITE-GF-7-7. NC2234.2 +171500 INI-FAIL-GF-7-7. NC2234.2 +171600 MOVE ZERO TO CORRECT-N NC2234.2 +171700 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +171800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +171900 TO RE-MARK NC2234.2 +172000 PERFORM FAIL. NC2234.2 +172100 INI-WRITE-GF-7-7. NC2234.2 +172200 PERFORM PRINT-DETAIL. NC2234.2 +172300* NC2234.2 +172400 INI-TEST-GF-7-8. NC2234.2 +172500 ADD 1 TO REC-CT. NC2234.2 +172600 MOVE "INI-TEST-GF-7-8" TO PAR-NAME. NC2234.2 +172700 IF TEST-1-8 = "**********" NC2234.2 +172800 PERFORM PASS NC2234.2 +172900 GO TO INI-WRITE-GF-7-8 NC2234.2 +173000 ELSE NC2234.2 +173100 GO TO INI-FAIL-GF-7-8. NC2234.2 +173200 INI-DELETE-GF-7-8. NC2234.2 +173300 PERFORM DE-LETE. NC2234.2 +173400 GO TO INI-WRITE-GF-7-8. NC2234.2 +173500 INI-FAIL-GF-7-8. NC2234.2 +173600 MOVE "**********" TO CORRECT-X NC2234.2 +173700 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +173800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +173900 TO RE-MARK NC2234.2 +174000 PERFORM FAIL. NC2234.2 +174100 INI-WRITE-GF-7-8. NC2234.2 +174200 PERFORM PRINT-DETAIL. NC2234.2 +174300* NC2234.2 +174400 INI-TEST-GF-7-9. NC2234.2 +174500 ADD 1 TO REC-CT. NC2234.2 +174600 MOVE "INI-TEST-GF-7-9" TO PAR-NAME. NC2234.2 +174700 IF TEST-1-9 = "DD DD/DD" NC2234.2 +174800 PERFORM PASS NC2234.2 +174900 GO TO INI-WRITE-GF-7-9 NC2234.2 +175000 ELSE NC2234.2 +175100 GO TO INI-FAIL-GF-7-9. NC2234.2 +175200 INI-DELETE-GF-7-9. NC2234.2 +175300 PERFORM DE-LETE. NC2234.2 +175400 GO TO INI-WRITE-GF-7-9. NC2234.2 +175500 INI-FAIL-GF-7-9. NC2234.2 +175600 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +175700 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +175800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +175900 TO RE-MARK NC2234.2 +176000 PERFORM FAIL. NC2234.2 +176100 INI-WRITE-GF-7-9. NC2234.2 +176200 PERFORM PRINT-DETAIL. NC2234.2 +176300* NC2234.2 +176400 INI-TEST-GF-7-10. NC2234.2 +176500 ADD 1 TO REC-CT. NC2234.2 +176600 MOVE "INI-TEST-GF-7-10" TO PAR-NAME. NC2234.2 +176700 IF TEST-1-10 = "AAAAAA" NC2234.2 +176800 PERFORM PASS NC2234.2 +176900 GO TO INI-WRITE-GF-7-10 NC2234.2 +177000 ELSE NC2234.2 +177100 GO TO INI-FAIL-GF-7-10. NC2234.2 +177200 INI-DELETE-GF-7-10. NC2234.2 +177300 PERFORM DE-LETE. NC2234.2 +177400 GO TO INI-WRITE-GF-7-10. NC2234.2 +177500 INI-FAIL-GF-7-10. NC2234.2 +177600 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +177700 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +177800 MOVE "WRONGLY AFFECTED BY OTHER INITIALISATION" NC2234.2 +177900 TO RE-MARK NC2234.2 +178000 PERFORM FAIL. NC2234.2 +178100 INI-WRITE-GF-7-10. NC2234.2 +178200 PERFORM PRINT-DETAIL. NC2234.2 +178300* NC2234.2 +178400 INI-INIT-GF-8. NC2234.2 +178500* ===--> MULTIPLE RECEIVING AREAS <--=== NC2234.2 +178600 MOVE "VI-91 6.16.4 GR2" TO ANSI-REFERENCE. NC2234.2 +178700 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +178800 MOVE 1 TO REC-CT. NC2234.2 +178900 MOVE LOW-VALUES TO TEST-1-DATA. NC2234.2 +179000 MOVE 999.99 TO TEST-8-DATA-1. NC2234.2 +179100 MOVE "ZZZZZZZZZZ" TO TEST-8-DATA-2. NC2234.2 +179200 INI-TEST-GF-8-0. NC2234.2 +179300 INITIALIZE TEST-8-DATA-1 NC2234.2 +179400 TEST-1-DATA NC2234.2 +179500 TEST-8-DATA-2. NC2234.2 +179600 GO TO INI-TEST-GF-8-1. NC2234.2 +179700 INI-DELETE-GF-8. NC2234.2 +179800 PERFORM DE-LETE. NC2234.2 +179900 PERFORM PRINT-DETAIL. NC2234.2 +180000 GO TO INI-INIT-GF-9. NC2234.2 +180100 INI-TEST-GF-8-1. NC2234.2 +180200 MOVE "INI-TEST-GF-8-1" TO PAR-NAME. NC2234.2 +180300 IF TEST-1-2 = " $0.00" NC2234.2 +180400 PERFORM PASS NC2234.2 +180500 GO TO INI-WRITE-GF-8-1 NC2234.2 +180600 ELSE NC2234.2 +180700 GO TO INI-FAIL-GF-8-1. NC2234.2 +180800 INI-DELETE-GF-8-1. NC2234.2 +180900 PERFORM DE-LETE. NC2234.2 +181000 GO TO INI-WRITE-GF-8-1. NC2234.2 +181100 INI-FAIL-GF-8-1. NC2234.2 +181200 MOVE " $0.00" TO CORRECT-X NC2234.2 +181300 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +181400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +181500 PERFORM FAIL. NC2234.2 +181600 INI-WRITE-GF-8-1. NC2234.2 +181700 PERFORM PRINT-DETAIL. NC2234.2 +181800* NC2234.2 +181900 INI-TEST-GF-8-2. NC2234.2 +182000 ADD 1 TO REC-CT. NC2234.2 +182100 MOVE "INI-TEST-GF-8-2" TO PAR-NAME. NC2234.2 +182200 IF TEST-1-7 = " $0.00" NC2234.2 +182300 PERFORM PASS NC2234.2 +182400 GO TO INI-WRITE-GF-8-2 NC2234.2 +182500 ELSE NC2234.2 +182600 GO TO INI-FAIL-GF-8-2. NC2234.2 +182700 INI-DELETE-GF-8-2. NC2234.2 +182800 PERFORM DE-LETE. NC2234.2 +182900 GO TO INI-WRITE-GF-8-2. NC2234.2 +183000 INI-FAIL-GF-8-2. NC2234.2 +183100 MOVE " $0.00" TO CORRECT-X NC2234.2 +183200 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +183300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +183400 PERFORM FAIL. NC2234.2 +183500 INI-WRITE-GF-8-2. NC2234.2 +183600 PERFORM PRINT-DETAIL. NC2234.2 +183700* NC2234.2 +183800 INI-TEST-GF-8-3. NC2234.2 +183900 ADD 1 TO REC-CT. NC2234.2 +184000 MOVE "INI-TEST-GF-8-3" TO PAR-NAME. NC2234.2 +184100 IF TEST-1-1 = ZERO NC2234.2 +184200 PERFORM PASS NC2234.2 +184300 GO TO INI-WRITE-GF-8-3 NC2234.2 +184400 ELSE NC2234.2 +184500 GO TO INI-FAIL-GF-8-3. NC2234.2 +184600 INI-DELETE-GF-8-3. NC2234.2 +184700 PERFORM DE-LETE. NC2234.2 +184800 GO TO INI-WRITE-GF-8-3. NC2234.2 +184900 INI-FAIL-GF-8-3. NC2234.2 +185000 MOVE ZERO TO CORRECT-N NC2234.2 +185100 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +185200 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +185300 PERFORM FAIL. NC2234.2 +185400 INI-WRITE-GF-8-3. NC2234.2 +185500 PERFORM PRINT-DETAIL. NC2234.2 +185600* NC2234.2 +185700 INI-TEST-GF-8-4. NC2234.2 +185800 ADD 1 TO REC-CT. NC2234.2 +185900 MOVE "INI-TEST-GF-8-4" TO PAR-NAME. NC2234.2 +186000 IF TEST-1-3 = SPACES NC2234.2 +186100 PERFORM PASS NC2234.2 +186200 GO TO INI-WRITE-GF-8-4 NC2234.2 +186300 ELSE NC2234.2 +186400 GO TO INI-FAIL-GF-8-4. NC2234.2 +186500 INI-DELETE-GF-8-4. NC2234.2 +186600 PERFORM DE-LETE. NC2234.2 +186700 GO TO INI-WRITE-GF-8-4. NC2234.2 +186800 INI-FAIL-GF-8-4. NC2234.2 +186900 MOVE SPACES TO CORRECT-X NC2234.2 +187000 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +187100 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +187200 PERFORM FAIL. NC2234.2 +187300 INI-WRITE-GF-8-4. NC2234.2 +187400 PERFORM PRINT-DETAIL. NC2234.2 +187500* NC2234.2 +187600 INI-TEST-GF-8-5. NC2234.2 +187700 ADD 1 TO REC-CT. NC2234.2 +187800 MOVE "INI-TEST-GF-8-5" TO PAR-NAME. NC2234.2 +187900 IF TEST-1-4 = " / " NC2234.2 +188000 PERFORM PASS NC2234.2 +188100 GO TO INI-WRITE-GF-8-5 NC2234.2 +188200 ELSE NC2234.2 +188300 GO TO INI-FAIL-GF-8-5. NC2234.2 +188400 INI-DELETE-GF-8-5. NC2234.2 +188500 PERFORM DE-LETE. NC2234.2 +188600 GO TO INI-WRITE-GF-8-5. NC2234.2 +188700 INI-FAIL-GF-8-5. NC2234.2 +188800 MOVE " / " TO CORRECT-X NC2234.2 +188900 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +189000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +189100 PERFORM FAIL. NC2234.2 +189200 INI-WRITE-GF-8-5. NC2234.2 +189300 PERFORM PRINT-DETAIL. NC2234.2 +189400* NC2234.2 +189500 INI-TEST-GF-8-6. NC2234.2 +189600 ADD 1 TO REC-CT. NC2234.2 +189700 MOVE "INI-TEST-GF-8-6" TO PAR-NAME. NC2234.2 +189800 IF TEST-1-5 = SPACES NC2234.2 +189900 PERFORM PASS NC2234.2 +190000 GO TO INI-WRITE-GF-8-6 NC2234.2 +190100 ELSE NC2234.2 +190200 GO TO INI-FAIL-GF-8-6. NC2234.2 +190300 INI-DELETE-GF-8-6. NC2234.2 +190400 PERFORM DE-LETE. NC2234.2 +190500 GO TO INI-WRITE-GF-8-6. NC2234.2 +190600 INI-FAIL-GF-8-6. NC2234.2 +190700 MOVE SPACES TO CORRECT-X NC2234.2 +190800 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +190900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +191000 PERFORM FAIL. NC2234.2 +191100 INI-WRITE-GF-8-6. NC2234.2 +191200 PERFORM PRINT-DETAIL. NC2234.2 +191300* NC2234.2 +191400 INI-TEST-GF-8-7. NC2234.2 +191500 ADD 1 TO REC-CT. NC2234.2 +191600 MOVE "INI-TEST-GF-8-7" TO PAR-NAME. NC2234.2 +191700 IF TEST-1-6 = ZERO NC2234.2 +191800 PERFORM PASS NC2234.2 +191900 GO TO INI-WRITE-GF-8-7 NC2234.2 +192000 ELSE NC2234.2 +192100 GO TO INI-FAIL-GF-8-7. NC2234.2 +192200 INI-DELETE-GF-8-7. NC2234.2 +192300 PERFORM DE-LETE. NC2234.2 +192400 GO TO INI-WRITE-GF-8-7. NC2234.2 +192500 INI-FAIL-GF-8-7. NC2234.2 +192600 MOVE ZERO TO CORRECT-N NC2234.2 +192700 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +192800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +192900 PERFORM FAIL. NC2234.2 +193000 INI-WRITE-GF-8-7. NC2234.2 +193100 PERFORM PRINT-DETAIL. NC2234.2 +193200* NC2234.2 +193300 INI-TEST-GF-8-8. NC2234.2 +193400 ADD 1 TO REC-CT. NC2234.2 +193500 MOVE "INI-TEST-GF-8-8" TO PAR-NAME. NC2234.2 +193600 IF TEST-1-8 = SPACES NC2234.2 +193700 PERFORM PASS NC2234.2 +193800 GO TO INI-WRITE-GF-8-8 NC2234.2 +193900 ELSE NC2234.2 +194000 GO TO INI-FAIL-GF-8-8. NC2234.2 +194100 INI-DELETE-GF-8-8. NC2234.2 +194200 PERFORM DE-LETE. NC2234.2 +194300 GO TO INI-WRITE-GF-8-8. NC2234.2 +194400 INI-FAIL-GF-8-8. NC2234.2 +194500 MOVE SPACES TO CORRECT-X NC2234.2 +194600 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +194700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +194800 PERFORM FAIL. NC2234.2 +194900 INI-WRITE-GF-8-8. NC2234.2 +195000 PERFORM PRINT-DETAIL. NC2234.2 +195100* NC2234.2 +195200 INI-TEST-GF-8-9. NC2234.2 +195300 ADD 1 TO REC-CT. NC2234.2 +195400 MOVE "INI-TEST-GF-8-9" TO PAR-NAME. NC2234.2 +195500 IF TEST-1-9 = " / " NC2234.2 +195600 PERFORM PASS NC2234.2 +195700 GO TO INI-WRITE-GF-8-9 NC2234.2 +195800 ELSE NC2234.2 +195900 GO TO INI-FAIL-GF-8-9. NC2234.2 +196000 INI-DELETE-GF-8-9. NC2234.2 +196100 PERFORM DE-LETE. NC2234.2 +196200 GO TO INI-WRITE-GF-8-9. NC2234.2 +196300 INI-FAIL-GF-8-9. NC2234.2 +196400 MOVE " / " TO CORRECT-X NC2234.2 +196500 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +196600 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +196700 PERFORM FAIL. NC2234.2 +196800 INI-WRITE-GF-8-9. NC2234.2 +196900 PERFORM PRINT-DETAIL. NC2234.2 +197000* NC2234.2 +197100 INI-TEST-GF-8-10. NC2234.2 +197200 ADD 1 TO REC-CT. NC2234.2 +197300 MOVE "INI-TEST-GF-8-10" TO PAR-NAME. NC2234.2 +197400 IF TEST-1-10 = SPACES NC2234.2 +197500 PERFORM PASS NC2234.2 +197600 GO TO INI-WRITE-GF-8-10 NC2234.2 +197700 ELSE NC2234.2 +197800 GO TO INI-FAIL-GF-8-10. NC2234.2 +197900 INI-DELETE-GF-8-10. NC2234.2 +198000 PERFORM DE-LETE. NC2234.2 +198100 GO TO INI-WRITE-GF-8-10. NC2234.2 +198200 INI-FAIL-GF-8-10. NC2234.2 +198300 MOVE SPACES TO CORRECT-X NC2234.2 +198400 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +198500 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +198600 PERFORM FAIL. NC2234.2 +198700 INI-WRITE-GF-8-10. NC2234.2 +198800 PERFORM PRINT-DETAIL. NC2234.2 +198900* NC2234.2 +199000 INI-TEST-GF-8-11. NC2234.2 +199100 ADD 1 TO REC-CT. NC2234.2 +199200 MOVE "INI-TEST-GF-8-11" TO PAR-NAME. NC2234.2 +199300 IF TEST-8-DATA-1 = " $0.00" NC2234.2 +199400 PERFORM PASS NC2234.2 +199500 GO TO INI-WRITE-GF-8-11 NC2234.2 +199600 ELSE NC2234.2 +199700 GO TO INI-FAIL-GF-8-11. NC2234.2 +199800 INI-DELETE-GF-8-11. NC2234.2 +199900 PERFORM DE-LETE. NC2234.2 +200000 GO TO INI-WRITE-GF-8-11. NC2234.2 +200100 INI-FAIL-GF-8-11. NC2234.2 +200200 MOVE " $0.00" TO CORRECT-X NC2234.2 +200300 MOVE TEST-8-DATA-1 TO COMPUTED-X NC2234.2 +200400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +200500 PERFORM FAIL. NC2234.2 +200600 INI-WRITE-GF-8-11. NC2234.2 +200700 PERFORM PRINT-DETAIL. NC2234.2 +200800* NC2234.2 +200900 INI-TEST-GF-8-12. NC2234.2 +201000 ADD 1 TO REC-CT. NC2234.2 +201100 MOVE "INI-TEST-GF-8-12" TO PAR-NAME. NC2234.2 +201200 IF TEST-8-DATA-2 = SPACES NC2234.2 +201300 PERFORM PASS NC2234.2 +201400 GO TO INI-WRITE-GF-8-12 NC2234.2 +201500 ELSE NC2234.2 +201600 GO TO INI-FAIL-GF-8-12. NC2234.2 +201700 INI-DELETE-GF-8-12. NC2234.2 +201800 PERFORM DE-LETE. NC2234.2 +201900 GO TO INI-WRITE-GF-8-12. NC2234.2 +202000 INI-FAIL-GF-8-12. NC2234.2 +202100 MOVE SPACES TO CORRECT-X NC2234.2 +202200 MOVE TEST-8-DATA-2 TO COMPUTED-X NC2234.2 +202300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +202400 PERFORM FAIL. NC2234.2 +202500 INI-WRITE-GF-8-12. NC2234.2 +202600 PERFORM PRINT-DETAIL. NC2234.2 +202700* NC2234.2 +202800 INI-INIT-GF-9. NC2234.2 +202900* ===--> MULTIPLE RECEIVING AREAS AND <--=== NC2234.2 +203000* ===--> MULTIPLE "REPLACING" PHRASES" <--=== NC2234.2 +203100 MOVE "VI-91 6.16.2" TO ANSI-REFERENCE. NC2234.2 +203200 MOVE "INITIALIZE STATEMENT" TO FEATURE. NC2234.2 +203300 MOVE 1 TO REC-CT. NC2234.2 +203400 MOVE ZEROS TO TEST-1-1. NC2234.2 +203500 MOVE ZEROS TO TEST-1-2. NC2234.2 +203600 MOVE SPACES TO TEST-1-3. NC2234.2 +203700 MOVE SPACES TO TEST-1-4. NC2234.2 +203800 MOVE SPACES TO TEST-1-5. NC2234.2 +203900 MOVE ZEROS TO TEST-1-6. NC2234.2 +204000 MOVE ZEROS TO TEST-1-7. NC2234.2 +204100 MOVE SPACES TO TEST-1-8. NC2234.2 +204200 MOVE SPACES TO TEST-1-9. NC2234.2 +204300 MOVE SPACES TO TEST-1-10. NC2234.2 +204400 MOVE 999.99 TO TEST-8-DATA-1. NC2234.2 +204500 MOVE "ZZZZZZZZZZ" TO TEST-8-DATA-2. NC2234.2 +204600 INI-TEST-GF-9-0. NC2234.2 +204700 INITIALIZE NC2234.2 +204800 TEST-8-DATA-1 NC2234.2 +204900 TEST-1-DATA NC2234.2 +205000 TEST-8-DATA-2 NC2234.2 +205100 REPLACING ALPHABETIC DATA BY "AAAAAA" NC2234.2 +205200 ALPHANUMERIC BY "**********" NC2234.2 +205300 ALPHANUMERIC-EDITED BY "DDDDDD" NC2234.2 +205400 NUMERIC DATA BY NUM-1234 NC2234.2 +205500 NUMERIC-EDITED BY 1234. NC2234.2 +205600 GO TO INI-TEST-GF-9-1. NC2234.2 +205700 INI-DELETE-GF-9. NC2234.2 +205800 PERFORM DE-LETE. NC2234.2 +205900 PERFORM PRINT-DETAIL. NC2234.2 +206000 GO TO CCVS-EXIT. NC2234.2 +206100 INI-TEST-GF-9-1. NC2234.2 +206200 MOVE "INI-TEST-GF-9-1" TO PAR-NAME. NC2234.2 +206300 IF TEST-1-2 = "$234.00" NC2234.2 +206400 PERFORM PASS NC2234.2 +206500 GO TO INI-WRITE-GF-9-1 NC2234.2 +206600 ELSE NC2234.2 +206700 GO TO INI-FAIL-GF-9-1. NC2234.2 +206800 INI-DELETE-GF-9-1. NC2234.2 +206900 PERFORM DE-LETE. NC2234.2 +207000 GO TO INI-WRITE-GF-9-1. NC2234.2 +207100 INI-FAIL-GF-9-1. NC2234.2 +207200 MOVE "$234.00" TO CORRECT-X NC2234.2 +207300 MOVE TEST-1-2 TO COMPUTED-X NC2234.2 +207400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +207500 PERFORM FAIL. NC2234.2 +207600 INI-WRITE-GF-9-1. NC2234.2 +207700 PERFORM PRINT-DETAIL. NC2234.2 +207800* NC2234.2 +207900 INI-TEST-GF-9-2. NC2234.2 +208000 ADD 1 TO REC-CT. NC2234.2 +208100 MOVE "INI-TEST-GF-9-2" TO PAR-NAME. NC2234.2 +208200 IF TEST-1-7 = "$234.00" NC2234.2 +208300 PERFORM PASS NC2234.2 +208400 GO TO INI-WRITE-GF-9-2 NC2234.2 +208500 ELSE NC2234.2 +208600 GO TO INI-FAIL-GF-9-2. NC2234.2 +208700 INI-DELETE-GF-9-2. NC2234.2 +208800 PERFORM DE-LETE. NC2234.2 +208900 GO TO INI-WRITE-GF-9-2. NC2234.2 +209000 INI-FAIL-GF-9-2. NC2234.2 +209100 MOVE "$234.00" TO CORRECT-X NC2234.2 +209200 MOVE TEST-1-7 TO COMPUTED-X NC2234.2 +209300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +209400 PERFORM FAIL. NC2234.2 +209500 INI-WRITE-GF-9-2. NC2234.2 +209600 PERFORM PRINT-DETAIL. NC2234.2 +209700* NC2234.2 +209800 INI-TEST-GF-9-3. NC2234.2 +209900 ADD 1 TO REC-CT. NC2234.2 +210000 MOVE "INI-TEST-GF-9-3" TO PAR-NAME. NC2234.2 +210100 IF TEST-1-1 = 001234 NC2234.2 +210200 PERFORM PASS NC2234.2 +210300 GO TO INI-WRITE-GF-9-3 NC2234.2 +210400 ELSE NC2234.2 +210500 GO TO INI-FAIL-GF-9-3. NC2234.2 +210600 INI-DELETE-GF-9-3. NC2234.2 +210700 PERFORM DE-LETE. NC2234.2 +210800 GO TO INI-WRITE-GF-9-3. NC2234.2 +210900 INI-FAIL-GF-9-3. NC2234.2 +211000 MOVE 001234 TO CORRECT-N NC2234.2 +211100 MOVE TEST-1-1 TO COMPUTED-X NC2234.2 +211200 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +211300 PERFORM FAIL. NC2234.2 +211400 INI-WRITE-GF-9-3. NC2234.2 +211500 PERFORM PRINT-DETAIL. NC2234.2 +211600* NC2234.2 +211700 INI-TEST-GF-9-4. NC2234.2 +211800 ADD 1 TO REC-CT. NC2234.2 +211900 MOVE "INI-TEST-GF-9-4" TO PAR-NAME. NC2234.2 +212000 IF TEST-1-3 = "**********" NC2234.2 +212100 PERFORM PASS NC2234.2 +212200 GO TO INI-WRITE-GF-9-4 NC2234.2 +212300 ELSE NC2234.2 +212400 GO TO INI-FAIL-GF-9-4. NC2234.2 +212500 INI-DELETE-GF-9-4. NC2234.2 +212600 PERFORM DE-LETE. NC2234.2 +212700 GO TO INI-WRITE-GF-9-4. NC2234.2 +212800 INI-FAIL-GF-9-4. NC2234.2 +212900 MOVE "**********" TO CORRECT-X NC2234.2 +213000 MOVE TEST-1-3 TO COMPUTED-X NC2234.2 +213100 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +213200 PERFORM FAIL. NC2234.2 +213300 INI-WRITE-GF-9-4. NC2234.2 +213400 PERFORM PRINT-DETAIL. NC2234.2 +213500* NC2234.2 +213600 INI-TEST-GF-9-5. NC2234.2 +213700 ADD 1 TO REC-CT. NC2234.2 +213800 MOVE "INI-TEST-GF-9-5" TO PAR-NAME. NC2234.2 +213900 IF TEST-1-4 = "DD DD/DD" NC2234.2 +214000 PERFORM PASS NC2234.2 +214100 GO TO INI-WRITE-GF-9-5 NC2234.2 +214200 ELSE NC2234.2 +214300 GO TO INI-FAIL-GF-9-5. NC2234.2 +214400 INI-DELETE-GF-9-5. NC2234.2 +214500 PERFORM DE-LETE. NC2234.2 +214600 GO TO INI-WRITE-GF-9-5. NC2234.2 +214700 INI-FAIL-GF-9-5. NC2234.2 +214800 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +214900 MOVE TEST-1-4 TO COMPUTED-X NC2234.2 +215000 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +215100 PERFORM FAIL. NC2234.2 +215200 INI-WRITE-GF-9-5. NC2234.2 +215300 PERFORM PRINT-DETAIL. NC2234.2 +215400* NC2234.2 +215500 INI-TEST-GF-9-6. NC2234.2 +215600 ADD 1 TO REC-CT. NC2234.2 +215700 MOVE "INI-TEST-GF-9-6" TO PAR-NAME. NC2234.2 +215800 IF TEST-1-5 = "AAAAAA" NC2234.2 +215900 PERFORM PASS NC2234.2 +216000 GO TO INI-WRITE-GF-9-6 NC2234.2 +216100 ELSE NC2234.2 +216200 GO TO INI-FAIL-GF-9-6. NC2234.2 +216300 INI-DELETE-GF-9-6. NC2234.2 +216400 PERFORM DE-LETE. NC2234.2 +216500 GO TO INI-WRITE-GF-9-6. NC2234.2 +216600 INI-FAIL-GF-9-6. NC2234.2 +216700 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +216800 MOVE TEST-1-5 TO COMPUTED-X NC2234.2 +216900 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +217000 PERFORM FAIL. NC2234.2 +217100 INI-WRITE-GF-9-6. NC2234.2 +217200 PERFORM PRINT-DETAIL. NC2234.2 +217300* NC2234.2 +217400 INI-TEST-GF-9-7. NC2234.2 +217500 ADD 1 TO REC-CT. NC2234.2 +217600 MOVE "INI-TEST-GF-9-7" TO PAR-NAME. NC2234.2 +217700 IF TEST-1-6 = 1234 NC2234.2 +217800 PERFORM PASS NC2234.2 +217900 GO TO INI-WRITE-GF-9-7 NC2234.2 +218000 ELSE NC2234.2 +218100 GO TO INI-FAIL-GF-9-7. NC2234.2 +218200 INI-DELETE-GF-9-7. NC2234.2 +218300 PERFORM DE-LETE. NC2234.2 +218400 GO TO INI-WRITE-GF-9-7. NC2234.2 +218500 INI-FAIL-GF-9-7. NC2234.2 +218600 MOVE 1234 TO CORRECT-N NC2234.2 +218700 MOVE TEST-1-6 TO COMPUTED-X NC2234.2 +218800 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +218900 PERFORM FAIL. NC2234.2 +219000 INI-WRITE-GF-9-7. NC2234.2 +219100 PERFORM PRINT-DETAIL. NC2234.2 +219200* NC2234.2 +219300 INI-TEST-GF-9-8. NC2234.2 +219400 ADD 1 TO REC-CT. NC2234.2 +219500 MOVE "INI-TEST-GF-9-8" TO PAR-NAME. NC2234.2 +219600 IF TEST-1-8 = "**********" NC2234.2 +219700 PERFORM PASS NC2234.2 +219800 GO TO INI-WRITE-GF-9-8 NC2234.2 +219900 ELSE NC2234.2 +220000 GO TO INI-FAIL-GF-9-8. NC2234.2 +220100 INI-DELETE-GF-9-8. NC2234.2 +220200 PERFORM DE-LETE. NC2234.2 +220300 GO TO INI-WRITE-GF-9-8. NC2234.2 +220400 INI-FAIL-GF-9-8. NC2234.2 +220500 MOVE "**********" TO CORRECT-X NC2234.2 +220600 MOVE TEST-1-8 TO COMPUTED-X NC2234.2 +220700 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +220800 PERFORM FAIL. NC2234.2 +220900 INI-WRITE-GF-9-8. NC2234.2 +221000 PERFORM PRINT-DETAIL. NC2234.2 +221100* NC2234.2 +221200 INI-TEST-GF-9-9. NC2234.2 +221300 ADD 1 TO REC-CT. NC2234.2 +221400 MOVE "INI-TEST-GF-9-9" TO PAR-NAME. NC2234.2 +221500 IF TEST-1-9 = "DD DD/DD" NC2234.2 +221600 PERFORM PASS NC2234.2 +221700 GO TO INI-WRITE-GF-9-9 NC2234.2 +221800 ELSE NC2234.2 +221900 GO TO INI-FAIL-GF-9-9. NC2234.2 +222000 INI-DELETE-GF-9-9. NC2234.2 +222100 PERFORM DE-LETE. NC2234.2 +222200 GO TO INI-WRITE-GF-9-9. NC2234.2 +222300 INI-FAIL-GF-9-9. NC2234.2 +222400 MOVE "DD DD/DD" TO CORRECT-X NC2234.2 +222500 MOVE TEST-1-9 TO COMPUTED-X NC2234.2 +222600 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +222700 PERFORM FAIL. NC2234.2 +222800 INI-WRITE-GF-9-9. NC2234.2 +222900 PERFORM PRINT-DETAIL. NC2234.2 +223000* NC2234.2 +223100 INI-TEST-GF-9-10. NC2234.2 +223200 ADD 1 TO REC-CT. NC2234.2 +223300 MOVE "INI-TEST-GF-9-10" TO PAR-NAME. NC2234.2 +223400 IF TEST-1-10 = "AAAAAA" NC2234.2 +223500 PERFORM PASS NC2234.2 +223600 GO TO INI-WRITE-GF-9-10 NC2234.2 +223700 ELSE NC2234.2 +223800 GO TO INI-FAIL-GF-9-10. NC2234.2 +223900 INI-DELETE-GF-9-10. NC2234.2 +224000 PERFORM DE-LETE. NC2234.2 +224100 GO TO INI-WRITE-GF-9-10. NC2234.2 +224200 INI-FAIL-GF-9-10. NC2234.2 +224300 MOVE "AAAAAA" TO CORRECT-X NC2234.2 +224400 MOVE TEST-1-10 TO COMPUTED-X NC2234.2 +224500 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +224600 PERFORM FAIL. NC2234.2 +224700 INI-WRITE-GF-9-10. NC2234.2 +224800 PERFORM PRINT-DETAIL. NC2234.2 +224900* NC2234.2 +225000 INI-TEST-GF-9-11. NC2234.2 +225100 ADD 1 TO REC-CT. NC2234.2 +225200 MOVE "INI-TEST-GF-9-11" TO PAR-NAME. NC2234.2 +225300 IF TEST-8-DATA-1 = "$234.00" NC2234.2 +225400 PERFORM PASS NC2234.2 +225500 GO TO INI-WRITE-GF-9-11 NC2234.2 +225600 ELSE NC2234.2 +225700 GO TO INI-FAIL-GF-9-11. NC2234.2 +225800 INI-DELETE-GF-9-11. NC2234.2 +225900 PERFORM DE-LETE. NC2234.2 +226000 GO TO INI-WRITE-GF-9-11. NC2234.2 +226100 INI-FAIL-GF-9-11. NC2234.2 +226200 MOVE "$234.00" TO CORRECT-X NC2234.2 +226300 MOVE TEST-8-DATA-1 TO COMPUTED-X NC2234.2 +226400 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +226500 PERFORM FAIL. NC2234.2 +226600 INI-WRITE-GF-9-11. NC2234.2 +226700 PERFORM PRINT-DETAIL. NC2234.2 +226800* NC2234.2 +226900 INI-TEST-GF-9-12. NC2234.2 +227000 ADD 1 TO REC-CT. NC2234.2 +227100 MOVE "INI-TEST-GF-9-12" TO PAR-NAME. NC2234.2 +227200 IF TEST-8-DATA-2 = "AAAAAA " NC2234.2 +227300 PERFORM PASS NC2234.2 +227400 GO TO INI-WRITE-GF-9-12 NC2234.2 +227500 ELSE NC2234.2 +227600 GO TO INI-FAIL-GF-9-12. NC2234.2 +227700 INI-DELETE-GF-9-12. NC2234.2 +227800 PERFORM DE-LETE. NC2234.2 +227900 GO TO INI-WRITE-GF-9-12. NC2234.2 +228000 INI-FAIL-GF-9-12. NC2234.2 +228100 MOVE "AAAAAA " TO CORRECT-X NC2234.2 +228200 MOVE TEST-8-DATA-2 TO COMPUTED-X NC2234.2 +228300 MOVE "INCORRECTLY INITIALIZED" TO RE-MARK NC2234.2 +228400 PERFORM FAIL. NC2234.2 +228500 INI-WRITE-GF-9-12. NC2234.2 +228600 PERFORM PRINT-DETAIL. NC2234.2 +228700* NC2234.2 +228800 CCVS-EXIT SECTION. NC2234.2 +228900 CCVS-999999. NC2234.2 +229000 GO TO CLOSE-FILES. NC2234.2 diff --git a/tests/cobol85/NC/NC224A.CBL b/tests/cobol85/NC/NC224A.CBL new file mode 100755 index 00000000..0d029991 --- /dev/null +++ b/tests/cobol85/NC/NC224A.CBL @@ -0,0 +1,647 @@ +000100 IDENTIFICATION DIVISION. NC2244.2 +000200 PROGRAM-ID. NC2244.2 +000300 NC224A. NC2244.2 +000400**************************************************************** NC2244.2 +000500* * NC2244.2 +000600* VALIDATION FOR:- * NC2244.2 +000700* * NC2244.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2244.2 +000900* * NC2244.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2244.2 +001100* * NC2244.2 +001200**************************************************************** NC2244.2 +001300* * NC2244.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2244.2 +001500* * NC2244.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2244.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2244.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2244.2 +001900* * NC2244.2 +002000**************************************************************** NC2244.2 +002100* PROGRAM NC224A TESTS THE USE OF REFERENCE MODIFICATION * NC2244.2 +002200* ON A VARIETY OF DATA ITEMS USING LITERALS, DATA NAMES * NC2244.2 +002300* AND ARITHMETIC EXPRESSIONS AS PARAMETERS. * NC2244.2 +002400* SUBSCRIPTED AND QUALIFIED DATA ITEMS ARE ALSO USED. * NC2244.2 +002500* * NC2244.2 +002600**************************************************************** NC2244.2 +002700 ENVIRONMENT DIVISION. NC2244.2 +002800 CONFIGURATION SECTION. NC2244.2 +002900 SOURCE-COMPUTER. NC2244.2 +003000 Linux. NC2244.2 +003100 OBJECT-COMPUTER. NC2244.2 +003200 Linux. NC2244.2 +003300 INPUT-OUTPUT SECTION. NC2244.2 +003400 FILE-CONTROL. NC2244.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2244.2 +003600 "report.log". NC2244.2 +003700 DATA DIVISION. NC2244.2 +003800 FILE SECTION. NC2244.2 +003900 FD PRINT-FILE. NC2244.2 +004000 01 PRINT-REC PICTURE X(120). NC2244.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2244.2 +004200 WORKING-STORAGE SECTION. NC2244.2 +004300 01 TEST-1-DATA PIC 9(6) VALUE 123456. NC2244.2 +004400 01 TEST-2-DATA PIC Z(5)9. NC2244.2 +004500 01 TEST-3-DATA-GRP. NC2244.2 +004600 03 TEST-3-DATA PIC X(6) VALUE "ABCDEF". NC2244.2 +004700 01 TEST-4-DATA PIC XXBXXBXX VALUE "AB CD EF". NC2244.2 +004800 NC2244.2 +004900 01 WS-2 PIC S9 VALUE +2. NC2244.2 +005000 01 WS-3 PIC S9 VALUE +3. NC2244.2 +005100 01 WS-5 PIC S9 VALUE +5. NC2244.2 +005200 01 WS-6 PIC S9 VALUE +6. NC2244.2 +005300 01 WS-7 PIC S9 VALUE +7. NC2244.2 +005400 01 WS-10 PIC S99 VALUE +10. NC2244.2 +005500 01 TEST-5-TABLE. NC2244.2 +005600 03 TABLE-GROUP OCCURS 4. NC2244.2 +005700 05 TABLE-1 PIC 9(8) NC2244.2 +005800 OCCURS 2. NC2244.2 +005900 03 TEST-3-DATA PIC X(6). NC2244.2 +006000* NC2244.2 +006100 01 TEST-RESULTS. NC2244.2 +006200 02 FILLER PIC X VALUE SPACE. NC2244.2 +006300 02 FEATURE PIC X(20) VALUE SPACE. NC2244.2 +006400 02 FILLER PIC X VALUE SPACE. NC2244.2 +006500 02 P-OR-F PIC X(5) VALUE SPACE. NC2244.2 +006600 02 FILLER PIC X VALUE SPACE. NC2244.2 +006700 02 PAR-NAME. NC2244.2 +006800 03 FILLER PIC X(19) VALUE SPACE. NC2244.2 +006900 03 PARDOT-X PIC X VALUE SPACE. NC2244.2 +007000 03 DOTVALUE PIC 99 VALUE ZERO. NC2244.2 +007100 02 FILLER PIC X(8) VALUE SPACE. NC2244.2 +007200 02 RE-MARK PIC X(61). NC2244.2 +007300 01 TEST-COMPUTED. NC2244.2 +007400 02 FILLER PIC X(30) VALUE SPACE. NC2244.2 +007500 02 FILLER PIC X(17) VALUE NC2244.2 +007600 " COMPUTED=". NC2244.2 +007700 02 COMPUTED-X. NC2244.2 +007800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2244.2 +007900 03 COMPUTED-N REDEFINES COMPUTED-A NC2244.2 +008000 PIC -9(9).9(9). NC2244.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2244.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2244.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2244.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. NC2244.2 +008500 04 COMPUTED-18V0 PIC -9(18). NC2244.2 +008600 04 FILLER PIC X. NC2244.2 +008700 03 FILLER PIC X(50) VALUE SPACE. NC2244.2 +008800 01 TEST-CORRECT. NC2244.2 +008900 02 FILLER PIC X(30) VALUE SPACE. NC2244.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2244.2 +009100 02 CORRECT-X. NC2244.2 +009200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2244.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2244.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2244.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2244.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2244.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. NC2244.2 +009800 04 CORRECT-18V0 PIC -9(18). NC2244.2 +009900 04 FILLER PIC X. NC2244.2 +010000 03 FILLER PIC X(2) VALUE SPACE. NC2244.2 +010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2244.2 +010200 01 CCVS-C-1. NC2244.2 +010300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2244.2 +010400- "SS PARAGRAPH-NAME NC2244.2 +010500- " REMARKS". NC2244.2 +010600 02 FILLER PIC X(20) VALUE SPACE. NC2244.2 +010700 01 CCVS-C-2. NC2244.2 +010800 02 FILLER PIC X VALUE SPACE. NC2244.2 +010900 02 FILLER PIC X(6) VALUE "TESTED". NC2244.2 +011000 02 FILLER PIC X(15) VALUE SPACE. NC2244.2 +011100 02 FILLER PIC X(4) VALUE "FAIL". NC2244.2 +011200 02 FILLER PIC X(94) VALUE SPACE. NC2244.2 +011300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2244.2 +011400 01 REC-CT PIC 99 VALUE ZERO. NC2244.2 +011500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2244.2 +011600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2244.2 +011700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2244.2 +011800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2244.2 +011900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2244.2 +012000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2244.2 +012100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2244.2 +012200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2244.2 +012300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2244.2 +012400 01 CCVS-H-1. NC2244.2 +012500 02 FILLER PIC X(39) VALUE SPACES. NC2244.2 +012600 02 FILLER PIC X(42) VALUE NC2244.2 +012700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2244.2 +012800 02 FILLER PIC X(39) VALUE SPACES. NC2244.2 +012900 01 CCVS-H-2A. NC2244.2 +013000 02 FILLER PIC X(40) VALUE SPACE. NC2244.2 +013100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2244.2 +013200 02 FILLER PIC XXXX VALUE NC2244.2 +013300 "4.2 ". NC2244.2 +013400 02 FILLER PIC X(28) VALUE NC2244.2 +013500 " COPY - NOT FOR DISTRIBUTION". NC2244.2 +013600 02 FILLER PIC X(41) VALUE SPACE. NC2244.2 +013700 NC2244.2 +013800 01 CCVS-H-2B. NC2244.2 +013900 02 FILLER PIC X(15) VALUE NC2244.2 +014000 "TEST RESULT OF ". NC2244.2 +014100 02 TEST-ID PIC X(9). NC2244.2 +014200 02 FILLER PIC X(4) VALUE NC2244.2 +014300 " IN ". NC2244.2 +014400 02 FILLER PIC X(12) VALUE NC2244.2 +014500 " HIGH ". NC2244.2 +014600 02 FILLER PIC X(22) VALUE NC2244.2 +014700 " LEVEL VALIDATION FOR ". NC2244.2 +014800 02 FILLER PIC X(58) VALUE NC2244.2 +014900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2244.2 +015000 01 CCVS-H-3. NC2244.2 +015100 02 FILLER PIC X(34) VALUE NC2244.2 +015200 " FOR OFFICIAL USE ONLY ". NC2244.2 +015300 02 FILLER PIC X(58) VALUE NC2244.2 +015400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2244.2 +015500 02 FILLER PIC X(28) VALUE NC2244.2 +015600 " COPYRIGHT 1985 ". NC2244.2 +015700 01 CCVS-E-1. NC2244.2 +015800 02 FILLER PIC X(52) VALUE SPACE. NC2244.2 +015900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2244.2 +016000 02 ID-AGAIN PIC X(9). NC2244.2 +016100 02 FILLER PIC X(45) VALUE SPACES. NC2244.2 +016200 01 CCVS-E-2. NC2244.2 +016300 02 FILLER PIC X(31) VALUE SPACE. NC2244.2 +016400 02 FILLER PIC X(21) VALUE SPACE. NC2244.2 +016500 02 CCVS-E-2-2. NC2244.2 +016600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2244.2 +016700 03 FILLER PIC X VALUE SPACE. NC2244.2 +016800 03 ENDER-DESC PIC X(44) VALUE NC2244.2 +016900 "ERRORS ENCOUNTERED". NC2244.2 +017000 01 CCVS-E-3. NC2244.2 +017100 02 FILLER PIC X(22) VALUE NC2244.2 +017200 " FOR OFFICIAL USE ONLY". NC2244.2 +017300 02 FILLER PIC X(12) VALUE SPACE. NC2244.2 +017400 02 FILLER PIC X(58) VALUE NC2244.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2244.2 +017600 02 FILLER PIC X(13) VALUE SPACE. NC2244.2 +017700 02 FILLER PIC X(15) VALUE NC2244.2 +017800 " COPYRIGHT 1985". NC2244.2 +017900 01 CCVS-E-4. NC2244.2 +018000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2244.2 +018100 02 FILLER PIC X(4) VALUE " OF ". NC2244.2 +018200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2244.2 +018300 02 FILLER PIC X(40) VALUE NC2244.2 +018400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2244.2 +018500 01 XXINFO. NC2244.2 +018600 02 FILLER PIC X(19) VALUE NC2244.2 +018700 "*** INFORMATION ***". NC2244.2 +018800 02 INFO-TEXT. NC2244.2 +018900 04 FILLER PIC X(8) VALUE SPACE. NC2244.2 +019000 04 XXCOMPUTED PIC X(20). NC2244.2 +019100 04 FILLER PIC X(5) VALUE SPACE. NC2244.2 +019200 04 XXCORRECT PIC X(20). NC2244.2 +019300 02 INF-ANSI-REFERENCE PIC X(48). NC2244.2 +019400 01 HYPHEN-LINE. NC2244.2 +019500 02 FILLER PIC IS X VALUE IS SPACE. NC2244.2 +019600 02 FILLER PIC IS X(65) VALUE IS "************************NC2244.2 +019700- "*****************************************". NC2244.2 +019800 02 FILLER PIC IS X(54) VALUE IS "************************NC2244.2 +019900- "******************************". NC2244.2 +020000 01 CCVS-PGM-ID PIC X(9) VALUE NC2244.2 +020100 "NC224A". NC2244.2 +020200 PROCEDURE DIVISION. NC2244.2 +020300 CCVS1 SECTION. NC2244.2 +020400 OPEN-FILES. NC2244.2 +020500 OPEN OUTPUT PRINT-FILE. NC2244.2 +020600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2244.2 +020700 MOVE SPACE TO TEST-RESULTS. NC2244.2 +020800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2244.2 +020900 GO TO CCVS1-EXIT. NC2244.2 +021000 CLOSE-FILES. NC2244.2 +021100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2244.2 +021200 TERMINATE-CCVS. NC2244.2 +021300*S EXIT PROGRAM. NC2244.2 +021400*SERMINATE-CALL. NC2244.2 +021500 STOP RUN. NC2244.2 +021600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2244.2 +021700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2244.2 +021800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2244.2 +021900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2244.2 +022000 MOVE "****TEST DELETED****" TO RE-MARK. NC2244.2 +022100 PRINT-DETAIL. NC2244.2 +022200 IF REC-CT NOT EQUAL TO ZERO NC2244.2 +022300 MOVE "." TO PARDOT-X NC2244.2 +022400 MOVE REC-CT TO DOTVALUE. NC2244.2 +022500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2244.2 +022600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2244.2 +022700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2244.2 +022800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2244.2 +022900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2244.2 +023000 MOVE SPACE TO CORRECT-X. NC2244.2 +023100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2244.2 +023200 MOVE SPACE TO RE-MARK. NC2244.2 +023300 HEAD-ROUTINE. NC2244.2 +023400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +023500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +023600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2244.2 +023700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2244.2 +023800 COLUMN-NAMES-ROUTINE. NC2244.2 +023900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +024000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +024100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +024200 END-ROUTINE. NC2244.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2244.2 +024400 END-RTN-EXIT. NC2244.2 +024500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +024600 END-ROUTINE-1. NC2244.2 +024700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2244.2 +024800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2244.2 +024900 ADD PASS-COUNTER TO ERROR-HOLD. NC2244.2 +025000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2244.2 +025100 NC2244.2 +025200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2244.2 +025300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2244.2 +025400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2244.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2244.2 +025600 END-ROUTINE-12. NC2244.2 +025700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2244.2 +025800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2244.2 +025900 MOVE "NO " TO ERROR-TOTAL NC2244.2 +026000 ELSE NC2244.2 +026100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2244.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2244.2 +026300 PERFORM WRITE-LINE. NC2244.2 +026400 END-ROUTINE-13. NC2244.2 +026500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2244.2 +026600 MOVE "NO " TO ERROR-TOTAL ELSE NC2244.2 +026700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2244.2 +026800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2244.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +027000 IF INSPECT-COUNTER EQUAL TO ZERO NC2244.2 +027100 MOVE "NO " TO ERROR-TOTAL NC2244.2 +027200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2244.2 +027300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2244.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +027500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2244.2 +027600 WRITE-LINE. NC2244.2 +027700 ADD 1 TO RECORD-COUNT. NC2244.2 +027800 IF RECORD-COUNT GREATER 50 NC2244.2 +027900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2244.2 +028000 MOVE SPACE TO DUMMY-RECORD NC2244.2 +028100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2244.2 +028200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2244.2 +028300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2244.2 +028400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2244.2 +028500 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2244.2 +028600 MOVE ZERO TO RECORD-COUNT. NC2244.2 +028700 PERFORM WRT-LN. NC2244.2 +028800 WRT-LN. NC2244.2 +028900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2244.2 +029000 MOVE SPACE TO DUMMY-RECORD. NC2244.2 +029100 BLANK-LINE-PRINT. NC2244.2 +029200 PERFORM WRT-LN. NC2244.2 +029300 FAIL-ROUTINE. NC2244.2 +029400 IF COMPUTED-X NOT EQUAL TO SPACE NC2244.2 +029500 GO TO FAIL-ROUTINE-WRITE. NC2244.2 +029600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2244.2 +029700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2244.2 +029800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2244.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2244.2 +030100 GO TO FAIL-ROUTINE-EX. NC2244.2 +030200 FAIL-ROUTINE-WRITE. NC2244.2 +030300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2244.2 +030400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2244.2 +030500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2244.2 +030600 MOVE SPACES TO COR-ANSI-REFERENCE. NC2244.2 +030700 FAIL-ROUTINE-EX. EXIT. NC2244.2 +030800 BAIL-OUT. NC2244.2 +030900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2244.2 +031000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2244.2 +031100 BAIL-OUT-WRITE. NC2244.2 +031200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2244.2 +031300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2244.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2244.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2244.2 +031600 BAIL-OUT-EX. EXIT. NC2244.2 +031700 CCVS1-EXIT. NC2244.2 +031800 EXIT. NC2244.2 +031900 SECT-NC224A-001 SECTION. NC2244.2 +032000* NC2244.2 +032100 REF-INIT-GF-1. NC2244.2 +032200 MOVE "REFERENCE MODIFICATION" TO FEATURE. NC2244.2 +032300 MOVE "IV-22 4.3.8.3" TO ANSI-REFERENCE. NC2244.2 +032400 MOVE 123456 TO TEST-1-DATA. NC2244.2 +032500 MOVE 1 TO REC-CT. NC2244.2 +032600 GO TO REF-TEST-GF-1-1. NC2244.2 +032700 REF-DELETE-GF-1. NC2244.2 +032800 PERFORM DE-LETE. NC2244.2 +032900 PERFORM PRINT-DETAIL. NC2244.2 +033000 GO TO REF-INIT-GF-2. NC2244.2 +033100 REF-TEST-GF-1-1. NC2244.2 +033200 MOVE "REF-TEST-GF-1-1" TO PAR-NAME. NC2244.2 +033300 IF TEST-1-DATA (3:) = 3456 NC2244.2 +033400 PERFORM PASS NC2244.2 +033500 GO TO REF-WRITE-GF-1-1 NC2244.2 +033600 ELSE NC2244.2 +033700 GO TO REF-FAIL-GF-1-1. NC2244.2 +033800 REF-DELETE-GF-1-1. NC2244.2 +033900 PERFORM DE-LETE. NC2244.2 +034000 GO TO REF-WRITE-GF-1-1. NC2244.2 +034100 REF-FAIL-GF-1-1. NC2244.2 +034200 MOVE 3456 TO CORRECT-N NC2244.2 +034300 MOVE TEST-1-DATA (3:) TO COMPUTED-X NC2244.2 +034400 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +034500 PERFORM FAIL. NC2244.2 +034600 REF-WRITE-GF-1-1. NC2244.2 +034700 PERFORM PRINT-DETAIL. NC2244.2 +034800* NC2244.2 +034900 REF-TEST-GF-1-2. NC2244.2 +035000 ADD 1 TO REC-CT. NC2244.2 +035100 MOVE "REF-TEST-GF-1-2" TO PAR-NAME. NC2244.2 +035200 IF TEST-1-DATA (2: WS-3) = 234 NC2244.2 +035300 PERFORM PASS NC2244.2 +035400 GO TO REF-WRITE-GF-1-2 NC2244.2 +035500 ELSE NC2244.2 +035600 GO TO REF-FAIL-GF-1-2. NC2244.2 +035700 REF-DELETE-GF-1-2. NC2244.2 +035800 PERFORM DE-LETE. NC2244.2 +035900 GO TO REF-WRITE-GF-1-2. NC2244.2 +036000 REF-FAIL-GF-1-2. NC2244.2 +036100 MOVE 234 TO CORRECT-N NC2244.2 +036200 MOVE TEST-1-DATA (2: WS-3) TO COMPUTED-X NC2244.2 +036300 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +036400 PERFORM FAIL. NC2244.2 +036500 REF-WRITE-GF-1-2. NC2244.2 +036600 PERFORM PRINT-DETAIL. NC2244.2 +036700* NC2244.2 +036800 REF-TEST-GF-1-3. NC2244.2 +036900 ADD 1 TO REC-CT. NC2244.2 +037000 MOVE "REF-TEST-GF-1-3" TO PAR-NAME. NC2244.2 +037100 IF TEST-1-DATA (10 - 7: 6 + 2 - 5) = 345 NC2244.2 +037200 PERFORM PASS NC2244.2 +037300 GO TO REF-WRITE-GF-1-3 NC2244.2 +037400 ELSE NC2244.2 +037500 GO TO REF-FAIL-GF-1-3. NC2244.2 +037600 REF-DELETE-GF-1-3. NC2244.2 +037700 PERFORM DE-LETE. NC2244.2 +037800 GO TO REF-WRITE-GF-1-3. NC2244.2 +037900 REF-FAIL-GF-1-3. NC2244.2 +038000 MOVE 345 TO CORRECT-N NC2244.2 +038100 MOVE TEST-1-DATA (10 - 7: 6 + 2 - 5) NC2244.2 +038200 TO COMPUTED-X NC2244.2 +038300 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +038400 PERFORM FAIL. NC2244.2 +038500 REF-WRITE-GF-1-3. NC2244.2 +038600 PERFORM PRINT-DETAIL. NC2244.2 +038700* NC2244.2 +038800 REF-INIT-GF-2. NC2244.2 +038900 MOVE "IV-22 4.3.8.3" TO ANSI-REFERENCE. NC2244.2 +039000 MOVE 1234 TO TEST-2-DATA. NC2244.2 +039100 MOVE 1 TO REC-CT. NC2244.2 +039200 GO TO REF-TEST-GF-2-1. NC2244.2 +039300 REF-DELETE-GF-2. NC2244.2 +039400 PERFORM DE-LETE. NC2244.2 +039500 PERFORM PRINT-DETAIL. NC2244.2 +039600 GO TO REF-INIT-GF-3. NC2244.2 +039700 REF-TEST-GF-2-1. NC2244.2 +039800 MOVE "REF-TEST-GF-2-1" TO PAR-NAME. NC2244.2 +039900 IF TEST-2-DATA (WS-3:) = "1234" NC2244.2 +040000 PERFORM PASS NC2244.2 +040100 GO TO REF-WRITE-GF-2-1 NC2244.2 +040200 ELSE NC2244.2 +040300 GO TO REF-FAIL-GF-2-1. NC2244.2 +040400 REF-DELETE-GF-2-1. NC2244.2 +040500 PERFORM DE-LETE. NC2244.2 +040600 GO TO REF-WRITE-GF-2-1. NC2244.2 +040700 REF-FAIL-GF-2-1. NC2244.2 +040800 MOVE "1234" TO CORRECT-X NC2244.2 +040900 MOVE TEST-2-DATA (WS-3:) TO COMPUTED-X NC2244.2 +041000 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +041100 PERFORM FAIL. NC2244.2 +041200 REF-WRITE-GF-2-1. NC2244.2 +041300 PERFORM PRINT-DETAIL. NC2244.2 +041400* NC2244.2 +041500 REF-TEST-GF-2-2. NC2244.2 +041600 ADD 1 TO REC-CT. NC2244.2 +041700 MOVE "REF-TEST-GF-2-2" TO PAR-NAME. NC2244.2 +041800 IF TEST-2-DATA (WS-2: 3) = " 12" NC2244.2 +041900 PERFORM PASS NC2244.2 +042000 GO TO REF-WRITE-GF-2-2 NC2244.2 +042100 ELSE NC2244.2 +042200 GO TO REF-FAIL-GF-2-2. NC2244.2 +042300 REF-DELETE-GF-2-2. NC2244.2 +042400 PERFORM DE-LETE. NC2244.2 +042500 GO TO REF-WRITE-GF-2-2. NC2244.2 +042600 REF-FAIL-GF-2-2. NC2244.2 +042700 MOVE " 12" TO CORRECT-X NC2244.2 +042800 MOVE TEST-2-DATA (WS-2: 3) TO COMPUTED-X NC2244.2 +042900 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +043000 PERFORM FAIL. NC2244.2 +043100 REF-WRITE-GF-2-2. NC2244.2 +043200 PERFORM PRINT-DETAIL. NC2244.2 +043300* NC2244.2 +043400 REF-TEST-GF-2-3. NC2244.2 +043500 ADD 1 TO REC-CT. NC2244.2 +043600 MOVE "REF-TEST-GF-2-3" TO PAR-NAME. NC2244.2 +043700 IF TEST-2-DATA (10 - 7: 6 + 2 - 5) = "123" NC2244.2 +043800 PERFORM PASS NC2244.2 +043900 GO TO REF-WRITE-GF-2-3 NC2244.2 +044000 ELSE NC2244.2 +044100 GO TO REF-FAIL-GF-2-3. NC2244.2 +044200 REF-DELETE-GF-2-3. NC2244.2 +044300 PERFORM DE-LETE. NC2244.2 +044400 GO TO REF-WRITE-GF-2-3. NC2244.2 +044500 REF-FAIL-GF-2-3. NC2244.2 +044600 MOVE "123" TO CORRECT-X NC2244.2 +044700 MOVE TEST-2-DATA (10 - 7: 6 + 2 - 5) NC2244.2 +044800 TO COMPUTED-X NC2244.2 +044900 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +045000 PERFORM FAIL. NC2244.2 +045100 REF-WRITE-GF-2-3. NC2244.2 +045200 PERFORM PRINT-DETAIL. NC2244.2 +045300* NC2244.2 +045400 REF-INIT-GF-3. NC2244.2 +045500 MOVE "IV-22 4.3.8.3" TO ANSI-REFERENCE. NC2244.2 +045600 MOVE "ABCDEF" TO TEST-3-DATA IN TEST-3-DATA-GRP. NC2244.2 +045700 MOVE 1 TO REC-CT. NC2244.2 +045800 GO TO REF-TEST-GF-3-1. NC2244.2 +045900 REF-DELETE-GF-3. NC2244.2 +046000 PERFORM DE-LETE. NC2244.2 +046100 PERFORM PRINT-DETAIL. NC2244.2 +046200 GO TO REF-INIT-GF-3. NC2244.2 +046300 REF-TEST-GF-3-1. NC2244.2 +046400 MOVE "REF-TEST-GF-3-1" TO PAR-NAME. NC2244.2 +046500 IF TEST-3-DATA IN TEST-3-DATA-GRP (3:) = "CDEF" NC2244.2 +046600 PERFORM PASS NC2244.2 +046700 GO TO REF-WRITE-GF-3-1 NC2244.2 +046800 ELSE NC2244.2 +046900 GO TO REF-FAIL-GF-3-1. NC2244.2 +047000 REF-DELETE-GF-3-1. NC2244.2 +047100 PERFORM DE-LETE. NC2244.2 +047200 GO TO REF-WRITE-GF-3-1. NC2244.2 +047300 REF-FAIL-GF-3-1. NC2244.2 +047400 MOVE "CDEF" TO CORRECT-X. NC2244.2 +047500 MOVE TEST-3-DATA IN TEST-3-DATA-GRP (3:) TO COMPUTED-X. NC2244.2 +047600 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK. NC2244.2 +047700 PERFORM FAIL. NC2244.2 +047800 REF-WRITE-GF-3-1. NC2244.2 +047900 PERFORM PRINT-DETAIL. NC2244.2 +048000* NC2244.2 +048100 REF-TEST-GF-3-2. NC2244.2 +048200 ADD 1 TO REC-CT. NC2244.2 +048300 MOVE "REF-TEST-GF-3-2" TO PAR-NAME. NC2244.2 +048400 IF TEST-3-DATA IN TEST-3-DATA-GRP (2: WS-3) = "BCD" NC2244.2 +048500 PERFORM PASS NC2244.2 +048600 GO TO REF-WRITE-GF-3-2 NC2244.2 +048700 ELSE NC2244.2 +048800 GO TO REF-FAIL-GF-3-2. NC2244.2 +048900 REF-DELETE-GF-3-2. NC2244.2 +049000 PERFORM DE-LETE. NC2244.2 +049100 GO TO REF-WRITE-GF-3-2. NC2244.2 +049200 REF-FAIL-GF-3-2. NC2244.2 +049300 MOVE "BCD" TO CORRECT-X. NC2244.2 +049400 MOVE TEST-3-DATA IN TEST-3-DATA-GRP (2: WS-3) NC2244.2 +049500 TO COMPUTED-X. NC2244.2 +049600 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK. NC2244.2 +049700 PERFORM FAIL. NC2244.2 +049800 REF-WRITE-GF-3-2. NC2244.2 +049900 PERFORM PRINT-DETAIL. NC2244.2 +050000* NC2244.2 +050100 REF-TEST-GF-3-3. NC2244.2 +050200 ADD 1 TO REC-CT. NC2244.2 +050300 MOVE "REF-TEST-GF-3-3" TO PAR-NAME. NC2244.2 +050400 IF TEST-3-DATA IN TEST-3-DATA-GRP (10 - 7: 6 + 2 - 5) NC2244.2 +050500 = "CDE" NC2244.2 +050600 PERFORM PASS NC2244.2 +050700 GO TO REF-WRITE-GF-3-3 NC2244.2 +050800 ELSE NC2244.2 +050900 GO TO REF-FAIL-GF-3-3. NC2244.2 +051000 REF-DELETE-GF-3-3. NC2244.2 +051100 PERFORM DE-LETE. NC2244.2 +051200 GO TO REF-WRITE-GF-3-3. NC2244.2 +051300 REF-FAIL-GF-3-3. NC2244.2 +051400 MOVE "CDE" TO CORRECT-X. NC2244.2 +051500 MOVE TEST-3-DATA IN TEST-3-DATA-GRP (10 - 7: 6 + 2 - 5) NC2244.2 +051600 TO COMPUTED-X NC2244.2 +051700 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +051800 PERFORM FAIL. NC2244.2 +051900 REF-WRITE-GF-3-3. NC2244.2 +052000 PERFORM PRINT-DETAIL. NC2244.2 +052100* NC2244.2 +052200 REF-INIT-GF-4. NC2244.2 +052300 MOVE "IV-22 4.3.8.3" TO ANSI-REFERENCE. NC2244.2 +052400 MOVE "ABCDEF" TO TEST-4-DATA. NC2244.2 +052500 MOVE 1 TO REC-CT. NC2244.2 +052600 GO TO REF-TEST-GF-4-1. NC2244.2 +052700 REF-DELETE-GF-4. NC2244.2 +052800 PERFORM DE-LETE. NC2244.2 +052900 PERFORM PRINT-DETAIL. NC2244.2 +053000 GO TO REF-INIT-GF-5. NC2244.2 +053100 REF-TEST-GF-4-1. NC2244.2 +053200 MOVE "REF-TEST-GF-4-1" TO PAR-NAME. NC2244.2 +053300 IF TEST-4-DATA (3:) = " CD EF" NC2244.2 +053400 PERFORM PASS NC2244.2 +053500 GO TO REF-WRITE-GF-4-1 NC2244.2 +053600 ELSE NC2244.2 +053700 GO TO REF-FAIL-GF-4-1. NC2244.2 +053800 REF-DELETE-GF-4-1. NC2244.2 +053900 PERFORM DE-LETE. NC2244.2 +054000 GO TO REF-WRITE-GF-4-1. NC2244.2 +054100 REF-FAIL-GF-4-1. NC2244.2 +054200 MOVE " CD EF" TO CORRECT-X NC2244.2 +054300 MOVE TEST-4-DATA (3:) TO COMPUTED-X NC2244.2 +054400 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +054500 PERFORM FAIL. NC2244.2 +054600 REF-WRITE-GF-4-1. NC2244.2 +054700 PERFORM PRINT-DETAIL. NC2244.2 +054800* NC2244.2 +054900 REF-TEST-GF-4-2. NC2244.2 +055000 ADD 1 TO REC-CT. NC2244.2 +055100 MOVE "REF-TEST-GF-4-2" TO PAR-NAME. NC2244.2 +055200 IF TEST-4-DATA (WS-2: WS-3) = "B C" NC2244.2 +055300 PERFORM PASS NC2244.2 +055400 GO TO REF-WRITE-GF-4-2 NC2244.2 +055500 ELSE NC2244.2 +055600 GO TO REF-FAIL-GF-4-2. NC2244.2 +055700 REF-DELETE-GF-4-2. NC2244.2 +055800 PERFORM DE-LETE. NC2244.2 +055900 GO TO REF-WRITE-GF-4-2. NC2244.2 +056000 REF-FAIL-GF-4-2. NC2244.2 +056100 MOVE "B C" TO CORRECT-X NC2244.2 +056200 MOVE TEST-4-DATA (WS-2: WS-3) TO COMPUTED-X NC2244.2 +056300 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +056400 PERFORM FAIL. NC2244.2 +056500 REF-WRITE-GF-4-2. NC2244.2 +056600 PERFORM PRINT-DETAIL. NC2244.2 +056700* NC2244.2 +056800 REF-TEST-GF-4-3. NC2244.2 +056900 ADD 1 TO REC-CT. NC2244.2 +057000 MOVE "REF-TEST-GF-4-3" TO PAR-NAME. NC2244.2 +057100 IF TEST-4-DATA (10 - 7: 6 + 2 - 5) = " CD" NC2244.2 +057200 PERFORM PASS NC2244.2 +057300 GO TO REF-WRITE-GF-4-3 NC2244.2 +057400 ELSE NC2244.2 +057500 GO TO REF-FAIL-GF-4-3. NC2244.2 +057600 REF-DELETE-GF-4-3. NC2244.2 +057700 PERFORM DE-LETE. NC2244.2 +057800 GO TO REF-WRITE-GF-4-3. NC2244.2 +057900 REF-FAIL-GF-4-3. NC2244.2 +058000 MOVE " CD" TO CORRECT-X NC2244.2 +058100 MOVE TEST-4-DATA (10 - 7: 6 + 2 - 5) NC2244.2 +058200 TO COMPUTED-X NC2244.2 +058300 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +058400 PERFORM FAIL. NC2244.2 +058500 REF-WRITE-GF-4-3. NC2244.2 +058600 PERFORM PRINT-DETAIL. NC2244.2 +058700* NC2244.2 +058800 REF-INIT-GF-5. NC2244.2 +058900* ===--> SUBSCRIPTED DATA-NAME <--=== NC2244.2 +059000 MOVE "IV-22 4.3.8.3.3 SR4" TO ANSI-REFERENCE. NC2244.2 +059100 MOVE 12345678 TO TABLE-1 (3 2). NC2244.2 +059200 MOVE 1 TO REC-CT. NC2244.2 +059300 GO TO REF-TEST-GF-5-1. NC2244.2 +059400 REF-DELETE-GF-5. NC2244.2 +059500 PERFORM DE-LETE. NC2244.2 +059600 PERFORM PRINT-DETAIL. NC2244.2 +059700 GO TO REF-INIT-GF-6. NC2244.2 +059800 REF-TEST-GF-5-1. NC2244.2 +059900 MOVE "REF-TEST-GF-5-1" TO PAR-NAME. NC2244.2 +060000 IF TABLE-1 (3 2) (2: 5) = 23456 NC2244.2 +060100 PERFORM PASS NC2244.2 +060200 GO TO REF-WRITE-GF-5-1 NC2244.2 +060300 ELSE NC2244.2 +060400 GO TO REF-FAIL-GF-5-1. NC2244.2 +060500 REF-DELETE-GF-5-1. NC2244.2 +060600 PERFORM DE-LETE. NC2244.2 +060700 GO TO REF-WRITE-GF-5-1. NC2244.2 +060800 REF-FAIL-GF-5-1. NC2244.2 +060900 MOVE 23456 TO CORRECT-N NC2244.2 +061000 MOVE TABLE-1 (3 2) (2: 5) TO COMPUTED-X NC2244.2 +061100 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +061200 PERFORM FAIL. NC2244.2 +061300 REF-WRITE-GF-5-1. NC2244.2 +061400 PERFORM PRINT-DETAIL. NC2244.2 +061500* NC2244.2 +061600 REF-INIT-GF-6. NC2244.2 +061700* ===--> QUALIFIED DATA-NAME <--=== NC2244.2 +061800 MOVE "IV-22 4.3.8.3.3 SR4" TO ANSI-REFERENCE. NC2244.2 +061900 MOVE "OPQRST" TO TEST-3-DATA OF TEST-5-TABLE. NC2244.2 +062000 MOVE 1 TO REC-CT. NC2244.2 +062100 GO TO REF-TEST-GF-6-1. NC2244.2 +062200 REF-DELETE-GF-6. NC2244.2 +062300 PERFORM DE-LETE. NC2244.2 +062400 PERFORM PRINT-DETAIL. NC2244.2 +062500 GO TO CCVS-EXIT. NC2244.2 +062600 REF-TEST-GF-6-1. NC2244.2 +062700 MOVE "REF-TEST-GF-6-1" TO PAR-NAME. NC2244.2 +062800 IF TEST-3-DATA OF TEST-5-TABLE (2: 4) = "PQRS" NC2244.2 +062900 PERFORM PASS NC2244.2 +063000 GO TO REF-WRITE-GF-6-1 NC2244.2 +063100 ELSE NC2244.2 +063200 GO TO REF-FAIL-GF-6-1. NC2244.2 +063300 REF-DELETE-GF-6-1. NC2244.2 +063400 PERFORM DE-LETE. NC2244.2 +063500 GO TO REF-WRITE-GF-6-1. NC2244.2 +063600 REF-FAIL-GF-6-1. NC2244.2 +063700 MOVE "PQRS" TO CORRECT-X. NC2244.2 +063800 MOVE TEST-3-DATA OF TEST-5-TABLE (2: 4) NC2244.2 +063900 TO COMPUTED-X NC2244.2 +064000 MOVE "INCORRECT REFERENCE MODIFICATION" TO RE-MARK NC2244.2 +064100 PERFORM FAIL. NC2244.2 +064200 REF-WRITE-GF-6-1. NC2244.2 +064300 PERFORM PRINT-DETAIL. NC2244.2 +064400* NC2244.2 +064500 CCVS-EXIT SECTION. NC2244.2 +064600 CCVS-999999. NC2244.2 +064700 GO TO CLOSE-FILES. NC2244.2 diff --git a/tests/cobol85/NC/NC225A.CBL b/tests/cobol85/NC/NC225A.CBL new file mode 100755 index 00000000..a7893a50 --- /dev/null +++ b/tests/cobol85/NC/NC225A.CBL @@ -0,0 +1,1924 @@ +000100 IDENTIFICATION DIVISION. NC2254.2 +000200 PROGRAM-ID. NC2254.2 +000300 NC225A. NC2254.2 +000400**************************************************************** NC2254.2 +000500* * NC2254.2 +000600* VALIDATION FOR:- * NC2254.2 +000700* * NC2254.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2254.2 +000900* * NC2254.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2254.2 +001100* * NC2254.2 +001200**************************************************************** NC2254.2 +001300* * NC2254.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2254.2 +001500* * NC2254.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2254.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2254.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2254.2 +001900* * NC2254.2 +002000**************************************************************** NC2254.2 +002100* * NC2254.2 +002200* PROGRAM NC225A TESTS THE USE OF THE "EVALUATE" STATEMENT. * NC2254.2 +002300* VARIOUS COMBINATIONS OF IDENTIFIERS, LITERALS, ARITHMETIC * NC2254.2 +002400* EXPRESSIONS AND CONDITIONAL EXPRESSIONS AS WELL AS THE * NC2254.2 +002500* OPTIONAL WORDS "TRUE" AND "FALSE" ARE USED AS SELECTION * NC2254.2 +002600* SUBJECTS AND SELECTION OBJECTS. * NC2254.2 +002700* MULTIPLE SELECTION SUBJECTS AND SETS OF SELECTION * NC2254.2 +002800* OBJECTS ARE ALSO TESTED. * NC2254.2 +002900* * NC2254.2 +003000**************************************************************** NC2254.2 +003100 ENVIRONMENT DIVISION. NC2254.2 +003200 CONFIGURATION SECTION. NC2254.2 +003300 SOURCE-COMPUTER. NC2254.2 +003400 Linux. NC2254.2 +003500 OBJECT-COMPUTER. NC2254.2 +003600 Linux. NC2254.2 +003700 INPUT-OUTPUT SECTION. NC2254.2 +003800 FILE-CONTROL. NC2254.2 +003900 SELECT PRINT-FILE ASSIGN TO NC2254.2 +004000 "report.log". NC2254.2 +004100 DATA DIVISION. NC2254.2 +004200 FILE SECTION. NC2254.2 +004300 FD PRINT-FILE. NC2254.2 +004400 01 PRINT-REC PICTURE X(120). NC2254.2 +004500 01 DUMMY-RECORD PICTURE X(120). NC2254.2 +004600 WORKING-STORAGE SECTION. NC2254.2 +004700 01 WRK-XN-00001-1 PIC X. NC2254.2 +004800 01 WRK-XN-00001-2 PIC X. NC2254.2 +004900 01 WRK-XN-00001-3 PIC X. NC2254.2 +005000 01 WRK-XN-00001-4 PIC X. NC2254.2 +005100 01 WRK-DU-02V00 PIC 99. NC2254.2 +005200 01 WRK-DU-08V00 PIC 9(8). NC2254.2 +005300 01 WRK-DU-08V00-1 PIC 9(8). NC2254.2 +005400 01 WRK-DU-08V00-2 PIC 9(8). NC2254.2 +005500 88 IT-IS-81 VALUE 81. NC2254.2 +005600 01 WRK-DU-08V00-3 PIC 9(8). NC2254.2 +005700 01 WRK-DU-08V00-4 PIC 9(8). NC2254.2 +005800 01 TEST-3-DATA PIC X(6) VALUE "ABCDEF". NC2254.2 +005900 01 TEST-4-DATA PIC XXBXXBXX VALUE "AB CD EF". NC2254.2 +006000 NC2254.2 +006100 01 WS-2 PIC S9 VALUE +2. NC2254.2 +006200 01 WS-3 PIC S9 VALUE +3. NC2254.2 +006300 01 WS-5 PIC S9 VALUE +5. NC2254.2 +006400 01 WS-6 PIC S9 VALUE +6. NC2254.2 +006500 01 WS-7 PIC S9 VALUE +7. NC2254.2 +006600 01 WS-10 PIC S99 VALUE +10. NC2254.2 +006700 01 WS-81 PIC S99 VALUE +81. NC2254.2 +006800 01 TEST-5-TABLE. NC2254.2 +006900 03 TABLE-GROUP OCCURS 4. NC2254.2 +007000 05 TABLE-1 PIC 9(8) NC2254.2 +007100 OCCURS 2. NC2254.2 +007200 03 TEST-5-DATA PIC X(6). NC2254.2 +007300* NC2254.2 +007400 01 TEST-RESULTS. NC2254.2 +007500 02 FILLER PIC X VALUE SPACE. NC2254.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. NC2254.2 +007700 02 FILLER PIC X VALUE SPACE. NC2254.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. NC2254.2 +007900 02 FILLER PIC X VALUE SPACE. NC2254.2 +008000 02 PAR-NAME. NC2254.2 +008100 03 FILLER PIC X(19) VALUE SPACE. NC2254.2 +008200 03 PARDOT-X PIC X VALUE SPACE. NC2254.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. NC2254.2 +008400 02 FILLER PIC X(8) VALUE SPACE. NC2254.2 +008500 02 RE-MARK PIC X(61). NC2254.2 +008600 01 TEST-COMPUTED. NC2254.2 +008700 02 FILLER PIC X(30) VALUE SPACE. NC2254.2 +008800 02 FILLER PIC X(17) VALUE NC2254.2 +008900 " COMPUTED=". NC2254.2 +009000 02 COMPUTED-X. NC2254.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2254.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A NC2254.2 +009300 PIC -9(9).9(9). NC2254.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2254.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2254.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2254.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. NC2254.2 +009800 04 COMPUTED-18V0 PIC -9(18). NC2254.2 +009900 04 FILLER PIC X. NC2254.2 +010000 03 FILLER PIC X(50) VALUE SPACE. NC2254.2 +010100 01 TEST-CORRECT. NC2254.2 +010200 02 FILLER PIC X(30) VALUE SPACE. NC2254.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2254.2 +010400 02 CORRECT-X. NC2254.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2254.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2254.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2254.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2254.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2254.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. NC2254.2 +011100 04 CORRECT-18V0 PIC -9(18). NC2254.2 +011200 04 FILLER PIC X. NC2254.2 +011300 03 FILLER PIC X(2) VALUE SPACE. NC2254.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2254.2 +011500 01 CCVS-C-1. NC2254.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2254.2 +011700- "SS PARAGRAPH-NAME NC2254.2 +011800- " REMARKS". NC2254.2 +011900 02 FILLER PIC X(20) VALUE SPACE. NC2254.2 +012000 01 CCVS-C-2. NC2254.2 +012100 02 FILLER PIC X VALUE SPACE. NC2254.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". NC2254.2 +012300 02 FILLER PIC X(15) VALUE SPACE. NC2254.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". NC2254.2 +012500 02 FILLER PIC X(94) VALUE SPACE. NC2254.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2254.2 +012700 01 REC-CT PIC 99 VALUE ZERO. NC2254.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2254.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2254.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2254.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2254.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2254.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2254.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2254.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2254.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2254.2 +013700 01 CCVS-H-1. NC2254.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC2254.2 +013900 02 FILLER PIC X(42) VALUE NC2254.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2254.2 +014100 02 FILLER PIC X(39) VALUE SPACES. NC2254.2 +014200 01 CCVS-H-2A. NC2254.2 +014300 02 FILLER PIC X(40) VALUE SPACE. NC2254.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2254.2 +014500 02 FILLER PIC XXXX VALUE NC2254.2 +014600 "4.2 ". NC2254.2 +014700 02 FILLER PIC X(28) VALUE NC2254.2 +014800 " COPY - NOT FOR DISTRIBUTION". NC2254.2 +014900 02 FILLER PIC X(41) VALUE SPACE. NC2254.2 +015000 NC2254.2 +015100 01 CCVS-H-2B. NC2254.2 +015200 02 FILLER PIC X(15) VALUE NC2254.2 +015300 "TEST RESULT OF ". NC2254.2 +015400 02 TEST-ID PIC X(9). NC2254.2 +015500 02 FILLER PIC X(4) VALUE NC2254.2 +015600 " IN ". NC2254.2 +015700 02 FILLER PIC X(12) VALUE NC2254.2 +015800 " HIGH ". NC2254.2 +015900 02 FILLER PIC X(22) VALUE NC2254.2 +016000 " LEVEL VALIDATION FOR ". NC2254.2 +016100 02 FILLER PIC X(58) VALUE NC2254.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2254.2 +016300 01 CCVS-H-3. NC2254.2 +016400 02 FILLER PIC X(34) VALUE NC2254.2 +016500 " FOR OFFICIAL USE ONLY ". NC2254.2 +016600 02 FILLER PIC X(58) VALUE NC2254.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2254.2 +016800 02 FILLER PIC X(28) VALUE NC2254.2 +016900 " COPYRIGHT 1985 ". NC2254.2 +017000 01 CCVS-E-1. NC2254.2 +017100 02 FILLER PIC X(52) VALUE SPACE. NC2254.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2254.2 +017300 02 ID-AGAIN PIC X(9). NC2254.2 +017400 02 FILLER PIC X(45) VALUE SPACES. NC2254.2 +017500 01 CCVS-E-2. NC2254.2 +017600 02 FILLER PIC X(31) VALUE SPACE. NC2254.2 +017700 02 FILLER PIC X(21) VALUE SPACE. NC2254.2 +017800 02 CCVS-E-2-2. NC2254.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2254.2 +018000 03 FILLER PIC X VALUE SPACE. NC2254.2 +018100 03 ENDER-DESC PIC X(44) VALUE NC2254.2 +018200 "ERRORS ENCOUNTERED". NC2254.2 +018300 01 CCVS-E-3. NC2254.2 +018400 02 FILLER PIC X(22) VALUE NC2254.2 +018500 " FOR OFFICIAL USE ONLY". NC2254.2 +018600 02 FILLER PIC X(12) VALUE SPACE. NC2254.2 +018700 02 FILLER PIC X(58) VALUE NC2254.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2254.2 +018900 02 FILLER PIC X(13) VALUE SPACE. NC2254.2 +019000 02 FILLER PIC X(15) VALUE NC2254.2 +019100 " COPYRIGHT 1985". NC2254.2 +019200 01 CCVS-E-4. NC2254.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2254.2 +019400 02 FILLER PIC X(4) VALUE " OF ". NC2254.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2254.2 +019600 02 FILLER PIC X(40) VALUE NC2254.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2254.2 +019800 01 XXINFO. NC2254.2 +019900 02 FILLER PIC X(19) VALUE NC2254.2 +020000 "*** INFORMATION ***". NC2254.2 +020100 02 INFO-TEXT. NC2254.2 +020200 04 FILLER PIC X(8) VALUE SPACE. NC2254.2 +020300 04 XXCOMPUTED PIC X(20). NC2254.2 +020400 04 FILLER PIC X(5) VALUE SPACE. NC2254.2 +020500 04 XXCORRECT PIC X(20). NC2254.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). NC2254.2 +020700 01 HYPHEN-LINE. NC2254.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. NC2254.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************NC2254.2 +021000- "*****************************************". NC2254.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************NC2254.2 +021200- "******************************". NC2254.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE NC2254.2 +021400 "NC225A". NC2254.2 +021500 PROCEDURE DIVISION. NC2254.2 +021600 CCVS1 SECTION. NC2254.2 +021700 OPEN-FILES. NC2254.2 +021800 OPEN OUTPUT PRINT-FILE. NC2254.2 +021900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2254.2 +022000 MOVE SPACE TO TEST-RESULTS. NC2254.2 +022100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2254.2 +022200 GO TO CCVS1-EXIT. NC2254.2 +022300 CLOSE-FILES. NC2254.2 +022400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2254.2 +022500 TERMINATE-CCVS. NC2254.2 +022600*S EXIT PROGRAM. NC2254.2 +022700*SERMINATE-CALL. NC2254.2 +022800 STOP RUN. NC2254.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2254.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2254.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2254.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2254.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. NC2254.2 +023400 PRINT-DETAIL. NC2254.2 +023500 IF REC-CT NOT EQUAL TO ZERO NC2254.2 +023600 MOVE "." TO PARDOT-X NC2254.2 +023700 MOVE REC-CT TO DOTVALUE. NC2254.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2254.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2254.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2254.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2254.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2254.2 +024300 MOVE SPACE TO CORRECT-X. NC2254.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2254.2 +024500 MOVE SPACE TO RE-MARK. NC2254.2 +024600 HEAD-ROUTINE. NC2254.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2254.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2254.2 +025100 COLUMN-NAMES-ROUTINE. NC2254.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +025500 END-ROUTINE. NC2254.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2254.2 +025700 END-RTN-EXIT. NC2254.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +025900 END-ROUTINE-1. NC2254.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2254.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2254.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. NC2254.2 +026300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2254.2 +026400 NC2254.2 +026500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2254.2 +026600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2254.2 +026700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2254.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2254.2 +026900 END-ROUTINE-12. NC2254.2 +027000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2254.2 +027100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2254.2 +027200 MOVE "NO " TO ERROR-TOTAL NC2254.2 +027300 ELSE NC2254.2 +027400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2254.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2254.2 +027600 PERFORM WRITE-LINE. NC2254.2 +027700 END-ROUTINE-13. NC2254.2 +027800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2254.2 +027900 MOVE "NO " TO ERROR-TOTAL ELSE NC2254.2 +028000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2254.2 +028100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2254.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +028300 IF INSPECT-COUNTER EQUAL TO ZERO NC2254.2 +028400 MOVE "NO " TO ERROR-TOTAL NC2254.2 +028500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2254.2 +028600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2254.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +028800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2254.2 +028900 WRITE-LINE. NC2254.2 +029000 ADD 1 TO RECORD-COUNT. NC2254.2 +029100 IF RECORD-COUNT GREATER 50 NC2254.2 +029200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2254.2 +029300 MOVE SPACE TO DUMMY-RECORD NC2254.2 +029400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2254.2 +029500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2254.2 +029600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2254.2 +029700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2254.2 +029800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2254.2 +029900 MOVE ZERO TO RECORD-COUNT. NC2254.2 +030000 PERFORM WRT-LN. NC2254.2 +030100 WRT-LN. NC2254.2 +030200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2254.2 +030300 MOVE SPACE TO DUMMY-RECORD. NC2254.2 +030400 BLANK-LINE-PRINT. NC2254.2 +030500 PERFORM WRT-LN. NC2254.2 +030600 FAIL-ROUTINE. NC2254.2 +030700 IF COMPUTED-X NOT EQUAL TO SPACE NC2254.2 +030800 GO TO FAIL-ROUTINE-WRITE. NC2254.2 +030900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2254.2 +031000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2254.2 +031100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2254.2 +031200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +031300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2254.2 +031400 GO TO FAIL-ROUTINE-EX. NC2254.2 +031500 FAIL-ROUTINE-WRITE. NC2254.2 +031600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2254.2 +031700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2254.2 +031800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2254.2 +031900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2254.2 +032000 FAIL-ROUTINE-EX. EXIT. NC2254.2 +032100 BAIL-OUT. NC2254.2 +032200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2254.2 +032300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2254.2 +032400 BAIL-OUT-WRITE. NC2254.2 +032500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2254.2 +032600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2254.2 +032700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2254.2 +032800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2254.2 +032900 BAIL-OUT-EX. EXIT. NC2254.2 +033000 CCVS1-EXIT. NC2254.2 +033100 EXIT. NC2254.2 +033200* NC2254.2 +033300 SECT-NC225A-001-1 SECTION. NC2254.2 +033400* NC2254.2 +033500 EVA-INIT-GF-1. NC2254.2 +033600 MOVE "EVALUATE STATEMENT" TO FEATURE. NC2254.2 +033700 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +033800 MOVE 1 TO REC-CT. NC2254.2 +033900 MOVE "6" TO WRK-XN-00001-1. NC2254.2 +034000 GO TO EVA-TEST-GF-1-1. NC2254.2 +034100 EVA-DELETE-GF-1. NC2254.2 +034200 PERFORM DE-LETE. NC2254.2 +034300 PERFORM PRINT-DETAIL. NC2254.2 +034400 GO TO EVA-INIT-GF-2. NC2254.2 +034500 EVA-TEST-GF-1-1. NC2254.2 +034600 MOVE "EVA-TEST-GF-1-1" TO PAR-NAME. NC2254.2 +034700 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +034800 WHEN TRUE NC2254.2 +034900 PERFORM PASS NC2254.2 +035000 GO TO EVA-WRITE-GF-1-1. NC2254.2 +035100 GO TO EVA-FAIL-GF-1-1. NC2254.2 +035200 EVA-DELETE-GF-1-1. NC2254.2 +035300 PERFORM DE-LETE. NC2254.2 +035400 GO TO EVA-WRITE-GF-1-1. NC2254.2 +035500 EVA-FAIL-GF-1-1. NC2254.2 +035600 MOVE "EXPECTING NUMERIC CONDITION" TO RE-MARK. NC2254.2 +035700 PERFORM FAIL. NC2254.2 +035800 EVA-WRITE-GF-1-1. NC2254.2 +035900 PERFORM PRINT-DETAIL. NC2254.2 +036000* NC2254.2 +036100 EVA-TEST-GF-1-2. NC2254.2 +036200 ADD 1 TO REC-CT. NC2254.2 +036300 MOVE "EVA-TEST-GF-1-2" TO PAR-NAME. NC2254.2 +036400 EVALUATE WRK-XN-00001-1 NOT NUMERIC NC2254.2 +036500 WHEN TRUE NC2254.2 +036600 GO TO EVA-FAIL-GF-1-2. NC2254.2 +036700 PERFORM PASS. NC2254.2 +036800 GO TO EVA-WRITE-GF-1-2. NC2254.2 +036900 EVA-DELETE-GF-1-2. NC2254.2 +037000 PERFORM DE-LETE. NC2254.2 +037100 GO TO EVA-WRITE-GF-1-2. NC2254.2 +037200 EVA-FAIL-GF-1-2. NC2254.2 +037300 MOVE "EXPECTING NUMERIC CONDITION" TO RE-MARK NC2254.2 +037400 PERFORM FAIL. NC2254.2 +037500 EVA-WRITE-GF-1-2. NC2254.2 +037600 PERFORM PRINT-DETAIL. NC2254.2 +037700* NC2254.2 +037800 EVA-INIT-GF-2. NC2254.2 +037900 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +038000 MOVE 1 TO REC-CT. NC2254.2 +038100 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +038200 GO TO EVA-TEST-GF-2-1. NC2254.2 +038300 EVA-DELETE-GF-2. NC2254.2 +038400 PERFORM DE-LETE. NC2254.2 +038500 PERFORM PRINT-DETAIL. NC2254.2 +038600 GO TO EVA-INIT-GF-3. NC2254.2 +038700 EVA-TEST-GF-2-1. NC2254.2 +038800 MOVE "EVA-TEST-GF-2-1" TO PAR-NAME. NC2254.2 +038900 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +039000 WHEN TRUE NC2254.2 +039100 GO TO EVA-FAIL-GF-2-1. NC2254.2 +039200 PERFORM PASS. NC2254.2 +039300 GO TO EVA-WRITE-GF-2-1. NC2254.2 +039400 EVA-DELETE-GF-2-1. NC2254.2 +039500 PERFORM DE-LETE. NC2254.2 +039600 GO TO EVA-WRITE-GF-2-1. NC2254.2 +039700 EVA-FAIL-GF-2-1. NC2254.2 +039800 MOVE "EXPECTING NON-NUMERIC CONDITION" TO RE-MARK NC2254.2 +039900 PERFORM FAIL. NC2254.2 +040000 EVA-WRITE-GF-2-1. NC2254.2 +040100 PERFORM PRINT-DETAIL. NC2254.2 +040200* NC2254.2 +040300 EVA-TEST-GF-2-2. NC2254.2 +040400 ADD 1 TO REC-CT. NC2254.2 +040500 MOVE "EVA-TEST-GF-2-2" TO PAR-NAME. NC2254.2 +040600 EVALUATE WRK-XN-00001-1 NOT NUMERIC NC2254.2 +040700 WHEN TRUE NC2254.2 +040800 PERFORM PASS NC2254.2 +040900 GO TO EVA-WRITE-GF-2-2. NC2254.2 +041000 GO TO EVA-FAIL-GF-2-2. NC2254.2 +041100 EVA-DELETE-GF-2-2. NC2254.2 +041200 PERFORM DE-LETE. NC2254.2 +041300 GO TO EVA-WRITE-GF-2-2. NC2254.2 +041400 EVA-FAIL-GF-2-2. NC2254.2 +041500 MOVE "EXPECTING NON-NUMERIC CONDITION" TO RE-MARK. NC2254.2 +041600 PERFORM FAIL. NC2254.2 +041700 EVA-WRITE-GF-2-2. NC2254.2 +041800 PERFORM PRINT-DETAIL. NC2254.2 +041900* NC2254.2 +042000 EVA-INIT-GF-3. NC2254.2 +042100 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +042200 MOVE 1 TO REC-CT. NC2254.2 +042300 MOVE "6" TO WRK-XN-00001-1. NC2254.2 +042400 MOVE "6" TO WRK-XN-00001-2. NC2254.2 +042500 GO TO EVA-TEST-GF-3-1. NC2254.2 +042600 EVA-DELETE-GF-3. NC2254.2 +042700 PERFORM DE-LETE. NC2254.2 +042800 PERFORM PRINT-DETAIL. NC2254.2 +042900 GO TO EVA-INIT-GF-4. NC2254.2 +043000 EVA-TEST-GF-3-1. NC2254.2 +043100 MOVE "EVA-TEST-GF-3-1" TO PAR-NAME. NC2254.2 +043200 EVALUATE WRK-XN-00001-1 NC2254.2 +043300 WHEN WRK-XN-00001-2 NC2254.2 +043400 PERFORM PASS NC2254.2 +043500 GO TO EVA-WRITE-GF-3-1. NC2254.2 +043600 GO TO EVA-FAIL-GF-3-1. NC2254.2 +043700 EVA-DELETE-GF-3-1. NC2254.2 +043800 PERFORM DE-LETE. NC2254.2 +043900 GO TO EVA-WRITE-GF-3-1. NC2254.2 +044000 EVA-FAIL-GF-3-1. NC2254.2 +044100 MOVE "EXPECTING EQUAL IDENTIFIER" TO RE-MARK. NC2254.2 +044200 PERFORM FAIL. NC2254.2 +044300 EVA-WRITE-GF-3-1. NC2254.2 +044400 PERFORM PRINT-DETAIL. NC2254.2 +044500* NC2254.2 +044600 EVA-TEST-GF-3-2. NC2254.2 +044700 ADD 1 TO REC-CT. NC2254.2 +044800 MOVE "EVA-TEST-GF-3-2" TO PAR-NAME. NC2254.2 +044900 EVALUATE WRK-XN-00001-1 NC2254.2 +045000 WHEN NOT WRK-XN-00001-2 NC2254.2 +045100 GO TO EVA-FAIL-GF-3-2. NC2254.2 +045200 PERFORM PASS. NC2254.2 +045300 GO TO EVA-WRITE-GF-3-2. NC2254.2 +045400 EVA-DELETE-GF-3-2. NC2254.2 +045500 PERFORM DE-LETE. NC2254.2 +045600 GO TO EVA-WRITE-GF-3-2. NC2254.2 +045700 EVA-FAIL-GF-3-2. NC2254.2 +045800 MOVE "EXPECTING EQUAL IDENTIFIERS" TO RE-MARK NC2254.2 +045900 PERFORM FAIL. NC2254.2 +046000 EVA-WRITE-GF-3-2. NC2254.2 +046100 PERFORM PRINT-DETAIL. NC2254.2 +046200* NC2254.2 +046300 EVA-INIT-GF-4. NC2254.2 +046400 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +046500 MOVE 1 TO REC-CT. NC2254.2 +046600 MOVE "1" TO WRK-XN-00001-1. NC2254.2 +046700 MOVE "*" TO WRK-XN-00001-2. NC2254.2 +046800 GO TO EVA-TEST-GF-4-1. NC2254.2 +046900 EVA-DELETE-GF-4. NC2254.2 +047000 PERFORM DE-LETE. NC2254.2 +047100 PERFORM PRINT-DETAIL. NC2254.2 +047200 GO TO EVA-INIT-GF-5. NC2254.2 +047300 EVA-TEST-GF-4-1. NC2254.2 +047400 MOVE "EVA-TEST-GF-4-1" TO PAR-NAME. NC2254.2 +047500 EVALUATE WRK-XN-00001-1 NC2254.2 +047600 WHEN WRK-XN-00001-2 NC2254.2 +047700 GO TO EVA-FAIL-GF-4-1. NC2254.2 +047800 PERFORM PASS. NC2254.2 +047900 GO TO EVA-WRITE-GF-4-1. NC2254.2 +048000 EVA-DELETE-GF-4-1. NC2254.2 +048100 PERFORM DE-LETE. NC2254.2 +048200 GO TO EVA-WRITE-GF-4-1. NC2254.2 +048300 EVA-FAIL-GF-4-1. NC2254.2 +048400 MOVE "EXPECTING UNEQUAL IDENTIFIERS" TO RE-MARK NC2254.2 +048500 PERFORM FAIL. NC2254.2 +048600 EVA-WRITE-GF-4-1. NC2254.2 +048700 PERFORM PRINT-DETAIL. NC2254.2 +048800* NC2254.2 +048900 EVA-TEST-GF-4-2. NC2254.2 +049000 ADD 1 TO REC-CT. NC2254.2 +049100 EVALUATE WRK-XN-00001-1 NC2254.2 +049200 WHEN NOT WRK-XN-00001-2 NC2254.2 +049300 PERFORM PASS NC2254.2 +049400 GO TO EVA-WRITE-GF-4-2. NC2254.2 +049500 GO TO EVA-FAIL-GF-4-2. NC2254.2 +049600 EVA-DELETE-GF-4-2. NC2254.2 +049700 PERFORM DE-LETE. NC2254.2 +049800 GO TO EVA-WRITE-GF-4-2. NC2254.2 +049900 EVA-FAIL-GF-4-2. NC2254.2 +050000 MOVE "EXPECTING UNEQUAL IDENTIFIERS" TO RE-MARK. NC2254.2 +050100 PERFORM FAIL. NC2254.2 +050200 EVA-WRITE-GF-4-2. NC2254.2 +050300 MOVE "EVA-TEST-GF-4-2" TO PAR-NAME. NC2254.2 +050400 PERFORM PRINT-DETAIL. NC2254.2 +050500* NC2254.2 +050600 EVA-INIT-GF-5. NC2254.2 +050700 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +050800 MOVE 1 TO REC-CT. NC2254.2 +050900 MOVE "A" TO WRK-XN-00001-1. NC2254.2 +051000 GO TO EVA-TEST-GF-5-1. NC2254.2 +051100 EVA-DELETE-GF-5. NC2254.2 +051200 PERFORM DE-LETE. NC2254.2 +051300 PERFORM PRINT-DETAIL. NC2254.2 +051400 GO TO EVA-INIT-GF-6. NC2254.2 +051500 EVA-TEST-GF-5-1. NC2254.2 +051600 MOVE "EVA-TEST-GF-5-1" TO PAR-NAME. NC2254.2 +051700 EVALUATE WRK-XN-00001-1 NC2254.2 +051800 WHEN "A" NC2254.2 +051900 PERFORM PASS NC2254.2 +052000 GO TO EVA-WRITE-GF-5-1. NC2254.2 +052100 GO TO EVA-FAIL-GF-5-1. NC2254.2 +052200 EVA-DELETE-GF-5-1. NC2254.2 +052300 PERFORM DE-LETE. NC2254.2 +052400 GO TO EVA-WRITE-GF-5-1. NC2254.2 +052500 EVA-FAIL-GF-5-1. NC2254.2 +052600 MOVE "EXPECTING EQUAL LITERAL" TO RE-MARK. NC2254.2 +052700 PERFORM FAIL. NC2254.2 +052800 EVA-WRITE-GF-5-1. NC2254.2 +052900 PERFORM PRINT-DETAIL. NC2254.2 +053000* NC2254.2 +053100 EVA-TEST-GF-5-2. NC2254.2 +053200 ADD 1 TO REC-CT. NC2254.2 +053300 MOVE "EVA-TEST-GF-5-2" TO PAR-NAME. NC2254.2 +053400 EVALUATE WRK-XN-00001-1 NC2254.2 +053500 WHEN NOT "A" NC2254.2 +053600 GO TO EVA-FAIL-GF-5-2. NC2254.2 +053700 PERFORM PASS. NC2254.2 +053800 GO TO EVA-WRITE-GF-5-2. NC2254.2 +053900 EVA-DELETE-GF-5-2. NC2254.2 +054000 PERFORM DE-LETE. NC2254.2 +054100 GO TO EVA-WRITE-GF-5-2. NC2254.2 +054200 EVA-FAIL-GF-5-2. NC2254.2 +054300 MOVE "EXPECTING EQUAL LITERAL" TO RE-MARK NC2254.2 +054400 PERFORM FAIL. NC2254.2 +054500 EVA-WRITE-GF-5-2. NC2254.2 +054600 PERFORM PRINT-DETAIL. NC2254.2 +054700* NC2254.2 +054800 EVA-INIT-GF-6. NC2254.2 +054900 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +055000 MOVE 1 TO REC-CT. NC2254.2 +055100 MOVE "A" TO WRK-XN-00001-1. NC2254.2 +055200 GO TO EVA-TEST-GF-6-1. NC2254.2 +055300 EVA-DELETE-GF-6. NC2254.2 +055400 PERFORM DE-LETE. NC2254.2 +055500 PERFORM PRINT-DETAIL. NC2254.2 +055600 GO TO EVA-INIT-GF-7. NC2254.2 +055700 EVA-TEST-GF-6-1. NC2254.2 +055800 MOVE "EVA-TEST-GF-6-1" TO PAR-NAME. NC2254.2 +055900 EVALUATE WRK-XN-00001-1 NC2254.2 +056000 WHEN "Z" NC2254.2 +056100 GO TO EVA-FAIL-GF-6-1. NC2254.2 +056200 PERFORM PASS. NC2254.2 +056300 GO TO EVA-WRITE-GF-6-1. NC2254.2 +056400 EVA-DELETE-GF-6-1. NC2254.2 +056500 PERFORM DE-LETE. NC2254.2 +056600 GO TO EVA-WRITE-GF-6-1. NC2254.2 +056700 EVA-FAIL-GF-6-1. NC2254.2 +056800 MOVE "EXPECTING UNEQUAL LITERAL" TO RE-MARK NC2254.2 +056900 PERFORM FAIL. NC2254.2 +057000 EVA-WRITE-GF-6-1. NC2254.2 +057100 PERFORM PRINT-DETAIL. NC2254.2 +057200* NC2254.2 +057300 EVA-TEST-GF-6-2. NC2254.2 +057400 ADD 1 TO REC-CT. NC2254.2 +057500 MOVE "EVA-TEST-GF-6-2" TO PAR-NAME. NC2254.2 +057600 EVALUATE WRK-XN-00001-1 NC2254.2 +057700 WHEN NOT "Z" NC2254.2 +057800 PERFORM PASS NC2254.2 +057900 GO TO EVA-WRITE-GF-6-2. NC2254.2 +058000 GO TO EVA-FAIL-GF-6-2. NC2254.2 +058100 EVA-DELETE-GF-6-2. NC2254.2 +058200 PERFORM DE-LETE. NC2254.2 +058300 GO TO EVA-WRITE-GF-6-2. NC2254.2 +058400 EVA-FAIL-GF-6-2. NC2254.2 +058500 MOVE "EXPECTING UNEQUAL LITERAL" TO RE-MARK. NC2254.2 +058600 PERFORM FAIL. NC2254.2 +058700 EVA-WRITE-GF-6-2. NC2254.2 +058800 PERFORM PRINT-DETAIL. NC2254.2 +058900* NC2254.2 +059000 EVA-INIT-GF-7. NC2254.2 +059100 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +059200 MOVE 1 TO REC-CT. NC2254.2 +059300 MOVE 89 TO WRK-DU-08V00. NC2254.2 +059400 GO TO EVA-TEST-GF-7-1. NC2254.2 +059500 EVA-DELETE-GF-7. NC2254.2 +059600 PERFORM DE-LETE. NC2254.2 +059700 PERFORM PRINT-DETAIL. NC2254.2 +059800 GO TO EVA-INIT-GF-8. NC2254.2 +059900 EVA-TEST-GF-7-1. NC2254.2 +060000 MOVE "EVA-TEST-GF-7-1" TO PAR-NAME. NC2254.2 +060100 EVALUATE WRK-DU-08V00 NC2254.2 +060200 WHEN (33 + (99 - 43)) NC2254.2 +060300 PERFORM PASS NC2254.2 +060400 GO TO EVA-WRITE-GF-7-1. NC2254.2 +060500 GO TO EVA-FAIL-GF-7-1. NC2254.2 +060600 EVA-DELETE-GF-7-1. NC2254.2 +060700 PERFORM DE-LETE. NC2254.2 +060800 GO TO EVA-WRITE-GF-7-1. NC2254.2 +060900 EVA-FAIL-GF-7-1. NC2254.2 +061000 MOVE "EXPECTING EQUAL ARITHMETIC EXPRESSION" TO RE-MARK. NC2254.2 +061100 PERFORM FAIL. NC2254.2 +061200 EVA-WRITE-GF-7-1. NC2254.2 +061300 PERFORM PRINT-DETAIL. NC2254.2 +061400* NC2254.2 +061500 EVA-TEST-GF-7-2. NC2254.2 +061600 ADD 1 TO REC-CT. NC2254.2 +061700 MOVE "EVA-TEST-GF-7-2" TO PAR-NAME. NC2254.2 +061800 EVALUATE WRK-DU-08V00 NC2254.2 +061900 WHEN NOT (33 + (99 - 43)) NC2254.2 +062000 GO TO EVA-FAIL-GF-7-2. NC2254.2 +062100 PERFORM PASS. NC2254.2 +062200 GO TO EVA-WRITE-GF-7-2. NC2254.2 +062300 EVA-DELETE-GF-7-2. NC2254.2 +062400 PERFORM DE-LETE. NC2254.2 +062500 GO TO EVA-WRITE-GF-7-2. NC2254.2 +062600 EVA-FAIL-GF-7-2. NC2254.2 +062700 MOVE "EXPECTING EQUAL ARITHMETIC EXPRESSION" NC2254.2 +062800 TO RE-MARK NC2254.2 +062900 PERFORM FAIL. NC2254.2 +063000 EVA-WRITE-GF-7-2. NC2254.2 +063100 PERFORM PRINT-DETAIL. NC2254.2 +063200* NC2254.2 +063300 EVA-INIT-GF-8. NC2254.2 +063400 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +063500 MOVE 1 TO REC-CT. NC2254.2 +063600 MOVE 89 TO WRK-DU-08V00. NC2254.2 +063700 GO TO EVA-TEST-GF-8-1. NC2254.2 +063800 EVA-DELETE-GF-8. NC2254.2 +063900 PERFORM DE-LETE. NC2254.2 +064000 PERFORM PRINT-DETAIL. NC2254.2 +064100 GO TO EVA-INIT-GF-9. NC2254.2 +064200 EVA-TEST-GF-8-1. NC2254.2 +064300 MOVE "EVA-TEST-GF-8-1" TO PAR-NAME. NC2254.2 +064400 EVALUATE WRK-DU-08V00 NC2254.2 +064500 WHEN (2 + 4 + 8 + 16 + 32 + 64) NC2254.2 +064600 GO TO EVA-FAIL-GF-8-1. NC2254.2 +064700 PERFORM PASS. NC2254.2 +064800 GO TO EVA-WRITE-GF-8-1. NC2254.2 +064900 EVA-DELETE-GF-8-1. NC2254.2 +065000 PERFORM DE-LETE. NC2254.2 +065100 GO TO EVA-WRITE-GF-8-1. NC2254.2 +065200 EVA-FAIL-GF-8-1. NC2254.2 +065300 MOVE "EXPECTING UNEQUAL ARITHMETIC EXPRESSION" NC2254.2 +065400 TO RE-MARK NC2254.2 +065500 PERFORM FAIL. NC2254.2 +065600 EVA-WRITE-GF-8-1. NC2254.2 +065700 PERFORM PRINT-DETAIL. NC2254.2 +065800* NC2254.2 +065900 EVA-TEST-GF-8-2. NC2254.2 +066000 ADD 1 TO REC-CT. NC2254.2 +066100 MOVE "EVA-TEST-GF-8-2" TO PAR-NAME. NC2254.2 +066200 EVALUATE WRK-DU-08V00 NC2254.2 +066300 WHEN NOT (2 + 4 + 8 + 16 + 32 + 64) NC2254.2 +066400 PERFORM PASS NC2254.2 +066500 GO TO EVA-WRITE-GF-8-2. NC2254.2 +066600 GO TO EVA-FAIL-GF-8-2. NC2254.2 +066700 EVA-DELETE-GF-8-2. NC2254.2 +066800 PERFORM DE-LETE. NC2254.2 +066900 GO TO EVA-WRITE-GF-8-2. NC2254.2 +067000 EVA-FAIL-GF-8-2. NC2254.2 +067100 MOVE "EXPECTING UNEQUAL ARITHMETIC EXPRESSION" TO RE-MARK. NC2254.2 +067200 PERFORM FAIL. NC2254.2 +067300 EVA-WRITE-GF-8-2. NC2254.2 +067400 PERFORM PRINT-DETAIL. NC2254.2 +067500* NC2254.2 +067600 EVA-INIT-GF-9. NC2254.2 +067700 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +067800 MOVE 1 TO REC-CT. NC2254.2 +067900 MOVE "J" TO WRK-XN-00001-1. NC2254.2 +068000 MOVE "A" TO WRK-XN-00001-2. NC2254.2 +068100 MOVE "N" TO WRK-XN-00001-3. NC2254.2 +068200 GO TO EVA-TEST-GF-9-1. NC2254.2 +068300 EVA-DELETE-GF-9. NC2254.2 +068400 PERFORM DE-LETE. NC2254.2 +068500 PERFORM PRINT-DETAIL. NC2254.2 +068600 GO TO EVA-INIT-GF-10. NC2254.2 +068700 EVA-TEST-GF-9-1. NC2254.2 +068800 MOVE "EVA-TEST-GF-9-1" TO PAR-NAME. NC2254.2 +068900 EVALUATE WRK-XN-00001-1 NC2254.2 +069000 WHEN WRK-XN-00001-2 THRU WRK-XN-00001-3 NC2254.2 +069100 PERFORM PASS NC2254.2 +069200 GO TO EVA-WRITE-GF-9-1. NC2254.2 +069300 GO TO EVA-FAIL-GF-9-1. NC2254.2 +069400 EVA-DELETE-GF-9-1. NC2254.2 +069500 PERFORM DE-LETE. NC2254.2 +069600 GO TO EVA-WRITE-GF-9-1. NC2254.2 +069700 EVA-FAIL-GF-9-1. NC2254.2 +069800 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +069900 TO RE-MARK. NC2254.2 +070000 PERFORM FAIL. NC2254.2 +070100 EVA-WRITE-GF-9-1. NC2254.2 +070200 PERFORM PRINT-DETAIL. NC2254.2 +070300* NC2254.2 +070400 EVA-TEST-GF-9-2. NC2254.2 +070500 ADD 1 TO REC-CT. NC2254.2 +070600 MOVE "EVA-TEST-GF-9-2" TO PAR-NAME. NC2254.2 +070700 EVALUATE WRK-XN-00001-1 NC2254.2 +070800 WHEN NOT WRK-XN-00001-2 THRU WRK-XN-00001-3 NC2254.2 +070900 GO TO EVA-FAIL-GF-9-2. NC2254.2 +071000 PERFORM PASS. NC2254.2 +071100 GO TO EVA-WRITE-GF-9-2. NC2254.2 +071200 EVA-DELETE-GF-9-2. NC2254.2 +071300 PERFORM DE-LETE. NC2254.2 +071400 GO TO EVA-WRITE-GF-9-2. NC2254.2 +071500 EVA-FAIL-GF-9-2. NC2254.2 +071600 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +071700 TO RE-MARK NC2254.2 +071800 PERFORM FAIL. NC2254.2 +071900 EVA-WRITE-GF-9-2. NC2254.2 +072000 PERFORM PRINT-DETAIL. NC2254.2 +072100* NC2254.2 +072200 EVA-INIT-GF-10. NC2254.2 +072300 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +072400 MOVE 1 TO REC-CT. NC2254.2 +072500 MOVE "J" TO WRK-XN-00001-1. NC2254.2 +072600 MOVE "A" TO WRK-XN-00001-2. NC2254.2 +072700 MOVE "N" TO WRK-XN-00001-3. NC2254.2 +072800 GO TO EVA-TEST-GF-10-1. NC2254.2 +072900 EVA-DELETE-GF-10. NC2254.2 +073000 PERFORM DE-LETE. NC2254.2 +073100 PERFORM PRINT-DETAIL. NC2254.2 +073200 GO TO EVA-INIT-GF-11. NC2254.2 +073300 EVA-TEST-GF-10-1. NC2254.2 +073400 MOVE "EVA-TEST-GF-10-1" TO PAR-NAME. NC2254.2 +073500 EVALUATE WRK-XN-00001-3 NC2254.2 +073600 WHEN WRK-XN-00001-2 THRU WRK-XN-00001-1 NC2254.2 +073700 GO TO EVA-FAIL-GF-10-1. NC2254.2 +073800 PERFORM PASS. NC2254.2 +073900 GO TO EVA-WRITE-GF-10-1. NC2254.2 +074000 EVA-DELETE-GF-10-1. NC2254.2 +074100 PERFORM DE-LETE. NC2254.2 +074200 GO TO EVA-WRITE-GF-10-1. NC2254.2 +074300 EVA-FAIL-GF-10-1. NC2254.2 +074400 MOVE "SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +074500 TO RE-MARK NC2254.2 +074600 PERFORM FAIL. NC2254.2 +074700 EVA-WRITE-GF-10-1. NC2254.2 +074800 PERFORM PRINT-DETAIL. NC2254.2 +074900* NC2254.2 +075000 EVA-TEST-GF-10-2. NC2254.2 +075100 ADD 1 TO REC-CT. NC2254.2 +075200 MOVE "EVA-TEST-GF-10-2" TO PAR-NAME. NC2254.2 +075300 EVALUATE WRK-XN-00001-3 NC2254.2 +075400 WHEN NOT WRK-XN-00001-2 THRU WRK-XN-00001-1 NC2254.2 +075500 PERFORM PASS NC2254.2 +075600 GO TO EVA-WRITE-GF-10-2. NC2254.2 +075700 GO TO EVA-FAIL-GF-10-2. NC2254.2 +075800 EVA-DELETE-GF-10-2. NC2254.2 +075900 PERFORM DE-LETE. NC2254.2 +076000 GO TO EVA-WRITE-GF-10-2. NC2254.2 +076100 EVA-FAIL-GF-10-2. NC2254.2 +076200 MOVE " SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +076300 TO RE-MARK. NC2254.2 +076400 PERFORM FAIL. NC2254.2 +076500 EVA-WRITE-GF-10-2. NC2254.2 +076600 PERFORM PRINT-DETAIL. NC2254.2 +076700* NC2254.2 +076800 EVA-INIT-GF-11. NC2254.2 +076900 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +077000 MOVE 1 TO REC-CT. NC2254.2 +077100 MOVE "J" TO WRK-XN-00001-1. NC2254.2 +077200 MOVE "A" TO WRK-XN-00001-2. NC2254.2 +077300 MOVE "N" TO WRK-XN-00001-3. NC2254.2 +077400 GO TO EVA-TEST-GF-11-1. NC2254.2 +077500 EVA-DELETE-GF-11. NC2254.2 +077600 PERFORM DE-LETE. NC2254.2 +077700 PERFORM PRINT-DETAIL. NC2254.2 +077800 GO TO EVA-INIT-GF-12. NC2254.2 +077900 EVA-TEST-GF-11-1. NC2254.2 +078000 MOVE "EVA-TEST-GF-11-1" TO PAR-NAME. NC2254.2 +078100 EVALUATE WRK-XN-00001-1 NC2254.2 +078200 WHEN "A" THROUGH "N" NC2254.2 +078300 PERFORM PASS NC2254.2 +078400 GO TO EVA-WRITE-GF-11-1. NC2254.2 +078500 GO TO EVA-FAIL-GF-11-1. NC2254.2 +078600 EVA-DELETE-GF-11-1. NC2254.2 +078700 PERFORM DE-LETE. NC2254.2 +078800 GO TO EVA-WRITE-GF-11-1. NC2254.2 +078900 EVA-FAIL-GF-11-1. NC2254.2 +079000 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +079100 TO RE-MARK. NC2254.2 +079200 PERFORM FAIL. NC2254.2 +079300 EVA-WRITE-GF-11-1. NC2254.2 +079400 PERFORM PRINT-DETAIL. NC2254.2 +079500* NC2254.2 +079600 EVA-TEST-GF-11-2. NC2254.2 +079700 ADD 1 TO REC-CT. NC2254.2 +079800 MOVE "EVA-TEST-GF-11-2" TO PAR-NAME. NC2254.2 +079900 EVALUATE WRK-XN-00001-1 NC2254.2 +080000 WHEN NOT "A" THROUGH "N" NC2254.2 +080100 GO TO EVA-FAIL-GF-11-2. NC2254.2 +080200 PERFORM PASS. NC2254.2 +080300 GO TO EVA-WRITE-GF-11-2. NC2254.2 +080400 EVA-DELETE-GF-11-2. NC2254.2 +080500 PERFORM DE-LETE. NC2254.2 +080600 GO TO EVA-WRITE-GF-11-2. NC2254.2 +080700 EVA-FAIL-GF-11-2. NC2254.2 +080800 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +080900 TO RE-MARK NC2254.2 +081000 PERFORM FAIL. NC2254.2 +081100 EVA-WRITE-GF-11-2. NC2254.2 +081200 PERFORM PRINT-DETAIL. NC2254.2 +081300* NC2254.2 +081400 EVA-INIT-GF-12. NC2254.2 +081500 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +081600 MOVE 1 TO REC-CT. NC2254.2 +081700 MOVE "J" TO WRK-XN-00001-1. NC2254.2 +081800 MOVE "A" TO WRK-XN-00001-2. NC2254.2 +081900 MOVE "N" TO WRK-XN-00001-3. NC2254.2 +082000 GO TO EVA-TEST-GF-12-1. NC2254.2 +082100 EVA-DELETE-GF-12. NC2254.2 +082200 PERFORM DE-LETE. NC2254.2 +082300 PERFORM PRINT-DETAIL. NC2254.2 +082400 GO TO EVA-INIT-GF-13. NC2254.2 +082500 EVA-TEST-GF-12-1. NC2254.2 +082600 MOVE "EVA-TEST-GF-12-1" TO PAR-NAME. NC2254.2 +082700 EVALUATE WRK-XN-00001-3 NC2254.2 +082800 WHEN "A" THROUGH "J" NC2254.2 +082900 GO TO EVA-FAIL-GF-12-1. NC2254.2 +083000 PERFORM PASS. NC2254.2 +083100 GO TO EVA-WRITE-GF-12-1. NC2254.2 +083200 EVA-DELETE-GF-12-1. NC2254.2 +083300 PERFORM DE-LETE. NC2254.2 +083400 GO TO EVA-WRITE-GF-12-1. NC2254.2 +083500 EVA-FAIL-GF-12-1. NC2254.2 +083600 MOVE "SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +083700 TO RE-MARK NC2254.2 +083800 PERFORM FAIL. NC2254.2 +083900 EVA-WRITE-GF-12-1. NC2254.2 +084000 PERFORM PRINT-DETAIL. NC2254.2 +084100* NC2254.2 +084200 EVA-TEST-GF-12-2. NC2254.2 +084300 ADD 1 TO REC-CT. NC2254.2 +084400 MOVE "EVA-TEST-GF-12-2" TO PAR-NAME. NC2254.2 +084500 EVALUATE WRK-XN-00001-3 NC2254.2 +084600 WHEN NOT "A" THROUGH "J" NC2254.2 +084700 PERFORM PASS NC2254.2 +084800 GO TO EVA-WRITE-GF-12-2. NC2254.2 +084900 GO TO EVA-FAIL-GF-12-2. NC2254.2 +085000 EVA-DELETE-GF-12-2. NC2254.2 +085100 PERFORM DE-LETE. NC2254.2 +085200 GO TO EVA-WRITE-GF-12-2. NC2254.2 +085300 EVA-FAIL-GF-12-2. NC2254.2 +085400 MOVE " SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +085500 TO RE-MARK. NC2254.2 +085600 PERFORM FAIL. NC2254.2 +085700 EVA-WRITE-GF-12-2. NC2254.2 +085800 PERFORM PRINT-DETAIL. NC2254.2 +085900* NC2254.2 +086000 EVA-INIT-GF-13. NC2254.2 +086100 MOVE "VI-84 6.12.4 GR1(a)" TO ANSI-REFERENCE. NC2254.2 +086200 MOVE 1 TO REC-CT. NC2254.2 +086300 MOVE 89 TO WRK-DU-08V00. NC2254.2 +086400 GO TO EVA-TEST-GF-13-1. NC2254.2 +086500 EVA-DELETE-GF-13. NC2254.2 +086600 PERFORM DE-LETE. NC2254.2 +086700 PERFORM PRINT-DETAIL. NC2254.2 +086800 GO TO EVA-INIT-GF-14. NC2254.2 +086900 EVA-TEST-GF-13-1. NC2254.2 +087000 MOVE "EVA-TEST-GF-13-1" TO PAR-NAME. NC2254.2 +087100 EVALUATE WRK-DU-08V00 NC2254.2 +087200 WHEN (11 + (99 - 43)) THRU (20 * 5) NC2254.2 +087300 PERFORM PASS NC2254.2 +087400 GO TO EVA-WRITE-GF-13-1. NC2254.2 +087500 GO TO EVA-FAIL-GF-13-1. NC2254.2 +087600 EVA-DELETE-GF-13-1. NC2254.2 +087700 PERFORM DE-LETE. NC2254.2 +087800 GO TO EVA-WRITE-GF-13-1. NC2254.2 +087900 EVA-FAIL-GF-13-1. NC2254.2 +088000 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +088100 TO RE-MARK. NC2254.2 +088200 PERFORM FAIL. NC2254.2 +088300 EVA-WRITE-GF-13-1. NC2254.2 +088400 PERFORM PRINT-DETAIL. NC2254.2 +088500* NC2254.2 +088600 EVA-TEST-GF-13-2. NC2254.2 +088700 ADD 1 TO REC-CT. NC2254.2 +088800 MOVE "EVA-TEST-GF-13-2" TO PAR-NAME. NC2254.2 +088900 EVALUATE WRK-DU-08V00 NC2254.2 +089000 WHEN NOT (11 + (99 - 43)) THRU (20 * 5) NC2254.2 +089100 GO TO EVA-FAIL-GF-13-2. NC2254.2 +089200 PERFORM PASS. NC2254.2 +089300 GO TO EVA-WRITE-GF-13-2. NC2254.2 +089400 EVA-DELETE-GF-13-2. NC2254.2 +089500 PERFORM DE-LETE. NC2254.2 +089600 GO TO EVA-WRITE-GF-13-2. NC2254.2 +089700 EVA-FAIL-GF-13-2. NC2254.2 +089800 MOVE "SUBJECT IDENTIFIER SHOULD BE WITHIN RANGE" NC2254.2 +089900 TO RE-MARK NC2254.2 +090000 PERFORM FAIL. NC2254.2 +090100 EVA-WRITE-GF-13-2. NC2254.2 +090200 PERFORM PRINT-DETAIL. NC2254.2 +090300* NC2254.2 +090400 EVA-INIT-GF-14. NC2254.2 +090500 MOVE "VI-84 6.12.4 GR1(A)" TO ANSI-REFERENCE. NC2254.2 +090600 MOVE 1 TO REC-CT. NC2254.2 +090700 MOVE 89 TO WRK-DU-08V00. NC2254.2 +090800 GO TO EVA-TEST-GF-14-1. NC2254.2 +090900 EVA-DELETE-GF-14. NC2254.2 +091000 PERFORM DE-LETE. NC2254.2 +091100 PERFORM PRINT-DETAIL. NC2254.2 +091200 GO TO EVA-INIT-GF-15. NC2254.2 +091300 EVA-TEST-GF-14-1. NC2254.2 +091400 MOVE "EVA-TEST-GF-14-1" TO PAR-NAME. NC2254.2 +091500 EVALUATE WRK-DU-08V00 NC2254.2 +091600 WHEN (11 + (99 - 20)) THRU (20 * 5) NC2254.2 +091700 GO TO EVA-FAIL-GF-14-1. NC2254.2 +091800 PERFORM PASS. NC2254.2 +091900 GO TO EVA-WRITE-GF-14-1. NC2254.2 +092000 EVA-DELETE-GF-14-1. NC2254.2 +092100 PERFORM DE-LETE. NC2254.2 +092200 GO TO EVA-WRITE-GF-14-1. NC2254.2 +092300 EVA-FAIL-GF-14-1. NC2254.2 +092400 MOVE "SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +092500 TO RE-MARK NC2254.2 +092600 PERFORM FAIL. NC2254.2 +092700 EVA-WRITE-GF-14-1. NC2254.2 +092800 PERFORM PRINT-DETAIL. NC2254.2 +092900* NC2254.2 +093000 EVA-TEST-GF-14-2. NC2254.2 +093100 ADD 1 TO REC-CT. NC2254.2 +093200 MOVE "EVA-TEST-GF-14-2" TO PAR-NAME. NC2254.2 +093300 EVALUATE WRK-DU-08V00 NC2254.2 +093400 WHEN NOT (11 + (99 - 20)) THRU (20 * 5) NC2254.2 +093500 PERFORM PASS NC2254.2 +093600 GO TO EVA-WRITE-GF-14-2. NC2254.2 +093700 GO TO EVA-FAIL-GF-14-2. NC2254.2 +093800 EVA-DELETE-GF-14-2. NC2254.2 +093900 PERFORM DE-LETE. NC2254.2 +094000 GO TO EVA-WRITE-GF-14-2. NC2254.2 +094100 EVA-FAIL-GF-14-2. NC2254.2 +094200 MOVE "SUBJECT IDENTIFIER SHOULD NOT BE WITHIN RANGE" NC2254.2 +094300 TO RE-MARK. NC2254.2 +094400 PERFORM FAIL. NC2254.2 +094500 EVA-WRITE-GF-14-2. NC2254.2 +094600 PERFORM PRINT-DETAIL. NC2254.2 +094700* NC2254.2 +094800 EVA-INIT-GF-15. NC2254.2 +094900 MOVE "VI-84 6.12.4 GR1(b)" TO ANSI-REFERENCE. NC2254.2 +095000 MOVE 1 TO REC-CT. NC2254.2 +095100 MOVE 26 TO WRK-DU-08V00. NC2254.2 +095200 GO TO EVA-TEST-GF-15-1. NC2254.2 +095300 EVA-DELETE-GF-15. NC2254.2 +095400 PERFORM DE-LETE. NC2254.2 +095500 PERFORM PRINT-DETAIL. NC2254.2 +095600 GO TO EVA-INIT-GF-16. NC2254.2 +095700 EVA-TEST-GF-15-1. NC2254.2 +095800 MOVE "EVA-TEST-GF-15-1" TO PAR-NAME. NC2254.2 +095900 EVALUATE 26 NC2254.2 +096000 WHEN WRK-DU-08V00 NC2254.2 +096100 PERFORM PASS NC2254.2 +096200 GO TO EVA-WRITE-GF-15-1. NC2254.2 +096300 GO TO EVA-FAIL-GF-15-1. NC2254.2 +096400 EVA-DELETE-GF-15-1. NC2254.2 +096500 PERFORM DE-LETE. NC2254.2 +096600 GO TO EVA-WRITE-GF-15-1. NC2254.2 +096700 EVA-FAIL-GF-15-1. NC2254.2 +096800 MOVE "IDENTIFIER AND LITERAL SHOULD BE EQUAL" NC2254.2 +096900 TO RE-MARK. NC2254.2 +097000 PERFORM FAIL. NC2254.2 +097100 EVA-WRITE-GF-15-1. NC2254.2 +097200 PERFORM PRINT-DETAIL. NC2254.2 +097300* NC2254.2 +097400 EVA-TEST-GF-15-2. NC2254.2 +097500 ADD 1 TO REC-CT. NC2254.2 +097600 MOVE "EVA-TEST-GF-15-2" TO PAR-NAME. NC2254.2 +097700 EVALUATE 26 NC2254.2 +097800 WHEN NOT WRK-DU-08V00 NC2254.2 +097900 GO TO EVA-FAIL-GF-15-2. NC2254.2 +098000 PERFORM PASS. NC2254.2 +098100 GO TO EVA-WRITE-GF-15-2. NC2254.2 +098200 EVA-DELETE-GF-15-2. NC2254.2 +098300 PERFORM DE-LETE. NC2254.2 +098400 GO TO EVA-WRITE-GF-15-2. NC2254.2 +098500 EVA-FAIL-GF-15-2. NC2254.2 +098600 MOVE "IDENTIFIER AND LITERAL SHOULD BE EQUAL" NC2254.2 +098700 TO RE-MARK NC2254.2 +098800 PERFORM FAIL. NC2254.2 +098900 EVA-WRITE-GF-15-2. NC2254.2 +099000 PERFORM PRINT-DETAIL. NC2254.2 +099100* NC2254.2 +099200 EVA-INIT-GF-16. NC2254.2 +099300 MOVE "VI-84 6.12.4 GR1(b)" TO ANSI-REFERENCE. NC2254.2 +099400 MOVE 1 TO REC-CT. NC2254.2 +099500 MOVE 78 TO WRK-DU-08V00. NC2254.2 +099600 GO TO EVA-TEST-GF-16-1. NC2254.2 +099700 EVA-DELETE-GF-16. NC2254.2 +099800 PERFORM DE-LETE. NC2254.2 +099900 PERFORM PRINT-DETAIL. NC2254.2 +100000 GO TO EVA-INIT-GF-17. NC2254.2 +100100 EVA-TEST-GF-16-1. NC2254.2 +100200 MOVE "EVA-TEST-GF-16-1" TO PAR-NAME. NC2254.2 +100300 EVALUATE 1234 NC2254.2 +100400 WHEN WRK-DU-08V00 NC2254.2 +100500 GO TO EVA-FAIL-GF-16-1. NC2254.2 +100600 PERFORM PASS. NC2254.2 +100700 GO TO EVA-WRITE-GF-16-1. NC2254.2 +100800 EVA-DELETE-GF-16-1. NC2254.2 +100900 PERFORM DE-LETE. NC2254.2 +101000 GO TO EVA-WRITE-GF-16-1. NC2254.2 +101100 EVA-FAIL-GF-16-1. NC2254.2 +101200 MOVE "IDENTIFIER AND LITERAL SHOULD NOT BE EQUAL" NC2254.2 +101300 TO RE-MARK NC2254.2 +101400 PERFORM FAIL. NC2254.2 +101500 EVA-WRITE-GF-16-1. NC2254.2 +101600 PERFORM PRINT-DETAIL. NC2254.2 +101700* NC2254.2 +101800 EVA-TEST-GF-16-2. NC2254.2 +101900 ADD 1 TO REC-CT. NC2254.2 +102000 MOVE "EVA-TEST-GF-16-2" TO PAR-NAME. NC2254.2 +102100 EVALUATE 1234 NC2254.2 +102200 WHEN NOT WRK-DU-08V00 NC2254.2 +102300 PERFORM PASS NC2254.2 +102400 GO TO EVA-WRITE-GF-16-2. NC2254.2 +102500 GO TO EVA-FAIL-GF-16-2. NC2254.2 +102600 EVA-DELETE-GF-16-2. NC2254.2 +102700 PERFORM DE-LETE. NC2254.2 +102800 GO TO EVA-WRITE-GF-16-2. NC2254.2 +102900 EVA-FAIL-GF-16-2. NC2254.2 +103000 MOVE "IDENTIFIER AND LITERAL SHOULD NOT BE EQUAL" NC2254.2 +103100 TO RE-MARK. NC2254.2 +103200 PERFORM FAIL. NC2254.2 +103300 EVA-WRITE-GF-16-2. NC2254.2 +103400 PERFORM PRINT-DETAIL. NC2254.2 +103500* NC2254.2 +103600 EVA-INIT-GF-17. NC2254.2 +103700 MOVE "VI-84 6.12.4 GR1(d)" TO ANSI-REFERENCE. NC2254.2 +103800 MOVE 1 TO REC-CT. NC2254.2 +103900 MOVE 8 TO WRK-XN-00001-1. NC2254.2 +104000 GO TO EVA-TEST-GF-17-1. NC2254.2 +104100 EVA-DELETE-GF-17. NC2254.2 +104200 PERFORM DE-LETE. NC2254.2 +104300 PERFORM PRINT-DETAIL. NC2254.2 +104400 GO TO EVA-INIT-GF-18. NC2254.2 +104500 EVA-TEST-GF-17-1. NC2254.2 +104600 MOVE "EVA-TEST-GF-17-1" TO PAR-NAME. NC2254.2 +104700 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +104800 WHEN TRUE NC2254.2 +104900 PERFORM PASS NC2254.2 +105000 GO TO EVA-WRITE-GF-17-1. NC2254.2 +105100 GO TO EVA-FAIL-GF-17-1. NC2254.2 +105200 EVA-DELETE-GF-17-1. NC2254.2 +105300 PERFORM DE-LETE. NC2254.2 +105400 GO TO EVA-WRITE-GF-17-1. NC2254.2 +105500 EVA-FAIL-GF-17-1. NC2254.2 +105600 MOVE "CONDITIONAL EXPRESSION SHOULD BE TRUE" NC2254.2 +105700 TO RE-MARK. NC2254.2 +105800 PERFORM FAIL. NC2254.2 +105900 EVA-WRITE-GF-17-1. NC2254.2 +106000 PERFORM PRINT-DETAIL. NC2254.2 +106100* NC2254.2 +106200 EVA-TEST-GF-17-2. NC2254.2 +106300 ADD 1 TO REC-CT. NC2254.2 +106400 MOVE "EVA-TEST-GF-17-2" TO PAR-NAME. NC2254.2 +106500 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +106600 WHEN FALSE NC2254.2 +106700 GO TO EVA-FAIL-GF-17-2. NC2254.2 +106800 PERFORM PASS. NC2254.2 +106900 GO TO EVA-WRITE-GF-17-2. NC2254.2 +107000 EVA-DELETE-GF-17-2. NC2254.2 +107100 PERFORM DE-LETE. NC2254.2 +107200 GO TO EVA-WRITE-GF-17-2. NC2254.2 +107300 EVA-FAIL-GF-17-2. NC2254.2 +107400 MOVE "CONDITIONAL EXPRESSION SHOULD BE TRUE" NC2254.2 +107500 TO RE-MARK NC2254.2 +107600 PERFORM FAIL. NC2254.2 +107700 EVA-WRITE-GF-17-2. NC2254.2 +107800 PERFORM PRINT-DETAIL. NC2254.2 +107900* NC2254.2 +108000 EVA-TEST-GF-17-3. NC2254.2 +108100 ADD 1 TO REC-CT. NC2254.2 +108200 MOVE "EVA-TEST-GF-17-3" TO PAR-NAME. NC2254.2 +108300 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +108400 WHEN ANY NC2254.2 +108500 PERFORM PASS NC2254.2 +108600 GO TO EVA-WRITE-GF-17-3. NC2254.2 +108700 GO TO EVA-FAIL-GF-17-3. NC2254.2 +108800 EVA-DELETE-GF-17-3. NC2254.2 +108900 PERFORM DE-LETE. NC2254.2 +109000 GO TO EVA-WRITE-GF-17-3. NC2254.2 +109100 EVA-FAIL-GF-17-3. NC2254.2 +109200 MOVE "WHEN 'ANY' SHOULD HAVE EXECUTED" TO RE-MARK NC2254.2 +109300 PERFORM FAIL. NC2254.2 +109400 EVA-WRITE-GF-17-3. NC2254.2 +109500 PERFORM PRINT-DETAIL. NC2254.2 +109600* NC2254.2 +109700 EVA-INIT-GF-18. NC2254.2 +109800 MOVE "VI-84 6.12.4 GR1(d)" TO ANSI-REFERENCE. NC2254.2 +109900 MOVE 1 TO REC-CT. NC2254.2 +110000 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +110100 GO TO EVA-TEST-GF-18-1. NC2254.2 +110200 EVA-DELETE-GF-18. NC2254.2 +110300 PERFORM DE-LETE. NC2254.2 +110400 PERFORM PRINT-DETAIL. NC2254.2 +110500 GO TO EVA-INIT-GF-19. NC2254.2 +110600 EVA-TEST-GF-18-1. NC2254.2 +110700 MOVE "EVA-TEST-GF-18-1" TO PAR-NAME. NC2254.2 +110800 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +110900 WHEN TRUE NC2254.2 +111000 GO TO EVA-FAIL-GF-18-1. NC2254.2 +111100 PERFORM PASS. NC2254.2 +111200 GO TO EVA-WRITE-GF-18-1. NC2254.2 +111300 EVA-DELETE-GF-18-1. NC2254.2 +111400 PERFORM DE-LETE. NC2254.2 +111500 GO TO EVA-WRITE-GF-18-1. NC2254.2 +111600 EVA-FAIL-GF-18-1. NC2254.2 +111700 MOVE "CONDITIONAL EXPRESSION SHOULD BE FALSE" NC2254.2 +111800 TO RE-MARK NC2254.2 +111900 PERFORM FAIL. NC2254.2 +112000 EVA-WRITE-GF-18-1. NC2254.2 +112100 PERFORM PRINT-DETAIL. NC2254.2 +112200* NC2254.2 +112300 EVA-TEST-GF-18-2. NC2254.2 +112400 ADD 1 TO REC-CT. NC2254.2 +112500 MOVE "EVA-TEST-GF-18-2" TO PAR-NAME. NC2254.2 +112600 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +112700 WHEN FALSE NC2254.2 +112800 PERFORM PASS NC2254.2 +112900 GO TO EVA-WRITE-GF-18-2. NC2254.2 +113000 GO TO EVA-WRITE-GF-18-2. NC2254.2 +113100 EVA-DELETE-GF-18-2. NC2254.2 +113200 PERFORM DE-LETE. NC2254.2 +113300 GO TO EVA-WRITE-GF-18-2. NC2254.2 +113400 EVA-FAIL-GF-18-2. NC2254.2 +113500 MOVE "CONDITIONAL EXPRESSION SHOULD BE FALSE" NC2254.2 +113600 TO RE-MARK. NC2254.2 +113700 PERFORM FAIL. NC2254.2 +113800 EVA-WRITE-GF-18-2. NC2254.2 +113900 PERFORM PRINT-DETAIL. NC2254.2 +114000* NC2254.2 +114100 EVA-TEST-GF-18-3. NC2254.2 +114200 ADD 1 TO REC-CT. NC2254.2 +114300 MOVE "EVA-TEST-GF-18-3" TO PAR-NAME. NC2254.2 +114400 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +114500 WHEN ANY NC2254.2 +114600 PERFORM PASS NC2254.2 +114700 GO TO EVA-WRITE-GF-18-3. NC2254.2 +114800 GO TO EVA-FAIL-GF-18-3. NC2254.2 +114900 EVA-DELETE-GF-18-3. NC2254.2 +115000 PERFORM DE-LETE. NC2254.2 +115100 GO TO EVA-WRITE-GF-18-3. NC2254.2 +115200 EVA-FAIL-GF-18-3. NC2254.2 +115300 MOVE "WHEN 'ANY' SHOULD HAVE EXECUTED" TO RE-MARK NC2254.2 +115400 PERFORM FAIL. NC2254.2 +115500 EVA-WRITE-GF-18-3. NC2254.2 +115600 PERFORM PRINT-DETAIL. NC2254.2 +115700* NC2254.2 +115800 EVA-INIT-GF-19. NC2254.2 +115900 MOVE "VI-84 6.12.4 GR1(c)" TO ANSI-REFERENCE. NC2254.2 +116000 MOVE 1 TO REC-CT. NC2254.2 +116100 MOVE 9 TO WRK-DU-08V00. NC2254.2 +116200 GO TO EVA-TEST-GF-19-1. NC2254.2 +116300 EVA-DELETE-GF-19. NC2254.2 +116400 PERFORM DE-LETE. NC2254.2 +116500 PERFORM PRINT-DETAIL. NC2254.2 +116600 GO TO EVA-INIT-GF-20. NC2254.2 +116700 EVA-TEST-GF-19-1. NC2254.2 +116800 MOVE "EVA-TEST-GF-19-1" TO PAR-NAME. NC2254.2 +116900 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +117000 WHEN WS-81 NC2254.2 +117100 PERFORM PASS NC2254.2 +117200 GO TO EVA-WRITE-GF-19-1. NC2254.2 +117300 GO TO EVA-FAIL-GF-19-1. NC2254.2 +117400 EVA-DELETE-GF-19-1. NC2254.2 +117500 PERFORM DE-LETE. NC2254.2 +117600 GO TO EVA-WRITE-GF-19-1. NC2254.2 +117700 EVA-FAIL-GF-19-1. NC2254.2 +117800 MOVE "SELECTION SUBJECT SHOULD EQUAL IDENTIFIER" NC2254.2 +117900 TO RE-MARK. NC2254.2 +118000 PERFORM FAIL. NC2254.2 +118100 EVA-WRITE-GF-19-1. NC2254.2 +118200 PERFORM PRINT-DETAIL. NC2254.2 +118300* NC2254.2 +118400 EVA-TEST-GF-19-2. NC2254.2 +118500 ADD 1 TO REC-CT. NC2254.2 +118600 MOVE "EVA-TEST-GF-19-2" TO PAR-NAME. NC2254.2 +118700 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +118800 WHEN 81 NC2254.2 +118900 PERFORM PASS NC2254.2 +119000 GO TO EVA-WRITE-GF-19-2. NC2254.2 +119100 GO TO EVA-FAIL-GF-19-2. NC2254.2 +119200 EVA-DELETE-GF-19-2. NC2254.2 +119300 PERFORM DE-LETE. NC2254.2 +119400 GO TO EVA-WRITE-GF-19-2. NC2254.2 +119500 EVA-FAIL-GF-19-2. NC2254.2 +119600 MOVE "SELECTION SUBJECT SHOULD EQUAL LITERAL" NC2254.2 +119700 TO RE-MARK. NC2254.2 +119800 PERFORM FAIL. NC2254.2 +119900 EVA-WRITE-GF-19-2. NC2254.2 +120000 PERFORM PRINT-DETAIL. NC2254.2 +120100* NC2254.2 +120200 EVA-TEST-GF-19-3. NC2254.2 +120300 ADD 1 TO REC-CT. NC2254.2 +120400 MOVE "EVA-TEST-GF-19-3" TO PAR-NAME. NC2254.2 +120500 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +120600 WHEN (9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9) NC2254.2 +120700 PERFORM PASS NC2254.2 +120800 GO TO EVA-WRITE-GF-19-3. NC2254.2 +120900 GO TO EVA-FAIL-GF-19-3. NC2254.2 +121000 EVA-DELETE-GF-19-3. NC2254.2 +121100 PERFORM DE-LETE. NC2254.2 +121200 GO TO EVA-WRITE-GF-19-3. NC2254.2 +121300 EVA-FAIL-GF-19-3. NC2254.2 +121400 MOVE "SELECTION SUBJECT SHOULD EQUAL ARITHMETIC EXPRESSION"NC2254.2 +121500 TO RE-MARK. NC2254.2 +121600 PERFORM FAIL. NC2254.2 +121700 EVA-WRITE-GF-19-3. NC2254.2 +121800 PERFORM PRINT-DETAIL. NC2254.2 +121900* NC2254.2 +122000 EVA-INIT-GF-20. NC2254.2 +122100 MOVE "VI-84 6.12.4 GR1(c)" TO ANSI-REFERENCE. NC2254.2 +122200 MOVE 1 TO REC-CT. NC2254.2 +122300 MOVE 8 TO WRK-DU-08V00. NC2254.2 +122400 GO TO EVA-TEST-GF-20-1. NC2254.2 +122500 EVA-DELETE-GF-20. NC2254.2 +122600 PERFORM DE-LETE. NC2254.2 +122700 PERFORM PRINT-DETAIL. NC2254.2 +122800 GO TO EVA-INIT-GF-21. NC2254.2 +122900 EVA-TEST-GF-20-1. NC2254.2 +123000 MOVE "EVA-TEST-GF-20-1" TO PAR-NAME. NC2254.2 +123100 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +123200 WHEN WS-81 NC2254.2 +123300 GO TO EVA-FAIL-GF-20-1. NC2254.2 +123400 PERFORM PASS. NC2254.2 +123500 GO TO EVA-WRITE-GF-20-1. NC2254.2 +123600 EVA-DELETE-GF-20-1. NC2254.2 +123700 PERFORM DE-LETE. NC2254.2 +123800 GO TO EVA-WRITE-GF-20-1. NC2254.2 +123900 EVA-FAIL-GF-20-1. NC2254.2 +124000 MOVE "SELECTION SUBJECT SHOULD NOT EQUAL IDENTIFIER" NC2254.2 +124100 TO RE-MARK NC2254.2 +124200 PERFORM FAIL. NC2254.2 +124300 EVA-WRITE-GF-20-1. NC2254.2 +124400 PERFORM PRINT-DETAIL. NC2254.2 +124500* NC2254.2 +124600 EVA-TEST-GF-20-2. NC2254.2 +124700 ADD 1 TO REC-CT. NC2254.2 +124800 MOVE "EVA-TEST-GF-20-2" TO PAR-NAME. NC2254.2 +124900 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +125000 WHEN 81 NC2254.2 +125100 GO TO EVA-FAIL-GF-20-2. NC2254.2 +125200 PERFORM PASS. NC2254.2 +125300 GO TO EVA-WRITE-GF-20-2. NC2254.2 +125400 EVA-DELETE-GF-20-2. NC2254.2 +125500 PERFORM DE-LETE. NC2254.2 +125600 GO TO EVA-WRITE-GF-20-2. NC2254.2 +125700 EVA-FAIL-GF-20-2. NC2254.2 +125800 MOVE "SELECTION SUBJECT SHOULD NOT EQUAL LITERAL" NC2254.2 +125900 TO RE-MARK NC2254.2 +126000 PERFORM FAIL. NC2254.2 +126100 EVA-WRITE-GF-20-2. NC2254.2 +126200 PERFORM PRINT-DETAIL. NC2254.2 +126300 NC2254.2 +126400 EVA-TEST-GF-20-3. NC2254.2 +126500 ADD 1 TO REC-CT. NC2254.2 +126600 MOVE "EVA-TEST-GF-20-3" TO PAR-NAME. NC2254.2 +126700 EVALUATE (WRK-DU-08V00 * 9) NC2254.2 +126800 WHEN (9 + 9 + 9 + 9 + 9 + 9 + 9 + 9 + 9) NC2254.2 +126900 GO TO EVA-FAIL-GF-20-3. NC2254.2 +127000 PERFORM PASS. NC2254.2 +127100 GO TO EVA-WRITE-GF-20-3. NC2254.2 +127200 EVA-DELETE-GF-20-3. NC2254.2 +127300 PERFORM DE-LETE. NC2254.2 +127400 GO TO EVA-WRITE-GF-20-3. NC2254.2 +127500 EVA-FAIL-GF-20-3. NC2254.2 +127600 MOVE NC2254.2 +127700 "SELECTION SUBJECT SHOULD NOT = ARITHMETIC EXPRESSION" NC2254.2 +127800 TO RE-MARK NC2254.2 +127900 PERFORM FAIL. NC2254.2 +128000 EVA-WRITE-GF-20-3. NC2254.2 +128100 PERFORM PRINT-DETAIL. NC2254.2 +128200* NC2254.2 +128300 EVA-INIT-GF-21. NC2254.2 +128400 MOVE "VI-84 6.12.4 GR1(e)" TO ANSI-REFERENCE. NC2254.2 +128500 MOVE 1 TO REC-CT. NC2254.2 +128600 MOVE SPACE TO WRK-XN-00001-1. NC2254.2 +128700 GO TO EVA-TEST-GF-21-1. NC2254.2 +128800 EVA-DELETE-GF-21. NC2254.2 +128900 PERFORM DE-LETE. NC2254.2 +129000 PERFORM PRINT-DETAIL. NC2254.2 +129100 GO TO EVA-INIT-GF-22. NC2254.2 +129200 EVA-TEST-GF-21-1. NC2254.2 +129300 MOVE "EVA-TEST-GF-21-1" TO PAR-NAME. NC2254.2 +129400 EVALUATE TRUE NC2254.2 +129500 WHEN WRK-XN-00001-1 = SPACE NC2254.2 +129600 PERFORM PASS NC2254.2 +129700 GO TO EVA-WRITE-GF-21-1. NC2254.2 +129800 GO TO EVA-FAIL-GF-21-1. NC2254.2 +129900 EVA-DELETE-GF-21-1. NC2254.2 +130000 PERFORM DE-LETE. NC2254.2 +130100 GO TO EVA-WRITE-GF-21-1. NC2254.2 +130200 EVA-FAIL-GF-21-1. NC2254.2 +130300 MOVE "SELECTION OBJECT CONDITION SHOULD BE TRUE" NC2254.2 +130400 TO RE-MARK. NC2254.2 +130500 PERFORM FAIL. NC2254.2 +130600 EVA-WRITE-GF-21-1. NC2254.2 +130700 PERFORM PRINT-DETAIL. NC2254.2 +130800* NC2254.2 +130900 EVA-INIT-GF-22. NC2254.2 +131000 MOVE "VI-84 6.12.4 GR1(e)" TO ANSI-REFERENCE. NC2254.2 +131100 MOVE 1 TO REC-CT. NC2254.2 +131200 MOVE "#" TO WRK-XN-00001-1. NC2254.2 +131300 GO TO EVA-TEST-GF-22-1. NC2254.2 +131400 EVA-DELETE-GF-22. NC2254.2 +131500 PERFORM DE-LETE. NC2254.2 +131600 PERFORM PRINT-DETAIL. NC2254.2 +131700 GO TO EVA-INIT-GF-23. NC2254.2 +131800 EVA-TEST-GF-22-1. NC2254.2 +131900 MOVE "EVA-TEST-GF-22-1" TO PAR-NAME. NC2254.2 +132000 EVALUATE TRUE NC2254.2 +132100 WHEN WRK-XN-00001-1 = SPACE NC2254.2 +132200 GO TO EVA-FAIL-GF-22-1. NC2254.2 +132300 PERFORM PASS. NC2254.2 +132400 GO TO EVA-WRITE-GF-22-1. NC2254.2 +132500 EVA-DELETE-GF-22-1. NC2254.2 +132600 PERFORM DE-LETE. NC2254.2 +132700 GO TO EVA-WRITE-GF-22-1. NC2254.2 +132800 EVA-FAIL-GF-22-1. NC2254.2 +132900 MOVE "SELECTION OBJECT CONDITION SHOULD BE FALSE" NC2254.2 +133000 TO RE-MARK NC2254.2 +133100 PERFORM FAIL. NC2254.2 +133200 EVA-WRITE-GF-22-1. NC2254.2 +133300 PERFORM PRINT-DETAIL. NC2254.2 +133400* NC2254.2 +133500 EVA-INIT-GF-23. NC2254.2 +133600 MOVE "VI-84 6.12.4 GR1(e)" TO ANSI-REFERENCE. NC2254.2 +133700 MOVE 1 TO REC-CT. NC2254.2 +133800 MOVE SPACE TO WRK-XN-00001-1. NC2254.2 +133900 GO TO EVA-TEST-GF-23-1. NC2254.2 +134000 EVA-DELETE-GF-23. NC2254.2 +134100 PERFORM DE-LETE. NC2254.2 +134200 PERFORM PRINT-DETAIL. NC2254.2 +134300 GO TO EVA-INIT-GF-24. NC2254.2 +134400 EVA-TEST-GF-23-1. NC2254.2 +134500 MOVE "EVA-TEST-GF-23-1" TO PAR-NAME. NC2254.2 +134600 EVALUATE FALSE NC2254.2 +134700 WHEN WRK-XN-00001-1 = SPACE NC2254.2 +134800 GO TO EVA-FAIL-GF-23-1. NC2254.2 +134900 PERFORM PASS. NC2254.2 +135000 GO TO EVA-WRITE-GF-23-1. NC2254.2 +135100 EVA-DELETE-GF-23-1. NC2254.2 +135200 PERFORM DE-LETE. NC2254.2 +135300 GO TO EVA-WRITE-GF-23-1. NC2254.2 +135400 EVA-FAIL-GF-23-1. NC2254.2 +135500 MOVE "SELECTION OBJECT CONDITION SHOULD BE TRUE" NC2254.2 +135600 TO RE-MARK NC2254.2 +135700 PERFORM FAIL. NC2254.2 +135800 EVA-WRITE-GF-23-1. NC2254.2 +135900 PERFORM PRINT-DETAIL. NC2254.2 +136000* NC2254.2 +136100 EVA-INIT-GF-24. NC2254.2 +136200 MOVE "VI-84 6.12.4 GR1(e)" TO ANSI-REFERENCE. NC2254.2 +136300 MOVE 1 TO REC-CT. NC2254.2 +136400 MOVE "#" TO WRK-XN-00001-1. NC2254.2 +136500 GO TO EVA-TEST-GF-24-1. NC2254.2 +136600 EVA-DELETE-GF-24. NC2254.2 +136700 PERFORM DE-LETE. NC2254.2 +136800 PERFORM PRINT-DETAIL. NC2254.2 +136900 GO TO EVA-INIT-GF-25. NC2254.2 +137000 EVA-TEST-GF-24-1. NC2254.2 +137100 MOVE "EVA-TEST-GF-24-1" TO PAR-NAME. NC2254.2 +137200 EVALUATE FALSE NC2254.2 +137300 WHEN WRK-XN-00001-1 = SPACE NC2254.2 +137400 PERFORM PASS NC2254.2 +137500 GO TO EVA-WRITE-GF-24-1. NC2254.2 +137600 GO TO EVA-FAIL-GF-24-1. NC2254.2 +137700 EVA-DELETE-GF-24-1. NC2254.2 +137800 PERFORM DE-LETE. NC2254.2 +137900 GO TO EVA-WRITE-GF-24-1. NC2254.2 +138000 EVA-FAIL-GF-24-1. NC2254.2 +138100 MOVE "SELECTION OBJECT CONDITION SHOULD BE FALSE" NC2254.2 +138200 TO RE-MARK. NC2254.2 +138300 PERFORM FAIL. NC2254.2 +138400 EVA-WRITE-GF-24-1. NC2254.2 +138500 PERFORM PRINT-DETAIL. NC2254.2 +138600* NC2254.2 +138700 EVA-INIT-GF-25. NC2254.2 +138800 MOVE "VI-84 6.12.4 GR3(b)" TO ANSI-REFERENCE. NC2254.2 +138900 MOVE 1 TO REC-CT. NC2254.2 +139000 MOVE 26 TO WRK-DU-08V00. NC2254.2 +139100 GO TO EVA-TEST-GF-25-1. NC2254.2 +139200 EVA-DELETE-GF-25. NC2254.2 +139300 PERFORM DE-LETE. NC2254.2 +139400 PERFORM PRINT-DETAIL. NC2254.2 +139500 GO TO EVA-INIT-GF-16. NC2254.2 +139600 EVA-TEST-GF-25-1. NC2254.2 +139700 MOVE "EVA-TEST-GF-25-1" TO PAR-NAME. NC2254.2 +139800 EVALUATE 26 NC2254.2 +139900 WHEN WRK-DU-08V00 NC2254.2 +140000 PERFORM PASS NC2254.2 +140100 WHEN OTHER NC2254.2 +140200 GO TO EVA-FAIL-GF-25-1. NC2254.2 +140300 GO TO EVA-WRITE-GF-25-1. NC2254.2 +140400 EVA-DELETE-GF-25-1. NC2254.2 +140500 PERFORM DE-LETE. NC2254.2 +140600 GO TO EVA-WRITE-GF-25-1. NC2254.2 +140700 EVA-FAIL-GF-25-1. NC2254.2 +140800 MOVE "IDENTIFIER AND LITERAL SHOULD BE EQUAL" NC2254.2 +140900 TO RE-MARK NC2254.2 +141000 PERFORM FAIL. NC2254.2 +141100 EVA-WRITE-GF-25-1. NC2254.2 +141200 PERFORM PRINT-DETAIL. NC2254.2 +141300* NC2254.2 +141400 EVA-INIT-GF-26. NC2254.2 +141500 MOVE "VI-84 6.12.4 GR3(b)" TO ANSI-REFERENCE. NC2254.2 +141600 MOVE 1 TO REC-CT. NC2254.2 +141700 MOVE 78 TO WRK-DU-08V00. NC2254.2 +141800 GO TO EVA-TEST-GF-26-1. NC2254.2 +141900 EVA-DELETE-GF-26. NC2254.2 +142000 PERFORM DE-LETE. NC2254.2 +142100 PERFORM PRINT-DETAIL. NC2254.2 +142200 GO TO EVA-INIT-GF-27. NC2254.2 +142300 EVA-TEST-GF-26-1. NC2254.2 +142400 MOVE "EVA-TEST-GF-26-1" TO PAR-NAME. NC2254.2 +142500 EVALUATE 1234 NC2254.2 +142600 WHEN WRK-DU-08V00 NC2254.2 +142700 GO TO EVA-FAIL-GF-26-1 NC2254.2 +142800 WHEN OTHER NC2254.2 +142900 PERFORM PASS. NC2254.2 +143000 GO TO EVA-WRITE-GF-26-1. NC2254.2 +143100 EVA-DELETE-GF-26-1. NC2254.2 +143200 PERFORM DE-LETE. NC2254.2 +143300 GO TO EVA-WRITE-GF-26-1. NC2254.2 +143400 EVA-FAIL-GF-26-1. NC2254.2 +143500 MOVE "IDENTIFIER AND LITERAL SHOULD NOT BE EQUAL" NC2254.2 +143600 TO RE-MARK NC2254.2 +143700 PERFORM FAIL. NC2254.2 +143800 EVA-WRITE-GF-26-1. NC2254.2 +143900 PERFORM PRINT-DETAIL. NC2254.2 +144000* NC2254.2 +144100 EVA-INIT-GF-27. NC2254.2 +144200 MOVE "VI-84 6.12.4 GR3(c)" TO ANSI-REFERENCE. NC2254.2 +144300 MOVE 1 TO REC-CT. NC2254.2 +144400 MOVE 26 TO WRK-DU-08V00. NC2254.2 +144500 GO TO EVA-TEST-GF-27-1. NC2254.2 +144600 EVA-DELETE-GF-27. NC2254.2 +144700 PERFORM DE-LETE. NC2254.2 +144800 PERFORM PRINT-DETAIL. NC2254.2 +144900 GO TO EVA-INIT-GF-28. NC2254.2 +145000 EVA-TEST-GF-27-1. NC2254.2 +145100 MOVE "EVA-TEST-GF-27-1" TO PAR-NAME. NC2254.2 +145200 EVALUATE 26 NC2254.2 +145300 WHEN NOT WRK-DU-08V00 NC2254.2 +145400 GO TO EVA-FAIL-GF-27-1 NC2254.2 +145500 END-EVALUATE. NC2254.2 +145600 PERFORM PASS. NC2254.2 +145700 GO TO EVA-WRITE-GF-27-1. NC2254.2 +145800 EVA-DELETE-GF-27-1. NC2254.2 +145900 PERFORM DE-LETE. NC2254.2 +146000 GO TO EVA-WRITE-GF-27-1. NC2254.2 +146100 EVA-FAIL-GF-27-1. NC2254.2 +146200 MOVE "IDENTIFIER AND LITERAL SHOULD BE EQUAL" NC2254.2 +146300 TO RE-MARK NC2254.2 +146400 PERFORM FAIL. NC2254.2 +146500 EVA-WRITE-GF-27-1. NC2254.2 +146600 PERFORM PRINT-DETAIL. NC2254.2 +146700* NC2254.2 +146800 EVA-INIT-GF-28. NC2254.2 +146900 MOVE "VI-84 6.12.4 GR3(c)" TO ANSI-REFERENCE. NC2254.2 +147000 MOVE 1 TO REC-CT. NC2254.2 +147100 MOVE 78 TO WRK-DU-08V00. NC2254.2 +147200 GO TO EVA-TEST-GF-28-1. NC2254.2 +147300 EVA-DELETE-GF-28. NC2254.2 +147400 PERFORM DE-LETE. NC2254.2 +147500 PERFORM PRINT-DETAIL. NC2254.2 +147600 GO TO EVA-INIT-GF-29. NC2254.2 +147700 EVA-TEST-GF-28-1. NC2254.2 +147800 MOVE "EVA-TEST-GF-28-1" TO PAR-NAME. NC2254.2 +147900 EVALUATE 1234 NC2254.2 +148000 WHEN NOT WRK-DU-08V00 NC2254.2 +148100 PERFORM PASS NC2254.2 +148200 GO TO EVA-WRITE-GF-28-1 NC2254.2 +148300 end-evaluate. NC2254.2 +148400 GO TO EVA-FAIL-GF-28-1. NC2254.2 +148500 EVA-DELETE-GF-28-1. NC2254.2 +148600 PERFORM DE-LETE. NC2254.2 +148700 GO TO EVA-WRITE-GF-28-1. NC2254.2 +148800 EVA-FAIL-GF-28-1. NC2254.2 +148900 MOVE "IDENTIFIER AND LITERAL SHOULD NOT BE EQUAL" NC2254.2 +149000 TO RE-MARK. NC2254.2 +149100 PERFORM FAIL. NC2254.2 +149200 EVA-WRITE-GF-28-1. NC2254.2 +149300 PERFORM PRINT-DETAIL. NC2254.2 +149400* NC2254.2 +149500 EVA-INIT-GF-29. NC2254.2 +149600 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +149700 MOVE 1 TO REC-CT. NC2254.2 +149800 MOVE 8 TO WRK-XN-00001-1. NC2254.2 +149900 GO TO EVA-TEST-GF-29-1. NC2254.2 +150000 EVA-DELETE-GF-29. NC2254.2 +150100 PERFORM DE-LETE. NC2254.2 +150200 PERFORM PRINT-DETAIL. NC2254.2 +150300 GO TO EVA-INIT-GF-30. NC2254.2 +150400 EVA-TEST-GF-29-1. NC2254.2 +150500 MOVE "EVA-TEST-GF-29-1" TO PAR-NAME. NC2254.2 +150600 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +150700 WHEN TRUE NC2254.2 +150800 PERFORM PASS NC2254.2 +150900 WHEN OTHER NC2254.2 +151000 GO TO EVA-FAIL-GF-29-1 NC2254.2 +151100 END-EVALUATE NC2254.2 +151200 GO TO EVA-WRITE-GF-29-1. NC2254.2 +151300 EVA-DELETE-GF-29-1. NC2254.2 +151400 PERFORM DE-LETE. NC2254.2 +151500 GO TO EVA-WRITE-GF-29-1. NC2254.2 +151600 EVA-FAIL-GF-29-1. NC2254.2 +151700 MOVE "CONDITIONAL EXPRESSION SHOULD BE TRUE" NC2254.2 +151800 TO RE-MARK NC2254.2 +151900 PERFORM FAIL. NC2254.2 +152000 EVA-WRITE-GF-29-1. NC2254.2 +152100 PERFORM PRINT-DETAIL. NC2254.2 +152200* NC2254.2 +152300 EVA-INIT-GF-30. NC2254.2 +152400 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +152500 MOVE 1 TO REC-CT. NC2254.2 +152600 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +152700 GO TO EVA-TEST-GF-30-1. NC2254.2 +152800 EVA-DELETE-GF-30. NC2254.2 +152900 PERFORM DE-LETE. NC2254.2 +153000 PERFORM PRINT-DETAIL. NC2254.2 +153100 GO TO EVA-INIT-GF-31. NC2254.2 +153200 EVA-TEST-GF-30-1. NC2254.2 +153300 MOVE "EVA-TEST-GF-30-1" TO PAR-NAME. NC2254.2 +153400 EVALUATE WRK-XN-00001-1 NUMERIC NC2254.2 +153500 WHEN TRUE NC2254.2 +153600 GO TO EVA-FAIL-GF-30-1 NC2254.2 +153700 WHEN OTHER NC2254.2 +153800 PERFORM PASS NC2254.2 +153900 END-EVALUATE NC2254.2 +154000 GO TO EVA-WRITE-GF-30-1. NC2254.2 +154100 EVA-DELETE-GF-30-1. NC2254.2 +154200 PERFORM DE-LETE. NC2254.2 +154300 GO TO EVA-WRITE-GF-30-1. NC2254.2 +154400 EVA-FAIL-GF-30-1. NC2254.2 +154500 MOVE "CONDITIONAL EXPRESSION SHOULD BE FALSE" NC2254.2 +154600 TO RE-MARK NC2254.2 +154700 PERFORM FAIL. NC2254.2 +154800 EVA-WRITE-GF-30-1. NC2254.2 +154900 PERFORM PRINT-DETAIL. NC2254.2 +155000* NC2254.2 +155100 EVA-INIT-GF-31. NC2254.2 +155200 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +155300 MOVE "EVA-TEST-GF-31-1" TO PAR-NAME. NC2254.2 +155400 MOVE 1 TO REC-CT. NC2254.2 +155500 MOVE 81 TO WRK-DU-08V00. NC2254.2 +155600 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +155700 MOVE "*" TO WRK-XN-00001-2. NC2254.2 +155800 MOVE 987 TO WRK-DU-08V00-1. NC2254.2 +155900 MOVE 81 TO WRK-DU-08V00-2. NC2254.2 +156000 MOVE 0 TO WRK-DU-08V00-3. NC2254.2 +156100 MOVE 567 TO WRK-DU-08V00-4. NC2254.2 +156200 GO TO EVA-TEST-GF-31-0. NC2254.2 +156300 EVA-DELETE-GF-31. NC2254.2 +156400 PERFORM DE-LETE. NC2254.2 +156500 PERFORM PRINT-DETAIL. NC2254.2 +156600 GO TO EVA-INIT-GF-32. NC2254.2 +156700 EVA-TEST-GF-31-0. NC2254.2 +156800 EVALUATE WRK-DU-08V00 NC2254.2 +156900 ALSO 81 NC2254.2 +157000 ALSO (WRK-DU-08V00 * 9) NC2254.2 +157100 ALSO IT-IS-81 NC2254.2 +157200 ALSO TRUE NC2254.2 +157300 ALSO FALSE NC2254.2 +157400 WHEN NOT WRK-DU-08V00-1 NC2254.2 +157500 ALSO WRK-DU-08V00-2 NC2254.2 +157600 ALSO 729 NC2254.2 +157700 ALSO TRUE NC2254.2 +157800 ALSO WRK-DU-08V00-3 = 0 NC2254.2 +157900 ALSO WRK-DU-08V00-4 < 9 NC2254.2 +158000 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +158100 MOVE "B" TO WRK-XN-00001-2 NC2254.2 +158200 WHEN 81 NC2254.2 +158300 ALSO WRK-DU-08V00 NC2254.2 +158400 ALSO (9 * 9 * 9) NC2254.2 +158500 ALSO FALSE NC2254.2 +158600 ALSO WRK-XN-00001-2 = "*" NC2254.2 +158700 ALSO WRK-DU-08V00 > 8 NC2254.2 +158800 MOVE "C" TO WRK-XN-00001-1 NC2254.2 +158900 MOVE "D" TO WRK-XN-00001-2 NC2254.2 +159000 WHEN ANY NC2254.2 +159100 ALSO ANY NC2254.2 +159200 ALSO ANY NC2254.2 +159300 ALSO ANY NC2254.2 +159400 ALSO ANY NC2254.2 +159500 ALSO WRK-DU-08V00 = 6 NC2254.2 +159600 MOVE "E" TO WRK-XN-00001-1 NC2254.2 +159700 MOVE "F" TO WRK-XN-00001-2 NC2254.2 +159800 WHEN OTHER NC2254.2 +159900 MOVE "G" TO WRK-XN-00001-1 NC2254.2 +160000 MOVE "H" TO WRK-XN-00001-2 NC2254.2 +160100 END-EVALUATE. NC2254.2 +160200 EVA-TEST-GF-31-1. NC2254.2 +160300 IF WRK-XN-00001-1 = "A" NC2254.2 +160400 PERFORM PASS NC2254.2 +160500 GO TO EVA-WRITE-GF-31-1 NC2254.2 +160600 ELSE NC2254.2 +160700 GO TO EVA-FAIL-GF-31-1. NC2254.2 +160800 EVA-DELETE-GF-31-1. NC2254.2 +160900 PERFORM DE-LETE. NC2254.2 +161000 GO TO EVA-WRITE-GF-31-1. NC2254.2 +161100 EVA-FAIL-GF-31-1. NC2254.2 +161200 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +161300 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +161400 MOVE "A" TO CORRECT-X NC2254.2 +161500 PERFORM FAIL. NC2254.2 +161600 EVA-WRITE-GF-31-1. NC2254.2 +161700 PERFORM PRINT-DETAIL. NC2254.2 +161800 EVA-TEST-GF-31-2. NC2254.2 +161900 IF WRK-XN-00001-2 = "B" NC2254.2 +162000 PERFORM PASS NC2254.2 +162100 GO TO EVA-WRITE-GF-31-2 NC2254.2 +162200 ELSE NC2254.2 +162300 GO TO EVA-FAIL-GF-31-2. NC2254.2 +162400 EVA-DELETE-GF-31-2. NC2254.2 +162500 PERFORM DE-LETE. NC2254.2 +162600 GO TO EVA-WRITE-GF-31-2. NC2254.2 +162700 EVA-FAIL-GF-31-2. NC2254.2 +162800 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +162900 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2254.2 +163000 MOVE "B" TO CORRECT-X NC2254.2 +163100 PERFORM FAIL. NC2254.2 +163200 EVA-WRITE-GF-31-2. NC2254.2 +163300 PERFORM PRINT-DETAIL. NC2254.2 +163400* NC2254.2 +163500 EVA-INIT-GF-32. NC2254.2 +163600 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +163700 MOVE "EVA-TEST-GF-32-1" TO PAR-NAME. NC2254.2 +163800 MOVE 1 TO REC-CT. NC2254.2 +163900 MOVE 81 TO WRK-DU-08V00. NC2254.2 +164000 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +164100 MOVE 987 TO WRK-DU-08V00-1. NC2254.2 +164200 MOVE 7 TO WRK-DU-08V00-2. NC2254.2 +164300 MOVE 0 TO WRK-DU-08V00-3. NC2254.2 +164400 MOVE 567 TO WRK-DU-08V00-4. NC2254.2 +164500 GO TO EVA-TEST-GF-32-0. NC2254.2 +164600 EVA-DELETE-GF-32. NC2254.2 +164700 PERFORM DE-LETE. NC2254.2 +164800 PERFORM PRINT-DETAIL. NC2254.2 +164900 GO TO EVA-INIT-GF-33. NC2254.2 +165000 EVA-TEST-GF-32-0. NC2254.2 +165100 EVALUATE WRK-DU-08V00 NC2254.2 +165200 ALSO 81 NC2254.2 +165300 ALSO (WRK-DU-08V00 * 2) NC2254.2 +165400 ALSO IT-IS-81 NC2254.2 +165500 ALSO TRUE NC2254.2 +165600 ALSO FALSE NC2254.2 +165700 WHEN NOT WRK-DU-08V00-1 NC2254.2 +165800 ALSO WRK-DU-08V00-2 NC2254.2 +165900 ALSO 81 NC2254.2 +166000 ALSO TRUE NC2254.2 +166100 ALSO WRK-DU-08V00-3 = 0 NC2254.2 +166200 ALSO WRK-DU-08V00-4 < 9 NC2254.2 +166300 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +166400 MOVE "B" TO WRK-XN-00001-2 NC2254.2 +166500 WHEN 81 NC2254.2 +166600 ALSO WRK-DU-08V00-3 THROUGH WRK-DU-08V00-4 NC2254.2 +166700 ALSO (WRK-DU-08V00-2 * 8) THRU (WRK-DU-08V00-2 * 30) NC2254.2 +166800 ALSO FALSE NC2254.2 +166900 ALSO WRK-DU-08V00-2 = 7 NC2254.2 +167000 ALSO WRK-DU-08V00 > 88 NC2254.2 +167100 MOVE "C" TO WRK-XN-00001-1 NC2254.2 +167200 MOVE "D" TO WRK-XN-00001-2 NC2254.2 +167300 WHEN ANY NC2254.2 +167400 ALSO ANY NC2254.2 +167500 ALSO ANY NC2254.2 +167600 ALSO ANY NC2254.2 +167700 ALSO ANY NC2254.2 +167800 ALSO WRK-DU-08V00 = 6 NC2254.2 +167900 MOVE "E" TO WRK-XN-00001-1 NC2254.2 +168000 MOVE "F" TO WRK-XN-00001-2 NC2254.2 +168100 WHEN OTHER NC2254.2 +168200 MOVE "G" TO WRK-XN-00001-1 NC2254.2 +168300 MOVE "H" TO WRK-XN-00001-2 NC2254.2 +168400 END-EVALUATE. NC2254.2 +168500 EVA-TEST-GF-32-1. NC2254.2 +168600 IF WRK-XN-00001-1 = "C" NC2254.2 +168700 PERFORM PASS NC2254.2 +168800 GO TO EVA-WRITE-GF-32-1 NC2254.2 +168900 ELSE NC2254.2 +169000 GO TO EVA-FAIL-GF-32-1. NC2254.2 +169100 EVA-DELETE-GF-32-1. NC2254.2 +169200 PERFORM DE-LETE. NC2254.2 +169300 GO TO EVA-WRITE-GF-32-1. NC2254.2 +169400 EVA-FAIL-GF-32-1. NC2254.2 +169500 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +169600 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +169700 MOVE "C" TO CORRECT-X NC2254.2 +169800 PERFORM FAIL. NC2254.2 +169900 EVA-WRITE-GF-32-1. NC2254.2 +170000 PERFORM PRINT-DETAIL. NC2254.2 +170100 EVA-TEST-GF-32-2. NC2254.2 +170200 ADD 1 TO REC-CT. NC2254.2 +170300 IF WRK-XN-00001-2 = "D" NC2254.2 +170400 PERFORM PASS NC2254.2 +170500 GO TO EVA-WRITE-GF-32-2 NC2254.2 +170600 ELSE NC2254.2 +170700 GO TO EVA-FAIL-GF-32-2. NC2254.2 +170800 EVA-DELETE-GF-32-2. NC2254.2 +170900 PERFORM DE-LETE. NC2254.2 +171000 GO TO EVA-WRITE-GF-32-2. NC2254.2 +171100 EVA-FAIL-GF-32-2. NC2254.2 +171200 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +171300 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2254.2 +171400 MOVE "D" TO CORRECT-X NC2254.2 +171500 PERFORM FAIL. NC2254.2 +171600 EVA-WRITE-GF-32-2. NC2254.2 +171700 PERFORM PRINT-DETAIL. NC2254.2 +171800* NC2254.2 +171900 EVA-INIT-GF-33. NC2254.2 +172000 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +172100 MOVE "EVA-TEST-GF-33-1" TO PAR-NAME. NC2254.2 +172200 MOVE 1 TO REC-CT. NC2254.2 +172300 MOVE 6 TO WRK-DU-08V00. NC2254.2 +172400 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +172500 MOVE 987 TO WRK-DU-08V00-1. NC2254.2 +172600 MOVE 7 TO WRK-DU-08V00-2. NC2254.2 +172700 MOVE 0 TO WRK-DU-08V00-3. NC2254.2 +172800 MOVE 567 TO WRK-DU-08V00-4. NC2254.2 +172900 GO TO EVA-TEST-GF-33-0. NC2254.2 +173000 EVA-DELETE-GF-33. NC2254.2 +173100 PERFORM DE-LETE. NC2254.2 +173200 PERFORM PRINT-DETAIL. NC2254.2 +173300 GO TO EVA-INIT-GF-34. NC2254.2 +173400 EVA-TEST-GF-33-0. NC2254.2 +173500 EVALUATE WRK-DU-08V00 NC2254.2 +173600 ALSO 81 NC2254.2 +173700 ALSO (WRK-DU-08V00-2 * 9) NC2254.2 +173800 ALSO IT-IS-81 NC2254.2 +173900 ALSO TRUE NC2254.2 +174000 ALSO FALSE NC2254.2 +174100 WHEN NOT WRK-DU-08V00-1 NC2254.2 +174200 ALSO WRK-DU-08V00-2 NC2254.2 +174300 ALSO 81 NC2254.2 +174400 ALSO TRUE NC2254.2 +174500 ALSO WRK-DU-08V00-3 = 0 NC2254.2 +174600 ALSO WRK-DU-08V00-4 < 9 NC2254.2 +174700 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +174800 MOVE "B" TO WRK-XN-00001-2 NC2254.2 +174900 WHEN 81 NC2254.2 +175000 ALSO WRK-DU-08V00-3 THROUGH WRK-DU-08V00-4 NC2254.2 +175100 ALSO (WRK-DU-08V00-2 * 7) THRU (WRK-DU-08V00-2 * 8) NC2254.2 +175200 ALSO FALSE NC2254.2 +175300 ALSO WRK-DU-08V00-2 = 81 NC2254.2 +175400 ALSO WRK-DU-08V00 > 8 NC2254.2 +175500 MOVE "C" TO WRK-XN-00001-1 NC2254.2 +175600 MOVE "D" TO WRK-XN-00001-2 NC2254.2 +175700 WHEN ANY NC2254.2 +175800 ALSO ANY NC2254.2 +175900 ALSO ANY NC2254.2 +176000 ALSO ANY NC2254.2 +176100 ALSO ANY NC2254.2 +176200 ALSO WRK-DU-08V00-2 = 6 NC2254.2 +176300 MOVE "E" TO WRK-XN-00001-1 NC2254.2 +176400 MOVE "F" TO WRK-XN-00001-2 NC2254.2 +176500 WHEN OTHER NC2254.2 +176600 MOVE "G" TO WRK-XN-00001-1 NC2254.2 +176700 MOVE "H" TO WRK-XN-00001-2 NC2254.2 +176800 END-EVALUATE. NC2254.2 +176900 EVA-TEST-GF-33-1. NC2254.2 +177000 IF WRK-XN-00001-1 = "E" NC2254.2 +177100 PERFORM PASS NC2254.2 +177200 GO TO EVA-WRITE-GF-33-1 NC2254.2 +177300 ELSE NC2254.2 +177400 GO TO EVA-FAIL-GF-33-1. NC2254.2 +177500 EVA-DELETE-GF-33-1. NC2254.2 +177600 PERFORM DE-LETE. NC2254.2 +177700 GO TO EVA-WRITE-GF-33-1. NC2254.2 +177800 EVA-FAIL-GF-33-1. NC2254.2 +177900 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +178000 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +178100 MOVE "E" TO CORRECT-X NC2254.2 +178200 PERFORM FAIL. NC2254.2 +178300 EVA-WRITE-GF-33-1. NC2254.2 +178400 PERFORM PRINT-DETAIL. NC2254.2 +178500 EVA-TEST-GF-33-2. NC2254.2 +178600 ADD 1 TO REC-CT. NC2254.2 +178700 IF WRK-XN-00001-2 = "F" NC2254.2 +178800 PERFORM PASS NC2254.2 +178900 GO TO EVA-WRITE-GF-33-2 NC2254.2 +179000 ELSE NC2254.2 +179100 GO TO EVA-FAIL-GF-33-2. NC2254.2 +179200 EVA-DELETE-GF-33-2. NC2254.2 +179300 PERFORM DE-LETE. NC2254.2 +179400 GO TO EVA-WRITE-GF-33-2. NC2254.2 +179500 EVA-FAIL-GF-33-2. NC2254.2 +179600 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +179700 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2254.2 +179800 MOVE "F" TO CORRECT-X NC2254.2 +179900 PERFORM FAIL. NC2254.2 +180000 EVA-WRITE-GF-33-2. NC2254.2 +180100 PERFORM PRINT-DETAIL. NC2254.2 +180200* NC2254.2 +180300 EVA-INIT-GF-34. NC2254.2 +180400 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +180500 MOVE "EVA-TEST-GF-34-1" TO PAR-NAME. NC2254.2 +180600 MOVE 1 TO REC-CT. NC2254.2 +180700 MOVE 99 TO WRK-DU-08V00. NC2254.2 +180800 MOVE "*" TO WRK-XN-00001-1. NC2254.2 +180900 MOVE 99 TO WRK-DU-08V00-1. NC2254.2 +181000 MOVE 99 TO WRK-DU-08V00-2. NC2254.2 +181100 MOVE 99 TO WRK-DU-08V00-3. NC2254.2 +181200 MOVE 99 TO WRK-DU-08V00-4. NC2254.2 +181300 GO TO EVA-TEST-GF-34-0. NC2254.2 +181400 EVA-DELETE-GF-34. NC2254.2 +181500 PERFORM DE-LETE. NC2254.2 +181600 PERFORM PRINT-DETAIL. NC2254.2 +181700 GO TO EVA-INIT-GF-35. NC2254.2 +181800 EVA-TEST-GF-34-0. NC2254.2 +181900 EVALUATE WRK-DU-08V00 NC2254.2 +182000 ALSO 81 NC2254.2 +182100 ALSO (WRK-DU-08V00-2 * 9) NC2254.2 +182200 ALSO IT-IS-81 NC2254.2 +182300 ALSO TRUE NC2254.2 +182400 ALSO FALSE NC2254.2 +182500 WHEN NOT WRK-DU-08V00-1 NC2254.2 +182600 ALSO WRK-DU-08V00-2 NC2254.2 +182700 ALSO 81 NC2254.2 +182800 ALSO TRUE NC2254.2 +182900 ALSO WRK-DU-08V00-3 = 0 NC2254.2 +183000 ALSO WRK-DU-08V00-4 < 9 NC2254.2 +183100 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +183200 MOVE "B" TO WRK-XN-00001-2 NC2254.2 +183300 WHEN 81 NC2254.2 +183400 ALSO WRK-DU-08V00-3 THROUGH WRK-DU-08V00-4 NC2254.2 +183500 ALSO (WRK-DU-08V00-2 * 7) THRU (WRK-DU-08V00-2 * 8) NC2254.2 +183600 ALSO FALSE NC2254.2 +183700 ALSO WRK-DU-08V00-2 = 81 NC2254.2 +183800 ALSO WRK-DU-08V00 > 8 NC2254.2 +183900 MOVE "C" TO WRK-XN-00001-1 NC2254.2 +184000 MOVE "D" TO WRK-XN-00001-2 NC2254.2 +184100 WHEN ANY NC2254.2 +184200 ALSO ANY NC2254.2 +184300 ALSO ANY NC2254.2 +184400 ALSO ANY NC2254.2 +184500 ALSO ANY NC2254.2 +184600 ALSO WRK-DU-08V00 = 99 NC2254.2 +184700 MOVE "E" TO WRK-XN-00001-1 NC2254.2 +184800 MOVE "F" TO WRK-XN-00001-2 NC2254.2 +184900 WHEN OTHER NC2254.2 +185000 MOVE "G" TO WRK-XN-00001-1 NC2254.2 +185100 MOVE "H" TO WRK-XN-00001-2 NC2254.2 +185200 END-EVALUATE. NC2254.2 +185300 EVA-TEST-GF-34-1. NC2254.2 +185400 IF WRK-XN-00001-1 = "G" NC2254.2 +185500 PERFORM PASS NC2254.2 +185600 GO TO EVA-WRITE-GF-34-1 NC2254.2 +185700 ELSE NC2254.2 +185800 GO TO EVA-FAIL-GF-34-1. NC2254.2 +185900 EVA-DELETE-GF-34-1. NC2254.2 +186000 PERFORM DE-LETE. NC2254.2 +186100 GO TO EVA-WRITE-GF-34-1. NC2254.2 +186200 EVA-FAIL-GF-34-1. NC2254.2 +186300 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +186400 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +186500 MOVE "G" TO CORRECT-X NC2254.2 +186600 PERFORM FAIL. NC2254.2 +186700 EVA-WRITE-GF-34-1. NC2254.2 +186800 PERFORM PRINT-DETAIL. NC2254.2 +186900 EVA-TEST-GF-34-2. NC2254.2 +187000 ADD 1 TO REC-CT. NC2254.2 +187100 IF WRK-XN-00001-2 = "H" NC2254.2 +187200 PERFORM PASS NC2254.2 +187300 GO TO EVA-WRITE-GF-34-2 NC2254.2 +187400 ELSE NC2254.2 +187500 GO TO EVA-FAIL-GF-34-2. NC2254.2 +187600 EVA-DELETE-GF-34-2. NC2254.2 +187700 PERFORM DE-LETE. NC2254.2 +187800 GO TO EVA-WRITE-GF-34-2. NC2254.2 +187900 EVA-FAIL-GF-34-2. NC2254.2 +188000 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +188100 MOVE WRK-XN-00001-2 TO COMPUTED-X NC2254.2 +188200 MOVE "H" TO CORRECT-X NC2254.2 +188300 PERFORM FAIL. NC2254.2 +188400 EVA-WRITE-GF-34-2. NC2254.2 +188500 PERFORM PRINT-DETAIL. NC2254.2 +188600* NC2254.2 +188700 EVA-INIT-GF-35. NC2254.2 +188800 MOVE "VI-84 6.12.4 GR3" TO ANSI-REFERENCE. NC2254.2 +188900 MOVE "EVA-TEST-GF-35-1" TO PAR-NAME. NC2254.2 +189000 MOVE 1 TO REC-CT. NC2254.2 +189100 MOVE 81 TO WRK-DU-08V00-1. NC2254.2 +189200 GO TO EVA-TEST-GF-35-1. NC2254.2 +189300 EVA-DELETE-GF-35. NC2254.2 +189400 PERFORM DE-LETE. NC2254.2 +189500 PERFORM PRINT-DETAIL. NC2254.2 +189600 GO TO CCVS-EXIT. NC2254.2 +189700 EVA-TEST-GF-35-1. NC2254.2 +189800 EVALUATE TRUE NC2254.2 +189900 WHEN WRK-DU-08V00 NUMERIC NC2254.2 +190000 WHEN WRK-DU-08V00 > 10 NC2254.2 +190100 WHEN WRK-DU-08V00 < 100 NC2254.2 +190200 MOVE "A" TO WRK-XN-00001-1 NC2254.2 +190300 WHEN OTHER NC2254.2 +190400 MOVE "Z" TO WRK-XN-00001-1 NC2254.2 +190500 END-EVALUATE. NC2254.2 +190600 IF WRK-XN-00001-1 = "A" NC2254.2 +190700 PERFORM PASS NC2254.2 +190800 GO TO EVA-WRITE-GF-35-1 NC2254.2 +190900 ELSE NC2254.2 +191000 GO TO EVA-FAIL-GF-35-1. NC2254.2 +191100 EVA-DELETE-GF-35-1. NC2254.2 +191200 PERFORM DE-LETE. NC2254.2 +191300 GO TO EVA-WRITE-GF-35-1. NC2254.2 +191400 EVA-FAIL-GF-35-1. NC2254.2 +191500 MOVE "EVALUATE FAILURE" TO RE-MARK NC2254.2 +191600 MOVE WRK-XN-00001-1 TO COMPUTED-X NC2254.2 +191700 MOVE "A" TO CORRECT-X NC2254.2 +191800 PERFORM FAIL. NC2254.2 +191900 EVA-WRITE-GF-35-1. NC2254.2 +192000 PERFORM PRINT-DETAIL. NC2254.2 +192100* NC2254.2 +192200 CCVS-EXIT SECTION. NC2254.2 +192300 CCVS-999999. NC2254.2 +192400 GO TO CLOSE-FILES. NC2254.2 diff --git a/tests/cobol85/NC/NC231A.CBL b/tests/cobol85/NC/NC231A.CBL new file mode 100755 index 00000000..ed3faced --- /dev/null +++ b/tests/cobol85/NC/NC231A.CBL @@ -0,0 +1,1110 @@ +000100 IDENTIFICATION DIVISION. NC2314.2 +000200 PROGRAM-ID. NC2314.2 +000300 NC231A. NC2314.2 +000400**************************************************************** NC2314.2 +000500* * NC2314.2 +000600* VALIDATION FOR:- * NC2314.2 +000700* * NC2314.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2314.2 +000900* * NC2314.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2314.2 +001100* * NC2314.2 +001200**************************************************************** NC2314.2 +001300* * NC2314.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2314.2 +001500* * NC2314.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2314.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2314.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2314.2 +001900* * NC2314.2 +002000**************************************************************** NC2314.2 +002100* * NC2314.2 +002200* PROGRAM NC231A USES FORMAT 1 OF THE "SEARCH" STATEMENT TO * NC2314.2 +002300* ACCESS THREE AND SEVEN DIMENSIONAL TABLES. * NC2314.2 +002400* THE OPTIONAL "VARYING" PHRASE IS USED WITH AN IDENTIFIER. * NC2314.2 +002500* THE SCOPE TERMINATOR "END-SEARCH" IS ALSO TESTED. * NC2314.2 +002600* * NC2314.2 +002700**************************************************************** NC2314.2 +002800 ENVIRONMENT DIVISION. NC2314.2 +002900 CONFIGURATION SECTION. NC2314.2 +003000 SOURCE-COMPUTER. NC2314.2 +003100 Linux. NC2314.2 +003200 OBJECT-COMPUTER. NC2314.2 +003300 Linux. NC2314.2 +003400 INPUT-OUTPUT SECTION. NC2314.2 +003500 FILE-CONTROL. NC2314.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2314.2 +003700 "report.log". NC2314.2 +003800 DATA DIVISION. NC2314.2 +003900 FILE SECTION. NC2314.2 +004000 FD PRINT-FILE. NC2314.2 +004100 01 PRINT-REC PICTURE X(120). NC2314.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2314.2 +004300 WORKING-STORAGE SECTION. NC2314.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2314.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2314.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2314.2 +004700 77 CON-7 PICTURE 99 VALUE 07. NC2314.2 +004800 77 CON-10 PICTURE 99 VALUE 10. NC2314.2 +004900 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2314.2 +005000 77 CON-5 PICTURE 99 VALUE 05. NC2314.2 +005100 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2314.2 +005200 77 CON-6 PICTURE 99 VALUE 06. NC2314.2 +005300 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2314.2 +005400 77 L1-HOLD PIC XX. NC2314.2 +005500 77 L2-HOLD PIC XX. NC2314.2 +005600 77 L3-HOLD PIC XX. NC2314.2 +005700 77 L4-HOLD PIC XX. NC2314.2 +005800 77 L5-HOLD PIC XX. NC2314.2 +005900 77 L6-HOLD PIC XX. NC2314.2 +006000 77 L7-HOLD PIC XX. NC2314.2 +006100 77 N1 PIC 99. NC2314.2 +006200 77 N2 PIC 99. NC2314.2 +006300 77 N3 PIC 99. NC2314.2 +006400 77 N4 PIC 99. NC2314.2 +006500 77 N5 PIC 99. NC2314.2 +006600 77 N6 PIC 99. NC2314.2 +006700 77 N7 PIC 99. NC2314.2 +006800 01 GRP-NAME. NC2314.2 +006900 02 FILLER PICTURE XXX VALUE "GRP". NC2314.2 +007000 02 ADD-GRP PICTURE 99 VALUE 01. NC2314.2 +007100 NC2314.2 +007200 01 SEC-NAME. NC2314.2 +007300 02 FILLER PICTURE X(5) VALUE "SEC (". NC2314.2 +007400 02 SEC-GRP PICTURE 99 VALUE 00. NC2314.2 +007500 02 FILLER PICTURE X VALUE ",". NC2314.2 +007600 02 ADD-SEC PICTURE 99 VALUE 01. NC2314.2 +007700 02 FILLER PICTURE X VALUE ")". NC2314.2 +007800 NC2314.2 +007900 01 ELEM-NAME. NC2314.2 +008000 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2314.2 +008100 02 ELEM-GRP PICTURE 99 VALUE 00. NC2314.2 +008200 02 FILLER PICTURE X VALUE ",". NC2314.2 +008300 02 ELEM-SEC PICTURE 99 VALUE 00. NC2314.2 +008400 02 FILLER PICTURE X VALUE ",". NC2314.2 +008500 02 ADD-ELEM PICTURE 99 VALUE 01. NC2314.2 +008600 02 FILLER PICTURE X VALUE ")". NC2314.2 +008700 NC2314.2 +008800 NC2314.2 +008900 01 3-DIMENSION-TBL. NC2314.2 +009000 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2314.2 +009100 03 ENTRY-1 PICTURE X(5). NC2314.2 +009200 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2314.2 +009300 04 ENTRY-2 PICTURE X(11). NC2314.2 +009400 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2314.2 +009500 05 ENTRY-3 PICTURE X(15). NC2314.2 +009600 NC2314.2 +009700 01 7-DIMENSION-TBL. NC2314.2 +009800 02 GRP-7-1-ENTRY OCCURS 2 INDEXED BY IX-1. NC2314.2 +009900 03 ENTRY-7-1 PIC XX. NC2314.2 +010000 03 GRP-7-2-ENTRY OCCURS 2 INDEXED BY IX-2. NC2314.2 +010100 04 ENTRY-7-2 PIC XX. NC2314.2 +010200 04 GRP-7-3-ENTRY OCCURS 2 INDEXED BY IX-3. NC2314.2 +010300 05 ENTRY-7-3 PIC XX. NC2314.2 +010400 05 GRP-7-4-ENTRY OCCURS 2 INDEXED BY IX-4. NC2314.2 +010500 06 ENTRY-7-4 PIC XX. NC2314.2 +010600 06 GRP-7-5-ENTRY OCCURS 2 INDEXED BY IX-5. NC2314.2 +010700 07 ENTRY-7-5 PIC XX. NC2314.2 +010800 07 GRP-7-6-ENTRY OCCURS 2 INDEXED BY IX-6. NC2314.2 +010900 08 ENTRY-7-6 PIC XX. NC2314.2 +011000 08 GRP-7-7-ENTRY OCCURS 2 INDEXED BY IX-7. NC2314.2 +011100 09 ENTRY-7-7 PIC XX. NC2314.2 +011200 NC2314.2 +011300 01 END-STMT. NC2314.2 +011400 02 FILLER PICTURE X(7) VALUE "AT END ". NC2314.2 +011500 02 END-IDX PICTURE X(5) VALUE SPACES. NC2314.2 +011600 02 FILLER PICTURE XXX VALUE " = ". NC2314.2 +011700 02 IDX-VALU PICTURE 99 VALUE 00. NC2314.2 +011800 02 FILLER PICTURE XXX VALUE SPACES. NC2314.2 +011900 NC2314.2 +012000 01 NOTE-1. NC2314.2 +012100 02 FILLER PICTURE X(74) VALUE NC2314.2 +012200 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2314.2 +012300- "PATH WAS TAKEN". NC2314.2 +012400 02 FILLER PICTURE X(46) VALUE SPACE. NC2314.2 +012500 NC2314.2 +012600 01 NOTE-2. NC2314.2 +012700 02 FILLER PICTURE X(112) VALUE NC2314.2 +012800 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2314.2 +012900- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2314.2 +013000 02 FILLER PICTURE X(8) VALUE SPACE. NC2314.2 +013100 NC2314.2 +013200 01 TEST-RESULTS. NC2314.2 +013300 02 FILLER PIC X VALUE SPACE. NC2314.2 +013400 02 FEATURE PIC X(20) VALUE SPACE. NC2314.2 +013500 02 FILLER PIC X VALUE SPACE. NC2314.2 +013600 02 P-OR-F PIC X(5) VALUE SPACE. NC2314.2 +013700 02 FILLER PIC X VALUE SPACE. NC2314.2 +013800 02 PAR-NAME. NC2314.2 +013900 03 FILLER PIC X(19) VALUE SPACE. NC2314.2 +014000 03 PARDOT-X PIC X VALUE SPACE. NC2314.2 +014100 03 DOTVALUE PIC 99 VALUE ZERO. NC2314.2 +014200 02 FILLER PIC X(8) VALUE SPACE. NC2314.2 +014300 02 RE-MARK PIC X(61). NC2314.2 +014400 01 TEST-COMPUTED. NC2314.2 +014500 02 FILLER PIC X(30) VALUE SPACE. NC2314.2 +014600 02 FILLER PIC X(17) VALUE NC2314.2 +014700 " COMPUTED=". NC2314.2 +014800 02 COMPUTED-X. NC2314.2 +014900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2314.2 +015000 03 COMPUTED-N REDEFINES COMPUTED-A NC2314.2 +015100 PIC -9(9).9(9). NC2314.2 +015200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2314.2 +015300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2314.2 +015400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2314.2 +015500 03 CM-18V0 REDEFINES COMPUTED-A. NC2314.2 +015600 04 COMPUTED-18V0 PIC -9(18). NC2314.2 +015700 04 FILLER PIC X. NC2314.2 +015800 03 FILLER PIC X(50) VALUE SPACE. NC2314.2 +015900 01 TEST-CORRECT. NC2314.2 +016000 02 FILLER PIC X(30) VALUE SPACE. NC2314.2 +016100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2314.2 +016200 02 CORRECT-X. NC2314.2 +016300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2314.2 +016400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2314.2 +016500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2314.2 +016600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2314.2 +016700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2314.2 +016800 03 CR-18V0 REDEFINES CORRECT-A. NC2314.2 +016900 04 CORRECT-18V0 PIC -9(18). NC2314.2 +017000 04 FILLER PIC X. NC2314.2 +017100 03 FILLER PIC X(2) VALUE SPACE. NC2314.2 +017200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2314.2 +017300 01 CCVS-C-1. NC2314.2 +017400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2314.2 +017500- "SS PARAGRAPH-NAME NC2314.2 +017600- " REMARKS". NC2314.2 +017700 02 FILLER PIC X(20) VALUE SPACE. NC2314.2 +017800 01 CCVS-C-2. NC2314.2 +017900 02 FILLER PIC X VALUE SPACE. NC2314.2 +018000 02 FILLER PIC X(6) VALUE "TESTED". NC2314.2 +018100 02 FILLER PIC X(15) VALUE SPACE. NC2314.2 +018200 02 FILLER PIC X(4) VALUE "FAIL". NC2314.2 +018300 02 FILLER PIC X(94) VALUE SPACE. NC2314.2 +018400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2314.2 +018500 01 REC-CT PIC 99 VALUE ZERO. NC2314.2 +018600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2314.2 +018700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2314.2 +018800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2314.2 +018900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2314.2 +019000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2314.2 +019100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2314.2 +019200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2314.2 +019300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2314.2 +019400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2314.2 +019500 01 CCVS-H-1. NC2314.2 +019600 02 FILLER PIC X(39) VALUE SPACES. NC2314.2 +019700 02 FILLER PIC X(42) VALUE NC2314.2 +019800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2314.2 +019900 02 FILLER PIC X(39) VALUE SPACES. NC2314.2 +020000 01 CCVS-H-2A. NC2314.2 +020100 02 FILLER PIC X(40) VALUE SPACE. NC2314.2 +020200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2314.2 +020300 02 FILLER PIC XXXX VALUE NC2314.2 +020400 "4.2 ". NC2314.2 +020500 02 FILLER PIC X(28) VALUE NC2314.2 +020600 " COPY - NOT FOR DISTRIBUTION". NC2314.2 +020700 02 FILLER PIC X(41) VALUE SPACE. NC2314.2 +020800 NC2314.2 +020900 01 CCVS-H-2B. NC2314.2 +021000 02 FILLER PIC X(15) VALUE NC2314.2 +021100 "TEST RESULT OF ". NC2314.2 +021200 02 TEST-ID PIC X(9). NC2314.2 +021300 02 FILLER PIC X(4) VALUE NC2314.2 +021400 " IN ". NC2314.2 +021500 02 FILLER PIC X(12) VALUE NC2314.2 +021600 " HIGH ". NC2314.2 +021700 02 FILLER PIC X(22) VALUE NC2314.2 +021800 " LEVEL VALIDATION FOR ". NC2314.2 +021900 02 FILLER PIC X(58) VALUE NC2314.2 +022000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2314.2 +022100 01 CCVS-H-3. NC2314.2 +022200 02 FILLER PIC X(34) VALUE NC2314.2 +022300 " FOR OFFICIAL USE ONLY ". NC2314.2 +022400 02 FILLER PIC X(58) VALUE NC2314.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2314.2 +022600 02 FILLER PIC X(28) VALUE NC2314.2 +022700 " COPYRIGHT 1985 ". NC2314.2 +022800 01 CCVS-E-1. NC2314.2 +022900 02 FILLER PIC X(52) VALUE SPACE. NC2314.2 +023000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2314.2 +023100 02 ID-AGAIN PIC X(9). NC2314.2 +023200 02 FILLER PIC X(45) VALUE SPACES. NC2314.2 +023300 01 CCVS-E-2. NC2314.2 +023400 02 FILLER PIC X(31) VALUE SPACE. NC2314.2 +023500 02 FILLER PIC X(21) VALUE SPACE. NC2314.2 +023600 02 CCVS-E-2-2. NC2314.2 +023700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2314.2 +023800 03 FILLER PIC X VALUE SPACE. NC2314.2 +023900 03 ENDER-DESC PIC X(44) VALUE NC2314.2 +024000 "ERRORS ENCOUNTERED". NC2314.2 +024100 01 CCVS-E-3. NC2314.2 +024200 02 FILLER PIC X(22) VALUE NC2314.2 +024300 " FOR OFFICIAL USE ONLY". NC2314.2 +024400 02 FILLER PIC X(12) VALUE SPACE. NC2314.2 +024500 02 FILLER PIC X(58) VALUE NC2314.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2314.2 +024700 02 FILLER PIC X(13) VALUE SPACE. NC2314.2 +024800 02 FILLER PIC X(15) VALUE NC2314.2 +024900 " COPYRIGHT 1985". NC2314.2 +025000 01 CCVS-E-4. NC2314.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2314.2 +025200 02 FILLER PIC X(4) VALUE " OF ". NC2314.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2314.2 +025400 02 FILLER PIC X(40) VALUE NC2314.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2314.2 +025600 01 XXINFO. NC2314.2 +025700 02 FILLER PIC X(19) VALUE NC2314.2 +025800 "*** INFORMATION ***". NC2314.2 +025900 02 INFO-TEXT. NC2314.2 +026000 04 FILLER PIC X(8) VALUE SPACE. NC2314.2 +026100 04 XXCOMPUTED PIC X(20). NC2314.2 +026200 04 FILLER PIC X(5) VALUE SPACE. NC2314.2 +026300 04 XXCORRECT PIC X(20). NC2314.2 +026400 02 INF-ANSI-REFERENCE PIC X(48). NC2314.2 +026500 01 HYPHEN-LINE. NC2314.2 +026600 02 FILLER PIC IS X VALUE IS SPACE. NC2314.2 +026700 02 FILLER PIC IS X(65) VALUE IS "************************NC2314.2 +026800- "*****************************************". NC2314.2 +026900 02 FILLER PIC IS X(54) VALUE IS "************************NC2314.2 +027000- "******************************". NC2314.2 +027100 01 CCVS-PGM-ID PIC X(9) VALUE NC2314.2 +027200 "NC231A". NC2314.2 +027300 PROCEDURE DIVISION. NC2314.2 +027400 CCVS1 SECTION. NC2314.2 +027500 OPEN-FILES. NC2314.2 +027600 OPEN OUTPUT PRINT-FILE. NC2314.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2314.2 +027800 MOVE SPACE TO TEST-RESULTS. NC2314.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2314.2 +028000 GO TO CCVS1-EXIT. NC2314.2 +028100 CLOSE-FILES. NC2314.2 +028200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2314.2 +028300 TERMINATE-CCVS. NC2314.2 +028400*S EXIT PROGRAM. NC2314.2 +028500*SERMINATE-CALL. NC2314.2 +028600 STOP RUN. NC2314.2 +028700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2314.2 +028800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2314.2 +028900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2314.2 +029000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2314.2 +029100 MOVE "****TEST DELETED****" TO RE-MARK. NC2314.2 +029200 PRINT-DETAIL. NC2314.2 +029300 IF REC-CT NOT EQUAL TO ZERO NC2314.2 +029400 MOVE "." TO PARDOT-X NC2314.2 +029500 MOVE REC-CT TO DOTVALUE. NC2314.2 +029600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2314.2 +029700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2314.2 +029800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2314.2 +029900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2314.2 +030000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2314.2 +030100 MOVE SPACE TO CORRECT-X. NC2314.2 +030200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2314.2 +030300 MOVE SPACE TO RE-MARK. NC2314.2 +030400 HEAD-ROUTINE. NC2314.2 +030500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +030600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +030700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2314.2 +030800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2314.2 +030900 COLUMN-NAMES-ROUTINE. NC2314.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +031300 END-ROUTINE. NC2314.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2314.2 +031500 END-RTN-EXIT. NC2314.2 +031600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +031700 END-ROUTINE-1. NC2314.2 +031800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2314.2 +031900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2314.2 +032000 ADD PASS-COUNTER TO ERROR-HOLD. NC2314.2 +032100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2314.2 +032200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2314.2 +032300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2314.2 +032400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2314.2 +032500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2314.2 +032600 END-ROUTINE-12. NC2314.2 +032700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2314.2 +032800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2314.2 +032900 MOVE "NO " TO ERROR-TOTAL NC2314.2 +033000 ELSE NC2314.2 +033100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2314.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2314.2 +033300 PERFORM WRITE-LINE. NC2314.2 +033400 END-ROUTINE-13. NC2314.2 +033500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2314.2 +033600 MOVE "NO " TO ERROR-TOTAL ELSE NC2314.2 +033700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2314.2 +033800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2314.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +034000 IF INSPECT-COUNTER EQUAL TO ZERO NC2314.2 +034100 MOVE "NO " TO ERROR-TOTAL NC2314.2 +034200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2314.2 +034300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2314.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +034500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2314.2 +034600 WRITE-LINE. NC2314.2 +034700 ADD 1 TO RECORD-COUNT. NC2314.2 +034800 IF RECORD-COUNT GREATER 50 NC2314.2 +034900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2314.2 +035000 MOVE SPACE TO DUMMY-RECORD NC2314.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2314.2 +035200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2314.2 +035300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2314.2 +035400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2314.2 +035500 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2314.2 +035600 MOVE ZERO TO RECORD-COUNT. NC2314.2 +035700 PERFORM WRT-LN. NC2314.2 +035800 WRT-LN. NC2314.2 +035900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2314.2 +036000 MOVE SPACE TO DUMMY-RECORD. NC2314.2 +036100 BLANK-LINE-PRINT. NC2314.2 +036200 PERFORM WRT-LN. NC2314.2 +036300 FAIL-ROUTINE. NC2314.2 +036400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2314.2 +036500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2314.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2314.2 +036700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2314.2 +036800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +036900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2314.2 +037000 GO TO FAIL-ROUTINE-EX. NC2314.2 +037100 FAIL-ROUTINE-WRITE. NC2314.2 +037200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2314.2 +037300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2314.2 +037400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2314.2 +037500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2314.2 +037600 FAIL-ROUTINE-EX. EXIT. NC2314.2 +037700 BAIL-OUT. NC2314.2 +037800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2314.2 +037900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2314.2 +038000 BAIL-OUT-WRITE. NC2314.2 +038100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2314.2 +038200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2314.2 +038300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2314.2 +038400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2314.2 +038500 BAIL-OUT-EX. EXIT. NC2314.2 +038600 CCVS1-EXIT. NC2314.2 +038700 EXIT. NC2314.2 +038800 SECT-NC231A-001 SECTION. NC2314.2 +038900 TH-01-001. NC2314.2 +039000 MOVE "VI-2 1.3.4" TO ANSI-REFERENCE. NC2314.2 +039100 PERFORM PARA-1 VARYING SUB-1 FROM 1 BY 1 NC2314.2 +039200 UNTIL SUB-1 EQUAL TO 11 NC2314.2 +039300 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2314.2 +039400 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11 NC2314.2 +039500 GO TO CHECK-ENTRIES. NC2314.2 +039600 NC2314.2 +039700 PARA-1. NC2314.2 +039800 SET IDX-1 TO SUB-1. NC2314.2 +039900 SET IDX-2 TO SUB-2. NC2314.2 +040000 SET IDX-3 TO SUB-3. NC2314.2 +040100 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2314.2 +040200 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2314.2 +040300 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2314.2 +040400 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2314.2 +040500 SET ADD-ELEM TO IDX-3. NC2314.2 +040600 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2314.2 +040700 NC2314.2 +040800 CHECK-ENTRIES. NC2314.2 +040900 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2314.2 +041000 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2314.2 +041100 MOVE "GRP02" TO GRP-HOLD-AREA. NC2314.2 +041200 MOVE 02 TO SUB-2. NC2314.2 +041300 MOVE 01 TO CON-5. NC2314.2 +041400 SET IDX-1 TO 01. NC2314.2 +041500 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +041600 PERFORM GRP-FAIL-PARGRAPH NC2314.2 +041700 GO TO LEVEL-1-TEST-2 NC2314.2 +041800 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2314.2 +041900 NC2314.2 +042000 PERFORM PASS-TH. NC2314.2 +042100 GO TO LEVEL-1-TEST-2. NC2314.2 +042200 NC2314.2 +042300 GRP-FAIL-PARGRAPH. NC2314.2 +042400 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2314.2 +042500 IF ENTRY-1 (SUB-2) NOT EQUAL TO GRP-HOLD-AREA NC2314.2 +042600 MOVE ENTRY-1 (SUB-2) TO COMPUTED-A NC2314.2 +042700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK ELSE NC2314.2 +042800 MOVE "IDX-1" TO END-IDX NC2314.2 +042900 SET IDX-VALU TO IDX-1 NC2314.2 +043000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +043100 MOVE END-STMT TO COMPUTED-A. NC2314.2 +043200 NC2314.2 +043300 PERFORM FAIL-TH. NC2314.2 +043400 LEVEL-1-TEST-2. NC2314.2 +043500 MOVE "LEVEL-1-TEST-2 " TO PAR-NAME. NC2314.2 +043600 MOVE "GRP01" TO GRP-HOLD-AREA. NC2314.2 +043700 MOVE 01 TO SUB-2. NC2314.2 +043800 MOVE 01 TO CON-5. NC2314.2 +043900 SET IDX-1 TO 01. NC2314.2 +044000 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +044100 PERFORM GRP-FAIL-PARGRAPH NC2314.2 +044200 GO TO LEVEL-1-TEST-3 NC2314.2 +044300 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2314.2 +044400 NC2314.2 +044500 PERFORM PASS-TH. NC2314.2 +044600 LEVEL-1-TEST-3. NC2314.2 +044700 MOVE "LEVEL-1-TEST-3 " TO PAR-NAME. NC2314.2 +044800 MOVE "GRP10" TO GRP-HOLD-AREA. NC2314.2 +044900 MOVE 10 TO SUB-2. NC2314.2 +045000 MOVE 01 TO CON-5. NC2314.2 +045100 SET IDX-1 TO 01. NC2314.2 +045200 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +045300 PERFORM GRP-FAIL-PARGRAPH NC2314.2 +045400 GO TO LEVEL-1-TEST-4 NC2314.2 +045500 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2314.2 +045600 NC2314.2 +045700 PERFORM PASS-TH. NC2314.2 +045800 LEVEL-1-TEST-4. NC2314.2 +045900 MOVE "LEVEL-1-TEST-4 " TO PAR-NAME. NC2314.2 +046000 MOVE "GRP05" TO GRP-HOLD-AREA. NC2314.2 +046100 MOVE 05 TO SUB-2. NC2314.2 +046200 MOVE 05 TO CON-5. NC2314.2 +046300 SET IDX-1 TO 05. NC2314.2 +046400 SEARCH GRP-ENTRY VARYING CON-5 WHEN ENTRY-1 (CON-5) NC2314.2 +046500 EQUAL TO GRP-HOLD-AREA GO TO PASS-TH-TEST-4. NC2314.2 +046600 PERFORM GRP-FAIL-PARGRAPH. NC2314.2 +046700 GO TO LEVEL-2-TEST-1. NC2314.2 +046800 PASS-TH-TEST-4. NC2314.2 +046900 NC2314.2 +047000 PERFORM PASS-TH. NC2314.2 +047100 NC2314.2 +047200 LEVEL-2-TEST-1. NC2314.2 +047300 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2314.2 +047400 MOVE "LEVEL-2-TEST-1 " TO PAR-NAME. NC2314.2 +047500 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2314.2 +047600 MOVE 1 TO SUB-1 SUB-2. NC2314.2 +047700 SET IDX-1 IDX-2 TO 01. NC2314.2 +047800 MOVE 01 TO CON-6. NC2314.2 +047900 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +048000 PERFORM SEC-FAIL-PARGRAF NC2314.2 +048100 GO TO LEVEL-2-TEST-2 NC2314.2 +048200 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2314.2 +048300 NEXT SENTENCE. NC2314.2 +048400 NC2314.2 +048500 PERFORM PASS-TH. NC2314.2 +048600 NC2314.2 +048700 LEVEL-2-TEST-2. NC2314.2 +048800 MOVE "LEVEL-2-TEST-2 " TO PAR-NAME. NC2314.2 +048900 MOVE "SEC (05,10)" TO SEC-HOLD-AREA. NC2314.2 +049000 MOVE 05 TO SUB-1. NC2314.2 +049100 MOVE 10 TO SUB-2. NC2314.2 +049200 SET IDX-1 TO 5. NC2314.2 +049300 MOVE 01 TO CON-6. NC2314.2 +049400 SET IDX-2 TO 01. NC2314.2 +049500 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +049600 PERFORM SEC-FAIL-PARGRAF NC2314.2 +049700 GO TO LEVEL-2-TEST-3 NC2314.2 +049800 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2314.2 +049900 NEXT SENTENCE. NC2314.2 +050000 NC2314.2 +050100 PERFORM PASS-TH. NC2314.2 +050200 NC2314.2 +050300 LEVEL-2-TEST-3. NC2314.2 +050400 MOVE "LEVEL-2-TEST-3 " TO PAR-NAME. NC2314.2 +050500 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2314.2 +050600 SET IDX-1 TO 10. NC2314.2 +050700 MOVE 01 TO CON-6. NC2314.2 +050800 SET IDX-2 TO 01. NC2314.2 +050900 MOVE 10 TO SUB-1 SUB-2. NC2314.2 +051000 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +051100 PERFORM SEC-FAIL-PARGRAF NC2314.2 +051200 GO TO LEVEL-2-TEST-4 NC2314.2 +051300 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2314.2 +051400 NEXT SENTENCE. NC2314.2 +051500 NC2314.2 +051600 PERFORM PASS-TH. NC2314.2 +051700 LEVEL-2-TEST-4. NC2314.2 +051800 MOVE "LEVEL-2-TEST-4 " TO PAR-NAME. NC2314.2 +051900 MOVE "SEC (08,02)" TO SEC-HOLD-AREA. NC2314.2 +052000 MOVE 08 TO SUB-1. NC2314.2 +052100 MOVE 02 TO SUB-2. NC2314.2 +052200 SET IDX-1 TO 08. NC2314.2 +052300 MOVE 01 TO CON-6. NC2314.2 +052400 SET IDX-2 TO 01. NC2314.2 +052500 SEARCH GRP2-ENTRY VARYING CON-6 NC2314.2 +052600 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2314.2 +052700 GO TO PASS-TH-2-4. NC2314.2 +052800 PERFORM SEC-FAIL-PARGRAF. NC2314.2 +052900 GO TO LEVEL-3-TEST-1. NC2314.2 +053000 PASS-TH-2-4. NC2314.2 +053100 NC2314.2 +053200 PERFORM PASS-TH. NC2314.2 +053300 GO TO LEVEL-3-TEST-1. NC2314.2 +053400 NC2314.2 +053500 SEC-FAIL-PARGRAF. NC2314.2 +053600 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2314.2 +053700 IF ENTRY-2 (SUB-1, SUB-2) = SEC-HOLD-AREA NC2314.2 +053800 MOVE "IDX-2" TO END-IDX NC2314.2 +053900 SET IDX-VALU TO IDX-2 NC2314.2 +054000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +054100 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +054200 MOVE ENTRY-2 (SUB-1, SUB-2) TO COMPUTED-A NC2314.2 +054300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +054400 NC2314.2 +054500 PERFORM FAIL-TH. NC2314.2 +054600 NC2314.2 +054700 LEVEL-3-TEST-1. NC2314.2 +054800 MOVE "LEVEL-3-TEST-1 " TO PAR-NAME. NC2314.2 +054900 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2314.2 +055000 MOVE 1 TO SUB-1 SUB-2 SUB-3. NC2314.2 +055100 MOVE "ELEM (01,01,01)" TO ELEM-HOLD-AREA. NC2314.2 +055200 SET IDX-1 IDX-2 IDX-3 TO 01. NC2314.2 +055300 MOVE 01 TO CON-7. NC2314.2 +055400 SEARCH GRP3-ENTRY VARYING CON-7 NC2314.2 +055500 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2314.2 +055600 GO TO PASS-TH-3-1. NC2314.2 +055700 PERFORM ELEM-FAIL-PARA. NC2314.2 +055800 GO TO LEVEL-3-TEST-2. NC2314.2 +055900 PASS-TH-3-1. NC2314.2 +056000 NC2314.2 +056100 PERFORM PASS-TH. NC2314.2 +056200 NC2314.2 +056300 LEVEL-3-TEST-2. NC2314.2 +056400 MOVE "LEVEL-3-TEST-2 " TO PAR-NAME. NC2314.2 +056500 MOVE 05 TO SUB-1. NC2314.2 +056600 MOVE 06 TO SUB-2. NC2314.2 +056700 MOVE 07 TO SUB-3. NC2314.2 +056800 SET IDX-1 TO 05. NC2314.2 +056900 SET IDX-2 TO 06. NC2314.2 +057000 MOVE 01 TO CON-7. NC2314.2 +057100 SET IDX-3 TO 01. NC2314.2 +057200 MOVE "ELEM (05,06,07)" TO ELEM-HOLD-AREA. NC2314.2 +057300 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +057400 PERFORM ELEM-FAIL-PARA NC2314.2 +057500 GO TO LEVEL-3-TEST-3 NC2314.2 +057600 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2314.2 +057700 NEXT SENTENCE. NC2314.2 +057800 NC2314.2 +057900 PERFORM PASS-TH. NC2314.2 +058000 NC2314.2 +058100 LEVEL-3-TEST-3. NC2314.2 +058200 MOVE "LEVEL-3-TEST-3 " TO PAR-NAME. NC2314.2 +058300 MOVE 10 TO SUB-1 SUB-2 SUB-3. NC2314.2 +058400 SET IDX-1 IDX-2 TO 10. NC2314.2 +058500 SET IDX-3 TO 01. NC2314.2 +058600 MOVE 01 TO CON-7. NC2314.2 +058700 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2314.2 +058800 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +058900 PERFORM ELEM-FAIL-PARA NC2314.2 +059000 GO TO LEVEL-3-TEST-4 NC2314.2 +059100 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2314.2 +059200 NEXT SENTENCE. NC2314.2 +059300 NC2314.2 +059400 PERFORM PASS-TH. NC2314.2 +059500 LEVEL-3-TEST-4. NC2314.2 +059600 MOVE "LEVEL-3-TEST-4 " TO PAR-NAME. NC2314.2 +059700 MOVE "ELEM (07,06,05)" TO ELEM-HOLD-AREA. NC2314.2 +059800 MOVE 07 TO SUB-1. NC2314.2 +059900 MOVE 06 TO SUB-2. NC2314.2 +060000 MOVE 05 TO SUB-3. NC2314.2 +060100 SET IDX-1 TO 07. NC2314.2 +060200 SET IDX-2 TO 06. NC2314.2 +060300 SET IDX-3 TO 03. NC2314.2 +060400 MOVE 03 TO CON-7. NC2314.2 +060500 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +060600 PERFORM ELEM-FAIL-PARA NC2314.2 +060700 GO TO MULT-SEARCH-TEST-1 NC2314.2 +060800 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2314.2 +060900 NEXT SENTENCE. NC2314.2 +061000 NC2314.2 +061100 PERFORM PASS-TH. NC2314.2 +061200 GO TO MULT-SEARCH-TEST-1. NC2314.2 +061300 ELEM-FAIL-PARA. NC2314.2 +061400 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2314.2 +061500 IF ENTRY-3 (SUB-1, SUB-2, SUB-3) = ELEM-HOLD-AREA NC2314.2 +061600 MOVE "IDX-3" TO END-IDX NC2314.2 +061700 SET IDX-VALU TO IDX-3 NC2314.2 +061800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +061900 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +062000 MOVE ENTRY-3 (SUB-1, SUB-2, SUB-3) TO COMPUTED-A NC2314.2 +062100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +062200 NC2314.2 +062300 PERFORM FAIL-TH. NC2314.2 +062400 NC2314.2 +062500 MULT-SEARCH-TEST-1. NC2314.2 +062600 MOVE "MULT-SEARCH-TEST-1 " TO PAR-NAME. NC2314.2 +062700 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2314.2 +062800 MOVE "GRP08" TO GRP-HOLD-AREA. NC2314.2 +062900 MOVE "SEC (08,07)" TO SEC-HOLD-AREA. NC2314.2 +063000 MOVE 01 TO CON-5 CON-6. NC2314.2 +063100 SET IDX-1 IDX-2 TO 01. NC2314.2 +063200 SEARCH GRP-ENTRY VARYING CON-5 AT END GO TO MULT-SEARCH-FAIL1NC2314.2 +063300 WHEN ENTRY-1 (CON-5) = "GRP08" NEXT SENTENCE. NC2314.2 +063400 SEARCH GRP2-ENTRY VARYING CON-6 AT END GO TO MULT-SEARCH-FAILNC2314.2 +063500 WHEN ENTRY-2 (CON-5, CON-6) = SEC-HOLD-AREA NC2314.2 +063600 NEXT SENTENCE. NC2314.2 +063700 NC2314.2 +063800 PERFORM PASS-TH. NC2314.2 +063900 GO TO MULT-SEARCH-TEST-2. NC2314.2 +064000 MULT-SEARCH-FAIL1. NC2314.2 +064100 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2314.2 +064200 IF ENTRY-1 (08) = GRP-HOLD-AREA NC2314.2 +064300 MOVE "IDX-1" TO END-IDX NC2314.2 +064400 SET IDX-VALU TO IDX-1 NC2314.2 +064500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +064600 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +064700 MOVE ENTRY-1 (08) TO COMPUTED-A NC2314.2 +064800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +064900 NC2314.2 +065000 PERFORM FAIL-TH. NC2314.2 +065100 GO TO MULT-SEARCH-TEST-2. NC2314.2 +065200 MULT-SEARCH-FAIL. NC2314.2 +065300 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2314.2 +065400 IF ENTRY-2 (08, 07) = SEC-HOLD-AREA NC2314.2 +065500 MOVE "IDX-2" TO END-IDX NC2314.2 +065600 SET IDX-VALU TO IDX-2 NC2314.2 +065700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +065800 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +065900 MOVE ENTRY-2 (08, 07) TO COMPUTED-A NC2314.2 +066000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +066100 NC2314.2 +066200 PERFORM FAIL-TH. NC2314.2 +066300 NC2314.2 +066400 MULT-SEARCH-TEST-2. NC2314.2 +066500 MOVE "MULT-SEARCH-TEST-2 " TO PAR-NAME. NC2314.2 +066600 MOVE "GRP04" TO GRP-HOLD-AREA. NC2314.2 +066700 MOVE "SEC (04,04)" TO SEC-HOLD-AREA. NC2314.2 +066800 MOVE "ELEM (04,04,04)" TO ELEM-HOLD-AREA. NC2314.2 +066900 MOVE 01 TO CON-5 CON-6 CON-7. NC2314.2 +067000 SET IDX-1 IDX-2 IDX-3 TO 01. NC2314.2 +067100 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +067200 GO TO MULT-SEARCH-2-FAIL WHEN ENTRY-1 (CON-5) = NC2314.2 +067300 GRP-HOLD-AREA NEXT SENTENCE. NC2314.2 +067400 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +067500 GO TO MULT-SEARCH-3-FAIL WHEN ENTRY-2 (CON-5, CON-6) = NC2314.2 +067600 SEC-HOLD-AREA NEXT SENTENCE. NC2314.2 +067700 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +067800 GO TO MULT-SEARCH-4-FAIL WHEN ENTRY-3 NC2314.2 +067900 (CON-5, CON-6, CON-7) = ELEM-HOLD-AREA NEXT SENTENCE.NC2314.2 +068000 NC2314.2 +068100 PERFORM PASS-TH. NC2314.2 +068200 GO TO MULT-SEARCH-7-INIT-3. NC2314.2 +068300 NC2314.2 +068400 MULT-SEARCH-2-FAIL. NC2314.2 +068500 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2314.2 +068600 IF ENTRY-1 (04) = GRP-HOLD-AREA NC2314.2 +068700 MOVE "IDX-1" TO END-IDX NC2314.2 +068800 SET IDX-VALU TO IDX-1 NC2314.2 +068900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +069000 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +069100 MOVE ENTRY-1 (04) TO COMPUTED-A NC2314.2 +069200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +069300 NC2314.2 +069400 PERFORM FAIL-TH. NC2314.2 +069500 GO TO MULT-SEARCH-7-INIT-3. NC2314.2 +069600 NC2314.2 +069700 MULT-SEARCH-3-FAIL. NC2314.2 +069800 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2314.2 +069900 IF ENTRY-2 (04, 04) = SEC-HOLD-AREA NC2314.2 +070000 MOVE "IDX-2" TO END-IDX NC2314.2 +070100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +070200 SET IDX-VALU TO IDX-2 NC2314.2 +070300 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +070400 MOVE ENTRY-2 (04, 04) TO COMPUTED-A NC2314.2 +070500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +070600 NC2314.2 +070700 PERFORM FAIL-TH. NC2314.2 +070800 GO TO MULT-SEARCH-7-INIT-3. NC2314.2 +070900 NC2314.2 +071000 MULT-SEARCH-4-FAIL. NC2314.2 +071100 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2314.2 +071200 IF ENTRY-3 (04, 04, 04) = ELEM-HOLD-AREA NC2314.2 +071300 MOVE "IDX-3" TO END-IDX NC2314.2 +071400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +071500 SET IDX-VALU TO IDX-3 NC2314.2 +071600 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +071700 MOVE ENTRY-3 (04, 04, 04) TO COMPUTED-A NC2314.2 +071800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +071900 NC2314.2 +072000 PERFORM FAIL-TH. NC2314.2 +072100 NC2314.2 +072200 MULT-SEARCH-7-INIT-3. NC2314.2 +072300 MOVE "MULT-SEARCH-7-TEST-3" TO PAR-NAME. NC2314.2 +072400 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2314.2 +072500 MOVE ALL "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO 7-DIMENSION-TBL. NC2314.2 +072600 MOVE "UV" TO L1-HOLD. NC2314.2 +072700 MOVE "WX" TO L2-HOLD. NC2314.2 +072800 MOVE "IJ" TO L3-HOLD. NC2314.2 +072900 MOVE "KL" TO L4-HOLD. NC2314.2 +073000 MOVE "AB" TO L5-HOLD. NC2314.2 +073100 MOVE "CD" TO L6-HOLD. NC2314.2 +073200 MOVE "GH" TO L7-HOLD. NC2314.2 +073300 SET IX-1 IX-2 IX-3 IX-4 IX-5 IX-6 IX-7 TO 1. NC2314.2 +073400 MOVE 1 TO N1 N2 N3 N4 N5 N6 N7. NC2314.2 +073500 GO TO MULT-SEARCH-7-TEST-3. NC2314.2 +073600 MULT-SEARCH-7-DELETE-3. NC2314.2 +073700 PERFORM DE-LETE. NC2314.2 +073800 PERFORM PRINT-DETAIL. NC2314.2 +073900 GO TO SPECIAL-TEST-1. NC2314.2 +074000 MULT-SEARCH-7-TEST-3. NC2314.2 +074100 SEARCH GRP-7-1-ENTRY VARYING N1 NC2314.2 +074200 AT END GO TO MULT-SEARCH-7-FAIL-1 NC2314.2 +074300 WHEN ENTRY-7-1 (N1) = L1-HOLD NC2314.2 +074400 NEXT SENTENCE. NC2314.2 +074500 SEARCH GRP-7-2-ENTRY VARYING N2 NC2314.2 +074600 AT END GO TO MULT-SEARCH-7-FAIL-2 NC2314.2 +074700 WHEN ENTRY-7-2 (N1 N2) = L2-HOLD NC2314.2 +074800 NEXT SENTENCE. NC2314.2 +074900 SEARCH GRP-7-3-ENTRY VARYING N3 NC2314.2 +075000 AT END GO TO MULT-SEARCH-7-FAIL-3 NC2314.2 +075100 WHEN ENTRY-7-3 (N1 N2 N3) = L3-HOLD NC2314.2 +075200 NEXT SENTENCE. NC2314.2 +075300 SEARCH GRP-7-4-ENTRY VARYING N4 NC2314.2 +075400 AT END GO TO MULT-SEARCH-7-FAIL-4 NC2314.2 +075500 WHEN ENTRY-7-4 (N1 N2 N3 N4) = L4-HOLD NC2314.2 +075600 NEXT SENTENCE. NC2314.2 +075700 SEARCH GRP-7-5-ENTRY VARYING N5 NC2314.2 +075800 AT END GO TO MULT-SEARCH-7-FAIL-5 NC2314.2 +075900 WHEN ENTRY-7-5 (N1 N2 N3 N4 N5) = L5-HOLD NC2314.2 +076000 NEXT SENTENCE. NC2314.2 +076100 SEARCH GRP-7-6-ENTRY VARYING N6 NC2314.2 +076200 AT END GO TO MULT-SEARCH-7-FAIL-6 NC2314.2 +076300 WHEN ENTRY-7-6 (N1 N2 N3 N4 N5 N6) = L6-HOLD NC2314.2 +076400 NEXT SENTENCE. NC2314.2 +076500 SEARCH GRP-7-7-ENTRY VARYING N7 NC2314.2 +076600 AT END GO TO MULT-SEARCH-7-FAIL-7 NC2314.2 +076700 WHEN ENTRY-7-7 (N1 N2 N3 N4 N5 N6 N7) = L7-HOLD NC2314.2 +076800 NEXT SENTENCE. NC2314.2 +076900 NC2314.2 +077000 PERFORM PASS-TH. NC2314.2 +077100 GO TO SPECIAL-TEST-1. NC2314.2 +077200 NC2314.2 +077300 MULT-SEARCH-7-FAIL-1. NC2314.2 +077400 MOVE L1-HOLD TO CORRECT-A. NC2314.2 +077500 IF ENTRY-7-1 (2) = L1-HOLD NC2314.2 +077600 MOVE "IX-1" TO END-IDX NC2314.2 +077700 SET IDX-VALU TO IX-1 NC2314.2 +077800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +077900 MOVE END-STMT TO COMPUTED-A NC2314.2 +078000 ELSE NC2314.2 +078100 MOVE ENTRY-7-1 (2) TO COMPUTED-A NC2314.2 +078200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +078300 NC2314.2 +078400 PERFORM FAIL-TH. NC2314.2 +078500 GO TO SPECIAL-TEST-1. NC2314.2 +078600 NC2314.2 +078700 MULT-SEARCH-7-FAIL-2. NC2314.2 +078800 MOVE L2-HOLD TO CORRECT-A. NC2314.2 +078900 IF ENTRY-7-2 (2 1) = L1-HOLD NC2314.2 +079000 MOVE "IX-2" TO END-IDX NC2314.2 +079100 SET IDX-VALU TO IX-2 NC2314.2 +079200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +079300 MOVE END-STMT TO COMPUTED-A NC2314.2 +079400 ELSE NC2314.2 +079500 MOVE ENTRY-7-2 (2 1) TO COMPUTED-A NC2314.2 +079600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +079700 NC2314.2 +079800 PERFORM FAIL-TH. NC2314.2 +079900 GO TO SPECIAL-TEST-1. NC2314.2 +080000 NC2314.2 +080100 MULT-SEARCH-7-FAIL-3. NC2314.2 +080200 MOVE L3-HOLD TO CORRECT-A. NC2314.2 +080300 IF ENTRY-7-3 (2 1 2) = L3-HOLD NC2314.2 +080400 MOVE "IX-3" TO END-IDX NC2314.2 +080500 SET IDX-VALU TO IX-3 NC2314.2 +080600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +080700 MOVE END-STMT TO COMPUTED-A NC2314.2 +080800 ELSE NC2314.2 +080900 MOVE ENTRY-7-3 (2 1 2) TO COMPUTED-A NC2314.2 +081000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +081100 NC2314.2 +081200 PERFORM FAIL-TH. NC2314.2 +081300 GO TO SPECIAL-TEST-1. NC2314.2 +081400 NC2314.2 +081500 MULT-SEARCH-7-FAIL-4. NC2314.2 +081600 MOVE L4-HOLD TO CORRECT-A. NC2314.2 +081700 IF ENTRY-7-4 (2 1 2 1) = L4-HOLD NC2314.2 +081800 MOVE "IX-4" TO END-IDX NC2314.2 +081900 SET IDX-VALU TO IX-4 NC2314.2 +082000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +082100 MOVE END-STMT TO COMPUTED-A NC2314.2 +082200 ELSE NC2314.2 +082300 MOVE ENTRY-7-4 (2 1 2 1) TO COMPUTED-A NC2314.2 +082400 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +082500 NC2314.2 +082600 PERFORM FAIL-TH. NC2314.2 +082700 GO TO SPECIAL-TEST-1. NC2314.2 +082800 NC2314.2 +082900 MULT-SEARCH-7-FAIL-5. NC2314.2 +083000 MOVE L5-HOLD TO CORRECT-A. NC2314.2 +083100 IF ENTRY-7-5 (2 1 2 1 2) = L5-HOLD NC2314.2 +083200 MOVE "IX-5" TO END-IDX NC2314.2 +083300 SET IDX-VALU TO IX-5 NC2314.2 +083400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +083500 MOVE END-STMT TO COMPUTED-A NC2314.2 +083600 ELSE NC2314.2 +083700 MOVE ENTRY-7-5 (2 1 2 1 2) TO COMPUTED-A NC2314.2 +083800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +083900 NC2314.2 +084000 PERFORM FAIL-TH. NC2314.2 +084100 GO TO SPECIAL-TEST-1. NC2314.2 +084200 NC2314.2 +084300 MULT-SEARCH-7-FAIL-6. NC2314.2 +084400 MOVE L6-HOLD TO CORRECT-A. NC2314.2 +084500 IF ENTRY-7-6 (2 1 2 1 2 1) = L6-HOLD NC2314.2 +084600 MOVE "IX-6" TO END-IDX NC2314.2 +084700 SET IDX-VALU TO IX-6 NC2314.2 +084800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +084900 MOVE END-STMT TO COMPUTED-A NC2314.2 +085000 ELSE NC2314.2 +085100 MOVE ENTRY-7-6 (2 1 2 1 2 1) TO COMPUTED-A NC2314.2 +085200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +085300 NC2314.2 +085400 PERFORM FAIL-TH. NC2314.2 +085500 GO TO SPECIAL-TEST-1. NC2314.2 +085600 NC2314.2 +085700 MULT-SEARCH-7-FAIL-7. NC2314.2 +085800 MOVE L7-HOLD TO CORRECT-A. NC2314.2 +085900 IF ENTRY-7-7 (2 1 2 1 2 1 2) = L7-HOLD NC2314.2 +086000 MOVE "IX-7" TO END-IDX NC2314.2 +086100 SET IDX-VALU TO IX-7 NC2314.2 +086200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +086300 MOVE END-STMT TO COMPUTED-A NC2314.2 +086400 ELSE NC2314.2 +086500 MOVE ENTRY-7-7 (2 1 2 1 2 1 2) TO COMPUTED-A NC2314.2 +086600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +086700 NC2314.2 +086800 PERFORM FAIL-TH. NC2314.2 +086900 NC2314.2 +087000 SPECIAL-TEST-1. NC2314.2 +087100 MOVE "SPECIAL-TEST-1 " TO PAR-NAME. NC2314.2 +087200 MOVE "IDX SET HI TO ENTRY " TO FEATURE. NC2314.2 +087300 MOVE 04 TO CON-5. NC2314.2 +087400 SET IDX-1 TO 04. NC2314.2 +087500 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +087600 GO TO SPEC-PASS-PARAGRAPH-1 WHEN ENTRY-1 (CON-5) = "GRP03" NC2314.2 +087700 GO TO SPEC-FAIL-PARAGRAPH-1. NC2314.2 +087800 SPECIAL-2-LEVEL-SEARCH. NC2314.2 +087900 MOVE "SPECIAL-2-LEVEL-SEAR" TO PAR-NAME. NC2314.2 +088000 MOVE 04 TO CON-5. NC2314.2 +088100 MOVE 05 TO CON-6. NC2314.2 +088200 SET IDX-1 TO 04. NC2314.2 +088300 SET IDX-2 TO 05. NC2314.2 +088400 SEARCH GRP-ENTRY VARYING IDX-1 AT END NC2314.2 +088500 GO TO SPEC-FAIL-PARAGRAPH-2 NC2314.2 +088600 WHEN ENTRY-1 (CON-5) = "GRP04" NEXT SENTENCE. NC2314.2 +088700 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +088800 GO TO SPEC-PASS-PARAGRAPH-2 NC2314.2 +088900 WHEN ENTRY-2 (CON-5, CON-6) = "SEC (04,04)" NC2314.2 +089000 GO TO SPEC-FAIL-PARAGRAPH-3. NC2314.2 +089100 SPEC-PASS-PARAGRAPH-1. NC2314.2 +089200 NC2314.2 +089300 PERFORM PASS-TH. NC2314.2 +089400 GO TO SPECIAL-2-LEVEL-SEARCH. NC2314.2 +089500 NC2314.2 +089600 SPEC-FAIL-PARAGRAPH-1. NC2314.2 +089700 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK. NC2314.2 +089800 MOVE "GRP03" TO COMPUTED-A. NC2314.2 +089900 NC2314.2 +090000 MOVE SPACES TO CORRECT-A. NC2314.2 +090100 PERFORM FAIL-TH. NC2314.2 +090200 GO TO SPECIAL-2-LEVEL-SEARCH. NC2314.2 +090300 NC2314.2 +090400 SPEC-FAIL-PARAGRAPH-2. NC2314.2 +090500 MOVE "GRP04" TO CORRECT-A. NC2314.2 +090600 MOVE ENTRY-1 (04) TO COMPUTED-A. NC2314.2 +090700 NC2314.2 +090800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +090900 PERFORM FAIL-TH. NC2314.2 +091000 GO TO SPECIAL-3-LEVEL-SEARCH. NC2314.2 +091100 NC2314.2 +091200 SPEC-FAIL-PARAGRAPH-3. NC2314.2 +091300 MOVE ENTRY-2 (04, 04) TO COMPUTED-A. NC2314.2 +091400 MOVE SPACE TO CORRECT-A. NC2314.2 +091500 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK. NC2314.2 +091600 NC2314.2 +091700 PERFORM FAIL-TH. NC2314.2 +091800 GO TO SPECIAL-3-LEVEL-SEARCH. NC2314.2 +091900 NC2314.2 +092000 SPEC-PASS-PARAGRAPH-2. NC2314.2 +092100 NC2314.2 +092200 PERFORM PASS-TH. NC2314.2 +092300 GO TO SPECIAL-3-LEVEL-SEARCH. NC2314.2 +092400 NC2314.2 +092500 SPECIAL-3-LEVEL-SEARCH. NC2314.2 +092600 MOVE "SPECIAL-3-LEVEL-SEAR" TO PAR-NAME. NC2314.2 +092700 SET IDX-1 TO 02. NC2314.2 +092800 MOVE 02 TO CON-5. NC2314.2 +092900 SEARCH GRP-ENTRY VARYING CON-5 AT END NC2314.2 +093000 GO TO SPEC-FAIL-PARAGRAPH-4 WHEN ENTRY-1 (CON-5) NC2314.2 +093100 EQUAL TO "GRP02" NEXT SENTENCE. NC2314.2 +093200 MOVE 01 TO CON-6. NC2314.2 +093300 SET IDX-2 TO 01. NC2314.2 +093400 SEARCH GRP2-ENTRY VARYING CON-6 AT END NC2314.2 +093500 GO TO SPEC-FAIL-PARAGRAPH-5 NC2314.2 +093600 WHEN ENTRY-2 (CON-5, CON-6) = "SEC (02,03)" NEXT SENTENCE. NC2314.2 +093700 MOVE 05 TO CON-7. NC2314.2 +093800 SET IDX-3 TO 05. NC2314.2 +093900 SEARCH GRP3-ENTRY VARYING CON-7 AT END NC2314.2 +094000 GO TO SPEC-PASS-PARAGRAPH-3 NC2314.2 +094100 WHEN ENTRY-3 (CON-5, CON-6, CON-7) = "ELEM (02,03,04)" NC2314.2 +094200 NC2314.2 +094300 MOVE "INDEX SET HIGHER THAN ENTRY" TO RE-MARK NC2314.2 +094400 MOVE SPACES TO CORRECT-A NC2314.2 +094500 MOVE "ELEM (02,03,04)" TO COMPUTED-A NC2314.2 +094600 PERFORM FAIL-TH NC2314.2 +094700 GO TO SEARCH-INIT-1. NC2314.2 +094800 SPEC-PASS-PARAGRAPH-3. NC2314.2 +094900 NC2314.2 +095000 PERFORM PASS-TH. NC2314.2 +095100 GO TO SEARCH-INIT-1. NC2314.2 +095200 NC2314.2 +095300 SPEC-FAIL-PARAGRAPH-4. NC2314.2 +095400 IF ENTRY-1 (02) = "GRP02" NC2314.2 +095500 MOVE "IDX-1" TO END-IDX NC2314.2 +095600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +095700 SET IDX-VALU TO IDX-1 NC2314.2 +095800 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +095900 MOVE ENTRY-1 (02) TO COMPUTED-A NC2314.2 +096000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +096100 NC2314.2 +096200 MOVE "GRP02" TO CORRECT-A. NC2314.2 +096300 PERFORM FAIL-TH. NC2314.2 +096400 GO TO SEARCH-INIT-1. NC2314.2 +096500 SPEC-FAIL-PARAGRAPH-5. NC2314.2 +096600 IF ENTRY-2 (02, 03) = "SEC (02,03)" NC2314.2 +096700 MOVE "IDX-2" TO END-IDX NC2314.2 +096800 SET IDX-VALU TO IDX-2 NC2314.2 +096900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2314.2 +097000 MOVE END-STMT TO COMPUTED-A ELSE NC2314.2 +097100 MOVE ENTRY-2 (02, 03) TO COMPUTED-A NC2314.2 +097200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2314.2 +097300 NC2314.2 +097400 MOVE "SEC (02, 03)" TO CORRECT-A. NC2314.2 +097500 PERFORM FAIL-TH. NC2314.2 +097600 NC2314.2 +097700 NC2314.2 +097800 SEARCH-INIT-1. NC2314.2 +097900 MOVE "SEARCH-TEST-1" TO PAR-NAME. NC2314.2 +098000 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC2314.2 +098100 MOVE "EXP.SCOPE TERMINATOR" TO FEATURE. NC2314.2 +098200 MOVE "CD" TO L1-HOLD. NC2314.2 +098300 MOVE "CD" TO ENTRY-7-1 (2). NC2314.2 +098400 MOVE SPACE TO L2-HOLD. NC2314.2 +098500 MOVE SPACE TO L3-HOLD. NC2314.2 +098600 MOVE SPACE TO L4-HOLD. NC2314.2 +098700 MOVE 1 TO REC-CT. NC2314.2 +098800 MOVE 1 TO N1. NC2314.2 +098900 SET IX-1 IX-2 IX-3 IX-4 IX-5 IX-6 IX-7 TO 1. NC2314.2 +099000 GO TO SEARCH-TEST-1-0. NC2314.2 +099100 SEARCH-DELETE-1. NC2314.2 +099200 PERFORM DE-LETE. NC2314.2 +099300 PERFORM PRINT-DETAIL. NC2314.2 +099400 GO TO SEARCH-INIT-2. NC2314.2 +099500 SEARCH-TEST-1-0. NC2314.2 +099600 SEARCH GRP-7-1-ENTRY VARYING N1 NC2314.2 +099700 WHEN ENTRY-7-1 (N1) = L1-HOLD NC2314.2 +099800 MOVE "AA" TO L2-HOLD NC2314.2 +099900 MOVE "BB" TO L3-HOLD NC2314.2 +100000 END-SEARCH NC2314.2 +100100 MOVE "CC" TO L4-HOLD. NC2314.2 +100200 SEARCH-TEST-1-1. NC2314.2 +100300 MOVE "SEARCH-TEST-1-1" TO PAR-NAME. NC2314.2 +100400 IF L2-HOLD = "AA" NC2314.2 +100500 PERFORM PASS NC2314.2 +100600 PERFORM PRINT-DETAIL NC2314.2 +100700 ELSE NC2314.2 +100800 MOVE "'WHEN' PHRASE SHOULD BE TRUE" TO RE-MARK NC2314.2 +100900 MOVE "AA" TO CORRECT-X NC2314.2 +101000 MOVE L2-HOLD TO COMPUTED-X NC2314.2 +101100 PERFORM FAIL NC2314.2 +101200 PERFORM PRINT-DETAIL. NC2314.2 +101300 ADD 1 TO REC-CT. NC2314.2 +101400 SEARCH-TEST-1-2. NC2314.2 +101500 MOVE "SEARCH-TEST-1-2" TO PAR-NAME. NC2314.2 +101600 IF L3-HOLD = "BB" NC2314.2 +101700 PERFORM PASS NC2314.2 +101800 PERFORM PRINT-DETAIL NC2314.2 +101900 ELSE NC2314.2 +102000 MOVE "'WHEN' PHRASE SHOULD BE TRUE" TO RE-MARK NC2314.2 +102100 MOVE "BB" TO CORRECT-X NC2314.2 +102200 MOVE L3-HOLD TO COMPUTED-X NC2314.2 +102300 PERFORM FAIL NC2314.2 +102400 PERFORM PRINT-DETAIL. NC2314.2 +102500 ADD 1 TO REC-CT. NC2314.2 +102600 SEARCH-TEST-1-3. NC2314.2 +102700 MOVE "SEARCH-TEST-1-3" TO PAR-NAME. NC2314.2 +102800 IF L4-HOLD = "CC" NC2314.2 +102900 PERFORM PASS NC2314.2 +103000 PERFORM PRINT-DETAIL NC2314.2 +103100 ELSE NC2314.2 +103200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2314.2 +103300 MOVE "CC" TO CORRECT-X NC2314.2 +103400 MOVE L4-HOLD TO COMPUTED-X NC2314.2 +103500 PERFORM FAIL NC2314.2 +103600 PERFORM PRINT-DETAIL. NC2314.2 +103700 NC2314.2 +103800 NC2314.2 +103900 SEARCH-INIT-2. NC2314.2 +104000 MOVE "SEARCH-TEST-2" TO PAR-NAME. NC2314.2 +104100 MOVE "IV-41 6.4.3" TO ANSI-REFERENCE. NC2314.2 +104200 MOVE "CD" TO L1-HOLD. NC2314.2 +104300 MOVE "ZZ" TO ENTRY-7-1 (2). NC2314.2 +104400 MOVE SPACE TO L2-HOLD. NC2314.2 +104500 MOVE SPACE TO L3-HOLD. NC2314.2 +104600 MOVE SPACE TO L4-HOLD. NC2314.2 +104700 MOVE 1 TO REC-CT. NC2314.2 +104800 MOVE 1 TO N1. NC2314.2 +104900 SET IX-1 IX-2 IX-3 IX-4 IX-5 IX-6 IX-7 TO 1. NC2314.2 +105000 GO TO SEARCH-TEST-2-0. NC2314.2 +105100 SEARCH-DELETE-2. NC2314.2 +105200 PERFORM DE-LETE. NC2314.2 +105300 PERFORM PRINT-DETAIL. NC2314.2 +105400 GO TO END-SEARCH-TEST. NC2314.2 +105500 SEARCH-TEST-2-0. NC2314.2 +105600 SEARCH GRP-7-1-ENTRY VARYING N1 NC2314.2 +105700 WHEN ENTRY-7-1 (N1) = L1-HOLD NC2314.2 +105800 MOVE "AA" TO L2-HOLD NC2314.2 +105900 MOVE "BB" TO L3-HOLD NC2314.2 +106000 END-SEARCH NC2314.2 +106100 MOVE "CC" TO L4-HOLD. NC2314.2 +106200 SEARCH-TEST-2-1. NC2314.2 +106300 MOVE "SEARCH-TEST-2-1" TO PAR-NAME. NC2314.2 +106400 IF L2-HOLD = SPACE NC2314.2 +106500 PERFORM PASS NC2314.2 +106600 PERFORM PRINT-DETAIL NC2314.2 +106700 ELSE NC2314.2 +106800 MOVE "'WHEN' PHRASE SHOULD BE FALSE" TO RE-MARK NC2314.2 +106900 MOVE SPACE TO CORRECT-X NC2314.2 +107000 MOVE L2-HOLD TO COMPUTED-X NC2314.2 +107100 PERFORM FAIL NC2314.2 +107200 PERFORM PRINT-DETAIL. NC2314.2 +107300 ADD 1 TO REC-CT. NC2314.2 +107400 SEARCH-TEST-2-2. NC2314.2 +107500 MOVE "SEARCH-TEST-2-2" TO PAR-NAME. NC2314.2 +107600 IF L3-HOLD = SPACE NC2314.2 +107700 PERFORM PASS NC2314.2 +107800 PERFORM PRINT-DETAIL NC2314.2 +107900 ELSE NC2314.2 +108000 MOVE "'WHEN' PHRASE SHOULD BE FALSE" TO RE-MARK NC2314.2 +108100 MOVE SPACE TO CORRECT-X NC2314.2 +108200 MOVE L3-HOLD TO COMPUTED-X NC2314.2 +108300 PERFORM FAIL NC2314.2 +108400 PERFORM PRINT-DETAIL. NC2314.2 +108500 ADD 1 TO REC-CT. NC2314.2 +108600 SEARCH-TEST-2-3. NC2314.2 +108700 MOVE "SEARCH-TEST-2-3" TO PAR-NAME. NC2314.2 +108800 IF L4-HOLD = "CC" NC2314.2 +108900 PERFORM PASS NC2314.2 +109000 PERFORM PRINT-DETAIL NC2314.2 +109100 ELSE NC2314.2 +109200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2314.2 +109300 MOVE "CC" TO CORRECT-X NC2314.2 +109400 MOVE L4-HOLD TO COMPUTED-X NC2314.2 +109500 PERFORM FAIL NC2314.2 +109600 PERFORM PRINT-DETAIL. NC2314.2 +109700 NC2314.2 +109800 GO TO END-SEARCH-TEST. NC2314.2 +109900 NC2314.2 +110000 PASS-TH. NC2314.2 +110100 PERFORM PASS. NC2314.2 +110200 PERFORM PRINT-DETAIL. NC2314.2 +110300 FAIL-TH. NC2314.2 +110400 PERFORM FAIL. NC2314.2 +110500 PERFORM PRINT-DETAIL. NC2314.2 +110600 END-SEARCH-TEST. NC2314.2 +110700 EXIT. NC2314.2 +110800 CCVS-EXIT SECTION. NC2314.2 +110900 CCVS-999999. NC2314.2 +111000 GO TO CLOSE-FILES. NC2314.2 diff --git a/tests/cobol85/NC/NC232A.CBL b/tests/cobol85/NC/NC232A.CBL new file mode 100755 index 00000000..91946579 --- /dev/null +++ b/tests/cobol85/NC/NC232A.CBL @@ -0,0 +1,923 @@ +000100 IDENTIFICATION DIVISION. NC2324.2 +000200 PROGRAM-ID. NC2324.2 +000300 NC232A. NC2324.2 +000400**************************************************************** NC2324.2 +000500* * NC2324.2 +000600* VALIDATION FOR:- * NC2324.2 +000700* * NC2324.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2324.2 +000900* * NC2324.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2324.2 +001100* * NC2324.2 +001200**************************************************************** NC2324.2 +001300* * NC2324.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2324.2 +001500* * NC2324.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2324.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2324.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2324.2 +001900* * NC2324.2 +002000**************************************************************** NC2324.2 +002100 NC2324.2 +002200* NC2324.2 +002300* PROGRAM NC232A USES FORMAT 1 OF THE "SEARCH" STATEMENT TO * NC2324.2 +002400* ACCESS A THREE DIMENSIONAL TABLE. THE OPTIONAL "VARYING" * NC2324.2 +002500* PHRASE IS USED WITH AN INDEX-NAME. * NC2324.2 +002600* * NC2324.2 +002700**************************************************************** NC2324.2 +002800 ENVIRONMENT DIVISION. NC2324.2 +002900 CONFIGURATION SECTION. NC2324.2 +003000 SOURCE-COMPUTER. NC2324.2 +003100 Linux. NC2324.2 +003200 OBJECT-COMPUTER. NC2324.2 +003300 Linux. NC2324.2 +003400 INPUT-OUTPUT SECTION. NC2324.2 +003500 FILE-CONTROL. NC2324.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2324.2 +003700 "report.log". NC2324.2 +003800 DATA DIVISION. NC2324.2 +003900 FILE SECTION. NC2324.2 +004000 FD PRINT-FILE. NC2324.2 +004100 01 PRINT-REC PICTURE X(120). NC2324.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2324.2 +004300 WORKING-STORAGE SECTION. NC2324.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2324.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2324.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2324.2 +004700 77 CON-7 PICTURE 99 VALUE 07. NC2324.2 +004800 77 CON-10 PICTURE 99 VALUE 10. NC2324.2 +004900 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2324.2 +005000 77 CON-5 PICTURE 99 VALUE 05. NC2324.2 +005100 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2324.2 +005200 77 CON-6 PICTURE 99 VALUE 06. NC2324.2 +005300 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2324.2 +005400 01 GRP-NAME. NC2324.2 +005500 02 FILLER PICTURE XXX VALUE "GRP". NC2324.2 +005600 02 ADD-GRP PICTURE 99 VALUE 01. NC2324.2 +005700 NC2324.2 +005800 01 SEC-NAME. NC2324.2 +005900 02 FILLER PICTURE X(5) VALUE "SEC (". NC2324.2 +006000 02 SEC-GRP PICTURE 99 VALUE 00. NC2324.2 +006100 02 FILLER PICTURE X VALUE ",". NC2324.2 +006200 02 ADD-SEC PICTURE 99 VALUE 01. NC2324.2 +006300 02 FILLER PICTURE X VALUE ")". NC2324.2 +006400 NC2324.2 +006500 01 ELEM-NAME. NC2324.2 +006600 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2324.2 +006700 02 ELEM-GRP PICTURE 99 VALUE 00. NC2324.2 +006800 02 FILLER PICTURE X VALUE ",". NC2324.2 +006900 02 ELEM-SEC PICTURE 99 VALUE 00. NC2324.2 +007000 02 FILLER PICTURE X VALUE ",". NC2324.2 +007100 02 ADD-ELEM PICTURE 99 VALUE 01. NC2324.2 +007200 02 FILLER PICTURE X VALUE ")". NC2324.2 +007300 NC2324.2 +007400 01 3-DIMENSION-TBL. NC2324.2 +007500 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2324.2 +007600 03 ENTRY-1 PICTURE X(5). NC2324.2 +007700 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2324.2 +007800 04 ENTRY-2 PICTURE X(11). NC2324.2 +007900 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2324.2 +008000 05 ENTRY-3 PICTURE X(15). NC2324.2 +008100 NC2324.2 +008200 01 END-STMT. NC2324.2 +008300 02 FILLER PICTURE X(7) VALUE "AT END ". NC2324.2 +008400 02 END-IDX PICTURE X(5) VALUE SPACES. NC2324.2 +008500 02 FILLER PICTURE XXX VALUE " = ". NC2324.2 +008600 02 IDX-VALU PICTURE 99 VALUE 00. NC2324.2 +008700 02 FILLER PICTURE XXX VALUE SPACES. NC2324.2 +008800 01 NOTE-1. NC2324.2 +008900 02 FILLER PICTURE X(74) VALUE NC2324.2 +009000 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2324.2 +009100- "PATH WAS TAKEN". NC2324.2 +009200 02 FILLER PICTURE X(46) VALUE SPACES. NC2324.2 +009300 01 NOTE-2. NC2324.2 +009400 02 FILLER PICTURE X(112) VALUE NC2324.2 +009500 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2324.2 +009600- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2324.2 +009700 02 FILLER PICTURE X(8) VALUE SPACES. NC2324.2 +009800 01 TEST-RESULTS. NC2324.2 +009900 02 FILLER PIC X VALUE SPACE. NC2324.2 +010000 02 FEATURE PIC X(20) VALUE SPACE. NC2324.2 +010100 02 FILLER PIC X VALUE SPACE. NC2324.2 +010200 02 P-OR-F PIC X(5) VALUE SPACE. NC2324.2 +010300 02 FILLER PIC X VALUE SPACE. NC2324.2 +010400 02 PAR-NAME. NC2324.2 +010500 03 FILLER PIC X(19) VALUE SPACE. NC2324.2 +010600 03 PARDOT-X PIC X VALUE SPACE. NC2324.2 +010700 03 DOTVALUE PIC 99 VALUE ZERO. NC2324.2 +010800 02 FILLER PIC X(8) VALUE SPACE. NC2324.2 +010900 02 RE-MARK PIC X(61). NC2324.2 +011000 01 TEST-COMPUTED. NC2324.2 +011100 02 FILLER PIC X(30) VALUE SPACE. NC2324.2 +011200 02 FILLER PIC X(17) VALUE NC2324.2 +011300 " COMPUTED=". NC2324.2 +011400 02 COMPUTED-X. NC2324.2 +011500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2324.2 +011600 03 COMPUTED-N REDEFINES COMPUTED-A NC2324.2 +011700 PIC -9(9).9(9). NC2324.2 +011800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2324.2 +011900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2324.2 +012000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2324.2 +012100 03 CM-18V0 REDEFINES COMPUTED-A. NC2324.2 +012200 04 COMPUTED-18V0 PIC -9(18). NC2324.2 +012300 04 FILLER PIC X. NC2324.2 +012400 03 FILLER PIC X(50) VALUE SPACE. NC2324.2 +012500 01 TEST-CORRECT. NC2324.2 +012600 02 FILLER PIC X(30) VALUE SPACE. NC2324.2 +012700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2324.2 +012800 02 CORRECT-X. NC2324.2 +012900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2324.2 +013000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2324.2 +013100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2324.2 +013200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2324.2 +013300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2324.2 +013400 03 CR-18V0 REDEFINES CORRECT-A. NC2324.2 +013500 04 CORRECT-18V0 PIC -9(18). NC2324.2 +013600 04 FILLER PIC X. NC2324.2 +013700 03 FILLER PIC X(2) VALUE SPACE. NC2324.2 +013800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2324.2 +013900 01 CCVS-C-1. NC2324.2 +014000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2324.2 +014100- "SS PARAGRAPH-NAME NC2324.2 +014200- " REMARKS". NC2324.2 +014300 02 FILLER PIC X(20) VALUE SPACE. NC2324.2 +014400 01 CCVS-C-2. NC2324.2 +014500 02 FILLER PIC X VALUE SPACE. NC2324.2 +014600 02 FILLER PIC X(6) VALUE "TESTED". NC2324.2 +014700 02 FILLER PIC X(15) VALUE SPACE. NC2324.2 +014800 02 FILLER PIC X(4) VALUE "FAIL". NC2324.2 +014900 02 FILLER PIC X(94) VALUE SPACE. NC2324.2 +015000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2324.2 +015100 01 REC-CT PIC 99 VALUE ZERO. NC2324.2 +015200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2324.2 +015300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2324.2 +015400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2324.2 +015500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2324.2 +015600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2324.2 +015700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2324.2 +015800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2324.2 +015900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2324.2 +016000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2324.2 +016100 01 CCVS-H-1. NC2324.2 +016200 02 FILLER PIC X(39) VALUE SPACES. NC2324.2 +016300 02 FILLER PIC X(42) VALUE NC2324.2 +016400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2324.2 +016500 02 FILLER PIC X(39) VALUE SPACES. NC2324.2 +016600 01 CCVS-H-2A. NC2324.2 +016700 02 FILLER PIC X(40) VALUE SPACE. NC2324.2 +016800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2324.2 +016900 02 FILLER PIC XXXX VALUE NC2324.2 +017000 "4.2 ". NC2324.2 +017100 02 FILLER PIC X(28) VALUE NC2324.2 +017200 " COPY - NOT FOR DISTRIBUTION". NC2324.2 +017300 02 FILLER PIC X(41) VALUE SPACE. NC2324.2 +017400 NC2324.2 +017500 01 CCVS-H-2B. NC2324.2 +017600 02 FILLER PIC X(15) VALUE NC2324.2 +017700 "TEST RESULT OF ". NC2324.2 +017800 02 TEST-ID PIC X(9). NC2324.2 +017900 02 FILLER PIC X(4) VALUE NC2324.2 +018000 " IN ". NC2324.2 +018100 02 FILLER PIC X(12) VALUE NC2324.2 +018200 " HIGH ". NC2324.2 +018300 02 FILLER PIC X(22) VALUE NC2324.2 +018400 " LEVEL VALIDATION FOR ". NC2324.2 +018500 02 FILLER PIC X(58) VALUE NC2324.2 +018600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2324.2 +018700 01 CCVS-H-3. NC2324.2 +018800 02 FILLER PIC X(34) VALUE NC2324.2 +018900 " FOR OFFICIAL USE ONLY ". NC2324.2 +019000 02 FILLER PIC X(58) VALUE NC2324.2 +019100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2324.2 +019200 02 FILLER PIC X(28) VALUE NC2324.2 +019300 " COPYRIGHT 1985 ". NC2324.2 +019400 01 CCVS-E-1. NC2324.2 +019500 02 FILLER PIC X(52) VALUE SPACE. NC2324.2 +019600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2324.2 +019700 02 ID-AGAIN PIC X(9). NC2324.2 +019800 02 FILLER PIC X(45) VALUE SPACES. NC2324.2 +019900 01 CCVS-E-2. NC2324.2 +020000 02 FILLER PIC X(31) VALUE SPACE. NC2324.2 +020100 02 FILLER PIC X(21) VALUE SPACE. NC2324.2 +020200 02 CCVS-E-2-2. NC2324.2 +020300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2324.2 +020400 03 FILLER PIC X VALUE SPACE. NC2324.2 +020500 03 ENDER-DESC PIC X(44) VALUE NC2324.2 +020600 "ERRORS ENCOUNTERED". NC2324.2 +020700 01 CCVS-E-3. NC2324.2 +020800 02 FILLER PIC X(22) VALUE NC2324.2 +020900 " FOR OFFICIAL USE ONLY". NC2324.2 +021000 02 FILLER PIC X(12) VALUE SPACE. NC2324.2 +021100 02 FILLER PIC X(58) VALUE NC2324.2 +021200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2324.2 +021300 02 FILLER PIC X(13) VALUE SPACE. NC2324.2 +021400 02 FILLER PIC X(15) VALUE NC2324.2 +021500 " COPYRIGHT 1985". NC2324.2 +021600 01 CCVS-E-4. NC2324.2 +021700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2324.2 +021800 02 FILLER PIC X(4) VALUE " OF ". NC2324.2 +021900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2324.2 +022000 02 FILLER PIC X(40) VALUE NC2324.2 +022100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2324.2 +022200 01 XXINFO. NC2324.2 +022300 02 FILLER PIC X(19) VALUE NC2324.2 +022400 "*** INFORMATION ***". NC2324.2 +022500 02 INFO-TEXT. NC2324.2 +022600 04 FILLER PIC X(8) VALUE SPACE. NC2324.2 +022700 04 XXCOMPUTED PIC X(20). NC2324.2 +022800 04 FILLER PIC X(5) VALUE SPACE. NC2324.2 +022900 04 XXCORRECT PIC X(20). NC2324.2 +023000 02 INF-ANSI-REFERENCE PIC X(48). NC2324.2 +023100 01 HYPHEN-LINE. NC2324.2 +023200 02 FILLER PIC IS X VALUE IS SPACE. NC2324.2 +023300 02 FILLER PIC IS X(65) VALUE IS "************************NC2324.2 +023400- "*****************************************". NC2324.2 +023500 02 FILLER PIC IS X(54) VALUE IS "************************NC2324.2 +023600- "******************************". NC2324.2 +023700 01 CCVS-PGM-ID PIC X(9) VALUE NC2324.2 +023800 "NC232A". NC2324.2 +023900 PROCEDURE DIVISION. NC2324.2 +024000 CCVS1 SECTION. NC2324.2 +024100 OPEN-FILES. NC2324.2 +024200 OPEN OUTPUT PRINT-FILE. NC2324.2 +024300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2324.2 +024400 MOVE SPACE TO TEST-RESULTS. NC2324.2 +024500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2324.2 +024600 GO TO CCVS1-EXIT. NC2324.2 +024700 CLOSE-FILES. NC2324.2 +024800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2324.2 +024900 TERMINATE-CCVS. NC2324.2 +025000*S EXIT PROGRAM. NC2324.2 +025100*SERMINATE-CALL. NC2324.2 +025200 STOP RUN. NC2324.2 +025300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2324.2 +025400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2324.2 +025500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2324.2 +025600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2324.2 +025700 MOVE "****TEST DELETED****" TO RE-MARK. NC2324.2 +025800 PRINT-DETAIL. NC2324.2 +025900 IF REC-CT NOT EQUAL TO ZERO NC2324.2 +026000 MOVE "." TO PARDOT-X NC2324.2 +026100 MOVE REC-CT TO DOTVALUE. NC2324.2 +026200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2324.2 +026300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2324.2 +026400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2324.2 +026500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2324.2 +026600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2324.2 +026700 MOVE SPACE TO CORRECT-X. NC2324.2 +026800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2324.2 +026900 MOVE SPACE TO RE-MARK. NC2324.2 +027000 HEAD-ROUTINE. NC2324.2 +027100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +027200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +027300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2324.2 +027400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2324.2 +027500 COLUMN-NAMES-ROUTINE. NC2324.2 +027600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +027700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +027900 END-ROUTINE. NC2324.2 +028000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2324.2 +028100 END-RTN-EXIT. NC2324.2 +028200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +028300 END-ROUTINE-1. NC2324.2 +028400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2324.2 +028500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2324.2 +028600 ADD PASS-COUNTER TO ERROR-HOLD. NC2324.2 +028700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2324.2 +028800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2324.2 +028900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2324.2 +029000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2324.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2324.2 +029200 END-ROUTINE-12. NC2324.2 +029300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2324.2 +029400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2324.2 +029500 MOVE "NO " TO ERROR-TOTAL NC2324.2 +029600 ELSE NC2324.2 +029700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2324.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2324.2 +029900 PERFORM WRITE-LINE. NC2324.2 +030000 END-ROUTINE-13. NC2324.2 +030100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2324.2 +030200 MOVE "NO " TO ERROR-TOTAL ELSE NC2324.2 +030300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2324.2 +030400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2324.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +030600 IF INSPECT-COUNTER EQUAL TO ZERO NC2324.2 +030700 MOVE "NO " TO ERROR-TOTAL NC2324.2 +030800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2324.2 +030900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2324.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +031100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2324.2 +031200 WRITE-LINE. NC2324.2 +031300 ADD 1 TO RECORD-COUNT. NC2324.2 +031400 IF RECORD-COUNT GREATER 50 NC2324.2 +031500 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2324.2 +031600 MOVE SPACE TO DUMMY-RECORD NC2324.2 +031700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2324.2 +031800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2324.2 +031900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2324.2 +032000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2324.2 +032100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2324.2 +032200 MOVE ZERO TO RECORD-COUNT. NC2324.2 +032300 PERFORM WRT-LN. NC2324.2 +032400 WRT-LN. NC2324.2 +032500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2324.2 +032600 MOVE SPACE TO DUMMY-RECORD. NC2324.2 +032700 BLANK-LINE-PRINT. NC2324.2 +032800 PERFORM WRT-LN. NC2324.2 +032900 FAIL-ROUTINE. NC2324.2 +033000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2324.2 +033100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2324.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2324.2 +033300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2324.2 +033400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +033500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2324.2 +033600 GO TO FAIL-ROUTINE-EX. NC2324.2 +033700 FAIL-ROUTINE-WRITE. NC2324.2 +033800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2324.2 +033900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2324.2 +034000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2324.2 +034100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2324.2 +034200 FAIL-ROUTINE-EX. EXIT. NC2324.2 +034300 BAIL-OUT. NC2324.2 +034400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2324.2 +034500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2324.2 +034600 BAIL-OUT-WRITE. NC2324.2 +034700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2324.2 +034800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2324.2 +034900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2324.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2324.2 +035100 BAIL-OUT-EX. EXIT. NC2324.2 +035200 CCVS1-EXIT. NC2324.2 +035300 EXIT. NC2324.2 +035400 SECT-NC232A-001 SECTION. NC2324.2 +035500 TH-03-001. NC2324.2 +035600* NC2324.2 +035700 BUILD-LEVEL-1. NC2324.2 +035800 ADD 1 TO SUB-1. NC2324.2 +035900 IF SUB-1 = 11 GO TO CHECK-ENTRIES. NC2324.2 +036000 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC2324.2 +036100 ADD 1 TO ADD-GRP. NC2324.2 +036200 NC2324.2 +036300 BUILD-LEVEL-2. NC2324.2 +036400 ADD 1 TO SUB-2. NC2324.2 +036500 IF SUB-2 = 11 NC2324.2 +036600 MOVE ZERO TO SUB-2 NC2324.2 +036700 MOVE 01 TO ADD-SEC NC2324.2 +036800 GO TO BUILD-LEVEL-1. NC2324.2 +036900 MOVE SUB-1 TO SEC-GRP. NC2324.2 +037000 MOVE SEC-NAME TO ENTRY-2 (SUB-1, SUB-2). NC2324.2 +037100 ADD 1 TO ADD-SEC. NC2324.2 +037200 NC2324.2 +037300 BUILD-LEVEL-3. NC2324.2 +037400 ADD 1 TO SUB-3. NC2324.2 +037500 IF SUB-3 = 11 NC2324.2 +037600 MOVE ZERO TO SUB-3 NC2324.2 +037700 MOVE 01 TO ADD-ELEM NC2324.2 +037800 GO TO BUILD-LEVEL-2. NC2324.2 +037900 MOVE SUB-1 TO ELEM-GRP. NC2324.2 +038000 MOVE SUB-2 TO ELEM-SEC. NC2324.2 +038100 MOVE ELEM-NAME TO ENTRY-3 (SUB-1, SUB-2, SUB-3). NC2324.2 +038200 ADD 1 TO ADD-ELEM. NC2324.2 +038300 GO TO BUILD-LEVEL-3. NC2324.2 +038400 NC2324.2 +038500 CHECK-ENTRIES. NC2324.2 +038600 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2324.2 +038700 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2324.2 +038800 MOVE "GRP02" TO GRP-HOLD-AREA. NC2324.2 +038900 MOVE 02 TO SUB-2. NC2324.2 +039000 SET IDX-1 TO 1. NC2324.2 +039100 SEARCH GRP-ENTRY VARYING IDX-1 AT END NC2324.2 +039200 PERFORM GRP-FAIL-PARGRAPH NC2324.2 +039300 GO TO TH1-TEST-F1-2 NC2324.2 +039400 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2324.2 +039500 PERFORM PASS NC2324.2 +039600 PERFORM PRINT-DETAIL. NC2324.2 +039700 GO TO TH1-TEST-F1-2. NC2324.2 +039800 NC2324.2 +039900 GRP-FAIL-PARGRAPH. NC2324.2 +040000 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2324.2 +040100 IF ENTRY-1 (SUB-2) EQUAL TO GRP-HOLD-AREA NC2324.2 +040200 MOVE "IDX-1" TO END-IDX NC2324.2 +040300 SET IDX-VALU TO IDX-1 NC2324.2 +040400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +040500 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +040600 MOVE ENTRY-1 (SUB-2) TO COMPUTED-A NC2324.2 +040700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +040800 NC2324.2 +040900 PERFORM FAIL NC2324.2 +041000 PERFORM PRINT-DETAIL. NC2324.2 +041100* NC2324.2 +041200 TH1-INIT-F1-2. NC2324.2 +041300 MOVE "TH1-TEST-F1-2 " TO PAR-NAME. NC2324.2 +041400 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +041500 MOVE "GRP01" TO GRP-HOLD-AREA. NC2324.2 +041600 MOVE 01 TO SUB-2. NC2324.2 +041700 SET IDX-1 TO 1. NC2324.2 +041800 TH1-TEST-F1-2. NC2324.2 +041900 SEARCH GRP-ENTRY VARYING IDX-1 AT END NC2324.2 +042000 GO TO TH1-FAIL-F1-2 NC2324.2 +042100 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2324.2 +042200 NC2324.2 +042300 PERFORM PASS NC2324.2 +042400 GO TO TH1-WRITE-F1-2. NC2324.2 +042500 TH1-DELETE-F1-2. NC2324.2 +042600 PERFORM DE-LETE. NC2324.2 +042700 GO TO TH1-WRITE-F1-2. NC2324.2 +042800 TH1-FAIL-F1-2. NC2324.2 +042900 PERFORM FAIL. NC2324.2 +043000 TH1-WRITE-F1-2. NC2324.2 +043100 PERFORM PRINT-DETAIL. NC2324.2 +043200* NC2324.2 +043300 TH1-INIT-F1-3. NC2324.2 +043400 MOVE "TH1-TEST-F1-3 " TO PAR-NAME. NC2324.2 +043500 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +043600 MOVE "GRP10" TO GRP-HOLD-AREA. NC2324.2 +043700 MOVE 10 TO SUB-2. NC2324.2 +043800 SET IDX-1 TO 1. NC2324.2 +043900 TH1-TEST-F1-3. NC2324.2 +044000 SEARCH GRP-ENTRY VARYING IDX-1 AT END NC2324.2 +044100 GO TO TH1-FAIL-F1-3 NC2324.2 +044200 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2324.2 +044300 NC2324.2 +044400 PERFORM PASS NC2324.2 +044500 GO TO TH1-WRITE-F1-3. NC2324.2 +044600 TH1-DELETE-F1-3. NC2324.2 +044700 PERFORM DE-LETE. NC2324.2 +044800 GO TO TH1-WRITE-F1-3. NC2324.2 +044900 TH1-FAIL-F1-3. NC2324.2 +045000 PERFORM FAIL. NC2324.2 +045100 TH1-WRITE-F1-3. NC2324.2 +045200 PERFORM PRINT-DETAIL. NC2324.2 +045300* NC2324.2 +045400 TH1-INIT-F1-4. NC2324.2 +045500 MOVE "TH1-TEST-F1-4 " TO PAR-NAME. NC2324.2 +045600 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +045700 MOVE "GRP05" TO GRP-HOLD-AREA. NC2324.2 +045800 MOVE 05 TO SUB-2. NC2324.2 +045900 SET IDX-1 TO 05. NC2324.2 +046000 TH1-TEST-F1-4. NC2324.2 +046100 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +046200 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2324.2 +046300 GO TO PASS-TH1-F1-4. NC2324.2 +046400 GO TO TH1-FAIL-F1-4. NC2324.2 +046500 PASS-TH1-F1-4. NC2324.2 +046600 NC2324.2 +046700 PERFORM PASS NC2324.2 +046800 GO TO TH1-WRITE-F1-4. NC2324.2 +046900 TH1-DELETE-F1-4. NC2324.2 +047000 PERFORM DE-LETE. NC2324.2 +047100 GO TO TH1-WRITE-F1-4. NC2324.2 +047200 TH1-FAIL-F1-4. NC2324.2 +047300 PERFORM GRP-FAIL-PARGRAPH. NC2324.2 +047400 TH1-WRITE-F1-4. NC2324.2 +047500 PERFORM PRINT-DETAIL. NC2324.2 +047600* NC2324.2 +047700 TH2-INIT-F1-1. NC2324.2 +047800 MOVE "TH2-TEST-F1-1 " TO PAR-NAME. NC2324.2 +047900 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +048000 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2324.2 +048100 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2324.2 +048200 MOVE 1 TO SUB-1 SUB-2. NC2324.2 +048300 SET IDX-1 IDX-2 TO 1. NC2324.2 +048400 TH2-TEST-F1-1. NC2324.2 +048500 SEARCH GRP2-ENTRY VARYING IDX-2 AT END NC2324.2 +048600 GO TO TH2-FAIL-F1-1 NC2324.2 +048700 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +048800 NEXT SENTENCE. NC2324.2 +048900 NC2324.2 +049000 PERFORM PASS. NC2324.2 +049100 GO TO TH2-WRITE-F1-1. NC2324.2 +049200 TH2-DELETE-F1-1. NC2324.2 +049300 PERFORM DE-LETE. NC2324.2 +049400 GO TO TH2-WRITE-F1-1. NC2324.2 +049500 TH2-FAIL-F1-1. NC2324.2 +049600 PERFORM SEC-FAIL-PARGRAF. NC2324.2 +049700 TH2-WRITE-F1-1. NC2324.2 +049800 PERFORM PRINT-DETAIL. NC2324.2 +049900 NC2324.2 +050000 TH2-INIT-F1-2. NC2324.2 +050100 MOVE "TH2-TEST-F1-2 " TO PAR-NAME. NC2324.2 +050200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +050300 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2324.2 +050400 MOVE "SEC (05,10)" TO SEC-HOLD-AREA. NC2324.2 +050500 MOVE 05 TO SUB-1. NC2324.2 +050600 MOVE 10 TO SUB-2. NC2324.2 +050700 SET IDX-1 TO 5. NC2324.2 +050800 SET IDX-2 TO 1. NC2324.2 +050900 TH2-TEST-F1-2. NC2324.2 +051000 SEARCH GRP2-ENTRY VARYING IDX-2 AT END NC2324.2 +051100 GO TO TH2-FAIL-F1-2 NC2324.2 +051200 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +051300 NEXT SENTENCE. NC2324.2 +051400 NC2324.2 +051500 PERFORM PASS NC2324.2 +051600 GO TO TH2-WRITE-F1-2. NC2324.2 +051700 TH2-DELETE-F1-2. NC2324.2 +051800 PERFORM DE-LETE. NC2324.2 +051900 GO TO TH2-WRITE-F1-2. NC2324.2 +052000 TH2-FAIL-F1-2. NC2324.2 +052100 PERFORM SEC-FAIL-PARGRAF. NC2324.2 +052200 TH2-WRITE-F1-2. NC2324.2 +052300 PERFORM PRINT-DETAIL. NC2324.2 +052400* NC2324.2 +052500 TH2-INIT-F1-3. NC2324.2 +052600 MOVE "TH2-TEST-F1-3 " TO PAR-NAME. NC2324.2 +052700 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +052800 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2324.2 +052900 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2324.2 +053000 SET IDX-1 TO 10. NC2324.2 +053100 SET IDX-2 TO 1. NC2324.2 +053200 MOVE 10 TO SUB-1 SUB-2. NC2324.2 +053300 TH2-TEST-F1-3. NC2324.2 +053400 SEARCH GRP2-ENTRY VARYING IDX-2 AT END NC2324.2 +053500 GO TO TH2-FAIL-F1-3 NC2324.2 +053600 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +053700 NEXT SENTENCE. NC2324.2 +053800 NC2324.2 +053900 PERFORM PASS NC2324.2 +054000 GO TO TH2-WRITE-F1-3. NC2324.2 +054100 TH2-DELETE-F1-3. NC2324.2 +054200 PERFORM DE-LETE. NC2324.2 +054300 GO TO TH2-WRITE-F1-3. NC2324.2 +054400 TH2-FAIL-F1-3. NC2324.2 +054500 PERFORM SEC-FAIL-PARGRAF. NC2324.2 +054600 TH2-WRITE-F1-3. NC2324.2 +054700 PERFORM PRINT-DETAIL. NC2324.2 +054800* NC2324.2 +054900 TH2-INIT-F1-4. NC2324.2 +055000 MOVE "TH2-TEST-F1-4 " TO PAR-NAME. NC2324.2 +055100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +055200 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2324.2 +055300 MOVE "SEC (08,02)" TO SEC-HOLD-AREA. NC2324.2 +055400 MOVE 08 TO SUB-1. NC2324.2 +055500 MOVE 02 TO SUB-2. NC2324.2 +055600 SET IDX-1 TO 08. NC2324.2 +055700 SET IDX-2 TO 01. NC2324.2 +055800 TH2-TEST-F1-4. NC2324.2 +055900 SEARCH GRP2-ENTRY VARYING IDX-2 NC2324.2 +056000 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +056100 PERFORM PASS NC2324.2 +056200 GO TO TH2-WRITE-F1-4. NC2324.2 +056300 GO TO TH2-FAIL-F1-4. NC2324.2 +056400 TH2-DELETE-F1-4. NC2324.2 +056500 PERFORM DE-LETE. NC2324.2 +056600 GO TO TH2-WRITE-F1-4. NC2324.2 +056700 TH2-FAIL-F1-4. NC2324.2 +056800 PERFORM SEC-FAIL-PARGRAF. NC2324.2 +056900 TH2-WRITE-F1-4. NC2324.2 +057000 PERFORM PRINT-DETAIL. NC2324.2 +057100 GO TO TH3-INIT-F1-1. NC2324.2 +057200* NC2324.2 +057300 SEC-FAIL-PARGRAF. NC2324.2 +057400 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2324.2 +057500 IF ENTRY-2 (SUB-1, SUB-2) EQUAL TO SEC-HOLD-AREA NC2324.2 +057600 MOVE "IDX-2" TO END-IDX NC2324.2 +057700 SET IDX-VALU TO IDX-2 NC2324.2 +057800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +057900 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +058000 MOVE ENTRY-2 (SUB-1, SUB-2) TO COMPUTED-A NC2324.2 +058100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +058200 NC2324.2 +058300 PERFORM FAIL. NC2324.2 +058400 NC2324.2 +058500 TH3-INIT-F1-1. NC2324.2 +058600 MOVE "TH3-TEST-F1-1 " TO PAR-NAME. NC2324.2 +058700 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +058800 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2324.2 +058900 MOVE 1 TO SUB-1 SUB-2 SUB-3. NC2324.2 +059000 MOVE "ELEM (01,01,01)" TO ELEM-HOLD-AREA. NC2324.2 +059100 SET IDX-1 IDX-2 IDX-3 TO 1. NC2324.2 +059200 TH3-TEST-F1-1. NC2324.2 +059300 SEARCH GRP3-ENTRY VARYING IDX-3 NC2324.2 +059400 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +059500 GO TO PASS-TH3-1. NC2324.2 +059600 GO TO TH3-FAIL-F1-1. NC2324.2 +059700 PASS-TH3-1. NC2324.2 +059800 NC2324.2 +059900 PERFORM PASS. NC2324.2 +060000 GO TO TH3-WRITE-F1-1. NC2324.2 +060100 TH3-DELETE-F1-1. NC2324.2 +060200 PERFORM DE-LETE. NC2324.2 +060300 GO TO TH3-WRITE-F1-1. NC2324.2 +060400 TH3-FAIL-F1-1. NC2324.2 +060500 PERFORM ELEM-FAIL-PARA. NC2324.2 +060600 TH3-WRITE-F1-1. NC2324.2 +060700 PERFORM PRINT-DETAIL. NC2324.2 +060800* NC2324.2 +060900 TH3-INIT-F1-2. NC2324.2 +061000 MOVE "TH3-TEST-F1-2 " TO PAR-NAME. NC2324.2 +061100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +061200 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2324.2 +061300 MOVE 05 TO SUB-1. NC2324.2 +061400 MOVE 06 TO SUB-2. NC2324.2 +061500 MOVE 07 TO SUB-3. NC2324.2 +061600 SET IDX-1 TO 05. NC2324.2 +061700 SET IDX-2 TO 06. NC2324.2 +061800 SET IDX-3 TO 1. NC2324.2 +061900 MOVE "ELEM (05,06,07)" TO ELEM-HOLD-AREA. NC2324.2 +062000 TH3-TEST-F1-2. NC2324.2 +062100 SEARCH GRP3-ENTRY VARYING IDX-3 AT END NC2324.2 +062200 GO TO TH3-FAIL-F1-2 NC2324.2 +062300 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +062400 NEXT SENTENCE. NC2324.2 +062500 NC2324.2 +062600 PERFORM PASS NC2324.2 +062700 GO TO TH3-WRITE-F1-2. NC2324.2 +062800 TH3-DELETE-F1-2. NC2324.2 +062900 PERFORM DE-LETE. NC2324.2 +063000 GO TO TH3-WRITE-F1-2. NC2324.2 +063100 TH3-FAIL-F1-2. NC2324.2 +063200 PERFORM ELEM-FAIL-PARA. NC2324.2 +063300 TH3-WRITE-F1-2. NC2324.2 +063400 PERFORM PRINT-DETAIL. NC2324.2 +063500* NC2324.2 +063600 TH3-INIT-F1-3. NC2324.2 +063700 MOVE "TH3-TEST-F1-3 " TO PAR-NAME. NC2324.2 +063800 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +063900 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2324.2 +064000 MOVE 10 TO SUB-1 SUB-2 SUB-3. NC2324.2 +064100 SET IDX-1 IDX-2 TO 10. NC2324.2 +064200 SET IDX-3 TO 1. NC2324.2 +064300 TH3-TEST-F1-3. NC2324.2 +064400 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2324.2 +064500 SEARCH GRP3-ENTRY VARYING IDX-3 AT END NC2324.2 +064600 GO TO TH3-FAIL-F1-3 NC2324.2 +064700 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +064800 NEXT SENTENCE. NC2324.2 +064900 NC2324.2 +065000 PERFORM PASS NC2324.2 +065100 GO TO TH3-WRITE-F1-3. NC2324.2 +065200 TH3-DELETE-F1-3. NC2324.2 +065300 PERFORM DE-LETE. NC2324.2 +065400 GO TO TH3-WRITE-F1-3. NC2324.2 +065500 TH3-FAIL-F1-3. NC2324.2 +065600 PERFORM ELEM-FAIL-PARA. NC2324.2 +065700 TH3-WRITE-F1-3. NC2324.2 +065800 PERFORM PRINT-DETAIL. NC2324.2 +065900* NC2324.2 +066000 TH3-INIT-F1-4. NC2324.2 +066100 MOVE "TH3-TEST-F1-4 " TO PAR-NAME. NC2324.2 +066200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +066300 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2324.2 +066400 MOVE "ELEM (07,06,05)" TO ELEM-HOLD-AREA. NC2324.2 +066500 MOVE 07 TO SUB-1. NC2324.2 +066600 MOVE 06 TO SUB-2. NC2324.2 +066700 MOVE 05 TO SUB-3. NC2324.2 +066800 SET IDX-1 TO 07. NC2324.2 +066900 SET IDX-2 TO 06. NC2324.2 +067000 SET IDX-3 TO 03. NC2324.2 +067100 TH3-TEST-F1-4. NC2324.2 +067200 SEARCH GRP3-ENTRY VARYING IDX-3 AT END NC2324.2 +067300 GO TO TH3-TEST-F1-4 NC2324.2 +067400 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +067500 NEXT SENTENCE. NC2324.2 +067600 NC2324.2 +067700 PERFORM PASS NC2324.2 +067800 GO TO TH3-WRITE-F1-4. NC2324.2 +067900 TH3-DELETE-F1-4. NC2324.2 +068000 PERFORM DE-LETE. NC2324.2 +068100 GO TO TH3-WRITE-F1-4. NC2324.2 +068200 TH3-FAIL-F1-4. NC2324.2 +068300 PERFORM ELEM-FAIL-PARA. NC2324.2 +068400 TH3-WRITE-F1-4. NC2324.2 +068500 PERFORM PRINT-DETAIL. NC2324.2 +068600 GO TO SCH-INIT-F1-1. NC2324.2 +068700* NC2324.2 +068800 ELEM-FAIL-PARA. NC2324.2 +068900 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2324.2 +069000 IF ENTRY-3 (SUB-1, SUB-2, SUB-3) EQUAL TO ELEM-HOLD-AREA NC2324.2 +069100 MOVE "IDX-3" TO END-IDX NC2324.2 +069200 SET IDX-VALU TO IDX-3 NC2324.2 +069300 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +069400 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +069500 MOVE ENTRY-3 (SUB-1, SUB-2, SUB-3) TO COMPUTED-A NC2324.2 +069600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +069700 PERFORM FAIL. NC2324.2 +069800* NC2324.2 +069900 SCH-INIT-F1-1. NC2324.2 +070000 MOVE "SCH-TEST-F1-1 " TO PAR-NAME. NC2324.2 +070100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +070200 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2324.2 +070300 MOVE "GRP08" TO GRP-HOLD-AREA. NC2324.2 +070400 MOVE "SEC (08,07)" TO SEC-HOLD-AREA. NC2324.2 +070500 SET IDX-1 IDX-2 TO 1. NC2324.2 +070600 SCH-TEST-F1-1. NC2324.2 +070700 SEARCH GRP-ENTRY VARYING IDX-1 AT END GO TO SCH-FAIL-F1-1-A NC2324.2 +070800 WHEN ENTRY-1 (IDX-1) = "GRP08" NEXT SENTENCE. NC2324.2 +070900 SEARCH GRP2-ENTRY VARYING IDX-2 AT END GO TO SCH-FAIL-F1-1-B NC2324.2 +071000 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +071100 NEXT SENTENCE. NC2324.2 +071200 PERFORM PASS NC2324.2 +071300 GO TO SCH-WRITE-F1-1. NC2324.2 +071400 SCH-DELETE-F1-1. NC2324.2 +071500 PERFORM DE-LETE. NC2324.2 +071600 GO TO SCH-WRITE-F1-1. NC2324.2 +071700 SCH-FAIL-F1-1-A. NC2324.2 +071800 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2324.2 +071900 IF ENTRY-1 (08) EQUAL TO GRP-HOLD-AREA NC2324.2 +072000 MOVE "IDX-1" TO END-IDX NC2324.2 +072100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +072200 SET IDX-VALU TO IDX-1 NC2324.2 +072300 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +072400 MOVE ENTRY-1 (08) TO COMPUTED-A NC2324.2 +072500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +072600 NC2324.2 +072700 PERFORM FAIL NC2324.2 +072800 GO TO SCH-WRITE-F1-1. NC2324.2 +072900 SCH-FAIL-F1-1-B. NC2324.2 +073000 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2324.2 +073100 IF ENTRY-2 (08, 07) EQUAL TO SEC-HOLD-AREA NC2324.2 +073200 MOVE "IDX-2" TO END-IDX NC2324.2 +073300 SET IDX-VALU TO IDX-2 NC2324.2 +073400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +073500 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +073600 MOVE ENTRY-2 (08, 07) TO COMPUTED-A NC2324.2 +073700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +073800 NC2324.2 +073900 PERFORM FAIL. NC2324.2 +074000 SCH-WRITE-F1-1. NC2324.2 +074100 PERFORM PRINT-DETAIL. NC2324.2 +074200* NC2324.2 +074300 SCH-INIT-F1-2. NC2324.2 +074400 MOVE "SCH-TEST-F1-2 " TO PAR-NAME. NC2324.2 +074500 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +074600 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2324.2 +074700 MOVE "GRP04" TO GRP-HOLD-AREA. NC2324.2 +074800 MOVE "SEC (04,04)" TO SEC-HOLD-AREA. NC2324.2 +074900 MOVE "ELEM (04,04,04)" TO ELEM-HOLD-AREA. NC2324.2 +075000 SET IDX-1 IDX-2 IDX-3 TO 1. NC2324.2 +075100 SCH-TEST-F1-2. NC2324.2 +075200 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +075300 AT END NC2324.2 +075400 GO TO SCH-FAIL-F1-2-A NC2324.2 +075500 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2324.2 +075600 NEXT SENTENCE. NC2324.2 +075700* NC2324.2 +075800 SEARCH GRP2-ENTRY VARYING IDX-2 NC2324.2 +075900 AT END NC2324.2 +076000 GO TO SCH-FAIL-F1-2-B NC2324.2 +076100 WHEN ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2324.2 +076200 NEXT SENTENCE. NC2324.2 +076300* NC2324.2 +076400 SEARCH GRP3-ENTRY VARYING IDX-3 NC2324.2 +076500 AT END NC2324.2 +076600 GO TO SCH-FAIL-F1-2-C NC2324.2 +076700 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2324.2 +076800 NEXT SENTENCE. NC2324.2 +076900 NC2324.2 +077000 PERFORM PASS NC2324.2 +077100 GO TO SCH-WRITE-F1-2. NC2324.2 +077200 SCH-FAIL-F1-2-A. NC2324.2 +077300 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2324.2 +077400 IF ENTRY-1 (04) EQUAL TO GRP-HOLD-AREA NC2324.2 +077500 MOVE "IDX-1" TO END-IDX NC2324.2 +077600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +077700 SET IDX-VALU TO IDX-1 NC2324.2 +077800 MOVE END-STMT TO COMPUTED-A NC2324.2 +077900 ELSE NC2324.2 +078000 MOVE ENTRY-1 (04) TO COMPUTED-A NC2324.2 +078100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +078200 PERFORM FAIL. NC2324.2 +078300 GO TO SCH-WRITE-F1-2. NC2324.2 +078400 SCH-FAIL-F1-2-B. NC2324.2 +078500 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2324.2 +078600 IF ENTRY-2 (04, 04) EQUAL TO SEC-HOLD-AREA NC2324.2 +078700 MOVE "IDX-2" TO END-IDX NC2324.2 +078800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +078900 SET IDX-VALU TO IDX-2 NC2324.2 +079000 MOVE END-STMT TO COMPUTED-A NC2324.2 +079100 ELSE NC2324.2 +079200 MOVE ENTRY-2 (04, 04) TO COMPUTED-A NC2324.2 +079300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +079400 PERFORM FAIL NC2324.2 +079500 GO TO SCH-WRITE-F1-2. NC2324.2 +079600 SCH-FAIL-F1-2-C. NC2324.2 +079700 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2324.2 +079800 IF ENTRY-3 (04, 04, 04) EQUAL TO ELEM-HOLD-AREA NC2324.2 +079900 MOVE "IDX-3" TO END-IDX NC2324.2 +080000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +080100 SET IDX-VALU TO IDX-3 NC2324.2 +080200 MOVE END-STMT TO COMPUTED-A NC2324.2 +080300 ELSE NC2324.2 +080400 MOVE ENTRY-3 (04, 04, 04) TO COMPUTED-A NC2324.2 +080500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +080600 PERFORM FAIL. NC2324.2 +080700 SCH-WRITE-F1-2. NC2324.2 +080800 PERFORM PRINT-DETAIL. NC2324.2 +080900* NC2324.2 +081000 SPC-INIT-F1-1. NC2324.2 +081100 MOVE "SPC-TEST-F1-1 " TO PAR-NAME. NC2324.2 +081200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +081300 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2324.2 +081400 SET IDX-1 TO 4. NC2324.2 +081500 SPC-TEST-F1-1. NC2324.2 +081600 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +081700 AT END NC2324.2 +081800 PERFORM PASS NC2324.2 +081900 GO TO SPC-WRITE-F1-1 NC2324.2 +082000 WHEN ENTRY-1 (IDX-1) = "GRP03" NC2324.2 +082100 GO TO SPC-FAIL-F1-1. NC2324.2 +082200 SPC-DELETE-F1-1. NC2324.2 +082300 PERFORM DE-LETE. NC2324.2 +082400 GO TO SPC-WRITE-F1-1. NC2324.2 +082500 SPC-FAIL-F1-1. NC2324.2 +082600 MOVE SPACES TO CORRECT-A. NC2324.2 +082700 MOVE ENTRY-1 (03) TO COMPUTED-A. NC2324.2 +082800 MOVE SPACES TO RE-MARK. NC2324.2 +082900 PERFORM FAIL. NC2324.2 +083000 SPC-WRITE-F1-1. NC2324.2 +083100 PERFORM PRINT-DETAIL. NC2324.2 +083200* NC2324.2 +083300 SPC-INIT-F1-2. NC2324.2 +083400 MOVE "SPC-TEST-F1-2" TO PAR-NAME. NC2324.2 +083500 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +083600 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2324.2 +083700 SET IDX-1 TO 4. NC2324.2 +083800 SET IDX-2 TO 5. NC2324.2 +083900 SPC-TEST-F1-2. NC2324.2 +084000 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +084100 AT END GO TO SPC-FAIL-F1-2-A NC2324.2 +084200 WHEN ENTRY-1 (IDX-1) = "GRP04" NEXT SENTENCE. NC2324.2 +084300 SEARCH GRP2-ENTRY VARYING IDX-2 NC2324.2 +084400 AT END PERFORM PASS NC2324.2 +084500 GO TO SPC-WRITE-F1-2 NC2324.2 +084600 WHEN ENTRY-2 (IDX-1, IDX-2) = "SEC (04,04)" NC2324.2 +084700 GO TO SPC-FAIL-F1-2-B. NC2324.2 +084800 SPC-DELETE-F1-2. NC2324.2 +084900 PERFORM DE-LETE. NC2324.2 +085000 GO TO SPC-WRITE-F1-2. NC2324.2 +085100 SPC-FAIL-F1-2-A. NC2324.2 +085200 MOVE "GRP04" TO CORRECT-A. NC2324.2 +085300 IF ENTRY-1 (04) EQUAL TO "GRP04" NC2324.2 +085400 MOVE "IDX-2" TO END-IDX NC2324.2 +085500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +085600 SET IDX-VALU TO IDX-2 NC2324.2 +085700 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +085800 MOVE ENTRY-1 (04) TO COMPUTED-A NC2324.2 +085900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +086000 PERFORM FAIL NC2324.2 +086100 GO TO SPC-WRITE-F1-2. NC2324.2 +086200 SPC-FAIL-F1-2-B. NC2324.2 +086300 MOVE ENTRY-2 (04, 04) TO COMPUTED-A NC2324.2 +086400 MOVE SPACES TO CORRECT-A. NC2324.2 +086500 PERFORM FAIL. NC2324.2 +086600 SPC-WRITE-F1-2. NC2324.2 +086700 PERFORM PRINT-DETAIL. NC2324.2 +086800* NC2324.2 +086900 SPC-INIT-F1-3. NC2324.2 +087000 MOVE "SPC-TEST-F1-3" TO PAR-NAME. NC2324.2 +087100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2324.2 +087200 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2324.2 +087300 SET IDX-1 TO 02. NC2324.2 +087400 SPC-TEST-F1-3. NC2324.2 +087500 SEARCH GRP-ENTRY VARYING IDX-1 NC2324.2 +087600 AT END NC2324.2 +087700 GO TO SPC-FAIL-F1-3-A NC2324.2 +087800 WHEN ENTRY-1 (IDX-1) EQUAL TO "GRP02" NC2324.2 +087900 NEXT SENTENCE. NC2324.2 +088000 SET IDX-2 TO 01. NC2324.2 +088100 SEARCH GRP2-ENTRY VARYING IDX-2 NC2324.2 +088200 AT END NC2324.2 +088300 GO TO SPC-FAIL-F1-3-B NC2324.2 +088400 WHEN ENTRY-2 (IDX-1, IDX-2) = "SEC (02,03)" NC2324.2 +088500 NEXT SENTENCE. NC2324.2 +088600 SET IDX-3 TO 05. NC2324.2 +088700 SEARCH GRP3-ENTRY VARYING IDX-3 NC2324.2 +088800 AT END PERFORM PASS NC2324.2 +088900 GO TO SPC-WRITE-F1-3 NC2324.2 +089000 WHEN ENTRY-3 (IDX-1, IDX-2, IDX-3) = "ELEM (02,03,04)" NC2324.2 +089100 GO TO SPC-FAIL-F1-3-C. NC2324.2 +089200 SPC-FAIL-F1-3-A. NC2324.2 +089300 MOVE "GRP02" TO CORRECT-A. NC2324.2 +089400 IF ENTRY-1 (02) EQUAL TO "GRP02" NC2324.2 +089500 MOVE "IDX-1" TO END-IDX NC2324.2 +089600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +089700 SET IDX-VALU TO IDX-1 NC2324.2 +089800 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +089900 MOVE ENTRY-1 (02) TO COMPUTED-A NC2324.2 +090000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +090100 PERFORM FAIL NC2324.2 +090200 GO TO SPC-WRITE-F1-3. NC2324.2 +090300 SPC-FAIL-F1-3-B. NC2324.2 +090400 MOVE "SEC (02,03)" TO CORRECT-A. NC2324.2 +090500 IF ENTRY-2 (02, 03) EQUAL TO "SEC (02,03)" NC2324.2 +090600 MOVE "IDX-2" TO END-IDX NC2324.2 +090700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2324.2 +090800 SET IDX-VALU TO IDX-2 NC2324.2 +090900 MOVE END-STMT TO COMPUTED-A ELSE NC2324.2 +091000 MOVE ENTRY-2 (02, 03) TO COMPUTED-A NC2324.2 +091100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2324.2 +091200 PERFORM FAIL NC2324.2 +091300 GO TO SPC-WRITE-F1-3. NC2324.2 +091400 SPC-FAIL-F1-3-C. NC2324.2 +091500 MOVE "INDEX SET HIGHER THAN ENTRY" TO RE-MARK NC2324.2 +091600 MOVE SPACES TO CORRECT-A NC2324.2 +091700 MOVE "ELEM (02,03,04)" TO COMPUTED-A NC2324.2 +091800 PERFORM FAIL. NC2324.2 +091900 SPC-WRITE-F1-3. NC2324.2 +092000 PERFORM PRINT-DETAIL. NC2324.2 +092100 CCVS-EXIT SECTION. NC2324.2 +092200 CCVS-999999. NC2324.2 +092300 GO TO CLOSE-FILES. NC2324.2 diff --git a/tests/cobol85/NC/NC233A.CBL b/tests/cobol85/NC/NC233A.CBL new file mode 100755 index 00000000..fe7aed69 --- /dev/null +++ b/tests/cobol85/NC/NC233A.CBL @@ -0,0 +1,881 @@ +000100 IDENTIFICATION DIVISION. NC2334.2 +000200 PROGRAM-ID. NC2334.2 +000300 NC233A. NC2334.2 +000400**************************************************************** NC2334.2 +000500* * NC2334.2 +000600* VALIDATION FOR:- * NC2334.2 +000700* * NC2334.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2334.2 +000900* * NC2334.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2334.2 +001100* * NC2334.2 +001200**************************************************************** NC2334.2 +001300* * NC2334.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2334.2 +001500* * NC2334.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2334.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2334.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2334.2 +001900* * NC2334.2 +002000**************************************************************** NC2334.2 +002100 NC2334.2 +002200* * NC2334.2 +002300* PROGRAM NC233A USES FORMAT 2 OF THE "SEARCH" STATEMENT * NC2334.2 +002400* TO ACCESS THRE AND SEVEN-DIMENSIONAL TABLES. * NC2334.2 +002500* THE SCOPE TERMINATOR "END-SEARCH" IS ALSO TESTED. * NC2334.2 +002600* * NC2334.2 +002700**************************************************************** NC2334.2 +002800 ENVIRONMENT DIVISION. NC2334.2 +002900 CONFIGURATION SECTION. NC2334.2 +003000 SOURCE-COMPUTER. NC2334.2 +003100 Linux. NC2334.2 +003200 OBJECT-COMPUTER. NC2334.2 +003300 Linux. NC2334.2 +003400 INPUT-OUTPUT SECTION. NC2334.2 +003500 FILE-CONTROL. NC2334.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2334.2 +003700 "report.log". NC2334.2 +003800 DATA DIVISION. NC2334.2 +003900 FILE SECTION. NC2334.2 +004000 FD PRINT-FILE. NC2334.2 +004100 01 PRINT-REC PICTURE X(120). NC2334.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2334.2 +004300 WORKING-STORAGE SECTION. NC2334.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2334.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2334.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2334.2 +004700 77 CON-7 PICTURE 99 VALUE 07. NC2334.2 +004800 77 CON-10 PICTURE 99 VALUE 10. NC2334.2 +004900 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2334.2 +005000 77 CON-5 PICTURE 99 VALUE 05. NC2334.2 +005100 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2334.2 +005200 77 CON-6 PICTURE 99 VALUE 06. NC2334.2 +005300 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2334.2 +005400 77 L1-HOLD PIC XX. NC2334.2 +005500 77 L2-HOLD PIC XX. NC2334.2 +005600 77 L3-HOLD PIC XX. NC2334.2 +005700 77 L4-HOLD PIC XX. NC2334.2 +005800 77 L5-HOLD PIC XX. NC2334.2 +005900 77 L6-HOLD PIC XX. NC2334.2 +006000 77 L7-HOLD PIC XX. NC2334.2 +006100 77 N1 PIC 99. NC2334.2 +006200 77 N2 PIC 99. NC2334.2 +006300 77 N3 PIC 99. NC2334.2 +006400 77 N4 PIC 99. NC2334.2 +006500 77 N5 PIC 99. NC2334.2 +006600 77 N6 PIC 99. NC2334.2 +006700 77 N7 PIC 99. NC2334.2 +006800 01 GRP-NAME. NC2334.2 +006900 02 FILLER PICTURE XXX VALUE "GRP". NC2334.2 +007000 02 ADD-GRP PICTURE 99 VALUE 01. NC2334.2 +007100 NC2334.2 +007200 01 SEC-NAME. NC2334.2 +007300 02 FILLER PICTURE X(5) VALUE "SEC (". NC2334.2 +007400 02 SEC-GRP PICTURE 99 VALUE 00. NC2334.2 +007500 02 FILLER PICTURE X VALUE ",". NC2334.2 +007600 02 ADD-SEC PICTURE 99 VALUE 01. NC2334.2 +007700 02 FILLER PICTURE X VALUE ")". NC2334.2 +007800 NC2334.2 +007900 01 ELEM-NAME. NC2334.2 +008000 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2334.2 +008100 02 ELEM-GRP PICTURE 99 VALUE 00. NC2334.2 +008200 02 FILLER PICTURE X VALUE ",". NC2334.2 +008300 02 ELEM-SEC PICTURE 99 VALUE 00. NC2334.2 +008400 02 FILLER PICTURE X VALUE ",". NC2334.2 +008500 02 ADD-ELEM PICTURE 99 VALUE 01. NC2334.2 +008600 02 FILLER PICTURE X VALUE ")". NC2334.2 +008700 NC2334.2 +008800 01 3-DIMENSION-TBL. NC2334.2 +008900 02 GRP-ENTRY OCCURS 10 TIMES ASCENDING KEY IS GRP NC2334.2 +009000 INDEXED BY IDX-1. NC2334.2 +009100 03 ENTRY-1. NC2334.2 +009200 05 GRP PICTURE X(5). NC2334.2 +009300 03 GRP2-ENTRY OCCURS 10 TIMES ASCENDING KEY IS SEC NC2334.2 +009400 INDEXED BY IDX-2. NC2334.2 +009500 04 ENTRY-2. NC2334.2 +009600 05 FILLER PICTURE X(4). NC2334.2 +009700 05 SEC PICTURE X(7). NC2334.2 +009800 04 GRP3-ENTRY OCCURS 10 TIMES ASCENDING KEY IS ELEM NC2334.2 +009900 INDEXED BY IDX-3. NC2334.2 +010000 05 ENTRY-3. NC2334.2 +010100 07 FILLER PICTURE X(8). NC2334.2 +010200 07 ELEM PICTURE X(7). NC2334.2 +010300 NC2334.2 +010400 NC2334.2 +010500 01 7-DIMENSION-TBL. NC2334.2 +010600 02 GRP-7-1-ENTRY OCCURS 2 NC2334.2 +010700 ASCENDING KEY IS ENTRY-7-1G NC2334.2 +010800 INDEXED BY X1. NC2334.2 +010900 03 ENTRY-7-1G. NC2334.2 +011000 04 CHARS-7-1 PIC X. NC2334.2 +011100 04 ENTRY-7-1 PIC 9. NC2334.2 +011200 03 GRP-7-2-ENTRY OCCURS 2 NC2334.2 +011300 ASCENDING KEY IS ENTRY-7-2G NC2334.2 +011400 INDEXED BY X2. NC2334.2 +011500 04 ENTRY-7-2G. NC2334.2 +011600 05 CHARS-7-2 PIC X. NC2334.2 +011700 05 ENTRY-7-2 PIC 9. NC2334.2 +011800 04 GRP-7-3-ENTRY OCCURS 2 NC2334.2 +011900 ASCENDING KEY IS ENTRY-7-3G NC2334.2 +012000 INDEXED BY X3. NC2334.2 +012100 05 ENTRY-7-3G. NC2334.2 +012200 06 CHARS-7-3 PIC X. NC2334.2 +012300 06 ENTRY-7-3 PIC 9. NC2334.2 +012400 05 GRP-7-4-ENTRY OCCURS 2 NC2334.2 +012500 ASCENDING KEY IS ENTRY-7-4G NC2334.2 +012600 INDEXED BY X4. NC2334.2 +012700 06 ENTRY-7-4G. NC2334.2 +012800 07 CHARS-7-4 PIC X. NC2334.2 +012900 07 ENTRY-7-4 PIC 9. NC2334.2 +013000 06 GRP-7-5-ENTRY OCCURS 2 NC2334.2 +013100 ASCENDING KEY IS ENTRY-7-5G NC2334.2 +013200 INDEXED BY X5. NC2334.2 +013300 07 ENTRY-7-5G. NC2334.2 +013400 08 CHARS-7-5 PIC X. NC2334.2 +013500 08 ENTRY-7-5 PIC 9. NC2334.2 +013600 07 GRP-7-6-ENTRY OCCURS 2 NC2334.2 +013700 ASCENDING KEY IS ENTRY-7-6G NC2334.2 +013800 INDEXED BY X6. NC2334.2 +013900 08 ENTRY-7-6G. NC2334.2 +014000 09 CHARS-7-6 PIC X. NC2334.2 +014100 09 ENTRY-7-6 PIC 9. NC2334.2 +014200 08 GRP-7-7-ENTRY OCCURS 2 NC2334.2 +014300 ASCENDING KEY IS ENTRY-7-7G NC2334.2 +014400 INDEXED BY X7. NC2334.2 +014500 09 ENTRY-7-7G. NC2334.2 +014600 10 CHARS-7-7 PIC X. NC2334.2 +014700 10 ENTRY-7-7 PIC 9. NC2334.2 +014800 NC2334.2 +014900 01 NOTE-1. NC2334.2 +015000 02 FILLER PICTURE X(74) VALUE NC2334.2 +015100 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2334.2 +015200- "PATH WAS TAKEN". NC2334.2 +015300 02 FILLER PICTURE X(46) VALUE SPACES. NC2334.2 +015400 01 NOTE-2. NC2334.2 +015500 02 FILLER PICTURE X(112) VALUE NC2334.2 +015600 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2334.2 +015700- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2334.2 +015800 02 FILLER PICTURE X(8) VALUE SPACES. NC2334.2 +015900 NC2334.2 +016000 01 END-STMT. NC2334.2 +016100 02 FILLER PICTURE X(7) VALUE "AT END ". NC2334.2 +016200 02 END-IDX PICTURE X(5) VALUE SPACES. NC2334.2 +016300 02 FILLER PICTURE XXX VALUE " = ". NC2334.2 +016400 02 IDX-VALU PICTURE 99 VALUE 00. NC2334.2 +016500 02 FILLER PICTURE XXX VALUE SPACES. NC2334.2 +016600 01 TEST-RESULTS. NC2334.2 +016700 02 FILLER PIC X VALUE SPACE. NC2334.2 +016800 02 FEATURE PIC X(20) VALUE SPACE. NC2334.2 +016900 02 FILLER PIC X VALUE SPACE. NC2334.2 +017000 02 P-OR-F PIC X(5) VALUE SPACE. NC2334.2 +017100 02 FILLER PIC X VALUE SPACE. NC2334.2 +017200 02 PAR-NAME. NC2334.2 +017300 03 FILLER PIC X(19) VALUE SPACE. NC2334.2 +017400 03 PARDOT-X PIC X VALUE SPACE. NC2334.2 +017500 03 DOTVALUE PIC 99 VALUE ZERO. NC2334.2 +017600 02 FILLER PIC X(8) VALUE SPACE. NC2334.2 +017700 02 RE-MARK PIC X(61). NC2334.2 +017800 01 TEST-COMPUTED. NC2334.2 +017900 02 FILLER PIC X(30) VALUE SPACE. NC2334.2 +018000 02 FILLER PIC X(17) VALUE NC2334.2 +018100 " COMPUTED=". NC2334.2 +018200 02 COMPUTED-X. NC2334.2 +018300 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2334.2 +018400 03 COMPUTED-N REDEFINES COMPUTED-A NC2334.2 +018500 PIC -9(9).9(9). NC2334.2 +018600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2334.2 +018700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2334.2 +018800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2334.2 +018900 03 CM-18V0 REDEFINES COMPUTED-A. NC2334.2 +019000 04 COMPUTED-18V0 PIC -9(18). NC2334.2 +019100 04 FILLER PIC X. NC2334.2 +019200 03 FILLER PIC X(50) VALUE SPACE. NC2334.2 +019300 01 TEST-CORRECT. NC2334.2 +019400 02 FILLER PIC X(30) VALUE SPACE. NC2334.2 +019500 02 FILLER PIC X(17) VALUE " CORRECT =". NC2334.2 +019600 02 CORRECT-X. NC2334.2 +019700 03 CORRECT-A PIC X(20) VALUE SPACE. NC2334.2 +019800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2334.2 +019900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2334.2 +020000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2334.2 +020100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2334.2 +020200 03 CR-18V0 REDEFINES CORRECT-A. NC2334.2 +020300 04 CORRECT-18V0 PIC -9(18). NC2334.2 +020400 04 FILLER PIC X. NC2334.2 +020500 03 FILLER PIC X(2) VALUE SPACE. NC2334.2 +020600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2334.2 +020700 01 CCVS-C-1. NC2334.2 +020800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2334.2 +020900- "SS PARAGRAPH-NAME NC2334.2 +021000- " REMARKS". NC2334.2 +021100 02 FILLER PIC X(20) VALUE SPACE. NC2334.2 +021200 01 CCVS-C-2. NC2334.2 +021300 02 FILLER PIC X VALUE SPACE. NC2334.2 +021400 02 FILLER PIC X(6) VALUE "TESTED". NC2334.2 +021500 02 FILLER PIC X(15) VALUE SPACE. NC2334.2 +021600 02 FILLER PIC X(4) VALUE "FAIL". NC2334.2 +021700 02 FILLER PIC X(94) VALUE SPACE. NC2334.2 +021800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2334.2 +021900 01 REC-CT PIC 99 VALUE ZERO. NC2334.2 +022000 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2334.2 +022100 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2334.2 +022200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2334.2 +022300 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2334.2 +022400 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2334.2 +022500 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2334.2 +022600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2334.2 +022700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2334.2 +022800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2334.2 +022900 01 CCVS-H-1. NC2334.2 +023000 02 FILLER PIC X(39) VALUE SPACES. NC2334.2 +023100 02 FILLER PIC X(42) VALUE NC2334.2 +023200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2334.2 +023300 02 FILLER PIC X(39) VALUE SPACES. NC2334.2 +023400 01 CCVS-H-2A. NC2334.2 +023500 02 FILLER PIC X(40) VALUE SPACE. NC2334.2 +023600 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2334.2 +023700 02 FILLER PIC XXXX VALUE NC2334.2 +023800 "4.2 ". NC2334.2 +023900 02 FILLER PIC X(28) VALUE NC2334.2 +024000 " COPY - NOT FOR DISTRIBUTION". NC2334.2 +024100 02 FILLER PIC X(41) VALUE SPACE. NC2334.2 +024200 NC2334.2 +024300 01 CCVS-H-2B. NC2334.2 +024400 02 FILLER PIC X(15) VALUE NC2334.2 +024500 "TEST RESULT OF ". NC2334.2 +024600 02 TEST-ID PIC X(9). NC2334.2 +024700 02 FILLER PIC X(4) VALUE NC2334.2 +024800 " IN ". NC2334.2 +024900 02 FILLER PIC X(12) VALUE NC2334.2 +025000 " HIGH ". NC2334.2 +025100 02 FILLER PIC X(22) VALUE NC2334.2 +025200 " LEVEL VALIDATION FOR ". NC2334.2 +025300 02 FILLER PIC X(58) VALUE NC2334.2 +025400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2334.2 +025500 01 CCVS-H-3. NC2334.2 +025600 02 FILLER PIC X(34) VALUE NC2334.2 +025700 " FOR OFFICIAL USE ONLY ". NC2334.2 +025800 02 FILLER PIC X(58) VALUE NC2334.2 +025900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2334.2 +026000 02 FILLER PIC X(28) VALUE NC2334.2 +026100 " COPYRIGHT 1985 ". NC2334.2 +026200 01 CCVS-E-1. NC2334.2 +026300 02 FILLER PIC X(52) VALUE SPACE. NC2334.2 +026400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2334.2 +026500 02 ID-AGAIN PIC X(9). NC2334.2 +026600 02 FILLER PIC X(45) VALUE SPACES. NC2334.2 +026700 01 CCVS-E-2. NC2334.2 +026800 02 FILLER PIC X(31) VALUE SPACE. NC2334.2 +026900 02 FILLER PIC X(21) VALUE SPACE. NC2334.2 +027000 02 CCVS-E-2-2. NC2334.2 +027100 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2334.2 +027200 03 FILLER PIC X VALUE SPACE. NC2334.2 +027300 03 ENDER-DESC PIC X(44) VALUE NC2334.2 +027400 "ERRORS ENCOUNTERED". NC2334.2 +027500 01 CCVS-E-3. NC2334.2 +027600 02 FILLER PIC X(22) VALUE NC2334.2 +027700 " FOR OFFICIAL USE ONLY". NC2334.2 +027800 02 FILLER PIC X(12) VALUE SPACE. NC2334.2 +027900 02 FILLER PIC X(58) VALUE NC2334.2 +028000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2334.2 +028100 02 FILLER PIC X(13) VALUE SPACE. NC2334.2 +028200 02 FILLER PIC X(15) VALUE NC2334.2 +028300 " COPYRIGHT 1985". NC2334.2 +028400 01 CCVS-E-4. NC2334.2 +028500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2334.2 +028600 02 FILLER PIC X(4) VALUE " OF ". NC2334.2 +028700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2334.2 +028800 02 FILLER PIC X(40) VALUE NC2334.2 +028900 " TESTS WERE EXECUTED SUCCESSFULLY". NC2334.2 +029000 01 XXINFO. NC2334.2 +029100 02 FILLER PIC X(19) VALUE NC2334.2 +029200 "*** INFORMATION ***". NC2334.2 +029300 02 INFO-TEXT. NC2334.2 +029400 04 FILLER PIC X(8) VALUE SPACE. NC2334.2 +029500 04 XXCOMPUTED PIC X(20). NC2334.2 +029600 04 FILLER PIC X(5) VALUE SPACE. NC2334.2 +029700 04 XXCORRECT PIC X(20). NC2334.2 +029800 02 INF-ANSI-REFERENCE PIC X(48). NC2334.2 +029900 01 HYPHEN-LINE. NC2334.2 +030000 02 FILLER PIC IS X VALUE IS SPACE. NC2334.2 +030100 02 FILLER PIC IS X(65) VALUE IS "************************NC2334.2 +030200- "*****************************************". NC2334.2 +030300 02 FILLER PIC IS X(54) VALUE IS "************************NC2334.2 +030400- "******************************". NC2334.2 +030500 01 CCVS-PGM-ID PIC X(9) VALUE NC2334.2 +030600 "NC233A". NC2334.2 +030700 PROCEDURE DIVISION. NC2334.2 +030800 CCVS1 SECTION. NC2334.2 +030900 OPEN-FILES. NC2334.2 +031000 OPEN OUTPUT PRINT-FILE. NC2334.2 +031100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2334.2 +031200 MOVE SPACE TO TEST-RESULTS. NC2334.2 +031300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2334.2 +031400 GO TO CCVS1-EXIT. NC2334.2 +031500 CLOSE-FILES. NC2334.2 +031600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2334.2 +031700 TERMINATE-CCVS. NC2334.2 +031800*S EXIT PROGRAM. NC2334.2 +031900*SERMINATE-CALL. NC2334.2 +032000 STOP RUN. NC2334.2 +032100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2334.2 +032200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2334.2 +032300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2334.2 +032400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2334.2 +032500 MOVE "****TEST DELETED****" TO RE-MARK. NC2334.2 +032600 PRINT-DETAIL. NC2334.2 +032700 IF REC-CT NOT EQUAL TO ZERO NC2334.2 +032800 MOVE "." TO PARDOT-X NC2334.2 +032900 MOVE REC-CT TO DOTVALUE. NC2334.2 +033000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2334.2 +033100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2334.2 +033200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2334.2 +033300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2334.2 +033400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2334.2 +033500 MOVE SPACE TO CORRECT-X. NC2334.2 +033600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2334.2 +033700 MOVE SPACE TO RE-MARK. NC2334.2 +033800 HEAD-ROUTINE. NC2334.2 +033900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +034000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +034100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2334.2 +034200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2334.2 +034300 COLUMN-NAMES-ROUTINE. NC2334.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +034700 END-ROUTINE. NC2334.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2334.2 +034900 END-RTN-EXIT. NC2334.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +035100 END-ROUTINE-1. NC2334.2 +035200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2334.2 +035300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2334.2 +035400 ADD PASS-COUNTER TO ERROR-HOLD. NC2334.2 +035500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2334.2 +035600 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2334.2 +035700 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2334.2 +035800 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2334.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2334.2 +036000 END-ROUTINE-12. NC2334.2 +036100 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2334.2 +036200 IF ERROR-COUNTER IS EQUAL TO ZERO NC2334.2 +036300 MOVE "NO " TO ERROR-TOTAL NC2334.2 +036400 ELSE NC2334.2 +036500 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2334.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2334.2 +036700 PERFORM WRITE-LINE. NC2334.2 +036800 END-ROUTINE-13. NC2334.2 +036900 IF DELETE-COUNTER IS EQUAL TO ZERO NC2334.2 +037000 MOVE "NO " TO ERROR-TOTAL ELSE NC2334.2 +037100 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2334.2 +037200 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2334.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +037400 IF INSPECT-COUNTER EQUAL TO ZERO NC2334.2 +037500 MOVE "NO " TO ERROR-TOTAL NC2334.2 +037600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2334.2 +037700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2334.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +037900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2334.2 +038000 WRITE-LINE. NC2334.2 +038100 ADD 1 TO RECORD-COUNT. NC2334.2 +038200 IF RECORD-COUNT GREATER 50 NC2334.2 +038300 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2334.2 +038400 MOVE SPACE TO DUMMY-RECORD NC2334.2 +038500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2334.2 +038600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2334.2 +038700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2334.2 +038800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2334.2 +038900 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2334.2 +039000 MOVE ZERO TO RECORD-COUNT. NC2334.2 +039100 PERFORM WRT-LN. NC2334.2 +039200 WRT-LN. NC2334.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2334.2 +039400 MOVE SPACE TO DUMMY-RECORD. NC2334.2 +039500 BLANK-LINE-PRINT. NC2334.2 +039600 PERFORM WRT-LN. NC2334.2 +039700 FAIL-ROUTINE. NC2334.2 +039800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2334.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2334.2 +040000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2334.2 +040100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2334.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +040300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2334.2 +040400 GO TO FAIL-ROUTINE-EX. NC2334.2 +040500 FAIL-ROUTINE-WRITE. NC2334.2 +040600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2334.2 +040700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2334.2 +040800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2334.2 +040900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2334.2 +041000 FAIL-ROUTINE-EX. EXIT. NC2334.2 +041100 BAIL-OUT. NC2334.2 +041200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2334.2 +041300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2334.2 +041400 BAIL-OUT-WRITE. NC2334.2 +041500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2334.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2334.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2334.2 +041800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2334.2 +041900 BAIL-OUT-EX. EXIT. NC2334.2 +042000 CCVS1-EXIT. NC2334.2 +042100 EXIT. NC2334.2 +042200 SECT-NC233A-001 SECTION. NC2334.2 +042300 TH-05-001. NC2334.2 +042400 BUILD-LEVEL-1. NC2334.2 +042500 ADD 1 TO SUB-1. NC2334.2 +042600 IF SUB-1 = 11 GO TO CHECK-ENTRIES. NC2334.2 +042700 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC2334.2 +042800 ADD 1 TO ADD-GRP. NC2334.2 +042900 BUILD-LEVEL-2. NC2334.2 +043000 ADD 1 TO SUB-2. NC2334.2 +043100 IF SUB-2 = 11 NC2334.2 +043200 MOVE ZERO TO SUB-2 NC2334.2 +043300 MOVE 01 TO ADD-SEC NC2334.2 +043400 GO TO BUILD-LEVEL-1. NC2334.2 +043500 MOVE SUB-1 TO SEC-GRP. NC2334.2 +043600 MOVE SEC-NAME TO ENTRY-2 (SUB-1, SUB-2). NC2334.2 +043700 ADD 1 TO ADD-SEC. NC2334.2 +043800 BUILD-LEVEL-3. NC2334.2 +043900 ADD 1 TO SUB-3. NC2334.2 +044000 IF SUB-3 = 11 NC2334.2 +044100 MOVE ZERO TO SUB-3 NC2334.2 +044200 MOVE 01 TO ADD-ELEM NC2334.2 +044300 GO TO BUILD-LEVEL-2. NC2334.2 +044400 MOVE SUB-1 TO ELEM-GRP. NC2334.2 +044500 MOVE SUB-2 TO ELEM-SEC. NC2334.2 +044600 MOVE ELEM-NAME TO ENTRY-3 (SUB-1, SUB-2, SUB-3). NC2334.2 +044700 ADD 1 TO ADD-ELEM. NC2334.2 +044800 GO TO BUILD-LEVEL-3. NC2334.2 +044900 NC2334.2 +045000 CHECK-ENTRIES. NC2334.2 +045100 MOVE "SEARCH ALL-FIRST LEV" TO FEATURE. NC2334.2 +045200 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2334.2 +045300 MOVE "GRP02" TO GRP-HOLD-AREA. NC2334.2 +045400 MOVE 02 TO SUB-2. NC2334.2 +045500 SET IDX-1 TO 1. NC2334.2 +045600 SEARCH ALL GRP-ENTRY AT END NC2334.2 +045700 PERFORM GRP-FAIL-PARGRAPH NC2334.2 +045800 GO TO LEVEL-1-TEST-2 NC2334.2 +045900 WHEN GRP (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2334.2 +046000 NC2334.2 +046100 PERFORM PASS-TH. NC2334.2 +046200 GO TO LEVEL-1-TEST-2. NC2334.2 +046300 NC2334.2 +046400 GRP-FAIL-PARGRAPH. NC2334.2 +046500 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2334.2 +046600 IF ENTRY-1 (SUB-2) EQUAL TO GRP-HOLD-AREA NC2334.2 +046700 MOVE "IDX-1" TO END-IDX NC2334.2 +046800 SET IDX-VALU TO IDX-1 NC2334.2 +046900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +047000 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +047100 MOVE ENTRY-1 (SUB-2) TO COMPUTED-A NC2334.2 +047200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +047300 NC2334.2 +047400 PERFORM FAIL-TH. NC2334.2 +047500 LEVEL-1-TEST-2. NC2334.2 +047600 MOVE "LEVEL-1-TEST-2 " TO PAR-NAME. NC2334.2 +047700 MOVE "GRP01" TO GRP-HOLD-AREA. NC2334.2 +047800 MOVE 01 TO SUB-2. NC2334.2 +047900 SET IDX-1 TO 1. NC2334.2 +048000 SEARCH ALL GRP-ENTRY AT END NC2334.2 +048100 PERFORM GRP-FAIL-PARGRAPH NC2334.2 +048200 GO TO LEVEL-1-TEST-3 NC2334.2 +048300 WHEN GRP (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2334.2 +048400 NC2334.2 +048500 PERFORM PASS-TH. NC2334.2 +048600 LEVEL-1-TEST-3. NC2334.2 +048700 MOVE "LEVEL-1-TEST-3 " TO PAR-NAME. NC2334.2 +048800 MOVE "GRP10" TO GRP-HOLD-AREA. NC2334.2 +048900 MOVE 10 TO SUB-2. NC2334.2 +049000 SET IDX-1 TO 1. NC2334.2 +049100 SEARCH ALL GRP-ENTRY AT END NC2334.2 +049200 PERFORM GRP-FAIL-PARGRAPH NC2334.2 +049300 GO TO LEVEL-1-TEST-4 NC2334.2 +049400 WHEN GRP (IDX-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2334.2 +049500 NC2334.2 +049600 PERFORM PASS-TH. NC2334.2 +049700 LEVEL-1-TEST-4. NC2334.2 +049800 MOVE "LEVEL-1-TEST-4 " TO PAR-NAME. NC2334.2 +049900 MOVE "GRP05" TO GRP-HOLD-AREA. NC2334.2 +050000 MOVE 05 TO SUB-2. NC2334.2 +050100 SET IDX-1 TO 05. NC2334.2 +050200 SEARCH ALL GRP-ENTRY NC2334.2 +050300 WHEN GRP (IDX-1) = GRP-HOLD-AREA GO TO PASS-TH-TEST-4. NC2334.2 +050400 PERFORM GRP-FAIL-PARGRAPH. NC2334.2 +050500 GO TO LEVEL-2-TEST-1. NC2334.2 +050600 PASS-TH-TEST-4. NC2334.2 +050700 NC2334.2 +050800 PERFORM PASS-TH. NC2334.2 +050900 NC2334.2 +051000 LEVEL-2-TEST-1. NC2334.2 +051100 MOVE "SEARCH ALL-SEC LEVEL" TO FEATURE. NC2334.2 +051200 MOVE "LEVEL-2-TEST-1 " TO PAR-NAME. NC2334.2 +051300 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2334.2 +051400 MOVE 1 TO SUB-1 SUB-2. NC2334.2 +051500 SET IDX-1 IDX-2 TO 1. NC2334.2 +051600 SEARCH ALL GRP2-ENTRY AT END NC2334.2 +051700 PERFORM SEC-FAIL-PARGRAF NC2334.2 +051800 GO TO LEVEL-2-TEST-2 NC2334.2 +051900 WHEN SEC (IDX-1, IDX-2) = "(01,01)" NEXT SENTENCE. NC2334.2 +052000 NC2334.2 +052100 PERFORM PASS-TH. NC2334.2 +052200 NC2334.2 +052300 LEVEL-2-TEST-2. NC2334.2 +052400 MOVE "LEVEL-2-TEST-2 " TO PAR-NAME. NC2334.2 +052500 MOVE "SEC (05,10)" TO SEC-HOLD-AREA. NC2334.2 +052600 MOVE 05 TO SUB-1. NC2334.2 +052700 MOVE 10 TO SUB-2. NC2334.2 +052800 SET IDX-1 TO 5. NC2334.2 +052900 SET IDX-2 TO 1. NC2334.2 +053000 SEARCH ALL GRP2-ENTRY AT END NC2334.2 +053100 PERFORM SEC-FAIL-PARGRAF NC2334.2 +053200 GO TO LEVEL-2-TEST-3 NC2334.2 +053300 WHEN SEC (IDX-1, IDX-2) = "(05,10)" NEXT SENTENCE. NC2334.2 +053400 NC2334.2 +053500 PERFORM PASS-TH. NC2334.2 +053600 NC2334.2 +053700 LEVEL-2-TEST-3. NC2334.2 +053800 MOVE "LEVEL-2-TEST-3 " TO PAR-NAME. NC2334.2 +053900 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2334.2 +054000 SET IDX-1 TO 10. NC2334.2 +054100 SET IDX-2 TO 1. NC2334.2 +054200 MOVE 10 TO SUB-1 SUB-2. NC2334.2 +054300 SEARCH ALL GRP2-ENTRY AT END NC2334.2 +054400 PERFORM SEC-FAIL-PARGRAF NC2334.2 +054500 GO TO LEVEL-2-TEST-4 NC2334.2 +054600 WHEN SEC (IDX-1, IDX-2) = "(10,10)" NEXT SENTENCE. NC2334.2 +054700 NC2334.2 +054800 PERFORM PASS-TH. NC2334.2 +054900 LEVEL-2-TEST-4. NC2334.2 +055000 MOVE "LEVEL-2-TEST-4 " TO PAR-NAME. NC2334.2 +055100 MOVE "SEC (08,02)" TO SEC-HOLD-AREA. NC2334.2 +055200 MOVE 08 TO SUB-1. NC2334.2 +055300 MOVE 02 TO SUB-2. NC2334.2 +055400 SET IDX-1 TO 08. NC2334.2 +055500 SET IDX-2 TO 01. NC2334.2 +055600 SEARCH ALL GRP2-ENTRY NC2334.2 +055700 WHEN SEC (IDX-1, IDX-2) = "(08,02)" GO TO PASS-TH-2-4. NC2334.2 +055800 PERFORM SEC-FAIL-PARGRAF. NC2334.2 +055900 GO TO LEVEL-3-TEST-1. NC2334.2 +056000 PASS-TH-2-4. NC2334.2 +056100 NC2334.2 +056200 PERFORM PASS-TH. NC2334.2 +056300 GO TO LEVEL-3-TEST-1. NC2334.2 +056400 NC2334.2 +056500 SEC-FAIL-PARGRAF. NC2334.2 +056600 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2334.2 +056700 IF ENTRY-2 (SUB-1, SUB-2) EQUAL TO SEC-HOLD-AREA NC2334.2 +056800 MOVE "IDX-2" TO END-IDX NC2334.2 +056900 SET IDX-VALU TO IDX-2 NC2334.2 +057000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +057100 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +057200 MOVE ENTRY-2 (SUB-1, SUB-2) TO COMPUTED-A NC2334.2 +057300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +057400 NC2334.2 +057500 PERFORM FAIL-TH. NC2334.2 +057600 NC2334.2 +057700 LEVEL-3-TEST-1. NC2334.2 +057800 MOVE "LEVEL-3-TEST-1 " TO PAR-NAME. NC2334.2 +057900 MOVE "SEARCH ALL THIRD LEV" TO FEATURE. NC2334.2 +058000 MOVE 1 TO SUB-1 SUB-2 SUB-3. NC2334.2 +058100 MOVE "ELEM (01,01,01)" TO ELEM-HOLD-AREA. NC2334.2 +058200 SET IDX-1 IDX-2 IDX-3 TO 1. NC2334.2 +058300 SEARCH ALL GRP3-ENTRY NC2334.2 +058400 WHEN ELEM (IDX-1, IDX-2, IDX-3) = ",01,01)" NC2334.2 +058500 GO TO PASS-TH-3-1. NC2334.2 +058600 PERFORM ELEM-FAIL-PARA. NC2334.2 +058700 GO TO LEVEL-3-TEST-2. NC2334.2 +058800 PASS-TH-3-1. NC2334.2 +058900 NC2334.2 +059000 PERFORM PASS-TH. NC2334.2 +059100 NC2334.2 +059200 LEVEL-3-TEST-2. NC2334.2 +059300 MOVE "LEVEL-3-TEST-2 " TO PAR-NAME. NC2334.2 +059400 MOVE 05 TO SUB-1. NC2334.2 +059500 MOVE 06 TO SUB-2. NC2334.2 +059600 MOVE 07 TO SUB-3. NC2334.2 +059700 SET IDX-1 TO 05. NC2334.2 +059800 SET IDX-2 TO 06. NC2334.2 +059900 SET IDX-3 TO 1. NC2334.2 +060000 MOVE "ELEM (05,06,07)" TO ELEM-HOLD-AREA. NC2334.2 +060100 SEARCH ALL GRP3-ENTRY AT END NC2334.2 +060200 PERFORM ELEM-FAIL-PARA NC2334.2 +060300 GO TO LEVEL-3-TEST-3 NC2334.2 +060400 WHEN ELEM (IDX-1, IDX-2, IDX-3) = ",06,07)" NC2334.2 +060500 NEXT SENTENCE. NC2334.2 +060600 NC2334.2 +060700 PERFORM PASS-TH. NC2334.2 +060800 NC2334.2 +060900 LEVEL-3-TEST-3. NC2334.2 +061000 MOVE "LEVEL-3-TEST-3 " TO PAR-NAME. NC2334.2 +061100 MOVE 10 TO SUB-1 SUB-2 SUB-3. NC2334.2 +061200 SET IDX-1 IDX-2 TO 10. NC2334.2 +061300 SET IDX-3 TO 1. NC2334.2 +061400 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2334.2 +061500 SEARCH ALL GRP3-ENTRY AT END NC2334.2 +061600 PERFORM ELEM-FAIL-PARA NC2334.2 +061700 GO TO LEVEL-3-TEST-4 NC2334.2 +061800 WHEN ELEM (IDX-1, IDX-2, IDX-3) = ",10,10)" NC2334.2 +061900 NEXT SENTENCE. NC2334.2 +062000 NC2334.2 +062100 PERFORM PASS-TH. NC2334.2 +062200 LEVEL-3-TEST-4. NC2334.2 +062300 MOVE "LEVEL-3-TEST-4 " TO PAR-NAME. NC2334.2 +062400 MOVE "ELEM (07,06,05)" TO ELEM-HOLD-AREA. NC2334.2 +062500 MOVE 07 TO SUB-1. NC2334.2 +062600 MOVE 06 TO SUB-2. NC2334.2 +062700 MOVE 05 TO SUB-3. NC2334.2 +062800 SET IDX-1 TO 07. NC2334.2 +062900 SET IDX-2 TO 06. NC2334.2 +063000 SET IDX-3 TO 03. NC2334.2 +063100 SEARCH ALL GRP3-ENTRY AT END NC2334.2 +063200 PERFORM ELEM-FAIL-PARA NC2334.2 +063300 GO TO MULT-SEARCH-TEST-1 NC2334.2 +063400 WHEN ELEM (IDX-1, IDX-2, IDX-3) = ",06,05)" NC2334.2 +063500 NEXT SENTENCE. NC2334.2 +063600 NC2334.2 +063700 PERFORM PASS-TH. NC2334.2 +063800 GO TO MULT-SEARCH-TEST-1. NC2334.2 +063900 ELEM-FAIL-PARA. NC2334.2 +064000 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2334.2 +064100 IF ENTRY-3 (SUB-1, SUB-2, SUB-3) EQUAL TO ELEM-HOLD-AREA NC2334.2 +064200 MOVE "IDX-3" TO END-IDX NC2334.2 +064300 SET IDX-VALU TO IDX-3 NC2334.2 +064400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +064500 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +064600 MOVE ENTRY-3 (SUB-1, SUB-2, SUB-3) TO COMPUTED-A NC2334.2 +064700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +064800 NC2334.2 +064900 PERFORM FAIL-TH. NC2334.2 +065000 NC2334.2 +065100 MULT-SEARCH-TEST-1. NC2334.2 +065200 MOVE "MULT-SEARCH-TEST-1 " TO PAR-NAME. NC2334.2 +065300 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2334.2 +065400 MOVE "GRP08" TO GRP-HOLD-AREA. NC2334.2 +065500 MOVE "SEC (08,07)" TO SEC-HOLD-AREA. NC2334.2 +065600 SET IDX-1 IDX-2 TO 1. NC2334.2 +065700 SEARCH ALL GRP-ENTRY AT END GO TO MULT-SEARCH-FAIL1 NC2334.2 +065800 WHEN GRP (IDX-1) = "GRP08" NEXT SENTENCE. NC2334.2 +065900 SEARCH ALL GRP2-ENTRY AT END GO TO MULT-SEARCH-FAIL NC2334.2 +066000 WHEN SEC (IDX-1, IDX-2) = "(08,07)" NEXT SENTENCE. NC2334.2 +066100 NC2334.2 +066200 PERFORM PASS-TH. NC2334.2 +066300 GO TO MULT-SEARCH-7-INIT-3. NC2334.2 +066400 MULT-SEARCH-FAIL1. NC2334.2 +066500 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2334.2 +066600 IF ENTRY-1 (08) EQUAL TO GRP-HOLD-AREA NC2334.2 +066700 MOVE "IDX-1" TO END-IDX NC2334.2 +066800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +066900 SET IDX-VALU TO IDX-1 NC2334.2 +067000 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +067100 MOVE ENTRY-1 (08) TO COMPUTED-A NC2334.2 +067200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +067300 NC2334.2 +067400 PERFORM FAIL-TH. NC2334.2 +067500 GO TO MULT-SEARCH-7-INIT-3. NC2334.2 +067600 MULT-SEARCH-FAIL. NC2334.2 +067700 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2334.2 +067800 IF ENTRY-2 (08, 07) EQUAL TO SEC-HOLD-AREA NC2334.2 +067900 MOVE "IDX-2" TO END-IDX NC2334.2 +068000 SET IDX-VALU TO IDX-2 NC2334.2 +068100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +068200 MOVE END-STMT TO COMPUTED-A ELSE NC2334.2 +068300 MOVE ENTRY-2 (08, 07) TO COMPUTED-A NC2334.2 +068400 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +068500 NC2334.2 +068600 PERFORM FAIL-TH. NC2334.2 +068700 NC2334.2 +068800 MULT-SEARCH-7-INIT-3. NC2334.2 +068900 MOVE "MULT-SEARCH-7-TEST-3" TO PAR-NAME. NC2334.2 +069000 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2334.2 +069100 MOVE "A2" TO L1-HOLD. NC2334.2 +069200 MOVE "B1" TO L2-HOLD. NC2334.2 +069300 MOVE "C2" TO L3-HOLD. NC2334.2 +069400 MOVE "D1" TO L4-HOLD. NC2334.2 +069500 MOVE "E2" TO L5-HOLD. NC2334.2 +069600 MOVE "F1" TO L6-HOLD. NC2334.2 +069700 MOVE "G2" TO L7-HOLD. NC2334.2 +069800 SET X1 X2 X3 X4 X5 X6 X7 TO 1. NC2334.2 +069900 PERFORM MULT-SEARCH-7-INIT-3-A NC2334.2 +070000 VARYING N1 FROM 1 BY 1 UNTIL N1 > 2 NC2334.2 +070100 AFTER N2 FROM 1 BY 1 UNTIL N2 > 2 NC2334.2 +070200 AFTER N3 FROM 1 BY 1 UNTIL N3 > 2 NC2334.2 +070300 AFTER N4 FROM 1 BY 1 UNTIL N4 > 2 NC2334.2 +070400 AFTER N5 FROM 1 BY 1 UNTIL N5 > 2 NC2334.2 +070500 AFTER N6 FROM 1 BY 1 UNTIL N6 > 2 NC2334.2 +070600 AFTER N7 FROM 1 BY 1 UNTIL N7 > 2. NC2334.2 +070700 GO TO MULT-SEARCH-7-TEST-3. NC2334.2 +070800 MULT-SEARCH-7-INIT-3-A. NC2334.2 +070900 NC2334.2 +071000 MOVE N1 TO ENTRY-7-1 (N1). NC2334.2 +071100 MOVE "A" TO CHARS-7-1 (N1). NC2334.2 +071200 MOVE N2 TO ENTRY-7-2 (N1 N2). NC2334.2 +071300 MOVE "B" TO CHARS-7-2 (N1 N2). NC2334.2 +071400 MOVE N3 TO ENTRY-7-3 (N1 N2 N3). NC2334.2 +071500 MOVE "C" TO CHARS-7-3 (N1 N2 N3). NC2334.2 +071600 MOVE N4 TO ENTRY-7-4 (N1 N2 N3 N4). NC2334.2 +071700 MOVE "D" TO CHARS-7-4 (N1 N2 N3 N4). NC2334.2 +071800 MOVE N5 TO ENTRY-7-5 (N1 N2 N3 N4 N5). NC2334.2 +071900 MOVE "E" TO CHARS-7-5 (N1 N2 N3 N4 N5). NC2334.2 +072000 MOVE N6 TO ENTRY-7-6 (N1 N2 N3 N4 N5 N6). NC2334.2 +072100 MOVE "F" TO CHARS-7-6 (N1 N2 N3 N4 N5 N6). NC2334.2 +072200 MOVE N7 TO ENTRY-7-7 (N1 N2 N3 N4 N5 N6 N7). NC2334.2 +072300 MOVE "G" TO CHARS-7-7 (N1 N2 N3 N4 N5 N6 N7). NC2334.2 +072400 MULT-SEARCH-7-DELETE-3. NC2334.2 +072500 PERFORM DE-LETE. NC2334.2 +072600 PERFORM PRINT-DETAIL. NC2334.2 +072700 GO TO END-SEARCH-TEST. NC2334.2 +072800 MULT-SEARCH-7-TEST-3. NC2334.2 +072900 SEARCH ALL GRP-7-1-ENTRY NC2334.2 +073000 AT END GO TO MULT-SEARCH-7-FAIL-1 NC2334.2 +073100 WHEN ENTRY-7-1G (X1) = L1-HOLD NC2334.2 +073200 NEXT SENTENCE. NC2334.2 +073300 SET X1 TO 1. NC2334.2 +073400 SEARCH ALL GRP-7-2-ENTRY NC2334.2 +073500 AT END GO TO MULT-SEARCH-7-FAIL-2 NC2334.2 +073600 WHEN ENTRY-7-2G (X1 X2) = L2-HOLD NC2334.2 +073700 NEXT SENTENCE. NC2334.2 +073800 SET X1 TO 2. NC2334.2 +073900 SET X2 TO 1. NC2334.2 +074000 SEARCH ALL GRP-7-3-ENTRY NC2334.2 +074100 AT END GO TO MULT-SEARCH-7-FAIL-3 NC2334.2 +074200 WHEN ENTRY-7-3G (X1 X2 X3) = L3-HOLD NC2334.2 +074300 NEXT SENTENCE. NC2334.2 +074400 SET X1 TO 1. NC2334.2 +074500 SET X2, X3 TO 1. NC2334.2 +074600 SEARCH ALL GRP-7-4-ENTRY NC2334.2 +074700 AT END GO TO MULT-SEARCH-7-FAIL-4 NC2334.2 +074800 WHEN ENTRY-7-4G (X1 X2 X3 X4) = L4-HOLD NC2334.2 +074900 NEXT SENTENCE. NC2334.2 +075000 SET X1 TO 2. NC2334.2 +075100 SET X2, X3, X4 TO 1. NC2334.2 +075200 SEARCH ALL GRP-7-5-ENTRY NC2334.2 +075300 AT END GO TO MULT-SEARCH-7-FAIL-5 NC2334.2 +075400 WHEN ENTRY-7-5G (X1 X2 X3 X4 X5) = L5-HOLD NC2334.2 +075500 NEXT SENTENCE. NC2334.2 +075600 SET X1 TO 1. NC2334.2 +075700 SET X2, X3, X4, X5 TO 1. NC2334.2 +075800 SEARCH ALL GRP-7-6-ENTRY NC2334.2 +075900 AT END GO TO MULT-SEARCH-7-FAIL-6 NC2334.2 +076000 WHEN ENTRY-7-6G (X1 X2 X3 X4 X5 X6) = L6-HOLD NC2334.2 +076100 NEXT SENTENCE. NC2334.2 +076200 SET X1 TO 2. NC2334.2 +076300 SET X2, X3, X4, X6 TO 1. NC2334.2 +076400 SEARCH ALL GRP-7-7-ENTRY NC2334.2 +076500 AT END GO TO MULT-SEARCH-7-FAIL-7 NC2334.2 +076600 WHEN ENTRY-7-7G (X1 X2 X3 X4 X5 X6 X7) = L7-HOLD NC2334.2 +076700 NEXT SENTENCE. NC2334.2 +076800 NC2334.2 +076900 PERFORM PASS-TH. NC2334.2 +077000 GO TO END-SEARCH-TEST. NC2334.2 +077100 NC2334.2 +077200 MULT-SEARCH-7-FAIL-1. NC2334.2 +077300 MOVE L1-HOLD TO CORRECT-A. NC2334.2 +077400 IF ENTRY-7-1 (2) = L1-HOLD NC2334.2 +077500 MOVE "IX-1" TO END-IDX NC2334.2 +077600 SET IDX-VALU TO X1 NC2334.2 +077700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +077800 MOVE END-STMT TO COMPUTED-A NC2334.2 +077900 ELSE NC2334.2 +078000 MOVE ENTRY-7-1 (2) TO COMPUTED-A NC2334.2 +078100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +078200 NC2334.2 +078300 PERFORM FAIL-TH. NC2334.2 +078400 GO TO END-SEARCH-TEST. NC2334.2 +078500 NC2334.2 +078600 MULT-SEARCH-7-FAIL-2. NC2334.2 +078700 MOVE L2-HOLD TO CORRECT-A. NC2334.2 +078800 IF ENTRY-7-2 (2 1) = L1-HOLD NC2334.2 +078900 MOVE "X2" TO END-IDX NC2334.2 +079000 SET IDX-VALU TO X2 NC2334.2 +079100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +079200 MOVE END-STMT TO COMPUTED-A NC2334.2 +079300 ELSE NC2334.2 +079400 MOVE ENTRY-7-2 (2 1) TO COMPUTED-A NC2334.2 +079500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +079600 NC2334.2 +079700 PERFORM FAIL-TH. NC2334.2 +079800 GO TO END-SEARCH-TEST. NC2334.2 +079900 NC2334.2 +080000 MULT-SEARCH-7-FAIL-3. NC2334.2 +080100 MOVE L3-HOLD TO CORRECT-A. NC2334.2 +080200 IF ENTRY-7-3 (2 1 2) = L3-HOLD NC2334.2 +080300 MOVE "X3" TO END-IDX NC2334.2 +080400 SET IDX-VALU TO X3 NC2334.2 +080500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +080600 MOVE END-STMT TO COMPUTED-A NC2334.2 +080700 ELSE NC2334.2 +080800 MOVE ENTRY-7-3 (2 1 2) TO COMPUTED-A NC2334.2 +080900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +081000 NC2334.2 +081100 PERFORM FAIL-TH. NC2334.2 +081200 GO TO END-SEARCH-TEST. NC2334.2 +081300 NC2334.2 +081400 MULT-SEARCH-7-FAIL-4. NC2334.2 +081500 MOVE L4-HOLD TO CORRECT-A. NC2334.2 +081600 IF ENTRY-7-4 (2 1 2 1) = L4-HOLD NC2334.2 +081700 MOVE "X4" TO END-IDX NC2334.2 +081800 SET IDX-VALU TO X4 NC2334.2 +081900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +082000 MOVE END-STMT TO COMPUTED-A NC2334.2 +082100 ELSE NC2334.2 +082200 MOVE ENTRY-7-4 (2 1 2 1) TO COMPUTED-A NC2334.2 +082300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +082400 NC2334.2 +082500 PERFORM FAIL-TH. NC2334.2 +082600 GO TO END-SEARCH-TEST. NC2334.2 +082700 NC2334.2 +082800 MULT-SEARCH-7-FAIL-5. NC2334.2 +082900 MOVE L5-HOLD TO CORRECT-A. NC2334.2 +083000 IF ENTRY-7-5 (2 1 2 1 2) = L5-HOLD NC2334.2 +083100 MOVE "X5" TO END-IDX NC2334.2 +083200 SET IDX-VALU TO X5 NC2334.2 +083300 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +083400 MOVE END-STMT TO COMPUTED-A NC2334.2 +083500 ELSE NC2334.2 +083600 MOVE ENTRY-7-5 (2 1 2 1 2) TO COMPUTED-A NC2334.2 +083700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +083800 NC2334.2 +083900 PERFORM FAIL-TH. NC2334.2 +084000 GO TO END-SEARCH-TEST. NC2334.2 +084100 NC2334.2 +084200 MULT-SEARCH-7-FAIL-6. NC2334.2 +084300 MOVE L6-HOLD TO CORRECT-A. NC2334.2 +084400 IF ENTRY-7-6 (2 1 2 1 2 1) = L6-HOLD NC2334.2 +084500 MOVE "X6" TO END-IDX NC2334.2 +084600 SET IDX-VALU TO X6 NC2334.2 +084700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +084800 MOVE END-STMT TO COMPUTED-A NC2334.2 +084900 ELSE NC2334.2 +085000 MOVE ENTRY-7-6 (2 1 2 1 2 1) TO COMPUTED-A NC2334.2 +085100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +085200 NC2334.2 +085300 PERFORM FAIL-TH. NC2334.2 +085400 GO TO END-SEARCH-TEST. NC2334.2 +085500 NC2334.2 +085600 MULT-SEARCH-7-FAIL-7. NC2334.2 +085700 MOVE L7-HOLD TO CORRECT-A. NC2334.2 +085800 IF ENTRY-7-7 (2 1 2 1 2 1 2) = L6-HOLD NC2334.2 +085900 MOVE "X7" TO END-IDX NC2334.2 +086000 SET IDX-VALU TO X7 NC2334.2 +086100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2334.2 +086200 MOVE END-STMT TO COMPUTED-A NC2334.2 +086300 ELSE NC2334.2 +086400 MOVE ENTRY-7-7 (2 1 2 1 2 1 2) TO COMPUTED-A NC2334.2 +086500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2334.2 +086600 NC2334.2 +086700 PERFORM FAIL-TH. NC2334.2 +086800 NC2334.2 +086900 GO TO END-SEARCH-TEST. NC2334.2 +087000 NC2334.2 +087100 PASS-TH. NC2334.2 +087200 PERFORM PASS. NC2334.2 +087300 PERFORM PRINT-DETAIL. NC2334.2 +087400 FAIL-TH. NC2334.2 +087500 PERFORM FAIL. NC2334.2 +087600 PERFORM PRINT-DETAIL. NC2334.2 +087700 END-SEARCH-TEST. NC2334.2 +087800 EXIT. NC2334.2 +087900 CCVS-EXIT SECTION. NC2334.2 +088000 CCVS-999999. NC2334.2 +088100 GO TO CLOSE-FILES. NC2334.2 diff --git a/tests/cobol85/NC/NC234A.CBL b/tests/cobol85/NC/NC234A.CBL new file mode 100755 index 00000000..d0c70606 --- /dev/null +++ b/tests/cobol85/NC/NC234A.CBL @@ -0,0 +1,922 @@ +000100 IDENTIFICATION DIVISION. NC2344.2 +000200 PROGRAM-ID. NC2344.2 +000300 NC234A. NC2344.2 +000400 NC2344.2 +000500**************************************************************** NC2344.2 +000600* * NC2344.2 +000700* VALIDATION FOR:- * NC2344.2 +000800* * NC2344.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2344.2 +001000* * NC2344.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2344.2 +001200* * NC2344.2 +001300**************************************************************** NC2344.2 +001400* * NC2344.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2344.2 +001600* * NC2344.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2344.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2344.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2344.2 +002000* * NC2344.2 +002100**************************************************************** NC2344.2 +002200* NC2344.2 +002300* PROGRAM NC234A TESTS THE ACCESSING OF A "REDEFINED" THREE * NC2344.2 +002400* -DIMENSIONAL TABLE USING FORMAT 1 OF THE "SEARCH" * NC2344.2 +002500* STATEMENT. THE "VARYING" AND "AT END" PHRASES ARE USED. * NC2344.2 +002600* * NC2344.2 +002700**************************************************************** NC2344.2 +002800 ENVIRONMENT DIVISION. NC2344.2 +002900 CONFIGURATION SECTION. NC2344.2 +003000 SOURCE-COMPUTER. NC2344.2 +003100 Linux. NC2344.2 +003200 OBJECT-COMPUTER. NC2344.2 +003300 Linux. NC2344.2 +003400 INPUT-OUTPUT SECTION. NC2344.2 +003500 FILE-CONTROL. NC2344.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2344.2 +003700 "report.log". NC2344.2 +003800 DATA DIVISION. NC2344.2 +003900 FILE SECTION. NC2344.2 +004000 FD PRINT-FILE. NC2344.2 +004100 01 PRINT-REC PICTURE X(120). NC2344.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2344.2 +004300 WORKING-STORAGE SECTION. NC2344.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2344.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2344.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2344.2 +004700 77 CON-5 PICTURE 99 VALUE 05. NC2344.2 +004800 77 CON-6 PICTURE 99 VALUE 06. NC2344.2 +004900 77 CON-7 PICTURE 99 VALUE 07. NC2344.2 +005000 77 CON-10 PICTURE 99 VALUE 10. NC2344.2 +005100 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2344.2 +005200 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2344.2 +005300 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2344.2 +005400 01 GRP-NAME. NC2344.2 +005500 02 FILLER PICTURE XXX VALUE "GRP". NC2344.2 +005600 02 ADD-GRP PICTURE 99 VALUE 01. NC2344.2 +005700 NC2344.2 +005800 01 SEC-NAME. NC2344.2 +005900 02 FILLER PICTURE X(5) VALUE "SEC (". NC2344.2 +006000 02 SEC-GRP PICTURE 99 VALUE 00. NC2344.2 +006100 02 FILLER PICTURE X VALUE ",". NC2344.2 +006200 02 ADD-SEC PICTURE 99 VALUE 01. NC2344.2 +006300 02 FILLER PICTURE X VALUE ")". NC2344.2 +006400 NC2344.2 +006500 01 ELEM-NAME. NC2344.2 +006600 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2344.2 +006700 02 ELEM-GRP PICTURE 99 VALUE 00. NC2344.2 +006800 02 FILLER PICTURE X VALUE ",". NC2344.2 +006900 02 ELEM-SEC PICTURE 99 VALUE 00. NC2344.2 +007000 02 FILLER PICTURE X VALUE ",". NC2344.2 +007100 02 ADD-ELEM PICTURE 99 VALUE 01. NC2344.2 +007200 02 FILLER PICTURE X VALUE ")". NC2344.2 +007300 NC2344.2 +007400 01 3-DIMENSION-TBL. NC2344.2 +007500 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2344.2 +007600 03 ENTRY-1 PICTURE X(5). NC2344.2 +007700 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2344.2 +007800 04 ENTRY-2 PICTURE X(11). NC2344.2 +007900 04 3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2344.2 +008000 05 ENTRY-3 PICTURE X(15). NC2344.2 +008100 01 3-DEM-TBL REDEFINES 3-DIMENSION-TBL. NC2344.2 +008200 02 GRP-ENTRY-1 OCCURS 10 TIMES INDEXED BY IDX-1-1. NC2344.2 +008300 03 ENTRY-1-1 PIC X(5). NC2344.2 +008400 03 GRP2-ENTRY-1 OCCURS 10 TIMES INDEXED BY IDX-2-1. NC2344.2 +008500 04 ENTRY-2-1 PIC X(11). NC2344.2 +008600 04 GRP3-ENTRY-1 OCCURS 10 TIMES INDEXED BY IDX-3-1. NC2344.2 +008700 05 ENTRY-3-1 PIC X(15). NC2344.2 +008800 NC2344.2 +008900 01 END-STMT. NC2344.2 +009000 02 FILLER PICTURE X(7) VALUE "AT END ". NC2344.2 +009100 02 END-IDX PICTURE X(7) VALUE SPACES. NC2344.2 +009200 02 FILLER PICTURE XXX VALUE " = ". NC2344.2 +009300 02 IDX-VALU PICTURE 99 VALUE 00. NC2344.2 +009400 02 FILLER PICTURE XXX VALUE SPACES. NC2344.2 +009500 01 NOTE-1. NC2344.2 +009600 02 FILLER PICTURE X(74) VALUE NC2344.2 +009700 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2344.2 +009800- "PATH WAS TAKEN". NC2344.2 +009900 02 FILLER PICTURE X(46) VALUE SPACES. NC2344.2 +010000 01 NOTE-2. NC2344.2 +010100 02 FILLER PICTURE X(112) VALUE NC2344.2 +010200 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2344.2 +010300- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2344.2 +010400 02 FILLER PICTURE X(8) VALUE SPACES. NC2344.2 +010500 01 TEST-RESULTS. NC2344.2 +010600 02 FILLER PIC X VALUE SPACE. NC2344.2 +010700 02 FEATURE PIC X(20) VALUE SPACE. NC2344.2 +010800 02 FILLER PIC X VALUE SPACE. NC2344.2 +010900 02 P-OR-F PIC X(5) VALUE SPACE. NC2344.2 +011000 02 FILLER PIC X VALUE SPACE. NC2344.2 +011100 02 PAR-NAME. NC2344.2 +011200 03 FILLER PIC X(19) VALUE SPACE. NC2344.2 +011300 03 PARDOT-X PIC X VALUE SPACE. NC2344.2 +011400 03 DOTVALUE PIC 99 VALUE ZERO. NC2344.2 +011500 02 FILLER PIC X(8) VALUE SPACE. NC2344.2 +011600 02 RE-MARK PIC X(61). NC2344.2 +011700 01 TEST-COMPUTED. NC2344.2 +011800 02 FILLER PIC X(30) VALUE SPACE. NC2344.2 +011900 02 FILLER PIC X(17) VALUE NC2344.2 +012000 " COMPUTED=". NC2344.2 +012100 02 COMPUTED-X. NC2344.2 +012200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2344.2 +012300 03 COMPUTED-N REDEFINES COMPUTED-A NC2344.2 +012400 PIC -9(9).9(9). NC2344.2 +012500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2344.2 +012600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2344.2 +012700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2344.2 +012800 03 CM-18V0 REDEFINES COMPUTED-A. NC2344.2 +012900 04 COMPUTED-18V0 PIC -9(18). NC2344.2 +013000 04 FILLER PIC X. NC2344.2 +013100 03 FILLER PIC X(50) VALUE SPACE. NC2344.2 +013200 01 TEST-CORRECT. NC2344.2 +013300 02 FILLER PIC X(30) VALUE SPACE. NC2344.2 +013400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2344.2 +013500 02 CORRECT-X. NC2344.2 +013600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2344.2 +013700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2344.2 +013800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2344.2 +013900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2344.2 +014000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2344.2 +014100 03 CR-18V0 REDEFINES CORRECT-A. NC2344.2 +014200 04 CORRECT-18V0 PIC -9(18). NC2344.2 +014300 04 FILLER PIC X. NC2344.2 +014400 03 FILLER PIC X(2) VALUE SPACE. NC2344.2 +014500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2344.2 +014600 01 CCVS-C-1. NC2344.2 +014700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2344.2 +014800- "SS PARAGRAPH-NAME NC2344.2 +014900- " REMARKS". NC2344.2 +015000 02 FILLER PIC X(20) VALUE SPACE. NC2344.2 +015100 01 CCVS-C-2. NC2344.2 +015200 02 FILLER PIC X VALUE SPACE. NC2344.2 +015300 02 FILLER PIC X(6) VALUE "TESTED". NC2344.2 +015400 02 FILLER PIC X(15) VALUE SPACE. NC2344.2 +015500 02 FILLER PIC X(4) VALUE "FAIL". NC2344.2 +015600 02 FILLER PIC X(94) VALUE SPACE. NC2344.2 +015700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2344.2 +015800 01 REC-CT PIC 99 VALUE ZERO. NC2344.2 +015900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2344.2 +016000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2344.2 +016100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2344.2 +016200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2344.2 +016300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2344.2 +016400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2344.2 +016500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2344.2 +016600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2344.2 +016700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2344.2 +016800 01 CCVS-H-1. NC2344.2 +016900 02 FILLER PIC X(39) VALUE SPACES. NC2344.2 +017000 02 FILLER PIC X(42) VALUE NC2344.2 +017100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2344.2 +017200 02 FILLER PIC X(39) VALUE SPACES. NC2344.2 +017300 01 CCVS-H-2A. NC2344.2 +017400 02 FILLER PIC X(40) VALUE SPACE. NC2344.2 +017500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2344.2 +017600 02 FILLER PIC XXXX VALUE NC2344.2 +017700 "4.2 ". NC2344.2 +017800 02 FILLER PIC X(28) VALUE NC2344.2 +017900 " COPY - NOT FOR DISTRIBUTION". NC2344.2 +018000 02 FILLER PIC X(41) VALUE SPACE. NC2344.2 +018100 NC2344.2 +018200 01 CCVS-H-2B. NC2344.2 +018300 02 FILLER PIC X(15) VALUE NC2344.2 +018400 "TEST RESULT OF ". NC2344.2 +018500 02 TEST-ID PIC X(9). NC2344.2 +018600 02 FILLER PIC X(4) VALUE NC2344.2 +018700 " IN ". NC2344.2 +018800 02 FILLER PIC X(12) VALUE NC2344.2 +018900 " HIGH ". NC2344.2 +019000 02 FILLER PIC X(22) VALUE NC2344.2 +019100 " LEVEL VALIDATION FOR ". NC2344.2 +019200 02 FILLER PIC X(58) VALUE NC2344.2 +019300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2344.2 +019400 01 CCVS-H-3. NC2344.2 +019500 02 FILLER PIC X(34) VALUE NC2344.2 +019600 " FOR OFFICIAL USE ONLY ". NC2344.2 +019700 02 FILLER PIC X(58) VALUE NC2344.2 +019800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2344.2 +019900 02 FILLER PIC X(28) VALUE NC2344.2 +020000 " COPYRIGHT 1985 ". NC2344.2 +020100 01 CCVS-E-1. NC2344.2 +020200 02 FILLER PIC X(52) VALUE SPACE. NC2344.2 +020300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2344.2 +020400 02 ID-AGAIN PIC X(9). NC2344.2 +020500 02 FILLER PIC X(45) VALUE SPACES. NC2344.2 +020600 01 CCVS-E-2. NC2344.2 +020700 02 FILLER PIC X(31) VALUE SPACE. NC2344.2 +020800 02 FILLER PIC X(21) VALUE SPACE. NC2344.2 +020900 02 CCVS-E-2-2. NC2344.2 +021000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2344.2 +021100 03 FILLER PIC X VALUE SPACE. NC2344.2 +021200 03 ENDER-DESC PIC X(44) VALUE NC2344.2 +021300 "ERRORS ENCOUNTERED". NC2344.2 +021400 01 CCVS-E-3. NC2344.2 +021500 02 FILLER PIC X(22) VALUE NC2344.2 +021600 " FOR OFFICIAL USE ONLY". NC2344.2 +021700 02 FILLER PIC X(12) VALUE SPACE. NC2344.2 +021800 02 FILLER PIC X(58) VALUE NC2344.2 +021900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2344.2 +022000 02 FILLER PIC X(13) VALUE SPACE. NC2344.2 +022100 02 FILLER PIC X(15) VALUE NC2344.2 +022200 " COPYRIGHT 1985". NC2344.2 +022300 01 CCVS-E-4. NC2344.2 +022400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2344.2 +022500 02 FILLER PIC X(4) VALUE " OF ". NC2344.2 +022600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2344.2 +022700 02 FILLER PIC X(40) VALUE NC2344.2 +022800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2344.2 +022900 01 XXINFO. NC2344.2 +023000 02 FILLER PIC X(19) VALUE NC2344.2 +023100 "*** INFORMATION ***". NC2344.2 +023200 02 INFO-TEXT. NC2344.2 +023300 04 FILLER PIC X(8) VALUE SPACE. NC2344.2 +023400 04 XXCOMPUTED PIC X(20). NC2344.2 +023500 04 FILLER PIC X(5) VALUE SPACE. NC2344.2 +023600 04 XXCORRECT PIC X(20). NC2344.2 +023700 02 INF-ANSI-REFERENCE PIC X(48). NC2344.2 +023800 01 HYPHEN-LINE. NC2344.2 +023900 02 FILLER PIC IS X VALUE IS SPACE. NC2344.2 +024000 02 FILLER PIC IS X(65) VALUE IS "************************NC2344.2 +024100- "*****************************************". NC2344.2 +024200 02 FILLER PIC IS X(54) VALUE IS "************************NC2344.2 +024300- "******************************". NC2344.2 +024400 01 CCVS-PGM-ID PIC X(9) VALUE NC2344.2 +024500 "NC234A". NC2344.2 +024600 PROCEDURE DIVISION. NC2344.2 +024700 CCVS1 SECTION. NC2344.2 +024800 OPEN-FILES. NC2344.2 +024900 OPEN OUTPUT PRINT-FILE. NC2344.2 +025000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2344.2 +025100 MOVE SPACE TO TEST-RESULTS. NC2344.2 +025200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2344.2 +025300 GO TO CCVS1-EXIT. NC2344.2 +025400 CLOSE-FILES. NC2344.2 +025500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2344.2 +025600 TERMINATE-CCVS. NC2344.2 +025700*S EXIT PROGRAM. NC2344.2 +025800*SERMINATE-CALL. NC2344.2 +025900 STOP RUN. NC2344.2 +026000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2344.2 +026100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2344.2 +026200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2344.2 +026300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2344.2 +026400 MOVE "****TEST DELETED****" TO RE-MARK. NC2344.2 +026500 PRINT-DETAIL. NC2344.2 +026600 IF REC-CT NOT EQUAL TO ZERO NC2344.2 +026700 MOVE "." TO PARDOT-X NC2344.2 +026800 MOVE REC-CT TO DOTVALUE. NC2344.2 +026900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2344.2 +027000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2344.2 +027100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2344.2 +027200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2344.2 +027300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2344.2 +027400 MOVE SPACE TO CORRECT-X. NC2344.2 +027500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2344.2 +027600 MOVE SPACE TO RE-MARK. NC2344.2 +027700 HEAD-ROUTINE. NC2344.2 +027800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +027900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +028000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2344.2 +028100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2344.2 +028200 COLUMN-NAMES-ROUTINE. NC2344.2 +028300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +028400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +028600 END-ROUTINE. NC2344.2 +028700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2344.2 +028800 END-RTN-EXIT. NC2344.2 +028900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +029000 END-ROUTINE-1. NC2344.2 +029100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2344.2 +029200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2344.2 +029300 ADD PASS-COUNTER TO ERROR-HOLD. NC2344.2 +029400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2344.2 +029500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2344.2 +029600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2344.2 +029700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2344.2 +029800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2344.2 +029900 END-ROUTINE-12. NC2344.2 +030000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2344.2 +030100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2344.2 +030200 MOVE "NO " TO ERROR-TOTAL NC2344.2 +030300 ELSE NC2344.2 +030400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2344.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2344.2 +030600 PERFORM WRITE-LINE. NC2344.2 +030700 END-ROUTINE-13. NC2344.2 +030800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2344.2 +030900 MOVE "NO " TO ERROR-TOTAL ELSE NC2344.2 +031000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2344.2 +031100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2344.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +031300 IF INSPECT-COUNTER EQUAL TO ZERO NC2344.2 +031400 MOVE "NO " TO ERROR-TOTAL NC2344.2 +031500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2344.2 +031600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2344.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +031800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2344.2 +031900 WRITE-LINE. NC2344.2 +032000 ADD 1 TO RECORD-COUNT. NC2344.2 +032100 IF RECORD-COUNT GREATER 50 NC2344.2 +032200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2344.2 +032300 MOVE SPACE TO DUMMY-RECORD NC2344.2 +032400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2344.2 +032500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2344.2 +032600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2344.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2344.2 +032800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2344.2 +032900 MOVE ZERO TO RECORD-COUNT. NC2344.2 +033000 PERFORM WRT-LN. NC2344.2 +033100 WRT-LN. NC2344.2 +033200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2344.2 +033300 MOVE SPACE TO DUMMY-RECORD. NC2344.2 +033400 BLANK-LINE-PRINT. NC2344.2 +033500 PERFORM WRT-LN. NC2344.2 +033600 FAIL-ROUTINE. NC2344.2 +033700 IF COMPUTED-X NOT EQUAL TO SPACE NC2344.2 +033800 GO TO FAIL-ROUTINE-WRITE. NC2344.2 +033900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2344.2 +034000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2344.2 +034100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2344.2 +034200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +034300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2344.2 +034400 GO TO FAIL-ROUTINE-EX. NC2344.2 +034500 FAIL-ROUTINE-WRITE. NC2344.2 +034600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2344.2 +034700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2344.2 +034800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2344.2 +034900 MOVE SPACES TO COR-ANSI-REFERENCE. NC2344.2 +035000 FAIL-ROUTINE-EX. EXIT. NC2344.2 +035100 BAIL-OUT. NC2344.2 +035200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2344.2 +035300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2344.2 +035400 BAIL-OUT-WRITE. NC2344.2 +035500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2344.2 +035600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2344.2 +035700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2344.2 +035800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2344.2 +035900 BAIL-OUT-EX. EXIT. NC2344.2 +036000 CCVS1-EXIT. NC2344.2 +036100 EXIT. NC2344.2 +036200 SECT-NC234A-001 SECTION. NC2344.2 +036300 TH-07-001. NC2344.2 +036400 INITIALISE-TABLE. NC2344.2 +036500 PERFORM BUILD-TABLE VARYING SUB-1 FROM 1 BY 1 NC2344.2 +036600 UNTIL SUB-1 EQUAL TO 11 NC2344.2 +036700 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2344.2 +036800 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11 NC2344.2 +036900 GO TO CHECK-ENTRIES. NC2344.2 +037000 NC2344.2 +037100 BUILD-TABLE. NC2344.2 +037200 SET IDX-1 TO SUB-1. NC2344.2 +037300 SET IDX-2 TO SUB-2. NC2344.2 +037400 SET IDX-3 TO SUB-3. NC2344.2 +037500 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2344.2 +037600 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2344.2 +037700 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2344.2 +037800 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2344.2 +037900 SET ADD-ELEM TO IDX-3. NC2344.2 +038000 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2344.2 +038100* NC2344.2 +038200 CHECK-ENTRIES. NC2344.2 +038300 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2344.2 +038400 MOVE "CHECK-ENTRIES" TO PAR-NAME. NC2344.2 +038500 MOVE "GRP02" TO GRP-HOLD-AREA. NC2344.2 +038600 MOVE 02 TO SUB-2. NC2344.2 +038700 SET IDX-1 TO 1. NC2344.2 +038800 SEARCH GRP-ENTRY VARYING IDX-1 NC2344.2 +038900 AT END NC2344.2 +039000 GO TO CHECK-FAIL NC2344.2 +039100 WHEN ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2344.2 +039200 PERFORM PASS NC2344.2 +039300 GO TO CHECK-WRITE. NC2344.2 +039400 CHECK-DELETE. NC2344.2 +039500 PERFORM DE-LETE. NC2344.2 +039600 GO TO CHECK-WRITE. NC2344.2 +039700 CHECK-FAIL. NC2344.2 +039800 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2344.2 +039900 IF ENTRY-1 (SUB-2) EQUAL TO GRP-HOLD-AREA NC2344.2 +040000 MOVE "IDX-1" TO END-IDX NC2344.2 +040100 SET IDX-VALU TO IDX-1 NC2344.2 +040200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +040300 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +040400 MOVE ENTRY-1 (SUB-2) TO COMPUTED-A NC2344.2 +040500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +040600 PERFORM FAIL. NC2344.2 +040700 CHECK-WRITE. NC2344.2 +040800 PERFORM PRINT-DETAIL. NC2344.2 +040900* NC2344.2 +041000 TH1-INIT-F1-2. NC2344.2 +041100 MOVE "TH1-TEST-F1-2" TO PAR-NAME. NC2344.2 +041200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +041300 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2344.2 +041400 MOVE "GRP01" TO GRP-HOLD-AREA. NC2344.2 +041500 MOVE 01 TO SUB-2. NC2344.2 +041600 SET IDX-1-1 TO 1. NC2344.2 +041700 TH1-TEST-F1-2. NC2344.2 +041800 SEARCH GRP-ENTRY-1 VARYING IDX-1 NC2344.2 +041900 AT END GO TO TH1-FAIL-F1-2 NC2344.2 +042000 WHEN ENTRY-1-1 (IDX-1-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2344.2 +042100 PERFORM PASS NC2344.2 +042200 GO TO TH1-WRITE-F1-2. NC2344.2 +042300 TH1-DELETE-F1-2. NC2344.2 +042400 PERFORM DE-LETE. NC2344.2 +042500 GO TO TH1-WRITE-F1-2. NC2344.2 +042600 TH1-FAIL-F1-2. NC2344.2 +042700 PERFORM CHECK-FAIL. NC2344.2 +042800 TH1-WRITE-F1-2. NC2344.2 +042900 PERFORM PRINT-DETAIL. NC2344.2 +043000* NC2344.2 +043100 TH1-INIT-F1-3. NC2344.2 +043200 MOVE "TH1-TEST-F1-3" TO PAR-NAME. NC2344.2 +043300 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +043400 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2344.2 +043500 MOVE "GRP10" TO GRP-HOLD-AREA. NC2344.2 +043600 MOVE 10 TO SUB-2. NC2344.2 +043700 SET IDX-1-1 TO 1. NC2344.2 +043800 TH1-TEST-F1-3. NC2344.2 +043900 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +044000 AT END GO TO TH1-FAIL-F1-3 NC2344.2 +044100 WHEN ENTRY-1-1 (IDX-1-1) = GRP-HOLD-AREA NEXT SENTENCE. NC2344.2 +044200 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +044300 PERFORM PASS NC2344.2 +044400 GO TO TH1-WRITE-F1-3. NC2344.2 +044500 TH1-DELETE-F1-3. NC2344.2 +044600 PERFORM DE-LETE. NC2344.2 +044700 GO TO TH1-WRITE-F1-3. NC2344.2 +044800 TH1-FAIL-F1-3. NC2344.2 +044900 PERFORM CHECK-FAIL. NC2344.2 +045000 TH1-WRITE-F1-3. NC2344.2 +045100 PERFORM PRINT-DETAIL. NC2344.2 +045200* NC2344.2 +045300 TH1-INIT-F1-4. NC2344.2 +045400 MOVE "TH1-TEST-F1-4" TO PAR-NAME. NC2344.2 +045500 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +045600 MOVE "SEARCH VARYING LEV 1" TO FEATURE. NC2344.2 +045700 MOVE "GRP05" TO GRP-HOLD-AREA. NC2344.2 +045800 MOVE 05 TO SUB-2. NC2344.2 +045900 SET IDX-1-1 TO 05. NC2344.2 +046000 TH1-TEST-F1-4. NC2344.2 +046100 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +046200 WHEN ENTRY-1-1 (IDX-1-1) = GRP-HOLD-AREA NC2344.2 +046300 PERFORM PASS NC2344.2 +046400 GO TO TH1-WRITE-F1-4. NC2344.2 +046500 GO TO TH1-FAIL-F1-4. NC2344.2 +046600 TH1-DELETE-F1-4. NC2344.2 +046700 PERFORM DE-LETE. NC2344.2 +046800 GO TO TH1-WRITE-F1-4. NC2344.2 +046900 TH1-FAIL-F1-4. NC2344.2 +047000 PERFORM CHECK-FAIL. NC2344.2 +047100 TH1-WRITE-F1-4. NC2344.2 +047200 PERFORM PRINT-DETAIL. NC2344.2 +047300* NC2344.2 +047400 TH2-INIT-F1-1. NC2344.2 +047500 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +047600 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +047700 MOVE "TH2-TEST-F1-1" TO PAR-NAME. NC2344.2 +047800 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2344.2 +047900 MOVE 1 TO SUB-1 SUB-2. NC2344.2 +048000 SET IDX-1-1 IDX-2-1 TO 1. NC2344.2 +048100 TH2-TEST-F1-1. NC2344.2 +048200 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 AT END NC2344.2 +048300 GO TO TH2-FAIL-F1-1 NC2344.2 +048400 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +048500 NEXT SENTENCE. NC2344.2 +048600 PERFORM PASS NC2344.2 +048700 GO TO TH2-WRITE-F1-1. NC2344.2 +048800 TH2-DELETE-F1-1. NC2344.2 +048900 PERFORM DE-LETE. NC2344.2 +049000 GO TO TH2-WRITE-F1-1. NC2344.2 +049100 TH2-FAIL-F1-1. NC2344.2 +049200 PERFORM CHECK-FAIL2. NC2344.2 +049300 TH2-WRITE-F1-1. NC2344.2 +049400 PERFORM PRINT-DETAIL. NC2344.2 +049500 NC2344.2 +049600* NC2344.2 +049700 TH2-INIT-F1-2. NC2344.2 +049800 MOVE "TH2-TEST-F1-2" TO PAR-NAME. NC2344.2 +049900 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +050000 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +050100 MOVE "SEC (05,10)" TO SEC-HOLD-AREA. NC2344.2 +050200 MOVE 05 TO SUB-1. NC2344.2 +050300 MOVE 10 TO SUB-2. NC2344.2 +050400 SET IDX-1-1 TO 5. NC2344.2 +050500 SET IDX-2-1 TO 1. NC2344.2 +050600 TH2-TEST-F1-2. NC2344.2 +050700 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 AT END NC2344.2 +050800 GO TO TH2-FAIL-F1-2 NC2344.2 +050900 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +051000 NEXT SENTENCE. NC2344.2 +051100 PERFORM PASS NC2344.2 +051200 GO TO TH2-WRITE-F1-2. NC2344.2 +051300 TH2-DELETE-F1-2. NC2344.2 +051400 PERFORM DE-LETE. NC2344.2 +051500 GO TO TH2-WRITE-F1-2. NC2344.2 +051600 TH2-FAIL-F1-2. NC2344.2 +051700 PERFORM CHECK-FAIL2. NC2344.2 +051800 TH2-WRITE-F1-2. NC2344.2 +051900 PERFORM PRINT-DETAIL. NC2344.2 +052000* NC2344.2 +052100 TH2-INIT-F1-3. NC2344.2 +052200 MOVE "TH2-TEST-F1-3" TO PAR-NAME. NC2344.2 +052300 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +052400 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +052500 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2344.2 +052600 SET IDX-1-1 TO 10. NC2344.2 +052700 SET IDX-2-1 TO 1. NC2344.2 +052800 MOVE 10 TO SUB-1 SUB-2. NC2344.2 +052900 TH2-TEST-F1-3. NC2344.2 +053000 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 AT END NC2344.2 +053100 GO TO TH2-FAIL-F1-3 NC2344.2 +053200 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +053300 NEXT SENTENCE. NC2344.2 +053400 PERFORM PASS NC2344.2 +053500 GO TO TH2-WRITE-F1-3. NC2344.2 +053600 TH2-DELETE-F1-3. NC2344.2 +053700 PERFORM DE-LETE. NC2344.2 +053800 GO TO TH2-WRITE-F1-3. NC2344.2 +053900 TH2-FAIL-F1-3. NC2344.2 +054000 PERFORM CHECK-FAIL2. NC2344.2 +054100 TH2-WRITE-F1-3. NC2344.2 +054200 PERFORM PRINT-DETAIL. NC2344.2 +054300* NC2344.2 +054400 TH2-INIT-F1-4. NC2344.2 +054500 MOVE "TH2-TEST-F1-4" TO PAR-NAME. NC2344.2 +054600 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +054700 MOVE "SEARCH VARYING LEV 2" TO FEATURE. NC2344.2 +054800 MOVE "SEC (08,02)" TO SEC-HOLD-AREA. NC2344.2 +054900 MOVE 08 TO SUB-1. NC2344.2 +055000 MOVE 02 TO SUB-2. NC2344.2 +055100 SET IDX-1-1 TO 08. NC2344.2 +055200 SET IDX-2-1 TO 01. NC2344.2 +055300 TH2-TEST-F1-4. NC2344.2 +055400 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 NC2344.2 +055500 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +055600 PERFORM PASS NC2344.2 +055700 GO TO TH2-WRITE-F1-4. NC2344.2 +055800 GO TO TH2-FAIL-F1-4. NC2344.2 +055900 TH2-DELETE-F1-4. NC2344.2 +056000 PERFORM DE-LETE. NC2344.2 +056100 GO TO TH2-WRITE-F1-4. NC2344.2 +056200 TH2-FAIL-F1-4. NC2344.2 +056300 PERFORM CHECK-FAIL2. NC2344.2 +056400 TH2-WRITE-F1-4. NC2344.2 +056500 PERFORM PRINT-DETAIL. NC2344.2 +056600 GO TO TH3-INIT-F1-1. NC2344.2 +056700 NC2344.2 +056800 CHECK-FAIL2. NC2344.2 +056900 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2344.2 +057000 IF ENTRY-2-1 (SUB-1, SUB-2) EQUAL TO SEC-HOLD-AREA NC2344.2 +057100 MOVE "IDX-2" TO END-IDX NC2344.2 +057200 SET IDX-VALU TO IDX-2 NC2344.2 +057300 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +057400 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +057500 MOVE ENTRY-2-1 (SUB-1, SUB-2) TO COMPUTED-A NC2344.2 +057600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +057700 PERFORM FAIL. NC2344.2 +057800* NC2344.2 +057900 TH3-INIT-F1-1. NC2344.2 +058000 MOVE "TH3-TEST-F1-1" TO PAR-NAME. NC2344.2 +058100 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +058200 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2344.2 +058300 MOVE 1 TO SUB-1 SUB-2 SUB-3. NC2344.2 +058400 MOVE "ELEM (01,01,01)" TO ELEM-HOLD-AREA. NC2344.2 +058500 SET IDX-1-1 IDX-2-1 IDX-3-1 TO 1. NC2344.2 +058600 TH3-TEST-F1-1. NC2344.2 +058700 SEARCH GRP3-ENTRY-1 VARYING IDX-3 NC2344.2 +058800 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +058900 = ELEM-HOLD-AREA NC2344.2 +059000 PERFORM PASS NC2344.2 +059100 GO TO TH3-WRITE-F1-1. NC2344.2 +059200 GO TO TH3-FAIL-F1-1. NC2344.2 +059300 TH3-DELETE-F1-1. NC2344.2 +059400 PERFORM DE-LETE. NC2344.2 +059500 GO TO TH3-WRITE-F1-1. NC2344.2 +059600 TH3-FAIL-F1-1. NC2344.2 +059700 PERFORM CHECK-FAIL3. NC2344.2 +059800 TH3-WRITE-F1-1. NC2344.2 +059900 PERFORM PRINT-DETAIL. NC2344.2 +060000* NC2344.2 +060100 TH3-INIT-F1-2. NC2344.2 +060200 MOVE "TH3-TEST-F1-2" TO PAR-NAME. NC2344.2 +060300 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +060400 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2344.2 +060500 MOVE 05 TO SUB-1. NC2344.2 +060600 MOVE 06 TO SUB-2. NC2344.2 +060700 MOVE 07 TO SUB-3. NC2344.2 +060800 SET IDX-1-1 TO 05. NC2344.2 +060900 SET IDX-2-1 TO 06. NC2344.2 +061000 SET IDX-3-1 TO 1. NC2344.2 +061100 MOVE "ELEM (05,06,07)" TO ELEM-HOLD-AREA. NC2344.2 +061200 TH3-TEST-F1-2. NC2344.2 +061300 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 AT END NC2344.2 +061400 GO TO TH3-FAIL-F1-2 NC2344.2 +061500 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +061600 = ELEM-HOLD-AREA NC2344.2 +061700 NEXT SENTENCE. NC2344.2 +061800 PERFORM PASS NC2344.2 +061900 GO TO TH3-WRITE-F1-2. NC2344.2 +062000 TH3-DELETE-F1-2. NC2344.2 +062100 PERFORM DE-LETE. NC2344.2 +062200 GO TO TH3-WRITE-F1-2. NC2344.2 +062300 TH3-FAIL-F1-2. NC2344.2 +062400 PERFORM CHECK-FAIL3. NC2344.2 +062500 TH3-WRITE-F1-2. NC2344.2 +062600 PERFORM PRINT-DETAIL. NC2344.2 +062700* NC2344.2 +062800 TH3-INIT-F1-3. NC2344.2 +062900 MOVE "TH3-TEST-F1-3" TO PAR-NAME. NC2344.2 +063000 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +063100 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2344.2 +063200 MOVE 10 TO SUB-1 SUB-2 SUB-3. NC2344.2 +063300 SET IDX-1-1 IDX-2-1 TO 10. NC2344.2 +063400 SET IDX-3-1 TO 1. NC2344.2 +063500 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2344.2 +063600 TH3-TEST-F1-3. NC2344.2 +063700 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 AT END NC2344.2 +063800 GO TO TH3-FAIL-F1-3 NC2344.2 +063900 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +064000 = ELEM-HOLD-AREA NC2344.2 +064100 NEXT SENTENCE. NC2344.2 +064200 PERFORM PASS NC2344.2 +064300 GO TO TH3-WRITE-F1-3. NC2344.2 +064400 TH3-DELETE-F1-3. NC2344.2 +064500 PERFORM DE-LETE. NC2344.2 +064600 GO TO TH3-WRITE-F1-3. NC2344.2 +064700 TH3-FAIL-F1-3. NC2344.2 +064800 PERFORM CHECK-FAIL3. NC2344.2 +064900 TH3-WRITE-F1-3. NC2344.2 +065000 PERFORM PRINT-DETAIL. NC2344.2 +065100* NC2344.2 +065200 TH3-INIT-F1-4. NC2344.2 +065300 MOVE "TH3-TEST-F1-4" TO PAR-NAME. NC2344.2 +065400 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +065500 MOVE "SEARCH VARYING LEV 3" TO FEATURE. NC2344.2 +065600 MOVE "ELEM (07,06,05)" TO ELEM-HOLD-AREA. NC2344.2 +065700 MOVE 07 TO SUB-1. NC2344.2 +065800 MOVE 06 TO SUB-2. NC2344.2 +065900 MOVE 05 TO SUB-3. NC2344.2 +066000 SET IDX-1-1 TO 07. NC2344.2 +066100 SET IDX-2-1 TO 06. NC2344.2 +066200 SET IDX-3-1 TO 03. NC2344.2 +066300 TH3-TEST-F1-4. NC2344.2 +066400 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 AT END NC2344.2 +066500 GO TO TH3-FAIL-F1-4 NC2344.2 +066600 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +066700 = ELEM-HOLD-AREA NC2344.2 +066800 NEXT SENTENCE. NC2344.2 +066900 PERFORM PASS NC2344.2 +067000 GO TO TH3-WRITE-F1-4. NC2344.2 +067100 TH3-DELETE-F1-4. NC2344.2 +067200 PERFORM DE-LETE. NC2344.2 +067300 GO TO TH3-WRITE-F1-4. NC2344.2 +067400 TH3-FAIL-F1-4. NC2344.2 +067500 PERFORM CHECK-FAIL3. NC2344.2 +067600 TH3-WRITE-F1-4. NC2344.2 +067700 PERFORM PRINT-DETAIL. NC2344.2 +067800 GO TO MLT-INIT-F1-1. NC2344.2 +067900* NC2344.2 +068000 CHECK-FAIL3. NC2344.2 +068100 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2344.2 +068200 IF ENTRY-3-1 (SUB-1, SUB-2, SUB-3) EQUAL TO ELEM-HOLD-AREA NC2344.2 +068300 MOVE "IDX-3-1" TO END-IDX NC2344.2 +068400 SET IDX-VALU TO IDX-3-1 NC2344.2 +068500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +068600 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +068700 MOVE ENTRY-3-1 (SUB-1, SUB-2, SUB-3) TO COMPUTED-A NC2344.2 +068800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +068900 PERFORM FAIL. NC2344.2 +069000* NC2344.2 +069100 MLT-INIT-F1-1. NC2344.2 +069200 MOVE "MLT-TEST-F1-1 " TO PAR-NAME. NC2344.2 +069300 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +069400 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2344.2 +069500 MOVE "GRP08" TO GRP-HOLD-AREA. NC2344.2 +069600 MOVE "SEC (08,07)" TO SEC-HOLD-AREA. NC2344.2 +069700 SET IDX-1-1 IDX-2-1 TO 1. NC2344.2 +069800 MLT-TEST-F1-1. NC2344.2 +069900 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +070000 AT END GO TO MLT-FAIL-F1-1-A NC2344.2 +070100 WHEN ENTRY-1-1 (IDX-1-1) = "GRP08" NEXT SENTENCE. NC2344.2 +070200 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 NC2344.2 +070300 AT END GO TO MLT-FAIL-F1-1-B NC2344.2 +070400 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = SEC-HOLD-AREA NC2344.2 +070500 NEXT SENTENCE. NC2344.2 +070600 PERFORM PASS NC2344.2 +070700 GO TO MLT-WRITE-F1-1. NC2344.2 +070800 MLT-DELETE-F1-1. NC2344.2 +070900 PERFORM DE-LETE. NC2344.2 +071000 GO TO MLT-WRITE-F1-1. NC2344.2 +071100* NC2344.2 +071200 MLT-FAIL-F1-1-A. NC2344.2 +071300 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2344.2 +071400 IF ENTRY-1-1 (08) EQUAL TO GRP-HOLD-AREA NC2344.2 +071500 MOVE "IDX-1-1" TO END-IDX NC2344.2 +071600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +071700 SET IDX-VALU TO IDX-1-1 NC2344.2 +071800 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +071900 MOVE ENTRY-1-1 (08) TO COMPUTED-A NC2344.2 +072000 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +072100 PERFORM FAIL NC2344.2 +072200 GO TO MLT-WRITE-F1-1. NC2344.2 +072300* NC2344.2 +072400 MLT-FAIL-F1-1-B. NC2344.2 +072500 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2344.2 +072600 IF ENTRY-2-1 (08, 07) EQUAL TO SEC-HOLD-AREA NC2344.2 +072700 MOVE "IDX-2-1" TO END-IDX NC2344.2 +072800 SET IDX-VALU TO IDX-2-1 NC2344.2 +072900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +073000 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +073100 MOVE ENTRY-2-1 (08, 07) TO COMPUTED-A NC2344.2 +073200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +073300 PERFORM FAIL. NC2344.2 +073400 MLT-WRITE-F1-1. NC2344.2 +073500 PERFORM PRINT-DETAIL. NC2344.2 +073600* NC2344.2 +073700 MLT-INIT-F1-2. NC2344.2 +073800 MOVE "MLT-TEST-F1-2 " TO PAR-NAME. NC2344.2 +073900 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +074000 MOVE "MULTIPLE SEARCH STMT" TO FEATURE. NC2344.2 +074100 MOVE "GRP04" TO GRP-HOLD-AREA. NC2344.2 +074200 MOVE "SEC (04,04)" TO SEC-HOLD-AREA. NC2344.2 +074300 MOVE "ELEM (04,04,04)" TO ELEM-HOLD-AREA. NC2344.2 +074400 SET IDX-1-1 IDX-2-1 IDX-3-1 TO 1. NC2344.2 +074500 MLT-TEST-F1-2. NC2344.2 +074600 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 AT END NC2344.2 +074700 GO TO MLT-FAIL-F1-2-A WHEN ENTRY-1-1 (IDX-1-1) = NC2344.2 +074800 GRP-HOLD-AREA NEXT SENTENCE. NC2344.2 +074900 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 AT END NC2344.2 +075000 GO TO MLT-FAIL-F1-2-B WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) =NC2344.2 +075100 SEC-HOLD-AREA NEXT SENTENCE. NC2344.2 +075200 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 AT END NC2344.2 +075300 GO TO MLT-FAIL-F1-2-C WHEN ENTRY-3-1 NC2344.2 +075400 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +075500 = ELEM-HOLD-AREA NEXT SENTENCE. NC2344.2 +075600 PERFORM PASS NC2344.2 +075700 GO TO MLT-WRITE-F1-2. NC2344.2 +075800 MLT-DELETE-F1-2. NC2344.2 +075900 PERFORM DE-LETE NC2344.2 +076000 GO TO MLT-WRITE-F1-2. NC2344.2 +076100 MLT-FAIL-F1-2-A. NC2344.2 +076200 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2344.2 +076300 IF ENTRY-1-1 (04) EQUAL TO GRP-HOLD-AREA NC2344.2 +076400 MOVE "IDX-1-1" TO END-IDX NC2344.2 +076500 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +076600 SET IDX-VALU TO IDX-1-1 NC2344.2 +076700 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +076800 MOVE ENTRY-1-1 (04) TO COMPUTED-A NC2344.2 +076900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +077000 PERFORM FAIL. NC2344.2 +077100 GO TO MLT-WRITE-F1-2. NC2344.2 +077200 NC2344.2 +077300 MLT-FAIL-F1-2-B. NC2344.2 +077400 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2344.2 +077500 IF ENTRY-2-1 (04, 04) EQUAL TO SEC-HOLD-AREA NC2344.2 +077600 MOVE "IDX-2-1" TO END-IDX NC2344.2 +077700 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +077800 SET IDX-VALU TO IDX-2-1 NC2344.2 +077900 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +078000 MOVE ENTRY-2-1 (04, 04) TO COMPUTED-A NC2344.2 +078100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +078200 PERFORM FAIL NC2344.2 +078300 GO TO MLT-WRITE-F1-2. NC2344.2 +078400 NC2344.2 +078500 MLT-FAIL-F1-2-C. NC2344.2 +078600 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2344.2 +078700 IF ENTRY-3-1 (04, 04, 04) EQUAL TO ELEM-HOLD-AREA NC2344.2 +078800 MOVE "IDX-3-1" TO END-IDX NC2344.2 +078900 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +079000 SET IDX-VALU TO IDX-3-1 NC2344.2 +079100 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +079200 MOVE ENTRY-3-1 (04, 04, 04) TO COMPUTED-A NC2344.2 +079300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +079400 PERFORM FAIL. NC2344.2 +079500 MLT-WRITE-F1-2. NC2344.2 +079600 PERFORM PRINT-DETAIL. NC2344.2 +079700* NC2344.2 +079800 SPC-INIT-F1-1. NC2344.2 +079900 MOVE "SPC-TEST-F1-1" TO PAR-NAME. NC2344.2 +080000 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +080100 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2344.2 +080200 SET IDX-1-1 TO 4. NC2344.2 +080300 SPC-TEST-F1-1. NC2344.2 +080400 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +080500 AT END PERFORM PASS NC2344.2 +080600 GO TO SPC-WRITE-F1-1 NC2344.2 +080700 WHEN ENTRY-1-1 (IDX-1-1) = "GRP03" NC2344.2 +080800 GO TO SPC-FAIL-F1-1. NC2344.2 +080900 SPC-DELETE-F1-1. NC2344.2 +081000 PERFORM DE-LETE. NC2344.2 +081100 GO TO SPC-WRITE-F1-1. NC2344.2 +081200 SPC-FAIL-F1-1. NC2344.2 +081300 MOVE SPACES TO CORRECT-A. NC2344.2 +081400 MOVE ENTRY-1-1 (03) TO COMPUTED-A. NC2344.2 +081500 MOVE SPACES TO RE-MARK. NC2344.2 +081600 PERFORM FAIL. NC2344.2 +081700 SPC-WRITE-F1-1. NC2344.2 +081800 PERFORM PRINT-DETAIL. NC2344.2 +081900* NC2344.2 +082000 SP2-INIT-F1-1. NC2344.2 +082100 MOVE "SP2-TEST-F1-1" TO PAR-NAME. NC2344.2 +082200 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +082300 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2344.2 +082400 SET IDX-1-1 TO 4. NC2344.2 +082500 SET IDX-2-1 TO 5. NC2344.2 +082600 SP2-TEST-F1-1. NC2344.2 +082700 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 AT END NC2344.2 +082800 GO TO SP2-FAIL-F1-1-A NC2344.2 +082900 WHEN ENTRY-1-1 (IDX-1-1) = "GRP04" NEXT SENTENCE. NC2344.2 +083000 SET IDX-1-1 TO 4. NC2344.2 +083100 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 NC2344.2 +083200 AT END PERFORM PASS NC2344.2 +083300 GO TO SP2-WRITE-F1-1 NC2344.2 +083400 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = "SEC (04,04)" NC2344.2 +083500 GO TO SP2-FAIL-F1-1-B. NC2344.2 +083600 SP2-DELETE-F1-1. NC2344.2 +083700 PERFORM DE-LETE. NC2344.2 +083800 GO TO SP2-WRITE-F1-1. NC2344.2 +083900 SP2-FAIL-F1-1-A. NC2344.2 +084000 MOVE "GRP04" TO CORRECT-A. NC2344.2 +084100 IF ENTRY-1-1 (04) EQUAL TO "GRP04" NC2344.2 +084200 MOVE "IDX-2-1" TO END-IDX NC2344.2 +084300 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +084400 SET IDX-VALU TO IDX-2-1 NC2344.2 +084500 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +084600 MOVE ENTRY-1-1 (04) TO COMPUTED-A NC2344.2 +084700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +084800 PERFORM FAIL. NC2344.2 +084900 GO TO SP2-WRITE-F1-1. NC2344.2 +085000* NC2344.2 +085100 SP2-FAIL-F1-1-B. NC2344.2 +085200 MOVE ENTRY-2-1 (04, 04) TO COMPUTED-A. NC2344.2 +085300 MOVE SPACES TO CORRECT-A. NC2344.2 +085400 PERFORM FAIL. NC2344.2 +085500 SP2-WRITE-F1-1. NC2344.2 +085600 PERFORM PRINT-DETAIL. NC2344.2 +085700* NC2344.2 +085800 SP3-INIT-F1-1. NC2344.2 +085900 MOVE "SP3-TEST-F1-1" TO PAR-NAME. NC2344.2 +086000 MOVE "VI-122 6.21" TO ANSI-REFERENCE. NC2344.2 +086100 MOVE "SEARCH WITH HI INDEX" TO FEATURE. NC2344.2 +086200 SET IDX-1-1 TO 02. NC2344.2 +086300 SP3-TEST-F1-1. NC2344.2 +086400 SEARCH GRP-ENTRY-1 VARYING IDX-1-1 NC2344.2 +086500 AT END NC2344.2 +086600 GO TO SP3-FAIL-F1-1-A NC2344.2 +086700 WHEN ENTRY-1-1 (IDX-1-1) EQUAL TO "GRP02" NC2344.2 +086800 NEXT SENTENCE. NC2344.2 +086900 SET IDX-1-1 TO 02. NC2344.2 +087000 SET IDX-2-1 TO 01. NC2344.2 +087100 SEARCH GRP2-ENTRY-1 VARYING IDX-2-1 NC2344.2 +087200 AT END NC2344.2 +087300 GO TO SP3-FAIL-F1-1-B NC2344.2 +087400 WHEN ENTRY-2-1 (IDX-1-1, IDX-2-1) = "SEC (02,03)" NC2344.2 +087500 NEXT SENTENCE. NC2344.2 +087600 SET IDX-1-1 TO 02. NC2344.2 +087700 SET IDX-2-1 TO 03. NC2344.2 +087800 SET IDX-3-1 TO 05. NC2344.2 +087900 SEARCH GRP3-ENTRY-1 VARYING IDX-3-1 NC2344.2 +088000 AT END PERFORM PASS NC2344.2 +088100 GO TO SP3-WRITE-F1-1 NC2344.2 +088200 WHEN ENTRY-3-1 (IDX-1-1, IDX-2-1, IDX-3-1) NC2344.2 +088300 = "ELEM (02,03,04)" NC2344.2 +088400 GO TO SP3-FAIL-F1-1-C. NC2344.2 +088500 SP3-DELETE-F1-1. NC2344.2 +088600 PERFORM DE-LETE. NC2344.2 +088700 GO TO SP3-WRITE-F1-1. NC2344.2 +088800 SP3-FAIL-F1-1-A. NC2344.2 +088900 MOVE "GRP02" TO CORRECT-A. NC2344.2 +089000 IF ENTRY-1-1 (02) EQUAL TO "GRP02" NC2344.2 +089100 MOVE "IDX-1-1" TO END-IDX NC2344.2 +089200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +089300 SET IDX-VALU TO IDX-1-1 NC2344.2 +089400 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +089500 MOVE ENTRY-1-1 (02) TO COMPUTED-A NC2344.2 +089600 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +089700 PERFORM FAIL. NC2344.2 +089800 GO TO SP3-WRITE-F1-1. NC2344.2 +089900* NC2344.2 +090000 SP3-FAIL-F1-1-B. NC2344.2 +090100 MOVE "SEC (02,03)" TO CORRECT-A. NC2344.2 +090200 IF ENTRY-2-1 (02, 03) EQUAL TO "SEC (02,03)" NC2344.2 +090300 MOVE "IDX-2-1" TO END-IDX NC2344.2 +090400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC " TO RE-MARK NC2344.2 +090500 SET IDX-VALU TO IDX-2-1 NC2344.2 +090600 MOVE END-STMT TO COMPUTED-A ELSE NC2344.2 +090700 MOVE ENTRY-2-1 (02, 03) TO COMPUTED-A NC2344.2 +090800 MOVE "SEE NOTE 2 FOR DIAGNOSTIC " TO RE-MARK. NC2344.2 +090900 PERFORM FAIL. NC2344.2 +091000 GO TO SP3-WRITE-F1-1. NC2344.2 +091100* NC2344.2 +091200 SP3-FAIL-F1-1-C. NC2344.2 +091300 MOVE "INDEX SET HIGHER THAN ENTRY" TO RE-MARK NC2344.2 +091400 MOVE SPACES TO CORRECT-A NC2344.2 +091500 MOVE "ELEM (02,03,04)" TO COMPUTED-A NC2344.2 +091600 PERFORM FAIL. NC2344.2 +091700 SP3-WRITE-F1-1. NC2344.2 +091800 PERFORM PRINT-DETAIL. NC2344.2 +091900* NC2344.2 +092000 CCVS-EXIT SECTION. NC2344.2 +092100 CCVS-999999. NC2344.2 +092200 GO TO CLOSE-FILES. NC2344.2 diff --git a/tests/cobol85/NC/NC235A.CBL b/tests/cobol85/NC/NC235A.CBL new file mode 100755 index 00000000..48440ec9 --- /dev/null +++ b/tests/cobol85/NC/NC235A.CBL @@ -0,0 +1,626 @@ +000100 IDENTIFICATION DIVISION. NC2354.2 +000200 PROGRAM-ID. NC2354.2 +000300 NC235A. NC2354.2 +000400* NC2354.2 +000500**************************************************************** NC2354.2 +000600* * NC2354.2 +000700* VALIDATION FOR:- * NC2354.2 +000800* * NC2354.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2354.2 +001000* * NC2354.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2354.2 +001200* * NC2354.2 +001300**************************************************************** NC2354.2 +001400* * NC2354.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2354.2 +001600* * NC2354.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2354.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2354.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2354.2 +002000* * NC2354.2 +002100**************************************************************** NC2354.2 +002200* PROGRAM NC235A TESTS THE USE OF FORMATS 1 AND 2 OF THE * NC2354.2 +002300* "SEARCH" STATEMENT ON A ONE DIMENSIONAL TABLE WITH A * NC2354.2 +002400* VARIABLE NUMBER OF OCCURRENCES. THE TABLE IS DEFINED * NC2354.2 +002500* USING FORMAT 2 OF THE "OCCURS" CLAUSE. * NC2354.2 +002600* * NC2354.2 +002700**************************************************************** NC2354.2 +002800 ENVIRONMENT DIVISION. NC2354.2 +002900 CONFIGURATION SECTION. NC2354.2 +003000 SOURCE-COMPUTER. NC2354.2 +003100 Linux. NC2354.2 +003200 OBJECT-COMPUTER. NC2354.2 +003300 Linux. NC2354.2 +003400 INPUT-OUTPUT SECTION. NC2354.2 +003500 FILE-CONTROL. NC2354.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2354.2 +003700 "report.log". NC2354.2 +003800 DATA DIVISION. NC2354.2 +003900 FILE SECTION. NC2354.2 +004000 FD PRINT-FILE. NC2354.2 +004100 01 PRINT-REC PICTURE X(120). NC2354.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2354.2 +004300 WORKING-STORAGE SECTION. NC2354.2 +004400 77 TBL-LENGTH PIC 99 VALUE 26. NC2354.2 +004500 77 SUB-1 PIC 99 VALUE ZERO. NC2354.2 +004600 01 TBL-TH309. NC2354.2 +004700 02 TH309-ENTRY OCCURS 1 TO 26 DEPENDING TBL-LENGTH NC2354.2 +004800 DESCENDING KEY IS DEC-KEY INDEXED BY IDX-1, IDX-2, IDX-3.NC2354.2 +004900 03 DEC-KEY PIC XX. NC2354.2 +005000 88 FIRSTZ VALUE "ZZ". NC2354.2 +005100 88 LASTA VALUE "AA". NC2354.2 +005200 88 MIDDLE-PP VALUE "PP". NC2354.2 +005300 01 NOTE-1. NC2354.2 +005400 02 FILLER PIC X(74) VALUE NC2354.2 +005500 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2354.2 +005600- "PATH WAS TAKEN". NC2354.2 +005700 02 FILLER PIC X(46) VALUE SPACE. NC2354.2 +005800 01 NOTE-2. NC2354.2 +005900 02 FILLER PIC X(112) VALUE NC2354.2 +006000 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2354.2 +006100- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2354.2 +006200 02 FILLER PIC X(8) VALUE SPACE. NC2354.2 +006300 01 TEST-RESULTS. NC2354.2 +006400 02 FILLER PIC X VALUE SPACE. NC2354.2 +006500 02 FEATURE PIC X(20) VALUE SPACE. NC2354.2 +006600 02 FILLER PIC X VALUE SPACE. NC2354.2 +006700 02 P-OR-F PIC X(5) VALUE SPACE. NC2354.2 +006800 02 FILLER PIC X VALUE SPACE. NC2354.2 +006900 02 PAR-NAME. NC2354.2 +007000 03 FILLER PIC X(19) VALUE SPACE. NC2354.2 +007100 03 PARDOT-X PIC X VALUE SPACE. NC2354.2 +007200 03 DOTVALUE PIC 99 VALUE ZERO. NC2354.2 +007300 02 FILLER PIC X(8) VALUE SPACE. NC2354.2 +007400 02 RE-MARK PIC X(61). NC2354.2 +007500 01 TEST-COMPUTED. NC2354.2 +007600 02 FILLER PIC X(30) VALUE SPACE. NC2354.2 +007700 02 FILLER PIC X(17) VALUE NC2354.2 +007800 " COMPUTED=". NC2354.2 +007900 02 COMPUTED-X. NC2354.2 +008000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2354.2 +008100 03 COMPUTED-N REDEFINES COMPUTED-A NC2354.2 +008200 PIC -9(9).9(9). NC2354.2 +008300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2354.2 +008400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2354.2 +008500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2354.2 +008600 03 CM-18V0 REDEFINES COMPUTED-A. NC2354.2 +008700 04 COMPUTED-18V0 PIC -9(18). NC2354.2 +008800 04 FILLER PIC X. NC2354.2 +008900 03 FILLER PIC X(50) VALUE SPACE. NC2354.2 +009000 01 TEST-CORRECT. NC2354.2 +009100 02 FILLER PIC X(30) VALUE SPACE. NC2354.2 +009200 02 FILLER PIC X(17) VALUE " CORRECT =". NC2354.2 +009300 02 CORRECT-X. NC2354.2 +009400 03 CORRECT-A PIC X(20) VALUE SPACE. NC2354.2 +009500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2354.2 +009600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2354.2 +009700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2354.2 +009800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2354.2 +009900 03 CR-18V0 REDEFINES CORRECT-A. NC2354.2 +010000 04 CORRECT-18V0 PIC -9(18). NC2354.2 +010100 04 FILLER PIC X. NC2354.2 +010200 03 FILLER PIC X(2) VALUE SPACE. NC2354.2 +010300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2354.2 +010400 01 CCVS-C-1. NC2354.2 +010500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2354.2 +010600- "SS PARAGRAPH-NAME NC2354.2 +010700- " REMARKS". NC2354.2 +010800 02 FILLER PIC X(20) VALUE SPACE. NC2354.2 +010900 01 CCVS-C-2. NC2354.2 +011000 02 FILLER PIC X VALUE SPACE. NC2354.2 +011100 02 FILLER PIC X(6) VALUE "TESTED". NC2354.2 +011200 02 FILLER PIC X(15) VALUE SPACE. NC2354.2 +011300 02 FILLER PIC X(4) VALUE "FAIL". NC2354.2 +011400 02 FILLER PIC X(94) VALUE SPACE. NC2354.2 +011500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2354.2 +011600 01 REC-CT PIC 99 VALUE ZERO. NC2354.2 +011700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2354.2 +011800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2354.2 +011900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2354.2 +012000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2354.2 +012100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2354.2 +012200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2354.2 +012300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2354.2 +012400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2354.2 +012500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2354.2 +012600 01 CCVS-H-1. NC2354.2 +012700 02 FILLER PIC X(39) VALUE SPACES. NC2354.2 +012800 02 FILLER PIC X(42) VALUE NC2354.2 +012900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2354.2 +013000 02 FILLER PIC X(39) VALUE SPACES. NC2354.2 +013100 01 CCVS-H-2A. NC2354.2 +013200 02 FILLER PIC X(40) VALUE SPACE. NC2354.2 +013300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2354.2 +013400 02 FILLER PIC XXXX VALUE NC2354.2 +013500 "4.2 ". NC2354.2 +013600 02 FILLER PIC X(28) VALUE NC2354.2 +013700 " COPY - NOT FOR DISTRIBUTION". NC2354.2 +013800 02 FILLER PIC X(41) VALUE SPACE. NC2354.2 +013900 NC2354.2 +014000 01 CCVS-H-2B. NC2354.2 +014100 02 FILLER PIC X(15) VALUE NC2354.2 +014200 "TEST RESULT OF ". NC2354.2 +014300 02 TEST-ID PIC X(9). NC2354.2 +014400 02 FILLER PIC X(4) VALUE NC2354.2 +014500 " IN ". NC2354.2 +014600 02 FILLER PIC X(12) VALUE NC2354.2 +014700 " HIGH ". NC2354.2 +014800 02 FILLER PIC X(22) VALUE NC2354.2 +014900 " LEVEL VALIDATION FOR ". NC2354.2 +015000 02 FILLER PIC X(58) VALUE NC2354.2 +015100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2354.2 +015200 01 CCVS-H-3. NC2354.2 +015300 02 FILLER PIC X(34) VALUE NC2354.2 +015400 " FOR OFFICIAL USE ONLY ". NC2354.2 +015500 02 FILLER PIC X(58) VALUE NC2354.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2354.2 +015700 02 FILLER PIC X(28) VALUE NC2354.2 +015800 " COPYRIGHT 1985 ". NC2354.2 +015900 01 CCVS-E-1. NC2354.2 +016000 02 FILLER PIC X(52) VALUE SPACE. NC2354.2 +016100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2354.2 +016200 02 ID-AGAIN PIC X(9). NC2354.2 +016300 02 FILLER PIC X(45) VALUE SPACES. NC2354.2 +016400 01 CCVS-E-2. NC2354.2 +016500 02 FILLER PIC X(31) VALUE SPACE. NC2354.2 +016600 02 FILLER PIC X(21) VALUE SPACE. NC2354.2 +016700 02 CCVS-E-2-2. NC2354.2 +016800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2354.2 +016900 03 FILLER PIC X VALUE SPACE. NC2354.2 +017000 03 ENDER-DESC PIC X(44) VALUE NC2354.2 +017100 "ERRORS ENCOUNTERED". NC2354.2 +017200 01 CCVS-E-3. NC2354.2 +017300 02 FILLER PIC X(22) VALUE NC2354.2 +017400 " FOR OFFICIAL USE ONLY". NC2354.2 +017500 02 FILLER PIC X(12) VALUE SPACE. NC2354.2 +017600 02 FILLER PIC X(58) VALUE NC2354.2 +017700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2354.2 +017800 02 FILLER PIC X(13) VALUE SPACE. NC2354.2 +017900 02 FILLER PIC X(15) VALUE NC2354.2 +018000 " COPYRIGHT 1985". NC2354.2 +018100 01 CCVS-E-4. NC2354.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2354.2 +018300 02 FILLER PIC X(4) VALUE " OF ". NC2354.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2354.2 +018500 02 FILLER PIC X(40) VALUE NC2354.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". NC2354.2 +018700 01 XXINFO. NC2354.2 +018800 02 FILLER PIC X(19) VALUE NC2354.2 +018900 "*** INFORMATION ***". NC2354.2 +019000 02 INFO-TEXT. NC2354.2 +019100 04 FILLER PIC X(8) VALUE SPACE. NC2354.2 +019200 04 XXCOMPUTED PIC X(20). NC2354.2 +019300 04 FILLER PIC X(5) VALUE SPACE. NC2354.2 +019400 04 XXCORRECT PIC X(20). NC2354.2 +019500 02 INF-ANSI-REFERENCE PIC X(48). NC2354.2 +019600 01 HYPHEN-LINE. NC2354.2 +019700 02 FILLER PIC IS X VALUE IS SPACE. NC2354.2 +019800 02 FILLER PIC IS X(65) VALUE IS "************************NC2354.2 +019900- "*****************************************". NC2354.2 +020000 02 FILLER PIC IS X(54) VALUE IS "************************NC2354.2 +020100- "******************************". NC2354.2 +020200 01 CCVS-PGM-ID PIC X(9) VALUE NC2354.2 +020300 "NC235A". NC2354.2 +020400 PROCEDURE DIVISION. NC2354.2 +020500 CCVS1 SECTION. NC2354.2 +020600 OPEN-FILES. NC2354.2 +020700 OPEN OUTPUT PRINT-FILE. NC2354.2 +020800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2354.2 +020900 MOVE SPACE TO TEST-RESULTS. NC2354.2 +021000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2354.2 +021100 GO TO CCVS1-EXIT. NC2354.2 +021200 CLOSE-FILES. NC2354.2 +021300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2354.2 +021400 TERMINATE-CCVS. NC2354.2 +021500*S EXIT PROGRAM. NC2354.2 +021600*SERMINATE-CALL. NC2354.2 +021700 STOP RUN. NC2354.2 +021800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2354.2 +021900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2354.2 +022000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2354.2 +022100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2354.2 +022200 MOVE "****TEST DELETED****" TO RE-MARK. NC2354.2 +022300 PRINT-DETAIL. NC2354.2 +022400 IF REC-CT NOT EQUAL TO ZERO NC2354.2 +022500 MOVE "." TO PARDOT-X NC2354.2 +022600 MOVE REC-CT TO DOTVALUE. NC2354.2 +022700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2354.2 +022800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2354.2 +022900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2354.2 +023000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2354.2 +023100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2354.2 +023200 MOVE SPACE TO CORRECT-X. NC2354.2 +023300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2354.2 +023400 MOVE SPACE TO RE-MARK. NC2354.2 +023500 HEAD-ROUTINE. NC2354.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2354.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2354.2 +024000 COLUMN-NAMES-ROUTINE. NC2354.2 +024100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +024200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +024400 END-ROUTINE. NC2354.2 +024500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2354.2 +024600 END-RTN-EXIT. NC2354.2 +024700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +024800 END-ROUTINE-1. NC2354.2 +024900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2354.2 +025000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2354.2 +025100 ADD PASS-COUNTER TO ERROR-HOLD. NC2354.2 +025200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2354.2 +025300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2354.2 +025400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2354.2 +025500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2354.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2354.2 +025700 END-ROUTINE-12. NC2354.2 +025800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2354.2 +025900 IF ERROR-COUNTER IS EQUAL TO ZERO NC2354.2 +026000 MOVE "NO " TO ERROR-TOTAL NC2354.2 +026100 ELSE NC2354.2 +026200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2354.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2354.2 +026400 PERFORM WRITE-LINE. NC2354.2 +026500 END-ROUTINE-13. NC2354.2 +026600 IF DELETE-COUNTER IS EQUAL TO ZERO NC2354.2 +026700 MOVE "NO " TO ERROR-TOTAL ELSE NC2354.2 +026800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2354.2 +026900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2354.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +027100 IF INSPECT-COUNTER EQUAL TO ZERO NC2354.2 +027200 MOVE "NO " TO ERROR-TOTAL NC2354.2 +027300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2354.2 +027400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2354.2 +027500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +027600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2354.2 +027700 WRITE-LINE. NC2354.2 +027800 ADD 1 TO RECORD-COUNT. NC2354.2 +027900 IF RECORD-COUNT GREATER 50 NC2354.2 +028000 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2354.2 +028100 MOVE SPACE TO DUMMY-RECORD NC2354.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2354.2 +028300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2354.2 +028400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2354.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2354.2 +028600 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2354.2 +028700 MOVE ZERO TO RECORD-COUNT. NC2354.2 +028800 PERFORM WRT-LN. NC2354.2 +028900 WRT-LN. NC2354.2 +029000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2354.2 +029100 MOVE SPACE TO DUMMY-RECORD. NC2354.2 +029200 BLANK-LINE-PRINT. NC2354.2 +029300 PERFORM WRT-LN. NC2354.2 +029400 FAIL-ROUTINE. NC2354.2 +029500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2354.2 +029600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2354.2 +029700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2354.2 +029800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2354.2 +029900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +030000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2354.2 +030100 GO TO FAIL-ROUTINE-EX. NC2354.2 +030200 FAIL-ROUTINE-WRITE. NC2354.2 +030300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2354.2 +030400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2354.2 +030500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2354.2 +030600 MOVE SPACES TO COR-ANSI-REFERENCE. NC2354.2 +030700 FAIL-ROUTINE-EX. EXIT. NC2354.2 +030800 BAIL-OUT. NC2354.2 +030900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2354.2 +031000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2354.2 +031100 BAIL-OUT-WRITE. NC2354.2 +031200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2354.2 +031300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2354.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2354.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2354.2 +031600 BAIL-OUT-EX. EXIT. NC2354.2 +031700 CCVS1-EXIT. NC2354.2 +031800 EXIT. NC2354.2 +031900 SECT-NC235A-001 SECTION. NC2354.2 +032000 TH-08-001. NC2354.2 +032100 INIT-TBL-TH309. NC2354.2 +032200 MOVE "ZZYYXXWWVVUUTTSSRRQQPPOONNMMLLKKJJIIHHGGFFEEDDCCBBAA" NC2354.2 +032300 TO TBL-TH309. NC2354.2 +032400 IF FIRSTZ (1) AND LASTA (26) NC2354.2 +032500 MOVE "26 ENTRY TABLE CONSTRUCTED " TO RE-MARK NC2354.2 +032600 GO TO INIT-WRITE. NC2354.2 +032700 MOVE "TBL ENTRIES BUILT INCORRECT" TO RE-MARK. NC2354.2 +032800 MOVE "*****" TO CORRECT-A COMPUTED-A. NC2354.2 +032900 INIT-WRITE. NC2354.2 +033000 MOVE "INIT-TBL-TH309" TO PAR-NAME. NC2354.2 +033100 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +033200 PERFORM PRINT-DETAIL. NC2354.2 +033300* NC2354.2 +033400 IDX-INIT-F2-1. NC2354.2 +033500 MOVE "IDX-TEST-F2-1 " TO PAR-NAME. NC2354.2 +033600 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +033700 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +033800 SET IDX-2 TO 26. NC2354.2 +033900 IDX-TEST-F2-1. NC2354.2 +034000 SEARCH ALL TH309-ENTRY AT END NC2354.2 +034100 GO TO IDX-FAIL-F2-1 NC2354.2 +034200 WHEN DEC-KEY (IDX-1) EQUAL TO "BB" NEXT SENTENCE. NC2354.2 +034300 PERFORM PASS. NC2354.2 +034400 GO TO IDX-WRITE-F2-1. NC2354.2 +034500 IDX-DELETE-F2-1. NC2354.2 +034600 PERFORM DE-LETE NC2354.2 +034700 GO TO IDX-WRITE-F2-1. NC2354.2 +034800 IDX-FAIL-F2-1. NC2354.2 +034900 MOVE 25 TO SUB-1 NC2354.2 +035000 MOVE "BB" TO CORRECT-A NC2354.2 +035100 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +035200 PERFORM FAIL. NC2354.2 +035300 IDX-WRITE-F2-1. NC2354.2 +035400 PERFORM PRINT-DETAIL. NC2354.2 +035500* NC2354.2 +035600 IDX-INIT-F2-2. NC2354.2 +035700 MOVE "IDX-TEST-F2-2 " TO PAR-NAME. NC2354.2 +035800 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +035900 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +036000 SET IDX-3 TO 01. NC2354.2 +036100 IDX-TEST-F2-2. NC2354.2 +036200 SEARCH ALL TH309-ENTRY AT END NC2354.2 +036300 GO TO IDX-FAIL-F2-2 NC2354.2 +036400 WHEN DEC-KEY (IDX-1) EQUAL TO "XX" NC2354.2 +036500 PERFORM PASS NC2354.2 +036600 GO TO IDX-WRITE-F2-2. NC2354.2 +036700 IDX-DELETE-F2-2. NC2354.2 +036800 PERFORM DE-LETE. NC2354.2 +036900 GO TO IDX-WRITE-F2-2. NC2354.2 +037000 IDX-FAIL-F2-2. NC2354.2 +037100 MOVE 03 TO SUB-1 NC2354.2 +037200 MOVE "XX" TO CORRECT-A NC2354.2 +037300 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +037400 PERFORM FAIL. NC2354.2 +037500 IDX-WRITE-F2-2. NC2354.2 +037600 PERFORM PRINT-DETAIL. NC2354.2 +037700* NC2354.2 +037800 IDX-INIT-F2-3. NC2354.2 +037900 MOVE "IDX-TEST-F2-3 " TO PAR-NAME. NC2354.2 +038000 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +038100 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +038200 MOVE 25 TO TBL-LENGTH. NC2354.2 +038300 IDX-TEST-F2-3. NC2354.2 +038400 SEARCH ALL TH309-ENTRY AT END NC2354.2 +038500 PERFORM PASS NC2354.2 +038600 GO TO IDX-WRITE-F2-3 NC2354.2 +038700 WHEN DEC-KEY (IDX-1) EQUAL TO "AA" NC2354.2 +038800 GO TO IDX-FAIL-F2-3. NC2354.2 +038900 IDX-DELETE-F2-3. NC2354.2 +039000 PERFORM DE-LETE. NC2354.2 +039100 GO TO IDX-WRITE-F2-3. NC2354.2 +039200 IDX-FAIL-F2-3. NC2354.2 +039300 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +039400 MOVE "AA" TO COMPUTED-A NC2354.2 +039500 PERFORM FAIL. NC2354.2 +039600 IDX-WRITE-F2-3. NC2354.2 +039700 PERFORM PRINT-DETAIL. NC2354.2 +039800* NC2354.2 +039900 IDX-INIT-F1-4. NC2354.2 +040000 MOVE "IDX-TEST-F1-4" TO PAR-NAME. NC2354.2 +040100 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +040200 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +040300 MOVE 24 TO TBL-LENGTH. NC2354.2 +040400 SET IDX-3 TO 01. NC2354.2 +040500 IDX-TEST-F1-4. NC2354.2 +040600 SEARCH TH309-ENTRY VARYING IDX-3 AT END NC2354.2 +040700 PERFORM PASS NC2354.2 +040800 GO TO IDX-WRITE-F1-4 NC2354.2 +040900 WHEN DEC-KEY (IDX-3) EQUAL TO "BB" NC2354.2 +041000 GO TO IDX-FAIL-F1-4. NC2354.2 +041100 IDX-DELETE-F1-4. NC2354.2 +041200 PERFORM DE-LETE. NC2354.2 +041300 GO TO IDX-WRITE-F1-4. NC2354.2 +041400 IDX-FAIL-F1-4. NC2354.2 +041500 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +041600 MOVE "BB" TO COMPUTED-A NC2354.2 +041700 PERFORM FAIL. NC2354.2 +041800 IDX-WRITE-F1-4. NC2354.2 +041900 PERFORM PRINT-DETAIL. NC2354.2 +042000* NC2354.2 +042100 IDX-INIT-F1-5. NC2354.2 +042200 MOVE "IDX-TEST-F1-5 " TO PAR-NAME. NC2354.2 +042300 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +042400 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +042500 SET IDX-2 TO 01. NC2354.2 +042600 IDX-TEST-F1-5. NC2354.2 +042700 SEARCH TH309-ENTRY VARYING IDX-2 AT END NC2354.2 +042800 GO TO IDX-FAIL-F1-5 NC2354.2 +042900 WHEN DEC-KEY (IDX-2) EQUAL TO "KK" NC2354.2 +043000 PERFORM PASS NC2354.2 +043100 GO TO IDX-WRITE-F1-5. NC2354.2 +043200 IDX-DELETE-F1-5. NC2354.2 +043300 PERFORM DE-LETE. NC2354.2 +043400 GO TO IDX-WRITE-F1-5. NC2354.2 +043500 IDX-FAIL-F1-5. NC2354.2 +043600 MOVE 16 TO SUB-1 NC2354.2 +043700 MOVE "KK" TO CORRECT-A NC2354.2 +043800 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +043900 PERFORM FAIL. NC2354.2 +044000 IDX-WRITE-F1-5. NC2354.2 +044100 PERFORM PRINT-DETAIL. NC2354.2 +044200* NC2354.2 +044300 IDX-INIT-F1-6. NC2354.2 +044400 MOVE "IDX-TEST-F1-6 " TO PAR-NAME. NC2354.2 +044500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +044600 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +044700 MOVE 22 TO TBL-LENGTH. NC2354.2 +044800 SET IDX-1 TO 09. NC2354.2 +044900 IDX-TEST-F1-6. NC2354.2 +045000 SEARCH TH309-ENTRY VARYING IDX-1 AT END NC2354.2 +045100 PERFORM PASS NC2354.2 +045200 GO TO IDX-WRITE-F1-6 NC2354.2 +045300 WHEN TH309-ENTRY (IDX-1) EQUAL TO "DD" NC2354.2 +045400 GO TO IDX-FAIL-F1-6. NC2354.2 +045500 IDX-DELETE-F1-6. NC2354.2 +045600 PERFORM DE-LETE. NC2354.2 +045700 GO TO IDX-WRITE-F1-6. NC2354.2 +045800 IDX-FAIL-F1-6. NC2354.2 +045900 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +046000 MOVE "DD" TO COMPUTED-A NC2354.2 +046100 PERFORM FAIL. NC2354.2 +046200 IDX-WRITE-F1-6. NC2354.2 +046300 PERFORM PRINT-DETAIL. NC2354.2 +046400* NC2354.2 +046500 IDX-INIT-F1-7. NC2354.2 +046600 MOVE "IDX-TEST-F1-7 " TO PAR-NAME. NC2354.2 +046700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +046800 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +046900 MOVE 22 TO TBL-LENGTH. NC2354.2 +047000 SET IDX-3 TO 23. NC2354.2 +047100 IDX-TEST-F1-7. NC2354.2 +047200 SEARCH TH309-ENTRY VARYING IDX-3 AT END NC2354.2 +047300 PERFORM PASS NC2354.2 +047400 GO TO IDX-WRITE-F1-7 NC2354.2 +047500 WHEN TH309-ENTRY (IDX-3) EQUAL TO "DD" NC2354.2 +047600 GO TO IDX-FAIL-F1-7. NC2354.2 +047700 IDX-DELETE-F1-7. NC2354.2 +047800 PERFORM DE-LETE. NC2354.2 +047900 GO TO IDX-WRITE-F1-7. NC2354.2 +048000 IDX-FAIL-F1-7. NC2354.2 +048100 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +048200 MOVE "DD" TO COMPUTED-A NC2354.2 +048300 PERFORM FAIL. NC2354.2 +048400 IDX-WRITE-F1-7. NC2354.2 +048500 PERFORM PRINT-DETAIL. NC2354.2 +048600* NC2354.2 +048700 IDX-INIT-F2-8. NC2354.2 +048800 MOVE "IDX-TEST-F2-8 " TO PAR-NAME. NC2354.2 +048900 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +049000 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +049100 MOVE 20 TO TBL-LENGTH. NC2354.2 +049200 SET IDX-2 TO 21. NC2354.2 +049300 IDX-TEST-F2-8. NC2354.2 +049400 SEARCH ALL TH309-ENTRY AT END NC2354.2 +049500 GO TO IDX-FAIL-F2-8 NC2354.2 +049600 WHEN DEC-KEY (IDX-1) EQUAL TO "GG" NC2354.2 +049700 PERFORM PASS NC2354.2 +049800 GO TO IDX-WRITE-F2-8. NC2354.2 +049900 IDX-DELETE-F2-8. NC2354.2 +050000 PERFORM DE-LETE. NC2354.2 +050100 GO TO IDX-WRITE-F2-8. NC2354.2 +050200 IDX-FAIL-F2-8. NC2354.2 +050300 MOVE 20 TO SUB-1 NC2354.2 +050400 MOVE "GG" TO CORRECT-A NC2354.2 +050500 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +050600 PERFORM FAIL. NC2354.2 +050700 IDX-WRITE-F2-8. NC2354.2 +050800 PERFORM PRINT-DETAIL. NC2354.2 +050900* NC2354.2 +051000 IDX-INIT-F2-9. NC2354.2 +051100 MOVE "IDX-TEST-F2-9 " TO PAR-NAME. NC2354.2 +051200 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +051300 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +051400 MOVE 20 TO TBL-LENGTH. NC2354.2 +051500 IDX-TEST-F2-9. NC2354.2 +051600 SEARCH ALL TH309-ENTRY AT END NC2354.2 +051700 PERFORM PASS NC2354.2 +051800 GO TO IDX-WRITE-F2-9 NC2354.2 +051900 WHEN LASTA (IDX-1) NC2354.2 +052000 GO TO IDX-FAIL-F2-9. NC2354.2 +052100 IDX-DELETE-F2-9. NC2354.2 +052200 PERFORM DE-LETE. NC2354.2 +052300 GO TO IDX-WRITE-F2-9. NC2354.2 +052400 IDX-FAIL-F2-9. NC2354.2 +052500 MOVE "CONDITION-NAME TEST" TO RE-MARK NC2354.2 +052600 PERFORM FAIL NC2354.2 +052700 MOVE "AA" TO COMPUTED-A. NC2354.2 +052800 IDX-WRITE-F2-9. NC2354.2 +052900 PERFORM PRINT-DETAIL. NC2354.2 +053000* NC2354.2 +053100 IDX-INIT-F2-10. NC2354.2 +053200 MOVE "IDX-TEST-F2-10 " TO PAR-NAME. NC2354.2 +053300 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +053400 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +053500 SET IDX-1, IDX-2, IDX-3 TO 10. NC2354.2 +053600 IDX-TEST-F2-10. NC2354.2 +053700 SEARCH ALL TH309-ENTRY AT END NC2354.2 +053800 GO TO IDX-FAIL-F2-10 NC2354.2 +053900 WHEN DEC-KEY (IDX-1) EQUAL TO "RR" NC2354.2 +054000 PERFORM PASS NC2354.2 +054100 GO TO IDX-WRITE-F2-10. NC2354.2 +054200 IDX-DELETE-F2-10. NC2354.2 +054300 PERFORM DE-LETE. NC2354.2 +054400 GO TO IDX-WRITE-F2-10. NC2354.2 +054500 IDX-FAIL-F2-10. NC2354.2 +054600 MOVE 9 TO SUB-1 NC2354.2 +054700 MOVE "RR" TO CORRECT-A NC2354.2 +054800 PERFORM PUTOUT-COMPUTED-A. NC2354.2 +054900 PERFORM FAIL. NC2354.2 +055000 IDX-WRITE-F2-10. NC2354.2 +055100 PERFORM PRINT-DETAIL. NC2354.2 +055200* NC2354.2 +055300 IDX-INIT-F2-11. NC2354.2 +055400 MOVE "IDX-TEST-F2-11 " TO PAR-NAME. NC2354.2 +055500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +055600 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +055700 MOVE 1 TO TBL-LENGTH. NC2354.2 +055800 IDX-TEST-F2-11. NC2354.2 +055900 SEARCH ALL TH309-ENTRY AT END NC2354.2 +056000 PERFORM PASS NC2354.2 +056100 GO TO IDX-WRITE-F2-11 NC2354.2 +056200 WHEN DEC-KEY (IDX-1) EQUAL TO "YY" NC2354.2 +056300 GO TO IDX-FAIL-F2-11. NC2354.2 +056400 IDX-DELETE-F2-11. NC2354.2 +056500 PERFORM DE-LETE. NC2354.2 +056600 GO TO IDX-WRITE-F2-11. NC2354.2 +056700 IDX-FAIL-F2-11. NC2354.2 +056800 MOVE 2 TO SUB-1 NC2354.2 +056900 MOVE "YY" TO COMPUTED-A NC2354.2 +057000 MOVE "ENTRY SHOULD NOT BE FOUND" TO RE-MARK NC2354.2 +057100 PERFORM FAIL. NC2354.2 +057200 IDX-WRITE-F2-11. NC2354.2 +057300 PERFORM PRINT-DETAIL. NC2354.2 +057400* NC2354.2 +057500 IDX-INIT-F2-12. NC2354.2 +057600 MOVE "IDX-TEST-F2-12 " TO PAR-NAME. NC2354.2 +057700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +057800 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +057900 MOVE 10 TO TBL-LENGTH. NC2354.2 +058000 IDX-TEST-F2-12. NC2354.2 +058100 SEARCH ALL TH309-ENTRY AT END NC2354.2 +058200 PERFORM PASS NC2354.2 +058300 GO TO IDX-WRITE-F2-12 NC2354.2 +058400 WHEN MIDDLE-PP (IDX-1) NC2354.2 +058500 GO TO IDX-FAIL-F2-12. NC2354.2 +058600 IDX-DELETE-F2-12. NC2354.2 +058700 PERFORM DE-LETE. NC2354.2 +058800 GO TO IDX-WRITE-F2-12. NC2354.2 +058900 IDX-FAIL-F2-12. NC2354.2 +059000 MOVE 10 TO SUB-1 NC2354.2 +059100 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +059200 MOVE "PP" TO COMPUTED-A NC2354.2 +059300 PERFORM FAIL. NC2354.2 +059400 IDX-WRITE-F2-12. NC2354.2 +059500 PERFORM PRINT-DETAIL. NC2354.2 +059600* NC2354.2 +059700 IDX-INIT-F2-13. NC2354.2 +059800 MOVE "IDX-TEST-F2-13 " TO PAR-NAME. NC2354.2 +059900 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2354.2 +060000 MOVE "LEVEL 3 TBL HANDLING" TO FEATURE. NC2354.2 +060100 MOVE 2 TO TBL-LENGTH. NC2354.2 +060200 IDX-TEST-F2-13. NC2354.2 +060300 SEARCH ALL TH309-ENTRY AT END NC2354.2 +060400 PERFORM PASS NC2354.2 +060500 GO TO IDX-WRITE-F2-13 NC2354.2 +060600 WHEN DEC-KEY (IDX-1) EQUAL TO "XX" NC2354.2 +060700 GO TO IDX-FAIL-F2-13. NC2354.2 +060800 IDX-DELETE-F2-13. NC2354.2 +060900 PERFORM DE-LETE. NC2354.2 +061000 GO TO IDX-WRITE-F2-13. NC2354.2 +061100 IDX-FAIL-F2-13. NC2354.2 +061200 MOVE "XX" TO COMPUTED-A NC2354.2 +061300 MOVE "ENTRY SHOULD NOT BE FOUND " TO RE-MARK NC2354.2 +061400 PERFORM FAIL. NC2354.2 +061500 IDX-WRITE-F2-13. NC2354.2 +061600 PERFORM PRINT-DETAIL. NC2354.2 +061700 GO TO CCVS-EXIT. NC2354.2 +061800* NC2354.2 +061900 PUTOUT-COMPUTED-A. NC2354.2 +062000 IF TH309-ENTRY (SUB-1) EQUAL TO CORRECT-A NC2354.2 +062100 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2354.2 +062200 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK. NC2354.2 +062300 MOVE TH309-ENTRY (SUB-1) TO COMPUTED-A. NC2354.2 +062400 CCVS-EXIT SECTION. NC2354.2 +062500 CCVS-999999. NC2354.2 +062600 GO TO CLOSE-FILES. NC2354.2 diff --git a/tests/cobol85/NC/NC236A.CBL b/tests/cobol85/NC/NC236A.CBL new file mode 100755 index 00000000..8333d284 --- /dev/null +++ b/tests/cobol85/NC/NC236A.CBL @@ -0,0 +1,584 @@ +000100 IDENTIFICATION DIVISION. NC2364.2 +000200 PROGRAM-ID. NC2364.2 +000300 NC236A. NC2364.2 +000400**************************************************************** NC2364.2 +000500* * NC2364.2 +000600* VALIDATION FOR:- * NC2364.2 +000700* * NC2364.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2364.2 +000900* * NC2364.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2364.2 +001100* * NC2364.2 +001200**************************************************************** NC2364.2 +001300* * NC2364.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2364.2 +001500* * NC2364.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2364.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2364.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2364.2 +001900* * NC2364.2 +002000**************************************************************** NC2364.2 +002100 NC2364.2 +002200* * NC2364.2 +002300* PROGRAM NC236A TESTS FORMAT 1 OF THE "SEARCH" STATEMENT * NC2364.2 +002400* USING TWO-DIMAENSIONAL TABKES WHICH HAVE BEEN REDEFINED. * NC2364.2 +002500* THE OPTIONAL "VARYING" AND "AT END" PHRASES ARE USED. * NC2364.2 +002600* * NC2364.2 +002700**************************************************************** NC2364.2 +002800 ENVIRONMENT DIVISION. NC2364.2 +002900 CONFIGURATION SECTION. NC2364.2 +003000 SOURCE-COMPUTER. NC2364.2 +003100 Linux. NC2364.2 +003200 OBJECT-COMPUTER. NC2364.2 +003300 Linux. NC2364.2 +003400 INPUT-OUTPUT SECTION. NC2364.2 +003500 FILE-CONTROL. NC2364.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2364.2 +003700 "report.log". NC2364.2 +003800 DATA DIVISION. NC2364.2 +003900 FILE SECTION. NC2364.2 +004000 FD PRINT-FILE. NC2364.2 +004100 01 PRINT-REC PICTURE X(120). NC2364.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2364.2 +004300 WORKING-STORAGE SECTION. NC2364.2 +004400 01 NOTE-1. NC2364.2 +004500 02 FILLER PIC X(74) VALUE NC2364.2 +004600 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2364.2 +004700- "PATH WAS TAKEN". NC2364.2 +004800 02 FILLER PIC X(46) VALUE SPACES. NC2364.2 +004900 01 NOTE-2. NC2364.2 +005000 02 FILLER PIC X(112) VALUE NC2364.2 +005100 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2364.2 +005200- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2364.2 +005300 02 FILLER PIC X(8) VALUE SPACES. NC2364.2 +005400 01 TABLE-A PIC X(20) VALUE "01020304050607080910". NC2364.2 +005500 01 TABLE-1 REDEFINES TABLE-A. NC2364.2 +005600 02 TBL-A OCCURS 10 TIMES INDEXED BY A. NC2364.2 +005700 03 ELMT-A PIC 99. NC2364.2 +005800 01 W USAGE INDEX. NC2364.2 +005900 01 INDEX-VALUE PIC 9999. NC2364.2 +006000 01 TABLE-B PIC X(20) VALUE "01020304050607080910". NC2364.2 +006100 01 TABLE-2 REDEFINES TABLE-B. NC2364.2 +006200 02 TBL-B OCCURS 10 TIMES INDEXED BY B. NC2364.2 +006300 03 ELMT-B PIC 99. NC2364.2 +006400 01 TEST-RESULTS. NC2364.2 +006500 02 FILLER PIC X VALUE SPACE. NC2364.2 +006600 02 FEATURE PIC X(20) VALUE SPACE. NC2364.2 +006700 02 FILLER PIC X VALUE SPACE. NC2364.2 +006800 02 P-OR-F PIC X(5) VALUE SPACE. NC2364.2 +006900 02 FILLER PIC X VALUE SPACE. NC2364.2 +007000 02 PAR-NAME. NC2364.2 +007100 03 FILLER PIC X(19) VALUE SPACE. NC2364.2 +007200 03 PARDOT-X PIC X VALUE SPACE. NC2364.2 +007300 03 DOTVALUE PIC 99 VALUE ZERO. NC2364.2 +007400 02 FILLER PIC X(8) VALUE SPACE. NC2364.2 +007500 02 RE-MARK PIC X(61). NC2364.2 +007600 01 TEST-COMPUTED. NC2364.2 +007700 02 FILLER PIC X(30) VALUE SPACE. NC2364.2 +007800 02 FILLER PIC X(17) VALUE NC2364.2 +007900 " COMPUTED=". NC2364.2 +008000 02 COMPUTED-X. NC2364.2 +008100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2364.2 +008200 03 COMPUTED-N REDEFINES COMPUTED-A NC2364.2 +008300 PIC -9(9).9(9). NC2364.2 +008400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2364.2 +008500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2364.2 +008600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2364.2 +008700 03 CM-18V0 REDEFINES COMPUTED-A. NC2364.2 +008800 04 COMPUTED-18V0 PIC -9(18). NC2364.2 +008900 04 FILLER PIC X. NC2364.2 +009000 03 FILLER PIC X(50) VALUE SPACE. NC2364.2 +009100 01 TEST-CORRECT. NC2364.2 +009200 02 FILLER PIC X(30) VALUE SPACE. NC2364.2 +009300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2364.2 +009400 02 CORRECT-X. NC2364.2 +009500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2364.2 +009600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2364.2 +009700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2364.2 +009800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2364.2 +009900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2364.2 +010000 03 CR-18V0 REDEFINES CORRECT-A. NC2364.2 +010100 04 CORRECT-18V0 PIC -9(18). NC2364.2 +010200 04 FILLER PIC X. NC2364.2 +010300 03 FILLER PIC X(2) VALUE SPACE. NC2364.2 +010400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2364.2 +010500 01 CCVS-C-1. NC2364.2 +010600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2364.2 +010700- "SS PARAGRAPH-NAME NC2364.2 +010800- " REMARKS". NC2364.2 +010900 02 FILLER PIC X(20) VALUE SPACE. NC2364.2 +011000 01 CCVS-C-2. NC2364.2 +011100 02 FILLER PIC X VALUE SPACE. NC2364.2 +011200 02 FILLER PIC X(6) VALUE "TESTED". NC2364.2 +011300 02 FILLER PIC X(15) VALUE SPACE. NC2364.2 +011400 02 FILLER PIC X(4) VALUE "FAIL". NC2364.2 +011500 02 FILLER PIC X(94) VALUE SPACE. NC2364.2 +011600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2364.2 +011700 01 REC-CT PIC 99 VALUE ZERO. NC2364.2 +011800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2364.2 +011900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2364.2 +012000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2364.2 +012100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2364.2 +012200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2364.2 +012300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2364.2 +012400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2364.2 +012500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2364.2 +012600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2364.2 +012700 01 CCVS-H-1. NC2364.2 +012800 02 FILLER PIC X(39) VALUE SPACES. NC2364.2 +012900 02 FILLER PIC X(42) VALUE NC2364.2 +013000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2364.2 +013100 02 FILLER PIC X(39) VALUE SPACES. NC2364.2 +013200 01 CCVS-H-2A. NC2364.2 +013300 02 FILLER PIC X(40) VALUE SPACE. NC2364.2 +013400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2364.2 +013500 02 FILLER PIC XXXX VALUE NC2364.2 +013600 "4.2 ". NC2364.2 +013700 02 FILLER PIC X(28) VALUE NC2364.2 +013800 " COPY - NOT FOR DISTRIBUTION". NC2364.2 +013900 02 FILLER PIC X(41) VALUE SPACE. NC2364.2 +014000 NC2364.2 +014100 01 CCVS-H-2B. NC2364.2 +014200 02 FILLER PIC X(15) VALUE NC2364.2 +014300 "TEST RESULT OF ". NC2364.2 +014400 02 TEST-ID PIC X(9). NC2364.2 +014500 02 FILLER PIC X(4) VALUE NC2364.2 +014600 " IN ". NC2364.2 +014700 02 FILLER PIC X(12) VALUE NC2364.2 +014800 " HIGH ". NC2364.2 +014900 02 FILLER PIC X(22) VALUE NC2364.2 +015000 " LEVEL VALIDATION FOR ". NC2364.2 +015100 02 FILLER PIC X(58) VALUE NC2364.2 +015200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2364.2 +015300 01 CCVS-H-3. NC2364.2 +015400 02 FILLER PIC X(34) VALUE NC2364.2 +015500 " FOR OFFICIAL USE ONLY ". NC2364.2 +015600 02 FILLER PIC X(58) VALUE NC2364.2 +015700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2364.2 +015800 02 FILLER PIC X(28) VALUE NC2364.2 +015900 " COPYRIGHT 1985 ". NC2364.2 +016000 01 CCVS-E-1. NC2364.2 +016100 02 FILLER PIC X(52) VALUE SPACE. NC2364.2 +016200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2364.2 +016300 02 ID-AGAIN PIC X(9). NC2364.2 +016400 02 FILLER PIC X(45) VALUE SPACES. NC2364.2 +016500 01 CCVS-E-2. NC2364.2 +016600 02 FILLER PIC X(31) VALUE SPACE. NC2364.2 +016700 02 FILLER PIC X(21) VALUE SPACE. NC2364.2 +016800 02 CCVS-E-2-2. NC2364.2 +016900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2364.2 +017000 03 FILLER PIC X VALUE SPACE. NC2364.2 +017100 03 ENDER-DESC PIC X(44) VALUE NC2364.2 +017200 "ERRORS ENCOUNTERED". NC2364.2 +017300 01 CCVS-E-3. NC2364.2 +017400 02 FILLER PIC X(22) VALUE NC2364.2 +017500 " FOR OFFICIAL USE ONLY". NC2364.2 +017600 02 FILLER PIC X(12) VALUE SPACE. NC2364.2 +017700 02 FILLER PIC X(58) VALUE NC2364.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2364.2 +017900 02 FILLER PIC X(13) VALUE SPACE. NC2364.2 +018000 02 FILLER PIC X(15) VALUE NC2364.2 +018100 " COPYRIGHT 1985". NC2364.2 +018200 01 CCVS-E-4. NC2364.2 +018300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2364.2 +018400 02 FILLER PIC X(4) VALUE " OF ". NC2364.2 +018500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2364.2 +018600 02 FILLER PIC X(40) VALUE NC2364.2 +018700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2364.2 +018800 01 XXINFO. NC2364.2 +018900 02 FILLER PIC X(19) VALUE NC2364.2 +019000 "*** INFORMATION ***". NC2364.2 +019100 02 INFO-TEXT. NC2364.2 +019200 04 FILLER PIC X(8) VALUE SPACE. NC2364.2 +019300 04 XXCOMPUTED PIC X(20). NC2364.2 +019400 04 FILLER PIC X(5) VALUE SPACE. NC2364.2 +019500 04 XXCORRECT PIC X(20). NC2364.2 +019600 02 INF-ANSI-REFERENCE PIC X(48). NC2364.2 +019700 01 HYPHEN-LINE. NC2364.2 +019800 02 FILLER PIC IS X VALUE IS SPACE. NC2364.2 +019900 02 FILLER PIC IS X(65) VALUE IS "************************NC2364.2 +020000- "*****************************************". NC2364.2 +020100 02 FILLER PIC IS X(54) VALUE IS "************************NC2364.2 +020200- "******************************". NC2364.2 +020300 01 CCVS-PGM-ID PIC X(9) VALUE NC2364.2 +020400 "NC236A". NC2364.2 +020500 PROCEDURE DIVISION. NC2364.2 +020600 CCVS1 SECTION. NC2364.2 +020700 OPEN-FILES. NC2364.2 +020800 OPEN OUTPUT PRINT-FILE. NC2364.2 +020900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2364.2 +021000 MOVE SPACE TO TEST-RESULTS. NC2364.2 +021100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2364.2 +021200 GO TO CCVS1-EXIT. NC2364.2 +021300 CLOSE-FILES. NC2364.2 +021400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2364.2 +021500 TERMINATE-CCVS. NC2364.2 +021600*S EXIT PROGRAM. NC2364.2 +021700*SERMINATE-CALL. NC2364.2 +021800 STOP RUN. NC2364.2 +021900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2364.2 +022000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2364.2 +022100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2364.2 +022200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2364.2 +022300 MOVE "****TEST DELETED****" TO RE-MARK. NC2364.2 +022400 PRINT-DETAIL. NC2364.2 +022500 IF REC-CT NOT EQUAL TO ZERO NC2364.2 +022600 MOVE "." TO PARDOT-X NC2364.2 +022700 MOVE REC-CT TO DOTVALUE. NC2364.2 +022800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2364.2 +022900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2364.2 +023000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2364.2 +023100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2364.2 +023200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2364.2 +023300 MOVE SPACE TO CORRECT-X. NC2364.2 +023400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2364.2 +023500 MOVE SPACE TO RE-MARK. NC2364.2 +023600 HEAD-ROUTINE. NC2364.2 +023700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +023800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +023900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2364.2 +024000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2364.2 +024100 COLUMN-NAMES-ROUTINE. NC2364.2 +024200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +024300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +024400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +024500 END-ROUTINE. NC2364.2 +024600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2364.2 +024700 END-RTN-EXIT. NC2364.2 +024800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +024900 END-ROUTINE-1. NC2364.2 +025000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2364.2 +025100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2364.2 +025200 ADD PASS-COUNTER TO ERROR-HOLD. NC2364.2 +025300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2364.2 +025400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2364.2 +025500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2364.2 +025600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2364.2 +025700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2364.2 +025800 END-ROUTINE-12. NC2364.2 +025900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2364.2 +026000 IF ERROR-COUNTER IS EQUAL TO ZERO NC2364.2 +026100 MOVE "NO " TO ERROR-TOTAL NC2364.2 +026200 ELSE NC2364.2 +026300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2364.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2364.2 +026500 PERFORM WRITE-LINE. NC2364.2 +026600 END-ROUTINE-13. NC2364.2 +026700 IF DELETE-COUNTER IS EQUAL TO ZERO NC2364.2 +026800 MOVE "NO " TO ERROR-TOTAL ELSE NC2364.2 +026900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2364.2 +027000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2364.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +027200 IF INSPECT-COUNTER EQUAL TO ZERO NC2364.2 +027300 MOVE "NO " TO ERROR-TOTAL NC2364.2 +027400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2364.2 +027500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2364.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +027700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2364.2 +027800 WRITE-LINE. NC2364.2 +027900 ADD 1 TO RECORD-COUNT. NC2364.2 +028000 IF RECORD-COUNT GREATER 50 NC2364.2 +028100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2364.2 +028200 MOVE SPACE TO DUMMY-RECORD NC2364.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2364.2 +028400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2364.2 +028500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2364.2 +028600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2364.2 +028700 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2364.2 +028800 MOVE ZERO TO RECORD-COUNT. NC2364.2 +028900 PERFORM WRT-LN. NC2364.2 +029000 WRT-LN. NC2364.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2364.2 +029200 MOVE SPACE TO DUMMY-RECORD. NC2364.2 +029300 BLANK-LINE-PRINT. NC2364.2 +029400 PERFORM WRT-LN. NC2364.2 +029500 FAIL-ROUTINE. NC2364.2 +029600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2364.2 +029700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2364.2 +029800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2364.2 +029900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2364.2 +030000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +030100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2364.2 +030200 GO TO FAIL-ROUTINE-EX. NC2364.2 +030300 FAIL-ROUTINE-WRITE. NC2364.2 +030400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2364.2 +030500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2364.2 +030600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2364.2 +030700 MOVE SPACES TO COR-ANSI-REFERENCE. NC2364.2 +030800 FAIL-ROUTINE-EX. EXIT. NC2364.2 +030900 BAIL-OUT. NC2364.2 +031000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2364.2 +031100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2364.2 +031200 BAIL-OUT-WRITE. NC2364.2 +031300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2364.2 +031400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2364.2 +031500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2364.2 +031600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2364.2 +031700 BAIL-OUT-EX. EXIT. NC2364.2 +031800 CCVS1-EXIT. NC2364.2 +031900 EXIT. NC2364.2 +032000 SECT-NC236A-001 SECTION. NC2364.2 +032100 TH-09-001. NC2364.2 +032200 SCH-INIT-F1-1. NC2364.2 +032300 MOVE "SCH-TEST-F1-1" TO PAR-NAME. NC2364.2 +032400 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +032500 MOVE "SEARCH " TO FEATURE. NC2364.2 +032600 SET A TO 01. NC2364.2 +032700 SET W TO A. NC2364.2 +032800 SCH-TEST-F1-1. NC2364.2 +032900 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-1 NC2364.2 +033000 WHEN ELMT-A (A) EQUAL TO 05 NC2364.2 +033100 SET A TO W. NC2364.2 +033200 IF ELMT-A (A) EQUAL TO 05 NC2364.2 +033300 PERFORM PASS NC2364.2 +033400 GO TO SCH-WRITE-F1-1. NC2364.2 +033500 SCH-DELETE-F1-1. NC2364.2 +033600 PERFORM DE-LETE. NC2364.2 +033700 GO TO SCH-WRITE-F1-1. NC2364.2 +033800 SCH-FAIL-F1-1. NC2364.2 +033900 IF ELMT-A (05) EQUAL TO 05 NC2364.2 +034000 MOVE 05 TO CORRECT-18V0 NC2364.2 +034100 MOVE ELMT-A (05) TO COMPUTED-18V0 NC2364.2 +034200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +034300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +034400 MOVE ELMT-A (05) TO COMPUTED-18V0 NC2364.2 +034500 MOVE 05 TO CORRECT-18V0. NC2364.2 +034600 PERFORM FAIL. NC2364.2 +034700 SCH-WRITE-F1-1. NC2364.2 +034800 PERFORM PRINT-DETAIL. NC2364.2 +034900* NC2364.2 +035000 SCH-INIT-F1-2. NC2364.2 +035100 MOVE "SCH-TEST-F1-2" TO PAR-NAME. NC2364.2 +035200 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +035300 MOVE "SEARCH " TO FEATURE. NC2364.2 +035400 SET A TO 09. NC2364.2 +035500 SET W TO A. NC2364.2 +035600 SCH-TEST-F1-2. NC2364.2 +035700 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-2 NC2364.2 +035800 WHEN ELMT-A (A) EQUAL TO 10 NC2364.2 +035900 SET A TO W. NC2364.2 +036000 IF ELMT-A (A) EQUAL TO 10 NC2364.2 +036100 PERFORM PASS NC2364.2 +036200 GO TO SCH-WRITE-F1-2. NC2364.2 +036300 SCH-DELETE-F1-2. NC2364.2 +036400 PERFORM DE-LETE. NC2364.2 +036500 GO TO SCH-WRITE-F1-2. NC2364.2 +036600 SCH-FAIL-F1-2. NC2364.2 +036700 IF ELMT-A (10) EQUAL TO 10 NC2364.2 +036800 MOVE 10 TO CORRECT-18V0 NC2364.2 +036900 MOVE ELMT-A (10) TO COMPUTED-18V0 NC2364.2 +037000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +037100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +037200 MOVE ELMT-A (10) TO COMPUTED-18V0 NC2364.2 +037300 MOVE 10 TO CORRECT-18V0. NC2364.2 +037400 PERFORM FAIL. NC2364.2 +037500 SCH-WRITE-F1-2. NC2364.2 +037600 PERFORM PRINT-DETAIL. NC2364.2 +037700* NC2364.2 +037800 SCH-INIT-F1-3. NC2364.2 +037900 MOVE "SCH-TEST-F1-3" TO PAR-NAME. NC2364.2 +038000 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +038100 MOVE "SEARCH " TO FEATURE. NC2364.2 +038200 SET A TO 02. NC2364.2 +038300 SET W TO A. NC2364.2 +038400 SCH-TEST-F1-3. NC2364.2 +038500 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-3 NC2364.2 +038600 WHEN ELMT-A (A) EQUAL TO 02 NC2364.2 +038700 SET A TO W. NC2364.2 +038800 IF ELMT-A (A) EQUAL TO 02 NC2364.2 +038900 PERFORM PASS NC2364.2 +039000 GO TO SCH-WRITE-F1-3. NC2364.2 +039100 SCH-DELETE-F1-3. NC2364.2 +039200 PERFORM DE-LETE. NC2364.2 +039300 GO TO SCH-WRITE-F1-3. NC2364.2 +039400 SCH-FAIL-F1-3. NC2364.2 +039500 IF ELMT-A (02) EQUAL TO 02 NC2364.2 +039600 MOVE 02 TO CORRECT-18V0 NC2364.2 +039700 MOVE ELMT-A (02) TO COMPUTED-18V0 NC2364.2 +039800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +039900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +040000 MOVE ELMT-A (02) TO COMPUTED-18V0 NC2364.2 +040100 MOVE 02 TO CORRECT-18V0. NC2364.2 +040200 PERFORM FAIL. NC2364.2 +040300 SCH-WRITE-F1-3. NC2364.2 +040400 PERFORM PRINT-DETAIL. NC2364.2 +040500* NC2364.2 +040600 SCH-INIT-F1-4. NC2364.2 +040700 MOVE "SCH-TEST-F1-4" TO PAR-NAME. NC2364.2 +040800 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +040900 MOVE "SEARCH " TO FEATURE. NC2364.2 +041000 SET A TO 07. NC2364.2 +041100 SET W TO A. NC2364.2 +041200 SCH-TEST-F1-4. NC2364.2 +041300 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-4 NC2364.2 +041400 WHEN ELMT-A (A) EQUAL TO 07 NC2364.2 +041500 SET A TO W. NC2364.2 +041600 IF ELMT-A (A) EQUAL TO 07 NC2364.2 +041700 PERFORM PASS NC2364.2 +041800 GO TO SCH-WRITE-F1-4. NC2364.2 +041900 SCH-DELETE-F1-4. NC2364.2 +042000 PERFORM DE-LETE. NC2364.2 +042100 GO TO SCH-WRITE-F1-4. NC2364.2 +042200 SCH-FAIL-F1-4. NC2364.2 +042300 IF ELMT-A (07) EQUAL TO 07 NC2364.2 +042400 MOVE 07 TO CORRECT-18V0 NC2364.2 +042500 MOVE ELMT-A (07) TO COMPUTED-18V0 NC2364.2 +042600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +042700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +042800 MOVE ELMT-A (07) TO COMPUTED-18V0 NC2364.2 +042900 MOVE 07 TO CORRECT-18V0. NC2364.2 +043000 PERFORM FAIL. NC2364.2 +043100 SCH-WRITE-F1-4. NC2364.2 +043200 PERFORM PRINT-DETAIL. NC2364.2 +043300* NC2364.2 +043400 SCH-INIT-F1-5. NC2364.2 +043500 MOVE "SCH-TEST-F1-5" TO PAR-NAME. NC2364.2 +043600 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +043700 MOVE "SEARCH " TO FEATURE. NC2364.2 +043800 SET A TO 03. NC2364.2 +043900 SET W TO A. NC2364.2 +044000 SCH-TEST-F1-5. NC2364.2 +044100 SEARCH TBL-A VARYING W AT END GO TO SCH-FAIL-F1-5 NC2364.2 +044200 WHEN ELMT-A (A) EQUAL TO 08 NC2364.2 +044300 SET A TO W. NC2364.2 +044400 IF ELMT-A (A) EQUAL TO 08 NC2364.2 +044500 PERFORM PASS NC2364.2 +044600 GO TO SCH-WRITE-F1-5. NC2364.2 +044700 SCH-DELETE-F1-5. NC2364.2 +044800 PERFORM DE-LETE. NC2364.2 +044900 GO TO SCH-WRITE-F1-5. NC2364.2 +045000 SCH-FAIL-F1-5. NC2364.2 +045100 IF ELMT-A (08) EQUAL TO 08 NC2364.2 +045200 MOVE 08 TO CORRECT-18V0 NC2364.2 +045300 MOVE ELMT-A (08) TO COMPUTED-18V0 NC2364.2 +045400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +045500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +045600 MOVE ELMT-A (08) TO COMPUTED-18V0 NC2364.2 +045700 MOVE 08 TO CORRECT-18V0. NC2364.2 +045800 PERFORM FAIL. NC2364.2 +045900 SCH-WRITE-F1-5. NC2364.2 +046000 PERFORM PRINT-DETAIL. NC2364.2 +046100* NC2364.2 +046200 SCH-INIT-F1-6. NC2364.2 +046300 MOVE "SCH-TEST-F1-6" TO PAR-NAME. NC2364.2 +046400 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +046500 MOVE "SEARCH " TO FEATURE. NC2364.2 +046600 SET A B TO 01. NC2364.2 +046700 SCH-TEST-F1-6. NC2364.2 +046800 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-6 NC2364.2 +046900 WHEN ELMT-B (B) EQUAL TO ELMT-A (8) NC2364.2 +047000 PERFORM PASS NC2364.2 +047100 GO TO SCH-WRITE-F1-6. NC2364.2 +047200 SCH-DELETE-F1-6. NC2364.2 +047300 PERFORM DE-LETE. NC2364.2 +047400 GO TO SCH-WRITE-F1-6. NC2364.2 +047500 SCH-FAIL-F1-6. NC2364.2 +047600 IF ELMT-B (8) EQUAL TO ELMT-A (8) NC2364.2 +047700 MOVE 08 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +047800 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +047900 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +048000 MOVE ELMT-B (8) TO COMPUTED-18V0 NC2364.2 +048100 MOVE ELMT-A (8) TO CORRECT-18V0. NC2364.2 +048200 PERFORM FAIL. NC2364.2 +048300 SCH-WRITE-F1-6. NC2364.2 +048400 PERFORM PRINT-DETAIL. NC2364.2 +048500* NC2364.2 +048600 SCH-INIT-F1-7. NC2364.2 +048700 MOVE "SCH-TEST-F1-7" TO PAR-NAME. NC2364.2 +048800 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +048900 MOVE "SEARCH " TO FEATURE. NC2364.2 +049000 SET A B TO 05. NC2364.2 +049100 SCH-TEST-F1-7. NC2364.2 +049200 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-7 NC2364.2 +049300 WHEN ELMT-B (B) EQUAL TO ELMT-A (10) NC2364.2 +049400 PERFORM PASS NC2364.2 +049500 GO TO SCH-WRITE-F1-7. NC2364.2 +049600 SCH-DELETE-F1-7. NC2364.2 +049700 PERFORM DE-LETE. NC2364.2 +049800 GO TO SCH-WRITE-F1-6. NC2364.2 +049900 SCH-FAIL-F1-7. NC2364.2 +050000 IF ELMT-B (10) EQUAL TO ELMT-A (10) NC2364.2 +050100 MOVE 10 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +050200 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +050300 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +050400 MOVE ELMT-B (10) TO COMPUTED-18V0 NC2364.2 +050500 MOVE ELMT-A (10) TO CORRECT-18V0. NC2364.2 +050600 PERFORM FAIL. NC2364.2 +050700 SCH-WRITE-F1-7. NC2364.2 +050800 PERFORM PRINT-DETAIL. NC2364.2 +050900* NC2364.2 +051000 SCH-INIT-F1-8. NC2364.2 +051100 MOVE "SCH-TEST-F1-8" TO PAR-NAME. NC2364.2 +051200 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +051300 MOVE "SEARCH " TO FEATURE. NC2364.2 +051400 SET A B TO 09. NC2364.2 +051500 SCH-TEST-F1-8. NC2364.2 +051600 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-8 NC2364.2 +051700 WHEN ELMT-B (09) EQUAL TO ELMT-A (A) NC2364.2 +051800 PERFORM PASS NC2364.2 +051900 GO TO SCH-WRITE-F1-8. NC2364.2 +052000 SCH-DELETE-F1-8. NC2364.2 +052100 PERFORM DE-LETE. NC2364.2 +052200 GO TO SCH-WRITE-F1-8. NC2364.2 +052300 SCH-FAIL-F1-8. NC2364.2 +052400 IF ELMT-B (09) EQUAL TO ELMT-A (09) NC2364.2 +052500 MOVE 09 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +052600 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +052700 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +052800 MOVE ELMT-B (09) TO COMPUTED-18V0 NC2364.2 +052900 MOVE ELMT-A (09) TO CORRECT-18V0. NC2364.2 +053000 PERFORM FAIL. NC2364.2 +053100 SCH-WRITE-F1-8. NC2364.2 +053200 PERFORM PRINT-DETAIL. NC2364.2 +053300* NC2364.2 +053400 SCH-INIT-F1-9. NC2364.2 +053500 MOVE "SCH-TEST-F1-9" TO PAR-NAME. NC2364.2 +053600 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +053700 MOVE "SEARCH " TO FEATURE. NC2364.2 +053800 SET A B TO 3. NC2364.2 +053900 SCH-TEST-F1-9. NC2364.2 +054000 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-9 NC2364.2 +054100 WHEN ELMT-B (B) EQUAL TO ELMT-A (A) NC2364.2 +054200 PERFORM PASS NC2364.2 +054300 GO TO SCH-WRITE-F1-9. NC2364.2 +054400 SCH-DELETE-F1-9. NC2364.2 +054500 PERFORM DE-LETE. NC2364.2 +054600 GO TO SCH-WRITE-F1-9. NC2364.2 +054700 SCH-FAIL-F1-9. NC2364.2 +054800 IF ELMT-B (3) EQUAL TO ELMT-A (3) NC2364.2 +054900 MOVE 03 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +055000 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +055100 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +055200 MOVE ELMT-B (3) TO COMPUTED-18V0 NC2364.2 +055300 MOVE ELMT-A (3) TO CORRECT-18V0. NC2364.2 +055400 PERFORM FAIL. NC2364.2 +055500 SCH-WRITE-F1-9. NC2364.2 +055600 PERFORM PRINT-DETAIL. NC2364.2 +055700* NC2364.2 +055800 SCH-INIT-F1-10. NC2364.2 +055900 MOVE "SCH-TEST-F1-10" TO PAR-NAME. NC2364.2 +056000 MOVE "VI-121 6.21.6" TO ANSI-REFERENCE. NC2364.2 +056100 MOVE "SEARCH " TO FEATURE. NC2364.2 +056200 SET A B TO 06. NC2364.2 +056300 SCH-TEST-F1-10. NC2364.2 +056400 SEARCH TBL-B VARYING A AT END GO TO SCH-FAIL-F1-10 NC2364.2 +056500 WHEN ELMT-B (9) EQUAL TO ELMT-A (9) NC2364.2 +056600 PERFORM PASS NC2364.2 +056700 GO TO SCH-WRITE-F1-10. NC2364.2 +056800 SCH-DELETE-F1-10. NC2364.2 +056900 PERFORM DE-LETE. NC2364.2 +057000 GO TO SCH-WRITE-F1-10. NC2364.2 +057100 SCH-FAIL-F1-10. NC2364.2 +057200 IF ELMT-B (9) EQUAL TO ELMT-A (9) NC2364.2 +057300 MOVE 09 TO CORRECT-18V0 COMPUTED-18V0 NC2364.2 +057400 MOVE "SEE NOTE 1 FOR DIAGNOSTIC" TO RE-MARK ELSE NC2364.2 +057500 MOVE "SEE NOTE 2 FOR DIAGNOSTIC" TO RE-MARK NC2364.2 +057600 MOVE ELMT-B (9) TO COMPUTED-18V0 NC2364.2 +057700 MOVE ELMT-A (9) TO CORRECT-18V0. NC2364.2 +057800 PERFORM FAIL. NC2364.2 +057900 SCH-WRITE-F1-10. NC2364.2 +058000 PERFORM PRINT-DETAIL. NC2364.2 +058100* NC2364.2 +058200 CCVS-EXIT SECTION. NC2364.2 +058300 CCVS-999999. NC2364.2 +058400 GO TO CLOSE-FILES. NC2364.2 diff --git a/tests/cobol85/NC/NC237A.CBL b/tests/cobol85/NC/NC237A.CBL new file mode 100755 index 00000000..7a6383fa --- /dev/null +++ b/tests/cobol85/NC/NC237A.CBL @@ -0,0 +1,661 @@ +000100 IDENTIFICATION DIVISION. NC2374.2 +000200 PROGRAM-ID. NC2374.2 +000300 NC237A. NC2374.2 +000400**************************************************************** NC2374.2 +000500* * NC2374.2 +000600* VALIDATION FOR:- * NC2374.2 +000700* * NC2374.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2374.2 +000900* * NC2374.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2374.2 +001100* * NC2374.2 +001200**************************************************************** NC2374.2 +001300* * NC2374.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2374.2 +001500* * NC2374.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2374.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2374.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2374.2 +001900* * NC2374.2 +002000**************************************************************** NC2374.2 +002100 NC2374.2 +002200* NC2374.2 +002300* PROGRAM NC237A TESTS FORMAT 2 OF THE "SEARCH" STATEMENT * NC2374.2 +002400* WITH A THREE-DIMENSIONAL TABLE CONTAINING ASCENDING AND * NC2374.2 +002500* DESCENDING KEYS. * NC2374.2 +002600* * NC2374.2 +002700**************************************************************** NC2374.2 +002800 ENVIRONMENT DIVISION. NC2374.2 +002900 CONFIGURATION SECTION. NC2374.2 +003000 SOURCE-COMPUTER. NC2374.2 +003100 Linux. NC2374.2 +003200 OBJECT-COMPUTER. NC2374.2 +003300 Linux. NC2374.2 +003400 INPUT-OUTPUT SECTION. NC2374.2 +003500 FILE-CONTROL. NC2374.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2374.2 +003700 "report.log". NC2374.2 +003800 DATA DIVISION. NC2374.2 +003900 FILE SECTION. NC2374.2 +004000 FD PRINT-FILE. NC2374.2 +004100 01 PRINT-REC PICTURE X(120). NC2374.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2374.2 +004300 WORKING-STORAGE SECTION. NC2374.2 +004400 77 IDENT-1 PICTURE S9(18) VALUE ZERO COMPUTATIONAL. NC2374.2 +004500 77 IDENT-2 PICTURE S9(18) VALUE ZERO COMPUTATIONAL. NC2374.2 +004600 77 IDENT-3 PICTURE S9(18) VALUE ZERO COMPUTATIONAL. NC2374.2 +004700 77 IDENT-4 PICTURE 9 VALUE ZERO COMPUTATIONAL. NC2374.2 +004800 77 IDENT-5 PICTURE 9 VALUE ZERO COMPUTATIONAL. NC2374.2 +004900 77 IDENT-6 PICTURE 9(18) VALUE 3. NC2374.2 +005000 77 IDENT-7 PICTURE 9(18) VALUE 1. NC2374.2 +005100 77 IDENT-8 PICTURE 9 VALUE 6. NC2374.2 +005200 77 IDENT-9 PICTURE 9 VALUE 5. NC2374.2 +005300 01 TABLE-TH310. NC2374.2 +005400 02 ENTRY-310 OCCURS 9 TIMES ASCENDING GRP NC2374.2 +005500 INDEXED BY IDX-1. NC2374.2 +005600 03 ENTRY-1. NC2374.2 +005700 04 GRP PIC 99. NC2374.2 +005800 03 ENTRY-310-2 OCCURS 9 ASCENDING KEY GRP-1 NC2374.2 +005900 DESCENDING KEY IS SEC INDEXED BY IDX-2. NC2374.2 +006000 04 ENTRY-2. NC2374.2 +006100 05 GRP-1 PIC 99. NC2374.2 +006200 05 SEC PIC 99. NC2374.2 +006300 04 ENTRY-310-3 OCCURS 9 TIMES ASCENDING IS GRP-2 NC2374.2 +006400 DESCENDING KEY SEC-1 ASCENDING ELEM INDEXED IDX-3. NC2374.2 +006500 05 ENTRY-3. NC2374.2 +006600 06 GRP-2 PICTURE 99. NC2374.2 +006700 06 SEC-1 PICTURE 99. NC2374.2 +006800 06 ELEM PICTURE 99. NC2374.2 +006900 01 ENTRIES-X. NC2374.2 +007000 02 ONE-99 PICTURE 99 VALUE 01. NC2374.2 +007100 02 TWO-99 PICTURE 99 VALUE 09. NC2374.2 +007200 02 THREE-99 PICTURE 99 VALUE 01. NC2374.2 +007300 01 CT PICTURE 999 VALUE 111. NC2374.2 +007400 01 SU REDEFINES CT. NC2374.2 +007500 02 S1 PICTURE 9. NC2374.2 +007600 02 S2 PICTURE 9. NC2374.2 +007700 02 S3 PICTURE 9. NC2374.2 +007800 01 TEST-RESULTS. NC2374.2 +007900 02 FILLER PIC X VALUE SPACE. NC2374.2 +008000 02 FEATURE PIC X(20) VALUE SPACE. NC2374.2 +008100 02 FILLER PIC X VALUE SPACE. NC2374.2 +008200 02 P-OR-F PIC X(5) VALUE SPACE. NC2374.2 +008300 02 FILLER PIC X VALUE SPACE. NC2374.2 +008400 02 PAR-NAME. NC2374.2 +008500 03 FILLER PIC X(19) VALUE SPACE. NC2374.2 +008600 03 PARDOT-X PIC X VALUE SPACE. NC2374.2 +008700 03 DOTVALUE PIC 99 VALUE ZERO. NC2374.2 +008800 02 FILLER PIC X(8) VALUE SPACE. NC2374.2 +008900 02 RE-MARK PIC X(61). NC2374.2 +009000 01 TEST-COMPUTED. NC2374.2 +009100 02 FILLER PIC X(30) VALUE SPACE. NC2374.2 +009200 02 FILLER PIC X(17) VALUE NC2374.2 +009300 " COMPUTED=". NC2374.2 +009400 02 COMPUTED-X. NC2374.2 +009500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2374.2 +009600 03 COMPUTED-N REDEFINES COMPUTED-A NC2374.2 +009700 PIC -9(9).9(9). NC2374.2 +009800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2374.2 +009900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2374.2 +010000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2374.2 +010100 03 CM-18V0 REDEFINES COMPUTED-A. NC2374.2 +010200 04 COMPUTED-18V0 PIC -9(18). NC2374.2 +010300 04 FILLER PIC X. NC2374.2 +010400 03 FILLER PIC X(50) VALUE SPACE. NC2374.2 +010500 01 TEST-CORRECT. NC2374.2 +010600 02 FILLER PIC X(30) VALUE SPACE. NC2374.2 +010700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2374.2 +010800 02 CORRECT-X. NC2374.2 +010900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2374.2 +011000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2374.2 +011100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2374.2 +011200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2374.2 +011300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2374.2 +011400 03 CR-18V0 REDEFINES CORRECT-A. NC2374.2 +011500 04 CORRECT-18V0 PIC -9(18). NC2374.2 +011600 04 FILLER PIC X. NC2374.2 +011700 03 FILLER PIC X(2) VALUE SPACE. NC2374.2 +011800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2374.2 +011900 01 CCVS-C-1. NC2374.2 +012000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2374.2 +012100- "SS PARAGRAPH-NAME NC2374.2 +012200- " REMARKS". NC2374.2 +012300 02 FILLER PIC X(20) VALUE SPACE. NC2374.2 +012400 01 CCVS-C-2. NC2374.2 +012500 02 FILLER PIC X VALUE SPACE. NC2374.2 +012600 02 FILLER PIC X(6) VALUE "TESTED". NC2374.2 +012700 02 FILLER PIC X(15) VALUE SPACE. NC2374.2 +012800 02 FILLER PIC X(4) VALUE "FAIL". NC2374.2 +012900 02 FILLER PIC X(94) VALUE SPACE. NC2374.2 +013000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2374.2 +013100 01 REC-CT PIC 99 VALUE ZERO. NC2374.2 +013200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2374.2 +013300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2374.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2374.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2374.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2374.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2374.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2374.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2374.2 +014000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2374.2 +014100 01 CCVS-H-1. NC2374.2 +014200 02 FILLER PIC X(39) VALUE SPACES. NC2374.2 +014300 02 FILLER PIC X(42) VALUE NC2374.2 +014400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2374.2 +014500 02 FILLER PIC X(39) VALUE SPACES. NC2374.2 +014600 01 CCVS-H-2A. NC2374.2 +014700 02 FILLER PIC X(40) VALUE SPACE. NC2374.2 +014800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2374.2 +014900 02 FILLER PIC XXXX VALUE NC2374.2 +015000 "4.2 ". NC2374.2 +015100 02 FILLER PIC X(28) VALUE NC2374.2 +015200 " COPY - NOT FOR DISTRIBUTION". NC2374.2 +015300 02 FILLER PIC X(41) VALUE SPACE. NC2374.2 +015400 NC2374.2 +015500 01 CCVS-H-2B. NC2374.2 +015600 02 FILLER PIC X(15) VALUE NC2374.2 +015700 "TEST RESULT OF ". NC2374.2 +015800 02 TEST-ID PIC X(9). NC2374.2 +015900 02 FILLER PIC X(4) VALUE NC2374.2 +016000 " IN ". NC2374.2 +016100 02 FILLER PIC X(12) VALUE NC2374.2 +016200 " HIGH ". NC2374.2 +016300 02 FILLER PIC X(22) VALUE NC2374.2 +016400 " LEVEL VALIDATION FOR ". NC2374.2 +016500 02 FILLER PIC X(58) VALUE NC2374.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2374.2 +016700 01 CCVS-H-3. NC2374.2 +016800 02 FILLER PIC X(34) VALUE NC2374.2 +016900 " FOR OFFICIAL USE ONLY ". NC2374.2 +017000 02 FILLER PIC X(58) VALUE NC2374.2 +017100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2374.2 +017200 02 FILLER PIC X(28) VALUE NC2374.2 +017300 " COPYRIGHT 1985 ". NC2374.2 +017400 01 CCVS-E-1. NC2374.2 +017500 02 FILLER PIC X(52) VALUE SPACE. NC2374.2 +017600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2374.2 +017700 02 ID-AGAIN PIC X(9). NC2374.2 +017800 02 FILLER PIC X(45) VALUE SPACES. NC2374.2 +017900 01 CCVS-E-2. NC2374.2 +018000 02 FILLER PIC X(31) VALUE SPACE. NC2374.2 +018100 02 FILLER PIC X(21) VALUE SPACE. NC2374.2 +018200 02 CCVS-E-2-2. NC2374.2 +018300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2374.2 +018400 03 FILLER PIC X VALUE SPACE. NC2374.2 +018500 03 ENDER-DESC PIC X(44) VALUE NC2374.2 +018600 "ERRORS ENCOUNTERED". NC2374.2 +018700 01 CCVS-E-3. NC2374.2 +018800 02 FILLER PIC X(22) VALUE NC2374.2 +018900 " FOR OFFICIAL USE ONLY". NC2374.2 +019000 02 FILLER PIC X(12) VALUE SPACE. NC2374.2 +019100 02 FILLER PIC X(58) VALUE NC2374.2 +019200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2374.2 +019300 02 FILLER PIC X(13) VALUE SPACE. NC2374.2 +019400 02 FILLER PIC X(15) VALUE NC2374.2 +019500 " COPYRIGHT 1985". NC2374.2 +019600 01 CCVS-E-4. NC2374.2 +019700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2374.2 +019800 02 FILLER PIC X(4) VALUE " OF ". NC2374.2 +019900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2374.2 +020000 02 FILLER PIC X(40) VALUE NC2374.2 +020100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2374.2 +020200 01 XXINFO. NC2374.2 +020300 02 FILLER PIC X(19) VALUE NC2374.2 +020400 "*** INFORMATION ***". NC2374.2 +020500 02 INFO-TEXT. NC2374.2 +020600 04 FILLER PIC X(8) VALUE SPACE. NC2374.2 +020700 04 XXCOMPUTED PIC X(20). NC2374.2 +020800 04 FILLER PIC X(5) VALUE SPACE. NC2374.2 +020900 04 XXCORRECT PIC X(20). NC2374.2 +021000 02 INF-ANSI-REFERENCE PIC X(48). NC2374.2 +021100 01 HYPHEN-LINE. NC2374.2 +021200 02 FILLER PIC IS X VALUE IS SPACE. NC2374.2 +021300 02 FILLER PIC IS X(65) VALUE IS "************************NC2374.2 +021400- "*****************************************". NC2374.2 +021500 02 FILLER PIC IS X(54) VALUE IS "************************NC2374.2 +021600- "******************************". NC2374.2 +021700 01 CCVS-PGM-ID PIC X(9) VALUE NC2374.2 +021800 "NC237A". NC2374.2 +021900 PROCEDURE DIVISION. NC2374.2 +022000 CCVS1 SECTION. NC2374.2 +022100 OPEN-FILES. NC2374.2 +022200 OPEN OUTPUT PRINT-FILE. NC2374.2 +022300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2374.2 +022400 MOVE SPACE TO TEST-RESULTS. NC2374.2 +022500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2374.2 +022600 GO TO CCVS1-EXIT. NC2374.2 +022700 CLOSE-FILES. NC2374.2 +022800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2374.2 +022900 TERMINATE-CCVS. NC2374.2 +023000*S EXIT PROGRAM. NC2374.2 +023100*SERMINATE-CALL. NC2374.2 +023200 STOP RUN. NC2374.2 +023300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2374.2 +023400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2374.2 +023500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2374.2 +023600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2374.2 +023700 MOVE "****TEST DELETED****" TO RE-MARK. NC2374.2 +023800 PRINT-DETAIL. NC2374.2 +023900 IF REC-CT NOT EQUAL TO ZERO NC2374.2 +024000 MOVE "." TO PARDOT-X NC2374.2 +024100 MOVE REC-CT TO DOTVALUE. NC2374.2 +024200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2374.2 +024300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2374.2 +024400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2374.2 +024500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2374.2 +024600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2374.2 +024700 MOVE SPACE TO CORRECT-X. NC2374.2 +024800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2374.2 +024900 MOVE SPACE TO RE-MARK. NC2374.2 +025000 HEAD-ROUTINE. NC2374.2 +025100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +025200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +025300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2374.2 +025400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2374.2 +025500 COLUMN-NAMES-ROUTINE. NC2374.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +025900 END-ROUTINE. NC2374.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2374.2 +026100 END-RTN-EXIT. NC2374.2 +026200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +026300 END-ROUTINE-1. NC2374.2 +026400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2374.2 +026500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2374.2 +026600 ADD PASS-COUNTER TO ERROR-HOLD. NC2374.2 +026700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2374.2 +026800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2374.2 +026900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2374.2 +027000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2374.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2374.2 +027200 END-ROUTINE-12. NC2374.2 +027300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2374.2 +027400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2374.2 +027500 MOVE "NO " TO ERROR-TOTAL NC2374.2 +027600 ELSE NC2374.2 +027700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2374.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2374.2 +027900 PERFORM WRITE-LINE. NC2374.2 +028000 END-ROUTINE-13. NC2374.2 +028100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2374.2 +028200 MOVE "NO " TO ERROR-TOTAL ELSE NC2374.2 +028300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2374.2 +028400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2374.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +028600 IF INSPECT-COUNTER EQUAL TO ZERO NC2374.2 +028700 MOVE "NO " TO ERROR-TOTAL NC2374.2 +028800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2374.2 +028900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2374.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +029100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2374.2 +029200 WRITE-LINE. NC2374.2 +029300 ADD 1 TO RECORD-COUNT. NC2374.2 +029400 IF RECORD-COUNT GREATER 50 NC2374.2 +029500 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2374.2 +029600 MOVE SPACE TO DUMMY-RECORD NC2374.2 +029700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2374.2 +029800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2374.2 +029900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2374.2 +030000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2374.2 +030100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2374.2 +030200 MOVE ZERO TO RECORD-COUNT. NC2374.2 +030300 PERFORM WRT-LN. NC2374.2 +030400 WRT-LN. NC2374.2 +030500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2374.2 +030600 MOVE SPACE TO DUMMY-RECORD. NC2374.2 +030700 BLANK-LINE-PRINT. NC2374.2 +030800 PERFORM WRT-LN. NC2374.2 +030900 FAIL-ROUTINE. NC2374.2 +031000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2374.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2374.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2374.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2374.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2374.2 +031600 GO TO FAIL-ROUTINE-EX. NC2374.2 +031700 FAIL-ROUTINE-WRITE. NC2374.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2374.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2374.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2374.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2374.2 +032200 FAIL-ROUTINE-EX. EXIT. NC2374.2 +032300 BAIL-OUT. NC2374.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2374.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2374.2 +032600 BAIL-OUT-WRITE. NC2374.2 +032700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2374.2 +032800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2374.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2374.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2374.2 +033100 BAIL-OUT-EX. EXIT. NC2374.2 +033200 CCVS1-EXIT. NC2374.2 +033300 EXIT. NC2374.2 +033400 SECT-NC237A-001 SECTION. NC2374.2 +033500 TH-10-001. NC2374.2 +033600* NC2374.2 +033700 BUILD-3DEM-TABLE. NC2374.2 +033800 MOVE "PERFORM VARYING" TO FEATURE. NC2374.2 +033900 SET IDX-1, IDX-2, IDX-3 TO 1. NC2374.2 +034000 PERFORM BUILD-TABLE THRU BUILD-EXIT VARYING ONE-99 FROM 1 NC2374.2 +034100 BY 1 UNTIL ONE-99 EQUAL TO 10 AFTER TWO-99 FROM 9 BY -1 NC2374.2 +034200 UNTIL TWO-99 EQUAL TO 0 AFTER THREE-99 FROM 1 BY 1 NC2374.2 +034300 UNTIL THREE-99 EQUAL TO 10. NC2374.2 +034400 GO TO IDX-INIT-GF-1. NC2374.2 +034500* NC2374.2 +034600 BUILD-TABLE. NC2374.2 +034700 MOVE ONE-99 TO GRP (IDX-1), GRP-1 (IDX-1, IDX-2), NC2374.2 +034800 GRP-2 (IDX-1, IDX-2, IDX-3). NC2374.2 +034900 MOVE TWO-99 TO SEC (IDX-1, IDX-2) SEC-1 (IDX-1, IDX-2, IDX-3)NC2374.2 +035000 MOVE THREE-99 TO ELEM (IDX-1, IDX-2, IDX-3). NC2374.2 +035100 IF CT = 999 NC2374.2 +035200 MOVE 0 TO CT NC2374.2 +035300 ELSE NC2374.2 +035400 ADD 1 TO CT. NC2374.2 +035500 IF S3 EQUAL TO 0 ADD 1 TO S3. NC2374.2 +035600 IF S2 EQUAL TO 0 ADD 1 TO S2. NC2374.2 +035700 IF S1 EQUAL TO 0 ADD 1 TO S1. NC2374.2 +035800 SET IDX-1 TO S1. NC2374.2 +035900 SET IDX-2 TO S2. NC2374.2 +036000 SET IDX-3 TO S3. NC2374.2 +036100 BUILD-EXIT. NC2374.2 +036200 EXIT. NC2374.2 +036300* NC2374.2 +036400 IDX-INIT-GF-1. NC2374.2 +036500 MOVE "IDX-TEST-GF-1" TO PAR-NAME. NC2374.2 +036600 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +036700 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +036800 IDX-TEST-GF-1. NC2374.2 +036900 IF ENTRY-3 (9, 9, 9) EQUAL TO 090109 NC2374.2 +037000 PERFORM PASS NC2374.2 +037100 MOVE "TABLE BUILT CORRECTLY" TO RE-MARK NC2374.2 +037200 GO TO IDX-WRITE-GF-1. NC2374.2 +037300 GO TO IDX-FAIL-GF-1. NC2374.2 +037400 IDX-DELETE-GF-1. NC2374.2 +037500 PERFORM DE-LETE. NC2374.2 +037600 GO TO IDX-WRITE-GF-1. NC2374.2 +037700 IDX-FAIL-GF-1. NC2374.2 +037800 MOVE "TABLE CREATED INCORRECTLY" TO RE-MARK. NC2374.2 +037900 PERFORM FAIL. NC2374.2 +038000 IDX-WRITE-GF-1. NC2374.2 +038100 PERFORM PRINT-DETAIL. NC2374.2 +038200* NC2374.2 +038300 IDX-INIT-GF-2. NC2374.2 +038400 MOVE "IDX-TEST-GF-2 " TO PAR-NAME. NC2374.2 +038500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +038600 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +038700 MOVE 7 TO IDENT-1. NC2374.2 +038800 SET IDX-1 IDX-2 IDX-3 TO IDENT-1. NC2374.2 +038900 SET IDX-1 IDX-3 DOWN BY IDENT-6. NC2374.2 +039000 IDX-TEST-GF-2. NC2374.2 +039100 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) EQUAL TO 040304 NC2374.2 +039200 PERFORM PASS NC2374.2 +039300 GO TO IDX-WRITE-GF-2. NC2374.2 +039400 GO TO IDX-FAIL-GF-2. NC2374.2 +039500 IDX-DELETE-GF-2. NC2374.2 +039600 PERFORM DE-LETE. NC2374.2 +039700 GO TO IDX-WRITE-GF-2. NC2374.2 +039800 IDX-FAIL-GF-2. NC2374.2 +039900 MOVE "040304" TO CORRECT-A. NC2374.2 +040000 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A. NC2374.2 +040100 PERFORM FAIL. NC2374.2 +040200 IDX-WRITE-GF-2. NC2374.2 +040300 PERFORM PRINT-DETAIL. NC2374.2 +040400* NC2374.2 +040500 IDX-INIT-GF-3. NC2374.2 +040600 MOVE "IDX-TEST-GF-3" TO PAR-NAME. NC2374.2 +040700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +040800 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +040900 MOVE 4 TO IDENT-1. NC2374.2 +041000 SET IDX-1 TO IDENT-7. NC2374.2 +041100 SET IDX-1 UP BY IDENT-1. NC2374.2 +041200 IDX-TEST-GF-3. NC2374.2 +041300 IF ENTRY-1 (IDX-1) EQUAL TO "05" NC2374.2 +041400 PERFORM PASS NC2374.2 +041500 GO TO IDX-WRITE-GF-3. NC2374.2 +041600 GO TO IDX-FAIL-GF-3. NC2374.2 +041700 IDX-DELETE-GF-3. NC2374.2 +041800 PERFORM DE-LETE. NC2374.2 +041900 GO TO IDX-WRITE-GF-3. NC2374.2 +042000 IDX-FAIL-GF-3. NC2374.2 +042100 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A. NC2374.2 +042200 MOVE "05" TO CORRECT-A. NC2374.2 +042300 PERFORM FAIL. NC2374.2 +042400 IDX-WRITE-GF-3. NC2374.2 +042500 PERFORM PRINT-DETAIL. NC2374.2 +042600* NC2374.2 +042700 IDX-INIT-GF-4. NC2374.2 +042800 MOVE "IDX-TEST-GF-4" TO PAR-NAME. NC2374.2 +042900 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +043000 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +043100 MOVE 1 TO IDENT-1. NC2374.2 +043200 SET IDX-1 IDX-2 TO IDENT-1. NC2374.2 +043300 SET IDX-2 UP BY IDENT-9. NC2374.2 +043400 SET IDX-2 UP BY IDENT-6. NC2374.2 +043500 IDX-TEST-GF-4. NC2374.2 +043600 IF ENTRY-2 (IDX-1, IDX-2) EQUAL TO "0101" NC2374.2 +043700 PERFORM PASS NC2374.2 +043800 GO TO IDX-WRITE-GF-4. NC2374.2 +043900 GO TO IDX-FAIL-GF-4. NC2374.2 +044000 IDX-DELETE-GF-4. NC2374.2 +044100 PERFORM DE-LETE. NC2374.2 +044200 GO TO IDX-WRITE-GF-4. NC2374.2 +044300 IDX-FAIL-GF-4. NC2374.2 +044400 MOVE "0101" TO CORRECT-A. NC2374.2 +044500 MOVE ENTRY-2 (IDX-1, IDX-2) TO COMPUTED-A. NC2374.2 +044600 PERFORM FAIL. NC2374.2 +044700 IDX-WRITE-GF-4. NC2374.2 +044800 PERFORM PRINT-DETAIL. NC2374.2 +044900* NC2374.2 +045000 IDX-INIT-GF-5. NC2374.2 +045100 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +045200 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +045300 MOVE "IDX-TEST-GF-5" TO PAR-NAME. NC2374.2 +045400 MOVE 1 TO IDENT-1. NC2374.2 +045500 SET IDX-1 TO IDENT-6. NC2374.2 +045600 SET IDX-1 UP BY IDENT-1. NC2374.2 +045700 IDX-TEST-GF-5. NC2374.2 +045800 IF ENTRY-1 (IDX-1) EQUAL TO 04 NC2374.2 +045900 PERFORM PASS NC2374.2 +046000 GO TO IDX-WRITE-GF-5. NC2374.2 +046100 GO TO IDX-FAIL-GF-5. NC2374.2 +046200 IDX-DELETE-GF-5. NC2374.2 +046300 PERFORM DE-LETE. NC2374.2 +046400 GO TO IDX-WRITE-GF-5. NC2374.2 +046500 IDX-FAIL-GF-5. NC2374.2 +046600 MOVE "04" TO CORRECT-A. NC2374.2 +046700 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A. NC2374.2 +046800 PERFORM FAIL. NC2374.2 +046900 IDX-WRITE-GF-5. NC2374.2 +047000 PERFORM PRINT-DETAIL. NC2374.2 +047100* NC2374.2 +047200 IDX-INIT-GF-6. NC2374.2 +047300 MOVE "IDX-TEST-GF-6" TO PAR-NAME. NC2374.2 +047400 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +047500 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +047600 SET IDX-3 TO 4. NC2374.2 +047700 SET IDX-1 IDX-2 TO IDX-3. NC2374.2 +047800 SET IDX-1 IDX-2 IDX-3 DOWN BY IDENT-7. NC2374.2 +047900 MOVE 4 TO IDENT-1. NC2374.2 +048000 SET IDX-1 IDX-2 IDX-3 UP BY IDENT-1. NC2374.2 +048100 IDX-TEST-GF-6. NC2374.2 +048200 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) EQUAL TO "070307" NC2374.2 +048300 PERFORM PASS NC2374.2 +048400 GO TO IDX-WRITE-GF-6. NC2374.2 +048500 GO TO IDX-FAIL-GF-6. NC2374.2 +048600 IDX-DELETE-GF-6. NC2374.2 +048700 PERFORM DE-LETE. NC2374.2 +048800 GO TO IDX-WRITE-GF-6. NC2374.2 +048900 IDX-FAIL-GF-6. NC2374.2 +049000 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A. NC2374.2 +049100 MOVE "070307" TO CORRECT-A. NC2374.2 +049200 PERFORM FAIL. NC2374.2 +049300 IDX-WRITE-GF-6. NC2374.2 +049400 PERFORM PRINT-DETAIL. NC2374.2 +049500* NC2374.2 +049600 IDX-INIT-GF-7. NC2374.2 +049700 MOVE "IDX-TEST-GF-7" TO PAR-NAME. NC2374.2 +049800 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +049900 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +050000 MOVE 3 TO IDENT-1 IDENT-2 IDENT-4. NC2374.2 +050100 SET IDX-1 TO IDENT-1. NC2374.2 +050200 SET IDX-2 TO IDENT-2. NC2374.2 +050300 SET IDX-3 TO IDENT-4. NC2374.2 +050400 SET IDX-1 IDX-2 IDX-3 UP BY IDENT-7. NC2374.2 +050500 IDX-TEST-GF-7. NC2374.2 +050600 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) EQUAL TO "040604" NC2374.2 +050700 PERFORM PASS NC2374.2 +050800 GO TO IDX-WRITE-GF-7. NC2374.2 +050900 GO TO IDX-FAIL-GF-7. NC2374.2 +051000 IDX-DELETE-GF-7. NC2374.2 +051100 PERFORM DE-LETE. NC2374.2 +051200 GO TO IDX-WRITE-GF-7. NC2374.2 +051300 IDX-FAIL-GF-7. NC2374.2 +051400 MOVE "040604" TO CORRECT-A. NC2374.2 +051500 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A. NC2374.2 +051600 PERFORM FAIL. NC2374.2 +051700 IDX-WRITE-GF-7. NC2374.2 +051800 PERFORM PRINT-DETAIL. NC2374.2 +051900* NC2374.2 +052000 IDX-INIT-GF-8. NC2374.2 +052100 MOVE "IDX-TEST-GF-8" TO PAR-NAME. NC2374.2 +052200 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +052300 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +052400 MOVE 9 TO IDENT-1. NC2374.2 +052500 SET IDX-1, IDX-2, IDX-3 TO IDENT-1. NC2374.2 +052600 SET IDX-1, IDX-2, IDX-3 DOWN BY 5. NC2374.2 +052700 IDX-TEST-GF-8. NC2374.2 +052800 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) EQUAL TO "040604" NC2374.2 +052900 PERFORM PASS NC2374.2 +053000 GO TO IDX-WRITE-GF-8. NC2374.2 +053100 GO TO IDX-FAIL-GF-8. NC2374.2 +053200 IDX-DELETE-GF-8. NC2374.2 +053300 PERFORM DE-LETE. NC2374.2 +053400 GO TO IDX-WRITE-GF-8. NC2374.2 +053500 IDX-FAIL-GF-8. NC2374.2 +053600 MOVE "040604" TO CORRECT-A. NC2374.2 +053700 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A. NC2374.2 +053800 PERFORM FAIL. NC2374.2 +053900 IDX-WRITE-GF-8. NC2374.2 +054000 PERFORM PRINT-DETAIL. NC2374.2 +054100* NC2374.2 +054200 IDX-INIT-F2-9. NC2374.2 +054300 MOVE "IDX-TEST-F2-9" TO PAR-NAME. NC2374.2 +054400 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +054500 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +054600 SET IDX-1 TO 05. NC2374.2 +054700 IDX-TEST-F2-9. NC2374.2 +054800 SEARCH ALL ENTRY-310-2 END NC2374.2 +054900 GO TO IDX-FAIL-F2-9 NC2374.2 +055000 WHEN GRP-1 (IDX-1, IDX-2) EQUAL TO "05" AND NC2374.2 +055100 SEC (IDX-1, IDX-2) EQUAL TO "07" NC2374.2 +055200 PERFORM PASS NC2374.2 +055300 GO TO IDX-WRITE-F2-9. NC2374.2 +055400 IDX-DELETE-F2-9. NC2374.2 +055500 PERFORM DE-LETE. NC2374.2 +055600 GO TO IDX-WRITE-F2-9. NC2374.2 +055700 IDX-FAIL-F2-9. NC2374.2 +055800 MOVE ENTRY-2 (05, 03) TO COMPUTED-A NC2374.2 +055900 MOVE "0507" TO CORRECT-A NC2374.2 +056000 MOVE "SUBSCRIPT USED FOR COMPUTED" TO RE-MARK NC2374.2 +056100 PERFORM FAIL. NC2374.2 +056200 IDX-WRITE-F2-9. NC2374.2 +056300 PERFORM PRINT-DETAIL. NC2374.2 +056400* NC2374.2 +056500 IDX-INIT-F2-10. NC2374.2 +056600 MOVE "IDX-TEST-F2-10" TO PAR-NAME. NC2374.2 +056700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +056800 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +056900 SET IDX-1 IDX-2 TO 9. NC2374.2 +057000 IDX-TEST-F2-10. NC2374.2 +057100 SEARCH ALL ENTRY-310-3 END NC2374.2 +057200 PERFORM PASS NC2374.2 +057300 GO TO IDX-WRITE-F2-10 NC2374.2 +057400 WHEN GRP-2 (IDX-1, IDX-2, IDX-3) EQUAL "09" NC2374.2 +057500 AND SEC-1 (IDX-1, IDX-2, IDX-3) EQUAL "01" NC2374.2 +057600 AND ELEM (IDX-1, IDX-2, IDX-3) EQUAL "10" NC2374.2 +057700 GO TO IDX-FAIL-F2-10. NC2374.2 +057800 IDX-DELETE-F2-10. NC2374.2 +057900 PERFORM DE-LETE. NC2374.2 +058000 GO TO IDX-WRITE-F2-10. NC2374.2 +058100 IDX-FAIL-F2-10. NC2374.2 +058200 MOVE "090110" TO COMPUTED-A NC2374.2 +058300 MOVE "ENTRY SHOULD NOT BE FOUND" TO RE-MARK NC2374.2 +058400 PERFORM FAIL. NC2374.2 +058500 IDX-WRITE-F2-10. NC2374.2 +058600 PERFORM PRINT-DETAIL. NC2374.2 +058700* NC2374.2 +058800 IDX-INIT-F2-11. NC2374.2 +058900 MOVE "IDX-TEST-F2-11" TO PAR-NAME. NC2374.2 +059000 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +059100 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +059200 SET IDX-1 TO 09. NC2374.2 +059300 IDX-TEST-F2-11. NC2374.2 +059400 SEARCH ALL ENTRY-310 ENDNC2374.2 +059500 GO TO IDX-FAIL-F2-11 NC2374.2 +059600 WHEN GRP (IDX-1) EQUAL TO "07" NC2374.2 +059700 PERFORM PASS NC2374.2 +059800 GO TO IDX-WRITE-F2-11. NC2374.2 +059900 IDX-DELETE-F2-11. NC2374.2 +060000 PERFORM DE-LETE. NC2374.2 +060100 GO TO IDX-WRITE-F2-11. NC2374.2 +060200 IDX-FAIL-F2-11. NC2374.2 +060300 MOVE ENTRY-1 (07) TO COMPUTED-A NC2374.2 +060400 MOVE "07" TO CORRECT-A NC2374.2 +060500 PERFORM FAIL NC2374.2 +060600 MOVE "SUBSCRIPT USED FOR COMPUTED" TO RE-MARK. NC2374.2 +060700 IDX-WRITE-F2-11. NC2374.2 +060800 PERFORM PRINT-DETAIL. NC2374.2 +060900* NC2374.2 +061000 IDX-INIT-F2-12. NC2374.2 +061100 MOVE "IDX-TEST-F2-12" TO PAR-NAME. NC2374.2 +061200 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +061300 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +061400 MOVE 04 TO IDENT-1. NC2374.2 +061500 SET IDX-1, IDX-2, IDX-3 TO IDENT-1. NC2374.2 +061600 SET IDX-1 UP BY 1. NC2374.2 +061700 IDX-TEST-F2-12. NC2374.2 +061800 SEARCH ALL ENTRY-310-3 AT END NC2374.2 +061900 GO TO IDX-FAIL-F2-12 NC2374.2 +062000 WHEN GRP-2 (IDX-1, IDX-2, IDX-3) EQUAL TO "05" AND NC2374.2 +062100 SEC-1 (IDX-1, IDX-2, IDX-3) EQUAL TO "06" AND NC2374.2 +062200 ELEM (IDX-1, IDX-2, IDX-3) EQUAL TO "03" NC2374.2 +062300 PERFORM PASS NC2374.2 +062400 GO TO IDX-WRITE-F2-12. NC2374.2 +062500 IDX-DELETE-F2-12. NC2374.2 +062600 PERFORM DE-LETE. NC2374.2 +062700 GO TO IDX-WRITE-F2-12. NC2374.2 +062800 IDX-FAIL-F2-12. NC2374.2 +062900 MOVE ENTRY-3 (05, 04, 03) TO COMPUTED-A NC2374.2 +063000 MOVE "SUBSCRIPT USED FOR COMPUTED" TO RE-MARK NC2374.2 +063100 MOVE "050603" TO CORRECT-A NC2374.2 +063200 PERFORM FAIL. NC2374.2 +063300 IDX-WRITE-F2-12. NC2374.2 +063400 PERFORM PRINT-DETAIL. NC2374.2 +063500* NC2374.2 +063600 IDX-INIT-F2-13. NC2374.2 +063700 MOVE "IDX-TEST-F2-13" TO PAR-NAME. NC2374.2 +063800 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2374.2 +063900 MOVE "SET AND SEARCH-ALL" TO FEATURE. NC2374.2 +064000 SET IDX-1 TO 9. NC2374.2 +064100 IDX-TEST-F2-13. NC2374.2 +064200 SEARCH ALL ENTRY-310-2 AT END NC2374.2 +064300 GO TO IDX-FAIL-F2-13 NC2374.2 +064400 WHEN GRP-1 (IDX-1, IDX-2) EQUAL TO "09" AND SEC NC2374.2 +064500 (IDX-1, IDX-2) EQUAL TO "01" NC2374.2 +064600 PERFORM PASS NC2374.2 +064700 GO TO IDX-WRITE-F2-13. NC2374.2 +064800 IDX-DELETE-F2-13. NC2374.2 +064900 PERFORM DE-LETE. NC2374.2 +065000 GO TO IDX-WRITE-F2-13. NC2374.2 +065100 IDX-FAIL-F2-13. NC2374.2 +065200 MOVE ENTRY-2 (09, 09) TO COMPUTED-A NC2374.2 +065300 MOVE "SUBSCRIPT USED FOR COMPUTED" TO RE-MARK NC2374.2 +065400 MOVE "0901" TO CORRECT-A NC2374.2 +065500 PERFORM FAIL. NC2374.2 +065600 IDX-WRITE-F2-13. NC2374.2 +065700 PERFORM PRINT-DETAIL. NC2374.2 +065800* NC2374.2 +065900 CCVS-EXIT SECTION. NC2374.2 +066000 CCVS-999999. NC2374.2 +066100 GO TO CLOSE-FILES. NC2374.2 diff --git a/tests/cobol85/NC/NC238A.CBL b/tests/cobol85/NC/NC238A.CBL new file mode 100755 index 00000000..c14f3f13 --- /dev/null +++ b/tests/cobol85/NC/NC238A.CBL @@ -0,0 +1,658 @@ +000100 IDENTIFICATION DIVISION. NC2384.2 +000200 PROGRAM-ID. NC2384.2 +000300 NC238A. NC2384.2 +000400**************************************************************** NC2384.2 +000500* * NC2384.2 +000600* VALIDATION FOR:- * NC2384.2 +000700* * NC2384.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2384.2 +000900* * NC2384.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2384.2 +001100* * NC2384.2 +001200**************************************************************** NC2384.2 +001300* * NC2384.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2384.2 +001500* * NC2384.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2384.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2384.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2384.2 +001900* * NC2384.2 +002000**************************************************************** NC2384.2 +002100* NC2384.2 +002200* PROGRAM NC238A TESTS FORMATS 1 AND 2 OF THE "SEARCH" * NC2384.2 +002300* STATEMENT USING A TWO-DIMENDIONAL TABLE WITH ASCENDING * NC2384.2 +002400* AND DESCENDING KEYS AND MULTIPLE INDICES. SINGLE AND * NC2384.2 +002500* MULTIPLE CONDITIONS ARE USED IN THE "WHEN" PHRASE. * NC2384.2 +002600* * NC2384.2 +002700**************************************************************** NC2384.2 +002800 ENVIRONMENT DIVISION. NC2384.2 +002900 CONFIGURATION SECTION. NC2384.2 +003000 SOURCE-COMPUTER. NC2384.2 +003100 Linux. NC2384.2 +003200 OBJECT-COMPUTER. NC2384.2 +003300 Linux. NC2384.2 +003400 INPUT-OUTPUT SECTION. NC2384.2 +003500 FILE-CONTROL. NC2384.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2384.2 +003700 "report.log". NC2384.2 +003800 DATA DIVISION. NC2384.2 +003900 FILE SECTION. NC2384.2 +004000 FD PRINT-FILE. NC2384.2 +004100 01 PRINT-REC PICTURE X(120). NC2384.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2384.2 +004300 WORKING-STORAGE SECTION. NC2384.2 +004400 77 SUB-1 PICTURE S99 VALUE ZERO. NC2384.2 +004500 77 SUB-2 PICTURE 99 VALUE ZERO. NC2384.2 +004600 77 SUB-3 PICTURE 99 VALUE ZERO. NC2384.2 +004700 77 CON-7 PICTURE 99 VALUE 07. NC2384.2 +004800 77 CON-10 PICTURE 99 VALUE 10. NC2384.2 +004900 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2384.2 +005000 77 CON-5 PICTURE 99 VALUE 05. NC2384.2 +005100 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2384.2 +005200 77 CON-6 PICTURE 99 VALUE 06. NC2384.2 +005300 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2384.2 +005400 77 SUB-4 PICTURE 9 VALUE 9. NC2384.2 +005500 77 SUB-5 PICTURE 9 VALUE 1. NC2384.2 +005600 77 SUB-6 PICTURE 99 VALUE 01. NC2384.2 +005700 77 LEVEL-HOLD PICTURE X(4) VALUE SPACES. NC2384.2 +005800 01 ALPHA-TABLE. NC2384.2 +005900 02 FILLER PICTURE X(4) VALUE "PPPP". NC2384.2 +006000 02 FILLER PICTURE X(4) VALUE "OOOO". NC2384.2 +006100 02 FILLER PICTURE X(4) VALUE "NNNN". NC2384.2 +006200 02 FILLER PICTURE X(4) VALUE "MMMM". NC2384.2 +006300 02 FILLER PICTURE X(4) VALUE "LLLL". NC2384.2 +006400 02 FILLER PICTURE X(4) VALUE "KKKK". NC2384.2 +006500 02 FILLER PICTURE X(4) VALUE "JJJJ". NC2384.2 +006600 02 FILLER PICTURE X(4) VALUE "IIII". NC2384.2 +006700 02 FILLER PICTURE X(4) VALUE "HHHH". NC2384.2 +006800 02 FILLER PICTURE X(4) VALUE "GGGG". NC2384.2 +006900 02 FILLER PICTURE X(4) VALUE "FFFF". NC2384.2 +007000 02 FILLER PICTURE X(4) VALUE "EEEE". NC2384.2 +007100 02 FILLER PICTURE X(4) VALUE "DDDD". NC2384.2 +007200 02 FILLER PICTURE X(4) VALUE "CCCC". NC2384.2 +007300 02 FILLER PICTURE X(4) VALUE "BBBB". NC2384.2 +007400 02 FILLER PICTURE X(4) VALUE "AAAA". NC2384.2 +007500 01 ALPHA-BET-TABLE REDEFINES ALPHA-TABLE. NC2384.2 +007600 02 ALPHA-BET OCCURS 16 TIMES PICTURE X(4). NC2384.2 +007700 NC2384.2 +007800 01 SERIES-TABLE-2. NC2384.2 +007900 02 1ST-ENTRY OCCURS 4 TIMES ASCENDING KEY IS FIELD-1 FIELD-2NC2384.2 +008000 DESCENDING KEY IS FIELD-3 FIELD-4 INDEXED BY IDX-4 NC2384.2 +008100 IDX-5 IDX-6. NC2384.2 +008200 03 FIELD-1 PICTURE 9. NC2384.2 +008300 03 FIELD-2 PICTURE 9. NC2384.2 +008400 03 FIELD-3 PICTURE 9. NC2384.2 +008500 03 FIELD-4 PICTURE 9. NC2384.2 +008600 03 2ND-ENTRY OCCURS 4 TIMES DESCENDING IS FIELD-5 NC2384.2 +008700 FIELD-6 FIELD-7 FIELD-8 INDEXED IDX-7 IDX-8 IDX-9. NC2384.2 +008800 04 FIELD-5 PICTURE X. NC2384.2 +008900 04 FIELD-6 PICTURE X. NC2384.2 +009000 04 FIELD-7 PICTURE X. NC2384.2 +009100 04 FIELD-8 PICTURE X. NC2384.2 +009200 01 NOTE-1. NC2384.2 +009300 02 FILLER PICTURE X(74) VALUE NC2384.2 +009400 "NOTE 1 - CORRECT AND COMPUTED DATA ARE EQUAL BUT THE AT END NC2384.2 +009500- "PATH WAS TAKEN". NC2384.2 +009600 02 FILLER PICTURE X(46) VALUE SPACES. NC2384.2 +009700 01 NOTE-2. NC2384.2 +009800 02 FILLER PICTURE X(112) VALUE NC2384.2 +009900 "NOTE 2 - CORRECT AND COMPUTED DATA ARE NOT EQUAL. THE COMPUTNC2384.2 +010000- "ED ENTRY WAS EXTRACTED FROM THE TABLE BY SUBSCRIPTS.". NC2384.2 +010100 02 FILLER PICTURE X(8) VALUE SPACES. NC2384.2 +010200 NC2384.2 +010300 01 END-STMT. NC2384.2 +010400 02 FILLER PICTURE X(7) VALUE "AT END ". NC2384.2 +010500 02 END-IDX PICTURE X(5) VALUE SPACES. NC2384.2 +010600 02 FILLER PICTURE XXX VALUE " = ". NC2384.2 +010700 02 IDX-VALU PICTURE 99 VALUE 00. NC2384.2 +010800 02 FILLER PICTURE XXX VALUE SPACES. NC2384.2 +010900 01 TEST-RESULTS. NC2384.2 +011000 02 FILLER PIC X VALUE SPACE. NC2384.2 +011100 02 FEATURE PIC X(20) VALUE SPACE. NC2384.2 +011200 02 FILLER PIC X VALUE SPACE. NC2384.2 +011300 02 P-OR-F PIC X(5) VALUE SPACE. NC2384.2 +011400 02 FILLER PIC X VALUE SPACE. NC2384.2 +011500 02 PAR-NAME. NC2384.2 +011600 03 FILLER PIC X(19) VALUE SPACE. NC2384.2 +011700 03 PARDOT-X PIC X VALUE SPACE. NC2384.2 +011800 03 DOTVALUE PIC 99 VALUE ZERO. NC2384.2 +011900 02 FILLER PIC X(8) VALUE SPACE. NC2384.2 +012000 02 RE-MARK PIC X(61). NC2384.2 +012100 01 TEST-COMPUTED. NC2384.2 +012200 02 FILLER PIC X(30) VALUE SPACE. NC2384.2 +012300 02 FILLER PIC X(17) VALUE NC2384.2 +012400 " COMPUTED=". NC2384.2 +012500 02 COMPUTED-X. NC2384.2 +012600 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2384.2 +012700 03 COMPUTED-N REDEFINES COMPUTED-A NC2384.2 +012800 PIC -9(9).9(9). NC2384.2 +012900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2384.2 +013000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2384.2 +013100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2384.2 +013200 03 CM-18V0 REDEFINES COMPUTED-A. NC2384.2 +013300 04 COMPUTED-18V0 PIC -9(18). NC2384.2 +013400 04 FILLER PIC X. NC2384.2 +013500 03 FILLER PIC X(50) VALUE SPACE. NC2384.2 +013600 01 TEST-CORRECT. NC2384.2 +013700 02 FILLER PIC X(30) VALUE SPACE. NC2384.2 +013800 02 FILLER PIC X(17) VALUE " CORRECT =". NC2384.2 +013900 02 CORRECT-X. NC2384.2 +014000 03 CORRECT-A PIC X(20) VALUE SPACE. NC2384.2 +014100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2384.2 +014200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2384.2 +014300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2384.2 +014400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2384.2 +014500 03 CR-18V0 REDEFINES CORRECT-A. NC2384.2 +014600 04 CORRECT-18V0 PIC -9(18). NC2384.2 +014700 04 FILLER PIC X. NC2384.2 +014800 03 FILLER PIC X(2) VALUE SPACE. NC2384.2 +014900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2384.2 +015000 01 CCVS-C-1. NC2384.2 +015100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2384.2 +015200- "SS PARAGRAPH-NAME NC2384.2 +015300- " REMARKS". NC2384.2 +015400 02 FILLER PIC X(20) VALUE SPACE. NC2384.2 +015500 01 CCVS-C-2. NC2384.2 +015600 02 FILLER PIC X VALUE SPACE. NC2384.2 +015700 02 FILLER PIC X(6) VALUE "TESTED". NC2384.2 +015800 02 FILLER PIC X(15) VALUE SPACE. NC2384.2 +015900 02 FILLER PIC X(4) VALUE "FAIL". NC2384.2 +016000 02 FILLER PIC X(94) VALUE SPACE. NC2384.2 +016100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2384.2 +016200 01 REC-CT PIC 99 VALUE ZERO. NC2384.2 +016300 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2384.2 +016400 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2384.2 +016500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2384.2 +016600 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2384.2 +016700 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2384.2 +016800 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2384.2 +016900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2384.2 +017000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2384.2 +017100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2384.2 +017200 01 CCVS-H-1. NC2384.2 +017300 02 FILLER PIC X(39) VALUE SPACES. NC2384.2 +017400 02 FILLER PIC X(42) VALUE NC2384.2 +017500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2384.2 +017600 02 FILLER PIC X(39) VALUE SPACES. NC2384.2 +017700 01 CCVS-H-2A. NC2384.2 +017800 02 FILLER PIC X(40) VALUE SPACE. NC2384.2 +017900 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2384.2 +018000 02 FILLER PIC XXXX VALUE NC2384.2 +018100 "4.2 ". NC2384.2 +018200 02 FILLER PIC X(28) VALUE NC2384.2 +018300 " COPY - NOT FOR DISTRIBUTION". NC2384.2 +018400 02 FILLER PIC X(41) VALUE SPACE. NC2384.2 +018500 NC2384.2 +018600 01 CCVS-H-2B. NC2384.2 +018700 02 FILLER PIC X(15) VALUE NC2384.2 +018800 "TEST RESULT OF ". NC2384.2 +018900 02 TEST-ID PIC X(9). NC2384.2 +019000 02 FILLER PIC X(4) VALUE NC2384.2 +019100 " IN ". NC2384.2 +019200 02 FILLER PIC X(12) VALUE NC2384.2 +019300 " HIGH ". NC2384.2 +019400 02 FILLER PIC X(22) VALUE NC2384.2 +019500 " LEVEL VALIDATION FOR ". NC2384.2 +019600 02 FILLER PIC X(58) VALUE NC2384.2 +019700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2384.2 +019800 01 CCVS-H-3. NC2384.2 +019900 02 FILLER PIC X(34) VALUE NC2384.2 +020000 " FOR OFFICIAL USE ONLY ". NC2384.2 +020100 02 FILLER PIC X(58) VALUE NC2384.2 +020200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2384.2 +020300 02 FILLER PIC X(28) VALUE NC2384.2 +020400 " COPYRIGHT 1985 ". NC2384.2 +020500 01 CCVS-E-1. NC2384.2 +020600 02 FILLER PIC X(52) VALUE SPACE. NC2384.2 +020700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2384.2 +020800 02 ID-AGAIN PIC X(9). NC2384.2 +020900 02 FILLER PIC X(45) VALUE SPACES. NC2384.2 +021000 01 CCVS-E-2. NC2384.2 +021100 02 FILLER PIC X(31) VALUE SPACE. NC2384.2 +021200 02 FILLER PIC X(21) VALUE SPACE. NC2384.2 +021300 02 CCVS-E-2-2. NC2384.2 +021400 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2384.2 +021500 03 FILLER PIC X VALUE SPACE. NC2384.2 +021600 03 ENDER-DESC PIC X(44) VALUE NC2384.2 +021700 "ERRORS ENCOUNTERED". NC2384.2 +021800 01 CCVS-E-3. NC2384.2 +021900 02 FILLER PIC X(22) VALUE NC2384.2 +022000 " FOR OFFICIAL USE ONLY". NC2384.2 +022100 02 FILLER PIC X(12) VALUE SPACE. NC2384.2 +022200 02 FILLER PIC X(58) VALUE NC2384.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2384.2 +022400 02 FILLER PIC X(13) VALUE SPACE. NC2384.2 +022500 02 FILLER PIC X(15) VALUE NC2384.2 +022600 " COPYRIGHT 1985". NC2384.2 +022700 01 CCVS-E-4. NC2384.2 +022800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2384.2 +022900 02 FILLER PIC X(4) VALUE " OF ". NC2384.2 +023000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2384.2 +023100 02 FILLER PIC X(40) VALUE NC2384.2 +023200 " TESTS WERE EXECUTED SUCCESSFULLY". NC2384.2 +023300 01 XXINFO. NC2384.2 +023400 02 FILLER PIC X(19) VALUE NC2384.2 +023500 "*** INFORMATION ***". NC2384.2 +023600 02 INFO-TEXT. NC2384.2 +023700 04 FILLER PIC X(8) VALUE SPACE. NC2384.2 +023800 04 XXCOMPUTED PIC X(20). NC2384.2 +023900 04 FILLER PIC X(5) VALUE SPACE. NC2384.2 +024000 04 XXCORRECT PIC X(20). NC2384.2 +024100 02 INF-ANSI-REFERENCE PIC X(48). NC2384.2 +024200 01 HYPHEN-LINE. NC2384.2 +024300 02 FILLER PIC IS X VALUE IS SPACE. NC2384.2 +024400 02 FILLER PIC IS X(65) VALUE IS "************************NC2384.2 +024500- "*****************************************". NC2384.2 +024600 02 FILLER PIC IS X(54) VALUE IS "************************NC2384.2 +024700- "******************************". NC2384.2 +024800 01 CCVS-PGM-ID PIC X(9) VALUE NC2384.2 +024900 "NC238A". NC2384.2 +025000 PROCEDURE DIVISION. NC2384.2 +025100 CCVS1 SECTION. NC2384.2 +025200 OPEN-FILES. NC2384.2 +025300 OPEN OUTPUT PRINT-FILE. NC2384.2 +025400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2384.2 +025500 MOVE SPACE TO TEST-RESULTS. NC2384.2 +025600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2384.2 +025700 GO TO CCVS1-EXIT. NC2384.2 +025800 CLOSE-FILES. NC2384.2 +025900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2384.2 +026000 TERMINATE-CCVS. NC2384.2 +026100*S EXIT PROGRAM. NC2384.2 +026200*SERMINATE-CALL. NC2384.2 +026300 STOP RUN. NC2384.2 +026400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2384.2 +026500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2384.2 +026600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2384.2 +026700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2384.2 +026800 MOVE "****TEST DELETED****" TO RE-MARK. NC2384.2 +026900 PRINT-DETAIL. NC2384.2 +027000 IF REC-CT NOT EQUAL TO ZERO NC2384.2 +027100 MOVE "." TO PARDOT-X NC2384.2 +027200 MOVE REC-CT TO DOTVALUE. NC2384.2 +027300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2384.2 +027400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2384.2 +027500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2384.2 +027600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2384.2 +027700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2384.2 +027800 MOVE SPACE TO CORRECT-X. NC2384.2 +027900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2384.2 +028000 MOVE SPACE TO RE-MARK. NC2384.2 +028100 HEAD-ROUTINE. NC2384.2 +028200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +028300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +028400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2384.2 +028500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2384.2 +028600 COLUMN-NAMES-ROUTINE. NC2384.2 +028700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +028800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +028900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +029000 END-ROUTINE. NC2384.2 +029100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2384.2 +029200 END-RTN-EXIT. NC2384.2 +029300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +029400 END-ROUTINE-1. NC2384.2 +029500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2384.2 +029600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2384.2 +029700 ADD PASS-COUNTER TO ERROR-HOLD. NC2384.2 +029800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2384.2 +029900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2384.2 +030000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2384.2 +030100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2384.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2384.2 +030300 END-ROUTINE-12. NC2384.2 +030400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2384.2 +030500 IF ERROR-COUNTER IS EQUAL TO ZERO NC2384.2 +030600 MOVE "NO " TO ERROR-TOTAL NC2384.2 +030700 ELSE NC2384.2 +030800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2384.2 +030900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2384.2 +031000 PERFORM WRITE-LINE. NC2384.2 +031100 END-ROUTINE-13. NC2384.2 +031200 IF DELETE-COUNTER IS EQUAL TO ZERO NC2384.2 +031300 MOVE "NO " TO ERROR-TOTAL ELSE NC2384.2 +031400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2384.2 +031500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2384.2 +031600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +031700 IF INSPECT-COUNTER EQUAL TO ZERO NC2384.2 +031800 MOVE "NO " TO ERROR-TOTAL NC2384.2 +031900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2384.2 +032000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2384.2 +032100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +032200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2384.2 +032300 WRITE-LINE. NC2384.2 +032400 ADD 1 TO RECORD-COUNT. NC2384.2 +032500 IF RECORD-COUNT GREATER 50 NC2384.2 +032600 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2384.2 +032700 MOVE SPACE TO DUMMY-RECORD NC2384.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2384.2 +032900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2384.2 +033000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2384.2 +033100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2384.2 +033200 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2384.2 +033300 MOVE ZERO TO RECORD-COUNT. NC2384.2 +033400 PERFORM WRT-LN. NC2384.2 +033500 WRT-LN. NC2384.2 +033600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2384.2 +033700 MOVE SPACE TO DUMMY-RECORD. NC2384.2 +033800 BLANK-LINE-PRINT. NC2384.2 +033900 PERFORM WRT-LN. NC2384.2 +034000 FAIL-ROUTINE. NC2384.2 +034100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2384.2 +034200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2384.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2384.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2384.2 +034500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +034600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2384.2 +034700 GO TO FAIL-ROUTINE-EX. NC2384.2 +034800 FAIL-ROUTINE-WRITE. NC2384.2 +034900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2384.2 +035000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2384.2 +035100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2384.2 +035200 MOVE SPACES TO COR-ANSI-REFERENCE. NC2384.2 +035300 FAIL-ROUTINE-EX. EXIT. NC2384.2 +035400 BAIL-OUT. NC2384.2 +035500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2384.2 +035600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2384.2 +035700 BAIL-OUT-WRITE. NC2384.2 +035800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2384.2 +035900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2384.2 +036000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2384.2 +036100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2384.2 +036200 BAIL-OUT-EX. EXIT. NC2384.2 +036300 CCVS1-EXIT. NC2384.2 +036400 EXIT. NC2384.2 +036500 SECT-NC238A-001 SECTION. NC2384.2 +036600 TH-11-001. NC2384.2 +036700 SET IDX-4 IDX-7 TO 01. NC2384.2 +036800 BUILD-LOOP-1. NC2384.2 +036900 MOVE SUB-5 TO FIELD-1 (IDX-4) FIELD-2 (IDX-4). NC2384.2 +037000 MOVE SUB-4 TO FIELD-3 (IDX-4) FIELD-4 (IDX-4). NC2384.2 +037100 PERFORM BUILD-ENTRY-2 THRU ENTRY-2-EXIT. NC2384.2 +037200 IF 2ND-ENTRY (4, 4) EQUAL TO "AAAA" GO TO BUILD-EXIT. NC2384.2 +037300 ADD 1 TO SUB-5. NC2384.2 +037400 SUBTRACT 1 FROM SUB-4. NC2384.2 +037500 SET IDX-4 UP BY 1. NC2384.2 +037600 GO TO BUILD-LOOP-1. NC2384.2 +037700 BUILD-ENTRY-2. NC2384.2 +037800 MOVE ALPHA-BET (SUB-6) TO 2ND-ENTRY (IDX-4, IDX-7). NC2384.2 +037900 IF IDX-7 EQUAL TO 4 NC2384.2 +038000 SET IDX-7 TO 1 NC2384.2 +038100 ADD 1 TO SUB-6 NC2384.2 +038200 GO TO ENTRY-2-EXIT. NC2384.2 +038300 SET IDX-7 UP BY 1. NC2384.2 +038400 ADD 1 TO SUB-6. NC2384.2 +038500 GO TO BUILD-ENTRY-2. NC2384.2 +038600 ENTRY-2-EXIT. NC2384.2 +038700 EXIT. NC2384.2 +038800 BUILD-EXIT. NC2384.2 +038900 EXIT. NC2384.2 +039000* NC2384.2 +039100 SCH-INIT-F1-1. NC2384.2 +039200 MOVE "SCH-TEST-F1-1" TO PAR-NAME. NC2384.2 +039300 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +039400 MOVE "SEARCH" TO FEATURE. NC2384.2 +039500 MOVE "IMPLIED VARYING OPTION" TO RE-MARK. NC2384.2 +039600 SET IDX-4 TO 01. NC2384.2 +039700 SCH-TEST-F1-1. NC2384.2 +039800 SEARCH 1ST-ENTRY NC2384.2 +039900 WHEN 1ST-ENTRY (IDX-4) EQUAL TO "2288LLLLKKKKJJJJIIII" NC2384.2 +040000 MOVE 1ST-ENTRY (IDX-4) TO LEVEL-HOLD. NC2384.2 +040100 IF LEVEL-HOLD EQUAL TO "2288" NC2384.2 +040200 PERFORM PASS NC2384.2 +040300 GO TO SCH-WRITE-F1-1. NC2384.2 +040400 GO TO SCH-FAIL-F1-1. NC2384.2 +040500 SCH-DELETE-F1-1. NC2384.2 +040600 PERFORM DE-LETE. NC2384.2 +040700 GO TO SCH-WRITE-F1-1. NC2384.2 +040800 SCH-FAIL-F1-1. NC2384.2 +040900 MOVE "2288" TO CORRECT-A. NC2384.2 +041000 MOVE "ENTRY NOT FOUND" TO COMPUTED-A. NC2384.2 +041100 PERFORM FAIL. NC2384.2 +041200 SCH-WRITE-F1-1. NC2384.2 +041300 PERFORM PRINT-DETAIL. NC2384.2 +041400* NC2384.2 +041500 SCH-INIT-F1-2. NC2384.2 +041600 MOVE "SCH-TEST-F1-2" TO PAR-NAME. NC2384.2 +041700 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +041800 MOVE "FORMAT 1 VARYING OPTION" TO RE-MARK. NC2384.2 +041900 MOVE "SEARCH WHEN SERIES" TO FEATURE. NC2384.2 +042000 SET IDX-5 TO 04. NC2384.2 +042100 SCH-TEST-F1-2. NC2384.2 +042200 SEARCH 1ST-ENTRY VARYING IDX-5 NC2384.2 +042300 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +042400 WHEN FIELD-1 (IDX-5) EQUAL TO 3 NC2384.2 +042500 MOVE FIELD-1 (IDX-5) TO LEVEL-HOLD NC2384.2 +042600 WHEN FIELD-4 (IDX-5) EQUAL TO 6 NC2384.2 +042700 MOVE FIELD-4 (IDX-5) TO LEVEL-HOLD. NC2384.2 +042800 MOVE "FORMAT 1 W/0 VARYING" TO RE-MARK. NC2384.2 +042900 IF LEVEL-HOLD EQUAL TO "6 " NC2384.2 +043000 PERFORM PASS NC2384.2 +043100 GO TO SCH-WRITE-F1-2. NC2384.2 +043200 GO TO SCH-FAIL-F1-2. NC2384.2 +043300 SCH-DELETE-F1-2. NC2384.2 +043400 PERFORM DE-LETE. NC2384.2 +043500 GO TO SCH-WRITE-F1-2. NC2384.2 +043600 SCH-FAIL-F1-2. NC2384.2 +043700 MOVE "6" TO CORRECT-A. NC2384.2 +043800 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +043900 PERFORM FAIL. NC2384.2 +044000 SCH-WRITE-F1-2. NC2384.2 +044100 PERFORM PRINT-DETAIL. NC2384.2 +044200* NC2384.2 +044300 SCH-INIT-F1-3. NC2384.2 +044400 MOVE "SCH-TEST-F1-3" TO PAR-NAME. NC2384.2 +044500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +044600 MOVE "SEARCH WHEN SERIES" TO FEATURE. NC2384.2 +044700 SET IDX-5 TO 03. NC2384.2 +044800 SET IDX-8 TO 01. NC2384.2 +044900 SCH-TEST-F1-3. NC2384.2 +045000 SEARCH 2ND-ENTRY VARYING IDX-8 NC2384.2 +045100 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +045200 WHEN FIELD-7 (IDX-5, IDX-8) EQUAL TO "E" NC2384.2 +045300 MOVE FIELD-7 (IDX-5, IDX-8) TO LEVEL-HOLD NC2384.2 +045400 WHEN FIELD-5 (IDX-5, IDX-8) EQUAL TO "E" NC2384.2 +045500 MOVE FIELD-5 (IDX-5, IDX-8) TO LEVEL-HOLD NC2384.2 +045600 WHEN FIELD-8 (IDX-5, IDX-8) EQUAL TO "E" NC2384.2 +045700 MOVE FIELD-8 (IDX-5, IDX-8) TO LEVEL-HOLD. NC2384.2 +045800 IF LEVEL-HOLD EQUAL TO "E " NC2384.2 +045900 PERFORM PASS NC2384.2 +046000 GO TO SCH-WRITE-F1-3. NC2384.2 +046100 GO TO SCH-FAIL-F1-3. NC2384.2 +046200 SCH-DELETE-F1-3. NC2384.2 +046300 PERFORM DE-LETE. NC2384.2 +046400 GO TO SCH-WRITE-F1-3. NC2384.2 +046500 SCH-FAIL-F1-3. NC2384.2 +046600 MOVE "E" TO CORRECT-A. NC2384.2 +046700 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +046800 PERFORM FAIL. NC2384.2 +046900 SCH-WRITE-F1-3. NC2384.2 +047000 PERFORM PRINT-DETAIL. NC2384.2 +047100* NC2384.2 +047200 SCH-INIT-F1-4. NC2384.2 +047300 MOVE "SCH-TEST-F1-4" TO PAR-NAME. NC2384.2 +047400 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +047500 MOVE "SEARCH VARYING" TO FEATURE. NC2384.2 +047600 MOVE "WHEN-COMPOUND CONDITION" TO RE-MARK. NC2384.2 +047700 SET IDX-4 IDX-9 TO 04. NC2384.2 +047800 SCH-TEST-F1-4. NC2384.2 +047900 SEARCH 2ND-ENTRY VARYING IDX-9 NC2384.2 +048000 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +048100 WHEN FIELD-6 (IDX-4, IDX-9) NOT EQUAL TO "A" NC2384.2 +048200 AND FIELD-7 (IDX-4, IDX-9) NOT EQUAL TO "A" NC2384.2 +048300 MOVE "A" TO LEVEL-HOLD. NC2384.2 +048400 IF LEVEL-HOLD EQUAL TO SPACES NC2384.2 +048500 PERFORM PASS NC2384.2 +048600 GO TO SCH-WRITE-F1-4. NC2384.2 +048700 GO TO SCH-FAIL-F1-4. NC2384.2 +048800 SCH-DELETE-F1-4. NC2384.2 +048900 PERFORM DE-LETE. NC2384.2 +049000 GO TO SCH-WRITE-F1-4. NC2384.2 +049100 SCH-FAIL-F1-4. NC2384.2 +049200 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +049300 MOVE "NO SUCH ENTRY" TO CORRECT-A. NC2384.2 +049400 PERFORM FAIL. NC2384.2 +049500 SCH-WRITE-F1-4. NC2384.2 +049600 PERFORM PRINT-DETAIL. NC2384.2 +049700* NC2384.2 +049800 SCH-INIT-F1-5. NC2384.2 +049900 MOVE "SCH-TEST-F1-5" TO PAR-NAME. NC2384.2 +050000 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +050100 MOVE "SEARCH WHEN SERIES" TO FEATURE. NC2384.2 +050200 SET IDX-6 TO 02. NC2384.2 +050300 SET IDX-7 TO 02. NC2384.2 +050400 SCH-TEST-F1-5. NC2384.2 +050500 SEARCH 2ND-ENTRY VARYING IDX-7 NC2384.2 +050600 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +050700 WHEN FIELD-5 (IDX-6, IDX-7) EQUAL TO "M" NC2384.2 +050800 MOVE FIELD-5 (IDX-6, IDX-7) TO LEVEL-HOLD NC2384.2 +050900 WHEN FIELD-6 (IDX-6, IDX-7) EQUAL TO "N" NC2384.2 +051000 MOVE FIELD-6 (IDX-6, IDX-7) TO LEVEL-HOLD NC2384.2 +051100 WHEN FIELD-7 (IDX-6, IDX-7) EQUAL TO "O" NC2384.2 +051200 MOVE FIELD-7 (IDX-6, IDX-7) TO LEVEL-HOLD NC2384.2 +051300 WHEN FIELD-8 (IDX-6, IDX-7) EQUAL TO "I" NC2384.2 +051400 MOVE FIELD-8 (IDX-6, IDX-7) TO LEVEL-HOLD. NC2384.2 +051500 IF LEVEL-HOLD EQUAL TO "I " NC2384.2 +051600 PERFORM PASS NC2384.2 +051700 GO TO SCH-WRITE-F1-5. NC2384.2 +051800 GO TO SCH-FAIL-F1-5. NC2384.2 +051900 SCH-DELETE-F1-5. NC2384.2 +052000 PERFORM DE-LETE. NC2384.2 +052100 GO TO SCH-WRITE-F1-5. NC2384.2 +052200 SCH-FAIL-F1-5. NC2384.2 +052300 MOVE "I" TO CORRECT-A. NC2384.2 +052400 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +052500 PERFORM FAIL. NC2384.2 +052600 SCH-WRITE-F1-5. NC2384.2 +052700 PERFORM PRINT-DETAIL. NC2384.2 +052800* NC2384.2 +052900 SCH-INIT-F2-6. NC2384.2 +053000 MOVE "SCH-TEST-F2-6" TO PAR-NAME. NC2384.2 +053100 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +053200 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +053300 MOVE "WHEN-COMPOUND CONDITION" TO RE-MARK. NC2384.2 +053400 SCH-TEST-F2-6. NC2384.2 +053500 SEARCH ALL 1ST-ENTRY NC2384.2 +053600 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +053700 WHEN FIELD-1 (IDX-4) EQUAL TO 2 AND NC2384.2 +053800 FIELD-2 (IDX-4) EQUAL TO 2 MOVE 2 TO LEVEL-HOLD. NC2384.2 +053900 IF LEVEL-HOLD EQUAL TO "2 " NC2384.2 +054000 PERFORM PASS NC2384.2 +054100 GO TO SCH-WRITE-F2-6. NC2384.2 +054200 GO TO SCH-FAIL-F2-6. NC2384.2 +054300 SCH-DELETE-F2-6. NC2384.2 +054400 PERFORM DE-LETE. NC2384.2 +054500 GO TO SCH-WRITE-F2-6. NC2384.2 +054600 SCH-FAIL-F2-6. NC2384.2 +054700 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +054800 MOVE "2" TO CORRECT-A. NC2384.2 +054900 PERFORM FAIL. NC2384.2 +055000 SCH-WRITE-F2-6. NC2384.2 +055100 PERFORM PRINT-DETAIL. NC2384.2 +055200* NC2384.2 +055300 SCH-INIT-F2-7. NC2384.2 +055400 MOVE "SCH-TEST-F2-7" TO PAR-NAME. NC2384.2 +055500 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +055600 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +055700 SCH-TEST-F2-7. NC2384.2 +055800 SEARCH ALL 1ST-ENTRY NC2384.2 +055900 AT END MOVE SPACES TO LEVEL-HOLD NC2384.2 +056000 WHEN FIELD-1 (IDX-4) EQUAL TO 4 AND NC2384.2 +056100 FIELD-2 (IDX-4) EQUAL TO 4 AND NC2384.2 +056200 FIELD-3 (IDX-4) EQUAL TO 6 AND NC2384.2 +056300 FIELD-4 (IDX-4) EQUAL TO 6 NC2384.2 +056400 MOVE 6 TO LEVEL-HOLD. NC2384.2 +056500 IF LEVEL-HOLD EQUAL TO "6 " NC2384.2 +056600 PERFORM PASS NC2384.2 +056700 GO TO SCH-WRITE-F2-7. NC2384.2 +056800 GO TO SCH-FAIL-F2-7. NC2384.2 +056900 SCH-DELETE-F2-7. NC2384.2 +057000 PERFORM DE-LETE. NC2384.2 +057100 GO TO SCH-WRITE-F2-7. NC2384.2 +057200 SCH-FAIL-F2-7. NC2384.2 +057300 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +057400 MOVE "6" TO CORRECT-A. NC2384.2 +057500 PERFORM FAIL. NC2384.2 +057600 SCH-WRITE-F2-7. NC2384.2 +057700 PERFORM PRINT-DETAIL. NC2384.2 +057800* NC2384.2 +057900 SCH-INIT-F2-8. NC2384.2 +058000 MOVE "SCH-TEST-F2-8" TO PAR-NAME. NC2384.2 +058100 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +058200 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +058300 MOVE SPACES TO LEVEL-HOLD. NC2384.2 +058400 SET IDX-4 TO 01. NC2384.2 +058500 SCH-TEST-F2-8. NC2384.2 +058600 SEARCH ALL 2ND-ENTRY NC2384.2 +058700 WHEN FIELD-5 (IDX-4, IDX-7) EQUAL TO "O" AND NC2384.2 +058800 FIELD-6 (IDX-4, IDX-7) EQUAL TO "O" AND NC2384.2 +058900 FIELD-7 (IDX-4, IDX-7) EQUAL TO "O" AND NC2384.2 +059000 FIELD-8 (IDX-4, IDX-7) EQUAL TO "P" NC2384.2 +059100 MOVE "OOOP" TO LEVEL-HOLD. NC2384.2 +059200 IF LEVEL-HOLD EQUAL TO "OOOP" NC2384.2 +059300 GO TO SCH-FAIL-F2-8. NC2384.2 +059400 PERFORM PASS. NC2384.2 +059500 GO TO SCH-WRITE-F2-8. NC2384.2 +059600 SCH-DELETE-F2-8. NC2384.2 +059700 PERFORM DE-LETE. NC2384.2 +059800 GO TO SCH-WRITE-F2-8. NC2384.2 +059900 SCH-FAIL-F2-8. NC2384.2 +060000 MOVE "NO SUCH ENTRY" TO CORRECT-A NC2384.2 +060100 MOVE LEVEL-HOLD TO COMPUTED-A NC2384.2 +060200 PERFORM FAIL. NC2384.2 +060300 SCH-WRITE-F2-8. NC2384.2 +060400 PERFORM PRINT-DETAIL. NC2384.2 +060500* NC2384.2 +060600 SCH-INIT-F2-9. NC2384.2 +060700 MOVE "SCH-TEST-F2-9" TO PAR-NAME. NC2384.2 +060800 MOVE "VI-121 6.21.2" TO ANSI-REFERENCE. NC2384.2 +060900 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +061000 MOVE SPACES TO LEVEL-HOLD. NC2384.2 +061100 SET IDX-4 TO 04. NC2384.2 +061200 SCH-TEST-F2-9. NC2384.2 +061300 SEARCH ALL 2ND-ENTRY NC2384.2 +061400 WHEN FIELD-5 (IDX-4, IDX-7) EQUAL TO "B" AND NC2384.2 +061500 FIELD-6 (IDX-4, IDX-7) EQUAL TO "B" NC2384.2 +061600 MOVE "BB" TO LEVEL-HOLD. NC2384.2 +061700 IF LEVEL-HOLD EQUAL TO "BB " NC2384.2 +061800 PERFORM PASS NC2384.2 +061900 GO TO SCH-WRITE-F2-9. NC2384.2 +062000 GO TO SCH-FAIL-F2-9. NC2384.2 +062100 SCH-DELETE-F2-9. NC2384.2 +062200 PERFORM DE-LETE. NC2384.2 +062300 GO TO SCH-WRITE-F2-9. NC2384.2 +062400 SCH-FAIL-F2-9. NC2384.2 +062500 MOVE "BB " TO CORRECT-A. NC2384.2 +062600 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +062700 PERFORM FAIL. NC2384.2 +062800 SCH-WRITE-F2-9. NC2384.2 +062900 PERFORM PRINT-DETAIL. NC2384.2 +063000* NC2384.2 +063100 SCH-INIT-F2-10. NC2384.2 +063200* ===--> ARITHMETIC EXPRESSION OF ZERO <--=== NC2384.2 +063300 MOVE "SCH-TEST-F2-10" TO PAR-NAME. NC2384.2 +063400 MOVE "VI-51 6.2" TO ANSI-REFERENCE. NC2384.2 +063500 MOVE "SEARCH ALL " TO FEATURE. NC2384.2 +063600 MOVE "ARITHMETIC EXPRESSION OF ZERO" TO RE-MARK. NC2384.2 +063700 SCH-TEST-F2-10. NC2384.2 +063800 SEARCH ALL 1ST-ENTRY NC2384.2 +063900 AT END MOVE ZERO TO LEVEL-HOLD NC2384.2 +064000 WHEN FIELD-1 (IDX-4) EQUAL TO ZERO NC2384.2 +064100 MOVE 2 TO LEVEL-HOLD. NC2384.2 +064200 IF LEVEL-HOLD EQUAL TO ZERO NC2384.2 +064300 PERFORM PASS NC2384.2 +064400 GO TO SCH-WRITE-F2-10. NC2384.2 +064500 GO TO SCH-FAIL-F2-10. NC2384.2 +064600 SCH-DELETE-F2-10. NC2384.2 +064700 PERFORM DE-LETE. NC2384.2 +064800 GO TO SCH-WRITE-F2-10. NC2384.2 +064900 SCH-FAIL-F2-10. NC2384.2 +065000 MOVE LEVEL-HOLD TO COMPUTED-A. NC2384.2 +065100 MOVE ZERO TO CORRECT-A. NC2384.2 +065200 PERFORM FAIL. NC2384.2 +065300 SCH-WRITE-F2-10. NC2384.2 +065400 PERFORM PRINT-DETAIL. NC2384.2 +065500* NC2384.2 +065600 CCVS-EXIT SECTION. NC2384.2 +065700 CCVS-999999. NC2384.2 +065800 GO TO CLOSE-FILES. NC2384.2 diff --git a/tests/cobol85/NC/NC239A.CBL b/tests/cobol85/NC/NC239A.CBL new file mode 100755 index 00000000..363a2fb0 --- /dev/null +++ b/tests/cobol85/NC/NC239A.CBL @@ -0,0 +1,528 @@ +000100 IDENTIFICATION DIVISION. NC2394.2 +000200 PROGRAM-ID. NC2394.2 +000300 NC239A. NC2394.2 +000400**************************************************************** NC2394.2 +000500* * NC2394.2 +000600* VALIDATION FOR:- * NC2394.2 +000700* * NC2394.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2394.2 +000900* * NC2394.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2394.2 +001100* * NC2394.2 +001200**************************************************************** NC2394.2 +001300* * NC2394.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2394.2 +001500* * NC2394.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2394.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2394.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2394.2 +001900* * NC2394.2 +002000**************************************************************** NC2394.2 +002100* * NC2394.2 +002200* PROGRAM NC239A TESTS THE CONSTRUCTION AND ACCESS OF A * NC2394.2 +002300* THREE-DIMENSIONAL TABLE USING INDICES. * NC2394.2 +002400* VALUES ARE VERIFIED USING THE "IF" STATEMENT. * NC2394.2 +002500* ~ * NC2394.2 +002600**************************************************************** NC2394.2 +002700 ENVIRONMENT DIVISION. NC2394.2 +002800 CONFIGURATION SECTION. NC2394.2 +002900 SOURCE-COMPUTER. NC2394.2 +003000 Linux. NC2394.2 +003100 OBJECT-COMPUTER. NC2394.2 +003200 Linux. NC2394.2 +003300 INPUT-OUTPUT SECTION. NC2394.2 +003400 FILE-CONTROL. NC2394.2 +003500 SELECT PRINT-FILE ASSIGN TO NC2394.2 +003600 "report.log". NC2394.2 +003700 DATA DIVISION. NC2394.2 +003800 FILE SECTION. NC2394.2 +003900 FD PRINT-FILE. NC2394.2 +004000 01 PRINT-REC PICTURE X(120). NC2394.2 +004100 01 DUMMY-RECORD PICTURE X(120). NC2394.2 +004200 WORKING-STORAGE SECTION. NC2394.2 +004300 77 SUB-1 PICTURE S99 VALUE ZERO. NC2394.2 +004400 77 SUB-2 PICTURE 99 VALUE ZERO. NC2394.2 +004500 77 SUB-3 PICTURE 99 VALUE ZERO. NC2394.2 +004600 77 CON-7 PICTURE 99 VALUE 07. NC2394.2 +004700 77 CON-10 PICTURE 99 VALUE 10. NC2394.2 +004800 77 CON-5 PICTURE 99 VALUE 05. NC2394.2 +004900 77 CON-6 PICTURE 99 VALUE 06. NC2394.2 +005000 01 GRP-NAME. NC2394.2 +005100 02 FILLER PICTURE XXX VALUE "GRP". NC2394.2 +005200 02 ADD-GRP PICTURE 99 VALUE 01. NC2394.2 +005300 NC2394.2 +005400 01 SEC-NAME. NC2394.2 +005500 02 FILLER PICTURE X(5) VALUE "SEC (". NC2394.2 +005600 02 SEC-GRP PICTURE 99 VALUE 00. NC2394.2 +005700 02 FILLER PICTURE X VALUE ",". NC2394.2 +005800 02 ADD-SEC PICTURE 99 VALUE 01. NC2394.2 +005900 02 FILLER PICTURE X VALUE ")". NC2394.2 +006000 NC2394.2 +006100 01 ELEM-NAME. NC2394.2 +006200 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2394.2 +006300 02 ELEM-GRP PICTURE 99 VALUE 00. NC2394.2 +006400 02 FILLER PICTURE X VALUE ",". NC2394.2 +006500 02 ELEM-SEC PICTURE 99 VALUE 00. NC2394.2 +006600 02 FILLER PICTURE X VALUE ",". NC2394.2 +006700 02 ADD-ELEM PICTURE 99 VALUE 01. NC2394.2 +006800 02 FILLER PICTURE X VALUE ")". NC2394.2 +006900 NC2394.2 +007000 01 3-DIMENSION-TBL. NC2394.2 +007100 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2394.2 +007200 03 ENTRY-1 PICTURE X(5). NC2394.2 +007300 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2394.2 +007400 04 ENTRY-2 PICTURE X(11). NC2394.2 +007500 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2394.2 +007600 05 ENTRY-3 PICTURE X(15). NC2394.2 +007700 NC2394.2 +007800 01 TEST-RESULTS. NC2394.2 +007900 02 FILLER PIC X VALUE SPACE. NC2394.2 +008000 02 FEATURE PIC X(20) VALUE SPACE. NC2394.2 +008100 02 FILLER PIC X VALUE SPACE. NC2394.2 +008200 02 P-OR-F PIC X(5) VALUE SPACE. NC2394.2 +008300 02 FILLER PIC X VALUE SPACE. NC2394.2 +008400 02 PAR-NAME. NC2394.2 +008500 03 FILLER PIC X(19) VALUE SPACE. NC2394.2 +008600 03 PARDOT-X PIC X VALUE SPACE. NC2394.2 +008700 03 DOTVALUE PIC 99 VALUE ZERO. NC2394.2 +008800 02 FILLER PIC X(8) VALUE SPACE. NC2394.2 +008900 02 RE-MARK PIC X(61). NC2394.2 +009000 01 TEST-COMPUTED. NC2394.2 +009100 02 FILLER PIC X(30) VALUE SPACE. NC2394.2 +009200 02 FILLER PIC X(17) VALUE NC2394.2 +009300 " COMPUTED=". NC2394.2 +009400 02 COMPUTED-X. NC2394.2 +009500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2394.2 +009600 03 COMPUTED-N REDEFINES COMPUTED-A NC2394.2 +009700 PIC -9(9).9(9). NC2394.2 +009800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2394.2 +009900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2394.2 +010000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2394.2 +010100 03 CM-18V0 REDEFINES COMPUTED-A. NC2394.2 +010200 04 COMPUTED-18V0 PIC -9(18). NC2394.2 +010300 04 FILLER PIC X. NC2394.2 +010400 03 FILLER PIC X(50) VALUE SPACE. NC2394.2 +010500 01 TEST-CORRECT. NC2394.2 +010600 02 FILLER PIC X(30) VALUE SPACE. NC2394.2 +010700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2394.2 +010800 02 CORRECT-X. NC2394.2 +010900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2394.2 +011000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2394.2 +011100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2394.2 +011200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2394.2 +011300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2394.2 +011400 03 CR-18V0 REDEFINES CORRECT-A. NC2394.2 +011500 04 CORRECT-18V0 PIC -9(18). NC2394.2 +011600 04 FILLER PIC X. NC2394.2 +011700 03 FILLER PIC X(2) VALUE SPACE. NC2394.2 +011800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2394.2 +011900 01 CCVS-C-1. NC2394.2 +012000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2394.2 +012100- "SS PARAGRAPH-NAME NC2394.2 +012200- " REMARKS". NC2394.2 +012300 02 FILLER PIC X(20) VALUE SPACE. NC2394.2 +012400 01 CCVS-C-2. NC2394.2 +012500 02 FILLER PIC X VALUE SPACE. NC2394.2 +012600 02 FILLER PIC X(6) VALUE "TESTED". NC2394.2 +012700 02 FILLER PIC X(15) VALUE SPACE. NC2394.2 +012800 02 FILLER PIC X(4) VALUE "FAIL". NC2394.2 +012900 02 FILLER PIC X(94) VALUE SPACE. NC2394.2 +013000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2394.2 +013100 01 REC-CT PIC 99 VALUE ZERO. NC2394.2 +013200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2394.2 +013300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2394.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2394.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2394.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2394.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2394.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2394.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2394.2 +014000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2394.2 +014100 01 CCVS-H-1. NC2394.2 +014200 02 FILLER PIC X(39) VALUE SPACES. NC2394.2 +014300 02 FILLER PIC X(42) VALUE NC2394.2 +014400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2394.2 +014500 02 FILLER PIC X(39) VALUE SPACES. NC2394.2 +014600 01 CCVS-H-2A. NC2394.2 +014700 02 FILLER PIC X(40) VALUE SPACE. NC2394.2 +014800 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2394.2 +014900 02 FILLER PIC XXXX VALUE NC2394.2 +015000 "4.2 ". NC2394.2 +015100 02 FILLER PIC X(28) VALUE NC2394.2 +015200 " COPY - NOT FOR DISTRIBUTION". NC2394.2 +015300 02 FILLER PIC X(41) VALUE SPACE. NC2394.2 +015400 NC2394.2 +015500 01 CCVS-H-2B. NC2394.2 +015600 02 FILLER PIC X(15) VALUE NC2394.2 +015700 "TEST RESULT OF ". NC2394.2 +015800 02 TEST-ID PIC X(9). NC2394.2 +015900 02 FILLER PIC X(4) VALUE NC2394.2 +016000 " IN ". NC2394.2 +016100 02 FILLER PIC X(12) VALUE NC2394.2 +016200 " HIGH ". NC2394.2 +016300 02 FILLER PIC X(22) VALUE NC2394.2 +016400 " LEVEL VALIDATION FOR ". NC2394.2 +016500 02 FILLER PIC X(58) VALUE NC2394.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2394.2 +016700 01 CCVS-H-3. NC2394.2 +016800 02 FILLER PIC X(34) VALUE NC2394.2 +016900 " FOR OFFICIAL USE ONLY ". NC2394.2 +017000 02 FILLER PIC X(58) VALUE NC2394.2 +017100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2394.2 +017200 02 FILLER PIC X(28) VALUE NC2394.2 +017300 " COPYRIGHT 1985 ". NC2394.2 +017400 01 CCVS-E-1. NC2394.2 +017500 02 FILLER PIC X(52) VALUE SPACE. NC2394.2 +017600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2394.2 +017700 02 ID-AGAIN PIC X(9). NC2394.2 +017800 02 FILLER PIC X(45) VALUE SPACES. NC2394.2 +017900 01 CCVS-E-2. NC2394.2 +018000 02 FILLER PIC X(31) VALUE SPACE. NC2394.2 +018100 02 FILLER PIC X(21) VALUE SPACE. NC2394.2 +018200 02 CCVS-E-2-2. NC2394.2 +018300 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2394.2 +018400 03 FILLER PIC X VALUE SPACE. NC2394.2 +018500 03 ENDER-DESC PIC X(44) VALUE NC2394.2 +018600 "ERRORS ENCOUNTERED". NC2394.2 +018700 01 CCVS-E-3. NC2394.2 +018800 02 FILLER PIC X(22) VALUE NC2394.2 +018900 " FOR OFFICIAL USE ONLY". NC2394.2 +019000 02 FILLER PIC X(12) VALUE SPACE. NC2394.2 +019100 02 FILLER PIC X(58) VALUE NC2394.2 +019200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2394.2 +019300 02 FILLER PIC X(13) VALUE SPACE. NC2394.2 +019400 02 FILLER PIC X(15) VALUE NC2394.2 +019500 " COPYRIGHT 1985". NC2394.2 +019600 01 CCVS-E-4. NC2394.2 +019700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2394.2 +019800 02 FILLER PIC X(4) VALUE " OF ". NC2394.2 +019900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2394.2 +020000 02 FILLER PIC X(40) VALUE NC2394.2 +020100 " TESTS WERE EXECUTED SUCCESSFULLY". NC2394.2 +020200 01 XXINFO. NC2394.2 +020300 02 FILLER PIC X(19) VALUE NC2394.2 +020400 "*** INFORMATION ***". NC2394.2 +020500 02 INFO-TEXT. NC2394.2 +020600 04 FILLER PIC X(8) VALUE SPACE. NC2394.2 +020700 04 XXCOMPUTED PIC X(20). NC2394.2 +020800 04 FILLER PIC X(5) VALUE SPACE. NC2394.2 +020900 04 XXCORRECT PIC X(20). NC2394.2 +021000 02 INF-ANSI-REFERENCE PIC X(48). NC2394.2 +021100 01 HYPHEN-LINE. NC2394.2 +021200 02 FILLER PIC IS X VALUE IS SPACE. NC2394.2 +021300 02 FILLER PIC IS X(65) VALUE IS "************************NC2394.2 +021400- "*****************************************". NC2394.2 +021500 02 FILLER PIC IS X(54) VALUE IS "************************NC2394.2 +021600- "******************************". NC2394.2 +021700 01 CCVS-PGM-ID PIC X(9) VALUE NC2394.2 +021800 "NC239A". NC2394.2 +021900 PROCEDURE DIVISION. NC2394.2 +022000 CCVS1 SECTION. NC2394.2 +022100 OPEN-FILES. NC2394.2 +022200 OPEN OUTPUT PRINT-FILE. NC2394.2 +022300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2394.2 +022400 MOVE SPACE TO TEST-RESULTS. NC2394.2 +022500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2394.2 +022600 GO TO CCVS1-EXIT. NC2394.2 +022700 CLOSE-FILES. NC2394.2 +022800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2394.2 +022900 TERMINATE-CCVS. NC2394.2 +023000*S EXIT PROGRAM. NC2394.2 +023100*SERMINATE-CALL. NC2394.2 +023200 STOP RUN. NC2394.2 +023300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2394.2 +023400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2394.2 +023500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2394.2 +023600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2394.2 +023700 MOVE "****TEST DELETED****" TO RE-MARK. NC2394.2 +023800 PRINT-DETAIL. NC2394.2 +023900 IF REC-CT NOT EQUAL TO ZERO NC2394.2 +024000 MOVE "." TO PARDOT-X NC2394.2 +024100 MOVE REC-CT TO DOTVALUE. NC2394.2 +024200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2394.2 +024300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2394.2 +024400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2394.2 +024500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2394.2 +024600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2394.2 +024700 MOVE SPACE TO CORRECT-X. NC2394.2 +024800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2394.2 +024900 MOVE SPACE TO RE-MARK. NC2394.2 +025000 HEAD-ROUTINE. NC2394.2 +025100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +025200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +025300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2394.2 +025400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2394.2 +025500 COLUMN-NAMES-ROUTINE. NC2394.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +025900 END-ROUTINE. NC2394.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2394.2 +026100 END-RTN-EXIT. NC2394.2 +026200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +026300 END-ROUTINE-1. NC2394.2 +026400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2394.2 +026500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2394.2 +026600 ADD PASS-COUNTER TO ERROR-HOLD. NC2394.2 +026700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2394.2 +026800 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2394.2 +026900 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2394.2 +027000 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2394.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2394.2 +027200 END-ROUTINE-12. NC2394.2 +027300 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2394.2 +027400 IF ERROR-COUNTER IS EQUAL TO ZERO NC2394.2 +027500 MOVE "NO " TO ERROR-TOTAL NC2394.2 +027600 ELSE NC2394.2 +027700 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2394.2 +027800 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2394.2 +027900 PERFORM WRITE-LINE. NC2394.2 +028000 END-ROUTINE-13. NC2394.2 +028100 IF DELETE-COUNTER IS EQUAL TO ZERO NC2394.2 +028200 MOVE "NO " TO ERROR-TOTAL ELSE NC2394.2 +028300 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2394.2 +028400 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2394.2 +028500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +028600 IF INSPECT-COUNTER EQUAL TO ZERO NC2394.2 +028700 MOVE "NO " TO ERROR-TOTAL NC2394.2 +028800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2394.2 +028900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2394.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +029100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2394.2 +029200 WRITE-LINE. NC2394.2 +029300 ADD 1 TO RECORD-COUNT. NC2394.2 +029400 IF RECORD-COUNT GREATER 50 NC2394.2 +029500 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2394.2 +029600 MOVE SPACE TO DUMMY-RECORD NC2394.2 +029700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2394.2 +029800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2394.2 +029900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2394.2 +030000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2394.2 +030100 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2394.2 +030200 MOVE ZERO TO RECORD-COUNT. NC2394.2 +030300 PERFORM WRT-LN. NC2394.2 +030400 WRT-LN. NC2394.2 +030500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2394.2 +030600 MOVE SPACE TO DUMMY-RECORD. NC2394.2 +030700 BLANK-LINE-PRINT. NC2394.2 +030800 PERFORM WRT-LN. NC2394.2 +030900 FAIL-ROUTINE. NC2394.2 +031000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2394.2 +031100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2394.2 +031200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2394.2 +031300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2394.2 +031400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +031500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2394.2 +031600 GO TO FAIL-ROUTINE-EX. NC2394.2 +031700 FAIL-ROUTINE-WRITE. NC2394.2 +031800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2394.2 +031900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2394.2 +032000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2394.2 +032100 MOVE SPACES TO COR-ANSI-REFERENCE. NC2394.2 +032200 FAIL-ROUTINE-EX. EXIT. NC2394.2 +032300 BAIL-OUT. NC2394.2 +032400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2394.2 +032500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2394.2 +032600 BAIL-OUT-WRITE. NC2394.2 +032700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2394.2 +032800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2394.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2394.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2394.2 +033100 BAIL-OUT-EX. EXIT. NC2394.2 +033200 CCVS1-EXIT. NC2394.2 +033300 EXIT. NC2394.2 +033400 SECT-NC239A-001 SECTION. NC2394.2 +033500 TH-12-001. NC2394.2 +033600 TABLE-INIT. NC2394.2 +033700 PERFORM TABLE-INIT-SUBROUTINE VARYING SUB-1 FROM 1 BY 1 NC2394.2 +033800 UNTIL SUB-1 EQUAL TO 11 NC2394.2 +033900 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2394.2 +034000 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11. NC2394.2 +034100 GO TO TABLE-TEST. NC2394.2 +034200 NC2394.2 +034300 TABLE-INIT-SUBROUTINE. NC2394.2 +034400 SET IDX-1 TO SUB-1. NC2394.2 +034500 SET IDX-2 TO SUB-2. NC2394.2 +034600 SET IDX-3 TO SUB-3. NC2394.2 +034700 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2394.2 +034800 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2394.2 +034900 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2394.2 +035000 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2394.2 +035100 SET ADD-ELEM TO IDX-3. NC2394.2 +035200 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2394.2 +035300 NC2394.2 +035400 TABLE-TEST. NC2394.2 +035500 MOVE "LEVEL 1 INT INDEXING" TO FEATURE. NC2394.2 +035600 MOVE "TABLE-TEST" TO PAR-NAME. NC2394.2 +035700 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +035800 SET IDX-1 TO 5. NC2394.2 +035900 IF ENTRY-1 (IDX-1) IS NOT EQUAL TO "GRP05" NC2394.2 +036000 GO TO TABLE-FAIL. NC2394.2 +036100 PERFORM PASS. NC2394.2 +036200 GO TO TABLE-WRITE. NC2394.2 +036300 TABLE-FAIL. NC2394.2 +036400 MOVE "GRP05" TO CORRECT-A NC2394.2 +036500 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A NC2394.2 +036600 MOVE "INTERNAL INDEXING LEVEL 1 " TO RE-MARK NC2394.2 +036700 PERFORM FAIL. NC2394.2 +036800 TABLE-WRITE. NC2394.2 +036900 PERFORM PRINT-DETAIL. NC2394.2 +037000 NC2394.2 +037100 TH1-INIT-GF-1. NC2394.2 +037200 MOVE "TH1-TEST-GF-1" TO PAR-NAME. NC2394.2 +037300 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +037400 MOVE "LEVEL 1 INT INDEXING" TO FEATURE. NC2394.2 +037500 SET IDX-1 TO 8. NC2394.2 +037600 TH1-TEST-GF-1. NC2394.2 +037700 IF ENTRY-1 (IDX-1) IS NOT EQUAL TO "GRP08" NC2394.2 +037800 GO TO TH1-FAIL-GF-1. NC2394.2 +037900 PERFORM PASS. NC2394.2 +038000 GO TO TH1-WRITE-GF-1. NC2394.2 +038100 TH1-DELETE-GF-1. NC2394.2 +038200 PERFORM DE-LETE. NC2394.2 +038300 GO TO TH1-WRITE-GF-1. NC2394.2 +038400 TH1-FAIL-GF-1. NC2394.2 +038500 MOVE "GRP08" TO CORRECT-A NC2394.2 +038600 MOVE ENTRY-1 (IDX-1) TO COMPUTED-A NC2394.2 +038700 MOVE "INTERNAL INDEXING LEVEL 1 " TO RE-MARK NC2394.2 +038800 PERFORM FAIL. NC2394.2 +038900 TH1-WRITE-GF-1. NC2394.2 +039000 PERFORM PRINT-DETAIL. NC2394.2 +039100 NC2394.2 +039200 TH2-INIT-GF-1. NC2394.2 +039300 MOVE "LEVEL 2 INT INDEXING" TO FEATURE. NC2394.2 +039400 MOVE "TH2-TEST-GF-1" TO PAR-NAME. NC2394.2 +039500 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +039600 SET IDX-1 TO 5. NC2394.2 +039700 SET IDX-2 TO 6. NC2394.2 +039800 TH2-TEST-GF-1. NC2394.2 +039900 IF ENTRY-2 (IDX-1, IDX-2) IS NOT EQUAL TO "SEC (05,06)" NC2394.2 +040000 GO TO TH2-FAIL-GF-1. NC2394.2 +040100 PERFORM PASS. NC2394.2 +040200 GO TO TH2-WRITE-GF-1. NC2394.2 +040300 TH2-DELETE-GF-1. NC2394.2 +040400 PERFORM DE-LETE. NC2394.2 +040500 GO TO TH2-WRITE-GF-1. NC2394.2 +040600 TH2-FAIL-GF-1. NC2394.2 +040700 MOVE "SEC (05,06)" TO CORRECT-A NC2394.2 +040800 MOVE ENTRY-2 (IDX-1, IDX-2) TO COMPUTED-A NC2394.2 +040900 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC2394.2 +041000 PERFORM FAIL. NC2394.2 +041100 TH2-WRITE-GF-1. NC2394.2 +041200 PERFORM PRINT-DETAIL. NC2394.2 +041300 NC2394.2 +041400 TH2-INIT-GF-2. NC2394.2 +041500 MOVE "TH2-TEST-GF-2" TO PAR-NAME. NC2394.2 +041600 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +041700 MOVE "LEVEL 2 INT INDEXING" TO FEATURE. NC2394.2 +041800 SET IDX-1, IDX-2 TO 8. NC2394.2 +041900 TH2-TEST-GF-2. NC2394.2 +042000 IF ENTRY-2 (IDX-1, IDX-2) IS NOT EQUAL TO "SEC (08,08)" NC2394.2 +042100 GO TO TH2-FAIL-GF-2. NC2394.2 +042200 PERFORM PASS. NC2394.2 +042300 GO TO TH2-WRITE-GF-2. NC2394.2 +042400 TH2-DELETE-GF-2. NC2394.2 +042500 PERFORM DE-LETE. NC2394.2 +042600 GO TO TH2-WRITE-GF-2. NC2394.2 +042700 TH2-FAIL-GF-2. NC2394.2 +042800 MOVE "SEC (08,08)" TO CORRECT-A NC2394.2 +042900 MOVE ENTRY-2 (IDX-1, IDX-2) TO COMPUTED-A NC2394.2 +043000 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC2394.2 +043100 PERFORM FAIL. NC2394.2 +043200 TH2-WRITE-GF-2. NC2394.2 +043300 PERFORM PRINT-DETAIL. NC2394.2 +043400 NC2394.2 +043500 TH2-INIT-GF-3. NC2394.2 +043600 MOVE "TH2-TEST-GF-3" TO PAR-NAME. NC2394.2 +043700 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +043800 MOVE "LEVEL 2 INT INDEXING" TO FEATURE. NC2394.2 +043900 SET IDX-1 TO 3. NC2394.2 +044000 SET IDX-2 TO 7. NC2394.2 +044100 TH2-TEST-GF-3. NC2394.2 +044200 IF ENTRY-2 (IDX-1, IDX-2) IS NOT EQUAL TO "SEC (03,07)" NC2394.2 +044300 GO TO TH2-FAIL-GF-3. NC2394.2 +044400 PERFORM PASS. NC2394.2 +044500 GO TO TH2-WRITE-GF-3. NC2394.2 +044600 TH2-DELETE-GF-3. NC2394.2 +044700 PERFORM DE-LETE. NC2394.2 +044800 GO TO TH2-WRITE-GF-3. NC2394.2 +044900 TH2-FAIL-GF-3. NC2394.2 +045000 MOVE "SEC (03,07)" TO CORRECT-A NC2394.2 +045100 MOVE ENTRY-2 (IDX-1, IDX-2) TO COMPUTED-A NC2394.2 +045200 MOVE "INTERNAL INDEXING LEVEL 2 " TO RE-MARK NC2394.2 +045300 PERFORM FAIL. NC2394.2 +045400 TH2-WRITE-GF-3. NC2394.2 +045500 PERFORM PRINT-DETAIL. NC2394.2 +045600 NC2394.2 +045700 TH3-INIT-GF-1. NC2394.2 +045800 MOVE "TH3-TEST-GF-1" TO PAR-NAME. NC2394.2 +045900 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +046000 MOVE "LEVEL 3 INT INDEXING" TO FEATURE. NC2394.2 +046100 SET IDX-1 TO 2. NC2394.2 +046200 SET IDX-2 TO 6. NC2394.2 +046300 SET IDX-3 TO 10. NC2394.2 +046400 TH3-TEST-GF-1. NC2394.2 +046500 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) IS NOT EQUAL TO NC2394.2 +046600 "ELEM (02,06,10)" NC2394.2 +046700 GO TO TH3-FAIL-GF-1. NC2394.2 +046800 PERFORM PASS. NC2394.2 +046900 GO TO TH3-WRITE-GF-1. NC2394.2 +047000 TH3-DELETE-GF-1. NC2394.2 +047100 PERFORM DE-LETE. NC2394.2 +047200 GO TO TH3-WRITE-GF-1. NC2394.2 +047300 TH3-FAIL-GF-1. NC2394.2 +047400 MOVE "ELEM (02,06,10)" TO CORRECT-A NC2394.2 +047500 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A NC2394.2 +047600 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC2394.2 +047700 PERFORM FAIL. NC2394.2 +047800 TH3-WRITE-GF-1. NC2394.2 +047900 PERFORM PRINT-DETAIL. NC2394.2 +048000 NC2394.2 +048100 TH3-INIT-GF-2. NC2394.2 +048200 MOVE "TH3-TEST-GF-2" TO PAR-NAME. NC2394.2 +048300 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +048400 MOVE "LEVEL 3 INT INDEXING" TO FEATURE. NC2394.2 +048500 SET IDX-1, IDX-2, IDX-3 TO 6. NC2394.2 +048600 TH3-TEST-GF-2. NC2394.2 +048700 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) IS NOT EQUAL TO NC2394.2 +048800 "ELEM (06,06,06)" NC2394.2 +048900 GO TO TH3-FAIL-GF-2. NC2394.2 +049000 PERFORM PASS. NC2394.2 +049100 GO TO TH3-WRITE-GF-2. NC2394.2 +049200 TH3-DELETE-GF-2. NC2394.2 +049300 PERFORM DE-LETE. NC2394.2 +049400 GO TO TH3-WRITE-GF-2. NC2394.2 +049500 TH3-FAIL-GF-2. NC2394.2 +049600 MOVE "ELEM (06,06,06)" TO CORRECT-A NC2394.2 +049700 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A NC2394.2 +049800 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC2394.2 +049900 PERFORM FAIL. NC2394.2 +050000 TH3-WRITE-GF-2. NC2394.2 +050100 PERFORM PRINT-DETAIL. NC2394.2 +050200 NC2394.2 +050300 TH3-INIT-GF-3. NC2394.2 +050400 MOVE "TH3-TEST-GF-3" TO PAR-NAME. NC2394.2 +050500 MOVE "IV-21 & II-15 4.4.2" TO ANSI-REFERENCE. NC2394.2 +050600 MOVE "LEVEL 3 INT INDEXING" TO FEATURE. NC2394.2 +050700 SET IDX-1 TO 9. NC2394.2 +050800 SET IDX-2 TO 8. NC2394.2 +050900 SET IDX-3 TO 7. NC2394.2 +051000 TH3-TEST-GF-3. NC2394.2 +051100 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) IS NOT EQUAL TO NC2394.2 +051200 "ELEM (09,08,07)" NC2394.2 +051300 GO TO TH3-FAIL-GF-3. NC2394.2 +051400 PERFORM PASS. NC2394.2 +051500 GO TO TH3-WRITE-GF-3. NC2394.2 +051600 TH3-DELETE-GF-3. NC2394.2 +051700 PERFORM DE-LETE. NC2394.2 +051800 GO TO TH3-WRITE-GF-3. NC2394.2 +051900 TH3-FAIL-GF-3. NC2394.2 +052000 MOVE "ELEM (09,08,07)" TO CORRECT-A NC2394.2 +052100 MOVE ENTRY-3 (IDX-1, IDX-2, IDX-3) TO COMPUTED-A NC2394.2 +052200 MOVE "INTERNAL INDEXING LEVEL 3 " TO RE-MARK NC2394.2 +052300 PERFORM FAIL. NC2394.2 +052400 TH3-WRITE-GF-3. NC2394.2 +052500 PERFORM PRINT-DETAIL. NC2394.2 +052600 CCVS-EXIT SECTION. NC2394.2 +052700 CCVS-999999. NC2394.2 +052800 GO TO CLOSE-FILES. NC2394.2 diff --git a/tests/cobol85/NC/NC240A.CBL b/tests/cobol85/NC/NC240A.CBL new file mode 100755 index 00000000..468bdc7c --- /dev/null +++ b/tests/cobol85/NC/NC240A.CBL @@ -0,0 +1,693 @@ +000100 IDENTIFICATION DIVISION. NC2404.2 +000200 PROGRAM-ID. NC2404.2 +000300 NC240A. NC2404.2 +000400 NC2404.2 +000500**************************************************************** NC2404.2 +000600* * NC2404.2 +000700* VALIDATION FOR:- * NC2404.2 +000800* * NC2404.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2404.2 +001000* * NC2404.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2404.2 +001200* * NC2404.2 +001300**************************************************************** NC2404.2 +001400* * NC2404.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2404.2 +001600* * NC2404.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2404.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2404.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2404.2 +002000* * NC2404.2 +002100**************************************************************** NC2404.2 +002200* * NC2404.2 +002300* PROGRAM NC240A TESTS THE CONSTRUCTION AND ACCESS OF A * NC2404.2 +002400* THREE-DIMENSIONAL TABLE USING SUBSCRIPTS. THE CONTENT OF * NC2404.2 +002500* TABLE ELEMENTS IS VERIFIED BY USE OF THE FORMAT 4 * NC2404.2 +002600* "PERFORM" STATEMENT. * NC2404.2 +002700* * NC2404.2 +002800**************************************************************** NC2404.2 +002900 NC2404.2 +003000 ENVIRONMENT DIVISION. NC2404.2 +003100 CONFIGURATION SECTION. NC2404.2 +003200 SOURCE-COMPUTER. NC2404.2 +003300 Linux. NC2404.2 +003400 OBJECT-COMPUTER. NC2404.2 +003500 Linux. NC2404.2 +003600 INPUT-OUTPUT SECTION. NC2404.2 +003700 FILE-CONTROL. NC2404.2 +003800 SELECT PRINT-FILE ASSIGN TO NC2404.2 +003900 "report.log". NC2404.2 +004000 DATA DIVISION. NC2404.2 +004100 FILE SECTION. NC2404.2 +004200 FD PRINT-FILE. NC2404.2 +004300 01 PRINT-REC PICTURE X(120). NC2404.2 +004400 01 DUMMY-RECORD PICTURE X(120). NC2404.2 +004500 WORKING-STORAGE SECTION. NC2404.2 +004600 77 SUB-1 PICTURE S99 VALUE ZERO. NC2404.2 +004700 77 SUB-2 PICTURE 99 VALUE ZERO. NC2404.2 +004800 77 SUB-3 PICTURE 99 VALUE ZERO. NC2404.2 +004900 77 TEST-CHECK PIC X(4) VALUE SPACE. NC2404.2 +005000 77 CON-10 PICTURE 99 VALUE 10. NC2404.2 +005100 77 CON-7 PICTURE 99 VALUE 07. NC2404.2 +005200 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2404.2 +005300 77 CON-5 PICTURE 99 VALUE 05. NC2404.2 +005400 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2404.2 +005500 77 CON-6 PICTURE 99 VALUE 06. NC2404.2 +005600 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2404.2 +005700 01 GRP-NAME. NC2404.2 +005800 02 FILLER PICTURE XXX VALUE "GRP". NC2404.2 +005900 02 ADD-GRP PICTURE 99 VALUE 01. NC2404.2 +006000 NC2404.2 +006100 01 SEC-NAME. NC2404.2 +006200 02 FILLER PICTURE X(5) VALUE "SEC (". NC2404.2 +006300 02 SEC-GRP PICTURE 99 VALUE 00. NC2404.2 +006400 02 FILLER PICTURE X VALUE ",". NC2404.2 +006500 02 ADD-SEC PICTURE 99 VALUE 01. NC2404.2 +006600 02 FILLER PICTURE X VALUE ")". NC2404.2 +006700 NC2404.2 +006800 01 ELEM-NAME. NC2404.2 +006900 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2404.2 +007000 02 ELEM-GRP PICTURE 99 VALUE 00. NC2404.2 +007100 02 FILLER PICTURE X VALUE ",". NC2404.2 +007200 02 ELEM-SEC PICTURE 99 VALUE 00. NC2404.2 +007300 02 FILLER PICTURE X VALUE ",". NC2404.2 +007400 02 ADD-ELEM PICTURE 99 VALUE 01. NC2404.2 +007500 02 FILLER PICTURE X VALUE ")". NC2404.2 +007600 NC2404.2 +007700 01 3-DIMENSION-TBL. NC2404.2 +007800 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2404.2 +007900 03 ENTRY-1 PICTURE X(5). NC2404.2 +008000 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2404.2 +008100 04 ENTRY-2 PICTURE X(11). NC2404.2 +008200 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2404.2 +008300 05 ENTRY-3 PICTURE X(15). NC2404.2 +008400 01 TEST-RESULTS. NC2404.2 +008500 02 FILLER PIC X VALUE SPACE. NC2404.2 +008600 02 FEATURE PIC X(20) VALUE SPACE. NC2404.2 +008700 02 FILLER PIC X VALUE SPACE. NC2404.2 +008800 02 P-OR-F PIC X(5) VALUE SPACE. NC2404.2 +008900 02 FILLER PIC X VALUE SPACE. NC2404.2 +009000 02 PAR-NAME. NC2404.2 +009100 03 FILLER PIC X(19) VALUE SPACE. NC2404.2 +009200 03 PARDOT-X PIC X VALUE SPACE. NC2404.2 +009300 03 DOTVALUE PIC 99 VALUE ZERO. NC2404.2 +009400 02 FILLER PIC X(8) VALUE SPACE. NC2404.2 +009500 02 RE-MARK PIC X(61). NC2404.2 +009600 01 TEST-COMPUTED. NC2404.2 +009700 02 FILLER PIC X(30) VALUE SPACE. NC2404.2 +009800 02 FILLER PIC X(17) VALUE NC2404.2 +009900 " COMPUTED=". NC2404.2 +010000 02 COMPUTED-X. NC2404.2 +010100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2404.2 +010200 03 COMPUTED-N REDEFINES COMPUTED-A NC2404.2 +010300 PIC -9(9).9(9). NC2404.2 +010400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2404.2 +010500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2404.2 +010600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2404.2 +010700 03 CM-18V0 REDEFINES COMPUTED-A. NC2404.2 +010800 04 COMPUTED-18V0 PIC -9(18). NC2404.2 +010900 04 FILLER PIC X. NC2404.2 +011000 03 FILLER PIC X(50) VALUE SPACE. NC2404.2 +011100 01 TEST-CORRECT. NC2404.2 +011200 02 FILLER PIC X(30) VALUE SPACE. NC2404.2 +011300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2404.2 +011400 02 CORRECT-X. NC2404.2 +011500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2404.2 +011600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2404.2 +011700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2404.2 +011800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2404.2 +011900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2404.2 +012000 03 CR-18V0 REDEFINES CORRECT-A. NC2404.2 +012100 04 CORRECT-18V0 PIC -9(18). NC2404.2 +012200 04 FILLER PIC X. NC2404.2 +012300 03 FILLER PIC X(2) VALUE SPACE. NC2404.2 +012400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2404.2 +012500 01 CCVS-C-1. NC2404.2 +012600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2404.2 +012700- "SS PARAGRAPH-NAME NC2404.2 +012800- " REMARKS". NC2404.2 +012900 02 FILLER PIC X(20) VALUE SPACE. NC2404.2 +013000 01 CCVS-C-2. NC2404.2 +013100 02 FILLER PIC X VALUE SPACE. NC2404.2 +013200 02 FILLER PIC X(6) VALUE "TESTED". NC2404.2 +013300 02 FILLER PIC X(15) VALUE SPACE. NC2404.2 +013400 02 FILLER PIC X(4) VALUE "FAIL". NC2404.2 +013500 02 FILLER PIC X(94) VALUE SPACE. NC2404.2 +013600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2404.2 +013700 01 REC-CT PIC 99 VALUE ZERO. NC2404.2 +013800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2404.2 +013900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2404.2 +014000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2404.2 +014100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2404.2 +014200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2404.2 +014300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2404.2 +014400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2404.2 +014500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2404.2 +014600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2404.2 +014700 01 CCVS-H-1. NC2404.2 +014800 02 FILLER PIC X(39) VALUE SPACES. NC2404.2 +014900 02 FILLER PIC X(42) VALUE NC2404.2 +015000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2404.2 +015100 02 FILLER PIC X(39) VALUE SPACES. NC2404.2 +015200 01 CCVS-H-2A. NC2404.2 +015300 02 FILLER PIC X(40) VALUE SPACE. NC2404.2 +015400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2404.2 +015500 02 FILLER PIC XXXX VALUE NC2404.2 +015600 "4.2 ". NC2404.2 +015700 02 FILLER PIC X(28) VALUE NC2404.2 +015800 " COPY - NOT FOR DISTRIBUTION". NC2404.2 +015900 02 FILLER PIC X(41) VALUE SPACE. NC2404.2 +016000 NC2404.2 +016100 01 CCVS-H-2B. NC2404.2 +016200 02 FILLER PIC X(15) VALUE NC2404.2 +016300 "TEST RESULT OF ". NC2404.2 +016400 02 TEST-ID PIC X(9). NC2404.2 +016500 02 FILLER PIC X(4) VALUE NC2404.2 +016600 " IN ". NC2404.2 +016700 02 FILLER PIC X(12) VALUE NC2404.2 +016800 " HIGH ". NC2404.2 +016900 02 FILLER PIC X(22) VALUE NC2404.2 +017000 " LEVEL VALIDATION FOR ". NC2404.2 +017100 02 FILLER PIC X(58) VALUE NC2404.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2404.2 +017300 01 CCVS-H-3. NC2404.2 +017400 02 FILLER PIC X(34) VALUE NC2404.2 +017500 " FOR OFFICIAL USE ONLY ". NC2404.2 +017600 02 FILLER PIC X(58) VALUE NC2404.2 +017700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2404.2 +017800 02 FILLER PIC X(28) VALUE NC2404.2 +017900 " COPYRIGHT 1985 ". NC2404.2 +018000 01 CCVS-E-1. NC2404.2 +018100 02 FILLER PIC X(52) VALUE SPACE. NC2404.2 +018200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2404.2 +018300 02 ID-AGAIN PIC X(9). NC2404.2 +018400 02 FILLER PIC X(45) VALUE SPACES. NC2404.2 +018500 01 CCVS-E-2. NC2404.2 +018600 02 FILLER PIC X(31) VALUE SPACE. NC2404.2 +018700 02 FILLER PIC X(21) VALUE SPACE. NC2404.2 +018800 02 CCVS-E-2-2. NC2404.2 +018900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2404.2 +019000 03 FILLER PIC X VALUE SPACE. NC2404.2 +019100 03 ENDER-DESC PIC X(44) VALUE NC2404.2 +019200 "ERRORS ENCOUNTERED". NC2404.2 +019300 01 CCVS-E-3. NC2404.2 +019400 02 FILLER PIC X(22) VALUE NC2404.2 +019500 " FOR OFFICIAL USE ONLY". NC2404.2 +019600 02 FILLER PIC X(12) VALUE SPACE. NC2404.2 +019700 02 FILLER PIC X(58) VALUE NC2404.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2404.2 +019900 02 FILLER PIC X(13) VALUE SPACE. NC2404.2 +020000 02 FILLER PIC X(15) VALUE NC2404.2 +020100 " COPYRIGHT 1985". NC2404.2 +020200 01 CCVS-E-4. NC2404.2 +020300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2404.2 +020400 02 FILLER PIC X(4) VALUE " OF ". NC2404.2 +020500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2404.2 +020600 02 FILLER PIC X(40) VALUE NC2404.2 +020700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2404.2 +020800 01 XXINFO. NC2404.2 +020900 02 FILLER PIC X(19) VALUE NC2404.2 +021000 "*** INFORMATION ***". NC2404.2 +021100 02 INFO-TEXT. NC2404.2 +021200 04 FILLER PIC X(8) VALUE SPACE. NC2404.2 +021300 04 XXCOMPUTED PIC X(20). NC2404.2 +021400 04 FILLER PIC X(5) VALUE SPACE. NC2404.2 +021500 04 XXCORRECT PIC X(20). NC2404.2 +021600 02 INF-ANSI-REFERENCE PIC X(48). NC2404.2 +021700 01 HYPHEN-LINE. NC2404.2 +021800 02 FILLER PIC IS X VALUE IS SPACE. NC2404.2 +021900 02 FILLER PIC IS X(65) VALUE IS "************************NC2404.2 +022000- "*****************************************". NC2404.2 +022100 02 FILLER PIC IS X(54) VALUE IS "************************NC2404.2 +022200- "******************************". NC2404.2 +022300 01 CCVS-PGM-ID PIC X(9) VALUE NC2404.2 +022400 "NC240A". NC2404.2 +022500 PROCEDURE DIVISION. NC2404.2 +022600 CCVS1 SECTION. NC2404.2 +022700 OPEN-FILES. NC2404.2 +022800 OPEN OUTPUT PRINT-FILE. NC2404.2 +022900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2404.2 +023000 MOVE SPACE TO TEST-RESULTS. NC2404.2 +023100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2404.2 +023200 GO TO CCVS1-EXIT. NC2404.2 +023300 CLOSE-FILES. NC2404.2 +023400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2404.2 +023500 TERMINATE-CCVS. NC2404.2 +023600*S EXIT PROGRAM. NC2404.2 +023700*SERMINATE-CALL. NC2404.2 +023800 STOP RUN. NC2404.2 +023900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2404.2 +024000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2404.2 +024100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2404.2 +024200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2404.2 +024300 MOVE "****TEST DELETED****" TO RE-MARK. NC2404.2 +024400 PRINT-DETAIL. NC2404.2 +024500 IF REC-CT NOT EQUAL TO ZERO NC2404.2 +024600 MOVE "." TO PARDOT-X NC2404.2 +024700 MOVE REC-CT TO DOTVALUE. NC2404.2 +024800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2404.2 +024900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2404.2 +025000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2404.2 +025100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2404.2 +025200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2404.2 +025300 MOVE SPACE TO CORRECT-X. NC2404.2 +025400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2404.2 +025500 MOVE SPACE TO RE-MARK. NC2404.2 +025600 HEAD-ROUTINE. NC2404.2 +025700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +025800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +025900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2404.2 +026000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2404.2 +026100 COLUMN-NAMES-ROUTINE. NC2404.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +026500 END-ROUTINE. NC2404.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2404.2 +026700 END-RTN-EXIT. NC2404.2 +026800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +026900 END-ROUTINE-1. NC2404.2 +027000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2404.2 +027100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2404.2 +027200 ADD PASS-COUNTER TO ERROR-HOLD. NC2404.2 +027300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2404.2 +027400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2404.2 +027500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2404.2 +027600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2404.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2404.2 +027800 END-ROUTINE-12. NC2404.2 +027900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2404.2 +028000 IF ERROR-COUNTER IS EQUAL TO ZERO NC2404.2 +028100 MOVE "NO " TO ERROR-TOTAL NC2404.2 +028200 ELSE NC2404.2 +028300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2404.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2404.2 +028500 PERFORM WRITE-LINE. NC2404.2 +028600 END-ROUTINE-13. NC2404.2 +028700 IF DELETE-COUNTER IS EQUAL TO ZERO NC2404.2 +028800 MOVE "NO " TO ERROR-TOTAL ELSE NC2404.2 +028900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2404.2 +029000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2404.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +029200 IF INSPECT-COUNTER EQUAL TO ZERO NC2404.2 +029300 MOVE "NO " TO ERROR-TOTAL NC2404.2 +029400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2404.2 +029500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2404.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +029700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2404.2 +029800 WRITE-LINE. NC2404.2 +029900 ADD 1 TO RECORD-COUNT. NC2404.2 +030000 IF RECORD-COUNT GREATER 50 NC2404.2 +030100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2404.2 +030200 MOVE SPACE TO DUMMY-RECORD NC2404.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2404.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2404.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2404.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2404.2 +030700 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2404.2 +030800 MOVE ZERO TO RECORD-COUNT. NC2404.2 +030900 PERFORM WRT-LN. NC2404.2 +031000 WRT-LN. NC2404.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2404.2 +031200 MOVE SPACE TO DUMMY-RECORD. NC2404.2 +031300 BLANK-LINE-PRINT. NC2404.2 +031400 PERFORM WRT-LN. NC2404.2 +031500 FAIL-ROUTINE. NC2404.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2404.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2404.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2404.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2404.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2404.2 +032200 GO TO FAIL-ROUTINE-EX. NC2404.2 +032300 FAIL-ROUTINE-WRITE. NC2404.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2404.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2404.2 +032600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2404.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. NC2404.2 +032800 FAIL-ROUTINE-EX. EXIT. NC2404.2 +032900 BAIL-OUT. NC2404.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2404.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2404.2 +033200 BAIL-OUT-WRITE. NC2404.2 +033300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2404.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2404.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2404.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2404.2 +033700 BAIL-OUT-EX. EXIT. NC2404.2 +033800 CCVS1-EXIT. NC2404.2 +033900 EXIT. NC2404.2 +034000 SECT-NC24A-0001 SECTION. NC2404.2 +034100 TH-13-001. NC2404.2 +034200 BUILD-LEVEL-1. NC2404.2 +034300 ADD 1 TO SUB-1. NC2404.2 +034400 IF SUB-1 = 11 GO TO CHECK-ENTRIES. NC2404.2 +034500 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC2404.2 +034600 ADD 1 TO ADD-GRP. NC2404.2 +034700 NC2404.2 +034800 BUILD-LEVEL-2. NC2404.2 +034900 ADD 1 TO SUB-2. NC2404.2 +035000 IF SUB-2 = 11 NC2404.2 +035100 MOVE ZERO TO SUB-2 NC2404.2 +035200 MOVE 01 TO ADD-SEC NC2404.2 +035300 GO TO BUILD-LEVEL-1. NC2404.2 +035400 MOVE SUB-1 TO SEC-GRP. NC2404.2 +035500 MOVE SEC-NAME TO ENTRY-2 (SUB-1, SUB-2). NC2404.2 +035600 ADD 1 TO ADD-SEC. NC2404.2 +035700 NC2404.2 +035800 BUILD-LEVEL-3. NC2404.2 +035900 ADD 1 TO SUB-3. NC2404.2 +036000 IF SUB-3 = 11 NC2404.2 +036100 MOVE ZERO TO SUB-3 NC2404.2 +036200 MOVE 01 TO ADD-ELEM NC2404.2 +036300 GO TO BUILD-LEVEL-2. NC2404.2 +036400 MOVE SUB-1 TO ELEM-GRP. NC2404.2 +036500 MOVE SUB-2 TO ELEM-SEC. NC2404.2 +036600 MOVE ELEM-NAME TO ENTRY-3 (SUB-1, SUB-2, SUB-3). NC2404.2 +036700 ADD 1 TO ADD-ELEM. NC2404.2 +036800 GO TO BUILD-LEVEL-3. NC2404.2 +036900 NC2404.2 +037000 CHECK-ENTRIES. NC2404.2 +037100 MOVE "PERFORM VARYING LEV1" TO FEATURE. NC2404.2 +037200 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2404.2 +037300 MOVE SPACES TO TEST-CHECK. NC2404.2 +037400 MOVE "GRP05" TO GRP-HOLD-AREA. NC2404.2 +037500 PERFORM FIND-LEVEL-1-ENTRY VARYING CON-5 FROM 1 BY 1 NC2404.2 +037600 UNTIL CON-5 = 11. NC2404.2 +037700 IF TEST-CHECK = "PASS" GO TO TH1-INIT-GF-2. NC2404.2 +037800 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2404.2 +037900 MOVE ENTRY-1 (05) TO COMPUTED-A. NC2404.2 +038000 NC2404.2 +038100 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +038200 PERFORM FAIL. NC2404.2 +038300 PERFORM PRINT-DETAIL. NC2404.2 +038400* NC2404.2 +038500 TH1-INIT-GF-2. NC2404.2 +038600 MOVE "GRP10" TO GRP-HOLD-AREA. NC2404.2 +038700 MOVE "TH1-TEST-GF-2 " TO PAR-NAME. NC2404.2 +038800 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +038900 MOVE SPACES TO TEST-CHECK. NC2404.2 +039000 TH1-TEST-GF-2. NC2404.2 +039100 PERFORM FIND-LEVEL-1-ENTRY NC2404.2 +039200 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11. NC2404.2 +039300 IF TEST-CHECK = "PASS" NC2404.2 +039400 PERFORM PASS NC2404.2 +039500 GO TO TH1-WRITE-GF-2 NC2404.2 +039600 ELSE NC2404.2 +039700 GO TO TH1-FAIL-GF-2. NC2404.2 +039800 TH1-DELETE-GF-2. NC2404.2 +039900 PERFORM DE-LETE. NC2404.2 +040000 GO TO TH1-WRITE-GF-2. NC2404.2 +040100 TH1-FAIL-GF-2. NC2404.2 +040200 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2404.2 +040300 MOVE ENTRY-1 (10) TO COMPUTED-A. NC2404.2 +040400 NC2404.2 +040500 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +040600 PERFORM FAIL. NC2404.2 +040700 TH1-WRITE-GF-2. NC2404.2 +040800 PERFORM PRINT-DETAIL. NC2404.2 +040900 NC2404.2 +041000 TH1-INIT-GF-3. NC2404.2 +041100 MOVE "GRP07" TO GRP-HOLD-AREA. NC2404.2 +041200 MOVE "TH1-TEST-GF-3 " TO PAR-NAME. NC2404.2 +041300 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +041400 MOVE SPACES TO TEST-CHECK. NC2404.2 +041500 TH1-TEST-GF-3. NC2404.2 +041600 PERFORM FIND-LEVEL-1-ENTRY NC2404.2 +041700 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11. NC2404.2 +041800 IF TEST-CHECK = "PASS" NC2404.2 +041900 PERFORM PASS NC2404.2 +042000 GO TO TH1-WRITE-GF-3 NC2404.2 +042100 ELSE NC2404.2 +042200 GO TO TH1-FAIL-GF-3. NC2404.2 +042300 TH1-DELETE-GF-3. NC2404.2 +042400 PERFORM DE-LETE. NC2404.2 +042500 GO TO TH1-WRITE-GF-3. NC2404.2 +042600 TH1-FAIL-GF-3. NC2404.2 +042700 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2404.2 +042800 MOVE ENTRY-1 (07) TO COMPUTED-A. NC2404.2 +042900 NC2404.2 +043000 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +043100 PERFORM FAIL. NC2404.2 +043200 TH1-WRITE-GF-3. NC2404.2 +043300 PERFORM PRINT-DETAIL. NC2404.2 +043400* NC2404.2 +043500 TH1-INIT-GF-4. NC2404.2 +043600 MOVE "TH1-TEST-GF-4 " TO PAR-NAME. NC2404.2 +043700 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +043800 MOVE "GRP01" TO GRP-HOLD-AREA. NC2404.2 +043900 TH1-TEST-GF-4. NC2404.2 +044000 PERFORM FIND-LEVEL-1-ENTRY NC2404.2 +044100 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11. NC2404.2 +044200 IF TEST-CHECK = "PASS" NC2404.2 +044300 PERFORM PASS NC2404.2 +044400 GO TO TH1-WRITE-GF-4 NC2404.2 +044500 ELSE NC2404.2 +044600 GO TO TH1-FAIL-GF-4. NC2404.2 +044700 TH1-DELETE-GF-4. NC2404.2 +044800 PERFORM DE-LETE. NC2404.2 +044900 GO TO TH1-WRITE-GF-4. NC2404.2 +045000 TH1-FAIL-GF-4. NC2404.2 +045100 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2404.2 +045200 MOVE ENTRY-1 (01) TO COMPUTED-A. NC2404.2 +045300 NC2404.2 +045400 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +045500 PERFORM FAIL. NC2404.2 +045600 TH1-WRITE-GF-4. NC2404.2 +045700 PERFORM PRINT-DETAIL. NC2404.2 +045800 GO TO TH2-INIT-GF-1. NC2404.2 +045900 NC2404.2 +046000 FIND-LEVEL-1-ENTRY. NC2404.2 +046100 IF ENTRY-1 (CON-5) = GRP-HOLD-AREA NC2404.2 +046200 MOVE "PASS" TO TEST-CHECK. NC2404.2 +046300 NC2404.2 +046400 TH2-INIT-GF-1. NC2404.2 +046500 MOVE "TH2-TEST-GF-1 " TO PAR-NAME. NC2404.2 +046600 MOVE "PERFORM VARYING LEV2" TO FEATURE. NC2404.2 +046700 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +046800 MOVE "SEC (03,05)" TO SEC-HOLD-AREA. NC2404.2 +046900 MOVE SPACES TO TEST-CHECK. NC2404.2 +047000 TH2-TEST-GF-1. NC2404.2 +047100 PERFORM FIND-LEVEL-2-ENTRY NC2404.2 +047200 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +047300 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10. NC2404.2 +047400 IF TEST-CHECK = "PASS" NC2404.2 +047500 PERFORM PASS NC2404.2 +047600 GO TO TH2-WRITE-GF-1 NC2404.2 +047700 ELSE NC2404.2 +047800 GO TO TH2-FAIL-GF-1. NC2404.2 +047900 TH2-DELETE-GF-1. NC2404.2 +048000 PERFORM DE-LETE. NC2404.2 +048100 GO TO TH2-WRITE-GF-1. NC2404.2 +048200 TH2-FAIL-GF-1. NC2404.2 +048300 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2404.2 +048400 MOVE ENTRY-2 (03, 05) TO COMPUTED-A. NC2404.2 +048500 NC2404.2 +048600 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +048700 PERFORM FAIL. NC2404.2 +048800 TH2-WRITE-GF-1. NC2404.2 +048900 PERFORM PRINT-DETAIL. NC2404.2 +049000 NC2404.2 +049100 TH2-INIT-GF-2. NC2404.2 +049200 MOVE "TH2-TEST-GF-2 " TO PAR-NAME. NC2404.2 +049300 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +049400 MOVE SPACES TO TEST-CHECK. NC2404.2 +049500 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2404.2 +049600 TH2-TEST-GF-2. NC2404.2 +049700 PERFORM FIND-LEVEL-2-ENTRY NC2404.2 +049800 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +049900 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10. NC2404.2 +050000 IF TEST-CHECK = "PASS" NC2404.2 +050100 PERFORM PASS NC2404.2 +050200 GO TO TH2-WRITE-GF-2 NC2404.2 +050300 ELSE NC2404.2 +050400 GO TO TH2-FAIL-GF-2. NC2404.2 +050500 TH2-DELETE-GF-2. NC2404.2 +050600 PERFORM DE-LETE. NC2404.2 +050700 GO TO TH2-WRITE-GF-2. NC2404.2 +050800 TH2-FAIL-GF-2. NC2404.2 +050900 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2404.2 +051000 MOVE ENTRY-2 (01, 01) TO COMPUTED-A. NC2404.2 +051100 NC2404.2 +051200 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +051300 PERFORM FAIL. NC2404.2 +051400 TH2-WRITE-GF-2. NC2404.2 +051500 PERFORM PRINT-DETAIL. NC2404.2 +051600 NC2404.2 +051700 TH2-INIT-GF-3. NC2404.2 +051800 MOVE "TH2-TEST-GF-3 " TO PAR-NAME. NC2404.2 +051900 MOVE SPACES TO TEST-CHECK. NC2404.2 +052000 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +052100 MOVE "SEC (10,01)" TO SEC-HOLD-AREA. NC2404.2 +052200 TH2-TEST-GF-3. NC2404.2 +052300 PERFORM FIND-LEVEL-2-ENTRY NC2404.2 +052400 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +052500 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10. NC2404.2 +052600 IF TEST-CHECK = "PASS" NC2404.2 +052700 PERFORM PASS NC2404.2 +052800 GO TO TH2-WRITE-GF-3 NC2404.2 +052900 ELSE NC2404.2 +053000 GO TO TH2-FAIL-GF-3. NC2404.2 +053100 TH2-DELETE-GF-3. NC2404.2 +053200 PERFORM DE-LETE. NC2404.2 +053300 GO TO TH2-WRITE-GF-3. NC2404.2 +053400 TH2-FAIL-GF-3. NC2404.2 +053500 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2404.2 +053600 MOVE ENTRY-2 (10, 01) TO COMPUTED-A. NC2404.2 +053700 NC2404.2 +053800 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +053900 PERFORM FAIL. NC2404.2 +054000 TH2-WRITE-GF-3. NC2404.2 +054100 PERFORM PRINT-DETAIL. NC2404.2 +054200* NC2404.2 +054300 TH2-INIT-GF-4. NC2404.2 +054400 MOVE "TH2-TEST-GF-4 " TO PAR-NAME. NC2404.2 +054500 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +054600 MOVE SPACES TO TEST-CHECK. NC2404.2 +054700 MOVE SPACES TO TEST-CHECK. NC2404.2 +054800 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2404.2 +054900 TH2-TEST-GF-4. NC2404.2 +055000 PERFORM FIND-LEVEL-2-ENTRY NC2404.2 +055100 VARYING CON-5 FROM 2 BY 2 UNTIL CON-5 = 12 NC2404.2 +055200 AFTER CON-6 FROM 2 BY 2 UNTIL CON-6 = 12. NC2404.2 +055300 IF TEST-CHECK = "PASS" NC2404.2 +055400 PERFORM PASS NC2404.2 +055500 GO TO TH2-WRITE-GF-4 NC2404.2 +055600 ELSE NC2404.2 +055700 GO TO TH2-FAIL-GF-4. NC2404.2 +055800 TH2-DELETE-GF-4. NC2404.2 +055900 PERFORM DE-LETE. NC2404.2 +056000 GO TO TH2-WRITE-GF-4. NC2404.2 +056100 TH2-FAIL-GF-4. NC2404.2 +056200 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2404.2 +056300 MOVE ENTRY-2 (10, 10) TO COMPUTED-A. NC2404.2 +056400 NC2404.2 +056500 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +056600 PERFORM FAIL. NC2404.2 +056700 TH2-WRITE-GF-4. NC2404.2 +056800 PERFORM PRINT-DETAIL. NC2404.2 +056900 GO TO TH3-INIT-GF-1. NC2404.2 +057000* NC2404.2 +057100 FIND-LEVEL-2-ENTRY. NC2404.2 +057200 IF ENTRY-2 (CON-5, CON-6) = SEC-HOLD-AREA NC2404.2 +057300 MOVE "PASS" TO TEST-CHECK. NC2404.2 +057400* NC2404.2 +057500 TH3-INIT-GF-1. NC2404.2 +057600 MOVE "PERFORM VARYING LEV3" TO FEATURE. NC2404.2 +057700 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +057800 MOVE SPACES TO TEST-CHECK. NC2404.2 +057900 MOVE "TH3-TEST-GF-1 " TO PAR-NAME. NC2404.2 +058000 MOVE "ELEM (01,02,03)" TO ELEM-HOLD-AREA. NC2404.2 +058100 TH3-TEST-GF-1. NC2404.2 +058200 PERFORM FIND-LEVEL-3-ENTRY NC2404.2 +058300 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +058400 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10 NC2404.2 +058500 AFTER CON-7 FROM 1 BY 1 UNTIL CON-7 = 10. NC2404.2 +058600 IF TEST-CHECK = "PASS" NC2404.2 +058700 PERFORM PASS NC2404.2 +058800 GO TO TH3-WRITE-GF-1 NC2404.2 +058900 ELSE NC2404.2 +059000 GO TO TH3-FAIL-GF-1. NC2404.2 +059100 TH3-DELETE-GF-1. NC2404.2 +059200 PERFORM DE-LETE. NC2404.2 +059300 GO TO TH3-WRITE-GF-1. NC2404.2 +059400 TH3-FAIL-GF-1. NC2404.2 +059500 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2404.2 +059600 MOVE ENTRY-3 (01, 02, 03) TO COMPUTED-A. NC2404.2 +059700 NC2404.2 +059800 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +059900 PERFORM FAIL. NC2404.2 +060000 TH3-WRITE-GF-1. NC2404.2 +060100 PERFORM PRINT-DETAIL. NC2404.2 +060200 NC2404.2 +060300 TH3-INIT-GF-2. NC2404.2 +060400 MOVE "TH3-TEST-GF-2 " TO PAR-NAME. NC2404.2 +060500 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +060600 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2404.2 +060700 MOVE SPACES TO TEST-CHECK. NC2404.2 +060800 TH3-TEST-GF-2. NC2404.2 +060900 PERFORM FIND-LEVEL-3-ENTRY NC2404.2 +061000 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +061100 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 11 NC2404.2 +061200 AFTER CON-7 FROM 1 BY 1 UNTIL CON-7 = 11. NC2404.2 +061300 IF TEST-CHECK = "PASS" NC2404.2 +061400 PERFORM PASS NC2404.2 +061500 GO TO TH3-WRITE-GF-2 NC2404.2 +061600 ELSE NC2404.2 +061700 GO TO TH3-FAIL-GF-2. NC2404.2 +061800 TH3-DELETE-GF-2. NC2404.2 +061900 PERFORM DE-LETE. NC2404.2 +062000 GO TO TH3-WRITE-GF-2. NC2404.2 +062100 TH3-FAIL-GF-2. NC2404.2 +062200 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2404.2 +062300 MOVE ENTRY-3 (10, 10, 10) TO COMPUTED-A. NC2404.2 +062400 NC2404.2 +062500 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +062600 PERFORM FAIL. NC2404.2 +062700 TH3-WRITE-GF-2. NC2404.2 +062800 PERFORM PRINT-DETAIL. NC2404.2 +062900 NC2404.2 +063000 TH3-INIT-GF-3. NC2404.2 +063100 MOVE "TH3-TEST-GF-3 " TO PAR-NAME. NC2404.2 +063200 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +063300 MOVE "ELEM (08,07,06)" TO ELEM-HOLD-AREA. NC2404.2 +063400 MOVE SPACES TO TEST-CHECK. NC2404.2 +063500 TH3-TEST-GF-3. NC2404.2 +063600 PERFORM FIND-LEVEL-3-ENTRY NC2404.2 +063700 VARYING CON-5 FROM 1 BY 1 UNTIL CON-5 = 11 NC2404.2 +063800 AFTER CON-6 FROM 1 BY 1 UNTIL CON-6 = 10 NC2404.2 +063900 AFTER CON-7 FROM 1 BY 1 UNTIL CON-7 = 10. NC2404.2 +064000 IF TEST-CHECK = "PASS" NC2404.2 +064100 PERFORM PASS NC2404.2 +064200 GO TO TH3-WRITE-GF-3 NC2404.2 +064300 ELSE NC2404.2 +064400 GO TO TH3-FAIL-GF-3. NC2404.2 +064500 TH3-DELETE-GF-3. NC2404.2 +064600 PERFORM DE-LETE. NC2404.2 +064700 GO TO TH3-WRITE-GF-3. NC2404.2 +064800 TH3-FAIL-GF-3. NC2404.2 +064900 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2404.2 +065000 MOVE ENTRY-3 (08, 07, 06) TO COMPUTED-A. NC2404.2 +065100 NC2404.2 +065200 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +065300 PERFORM FAIL. NC2404.2 +065400 TH3-WRITE-GF-3. NC2404.2 +065500 PERFORM PRINT-DETAIL. NC2404.2 +065600* NC2404.2 +065700 TH3-INIT-GF-4. NC2404.2 +065800 MOVE "TH3-TEST-GF-4 " TO PAR-NAME. NC2404.2 +065900 MOVE "VI-109" TO ANSI-REFERENCE. NC2404.2 +066000 MOVE SPACES TO TEST-CHECK. NC2404.2 +066100 MOVE "ELEM (06,04,08)" TO ELEM-HOLD-AREA. NC2404.2 +066200 TH3-TEST-GF-4. NC2404.2 +066300 PERFORM FIND-LEVEL-3-ENTRY NC2404.2 +066400 VARYING CON-5 FROM 3 BY 3 UNTIL CON-5 = 12 NC2404.2 +066500 AFTER CON-6 FROM 2 BY 2 UNTIL CON-6 = 12 NC2404.2 +066600 AFTER CON-7 FROM 8 BY 8 UNTIL CON-7 = 16. NC2404.2 +066700 IF TEST-CHECK = "PASS" NC2404.2 +066800 PERFORM PASS NC2404.2 +066900 GO TO TH3-WRITE-GF-4 NC2404.2 +067000 ELSE NC2404.2 +067100 GO TO TH3-FAIL-GF-4. NC2404.2 +067200 TH3-DELETE-GF-4. NC2404.2 +067300 PERFORM DE-LETE. NC2404.2 +067400 GO TO TH3-WRITE-GF-4. NC2404.2 +067500 TH3-FAIL-GF-4. NC2404.2 +067600 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2404.2 +067700 MOVE ENTRY-3 (06, 04, 08) TO COMPUTED-A. NC2404.2 +067800 NC2404.2 +067900 MOVE "PERFORM VARYING DATA NAMES " TO RE-MARK. NC2404.2 +068000 PERFORM FAIL. NC2404.2 +068100 TH3-WRITE-GF-4. NC2404.2 +068200 PERFORM PRINT-DETAIL. NC2404.2 +068300 GO TO END-3LEVEL-TEST. NC2404.2 +068400 NC2404.2 +068500 FIND-LEVEL-3-ENTRY. NC2404.2 +068600 IF ENTRY-3 (CON-5, CON-6, CON-7) = ELEM-HOLD-AREA NC2404.2 +068700 MOVE "PASS" TO TEST-CHECK. NC2404.2 +068800 NC2404.2 +068900 END-3LEVEL-TEST. NC2404.2 +069000 EXIT. NC2404.2 +069100 CCVS-EXIT SECTION. NC2404.2 +069200 CCVS-999999. NC2404.2 +069300 GO TO CLOSE-FILES. NC2404.2 diff --git a/tests/cobol85/NC/NC241A.CBL b/tests/cobol85/NC/NC241A.CBL new file mode 100755 index 00000000..f969c04a --- /dev/null +++ b/tests/cobol85/NC/NC241A.CBL @@ -0,0 +1,671 @@ +000100 IDENTIFICATION DIVISION. NC2414.2 +000200 PROGRAM-ID. NC2414.2 +000300 NC241A. NC2414.2 +000400**************************************************************** NC2414.2 +000500* * NC2414.2 +000600* VALIDATION FOR:- * NC2414.2 +000700* * NC2414.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2414.2 +000900* * NC2414.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2414.2 +001100* * NC2414.2 +001200**************************************************************** NC2414.2 +001300* * NC2414.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2414.2 +001500* * NC2414.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2414.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2414.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2414.2 +001900* * NC2414.2 +002000**************************************************************** NC2414.2 +002100* NC2414.2 +002200* PROGRAM NC241A TESTS THE CONSTRUCTION AND ACCESS OF A * NC2414.2 +002300* THREE-DIMENSIONAL TABLE USING INDICES. THE CONTENT OF * NC2414.2 +002400* TABLE ELEMENTS IS VERIFIED BY USE OF THE FORMAT 4 * NC2414.2 +002500* "PERFORM" STATEMENT. * NC2414.2 +002600* * NC2414.2 +002700**************************************************************** NC2414.2 +002800 NC2414.2 +002900 ENVIRONMENT DIVISION. NC2414.2 +003000 CONFIGURATION SECTION. NC2414.2 +003100 SOURCE-COMPUTER. NC2414.2 +003200 Linux. NC2414.2 +003300 OBJECT-COMPUTER. NC2414.2 +003400 Linux. NC2414.2 +003500 INPUT-OUTPUT SECTION. NC2414.2 +003600 FILE-CONTROL. NC2414.2 +003700 SELECT PRINT-FILE ASSIGN TO NC2414.2 +003800 "report.log". NC2414.2 +003900 DATA DIVISION. NC2414.2 +004000 FILE SECTION. NC2414.2 +004100 FD PRINT-FILE. NC2414.2 +004200 01 PRINT-REC PICTURE X(120). NC2414.2 +004300 01 DUMMY-RECORD PICTURE X(120). NC2414.2 +004400 WORKING-STORAGE SECTION. NC2414.2 +004500 77 SUB-1 PICTURE S99 VALUE ZERO. NC2414.2 +004600 77 SUB-2 PICTURE 99 VALUE ZERO. NC2414.2 +004700 77 SUB-3 PICTURE 99 VALUE ZERO. NC2414.2 +004800 77 TEST-CHECK PIC X(4) VALUE SPACE. NC2414.2 +004900 77 CON-7 PICTURE 99 VALUE 07. NC2414.2 +005000 77 CON-10 PICTURE 99 VALUE 10. NC2414.2 +005100 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2414.2 +005200 77 CON-5 PICTURE 99 VALUE 05. NC2414.2 +005300 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2414.2 +005400 77 CON-6 PICTURE 99 VALUE 06. NC2414.2 +005500 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2414.2 +005600 01 GRP-NAME. NC2414.2 +005700 02 FILLER PICTURE XXX VALUE "GRP". NC2414.2 +005800 02 ADD-GRP PICTURE 99 VALUE 01. NC2414.2 +005900 NC2414.2 +006000 01 SEC-NAME. NC2414.2 +006100 02 FILLER PICTURE X(5) VALUE "SEC (". NC2414.2 +006200 02 SEC-GRP PICTURE 99 VALUE 00. NC2414.2 +006300 02 FILLER PICTURE X VALUE ",". NC2414.2 +006400 02 ADD-SEC PICTURE 99 VALUE 01. NC2414.2 +006500 02 FILLER PICTURE X VALUE ")". NC2414.2 +006600 NC2414.2 +006700 01 ELEM-NAME. NC2414.2 +006800 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2414.2 +006900 02 ELEM-GRP PICTURE 99 VALUE 00. NC2414.2 +007000 02 FILLER PICTURE X VALUE ",". NC2414.2 +007100 02 ELEM-SEC PICTURE 99 VALUE 00. NC2414.2 +007200 02 FILLER PICTURE X VALUE ",". NC2414.2 +007300 02 ADD-ELEM PICTURE 99 VALUE 01. NC2414.2 +007400 02 FILLER PICTURE X VALUE ")". NC2414.2 +007500 NC2414.2 +007600 01 3-DIMENSION-TBL. NC2414.2 +007700 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2414.2 +007800 03 ENTRY-1 PICTURE X(5). NC2414.2 +007900 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2414.2 +008000 04 ENTRY-2 PICTURE X(11). NC2414.2 +008100 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2414.2 +008200 05 ENTRY-3 PICTURE X(15). NC2414.2 +008300 NC2414.2 +008400 01 TEST-RESULTS. NC2414.2 +008500 02 FILLER PIC X VALUE SPACE. NC2414.2 +008600 02 FEATURE PIC X(20) VALUE SPACE. NC2414.2 +008700 02 FILLER PIC X VALUE SPACE. NC2414.2 +008800 02 P-OR-F PIC X(5) VALUE SPACE. NC2414.2 +008900 02 FILLER PIC X VALUE SPACE. NC2414.2 +009000 02 PAR-NAME. NC2414.2 +009100 03 FILLER PIC X(19) VALUE SPACE. NC2414.2 +009200 03 PARDOT-X PIC X VALUE SPACE. NC2414.2 +009300 03 DOTVALUE PIC 99 VALUE ZERO. NC2414.2 +009400 02 FILLER PIC X(8) VALUE SPACE. NC2414.2 +009500 02 RE-MARK PIC X(61). NC2414.2 +009600 01 TEST-COMPUTED. NC2414.2 +009700 02 FILLER PIC X(30) VALUE SPACE. NC2414.2 +009800 02 FILLER PIC X(17) VALUE NC2414.2 +009900 " COMPUTED=". NC2414.2 +010000 02 COMPUTED-X. NC2414.2 +010100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2414.2 +010200 03 COMPUTED-N REDEFINES COMPUTED-A NC2414.2 +010300 PIC -9(9).9(9). NC2414.2 +010400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2414.2 +010500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2414.2 +010600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2414.2 +010700 03 CM-18V0 REDEFINES COMPUTED-A. NC2414.2 +010800 04 COMPUTED-18V0 PIC -9(18). NC2414.2 +010900 04 FILLER PIC X. NC2414.2 +011000 03 FILLER PIC X(50) VALUE SPACE. NC2414.2 +011100 01 TEST-CORRECT. NC2414.2 +011200 02 FILLER PIC X(30) VALUE SPACE. NC2414.2 +011300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2414.2 +011400 02 CORRECT-X. NC2414.2 +011500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2414.2 +011600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2414.2 +011700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2414.2 +011800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2414.2 +011900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2414.2 +012000 03 CR-18V0 REDEFINES CORRECT-A. NC2414.2 +012100 04 CORRECT-18V0 PIC -9(18). NC2414.2 +012200 04 FILLER PIC X. NC2414.2 +012300 03 FILLER PIC X(2) VALUE SPACE. NC2414.2 +012400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2414.2 +012500 01 CCVS-C-1. NC2414.2 +012600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2414.2 +012700- "SS PARAGRAPH-NAME NC2414.2 +012800- " REMARKS". NC2414.2 +012900 02 FILLER PIC X(20) VALUE SPACE. NC2414.2 +013000 01 CCVS-C-2. NC2414.2 +013100 02 FILLER PIC X VALUE SPACE. NC2414.2 +013200 02 FILLER PIC X(6) VALUE "TESTED". NC2414.2 +013300 02 FILLER PIC X(15) VALUE SPACE. NC2414.2 +013400 02 FILLER PIC X(4) VALUE "FAIL". NC2414.2 +013500 02 FILLER PIC X(94) VALUE SPACE. NC2414.2 +013600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2414.2 +013700 01 REC-CT PIC 99 VALUE ZERO. NC2414.2 +013800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2414.2 +013900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2414.2 +014000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2414.2 +014100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2414.2 +014200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2414.2 +014300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2414.2 +014400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2414.2 +014500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2414.2 +014600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2414.2 +014700 01 CCVS-H-1. NC2414.2 +014800 02 FILLER PIC X(39) VALUE SPACES. NC2414.2 +014900 02 FILLER PIC X(42) VALUE NC2414.2 +015000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2414.2 +015100 02 FILLER PIC X(39) VALUE SPACES. NC2414.2 +015200 01 CCVS-H-2A. NC2414.2 +015300 02 FILLER PIC X(40) VALUE SPACE. NC2414.2 +015400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2414.2 +015500 02 FILLER PIC XXXX VALUE NC2414.2 +015600 "4.2 ". NC2414.2 +015700 02 FILLER PIC X(28) VALUE NC2414.2 +015800 " COPY - NOT FOR DISTRIBUTION". NC2414.2 +015900 02 FILLER PIC X(41) VALUE SPACE. NC2414.2 +016000 NC2414.2 +016100 01 CCVS-H-2B. NC2414.2 +016200 02 FILLER PIC X(15) VALUE NC2414.2 +016300 "TEST RESULT OF ". NC2414.2 +016400 02 TEST-ID PIC X(9). NC2414.2 +016500 02 FILLER PIC X(4) VALUE NC2414.2 +016600 " IN ". NC2414.2 +016700 02 FILLER PIC X(12) VALUE NC2414.2 +016800 " HIGH ". NC2414.2 +016900 02 FILLER PIC X(22) VALUE NC2414.2 +017000 " LEVEL VALIDATION FOR ". NC2414.2 +017100 02 FILLER PIC X(58) VALUE NC2414.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2414.2 +017300 01 CCVS-H-3. NC2414.2 +017400 02 FILLER PIC X(34) VALUE NC2414.2 +017500 " FOR OFFICIAL USE ONLY ". NC2414.2 +017600 02 FILLER PIC X(58) VALUE NC2414.2 +017700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2414.2 +017800 02 FILLER PIC X(28) VALUE NC2414.2 +017900 " COPYRIGHT 1985 ". NC2414.2 +018000 01 CCVS-E-1. NC2414.2 +018100 02 FILLER PIC X(52) VALUE SPACE. NC2414.2 +018200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2414.2 +018300 02 ID-AGAIN PIC X(9). NC2414.2 +018400 02 FILLER PIC X(45) VALUE SPACES. NC2414.2 +018500 01 CCVS-E-2. NC2414.2 +018600 02 FILLER PIC X(31) VALUE SPACE. NC2414.2 +018700 02 FILLER PIC X(21) VALUE SPACE. NC2414.2 +018800 02 CCVS-E-2-2. NC2414.2 +018900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2414.2 +019000 03 FILLER PIC X VALUE SPACE. NC2414.2 +019100 03 ENDER-DESC PIC X(44) VALUE NC2414.2 +019200 "ERRORS ENCOUNTERED". NC2414.2 +019300 01 CCVS-E-3. NC2414.2 +019400 02 FILLER PIC X(22) VALUE NC2414.2 +019500 " FOR OFFICIAL USE ONLY". NC2414.2 +019600 02 FILLER PIC X(12) VALUE SPACE. NC2414.2 +019700 02 FILLER PIC X(58) VALUE NC2414.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2414.2 +019900 02 FILLER PIC X(13) VALUE SPACE. NC2414.2 +020000 02 FILLER PIC X(15) VALUE NC2414.2 +020100 " COPYRIGHT 1985". NC2414.2 +020200 01 CCVS-E-4. NC2414.2 +020300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2414.2 +020400 02 FILLER PIC X(4) VALUE " OF ". NC2414.2 +020500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2414.2 +020600 02 FILLER PIC X(40) VALUE NC2414.2 +020700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2414.2 +020800 01 XXINFO. NC2414.2 +020900 02 FILLER PIC X(19) VALUE NC2414.2 +021000 "*** INFORMATION ***". NC2414.2 +021100 02 INFO-TEXT. NC2414.2 +021200 04 FILLER PIC X(8) VALUE SPACE. NC2414.2 +021300 04 XXCOMPUTED PIC X(20). NC2414.2 +021400 04 FILLER PIC X(5) VALUE SPACE. NC2414.2 +021500 04 XXCORRECT PIC X(20). NC2414.2 +021600 02 INF-ANSI-REFERENCE PIC X(48). NC2414.2 +021700 01 HYPHEN-LINE. NC2414.2 +021800 02 FILLER PIC IS X VALUE IS SPACE. NC2414.2 +021900 02 FILLER PIC IS X(65) VALUE IS "************************NC2414.2 +022000- "*****************************************". NC2414.2 +022100 02 FILLER PIC IS X(54) VALUE IS "************************NC2414.2 +022200- "******************************". NC2414.2 +022300 01 CCVS-PGM-ID PIC X(9) VALUE NC2414.2 +022400 "NC241A". NC2414.2 +022500 PROCEDURE DIVISION. NC2414.2 +022600 CCVS1 SECTION. NC2414.2 +022700 OPEN-FILES. NC2414.2 +022800 OPEN OUTPUT PRINT-FILE. NC2414.2 +022900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2414.2 +023000 MOVE SPACE TO TEST-RESULTS. NC2414.2 +023100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2414.2 +023200 GO TO CCVS1-EXIT. NC2414.2 +023300 CLOSE-FILES. NC2414.2 +023400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2414.2 +023500 TERMINATE-CCVS. NC2414.2 +023600*S EXIT PROGRAM. NC2414.2 +023700*SERMINATE-CALL. NC2414.2 +023800 STOP RUN. NC2414.2 +023900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2414.2 +024000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2414.2 +024100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2414.2 +024200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2414.2 +024300 MOVE "****TEST DELETED****" TO RE-MARK. NC2414.2 +024400 PRINT-DETAIL. NC2414.2 +024500 IF REC-CT NOT EQUAL TO ZERO NC2414.2 +024600 MOVE "." TO PARDOT-X NC2414.2 +024700 MOVE REC-CT TO DOTVALUE. NC2414.2 +024800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2414.2 +024900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2414.2 +025000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2414.2 +025100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2414.2 +025200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2414.2 +025300 MOVE SPACE TO CORRECT-X. NC2414.2 +025400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2414.2 +025500 MOVE SPACE TO RE-MARK. NC2414.2 +025600 HEAD-ROUTINE. NC2414.2 +025700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +025800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +025900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2414.2 +026000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2414.2 +026100 COLUMN-NAMES-ROUTINE. NC2414.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +026500 END-ROUTINE. NC2414.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2414.2 +026700 END-RTN-EXIT. NC2414.2 +026800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +026900 END-ROUTINE-1. NC2414.2 +027000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2414.2 +027100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2414.2 +027200 ADD PASS-COUNTER TO ERROR-HOLD. NC2414.2 +027300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2414.2 +027400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2414.2 +027500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2414.2 +027600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2414.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2414.2 +027800 END-ROUTINE-12. NC2414.2 +027900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2414.2 +028000 IF ERROR-COUNTER IS EQUAL TO ZERO NC2414.2 +028100 MOVE "NO " TO ERROR-TOTAL NC2414.2 +028200 ELSE NC2414.2 +028300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2414.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2414.2 +028500 PERFORM WRITE-LINE. NC2414.2 +028600 END-ROUTINE-13. NC2414.2 +028700 IF DELETE-COUNTER IS EQUAL TO ZERO NC2414.2 +028800 MOVE "NO " TO ERROR-TOTAL ELSE NC2414.2 +028900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2414.2 +029000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2414.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +029200 IF INSPECT-COUNTER EQUAL TO ZERO NC2414.2 +029300 MOVE "NO " TO ERROR-TOTAL NC2414.2 +029400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2414.2 +029500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2414.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +029700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2414.2 +029800 WRITE-LINE. NC2414.2 +029900 ADD 1 TO RECORD-COUNT. NC2414.2 +030000 IF RECORD-COUNT GREATER 50 NC2414.2 +030100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2414.2 +030200 MOVE SPACE TO DUMMY-RECORD NC2414.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2414.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2414.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2414.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2414.2 +030700 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2414.2 +030800 MOVE ZERO TO RECORD-COUNT. NC2414.2 +030900 PERFORM WRT-LN. NC2414.2 +031000 WRT-LN. NC2414.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2414.2 +031200 MOVE SPACE TO DUMMY-RECORD. NC2414.2 +031300 BLANK-LINE-PRINT. NC2414.2 +031400 PERFORM WRT-LN. NC2414.2 +031500 FAIL-ROUTINE. NC2414.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2414.2 +031700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2414.2 +031800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2414.2 +031900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2414.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2414.2 +032200 GO TO FAIL-ROUTINE-EX. NC2414.2 +032300 FAIL-ROUTINE-WRITE. NC2414.2 +032400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2414.2 +032500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2414.2 +032600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2414.2 +032700 MOVE SPACES TO COR-ANSI-REFERENCE. NC2414.2 +032800 FAIL-ROUTINE-EX. EXIT. NC2414.2 +032900 BAIL-OUT. NC2414.2 +033000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2414.2 +033100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2414.2 +033200 BAIL-OUT-WRITE. NC2414.2 +033300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2414.2 +033400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2414.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2414.2 +033600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2414.2 +033700 BAIL-OUT-EX. EXIT. NC2414.2 +033800 CCVS1-EXIT. NC2414.2 +033900 EXIT. NC2414.2 +034000 SECT-NC241A-001 SECTION. NC2414.2 +034100 TH-15-001. NC2414.2 +034200 PERFORM PARA-1 VARYING SUB-1 FROM 1 BY 1 NC2414.2 +034300 UNTIL SUB-1 EQUAL TO 11 NC2414.2 +034400 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2414.2 +034500 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11 NC2414.2 +034600 GO TO CHECK-ENTRIES. NC2414.2 +034700 NC2414.2 +034800 PARA-1. NC2414.2 +034900 SET IDX-1 TO SUB-1. NC2414.2 +035000 SET IDX-2 TO SUB-2. NC2414.2 +035100 SET IDX-3 TO SUB-3. NC2414.2 +035200 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2414.2 +035300 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2414.2 +035400 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2414.2 +035500 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2414.2 +035600 SET ADD-ELEM TO IDX-3. NC2414.2 +035700 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2414.2 +035800 NC2414.2 +035900 CHECK-ENTRIES. NC2414.2 +036000 MOVE "PERFORM VARYING LEV1" TO FEATURE. NC2414.2 +036100 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2414.2 +036200 MOVE SPACES TO TEST-CHECK. NC2414.2 +036300 MOVE "GRP05" TO GRP-HOLD-AREA. NC2414.2 +036400 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2414.2 +036500 UNTIL IDX-1 = 11. NC2414.2 +036600 IF TEST-CHECK = "PASS" GO TO TH1-INIT-GF-2. NC2414.2 +036700 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2414.2 +036800 MOVE ENTRY-1 (05) TO COMPUTED-A. NC2414.2 +036900 NC2414.2 +037000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +037100 PERFORM FAIL. NC2414.2 +037200 PERFORM PRINT-DETAIL. NC2414.2 +037300* NC2414.2 +037400 TH1-INIT-GF-2. NC2414.2 +037500 MOVE "GRP10" TO GRP-HOLD-AREA. NC2414.2 +037600 MOVE "TH1-TEST-GF-2 " TO PAR-NAME. NC2414.2 +037700 MOVE SPACES TO TEST-CHECK. NC2414.2 +037800 TH1-TEST-GF-2. NC2414.2 +037900 PERFORM FIND-LEVEL-1-ENTRY NC2414.2 +038000 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 = 11. NC2414.2 +038100 IF TEST-CHECK = "PASS" NC2414.2 +038200 PERFORM PASS NC2414.2 +038300 GO TO TH1-WRITE-GF-2 NC2414.2 +038400 ELSE NC2414.2 +038500 GO TO TH1-FAIL-GF-2. NC2414.2 +038600 TH1-DELETE-GF-2. NC2414.2 +038700 PERFORM DE-LETE. NC2414.2 +038800 GO TO TH1-WRITE-GF-2. NC2414.2 +038900 TH1-FAIL-GF-2. NC2414.2 +039000 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2414.2 +039100 MOVE ENTRY-1 (10) TO COMPUTED-A. NC2414.2 +039200 NC2414.2 +039300 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +039400 PERFORM FAIL. NC2414.2 +039500 TH1-WRITE-GF-2. NC2414.2 +039600 PERFORM PRINT-DETAIL. NC2414.2 +039700* NC2414.2 +039800 TH1-INIT-GF-3. NC2414.2 +039900 MOVE "GRP07" TO GRP-HOLD-AREA. NC2414.2 +040000 MOVE "TH1-TEST-GF-3 " TO PAR-NAME. NC2414.2 +040100 MOVE SPACES TO TEST-CHECK. NC2414.2 +040200 TH1-TEST-GF-3. NC2414.2 +040300 PERFORM FIND-LEVEL-1-ENTRY NC2414.2 +040400 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 = 11. NC2414.2 +040500 IF TEST-CHECK = "PASS" NC2414.2 +040600 PERFORM PASS NC2414.2 +040700 GO TO TH1-WRITE-GF-3 NC2414.2 +040800 ELSE NC2414.2 +040900 GO TO TH1-FAIL-GF-3. NC2414.2 +041000 TH1-DELETE-GF-3. NC2414.2 +041100 PERFORM DE-LETE. NC2414.2 +041200 GO TO TH1-WRITE-GF-3. NC2414.2 +041300 TH1-FAIL-GF-3. NC2414.2 +041400 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2414.2 +041500 MOVE ENTRY-1 (07) TO COMPUTED-A. NC2414.2 +041600 NC2414.2 +041700 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +041800 PERFORM FAIL. NC2414.2 +041900 TH1-WRITE-GF-3. NC2414.2 +042000 PERFORM PRINT-DETAIL. NC2414.2 +042100* NC2414.2 +042200 TH1-INIT-GF-4. NC2414.2 +042300 MOVE "TH1-TEST-GF-4 " TO PAR-NAME. NC2414.2 +042400 MOVE "GRP01" TO GRP-HOLD-AREA. NC2414.2 +042500 TH1-TEST-GF-4. NC2414.2 +042600 PERFORM FIND-LEVEL-1-ENTRY NC2414.2 +042700 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 = 11. NC2414.2 +042800 IF TEST-CHECK = "PASS" NC2414.2 +042900 PERFORM PASS NC2414.2 +043000 GO TO TH1-WRITE-GF-4 NC2414.2 +043100 ELSE NC2414.2 +043200 GO TO TH1-FAIL-GF-4. NC2414.2 +043300 TH1-DELETE-GF-4. NC2414.2 +043400 PERFORM DE-LETE. NC2414.2 +043500 GO TO TH1-WRITE-GF-4. NC2414.2 +043600 TH1-FAIL-GF-4. NC2414.2 +043700 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2414.2 +043800 MOVE ENTRY-1 (01) TO COMPUTED-A. NC2414.2 +043900 NC2414.2 +044000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +044100 PERFORM FAIL. NC2414.2 +044200 TH1-WRITE-GF-4. NC2414.2 +044300 PERFORM PRINT-DETAIL. NC2414.2 +044400 GO TO TH2-INIT-GF-1. NC2414.2 +044500* NC2414.2 +044600 FIND-LEVEL-1-ENTRY. NC2414.2 +044700 IF ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2414.2 +044800 MOVE "PASS" TO TEST-CHECK. NC2414.2 +044900* NC2414.2 +045000 TH2-INIT-GF-1. NC2414.2 +045100 MOVE "TH2-TEST-GF-1 " TO PAR-NAME. NC2414.2 +045200 MOVE "PERFORM VARYING LEV2" TO FEATURE. NC2414.2 +045300 MOVE "SEC (03,05)" TO SEC-HOLD-AREA. NC2414.2 +045400 MOVE SPACES TO TEST-CHECK. NC2414.2 +045500 TH2-TEST-GF-1. NC2414.2 +045600 PERFORM FIND-LEVEL-2-ENTRY NC2414.2 +045700 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +045800 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10. NC2414.2 +045900 IF TEST-CHECK = "PASS" NC2414.2 +046000 PERFORM PASS NC2414.2 +046100 GO TO TH2-WRITE-GF-1 NC2414.2 +046200 ELSE NC2414.2 +046300 GO TO TH2-FAIL-GF-1. NC2414.2 +046400 TH2-DELETE-GF-1. NC2414.2 +046500 PERFORM DE-LETE. NC2414.2 +046600 GO TO TH2-WRITE-GF-1. NC2414.2 +046700 TH2-FAIL-GF-1. NC2414.2 +046800 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2414.2 +046900 MOVE ENTRY-2 (03, 05) TO COMPUTED-A. NC2414.2 +047000 NC2414.2 +047100 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +047200 PERFORM FAIL. NC2414.2 +047300 TH2-WRITE-GF-1. NC2414.2 +047400 PERFORM PRINT-DETAIL. NC2414.2 +047500* NC2414.2 +047600 TH2-INIT-GF-2. NC2414.2 +047700 MOVE "TH2-TEST-GF-2 " TO PAR-NAME. NC2414.2 +047800 MOVE SPACES TO TEST-CHECK. NC2414.2 +047900 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2414.2 +048000 TH2-TEST-GF-2. NC2414.2 +048100 PERFORM FIND-LEVEL-2-ENTRY NC2414.2 +048200 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +048300 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10. NC2414.2 +048400 IF TEST-CHECK = "PASS" NC2414.2 +048500 PERFORM PASS NC2414.2 +048600 GO TO TH2-WRITE-GF-2 NC2414.2 +048700 ELSE NC2414.2 +048800 GO TO TH2-FAIL-GF-2. NC2414.2 +048900 TH2-DELETE-GF-2. NC2414.2 +049000 PERFORM DE-LETE. NC2414.2 +049100 GO TO TH2-WRITE-GF-2. NC2414.2 +049200 TH2-FAIL-GF-2. NC2414.2 +049300 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2414.2 +049400 MOVE ENTRY-2 (01, 01) TO COMPUTED-A. NC2414.2 +049500 NC2414.2 +049600 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +049700 PERFORM FAIL. NC2414.2 +049800 TH2-WRITE-GF-2. NC2414.2 +049900 PERFORM PRINT-DETAIL. NC2414.2 +050000* NC2414.2 +050100 TH2-INIT-GF-3. NC2414.2 +050200 MOVE "TH2-TEST-GF-3 " TO PAR-NAME. NC2414.2 +050300 MOVE SPACES TO TEST-CHECK. NC2414.2 +050400 MOVE "SEC (10,01)" TO SEC-HOLD-AREA. NC2414.2 +050500 TH2-TEST-GF-3. NC2414.2 +050600 PERFORM FIND-LEVEL-2-ENTRY NC2414.2 +050700 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +050800 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10. NC2414.2 +050900 IF TEST-CHECK = "PASS" NC2414.2 +051000 PERFORM PASS NC2414.2 +051100 GO TO TH2-WRITE-GF-3 NC2414.2 +051200 ELSE NC2414.2 +051300 GO TO TH2-FAIL-GF-3. NC2414.2 +051400 TH2-DELETE-GF-3. NC2414.2 +051500 PERFORM DE-LETE. NC2414.2 +051600 GO TO TH2-WRITE-GF-3. NC2414.2 +051700 TH2-FAIL-GF-3. NC2414.2 +051800 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2414.2 +051900 MOVE ENTRY-2 (10, 01) TO COMPUTED-A. NC2414.2 +052000 NC2414.2 +052100 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +052200 PERFORM FAIL. NC2414.2 +052300 TH2-WRITE-GF-3. NC2414.2 +052400 PERFORM PRINT-DETAIL. NC2414.2 +052500* NC2414.2 +052600 TH2-INIT-GF-4. NC2414.2 +052700 MOVE "TH2-TEST-GF-4 " TO PAR-NAME. NC2414.2 +052800 MOVE SPACES TO TEST-CHECK. NC2414.2 +052900 MOVE SPACES TO TEST-CHECK. NC2414.2 +053000 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2414.2 +053100 TH2-TEST-GF-4. NC2414.2 +053200 PERFORM FIND-LEVEL-2-ENTRY NC2414.2 +053300 VARYING IDX-1 FROM 2 BY 2 UNTIL IDX-1 GREATER 10 NC2414.2 +053400 AFTER IDX-2 FROM 2 BY 2 UNTIL IDX-2 GREATER 10. NC2414.2 +053500 IF TEST-CHECK = "PASS" NC2414.2 +053600 PERFORM PASS NC2414.2 +053700 GO TO TH2-WRITE-GF-4 NC2414.2 +053800 ELSE NC2414.2 +053900 GO TO TH2-FAIL-GF-4. NC2414.2 +054000 TH2-DELETE-GF-4. NC2414.2 +054100 PERFORM DE-LETE. NC2414.2 +054200 GO TO TH2-WRITE-GF-4. NC2414.2 +054300 TH2-FAIL-GF-4. NC2414.2 +054400 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2414.2 +054500 MOVE ENTRY-2 (10, 10) TO COMPUTED-A. NC2414.2 +054600 NC2414.2 +054700 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +054800 PERFORM FAIL. NC2414.2 +054900 TH2-WRITE-GF-4. NC2414.2 +055000 PERFORM PRINT-DETAIL. NC2414.2 +055100 GO TO TH3-INIT-GF-1. NC2414.2 +055200* NC2414.2 +055300 FIND-LEVEL-2-ENTRY. NC2414.2 +055400 IF ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2414.2 +055500 MOVE "PASS" TO TEST-CHECK. NC2414.2 +055600* NC2414.2 +055700 TH3-INIT-GF-1. NC2414.2 +055800 MOVE "PERFORM VARYING LEV3" TO FEATURE. NC2414.2 +055900 MOVE SPACES TO TEST-CHECK. NC2414.2 +056000 MOVE "TH3-TEST-GF-1 " TO PAR-NAME. NC2414.2 +056100 MOVE "ELEM (01,02,03)" TO ELEM-HOLD-AREA. NC2414.2 +056200 TH3-TEST-GF-1. NC2414.2 +056300 PERFORM FIND-LEVEL-3-ENTRY NC2414.2 +056400 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +056500 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10 NC2414.2 +056600 AFTER IDX-3 FROM 1 BY 1 UNTIL IDX-3 = 10. NC2414.2 +056700 IF TEST-CHECK = "PASS" NC2414.2 +056800 PERFORM PASS NC2414.2 +056900 GO TO TH3-WRITE-GF-1 NC2414.2 +057000 ELSE NC2414.2 +057100 GO TO TH3-FAIL-GF-1. NC2414.2 +057200 TH3-DELETE-GF-1. NC2414.2 +057300 PERFORM DE-LETE. NC2414.2 +057400 GO TO TH3-WRITE-GF-1. NC2414.2 +057500 TH3-FAIL-GF-1. NC2414.2 +057600 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2414.2 +057700 MOVE ENTRY-3 (01, 02, 03) TO COMPUTED-A. NC2414.2 +057800 NC2414.2 +057900 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +058000 PERFORM FAIL. NC2414.2 +058100 TH3-WRITE-GF-1. NC2414.2 +058200 PERFORM PRINT-DETAIL. NC2414.2 +058300* NC2414.2 +058400 TH3-INIT-GF-2. NC2414.2 +058500 MOVE "TH3-TEST-GF-2 " TO PAR-NAME. NC2414.2 +058600 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2414.2 +058700 MOVE SPACES TO TEST-CHECK. NC2414.2 +058800 TH3-TEST-GF-2. NC2414.2 +058900 PERFORM FIND-LEVEL-3-ENTRY NC2414.2 +059000 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +059100 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 GREATER 10 NC2414.2 +059200 AFTER IDX-3 FROM 1 BY 1 UNTIL IDX-3 GREATER 10. NC2414.2 +059300 IF TEST-CHECK = "PASS" NC2414.2 +059400 PERFORM PASS NC2414.2 +059500 GO TO TH3-WRITE-GF-2 NC2414.2 +059600 ELSE NC2414.2 +059700 GO TO TH3-FAIL-GF-2. NC2414.2 +059800 TH3-DELETE-GF-2. NC2414.2 +059900 PERFORM DE-LETE. NC2414.2 +060000 GO TO TH3-WRITE-GF-2. NC2414.2 +060100 TH3-FAIL-GF-2. NC2414.2 +060200 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2414.2 +060300 MOVE ENTRY-3 (10, 10, 10) TO COMPUTED-A. NC2414.2 +060400 NC2414.2 +060500 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +060600 PERFORM FAIL. NC2414.2 +060700 TH3-WRITE-GF-2. NC2414.2 +060800 PERFORM PRINT-DETAIL. NC2414.2 +060900* NC2414.2 +061000 TH3-INIT-GF-3. NC2414.2 +061100 MOVE "TH3-TEST-GF-3 " TO PAR-NAME. NC2414.2 +061200 MOVE "ELEM (08,07,06)" TO ELEM-HOLD-AREA. NC2414.2 +061300 MOVE SPACES TO TEST-CHECK. NC2414.2 +061400 TH3-TEST-GF-3. NC2414.2 +061500 PERFORM FIND-LEVEL-3-ENTRY NC2414.2 +061600 VARYING IDX-1 FROM 1 BY 1 UNTIL IDX-1 GREATER 10 NC2414.2 +061700 AFTER IDX-2 FROM 1 BY 1 UNTIL IDX-2 = 10 NC2414.2 +061800 AFTER IDX-3 FROM 1 BY 1 UNTIL IDX-3 = 10. NC2414.2 +061900 IF TEST-CHECK = "PASS" NC2414.2 +062000 PERFORM PASS NC2414.2 +062100 GO TO TH3-WRITE-GF-3 NC2414.2 +062200 ELSE NC2414.2 +062300 GO TO TH3-FAIL-GF-3. NC2414.2 +062400 TH3-DELETE-GF-3. NC2414.2 +062500 PERFORM DE-LETE. NC2414.2 +062600 GO TO TH3-WRITE-GF-3. NC2414.2 +062700 TH3-FAIL-GF-3. NC2414.2 +062800 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2414.2 +062900 MOVE ENTRY-3 (08, 07, 06) TO COMPUTED-A. NC2414.2 +063000 NC2414.2 +063100 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +063200 PERFORM FAIL. NC2414.2 +063300 TH3-WRITE-GF-3. NC2414.2 +063400 PERFORM PRINT-DETAIL. NC2414.2 +063500* NC2414.2 +063600 TH3-INIT-GF-4. NC2414.2 +063700 MOVE "TH3-TEST-GF-4 " TO PAR-NAME. NC2414.2 +063800 MOVE SPACES TO TEST-CHECK. NC2414.2 +063900 MOVE "ELEM (06,04,08)" TO ELEM-HOLD-AREA. NC2414.2 +064000 TH3-TEST-GF-4. NC2414.2 +064100 PERFORM FIND-LEVEL-3-ENTRY NC2414.2 +064200 VARYING IDX-1 FROM 3 BY 3 UNTIL IDX-1 GREATER 10 NC2414.2 +064300 AFTER IDX-2 FROM 2 BY 2 UNTIL IDX-2 GREATER 10 NC2414.2 +064400 AFTER IDX-3 FROM 8 BY 8 UNTIL IDX-3 GREATER 10. NC2414.2 +064500 IF TEST-CHECK = "PASS" NC2414.2 +064600 PERFORM PASS NC2414.2 +064700 GO TO TH3-WRITE-GF-4 NC2414.2 +064800 ELSE NC2414.2 +064900 GO TO TH3-FAIL-GF-4. NC2414.2 +065000 TH3-DELETE-GF-4. NC2414.2 +065100 PERFORM DE-LETE. NC2414.2 +065200 GO TO TH3-WRITE-GF-4. NC2414.2 +065300 TH3-FAIL-GF-4. NC2414.2 +065400 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2414.2 +065500 MOVE ENTRY-3 (06, 04, 08) TO COMPUTED-A. NC2414.2 +065600 NC2414.2 +065700 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2414.2 +065800 PERFORM FAIL. NC2414.2 +065900 TH3-WRITE-GF-4. NC2414.2 +066000 PERFORM PRINT-DETAIL. NC2414.2 +066100 GO TO END-3LEVEL-TEST. NC2414.2 +066200* NC2414.2 +066300 FIND-LEVEL-3-ENTRY. NC2414.2 +066400 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2414.2 +066500 MOVE "PASS" TO TEST-CHECK. NC2414.2 +066600* NC2414.2 +066700 END-3LEVEL-TEST. NC2414.2 +066800 EXIT. NC2414.2 +066900 CCVS-EXIT SECTION. NC2414.2 +067000 CCVS-999999. NC2414.2 +067100 GO TO CLOSE-FILES. NC2414.2 diff --git a/tests/cobol85/NC/NC242A.CBL b/tests/cobol85/NC/NC242A.CBL new file mode 100755 index 00000000..fdd2a756 --- /dev/null +++ b/tests/cobol85/NC/NC242A.CBL @@ -0,0 +1,575 @@ +000100 IDENTIFICATION DIVISION. NC2424.2 +000200 PROGRAM-ID. NC2424.2 +000300 NC242A. NC2424.2 +000400 NC2424.2 +000500**************************************************************** NC2424.2 +000600* * NC2424.2 +000700* VALIDATION FOR:- * NC2424.2 +000800* * NC2424.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2424.2 +001000* * NC2424.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2424.2 +001200* * NC2424.2 +001300**************************************************************** NC2424.2 +001400* * NC2424.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2424.2 +001600* * NC2424.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2424.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2424.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2424.2 +002000* * NC2424.2 +002100**************************************************************** NC2424.2 +002200* * NC2424.2 +002300* PROGRAM NC242A TESTS THE CONSTRUCTION AND ACCESS OF * NC2424.2 +002400* THREE AND SEVEN-DIMENSIONAL TABLES. * NC2424.2 +002500* THE CONSTRUCTION IS BY MEANS OF A FORMAT 4 "PERFORM" * NC2424.2 +002600* STATEMENT UTILIZING SUBSCRIPTS WHICH ARE CONVERTED TO * NC2424.2 +002700* INDICES BY "SET". ACCESS IS VIA "IF" STATEMENTS USING * NC2424.2 +002800* SUBSCRIPTS OF NUMERIC LITERALS AND CONSTANTS. * NC2424.2 +002900* * NC2424.2 +003000**************************************************************** NC2424.2 +003100 ENVIRONMENT DIVISION. NC2424.2 +003200 CONFIGURATION SECTION. NC2424.2 +003300 SOURCE-COMPUTER. NC2424.2 +003400 Linux. NC2424.2 +003500 OBJECT-COMPUTER. NC2424.2 +003600 Linux. NC2424.2 +003700 INPUT-OUTPUT SECTION. NC2424.2 +003800 FILE-CONTROL. NC2424.2 +003900 SELECT PRINT-FILE ASSIGN TO NC2424.2 +004000 "report.log". NC2424.2 +004100 DATA DIVISION. NC2424.2 +004200 FILE SECTION. NC2424.2 +004300 FD PRINT-FILE. NC2424.2 +004400 01 PRINT-REC PICTURE X(120). NC2424.2 +004500 01 DUMMY-RECORD PICTURE X(120). NC2424.2 +004600 WORKING-STORAGE SECTION. NC2424.2 +004700 77 SUB-1 PICTURE S99 VALUE ZERO. NC2424.2 +004800 77 SUB-2 PICTURE 99 VALUE ZERO. NC2424.2 +004900 77 SUB-3 PICTURE 99 VALUE ZERO. NC2424.2 +005000 77 CON-7 PICTURE 99 VALUE 07. NC2424.2 +005100 77 CON-10 PICTURE 99 VALUE 10. NC2424.2 +005200 77 CON-5 PICTURE 99 VALUE 05. NC2424.2 +005300 77 CON-6 PICTURE 99 VALUE 06. NC2424.2 +005400 77 N1 PICTURE 99 VALUE ZERO. NC2424.2 +005500 77 N2 PICTURE 99 VALUE ZERO. NC2424.2 +005600 77 N3 PICTURE 99 VALUE ZERO. NC2424.2 +005700 77 N4 PICTURE 99 VALUE ZERO. NC2424.2 +005800 77 N5 PICTURE 99 VALUE ZERO. NC2424.2 +005900 77 N6 PICTURE 99 VALUE ZERO. NC2424.2 +006000 77 N7 PICTURE 99 VALUE ZERO. NC2424.2 +006100 NC2424.2 +006200 NC2424.2 +006300 NC2424.2 +006400 01 GRP-NAME. NC2424.2 +006500 02 FILLER PICTURE XXX VALUE "GRP". NC2424.2 +006600 02 ADD-GRP PICTURE 99 VALUE 01. NC2424.2 +006700 NC2424.2 +006800 01 SEC-NAME. NC2424.2 +006900 02 FILLER PICTURE X(5) VALUE "SEC (". NC2424.2 +007000 02 SEC-GRP PICTURE 99 VALUE 00. NC2424.2 +007100 02 FILLER PICTURE X VALUE ",". NC2424.2 +007200 02 ADD-SEC PICTURE 99 VALUE 01. NC2424.2 +007300 02 FILLER PICTURE X VALUE ")". NC2424.2 +007400 NC2424.2 +007500 01 ELEM-NAME. NC2424.2 +007600 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2424.2 +007700 02 ELEM-GRP PICTURE 99 VALUE 00. NC2424.2 +007800 02 FILLER PICTURE X VALUE ",". NC2424.2 +007900 02 ELEM-SEC PICTURE 99 VALUE 00. NC2424.2 +008000 02 FILLER PICTURE X VALUE ",". NC2424.2 +008100 02 ADD-ELEM PICTURE 99 VALUE 01. NC2424.2 +008200 02 FILLER PICTURE X VALUE ")". NC2424.2 +008300 NC2424.2 +008400 01 3-DIMENSION-TBL. NC2424.2 +008500 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2424.2 +008600 03 ENTRY-1 PICTURE X(5). NC2424.2 +008700 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2424.2 +008800 04 ENTRY-2 PICTURE X(11). NC2424.2 +008900 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2424.2 +009000 05 ENTRY-3 PICTURE X(15). NC2424.2 +009100 NC2424.2 +009200 01 7-DIMENSION-TBL. NC2424.2 +009300 02 GRP-7-1-ENTRY OCCURS 2 INDEXED BY IX-1. NC2424.2 +009400 03 ENTRY-7-1 PIC XX. NC2424.2 +009500 03 GRP-7-2-ENTRY OCCURS 2 INDEXED BY IX-2. NC2424.2 +009600 04 ENTRY-7-2 PIC XX. NC2424.2 +009700 04 GRP-7-3-ENTRY OCCURS 2 INDEXED BY IX-3. NC2424.2 +009800 05 ENTRY-7-3 PIC XX. NC2424.2 +009900 05 GRP-7-4-ENTRY OCCURS 2 INDEXED BY IX-4. NC2424.2 +010000 06 ENTRY-7-4 PIC XX. NC2424.2 +010100 06 GRP-7-5-ENTRY OCCURS 2 INDEXED BY IX-5. NC2424.2 +010200 07 ENTRY-7-5 PIC XX. NC2424.2 +010300 07 GRP-7-6-ENTRY OCCURS 2 INDEXED BY IX-6. NC2424.2 +010400 08 ENTRY-7-6 PIC XX. NC2424.2 +010500 08 GRP-7-7-ENTRY OCCURS 2 INDEXED BY IX-7. NC2424.2 +010600 09 ENTRY-7-7 PIC XX. NC2424.2 +010700 NC2424.2 +010800 77 L1-HOLD PIC XX. NC2424.2 +010900 77 L2-HOLD PIC XX. NC2424.2 +011000 77 L3-HOLD PIC XX. NC2424.2 +011100 77 L4-HOLD PIC XX. NC2424.2 +011200 77 L5-HOLD PIC XX. NC2424.2 +011300 77 L6-HOLD PIC XX. NC2424.2 +011400 77 L7-HOLD PIC XX. NC2424.2 +011500 01 TEST-RESULTS. NC2424.2 +011600 02 FILLER PIC X VALUE SPACE. NC2424.2 +011700 02 FEATURE PIC X(20) VALUE SPACE. NC2424.2 +011800 02 FILLER PIC X VALUE SPACE. NC2424.2 +011900 02 P-OR-F PIC X(5) VALUE SPACE. NC2424.2 +012000 02 FILLER PIC X VALUE SPACE. NC2424.2 +012100 02 PAR-NAME. NC2424.2 +012200 03 FILLER PIC X(19) VALUE SPACE. NC2424.2 +012300 03 PARDOT-X PIC X VALUE SPACE. NC2424.2 +012400 03 DOTVALUE PIC 99 VALUE ZERO. NC2424.2 +012500 02 FILLER PIC X(8) VALUE SPACE. NC2424.2 +012600 02 RE-MARK PIC X(61). NC2424.2 +012700 01 TEST-COMPUTED. NC2424.2 +012800 02 FILLER PIC X(30) VALUE SPACE. NC2424.2 +012900 02 FILLER PIC X(17) VALUE NC2424.2 +013000 " COMPUTED=". NC2424.2 +013100 02 COMPUTED-X. NC2424.2 +013200 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2424.2 +013300 03 COMPUTED-N REDEFINES COMPUTED-A NC2424.2 +013400 PIC -9(9).9(9). NC2424.2 +013500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2424.2 +013600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2424.2 +013700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2424.2 +013800 03 CM-18V0 REDEFINES COMPUTED-A. NC2424.2 +013900 04 COMPUTED-18V0 PIC -9(18). NC2424.2 +014000 04 FILLER PIC X. NC2424.2 +014100 03 FILLER PIC X(50) VALUE SPACE. NC2424.2 +014200 01 TEST-CORRECT. NC2424.2 +014300 02 FILLER PIC X(30) VALUE SPACE. NC2424.2 +014400 02 FILLER PIC X(17) VALUE " CORRECT =". NC2424.2 +014500 02 CORRECT-X. NC2424.2 +014600 03 CORRECT-A PIC X(20) VALUE SPACE. NC2424.2 +014700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2424.2 +014800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2424.2 +014900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2424.2 +015000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2424.2 +015100 03 CR-18V0 REDEFINES CORRECT-A. NC2424.2 +015200 04 CORRECT-18V0 PIC -9(18). NC2424.2 +015300 04 FILLER PIC X. NC2424.2 +015400 03 FILLER PIC X(2) VALUE SPACE. NC2424.2 +015500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2424.2 +015600 01 CCVS-C-1. NC2424.2 +015700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2424.2 +015800- "SS PARAGRAPH-NAME NC2424.2 +015900- " REMARKS". NC2424.2 +016000 02 FILLER PIC X(20) VALUE SPACE. NC2424.2 +016100 01 CCVS-C-2. NC2424.2 +016200 02 FILLER PIC X VALUE SPACE. NC2424.2 +016300 02 FILLER PIC X(6) VALUE "TESTED". NC2424.2 +016400 02 FILLER PIC X(15) VALUE SPACE. NC2424.2 +016500 02 FILLER PIC X(4) VALUE "FAIL". NC2424.2 +016600 02 FILLER PIC X(94) VALUE SPACE. NC2424.2 +016700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2424.2 +016800 01 REC-CT PIC 99 VALUE ZERO. NC2424.2 +016900 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2424.2 +017000 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2424.2 +017100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2424.2 +017200 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2424.2 +017300 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2424.2 +017400 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2424.2 +017500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2424.2 +017600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2424.2 +017700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2424.2 +017800 01 CCVS-H-1. NC2424.2 +017900 02 FILLER PIC X(39) VALUE SPACES. NC2424.2 +018000 02 FILLER PIC X(42) VALUE NC2424.2 +018100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2424.2 +018200 02 FILLER PIC X(39) VALUE SPACES. NC2424.2 +018300 01 CCVS-H-2A. NC2424.2 +018400 02 FILLER PIC X(40) VALUE SPACE. NC2424.2 +018500 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2424.2 +018600 02 FILLER PIC XXXX VALUE NC2424.2 +018700 "4.2 ". NC2424.2 +018800 02 FILLER PIC X(28) VALUE NC2424.2 +018900 " COPY - NOT FOR DISTRIBUTION". NC2424.2 +019000 02 FILLER PIC X(41) VALUE SPACE. NC2424.2 +019100 NC2424.2 +019200 01 CCVS-H-2B. NC2424.2 +019300 02 FILLER PIC X(15) VALUE NC2424.2 +019400 "TEST RESULT OF ". NC2424.2 +019500 02 TEST-ID PIC X(9). NC2424.2 +019600 02 FILLER PIC X(4) VALUE NC2424.2 +019700 " IN ". NC2424.2 +019800 02 FILLER PIC X(12) VALUE NC2424.2 +019900 " HIGH ". NC2424.2 +020000 02 FILLER PIC X(22) VALUE NC2424.2 +020100 " LEVEL VALIDATION FOR ". NC2424.2 +020200 02 FILLER PIC X(58) VALUE NC2424.2 +020300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2424.2 +020400 01 CCVS-H-3. NC2424.2 +020500 02 FILLER PIC X(34) VALUE NC2424.2 +020600 " FOR OFFICIAL USE ONLY ". NC2424.2 +020700 02 FILLER PIC X(58) VALUE NC2424.2 +020800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2424.2 +020900 02 FILLER PIC X(28) VALUE NC2424.2 +021000 " COPYRIGHT 1985 ". NC2424.2 +021100 01 CCVS-E-1. NC2424.2 +021200 02 FILLER PIC X(52) VALUE SPACE. NC2424.2 +021300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2424.2 +021400 02 ID-AGAIN PIC X(9). NC2424.2 +021500 02 FILLER PIC X(45) VALUE SPACES. NC2424.2 +021600 01 CCVS-E-2. NC2424.2 +021700 02 FILLER PIC X(31) VALUE SPACE. NC2424.2 +021800 02 FILLER PIC X(21) VALUE SPACE. NC2424.2 +021900 02 CCVS-E-2-2. NC2424.2 +022000 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2424.2 +022100 03 FILLER PIC X VALUE SPACE. NC2424.2 +022200 03 ENDER-DESC PIC X(44) VALUE NC2424.2 +022300 "ERRORS ENCOUNTERED". NC2424.2 +022400 01 CCVS-E-3. NC2424.2 +022500 02 FILLER PIC X(22) VALUE NC2424.2 +022600 " FOR OFFICIAL USE ONLY". NC2424.2 +022700 02 FILLER PIC X(12) VALUE SPACE. NC2424.2 +022800 02 FILLER PIC X(58) VALUE NC2424.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2424.2 +023000 02 FILLER PIC X(13) VALUE SPACE. NC2424.2 +023100 02 FILLER PIC X(15) VALUE NC2424.2 +023200 " COPYRIGHT 1985". NC2424.2 +023300 01 CCVS-E-4. NC2424.2 +023400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2424.2 +023500 02 FILLER PIC X(4) VALUE " OF ". NC2424.2 +023600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2424.2 +023700 02 FILLER PIC X(40) VALUE NC2424.2 +023800 " TESTS WERE EXECUTED SUCCESSFULLY". NC2424.2 +023900 01 XXINFO. NC2424.2 +024000 02 FILLER PIC X(19) VALUE NC2424.2 +024100 "*** INFORMATION ***". NC2424.2 +024200 02 INFO-TEXT. NC2424.2 +024300 04 FILLER PIC X(8) VALUE SPACE. NC2424.2 +024400 04 XXCOMPUTED PIC X(20). NC2424.2 +024500 04 FILLER PIC X(5) VALUE SPACE. NC2424.2 +024600 04 XXCORRECT PIC X(20). NC2424.2 +024700 02 INF-ANSI-REFERENCE PIC X(48). NC2424.2 +024800 01 HYPHEN-LINE. NC2424.2 +024900 02 FILLER PIC IS X VALUE IS SPACE. NC2424.2 +025000 02 FILLER PIC IS X(65) VALUE IS "************************NC2424.2 +025100- "*****************************************". NC2424.2 +025200 02 FILLER PIC IS X(54) VALUE IS "************************NC2424.2 +025300- "******************************". NC2424.2 +025400 01 CCVS-PGM-ID PIC X(9) VALUE NC2424.2 +025500 "NC242A". NC2424.2 +025600 PROCEDURE DIVISION. NC2424.2 +025700 CCVS1 SECTION. NC2424.2 +025800 OPEN-FILES. NC2424.2 +025900 OPEN OUTPUT PRINT-FILE. NC2424.2 +026000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2424.2 +026100 MOVE SPACE TO TEST-RESULTS. NC2424.2 +026200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2424.2 +026300 GO TO CCVS1-EXIT. NC2424.2 +026400 CLOSE-FILES. NC2424.2 +026500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2424.2 +026600 TERMINATE-CCVS. NC2424.2 +026700*S EXIT PROGRAM. NC2424.2 +026800*SERMINATE-CALL. NC2424.2 +026900 STOP RUN. NC2424.2 +027000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2424.2 +027100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2424.2 +027200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2424.2 +027300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2424.2 +027400 MOVE "****TEST DELETED****" TO RE-MARK. NC2424.2 +027500 PRINT-DETAIL. NC2424.2 +027600 IF REC-CT NOT EQUAL TO ZERO NC2424.2 +027700 MOVE "." TO PARDOT-X NC2424.2 +027800 MOVE REC-CT TO DOTVALUE. NC2424.2 +027900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2424.2 +028000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2424.2 +028100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2424.2 +028200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2424.2 +028300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2424.2 +028400 MOVE SPACE TO CORRECT-X. NC2424.2 +028500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2424.2 +028600 MOVE SPACE TO RE-MARK. NC2424.2 +028700 HEAD-ROUTINE. NC2424.2 +028800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +028900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +029000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2424.2 +029100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2424.2 +029200 COLUMN-NAMES-ROUTINE. NC2424.2 +029300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +029400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +029500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +029600 END-ROUTINE. NC2424.2 +029700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2424.2 +029800 END-RTN-EXIT. NC2424.2 +029900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +030000 END-ROUTINE-1. NC2424.2 +030100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2424.2 +030200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2424.2 +030300 ADD PASS-COUNTER TO ERROR-HOLD. NC2424.2 +030400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2424.2 +030500 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2424.2 +030600 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2424.2 +030700 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2424.2 +030800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2424.2 +030900 END-ROUTINE-12. NC2424.2 +031000 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2424.2 +031100 IF ERROR-COUNTER IS EQUAL TO ZERO NC2424.2 +031200 MOVE "NO " TO ERROR-TOTAL NC2424.2 +031300 ELSE NC2424.2 +031400 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2424.2 +031500 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2424.2 +031600 PERFORM WRITE-LINE. NC2424.2 +031700 END-ROUTINE-13. NC2424.2 +031800 IF DELETE-COUNTER IS EQUAL TO ZERO NC2424.2 +031900 MOVE "NO " TO ERROR-TOTAL ELSE NC2424.2 +032000 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2424.2 +032100 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2424.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +032300 IF INSPECT-COUNTER EQUAL TO ZERO NC2424.2 +032400 MOVE "NO " TO ERROR-TOTAL NC2424.2 +032500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2424.2 +032600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2424.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +032800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2424.2 +032900 WRITE-LINE. NC2424.2 +033000 ADD 1 TO RECORD-COUNT. NC2424.2 +033100 IF RECORD-COUNT GREATER 50 NC2424.2 +033200 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2424.2 +033300 MOVE SPACE TO DUMMY-RECORD NC2424.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2424.2 +033500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2424.2 +033600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2424.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2424.2 +033800 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2424.2 +033900 MOVE ZERO TO RECORD-COUNT. NC2424.2 +034000 PERFORM WRT-LN. NC2424.2 +034100 WRT-LN. NC2424.2 +034200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2424.2 +034300 MOVE SPACE TO DUMMY-RECORD. NC2424.2 +034400 BLANK-LINE-PRINT. NC2424.2 +034500 PERFORM WRT-LN. NC2424.2 +034600 FAIL-ROUTINE. NC2424.2 +034700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2424.2 +034800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2424.2 +034900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2424.2 +035000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2424.2 +035100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +035200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2424.2 +035300 GO TO FAIL-ROUTINE-EX. NC2424.2 +035400 FAIL-ROUTINE-WRITE. NC2424.2 +035500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2424.2 +035600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2424.2 +035700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2424.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. NC2424.2 +035900 FAIL-ROUTINE-EX. EXIT. NC2424.2 +036000 BAIL-OUT. NC2424.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2424.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2424.2 +036300 BAIL-OUT-WRITE. NC2424.2 +036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2424.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2424.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2424.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2424.2 +036800 BAIL-OUT-EX. EXIT. NC2424.2 +036900 CCVS1-EXIT. NC2424.2 +037000 EXIT. NC2424.2 +037100 SECT-NC242A-001 SECTION. NC2424.2 +037200 TH-16-001. NC2424.2 +037300 PERFORM PARA-1 VARYING SUB-1 FROM 1 BY 1 NC2424.2 +037400 UNTIL SUB-1 EQUAL TO 11 NC2424.2 +037500 AFTER SUB-2 FROM 1 BY 1 UNTIL SUB-2 EQUAL TO 11 NC2424.2 +037600 AFTER SUB-3 FROM 1 BY 1 UNTIL SUB-3 EQUAL TO 11 NC2424.2 +037700 GO TO CHECK-ENTRIES. NC2424.2 +037800 NC2424.2 +037900 PARA-1. NC2424.2 +038000 SET IDX-1 TO SUB-1. NC2424.2 +038100 SET IDX-2 TO SUB-2. NC2424.2 +038200 SET IDX-3 TO SUB-3. NC2424.2 +038300 SET ADD-GRP, SEC-GRP, ELEM-GRP TO IDX-1. NC2424.2 +038400 MOVE GRP-NAME TO ENTRY-1 (IDX-1). NC2424.2 +038500 SET ADD-SEC, ELEM-SEC TO IDX-2. NC2424.2 +038600 MOVE SEC-NAME TO ENTRY-2 (IDX-1, IDX-2). NC2424.2 +038700 SET ADD-ELEM TO IDX-3. NC2424.2 +038800 MOVE ELEM-NAME TO ENTRY-3 (IDX-1, IDX-2, IDX-3). NC2424.2 +038900 NC2424.2 +039000 CHECK-ENTRIES. NC2424.2 +039100 MOVE "LEVEL 1 TBL SUBSCRPT" TO FEATURE. NC2424.2 +039200 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2424.2 +039300 IF ENTRY-1 (5) IS NOT EQUAL TO "GRP05" NC2424.2 +039400 MOVE "GRP05" TO CORRECT-A NC2424.2 +039500 MOVE ENTRY-1 (5) TO COMPUTED-A NC2424.2 +039600 NC2424.2 +039700 MOVE "NUMERIC LITERAL SUBSCRIPT " TO RE-MARK NC2424.2 +039800 PERFORM FAIL NC2424.2 +039900 GO TO TEST-1-WRITE. NC2424.2 +040000 NC2424.2 +040100 PERFORM PASS. NC2424.2 +040200 TEST-1-WRITE. NC2424.2 +040300 PERFORM PRINT-DETAIL. NC2424.2 +040400 NC2424.2 +040500 TEST-1-2. NC2424.2 +040600 MOVE "TEST-1-2" TO PAR-NAME. NC2424.2 +040700 IF ENTRY-1 (CON-5) IS NOT EQUAL TO "GRP05" NC2424.2 +040800 MOVE "GRP05" TO CORRECT-A NC2424.2 +040900 MOVE ENTRY-1 (CON-5) TO COMPUTED-A NC2424.2 +041000 NC2424.2 +041100 MOVE "NUMERIC CONSTANT SUBSCRIPT " TO RE-MARK NC2424.2 +041200 PERFORM FAIL NC2424.2 +041300 GO TO TEST-1-2-WRITE. NC2424.2 +041400 NC2424.2 +041500 PERFORM PASS. NC2424.2 +041600 TEST-1-2-WRITE. NC2424.2 +041700 PERFORM PRINT-DETAIL. NC2424.2 +041800 NC2424.2 +041900 TEST-2. NC2424.2 +042000 MOVE "LEVEL 2 TBL SUBSCRPT" TO FEATURE. NC2424.2 +042100 MOVE "TEST-2 " TO PAR-NAME. NC2424.2 +042200 IF ENTRY-2 (5, 6) IS NOT EQUAL TO "SEC (05,06)" NC2424.2 +042300 MOVE "SEC (05,06)" TO CORRECT-A NC2424.2 +042400 MOVE ENTRY-2 (5, 6) TO COMPUTED-A NC2424.2 +042500 NC2424.2 +042600 MOVE "NUMERIC LITERAL SUBSCRIPT " TO RE-MARK NC2424.2 +042700 PERFORM FAIL NC2424.2 +042800 GO TO TEST-2-WRITE. NC2424.2 +042900 NC2424.2 +043000 PERFORM PASS. NC2424.2 +043100 TEST-2-WRITE. NC2424.2 +043200 PERFORM PRINT-DETAIL. NC2424.2 +043300 NC2424.2 +043400 TEST-2-2. NC2424.2 +043500 MOVE "TEST-2-2 " TO PAR-NAME. NC2424.2 +043600 IF ENTRY-2 (05, CON-6) IS NOT EQUAL TO "SEC (05,06)" NC2424.2 +043700 MOVE "SEC (05,06)" TO CORRECT-A NC2424.2 +043800 MOVE ENTRY-2 (05, CON-6) TO COMPUTED-A NC2424.2 +043900 NC2424.2 +044000 MOVE "NUM LITRL/CONSTANT SUBSCRPT" TO RE-MARK NC2424.2 +044100 PERFORM FAIL NC2424.2 +044200 GO TO TEST-2-2-WRITE. NC2424.2 +044300 NC2424.2 +044400 PERFORM PASS. NC2424.2 +044500 TEST-2-2-WRITE. NC2424.2 +044600 PERFORM PRINT-DETAIL. NC2424.2 +044700 NC2424.2 +044800 TEST-2-3. NC2424.2 +044900 MOVE "TEST-2-3 " TO PAR-NAME. NC2424.2 +045000 IF ENTRY-2 (CON-5, CON-6) IS NOT EQUAL TO "SEC (05,06)" NC2424.2 +045100 MOVE "SEC (05,06)" TO CORRECT-A NC2424.2 +045200 MOVE ENTRY-2 (CON-5, CON-6) TO COMPUTED-A NC2424.2 +045300 NC2424.2 +045400 MOVE "2 NUMERIC CONSTANT SUBSCRPT" TO RE-MARK NC2424.2 +045500 PERFORM FAIL NC2424.2 +045600 GO TO TEST-2-3-WRITE. NC2424.2 +045700 NC2424.2 +045800 PERFORM PASS. NC2424.2 +045900 TEST-2-3-WRITE. NC2424.2 +046000 PERFORM PRINT-DETAIL. NC2424.2 +046100 NC2424.2 +046200 TEST-3. NC2424.2 +046300 MOVE "LEVEL 3 TBL SUBSCRPT" TO FEATURE. NC2424.2 +046400 MOVE "TEST-3 " TO PAR-NAME. NC2424.2 +046500 IF ENTRY-3 (10, 05, 06) IS NOT EQUAL TO "ELEM (10,05,06)" NC2424.2 +046600 MOVE "ELEM (10,05,06)" TO CORRECT-A NC2424.2 +046700 MOVE ENTRY-3 (10, 05, 06) TO COMPUTED-A NC2424.2 +046800 NC2424.2 +046900 MOVE "3 NUMERIC LITERAL SUBSCRPTS" TO RE-MARK NC2424.2 +047000 PERFORM FAIL NC2424.2 +047100 GO TO TEST-3-WRITE. NC2424.2 +047200 NC2424.2 +047300 PERFORM PASS. NC2424.2 +047400 TEST-3-WRITE. NC2424.2 +047500 PERFORM PRINT-DETAIL. NC2424.2 +047600 NC2424.2 +047700 TEST-3-2. NC2424.2 +047800 MOVE "TEST-3-2 " TO PAR-NAME. NC2424.2 +047900 IF ENTRY-3 (10, CON-5, CON-6) IS NOT EQUAL TO NC2424.2 +048000 "ELEM (10,05,06)" NC2424.2 +048100 MOVE "ELEM (10,05,06)" TO CORRECT-A NC2424.2 +048200 MOVE ENTRY-3 (10, CON-5, CON-6) TO COMPUTED-A NC2424.2 +048300 NC2424.2 +048400 MOVE "1 NUM LTRL/2 CONSTANT SUBS " TO RE-MARK NC2424.2 +048500 PERFORM FAIL NC2424.2 +048600 GO TO TEST-3-2-WRITE. NC2424.2 +048700 NC2424.2 +048800 PERFORM PASS. NC2424.2 +048900 TEST-3-2-WRITE. NC2424.2 +049000 PERFORM PRINT-DETAIL. NC2424.2 +049100 NC2424.2 +049200 TEST-3-3. NC2424.2 +049300 MOVE "TEST-3-3 " TO PAR-NAME. NC2424.2 +049400 IF ENTRY-3 (CON-10, CON-5, CON-6) IS NOT EQUAL TO NC2424.2 +049500 "ELEM (10,05,06)" MOVE "ELEM (10,05,06)" TO CORRECT-A NC2424.2 +049600 MOVE ENTRY-3 (CON-10, CON-5, CON-6) TO COMPUTED-A NC2424.2 +049700 NC2424.2 +049800 MOVE "3 NUMERIC CONSTANT SUBSCRPT" TO RE-MARK NC2424.2 +049900 PERFORM FAIL NC2424.2 +050000 GO TO END-3LEVEL-SUBSCRPT-TEST. NC2424.2 +050100 NC2424.2 +050200 PERFORM PASS. NC2424.2 +050300 GO TO END-3LEVEL-SUBSCRPT-TEST. NC2424.2 +050400 NC2424.2 +050500 END-3LEVEL-SUBSCRPT-TEST. NC2424.2 +050600 PERFORM PRINT-DETAIL. NC2424.2 +050700* NC2424.2 +050800 TH7-INIT. NC2424.2 +050900 MOVE "TH7-TEST" TO PAR-NAME. NC2424.2 +051000 MOVE "VI-2 1.3.4" TO ANSI-REFERENCE. NC2424.2 +051100 MOVE ALL "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO 7-DIMENSION-TBL. NC2424.2 +051200 MOVE "KL" TO L4-HOLD. NC2424.2 +051300 MOVE "AB" TO L5-HOLD. NC2424.2 +051400 MOVE "CD" TO L6-HOLD. NC2424.2 +051500 MOVE "GH" TO L7-HOLD. NC2424.2 +051600 MOVE 1 TO REC-CT. NC2424.2 +051700 SET IX-1 IX-2 IX-3 IX-4 IX-5 IX-6 IX-7 TO 1. NC2424.2 +051800 MOVE 2 TO N1 N3 N5 N7. NC2424.2 +051900 GO TO TH7-TEST-1. NC2424.2 +052000 TH7-DELETE-1. NC2424.2 +052100 PERFORM DE-LETE. NC2424.2 +052200 PERFORM PRINT-DETAIL. NC2424.2 +052300 GO TO CCVS-999999. NC2424.2 +052400 TH7-TEST-1. NC2424.2 +052500 MOVE "TH7-TEST-1" TO PAR-NAME. NC2424.2 +052600 IF ENTRY-7-4 (N1 1 N3 1) = L4-HOLD NC2424.2 +052700 PERFORM PASS NC2424.2 +052800 PERFORM PRINT-DETAIL NC2424.2 +052900 ELSE NC2424.2 +053000 MOVE ENTRY-7-4 (N1 1 N3 1) TO COMPUTED-A NC2424.2 +053100 MOVE L4-HOLD TO CORRECT-A NC2424.2 +053200 MOVE "TABLE INCORRECT" TO RE-MARK NC2424.2 +053300 PERFORM FAIL NC2424.2 +053400 PERFORM PRINT-DETAIL. NC2424.2 +053500 ADD 1 TO REC-CT. NC2424.2 +053600 TH7-TEST-2. NC2424.2 +053700 MOVE "TH7-TEST-2" TO PAR-NAME. NC2424.2 +053800 IF ENTRY-7-5 (N1 1 N3 1 N5) = L5-HOLD NC2424.2 +053900 PERFORM PASS NC2424.2 +054000 PERFORM PRINT-DETAIL NC2424.2 +054100 ELSE NC2424.2 +054200 MOVE ENTRY-7-5 (N1 1 N3 1 N5) TO COMPUTED-A NC2424.2 +054300 MOVE L5-HOLD TO CORRECT-A NC2424.2 +054400 MOVE "TABLE INCORRECT" TO RE-MARK NC2424.2 +054500 PERFORM FAIL NC2424.2 +054600 PERFORM PRINT-DETAIL. NC2424.2 +054700 ADD 1 TO REC-CT. NC2424.2 +054800 TH7-TEST-3. NC2424.2 +054900 MOVE "TH7-TEST-3" TO PAR-NAME. NC2424.2 +055000 IF ENTRY-7-6 (N1 1 N3 1 N5 1) = L6-HOLD NC2424.2 +055100 PERFORM PASS NC2424.2 +055200 PERFORM PRINT-DETAIL NC2424.2 +055300 ELSE NC2424.2 +055400 MOVE ENTRY-7-6 (N1 1 N3 1 N5 1) TO COMPUTED-A NC2424.2 +055500 MOVE L6-HOLD TO CORRECT-A NC2424.2 +055600 MOVE "TABLE INCORRECT" TO RE-MARK NC2424.2 +055700 PERFORM FAIL NC2424.2 +055800 PERFORM PRINT-DETAIL. NC2424.2 +055900 ADD 1 TO REC-CT. NC2424.2 +056000 TH7-TEST-4. NC2424.2 +056100 MOVE "TH7-TEST-4" TO PAR-NAME. NC2424.2 +056200 IF ENTRY-7-7 (N1 1 N3 1 N5 1 N7) = L7-HOLD NC2424.2 +056300 PERFORM PASS NC2424.2 +056400 PERFORM PRINT-DETAIL NC2424.2 +056500 ELSE NC2424.2 +056600 MOVE ENTRY-7-7 (N1 1 N3 1 N5 1 N7) TO COMPUTED-A NC2424.2 +056700 MOVE L7-HOLD TO CORRECT-A NC2424.2 +056800 MOVE "TABLE INCORRECT" TO RE-MARK NC2424.2 +056900 PERFORM FAIL NC2424.2 +057000 PERFORM PRINT-DETAIL. NC2424.2 +057100 NC2424.2 +057200* NC2424.2 +057300 CCVS-EXIT SECTION. NC2424.2 +057400 CCVS-999999. NC2424.2 +057500 GO TO CLOSE-FILES. NC2424.2 diff --git a/tests/cobol85/NC/NC243A.CBL b/tests/cobol85/NC/NC243A.CBL new file mode 100755 index 00000000..a476d653 --- /dev/null +++ b/tests/cobol85/NC/NC243A.CBL @@ -0,0 +1,702 @@ +000100 IDENTIFICATION DIVISION. NC2434.2 +000200 PROGRAM-ID. NC2434.2 +000300 NC243A. NC2434.2 +000400 NC2434.2 +000500**************************************************************** NC2434.2 +000600* * NC2434.2 +000700* VALIDATION FOR:- * NC2434.2 +000800* * NC2434.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2434.2 +001000* * NC2434.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2434.2 +001200* * NC2434.2 +001300**************************************************************** NC2434.2 +001400* * NC2434.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2434.2 +001600* * NC2434.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2434.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2434.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2434.2 +002000* * NC2434.2 +002100**************************************************************** NC2434.2 +002200* * NC2434.2 +002300* PROGRAM NC243A TESTS THE CONSTRUCTION AND ACCES OF A * NC2434.2 +002400* SEVEN-DIMENSIONAL TABLE. THE CONSTRUCTION IS VIA * NC2434.2 +002500* SUBSCRIPTED LOOPS AND ACCESS IS BY FORMAT 4 "PERFORM" * NC2434.2 +002600* STATEMENTS USING INDICES. * NC2434.2 +002700* * NC2434.2 +002800**************************************************************** NC2434.2 +002900 ENVIRONMENT DIVISION. NC2434.2 +003000 CONFIGURATION SECTION. NC2434.2 +003100 SOURCE-COMPUTER. NC2434.2 +003200 Linux. NC2434.2 +003300 OBJECT-COMPUTER. NC2434.2 +003400 Linux. NC2434.2 +003500 INPUT-OUTPUT SECTION. NC2434.2 +003600 FILE-CONTROL. NC2434.2 +003700 SELECT PRINT-FILE ASSIGN TO NC2434.2 +003800 "report.log". NC2434.2 +003900 DATA DIVISION. NC2434.2 +004000 FILE SECTION. NC2434.2 +004100 FD PRINT-FILE. NC2434.2 +004200 01 PRINT-REC PICTURE X(120). NC2434.2 +004300 01 DUMMY-RECORD PICTURE X(120). NC2434.2 +004400 WORKING-STORAGE SECTION. NC2434.2 +004500 77 SUB-1 PICTURE S99 VALUE ZERO. NC2434.2 +004600 77 SUB-2 PICTURE 99 VALUE ZERO. NC2434.2 +004700 77 SUB-3 PICTURE 99 VALUE ZERO. NC2434.2 +004800 77 TEST-CHECK PIC X(4) VALUE SPACE. NC2434.2 +004900 77 CON-7 PICTURE 99 VALUE 07. NC2434.2 +005000 77 CON-10 PICTURE 99 VALUE 10. NC2434.2 +005100 77 ELEM-HOLD-AREA PICTURE X(15) VALUE SPACES. NC2434.2 +005200 77 CON-5 PICTURE 99 VALUE 05. NC2434.2 +005300 77 SEC-HOLD-AREA PICTURE X(11) VALUE SPACES. NC2434.2 +005400 77 CON-6 PICTURE 99 VALUE 06. NC2434.2 +005500 77 GRP-HOLD-AREA PICTURE X(5) VALUE SPACES. NC2434.2 +005600 77 N1 PIC 9. NC2434.2 +005700 77 N2 PIC 9. NC2434.2 +005800 77 N3 PIC 9. NC2434.2 +005900 77 N4 PIC 9. NC2434.2 +006000 77 N5 PIC 9. NC2434.2 +006100 77 N6 PIC 9. NC2434.2 +006200 77 N7 PIC 9. NC2434.2 +006300 01 GRP-NAME. NC2434.2 +006400 02 FILLER PICTURE XXX VALUE "GRP". NC2434.2 +006500 02 ADD-GRP PICTURE 99 VALUE 01. NC2434.2 +006600 NC2434.2 +006700 01 SEC-NAME. NC2434.2 +006800 02 FILLER PICTURE X(5) VALUE "SEC (". NC2434.2 +006900 02 SEC-GRP PICTURE 99 VALUE 00. NC2434.2 +007000 02 FILLER PICTURE X VALUE ",". NC2434.2 +007100 02 ADD-SEC PICTURE 99 VALUE 01. NC2434.2 +007200 02 FILLER PICTURE X VALUE ")". NC2434.2 +007300 NC2434.2 +007400 01 ELEM-NAME. NC2434.2 +007500 02 FILLER PICTURE X(6) VALUE "ELEM (". NC2434.2 +007600 02 ELEM-GRP PICTURE 99 VALUE 00. NC2434.2 +007700 02 FILLER PICTURE X VALUE ",". NC2434.2 +007800 02 ELEM-SEC PICTURE 99 VALUE 00. NC2434.2 +007900 02 FILLER PICTURE X VALUE ",". NC2434.2 +008000 02 ADD-ELEM PICTURE 99 VALUE 01. NC2434.2 +008100 02 FILLER PICTURE X VALUE ")". NC2434.2 +008200 NC2434.2 +008300 01 3-DIMENSION-TBL. NC2434.2 +008400 02 GRP-ENTRY OCCURS 10 TIMES INDEXED BY IDX-1. NC2434.2 +008500 03 ENTRY-1 PICTURE X(5). NC2434.2 +008600 03 GRP2-ENTRY OCCURS 10 TIMES INDEXED BY IDX-2. NC2434.2 +008700 04 ENTRY-2 PICTURE X(11). NC2434.2 +008800 04 GRP3-ENTRY OCCURS 10 TIMES INDEXED BY IDX-3. NC2434.2 +008900 05 ENTRY-3 PICTURE X(15). NC2434.2 +009000 NC2434.2 +009100 01 7-DIMENSION-TBL. NC2434.2 +009200 02 GRP-7-1-ENTRY OCCURS 2 INDEXED BY X1. NC2434.2 +009300 03 ENTRY-7-1 PIC XX. NC2434.2 +009400 03 GRP-7-2-ENTRY OCCURS 2 INDEXED BY X2. NC2434.2 +009500 04 ENTRY-7-2 PIC XX. NC2434.2 +009600 04 GRP-7-3-ENTRY OCCURS 2 INDEXED BY X3. NC2434.2 +009700 05 ENTRY-7-3 PIC XX. NC2434.2 +009800 05 GRP-7-4-ENTRY OCCURS 2 INDEXED BY X4. NC2434.2 +009900 06 ENTRY-7-4 PIC XX. NC2434.2 +010000 06 GRP-7-5-ENTRY OCCURS 2 INDEXED BY X5. NC2434.2 +010100 07 ENTRY-7-5 PIC XX. NC2434.2 +010200 07 GRP-7-6-ENTRY OCCURS 2 INDEXED BY X6. NC2434.2 +010300 08 ENTRY-7-6 PIC XX. NC2434.2 +010400 08 GRP-7-7-ENTRY OCCURS 2 INDEXED BY X7. NC2434.2 +010500 09 ENTRY-7-7 PIC XX. NC2434.2 +010600 NC2434.2 +010700 01 WS-FLAG PIC X(5). NC2434.2 +010800 01 TEST-RESULTS. NC2434.2 +010900 02 FILLER PIC X VALUE SPACE. NC2434.2 +011000 02 FEATURE PIC X(20) VALUE SPACE. NC2434.2 +011100 02 FILLER PIC X VALUE SPACE. NC2434.2 +011200 02 P-OR-F PIC X(5) VALUE SPACE. NC2434.2 +011300 02 FILLER PIC X VALUE SPACE. NC2434.2 +011400 02 PAR-NAME. NC2434.2 +011500 03 FILLER PIC X(19) VALUE SPACE. NC2434.2 +011600 03 PARDOT-X PIC X VALUE SPACE. NC2434.2 +011700 03 DOTVALUE PIC 99 VALUE ZERO. NC2434.2 +011800 02 FILLER PIC X(8) VALUE SPACE. NC2434.2 +011900 02 RE-MARK PIC X(61). NC2434.2 +012000 01 TEST-COMPUTED. NC2434.2 +012100 02 FILLER PIC X(30) VALUE SPACE. NC2434.2 +012200 02 FILLER PIC X(17) VALUE NC2434.2 +012300 " COMPUTED=". NC2434.2 +012400 02 COMPUTED-X. NC2434.2 +012500 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2434.2 +012600 03 COMPUTED-N REDEFINES COMPUTED-A NC2434.2 +012700 PIC -9(9).9(9). NC2434.2 +012800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2434.2 +012900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2434.2 +013000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2434.2 +013100 03 CM-18V0 REDEFINES COMPUTED-A. NC2434.2 +013200 04 COMPUTED-18V0 PIC -9(18). NC2434.2 +013300 04 FILLER PIC X. NC2434.2 +013400 03 FILLER PIC X(50) VALUE SPACE. NC2434.2 +013500 01 TEST-CORRECT. NC2434.2 +013600 02 FILLER PIC X(30) VALUE SPACE. NC2434.2 +013700 02 FILLER PIC X(17) VALUE " CORRECT =". NC2434.2 +013800 02 CORRECT-X. NC2434.2 +013900 03 CORRECT-A PIC X(20) VALUE SPACE. NC2434.2 +014000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2434.2 +014100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2434.2 +014200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2434.2 +014300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2434.2 +014400 03 CR-18V0 REDEFINES CORRECT-A. NC2434.2 +014500 04 CORRECT-18V0 PIC -9(18). NC2434.2 +014600 04 FILLER PIC X. NC2434.2 +014700 03 FILLER PIC X(2) VALUE SPACE. NC2434.2 +014800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2434.2 +014900 01 CCVS-C-1. NC2434.2 +015000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2434.2 +015100- "SS PARAGRAPH-NAME NC2434.2 +015200- " REMARKS". NC2434.2 +015300 02 FILLER PIC X(20) VALUE SPACE. NC2434.2 +015400 01 CCVS-C-2. NC2434.2 +015500 02 FILLER PIC X VALUE SPACE. NC2434.2 +015600 02 FILLER PIC X(6) VALUE "TESTED". NC2434.2 +015700 02 FILLER PIC X(15) VALUE SPACE. NC2434.2 +015800 02 FILLER PIC X(4) VALUE "FAIL". NC2434.2 +015900 02 FILLER PIC X(94) VALUE SPACE. NC2434.2 +016000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2434.2 +016100 01 REC-CT PIC 99 VALUE ZERO. NC2434.2 +016200 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2434.2 +016300 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2434.2 +016400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2434.2 +016500 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2434.2 +016600 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2434.2 +016700 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2434.2 +016800 01 L4-HOLD PIC XX VALUE SPACE. NC2434.2 +016900 01 L5-HOLD PIC XX VALUE SPACE. NC2434.2 +017000 01 L6-HOLD PIC XX VALUE SPACE. NC2434.2 +017100 01 L7-HOLD PIC XX VALUE SPACE. NC2434.2 +017200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2434.2 +017300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2434.2 +017400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2434.2 +017500 01 CCVS-H-1. NC2434.2 +017600 02 FILLER PIC X(39) VALUE SPACES. NC2434.2 +017700 02 FILLER PIC X(42) VALUE NC2434.2 +017800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2434.2 +017900 02 FILLER PIC X(39) VALUE SPACES. NC2434.2 +018000 01 CCVS-H-2A. NC2434.2 +018100 02 FILLER PIC X(40) VALUE SPACE. NC2434.2 +018200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2434.2 +018300 02 FILLER PIC XXXX VALUE NC2434.2 +018400 "4.2 ". NC2434.2 +018500 02 FILLER PIC X(28) VALUE NC2434.2 +018600 " COPY - NOT FOR DISTRIBUTION". NC2434.2 +018700 02 FILLER PIC X(41) VALUE SPACE. NC2434.2 +018800 NC2434.2 +018900 01 CCVS-H-2B. NC2434.2 +019000 02 FILLER PIC X(15) VALUE NC2434.2 +019100 "TEST RESULT OF ". NC2434.2 +019200 02 TEST-ID PIC X(9). NC2434.2 +019300 02 FILLER PIC X(4) VALUE NC2434.2 +019400 " IN ". NC2434.2 +019500 02 FILLER PIC X(12) VALUE NC2434.2 +019600 " HIGH ". NC2434.2 +019700 02 FILLER PIC X(22) VALUE NC2434.2 +019800 " LEVEL VALIDATION FOR ". NC2434.2 +019900 02 FILLER PIC X(58) VALUE NC2434.2 +020000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2434.2 +020100 01 CCVS-H-3. NC2434.2 +020200 02 FILLER PIC X(34) VALUE NC2434.2 +020300 " FOR OFFICIAL USE ONLY ". NC2434.2 +020400 02 FILLER PIC X(58) VALUE NC2434.2 +020500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2434.2 +020600 02 FILLER PIC X(28) VALUE NC2434.2 +020700 " COPYRIGHT 1985 ". NC2434.2 +020800 01 CCVS-E-1. NC2434.2 +020900 02 FILLER PIC X(52) VALUE SPACE. NC2434.2 +021000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2434.2 +021100 02 ID-AGAIN PIC X(9). NC2434.2 +021200 02 FILLER PIC X(45) VALUE SPACES. NC2434.2 +021300 01 CCVS-E-2. NC2434.2 +021400 02 FILLER PIC X(31) VALUE SPACE. NC2434.2 +021500 02 FILLER PIC X(21) VALUE SPACE. NC2434.2 +021600 02 CCVS-E-2-2. NC2434.2 +021700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2434.2 +021800 03 FILLER PIC X VALUE SPACE. NC2434.2 +021900 03 ENDER-DESC PIC X(44) VALUE NC2434.2 +022000 "ERRORS ENCOUNTERED". NC2434.2 +022100 01 CCVS-E-3. NC2434.2 +022200 02 FILLER PIC X(22) VALUE NC2434.2 +022300 " FOR OFFICIAL USE ONLY". NC2434.2 +022400 02 FILLER PIC X(12) VALUE SPACE. NC2434.2 +022500 02 FILLER PIC X(58) VALUE NC2434.2 +022600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2434.2 +022700 02 FILLER PIC X(13) VALUE SPACE. NC2434.2 +022800 02 FILLER PIC X(15) VALUE NC2434.2 +022900 " COPYRIGHT 1985". NC2434.2 +023000 01 CCVS-E-4. NC2434.2 +023100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2434.2 +023200 02 FILLER PIC X(4) VALUE " OF ". NC2434.2 +023300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2434.2 +023400 02 FILLER PIC X(40) VALUE NC2434.2 +023500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2434.2 +023600 01 XXINFO. NC2434.2 +023700 02 FILLER PIC X(19) VALUE NC2434.2 +023800 "*** INFORMATION ***". NC2434.2 +023900 02 INFO-TEXT. NC2434.2 +024000 04 FILLER PIC X(8) VALUE SPACE. NC2434.2 +024100 04 XXCOMPUTED PIC X(20). NC2434.2 +024200 04 FILLER PIC X(5) VALUE SPACE. NC2434.2 +024300 04 XXCORRECT PIC X(20). NC2434.2 +024400 02 INF-ANSI-REFERENCE PIC X(48). NC2434.2 +024500 01 HYPHEN-LINE. NC2434.2 +024600 02 FILLER PIC IS X VALUE IS SPACE. NC2434.2 +024700 02 FILLER PIC IS X(65) VALUE IS "************************NC2434.2 +024800- "*****************************************". NC2434.2 +024900 02 FILLER PIC IS X(54) VALUE IS "************************NC2434.2 +025000- "******************************". NC2434.2 +025100 01 CCVS-PGM-ID PIC X(9) VALUE NC2434.2 +025200 "NC243A". NC2434.2 +025300 PROCEDURE DIVISION. NC2434.2 +025400 CCVS1 SECTION. NC2434.2 +025500 OPEN-FILES. NC2434.2 +025600 OPEN OUTPUT PRINT-FILE. NC2434.2 +025700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2434.2 +025800 MOVE SPACE TO TEST-RESULTS. NC2434.2 +025900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2434.2 +026000 GO TO CCVS1-EXIT. NC2434.2 +026100 CLOSE-FILES. NC2434.2 +026200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2434.2 +026300 TERMINATE-CCVS. NC2434.2 +026400*S EXIT PROGRAM. NC2434.2 +026500*SERMINATE-CALL. NC2434.2 +026600 STOP RUN. NC2434.2 +026700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2434.2 +026800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2434.2 +026900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2434.2 +027000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2434.2 +027100 MOVE "****TEST DELETED****" TO RE-MARK. NC2434.2 +027200 PRINT-DETAIL. NC2434.2 +027300 IF REC-CT NOT EQUAL TO ZERO NC2434.2 +027400 MOVE "." TO PARDOT-X NC2434.2 +027500 MOVE REC-CT TO DOTVALUE. NC2434.2 +027600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2434.2 +027700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2434.2 +027800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2434.2 +027900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2434.2 +028000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2434.2 +028100 MOVE SPACE TO CORRECT-X. NC2434.2 +028200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2434.2 +028300 MOVE SPACE TO RE-MARK. NC2434.2 +028400 HEAD-ROUTINE. NC2434.2 +028500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +028600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +028700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2434.2 +028800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2434.2 +028900 COLUMN-NAMES-ROUTINE. NC2434.2 +029000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +029100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +029300 END-ROUTINE. NC2434.2 +029400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2434.2 +029500 END-RTN-EXIT. NC2434.2 +029600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +029700 END-ROUTINE-1. NC2434.2 +029800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2434.2 +029900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2434.2 +030000 ADD PASS-COUNTER TO ERROR-HOLD. NC2434.2 +030100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2434.2 +030200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2434.2 +030300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2434.2 +030400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2434.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2434.2 +030600 END-ROUTINE-12. NC2434.2 +030700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2434.2 +030800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2434.2 +030900 MOVE "NO " TO ERROR-TOTAL NC2434.2 +031000 ELSE NC2434.2 +031100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2434.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2434.2 +031300 PERFORM WRITE-LINE. NC2434.2 +031400 END-ROUTINE-13. NC2434.2 +031500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2434.2 +031600 MOVE "NO " TO ERROR-TOTAL ELSE NC2434.2 +031700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2434.2 +031800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2434.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +032000 IF INSPECT-COUNTER EQUAL TO ZERO NC2434.2 +032100 MOVE "NO " TO ERROR-TOTAL NC2434.2 +032200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2434.2 +032300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2434.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +032500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2434.2 +032600 WRITE-LINE. NC2434.2 +032700 ADD 1 TO RECORD-COUNT. NC2434.2 +032800 IF RECORD-COUNT GREATER 50 NC2434.2 +032900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2434.2 +033000 MOVE SPACE TO DUMMY-RECORD NC2434.2 +033100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2434.2 +033200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2434.2 +033300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2434.2 +033400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2434.2 +033500 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2434.2 +033600 MOVE ZERO TO RECORD-COUNT. NC2434.2 +033700 PERFORM WRT-LN. NC2434.2 +033800 WRT-LN. NC2434.2 +033900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2434.2 +034000 MOVE SPACE TO DUMMY-RECORD. NC2434.2 +034100 BLANK-LINE-PRINT. NC2434.2 +034200 PERFORM WRT-LN. NC2434.2 +034300 FAIL-ROUTINE. NC2434.2 +034400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2434.2 +034500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2434.2 +034600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2434.2 +034700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2434.2 +034800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +034900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2434.2 +035000 GO TO FAIL-ROUTINE-EX. NC2434.2 +035100 FAIL-ROUTINE-WRITE. NC2434.2 +035200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2434.2 +035300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2434.2 +035400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2434.2 +035500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2434.2 +035600 FAIL-ROUTINE-EX. EXIT. NC2434.2 +035700 BAIL-OUT. NC2434.2 +035800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2434.2 +035900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2434.2 +036000 BAIL-OUT-WRITE. NC2434.2 +036100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2434.2 +036200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2434.2 +036300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2434.2 +036400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2434.2 +036500 BAIL-OUT-EX. EXIT. NC2434.2 +036600 CCVS1-EXIT. NC2434.2 +036700 EXIT. NC2434.2 +036800 SECT-NC243A-001 SECTION. NC2434.2 +036900 TH-17-001. NC2434.2 +037000 NC2434.2 +037100 BUILD-LEVEL-1. NC2434.2 +037200 ADD 1 TO SUB-1. NC2434.2 +037300 IF SUB-1 = 11 GO TO CHECK-ENTRIES. NC2434.2 +037400 MOVE GRP-NAME TO ENTRY-1 (SUB-1). NC2434.2 +037500 ADD 1 TO ADD-GRP. NC2434.2 +037600 NC2434.2 +037700 BUILD-LEVEL-2. NC2434.2 +037800 ADD 1 TO SUB-2. NC2434.2 +037900 IF SUB-2 = 11 NC2434.2 +038000 MOVE ZERO TO SUB-2 NC2434.2 +038100 MOVE 01 TO ADD-SEC NC2434.2 +038200 GO TO BUILD-LEVEL-1. NC2434.2 +038300 MOVE SUB-1 TO SEC-GRP. NC2434.2 +038400 MOVE SEC-NAME TO ENTRY-2 (SUB-1, SUB-2). NC2434.2 +038500 ADD 1 TO ADD-SEC. NC2434.2 +038600 NC2434.2 +038700 BUILD-LEVEL-3. NC2434.2 +038800 ADD 1 TO SUB-3. NC2434.2 +038900 IF SUB-3 = 11 NC2434.2 +039000 MOVE ZERO TO SUB-3 NC2434.2 +039100 MOVE 01 TO ADD-ELEM NC2434.2 +039200 GO TO BUILD-LEVEL-2. NC2434.2 +039300 MOVE SUB-1 TO ELEM-GRP. NC2434.2 +039400 MOVE SUB-2 TO ELEM-SEC. NC2434.2 +039500 MOVE ELEM-NAME TO ENTRY-3 (SUB-1, SUB-2, SUB-3). NC2434.2 +039600 ADD 1 TO ADD-ELEM. NC2434.2 +039700 GO TO BUILD-LEVEL-3. NC2434.2 +039800 NC2434.2 +039900 CHECK-ENTRIES. NC2434.2 +040000 MOVE "PERFORM VARYING LEV1" TO FEATURE. NC2434.2 +040100 MOVE "CHECK-ENTRIES " TO PAR-NAME. NC2434.2 +040200 MOVE SPACES TO TEST-CHECK. NC2434.2 +040300 MOVE "GRP05" TO GRP-HOLD-AREA. NC2434.2 +040400 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +040500 UNTIL IDX-1 GREATER 10. NC2434.2 +040600 IF TEST-CHECK = "PASS" GO TO LEVEL-1-TEST-2. NC2434.2 +040700 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2434.2 +040800 MOVE ENTRY-1 (05) TO COMPUTED-A. NC2434.2 +040900 NC2434.2 +041000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +041100 PERFORM FAIL-TH. NC2434.2 +041200 NC2434.2 +041300 LEVEL-1-TEST-2. NC2434.2 +041400 MOVE "GRP10" TO GRP-HOLD-AREA. NC2434.2 +041500 MOVE "LEVEL-1-TEST-2 " TO PAR-NAME. NC2434.2 +041600 MOVE SPACES TO TEST-CHECK. NC2434.2 +041700 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +041800 UNTIL IDX-1 GREATER 10. NC2434.2 +041900 IF TEST-CHECK = "PASS" GO TO LEVEL-1-TEST-3. NC2434.2 +042000 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2434.2 +042100 MOVE ENTRY-1 (10) TO COMPUTED-A. NC2434.2 +042200 NC2434.2 +042300 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +042400 PERFORM FAIL-TH. NC2434.2 +042500 NC2434.2 +042600 LEVEL-1-TEST-3. NC2434.2 +042700 MOVE "GRP07" TO GRP-HOLD-AREA. NC2434.2 +042800 MOVE "LEVEL-1-TEST-3 " TO PAR-NAME. NC2434.2 +042900 MOVE SPACES TO TEST-CHECK. NC2434.2 +043000 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +043100 UNTIL IDX-1 GREATER 10. NC2434.2 +043200 IF TEST-CHECK = "PASS" GO TO LEVEL-1-TEST-4. NC2434.2 +043300 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2434.2 +043400 MOVE ENTRY-1 (07) TO COMPUTED-A. NC2434.2 +043500 NC2434.2 +043600 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +043700 PERFORM FAIL-TH. NC2434.2 +043800 LEVEL-1-TEST-4. NC2434.2 +043900 MOVE "LEVEL-1-TEST-4 " TO PAR-NAME. NC2434.2 +044000 MOVE "GRP01" TO GRP-HOLD-AREA. NC2434.2 +044100 PERFORM FIND-LEVEL-1-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +044200 UNTIL IDX-1 GREATER 10. NC2434.2 +044300 IF TEST-CHECK = "PASS" GO TO LEVEL-2-TEST-1. NC2434.2 +044400 MOVE GRP-HOLD-AREA TO CORRECT-A. NC2434.2 +044500 MOVE ENTRY-1 (01) TO COMPUTED-A. NC2434.2 +044600 NC2434.2 +044700 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +044800 PERFORM FAIL-TH. NC2434.2 +044900 GO TO LEVEL-2-TEST-1. NC2434.2 +045000 NC2434.2 +045100 FIND-LEVEL-1-ENTRY. NC2434.2 +045200 IF ENTRY-1 (IDX-1) = GRP-HOLD-AREA NC2434.2 +045300 MOVE "PASS" TO TEST-CHECK NC2434.2 +045400 PERFORM PASS-TH. NC2434.2 +045500 NC2434.2 +045600 LEVEL-2-TEST-1. NC2434.2 +045700 MOVE "LEVEL-2-TEST-1 " TO PAR-NAME. NC2434.2 +045800 MOVE "PERFORM VARYING LEV2" TO FEATURE. NC2434.2 +045900 MOVE "SEC (03,05)" TO SEC-HOLD-AREA. NC2434.2 +046000 MOVE SPACES TO TEST-CHECK. NC2434.2 +046100 PERFORM FIND-LEVEL-2-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +046200 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 UNTIL NC2434.2 +046300 IDX-2 = 10. NC2434.2 +046400 IF TEST-CHECK = "PASS" GO TO LEVEL-2-TEST-2. NC2434.2 +046500 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2434.2 +046600 MOVE ENTRY-2 (03, 05) TO COMPUTED-A. NC2434.2 +046700 NC2434.2 +046800 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +046900 PERFORM FAIL-TH. NC2434.2 +047000 NC2434.2 +047100 LEVEL-2-TEST-2. NC2434.2 +047200 MOVE "LEVEL-2-TEST-2 " TO PAR-NAME. NC2434.2 +047300 MOVE SPACES TO TEST-CHECK. NC2434.2 +047400 MOVE "SEC (01,01)" TO SEC-HOLD-AREA. NC2434.2 +047500 PERFORM FIND-LEVEL-2-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +047600 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 NC2434.2 +047700 UNTIL IDX-2 = 10. NC2434.2 +047800 IF TEST-CHECK = "PASS" GO TO LEVEL-2-TEST-3. NC2434.2 +047900 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2434.2 +048000 MOVE ENTRY-2 (01, 01) TO COMPUTED-A. NC2434.2 +048100 NC2434.2 +048200 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +048300 PERFORM FAIL-TH. NC2434.2 +048400 NC2434.2 +048500 LEVEL-2-TEST-3. NC2434.2 +048600 MOVE "LEVEL-2-TEST-3 " TO PAR-NAME. NC2434.2 +048700 MOVE SPACES TO TEST-CHECK. NC2434.2 +048800 MOVE "SEC (10,01)" TO SEC-HOLD-AREA. NC2434.2 +048900 PERFORM FIND-LEVEL-2-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +049000 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 NC2434.2 +049100 UNTIL IDX-2 = 10. NC2434.2 +049200 IF TEST-CHECK = "PASS" GO TO LEVEL-2-TEST-4. NC2434.2 +049300 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2434.2 +049400 MOVE ENTRY-2 (10, 01) TO COMPUTED-A. NC2434.2 +049500 NC2434.2 +049600 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +049700 PERFORM FAIL-TH. NC2434.2 +049800 LEVEL-2-TEST-4. NC2434.2 +049900 MOVE "LEVEL-2-TEST-4 " TO PAR-NAME. NC2434.2 +050000 MOVE SPACES TO TEST-CHECK. NC2434.2 +050100 MOVE SPACES TO TEST-CHECK. NC2434.2 +050200 MOVE "SEC (10,10)" TO SEC-HOLD-AREA. NC2434.2 +050300 PERFORM FIND-LEVEL-2-ENTRY VARYING IDX-1 FROM 2 BY 2 NC2434.2 +050400 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 2 BY 2 NC2434.2 +050500 UNTIL IDX-2 GREATER 10. NC2434.2 +050600 IF TEST-CHECK = "PASS" GO TO LEVEL-3-TEST-1. NC2434.2 +050700 MOVE SEC-HOLD-AREA TO CORRECT-A. NC2434.2 +050800 MOVE ENTRY-2 (10, 10) TO COMPUTED-A. NC2434.2 +050900 NC2434.2 +051000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +051100 PERFORM FAIL-TH. NC2434.2 +051200 GO TO LEVEL-3-TEST-1. NC2434.2 +051300 FIND-LEVEL-2-ENTRY. NC2434.2 +051400 IF ENTRY-2 (IDX-1, IDX-2) = SEC-HOLD-AREA NC2434.2 +051500 MOVE "PASS" TO TEST-CHECK NC2434.2 +051600 PERFORM PASS-TH. NC2434.2 +051700 LEVEL-3-TEST-1. NC2434.2 +051800 MOVE "PERFORM VARYING LEV3" TO FEATURE. NC2434.2 +051900 MOVE SPACES TO TEST-CHECK. NC2434.2 +052000 MOVE "LEVEL-3-TEST-1 " TO PAR-NAME. NC2434.2 +052100 MOVE "ELEM (01,02,03)" TO ELEM-HOLD-AREA. NC2434.2 +052200 PERFORM FIND-LEVEL-3-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +052300 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 UNTIL NC2434.2 +052400 IDX-2 = 10 AFTER IDX-3 FROM 1 BY 1 UNTIL NC2434.2 +052500 IDX-3 = 10. NC2434.2 +052600 IF TEST-CHECK = "PASS" GO TO LEVEL-3-TEST-2. NC2434.2 +052700 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2434.2 +052800 MOVE ENTRY-3 (01, 02, 03) TO COMPUTED-A. NC2434.2 +052900 NC2434.2 +053000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +053100 PERFORM FAIL-TH. NC2434.2 +053200 NC2434.2 +053300 LEVEL-3-TEST-2. NC2434.2 +053400 MOVE "LEVEL-3-TEST-2 " TO PAR-NAME. NC2434.2 +053500 MOVE "ELEM (10,10,10)" TO ELEM-HOLD-AREA. NC2434.2 +053600 MOVE SPACES TO TEST-CHECK. NC2434.2 +053700 PERFORM FIND-LEVEL-3-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +053800 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 UNTIL NC2434.2 +053900 IDX-2 GREATER 10 AFTER IDX-3 FROM 1 BY 1 UNTIL NC2434.2 +054000 IDX-3 GREATER 10. NC2434.2 +054100 IF TEST-CHECK = "PASS" GO TO LEVEL-3-TEST-3. NC2434.2 +054200 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2434.2 +054300 MOVE ENTRY-3 (10, 10, 10) TO COMPUTED-A. NC2434.2 +054400 NC2434.2 +054500 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +054600 PERFORM FAIL-TH. NC2434.2 +054700 NC2434.2 +054800 LEVEL-3-TEST-3. NC2434.2 +054900 MOVE "LEVEL-3-TEST-3 " TO PAR-NAME. NC2434.2 +055000 MOVE "ELEM (08,07,06)" TO ELEM-HOLD-AREA. NC2434.2 +055100 MOVE SPACES TO TEST-CHECK. NC2434.2 +055200 PERFORM FIND-LEVEL-3-ENTRY VARYING IDX-1 FROM 1 BY 1 NC2434.2 +055300 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 1 BY 1 UNTIL NC2434.2 +055400 IDX-2 = 10 AFTER IDX-3 FROM 1 BY 1 UNTIL NC2434.2 +055500 IDX-3 = 10. NC2434.2 +055600 IF TEST-CHECK = "PASS" GO TO LEVEL-3-TEST-4. NC2434.2 +055700 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2434.2 +055800 MOVE ENTRY-3 (08, 07, 06) TO COMPUTED-A. NC2434.2 +055900 NC2434.2 +056000 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +056100 PERFORM FAIL-TH. NC2434.2 +056200 LEVEL-3-TEST-4. NC2434.2 +056300 MOVE "LEVEL-3-TEST-4 " TO PAR-NAME. NC2434.2 +056400 MOVE SPACES TO TEST-CHECK. NC2434.2 +056500 MOVE "ELEM (06,04,08)" TO ELEM-HOLD-AREA. NC2434.2 +056600 PERFORM FIND-LEVEL-3-ENTRY VARYING IDX-1 FROM 3 BY 3 NC2434.2 +056700 UNTIL IDX-1 GREATER 10 AFTER IDX-2 FROM 2 BY 2 UNTIL NC2434.2 +056800 IDX-2 GREATER 10 AFTER IDX-3 FROM 8 BY 8 UNTIL NC2434.2 +056900 IDX-3 GREATER 10. NC2434.2 +057000 IF TEST-CHECK = "PASS" GO TO END-3LEVEL-TEST. NC2434.2 +057100 MOVE ELEM-HOLD-AREA TO CORRECT-A. NC2434.2 +057200 MOVE ENTRY-3 (06, 04, 08) TO COMPUTED-A. NC2434.2 +057300 NC2434.2 +057400 MOVE "PERFORM VARYING USING INDEX" TO RE-MARK. NC2434.2 +057500 PERFORM FAIL-TH. NC2434.2 +057600 GO TO END-3LEVEL-TEST. NC2434.2 +057700 NC2434.2 +057800 FIND-LEVEL-3-ENTRY. NC2434.2 +057900 IF ENTRY-3 (IDX-1, IDX-2, IDX-3) = ELEM-HOLD-AREA NC2434.2 +058000 MOVE "PASS" TO TEST-CHECK NC2434.2 +058100 PERFORM PASS-TH. NC2434.2 +058200 NC2434.2 +058300 PASS-TH. NC2434.2 +058400 PERFORM PASS. NC2434.2 +058500 PERFORM PRINT-DETAIL. NC2434.2 +058600 FAIL-TH. NC2434.2 +058700 PERFORM FAIL. NC2434.2 +058800 PERFORM PRINT-DETAIL. NC2434.2 +058900 END-3LEVEL-TEST. NC2434.2 +059000 EXIT. NC2434.2 +059100* NC2434.2 +059200 TH7-INIT-1. NC2434.2 +059300 MOVE "TH7-TEST" TO PAR-NAME. NC2434.2 +059400 MOVE "VI-2 1.3.4" TO ANSI-REFERENCE. NC2434.2 +059500 MOVE ALL "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO 7-DIMENSION-TBL. NC2434.2 +059600 MOVE "KL" TO L4-HOLD. NC2434.2 +059700 MOVE "AB" TO L5-HOLD. NC2434.2 +059800 MOVE "CD" TO L6-HOLD. NC2434.2 +059900 MOVE "GH" TO L7-HOLD. NC2434.2 +060000 MOVE SPACES TO WS-FLAG. NC2434.2 +060100 MOVE 1 TO REC-CT. NC2434.2 +060200 GO TO TH7-TEST-1-0. NC2434.2 +060300 TH7-DELETE-1. NC2434.2 +060400 PERFORM DE-LETE. NC2434.2 +060500 PERFORM PRINT-DETAIL. NC2434.2 +060600 GO TO CCVS-EXIT. NC2434.2 +060700 TH7-TEST-1-0. NC2434.2 +060800 PERFORM TH7-FIND-LEVEL-4-ENTRY NC2434.2 +060900 VARYING X1 FROM 1 BY 1 UNTIL X1 > 2 NC2434.2 +061000 AFTER X2 FROM 1 BY 1 UNTIL X2 > 2 NC2434.2 +061100 AFTER X3 FROM 1 BY 1 UNTIL X3 > 2 NC2434.2 +061200 AFTER X4 FROM 1 BY 1 UNTIL X4 > 2. NC2434.2 +061300 GO TO TH7-TEST-1-1. NC2434.2 +061400 TH7-FIND-LEVEL-4-ENTRY. NC2434.2 +061500 IF ENTRY-7-4 (X1 X2 X3 X4) = L4-HOLD NC2434.2 +061600 MOVE "FOUND" TO WS-FLAG. NC2434.2 +061700 TH7-TEST-1-1. NC2434.2 +061800 IF WS-FLAG = "FOUND" NC2434.2 +061900 PERFORM PASS NC2434.2 +062000 PERFORM PRINT-DETAIL NC2434.2 +062100 ELSE NC2434.2 +062200 MOVE "TABLE NOT CORRECT AT 4TH LEVEL" TO RE-MARK NC2434.2 +062300 MOVE ENTRY-7-4 (X1 X2 X3 X4) TO COMPUTED-X NC2434.2 +062400 MOVE L4-HOLD TO CORRECT-X NC2434.2 +062500 PERFORM FAIL NC2434.2 +062600 PERFORM PRINT-DETAIL. NC2434.2 +062700 MOVE SPACES TO WS-FLAG. NC2434.2 +062800 ADD 1 TO REC-CT. NC2434.2 +062900 TH7-TEST-2-0. NC2434.2 +063000 PERFORM TH7-FIND-LEVEL-5-ENTRY NC2434.2 +063100 VARYING X1 FROM 1 BY 1 UNTIL X1 > 2 NC2434.2 +063200 AFTER X2 FROM 1 BY 1 UNTIL X2 > 2 NC2434.2 +063300 AFTER X3 FROM 1 BY 1 UNTIL X3 > 2 NC2434.2 +063400 AFTER X4 FROM 1 BY 1 UNTIL X4 > 2 NC2434.2 +063500 AFTER X5 FROM 1 BY 1 UNTIL X5 > 2. NC2434.2 +063600 GO TO TH7-TEST-2-1. NC2434.2 +063700 TH7-FIND-LEVEL-5-ENTRY. NC2434.2 +063800 IF ENTRY-7-5 (X1 X2 X3 X4 X5) = L5-HOLD NC2434.2 +063900 MOVE "FOUND" TO WS-FLAG. NC2434.2 +064000 TH7-TEST-2-1. NC2434.2 +064100 IF WS-FLAG = "FOUND" NC2434.2 +064200 PERFORM PASS NC2434.2 +064300 PERFORM PRINT-DETAIL NC2434.2 +064400 ELSE NC2434.2 +064500 MOVE "TABLE NOT CORRECT AT 5TH LEVEL" TO RE-MARK NC2434.2 +064600 MOVE ENTRY-7-5 (X1 X2 X3 X4 X5) TO COMPUTED-X NC2434.2 +064700 MOVE L5-HOLD TO CORRECT-X NC2434.2 +064800 PERFORM FAIL NC2434.2 +064900 PERFORM PRINT-DETAIL. NC2434.2 +065000 MOVE SPACES TO WS-FLAG. NC2434.2 +065100 ADD 1 TO REC-CT. NC2434.2 +065200 TH7-TEST-3-0. NC2434.2 +065300 PERFORM TH7-FIND-LEVEL-6-ENTRY NC2434.2 +065400 VARYING X1 FROM 1 BY 1 UNTIL X1 > 2 NC2434.2 +065500 AFTER X2 FROM 1 BY 1 UNTIL X2 > 2 NC2434.2 +065600 AFTER X3 FROM 1 BY 1 UNTIL X3 > 2 NC2434.2 +065700 AFTER X4 FROM 1 BY 1 UNTIL X4 > 2 NC2434.2 +065800 AFTER X5 FROM 1 BY 1 UNTIL X5 > 2 NC2434.2 +065900 AFTER X6 FROM 1 BY 1 UNTIL X6 > 2. NC2434.2 +066000 GO TO TH7-TEST-3-1. NC2434.2 +066100 TH7-FIND-LEVEL-6-ENTRY. NC2434.2 +066200 IF ENTRY-7-6 (X1 X2 X3 X4 X5 X6) = L6-HOLD NC2434.2 +066300 MOVE "FOUND" TO WS-FLAG. NC2434.2 +066400 TH7-TEST-3-1. NC2434.2 +066500 IF WS-FLAG = "FOUND" NC2434.2 +066600 PERFORM PASS NC2434.2 +066700 PERFORM PRINT-DETAIL NC2434.2 +066800 ELSE NC2434.2 +066900 MOVE "TABLE NOT CORRECT AT 6TH LEVEL" TO RE-MARK NC2434.2 +067000 MOVE ENTRY-7-6 (X1 X2 X3 X4 X5 X6) TO COMPUTED-X NC2434.2 +067100 MOVE L6-HOLD TO CORRECT-X NC2434.2 +067200 PERFORM FAIL NC2434.2 +067300 PERFORM PRINT-DETAIL. NC2434.2 +067400 MOVE SPACES TO WS-FLAG. NC2434.2 +067500 ADD 1 TO REC-CT. NC2434.2 +067600 TH7-TEST-4-0. NC2434.2 +067700 PERFORM TH7-FIND-LEVEL-7-ENTRY NC2434.2 +067800 VARYING X1 FROM 1 BY 1 UNTIL X1 > 2 NC2434.2 +067900 AFTER X2 FROM 1 BY 1 UNTIL X2 > 2 NC2434.2 +068000 AFTER X3 FROM 1 BY 1 UNTIL X3 > 2 NC2434.2 +068100 AFTER X4 FROM 1 BY 1 UNTIL X4 > 2 NC2434.2 +068200 AFTER X5 FROM 1 BY 1 UNTIL X5 > 2 NC2434.2 +068300 AFTER X6 FROM 1 BY 1 UNTIL X6 > 2 NC2434.2 +068400 AFTER X7 FROM 1 BY 1 UNTIL X7 > 2. NC2434.2 +068500 GO TO TH7-TEST-4-1. NC2434.2 +068600 TH7-FIND-LEVEL-7-ENTRY. NC2434.2 +068700 IF ENTRY-7-7 (X1 X2 X3 X4 X5 X6 X7) = L7-HOLD NC2434.2 +068800 MOVE "FOUND" TO WS-FLAG. NC2434.2 +068900 TH7-TEST-4-1. NC2434.2 +069000 IF WS-FLAG = "FOUND" NC2434.2 +069100 PERFORM PASS NC2434.2 +069200 PERFORM PRINT-DETAIL NC2434.2 +069300 ELSE NC2434.2 +069400 MOVE "TABLE NOT CORRECT AT 6TH LEVEL" TO RE-MARK NC2434.2 +069500 MOVE ENTRY-7-7 (X1 X2 X3 X4 X5 X6 X7) TO COMPUTED-X NC2434.2 +069600 MOVE L7-HOLD TO CORRECT-X NC2434.2 +069700 PERFORM FAIL NC2434.2 +069800 PERFORM PRINT-DETAIL. NC2434.2 +069900* NC2434.2 +070000 CCVS-EXIT SECTION. NC2434.2 +070100 CCVS-999999. NC2434.2 +070200 GO TO CLOSE-FILES. NC2434.2 diff --git a/tests/cobol85/NC/NC244A.CBL b/tests/cobol85/NC/NC244A.CBL new file mode 100755 index 00000000..f0ae7dc9 --- /dev/null +++ b/tests/cobol85/NC/NC244A.CBL @@ -0,0 +1,511 @@ +000100 IDENTIFICATION DIVISION. NC2444.2 +000200 PROGRAM-ID. NC2444.2 +000300 NC244A. NC2444.2 +000400**************************************************************** NC2444.2 +000500* * NC2444.2 +000600* VALIDATION FOR:- * NC2444.2 +000700* * NC2444.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2444.2 +000900* * NC2444.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2444.2 +001100* * NC2444.2 +001200**************************************************************** NC2444.2 +001300* * NC2444.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2444.2 +001500* * NC2444.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2444.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2444.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2444.2 +001900* * NC2444.2 +002000**************************************************************** NC2444.2 +002100* * NC2444.2 +002200* PROGRAM NCC244A TESTS THE CONSTRUCTION AND ACCESS OF A * NC2444.2 +002300* TWO-DIMENSIONAL TABLE WHICH HAS MULTIPLE INDICES. * NC2444.2 +002400* RELATIVE INDEXING AND FORMATS 1 AND 2 OF THE "SET" * NC2444.2 +002500* STATEMENT ARE USED. * NC2444.2 +002600* * NC2444.2 +002700**************************************************************** NC2444.2 +002800 ENVIRONMENT DIVISION. NC2444.2 +002900 CONFIGURATION SECTION. NC2444.2 +003000 SOURCE-COMPUTER. NC2444.2 +003100 Linux. NC2444.2 +003200 OBJECT-COMPUTER. NC2444.2 +003300 Linux. NC2444.2 +003400 INPUT-OUTPUT SECTION. NC2444.2 +003500 FILE-CONTROL. NC2444.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2444.2 +003700 "report.log". NC2444.2 +003800 DATA DIVISION. NC2444.2 +003900 FILE SECTION. NC2444.2 +004000 FD PRINT-FILE. NC2444.2 +004100 01 PRINT-REC PICTURE X(120). NC2444.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2444.2 +004300 WORKING-STORAGE SECTION. NC2444.2 +004400 77 SUB-COMP1 PICTURE S9 VALUE 3 COMPUTATIONAL. NC2444.2 +004500 77 SUB-COMP2 PICTURE S9(10) VALUE 1 COMPUTATIONAL. NC2444.2 +004600 77 SUB-COMP3 PICTURE S9(18) VALUE 49 COMPUTATIONAL. NC2444.2 +004700 77 SUB-COMP4 PICTURE 9 VALUE 3 COMPUTATIONAL. NC2444.2 +004800 77 SUB-COMP5 PICTURE 9(10) VALUE 1 COMPUTATIONAL. NC2444.2 +004900 77 SUB-COMP6 PICTURE 9(18) VALUE 9 COMPUTATIONAL. NC2444.2 +005000 77 SUB-7 PICTURE 99 VALUE 20. NC2444.2 +005100 77 SUB-8 PICTURE 99 VALUE 01. NC2444.2 +005200 77 SUB-9 PICTURE 99 VALUE 10. NC2444.2 +005300 77 IN-SERT PICTURE AA VALUE "AA". NC2444.2 +005400 77 ENTRY-HOLD PICTURE XX VALUE SPACES. NC2444.2 +005500 01 IDX-HOLD. NC2444.2 +005600 02 IDX-3HOLD PICTURE 9(6) VALUE 0. NC2444.2 +005700 02 FILLER PICTURE X(8) VALUE SPACES. NC2444.2 +005800 02 IDX-14HOLD PICTURE 9(6) VALUE 0. NC2444.2 +005900 01 TWO-DIMENSION-TABLE. NC2444.2 +006000 02 GRP-ENTRY OCCURS 50 INDEXED IDX-1 IDX-2 IDX-3 IDX-4 NC2444.2 +006100 IDX-5. NC2444.2 +006200 03 ENTRY-1 PICTURE 99. NC2444.2 +006300 03 ELEM-ENTRY OCCURS 10 TIMES INDEXED BY IDX-6 IDX-7 NC2444.2 +006400 IDX-8 IDX-9 IDX-10 IDX-11 IDX-12 IDX-13 IDX-14 NC2444.2 +006500 IDX-15. NC2444.2 +006600 04 ENTRY-2 PICTURE XX. NC2444.2 +006700 01 TEST-RESULTS. NC2444.2 +006800 02 FILLER PIC X VALUE SPACE. NC2444.2 +006900 02 FEATURE PIC X(20) VALUE SPACE. NC2444.2 +007000 02 FILLER PIC X VALUE SPACE. NC2444.2 +007100 02 P-OR-F PIC X(5) VALUE SPACE. NC2444.2 +007200 02 FILLER PIC X VALUE SPACE. NC2444.2 +007300 02 PAR-NAME. NC2444.2 +007400 03 FILLER PIC X(19) VALUE SPACE. NC2444.2 +007500 03 PARDOT-X PIC X VALUE SPACE. NC2444.2 +007600 03 DOTVALUE PIC 99 VALUE ZERO. NC2444.2 +007700 02 FILLER PIC X(8) VALUE SPACE. NC2444.2 +007800 02 RE-MARK PIC X(61). NC2444.2 +007900 01 TEST-COMPUTED. NC2444.2 +008000 02 FILLER PIC X(30) VALUE SPACE. NC2444.2 +008100 02 FILLER PIC X(17) VALUE NC2444.2 +008200 " COMPUTED=". NC2444.2 +008300 02 COMPUTED-X. NC2444.2 +008400 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2444.2 +008500 03 COMPUTED-N REDEFINES COMPUTED-A NC2444.2 +008600 PIC -9(9).9(9). NC2444.2 +008700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2444.2 +008800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2444.2 +008900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2444.2 +009000 03 CM-18V0 REDEFINES COMPUTED-A. NC2444.2 +009100 04 COMPUTED-18V0 PIC -9(18). NC2444.2 +009200 04 FILLER PIC X. NC2444.2 +009300 03 FILLER PIC X(50) VALUE SPACE. NC2444.2 +009400 01 TEST-CORRECT. NC2444.2 +009500 02 FILLER PIC X(30) VALUE SPACE. NC2444.2 +009600 02 FILLER PIC X(17) VALUE " CORRECT =". NC2444.2 +009700 02 CORRECT-X. NC2444.2 +009800 03 CORRECT-A PIC X(20) VALUE SPACE. NC2444.2 +009900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2444.2 +010000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2444.2 +010100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2444.2 +010200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2444.2 +010300 03 CR-18V0 REDEFINES CORRECT-A. NC2444.2 +010400 04 CORRECT-18V0 PIC -9(18). NC2444.2 +010500 04 FILLER PIC X. NC2444.2 +010600 03 FILLER PIC X(2) VALUE SPACE. NC2444.2 +010700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2444.2 +010800 01 CCVS-C-1. NC2444.2 +010900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2444.2 +011000- "SS PARAGRAPH-NAME NC2444.2 +011100- " REMARKS". NC2444.2 +011200 02 FILLER PIC X(20) VALUE SPACE. NC2444.2 +011300 01 CCVS-C-2. NC2444.2 +011400 02 FILLER PIC X VALUE SPACE. NC2444.2 +011500 02 FILLER PIC X(6) VALUE "TESTED". NC2444.2 +011600 02 FILLER PIC X(15) VALUE SPACE. NC2444.2 +011700 02 FILLER PIC X(4) VALUE "FAIL". NC2444.2 +011800 02 FILLER PIC X(94) VALUE SPACE. NC2444.2 +011900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2444.2 +012000 01 REC-CT PIC 99 VALUE ZERO. NC2444.2 +012100 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2444.2 +012200 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2444.2 +012300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2444.2 +012400 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2444.2 +012500 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2444.2 +012600 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2444.2 +012700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2444.2 +012800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2444.2 +012900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2444.2 +013000 01 CCVS-H-1. NC2444.2 +013100 02 FILLER PIC X(39) VALUE SPACES. NC2444.2 +013200 02 FILLER PIC X(42) VALUE NC2444.2 +013300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2444.2 +013400 02 FILLER PIC X(39) VALUE SPACES. NC2444.2 +013500 01 CCVS-H-2A. NC2444.2 +013600 02 FILLER PIC X(40) VALUE SPACE. NC2444.2 +013700 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2444.2 +013800 02 FILLER PIC XXXX VALUE NC2444.2 +013900 "4.2 ". NC2444.2 +014000 02 FILLER PIC X(28) VALUE NC2444.2 +014100 " COPY - NOT FOR DISTRIBUTION". NC2444.2 +014200 02 FILLER PIC X(41) VALUE SPACE. NC2444.2 +014300 NC2444.2 +014400 01 CCVS-H-2B. NC2444.2 +014500 02 FILLER PIC X(15) VALUE NC2444.2 +014600 "TEST RESULT OF ". NC2444.2 +014700 02 TEST-ID PIC X(9). NC2444.2 +014800 02 FILLER PIC X(4) VALUE NC2444.2 +014900 " IN ". NC2444.2 +015000 02 FILLER PIC X(12) VALUE NC2444.2 +015100 " HIGH ". NC2444.2 +015200 02 FILLER PIC X(22) VALUE NC2444.2 +015300 " LEVEL VALIDATION FOR ". NC2444.2 +015400 02 FILLER PIC X(58) VALUE NC2444.2 +015500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2444.2 +015600 01 CCVS-H-3. NC2444.2 +015700 02 FILLER PIC X(34) VALUE NC2444.2 +015800 " FOR OFFICIAL USE ONLY ". NC2444.2 +015900 02 FILLER PIC X(58) VALUE NC2444.2 +016000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2444.2 +016100 02 FILLER PIC X(28) VALUE NC2444.2 +016200 " COPYRIGHT 1985 ". NC2444.2 +016300 01 CCVS-E-1. NC2444.2 +016400 02 FILLER PIC X(52) VALUE SPACE. NC2444.2 +016500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2444.2 +016600 02 ID-AGAIN PIC X(9). NC2444.2 +016700 02 FILLER PIC X(45) VALUE SPACES. NC2444.2 +016800 01 CCVS-E-2. NC2444.2 +016900 02 FILLER PIC X(31) VALUE SPACE. NC2444.2 +017000 02 FILLER PIC X(21) VALUE SPACE. NC2444.2 +017100 02 CCVS-E-2-2. NC2444.2 +017200 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2444.2 +017300 03 FILLER PIC X VALUE SPACE. NC2444.2 +017400 03 ENDER-DESC PIC X(44) VALUE NC2444.2 +017500 "ERRORS ENCOUNTERED". NC2444.2 +017600 01 CCVS-E-3. NC2444.2 +017700 02 FILLER PIC X(22) VALUE NC2444.2 +017800 " FOR OFFICIAL USE ONLY". NC2444.2 +017900 02 FILLER PIC X(12) VALUE SPACE. NC2444.2 +018000 02 FILLER PIC X(58) VALUE NC2444.2 +018100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2444.2 +018200 02 FILLER PIC X(13) VALUE SPACE. NC2444.2 +018300 02 FILLER PIC X(15) VALUE NC2444.2 +018400 " COPYRIGHT 1985". NC2444.2 +018500 01 CCVS-E-4. NC2444.2 +018600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2444.2 +018700 02 FILLER PIC X(4) VALUE " OF ". NC2444.2 +018800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2444.2 +018900 02 FILLER PIC X(40) VALUE NC2444.2 +019000 " TESTS WERE EXECUTED SUCCESSFULLY". NC2444.2 +019100 01 XXINFO. NC2444.2 +019200 02 FILLER PIC X(19) VALUE NC2444.2 +019300 "*** INFORMATION ***". NC2444.2 +019400 02 INFO-TEXT. NC2444.2 +019500 04 FILLER PIC X(8) VALUE SPACE. NC2444.2 +019600 04 XXCOMPUTED PIC X(20). NC2444.2 +019700 04 FILLER PIC X(5) VALUE SPACE. NC2444.2 +019800 04 XXCORRECT PIC X(20). NC2444.2 +019900 02 INF-ANSI-REFERENCE PIC X(48). NC2444.2 +020000 01 HYPHEN-LINE. NC2444.2 +020100 02 FILLER PIC IS X VALUE IS SPACE. NC2444.2 +020200 02 FILLER PIC IS X(65) VALUE IS "************************NC2444.2 +020300- "*****************************************". NC2444.2 +020400 02 FILLER PIC IS X(54) VALUE IS "************************NC2444.2 +020500- "******************************". NC2444.2 +020600 01 CCVS-PGM-ID PIC X(9) VALUE NC2444.2 +020700 "NC244A". NC2444.2 +020800 PROCEDURE DIVISION. NC2444.2 +020900 CCVS1 SECTION. NC2444.2 +021000 OPEN-FILES. NC2444.2 +021100 OPEN OUTPUT PRINT-FILE. NC2444.2 +021200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2444.2 +021300 MOVE SPACE TO TEST-RESULTS. NC2444.2 +021400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2444.2 +021500 GO TO CCVS1-EXIT. NC2444.2 +021600 CLOSE-FILES. NC2444.2 +021700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2444.2 +021800 TERMINATE-CCVS. NC2444.2 +021900*S EXIT PROGRAM. NC2444.2 +022000*SERMINATE-CALL. NC2444.2 +022100 STOP RUN. NC2444.2 +022200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2444.2 +022300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2444.2 +022400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2444.2 +022500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2444.2 +022600 MOVE "****TEST DELETED****" TO RE-MARK. NC2444.2 +022700 PRINT-DETAIL. NC2444.2 +022800 IF REC-CT NOT EQUAL TO ZERO NC2444.2 +022900 MOVE "." TO PARDOT-X NC2444.2 +023000 MOVE REC-CT TO DOTVALUE. NC2444.2 +023100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2444.2 +023200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2444.2 +023300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2444.2 +023400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2444.2 +023500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2444.2 +023600 MOVE SPACE TO CORRECT-X. NC2444.2 +023700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2444.2 +023800 MOVE SPACE TO RE-MARK. NC2444.2 +023900 HEAD-ROUTINE. NC2444.2 +024000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +024100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +024200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2444.2 +024300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2444.2 +024400 COLUMN-NAMES-ROUTINE. NC2444.2 +024500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +024600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +024700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +024800 END-ROUTINE. NC2444.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2444.2 +025000 END-RTN-EXIT. NC2444.2 +025100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +025200 END-ROUTINE-1. NC2444.2 +025300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2444.2 +025400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2444.2 +025500 ADD PASS-COUNTER TO ERROR-HOLD. NC2444.2 +025600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2444.2 +025700 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2444.2 +025800 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2444.2 +025900 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2444.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2444.2 +026100 END-ROUTINE-12. NC2444.2 +026200 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2444.2 +026300 IF ERROR-COUNTER IS EQUAL TO ZERO NC2444.2 +026400 MOVE "NO " TO ERROR-TOTAL NC2444.2 +026500 ELSE NC2444.2 +026600 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2444.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2444.2 +026800 PERFORM WRITE-LINE. NC2444.2 +026900 END-ROUTINE-13. NC2444.2 +027000 IF DELETE-COUNTER IS EQUAL TO ZERO NC2444.2 +027100 MOVE "NO " TO ERROR-TOTAL ELSE NC2444.2 +027200 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2444.2 +027300 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2444.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +027500 IF INSPECT-COUNTER EQUAL TO ZERO NC2444.2 +027600 MOVE "NO " TO ERROR-TOTAL NC2444.2 +027700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2444.2 +027800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2444.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +028000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2444.2 +028100 WRITE-LINE. NC2444.2 +028200 ADD 1 TO RECORD-COUNT. NC2444.2 +028300 IF RECORD-COUNT GREATER 50 NC2444.2 +028400 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2444.2 +028500 MOVE SPACE TO DUMMY-RECORD NC2444.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2444.2 +028700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2444.2 +028800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2444.2 +028900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2444.2 +029000 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2444.2 +029100 MOVE ZERO TO RECORD-COUNT. NC2444.2 +029200 PERFORM WRT-LN. NC2444.2 +029300 WRT-LN. NC2444.2 +029400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2444.2 +029500 MOVE SPACE TO DUMMY-RECORD. NC2444.2 +029600 BLANK-LINE-PRINT. NC2444.2 +029700 PERFORM WRT-LN. NC2444.2 +029800 FAIL-ROUTINE. NC2444.2 +029900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2444.2 +030000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2444.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2444.2 +030200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2444.2 +030300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +030400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2444.2 +030500 GO TO FAIL-ROUTINE-EX. NC2444.2 +030600 FAIL-ROUTINE-WRITE. NC2444.2 +030700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2444.2 +030800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2444.2 +030900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2444.2 +031000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2444.2 +031100 FAIL-ROUTINE-EX. EXIT. NC2444.2 +031200 BAIL-OUT. NC2444.2 +031300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2444.2 +031400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2444.2 +031500 BAIL-OUT-WRITE. NC2444.2 +031600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2444.2 +031700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2444.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2444.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2444.2 +032000 BAIL-OUT-EX. EXIT. NC2444.2 +032100 CCVS1-EXIT. NC2444.2 +032200 EXIT. NC2444.2 +032300 SECT-NC244A-001 SECTION. NC2444.2 +032400 TH-18-001. NC2444.2 +032500 BUILD-2DEM-TABLE. NC2444.2 +032600 SET IDX-1 IDX-2 IDX-3 IDX-4 IDX-5 IDX-6 IDX-7 IDX-8 NC2444.2 +032700 IDX-9 IDX-10 TO 01. NC2444.2 +032800 SET IDX-11 IDX-12 IDX-13 IDX-14 IDX-15 TO 01. NC2444.2 +032900 BUILD-LEVEL-1. NC2444.2 +033000 SET ENTRY-1 (IDX-5) TO IDX-5. NC2444.2 +033100 IF IDX-5 EQUAL TO 6 MOVE "BB" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033200 IF IDX-5 EQUAL TO 11 MOVE "CC" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033300 IF IDX-5 EQUAL TO 16 MOVE "DD" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033400 IF IDX-5 EQUAL TO 21 MOVE "EE" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033500 IF IDX-5 EQUAL TO 26 MOVE "FF" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033600 IF IDX-5 EQUAL TO 31 MOVE "GG" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033700 IF IDX-5 EQUAL TO 36 MOVE "HH" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033800 IF IDX-5 EQUAL TO 41 MOVE "II" TO IN-SERT GO TO BUILD-ENTRY. NC2444.2 +033900 IF IDX-5 EQUAL TO 46 MOVE "JJ" TO IN-SERT. NC2444.2 +034000 BUILD-ENTRY. NC2444.2 +034100 MOVE IN-SERT TO ENTRY-2 (IDX-5, IDX-15). NC2444.2 +034200 IF IDX-15 EQUAL TO 10 AND IDX-5 EQUAL TO 50 NC2444.2 +034300 GO TO BUILD-EXIT. NC2444.2 +034400 IF IDX-15 EQUAL TO 10 NC2444.2 +034500 SET IDX-15 TO 01 NC2444.2 +034600 SET IDX-5 UP BY 1 NC2444.2 +034700 GO TO BUILD-LEVEL-1. NC2444.2 +034800 SET IDX-15 UP BY 01. NC2444.2 +034900 GO TO BUILD-ENTRY. NC2444.2 +035000 BUILD-EXIT. NC2444.2 +035100 EXIT. NC2444.2 +035200 TABLE-CHECKING SECTION. NC2444.2 +035300* NC2444.2 +035400 IDX-INIT-F1-1. NC2444.2 +035500 MOVE "IDX-TEST-F1-1" TO PAR-NAME. NC2444.2 +035600 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +035700 MOVE "RELATIVE INDEXING " TO FEATURE. NC2444.2 +035800 IDX-TEST-F1-1. NC2444.2 +035900 SET IDX-4 IDX-14 TO SUB-COMP2. NC2444.2 +036000 IF ENTRY-2 (IDX-4 + 49, IDX-14 + 9) EQUAL TO "JJ" NC2444.2 +036100 PERFORM PASS NC2444.2 +036200 GO TO IDX-WRITE-F1-1 NC2444.2 +036300 ELSE NC2444.2 +036400 GO TO IDX-FAIL-F1-1. NC2444.2 +036500 IDX-DELETE-F1-1. NC2444.2 +036600 PERFORM DE-LETE. NC2444.2 +036700 GO TO IDX-WRITE-F1-1. NC2444.2 +036800 IDX-FAIL-F1-1. NC2444.2 +036900 MOVE ENTRY-2 (IDX-4 + 49, IDX-14 + 9) TO COMPUTED-A. NC2444.2 +037000 MOVE "JJ" TO CORRECT-A. NC2444.2 +037100 PERFORM FAIL. NC2444.2 +037200 IDX-WRITE-F1-1. NC2444.2 +037300 PERFORM PRINT-DETAIL. NC2444.2 +037400* NC2444.2 +037500 IDX-INIT-F2-2. NC2444.2 +037600 MOVE "IDX-TEST-F2-2" TO PAR-NAME. NC2444.2 +037700 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +037800 MOVE "SET DN BY COMP ITEM " TO FEATURE. NC2444.2 +037900 IDX-TEST-F2-2. NC2444.2 +038000 SET IDX-3 TO SUB-COMP3. NC2444.2 +038100 SET IDX-3 DOWN BY SUB-7. NC2444.2 +038200 IF ENTRY-1 (IDX-3) EQUAL TO 29 NC2444.2 +038300 PERFORM PASS NC2444.2 +038400 GO TO IDX-WRITE-F2-2 NC2444.2 +038500 ELSE NC2444.2 +038600 GO TO IDX-FAIL-F2-2. NC2444.2 +038700 IDX-DELETE-F2-2. NC2444.2 +038800 PERFORM DE-LETE. NC2444.2 +038900 GO TO IDX-WRITE-F2-2. NC2444.2 +039000 IDX-FAIL-F2-2. NC2444.2 +039100 MOVE ENTRY-1 (IDX-3) TO COMPUTED-N. NC2444.2 +039200 MOVE 29 TO CORRECT-N. NC2444.2 +039300 PERFORM FAIL. NC2444.2 +039400 IDX-WRITE-F2-2. NC2444.2 +039500 PERFORM PRINT-DETAIL. NC2444.2 +039600* NC2444.2 +039700 IDX-INIT-F2-3. NC2444.2 +039800 MOVE "IDX-TEST-F2-3" TO PAR-NAME. NC2444.2 +039900 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +040000 MOVE "SET UP BY COMP ITEM " TO FEATURE. NC2444.2 +040100 IDX-TEST-F2-3. NC2444.2 +040200 SET IDX-2 TO SUB-COMP6. NC2444.2 +040300 SET IDX-2 UP BY SUB-COMP1. NC2444.2 +040400 IF ENTRY-1 (IDX-2) EQUAL TO 12 NC2444.2 +040500 PERFORM PASS NC2444.2 +040600 GO TO IDX-WRITE-F2-3 NC2444.2 +040700 ELSE NC2444.2 +040800 GO TO IDX-FAIL-F2-3. NC2444.2 +040900 IDX-DELETE-F2-3. NC2444.2 +041000 PERFORM DE-LETE. NC2444.2 +041100 GO TO IDX-WRITE-F2-3. NC2444.2 +041200 IDX-FAIL-F2-3. NC2444.2 +041300 MOVE ENTRY-1 (IDX-2) TO COMPUTED-N. NC2444.2 +041400 MOVE 12 TO CORRECT-N. NC2444.2 +041500 PERFORM FAIL. NC2444.2 +041600 IDX-WRITE-F2-3. NC2444.2 +041700 PERFORM PRINT-DETAIL. NC2444.2 +041800* NC2444.2 +041900 IDX-INIT-F2-4. NC2444.2 +042000 MOVE "IDX-TEST-F2-4" TO PAR-NAME. NC2444.2 +042100 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +042200 MOVE "MULT OPERND SET STMT" TO FEATURE. NC2444.2 +042300 GO TO IDX-TEST-F2-4. NC2444.2 +042400 TEST-4. NC2444.2 +042500 SET IDX-1 IDX-6 DOWN BY SUB-COMP5. NC2444.2 +042600 MOVE ENTRY-2 (IDX-1, IDX-6) TO ENTRY-HOLD. NC2444.2 +042700 TEST-4EXIT. NC2444.2 +042800 EXIT. NC2444.2 +042900 IDX-TEST-F2-4. NC2444.2 +043000 SET IDX-1 TO SUB-COMP3. NC2444.2 +043100 SET IDX-6 TO SUB-9. NC2444.2 +043200 PERFORM TEST-4 THRU TEST-4EXIT UNTIL NC2444.2 +043300 ENTRY-2 (IDX-1, IDX-6) EQUAL TO "II". NC2444.2 +043400 IF ENTRY-HOLD EQUAL TO "II" NC2444.2 +043500 PERFORM PASS NC2444.2 +043600 GO TO IDX-WRITE-F2-4 NC2444.2 +043700 ELSE NC2444.2 +043800 GO TO IDX-FAIL-F2-4. NC2444.2 +043900 IDX-DELETE-F2-4. NC2444.2 +044000 PERFORM DE-LETE. NC2444.2 +044100 GO TO IDX-WRITE-F2-4. NC2444.2 +044200 IDX-FAIL-F2-4. NC2444.2 +044300 MOVE ENTRY-HOLD TO COMPUTED-A. NC2444.2 +044400 MOVE "II" TO CORRECT-A. NC2444.2 +044500 IDX-WRITE-F2-4. NC2444.2 +044600 PERFORM PRINT-DETAIL. NC2444.2 +044700* NC2444.2 +044800 IDX-INIT-F2-5. NC2444.2 +044900 MOVE "IDX-TEST-F2-5" TO PAR-NAME. NC2444.2 +045000 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +045100 MOVE "PFM VARYNG COMP ITEM" TO FEATURE. NC2444.2 +045200 MOVE SPACES TO ENTRY-HOLD. NC2444.2 +045300 GO TO IDX-TEST-F2-5. NC2444.2 +045400 TEST-5. NC2444.2 +045500 SET IDX-3 TO SUB-COMP2. NC2444.2 +045600 SET IDX-14 TO SUB-COMP5. NC2444.2 +045700 MOVE ENTRY-2 (IDX-3, IDX-14) TO ENTRY-HOLD. NC2444.2 +045800 IDX-TEST-F2-5. NC2444.2 +045900 SET IDX-3, IDX-14 TO 01. NC2444.2 +046000 PERFORM TEST-5 NC2444.2 +046100 VARYING SUB-COMP5 FROM 1 BY SUB-8 NC2444.2 +046200 UNTIL ENTRY-2 (IDX-3, IDX-14) EQUAL TO "JJ" NC2444.2 +046300 OR IDX-14 EQUAL TO 10 NC2444.2 +046400 AFTER SUB-COMP2 FROM 1 BY 1 NC2444.2 +046500 UNTIL ENTRY-1 (IDX-3) EQUAL TO 46. NC2444.2 +046600 IF ENTRY-HOLD EQUAL TO "JJ" NC2444.2 +046700 PERFORM PASS NC2444.2 +046800 GO TO IDX-WRITE-F2-5 NC2444.2 +046900 ELSE NC2444.2 +047000 GO TO IDX-FAIL-F2-5. NC2444.2 +047100 IDX-DELETE-F2-5. NC2444.2 +047200 PERFORM DE-LETE. NC2444.2 +047300 MOVE "IDX-TEST-F2-5" TO PAR-NAME. NC2444.2 +047400 MOVE "PFM VARYING COMP ITEM" TO FEATURE. NC2444.2 +047500 PERFORM PRINT-DETAIL. NC2444.2 +047600* NOTE IF THIS TEST IS DELETED TEST-6 WILL ALSO BE DELETED. NC2444.2 +047700 PERFORM DE-LETE. NC2444.2 +047800 MOVE "IDX-TEST-F2-6" TO PAR-NAME. NC2444.2 +047900 PERFORM PRINT-DETAIL. NC2444.2 +048000 GO TO CLOSE-FILES. NC2444.2 +048100 IDX-FAIL-F2-5. NC2444.2 +048200 MOVE "JJ" TO CORRECT-A. NC2444.2 +048300 MOVE ENTRY-HOLD TO COMPUTED-A. NC2444.2 +048400 PERFORM FAIL. NC2444.2 +048500 IDX-WRITE-F2-5. NC2444.2 +048600 PERFORM PRINT-DETAIL. NC2444.2 +048700* NC2444.2 +048800 IDX-INIT-F2-6. NC2444.2 +048900 MOVE "IDX-TEST-F2-6" TO PAR-NAME. NC2444.2 +049000 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2444.2 +049100 IDX-TEST-F2-6. NC2444.2 +049200 IF IDX-3 EQUAL TO 46 AND IDX-14 EQUAL TO 01 NC2444.2 +049300 PERFORM PASS NC2444.2 +049400 GO TO IDX-WRITE-F2-6 NC2444.2 +049500 ELSE NC2444.2 +049600 GO TO IDX-FAIL-F2-6. NC2444.2 +049700 IDX-DELETE-F2-6. NC2444.2 +049800 PERFORM DE-LETE. NC2444.2 +049900 GO TO IDX-WRITE-F2-6. NC2444.2 +050000 IDX-FAIL-F2-6. NC2444.2 +050100 SET IDX-3HOLD TO IDX-3. NC2444.2 +050200 SET IDX-14HOLD TO IDX-14. NC2444.2 +050300 MOVE IDX-HOLD TO COMPUTED-A. NC2444.2 +050400 PERFORM FAIL. NC2444.2 +050500 MOVE "000046 000001" TO CORRECT-A. NC2444.2 +050600 MOVE "COMPARE INDEXES OF TEST-5" TO RE-MARK. NC2444.2 +050700 IDX-WRITE-F2-6. NC2444.2 +050800 PERFORM PRINT-DETAIL. NC2444.2 +050900 CCVS-EXIT SECTION. NC2444.2 +051000 CCVS-999999. NC2444.2 +051100 GO TO CLOSE-FILES. NC2444.2 diff --git a/tests/cobol85/NC/NC245A.CBL b/tests/cobol85/NC/NC245A.CBL new file mode 100755 index 00000000..1d916449 --- /dev/null +++ b/tests/cobol85/NC/NC245A.CBL @@ -0,0 +1,537 @@ +000100 IDENTIFICATION DIVISION. NC2454.2 +000200 PROGRAM-ID. NC2454.2 +000300 NC245A. NC2454.2 +000400**************************************************************** NC2454.2 +000500* * NC2454.2 +000600* VALIDATION FOR:- * NC2454.2 +000700* * NC2454.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2454.2 +000900* * NC2454.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2454.2 +001100* * NC2454.2 +001200**************************************************************** NC2454.2 +001300* * NC2454.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2454.2 +001500* * NC2454.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2454.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2454.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2454.2 +001900* * NC2454.2 +002000**************************************************************** NC2454.2 +002100* * NC2454.2 +002200* PROGRAM NC245A TESTS THE USE OF THE COMMA, SEMI-COLON AND * NC2454.2 +002300* SPACE SEPARATORS WHEN SPECIFYING SUBSCRIPTS AND INDICES * NC2454.2 +002400* TO ACCESS TWO AND THREE-DIMENSIONAL TABLES * NC2454.2 +002500* RELATIVE INDEXING IS ALSO USED. * NC2454.2 +002600* * NC2454.2 +002700**************************************************************** NC2454.2 +002800 ENVIRONMENT DIVISION. NC2454.2 +002900 CONFIGURATION SECTION. NC2454.2 +003000 SOURCE-COMPUTER. NC2454.2 +003100 Linux. NC2454.2 +003200 OBJECT-COMPUTER. NC2454.2 +003300 Linux. NC2454.2 +003400 INPUT-OUTPUT SECTION. NC2454.2 +003500 FILE-CONTROL. NC2454.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2454.2 +003700 "report.log". NC2454.2 +003800 DATA DIVISION. NC2454.2 +003900 FILE SECTION. NC2454.2 +004000 FD PRINT-FILE. NC2454.2 +004100 01 PRINT-REC PICTURE X(120). NC2454.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2454.2 +004300 WORKING-STORAGE SECTION. NC2454.2 +004400 77 WRK1 PIC S999; COMPUTATIONAL, VALUE ZERO. NC2454.2 +004500 77 EXPECTED-VALUE, PIC S999999. NC2454.2 +004600 77 TEMP; PIC S999999. NC2454.2 +004700* TWO DIMENSIONAL TABLE; 15 X 10. NC2454.2 +004800 01 GRP-TAB2. NC2454.2 +004900 02 GRP-LEV2-0015F; OCCURS 15 TIMES; NC2454.2 +005000 INDEXED BY IN1, INDEX1, NC2454.2 +005100 USAGE IS COMPUTATIONAL. NC2454.2 +005200 03 ELEM2 PIC S999999; OCCURS 10 TIMES; NC2454.2 +005300 INDEXED BY IN2; INDEX2. NC2454.2 +005400* THREE DIMENSIONAL TABLE; 10 X 5 X 3. NC2454.2 +005500 01 GRP-TAB3. NC2454.2 +005600 02 GRP-LEV2-0003F; OCCURS 3 TIMES; NC2454.2 +005700 INDEXED BY INAME1, IN-NAME-1, NC2454.2 +005800 USAGE IS COMPUTATIONAL. NC2454.2 +005900 03 GRP-LEV3-0005F; OCCURS 5 TIMES; NC2454.2 +006000 INDEXED BY INAME2; IN-NAME-2. NC2454.2 +006100 04 ELEM3 PIC S999999; OCCURS 10 TIMES; NC2454.2 +006200 INDEXED BY INAME3; IN-NAME-3. NC2454.2 +006300* SUBSCRIPTS FOR REFERENCING TABLE ITEMS NC2454.2 +006400 01 SUBSCRIPT-TABLE; USAGE COMPUTATIONAL. NC2454.2 +006500 02 S21 PIC S999; VALUE IS 1. NC2454.2 +006600 02 S22 PIC S999; VALUE IS 1. NC2454.2 +006700 02 S31 PIC S999; VALUE IS 1. NC2454.2 +006800 02 S32 PIC S999; VALUE IS 1. NC2454.2 +006900 02 S33 PIC S999; VALUE IS 1. NC2454.2 +007000 01 TEST-RESULTS. NC2454.2 +007100 02 FILLER PIC X VALUE SPACE. NC2454.2 +007200 02 FEATURE PIC X(20) VALUE SPACE. NC2454.2 +007300 02 FILLER PIC X VALUE SPACE. NC2454.2 +007400 02 P-OR-F PIC X(5) VALUE SPACE. NC2454.2 +007500 02 FILLER PIC X VALUE SPACE. NC2454.2 +007600 02 PAR-NAME. NC2454.2 +007700 03 FILLER PIC X(19) VALUE SPACE. NC2454.2 +007800 03 PARDOT-X PIC X VALUE SPACE. NC2454.2 +007900 03 DOTVALUE PIC 99 VALUE ZERO. NC2454.2 +008000 02 FILLER PIC X(8) VALUE SPACE. NC2454.2 +008100 02 RE-MARK PIC X(61). NC2454.2 +008200 01 TEST-COMPUTED. NC2454.2 +008300 02 FILLER PIC X(30) VALUE SPACE. NC2454.2 +008400 02 FILLER PIC X(17) VALUE NC2454.2 +008500 " COMPUTED=". NC2454.2 +008600 02 COMPUTED-X. NC2454.2 +008700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2454.2 +008800 03 COMPUTED-N REDEFINES COMPUTED-A NC2454.2 +008900 PIC -9(9).9(9). NC2454.2 +009000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2454.2 +009100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2454.2 +009200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2454.2 +009300 03 CM-18V0 REDEFINES COMPUTED-A. NC2454.2 +009400 04 COMPUTED-18V0 PIC -9(18). NC2454.2 +009500 04 FILLER PIC X. NC2454.2 +009600 03 FILLER PIC X(50) VALUE SPACE. NC2454.2 +009700 01 TEST-CORRECT. NC2454.2 +009800 02 FILLER PIC X(30) VALUE SPACE. NC2454.2 +009900 02 FILLER PIC X(17) VALUE " CORRECT =". NC2454.2 +010000 02 CORRECT-X. NC2454.2 +010100 03 CORRECT-A PIC X(20) VALUE SPACE. NC2454.2 +010200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2454.2 +010300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2454.2 +010400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2454.2 +010500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2454.2 +010600 03 CR-18V0 REDEFINES CORRECT-A. NC2454.2 +010700 04 CORRECT-18V0 PIC -9(18). NC2454.2 +010800 04 FILLER PIC X. NC2454.2 +010900 03 FILLER PIC X(2) VALUE SPACE. NC2454.2 +011000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2454.2 +011100 01 CCVS-C-1. NC2454.2 +011200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2454.2 +011300- "SS PARAGRAPH-NAME NC2454.2 +011400- " REMARKS". NC2454.2 +011500 02 FILLER PIC X(20) VALUE SPACE. NC2454.2 +011600 01 CCVS-C-2. NC2454.2 +011700 02 FILLER PIC X VALUE SPACE. NC2454.2 +011800 02 FILLER PIC X(6) VALUE "TESTED". NC2454.2 +011900 02 FILLER PIC X(15) VALUE SPACE. NC2454.2 +012000 02 FILLER PIC X(4) VALUE "FAIL". NC2454.2 +012100 02 FILLER PIC X(94) VALUE SPACE. NC2454.2 +012200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2454.2 +012300 01 REC-CT PIC 99 VALUE ZERO. NC2454.2 +012400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2454.2 +012500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2454.2 +012600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2454.2 +012700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2454.2 +012800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2454.2 +012900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2454.2 +013000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2454.2 +013100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2454.2 +013200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2454.2 +013300 01 CCVS-H-1. NC2454.2 +013400 02 FILLER PIC X(39) VALUE SPACES. NC2454.2 +013500 02 FILLER PIC X(42) VALUE NC2454.2 +013600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2454.2 +013700 02 FILLER PIC X(39) VALUE SPACES. NC2454.2 +013800 01 CCVS-H-2A. NC2454.2 +013900 02 FILLER PIC X(40) VALUE SPACE. NC2454.2 +014000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2454.2 +014100 02 FILLER PIC XXXX VALUE NC2454.2 +014200 "4.2 ". NC2454.2 +014300 02 FILLER PIC X(28) VALUE NC2454.2 +014400 " COPY - NOT FOR DISTRIBUTION". NC2454.2 +014500 02 FILLER PIC X(41) VALUE SPACE. NC2454.2 +014600 NC2454.2 +014700 01 CCVS-H-2B. NC2454.2 +014800 02 FILLER PIC X(15) VALUE NC2454.2 +014900 "TEST RESULT OF ". NC2454.2 +015000 02 TEST-ID PIC X(9). NC2454.2 +015100 02 FILLER PIC X(4) VALUE NC2454.2 +015200 " IN ". NC2454.2 +015300 02 FILLER PIC X(12) VALUE NC2454.2 +015400 " HIGH ". NC2454.2 +015500 02 FILLER PIC X(22) VALUE NC2454.2 +015600 " LEVEL VALIDATION FOR ". NC2454.2 +015700 02 FILLER PIC X(58) VALUE NC2454.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2454.2 +015900 01 CCVS-H-3. NC2454.2 +016000 02 FILLER PIC X(34) VALUE NC2454.2 +016100 " FOR OFFICIAL USE ONLY ". NC2454.2 +016200 02 FILLER PIC X(58) VALUE NC2454.2 +016300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2454.2 +016400 02 FILLER PIC X(28) VALUE NC2454.2 +016500 " COPYRIGHT 1985 ". NC2454.2 +016600 01 CCVS-E-1. NC2454.2 +016700 02 FILLER PIC X(52) VALUE SPACE. NC2454.2 +016800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2454.2 +016900 02 ID-AGAIN PIC X(9). NC2454.2 +017000 02 FILLER PIC X(45) VALUE SPACES. NC2454.2 +017100 01 CCVS-E-2. NC2454.2 +017200 02 FILLER PIC X(31) VALUE SPACE. NC2454.2 +017300 02 FILLER PIC X(21) VALUE SPACE. NC2454.2 +017400 02 CCVS-E-2-2. NC2454.2 +017500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2454.2 +017600 03 FILLER PIC X VALUE SPACE. NC2454.2 +017700 03 ENDER-DESC PIC X(44) VALUE NC2454.2 +017800 "ERRORS ENCOUNTERED". NC2454.2 +017900 01 CCVS-E-3. NC2454.2 +018000 02 FILLER PIC X(22) VALUE NC2454.2 +018100 " FOR OFFICIAL USE ONLY". NC2454.2 +018200 02 FILLER PIC X(12) VALUE SPACE. NC2454.2 +018300 02 FILLER PIC X(58) VALUE NC2454.2 +018400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2454.2 +018500 02 FILLER PIC X(13) VALUE SPACE. NC2454.2 +018600 02 FILLER PIC X(15) VALUE NC2454.2 +018700 " COPYRIGHT 1985". NC2454.2 +018800 01 CCVS-E-4. NC2454.2 +018900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2454.2 +019000 02 FILLER PIC X(4) VALUE " OF ". NC2454.2 +019100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2454.2 +019200 02 FILLER PIC X(40) VALUE NC2454.2 +019300 " TESTS WERE EXECUTED SUCCESSFULLY". NC2454.2 +019400 01 XXINFO. NC2454.2 +019500 02 FILLER PIC X(19) VALUE NC2454.2 +019600 "*** INFORMATION ***". NC2454.2 +019700 02 INFO-TEXT. NC2454.2 +019800 04 FILLER PIC X(8) VALUE SPACE. NC2454.2 +019900 04 XXCOMPUTED PIC X(20). NC2454.2 +020000 04 FILLER PIC X(5) VALUE SPACE. NC2454.2 +020100 04 XXCORRECT PIC X(20). NC2454.2 +020200 02 INF-ANSI-REFERENCE PIC X(48). NC2454.2 +020300 01 HYPHEN-LINE. NC2454.2 +020400 02 FILLER PIC IS X VALUE IS SPACE. NC2454.2 +020500 02 FILLER PIC IS X(65) VALUE IS "************************NC2454.2 +020600- "*****************************************". NC2454.2 +020700 02 FILLER PIC IS X(54) VALUE IS "************************NC2454.2 +020800- "******************************". NC2454.2 +020900 01 CCVS-PGM-ID PIC X(9) VALUE NC2454.2 +021000 "NC245A". NC2454.2 +021100 PROCEDURE DIVISION. NC2454.2 +021200 CCVS1 SECTION. NC2454.2 +021300 OPEN-FILES. NC2454.2 +021400 OPEN OUTPUT PRINT-FILE. NC2454.2 +021500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2454.2 +021600 MOVE SPACE TO TEST-RESULTS. NC2454.2 +021700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2454.2 +021800 GO TO CCVS1-EXIT. NC2454.2 +021900 CLOSE-FILES. NC2454.2 +022000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2454.2 +022100 TERMINATE-CCVS. NC2454.2 +022200*S EXIT PROGRAM. NC2454.2 +022300*SERMINATE-CALL. NC2454.2 +022400 STOP RUN. NC2454.2 +022500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2454.2 +022600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2454.2 +022700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2454.2 +022800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2454.2 +022900 MOVE "****TEST DELETED****" TO RE-MARK. NC2454.2 +023000 PRINT-DETAIL. NC2454.2 +023100 IF REC-CT NOT EQUAL TO ZERO NC2454.2 +023200 MOVE "." TO PARDOT-X NC2454.2 +023300 MOVE REC-CT TO DOTVALUE. NC2454.2 +023400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2454.2 +023500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2454.2 +023600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2454.2 +023700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2454.2 +023800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2454.2 +023900 MOVE SPACE TO CORRECT-X. NC2454.2 +024000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2454.2 +024100 MOVE SPACE TO RE-MARK. NC2454.2 +024200 HEAD-ROUTINE. NC2454.2 +024300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +024400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +024500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2454.2 +024600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2454.2 +024700 COLUMN-NAMES-ROUTINE. NC2454.2 +024800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +024900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +025100 END-ROUTINE. NC2454.2 +025200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2454.2 +025300 END-RTN-EXIT. NC2454.2 +025400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +025500 END-ROUTINE-1. NC2454.2 +025600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2454.2 +025700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2454.2 +025800 ADD PASS-COUNTER TO ERROR-HOLD. NC2454.2 +025900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2454.2 +026000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2454.2 +026100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2454.2 +026200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2454.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2454.2 +026400 END-ROUTINE-12. NC2454.2 +026500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2454.2 +026600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2454.2 +026700 MOVE "NO " TO ERROR-TOTAL NC2454.2 +026800 ELSE NC2454.2 +026900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2454.2 +027000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2454.2 +027100 PERFORM WRITE-LINE. NC2454.2 +027200 END-ROUTINE-13. NC2454.2 +027300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2454.2 +027400 MOVE "NO " TO ERROR-TOTAL ELSE NC2454.2 +027500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2454.2 +027600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2454.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +027800 IF INSPECT-COUNTER EQUAL TO ZERO NC2454.2 +027900 MOVE "NO " TO ERROR-TOTAL NC2454.2 +028000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2454.2 +028100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2454.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +028300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2454.2 +028400 WRITE-LINE. NC2454.2 +028500 ADD 1 TO RECORD-COUNT. NC2454.2 +028600 IF RECORD-COUNT GREATER 50 NC2454.2 +028700 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2454.2 +028800 MOVE SPACE TO DUMMY-RECORD NC2454.2 +028900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2454.2 +029000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2454.2 +029100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2454.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2454.2 +029300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2454.2 +029400 MOVE ZERO TO RECORD-COUNT. NC2454.2 +029500 PERFORM WRT-LN. NC2454.2 +029600 WRT-LN. NC2454.2 +029700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2454.2 +029800 MOVE SPACE TO DUMMY-RECORD. NC2454.2 +029900 BLANK-LINE-PRINT. NC2454.2 +030000 PERFORM WRT-LN. NC2454.2 +030100 FAIL-ROUTINE. NC2454.2 +030200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2454.2 +030300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2454.2 +030400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2454.2 +030500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2454.2 +030600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +030700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2454.2 +030800 GO TO FAIL-ROUTINE-EX. NC2454.2 +030900 FAIL-ROUTINE-WRITE. NC2454.2 +031000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2454.2 +031100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2454.2 +031200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2454.2 +031300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2454.2 +031400 FAIL-ROUTINE-EX. EXIT. NC2454.2 +031500 BAIL-OUT. NC2454.2 +031600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2454.2 +031700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2454.2 +031800 BAIL-OUT-WRITE. NC2454.2 +031900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2454.2 +032000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2454.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2454.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2454.2 +032300 BAIL-OUT-EX. EXIT. NC2454.2 +032400 CCVS1-EXIT. NC2454.2 +032500 EXIT. NC2454.2 +032600* SECTION 2.1.6 ON PAGE IV-3 OF AMERICAN NATIONAL NC2454.2 +032700* STANDARD COBOL, X3.23 - 1985 STATES THAT COMMA AND NC2454.2 +032800* SEMICOLON ARE OPTIONAL WHERE SHOWN IN THE FORMATS AND NC2454.2 +032900* ARE INTERCHANGEABLE. EITHER ONE MAY BE USED ANYWHERE NC2454.2 +033000* ONE OF THEM IS SHOWN IN THE LANGUAGE FORMATS. NC2454.2 +033100* NC2454.2 +033200* THIS ROUTINE TESTS THE USE OF SEMICOLON IN PLACE OF NC2454.2 +033300* COMMA AS SEPARATORS FOR SUBSCRIPTS AND INDEXES IN NC2454.2 +033400* REFERENCING TABLE ITEMS. NC2454.2 +033500**************************************** NC2454.2 +033600*STATEMENT DELETION INSTRUCTIONS NC2454.2 +033700* IF THE COMPILER REJECTS ANY TABLE REFERENCE IN THESE NC2454.2 +033800* TESTS, DELETE THAT LINE OF CODE BY PLACING AN * IN COLUMN 7. NC2454.2 +033900* LEAVE THE PERFORM ... THRU STATEMENT. THE TEST DELETED NC2454.2 +034000* APPEARS AS A FAILURE ON THE OUTPUT REPORT. NC2454.2 +034100**************************************** NC2454.2 +034200 SECT-NC245A-001 SECTION. NC2454.2 +034300* THIS SECTION STORES THE VALUES 1 THRU 150 IN THE NC2454.2 +034400* TWO TABLES USED IN THE TESTS OF SEMICOLON AS SUBSCRIPT NC2454.2 +034500* AND INDEX SEPARATOR. NC2454.2 +034600 BUILD-TABLE. NC2454.2 +034700 ADD 1 TO WRK1. NC2454.2 +034800 MOVE WRK1 TO ELEM2 (S21, S22) NC2454.2 +034900 ELEM3 (S31, S32, S33). NC2454.2 +035000 IF WRK1 EQUAL TO 150 GO TO SECT-TH219-0002. NC2454.2 +035100 INCRE-SUBS. NC2454.2 +035200 ADD 1 TO S22, S33. NC2454.2 +035300 IF S22 LESS THAN 11 GO TO BUILD-TABLE. NC2454.2 +035400 MOVE 1 TO S22, S33. NC2454.2 +035500 ADD 1 TO S21, S32. NC2454.2 +035600 IF S32 LESS THAN 6 GO TO BUILD-TABLE. NC2454.2 +035700 MOVE 1 TO S32. NC2454.2 +035800 ADD 1 TO S31. NC2454.2 +035900 GO TO BUILD-TABLE. NC2454.2 +036000 SECT-TH219-0002 SECTION. NC2454.2 +036100* THIS SECTION CONTAINS THE TESTS ON THE USE OF SEMICOLON NC2454.2 +036200* AS A SEPARATOR IN REFERENCING TABLE ITEMS. NC2454.2 +036300 SEP-INIT-008. NC2454.2 +036400 MOVE "SEP-TEST-008" TO PAR-NAME. NC2454.2 +036500 MOVE "SEMICLN AS SEPARATOR" TO FEATURE. NC2454.2 +036600 MOVE 0 TO REC-CT. NC2454.2 +036700 MOVE 0 TO TEMP. NC2454.2 +036800 MOVE 6 TO EXPECTED-VALUE. NC2454.2 +036900 MOVE 1 TO S21. NC2454.2 +037000 MOVE 6 TO S22. NC2454.2 +037100* THIS TEST USES SPACES AND SEMICOLONS IN REFERENCING NC2454.2 +037200* TWO DIMENSIONAL TABLE ELEMENTS WITH SUBSCRIPTS. NC2454.2 +037300 SEP-TEST-008-01. NC2454.2 +037400 MOVE ELEM2 (S21; S22) TO TEMP. NC2454.2 +037500 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +037600 SEP-TEST-008-02. NC2454.2 +037700 MOVE ELEM2(S21; S22) TO TEMP. NC2454.2 +037800 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +037900 SEP-TEST-008-03. NC2454.2 +038000 ADD ELEM2 (S21 ; S22) TO TEMP. NC2454.2 +038100 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +038200 SEP-TEST-008-04. NC2454.2 +038300 MOVE ELEM2( S21; S22 ) TO TEMP. NC2454.2 +038400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +038500 SEP-TEST-008-05. NC2454.2 +038600 MOVE ELEM2 ( S21; S22 ) TO TEMP. NC2454.2 +038700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +038800 GO TO SEP-INIT-009. NC2454.2 +038900 SEP-DELETE-008. NC2454.2 +039000 PERFORM DE-LETE. NC2454.2 +039100 PERFORM TEST-WRITE. NC2454.2 +039200 SEP-INIT-009. NC2454.2 +039300 MOVE "SEP-TEST-009" TO PAR-NAME. NC2454.2 +039400 MOVE 0 TO REC-CT. NC2454.2 +039500 MOVE 0 TO TEMP. NC2454.2 +039600 MOVE 150 TO EXPECTED-VALUE. NC2454.2 +039700 MOVE 3 TO S31. NC2454.2 +039800 MOVE 5 TO S32. NC2454.2 +039900 MOVE 10 TO S33. NC2454.2 +040000* THIS TEST USES SEMICOLONS, COMMAS, AND SPACES IN NC2454.2 +040100* REFERENCING THREE DIMENSIONAL TABLE ELEMENTS WITH SUBSCRIPTS.NC2454.2 +040200 SEP-TEST-009-01. NC2454.2 +040300 MOVE ELEM3 (S31; S32; S33) TO TEMP. NC2454.2 +040400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +040500 SEP-TEST-009-02. NC2454.2 +040600 MOVE ELEM3(S31; S32; S33) TO TEMP. NC2454.2 +040700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +040800 SEP-TEST-009-03. NC2454.2 +040900 ADD ELEM3 (S31, S32; S33) TO TEMP. NC2454.2 +041000 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +041100 SEP-TEST-009-04. NC2454.2 +041200 MOVE 300 TO TEMP. NC2454.2 +041300 SUBTRACT ELEM3 (S31; S32 S33) FROM TEMP. NC2454.2 +041400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +041500 SEP-TEST-009-05. NC2454.2 +041600 MOVE ELEM3 (S31 ; S32 ; S33) TO TEMP. NC2454.2 +041700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +041800 SEP-TEST-009-06. NC2454.2 +041900 MOVE ELEM3( S31 S32; S33) TO TEMP. NC2454.2 +042000 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +042100 GO TO SEP-INIT-010. NC2454.2 +042200 SEP-DELETE-009. NC2454.2 +042300 PERFORM DE-LETE. NC2454.2 +042400 PERFORM TEST-WRITE. NC2454.2 +042500* NC2454.2 +042600 SEP-INIT-010. NC2454.2 +042700 MOVE "SEP-TEST-010" TO PAR-NAME. NC2454.2 +042800 MOVE 0 TO REC-CT. NC2454.2 +042900 MOVE 0 TO TEMP. NC2454.2 +043000 MOVE 150 TO EXPECTED-VALUE. NC2454.2 +043100* THIS TEST USES SEMICOLONS, SPACES AND COMMAS IN NC2454.2 +043200* REFERENCING TABLE ELEMENTS WITH LITERAL SUBSCRIPTS. NC2454.2 +043300 SEP-TEST-010-01. NC2454.2 +043400 MOVE ELEM2 (15; 10) TO TEMP. NC2454.2 +043500 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +043600 SEP-TEST-010-02. NC2454.2 +043700 MOVE ELEM2 ( 15; 10 ) TO TEMP. NC2454.2 +043800 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +043900 SEP-TEST-010-03. NC2454.2 +044000 ADD ELEM2(15; 10) TO TEMP. NC2454.2 +044100 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +044200 SEP-TEST-010-04. NC2454.2 +044300 MOVE ELEM2 (+15; 10) TO TEMP. NC2454.2 +044400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +044500 SEP-TEST-010-05. NC2454.2 +044600 ADD ELEM3 (3; 5; 10) TO TEMP. NC2454.2 +044700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +044800 SEP-TEST-010-06. NC2454.2 +044900 MOVE ELEM3( +3; +5, +10) TO TEMP. NC2454.2 +045000 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +045100 SEP-TEST-010-07. NC2454.2 +045200 MOVE ELEM3 (+3, 5; 10) TO TEMP. NC2454.2 +045300 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +045400 GO TO SEP-INIT-011. NC2454.2 +045500 SEP-DELETE-010. NC2454.2 +045600 PERFORM DE-LETE. NC2454.2 +045700 PERFORM TEST-WRITE. NC2454.2 +045800* NC2454.2 +045900 SEP-INIT-011. NC2454.2 +046000 MOVE "SEP-TEST-011" TO PAR-NAME. NC2454.2 +046100 MOVE 0 TO TEMP; REC-CT. NC2454.2 +046200 MOVE 135 TO EXPECTED-VALUE. NC2454.2 +046300* THIS TEST USES SEMICOLON, COMMA AND SPACE IN NC2454.2 +046400* REFERENCING 2 AND 3-DIM. TABLES WITH INDEXING. NC2454.2 +046500 SEP-TEST-011-01. NC2454.2 +046600 SET IN1 TO 14. NC2454.2 +046700 SET IN2 TO 5. NC2454.2 +046800 MOVE ELEM2 (IN1; IN2) TO TEMP. NC2454.2 +046900 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +047000 SEP-TEST-011-02. NC2454.2 +047100 SET INAME1 TO 3. NC2454.2 +047200 SET INAME2 TO 4. NC2454.2 +047300 SET INAME3 TO 5. NC2454.2 +047400 MOVE ELEM3 (INAME1; INAME2; INAME3) TO TEMP. NC2454.2 +047500 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +047600 SEP-TEST-011-03. NC2454.2 +047700 MOVE ELEM3 (INAME1, INAME2; INAME3) TO TEMP. NC2454.2 +047800 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +047900 SEP-TEST-011-04. NC2454.2 +048000 MOVE ELEM3 (INAME1; INAME2 INAME3) TO TEMP. NC2454.2 +048100 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +048200 SEP-TEST-011-05. NC2454.2 +048300 MOVE ELEM3 (3; INAME2; 5) TO TEMP. NC2454.2 +048400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +048500 SEP-TEST-011-06. NC2454.2 +048600 MOVE ELEM3 (3, INAME2; 5) TO TEMP. NC2454.2 +048700 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +048800 GO TO SEP-INIT-012. NC2454.2 +048900 SEP-DELETE-011. NC2454.2 +049000 PERFORM DE-LETE. NC2454.2 +049100 PERFORM TEST-WRITE. NC2454.2 +049200* NC2454.2 +049300 SEP-INIT-012. NC2454.2 +049400 MOVE "SEP-TEST-012" TO PAR-NAME. NC2454.2 +049500 MOVE ZERO TO TEMP; REC-CT. NC2454.2 +049600 MOVE 123 TO EXPECTED-VALUE. NC2454.2 +049700* THIS TEST USES SEMICOLON, COMMA AND SPACE AS NC2454.2 +049800* SEPARATORS IN REFERENCING 3-DIMENSIONAL TABLE NC2454.2 +049900* ITEMS WITH RELATIVE INDEXING. NC2454.2 +050000 SEP-TEST-012-01. NC2454.2 +050100 SET INAME1; INAME2; INAME3 TO 3. NC2454.2 +050200 SET IN-NAME-1; IN-NAME-2; IN-NAME-3 TO 1. NC2454.2 +050300 MOVE ELEM3 (IN-NAME-1 + 2; INAME2; 3) TO TEMP. NC2454.2 +050400 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +050500 SEP-TEST-012-02. NC2454.2 +050600 MOVE ELEM3 (IN-NAME-1 + 2; IN-NAME-2 + 2; NC2454.2 +050700 IN-NAME-3 + 2) TO TEMP. NC2454.2 +050800 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +050900 SEP-TEST-012-03. NC2454.2 +051000 MOVE ELEM3 (INAME1; IN-NAME-2 + 2; IN-NAME-3 + 2) NC2454.2 +051100 TO TEMP. NC2454.2 +051200 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +051300 SEP-TEST-012-04. NC2454.2 +051400 MOVE ELEM3 (+3, INAME2; IN-NAME-3 + 2) TO TEMP. NC2454.2 +051500 PERFORM TEST-CHECK THRU TEST-WRITE. NC2454.2 +051600 GO TO CCVS-EXIT. NC2454.2 +051700 SEP-DELETE-012. NC2454.2 +051800 PERFORM DE-LETE. NC2454.2 +051900 PERFORM TEST-WRITE. NC2454.2 +052000* NC2454.2 +052100 SECT-TH219-0003 SECTION. NC2454.2 +052200* NC2454.2 +052300 TEST-CHECK. NC2454.2 +052400 ADD 1 TO REC-CT. NC2454.2 +052500 IF TEMP IS EQUAL TO EXPECTED-VALUE NC2454.2 +052600 PERFORM PASS NC2454.2 +052700 GO TO TEST-WRITE. NC2454.2 +052800 TEST-FAIL. NC2454.2 +052900 PERFORM FAIL. NC2454.2 +053000 MOVE TEMP TO COMPUTED-18V0. NC2454.2 +053100 MOVE EXPECTED-VALUE TO CORRECT-18V0. NC2454.2 +053200 TEST-WRITE. NC2454.2 +053300 PERFORM PRINT-DETAIL. NC2454.2 +053400 MOVE 0 TO TEMP. NC2454.2 +053500 CCVS-EXIT SECTION. NC2454.2 +053600 CCVS-999999. NC2454.2 +053700 GO TO CLOSE-FILES. NC2454.2 diff --git a/tests/cobol85/NC/NC246A.CBL b/tests/cobol85/NC/NC246A.CBL new file mode 100755 index 00000000..2964da40 --- /dev/null +++ b/tests/cobol85/NC/NC246A.CBL @@ -0,0 +1,1320 @@ +000100 IDENTIFICATION DIVISION. NC2464.2 +000200 PROGRAM-ID. NC2464.2 +000300 NC246A. NC2464.2 +000400**************************************************************** NC2464.2 +000500* * NC2464.2 +000600* VALIDATION FOR:- * NC2464.2 +000700* * NC2464.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2464.2 +000900* * NC2464.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2464.2 +001100* * NC2464.2 +001200**************************************************************** NC2464.2 +001300* * NC2464.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2464.2 +001500* * NC2464.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2464.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2464.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2464.2 +001900* * NC2464.2 +002000**************************************************************** NC2464.2 +002100* * NC2464.2 +002200* PROGRAM NC246A TESTS THE USE OF QUALIFIED DATA NAMES AND * NC2464.2 +002300* SUBSCRIPTS WHEN ACCESSING A SEVEN-DIMENSIONAL TABLE. * NC2464.2 +002400* QUALIFIED CONDITION-NAMES AND RELATIVE INDEXING ARE ALSO * NC2464.2 +002500* USED IN ACCESSING THREE-DIMENSIONAL TABLES. * NC2464.2 +002600* * NC2464.2 +002700**************************************************************** NC2464.2 +002800* * NC2464.2 +002900* DATA-NAMES MAY BE QUALIFIED AND THE NUMBER OF QUALIFIERS* NC2464.2 +003000* PERMITTED MUST BE AT LEAST FIVE. WHEN A SUBSCRIPT IS * NC2464.2 +003100* REPRESENTED BY A DATA-NAME, THE DATA-NAME MAY BE QUALIFIED* NC2464.2 +003200* BUT NOT SUBSCRIPTED. * NC2464.2 +003300* * NC2464.2 +003400**************************************************************** NC2464.2 +003500* * NC2464.2 +003600* STATEMENT DELETION INSTRUCTIONS * NC2464.2 +003700* * NC2464.2 +003800* IF THE COMPILER REJECTS ANY OF THE TABLE REFERENCES IN * NC2464.2 +003900* THIS ROUTINE, DELETE THAT LINE OF CODE BY PLACING AN * IN * NC2464.2 +004000* COLUMN 7. LEAVE THE PERFORM STATEMENT. THE TEST ELEMENT * NC2464.2 +004100* DELETED APPEARS AS A FAILURE ON THE OUTPUT REPORT AND THE * NC2464.2 +004200* COMPUTED RESULTS ARE SPACES. * NC2464.2 +004300* * NC2464.2 +004400**************************************************************** NC2464.2 +004500 ENVIRONMENT DIVISION. NC2464.2 +004600 CONFIGURATION SECTION. NC2464.2 +004700 SOURCE-COMPUTER. NC2464.2 +004800 Linux. NC2464.2 +004900 OBJECT-COMPUTER. NC2464.2 +005000 Linux. NC2464.2 +005100 INPUT-OUTPUT SECTION. NC2464.2 +005200 FILE-CONTROL. NC2464.2 +005300 SELECT PRINT-FILE ASSIGN TO NC2464.2 +005400 "report.log". NC2464.2 +005500 DATA DIVISION. NC2464.2 +005600 FILE SECTION. NC2464.2 +005700 FD PRINT-FILE. NC2464.2 +005800 01 PRINT-REC PICTURE X(120). NC2464.2 +005900 01 DUMMY-RECORD PICTURE X(120). NC2464.2 +006000 WORKING-STORAGE SECTION. NC2464.2 +006100 01 TABLE-A. NC2464.2 +006200 02 L2 OCCURS 2. NC2464.2 +006300 03 L3 OCCURS 2. NC2464.2 +006400 04 L4 OCCURS 2. NC2464.2 +006500 05 L5 OCCURS 2. NC2464.2 +006600 06 L6 OCCURS 2. NC2464.2 +006700 07 L7 OCCURS 2. NC2464.2 +006800 08 L8 OCCURS 2. NC2464.2 +006900 09 ELEM1 PIC 99. NC2464.2 +007000 09 ELEM2 PIC 99. NC2464.2 +007100 01 TABLE-B. NC2464.2 +007200 02 L2 OCCURS 2. NC2464.2 +007300 03 L3 OCCURS 2. NC2464.2 +007400 04 L4 OCCURS 2. NC2464.2 +007500 05 L5 OCCURS 2. NC2464.2 +007600 06 L6 OCCURS 2. NC2464.2 +007700 07 L7 OCCURS 2. NC2464.2 +007800 08 L8 OCCURS 2. NC2464.2 +007900 09 ELEM1 PIC 99. NC2464.2 +008000 09 ELEM2 PIC 99. NC2464.2 +008100 01 SUBSCRIPTS-GROUP-1. NC2464.2 +008200 02 SO2. NC2464.2 +008300 03 SO3. NC2464.2 +008400 04 SO4. NC2464.2 +008500 05 SO5. NC2464.2 +008600 06 SO6. NC2464.2 +008700 07 SO7. NC2464.2 +008800 08 SO8. NC2464.2 +008900 09 SO9. NC2464.2 +009000 10 S10. NC2464.2 +009100 11 S11. NC2464.2 +009200 12 S12. NC2464.2 +009300 13 S13. NC2464.2 +009400 14 S14. NC2464.2 +009500 15 S15. NC2464.2 +009600 16 S16. NC2464.2 +009700 17 S17. NC2464.2 +009800 18 S18. NC2464.2 +009900 19 S19. NC2464.2 +010000 20 S20. NC2464.2 +010100 21 S21. NC2464.2 +010200 22 S22. NC2464.2 +010300 23 S23. NC2464.2 +010400 24 S24. NC2464.2 +010500 25 S25. NC2464.2 +010600 26 S26. NC2464.2 +010700 27 S27. NC2464.2 +010800 28 S28. NC2464.2 +010900 29 S29. NC2464.2 +011000 30 S30. NC2464.2 +011100 31 S31. NC2464.2 +011200 32 S32. NC2464.2 +011300 33 S33. NC2464.2 +011400 34 S34. NC2464.2 +011500 35 S35. NC2464.2 +011600 36 S36. NC2464.2 +011700 37 S37. NC2464.2 +011800 38 S38. NC2464.2 +011900 39 S39. NC2464.2 +012000 40 S40. NC2464.2 +012100 41 S41. NC2464.2 +012200 42 S42. NC2464.2 +012300 43 S43. NC2464.2 +012400 44 S44. NC2464.2 +012500 45 S45. NC2464.2 +012600 46 S46. NC2464.2 +012700 47 S47. NC2464.2 +012800 48 S48. NC2464.2 +012900 49 SUB1 PIC 9 NC2464.2 +013000 VALUE 1. NC2464.2 +013100 49 SUB2 PIC 9 NC2464.2 +013200 VALUE 1. NC2464.2 +013300 49 SUB3 PIC 9 NC2464.2 +013400 VALUE 1. NC2464.2 +013500 49 SUB4 PIC 9 NC2464.2 +013600 VALUE 1. NC2464.2 +013700 49 SUB5 PIC 9 NC2464.2 +013800 VALUE 1. NC2464.2 +013900 49 SUB6 PIC 9 NC2464.2 +014000 VALUE 1. NC2464.2 +014100 49 SUB7 PIC 9 NC2464.2 +014200 VALUE 1. NC2464.2 +014300 01 SUBSCRIPTS-GROUP-2. NC2464.2 +014400 02 SO2. NC2464.2 +014500 03 SO3. NC2464.2 +014600 04 SO4. NC2464.2 +014700 05 SO5. NC2464.2 +014800 06 SO6. NC2464.2 +014900 07 SO7. NC2464.2 +015000 08 SO8. NC2464.2 +015100 09 SO9. NC2464.2 +015200 10 S10. NC2464.2 +015300 11 S11. NC2464.2 +015400 12 S12. NC2464.2 +015500 13 S13. NC2464.2 +015600 14 S14. NC2464.2 +015700 15 S15. NC2464.2 +015800 16 S16. NC2464.2 +015900 17 S17. NC2464.2 +016000 18 S18. NC2464.2 +016100 19 S19. NC2464.2 +016200 20 S20. NC2464.2 +016300 21 S21. NC2464.2 +016400 22 S22. NC2464.2 +016500 23 S23. NC2464.2 +016600 24 S24. NC2464.2 +016700 25 S25. NC2464.2 +016800 26 S26. NC2464.2 +016900 27 S27. NC2464.2 +017000 28 S28. NC2464.2 +017100 29 S29. NC2464.2 +017200 30 S30. NC2464.2 +017300 31 S31. NC2464.2 +017400 32 S32. NC2464.2 +017500 33 S33. NC2464.2 +017600 34 S34. NC2464.2 +017700 35 S35. NC2464.2 +017800 36 S36. NC2464.2 +017900 37 S37. NC2464.2 +018000 38 S38. NC2464.2 +018100 39 S39. NC2464.2 +018200 40 S40. NC2464.2 +018300 41 S41. NC2464.2 +018400 42 S42. NC2464.2 +018500 43 S43. NC2464.2 +018600 44 S44. NC2464.2 +018700 45 S45. NC2464.2 +018800 46 S46. NC2464.2 +018900 47 S47. NC2464.2 +019000 48 S48. NC2464.2 +019100 49 SUB1 PIC 9 NC2464.2 +019200 VALUE 2. NC2464.2 +019300 49 SUB2 PIC 9 NC2464.2 +019400 VALUE 2. NC2464.2 +019500 49 SUB3 PIC 9 NC2464.2 +019600 VALUE 2. NC2464.2 +019700 49 SUB4 PIC 9 NC2464.2 +019800 VALUE 2. NC2464.2 +019900 49 SUB5 PIC 9 NC2464.2 +020000 VALUE 2. NC2464.2 +020100 49 SUB6 PIC 9 NC2464.2 +020200 VALUE 2. NC2464.2 +020300 49 SUB7 PIC 9 NC2464.2 +020400 VALUE 2. NC2464.2 +020500 01 COMPARISON-VALUES. NC2464.2 +020600 02 EXPECTED-VALUE PICTURE X(6). NC2464.2 +020700 02 TEMP-VALUE PICTURE X(6). NC2464.2 +020800 01 GROUP-1-TABLE. NC2464.2 +020900 02 TABLE-LEVEL-2. NC2464.2 +021000 03 FILLER PIC X(13) VALUE "GROUP-1-TABLE". NC2464.2 +021100 03 TABLE-LEVEL-3. NC2464.2 +021200 04 FILLER PIC X VALUE SPACE. NC2464.2 +021300 04 TABLE-LEVEL-4. NC2464.2 +021400 05 FILLER PIC X VALUE "=". NC2464.2 +021500 05 TABLE-LEVEL-5. NC2464.2 +021600 06 FILLER PIC X VALUE SPACE. NC2464.2 +021700 06 TABLE-ITEM PICTURE X NC2464.2 +021800 OCCURS 15 TIMES NC2464.2 +021900 INDEXED BY IN1. NC2464.2 +022000 88 EQUALS-A VALUE "A". NC2464.2 +022100 88 EQUALS-C VALUE "C". NC2464.2 +022200 88 EQUALS-M VALUE "M". NC2464.2 +022300 05 GROUP-1-ENTRY REDEFINES TABLE-LEVEL-5. NC2464.2 +022400 06 FILLER PIC X(16). NC2464.2 +022500 01 GROUP-2-TABLE. NC2464.2 +022600 02 TABLE-LEVEL-2. NC2464.2 +022700 03 FILLER PIC X(13) VALUE "GROUP-2-TABLE". NC2464.2 +022800 03 TABLE-LEVEL-3. NC2464.2 +022900 04 FILLER PIC X VALUE SPACE. NC2464.2 +023000 04 TABLE-LEVEL-4. NC2464.2 +023100 05 FILLER PIC X VALUE "=". NC2464.2 +023200 05 TABLE-LEVEL-5. NC2464.2 +023300 06 FILLER PIC X VALUE SPACE. NC2464.2 +023400 06 TABLE-ITEM PICTURE X NC2464.2 +023500 OCCURS 12 TIMES NC2464.2 +023600 INDEXED BY IN2. NC2464.2 +023700 88 EQUALS-A VALUE "A". NC2464.2 +023800 88 EQUALS-C VALUE "C". NC2464.2 +023900 88 EQUALS-M VALUE "M". NC2464.2 +024000 05 GROUP-2-ENTRY REDEFINES TABLE-LEVEL-5. NC2464.2 +024100 06 FILLER PIC X(13). NC2464.2 +024200 01 GROUP-3-TABLE. NC2464.2 +024300 02 TABLE-LEVEL-2. NC2464.2 +024400 03 FILLER PIC X(15) VALUE "GROUP-3-TABLE =". NC2464.2 +024500 03 TABLE-LEVEL-3. NC2464.2 +024600 04 TABLE-LEVEL-4 NC2464.2 +024700 OCCURS 2 TIMES NC2464.2 +024800 INDEXED BY IN3. NC2464.2 +024900 05 TABLE-LEVEL-5 NC2464.2 +025000 OCCURS 2 TIMES NC2464.2 +025100 INDEXED BY IN4. NC2464.2 +025200 06 TABLE-ITEM PICTURE X NC2464.2 +025300 OCCURS 4 TIMES NC2464.2 +025400 INDEXED BY IN5. NC2464.2 +025500 88 EQUALS-A VALUE "A". NC2464.2 +025600 88 EQUALS-C VALUE "C". NC2464.2 +025700 88 EQUALS-M VALUE "M". NC2464.2 +025800 03 GROUP-3-ENTRY REDEFINES TABLE-LEVEL-3. NC2464.2 +025900 06 FILLER PIC X(16). NC2464.2 +026000 01 GROUP-4-TABLE. NC2464.2 +026100 02 UNQUAL-TABLE-2. NC2464.2 +026200 03 UNQUAL-TABLE-3. NC2464.2 +026300 04 UNQUAL-TABLE-4. NC2464.2 +026400 05 FILLER PIC X(15) VALUE "GROUP-4-TABLE =". NC2464.2 +026500 05 UNQUAL-TABLE-5. NC2464.2 +026600 06 UNQUAL-ITEM PIC X NC2464.2 +026700 OCCURS 15 TIMES. NC2464.2 +026800 01 GROUP-5-TABLE. NC2464.2 +026900 02 TABLE5-LEVEL-2. NC2464.2 +027000 03 FILLER PIC X(15) VALUE "GROUP-5-TABLE =". NC2464.2 +027100 03 TABLE5-LEVEL-3. NC2464.2 +027200 04 TABLE5-LEVEL-4 OCCURS 2 TIMES. NC2464.2 +027300 05 TABLE5-LEVEL-5 OCCURS 2 TIMES. NC2464.2 +027400 06 TABLE5-ITEM-UNQUAL PIC X NC2464.2 +027500 OCCURS 4 TIMES. NC2464.2 +027600 01 FIRST-SUB PIC 99 VALUE 1. NC2464.2 +027700 01 FOURTH-SUB PIC 99 VALUE 4. NC2464.2 +027800 01 UNQUAL-SUB PIC 99. NC2464.2 +027900 01 SUBSCRIPTS-PART1. NC2464.2 +028000 02 SUBSCRIPTS. NC2464.2 +028100 03 SUB1 PIC 9 VALUE 5. NC2464.2 +028200 03 SUB2 PIC 99 VALUE 12. NC2464.2 +028300 03 SUB3 PIC 999 USAGE COMP VALUE 1. NC2464.2 +028400 02 SOME-MORE-SUBSCRIPTS. NC2464.2 +028500 03 SUB1 PIC 9 USAGE COMP VALUE 3. NC2464.2 +028600 03 SUB2 PIC 99 USAGE COMP VALUE 7. NC2464.2 +028700 03 SUB3 PIC 999 VALUE 15. NC2464.2 +028800 01 SUBSCRIPTS-PART2. NC2464.2 +028900 02 SUB-PART2-LEVEL2. NC2464.2 +029000 03 SUB-PART2-LEVEL3. NC2464.2 +029100 04 SUB-PART2-LEVEL4. NC2464.2 +029200 05 SUBSCRIPTS. NC2464.2 +029300 06 SUB1 PIC 999 VALUE 5. NC2464.2 +029400 06 SUB2 PIC 99 VALUE 12. NC2464.2 +029500 06 SUB3 PIC 99 USAGE COMP VALUE 1. NC2464.2 +029600 03 SOME-MORE-SUBSCRIPTS. NC2464.2 +029700 04 SUB1 PIC 999 USAGE COMP VALUE 3. NC2464.2 +029800 04 SUB2 PIC 99 VALUE 7. NC2464.2 +029900 04 SUB3 PIC 99 USAGE COMP VALUE 15. NC2464.2 +030000 01 TEST-RESULTS. NC2464.2 +030100 02 FILLER PIC X VALUE SPACE. NC2464.2 +030200 02 FEATURE PIC X(20) VALUE SPACE. NC2464.2 +030300 02 FILLER PIC X VALUE SPACE. NC2464.2 +030400 02 P-OR-F PIC X(5) VALUE SPACE. NC2464.2 +030500 02 FILLER PIC X VALUE SPACE. NC2464.2 +030600 02 PAR-NAME. NC2464.2 +030700 03 FILLER PIC X(19) VALUE SPACE. NC2464.2 +030800 03 PARDOT-X PIC X VALUE SPACE. NC2464.2 +030900 03 DOTVALUE PIC 99 VALUE ZERO. NC2464.2 +031000 02 FILLER PIC X(8) VALUE SPACE. NC2464.2 +031100 02 RE-MARK PIC X(61). NC2464.2 +031200 01 TEST-COMPUTED. NC2464.2 +031300 02 FILLER PIC X(30) VALUE SPACE. NC2464.2 +031400 02 FILLER PIC X(17) VALUE NC2464.2 +031500 " COMPUTED=". NC2464.2 +031600 02 COMPUTED-X. NC2464.2 +031700 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2464.2 +031800 03 COMPUTED-N REDEFINES COMPUTED-A NC2464.2 +031900 PIC -9(9).9(9). NC2464.2 +032000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2464.2 +032100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2464.2 +032200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2464.2 +032300 03 CM-18V0 REDEFINES COMPUTED-A. NC2464.2 +032400 04 COMPUTED-18V0 PIC -9(18). NC2464.2 +032500 04 FILLER PIC X. NC2464.2 +032600 03 FILLER PIC X(50) VALUE SPACE. NC2464.2 +032700 01 TEST-CORRECT. NC2464.2 +032800 02 FILLER PIC X(30) VALUE SPACE. NC2464.2 +032900 02 FILLER PIC X(17) VALUE " CORRECT =". NC2464.2 +033000 02 CORRECT-X. NC2464.2 +033100 03 CORRECT-A PIC X(20) VALUE SPACE. NC2464.2 +033200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2464.2 +033300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2464.2 +033400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2464.2 +033500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2464.2 +033600 03 CR-18V0 REDEFINES CORRECT-A. NC2464.2 +033700 04 CORRECT-18V0 PIC -9(18). NC2464.2 +033800 04 FILLER PIC X. NC2464.2 +033900 03 FILLER PIC X(2) VALUE SPACE. NC2464.2 +034000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2464.2 +034100 01 CCVS-C-1. NC2464.2 +034200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2464.2 +034300- "SS PARAGRAPH-NAME NC2464.2 +034400- " REMARKS". NC2464.2 +034500 02 FILLER PIC X(20) VALUE SPACE. NC2464.2 +034600 01 CCVS-C-2. NC2464.2 +034700 02 FILLER PIC X VALUE SPACE. NC2464.2 +034800 02 FILLER PIC X(6) VALUE "TESTED". NC2464.2 +034900 02 FILLER PIC X(15) VALUE SPACE. NC2464.2 +035000 02 FILLER PIC X(4) VALUE "FAIL". NC2464.2 +035100 02 FILLER PIC X(94) VALUE SPACE. NC2464.2 +035200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2464.2 +035300 01 REC-CT PIC 99 VALUE ZERO. NC2464.2 +035400 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2464.2 +035500 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2464.2 +035600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2464.2 +035700 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2464.2 +035800 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2464.2 +035900 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2464.2 +036000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2464.2 +036100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2464.2 +036200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2464.2 +036300 01 CCVS-H-1. NC2464.2 +036400 02 FILLER PIC X(39) VALUE SPACES. NC2464.2 +036500 02 FILLER PIC X(42) VALUE NC2464.2 +036600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2464.2 +036700 02 FILLER PIC X(39) VALUE SPACES. NC2464.2 +036800 01 CCVS-H-2A. NC2464.2 +036900 02 FILLER PIC X(40) VALUE SPACE. NC2464.2 +037000 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2464.2 +037100 02 FILLER PIC XXXX VALUE NC2464.2 +037200 "4.2 ". NC2464.2 +037300 02 FILLER PIC X(28) VALUE NC2464.2 +037400 " COPY - NOT FOR DISTRIBUTION". NC2464.2 +037500 02 FILLER PIC X(41) VALUE SPACE. NC2464.2 +037600 NC2464.2 +037700 01 CCVS-H-2B. NC2464.2 +037800 02 FILLER PIC X(15) VALUE NC2464.2 +037900 "TEST RESULT OF ". NC2464.2 +038000 02 TEST-ID PIC X(9). NC2464.2 +038100 02 FILLER PIC X(4) VALUE NC2464.2 +038200 " IN ". NC2464.2 +038300 02 FILLER PIC X(12) VALUE NC2464.2 +038400 " HIGH ". NC2464.2 +038500 02 FILLER PIC X(22) VALUE NC2464.2 +038600 " LEVEL VALIDATION FOR ". NC2464.2 +038700 02 FILLER PIC X(58) VALUE NC2464.2 +038800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2464.2 +038900 01 CCVS-H-3. NC2464.2 +039000 02 FILLER PIC X(34) VALUE NC2464.2 +039100 " FOR OFFICIAL USE ONLY ". NC2464.2 +039200 02 FILLER PIC X(58) VALUE NC2464.2 +039300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2464.2 +039400 02 FILLER PIC X(28) VALUE NC2464.2 +039500 " COPYRIGHT 1985 ". NC2464.2 +039600 01 CCVS-E-1. NC2464.2 +039700 02 FILLER PIC X(52) VALUE SPACE. NC2464.2 +039800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2464.2 +039900 02 ID-AGAIN PIC X(9). NC2464.2 +040000 02 FILLER PIC X(45) VALUE SPACES. NC2464.2 +040100 01 CCVS-E-2. NC2464.2 +040200 02 FILLER PIC X(31) VALUE SPACE. NC2464.2 +040300 02 FILLER PIC X(21) VALUE SPACE. NC2464.2 +040400 02 CCVS-E-2-2. NC2464.2 +040500 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2464.2 +040600 03 FILLER PIC X VALUE SPACE. NC2464.2 +040700 03 ENDER-DESC PIC X(44) VALUE NC2464.2 +040800 "ERRORS ENCOUNTERED". NC2464.2 +040900 01 CCVS-E-3. NC2464.2 +041000 02 FILLER PIC X(22) VALUE NC2464.2 +041100 " FOR OFFICIAL USE ONLY". NC2464.2 +041200 02 FILLER PIC X(12) VALUE SPACE. NC2464.2 +041300 02 FILLER PIC X(58) VALUE NC2464.2 +041400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2464.2 +041500 02 FILLER PIC X(13) VALUE SPACE. NC2464.2 +041600 02 FILLER PIC X(15) VALUE NC2464.2 +041700 " COPYRIGHT 1985". NC2464.2 +041800 01 CCVS-E-4. NC2464.2 +041900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2464.2 +042000 02 FILLER PIC X(4) VALUE " OF ". NC2464.2 +042100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2464.2 +042200 02 FILLER PIC X(40) VALUE NC2464.2 +042300 " TESTS WERE EXECUTED SUCCESSFULLY". NC2464.2 +042400 01 XXINFO. NC2464.2 +042500 02 FILLER PIC X(19) VALUE NC2464.2 +042600 "*** INFORMATION ***". NC2464.2 +042700 02 INFO-TEXT. NC2464.2 +042800 04 FILLER PIC X(8) VALUE SPACE. NC2464.2 +042900 04 XXCOMPUTED PIC X(20). NC2464.2 +043000 04 FILLER PIC X(5) VALUE SPACE. NC2464.2 +043100 04 XXCORRECT PIC X(20). NC2464.2 +043200 02 INF-ANSI-REFERENCE PIC X(48). NC2464.2 +043300 01 HYPHEN-LINE. NC2464.2 +043400 02 FILLER PIC IS X VALUE IS SPACE. NC2464.2 +043500 02 FILLER PIC IS X(65) VALUE IS "************************NC2464.2 +043600- "*****************************************". NC2464.2 +043700 02 FILLER PIC IS X(54) VALUE IS "************************NC2464.2 +043800- "******************************". NC2464.2 +043900 01 CCVS-PGM-ID PIC X(9) VALUE NC2464.2 +044000 "NC246A". NC2464.2 +044100 PROCEDURE DIVISION. NC2464.2 +044200 CCVS1 SECTION. NC2464.2 +044300 OPEN-FILES. NC2464.2 +044400 OPEN OUTPUT PRINT-FILE. NC2464.2 +044500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2464.2 +044600 MOVE SPACE TO TEST-RESULTS. NC2464.2 +044700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2464.2 +044800 GO TO CCVS1-EXIT. NC2464.2 +044900 CLOSE-FILES. NC2464.2 +045000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2464.2 +045100 TERMINATE-CCVS. NC2464.2 +045200*S EXIT PROGRAM. NC2464.2 +045300*SERMINATE-CALL. NC2464.2 +045400 STOP RUN. NC2464.2 +045500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2464.2 +045600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2464.2 +045700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2464.2 +045800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2464.2 +045900 MOVE "****TEST DELETED****" TO RE-MARK. NC2464.2 +046000 PRINT-DETAIL. NC2464.2 +046100 IF REC-CT NOT EQUAL TO ZERO NC2464.2 +046200 MOVE "." TO PARDOT-X NC2464.2 +046300 MOVE REC-CT TO DOTVALUE. NC2464.2 +046400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2464.2 +046500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2464.2 +046600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2464.2 +046700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2464.2 +046800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2464.2 +046900 MOVE SPACE TO CORRECT-X. NC2464.2 +047000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2464.2 +047100 MOVE SPACE TO RE-MARK. NC2464.2 +047200 HEAD-ROUTINE. NC2464.2 +047300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +047400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +047500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2464.2 +047600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2464.2 +047700 COLUMN-NAMES-ROUTINE. NC2464.2 +047800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +047900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +048000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +048100 END-ROUTINE. NC2464.2 +048200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2464.2 +048300 END-RTN-EXIT. NC2464.2 +048400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +048500 END-ROUTINE-1. NC2464.2 +048600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2464.2 +048700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2464.2 +048800 ADD PASS-COUNTER TO ERROR-HOLD. NC2464.2 +048900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2464.2 +049000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2464.2 +049100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2464.2 +049200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2464.2 +049300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2464.2 +049400 END-ROUTINE-12. NC2464.2 +049500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2464.2 +049600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2464.2 +049700 MOVE "NO " TO ERROR-TOTAL NC2464.2 +049800 ELSE NC2464.2 +049900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2464.2 +050000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2464.2 +050100 PERFORM WRITE-LINE. NC2464.2 +050200 END-ROUTINE-13. NC2464.2 +050300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2464.2 +050400 MOVE "NO " TO ERROR-TOTAL ELSE NC2464.2 +050500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2464.2 +050600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2464.2 +050700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +050800 IF INSPECT-COUNTER EQUAL TO ZERO NC2464.2 +050900 MOVE "NO " TO ERROR-TOTAL NC2464.2 +051000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2464.2 +051100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2464.2 +051200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +051300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2464.2 +051400 WRITE-LINE. NC2464.2 +051500 ADD 1 TO RECORD-COUNT. NC2464.2 +051600 IF RECORD-COUNT GREATER 50 NC2464.2 +051700 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2464.2 +051800 MOVE SPACE TO DUMMY-RECORD NC2464.2 +051900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2464.2 +052000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2464.2 +052100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2464.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2464.2 +052300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2464.2 +052400 MOVE ZERO TO RECORD-COUNT. NC2464.2 +052500 PERFORM WRT-LN. NC2464.2 +052600 WRT-LN. NC2464.2 +052700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2464.2 +052800 MOVE SPACE TO DUMMY-RECORD. NC2464.2 +052900 BLANK-LINE-PRINT. NC2464.2 +053000 PERFORM WRT-LN. NC2464.2 +053100 FAIL-ROUTINE. NC2464.2 +053200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2464.2 +053300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2464.2 +053400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2464.2 +053500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2464.2 +053600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +053700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2464.2 +053800 GO TO FAIL-ROUTINE-EX. NC2464.2 +053900 FAIL-ROUTINE-WRITE. NC2464.2 +054000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2464.2 +054100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2464.2 +054200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2464.2 +054300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2464.2 +054400 FAIL-ROUTINE-EX. EXIT. NC2464.2 +054500 BAIL-OUT. NC2464.2 +054600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2464.2 +054700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2464.2 +054800 BAIL-OUT-WRITE. NC2464.2 +054900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2464.2 +055000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2464.2 +055100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2464.2 +055200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2464.2 +055300 BAIL-OUT-EX. EXIT. NC2464.2 +055400 CCVS1-EXIT. NC2464.2 +055500 EXIT. NC2464.2 +055600 SECT-NC246A-001 SECTION. NC2464.2 +055700* NC2464.2 +055800 TABLE-INIT. NC2464.2 +055900 MOVE "INIT-TABLE" TO PAR-NAME. NC2464.2 +056000 MOVE "STORE TABLE VALUES" TO FEATURE. NC2464.2 +056100* NC2464.2 +056200* THIS SECTION STORES THE LETTERS OF THE ALPHABET IN THE NC2464.2 +056300* THREE TABLES WHOSE ITEMS ARE REFERENCED IN THE QUALIFICATION NC2464.2 +056400* TESTS IN THIS ROUTINE. THE TABLE CONTENTS ARE AS FOLLOWS NC2464.2 +056500* GROUP-1-TABLE A,B,...,O. NC2464.2 +056600* GROUP-2-TABLE L,K,J,...,B,A. NC2464.2 +056700* GROUP-3-TABLE A,B,...,O,P. NC2464.2 +056800* GROUP-4-TABLE A,B,...,O. NC2464.2 +056900* GROUP-5-TABLE P,O,N,...,B,A. NC2464.2 +057000* THE TABLES ARE ALSO PRINTED ON THE OUTPUT REPORT. NC2464.2 +057100* NC2464.2 +057200 MOVE " ABCDEFGHIJKLMNO" TO GROUP-1-ENTRY. NC2464.2 +057300 MOVE " LKJIHGFEDCBA" TO GROUP-2-ENTRY. NC2464.2 +057400 MOVE "ABCDEFGHIJKLMNOP" TO GROUP-3-ENTRY. NC2464.2 +057500 MOVE "ABCDEFGHIJKLMNO" TO UNQUAL-TABLE-5. NC2464.2 +057600 MOVE "PONMLKJIHGFEDCBA" TO TABLE5-LEVEL-3. NC2464.2 +057700* NC2464.2 +057800 TABLE-PRINT. NC2464.2 +057900 MOVE GROUP-1-TABLE TO RE-MARK. NC2464.2 +058000 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +058100 MOVE "ABCDEFGHIJKLMNO" TO CORRECT-A. NC2464.2 +058200 MOVE 1 TO REC-CT. NC2464.2 +058300 PERFORM PRINT-DETAIL. NC2464.2 +058400 MOVE GROUP-2-TABLE TO RE-MARK. NC2464.2 +058500 MOVE "LKJIHGFEDCBA" TO CORRECT-A. NC2464.2 +058600 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +058700 MOVE 2 TO REC-CT. NC2464.2 +058800 PERFORM PRINT-DETAIL. NC2464.2 +058900 MOVE GROUP-3-TABLE TO RE-MARK. NC2464.2 +059000 MOVE "ABCDEFGHIJKLMNOP" TO CORRECT-A. NC2464.2 +059100 MOVE 3 TO REC-CT. NC2464.2 +059200 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +059300 PERFORM PRINT-DETAIL. NC2464.2 +059400 MOVE GROUP-4-TABLE TO RE-MARK. NC2464.2 +059500 MOVE "ABCDEFGHIJKLMNO" TO CORRECT-A. NC2464.2 +059600 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +059700 MOVE 4 TO REC-CT. NC2464.2 +059800 PERFORM PRINT-DETAIL. NC2464.2 +059900 MOVE GROUP-5-TABLE TO RE-MARK. NC2464.2 +060000 MOVE "PONMLKJIHGFEDCBA" TO CORRECT-A. NC2464.2 +060100 MOVE "SEE REMARKS" TO COMPUTED-A. NC2464.2 +060200 MOVE 5 TO REC-CT. NC2464.2 +060300 PERFORM PRINT-DETAIL. NC2464.2 +060400* NC2464.2 +060500 QUAL-TEST-01. NC2464.2 +060600 MOVE ZERO TO REC-CT. NC2464.2 +060700 MOVE SPACE TO TEMP-VALUE. NC2464.2 +060800 MOVE "QUAL-TEST-01" TO PAR-NAME. NC2464.2 +060900 MOVE "QUALIFIED TABLE ITEM" TO FEATURE. NC2464.2 +061000 MOVE "ONE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +061100 MOVE "A" TO EXPECTED-VALUE. NC2464.2 +061200* NC2464.2 +061300* THIS TEST CONTAINS QUALIFIED DATA NAMES IN MOVE NC2464.2 +061400* STATEMENTS. THE DATA NAMES REFER TO SINGLE DIMENSIONAL NC2464.2 +061500* TABLE ITEMS. THE SUBSCRIPTS IN THIS TEST ARE CONSTANTS, NC2464.2 +061600* UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT AND RELATIVENC2464.2 +061700* INDEXING ARE USED. NC2464.2 +061800* NC2464.2 +061900 QUAL-TEST-01-01. NC2464.2 +062000 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +062100 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +062200 OF GROUP-1-TABLE (1) TO TEMP-VALUE. NC2464.2 +062300 PERFORM SECT-TH220-0003. NC2464.2 +062400* NC2464.2 +062500 QUAL-TEST-01-02. NC2464.2 +062600 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +062700 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +062800 OF GROUP-1-TABLE (FIRST-SUB) TO TEMP-VALUE. NC2464.2 +062900 PERFORM SECT-TH220-0003. NC2464.2 +063000* NC2464.2 +063100 QUAL-TEST-01-03. NC2464.2 +063200 SET IN1 TO 1. NC2464.2 +063300 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +063400 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +063500 OF GROUP-1-TABLE (IN1) TO TEMP-VALUE. NC2464.2 +063600 PERFORM SECT-TH220-0003. NC2464.2 +063700* NC2464.2 +063800 QUAL-TEST-01-04. NC2464.2 +063900 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +064000 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +064100 OF GROUP-2-TABLE (12) TO TEMP-VALUE. NC2464.2 +064200 PERFORM SECT-TH220-0003. NC2464.2 +064300* NC2464.2 +064400 QUAL-TEST-01-05. NC2464.2 +064500 SET IN1 TO 1. NC2464.2 +064600 MOVE "D" TO EXPECTED-VALUE. NC2464.2 +064700 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +064800 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +064900 OF GROUP-1-TABLE (IN1 + 3) TO TEMP-VALUE. NC2464.2 +065000 PERFORM SECT-TH220-0003. NC2464.2 +065100* NC2464.2 +065200 QUAL-TEST-01-06. NC2464.2 +065300 SET IN1 TO 6. NC2464.2 +065400 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +065500 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +065600 OF GROUP-1-TABLE (IN1 - 2) TO TEMP-VALUE. NC2464.2 +065700 PERFORM SECT-TH220-0003. NC2464.2 +065800* NC2464.2 +065900 QUAL-TEST-01-07. NC2464.2 +066000 MOVE 9 TO UNQUAL-SUB. NC2464.2 +066100 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +066200 OF TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +066300 OF GROUP-2-TABLE (UNQUAL-SUB) TO TEMP-VALUE. NC2464.2 +066400 PERFORM SECT-TH220-0003. NC2464.2 +066500 GO TO QUAL-TEST-02. NC2464.2 +066600* NC2464.2 +066700 QUAL-DELETE-001. NC2464.2 +066800 PERFORM DE-LETE. NC2464.2 +066900 PERFORM PRINT-DETAIL. NC2464.2 +067000* NC2464.2 +067100 QUAL-TEST-02. NC2464.2 +067200 MOVE ZERO TO REC-CT. NC2464.2 +067300 MOVE "QUAL-TEST-02" TO PAR-NAME. NC2464.2 +067400 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +067500* NC2464.2 +067600* THIS TEST CONTAINS TWO QUALIFIED DATA NAMES IN IF NC2464.2 +067700* STATEMENTS. THE DATA NAMES REFER TO SINGLE DIMENSIONAL NC2464.2 +067800* TABLE ITEMS. THE SUBSCRIPTS IN THIS TEST ARE CONSTANTS, NC2464.2 +067900* UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT AND RELATIVENC2464.2 +068000* INDEXING ARE USED. NC2464.2 +068100* NC2464.2 +068200 QUAL-TEST-02-01. NC2464.2 +068300 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +068400 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +068500 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +068600 IN GROUP-1-TABLE (1) IS EQUAL TO NC2464.2 +068700 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +068800 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +068900 IN GROUP-2-TABLE (12) NC2464.2 +069000 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +069100 PERFORM SECT-TH220-0003. NC2464.2 +069200* NC2464.2 +069300 QUAL-TEST-02-02. NC2464.2 +069400 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +069500 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +069600 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +069700 IN GROUP-1-TABLE (FIRST-SUB) IS NOT EQUAL TO NC2464.2 +069800 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +069900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +070000 IN GROUP-2-TABLE (FIRST-SUB) NC2464.2 +070100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +070200 PERFORM SECT-TH220-0003. NC2464.2 +070300* NC2464.2 +070400 QUAL-TEST-02-03. NC2464.2 +070500 SET IN1 TO 4. NC2464.2 +070600 SET IN2 TO 9. NC2464.2 +070700 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +070800 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +070900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +071000 IN GROUP-1-TABLE (IN1) IS EQUAL TO NC2464.2 +071100 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +071200 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +071300 IN GROUP-2-TABLE (IN2) NC2464.2 +071400 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +071500 PERFORM SECT-TH220-0003. NC2464.2 +071600* NC2464.2 +071700 QUAL-TEST-02-04. NC2464.2 +071800 SET IN1 IN2 TO 5. NC2464.2 +071900 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +072000 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +072100 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +072200 IN GROUP-1-TABLE (IN1 - 1) EQUAL TO NC2464.2 +072300 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +072400 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +072500 IN GROUP-2-TABLE (IN2 + 4) NC2464.2 +072600 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +072700 PERFORM SECT-TH220-0003. NC2464.2 +072800* NC2464.2 +072900 QUAL-TEST-02-05. NC2464.2 +073000 SET IN1 TO 5. NC2464.2 +073100 MOVE 8 TO UNQUAL-SUB. NC2464.2 +073200 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +073300 IF TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +073400 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +073500 IN GROUP-1-TABLE (IN1) EQUAL TO NC2464.2 +073600 TABLE-ITEM IN TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +073700 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +073800 IN GROUP-2-TABLE (UNQUAL-SUB) NC2464.2 +073900 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +074000 PERFORM SECT-TH220-0003. NC2464.2 +074100 GO TO QUAL-INIT-03. NC2464.2 +074200* NC2464.2 +074300 QUAL-DELETE-002. NC2464.2 +074400 PERFORM DE-LETE. NC2464.2 +074500 PERFORM PRINT-DETAIL. NC2464.2 +074600* NC2464.2 +074700 QUAL-INIT-03. NC2464.2 +074800 MOVE ZERO TO REC-CT. NC2464.2 +074900 MOVE "QUAL-TEST-03" TO PAR-NAME. NC2464.2 +075000 MOVE "THREE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +075100 MOVE SPACE TO TEMP-VALUE. NC2464.2 +075200 MOVE "D" TO EXPECTED-VALUE. NC2464.2 +075300* NC2464.2 +075400* THIS TEST CONTAINS QUALIFIED DATA NAMES IN MOVE NC2464.2 +075500* STATEMENTS. THE DATA NAMES REFER TO THREE DIMENSIONAL NC2464.2 +075600* TABLE ITEMS. THE SUBSCRIPTS IN THIS TEST ARE CONSTANTS, NC2464.2 +075700* UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT AND RELATIVENC2464.2 +075800* INDEXING ARE USED. NC2464.2 +075900* NC2464.2 +076000* NC2464.2 +076100 QUAL-TEST-03-01. NC2464.2 +076200 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +076300 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +076400 OF GROUP-3-TABLE (1, 1, 4) TO TEMP-VALUE. NC2464.2 +076500 PERFORM SECT-TH220-0003. NC2464.2 +076600* NC2464.2 +076700 QUAL-TEST-03-02. NC2464.2 +076800 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +076900 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +077000 OF GROUP-3-TABLE (FIRST-SUB, FIRST-SUB, FOURTH-SUB) NC2464.2 +077100 TO TEMP-VALUE. NC2464.2 +077200 PERFORM SECT-TH220-0003. NC2464.2 +077300* NC2464.2 +077400 QUAL-TEST-03-03. NC2464.2 +077500 SET IN5 TO 4. NC2464.2 +077600 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +077700 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +077800 OF GROUP-3-TABLE (1, 1, IN5) TO TEMP-VALUE. NC2464.2 +077900 PERFORM SECT-TH220-0003. NC2464.2 +078000* NC2464.2 +078100 QUAL-TEST-03-04. NC2464.2 +078200 SET IN3, IN4 TO 1. NC2464.2 +078300 SET IN5 TO 4. NC2464.2 +078400 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +078500 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +078600 OF GROUP-3-TABLE (IN3, IN4, IN5) TO TEMP-VALUE. NC2464.2 +078700 PERFORM SECT-TH220-0003. NC2464.2 +078800* NC2464.2 +078900 QUAL-TEST-03-05. NC2464.2 +079000 SET IN3, IN4 TO 2. NC2464.2 +079100 SET IN5 TO 1. NC2464.2 +079200 MOVE TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +079300 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +079400 IN GROUP-3-TABLE (IN3 - 1, IN4 - 1, IN5 + 3) NC2464.2 +079500 TO TEMP-VALUE. NC2464.2 +079600 PERFORM SECT-TH220-0003. NC2464.2 +079700 GO TO QUAL-INIT-04. NC2464.2 +079800* NC2464.2 +079900 QUAL-DELETE-003. NC2464.2 +080000 PERFORM DE-LETE. NC2464.2 +080100 PERFORM PRINT-DETAIL. NC2464.2 +080200* NC2464.2 +080300 QUAL-INIT-04. NC2464.2 +080400 MOVE "QUAL-TEST-04" TO PAR-NAME. NC2464.2 +080500 MOVE ZERO TO REC-CT. NC2464.2 +080600 MOVE "QUALIFIED SUBSCRIPT" TO FEATURE. NC2464.2 +080700 MOVE "ONE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +080800 MOVE SPACE TO TEMP-VALUE. NC2464.2 +080900* NC2464.2 +081000* THIS TEST CONTAINS UNQUALIFIED DATA NAMES WITH NC2464.2 +081100* QUALIFIED SUBSCRIPTS IN MOVE STATEMENTS. THE DATA NAMES NC2464.2 +081200* REFER TO SINGLE DIMENSIONAL TABLE ITEMS. NC2464.2 +081300* NC2464.2 +081400 MOVE "E" TO EXPECTED-VALUE. NC2464.2 +081500* NC2464.2 +081600 QUAL-TEST-04-01. NC2464.2 +081700 MOVE UNQUAL-ITEM (SUB1 OF SUBSCRIPTS OF SUBSCRIPTS-PART1) NC2464.2 +081800 TO TEMP-VALUE. NC2464.2 +081900 PERFORM SECT-TH220-0003. NC2464.2 +082000* NC2464.2 +082100 QUAL-TEST-04-02. NC2464.2 +082200 MOVE UNQUAL-ITEM (SUB1 OF SUBSCRIPTS OF SUB-PART2-LEVEL4) NC2464.2 +082300 TO TEMP-VALUE. NC2464.2 +082400 PERFORM SECT-TH220-0003. NC2464.2 +082500* NC2464.2 +082600 QUAL-TEST-04-03. NC2464.2 +082700 MOVE UNQUAL-ITEM (SUB1 OF SUBSCRIPTS OF SUB-PART2-LEVEL4 NC2464.2 +082800 OF SUB-PART2-LEVEL3 IN SUB-PART2-LEVEL2 NC2464.2 +082900 IN SUBSCRIPTS-PART2) NC2464.2 +083000 TO TEMP-VALUE. NC2464.2 +083100 PERFORM SECT-TH220-0003. NC2464.2 +083200* NC2464.2 +083300 QUAL-TEST-04-04. NC2464.2 +083400 MOVE "C" TO EXPECTED-VALUE. NC2464.2 +083500 MOVE UNQUAL-ITEM (SUB1 OF SOME-MORE-SUBSCRIPTS OF NC2464.2 +083600 SUBSCRIPTS-PART1) NC2464.2 +083700 TO TEMP-VALUE. NC2464.2 +083800 PERFORM SECT-TH220-0003. NC2464.2 +083900* NC2464.2 +084000 QUAL-TEST-04-05. NC2464.2 +084100 MOVE "G" TO EXPECTED-VALUE. NC2464.2 +084200 MOVE UNQUAL-ITEM (SUB2 OF SOME-MORE-SUBSCRIPTS OF NC2464.2 +084300 SUB-PART2-LEVEL2) NC2464.2 +084400 TO TEMP-VALUE. NC2464.2 +084500 PERFORM SECT-TH220-0003. NC2464.2 +084600 GO TO QUAL-INIT-05. NC2464.2 +084700* NC2464.2 +084800 QUAL-DELETE-004. NC2464.2 +084900 PERFORM DE-LETE. NC2464.2 +085000 PERFORM PRINT-DETAIL. NC2464.2 +085100* NC2464.2 +085200 QUAL-INIT-05. NC2464.2 +085300 MOVE "QUAL-TEST-05" TO PAR-NAME. NC2464.2 +085400 MOVE ZERO TO REC-CT. NC2464.2 +085500 MOVE "THREE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +085600* NC2464.2 +085700* THIS TEST CONTAINS UNQUALIFIED DATA NAMES WITH NC2464.2 +085800* QUALIFIED SUBSCRIPTS IN MOVE STATEMENTS. THE DATA NAMES NC2464.2 +085900* REFER TO THREE DIMENSIONAL TABLE ITEMS. NC2464.2 +086000* NC2464.2 +086100 MOVE SPACE TO TEMP-VALUE. NC2464.2 +086200 MOVE "N" TO EXPECTED-VALUE. NC2464.2 +086300* NC2464.2 +086400 QUAL-TEST-05-01. NC2464.2 +086500 MOVE TABLE5-ITEM-UNQUAL (FIRST-SUB FIRST-SUB NC2464.2 +086600 SUB1 OF SOME-MORE-SUBSCRIPTS OF SUB-PART2-LEVEL2 NC2464.2 +086700 IN SUBSCRIPTS-PART2) NC2464.2 +086800 TO TEMP-VALUE. NC2464.2 +086900 PERFORM SECT-TH220-0003. NC2464.2 +087000* NC2464.2 +087100 QUAL-TEST-05-02. NC2464.2 +087200 MOVE TABLE5-ITEM-UNQUAL (SUB3 OF SUBSCRIPTS OF NC2464.2 +087300 SUBSCRIPTS-PART1 SUB3 OF SUBSCRIPTS OF NC2464.2 +087400 SUB-PART2-LEVEL4 IN SUB-PART2-LEVEL3 IN NC2464.2 +087500 SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2 NC2464.2 +087600 SUB1 OF SOME-MORE-SUBSCRIPTS OF SUB-PART2-LEVEL2 NC2464.2 +087700 IN SUBSCRIPTS-PART2) NC2464.2 +087800 TO TEMP-VALUE. NC2464.2 +087900 PERFORM SECT-TH220-0003. NC2464.2 +088000 GO TO QUAL-INIT-06. NC2464.2 +088100* NC2464.2 +088200 QUAL-DELETE-005. NC2464.2 +088300 PERFORM DE-LETE. NC2464.2 +088400 PERFORM PRINT-DETAIL. NC2464.2 +088500* NC2464.2 +088600 QUAL-INIT-06. NC2464.2 +088700 MOVE "QUAL-TEST-06" TO PAR-NAME. NC2464.2 +088800 MOVE "ONE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +088900 MOVE ZERO TO REC-CT. NC2464.2 +089000* NC2464.2 +089100* THIS TEST CONTAINS QUALIFIED DATA NAMES WITH NC2464.2 +089200* QUALIFIED SUBSCRIPTS IN IF STATEMENTS. THE DATA NAMES NC2464.2 +089300* REFER TO SINGLE DIMENSIONAL TABLE ITEMS. NC2464.2 +089400* NC2464.2 +089500 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +089600* NC2464.2 +089700 QUAL-TEST-06-01. NC2464.2 +089800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +089900 IF TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +090000 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +090100 OF GROUP-1-TABLE (SUB3 IN SOME-MORE-SUBSCRIPTS NC2464.2 +090200 IN SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2) NC2464.2 +090300 IS EQUAL TO "O" NC2464.2 +090400 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +090500 PERFORM SECT-TH220-0003. NC2464.2 +090600* NC2464.2 +090700 QUAL-TEST-06-02. NC2464.2 +090800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +090900 IF TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +091000 OF TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +091100 OF GROUP-1-TABLE (SUB2 OF SUBSCRIPTS OF NC2464.2 +091200 SUB-PART2-LEVEL4 IN SUB-PART2-LEVEL3 IN NC2464.2 +091300 SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2) NC2464.2 +091400 IS EQUAL TO TABLE-ITEM OF TABLE-LEVEL-5 NC2464.2 +091500 IN TABLE-LEVEL-4 OF TABLE-LEVEL-3 IN NC2464.2 +091600 TABLE-LEVEL-2 OF GROUP-2-TABLE (SUB3 IN SUBSCRIPTS NC2464.2 +091700 OF SUBSCRIPTS-PART1) NC2464.2 +091800 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +091900 PERFORM SECT-TH220-0003. NC2464.2 +092000 GO TO QUAL-INIT-07. NC2464.2 +092100* NC2464.2 +092200 QUAL-DELETE-006. NC2464.2 +092300 PERFORM DE-LETE. NC2464.2 +092400 PERFORM PRINT-DETAIL. NC2464.2 +092500* NC2464.2 +092600 QUAL-INIT-07. NC2464.2 +092700 MOVE "QUAL-TEST-07" TO PAR-NAME. NC2464.2 +092800 MOVE "THREE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +092900 MOVE ZERO TO REC-CT. NC2464.2 +093000* NC2464.2 +093100* THIS TEST CONTAINS QUALIFIED DATA NAMES WITH NC2464.2 +093200* QUALIFIED SUBSCRIPTS IN IF STATEMENTS. THE DATA NAMES NC2464.2 +093300* REFER TO THREE DIMENSIONAL TABLE ITEMS. NC2464.2 +093400* NC2464.2 +093500 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +093600* NC2464.2 +093700 QUAL-TEST-07-01. NC2464.2 +093800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +093900 IF TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +094000 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +094100 IN GROUP-3-TABLE (SUB3 IN SUBSCRIPTS IN NC2464.2 +094200 SUBSCRIPTS-PART1 SUB3 OF SUBSCRIPTS OF NC2464.2 +094300 SUBSCRIPTS-PART1 SUB1 OF SOME-MORE-SUBSCRIPTS OF NC2464.2 +094400 SUBSCRIPTS-PART1) IS EQUAL TO "C" NC2464.2 +094500 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +094600 PERFORM SECT-TH220-0003. NC2464.2 +094700* NC2464.2 +094800 QUAL-TEST-07-02. NC2464.2 +094900 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +095000 IF TABLE-ITEM OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +095100 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +095200 OF GROUP-3-TABLE (SUB3 IN SUBSCRIPTS IN NC2464.2 +095300 SUB-PART2-LEVEL4 OF SUB-PART2-LEVEL3 OF NC2464.2 +095400 SUB-PART2-LEVEL2 OF SUBSCRIPTS-PART2 SUB3 IN NC2464.2 +095500 SUBSCRIPTS IN SUB-PART2-LEVEL4 OF SUB-PART2-LEVEL3 NC2464.2 +095600 IN SUB-PART2-LEVEL2 OF SUBSCRIPTS-PART2 SUB1 OF NC2464.2 +095700 SOME-MORE-SUBSCRIPTS OF SUB-PART2-LEVEL2 NC2464.2 +095800 IN SUBSCRIPTS-PART2) NC2464.2 +095900 IS EQUAL TO TABLE-ITEM OF TABLE-LEVEL-5 IN NC2464.2 +096000 TABLE-LEVEL-4 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +096100 IN GROUP-3-TABLE (SUB3 OF SUBSCRIPTS IN NC2464.2 +096200 SUBSCRIPTS-PART1 SUB3 OF SUBSCRIPTS IN NC2464.2 +096300 SUB-PART2-LEVEL4 OF SUB-PART2-LEVEL3 NC2464.2 +096400 OF SUB-PART2-LEVEL2 OF SUBSCRIPTS-PART2 SUB1 NC2464.2 +096500 OF SOME-MORE-SUBSCRIPTS OF SUBSCRIPTS-PART1) NC2464.2 +096600 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +096700 PERFORM SECT-TH220-0003. NC2464.2 +096800 GO TO QUAL-INIT-08. NC2464.2 +096900* NC2464.2 +097000 QUAL-DELETE-007. NC2464.2 +097100 PERFORM DE-LETE. NC2464.2 +097200 PERFORM PRINT-DETAIL. NC2464.2 +097300* NC2464.2 +097400 QUAL-INIT-08. NC2464.2 +097500 MOVE "QUAL-TEST-08" TO PAR-NAME. NC2464.2 +097600 MOVE "QUAL. CONDITION NAME" TO FEATURE. NC2464.2 +097700 MOVE ZERO TO REC-CT. NC2464.2 +097800 MOVE "ONE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +097900* NC2464.2 +098000* THIS TEST CONTAINS QUALIFIED CONDITION NAMES IN IF NC2464.2 +098100* STATEMENTS. THE CONDITION NAMES REFER TO SINGLE DIMENSIONAL NC2464.2 +098200* CONDITIONAL VARIABLES. THE SUBSCRIPTS IN THIS TEST ARE NC2464.2 +098300* CONSTANTS, UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT NC2464.2 +098400* AND RELATIVE INDEXING ARE USED. NC2464.2 +098500* NC2464.2 +098600 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +098700* NC2464.2 +098800 QUAL-TEST-08-01. NC2464.2 +098900 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +099000 IF EQUALS-M OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +099100 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +099200 OF GROUP-1-TABLE (13) NC2464.2 +099300 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +099400 PERFORM SECT-TH220-0003. NC2464.2 +099500* NC2464.2 +099600 QUAL-TEST-08-02. NC2464.2 +099700 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +099800 IF EQUALS-A OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +099900 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +100000 OF GROUP-1-TABLE (FIRST-SUB) NC2464.2 +100100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +100200 PERFORM SECT-TH220-0003. NC2464.2 +100300* NC2464.2 +100400 QUAL-TEST-08-03. NC2464.2 +100500 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +100600 SET IN1 TO 3. NC2464.2 +100700 IF EQUALS-C OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +100800 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +100900 OF GROUP-1-TABLE (IN1) NC2464.2 +101000 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +101100 PERFORM SECT-TH220-0003. NC2464.2 +101200* NC2464.2 +101300 QUAL-TEST-08-04. NC2464.2 +101400 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +101500 SET IN1 TO 6. NC2464.2 +101600 IF EQUALS-A OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +101700 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +101800 OF GROUP-1-TABLE (IN1 - 5) NC2464.2 +101900 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +102000 PERFORM SECT-TH220-0003. NC2464.2 +102100* NC2464.2 +102200 QUAL-TEST-08-05. NC2464.2 +102300 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +102400 SET IN1 TO 1. NC2464.2 +102500 IF EQUALS-C OF TABLE-LEVEL-5 OF TABLE-LEVEL-4 NC2464.2 +102600 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +102700 OF GROUP-1-TABLE (IN1 + 2) NC2464.2 +102800 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +102900 PERFORM SECT-TH220-0003. NC2464.2 +103000 GO TO QUAL-INIT-09. NC2464.2 +103100* NC2464.2 +103200 QUAL-DELETE-008. NC2464.2 +103300 PERFORM DE-LETE. NC2464.2 +103400 PERFORM PRINT-DETAIL. NC2464.2 +103500* NC2464.2 +103600 QUAL-INIT-09. NC2464.2 +103700 MOVE "QUAL-TEST-09" TO PAR-NAME. NC2464.2 +103800 MOVE ZERO TO REC-CT. NC2464.2 +103900 MOVE "THREE DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +104000* NC2464.2 +104100* THIS TEST CONTAINS QUALIFIED CONDITION NAMES IN IF NC2464.2 +104200* STATEMENTS. THE CONDITION NAMES REFER TO THREE DIMENSIONAL NC2464.2 +104300* CONDITIONAL VARIABLES. THE SUBSCRIPTS IN THIS TEST ARE NC2464.2 +104400* CONSTANTS, UNQUALIFIED DATA NAMES AND INDEXES. BOTH DIRECT NC2464.2 +104500* AND RELATIVE INDEXING ARE USED. NC2464.2 +104600* NC2464.2 +104700 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +104800* NC2464.2 +104900 QUAL-TEST-09-01. NC2464.2 +105000 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +105100 IF EQUALS-M OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +105200 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +105300 OF GROUP-3-TABLE (2, 2, 1) NC2464.2 +105400 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +105500 PERFORM SECT-TH220-0003. NC2464.2 +105600* NC2464.2 +105700 QUAL-TEST-09-02. NC2464.2 +105800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +105900 IF EQUALS-A OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +106000 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +106100 OF GROUP-3-TABLE (FIRST-SUB, FIRST-SUB, FIRST-SUB) NC2464.2 +106200 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +106300 PERFORM SECT-TH220-0003. NC2464.2 +106400* NC2464.2 +106500 QUAL-TEST-09-03. NC2464.2 +106600 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +106700 SET IN5 TO 3. NC2464.2 +106800 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +106900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +107000 OF GROUP-3-TABLE (1, 1, IN5) NC2464.2 +107100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +107200 PERFORM SECT-TH220-0003. NC2464.2 +107300* NC2464.2 +107400 QUAL-TEST-09-04. NC2464.2 +107500 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +107600 SET IN3, IN4 TO 1. NC2464.2 +107700 SET IN5 TO 3. NC2464.2 +107800 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +107900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +108000 OF GROUP-3-TABLE (IN3, IN4, IN5) NC2464.2 +108100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +108200 PERFORM SECT-TH220-0003. NC2464.2 +108300* NC2464.2 +108400 QUAL-TEST-09-05. NC2464.2 +108500 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +108600 SET IN5 TO 1. NC2464.2 +108700 SET IN3, IN4 TO 2. NC2464.2 +108800 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +108900 IN TABLE-LEVEL-3 IN TABLE-LEVEL-2 NC2464.2 +109000 OF GROUP-3-TABLE (IN3 - 1, IN4 - 1, IN5 + 2) NC2464.2 +109100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +109200 PERFORM SECT-TH220-0003. NC2464.2 +109300 GO TO QUAL-INIT-10. NC2464.2 +109400* NC2464.2 +109500 QUAL-DELETE-009. NC2464.2 +109600 PERFORM DE-LETE. NC2464.2 +109700 PERFORM PRINT-DETAIL. NC2464.2 +109800* NC2464.2 +109900 QUAL-INIT-10. NC2464.2 +110000 MOVE "QUAL-TEST-10" TO PAR-NAME. NC2464.2 +110100 MOVE "QUALIFIED SUBSCRIPTS" TO RE-MARK. NC2464.2 +110200 MOVE ZERO TO REC-CT. NC2464.2 +110300* NC2464.2 +110400* THIS TEST CONTAINS QUALIFIED CONDITION NAMES WITH NC2464.2 +110500* QUALIFIED SUBSCRIPTS. NC2464.2 +110600* NC2464.2 +110700 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +110800* NC2464.2 +110900 QUAL-TEST-10-01. NC2464.2 +111000 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +111100 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +111200 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +111300 IN GROUP-1-TABLE (SUB1 OF SOME-MORE-SUBSCRIPTS NC2464.2 +111400 IN SUBSCRIPTS-PART1) NC2464.2 +111500 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +111600 PERFORM SECT-TH220-0003. NC2464.2 +111700* NC2464.2 +111800 QUAL-TEST-10-02. NC2464.2 +111900 IF NOT EQUALS-M OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +112000 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +112100 IN GROUP-2-TABLE (SUB2 OF SUBSCRIPTS NC2464.2 +112200 OF SUB-PART2-LEVEL4 OF SUB-PART2-LEVEL3 NC2464.2 +112300 OF SUB-PART2-LEVEL2 OF SUBSCRIPTS-PART2) NC2464.2 +112400 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +112500 PERFORM SECT-TH220-0003. NC2464.2 +112600* NC2464.2 +112700 QUAL-TEST-10-03. NC2464.2 +112800 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +112900 IF EQUALS-C OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +113000 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +113100 IN GROUP-3-TABLE (SUB3 OF SUBSCRIPTS OF NC2464.2 +113200 SUB-PART2-LEVEL4 IN SUB-PART2-LEVEL3 IN NC2464.2 +113300 SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2, NC2464.2 +113400 SUB3 IN SUBSCRIPTS IN SUBSCRIPTS-PART1, NC2464.2 +113500 SUB1 IN SOME-MORE-SUBSCRIPTS IN SUB-PART2-LEVEL2 NC2464.2 +113600 IN SUBSCRIPTS-PART2) NC2464.2 +113700 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +113800 PERFORM SECT-TH220-0003. NC2464.2 +113900* NC2464.2 +114000 QUAL-TEST-10-04. NC2464.2 +114100 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +114200 IF NOT EQUALS-A OF TABLE-LEVEL-5 IN TABLE-LEVEL-4 NC2464.2 +114300 IN TABLE-LEVEL-3 OF TABLE-LEVEL-2 NC2464.2 +114400 IN GROUP-3-TABLE (SUB3 OF SUBSCRIPTS OF NC2464.2 +114500 SUB-PART2-LEVEL4 IN SUB-PART2-LEVEL3 IN NC2464.2 +114600 SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2, NC2464.2 +114700 SUB3 IN SUBSCRIPTS OF SUB-PART2-LEVEL4 OF NC2464.2 +114800 SUB-PART2-LEVEL3 IN SUB-PART2-LEVEL2 IN NC2464.2 +114900 SUBSCRIPTS-PART2, SUB1 OF SOME-MORE-SUBSCRIPTS NC2464.2 +115000 OF SUB-PART2-LEVEL2 IN SUBSCRIPTS-PART2) NC2464.2 +115100 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +115200 PERFORM SECT-TH220-0003. NC2464.2 +115300 GO TO QUAL-INIT-11. NC2464.2 +115400* NC2464.2 +115500 QUAL-DELETE-010. NC2464.2 +115600 PERFORM DE-LETE. NC2464.2 +115700 PERFORM PRINT-DETAIL. NC2464.2 +115800* NC2464.2 +115900 QUAL-INIT-11. NC2464.2 +116000 MOVE "QUAL-TEST-11" TO PAR-NAME. NC2464.2 +116100 MOVE "QUALIFICATION" TO FEATURE. NC2464.2 +116200 MOVE "INTERMEDIATE LEVELS SKIPPED" TO RE-MARK. NC2464.2 +116300 MOVE SPACE TO TEMP-VALUE. NC2464.2 +116400 MOVE ZERO TO REC-CT. NC2464.2 +116500* NC2464.2 +116600* THIS TEST USES QUALIFIED DATA NAMES WITHOUT ALL OF THE NC2464.2 +116700* INTERMEDIATE LEVELS SPECIFIED. THERE ARE QUALIFIED TABLE NC2464.2 +116800* ITEMS AND QUALIFIED SUBSCRIPTS INCLUDED IN THE TEST NC2464.2 +116900* STATEMENTS. NC2464.2 +117000* NC2464.2 +117100 MOVE "G" TO EXPECTED-VALUE. NC2464.2 +117200* NC2464.2 +117300 QUAL-TEST-11-01. NC2464.2 +117400 MOVE TABLE-ITEM OF TABLE-LEVEL-5 OF GROUP-1-TABLE (7) NC2464.2 +117500 TO TEMP-VALUE. NC2464.2 +117600 PERFORM SECT-TH220-0003. NC2464.2 +117700* NC2464.2 +117800 QUAL-TEST-11-02. NC2464.2 +117900 MOVE UNQUAL-ITEM (SUB2 OF SOME-MORE-SUBSCRIPTS OF NC2464.2 +118000 SUBSCRIPTS-PART2) TO TEMP-VALUE. NC2464.2 +118100 PERFORM SECT-TH220-0003. NC2464.2 +118200* NC2464.2 +118300 QUAL-TEST-11-03. NC2464.2 +118400 MOVE TABLE-ITEM OF GROUP-1-TABLE (SUB2 OF NC2464.2 +118500 SOME-MORE-SUBSCRIPTS OF SUB-PART2-LEVEL2) TO TEMP-VALUE. NC2464.2 +118600 PERFORM SECT-TH220-0003. NC2464.2 +118700* NC2464.2 +118800 QUAL-TEST-11-04. NC2464.2 +118900 MOVE "A" TO EXPECTED-VALUE. NC2464.2 +119000 MOVE TABLE-ITEM OF GROUP-3-TABLE (FIRST-SUB, SUB3 OF NC2464.2 +119100 SUBSCRIPTS OF SUBSCRIPTS-PART1, SUB3 OF NC2464.2 +119200 SUB-PART2-LEVEL4) TO TEMP-VALUE. NC2464.2 +119300 PERFORM SECT-TH220-0003. NC2464.2 +119400* NC2464.2 +119500 QUAL-TEST-11-05. NC2464.2 +119600 MOVE "TRUE" TO EXPECTED-VALUE. NC2464.2 +119700 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +119800 SET IN1 TO 3. NC2464.2 +119900 IF EQUALS-C OF TABLE-ITEM OF GROUP-1-TABLE (IN1) NC2464.2 +120000 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +120100 PERFORM SECT-TH220-0003. NC2464.2 +120200* NC2464.2 +120300 QUAL-TEST-11-06. NC2464.2 +120400 MOVE "FALSE" TO TEMP-VALUE. NC2464.2 +120500 IF EQUALS-C OF TABLE-ITEM OF GROUP-3-TABLE NC2464.2 +120600 (FIRST-SUB, SUB3 OF SUB-PART2-LEVEL3, SUB1 OF NC2464.2 +120700 SOME-MORE-SUBSCRIPTS OF SUBSCRIPTS-PART2) NC2464.2 +120800 MOVE "TRUE" TO TEMP-VALUE. NC2464.2 +120900 PERFORM SECT-TH220-0003. NC2464.2 +121000 GO TO QUAL-INIT-12. NC2464.2 +121100 QUAL-DELETE-011. NC2464.2 +121200 PERFORM DE-LETE. NC2464.2 +121300 PERFORM PRINT-DETAIL. NC2464.2 +121400* NC2464.2 +121500 QUAL-INIT-12. NC2464.2 +121600 MOVE "IV-21 4.3.8.2.3 SR5 AND VI-2 1.3.2/4" NC2464.2 +121700 TO ANSI-REFERENCE. NC2464.2 +121800 MOVE "QUAL-TEST-12" TO PAR-NAME. NC2464.2 +121900 MOVE "SEVEN DIMENSIONAL TABLE" TO RE-MARK. NC2464.2 +122000 MOVE ZEROES TO TABLE-A NC2464.2 +122100 TABLE-B. NC2464.2 +122200 MOVE 27 TO ELEM1 OF L8 IN L7 IN L6 IN L5 IN L4 IN L3 NC2464.2 +122300 IN L2 OF TABLE-A (1, 2, 1, 2, 1, 1, 2). NC2464.2 +122400 GO TO QUAL-TEST-12. NC2464.2 +122500 QUAL-DELETE-12. NC2464.2 +122600 PERFORM DE-LETE. NC2464.2 +122700 PERFORM PRINT-DETAIL. NC2464.2 +122800 GO TO CCVS-EXIT. NC2464.2 +122900 QUAL-TEST-12. NC2464.2 +123000 IF ELEM1 OF L8 IN L7 OF L6 OF L5 IN L4 IN L3 OF L2 NC2464.2 +123100 IN TABLE-A NC2464.2 +123200 (SUB1 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +123300 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +123400 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +123500 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +123600 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +123700 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +123800 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +123900 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +124000 IN SUBSCRIPTS-GROUP-1, NC2464.2 +124100 SUB2 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +124200 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +124300 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +124400 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +124500 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +124600 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +124700 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +124800 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +124900 OF SUBSCRIPTS-GROUP-2, NC2464.2 +125000 SUB3 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +125100 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +125200 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +125300 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +125400 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +125500 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +125600 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +125700 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +125800 IN SUBSCRIPTS-GROUP-1, NC2464.2 +125900 SUB4 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +126000 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +126100 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +126200 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +126300 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +126400 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +126500 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +126600 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +126700 OF SUBSCRIPTS-GROUP-2, NC2464.2 +126800 SUB5 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +126900 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +127000 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +127100 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +127200 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +127300 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +127400 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +127500 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +127600 IN SUBSCRIPTS-GROUP-1, NC2464.2 +127700 SUB6 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +127800 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +127900 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +128000 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +128100 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +128200 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +128300 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +128400 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +128500 IN SUBSCRIPTS-GROUP-1, NC2464.2 +128600 SUB7 OF S48 IN S47 OF S46 IN S45 OF S44 IN S43 NC2464.2 +128700 OF S42 IN S41 OF S40 IN S39 OF S38 IN S37 NC2464.2 +128800 OF S36 IN S35 OF S34 IN S33 OF S32 IN S31 NC2464.2 +128900 OF S30 IN S29 OF S28 IN S27 OF S26 IN S25 NC2464.2 +129000 OF S24 IN S23 OF S22 IN S21 OF S20 IN S19 NC2464.2 +129100 OF S18 IN S17 OF S16 IN S15 OF S14 IN S13 NC2464.2 +129200 OF S12 IN S11 OF S10 IN SO9 OF SO8 IN SO7 NC2464.2 +129300 OF SO6 IN SO5 OF SO4 IN SO3 OF SO2 NC2464.2 +129400 OF SUBSCRIPTS-GROUP-2) NC2464.2 +129500 = 27 NC2464.2 +129600 PERFORM PASS NC2464.2 +129700 PERFORM PRINT-DETAIL NC2464.2 +129800 ELSE NC2464.2 +129900 MOVE "QUALIFICATION FAILED" TO RE-MARK NC2464.2 +130000 PERFORM FAIL NC2464.2 +130100 PERFORM PRINT-DETAIL. NC2464.2 +130200* NC2464.2 +130300 GO TO CCVS-EXIT. NC2464.2 +130400* NC2464.2 +130500 SECT-TH220-0003 SECTION. NC2464.2 +130600 SYNTAX-CHECK. NC2464.2 +130700 ADD 1 TO REC-CT. NC2464.2 +130800 IF TEMP-VALUE IS EQUAL TO EXPECTED-VALUE NC2464.2 +130900 PERFORM PASS NC2464.2 +131000 GO TO SYNTAX-CHECK-WRITE. NC2464.2 +131100 SYNTAX-FAIL. NC2464.2 +131200 MOVE TEMP-VALUE TO COMPUTED-A. NC2464.2 +131300 MOVE EXPECTED-VALUE TO CORRECT-A. NC2464.2 +131400 PERFORM FAIL. NC2464.2 +131500 SYNTAX-CHECK-WRITE. NC2464.2 +131600 PERFORM PRINT-DETAIL. NC2464.2 +131700 MOVE SPACE TO TEMP-VALUE. NC2464.2 +131800 CCVS-EXIT SECTION. NC2464.2 +131900 CCVS-999999. NC2464.2 +132000 GO TO CLOSE-FILES. NC2464.2 diff --git a/tests/cobol85/NC/NC247A.CBL b/tests/cobol85/NC/NC247A.CBL new file mode 100755 index 00000000..f1a85839 --- /dev/null +++ b/tests/cobol85/NC/NC247A.CBL @@ -0,0 +1,864 @@ +000100 IDENTIFICATION DIVISION. NC2474.2 +000200 PROGRAM-ID. NC2474.2 +000300 NC247A. NC2474.2 +000400**************************************************************** NC2474.2 +000500* * NC2474.2 +000600* VALIDATION FOR:- * NC2474.2 +000700* * NC2474.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2474.2 +000900* * NC2474.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2474.2 +001100* * NC2474.2 +001200**************************************************************** NC2474.2 +001300* * NC2474.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2474.2 +001500* * NC2474.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2474.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2474.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2474.2 +001900* * NC2474.2 +002000**************************************************************** NC2474.2 +002100* NC2474.2 +002200* NC2474.2 +002300* PROGRAM NC247A TESTS FORMAT2 OF THE "OCCURS" CLAUSE TO * NC2474.2 +002400* VERIFY THAT THE NUMBER OF TABLE OCCURRENCES CARIES * NC2474.2 +002500* ACCORDING TO THE CURRENT VALUE OF THE IDENTIDIER ON WHICH * NC2474.2 +002600* IT DEPENDS. * NC2474.2 +002700* * NC2474.2 +002800**************************************************************** NC2474.2 +002900 ENVIRONMENT DIVISION. NC2474.2 +003000 CONFIGURATION SECTION. NC2474.2 +003100 SOURCE-COMPUTER. NC2474.2 +003200 Linux. NC2474.2 +003300 OBJECT-COMPUTER. NC2474.2 +003400 Linux. NC2474.2 +003500 INPUT-OUTPUT SECTION. NC2474.2 +003600 FILE-CONTROL. NC2474.2 +003700 SELECT PRINT-FILE ASSIGN TO NC2474.2 +003800 "report.log". NC2474.2 +003900 DATA DIVISION. NC2474.2 +004000 FILE SECTION. NC2474.2 +004100 FD PRINT-FILE. NC2474.2 +004200 01 PRINT-REC PICTURE X(120). NC2474.2 +004300 01 DUMMY-RECORD PICTURE X(120). NC2474.2 +004400 WORKING-STORAGE SECTION. NC2474.2 +004500 01 ODO-RECORD. NC2474.2 +004600 02 FILLER PIC X(120). NC2474.2 +004700 02 GRP-ODO. NC2474.2 +004800 03 DOI-DU-01V00 PIC 9. NC2474.2 +004900 03 ODO-XN-00009 PIC X(9). NC2474.2 +005000 03 ODO-GRP-00009. NC2474.2 +005100 04 ODO-XN-00001-O009D OCCURS 0 TO 9 TIMES DEPENDING ON NC2474.2 +005200 DOI-DU-01V00 ASCENDING KEY ODO-XN-00001-O009D NC2474.2 +005300 INDEXED BY ODO-IX PIC X. NC2474.2 +005400 01 NEW-RECORD. NC2474.2 +005500 02 FILLER PIC X(120). NC2474.2 +005600 02 NEW-ODO. NC2474.2 +005700 03 NEW-DU-01V00 PIC 9. NC2474.2 +005800 03 NEW-XN-00009 PIC X(9). NC2474.2 +005900 03 NEW-GRP-00009. NC2474.2 +006000 04 NEW-XN-00001-O009D OCCURS 0 TO 9 TIMES DEPENDING ON NC2474.2 +006100 NEW-DU-01V00 ASCENDING KEY NEW-XN-00001-O009D NC2474.2 +006200 INDEXED BY NEW-IX PIC X. NC2474.2 +006300 01 STATIC-VALUE. NC2474.2 +006400 02 FILLER PIC 9 VALUE 9. NC2474.2 +006500 02 FILLER PIC X(18) VALUE " ACTIVE: 123456789". NC2474.2 +006600 01 WRK-GRP-00019. NC2474.2 +006700 02 WRK-DU-01V00 PIC 9. NC2474.2 +006800 02 WRK-XN-00009-1 PIC X(9). NC2474.2 +006900 02 WRK-XN-00009-2 PIC X(9). NC2474.2 +007000 01 WRK-DU-05V00 PIC 9(5). NC2474.2 +007100 01 WRK-XN-00020 PIC X(20). NC2474.2 +007200 01 WRK-XN-00010 PIC X(10). NC2474.2 +007300 01 WRK-XN-00001 PIC X. NC2474.2 +007400 01 TEST-RESULTS. NC2474.2 +007500 02 FILLER PIC X VALUE SPACE. NC2474.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. NC2474.2 +007700 02 FILLER PIC X VALUE SPACE. NC2474.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. NC2474.2 +007900 02 FILLER PIC X VALUE SPACE. NC2474.2 +008000 02 PAR-NAME. NC2474.2 +008100 03 FILLER PIC X(19) VALUE SPACE. NC2474.2 +008200 03 PARDOT-X PIC X VALUE SPACE. NC2474.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. NC2474.2 +008400 02 FILLER PIC X(8) VALUE SPACE. NC2474.2 +008500 02 RE-MARK PIC X(61). NC2474.2 +008600 01 TEST-COMPUTED. NC2474.2 +008700 02 FILLER PIC X(30) VALUE SPACE. NC2474.2 +008800 02 FILLER PIC X(17) VALUE NC2474.2 +008900 " COMPUTED=". NC2474.2 +009000 02 COMPUTED-X. NC2474.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2474.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A NC2474.2 +009300 PIC -9(9).9(9). NC2474.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2474.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2474.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2474.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. NC2474.2 +009800 04 COMPUTED-18V0 PIC -9(18). NC2474.2 +009900 04 FILLER PIC X. NC2474.2 +010000 03 FILLER PIC X(50) VALUE SPACE. NC2474.2 +010100 01 TEST-CORRECT. NC2474.2 +010200 02 FILLER PIC X(30) VALUE SPACE. NC2474.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". NC2474.2 +010400 02 CORRECT-X. NC2474.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. NC2474.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2474.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2474.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2474.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2474.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. NC2474.2 +011100 04 CORRECT-18V0 PIC -9(18). NC2474.2 +011200 04 FILLER PIC X. NC2474.2 +011300 03 FILLER PIC X(2) VALUE SPACE. NC2474.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2474.2 +011500 01 CCVS-C-1. NC2474.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2474.2 +011700- "SS PARAGRAPH-NAME NC2474.2 +011800- " REMARKS". NC2474.2 +011900 02 FILLER PIC X(20) VALUE SPACE. NC2474.2 +012000 01 CCVS-C-2. NC2474.2 +012100 02 FILLER PIC X VALUE SPACE. NC2474.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". NC2474.2 +012300 02 FILLER PIC X(15) VALUE SPACE. NC2474.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". NC2474.2 +012500 02 FILLER PIC X(94) VALUE SPACE. NC2474.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2474.2 +012700 01 REC-CT PIC 99 VALUE ZERO. NC2474.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2474.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2474.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2474.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2474.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2474.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2474.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2474.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2474.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2474.2 +013700 01 CCVS-H-1. NC2474.2 +013800 02 FILLER PIC X(39) VALUE SPACES. NC2474.2 +013900 02 FILLER PIC X(42) VALUE NC2474.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2474.2 +014100 02 FILLER PIC X(39) VALUE SPACES. NC2474.2 +014200 01 CCVS-H-2A. NC2474.2 +014300 02 FILLER PIC X(40) VALUE SPACE. NC2474.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2474.2 +014500 02 FILLER PIC XXXX VALUE NC2474.2 +014600 "4.2 ". NC2474.2 +014700 02 FILLER PIC X(28) VALUE NC2474.2 +014800 " COPY - NOT FOR DISTRIBUTION". NC2474.2 +014900 02 FILLER PIC X(41) VALUE SPACE. NC2474.2 +015000 NC2474.2 +015100 01 CCVS-H-2B. NC2474.2 +015200 02 FILLER PIC X(15) VALUE NC2474.2 +015300 "TEST RESULT OF ". NC2474.2 +015400 02 TEST-ID PIC X(9). NC2474.2 +015500 02 FILLER PIC X(4) VALUE NC2474.2 +015600 " IN ". NC2474.2 +015700 02 FILLER PIC X(12) VALUE NC2474.2 +015800 " HIGH ". NC2474.2 +015900 02 FILLER PIC X(22) VALUE NC2474.2 +016000 " LEVEL VALIDATION FOR ". NC2474.2 +016100 02 FILLER PIC X(58) VALUE NC2474.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2474.2 +016300 01 CCVS-H-3. NC2474.2 +016400 02 FILLER PIC X(34) VALUE NC2474.2 +016500 " FOR OFFICIAL USE ONLY ". NC2474.2 +016600 02 FILLER PIC X(58) VALUE NC2474.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2474.2 +016800 02 FILLER PIC X(28) VALUE NC2474.2 +016900 " COPYRIGHT 1985 ". NC2474.2 +017000 01 CCVS-E-1. NC2474.2 +017100 02 FILLER PIC X(52) VALUE SPACE. NC2474.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2474.2 +017300 02 ID-AGAIN PIC X(9). NC2474.2 +017400 02 FILLER PIC X(45) VALUE SPACES. NC2474.2 +017500 01 CCVS-E-2. NC2474.2 +017600 02 FILLER PIC X(31) VALUE SPACE. NC2474.2 +017700 02 FILLER PIC X(21) VALUE SPACE. NC2474.2 +017800 02 CCVS-E-2-2. NC2474.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2474.2 +018000 03 FILLER PIC X VALUE SPACE. NC2474.2 +018100 03 ENDER-DESC PIC X(44) VALUE NC2474.2 +018200 "ERRORS ENCOUNTERED". NC2474.2 +018300 01 CCVS-E-3. NC2474.2 +018400 02 FILLER PIC X(22) VALUE NC2474.2 +018500 " FOR OFFICIAL USE ONLY". NC2474.2 +018600 02 FILLER PIC X(12) VALUE SPACE. NC2474.2 +018700 02 FILLER PIC X(58) VALUE NC2474.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2474.2 +018900 02 FILLER PIC X(13) VALUE SPACE. NC2474.2 +019000 02 FILLER PIC X(15) VALUE NC2474.2 +019100 " COPYRIGHT 1985". NC2474.2 +019200 01 CCVS-E-4. NC2474.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2474.2 +019400 02 FILLER PIC X(4) VALUE " OF ". NC2474.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2474.2 +019600 02 FILLER PIC X(40) VALUE NC2474.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". NC2474.2 +019800 01 XXINFO. NC2474.2 +019900 02 FILLER PIC X(19) VALUE NC2474.2 +020000 "*** INFORMATION ***". NC2474.2 +020100 02 INFO-TEXT. NC2474.2 +020200 04 FILLER PIC X(8) VALUE SPACE. NC2474.2 +020300 04 XXCOMPUTED PIC X(20). NC2474.2 +020400 04 FILLER PIC X(5) VALUE SPACE. NC2474.2 +020500 04 XXCORRECT PIC X(20). NC2474.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). NC2474.2 +020700 01 HYPHEN-LINE. NC2474.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. NC2474.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************NC2474.2 +021000- "*****************************************". NC2474.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************NC2474.2 +021200- "******************************". NC2474.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE NC2474.2 +021400 "NC247A". NC2474.2 +021500 PROCEDURE DIVISION. NC2474.2 +021600 CCVS1 SECTION. NC2474.2 +021700 OPEN-FILES. NC2474.2 +021800 OPEN OUTPUT PRINT-FILE. NC2474.2 +021900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2474.2 +022000 MOVE SPACE TO TEST-RESULTS. NC2474.2 +022100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2474.2 +022200 GO TO CCVS1-EXIT. NC2474.2 +022300 CLOSE-FILES. NC2474.2 +022400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2474.2 +022500 TERMINATE-CCVS. NC2474.2 +022600*S EXIT PROGRAM. NC2474.2 +022700*SERMINATE-CALL. NC2474.2 +022800 STOP RUN. NC2474.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2474.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2474.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2474.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2474.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. NC2474.2 +023400 PRINT-DETAIL. NC2474.2 +023500 IF REC-CT NOT EQUAL TO ZERO NC2474.2 +023600 MOVE "." TO PARDOT-X NC2474.2 +023700 MOVE REC-CT TO DOTVALUE. NC2474.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2474.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2474.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2474.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2474.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2474.2 +024300 MOVE SPACE TO CORRECT-X. NC2474.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2474.2 +024500 MOVE SPACE TO RE-MARK. NC2474.2 +024600 HEAD-ROUTINE. NC2474.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2474.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2474.2 +025100 COLUMN-NAMES-ROUTINE. NC2474.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +025500 END-ROUTINE. NC2474.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2474.2 +025700 END-RTN-EXIT. NC2474.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +025900 END-ROUTINE-1. NC2474.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2474.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2474.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. NC2474.2 +026300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2474.2 +026400 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2474.2 +026500 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2474.2 +026600 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2474.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2474.2 +026800 END-ROUTINE-12. NC2474.2 +026900 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2474.2 +027000 IF ERROR-COUNTER IS EQUAL TO ZERO NC2474.2 +027100 MOVE "NO " TO ERROR-TOTAL NC2474.2 +027200 ELSE NC2474.2 +027300 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2474.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2474.2 +027500 PERFORM WRITE-LINE. NC2474.2 +027600 END-ROUTINE-13. NC2474.2 +027700 IF DELETE-COUNTER IS EQUAL TO ZERO NC2474.2 +027800 MOVE "NO " TO ERROR-TOTAL ELSE NC2474.2 +027900 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2474.2 +028000 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2474.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +028200 IF INSPECT-COUNTER EQUAL TO ZERO NC2474.2 +028300 MOVE "NO " TO ERROR-TOTAL NC2474.2 +028400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2474.2 +028500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2474.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +028700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2474.2 +028800 WRITE-LINE. NC2474.2 +028900 ADD 1 TO RECORD-COUNT. NC2474.2 +029000 IF RECORD-COUNT GREATER 50 NC2474.2 +029100 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2474.2 +029200 MOVE SPACE TO DUMMY-RECORD NC2474.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2474.2 +029400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2474.2 +029500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2474.2 +029600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2474.2 +029700 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2474.2 +029800 MOVE ZERO TO RECORD-COUNT. NC2474.2 +029900 PERFORM WRT-LN. NC2474.2 +030000 WRT-LN. NC2474.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2474.2 +030200 MOVE SPACE TO DUMMY-RECORD. NC2474.2 +030300 BLANK-LINE-PRINT. NC2474.2 +030400 PERFORM WRT-LN. NC2474.2 +030500 FAIL-ROUTINE. NC2474.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2474.2 +030700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2474.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2474.2 +030900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2474.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2474.2 +031200 GO TO FAIL-ROUTINE-EX. NC2474.2 +031300 FAIL-ROUTINE-WRITE. NC2474.2 +031400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2474.2 +031500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2474.2 +031600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2474.2 +031700 MOVE SPACES TO COR-ANSI-REFERENCE. NC2474.2 +031800 FAIL-ROUTINE-EX. EXIT. NC2474.2 +031900 BAIL-OUT. NC2474.2 +032000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2474.2 +032100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2474.2 +032200 BAIL-OUT-WRITE. NC2474.2 +032300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2474.2 +032400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2474.2 +032500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2474.2 +032600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2474.2 +032700 BAIL-OUT-EX. EXIT. NC2474.2 +032800 CCVS1-EXIT. NC2474.2 +032900 EXIT. NC2474.2 +033000 SECT-NC247A-001 SECTION. NC2474.2 +033100 INIT-WRK-AREA. NC2474.2 +033200 MOVE STATIC-VALUE TO WRK-GRP-00019. NC2474.2 +033300 MOVE 9 TO DOI-DU-01V00. NC2474.2 +033400 MOVE " ACTIVE: " TO ODO-XN-00009. NC2474.2 +033500 MOVE "1" TO ODO-XN-00001-O009D (1). NC2474.2 +033600 MOVE "2" TO ODO-XN-00001-O009D (2). NC2474.2 +033700 MOVE "3" TO ODO-XN-00001-O009D (3). NC2474.2 +033800 MOVE "4" TO ODO-XN-00001-O009D (4). NC2474.2 +033900 MOVE "5" TO ODO-XN-00001-O009D (5). NC2474.2 +034000 MOVE "6" TO ODO-XN-00001-O009D (6). NC2474.2 +034100 MOVE "7" TO ODO-XN-00001-O009D (7). NC2474.2 +034200 MOVE "8" TO ODO-XN-00001-O009D (8). NC2474.2 +034300 MOVE "9" TO ODO-XN-00001-O009D (9). NC2474.2 +034400* NC2474.2 +034500 IF-INIT-GF-1. NC2474.2 +034600 MOVE "IF-TEST-GF-1" TO PAR-NAME. NC2474.2 +034700 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +034800 MOVE "OCCURS DEPENDING ON" TO FEATURE. NC2474.2 +034900 MOVE STATIC-VALUE TO RE-MARK. NC2474.2 +035000 IF-TEST-GF-1. NC2474.2 +035100 IF STATIC-VALUE IS EQUAL TO GRP-ODO NC2474.2 +035200 PERFORM PASS NC2474.2 +035300 GO TO IF-WRITE-GF-1 NC2474.2 +035400 ELSE NC2474.2 +035500 GO TO IF-FAIL-GF-1. NC2474.2 +035600 IF-DELETE-GF-1. NC2474.2 +035700 PERFORM DE-LETE. NC2474.2 +035800 GO TO IF-WRITE-GF-1. NC2474.2 +035900 IF-FAIL-GF-1. NC2474.2 +036000 PERFORM FAIL NC2474.2 +036100 MOVE "CONDITION WAS EQUAL" TO CORRECT-A NC2474.2 +036200 MOVE "CONDITION NOT EQUAL" TO COMPUTED-A. NC2474.2 +036300 IF-WRITE-GF-1. NC2474.2 +036400 PERFORM PRINT-DETAIL. NC2474.2 +036500* NC2474.2 +036600 IF-INIT-GF-2. NC2474.2 +036700 MOVE WRK-GRP-00019 TO RE-MARK. NC2474.2 +036800 MOVE "IF-TEST-GF-2" TO PAR-NAME. NC2474.2 +036900 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +037000 PERFORM INIT-WRK-AREA. NC2474.2 +037100 MOVE 3 TO WRK-DU-01V00 DOI-DU-01V00 NC2474.2 +037200 MOVE "123 " TO WRK-XN-00009-2. NC2474.2 +037300 IF-TEST-GF-2. NC2474.2 +037400 IF GRP-ODO IS EQUAL TO WRK-GRP-00019 NC2474.2 +037500 PERFORM PASS NC2474.2 +037600 GO TO IF-WRITE-GF-2 NC2474.2 +037700 ELSE NC2474.2 +037800 GO TO IF-FAIL-GF-2. NC2474.2 +037900 IF-DELETE-GF-2. NC2474.2 +038000 PERFORM DE-LETE. NC2474.2 +038100 GO TO IF-WRITE-GF-2. NC2474.2 +038200 IF-FAIL-GF-2. NC2474.2 +038300 PERFORM FAIL NC2474.2 +038400 MOVE "CONDITION WAS EQUAL" TO CORRECT-A NC2474.2 +038500 MOVE "CONDITION NOT EQUAL" TO COMPUTED-A. NC2474.2 +038600 IF-WRITE-GF-2. NC2474.2 +038700 PERFORM PRINT-DETAIL. NC2474.2 +038800* NC2474.2 +038900 INS-INIT-F1-1. NC2474.2 +039000 MOVE "INS-TEST-F1-1" TO PAR-NAME. NC2474.2 +039100 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +039200 MOVE STATIC-VALUE TO RE-MARK. NC2474.2 +039300 PERFORM INIT-WRK-AREA. NC2474.2 +039400 MOVE 0 TO WRK-DU-05V00. NC2474.2 +039500 INS-TEST-F1-1. NC2474.2 +039600 INSPECT ODO-GRP-00009 TALLYING WRK-DU-05V00 FOR ALL "7". NC2474.2 +039700 IF WRK-DU-05V00 IS EQUAL TO 1 NC2474.2 +039800 PERFORM PASS NC2474.2 +039900 GO TO INS-WRITE-F1-1 NC2474.2 +040000 ELSE NC2474.2 +040100 GO TO INS-FAIL-F1-1. NC2474.2 +040200 INS-DELETE-F1-1. NC2474.2 +040300 PERFORM DE-LETE. NC2474.2 +040400 GO TO INS-WRITE-F1-1. NC2474.2 +040500 INS-FAIL-F1-1. NC2474.2 +040600 PERFORM FAIL NC2474.2 +040700 MOVE 1 TO CORRECT-18V0 NC2474.2 +040800 MOVE WRK-DU-05V00 TO COMPUTED-18V0. NC2474.2 +040900 INS-WRITE-F1-1. NC2474.2 +041000 PERFORM PRINT-DETAIL. NC2474.2 +041100* NC2474.2 +041200 INS-INIT-F1-2. NC2474.2 +041300 MOVE "INS-TEST-F1-2" TO PAR-NAME. NC2474.2 +041400 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +041500 PERFORM INIT-WRK-AREA. NC2474.2 +041600 MOVE 3 TO DOI-DU-01V00 WRK-DU-01V00 WRK-DU-05V00. NC2474.2 +041700 MOVE "123 " TO WRK-XN-00009-2. NC2474.2 +041800 MOVE 0 TO WRK-DU-05V00. NC2474.2 +041900 MOVE WRK-GRP-00019 TO RE-MARK. NC2474.2 +042000 INS-TEST-F1-2. NC2474.2 +042100 INSPECT ODO-GRP-00009 TALLYING WRK-DU-05V00 FOR ALL "7". NC2474.2 +042200 IF WRK-DU-05V00 IS EQUAL TO 0 NC2474.2 +042300 PERFORM PASS NC2474.2 +042400 GO TO INS-WRITE-F1-2 NC2474.2 +042500 ELSE NC2474.2 +042600 GO TO INS-FAIL-F1-2. NC2474.2 +042700 INS-DELETE-F1-2. NC2474.2 +042800 PERFORM DE-LETE. NC2474.2 +042900 GO TO INS-WRITE-F1-2. NC2474.2 +043000 INS-FAIL-F1-2. NC2474.2 +043100 PERFORM FAIL NC2474.2 +043200 MOVE 0 TO CORRECT-18V0 NC2474.2 +043300 MOVE WRK-DU-05V00 TO COMPUTED-18V0. NC2474.2 +043400 INS-WRITE-F1-2. NC2474.2 +043500 PERFORM PRINT-DETAIL. NC2474.2 +043600* NC2474.2 +043700 MOV-INIT-F1-1. NC2474.2 +043800 MOVE "MOV-TEST-F1-1" TO PAR-NAME. NC2474.2 +043900 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +044000 MOVE "FULL ODO + BASE SEGMENT SOURCE" TO RE-MARK. NC2474.2 +044100 PERFORM INIT-WRK-AREA. NC2474.2 +044200 MOVE SPACES TO WRK-GRP-00019. NC2474.2 +044300 MOVE GRP-ODO TO WRK-GRP-00019. NC2474.2 +044400 MOV-TEST-F1-1. NC2474.2 +044500 IF WRK-GRP-00019 IS EQUAL TO STATIC-VALUE NC2474.2 +044600 PERFORM PASS NC2474.2 +044700 GO TO MOV-WRITE-F1-1 NC2474.2 +044800 ELSE NC2474.2 +044900 GO TO MOV-FAIL-F1-1. NC2474.2 +045000 MOV-DELETE-F1-1. NC2474.2 +045100 PERFORM DE-LETE. NC2474.2 +045200 GO TO MOV-WRITE-F1-1. NC2474.2 +045300 MOV-FAIL-F1-1. NC2474.2 +045400 PERFORM FAIL NC2474.2 +045500 MOVE STATIC-VALUE TO CORRECT-A NC2474.2 +045600 MOVE WRK-GRP-00019 TO COMPUTED-A. NC2474.2 +045700 MOV-WRITE-F1-1. NC2474.2 +045800 PERFORM PRINT-DETAIL. NC2474.2 +045900* NC2474.2 +046000 MOV-INIT-F1-2. NC2474.2 +046100 MOVE "MOV-TEST-F1-2" TO PAR-NAME. NC2474.2 +046200 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +046300 MOVE "PART ODO + BASE SEGMENT SOURCE" TO RE-MARK. NC2474.2 +046400 PERFORM INIT-WRK-AREA. NC2474.2 +046500 MOVE SPACES TO WRK-GRP-00019. NC2474.2 +046600 MOVE 3 TO DOI-DU-01V00. NC2474.2 +046700 MOVE GRP-ODO TO WRK-GRP-00019. NC2474.2 +046800 MOV-TEST-F1-2. NC2474.2 +046900 IF WRK-GRP-00019 IS EQUAL TO "3 ACTIVE: 123 " NC2474.2 +047000 PERFORM PASS NC2474.2 +047100 GO TO MOV-WRITE-F1-2 NC2474.2 +047200 ELSE NC2474.2 +047300 GO TO MOV-FAIL-F1-2. NC2474.2 +047400 MOV-DELETE-F1-2. NC2474.2 +047500 PERFORM DE-LETE. NC2474.2 +047600 GO TO MOV-WRITE-F1-2. NC2474.2 +047700 MOV-FAIL-F1-2. NC2474.2 +047800 PERFORM FAIL NC2474.2 +047900 MOVE "3 ACTIVE: 123" TO CORRECT-A NC2474.2 +048000 MOVE WRK-GRP-00019 TO COMPUTED-A. NC2474.2 +048100 MOV-WRITE-F1-2. NC2474.2 +048200 PERFORM PRINT-DETAIL. NC2474.2 +048300* NC2474.2 +048400 MOV-INIT-F1-3. NC2474.2 +048500 MOVE "MOV-TEST-F1-3" TO PAR-NAME. NC2474.2 +048600 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +048700 MOVE "FULL ODO +BASE SEG RECEIVING" TO RE-MARK. NC2474.2 +048800 MOVE 9 TO DOI-DU-01V00. NC2474.2 +048900 MOVE "F" TO ODO-XN-00001-O009D (6). NC2474.2 +049000 MOVE "A" TO ODO-XN-00001-O009D (7). NC2474.2 +049100 MOVE "I" TO ODO-XN-00001-O009D (8). NC2474.2 +049200 MOVE "L" TO ODO-XN-00001-O009D (9). NC2474.2 +049300 MOVE "3 ACTIVE: TEST PASS" TO GRP-ODO. NC2474.2 +049400 MOVE 9 TO DOI-DU-01V00. NC2474.2 +049500 MOV-TEST-F1-3. NC2474.2 +049600 IF GRP-ODO IS EQUAL TO "9 ACTIVE: TEST PASS" NC2474.2 +049700 PERFORM PASS NC2474.2 +049800 GO TO MOV-WRITE-F1-3 NC2474.2 +049900 ELSE NC2474.2 +050000 GO TO MOV-FAIL-F1-3. NC2474.2 +050100 MOV-DELETE-F1-3. NC2474.2 +050200 PERFORM DE-LETE. NC2474.2 +050300 GO TO MOV-WRITE-F1-3. NC2474.2 +050400 MOV-FAIL-F1-3. NC2474.2 +050500 PERFORM FAIL NC2474.2 +050600 MOVE "9 ACTIVE: TEST PASS" TO CORRECT-A NC2474.2 +050700 MOVE GRP-ODO TO COMPUTED-A. NC2474.2 +050800 MOV-WRITE-F1-3. NC2474.2 +050900 PERFORM PRINT-DETAIL. NC2474.2 +051000* NC2474.2 +051100 MOV-INIT-F1-4. NC2474.2 +051200 MOVE "MOV-TEST-F1-4" TO PAR-NAME. NC2474.2 +051300 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +051400 MOVE "PART ODO + BASE SEG RECEIVING" TO RE-MARK. NC2474.2 +051500 MOVE 9 TO DOI-DU-01V00. NC2474.2 +051600 MOVE "F" TO ODO-XN-00001-O009D (6). NC2474.2 +051700 MOVE "A" TO ODO-XN-00001-O009D (7). NC2474.2 +051800 MOVE "I" TO ODO-XN-00001-O009D (8). NC2474.2 +051900 MOVE "L" TO ODO-XN-00001-O009D (9). NC2474.2 +052000 MOVE "9 ACTIVE: TEST PASS" TO GRP-ODO. NC2474.2 +052100 MOVE 9 TO DOI-DU-01V00. NC2474.2 +052200 MOVE GRP-ODO TO WRK-GRP-00019. NC2474.2 +052300 MOVE 5 TO WRK-DU-01V00. NC2474.2 +052400 MOV-TEST-F1-4. NC2474.2 +052500 IF GRP-ODO IS EQUAL TO "9 ACTIVE: TEST PASS" NC2474.2 +052600 PERFORM PASS NC2474.2 +052700 GO TO MOV-WRITE-F1-4 NC2474.2 +052800 ELSE NC2474.2 +052900 GO TO MOV-FAIL-F1-4. NC2474.2 +053000 MOV-DELETE-F1-4. NC2474.2 +053100 PERFORM DE-LETE. NC2474.2 +053200 GO TO MOV-WRITE-F1-4. NC2474.2 +053300 MOV-FAIL-F1-4. NC2474.2 +053400 PERFORM FAIL NC2474.2 +053500 MOVE WRK-GRP-00019 TO COMPUTED-A NC2474.2 +053600 MOVE "9 ACTIVE: TEST PASS" TO CORRECT-A. NC2474.2 +053700 MOV-WRITE-F1-4. NC2474.2 +053800 PERFORM PRINT-DETAIL. NC2474.2 +053900* NC2474.2 +054000 MOV-INIT-F1-5. NC2474.2 +054100 MOVE "MOV-TEST-F1-5" TO PAR-NAME. NC2474.2 +054200 MOVE "VI-26 5.8.3 SR5" TO ANSI-REFERENCE. NC2474.2 +054300* MOVE 9 TO DOI-DU-01V00. NC2474.2 +054400* MOVE "Z" TO ODO-XN-00001-O009D (1). NC2474.2 +054500* MOVE "E" TO ODO-XN-00001-O009D (2). NC2474.2 +054600* MOVE "R" TO ODO-XN-00001-O009D (3). NC2474.2 +054700* MOVE "O" TO ODO-XN-00001-O009D (4). NC2474.2 +054800* MOVE "*" TO WRK-XN-00001. NC2474.2 +054900* MOVE ZERO TO DOI-DU-01V00. NC2474.2 +055000* MOVE ODO-XN-00001-O009D (1) TO WRK-XN-00001. NC2474.2 +055100*MOV-TEST-F1-5. NC2474.2 +055200* IF WRK-XN-00001 = "*" NC2474.2 +055300* PERFORM PASS NC2474.2 +055400* GO TO MOV-WRITE-F1-5 NC2474.2 +055500* ELSE NC2474.2 +055600* GO TO MOV-FAIL-F1-5. NC2474.2 +055700 MOV-DELETE-F1-5. NC2474.2 +055800 PERFORM DE-LETE. NC2474.2 +055900 GO TO MOV-WRITE-F1-5. NC2474.2 +056000 MOV-FAIL-F1-5. NC2474.2 +056100 MOVE WRK-XN-00001 TO COMPUTED-A NC2474.2 +056200 MOVE "*" TO CORRECT-A NC2474.2 +056300 MOVE "OCCURS ZERO TIMES - MOVE SHOULD HAVE FAILED" NC2474.2 +056400 TO RE-MARK NC2474.2 +056500 PERFORM FAIL. NC2474.2 +056600 MOV-WRITE-F1-5. NC2474.2 +056700 PERFORM PRINT-DETAIL. NC2474.2 +056800* NC2474.2 +056900 MOV-INIT-F1-6. NC2474.2 +057000 MOVE "MOV-TEST-F1-6" TO PAR-NAME. NC2474.2 +057100 MOVE "VI-26 5.8.3 SR5" TO ANSI-REFERENCE. NC2474.2 +057200 MOVE 9 TO DOI-DU-01V00. NC2474.2 +057300 MOVE "P" TO ODO-XN-00001-O009D (1). NC2474.2 +057400 MOVE "Q" TO ODO-XN-00001-O009D (2). NC2474.2 +057500 MOVE "R" TO ODO-XN-00001-O009D (3). NC2474.2 +057600 MOVE "S" TO ODO-XN-00001-O009D (4). NC2474.2 +057700 MOVE "T" TO ODO-XN-00001-O009D (5). NC2474.2 +057800 MOVE "U" TO ODO-XN-00001-O009D (6). NC2474.2 +057900 MOVE "V" TO ODO-XN-00001-O009D (7). NC2474.2 +058000 MOVE "W" TO ODO-XN-00001-O009D (8). NC2474.2 +058100 MOVE "X" TO ODO-XN-00001-O009D (9). NC2474.2 +058200 MOVE 3 TO NEW-DU-01V00. NC2474.2 +058300 MOVE ODO-RECORD TO NEW-RECORD. NC2474.2 +058400 MOV-TEST-F1-6. NC2474.2 +058500 IF NEW-GRP-00009 = "PQRSTUVWX" NC2474.2 +058600 PERFORM PASS NC2474.2 +058700 GO TO MOV-WRITE-F1-6 NC2474.2 +058800 ELSE NC2474.2 +058900 GO TO MOV-FAIL-F1-6. NC2474.2 +059000 MOVE-DELETE-F1-6. NC2474.2 +059100 PERFORM DE-LETE. NC2474.2 +059200 GO TO MOV-WRITE-F1-6. NC2474.2 +059300 MOV-FAIL-F1-6. NC2474.2 +059400 MOVE NEW-GRP-00009 TO COMPUTED-A NC2474.2 +059500 MOVE "PQRSTUVWX" TO CORRECT-A NC2474.2 +059600 MOVE "ALL 9 FIELDS SHOULD BE MOVED IN GROUP MOVE" NC2474.2 +059700 TO RE-MARK NC2474.2 +059800 PERFORM FAIL. NC2474.2 +059900 MOV-WRITE-F1-6. NC2474.2 +060000 PERFORM PRINT-DETAIL. NC2474.2 +060100* NC2474.2 +060200 SCH-INIT-F1-1. NC2474.2 +060300 MOVE "SCH-TEST-F1-1" TO PAR-NAME. NC2474.2 +060400 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +060500 MOVE "SEARCH FULL ODO TABLE" TO RE-MARK. NC2474.2 +060600 PERFORM INIT-WRK-AREA. NC2474.2 +060700 SET ODO-IX TO 1. NC2474.2 +060800 SCH-TEST-F1-1. NC2474.2 +060900 SEARCH ODO-XN-00001-O009D NC2474.2 +061000 WHEN ODO-XN-00001-O009D (ODO-IX) IS EQUAL TO "7" NC2474.2 +061100 PERFORM PASS NC2474.2 +061200 GO TO SCH-WRITE-F1-1. NC2474.2 +061300 GO TO SCH-FAIL-F1-1. NC2474.2 +061400 SCH-DELETE-F1-1. NC2474.2 +061500 PERFORM DE-LETE. NC2474.2 +061600 GO TO SCH-WRITE-F1-1. NC2474.2 +061700 SCH-FAIL-F1-1. NC2474.2 +061800 PERFORM FAIL. NC2474.2 +061900 MOVE "7 SHOULD BE FOUND" TO CORRECT-A NC2474.2 +062000 MOVE "7 WAS NOT FOUND" TO COMPUTED-A. NC2474.2 +062100 SCH-WRITE-F1-1. NC2474.2 +062200 PERFORM PRINT-DETAIL. NC2474.2 +062300* NC2474.2 +062400 SCH-INIT-F1-2. NC2474.2 +062500 MOVE "SCH-TEST-F1-2" TO PAR-NAME. NC2474.2 +062600 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +062700 MOVE "SEARCH PARTIAL ODO TABLE" TO RE-MARK. NC2474.2 +062800 PERFORM INIT-WRK-AREA. NC2474.2 +062900 MOVE 3 TO DOI-DU-01V00. NC2474.2 +063000 SET ODO-IX TO 1. NC2474.2 +063100 SCH-TEST-F1-2. NC2474.2 +063200 SEARCH ODO-XN-00001-O009D NC2474.2 +063300 AT END NC2474.2 +063400 PERFORM PASS NC2474.2 +063500 GO TO SCH-WRITE-F1-2 NC2474.2 +063600 WHEN ODO-XN-00001-O009D (ODO-IX) IS EQUAL TO "7" NC2474.2 +063700 GO TO SCH-FAIL-F1-2. NC2474.2 +063800 SCH-DELETE-F1-2. NC2474.2 +063900 PERFORM DE-LETE. NC2474.2 +064000 GO TO SCH-WRITE-F1-2. NC2474.2 +064100 SCH-FAIL-F1-2. NC2474.2 +064200 PERFORM FAIL NC2474.2 +064300 MOVE "7 SHOULDN""T BE FOUND" TO CORRECT-A NC2474.2 +064400 MOVE "7 WAS FOUND" TO COMPUTED-A. NC2474.2 +064500 SCH-WRITE-F1-2. NC2474.2 +064600 PERFORM PRINT-DETAIL. NC2474.2 +064700* NC2474.2 +064800 SCH-INIT-F2-3. NC2474.2 +064900 MOVE "SCH-TEST-F2-3" TO PAR-NAME. NC2474.2 +065000 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +065100 MOVE "SEARCH ALL FULL ODO TABLE" TO RE-MARK. NC2474.2 +065200 PERFORM INIT-WRK-AREA. NC2474.2 +065300 SCH-TEST-F2-3. NC2474.2 +065400 SEARCH ALL ODO-XN-00001-O009D NC2474.2 +065500 WHEN ODO-XN-00001-O009D (ODO-IX) IS EQUAL TO "7" NC2474.2 +065600 PERFORM PASS NC2474.2 +065700 GO TO SCH-WRITE-F2-3. NC2474.2 +065800 GO TO SCH-FAIL-F2-3. NC2474.2 +065900 SCH-DELETE-F2-3. NC2474.2 +066000 PERFORM DE-LETE. NC2474.2 +066100 GO TO SCH-WRITE-F2-3. NC2474.2 +066200 SCH-FAIL-F2-3. NC2474.2 +066300 PERFORM FAIL NC2474.2 +066400 MOVE "7 SHOULD BE FOUND" TO CORRECT-A NC2474.2 +066500 MOVE "7 WAS NOT FOUND" TO COMPUTED-A. NC2474.2 +066600 SCH-WRITE-F2-3. NC2474.2 +066700 PERFORM PRINT-DETAIL. NC2474.2 +066800* NC2474.2 +066900 SCH-INIT-4. NC2474.2 +067000 MOVE "SCH-TEST-4" TO PAR-NAME. NC2474.2 +067100 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +067200 MOVE "SEARCH ALL PARTIAL ODO TABLE" TO RE-MARK. NC2474.2 +067300 PERFORM INIT-WRK-AREA. NC2474.2 +067400 MOVE 3 TO DOI-DU-01V00. NC2474.2 +067500 SCH-TEST-4. NC2474.2 +067600 SEARCH ALL ODO-XN-00001-O009D NC2474.2 +067700 AT END NC2474.2 +067800 PERFORM PASS NC2474.2 +067900 GO TO SCH-WRITE-4 NC2474.2 +068000 WHEN ODO-XN-00001-O009D (ODO-IX) IS EQUAL TO "7" NC2474.2 +068100 GO TO SCH-FAIL-4. NC2474.2 +068200 SCH-DELETE-4. NC2474.2 +068300 PERFORM DE-LETE. NC2474.2 +068400 GO TO SCH-WRITE-4. NC2474.2 +068500 SCH-FAIL-4. NC2474.2 +068600 PERFORM FAIL NC2474.2 +068700 MOVE "7 SHOULDN""T BE FOUND" TO CORRECT-A NC2474.2 +068800 MOVE "7 WAS FOUND" TO COMPUTED-A. NC2474.2 +068900 SCH-WRITE-4. NC2474.2 +069000 PERFORM PRINT-DETAIL. NC2474.2 +069100* NC2474.2 +069200 STR-INIT-GF-1. NC2474.2 +069300 MOVE "STR-TEST-GF-1" TO PAR-NAME. NC2474.2 +069400 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +069500 MOVE "STRING FULL ODO AND LITERAL" TO RE-MARK. NC2474.2 +069600 PERFORM INIT-WRK-AREA. NC2474.2 +069700 MOVE SPACES TO WRK-XN-00020. NC2474.2 +069800 STR-TEST-GF-1. NC2474.2 +069900 STRING ODO-GRP-00009 "-TRAILER" DELIMITED BY SIZE NC2474.2 +070000 INTO WRK-XN-00020. NC2474.2 +070100 IF WRK-XN-00020 IS EQUAL TO "123456789-TRAILER " NC2474.2 +070200 PERFORM PASS NC2474.2 +070300 GO TO STR-WRITE-GF-1 NC2474.2 +070400 ELSE NC2474.2 +070500 GO TO STR-FAIL-GF-1. NC2474.2 +070600 STR-DELETE-GF-1. NC2474.2 +070700 PERFORM DE-LETE. NC2474.2 +070800 GO TO STR-WRITE-GF-1. NC2474.2 +070900 STR-FAIL-GF-1. NC2474.2 +071000 PERFORM FAIL NC2474.2 +071100 MOVE "123456789-TRAILER" TO CORRECT-A NC2474.2 +071200 MOVE WRK-XN-00020 TO COMPUTED-A. NC2474.2 +071300 STR-WRITE-GF-1. NC2474.2 +071400 PERFORM PRINT-DETAIL. NC2474.2 +071500* NC2474.2 +071600 STR-INIT-GF-2. NC2474.2 +071700 MOVE "STR-TEST-GF-2" TO PAR-NAME. NC2474.2 +071800 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +071900 MOVE "STRING PARTIAL ODO AND LITERAL" TO RE-MARK. NC2474.2 +072000 PERFORM INIT-WRK-AREA. NC2474.2 +072100 MOVE SPACES TO WRK-XN-00020. NC2474.2 +072200 MOVE 3 TO DOI-DU-01V00. NC2474.2 +072300 STR-TEST-GF-2. NC2474.2 +072400 STRING ODO-GRP-00009 "-TRAILER" DELIMITED BY SIZE NC2474.2 +072500 INTO WRK-XN-00020. NC2474.2 +072600 IF WRK-XN-00020 IS EQUAL TO "123-TRAILER " NC2474.2 +072700 PERFORM PASS NC2474.2 +072800 GO TO STR-WRITE-GF-2 NC2474.2 +072900 ELSE NC2474.2 +073000 GO TO STR-FAIL-GF-2. NC2474.2 +073100 STR-DELETE-GF-2. NC2474.2 +073200 PERFORM DE-LETE. NC2474.2 +073300 GO TO STR-WRITE-GF-2. NC2474.2 +073400 STR-FAIL-GF-2. NC2474.2 +073500 PERFORM FAIL NC2474.2 +073600 MOVE "123-TRAILER" TO CORRECT-A NC2474.2 +073700 MOVE WRK-XN-00020 TO COMPUTED-A. NC2474.2 +073800 STR-WRITE-GF-2. NC2474.2 +073900 PERFORM PRINT-DETAIL. NC2474.2 +074000* NC2474.2 +074100 STR-TEST-GF-3. NC2474.2 +074200 PERFORM INIT-WRK-AREA. NC2474.2 +074300 MOVE SPACES TO WRK-XN-00020. NC2474.2 +074400 MOVE 3 TO DOI-DU-01V00. NC2474.2 +074500 STRING "LEADER-" ODO-GRP-00009 DELIMITED BY SIZE NC2474.2 +074600 INTO WRK-XN-00020. NC2474.2 +074700 IF WRK-XN-00020 IS EQUAL TO "LEADER-123 " NC2474.2 +074800 PERFORM PASS NC2474.2 +074900 GO TO STR-WRITE-GF-3 NC2474.2 +075000 ELSE NC2474.2 +075100 PERFORM FAIL NC2474.2 +075200 MOVE "LEADER-123" TO CORRECT-A NC2474.2 +075300 MOVE WRK-XN-00020 TO COMPUTED-A NC2474.2 +075400 PERFORM STR-WRITE-GF-3 NC2474.2 +075500 GO TO STR-DELETE-GF-4. NC2474.2 +075600 STR-DELETE-GF-3. NC2474.2 +075700 PERFORM DE-LETE. NC2474.2 +075800 STR-WRITE-GF-3. NC2474.2 +075900 MOVE "STR-TEST-GF-3" TO PAR-NAME. NC2474.2 +076000 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +076100 MOVE "STRING LITERAL AND PARTIAL ODO" TO RE-MARK. NC2474.2 +076200 PERFORM PRINT-DETAIL. NC2474.2 +076300* NC2474.2 +076400 STR-INIT-GF-4. NC2474.2 +076500 MOVE "STR-TEST-GF-4" TO PAR-NAME. NC2474.2 +076600 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +076700 MOVE "PARTIAL ODO/UNNEEDED OVERFLOW" TO RE-MARK. NC2474.2 +076800 PERFORM INIT-WRK-AREA NC2474.2 +076900 MOVE SPACES TO WRK-XN-00010. NC2474.2 +077000 MOVE 3 TO DOI-DU-01V00. NC2474.2 +077100 STR-TEST-GF-4. NC2474.2 +077200 STRING "LEADER-" ODO-GRP-00009 DELIMITED BY SIZE NC2474.2 +077300 INTO WRK-XN-00010 NC2474.2 +077400 ON OVERFLOW NC2474.2 +077500 GO TO STR-FAIL-GF-4. NC2474.2 +077600 PERFORM PASS. NC2474.2 +077700 GO TO STR-WRITE-GF-4. NC2474.2 +077800 STR-DELETE-GF-4. NC2474.2 +077900 PERFORM DE-LETE. NC2474.2 +078000 MOVE "STR-TEST-GF-4" TO PAR-NAME. NC2474.2 +078100 MOVE "DELETE AUTOMATIC IF" TO COMPUTED-A. NC2474.2 +078200 MOVE "STR-TEST-GF-3 FAILS" TO CORRECT-A. NC2474.2 +078300 GO TO STR-WRITE-GF-4. NC2474.2 +078400 STR-FAIL-GF-4. NC2474.2 +078500 PERFORM FAIL NC2474.2 +078600 MOVE "OVERFLOW EXIT TAKEN" TO COMPUTED-A NC2474.2 +078700 MOVE "NO EXIT NECESSARY" TO CORRECT-A. NC2474.2 +078800 STR-WRITE-GF-4. NC2474.2 +078900 PERFORM PRINT-DETAIL. NC2474.2 +079000* NC2474.2 +079100 UST-INIT-GF-1. NC2474.2 +079200 MOVE "UST-TEST-GF-1" TO PAR-NAME. NC2474.2 +079300 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +079400 MOVE "UNSTRING FULL ODO" TO RE-MARK. NC2474.2 +079500 PERFORM INIT-WRK-AREA. NC2474.2 +079600 MOVE SPACES TO WRK-XN-00010 WRK-XN-00020. NC2474.2 +079700 UST-TEST-GF-1. NC2474.2 +079800 UNSTRING GRP-ODO INTO WRK-XN-00010 WRK-XN-00020. NC2474.2 +079900 IF WRK-XN-00020 IS EQUAL TO "123456789 " NC2474.2 +080000 PERFORM PASS NC2474.2 +080100 GO TO UST-WRITE-GF-1 NC2474.2 +080200 ELSE NC2474.2 +080300 GO TO UST-FAIL-GF-1. NC2474.2 +080400 UST-DELETE-GF-1. NC2474.2 +080500 PERFORM DE-LETE. NC2474.2 +080600 GO TO UST-WRITE-GF-1. NC2474.2 +080700 UST-FAIL-GF-1. NC2474.2 +080800 PERFORM FAIL NC2474.2 +080900 MOVE WRK-XN-00020 TO COMPUTED-A NC2474.2 +081000 MOVE "123456789" TO CORRECT-A. NC2474.2 +081100 UST-WRITE-GF-1. NC2474.2 +081200 PERFORM PRINT-DETAIL. NC2474.2 +081300* NC2474.2 +081400 UST-INIT-GF-2. NC2474.2 +081500 MOVE "UST-TEST-GF-2" TO PAR-NAME. NC2474.2 +081600 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +081700 MOVE "UNSTRING PARTIAL ODO" TO RE-MARK. NC2474.2 +081800 PERFORM INIT-WRK-AREA. NC2474.2 +081900 MOVE SPACES TO WRK-XN-00020 WRK-XN-00010. NC2474.2 +082000 MOVE 3 TO DOI-DU-01V00. NC2474.2 +082100 UST-TEST-GF-2. NC2474.2 +082200 UNSTRING GRP-ODO INTO WRK-XN-00010 WRK-XN-00020. NC2474.2 +082300 IF WRK-XN-00020 IS EQUAL TO "123 " NC2474.2 +082400 PERFORM PASS NC2474.2 +082500 GO TO UST-WRITE-GF-2 NC2474.2 +082600 ELSE NC2474.2 +082700 GO TO UST-FAIL-GF-2. NC2474.2 +082800 UST-DELETE-GF-2. NC2474.2 +082900 PERFORM DE-LETE. NC2474.2 +083000 GO TO UST-WRITE-GF-2. NC2474.2 +083100 UST-FAIL-GF-2. NC2474.2 +083200 PERFORM FAIL NC2474.2 +083300 MOVE WRK-XN-00020 TO COMPUTED-A NC2474.2 +083400 MOVE "123" TO CORRECT-A. NC2474.2 +083500 UST-WRITE-GF-2. NC2474.2 +083600 PERFORM PRINT-DETAIL. NC2474.2 +083700* NC2474.2 +083800 UST-INIT-GF-3. NC2474.2 +083900 MOVE "UST-TEST-GF-3" TO PAR-NAME. NC2474.2 +084000 MOVE "VI-26 5.8" TO ANSI-REFERENCE. NC2474.2 +084100 MOVE "UNSTRING DELIMITED PARTIAL ODO" TO RE-MARK. NC2474.2 +084200 PERFORM INIT-WRK-AREA. NC2474.2 +084300 MOVE SPACES TO WRK-XN-00020. NC2474.2 +084400 MOVE 3 TO DOI-DU-01V00. NC2474.2 +084500 UST-TEST-GF-3. NC2474.2 +084600 UNSTRING GRP-ODO DELIMITED BY "7" INTO WRK-XN-00020. NC2474.2 +084700 IF WRK-XN-00020 IS EQUAL TO "3 ACTIVE: 123 " NC2474.2 +084800 PERFORM PASS NC2474.2 +084900 GO TO UST-WRITE-GF-3 NC2474.2 +085000 ELSE NC2474.2 +085100 GO TO UST-FAIL-GF-3. NC2474.2 +085200 UST-DELETE-GF-3. NC2474.2 +085300 PERFORM DE-LETE. NC2474.2 +085400 GO TO UST-WRITE-GF-3. NC2474.2 +085500 UST-FAIL-GF-3. NC2474.2 +085600 PERFORM FAIL NC2474.2 +085700 MOVE WRK-XN-00020 TO COMPUTED-A NC2474.2 +085800 MOVE "3 ACTIVE: 123" TO CORRECT-A. NC2474.2 +085900 UST-WRITE-GF-3. NC2474.2 +086000 PERFORM PRINT-DETAIL. NC2474.2 +086100* NC2474.2 +086200 CCVS-EXIT SECTION. NC2474.2 +086300 CCVS-999999. NC2474.2 +086400 GO TO CLOSE-FILES. NC2474.2 diff --git a/tests/cobol85/NC/NC248A.CBL b/tests/cobol85/NC/NC248A.CBL new file mode 100755 index 00000000..73d2087c --- /dev/null +++ b/tests/cobol85/NC/NC248A.CBL @@ -0,0 +1,621 @@ +000100 IDENTIFICATION DIVISION. NC2484.2 +000200 PROGRAM-ID. NC2484.2 +000300 NC248A. NC2484.2 +000400**************************************************************** NC2484.2 +000500* * NC2484.2 +000600* VALIDATION FOR:- * NC2484.2 +000700* * NC2484.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2484.2 +000900* * NC2484.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2484.2 +001100* * NC2484.2 +001200**************************************************************** NC2484.2 +001300* * NC2484.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2484.2 +001500* * NC2484.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2484.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2484.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2484.2 +001900* * NC2484.2 +002000**************************************************************** NC2484.2 +002100* NC2484.2 +002200* PROGRAM NC248A TESTS FORMATS 1 AND 2 OF THE "SET" * NC2484.2 +002300* STATEMENT USING QUALIFICATION WITH INDEXED AND * NC2484.2 +002400* RELATIVE-INDEXED IDENTIFIERS. * NC2484.2 +002500* FORMAT 4 OF THE "SET" STATEMENT IS ALSO TESTED. * NC2484.2 +002600* * NC2484.2 +002700**************************************************************** NC2484.2 +002800 ENVIRONMENT DIVISION. NC2484.2 +002900 CONFIGURATION SECTION. NC2484.2 +003000 SOURCE-COMPUTER. NC2484.2 +003100 Linux. NC2484.2 +003200 OBJECT-COMPUTER. NC2484.2 +003300 Linux. NC2484.2 +003400 INPUT-OUTPUT SECTION. NC2484.2 +003500 FILE-CONTROL. NC2484.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2484.2 +003700 "report.log". NC2484.2 +003800 DATA DIVISION. NC2484.2 +003900 FILE SECTION. NC2484.2 +004000 FD PRINT-FILE. NC2484.2 +004100 01 PRINT-REC PICTURE X(120). NC2484.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2484.2 +004300 WORKING-STORAGE SECTION. NC2484.2 +004400 01 TEST-7-DATA. NC2484.2 +004500 03 TEST-7-1 PIC X. NC2484.2 +004600 88 TEST-7-1-TRUE VALUE "%". NC2484.2 +004700 01 TEST-8-DATA. NC2484.2 +004800 03 TEST-8-1 PIC X. NC2484.2 +004900 88 TEST-8-1-1-TRUE VALUE "J". NC2484.2 +005000 88 TEST-8-1-2-TRUE VALUE "A". NC2484.2 +005100 88 TEST-8-1-3-TRUE VALUE "N". NC2484.2 +005200 01 TEST-9-DATA. NC2484.2 +005300 03 TEST-9-1 PIC X. NC2484.2 +005400 88 TEST-9-1-1-TRUE VALUE "6". NC2484.2 +005500 88 TEST-9-1-2-TRUE VALUE "2". NC2484.2 +005600 03 TEST-9-2 PIC X. NC2484.2 +005700 88 TEST-9-2-1-TRUE VALUE "B". NC2484.2 +005800 88 TEST-9-2-2-TRUE VALUE "C". NC2484.2 +005900 03 TEST-9-3 PIC X. NC2484.2 +006000 88 TEST-9-3-1-TRUE VALUE "*". NC2484.2 +006100 88 TEST-9-3-2-TRUE VALUE "+". NC2484.2 +006200 NC2484.2 +006300 01 TABLE1. NC2484.2 +006400 02 TABLE1-REC PICTURE 99 NC2484.2 +006500 OCCURS 100 TIMES NC2484.2 +006600 INDEXED BY INDEX1. NC2484.2 +006700 01 TABLE2. NC2484.2 +006800 02 TABLE2-REC PICTURE 99 NC2484.2 +006900 OCCURS 12 TIMES NC2484.2 +007000 INDEXED BY INDEX2. NC2484.2 +007100 01 INDEX-ID PIC 999 VALUE ZEROS. NC2484.2 +007200 01 TEST-RESULTS. NC2484.2 +007300 02 FILLER PIC X VALUE SPACE. NC2484.2 +007400 02 FEATURE PIC X(20) VALUE SPACE. NC2484.2 +007500 02 FILLER PIC X VALUE SPACE. NC2484.2 +007600 02 P-OR-F PIC X(5) VALUE SPACE. NC2484.2 +007700 02 FILLER PIC X VALUE SPACE. NC2484.2 +007800 02 PAR-NAME. NC2484.2 +007900 03 FILLER PIC X(19) VALUE SPACE. NC2484.2 +008000 03 PARDOT-X PIC X VALUE SPACE. NC2484.2 +008100 03 DOTVALUE PIC 99 VALUE ZERO. NC2484.2 +008200 02 FILLER PIC X(8) VALUE SPACE. NC2484.2 +008300 02 RE-MARK PIC X(61). NC2484.2 +008400 01 TEST-COMPUTED. NC2484.2 +008500 02 FILLER PIC X(30) VALUE SPACE. NC2484.2 +008600 02 FILLER PIC X(17) VALUE NC2484.2 +008700 " COMPUTED=". NC2484.2 +008800 02 COMPUTED-X. NC2484.2 +008900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2484.2 +009000 03 COMPUTED-N REDEFINES COMPUTED-A NC2484.2 +009100 PIC -9(9).9(9). NC2484.2 +009200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2484.2 +009300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2484.2 +009400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2484.2 +009500 03 CM-18V0 REDEFINES COMPUTED-A. NC2484.2 +009600 04 COMPUTED-18V0 PIC -9(18). NC2484.2 +009700 04 FILLER PIC X. NC2484.2 +009800 03 FILLER PIC X(50) VALUE SPACE. NC2484.2 +009900 01 TEST-CORRECT. NC2484.2 +010000 02 FILLER PIC X(30) VALUE SPACE. NC2484.2 +010100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2484.2 +010200 02 CORRECT-X. NC2484.2 +010300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2484.2 +010400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2484.2 +010500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2484.2 +010600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2484.2 +010700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2484.2 +010800 03 CR-18V0 REDEFINES CORRECT-A. NC2484.2 +010900 04 CORRECT-18V0 PIC -9(18). NC2484.2 +011000 04 FILLER PIC X. NC2484.2 +011100 03 FILLER PIC X(2) VALUE SPACE. NC2484.2 +011200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2484.2 +011300 01 CCVS-C-1. NC2484.2 +011400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2484.2 +011500- "SS PARAGRAPH-NAME NC2484.2 +011600- " REMARKS". NC2484.2 +011700 02 FILLER PIC X(20) VALUE SPACE. NC2484.2 +011800 01 CCVS-C-2. NC2484.2 +011900 02 FILLER PIC X VALUE SPACE. NC2484.2 +012000 02 FILLER PIC X(6) VALUE "TESTED". NC2484.2 +012100 02 FILLER PIC X(15) VALUE SPACE. NC2484.2 +012200 02 FILLER PIC X(4) VALUE "FAIL". NC2484.2 +012300 02 FILLER PIC X(94) VALUE SPACE. NC2484.2 +012400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2484.2 +012500 01 REC-CT PIC 99 VALUE ZERO. NC2484.2 +012600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2484.2 +012700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2484.2 +012800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2484.2 +012900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2484.2 +013000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2484.2 +013100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2484.2 +013200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2484.2 +013300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2484.2 +013400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2484.2 +013500 01 CCVS-H-1. NC2484.2 +013600 02 FILLER PIC X(39) VALUE SPACES. NC2484.2 +013700 02 FILLER PIC X(42) VALUE NC2484.2 +013800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2484.2 +013900 02 FILLER PIC X(39) VALUE SPACES. NC2484.2 +014000 01 CCVS-H-2A. NC2484.2 +014100 02 FILLER PIC X(40) VALUE SPACE. NC2484.2 +014200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2484.2 +014300 02 FILLER PIC XXXX VALUE NC2484.2 +014400 "4.2 ". NC2484.2 +014500 02 FILLER PIC X(28) VALUE NC2484.2 +014600 " COPY - NOT FOR DISTRIBUTION". NC2484.2 +014700 02 FILLER PIC X(41) VALUE SPACE. NC2484.2 +014800 NC2484.2 +014900 01 CCVS-H-2B. NC2484.2 +015000 02 FILLER PIC X(15) VALUE NC2484.2 +015100 "TEST RESULT OF ". NC2484.2 +015200 02 TEST-ID PIC X(9). NC2484.2 +015300 02 FILLER PIC X(4) VALUE NC2484.2 +015400 " IN ". NC2484.2 +015500 02 FILLER PIC X(12) VALUE NC2484.2 +015600 " HIGH ". NC2484.2 +015700 02 FILLER PIC X(22) VALUE NC2484.2 +015800 " LEVEL VALIDATION FOR ". NC2484.2 +015900 02 FILLER PIC X(58) VALUE NC2484.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2484.2 +016100 01 CCVS-H-3. NC2484.2 +016200 02 FILLER PIC X(34) VALUE NC2484.2 +016300 " FOR OFFICIAL USE ONLY ". NC2484.2 +016400 02 FILLER PIC X(58) VALUE NC2484.2 +016500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2484.2 +016600 02 FILLER PIC X(28) VALUE NC2484.2 +016700 " COPYRIGHT 1985 ". NC2484.2 +016800 01 CCVS-E-1. NC2484.2 +016900 02 FILLER PIC X(52) VALUE SPACE. NC2484.2 +017000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2484.2 +017100 02 ID-AGAIN PIC X(9). NC2484.2 +017200 02 FILLER PIC X(45) VALUE SPACES. NC2484.2 +017300 01 CCVS-E-2. NC2484.2 +017400 02 FILLER PIC X(31) VALUE SPACE. NC2484.2 +017500 02 FILLER PIC X(21) VALUE SPACE. NC2484.2 +017600 02 CCVS-E-2-2. NC2484.2 +017700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2484.2 +017800 03 FILLER PIC X VALUE SPACE. NC2484.2 +017900 03 ENDER-DESC PIC X(44) VALUE NC2484.2 +018000 "ERRORS ENCOUNTERED". NC2484.2 +018100 01 CCVS-E-3. NC2484.2 +018200 02 FILLER PIC X(22) VALUE NC2484.2 +018300 " FOR OFFICIAL USE ONLY". NC2484.2 +018400 02 FILLER PIC X(12) VALUE SPACE. NC2484.2 +018500 02 FILLER PIC X(58) VALUE NC2484.2 +018600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2484.2 +018700 02 FILLER PIC X(13) VALUE SPACE. NC2484.2 +018800 02 FILLER PIC X(15) VALUE NC2484.2 +018900 " COPYRIGHT 1985". NC2484.2 +019000 01 CCVS-E-4. NC2484.2 +019100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2484.2 +019200 02 FILLER PIC X(4) VALUE " OF ". NC2484.2 +019300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2484.2 +019400 02 FILLER PIC X(40) VALUE NC2484.2 +019500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2484.2 +019600 01 XXINFO. NC2484.2 +019700 02 FILLER PIC X(19) VALUE NC2484.2 +019800 "*** INFORMATION ***". NC2484.2 +019900 02 INFO-TEXT. NC2484.2 +020000 04 FILLER PIC X(8) VALUE SPACE. NC2484.2 +020100 04 XXCOMPUTED PIC X(20). NC2484.2 +020200 04 FILLER PIC X(5) VALUE SPACE. NC2484.2 +020300 04 XXCORRECT PIC X(20). NC2484.2 +020400 02 INF-ANSI-REFERENCE PIC X(48). NC2484.2 +020500 01 HYPHEN-LINE. NC2484.2 +020600 02 FILLER PIC IS X VALUE IS SPACE. NC2484.2 +020700 02 FILLER PIC IS X(65) VALUE IS "************************NC2484.2 +020800- "*****************************************". NC2484.2 +020900 02 FILLER PIC IS X(54) VALUE IS "************************NC2484.2 +021000- "******************************". NC2484.2 +021100 01 CCVS-PGM-ID PIC X(9) VALUE NC2484.2 +021200 "NC248A". NC2484.2 +021300 PROCEDURE DIVISION. NC2484.2 +021400 CCVS1 SECTION. NC2484.2 +021500 OPEN-FILES. NC2484.2 +021600 OPEN OUTPUT PRINT-FILE. NC2484.2 +021700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2484.2 +021800 MOVE SPACE TO TEST-RESULTS. NC2484.2 +021900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2484.2 +022000 GO TO CCVS1-EXIT. NC2484.2 +022100 CLOSE-FILES. NC2484.2 +022200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2484.2 +022300 TERMINATE-CCVS. NC2484.2 +022400*S EXIT PROGRAM. NC2484.2 +022500*SERMINATE-CALL. NC2484.2 +022600 STOP RUN. NC2484.2 +022700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2484.2 +022800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2484.2 +022900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2484.2 +023000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2484.2 +023100 MOVE "****TEST DELETED****" TO RE-MARK. NC2484.2 +023200 PRINT-DETAIL. NC2484.2 +023300 IF REC-CT NOT EQUAL TO ZERO NC2484.2 +023400 MOVE "." TO PARDOT-X NC2484.2 +023500 MOVE REC-CT TO DOTVALUE. NC2484.2 +023600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2484.2 +023700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2484.2 +023800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2484.2 +023900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2484.2 +024000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2484.2 +024100 MOVE SPACE TO CORRECT-X. NC2484.2 +024200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2484.2 +024300 MOVE SPACE TO RE-MARK. NC2484.2 +024400 HEAD-ROUTINE. NC2484.2 +024500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +024600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +024700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2484.2 +024800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2484.2 +024900 COLUMN-NAMES-ROUTINE. NC2484.2 +025000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +025100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +025200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +025300 END-ROUTINE. NC2484.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2484.2 +025500 END-RTN-EXIT. NC2484.2 +025600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +025700 END-ROUTINE-1. NC2484.2 +025800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2484.2 +025900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2484.2 +026000 ADD PASS-COUNTER TO ERROR-HOLD. NC2484.2 +026100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2484.2 +026200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2484.2 +026300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2484.2 +026400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2484.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2484.2 +026600 END-ROUTINE-12. NC2484.2 +026700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2484.2 +026800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2484.2 +026900 MOVE "NO " TO ERROR-TOTAL NC2484.2 +027000 ELSE NC2484.2 +027100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2484.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2484.2 +027300 PERFORM WRITE-LINE. NC2484.2 +027400 END-ROUTINE-13. NC2484.2 +027500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2484.2 +027600 MOVE "NO " TO ERROR-TOTAL ELSE NC2484.2 +027700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2484.2 +027800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2484.2 +027900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +028000 IF INSPECT-COUNTER EQUAL TO ZERO NC2484.2 +028100 MOVE "NO " TO ERROR-TOTAL NC2484.2 +028200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2484.2 +028300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2484.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +028500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2484.2 +028600 WRITE-LINE. NC2484.2 +028700 ADD 1 TO RECORD-COUNT. NC2484.2 +028800 IF RECORD-COUNT GREATER 50 NC2484.2 +028900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2484.2 +029000 MOVE SPACE TO DUMMY-RECORD NC2484.2 +029100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2484.2 +029200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2484.2 +029300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2484.2 +029400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2484.2 +029500 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2484.2 +029600 MOVE ZERO TO RECORD-COUNT. NC2484.2 +029700 PERFORM WRT-LN. NC2484.2 +029800 WRT-LN. NC2484.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2484.2 +030000 MOVE SPACE TO DUMMY-RECORD. NC2484.2 +030100 BLANK-LINE-PRINT. NC2484.2 +030200 PERFORM WRT-LN. NC2484.2 +030300 FAIL-ROUTINE. NC2484.2 +030400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2484.2 +030500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2484.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2484.2 +030700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2484.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2484.2 +031000 GO TO FAIL-ROUTINE-EX. NC2484.2 +031100 FAIL-ROUTINE-WRITE. NC2484.2 +031200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2484.2 +031300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2484.2 +031400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2484.2 +031500 MOVE SPACES TO COR-ANSI-REFERENCE. NC2484.2 +031600 FAIL-ROUTINE-EX. EXIT. NC2484.2 +031700 BAIL-OUT. NC2484.2 +031800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2484.2 +031900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2484.2 +032000 BAIL-OUT-WRITE. NC2484.2 +032100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2484.2 +032200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2484.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2484.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2484.2 +032500 BAIL-OUT-EX. EXIT. NC2484.2 +032600 CCVS1-EXIT. NC2484.2 +032700 EXIT. NC2484.2 +032800 BUILD-TABLE2. NC2484.2 +032900 MOVE 21 TO TABLE2-REC (1). NC2484.2 +033000 MOVE 02 TO TABLE2-REC (2). NC2484.2 +033100 MOVE 03 TO TABLE2-REC (3). NC2484.2 +033200 MOVE 11 TO TABLE2-REC (4). NC2484.2 +033300 MOVE 05 TO TABLE2-REC (5). NC2484.2 +033400 MOVE 10 TO TABLE2-REC (6). NC2484.2 +033500 MOVE 26 TO TABLE2-REC (7). NC2484.2 +033600 MOVE 02 TO TABLE2-REC (8). NC2484.2 +033700 MOVE 16 TO TABLE2-REC (9). NC2484.2 +033800 MOVE 62 TO TABLE2-REC (10). NC2484.2 +033900 MOVE 10 TO TABLE2-REC (11). NC2484.2 +034000 MOVE 04 TO TABLE2-REC (12). NC2484.2 +034100* NC2484.2 +034200 SET-INIT-F1-1. NC2484.2 +034300 MOVE "SET-TEST-F1-1" TO PAR-NAME. NC2484.2 +034400 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +034500 MOVE "SET ... TO" TO FEATURE. NC2484.2 +034600 SET-TEST-F1-1. NC2484.2 +034700 SET INDEX1 TO 1. NC2484.2 +034800 SET INDEX2 TO 4. NC2484.2 +034900 SET INDEX1 TO TABLE2-REC OF TABLE2 (INDEX2). NC2484.2 +035000 IF INDEX1 EQUAL TO 11 NC2484.2 +035100 PERFORM PASS NC2484.2 +035200 GO TO SET-WRITE-F1-1 NC2484.2 +035300 ELSE NC2484.2 +035400 GO TO SET-FAIL-F1-1. NC2484.2 +035500 SET-DELETE-F1-1. NC2484.2 +035600 PERFORM DE-LETE. NC2484.2 +035700 GO TO SET-WRITE-F1-1. NC2484.2 +035800 SET-FAIL-F1-1. NC2484.2 +035900 PERFORM FAIL. NC2484.2 +036000 SET INDEX-ID TO INDEX1. NC2484.2 +036100 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +036200 MOVE 11 TO CORRECT-18V0. NC2484.2 +036300 SET-WRITE-F1-1. NC2484.2 +036400 PERFORM PRINT-DETAIL. NC2484.2 +036500* NC2484.2 +036600 SET-INIT-F2-2. NC2484.2 +036700 MOVE "SET-TEST-F2-2" TO PAR-NAME. NC2484.2 +036800 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +036900 MOVE "SET ... UP BY" TO FEATURE. NC2484.2 +037000 PERFORM BUILD-TABLE2. NC2484.2 +037100 SET-TEST-F2-2. NC2484.2 +037200 SET INDEX1 TO 11. NC2484.2 +037300 SET INDEX2 TO 5. NC2484.2 +037400 SET INDEX1 UP BY TABLE2-REC OF TABLE2 (INDEX2). NC2484.2 +037500 IF INDEX1 EQUAL TO 16 NC2484.2 +037600 PERFORM PASS NC2484.2 +037700 GO TO SET-WRITE-F2-2 NC2484.2 +037800 ELSE NC2484.2 +037900 GO TO SET-FAIL-F2-2. NC2484.2 +038000 SET-DELETE-F2-2. NC2484.2 +038100 PERFORM DE-LETE. NC2484.2 +038200 GO TO SET-WRITE-F2-2. NC2484.2 +038300 SET-FAIL-F2-2. NC2484.2 +038400 PERFORM FAIL. NC2484.2 +038500 SET INDEX-ID TO INDEX1. NC2484.2 +038600 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +038700 MOVE 16 TO CORRECT-18V0. NC2484.2 +038800 SET-WRITE-F2-2. NC2484.2 +038900 PERFORM PRINT-DETAIL. NC2484.2 +039000* NC2484.2 +039100 SET-INIT-F2-3. NC2484.2 +039200 MOVE "SET-TEST-F2-3" TO PAR-NAME. NC2484.2 +039300 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +039400 MOVE "SET ... DOWN BY" TO FEATURE. NC2484.2 +039500 PERFORM BUILD-TABLE2. NC2484.2 +039600 SET-TEST-F2-3. NC2484.2 +039700 SET INDEX1 TO 16. NC2484.2 +039800 SET INDEX2 TO 6. NC2484.2 +039900 SET INDEX1 DOWN BY TABLE2-REC OF TABLE2 (INDEX2). NC2484.2 +040000 IF INDEX1 EQUAL TO 06 NC2484.2 +040100 PERFORM PASS NC2484.2 +040200 GO TO SET-WRITE-F2-3 NC2484.2 +040300 ELSE NC2484.2 +040400 GO TO SET-FAIL-F2-3. NC2484.2 +040500 SET-DELETE-F2-3. NC2484.2 +040600 PERFORM DE-LETE. NC2484.2 +040700 GO TO SET-WRITE-F2-3. NC2484.2 +040800 SET-FAIL-F2-3. NC2484.2 +040900 PERFORM FAIL. NC2484.2 +041000 SET INDEX-ID TO INDEX1. NC2484.2 +041100 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +041200 MOVE 06 TO CORRECT-18V0. NC2484.2 +041300 SET-WRITE-F2-3. NC2484.2 +041400 PERFORM PRINT-DETAIL. NC2484.2 +041500* NC2484.2 +041600 SET-INIT-F1-4. NC2484.2 +041700 MOVE "SET-TEST-F1-4" TO PAR-NAME. NC2484.2 +041800 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +041900 MOVE "SET ... TO" TO FEATURE. NC2484.2 +042000 PERFORM BUILD-TABLE2. NC2484.2 +042100 SET-TEST-F1-4. NC2484.2 +042200 SET INDEX1 TO 1. NC2484.2 +042300 SET INDEX2 TO 11. NC2484.2 +042400 SET INDEX1 TO TABLE2-REC OF TABLE2 (INDEX2 + 1). NC2484.2 +042500 IF INDEX1 EQUAL TO 4 NC2484.2 +042600 PERFORM PASS NC2484.2 +042700 GO TO SET-WRITE-F1-4 NC2484.2 +042800 ELSE NC2484.2 +042900 GO TO SET-FAIL-F1-4. NC2484.2 +043000 SET-DELETE-F1-4. NC2484.2 +043100 PERFORM DE-LETE. NC2484.2 +043200 GO TO SET-WRITE-F1-4. NC2484.2 +043300 SET-FAIL-F1-4. NC2484.2 +043400 PERFORM FAIL. NC2484.2 +043500 SET INDEX-ID TO INDEX1. NC2484.2 +043600 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +043700 MOVE 4 TO CORRECT-18V0. NC2484.2 +043800 SET-WRITE-F1-4. NC2484.2 +043900 PERFORM PRINT-DETAIL. NC2484.2 +044000* NC2484.2 +044100 SET-INIT-F2-5. NC2484.2 +044200 MOVE "SET-TEST-F2-5" TO PAR-NAME. NC2484.2 +044300 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +044400 MOVE "SET ... UP BY" TO FEATURE. NC2484.2 +044500 PERFORM BUILD-TABLE2. NC2484.2 +044600 SET-TEST-F2-5. NC2484.2 +044700 SET INDEX1 TO 1. NC2484.2 +044800 SET INDEX2 TO 3. NC2484.2 +044900 SET INDEX1 UP BY TABLE2-REC OF TABLE2 (INDEX2 - 2). NC2484.2 +045000 IF INDEX1 EQUAL TO 22 NC2484.2 +045100 PERFORM PASS NC2484.2 +045200 GO TO SET-WRITE-F2-5 NC2484.2 +045300 ELSE NC2484.2 +045400 GO TO SET-FAIL-F2-5. NC2484.2 +045500 SET-DELETE-F2-5. NC2484.2 +045600 PERFORM DE-LETE. NC2484.2 +045700 GO TO SET-WRITE-F2-5. NC2484.2 +045800 SET-FAIL-F2-5. NC2484.2 +045900 PERFORM FAIL. NC2484.2 +046000 SET INDEX-ID TO INDEX1. NC2484.2 +046100 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +046200 MOVE 22 TO CORRECT-18V0. NC2484.2 +046300 SET-WRITE-F2-5. NC2484.2 +046400 PERFORM PRINT-DETAIL. NC2484.2 +046500* NC2484.2 +046600 SET-INIT-F2-6. NC2484.2 +046700 MOVE "SET-TEST-F2-6" TO PAR-NAME. NC2484.2 +046800 MOVE "VI-126 6.22.2" TO ANSI-REFERENCE. NC2484.2 +046900 MOVE "SET ... DOWN BY" TO FEATURE. NC2484.2 +047000 PERFORM BUILD-TABLE2. NC2484.2 +047100 SET-TEST-F2-6. NC2484.2 +047200 SET INDEX1 TO 16. NC2484.2 +047300 SET INDEX2 TO 12. NC2484.2 +047400 SET INDEX1 DOWN BY TABLE2-REC OF TABLE2 (INDEX2 - 6). NC2484.2 +047500 IF INDEX1 EQUAL TO 06 NC2484.2 +047600 PERFORM PASS NC2484.2 +047700 GO TO SET-WRITE-F2-6 NC2484.2 +047800 ELSE NC2484.2 +047900 GO TO SET-FAIL-F2-6. NC2484.2 +048000 SET-DELETE-F2-6. NC2484.2 +048100 PERFORM DE-LETE. NC2484.2 +048200 GO TO SET-WRITE-F2-6. NC2484.2 +048300 SET-FAIL-F2-6. NC2484.2 +048400 PERFORM FAIL. NC2484.2 +048500 SET INDEX-ID TO INDEX1. NC2484.2 +048600 MOVE INDEX-ID TO COMPUTED-18V0. NC2484.2 +048700 MOVE 06 TO CORRECT-18V0. NC2484.2 +048800 SET-WRITE-F2-6. NC2484.2 +048900 PERFORM PRINT-DETAIL. NC2484.2 +049000* NC2484.2 +049100 SET-INIT-F2-7. NC2484.2 +049200 MOVE "SET-TEST-F2-7" TO PAR-NAME. NC2484.2 +049300 MOVE "VI-128 6.22.4 GR7" TO ANSI-REFERENCE. NC2484.2 +049400 MOVE SPACE TO TEST-7-1. NC2484.2 +049500 SET-TEST-F2-7-0. NC2484.2 +049600 SET TEST-7-1-TRUE TO TRUE. NC2484.2 +049700 GO TO SET-TEST-F2-7-1. NC2484.2 +049800 SET-DELETE-F2-7. NC2484.2 +049900 PERFORM DE-LETE. NC2484.2 +050000 GO TO SET-WRITE-F2-7-1. NC2484.2 +050100* NC2484.2 +050200 SET-TEST-F2-7-1. NC2484.2 +050300 IF TEST-7-1 = "%" NC2484.2 +050400 PERFORM PASS NC2484.2 +050500 GO TO SET-WRITE-F2-7-1 NC2484.2 +050600 ELSE NC2484.2 +050700 GO TO SET-FAIL-F2-7-1. NC2484.2 +050800 SET-DELETE-F2-7-1. NC2484.2 +050900 PERFORM DE-LETE. NC2484.2 +051000 GO TO SET-WRITE-F2-7-1. NC2484.2 +051100 SET-FAIL-F2-7-1. NC2484.2 +051200 PERFORM FAIL. NC2484.2 +051300 MOVE "CONDITION VARIABLE NOT SET TO TRUE VALUE" NC2484.2 +051400 TO RE-MARK. NC2484.2 +051500 MOVE TEST-7-1 TO COMPUTED-X. NC2484.2 +051600 MOVE "%" TO CORRECT-X. NC2484.2 +051700 SET-WRITE-F2-7-1. NC2484.2 +051800 PERFORM PRINT-DETAIL. NC2484.2 +051900* NC2484.2 +052000 SET-INIT-F2-8. NC2484.2 +052100 MOVE "SET-TEST-F2-8" TO PAR-NAME. NC2484.2 +052200 MOVE "VI-128 6.22.4 GR7" TO ANSI-REFERENCE. NC2484.2 +052300 MOVE SPACE TO TEST-8-1. NC2484.2 +052400 SET-TEST-F2-8-0. NC2484.2 +052500 SET TEST-8-1-1-TRUE TO TRUE. NC2484.2 +052600 GO TO SET-TEST-F2-8-1. NC2484.2 +052700 SET-DELETE-F2-8. NC2484.2 +052800 PERFORM DE-LETE. NC2484.2 +052900 GO TO SET-WRITE-F2-8-1. NC2484.2 +053000* NC2484.2 +053100 SET-TEST-F2-8-1. NC2484.2 +053200 IF TEST-8-1 = "J" NC2484.2 +053300 PERFORM PASS NC2484.2 +053400 GO TO SET-WRITE-F2-8-1 NC2484.2 +053500 ELSE NC2484.2 +053600 GO TO SET-FAIL-F2-8-1. NC2484.2 +053700 SET-DELETE-F2-8-1. NC2484.2 +053800 PERFORM DE-LETE. NC2484.2 +053900 GO TO SET-WRITE-F2-8-1. NC2484.2 +054000 SET-FAIL-F2-8-1. NC2484.2 +054100 PERFORM FAIL. NC2484.2 +054200 MOVE "CONDITION VARIABLE NOT SET TO FIRST TRUE VALUE" NC2484.2 +054300 TO RE-MARK. NC2484.2 +054400 MOVE TEST-8-1 TO COMPUTED-X. NC2484.2 +054500 MOVE "J" TO CORRECT-X. NC2484.2 +054600 SET-WRITE-F2-8-1. NC2484.2 +054700 PERFORM PRINT-DETAIL. NC2484.2 +054800* NC2484.2 +054900 SET-INIT-F2-9. NC2484.2 +055000 MOVE "SET-TEST-F2-9" TO PAR-NAME. NC2484.2 +055100 MOVE "VI-128 6.22.4 GR7" TO ANSI-REFERENCE. NC2484.2 +055200 MOVE SPACE TO TEST-8-1. NC2484.2 +055300 MOVE 1 TO REC-CT. NC2484.2 +055400 SET-TEST-F2-9-0. NC2484.2 +055500 SET TEST-9-1-1-TRUE NC2484.2 +055600 TEST-9-2-1-TRUE NC2484.2 +055700 TEST-9-3-1-TRUE TO TRUE. NC2484.2 +055800 GO TO SET-TEST-F2-9-1. NC2484.2 +055900 SET-DELETE-F2-9. NC2484.2 +056000 PERFORM DE-LETE. NC2484.2 +056100 GO TO SET-WRITE-F2-9-3. NC2484.2 +056200* NC2484.2 +056300 SET-TEST-F2-9-1. NC2484.2 +056400 IF TEST-9-1 = "6" NC2484.2 +056500 PERFORM PASS NC2484.2 +056600 GO TO SET-WRITE-F2-9-1 NC2484.2 +056700 ELSE NC2484.2 +056800 GO TO SET-FAIL-F2-9-1. NC2484.2 +056900 SET-DELETE-F2-9-1. NC2484.2 +057000 PERFORM DE-LETE. NC2484.2 +057100 GO TO SET-WRITE-F2-9-1. NC2484.2 +057200 SET-FAIL-F2-9-1. NC2484.2 +057300 PERFORM FAIL. NC2484.2 +057400 MOVE "CONDITION VARIABLE NOT SET TO FIRST TRUE VALUE" NC2484.2 +057500 TO RE-MARK. NC2484.2 +057600 MOVE TEST-9-1 TO COMPUTED-X. NC2484.2 +057700 MOVE "6" TO CORRECT-X. NC2484.2 +057800 SET-WRITE-F2-9-1. NC2484.2 +057900 PERFORM PRINT-DETAIL. NC2484.2 +058000* NC2484.2 +058100 SET-TEST-F2-9-2. NC2484.2 +058200 ADD 1 TO REC-CT. NC2484.2 +058300 IF TEST-9-2 = "B" NC2484.2 +058400 PERFORM PASS NC2484.2 +058500 GO TO SET-WRITE-F2-9-2 NC2484.2 +058600 ELSE NC2484.2 +058700 GO TO SET-FAIL-F2-9-2. NC2484.2 +058800 SET-DELETE-F2-9-2. NC2484.2 +058900 PERFORM DE-LETE. NC2484.2 +059000 GO TO SET-WRITE-F2-9-2. NC2484.2 +059100 SET-FAIL-F2-9-2. NC2484.2 +059200 PERFORM FAIL. NC2484.2 +059300 MOVE "CONDITION VARIABLE NOT SET TO FIRST TRUE VALUE" NC2484.2 +059400 TO RE-MARK. NC2484.2 +059500 MOVE TEST-9-2 TO COMPUTED-X. NC2484.2 +059600 MOVE "6" TO CORRECT-X. NC2484.2 +059700 SET-WRITE-F2-9-2. NC2484.2 +059800 PERFORM PRINT-DETAIL. NC2484.2 +059900* NC2484.2 +060000 SET-TEST-F2-9-3. NC2484.2 +060100 ADD 1 TO REC-CT. NC2484.2 +060200 IF TEST-9-3 = "*" NC2484.2 +060300 PERFORM PASS NC2484.2 +060400 GO TO SET-WRITE-F2-9-3 NC2484.2 +060500 ELSE NC2484.2 +060600 GO TO SET-FAIL-F2-9-3. NC2484.2 +060700 SET-DELETE-F2-9-3. NC2484.2 +060800 PERFORM DE-LETE. NC2484.2 +060900 GO TO SET-WRITE-F2-9-3. NC2484.2 +061000 SET-FAIL-F2-9-3. NC2484.2 +061100 PERFORM FAIL. NC2484.2 +061200 MOVE "CONDITION VARIABLE NOT SET TO FIRST TRUE VALUE" NC2484.2 +061300 TO RE-MARK. NC2484.2 +061400 MOVE TEST-9-3 TO COMPUTED-X. NC2484.2 +061500 MOVE "*" TO CORRECT-X. NC2484.2 +061600 SET-WRITE-F2-9-3. NC2484.2 +061700 PERFORM PRINT-DETAIL. NC2484.2 +061800* NC2484.2 +061900 CCVS-EXIT SECTION. NC2484.2 +062000 CCVS-999999. NC2484.2 +062100 GO TO CLOSE-FILES. NC2484.2 diff --git a/tests/cobol85/NC/NC250A.CBL b/tests/cobol85/NC/NC250A.CBL new file mode 100755 index 00000000..61e97cd1 --- /dev/null +++ b/tests/cobol85/NC/NC250A.CBL @@ -0,0 +1,1971 @@ +000100 IDENTIFICATION DIVISION. NC2504.2 +000200 PROGRAM-ID. NC2504.2 +000300 NC250A. NC2504.2 +000400 NC2504.2 +000500**************************************************************** NC2504.2 +000600* * NC2504.2 +000700* VALIDATION FOR:- * NC2504.2 +000800* * NC2504.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2504.2 +001000* * NC2504.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2504.2 +001200* * NC2504.2 +001300**************************************************************** NC2504.2 +001400* * NC2504.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * NC2504.2 +001600* * NC2504.2 +001700* X-55 - SYSTEM PRINTER NAME. * NC2504.2 +001800* X-82 - SOURCE COMPUTER NAME. * NC2504.2 +001900* X-83 - OBJECT COMPUTER NAME. * NC2504.2 +002000* * NC2504.2 +002100**************************************************************** NC2504.2 +002200* NC2504.2 +002300* PROGRAM NC250A TESTS THE GENERAL FORMAT OF THE "IF" STATEMENTNC2504.2 +002400* A VARIETY OF QUALIFIED DATA-NAMES AND CONDITION-NAMES NC2504.2 +002500* ARE USED. NC2504.2 +002600* NC2504.2 +002700 NC2504.2 +002800 ENVIRONMENT DIVISION. NC2504.2 +002900 CONFIGURATION SECTION. NC2504.2 +003000 SOURCE-COMPUTER. NC2504.2 +003100 Linux. NC2504.2 +003200 OBJECT-COMPUTER. NC2504.2 +003300 Linux. NC2504.2 +003400 INPUT-OUTPUT SECTION. NC2504.2 +003500 FILE-CONTROL. NC2504.2 +003600 SELECT PRINT-FILE ASSIGN TO NC2504.2 +003700 "report.log". NC2504.2 +003800 DATA DIVISION. NC2504.2 +003900 FILE SECTION. NC2504.2 +004000 FD PRINT-FILE. NC2504.2 +004100 01 PRINT-REC PICTURE X(120). NC2504.2 +004200 01 DUMMY-RECORD PICTURE X(120). NC2504.2 +004300 WORKING-STORAGE SECTION. NC2504.2 +004400 01 WRK-DU-1V0-1 PIC 9 VALUE 1. NC2504.2 +004500 01 WRK-DU-1V0-2 PIC 9 VALUE 2. NC2504.2 +004600 01 WRK-DU-1V0-3 PIC 9 VALUE 3. NC2504.2 +004700 01 WRK-DU-1V0-4 PIC 9 VALUE ZERO. NC2504.2 +004800 01 WRK-DU-2V0-1 PIC 99 VALUE 10. NC2504.2 +004900 01 WRK-DU-2V0-2 PIC 99 VALUE 11. NC2504.2 +005000 01 WRK-DU-2V0-3 PIC 99 VALUE 12. NC2504.2 +005100 77 SMALL-VALU PICTURE 99 VALUE 7. NC2504.2 +005200 77 SMALLER-VALU PICTURE 99 VALUE 6. NC2504.2 +005300 77 SMALLEST-VALU PICTURE 99 VALUE 5. NC2504.2 +005400 77 EVEN-SMALLER PICTURE 99 VALUE 1. NC2504.2 +005500 77 WRK-DS-02V00 PICTURE S99. NC2504.2 +005600 88 TEST-2NUC-COND-99 VALUE 99. NC2504.2 +005700 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2504.2 +005800 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 NC2504.2 +005900 PICTURE S9(12). NC2504.2 +006000 77 A02TWOS-DS-02V00 PICTURE S99 VALUE 22. NC2504.2 +006100 77 WRK-DS-01V00 PICTURE S9. NC2504.2 +006200 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2504.2 +006300 77 A990-DS-0201P PICTURE S99P VALUE 990. NC2504.2 +006400 77 A02ONES-DS-02V00 PICTURE S99 VALUE 11. NC2504.2 +006500 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001.NC2504.2 +006600 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2504.2 +006700 77 WRK-XN-00001 PICTURE X. NC2504.2 +006800 77 WRK-XN-00005 PICTURE X(5). NC2504.2 +006900 77 TWO PICTURE 9 VALUE 2. NC2504.2 +007000 77 THREE PICTURE 9 VALUE 3. NC2504.2 +007100 77 SEVEN PICTURE 9 VALUE 7. NC2504.2 +007200 77 EIGHT PICTURE 9 VALUE 8. NC2504.2 +007300 77 NINE PICTURE 9 VALUE 9. NC2504.2 +007400 77 TEN PICTURE 99 VALUE 10. NC2504.2 +007500 77 TWENTY PICTURE 99 VALUE 20. NC2504.2 +007600 77 ALTERCOUNT PICTURE 999 VALUE ZERO. NC2504.2 +007700 77 XRAY PICTURE IS X. NC2504.2 +007800 77 IF-D1 PICTURE S9(4)V9(2) VALUE 0. NC2504.2 +007900 77 IF-D2 PICTURE S9(4)V9(2) VALUE ZERO. NC2504.2 +008000 77 IF-D3 PICTURE X(10) VALUE "0000000000". NC2504.2 +008100 77 IF-D4 PICTURE X(15) VALUE " ". NC2504.2 +008200 77 IF-D5 PICTURE X(10) VALUE ALL QUOTE. NC2504.2 +008300 77 IF-D6 PICTURE A(10) VALUE "BABABABABA". NC2504.2 +008400 77 IF-D7 PICTURE S9(6)V9(4) VALUE +123.45. NC2504.2 +008500 77 IF-D8 PICTURE 9(6)V9(4) VALUE 12300. NC2504.2 +008600 77 IF-D9 PICTURE X(3) VALUE "123". NC2504.2 +008700 77 IF-D11 PICTURE X(6) VALUE "ABCDEF". NC2504.2 +008800 77 IF-D13 PICTURE 9(6)V9(4) VALUE 12300. NC2504.2 +008900 77 IF-D14 PICTURE S9(4)V9(2) VALUE +123.45. NC2504.2 +009000 77 IF-D15 PICTURE S999PP VALUE 12300. NC2504.2 +009100 77 IF-D16 PICTURE PP99 VALUE .0012. NC2504.2 +009200 77 IF-D17 PICTURE SV9(4) VALUE .0012. NC2504.2 +009300 77 IF-D18 PICTURE X(10) VALUE "BABABABABA". NC2504.2 +009400 77 IF-D19 PICTURE X(10) VALUE "ABCDEF ". NC2504.2 +009500 77 IF-D23 PICTURE $9,9B9.90+. NC2504.2 +009600 77 IF-D24 PICTURE X(10) VALUE "$1,2 3.40+". NC2504.2 +009700 77 IF-D25 PICTURE ABABX0A. NC2504.2 +009800 77 IF-D26 PICTURE X(8) VALUE "A C D0E". NC2504.2 +009900 77 IF-D27 PICTURE IS 9(6)V9(4) VALUE IS 2137.45 NC2504.2 +010000 USAGE IS COMPUTATIONAL. NC2504.2 +010100 77 IF-D28 PICTURE IS 999999V9999 VALUE IS 2137.45. NC2504.2 +010200 77 IF-D31 PICTURE S9(6) VALUE -123. NC2504.2 +010300 77 IF-D32 PICTURE S9(4)V99. NC2504.2 +010400 88 A VALUE 1. NC2504.2 +010500 88 B VALUES ARE 2 THRU 4. NC2504.2 +010600 88 C VALUE IS ZERO. NC2504.2 +010700 88 D VALUE IS +12.34. NC2504.2 +010800 88 E VALUE IS .01, .11, .21 .81. NC2504.2 +010900 88 F VALUE IS 100 THRU 128 1000 THRU 1280 -9 THRU -2. NC2504.2 +011000 88 G VALUE IS 8765.43 1234 THRU 5678 5 -9999 THRU 10. NC2504.2 +011100 77 IF-D33 PICTURE X(4). NC2504.2 +011200 88 B VALUE QUOTE. NC2504.2 +011300 88 C VALUE SPACE. NC2504.2 +011400 88 D VALUE ALL "BAC". NC2504.2 +011500 77 IF-D34 PICTURE A(4). NC2504.2 +011600 88 B VALUE "A A ". NC2504.2 +011700 77 IF-D37 PICTURE 9(5) VALUE 12345. NC2504.2 +011800 77 IF-D38 PICTURE X(9) VALUE "12345 ". NC2504.2 +011900 77 CCON-1 PICTURE 99 VALUE 11. NC2504.2 +012000 77 CCON-2 PICTURE 99 VALUE 12. NC2504.2 +012100 77 CCON-3 PICTURE 99 VALUE 13. NC2504.2 +012200 77 COMP-SGN1 PICTURE S9(1) VALUE +9 COMPUTATIONAL. NC2504.2 +012300 77 COMP-SGN2 PICTURE S9(18) VALUE +3 COMPUTATIONAL. NC2504.2 +012400 77 COMP-SGN3 PICTURE S9(1) VALUE -5 COMPUTATIONAL. NC2504.2 +012500 77 COMP-SGN4 PICTURE S9(18) VALUE -3167598765431 COMPUTATIONAL.NC2504.2 +012600 77 START-POINT PICTURE 9(6) COMPUTATIONAL. NC2504.2 +012700 77 INC-VALUE PICTURE 9(6) COMPUTATIONAL. NC2504.2 +012800 77 SWITCH-PFM-1 PICTURE 9 VALUE ZERO. NC2504.2 +012900 77 SWITCH-PFM-2 PICTURE 9 VALUE ZERO. NC2504.2 +013000 77 PFM-11-COUNTER PICTURE 999 VALUE ZERO. NC2504.2 +013100 77 PFM-12-COUNTER PICTURE 999 VALUE 100. NC2504.2 +013200 77 PFM-12-ANS1 PICTURE 999 VALUE ZERO. NC2504.2 +013300 77 PFM-12-ANS2 PICTURE 999 VALUE ZERO. NC2504.2 +013400 01 SUBSCRIPT-6 PICTURE 99999 VALUE ZERO. NC2504.2 +013500 01 IF-TABLE. NC2504.2 +013600 02 IF-ELEM PICTURE X OCCURS 12 TIMES. NC2504.2 +013700 01 QUOTE-DATA. NC2504.2 +013800 02 QU-1 PICTURE X(3) VALUE "123". NC2504.2 +013900 02 QU-2 PICTURE X VALUE QUOTE. NC2504.2 +014000 02 QU-3 PICTURE X(6) VALUE "ABC456". NC2504.2 +014100 01 IF-D10. NC2504.2 +014200 02 D1 PICTURE X(2) VALUE "01". NC2504.2 +014300 02 D2 PICTURE X(2) VALUE "23". NC2504.2 +014400 02 D3. NC2504.2 +014500 03 D4 PICTURE X(4) VALUE "4567". NC2504.2 +014600 03 D5 PICTURE X(4) VALUE "8912". NC2504.2 +014700 01 IF-D12. NC2504.2 +014800 02 D1 PICTURE X(3) VALUE "ABC". NC2504.2 +014900 02 D2. NC2504.2 +015000 03 D3. NC2504.2 +015100 04 D4 PICTURE XX VALUE "DE". NC2504.2 +015200 04 D5 PICTURE X VALUE "F". NC2504.2 +015300 01 IF-D20. NC2504.2 +015400 02 FILLER PICTURE 9(5) VALUE ZERO. NC2504.2 +015500 02 D1 PICTURE 9(2) VALUE 12. NC2504.2 +015600 02 D2 PICTURE 9 VALUE 3. NC2504.2 +015700 02 D3 PICTURE 9(2) VALUE 45. NC2504.2 +015800 01 IF-D21. NC2504.2 +015900 02 D1 PICTURE 9(5) VALUE ZEROS. NC2504.2 +016000 02 D2 PICTURE 9(5) VALUE 12345. NC2504.2 +016100 01 IF-D22. NC2504.2 +016200 02 D1 PICTURE A(2) VALUE "AB". NC2504.2 +016300 02 D2 PICTURE A(4) VALUE "CDEF". NC2504.2 +016400 01 IF-D35. NC2504.2 +016500 02 AA PICTURE X(2). NC2504.2 +016600 88 A1 VALUE "AA". NC2504.2 +016700 88 A2 VALUE "AB". NC2504.2 +016800 02 BB PICTURE IS X(2). NC2504.2 +016900 88 B1 VALUE "CC". NC2504.2 +017000 88 B2 VALUE "CD". NC2504.2 +017100 02 BB-2 REDEFINES BB. NC2504.2 +017200 03 AAA PICTURE X. NC2504.2 +017300 88 AA1 VALUE "A". NC2504.2 +017400 88 AA2 VALUE "C". NC2504.2 +017500 03 BBB PICTURE X. NC2504.2 +017600 88 BB1 VALUE "B". NC2504.2 +017700 88 BB2 VALUE "D". NC2504.2 +017800 01 IF-D36 PICTURE X(120) VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYNC2504.2 +017900- "Z1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCDEFGHIJKLMNC2504.2 +018000- "NOPQRSTUVWXYZ1234567890ABCDEFGHIJKL". NC2504.2 +018100 01 IF-D40 PICTURE 9(5) VALUE 12345 NC2504.2 +018200 COMPUTATIONAL SYNCHRONIZED RIGHT. NC2504.2 +018300 88 IF-D40A VALUE ZERO THRU 10000. NC2504.2 +018400 88 IF-D40B VALUE 10001 THRU 99999. NC2504.2 +018500 88 IF-D40C VALUE 99999. NC2504.2 +018600 01 PERFORM1 PICTURE XXX VALUE SPACES. NC2504.2 +018700 01 PERFORM2 PICTURE S999 VALUE 20. NC2504.2 +018800 01 PERFORM3 PICTURE 9 VALUE 5. NC2504.2 +018900 01 PERFORM4 PICTURE S99V9. NC2504.2 +019000 01 PERFORM5 PICTURE S99V9 VALUE 10.0. NC2504.2 +019100 01 PERFORM6 PICTURE 99V9. NC2504.2 +019200 01 PERFORM7. NC2504.2 +019300 02 PERFORM8 OCCURS 7 TIMES PICTURE 99V9. NC2504.2 +019400 01 PERFORM9 PICTURE 9 VALUE 3. NC2504.2 +019500 01 PERFORM10 PICTURE S9 VALUE -1. NC2504.2 +019600 01 PERFORM11 PICTURE 99 VALUE 6. NC2504.2 +019700 01 PERFORM12. NC2504.2 +019800 02 PERFORM13 OCCURS 4 TIMES. NC2504.2 +019900 03 PERFORM14 OCCURS 20 TIMES PICTURE 99V9. NC2504.2 +020000 03 PERFORM15 OCCURS 10 TIMES. NC2504.2 +020100 04 PERFORM16 OCCURS 5 TIMES PICTURE 99V9. NC2504.2 +020200 01 PERFORM17 PICTURE 9(6) COMPUTATIONAL. NC2504.2 +020300 01 PERFORM18 PICTURE 9(6) COMPUTATIONAL. NC2504.2 +020400 01 PERFORM-KEY PICTURE 9. NC2504.2 +020500 01 PERFORM-SEVEN-LEVEL-TABLE. NC2504.2 +020600 03 PFM71 OCCURS 2. NC2504.2 +020700 05 PFM72 OCCURS 2. NC2504.2 +020800 07 PFM73 OCCURS 2. NC2504.2 +020900 09 PFM74 OCCURS 2. NC2504.2 +021000 11 PFM75 OCCURS 2. NC2504.2 +021100 13 PFM76 OCCURS 2. NC2504.2 +021200 15 PFM77 OCCURS 2. NC2504.2 +021300 17 PFM77-1 PIC X. NC2504.2 +021400 01 S1 PIC S9(3) COMP. NC2504.2 +021500 01 S2 PIC S9(3) COMP. NC2504.2 +021600 01 S3 PIC S9(3) COMP. NC2504.2 +021700 01 S4 PIC S9(3) COMP. NC2504.2 +021800 01 S5 PIC S9(3) COMP. NC2504.2 +021900 01 S6 PIC S9(3) COMP. NC2504.2 +022000 01 S7 PIC S9(3) COMP. NC2504.2 +022100 01 PFM-7-TOT PIC S9(3) COMP. NC2504.2 +022200 01 PFM-F4-24-TOT PIC S9(3) COMP. NC2504.2 +022300 01 PFM-A PIC S9(3) COMP. NC2504.2 +022400 01 PFM-B PIC S9(3) COMP. NC2504.2 +022500 01 FILLER-A. NC2504.2 +022600 03 PFM-F4-25-A PIC S9(3) COMP OCCURS 10. NC2504.2 +022700 01 FILLER-B. NC2504.2 +022800 03 PFM-F4-25-B PIC S9(3) COMP OCCURS 10. NC2504.2 +022900 01 FILLER-C. NC2504.2 +023000 03 PFM-F4-25-C PIC S9(3) COMP OCCURS 10. NC2504.2 +023100 01 RECEIVING-TABLE. NC2504.2 +023200 03 TBL-ELEMEN-A. NC2504.2 +023300 05 TBL-ELEMEN-B PICTURE X(18). NC2504.2 +023400 05 TBL-ELEMEN-C PICTURE X(18). NC2504.2 +023500 03 TBL-ELEMEN-D. NC2504.2 +023600 05 TBL-ELEMEN-E PICTURE X OCCURS 36 TIMES. NC2504.2 +023700 01 LITERAL-SPLITTER. NC2504.2 +023800 02 PART1 PICTURE X(20). NC2504.2 +023900 02 PART2 PICTURE X(20). NC2504.2 +024000 02 PART3 PICTURE X(20). NC2504.2 +024100 02 PART4 PICTURE X(20). NC2504.2 +024200 01 LITERAL-TABLE REDEFINES LITERAL-SPLITTER. NC2504.2 +024300 02 80PARTS PICTURE X OCCURS 80 TIMES. NC2504.2 +024400 01 GRP-FOR-88-LEVELS. NC2504.2 +024500 03 WRK-DS-02V00-COND PICTURE 99. NC2504.2 +024600 88 COND-1 VALUE IS 01 THRU 05. NC2504.2 +024700 88 COND-2 VALUES ARE 06 THRU 10 NC2504.2 +024800 16 THRU 20 00. NC2504.2 +024900 88 COND-3 VALUES 11 THRU 15. NC2504.2 +025000 01 GRP-MOVE-CONSTANTS. NC2504.2 +025100 03 GRP-GROUP-MOVE-FROM. NC2504.2 +025200 04 GRP-ALPHABETIC. NC2504.2 +025300 05 ALPHABET-AN-00026 PICTURE A(26) NC2504.2 +025400 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". NC2504.2 +025500 04 GRP-NUMERIC. NC2504.2 +025600 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789. NC2504.2 +025700 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 NC2504.2 +025800 PICTURE 9(6)V9999. NC2504.2 +025900 04 GRP-ALPHANUMERIC. NC2504.2 +026000 05 ALPHANUMERIC-XN-00049 PICTURE X(50) NC2504.2 +026100 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-><=$,;.()/* 0123456789". NC2504.2 +026200 05 FILLER PICTURE X VALUE QUOTE. NC2504.2 +026300 01 GRP-FOR-2N058. NC2504.2 +026400 02 SUB-GRP-FOR-2N058-A. NC2504.2 +026500 03 ELEM-FOR-2N058-A PICTURE 999 VALUE ZEROES. NC2504.2 +026600 03 ELEM-FOR-2N058-B PICTURE XXX VALUE ZEROS. NC2504.2 +026700 03 ELEM-FOR-2N058-C PICTURE XXX VALUE SPACES. NC2504.2 +026800 03 ELEM-FOR-2N058-D PICTURE X(6) VALUE ALL "ABC". NC2504.2 +026900 03 ELEM-FOR-2N058-E PICTURE XXX VALUE ALL "Z". NC2504.2 +027000 03 ELEM-FOR-2N058-F PICTURE XXX VALUE ALL SPACES. NC2504.2 +027100 03 ELEM-FOR-2N058-G PICTURE XXX VALUE ALL ZEROES. NC2504.2 +027200 03 ELEM-FOR-2N058-H PICTURE 999 VALUE ALL ZEROS. NC2504.2 +027300 03 ELEM-FOR-2N058-I PICTURE XXX VALUE QUOTES. NC2504.2 +027400 03 ELEM-FOR-2N058-J PICTURE XXX VALUE ALL QUOTES. NC2504.2 +027500 03 ELEM-FOR-2N058-K PICTURE XXX VALUE ALL HIGH-VALUES. NC2504.2 +027600 03 ELEM-FOR-2N058-L PICTURE XXX VALUE ALL LOW-VALUES. NC2504.2 +027700 03 ELEM-FOR-2N058-M PICTURE XXX VALUE HIGH-VALUES. NC2504.2 +027800 03 ELEM-FOR-2N058-N PICTURE XXX VALUE LOW-VALUES. NC2504.2 +027900 02 SUB-GRP-FOR-2N058-B. NC2504.2 +028000 03 SUB-SUB-BA. NC2504.2 +028100 04 ELEM-FOR-2N058-A PICTURE 999. NC2504.2 +028200 04 ELEM-FOR-2N058-B PICTURE XXX. NC2504.2 +028300 04 ELEM-FOR-2N058-C PICTURE XXX. NC2504.2 +028400 04 ELEM-FOR-2N058-D PICTURE X(6). NC2504.2 +028500 03 SUB-SUB-BB. NC2504.2 +028600 04 ELEM-FOR-2N058-E PICTURE XXX. NC2504.2 +028700 04 ELEM-FOR-2N058-F PICTURE XXX. NC2504.2 +028800 04 ELEM-FOR-2N058-G PICTURE XXX. NC2504.2 +028900 04 ELEM-FOR-2N058-H PICTURE 999. NC2504.2 +029000 03 SUB-SUB-BC. NC2504.2 +029100 04 ELEM-FOR-2N058-I PICTURE XXX. NC2504.2 +029200 04 ELEM-FOR-2N058-J PICTURE XXX. NC2504.2 +029300 04 ELEM-FOR-2N058-K PICTURE XXX. NC2504.2 +029400 04 ELEM-FOR-2N058-L PICTURE XXX. NC2504.2 +029500 04 ELEM-FOR-2N058-M PICTURE XXX. NC2504.2 +029600 04 ELEM-FOR-2N058-N PICTURE XXX. NC2504.2 +029700 01 CHARACTER-BREAKDOWN-S. NC2504.2 +029800 02 FIRST-20S PICTURE X(20). NC2504.2 +029900 02 SECOND-20S PICTURE X(20). NC2504.2 +030000 02 THIRD-20S PICTURE X(20). NC2504.2 +030100 02 FOURTH-20S PICTURE X(20). NC2504.2 +030200 02 FIFTH-20S PICTURE X(20). NC2504.2 +030300 02 SIXTH-20S PICTURE X(20). NC2504.2 +030400 02 SEVENTH-20S PICTURE X(20). NC2504.2 +030500 02 EIGHTH-20S PICTURE X(20). NC2504.2 +030600 02 NINTH-20S PICTURE X(20). NC2504.2 +030700 02 TENTH-20S PICTURE X(20). NC2504.2 +030800 01 CHARACTER-BREAKDOWN-R. NC2504.2 +030900 02 FIRST-20R PICTURE X(20). NC2504.2 +031000 02 SECOND-20R PICTURE X(20). NC2504.2 +031100 02 THIRD-20R PICTURE X(20). NC2504.2 +031200 02 FOURTH-20R PICTURE X(20). NC2504.2 +031300 02 FIFTH-20R PICTURE X(20). NC2504.2 +031400 02 SIXTH-20R PICTURE X(20). NC2504.2 +031500 02 SEVENTH-20R PICTURE X(20). NC2504.2 +031600 02 EIGHTH-20R PICTURE X(20). NC2504.2 +031700 02 NINTH-20R PICTURE X(20). NC2504.2 +031800 02 TENTH-20R PICTURE X(20). NC2504.2 +031900 01 TABLE-80. NC2504.2 +032000 02 ELMT OCCURS 3 TIMES PIC 9. NC2504.2 +032100 88 A80 VALUES ARE ZERO THRU 7. NC2504.2 +032200 88 B80 VALUE 8. NC2504.2 +032300 88 C80 VALUES ARE 7, 8 THROUGH 9. NC2504.2 +032400 NC2504.2 +032500 01 TABLE-86. NC2504.2 +032600 88 A86 VALUE "ABC". NC2504.2 +032700 88 B86 VALUE "ABCABC". NC2504.2 +032800 88 C86 VALUE " ABC". NC2504.2 +032900 02 DATANAME-86 PIC XXX VALUE "ABC". NC2504.2 +033000 02 DNAME-86. NC2504.2 +033100 03 FILLER PIC X VALUE "A". NC2504.2 +033200 03 FILLER PIC X VALUE "B". NC2504.2 +033300 03 FILLER PIC X VALUE "C". NC2504.2 +033400 01 FIGCON-DATA. NC2504.2 +033500 02 SPACE-X PICTURE X(10) VALUE " ". NC2504.2 +033600 02 QUOTE-X PICTURE X(5) VALUE QUOTE. NC2504.2 +033700 02 LOW-VAL PICTURE X(5) VALUE LOW-VALUE. NC2504.2 +033800 02 ABC PICTURE XXX VALUE "ABC". NC2504.2 +033900 02 ONE23 PICTURE 9999 VALUE 123. NC2504.2 +034000 02 ZERO-C PICTURE 9(10) VALUE 0 COMPUTATIONAL. NC2504.2 +034100 02 ZERO-D PICTURE 9 VALUE ZERO USAGE DISPLAY. NC2504.2 +034200 01 TEST-RESULTS. NC2504.2 +034300 02 FILLER PIC X VALUE SPACE. NC2504.2 +034400 02 FEATURE PIC X(20) VALUE SPACE. NC2504.2 +034500 02 FILLER PIC X VALUE SPACE. NC2504.2 +034600 02 P-OR-F PIC X(5) VALUE SPACE. NC2504.2 +034700 02 FILLER PIC X VALUE SPACE. NC2504.2 +034800 02 PAR-NAME. NC2504.2 +034900 03 FILLER PIC X(19) VALUE SPACE. NC2504.2 +035000 03 PARDOT-X PIC X VALUE SPACE. NC2504.2 +035100 03 DOTVALUE PIC 99 VALUE ZERO. NC2504.2 +035200 02 FILLER PIC X(8) VALUE SPACE. NC2504.2 +035300 02 RE-MARK PIC X(61). NC2504.2 +035400 01 TEST-COMPUTED. NC2504.2 +035500 02 FILLER PIC X(30) VALUE SPACE. NC2504.2 +035600 02 FILLER PIC X(17) VALUE NC2504.2 +035700 " COMPUTED=". NC2504.2 +035800 02 COMPUTED-X. NC2504.2 +035900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2504.2 +036000 03 COMPUTED-N REDEFINES COMPUTED-A NC2504.2 +036100 PIC -9(9).9(9). NC2504.2 +036200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2504.2 +036300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2504.2 +036400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2504.2 +036500 03 CM-18V0 REDEFINES COMPUTED-A. NC2504.2 +036600 04 COMPUTED-18V0 PIC -9(18). NC2504.2 +036700 04 FILLER PIC X. NC2504.2 +036800 03 FILLER PIC X(50) VALUE SPACE. NC2504.2 +036900 01 TEST-CORRECT. NC2504.2 +037000 02 FILLER PIC X(30) VALUE SPACE. NC2504.2 +037100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2504.2 +037200 02 CORRECT-X. NC2504.2 +037300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2504.2 +037400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2504.2 +037500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2504.2 +037600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2504.2 +037700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2504.2 +037800 03 CR-18V0 REDEFINES CORRECT-A. NC2504.2 +037900 04 CORRECT-18V0 PIC -9(18). NC2504.2 +038000 04 FILLER PIC X. NC2504.2 +038100 03 FILLER PIC X(2) VALUE SPACE. NC2504.2 +038200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2504.2 +038300 01 CCVS-C-1. NC2504.2 +038400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2504.2 +038500- "SS PARAGRAPH-NAME NC2504.2 +038600- " REMARKS". NC2504.2 +038700 02 FILLER PIC X(20) VALUE SPACE. NC2504.2 +038800 01 CCVS-C-2. NC2504.2 +038900 02 FILLER PIC X VALUE SPACE. NC2504.2 +039000 02 FILLER PIC X(6) VALUE "TESTED". NC2504.2 +039100 02 FILLER PIC X(15) VALUE SPACE. NC2504.2 +039200 02 FILLER PIC X(4) VALUE "FAIL". NC2504.2 +039300 02 FILLER PIC X(94) VALUE SPACE. NC2504.2 +039400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2504.2 +039500 01 REC-CT PIC 99 VALUE ZERO. NC2504.2 +039600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2504.2 +039700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2504.2 +039800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2504.2 +039900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2504.2 +040000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2504.2 +040100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2504.2 +040200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2504.2 +040300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2504.2 +040400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2504.2 +040500 01 CCVS-H-1. NC2504.2 +040600 02 FILLER PIC X(39) VALUE SPACES. NC2504.2 +040700 02 FILLER PIC X(42) VALUE NC2504.2 +040800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2504.2 +040900 02 FILLER PIC X(39) VALUE SPACES. NC2504.2 +041000 01 CCVS-H-2A. NC2504.2 +041100 02 FILLER PIC X(40) VALUE SPACE. NC2504.2 +041200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2504.2 +041300 02 FILLER PIC XXXX VALUE NC2504.2 +041400 "4.2 ". NC2504.2 +041500 02 FILLER PIC X(28) VALUE NC2504.2 +041600 " COPY - NOT FOR DISTRIBUTION". NC2504.2 +041700 02 FILLER PIC X(41) VALUE SPACE. NC2504.2 +041800 NC2504.2 +041900 01 CCVS-H-2B. NC2504.2 +042000 02 FILLER PIC X(15) VALUE NC2504.2 +042100 "TEST RESULT OF ". NC2504.2 +042200 02 TEST-ID PIC X(9). NC2504.2 +042300 02 FILLER PIC X(4) VALUE NC2504.2 +042400 " IN ". NC2504.2 +042500 02 FILLER PIC X(12) VALUE NC2504.2 +042600 " HIGH ". NC2504.2 +042700 02 FILLER PIC X(22) VALUE NC2504.2 +042800 " LEVEL VALIDATION FOR ". NC2504.2 +042900 02 FILLER PIC X(58) VALUE NC2504.2 +043000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2504.2 +043100 01 CCVS-H-3. NC2504.2 +043200 02 FILLER PIC X(34) VALUE NC2504.2 +043300 " FOR OFFICIAL USE ONLY ". NC2504.2 +043400 02 FILLER PIC X(58) VALUE NC2504.2 +043500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2504.2 +043600 02 FILLER PIC X(28) VALUE NC2504.2 +043700 " COPYRIGHT 1985 ". NC2504.2 +043800 01 CCVS-E-1. NC2504.2 +043900 02 FILLER PIC X(52) VALUE SPACE. NC2504.2 +044000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2504.2 +044100 02 ID-AGAIN PIC X(9). NC2504.2 +044200 02 FILLER PIC X(45) VALUE SPACES. NC2504.2 +044300 01 CCVS-E-2. NC2504.2 +044400 02 FILLER PIC X(31) VALUE SPACE. NC2504.2 +044500 02 FILLER PIC X(21) VALUE SPACE. NC2504.2 +044600 02 CCVS-E-2-2. NC2504.2 +044700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2504.2 +044800 03 FILLER PIC X VALUE SPACE. NC2504.2 +044900 03 ENDER-DESC PIC X(44) VALUE NC2504.2 +045000 "ERRORS ENCOUNTERED". NC2504.2 +045100 01 CCVS-E-3. NC2504.2 +045200 02 FILLER PIC X(22) VALUE NC2504.2 +045300 " FOR OFFICIAL USE ONLY". NC2504.2 +045400 02 FILLER PIC X(12) VALUE SPACE. NC2504.2 +045500 02 FILLER PIC X(58) VALUE NC2504.2 +045600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2504.2 +045700 02 FILLER PIC X(13) VALUE SPACE. NC2504.2 +045800 02 FILLER PIC X(15) VALUE NC2504.2 +045900 " COPYRIGHT 1985". NC2504.2 +046000 01 CCVS-E-4. NC2504.2 +046100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2504.2 +046200 02 FILLER PIC X(4) VALUE " OF ". NC2504.2 +046300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2504.2 +046400 02 FILLER PIC X(40) VALUE NC2504.2 +046500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2504.2 +046600 01 XXINFO. NC2504.2 +046700 02 FILLER PIC X(19) VALUE NC2504.2 +046800 "*** INFORMATION ***". NC2504.2 +046900 02 INFO-TEXT. NC2504.2 +047000 04 FILLER PIC X(8) VALUE SPACE. NC2504.2 +047100 04 XXCOMPUTED PIC X(20). NC2504.2 +047200 04 FILLER PIC X(5) VALUE SPACE. NC2504.2 +047300 04 XXCORRECT PIC X(20). NC2504.2 +047400 02 INF-ANSI-REFERENCE PIC X(48). NC2504.2 +047500 01 HYPHEN-LINE. NC2504.2 +047600 02 FILLER PIC IS X VALUE IS SPACE. NC2504.2 +047700 02 FILLER PIC IS X(65) VALUE IS "************************NC2504.2 +047800- "*****************************************". NC2504.2 +047900 02 FILLER PIC IS X(54) VALUE IS "************************NC2504.2 +048000- "******************************". NC2504.2 +048100 01 CCVS-PGM-ID PIC X(9) VALUE NC2504.2 +048200 "NC250A". NC2504.2 +048300 PROCEDURE DIVISION. NC2504.2 +048400 CCVS1 SECTION. NC2504.2 +048500 OPEN-FILES. NC2504.2 +048600 OPEN OUTPUT PRINT-FILE. NC2504.2 +048700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2504.2 +048800 MOVE SPACE TO TEST-RESULTS. NC2504.2 +048900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2504.2 +049000 GO TO CCVS1-EXIT. NC2504.2 +049100 CLOSE-FILES. NC2504.2 +049200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2504.2 +049300 TERMINATE-CCVS. NC2504.2 +049400 STOP RUN. NC2504.2 +049500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2504.2 +049600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2504.2 +049700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2504.2 +049800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2504.2 +049900 MOVE "****TEST DELETED****" TO RE-MARK. NC2504.2 +050000 PRINT-DETAIL. NC2504.2 +050100 IF REC-CT NOT EQUAL TO ZERO NC2504.2 +050200 MOVE "." TO PARDOT-X NC2504.2 +050300 MOVE REC-CT TO DOTVALUE. NC2504.2 +050400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2504.2 +050500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2504.2 +050600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2504.2 +050700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2504.2 +050800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2504.2 +050900 MOVE SPACE TO CORRECT-X. NC2504.2 +051000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2504.2 +051100 MOVE SPACE TO RE-MARK. NC2504.2 +051200 HEAD-ROUTINE. NC2504.2 +051300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +051400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +051500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2504.2 +051600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2504.2 +051700 COLUMN-NAMES-ROUTINE. NC2504.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +052100 END-ROUTINE. NC2504.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2504.2 +052300 END-RTN-EXIT. NC2504.2 +052400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +052500 END-ROUTINE-1. NC2504.2 +052600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2504.2 +052700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2504.2 +052800 ADD PASS-COUNTER TO ERROR-HOLD. NC2504.2 +052900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2504.2 +053000 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2504.2 +053100 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2504.2 +053200 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2504.2 +053300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2504.2 +053400 END-ROUTINE-12. NC2504.2 +053500 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2504.2 +053600 IF ERROR-COUNTER IS EQUAL TO ZERO NC2504.2 +053700 MOVE "NO " TO ERROR-TOTAL NC2504.2 +053800 ELSE NC2504.2 +053900 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2504.2 +054000 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2504.2 +054100 PERFORM WRITE-LINE. NC2504.2 +054200 END-ROUTINE-13. NC2504.2 +054300 IF DELETE-COUNTER IS EQUAL TO ZERO NC2504.2 +054400 MOVE "NO " TO ERROR-TOTAL ELSE NC2504.2 +054500 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2504.2 +054600 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2504.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +054800 IF INSPECT-COUNTER EQUAL TO ZERO NC2504.2 +054900 MOVE "NO " TO ERROR-TOTAL NC2504.2 +055000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2504.2 +055100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2504.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +055300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2504.2 +055400 WRITE-LINE. NC2504.2 +055500 ADD 1 TO RECORD-COUNT. NC2504.2 +055600 IF RECORD-COUNT GREATER 50 NC2504.2 +055700 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2504.2 +055800 MOVE SPACE TO DUMMY-RECORD NC2504.2 +055900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2504.2 +056000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2504.2 +056100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2504.2 +056200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2504.2 +056300 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2504.2 +056400 MOVE ZERO TO RECORD-COUNT. NC2504.2 +056500 PERFORM WRT-LN. NC2504.2 +056600 WRT-LN. NC2504.2 +056700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2504.2 +056800 MOVE SPACE TO DUMMY-RECORD. NC2504.2 +056900 BLANK-LINE-PRINT. NC2504.2 +057000 PERFORM WRT-LN. NC2504.2 +057100 FAIL-ROUTINE. NC2504.2 +057200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2504.2 +057300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2504.2 +057400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2504.2 +057500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2504.2 +057600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +057700 MOVE SPACES TO INF-ANSI-REFERENCE. NC2504.2 +057800 GO TO FAIL-ROUTINE-EX. NC2504.2 +057900 FAIL-ROUTINE-WRITE. NC2504.2 +058000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2504.2 +058100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2504.2 +058200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2504.2 +058300 MOVE SPACES TO COR-ANSI-REFERENCE. NC2504.2 +058400 FAIL-ROUTINE-EX. EXIT. NC2504.2 +058500 BAIL-OUT. NC2504.2 +058600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2504.2 +058700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2504.2 +058800 BAIL-OUT-WRITE. NC2504.2 +058900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2504.2 +059000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2504.2 +059100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2504.2 +059200 MOVE SPACES TO INF-ANSI-REFERENCE. NC2504.2 +059300 BAIL-OUT-EX. EXIT. NC2504.2 +059400 CCVS1-EXIT. NC2504.2 +059500 EXIT. NC2504.2 +059600 SECT-NC201A-001 SECTION. NC2504.2 +059700* NC2504.2 +059800 IF--INIT-A. NC2504.2 +059900 MOVE "VI-89 6.15" TO ANSI-REFERENCE. NC2504.2 +060000 PERFORM END-ROUTINE. NC2504.2 +060100 MOVE SPACE TO TEST-RESULTS. NC2504.2 +060200 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC2504.2 +060300 PERFORM PRINT-DETAIL. NC2504.2 +060400 MOVE "COMPARE FIGURATIVE " TO RE-MARK. NC2504.2 +060500 PERFORM PRINT-DETAIL. NC2504.2 +060600 MOVE "CONSTANTS, SIGN OF DATA, " TO RE-MARK. NC2504.2 +060700 PERFORM PRINT-DETAIL. NC2504.2 +060800 MOVE "AND CONDITION-NAMES " TO RE-MARK. NC2504.2 +060900 PERFORM PRINT-DETAIL. NC2504.2 +061000 MOVE "IN VARYING COMBINATIONS. " TO RE-MARK. NC2504.2 +061100 PERFORM PRINT-DETAIL. NC2504.2 +061200 MOVE "COMPARE-- " TO FEATURE. NC2504.2 +061300 PERFORM PRINT-DETAIL. NC2504.2 +061400 MOVE " FIG. CONSTANTS " TO FEATURE. NC2504.2 +061500 IF--TEST-1. NC2504.2 +061600 IF ZEROES IS EQUAL TO IF-D3 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +061700* NOTE FIGURATIVE ZEROES VS ALPHANUMERIC FIELD. NC2504.2 +061800 GO TO IF--WRITE-1. NC2504.2 +061900 IF--DELETE-1. NC2504.2 +062000 PERFORM DE-LETE. NC2504.2 +062100 IF--WRITE-1. NC2504.2 +062200 MOVE "IF--TEST-1 " TO PAR-NAME. NC2504.2 +062300 PERFORM PRINT-DETAIL. NC2504.2 +062400 IF--TEST-2. NC2504.2 +062500 IF SPACES EQUAL TO IF-D4 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +062600* NOTE FIGURATIVE SPACES VS ALPHANUMERIC FIELD. NC2504.2 +062700 GO TO IF--WRITE-2. NC2504.2 +062800 IF--DELETE-2. NC2504.2 +062900 PERFORM DE-LETE. NC2504.2 +063000 IF--WRITE-2. NC2504.2 +063100 MOVE "IF--TEST-2 " TO PAR-NAME. NC2504.2 +063200 PERFORM PRINT-DETAIL. NC2504.2 +063300 IF--TEST-3. NC2504.2 +063400 IF QUOTES EQUAL TO IF-D5 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +063500* NOTE FIGURATIVE QUOTES VS ALPHANUMERIC FIELD. NC2504.2 +063600 GO TO IF--WRITE-3. NC2504.2 +063700 IF--DELETE-3. NC2504.2 +063800 PERFORM DE-LETE. NC2504.2 +063900 IF--WRITE-3. NC2504.2 +064000 MOVE "IF--TEST-3 " TO PAR-NAME. NC2504.2 +064100 PERFORM PRINT-DETAIL. NC2504.2 +064200 IF--TEST-4. NC2504.2 +064300 IF IF-D6 EQUAL TO ALL "BA" PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +064400* NOTE ALL ANY LITERAL VS ALPHANUMERIC FIELD. NC2504.2 +064500 GO TO IF--WRITE-4. NC2504.2 +064600 IF--DELETE-4. NC2504.2 +064700 PERFORM DE-LETE. NC2504.2 +064800 IF--WRITE-4. NC2504.2 +064900 MOVE "IF--TEST-4 " TO PAR-NAME. NC2504.2 +065000 PERFORM PRINT-DETAIL. NC2504.2 +065100 IF--TEST-5. NC2504.2 +065200 IF IF-D4 GREATER THAN SPACES PERFORM FAIL ELSE NC2504.2 +065300 PERFORM PASS. NC2504.2 +065400* NOTE FIG-SPACES VS ALPHANUMERIC FIELD. NC2504.2 +065500 GO TO IF--WRITE-5. NC2504.2 +065600 IF--DELETE-5. NC2504.2 +065700 PERFORM DE-LETE. NC2504.2 +065800 IF--WRITE-5. NC2504.2 +065900 MOVE "IF--TEST-5 " TO PAR-NAME. NC2504.2 +066000 PERFORM PRINT-DETAIL. NC2504.2 +066100 IF--TEST-6. NC2504.2 +066200 IF QUOTES GREATER THAN IF-D5 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +066300* NOTE FIG-QUOTES VS ALPHANUMERIC FIELD. NC2504.2 +066400 GO TO IF--WRITE-6. NC2504.2 +066500 IF--DELETE-6. NC2504.2 +066600 PERFORM DE-LETE. NC2504.2 +066700 IF--WRITE-6. NC2504.2 +066800 MOVE "IF--TEST-6 " TO PAR-NAME. NC2504.2 +066900 PERFORM PRINT-DETAIL. NC2504.2 +067000 IF--TEST-7. NC2504.2 +067100 IF ALL "BA" GREATER THAN IF-D6 PERFORM FAIL NC2504.2 +067200 ELSE PERFORM PASS. NC2504.2 +067300* NOTE ALL ANY LITERAL VS ALPHA FIELD. NC2504.2 +067400 GO TO IF--WRITE-7. NC2504.2 +067500 IF--DELETE-7. NC2504.2 +067600 PERFORM DE-LETE. NC2504.2 +067700 IF--WRITE-7. NC2504.2 +067800 MOVE "IF--TEST-7 " TO PAR-NAME. NC2504.2 +067900 PERFORM PRINT-DETAIL. NC2504.2 +068000 IF--INIT-B. NC2504.2 +068100 MOVE " UNEQUAL LENGTHS " TO FEATURE. NC2504.2 +068200 IF--TEST-8. NC2504.2 +068300 IF IF-D22 GREATER THAN IF-D19 PERFORM FAIL ELSE PERFORM PASS.NC2504.2 +068400* NOTE ALPHANUMERIC GROUP VS ALPHANUMERIC FIELD. NC2504.2 +068500* NOTE UNEQUAL LENGTHS. NC2504.2 +068600 GO TO IF--WRITE-8. NC2504.2 +068700 IF--DELETE-8. NC2504.2 +068800 PERFORM DE-LETE. NC2504.2 +068900 IF--WRITE-8. NC2504.2 +069000 MOVE "IF--TEST-8 " TO PAR-NAME. NC2504.2 +069100 PERFORM PRINT-DETAIL. NC2504.2 +069200 IF--INIT-C. NC2504.2 +069300 MOVE " POSITIVE " TO FEATURE. NC2504.2 +069400 IF--TEST-9. NC2504.2 +069500 IF IF-D1 IS NOT POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +069600* NOTE POSITIVE TEST ON ZERO VALUE. NC2504.2 +069700 GO TO IF--WRITE-9. NC2504.2 +069800 IF--DELETE-9. NC2504.2 +069900 PERFORM DE-LETE. NC2504.2 +070000 IF--WRITE-9. NC2504.2 +070100 MOVE "IF--TEST-9 " TO PAR-NAME. NC2504.2 +070200 PERFORM PRINT-DETAIL. NC2504.2 +070300 IF--TEST-10. NC2504.2 +070400 IF IF-D8 POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +070500* NOTE POSITIVE TEST ON UNSIGNED VALUE. NC2504.2 +070600 GO TO IF--WRITE-10. NC2504.2 +070700 IF--DELETE-10. NC2504.2 +070800 PERFORM DE-LETE. NC2504.2 +070900 IF--WRITE-10. NC2504.2 +071000 MOVE "IF--TEST-10" TO PAR-NAME. NC2504.2 +071100 PERFORM PRINT-DETAIL. NC2504.2 +071200 IF--TEST-11. NC2504.2 +071300 IF IF-D16 POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +071400* NOTE POSITIVE TEST ON SCALED VALUE. NC2504.2 +071500 GO TO IF--WRITE-11. NC2504.2 +071600 IF--DELETE-11. NC2504.2 +071700 PERFORM DE-LETE. NC2504.2 +071800 IF--WRITE-11. NC2504.2 +071900 MOVE "IF--TEST-11" TO PAR-NAME. NC2504.2 +072000 PERFORM PRINT-DETAIL. NC2504.2 +072100 IF--TEST-12. NC2504.2 +072200 IF IF-D27 POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +072300* NOTE POSITIVE TEST ON COMPUTATIONAL FIELD. NC2504.2 +072400 GO TO IF--WRITE-12. NC2504.2 +072500 IF--DELETE-12. NC2504.2 +072600 PERFORM DE-LETE. NC2504.2 +072700 IF--WRITE-12. NC2504.2 +072800 MOVE "IF--TEST-12" TO PAR-NAME. NC2504.2 +072900 PERFORM PRINT-DETAIL. NC2504.2 +073000 IF--TEST-13. NC2504.2 +073100 IF IF-D28 POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +073200* NOTE POSITIVE TEST ON NUMERIC DISPLAY IFELD. NC2504.2 +073300 GO TO IF--WRITE-13. NC2504.2 +073400 IF--DELETE-13. NC2504.2 +073500 PERFORM DE-LETE. NC2504.2 +073600 IF--WRITE-13. NC2504.2 +073700 MOVE "IF--TEST-13" TO PAR-NAME. NC2504.2 +073800 PERFORM PRINT-DETAIL. NC2504.2 +073900 IF--TEST-14. NC2504.2 +074000 IF IF-D31 IS POSITIVE PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +074100* NOTE POSITIVE TEST ON NEGATIVE FIELD. NC2504.2 +074200 GO TO IF--WRITE-14. NC2504.2 +074300 IF--DELETE-14. NC2504.2 +074400 PERFORM DE-LETE. NC2504.2 +074500 IF--WRITE-14. NC2504.2 +074600 MOVE "IF--TEST-14" TO PAR-NAME. NC2504.2 +074700 PERFORM PRINT-DETAIL. NC2504.2 +074800 IF--TEST-15. NC2504.2 +074900 IF IF-D31 IS NOT POSITIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +075000* NOTE NOT POSITIVE TEST ON NEGATIVE VALUE. NC2504.2 +075100 GO TO IF--WRITE-15. NC2504.2 +075200 IF--DELETE-15. NC2504.2 +075300 PERFORM DE-LETE. NC2504.2 +075400 IF--WRITE-15. NC2504.2 +075500 MOVE "IF--TEST-15" TO PAR-NAME. NC2504.2 +075600 PERFORM PRINT-DETAIL. NC2504.2 +075700 IF--TEST-16. NC2504.2 +075800 IF IF-D28 IS NOT POSITIVE PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +075900* NOTE NOT POSITIVE TEST ON UNSIGNED FIELD. NC2504.2 +076000 GO TO IF--WRITE-16. NC2504.2 +076100 IF--DELETE-16. NC2504.2 +076200 PERFORM DE-LETE. NC2504.2 +076300 IF--WRITE-16. NC2504.2 +076400 MOVE "IF--TEST-16" TO PAR-NAME. NC2504.2 +076500 PERFORM PRINT-DETAIL. NC2504.2 +076600 IF--INIT-D. NC2504.2 +076700 MOVE " NEGATIVE " TO FEATURE. NC2504.2 +076800 IF--TEST-17. NC2504.2 +076900 IF IF-D31 IS NEGATIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +077000* NOTE NEGATIVE TEST ON NEGATIVE VALUE. NC2504.2 +077100 GO TO IF--WRITE-17. NC2504.2 +077200 IF--DELETE-17. NC2504.2 +077300 PERFORM DE-LETE. NC2504.2 +077400 IF--WRITE-17. NC2504.2 +077500 MOVE "IF--TEST-17" TO PAR-NAME. NC2504.2 +077600 PERFORM PRINT-DETAIL. NC2504.2 +077700 IF--TEST-18. NC2504.2 +077800 IF IF-D31 IS NOT NEGATIVE PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +077900* NOTE NOT NEGATIVE TEST ON NEGATIVE VALUE. NC2504.2 +078000 GO TO IF--WRITE-18. NC2504.2 +078100 IF--DELETE-18. NC2504.2 +078200 PERFORM DE-LETE. NC2504.2 +078300 IF--WRITE-18. NC2504.2 +078400 MOVE "IF--TEST-18" TO PAR-NAME. NC2504.2 +078500 PERFORM PRINT-DETAIL. NC2504.2 +078600 IF--TEST-19. NC2504.2 +078700 IF IF-D16 NOT NEGATIVE PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +078800* NOTE NOT NEGATIVE TEST ON UNSIGNED FIELD. NC2504.2 +078900 GO TO IF--WRITE-19. NC2504.2 +079000 IF--DELETE-19. NC2504.2 +079100 PERFORM DE-LETE. NC2504.2 +079200 IF--WRITE-19. NC2504.2 +079300 MOVE "IF--TEST-19" TO PAR-NAME. NC2504.2 +079400 PERFORM PRINT-DETAIL. NC2504.2 +079500 IF--INIT-E. NC2504.2 +079600 MOVE " ZERO " TO FEATURE. NC2504.2 +079700 IF--TEST-20. NC2504.2 +079800 IF IF-D1 IS ZERO PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +079900* NOTE ZERO TEST ON ZERO VALUE. NC2504.2 +080000 GO TO IF--WRITE-20. NC2504.2 +080100 IF--DELETE-20. NC2504.2 +080200 PERFORM DE-LETE. NC2504.2 +080300 IF--WRITE-20. NC2504.2 +080400 MOVE "IF--TEST-20" TO PAR-NAME. NC2504.2 +080500 PERFORM PRINT-DETAIL. NC2504.2 +080600 IF--TEST-21. NC2504.2 +080700 IF IF-D10 NOT EQUAL TO ZERO NC2504.2 +080800 PERFORM PASS ELSE NC2504.2 +080900 MOVE IF-D10 TO COMPUTED-A NC2504.2 +081000 MOVE ZERO TO CORRECT-N NC2504.2 +081100 PERFORM FAIL. NC2504.2 +081200* NOTE NOT EQUAL TO ZERO TEST ON NON-ZERO VALUE. NC2504.2 +081300 GO TO IF--WRITE-21. NC2504.2 +081400 IF--DELETE-21. NC2504.2 +081500 PERFORM DE-LETE. NC2504.2 +081600 IF--WRITE-21. NC2504.2 +081700 MOVE "IF--TEST-21" TO PAR-NAME. NC2504.2 +081800 PERFORM PRINT-DETAIL. NC2504.2 +081900 IF--INIT-F. NC2504.2 +082000 MOVE " CONDITION-NAMES " TO FEATURE. NC2504.2 +082100 IF--TEST-22. NC2504.2 +082200 MOVE 1 TO IF-D32. IF A OF IF-D32 PERFORM PASS NC2504.2 +082300 ELSE PERFORM FAIL. NC2504.2 +082400* NOTE TEST OF SIGNED NUMERIC FIELD FOR SINGLE VALUE. NC2504.2 +082500 GO TO IF--WRITE-22. NC2504.2 +082600 IF--DELETE-22. NC2504.2 +082700 PERFORM DE-LETE. NC2504.2 +082800 IF--WRITE-22. NC2504.2 +082900 MOVE "IF--TEST-22" TO PAR-NAME. NC2504.2 +083000 PERFORM PRINT-DETAIL. NC2504.2 +083100 IF--TEST-23. NC2504.2 +083200 MOVE 3 TO IF-D32. IF B OF IF-D32 PERFORM PASS NC2504.2 +083300 ELSE PERFORM FAIL. NC2504.2 +083400* NOTE TEST OF SIGNED NUMERIC FIELD FOR MULTIPLE VALUES. NC2504.2 +083500 GO TO IF--WRITE-23. NC2504.2 +083600 IF--DELETE-23. NC2504.2 +083700 PERFORM DE-LETE. NC2504.2 +083800 IF--WRITE-23. NC2504.2 +083900 MOVE "IF--TEST-23" TO PAR-NAME. NC2504.2 +084000 PERFORM PRINT-DETAIL. NC2504.2 +084100 IF--TEST-24. NC2504.2 +084200 MOVE ZERO TO IF-D32. IF C OF IF-D32 PERFORM PASS NC2504.2 +084300 ELSE PERFORM FAIL. NC2504.2 +084400* NOTE TEST OF SIGNED NUMERIC FIELD FOR FIG-ZERO. NC2504.2 +084500 GO TO IF--WRITE-24. NC2504.2 +084600 IF--DELETE-24. NC2504.2 +084700 PERFORM DE-LETE. NC2504.2 +084800 IF--WRITE-24. NC2504.2 +084900 MOVE "IF--TEST-24" TO PAR-NAME. NC2504.2 +085000 PERFORM PRINT-DETAIL. NC2504.2 +085100 IF--TEST-25. NC2504.2 +085200 MOVE +12.34 TO IF-D32. NC2504.2 +085300 IF D OF IF-D32 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +085400* NOTE SIGNED CONDITION-NAME. NC2504.2 +085500 GO TO IF--WRITE-25. NC2504.2 +085600 IF--DELETE-25. NC2504.2 +085700 PERFORM DE-LETE. NC2504.2 +085800 IF--WRITE-25. NC2504.2 +085900 MOVE "IF--TEST-25" TO PAR-NAME. NC2504.2 +086000 PERFORM PRINT-DETAIL. NC2504.2 +086100 IF--TEST-26. NC2504.2 +086200 MOVE QUOTE TO IF-D33. IF B OF IF-D33 AND NOT B OF IF-D32 NC2504.2 +086300 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +086400* NOTE TEST OF ALPHANUMERIC FIELD FOR FIG-QUOTES. NC2504.2 +086500 GO TO IF--WRITE-26. NC2504.2 +086600 IF--DELETE-26. NC2504.2 +086700 PERFORM DE-LETE. NC2504.2 +086800 IF--WRITE-26. NC2504.2 +086900 MOVE "IF--TEST-26" TO PAR-NAME. NC2504.2 +087000 PERFORM PRINT-DETAIL. NC2504.2 +087100 IF--TEST-27. NC2504.2 +087200 MOVE SPACE TO IF-D33. IF C OF IF-D33 PERFORM PASS NC2504.2 +087300 ELSE PERFORM FAIL. NC2504.2 +087400* NOTE TEST OF ALPHANUMERIC FIELD FOR FIG-SPACES. NC2504.2 +087500 GO TO IF--WRITE-27. NC2504.2 +087600 IF--DELETE-27. NC2504.2 +087700 PERFORM DE-LETE. NC2504.2 +087800 IF--WRITE-27. NC2504.2 +087900 MOVE "IF--TEST-27" TO PAR-NAME. NC2504.2 +088000 PERFORM PRINT-DETAIL. NC2504.2 +088100 IF--TEST-28. NC2504.2 +088200 MOVE "BACB" TO IF-D33. IF D OF IF-D33 PERFORM PASS NC2504.2 +088300 ELSE PERFORM FAIL. NC2504.2 +088400* NOTE TEST OF ALPHANUMERIC FIELD FOR ALL ANY LITERAL. NC2504.2 +088500 GO TO IF--WRITE-28. NC2504.2 +088600 IF--DELETE-28. NC2504.2 +088700 PERFORM DE-LETE. NC2504.2 +088800 IF--WRITE-28. NC2504.2 +088900 MOVE "IF--TEST-28" TO PAR-NAME. NC2504.2 +089000 PERFORM PRINT-DETAIL. NC2504.2 +089100 IF--TEST-29. NC2504.2 +089200 IF NOT B OF IF-D34 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +089300 GO TO IF--WRITE-29. NC2504.2 +089400 IF--DELETE-29. NC2504.2 +089500 PERFORM DE-LETE. NC2504.2 +089600 IF--WRITE-29. NC2504.2 +089700 MOVE "IF--TEST-29" TO PAR-NAME. NC2504.2 +089800 PERFORM PRINT-DETAIL. NC2504.2 +089900 IF--TEST-30. NC2504.2 +090000 MOVE "ABCD" TO IF-D35. NC2504.2 +090100 IF A2 AND B2 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +090200 GO TO IF--WRITE-30. NC2504.2 +090300 IF--DELETE-30. NC2504.2 +090400 PERFORM DE-LETE. NC2504.2 +090500 IF--WRITE-30. NC2504.2 +090600 MOVE "IF--TEST-30" TO PAR-NAME. NC2504.2 +090700 PERFORM PRINT-DETAIL. NC2504.2 +090800 IF--TEST-31. NC2504.2 +090900 MOVE .21 TO IF-D32. NC2504.2 +091000 IF E PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +091100* NOTE TESTS VALUE SERIES. NC2504.2 +091200 GO TO IF--WRITE-31. NC2504.2 +091300 IF--DELETE-31. NC2504.2 +091400 PERFORM DE-LETE. NC2504.2 +091500 IF--WRITE-31. NC2504.2 +091600 MOVE "IF--TEST-31" TO PAR-NAME. NC2504.2 +091700 PERFORM PRINT-DETAIL. NC2504.2 +091800 IF--TEST-32. NC2504.2 +091900 MOVE 1279.99 TO IF-D32. NC2504.2 +092000 IF F PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +092100* NOTE TESTS VALUE RANGE SERIES. NC2504.2 +092200 GO TO IF--WRITE-32. NC2504.2 +092300 IF--DELETE-32. NC2504.2 +092400 PERFORM DE-LETE. NC2504.2 +092500 IF--WRITE-32. NC2504.2 +092600 MOVE "IF--TEST-32" TO PAR-NAME. NC2504.2 +092700 PERFORM PRINT-DETAIL. NC2504.2 +092800 IF--TEST-33. NC2504.2 +092900 MOVE -4321.88 TO IF-D32. NC2504.2 +093000 IF G PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +093100* NOTE TESTS VALUE SERIES RANGE SERIES. NC2504.2 +093200 GO TO IF--WRITE-33. NC2504.2 +093300 IF--DELETE-33. NC2504.2 +093400 PERFORM DE-LETE. NC2504.2 +093500 IF--WRITE-33. NC2504.2 +093600 MOVE "IF--TEST-33" TO PAR-NAME. NC2504.2 +093700 PERFORM PRINT-DETAIL. NC2504.2 +093800 IF--INIT-G. NC2504.2 +093900 PERFORM END-ROUTINE. NC2504.2 +094000 MOVE SPACES TO FEATURE. NC2504.2 +094100 MOVE "THE FOLLOWING TESTS USE ARITHMETIC-EXPRESSIONS" NC2504.2 +094200 TO RE-MARK. NC2504.2 +094300 PERFORM PRINT-DETAIL. NC2504.2 +094400 MOVE "IN RELATION OR SIGN CONDITIONS." NC2504.2 +094500 TO RE-MARK. NC2504.2 +094600 PERFORM PRINT-DETAIL. NC2504.2 +094700 MOVE " EQUAL " TO FEATURE. NC2504.2 +094800 IF--TEST-34. NC2504.2 +094900 IF 1 + (TWO * 3) EQUAL TO (TWO * 3) + 1 NC2504.2 +095000 PERFORM PASS NC2504.2 +095100 ELSE NC2504.2 +095200 PERFORM FAIL. NC2504.2 +095300 GO TO IF--WRITE-34. NC2504.2 +095400 IF--DELETE-34. NC2504.2 +095500 PERFORM DE-LETE. NC2504.2 +095600 IF--WRITE-34. NC2504.2 +095700 MOVE "IF--TEST-34" TO PAR-NAME. NC2504.2 +095800 PERFORM PRINT-DETAIL. NC2504.2 +095900 IF--TEST-35. NC2504.2 +096000 IF 9 + TWO + 2 * 3 EQUAL TO 2 * 3 + TWO + 9 NC2504.2 +096100 PERFORM PASS NC2504.2 +096200 ELSE NC2504.2 +096300 PERFORM FAIL. NC2504.2 +096400 GO TO IF--WRITE-35. NC2504.2 +096500 IF--DELETE-35. NC2504.2 +096600 PERFORM DE-LETE. NC2504.2 +096700 IF--WRITE-35. NC2504.2 +096800 MOVE "IF--TEST-35" TO PAR-NAME. NC2504.2 +096900 PERFORM PRINT-DETAIL. NC2504.2 +097000 IF--TEST-36. NC2504.2 +097100 IF NINE ** 2 EQUAL TO 9 ** 2 NC2504.2 +097200 PERFORM PASS NC2504.2 +097300 ELSE NC2504.2 +097400 PERFORM FAIL. NC2504.2 +097500 GO TO IF--WRITE-36. NC2504.2 +097600 IF--DELETE-36. NC2504.2 +097700 PERFORM DE-LETE. NC2504.2 +097800 IF--WRITE-36. NC2504.2 +097900 MOVE "IF--TEST-36" TO PAR-NAME. NC2504.2 +098000 PERFORM PRINT-DETAIL. NC2504.2 +098100 IF--TEST-37. NC2504.2 +098200 IF 100 + (TWENTY + 3.4) + .05 EQUAL TO NC2504.2 +098300 .05 + (100 + TWENTY) + 3.4 NC2504.2 +098400 PERFORM PASS NC2504.2 +098500 ELSE NC2504.2 +098600 PERFORM FAIL. NC2504.2 +098700 GO TO IF--WRITE-37. NC2504.2 +098800 IF--DELETE-37. NC2504.2 +098900 PERFORM DE-LETE. NC2504.2 +099000 IF--WRITE-37. NC2504.2 +099100 MOVE "IF--TEST-37" TO PAR-NAME. NC2504.2 +099200 PERFORM PRINT-DETAIL. NC2504.2 +099300 IF--INIT-H. NC2504.2 +099400 MOVE " GREATER " TO FEATURE. NC2504.2 +099500 IF--TEST-38. NC2504.2 +099600 IF NINE * 8 IS GREATER THAN 9 * 7 + 8 PERFORM PASS NC2504.2 +099700 ELSE PERFORM FAIL. NC2504.2 +099800 GO TO IF--WRITE-38. NC2504.2 +099900 IF--DELETE-38. NC2504.2 +100000 PERFORM DE-LETE. NC2504.2 +100100 IF--WRITE-38. NC2504.2 +100200 MOVE "IF--TEST-38" TO PAR-NAME. NC2504.2 +100300 PERFORM PRINT-DETAIL. NC2504.2 +100400 IF--TEST-39. NC2504.2 +100500 IF 10 ** 2 + 25 GREATER THAN IF-D14 PERFORM PASS ELSE NC2504.2 +100600 PERFORM FAIL. NC2504.2 +100700 GO TO IF--WRITE-39. NC2504.2 +100800 IF--DELETE-39. NC2504.2 +100900 PERFORM DE-LETE. NC2504.2 +101000 IF--WRITE-39. NC2504.2 +101100 MOVE "IF--TEST-39" TO PAR-NAME. NC2504.2 +101200 PERFORM PRINT-DETAIL. NC2504.2 +101300 IF--TEST-40. NC2504.2 +101400 IF 1000 GREATER THAN TEN ** 3 - 1 PERFORM PASS ELSE PERFORM NC2504.2 +101500 FAIL. NC2504.2 +101600 GO TO IF--WRITE-40. NC2504.2 +101700 IF--DELETE-40. NC2504.2 +101800 PERFORM DE-LETE. NC2504.2 +101900 IF--WRITE-40. NC2504.2 +102000 MOVE "IF--TEST-40" TO PAR-NAME. NC2504.2 +102100 PERFORM PRINT-DETAIL. NC2504.2 +102200 IF--INIT-I. NC2504.2 +102300 MOVE " LESS " TO FEATURE. NC2504.2 +102400 IF--TEST-41. NC2504.2 +102500 IF 1000 LESS THAN 10 ** THREE + 1 PERFORM PASS ELSE NC2504.2 +102600 PERFORM FAIL. NC2504.2 +102700 GO TO IF--WRITE-41. NC2504.2 +102800 IF--DELETE-41. NC2504.2 +102900 PERFORM DE-LETE. NC2504.2 +103000 IF--WRITE-41. NC2504.2 +103100 MOVE "IF--TEST-41" TO PAR-NAME. NC2504.2 +103200 PERFORM PRINT-DETAIL. NC2504.2 +103300 IF--TEST-42. NC2504.2 +103400 IF 10 ** 2 + 20 LESS THAN IF-D14 PERFORM PASS ELSE NC2504.2 +103500 PERFORM FAIL. NC2504.2 +103600 GO TO IF--WRITE-42. NC2504.2 +103700 IF--DELETE-42. NC2504.2 +103800 PERFORM DE-LETE. NC2504.2 +103900 IF--WRITE-42. NC2504.2 +104000 MOVE "IF--TEST-42" TO PAR-NAME. NC2504.2 +104100 PERFORM PRINT-DETAIL. NC2504.2 +104200 IF--TEST-43. NC2504.2 +104300 IF 9 * 8 LESS THAN 9 * 7 + TEN PERFORM PASS ELSE PERFORM NC2504.2 +104400 FAIL. NC2504.2 +104500 GO TO IF--WRITE-43. NC2504.2 +104600 IF--DELETE-43. NC2504.2 +104700 PERFORM DE-LETE. NC2504.2 +104800 IF--WRITE-43. NC2504.2 +104900 MOVE "IF--TEST-43" TO PAR-NAME. NC2504.2 +105000 PERFORM PRINT-DETAIL. NC2504.2 +105100 IF--TEST-44-45. NC2504.2 +105200 MOVE SPACES TO TEST-RESULTS. NC2504.2 +105300 MOVE "NOT USED" TO RE-MARK. NC2504.2 +105400 MOVE "IF--TEST-44" TO PAR-NAME. NC2504.2 +105500 PERFORM PRINT-DETAIL. NC2504.2 +105600 MOVE "NOT USED" TO RE-MARK. NC2504.2 +105700 MOVE "IF--TEST-45" TO PAR-NAME. NC2504.2 +105800 PERFORM PRINT-DETAIL. NC2504.2 +105900 IF--INIT-J. NC2504.2 +106000 MOVE " NOT EQUAL " TO FEATURE. NC2504.2 +106100 PERFORM PRINT-DETAIL. NC2504.2 +106200 IF--TEST-46. NC2504.2 +106300 IF NINE * 9 - 7 * SEVEN NOT EQUAL - (SEVEN * 7) + 9 * NINE NC2504.2 +106400 PERFORM FAIL NC2504.2 +106500 ELSE NC2504.2 +106600 PERFORM PASS. NC2504.2 +106700 NC2504.2 +106800 GO TO IF--WRITE-46. NC2504.2 +106900 IF--DELETE-46. NC2504.2 +107000 PERFORM DE-LETE. NC2504.2 +107100 IF--WRITE-46. NC2504.2 +107200 MOVE "IF--TEST-46" TO PAR-NAME. NC2504.2 +107300 PERFORM PRINT-DETAIL. NC2504.2 +107400 IF--TEST-47. NC2504.2 +107500 IF IF-D14 - IF-D7 NOT EQUAL - IF-D7 + IF-D14 NC2504.2 +107600 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +107700 GO TO IF--WRITE-47. NC2504.2 +107800 IF--DELETE-47. NC2504.2 +107900 PERFORM DE-LETE. NC2504.2 +108000 IF--WRITE-47. NC2504.2 +108100 MOVE "IF--TEST-47" TO PAR-NAME. NC2504.2 +108200 PERFORM PRINT-DETAIL. NC2504.2 +108300 IF--INIT-K. NC2504.2 +108400 MOVE " NOT GREATER " TO FEATURE. NC2504.2 +108500 IF--TEST-48. NC2504.2 +108600 IF NINE * 8 IS NOT GREATER THAN 9 * SEVEN + 8 THEN NC2504.2 +108700 PERFORM FAIL NC2504.2 +108800 ELSE NC2504.2 +108900 PERFORM PASS. NC2504.2 +109000 GO TO IF--WRITE-48. NC2504.2 +109100 IF--DELETE-48. NC2504.2 +109200 PERFORM DE-LETE. NC2504.2 +109300 IF--WRITE-48. NC2504.2 +109400 MOVE "IF--TEST-48" TO PAR-NAME. NC2504.2 +109500 PERFORM PRINT-DETAIL. NC2504.2 +109600 IF--TEST-49. NC2504.2 +109700 IF 10 ** 2 + 25 NOT GREATER THAN IF-D14 PERFORM FAIL ELSE NC2504.2 +109800 PERFORM PASS. NC2504.2 +109900 GO TO IF--WRITE-49. NC2504.2 +110000 IF--DELETE-49. NC2504.2 +110100 PERFORM DE-LETE. NC2504.2 +110200 IF--WRITE-49. NC2504.2 +110300 MOVE "IF--TEST-49" TO PAR-NAME. NC2504.2 +110400 PERFORM PRINT-DETAIL. NC2504.2 +110500 IF--TEST-50. NC2504.2 +110600 IF 1000 NOT GREATER THAN 10 ** THREE - 1 PERFORM FAIL ELSE NC2504.2 +110700 PERFORM PASS. NC2504.2 +110800 GO TO IF--WRITE-50. NC2504.2 +110900 IF--DELETE-50. NC2504.2 +111000 PERFORM DE-LETE. NC2504.2 +111100 IF--WRITE-50. NC2504.2 +111200 MOVE "IF--TEST-50" TO PAR-NAME. NC2504.2 +111300 PERFORM PRINT-DETAIL. NC2504.2 +111400 IF--INIT-L. NC2504.2 +111500 MOVE " NOT LESS " TO FEATURE. NC2504.2 +111600 IF--TEST-51. NC2504.2 +111700 IF 1000 NOT LESS THAN TEN ** 3 + 1 PERFORM FAIL ELSE NC2504.2 +111800 PERFORM PASS. NC2504.2 +111900 GO TO IF--WRITE-51. NC2504.2 +112000 IF--DELETE-51. NC2504.2 +112100 PERFORM DE-LETE. NC2504.2 +112200 IF--WRITE-51. NC2504.2 +112300 MOVE "IF--TEST-51" TO PAR-NAME. NC2504.2 +112400 PERFORM PRINT-DETAIL. NC2504.2 +112500 IF--TEST-52. NC2504.2 +112600 IF 10 ** 2 + 20 NOT LESS THAN IF-D14 PERFORM FAIL ELSE NC2504.2 +112700 PERFORM PASS. NC2504.2 +112800 GO TO IF--WRITE-52. NC2504.2 +112900 IF--DELETE-52. NC2504.2 +113000 PERFORM DE-LETE. NC2504.2 +113100 IF--WRITE-52. NC2504.2 +113200 MOVE "IF--TEST-52" TO PAR-NAME. NC2504.2 +113300 PERFORM PRINT-DETAIL. NC2504.2 +113400 IF--TEST-53. NC2504.2 +113500 IF NINE * 8 NOT LESS THAN 9 * 7 + TEN PERFORM FAIL ELSE NC2504.2 +113600 PERFORM PASS. NC2504.2 +113700 GO TO IF--WRITE-53. NC2504.2 +113800 IF--DELETE-53. NC2504.2 +113900 PERFORM DE-LETE. NC2504.2 +114000 IF--WRITE-53. NC2504.2 +114100 MOVE "IF--TEST-53" TO PAR-NAME. NC2504.2 +114200 PERFORM PRINT-DETAIL. NC2504.2 +114300 IF--INIT-M. NC2504.2 +114400 MOVE " POS, NEG, ZERO " TO FEATURE. NC2504.2 +114500 IF--TEST-54. NC2504.2 +114600 IF 9 ** TWO + (180 - 90) IS NOT POSITIVE PERFORM FAIL ELSE NC2504.2 +114700 PERFORM PASS. NC2504.2 +114800 GO TO IF--WRITE-54. NC2504.2 +114900 IF--DELETE-54. NC2504.2 +115000 PERFORM DE-LETE. NC2504.2 +115100 IF--WRITE-54. NC2504.2 +115200 MOVE "IF--TEST-54" TO PAR-NAME. NC2504.2 +115300 PERFORM PRINT-DETAIL. NC2504.2 +115400 IF--TEST-55. NC2504.2 +115500 IF NINE ** 2 + (90 - 180) IS POSITIVE PERFORM FAIL ELSE NC2504.2 +115600 PERFORM PASS. NC2504.2 +115700 GO TO IF--WRITE-55. NC2504.2 +115800 IF--DELETE-55. NC2504.2 +115900 PERFORM DE-LETE. NC2504.2 +116000 IF--WRITE-55. NC2504.2 +116100 MOVE "IF--TEST-55" TO PAR-NAME. NC2504.2 +116200 PERFORM PRINT-DETAIL. NC2504.2 +116300 IF--TEST-56. NC2504.2 +116400 IF 8 * EIGHT - 8 * 8 NOT ZERO NC2504.2 +116500 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +116600 GO TO IF--WRITE-56. NC2504.2 +116700 IF--DELETE-56. NC2504.2 +116800 PERFORM DE-LETE. NC2504.2 +116900 IF--WRITE-56. NC2504.2 +117000 MOVE "IF--TEST-56" TO PAR-NAME. NC2504.2 +117100 PERFORM PRINT-DETAIL. NC2504.2 +117200 IF--TEST-57-58. NC2504.2 +117300 MOVE SPACES TO TEST-RESULTS. NC2504.2 +117400 MOVE "NOT USED" TO RE-MARK. NC2504.2 +117500 MOVE "IF--TEST-57" TO PAR-NAME. NC2504.2 +117600 PERFORM PRINT-DETAIL. NC2504.2 +117700 MOVE "NOT USED" TO RE-MARK. NC2504.2 +117800 MOVE "IF--TEST-58" TO PAR-NAME. NC2504.2 +117900 PERFORM PRINT-DETAIL. NC2504.2 +118000 MOVE " POS, NEG, ZERO " TO FEATURE. NC2504.2 +118100 IF--TEST-59. NC2504.2 +118200 IF 10 ** THREE + 99 - (1500 - 400) IS NEGATIVE PERFORM PASS NC2504.2 +118300 ELSE PERFORM FAIL. NC2504.2 +118400 GO TO IF--WRITE-59. NC2504.2 +118500 IF--DELETE-59. NC2504.2 +118600 PERFORM DE-LETE. NC2504.2 +118700 IF--WRITE-59. NC2504.2 +118800 MOVE "IF--TEST-59" TO PAR-NAME. NC2504.2 +118900 PERFORM PRINT-DETAIL. NC2504.2 +119000 IF--TEST-60. NC2504.2 +119100 IF TEN ** 3 + 99 - (1500 - 400) IS NOT POSITIVE PERFORM PASS NC2504.2 +119200 ELSE PERFORM FAIL. NC2504.2 +119300 GO TO IF--WRITE-60. NC2504.2 +119400 IF--DELETE-60. NC2504.2 +119500 PERFORM DE-LETE. NC2504.2 +119600 IF--WRITE-60. NC2504.2 +119700 MOVE "IF--TEST-60" TO PAR-NAME. NC2504.2 +119800 PERFORM PRINT-DETAIL. NC2504.2 +119900 IF--TEST-61. NC2504.2 +120000 IF 8 * EIGHT - 8 * 8 IS ZERO NC2504.2 +120100 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +120200 GO TO IF--WRITE-61. NC2504.2 +120300 IF--DELETE-61. NC2504.2 +120400 PERFORM DE-LETE. NC2504.2 +120500 IF--WRITE-61. NC2504.2 +120600 MOVE "IF--TEST-61" TO PAR-NAME. NC2504.2 +120700 PERFORM PRINT-DETAIL. NC2504.2 +120800 IF--TEST-62. NC2504.2 +120900 MOVE SPACES TO TEST-RESULTS. NC2504.2 +121000 MOVE "NOT USED" TO RE-MARK. NC2504.2 +121100 MOVE "IF--TEST-62" TO PAR-NAME. NC2504.2 +121200 PERFORM PRINT-DETAIL. NC2504.2 +121300 MOVE "POS, NEG, ZERO " TO FEATURE. NC2504.2 +121400 IF--TEST-63. NC2504.2 +121500 IF 10 ** THREE + 99 - (1500 - 400) IS NOT NEGATIVE NC2504.2 +121600 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +121700 GO TO IF--WRITE-63. NC2504.2 +121800 IF--DELETE-63. NC2504.2 +121900 PERFORM DE-LETE. NC2504.2 +122000 IF--WRITE-63. NC2504.2 +122100 MOVE "IF--TEST-63" TO PAR-NAME. NC2504.2 +122200 PERFORM PRINT-DETAIL. NC2504.2 +122300 IF--INIT-N. NC2504.2 +122400 MOVE " SYMBOLS > < = " TO FEATURE. NC2504.2 +122500 IF--TEST-64. NC2504.2 +122600 IF TEN * 10 - 10 * 10 = - TEN * 10 + 10 * 10 NC2504.2 +122700 PERFORM PASS NC2504.2 +122800 ELSE NC2504.2 +122900 PERFORM FAIL. NC2504.2 +123000 GO TO IF--WRITE-64. NC2504.2 +123100 IF--DELETE-64. NC2504.2 +123200 PERFORM DE-LETE. NC2504.2 +123300 IF--WRITE-64. NC2504.2 +123400 MOVE "IF--TEST-64" TO PAR-NAME. NC2504.2 +123500 PERFORM PRINT-DETAIL. NC2504.2 +123600 IF--TEST-65. NC2504.2 +123700 IF NINE * 8 > 9 * 7 + 8 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +123800 GO TO IF--WRITE-65. NC2504.2 +123900 IF--DELETE-65. NC2504.2 +124000 PERFORM DE-LETE. NC2504.2 +124100 IF--WRITE-65. NC2504.2 +124200 MOVE "IF--TEST-65" TO PAR-NAME. NC2504.2 +124300 PERFORM PRINT-DETAIL. NC2504.2 +124400 IF--TEST-66. NC2504.2 +124500 IF 1000 < 10 ** THREE + 1 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +124600 GO TO IF--WRITE-66. NC2504.2 +124700 IF--DELETE-66. NC2504.2 +124800 PERFORM DE-LETE. NC2504.2 +124900 IF--WRITE-66. NC2504.2 +125000 MOVE "IF--TEST-66" TO PAR-NAME. NC2504.2 +125100 PERFORM PRINT-DETAIL. NC2504.2 +125200 IF--TEST-67. NC2504.2 +125300 IF 100 + TWENTY + 3.4 + .05 NOT = 100 + TWENTY + 3.4 + 0.6 NC2504.2 +125400 PERFORM PASS NC2504.2 +125500 ELSE NC2504.2 +125600 PERFORM FAIL. NC2504.2 +125700 GO TO IF--WRITE-67. NC2504.2 +125800 IF--DELETE-67. NC2504.2 +125900 PERFORM DE-LETE. NC2504.2 +126000 IF--WRITE-67. NC2504.2 +126100 MOVE "IF--TEST-67" TO PAR-NAME. NC2504.2 +126200 PERFORM PRINT-DETAIL. NC2504.2 +126300 IF--TEST-68. NC2504.2 +126400 IF NINE * 8 NOT > 9 * 7 + 8 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +126500 GO TO IF--WRITE-68. NC2504.2 +126600 IF--DELETE-68. NC2504.2 +126700 PERFORM DE-LETE. NC2504.2 +126800 IF--WRITE-68. NC2504.2 +126900 MOVE "IF--TEST-68" TO PAR-NAME. NC2504.2 +127000 PERFORM PRINT-DETAIL. NC2504.2 +127100 IF--TEST-69. NC2504.2 +127200 IF 1000 NOT < 10 ** THREE + 1 PERFORM FAIL ELSE PERFORM PASS.NC2504.2 +127300 GO TO IF--WRITE-69. NC2504.2 +127400 IF--DELETE-69. NC2504.2 +127500 PERFORM DE-LETE. NC2504.2 +127600 IF--WRITE-69. NC2504.2 +127700 MOVE "IF--TEST-69" TO PAR-NAME. NC2504.2 +127800 PERFORM PRINT-DETAIL. NC2504.2 +127900 IF--TEST-70. NC2504.2 +128000 MOVE SPACES TO TEST-RESULTS. NC2504.2 +128100 MOVE "NOT USED" TO RE-MARK. NC2504.2 +128200 MOVE "IF--TEST-70" TO PAR-NAME. NC2504.2 +128300 PERFORM PRINT-DETAIL. NC2504.2 +128400 IF--INIT-N1. NC2504.2 +128500 PERFORM END-ROUTINE. NC2504.2 +128600 MOVE SPACES TO FEATURE. NC2504.2 +128700 MOVE "THE FOLLOWING TESTS COMBINATIONS OF" NC2504.2 +128800 TO RE-MARK. NC2504.2 +128900 PERFORM PRINT-DETAIL. NC2504.2 +129000 MOVE "RELATIONAL AND SIZE ERROR CONDITIONS." NC2504.2 +129100 TO RE-MARK. NC2504.2 +129200 PERFORM PRINT-DETAIL. NC2504.2 +129300 IF--TEST-71. NC2504.2 +129400 MOVE "X" TO WRK-XN-00001. NC2504.2 +129500 MOVE ZERO TO WRK-DS-01V00. NC2504.2 +129600 IF WRK-XN-00001 IS EQUAL TO "X" NC2504.2 +129700 MOVE "Z" TO WRK-XN-00001 NC2504.2 +129800 ADD 1 TO WRK-DS-01V00 ON SIZE ERROR NC2504.2 +129900 MOVE "Y" TO WRK-XN-00001 NC2504.2 +130000 ELSE NC2504.2 +130100 ADD 2 TO WRK-DS-01V00 ON SIZE ERROR NC2504.2 +130200 MOVE "W" TO WRK-XN-00001. NC2504.2 +130300 IF WRK-XN-00001 EQUAL TO "Z" AND NC2504.2 +130400 WRK-DS-01V00 EQUAL TO 1 NC2504.2 +130500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +130600* NOTE COMBINATION OF RELATIONAL AND SIZE ERROR CONDITIONS.NC2504.2 +130700 GO TO IF--WRITE-71. NC2504.2 +130800 IF--DELETE-71. NC2504.2 +130900 PERFORM DE-LETE. NC2504.2 +131000 IF--WRITE-71. NC2504.2 +131100 MOVE " INCL SIZE ERROR" TO FEATURE. NC2504.2 +131200 MOVE "IF--TEST-71" TO PAR-NAME. NC2504.2 +131300 PERFORM PRINT-DETAIL. NC2504.2 +131400 IF--INIT-O. NC2504.2 +131500 MOVE " UNEQUAL LENGTHS" TO FEATURE. NC2504.2 +131600 IF--TEST-73. NC2504.2 +131700 MOVE "X" TO WRK-XN-00001. NC2504.2 +131800 MOVE "X " TO WRK-XN-00005. NC2504.2 +131900 IF WRK-XN-00001 IS EQUAL TO WRK-XN-00005 NC2504.2 +132000 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +132100* NOTE EQUAL QUANTITIES IN UNEQUAL LENGTH FIELDS. NC2504.2 +132200 GO TO IF--WRITE-73. NC2504.2 +132300 IF--DELETE-73. NC2504.2 +132400 PERFORM DE-LETE. NC2504.2 +132500 IF--WRITE-73. NC2504.2 +132600 MOVE "IF--TEST-73" TO PAR-NAME. NC2504.2 +132700 PERFORM PRINT-DETAIL. NC2504.2 +132800 IF--TEST-74. NC2504.2 +132900 MOVE "X" TO WRK-XN-00001. NC2504.2 +133000 MOVE "Y " TO WRK-XN-00005. NC2504.2 +133100 IF WRK-XN-00001 IS NOT EQUAL TO WRK-XN-00005 NC2504.2 +133200 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +133300* NOTE UNEQUAL QUANTITIES IN UNEQUAL LENGTH FIELDS. NC2504.2 +133400 GO TO IF--WRITE-74. NC2504.2 +133500 IF--DELETE-74. NC2504.2 +133600 PERFORM DE-LETE. NC2504.2 +133700 IF--WRITE-74. NC2504.2 +133800 MOVE "IF--TEST-74" TO PAR-NAME. NC2504.2 +133900 PERFORM PRINT-DETAIL. NC2504.2 +134000 IF--TEST-75. NC2504.2 +134100 MOVE "X" TO WRK-XN-00001. NC2504.2 +134200 MOVE "X X" TO WRK-XN-00005. NC2504.2 +134300 IF WRK-XN-00001 IS NOT EQUAL TO WRK-XN-00005 NC2504.2 +134400 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +134500* NOTE UNEQUAL QUANTITIES IN UNEQUAL LENGTH FIELDS. NC2504.2 +134600 GO TO IF--WRITE-75. NC2504.2 +134700 IF--DELETE-75. NC2504.2 +134800 PERFORM DE-LETE. NC2504.2 +134900 IF--WRITE-75. NC2504.2 +135000 MOVE "IF--TEST-75" TO PAR-NAME. NC2504.2 +135100 PERFORM PRINT-DETAIL. NC2504.2 +135200 IF--INIT-P. NC2504.2 +135300 MOVE " UNEQUAL LENGTHS" TO FEATURE. NC2504.2 +135400 IF--TEST-77. NC2504.2 +135500 IF IF-D37 NOT EQUAL TO IF-D21 NC2504.2 +135600 PERFORM PASS GO TO IF--WRITE-77. NC2504.2 +135700* NOTE NUMERIC VS GROUP COMPARISON, UNEQUAL LENGTHS. NC2504.2 +135800 GO TO IF--FAIL-77. NC2504.2 +135900 IF--DELETE-77. NC2504.2 +136000 PERFORM DE-LETE. NC2504.2 +136100 GO TO IF--WRITE-11. NC2504.2 +136200 IF--FAIL-77. NC2504.2 +136300 PERFORM FAIL. NC2504.2 +136400 MOVE "IF-D37 SHOULD PAD ON RIGHT" TO RE-MARK. NC2504.2 +136500 IF--WRITE-77. NC2504.2 +136600 MOVE "IF--TEST-77" TO PAR-NAME. NC2504.2 +136700 PERFORM PRINT-DETAIL. NC2504.2 +136800 IF--TEST-78. NC2504.2 +136900 IF IF-D37 EQUAL TO IF-D38 NC2504.2 +137000 PERFORM PASS GO TO IF--WRITE-78. NC2504.2 +137100* NOTE NUMERIC VS ALPHANUMERIC COMPARISON, UNEQUAL LENGTHS.NC2504.2 +137200 GO TO IF--FAIL-78. NC2504.2 +137300 IF--DELETE-78. NC2504.2 +137400 PERFORM DE-LETE. NC2504.2 +137500 GO TO IF--WRITE-78. NC2504.2 +137600 IF--FAIL-78. NC2504.2 +137700 PERFORM FAIL. NC2504.2 +137800 MOVE "IF-D37 SHOULD PAD ON RIGHT" TO RE-MARK. NC2504.2 +137900 IF--WRITE-78. NC2504.2 +138000 MOVE "IF--TEST-78" TO PAR-NAME. NC2504.2 +138100 PERFORM PRINT-DETAIL. NC2504.2 +138200 IF--TEST-79. NC2504.2 +138300 MOVE ZERO TO IF-D10. NC2504.2 +138400 IF D3 OF IF-D10 EQUAL TO "00000000" NC2504.2 +138500 PERFORM PASS NC2504.2 +138600 GO TO IF-WRITE-79. NC2504.2 +138700 MOVE D3 IN IF-D10 TO COMPUTED-A. NC2504.2 +138800 MOVE "00000000" TO CORRECT-A. NC2504.2 +138900 PERFORM FAIL. NC2504.2 +139000 GO TO IF-WRITE-79. NC2504.2 +139100 IF-DELETE-79. NC2504.2 +139200 PERFORM DE-LETE. NC2504.2 +139300 IF-WRITE-79. NC2504.2 +139400 MOVE "QUALIFIED GROUP " TO FEATURE. NC2504.2 +139500 MOVE "IF--TEST-79 " TO PAR-NAME. NC2504.2 +139600 PERFORM PRINT-DETAIL. NC2504.2 +139700 IF--INIT-80. NC2504.2 +139800 PERFORM END-ROUTINE. NC2504.2 +139900 MOVE SPACES TO FEATURE. NC2504.2 +140000 MOVE "THESE SPECIAL CONDITION- " TO RE-MARK. NC2504.2 +140100 PERFORM PRINT-DETAIL. NC2504.2 +140200 MOVE "NAME TESTS VERIFY THE " TO RE-MARK. NC2504.2 +140300 PERFORM PRINT-DETAIL. NC2504.2 +140400 MOVE "ABILITY OF THE COMPILER TO " TO RE-MARK. NC2504.2 +140500 PERFORM PRINT-DETAIL. NC2504.2 +140600 MOVE "ACCEPT SUBSCRIPTED 88 LEVEL" TO RE-MARK. NC2504.2 +140700 PERFORM PRINT-DETAIL. NC2504.2 +140800* NOTE ******* ****** *********NC2504.2 +140900* ***** A NOTE AS THE FIRST STATEMENT IN THIS ****** NC2504.2 +141000* PARAGRAPH WILL BYPASS ALL THE SPECIAL ***** NC2504.2 +141100* CONDITION-NAME TESTS, BUT A NOTE STATEMENT NC2504.2 +141200* MIGHT NEED TO BE INSERTED IN EACH TEST NC2504.2 +141300* SO THE SYNTAX WOULD BE IGNORED BY THE COMPILER. NC2504.2 +141400 MOVE "OCCURS WITH 88 LEVEL" TO FEATURE. NC2504.2 +141500 MOVE 123 TO TABLE-80. NC2504.2 +141600 GO TO IF--TEST-80. NC2504.2 +141700 IF-DELETE-80. NC2504.2 +141800 PERFORM DE-LETE. NC2504.2 +141900 MOVE "IF--TEST-80" TO PAR-NAME. NC2504.2 +142000 MOVE "TEST-80 THRU 85 DELETED " TO RE-MARK. NC2504.2 +142100 PERFORM PRINT-DETAIL. NC2504.2 +142200 ADD 5 TO DELETE-COUNTER. NC2504.2 +142300 GO TO IF--TEST-86. NC2504.2 +142400 IF--TEST-80. NC2504.2 +142500 IF A80 (2) NC2504.2 +142600 PERFORM PASS ELSE NC2504.2 +142700 PERFORM FAIL. NC2504.2 +142800* NOTE ELMT(2) SHOULD CONTAIN A 2 WHICH IS CONTAINED IN NC2504.2 +142900* THE VALUE OF THE A80 88 LEVEL. NC2504.2 +143000 GO TO IF-WRITE-80. NC2504.2 +143100 IF--DELETE-80. NC2504.2 +143200 PERFORM DE-LETE. NC2504.2 +143300 IF-WRITE-80. NC2504.2 +143400 MOVE "IF--TEST-80" TO PAR-NAME. NC2504.2 +143500 PERFORM PRINT-DETAIL. NC2504.2 +143600 IF--TEST-81. NC2504.2 +143700 IF C80 (1) NC2504.2 +143800 PERFORM FAIL ELSE NC2504.2 +143900 PERFORM PASS. NC2504.2 +144000* NOTE ELMT(1) SHOULD CONTAIN A 1 WHICH IS NOT CONTAINED NC2504.2 +144100* IN THE VALUE OF THE C80 88 LEVEL. NC2504.2 +144200 GO TO IF-WRITE-81. NC2504.2 +144300 IF-DELETE-81. NC2504.2 +144400 PERFORM DE-LETE. NC2504.2 +144500 IF-WRITE-81. NC2504.2 +144600 MOVE "IF--TEST-81" TO PAR-NAME. NC2504.2 +144700 PERFORM PRINT-DETAIL. NC2504.2 +144800 IF--TEST-82. NC2504.2 +144900 IF B80 (3) NC2504.2 +145000 PERFORM FAIL ELSE NC2504.2 +145100 PERFORM PASS. NC2504.2 +145200* NOTE ELMT(3) SHOULD CONTAIN A 3 WHICH IS NOT CONTAINED NC2504.2 +145300* IN THE VALUE OF THE B80 88 LEVEL. NC2504.2 +145400 GO TO IF-WRITE-82. NC2504.2 +145500 IF-DELETE-82. NC2504.2 +145600 PERFORM DE-LETE. NC2504.2 +145700 IF-WRITE-82. NC2504.2 +145800 MOVE "IF--TEST-82" TO PAR-NAME. NC2504.2 +145900 PERFORM PRINT-DETAIL. NC2504.2 +146000 IF--TEST-83. NC2504.2 +146100 IF NOT A80 OF TABLE-80 (3) NC2504.2 +146200 PERFORM FAIL ELSE NC2504.2 +146300 PERFORM PASS. NC2504.2 +146400* NOTE ELMT(3) SHOULD CONTAIN A 3 BUT THE NOT CONDITION NC2504.2 +146500* SHOULD CAUSE THE TEST TO FAIL EVEN THOUGH THE A80 NC2504.2 +146600* VALUE INCLUDES THE VALUE 3. NC2504.2 +146700 GO TO IF-WRITE-83. NC2504.2 +146800 IF-DELETE-83. NC2504.2 +146900 PERFORM DE-LETE. NC2504.2 +147000 IF-WRITE-83. NC2504.2 +147100 MOVE "IF--TEST-83" TO PAR-NAME. NC2504.2 +147200 PERFORM PRINT-DETAIL. NC2504.2 +147300 IF--TEST-84. NC2504.2 +147400 IF NOT B80 (1) NC2504.2 +147500 PERFORM PASS ELSE NC2504.2 +147600 PERFORM FAIL. NC2504.2 +147700* NOTE ELMT(1) CONTAINS A 1 AND THE VALUE OF B80 IS 8 NC2504.2 +147800* SO, SAYING NOT 8 IS TRUE. NC2504.2 +147900 GO TO IF-WRITE-84. NC2504.2 +148000 IF-DELETE-84. NC2504.2 +148100 PERFORM DE-LETE. NC2504.2 +148200 IF-WRITE-84. NC2504.2 +148300 MOVE "IF--TEST-84" TO PAR-NAME. NC2504.2 +148400 PERFORM PRINT-DETAIL. NC2504.2 +148500 IF--TEST-85. NC2504.2 +148600 IF C80 OF TABLE-80 (2) NC2504.2 +148700 PERFORM FAIL ELSE NC2504.2 +148800 PERFORM PASS. NC2504.2 +148900* NOTE ELMT(2) IS 2 AND THE VALUES OF C80 DO NOT CONTAIN A 2. NC2504.2 +149000 GO TO IF-WRITE-85. NC2504.2 +149100 IF-DELETE-85. NC2504.2 +149200 PERFORM DE-LETE. NC2504.2 +149300 IF-WRITE-85. NC2504.2 +149400 MOVE "IF--TEST-85" TO PAR-NAME. NC2504.2 +149500 PERFORM PRINT-DETAIL. NC2504.2 +149600 IF--TEST-86. NC2504.2 +149700 IF A86 NC2504.2 +149800 PERFORM FAIL ELSE NC2504.2 +149900 PERFORM PASS. NC2504.2 +150000* NOTE A86 (ABC ) SHOULD NOT EQUAL TABLE-86 (ABCABC). NC2504.2 +150100 GO TO IF-WRITE-86. NC2504.2 +150200 IF-DELETE-86. NC2504.2 +150300 PERFORM DE-LETE. NC2504.2 +150400 IF-WRITE-86. NC2504.2 +150500 MOVE "IF--TEST-86" TO PAR-NAME. NC2504.2 +150600 PERFORM PRINT-DETAIL. NC2504.2 +150700 IF--TEST-87. NC2504.2 +150800 IF NOT B86 NC2504.2 +150900 PERFORM FAIL ELSE NC2504.2 +151000 PERFORM PASS. NC2504.2 +151100* NOTE B86 (ABCABC) SHOULD EQUAL TABLE-86 (ABCABC) THUS NC2504.2 +151200* FAILING THE TEST. NC2504.2 +151300 GO TO IF-WRITE-87. NC2504.2 +151400 IF-DELETE-87. NC2504.2 +151500 PERFORM DE-LETE. NC2504.2 +151600 IF-WRITE-87. NC2504.2 +151700 MOVE "IF--TEST-87" TO PAR-NAME. NC2504.2 +151800 PERFORM PRINT-DETAIL. NC2504.2 +151900 IF--TEST-88. NC2504.2 +152000 MOVE SPACES TO DATANAME-86. NC2504.2 +152100 IF C86 NC2504.2 +152200 PERFORM PASS ELSE NC2504.2 +152300 PERFORM FAIL. NC2504.2 +152400* NOTE TABLE-86 ( ABC) SHOULD EQUAL C86 ( ABC). NC2504.2 +152500 GO TO IF-WRITE-88. NC2504.2 +152600 IF-DELETE-88. NC2504.2 +152700 PERFORM DE-LETE. NC2504.2 +152800 IF-WRITE-88. NC2504.2 +152900 MOVE "IF--TEST-88" TO PAR-NAME. NC2504.2 +153000 PERFORM PRINT-DETAIL. NC2504.2 +153100 IF--INIT-R. NC2504.2 +153200 MOVE "FIGCON < = > D-NAME" TO FEATURE. NC2504.2 +153300 IF--TEST-89. NC2504.2 +153400 IF ZEROS NOT < LOW-VAL NC2504.2 +153500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +153600 GO TO IF--WRITE-89. NC2504.2 +153700 IF--DELETE-89. NC2504.2 +153800 PERFORM DE-LETE. NC2504.2 +153900 IF--WRITE-89. NC2504.2 +154000 MOVE "IF--TEST-89 " TO PAR-NAME. NC2504.2 +154100 PERFORM PRINT-DETAIL. NC2504.2 +154200 IF--TEST-90. NC2504.2 +154300 IF ZEROS < ONE23 NC2504.2 +154400 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +154500 GO TO IF--WRITE-90. NC2504.2 +154600 IF--DELETE-90. NC2504.2 +154700 PERFORM DE-LETE. NC2504.2 +154800 IF--WRITE-90. NC2504.2 +154900 MOVE "IF--TEST-90 " TO PAR-NAME. NC2504.2 +155000 PERFORM PRINT-DETAIL. NC2504.2 +155100 IF--TEST-91. NC2504.2 +155200 IF ZEROS = ZERO-C NC2504.2 +155300 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +155400 GO TO IF--WRITE-91. NC2504.2 +155500 IF--DELETE-91. NC2504.2 +155600 PERFORM DE-LETE. NC2504.2 +155700 IF--WRITE-91. NC2504.2 +155800 MOVE "IF--TEST-91 " TO PAR-NAME. NC2504.2 +155900 PERFORM PRINT-DETAIL. NC2504.2 +156000 IF--TEST-92. NC2504.2 +156100 IF ZEROS NOT = ZERO-D NC2504.2 +156200 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +156300 GO TO IF--WRITE-92. NC2504.2 +156400 IF--DELETE-92. NC2504.2 +156500 PERFORM DE-LETE. NC2504.2 +156600 IF--WRITE-92. NC2504.2 +156700 MOVE "IF--TEST-92 " TO PAR-NAME. NC2504.2 +156800 PERFORM PRINT-DETAIL. NC2504.2 +156900 IF--TEST-93. NC2504.2 +157000 IF SPACES = SPACE-X NC2504.2 +157100 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +157200 GO TO IF--WRITE-93. NC2504.2 +157300 IF--DELETE-93. NC2504.2 +157400 PERFORM DE-LETE. NC2504.2 +157500 IF--WRITE-93. NC2504.2 +157600 MOVE "IF--TEST-93 " TO PAR-NAME. NC2504.2 +157700 PERFORM PRINT-DETAIL. NC2504.2 +157800 IF--TEST-94. NC2504.2 +157900 IF SPACES NOT = QUOTE-X NC2504.2 +158000 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +158100 GO TO IF--WRITE-94. NC2504.2 +158200 IF--DELETE-94. NC2504.2 +158300 PERFORM DE-LETE. NC2504.2 +158400 IF--WRITE-94. NC2504.2 +158500 MOVE "IF--TEST-94 " TO PAR-NAME. NC2504.2 +158600 PERFORM PRINT-DETAIL. NC2504.2 +158700 IF--TEST-95. NC2504.2 +158800 IF SPACES > ABC OR < ABC NC2504.2 +158900 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +159000 GO TO IF--WRITE-95. NC2504.2 +159100 IF--DELETE-95. NC2504.2 +159200 PERFORM DE-LETE. NC2504.2 +159300 IF--WRITE-95. NC2504.2 +159400 MOVE "IF--TEST-95 " TO PAR-NAME. NC2504.2 +159500 PERFORM PRINT-DETAIL. NC2504.2 +159600 IF--TEST-96. NC2504.2 +159700 IF QUOTES NOT > QUOTE-X NC2504.2 +159800 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +159900 GO TO IF--WRITE-96. NC2504.2 +160000 IF--DELETE-96. NC2504.2 +160100 PERFORM DE-LETE. NC2504.2 +160200 IF--WRITE-96. NC2504.2 +160300 MOVE "IF--TEST-96 " TO PAR-NAME. NC2504.2 +160400 PERFORM PRINT-DETAIL. NC2504.2 +160500 IF--TEST-97. NC2504.2 +160600 IF QUOTES NOT = ZERO-D NC2504.2 +160700 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +160800 GO TO IF--WRITE-97. NC2504.2 +160900 IF--DELETE-97. NC2504.2 +161000 PERFORM DE-LETE. NC2504.2 +161100 IF--WRITE-97. NC2504.2 +161200 MOVE "IF--TEST-97 " TO PAR-NAME. NC2504.2 +161300 PERFORM PRINT-DETAIL. NC2504.2 +161400 IF--TEST-98. NC2504.2 +161500 IF HIGH-VALUES > LOW-VAL NC2504.2 +161600 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +161700 GO TO IF--WRITE-98. NC2504.2 +161800 IF--DELETE-98. NC2504.2 +161900 PERFORM DE-LETE. NC2504.2 +162000 IF--WRITE-98. NC2504.2 +162100 MOVE "IF--TEST-98 " TO PAR-NAME. NC2504.2 +162200 PERFORM PRINT-DETAIL. NC2504.2 +162300 IF--TEST-99. NC2504.2 +162400 IF HIGH-VALUES > ABC NC2504.2 +162500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +162600 GO TO IF--WRITE-99. NC2504.2 +162700 IF--DELETE-99. NC2504.2 +162800 PERFORM DE-LETE. NC2504.2 +162900 IF--WRITE-99. NC2504.2 +163000 MOVE "IF--TEST-99 " TO PAR-NAME. NC2504.2 +163100 PERFORM PRINT-DETAIL. NC2504.2 +163200 IF--TEST-100. NC2504.2 +163300 IF HIGH-VALUES NOT > ONE23 NC2504.2 +163400 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +163500 GO TO IF--WRITE-100. NC2504.2 +163600 IF--DELETE-100. NC2504.2 +163700 PERFORM DE-LETE. NC2504.2 +163800 IF--WRITE-100. NC2504.2 +163900 MOVE "IF--TEST-100" TO PAR-NAME. NC2504.2 +164000 PERFORM PRINT-DETAIL. NC2504.2 +164100 IF--TEST-101. NC2504.2 +164200 IF HIGH-VALUES = ZERO-D NC2504.2 +164300 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +164400 GO TO IF--WRITE-101. NC2504.2 +164500 IF--DELETE-101. NC2504.2 +164600 PERFORM DE-LETE. NC2504.2 +164700 IF--WRITE-101. NC2504.2 +164800 MOVE "IF--TEST-101" TO PAR-NAME. NC2504.2 +164900 PERFORM PRINT-DETAIL. NC2504.2 +165000 IF--TEST-102. NC2504.2 +165100 IF LOW-VALUES = LOW-VAL NC2504.2 +165200 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +165300 GO TO IF--WRITE-102. NC2504.2 +165400 IF--DELETE-102. NC2504.2 +165500 PERFORM DE-LETE. NC2504.2 +165600 IF--WRITE-102. NC2504.2 +165700 MOVE "IF--TEST-102" TO PAR-NAME. NC2504.2 +165800 PERFORM PRINT-DETAIL. NC2504.2 +165900 IF--TEST-103. NC2504.2 +166000 IF LOW-VALUES < ABC NC2504.2 +166100 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +166200 GO TO IF--WRITE-103. NC2504.2 +166300 IF--DELETE-103. NC2504.2 +166400 PERFORM DE-LETE. NC2504.2 +166500 IF--WRITE-103. NC2504.2 +166600 MOVE "IF--TEST-103" TO PAR-NAME. NC2504.2 +166700 PERFORM PRINT-DETAIL. NC2504.2 +166800 IF--TEST-104. NC2504.2 +166900 IF ALL "00" < ONE23 NC2504.2 +167000 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +167100 GO TO IF--WRITE-104. NC2504.2 +167200 IF--DELETE-104. NC2504.2 +167300 PERFORM DE-LETE. NC2504.2 +167400 IF--WRITE-104. NC2504.2 +167500 MOVE "IF--TEST-104" TO PAR-NAME. NC2504.2 +167600 PERFORM PRINT-DETAIL. NC2504.2 +167700 IF--TEST-105. NC2504.2 +167800 IF ALL ZEROES = ZERO-D NC2504.2 +167900 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +168000 GO TO IF--WRITE-105. NC2504.2 +168100 IF--DELETE-105. NC2504.2 +168200 PERFORM DE-LETE. NC2504.2 +168300 IF--WRITE-105. NC2504.2 +168400 MOVE "IF--TEST-105" TO PAR-NAME. NC2504.2 +168500 PERFORM PRINT-DETAIL. NC2504.2 +168600 IF--TEST-106. NC2504.2 +168700 IF ALL "00" NOT > ZERO-D NC2504.2 +168800 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +168900 GO TO IF--WRITE-106. NC2504.2 +169000 IF--DELETE-106. NC2504.2 +169100 PERFORM DE-LETE. NC2504.2 +169200 IF--WRITE-106. NC2504.2 +169300 MOVE "IF--TEST-106" TO PAR-NAME. NC2504.2 +169400 PERFORM PRINT-DETAIL. NC2504.2 +169500 IF--TEST-107. NC2504.2 +169600 IF ALL "A" = SPACE-X NC2504.2 +169700 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +169800 GO TO IF--WRITE-107. NC2504.2 +169900 IF--DELETE-107. NC2504.2 +170000 PERFORM DE-LETE. NC2504.2 +170100 IF--WRITE-107. NC2504.2 +170200 MOVE "IF--TEST-107" TO PAR-NAME. NC2504.2 +170300 PERFORM PRINT-DETAIL. NC2504.2 +170400 IF--TEST-108. NC2504.2 +170500 IF ALL "A" > ABC NC2504.2 +170600 PERFORM FAIL ELSE PERFORM PASS. NC2504.2 +170700 GO TO IF--WRITE-108. NC2504.2 +170800 IF--DELETE-108. NC2504.2 +170900 PERFORM DE-LETE. NC2504.2 +171000 IF--WRITE-108. NC2504.2 +171100 MOVE "IF--TEST-108" TO PAR-NAME. NC2504.2 +171200 PERFORM PRINT-DETAIL. NC2504.2 +171300 IF--TEST-109. NC2504.2 +171400 IF IF-D4 ALPHABETIC NC2504.2 +171500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +171600 GO TO IF--WRITE-109. NC2504.2 +171700 IF--DELETE-109. NC2504.2 +171800 PERFORM DE-LETE. NC2504.2 +171900 IF--WRITE-109. NC2504.2 +172000 MOVE "CLASS --- ALPHABETIC" TO FEATURE. NC2504.2 +172100 MOVE "IF--TEST-109" TO PAR-NAME. NC2504.2 +172200 PERFORM PRINT-DETAIL. NC2504.2 +172300 IF--INIT-S. NC2504.2 +172400 MOVE "SIGN --- ZERO" TO FEATURE. NC2504.2 +172500 IF--TEST-110. NC2504.2 +172600 IF SMALLEST-VALU GREATER THAN SMALL-VALU NC2504.2 +172700 AND IS NOT LESS THAN EVEN-SMALLER OR SMALLER-VALU NC2504.2 +172800 MOVE "CONDITION FALSE" TO CORRECT-A NC2504.2 +172900 MOVE "CONDITION TRUE " TO COMPUTED-A NC2504.2 +173000 PERFORM FAIL NC2504.2 +173100 GO TO IF--WRITE-110. NC2504.2 +173200 PERFORM PASS. NC2504.2 +173300 GO TO IF--WRITE-110. NC2504.2 +173400 IF--DELETE-110. NC2504.2 +173500 PERFORM DE-LETE. NC2504.2 +173600 IF--WRITE-110. NC2504.2 +173700 MOVE "IF--TEST-110" TO PAR-NAME. NC2504.2 +173800 MOVE "ABBREV CONDITIONS" TO FEATURE. NC2504.2 +173900 PERFORM PRINT-DETAIL. NC2504.2 +174000 IF--TEST-111. NC2504.2 +174100 IF SMALLEST-VALU LESS THAN SMALL-VALU AND NC2504.2 +174200 (SMALLEST-VALU GREATER THAN EVEN-SMALLER OR SMALLER-VALU) NC2504.2 +174300 PERFORM PASS GO TO IF--WRITE-111. NC2504.2 +174400 MOVE "CONDITION TRUE" TO CORRECT-A. NC2504.2 +174500 MOVE "CONDITION FALSE" TO COMPUTED-A. NC2504.2 +174600 PERFORM FAIL. NC2504.2 +174700 GO TO IF--WRITE-111. NC2504.2 +174800 IF--DELETE-111. NC2504.2 +174900 PERFORM DE-LETE. NC2504.2 +175000 IF--WRITE-111. NC2504.2 +175100 MOVE "IF--TEST-111" TO PAR-NAME. NC2504.2 +175200 PERFORM PRINT-DETAIL. NC2504.2 +175300 IF--TEST-112. NC2504.2 +175400 IF IF-D40B NC2504.2 +175500 PERFORM PASS ELSE PERFORM FAIL. NC2504.2 +175600 GO TO IF--WRITE-112. NC2504.2 +175700 IF--DELETE-112. NC2504.2 +175800 PERFORM DE-LETE. NC2504.2 +175900 IF--WRITE-112. NC2504.2 +176000 MOVE "CONDITION---NAME" TO FEATURE. NC2504.2 +176100 MOVE "IF--TEST-112" TO PAR-NAME. NC2504.2 +176200 PERFORM PRINT-DETAIL. NC2504.2 +176300 IF--INIT-T. NC2504.2 +176400 MOVE "ABBREV---CONDITION" TO FEATURE. NC2504.2 +176500 IF--TEST-113. NC2504.2 +176600 IF SMALLEST-VALU LESS THAN SMALL-VALU AND (SMALLEST-VALU NOT NC2504.2 +176700 GREATER THAN EVEN-SMALLER OR SMALLER-VALU) NC2504.2 +176800 PERFORM PASS NC2504.2 +176900 GO TO IF--WRITE-113. NC2504.2 +177000 MOVE "CONDITION TRUE" TO CORRECT-A. NC2504.2 +177100 MOVE "CONDITION FALSE" TO COMPUTED-A. NC2504.2 +177200 PERFORM FAIL. NC2504.2 +177300 GO TO IF--WRITE-113. NC2504.2 +177400 IF--DELETE-113. NC2504.2 +177500 PERFORM DE-LETE. NC2504.2 +177600 IF--WRITE-113. NC2504.2 +177700 MOVE "IF--TEST-113" TO PAR-NAME. NC2504.2 +177800 PERFORM PRINT-DETAIL. NC2504.2 +177900 IF--TEST-114. NC2504.2 +178000 IF SMALLEST-VALU LESS THAN SMALL-VALU NC2504.2 +178100 AND NOT EVEN-SMALLER OR SMALLER-VALU NC2504.2 +178200 PERFORM PASS NC2504.2 +178300 GO TO IF--WRITE-114 NC2504.2 +178400 ELSE NC2504.2 +178500 PERFORM FAIL NC2504.2 +178600 MOVE "CONDITION FALSE" TO CORRECT-A NC2504.2 +178700 MOVE "CONDITION TRUE" TO COMPUTED-A NC2504.2 +178800 GO TO IF--WRITE-114. NC2504.2 +178900 IF--DELETE-114. NC2504.2 +179000 PERFORM DE-LETE. NC2504.2 +179100 IF--WRITE-114. NC2504.2 +179200 MOVE "IF--TEST-114" TO PAR-NAME. NC2504.2 +179300 PERFORM PRINT-DETAIL. NC2504.2 +179400 IF--TEST-115. NC2504.2 +179500 IF COMP-SGN1 IS POSITIVE NC2504.2 +179600 PERFORM PASS NC2504.2 +179700 GO TO IF--WRITE-115. NC2504.2 +179800 MOVE "POSITIVE EXPECTED" TO CORRECT-A. NC2504.2 +179900 MOVE COMP-SGN1 TO COMPUTED-14V4. NC2504.2 +180000 PERFORM FAIL. NC2504.2 +180100 GO TO IF--WRITE-115. NC2504.2 +180200 IF--DELETE-115. NC2504.2 +180300 PERFORM DE-LETE. NC2504.2 +180400 IF--WRITE-115. NC2504.2 +180500 MOVE "POS/NEG SIGN TEST" TO FEATURE. NC2504.2 +180600 MOVE "IF--TEST-115" TO PAR-NAME. NC2504.2 +180700 PERFORM PRINT-DETAIL. NC2504.2 +180800 IF--TEST-116. NC2504.2 +180900 IF COMP-SGN2 NOT POSITIVE NC2504.2 +181000 MOVE COMP-SGN2 TO COMPUTED-14V4 NC2504.2 +181100 MOVE "POSITIVE EXPECTED" TO CORRECT-A NC2504.2 +181200 PERFORM FAIL NC2504.2 +181300 GO TO IF--WRITE-116. NC2504.2 +181400 PERFORM PASS. NC2504.2 +181500 GO TO IF--WRITE-116. NC2504.2 +181600 IF--DELETE-116. NC2504.2 +181700 PERFORM DE-LETE. NC2504.2 +181800 IF--WRITE-116. NC2504.2 +181900 MOVE "IF--TEST-116" TO PAR-NAME. NC2504.2 +182000 PERFORM PRINT-DETAIL. NC2504.2 +182100 IF--TEST-117. NC2504.2 +182200 IF COMP-SGN3 NOT NEGATIVE NC2504.2 +182300 MOVE COMP-SGN3 TO COMPUTED-14V4 NC2504.2 +182400 MOVE "NEGATIVE EXPECTED" TO CORRECT-A NC2504.2 +182500 PERFORM FAIL NC2504.2 +182600 GO TO IF--WRITE-117. NC2504.2 +182700 PERFORM PASS. NC2504.2 +182800 GO TO IF--WRITE-117. NC2504.2 +182900 IF--DELETE-117. NC2504.2 +183000 PERFORM DE-LETE. NC2504.2 +183100 IF--WRITE-117. NC2504.2 +183200 MOVE "IF--TEST-117" TO PAR-NAME. NC2504.2 +183300 PERFORM PRINT-DETAIL. NC2504.2 +183400 IF--TEST-118. NC2504.2 +183500 IF COMP-SGN4 NOT POSITIVE NC2504.2 +183600 PERFORM PASS NC2504.2 +183700 GO TO IF--WRITE-118. NC2504.2 +183800 MOVE COMP-SGN4 TO COMPUTED-14V4. NC2504.2 +183900 MOVE "NEGATIVE EXPECTED" TO CORRECT-A. NC2504.2 +184000 PERFORM FAIL. NC2504.2 +184100 GO TO IF--WRITE-118. NC2504.2 +184200 IF--DELETE-118. NC2504.2 +184300 PERFORM DE-LETE. NC2504.2 +184400 IF--WRITE-118. NC2504.2 +184500 MOVE "IF--TEST-118" TO PAR-NAME. NC2504.2 +184600 PERFORM PRINT-DETAIL. NC2504.2 +184700 IF--TEST-119. NC2504.2 +184800 MOVE SPACES TO TEST-RESULTS. NC2504.2 +184900 MOVE "NOT USED" TO RE-MARK. NC2504.2 +185000 MOVE "IF--TEST-119" TO PAR-NAME. NC2504.2 +185100 PERFORM PRINT-DETAIL. NC2504.2 +185200 IF--TEST-120. NC2504.2 +185300 MOVE -10 TO WRK-DS-06V06. NC2504.2 +185400 ADD +10 TO WRK-DS-06V06. NC2504.2 +185500 IF WRK-DS-06V06 NEGATIVE NC2504.2 +185600 PERFORM FAIL-120-121 NC2504.2 +185700 MOVE "NEGATIVE ZERO DETECTED" TO RE-MARK NC2504.2 +185800 GO TO IF--WRITE-120. NC2504.2 +185900 IF WRK-DS-06V06 POSITIVE NC2504.2 +186000 PERFORM FAIL-120-121 NC2504.2 +186100 MOVE "POSITIVE ZERO DETECTED" TO RE-MARK NC2504.2 +186200 GO TO IF--WRITE-120. NC2504.2 +186300 IF WRK-DS-06V06 ZERO NC2504.2 +186400 PERFORM PASS GO TO IF--WRITE-120. NC2504.2 +186500 PERFORM FAIL-120-121. NC2504.2 +186600 MOVE "NEITHER POS, NEG, NOR ZERO" TO RE-MARK. NC2504.2 +186700 GO TO IF--WRITE-120. NC2504.2 +186800 IF--DELETE-120. NC2504.2 +186900 PERFORM DE-LETE. NC2504.2 +187000 IF--WRITE-120. NC2504.2 +187100 MOVE "SIGN TEST ON ZERO" TO FEATURE. NC2504.2 +187200 MOVE "IF--TEST-120" TO PAR-NAME. NC2504.2 +187300 PERFORM PRINT-DETAIL. NC2504.2 +187400 GO TO IF--EXIT-120. NC2504.2 +187500 FAIL-120-121. NC2504.2 +187600 PERFORM FAIL. NC2504.2 +187700 MOVE WRK-DS-06V06 TO COMPUTED-N. NC2504.2 +187800 MOVE ZERO TO CORRECT-N. NC2504.2 +187900 IF--EXIT-120. NC2504.2 +188000 EXIT. NC2504.2 +188100 IF--TEST-121. NC2504.2 +188200 MOVE 10 TO WRK-DS-06V06. NC2504.2 +188300 SUBTRACT 10 FROM WRK-DS-06V06. NC2504.2 +188400 IF WRK-DS-06V06 NEGATIVE NC2504.2 +188500 PERFORM FAIL-120-121 NC2504.2 +188600 MOVE "NEGATIVE ZERO DETECTED" TO RE-MARK NC2504.2 +188700 GO TO IF--WRITE-121. NC2504.2 +188800 IF WRK-DS-06V06 POSITIVE NC2504.2 +188900 PERFORM FAIL-120-121 NC2504.2 +189000 MOVE "POSITIVE ZERO DETECTED" TO RE-MARK NC2504.2 +189100 GO TO IF--WRITE-121. NC2504.2 +189200 NC2504.2 +189300 IF WRK-DS-06V06 ZERO NC2504.2 +189400 PERFORM PASS GO TO IF--WRITE-121. NC2504.2 +189500 PERFORM FAIL-120-121. NC2504.2 +189600 MOVE "NEITHER POS, NEG, NOR ZERO" TO RE-MARK. NC2504.2 +189700 GO TO IF--WRITE-120. NC2504.2 +189800 IF--DELETE-121. NC2504.2 +189900 PERFORM DE-LETE. NC2504.2 +190000 IF--WRITE-121. NC2504.2 +190100 MOVE "IF--TEST-121" TO PAR-NAME. NC2504.2 +190200 PERFORM PRINT-DETAIL. NC2504.2 +190300 IF-INIT-122. NC2504.2 +190400 MOVE "VI-89 6.15" TO ANSI-REFERENCE. NC2504.2 +190500 MOVE 1 TO WRK-DU-1V0-1. NC2504.2 +190600 MOVE 2 TO WRK-DU-1V0-2. NC2504.2 +190700 MOVE 3 TO WRK-DU-1V0-3. NC2504.2 +190800 MOVE 0 TO WRK-DU-1V0-4. NC2504.2 +190900 IF-TEST-122. NC2504.2 +191000 IF NOT (WRK-DU-1V0-1 NOT GREATER WRK-DU-1V0-2 AND NC2504.2 +191100 WRK-DU-1V0-3 AND NOT WRK-DU-1V0-4) GO TO BUMMER-122 NC2504.2 +191200 ELSE NEXT SENTENCE. NC2504.2 +191300 PERFORM PASS. NC2504.2 +191400 GO TO IF-WRITE-122. NC2504.2 +191500 IF-DELETE-122. NC2504.2 +191600 PERFORM DE-LETE. NC2504.2 +191700 GO TO IF-WRITE-122. NC2504.2 +191800 BUMMER-122. NC2504.2 +191900 PERFORM FAIL. NC2504.2 +192000 MOVE "RESULT TRUE" TO COMPUTED-A. NC2504.2 +192100 MOVE "SHOULD BE FALSE" TO CORRECT-A. NC2504.2 +192200 IF-WRITE-122. NC2504.2 +192300 MOVE "IF-TEST-122" TO PAR-NAME. NC2504.2 +192400 MOVE "ABR. COM. REL. CONDT" TO FEATURE. NC2504.2 +192500 PERFORM PRINT-DETAIL. NC2504.2 +192600 IF-INIT-123. NC2504.2 +192700 MOVE "VI-89 6.15" TO ANSI-REFERENCE. NC2504.2 +192800 MOVE 9 TO WRK-DU-1V0-1. NC2504.2 +192900 MOVE 8 TO WRK-DU-1V0-2. NC2504.2 +193000 MOVE 7 TO WRK-DU-1V0-3. NC2504.2 +193100 IF-LOGICAL-CONN-TEST-123. NC2504.2 +193200 IF WRK-DU-1V0-1 > WRK-DU-1V0-2 AND NOT < WRK-DU-2V0-1 OR NC2504.2 +193300 WRK-DU-2V0-2 OR NOT WRK-DU-2V0-3 AND WRK-DU-1V0-3 NC2504.2 +193400 PERFORM PASS NC2504.2 +193500 ELSE NC2504.2 +193600 PERFORM FAIL MOVE "FALSE RESULT FOUND" TO COMPUTED-A NC2504.2 +193700 MOVE "SHOULD BE TRUE" TO CORRECT-A. NC2504.2 +193800 GO TO IF-WRITE-123. NC2504.2 +193900 IF-DELETE-123. NC2504.2 +194000 PERFORM DE-LETE. NC2504.2 +194100 IF-WRITE-123. NC2504.2 +194200 MOVE "IF-TEST-123" TO PAR-NAME. NC2504.2 +194300 MOVE "LOGICAL CONNECTIVES" TO FEATURE. NC2504.2 +194400 PERFORM PRINT-DETAIL. NC2504.2 +194500 PERFORM END-ROUTINE. NC2504.2 +194600 MOVE " COLLATING-AND-ALPHABET-TEST-9 SYNTAX CHECK IN OBJENC2504.2 +194700- "CT-COMPUTER AND SPECIAL-NAMES" TO TEST-RESULTS. NC2504.2 +194800 PERFORM PRINT-DETAIL. NC2504.2 +194900 MOVE SPACE TO TEST-RESULTS. NC2504.2 +195000 IF-INIT-124. NC2504.2 +195100* ===--> ARITHMETIC EXPRESSION CONTAINING ZERO <--=== NC2504.2 +195200 MOVE "VI-58 6.3.1.5 AND VI-51 6.2" TO ANSI-REFERENCE. NC2504.2 +195300 MOVE 4 TO WRK-DU-1V0-1. NC2504.2 +195400 MOVE "IF-TEST-124" TO PAR-NAME. NC2504.2 +195500 IF-TEST-124. NC2504.2 +195600 IF ZERO - WRK-DU-1V0-1 IS NEGATIVE NC2504.2 +195700 PERFORM PASS NC2504.2 +195800 ELSE NC2504.2 +195900 PERFORM FAIL NC2504.2 +196000 MOVE "POSITIVE RESULT FOUND" TO COMPUTED-A NC2504.2 +196100 MOVE "SHOULD BE NEGATIVE" TO CORRECT-A. NC2504.2 +196200 GO TO IF-WRITE-124. NC2504.2 +196300 IF-DELETE-124. NC2504.2 +196400 PERFORM DE-LETE. NC2504.2 +196500 IF-WRITE-124. NC2504.2 +196600 MOVE "IF-TEST-124" TO PAR-NAME. NC2504.2 +196700 MOVE "LOGICAL CONNECTIVES" TO FEATURE. NC2504.2 +196800 PERFORM PRINT-DETAIL. NC2504.2 +196900 CCVS-EXIT SECTION. NC2504.2 +197000 CCVS-999999. NC2504.2 +197100 GO TO CLOSE-FILES. NC2504.2 diff --git a/tests/cobol85/NC/NC251A.CBL b/tests/cobol85/NC/NC251A.CBL new file mode 100755 index 00000000..91b75cf2 --- /dev/null +++ b/tests/cobol85/NC/NC251A.CBL @@ -0,0 +1,1417 @@ +000100 IDENTIFICATION DIVISION. NC2514.2 +000200 PROGRAM-ID. NC2514.2 +000300 NC251A. NC2514.2 +000400**************************************************************** NC2514.2 +000500* * NC2514.2 +000600* VALIDATION FOR:- * NC2514.2 +000700* * NC2514.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2514.2 +000900* * NC2514.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2514.2 +001100* * NC2514.2 +001200**************************************************************** NC2514.2 +001300* * NC2514.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2514.2 +001500* * NC2514.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2514.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2514.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2514.2 +001900* * NC2514.2 +002000**************************************************************** NC2514.2 +002100* * NC2514.2 +002200* THIS PROGRAM TESTS FORMAT 5 OF THE DIVIDE STATEMENT. * NC2514.2 +002300* * NC2514.2 +002400**************************************************************** NC2514.2 +002500 ENVIRONMENT DIVISION. NC2514.2 +002600 CONFIGURATION SECTION. NC2514.2 +002700 SOURCE-COMPUTER. NC2514.2 +002800 Linux. NC2514.2 +002900 OBJECT-COMPUTER. NC2514.2 +003000 Linux. NC2514.2 +003100 INPUT-OUTPUT SECTION. NC2514.2 +003200 FILE-CONTROL. NC2514.2 +003300 SELECT PRINT-FILE ASSIGN TO NC2514.2 +003400 "report.log". NC2514.2 +003500 DATA DIVISION. NC2514.2 +003600 FILE SECTION. NC2514.2 +003700 FD PRINT-FILE. NC2514.2 +003800 01 PRINT-REC PICTURE X(120). NC2514.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC2514.2 +004000 WORKING-STORAGE SECTION. NC2514.2 +004100 01 WRK-DU-1V17-1 PIC 9V9(17) VALUE 3.14159265358979323. NC2514.2 +004200 01 WRK-DU-1V5-1 PIC 9V9(5). NC2514.2 +004300 01 WRK-NE-1 PIC .9999/99999,99999,99. NC2514.2 +004400 01 WS-REMAINDERS. NC2514.2 +004500 03 WS-REM PIC 99 OCCURS 20. NC2514.2 +004600 01 WRK-XN-00001-1 PIC X. NC2514.2 +004700 01 WRK-XN-00001-2 PIC X. NC2514.2 +004800 01 WS-46. NC2514.2 +004900 03 WS-1-20 PIC X(20). NC2514.2 +005000 03 WS-21-40 PIC X(20). NC2514.2 +005100 03 WS-41-46 PIC X(6). NC2514.2 +005200 77 11A PICTURE 9999 VALUE 9. NC2514.2 +005300 77 11B PICTURE 99; VALUE 8. NC2514.2 +005400 77 1111C PICTURE 99 VALUE 9. NC2514.2 +005500 77 WRK-DS-02V00 PICTURE S99. NC2514.2 +005600 88 TEST-2NUC-COND-99 VALUE 99. NC2514.2 +005700 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2514.2 +005800 77 WRK-DS-18V00 PICTURE S9(18). NC2514.2 +005900 77 WRK-DU-2V1-1 PICTURE S99V9. NC2514.2 +006000 77 A18ONES-DS-18V00 PICTURE S9(18) NC2514.2 +006100 VALUE 111111111111111111. NC2514.2 +006200 77 A18TWOS-DS-18V00 PICTURE S9(18) NC2514.2 +006300 VALUE 222222222222222222. NC2514.2 +006400 77 WRK-DS-05V00 PICTURE S9(5). NC2514.2 +006500 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2514.2 +006600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2514.2 +006700 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2514.2 +006800 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2514.2 +006900 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2514.2 +007000 77 WRK-DS-0201P PICTURE S99P. NC2514.2 +007100 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2514.2 +007200 77 WRK-DS-09V00 PICTURE S9(9). NC2514.2 +007300 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2514.2 +007400 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 NC2514.2 +007500 PICTURE S9(18). NC2514.2 +007600 77 XRAY PICTURE IS X. NC2514.2 +007700 77 W-1 PICTURE IS 9. NC2514.2 +007800 77 W-2 PICTURE IS 99. NC2514.2 +007900 77 W-3 PICTURE IS 999. NC2514.2 +008000 77 W-5 PICTURE 99 VALUE ZERO. NC2514.2 +008100 77 W-9 PICTURE 999. NC2514.2 +008200 77 W-11 PICTURE S99V9. NC2514.2 +008300 77 D-1 PICTURE S9V99 VALUE 1.06. NC2514.2 +008400 77 D-7 PICTURE S99V99 VALUE 1.09. NC2514.2 +008500 77 ONE PICTURE IS 9 VALUE IS 1. NC2514.2 +008600 77 TWO PICTURE IS S9 VALUE IS 2. NC2514.2 +008700 77 THREE PICTURE IS S9 VALUE IS 3. NC2514.2 +008800 77 FOUR PICTURE IS S9 VALUE IS 4. NC2514.2 +008900 77 FIVE PICTURE IS S9 VALUE IS 5. NC2514.2 +009000 77 SIX PICTURE IS S9 VALUE IS 6. NC2514.2 +009100 77 SEVEN PICTURE IS S9 VALUE IS 7. NC2514.2 +009200 77 EIGHT PICTURE IS 9 VALUE IS 8. NC2514.2 +009300 77 NINE PICTURE IS S9 VALUE IS 9. NC2514.2 +009400 77 TEN PICTURE IS S99 VALUE IS 10. NC2514.2 +009500 77 FIFTEEN PICTURE IS S99 VALUE IS 15. NC2514.2 +009600 77 TWENTY PICTURE IS S99 VALUE IS 20. NC2514.2 +009700 77 TWENTY-5 PICTURE IS S99 VALUE IS 25. NC2514.2 +009800 77 25COUNT PICTURE 999 VALUE ZERO. NC2514.2 +009900 77 25ANS PICTURE 99 VALUE ZERO. NC2514.2 +010000 77 25REM PICTURE 99 VALUE ZERO. NC2514.2 +010100 77 DIV-30-Y1 PICTURE 999 USAGE COMP SYNC RIGHT VALUE 31. NC2514.2 +010200 77 DIV-30-Y2 PICTURE 999 USAGE COMP VALUE 54. NC2514.2 +010300 77 DIV-30-Y3 PICTURE 999 VALUE 151. NC2514.2 +010400 77 DIV-30-Y4 PICTURE 9(4) SYNC RIGHT VALUE 1010. NC2514.2 +010500 77 DIV-Z1-30 PICTURE 999 USAGE COMP VALUE ZERO. NC2514.2 +010600 77 DIV-Z2-30 PICTURE 999 SYNC RIGHT VALUE ZERO. NC2514.2 +010700 77 DIV-Z3-30 PICTURE 999 USAGE COMP SYNC RIGHT VALUE ZERO. NC2514.2 +010800 77 DIV-Z4-30 PICTURE 999 VALUE ZERO. NC2514.2 +010900 77 DIV-30-A1 PICTURE 999 SYNC RIGHT VALUE ZERO. NC2514.2 +011000 77 DIV-30-A2 PICTURE 999 VALUE ZERO. NC2514.2 +011100 77 DIV-30-A3 PICTURE 999 USAGE COMP SYNC RIGHT VALUE ZERO. NC2514.2 +011200 77 DIV-30-A4 PICTURE 999 USAGE COMP VALUE ZERO. NC2514.2 +011300 01 DIV-ENTRIES. NC2514.2 +011400 02 DIV11 PICTURE 999 VALUE 105. NC2514.2 +011500 02 DIV12 PICTURE 9999 VALUE 1000. NC2514.2 +011600 02 DIV13 PICTURE 999. NC2514.2 +011700 02 DIV14 PICTURE 99. NC2514.2 +011800 02 DIV15 PICTURE 9V9 VALUE 1.1. NC2514.2 +011900 02 DIV16 PICTURE 99V99 VALUE 89.10. NC2514.2 +012000 02 DIV17 PICTURE 99V99. NC2514.2 +012100 02 DIV18 PICTURE 9999. NC2514.2 +012200 02 DIV19 PICTURE 99 VALUE 14. NC2514.2 +012300 02 DIV20 PICTURE 9999 VALUE 2147. NC2514.2 +012400 02 DIV21 PICTURE 999. NC2514.2 +012500 02 DIV22 PICTURE 99. NC2514.2 +012600 01 WRK-DU-05V00-0001 PIC 9(5). NC2514.2 +012700 01 WRK-DS-05V00-0002 PIC S9(5). NC2514.2 +012800 01 WRK-CS-05V00-0003 PIC S9(5) COMP. NC2514.2 +012900 01 WRK-DU-04V02-0004 PIC 9(4)V9(2). NC2514.2 +013000 01 WRK-DS-04V01-0005 PIC S9(4)V9. NC2514.2 +013100 01 NE-0008 PIC $9(4).99-. NC2514.2 +013200 01 NE-0009 PIC ***99. NC2514.2 +013300 01 NE-04V01-0006 PIC ****.9. NC2514.2 +013400 01 GRP-0010. NC2514.2 +013500 02 WRK-DU-03V00-L-0011 PIC 9(03) SYNC LEFT. NC2514.2 +013600 02 WRK-O005F-0012 OCCURS 5 TIMES. NC2514.2 +013700 03 WRK-O003F-0013 OCCURS 3 TIMES. NC2514.2 +013800 05 WRK-DS-03V04-O003F-0014 PIC S9(3)V9999 NC2514.2 +013900 OCCURS 3 TIMES. NC2514.2 +014000 01 DS-02V00-0001 PIC S99 VALUE 16. NC2514.2 +014100 01 DS-03V00-0002 PIC S999 VALUE 174. NC2514.2 +014200 01 CS-05V00-0003 PIC S9(5) COMP VALUE 10. NC2514.2 +014300 01 TA--X PIC 9(5) COMP VALUE ZERO. NC2514.2 +014400 01 MINUS-NAMES. NC2514.2 +014500 02 WHOLE-FIELD PICTURE S9(18). NC2514.2 +014600 02 PLUS-NAME1 PICTURE S9(18) VALUE +333333333333333333. NC2514.2 +014700 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC2514.2 +014800 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC2514.2 +014900 02 ALPHA-LIT PICTURE X(5) VALUE SPACE. NC2514.2 +015000 02 SNEG-LIT2 PICTURE S9(5) VALUE -70718. NC2514.2 +015100 01 TEST-RESULTS. NC2514.2 +015200 02 FILLER PIC X VALUE SPACE. NC2514.2 +015300 02 FEATURE PIC X(20) VALUE SPACE. NC2514.2 +015400 02 FILLER PIC X VALUE SPACE. NC2514.2 +015500 02 P-OR-F PIC X(5) VALUE SPACE. NC2514.2 +015600 02 FILLER PIC X VALUE SPACE. NC2514.2 +015700 02 PAR-NAME. NC2514.2 +015800 03 FILLER PIC X(19) VALUE SPACE. NC2514.2 +015900 03 PARDOT-X PIC X VALUE SPACE. NC2514.2 +016000 03 DOTVALUE PIC 99 VALUE ZERO. NC2514.2 +016100 02 FILLER PIC X(8) VALUE SPACE. NC2514.2 +016200 02 RE-MARK PIC X(61). NC2514.2 +016300 01 TEST-COMPUTED. NC2514.2 +016400 02 FILLER PIC X(30) VALUE SPACE. NC2514.2 +016500 02 FILLER PIC X(17) VALUE NC2514.2 +016600 " COMPUTED=". NC2514.2 +016700 02 COMPUTED-X. NC2514.2 +016800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2514.2 +016900 03 COMPUTED-N REDEFINES COMPUTED-A NC2514.2 +017000 PIC -9(9).9(9). NC2514.2 +017100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2514.2 +017200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2514.2 +017300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2514.2 +017400 03 CM-18V0 REDEFINES COMPUTED-A. NC2514.2 +017500 04 COMPUTED-18V0 PIC -9(18). NC2514.2 +017600 04 FILLER PIC X. NC2514.2 +017700 03 FILLER PIC X(50) VALUE SPACE. NC2514.2 +017800 01 TEST-CORRECT. NC2514.2 +017900 02 FILLER PIC X(30) VALUE SPACE. NC2514.2 +018000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2514.2 +018100 02 CORRECT-X. NC2514.2 +018200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2514.2 +018300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2514.2 +018400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2514.2 +018500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2514.2 +018600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2514.2 +018700 03 CR-18V0 REDEFINES CORRECT-A. NC2514.2 +018800 04 CORRECT-18V0 PIC -9(18). NC2514.2 +018900 04 FILLER PIC X. NC2514.2 +019000 03 FILLER PIC X(2) VALUE SPACE. NC2514.2 +019100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2514.2 +019200 01 CCVS-C-1. NC2514.2 +019300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2514.2 +019400- "SS PARAGRAPH-NAME NC2514.2 +019500- " REMARKS". NC2514.2 +019600 02 FILLER PIC X(20) VALUE SPACE. NC2514.2 +019700 01 CCVS-C-2. NC2514.2 +019800 02 FILLER PIC X VALUE SPACE. NC2514.2 +019900 02 FILLER PIC X(6) VALUE "TESTED". NC2514.2 +020000 02 FILLER PIC X(15) VALUE SPACE. NC2514.2 +020100 02 FILLER PIC X(4) VALUE "FAIL". NC2514.2 +020200 02 FILLER PIC X(94) VALUE SPACE. NC2514.2 +020300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2514.2 +020400 01 REC-CT PIC 99 VALUE ZERO. NC2514.2 +020500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2514.2 +020600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2514.2 +020700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2514.2 +020800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2514.2 +020900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2514.2 +021000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2514.2 +021100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2514.2 +021200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2514.2 +021300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2514.2 +021400 01 CCVS-H-1. NC2514.2 +021500 02 FILLER PIC X(39) VALUE SPACES. NC2514.2 +021600 02 FILLER PIC X(42) VALUE NC2514.2 +021700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2514.2 +021800 02 FILLER PIC X(39) VALUE SPACES. NC2514.2 +021900 01 CCVS-H-2A. NC2514.2 +022000 02 FILLER PIC X(40) VALUE SPACE. NC2514.2 +022100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2514.2 +022200 02 FILLER PIC XXXX VALUE NC2514.2 +022300 "4.2 ". NC2514.2 +022400 02 FILLER PIC X(28) VALUE NC2514.2 +022500 " COPY - NOT FOR DISTRIBUTION". NC2514.2 +022600 02 FILLER PIC X(41) VALUE SPACE. NC2514.2 +022700 NC2514.2 +022800 01 CCVS-H-2B. NC2514.2 +022900 02 FILLER PIC X(15) VALUE NC2514.2 +023000 "TEST RESULT OF ". NC2514.2 +023100 02 TEST-ID PIC X(9). NC2514.2 +023200 02 FILLER PIC X(4) VALUE NC2514.2 +023300 " IN ". NC2514.2 +023400 02 FILLER PIC X(12) VALUE NC2514.2 +023500 " HIGH ". NC2514.2 +023600 02 FILLER PIC X(22) VALUE NC2514.2 +023700 " LEVEL VALIDATION FOR ". NC2514.2 +023800 02 FILLER PIC X(58) VALUE NC2514.2 +023900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2514.2 +024000 01 CCVS-H-3. NC2514.2 +024100 02 FILLER PIC X(34) VALUE NC2514.2 +024200 " FOR OFFICIAL USE ONLY ". NC2514.2 +024300 02 FILLER PIC X(58) VALUE NC2514.2 +024400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2514.2 +024500 02 FILLER PIC X(28) VALUE NC2514.2 +024600 " COPYRIGHT 1985 ". NC2514.2 +024700 01 CCVS-E-1. NC2514.2 +024800 02 FILLER PIC X(52) VALUE SPACE. NC2514.2 +024900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2514.2 +025000 02 ID-AGAIN PIC X(9). NC2514.2 +025100 02 FILLER PIC X(45) VALUE SPACES. NC2514.2 +025200 01 CCVS-E-2. NC2514.2 +025300 02 FILLER PIC X(31) VALUE SPACE. NC2514.2 +025400 02 FILLER PIC X(21) VALUE SPACE. NC2514.2 +025500 02 CCVS-E-2-2. NC2514.2 +025600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2514.2 +025700 03 FILLER PIC X VALUE SPACE. NC2514.2 +025800 03 ENDER-DESC PIC X(44) VALUE NC2514.2 +025900 "ERRORS ENCOUNTERED". NC2514.2 +026000 01 CCVS-E-3. NC2514.2 +026100 02 FILLER PIC X(22) VALUE NC2514.2 +026200 " FOR OFFICIAL USE ONLY". NC2514.2 +026300 02 FILLER PIC X(12) VALUE SPACE. NC2514.2 +026400 02 FILLER PIC X(58) VALUE NC2514.2 +026500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2514.2 +026600 02 FILLER PIC X(13) VALUE SPACE. NC2514.2 +026700 02 FILLER PIC X(15) VALUE NC2514.2 +026800 " COPYRIGHT 1985". NC2514.2 +026900 01 CCVS-E-4. NC2514.2 +027000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2514.2 +027100 02 FILLER PIC X(4) VALUE " OF ". NC2514.2 +027200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2514.2 +027300 02 FILLER PIC X(40) VALUE NC2514.2 +027400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2514.2 +027500 01 XXINFO. NC2514.2 +027600 02 FILLER PIC X(19) VALUE NC2514.2 +027700 "*** INFORMATION ***". NC2514.2 +027800 02 INFO-TEXT. NC2514.2 +027900 04 FILLER PIC X(8) VALUE SPACE. NC2514.2 +028000 04 XXCOMPUTED PIC X(20). NC2514.2 +028100 04 FILLER PIC X(5) VALUE SPACE. NC2514.2 +028200 04 XXCORRECT PIC X(20). NC2514.2 +028300 02 INF-ANSI-REFERENCE PIC X(48). NC2514.2 +028400 01 HYPHEN-LINE. NC2514.2 +028500 02 FILLER PIC IS X VALUE IS SPACE. NC2514.2 +028600 02 FILLER PIC IS X(65) VALUE IS "************************NC2514.2 +028700- "*****************************************". NC2514.2 +028800 02 FILLER PIC IS X(54) VALUE IS "************************NC2514.2 +028900- "******************************". NC2514.2 +029000 01 CCVS-PGM-ID PIC X(9) VALUE NC2514.2 +029100 "NC251A". NC2514.2 +029200 PROCEDURE DIVISION. NC2514.2 +029300 CCVS1 SECTION. NC2514.2 +029400 OPEN-FILES. NC2514.2 +029500 OPEN OUTPUT PRINT-FILE. NC2514.2 +029600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2514.2 +029700 MOVE SPACE TO TEST-RESULTS. NC2514.2 +029800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2514.2 +029900 GO TO CCVS1-EXIT. NC2514.2 +030000 CLOSE-FILES. NC2514.2 +030100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2514.2 +030200 TERMINATE-CCVS. NC2514.2 +030300*S EXIT PROGRAM. NC2514.2 +030400*SERMINATE-CALL. NC2514.2 +030500 STOP RUN. NC2514.2 +030600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2514.2 +030700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2514.2 +030800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2514.2 +030900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2514.2 +031000 MOVE "****TEST DELETED****" TO RE-MARK. NC2514.2 +031100 PRINT-DETAIL. NC2514.2 +031200 IF REC-CT NOT EQUAL TO ZERO NC2514.2 +031300 MOVE "." TO PARDOT-X NC2514.2 +031400 MOVE REC-CT TO DOTVALUE. NC2514.2 +031500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2514.2 +031600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2514.2 +031700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2514.2 +031800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2514.2 +031900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2514.2 +032000 MOVE SPACE TO CORRECT-X. NC2514.2 +032100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2514.2 +032200 MOVE SPACE TO RE-MARK. NC2514.2 +032300 HEAD-ROUTINE. NC2514.2 +032400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +032500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +032600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2514.2 +032700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2514.2 +032800 COLUMN-NAMES-ROUTINE. NC2514.2 +032900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +033000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +033100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +033200 END-ROUTINE. NC2514.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2514.2 +033400 END-RTN-EXIT. NC2514.2 +033500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +033600 END-ROUTINE-1. NC2514.2 +033700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2514.2 +033800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2514.2 +033900 ADD PASS-COUNTER TO ERROR-HOLD. NC2514.2 +034000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2514.2 +034100 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2514.2 +034200 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2514.2 +034300 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2514.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2514.2 +034500 END-ROUTINE-12. NC2514.2 +034600 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2514.2 +034700 IF ERROR-COUNTER IS EQUAL TO ZERO NC2514.2 +034800 MOVE "NO " TO ERROR-TOTAL NC2514.2 +034900 ELSE NC2514.2 +035000 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2514.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2514.2 +035200 PERFORM WRITE-LINE. NC2514.2 +035300 END-ROUTINE-13. NC2514.2 +035400 IF DELETE-COUNTER IS EQUAL TO ZERO NC2514.2 +035500 MOVE "NO " TO ERROR-TOTAL ELSE NC2514.2 +035600 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2514.2 +035700 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2514.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +035900 IF INSPECT-COUNTER EQUAL TO ZERO NC2514.2 +036000 MOVE "NO " TO ERROR-TOTAL NC2514.2 +036100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2514.2 +036200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2514.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +036400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2514.2 +036500 WRITE-LINE. NC2514.2 +036600 ADD 1 TO RECORD-COUNT. NC2514.2 +036700 IF RECORD-COUNT GREATER 50 NC2514.2 +036800 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2514.2 +036900 MOVE SPACE TO DUMMY-RECORD NC2514.2 +037000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2514.2 +037100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2514.2 +037200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2514.2 +037300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2514.2 +037400 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2514.2 +037500 MOVE ZERO TO RECORD-COUNT. NC2514.2 +037600 PERFORM WRT-LN. NC2514.2 +037700 WRT-LN. NC2514.2 +037800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2514.2 +037900 MOVE SPACE TO DUMMY-RECORD. NC2514.2 +038000 BLANK-LINE-PRINT. NC2514.2 +038100 PERFORM WRT-LN. NC2514.2 +038200 FAIL-ROUTINE. NC2514.2 +038300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2514.2 +038400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2514.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2514.2 +038600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2514.2 +038700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +038800 MOVE SPACES TO INF-ANSI-REFERENCE. NC2514.2 +038900 GO TO FAIL-ROUTINE-EX. NC2514.2 +039000 FAIL-ROUTINE-WRITE. NC2514.2 +039100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2514.2 +039200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2514.2 +039300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2514.2 +039400 MOVE SPACES TO COR-ANSI-REFERENCE. NC2514.2 +039500 FAIL-ROUTINE-EX. EXIT. NC2514.2 +039600 BAIL-OUT. NC2514.2 +039700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2514.2 +039800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2514.2 +039900 BAIL-OUT-WRITE. NC2514.2 +040000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2514.2 +040100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2514.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2514.2 +040300 MOVE SPACES TO INF-ANSI-REFERENCE. NC2514.2 +040400 BAIL-OUT-EX. EXIT. NC2514.2 +040500 CCVS1-EXIT. NC2514.2 +040600 EXIT. NC2514.2 +040700 SECT-NC251A-001 SECTION. NC2514.2 +040800 DIV-TEST-4. NC2514.2 +040900 DIVIDE DIV16 BY DIV15 GIVING DIV17 REMAINDER DIV18. NC2514.2 +041000 IF DIV18 IS EQUAL TO ZERO NC2514.2 +041100 PERFORM PASS NC2514.2 +041200 GO TO DIV-WRITE-4. NC2514.2 +041300 PERFORM FAIL. NC2514.2 +041400 MOVE DIV18 TO COMPUTED-N. NC2514.2 +041500 MOVE "0000" TO CORRECT-A. NC2514.2 +041600 GO TO DIV-WRITE-4. NC2514.2 +041700 DIV-DELETE-4. NC2514.2 +041800 PERFORM DE-LETE. NC2514.2 +041900 DIV-WRITE-4. NC2514.2 +042000 MOVE "DIV-TEST-4" TO PAR-NAME. NC2514.2 +042100 PERFORM PRINT-DETAIL. NC2514.2 +042200 DIV-TEST-5. NC2514.2 +042300 MOVE ZERO TO DIV21. NC2514.2 +042400 MOVE ZERO TO DIV22. NC2514.2 +042500 DIVIDE DIV20 BY DIV19 GIVING DIV21 ROUNDED REMAINDER NC2514.2 +042600 DIV22. NC2514.2 +042700 IF DIV22 IS EQUAL TO 05 NC2514.2 +042800 PERFORM PASS NC2514.2 +042900 GO TO DIV-WRITE-5. NC2514.2 +043000 PERFORM FAIL. NC2514.2 +043100 MOVE DIV22 TO COMPUTED-N. NC2514.2 +043200 MOVE "+05" TO CORRECT-A. NC2514.2 +043300 GO TO DIV-WRITE-5. NC2514.2 +043400 DIV-DELETE-5. NC2514.2 +043500 PERFORM DE-LETE. NC2514.2 +043600 DIV-WRITE-5. NC2514.2 +043700 MOVE "DIV-TEST-5" TO PAR-NAME. NC2514.2 +043800 PERFORM PRINT-DETAIL. NC2514.2 +043900* NC2514.2 +044000 DIV-INIT-F5-3. NC2514.2 +044100 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +044200 MOVE "DIV-TEST-F5-3-0" TO PAR-NAME. NC2514.2 +044300 MOVE 40 TO 25COUNT. NC2514.2 +044400 MOVE ZERO TO 25ANS. NC2514.2 +044500 MOVE ZERO TO 25REM. NC2514.2 +044600 MOVE 1 TO REC-CT. NC2514.2 +044700 DIV-TEST-F5-3-0. NC2514.2 +044800 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +044900 ON SIZE ERROR NC2514.2 +045000 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2514.2 +045100 TO RE-MARK NC2514.2 +045200 PERFORM FAIL NC2514.2 +045300 PERFORM PRINT-DETAIL NC2514.2 +045400 GO TO DIV-TEST-F5-3-1. NC2514.2 +045500 PERFORM PASS. NC2514.2 +045600 PERFORM PRINT-DETAIL. NC2514.2 +045700 GO TO DIV-TEST-F5-3-1. NC2514.2 +045800 DIV-DELETE-F5-3. NC2514.2 +045900 PERFORM DE-LETE. NC2514.2 +046000 PERFORM PRINT-DETAIL. NC2514.2 +046100 GO TO DIV-INIT-F5-4. NC2514.2 +046200 DIV-TEST-F5-3-1. NC2514.2 +046300 MOVE "DIV-TEST-F5-3-1" TO PAR-NAME. NC2514.2 +046400 ADD 1 TO REC-CT. NC2514.2 +046500 IF 25ANS NOT = 2 NC2514.2 +046600 MOVE 2 TO CORRECT-N NC2514.2 +046700 MOVE 25ANS TO COMPUTED-N NC2514.2 +046800 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +046900 PERFORM FAIL NC2514.2 +047000 PERFORM PRINT-DETAIL NC2514.2 +047100 ELSE NC2514.2 +047200 PERFORM PASS NC2514.2 +047300 PERFORM PRINT-DETAIL. NC2514.2 +047400 DIV-TEST-F5-3-2. NC2514.2 +047500 MOVE "DIV-TEST-F5-3-2" TO PAR-NAME. NC2514.2 +047600 ADD 1 TO REC-CT. NC2514.2 +047700 IF 25REM NOT = 20 NC2514.2 +047800 MOVE 25REM TO COMPUTED-N NC2514.2 +047900 MOVE 20 TO CORRECT-N NC2514.2 +048000 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +048100 PERFORM FAIL NC2514.2 +048200 PERFORM PRINT-DETAIL NC2514.2 +048300 ELSE NC2514.2 +048400 PERFORM PASS NC2514.2 +048500 PERFORM PRINT-DETAIL. NC2514.2 +048600* NC2514.2 +048700 DIV-INIT-F5-4. NC2514.2 +048800 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +048900 MOVE "DIV-TEST-F5-4-0" TO PAR-NAME. NC2514.2 +049000 MOVE ZERO TO 25COUNT. NC2514.2 +049100 MOVE ZERO TO 25ANS. NC2514.2 +049200 MOVE ZERO TO 25REM. NC2514.2 +049300 MOVE 1 TO REC-CT. NC2514.2 +049400 DIV-TEST-F5-4-0. NC2514.2 +049500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +049600 ON SIZE ERROR NC2514.2 +049700 PERFORM PASS NC2514.2 +049800 PERFORM PRINT-DETAIL NC2514.2 +049900 GO TO DIV-TEST-F5-4-1. NC2514.2 +050000 MOVE "ON SIZE ERROR SHOULD HAVE OCCURRED" TO RE-MARK. NC2514.2 +050100 PERFORM FAIL. NC2514.2 +050200 PERFORM PRINT-DETAIL. NC2514.2 +050300 GO TO DIV-TEST-F5-4-1. NC2514.2 +050400 DIV-DELETE-F5-4. NC2514.2 +050500 PERFORM DE-LETE. NC2514.2 +050600 PERFORM PRINT-DETAIL. NC2514.2 +050700 GO TO DIV-INIT-F5-5. NC2514.2 +050800 DIV-TEST-F5-4-1. NC2514.2 +050900 MOVE "DIV-TEST-F5-4-1" TO PAR-NAME. NC2514.2 +051000 ADD 1 TO REC-CT. NC2514.2 +051100 IF 25ANS NOT = 0 NC2514.2 +051200 MOVE 0 TO CORRECT-N NC2514.2 +051300 MOVE 25ANS TO COMPUTED-N NC2514.2 +051400 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +051500 PERFORM FAIL NC2514.2 +051600 PERFORM PRINT-DETAIL NC2514.2 +051700 ELSE NC2514.2 +051800 PERFORM PASS NC2514.2 +051900 PERFORM PRINT-DETAIL. NC2514.2 +052000 DIV-TEST-F5-4-2. NC2514.2 +052100 MOVE "DIV-TEST-F5-4-2" TO PAR-NAME. NC2514.2 +052200 ADD 1 TO REC-CT. NC2514.2 +052300 IF 25REM NOT = ZERO NC2514.2 +052400 MOVE 25REM TO COMPUTED-N NC2514.2 +052500 MOVE ZERO TO CORRECT-N NC2514.2 +052600 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +052700 PERFORM FAIL NC2514.2 +052800 PERFORM PRINT-DETAIL NC2514.2 +052900 ELSE NC2514.2 +053000 PERFORM PASS NC2514.2 +053100 PERFORM PRINT-DETAIL. NC2514.2 +053200* NC2514.2 +053300 DIV-INIT-F5-5. NC2514.2 +053400 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +053500 MOVE "DIV-TEST-F5-5-0" TO PAR-NAME. NC2514.2 +053600 MOVE 3 TO 25COUNT. NC2514.2 +053700 MOVE ZERO TO 25ANS. NC2514.2 +053800 MOVE ZERO TO 25REM. NC2514.2 +053900 MOVE 1 TO REC-CT. NC2514.2 +054000 DIV-TEST-F5-5-0. NC2514.2 +054100 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +054200 ON SIZE ERROR NC2514.2 +054300 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2514.2 +054400 TO RE-MARK NC2514.2 +054500 PERFORM FAIL NC2514.2 +054600 PERFORM PRINT-DETAIL NC2514.2 +054700 GO TO DIV-TEST-F5-5-1. NC2514.2 +054800 PERFORM PASS. NC2514.2 +054900 PERFORM PRINT-DETAIL. NC2514.2 +055000 GO TO DIV-TEST-F5-5-1. NC2514.2 +055100 DIV-DELETE-F5-5. NC2514.2 +055200 PERFORM DE-LETE. NC2514.2 +055300 PERFORM PRINT-DETAIL. NC2514.2 +055400 GO TO DIV-TEST-12. NC2514.2 +055500 DIV-TEST-F5-5-1. NC2514.2 +055600 MOVE "DIV-TEST-F5-5-1" TO PAR-NAME. NC2514.2 +055700 ADD 1 TO REC-CT. NC2514.2 +055800 IF 25ANS NOT = 33 NC2514.2 +055900 MOVE 33 TO CORRECT-N NC2514.2 +056000 MOVE 25ANS TO COMPUTED-N NC2514.2 +056100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +056200 PERFORM FAIL NC2514.2 +056300 PERFORM PRINT-DETAIL NC2514.2 +056400 ELSE NC2514.2 +056500 PERFORM PASS NC2514.2 +056600 PERFORM PRINT-DETAIL. NC2514.2 +056700 DIV-TEST-F5-5-2. NC2514.2 +056800 MOVE "DIV-TEST-F5-5-2" TO PAR-NAME. NC2514.2 +056900 ADD 1 TO REC-CT. NC2514.2 +057000 IF 25REM NOT = 1 NC2514.2 +057100 MOVE 25REM TO COMPUTED-N NC2514.2 +057200 MOVE 1 TO CORRECT-N NC2514.2 +057300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +057400 PERFORM FAIL NC2514.2 +057500 PERFORM PRINT-DETAIL NC2514.2 +057600 ELSE NC2514.2 +057700 PERFORM PASS NC2514.2 +057800 PERFORM PRINT-DETAIL. NC2514.2 +057900* NC2514.2 +058000 DIV-TEST-12. NC2514.2 +058100 DIVIDE 230 BY DIV-30-Y2 GIVING DIV-Z2-30 REMAINDER NC2514.2 +058200 DIV-30-A2. NC2514.2 +058300 IF DIV-Z2-30 EQUAL TO 4 AND DIV-30-A2 EQUAL TO 14 NC2514.2 +058400 PERFORM PASS NC2514.2 +058500 GO TO DIV-WRITE-12. NC2514.2 +058600 PERFORM FAIL. NC2514.2 +058700 MOVE 4 TO CORRECT-N. NC2514.2 +058800 MOVE DIV-30-A3 TO COMPUTED-N. NC2514.2 +058900 GO TO DIV-WRITE-12. NC2514.2 +059000 DIV-DELETE-12. NC2514.2 +059100 PERFORM DE-LETE. NC2514.2 +059200 DIV-WRITE-12. NC2514.2 +059300 MOVE "DIV-TEST-12" TO PAR-NAME. NC2514.2 +059400 PERFORM PRINT-DETAIL. NC2514.2 +059500* NC2514.2 +059600 DIV-INIT-F5-7. NC2514.2 +059700 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +059800 MOVE "DIV-TEST-F5-7-0" TO PAR-NAME. NC2514.2 +059900 MOVE 151 TO DIV-30-Y3. NC2514.2 +060000 MOVE ZERO TO DIV-Z3-30. NC2514.2 +060100 MOVE ZERO TO DIV-30-A3. NC2514.2 +060200 MOVE 1 TO REC-CT. NC2514.2 +060300 DIV-TEST-F5-7-0. NC2514.2 +060400 DIVIDE 681 BY DIV-30-Y3 GIVING DIV-Z3-30 REMAINDER NC2514.2 +060500 DIV-30-A3. NC2514.2 +060600 GO TO DIV-TEST-F5-7-1. NC2514.2 +060700 DIV-DELETE-F5-7. NC2514.2 +060800 PERFORM DE-LETE. NC2514.2 +060900 PERFORM PRINT-DETAIL. NC2514.2 +061000 GO TO DIV-INIT-F5-8. NC2514.2 +061100 DIV-TEST-F5-7-1. NC2514.2 +061200 MOVE "DIV-TEST-F5-7-1" TO PAR-NAME. NC2514.2 +061300 ADD 1 TO REC-CT. NC2514.2 +061400 IF DIV-Z3-30 NOT EQUAL TO 4 NC2514.2 +061500 MOVE 4 TO CORRECT-N NC2514.2 +061600 MOVE DIV-Z3-30 TO COMPUTED-N NC2514.2 +061700 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +061800 PERFORM FAIL NC2514.2 +061900 PERFORM PRINT-DETAIL NC2514.2 +062000 ELSE NC2514.2 +062100 PERFORM PASS NC2514.2 +062200 PERFORM PRINT-DETAIL. NC2514.2 +062300 DIV-TEST-F5-7-2. NC2514.2 +062400 MOVE "DIV-TEST-F5-7-2" TO PAR-NAME. NC2514.2 +062500 ADD 1 TO REC-CT. NC2514.2 +062600 IF DIV-30-A3 NOT EQUAL TO 77 NC2514.2 +062700 MOVE DIV-30-A3 TO COMPUTED-N NC2514.2 +062800 MOVE 77 TO CORRECT-N NC2514.2 +062900 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +063000 PERFORM FAIL NC2514.2 +063100 PERFORM PRINT-DETAIL NC2514.2 +063200 ELSE NC2514.2 +063300 PERFORM PASS NC2514.2 +063400 PERFORM PRINT-DETAIL. NC2514.2 +063500* NC2514.2 +063600 DIV-INIT-F5-8. NC2514.2 +063700 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +063800 MOVE "DIV-TEST-F5-8-0" TO PAR-NAME. NC2514.2 +063900 MOVE 1010 TO DIV-30-Y4. NC2514.2 +064000 MOVE ZERO TO DIV-Z4-30. NC2514.2 +064100 MOVE ZERO TO DIV-30-A4. NC2514.2 +064200 MOVE 1 TO REC-CT. NC2514.2 +064300 DIV-TEST-F5-8-0. NC2514.2 +064400 DIVIDE 4150 BY DIV-30-Y4 GIVING DIV-Z4-30 REMAINDER NC2514.2 +064500 DIV-30-A4. NC2514.2 +064600 GO TO DIV-TEST-F5-8-1. NC2514.2 +064700 DIV-DELETE-F5-8. NC2514.2 +064800 PERFORM DE-LETE. NC2514.2 +064900 PERFORM PRINT-DETAIL. NC2514.2 +065000 GO TO DIV-INIT-F5-9. NC2514.2 +065100 DIV-TEST-F5-8-1. NC2514.2 +065200 MOVE "DIV-TEST-F5-8-1" TO PAR-NAME. NC2514.2 +065300 ADD 1 TO REC-CT. NC2514.2 +065400 IF DIV-Z4-30 NOT EQUAL TO 4 NC2514.2 +065500 MOVE 4 TO CORRECT-N NC2514.2 +065600 MOVE DIV-Z4-30 TO COMPUTED-N NC2514.2 +065700 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +065800 PERFORM FAIL NC2514.2 +065900 PERFORM PRINT-DETAIL NC2514.2 +066000 ELSE NC2514.2 +066100 PERFORM PASS NC2514.2 +066200 PERFORM PRINT-DETAIL. NC2514.2 +066300 DIV-TEST-F5-8-2. NC2514.2 +066400 MOVE "DIV-TEST-F5-8-2" TO PAR-NAME. NC2514.2 +066500 ADD 1 TO REC-CT. NC2514.2 +066600 IF DIV-30-A4 NOT EQUAL TO 110 NC2514.2 +066700 MOVE DIV-30-A4 TO COMPUTED-N NC2514.2 +066800 MOVE 110 TO CORRECT-N NC2514.2 +066900 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +067000 PERFORM FAIL NC2514.2 +067100 PERFORM PRINT-DETAIL NC2514.2 +067200 ELSE NC2514.2 +067300 PERFORM PASS NC2514.2 +067400 PERFORM PRINT-DETAIL. NC2514.2 +067500* NC2514.2 +067600* NC2514.2 +067700 DIV-INIT-F5-9. NC2514.2 +067800 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +067900 MOVE "DIV-TEST-F5-9-0" TO PAR-NAME. NC2514.2 +068000 MOVE 31 TO DIV-30-Y1. NC2514.2 +068100 MOVE ZERO TO DIV-Z1-30. NC2514.2 +068200 MOVE ZERO TO DIV-30-A1. NC2514.2 +068300 MOVE 1 TO REC-CT. NC2514.2 +068400 DIV-TEST-F5-9-0. NC2514.2 +068500 DIVIDE 150 BY DIV-30-Y1 GIVING DIV-Z1-30 REMAINDER DIV-30-A1.NC2514.2 +068600 GO TO DIV-TEST-F5-9-1. NC2514.2 +068700 DIV-DELETE-F5-9. NC2514.2 +068800 PERFORM DE-LETE. NC2514.2 +068900 PERFORM PRINT-DETAIL. NC2514.2 +069000 GO TO DIV-INIT-F5-10. NC2514.2 +069100 DIV-TEST-F5-9-1. NC2514.2 +069200 MOVE "DIV-TEST-F5-9-1" TO PAR-NAME. NC2514.2 +069300 ADD 1 TO REC-CT. NC2514.2 +069400 IF DIV-Z1-30 NOT EQUAL TO 4 NC2514.2 +069500 MOVE 4 TO CORRECT-N NC2514.2 +069600 MOVE DIV-Z1-30 TO COMPUTED-N NC2514.2 +069700 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +069800 PERFORM FAIL NC2514.2 +069900 PERFORM PRINT-DETAIL NC2514.2 +070000 ELSE NC2514.2 +070100 PERFORM PASS NC2514.2 +070200 PERFORM PRINT-DETAIL. NC2514.2 +070300 DIV-TEST-F5-9-2. NC2514.2 +070400 MOVE "DIV-TEST-F5-9-2" TO PAR-NAME. NC2514.2 +070500 ADD 1 TO REC-CT. NC2514.2 +070600 IF DIV-30-A1 NOT EQUAL TO 26 NC2514.2 +070700 MOVE DIV-30-A4 TO COMPUTED-N NC2514.2 +070800 MOVE 26 TO CORRECT-N NC2514.2 +070900 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +071000 PERFORM FAIL NC2514.2 +071100 PERFORM PRINT-DETAIL NC2514.2 +071200 ELSE NC2514.2 +071300 PERFORM PASS NC2514.2 +071400 PERFORM PRINT-DETAIL. NC2514.2 +071500* NC2514.2 +071600 DIV-INIT-F5-10. NC2514.2 +071700 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +071800 MOVE "DIV-TEST-F5-10-0" TO PAR-NAME. NC2514.2 +071900 MOVE 40 TO 25COUNT. NC2514.2 +072000 MOVE ZERO TO 25ANS. NC2514.2 +072100 MOVE ZERO TO 25REM. NC2514.2 +072200 MOVE 1 TO REC-CT. NC2514.2 +072300 DIV-TEST-F5-10-0. NC2514.2 +072400 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +072500 NOT ON SIZE ERROR NC2514.2 +072600 PERFORM PASS NC2514.2 +072700 PERFORM PRINT-DETAIL NC2514.2 +072800 GO TO DIV-TEST-F5-10-1. NC2514.2 +072900 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" TO RE-MARK. NC2514.2 +073000 PERFORM FAIL. NC2514.2 +073100 PERFORM PRINT-DETAIL. NC2514.2 +073200 GO TO DIV-TEST-F5-10-1. NC2514.2 +073300 DIV-DELETE-F5-10. NC2514.2 +073400 PERFORM DE-LETE. NC2514.2 +073500 PERFORM PRINT-DETAIL. NC2514.2 +073600 GO TO DIV-INIT-F5-11. NC2514.2 +073700 DIV-TEST-F5-10-1. NC2514.2 +073800 MOVE "DIV-TEST-F5-10-1" TO PAR-NAME. NC2514.2 +073900 ADD 1 TO REC-CT. NC2514.2 +074000 IF 25ANS NOT = 2 NC2514.2 +074100 MOVE 2 TO CORRECT-N NC2514.2 +074200 MOVE 25ANS TO COMPUTED-N NC2514.2 +074300 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +074400 PERFORM FAIL NC2514.2 +074500 PERFORM PRINT-DETAIL NC2514.2 +074600 ELSE NC2514.2 +074700 PERFORM PASS NC2514.2 +074800 PERFORM PRINT-DETAIL. NC2514.2 +074900 DIV-TEST-F5-10-2. NC2514.2 +075000 MOVE "DIV-TEST-F5-10-2" TO PAR-NAME. NC2514.2 +075100 ADD 1 TO REC-CT. NC2514.2 +075200 IF 25REM NOT = 20 NC2514.2 +075300 MOVE 25REM TO COMPUTED-N NC2514.2 +075400 MOVE 20 TO CORRECT-N NC2514.2 +075500 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +075600 PERFORM FAIL NC2514.2 +075700 PERFORM PRINT-DETAIL NC2514.2 +075800 ELSE NC2514.2 +075900 PERFORM PASS NC2514.2 +076000 PERFORM PRINT-DETAIL. NC2514.2 +076100* NC2514.2 +076200 DIV-INIT-F5-11. NC2514.2 +076300 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +076400 MOVE "DIV-TEST-F5-11-0" TO PAR-NAME. NC2514.2 +076500 MOVE ZERO TO 25COUNT. NC2514.2 +076600 MOVE ZERO TO 25ANS. NC2514.2 +076700 MOVE ZERO TO 25REM. NC2514.2 +076800 MOVE 1 TO REC-CT. NC2514.2 +076900 DIV-TEST-F5-11-0. NC2514.2 +077000 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +077100 NOT ON SIZE ERROR NC2514.2 +077200 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +077300 TO RE-MARK NC2514.2 +077400 PERFORM FAIL NC2514.2 +077500 PERFORM PRINT-DETAIL NC2514.2 +077600 GO TO DIV-TEST-F5-11-1. NC2514.2 +077700 PERFORM PASS. NC2514.2 +077800 PERFORM PRINT-DETAIL. NC2514.2 +077900 GO TO DIV-TEST-F5-11-1. NC2514.2 +078000 DIV-DELETE-F5-11. NC2514.2 +078100 PERFORM DE-LETE. NC2514.2 +078200 PERFORM PRINT-DETAIL. NC2514.2 +078300 GO TO DIV-INIT-F5-12. NC2514.2 +078400 DIV-TEST-F5-11-1. NC2514.2 +078500 MOVE "DIV-TEST-F5-11-1" TO PAR-NAME. NC2514.2 +078600 ADD 1 TO REC-CT. NC2514.2 +078700 IF 25ANS NOT = 0 NC2514.2 +078800 MOVE 0 TO CORRECT-N NC2514.2 +078900 MOVE 25ANS TO COMPUTED-N NC2514.2 +079000 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +079100 PERFORM FAIL NC2514.2 +079200 PERFORM PRINT-DETAIL NC2514.2 +079300 ELSE NC2514.2 +079400 PERFORM PASS NC2514.2 +079500 PERFORM PRINT-DETAIL. NC2514.2 +079600 DIV-TEST-F5-11-2. NC2514.2 +079700 MOVE "DIV-TEST-F5-11-2" TO PAR-NAME. NC2514.2 +079800 ADD 1 TO REC-CT. NC2514.2 +079900 IF 25REM NOT = ZERO NC2514.2 +080000 MOVE 25REM TO COMPUTED-N NC2514.2 +080100 MOVE ZERO TO CORRECT-N NC2514.2 +080200 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +080300 PERFORM FAIL NC2514.2 +080400 PERFORM PRINT-DETAIL NC2514.2 +080500 ELSE NC2514.2 +080600 PERFORM PASS NC2514.2 +080700 PERFORM PRINT-DETAIL. NC2514.2 +080800* NC2514.2 +080900 DIV-INIT-F5-12. NC2514.2 +081000 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +081100 MOVE "DIV-TEST-F5-12-0" TO PAR-NAME. NC2514.2 +081200 MOVE 40 TO 25COUNT. NC2514.2 +081300 MOVE ZERO TO 25ANS. NC2514.2 +081400 MOVE ZERO TO 25REM. NC2514.2 +081500 MOVE 1 TO REC-CT. NC2514.2 +081600 DIV-TEST-F5-12-0. NC2514.2 +081700 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +081800 ON SIZE ERROR NC2514.2 +081900 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +082000 TO RE-MARK NC2514.2 +082100 PERFORM FAIL NC2514.2 +082200 PERFORM PRINT-DETAIL NC2514.2 +082300 GO TO DIV-TEST-F5-12-1 NC2514.2 +082400 NOT ON SIZE ERROR NC2514.2 +082500 PERFORM PASS NC2514.2 +082600 PERFORM PRINT-DETAIL NC2514.2 +082700 GO TO DIV-TEST-F5-12-1. NC2514.2 +082800 DIV-DELETE-F5-12. NC2514.2 +082900 PERFORM DE-LETE. NC2514.2 +083000 PERFORM PRINT-DETAIL. NC2514.2 +083100 GO TO DIV-INIT-F5-13. NC2514.2 +083200 DIV-TEST-F5-12-1. NC2514.2 +083300 MOVE "DIV-TEST-F5-12-1" TO PAR-NAME. NC2514.2 +083400 ADD 1 TO REC-CT. NC2514.2 +083500 IF 25ANS NOT = 2 NC2514.2 +083600 MOVE 2 TO CORRECT-N NC2514.2 +083700 MOVE 25ANS TO COMPUTED-N NC2514.2 +083800 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +083900 PERFORM FAIL NC2514.2 +084000 PERFORM PRINT-DETAIL NC2514.2 +084100 ELSE NC2514.2 +084200 PERFORM PASS NC2514.2 +084300 PERFORM PRINT-DETAIL. NC2514.2 +084400 DIV-TEST-F5-12-2. NC2514.2 +084500 MOVE "DIV-TEST-F5-12-2" TO PAR-NAME. NC2514.2 +084600 ADD 1 TO REC-CT. NC2514.2 +084700 IF 25REM NOT = 20 NC2514.2 +084800 MOVE 25REM TO COMPUTED-N NC2514.2 +084900 MOVE 20 TO CORRECT-N NC2514.2 +085000 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +085100 PERFORM FAIL NC2514.2 +085200 PERFORM PRINT-DETAIL NC2514.2 +085300 ELSE NC2514.2 +085400 PERFORM PASS NC2514.2 +085500 PERFORM PRINT-DETAIL. NC2514.2 +085600* NC2514.2 +085700 DIV-INIT-F5-13. NC2514.2 +085800 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +085900 MOVE "DIV-TEST-F5-13-0" TO PAR-NAME. NC2514.2 +086000 MOVE ZERO TO 25COUNT. NC2514.2 +086100 MOVE ZERO TO 25ANS. NC2514.2 +086200 MOVE ZERO TO 25REM. NC2514.2 +086300 MOVE 1 TO REC-CT. NC2514.2 +086400 DIV-TEST-F5-13-0. NC2514.2 +086500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +086600 ON SIZE ERROR NC2514.2 +086700 PERFORM PASS NC2514.2 +086800 PERFORM PRINT-DETAIL NC2514.2 +086900 GO TO DIV-TEST-F5-13-1 NC2514.2 +087000 NOT ON SIZE ERROR NC2514.2 +087100 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +087200 TO RE-MARK NC2514.2 +087300 PERFORM FAIL NC2514.2 +087400 PERFORM PRINT-DETAIL NC2514.2 +087500 GO TO DIV-TEST-F5-13-1. NC2514.2 +087600 DIV-DELETE-F5-13. NC2514.2 +087700 PERFORM DE-LETE. NC2514.2 +087800 PERFORM PRINT-DETAIL. NC2514.2 +087900 GO TO DIV-INIT-F5-14. NC2514.2 +088000 DIV-TEST-F5-13-1. NC2514.2 +088100 MOVE "DIV-TEST-F5-13-1" TO PAR-NAME. NC2514.2 +088200 ADD 1 TO REC-CT. NC2514.2 +088300 IF 25ANS NOT = 0 NC2514.2 +088400 MOVE 0 TO CORRECT-N NC2514.2 +088500 MOVE 25ANS TO COMPUTED-N NC2514.2 +088600 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +088700 PERFORM FAIL NC2514.2 +088800 PERFORM PRINT-DETAIL NC2514.2 +088900 ELSE NC2514.2 +089000 PERFORM PASS NC2514.2 +089100 PERFORM PRINT-DETAIL. NC2514.2 +089200 DIV-TEST-F5-13-2. NC2514.2 +089300 MOVE "DIV-TEST-F5-13-2" TO PAR-NAME. NC2514.2 +089400 ADD 1 TO REC-CT. NC2514.2 +089500 IF 25REM NOT = ZERO NC2514.2 +089600 MOVE 25REM TO COMPUTED-N NC2514.2 +089700 MOVE ZERO TO CORRECT-N NC2514.2 +089800 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +089900 PERFORM FAIL NC2514.2 +090000 PERFORM PRINT-DETAIL NC2514.2 +090100 ELSE NC2514.2 +090200 PERFORM PASS NC2514.2 +090300 PERFORM PRINT-DETAIL. NC2514.2 +090400* NC2514.2 +090500 DIV-INIT-F5-14. NC2514.2 +090600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2514.2 +090700 MOVE "DIV-TEST-F5-14-0" TO PAR-NAME. NC2514.2 +090800 MOVE 40 TO 25COUNT. NC2514.2 +090900 MOVE ZERO TO 25ANS. NC2514.2 +091000 MOVE ZERO TO 25REM. NC2514.2 +091100 MOVE 1 TO REC-CT. NC2514.2 +091200 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +091300 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +091400 DIV-TEST-F5-14-0. NC2514.2 +091500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +091600 ON SIZE ERROR NC2514.2 +091700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +091800 END-DIVIDE NC2514.2 +091900 MOVE "B" TO WRK-XN-00001-2. NC2514.2 +092000 GO TO DIV-TEST-F5-14-1. NC2514.2 +092100 DIV-DELETE-F5-14. NC2514.2 +092200 PERFORM DE-LETE. NC2514.2 +092300 PERFORM PRINT-DETAIL. NC2514.2 +092400 GO TO DIV-INIT-F5-15. NC2514.2 +092500 DIV-TEST-F5-14-1. NC2514.2 +092600 MOVE "DIV-TEST-F5-14-1" TO PAR-NAME. NC2514.2 +092700 ADD 1 TO REC-CT. NC2514.2 +092800 IF 25ANS NOT = 2 NC2514.2 +092900 MOVE 2 TO CORRECT-N NC2514.2 +093000 MOVE 25ANS TO COMPUTED-N NC2514.2 +093100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +093200 PERFORM FAIL NC2514.2 +093300 PERFORM PRINT-DETAIL NC2514.2 +093400 ELSE NC2514.2 +093500 PERFORM PASS NC2514.2 +093600 PERFORM PRINT-DETAIL. NC2514.2 +093700 DIV-TEST-F5-14-2. NC2514.2 +093800 MOVE "DIV-TEST-F5-14-2" TO PAR-NAME. NC2514.2 +093900 ADD 1 TO REC-CT. NC2514.2 +094000 IF 25REM NOT = 20 NC2514.2 +094100 MOVE 25REM TO COMPUTED-N NC2514.2 +094200 MOVE 20 TO CORRECT-N NC2514.2 +094300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +094400 PERFORM FAIL NC2514.2 +094500 PERFORM PRINT-DETAIL NC2514.2 +094600 ELSE NC2514.2 +094700 PERFORM PASS NC2514.2 +094800 PERFORM PRINT-DETAIL. NC2514.2 +094900 DIV-TEST-F5-14-3. NC2514.2 +095000 MOVE "DIV-TEST-F5-14-3" TO PAR-NAME. NC2514.2 +095100 ADD 1 TO REC-CT. NC2514.2 +095200 IF WRK-XN-00001-1 = SPACE NC2514.2 +095300 PERFORM PASS NC2514.2 +095400 PERFORM PRINT-DETAIL NC2514.2 +095500 ELSE NC2514.2 +095600 MOVE "ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +095700 TO RE-MARK NC2514.2 +095800 MOVE SPACE TO CORRECT-A NC2514.2 +095900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +096000 PERFORM FAIL NC2514.2 +096100 PERFORM PRINT-DETAIL. NC2514.2 +096200 DIV-TEST-F5-14-4. NC2514.2 +096300 MOVE "DIV-TEST-F5-14-4" TO PAR-NAME. NC2514.2 +096400 ADD 1 TO REC-CT. NC2514.2 +096500 IF WRK-XN-00001-2 = "B" NC2514.2 +096600 PERFORM PASS NC2514.2 +096700 PERFORM PRINT-DETAIL NC2514.2 +096800 ELSE NC2514.2 +096900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +097000 MOVE "B" TO CORRECT-A NC2514.2 +097100 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +097200 PERFORM FAIL NC2514.2 +097300 PERFORM PRINT-DETAIL. NC2514.2 +097400* NC2514.2 +097500 DIV-INIT-F5-15. NC2514.2 +097600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2514.2 +097700 MOVE "DIV-TEST-F5-15-0" TO PAR-NAME. NC2514.2 +097800 MOVE ZERO TO 25COUNT. NC2514.2 +097900 MOVE ZERO TO 25ANS. NC2514.2 +098000 MOVE ZERO TO 25REM. NC2514.2 +098100 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +098200 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +098300 MOVE 1 TO REC-CT. NC2514.2 +098400 DIV-TEST-F5-15-0. NC2514.2 +098500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +098600 ON SIZE ERROR NC2514.2 +098700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +098800 END-DIVIDE NC2514.2 +098900 MOVE "B" TO WRK-XN-00001-2. NC2514.2 +099000 GO TO DIV-TEST-F5-15-1. NC2514.2 +099100 DIV-DELETE-F5-15. NC2514.2 +099200 PERFORM DE-LETE. NC2514.2 +099300 PERFORM PRINT-DETAIL. NC2514.2 +099400 GO TO DIV-INIT-F5-16. NC2514.2 +099500 DIV-TEST-F5-15-1. NC2514.2 +099600 MOVE "DIV-TEST-F5-15-1" TO PAR-NAME. NC2514.2 +099700 ADD 1 TO REC-CT. NC2514.2 +099800 IF 25ANS NOT = 0 NC2514.2 +099900 MOVE 0 TO CORRECT-N NC2514.2 +100000 MOVE 25ANS TO COMPUTED-N NC2514.2 +100100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +100200 PERFORM FAIL NC2514.2 +100300 PERFORM PRINT-DETAIL NC2514.2 +100400 ELSE NC2514.2 +100500 PERFORM PASS NC2514.2 +100600 PERFORM PRINT-DETAIL. NC2514.2 +100700 DIV-TEST-F5-15-2. NC2514.2 +100800 MOVE "DIV-TEST-F5-15-2" TO PAR-NAME. NC2514.2 +100900 ADD 1 TO REC-CT. NC2514.2 +101000 IF 25REM NOT = ZERO NC2514.2 +101100 MOVE 25REM TO COMPUTED-N NC2514.2 +101200 MOVE ZERO TO CORRECT-N NC2514.2 +101300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +101400 PERFORM FAIL NC2514.2 +101500 PERFORM PRINT-DETAIL NC2514.2 +101600 ELSE NC2514.2 +101700 PERFORM PASS NC2514.2 +101800 PERFORM PRINT-DETAIL. NC2514.2 +101900 DIV-TEST-F5-15-3. NC2514.2 +102000 MOVE "DIV-TEST-F5-15-3" TO PAR-NAME. NC2514.2 +102100 ADD 1 TO REC-CT. NC2514.2 +102200 IF WRK-XN-00001-1 = "A" NC2514.2 +102300 PERFORM PASS NC2514.2 +102400 PERFORM PRINT-DETAIL NC2514.2 +102500 ELSE NC2514.2 +102600 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC2514.2 +102700 TO RE-MARK NC2514.2 +102800 MOVE "A" TO CORRECT-A NC2514.2 +102900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +103000 PERFORM FAIL NC2514.2 +103100 PERFORM PRINT-DETAIL. NC2514.2 +103200 DIV-TEST-F5-15-4. NC2514.2 +103300 MOVE "DIV-TEST-F5-15-4" TO PAR-NAME. NC2514.2 +103400 ADD 1 TO REC-CT. NC2514.2 +103500 IF WRK-XN-00001-2 = "B" NC2514.2 +103600 PERFORM PASS NC2514.2 +103700 PERFORM PRINT-DETAIL NC2514.2 +103800 ELSE NC2514.2 +103900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +104000 MOVE SPACE TO CORRECT-A NC2514.2 +104100 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +104200 PERFORM FAIL NC2514.2 +104300 PERFORM PRINT-DETAIL. NC2514.2 +104400* NC2514.2 +104500 DIV-INIT-F5-16. NC2514.2 +104600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2514.2 +104700 MOVE "DIV-TEST-F5-16-0" TO PAR-NAME. NC2514.2 +104800 MOVE 40 TO 25COUNT. NC2514.2 +104900 MOVE ZERO TO 25ANS. NC2514.2 +105000 MOVE ZERO TO 25REM. NC2514.2 +105100 MOVE 1 TO REC-CT. NC2514.2 +105200 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +105300 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +105400 DIV-TEST-F5-16-0. NC2514.2 +105500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +105600 NOT ON SIZE ERROR NC2514.2 +105700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +105800 END-DIVIDE NC2514.2 +105900 MOVE "B" TO WRK-XN-00001-2. NC2514.2 +106000 GO TO DIV-TEST-F5-16-1. NC2514.2 +106100 DIV-DELETE-F5-16. NC2514.2 +106200 PERFORM DE-LETE. NC2514.2 +106300 PERFORM PRINT-DETAIL. NC2514.2 +106400 GO TO DIV-INIT-F5-17. NC2514.2 +106500 DIV-TEST-F5-16-1. NC2514.2 +106600 MOVE "DIV-TEST-F5-16-1" TO PAR-NAME. NC2514.2 +106700 ADD 1 TO REC-CT. NC2514.2 +106800 IF 25ANS NOT = 2 NC2514.2 +106900 MOVE 2 TO CORRECT-N NC2514.2 +107000 MOVE 25ANS TO COMPUTED-N NC2514.2 +107100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +107200 PERFORM FAIL NC2514.2 +107300 PERFORM PRINT-DETAIL NC2514.2 +107400 ELSE NC2514.2 +107500 PERFORM PASS NC2514.2 +107600 PERFORM PRINT-DETAIL. NC2514.2 +107700 DIV-TEST-F5-16-2. NC2514.2 +107800 MOVE "DIV-TEST-F5-16-2" TO PAR-NAME. NC2514.2 +107900 ADD 1 TO REC-CT. NC2514.2 +108000 IF 25REM NOT = 20 NC2514.2 +108100 MOVE 25REM TO COMPUTED-N NC2514.2 +108200 MOVE 20 TO CORRECT-N NC2514.2 +108300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +108400 PERFORM FAIL NC2514.2 +108500 PERFORM PRINT-DETAIL NC2514.2 +108600 ELSE NC2514.2 +108700 PERFORM PASS NC2514.2 +108800 PERFORM PRINT-DETAIL. NC2514.2 +108900 DIV-TEST-F5-16-3. NC2514.2 +109000 MOVE "DIV-TEST-F5-16-3" TO PAR-NAME. NC2514.2 +109100 ADD 1 TO REC-CT. NC2514.2 +109200 IF WRK-XN-00001-1 = "A" NC2514.2 +109300 PERFORM PASS NC2514.2 +109400 PERFORM PRINT-DETAIL NC2514.2 +109500 ELSE NC2514.2 +109600 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC2514.2 +109700 TO RE-MARK NC2514.2 +109800 MOVE "A" TO CORRECT-A NC2514.2 +109900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +110000 PERFORM FAIL NC2514.2 +110100 PERFORM PRINT-DETAIL. NC2514.2 +110200 DIV-TEST-F5-16-4. NC2514.2 +110300 MOVE "DIV-TEST-F5-16-4" TO PAR-NAME. NC2514.2 +110400 ADD 1 TO REC-CT. NC2514.2 +110500 IF WRK-XN-00001-2 = "B" NC2514.2 +110600 PERFORM PASS NC2514.2 +110700 PERFORM PRINT-DETAIL NC2514.2 +110800 ELSE NC2514.2 +110900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +111000 MOVE "B" TO CORRECT-A NC2514.2 +111100 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +111200 PERFORM FAIL NC2514.2 +111300 PERFORM PRINT-DETAIL. NC2514.2 +111400* NC2514.2 +111500 DIV-INIT-F5-17. NC2514.2 +111600 MOVE "VI-82 6.11.4 GR9" TO ANSI-REFERENCE. NC2514.2 +111700 MOVE "DIV-TEST-F5-17-0" TO PAR-NAME. NC2514.2 +111800 MOVE ZERO TO 25COUNT. NC2514.2 +111900 MOVE ZERO TO 25ANS. NC2514.2 +112000 MOVE ZERO TO 25REM. NC2514.2 +112100 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +112200 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +112300 MOVE 1 TO REC-CT. NC2514.2 +112400 DIV-TEST-F5-17-0. NC2514.2 +112500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +112600 NOT ON SIZE ERROR NC2514.2 +112700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +112800 END-DIVIDE NC2514.2 +112900 MOVE "B" TO WRK-XN-00001-2. NC2514.2 +113000 GO TO DIV-TEST-F5-17-1. NC2514.2 +113100 DIV-DELETE-F5-17. NC2514.2 +113200 PERFORM DE-LETE. NC2514.2 +113300 PERFORM PRINT-DETAIL. NC2514.2 +113400 GO TO DIV-INIT-F5-18. NC2514.2 +113500 DIV-TEST-F5-17-1. NC2514.2 +113600 MOVE "DIV-TEST-F5-17-1" TO PAR-NAME. NC2514.2 +113700 ADD 1 TO REC-CT. NC2514.2 +113800 IF 25ANS NOT = 0 NC2514.2 +113900 MOVE 0 TO CORRECT-N NC2514.2 +114000 MOVE 25ANS TO COMPUTED-N NC2514.2 +114100 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +114200 PERFORM FAIL NC2514.2 +114300 PERFORM PRINT-DETAIL NC2514.2 +114400 ELSE NC2514.2 +114500 PERFORM PASS NC2514.2 +114600 PERFORM PRINT-DETAIL. NC2514.2 +114700 DIV-TEST-F5-17-2. NC2514.2 +114800 MOVE "DIV-TEST-F5-17-2" TO PAR-NAME. NC2514.2 +114900 ADD 1 TO REC-CT. NC2514.2 +115000 IF 25REM NOT = ZERO NC2514.2 +115100 MOVE 25REM TO COMPUTED-N NC2514.2 +115200 MOVE ZERO TO CORRECT-N NC2514.2 +115300 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +115400 PERFORM FAIL NC2514.2 +115500 PERFORM PRINT-DETAIL NC2514.2 +115600 ELSE NC2514.2 +115700 PERFORM PASS NC2514.2 +115800 PERFORM PRINT-DETAIL. NC2514.2 +115900 DIV-TEST-F5-17-3. NC2514.2 +116000 MOVE "DIV-TEST-F5-17-3" TO PAR-NAME. NC2514.2 +116100 ADD 1 TO REC-CT. NC2514.2 +116200 IF WRK-XN-00001-1 = SPACE NC2514.2 +116300 PERFORM PASS NC2514.2 +116400 PERFORM PRINT-DETAIL NC2514.2 +116500 ELSE NC2514.2 +116600 MOVE "NOT ON SIZE ERROR SHOULD NOT HAVE EXECUTED" NC2514.2 +116700 TO RE-MARK NC2514.2 +116800 MOVE SPACE TO CORRECT-A NC2514.2 +116900 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +117000 PERFORM FAIL NC2514.2 +117100 PERFORM PRINT-DETAIL. NC2514.2 +117200 DIV-TEST-F5-17-4. NC2514.2 +117300 MOVE "DIV-TEST-F5-17-4" TO PAR-NAME. NC2514.2 +117400 ADD 1 TO REC-CT. NC2514.2 +117500 IF WRK-XN-00001-2 = "B" NC2514.2 +117600 PERFORM PASS NC2514.2 +117700 PERFORM PRINT-DETAIL NC2514.2 +117800 ELSE NC2514.2 +117900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +118000 MOVE "B" TO CORRECT-A NC2514.2 +118100 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +118200 PERFORM FAIL NC2514.2 +118300 PERFORM PRINT-DETAIL. NC2514.2 +118400* NC2514.2 +118500 DIV-INIT-F5-18. NC2514.2 +118600 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +118700 MOVE "DIV-TEST-F5-18-0" TO PAR-NAME. NC2514.2 +118800 MOVE 40 TO 25COUNT. NC2514.2 +118900 MOVE ZERO TO 25ANS. NC2514.2 +119000 MOVE ZERO TO 25REM. NC2514.2 +119100 MOVE 1 TO REC-CT. NC2514.2 +119200 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +119300 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +119400 DIV-TEST-F5-18-0. NC2514.2 +119500 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +119600 ON SIZE ERROR NC2514.2 +119700 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +119800 NOT ON SIZE ERROR NC2514.2 +119900 MOVE "B" TO WRK-XN-00001-1 NC2514.2 +120000 END-DIVIDE NC2514.2 +120100 MOVE "C" TO WRK-XN-00001-2. NC2514.2 +120200 GO TO DIV-TEST-F5-18-1. NC2514.2 +120300 DIV-DELETE-F5-18. NC2514.2 +120400 PERFORM DE-LETE. NC2514.2 +120500 PERFORM PRINT-DETAIL. NC2514.2 +120600 GO TO DIV-INIT-F5-19. NC2514.2 +120700 DIV-TEST-F5-18-1. NC2514.2 +120800 MOVE "DIV-TEST-F5-18-1" TO PAR-NAME. NC2514.2 +120900 ADD 1 TO REC-CT. NC2514.2 +121000 IF 25ANS NOT = 2 NC2514.2 +121100 MOVE 2 TO CORRECT-N NC2514.2 +121200 MOVE 25ANS TO COMPUTED-N NC2514.2 +121300 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +121400 PERFORM FAIL NC2514.2 +121500 PERFORM PRINT-DETAIL NC2514.2 +121600 ELSE NC2514.2 +121700 PERFORM PASS NC2514.2 +121800 PERFORM PRINT-DETAIL. NC2514.2 +121900 DIV-TEST-F5-18-2. NC2514.2 +122000 MOVE "DIV-TEST-F5-18-2" TO PAR-NAME. NC2514.2 +122100 ADD 1 TO REC-CT. NC2514.2 +122200 IF 25REM NOT = 20 NC2514.2 +122300 MOVE 25REM TO COMPUTED-N NC2514.2 +122400 MOVE 20 TO CORRECT-N NC2514.2 +122500 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +122600 PERFORM FAIL NC2514.2 +122700 PERFORM PRINT-DETAIL NC2514.2 +122800 ELSE NC2514.2 +122900 PERFORM PASS NC2514.2 +123000 PERFORM PRINT-DETAIL. NC2514.2 +123100 DIV-TEST-F5-18-3. NC2514.2 +123200 MOVE "DIV-TEST-F5-18-3" TO PAR-NAME. NC2514.2 +123300 ADD 1 TO REC-CT. NC2514.2 +123400 IF WRK-XN-00001-1 = "B" NC2514.2 +123500 PERFORM PASS NC2514.2 +123600 PERFORM PRINT-DETAIL NC2514.2 +123700 ELSE NC2514.2 +123800 MOVE "NOT ON SIZE ERROR SHOULD HAVE EXECUTED" NC2514.2 +123900 TO RE-MARK NC2514.2 +124000 MOVE "B" TO CORRECT-A NC2514.2 +124100 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +124200 PERFORM FAIL NC2514.2 +124300 PERFORM PRINT-DETAIL. NC2514.2 +124400 DIV-TEST-F5-18-4. NC2514.2 +124500 MOVE "DIV-TEST-F5-18-4" TO PAR-NAME. NC2514.2 +124600 ADD 1 TO REC-CT. NC2514.2 +124700 IF WRK-XN-00001-2 = "C" NC2514.2 +124800 PERFORM PASS NC2514.2 +124900 PERFORM PRINT-DETAIL NC2514.2 +125000 ELSE NC2514.2 +125100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +125200 MOVE "C" TO CORRECT-A NC2514.2 +125300 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +125400 PERFORM FAIL NC2514.2 +125500 PERFORM PRINT-DETAIL. NC2514.2 +125600* NC2514.2 +125700 DIV-INIT-F5-19. NC2514.2 +125800 MOVE "VI-82 6.11.4 GR8" TO ANSI-REFERENCE. NC2514.2 +125900 MOVE "DIV-TEST-F5-19-0" TO PAR-NAME. NC2514.2 +126000 MOVE ZERO TO 25COUNT. NC2514.2 +126100 MOVE ZERO TO 25ANS. NC2514.2 +126200 MOVE ZERO TO 25REM. NC2514.2 +126300 MOVE 1 TO REC-CT. NC2514.2 +126400 MOVE SPACE TO WRK-XN-00001-1. NC2514.2 +126500 MOVE SPACE TO WRK-XN-00001-2. NC2514.2 +126600 DIV-TEST-F5-19-0. NC2514.2 +126700 DIVIDE 100 BY 25COUNT GIVING 25ANS REMAINDER 25REM NC2514.2 +126800 ON SIZE ERROR NC2514.2 +126900 MOVE "A" TO WRK-XN-00001-1 NC2514.2 +127000 NOT ON SIZE ERROR NC2514.2 +127100 MOVE "B" TO WRK-XN-00001-1 NC2514.2 +127200 END-DIVIDE NC2514.2 +127300 MOVE "C" TO WRK-XN-00001-2. NC2514.2 +127400 GO TO DIV-TEST-F5-19-1. NC2514.2 +127500 DIV-DELETE-F5-19. NC2514.2 +127600 PERFORM DE-LETE. NC2514.2 +127700 PERFORM PRINT-DETAIL. NC2514.2 +127800 GO TO DIV-INIT-F5-20. NC2514.2 +127900 DIV-TEST-F5-19-1. NC2514.2 +128000 MOVE "DIV-TEST-F5-19-1" TO PAR-NAME. NC2514.2 +128100 ADD 1 TO REC-CT. NC2514.2 +128200 IF 25ANS NOT = 0 NC2514.2 +128300 MOVE 0 TO CORRECT-N NC2514.2 +128400 MOVE 25ANS TO COMPUTED-N NC2514.2 +128500 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +128600 PERFORM FAIL NC2514.2 +128700 PERFORM PRINT-DETAIL NC2514.2 +128800 ELSE NC2514.2 +128900 PERFORM PASS NC2514.2 +129000 PERFORM PRINT-DETAIL. NC2514.2 +129100 DIV-TEST-F5-19-2. NC2514.2 +129200 MOVE "DIV-TEST-F5-19-2" TO PAR-NAME. NC2514.2 +129300 ADD 1 TO REC-CT. NC2514.2 +129400 IF 25REM NOT = ZERO NC2514.2 +129500 MOVE 25REM TO COMPUTED-N NC2514.2 +129600 MOVE ZERO TO CORRECT-N NC2514.2 +129700 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +129800 PERFORM FAIL NC2514.2 +129900 PERFORM PRINT-DETAIL NC2514.2 +130000 ELSE NC2514.2 +130100 PERFORM PASS NC2514.2 +130200 PERFORM PRINT-DETAIL. NC2514.2 +130300 DIV-TEST-F5-19-3. NC2514.2 +130400 MOVE "DIV-TEST-F5-19-3" TO PAR-NAME. NC2514.2 +130500 ADD 1 TO REC-CT. NC2514.2 +130600 IF WRK-XN-00001-1 = "A" NC2514.2 +130700 PERFORM PASS NC2514.2 +130800 PERFORM PRINT-DETAIL NC2514.2 +130900 ELSE NC2514.2 +131000 MOVE "ON SIZE ERROR SHOULD HAVE EXECUTED" NC2514.2 +131100 TO RE-MARK NC2514.2 +131200 MOVE "A" TO CORRECT-A NC2514.2 +131300 MOVE WRK-XN-00001-1 TO COMPUTED-A NC2514.2 +131400 PERFORM FAIL NC2514.2 +131500 PERFORM PRINT-DETAIL. NC2514.2 +131600 DIV-TEST-F5-19-4. NC2514.2 +131700 MOVE "DIV-TEST-F5-19-4" TO PAR-NAME. NC2514.2 +131800 ADD 1 TO REC-CT. NC2514.2 +131900 IF WRK-XN-00001-2 = "C" NC2514.2 +132000 PERFORM PASS NC2514.2 +132100 PERFORM PRINT-DETAIL NC2514.2 +132200 ELSE NC2514.2 +132300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2514.2 +132400 MOVE "C" TO CORRECT-A NC2514.2 +132500 MOVE WRK-XN-00001-2 TO COMPUTED-A NC2514.2 +132600 PERFORM FAIL NC2514.2 +132700 PERFORM PRINT-DETAIL. NC2514.2 +132800* NC2514.2 +132900 DIV-INIT-F5-20. NC2514.2 +133000 MOVE "VI-82 6.11.4 GR4" TO ANSI-REFERENCE. NC2514.2 +133100 MOVE "DIV-TEST-F5-20-0" TO PAR-NAME. NC2514.2 +133200 MOVE ZERO TO 25ANS. NC2514.2 +133300 MOVE ZERO TO 25REM. NC2514.2 +133400 MOVE ZERO TO WS-REMAINDERS. NC2514.2 +133500 MOVE 6 TO 25COUNT. NC2514.2 +133600 MOVE 1 TO REC-CT. NC2514.2 +133700 DIV-TEST-F5-20-0. NC2514.2 +133800 DIVIDE 100 BY 25COUNT GIVING 25ANS NC2514.2 +133900 REMAINDER WS-REM (25ANS) NC2514.2 +134000 ON SIZE ERROR NC2514.2 +134100 MOVE "SIZE ERROR SHOULD NOT HAVE OCCURED" NC2514.2 +134200 TO RE-MARK NC2514.2 +134300 PERFORM FAIL NC2514.2 +134400 PERFORM PRINT-DETAIL NC2514.2 +134500 GO TO DIV-TEST-F5-20-1. NC2514.2 +134600 PERFORM PASS. NC2514.2 +134700 PERFORM PRINT-DETAIL. NC2514.2 +134800 GO TO DIV-TEST-F5-20-1. NC2514.2 +134900 DIV-DELETE-F5-20. NC2514.2 +135000 PERFORM DE-LETE. NC2514.2 +135100 PERFORM PRINT-DETAIL. NC2514.2 +135200 GO TO CCVS-EXIT. NC2514.2 +135300 DIV-TEST-F5-20-1. NC2514.2 +135400 MOVE "DIV-TEST-F5-20-1" TO PAR-NAME. NC2514.2 +135500 ADD 1 TO REC-CT. NC2514.2 +135600 IF 25ANS NOT = 16 NC2514.2 +135700 MOVE 16 TO CORRECT-N NC2514.2 +135800 MOVE 25ANS TO COMPUTED-N NC2514.2 +135900 MOVE "INVALID QUOTIENT" TO RE-MARK NC2514.2 +136000 PERFORM FAIL NC2514.2 +136100 PERFORM PRINT-DETAIL NC2514.2 +136200 ELSE NC2514.2 +136300 PERFORM PASS NC2514.2 +136400 PERFORM PRINT-DETAIL. NC2514.2 +136500 DIV-TEST-F5-20-2. NC2514.2 +136600 MOVE "DIV-TEST-F5-20-2" TO PAR-NAME. NC2514.2 +136700 ADD 1 TO REC-CT. NC2514.2 +136800 IF WS-REM (25ANS) NOT = 4 NC2514.2 +136900 MOVE WS-REM (25ANS) TO COMPUTED-N NC2514.2 +137000 MOVE 4 TO CORRECT-N NC2514.2 +137100 MOVE "INVALID REMAINDER" TO RE-MARK NC2514.2 +137200 PERFORM FAIL NC2514.2 +137300 PERFORM PRINT-DETAIL NC2514.2 +137400 ADD 1 TO REC-CT NC2514.2 +137500 MOVE 25ANS TO COMPUTED-N NC2514.2 +137600 MOVE 16 TO CORRECT-N NC2514.2 +137700 MOVE "INVALID SUBSCRIPT FOR REMAINDER" TO RE-MARK NC2514.2 +137800 PERFORM FAIL NC2514.2 +137900 PERFORM PRINT-DETAIL NC2514.2 +138000 ELSE NC2514.2 +138100 PERFORM PASS NC2514.2 +138200 PERFORM PRINT-DETAIL. NC2514.2 +138300* NC2514.2 +138400 DIV-INIT-F5-21. NC2514.2 +138500 MOVE "DIV-TEST-F5-21" TO PAR-NAME. NC2514.2 +138600 MOVE 10.0 TO WRK-DU-2V1-1. NC2514.2 +138700 MOVE ZERO TO REC-CT. NC2514.2 +138800 DIVIDE-REMAINDER-TEST-7. NC2514.2 +138900 DIVIDE WRK-DU-1V17-1 BY WRK-DU-2V1-1 GIVING WRK-DU-1V5-1 NC2514.2 +139000 REMAINDER WRK-NE-1 ON SIZE ERROR GO TO DIV-FAIL-F5-21. NC2514.2 +139100 GO TO DIV-TEST-F5-21-1. NC2514.2 +139200 DIV-DELETE-F5-21. NC2514.2 +139300 PERFORM DE-LETE. NC2514.2 +139400 PERFORM PRINT-DETAIL. NC2514.2 +139500 GO TO CCVS-EXIT. NC2514.2 +139600 DIV-FAIL-F5-21. NC2514.2 +139700 PERFORM FAIL. NC2514.2 +139800 MOVE "SIZE ERROR BAD" TO RE-MARK. NC2514.2 +139900 PERFORM PRINT-DETAIL. NC2514.2 +140000 DIV-TEST-F5-21-1. NC2514.2 +140100 MOVE "DIV-TEST-F5-21-1" TO ANSI-REFERENCE. NC2514.2 +140200 MOVE 1 TO REC-CT. NC2514.2 +140300 IF WRK-DU-1V5-1 = 0.31415 PERFORM PASS PERFORM PRINT-DETAIL NC2514.2 +140400 ELSE NC2514.2 +140500 PERFORM FAIL MOVE WRK-DU-1V5-1 TO COMPUTED-N MOVE 0.31415 NC2514.2 +140600 TO CORRECT-N PERFORM PRINT-DETAIL. NC2514.2 +140700 ADD 1 TO REC-CT. NC2514.2 +140800 DIV-TEST-F5-21-2. NC2514.2 +140900 MOVE "DIV-TEST-F5-21-2" TO ANSI-REFERENCE. NC2514.2 +141000 IF WRK-NE-1 = ".0000/92653,58979,32" PERFORM PASS NC2514.2 +141100 PERFORM PRINT-DETAIL ELSE NC2514.2 +141200 PERFORM FAIL MOVE WRK-NE-1 TO COMPUTED-A MOVE NC2514.2 +141300 ".0000/92653,58979,32" TO CORRECT-A PERFORM PRINT-DETAIL. NC2514.2 +141400* NC2514.2 +141500 CCVS-EXIT SECTION. NC2514.2 +141600 CCVS-999999. NC2514.2 +141700 GO TO CLOSE-FILES. NC2514.2 diff --git a/tests/cobol85/NC/NC252A.CBL b/tests/cobol85/NC/NC252A.CBL new file mode 100755 index 00000000..d4cbf6ea --- /dev/null +++ b/tests/cobol85/NC/NC252A.CBL @@ -0,0 +1,1710 @@ +000100 IDENTIFICATION DIVISION. NC2524.2 +000200 PROGRAM-ID. NC2524.2 +000300 NC252A. NC2524.2 +000400**************************************************************** NC2524.2 +000500* * NC2524.2 +000600* VALIDATION FOR:- * NC2524.2 +000700* * NC2524.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2524.2 +000900* * NC2524.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2524.2 +001100* * NC2524.2 +001200**************************************************************** NC2524.2 +001300* * NC2524.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2524.2 +001500* * NC2524.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2524.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2524.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2524.2 +001900* * NC2524.2 +002000**************************************************************** NC2524.2 +002100* * NC2524.2 +002200* THIS PROGRAM TESTS THE "REDEFINES" AND "RENAMES" CLAUSES. * NC2524.2 +002300* * NC2524.2 +002400**************************************************************** NC2524.2 +002500 ENVIRONMENT DIVISION. NC2524.2 +002600 CONFIGURATION SECTION. NC2524.2 +002700 SOURCE-COMPUTER. NC2524.2 +002800 Linux. NC2524.2 +002900 OBJECT-COMPUTER. NC2524.2 +003000 Linux. NC2524.2 +003100 INPUT-OUTPUT SECTION. NC2524.2 +003200 FILE-CONTROL. NC2524.2 +003300 SELECT PRINT-FILE ASSIGN TO NC2524.2 +003400 "report.log". NC2524.2 +003500 DATA DIVISION. NC2524.2 +003600 FILE SECTION. NC2524.2 +003700 FD PRINT-FILE. NC2524.2 +003800 01 PRINT-REC PICTURE X(120). NC2524.2 +003900 01 DUMMY-RECORD PICTURE X(120). NC2524.2 +004000 WORKING-STORAGE SECTION. NC2524.2 +004100 01 WS-REMAINDERS. NC2524.2 +004200 03 WS-REM PIC 99 OCCURS 20. NC2524.2 +004300 01 WRK-XN-00001-1 PIC X. NC2524.2 +004400 01 WRK-XN-00001-2 PIC X. NC2524.2 +004500 01 WS-46. NC2524.2 +004600 03 WS-1-20 PIC X(20). NC2524.2 +004700 03 WS-21-40 PIC X(20). NC2524.2 +004800 03 WS-41-46 PIC X(6). NC2524.2 +004900 77 11A PICTURE 9999 VALUE 9. NC2524.2 +005000 77 11B PICTURE 99; VALUE 8. NC2524.2 +005100 77 1111C PICTURE 99 VALUE 9. NC2524.2 +005200 77 WRK-DS-02V00 PICTURE S99. NC2524.2 +005300 88 TEST-2NUC-COND-99 VALUE 99. NC2524.2 +005400 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2524.2 +005500 77 WRK-DS-18V00 PICTURE S9(18). NC2524.2 +005600 77 A18ONES-DS-18V00 PICTURE S9(18) NC2524.2 +005700 VALUE 111111111111111111. NC2524.2 +005800 77 A18TWOS-DS-18V00 PICTURE S9(18) NC2524.2 +005900 VALUE 222222222222222222. NC2524.2 +006000 77 WRK-DS-05V00 PICTURE S9(5). NC2524.2 +006100 77 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2524.2 +006200 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2524.2 +006300 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. NC2524.2 +006400 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2524.2 +006500 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2524.2 +006600 77 WRK-DS-0201P PICTURE S99P. NC2524.2 +006700 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2524.2 +006800 77 WRK-DS-09V00 PICTURE S9(9). NC2524.2 +006900 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2524.2 +007000 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 NC2524.2 +007100 PICTURE S9(18). NC2524.2 +007200 77 XRAY PICTURE IS X. NC2524.2 +007300 77 W-1 PICTURE IS 9. NC2524.2 +007400 77 W-2 PICTURE IS 99. NC2524.2 +007500 77 W-3 PICTURE IS 999. NC2524.2 +007600 77 W-5 PICTURE 99 VALUE ZERO. NC2524.2 +007700 77 W-9 PICTURE 999. NC2524.2 +007800 77 W-11 PICTURE S99V9. NC2524.2 +007900 77 D-1 PICTURE S9V99 VALUE 1.06. NC2524.2 +008000 77 D-7 PICTURE S99V99 VALUE 1.09. NC2524.2 +008100 77 ONE PICTURE IS 9 VALUE IS 1. NC2524.2 +008200 77 TWO PICTURE IS S9 VALUE IS 2. NC2524.2 +008300 77 THREE PICTURE IS S9 VALUE IS 3. NC2524.2 +008400 77 FOUR PICTURE IS S9 VALUE IS 4. NC2524.2 +008500 77 FIVE PICTURE IS S9 VALUE IS 5. NC2524.2 +008600 77 SIX PICTURE IS S9 VALUE IS 6. NC2524.2 +008700 77 SEVEN PICTURE IS S9 VALUE IS 7. NC2524.2 +008800 77 EIGHT PICTURE IS 9 VALUE IS 8. NC2524.2 +008900 77 NINE PICTURE IS S9 VALUE IS 9. NC2524.2 +009000 77 TEN PICTURE IS S99 VALUE IS 10. NC2524.2 +009100 77 FIFTEEN PICTURE IS S99 VALUE IS 15. NC2524.2 +009200 77 TWENTY PICTURE IS S99 VALUE IS 20. NC2524.2 +009300 77 TWENTY-5 PICTURE IS S99 VALUE IS 25. NC2524.2 +009400 1 COMPUTE-DATA. NC2524.2 +009500 02NC2524.2 +009600 COMPUTE-1 PICTURE 999V9999 VALUE ZERO. NC2524.2 +009700 2 COMPUTE-1A PICTURE 9(3)V9(4) VALUE 654.1873. NC2524.2 +009800 2 COMPUTE-2 PICTURE 9999V9 VALUE ZERO. NC2524.2 +009900 02 COMPUTE-3 PICTURE 999V99 VALUE ZERO. NC2524.2 +010000 2 COMPUTE-3A PICTURE 999V99 VALUE 86.14. NC2524.2 +010100 2 COMPUTE-3B PICTURE 999V99 VALUE 33.75. NC2524.2 +010200 2 COMPUTE-4 PICTURE 999 VALUE ZERO. NC2524.2 +010300 2 COMPUTE-4A PICTURE 999 VALUE 124. NC2524.2 +010400 2 COMPUTE-4B PICTURE 999 VALUE 217. NC2524.2 +010500 2 COMPUTE-5 PICTURE 9999V99 VALUE ZERO. NC2524.2 +010600 02 COMPUTE-5A PICTURE 999V9 VALUE 11.1. NC2524.2 +010700 2 COMPUTE-6 PICTURE 999V9 VALUE ZERO. NC2524.2 +010800 2 COMPUTE-6A PICTURE 999V9 VALUE 374.4. NC2524.2 +010900 2 COMPUTE-7 PICTURE 999 VALUE ZERO. NC2524.2 +011000 2 COMPUTE-8 PICTURE 999 VALUE ZERO. NC2524.2 +011100 02 COMPUTE-9 PICTURE 9999 VALUE ZERO. NC2524.2 +011200 2 COMPUTE-10 PICTURE 999V9999 VALUE ZERO. NC2524.2 +011300 2 COMPUTE-11 PICTURE 999V9 VALUE ZERO. NC2524.2 +011400 2 COMPUTE-11A PICTURE 999V9 VALUE 371.2. NC2524.2 +011500 2 COMPUTE-11B PICTURE 999V9 VALUE 468.9. NC2524.2 +011600 2 COMPUTE-12 PICTURE 99V99 VALUE ZERO. NC2524.2 +011700 2 COMPUTE-12A PICTURE 999V9 VALUE 336.4. NC2524.2 +011800 2 COMPUTE-12B PICTURE 999V9 VALUE 281.7. NC2524.2 +011900 01 RENAMES-DATA. NC2524.2 +012000 02 NAME1. NC2524.2 +012100 03 NAME1A PICTURE XX VALUE SPACE. NC2524.2 +012200 03 NAME1B PICTURE XXX VALUE SPACE. NC2524.2 +012300 02 NAME2 PICTURE X(10) VALUE SPACE. NC2524.2 +012400 02 NAME3. NC2524.2 +012500 09 NAME3A PICTURE XXX VALUE SPACE. NC2524.2 +012600 09 NAME3B PICTURE XX VALUE SPACE. NC2524.2 +012700 66 RENAME1 RENAMES NAME1 THRU NAME3. NC2524.2 +012800 66 RENAME2 RENAMES NAME1A THRU NAME1B. NC2524.2 +012900 66 RENAME3 RENAMES NAME2. NC2524.2 +013000 66 RENAME4 RENAMES NAME1. NC2524.2 +013100 01 GRP-FOR-RENAMES. NC2524.2 +013200 03 SUB-GRP-FOR-RENAMES-1. NC2524.2 +013300 05 ELEM-FOR-RENAMES-1 PICTURE X VALUE "X". NC2524.2 +013400 05 FILLER PICTURE XX VALUE SPACE. NC2524.2 +013500 03 SUB-GRP-FOR-RENAMES-2. NC2524.2 +013600 49 ELEM-FOR-RENAMES-2 PICTURE 999 VALUE 123. NC2524.2 +013700 49 FILLER PICTURE 9 VALUE ZERO. NC2524.2 +013800 49 ELEM-FOR-RENAMES-3 PICTURE XXXX VALUE ZERO. NC2524.2 +013900 66 RENAMES-TEST-1 RENAMES ELEM-FOR-RENAMES-2. NC2524.2 +014000 66 RENAMES-TEST-2 RENAMES SUB-GRP-FOR-RENAMES-1 NC2524.2 +014100 OF GRP-FOR-RENAMES. NC2524.2 +014200 66 RENAMES-TEST-3 RENAMES SUB-GRP-FOR-RENAMES-1 NC2524.2 +014300 THRU ELEM-FOR-RENAMES-2. NC2524.2 +014400 66 RENAMES-TEST-4 RENAMES ELEM-FOR-RENAMES-1 NC2524.2 +014500 THRU ELEM-FOR-RENAMES-2 IN GRP-FOR-RENAMES. NC2524.2 +014600 01 T-RENAMES-DATA. NC2524.2 +014700 02 TAG-1. NC2524.2 +014800 03 TAG-1A PICTURE XXXX. NC2524.2 +014900 03 TAG-1B PICTURE XXXXXX. NC2524.2 +015000 02 NAME-2 PICTURE XXXXXXX. NC2524.2 +015100 66 RENAME-5 RENAMES TAG-1A THRU TAG-1B. NC2524.2 +015200 66 RENAME-6 RENAMES TAG-1A THRU NAME-2 OF T-RENAMES-DATA. NC2524.2 +015300 01 U-RENAMES-DATA. NC2524.2 +015400 02 UNIT-1. NC2524.2 +015500 03 UNIT-1A PICTURE XXXXXXX VALUE "VERMONT". NC2524.2 +015600 03 UNIT-1B PICTURE XXXX VALUE "OHIO". NC2524.2 +015700 02 NAME-2 PICTURE XXXXX VALUE "MAINE". NC2524.2 +015800 66 RENAME-5 RENAMES UNIT-1A THROUGH UNIT-1B. NC2524.2 +015900 66 RENAME-6 RENAMES UNIT-1A THRU NAME-2 OF U-RENAMES-DATA. NC2524.2 +016000 01 V-RENAMES-DATA. NC2524.2 +016100 02 ITEM-1 PICTURE X(5). NC2524.2 +016200 02 TABLE-2. NC2524.2 +016300 03 TABLE-ITEM-2 PICTURE XXX OCCURS 5 TIMES. NC2524.2 +016400 66 RENAME-7 RENAMES ITEM-1 THRU TABLE-2. NC2524.2 +016500 01 W-RENAMES-DATA. NC2524.2 +016600 02 WIDGET-1 PICTURE 99V9. NC2524.2 +016700 02 WIDGET-2 PICTURE ***,***.**. NC2524.2 +016800 02 WIDGET-3 PICTURE XXXX. NC2524.2 +016900 02 WIDGET-4 PICTURE 9(4). NC2524.2 +017000 02 WIDGET-5 PICTURE 9(4). NC2524.2 +017100 66 RENAME-8 RENAMES WIDGET-1 THRU WIDGET-3. NC2524.2 +017200 66 RENAME-9 RENAMES WIDGET-3 THRU WIDGET-5. NC2524.2 +017300 66 RENAME-10 RENAMES WIDGET-4 THRU WIDGET-5. NC2524.2 +017400 66 RENAME-11 RENAMES WIDGET-2. NC2524.2 +017500 66 RENAME-12 RENAMES WIDGET-4. NC2524.2 +017600 01 REDEF10. NC2524.2 +017700 02 RDFDATA1 PICTURE X(10) VALUE "ABC98765DE".NC2524.2 +017800 02 RDFDATA2 PICTURE 9(4)V99 VALUE 9116.44. NC2524.2 +017900 02 RDFDATA3. NC2524.2 +018000 08 RDFDATA4 PICTURE X(6) VALUE "ALLDON". NC2524.2 +018100 08 RDFDATA5 PICTURE XX99 VALUE "XX66". NC2524.2 +018200 02 RDF3 REDEFINES RDFDATA3. NC2524.2 +018300 03 RDF3-4 PICTURE X(8). NC2524.2 +018400 03 RDF3-5 PIC 99. NC2524.2 +018500 03 RDF3-5-1 REDEFINES RDF3-5. NC2524.2 +018600 04 RDF3-5-14 PIC 9. NC2524.2 +018700 04 RDF3-5-15 PIC 9. NC2524.2 +018800 88 HARD VALUE 0. NC2524.2 +018900 88 SOFT VALUE 1. NC2524.2 +019000 02 RDFDATA6 PICTURE A(20) VALUE NC2524.2 +019100 "ZYXWVUTSRQPONMLKJIHG". NC2524.2 +019200 66 RDF3-5-16 RENAMES RDF3-5. NC2524.2 +019300 01 REDEF11 REDEFINES REDEF10. NC2524.2 +019400 02 RDFDATA7 PICTURE X(20). NC2524.2 +019500 02 RDF8. NC2524.2 +019600 03 RDFDATA8 OCCURS 36 TIMES PICTURE XX. NC2524.2 +019700 02 RDEF8 REDEFINES RDF8. NC2524.2 +019800 03 RDF8-1 PICTURE X(50). NC2524.2 +019900 03 RDF8-2 PIC X(9). NC2524.2 +020000 03 RDF8-3 REDEFINES RDF8-2. NC2524.2 +020100 04 RDF8-4 PIC X(5). NC2524.2 +020200 04 RDF8-5 PICTURE XX. NC2524.2 +020300 04 RDF8-6 PIC XX. NC2524.2 +020400 03 RDF8-8 PIC X(13). NC2524.2 +020500 66 RDF8-7 RENAMES RDF8-5 THRU RDF8-6. NC2524.2 +020600 01 REDEF12 REDEFINES REDEF10. NC2524.2 +020700 02 RDFDATA9 PICTURE A(3). NC2524.2 +020800 02 RDFDATA10 PIC 9(5). NC2524.2 +020900 02 RDFDATA11. NC2524.2 +021000 03 RDFDATA12. NC2524.2 +021100 04 RDFDATA13 PICTURE XX. NC2524.2 +021200 04 RDFDATA14 OCCURS 6 TIMES PICTURE 9. NC2524.2 +021300 03 RDFDATA15 PICTURE X(8). NC2524.2 +021400 02 RDFDATA16 PICTURE 99. NC2524.2 +021500 02 RDFDATA17 PICTURE X(80). NC2524.2 +021600 02 RDFDATA18 PICTURE X(14). NC2524.2 +021700 01 GRP-REDEF125 REDEFINES REDEF10. NC2524.2 +021800 02 AN0020-X-0001 PIC X(26). NC2524.2 +021900 02 AN0002-O036F-X-0002 PIC XX OCCURS 36 TIMES. NC2524.2 +022000 01 WRK-DU-05V00-0001 PIC 9(5). NC2524.2 +022100 01 WRK-DS-05V00-0002 PIC S9(5). NC2524.2 +022200 01 WRK-CS-05V00-0003 PIC S9(5) COMP. NC2524.2 +022300 01 WRK-DU-04V02-0004 PIC 9(4)V9(2). NC2524.2 +022400 01 WRK-DS-04V01-0005 PIC S9(4)V9. NC2524.2 +022500 01 NE-0008 PIC $9(4).99-. NC2524.2 +022600 01 NE-0009 PIC ***99. NC2524.2 +022700 01 NE-04V01-0006 PIC ****.9. NC2524.2 +022800 01 GRP-0010. NC2524.2 +022900 02 WRK-DU-03V00-L-0011 PIC 9(03) SYNC LEFT. NC2524.2 +023000 02 WRK-O005F-0012 OCCURS 5 TIMES. NC2524.2 +023100 03 WRK-O003F-0013 OCCURS 3 TIMES. NC2524.2 +023200 05 WRK-DS-03V04-0003F-0014 PIC S9(3)V9999 NC2524.2 +023300 OCCURS 3 TIMES. NC2524.2 +023400 01 DS-02V00-0001 PIC S99 VALUE 16. NC2524.2 +023500 01 DS-03V00-0002 PIC S999 VALUE 174. NC2524.2 +023600 01 CS-05V00-0003 PIC S9(5) COMP VALUE 10. NC2524.2 +023700 01 TA--X PIC 9(5) COMP VALUE ZERO. NC2524.2 +023800 01 REDEF13. NC2524.2 +023900 02 FILLER PICTURE X(57) VALUE NC2524.2 +024000 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA". NC2524.2 +024100 02 FILLER PICTURE X(57) VALUE NC2524.2 +024200 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA". NC2524.2 +024300 02 FILLER PICTURE X(6) VALUE "AAAAAA". NC2524.2 +024400 01 MINUS-NAMES. NC2524.2 +024500 02 WHOLE-FIELD PICTURE S9(18). NC2524.2 +024600 02 PLUS-NAME1 PICTURE S9(18) VALUE +333333333333333333. NC2524.2 +024700 02 EVEN-NAME1 PICTURE S9(18) VALUE +1. NC2524.2 +024800 02 PLUS-NAME2 PICTURE S9(18) VALUE +999999999999999999. NC2524.2 +024900 02 ALPHA-LIT PICTURE X(5) VALUE SPACE. NC2524.2 +025000 02 SNEG-LIT2 PICTURE S9(5) VALUE -70718. NC2524.2 +025100 01 TEST-RESULTS. NC2524.2 +025200 02 FILLER PIC X VALUE SPACE. NC2524.2 +025300 02 FEATURE PIC X(20) VALUE SPACE. NC2524.2 +025400 02 FILLER PIC X VALUE SPACE. NC2524.2 +025500 02 P-OR-F PIC X(5) VALUE SPACE. NC2524.2 +025600 02 FILLER PIC X VALUE SPACE. NC2524.2 +025700 02 PAR-NAME. NC2524.2 +025800 03 FILLER PIC X(19) VALUE SPACE. NC2524.2 +025900 03 PARDOT-X PIC X VALUE SPACE. NC2524.2 +026000 03 DOTVALUE PIC 99 VALUE ZERO. NC2524.2 +026100 02 FILLER PIC X(8) VALUE SPACE. NC2524.2 +026200 02 RE-MARK PIC X(61). NC2524.2 +026300 01 TEST-COMPUTED. NC2524.2 +026400 02 FILLER PIC X(30) VALUE SPACE. NC2524.2 +026500 02 FILLER PIC X(17) VALUE NC2524.2 +026600 " COMPUTED=". NC2524.2 +026700 02 COMPUTED-X. NC2524.2 +026800 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2524.2 +026900 03 COMPUTED-N REDEFINES COMPUTED-A NC2524.2 +027000 PIC -9(9).9(9). NC2524.2 +027100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2524.2 +027200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2524.2 +027300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2524.2 +027400 03 CM-18V0 REDEFINES COMPUTED-A. NC2524.2 +027500 04 COMPUTED-18V0 PIC -9(18). NC2524.2 +027600 04 FILLER PIC X. NC2524.2 +027700 03 FILLER PIC X(50) VALUE SPACE. NC2524.2 +027800 01 TEST-CORRECT. NC2524.2 +027900 02 FILLER PIC X(30) VALUE SPACE. NC2524.2 +028000 02 FILLER PIC X(17) VALUE " CORRECT =". NC2524.2 +028100 02 CORRECT-X. NC2524.2 +028200 03 CORRECT-A PIC X(20) VALUE SPACE. NC2524.2 +028300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2524.2 +028400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2524.2 +028500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2524.2 +028600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2524.2 +028700 03 CR-18V0 REDEFINES CORRECT-A. NC2524.2 +028800 04 CORRECT-18V0 PIC -9(18). NC2524.2 +028900 04 FILLER PIC X. NC2524.2 +029000 03 FILLER PIC X(2) VALUE SPACE. NC2524.2 +029100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2524.2 +029200 01 CCVS-C-1. NC2524.2 +029300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2524.2 +029400- "SS PARAGRAPH-NAME NC2524.2 +029500- " REMARKS". NC2524.2 +029600 02 FILLER PIC X(20) VALUE SPACE. NC2524.2 +029700 01 CCVS-C-2. NC2524.2 +029800 02 FILLER PIC X VALUE SPACE. NC2524.2 +029900 02 FILLER PIC X(6) VALUE "TESTED". NC2524.2 +030000 02 FILLER PIC X(15) VALUE SPACE. NC2524.2 +030100 02 FILLER PIC X(4) VALUE "FAIL". NC2524.2 +030200 02 FILLER PIC X(94) VALUE SPACE. NC2524.2 +030300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2524.2 +030400 01 REC-CT PIC 99 VALUE ZERO. NC2524.2 +030500 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2524.2 +030600 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2524.2 +030700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2524.2 +030800 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2524.2 +030900 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2524.2 +031000 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2524.2 +031100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2524.2 +031200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2524.2 +031300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2524.2 +031400 01 CCVS-H-1. NC2524.2 +031500 02 FILLER PIC X(39) VALUE SPACES. NC2524.2 +031600 02 FILLER PIC X(42) VALUE NC2524.2 +031700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2524.2 +031800 02 FILLER PIC X(39) VALUE SPACES. NC2524.2 +031900 01 CCVS-H-2A. NC2524.2 +032000 02 FILLER PIC X(40) VALUE SPACE. NC2524.2 +032100 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2524.2 +032200 02 FILLER PIC XXXX VALUE NC2524.2 +032300 "4.2 ". NC2524.2 +032400 02 FILLER PIC X(28) VALUE NC2524.2 +032500 " COPY - NOT FOR DISTRIBUTION". NC2524.2 +032600 02 FILLER PIC X(41) VALUE SPACE. NC2524.2 +032700 NC2524.2 +032800 01 CCVS-H-2B. NC2524.2 +032900 02 FILLER PIC X(15) VALUE NC2524.2 +033000 "TEST RESULT OF ". NC2524.2 +033100 02 TEST-ID PIC X(9). NC2524.2 +033200 02 FILLER PIC X(4) VALUE NC2524.2 +033300 " IN ". NC2524.2 +033400 02 FILLER PIC X(12) VALUE NC2524.2 +033500 " HIGH ". NC2524.2 +033600 02 FILLER PIC X(22) VALUE NC2524.2 +033700 " LEVEL VALIDATION FOR ". NC2524.2 +033800 02 FILLER PIC X(58) VALUE NC2524.2 +033900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2524.2 +034000 01 CCVS-H-3. NC2524.2 +034100 02 FILLER PIC X(34) VALUE NC2524.2 +034200 " FOR OFFICIAL USE ONLY ". NC2524.2 +034300 02 FILLER PIC X(58) VALUE NC2524.2 +034400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2524.2 +034500 02 FILLER PIC X(28) VALUE NC2524.2 +034600 " COPYRIGHT 1985 ". NC2524.2 +034700 01 CCVS-E-1. NC2524.2 +034800 02 FILLER PIC X(52) VALUE SPACE. NC2524.2 +034900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2524.2 +035000 02 ID-AGAIN PIC X(9). NC2524.2 +035100 02 FILLER PIC X(45) VALUE SPACES. NC2524.2 +035200 01 CCVS-E-2. NC2524.2 +035300 02 FILLER PIC X(31) VALUE SPACE. NC2524.2 +035400 02 FILLER PIC X(21) VALUE SPACE. NC2524.2 +035500 02 CCVS-E-2-2. NC2524.2 +035600 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2524.2 +035700 03 FILLER PIC X VALUE SPACE. NC2524.2 +035800 03 ENDER-DESC PIC X(44) VALUE NC2524.2 +035900 "ERRORS ENCOUNTERED". NC2524.2 +036000 01 CCVS-E-3. NC2524.2 +036100 02 FILLER PIC X(22) VALUE NC2524.2 +036200 " FOR OFFICIAL USE ONLY". NC2524.2 +036300 02 FILLER PIC X(12) VALUE SPACE. NC2524.2 +036400 02 FILLER PIC X(58) VALUE NC2524.2 +036500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2524.2 +036600 02 FILLER PIC X(13) VALUE SPACE. NC2524.2 +036700 02 FILLER PIC X(15) VALUE NC2524.2 +036800 " COPYRIGHT 1985". NC2524.2 +036900 01 CCVS-E-4. NC2524.2 +037000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2524.2 +037100 02 FILLER PIC X(4) VALUE " OF ". NC2524.2 +037200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2524.2 +037300 02 FILLER PIC X(40) VALUE NC2524.2 +037400 " TESTS WERE EXECUTED SUCCESSFULLY". NC2524.2 +037500 01 XXINFO. NC2524.2 +037600 02 FILLER PIC X(19) VALUE NC2524.2 +037700 "*** INFORMATION ***". NC2524.2 +037800 02 INFO-TEXT. NC2524.2 +037900 04 FILLER PIC X(8) VALUE SPACE. NC2524.2 +038000 04 XXCOMPUTED PIC X(20). NC2524.2 +038100 04 FILLER PIC X(5) VALUE SPACE. NC2524.2 +038200 04 XXCORRECT PIC X(20). NC2524.2 +038300 02 INF-ANSI-REFERENCE PIC X(48). NC2524.2 +038400 01 HYPHEN-LINE. NC2524.2 +038500 02 FILLER PIC IS X VALUE IS SPACE. NC2524.2 +038600 02 FILLER PIC IS X(65) VALUE IS "************************NC2524.2 +038700- "*****************************************". NC2524.2 +038800 02 FILLER PIC IS X(54) VALUE IS "************************NC2524.2 +038900- "******************************". NC2524.2 +039000 01 CCVS-PGM-ID PIC X(9) VALUE NC2524.2 +039100 "NC252A". NC2524.2 +039200 PROCEDURE DIVISION. NC2524.2 +039300 CCVS1 SECTION. NC2524.2 +039400 OPEN-FILES. NC2524.2 +039500 OPEN OUTPUT PRINT-FILE. NC2524.2 +039600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2524.2 +039700 MOVE SPACE TO TEST-RESULTS. NC2524.2 +039800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2524.2 +039900 GO TO CCVS1-EXIT. NC2524.2 +040000 CLOSE-FILES. NC2524.2 +040100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2524.2 +040200 TERMINATE-CCVS. NC2524.2 +040300 STOP RUN. NC2524.2 +040400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2524.2 +040500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2524.2 +040600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2524.2 +040700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2524.2 +040800 MOVE "****TEST DELETED****" TO RE-MARK. NC2524.2 +040900 PRINT-DETAIL. NC2524.2 +041000 IF REC-CT NOT EQUAL TO ZERO NC2524.2 +041100 MOVE "." TO PARDOT-X NC2524.2 +041200 MOVE REC-CT TO DOTVALUE. NC2524.2 +041300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2524.2 +041400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2524.2 +041500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2524.2 +041600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2524.2 +041700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2524.2 +041800 MOVE SPACE TO CORRECT-X. NC2524.2 +041900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2524.2 +042000 MOVE SPACE TO RE-MARK. NC2524.2 +042100 HEAD-ROUTINE. NC2524.2 +042200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +042300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +042400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2524.2 +042500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2524.2 +042600 COLUMN-NAMES-ROUTINE. NC2524.2 +042700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +042800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +042900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +043000 END-ROUTINE. NC2524.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2524.2 +043200 END-RTN-EXIT. NC2524.2 +043300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +043400 END-ROUTINE-1. NC2524.2 +043500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2524.2 +043600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2524.2 +043700 ADD PASS-COUNTER TO ERROR-HOLD. NC2524.2 +043800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2524.2 +043900 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2524.2 +044000 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2524.2 +044100 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2524.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2524.2 +044300 END-ROUTINE-12. NC2524.2 +044400 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2524.2 +044500 IF ERROR-COUNTER IS EQUAL TO ZERO NC2524.2 +044600 MOVE "NO " TO ERROR-TOTAL NC2524.2 +044700 ELSE NC2524.2 +044800 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2524.2 +044900 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2524.2 +045000 PERFORM WRITE-LINE. NC2524.2 +045100 END-ROUTINE-13. NC2524.2 +045200 IF DELETE-COUNTER IS EQUAL TO ZERO NC2524.2 +045300 MOVE "NO " TO ERROR-TOTAL ELSE NC2524.2 +045400 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2524.2 +045500 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2524.2 +045600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +045700 IF INSPECT-COUNTER EQUAL TO ZERO NC2524.2 +045800 MOVE "NO " TO ERROR-TOTAL NC2524.2 +045900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2524.2 +046000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2524.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +046200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2524.2 +046300 WRITE-LINE. NC2524.2 +046400 ADD 1 TO RECORD-COUNT. NC2524.2 +046500 IF RECORD-COUNT GREATER 50 NC2524.2 +046600 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2524.2 +046700 MOVE SPACE TO DUMMY-RECORD NC2524.2 +046800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2524.2 +046900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2524.2 +047000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2524.2 +047100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2524.2 +047200 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2524.2 +047300 MOVE ZERO TO RECORD-COUNT. NC2524.2 +047400 PERFORM WRT-LN. NC2524.2 +047500 WRT-LN. NC2524.2 +047600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2524.2 +047700 MOVE SPACE TO DUMMY-RECORD. NC2524.2 +047800 BLANK-LINE-PRINT. NC2524.2 +047900 PERFORM WRT-LN. NC2524.2 +048000 FAIL-ROUTINE. NC2524.2 +048100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2524.2 +048200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2524.2 +048300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2524.2 +048400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2524.2 +048500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +048600 MOVE SPACES TO INF-ANSI-REFERENCE. NC2524.2 +048700 GO TO FAIL-ROUTINE-EX. NC2524.2 +048800 FAIL-ROUTINE-WRITE. NC2524.2 +048900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2524.2 +049000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2524.2 +049100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2524.2 +049200 MOVE SPACES TO COR-ANSI-REFERENCE. NC2524.2 +049300 FAIL-ROUTINE-EX. EXIT. NC2524.2 +049400 BAIL-OUT. NC2524.2 +049500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2524.2 +049600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2524.2 +049700 BAIL-OUT-WRITE. NC2524.2 +049800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2524.2 +049900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2524.2 +050000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2524.2 +050100 MOVE SPACES TO INF-ANSI-REFERENCE. NC2524.2 +050200 BAIL-OUT-EX. EXIT. NC2524.2 +050300 CCVS1-EXIT. NC2524.2 +050400 EXIT. NC2524.2 +050500 SECT-NC252A-001 SECTION. NC2524.2 +050600 RDF-INIT. NC2524.2 +050700 MOVE "REDEFINES " TO FEATURE. NC2524.2 +050800 RDF-TEST-1. NC2524.2 +050900 IF HARD NC2524.2 +051000 MOVE RDF3-5-15 TO COMPUTED-A NC2524.2 +051100 MOVE 6 TO CORRECT-A NC2524.2 +051200 PERFORM FAIL NC2524.2 +051300 GO TO RDF-WRITE-1. NC2524.2 +051400* NOTE 88 LEVEL CONDITION TEST ON REDEFINED FIELD. NC2524.2 +051500 PERFORM PASS. NC2524.2 +051600 GO TO RDF-WRITE-1. NC2524.2 +051700 RDF-DELETE-1. NC2524.2 +051800 PERFORM DE-LETE. NC2524.2 +051900 RDF-WRITE-1. NC2524.2 +052000 MOVE "RDF-TEST-1 " TO PAR-NAME. NC2524.2 +052100 PERFORM PRINT-DETAIL. NC2524.2 +052200 RDF-TEST-2. NC2524.2 +052300 IF RDF3-5-16 EQUAL TO 66 NC2524.2 +052400 PERFORM PASS NC2524.2 +052500 GO TO RDF-WRITE-2. NC2524.2 +052600* NOTE USING A RENAMES DATANAME THAT IS ALSO REDEFINED. NC2524.2 +052700 MOVE RDF3-5-16 TO COMPUTED-A. NC2524.2 +052800 MOVE 66 TO CORRECT-A. NC2524.2 +052900 PERFORM FAIL. NC2524.2 +053000 GO TO RDF-WRITE-2. NC2524.2 +053100 RDF-DELETE-2. NC2524.2 +053200 PERFORM DE-LETE. NC2524.2 +053300 RDF-WRITE-2. NC2524.2 +053400 MOVE "RDF-TEST-2 " TO PAR-NAME. NC2524.2 +053500 PERFORM PRINT-DETAIL. NC2524.2 +053600 RDF-TEST-003. NC2524.2 +053700 IF AN0002-O036F-X-0002 (8) EQUAL TO "LK" NC2524.2 +053800 PERFORM PASS NC2524.2 +053900 GO TO RDF-WRITE-003. NC2524.2 +054000* NC2524.2 +054100* NOTE REFERENCING SUBSCRIPTED DATA ITEM WHICH IS NC2524.2 +054200* SUBORDINATE TO A REDEFINES CLAUSE. NC2524.2 +054300* NC2524.2 +054400 MOVE AN0002-O036F-X-0002 (8) TO COMPUTED-A. NC2524.2 +054500 MOVE "LK" TO CORRECT-A. NC2524.2 +054600 PERFORM FAIL. NC2524.2 +054700 GO TO RDF-WRITE-003. NC2524.2 +054800 RDF-DELETE-003. NC2524.2 +054900 PERFORM DE-LETE. NC2524.2 +055000 RDF-WRITE-003. NC2524.2 +055100 MOVE "RDF-TEST-003" TO PAR-NAME. NC2524.2 +055200 PERFORM PRINT-DETAIL. NC2524.2 +055300 RDF-TEST-4. NC2524.2 +055400 IF RDFDATA7 EQUAL TO "ABC98765DE911644ALLD" NC2524.2 +055500 PERFORM PASS NC2524.2 +055600 GO TO RDF-WRITE-4. NC2524.2 +055700* NOTE THIS IS THE FIRST REFERENCE TO THESE REDEFINED NC2524.2 +055800* DATANAMES, SO, THE FIELDS CONTAIN THE WORKING-STORAGE NC2524.2 +055900* ASSIGNED VALUES. NC2524.2 +056000 MOVE RDFDATA7 TO COMPUTED-A. NC2524.2 +056100 MOVE "ABC98765DE911644ALLD" TO CORRECT-A. NC2524.2 +056200 PERFORM FAIL. NC2524.2 +056300 GO TO RDF-WRITE-4. NC2524.2 +056400 RDF-DELETE-4. NC2524.2 +056500 PERFORM DE-LETE. NC2524.2 +056600 RDF-WRITE-4. NC2524.2 +056700 MOVE "RDF-TEST-4 " TO PAR-NAME. NC2524.2 +056800 PERFORM PRINT-DETAIL. NC2524.2 +056900 RDF-TEST-5. NC2524.2 +057000 IF RDFDATA8 (13) EQUAL TO "HG" NC2524.2 +057100 PERFORM PASS NC2524.2 +057200 GO TO RDF-WRITE-5. NC2524.2 +057300 MOVE "HG" TO CORRECT-A. NC2524.2 +057400 MOVE RDFDATA8 (13) TO COMPUTED-A. NC2524.2 +057500 PERFORM FAIL. NC2524.2 +057600 GO TO RDF-WRITE-5. NC2524.2 +057700 RDF-DELETE-5. NC2524.2 +057800 PERFORM DE-LETE. NC2524.2 +057900 RDF-WRITE-5. NC2524.2 +058000 MOVE "RDF-TEST-5 " TO PAR-NAME. NC2524.2 +058100 PERFORM PRINT-DETAIL. NC2524.2 +058200 RDF-TEST-6. NC2524.2 +058300 IF RDFDATA2 EQUAL TO 9116.44 NC2524.2 +058400 PERFORM PASS NC2524.2 +058500 GO TO RDF-WRITE-6. NC2524.2 +058600 MOVE 9116.44 TO COMPUTED-N. NC2524.2 +058700 MOVE RDFDATA2 TO CORRECT-N. NC2524.2 +058800 PERFORM FAIL. NC2524.2 +058900 GO TO RDF-WRITE-6. NC2524.2 +059000 RDF-DELETE-6. NC2524.2 +059100 PERFORM DE-LETE. NC2524.2 +059200 RDF-WRITE-6. NC2524.2 +059300 MOVE "RDF-TEST-6 " TO PAR-NAME. NC2524.2 +059400 PERFORM PRINT-DETAIL. NC2524.2 +059500 RDF-TEST-7. NC2524.2 +059600 IF RDFDATA16 EQUAL TO 66 NC2524.2 +059700 PERFORM PASS NC2524.2 +059800 GO TO RDF-WRITE-7. NC2524.2 +059900 MOVE RDFDATA16 TO COMPUTED-A. NC2524.2 +060000 MOVE 66 TO CORRECT-A. NC2524.2 +060100 PERFORM FAIL. NC2524.2 +060200 GO TO RDF-WRITE-7. NC2524.2 +060300 RDF-DELETE-7. NC2524.2 +060400 PERFORM DE-LETE. NC2524.2 +060500 RDF-WRITE-7. NC2524.2 +060600 MOVE "RDF-TEST-7 " TO PAR-NAME. NC2524.2 +060700 PERFORM PRINT-DETAIL. NC2524.2 +060800 RDF-TEST-8. NC2524.2 +060900 MOVE SPACE TO REDEF12. NC2524.2 +061000 IF REDEF11 EQUAL TO SPACE NC2524.2 +061100 PERFORM PASS NC2524.2 +061200 GO TO RDF-WRITE-8. NC2524.2 +061300 MOVE "SPACE EXPECTED " TO CORRECT-A. NC2524.2 +061400 MOVE "NON BLANK CHARACTERS" TO COMPUTED-A. NC2524.2 +061500 MOVE "REDEF11 CONTAINS NON BLANKS" TO RE-MARK. NC2524.2 +061600 PERFORM FAIL. NC2524.2 +061700 GO TO RDF-WRITE-8. NC2524.2 +061800 RDF-DELETE-8. NC2524.2 +061900 PERFORM DE-LETE. NC2524.2 +062000 RDF-WRITE-8. NC2524.2 +062100 MOVE "RDF-TEST-8 " TO PAR-NAME. NC2524.2 +062200 PERFORM PRINT-DETAIL. NC2524.2 +062300 RDF-TEST-9. NC2524.2 +062400 MOVE ZERO TO REDEF12. NC2524.2 +062500 MOVE SPACE TO REDEF11. NC2524.2 +062600* NOTE CHECKS RDFDATA18 WHICH SHOULD NOT BE DISTURBED BY THE NC2524.2 +062700* MOVE SPACE STATEMENT TO A SHORTER REDEFINED AREA. NC2524.2 +062800 IF RDFDATA18 EQUAL TO ZERO NC2524.2 +062900 PERFORM PASS NC2524.2 +063000 GO TO RDF-WRITE-9. NC2524.2 +063100 MOVE "00000000000000" TO CORRECT-A. NC2524.2 +063200 MOVE RDFDATA18 TO COMPUTED-A. NC2524.2 +063300 PERFORM FAIL. NC2524.2 +063400 GO TO RDF-WRITE-9. NC2524.2 +063500 RDF-DELETE-9. NC2524.2 +063600 PERFORM DE-LETE. NC2524.2 +063700 RDF-WRITE-9. NC2524.2 +063800 MOVE "RDF-TEST-9 " TO PAR-NAME. NC2524.2 +063900 PERFORM PRINT-DETAIL. NC2524.2 +064000 RDF-TEST-10. NC2524.2 +064100 MOVE ZERO TO REDEF12. NC2524.2 +064200 MOVE "MOVING DATA TO A REDEFINED FIELD CAN BE RISKY " NC2524.2 +064300 TO REDEF10. NC2524.2 +064400 IF RDFDATA8 (14) EQUAL TO "00" NC2524.2 +064500 PERFORM PASS NC2524.2 +064600 GO TO RDF-WRITE-10. NC2524.2 +064700 MOVE 00 TO CORRECT-A. NC2524.2 +064800 MOVE RDFDATA8 (14) TO COMPUTED-A. NC2524.2 +064900 PERFORM FAIL. NC2524.2 +065000 GO TO RDF-WRITE-10. NC2524.2 +065100 RDF-DELETE-10. NC2524.2 +065200 PERFORM DE-LETE. NC2524.2 +065300 RDF-WRITE-10. NC2524.2 +065400 MOVE "RDF-TEST-10 " TO PAR-NAME. NC2524.2 +065500 PERFORM PRINT-DETAIL. NC2524.2 +065600 RDF-INIT-11. NC2524.2 +065700 MOVE REDEF13 TO REDEF12. NC2524.2 +065800 MOVE "RDF-TEST-11 " TO PAR-NAME. NC2524.2 +065900 RDF-TEST-11. NC2524.2 +066000 IF REDEF10 EQUAL TO NC2524.2 +066100 "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" NC2524.2 +066200 PERFORM PASS NC2524.2 +066300 PERFORM PRINT-DETAIL NC2524.2 +066400 GO TO RDF-TEST-12. NC2524.2 +066500 MOVE 1 TO REC-CT. NC2524.2 +066600 MOVE REDEF10 TO WS-46. NC2524.2 +066700 MOVE "AAAAAAAAAAAAAAAAAAAA" TO CORRECT-A. NC2524.2 +066800 MOVE WS-1-20 TO COMPUTED-A. NC2524.2 +066900 MOVE "FIELDS DIDNT COMPARE EQUAL " TO RE-MARK. NC2524.2 +067000 PERFORM FAIL. NC2524.2 +067100 PERFORM PRINT-DETAIL. NC2524.2 +067200 ADD 1 TO REC-CT. NC2524.2 +067300 MOVE "AAAAAAAAAAAAAAAAAAAA" TO CORRECT-A. NC2524.2 +067400 MOVE WS-21-40 TO COMPUTED-A. NC2524.2 +067500 MOVE "FIELDS DIDNT COMPARE EQUAL " TO RE-MARK. NC2524.2 +067600 PERFORM FAIL. NC2524.2 +067700 PERFORM PRINT-DETAIL. NC2524.2 +067800 ADD 1 TO REC-CT. NC2524.2 +067900 MOVE "AAAAAA" TO CORRECT-A. NC2524.2 +068000 MOVE WS-41-46 TO COMPUTED-A. NC2524.2 +068100 MOVE "FIELDS DIDNT COMPARE EQUAL " TO RE-MARK. NC2524.2 +068200 PERFORM FAIL. NC2524.2 +068300 PERFORM PRINT-DETAIL. NC2524.2 +068400 GO TO RDF-TEST-12. NC2524.2 +068500 RDF-DELETE-11. NC2524.2 +068600 PERFORM DE-LETE. NC2524.2 +068700 RDF-TEST-12. NC2524.2 +068800 MOVE 11 TO RDFDATA16. NC2524.2 +068900* NOTE 88 LEVEL TEST ON REDEFINED AREA. NC2524.2 +069000 IF SOFT NC2524.2 +069100 PERFORM PASS NC2524.2 +069200 ELSE NC2524.2 +069300 MOVE "CONDITION-NAME TEST" TO RE-MARK NC2524.2 +069400 PERFORM FAIL. NC2524.2 +069500 GO TO RDF-WRITE-12. NC2524.2 +069600 RDF-DELETE-12. NC2524.2 +069700 PERFORM DE-LETE. NC2524.2 +069800 RDF-WRITE-12. NC2524.2 +069900 MOVE "RDF-TEST-12" TO PAR-NAME. NC2524.2 +070000 PERFORM PRINT-DETAIL. NC2524.2 +070100 RDF-TEST-13. NC2524.2 +070200 MOVE REDEF13 TO REDEF12. NC2524.2 +070300 MOVE SPACE TO REDEF10. NC2524.2 +070400 IF RDF8-7 EQUAL TO SPACE NC2524.2 +070500 MOVE RDF8-7 TO COMPUTED-A NC2524.2 +070600 MOVE "AAAA" TO CORRECT-A NC2524.2 +070700 PERFORM FAIL NC2524.2 +070800 GO TO RDF-WRITE-13. NC2524.2 +070900 PERFORM PASS. NC2524.2 +071000 GO TO RDF-WRITE-13. NC2524.2 +071100 RDF-DELETE-13. NC2524.2 +071200 PERFORM DE-LETE. NC2524.2 +071300 RDF-WRITE-13. NC2524.2 +071400 MOVE "RDF-TEST-13 " TO PAR-NAME. NC2524.2 +071500 PERFORM PRINT-DETAIL. NC2524.2 +071600 RDF-TEST-14. NC2524.2 +071700 MOVE SPACE TO REDEF12. NC2524.2 +071800 MOVE REDEF13 TO REDEF10. NC2524.2 +071900 IF RDF8-3 EQUAL TO "AAAAAAAAA" NC2524.2 +072000 MOVE RDF8-3 TO COMPUTED-A NC2524.2 +072100 MOVE SPACE TO CORRECT-A NC2524.2 +072200 PERFORM FAIL NC2524.2 +072300 GO TO RDF-WRITE-14. NC2524.2 +072400 PERFORM PASS. NC2524.2 +072500 GO TO RDF-WRITE-14. NC2524.2 +072600 RDF-DELETE-14. NC2524.2 +072700 PERFORM DE-LETE. NC2524.2 +072800 RDF-WRITE-14. NC2524.2 +072900 MOVE "RDF-TEST-14 " TO PAR-NAME. NC2524.2 +073000 PERFORM PRINT-DETAIL. NC2524.2 +073100 RNM-INIT. NC2524.2 +073200 PERFORM END-ROUTINE. NC2524.2 +073300 MOVE "RENAMES" TO FEATURE. NC2524.2 +073400 RENAM-TEST-1. NC2524.2 +073500 MOVE "AB" TO NAME1A. NC2524.2 +073600 MOVE "CD" TO NAME1B. NC2524.2 +073700 IF RENAME4 EQUAL TO "ABCD " NC2524.2 +073800 PERFORM PASS NC2524.2 +073900 GO TO RNM-WRITE-1. NC2524.2 +074000 MOVE RENAME4 TO COMPUTED-A. NC2524.2 +074100 MOVE "ABCD" TO CORRECT-A. NC2524.2 +074200* NOTE CORRECT ANSWER IS ABCD-BLANK. NC2524.2 +074300 PERFORM FAIL. NC2524.2 +074400 GO TO RNM-WRITE-1. NC2524.2 +074500 RNM-DELETE-1. NC2524.2 +074600 PERFORM DE-LETE. NC2524.2 +074700 RNM-WRITE-1. NC2524.2 +074800 MOVE "RENAM-TEST-1" TO PAR-NAME. NC2524.2 +074900 PERFORM PRINT-DETAIL. NC2524.2 +075000 RENAM-TEST-2. NC2524.2 +075100 MOVE ALL "A" TO RENAMES-DATA. NC2524.2 +075200 IF RENAME3 EQUAL TO "AAAAAAAAAA" NC2524.2 +075300 PERFORM PASS NC2524.2 +075400 GO TO RNM-WRITE-2. NC2524.2 +075500 MOVE RENAME3 TO COMPUTED-A. NC2524.2 +075600 MOVE "AAAAAAAAAA" TO CORRECT-A. NC2524.2 +075700 PERFORM FAIL. NC2524.2 +075800 GO TO RNM-WRITE-2. NC2524.2 +075900 RNM-DELETE-2. NC2524.2 +076000 PERFORM DE-LETE. NC2524.2 +076100 RNM-WRITE-2. NC2524.2 +076200 MOVE "RENAM-TEST-2" TO PAR-NAME. NC2524.2 +076300 PERFORM PRINT-DETAIL. NC2524.2 +076400 RENAM-TEST-3. NC2524.2 +076500 MOVE ALL "A" TO RENAMES-DATA. NC2524.2 +076600 MOVE ALL "X" TO RENAME1. NC2524.2 +076700 IF NAME1 NOT EQUAL TO "XXXXX" GO TO RNM-FAIL-3. NC2524.2 +076800 IF NAME2 NOT EQUAL TO "XXXXXXXXXX" GO TO RNM-FAIL-3. NC2524.2 +076900 IF NAME3 NOT EQUAL TO "XXXXX" GO TO RNM-FAIL-3. NC2524.2 +077000 PERFORM PASS. NC2524.2 +077100 GO TO RNM-WRITE-3. NC2524.2 +077200 RNM-DELETE-3. NC2524.2 +077300 PERFORM DE-LETE. NC2524.2 +077400 GO TO RNM-WRITE-3. NC2524.2 +077500 RNM-FAIL-3. NC2524.2 +077600 MOVE RENAMES-DATA TO COMPUTED-A. NC2524.2 +077700 MOVE "XXXXXXXXXXXXXXXXXXXX" TO CORRECT-A. NC2524.2 +077800 PERFORM FAIL. NC2524.2 +077900 RNM-WRITE-3. NC2524.2 +078000 MOVE "RENAM-TEST-3" TO PAR-NAME. NC2524.2 +078100 PERFORM PRINT-DETAIL. NC2524.2 +078200 RENAM-TEST-4. NC2524.2 +078300 IF RENAMES-TEST-1 EQUAL TO 123 NC2524.2 +078400 PERFORM PASS NC2524.2 +078500 GO TO RENAM-WRITE-4. NC2524.2 +078600 MOVE RENAMES-TEST-1 TO COMPUTED-A. NC2524.2 +078700 MOVE 123 TO CORRECT-A. NC2524.2 +078800 PERFORM FAIL. NC2524.2 +078900 GO TO RENAM-WRITE-4. NC2524.2 +079000 RENAM-DELETE-4. NC2524.2 +079100 PERFORM DE-LETE. NC2524.2 +079200 RENAM-WRITE-4. NC2524.2 +079300 MOVE "RENAM-TEST-4" TO PAR-NAME. NC2524.2 +079400 PERFORM PRINT-DETAIL. NC2524.2 +079500 RENAM-TEST-5. NC2524.2 +079600 IF RENAMES-TEST-3 EQUAL TO "X 123" NC2524.2 +079700 PERFORM PASS NC2524.2 +079800 GO TO RENAM-WRITE-5. NC2524.2 +079900 MOVE RENAMES-TEST-3 TO COMPUTED-A. NC2524.2 +080000 MOVE "X 123" TO CORRECT-A. NC2524.2 +080100 PERFORM FAIL. NC2524.2 +080200 GO TO RENAM-WRITE-5. NC2524.2 +080300 RENAM-DELETE-5. NC2524.2 +080400 PERFORM DE-LETE. NC2524.2 +080500 RENAM-WRITE-5. NC2524.2 +080600 MOVE "RENAM-TEST-5" TO PAR-NAME. NC2524.2 +080700 PERFORM PRINT-DETAIL. NC2524.2 +080800 RENAM-TEST-6. NC2524.2 +080900 IF RENAMES-TEST-4 EQUAL TO "X 123" NC2524.2 +081000 PERFORM PASS NC2524.2 +081100 GO TO RENAM-WRITE-6. NC2524.2 +081200 MOVE RENAMES-TEST-4 TO COMPUTED-A. NC2524.2 +081300 MOVE "X 123" TO CORRECT-A. NC2524.2 +081400 PERFORM FAIL. NC2524.2 +081500 GO TO RENAM-WRITE-6. NC2524.2 +081600 RENAM-DELETE-6. NC2524.2 +081700 PERFORM DE-LETE. NC2524.2 +081800 RENAM-WRITE-6. NC2524.2 +081900 MOVE "RENAM-TEST-6" TO PAR-NAME. NC2524.2 +082000 PERFORM PRINT-DETAIL. NC2524.2 +082100 RENAM-TEST-7. NC2524.2 +082200 IF RENAMES-TEST-2 EQUAL TO "X " NC2524.2 +082300 PERFORM PASS NC2524.2 +082400 GO TO RENAM-WRITE-7. NC2524.2 +082500 MOVE RENAMES-TEST-2 TO COMPUTED-A. NC2524.2 +082600 MOVE "X " TO CORRECT-A. NC2524.2 +082700 PERFORM FAIL. NC2524.2 +082800 GO TO RENAM-WRITE-7. NC2524.2 +082900 RENAM-DELETE-7. NC2524.2 +083000 PERFORM DE-LETE. NC2524.2 +083100 RENAM-WRITE-7. NC2524.2 +083200 MOVE "RENAM-TEST-7" TO PAR-NAME. NC2524.2 +083300 PERFORM PRINT-DETAIL. NC2524.2 +083400 RENAM-INIT-C. NC2524.2 +083500 MOVE "QUALIFIED RENAMES" TO FEATURE. NC2524.2 +083600 RENAM-TEST-8. NC2524.2 +083700 MOVE "IOWA" TO TAG-1A. NC2524.2 +083800 MOVE "OREGON" TO TAG-1B. NC2524.2 +083900 MOVE "CALIFORNIA" TO RENAME-5 OF T-RENAMES-DATA. NC2524.2 +084000 IF TAG-1 EQUAL TO "CALIFORNIA" NC2524.2 +084100 PERFORM PASS GO TO RENAM-WRITE-8. NC2524.2 +084200 GO TO RENAM-FAIL-8. NC2524.2 +084300 RENAM-DELETE-8. NC2524.2 +084400 PERFORM DE-LETE. NC2524.2 +084500 GO TO RENAM-WRITE-8. NC2524.2 +084600 RENAM-FAIL-8. NC2524.2 +084700 PERFORM FAIL. NC2524.2 +084800 MOVE TAG-1 TO COMPUTED-A. NC2524.2 +084900 MOVE "CALIFORNIA" TO CORRECT-A. NC2524.2 +085000 RENAM-WRITE-8. NC2524.2 +085100 MOVE "RENAM-TEST-8 " TO PAR-NAME. NC2524.2 +085200 PERFORM PRINT-DETAIL. NC2524.2 +085300 RENAM-TEST-9. NC2524.2 +085400 IF UNIT-1 EQUAL TO "VERMONTOHIO" NC2524.2 +085500 PERFORM PASS GO TO RENAM-WRITE-9. NC2524.2 +085600* NOTE THIS TEST FURTHER CHECKS THE RESULTS OF NC2524.2 +085700* THE PREVIOUS TEST - THIS ITEM SHOULD BE UNCHANGED. NC2524.2 +085800 GO TO RENAM-FAIL-9. NC2524.2 +085900 RENAM-DELETE-9. NC2524.2 +086000 PERFORM DE-LETE. NC2524.2 +086100 GO TO RENAM-WRITE-9. NC2524.2 +086200 RENAM-FAIL-9. NC2524.2 +086300 PERFORM FAIL. NC2524.2 +086400 MOVE UNIT-1 TO COMPUTED-A. NC2524.2 +086500 MOVE "VERMONTOHIO" TO CORRECT-A. NC2524.2 +086600 RENAM-WRITE-9. NC2524.2 +086700 MOVE "RENAM-TEST-9 " TO PAR-NAME. NC2524.2 +086800 PERFORM PRINT-DETAIL. NC2524.2 +086900 RENAM-TEST-10. NC2524.2 +087000 MOVE "IOWAOREGONFLORIDA" TO T-RENAMES-DATA. NC2524.2 +087100 IF RENAME-6 IN T-RENAMES-DATA EQUAL TO NC2524.2 +087200 "IOWAOREGONFLORIDA" NC2524.2 +087300 PERFORM PASS GO TO RENAM-WRITE-10. NC2524.2 +087400 GO TO RENAM-FAIL-10. NC2524.2 +087500 RENAM-DELETE-10. NC2524.2 +087600 PERFORM DE-LETE. NC2524.2 +087700 GO TO RENAM-WRITE-10. NC2524.2 +087800 RENAM-FAIL-10. NC2524.2 +087900 PERFORM FAIL. NC2524.2 +088000 MOVE RENAME-6 IN T-RENAMES-DATA TO COMPUTED-A. NC2524.2 +088100 MOVE "IOWAOREGONFLORIDA" TO CORRECT-A. NC2524.2 +088200 RENAM-WRITE-10. NC2524.2 +088300 MOVE "RENAM-TEST-10" TO PAR-NAME. NC2524.2 +088400 PERFORM PRINT-DETAIL. NC2524.2 +088500 RENAM-TEST-11. NC2524.2 +088600 MOVE "BOSTO" TO ITEM-1. NC2524.2 +088700 MOVE "N M" TO TABLE-ITEM-2 (1). NC2524.2 +088800 MOVE "ASS" TO TABLE-ITEM-2 (2). NC2524.2 +088900 MOVE "ACH" TO TABLE-ITEM-2 (3). NC2524.2 +089000 MOVE "USE" TO TABLE-ITEM-2 (4). NC2524.2 +089100 MOVE "TTS" TO TABLE-ITEM-2 (5). NC2524.2 +089200 IF RENAME-7 EQUAL TO "BOSTON MASSACHUSETTS" NC2524.2 +089300 PERFORM PASS GO TO RENAM-WRITE-11. NC2524.2 +089400 GO TO RENAM-FAIL-11. NC2524.2 +089500 RENAM-DELETE-11. NC2524.2 +089600 PERFORM DE-LETE. NC2524.2 +089700 GO TO RENAM-WRITE-11. NC2524.2 +089800 RENAM-FAIL-11. NC2524.2 +089900 PERFORM FAIL. NC2524.2 +090000 MOVE RENAME-7 TO COMPUTED-A. NC2524.2 +090100 MOVE "BOSTON MASSACHUSETTS" TO CORRECT-A. NC2524.2 +090200 RENAM-WRITE-11. NC2524.2 +090300 MOVE "RENAMES A TABLE" TO FEATURE. NC2524.2 +090400 MOVE "RENAM-TEST-11" TO PAR-NAME. NC2524.2 +090500 PERFORM PRINT-DETAIL. NC2524.2 +090600 RENAM-INIT-D. NC2524.2 +090700 MOVE "RENAMED DATA ---" TO FEATURE. NC2524.2 +090800 PERFORM PRINT-DETAIL. NC2524.2 +090900 RENAM-TEST-12. NC2524.2 +091000 MOVE SPACE TO W-RENAMES-DATA. NC2524.2 +091100 MOVE 12.3 TO WIDGET-1. NC2524.2 +091200 MOVE 45678.9 TO WIDGET-2. NC2524.2 +091300 MOVE ZERO TO WIDGET-3. NC2524.2 +091400 IF RENAME-8 EQUAL TO "123*45,678.900000" NC2524.2 +091500 PERFORM PASS GO TO RENAM-WRITE-12. NC2524.2 +091600 GO TO RENAM-FAIL-12. NC2524.2 +091700 RENAM-DELETE-12. NC2524.2 +091800 PERFORM DE-LETE. NC2524.2 +091900 GO TO RENAM-WRITE-12. NC2524.2 +092000 RENAM-FAIL-12. NC2524.2 +092100 PERFORM FAIL. NC2524.2 +092200 MOVE RENAME-8 TO COMPUTED-A. NC2524.2 +092300 MOVE "123*45,678.900000" TO CORRECT-A. NC2524.2 +092400 RENAM-WRITE-12. NC2524.2 +092500 MOVE " GROUP COMPARISON" TO FEATURE NC2524.2 +092600 MOVE "RENAM-TEST-12" TO PAR-NAME. NC2524.2 +092700 PERFORM PRINT-DETAIL. NC2524.2 +092800 RENAM-TEST-13. NC2524.2 +092900 MOVE SPACE TO W-RENAMES-DATA. NC2524.2 +093000 MOVE "123456789" TO RENAME-10. NC2524.2 +093100 IF RENAME-9 EQUAL TO " 12345678" NC2524.2 +093200 PERFORM PASS GO TO RENAM-WRITE-13. NC2524.2 +093300 GO TO RENAM-FAIL-13. NC2524.2 +093400 RENAM-DELETE-13. NC2524.2 +093500 PERFORM DE-LETE. NC2524.2 +093600 GO TO RENAM-WRITE-13. NC2524.2 +093700 RENAM-FAIL-13. NC2524.2 +093800 PERFORM FAIL. NC2524.2 +093900 MOVE RENAME-9 TO COMPUTED-A NC2524.2 +094000 MOVE " 12345678" TO CORRECT-A. NC2524.2 +094100 RENAM-WRITE-13. NC2524.2 +094200 MOVE " GRP MOVE, COMPARE" TO FEATURE. NC2524.2 +094300 MOVE "RENAM-TEST-13" TO PAR-NAME. NC2524.2 +094400 PERFORM PRINT-DETAIL. NC2524.2 +094500 RENAM-TEST-14. NC2524.2 +094600 MOVE SPACE TO W-RENAMES-DATA. NC2524.2 +094700 MOVE 123456 TO RENAME-10 NC2524.2 +094800 IF WIDGET-4 EQUAL TO 1234 NC2524.2 +094900 PERFORM PASS GO TO RENAM-WRITE-14. NC2524.2 +095000 GO TO RENAM-FAIL-14. NC2524.2 +095100 RENAM-DELETE-14. NC2524.2 +095200 PERFORM DE-LETE. NC2524.2 +095300 GO TO RENAM-WRITE-14. NC2524.2 +095400 RENAM-FAIL-14. NC2524.2 +095500 PERFORM FAIL. NC2524.2 +095600 MOVE WIDGET-4 TO COMPUTED-N. NC2524.2 +095700 MOVE 1234 TO CORRECT-N. NC2524.2 +095800 RENAM-WRITE-14. NC2524.2 +095900 MOVE " GROUP MOVE" TO FEATURE. NC2524.2 +096000 MOVE "RENAM-TEST-14" TO PAR-NAME. NC2524.2 +096100 PERFORM PRINT-DETAIL. NC2524.2 +096200 RENAM-TEST-15. NC2524.2 +096300 MOVE SPACE TO W-RENAMES-DATA. NC2524.2 +096400 MOVE 234.5 TO RENAME-11. NC2524.2 +096500 IF WIDGET-2 EQUAL TO "****234.50" NC2524.2 +096600 PERFORM PASS GO TO RENAM-WRITE-15. NC2524.2 +096700 GO TO RENAM-FAIL-15. NC2524.2 +096800 RENAM-DELETE-15. NC2524.2 +096900 PERFORM DE-LETE. NC2524.2 +097000 GO TO RENAM-WRITE-15. NC2524.2 +097100 RENAM-FAIL-15. NC2524.2 +097200 PERFORM FAIL. NC2524.2 +097300 MOVE WIDGET-2 TO COMPUTED-A. NC2524.2 +097400 MOVE "****234.50" TO CORRECT-A. NC2524.2 +097500 RENAM-WRITE-15. NC2524.2 +097600 MOVE " EDITED MOVE" TO FEATURE. NC2524.2 +097700 MOVE "RENAM-TEST-15" TO PAR-NAME. NC2524.2 +097800 PERFORM PRINT-DETAIL. NC2524.2 +097900 RENAM-INIT-E. NC2524.2 +098000 MOVE " ADD, SIZE ERROR" TO FEATURE. NC2524.2 +098100* NOTE THE NEXT TWO TESTS ARE INTERRELATED. NC2524.2 +098200 RENAM-TEST-16. NC2524.2 +098300 MOVE 8000 TO WIDGET-4. NC2524.2 +098400 ADD 3500 TO RENAME-12 ON SIZE ERROR NC2524.2 +098500 PERFORM PASS GO TO RENAM-WRITE-16. NC2524.2 +098600 GO TO RENAM-FAIL-16. NC2524.2 +098700 RENAM-DELETE-16. NC2524.2 +098800 PERFORM DE-LETE. NC2524.2 +098900 GO TO RENAM-WRITE-16. NC2524.2 +099000 RENAM-FAIL-16. NC2524.2 +099100 PERFORM FAIL. NC2524.2 +099200 MOVE "SIZE ERROR DID NOT OCCUR" TO RE-MARK. NC2524.2 +099300 RENAM-WRITE-16. NC2524.2 +099400 MOVE "RENAM-TEST-16" TO PAR-NAME. NC2524.2 +099500 PERFORM PRINT-DETAIL. NC2524.2 +099600 RENAM-TEST-17. NC2524.2 +099700 IF RENAME-12 EQUAL TO 8000 NC2524.2 +099800 PERFORM PASS GO TO RENAM-WRITE-17. NC2524.2 +099900 GO TO RENAM-FAIL-17. NC2524.2 +100000 RENAM-DELETE-17. NC2524.2 +100100 PERFORM DE-LETE. NC2524.2 +100200 GO TO RENAM-WRITE-17. NC2524.2 +100300 RENAM-FAIL-17. NC2524.2 +100400 PERFORM FAIL. NC2524.2 +100500 MOVE RENAME-12 TO COMPUTED-N. NC2524.2 +100600 MOVE 8000 TO CORRECT-N. NC2524.2 +100700 RENAM-WRITE-17. NC2524.2 +100800 MOVE "RENAM-TEST-17" TO PAR-NAME. NC2524.2 +100900 PERFORM PRINT-DETAIL. NC2524.2 +101000 RENAM-TEST-18. NC2524.2 +101100 MOVE SPACE TO U-RENAMES-DATA. NC2524.2 +101200 MOVE "CHICAGO ILLINOIS" TO RENAME-5 OF U-RENAMES-DATA. NC2524.2 +101300 IF U-RENAMES-DATA EQUAL TO "CHICAGO ILL " NC2524.2 +101400 PERFORM PASS GO TO RENAM-WRITE-18. NC2524.2 +101500 PERFORM FAIL. NC2524.2 +101600 GO TO RENAM-FAIL-18. NC2524.2 +101700 RENAM-DELETE-18. NC2524.2 +101800 PERFORM DE-LETE. NC2524.2 +101900 GO TO RENAM-WRITE-18. NC2524.2 +102000 RENAM-FAIL-18. NC2524.2 +102100 PERFORM FAIL. NC2524.2 +102200 MOVE U-RENAMES-DATA TO COMPUTED-A. NC2524.2 +102300 MOVE "CHICAGO ILL " TO CORRECT-A. NC2524.2 +102400 RENAM-WRITE-18. NC2524.2 +102500 MOVE " THROUGH" TO FEATURE. NC2524.2 +102600 MOVE "RENAM-TEST-18" TO PAR-NAME. NC2524.2 +102700 PERFORM PRINT-DETAIL. NC2524.2 +102800* NC2524.2 +102900 COMPUTING SECTION. NC2524.2 +103000 COMPUTE-INIT. NC2524.2 +103100 MOVE SPACES TO TEST-RESULTS. NC2524.2 +103200 PERFORM END-ROUTINE. NC2524.2 +103300 MOVE "THE COMPUTED RESULT FOR THE FOLLOWING TESTS" NC2524.2 +103400 TO RE-MARK. NC2524.2 +103500 PERFORM PRINT-DETAIL. NC2524.2 +103600 MOVE "IS ALLOWED TO DEVIATE FROM THE INDICATED" NC2524.2 +103700 TO RE-MARK. NC2524.2 +103800 PERFORM PRINT-DETAIL. NC2524.2 +103900 MOVE "CORRECT RESULT BY" TO RE-MARK. NC2524.2 +104000 PERFORM PRINT-DETAIL. NC2524.2 +104100 MOVE "+ OR - (CORRECT RESULT * (.2 ** 5))." NC2524.2 +104200 TO RE-MARK. NC2524.2 +104300 PERFORM PRINT-DETAIL. NC2524.2 +104400 MOVE "COMPUTE " TO FEATURE. NC2524.2 +104500 COMP-TEST-1. NC2524.2 +104600 COMPUTE COMPUTE-1 = COMPUTE-1A. NC2524.2 +104700 IF ( COMPUTE-1 < 654.20038) AND NC2524.2 +104800 ( COMPUTE-1 > 654.17422) THEN NC2524.2 +104900 PERFORM PASS NC2524.2 +105000 GO TO COMP-WRITE-1. NC2524.2 +105100 PERFORM FAIL. NC2524.2 +105200 MOVE COMPUTE-1 TO COMPUTED-N. NC2524.2 +105300 MOVE "+654.1873" TO CORRECT-A. NC2524.2 +105400 GO TO COMP-WRITE-1. NC2524.2 +105500 COMP-DELETE-1. NC2524.2 +105600 PERFORM DE-LETE. NC2524.2 +105700 COMP-WRITE-1. NC2524.2 +105800 MOVE "COMP-TEST-1" TO PAR-NAME. NC2524.2 +105900 PERFORM PRINT-DETAIL. NC2524.2 +106000 COMP-TEST-2. NC2524.2 +106100 COMPUTE COMPUTE-2 = 2233.9 NC2524.2 +106200 IF ( COMPUTE-2 < 2233.94468) AND NC2524.2 +106300 ( COMPUTE-2 > 2233.85532) THEN NC2524.2 +106400 PERFORM PASS NC2524.2 +106500 GO TO COMP-WRITE-2. NC2524.2 +106600 PERFORM FAIL. NC2524.2 +106700 MOVE COMPUTE-2 TO COMPUTED-N. NC2524.2 +106800 MOVE "+2233.9" TO CORRECT-A. NC2524.2 +106900 GO TO COMP-WRITE-2. NC2524.2 +107000 COMP-DELETE-2. NC2524.2 +107100 PERFORM DE-LETE. NC2524.2 +107200 COMP-WRITE-2. NC2524.2 +107300 MOVE "COMP-TEST-2" TO PAR-NAME. NC2524.2 +107400 PERFORM PRINT-DETAIL. NC2524.2 +107500 COMP-TEST-3. NC2524.2 +107600 COMPUTE COMPUTE-3 = COMPUTE-3A - COMPUTE-3B. NC2524.2 +107700 IF ( COMPUTE-3 NOT < 52.39105) AND NC2524.2 +107800 ( COMPUTE-3 NOT > 52.38895) THEN NC2524.2 +107900 PERFORM FAIL NC2524.2 +108000 MOVE COMPUTE-3 TO COMPUTED-N NC2524.2 +108100 MOVE "+52.39" TO CORRECT-A NC2524.2 +108200 GO TO COMP-WRITE-3. NC2524.2 +108300 PERFORM PASS. NC2524.2 +108400 GO TO COMP-WRITE-3. NC2524.2 +108500 COMP-DELETE-3. NC2524.2 +108600 PERFORM DE-LETE. NC2524.2 +108700 COMP-WRITE-3. NC2524.2 +108800 MOVE "COMP-TEST-3" TO PAR-NAME. NC2524.2 +108900 PERFORM PRINT-DETAIL. NC2524.2 +109000 COMP-TEST-4. NC2524.2 +109100 COMPUTE COMPUTE-4 = COMPUTE-4A + COMPUTE-4B. NC2524.2 +109200 IF COMPUTE-4 NOT = 341 NC2524.2 +109300 PERFORM FAIL NC2524.2 +109400 MOVE COMPUTE-4 TO COMPUTED-N NC2524.2 +109500 MOVE "+341" TO CORRECT-A NC2524.2 +109600 GO TO COMP-WRITE-4. NC2524.2 +109700 PERFORM PASS. NC2524.2 +109800 GO TO COMP-WRITE-4. NC2524.2 +109900 COMP-DELETE-4. NC2524.2 +110000 PERFORM DE-LETE. NC2524.2 +110100 COMP-WRITE-4. NC2524.2 +110200 MOVE "COMP-TEST-4" TO PAR-NAME. NC2524.2 +110300 PERFORM PRINT-DETAIL. NC2524.2 +110400 COMP-TEST-5. NC2524.2 +110500 COMPUTE COMPUTE-5 = COMPUTE-5A * 36.1 NC2524.2 +110600 IF ( COMPUTE-5 > 400.71801) OR NC2524.2 +110700 ( COMPUTE-5 < 400.70199) THEN NC2524.2 +110800 PERFORM FAIL NC2524.2 +110900 MOVE COMPUTE-5 TO COMPUTED-N NC2524.2 +111000 MOVE "+400.71" TO CORRECT-A NC2524.2 +111100 GO TO COMP-WRITE-5. NC2524.2 +111200 PERFORM PASS. NC2524.2 +111300 GO TO COMP-WRITE-5. NC2524.2 +111400 COMP-DELETE-5. NC2524.2 +111500 PERFORM DE-LETE. NC2524.2 +111600 COMP-WRITE-5. NC2524.2 +111700 MOVE "COMP-TEST-5" TO PAR-NAME. NC2524.2 +111800 PERFORM PRINT-DETAIL. NC2524.2 +111900 COMP-TEST-6. NC2524.2 +112000 COMPUTE COMPUTE-6 = COMPUTE-6A / 6.0 NC2524.2 +112100 IF ( COMPUTE-6 > 62.40125) OR NC2524.2 +112200 ( COMPUTE-6 < 62.39875) THEN NC2524.2 +112300 PERFORM FAIL NC2524.2 +112400 MOVE COMPUTE-6 TO COMPUTED-N NC2524.2 +112500 MOVE "+062.40" TO CORRECT-A NC2524.2 +112600 GO TO COMP-WRITE-6. NC2524.2 +112700 PERFORM PASS. NC2524.2 +112800 GO TO COMP-WRITE-6. NC2524.2 +112900 COMP-DELETE-6. NC2524.2 +113000 PERFORM DE-LETE. NC2524.2 +113100 COMP-WRITE-6. NC2524.2 +113200 MOVE "COMP-TEST-6" TO PAR-NAME. NC2524.2 +113300 PERFORM PRINT-DETAIL. NC2524.2 +113400 COMP-TEST-7. NC2524.2 +113500 COMPUTE COMPUTE-7 = 2.0 ** 4. NC2524.2 +113600 IF COMPUTE-7 = 16 NC2524.2 +113700 PERFORM PASS NC2524.2 +113800 GO TO COMP-WRITE-7. NC2524.2 +113900 PERFORM FAIL. NC2524.2 +114000 MOVE COMPUTE-7 TO COMPUTED-N. NC2524.2 +114100 MOVE "+16" TO CORRECT-A. NC2524.2 +114200 GO TO COMP-WRITE-7. NC2524.2 +114300 COMP-DELETE-7. NC2524.2 +114400 PERFORM DE-LETE. NC2524.2 +114500 COMP-WRITE-7. NC2524.2 +114600 MOVE "COMP-TEST-7" TO PAR-NAME. NC2524.2 +114700 PERFORM PRINT-DETAIL. NC2524.2 +114800 COMP-TEST-8. NC2524.2 +114900 COMPUTE COMPUTE-8 = (((24.0 + 1) * (60 - 10)) / 125) ** 2. NC2524.2 +115000 IF COMPUTE-8 = 100 NC2524.2 +115100 PERFORM PASS NC2524.2 +115200 GO TO COMP-WRITE-8. NC2524.2 +115300 PERFORM FAIL. NC2524.2 +115400 MOVE COMPUTE-8 TO COMPUTED-N. NC2524.2 +115500 MOVE "+100" TO CORRECT-A. NC2524.2 +115600 GO TO COMP-WRITE-8. NC2524.2 +115700 COMP-DELETE-8. NC2524.2 +115800 PERFORM DE-LETE. NC2524.2 +115900 COMP-WRITE-8. NC2524.2 +116000 MOVE "COMP-TEST-8" TO PAR-NAME. NC2524.2 +116100 PERFORM PRINT-DETAIL. NC2524.2 +116200 COMP-TEST-9. NC2524.2 +116300 COMPUTE COMPUTE-9 ROUNDED = COMPUTE-6A * 7.0 NC2524.2 +116400 IF (COMPUTE-9 > 2621.05242) OR NC2524.2 +116500 (COMPUTE-9 < 2620.94758) THEN NC2524.2 +116600 PERFORM FAIL NC2524.2 +116700 MOVE COMPUTE-9 TO COMPUTED-N NC2524.2 +116800 MOVE "+2621" TO CORRECT-A NC2524.2 +116900 GO TO COMP-WRITE-9. NC2524.2 +117000 PERFORM PASS. NC2524.2 +117100 GO TO COMP-WRITE-9. NC2524.2 +117200 COMP-DELETE-9. NC2524.2 +117300 PERFORM DE-LETE. NC2524.2 +117400 COMP-WRITE-9. NC2524.2 +117500 MOVE "COMP-TEST-9" TO PAR-NAME. NC2524.2 +117600 PERFORM PRINT-DETAIL. NC2524.2 +117700 COMP-TEST-10. NC2524.2 +117800 COMPUTE COMPUTE-10 = COMPUTE-1A + COMPUTE-6A ON SIZE ERROR NC2524.2 +117900 MOVE "R" TO XRAY. NC2524.2 +118000 IF XRAY EQUAL TO "R" NC2524.2 +118100 PERFORM PASS NC2524.2 +118200 GO TO COMP-WRITE-10. NC2524.2 +118300 PERFORM FAIL. NC2524.2 +118400 MOVE "OSE NOT EXECUTED" TO RE-MARK. NC2524.2 +118500 GO TO COMP-WRITE-10. NC2524.2 +118600 COMP-DELETE-10. NC2524.2 +118700 PERFORM DE-LETE. NC2524.2 +118800 COMP-WRITE-10. NC2524.2 +118900 MOVE "COMP-TEST-10" TO PAR-NAME. NC2524.2 +119000 PERFORM PRINT-DETAIL. NC2524.2 +119100 COMP-TEST-11. NC2524.2 +119200 IF (COMPUTE-10 > 0.00002) OR NC2524.2 +119300 (COMPUTE-10 < -0.00002) NC2524.2 +119400 PERFORM FAIL NC2524.2 +119500 MOVE COMPUTE-10 TO COMPUTED-N NC2524.2 +119600 MOVE ZERO TO CORRECT-N NC2524.2 +119700 GO TO COMP-WRITE-11. NC2524.2 +119800 PERFORM PASS. NC2524.2 +119900 GO TO COMP-WRITE-11. NC2524.2 +120000 COMP-DELETE-11. NC2524.2 +120100 PERFORM DE-LETE. NC2524.2 +120200 COMP-WRITE-11. NC2524.2 +120300 MOVE "COMP-TEST-11" TO PAR-NAME. NC2524.2 +120400 PERFORM PRINT-DETAIL. NC2524.2 +120500 COMP-TEST-12. NC2524.2 +120600 COMPUTE COMPUTE-11 = COMPUTE-11A + COMPUTE-11B - 121.6 NC2524.2 +120700 IF ( COMPUTE-11 < 718.51437) AND NC2524.2 +120800 ( COMPUTE-11 > 718.48563) THEN NC2524.2 +120900 PERFORM PASS NC2524.2 +121000 GO TO COMP-WRITE-12. NC2524.2 +121100 PERFORM FAIL. NC2524.2 +121200 MOVE COMPUTE-11 TO COMPUTED-N. NC2524.2 +121300 MOVE "+718.5" TO CORRECT-A. NC2524.2 +121400 GO TO COMP-WRITE-12. NC2524.2 +121500 COMP-DELETE-12. NC2524.2 +121600 PERFORM DE-LETE. NC2524.2 +121700 COMP-WRITE-12. NC2524.2 +121800 MOVE "COMP-TEST-12" TO PAR-NAME. NC2524.2 +121900 PERFORM PRINT-DETAIL. NC2524.2 +122000 COMP-TEST-13. NC2524.2 +122100 COMPUTE COMPUTE-12 = COMPUTE-12A * 5.1 / 281.7. NC2524.2 +122200 IF (COMPUTE-12 < 6.09012) AND NC2524.2 +122300 (COMPUTE-12 > 6.08988) THEN NC2524.2 +122400 PERFORM PASS NC2524.2 +122500 GO TO COMP-WRITE-13. NC2524.2 +122600 PERFORM FAIL. NC2524.2 +122700 MOVE COMPUTE-12 TO COMPUTED-N. NC2524.2 +122800 MOVE "+6.09" TO CORRECT-A. NC2524.2 +122900 GO TO COMP-WRITE-13. NC2524.2 +123000 COMP-DELETE-13. NC2524.2 +123100 PERFORM DE-LETE. NC2524.2 +123200 COMP-WRITE-13. NC2524.2 +123300 MOVE "COMP-TEST-13" TO PAR-NAME. NC2524.2 +123400 PERFORM PRINT-DETAIL. NC2524.2 +123500 COMPUTE-ROUTINE SECTION. NC2524.2 +123600 COMPUTE-TEST. NC2524.2 +123700 MOVE "COMPUTE" TO FEATURE. NC2524.2 +123800 MOVE ZERO TO W-1. NC2524.2 +123900 MOVE ZERO TO W-2. NC2524.2 +124000 COMP-TEST-14. NC2524.2 +124100 COMPUTE W-1 = NINE. NC2524.2 +124200 IF W-1 = 9 NC2524.2 +124300 PERFORM PASS NC2524.2 +124400 GO TO COMP-WRITE-14. NC2524.2 +124500 PERFORM FAIL. NC2524.2 +124600 MOVE W-1 TO COMPUTED-A. NC2524.2 +124700 MOVE 9 TO W-1. NC2524.2 +124800 MOVE 9 TO CORRECT-A. NC2524.2 +124900 GO TO COMP-WRITE-14. NC2524.2 +125000 COMP-DELETE-14. NC2524.2 +125100 PERFORM DE-LETE. NC2524.2 +125200 COMP-WRITE-14. NC2524.2 +125300 MOVE "COMP-TEST-14" TO PAR-NAME. NC2524.2 +125400 PERFORM PRINT-DETAIL. NC2524.2 +125500 COMP-TEST-15. NC2524.2 +125600 COMPUTE W-2 = W-1 + 20. NC2524.2 +125700 IF W-2 = 29 NC2524.2 +125800 PERFORM PASS NC2524.2 +125900 GO TO COMP-WRITE-15. NC2524.2 +126000 PERFORM FAIL. NC2524.2 +126100 MOVE W-2 TO COMPUTED-N. NC2524.2 +126200 MOVE "+29" TO CORRECT-A. NC2524.2 +126300 MOVE 29 TO W-2. NC2524.2 +126400 GO TO COMP-WRITE-15. NC2524.2 +126500 COMP-DELETE-15. NC2524.2 +126600 PERFORM DE-LETE. NC2524.2 +126700 COMP-WRITE-15. NC2524.2 +126800 MOVE "COMP-TEST-15" TO PAR-NAME. NC2524.2 +126900 PERFORM PRINT-DETAIL. NC2524.2 +127000 COMP-TEST-16. NC2524.2 +127100 MOVE ZERO TO W-11. NC2524.2 +127200 COMPUTE W-11 = W-1 - W-2. NC2524.2 +127300 IF ( W-11 > -20.00040) AND NC2524.2 +127400 ( W-11 < -19.99960) THEN NC2524.2 +127500 PERFORM PASS NC2524.2 +127600 GO TO COMP-WRITE-16. NC2524.2 +127700 PERFORM FAIL. NC2524.2 +127800 MOVE W-11 TO COMPUTED-N. NC2524.2 +127900 MOVE "-20" TO CORRECT-A. NC2524.2 +128000 GO TO COMP-WRITE-16. NC2524.2 +128100 COMP-DELETE-16. NC2524.2 +128200 PERFORM DE-LETE. NC2524.2 +128300 COMP-WRITE-16. NC2524.2 +128400 MOVE "COMP-TEST-16" TO PAR-NAME. NC2524.2 +128500 PERFORM PRINT-DETAIL. NC2524.2 +128600 COMP-TEST-17. NC2524.2 +128700 MOVE ZERO TO W-3. NC2524.2 +128800 COMPUTE W-3 = TEN * 30. NC2524.2 +128900 IF W-3 = 300 NC2524.2 +129000 PERFORM PASS NC2524.2 +129100 GO TO COMP-WRITE-17. NC2524.2 +129200 PERFORM FAIL. NC2524.2 +129300 MOVE W-3 TO COMPUTED-N. NC2524.2 +129400 MOVE "+300" TO CORRECT-A. NC2524.2 +129500 GO TO COMP-WRITE-17. NC2524.2 +129600 COMP-DELETE-17. NC2524.2 +129700 PERFORM DE-LETE. NC2524.2 +129800 COMP-WRITE-17. NC2524.2 +129900 MOVE "COMP-TEST-17" TO PAR-NAME. NC2524.2 +130000 PERFORM PRINT-DETAIL. NC2524.2 +130100 COMP-TEST-18. NC2524.2 +130200 MOVE ZERO TO W-5. NC2524.2 +130300 COMPUTE W-5 = 42 / SEVEN. NC2524.2 +130400 IF W-5 = 6 NC2524.2 +130500 PERFORM PASS NC2524.2 +130600 GO TO COMP-WRITE-18. NC2524.2 +130700 PERFORM FAIL. NC2524.2 +130800 MOVE W-5 TO COMPUTED-N. NC2524.2 +130900 MOVE "+6" TO CORRECT-A. NC2524.2 +131000 GO TO COMP-WRITE-18. NC2524.2 +131100 COMP-DELETE-18. NC2524.2 +131200 PERFORM DE-LETE. NC2524.2 +131300 COMP-WRITE-18. NC2524.2 +131400 MOVE "COMP-TEST-18" TO PAR-NAME. NC2524.2 +131500 PERFORM PRINT-DETAIL. NC2524.2 +131600 COMP-TEST-19. NC2524.2 +131700 MOVE ZERO TO W-2. NC2524.2 +131800 COMPUTE W-2 = FOUR ** 3. NC2524.2 +131900 IF W-2 = 64 NC2524.2 +132000 PERFORM PASS NC2524.2 +132100 GO TO COMP-WRITE-19. NC2524.2 +132200 PERFORM FAIL. NC2524.2 +132300 MOVE W-2 TO COMPUTED-N. NC2524.2 +132400 MOVE "+64" TO CORRECT-A. NC2524.2 +132500 GO TO COMP-WRITE-19. NC2524.2 +132600 COMP-DELETE-19. NC2524.2 +132700 PERFORM DE-LETE. NC2524.2 +132800 COMP-WRITE-19. NC2524.2 +132900 MOVE "COMP-TEST-19" TO PAR-NAME. NC2524.2 +133000 PERFORM PRINT-DETAIL. NC2524.2 +133100 COMP-TEST-20. NC2524.2 +133200 MOVE 555 TO W-3. NC2524.2 +133300 COMPUTE W-3 = TWENTY-5 + 101 + 222. NC2524.2 +133400 IF W-3 = 348 NC2524.2 +133500 PERFORM PASS NC2524.2 +133600 GO TO COMP-WRITE-20. NC2524.2 +133700 PERFORM FAIL. NC2524.2 +133800 MOVE W-3 TO COMPUTED-N. NC2524.2 +133900 MOVE "+348" TO CORRECT-A. NC2524.2 +134000 GO TO COMP-WRITE-20. NC2524.2 +134100 COMP-DELETE-20. NC2524.2 +134200 PERFORM DE-LETE. NC2524.2 +134300 COMP-WRITE-20. NC2524.2 +134400 MOVE "COMP-TEST-20" TO PAR-NAME. NC2524.2 +134500 PERFORM PRINT-DETAIL. NC2524.2 +134600 COMP-TEST-21. NC2524.2 +134700 MOVE ZERO TO W-9. NC2524.2 +134800 COMPUTE W-9 = TWO * (3 + 4). NC2524.2 +134900 IF W-9 = 14 NC2524.2 +135000 PERFORM PASS NC2524.2 +135100 GO TO COMP-WRITE-21. NC2524.2 +135200 PERFORM FAIL. NC2524.2 +135300 MOVE W-9 TO COMPUTED-N. NC2524.2 +135400 MOVE "+14" TO CORRECT-A. NC2524.2 +135500 GO TO COMP-WRITE-21. NC2524.2 +135600 COMP-DELETE-21. NC2524.2 +135700 PERFORM DE-LETE. NC2524.2 +135800 COMP-WRITE-21. NC2524.2 +135900 MOVE "COMP-TEST-21" TO PAR-NAME. NC2524.2 +136000 PERFORM PRINT-DETAIL. NC2524.2 +136100 COMP-TEST-22. NC2524.2 +136200 MOVE ZERO TO W-9. NC2524.2 +136300 COMPUTE W-9 = (TWO + (3 * FOUR) / (2 * THREE)) ** 2 - 1. NC2524.2 +136400 IF W-9 = 15 PERFORM PASS NC2524.2 +136500 GO TO COMP-WRITE-22. NC2524.2 +136600 PERFORM FAIL. NC2524.2 +136700 MOVE W-9 TO COMPUTED-N. NC2524.2 +136800 MOVE "+15" TO CORRECT-A. NC2524.2 +136900 GO TO COMP-WRITE-22. NC2524.2 +137000 COMP-DELETE-22. NC2524.2 +137100 PERFORM DE-LETE. NC2524.2 +137200 COMP-WRITE-22. NC2524.2 +137300 MOVE "COMP-TEST-22" TO PAR-NAME. NC2524.2 +137400 PERFORM PRINT-DETAIL. NC2524.2 +137500 COMP-TEST-23. NC2524.2 +137600 MOVE ZERO TO XRAY. NC2524.2 +137700 MOVE 10 TO W-2. NC2524.2 +137800 COMPUTE W-2 = 96 + TWENTY ON SIZE ERROR NC2524.2 +137900 MOVE 8 TO XRAY. NC2524.2 +138000 IF XRAY IS EQUAL TO "8" NC2524.2 +138100 PERFORM PASS NC2524.2 +138200 GO TO COMP-WRITE-23. NC2524.2 +138300 PERFORM FAIL. NC2524.2 +138400 MOVE "8" TO CORRECT-A. NC2524.2 +138500 MOVE XRAY TO COMPUTED-A. NC2524.2 +138600 MOVE "OSE NOT EXECUTED" TO RE-MARK. NC2524.2 +138700 GO TO COMP-WRITE-23. NC2524.2 +138800 COMP-DELETE-23. NC2524.2 +138900 PERFORM DE-LETE. NC2524.2 +139000 COMP-WRITE-23. NC2524.2 +139100 MOVE "COMP-TEST-23" TO PAR-NAME. NC2524.2 +139200 PERFORM PRINT-DETAIL. NC2524.2 +139300 COMP-TEST-24. NC2524.2 +139400 IF W-2 = 10 NC2524.2 +139500 PERFORM PASS NC2524.2 +139600 GO TO COMP-WRITE-24. NC2524.2 +139700 PERFORM FAIL. NC2524.2 +139800 MOVE W-2 TO COMPUTED-A. NC2524.2 +139900 MOVE "10" TO CORRECT-A. NC2524.2 +140000 MOVE "NOT PROTECTED BY OES" TO RE-MARK. NC2524.2 +140100 GO TO COMP-WRITE-24. NC2524.2 +140200 COMP-DELETE-24. NC2524.2 +140300 PERFORM DE-LETE. NC2524.2 +140400 COMP-WRITE-24. NC2524.2 +140500 MOVE "COMP-TEST-24" TO PAR-NAME. NC2524.2 +140600 PERFORM PRINT-DETAIL. NC2524.2 +140700 COMP-TEST-25. NC2524.2 +140800 MOVE ZERO TO W-11. NC2524.2 +140900 COMPUTE W-11 ROUNDED = D-1 + D-7. NC2524.2 +141000 IF ( W-11 < 2.20004) AND NC2524.2 +141100 ( W-11 > 2.19996) THEN NC2524.2 +141200 PERFORM PASS NC2524.2 +141300 GO TO COMP-WRITE-25. NC2524.2 +141400 PERFORM FAIL. NC2524.2 +141500 MOVE W-11 TO COMPUTED-N. NC2524.2 +141600 MOVE "+2.2" TO CORRECT-A. NC2524.2 +141700 GO TO COMP-WRITE-25. NC2524.2 +141800 COMP-DELETE-25. NC2524.2 +141900 PERFORM DE-LETE. NC2524.2 +142000 COMP-WRITE-25. NC2524.2 +142100 MOVE "COMP-TEST-25" TO PAR-NAME. NC2524.2 +142200 PERFORM PRINT-DETAIL. NC2524.2 +142300 COMP-TEST-26. NC2524.2 +142400 MOVE ZERO TO W-11. NC2524.2 +142500 COMPUTE W-11 ROUNDED = 25 / 10. NC2524.2 +142600 IF ( W-11 < 2.50005) AND NC2524.2 +142700 ( W-11 > 2.49995) THEN NC2524.2 +142800 PERFORM PASS NC2524.2 +142900 GO TO COMP-WRITE-26. NC2524.2 +143000 PERFORM FAIL. NC2524.2 +143100 MOVE W-11 TO COMPUTED-N. NC2524.2 +143200 MOVE "+2.5" TO CORRECT-A. NC2524.2 +143300 GO TO COMP-WRITE-26. NC2524.2 +143400 COMP-DELETE-26. NC2524.2 +143500 PERFORM DE-LETE. NC2524.2 +143600 COMP-WRITE-26. NC2524.2 +143700 MOVE "COMP-TEST-26" TO PAR-NAME. NC2524.2 +143800 PERFORM PRINT-DETAIL. NC2524.2 +143900 CTST-END. NC2524.2 +144000 EXIT. NC2524.2 +144100 COMP-INIT-A. NC2524.2 +144200 MOVE "COMPUTE" TO FEATURE. NC2524.2 +144300 COMP-TEST-27. NC2524.2 +144400 MOVE ZERO TO WRK-DS-02V00. NC2524.2 +144500 COMPUTE WRK-DS-02V00 = -9. NC2524.2 +144600 IF WRK-DS-02V00 = -9 NC2524.2 +144700 PERFORM PASS NC2524.2 +144800 GO TO COMP-WRITE-27. NC2524.2 +144900 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2524.2 +145000 MOVE -9 TO CORRECT-N. NC2524.2 +145100 PERFORM FAIL. NC2524.2 +145200 GO TO COMP-WRITE-27. NC2524.2 +145300 COMP-DELETE-27. NC2524.2 +145400 PERFORM DE-LETE. NC2524.2 +145500 COMP-WRITE-27. NC2524.2 +145600 MOVE "COMP-TEST-27" TO PAR-NAME. NC2524.2 +145700 PERFORM PRINT-DETAIL. NC2524.2 +145800 COMP-TEST-28. NC2524.2 +145900 MOVE ZERO TO WRK-DS-02V00. NC2524.2 +146000 COMPUTE WRK-DS-02V00 = A99-DS-02V00. NC2524.2 +146100 IF WRK-DS-02V00 = 99 NC2524.2 +146200 PERFORM PASS NC2524.2 +146300 GO TO COMP-WRITE-28. NC2524.2 +146400 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2524.2 +146500 MOVE 99 TO CORRECT-N. NC2524.2 +146600 PERFORM FAIL. NC2524.2 +146700 GO TO COMP-WRITE-28. NC2524.2 +146800 COMP-DELETE-28. NC2524.2 +146900 PERFORM DE-LETE. NC2524.2 +147000 COMP-WRITE-28. NC2524.2 +147100 MOVE "COMP-TEST-28" TO PAR-NAME. NC2524.2 +147200 PERFORM PRINT-DETAIL. NC2524.2 +147300 COMP-TEST-29. NC2524.2 +147400 MOVE ZERO TO WRK-DS-18V00. NC2524.2 +147500 COMPUTE WRK-DS-18V00 = A18ONES-DS-18V00 + A18ONES-DS-18V00. NC2524.2 +147600 IF WRK-DS-18V00 = 222222222222222222 NC2524.2 +147700 PERFORM PASS NC2524.2 +147800 GO TO COMP-WRITE-29. NC2524.2 +147900 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC2524.2 +148000 MOVE 222222222222222222 TO CORRECT-18V0. NC2524.2 +148100 PERFORM FAIL. NC2524.2 +148200 GO TO COMP-WRITE-29. NC2524.2 +148300 COMP-DELETE-29. NC2524.2 +148400 PERFORM DE-LETE. NC2524.2 +148500 COMP-WRITE-29. NC2524.2 +148600 MOVE "COMP-TEST-29" TO PAR-NAME. NC2524.2 +148700 PERFORM PRINT-DETAIL. NC2524.2 +148800 COMP-TEST-30. NC2524.2 +148900 MOVE ZERO TO WRK-DS-18V00. NC2524.2 +149000 COMPUTE WRK-DS-18V00 = A18TWOS-DS-18V00 - A18ONES-DS-18V00. NC2524.2 +149100 IF WRK-DS-18V00 = 111111111111111111 NC2524.2 +149200 PERFORM PASS NC2524.2 +149300 GO TO COMP-WRITE-30. NC2524.2 +149400 MOVE WRK-DS-18V00 TO COMPUTED-18V0. NC2524.2 +149500 MOVE 111111111111111111 TO CORRECT-18V0. NC2524.2 +149600 PERFORM FAIL. NC2524.2 +149700 GO TO COMP-WRITE-30. NC2524.2 +149800 COMP-DELETE-30. NC2524.2 +149900 PERFORM DE-LETE. NC2524.2 +150000 COMP-WRITE-30. NC2524.2 +150100 MOVE "COMP-TEST-30" TO PAR-NAME. NC2524.2 +150200 PERFORM PRINT-DETAIL. NC2524.2 +150300 COMP-TEST-31. NC2524.2 +150400 MOVE ZERO TO TA--X. NC2524.2 +150500 COMPUTE TA--X = 3 * A02TWOS-DU-02V00. NC2524.2 +150600 IF TA--X = 66 NC2524.2 +150700 PERFORM PASS NC2524.2 +150800 GO TO COMP-WRITE-31. NC2524.2 +150900 MOVE TA--X TO COMPUTED-N NC2524.2 +151000 MOVE 66 TO CORRECT-N. NC2524.2 +151100 PERFORM FAIL. NC2524.2 +151200 GO TO COMP-WRITE-31. NC2524.2 +151300 COMP-DELETE-31. NC2524.2 +151400 PERFORM DE-LETE. NC2524.2 +151500 COMP-WRITE-31. NC2524.2 +151600 MOVE "COMP-TEST-31" TO PAR-NAME. NC2524.2 +151700 PERFORM PRINT-DETAIL. NC2524.2 +151800 COMP-TEST-32. NC2524.2 +151900 MOVE ZERO TO WRK-DS-05V00. NC2524.2 +152000 COMPUTE WRK-DS-05V00 = A02TWOS-DU-02V00 / A02TWOS-DS-03V02. NC2524.2 +152100 IF WRK-DS-05V00 = 1 NC2524.2 +152200 PERFORM PASS NC2524.2 +152300 GO TO COMP-WRITE-32. NC2524.2 +152400 MOVE WRK-DS-05V00 TO COMPUTED-N. NC2524.2 +152500 MOVE 1 TO CORRECT-N. NC2524.2 +152600 PERFORM FAIL. NC2524.2 +152700 GO TO COMP-WRITE-32. NC2524.2 +152800 COMP-DELETE-32. NC2524.2 +152900 PERFORM DE-LETE. NC2524.2 +153000 COMP-WRITE-32. NC2524.2 +153100 MOVE "COMP-TEST-32" TO PAR-NAME. NC2524.2 +153200 PERFORM PRINT-DETAIL. NC2524.2 +153300 COMP-TEST-33. NC2524.2 +153400 MOVE ZERO TO WRK-DS-05V00. NC2524.2 +153500 COMPUTE WRK-DS-05V00 = 3 ** ATWO-DS-01V00. NC2524.2 +153600 IF WRK-DS-05V00 = 9 NC2524.2 +153700 PERFORM PASS NC2524.2 +153800 GO TO COMP-WRITE-33. NC2524.2 +153900 MOVE WRK-DS-05V00 TO COMPUTED-N. NC2524.2 +154000 MOVE 9 TO CORRECT-N. NC2524.2 +154100 PERFORM FAIL. NC2524.2 +154200 GO TO COMP-WRITE-33. NC2524.2 +154300 COMP-DELETE-33. NC2524.2 +154400 PERFORM DE-LETE. NC2524.2 +154500 COMP-WRITE-33. NC2524.2 +154600 MOVE "COMP-TEST-33" TO PAR-NAME. NC2524.2 +154700 PERFORM PRINT-DETAIL. NC2524.2 +154800 COMP-TEST-34. NC2524.2 +154900 MOVE ZERO TO WRK-DS-02V00. NC2524.2 +155000 COMPUTE WRK-DS-02V00 ROUNDED = A99-DS-02V00 NC2524.2 +155100 + AZERO-DS-05V05 - 2.5. NC2524.2 +155200 IF WRK-DS-02V00 = 97 NC2524.2 +155300 PERFORM PASS NC2524.2 +155400 GO TO COMP-WRITE-34. NC2524.2 +155500 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2524.2 +155600 MOVE 97 TO CORRECT-N. NC2524.2 +155700 PERFORM FAIL. NC2524.2 +155800 GO TO COMP-WRITE-34. NC2524.2 +155900 COMP-DELETE-34. NC2524.2 +156000 PERFORM DE-LETE. NC2524.2 +156100 COMP-WRITE-34. NC2524.2 +156200 MOVE "COMP-TEST-34" TO PAR-NAME. NC2524.2 +156300 PERFORM PRINT-DETAIL. NC2524.2 +156400 COMP-TEST-35. NC2524.2 +156500 MOVE ZERO TO WRK-DS-02V00. NC2524.2 +156600 COMPUTE WRK-DS-02V00 = A99-DS-02V00 + AZERO-DS-05V05 NC2524.2 +156700 ON SIZE ERROR NC2524.2 +156800 MOVE "SIZE ERR SHOULD NOT EXCUTE" TO RE-MARK NC2524.2 +156900 PERFORM FAIL NC2524.2 +157000 GO TO COMP-WRITE-35. NC2524.2 +157100 PERFORM PASS. NC2524.2 +157200 GO TO COMP-WRITE-35. NC2524.2 +157300 COMP-DELETE-35. NC2524.2 +157400 PERFORM DE-LETE. NC2524.2 +157500 COMP-WRITE-35. NC2524.2 +157600 MOVE "COMP-TEST-35" TO PAR-NAME. NC2524.2 +157700 PERFORM PRINT-DETAIL. NC2524.2 +157800 COMP-TEST-36. NC2524.2 +157900 IF TEST-2NUC-COND-99 NC2524.2 +158000 PERFORM PASS NC2524.2 +158100 GO TO COMP-WRITE-36. NC2524.2 +158200* NOTE THIS TEST DEPENDS UPON THE RESULT OF COMP-TEST-35. NC2524.2 +158300 MOVE WRK-DS-02V00 TO COMPUTED-N. NC2524.2 +158400 MOVE 99 TO CORRECT-N. NC2524.2 +158500 PERFORM FAIL. NC2524.2 +158600 GO TO COMP-WRITE-36. NC2524.2 +158700 COMP-DELETE-36. NC2524.2 +158800 PERFORM DE-LETE. NC2524.2 +158900 COMP-WRITE-36. NC2524.2 +159000 MOVE "COMP-TEST-36" TO PAR-NAME. NC2524.2 +159100 PERFORM PRINT-DETAIL. NC2524.2 +159200 COMP-TEST-37. NC2524.2 +159300 MOVE ZERO TO WRK-DS-0201P. NC2524.2 +159400 COMPUTE WRK-DS-0201P ROUNDED = A05ONES-DS-05V00 / 5 NC2524.2 +159500 ON SIZE ERROR NC2524.2 +159600 PERFORM PASS NC2524.2 +159700 GO TO COMP-WRITE-37. NC2524.2 +159800 MOVE "ON SIZE ERROR NOT EXECUTED" TO RE-MARK. NC2524.2 +159900 PERFORM FAIL. NC2524.2 +160000 GO TO COMP-WRITE-37. NC2524.2 +160100 COMP-DELETE-37. NC2524.2 +160200 PERFORM DE-LETE. NC2524.2 +160300 COMP-WRITE-37. NC2524.2 +160400 MOVE "COMP-TEST-37" TO PAR-NAME. NC2524.2 +160500 PERFORM PRINT-DETAIL. NC2524.2 +160600 COMP-TEST-38. NC2524.2 +160700 IF WRK-DS-0201P = ZERO NC2524.2 +160800 PERFORM PASS NC2524.2 +160900 GO TO COMP-WRITE-38. NC2524.2 +161000* NOTE THIS TEST DEPENDS UPON THE RESULT OF COMP-TEST-37. NC2524.2 +161100 MOVE WRK-DS-0201P TO COMPUTED-N. NC2524.2 +161200 MOVE ZERO TO CORRECT-N. NC2524.2 +161300 PERFORM FAIL. NC2524.2 +161400 GO TO COMP-WRITE-38. NC2524.2 +161500 COMP-DELETE-38. NC2524.2 +161600 PERFORM DE-LETE. NC2524.2 +161700 COMP-WRITE-38. NC2524.2 +161800 MOVE "COMP-TEST-38" TO PAR-NAME. NC2524.2 +161900 PERFORM PRINT-DETAIL. NC2524.2 +162000 COMP-TEST-39-42. NC2524.2 +162100 MOVE SPACES TO TEST-RESULTS. NC2524.2 +162200 MOVE "NOT USED" TO RE-MARK. NC2524.2 +162300 MOVE "COMP-TEST-39" TO PAR-NAME. NC2524.2 +162400 PERFORM PRINT-DETAIL. NC2524.2 +162500 MOVE "NOT USED" TO RE-MARK. NC2524.2 +162600 MOVE "COMP-TEST-40" TO PAR-NAME. NC2524.2 +162700 PERFORM PRINT-DETAIL. NC2524.2 +162800 MOVE "NOT USED" TO RE-MARK. NC2524.2 +162900 MOVE "COMP-TEST-41" TO PAR-NAME. NC2524.2 +163000 PERFORM PRINT-DETAIL. NC2524.2 +163100 MOVE "NOT USED" TO RE-MARK. NC2524.2 +163200 MOVE "COMP-TEST-42" TO PAR-NAME. NC2524.2 +163300 PERFORM PRINT-DETAIL. NC2524.2 +163400 MOVE "COMPUTE" TO FEATURE. NC2524.2 +163500 COMP-TEST-43. NC2524.2 +163600 MOVE ZEROS TO WHOLE-FIELD. NC2524.2 +163700 COMPUTE WHOLE-FIELD = NC2524.2 +163800 (1 + (2 - (3 + (4 - (5 + (6 - (7 + (8 - (9 + (10 - NC2524.2 +163900 EVEN-NAME1)))))))))). NC2524.2 +164000 IF (WHOLE-FIELD < 10.0002) AND NC2524.2 +164100 (WHOLE-FIELD > 9.9998) PERFORM PASS NC2524.2 +164200 GO TO COMP-WRITE-43. NC2524.2 +164300 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC2524.2 +164400 MOVE 10 TO CORRECT-18V0. NC2524.2 +164500 PERFORM FAIL. NC2524.2 +164600 GO TO COMP-WRITE-43. NC2524.2 +164700 COMP-DELETE-43. NC2524.2 +164800 PERFORM DE-LETE. NC2524.2 +164900 COMP-WRITE-43. NC2524.2 +165000 MOVE "COMP-TEST-43" TO PAR-NAME. NC2524.2 +165100 PERFORM PRINT-DETAIL. NC2524.2 +165200 COMP-TEST-44. NC2524.2 +165300 MOVE ZEROS TO WHOLE-FIELD. NC2524.2 +165400 COMPUTE WHOLE-FIELD = NC2524.2 +165500 (ONE + (TWO - (THREE + (FOUR - (FIVE + (SIX - (SEVEN + NC2524.2 +165600 (EIGHT - (NINE + (TEN - EVEN-NAME1)))))))))). NC2524.2 +165700 IF WHOLE-FIELD = 10 PERFORM PASS NC2524.2 +165800 GO TO COMP-WRITE-44. NC2524.2 +165900 MOVE WHOLE-FIELD TO COMPUTED-18V0. NC2524.2 +166000 MOVE 10 TO CORRECT-18V0. NC2524.2 +166100 PERFORM FAIL. NC2524.2 +166200 GO TO COMP-WRITE-44. NC2524.2 +166300 COMP-DELETE-44. NC2524.2 +166400 PERFORM DE-LETE. NC2524.2 +166500 COMP-WRITE-44. NC2524.2 +166600 MOVE "COMP-TEST-44" TO PAR-NAME. NC2524.2 +166700 PERFORM PRINT-DETAIL. NC2524.2 +166800 COMP-INT-045. NC2524.2 +166900 MOVE "COMPUTE SERIES" TO FEATURE. NC2524.2 +167000 MOVE "COMP-TEST-045" TO PAR-NAME. NC2524.2 +167100 COMP-TEST-045. NC2524.2 +167200 COMPUTE WRK-DS-05V00-0002 NC2524.2 +167300 WRK-DS-04V01-0005 ROUNDED NC2524.2 +167400 WRK-DS-03V04-0003F-0014 (2, 2, 2) = 174 / 16. NC2524.2 +167500* NC2524.2 +167600* IDENTIFIER SERIES - WITH AND WITHOUT ROUNDED - NC2524.2 +167700* SUBSCRIPTED DATA ITEM. NC2524.2 +167800* NC2524.2 +167900 MOVE "COMP-TEST-045-1" TO PAR-NAME. NC2524.2 +168000 IF WRK-DS-05V00-0002 NOT = 10 NC2524.2 +168100 MOVE +00010 TO CORRECT-N NC2524.2 +168200 MOVE WRK-DS-05V00-0002 TO COMPUTED-N NC2524.2 +168300 PERFORM COMP-WRITE-045 GO TO COMP-TEST-045-2. NC2524.2 +168400 PERFORM PASS. PERFORM COMP-WRITE-045. NC2524.2 +168500 COMP-TEST-045-2. NC2524.2 +168600 MOVE "COMP-TEST-045-2" TO PAR-NAME. NC2524.2 +168700 IF (WRK-DS-04V01-0005 > 10.9002180) OR NC2524.2 +168800 (WRK-DS-04V01-0005 < 10.8997820) PERFORM FAIL NC2524.2 +168900 MOVE +10.9 TO CORRECT-N NC2524.2 +169000 MOVE WRK-DS-04V01-0005 TO COMPUTED-N NC2524.2 +169100 PERFORM COMP-WRITE-045 GO TO COMP-TEST-045-3. NC2524.2 +169200 PERFORM PASS. PERFORM COMP-WRITE-045. NC2524.2 +169300 COMP-TEST-045-3. NC2524.2 +169400 MOVE "COMP-TEST-045-3" TO PAR-NAME. NC2524.2 +169500 IF (WRK-DS-03V04-0003F-0014 (2, 2, 2) > 10.87521750) OR NC2524.2 +169600 (WRK-DS-03V04-0003F-0014 (2, 2, 2) < 10.87479250) NC2524.2 +169700 PERFORM FAIL MOVE +010.8750 TO CORRECT-N NC2524.2 +169800 MOVE WRK-DS-03V04-0003F-0014 (2, 2, 2) TO COMPUTED-N NC2524.2 +169900 GO TO COMP-WRITE-045. NC2524.2 +170000 PERFORM PASS. NC2524.2 +170100 GO TO COMP-WRITE-045. NC2524.2 +170200 COMP-DELETE-045. NC2524.2 +170300 PERFORM DE-LETE. NC2524.2 +170400 COMP-WRITE-045. NC2524.2 +170500 PERFORM PRINT-DETAIL. NC2524.2 +170600 COMP-TEST-045-EXIT. NC2524.2 +170700 EXIT. NC2524.2 +170800 CCVS-EXIT SECTION. NC2524.2 +170900 CCVS-999999. NC2524.2 +171000 GO TO CLOSE-FILES. NC2524.2 diff --git a/tests/cobol85/NC/NC253A.CBL b/tests/cobol85/NC/NC253A.CBL new file mode 100755 index 00000000..3be12b24 --- /dev/null +++ b/tests/cobol85/NC/NC253A.CBL @@ -0,0 +1,1978 @@ +000100 IDENTIFICATION DIVISION. NC2534.2 +000200 PROGRAM-ID. NC2534.2 +000300 NC253A. NC2534.2 +000400**************************************************************** NC2534.2 +000500* * NC2534.2 +000600* VALIDATION FOR:- * NC2534.2 +000700* * NC2534.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2534.2 +000900* * NC2534.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2534.2 +001100* * NC2534.2 +001200**************************************************************** NC2534.2 +001300* * NC2534.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2534.2 +001500* * NC2534.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2534.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2534.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2534.2 +001900* * NC2534.2 +002000**************************************************************** NC2534.2 +002100 NC2534.2 +002200* NC2534.2 +002300* PROGRAM NC202A TESTS FORMAT3 OF THE SUBTRACT STATEMENT. NC2534.2 +002400* NC2534.2 +002500* NC2534.2 +002600 ENVIRONMENT DIVISION. NC2534.2 +002700 CONFIGURATION SECTION. NC2534.2 +002800 SOURCE-COMPUTER. NC2534.2 +002900 Linux. NC2534.2 +003000 OBJECT-COMPUTER. NC2534.2 +003100 Linux. NC2534.2 +003200 INPUT-OUTPUT SECTION. NC2534.2 +003300 FILE-CONTROL. NC2534.2 +003400 SELECT PRINT-FILE ASSIGN TO NC2534.2 +003500 "report.log". NC2534.2 +003600 DATA DIVISION. NC2534.2 +003700 FILE SECTION. NC2534.2 +003800 FD PRINT-FILE. NC2534.2 +003900 01 PRINT-REC PICTURE X(120). NC2534.2 +004000 01 DUMMY-RECORD PICTURE X(120). NC2534.2 +004100 WORKING-STORAGE SECTION. NC2534.2 +004200 01 TABLE1. NC2534.2 +004300 02 RECORD1 PICTURE 99. NC2534.2 +004400 02 RECORD2 PICTURE 99 NC2534.2 +004500 OCCURS 2 TIMES NC2534.2 +004600 INDEXED BY INDEX1. NC2534.2 +004700 02 RECORD3 PICTURE 99. NC2534.2 +004800 01 TABLE2. NC2534.2 +004900 02 RECORD1 PICTURE 99. NC2534.2 +005000 02 RECORD2 PICTURE 99 NC2534.2 +005100 OCCURS 2 TIMES NC2534.2 +005200 INDEXED BY INDEX2. NC2534.2 +005300 02 RECORD3 PICTURE 99. NC2534.2 +005400 77 WRK-AN-00001 PICTURE A. NC2534.2 +005500 77 WRK-XN-00001 PICTURE X. NC2534.2 +005600 77 WRK-DS-01V00 PICTURE S9. NC2534.2 +005700 77 WRK-DS-02V00 PICTURE S99. NC2534.2 +005800 77 WRK-DS-06V06 PICTURE S9(6)V9(6). NC2534.2 +005900 77 WRK-DS-05V00 PICTURE S9(5). NC2534.2 +006000 77 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2534.2 +006100 77 WRK-DS-09V09 PICTURE S9(9)V9(9). NC2534.2 +006200 77 WRK-DS-18V00-S REDEFINES WRK-DS-09V09 PICTURE S9(18). NC2534.2 +006300 77 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2534.2 +006400 VALUE 111111111.111111111. NC2534.2 +006500 77 WRK-DS-18V00 PICTURE S9(18) VALUE 111111111111111111. NC2534.2 +006600 77 A05ONES-DS-05V00 PICTURE S9(5) VALUE 11111. NC2534.2 +006700 77 A99-DS-02V00 PICTURE S99 VALUE 99. NC2534.2 +006800 77 WRK-DS-03V00 PICTURE S999. NC2534.2 +006900 77 WRK-DS-06V00 PICTURE S9(6). NC2534.2 +007000 77 WRK-DS-0201P PICTURE S99P. NC2534.2 +007100 77 WRK-DS-03V10 PICTURE S9(3)V9(10). NC2534.2 +007200 77 ADD-1 PICTURE S9(8)V99 VALUE 1. NC2534.2 +007300 77 ADD-2 PICTURE S9(6)V9(4) VALUE 1. NC2534.2 +007400 77 ADD-3 PICTURE S9(5) VALUE -1. NC2534.2 +007500 77 ADD-4 PICTURE 9 VALUE 9. NC2534.2 +007600 77 ADD-5 PICTURE 9 VALUE 9. NC2534.2 +007700 77 ADD-6 PICTURE 9(5) VALUE 99999. NC2534.2 +007800 77 ADD-7 PICTURE 9 VALUE 1. NC2534.2 +007900 77 ADD-8 PICTURE 9. NC2534.2 +008000 77 ADD-9 PICTURE S9(8)V99 VALUE 5.9. NC2534.2 +008100 77 ADD-10 PICTURE 9(5) VALUE 52800. NC2534.2 +008200 77 ADD-11 PICTURE 99999. NC2534.2 +008300 77 ADD-12 PICTURE PP9 VALUE .001. NC2534.2 +008400 77 ADD-13 PICTURE 9PP VALUE 100. NC2534.2 +008500 77 ADD-14 PICTURE 999V999. NC2534.2 +008600 77 W-1 PICTURE IS 9. NC2534.2 +008700 77 W-2 PICTURE IS 99. NC2534.2 +008800 77 W-3 PICTURE IS 999. NC2534.2 +008900 77 W-4 PICTURE 9 VALUE 0. NC2534.2 +009000 77 W-6 PICTURE IS 999 VALUE IS ZERO. NC2534.2 +009100 77 W-9 PICTURE 999. NC2534.2 +009200 77 D-5 PICTURE S999 VALUE -1. NC2534.2 +009300 77 D-9 PICTURE 9(4)V9(4) VALUE 111.1189. NC2534.2 +009400 77 ONE PICTURE 9 VALUE 1. NC2534.2 +009500 77 TWO PICTURE S9 VALUE 2. NC2534.2 +009600 77 THREE PICTURE S9 VALUE 3. NC2534.2 +009700 77 FOUR PICTURE S9 VALUE 4. NC2534.2 +009800 77 FIVE PICTURE S9 VALUE 5. NC2534.2 +009900 77 SIX PICTURE S9 VALUE 6. NC2534.2 +010000 77 SEVEN PICTURE S9 VALUE 7. NC2534.2 +010100 77 EIGHT PICTURE 9 VALUE 8. NC2534.2 +010200 77 NINE PICTURE S9 VALUE 9. NC2534.2 +010300 77 TEN PICTURE S99 VALUE 10. NC2534.2 +010400 77 FIFTEEN PICTURE S99 VALUE 15. NC2534.2 +010500 77 TWENTY PICTURE S99 VALUE 20. NC2534.2 +010600 77 TWENTY-5 PICTURE S99 VALUE 25. NC2534.2 +010700 01 WRK-DS-09V00 PICTURE S9(9) VALUE ZERO. NC2534.2 +010800 01 GRP-FOR-ADD-CORR-1. NC2534.2 +010900 02 GRP-SUBTRACT-CORR-1. NC2534.2 +011000 03 FILLER PICTURE S99 VALUE 91. NC2534.2 +011100 03 ADD-CORR-2 PICTURE S99 VALUE 22. NC2534.2 +011200 03 ADD-CORR-1 PICTURE S99 VALUE 11. NC2534.2 +011300 03 ADD-CORR-A PICTURE S99 VALUE 93. NC2534.2 +011400 03 ADD-CORR-4 PICTURE S99 VALUE 44. NC2534.2 +011500 03 ADD-CORR-3 PICTURE S99 VALUE 33. NC2534.2 +011600 03 ADD-CORR-6 PICTURE S99 VALUE 66. NC2534.2 +011700 03 ADD-CORR-5 PICTURE S99 VALUE 55. NC2534.2 +011800 03 ADD-CORR-8 PICTURE S99 VALUE 88. NC2534.2 +011900 03 ADD-CORR-7 PICTURE S99 VALUE 77. NC2534.2 +012000 03 ADD-CORR-9 PICTURE S99 VALUE 99. NC2534.2 +012100 01 GRP-FOR-ADD-CORR-R. NC2534.2 +012200 02 GRP-SUBTRACT-CORR-1. NC2534.2 +012300 05 ADD-CORR-1 PICTURE 99. NC2534.2 +012400 05 ADD-CORR-2 PICTURE 99. NC2534.2 +012500 05 ADD-CORR-3 PICTURE 99. NC2534.2 +012600 05 ADD-CORR-4 PICTURE 99. NC2534.2 +012700 05 ADD-CORR-5 PICTURE 9P. NC2534.2 +012800 05 ADD-CORR-6 PICTURE 999. NC2534.2 +012900 05 ADD-CORR-7 PICTURE 99. NC2534.2 +013000 05 ADD-CORR-8 PICTURE 99. NC2534.2 +013100 05 ADD-CORR-9 PICTURE 99. NC2534.2 +013200 05 FILLER PICTURE 99. NC2534.2 +013300 01 GRP-FOR-ADD-CORR-2. NC2534.2 +013400 02 GRP-ADD-SUB-CORR. NC2534.2 +013500 03 GRP-SUBTRACT-CORR-1. NC2534.2 +013600 04 ADD-CORR-1 PICTURE S99 VALUE 11. NC2534.2 +013700 04 ADD-CORR-2 PICTURE S99 VALUE 22. NC2534.2 +013800 04 ADD-CORR-5 PICTURE S99 VALUE 55. NC2534.2 +013900 04 ADD-CORR-4 PICTURE S99 VALUE 44. NC2534.2 +014000 04 ADD-CORR-3 PICTURE S99 VALUE 33. NC2534.2 +014100 04 ADD-CORR-6 PICTURE S99 VALUE 66. NC2534.2 +014200 04 ADD-CORR-7 PICTURE S99 VALUE 77. NC2534.2 +014300 04 ADD-CORR-8 PICTURE S99 VALUE 88. NC2534.2 +014400 04 ADD-CORR-9 PICTURE S99 VALUE 99. NC2534.2 +014500 04 ADD-CORR-B PICTURE S99 VALUE 92. NC2534.2 +014600 04 ADD-CORR-0 PICTURE S99 VALUE 00. NC2534.2 +014700 01 GRP-FOR-ADD-CORR-A. NC2534.2 +014800 02 GRP-SUBTRACT-CORR-3. NC2534.2 +014900 03 GRP-SUBTRACT-CORR-1. NC2534.2 +015000 05 ADD-CORR-4 PICTURE S999 VALUE 044. NC2534.2 +015100 05 ADD-CORR-3 PICTURE S999 VALUE 033. NC2534.2 +015200 05 ADD-CORR-2 PICTURE S999 VALUE 022. NC2534.2 +015300 05 ADD-CORR-1 PICTURE S999 VALUE 111. NC2534.2 +015400 01 ADD-15. NC2534.2 +015500 02 FIELD1 PICTURE 99999 VALUE 1. NC2534.2 +015600 02 FIELD2 PICTURE 999V99 VALUE 32.1. NC2534.2 +015700 02 FIELD3 PICTURE 999V9 VALUE 123.4. NC2534.2 +015800 01 ADD-16. NC2534.2 +015900 02 FIELD1 PICTURE 99999 VALUE 99999. NC2534.2 +016000 02 FIELD2 PICTURE 999V99 VALUE 745.67. NC2534.2 +016100 02 FIELD3 PICTURE 999V9 VALUE 432.1. NC2534.2 +016200 01 SUBTRACT-DATA. NC2534.2 +016300 02 SUBTR-1 PICTURE 9 VALUE 1. NC2534.2 +016400 02 SUBTR-2 PICTURE S99 VALUE 99. NC2534.2 +016500 02 SUBTR-3 PICTURE S9V99 VALUE -1. NC2534.2 +016600 02 SUBTR-4 PICTURE SPP9 VALUE .001. NC2534.2 +016700 02 SUBTR-5 PICTURE S9PP VALUE 100. NC2534.2 +016800 02 SUBTR-6 PICTURE 9 VALUE 1. NC2534.2 +016900 02 SUBTR-7 PICTURE S99 VALUE 99. NC2534.2 +017000 02 SUBTR-8 PICTURE S9V99 VALUE -9.99. NC2534.2 +017100 02 SUBTR-9 PICTURE SV999. NC2534.2 +017200 02 SUBTR-10 PICTURE S999 VALUE 100. NC2534.2 +017300 02 SUBTR-11 PICTURE S999V999. NC2534.2 +017400 02 SUBTR-12. NC2534.2 +017500 03 SUBTR-13 PICTURE 9 VALUE 1. NC2534.2 +017600 03 SUBTR-14 PICTURE S9V999 VALUE -1.725. NC2534.2 +017700 03 SUBTR-15 PICTURE S99V99 VALUE 76.76. NC2534.2 +017800 02 SUBTR-16. NC2534.2 +017900 03 SUBTR-13 PICTURE 9 VALUE 2. NC2534.2 +018000 03 SUBTR-14 PICTURE S9V99 VALUE .23. NC2534.2 +018100 03 SUBTR-15 PICTURE S9V99 VALUE 1. NC2534.2 +018200 01 CORR-DATA-1. NC2534.2 +018300 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018400 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018500 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018600 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018700 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018800 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +018900 01 CORR-DATA-2. NC2534.2 +019000 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019100 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019200 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019300 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019400 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019500 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019600 01 CORR-DATA-3. NC2534.2 +019700 03 XYZ-4 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019800 03 XYZ-3 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +019900 03 XYZ-6 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +020000 03 XYZ-5 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +020100 03 XYZ-2 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +020200 03 XYZ-1 PICTURE IS 99 VALUE IS ZERO. NC2534.2 +020300 01 CORR-DATA-4. NC2534.2 +020400 03 XYZ-11 PICTURE IS 99. NC2534.2 +020500 03 XYZ-12 PICTURE IS 99. NC2534.2 +020600 03 XYZ-13 PICTURE IS 99. NC2534.2 +020700 03 XYZ-14 PICTURE IS 99. NC2534.2 +020800 03 XYZ-15 PICTURE IS 99. NC2534.2 +020900 03 XYZ-16 PICTURE IS 99. NC2534.2 +021000 01 CORR-DATA-5. NC2534.2 +021100 03 XYZ-1 PICTURE 99. NC2534.2 +021200 03 XYZ-2 PICTURE 99. NC2534.2 +021300 03 XYZ-13 PICTURE IS 99. NC2534.2 +021400 03 XYZ-14 PICTURE IS 99. NC2534.2 +021500 03 FILLER PICTURE IS 99. NC2534.2 +021600 03 XYZ-11 PICTURE IS 99. NC2534.2 +021700 03 XYZ-12 PICTURE IS 99. NC2534.2 +021800 01 CORR-DATA-6. NC2534.2 +021900 03 XYZ-11 PICTURE IS 99. NC2534.2 +022000 03 XYZ-12 PICTURE IS 99. NC2534.2 +022100 03 FILLER PICTURE IS 99. NC2534.2 +022200 03 XYZ-1 PICTURE IS 99. NC2534.2 +022300 03 XYZ-2 PICTURE IS 9(2). NC2534.2 +022400 03 FILLER PICTURE IS 99. NC2534.2 +022500 01 CORR-DATA-7. NC2534.2 +022600 02 XYZ-1 PICTURE 99V99 VALUE 10.45. NC2534.2 +022700 02 XYZ-6 PICTURE 999V9 VALUE 100.5. NC2534.2 +022800 02 XYZ-11 PICTURE 99V9 VALUE ZERO. NC2534.2 +022900 02 XYZ-2 PICTURE 99V9 VALUE 0.9. NC2534.2 +023000 01 42-DATANAMES. NC2534.2 +023100 02 DNAME1 PICTURE 9 VALUE 1 COMPUTATIONAL. NC2534.2 +023200 02 DNAME2 PICTURE 99 VALUE 1 COMPUTATIONAL. NC2534.2 +023300 02 DNAME3 PICTURE 999 VALUE 1 COMPUTATIONAL. NC2534.2 +023400 02 DNAME4 PICTURE 9(4) VALUE 1 COMPUTATIONAL. NC2534.2 +023500 02 DNAME5 PICTURE 9(5) VALUE 1 COMPUTATIONAL. NC2534.2 +023600 02 DNAME6 PICTURE 9(6) VALUE 1 COMPUTATIONAL. NC2534.2 +023700 02 DNAME7 PICTURE 9(7) VALUE 1 COMPUTATIONAL. NC2534.2 +023800 02 DNAME8 PICTURE 9(8) VALUE 1 COMPUTATIONAL. NC2534.2 +023900 02 DNAME9 PICTURE 9(9) VALUE 1 COMPUTATIONAL. NC2534.2 +024000 02 DNAME10 PICTURE 9(10) VALUE 1. NC2534.2 +024100 02 DNAME11 PICTURE 9(11) VALUE 1. NC2534.2 +024200 02 DNAME12 PICTURE 9(12) VALUE 1. NC2534.2 +024300 02 DNAME13 PICTURE 9(13) VALUE 1. NC2534.2 +024400 02 DNAME14 PICTURE 9(14) VALUE 1. NC2534.2 +024500 02 DNAME15 PICTURE 9(15) VALUE 1. NC2534.2 +024600 02 DNAME16 PICTURE 9(16) VALUE 1. NC2534.2 +024700 02 DNAME17 PICTURE 9(17) VALUE 1. NC2534.2 +024800 02 DNAME18 PICTURE 9(18) VALUE 1. NC2534.2 +024900 02 DNAME19 PICTURE 9 VALUE 1. NC2534.2 +025000 02 DNAME20 PICTURE 99 VALUE 1. NC2534.2 +025100 02 DNAME21 PICTURE 999 VALUE 1. NC2534.2 +025200 02 DNAME22 PICTURE 9(18) VALUE ZERO. NC2534.2 +025300 02 DNAME23 PICTURE 9(18) VALUE ZERO. NC2534.2 +025400 02 DNAME24 PICTURE 9(18) VALUE ZERO. NC2534.2 +025500 02 DNAME25 PICTURE 9(18) VALUE ZERO. NC2534.2 +025600 02 DNAME26 PICTURE 9(18) VALUE ZERO. NC2534.2 +025700 02 DNAME27 PICTURE 9(18) VALUE ZERO. NC2534.2 +025800 02 DNAME28 PICTURE 9(18) VALUE ZERO. NC2534.2 +025900 02 DNAME29 PICTURE 9(18) VALUE ZERO. NC2534.2 +026000 02 DNAME30 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026100 02 DNAME31 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026200 02 DNAME32 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026300 02 DNAME33 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026400 02 DNAME34 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026500 02 DNAME35 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026600 02 DNAME36 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026700 02 DNAME37 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026800 02 DNAME38 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +026900 02 DNAME39 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +027000 02 DNAME40 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +027100 02 DNAME41 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +027200 02 DNAME42 PICTURE 9(18) VALUE ZERO COMPUTATIONAL. NC2534.2 +027300 01 TEST-RESULTS. NC2534.2 +027400 02 FILLER PIC X VALUE SPACE. NC2534.2 +027500 02 FEATURE PIC X(20) VALUE SPACE. NC2534.2 +027600 02 FILLER PIC X VALUE SPACE. NC2534.2 +027700 02 P-OR-F PIC X(5) VALUE SPACE. NC2534.2 +027800 02 FILLER PIC X VALUE SPACE. NC2534.2 +027900 02 PAR-NAME. NC2534.2 +028000 03 FILLER PIC X(19) VALUE SPACE. NC2534.2 +028100 03 PARDOT-X PIC X VALUE SPACE. NC2534.2 +028200 03 DOTVALUE PIC 99 VALUE ZERO. NC2534.2 +028300 02 FILLER PIC X(8) VALUE SPACE. NC2534.2 +028400 02 RE-MARK PIC X(61). NC2534.2 +028500 01 TEST-COMPUTED. NC2534.2 +028600 02 FILLER PIC X(30) VALUE SPACE. NC2534.2 +028700 02 FILLER PIC X(17) VALUE NC2534.2 +028800 " COMPUTED=". NC2534.2 +028900 02 COMPUTED-X. NC2534.2 +029000 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2534.2 +029100 03 COMPUTED-N REDEFINES COMPUTED-A NC2534.2 +029200 PIC -9(9).9(9). NC2534.2 +029300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2534.2 +029400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2534.2 +029500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2534.2 +029600 03 CM-18V0 REDEFINES COMPUTED-A. NC2534.2 +029700 04 COMPUTED-18V0 PIC -9(18). NC2534.2 +029800 04 FILLER PIC X. NC2534.2 +029900 03 FILLER PIC X(50) VALUE SPACE. NC2534.2 +030000 01 TEST-CORRECT. NC2534.2 +030100 02 FILLER PIC X(30) VALUE SPACE. NC2534.2 +030200 02 FILLER PIC X(17) VALUE " CORRECT =". NC2534.2 +030300 02 CORRECT-X. NC2534.2 +030400 03 CORRECT-A PIC X(20) VALUE SPACE. NC2534.2 +030500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2534.2 +030600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2534.2 +030700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2534.2 +030800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2534.2 +030900 03 CR-18V0 REDEFINES CORRECT-A. NC2534.2 +031000 04 CORRECT-18V0 PIC -9(18). NC2534.2 +031100 04 FILLER PIC X. NC2534.2 +031200 03 FILLER PIC X(2) VALUE SPACE. NC2534.2 +031300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2534.2 +031400 01 CCVS-C-1. NC2534.2 +031500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2534.2 +031600- "SS PARAGRAPH-NAME NC2534.2 +031700- " REMARKS". NC2534.2 +031800 02 FILLER PIC X(20) VALUE SPACE. NC2534.2 +031900 01 CCVS-C-2. NC2534.2 +032000 02 FILLER PIC X VALUE SPACE. NC2534.2 +032100 02 FILLER PIC X(6) VALUE "TESTED". NC2534.2 +032200 02 FILLER PIC X(15) VALUE SPACE. NC2534.2 +032300 02 FILLER PIC X(4) VALUE "FAIL". NC2534.2 +032400 02 FILLER PIC X(94) VALUE SPACE. NC2534.2 +032500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2534.2 +032600 01 REC-CT PIC 99 VALUE ZERO. NC2534.2 +032700 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2534.2 +032800 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2534.2 +032900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2534.2 +033000 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2534.2 +033100 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2534.2 +033200 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2534.2 +033300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2534.2 +033400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2534.2 +033500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2534.2 +033600 01 CCVS-H-1. NC2534.2 +033700 02 FILLER PIC X(39) VALUE SPACES. NC2534.2 +033800 02 FILLER PIC X(42) VALUE NC2534.2 +033900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2534.2 +034000 02 FILLER PIC X(39) VALUE SPACES. NC2534.2 +034100 01 CCVS-H-2A. NC2534.2 +034200 02 FILLER PIC X(40) VALUE SPACE. NC2534.2 +034300 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2534.2 +034400 02 FILLER PIC XXXX VALUE NC2534.2 +034500 "4.2 ". NC2534.2 +034600 02 FILLER PIC X(28) VALUE NC2534.2 +034700 " COPY - NOT FOR DISTRIBUTION". NC2534.2 +034800 02 FILLER PIC X(41) VALUE SPACE. NC2534.2 +034900 NC2534.2 +035000 01 CCVS-H-2B. NC2534.2 +035100 02 FILLER PIC X(15) VALUE NC2534.2 +035200 "TEST RESULT OF ". NC2534.2 +035300 02 TEST-ID PIC X(9). NC2534.2 +035400 02 FILLER PIC X(4) VALUE NC2534.2 +035500 " IN ". NC2534.2 +035600 02 FILLER PIC X(12) VALUE NC2534.2 +035700 " HIGH ". NC2534.2 +035800 02 FILLER PIC X(22) VALUE NC2534.2 +035900 " LEVEL VALIDATION FOR ". NC2534.2 +036000 02 FILLER PIC X(58) VALUE NC2534.2 +036100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2534.2 +036200 01 CCVS-H-3. NC2534.2 +036300 02 FILLER PIC X(34) VALUE NC2534.2 +036400 " FOR OFFICIAL USE ONLY ". NC2534.2 +036500 02 FILLER PIC X(58) VALUE NC2534.2 +036600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2534.2 +036700 02 FILLER PIC X(28) VALUE NC2534.2 +036800 " COPYRIGHT 1985 ". NC2534.2 +036900 01 CCVS-E-1. NC2534.2 +037000 02 FILLER PIC X(52) VALUE SPACE. NC2534.2 +037100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2534.2 +037200 02 ID-AGAIN PIC X(9). NC2534.2 +037300 02 FILLER PIC X(45) VALUE SPACES. NC2534.2 +037400 01 CCVS-E-2. NC2534.2 +037500 02 FILLER PIC X(31) VALUE SPACE. NC2534.2 +037600 02 FILLER PIC X(21) VALUE SPACE. NC2534.2 +037700 02 CCVS-E-2-2. NC2534.2 +037800 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2534.2 +037900 03 FILLER PIC X VALUE SPACE. NC2534.2 +038000 03 ENDER-DESC PIC X(44) VALUE NC2534.2 +038100 "ERRORS ENCOUNTERED". NC2534.2 +038200 01 CCVS-E-3. NC2534.2 +038300 02 FILLER PIC X(22) VALUE NC2534.2 +038400 " FOR OFFICIAL USE ONLY". NC2534.2 +038500 02 FILLER PIC X(12) VALUE SPACE. NC2534.2 +038600 02 FILLER PIC X(58) VALUE NC2534.2 +038700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2534.2 +038800 02 FILLER PIC X(13) VALUE SPACE. NC2534.2 +038900 02 FILLER PIC X(15) VALUE NC2534.2 +039000 " COPYRIGHT 1985". NC2534.2 +039100 01 CCVS-E-4. NC2534.2 +039200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2534.2 +039300 02 FILLER PIC X(4) VALUE " OF ". NC2534.2 +039400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2534.2 +039500 02 FILLER PIC X(40) VALUE NC2534.2 +039600 " TESTS WERE EXECUTED SUCCESSFULLY". NC2534.2 +039700 01 XXINFO. NC2534.2 +039800 02 FILLER PIC X(19) VALUE NC2534.2 +039900 "*** INFORMATION ***". NC2534.2 +040000 02 INFO-TEXT. NC2534.2 +040100 04 FILLER PIC X(8) VALUE SPACE. NC2534.2 +040200 04 XXCOMPUTED PIC X(20). NC2534.2 +040300 04 FILLER PIC X(5) VALUE SPACE. NC2534.2 +040400 04 XXCORRECT PIC X(20). NC2534.2 +040500 02 INF-ANSI-REFERENCE PIC X(48). NC2534.2 +040600 01 HYPHEN-LINE. NC2534.2 +040700 02 FILLER PIC IS X VALUE IS SPACE. NC2534.2 +040800 02 FILLER PIC IS X(65) VALUE IS "************************NC2534.2 +040900- "*****************************************". NC2534.2 +041000 02 FILLER PIC IS X(54) VALUE IS "************************NC2534.2 +041100- "******************************". NC2534.2 +041200 01 CCVS-PGM-ID PIC X(9) VALUE NC2534.2 +041300 "NC253A". NC2534.2 +041400 PROCEDURE DIVISION. NC2534.2 +041500 CCVS1 SECTION. NC2534.2 +041600 OPEN-FILES. NC2534.2 +041700 OPEN OUTPUT PRINT-FILE. NC2534.2 +041800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2534.2 +041900 MOVE SPACE TO TEST-RESULTS. NC2534.2 +042000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2534.2 +042100 GO TO CCVS1-EXIT. NC2534.2 +042200 CLOSE-FILES. NC2534.2 +042300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2534.2 +042400 TERMINATE-CCVS. NC2534.2 +042500*S EXIT PROGRAM. NC2534.2 +042600*SERMINATE-CALL. NC2534.2 +042700 STOP RUN. NC2534.2 +042800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2534.2 +042900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2534.2 +043000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2534.2 +043100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2534.2 +043200 MOVE "****TEST DELETED****" TO RE-MARK. NC2534.2 +043300 PRINT-DETAIL. NC2534.2 +043400 IF REC-CT NOT EQUAL TO ZERO NC2534.2 +043500 MOVE "." TO PARDOT-X NC2534.2 +043600 MOVE REC-CT TO DOTVALUE. NC2534.2 +043700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2534.2 +043800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2534.2 +043900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2534.2 +044000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2534.2 +044100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2534.2 +044200 MOVE SPACE TO CORRECT-X. NC2534.2 +044300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2534.2 +044400 MOVE SPACE TO RE-MARK. NC2534.2 +044500 HEAD-ROUTINE. NC2534.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2534.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2534.2 +045000 COLUMN-NAMES-ROUTINE. NC2534.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +045400 END-ROUTINE. NC2534.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2534.2 +045600 END-RTN-EXIT. NC2534.2 +045700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +045800 END-ROUTINE-1. NC2534.2 +045900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2534.2 +046000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2534.2 +046100 ADD PASS-COUNTER TO ERROR-HOLD. NC2534.2 +046200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2534.2 +046300 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2534.2 +046400 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2534.2 +046500 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2534.2 +046600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2534.2 +046700 END-ROUTINE-12. NC2534.2 +046800 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2534.2 +046900 IF ERROR-COUNTER IS EQUAL TO ZERO NC2534.2 +047000 MOVE "NO " TO ERROR-TOTAL NC2534.2 +047100 ELSE NC2534.2 +047200 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2534.2 +047300 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2534.2 +047400 PERFORM WRITE-LINE. NC2534.2 +047500 END-ROUTINE-13. NC2534.2 +047600 IF DELETE-COUNTER IS EQUAL TO ZERO NC2534.2 +047700 MOVE "NO " TO ERROR-TOTAL ELSE NC2534.2 +047800 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2534.2 +047900 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2534.2 +048000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +048100 IF INSPECT-COUNTER EQUAL TO ZERO NC2534.2 +048200 MOVE "NO " TO ERROR-TOTAL NC2534.2 +048300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2534.2 +048400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2534.2 +048500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +048600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2534.2 +048700 WRITE-LINE. NC2534.2 +048800 ADD 1 TO RECORD-COUNT. NC2534.2 +048900 IF RECORD-COUNT GREATER 50 NC2534.2 +049000 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2534.2 +049100 MOVE SPACE TO DUMMY-RECORD NC2534.2 +049200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2534.2 +049300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2534.2 +049400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2534.2 +049500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2534.2 +049600 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2534.2 +049700 MOVE ZERO TO RECORD-COUNT. NC2534.2 +049800 PERFORM WRT-LN. NC2534.2 +049900 WRT-LN. NC2534.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2534.2 +050100 MOVE SPACE TO DUMMY-RECORD. NC2534.2 +050200 BLANK-LINE-PRINT. NC2534.2 +050300 PERFORM WRT-LN. NC2534.2 +050400 FAIL-ROUTINE. NC2534.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. NC2534.2 +050600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2534.2 +050700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2534.2 +050800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2534.2 +050900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +051000 MOVE SPACES TO INF-ANSI-REFERENCE. NC2534.2 +051100 GO TO FAIL-ROUTINE-EX. NC2534.2 +051200 FAIL-ROUTINE-WRITE. NC2534.2 +051300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2534.2 +051400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2534.2 +051500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2534.2 +051600 MOVE SPACES TO COR-ANSI-REFERENCE. NC2534.2 +051700 FAIL-ROUTINE-EX. EXIT. NC2534.2 +051800 BAIL-OUT. NC2534.2 +051900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2534.2 +052000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2534.2 +052100 BAIL-OUT-WRITE. NC2534.2 +052200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2534.2 +052300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2534.2 +052400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2534.2 +052500 MOVE SPACES TO INF-ANSI-REFERENCE. NC2534.2 +052600 BAIL-OUT-EX. EXIT. NC2534.2 +052700 CCVS1-EXIT. NC2534.2 +052800 EXIT. NC2534.2 +052900* NC2534.2 +053000 SECT-NC253A-001 SECTION. NC2534.2 +053100 BUILD-TABLE1. NC2534.2 +053200 MOVE 06 TO RECORD1 OF TABLE1. NC2534.2 +053300 MOVE 01 TO RECORD2 OF TABLE1 (1). NC2534.2 +053400 MOVE 02 TO RECORD2 OF TABLE1 (2). NC2534.2 +053500 MOVE 07 TO RECORD3 OF TABLE1. NC2534.2 +053600 BUILD-TABLE2. NC2534.2 +053700 MOVE 08 TO RECORD1 OF TABLE2. NC2534.2 +053800 MOVE 03 TO RECORD2 OF TABLE2 (1). NC2534.2 +053900 MOVE 04 TO RECORD2 OF TABLE2 (2). NC2534.2 +054000 MOVE 09 TO RECORD3 OF TABLE2. NC2534.2 +054100* NC2534.2 +054200 SUB-INIT-F3-1. NC2534.2 +054300 PERFORM END-ROUTINE. NC2534.2 +054400 MOVE "SUB-TEST-F3-1" TO PAR-NAME. NC2534.2 +054500 MOVE "VI-134 6.25.4 GR3" TO ANSI-REFERENCE. NC2534.2 +054600 MOVE "SUBTRACT SERIES " TO FEATURE. NC2534.2 +054700 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2534.2 +054800 MOVE 11 TO ADD-CORR-1 OF GRP-FOR-ADD-CORR-1. NC2534.2 +054900 MOVE 22 TO ADD-CORR-2 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055000 MOVE 33 TO ADD-CORR-3 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055100 MOVE 44 TO ADD-CORR-4 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055200 MOVE 55 TO ADD-CORR-5 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055300 MOVE 66 TO ADD-CORR-6 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055400 MOVE 77 TO ADD-CORR-7 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055500 MOVE 88 TO ADD-CORR-8 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055600 MOVE 99 TO ADD-CORR-9 OF GRP-FOR-ADD-CORR-1. NC2534.2 +055700 SUB-TEST-F3-1. NC2534.2 +055800 SUBTRACT CORRESPONDING GRP-FOR-ADD-CORR-1 FROM NC2534.2 +055900 GRP-FOR-ADD-CORR-R. NC2534.2 +056000 IF GRP-FOR-ADD-CORR-R EQUAL TO "11223344506677889900" NC2534.2 +056100 PERFORM PASS NC2534.2 +056200 GO TO SUB-WRITE-F3-1. NC2534.2 +056300 GO TO SUB-FAIL-F3-1. NC2534.2 +056400 SUB-DELETE-F3-1. NC2534.2 +056500 PERFORM DE-LETE. NC2534.2 +056600 GO TO SUB-WRITE-F3-1. NC2534.2 +056700 SUB-FAIL-F3-1. NC2534.2 +056800 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2534.2 +056900 MOVE "11223344506677889900" TO CORRECT-A. NC2534.2 +057000 PERFORM FAIL. NC2534.2 +057100 SUB-WRITE-F3-1. NC2534.2 +057200 PERFORM PRINT-DETAIL. NC2534.2 +057300* NC2534.2 +057400 SUB-INIT-F3-2. NC2534.2 +057500 MOVE "SUB-TEST-F3-2" TO PAR-NAME. NC2534.2 +057600 MOVE ZERO TO GRP-FOR-ADD-CORR-R. NC2534.2 +057700 SUB-TEST-F3-2. NC2534.2 +057800 SUBTRACT CORRESPONDING GRP-ADD-SUB-CORR FROM NC2534.2 +057900 GRP-FOR-ADD-CORR-R ROUNDED. NC2534.2 +058000 IF GRP-FOR-ADD-CORR-R EQUAL TO "11223344606677889900" NC2534.2 +058100 PERFORM PASS NC2534.2 +058200 GO TO SUB-WRITE-F3-2. NC2534.2 +058300 GO TO SUB-FAIL-F3-2. NC2534.2 +058400 SUB-DELETE-F3-2. NC2534.2 +058500 PERFORM DE-LETE. NC2534.2 +058600 GO TO SUB-WRITE-F3-2. NC2534.2 +058700 SUB-FAIL-F3-2. NC2534.2 +058800 MOVE GRP-FOR-ADD-CORR-R TO COMPUTED-A. NC2534.2 +058900 MOVE "11223344606677889900" TO CORRECT-A. NC2534.2 +059000 PERFORM FAIL. NC2534.2 +059100 SUB-WRITE-F3-2. NC2534.2 +059200 PERFORM PRINT-DETAIL. NC2534.2 +059300* NC2534.2 +059400 SUB-INIT-F3-3. NC2534.2 +059500 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +059600 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +059700 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +059800 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +059900 MOVE 0.23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +060000 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +060100 SUB-INIT-F3-3-1. NC2534.2 +060200 MOVE "SUB-TEST-F3-3-1" TO PAR-NAME. NC2534.2 +060300 MOVE SPACE TO WRK-AN-00001. NC2534.2 +060400 SUB-TEST-F3-3-1. NC2534.2 +060500 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED ON NC2534.2 +060600 SIZE ERROR NC2534.2 +060700 MOVE "G" TO WRK-AN-00001. NC2534.2 +060800 IF WRK-AN-00001 EQUAL TO "G" NC2534.2 +060900 PERFORM PASS NC2534.2 +061000 GO TO SUB-WRITE-F3-3-1. NC2534.2 +061100 GO TO SUB-FAIL-F3-3-1. NC2534.2 +061200 SUB-DELETE-F3-3-1. NC2534.2 +061300 PERFORM DE-LETE. NC2534.2 +061400 GO TO SUB-WRITE-F3-3-1. NC2534.2 +061500 SUB-FAIL-F3-3-1. NC2534.2 +061600 PERFORM FAIL. NC2534.2 +061700 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" TO RE-MARK. NC2534.2 +061800 SUB-WRITE-F3-3-1. NC2534.2 +061900 PERFORM PRINT-DETAIL. NC2534.2 +062000* NC2534.2 +062100 SUB-INIT-F3-3-2. NC2534.2 +062200 MOVE "SUB-TEST-F3-3-2" TO PAR-NAME. NC2534.2 +062300 SUB-TEST-F3-3-2. NC2534.2 +062400 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +062500 GO TO SUB-FAIL-F3-3-2. NC2534.2 +062600 PERFORM PASS. NC2534.2 +062700 GO TO SUB-WRITE-F3-3-2. NC2534.2 +062800 SUB-DELETE-F3-3-2. NC2534.2 +062900 PERFORM DE-LETE. NC2534.2 +063000 GO TO SUB-WRITE-F3-3-2. NC2534.2 +063100 SUB-FAIL-F3-3-2. NC2534.2 +063200 PERFORM FAIL. NC2534.2 +063300 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N. NC2534.2 +063400 MOVE "+1" TO CORRECT-A. NC2534.2 +063500 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +063600 TO RE-MARK. NC2534.2 +063700 SUB-WRITE-F3-3-2. NC2534.2 +063800 PERFORM PRINT-DETAIL. NC2534.2 +063900* NC2534.2 +064000 SUB-INIT-F3-3-3. NC2534.2 +064100 MOVE "SUB-TEST-F3-3-3" TO PAR-NAME. NC2534.2 +064200 SUB-TEST-F3-3-3. NC2534.2 +064300 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +064400 GO TO SUB-FAIL-F3-3-3. NC2534.2 +064500 PERFORM PASS. NC2534.2 +064600 GO TO SUB-WRITE-F3-3-3. NC2534.2 +064700 SUB-DELETE-F3-3-3. NC2534.2 +064800 PERFORM DE-LETE. NC2534.2 +064900 GO TO SUB-WRITE-F3-3-3. NC2534.2 +065000 SUB-FAIL-F3-3-3. NC2534.2 +065100 PERFORM FAIL. NC2534.2 +065200 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N. NC2534.2 +065300 MOVE "+1.96" TO CORRECT-A. NC2534.2 +065400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +065500 TO RE-MARK. NC2534.2 +065600 SUB-WRITE-F3-3-3. NC2534.2 +065700 PERFORM PRINT-DETAIL. NC2534.2 +065800* NC2534.2 +065900 SUB-INIT-3-3-4. NC2534.2 +066000 MOVE "SUB-TEST-3-3-4" TO PAR-NAME. NC2534.2 +066100 SUB-TEST-3-3-4. NC2534.2 +066200 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +066300 GO TO SUB-FAIL-3-3-4. NC2534.2 +066400 PERFORM PASS NC2534.2 +066500 GO TO SUB-WRITE-3-3-4. NC2534.2 +066600 SUB-DELETE-3-3-4. NC2534.2 +066700 PERFORM DE-LETE. NC2534.2 +066800 GO TO SUB-WRITE-3-3-4. NC2534.2 +066900 SUB-FAIL-3-3-4. NC2534.2 +067000 PERFORM FAIL. NC2534.2 +067100 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N. NC2534.2 +067200 MOVE "+1" TO CORRECT-A. NC2534.2 +067300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK. NC2534.2 +067400 SUB-WRITE-3-3-4. NC2534.2 +067500 PERFORM PRINT-DETAIL. NC2534.2 +067600* NC2534.2 +067700 SUB-INIT-F3-4. NC2534.2 +067800 MOVE "SUB-TEST-F3-4" TO PAR-NAME. NC2534.2 +067900 MOVE "050506060000" TO CORR-DATA-2. NC2534.2 +068000 MOVE "999999999999" TO CORR-DATA-3. NC2534.2 +068100 SUB-TEST-F3-4. NC2534.2 +068200 SUBTRACT CORRESPONDING CORR-DATA-2 FROM CORR-DATA-3. NC2534.2 +068300 IF CORR-DATA-3 EQUAL TO "939399999494" NC2534.2 +068400 PERFORM PASS NC2534.2 +068500 GO TO SUB-WRITE-F3-4. NC2534.2 +068600 GO TO SUB-FAIL-F3-4. NC2534.2 +068700 SUB-DELETE-F3-4. NC2534.2 +068800 PERFORM DE-LETE. NC2534.2 +068900 GO TO SUB-WRITE-F3-4. NC2534.2 +069000 SUB-FAIL-F3-4. NC2534.2 +069100 MOVE 939399999494 TO CORRECT-A. NC2534.2 +069200 MOVE CORR-DATA-3 TO COMPUTED-A. NC2534.2 +069300 PERFORM FAIL. NC2534.2 +069400 SUB-WRITE-F3-4. NC2534.2 +069500 PERFORM PRINT-DETAIL. NC2534.2 +069600* NC2534.2 +069700 SUB-INIT-F3-5. NC2534.2 +069800 MOVE "SUB-TEST-F3-5" TO PAR-NAME. NC2534.2 +069900 MOVE 999955995511 TO CORR-DATA-1. NC2534.2 +070000 MOVE 123456107890 TO CORR-DATA-6. NC2534.2 +070100 SUB-TEST-F3-5. NC2534.2 +070200 SUBTRACT CORRESPONDING CORR-DATA-6 FROM CORR-DATA-1. NC2534.2 +070300 IF CORR-DATA-1 EQUAL TO "892155995511" NC2534.2 +070400 PERFORM PASS NC2534.2 +070500 GO TO SUB-WRITE-F3-5. NC2534.2 +070600 GO TO SUB-FAIL-F3-5. NC2534.2 +070700 SUB-DELETE-F3-5. NC2534.2 +070800 PERFORM DE-LETE. NC2534.2 +070900 GO TO SUB-WRITE-F3-5. NC2534.2 +071000 SUB-FAIL-F3-5. NC2534.2 +071100 MOVE 892155995511 TO CORRECT-A. NC2534.2 +071200 MOVE CORR-DATA-1 TO COMPUTED-A. NC2534.2 +071300 PERFORM FAIL. NC2534.2 +071400 SUB-WRITE-F3-5. NC2534.2 +071500 PERFORM PRINT-DETAIL. NC2534.2 +071600* NC2534.2 +071700 SUB-INIT-F3-6. NC2534.2 +071800 MOVE "555555000055" TO CORR-DATA-6. NC2534.2 +071900 MOVE "SUB-TEST-F3-6" TO PAR-NAME. NC2534.2 +072000 SUB-TEST-F3-6. NC2534.2 +072100 SUBTRACT CORRESPONDING CORR-DATA-6 FROM CORR-DATA-1 NC2534.2 +072200 IF CORR-DATA-1 EQUAL TO 892155995511 NC2534.2 +072300 PERFORM PASS NC2534.2 +072400 GO TO SUB-WRITE-F3-6. NC2534.2 +072500 GO TO SUB-FAIL-F3-6. NC2534.2 +072600 SUB-DELETE-F3-6. NC2534.2 +072700 PERFORM DE-LETE. NC2534.2 +072800 GO TO SUB-WRITE-F3-6. NC2534.2 +072900 SUB-FAIL-F3-6. NC2534.2 +073000 MOVE 892155995511 TO CORRECT-A. NC2534.2 +073100 MOVE CORR-DATA-1 TO COMPUTED-A. NC2534.2 +073200 PERFORM FAIL. NC2534.2 +073300 SUB-WRITE-F3-6. NC2534.2 +073400 PERFORM PRINT-DETAIL. NC2534.2 +073500* NC2534.2 +073600 SUB-INIT-F3-7. NC2534.2 +073700 MOVE "SUB-TEST-F3-7" TO PAR-NAME. NC2534.2 +073800 MOVE 99999999999999 TO CORR-DATA-5. NC2534.2 +073900 MOVE 111111111111 TO CORR-DATA-1. NC2534.2 +074000 SUB-TEST-F3-7. NC2534.2 +074100 SUBTRACT CORRESPONDING CORR-DATA-1 FROM CORR-DATA-5. NC2534.2 +074200 IF CORR-DATA-5 EQUAL TO "88889999999999" NC2534.2 +074300 PERFORM PASS NC2534.2 +074400 GO TO SUB-WRITE-F3-7. NC2534.2 +074500 GO TO SUB-FAIL-F3-7. NC2534.2 +074600 SUB-DELETE-F3-7. NC2534.2 +074700 PERFORM DE-LETE. NC2534.2 +074800 GO TO SUB-WRITE-F3-7. NC2534.2 +074900 SUB-FAIL-F3-7. NC2534.2 +075000 PERFORM FAIL. NC2534.2 +075100 MOVE CORR-DATA-5 TO COMPUTED-A. NC2534.2 +075200 MOVE "88889999999999" TO CORRECT-A. NC2534.2 +075300 SUB-WRITE-F3-7. NC2534.2 +075400 PERFORM PRINT-DETAIL. NC2534.2 +075500* NC2534.2 +075600 SUB-INIT-F3-8. NC2534.2 +075700 MOVE "SUB-TEST-F3-8" TO PAR-NAME. NC2534.2 +075800 MOVE "VI-134 6.25.4 GR3" TO ANSI-REFERENCE. NC2534.2 +075900 PERFORM BUILD-TABLE1. NC2534.2 +076000 PERFORM BUILD-TABLE2. NC2534.2 +076100 SUB-TEST-F3-8-0. NC2534.2 +076200 SUBTRACT CORRESPONDING TABLE1 FROM TABLE2. NC2534.2 +076300 SUB-TEST-F3-8-1. NC2534.2 +076400 IF RECORD1 OF TABLE2 = 02 NC2534.2 +076500 AND RECORD2 OF TABLE2 (1) = 03 NC2534.2 +076600 AND RECORD2 OF TABLE2 (2) = 04 NC2534.2 +076700 AND RECORD3 OF TABLE2 = 02 NC2534.2 +076800 PERFORM PASS NC2534.2 +076900 GO TO SUB-WRITE-F3-8. NC2534.2 +077000 GO TO SUB-FAIL-F3-8. NC2534.2 +077100 SUB-DELETE-F3-8. NC2534.2 +077200 PERFORM DE-LETE. NC2534.2 +077300 GO TO SUB-WRITE-F3-8. NC2534.2 +077400 SUB-FAIL-F3-8. NC2534.2 +077500 PERFORM FAIL. NC2534.2 +077600 MOVE TABLE2 TO COMPUTED-A. NC2534.2 +077700 MOVE "02030402" TO CORRECT-A. NC2534.2 +077800 SUB-WRITE-F3-8. NC2534.2 +077900 PERFORM PRINT-DETAIL. NC2534.2 +078000* NC2534.2 +078100 SUB-INIT-F3-9. NC2534.2 +078200* ===--> NO SIZE ERROR <--=== NC2534.2 +078300 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +078400 MOVE SPACE TO WRK-AN-00001. NC2534.2 +078500 MOVE 0 TO REC-CT. NC2534.2 +078600 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +078700 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +078800 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +078900 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +079000 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +079100 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +079200 SUB-TEST-F3-9-0. NC2534.2 +079300 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +079400 ON SIZE ERROR NC2534.2 +079500 MOVE "G" TO WRK-AN-00001. NC2534.2 +079600* NC2534.2 +079700 SUB-INIT-F3-9-1. NC2534.2 +079800 MOVE "SUB-TEST-F3-9-1" TO PAR-NAME. NC2534.2 +079900 ADD 1 TO REC-CT. NC2534.2 +080000 SUB-TEST-F3-9-1. NC2534.2 +080100 IF WRK-AN-00001 NOT = SPACE NC2534.2 +080200 GO TO SUB-FAIL-F3-9-1. NC2534.2 +080300 PERFORM PASS NC2534.2 +080400 GO TO SUB-WRITE-F3-9-1. NC2534.2 +080500 SUB-DELETE-F3-9-1. NC2534.2 +080600 PERFORM DE-LETE. NC2534.2 +080700 GO TO SUB-WRITE-F3-9-1. NC2534.2 +080800 SUB-FAIL-F3-9-1. NC2534.2 +080900 MOVE "SUBTRACT CORRESPONDING FAILED" NC2534.2 +081000 TO RE-MARK NC2534.2 +081100 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +081200 MOVE SPACE TO CORRECT-X NC2534.2 +081300 PERFORM FAIL. NC2534.2 +081400 SUB-WRITE-F3-9-1. NC2534.2 +081500 PERFORM PRINT-DETAIL. NC2534.2 +081600* NC2534.2 +081700 SUB-INIT-F3-9-2. NC2534.2 +081800 MOVE "SUB-TEST-F3-9-2" TO PAR-NAME. NC2534.2 +081900 ADD 1 TO REC-CT. NC2534.2 +082000 SUB-TEST-F3-9-2. NC2534.2 +082100 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +082200 GO TO SUB-FAIL-F3-9-2. NC2534.2 +082300 PERFORM PASS NC2534.2 +082400 GO TO SUB-WRITE-F3-9-2. NC2534.2 +082500 SUB-DELETE-F3-9-2. NC2534.2 +082600 PERFORM DE-LETE. NC2534.2 +082700 GO TO SUB-WRITE-F3-9-2. NC2534.2 +082800 SUB-FAIL-F3-9-2. NC2534.2 +082900 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +083000 MOVE "+1" TO CORRECT-A NC2534.2 +083100 MOVE "SUBTRACT CORRESPONDING FAILED" NC2534.2 +083200 TO RE-MARK NC2534.2 +083300 PERFORM FAIL. NC2534.2 +083400 SUB-WRITE-F3-9-2. NC2534.2 +083500 PERFORM PRINT-DETAIL. NC2534.2 +083600* NC2534.2 +083700 SUB-INIT-F3-9-3. NC2534.2 +083800 MOVE "SUB-TEST-F3-9-3" TO PAR-NAME. NC2534.2 +083900 ADD 1 TO REC-CT. NC2534.2 +084000 SUB-TEST-F3-9-3. NC2534.2 +084100 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +084200 GO TO SUB-FAIL-F3-9-3. NC2534.2 +084300 PERFORM PASS NC2534.2 +084400 GO TO SUB-WRITE-F3-9-3. NC2534.2 +084500 SUB-DELETE-F3-9-3. NC2534.2 +084600 PERFORM DE-LETE. NC2534.2 +084700 GO TO SUB-WRITE-F3-9-3. NC2534.2 +084800 SUB-FAIL-F3-9-3. NC2534.2 +084900 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +085000 MOVE "+1.96" TO CORRECT-A NC2534.2 +085100 MOVE "SUBTRACT CORRESPONDING FAILED" NC2534.2 +085200 TO RE-MARK NC2534.2 +085300 PERFORM FAIL. NC2534.2 +085400 SUB-WRITE-F3-9-3. NC2534.2 +085500 PERFORM PRINT-DETAIL. NC2534.2 +085600* NC2534.2 +085700 SUB-INIT-F3-9-4. NC2534.2 +085800 MOVE "SUB-TEST-F3-9-4" TO PAR-NAME. NC2534.2 +085900 ADD 1 TO REC-CT. NC2534.2 +086000 SUB-TEST-F3-9-4. NC2534.2 +086100 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +086200 GO TO SUB-FAIL-F3-9-4. NC2534.2 +086300 PERFORM PASS NC2534.2 +086400 GO TO SUB-WRITE-F3-9-4. NC2534.2 +086500 SUB-DELETE-F3-9-4. NC2534.2 +086600 PERFORM DE-LETE. NC2534.2 +086700 GO TO SUB-WRITE-F3-9-4. NC2534.2 +086800 SUB-FAIL-F3-9-4. NC2534.2 +086900 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +087000 MOVE "-5.76" TO CORRECT-A NC2534.2 +087100 MOVE "SUBRACT CORRESPONDING FAILED" NC2534.2 +087200 TO RE-MARK NC2534.2 +087300 PERFORM FAIL. NC2534.2 +087400 SUB-WRITE-F3-9-4. NC2534.2 +087500 PERFORM PRINT-DETAIL. NC2534.2 +087600* NC2534.2 +087700 SUB-INIT-F3-10. NC2534.2 +087800* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +087900* ===--> SIZE ERROR <--=== NC2534.2 +088000 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +088100 MOVE SPACE TO WRK-AN-00001. NC2534.2 +088200 MOVE 0 TO REC-CT. NC2534.2 +088300 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +088400 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +088500 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +088600 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +088700 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +088800 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +088900 SUB-TEST-F3-10-0. NC2534.2 +089000 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +089100 NOT ON SIZE ERROR NC2534.2 +089200 MOVE "G" TO WRK-AN-00001. NC2534.2 +089300* NC2534.2 +089400 SUB-INIT-F3-10-1. NC2534.2 +089500 MOVE "SUB-TEST-F3-10-1" TO PAR-NAME. NC2534.2 +089600 ADD 1 TO REC-CT. NC2534.2 +089700 SUB-TEST-F3-10-1. NC2534.2 +089800 IF WRK-AN-00001 EQUAL TO "G" NC2534.2 +089900 GO TO SUB-FAIL-F3-10-1. NC2534.2 +090000 PERFORM PASS NC2534.2 +090100 GO TO SUB-WRITE-F3-10-1. NC2534.2 +090200 SUB-DELETE-F3-10-1. NC2534.2 +090300 PERFORM DE-LETE. NC2534.2 +090400 GO TO SUB-WRITE-F3-10-1. NC2534.2 +090500 SUB-FAIL-F3-10-1. NC2534.2 +090600 MOVE "NOT ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2534.2 +090700 TO RE-MARK NC2534.2 +090800 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +090900 MOVE SPACE TO CORRECT-X NC2534.2 +091000 PERFORM FAIL. NC2534.2 +091100 SUB-WRITE-F3-10-1. NC2534.2 +091200 PERFORM PRINT-DETAIL. NC2534.2 +091300* NC2534.2 +091400 SUB-INIT-F3-10-2. NC2534.2 +091500 MOVE "SUB-TEST-F3-10-2" TO PAR-NAME. NC2534.2 +091600 ADD 1 TO REC-CT. NC2534.2 +091700 SUB-TEST-F3-10-2. NC2534.2 +091800 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +091900 GO TO SUB-FAIL-F3-10-2. NC2534.2 +092000 PERFORM PASS NC2534.2 +092100 GO TO SUB-WRITE-F3-10-2. NC2534.2 +092200 SUB-DELETE-F3-10-2. NC2534.2 +092300 PERFORM DE-LETE. NC2534.2 +092400 GO TO SUB-WRITE-F3-10-2. NC2534.2 +092500 SUB-FAIL-F3-10-2. NC2534.2 +092600 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +092700 MOVE "+1" TO CORRECT-A NC2534.2 +092800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +092900 TO RE-MARK NC2534.2 +093000 PERFORM FAIL. NC2534.2 +093100 SUB-WRITE-F3-10-2. NC2534.2 +093200 PERFORM PRINT-DETAIL. NC2534.2 +093300* NC2534.2 +093400 SUB-INIT-F3-10-3. NC2534.2 +093500 MOVE "SUB-TEST-F3-10-3" TO PAR-NAME. NC2534.2 +093600 ADD 1 TO REC-CT. NC2534.2 +093700 SUB-TEST-F3-10-3. NC2534.2 +093800 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +093900 GO TO SUB-FAIL-F3-10-3. NC2534.2 +094000 PERFORM PASS NC2534.2 +094100 GO TO SUB-WRITE-F3-10-3. NC2534.2 +094200 SUB-DELETE-F3-10-3. NC2534.2 +094300 PERFORM DE-LETE. NC2534.2 +094400 GO TO SUB-WRITE-F3-10-3. NC2534.2 +094500 SUB-FAIL-F3-10-3. NC2534.2 +094600 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +094700 MOVE "+1.96" TO CORRECT-A NC2534.2 +094800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +094900 TO RE-MARK NC2534.2 +095000 PERFORM FAIL. NC2534.2 +095100 SUB-WRITE-F3-10-3. NC2534.2 +095200 PERFORM PRINT-DETAIL. NC2534.2 +095300* NC2534.2 +095400 SUB-INIT-F3-10-4. NC2534.2 +095500 MOVE "SUB-TEST-F3-10-4" TO PAR-NAME. NC2534.2 +095600 ADD 1 TO REC-CT. NC2534.2 +095700 SUB-TEST-F3-10-4. NC2534.2 +095800 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +095900 GO TO SUB-FAIL-F3-10-4. NC2534.2 +096000 PERFORM PASS NC2534.2 +096100 GO TO SUB-WRITE-F3-10-4. NC2534.2 +096200 SUB-DELETE-F3-10-4. NC2534.2 +096300 PERFORM DE-LETE. NC2534.2 +096400 GO TO SUB-WRITE-F3-10-4. NC2534.2 +096500 SUB-FAIL-F3-10-4. NC2534.2 +096600 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +096700 MOVE "+1" TO CORRECT-A NC2534.2 +096800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +096900 PERFORM FAIL. NC2534.2 +097000 SUB-WRITE-F3-10-4. NC2534.2 +097100 PERFORM PRINT-DETAIL. NC2534.2 +097200* NC2534.2 +097300 SUB-INIT-F3-11. NC2534.2 +097400* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +097500* ===--> NO SIZE ERROR <--=== NC2534.2 +097600 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +097700 MOVE SPACE TO WRK-AN-00001. NC2534.2 +097800 MOVE 0 TO REC-CT. NC2534.2 +097900 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +098000 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +098100 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +098200 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +098300 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +098400 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +098500 SUB-TEST-F3-11-0. NC2534.2 +098600 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +098700 NOT ON SIZE ERROR NC2534.2 +098800 MOVE "G" TO WRK-AN-00001. NC2534.2 +098900* NC2534.2 +099000 SUB-INIT-F3-11-1. NC2534.2 +099100 MOVE "SUB-TEST-F3-11-1" TO PAR-NAME. NC2534.2 +099200 ADD 1 TO REC-CT. NC2534.2 +099300 SUB-TEST-F3-11-1. NC2534.2 +099400 IF WRK-AN-00001 EQUAL TO SPACE NC2534.2 +099500 GO TO SUB-FAIL-F3-11-1. NC2534.2 +099600 PERFORM PASS NC2534.2 +099700 GO TO SUB-WRITE-F3-11-1. NC2534.2 +099800 SUB-DELETE-F3-11-1. NC2534.2 +099900 PERFORM DE-LETE. NC2534.2 +100000 GO TO SUB-WRITE-F3-11-1. NC2534.2 +100100 SUB-FAIL-F3-11-1. NC2534.2 +100200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +100300 TO RE-MARK NC2534.2 +100400 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +100500 MOVE "G" TO CORRECT-X NC2534.2 +100600 PERFORM FAIL. NC2534.2 +100700 SUB-WRITE-F3-11-1. NC2534.2 +100800 PERFORM PRINT-DETAIL. NC2534.2 +100900* NC2534.2 +101000 SUB-INIT-F3-11-2. NC2534.2 +101100 MOVE "SUB-TEST-F3-11-1" TO PAR-NAME. NC2534.2 +101200 ADD 1 TO REC-CT. NC2534.2 +101300 SUB-TEST-F3-11-2. NC2534.2 +101400 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +101500 GO TO SUB-FAIL-F3-11-2. NC2534.2 +101600 PERFORM PASS NC2534.2 +101700 GO TO SUB-WRITE-F3-11-2. NC2534.2 +101800 SUB-DELETE-F3-11-2. NC2534.2 +101900 PERFORM DE-LETE. NC2534.2 +102000 GO TO SUB-WRITE-F3-11-2. NC2534.2 +102100 SUB-FAIL-F3-11-2. NC2534.2 +102200 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +102300 MOVE "+1" TO CORRECT-A NC2534.2 +102400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +102500 TO RE-MARK NC2534.2 +102600 PERFORM FAIL. NC2534.2 +102700 SUB-WRITE-F3-11-2. NC2534.2 +102800 PERFORM PRINT-DETAIL. NC2534.2 +102900* NC2534.2 +103000 SUB-INIT-F3-11-3. NC2534.2 +103100 MOVE "SUB-TEST-F3-11-3" TO PAR-NAME. NC2534.2 +103200 ADD 1 TO REC-CT. NC2534.2 +103300 SUB-TEST-F3-11-3. NC2534.2 +103400 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +103500 GO TO SUB-FAIL-F3-11-3. NC2534.2 +103600 PERFORM PASS NC2534.2 +103700 GO TO SUB-WRITE-F3-11-3. NC2534.2 +103800 SUB-DELETE-F3-11-3. NC2534.2 +103900 PERFORM DE-LETE. NC2534.2 +104000 GO TO SUB-WRITE-F3-11-3. NC2534.2 +104100 SUB-FAIL-F3-11-3. NC2534.2 +104200 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +104300 MOVE "+1.96" TO CORRECT-A NC2534.2 +104400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +104500 TO RE-MARK NC2534.2 +104600 PERFORM FAIL. NC2534.2 +104700 SUB-WRITE-F3-11-3. NC2534.2 +104800 PERFORM PRINT-DETAIL. NC2534.2 +104900* NC2534.2 +105000 SUB-INIT-F3-11-4. NC2534.2 +105100 MOVE "SUB-TEST-F3-11-4" TO PAR-NAME. NC2534.2 +105200 ADD 1 TO REC-CT. NC2534.2 +105300 SUB-TEST-F3-11-4. NC2534.2 +105400 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +105500 GO TO SUB-FAIL-F3-11-4. NC2534.2 +105600 PERFORM PASS NC2534.2 +105700 GO TO SUB-WRITE-F3-11-4. NC2534.2 +105800 SUB-DELETE-F3-11-4. NC2534.2 +105900 PERFORM DE-LETE. NC2534.2 +106000 GO TO SUB-WRITE-F3-11-4. NC2534.2 +106100 SUB-FAIL-F3-11-4. NC2534.2 +106200 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +106300 MOVE "-5.76" TO CORRECT-A NC2534.2 +106400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +106500 TO RE-MARK NC2534.2 +106600 PERFORM FAIL. NC2534.2 +106700 SUB-WRITE-F3-11-4. NC2534.2 +106800 PERFORM PRINT-DETAIL. NC2534.2 +106900* NC2534.2 +107000 SUB-INIT-F3-12. NC2534.2 +107100* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +107200* ===--> SIZE ERROR <--=== NC2534.2 +107300 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +107400 MOVE SPACE TO WRK-AN-00001. NC2534.2 +107500 MOVE 0 TO REC-CT. NC2534.2 +107600 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +107700 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +107800 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +107900 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +108000 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +108100 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +108200 SUB-TEST-F3-12-0. NC2534.2 +108300 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +108400 ON SIZE ERROR NC2534.2 +108500 MOVE "A" TO WRK-AN-00001 NC2534.2 +108600 NOT ON SIZE ERROR NC2534.2 +108700 MOVE "B" TO WRK-AN-00001. NC2534.2 +108800* NC2534.2 +108900 SUB-INIT-F3-12-1. NC2534.2 +109000 MOVE "SUB-TEST-F3-12-1" TO PAR-NAME. NC2534.2 +109100 ADD 1 TO REC-CT. NC2534.2 +109200 SUB-TEST-F3-12-1. NC2534.2 +109300 IF WRK-AN-00001 NOT = "A" NC2534.2 +109400 GO TO SUB-FAIL-F3-12-1. NC2534.2 +109500 PERFORM PASS NC2534.2 +109600 GO TO SUB-WRITE-F3-12-1. NC2534.2 +109700 SUB-DELETE-F3-12-1. NC2534.2 +109800 PERFORM DE-LETE. NC2534.2 +109900 GO TO SUB-WRITE-F3-12-1. NC2534.2 +110000 SUB-FAIL-F3-12-1. NC2534.2 +110100 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +110200 TO RE-MARK NC2534.2 +110300 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +110400 MOVE "A" TO CORRECT-X NC2534.2 +110500 PERFORM FAIL. NC2534.2 +110600 SUB-WRITE-F3-12-1. NC2534.2 +110700 PERFORM PRINT-DETAIL. NC2534.2 +110800* NC2534.2 +110900 SUB-INIT-F3-12-2. NC2534.2 +111000 MOVE "SUB-TEST-F3-12-2" TO PAR-NAME. NC2534.2 +111100 ADD 1 TO REC-CT. NC2534.2 +111200 SUB-TEST-F3-12-2. NC2534.2 +111300 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +111400 GO TO SUB-FAIL-F3-12-2. NC2534.2 +111500 PERFORM PASS NC2534.2 +111600 GO TO SUB-WRITE-F3-12-2. NC2534.2 +111700 SUB-DELETE-F3-12-2. NC2534.2 +111800 PERFORM DE-LETE. NC2534.2 +111900 GO TO SUB-WRITE-F3-12-2. NC2534.2 +112000 SUB-FAIL-F3-12-2. NC2534.2 +112100 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +112200 MOVE "+1" TO CORRECT-A NC2534.2 +112300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +112400 TO RE-MARK NC2534.2 +112500 PERFORM FAIL. NC2534.2 +112600 SUB-WRITE-F3-12-2. NC2534.2 +112700 PERFORM PRINT-DETAIL. NC2534.2 +112800* NC2534.2 +112900 SUB-INIT-F3-12-3. NC2534.2 +113000 MOVE "SUB-TEST-F3-12-3" TO PAR-NAME. NC2534.2 +113100 ADD 1 TO REC-CT. NC2534.2 +113200 SUB-TEST-F3-12-3. NC2534.2 +113300 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +113400 GO TO SUB-FAIL-F3-12-3. NC2534.2 +113500 PERFORM PASS NC2534.2 +113600 GO TO SUB-WRITE-F3-12-3. NC2534.2 +113700 SUB-DELETE-F3-12-3. NC2534.2 +113800 PERFORM DE-LETE. NC2534.2 +113900 GO TO SUB-WRITE-F3-12-3. NC2534.2 +114000 SUB-FAIL-F3-12-3. NC2534.2 +114100 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +114200 MOVE "+1.96" TO CORRECT-A NC2534.2 +114300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +114400 TO RE-MARK NC2534.2 +114500 PERFORM FAIL. NC2534.2 +114600 SUB-WRITE-F3-12-3. NC2534.2 +114700 PERFORM PRINT-DETAIL. NC2534.2 +114800* NC2534.2 +114900 SUB-INIT-F3-12-4. NC2534.2 +115000 MOVE "SUB-TEST-F3-12-4" TO PAR-NAME. NC2534.2 +115100 ADD 1 TO REC-CT. NC2534.2 +115200 SUB-TEST-F3-12-4. NC2534.2 +115300 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +115400 GO TO SUB-FAIL-F3-12-4. NC2534.2 +115500 PERFORM PASS NC2534.2 +115600 GO TO SUB-WRITE-F3-12-4. NC2534.2 +115700 SUB-DELETE-F3-12-4. NC2534.2 +115800 PERFORM DE-LETE. NC2534.2 +115900 GO TO SUB-WRITE-F3-12-4. NC2534.2 +116000 SUB-FAIL-F3-12-4. NC2534.2 +116100 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +116200 MOVE "+1" TO CORRECT-A NC2534.2 +116300 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +116400 PERFORM FAIL. NC2534.2 +116500 SUB-WRITE-F3-12-4. NC2534.2 +116600 PERFORM PRINT-DETAIL. NC2534.2 +116700* NC2534.2 +116800 SUB-INIT-F3-13. NC2534.2 +116900* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +117000* ===--> NO SIZE ERROR <--=== NC2534.2 +117100 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +117200 MOVE SPACE TO WRK-AN-00001. NC2534.2 +117300 MOVE 0 TO REC-CT. NC2534.2 +117400 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +117500 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +117600 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +117700 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +117800 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +117900 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +118000 SUB-TEST-F3-13-0. NC2534.2 +118100 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +118200 ON SIZE ERROR NC2534.2 +118300 MOVE "A" TO WRK-AN-00001 NC2534.2 +118400 NOT ON SIZE ERROR NC2534.2 +118500 MOVE "B" TO WRK-AN-00001. NC2534.2 +118600* NC2534.2 +118700 SUB-INIT-F3-13-1. NC2534.2 +118800 MOVE "SUB-TEST-F3-13-1" TO PAR-NAME. NC2534.2 +118900 ADD 1 TO REC-CT. NC2534.2 +119000 SUB-TEST-F3-13-1. NC2534.2 +119100 IF WRK-AN-00001 NOT = "B" NC2534.2 +119200 GO TO SUB-FAIL-F3-13-1. NC2534.2 +119300 PERFORM PASS NC2534.2 +119400 GO TO SUB-WRITE-F3-13-1. NC2534.2 +119500 SUB-DELETE-F3-13-1. NC2534.2 +119600 PERFORM DE-LETE. NC2534.2 +119700 GO TO SUB-WRITE-F3-13-1. NC2534.2 +119800 SUB-FAIL-F3-13-1. NC2534.2 +119900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +120000 TO RE-MARK NC2534.2 +120100 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +120200 MOVE "B" TO CORRECT-X NC2534.2 +120300 PERFORM FAIL. NC2534.2 +120400 SUB-WRITE-F3-13-1. NC2534.2 +120500 PERFORM PRINT-DETAIL. NC2534.2 +120600* NC2534.2 +120700 SUB-INIT-F3-13-2. NC2534.2 +120800 MOVE "SUB-TEST-F3-13-2" TO PAR-NAME. NC2534.2 +120900 ADD 1 TO REC-CT. NC2534.2 +121000 SUB-TEST-F3-13-2. NC2534.2 +121100 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +121200 GO TO SUB-FAIL-F3-13-2. NC2534.2 +121300 PERFORM PASS NC2534.2 +121400 GO TO SUB-WRITE-F3-13-2. NC2534.2 +121500 SUB-DELETE-F3-13-2. NC2534.2 +121600 PERFORM DE-LETE. NC2534.2 +121700 GO TO SUB-WRITE-F3-13-2. NC2534.2 +121800 SUB-FAIL-F3-13-2. NC2534.2 +121900 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +122000 MOVE "+1" TO CORRECT-A NC2534.2 +122100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND"NC2534.2 +122200 TO RE-MARK NC2534.2 +122300 PERFORM FAIL. NC2534.2 +122400 SUB-WRITE-F3-13-2. NC2534.2 +122500 PERFORM PRINT-DETAIL. NC2534.2 +122600* NC2534.2 +122700 SUB-INIT-F3-13-3. NC2534.2 +122800 MOVE "SUB-TEST-F3-13-3" TO PAR-NAME. NC2534.2 +122900 ADD 1 TO REC-CT. NC2534.2 +123000 SUB-TEST-F3-13-3. NC2534.2 +123100 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +123200 GO TO SUB-FAIL-F3-13-3. NC2534.2 +123300 PERFORM PASS NC2534.2 +123400 GO TO SUB-WRITE-F3-13-3. NC2534.2 +123500 SUB-DELETE-F3-13-3. NC2534.2 +123600 PERFORM DE-LETE. NC2534.2 +123700 GO TO SUB-WRITE-F3-13-3. NC2534.2 +123800 SUB-FAIL-F3-13-3. NC2534.2 +123900 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +124000 MOVE "+1.96" TO CORRECT-A NC2534.2 +124100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +124200 TO RE-MARK NC2534.2 +124300 PERFORM FAIL. NC2534.2 +124400 SUB-WRITE-F3-13-3. NC2534.2 +124500 PERFORM PRINT-DETAIL. NC2534.2 +124600* NC2534.2 +124700 SUB-INIT-F3-13-4. NC2534.2 +124800 MOVE "SUB-TEST-F3-13-4" TO PAR-NAME. NC2534.2 +124900 ADD 1 TO REC-CT. NC2534.2 +125000 SUB-TEST-F3-13-4. NC2534.2 +125100 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +125200 GO TO SUB-FAIL-F3-13-4. NC2534.2 +125300 PERFORM PASS NC2534.2 +125400 GO TO SUB-WRITE-F3-13-4. NC2534.2 +125500 SUB-FAIL-F3-13-4. NC2534.2 +125600 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +125700 MOVE "-5.76" TO CORRECT-A NC2534.2 +125800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +125900 TO RE-MARK NC2534.2 +126000 PERFORM FAIL. NC2534.2 +126100 SUB-WRITE-F3-13-4. NC2534.2 +126200 PERFORM PRINT-DETAIL. NC2534.2 +126300* NC2534.2 +126400 SUB-INIT-F3-14. NC2534.2 +126500* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +126600* ===--> SIZE ERROR <--=== NC2534.2 +126700 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +126800 MOVE SPACE TO WRK-AN-00001. NC2534.2 +126900 MOVE SPACE TO WRK-XN-00001. NC2534.2 +127000 MOVE 0 TO REC-CT. NC2534.2 +127100 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +127200 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +127300 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +127400 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +127500 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +127600 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +127700 SUB-TEST-F3-14-0. NC2534.2 +127800 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +127900 ON SIZE ERROR NC2534.2 +128000 MOVE "A" TO WRK-AN-00001 NC2534.2 +128100 END-SUBTRACT NC2534.2 +128200 MOVE "Z" TO WRK-XN-00001. NC2534.2 +128300* NC2534.2 +128400 SUB-INIT-F3-14-1. NC2534.2 +128500 MOVE "SUB-TEST-F3-14-1" TO PAR-NAME. NC2534.2 +128600 ADD 1 TO REC-CT. NC2534.2 +128700 SUB-TEST-F3-14-1. NC2534.2 +128800 IF WRK-AN-00001 NOT = "A" NC2534.2 +128900 GO TO SUB-FAIL-F3-14-1. NC2534.2 +129000 PERFORM PASS NC2534.2 +129100 GO TO SUB-WRITE-F3-14-1. NC2534.2 +129200 SUB-DELETE-F3-14-1. NC2534.2 +129300 PERFORM DE-LETE. NC2534.2 +129400 GO TO SUB-WRITE-F3-14-1. NC2534.2 +129500 SUB-FAIL-F3-14-1. NC2534.2 +129600 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +129700 TO RE-MARK NC2534.2 +129800 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +129900 MOVE "A" TO CORRECT-X NC2534.2 +130000 PERFORM FAIL. NC2534.2 +130100 SUB-WRITE-F3-14-1. NC2534.2 +130200 PERFORM PRINT-DETAIL. NC2534.2 +130300* NC2534.2 +130400 SUB-INIT-F3-14-2. NC2534.2 +130500 MOVE "SUB-TEST-F3-14-2" TO PAR-NAME. NC2534.2 +130600 ADD 1 TO REC-CT. NC2534.2 +130700 SUB-TEST-F3-14-2. NC2534.2 +130800 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +130900 GO TO SUB-FAIL-F3-14-2. NC2534.2 +131000 PERFORM PASS NC2534.2 +131100 GO TO SUB-WRITE-F3-14-2. NC2534.2 +131200 SUB-DELETE-F3-14-2. NC2534.2 +131300 PERFORM DE-LETE. NC2534.2 +131400 GO TO SUB-WRITE-F3-14-2. NC2534.2 +131500 SUB-FAIL-F3-14-2. NC2534.2 +131600 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +131700 MOVE "+1" TO CORRECT-A NC2534.2 +131800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +131900 TO RE-MARK NC2534.2 +132000 PERFORM FAIL. NC2534.2 +132100 SUB-WRITE-F3-14-2. NC2534.2 +132200 PERFORM PRINT-DETAIL. NC2534.2 +132300* NC2534.2 +132400 SUB-INIT-F3-14-3. NC2534.2 +132500 MOVE "SUB-TEST-F3-14-3" TO PAR-NAME. NC2534.2 +132600 ADD 1 TO REC-CT. NC2534.2 +132700 SUB-TEST-F3-14-3. NC2534.2 +132800 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +132900 GO TO SUB-FAIL-F3-14-3. NC2534.2 +133000 PERFORM PASS NC2534.2 +133100 GO TO SUB-WRITE-F3-14-3. NC2534.2 +133200 SUB-DELETE-F3-14-3. NC2534.2 +133300 PERFORM DE-LETE. NC2534.2 +133400 GO TO SUB-WRITE-F3-14-3. NC2534.2 +133500 SUB-FAIL-F3-14-3. NC2534.2 +133600 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +133700 MOVE "+1.96" TO CORRECT-A NC2534.2 +133800 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +133900 TO RE-MARK NC2534.2 +134000 PERFORM FAIL. NC2534.2 +134100 SUB-WRITE-F3-14-3. NC2534.2 +134200 PERFORM PRINT-DETAIL. NC2534.2 +134300* NC2534.2 +134400 SUB-INIT-F3-14-4. NC2534.2 +134500 MOVE "SUB-TEST-F3-14-4" TO PAR-NAME. NC2534.2 +134600 ADD 1 TO REC-CT. NC2534.2 +134700 SUB-TEST-F3-14-4. NC2534.2 +134800 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +134900 GO TO SUB-FAIL-F3-14-4. NC2534.2 +135000 PERFORM PASS NC2534.2 +135100 GO TO SUB-WRITE-F3-14-4. NC2534.2 +135200 SUB-DELETE-F3-14-4. NC2534.2 +135300 PERFORM DE-LETE. NC2534.2 +135400 GO TO SUB-WRITE-F3-14-4. NC2534.2 +135500 SUB-FAIL-F3-14-4. NC2534.2 +135600 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +135700 MOVE "+1" TO CORRECT-A NC2534.2 +135800 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +135900 PERFORM FAIL. NC2534.2 +136000 SUB-WRITE-F3-14-4. NC2534.2 +136100 PERFORM PRINT-DETAIL. NC2534.2 +136200* NC2534.2 +136300 SUB-INIT-F3-14-5. NC2534.2 +136400 MOVE "SUB-TEST-F3-14-5" TO PAR-NAME. NC2534.2 +136500 ADD 1 TO REC-CT. NC2534.2 +136600 SUB-TEST-F3-14-5. NC2534.2 +136700 IF WRK-XN-00001 NOT = "Z" NC2534.2 +136800 GO TO SUB-FAIL-F3-14-5. NC2534.2 +136900 PERFORM PASS NC2534.2 +137000 GO TO SUB-WRITE-F3-14-5. NC2534.2 +137100 SUB-DELETE-F3-14-5. NC2534.2 +137200 PERFORM DE-LETE. NC2534.2 +137300 GO TO SUB-WRITE-F3-14-5. NC2534.2 +137400 SUB-FAIL-F3-14-5. NC2534.2 +137500 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +137600 MOVE "Z" TO COMPUTED-X NC2534.2 +137700 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +137800 PERFORM FAIL. NC2534.2 +137900 SUB-WRITE-F3-14-5. NC2534.2 +138000 PERFORM PRINT-DETAIL. NC2534.2 +138100* NC2534.2 +138200 SUB-INIT-F3-15. NC2534.2 +138300* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +138400* ===--> NO SIZE ERROR <--=== NC2534.2 +138500 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +138600 MOVE SPACE TO WRK-AN-00001. NC2534.2 +138700 MOVE SPACE TO WRK-XN-00001. NC2534.2 +138800 MOVE 0 TO REC-CT. NC2534.2 +138900 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +139000 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +139100 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +139200 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +139300 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +139400 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +139500 SUB-TEST-F3-15-0. NC2534.2 +139600 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +139700 ON SIZE ERROR NC2534.2 +139800 MOVE "A" TO WRK-AN-00001 NC2534.2 +139900 END-SUBTRACT NC2534.2 +140000 MOVE "Z" TO WRK-XN-00001. NC2534.2 +140100* NC2534.2 +140200 SUB-INIT-F3-15-1. NC2534.2 +140300 MOVE "SUB-TEST-F3-15-1" TO PAR-NAME. NC2534.2 +140400 ADD 1 TO REC-CT. NC2534.2 +140500 SUB-TEST-F3-15-1. NC2534.2 +140600 IF WRK-AN-00001 = "A" NC2534.2 +140700 GO TO SUB-FAIL-F3-15-1. NC2534.2 +140800 PERFORM PASS NC2534.2 +140900 GO TO SUB-WRITE-F3-15-1. NC2534.2 +141000 SUB-FAIL-F3-15-1. NC2534.2 +141100 MOVE "ON SIZE ERROR SHOULD NOT BE EXECUTED" NC2534.2 +141200 TO RE-MARK NC2534.2 +141300 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +141400 MOVE SPACE TO CORRECT-X NC2534.2 +141500 PERFORM FAIL. NC2534.2 +141600 SUB-WRITE-F3-15-1. NC2534.2 +141700 PERFORM PRINT-DETAIL. NC2534.2 +141800* NC2534.2 +141900 SUB-INIT-F3-15-2. NC2534.2 +142000 MOVE "SUB-TEST-F3-15-2" TO PAR-NAME. NC2534.2 +142100 ADD 1 TO REC-CT. NC2534.2 +142200 SUB-TEST-F3-15-2. NC2534.2 +142300 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +142400 GO TO SUB-FAIL-F3-15-2. NC2534.2 +142500 PERFORM PASS NC2534.2 +142600 GO TO SUB-WRITE-F3-15-2. NC2534.2 +142700 SUB-DELETE-F3-15-2. NC2534.2 +142800 PERFORM DE-LETE. NC2534.2 +142900 GO TO SUB-WRITE-F3-15-2. NC2534.2 +143000 SUB-FAIL-F3-15-2. NC2534.2 +143100 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +143200 MOVE "+1" TO CORRECT-A NC2534.2 +143300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +143400 TO RE-MARK NC2534.2 +143500 PERFORM FAIL. NC2534.2 +143600 SUB-WRITE-F3-15-2. NC2534.2 +143700 PERFORM PRINT-DETAIL. NC2534.2 +143800* NC2534.2 +143900 SUB-INIT-F3-15-3. NC2534.2 +144000 MOVE "SUB-TEST-F3-15-3" TO PAR-NAME. NC2534.2 +144100 ADD 1 TO REC-CT. NC2534.2 +144200 SUB-TEST-F3-15-3. NC2534.2 +144300 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +144400 GO TO SUB-FAIL-F3-15-3. NC2534.2 +144500 PERFORM PASS NC2534.2 +144600 GO TO SUB-WRITE-F3-15-3. NC2534.2 +144700 SUB-DELETE-F3-15-3. NC2534.2 +144800 PERFORM DE-LETE. NC2534.2 +144900 GO TO SUB-WRITE-F3-15-3. NC2534.2 +145000 SUB-FAIL-F3-15-3. NC2534.2 +145100 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +145200 MOVE "+1.96" TO CORRECT-A NC2534.2 +145300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +145400 TO RE-MARK NC2534.2 +145500 PERFORM FAIL. NC2534.2 +145600 SUB-WRITE-F3-15-3. NC2534.2 +145700 PERFORM PRINT-DETAIL. NC2534.2 +145800* NC2534.2 +145900 SUB-INIT-F3-15-4. NC2534.2 +146000 MOVE "SUB-TEST-F3-15-4" TO PAR-NAME. NC2534.2 +146100 ADD 1 TO REC-CT. NC2534.2 +146200 SUB-TEST-F3-15-4. NC2534.2 +146300 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +146400 GO TO SUB-FAIL-F3-15-4. NC2534.2 +146500 PERFORM PASS NC2534.2 +146600 GO TO SUB-WRITE-F3-15-4. NC2534.2 +146700 SUB-DELETE-F3-15-4. NC2534.2 +146800 PERFORM DE-LETE. NC2534.2 +146900 GO TO SUB-WRITE-F3-15-4. NC2534.2 +147000 SUB-FAIL-F3-15-4. NC2534.2 +147100 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +147200 MOVE "-5.76" TO CORRECT-A NC2534.2 +147300 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +147400 TO RE-MARK NC2534.2 +147500 PERFORM FAIL. NC2534.2 +147600 SUB-WRITE-F3-15-4. NC2534.2 +147700 PERFORM PRINT-DETAIL. NC2534.2 +147800* NC2534.2 +147900 SUB-INIT-F3-15-5. NC2534.2 +148000 MOVE "SUB-TEST-F3-15-5" TO PAR-NAME. NC2534.2 +148100 ADD 1 TO REC-CT. NC2534.2 +148200 SUB-TEST-F3-15-5. NC2534.2 +148300 IF WRK-XN-00001 NOT = "Z" NC2534.2 +148400 GO TO SUB-FAIL-F3-15-5. NC2534.2 +148500 PERFORM PASS NC2534.2 +148600 GO TO SUB-WRITE-F3-15-5. NC2534.2 +148700 SUB-DELETE-F3-15-5. NC2534.2 +148800 PERFORM DE-LETE. NC2534.2 +148900 GO TO SUB-WRITE-F3-15-5. NC2534.2 +149000 SUB-FAIL-F3-15-5. NC2534.2 +149100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +149200 MOVE "Z" TO COMPUTED-X NC2534.2 +149300 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +149400 PERFORM FAIL. NC2534.2 +149500 SUB-WRITE-F3-15-5. NC2534.2 +149600 PERFORM PRINT-DETAIL. NC2534.2 +149700* NC2534.2 +149800 SUB-INIT-F3-16. NC2534.2 +149900* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +150000* ===--> SIZE ERROR <--=== NC2534.2 +150100 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +150200 MOVE SPACE TO WRK-AN-00001. NC2534.2 +150300 MOVE SPACE TO WRK-XN-00001. NC2534.2 +150400 MOVE 0 TO REC-CT. NC2534.2 +150500 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +150600 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +150700 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +150800 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +150900 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +151000 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +151100 SUB-TEST-F3-16-0. NC2534.2 +151200 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +151300 ON SIZE ERROR NC2534.2 +151400 MOVE "A" TO WRK-AN-00001 NC2534.2 +151500 NOT ON SIZE ERROR NC2534.2 +151600 MOVE "B" TO WRK-AN-00001 NC2534.2 +151700 END-SUBTRACT NC2534.2 +151800 MOVE "Z" TO WRK-XN-00001. NC2534.2 +151900* NC2534.2 +152000 SUB-INIT-F3-16-1. NC2534.2 +152100 MOVE "SUB-TEST-F3-16-1" TO PAR-NAME. NC2534.2 +152200 ADD 1 TO REC-CT. NC2534.2 +152300 SUB-TEST-F3-16-1. NC2534.2 +152400 IF WRK-AN-00001 NOT = "A" NC2534.2 +152500 GO TO SUB-FAIL-F3-16-1. NC2534.2 +152600 PERFORM PASS NC2534.2 +152700 GO TO SUB-WRITE-F3-16-1. NC2534.2 +152800 SUB-DELETE-F3-16-1. NC2534.2 +152900 PERFORM DE-LETE. NC2534.2 +153000 GO TO SUB-WRITE-F3-16-1. NC2534.2 +153100 SUB-FAIL-F3-16-1. NC2534.2 +153200 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +153300 TO RE-MARK NC2534.2 +153400 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +153500 MOVE "A" TO CORRECT-X NC2534.2 +153600 PERFORM FAIL. NC2534.2 +153700 SUB-WRITE-F3-16-1. NC2534.2 +153800 PERFORM PRINT-DETAIL. NC2534.2 +153900* NC2534.2 +154000 SUB-INIT-F3-16-2. NC2534.2 +154100 MOVE "SUB-TEST-F3-16-2" TO PAR-NAME. NC2534.2 +154200 ADD 1 TO REC-CT. NC2534.2 +154300 SUB-TEST-F3-16-2. NC2534.2 +154400 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +154500 GO TO SUB-FAIL-F3-16-2. NC2534.2 +154600 PERFORM PASS NC2534.2 +154700 GO TO SUB-WRITE-F3-16-2. NC2534.2 +154800 SUB-DELETE-F3-16-2. NC2534.2 +154900 PERFORM DE-LETE. NC2534.2 +155000 GO TO SUB-WRITE-F3-16-2. NC2534.2 +155100 SUB-FAIL-F3-16-2. NC2534.2 +155200 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +155300 MOVE "+1" TO CORRECT-A NC2534.2 +155400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +155500 TO RE-MARK NC2534.2 +155600 PERFORM FAIL. NC2534.2 +155700 SUB-WRITE-F3-16-2. NC2534.2 +155800 PERFORM PRINT-DETAIL. NC2534.2 +155900* NC2534.2 +156000 SUB-INIT-F3-16-3. NC2534.2 +156100 MOVE "SUB-TEST-F3-16-3" TO PAR-NAME. NC2534.2 +156200 ADD 1 TO REC-CT. NC2534.2 +156300 SUB-TEST-F3-16-3. NC2534.2 +156400 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +156500 GO TO SUB-FAIL-F3-16-3. NC2534.2 +156600 PERFORM PASS NC2534.2 +156700 GO TO SUB-WRITE-F3-16-3. NC2534.2 +156800 SUB-DELETE-F3-16-3. NC2534.2 +156900 PERFORM DE-LETE. NC2534.2 +157000 GO TO SUB-WRITE-F3-16-3. NC2534.2 +157100 SUB-FAIL-F3-16-3. NC2534.2 +157200 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +157300 MOVE "+1.96" TO CORRECT-A NC2534.2 +157400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +157500 TO RE-MARK NC2534.2 +157600 PERFORM FAIL. NC2534.2 +157700 SUB-WRITE-F3-16-3. NC2534.2 +157800 PERFORM PRINT-DETAIL. NC2534.2 +157900* NC2534.2 +158000 SUB-INIT-F3-16-4. NC2534.2 +158100 MOVE "SUB-TEST-F3-16-4" TO PAR-NAME. NC2534.2 +158200 ADD 1 TO REC-CT. NC2534.2 +158300 SUB-TEST-F3-16-4. NC2534.2 +158400 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +158500 GO TO SUB-FAIL-F3-16-4. NC2534.2 +158600 PERFORM PASS NC2534.2 +158700 GO TO SUB-WRITE-F3-16-4. NC2534.2 +158800 SUB-DELETE-F3-16-4. NC2534.2 +158900 PERFORM DE-LETE. NC2534.2 +159000 GO TO SUB-WRITE-F3-16-4. NC2534.2 +159100 SUB-FAIL-F3-16-4. NC2534.2 +159200 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +159300 MOVE "+1" TO CORRECT-A NC2534.2 +159400 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +159500 PERFORM FAIL. NC2534.2 +159600 SUB-WRITE-F3-16-4. NC2534.2 +159700 PERFORM PRINT-DETAIL. NC2534.2 +159800* NC2534.2 +159900 SUB-INIT-F3-16-5. NC2534.2 +160000 MOVE "SUB-TEST-F3-16-5" TO PAR-NAME. NC2534.2 +160100 ADD 1 TO REC-CT. NC2534.2 +160200 SUB-TEST-F3-16-5. NC2534.2 +160300 IF WRK-XN-00001 NOT = "Z" NC2534.2 +160400 GO TO SUB-FAIL-F3-16-5. NC2534.2 +160500 PERFORM PASS NC2534.2 +160600 GO TO SUB-WRITE-F3-16-5. NC2534.2 +160700 SUB-DELETE-F3-16-5. NC2534.2 +160800 PERFORM DE-LETE. NC2534.2 +160900 GO TO SUB-WRITE-F3-16-5. NC2534.2 +161000 SUB-FAIL-F3-16-5. NC2534.2 +161100 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +161200 MOVE "Z" TO COMPUTED-X NC2534.2 +161300 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +161400 PERFORM FAIL. NC2534.2 +161500 SUB-WRITE-F3-16-5. NC2534.2 +161600 PERFORM PRINT-DETAIL. NC2534.2 +161700* NC2534.2 +161800 SUB-INIT-F3-17. NC2534.2 +161900* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +162000* ===--> NO SIZE ERROR <--=== NC2534.2 +162100 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +162200 MOVE SPACE TO WRK-AN-00001. NC2534.2 +162300 MOVE SPACE TO WRK-XN-00001. NC2534.2 +162400 MOVE 0 TO REC-CT. NC2534.2 +162500 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +162600 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +162700 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +162800 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +162900 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +163000 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +163100 SUB-TEST-F3-17-0. NC2534.2 +163200 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +163300 ON SIZE ERROR NC2534.2 +163400 MOVE "A" TO WRK-AN-00001 NC2534.2 +163500 NOT ON SIZE ERROR NC2534.2 +163600 MOVE "B" TO WRK-AN-00001 NC2534.2 +163700 END-SUBTRACT NC2534.2 +163800 MOVE "Z" TO WRK-XN-00001. NC2534.2 +163900* NC2534.2 +164000 SUB-INIT-F3-17-1. NC2534.2 +164100 MOVE "SUB-TEST-F3-17-1" TO PAR-NAME. NC2534.2 +164200 ADD 1 TO REC-CT. NC2534.2 +164300 SUB-TEST-F3-17-1. NC2534.2 +164400 IF WRK-AN-00001 NOT = "B" NC2534.2 +164500 GO TO SUB-FAIL-F3-17-1. NC2534.2 +164600 PERFORM PASS NC2534.2 +164700 GO TO SUB-WRITE-F3-17-1. NC2534.2 +164800 SUB-DELETE-F3-17-1. NC2534.2 +164900 PERFORM DE-LETE. NC2534.2 +165000 GO TO SUB-WRITE-F3-17-1. NC2534.2 +165100 SUB-FAIL-F3-17-1. NC2534.2 +165200 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +165300 TO RE-MARK NC2534.2 +165400 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +165500 MOVE "B" TO CORRECT-X NC2534.2 +165600 PERFORM FAIL. NC2534.2 +165700 SUB-WRITE-F3-17-1. NC2534.2 +165800 PERFORM PRINT-DETAIL. NC2534.2 +165900* NC2534.2 +166000 SUB-INIT-F3-17-2. NC2534.2 +166100 MOVE "SUB-TEST-F3-17-2" TO PAR-NAME. NC2534.2 +166200 ADD 1 TO REC-CT. NC2534.2 +166300 SUB-TEST-F3-17-2. NC2534.2 +166400 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +166500 GO TO SUB-FAIL-F3-17-2. NC2534.2 +166600 PERFORM PASS NC2534.2 +166700 GO TO SUB-WRITE-F3-17-2. NC2534.2 +166800 SUB-DELETE-F3-17-2. NC2534.2 +166900 PERFORM DE-LETE. NC2534.2 +167000 GO TO SUB-WRITE-F3-17-2. NC2534.2 +167100 SUB-FAIL-F3-17-2. NC2534.2 +167200 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +167300 MOVE "+1" TO CORRECT-A NC2534.2 +167400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +167500 TO RE-MARK NC2534.2 +167600 PERFORM FAIL. NC2534.2 +167700 SUB-WRITE-F3-17-2. NC2534.2 +167800 PERFORM PRINT-DETAIL. NC2534.2 +167900* NC2534.2 +168000 SUB-INIT-F3-17-3. NC2534.2 +168100 MOVE "SUB-TEST-F3-17-3" TO PAR-NAME. NC2534.2 +168200 ADD 1 TO REC-CT. NC2534.2 +168300 SUB-TEST-F3-17-3. NC2534.2 +168400 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +168500 GO TO SUB-FAIL-F3-17-3. NC2534.2 +168600 PERFORM PASS NC2534.2 +168700 GO TO SUB-WRITE-F3-17-3. NC2534.2 +168800 SUB-DELETE-F3-17-3. NC2534.2 +168900 PERFORM DE-LETE. NC2534.2 +169000 GO TO SUB-WRITE-F3-17-3. NC2534.2 +169100 SUB-FAIL-F3-17-3. NC2534.2 +169200 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +169300 MOVE "+1.96" TO CORRECT-A NC2534.2 +169400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +169500 TO RE-MARK NC2534.2 +169600 PERFORM FAIL. NC2534.2 +169700 SUB-WRITE-F3-17-3. NC2534.2 +169800 PERFORM PRINT-DETAIL. NC2534.2 +169900* NC2534.2 +170000 SUB-INIT-F3-17-4. NC2534.2 +170100 MOVE "SUB-TEST-F3-17-4" TO PAR-NAME. NC2534.2 +170200 ADD 1 TO REC-CT. NC2534.2 +170300 SUB-TEST-F3-17-4. NC2534.2 +170400 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +170500 GO TO SUB-FAIL-F3-17-4. NC2534.2 +170600 PERFORM PASS NC2534.2 +170700 GO TO SUB-WRITE-F3-17-4. NC2534.2 +170800 SUB-DELETE-F3-17-4. NC2534.2 +170900 PERFORM DE-LETE. NC2534.2 +171000 GO TO SUB-WRITE-F3-17-4. NC2534.2 +171100 SUB-FAIL-F3-17-4. NC2534.2 +171200 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +171300 MOVE "-5.76" TO CORRECT-A NC2534.2 +171400 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +171500 TO RE-MARK NC2534.2 +171600 PERFORM FAIL. NC2534.2 +171700 SUB-WRITE-F3-17-4. NC2534.2 +171800 PERFORM PRINT-DETAIL. NC2534.2 +171900* NC2534.2 +172000 SUB-INIT-F3-17-5. NC2534.2 +172100 MOVE "SUB-TEST-F3-17-5" TO PAR-NAME. NC2534.2 +172200 ADD 1 TO REC-CT. NC2534.2 +172300 SUB-TEST-F3-17-5. NC2534.2 +172400 IF WRK-XN-00001 NOT = "Z" NC2534.2 +172500 GO TO SUB-FAIL-F3-17-5. NC2534.2 +172600 PERFORM PASS NC2534.2 +172700 GO TO SUB-WRITE-F3-17-5. NC2534.2 +172800 SUB-DELETE-F3-17-5. NC2534.2 +172900 PERFORM DE-LETE. NC2534.2 +173000 GO TO SUB-WRITE-F3-17-5. NC2534.2 +173100 SUB-FAIL-F3-17-5. NC2534.2 +173200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +173300 MOVE "Z" TO COMPUTED-X NC2534.2 +173400 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +173500 PERFORM FAIL. NC2534.2 +173600 SUB-WRITE-F3-17-5. NC2534.2 +173700 PERFORM PRINT-DETAIL. NC2534.2 +173800* NC2534.2 +173900 SUB-INIT-F3-18. NC2534.2 +174000* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +174100* ===--> SIZE ERROR <--=== NC2534.2 +174200 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +174300 MOVE SPACE TO WRK-AN-00001. NC2534.2 +174400 MOVE SPACE TO WRK-XN-00001. NC2534.2 +174500 MOVE 0 TO REC-CT. NC2534.2 +174600 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +174700 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +174800 MOVE 76.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +174900 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +175000 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +175100 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +175200 SUB-TEST-F3-18-0. NC2534.2 +175300 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +175400 ON SIZE ERROR NC2534.2 +175500 MOVE "A" TO WRK-AN-00001 NC2534.2 +175600 NOT ON SIZE ERROR NC2534.2 +175700 MOVE "B" TO WRK-AN-00001 NC2534.2 +175800 END-SUBTRACT NC2534.2 +175900 MOVE "Z" TO WRK-XN-00001. NC2534.2 +176000* NC2534.2 +176100 SUB-INIT-F3-18-1. NC2534.2 +176200 MOVE "SUB-TEST-F3-18-1" TO PAR-NAME. NC2534.2 +176300 ADD 1 TO REC-CT. NC2534.2 +176400 SUB-TEST-F3-18-1. NC2534.2 +176500 IF WRK-AN-00001 NOT = "A" NC2534.2 +176600 GO TO SUB-FAIL-F3-18-1. NC2534.2 +176700 PERFORM PASS NC2534.2 +176800 GO TO SUB-WRITE-F3-18-1. NC2534.2 +176900 SUB-DELETE-F3-18-1. NC2534.2 +177000 PERFORM DE-LETE. NC2534.2 +177100 GO TO SUB-WRITE-F3-18-1. NC2534.2 +177200 SUB-FAIL-F3-18-1. NC2534.2 +177300 MOVE "ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +177400 TO RE-MARK NC2534.2 +177500 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +177600 MOVE "A" TO CORRECT-X NC2534.2 +177700 PERFORM FAIL. NC2534.2 +177800 SUB-WRITE-F3-18-1. NC2534.2 +177900 PERFORM PRINT-DETAIL. NC2534.2 +178000* NC2534.2 +178100 SUB-INIT-F3-18-2. NC2534.2 +178200 MOVE "SUB-TEST-F3-18-2" TO PAR-NAME. NC2534.2 +178300 ADD 1 TO REC-CT. NC2534.2 +178400 SUB-TEST-F3-18-2. NC2534.2 +178500 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +178600 GO TO SUB-FAIL-F3-18-2. NC2534.2 +178700 PERFORM PASS NC2534.2 +178800 GO TO SUB-WRITE-F3-18-2. NC2534.2 +178900 SUB-FAIL-F3-18-2. NC2534.2 +179000 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +179100 MOVE "+1" TO CORRECT-A NC2534.2 +179200 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +179300 TO RE-MARK NC2534.2 +179400 PERFORM FAIL. NC2534.2 +179500 SUB-WRITE-F3-18-2. NC2534.2 +179600 PERFORM PRINT-DETAIL. NC2534.2 +179700* NC2534.2 +179800 SUB-INIT-F3-18-3. NC2534.2 +179900 MOVE "SUB-TEST-F3-18-3" TO PAR-NAME. NC2534.2 +180000 ADD 1 TO REC-CT. NC2534.2 +180100 SUB-TEST-F3-18-3. NC2534.2 +180200 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +180300 GO TO SUB-FAIL-F3-18-3. NC2534.2 +180400 PERFORM PASS NC2534.2 +180500 GO TO SUB-WRITE-F3-18-3. NC2534.2 +180600 SUB-DELETE-F3-18-3. NC2534.2 +180700 PERFORM DE-LETE. NC2534.2 +180800 GO TO SUB-WRITE-F3-18-3. NC2534.2 +180900 SUB-FAIL-F3-18-3. NC2534.2 +181000 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +181100 MOVE "+1.96" TO CORRECT-A NC2534.2 +181200 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +181300 TO RE-MARK NC2534.2 +181400 PERFORM FAIL. NC2534.2 +181500 SUB-WRITE-F3-18-3. NC2534.2 +181600 PERFORM PRINT-DETAIL. NC2534.2 +181700* NC2534.2 +181800 SUB-INIT-F3-18-4. NC2534.2 +181900 MOVE "SUB-TEST-F3-18-4" TO PAR-NAME. NC2534.2 +182000 ADD 1 TO REC-CT. NC2534.2 +182100 SUB-TEST-F3-18-4. NC2534.2 +182200 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +182300 GO TO SUB-FAIL-F3-18-4. NC2534.2 +182400 PERFORM PASS NC2534.2 +182500 GO TO SUB-WRITE-F3-18-4. NC2534.2 +182600 SUB-DELETE-F3-18-4. NC2534.2 +182700 PERFORM DE-LETE. NC2534.2 +182800 GO TO SUB-WRITE-F3-18-4. NC2534.2 +182900 SUB-FAIL-F3-18-4. NC2534.2 +183000 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +183100 MOVE "+1" TO CORRECT-A NC2534.2 +183200 MOVE "WRONGLY AFFECTED BY SIZE ERROR" TO RE-MARK NC2534.2 +183300 PERFORM FAIL. NC2534.2 +183400 SUB-WRITE-F3-18-4. NC2534.2 +183500 PERFORM PRINT-DETAIL. NC2534.2 +183600* NC2534.2 +183700 SUB-INIT-F3-18-5. NC2534.2 +183800 MOVE "SUB-TEST-F3-18-5" TO PAR-NAME. NC2534.2 +183900 ADD 1 TO REC-CT. NC2534.2 +184000 SUB-TEST-F3-18-5. NC2534.2 +184100 IF WRK-XN-00001 NOT = "Z" NC2534.2 +184200 GO TO SUB-FAIL-F3-18-5. NC2534.2 +184300 PERFORM PASS NC2534.2 +184400 GO TO SUB-WRITE-F3-18-5. NC2534.2 +184500 SUB-DELETE-F3-18-5. NC2534.2 +184600 PERFORM DE-LETE. NC2534.2 +184700 GO TO SUB-WRITE-F3-18-5. NC2534.2 +184800 SUB-FAIL-F3-18-5. NC2534.2 +184900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +185000 MOVE "Z" TO COMPUTED-X NC2534.2 +185100 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +185200 PERFORM FAIL. NC2534.2 +185300 SUB-WRITE-F3-18-5. NC2534.2 +185400 PERFORM PRINT-DETAIL. NC2534.2 +185500* NC2534.2 +185600 SUB-INIT-F3-19. NC2534.2 +185700* ===--> NEW SIZE ERROR TESTS <--=== NC2534.2 +185800* ===--> NO SIZE ERROR <--=== NC2534.2 +185900 MOVE "VI-133 6.25" TO ANSI-REFERENCE. NC2534.2 +186000 MOVE SPACE TO WRK-AN-00001. NC2534.2 +186100 MOVE 0 TO REC-CT. NC2534.2 +186200 MOVE 1 TO SUBTR-13 OF SUBTR-12. NC2534.2 +186300 MOVE -1.725 TO SUBTR-14 OF SUBTR-12. NC2534.2 +186400 MOVE 6.76 TO SUBTR-15 OF SUBTR-12. NC2534.2 +186500 MOVE 2 TO SUBTR-13 OF SUBTR-16. NC2534.2 +186600 MOVE .23 TO SUBTR-14 OF SUBTR-16. NC2534.2 +186700 MOVE 1 TO SUBTR-15 OF SUBTR-16. NC2534.2 +186800 SUB-TEST-F3-19-0. NC2534.2 +186900 SUBTRACT CORRESPONDING SUBTR-12 FROM SUBTR-16 ROUNDED NC2534.2 +187000 ON SIZE ERROR NC2534.2 +187100 MOVE "A" TO WRK-AN-00001 NC2534.2 +187200 NOT ON SIZE ERROR NC2534.2 +187300 MOVE "B" TO WRK-AN-00001 NC2534.2 +187400 END-SUBTRACT NC2534.2 +187500 MOVE "Z" TO WRK-XN-00001. NC2534.2 +187600* NC2534.2 +187700 SUB-INIT-F3-19-1. NC2534.2 +187800 MOVE "SUB-TEST-F3-19-1" TO PAR-NAME. NC2534.2 +187900 ADD 1 TO REC-CT. NC2534.2 +188000 SUB-TEST-F3-19-1. NC2534.2 +188100 IF WRK-AN-00001 NOT = "B" NC2534.2 +188200 GO TO SUB-FAIL-F3-19-1. NC2534.2 +188300 PERFORM PASS NC2534.2 +188400 GO TO SUB-WRITE-F3-19-1. NC2534.2 +188500 SUB-DELETE-F3-19-1. NC2534.2 +188600 PERFORM DE-LETE. NC2534.2 +188700 GO TO SUB-WRITE-F3-19-1. NC2534.2 +188800 SUB-FAIL-F3-19-1. NC2534.2 +188900 MOVE "NOT ON SIZE ERROR SHOULD BE EXECUTED" NC2534.2 +189000 TO RE-MARK NC2534.2 +189100 MOVE WRK-AN-00001 TO COMPUTED-X NC2534.2 +189200 MOVE "B" TO CORRECT-X NC2534.2 +189300 PERFORM FAIL. NC2534.2 +189400 SUB-WRITE-F3-19-1. NC2534.2 +189500 PERFORM PRINT-DETAIL. NC2534.2 +189600* NC2534.2 +189700 SUB-INIT-F3-19-2. NC2534.2 +189800 MOVE "SUB-TEST-F3-19-2" TO PAR-NAME. NC2534.2 +189900 ADD 1 TO REC-CT. NC2534.2 +190000 SUB-TEST-F3-19-2. NC2534.2 +190100 IF SUBTR-13 OF SUBTR-16 NOT EQUAL TO 1 NC2534.2 +190200 GO TO SUB-FAIL-F3-19-2. NC2534.2 +190300 PERFORM PASS NC2534.2 +190400 GO TO SUB-WRITE-F3-19-2. NC2534.2 +190500 SUB-DELETE-F3-19-2. NC2534.2 +190600 PERFORM DE-LETE. NC2534.2 +190700 GO TO SUB-WRITE-F3-19-2. NC2534.2 +190800 SUB-FAIL-F3-19-2. NC2534.2 +190900 MOVE SUBTR-13 OF SUBTR-16 TO COMPUTED-N NC2534.2 +191000 MOVE "+1" TO CORRECT-A NC2534.2 +191100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +191200 TO RE-MARK NC2534.2 +191300 PERFORM FAIL. NC2534.2 +191400 SUB-WRITE-F3-19-2. NC2534.2 +191500 PERFORM PRINT-DETAIL. NC2534.2 +191600* NC2534.2 +191700 SUB-INIT-F3-19-3. NC2534.2 +191800 MOVE "SUB-TEST-F3-19-3" TO PAR-NAME. NC2534.2 +191900 ADD 1 TO REC-CT. NC2534.2 +192000 SUB-TEST-F3-19-3. NC2534.2 +192100 IF SUBTR-14 OF SUBTR-16 IS NOT EQUAL TO 1.96 NC2534.2 +192200 GO TO SUB-FAIL-F3-19-3. NC2534.2 +192300 PERFORM PASS NC2534.2 +192400 GO TO SUB-WRITE-F3-19-3. NC2534.2 +192500 SUB-DELETE-F3-19-3. NC2534.2 +192600 PERFORM DE-LETE. NC2534.2 +192700 GO TO SUB-WRITE-F3-19-3. NC2534.2 +192800 SUB-FAIL-F3-19-3. NC2534.2 +192900 MOVE SUBTR-14 OF SUBTR-16 TO COMPUTED-N NC2534.2 +193000 MOVE "+1.96" TO CORRECT-A NC2534.2 +193100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +193200 TO RE-MARK NC2534.2 +193300 PERFORM FAIL. NC2534.2 +193400 SUB-WRITE-F3-19-3. NC2534.2 +193500 PERFORM PRINT-DETAIL. NC2534.2 +193600* NC2534.2 +193700 SUB-INIT-F3-19-4. NC2534.2 +193800 MOVE "SUB-TEST-F3-19-4" TO PAR-NAME. NC2534.2 +193900 ADD 1 TO REC-CT. NC2534.2 +194000 SUB-TEST-F3-19-4. NC2534.2 +194100 IF SUBTR-15 OF SUBTR-16 NOT EQUAL TO -5.76 NC2534.2 +194200 GO TO SUB-FAIL-F3-19-4. NC2534.2 +194300 PERFORM PASS NC2534.2 +194400 GO TO SUB-WRITE-F3-19-4. NC2534.2 +194500 SUB-DELETE-F3-19-4. NC2534.2 +194600 PERFORM DE-LETE. NC2534.2 +194700 GO TO SUB-WRITE-F3-19-4. NC2534.2 +194800 SUB-FAIL-F3-19-4. NC2534.2 +194900 MOVE SUBTR-15 OF SUBTR-16 TO COMPUTED-N NC2534.2 +195000 MOVE "-5.76" TO CORRECT-A NC2534.2 +195100 MOVE "WRONGLY AFFECTED BY SIZE ERROR ON OTHER OPERAND" NC2534.2 +195200 TO RE-MARK NC2534.2 +195300 PERFORM FAIL. NC2534.2 +195400 SUB-WRITE-F3-19-4. NC2534.2 +195500 PERFORM PRINT-DETAIL. NC2534.2 +195600* NC2534.2 +195700 SUB-INIT-F3-19-5. NC2534.2 +195800 MOVE "SUB-TEST-F3-19-5" TO PAR-NAME. NC2534.2 +195900 ADD 1 TO REC-CT. NC2534.2 +196000 SUB-TEST-F3-19-5. NC2534.2 +196100 IF WRK-XN-00001 NOT = "Z" NC2534.2 +196200 GO TO SUB-FAIL-F3-19-5. NC2534.2 +196300 PERFORM PASS NC2534.2 +196400 GO TO SUB-WRITE-F3-19-5. NC2534.2 +196500 SUB-DELETE-F3-19-5. NC2534.2 +196600 PERFORM DE-LETE. NC2534.2 +196700 GO TO SUB-WRITE-F3-19-5. NC2534.2 +196800 SUB-FAIL-F3-19-5. NC2534.2 +196900 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK NC2534.2 +197000 MOVE "Z" TO COMPUTED-X NC2534.2 +197100 MOVE WRK-AN-00001 TO CORRECT-X NC2534.2 +197200 PERFORM FAIL. NC2534.2 +197300 SUB-WRITE-F3-19-5. NC2534.2 +197400 PERFORM PRINT-DETAIL. NC2534.2 +197500* NC2534.2 +197600 CCVS-EXIT SECTION. NC2534.2 +197700 CCVS-999999. NC2534.2 +197800 GO TO CLOSE-FILES. NC2534.2 diff --git a/tests/cobol85/NC/NC254A.CBL b/tests/cobol85/NC/NC254A.CBL new file mode 100755 index 00000000..6f7b3d67 --- /dev/null +++ b/tests/cobol85/NC/NC254A.CBL @@ -0,0 +1,671 @@ +000100 IDENTIFICATION DIVISION. NC2544.2 +000200 PROGRAM-ID. NC2544.2 +000300 NC254A. NC2544.2 +000400**************************************************************** NC2544.2 +000500* * NC2544.2 +000600* VALIDATION FOR:- * NC2544.2 +000700* * NC2544.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +000900* * NC2544.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2544.2 +001100* * NC2544.2 +001200**************************************************************** NC2544.2 +001300* * NC2544.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2544.2 +001500* * NC2544.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2544.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2544.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2544.2 +001900* * NC2544.2 +002000**************************************************************** NC2544.2 +002100* NC2544.2 +002200* PROGRAM NC254A TESTS SWITCH SETTINGS USING LEVEL 2 FEATURES NC2544.2 +002300* LOGICAL OPERATORS AND, OR, NOT. NC2544.2 +002400* NC2544.2 +002500 ENVIRONMENT DIVISION. NC2544.2 +002600 CONFIGURATION SECTION. NC2544.2 +002700 SOURCE-COMPUTER. NC2544.2 +002800 Linux. NC2544.2 +002900 OBJECT-COMPUTER. NC2544.2 +003000 Linux. NC2544.2 +003100 SPECIAL-NAMES. NC2544.2 +003200 SWITCH-1 NC2544.2 +003300 IS SW-1 NC2544.2 +003400 ON STATUS IS ON-SWITCH-1 NC2544.2 +003500 OFF STATUS IS OFF-SWITCH-1 NC2544.2 +003600 SWITCH-2 NC2544.2 +003700 IS SW-2 NC2544.2 +003800 ON IS ON-SWITCH-2 NC2544.2 +003900 OFF IS OFF-SWITCH-2 NC2544.2 +004000 CLASS ORDINAL-A-ONLY IS NC2544.2 +004100 "A" NC2544.2 +004200 CLASS ORDINAL-A-THROUGH-D IS NC2544.2 +004300 "A" NC2544.2 +004400 THROUGH NC2544.2 +004500 "D" NC2544.2 +004600 CLASS ORDINAL-D-THRU-A NC2544.2 +004700 "D" NC2544.2 +004800 THRU NC2544.2 +004900 "A" NC2544.2 +005000 CLASS ACTUAL-A-ONLY "A" NC2544.2 +005100 CLASS ACTUAL-A-THRU-D IS "A" THRU "D" NC2544.2 +005200 CLASS ACTUAL-D-THROUGH-A IS "D" THROUGH "A" NC2544.2 +005300 CLASS ACTUAL-ABCD "ABCD". NC2544.2 +005400 INPUT-OUTPUT SECTION. NC2544.2 +005500 FILE-CONTROL. NC2544.2 +005600 SELECT PRINT-FILE ASSIGN TO NC2544.2 +005700 "report.log". NC2544.2 +005800 DATA DIVISION. NC2544.2 +005900 FILE SECTION. NC2544.2 +006000 FD PRINT-FILE. NC2544.2 +006100 01 PRINT-REC PICTURE X(120). NC2544.2 +006200 01 DUMMY-RECORD PICTURE X(120). NC2544.2 +006300 WORKING-STORAGE SECTION. NC2544.2 +006400 01 WS-A PIC X. NC2544.2 +006500 01 WS-B PIC X(5). NC2544.2 +006600 01 IF-D1 PICTURE IS S9(4)V9(2) NC2544.2 +006700 VALUE IS 0. NC2544.2 +006800 01 IF-D2 PICTURE IS S9(4)V9(2) NC2544.2 +006900 VALUE IS ZERO. NC2544.2 +007000 01 IF-D3 PICTURE IS X(10) NC2544.2 +007100 VALUE IS "0000000000". NC2544.2 +007200 01 IF-D4 PICTURE IS X(15) NC2544.2 +007300 VALUE IS " ". NC2544.2 +007400 01 IF-D6 PICTURE IS A(10) NC2544.2 +007500 VALUE IS "BABABABABA". NC2544.2 +007600 01 IF-D7 PICTURE IS S9(6)V9(4) NC2544.2 +007700 VALUE IS +123.45. NC2544.2 +007800 01 IF-D8 PICTURE IS 9(6)V9(4) NC2544.2 +007900 VALUE IS 12300. NC2544.2 +008000 01 IF-D9 PICTURE IS X(3) NC2544.2 +008100 VALUE IS "123". NC2544.2 +008200 01 IF-D11 PICTURE IS X(6) NC2544.2 +008300 VALUE IS "ABCDEF". NC2544.2 +008400 01 IF-D13 PICTURE IS 9(6)V9(4) NC2544.2 +008500 VALUE IS 12300. NC2544.2 +008600 01 IF-D14 PICTURE IS S9(4)V9(2) NC2544.2 +008700 VALUE IS +123.45. NC2544.2 +008800 01 IF-D15 PICTURE IS S999PP NC2544.2 +008900 VALUE IS 12300. NC2544.2 +009000 01 IF-D16 PICTURE IS PP99 NC2544.2 +009100 VALUE IS .0012. NC2544.2 +009200 01 IF-D17 PICTURE IS SV9(4) NC2544.2 +009300 VALUE IS .0012. NC2544.2 +009400 01 IF-D18 PICTURE IS X(10) NC2544.2 +009500 VALUE IS "BABABABABA". NC2544.2 +009600 01 IF-D19 PICTURE IS X(10) NC2544.2 +009700 VALUE IS "ABCDEF ". NC2544.2 +009800 01 IF-D23 PICTURE IS $9,9B9.90+. NC2544.2 +009900 01 IF-D24 PICTURE IS X(10) NC2544.2 +010000 VALUE IS "$1,2 3.40+". NC2544.2 +010100 01 IF-D25 PICTURE IS ABABX0A. NC2544.2 +010200 01 IF-D26 PIC X(7) NC2544.2 +010300 VALUE IS "A C D0E". NC2544.2 +010400 01 IF-D27 PICTURE 9(6)V9(4) VALUE 2137.45 NC2544.2 +010500 USAGE IS COMPUTATIONAL. NC2544.2 +010600 01 IF-D28 PICTURE IS 999999V9999 NC2544.2 +010700 VALUE IS 2137.45. NC2544.2 +010800 01 IF-D32 PICTURE IS 9 VALUE IS 0. NC2544.2 +010900 01 IF-D33 PICTURE S9 VALUE -0. NC2544.2 +011000 01 IF-D34 PICTURE S9 VALUE +0. NC2544.2 +011100 01 IF-D37 PICTURE 9(5) VALUE 0001234. NC2544.2 +011200 01 IF-D38 PICTURE X(20) VALUE " BABBAGE". NC2544.2 +011300 01 ALPHA-UPPER PIC X(20) VALUE " UPPERCASE CHARS". NC2544.2 +011400 01 ALPHA-LOWER PIC X(20) VALUE " lowercase chars". NC2544.2 +011500 01 NON-COBOL-CHARACTERS PICTURE X(8) VALUE NC2544.2 +011600 "12345678". NC2544.2 +011700 01 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2544.2 +011800 01 A18ONES-DS-18V00 PICTURE S9(18) NC2544.2 +011900 VALUE 111111111111111111. NC2544.2 +012000 01 ONES-XN-00018 PICTURE X(18) NC2544.2 +012100 VALUE "111111111111111111". NC2544.2 +012200 01 A99-DS-02V00 PICTURE S99 VALUE 99. NC2544.2 +012300 01 WRK-DU-02V00 PICTURE 99. NC2544.2 +012400 01 TWOS-XN-00002 PICTURE XX VALUE "22". NC2544.2 +012500 01 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2544.2 +012600 VALUE 111111111.111111111. NC2544.2 +012700 01 ONES-XN-00002 PICTURE XX VALUE "11". NC2544.2 +012800 01 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2544.2 +012900 01 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC2544.2 +013000 01 A990-DS-0201P PICTURE S99P VALUE +990. NC2544.2 +013100 01 XDATA-XN-00018 PICTURE X(18) NC2544.2 +013200 VALUE "00ABCDEFGHI 4321 ". NC2544.2 +013300 01 XDATA-DS-18V00-S REDEFINES XDATA-XN-00018 PICTURE S9(18). NC2544.2 +013400 01 YADATA-XN-00010 PICTURE X(10) VALUE "ABCDEFGHIJ".NC2544.2 +013500 01 YADATA-XN-00010-U-AND-L PICTURE X(10) VALUE "AbCdEfGhIj".NC2544.2 +013600 01 DUMMY-DS-00001 PICTURE S9 VALUE -1. NC2544.2 +013700 01 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2544.2 +013800 01 WRK-DS-18V0-1 PIC S9(18) VALUE NC2544.2 +013900 -123456789012345678. NC2544.2 +014000 01 WRK-XN-18-2 PIC X(18) VALUE NC2544.2 +014100 "123456789012345678". NC2544.2 +014200 NC2544.2 +014300 01 IF-D10. NC2544.2 +014400 02 FILLER PICTURE XX VALUE "01". NC2544.2 +014500 02 FILLER PICTURE XX VALUE "23". NC2544.2 +014600 02 IF-D10A. NC2544.2 +014700 03 FILLER PICTURE XXXX VALUE "4567". NC2544.2 +014800 03 FILLER PICTURE XXXX VALUE "8912". NC2544.2 +014900 01 IF-D12. NC2544.2 +015000 02 FILLER PICTURE XXX VALUE "ABC". NC2544.2 +015100 02 IF-D12A. NC2544.2 +015200 03 IF-D12B. NC2544.2 +015300 04 FILLER PICTURE XX VALUE "DE". NC2544.2 +015400 04 FILLER PICTURE X VALUE "F". NC2544.2 +015500 01 IF-D20. NC2544.2 +015600 02 FILLER PICTURE 9(5) VALUE ZERO. NC2544.2 +015700 02 FILLER PICTURE 99 VALUE 12. NC2544.2 +015800 02 FILLER PICTURE 9 VALUE 3. NC2544.2 +015900 02 FILLER PICTURE 99 VALUE 45. NC2544.2 +016000 01 IF-D21. NC2544.2 +016100 02 FILLER PICTURE 9(5) VALUE ZERO. NC2544.2 +016200 02 FILLER PICTURE 9(5) VALUE 12345. NC2544.2 +016300 01 IF-D22. NC2544.2 +016400 02 FILLER PICTURE AA VALUE "AB". NC2544.2 +016500 02 FILLER PICTURE AAAA VALUE "CDEF". NC2544.2 +016600 01 IF-D35. NC2544.2 +016700 02 IF-D35A VALUE "*ASTERISK". NC2544.2 +016800 03 FILLER PICTURE A(6). NC2544.2 +016900 03 FILLER PICTURE AAA. NC2544.2 +017000 02 IF-D35B VALUE "/SLASH". NC2544.2 +017100 03 FILLER PICTURE 9(6). NC2544.2 +017200 01 IF-D36 REDEFINES IF-D35. NC2544.2 +017300 02 IF-D36A PICTURE X(6). NC2544.2 +017400 02 IF-D36B PICTURE XXX. NC2544.2 +017500 02 IF-D36C PICTURE X(6). NC2544.2 +017600 01 IF-D39. NC2544.2 +017700 02 FILLER PICTURE A(6) VALUE "ABCDEF". NC2544.2 +017800 02 FILLER PICTURE A(4) VALUE SPACE. NC2544.2 +017900 01 LEVEL-01. NC2544.2 +018000 02 LEVEL-02. NC2544.2 +018100 03 LEVEL-03. NC2544.2 +018200 04 LEVEL-04. NC2544.2 +018300 05 LEVEL-05. NC2544.2 +018400 06 LEVEL-06. NC2544.2 +018500 07 LEVEL-07. NC2544.2 +018600 08 LEVEL-08. NC2544.2 +018700 09 LEVEL-09. NC2544.2 +018800 10 LEVEL-10 PICTURE IS X VALUE IS "R".NC2544.2 +018900 01 LEVEL-RECEIVER PICTURE IS X VALUE IS NC2544.2 +019000 SPACE. NC2544.2 +019100 01 LEVEL-SENDER PICTURE X VALUE "S". NC2544.2 +019200 01 VAL PICTURE IS 9 VALUE IS 0. NC2544.2 +019300 01 A-2 PICTURE IS A VALUE IS "A".NC2544.2 +019400 01 N-27 PICTURE IS 9999V9 NC2544.2 +019500 VALUE IS 9999.9. NC2544.2 +019600 01 N-30 PICTURE IS 9V9 NC2544.2 +019700 VALUE IS 2. NC2544.2 +019800 01 N-31 PICTURE IS 9(6). NC2544.2 +019900 01 X-32 REDEFINES N-31 PICTURE IS X(6). NC2544.2 +020000 01 N-33 PICTURE IS 9(5) NC2544.2 +020100 VALUE IS 29. NC2544.2 +020200 01 A-37 PICTURE IS A VALUE IS "X".NC2544.2 +020300 01 X-38 REDEFINES A-37 PICTURE IS X. NC2544.2 +020400 01 X-43 PIC X(10) VALUE " l75.63". NC2544.2 +020500 01 N-84 PICTURE IS 9999999999. NC2544.2 +020600 01 NUMERIC-GRP-TEST. NC2544.2 +020700 02 NUMERIC-1 PICTURE 9 VALUE 0. NC2544.2 +020800 02 NUMERIC-2. NC2544.2 +020900 03 NUMERIC-3 PICTURE 9(1)V9(1) VALUE ZERO. NC2544.2 +021000 03 NUMERIC-4. NC2544.2 +021100 04 NUMERIC-5 PICTURE 9(18) VALUE 1. NC2544.2 +021200 02 NUMERIC-6. NC2544.2 +021300 03 NUMERIC-7 PICTURE X VALUE "7". NC2544.2 +021400 03 NUMERIC-8 PICTURE 9 VALUE 8. NC2544.2 +021500 01 NUM-GRP. NC2544.2 +021600 02 NUM-SUB-GRP PIC 9. NC2544.2 +021700 01 GROUP-1000. NC2544.2 +021800 02 FILLER PIC X. NC2544.2 +021900 02 GROUP-X1000. NC2544.2 +022000 03 GROUP-1000-1 PIC X(500) VALUE ZERO. NC2544.2 +022100 03 XNAME PICTURE X(100) VALUE QUOTE. NC2544.2 +022200 03 GROUP-1000-2 PICTURE X(399) VALUE SPACE. NC2544.2 +022300 03 GROUP-1000-3 PICTURE X VALUE ".". NC2544.2 +022400 02 GROUP-X500-2. NC2544.2 +022500 03 GROUP-X500-A PICTURE X(500) VALUE ZERO. NC2544.2 +022600 03 GROUP-X500-1. NC2544.2 +022700 04 GROUP-X500-1-1 PICTURE X(50) VALUE QUOTE. NC2544.2 +022800 04 GROUP-X500-1-2 PICTURE X(50) VALUE QUOTE. NC2544.2 +022900 04 GROUP-X500-1-3 PICTURE X(398) VALUE SPACE. NC2544.2 +023000 04 GROUP-X500-1-4 PICTURE XX VALUE " .". NC2544.2 +023100 01 HI-LO-VALUES. NC2544.2 +023200 02 LOW-VAL PIC X VALUE LOW-VALUE. NC2544.2 +023300 02 ZERO-01 PICTURE 9(18) VALUE 1. NC2544.2 +023400 02 ABC PICTURE XXX VALUE "ABC". NC2544.2 +023500 02 NINE-17-8 PICTURE 9(18) VALUE 999999999999999998. NC2544.2 +023600 02 ZERO-NULL PIC 9(9) VALUE 0. NC2544.2 +023700 02 ZERO-ZERO PICTURE 9(9)V9(9) VALUE 0.0. NC2544.2 +023800 01 COMP-DATA. NC2544.2 +023900 02 COMP-DATA1 PICTURE 9(18) COMPUTATIONAL VALUE 300. NC2544.2 +024000 02 COMP-DATA2 PICTURE 9(10) COMPUTATIONAL VALUE 100000. NC2544.2 +024100 02 COMP-DATA3 PICTURE 9 COMPUTATIONAL VALUE 9. NC2544.2 +024200 02 COMP-DATA4 PICTURE 9(9)V9(7) COMPUTATIONAL VALUE 3.3. NC2544.2 +024300 02 COMP-DATA5 PICTURE 9(5)V9(2) COMPUTATIONAL VALUE 52.25. NC2544.2 +024400 02 COMP-DATA6 PICTURE 9V9 COMPUTATIONAL VALUE 8.8. NC2544.2 +024500 02 COMP-DATA7 PICTURE 9(3)V9(2) COMPUTATIONAL VALUE 300.00.NC2544.2 +024600 02 COMP-DATA8 PICTURE 9V9(9) COMPUTATIONAL VALUE 3.3000000.NC2544.2 +024700 02 COMP-DATA9 PICTURE 9(8) COMPUTATIONAL VALUE 100000. NC2544.2 +024800 01 DISP-DATA. NC2544.2 +024900 02 DISP-DATA1 PICTURE 9(18) VALUE 300. NC2544.2 +025000 02 DISP-DATA2 PICTURE 9(8) VALUE 100000. NC2544.2 +025100 02 DISP-DATA3 PICTURE 9 VALUE 9. NC2544.2 +025200 02 DISP-DATA4 PICTURE 9(7)V9(9) VALUE 3.3. NC2544.2 +025300 02 DISP-DATA5 PICTURE 9(2)V9(2) VALUE 52.25. NC2544.2 +025400 02 DISP-DATA6 PICTURE 9V9 VALUE 8.8. NC2544.2 +025500 01 DATA-5 PICTURE 9 VALUE 5. NC2544.2 +025600 01 DATA-99999 PICTURE S9(5) VALUE +99999. NC2544.2 +025700 01 DATA-Z PICTURE X VALUE "Z". NC2544.2 +025800 01 DATA-4 PICTURE 9 VALUE 4. NC2544.2 +025900 01 DATA-Y PICTURE X VALUE "Y". NC2544.2 +026000 01 DATA-VWXYZ PICTURE X(5) VALUE "VWXYZ". NC2544.2 +026100 01 DATA-ADCBA PICTURE X(5) VALUE "ADCBA". NC2544.2 +026200 01 TEST-RESULTS. NC2544.2 +026300 02 FILLER PIC X VALUE SPACE. NC2544.2 +026400 02 FEATURE PIC X(20) VALUE SPACE. NC2544.2 +026500 02 FILLER PIC X VALUE SPACE. NC2544.2 +026600 02 P-OR-F PIC X(5) VALUE SPACE. NC2544.2 +026700 02 FILLER PIC X VALUE SPACE. NC2544.2 +026800 02 PAR-NAME. NC2544.2 +026900 03 FILLER PIC X(19) VALUE SPACE. NC2544.2 +027000 03 PARDOT-X PIC X VALUE SPACE. NC2544.2 +027100 03 DOTVALUE PIC 99 VALUE ZERO. NC2544.2 +027200 02 FILLER PIC X(8) VALUE SPACE. NC2544.2 +027300 02 RE-MARK PIC X(61). NC2544.2 +027400 01 TEST-COMPUTED. NC2544.2 +027500 02 FILLER PIC X(30) VALUE SPACE. NC2544.2 +027600 02 FILLER PIC X(17) VALUE NC2544.2 +027700 " COMPUTED=". NC2544.2 +027800 02 COMPUTED-X. NC2544.2 +027900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2544.2 +028000 03 COMPUTED-N REDEFINES COMPUTED-A NC2544.2 +028100 PIC -9(9).9(9). NC2544.2 +028200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2544.2 +028300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2544.2 +028400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2544.2 +028500 03 CM-18V0 REDEFINES COMPUTED-A. NC2544.2 +028600 04 COMPUTED-18V0 PIC -9(18). NC2544.2 +028700 04 FILLER PIC X. NC2544.2 +028800 03 FILLER PIC X(50) VALUE SPACE. NC2544.2 +028900 01 TEST-CORRECT. NC2544.2 +029000 02 FILLER PIC X(30) VALUE SPACE. NC2544.2 +029100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2544.2 +029200 02 CORRECT-X. NC2544.2 +029300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2544.2 +029400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2544.2 +029500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2544.2 +029600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2544.2 +029700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2544.2 +029800 03 CR-18V0 REDEFINES CORRECT-A. NC2544.2 +029900 04 CORRECT-18V0 PIC -9(18). NC2544.2 +030000 04 FILLER PIC X. NC2544.2 +030100 03 FILLER PIC X(2) VALUE SPACE. NC2544.2 +030200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2544.2 +030300 01 CCVS-C-1. NC2544.2 +030400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2544.2 +030500- "SS PARAGRAPH-NAME NC2544.2 +030600- " REMARKS". NC2544.2 +030700 02 FILLER PIC X(20) VALUE SPACE. NC2544.2 +030800 01 CCVS-C-2. NC2544.2 +030900 02 FILLER PIC X VALUE SPACE. NC2544.2 +031000 02 FILLER PIC X(6) VALUE "TESTED". NC2544.2 +031100 02 FILLER PIC X(15) VALUE SPACE. NC2544.2 +031200 02 FILLER PIC X(4) VALUE "FAIL". NC2544.2 +031300 02 FILLER PIC X(94) VALUE SPACE. NC2544.2 +031400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2544.2 +031500 01 REC-CT PIC 99 VALUE ZERO. NC2544.2 +031600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2544.2 +032000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2544.2 +032100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2544.2 +032200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2544.2 +032300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2544.2 +032400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2544.2 +032500 01 CCVS-H-1. NC2544.2 +032600 02 FILLER PIC X(39) VALUE SPACES. NC2544.2 +032700 02 FILLER PIC X(42) VALUE NC2544.2 +032800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2544.2 +032900 02 FILLER PIC X(39) VALUE SPACES. NC2544.2 +033000 01 CCVS-H-2A. NC2544.2 +033100 02 FILLER PIC X(40) VALUE SPACE. NC2544.2 +033200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2544.2 +033300 02 FILLER PIC XXXX VALUE NC2544.2 +033400 "4.2 ". NC2544.2 +033500 02 FILLER PIC X(28) VALUE NC2544.2 +033600 " COPY - NOT FOR DISTRIBUTION". NC2544.2 +033700 02 FILLER PIC X(41) VALUE SPACE. NC2544.2 +033800 NC2544.2 +033900 01 CCVS-H-2B. NC2544.2 +034000 02 FILLER PIC X(15) VALUE NC2544.2 +034100 "TEST RESULT OF ". NC2544.2 +034200 02 TEST-ID PIC X(9). NC2544.2 +034300 02 FILLER PIC X(4) VALUE NC2544.2 +034400 " IN ". NC2544.2 +034500 02 FILLER PIC X(12) VALUE NC2544.2 +034600 " HIGH ". NC2544.2 +034700 02 FILLER PIC X(22) VALUE NC2544.2 +034800 " LEVEL VALIDATION FOR ". NC2544.2 +034900 02 FILLER PIC X(58) VALUE NC2544.2 +035000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +035100 01 CCVS-H-3. NC2544.2 +035200 02 FILLER PIC X(34) VALUE NC2544.2 +035300 " FOR OFFICIAL USE ONLY ". NC2544.2 +035400 02 FILLER PIC X(58) VALUE NC2544.2 +035500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2544.2 +035600 02 FILLER PIC X(28) VALUE NC2544.2 +035700 " COPYRIGHT 1985 ". NC2544.2 +035800 01 CCVS-E-1. NC2544.2 +035900 02 FILLER PIC X(52) VALUE SPACE. NC2544.2 +036000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2544.2 +036100 02 ID-AGAIN PIC X(9). NC2544.2 +036200 02 FILLER PIC X(45) VALUE SPACES. NC2544.2 +036300 01 CCVS-E-2. NC2544.2 +036400 02 FILLER PIC X(31) VALUE SPACE. NC2544.2 +036500 02 FILLER PIC X(21) VALUE SPACE. NC2544.2 +036600 02 CCVS-E-2-2. NC2544.2 +036700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2544.2 +036800 03 FILLER PIC X VALUE SPACE. NC2544.2 +036900 03 ENDER-DESC PIC X(44) VALUE NC2544.2 +037000 "ERRORS ENCOUNTERED". NC2544.2 +037100 01 CCVS-E-3. NC2544.2 +037200 02 FILLER PIC X(22) VALUE NC2544.2 +037300 " FOR OFFICIAL USE ONLY". NC2544.2 +037400 02 FILLER PIC X(12) VALUE SPACE. NC2544.2 +037500 02 FILLER PIC X(58) VALUE NC2544.2 +037600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +037700 02 FILLER PIC X(13) VALUE SPACE. NC2544.2 +037800 02 FILLER PIC X(15) VALUE NC2544.2 +037900 " COPYRIGHT 1985". NC2544.2 +038000 01 CCVS-E-4. NC2544.2 +038100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2544.2 +038200 02 FILLER PIC X(4) VALUE " OF ". NC2544.2 +038300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2544.2 +038400 02 FILLER PIC X(40) VALUE NC2544.2 +038500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2544.2 +038600 01 XXINFO. NC2544.2 +038700 02 FILLER PIC X(19) VALUE NC2544.2 +038800 "*** INFORMATION ***". NC2544.2 +038900 02 INFO-TEXT. NC2544.2 +039000 04 FILLER PIC X(8) VALUE SPACE. NC2544.2 +039100 04 XXCOMPUTED PIC X(20). NC2544.2 +039200 04 FILLER PIC X(5) VALUE SPACE. NC2544.2 +039300 04 XXCORRECT PIC X(20). NC2544.2 +039400 02 INF-ANSI-REFERENCE PIC X(48). NC2544.2 +039500 01 HYPHEN-LINE. NC2544.2 +039600 02 FILLER PIC IS X VALUE IS SPACE. NC2544.2 +039700 02 FILLER PIC IS X(65) VALUE IS "************************NC2544.2 +039800- "*****************************************". NC2544.2 +039900 02 FILLER PIC IS X(54) VALUE IS "************************NC2544.2 +040000- "******************************". NC2544.2 +040100 01 CCVS-PGM-ID PIC X(9) VALUE NC2544.2 +040200 "NC254A". NC2544.2 +040300 PROCEDURE DIVISION. NC2544.2 +040400 CCVS1 SECTION. NC2544.2 +040500 OPEN-FILES. NC2544.2 +040600 OPEN OUTPUT PRINT-FILE. NC2544.2 +040700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2544.2 +040800 MOVE SPACE TO TEST-RESULTS. NC2544.2 +040900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2544.2 +041000 GO TO CCVS1-EXIT. NC2544.2 +041100 CLOSE-FILES. NC2544.2 +041200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2544.2 +041300 TERMINATE-CCVS. NC2544.2 +041400*S EXIT PROGRAM. NC2544.2 +041500*SERMINATE-CALL. NC2544.2 +041600 STOP RUN. NC2544.2 +041700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2544.2 +041800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2544.2 +041900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2544.2 +042000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2544.2 +042100 MOVE "****TEST DELETED****" TO RE-MARK. NC2544.2 +042200 PRINT-DETAIL. NC2544.2 +042300 IF REC-CT NOT EQUAL TO ZERO NC2544.2 +042400 MOVE "." TO PARDOT-X NC2544.2 +042500 MOVE REC-CT TO DOTVALUE. NC2544.2 +042600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2544.2 +042700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2544.2 +042800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2544.2 +042900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2544.2 +043000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2544.2 +043100 MOVE SPACE TO CORRECT-X. NC2544.2 +043200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2544.2 +043300 MOVE SPACE TO RE-MARK. NC2544.2 +043400 HEAD-ROUTINE. NC2544.2 +043500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +043600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +043700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2544.2 +043800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2544.2 +043900 COLUMN-NAMES-ROUTINE. NC2544.2 +044000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +044100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +044200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +044300 END-ROUTINE. NC2544.2 +044400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2544.2 +044500 END-RTN-EXIT. NC2544.2 +044600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +044700 END-ROUTINE-1. NC2544.2 +044800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2544.2 +044900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2544.2 +045000 ADD PASS-COUNTER TO ERROR-HOLD. NC2544.2 +045100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2544.2 +045200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2544.2 +045300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2544.2 +045400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2544.2 +045500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2544.2 +045600 END-ROUTINE-12. NC2544.2 +045700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2544.2 +045800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2544.2 +045900 MOVE "NO " TO ERROR-TOTAL NC2544.2 +046000 ELSE NC2544.2 +046100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2544.2 +046200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2544.2 +046300 PERFORM WRITE-LINE. NC2544.2 +046400 END-ROUTINE-13. NC2544.2 +046500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2544.2 +046600 MOVE "NO " TO ERROR-TOTAL ELSE NC2544.2 +046700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2544.2 +046800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2544.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047000 IF INSPECT-COUNTER EQUAL TO ZERO NC2544.2 +047100 MOVE "NO " TO ERROR-TOTAL NC2544.2 +047200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2544.2 +047300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2544.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047600 WRITE-LINE. NC2544.2 +047700 ADD 1 TO RECORD-COUNT. NC2544.2 +047800 IF RECORD-COUNT GREATER 42 NC2544.2 +047900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2544.2 +048000 MOVE SPACE TO DUMMY-RECORD NC2544.2 +048100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2544.2 +048200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2544.2 +048300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2544.2 +048400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC2544.2 +048500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC2544.2 +048600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048900 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2544.2 +049000 MOVE ZERO TO RECORD-COUNT. NC2544.2 +049100 PERFORM WRT-LN. NC2544.2 +049200 WRT-LN. NC2544.2 +049300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2544.2 +049400 MOVE SPACE TO DUMMY-RECORD. NC2544.2 +049500 BLANK-LINE-PRINT. NC2544.2 +049600 PERFORM WRT-LN. NC2544.2 +049700 FAIL-ROUTINE. NC2544.2 +049800 IF COMPUTED-X NOT EQUAL TO SPACE NC2544.2 +049900 GO TO FAIL-ROUTINE-WRITE. NC2544.2 +050000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2544.2 +050100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2544.2 +050200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2544.2 +050300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +050400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2544.2 +050500 GO TO FAIL-ROUTINE-EX. NC2544.2 +050600 FAIL-ROUTINE-WRITE. NC2544.2 +050700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2544.2 +050800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2544.2 +050900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2544.2 +051000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2544.2 +051100 FAIL-ROUTINE-EX. EXIT. NC2544.2 +051200 BAIL-OUT. NC2544.2 +051300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2544.2 +051400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2544.2 +051500 BAIL-OUT-WRITE. NC2544.2 +051600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2544.2 +051700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2544.2 +051800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2544.2 +052000 BAIL-OUT-EX. EXIT. NC2544.2 +052100 CCVS1-EXIT. NC2544.2 +052200 EXIT. NC2544.2 +052300 SECT-NC254A-001 SECTION. NC2544.2 +052400* NC2544.2 +052500* NC2544.2 +052600 NEXT-INIT-GF-1. NC2544.2 +052700* ==--> NEXT SENTENCE <--== NC2544.2 +052800 MOVE "V1-89 6.15.4 GR2 " TO ANSI-REFERENCE. NC2544.2 +052900 MOVE "A" TO A-2. NC2544.2 +053000 NEXT-TEST-GF-1. NC2544.2 +053100 IF A-2 EQUAL TO "A" NC2544.2 +053200 NEXT SENTENCE NC2544.2 +053300 ELSE NC2544.2 +053400 NEXT SENTENCE. NC2544.2 +053500 PERFORM PASS. NC2544.2 +053600 GO TO NEXT-WRITE-GF-1. NC2544.2 +053700 NEXT-DELETE-GF-1. NC2544.2 +053800 PERFORM DE-LETE. NC2544.2 +053900 NEXT-WRITE-GF-1. NC2544.2 +054000 MOVE "NEXT-TEST-1" TO PAR-NAME. NC2544.2 +054100 PERFORM PRINT-DETAIL. NC2544.2 +054200* NC2544.2 +054300* NC2544.2 +054400 ANOTHER-REMARK. NC2544.2 +054500 MOVE SPACE TO TEST-RESULTS. NC2544.2 +054600 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC2544.2 +054700 PERFORM PRINT-DETAIL. NC2544.2 +054800 MOVE "TEST THE COMPARISONS IN " TO RE-MARK. NC2544.2 +054900 PERFORM PRINT-DETAIL. NC2544.2 +055000 MOVE "SWITCH-STATUS, RELATION " TO RE-MARK. NC2544.2 +055100 PERFORM PRINT-DETAIL. NC2544.2 +055200 MOVE "AND CLASS CONDITIONALS. " TO RE-MARK. NC2544.2 +055300 PERFORM PRINT-DETAIL. NC2544.2 +055400 SWH-INIT-GF-1. NC2544.2 +055500 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +055600 MOVE "SWITCH-STATUS" TO FEATURE. NC2544.2 +055700 SWH-TEST-GF-1. NC2544.2 +055800 IF ON-SWITCH-1 NC2544.2 +055900 PERFORM PASS NC2544.2 +056000 ELSE NC2544.2 +056100 PERFORM FAIL. NC2544.2 +056200 GO TO SWH-WRITE-GF-1. NC2544.2 +056300 SWH-DELETE-GF-1. NC2544.2 +056400*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +056500 PERFORM DE-LETE. NC2544.2 +056600 SWH-WRITE-GF-1. NC2544.2 +056700 MOVE "SWH-TEST-GF-1" TO PAR-NAME. NC2544.2 +056800 PERFORM PRINT-DETAIL. NC2544.2 +056900 SWH-INIT-GF-2. NC2544.2 +057000 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +057100 SWH-TEST-GF-2. NC2544.2 +057200 IF OFF-SWITCH-1 NC2544.2 +057300 PERFORM FAIL NC2544.2 +057400 ELSE NC2544.2 +057500 PERFORM PASS. NC2544.2 +057600 GO TO SWH-WRITE-GF-2. NC2544.2 +057700 SWH-DELETE-GF-2. NC2544.2 +057800*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +057900 PERFORM DE-LETE. NC2544.2 +058000 SWH-WRITE-GF-2. NC2544.2 +058100 MOVE "SWH-TEST-GF-2" TO PAR-NAME. NC2544.2 +058200 PERFORM PRINT-DETAIL. NC2544.2 +058300 SWH-INIT-GF-3. NC2544.2 +058400 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +058500 SWH-TEST-GF-3. NC2544.2 +058600 IF OFF-SWITCH-2 NC2544.2 +058700 PERFORM PASS NC2544.2 +058800 ELSE NC2544.2 +058900 PERFORM FAIL. NC2544.2 +059000 GO TO SWH-WRITE-GF-3. NC2544.2 +059100 SWH-DELETE-GF-3. NC2544.2 +059200*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +059300 PERFORM DE-LETE. NC2544.2 +059400 SWH-WRITE-GF-3. NC2544.2 +059500 MOVE "SWH-TEST-GF-3" TO PAR-NAME. NC2544.2 +059600 PERFORM PRINT-DETAIL. NC2544.2 +059700 SWH-INIT-GF-4. NC2544.2 +059800 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +059900 SWH-TEST-GF-4. NC2544.2 +060000 IF ON-SWITCH-2 NC2544.2 +060100 PERFORM FAIL NC2544.2 +060200 ELSE NC2544.2 +060300 PERFORM PASS. NC2544.2 +060400 GO TO SWH-WRITE-GF-4. NC2544.2 +060500 SWH-DELETE-GF-4. NC2544.2 +060600*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +060700 PERFORM DE-LETE. NC2544.2 +060800 SWH-WRITE-GF-4. NC2544.2 +060900 MOVE "SWH-TEST-GF-4" TO PAR-NAME. NC2544.2 +061000 PERFORM PRINT-DETAIL. NC2544.2 +061100 SWH-TEST-5. NC2544.2 +061200 IF NOT ON-SWITCH-1 NC2544.2 +061300 MOVE "SWITCH-1 OFF " TO COMPUTED-A NC2544.2 +061400 MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A NC2544.2 +061500 PERFORM FAIL NC2544.2 +061600 GO TO SWH-WRITE-5. NC2544.2 +061700 PERFORM PASS. NC2544.2 +061800 GO TO SWH-WRITE-5. NC2544.2 +061900 SWH-DELETE-5. NC2544.2 +062000*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +062100 PERFORM DE-LETE. NC2544.2 +062200 SWH-WRITE-5. NC2544.2 +062300 MOVE "SWH-TEST-5" TO PAR-NAME. NC2544.2 +062400 PERFORM PRINT-DETAIL. NC2544.2 +062500 SWH-TEST-6. NC2544.2 +062600 IF NOT OFF-SWITCH-1 NC2544.2 +062700 PERFORM PASS NC2544.2 +062800 GO TO SWH-WRITE-6. NC2544.2 +062900 MOVE "SWITCH-1 OFF " TO COMPUTED-A. NC2544.2 +063000 MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A. NC2544.2 +063100 PERFORM FAIL. NC2544.2 +063200 GO TO SWH-WRITE-6. NC2544.2 +063300 SWH-DELETE-6. NC2544.2 +063400*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +063500 PERFORM DE-LETE. NC2544.2 +063600 SWH-WRITE-6. NC2544.2 +063700 MOVE "SWH-TEST-6" TO PAR-NAME. NC2544.2 +063800 PERFORM PRINT-DETAIL. NC2544.2 +063900 SWH-TEST-7. NC2544.2 +064000 IF NOT ON-SWITCH-2 NC2544.2 +064100 PERFORM PASS NC2544.2 +064200 GO TO SWH-WRITE-7. NC2544.2 +064300 MOVE "SWITCH-2 ON " TO COMPUTED-A. NC2544.2 +064400 MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A. NC2544.2 +064500 PERFORM FAIL. NC2544.2 +064600 GO TO SWH-WRITE-7. NC2544.2 +064700 SWH-DELETE-7. NC2544.2 +064800*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +064900 PERFORM DE-LETE. NC2544.2 +065000 SWH-WRITE-7. NC2544.2 +065100 MOVE "SWH-TEST-7" TO PAR-NAME. NC2544.2 +065200 PERFORM PRINT-DETAIL. NC2544.2 +065300 SWH-TEST-8. NC2544.2 +065400 IF NOT OFF-SWITCH-2 NC2544.2 +065500 MOVE "SWITCH-2 ON " TO COMPUTED-A NC2544.2 +065600 MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A NC2544.2 +065700 PERFORM FAIL NC2544.2 +065800 GO TO SWH-WRITE-8. NC2544.2 +065900 PERFORM PASS. NC2544.2 +066000 GO TO SWH-WRITE-8. NC2544.2 +066100 SWH-DELETE-8. NC2544.2 +066200*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +066300 PERFORM DE-LETE. NC2544.2 +066400 SWH-WRITE-8. NC2544.2 +066500 MOVE "SWH-TEST-8" TO PAR-NAME. NC2544.2 +066600 PERFORM PRINT-DETAIL. NC2544.2 +066700* NC2544.2 +066800* NC2544.2 +066900 CCVS-EXIT SECTION. NC2544.2 +067000 CCVS-999999. NC2544.2 +067100 GO TO CLOSE-FILES. NC2544.2 diff --git a/tests/cobol85/NC/NC302M.CBL b/tests/cobol85/NC/NC302M.CBL new file mode 100755 index 00000000..6eea2266 --- /dev/null +++ b/tests/cobol85/NC/NC302M.CBL @@ -0,0 +1,51 @@ +000100 IDENTIFICATION DIVISION. NC3024.2 +000200 PROGRAM-ID. NC3024.2 +000300 NC302M. NC3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF OBSOLETE NC3024.2 +000500*MINIMUM SUBSET NUCLEUS FEATURES. NC3024.2 +000600 AUTHOR. DAVID G BAMBER. NC3024.2 +000700*Message expected for above statement: OBSOLETE NC3024.2 +000800 INSTALLATION. NCC. NC3024.2 +000900*Message expected for above statement: OBSOLETE NC3024.2 +001000 DATE-WRITTEN. 19TH AUG 1988. NC3024.2 +001100*Message expected for above statement: OBSOLETE NC3024.2 +001200 SECURITY. NO SECURITY. NC3024.2 +001300*Message expected for above statement: OBSOLETE NC3024.2 +001400 ENVIRONMENT DIVISION. NC3024.2 +001500 CONFIGURATION SECTION. NC3024.2 +001600 SOURCE-COMPUTER. NC3024.2 +001700 Linux. NC3024.2 +001800 OBJECT-COMPUTER. NC3024.2 +001900 Linux NC3024.2 +002000 MEMORY SIZE NC3024.2 +002100 64000 NC3024.2 +002200 CHARACTERS. NC3024.2 +002300*Message expected for above statement: OBSOLETE NC3024.2 +002400 NC3024.2 +002500 NC3024.2 +002600 DATA DIVISION. NC3024.2 +002700 PROCEDURE DIVISION. NC3024.2 +002800 NC3024.2 +002900 NC302M-CONTROL. NC3024.2 +003000 PERFORM NC302M-ALTER THRU NC302M-STOP. NC3024.2 +003100 STOP RUN. NC3024.2 +003200 NC3024.2 +003300 NC302M-ALTER. NC3024.2 +003400 ALTER NC302M-PROC1 TO NC302M-PROC2. NC3024.2 +003500*Message expected for above statement: OBSOLETE NC3024.2 +003600 NC3024.2 +003700 NC302M-PROC1. NC3024.2 +003800 GO TO NC302M-PROC2. NC3024.2 +003900 NC3024.2 +004000 NC302M-PROC2. NC3024.2 +004100 DISPLAY "DUMMY PROCEDURE". NC3024.2 +004200 NC3024.2 +004300 NC3024.2 +004400 NC3024.2 +004500 NC3024.2 +004600 NC302M-STOP. NC3024.2 +004700 STOP "FNC302". NC3024.2 +004800*Message expected for above statement: OBSOLETE NC3024.2 +004900 NC3024.2 +005000 NC3024.2 +005100*TOTAL NUMBER OF FLAGS EXPECTED = 7. NC3024.2 diff --git a/tests/cobol85/NC/NC303M.CBL b/tests/cobol85/NC/NC303M.CBL new file mode 100755 index 00000000..9273cc31 --- /dev/null +++ b/tests/cobol85/NC/NC303M.CBL @@ -0,0 +1,32 @@ +000100 IDENTIFICATION DIVISION. NC3034.2 +000200 PROGRAM-ID. NC3034.2 +000300 NC303M. NC3034.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF NC3034.2 +000500*OBSOLETE HIGH SUBSET NUCLEUS FEATURES. NC3034.2 +000600 DATE-COMPILED. 22ND AUG 1988. NC3034.2 +000700*Message expected for above statement: OBSOLETE NC3034.2 +000800 ENVIRONMENT DIVISION. NC3034.2 +000900 CONFIGURATION SECTION. NC3034.2 +001000 SOURCE-COMPUTER. NC3034.2 +001100 Linux. NC3034.2 +001200 OBJECT-COMPUTER. NC3034.2 +001300 Linux. NC3034.2 +001400 NC3034.2 +001500 NC3034.2 +001600 PROCEDURE DIVISION. NC3034.2 +001700 NC3034.2 +001800 NC303M-CONTROL. NC3034.2 +001900 ALTER NC303M-GOTO TO PROCEED TO NC303M-GOTO-2, NC3034.2 +002000 NC303M-GOTO-2 TO PROCEED TO NC303M-CONTROL. NC3034.2 +002100*Message expected for above statement: OBSOLETE NC3034.2 +002200 STOP RUN. NC3034.2 +002300 NC3034.2 +002400 NC303M-GOTO. NC3034.2 +002500 GO TO. NC3034.2 +002600*Message expected for above statement: OBSOLETE NC3034.2 +002700 NC3034.2 +002800 NC303M-GOTO-2. NC3034.2 +002900 GO TO. NC3034.2 +003000*Message expected for above statement: OBSOLETE NC3034.2 +003100 NC3034.2 +003200*TOTAL NUMBER OF FLAGS EXPECTED = 4. NC3034.2 diff --git a/tests/cobol85/NC/NC401M.CBL b/tests/cobol85/NC/NC401M.CBL new file mode 100755 index 00000000..971e1a25 --- /dev/null +++ b/tests/cobol85/NC/NC401M.CBL @@ -0,0 +1,332 @@ +000100 IDENTIFICATION DIVISION. NC4014.2 +000200 PROGRAM-ID. NC4014.2 +000300 NC401M. NC4014.2 +000400 NC4014.2 +000500 NC4014.2 +000600*THIS PROGRAM TESTS THE FLAGGING OF HIGH SUBSET NUCLEUS NC4014.2 +000700*FEATURES. NC4014.2 +000800 DATE-COMPILED. 22ND AUG 1988. NC4014.2 +000900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +001000 ENVIRONMENT DIVISION. NC4014.2 +001100 CONFIGURATION SECTION. NC4014.2 +001200 SOURCE-COMPUTER. NC4014.2 +001300 Linux. NC4014.2 +001400 OBJECT-COMPUTER. NC4014.2 +001500 Linux. NC4014.2 +001600 SPECIAL-NAMES. NC4014.2 +001700 SYSOUT NC4014.2 +001800 IS VDUNIT NC4014.2 +001900 ALPHABET NC4014.2 +002000 TEST-ALPHABET IS "A" THRU "F" NC4014.2 +002100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +002200 NC4014.2 +002300 NC4014.2 +002400 SYMBOLIC CHARACTERS A IS 32. NC4014.2 +002500*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +002600 NC4014.2 +002700 NC4014.2 +002800 INPUT-OUTPUT SECTION. NC4014.2 +002900 FILE-CONTROL. NC4014.2 +003000 SELECT TFIL ASSIGN NC4014.2 +003100 "XXXXX001". NC4014.2 +003200 SELECT TFIL-2 ASSIGN NC4014.2 +003300 "XXXXX002". NC4014.2 +003400 DATA DIVISION. NC4014.2 +003500 FILE SECTION. NC4014.2 +003600 FD TFIL. NC4014.2 +003700 01 FREC. NC4014.2 +003800 03 GUBBINS PIC X(1 NC4014.2 +003900- 00). NC4014.2 +004000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +004100 NC4014.2 +004200 FD TFIL-2. NC4014.2 +004300 01 FREC-2. NC4014.2 +004400 03 COLONTEST PIC X(100). NC4014.2 +004500 03 GUBBINS PIC X(100). NC4014.2 +004600 NC4014.2 +004700 NC4014.2 +004800 WORKING-STORAGE SECTION. NC4014.2 +004900 NC4014.2 +005000 01 TEST-CUSTOMER-RECORD. NC4014.2 +005100 03 TEST-AR-CUSTOMER-ID PIC X(4). NC4014.2 +005200 03 TEST-AR-CUSTOMER-NAME PIC X(20). NC4014.2 +005300 03 TEST-AR-NUMBER-INVOICES PIC S9(2). NC4014.2 +005400 03 TEST-AR-INVOICE-DATA OCCURS 1 TO 15 TIMES NC4014.2 +005500 DEPENDING ON NC4014.2 +005600 TEST-AR-NUMBER-INVOICES NC4014.2 +005700 INDEXED BY WS-INDEX. NC4014.2 +005800*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +005900 NC4014.2 +006000 05 TEST-INVOICE-DATE. NC4014.2 +006100 07 TEST-INVOICE-YY PIC 99. NC4014.2 +006200 07 TEST-INVOICE-MM PIC 99. NC4014.2 +006300 07 TEST-INVOICE-DD PIC 99. NC4014.2 +006400 NC4014.2 +006500 01 TEST-DESCEND-RECORD. NC4014.2 +006600 03 TEST-DESCEND-CUST-ID PIC X(4). NC4014.2 +006700 03 TEST-DESCEND-CUST-NAME PIC X(20). NC4014.2 +006800 03 TEST-DESCEND-NO-INV PIC S9(2). NC4014.2 +006900 03 TEST-DESCEND-INVOICE OCCURS 15 TIMES NC4014.2 +007000 ASCENDING KEY IS NC4014.2 +007100 TEST-ASCEND-TIME NC4014.2 +007200 DESCENDING KEY IS NC4014.2 +007300 TEST-DESC-DATE. NC4014.2 +007400*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +007500 NC4014.2 +007600 NC4014.2 +007700 05 TEST-DESC-DATE. NC4014.2 +007800 07 TEST-DESC-YY PIC 99. NC4014.2 +007900 07 TEST-DESC-MM PIC 99. NC4014.2 +008000 07 TEST-DESC-DD PIC 99. NC4014.2 +008100 05 TEST-ASCEND-TIME PIC 9(6). NC4014.2 +008200 NC4014.2 +008300 01 TEST-CODE-TABLE. NC4014.2 +008400 03 TEST-CODE PIC X(3) NC4014.2 +008500 OCCURS 40 TIMES NC4014.2 +008600 INDEXED BY CODE-INDEX. NC4014.2 +008700 NC4014.2 +008800 01 CUST-REC. NC4014.2 +008900 03 CUST-CODES PIC X. NC4014.2 +009000 88 CUST-PAID VALUE "A". NC4014.2 +009100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +009200 NC4014.2 +009300 NC4014.2 +009400 01 GROUP-1. NC4014.2 +009500 03 ITEM-1 PIC 99 VALUE 10. NC4014.2 +009600 03 ITEM-2 PIC 99 VALUE 12. NC4014.2 +009700 03 ITEM-3 PIC 99 VALUE 14. NC4014.2 +009800 NC4014.2 +009900 01 GROUP-2. NC4014.2 +010000 03 ITEM-1 PIC 99 VALUE 10. NC4014.2 +010100 03 ITEM-2 PIC 99 VALUE 12. NC4014.2 +010200 03 ITEM-3 PIC 99 VALUE 14. NC4014.2 +010300 NC4014.2 +010400 01 SALES-DATA. NC4014.2 +010500 03 STORE-INFO PIC X(30). NC4014.2 +010600 03 MON-SALES OCCURS 2 TIMES. NC4014.2 +010700 05 AM-SALES PIC 9(3). NC4014.2 +010800 05 TUE-SALES OCCURS 2 TIMES. NC4014.2 +010900 07 AM-SALES PIC 9(3). NC4014.2 +011000 07 WED-SALES OCCURS 2 TIMES. NC4014.2 +011100 09 AM-SALES PIC 9(3). NC4014.2 +011200 09 THU-SALES OCCURS 2 TIMES. NC4014.2 +011300 11 AM-SALES PIC 9(3). NC4014.2 +011400 11 FRI-SALES OCCURS 2 TIMES. NC4014.2 +011500 13 PM-SALES PIC 9(3). NC4014.2 +011600 NC4014.2 +011700 01 VARIABLES. NC4014.2 +011800 03 EDFIELD PIC Z,ZZZ.99. NC4014.2 +011900 NC4014.2 +012000 NC4014.2 +012100 03 STATE PIC X(4) VALUE ALL "A". NC4014.2 +012200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +012300 NC4014.2 +012400 NC4014.2 +012500 03 RKEY PIC 9(8) VALUE ZERO. NC4014.2 +012600 NC4014.2 +012700 NC4014.2 +012800 NC4014.2 +012900 03 GRANDTOTAL PIC 9(7)V99 VALUE ZERO. NC4014.2 +013000 03 BOX-A PIC 99 VALUE ZERO. NC4014.2 +013100 03 BOX-B PIC 99 VALUE ZERO. NC4014.2 +013200 03 BOX-C PIC 999 VALUE ZERO. NC4014.2 +013300 03 BOX-D PIC 999 VALUE ZERO. NC4014.2 +013400 NC4014.2 +013500 NC4014.2 +013600 03 MARYPOPPINS PIC X(34) VALUE "SUPERCALIFRAGILISTICEXPIALIDONC4014.2 +013700- "CIOUS". NC4014.2 +013800 03 MP-1 REDEFINES MARYPOPPINS. NC4014.2 +013900 04 MP-1-A PICTURE X(5). NC4014.2 +014000 04 MP-1-A-1 REDEFINES MP-1-A. NC4014.2 +014100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +014200 05 MP-1-A-1-A PICTURE X(3). NC4014.2 +014300 05 FILLER PICTURE X(2). NC4014.2 +014400 04 FILLER PICTURE X(29). NC4014.2 +014500 NC4014.2 +014600 03 VARA PIC X(4). NC4014.2 +014700 03 VARB PIC X(4). NC4014.2 +014800 03 VARC PIC X(4). NC4014.2 +014900 66 VARA NC4014.2 +015000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +015100 RENAMES VARB THRU VARC. NC4014.2 +015200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +015300 NC4014.2 +015400 NC4014.2 +015500 01 DDAY PIC 9(5). NC4014.2 +015600 NC4014.2 +015700 01 VARD PIC X(4). NC4014.2 +015800 NC4014.2 +015900 01 VARE PIC X(4). NC4014.2 +016000 NC4014.2 +016100 01 VARF PIC 9(7)V99. NC4014.2 +016200 NC4014.2 +016300 PROCEDURE DIVISION. NC4014.2 +016400 NC4014.2 +016500 NC4014.2 +016600 NC401M-CONTROL. NC4014.2 +016700 OPEN INPUT TFIL. NC4014.2 +016800 PERFORM NC401M-COLON THRU NC401M-END 1 TIMES. NC4014.2 +016900 ALTER NC401M-GOTO TO PROCEED TO NC401M-GOTO-2, NC4014.2 +017000 NC401M-GOTO-2 TO PROCEED TO NC401M-NESTIF. NC4014.2 +017100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +017200 CLOSE TFIL. NC4014.2 +017300 STOP RUN. NC4014.2 +017400 NC4014.2 +017500 NC4014.2 +017600 NC401M-COLON. NC4014.2 +017700 DISPLAY COLONTEST(1:20). NC4014.2 +017800*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +017900 NC4014.2 +018000 NC4014.2 +018100 NC401M-QUALIF. NC4014.2 +018200 MOVE GUBBINS OF FREC TO GUBBINS OF FREC-2. NC4014.2 +018300*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +018400 NC4014.2 +018500 NC4014.2 +018600 NC401M-SUBSCR. NC4014.2 +018700 MOVE ZERO TO NC4014.2 +018800 PM-SALES (BOX-A, BOX-B, BOX-C, BOX-D, 1). NC4014.2 +018900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +019000 NC4014.2 +019100 NC401M-CHARBR1. NC4014.2 +019200 MUL NC4014.2 +019300- TIPLY BOX-A BY BOX-B GIVING BOX-C. NC4014.2 +019400*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +019500 NC4014.2 +019600 NC4014.2 +019700 NC401M-CHARBR2. NC4014.2 +019800 MOVE 2 NC4014.2 +019900- 0 TO BOX-A. NC4014.2 +020000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +020100 NC4014.2 +020200 NC401M-ARITHEXP. NC4014.2 +020300 IF BOX-A + 1 IS NOT GREATER THAN BOX-B + 2 NC4014.2 +020400 DISPLAY "ARITHEXP-TEST". NC4014.2 +020500*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +020600 NC4014.2 +020700 NC4014.2 +020800 NC401M-SIGCOND. NC4014.2 +020900 IF BOX-A IS NOT NEGATIVE NC4014.2 +021000 DISPLAY "SIGCOND-TEST". NC4014.2 +021100*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +021200 NC4014.2 +021300 NC4014.2 +021400 NC401M-COMPCOND. NC4014.2 +021500 IF BOX-A IS GREATER THAN BOX-B AND NOT BOX-C IS GREATER NC4014.2 +021600 THAN BOX-A THEN MOVE 7 TO BOX-B. NC4014.2 +021700*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +021800 NC4014.2 +021900 NC4014.2 +022000 NC401M-CORRESADD. NC4014.2 +022100 ADD CORRESPONDING GROUP-1 TO GROUP-2. NC4014.2 +022200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +022300 NC4014.2 +022400 NC4014.2 +022500 NC401M-CORRESMOVE. NC4014.2 +022600 MOVE CORRESPONDING GROUP-1 TO GROUP-2. NC4014.2 +022700*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +022800 NC4014.2 +022900 NC4014.2 +023000 NC401M-CORRESSUB. NC4014.2 +023100 SUBTRACT CORRESPONDING GROUP-2 FROM GROUP-1. NC4014.2 +023200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +023300 NC4014.2 +023400 NC4014.2 +023500 NC401M-COMPUTE. NC4014.2 +023600 COMPUTE BOX-A = 10 + 6. NC4014.2 +023700*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +023800 NC4014.2 +023900 NC4014.2 +024000 NC401M-GETDAY. NC4014.2 +024100 ACCEPT DDAY FROM DAY-OF-WEEK. NC4014.2 +024200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +024300 NC4014.2 +024400 NC4014.2 +024500 NC401M-DISPUPON. NC4014.2 +024600 DISPLAY "PFILE" UPON VDUNIT. NC4014.2 +024700*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +024800 NC4014.2 +024900 NC4014.2 +025000 NC401-DIVREMAINDER. NC4014.2 +025100 DIVIDE BOX-A INTO BOX-B GIVING BOX-C REMAINDER BOX-D. NC4014.2 +025200*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +025300 NC4014.2 +025400 NC4014.2 +025500 NC401M-EVAL. NC4014.2 +025600 EVALUATE BOX-A NC4014.2 +025700 WHEN 1 MOVE "A" TO VARC NC4014.2 +025800 WHEN 2 MOVE "B" TO VARC. NC4014.2 +025900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +026000 NC4014.2 +026100 NC4014.2 +026200 NC401M-GOTO. NC4014.2 +026300 GO TO. NC4014.2 +026400*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +026500 NC4014.2 +026600 NC401M-GOTO-2. NC4014.2 +026700 GO TO. NC4014.2 +026800*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +026900 NC4014.2 +027000 NC4014.2 +027100 NC401M-NESTIF. NC4014.2 +027200 IF BOX-A IS GREATER THAN BOX-B THEN NC4014.2 +027300 MOVE "AAAA" TO VARD NC4014.2 +027400 ELSE NC4014.2 +027500 IF BOX-B IS GREATER THAN BOX-C THEN NC4014.2 +027600 MOVE "BBBB" TO VARD NC4014.2 +027700 ELSE NC4014.2 +027800 MOVE "CCCC" TO VARD. NC4014.2 +027900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +028000 NC4014.2 +028100 NC4014.2 +028200 NC401M-INIT. NC4014.2 +028300 INITIALIZE VARB. NC4014.2 +028400*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +028500 NC4014.2 +028600 NC4014.2 +028700 NC401M-INSCT. NC4014.2 +028800 INSPECT MARYPOPPINS CONVERTING "A" TO "Z". NC4014.2 +028900*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +029000 NC4014.2 +029100 NC4014.2 +029200 NC4014.2 +029300 NC401M-PWT. NC4014.2 +029400 PERFORM NC401M-NESTIF THRU NC401M-INIT WITH TEST AFTER NC4014.2 +029500 UNTIL BOX-B IS EQUAL TO BOX-A. NC4014.2 +029600*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +029700 NC4014.2 +029800 NC4014.2 +029900 NC401M-PWV. NC4014.2 +030000 PERFORM NC401M-NESTIF THRU NC401M-INIT NC4014.2 +030100 VARYING BOX-A FROM BOX-B BY BOX-C NC4014.2 +030200 UNTIL GRANDTOTAL IS EQUAL TO VARF. NC4014.2 +030300*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +030400 NC4014.2 +030500 NC4014.2 +030600 NC401M-SEARCH. NC4014.2 +030700 SEARCH TEST-CODE NC4014.2 +030800 WHEN BOX-A IS EQUAL TO BOX-B NC4014.2 +030900 NEXT SENTENCE. NC4014.2 +031000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +031100 NC4014.2 +031200 NC4014.2 +031300 NC401M-STT. NC4014.2 +031400 SET CUST-PAID TO TRUE. NC4014.2 +031500*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +031600 NC4014.2 +031700 NC4014.2 +031800 NC401M-ST. NC4014.2 +031900 STRING VARD DELIMITED BY VARB INTO VARC. NC4014.2 +032000*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +032100 NC4014.2 +032200 NC4014.2 +032300 NC401M-UST. NC4014.2 +032400 UNSTRING VARD INTO VARE. NC4014.2 +032500*Message expected for above statement: NON-CONFORMING STANDARD NC4014.2 +032600 NC4014.2 +032700 NC4014.2 +032800 NC401M-END. NC4014.2 +032900 NC4014.2 +033000*TOTAL NUMBER OF FLAGS EXPECTED = 40. NC4014.2 +033100*Message expected for following statement: NON-CONFORMING STANDARDNC4014.2 +033200 END PROGRAM NC401M. NC4014.2 diff --git a/tests/cobol85/NC/report.txt b/tests/cobol85/NC/report.txt new file mode 100755 index 00000000..ede2e38c --- /dev/null +++ b/tests/cobol85/NC/report.txt @@ -0,0 +1,105 @@ +Filename total pass fail deleted inspect +-------- ----- ---- ---- ------- ------- +NC101A.CBL 93 93 0 0 0 OK +NC102A.CBL ===== compile error ===== +NC103A.CBL ===== compile error ===== +NC104A.CBL ===== compile error ===== +NC105A.CBL ===== compile error ===== +NC106A.CBL ===== compile error ===== +NC107A.CBL ===== compile error ===== +NC108M.CBL ===== compile error ===== +NC109M.CBL ===== compile error ===== +NC110M.CBL ===== compile error ===== +NC111A.CBL ===== compile error ===== +NC112A.CBL ===== compile error ===== +NC113M.CBL ===== compile error ===== +NC114M.CBL ===== compile error ===== +NC115A.CBL ===== compile error ===== +NC116A.CBL ===== compile error ===== +NC117A.CBL ===== compile error ===== +NC118A.CBL ===== compile error ===== +NC119A.CBL ===== compile error ===== +NC120A.CBL ===== compile error ===== +NC121M.CBL ===== compile error ===== +NC122A.CBL ===== compile error ===== +NC123A.CBL ===== compile error ===== +NC124A.CBL ===== compile error ===== +NC125A.CBL ===== compile error ===== +NC126A.CBL ===== compile error ===== +NC127A.CBL ----- test skipped ----- +NC131A.CBL ===== compile error ===== +NC132A.CBL ===== compile error ===== +NC133A.CBL ===== compile error ===== +NC134A.CBL ===== compile error ===== +NC135A.CBL ===== compile error ===== +NC136A.CBL ===== compile error ===== +NC137A.CBL ===== compile error ===== +NC138A.CBL ===== compile error ===== +NC139A.CBL ===== compile error ===== +NC140A.CBL ===== compile error ===== +NC141A.CBL ===== compile error ===== +NC170A.CBL ===== compile error ===== +NC171A.CBL ===== compile error ===== +NC172A.CBL ===== compile error ===== +NC173A.CBL ===== compile error ===== +NC174A.CBL ===== compile error ===== +NC175A.CBL ===== compile error ===== +NC176A.CBL ===== compile error ===== +NC177A.CBL ===== compile error ===== +NC201A.CBL ===== compile error ===== +NC202A.CBL ===== compile error ===== +NC203A.CBL ===== compile error ===== +NC204M.CBL ===== compile error ===== +NC205A.CBL ===== compile error ===== +NC206A.CBL ===== compile error ===== +NC207A.CBL ===== compile error ===== +NC208A.CBL ===== compile error ===== +NC209A.CBL ===== compile error ===== +NC210A.CBL ===== compile error ===== +NC211A.CBL ===== compile error ===== +NC214M.CBL ===== compile error ===== +NC215A.CBL ===== compile error ===== +NC216A.CBL ===== compile error ===== +NC217A.CBL ===== compile error ===== +NC218A.CBL ===== compile error ===== +NC219A.CBL ===== compile error ===== +NC220M.CBL ===== compile error ===== +NC221A.CBL ===== compile error ===== +NC222A.CBL ===== compile error ===== +NC223A.CBL ===== compile error ===== +NC224A.CBL ===== compile error ===== +NC225A.CBL ===== compile error ===== +NC231A.CBL ===== compile error ===== +NC232A.CBL ===== compile error ===== +NC233A.CBL ===== compile error ===== +NC234A.CBL ===== compile error ===== +NC235A.CBL ===== compile error ===== +NC236A.CBL ===== compile error ===== +NC237A.CBL ===== compile error ===== +NC238A.CBL ===== compile error ===== +NC239A.CBL ===== compile error ===== +NC240A.CBL ===== compile error ===== +NC241A.CBL ===== compile error ===== +NC242A.CBL ===== compile error ===== +NC243A.CBL ===== compile error ===== +NC244A.CBL ===== compile error ===== +NC245A.CBL ===== compile error ===== +NC246A.CBL ===== compile error ===== +NC247A.CBL ===== compile error ===== +NC248A.CBL ===== compile error ===== +NC250A.CBL ===== compile error ===== +NC251A.CBL ===== compile error ===== +NC252A.CBL ===== compile error ===== +NC253A.CBL ===== compile error ===== +NC254A.CBL ===== compile error ===== +NC302M.CBL ----- test skipped ----- +NC303M.CBL ----- test skipped ----- +NC401M.CBL ----- test skipped ----- +-------- ----- ---- ---- ------- ------- +Total 93 93 0 0 0 +% 100.0 100.0 0.0 0.0 0.0 + +Number of programs: 91 +Successfully executed: 1 ( 1.10%) +Compile error: 90 (98.90%) +Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/NC/tmp.cbl b/tests/cobol85/NC/tmp.cbl new file mode 100755 index 00000000..6f7b3d67 --- /dev/null +++ b/tests/cobol85/NC/tmp.cbl @@ -0,0 +1,671 @@ +000100 IDENTIFICATION DIVISION. NC2544.2 +000200 PROGRAM-ID. NC2544.2 +000300 NC254A. NC2544.2 +000400**************************************************************** NC2544.2 +000500* * NC2544.2 +000600* VALIDATION FOR:- * NC2544.2 +000700* * NC2544.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +000900* * NC2544.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2544.2 +001100* * NC2544.2 +001200**************************************************************** NC2544.2 +001300* * NC2544.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * NC2544.2 +001500* * NC2544.2 +001600* X-55 - SYSTEM PRINTER NAME. * NC2544.2 +001700* X-82 - SOURCE COMPUTER NAME. * NC2544.2 +001800* X-83 - OBJECT COMPUTER NAME. * NC2544.2 +001900* * NC2544.2 +002000**************************************************************** NC2544.2 +002100* NC2544.2 +002200* PROGRAM NC254A TESTS SWITCH SETTINGS USING LEVEL 2 FEATURES NC2544.2 +002300* LOGICAL OPERATORS AND, OR, NOT. NC2544.2 +002400* NC2544.2 +002500 ENVIRONMENT DIVISION. NC2544.2 +002600 CONFIGURATION SECTION. NC2544.2 +002700 SOURCE-COMPUTER. NC2544.2 +002800 Linux. NC2544.2 +002900 OBJECT-COMPUTER. NC2544.2 +003000 Linux. NC2544.2 +003100 SPECIAL-NAMES. NC2544.2 +003200 SWITCH-1 NC2544.2 +003300 IS SW-1 NC2544.2 +003400 ON STATUS IS ON-SWITCH-1 NC2544.2 +003500 OFF STATUS IS OFF-SWITCH-1 NC2544.2 +003600 SWITCH-2 NC2544.2 +003700 IS SW-2 NC2544.2 +003800 ON IS ON-SWITCH-2 NC2544.2 +003900 OFF IS OFF-SWITCH-2 NC2544.2 +004000 CLASS ORDINAL-A-ONLY IS NC2544.2 +004100 "A" NC2544.2 +004200 CLASS ORDINAL-A-THROUGH-D IS NC2544.2 +004300 "A" NC2544.2 +004400 THROUGH NC2544.2 +004500 "D" NC2544.2 +004600 CLASS ORDINAL-D-THRU-A NC2544.2 +004700 "D" NC2544.2 +004800 THRU NC2544.2 +004900 "A" NC2544.2 +005000 CLASS ACTUAL-A-ONLY "A" NC2544.2 +005100 CLASS ACTUAL-A-THRU-D IS "A" THRU "D" NC2544.2 +005200 CLASS ACTUAL-D-THROUGH-A IS "D" THROUGH "A" NC2544.2 +005300 CLASS ACTUAL-ABCD "ABCD". NC2544.2 +005400 INPUT-OUTPUT SECTION. NC2544.2 +005500 FILE-CONTROL. NC2544.2 +005600 SELECT PRINT-FILE ASSIGN TO NC2544.2 +005700 "report.log". NC2544.2 +005800 DATA DIVISION. NC2544.2 +005900 FILE SECTION. NC2544.2 +006000 FD PRINT-FILE. NC2544.2 +006100 01 PRINT-REC PICTURE X(120). NC2544.2 +006200 01 DUMMY-RECORD PICTURE X(120). NC2544.2 +006300 WORKING-STORAGE SECTION. NC2544.2 +006400 01 WS-A PIC X. NC2544.2 +006500 01 WS-B PIC X(5). NC2544.2 +006600 01 IF-D1 PICTURE IS S9(4)V9(2) NC2544.2 +006700 VALUE IS 0. NC2544.2 +006800 01 IF-D2 PICTURE IS S9(4)V9(2) NC2544.2 +006900 VALUE IS ZERO. NC2544.2 +007000 01 IF-D3 PICTURE IS X(10) NC2544.2 +007100 VALUE IS "0000000000". NC2544.2 +007200 01 IF-D4 PICTURE IS X(15) NC2544.2 +007300 VALUE IS " ". NC2544.2 +007400 01 IF-D6 PICTURE IS A(10) NC2544.2 +007500 VALUE IS "BABABABABA". NC2544.2 +007600 01 IF-D7 PICTURE IS S9(6)V9(4) NC2544.2 +007700 VALUE IS +123.45. NC2544.2 +007800 01 IF-D8 PICTURE IS 9(6)V9(4) NC2544.2 +007900 VALUE IS 12300. NC2544.2 +008000 01 IF-D9 PICTURE IS X(3) NC2544.2 +008100 VALUE IS "123". NC2544.2 +008200 01 IF-D11 PICTURE IS X(6) NC2544.2 +008300 VALUE IS "ABCDEF". NC2544.2 +008400 01 IF-D13 PICTURE IS 9(6)V9(4) NC2544.2 +008500 VALUE IS 12300. NC2544.2 +008600 01 IF-D14 PICTURE IS S9(4)V9(2) NC2544.2 +008700 VALUE IS +123.45. NC2544.2 +008800 01 IF-D15 PICTURE IS S999PP NC2544.2 +008900 VALUE IS 12300. NC2544.2 +009000 01 IF-D16 PICTURE IS PP99 NC2544.2 +009100 VALUE IS .0012. NC2544.2 +009200 01 IF-D17 PICTURE IS SV9(4) NC2544.2 +009300 VALUE IS .0012. NC2544.2 +009400 01 IF-D18 PICTURE IS X(10) NC2544.2 +009500 VALUE IS "BABABABABA". NC2544.2 +009600 01 IF-D19 PICTURE IS X(10) NC2544.2 +009700 VALUE IS "ABCDEF ". NC2544.2 +009800 01 IF-D23 PICTURE IS $9,9B9.90+. NC2544.2 +009900 01 IF-D24 PICTURE IS X(10) NC2544.2 +010000 VALUE IS "$1,2 3.40+". NC2544.2 +010100 01 IF-D25 PICTURE IS ABABX0A. NC2544.2 +010200 01 IF-D26 PIC X(7) NC2544.2 +010300 VALUE IS "A C D0E". NC2544.2 +010400 01 IF-D27 PICTURE 9(6)V9(4) VALUE 2137.45 NC2544.2 +010500 USAGE IS COMPUTATIONAL. NC2544.2 +010600 01 IF-D28 PICTURE IS 999999V9999 NC2544.2 +010700 VALUE IS 2137.45. NC2544.2 +010800 01 IF-D32 PICTURE IS 9 VALUE IS 0. NC2544.2 +010900 01 IF-D33 PICTURE S9 VALUE -0. NC2544.2 +011000 01 IF-D34 PICTURE S9 VALUE +0. NC2544.2 +011100 01 IF-D37 PICTURE 9(5) VALUE 0001234. NC2544.2 +011200 01 IF-D38 PICTURE X(20) VALUE " BABBAGE". NC2544.2 +011300 01 ALPHA-UPPER PIC X(20) VALUE " UPPERCASE CHARS". NC2544.2 +011400 01 ALPHA-LOWER PIC X(20) VALUE " lowercase chars". NC2544.2 +011500 01 NON-COBOL-CHARACTERS PICTURE X(8) VALUE NC2544.2 +011600 "12345678". NC2544.2 +011700 01 AZERO-DS-05V05 PICTURE S9(5)V9(5) VALUE ZERO. NC2544.2 +011800 01 A18ONES-DS-18V00 PICTURE S9(18) NC2544.2 +011900 VALUE 111111111111111111. NC2544.2 +012000 01 ONES-XN-00018 PICTURE X(18) NC2544.2 +012100 VALUE "111111111111111111". NC2544.2 +012200 01 A99-DS-02V00 PICTURE S99 VALUE 99. NC2544.2 +012300 01 WRK-DU-02V00 PICTURE 99. NC2544.2 +012400 01 TWOS-XN-00002 PICTURE XX VALUE "22". NC2544.2 +012500 01 A18ONES-DS-09V09 PICTURE S9(9)V9(9) NC2544.2 +012600 VALUE 111111111.111111111. NC2544.2 +012700 01 ONES-XN-00002 PICTURE XX VALUE "11". NC2544.2 +012800 01 A02TWOS-DU-02V00 PICTURE 99 VALUE 22. NC2544.2 +012900 01 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001. NC2544.2 +013000 01 A990-DS-0201P PICTURE S99P VALUE +990. NC2544.2 +013100 01 XDATA-XN-00018 PICTURE X(18) NC2544.2 +013200 VALUE "00ABCDEFGHI 4321 ". NC2544.2 +013300 01 XDATA-DS-18V00-S REDEFINES XDATA-XN-00018 PICTURE S9(18). NC2544.2 +013400 01 YADATA-XN-00010 PICTURE X(10) VALUE "ABCDEFGHIJ".NC2544.2 +013500 01 YADATA-XN-00010-U-AND-L PICTURE X(10) VALUE "AbCdEfGhIj".NC2544.2 +013600 01 DUMMY-DS-00001 PICTURE S9 VALUE -1. NC2544.2 +013700 01 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. NC2544.2 +013800 01 WRK-DS-18V0-1 PIC S9(18) VALUE NC2544.2 +013900 -123456789012345678. NC2544.2 +014000 01 WRK-XN-18-2 PIC X(18) VALUE NC2544.2 +014100 "123456789012345678". NC2544.2 +014200 NC2544.2 +014300 01 IF-D10. NC2544.2 +014400 02 FILLER PICTURE XX VALUE "01". NC2544.2 +014500 02 FILLER PICTURE XX VALUE "23". NC2544.2 +014600 02 IF-D10A. NC2544.2 +014700 03 FILLER PICTURE XXXX VALUE "4567". NC2544.2 +014800 03 FILLER PICTURE XXXX VALUE "8912". NC2544.2 +014900 01 IF-D12. NC2544.2 +015000 02 FILLER PICTURE XXX VALUE "ABC". NC2544.2 +015100 02 IF-D12A. NC2544.2 +015200 03 IF-D12B. NC2544.2 +015300 04 FILLER PICTURE XX VALUE "DE". NC2544.2 +015400 04 FILLER PICTURE X VALUE "F". NC2544.2 +015500 01 IF-D20. NC2544.2 +015600 02 FILLER PICTURE 9(5) VALUE ZERO. NC2544.2 +015700 02 FILLER PICTURE 99 VALUE 12. NC2544.2 +015800 02 FILLER PICTURE 9 VALUE 3. NC2544.2 +015900 02 FILLER PICTURE 99 VALUE 45. NC2544.2 +016000 01 IF-D21. NC2544.2 +016100 02 FILLER PICTURE 9(5) VALUE ZERO. NC2544.2 +016200 02 FILLER PICTURE 9(5) VALUE 12345. NC2544.2 +016300 01 IF-D22. NC2544.2 +016400 02 FILLER PICTURE AA VALUE "AB". NC2544.2 +016500 02 FILLER PICTURE AAAA VALUE "CDEF". NC2544.2 +016600 01 IF-D35. NC2544.2 +016700 02 IF-D35A VALUE "*ASTERISK". NC2544.2 +016800 03 FILLER PICTURE A(6). NC2544.2 +016900 03 FILLER PICTURE AAA. NC2544.2 +017000 02 IF-D35B VALUE "/SLASH". NC2544.2 +017100 03 FILLER PICTURE 9(6). NC2544.2 +017200 01 IF-D36 REDEFINES IF-D35. NC2544.2 +017300 02 IF-D36A PICTURE X(6). NC2544.2 +017400 02 IF-D36B PICTURE XXX. NC2544.2 +017500 02 IF-D36C PICTURE X(6). NC2544.2 +017600 01 IF-D39. NC2544.2 +017700 02 FILLER PICTURE A(6) VALUE "ABCDEF". NC2544.2 +017800 02 FILLER PICTURE A(4) VALUE SPACE. NC2544.2 +017900 01 LEVEL-01. NC2544.2 +018000 02 LEVEL-02. NC2544.2 +018100 03 LEVEL-03. NC2544.2 +018200 04 LEVEL-04. NC2544.2 +018300 05 LEVEL-05. NC2544.2 +018400 06 LEVEL-06. NC2544.2 +018500 07 LEVEL-07. NC2544.2 +018600 08 LEVEL-08. NC2544.2 +018700 09 LEVEL-09. NC2544.2 +018800 10 LEVEL-10 PICTURE IS X VALUE IS "R".NC2544.2 +018900 01 LEVEL-RECEIVER PICTURE IS X VALUE IS NC2544.2 +019000 SPACE. NC2544.2 +019100 01 LEVEL-SENDER PICTURE X VALUE "S". NC2544.2 +019200 01 VAL PICTURE IS 9 VALUE IS 0. NC2544.2 +019300 01 A-2 PICTURE IS A VALUE IS "A".NC2544.2 +019400 01 N-27 PICTURE IS 9999V9 NC2544.2 +019500 VALUE IS 9999.9. NC2544.2 +019600 01 N-30 PICTURE IS 9V9 NC2544.2 +019700 VALUE IS 2. NC2544.2 +019800 01 N-31 PICTURE IS 9(6). NC2544.2 +019900 01 X-32 REDEFINES N-31 PICTURE IS X(6). NC2544.2 +020000 01 N-33 PICTURE IS 9(5) NC2544.2 +020100 VALUE IS 29. NC2544.2 +020200 01 A-37 PICTURE IS A VALUE IS "X".NC2544.2 +020300 01 X-38 REDEFINES A-37 PICTURE IS X. NC2544.2 +020400 01 X-43 PIC X(10) VALUE " l75.63". NC2544.2 +020500 01 N-84 PICTURE IS 9999999999. NC2544.2 +020600 01 NUMERIC-GRP-TEST. NC2544.2 +020700 02 NUMERIC-1 PICTURE 9 VALUE 0. NC2544.2 +020800 02 NUMERIC-2. NC2544.2 +020900 03 NUMERIC-3 PICTURE 9(1)V9(1) VALUE ZERO. NC2544.2 +021000 03 NUMERIC-4. NC2544.2 +021100 04 NUMERIC-5 PICTURE 9(18) VALUE 1. NC2544.2 +021200 02 NUMERIC-6. NC2544.2 +021300 03 NUMERIC-7 PICTURE X VALUE "7". NC2544.2 +021400 03 NUMERIC-8 PICTURE 9 VALUE 8. NC2544.2 +021500 01 NUM-GRP. NC2544.2 +021600 02 NUM-SUB-GRP PIC 9. NC2544.2 +021700 01 GROUP-1000. NC2544.2 +021800 02 FILLER PIC X. NC2544.2 +021900 02 GROUP-X1000. NC2544.2 +022000 03 GROUP-1000-1 PIC X(500) VALUE ZERO. NC2544.2 +022100 03 XNAME PICTURE X(100) VALUE QUOTE. NC2544.2 +022200 03 GROUP-1000-2 PICTURE X(399) VALUE SPACE. NC2544.2 +022300 03 GROUP-1000-3 PICTURE X VALUE ".". NC2544.2 +022400 02 GROUP-X500-2. NC2544.2 +022500 03 GROUP-X500-A PICTURE X(500) VALUE ZERO. NC2544.2 +022600 03 GROUP-X500-1. NC2544.2 +022700 04 GROUP-X500-1-1 PICTURE X(50) VALUE QUOTE. NC2544.2 +022800 04 GROUP-X500-1-2 PICTURE X(50) VALUE QUOTE. NC2544.2 +022900 04 GROUP-X500-1-3 PICTURE X(398) VALUE SPACE. NC2544.2 +023000 04 GROUP-X500-1-4 PICTURE XX VALUE " .". NC2544.2 +023100 01 HI-LO-VALUES. NC2544.2 +023200 02 LOW-VAL PIC X VALUE LOW-VALUE. NC2544.2 +023300 02 ZERO-01 PICTURE 9(18) VALUE 1. NC2544.2 +023400 02 ABC PICTURE XXX VALUE "ABC". NC2544.2 +023500 02 NINE-17-8 PICTURE 9(18) VALUE 999999999999999998. NC2544.2 +023600 02 ZERO-NULL PIC 9(9) VALUE 0. NC2544.2 +023700 02 ZERO-ZERO PICTURE 9(9)V9(9) VALUE 0.0. NC2544.2 +023800 01 COMP-DATA. NC2544.2 +023900 02 COMP-DATA1 PICTURE 9(18) COMPUTATIONAL VALUE 300. NC2544.2 +024000 02 COMP-DATA2 PICTURE 9(10) COMPUTATIONAL VALUE 100000. NC2544.2 +024100 02 COMP-DATA3 PICTURE 9 COMPUTATIONAL VALUE 9. NC2544.2 +024200 02 COMP-DATA4 PICTURE 9(9)V9(7) COMPUTATIONAL VALUE 3.3. NC2544.2 +024300 02 COMP-DATA5 PICTURE 9(5)V9(2) COMPUTATIONAL VALUE 52.25. NC2544.2 +024400 02 COMP-DATA6 PICTURE 9V9 COMPUTATIONAL VALUE 8.8. NC2544.2 +024500 02 COMP-DATA7 PICTURE 9(3)V9(2) COMPUTATIONAL VALUE 300.00.NC2544.2 +024600 02 COMP-DATA8 PICTURE 9V9(9) COMPUTATIONAL VALUE 3.3000000.NC2544.2 +024700 02 COMP-DATA9 PICTURE 9(8) COMPUTATIONAL VALUE 100000. NC2544.2 +024800 01 DISP-DATA. NC2544.2 +024900 02 DISP-DATA1 PICTURE 9(18) VALUE 300. NC2544.2 +025000 02 DISP-DATA2 PICTURE 9(8) VALUE 100000. NC2544.2 +025100 02 DISP-DATA3 PICTURE 9 VALUE 9. NC2544.2 +025200 02 DISP-DATA4 PICTURE 9(7)V9(9) VALUE 3.3. NC2544.2 +025300 02 DISP-DATA5 PICTURE 9(2)V9(2) VALUE 52.25. NC2544.2 +025400 02 DISP-DATA6 PICTURE 9V9 VALUE 8.8. NC2544.2 +025500 01 DATA-5 PICTURE 9 VALUE 5. NC2544.2 +025600 01 DATA-99999 PICTURE S9(5) VALUE +99999. NC2544.2 +025700 01 DATA-Z PICTURE X VALUE "Z". NC2544.2 +025800 01 DATA-4 PICTURE 9 VALUE 4. NC2544.2 +025900 01 DATA-Y PICTURE X VALUE "Y". NC2544.2 +026000 01 DATA-VWXYZ PICTURE X(5) VALUE "VWXYZ". NC2544.2 +026100 01 DATA-ADCBA PICTURE X(5) VALUE "ADCBA". NC2544.2 +026200 01 TEST-RESULTS. NC2544.2 +026300 02 FILLER PIC X VALUE SPACE. NC2544.2 +026400 02 FEATURE PIC X(20) VALUE SPACE. NC2544.2 +026500 02 FILLER PIC X VALUE SPACE. NC2544.2 +026600 02 P-OR-F PIC X(5) VALUE SPACE. NC2544.2 +026700 02 FILLER PIC X VALUE SPACE. NC2544.2 +026800 02 PAR-NAME. NC2544.2 +026900 03 FILLER PIC X(19) VALUE SPACE. NC2544.2 +027000 03 PARDOT-X PIC X VALUE SPACE. NC2544.2 +027100 03 DOTVALUE PIC 99 VALUE ZERO. NC2544.2 +027200 02 FILLER PIC X(8) VALUE SPACE. NC2544.2 +027300 02 RE-MARK PIC X(61). NC2544.2 +027400 01 TEST-COMPUTED. NC2544.2 +027500 02 FILLER PIC X(30) VALUE SPACE. NC2544.2 +027600 02 FILLER PIC X(17) VALUE NC2544.2 +027700 " COMPUTED=". NC2544.2 +027800 02 COMPUTED-X. NC2544.2 +027900 03 COMPUTED-A PIC X(20) VALUE SPACE. NC2544.2 +028000 03 COMPUTED-N REDEFINES COMPUTED-A NC2544.2 +028100 PIC -9(9).9(9). NC2544.2 +028200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). NC2544.2 +028300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). NC2544.2 +028400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). NC2544.2 +028500 03 CM-18V0 REDEFINES COMPUTED-A. NC2544.2 +028600 04 COMPUTED-18V0 PIC -9(18). NC2544.2 +028700 04 FILLER PIC X. NC2544.2 +028800 03 FILLER PIC X(50) VALUE SPACE. NC2544.2 +028900 01 TEST-CORRECT. NC2544.2 +029000 02 FILLER PIC X(30) VALUE SPACE. NC2544.2 +029100 02 FILLER PIC X(17) VALUE " CORRECT =". NC2544.2 +029200 02 CORRECT-X. NC2544.2 +029300 03 CORRECT-A PIC X(20) VALUE SPACE. NC2544.2 +029400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). NC2544.2 +029500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). NC2544.2 +029600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). NC2544.2 +029700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). NC2544.2 +029800 03 CR-18V0 REDEFINES CORRECT-A. NC2544.2 +029900 04 CORRECT-18V0 PIC -9(18). NC2544.2 +030000 04 FILLER PIC X. NC2544.2 +030100 03 FILLER PIC X(2) VALUE SPACE. NC2544.2 +030200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. NC2544.2 +030300 01 CCVS-C-1. NC2544.2 +030400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PANC2544.2 +030500- "SS PARAGRAPH-NAME NC2544.2 +030600- " REMARKS". NC2544.2 +030700 02 FILLER PIC X(20) VALUE SPACE. NC2544.2 +030800 01 CCVS-C-2. NC2544.2 +030900 02 FILLER PIC X VALUE SPACE. NC2544.2 +031000 02 FILLER PIC X(6) VALUE "TESTED". NC2544.2 +031100 02 FILLER PIC X(15) VALUE SPACE. NC2544.2 +031200 02 FILLER PIC X(4) VALUE "FAIL". NC2544.2 +031300 02 FILLER PIC X(94) VALUE SPACE. NC2544.2 +031400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. NC2544.2 +031500 01 REC-CT PIC 99 VALUE ZERO. NC2544.2 +031600 01 DELETE-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031700 01 ERROR-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. NC2544.2 +031900 01 PASS-COUNTER PIC 999 VALUE ZERO. NC2544.2 +032000 01 TOTAL-ERROR PIC 999 VALUE ZERO. NC2544.2 +032100 01 ERROR-HOLD PIC 999 VALUE ZERO. NC2544.2 +032200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. NC2544.2 +032300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. NC2544.2 +032400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. NC2544.2 +032500 01 CCVS-H-1. NC2544.2 +032600 02 FILLER PIC X(39) VALUE SPACES. NC2544.2 +032700 02 FILLER PIC X(42) VALUE NC2544.2 +032800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". NC2544.2 +032900 02 FILLER PIC X(39) VALUE SPACES. NC2544.2 +033000 01 CCVS-H-2A. NC2544.2 +033100 02 FILLER PIC X(40) VALUE SPACE. NC2544.2 +033200 02 FILLER PIC X(7) VALUE "CCVS85 ". NC2544.2 +033300 02 FILLER PIC XXXX VALUE NC2544.2 +033400 "4.2 ". NC2544.2 +033500 02 FILLER PIC X(28) VALUE NC2544.2 +033600 " COPY - NOT FOR DISTRIBUTION". NC2544.2 +033700 02 FILLER PIC X(41) VALUE SPACE. NC2544.2 +033800 NC2544.2 +033900 01 CCVS-H-2B. NC2544.2 +034000 02 FILLER PIC X(15) VALUE NC2544.2 +034100 "TEST RESULT OF ". NC2544.2 +034200 02 TEST-ID PIC X(9). NC2544.2 +034300 02 FILLER PIC X(4) VALUE NC2544.2 +034400 " IN ". NC2544.2 +034500 02 FILLER PIC X(12) VALUE NC2544.2 +034600 " HIGH ". NC2544.2 +034700 02 FILLER PIC X(22) VALUE NC2544.2 +034800 " LEVEL VALIDATION FOR ". NC2544.2 +034900 02 FILLER PIC X(58) VALUE NC2544.2 +035000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +035100 01 CCVS-H-3. NC2544.2 +035200 02 FILLER PIC X(34) VALUE NC2544.2 +035300 " FOR OFFICIAL USE ONLY ". NC2544.2 +035400 02 FILLER PIC X(58) VALUE NC2544.2 +035500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".NC2544.2 +035600 02 FILLER PIC X(28) VALUE NC2544.2 +035700 " COPYRIGHT 1985 ". NC2544.2 +035800 01 CCVS-E-1. NC2544.2 +035900 02 FILLER PIC X(52) VALUE SPACE. NC2544.2 +036000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". NC2544.2 +036100 02 ID-AGAIN PIC X(9). NC2544.2 +036200 02 FILLER PIC X(45) VALUE SPACES. NC2544.2 +036300 01 CCVS-E-2. NC2544.2 +036400 02 FILLER PIC X(31) VALUE SPACE. NC2544.2 +036500 02 FILLER PIC X(21) VALUE SPACE. NC2544.2 +036600 02 CCVS-E-2-2. NC2544.2 +036700 03 ERROR-TOTAL PIC XXX VALUE SPACE. NC2544.2 +036800 03 FILLER PIC X VALUE SPACE. NC2544.2 +036900 03 ENDER-DESC PIC X(44) VALUE NC2544.2 +037000 "ERRORS ENCOUNTERED". NC2544.2 +037100 01 CCVS-E-3. NC2544.2 +037200 02 FILLER PIC X(22) VALUE NC2544.2 +037300 " FOR OFFICIAL USE ONLY". NC2544.2 +037400 02 FILLER PIC X(12) VALUE SPACE. NC2544.2 +037500 02 FILLER PIC X(58) VALUE NC2544.2 +037600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".NC2544.2 +037700 02 FILLER PIC X(13) VALUE SPACE. NC2544.2 +037800 02 FILLER PIC X(15) VALUE NC2544.2 +037900 " COPYRIGHT 1985". NC2544.2 +038000 01 CCVS-E-4. NC2544.2 +038100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. NC2544.2 +038200 02 FILLER PIC X(4) VALUE " OF ". NC2544.2 +038300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. NC2544.2 +038400 02 FILLER PIC X(40) VALUE NC2544.2 +038500 " TESTS WERE EXECUTED SUCCESSFULLY". NC2544.2 +038600 01 XXINFO. NC2544.2 +038700 02 FILLER PIC X(19) VALUE NC2544.2 +038800 "*** INFORMATION ***". NC2544.2 +038900 02 INFO-TEXT. NC2544.2 +039000 04 FILLER PIC X(8) VALUE SPACE. NC2544.2 +039100 04 XXCOMPUTED PIC X(20). NC2544.2 +039200 04 FILLER PIC X(5) VALUE SPACE. NC2544.2 +039300 04 XXCORRECT PIC X(20). NC2544.2 +039400 02 INF-ANSI-REFERENCE PIC X(48). NC2544.2 +039500 01 HYPHEN-LINE. NC2544.2 +039600 02 FILLER PIC IS X VALUE IS SPACE. NC2544.2 +039700 02 FILLER PIC IS X(65) VALUE IS "************************NC2544.2 +039800- "*****************************************". NC2544.2 +039900 02 FILLER PIC IS X(54) VALUE IS "************************NC2544.2 +040000- "******************************". NC2544.2 +040100 01 CCVS-PGM-ID PIC X(9) VALUE NC2544.2 +040200 "NC254A". NC2544.2 +040300 PROCEDURE DIVISION. NC2544.2 +040400 CCVS1 SECTION. NC2544.2 +040500 OPEN-FILES. NC2544.2 +040600 OPEN OUTPUT PRINT-FILE. NC2544.2 +040700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. NC2544.2 +040800 MOVE SPACE TO TEST-RESULTS. NC2544.2 +040900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. NC2544.2 +041000 GO TO CCVS1-EXIT. NC2544.2 +041100 CLOSE-FILES. NC2544.2 +041200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. NC2544.2 +041300 TERMINATE-CCVS. NC2544.2 +041400*S EXIT PROGRAM. NC2544.2 +041500*SERMINATE-CALL. NC2544.2 +041600 STOP RUN. NC2544.2 +041700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. NC2544.2 +041800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. NC2544.2 +041900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. NC2544.2 +042000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. NC2544.2 +042100 MOVE "****TEST DELETED****" TO RE-MARK. NC2544.2 +042200 PRINT-DETAIL. NC2544.2 +042300 IF REC-CT NOT EQUAL TO ZERO NC2544.2 +042400 MOVE "." TO PARDOT-X NC2544.2 +042500 MOVE REC-CT TO DOTVALUE. NC2544.2 +042600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. NC2544.2 +042700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE NC2544.2 +042800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX NC2544.2 +042900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. NC2544.2 +043000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. NC2544.2 +043100 MOVE SPACE TO CORRECT-X. NC2544.2 +043200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. NC2544.2 +043300 MOVE SPACE TO RE-MARK. NC2544.2 +043400 HEAD-ROUTINE. NC2544.2 +043500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +043600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +043700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2544.2 +043800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. NC2544.2 +043900 COLUMN-NAMES-ROUTINE. NC2544.2 +044000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +044100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +044200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +044300 END-ROUTINE. NC2544.2 +044400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.NC2544.2 +044500 END-RTN-EXIT. NC2544.2 +044600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +044700 END-ROUTINE-1. NC2544.2 +044800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO NC2544.2 +044900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. NC2544.2 +045000 ADD PASS-COUNTER TO ERROR-HOLD. NC2544.2 +045100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. NC2544.2 +045200 MOVE PASS-COUNTER TO CCVS-E-4-1. NC2544.2 +045300 MOVE ERROR-HOLD TO CCVS-E-4-2. NC2544.2 +045400 MOVE CCVS-E-4 TO CCVS-E-2-2. NC2544.2 +045500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. NC2544.2 +045600 END-ROUTINE-12. NC2544.2 +045700 MOVE "TEST(S) FAILED" TO ENDER-DESC. NC2544.2 +045800 IF ERROR-COUNTER IS EQUAL TO ZERO NC2544.2 +045900 MOVE "NO " TO ERROR-TOTAL NC2544.2 +046000 ELSE NC2544.2 +046100 MOVE ERROR-COUNTER TO ERROR-TOTAL. NC2544.2 +046200 MOVE CCVS-E-2 TO DUMMY-RECORD. NC2544.2 +046300 PERFORM WRITE-LINE. NC2544.2 +046400 END-ROUTINE-13. NC2544.2 +046500 IF DELETE-COUNTER IS EQUAL TO ZERO NC2544.2 +046600 MOVE "NO " TO ERROR-TOTAL ELSE NC2544.2 +046700 MOVE DELETE-COUNTER TO ERROR-TOTAL. NC2544.2 +046800 MOVE "TEST(S) DELETED " TO ENDER-DESC. NC2544.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047000 IF INSPECT-COUNTER EQUAL TO ZERO NC2544.2 +047100 MOVE "NO " TO ERROR-TOTAL NC2544.2 +047200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. NC2544.2 +047300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. NC2544.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. NC2544.2 +047600 WRITE-LINE. NC2544.2 +047700 ADD 1 TO RECORD-COUNT. NC2544.2 +047800 IF RECORD-COUNT GREATER 42 NC2544.2 +047900 MOVE DUMMY-RECORD TO DUMMY-HOLD NC2544.2 +048000 MOVE SPACE TO DUMMY-RECORD NC2544.2 +048100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE NC2544.2 +048200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2544.2 +048300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES NC2544.2 +048400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC2544.2 +048500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES NC2544.2 +048600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN NC2544.2 +048900 MOVE DUMMY-HOLD TO DUMMY-RECORD NC2544.2 +049000 MOVE ZERO TO RECORD-COUNT. NC2544.2 +049100 PERFORM WRT-LN. NC2544.2 +049200 WRT-LN. NC2544.2 +049300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. NC2544.2 +049400 MOVE SPACE TO DUMMY-RECORD. NC2544.2 +049500 BLANK-LINE-PRINT. NC2544.2 +049600 PERFORM WRT-LN. NC2544.2 +049700 FAIL-ROUTINE. NC2544.2 +049800 IF COMPUTED-X NOT EQUAL TO SPACE NC2544.2 +049900 GO TO FAIL-ROUTINE-WRITE. NC2544.2 +050000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.NC2544.2 +050100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2544.2 +050200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. NC2544.2 +050300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +050400 MOVE SPACES TO INF-ANSI-REFERENCE. NC2544.2 +050500 GO TO FAIL-ROUTINE-EX. NC2544.2 +050600 FAIL-ROUTINE-WRITE. NC2544.2 +050700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE NC2544.2 +050800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. NC2544.2 +050900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. NC2544.2 +051000 MOVE SPACES TO COR-ANSI-REFERENCE. NC2544.2 +051100 FAIL-ROUTINE-EX. EXIT. NC2544.2 +051200 BAIL-OUT. NC2544.2 +051300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. NC2544.2 +051400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. NC2544.2 +051500 BAIL-OUT-WRITE. NC2544.2 +051600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. NC2544.2 +051700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. NC2544.2 +051800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. NC2544.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. NC2544.2 +052000 BAIL-OUT-EX. EXIT. NC2544.2 +052100 CCVS1-EXIT. NC2544.2 +052200 EXIT. NC2544.2 +052300 SECT-NC254A-001 SECTION. NC2544.2 +052400* NC2544.2 +052500* NC2544.2 +052600 NEXT-INIT-GF-1. NC2544.2 +052700* ==--> NEXT SENTENCE <--== NC2544.2 +052800 MOVE "V1-89 6.15.4 GR2 " TO ANSI-REFERENCE. NC2544.2 +052900 MOVE "A" TO A-2. NC2544.2 +053000 NEXT-TEST-GF-1. NC2544.2 +053100 IF A-2 EQUAL TO "A" NC2544.2 +053200 NEXT SENTENCE NC2544.2 +053300 ELSE NC2544.2 +053400 NEXT SENTENCE. NC2544.2 +053500 PERFORM PASS. NC2544.2 +053600 GO TO NEXT-WRITE-GF-1. NC2544.2 +053700 NEXT-DELETE-GF-1. NC2544.2 +053800 PERFORM DE-LETE. NC2544.2 +053900 NEXT-WRITE-GF-1. NC2544.2 +054000 MOVE "NEXT-TEST-1" TO PAR-NAME. NC2544.2 +054100 PERFORM PRINT-DETAIL. NC2544.2 +054200* NC2544.2 +054300* NC2544.2 +054400 ANOTHER-REMARK. NC2544.2 +054500 MOVE SPACE TO TEST-RESULTS. NC2544.2 +054600 MOVE "THE FOLLOWING TESTS " TO RE-MARK. NC2544.2 +054700 PERFORM PRINT-DETAIL. NC2544.2 +054800 MOVE "TEST THE COMPARISONS IN " TO RE-MARK. NC2544.2 +054900 PERFORM PRINT-DETAIL. NC2544.2 +055000 MOVE "SWITCH-STATUS, RELATION " TO RE-MARK. NC2544.2 +055100 PERFORM PRINT-DETAIL. NC2544.2 +055200 MOVE "AND CLASS CONDITIONALS. " TO RE-MARK. NC2544.2 +055300 PERFORM PRINT-DETAIL. NC2544.2 +055400 SWH-INIT-GF-1. NC2544.2 +055500 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +055600 MOVE "SWITCH-STATUS" TO FEATURE. NC2544.2 +055700 SWH-TEST-GF-1. NC2544.2 +055800 IF ON-SWITCH-1 NC2544.2 +055900 PERFORM PASS NC2544.2 +056000 ELSE NC2544.2 +056100 PERFORM FAIL. NC2544.2 +056200 GO TO SWH-WRITE-GF-1. NC2544.2 +056300 SWH-DELETE-GF-1. NC2544.2 +056400*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +056500 PERFORM DE-LETE. NC2544.2 +056600 SWH-WRITE-GF-1. NC2544.2 +056700 MOVE "SWH-TEST-GF-1" TO PAR-NAME. NC2544.2 +056800 PERFORM PRINT-DETAIL. NC2544.2 +056900 SWH-INIT-GF-2. NC2544.2 +057000 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +057100 SWH-TEST-GF-2. NC2544.2 +057200 IF OFF-SWITCH-1 NC2544.2 +057300 PERFORM FAIL NC2544.2 +057400 ELSE NC2544.2 +057500 PERFORM PASS. NC2544.2 +057600 GO TO SWH-WRITE-GF-2. NC2544.2 +057700 SWH-DELETE-GF-2. NC2544.2 +057800*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +057900 PERFORM DE-LETE. NC2544.2 +058000 SWH-WRITE-GF-2. NC2544.2 +058100 MOVE "SWH-TEST-GF-2" TO PAR-NAME. NC2544.2 +058200 PERFORM PRINT-DETAIL. NC2544.2 +058300 SWH-INIT-GF-3. NC2544.2 +058400 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +058500 SWH-TEST-GF-3. NC2544.2 +058600 IF OFF-SWITCH-2 NC2544.2 +058700 PERFORM PASS NC2544.2 +058800 ELSE NC2544.2 +058900 PERFORM FAIL. NC2544.2 +059000 GO TO SWH-WRITE-GF-3. NC2544.2 +059100 SWH-DELETE-GF-3. NC2544.2 +059200*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +059300 PERFORM DE-LETE. NC2544.2 +059400 SWH-WRITE-GF-3. NC2544.2 +059500 MOVE "SWH-TEST-GF-3" TO PAR-NAME. NC2544.2 +059600 PERFORM PRINT-DETAIL. NC2544.2 +059700 SWH-INIT-GF-4. NC2544.2 +059800 MOVE "V1-13 4.5.2" TO ANSI-REFERENCE. NC2544.2 +059900 SWH-TEST-GF-4. NC2544.2 +060000 IF ON-SWITCH-2 NC2544.2 +060100 PERFORM FAIL NC2544.2 +060200 ELSE NC2544.2 +060300 PERFORM PASS. NC2544.2 +060400 GO TO SWH-WRITE-GF-4. NC2544.2 +060500 SWH-DELETE-GF-4. NC2544.2 +060600*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +060700 PERFORM DE-LETE. NC2544.2 +060800 SWH-WRITE-GF-4. NC2544.2 +060900 MOVE "SWH-TEST-GF-4" TO PAR-NAME. NC2544.2 +061000 PERFORM PRINT-DETAIL. NC2544.2 +061100 SWH-TEST-5. NC2544.2 +061200 IF NOT ON-SWITCH-1 NC2544.2 +061300 MOVE "SWITCH-1 OFF " TO COMPUTED-A NC2544.2 +061400 MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A NC2544.2 +061500 PERFORM FAIL NC2544.2 +061600 GO TO SWH-WRITE-5. NC2544.2 +061700 PERFORM PASS. NC2544.2 +061800 GO TO SWH-WRITE-5. NC2544.2 +061900 SWH-DELETE-5. NC2544.2 +062000*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +062100 PERFORM DE-LETE. NC2544.2 +062200 SWH-WRITE-5. NC2544.2 +062300 MOVE "SWH-TEST-5" TO PAR-NAME. NC2544.2 +062400 PERFORM PRINT-DETAIL. NC2544.2 +062500 SWH-TEST-6. NC2544.2 +062600 IF NOT OFF-SWITCH-1 NC2544.2 +062700 PERFORM PASS NC2544.2 +062800 GO TO SWH-WRITE-6. NC2544.2 +062900 MOVE "SWITCH-1 OFF " TO COMPUTED-A. NC2544.2 +063000 MOVE "SWITCH-1 EXPECTED ON" TO CORRECT-A. NC2544.2 +063100 PERFORM FAIL. NC2544.2 +063200 GO TO SWH-WRITE-6. NC2544.2 +063300 SWH-DELETE-6. NC2544.2 +063400*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +063500 PERFORM DE-LETE. NC2544.2 +063600 SWH-WRITE-6. NC2544.2 +063700 MOVE "SWH-TEST-6" TO PAR-NAME. NC2544.2 +063800 PERFORM PRINT-DETAIL. NC2544.2 +063900 SWH-TEST-7. NC2544.2 +064000 IF NOT ON-SWITCH-2 NC2544.2 +064100 PERFORM PASS NC2544.2 +064200 GO TO SWH-WRITE-7. NC2544.2 +064300 MOVE "SWITCH-2 ON " TO COMPUTED-A. NC2544.2 +064400 MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A. NC2544.2 +064500 PERFORM FAIL. NC2544.2 +064600 GO TO SWH-WRITE-7. NC2544.2 +064700 SWH-DELETE-7. NC2544.2 +064800*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +064900 PERFORM DE-LETE. NC2544.2 +065000 SWH-WRITE-7. NC2544.2 +065100 MOVE "SWH-TEST-7" TO PAR-NAME. NC2544.2 +065200 PERFORM PRINT-DETAIL. NC2544.2 +065300 SWH-TEST-8. NC2544.2 +065400 IF NOT OFF-SWITCH-2 NC2544.2 +065500 MOVE "SWITCH-2 ON " TO COMPUTED-A NC2544.2 +065600 MOVE "SWITCH2 EXPECTED OFF" TO CORRECT-A NC2544.2 +065700 PERFORM FAIL NC2544.2 +065800 GO TO SWH-WRITE-8. NC2544.2 +065900 PERFORM PASS. NC2544.2 +066000 GO TO SWH-WRITE-8. NC2544.2 +066100 SWH-DELETE-8. NC2544.2 +066200*B MOVE "SWITCHES NOT IMPLEMENTED" TO RE-MARK. NC2544.2 +066300 PERFORM DE-LETE. NC2544.2 +066400 SWH-WRITE-8. NC2544.2 +066500 MOVE "SWH-TEST-8" TO PAR-NAME. NC2544.2 +066600 PERFORM PRINT-DETAIL. NC2544.2 +066700* NC2544.2 +066800* NC2544.2 +066900 CCVS-EXIT SECTION. NC2544.2 +067000 CCVS-999999. NC2544.2 +067100 GO TO CLOSE-FILES. NC2544.2 diff --git a/tests/cobol85/OB.txt b/tests/cobol85/OB.txt deleted file mode 100644 index 895f7294..00000000 --- a/tests/cobol85/OB.txt +++ /dev/null @@ -1,17 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -OBIC1A.CBL 1 1 0 0 0 OK -OBNC1M.CBL ----- test skipped ----- -OBNC2M.CBL ----- test skipped ----- -OBSQ1A.CBL 6 6 0 0 0 OK -OBSQ3A.CBL 0 0 0 0 0 OK -OBSQ4A.SUB 4 4 0 0 0 OK -OBSQ5A.SUB 5 5 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 16 16 0 0 0 -% 100.0 100.0 0.0 0.0 0.0 - -Number of programs: 5 -Successfully executed: 5 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/OB/OBIC1A.CBL b/tests/cobol85/OB/OBIC1A.CBL new file mode 100755 index 00000000..cf5d0d73 --- /dev/null +++ b/tests/cobol85/OB/OBIC1A.CBL @@ -0,0 +1,80 @@ +000100 IDENTIFICATION DIVISION. OBIC14.2 +000200 PROGRAM-ID. OBIC14.2 +000300 OBIC1A. OBIC14.2 +000400**************************************************************** OBIC14.2 +000500* * OBIC14.2 +000600* VALIDATION FOR:- * OBIC14.2 +000700* * OBIC14.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC14.2 +000900* * OBIC14.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBIC14.2 +001100* * OBIC14.2 +001200**************************************************************** OBIC14.2 +001300* * OBIC14.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * OBIC14.2 +001500* * OBIC14.2 +001600* X-55 - SYSTEM PRINTER NAME. * OBIC14.2 +001700* X-82 - SOURCE COMPUTER NAME. * OBIC14.2 +001800* X-83 - OBJECT COMPUTER NAME. * OBIC14.2 +001900* * OBIC14.2 +002000**************************************************************** OBIC14.2 +002100* OBIC14.2 +002200* THE MAIN PROGRAM IC218 CALLS THE SUBPROGRAM IC219 WHICH OBIC14.2 +002300* CONTAINS A SORT STATEMENT AND A STOP RUN STATEMENT. THE OBIC14.2 +002400* PURPOSE OF THESE PROGRAMS IS TO VERIFY THAT A SORT STATEMENT OBIC14.2 +002500* FUNCTIONS CORRECTLY IN A SUBPROGRAM. THE FIRST NON-DECLARA- OBIC14.2 +002600* TIVE PORTION OF THE SUBPROGRAM, THE SORT INPUT PROCEDURE AND OBIC14.2 +002700* THE SORT OUTPUT PROCEDURE ARE CONTAINED IN DIFFERENT SUBPRO- OBIC14.2 +002800* GRAM SEGMENTS. OBIC14.2 +002900* OBIC14.2 +003000* A CALL IS MADE TO THE SUBPROGRAM IC219. CONTROL SHOULD OBIC14.2 +003100* NOT BE RETURNED TO THIS PROGRAM SINCE IC219 CONTAINS A STOP OBIC14.2 +003200* RUN STATEMENT. THE SUBPROGRAM IC220 CONTAINS THE PRINTER FD OBIC14.2 +003300* AND PRINTS OUT THE REPORT SHOWING THE TEST RESULTS. OBIC14.2 +003400* OBIC14.2 +003500* REFERENCE - AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE OBIC14.2 +003600* COBOL, X3.23-1985 OBIC14.2 +003700* OBIC14.2 +003800******************************************************************OBIC14.2 +003900 ENVIRONMENT DIVISION. OBIC14.2 +004000 CONFIGURATION SECTION. OBIC14.2 +004100 SOURCE-COMPUTER. OBIC14.2 +004200 Linux. OBIC14.2 +004300 OBJECT-COMPUTER. OBIC14.2 +004400 Linux. OBIC14.2 +004500 DATA DIVISION. OBIC14.2 +004600 WORKING-STORAGE SECTION. OBIC14.2 +004700 01 SORT-LINK PICTURE 9. OBIC14.2 +004800 01 PRINT-LINE-VALUES. OBIC14.2 +004900 02 PASS-OR-FAIL PICTURE X(5). OBIC14.2 +005000 02 R-COUNT PICTURE 99. OBIC14.2 +005100 02 FEATURE-TESTED PICTURE X(20). OBIC14.2 +005200 02 COMPUTED-SORT-KEY PICTURE X(20). OBIC14.2 +005300 02 CORRECT-SORT-KEY PICTURE X(20). OBIC14.2 +005400 02 PARAGRAPH-NAME PICTURE X(12). OBIC14.2 +005500 01 PRINT-FLAG PICTURE 9. OBIC14.2 +005600 PROCEDURE DIVISION. OBIC14.2 +005700 SECT-IC218-0001 SECTION. OBIC14.2 +005800 CALL-IC219. OBIC14.2 +005900 MOVE 0 TO SORT-LINK. OBIC14.2 +006000 CALL "OBIC2A" USING SORT-LINK. OBIC14.2 +006100 CALL-FAIL. OBIC14.2 +006200* OBIC14.2 +006300* CONTROL SHOULD NOT RETURN TO THE MAIN PROGRAM FROM THE SUB- OBIC14.2 +006400* PROGRAM SINCE THE SUBPROGRAM CONTAINS A STOP RUN STATEMENT. OBIC14.2 +006500* OBIC14.2 +006600 MOVE 2 TO PRINT-FLAG. OBIC14.2 +006700 MOVE "CALL-MAIN-IC" TO PARAGRAPH-NAME. OBIC14.2 +006800 MOVE "CONTROL RETURNED" TO FEATURE-TESTED. OBIC14.2 +006900 MOVE "FAIL " TO PASS-OR-FAIL. OBIC14.2 +007000 MOVE 0 TO R-COUNT. OBIC14.2 +007100 MOVE SORT-LINK TO COMPUTED-SORT-KEY. OBIC14.2 +007200 MOVE SPACE TO CORRECT-SORT-KEY. OBIC14.2 +007300 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC14.2 +007400 MOVE 3 TO PRINT-FLAG. OBIC14.2 +007500 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC14.2 +007600* OBIC14.2 +007700* NO STOP RUN STATEMENT APPEARS IN THIS PROGRAM. OBIC14.2 +007800* OBIC14.2 +007900 END-OF-PROGRAM. OBIC14.2 +008000 EXIT PROGRAM. OBIC14.2 diff --git a/tests/cobol85/OB/OBNC1M.CBL b/tests/cobol85/OB/OBNC1M.CBL new file mode 100755 index 00000000..ae4c39b0 --- /dev/null +++ b/tests/cobol85/OB/OBNC1M.CBL @@ -0,0 +1,782 @@ +000100 IDENTIFICATION DIVISION. OBNC14.2 +000200 PROGRAM-ID. OBNC14.2 +000300 OBNC1M. OBNC14.2 +000400 OBNC14.2 +000500 AUTHOR. OBNC14.2 +000600 FEDERAL COMPILER TESTING CENTRE. OBNC14.2 +000700 INSTALLATION. OBNC14.2 +000800 GENERAL SERVICES ADMINISTRATION OBNC14.2 +000900 AUTOMATIC DATA AND TELECOMMUNICATION SERVICE OBNC14.2 +001000 SOFTWARE DEVELOPMENT OFFICE OBNC14.2 +001100 5203 LEESBURG PIKE. SUITE 1100 OBNC14.2 +001200 FALLS CHURCH VIRGINIA 22041 OBNC14.2 +001300 OBNC14.2 +001400 PHONE (703) 756-6153 OBNC14.2 +001500 DATE-WRITTEN. OBNC14.2 +001600 CCVS-74 VERSION 4.0 - 1980 JULY 1. OBNC14.2 +001700 CREATION DATE / VALIDATION DATE OBNC14.2 +001800 OBNC14.2 +001900 SECURITY. OBNC14.2 +002000 NONE OBNC14.2 +002100 OBNC14.2 +002200 OBNC14.2 +002300**************************************************************** OBNC14.2 +002400* * OBNC14.2 +002500* VALIDATION FOR:- * OBNC14.2 +002600* * OBNC14.2 +002700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC14.2 +002800* * OBNC14.2 +002900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBNC14.2 +003000* * OBNC14.2 +003100**************************************************************** OBNC14.2 +003200* * OBNC14.2 +003300* X-CARDS USED BY THIS PROGRAM ARE :- * OBNC14.2 +003400* * OBNC14.2 +003500* X-55 - SYSTEM PRINTER NAME. * OBNC14.2 +003600* X-82 - SOURCE COMPUTER NAME. * OBNC14.2 +003700* X-83 - OBJECT COMPUTER NAME. * OBNC14.2 +003800* * OBNC14.2 +003900**************************************************************** OBNC14.2 +004000* OBNC14.2 +004100* PROGRAM OBNC1M CONTAINS CCVS74 TESTS OF LEVEL 1 LANGUAGE OBNC14.2 +004200* ELEMENTS DEFINED AS OBSOLETE IN THE 1985 STANDARDS. OBNC14.2 +004300* OBNC14.2 +004400* OBNC14.2 +004500**************************************************************** OBNC14.2 +004600 OBNC14.2 +004700 OBNC14.2 +004800 A COMMENT ENTRY PARAGRAPH IS TO BE TREATED AS OBNC14.2 +004900 DOCUMENTATION. ANY ATTEMPT TO COMPILE ANYTHING CONTAINED OBNC14.2 +005000 HERE IS ILLEGAL. THE LINES WHICH FOLLOW CONSTITUTE A TEST OBNC14.2 +005100 OF THIS REQUIREMENT. ALL LINES BEGIN IN AREA B --- OBNC14.2 +005200 OBNC14.2 +005300 ENVIRONMENT DIVISION. OBNC14.2 +005400 CONFIGURATION SECTION. OBNC14.2 +005500 SOURCE-COMPUTER. OBNC14.2 +005600 Linux. OBNC14.2 +005700 OBJECT-COMPUTER. OBNC14.2 +005800 Linux. OBNC14.2 +005900 INPUT-OUTPUT SECTION. OBNC14.2 +006000 FILE-CONTROL. OBNC14.2 +006100 SELECT PHONY-PRINT-FILE ASSIGN TO OBNC14.2 +006200 "report.log". OBNC14.2 +006300 DATA DIVISION. OBNC14.2 +006400 FILE SECTION. OBNC14.2 +006500 FD PHONY-PRINT-FILE OBNC14.2 +006600 LABEL RECORDS OMITTED OBNC14.2 +006700 DATA RECORD IS PHONY-PRINT-REC. OBNC14.2 +006800 01 PHONY-PRINT-REC PICTURE X(120). OBNC14.2 +006900 WORKING-STORAGE SECTION. OBNC14.2 +007000 01 COM-MENT. OBNC14.2 +007100 02 FILLER PICTURE X(56) VALUE OBNC14.2 +007200 " CONGRATULATIONS --- YOUR COMPILER HAS JUST SUCCESSFULLY". OBNC14.2 +007300 02 FILLER PICTURE X(51) VALUE OBNC14.2 +007400 " COMPILED AND EXECUTED THE COBOL REMARKS PARAGRAPH.". OBNC14.2 +007500 PROCEDURE DIVISION. OBNC14.2 +007600 PHONY-OPEN. OBNC14.2 +007700 OPEN OUTPUT PHONY-PRINT-FILE. OBNC14.2 +007800 PHONY-WRITE. OBNC14.2 +007900 MOVE COM-MENT TO PHONY-PRINT-REC. OBNC14.2 +008000 WRITE PHONY-PRINT-REC. OBNC14.2 +008100 PHONY-CLOSE. OBNC14.2 +008200 CLOSE PHONY-PRINT-FILE. OBNC14.2 +008300 STOP RUN. OBNC14.2 +008400 IDENTIFICATION DIVISION. OBNC14.2 +008500 OBNC14.2 +008600 OBNC14.2 +008700 ENVIRONMENT DIVISION. OBNC14.2 +008800 CONFIGURATION SECTION. OBNC14.2 +008900 SOURCE-COMPUTER. OBNC14.2 +009000 Linux. OBNC14.2 +009100 OBJECT-COMPUTER. OBNC14.2 +009200 Linux OBNC14.2 +009300 MEMORY SIZE OBNC14.2 +009400 1000 OBNC14.2 +009500 WORDS. OBNC14.2 +009600 INPUT-OUTPUT SECTION. OBNC14.2 +009700 FILE-CONTROL. OBNC14.2 +009800 SELECT PRINT-FILE ASSIGN TO OBNC14.2 +009900 "report.log". OBNC14.2 +010000 DATA DIVISION. OBNC14.2 +010100 FILE SECTION. OBNC14.2 +010200 FD PRINT-FILE. OBNC14.2 +010300 01 PRINT-REC PICTURE X(132). OBNC14.2 +010400 01 DUMMY-RECORD PICTURE X(132). OBNC14.2 +010500 WORKING-STORAGE SECTION. OBNC14.2 +010600 01 CHARACTER-BREAKDOWN-R. OBNC14.2 +010700 02 FIRST-20R PICTURE X(20). OBNC14.2 +010800 02 SECOND-20R PICTURE X(20). OBNC14.2 +010900 02 THIRD-20R PICTURE X(20). OBNC14.2 +011000 02 FOURTH-20R PICTURE X(20). OBNC14.2 +011100 01 CHARACTER-BREAKDOWN-S. OBNC14.2 +011200 02 FIRST-20S PICTURE X(20). OBNC14.2 +011300 02 SECOND-20S PICTURE X(20). OBNC14.2 +011400 02 THIRD-20S PICTURE X(20). OBNC14.2 +011500 02 FOURTH-20S PICTURE X(20). OBNC14.2 +011600 01 X80-CHARACTER-FIELD. OBNC14.2 +011700 02 FILLER PICTURE X(80). OBNC14.2 +011800 01 ACCEPT-RESULTS. OBNC14.2 +011900 02 FILLER PICTURE X(80) VALUE OBNC14.2 +012000 "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 0123456OBNC14.2 +012100- "789 ". OBNC14.2 +012200 01 ALTERLOOP PIC 9 VALUE ZERO. OBNC14.2 +012300 01 DISPLAY-DATA. OBNC14.2 +012400 02 DISPLAY-A. OBNC14.2 +012500 03 DISPLAY-03 PICTURE A VALUE "A". OBNC14.2 +012600 03 DISPLAY-03A. OBNC14.2 +012700 04 DISPLAY-04 PICTURE A VALUE "L". OBNC14.2 +012800 04 DISPLAY-04A. OBNC14.2 +012900 05 DISPLAY-05 PICTURE A VALUE "P". OBNC14.2 +013000 05 DISPLAY-05A. OBNC14.2 +013100 06 DISPLAY-06 PICTURE A VALUE "H". OBNC14.2 +013200 06 DISPLAY-06A. OBNC14.2 +013300 07 DISPLAY-07 PICTURE A VALUE "A". OBNC14.2 +013400 07 DISPLAY-07A. OBNC14.2 +013500 08 DISPLAY-08 PICTURE A VALUE "B". OBNC14.2 +013600 08 DISPLAY-08A. OBNC14.2 +013700 09 DISPLAY-09 PICTURE A VALUE "E". OBNC14.2 +013800 09 DISPLAY-09A. OBNC14.2 +013900 10 DISPLAY-10 PICTURE AAA VALUE "TIC". OBNC14.2 +014000 02 DISPLAY-N PICTURE 9(10) VALUE 0123456789. OBNC14.2 +014100 02 DISPLAY-X PICTURE X(10) VALUE "A1B2C3D4E5". OBNC14.2 +014200 02 DISPLAY-B PICTURE X(13). OBNC14.2 +014300 02 DISPLAY-C REDEFINES DISPLAY-B. OBNC14.2 +014400 03 DISPLAY-D PICTURE X(8). OBNC14.2 +014500 03 DISPLAY-E PICTURE X(5). OBNC14.2 +014600 02 DISPLAY-F. OBNC14.2 +014700 03 DISPLAY-G PICTURE X(100) VALUE "*001*002*003*00OBNC14.2 +014800- "4*005*006*007*008*009*010*011*012*013*014*015*016*017*018*01OBNC14.2 +014900- "9*020*021*022*023*024*025". OBNC14.2 +015000 03 DISPLAY-H PICTURE X(100) VALUE "*026*027*028*02OBNC14.2 +015100- "9*030*031*032*033*034*035*036*037*038*039*040*041*042*043*04OBNC14.2 +015200- "4*045*046*047*048*049*050". OBNC14.2 +015300 02 SEE-ABOVE PICTURE X(9) VALUE "SEE ABOVE". OBNC14.2 +015400 02 SEE-BELOW PICTURE X(9) VALUE "SEE BELOW". OBNC14.2 +015500 02 CORRECT-FOLLOWS PICTURE X(20) VALUE OBNC14.2 +015600 "CORRECT DATA FOLLOWS". OBNC14.2 +015700 02 END-CORRECT PICTURE X(16) VALUE OBNC14.2 +015800 "END CORRECT DATA". OBNC14.2 +015900 02 DISPLAY-WRITER. OBNC14.2 +016000 03 DIS-PLAYER. OBNC14.2 +016100 04 FILLER PICTURE X(6). OBNC14.2 +016200 04 QUOTE-SLOT PICTURE X. OBNC14.2 +016300 04 FILLER PICTURE X(112). OBNC14.2 +016400 02 DISPLAY-SWITCH PICTURE 9 VALUE ZERO. OBNC14.2 +016500 02 ZERO-SPACE-QUOTE. OBNC14.2 +016600 03 FILLER PICTURE X VALUE ZERO. OBNC14.2 +016700 03 FILLER PICTURE X VALUE SPACE. OBNC14.2 +016800 03 FILLER PICTURE X VALUE QUOTE. OBNC14.2 +016900 01 LONG-LITERAL. OBNC14.2 +017000 02 LONG20 PICTURE IS X(20) OBNC14.2 +017100 VALUE IS "STANDARD COMPILERS M". OBNC14.2 +017200 02 LONG40 PICTURE IS X(20) OBNC14.2 +017300 VALUE IS "UST ALLOW NON-NUMERI". OBNC14.2 +017400 02 LONG60 PICTURE IS X(20) OBNC14.2 +017500 VALUE IS "C LITERALS OF AT LEA". OBNC14.2 +017600 02 LONG80 PICTURE IS X(20) OBNC14.2 +017700 VALUE IS "ST 120 CHARACTERS AN". OBNC14.2 +017800 02 LONG100 PICTURE IS X(20) OBNC14.2 +017900 VALUE IS "D NUMERIC LITERALS O". OBNC14.2 +018000 02 LONG120 PICTURE IS X(20) OBNC14.2 +018100 VALUE IS "F AT LEAST 18 DIGITS". OBNC14.2 +018200 01 ACCEPT-DATA. OBNC14.2 +018300 02 ACCEPT-D1. OBNC14.2 +018400 03 ACCEPT-D1-A PICTURE X(20). OBNC14.2 +018500 03 ACCEPT-D1-B PICTURE X(7). OBNC14.2 +018600 02 ACCEPT-D2 PICTURE X(27) OBNC14.2 +018700 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXY Z". OBNC14.2 +018800 02 ACCEPT-D3 PICTURE 9(10) USAGE DISPLAY. OBNC14.2 +018900 02 ACCEPT-D4 PICTURE 9(10) USAGE DISPLAY VALUE 0123456789. OBNC14.2 +019000 02 ACCEPT-D5 PICTURE X(11). OBNC14.2 +019100 02 ACCEPT-D6 PICTURE X(11) VALUE "().+-*/l, =". OBNC14.2 +019200 02 ACCEPT-D7 PICTURE X. OBNC14.2 +019300 02 ACCEPT-D8 PICTURE X VALUE "9". OBNC14.2 +019400 02 ACCEPT-D9 PICTURE X. OBNC14.2 +019500 02 ACCEPT-D10 PICTURE X VALUE "0". OBNC14.2 +019600 02 ACCEPT-D11 PICTURE A(20). OBNC14.2 +019700 02 ACCEPT-D12 PICTURE A(20) OBNC14.2 +019800 VALUE " ABC XYZ ". OBNC14.2 +019900 02 ACCEPT-D13 PICTURE 9(9). OBNC14.2 +020000 02 ACCEPT-D14 PICTURE 9(9) VALUE 012345678. OBNC14.2 +020100 02 ACCEPT-D15 PICTURE X. OBNC14.2 +020200 02 ACCEPT-D16 PICTURE X VALUE SPACE. OBNC14.2 +020300 02 ACCEPT-D17 PICTURE X. OBNC14.2 +020400 02 ACCEPT-D18 PICTURE X VALUE QUOTE. OBNC14.2 +020500 02 ACCEPT-D21. OBNC14.2 +020600 03 TAB-ACCEPT PICTURE XXXX OCCURS 3 TIMES. OBNC14.2 +020700 02 ACCEPT-D22 PICTURE X(12) VALUE "....ABCD....". OBNC14.2 +020800 01 TAB-VALUE PICTURE X(21) OBNC14.2 +020900 VALUE "ABCDEFGHIJKLMNOPQRSTU". OBNC14.2 +021000 01 NO-TAB-RECORD REDEFINES TAB-VALUE. OBNC14.2 +021100 02 X1 PICTURE X. OBNC14.2 +021200 02 X2 PICTURE X. OBNC14.2 +021300 02 X3 PICTURE X. OBNC14.2 +021400 02 X4 PICTURE X. OBNC14.2 +021500 02 X5 PICTURE X. OBNC14.2 +021600 02 X6 PICTURE X. OBNC14.2 +021700 02 X7 PICTURE X. OBNC14.2 +021800 02 X8 PICTURE X. OBNC14.2 +021900 02 X9 PICTURE X. OBNC14.2 +022000 02 X10 PICTURE X. OBNC14.2 +022100 02 X11 PICTURE X. OBNC14.2 +022200 02 X12 PICTURE X. OBNC14.2 +022300 02 X13 PICTURE X. OBNC14.2 +022400 02 X14 PICTURE X. OBNC14.2 +022500 02 X15 PICTURE X. OBNC14.2 +022600 02 X16 PICTURE X. OBNC14.2 +022700 02 X17 PICTURE X. OBNC14.2 +022800 02 X18 PICTURE X. OBNC14.2 +022900 02 X19 PICTURE X. OBNC14.2 +023000 02 X20 PICTURE X. OBNC14.2 +023100 02 X21 PICTURE X. OBNC14.2 +023200 01 TAB-RECORD REDEFINES TAB-VALUE. OBNC14.2 +023300 02 XTAB PICTURE X OCCURS 21 TIMES. OBNC14.2 +023400 01 DISPLAY-MIXTURE. OBNC14.2 +023500 02 I-DATA PICTURE X(17) OBNC14.2 +023600 VALUE " IDENTIFIER DATA ". OBNC14.2 +023700 02 TA-VALUE PICTURE X(20) OBNC14.2 +023800 VALUE "A B C D E 0102030405". OBNC14.2 +023900 02 TA-BLE REDEFINES TA-VALUE. OBNC14.2 +024000 04 PIECE-A PICTURE XX OCCURS 5 TIMES. OBNC14.2 +024100 04 PIECE-N PICTURE 99 OCCURS 5 TIMES. OBNC14.2 +024200 02 TRUE-PAIR. OBNC14.2 +024300 03 A1 PICTURE X(21) OBNC14.2 +024400 VALUE " (TOTAL 21 OPERANDS) ". OBNC14.2 +024500 03 A2 PICTURE X(11) OBNC14.2 +024600 VALUE "END OF DATA". OBNC14.2 +024700 01 TEST-RESULTS. OBNC14.2 +024800 02 FILLER PIC X VALUE SPACE. OBNC14.2 +024900 02 FEATURE PIC X(20) VALUE SPACE. OBNC14.2 +025000 02 FILLER PIC X VALUE SPACE. OBNC14.2 +025100 02 P-OR-F PIC X(5) VALUE SPACE. OBNC14.2 +025200 02 FILLER PIC X VALUE SPACE. OBNC14.2 +025300 02 PAR-NAME. OBNC14.2 +025400 03 FILLER PIC X(19) VALUE SPACE. OBNC14.2 +025500 03 PARDOT-X PIC X VALUE SPACE. OBNC14.2 +025600 03 DOTVALUE PIC 99 VALUE ZERO. OBNC14.2 +025700 02 FILLER PIC X(8) VALUE SPACE. OBNC14.2 +025800 02 RE-MARK PIC X(61). OBNC14.2 +025900 01 TEST-COMPUTED. OBNC14.2 +026000 02 FILLER PIC X(30) VALUE SPACE. OBNC14.2 +026100 02 FILLER PIC X(17) VALUE OBNC14.2 +026200 " COMPUTED=". OBNC14.2 +026300 02 COMPUTED-X. OBNC14.2 +026400 03 COMPUTED-A PIC X(20) VALUE SPACE. OBNC14.2 +026500 03 COMPUTED-N REDEFINES COMPUTED-A OBNC14.2 +026600 PIC -9(9).9(9). OBNC14.2 +026700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). OBNC14.2 +026800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). OBNC14.2 +026900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). OBNC14.2 +027000 03 CM-18V0 REDEFINES COMPUTED-A. OBNC14.2 +027100 04 COMPUTED-18V0 PIC -9(18). OBNC14.2 +027200 04 FILLER PIC X. OBNC14.2 +027300 03 FILLER PIC X(50) VALUE SPACE. OBNC14.2 +027400 01 TEST-CORRECT. OBNC14.2 +027500 02 FILLER PIC X(30) VALUE SPACE. OBNC14.2 +027600 02 FILLER PIC X(17) VALUE " CORRECT =". OBNC14.2 +027700 02 CORRECT-X. OBNC14.2 +027800 03 CORRECT-A PIC X(20) VALUE SPACE. OBNC14.2 +027900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). OBNC14.2 +028000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). OBNC14.2 +028100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). OBNC14.2 +028200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). OBNC14.2 +028300 03 CR-18V0 REDEFINES CORRECT-A. OBNC14.2 +028400 04 CORRECT-18V0 PIC -9(18). OBNC14.2 +028500 04 FILLER PIC X. OBNC14.2 +028600 03 FILLER PIC X(2) VALUE SPACE. OBNC14.2 +028700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. OBNC14.2 +028800 01 CCVS-C-1. OBNC14.2 +028900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAOBNC14.2 +029000- "SS PARAGRAPH-NAME OBNC14.2 +029100- " REMARKS". OBNC14.2 +029200 02 FILLER PIC X(20) VALUE SPACE. OBNC14.2 +029300 01 CCVS-C-2. OBNC14.2 +029400 02 FILLER PIC X VALUE SPACE. OBNC14.2 +029500 02 FILLER PIC X(6) VALUE "TESTED". OBNC14.2 +029600 02 FILLER PIC X(15) VALUE SPACE. OBNC14.2 +029700 02 FILLER PIC X(4) VALUE "FAIL". OBNC14.2 +029800 02 FILLER PIC X(94) VALUE SPACE. OBNC14.2 +029900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. OBNC14.2 +030000 01 REC-CT PIC 99 VALUE ZERO. OBNC14.2 +030100 01 DELETE-COUNTER PIC 999 VALUE ZERO. OBNC14.2 +030200 01 ERROR-COUNTER PIC 999 VALUE ZERO. OBNC14.2 +030300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBNC14.2 +030400 01 PASS-COUNTER PIC 999 VALUE ZERO. OBNC14.2 +030500 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBNC14.2 +030600 01 ERROR-HOLD PIC 999 VALUE ZERO. OBNC14.2 +030700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBNC14.2 +030800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBNC14.2 +030900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. OBNC14.2 +031000 01 CCVS-H-1. OBNC14.2 +031100 02 FILLER PIC X(39) VALUE SPACES. OBNC14.2 +031200 02 FILLER PIC X(42) VALUE OBNC14.2 +031300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". OBNC14.2 +031400 02 FILLER PIC X(39) VALUE SPACES. OBNC14.2 +031500 01 CCVS-H-2A. OBNC14.2 +031600 02 FILLER PIC X(40) VALUE SPACE. OBNC14.2 +031700 02 FILLER PIC X(7) VALUE "CCVS85 ". OBNC14.2 +031800 02 FILLER PIC XXXX VALUE OBNC14.2 +031900 "4.2 ". OBNC14.2 +032000 02 FILLER PIC X(28) VALUE OBNC14.2 +032100 " COPY - NOT FOR DISTRIBUTION". OBNC14.2 +032200 02 FILLER PIC X(41) VALUE SPACE. OBNC14.2 +032300 OBNC14.2 +032400 01 CCVS-H-2B. OBNC14.2 +032500 02 FILLER PIC X(15) VALUE OBNC14.2 +032600 "TEST RESULT OF ". OBNC14.2 +032700 02 TEST-ID PIC X(9). OBNC14.2 +032800 02 FILLER PIC X(4) VALUE OBNC14.2 +032900 " IN ". OBNC14.2 +033000 02 FILLER PIC X(12) VALUE OBNC14.2 +033100 " HIGH ". OBNC14.2 +033200 02 FILLER PIC X(22) VALUE OBNC14.2 +033300 " LEVEL VALIDATION FOR ". OBNC14.2 +033400 02 FILLER PIC X(58) VALUE OBNC14.2 +033500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC14.2 +033600 01 CCVS-H-3. OBNC14.2 +033700 02 FILLER PIC X(34) VALUE OBNC14.2 +033800 " FOR OFFICIAL USE ONLY ". OBNC14.2 +033900 02 FILLER PIC X(58) VALUE OBNC14.2 +034000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBNC14.2 +034100 02 FILLER PIC X(28) VALUE OBNC14.2 +034200 " COPYRIGHT 1985 ". OBNC14.2 +034300 01 CCVS-E-1. OBNC14.2 +034400 02 FILLER PIC X(52) VALUE SPACE. OBNC14.2 +034500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". OBNC14.2 +034600 02 ID-AGAIN PIC X(9). OBNC14.2 +034700 02 FILLER PIC X(45) VALUE SPACES. OBNC14.2 +034800 01 CCVS-E-2. OBNC14.2 +034900 02 FILLER PIC X(31) VALUE SPACE. OBNC14.2 +035000 02 FILLER PIC X(21) VALUE SPACE. OBNC14.2 +035100 02 CCVS-E-2-2. OBNC14.2 +035200 03 ERROR-TOTAL PIC XXX VALUE SPACE. OBNC14.2 +035300 03 FILLER PIC X VALUE SPACE. OBNC14.2 +035400 03 ENDER-DESC PIC X(44) VALUE OBNC14.2 +035500 "ERRORS ENCOUNTERED". OBNC14.2 +035600 01 CCVS-E-3. OBNC14.2 +035700 02 FILLER PIC X(22) VALUE OBNC14.2 +035800 " FOR OFFICIAL USE ONLY". OBNC14.2 +035900 02 FILLER PIC X(12) VALUE SPACE. OBNC14.2 +036000 02 FILLER PIC X(58) VALUE OBNC14.2 +036100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC14.2 +036200 02 FILLER PIC X(13) VALUE SPACE. OBNC14.2 +036300 02 FILLER PIC X(15) VALUE OBNC14.2 +036400 " COPYRIGHT 1985". OBNC14.2 +036500 01 CCVS-E-4. OBNC14.2 +036600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBNC14.2 +036700 02 FILLER PIC X(4) VALUE " OF ". OBNC14.2 +036800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBNC14.2 +036900 02 FILLER PIC X(40) VALUE OBNC14.2 +037000 " TESTS WERE EXECUTED SUCCESSFULLY". OBNC14.2 +037100 01 XXINFO. OBNC14.2 +037200 02 FILLER PIC X(19) VALUE OBNC14.2 +037300 "*** INFORMATION ***". OBNC14.2 +037400 02 INFO-TEXT. OBNC14.2 +037500 04 FILLER PIC X(8) VALUE SPACE. OBNC14.2 +037600 04 XXCOMPUTED PIC X(20). OBNC14.2 +037700 04 FILLER PIC X(5) VALUE SPACE. OBNC14.2 +037800 04 XXCORRECT PIC X(20). OBNC14.2 +037900 02 INF-ANSI-REFERENCE PIC X(48). OBNC14.2 +038000 01 HYPHEN-LINE. OBNC14.2 +038100 02 FILLER PIC IS X VALUE IS SPACE. OBNC14.2 +038200 02 FILLER PIC IS X(65) VALUE IS "************************OBNC14.2 +038300- "*****************************************". OBNC14.2 +038400 02 FILLER PIC IS X(54) VALUE IS "************************OBNC14.2 +038500- "******************************". OBNC14.2 +038600 01 CCVS-PGM-ID PIC X(9) VALUE OBNC14.2 +038700 "OBNC1M". OBNC14.2 +038800 PROCEDURE DIVISION. OBNC14.2 +038900 CCVS1 SECTION. OBNC14.2 +039000 OPEN-FILES. OBNC14.2 +039100 OPEN OUTPUT PRINT-FILE. OBNC14.2 +039200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBNC14.2 +039300 MOVE SPACE TO TEST-RESULTS. OBNC14.2 +039400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBNC14.2 +039500 GO TO CCVS1-EXIT. OBNC14.2 +039600 CLOSE-FILES. OBNC14.2 +039700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBNC14.2 +039800 TERMINATE-CCVS. OBNC14.2 +039900*S EXIT PROGRAM. OBNC14.2 +040000*SERMINATE-CALL. OBNC14.2 +040100 STOP RUN. OBNC14.2 +040200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBNC14.2 +040300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBNC14.2 +040400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBNC14.2 +040500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. OBNC14.2 +040600 MOVE "****TEST DELETED****" TO RE-MARK. OBNC14.2 +040700 PRINT-DETAIL. OBNC14.2 +040800 IF REC-CT NOT EQUAL TO ZERO OBNC14.2 +040900 MOVE "." TO PARDOT-X OBNC14.2 +041000 MOVE REC-CT TO DOTVALUE. OBNC14.2 +041100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBNC14.2 +041200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBNC14.2 +041300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBNC14.2 +041400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBNC14.2 +041500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBNC14.2 +041600 MOVE SPACE TO CORRECT-X. OBNC14.2 +041700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBNC14.2 +041800 MOVE SPACE TO RE-MARK. OBNC14.2 +041900 HEAD-ROUTINE. OBNC14.2 +042000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +042100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +042200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBNC14.2 +042300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBNC14.2 +042400 COLUMN-NAMES-ROUTINE. OBNC14.2 +042500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +042600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +042700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +042800 END-ROUTINE. OBNC14.2 +042900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBNC14.2 +043000 END-RTN-EXIT. OBNC14.2 +043100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +043200 END-ROUTINE-1. OBNC14.2 +043300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBNC14.2 +043400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. OBNC14.2 +043500 ADD PASS-COUNTER TO ERROR-HOLD. OBNC14.2 +043600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBNC14.2 +043700 MOVE PASS-COUNTER TO CCVS-E-4-1. OBNC14.2 +043800 MOVE ERROR-HOLD TO CCVS-E-4-2. OBNC14.2 +043900 MOVE CCVS-E-4 TO CCVS-E-2-2. OBNC14.2 +044000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBNC14.2 +044100 END-ROUTINE-12. OBNC14.2 +044200 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBNC14.2 +044300 IF ERROR-COUNTER IS EQUAL TO ZERO OBNC14.2 +044400 MOVE "NO " TO ERROR-TOTAL OBNC14.2 +044500 ELSE OBNC14.2 +044600 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBNC14.2 +044700 MOVE CCVS-E-2 TO DUMMY-RECORD. OBNC14.2 +044800 PERFORM WRITE-LINE. OBNC14.2 +044900 END-ROUTINE-13. OBNC14.2 +045000 IF DELETE-COUNTER IS EQUAL TO ZERO OBNC14.2 +045100 MOVE "NO " TO ERROR-TOTAL ELSE OBNC14.2 +045200 MOVE DELETE-COUNTER TO ERROR-TOTAL. OBNC14.2 +045300 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBNC14.2 +045400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +045500 IF INSPECT-COUNTER EQUAL TO ZERO OBNC14.2 +045600 MOVE "NO " TO ERROR-TOTAL OBNC14.2 +045700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBNC14.2 +045800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBNC14.2 +045900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +046000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC14.2 +046100 WRITE-LINE. OBNC14.2 +046200 ADD 1 TO RECORD-COUNT. OBNC14.2 +046300 IF RECORD-COUNT GREATER 42 OBNC14.2 +046400 MOVE DUMMY-RECORD TO DUMMY-HOLD OBNC14.2 +046500 MOVE SPACE TO DUMMY-RECORD OBNC14.2 +046600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBNC14.2 +046700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBNC14.2 +046800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBNC14.2 +046900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES OBNC14.2 +047000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES OBNC14.2 +047100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBNC14.2 +047200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN OBNC14.2 +047300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBNC14.2 +047400 MOVE DUMMY-HOLD TO DUMMY-RECORD OBNC14.2 +047500 MOVE ZERO TO RECORD-COUNT. OBNC14.2 +047600 PERFORM WRT-LN. OBNC14.2 +047700 WRT-LN. OBNC14.2 +047800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBNC14.2 +047900 MOVE SPACE TO DUMMY-RECORD. OBNC14.2 +048000 BLANK-LINE-PRINT. OBNC14.2 +048100 PERFORM WRT-LN. OBNC14.2 +048200 FAIL-ROUTINE. OBNC14.2 +048300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBNC14.2 +048400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBNC14.2 +048500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBNC14.2 +048600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBNC14.2 +048700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +048800 MOVE SPACES TO INF-ANSI-REFERENCE. OBNC14.2 +048900 GO TO FAIL-ROUTINE-EX. OBNC14.2 +049000 FAIL-ROUTINE-WRITE. OBNC14.2 +049100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBNC14.2 +049200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. OBNC14.2 +049300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +049400 MOVE SPACES TO COR-ANSI-REFERENCE. OBNC14.2 +049500 FAIL-ROUTINE-EX. EXIT. OBNC14.2 +049600 BAIL-OUT. OBNC14.2 +049700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBNC14.2 +049800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBNC14.2 +049900 BAIL-OUT-WRITE. OBNC14.2 +050000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBNC14.2 +050100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBNC14.2 +050200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC14.2 +050300 MOVE SPACES TO INF-ANSI-REFERENCE. OBNC14.2 +050400 BAIL-OUT-EX. EXIT. OBNC14.2 +050500 CCVS1-EXIT. OBNC14.2 +050600 EXIT. OBNC14.2 +050700 SECT-NC107A-001 SECTION. OBNC14.2 +050800 REMARKS-TEST. OBNC14.2 +050900 MOVE "IV-11 7.2.4" TO ANSI-REFERENCE. OBNC14.2 +051000 MOVE "COBOL REMARKS PARA" TO FEATURE. OBNC14.2 +051100 MOVE "REMARKS" TO PAR-NAME. OBNC14.2 +051200 MOVE "PHONY LINES SHOULDNT EXECUT" TO RE-MARK. OBNC14.2 +051300 PERFORM PRINT-DETAIL. OBNC14.2 +051400* THE FOLLOWING HAS BEEN MOVED FROM THE END TO ENSURE OBNC14.2 +051500* EXECUTION OBNC14.2 +051600 NOTE-TEST-6. OBNC14.2 +051700* PERFORM FAIL. OBNC14.2 +051800* NOTE ENTER GO TO NOTE-WRITE-6 OBNC14.2 +051900* USE GO TO NOTE-WRITE-6 OBNC14.2 +052000* DECLARATIVES GO TO NOTE-WRITE-6 OBNC14.2 +052100* DATA DIVISION GO TO NOTE-WRITE-6 OBNC14.2 +052200* COPY (SEE ALSO PROGRAM LB104) GO TO NOTE-WRITE-6 OBNC14.2 +052300* THE COMPILER SHOULD "IGNORE" THE ABOVE WORDS. OBNC14.2 +052400* PERFORM PASS. OBNC14.2 +052500 GO TO NOTE-WRITE-6. OBNC14.2 +052600 NOTE-DELETE-6. OBNC14.2 +052700 PERFORM DE-LETE. OBNC14.2 +052800 NOTE-WRITE-6. OBNC14.2 +052900 MOVE "NOTE RESERVED WORDS" TO FEATURE. OBNC14.2 +053000 MOVE "NOTE-TEST-6" TO PAR-NAME. OBNC14.2 +053100 PERFORM PRINT-DETAIL. OBNC14.2 +053200 NUM-INIT-1. OBNC14.2 +053300 MOVE "NUMERIC PARA-NAMES" TO FEATURE. OBNC14.2 +053400 MOVE "VI-75 6.7.2" TO ANSI-REFERENCE. OBNC14.2 +053500 PERFORM PRINT-DETAIL. OBNC14.2 +053600 NUM-TEST-1. OBNC14.2 +053700 ALTER 02 TO PROCEED TO 77. OBNC14.2 +053800 GO TO 02. OBNC14.2 +053900 NUM-DELETE-1. OBNC14.2 +054000 PERFORM DE-LETE. OBNC14.2 +054100 GO TO NUM-WRITE-1. OBNC14.2 +054200 02. OBNC14.2 +054300 GO TO 50. OBNC14.2 +054400 50. PERFORM FAIL. OBNC14.2 +054500 GO TO NUM-WRITE-1. OBNC14.2 +054600 77. OBNC14.2 +054700 PERFORM PASS. OBNC14.2 +054800 NUM-WRITE-1. OBNC14.2 +054900 MOVE "NUM-TEST-1" TO PAR-NAME. OBNC14.2 +055000 PERFORM PRINT-DETAIL. OBNC14.2 +055100 ALTER-INIT. OBNC14.2 +055200 MOVE "ALTER" TO FEATURE. OBNC14.2 +055300 MOVE "VI-75 6.7.2" TO ANSI-REFERENCE. OBNC14.2 +055400 ALTER-TEST-1. OBNC14.2 +055500 ALTER ALTER-A TO PROCEED TO ALTER-C. OBNC14.2 +055600 GO TO ALTER-A. OBNC14.2 +055700 ALTER-DELETE-1. OBNC14.2 +055800 PERFORM DE-LETE. OBNC14.2 +055900 GO TO ALTER-WRITE-1. OBNC14.2 +056000 ALTER-A. OBNC14.2 +056100 GO TO ALTER-B. OBNC14.2 +056200 ALTER-B. OBNC14.2 +056300 PERFORM FAIL. OBNC14.2 +056400 GO TO ALTER-WRITE-1. OBNC14.2 +056500 ALTER-C. OBNC14.2 +056600 PERFORM PASS. OBNC14.2 +056700 ALTER-WRITE-1. OBNC14.2 +056800 MOVE "ALTER-TEST-1" TO PAR-NAME. OBNC14.2 +056900 PERFORM PRINT-DETAIL. OBNC14.2 +057000 ALTER-TEST-2. OBNC14.2 +057100 ALTER ALTER-D TO ALTER-F. OBNC14.2 +057200* NOTE THE WORDS "PROCEED TO" ARE OPTIONAL. OBNC14.2 +057300 GO TO ALTER-D. OBNC14.2 +057400 ALTER-DELETE-2. OBNC14.2 +057500 PERFORM DE-LETE. OBNC14.2 +057600 GO TO ALTER-WRITE-2. OBNC14.2 +057700 ALTER-D. OBNC14.2 +057800 GO TO ALTER-E. OBNC14.2 +057900 ALTER-E. OBNC14.2 +058000 PERFORM FAIL. OBNC14.2 +058100 GO TO ALTER-WRITE-2. OBNC14.2 +058200 ALTER-F. OBNC14.2 +058300 PERFORM PASS. OBNC14.2 +058400 ALTER-WRITE-2. OBNC14.2 +058500 MOVE "ALTER-TEST-2" TO PAR-NAME. OBNC14.2 +058600 PERFORM PRINT-DETAIL. OBNC14.2 +058700 ALTER-TEST-3. OBNC14.2 +058800 ALTER ALTER-G TO PROCEED TO ALTER-I. OBNC14.2 +058900* NOTE COMPOUND ALTERS, MULTIPLE ALTERS OF THE SAME SEQUENCE. OBNC14.2 +059000 GO TO ALTER-G. OBNC14.2 +059100 ALTER-DELETE-3. OBNC14.2 +059200 PERFORM DE-LETE. OBNC14.2 +059300 GO TO ALTER-WRITE-3. OBNC14.2 +059400 ALTER-G. OBNC14.2 +059500 GO TO ALTER-H. OBNC14.2 +059600 ALTER-H. OBNC14.2 +059700 PERFORM FAIL. OBNC14.2 +059800 GO TO ALTER-WRITE-3. OBNC14.2 +059900 ALTER-I. OBNC14.2 +060000 ADD 1 TO ALTERLOOP. OBNC14.2 +060100 IF ALTERLOOP GREATER THAN 1 OBNC14.2 +060200 PERFORM FAIL OBNC14.2 +060300 GO TO ALTER-WRITE-3. OBNC14.2 +060400 ALTER ALTER-G TO PROCEED TO ALTER-J. OBNC14.2 +060500 GO TO ALTER-G. OBNC14.2 +060600 ALTER-J. OBNC14.2 +060700 PERFORM PASS. OBNC14.2 +060800 ALTER-WRITE-3. OBNC14.2 +060900 MOVE "ALTER-TEST-3" TO PAR-NAME. OBNC14.2 +061000 PERFORM PRINT-DETAIL. OBNC14.2 +061100* OBNC14.2 +061200 GO--TEST-1. OBNC14.2 +061300 ALTER GO--A TO PROCEED TO GO--C. OBNC14.2 +061400* NOTE THE GO STATEMENT IN GO--A IS NOT LEGAL UNLESS IT IS OBNC14.2 +061500* ALTERED AS SHOWN ABOVE BEFORE CONTROL PASSES TO IT. OBNC14.2 +061600 GO TO GO--A. OBNC14.2 +061700 GO--DELETE-1. OBNC14.2 +061800 PERFORM DE-LETE. OBNC14.2 +061900 GO TO GO--WRITE-1. OBNC14.2 +062000 GO--A. OBNC14.2 +062100 GO TO. OBNC14.2 +062200 GO--B. OBNC14.2 +062300 PERFORM FAIL. OBNC14.2 +062400 GO TO GO--WRITE-1. OBNC14.2 +062500 GO--C. OBNC14.2 +062600 PERFORM PASS. OBNC14.2 +062700 GO--WRITE-1. OBNC14.2 +062800 PERFORM END-ROUTINE. OBNC14.2 +062900 MOVE "UNFINISHED GO TO" TO FEATURE. OBNC14.2 +063000 MOVE "GO--TEST-1" TO PAR-NAME. OBNC14.2 +063100 PERFORM PRINT-DETAIL. OBNC14.2 +063200 COMMENT-ENTRIES-INIT. OBNC14.2 +063300 MOVE "VI-6 3.2.1.1" TO ANSI-REFERENCE. OBNC14.2 +063400 COMMENT-ENTRIES-TEST. OBNC14.2 +063500 MOVE "PLEASE VISUALLY VERIFY THE FOLLOWING PARAGRAPHS: " OBNC14.2 +063600 TO RE-MARK. OBNC14.2 +063700 PERFORM PRINT-DETAIL. OBNC14.2 +063800 MOVE " AUTHOR, INSTALLATION, DATE-WRITTEN, SECURITY" OBNC14.2 +063900 TO RE-MARK. OBNC14.2 +064000 PERFORM PRINT-DETAIL. OBNC14.2 +064100 SECT-NC180M-001 SECTION. OBNC14.2 +064200 STOP-INIT-GF-1. OBNC14.2 +064300 MOVE "STOP LITERAL" TO FEATURE. OBNC14.2 +064400 MOVE "VI-88 6.14.3 SR3, 6.14.4 GR2" TO ANSI-REFERENCE. OBNC14.2 +064500 STOP-TEST-GF-1. OBNC14.2 +064600 STOP "OPERATOR PLEASE EXECUTE RUN CONTINUATION". OBNC14.2 +064700 PERFORM PASS. OBNC14.2 +064800 GO TO STOP-WRITE-GF-1. OBNC14.2 +064900 STOP-DELETE-GF-1. OBNC14.2 +065000 PERFORM DE-LETE. OBNC14.2 +065100 STOP-WRITE-GF-1. OBNC14.2 +065200 MOVE "STOP-TEST-GF-1" TO PAR-NAME. OBNC14.2 +065300 PERFORM PRINT-DETAIL. OBNC14.2 +065400*STOP-NOTE. OBNC14.2 +065500* NOTE THE ABOVE TEST TESTS THE BASIC FUNCTIONING OF THE OBNC14.2 +065600* STOP VERB WITH LITERAL - A MESSAGE TO THE OPERATOR OBNC14.2 +065700* AND RESTART ABILITY. THE FOLLOWING TESTS ASCERTAIN OBNC14.2 +065800* THAT THE "LITERAL" MAY BE ANY LEGAL COBOL LITERAL. OBNC14.2 +065900* THE USER MUST VISUALLY CHECK THE MESSAGES TO THE OBNC14.2 +066000* OPERATOR AND SEE THAT THEY ARE IDENTICAL TO THE OBNC14.2 +066100* DATA SHOWN IN THE OUTPUT LISTING. OBNC14.2 +066200 STOP-INIT-GF-2. OBNC14.2 +066300 MOVE "SEE STOP-NOTE PARAGRAPH" TO RE-MARK. OBNC14.2 +066400 PERFORM PRINT-DETAIL. OBNC14.2 +066500 STOP-TEST-GF-2. OBNC14.2 +066600 STOP "A". OBNC14.2 +066700 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +066800 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +066900 GO TO STOP-WRITE-GF-2. OBNC14.2 +067000 STOP-DELETE-GF-2. OBNC14.2 +067100 PERFORM DE-LETE. OBNC14.2 +067200 STOP-WRITE-GF-2. OBNC14.2 +067300 MOVE "STOP-TEST-GF-2 " TO PAR-NAME. OBNC14.2 +067400 PERFORM PRINT-DETAIL. OBNC14.2 +067500 MOVE " A" TO PRINT-REC. OBNC14.2 +067600 WRITE PRINT-REC. OBNC14.2 +067700 MOVE SPACE TO TEST-RESULTS. OBNC14.2 +067800 STOP-TEST-GF-3. OBNC14.2 +067900 STOP "*". OBNC14.2 +068000 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +068100 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +068200 GO TO STOP-WRITE-GF-3. OBNC14.2 +068300 STOP-DELETE-GF-3. OBNC14.2 +068400 PERFORM DE-LETE. OBNC14.2 +068500 STOP-WRITE-GF-3. OBNC14.2 +068600 MOVE "STOP-TEST-GF-3 " TO PAR-NAME. OBNC14.2 +068700 PERFORM PRINT-DETAIL. OBNC14.2 +068800 MOVE " *" TO PRINT-REC. OBNC14.2 +068900 WRITE PRINT-REC. OBNC14.2 +069000 STOP-TEST-GF-4. OBNC14.2 +069100 STOP QUOTE. OBNC14.2 +069200 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +069300 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +069400 GO TO STOP-WRITE-GF-4. OBNC14.2 +069500 STOP-DELETE-GF-4. OBNC14.2 +069600 PERFORM DE-LETE. OBNC14.2 +069700 STOP-WRITE-GF-4. OBNC14.2 +069800 MOVE "STOP-TEST-GF-4 " TO PAR-NAME. OBNC14.2 +069900 PERFORM PRINT-DETAIL. OBNC14.2 +070000 MOVE " (A SINGLE QUOTE)" TO PRINT-REC. OBNC14.2 +070100 WRITE PRINT-REC. OBNC14.2 +070200 STOP-TEST-GF-5. OBNC14.2 +070300 MOVE "IV-9 4.3.3.3.1" TO ANSI-REFERENCE. OBNC14.2 +070400 STOP " * 5 * 10 * 15 * 20 * 25 * 30 * 35 * 40 * 45 * 50 OBNC14.2 +070500- "* 55 * 60 * 65 * 70 * 75 * 80 * 85 * 90 * 95 *100 *105 *110 OBNC14.2 +070600- "*115 *120 *125 *130 *135 *140 *145 *150 *155 *160". OBNC14.2 +070700 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +070800 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +070900 GO TO STOP-WRITE-GF-5. OBNC14.2 +071000 STOP-DELETE-GF-5. OBNC14.2 +071100 PERFORM DE-LETE. OBNC14.2 +071200 STOP-WRITE-GF-5. OBNC14.2 +071300 MOVE "STOP-TEST-GF-5 " TO PAR-NAME. OBNC14.2 +071400 PERFORM PRINT-DETAIL. OBNC14.2 +071500 MOVE " * 5 * 10 * 15 * 20 * 25 * 30 * 35 * 40 * 45 * 50 OBNC14.2 +071600- "* 55 * 60 * 65 * 70 * 75 * 80 * 85 * 90 * 95 *100 *105 *110 OBNC14.2 +071700- "*115 *120 *125 *130 *135 *140 *145 *150 *155 *160" OBNC14.2 +071800 TO PRINT-REC. OBNC14.2 +071900 WRITE PRINT-REC. OBNC14.2 +072000 STOP-TEST-GF-6. OBNC14.2 +072100 MOVE "VI-129 6.23.4" TO ANSI-REFERENCE. OBNC14.2 +072200 STOP 7. OBNC14.2 +072300 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +072400 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +072500 GO TO STOP-WRITE-GF-6. OBNC14.2 +072600 STOP-DELETE-GF-6. OBNC14.2 +072700 PERFORM DE-LETE. OBNC14.2 +072800 STOP-WRITE-GF-6. OBNC14.2 +072900 MOVE "STOP-TEST-GF-6 " TO PAR-NAME. OBNC14.2 +073000 PERFORM PRINT-DETAIL. OBNC14.2 +073100 MOVE " 7" TO PRINT-REC. OBNC14.2 +073200 WRITE PRINT-REC. OBNC14.2 +073300 STOP-TEST-GF-7. OBNC14.2 +073400 STOP 123456789987654321. OBNC14.2 +073500 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +073600 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +073700 GO TO STOP-WRITE-GF-7. OBNC14.2 +073800 STOP-DELETE-GF-7. OBNC14.2 +073900 PERFORM DE-LETE. OBNC14.2 +074000 STOP-WRITE-GF-7. OBNC14.2 +074100 MOVE "STOP-TEST-GF-7 " TO PAR-NAME. OBNC14.2 +074200 PERFORM PRINT-DETAIL. OBNC14.2 +074300 MOVE " 123456789987654321" TO PRINT-REC. OBNC14.2 +074400 WRITE PRINT-REC. OBNC14.2 +074500 STOP-TEST-GF-8. OBNC14.2 +074600 STOP ZERO. OBNC14.2 +074700 MOVE "SEE OPERATOR MESSAGE" TO COMPUTED-A. OBNC14.2 +074800 MOVE "SEE BELOW" TO CORRECT-A. OBNC14.2 +074900 GO TO STOP-WRITE-GF-8. OBNC14.2 +075000 STOP-DELETE-GF-8. OBNC14.2 +075100 PERFORM DE-LETE. OBNC14.2 +075200 STOP-WRITE-GF-8. OBNC14.2 +075300 MOVE "STOP-TEST-GF-8" TO PAR-NAME. OBNC14.2 +075400 PERFORM PRINT-DETAIL. OBNC14.2 +075500 MOVE " 0" TO PRINT-REC. OBNC14.2 +075600 WRITE PRINT-REC. OBNC14.2 +075700 STOP-TEST-GF-9. OBNC14.2 +075800 MOVE SPACE TO DUMMY-RECORD. OBNC14.2 +075900 PERFORM BLANK-LINE-PRINT 4 TIMES. OBNC14.2 +076000 MOVE " STOP-TEST-GF-9 PASSES UNLESS A SECOND REPORT FOR OBNC14.2 +076100- "OBNC1 IS GENERATED AFTER THIS ONE." TO TEST-RESULTS. OBNC14.2 +076200 PERFORM PRINT-DETAIL. OBNC14.2 +076300 MOVE SPACE TO TEST-RESULTS. OBNC14.2 +076400 PERFORM END-ROUTINE THRU END-ROUTINE-13. OBNC14.2 +076500 CLOSE PRINT-FILE. OBNC14.2 +076600 STOP "OPERATOR KILL OBNC1". OBNC14.2 +076700 MOVE ZEROES TO ERROR-HOLD. OBNC14.2 +076800 OPEN OUTPUT PRINT-FILE. OBNC14.2 +076900 PERFORM HEAD-ROUTINE THROUGH COLUMN-NAMES-ROUTINE. OBNC14.2 +077000 PERFORM FAIL. OBNC14.2 +077100 MOVE "EXECUTION DID NOT HALT" TO RE-MARK. OBNC14.2 +077200 GO TO STOP-WRITE-GF-9. OBNC14.2 +077300 STOP-DELETE-GF-9. OBNC14.2 +077400 PERFORM DE-LETE. OBNC14.2 +077500 STOP-WRITE-GF-9. OBNC14.2 +077600 MOVE "STOP LITERAL" TO FEATURE. OBNC14.2 +077700 MOVE "STOP-GF-9-TEST" TO PAR-NAME. OBNC14.2 +077800 PERFORM PRINT-DETAIL. OBNC14.2 +077900 OBNC14.2 +078000 CCVS-EXIT SECTION. OBNC14.2 +078100 CCVS-999999. OBNC14.2 +078200 GO TO CLOSE-FILES. OBNC14.2 diff --git a/tests/cobol85/OB/OBNC2M.CBL b/tests/cobol85/OB/OBNC2M.CBL new file mode 100755 index 00000000..0f619a98 --- /dev/null +++ b/tests/cobol85/OB/OBNC2M.CBL @@ -0,0 +1,929 @@ +000100 IDENTIFICATION DIVISION. OBNC24.2 +000200 PROGRAM-ID. OBNC24.2 +000300 OBNC2M. OBNC24.2 +000400 OBNC24.2 +000500**************************************************************** OBNC24.2 +000600* * OBNC24.2 +000700* VALIDATION FOR:- * OBNC24.2 +000800* * OBNC24.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC24.2 +001000* * OBNC24.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBNC24.2 +001200* * OBNC24.2 +001300**************************************************************** OBNC24.2 +001400* * OBNC24.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * OBNC24.2 +001600* * OBNC24.2 +001700* X-55 - SYSTEM PRINTER NAME. * OBNC24.2 +001800* X-82 - SOURCE COMPUTER NAME. * OBNC24.2 +001900* X-83 - OBJECT COMPUTER NAME. * OBNC24.2 +002000* * OBNC24.2 +002100**************************************************************** OBNC24.2 +002200* PROGRAM OBNC2M CONTAINS CCVS74 TESTS OF LANGUAGE ELEMENTS * OBNC24.2 +002300* DEFINED AS OBSOLETE IN THE 198X STANDARDS. * OBNC24.2 +002400**************************************************************** OBNC24.2 +002500 DATE-COMPILED. OBNC24.2 +002600* THIS COMMENT LINE SHOULD NOT BE REPLACED OBNC24.2 +002700* THIS COMMENT ENTRY SHOULD APPEAR AS THE LAST LINE BEFORE OBNC24.2 +002800* THE ENVIRONMENT DIVISION. OBNC24.2 +002900 ENVIRONMENT DIVISION. OBNC24.2 +003000 CONFIGURATION SECTION. OBNC24.2 +003100 SOURCE-COMPUTER. OBNC24.2 +003200 Linux. OBNC24.2 +003300 OBJECT-COMPUTER. OBNC24.2 +003400 Linux. OBNC24.2 +003500 INPUT-OUTPUT SECTION. OBNC24.2 +003600 FILE-CONTROL. OBNC24.2 +003700 SELECT PRINT-FILE ASSIGN TO OBNC24.2 +003800 "report.log". OBNC24.2 +003900 DATA DIVISION. OBNC24.2 +004000 FILE SECTION. OBNC24.2 +004100 FD PRINT-FILE. OBNC24.2 +004200 01 PRINT-REC PICTURE X(120). OBNC24.2 +004300 01 DUMMY-RECORD PICTURE X(120). OBNC24.2 +004400 WORKING-STORAGE SECTION. OBNC24.2 +004500 77 SMALL-VALU PICTURE 99 VALUE 7. OBNC24.2 +004600 77 SMALLER-VALU PICTURE 99 VALUE 6. OBNC24.2 +004700 77 SMALLEST-VALU PICTURE 99 VALUE 5. OBNC24.2 +004800 77 EVEN-SMALLER PICTURE 99 VALUE 1. OBNC24.2 +004900 77 WRK-DS-02V00 PICTURE S99. OBNC24.2 +005000 88 TEST-2NUC-COND-99 VALUE 99. OBNC24.2 +005100 77 WRK-DS-06V06 PICTURE S9(6)V9(6). OBNC24.2 +005200 77 WRK-DS-12V00-S REDEFINES WRK-DS-06V06 OBNC24.2 +005300 PICTURE S9(12). OBNC24.2 +005400 77 A02TWOS-DS-02V00 PICTURE S99 VALUE 22. OBNC24.2 +005500 77 WRK-DS-01V00 PICTURE S9. OBNC24.2 +005600 77 A02TWOS-DS-03V02 PICTURE S999V99 VALUE +022.00. OBNC24.2 +005700 77 A990-DS-0201P PICTURE S99P VALUE 990. OBNC24.2 +005800 77 A02ONES-DS-02V00 PICTURE S99 VALUE 11. OBNC24.2 +005900 77 A01ONE-DS-P0801 PICTURE SP(8)9 VALUE .000000001.OBNC24.2 +006000 77 ATWO-DS-01V00 PICTURE S9 VALUE 2. OBNC24.2 +006100 77 WRK-XN-00001 PICTURE X. OBNC24.2 +006200 77 WRK-XN-00005 PICTURE X(5). OBNC24.2 +006300 77 TWO PICTURE 9 VALUE 2. OBNC24.2 +006400 77 THREE PICTURE 9 VALUE 3. OBNC24.2 +006500 77 SEVEN PICTURE 9 VALUE 7. OBNC24.2 +006600 77 NINE PICTURE 9 VALUE 9. OBNC24.2 +006700 77 TEN PICTURE 99 VALUE 10. OBNC24.2 +006800 77 ALTERCOUNT PICTURE 999 VALUE ZERO. OBNC24.2 +006900 77 QT5 PIC X(4) VALUE SPACE. OBNC24.2 +007000 77 XRAY PICTURE IS X. OBNC24.2 +007100 77 IF-D1 PICTURE S9(4)V9(2) VALUE 0. OBNC24.2 +007200 77 IF-D2 PICTURE S9(4)V9(2) VALUE ZERO. OBNC24.2 +007300 77 IF-D3 PICTURE X(10) VALUE "0000000000". OBNC24.2 +007400 77 IF-D4 PICTURE X(15) VALUE " ". OBNC24.2 +007500 77 IF-D5 PICTURE X(10) VALUE ALL QUOTE. OBNC24.2 +007600 77 IF-D6 PICTURE A(10) VALUE "BABABABABA". OBNC24.2 +007700 77 IF-D7 PICTURE S9(6)V9(4) VALUE +123.45. OBNC24.2 +007800 77 IF-D8 PICTURE 9(6)V9(4) VALUE 12300. OBNC24.2 +007900 77 IF-D9 PICTURE X(3) VALUE "123". OBNC24.2 +008000 77 IF-D11 PICTURE X(6) VALUE "ABCDEF". OBNC24.2 +008100 77 IF-D13 PICTURE 9(6)V9(4) VALUE 12300. OBNC24.2 +008200 77 IF-D14 PICTURE S9(4)V9(2) VALUE +123.45. OBNC24.2 +008300 77 IF-D15 PICTURE S999PP VALUE 12300. OBNC24.2 +008400 77 IF-D16 PICTURE PP99 VALUE .0012. OBNC24.2 +008500 77 IF-D17 PICTURE SV9(4) VALUE .0012. OBNC24.2 +008600 77 IF-D18 PICTURE X(10) VALUE "BABABABABA". OBNC24.2 +008700 77 IF-D19 PICTURE X(10) VALUE "ABCDEF ". OBNC24.2 +008800 77 IF-D23 PICTURE $9,9B9.90+. OBNC24.2 +008900 77 IF-D24 PICTURE X(10) VALUE "$1,2 3.40+". OBNC24.2 +009000 77 IF-D25 PICTURE ABABX0A. OBNC24.2 +009100 77 IF-D26 PICTURE X(8) VALUE "A C D0E". OBNC24.2 +009200 77 IF-D27 PICTURE IS 9(6)V9(4) VALUE IS 2137.45 OBNC24.2 +009300 USAGE IS COMPUTATIONAL. OBNC24.2 +009400 77 IF-D28 PICTURE IS 999999V9999 VALUE IS 2137.45. OBNC24.2 +009500 77 IF-D31 PICTURE S9(6) VALUE -123. OBNC24.2 +009600 77 IF-D32 PICTURE S9(4)V99. OBNC24.2 +009700 88 A VALUE 1. OBNC24.2 +009800 88 B VALUES ARE 2 THRU 4. OBNC24.2 +009900 88 C VALUE IS ZERO. OBNC24.2 +010000 88 D VALUE IS +12.34. OBNC24.2 +010100 88 E VALUE IS .01, .11, .21 .81. OBNC24.2 +010200 88 F VALUE IS 100 THRU 128 1000 THRU 1280 -9 THRU -2. OBNC24.2 +010300 88 G VALUE IS 8765.43 1234 THRU 5678 5 -9999 THRU 10. OBNC24.2 +010400 77 IF-D33 PICTURE X(4). OBNC24.2 +010500 88 B VALUE QUOTE. OBNC24.2 +010600 88 C VALUE SPACE. OBNC24.2 +010700 88 D VALUE ALL "BAC". OBNC24.2 +010800 77 IF-D34 PICTURE A(4). OBNC24.2 +010900 88 B VALUE "A A ". OBNC24.2 +011000 77 IF-D37 PICTURE 9(5) VALUE 12345. OBNC24.2 +011100 77 IF-D38 PICTURE X(9) VALUE "12345 ". OBNC24.2 +011200 77 CCON-1 PICTURE 99 VALUE 11. OBNC24.2 +011300 77 CCON-2 PICTURE 99 VALUE 12. OBNC24.2 +011400 77 CCON-3 PICTURE 99 VALUE 13. OBNC24.2 +011500 77 COMP-SGN1 PICTURE S9(1) VALUE +9 COMPUTATIONAL. OBNC24.2 +011600 77 COMP-SGN2 PICTURE S9(18) VALUE +3 COMPUTATIONAL. OBNC24.2 +011700 77 COMP-SGN3 PICTURE S9(1) VALUE -5 COMPUTATIONAL. OBNC24.2 +011800 77 COMP-SGN4 PICTURE S9(18) VALUE -3167598765431 COMPUTATIONAL.OBNC24.2 +011900 77 START-POINT PICTURE 9(6) COMPUTATIONAL. OBNC24.2 +012000 77 INC-VALUE PICTURE 9(6) COMPUTATIONAL. OBNC24.2 +012100 77 SWITCH-PFM-1 PICTURE 9 VALUE ZERO. OBNC24.2 +012200 77 SWITCH-PFM-2 PICTURE 9 VALUE ZERO. OBNC24.2 +012300 77 PFM-11-COUNTER PICTURE 999 VALUE ZERO. OBNC24.2 +012400 77 PFM-12-COUNTER PICTURE 999 VALUE 100. OBNC24.2 +012500 77 PFM-12-ANS1 PICTURE 999 VALUE ZERO. OBNC24.2 +012600 77 PFM-12-ANS2 PICTURE 999 VALUE ZERO. OBNC24.2 +012700 01 SUBSCRIPT-6 PICTURE 99999 VALUE ZERO. OBNC24.2 +012800 01 IF-TABLE. OBNC24.2 +012900 02 IF-ELEM PICTURE X OCCURS 12 TIMES. OBNC24.2 +013000 01 QUOTE-DATA. OBNC24.2 +013100 02 QU-1 PICTURE X(3) VALUE "123". OBNC24.2 +013200 02 QU-2 PICTURE X VALUE QUOTE. OBNC24.2 +013300 02 QU-3 PICTURE X(6) VALUE "ABC456". OBNC24.2 +013400 01 IF-D10. OBNC24.2 +013500 02 D1 PICTURE X(2) VALUE "01". OBNC24.2 +013600 02 D2 PICTURE X(2) VALUE "23". OBNC24.2 +013700 02 D3. OBNC24.2 +013800 03 D4 PICTURE X(4) VALUE "4567". OBNC24.2 +013900 03 D5 PICTURE X(4) VALUE "8912". OBNC24.2 +014000 01 IF-D12. OBNC24.2 +014100 02 D1 PICTURE X(3) VALUE "ABC". OBNC24.2 +014200 02 D2. OBNC24.2 +014300 03 D3. OBNC24.2 +014400 04 D4 PICTURE XX VALUE "DE". OBNC24.2 +014500 04 D5 PICTURE X VALUE "F". OBNC24.2 +014600 01 IF-D20. OBNC24.2 +014700 02 FILLER PICTURE 9(5) VALUE ZERO. OBNC24.2 +014800 02 D1 PICTURE 9(2) VALUE 12. OBNC24.2 +014900 02 D2 PICTURE 9 VALUE 3. OBNC24.2 +015000 02 D3 PICTURE 9(2) VALUE 45. OBNC24.2 +015100 01 IF-D21. OBNC24.2 +015200 02 D1 PICTURE 9(5) VALUE ZEROS. OBNC24.2 +015300 02 D2 PICTURE 9(5) VALUE 12345. OBNC24.2 +015400 01 IF-D22. OBNC24.2 +015500 02 D1 PICTURE A(2) VALUE "AB". OBNC24.2 +015600 02 D2 PICTURE A(4) VALUE "CDEF". OBNC24.2 +015700 01 IF-D35. OBNC24.2 +015800 02 AA PICTURE X(2). OBNC24.2 +015900 88 A1 VALUE "AA". OBNC24.2 +016000 88 A2 VALUE "AB". OBNC24.2 +016100 02 BB PICTURE IS X(2). OBNC24.2 +016200 88 B1 VALUE "CC". OBNC24.2 +016300 88 B2 VALUE "CD". OBNC24.2 +016400 02 BB-2 REDEFINES BB. OBNC24.2 +016500 03 AAA PICTURE X. OBNC24.2 +016600 88 AA1 VALUE "A". OBNC24.2 +016700 88 AA2 VALUE "C". OBNC24.2 +016800 03 BBB PICTURE X. OBNC24.2 +016900 88 BB1 VALUE "B". OBNC24.2 +017000 88 BB2 VALUE "D". OBNC24.2 +017100 01 IF-D36 PICTURE X(120) VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYOBNC24.2 +017200- "Z1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCDEFGHIJKLMOBNC24.2 +017300- "NOPQRSTUVWXYZ1234567890ABCDEFGHIJKL". OBNC24.2 +017400 01 IF-D40 PICTURE 9(5) VALUE 12345 OBNC24.2 +017500 COMPUTATIONAL SYNCHRONIZED RIGHT. OBNC24.2 +017600 88 IF-D40A VALUE ZERO THRU 10000. OBNC24.2 +017700 88 IF-D40B VALUE 10001 THRU 99999. OBNC24.2 +017800 88 IF-D40C VALUE 99999. OBNC24.2 +017900 01 PERFORM1 PICTURE XXX VALUE SPACES. OBNC24.2 +018000 01 PERFORM2 PICTURE S999 VALUE 20. OBNC24.2 +018100 01 PERFORM3 PICTURE 9 VALUE 5. OBNC24.2 +018200 01 PERFORM4 PICTURE S99V9. OBNC24.2 +018300 01 PERFORM5 PICTURE S99V9 VALUE 10.0. OBNC24.2 +018400 01 PERFORM6 PICTURE 99V9. OBNC24.2 +018500 01 PERFORM7. OBNC24.2 +018600 02 PERFORM8 OCCURS 7 TIMES PICTURE 99V9. OBNC24.2 +018700 01 PERFORM9 PICTURE 9 VALUE 3. OBNC24.2 +018800 01 PERFORM10 PICTURE S9 VALUE -1. OBNC24.2 +018900 01 PERFORM11 PICTURE 99 VALUE 6. OBNC24.2 +019000 01 PERFORM12. OBNC24.2 +019100 02 PERFORM13 OCCURS 4 TIMES. OBNC24.2 +019200 03 PERFORM14 OCCURS 20 TIMES PICTURE 99V9. OBNC24.2 +019300 03 PERFORM15 OCCURS 10 TIMES. OBNC24.2 +019400 04 PERFORM16 OCCURS 5 TIMES PICTURE 99V9. OBNC24.2 +019500 01 PERFORM17 PICTURE 9(6) COMPUTATIONAL. OBNC24.2 +019600 01 PERFORM18 PICTURE 9(6) COMPUTATIONAL. OBNC24.2 +019700 01 PERFORM-KEY PICTURE 9. OBNC24.2 +019800 01 PERFORM-SEVEN-LEVEL-TABLE. OBNC24.2 +019900 03 PFM71 OCCURS 2. OBNC24.2 +020000 05 PFM72 OCCURS 2. OBNC24.2 +020100 07 PFM73 OCCURS 2. OBNC24.2 +020200 09 PFM74 OCCURS 2. OBNC24.2 +020300 11 PFM75 OCCURS 2. OBNC24.2 +020400 13 PFM76 OCCURS 2. OBNC24.2 +020500 15 PFM77 OCCURS 2. OBNC24.2 +020600 17 PFM77-1 PIC X. OBNC24.2 +020700 01 S1 PIC S9(3) COMP. OBNC24.2 +020800 01 S2 PIC S9(3) COMP. OBNC24.2 +020900 01 S3 PIC S9(3) COMP. OBNC24.2 +021000 01 S4 PIC S9(3) COMP. OBNC24.2 +021100 01 S5 PIC S9(3) COMP. OBNC24.2 +021200 01 S6 PIC S9(3) COMP. OBNC24.2 +021300 01 S7 PIC S9(3) COMP. OBNC24.2 +021400 01 PFM-7-TOT PIC S9(3) COMP. OBNC24.2 +021500 01 PFM-F4-24-TOT PIC S9(3) COMP. OBNC24.2 +021600 01 PFM-A PIC S9(3) COMP. OBNC24.2 +021700 01 PFM-B PIC S9(3) COMP. OBNC24.2 +021800 01 FILLER-A. OBNC24.2 +021900 03 PFM-F4-25-A PIC S9(3) COMP OCCURS 10. OBNC24.2 +022000 01 FILLER-B. OBNC24.2 +022100 03 PFM-F4-25-B PIC S9(3) COMP OCCURS 10. OBNC24.2 +022200 01 FILLER-C. OBNC24.2 +022300 03 PFM-F4-25-C PIC S9(3) COMP OCCURS 10. OBNC24.2 +022400 01 RECEIVING-TABLE. OBNC24.2 +022500 03 TBL-ELEMEN-A. OBNC24.2 +022600 05 TBL-ELEMEN-B PICTURE X(18). OBNC24.2 +022700 05 TBL-ELEMEN-C PICTURE X(18). OBNC24.2 +022800 03 TBL-ELEMEN-D. OBNC24.2 +022900 05 TBL-ELEMEN-E PICTURE X OCCURS 36 TIMES. OBNC24.2 +023000 01 LITERAL-SPLITTER. OBNC24.2 +023100 02 PART1 PICTURE X(20). OBNC24.2 +023200 02 PART2 PICTURE X(20). OBNC24.2 +023300 02 PART3 PICTURE X(20). OBNC24.2 +023400 02 PART4 PICTURE X(20). OBNC24.2 +023500 01 LITERAL-TABLE REDEFINES LITERAL-SPLITTER. OBNC24.2 +023600 02 80PARTS PICTURE X OCCURS 80 TIMES. OBNC24.2 +023700 01 GRP-FOR-88-LEVELS. OBNC24.2 +023800 03 WRK-DS-02V00-COND PICTURE 99. OBNC24.2 +023900 88 COND-1 VALUE IS 01 THRU 05. OBNC24.2 +024000 88 COND-2 VALUES ARE 06 THRU 10 OBNC24.2 +024100 16 THRU 20 00. OBNC24.2 +024200 88 COND-3 VALUES 11 THRU 15. OBNC24.2 +024300 01 GRP-MOVE-CONSTANTS. OBNC24.2 +024400 03 GRP-GROUP-MOVE-FROM. OBNC24.2 +024500 04 GRP-ALPHABETIC. OBNC24.2 +024600 05 ALPHABET-AN-00026 PICTURE A(26) OBNC24.2 +024700 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". OBNC24.2 +024800 04 GRP-NUMERIC. OBNC24.2 +024900 05 DIGITS-DV-10V00 PICTURE 9(10) VALUE 0123456789. OBNC24.2 +025000 05 DIGITS-DU-06V04-S REDEFINES DIGITS-DV-10V00 OBNC24.2 +025100 PICTURE 9(6)V9999. OBNC24.2 +025200 04 GRP-ALPHANUMERIC. OBNC24.2 +025300 05 ALPHANUMERIC-XN-00049 PICTURE X(50) OBNC24.2 +025400 VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-><=l,;.()/* 0123456789". OBNC24.2 +025500 05 FILLER PICTURE X VALUE QUOTE. OBNC24.2 +025600 01 GRP-FOR-2N058. OBNC24.2 +025700 02 SUB-GRP-FOR-2N058-A. OBNC24.2 +025800 03 ELEM-FOR-2N058-A PICTURE 999 VALUE ZEROES. OBNC24.2 +025900 03 ELEM-FOR-2N058-B PICTURE XXX VALUE ZEROS. OBNC24.2 +026000 03 ELEM-FOR-2N058-C PICTURE XXX VALUE SPACES. OBNC24.2 +026100 03 ELEM-FOR-2N058-D PICTURE X(6) VALUE ALL "ABC". OBNC24.2 +026200 03 ELEM-FOR-2N058-E PICTURE XXX VALUE ALL "Z". OBNC24.2 +026300 03 ELEM-FOR-2N058-F PICTURE XXX VALUE ALL SPACES. OBNC24.2 +026400 03 ELEM-FOR-2N058-G PICTURE XXX VALUE ALL ZEROES. OBNC24.2 +026500 03 ELEM-FOR-2N058-H PICTURE 999 VALUE ALL ZEROS. OBNC24.2 +026600 03 ELEM-FOR-2N058-I PICTURE XXX VALUE QUOTES. OBNC24.2 +026700 03 ELEM-FOR-2N058-J PICTURE XXX VALUE ALL QUOTES. OBNC24.2 +026800 03 ELEM-FOR-2N058-K PICTURE XXX VALUE ALL HIGH-VALUES. OBNC24.2 +026900 03 ELEM-FOR-2N058-L PICTURE XXX VALUE ALL LOW-VALUES. OBNC24.2 +027000 03 ELEM-FOR-2N058-M PICTURE XXX VALUE HIGH-VALUES. OBNC24.2 +027100 03 ELEM-FOR-2N058-N PICTURE XXX VALUE LOW-VALUES. OBNC24.2 +027200 02 SUB-GRP-FOR-2N058-B. OBNC24.2 +027300 03 SUB-SUB-BA. OBNC24.2 +027400 04 ELEM-FOR-2N058-A PICTURE 999. OBNC24.2 +027500 04 ELEM-FOR-2N058-B PICTURE XXX. OBNC24.2 +027600 04 ELEM-FOR-2N058-C PICTURE XXX. OBNC24.2 +027700 04 ELEM-FOR-2N058-D PICTURE X(6). OBNC24.2 +027800 03 SUB-SUB-BB. OBNC24.2 +027900 04 ELEM-FOR-2N058-E PICTURE XXX. OBNC24.2 +028000 04 ELEM-FOR-2N058-F PICTURE XXX. OBNC24.2 +028100 04 ELEM-FOR-2N058-G PICTURE XXX. OBNC24.2 +028200 04 ELEM-FOR-2N058-H PICTURE 999. OBNC24.2 +028300 03 SUB-SUB-BC. OBNC24.2 +028400 04 ELEM-FOR-2N058-I PICTURE XXX. OBNC24.2 +028500 04 ELEM-FOR-2N058-J PICTURE XXX. OBNC24.2 +028600 04 ELEM-FOR-2N058-K PICTURE XXX. OBNC24.2 +028700 04 ELEM-FOR-2N058-L PICTURE XXX. OBNC24.2 +028800 04 ELEM-FOR-2N058-M PICTURE XXX. OBNC24.2 +028900 04 ELEM-FOR-2N058-N PICTURE XXX. OBNC24.2 +029000 01 CHARACTER-BREAKDOWN-S. OBNC24.2 +029100 02 FIRST-20S PICTURE X(20). OBNC24.2 +029200 02 SECOND-20S PICTURE X(20). OBNC24.2 +029300 02 THIRD-20S PICTURE X(20). OBNC24.2 +029400 02 FOURTH-20S PICTURE X(20). OBNC24.2 +029500 02 FIFTH-20S PICTURE X(20). OBNC24.2 +029600 02 SIXTH-20S PICTURE X(20). OBNC24.2 +029700 02 SEVENTH-20S PICTURE X(20). OBNC24.2 +029800 02 EIGHTH-20S PICTURE X(20). OBNC24.2 +029900 02 NINTH-20S PICTURE X(20). OBNC24.2 +030000 02 TENTH-20S PICTURE X(20). OBNC24.2 +030100 01 CHARACTER-BREAKDOWN-R. OBNC24.2 +030200 02 FIRST-20R PICTURE X(20). OBNC24.2 +030300 02 SECOND-20R PICTURE X(20). OBNC24.2 +030400 02 THIRD-20R PICTURE X(20). OBNC24.2 +030500 02 FOURTH-20R PICTURE X(20). OBNC24.2 +030600 02 FIFTH-20R PICTURE X(20). OBNC24.2 +030700 02 SIXTH-20R PICTURE X(20). OBNC24.2 +030800 02 SEVENTH-20R PICTURE X(20). OBNC24.2 +030900 02 EIGHTH-20R PICTURE X(20). OBNC24.2 +031000 02 NINTH-20R PICTURE X(20). OBNC24.2 +031100 02 TENTH-20R PICTURE X(20). OBNC24.2 +031200 01 TABLE-80. OBNC24.2 +031300 02 ELMT OCCURS 3 TIMES PIC 9. OBNC24.2 +031400 88 A80 VALUES ARE ZERO THRU 7. OBNC24.2 +031500 88 B80 VALUE 8. OBNC24.2 +031600 88 C80 VALUES ARE 7, 8 THROUGH 9. OBNC24.2 +031700 OBNC24.2 +031800 01 TABLE-86. OBNC24.2 +031900 88 A86 VALUE "ABC". OBNC24.2 +032000 88 B86 VALUE "ABCABC". OBNC24.2 +032100 88 C86 VALUE " ABC". OBNC24.2 +032200 02 DATANAME-86 PIC XXX VALUE "ABC". OBNC24.2 +032300 02 DNAME-86. OBNC24.2 +032400 03 FILLER PIC X VALUE "A". OBNC24.2 +032500 03 FILLER PIC X VALUE "B". OBNC24.2 +032600 03 FILLER PIC X VALUE "C". OBNC24.2 +032700 01 FIGCON-DATA. OBNC24.2 +032800 02 SPACE-X PICTURE X(10) VALUE " ". OBNC24.2 +032900 02 QUOTE-X PICTURE X(5) VALUE QUOTE. OBNC24.2 +033000 02 LOW-VAL PICTURE X(5) VALUE LOW-VALUE. OBNC24.2 +033100 02 ABC PICTURE XXX VALUE "ABC". OBNC24.2 +033200 02 ONE23 PICTURE 9999 VALUE 123. OBNC24.2 +033300 02 ZERO-C PICTURE 9(10) VALUE 0 COMPUTATIONAL. OBNC24.2 +033400 02 ZERO-D PICTURE 9 VALUE ZERO USAGE DISPLAY. OBNC24.2 +033500 01 TEST-RESULTS. OBNC24.2 +033600 02 FILLER PIC X VALUE SPACE. OBNC24.2 +033700 02 FEATURE PIC X(20) VALUE SPACE. OBNC24.2 +033800 02 FILLER PIC X VALUE SPACE. OBNC24.2 +033900 02 P-OR-F PIC X(5) VALUE SPACE. OBNC24.2 +034000 02 FILLER PIC X VALUE SPACE. OBNC24.2 +034100 02 PAR-NAME. OBNC24.2 +034200 03 FILLER PIC X(19) VALUE SPACE. OBNC24.2 +034300 03 PARDOT-X PIC X VALUE SPACE. OBNC24.2 +034400 03 DOTVALUE PIC 99 VALUE ZERO. OBNC24.2 +034500 02 FILLER PIC X(8) VALUE SPACE. OBNC24.2 +034600 02 RE-MARK PIC X(61). OBNC24.2 +034700 01 TEST-COMPUTED. OBNC24.2 +034800 02 FILLER PIC X(30) VALUE SPACE. OBNC24.2 +034900 02 FILLER PIC X(17) VALUE OBNC24.2 +035000 " COMPUTED=". OBNC24.2 +035100 02 COMPUTED-X. OBNC24.2 +035200 03 COMPUTED-A PIC X(20) VALUE SPACE. OBNC24.2 +035300 03 COMPUTED-N REDEFINES COMPUTED-A OBNC24.2 +035400 PIC -9(9).9(9). OBNC24.2 +035500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). OBNC24.2 +035600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). OBNC24.2 +035700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). OBNC24.2 +035800 03 CM-18V0 REDEFINES COMPUTED-A. OBNC24.2 +035900 04 COMPUTED-18V0 PIC -9(18). OBNC24.2 +036000 04 FILLER PIC X. OBNC24.2 +036100 03 FILLER PIC X(50) VALUE SPACE. OBNC24.2 +036200 01 TEST-CORRECT. OBNC24.2 +036300 02 FILLER PIC X(30) VALUE SPACE. OBNC24.2 +036400 02 FILLER PIC X(17) VALUE " CORRECT =". OBNC24.2 +036500 02 CORRECT-X. OBNC24.2 +036600 03 CORRECT-A PIC X(20) VALUE SPACE. OBNC24.2 +036700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). OBNC24.2 +036800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). OBNC24.2 +036900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). OBNC24.2 +037000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). OBNC24.2 +037100 03 CR-18V0 REDEFINES CORRECT-A. OBNC24.2 +037200 04 CORRECT-18V0 PIC -9(18). OBNC24.2 +037300 04 FILLER PIC X. OBNC24.2 +037400 03 FILLER PIC X(2) VALUE SPACE. OBNC24.2 +037500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. OBNC24.2 +037600 01 CCVS-C-1. OBNC24.2 +037700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAOBNC24.2 +037800- "SS PARAGRAPH-NAME OBNC24.2 +037900- " REMARKS". OBNC24.2 +038000 02 FILLER PIC X(20) VALUE SPACE. OBNC24.2 +038100 01 CCVS-C-2. OBNC24.2 +038200 02 FILLER PIC X VALUE SPACE. OBNC24.2 +038300 02 FILLER PIC X(6) VALUE "TESTED". OBNC24.2 +038400 02 FILLER PIC X(15) VALUE SPACE. OBNC24.2 +038500 02 FILLER PIC X(4) VALUE "FAIL". OBNC24.2 +038600 02 FILLER PIC X(94) VALUE SPACE. OBNC24.2 +038700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. OBNC24.2 +038800 01 REC-CT PIC 99 VALUE ZERO. OBNC24.2 +038900 01 DELETE-COUNTER PIC 999 VALUE ZERO. OBNC24.2 +039000 01 ERROR-COUNTER PIC 999 VALUE ZERO. OBNC24.2 +039100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBNC24.2 +039200 01 PASS-COUNTER PIC 999 VALUE ZERO. OBNC24.2 +039300 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBNC24.2 +039400 01 ERROR-HOLD PIC 999 VALUE ZERO. OBNC24.2 +039500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBNC24.2 +039600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBNC24.2 +039700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. OBNC24.2 +039800 01 CCVS-H-1. OBNC24.2 +039900 02 FILLER PIC X(39) VALUE SPACES. OBNC24.2 +040000 02 FILLER PIC X(42) VALUE OBNC24.2 +040100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". OBNC24.2 +040200 02 FILLER PIC X(39) VALUE SPACES. OBNC24.2 +040300 01 CCVS-H-2A. OBNC24.2 +040400 02 FILLER PIC X(40) VALUE SPACE. OBNC24.2 +040500 02 FILLER PIC X(7) VALUE "CCVS85 ". OBNC24.2 +040600 02 FILLER PIC XXXX VALUE OBNC24.2 +040700 "4.2 ". OBNC24.2 +040800 02 FILLER PIC X(28) VALUE OBNC24.2 +040900 " COPY - NOT FOR DISTRIBUTION". OBNC24.2 +041000 02 FILLER PIC X(41) VALUE SPACE. OBNC24.2 +041100 OBNC24.2 +041200 01 CCVS-H-2B. OBNC24.2 +041300 02 FILLER PIC X(15) VALUE OBNC24.2 +041400 "TEST RESULT OF ". OBNC24.2 +041500 02 TEST-ID PIC X(9). OBNC24.2 +041600 02 FILLER PIC X(4) VALUE OBNC24.2 +041700 " IN ". OBNC24.2 +041800 02 FILLER PIC X(12) VALUE OBNC24.2 +041900 " HIGH ". OBNC24.2 +042000 02 FILLER PIC X(22) VALUE OBNC24.2 +042100 " LEVEL VALIDATION FOR ". OBNC24.2 +042200 02 FILLER PIC X(58) VALUE OBNC24.2 +042300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC24.2 +042400 01 CCVS-H-3. OBNC24.2 +042500 02 FILLER PIC X(34) VALUE OBNC24.2 +042600 " FOR OFFICIAL USE ONLY ". OBNC24.2 +042700 02 FILLER PIC X(58) VALUE OBNC24.2 +042800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBNC24.2 +042900 02 FILLER PIC X(28) VALUE OBNC24.2 +043000 " COPYRIGHT 1985 ". OBNC24.2 +043100 01 CCVS-E-1. OBNC24.2 +043200 02 FILLER PIC X(52) VALUE SPACE. OBNC24.2 +043300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". OBNC24.2 +043400 02 ID-AGAIN PIC X(9). OBNC24.2 +043500 02 FILLER PIC X(45) VALUE SPACES. OBNC24.2 +043600 01 CCVS-E-2. OBNC24.2 +043700 02 FILLER PIC X(31) VALUE SPACE. OBNC24.2 +043800 02 FILLER PIC X(21) VALUE SPACE. OBNC24.2 +043900 02 CCVS-E-2-2. OBNC24.2 +044000 03 ERROR-TOTAL PIC XXX VALUE SPACE. OBNC24.2 +044100 03 FILLER PIC X VALUE SPACE. OBNC24.2 +044200 03 ENDER-DESC PIC X(44) VALUE OBNC24.2 +044300 "ERRORS ENCOUNTERED". OBNC24.2 +044400 01 CCVS-E-3. OBNC24.2 +044500 02 FILLER PIC X(22) VALUE OBNC24.2 +044600 " FOR OFFICIAL USE ONLY". OBNC24.2 +044700 02 FILLER PIC X(12) VALUE SPACE. OBNC24.2 +044800 02 FILLER PIC X(58) VALUE OBNC24.2 +044900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBNC24.2 +045000 02 FILLER PIC X(13) VALUE SPACE. OBNC24.2 +045100 02 FILLER PIC X(15) VALUE OBNC24.2 +045200 " COPYRIGHT 1985". OBNC24.2 +045300 01 CCVS-E-4. OBNC24.2 +045400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBNC24.2 +045500 02 FILLER PIC X(4) VALUE " OF ". OBNC24.2 +045600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBNC24.2 +045700 02 FILLER PIC X(40) VALUE OBNC24.2 +045800 " TESTS WERE EXECUTED SUCCESSFULLY". OBNC24.2 +045900 01 XXINFO. OBNC24.2 +046000 02 FILLER PIC X(19) VALUE OBNC24.2 +046100 "*** INFORMATION ***". OBNC24.2 +046200 02 INFO-TEXT. OBNC24.2 +046300 04 FILLER PIC X(8) VALUE SPACE. OBNC24.2 +046400 04 XXCOMPUTED PIC X(20). OBNC24.2 +046500 04 FILLER PIC X(5) VALUE SPACE. OBNC24.2 +046600 04 XXCORRECT PIC X(20). OBNC24.2 +046700 02 INF-ANSI-REFERENCE PIC X(48). OBNC24.2 +046800 01 HYPHEN-LINE. OBNC24.2 +046900 02 FILLER PIC IS X VALUE IS SPACE. OBNC24.2 +047000 02 FILLER PIC IS X(65) VALUE IS "************************OBNC24.2 +047100- "*****************************************". OBNC24.2 +047200 02 FILLER PIC IS X(54) VALUE IS "************************OBNC24.2 +047300- "******************************". OBNC24.2 +047400 01 CCVS-PGM-ID PIC X(9) VALUE OBNC24.2 +047500 "OBNC2M". OBNC24.2 +047600 PROCEDURE DIVISION. OBNC24.2 +047700 CCVS1 SECTION. OBNC24.2 +047800 OPEN-FILES. OBNC24.2 +047900 OPEN OUTPUT PRINT-FILE. OBNC24.2 +048000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBNC24.2 +048100 MOVE SPACE TO TEST-RESULTS. OBNC24.2 +048200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBNC24.2 +048300 GO TO CCVS1-EXIT. OBNC24.2 +048400 CLOSE-FILES. OBNC24.2 +048500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBNC24.2 +048600 TERMINATE-CCVS. OBNC24.2 +048700*S EXIT PROGRAM. OBNC24.2 +048800*SERMINATE-CALL. OBNC24.2 +048900 STOP RUN. OBNC24.2 +049000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBNC24.2 +049100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBNC24.2 +049200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBNC24.2 +049300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. OBNC24.2 +049400 MOVE "****TEST DELETED****" TO RE-MARK. OBNC24.2 +049500 PRINT-DETAIL. OBNC24.2 +049600 IF REC-CT NOT EQUAL TO ZERO OBNC24.2 +049700 MOVE "." TO PARDOT-X OBNC24.2 +049800 MOVE REC-CT TO DOTVALUE. OBNC24.2 +049900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBNC24.2 +050000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBNC24.2 +050100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBNC24.2 +050200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBNC24.2 +050300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBNC24.2 +050400 MOVE SPACE TO CORRECT-X. OBNC24.2 +050500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBNC24.2 +050600 MOVE SPACE TO RE-MARK. OBNC24.2 +050700 HEAD-ROUTINE. OBNC24.2 +050800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +050900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +051000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBNC24.2 +051100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBNC24.2 +051200 COLUMN-NAMES-ROUTINE. OBNC24.2 +051300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +051400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +051500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +051600 END-ROUTINE. OBNC24.2 +051700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBNC24.2 +051800 END-RTN-EXIT. OBNC24.2 +051900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +052000 END-ROUTINE-1. OBNC24.2 +052100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBNC24.2 +052200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. OBNC24.2 +052300 ADD PASS-COUNTER TO ERROR-HOLD. OBNC24.2 +052400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBNC24.2 +052500 MOVE PASS-COUNTER TO CCVS-E-4-1. OBNC24.2 +052600 MOVE ERROR-HOLD TO CCVS-E-4-2. OBNC24.2 +052700 MOVE CCVS-E-4 TO CCVS-E-2-2. OBNC24.2 +052800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBNC24.2 +052900 END-ROUTINE-12. OBNC24.2 +053000 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBNC24.2 +053100 IF ERROR-COUNTER IS EQUAL TO ZERO OBNC24.2 +053200 MOVE "NO " TO ERROR-TOTAL OBNC24.2 +053300 ELSE OBNC24.2 +053400 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBNC24.2 +053500 MOVE CCVS-E-2 TO DUMMY-RECORD. OBNC24.2 +053600 PERFORM WRITE-LINE. OBNC24.2 +053700 END-ROUTINE-13. OBNC24.2 +053800 IF DELETE-COUNTER IS EQUAL TO ZERO OBNC24.2 +053900 MOVE "NO " TO ERROR-TOTAL ELSE OBNC24.2 +054000 MOVE DELETE-COUNTER TO ERROR-TOTAL. OBNC24.2 +054100 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBNC24.2 +054200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +054300 IF INSPECT-COUNTER EQUAL TO ZERO OBNC24.2 +054400 MOVE "NO " TO ERROR-TOTAL OBNC24.2 +054500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBNC24.2 +054600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBNC24.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +054800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBNC24.2 +054900 WRITE-LINE. OBNC24.2 +055000 ADD 1 TO RECORD-COUNT. OBNC24.2 +055100 IF RECORD-COUNT GREATER 50 OBNC24.2 +055200 MOVE DUMMY-RECORD TO DUMMY-HOLD OBNC24.2 +055300 MOVE SPACE TO DUMMY-RECORD OBNC24.2 +055400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBNC24.2 +055500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBNC24.2 +055600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBNC24.2 +055700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBNC24.2 +055800 MOVE DUMMY-HOLD TO DUMMY-RECORD OBNC24.2 +055900 MOVE ZERO TO RECORD-COUNT. OBNC24.2 +056000 PERFORM WRT-LN. OBNC24.2 +056100 WRT-LN. OBNC24.2 +056200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBNC24.2 +056300 MOVE SPACE TO DUMMY-RECORD. OBNC24.2 +056400 BLANK-LINE-PRINT. OBNC24.2 +056500 PERFORM WRT-LN. OBNC24.2 +056600 FAIL-ROUTINE. OBNC24.2 +056700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBNC24.2 +056800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.OBNC24.2 +056900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBNC24.2 +057000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBNC24.2 +057100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +057200 MOVE SPACES TO INF-ANSI-REFERENCE. OBNC24.2 +057300 GO TO FAIL-ROUTINE-EX. OBNC24.2 +057400 FAIL-ROUTINE-WRITE. OBNC24.2 +057500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBNC24.2 +057600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. OBNC24.2 +057700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +057800 MOVE SPACES TO COR-ANSI-REFERENCE. OBNC24.2 +057900 FAIL-ROUTINE-EX. EXIT. OBNC24.2 +058000 BAIL-OUT. OBNC24.2 +058100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBNC24.2 +058200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBNC24.2 +058300 BAIL-OUT-WRITE. OBNC24.2 +058400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBNC24.2 +058500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBNC24.2 +058600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBNC24.2 +058700 MOVE SPACES TO INF-ANSI-REFERENCE. OBNC24.2 +058800 BAIL-OUT-EX. EXIT. OBNC24.2 +058900 CCVS1-EXIT. OBNC24.2 +059000 EXIT. OBNC24.2 +059100 SECT-OBNC2M-001 SECTION. OBNC24.2 +059200* OBNC24.2 +059300 GO--TEST-1. OBNC24.2 +059400 ALTER GO--A TO PROCEED TO GO--C. OBNC24.2 +059500* NOTE THE GO STATEMENT IN GO--A IS NOT LEGAL UNLESS IT IS OBNC24.2 +059600* ALTERED AS SHOWN ABOVE BEFORE CONTROL PASSES TO IT. OBNC24.2 +059700 GO TO GO--A. OBNC24.2 +059800 GO--DELETE-1. OBNC24.2 +059900 PERFORM DE-LETE. OBNC24.2 +060000 GO TO GO--WRITE-1. OBNC24.2 +060100 GO--A. OBNC24.2 +060200 GO TO. OBNC24.2 +060300 GO--B. OBNC24.2 +060400 PERFORM FAIL. OBNC24.2 +060500 GO TO GO--WRITE-1. OBNC24.2 +060600 GO--C. OBNC24.2 +060700 PERFORM PASS. OBNC24.2 +060800 GO--WRITE-1. OBNC24.2 +060900 PERFORM END-ROUTINE. OBNC24.2 +061000 MOVE "UNFINISHED GO TO" TO FEATURE. OBNC24.2 +061100 MOVE "GO--TEST-1" TO PAR-NAME. OBNC24.2 +061200 PERFORM PRINT-DETAIL. OBNC24.2 +061300 ALTER-TEST-1. OBNC24.2 +061400 ALTER ALTER-A TO PROCEED TO ALTER-C OBNC24.2 +061500 ALTER-D TO PROCEED TO ALTER-F OBNC24.2 +061600 ALTER-F TO PROCEED TO ALTER-H. OBNC24.2 +061700 GO TO ALTER-A. OBNC24.2 +061800 ALTER-DELETE-1. OBNC24.2 +061900 PERFORM DE-LETE. OBNC24.2 +062000 GO TO ALTER-WRITE-1. OBNC24.2 +062100 ALTER-A. OBNC24.2 +062200 GO TO ALTER-B. OBNC24.2 +062300 ALTER-B. OBNC24.2 +062400 ADD 1 TO ALTERCOUNT. OBNC24.2 +062500 GO TO ALTER-FAIL-1. OBNC24.2 +062600 ALTER-C. OBNC24.2 +062700 PERFORM PASS. OBNC24.2 +062800 ALTER-D. OBNC24.2 +062900 GO TO ALTER-E. OBNC24.2 +063000 ALTER-E. OBNC24.2 +063100 ADD 10 TO ALTERCOUNT. OBNC24.2 +063200 GO TO ALTER-FAIL-1. OBNC24.2 +063300 ALTER-F. OBNC24.2 +063400 GO TO ALTER-G. OBNC24.2 +063500 ALTER-G. OBNC24.2 +063600 ADD 100 TO ALTERCOUNT. OBNC24.2 +063700 GO TO ALTER-FAIL-1. OBNC24.2 +063800 ALTER-H. OBNC24.2 +063900 GO TO ALTER-WRITE-1. OBNC24.2 +064000 ALTER-FAIL-1. OBNC24.2 +064100 MOVE ALTERCOUNT TO COMPUTED-N. OBNC24.2 +064200 MOVE ZERO TO CORRECT-N. OBNC24.2 +064300 PERFORM FAIL. OBNC24.2 +064400 ALTER-WRITE-1. OBNC24.2 +064500 PERFORM END-ROUTINE. OBNC24.2 +064600 MOVE "SERIES ALTER" TO FEATURE. OBNC24.2 +064700 MOVE "ALTER-TEST-1" TO PAR-NAME. OBNC24.2 +064800 PERFORM PRINT-DETAIL. OBNC24.2 +064900 ALTER-INIT-B. OBNC24.2 +065000 MOVE "SERIES ALTER" TO FEATURE. OBNC24.2 +065100 ALTER-TEST-2. OBNC24.2 +065200 MOVE ZERO TO SUBSCRIPT-6. OBNC24.2 +065300 MOVE SPACE TO RECEIVING-TABLE. OBNC24.2 +065400 ALTER-TESTT-2. OBNC24.2 +065500 GO TO ALTER-TESTTT-2. OBNC24.2 +065600 ALTER-A-2. OBNC24.2 +065700 GO TO ALTER-C-2. OBNC24.2 +065800 ALTER-B-2. OBNC24.2 +065900 MOVE "M" TO WRK-XN-00001. OBNC24.2 +066000 PERFORM ALTER-G-2. OBNC24.2 +066100 ALTER-C-2. OBNC24.2 +066200 MOVE "N" TO WRK-XN-00001. OBNC24.2 +066300 PERFORM ALTER-G-2. OBNC24.2 +066400 MOVE " " TO WRK-XN-00001. OBNC24.2 +066500 PERFORM ALTER-G-2. OBNC24.2 +066600 ALTER-D-2. OBNC24.2 +066700 GO TO ALTER-F-2. OBNC24.2 +066800 ALTER-E-2. OBNC24.2 +066900 MOVE "O" TO WRK-XN-00001. OBNC24.2 +067000 PERFORM ALTER-G-2. OBNC24.2 +067100 ALTER-F-2. OBNC24.2 +067200 MOVE "P" TO WRK-XN-00001. OBNC24.2 +067300 PERFORM ALTER-G-2. OBNC24.2 +067400 MOVE " " TO WRK-XN-00001. OBNC24.2 +067500 PERFORM ALTER-G-2. OBNC24.2 +067600 ALTER-G-2. OBNC24.2 +067700 ADD 1 TO SUBSCRIPT-6. OBNC24.2 +067800 MOVE WRK-XN-00001 TO TBL-ELEMEN-E (SUBSCRIPT-6). OBNC24.2 +067900 ALTER-TESTTT-2. OBNC24.2 +068000 PERFORM ALTER-A-2 THRU ALTER-F-2. OBNC24.2 +068100 ALTER ALTER-A-2 TO PROCEED TO ALTER-B-2 OBNC24.2 +068200 ALTER-TESTT-2 TO PROCEED TO ALTER-TESTT-2 OBNC24.2 +068300 ALTER-D-2 TO PROCEED TO ALTER-E-2. OBNC24.2 +068400 PERFORM ALTER-A-2 THRU ALTER-F-2. OBNC24.2 +068500 PERFORM ALTER-A-2 THRU ALTER-F-2. OBNC24.2 +068600 MOVE TBL-ELEMEN-D TO TBL-ELEMEN-B. OBNC24.2 +068700 IF TBL-ELEMEN-B EQUAL TO "N P MN OP MN OP " OBNC24.2 +068800 PERFORM PASS GO TO ALTER-WRITE-2. OBNC24.2 +068900 GO TO ALTER-FAIL-2. OBNC24.2 +069000 ALTER-DELETE-2. OBNC24.2 +069100 PERFORM DE-LETE. OBNC24.2 +069200 GO TO ALTER-WRITE-2. OBNC24.2 +069300 ALTER-FAIL-2. OBNC24.2 +069400 MOVE TBL-ELEMEN-B TO COMPUTED-A. OBNC24.2 +069500 MOVE "N P MN OP MN OP " TO CORRECT-A. OBNC24.2 +069600 PERFORM FAIL. OBNC24.2 +069700 ALTER-WRITE-2. OBNC24.2 +069800 MOVE "ALTER-TEST-2" TO PAR-NAME. OBNC24.2 +069900 PERFORM PRINT-DETAIL. OBNC24.2 +070000 ALTER-INIT-3. OBNC24.2 +070100* NOTE THE FOLLOWING TESTS UTILIZE THE ALTER STATEMENT WITH OBNC24.2 +070200* 11 OPERANDS A DELETE IN ALTER-TEST-3 WILL CAUSE THE OBNC24.2 +070300* REST OF THE ALTER TESTS TO BE BYPASSED. OBNC24.2 +070400 ALTER-TEST-3. OBNC24.2 +070500 ALTER TEST-3A TO PROCEED TO TEST-3C TEST-4A TO TEST-4C OBNC24.2 +070600 TEST-5A TO TEST-5B TEST-6A TO TEST-6C TEST-7A TO OBNC24.2 +070700 TEST-7B TEST-8B TO PROCEED TO TEST-8C TEST-9A TO OBNC24.2 +070800 TEST-9C TEST-10A TO TEST-10C TEST-11A TO TEST-11C OBNC24.2 +070900 TEST-12B TO PROCEED TO TEST-12C TEST-13A TO TEST-13B. OBNC24.2 +071000 GO TO TEST-3A. OBNC24.2 +071100 ALTER-DELETE-3. OBNC24.2 +071200 PERFORM DE-LETE. OBNC24.2 +071300 MOVE "ALTER-TEST-3 THRU 13" TO PAR-NAME. OBNC24.2 +071400 PERFORM PRINT-DETAIL. OBNC24.2 +071500 GO TO ALTER-EXIT. OBNC24.2 +071600 TEST-3A. OBNC24.2 +071700 GO TO TEST-3B. OBNC24.2 +071800 TEST-3B. OBNC24.2 +071900 MOVE "TEST-3C " TO CORRECT-A. OBNC24.2 +072000 MOVE "TEST-3B " TO COMPUTED-A. OBNC24.2 +072100 PERFORM FAIL. OBNC24.2 +072200 GO TO ALTER-WRITE-3. OBNC24.2 +072300 TEST-3C. OBNC24.2 +072400 PERFORM PASS. OBNC24.2 +072500 ALTER-WRITE-3. OBNC24.2 +072600 MOVE "ALTER-TEST-3 " TO PAR-NAME. OBNC24.2 +072700 PERFORM PRINT-DETAIL. OBNC24.2 +072800 ALTER-TEST-4. OBNC24.2 +072900 GO TO TEST-4A. OBNC24.2 +073000 TEST-4A. OBNC24.2 +073100 GO TO TEST-4B. OBNC24.2 +073200 TEST-4B. OBNC24.2 +073300 MOVE "TEST-4B " TO COMPUTED-A. OBNC24.2 +073400 MOVE "TEST-4C " TO CORRECT-A. OBNC24.2 +073500 PERFORM FAIL. OBNC24.2 +073600 GO TO ALTER-WRITE-4. OBNC24.2 +073700 TEST-4C. OBNC24.2 +073800 PERFORM PASS. OBNC24.2 +073900 ALTER-WRITE-4. OBNC24.2 +074000 MOVE "ALTER-TEST-4 " TO PAR-NAME. OBNC24.2 +074100 PERFORM PRINT-DETAIL. OBNC24.2 +074200 ALTER-TEST-5. OBNC24.2 +074300 GO TO TEST-5A. OBNC24.2 +074400 TEST-5B. OBNC24.2 +074500 PERFORM PASS OBNC24.2 +074600 GO TO ALTER-WRITE-5. OBNC24.2 +074700 TEST-5A. OBNC24.2 +074800 GO TO TEST-5C. OBNC24.2 +074900 TEST-5C. OBNC24.2 +075000 MOVE "TEST-5C " TO COMPUTED-A. OBNC24.2 +075100 MOVE "TEST-5B " TO CORRECT-A. OBNC24.2 +075200 PERFORM FAIL. OBNC24.2 +075300 ALTER-WRITE-5. OBNC24.2 +075400 MOVE "ALTER-TEST-5 " TO PAR-NAME. OBNC24.2 +075500 PERFORM PRINT-DETAIL. OBNC24.2 +075600 ALTER-TEST-6. OBNC24.2 +075700 GO TO TEST-6A. OBNC24.2 +075800 TEST-6B. OBNC24.2 +075900 MOVE "TEST-6B " TO COMPUTED-A. OBNC24.2 +076000 MOVE "TEST-6C " TO CORRECT-A. OBNC24.2 +076100 PERFORM FAIL. OBNC24.2 +076200 GO TO ALTER-WRITE-6. OBNC24.2 +076300 TEST-6A. OBNC24.2 +076400 GO TO TEST-6B. OBNC24.2 +076500 TEST-6C. OBNC24.2 +076600 PERFORM PASS. OBNC24.2 +076700 ALTER-WRITE-6. OBNC24.2 +076800 MOVE "ALTER-TEST-6 " TO PAR-NAME. OBNC24.2 +076900 PERFORM PRINT-DETAIL. OBNC24.2 +077000 ALTER-TEST-7. OBNC24.2 +077100 GO TO TEST-7A. OBNC24.2 +077200 TEST-7B. OBNC24.2 +077300 PERFORM PASS. OBNC24.2 +077400 GO TO ALTER-WRITE-7. OBNC24.2 +077500 TEST-7A. OBNC24.2 +077600 GO TO TEST-7C. OBNC24.2 +077700 TEST-7C. OBNC24.2 +077800 MOVE "TEST-7C " TO COMPUTED-A. OBNC24.2 +077900 MOVE "TEST-7B " TO CORRECT-A. OBNC24.2 +078000 PERFORM FAIL. OBNC24.2 +078100 ALTER-WRITE-7. OBNC24.2 +078200 MOVE "ALTER-TEST-7 " TO PAR-NAME. OBNC24.2 +078300 PERFORM PRINT-DETAIL. OBNC24.2 +078400 ALTER-TEST-8. OBNC24.2 +078500 GO TO TEST-8B. OBNC24.2 +078600 TEST-8B. OBNC24.2 +078700 GO TO TEST-8A. OBNC24.2 +078800 TEST-8C. OBNC24.2 +078900 PERFORM PASS. OBNC24.2 +079000 GO TO ALTER-WRITE-8. OBNC24.2 +079100 TEST-8A. OBNC24.2 +079200 MOVE "TEST-8A " TO COMPUTED-A. OBNC24.2 +079300 MOVE "TEST-8C " TO CORRECT-A. OBNC24.2 +079400 PERFORM FAIL. OBNC24.2 +079500 ALTER-WRITE-8. OBNC24.2 +079600 MOVE "ALTER-TEST-8 " TO PAR-NAME. OBNC24.2 +079700 PERFORM PRINT-DETAIL. OBNC24.2 +079800 ALTER-TEST-9. OBNC24.2 +079900 GO TO TEST-9A. OBNC24.2 +080000 TEST-9B. OBNC24.2 +080100 MOVE "TEST-9B " TO COMPUTED-A. OBNC24.2 +080200 MOVE "TEST-9C " TO CORRECT-A. OBNC24.2 +080300 PERFORM FAIL. OBNC24.2 +080400 GO TO ALTER-WRITE-9. OBNC24.2 +080500 TEST-9A. OBNC24.2 +080600 GO TO TEST-9B. OBNC24.2 +080700 TEST-9C. OBNC24.2 +080800 PERFORM PASS. OBNC24.2 +080900 ALTER-WRITE-9. OBNC24.2 +081000 MOVE "ALTER-TEST-9 " TO PAR-NAME. OBNC24.2 +081100 PERFORM PRINT-DETAIL. OBNC24.2 +081200 ALTER-TEST-10. OBNC24.2 +081300 GO TO TEST-10A. OBNC24.2 +081400 TEST-10B. OBNC24.2 +081500 MOVE "TEST-10B " TO COMPUTED-A. OBNC24.2 +081600 MOVE "TEST-10C " TO CORRECT-A. OBNC24.2 +081700 PERFORM FAIL. OBNC24.2 +081800 ALTER-WRITE-10. OBNC24.2 +081900 MOVE "ALTER-TEST-10 " TO PAR-NAME. OBNC24.2 +082000 PERFORM PRINT-DETAIL. OBNC24.2 +082100 ALTER-TEST-11. OBNC24.2 +082200 GO TO TEST-11A. OBNC24.2 +082300 TEST-10A. OBNC24.2 +082400 GO TO TEST-10B. OBNC24.2 +082500 TEST-10C. OBNC24.2 +082600 PERFORM PASS. OBNC24.2 +082700 GO TO ALTER-WRITE-10. OBNC24.2 +082800 TEST-11A. OBNC24.2 +082900 GO TO TEST-11B. OBNC24.2 +083000 TEST-11B. OBNC24.2 +083100 MOVE "TEST-11B " TO COMPUTED-A. OBNC24.2 +083200 MOVE "TEST-11C " TO CORRECT-A. OBNC24.2 +083300 PERFORM FAIL. OBNC24.2 +083400 GO TO ALTER-WRITE-11. OBNC24.2 +083500 TEST-11C. OBNC24.2 +083600 PERFORM PASS. OBNC24.2 +083700 ALTER-WRITE-11. OBNC24.2 +083800 MOVE "ALTER-TEST-11 " TO PAR-NAME. OBNC24.2 +083900 PERFORM PRINT-DETAIL. OBNC24.2 +084000 ALTER-TEST-12. OBNC24.2 +084100 GO TO TEST-12B. OBNC24.2 +084200 TEST-12A. OBNC24.2 +084300 MOVE "TEST-12A " TO COMPUTED-A. OBNC24.2 +084400 MOVE "TEST-12C " TO CORRECT-A. OBNC24.2 +084500 PERFORM FAIL. OBNC24.2 +084600 GO TO ALTER-WRITE-12. OBNC24.2 +084700 TEST-12B. OBNC24.2 +084800 GO TO TEST-12A. OBNC24.2 +084900 TEST-12C. OBNC24.2 +085000 PERFORM PASS. OBNC24.2 +085100 ALTER-WRITE-12. OBNC24.2 +085200 MOVE "ALTER-TEST-12 " TO PAR-NAME. OBNC24.2 +085300 PERFORM PRINT-DETAIL. OBNC24.2 +085400 ALTER-TEST-13. OBNC24.2 +085500 GO TO TEST-13A. OBNC24.2 +085600 TEST-13C. OBNC24.2 +085700 MOVE "TEST-13C " TO COMPUTED-A. OBNC24.2 +085800 MOVE "TEST-13B " TO CORRECT-A. OBNC24.2 +085900 PERFORM FAIL. OBNC24.2 +086000 GO TO ALTER-WRITE-13. OBNC24.2 +086100 TEST-13A. OBNC24.2 +086200 GO TO TEST-13C. OBNC24.2 +086300 TEST-13B. OBNC24.2 +086400 PERFORM PASS. OBNC24.2 +086500 ALTER-WRITE-13. OBNC24.2 +086600 MOVE "ALTER-TEST-13 " TO PAR-NAME. OBNC24.2 +086700 PERFORM PRINT-DETAIL. OBNC24.2 +086800 ALTER-EXIT. OBNC24.2 +086900 EXIT. OBNC24.2 +087000 DATE-TEST-1. OBNC24.2 +087100 MOVE "DATE-COMPILED" TO FEATURE, PAR-NAME. OBNC24.2 +087200 MOVE "SEE SOURCE LISTING" TO COMPUTED-A. OBNC24.2 +087300 MOVE "COMMENT SHOULD BE DELETED" TO RE-MARK. OBNC24.2 +087400 PERFORM PRINT-DETAIL. OBNC24.2 +087500 QUAL-SECTION-1 SECTION. OBNC24.2 +087600 PARA-TEST-5. OBNC24.2 +087700 ALTER PARA-5A IN QUAL-SECTION-1 TO PROCEED TO PARA-5C OF OBNC24.2 +087800 QUAL-SECTION-2. OBNC24.2 +087900 PARA-5A. OBNC24.2 +088000 GO TO PARA-5C OF QUAL-SECTION-1. OBNC24.2 +088100 PARA-5B. OBNC24.2 +088200 MOVE "FAIL" TO QT5. OBNC24.2 +088300 GO TO PARA-5D. OBNC24.2 +088400 PARA-5C. OBNC24.2 +088500 MOVE "FAIL" TO QT5. OBNC24.2 +088600 PARA-5D. OBNC24.2 +088700 IF QT5 EQUAL TO "PASS" OBNC24.2 +088800 PERFORM PASS ELSE OBNC24.2 +088900 PERFORM FAIL. OBNC24.2 +089000 MOVE "PARA-TEST-5" TO PAR-NAME. OBNC24.2 +089100 PERFORM PRINT-DETAIL. OBNC24.2 +089200 PARA-5-EXIT. OBNC24.2 +089300 EXIT. OBNC24.2 +089400 PARA-TEST-6. OBNC24.2 +089500 ALTER PARA-6B IN QUAL-SECTION-2 TO PROCEED TO PARA-6C OF OBNC24.2 +089600 QUAL-SECTION-1. OBNC24.2 +089700 PARA-6A. OBNC24.2 +089800 GO TO PARA-6B OF QUAL-SECTION-2. OBNC24.2 +089900 PARA-6B. OBNC24.2 +090000 PERFORM FAIL OBNC24.2 +090100 GO TO PARA-6-EXIT. OBNC24.2 +090200 PARA-6C. OBNC24.2 +090300 PERFORM PASS. OBNC24.2 +090400 GO TO PARA-6-EXIT. OBNC24.2 +090500 PARA-6D. OBNC24.2 +090600 PERFORM FAIL. OBNC24.2 +090700 PARA-6-EXIT. OBNC24.2 +090800 EXIT. OBNC24.2 +090900 PARA-6-LAST. OBNC24.2 +091000 GO TO CCVS-EXIT. OBNC24.2 +091100 PARA-TEST-FINISH. OBNC24.2 +091200 MOVE "PARA-TEST-6" TO PAR-NAME. OBNC24.2 +091300 PERFORM PRINT-DETAIL. OBNC24.2 +091400 QUAL-SECTION-2 SECTION. OBNC24.2 +091500 PARA-5C. OBNC24.2 +091600 MOVE "PASS" TO QT5. OBNC24.2 +091700 GO TO PARA-5D. OBNC24.2 +091800 PARA-6B. OBNC24.2 +091900 GO TO PARA-6D OF QUAL-SECTION-2. OBNC24.2 +092000 PARA-6C. OBNC24.2 +092100 PERFORM FAIL. OBNC24.2 +092200 GO TO PARA-6-EXIT. OBNC24.2 +092300 PARA-6D. OBNC24.2 +092400 GO TO PARA-6D IN QUAL-SECTION-1. OBNC24.2 +092500 QUAL-EXIT. OBNC24.2 +092600 EXIT. OBNC24.2 +092700 CCVS-EXIT SECTION. OBNC24.2 +092800 CCVS-999999. OBNC24.2 +092900 GO TO CLOSE-FILES. OBNC24.2 diff --git a/tests/cobol85/OB/OBSQ1A.CBL b/tests/cobol85/OB/OBSQ1A.CBL new file mode 100755 index 00000000..814d84c7 --- /dev/null +++ b/tests/cobol85/OB/OBSQ1A.CBL @@ -0,0 +1,629 @@ +000100 IDENTIFICATION DIVISION. OBSQ14.2 +000200 PROGRAM-ID. OBSQ14.2 +000300 OBSQ1A. OBSQ14.2 +000400**************************************************************** OBSQ14.2 +000500* * OBSQ14.2 +000600* VALIDATION FOR:- * OBSQ14.2 +000700* " HIGH ". OBSQ14.2 +000800* * OBSQ14.2 +000900* CREATION DATE / VALIDATION DATE * OBSQ14.2 +001000* "4.2 ". OBSQ14.2 +001100* * OBSQ14.2 +001200* THE ROUTINE OBSQ1A CREATES A TAPE FILE WHICH HAS FIXED OBSQ14.2 +001300* LENGTH RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN OBSQ14.2 +001400* INPUT FILE. THE FILE IS READ AND FIELDS IN THE INPUT RECORDSOBSQ14.2 +001500* ARE COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDSOBSQ14.2 +001600* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED OBSQ14.2 +001700* AGAIN AS AN INPUT FILE. FOUR READ FORMAT OPTIONS ARE USED OBSQ14.2 +001800* TO READ THE FILE AND FIELDS IN THE RECORDS ARE VERIFIED. OBSQ14.2 +001900* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR OBSQ14.2 +002000* LEVEL ONE FEATURES. OBSQ14.2 +002100* OBSQ14.2 +002200* THIS ROUTINE TESTS THE OBSOLETE LANGUAGE FEATURE "VALUE OF". OBSQ14.2 +002300* IT IS IDENTICAL WITH THE OLD (74) TEST PROGRAM SQ102. OBSQ14.2 +002400* OBSQ14.2 +002500* USED X-CARDS: OBSQ14.2 +002600* XXXXX001 OBSQ14.2 +002700* XXXXX055 OBSQ14.2 +002800* P XXXXX062 OBSQ14.2 +002900* XXXXX082 OBSQ14.2 +003000* XXXXX083 OBSQ14.2 +003100* C XXXXX084 OBSQ14.2 +003200* OBSQ14.2 +003300* OBSQ14.2 +003400* OBSOLETE FEATURES WHICH ARE TESTED: OBSQ14.2 +003500* OBSQ14.2 +003600* VALUE OF OBSQ14.2 +003700* XXXXX074 OBSQ14.2 +003800* IS OBSQ14.2 +003900* XXXXX075 OBSQ14.2 +004000* XXXXX069 OBSQ14.2 +004100* OBSQ14.2 +004200* DATA RECORDS ARE ... DATA RECORD ... OBSQ14.2 +004300* LABEL RECORDS ARE ... LABEL RECORD ... OBSQ14.2 +004400 ENVIRONMENT DIVISION. OBSQ14.2 +004500 CONFIGURATION SECTION. OBSQ14.2 +004600 SOURCE-COMPUTER. OBSQ14.2 +004700 Linux. OBSQ14.2 +004800 OBJECT-COMPUTER. OBSQ14.2 +004900 Linux. OBSQ14.2 +005000 INPUT-OUTPUT SECTION. OBSQ14.2 +005100 FILE-CONTROL. OBSQ14.2 +005200*P SELECT RAW-DATA ASSIGN TO OBSQ14.2 +005300*P "XXXXX062" OBSQ14.2 +005400*P ORGANIZATION IS INDEXED OBSQ14.2 +005500*P ACCESS MODE IS RANDOM OBSQ14.2 +005600*P RECORD KEY IS RAW-DATA-KEY. OBSQ14.2 +005700 SELECT PRINT-FILE ASSIGN TO OBSQ14.2 +005800 "report.log". OBSQ14.2 +005900 SELECT SQ-FS1 ASSIGN TO OBSQ14.2 +006000 "XXXXX001" OBSQ14.2 +006100 ORGANIZATION IS SEQUENTIAL OBSQ14.2 +006200 ACCESS MODE IS SEQUENTIAL. OBSQ14.2 +006300 DATA DIVISION. OBSQ14.2 +006400 FILE SECTION. OBSQ14.2 +006500*P OBSQ14.2 +006600*PD RAW-DATA OBSQ14.2 +006700*P DATA RECORD IS RAW-DATA-SATZ OBSQ14.2 +006800*P RECORD CONTAINS 50 CHARACTERS OBSQ14.2 +006900*P LABEL RECORDS ARE STANDARD. OBSQ14.2 +007000*P OBSQ14.2 +007100*P1 RAW-DATA-SATZ. OBSQ14.2 +007200*P 05 RAW-DATA-KEY. OBSQ14.2 +007300*P 10 C-2 PIC XX. OBSQ14.2 +007400*P 10 C-POS3 PIC X. OBSQ14.2 +007500*P 10 FILLER PIC XX. OBSQ14.2 +007600*P 05 C-DATUM. OBSQ14.2 +007700*P 10 C-D-JJ PIC XX. OBSQ14.2 +007800*P 10 C-D-MM PIC XX. OBSQ14.2 +007900*P 10 C-D-DD PIC XX. OBSQ14.2 +008000*P 05 C-DATE REDEFINES C-DATUM PIC 9(6). OBSQ14.2 +008100*P 05 C-ZEIT. OBSQ14.2 +008200*P 10 C-T-HH PIC XX. OBSQ14.2 +008300*P 10 C-T-MM PIC XX. OBSQ14.2 +008400*P 10 C-T-SS PIC XX. OBSQ14.2 +008500*P 10 C-T-HS PIC XX. OBSQ14.2 +008600*P 05 C-TIME REDEFINES C-ZEIT PIC 9(8). OBSQ14.2 +008700*P 05 C-NO-OF-TESTS PIC 99. OBSQ14.2 +008800*P 05 C-OK PIC 999. OBSQ14.2 +008900*P 05 C-ALL PIC 999. OBSQ14.2 +009000*P 05 C-FAIL PIC 999. OBSQ14.2 +009100*P 05 C-DELETED PIC 999. OBSQ14.2 +009200*P 05 C-INSPECT PIC 999. OBSQ14.2 +009300*P 05 C-NOTE PIC X(13). OBSQ14.2 +009400*P 05 C-INDENT PIC X. OBSQ14.2 +009500 FD PRINT-FILE. OBSQ14.2 +009600 01 PRINT-REC PICTURE X(120). OBSQ14.2 +009700 01 DUMMY-RECORD PICTURE X(120). OBSQ14.2 +009800 FD SQ-FS1 OBSQ14.2 +009900*C VALUE OF OBSQ14.2 +010000*C OCLABELID OBSQ14.2 +010100*C IS OBSQ14.2 +010200*C "OCDUMMY" OBSQ14.2 +010300*G SYSIN OBSQ14.2 +010400 DATA RECORD SQ-FS1R1-F-G-120 OBSQ14.2 +010500 LABEL RECORD STANDARD. OBSQ14.2 +010600 01 SQ-FS1R1-F-G-120. OBSQ14.2 +010700 02 FILLER PIC X(120). OBSQ14.2 +010800 WORKING-STORAGE SECTION. OBSQ14.2 +010900 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. OBSQ14.2 +011000 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. OBSQ14.2 +011100 01 ERROR-FLAG PIC 9 VALUE ZERO. OBSQ14.2 +011200 01 EOF-FLAG PICTURE 9 VALUE ZERO. OBSQ14.2 +011300 01 FILE-RECORD-INFORMATION-REC. OBSQ14.2 +011400 03 FILE-RECORD-INFO-SKELETON. OBSQ14.2 +011500 05 FILLER PICTURE X(48) VALUE OBSQ14.2 +011600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBSQ14.2 +011700 05 FILLER PICTURE X(46) VALUE OBSQ14.2 +011800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBSQ14.2 +011900 05 FILLER PICTURE X(26) VALUE OBSQ14.2 +012000 ",LFIL=000000,ORG= ,LBLR= ". OBSQ14.2 +012100 05 FILLER PICTURE X(37) VALUE OBSQ14.2 +012200 ",RECKEY= ". OBSQ14.2 +012300 05 FILLER PICTURE X(38) VALUE OBSQ14.2 +012400 ",ALTKEY1= ". OBSQ14.2 +012500 05 FILLER PICTURE X(38) VALUE OBSQ14.2 +012600 ",ALTKEY2= ". OBSQ14.2 +012700 05 FILLER PICTURE X(7) VALUE SPACE.OBSQ14.2 +012800 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBSQ14.2 +012900 05 FILE-RECORD-INFO-P1-120. OBSQ14.2 +013000 07 FILLER PIC X(5). OBSQ14.2 +013100 07 XFILE-NAME PIC X(6). OBSQ14.2 +013200 07 FILLER PIC X(8). OBSQ14.2 +013300 07 XRECORD-NAME PIC X(6). OBSQ14.2 +013400 07 FILLER PIC X(1). OBSQ14.2 +013500 07 REELUNIT-NUMBER PIC 9(1). OBSQ14.2 +013600 07 FILLER PIC X(7). OBSQ14.2 +013700 07 XRECORD-NUMBER PIC 9(6). OBSQ14.2 +013800 07 FILLER PIC X(6). OBSQ14.2 +013900 07 UPDATE-NUMBER PIC 9(2). OBSQ14.2 +014000 07 FILLER PIC X(5). OBSQ14.2 +014100 07 ODO-NUMBER PIC 9(4). OBSQ14.2 +014200 07 FILLER PIC X(5). OBSQ14.2 +014300 07 XPROGRAM-NAME PIC X(5). OBSQ14.2 +014400 07 FILLER PIC X(7). OBSQ14.2 +014500 07 XRECORD-LENGTH PIC 9(6). OBSQ14.2 +014600 07 FILLER PIC X(7). OBSQ14.2 +014700 07 CHARS-OR-RECORDS PIC X(2). OBSQ14.2 +014800 07 FILLER PIC X(1). OBSQ14.2 +014900 07 XBLOCK-SIZE PIC 9(4). OBSQ14.2 +015000 07 FILLER PIC X(6). OBSQ14.2 +015100 07 RECORDS-IN-FILE PIC 9(6). OBSQ14.2 +015200 07 FILLER PIC X(5). OBSQ14.2 +015300 07 XFILE-ORGANIZATION PIC X(2). OBSQ14.2 +015400 07 FILLER PIC X(6). OBSQ14.2 +015500 07 XLABEL-TYPE PIC X(1). OBSQ14.2 +015600 05 FILE-RECORD-INFO-P121-240. OBSQ14.2 +015700 07 FILLER PIC X(8). OBSQ14.2 +015800 07 XRECORD-KEY PIC X(29). OBSQ14.2 +015900 07 FILLER PIC X(9). OBSQ14.2 +016000 07 ALTERNATE-KEY1 PIC X(29). OBSQ14.2 +016100 07 FILLER PIC X(9). OBSQ14.2 +016200 07 ALTERNATE-KEY2 PIC X(29). OBSQ14.2 +016300 07 FILLER PIC X(7). OBSQ14.2 +016400 01 TEST-RESULTS. OBSQ14.2 +016500 02 FILLER PICTURE X VALUE SPACE. OBSQ14.2 +016600 02 FEATURE PICTURE X(20) VALUE SPACE. OBSQ14.2 +016700 02 FILLER PICTURE X VALUE SPACE. OBSQ14.2 +016800 02 P-OR-F PICTURE X(5) VALUE SPACE. OBSQ14.2 +016900 02 FILLER PICTURE X VALUE SPACE. OBSQ14.2 +017000 02 PAR-NAME. OBSQ14.2 +017100 03 FILLER PICTURE X(12) VALUE SPACE. OBSQ14.2 +017200 03 PARDOT-X PICTURE X VALUE SPACE. OBSQ14.2 +017300 03 DOTVALUE PICTURE 99 VALUE ZERO. OBSQ14.2 +017400 03 FILLER PIC X(5) VALUE SPACE. OBSQ14.2 +017500 02 FILLER PIC X(10) VALUE SPACE. OBSQ14.2 +017600 02 RE-MARK PIC X(61). OBSQ14.2 +017700 01 TEST-COMPUTED. OBSQ14.2 +017800 02 FILLER PIC X(30) VALUE SPACE. OBSQ14.2 +017900 02 FILLER PIC X(17) VALUE " COMPUTED=". OBSQ14.2 +018000 02 COMPUTED-X. OBSQ14.2 +018100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. OBSQ14.2 +018200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). OBSQ14.2 +018300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). OBSQ14.2 +018400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). OBSQ14.2 +018500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). OBSQ14.2 +018600 03 CM-18V0 REDEFINES COMPUTED-A. OBSQ14.2 +018700 04 COMPUTED-18V0 PICTURE -9(18). OBSQ14.2 +018800 04 FILLER PICTURE X. OBSQ14.2 +018900 03 FILLER PIC X(50) VALUE SPACE. OBSQ14.2 +019000 01 TEST-CORRECT. OBSQ14.2 +019100 02 FILLER PIC X(30) VALUE SPACE. OBSQ14.2 +019200 02 FILLER PIC X(17) VALUE " CORRECT =". OBSQ14.2 +019300 02 CORRECT-X. OBSQ14.2 +019400 03 CORRECT-A PICTURE X(20) VALUE SPACE. OBSQ14.2 +019500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). OBSQ14.2 +019600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). OBSQ14.2 +019700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). OBSQ14.2 +019800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). OBSQ14.2 +019900 03 CR-18V0 REDEFINES CORRECT-A. OBSQ14.2 +020000 04 CORRECT-18V0 PICTURE -9(18). OBSQ14.2 +020100 04 FILLER PICTURE X. OBSQ14.2 +020200 03 FILLER PIC X(50) VALUE SPACE. OBSQ14.2 +020300 01 CCVS-C-1. OBSQ14.2 +020400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PAOBSQ14.2 +020500- "SS PARAGRAPH-NAME OBSQ14.2 +020600- " REMARKS". OBSQ14.2 +020700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. OBSQ14.2 +020800 01 CCVS-C-2. OBSQ14.2 +020900 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ14.2 +021000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". OBSQ14.2 +021100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. OBSQ14.2 +021200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". OBSQ14.2 +021300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. OBSQ14.2 +021400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. OBSQ14.2 +021500 01 REC-CT PICTURE 99 VALUE ZERO. OBSQ14.2 +021600 01 DELETE-CNT PICTURE 999 VALUE ZERO. OBSQ14.2 +021700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. OBSQ14.2 +021800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBSQ14.2 +021900 01 PASS-COUNTER PIC 999 VALUE ZERO. OBSQ14.2 +022000 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBSQ14.2 +022100 01 ERROR-HOLD PIC 999 VALUE ZERO. OBSQ14.2 +022200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBSQ14.2 +022300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBSQ14.2 +022400 01 CCVS-H-1. OBSQ14.2 +022500 02 FILLER PICTURE X(27) VALUE SPACE. OBSQ14.2 +022600 02 FILLER PICTURE X(67) VALUE OBSQ14.2 +022700 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION OBSQ14.2 +022800- " SYSTEM". OBSQ14.2 +022900 02 FILLER PICTURE X(26) VALUE SPACE. OBSQ14.2 +023000 01 CCVS-H-2. OBSQ14.2 +023100 02 FILLER PICTURE X(52) VALUE IS OBSQ14.2 +023200 "CCVS74 FSTC COPY, NOT FOR DISTRIBUTION.". OBSQ14.2 +023300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". OBSQ14.2 +023400 02 TEST-ID PICTURE IS X(9). OBSQ14.2 +023500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. OBSQ14.2 +023600 01 CCVS-H-3. OBSQ14.2 +023700 02 FILLER PICTURE X(34) VALUE OBSQ14.2 +023800 " FOR OFFICIAL USE ONLY ". OBSQ14.2 +023900 02 FILLER PICTURE X(58) VALUE OBSQ14.2 +024000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBSQ14.2 +024100 02 FILLER PICTURE X(28) VALUE OBSQ14.2 +024200 " COPYRIGHT 1974 ". OBSQ14.2 +024300 01 CCVS-E-1. OBSQ14.2 +024400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. OBSQ14.2 +024500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". OBSQ14.2 +024600 02 ID-AGAIN PICTURE IS X(9). OBSQ14.2 +024700 02 FILLER PICTURE X(45) VALUE IS OBSQ14.2 +024800 " NTIS DISTRIBUTION COBOL 74". OBSQ14.2 +024900 01 CCVS-E-2. OBSQ14.2 +025000 02 FILLER PICTURE X(31) VALUE OBSQ14.2 +025100 SPACE. OBSQ14.2 +025200 02 FILLER PICTURE X(21) VALUE SPACE. OBSQ14.2 +025300 02 CCVS-E-2-2. OBSQ14.2 +025400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. OBSQ14.2 +025500 03 FILLER PICTURE IS X VALUE IS SPACE. OBSQ14.2 +025600 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". OBSQ14.2 +025700 01 CCVS-E-3. OBSQ14.2 +025800 02 FILLER PICTURE X(22) VALUE OBSQ14.2 +025900 " FOR OFFICIAL USE ONLY". OBSQ14.2 +026000 02 FILLER PICTURE X(12) VALUE SPACE. OBSQ14.2 +026100 02 FILLER PICTURE X(58) VALUE OBSQ14.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBSQ14.2 +026300 02 FILLER PICTURE X(13) VALUE SPACE. OBSQ14.2 +026400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". OBSQ14.2 +026500 01 CCVS-E-4. OBSQ14.2 +026600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBSQ14.2 +026700 02 FILLER PIC XXXX VALUE " OF ". OBSQ14.2 +026800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBSQ14.2 +026900 02 FILLER PIC X(40) VALUE OBSQ14.2 +027000 " TESTS WERE EXECUTED SUCCESSFULLY". OBSQ14.2 +027100 01 XXINFO. OBSQ14.2 +027200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". OBSQ14.2 +027300 02 INFO-TEXT. OBSQ14.2 +027400 04 FILLER PIC X(20) VALUE SPACE. OBSQ14.2 +027500 04 XXCOMPUTED PIC X(20). OBSQ14.2 +027600 04 FILLER PIC X(5) VALUE SPACE. OBSQ14.2 +027700 04 XXCORRECT PIC X(20). OBSQ14.2 +027800 01 HYPHEN-LINE. OBSQ14.2 +027900 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ14.2 +028000 02 FILLER PICTURE IS X(65) VALUE IS "************************OBSQ14.2 +028100- "*****************************************". OBSQ14.2 +028200 02 FILLER PICTURE IS X(54) VALUE IS "************************OBSQ14.2 +028300- "******************************". OBSQ14.2 +028400 01 CCVS-PGM-ID PIC X(6) VALUE OBSQ14.2 +028500 "OBSQ1A". OBSQ14.2 +028600 PROCEDURE DIVISION. OBSQ14.2 +028700 CCVS1 SECTION. OBSQ14.2 +028800 OPEN-FILES. OBSQ14.2 +028900*P OPEN I-O RAW-DATA. OBSQ14.2 +029000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ14.2 +029100*P READ RAW-DATA INVALID KEY GO TO END-E-1. OBSQ14.2 +029200*P ADD 1 TO C-NO-OF-TESTS. OBSQ14.2 +029300*P ACCEPT C-DATE FROM DATE. OBSQ14.2 +029400*P ACCEPT C-TIME FROM TIME. OBSQ14.2 +029500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. OBSQ14.2 +029600*PND-E-1. OBSQ14.2 +029700*P CLOSE RAW-DATA. OBSQ14.2 +029800 OPEN OUTPUT PRINT-FILE. OBSQ14.2 +029900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBSQ14.2 +030000 MOVE SPACE TO TEST-RESULTS. OBSQ14.2 +030100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBSQ14.2 +030200 MOVE ZERO TO REC-SKL-SUB. OBSQ14.2 +030300 PERFORM CCVS-INIT-FILE 9 TIMES. OBSQ14.2 +030400 CCVS-INIT-FILE. OBSQ14.2 +030500 ADD 1 TO REC-SKL-SUB. OBSQ14.2 +030600 MOVE FILE-RECORD-INFO-SKELETON TO OBSQ14.2 +030700 FILE-RECORD-INFO (REC-SKL-SUB). OBSQ14.2 +030800 CCVS-INIT-EXIT. OBSQ14.2 +030900 GO TO CCVS1-EXIT. OBSQ14.2 +031000 CLOSE-FILES. OBSQ14.2 +031100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBSQ14.2 +031200*P OPEN I-O RAW-DATA. OBSQ14.2 +031300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ14.2 +031400*P READ RAW-DATA INVALID KEY GO TO END-E-2. OBSQ14.2 +031500*P MOVE PASS-COUNTER TO C-OK. OBSQ14.2 +031600*P MOVE ERROR-HOLD TO C-ALL. OBSQ14.2 +031700*P MOVE ERROR-COUNTER TO C-FAIL. OBSQ14.2 +031800*P MOVE DELETE-CNT TO C-DELETED. OBSQ14.2 +031900*P MOVE INSPECT-COUNTER TO C-INSPECT. OBSQ14.2 +032000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. OBSQ14.2 +032100*PND-E-2. OBSQ14.2 +032200*P CLOSE RAW-DATA. OBSQ14.2 +032300 TERMINATE-CCVS. OBSQ14.2 +032400*S EXIT PROGRAM. OBSQ14.2 +032500*SERMINATE-CALL. OBSQ14.2 +032600 STOP RUN. OBSQ14.2 +032700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBSQ14.2 +032800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBSQ14.2 +032900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBSQ14.2 +033000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. OBSQ14.2 +033100 MOVE "****TEST DELETED****" TO RE-MARK. OBSQ14.2 +033200 PRINT-DETAIL. OBSQ14.2 +033300 IF REC-CT NOT EQUAL TO ZERO OBSQ14.2 +033400 MOVE "." TO PARDOT-X OBSQ14.2 +033500 MOVE REC-CT TO DOTVALUE. OBSQ14.2 +033600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBSQ14.2 +033700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBSQ14.2 +033800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBSQ14.2 +033900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBSQ14.2 +034000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBSQ14.2 +034100 MOVE SPACE TO CORRECT-X. OBSQ14.2 +034200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBSQ14.2 +034300 MOVE SPACE TO RE-MARK. OBSQ14.2 +034400 HEAD-ROUTINE. OBSQ14.2 +034500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +034600 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. OBSQ14.2 +034700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBSQ14.2 +034800 COLUMN-NAMES-ROUTINE. OBSQ14.2 +034900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +035000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +035200 END-ROUTINE. OBSQ14.2 +035300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBSQ14.2 +035400 END-RTN-EXIT. OBSQ14.2 +035500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +035600 END-ROUTINE-1. OBSQ14.2 +035700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBSQ14.2 +035800 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. OBSQ14.2 +035900 ADD PASS-COUNTER TO ERROR-HOLD. OBSQ14.2 +036000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBSQ14.2 +036100 MOVE PASS-COUNTER TO CCVS-E-4-1. OBSQ14.2 +036200 MOVE ERROR-HOLD TO CCVS-E-4-2. OBSQ14.2 +036300 MOVE CCVS-E-4 TO CCVS-E-2-2. OBSQ14.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBSQ14.2 +036500 END-ROUTINE-12. OBSQ14.2 +036600 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBSQ14.2 +036700 IF ERROR-COUNTER IS EQUAL TO ZERO OBSQ14.2 +036800 MOVE "NO " TO ERROR-TOTAL OBSQ14.2 +036900 ELSE OBSQ14.2 +037000 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBSQ14.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. OBSQ14.2 +037200 PERFORM WRITE-LINE. OBSQ14.2 +037300 END-ROUTINE-13. OBSQ14.2 +037400 IF DELETE-CNT IS EQUAL TO ZERO OBSQ14.2 +037500 MOVE "NO " TO ERROR-TOTAL ELSE OBSQ14.2 +037600 MOVE DELETE-CNT TO ERROR-TOTAL. OBSQ14.2 +037700 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBSQ14.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +037900 IF INSPECT-COUNTER EQUAL TO ZERO OBSQ14.2 +038000 MOVE "NO " TO ERROR-TOTAL OBSQ14.2 +038100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBSQ14.2 +038200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBSQ14.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +038400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ14.2 +038500 WRITE-LINE. OBSQ14.2 +038600 ADD 1 TO RECORD-COUNT. OBSQ14.2 +038700 IF RECORD-COUNT GREATER 50 OBSQ14.2 +038800 MOVE DUMMY-RECORD TO DUMMY-HOLD OBSQ14.2 +038900 MOVE SPACE TO DUMMY-RECORD OBSQ14.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBSQ14.2 +039100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBSQ14.2 +039200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBSQ14.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBSQ14.2 +039400 MOVE DUMMY-HOLD TO DUMMY-RECORD OBSQ14.2 +039500 MOVE ZERO TO RECORD-COUNT. OBSQ14.2 +039600 PERFORM WRT-LN. OBSQ14.2 +039700 WRT-LN. OBSQ14.2 +039800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBSQ14.2 +039900 MOVE SPACE TO DUMMY-RECORD. OBSQ14.2 +040000 BLANK-LINE-PRINT. OBSQ14.2 +040100 PERFORM WRT-LN. OBSQ14.2 +040200 FAIL-ROUTINE. OBSQ14.2 +040300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ14.2 +040400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ14.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBSQ14.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +040700 GO TO FAIL-ROUTINE-EX. OBSQ14.2 +040800 FAIL-ROUTINE-WRITE. OBSQ14.2 +040900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBSQ14.2 +041000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +041100 FAIL-ROUTINE-EX. EXIT. OBSQ14.2 +041200 BAIL-OUT. OBSQ14.2 +041300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBSQ14.2 +041400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBSQ14.2 +041500 BAIL-OUT-WRITE. OBSQ14.2 +041600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBSQ14.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ14.2 +041800 BAIL-OUT-EX. EXIT. OBSQ14.2 +041900 CCVS1-EXIT. OBSQ14.2 +042000 EXIT. OBSQ14.2 +042100 SECT-OBSQ1A-0001 SECTION. OBSQ14.2 +042200 SEQ-INIT-001. OBSQ14.2 +042300 MOVE "SQ-FS1" TO XFILE-NAME (1). OBSQ14.2 +042400 MOVE "R1-F-G" TO XRECORD-NAME (1). OBSQ14.2 +042500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). OBSQ14.2 +042600 MOVE 000120 TO XRECORD-LENGTH (1). OBSQ14.2 +042700 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ14.2 +042800 MOVE 0001 TO XBLOCK-SIZE (1). OBSQ14.2 +042900 MOVE 000750 TO RECORDS-IN-FILE (1). OBSQ14.2 +043000 MOVE "SQ" TO XFILE-ORGANIZATION (1). OBSQ14.2 +043100 MOVE "S" TO XLABEL-TYPE (1). OBSQ14.2 +043200 MOVE 000001 TO XRECORD-NUMBER (1). OBSQ14.2 +043300 OPEN OUTPUT SQ-FS1. OBSQ14.2 +043400 SEQ-TEST-001. OBSQ14.2 +043500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. OBSQ14.2 +043600 WRITE SQ-FS1R1-F-G-120. OBSQ14.2 +043700 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ14.2 +043800 GO TO SEQ-WRITE-001. OBSQ14.2 +043900 ADD 1 TO XRECORD-NUMBER (1). OBSQ14.2 +044000 GO TO SEQ-TEST-001. OBSQ14.2 +044100 SEQ-WRITE-001. OBSQ14.2 +044200 MOVE "CREATE FILE SQ-FS1" TO FEATURE. OBSQ14.2 +044300 MOVE "SEQ-TEST-001" TO PAR-NAME. OBSQ14.2 +044400 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ14.2 +044500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ14.2 +044600 PERFORM PRINT-DETAIL. OBSQ14.2 +044700 CLOSE SQ-FS1. OBSQ14.2 +044800* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS OBSQ14.2 +044900* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. OBSQ14.2 +045000 SEQ-INIT-002. OBSQ14.2 +045100 MOVE ZERO TO WRK-CS-09V00. OBSQ14.2 +045200* THIS TEST READS AND CHECKS THE FILE CREATED IN OBSQ14.2 +045300* SEQ-TEST-001. OBSQ14.2 +045400 OPEN INPUT SQ-FS1. OBSQ14.2 +045500 SEQ-TEST-002. OBSQ14.2 +045600 READ SQ-FS1 OBSQ14.2 +045700 AT END GO TO SEQ-TEST-002-1. OBSQ14.2 +045800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ14.2 +045900 ADD 1 TO WRK-CS-09V00. OBSQ14.2 +046000 IF WRK-CS-09V00 GREATER THAN 750 OBSQ14.2 +046100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ14.2 +046200 GO TO SEQ-FAIL-002. OBSQ14.2 +046300 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) OBSQ14.2 +046400 ADD 1 TO RECORDS-IN-ERROR OBSQ14.2 +046500 GO TO SEQ-TEST-002. OBSQ14.2 +046600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" OBSQ14.2 +046700 ADD 1 TO RECORDS-IN-ERROR OBSQ14.2 +046800 GO TO SEQ-TEST-002. OBSQ14.2 +046900 IF XLABEL-TYPE (1) NOT EQUAL TO "S" OBSQ14.2 +047000 ADD 1 TO RECORDS-IN-ERROR. OBSQ14.2 +047100 GO TO SEQ-TEST-002. OBSQ14.2 +047200 SEQ-TEST-002-1. OBSQ14.2 +047300 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ14.2 +047400 GO TO SEQ-PASS-002. OBSQ14.2 +047500 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. OBSQ14.2 +047600 SEQ-FAIL-002. OBSQ14.2 +047700 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. OBSQ14.2 +047800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ14.2 +047900 PERFORM FAIL. OBSQ14.2 +048000 GO TO SEQ-WRITE-002. OBSQ14.2 +048100 SEQ-PASS-002. OBSQ14.2 +048200 PERFORM PASS. OBSQ14.2 +048300 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ14.2 +048400 MOVE WRK-CS-09V00 TO CORRECT-18V0. OBSQ14.2 +048500 SEQ-WRITE-002. OBSQ14.2 +048600 MOVE "SEQ-TEST-002" TO PAR-NAME. OBSQ14.2 +048700 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. OBSQ14.2 +048800 PERFORM PRINT-DETAIL. OBSQ14.2 +048900 SEQ-CLOSE-002. OBSQ14.2 +049000 CLOSE SQ-FS1. OBSQ14.2 +049100 READ-INIT-01. OBSQ14.2 +049200 MOVE ZERO TO WRK-CS-09V00. OBSQ14.2 +049300 MOVE ZERO TO RECORDS-IN-ERROR. OBSQ14.2 +049400 OPEN INPUT SQ-FS1. OBSQ14.2 +049500* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED OBSQ14.2 +049600* IN THIS SERIES OF TESTS. OBSQ14.2 +049700 MOVE "LEV 1 READ STATEMENT" TO FEATURE. OBSQ14.2 +049800 MOVE "READ...RECORD AT END ..." TO RE-MARK. OBSQ14.2 +049900 MOVE "READ-TEST-01" TO PAR-NAME. OBSQ14.2 +050000 MOVE ZERO TO ERROR-FLAG. OBSQ14.2 +050100 READ-TEST-01. OBSQ14.2 +050200 READ SQ-FS1 RECORD AT END OBSQ14.2 +050300 MOVE "UNEXPECTED EOF" TO COMPUTED-A OBSQ14.2 +050400 MOVE 1 TO EOF-FLAG OBSQ14.2 +050500 GO TO READ-FAIL-01. OBSQ14.2 +050600 PERFORM RECORD-CHECK. OBSQ14.2 +050700 IF WRK-CS-09V00 EQUAL TO 200 OBSQ14.2 +050800 GO TO READ-TEST-01-1. OBSQ14.2 +050900 GO TO READ-TEST-01. OBSQ14.2 +051000 RECORD-CHECK. OBSQ14.2 +051100 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ14.2 +051200 ADD 1 TO WRK-CS-09V00. OBSQ14.2 +051300 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) OBSQ14.2 +051400 ADD 1 TO RECORDS-IN-ERROR OBSQ14.2 +051500 MOVE 1 TO ERROR-FLAG. OBSQ14.2 +051600 READ-TEST-01-1. OBSQ14.2 +051700 IF ERROR-FLAG EQUAL TO ZERO OBSQ14.2 +051800 GO TO READ-PASS-01. OBSQ14.2 +051900 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. OBSQ14.2 +052000 READ-FAIL-01. OBSQ14.2 +052100 PERFORM FAIL. OBSQ14.2 +052200 GO TO READ-WRITE-01. OBSQ14.2 +052300 READ-PASS-01. OBSQ14.2 +052400 PERFORM PASS. OBSQ14.2 +052500 READ-WRITE-01. OBSQ14.2 +052600 PERFORM PRINT-DETAIL. OBSQ14.2 +052700 READ-INIT-02. OBSQ14.2 +052800 IF EOF-FLAG EQUAL TO 1 OBSQ14.2 +052900 GO TO SEQ-EOF-003. OBSQ14.2 +053000 MOVE ZERO TO ERROR-FLAG. OBSQ14.2 +053100 MOVE "READ...AT END..." TO RE-MARK. OBSQ14.2 +053200 MOVE "READ-TEST-02" TO PAR-NAME. OBSQ14.2 +053300 READ-TEST-02. OBSQ14.2 +053400 READ SQ-FS1 AT END OBSQ14.2 +053500 MOVE "UNEXPECTED EOF" TO COMPUTED-A OBSQ14.2 +053600 MOVE 1 TO EOF-FLAG OBSQ14.2 +053700 GO TO READ-FAIL-02. OBSQ14.2 +053800 PERFORM RECORD-CHECK. OBSQ14.2 +053900 IF WRK-CS-09V00 EQUAL TO 400 OBSQ14.2 +054000 GO TO READ-TEST-02-1. OBSQ14.2 +054100 GO TO READ-TEST-02. OBSQ14.2 +054200 READ-TEST-02-1. OBSQ14.2 +054300 IF ERROR-FLAG EQUAL TO ZERO OBSQ14.2 +054400 GO TO READ-PASS-02. OBSQ14.2 +054500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. OBSQ14.2 +054600 READ-FAIL-02. OBSQ14.2 +054700 PERFORM FAIL. OBSQ14.2 +054800 GO TO READ-WRITE-02. OBSQ14.2 +054900 READ-PASS-02. OBSQ14.2 +055000 PERFORM PASS. OBSQ14.2 +055100 READ-WRITE-02. OBSQ14.2 +055200 PERFORM PRINT-DETAIL. OBSQ14.2 +055300 READ-INIT-03. OBSQ14.2 +055400 IF EOF-FLAG EQUAL TO 1 OBSQ14.2 +055500 GO TO SEQ-EOF-003. OBSQ14.2 +055600 MOVE ZERO TO ERROR-FLAG. OBSQ14.2 +055700 MOVE "READ...RECORD END..." TO RE-MARK. OBSQ14.2 +055800 MOVE "READ-TEST-03" TO PAR-NAME. OBSQ14.2 +055900 READ-TEST-03. OBSQ14.2 +056000 READ SQ-FS1 RECORD END OBSQ14.2 +056100 MOVE "UNEXPECTED EOF" TO COMPUTED-A OBSQ14.2 +056200 MOVE 1 TO EOF-FLAG OBSQ14.2 +056300 GO TO READ-FAIL-03. OBSQ14.2 +056400 PERFORM RECORD-CHECK. OBSQ14.2 +056500 IF WRK-CS-09V00 EQUAL TO 600 OBSQ14.2 +056600 GO TO READ-TEST-03-1. OBSQ14.2 +056700 GO TO READ-TEST-03. OBSQ14.2 +056800 READ-TEST-03-1. OBSQ14.2 +056900 IF ERROR-FLAG EQUAL TO ZERO OBSQ14.2 +057000 GO TO READ-PASS-03. OBSQ14.2 +057100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. OBSQ14.2 +057200 READ-FAIL-03. OBSQ14.2 +057300 PERFORM FAIL. OBSQ14.2 +057400 GO TO READ-WRITE-03. OBSQ14.2 +057500 READ-PASS-03. OBSQ14.2 +057600 PERFORM PASS. OBSQ14.2 +057700 READ-WRITE-03. OBSQ14.2 +057800 PERFORM PRINT-DETAIL. OBSQ14.2 +057900 READ-INIT-04. OBSQ14.2 +058000 IF EOF-FLAG EQUAL TO 1 OBSQ14.2 +058100 GO TO SEQ-EOF-003. OBSQ14.2 +058200 MOVE ZERO TO ERROR-FLAG. OBSQ14.2 +058300 MOVE "READ...END..." TO RE-MARK. OBSQ14.2 +058400 MOVE "READ-TEST-04" TO PAR-NAME. OBSQ14.2 +058500 READ-TEST-04. OBSQ14.2 +058600 READ SQ-FS1 END GO TO READ-TEST-04-1. OBSQ14.2 +058700 PERFORM RECORD-CHECK. OBSQ14.2 +058800 IF WRK-CS-09V00 GREATER THAN 750 OBSQ14.2 +058900 GO TO READ-TEST-04-1. OBSQ14.2 +059000 GO TO READ-TEST-04. OBSQ14.2 +059100 READ-TEST-04-1. OBSQ14.2 +059200 IF ERROR-FLAG EQUAL TO ZERO OBSQ14.2 +059300 GO TO READ-PASS-04. OBSQ14.2 +059400 READ-FAIL-04. OBSQ14.2 +059500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. OBSQ14.2 +059600 PERFORM FAIL. OBSQ14.2 +059700 GO TO READ-WRITE-04. OBSQ14.2 +059800 READ-PASS-04. OBSQ14.2 +059900 PERFORM PASS. OBSQ14.2 +060000 READ-WRITE-04. OBSQ14.2 +060100 PERFORM PRINT-DETAIL. OBSQ14.2 +060200 SEQ-TEST-003. OBSQ14.2 +060300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO OBSQ14.2 +060400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A OBSQ14.2 +060500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 OBSQ14.2 +060600 GO TO SEQ-FAIL-003. OBSQ14.2 +060700 IF WRK-CS-09V00 GREATER THAN 750 OBSQ14.2 +060800 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ14.2 +060900 GO TO SEQ-FAIL-003. OBSQ14.2 +061000 SEQ-PASS-003. OBSQ14.2 +061100 PERFORM PASS. OBSQ14.2 +061200 GO TO SEQ-WRITE-003. OBSQ14.2 +061300 SEQ-EOF-003. OBSQ14.2 +061400 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. OBSQ14.2 +061500 MOVE "RECORDS READ =" TO COMPUTED-A. OBSQ14.2 +061600 MOVE WRK-CS-09V00 TO CORRECT-18V0. OBSQ14.2 +061700 SEQ-FAIL-003. OBSQ14.2 +061800 PERFORM FAIL. OBSQ14.2 +061900 SEQ-WRITE-003. OBSQ14.2 +062000 MOVE "SEQ-TEST-003" TO PAR-NAME. OBSQ14.2 +062100 MOVE "READ FILE SQ-FS1" TO FEATURE. OBSQ14.2 +062200 PERFORM PRINT-DETAIL. OBSQ14.2 +062300 SEQ-CLOSE-003. OBSQ14.2 +062400 CLOSE SQ-FS1. OBSQ14.2 +062500 TERMINATE-ROUTINE. OBSQ14.2 +062600 EXIT. OBSQ14.2 +062700 CCVS-EXIT SECTION. OBSQ14.2 +062800 CCVS-999999. OBSQ14.2 +062900 GO TO CLOSE-FILES. OBSQ14.2 diff --git a/tests/cobol85/OB/OBSQ3A.CBL b/tests/cobol85/OB/OBSQ3A.CBL new file mode 100755 index 00000000..6d3874a6 --- /dev/null +++ b/tests/cobol85/OB/OBSQ3A.CBL @@ -0,0 +1,647 @@ +000100 IDENTIFICATION DIVISION. OBSQ34.2 +000200 PROGRAM-ID. OBSQ34.2 +000300 OBSQ3A. OBSQ34.2 +000400**************************************************************** OBSQ34.2 +000500* * OBSQ34.2 +000600* VALIDATION FOR:- * OBSQ34.2 +000700* " HIGH ". OBSQ34.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * OBSQ34.2 +000900* * OBSQ34.2 +001000* CREATION DATE / VALIDATION DATE * OBSQ34.2 +001100* "4.2 ". OBSQ34.2 +001200* * OBSQ34.2 +001300* THIS ROUTINE TESTS THE USE OF MULTIPLE FILE CLAUSE OBSQ34.2 +001400* OF THE I-O-CONTROL PARAGRAPH. TWO TAPES ARE CREATED OBSQ34.2 +001500* CONTAINING 4 FILES EACH. TAPE ONE IS CREATED WITHOUT THE OBSQ34.2 +001600* USE OF THE NO REWIND OPTION WITH THE OPEN AND CLOSE OBSQ34.2 +001700* STATEMENTS. IT IS THEN PASSED ON TO OBSQ4A AND OBSQ5A WHERE ITOBSQ34.2 +001800* IS READ AND VALIDATED. TAPE TWO IS CREATED USING THE OBSQ34.2 +001900* POSITION PHRASE OF THE MULTIPLE FILE CLAUSE AND WITH THE USE OBSQ34.2 +002000* OF THE NO REWIND OPTION WITH THE OPEN AND CLOSE STATEMENT. OBSQ34.2 +002100* TAPE TWO IS THEN PASSED ON TO OBSQ5A WHERE IT IS READ AND OBSQ34.2 +002200* VALIDATED. OBSQ34.2 +002300 ENVIRONMENT DIVISION. OBSQ34.2 +002400 CONFIGURATION SECTION. OBSQ34.2 +002500 SOURCE-COMPUTER. OBSQ34.2 +002600 Linux. OBSQ34.2 +002700 OBJECT-COMPUTER. OBSQ34.2 +002800 Linux. OBSQ34.2 +002900 INPUT-OUTPUT SECTION. OBSQ34.2 +003000 FILE-CONTROL. OBSQ34.2 +003100*P SELECT RAW-DATA ASSIGN TO OBSQ34.2 +003200*P "XXXXX062" OBSQ34.2 +003300*P ORGANIZATION IS INDEXED OBSQ34.2 +003400*P ACCESS MODE IS RANDOM OBSQ34.2 +003500*P RECORD KEY IS RAW-DATA-KEY. OBSQ34.2 +003600 SELECT PRINT-FILE ASSIGN TO OBSQ34.2 +003700 "report.log". OBSQ34.2 +003800 SELECT SQ-FS1 ASSIGN TO OBSQ34.2 +003900 "XXXXX004" OBSQ34.2 +004000 ORGANIZATION IS SEQUENTIAL. OBSQ34.2 +004100 SELECT SQ-FS2 ASSIGN TO OBSQ34.2 +004200 "XXXXX008" OBSQ34.2 +004300 ACCESS MODE IS SEQUENTIAL. OBSQ34.2 +004400 SELECT SQ-FS3 ASSIGN OBSQ34.2 +004500 "XXXXX009" OBSQ34.2 +004600 ORGANIZATION IS SEQUENTIAL. OBSQ34.2 +004700 SELECT SQ-FS4 ASSIGN OBSQ34.2 +004800 "XXXXX010" OBSQ34.2 +004900 ACCESS MODE SEQUENTIAL. OBSQ34.2 +005000 SELECT SQ-FS5 ASSIGN OBSQ34.2 +005100 "XXXXX005". OBSQ34.2 +005200 SELECT SQ-FS6 ASSIGN OBSQ34.2 +005300 "XXXXX011" OBSQ34.2 +005400 ORGANIZATION IS SEQUENTIAL. OBSQ34.2 +005500 SELECT SQ-FS7 ASSIGN TO OBSQ34.2 +005600 "XXXXX012" OBSQ34.2 +005700 ORGANIZATION IS SEQUENTIAL OBSQ34.2 +005800 ACCESS MODE IS SEQUENTIAL. OBSQ34.2 +005900 SELECT SQ-FS8 ASSIGN TO OBSQ34.2 +006000 "XXXXX013" OBSQ34.2 +006100 ACCESS MODE IS SEQUENTIAL. OBSQ34.2 +006200 I-O-CONTROL. OBSQ34.2 +006300 MULTIPLE FILE TAPE CONTAINS SQ-FS1, OBSQ34.2 +006400 SQ-FS2, OBSQ34.2 +006500 SQ-FS3, OBSQ34.2 +006600 SQ-FS4; OBSQ34.2 +006700 MULTIPLE FILE TAPE SQ-FS8 POSITION 4, OBSQ34.2 +006800 SQ-FS7 POSITION 3, OBSQ34.2 +006900 SQ-FS6 POSITION 2, OBSQ34.2 +007000 SQ-FS5 POSITION 1. OBSQ34.2 +007100 DATA DIVISION. OBSQ34.2 +007200 FILE SECTION. OBSQ34.2 +007300*P OBSQ34.2 +007400*PD RAW-DATA. OBSQ34.2 +007500*P OBSQ34.2 +007600*P1 RAW-DATA-SATZ. OBSQ34.2 +007700*P 05 RAW-DATA-KEY PIC X(6). OBSQ34.2 +007800*P 05 C-DATE PIC 9(6). OBSQ34.2 +007900*P 05 C-TIME PIC 9(8). OBSQ34.2 +008000*P 05 C-NO-OF-TESTS PIC 99. OBSQ34.2 +008100*P 05 C-OK PIC 999. OBSQ34.2 +008200*P 05 C-ALL PIC 999. OBSQ34.2 +008300*P 05 C-FAIL PIC 999. OBSQ34.2 +008400*P 05 C-DELETED PIC 999. OBSQ34.2 +008500*P 05 C-INSPECT PIC 999. OBSQ34.2 +008600*P 05 C-NOTE PIC X(13). OBSQ34.2 +008700*P 05 C-INDENT PIC X. OBSQ34.2 +008800*P 05 C-ABORT PIC X(8). OBSQ34.2 +008900 FD PRINT-FILE. OBSQ34.2 +009000 01 PRINT-REC PICTURE X(120). OBSQ34.2 +009100 01 DUMMY-RECORD PICTURE X(120). OBSQ34.2 +009200 FD SQ-FS1 OBSQ34.2 +009300 LABEL RECORD IS STANDARD OBSQ34.2 +009400 . OBSQ34.2 +009500 01 SQ-FS1R1-F-G-120 PIC X(120). OBSQ34.2 +009600 FD SQ-FS2 OBSQ34.2 +009700 LABEL RECORD STANDARD OBSQ34.2 +009800 BLOCK CONTAINS 5 RECORDS. OBSQ34.2 +009900 01 SQ-FS2R1-F-G-120 PIC X(120). OBSQ34.2 +010000 FD SQ-FS3 OBSQ34.2 +010100 LABEL RECORD STANDARD OBSQ34.2 +010200 BLOCK CONTAINS 1200 CHARACTERS OBSQ34.2 +010300 RECORD CONTAINS 120 CHARACTERS. OBSQ34.2 +010400 01 SQ-FS3R1-F-G-120 PIC X(120). OBSQ34.2 +010500 FD SQ-FS4 OBSQ34.2 +010600 LABEL RECORDS STANDARD OBSQ34.2 +010700 BLOCK 10 RECORDS OBSQ34.2 +010800 RECORD 120 CHARACTERS. OBSQ34.2 +010900 01 SQ-FS4R1-F-G-120 PIC X(120). OBSQ34.2 +011000 FD SQ-FS5 OBSQ34.2 +011100 LABEL RECORDS ARE STANDARD OBSQ34.2 +011200 BLOCK CONTAINS 5 RECORDS. OBSQ34.2 +011300 01 SQ-FS5R1-F-G-120 PIC X(120). OBSQ34.2 +011400 FD SQ-FS6 OBSQ34.2 +011500 LABEL RECORD IS STANDARD OBSQ34.2 +011600 BLOCK CONTAINS 10 RECORDS. OBSQ34.2 +011700 01 SQ-FS6R1-F-G-120 PIC X(120). OBSQ34.2 +011800 FD SQ-FS7 OBSQ34.2 +011900 LABEL RECORD STANDARD OBSQ34.2 +012000 BLOCK CONTAINS 2400 CHARACTERS. OBSQ34.2 +012100 01 SQ-FS7R1-F-G-120 PIC X(120). OBSQ34.2 +012200 FD SQ-FS8 OBSQ34.2 +012300 LABEL RECORDS ARE STANDARD OBSQ34.2 +012400 BLOCK 120 CHARACTERS OBSQ34.2 +012500 RECORD 120. OBSQ34.2 +012600 01 SQ-FS8R1-F-G-120 PIC X(120). OBSQ34.2 +012700 WORKING-STORAGE SECTION. OBSQ34.2 +012800 01 COUNT-OF-RECS PIC 9999. OBSQ34.2 +012900 01 FILE-RECORD-INFORMATION-REC. OBSQ34.2 +013000 03 FILE-RECORD-INFO-SKELETON. OBSQ34.2 +013100 05 FILLER PICTURE X(48) VALUE OBSQ34.2 +013200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBSQ34.2 +013300 05 FILLER PICTURE X(46) VALUE OBSQ34.2 +013400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBSQ34.2 +013500 05 FILLER PICTURE X(26) VALUE OBSQ34.2 +013600 ",LFIL=000000,ORG= ,LBLR= ". OBSQ34.2 +013700 05 FILLER PICTURE X(37) VALUE OBSQ34.2 +013800 ",RECKEY= ". OBSQ34.2 +013900 05 FILLER PICTURE X(38) VALUE OBSQ34.2 +014000 ",ALTKEY1= ". OBSQ34.2 +014100 05 FILLER PICTURE X(38) VALUE OBSQ34.2 +014200 ",ALTKEY2= ". OBSQ34.2 +014300 05 FILLER PICTURE X(7) VALUE SPACE.OBSQ34.2 +014400 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBSQ34.2 +014500 05 FILE-RECORD-INFO-P1-120. OBSQ34.2 +014600 07 FILLER PIC X(5). OBSQ34.2 +014700 07 XFILE-NAME PIC X(6). OBSQ34.2 +014800 07 FILLER PIC X(8). OBSQ34.2 +014900 07 XRECORD-NAME PIC X(6). OBSQ34.2 +015000 07 FILLER PIC X(1). OBSQ34.2 +015100 07 REELUNIT-NUMBER PIC 9(1). OBSQ34.2 +015200 07 FILLER PIC X(7). OBSQ34.2 +015300 07 XRECORD-NUMBER PIC 9(6). OBSQ34.2 +015400 07 FILLER PIC X(6). OBSQ34.2 +015500 07 UPDATE-NUMBER PIC 9(2). OBSQ34.2 +015600 07 FILLER PIC X(5). OBSQ34.2 +015700 07 ODO-NUMBER PIC 9(4). OBSQ34.2 +015800 07 FILLER PIC X(5). OBSQ34.2 +015900 07 XPROGRAM-NAME PIC X(5). OBSQ34.2 +016000 07 FILLER PIC X(7). OBSQ34.2 +016100 07 XRECORD-LENGTH PIC 9(6). OBSQ34.2 +016200 07 FILLER PIC X(7). OBSQ34.2 +016300 07 CHARS-OR-RECORDS PIC X(2). OBSQ34.2 +016400 07 FILLER PIC X(1). OBSQ34.2 +016500 07 XBLOCK-SIZE PIC 9(4). OBSQ34.2 +016600 07 FILLER PIC X(6). OBSQ34.2 +016700 07 RECORDS-IN-FILE PIC 9(6). OBSQ34.2 +016800 07 FILLER PIC X(5). OBSQ34.2 +016900 07 XFILE-ORGANIZATION PIC X(2). OBSQ34.2 +017000 07 FILLER PIC X(6). OBSQ34.2 +017100 07 XLABEL-TYPE PIC X(1). OBSQ34.2 +017200 05 FILE-RECORD-INFO-P121-240. OBSQ34.2 +017300 07 FILLER PIC X(8). OBSQ34.2 +017400 07 XRECORD-KEY PIC X(29). OBSQ34.2 +017500 07 FILLER PIC X(9). OBSQ34.2 +017600 07 ALTERNATE-KEY1 PIC X(29). OBSQ34.2 +017700 07 FILLER PIC X(9). OBSQ34.2 +017800 07 ALTERNATE-KEY2 PIC X(29). OBSQ34.2 +017900 07 FILLER PIC X(7). OBSQ34.2 +018000 01 TEST-RESULTS. OBSQ34.2 +018100 02 FILLER PICTURE X VALUE SPACE. OBSQ34.2 +018200 02 FEATURE PICTURE X(20) VALUE SPACE. OBSQ34.2 +018300 02 FILLER PICTURE X VALUE SPACE. OBSQ34.2 +018400 02 P-OR-F PICTURE X(5) VALUE SPACE. OBSQ34.2 +018500 02 FILLER PICTURE X VALUE SPACE. OBSQ34.2 +018600 02 PAR-NAME. OBSQ34.2 +018700 03 FILLER PICTURE X(12) VALUE SPACE. OBSQ34.2 +018800 03 PARDOT-X PICTURE X VALUE SPACE. OBSQ34.2 +018900 03 DOTVALUE PICTURE 99 VALUE ZERO. OBSQ34.2 +019000 03 FILLER PIC X(5) VALUE SPACE. OBSQ34.2 +019100 02 FILLER PIC X(10) VALUE SPACE. OBSQ34.2 +019200 02 RE-MARK PIC X(61). OBSQ34.2 +019300 01 TEST-COMPUTED. OBSQ34.2 +019400 02 FILLER PIC X(30) VALUE SPACE. OBSQ34.2 +019500 02 FILLER PIC X(17) VALUE " COMPUTED=". OBSQ34.2 +019600 02 COMPUTED-X. OBSQ34.2 +019700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. OBSQ34.2 +019800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). OBSQ34.2 +019900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). OBSQ34.2 +020000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). OBSQ34.2 +020100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). OBSQ34.2 +020200 03 CM-18V0 REDEFINES COMPUTED-A. OBSQ34.2 +020300 04 COMPUTED-18V0 PICTURE -9(18). OBSQ34.2 +020400 04 FILLER PICTURE X. OBSQ34.2 +020500 03 FILLER PIC X(50) VALUE SPACE. OBSQ34.2 +020600 01 TEST-CORRECT. OBSQ34.2 +020700 02 FILLER PIC X(30) VALUE SPACE. OBSQ34.2 +020800 02 FILLER PIC X(17) VALUE " CORRECT =". OBSQ34.2 +020900 02 CORRECT-X. OBSQ34.2 +021000 03 CORRECT-A PICTURE X(20) VALUE SPACE. OBSQ34.2 +021100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). OBSQ34.2 +021200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). OBSQ34.2 +021300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). OBSQ34.2 +021400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). OBSQ34.2 +021500 03 CR-18V0 REDEFINES CORRECT-A. OBSQ34.2 +021600 04 CORRECT-18V0 PICTURE -9(18). OBSQ34.2 +021700 04 FILLER PICTURE X. OBSQ34.2 +021800 03 FILLER PIC X(50) VALUE SPACE. OBSQ34.2 +021900 01 CCVS-C-1. OBSQ34.2 +022000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PAOBSQ34.2 +022100- "SS PARAGRAPH-NAME OBSQ34.2 +022200- " REMARKS". OBSQ34.2 +022300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. OBSQ34.2 +022400 01 CCVS-C-2. OBSQ34.2 +022500 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ34.2 +022600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". OBSQ34.2 +022700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. OBSQ34.2 +022800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". OBSQ34.2 +022900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. OBSQ34.2 +023000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. OBSQ34.2 +023100 01 REC-CT PICTURE 99 VALUE ZERO. OBSQ34.2 +023200 01 DELETE-CNT PICTURE 999 VALUE ZERO. OBSQ34.2 +023300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. OBSQ34.2 +023400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBSQ34.2 +023500 01 PASS-COUNTER PIC 999 VALUE ZERO. OBSQ34.2 +023600 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBSQ34.2 +023700 01 ERROR-HOLD PIC 999 VALUE ZERO. OBSQ34.2 +023800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBSQ34.2 +023900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBSQ34.2 +024000 01 CCVS-H-1. OBSQ34.2 +024100 02 FILLER PICTURE X(27) VALUE SPACE. OBSQ34.2 +024200 02 FILLER PICTURE X(67) VALUE OBSQ34.2 +024300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION OBSQ34.2 +024400- " SYSTEM". OBSQ34.2 +024500 02 FILLER PICTURE X(26) VALUE SPACE. OBSQ34.2 +024600 01 CCVS-H-2. OBSQ34.2 +024700 02 FILLER PICTURE X(52) VALUE IS OBSQ34.2 +024800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". OBSQ34.2 +024900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". OBSQ34.2 +025000 02 TEST-ID PICTURE IS X(9). OBSQ34.2 +025100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. OBSQ34.2 +025200 01 CCVS-H-3. OBSQ34.2 +025300 02 FILLER PICTURE X(34) VALUE OBSQ34.2 +025400 " FOR OFFICIAL USE ONLY ". OBSQ34.2 +025500 02 FILLER PICTURE X(58) VALUE OBSQ34.2 +025600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBSQ34.2 +025700 02 FILLER PICTURE X(28) VALUE OBSQ34.2 +025800 " COPYRIGHT 1985 ". OBSQ34.2 +025900 01 CCVS-E-1. OBSQ34.2 +026000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. OBSQ34.2 +026100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". OBSQ34.2 +026200 02 ID-AGAIN PICTURE IS X(9). OBSQ34.2 +026300 02 FILLER PICTURE X(45) VALUE IS OBSQ34.2 +026400 " NTIS DISTRIBUTION COBOL 85". OBSQ34.2 +026500 01 CCVS-E-2. OBSQ34.2 +026600 02 FILLER PICTURE X(31) VALUE OBSQ34.2 +026700 SPACE. OBSQ34.2 +026800 02 FILLER PICTURE X(21) VALUE SPACE. OBSQ34.2 +026900 02 CCVS-E-2-2. OBSQ34.2 +027000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. OBSQ34.2 +027100 03 FILLER PICTURE IS X VALUE IS SPACE. OBSQ34.2 +027200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". OBSQ34.2 +027300 01 CCVS-E-3. OBSQ34.2 +027400 02 FILLER PICTURE X(22) VALUE OBSQ34.2 +027500 " FOR OFFICIAL USE ONLY". OBSQ34.2 +027600 02 FILLER PICTURE X(12) VALUE SPACE. OBSQ34.2 +027700 02 FILLER PICTURE X(58) VALUE OBSQ34.2 +027800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBSQ34.2 +027900 02 FILLER PICTURE X(13) VALUE SPACE. OBSQ34.2 +028000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". OBSQ34.2 +028100 01 CCVS-E-4. OBSQ34.2 +028200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBSQ34.2 +028300 02 FILLER PIC XXXX VALUE " OF ". OBSQ34.2 +028400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBSQ34.2 +028500 02 FILLER PIC X(40) VALUE OBSQ34.2 +028600 " TESTS WERE EXECUTED SUCCESSFULLY". OBSQ34.2 +028700 01 XXINFO. OBSQ34.2 +028800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". OBSQ34.2 +028900 02 INFO-TEXT. OBSQ34.2 +029000 04 FILLER PIC X(20) VALUE SPACE. OBSQ34.2 +029100 04 XXCOMPUTED PIC X(20). OBSQ34.2 +029200 04 FILLER PIC X(5) VALUE SPACE. OBSQ34.2 +029300 04 XXCORRECT PIC X(20). OBSQ34.2 +029400 01 HYPHEN-LINE. OBSQ34.2 +029500 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ34.2 +029600 02 FILLER PICTURE IS X(65) VALUE IS "************************OBSQ34.2 +029700- "*****************************************". OBSQ34.2 +029800 02 FILLER PICTURE IS X(54) VALUE IS "************************OBSQ34.2 +029900- "******************************". OBSQ34.2 +030000 01 CCVS-PGM-ID PIC X(6) VALUE OBSQ34.2 +030100 "OBSQ3A". OBSQ34.2 +030200 PROCEDURE DIVISION. OBSQ34.2 +030300 CCVS1 SECTION. OBSQ34.2 +030400 OPEN-FILES. OBSQ34.2 +030500*P OPEN I-O RAW-DATA. OBSQ34.2 +030600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ34.2 +030700*P READ RAW-DATA INVALID KEY GO TO END-E-1. OBSQ34.2 +030800*P MOVE "ABORTED " TO C-ABORT. OBSQ34.2 +030900*P ADD 1 TO C-NO-OF-TESTS. OBSQ34.2 +031000*P ACCEPT C-DATE FROM DATE. OBSQ34.2 +031100*P ACCEPT C-TIME FROM TIME. OBSQ34.2 +031200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. OBSQ34.2 +031300*PND-E-1. OBSQ34.2 +031400*P CLOSE RAW-DATA. OBSQ34.2 +031500 OPEN OUTPUT PRINT-FILE. OBSQ34.2 +031600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBSQ34.2 +031700 MOVE SPACE TO TEST-RESULTS. OBSQ34.2 +031800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBSQ34.2 +031900 MOVE ZERO TO REC-SKL-SUB. OBSQ34.2 +032000 PERFORM CCVS-INIT-FILE 9 TIMES. OBSQ34.2 +032100 CCVS-INIT-FILE. OBSQ34.2 +032200 ADD 1 TO REC-SKL-SUB. OBSQ34.2 +032300 MOVE FILE-RECORD-INFO-SKELETON TO OBSQ34.2 +032400 FILE-RECORD-INFO (REC-SKL-SUB). OBSQ34.2 +032500 CCVS-INIT-EXIT. OBSQ34.2 +032600 GO TO CCVS1-EXIT. OBSQ34.2 +032700 CLOSE-FILES. OBSQ34.2 +032800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBSQ34.2 +032900*P OPEN I-O RAW-DATA. OBSQ34.2 +033000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ34.2 +033100*P READ RAW-DATA INVALID KEY GO TO END-E-2. OBSQ34.2 +033200*P MOVE "OK. " TO C-ABORT. OBSQ34.2 +033300*P MOVE PASS-COUNTER TO C-OK. OBSQ34.2 +033400*P MOVE ERROR-HOLD TO C-ALL. OBSQ34.2 +033500*P MOVE ERROR-COUNTER TO C-FAIL. OBSQ34.2 +033600*P MOVE DELETE-CNT TO C-DELETED. OBSQ34.2 +033700*P MOVE INSPECT-COUNTER TO C-INSPECT. OBSQ34.2 +033800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. OBSQ34.2 +033900*PND-E-2. OBSQ34.2 +034000*P CLOSE RAW-DATA. OBSQ34.2 +034100 TERMINATE-CCVS. OBSQ34.2 +034200*S EXIT PROGRAM. OBSQ34.2 +034300*SERMINATE-CALL. OBSQ34.2 +034400 STOP RUN. OBSQ34.2 +034500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBSQ34.2 +034600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBSQ34.2 +034700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBSQ34.2 +034800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. OBSQ34.2 +034900 MOVE "****TEST DELETED****" TO RE-MARK. OBSQ34.2 +035000 PRINT-DETAIL. OBSQ34.2 +035100 IF REC-CT NOT EQUAL TO ZERO OBSQ34.2 +035200 MOVE "." TO PARDOT-X OBSQ34.2 +035300 MOVE REC-CT TO DOTVALUE. OBSQ34.2 +035400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBSQ34.2 +035500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBSQ34.2 +035600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBSQ34.2 +035700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBSQ34.2 +035800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBSQ34.2 +035900 MOVE SPACE TO CORRECT-X. OBSQ34.2 +036000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBSQ34.2 +036100 MOVE SPACE TO RE-MARK. OBSQ34.2 +036200 HEAD-ROUTINE. OBSQ34.2 +036300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +036400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. OBSQ34.2 +036500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBSQ34.2 +036600 COLUMN-NAMES-ROUTINE. OBSQ34.2 +036700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +036800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +036900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +037000 END-ROUTINE. OBSQ34.2 +037100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBSQ34.2 +037200 END-RTN-EXIT. OBSQ34.2 +037300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +037400 END-ROUTINE-1. OBSQ34.2 +037500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBSQ34.2 +037600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. OBSQ34.2 +037700 ADD PASS-COUNTER TO ERROR-HOLD. OBSQ34.2 +037800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBSQ34.2 +037900 MOVE PASS-COUNTER TO CCVS-E-4-1. OBSQ34.2 +038000 MOVE ERROR-HOLD TO CCVS-E-4-2. OBSQ34.2 +038100 MOVE CCVS-E-4 TO CCVS-E-2-2. OBSQ34.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBSQ34.2 +038300 END-ROUTINE-12. OBSQ34.2 +038400 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBSQ34.2 +038500 IF ERROR-COUNTER IS EQUAL TO ZERO OBSQ34.2 +038600 MOVE "NO " TO ERROR-TOTAL OBSQ34.2 +038700 ELSE OBSQ34.2 +038800 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBSQ34.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. OBSQ34.2 +039000 PERFORM WRITE-LINE. OBSQ34.2 +039100 END-ROUTINE-13. OBSQ34.2 +039200 IF DELETE-CNT IS EQUAL TO ZERO OBSQ34.2 +039300 MOVE "NO " TO ERROR-TOTAL ELSE OBSQ34.2 +039400 MOVE DELETE-CNT TO ERROR-TOTAL. OBSQ34.2 +039500 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBSQ34.2 +039600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +039700 IF INSPECT-COUNTER EQUAL TO ZERO OBSQ34.2 +039800 MOVE "NO " TO ERROR-TOTAL OBSQ34.2 +039900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBSQ34.2 +040000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBSQ34.2 +040100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +040200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ34.2 +040300 WRITE-LINE. OBSQ34.2 +040400 ADD 1 TO RECORD-COUNT. OBSQ34.2 +040500 IF RECORD-COUNT GREATER 50 OBSQ34.2 +040600 MOVE DUMMY-RECORD TO DUMMY-HOLD OBSQ34.2 +040700 MOVE SPACE TO DUMMY-RECORD OBSQ34.2 +040800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBSQ34.2 +040900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBSQ34.2 +041000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBSQ34.2 +041100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBSQ34.2 +041200 MOVE DUMMY-HOLD TO DUMMY-RECORD OBSQ34.2 +041300 MOVE ZERO TO RECORD-COUNT. OBSQ34.2 +041400 PERFORM WRT-LN. OBSQ34.2 +041500 WRT-LN. OBSQ34.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBSQ34.2 +041700 MOVE SPACE TO DUMMY-RECORD. OBSQ34.2 +041800 BLANK-LINE-PRINT. OBSQ34.2 +041900 PERFORM WRT-LN. OBSQ34.2 +042000 FAIL-ROUTINE. OBSQ34.2 +042100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ34.2 +042200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ34.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBSQ34.2 +042400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +042500 GO TO FAIL-ROUTINE-EX. OBSQ34.2 +042600 FAIL-ROUTINE-WRITE. OBSQ34.2 +042700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBSQ34.2 +042800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +042900 FAIL-ROUTINE-EX. EXIT. OBSQ34.2 +043000 BAIL-OUT. OBSQ34.2 +043100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBSQ34.2 +043200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBSQ34.2 +043300 BAIL-OUT-WRITE. OBSQ34.2 +043400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBSQ34.2 +043500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ34.2 +043600 BAIL-OUT-EX. EXIT. OBSQ34.2 +043700 CCVS1-EXIT. OBSQ34.2 +043800 EXIT. OBSQ34.2 +043900 SECT-OBSQ3A-0001 SECTION. OBSQ34.2 +044000 SEQ-INIT-001. OBSQ34.2 +044100* THIS TEST CREATES FILE SQ-FS1 AS THE FIRST FILE OBSQ34.2 +044200* ON MULTIPLE FILE TAPE ONE. THIS FILE IS CLOSED OBSQ34.2 +044300* WITH NO REWIND. OBSQ34.2 +044400 PERFORM BUILD-RECORD. OBSQ34.2 +044500 MOVE "SQ-FS1" TO XFILE-NAME (1). OBSQ34.2 +044600 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +044700 MOVE 1 TO XBLOCK-SIZE (1). OBSQ34.2 +044800 OPEN OUTPUT SQ-FS1. OBSQ34.2 +044900 SEQ-TEST-001. OBSQ34.2 +045000 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. OBSQ34.2 +045100 WRITE SQ-FS1R1-F-G-120. OBSQ34.2 +045200 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +045300 GO TO SEQ-WRITE-001. OBSQ34.2 +045400 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +045500 GO TO SEQ-TEST-001. OBSQ34.2 +045600 SEQ-WRITE-001. OBSQ34.2 +045700 MOVE "CREATE FILE SQ-FS1" TO FEATURE. OBSQ34.2 +045800 MOVE "SEQ-TEST-001" TO PAR-NAME. OBSQ34.2 +045900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +046000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +046100 PERFORM PRINT-DETAIL. OBSQ34.2 +046200 SEQ-CLOSE-001. OBSQ34.2 +046300 CLOSE SQ-FS1 WITH NO REWIND. OBSQ34.2 +046400 SEQ-INIT-002. OBSQ34.2 +046500* THIS TEST CREATES FILE SQ-FS2 AS THE SECOND FILE OBSQ34.2 +046600* ON MULTIPLE FILE TAPE ONE. THIS FILE IS OPENED OBSQ34.2 +046700* AND CLOSED WITH NO REWIND. OBSQ34.2 +046800 PERFORM BUILD-RECORD. OBSQ34.2 +046900 MOVE "SQ-FS2" TO XFILE-NAME (1). OBSQ34.2 +047000 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +047100 MOVE 5 TO XBLOCK-SIZE (1). OBSQ34.2 +047200 OPEN OUTPUT SQ-FS2 WITH NO REWIND. OBSQ34.2 +047300 SEQ-TEST-002. OBSQ34.2 +047400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS2R1-F-G-120. OBSQ34.2 +047500 WRITE SQ-FS2R1-F-G-120. OBSQ34.2 +047600 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +047700 GO TO SEQ-WRITE-002. OBSQ34.2 +047800 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +047900 GO TO SEQ-TEST-002. OBSQ34.2 +048000 SEQ-WRITE-002. OBSQ34.2 +048100 MOVE "CREATE FILE SQ-FS2" TO FEATURE. OBSQ34.2 +048200 MOVE "SEQ-TEST-002" TO PAR-NAME. OBSQ34.2 +048300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +048400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +048500 PERFORM PRINT-DETAIL. OBSQ34.2 +048600 SEQ-CLOSE-002. OBSQ34.2 +048700 CLOSE SQ-FS2 WITH NO REWIND. OBSQ34.2 +048800 SEQ-INIT-003. OBSQ34.2 +048900* THIS TEST CREATES FILE SQ-FS3 AS THE THIRD FILE OBSQ34.2 +049000* ON MULTIPLE FILE TAPE ONE. THIS FILE IS OPENED OBSQ34.2 +049100* AND CLOSED WITH NO REWIND. OBSQ34.2 +049200 PERFORM BUILD-RECORD. OBSQ34.2 +049300 MOVE "SQ-FS3" TO XFILE-NAME (1). OBSQ34.2 +049400 MOVE "CH" TO CHARS-OR-RECORDS (1). OBSQ34.2 +049500 MOVE 1200 TO XBLOCK-SIZE (1). OBSQ34.2 +049600 OPEN OUTPUT SQ-FS3 NO REWIND. OBSQ34.2 +049700 SEQ-TEST-003. OBSQ34.2 +049800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. OBSQ34.2 +049900 WRITE SQ-FS3R1-F-G-120. OBSQ34.2 +050000 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +050100 GO TO SEQ-WRITE-003. OBSQ34.2 +050200 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +050300 GO TO SEQ-TEST-003. OBSQ34.2 +050400 SEQ-WRITE-003. OBSQ34.2 +050500 MOVE "CREATE FILE SQ-FS3" TO FEATURE. OBSQ34.2 +050600 MOVE "SEQ-TEST-003" TO PAR-NAME. OBSQ34.2 +050700 MOVE "FILE CREATED, RECS=" TO COMPUTED-A. OBSQ34.2 +050800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +050900 PERFORM PRINT-DETAIL. OBSQ34.2 +051000 SEQ-CLOSE-003. OBSQ34.2 +051100 CLOSE SQ-FS3 WITH NO REWIND. OBSQ34.2 +051200 SEQ-INIT-004. OBSQ34.2 +051300* THIS TEST CREATES FILE SQ-FS4 AS THE FOURTH AND LASTOBSQ34.2 +051400* FILE ON MULTIPLE FILE TAPE ONE. THIS FILE IS OPENEDOBSQ34.2 +051500* WITH NO REWIND. OBSQ34.2 +051600 PERFORM BUILD-RECORD. OBSQ34.2 +051700 MOVE "SQ-FS4" TO XFILE-NAME (1). OBSQ34.2 +051800 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +051900 MOVE 10 TO XBLOCK-SIZE (1). OBSQ34.2 +052000 OPEN OUTPUT SQ-FS4 WITH NO REWIND. OBSQ34.2 +052100 SEQ-TEST-004. OBSQ34.2 +052200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. OBSQ34.2 +052300 WRITE SQ-FS4R1-F-G-120. OBSQ34.2 +052400 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +052500 GO TO SEQ-WRITE-004. OBSQ34.2 +052600 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +052700 GO TO SEQ-TEST-004. OBSQ34.2 +052800 SEQ-WRITE-004. OBSQ34.2 +052900 MOVE "CREATE FILE SQ-FS4" TO FEATURE. OBSQ34.2 +053000 MOVE "SEQ-TEST-004" TO PAR-NAME. OBSQ34.2 +053100 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +053200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +053300 PERFORM PRINT-DETAIL. OBSQ34.2 +053400 SEQ-CLOSE-004. OBSQ34.2 +053500 CLOSE SQ-FS4. OBSQ34.2 +053600 SEQ-INIT-005. OBSQ34.2 +053700* THIS TEST CREATES FILE SQ-FS5 AS THE FIRST FILE ON OBSQ34.2 +053800* MULTIPLE FILE TAPE TWO. THE POSITION PHRASE IS OBSQ34.2 +053900* USED IN THE MULTIPLE FILE CLAUSE. OBSQ34.2 +054000 PERFORM BUILD-RECORD. OBSQ34.2 +054100 MOVE "SQ-FS5" TO XFILE-NAME (1). OBSQ34.2 +054200 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +054300 MOVE 5 TO XBLOCK-SIZE (1). OBSQ34.2 +054400 OPEN OUTPUT SQ-FS5. OBSQ34.2 +054500 SEQ-TEST-005. OBSQ34.2 +054600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5R1-F-G-120. OBSQ34.2 +054700 WRITE SQ-FS5R1-F-G-120. OBSQ34.2 +054800 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +054900 GO TO SEQ-WRITE-005. OBSQ34.2 +055000 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +055100 GO TO SEQ-TEST-005. OBSQ34.2 +055200 SEQ-WRITE-005. OBSQ34.2 +055300 MOVE "CREATE FILE SQ-FS5" TO FEATURE. OBSQ34.2 +055400 MOVE "SEQ-TEST-005" TO PAR-NAME. OBSQ34.2 +055500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +055600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +055700 PERFORM PRINT-DETAIL. OBSQ34.2 +055800 SEQ-CLOSE-005. OBSQ34.2 +055900 CLOSE SQ-FS5. OBSQ34.2 +056000 SEQ-INIT-006. OBSQ34.2 +056100* THIS TEST CREATES FILE SQ-FS6 AS THE SECOND FILE OBSQ34.2 +056200* ON MULTIPLE FILE TAPE TWO. THE POSITION PHRASE IS OBSQ34.2 +056300* USED IN THE MULTIPLE FILE CLAUSE. OBSQ34.2 +056400 PERFORM BUILD-RECORD. OBSQ34.2 +056500 MOVE "SQ-FS6" TO XFILE-NAME (1). OBSQ34.2 +056600 MOVE "RC" TO CHARS-OR-RECORDS (1). OBSQ34.2 +056700 MOVE 10 TO XBLOCK-SIZE (1). OBSQ34.2 +056800 OPEN OUTPUT SQ-FS6. OBSQ34.2 +056900 SEQ-TEST-006. OBSQ34.2 +057000 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS6R1-F-G-120. OBSQ34.2 +057100 WRITE SQ-FS6R1-F-G-120. OBSQ34.2 +057200 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +057300 GO TO SEQ-WRITE-006. OBSQ34.2 +057400 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +057500 GO TO SEQ-TEST-006. OBSQ34.2 +057600 SEQ-WRITE-006. OBSQ34.2 +057700 MOVE "CREATE FILE SQ-FS6" TO FEATURE. OBSQ34.2 +057800 MOVE "SEQ-TEST-006" TO PAR-NAME. OBSQ34.2 +057900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +058000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +058100 PERFORM PRINT-DETAIL. OBSQ34.2 +058200 SEQ-CLOSE-006. OBSQ34.2 +058300 CLOSE SQ-FS6. OBSQ34.2 +058400 SEQ-INIT-007. OBSQ34.2 +058500* THIS TEST CREATES FILE SQ-FS7 AS THE THIRD FILE OBSQ34.2 +058600* ON MULTIPLE FILE TAPE TWO. THE POSITION PHRASE IS OBSQ34.2 +058700* USED IN THE MULTIPLE FILE CLAUSE. OBSQ34.2 +058800 PERFORM BUILD-RECORD. OBSQ34.2 +058900 MOVE "SQ-FS7" TO XFILE-NAME (1). OBSQ34.2 +059000 MOVE "CH" TO CHARS-OR-RECORDS (1). OBSQ34.2 +059100 MOVE 2400 TO XBLOCK-SIZE (1). OBSQ34.2 +059200 OPEN OUTPUT SQ-FS7. OBSQ34.2 +059300 SEQ-TEST-007. OBSQ34.2 +059400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS7R1-F-G-120. OBSQ34.2 +059500 WRITE SQ-FS7R1-F-G-120. OBSQ34.2 +059600 IF XRECORD-NUMBER (1) EQUAL TO 750 OBSQ34.2 +059700 GO TO SEQ-WRITE-007. OBSQ34.2 +059800 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +059900 GO TO SEQ-TEST-007. OBSQ34.2 +060000 SEQ-WRITE-007. OBSQ34.2 +060100 MOVE "CREATE FILE SQ-FS7" TO FEATURE. OBSQ34.2 +060200 MOVE "SEQ-TEST-007" TO PAR-NAME. OBSQ34.2 +060300 MOVE "FILE CREATED, RECS-=" TO COMPUTED-A. OBSQ34.2 +060400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +060500 PERFORM PRINT-DETAIL. OBSQ34.2 +060600 SEQ-CLOSE-007. OBSQ34.2 +060700 CLOSE SQ-FS7. OBSQ34.2 +060800 SEQ-INIT-008. OBSQ34.2 +060900* THIS TEST CREATES FILE SQ-FS8 AS THE FOURTH AND LASTOBSQ34.2 +061000* FILE ON MULTIPLE FILE TAPE TWO. THE POSITION PHRASEOBSQ34.2 +061100* IS USED IN THE MULTIPLE FILE CLAUSE. OBSQ34.2 +061200 PERFORM BUILD-RECORD. OBSQ34.2 +061300 MOVE "SQ-FS8" TO XFILE-NAME (1). OBSQ34.2 +061400 MOVE "CH" TO CHARS-OR-RECORDS (1). OBSQ34.2 +061500 MOVE 120 TO XBLOCK-SIZE (1). OBSQ34.2 +061600 OPEN OUTPUT SQ-FS8. OBSQ34.2 +061700 SEQ-TEST-008. OBSQ34.2 +061800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS8R1-F-G-120. OBSQ34.2 +061900 WRITE SQ-FS8R1-F-G-120. OBSQ34.2 +062000 IF XRECORD-NUMBER (1) EQUAL 750 OBSQ34.2 +062100 GO TO SEQ-WRITE-008. OBSQ34.2 +062200 ADD 1 TO XRECORD-NUMBER (1). OBSQ34.2 +062300 GO TO SEQ-TEST-008. OBSQ34.2 +062400 SEQ-WRITE-008. OBSQ34.2 +062500 MOVE "CREATE FILE SQ-FS8" TO FEATURE. OBSQ34.2 +062600 MOVE "SEQ-TEST-008" TO PAR-NAME. OBSQ34.2 +062700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. OBSQ34.2 +062800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. OBSQ34.2 +062900 PERFORM PRINT-DETAIL. OBSQ34.2 +063000 SEQ-CLOSE-008. OBSQ34.2 +063100 CLOSE SQ-FS8. OBSQ34.2 +063200 OBSQ3A-END-ROUTINE. OBSQ34.2 +063300 MOVE "END OF OBSQ3A VALIDATION TESTS" TO PRINT-REC. OBSQ34.2 +063400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. OBSQ34.2 +063500 TERMINATE-OBSQ3A. OBSQ34.2 +063600 GO TO CCVS-EXIT. OBSQ34.2 +063700 BUILD-RECORD. OBSQ34.2 +063800 MOVE "R1-F-G" TO XRECORD-NAME (1). OBSQ34.2 +063900 MOVE "OBSQ3A" TO XPROGRAM-NAME (1). OBSQ34.2 +064000 MOVE 120 TO XRECORD-LENGTH (1). OBSQ34.2 +064100 MOVE 750 TO RECORDS-IN-FILE (1). OBSQ34.2 +064200 MOVE "SQ" TO XFILE-ORGANIZATION (1). OBSQ34.2 +064300 MOVE "S" TO XLABEL-TYPE (1). OBSQ34.2 +064400 MOVE 1 TO XRECORD-NUMBER (1). OBSQ34.2 +064500 CCVS-EXIT SECTION. OBSQ34.2 +064600 CCVS-999999. OBSQ34.2 +064700 GO TO CLOSE-FILES. OBSQ34.2 diff --git a/tests/cobol85/OB/OBSQ4A.SUB b/tests/cobol85/OB/OBSQ4A.SUB new file mode 100755 index 00000000..c85b456b --- /dev/null +++ b/tests/cobol85/OB/OBSQ4A.SUB @@ -0,0 +1,574 @@ +000100 IDENTIFICATION DIVISION. OBSQ44.2 +000200 PROGRAM-ID. OBSQ44.2 +000300 OBSQ4A. OBSQ44.2 +000400**************************************************************** OBSQ44.2 +000500* * OBSQ44.2 +000600* VALIDATION FOR:- * OBSQ44.2 +000700* " HIGH ". OBSQ44.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * OBSQ44.2 +000900* * OBSQ44.2 +001000* CREATION DATE / VALIDATION DATE * OBSQ44.2 +001100* "4.2 ". OBSQ44.2 +001200* * OBSQ44.2 +001300* THE ROUTINE OBSQ4A READS AND VALIDATES THE MULTIPLE OBSQ44.2 +001400* FILE TAPE CREATED IN OBSQ3A. THE FOUR FILES CONTAINED ON OBSQ44.2 +001500* THIS TAPE ARE SQ-FS1, SQ-FS2, SQ-FS3, AND SQ-FS4. BOTH OBSQ44.2 +001600* MULTIPLE FILE TAPES ONE AND TWO ARE THEN PASSED ON TO OBSQ5A.OBSQ44.2 +001700* OBSQ4A USES A MULTIPLE FILE CLAUSE WITH THE POSITION PHRASE OBSQ44.2 +001800* TO PROCESS TAPE ONE. THIS TAPE WAS CREATED USING OPEN AND OBSQ44.2 +001900* CLOSE STATEMENTS WITH NO REWIND. OBSQ44.2 +002000 ENVIRONMENT DIVISION. OBSQ44.2 +002100 CONFIGURATION SECTION. OBSQ44.2 +002200 SOURCE-COMPUTER. OBSQ44.2 +002300 Linux. OBSQ44.2 +002400 OBJECT-COMPUTER. OBSQ44.2 +002500 Linux. OBSQ44.2 +002600 INPUT-OUTPUT SECTION. OBSQ44.2 +002700 FILE-CONTROL. OBSQ44.2 +002800*P SELECT RAW-DATA ASSIGN TO OBSQ44.2 +002900*P "XXXXX062" OBSQ44.2 +003000*P ORGANIZATION IS INDEXED OBSQ44.2 +003100*P ACCESS MODE IS RANDOM OBSQ44.2 +003200*P RECORD KEY IS RAW-DATA-KEY. OBSQ44.2 +003300 SELECT PRINT-FILE ASSIGN TO OBSQ44.2 +003400 "report.log". OBSQ44.2 +003500 SELECT SQ-FS1 ASSIGN TO OBSQ44.2 +003600 "XXXXX004". OBSQ44.2 +003700 SELECT SQ-FS2 ASSIGN TO OBSQ44.2 +003800 "XXXXX008". OBSQ44.2 +003900 SELECT SQ-FS3 ASSIGN TO OBSQ44.2 +004000 "XXXXX009". OBSQ44.2 +004100 SELECT SQ-FS4 ASSIGN TO OBSQ44.2 +004200 "XXXXX010". OBSQ44.2 +004300 I-O-CONTROL. OBSQ44.2 +004400 MULTIPLE FILE CONTAINS SQ-FS1 POSITION 1, OBSQ44.2 +004500 SQ-FS4 POSITION 4, OBSQ44.2 +004600 SQ-FS3 POSITION 3, OBSQ44.2 +004700 SQ-FS2 POSITION 2. OBSQ44.2 +004800 DATA DIVISION. OBSQ44.2 +004900 FILE SECTION. OBSQ44.2 +005000*P OBSQ44.2 +005100*PD RAW-DATA. OBSQ44.2 +005200*P OBSQ44.2 +005300*P1 RAW-DATA-SATZ. OBSQ44.2 +005400*P 05 RAW-DATA-KEY PIC X(6). OBSQ44.2 +005500*P 05 C-DATE PIC 9(6). OBSQ44.2 +005600*P 05 C-TIME PIC 9(8). OBSQ44.2 +005700*P 05 C-NO-OF-TESTS PIC 99. OBSQ44.2 +005800*P 05 C-OK PIC 999. OBSQ44.2 +005900*P 05 C-ALL PIC 999. OBSQ44.2 +006000*P 05 C-FAIL PIC 999. OBSQ44.2 +006100*P 05 C-DELETED PIC 999. OBSQ44.2 +006200*P 05 C-INSPECT PIC 999. OBSQ44.2 +006300*P 05 C-NOTE PIC X(13). OBSQ44.2 +006400*P 05 C-INDENT PIC X. OBSQ44.2 +006500*P 05 C-ABORT PIC X(8). OBSQ44.2 +006600 FD PRINT-FILE. OBSQ44.2 +006700 01 PRINT-REC PICTURE X(120). OBSQ44.2 +006800 01 DUMMY-RECORD PICTURE X(120). OBSQ44.2 +006900 FD SQ-FS1 OBSQ44.2 +007000 LABEL RECORD STANDARD OBSQ44.2 +007100 . OBSQ44.2 +007200 01 SQ-FS1R1-F-G-120 PIC X(120). OBSQ44.2 +007300 FD SQ-FS2 OBSQ44.2 +007400 LABEL RECORD STANDARD OBSQ44.2 +007500 BLOCK 5 RECORDS. OBSQ44.2 +007600 01 SQ-FS2R1-F-G-120 PIC X(120). OBSQ44.2 +007700 FD SQ-FS3 OBSQ44.2 +007800 LABEL RECORD STANDARD OBSQ44.2 +007900 RECORD CONTAINS 120 CHARACTERS OBSQ44.2 +008000 BLOCK CONTAINS 1200 CHARACTERS. OBSQ44.2 +008100 01 SQ-FS3R1-F-G-120 PIC X(120). OBSQ44.2 +008200 FD SQ-FS4 OBSQ44.2 +008300 LABEL RECORD IS STANDARD OBSQ44.2 +008400 RECORD 120 CHARACTERS OBSQ44.2 +008500 BLOCK CONTAINS 10 RECORDS. OBSQ44.2 +008600 01 SQ-FS4R1-F-G-120 PIC X(120). OBSQ44.2 +008700 WORKING-STORAGE SECTION. OBSQ44.2 +008800 77 RECORDS-COUNT PIC 999 VALUE 0. OBSQ44.2 +008900 77 RECORDS-IN-ERROR PIC 999 VALUE 0. OBSQ44.2 +009000 01 FILE-RECORD-INFORMATION-REC. OBSQ44.2 +009100 03 FILE-RECORD-INFO-SKELETON. OBSQ44.2 +009200 05 FILLER PICTURE X(48) VALUE OBSQ44.2 +009300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBSQ44.2 +009400 05 FILLER PICTURE X(46) VALUE OBSQ44.2 +009500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBSQ44.2 +009600 05 FILLER PICTURE X(26) VALUE OBSQ44.2 +009700 ",LFIL=000000,ORG= ,LBLR= ". OBSQ44.2 +009800 05 FILLER PICTURE X(37) VALUE OBSQ44.2 +009900 ",RECKEY= ". OBSQ44.2 +010000 05 FILLER PICTURE X(38) VALUE OBSQ44.2 +010100 ",ALTKEY1= ". OBSQ44.2 +010200 05 FILLER PICTURE X(38) VALUE OBSQ44.2 +010300 ",ALTKEY2= ". OBSQ44.2 +010400 05 FILLER PICTURE X(7) VALUE SPACE.OBSQ44.2 +010500 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBSQ44.2 +010600 05 FILE-RECORD-INFO-P1-120. OBSQ44.2 +010700 07 FILLER PIC X(5). OBSQ44.2 +010800 07 XFILE-NAME PIC X(6). OBSQ44.2 +010900 07 FILLER PIC X(8). OBSQ44.2 +011000 07 XRECORD-NAME PIC X(6). OBSQ44.2 +011100 07 FILLER PIC X(1). OBSQ44.2 +011200 07 REELUNIT-NUMBER PIC 9(1). OBSQ44.2 +011300 07 FILLER PIC X(7). OBSQ44.2 +011400 07 XRECORD-NUMBER PIC 9(6). OBSQ44.2 +011500 07 FILLER PIC X(6). OBSQ44.2 +011600 07 UPDATE-NUMBER PIC 9(2). OBSQ44.2 +011700 07 FILLER PIC X(5). OBSQ44.2 +011800 07 ODO-NUMBER PIC 9(4). OBSQ44.2 +011900 07 FILLER PIC X(5). OBSQ44.2 +012000 07 XPROGRAM-NAME PIC X(5). OBSQ44.2 +012100 07 FILLER PIC X(7). OBSQ44.2 +012200 07 XRECORD-LENGTH PIC 9(6). OBSQ44.2 +012300 07 FILLER PIC X(7). OBSQ44.2 +012400 07 CHARS-OR-RECORDS PIC X(2). OBSQ44.2 +012500 07 FILLER PIC X(1). OBSQ44.2 +012600 07 XBLOCK-SIZE PIC 9(4). OBSQ44.2 +012700 07 FILLER PIC X(6). OBSQ44.2 +012800 07 RECORDS-IN-FILE PIC 9(6). OBSQ44.2 +012900 07 FILLER PIC X(5). OBSQ44.2 +013000 07 XFILE-ORGANIZATION PIC X(2). OBSQ44.2 +013100 07 FILLER PIC X(6). OBSQ44.2 +013200 07 XLABEL-TYPE PIC X(1). OBSQ44.2 +013300 05 FILE-RECORD-INFO-P121-240. OBSQ44.2 +013400 07 FILLER PIC X(8). OBSQ44.2 +013500 07 XRECORD-KEY PIC X(29). OBSQ44.2 +013600 07 FILLER PIC X(9). OBSQ44.2 +013700 07 ALTERNATE-KEY1 PIC X(29). OBSQ44.2 +013800 07 FILLER PIC X(9). OBSQ44.2 +013900 07 ALTERNATE-KEY2 PIC X(29). OBSQ44.2 +014000 07 FILLER PIC X(7). OBSQ44.2 +014100 01 TEST-RESULTS. OBSQ44.2 +014200 02 FILLER PICTURE X VALUE SPACE. OBSQ44.2 +014300 02 FEATURE PICTURE X(20) VALUE SPACE. OBSQ44.2 +014400 02 FILLER PICTURE X VALUE SPACE. OBSQ44.2 +014500 02 P-OR-F PICTURE X(5) VALUE SPACE. OBSQ44.2 +014600 02 FILLER PICTURE X VALUE SPACE. OBSQ44.2 +014700 02 PAR-NAME. OBSQ44.2 +014800 03 FILLER PICTURE X(12) VALUE SPACE. OBSQ44.2 +014900 03 PARDOT-X PICTURE X VALUE SPACE. OBSQ44.2 +015000 03 DOTVALUE PICTURE 99 VALUE ZERO. OBSQ44.2 +015100 03 FILLER PIC X(5) VALUE SPACE. OBSQ44.2 +015200 02 FILLER PIC X(10) VALUE SPACE. OBSQ44.2 +015300 02 RE-MARK PIC X(61). OBSQ44.2 +015400 01 TEST-COMPUTED. OBSQ44.2 +015500 02 FILLER PIC X(30) VALUE SPACE. OBSQ44.2 +015600 02 FILLER PIC X(17) VALUE " COMPUTED=". OBSQ44.2 +015700 02 COMPUTED-X. OBSQ44.2 +015800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. OBSQ44.2 +015900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). OBSQ44.2 +016000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). OBSQ44.2 +016100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). OBSQ44.2 +016200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). OBSQ44.2 +016300 03 CM-18V0 REDEFINES COMPUTED-A. OBSQ44.2 +016400 04 COMPUTED-18V0 PICTURE -9(18). OBSQ44.2 +016500 04 FILLER PICTURE X. OBSQ44.2 +016600 03 FILLER PIC X(50) VALUE SPACE. OBSQ44.2 +016700 01 TEST-CORRECT. OBSQ44.2 +016800 02 FILLER PIC X(30) VALUE SPACE. OBSQ44.2 +016900 02 FILLER PIC X(17) VALUE " CORRECT =". OBSQ44.2 +017000 02 CORRECT-X. OBSQ44.2 +017100 03 CORRECT-A PICTURE X(20) VALUE SPACE. OBSQ44.2 +017200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). OBSQ44.2 +017300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). OBSQ44.2 +017400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). OBSQ44.2 +017500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). OBSQ44.2 +017600 03 CR-18V0 REDEFINES CORRECT-A. OBSQ44.2 +017700 04 CORRECT-18V0 PICTURE -9(18). OBSQ44.2 +017800 04 FILLER PICTURE X. OBSQ44.2 +017900 03 FILLER PIC X(50) VALUE SPACE. OBSQ44.2 +018000 01 CCVS-C-1. OBSQ44.2 +018100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PAOBSQ44.2 +018200- "SS PARAGRAPH-NAME OBSQ44.2 +018300- " REMARKS". OBSQ44.2 +018400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. OBSQ44.2 +018500 01 CCVS-C-2. OBSQ44.2 +018600 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ44.2 +018700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". OBSQ44.2 +018800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. OBSQ44.2 +018900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". OBSQ44.2 +019000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. OBSQ44.2 +019100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. OBSQ44.2 +019200 01 REC-CT PICTURE 99 VALUE ZERO. OBSQ44.2 +019300 01 DELETE-CNT PICTURE 999 VALUE ZERO. OBSQ44.2 +019400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. OBSQ44.2 +019500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBSQ44.2 +019600 01 PASS-COUNTER PIC 999 VALUE ZERO. OBSQ44.2 +019700 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBSQ44.2 +019800 01 ERROR-HOLD PIC 999 VALUE ZERO. OBSQ44.2 +019900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBSQ44.2 +020000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBSQ44.2 +020100 01 CCVS-H-1. OBSQ44.2 +020200 02 FILLER PICTURE X(27) VALUE SPACE. OBSQ44.2 +020300 02 FILLER PICTURE X(67) VALUE OBSQ44.2 +020400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION OBSQ44.2 +020500- " SYSTEM". OBSQ44.2 +020600 02 FILLER PICTURE X(26) VALUE SPACE. OBSQ44.2 +020700 01 CCVS-H-2. OBSQ44.2 +020800 02 FILLER PICTURE X(52) VALUE IS OBSQ44.2 +020900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". OBSQ44.2 +021000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". OBSQ44.2 +021100 02 TEST-ID PICTURE IS X(9). OBSQ44.2 +021200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. OBSQ44.2 +021300 01 CCVS-H-3. OBSQ44.2 +021400 02 FILLER PICTURE X(34) VALUE OBSQ44.2 +021500 " FOR OFFICIAL USE ONLY ". OBSQ44.2 +021600 02 FILLER PICTURE X(58) VALUE OBSQ44.2 +021700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBSQ44.2 +021800 02 FILLER PICTURE X(28) VALUE OBSQ44.2 +021900 " COPYRIGHT 1985 ". OBSQ44.2 +022000 01 CCVS-E-1. OBSQ44.2 +022100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. OBSQ44.2 +022200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". OBSQ44.2 +022300 02 ID-AGAIN PICTURE IS X(9). OBSQ44.2 +022400 02 FILLER PICTURE X(45) VALUE IS OBSQ44.2 +022500 " NTIS DISTRIBUTION COBOL 85". OBSQ44.2 +022600 01 CCVS-E-2. OBSQ44.2 +022700 02 FILLER PICTURE X(31) VALUE OBSQ44.2 +022800 SPACE. OBSQ44.2 +022900 02 FILLER PICTURE X(21) VALUE SPACE. OBSQ44.2 +023000 02 CCVS-E-2-2. OBSQ44.2 +023100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. OBSQ44.2 +023200 03 FILLER PICTURE IS X VALUE IS SPACE. OBSQ44.2 +023300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". OBSQ44.2 +023400 01 CCVS-E-3. OBSQ44.2 +023500 02 FILLER PICTURE X(22) VALUE OBSQ44.2 +023600 " FOR OFFICIAL USE ONLY". OBSQ44.2 +023700 02 FILLER PICTURE X(12) VALUE SPACE. OBSQ44.2 +023800 02 FILLER PICTURE X(58) VALUE OBSQ44.2 +023900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBSQ44.2 +024000 02 FILLER PICTURE X(13) VALUE SPACE. OBSQ44.2 +024100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". OBSQ44.2 +024200 01 CCVS-E-4. OBSQ44.2 +024300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBSQ44.2 +024400 02 FILLER PIC XXXX VALUE " OF ". OBSQ44.2 +024500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBSQ44.2 +024600 02 FILLER PIC X(40) VALUE OBSQ44.2 +024700 " TESTS WERE EXECUTED SUCCESSFULLY". OBSQ44.2 +024800 01 XXINFO. OBSQ44.2 +024900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". OBSQ44.2 +025000 02 INFO-TEXT. OBSQ44.2 +025100 04 FILLER PIC X(20) VALUE SPACE. OBSQ44.2 +025200 04 XXCOMPUTED PIC X(20). OBSQ44.2 +025300 04 FILLER PIC X(5) VALUE SPACE. OBSQ44.2 +025400 04 XXCORRECT PIC X(20). OBSQ44.2 +025500 01 HYPHEN-LINE. OBSQ44.2 +025600 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ44.2 +025700 02 FILLER PICTURE IS X(65) VALUE IS "************************OBSQ44.2 +025800- "*****************************************". OBSQ44.2 +025900 02 FILLER PICTURE IS X(54) VALUE IS "************************OBSQ44.2 +026000- "******************************". OBSQ44.2 +026100 01 CCVS-PGM-ID PIC X(6) VALUE OBSQ44.2 +026200 "OBSQ4A". OBSQ44.2 +026300 PROCEDURE DIVISION. OBSQ44.2 +026400 CCVS1 SECTION. OBSQ44.2 +026500 OPEN-FILES. OBSQ44.2 +026600*P OPEN I-O RAW-DATA. OBSQ44.2 +026700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ44.2 +026800*P READ RAW-DATA INVALID KEY GO TO END-E-1. OBSQ44.2 +026900*P MOVE "ABORTED " TO C-ABORT. OBSQ44.2 +027000*P ADD 1 TO C-NO-OF-TESTS. OBSQ44.2 +027100*P ACCEPT C-DATE FROM DATE. OBSQ44.2 +027200*P ACCEPT C-TIME FROM TIME. OBSQ44.2 +027300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. OBSQ44.2 +027400*PND-E-1. OBSQ44.2 +027500*P CLOSE RAW-DATA. OBSQ44.2 +027600 OPEN OUTPUT PRINT-FILE. OBSQ44.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBSQ44.2 +027800 MOVE SPACE TO TEST-RESULTS. OBSQ44.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBSQ44.2 +028000 MOVE ZERO TO REC-SKL-SUB. OBSQ44.2 +028100 PERFORM CCVS-INIT-FILE 9 TIMES. OBSQ44.2 +028200 CCVS-INIT-FILE. OBSQ44.2 +028300 ADD 1 TO REC-SKL-SUB. OBSQ44.2 +028400 MOVE FILE-RECORD-INFO-SKELETON TO OBSQ44.2 +028500 FILE-RECORD-INFO (REC-SKL-SUB). OBSQ44.2 +028600 CCVS-INIT-EXIT. OBSQ44.2 +028700 GO TO CCVS1-EXIT. OBSQ44.2 +028800 CLOSE-FILES. OBSQ44.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBSQ44.2 +029000*P OPEN I-O RAW-DATA. OBSQ44.2 +029100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ44.2 +029200*P READ RAW-DATA INVALID KEY GO TO END-E-2. OBSQ44.2 +029300*P MOVE "OK. " TO C-ABORT. OBSQ44.2 +029400*P MOVE PASS-COUNTER TO C-OK. OBSQ44.2 +029500*P MOVE ERROR-HOLD TO C-ALL. OBSQ44.2 +029600*P MOVE ERROR-COUNTER TO C-FAIL. OBSQ44.2 +029700*P MOVE DELETE-CNT TO C-DELETED. OBSQ44.2 +029800*P MOVE INSPECT-COUNTER TO C-INSPECT. OBSQ44.2 +029900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. OBSQ44.2 +030000*PND-E-2. OBSQ44.2 +030100*P CLOSE RAW-DATA. OBSQ44.2 +030200 TERMINATE-CCVS. OBSQ44.2 +030300*S EXIT PROGRAM. OBSQ44.2 +030400*SERMINATE-CALL. OBSQ44.2 +030500 STOP RUN. OBSQ44.2 +030600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBSQ44.2 +030700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBSQ44.2 +030800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBSQ44.2 +030900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. OBSQ44.2 +031000 MOVE "****TEST DELETED****" TO RE-MARK. OBSQ44.2 +031100 PRINT-DETAIL. OBSQ44.2 +031200 IF REC-CT NOT EQUAL TO ZERO OBSQ44.2 +031300 MOVE "." TO PARDOT-X OBSQ44.2 +031400 MOVE REC-CT TO DOTVALUE. OBSQ44.2 +031500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBSQ44.2 +031600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBSQ44.2 +031700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBSQ44.2 +031800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBSQ44.2 +031900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBSQ44.2 +032000 MOVE SPACE TO CORRECT-X. OBSQ44.2 +032100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBSQ44.2 +032200 MOVE SPACE TO RE-MARK. OBSQ44.2 +032300 HEAD-ROUTINE. OBSQ44.2 +032400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +032500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. OBSQ44.2 +032600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBSQ44.2 +032700 COLUMN-NAMES-ROUTINE. OBSQ44.2 +032800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +032900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +033000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +033100 END-ROUTINE. OBSQ44.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBSQ44.2 +033300 END-RTN-EXIT. OBSQ44.2 +033400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +033500 END-ROUTINE-1. OBSQ44.2 +033600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBSQ44.2 +033700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. OBSQ44.2 +033800 ADD PASS-COUNTER TO ERROR-HOLD. OBSQ44.2 +033900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBSQ44.2 +034000 MOVE PASS-COUNTER TO CCVS-E-4-1. OBSQ44.2 +034100 MOVE ERROR-HOLD TO CCVS-E-4-2. OBSQ44.2 +034200 MOVE CCVS-E-4 TO CCVS-E-2-2. OBSQ44.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBSQ44.2 +034400 END-ROUTINE-12. OBSQ44.2 +034500 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBSQ44.2 +034600 IF ERROR-COUNTER IS EQUAL TO ZERO OBSQ44.2 +034700 MOVE "NO " TO ERROR-TOTAL OBSQ44.2 +034800 ELSE OBSQ44.2 +034900 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBSQ44.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. OBSQ44.2 +035100 PERFORM WRITE-LINE. OBSQ44.2 +035200 END-ROUTINE-13. OBSQ44.2 +035300 IF DELETE-CNT IS EQUAL TO ZERO OBSQ44.2 +035400 MOVE "NO " TO ERROR-TOTAL ELSE OBSQ44.2 +035500 MOVE DELETE-CNT TO ERROR-TOTAL. OBSQ44.2 +035600 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBSQ44.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +035800 IF INSPECT-COUNTER EQUAL TO ZERO OBSQ44.2 +035900 MOVE "NO " TO ERROR-TOTAL OBSQ44.2 +036000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBSQ44.2 +036100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBSQ44.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +036300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ44.2 +036400 WRITE-LINE. OBSQ44.2 +036500 ADD 1 TO RECORD-COUNT. OBSQ44.2 +036600 IF RECORD-COUNT GREATER 50 OBSQ44.2 +036700 MOVE DUMMY-RECORD TO DUMMY-HOLD OBSQ44.2 +036800 MOVE SPACE TO DUMMY-RECORD OBSQ44.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBSQ44.2 +037000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBSQ44.2 +037100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBSQ44.2 +037200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBSQ44.2 +037300 MOVE DUMMY-HOLD TO DUMMY-RECORD OBSQ44.2 +037400 MOVE ZERO TO RECORD-COUNT. OBSQ44.2 +037500 PERFORM WRT-LN. OBSQ44.2 +037600 WRT-LN. OBSQ44.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBSQ44.2 +037800 MOVE SPACE TO DUMMY-RECORD. OBSQ44.2 +037900 BLANK-LINE-PRINT. OBSQ44.2 +038000 PERFORM WRT-LN. OBSQ44.2 +038100 FAIL-ROUTINE. OBSQ44.2 +038200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ44.2 +038300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ44.2 +038400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBSQ44.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +038600 GO TO FAIL-ROUTINE-EX. OBSQ44.2 +038700 FAIL-ROUTINE-WRITE. OBSQ44.2 +038800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBSQ44.2 +038900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +039000 FAIL-ROUTINE-EX. EXIT. OBSQ44.2 +039100 BAIL-OUT. OBSQ44.2 +039200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBSQ44.2 +039300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBSQ44.2 +039400 BAIL-OUT-WRITE. OBSQ44.2 +039500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBSQ44.2 +039600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ44.2 +039700 BAIL-OUT-EX. EXIT. OBSQ44.2 +039800 CCVS1-EXIT. OBSQ44.2 +039900 EXIT. OBSQ44.2 +040000 SECT-OBSQ4A-0001 SECTION. OBSQ44.2 +040100 SEQ-INIT-001. OBSQ44.2 +040200 MOVE 0 TO RECORDS-COUNT, RECORDS-IN-ERROR. OBSQ44.2 +040300 OPEN INPUT SQ-FS1. OBSQ44.2 +040400 SEQ-TEST-001. OBSQ44.2 +040500 READ SQ-FS1 AT END GO TO SEQ-TEST-001-01. OBSQ44.2 +040600 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ44.2 +040700 ADD 1 TO RECORDS-COUNT. OBSQ44.2 +040800 IF RECORDS-COUNT GREATER THAN 750 OBSQ44.2 +040900 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ44.2 +041000 GO TO SEQ-FAIL-001. OBSQ44.2 +041100 IF RECORDS-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ44.2 +041200 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +041300 GO TO SEQ-TEST-001. OBSQ44.2 +041400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" OBSQ44.2 +041500 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +041600 GO TO SEQ-TEST-001. OBSQ44.2 +041700 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ44.2 +041800 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +041900 GO TO SEQ-TEST-001. OBSQ44.2 +042000 IF XBLOCK-SIZE (1) NOT EQUAL TO 1 OBSQ44.2 +042100 ADD 1 TO RECORDS-IN-ERROR. OBSQ44.2 +042200 GO TO SEQ-TEST-001. OBSQ44.2 +042300 SEQ-TEST-001-01. OBSQ44.2 +042400 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ44.2 +042500 GO TO SEQ-PASS-001. OBSQ44.2 +042600 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. OBSQ44.2 +042700 SEQ-FAIL-001. OBSQ44.2 +042800 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ44.2 +042900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ44.2 +043000 PERFORM FAIL. OBSQ44.2 +043100 GO TO SEQ-WRITE-001. OBSQ44.2 +043200 SEQ-PASS-001. OBSQ44.2 +043300 PERFORM PASS. OBSQ44.2 +043400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ44.2 +043500 MOVE RECORDS-COUNT TO CORRECT-18V0. OBSQ44.2 +043600 SEQ-WRITE-001. OBSQ44.2 +043700 MOVE "SEQ-TEST-001" TO PAR-NAME. OBSQ44.2 +043800 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. OBSQ44.2 +043900 PERFORM PRINT-DETAIL. OBSQ44.2 +044000 SEQ-CLOSE-001. OBSQ44.2 +044100 CLOSE SQ-FS1. OBSQ44.2 +044200 SEQ-INIT-002. OBSQ44.2 +044300* THIS TEST READS AND VALIDATES FILE SQ-FS3. OBSQ44.2 +044400 MOVE 0 TO RECORDS-COUNT, RECORDS-IN-ERROR. OBSQ44.2 +044500 OPEN INPUT SQ-FS3. OBSQ44.2 +044600 SEQ-TEST-002. OBSQ44.2 +044700 READ SQ-FS3 AT END GO TO SEQ-TEST-002-01. OBSQ44.2 +044800 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ44.2 +044900 ADD 1 TO RECORDS-COUNT. OBSQ44.2 +045000 IF RECORDS-COUNT GREATER THAN 750 OBSQ44.2 +045100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ44.2 +045200 GO TO SEQ-FAIL-002. OBSQ44.2 +045300 IF RECORDS-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ44.2 +045400 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +045500 GO TO SEQ-TEST-002. OBSQ44.2 +045600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" OBSQ44.2 +045700 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +045800 GO TO SEQ-TEST-002. OBSQ44.2 +045900 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "CH" OBSQ44.2 +046000 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +046100 GO TO SEQ-TEST-002. OBSQ44.2 +046200 IF XBLOCK-SIZE (1) NOT EQUAL TO 1200 OBSQ44.2 +046300 ADD 1 TO RECORDS-IN-ERROR. OBSQ44.2 +046400 GO TO SEQ-TEST-002. OBSQ44.2 +046500 SEQ-TEST-002-01. OBSQ44.2 +046600 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ44.2 +046700 GO TO SEQ-PASS-002. OBSQ44.2 +046800 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. OBSQ44.2 +046900 SEQ-FAIL-002. OBSQ44.2 +047000 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ44.2 +047100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ44.2 +047200 PERFORM FAIL. OBSQ44.2 +047300 GO TO SEQ-WRITE-002. OBSQ44.2 +047400 SEQ-PASS-002. OBSQ44.2 +047500 PERFORM PASS. OBSQ44.2 +047600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ44.2 +047700 MOVE RECORDS-COUNT TO CORRECT-18V0. OBSQ44.2 +047800 SEQ-WRITE-002. OBSQ44.2 +047900 MOVE "SEQ-TEST-002" TO PAR-NAME. OBSQ44.2 +048000 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. OBSQ44.2 +048100 PERFORM PRINT-DETAIL. OBSQ44.2 +048200 SEQ-CLOSE-002. OBSQ44.2 +048300 CLOSE SQ-FS3. OBSQ44.2 +048400 SEQ-INIT-003. OBSQ44.2 +048500* THIS TEST READS AND VALIDATES FILE SQ-FS2. OBSQ44.2 +048600 MOVE 0 TO RECORDS-COUNT, RECORDS-IN-ERROR. OBSQ44.2 +048700 OPEN INPUT SQ-FS2. OBSQ44.2 +048800 SEQ-TEST-003. OBSQ44.2 +048900 READ SQ-FS2 AT END GO TO SEQ-TEST-003-01. OBSQ44.2 +049000 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ44.2 +049100 ADD 1 TO RECORDS-COUNT. OBSQ44.2 +049200 IF RECORDS-COUNT GREATER THAN 750 OBSQ44.2 +049300 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ44.2 +049400 GO TO SEQ-FAIL-003. OBSQ44.2 +049500 IF RECORDS-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ44.2 +049600 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +049700 GO TO SEQ-TEST-003. OBSQ44.2 +049800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS2" OBSQ44.2 +049900 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +050000 GO TO SEQ-TEST-003. OBSQ44.2 +050100 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ44.2 +050200 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +050300 GO TO SEQ-TEST-003. OBSQ44.2 +050400 IF XBLOCK-SIZE (1) NOT EQUAL TO 5 OBSQ44.2 +050500 ADD 1 TO RECORDS-IN-ERROR. OBSQ44.2 +050600 GO TO SEQ-TEST-003. OBSQ44.2 +050700 SEQ-TEST-003-01. OBSQ44.2 +050800 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ44.2 +050900 GO TO SEQ-PASS-003. OBSQ44.2 +051000 MOVE "ERRORS IN READING SQ-FS2" TO RE-MARK. OBSQ44.2 +051100 SEQ-FAIL-003. OBSQ44.2 +051200 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ44.2 +051300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ44.2 +051400 PERFORM FAIL. OBSQ44.2 +051500 GO TO SEQ-WRITE-003. OBSQ44.2 +051600 SEQ-PASS-003. OBSQ44.2 +051700 PERFORM PASS. OBSQ44.2 +051800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ44.2 +051900 MOVE RECORDS-COUNT TO CORRECT-18V0. OBSQ44.2 +052000 SEQ-WRITE-003. OBSQ44.2 +052100 MOVE "SEQ-TEST-003" TO PAR-NAME. OBSQ44.2 +052200 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. OBSQ44.2 +052300 PERFORM PRINT-DETAIL. OBSQ44.2 +052400 SEQ-CLOSE-003. OBSQ44.2 +052500 CLOSE SQ-FS2. OBSQ44.2 +052600 SEQ-INIT-004. OBSQ44.2 +052700* THIS TEST READS AND VALIDATES FILE SQ-FS4. OBSQ44.2 +052800 MOVE 0 TO RECORDS-COUNT, RECORDS-IN-ERROR. OBSQ44.2 +052900 OPEN INPUT SQ-FS4. OBSQ44.2 +053000 SEQ-TEST-004. OBSQ44.2 +053100 READ SQ-FS4 AT END GO TO SEQ-TEST-004-01. OBSQ44.2 +053200 MOVE SQ-FS4R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ44.2 +053300 ADD 1 TO RECORDS-COUNT. OBSQ44.2 +053400 IF RECORDS-COUNT GREATER THAN 750 OBSQ44.2 +053500 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ44.2 +053600 GO TO SEQ-FAIL-004. OBSQ44.2 +053700 IF RECORDS-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ44.2 +053800 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +053900 GO TO SEQ-TEST-004. OBSQ44.2 +054000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS4" OBSQ44.2 +054100 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +054200 GO TO SEQ-TEST-004. OBSQ44.2 +054300 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ44.2 +054400 ADD 1 TO RECORDS-IN-ERROR OBSQ44.2 +054500 GO TO SEQ-TEST-004. OBSQ44.2 +054600 IF XBLOCK-SIZE (1) NOT EQUAL TO 10 OBSQ44.2 +054700 ADD 1 TO RECORDS-IN-ERROR. OBSQ44.2 +054800 GO TO SEQ-TEST-004. OBSQ44.2 +054900 SEQ-TEST-004-01. OBSQ44.2 +055000 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ44.2 +055100 GO TO SEQ-PASS-004. OBSQ44.2 +055200 MOVE "ERRORS IN READING SQ-FS4" TO RE-MARK. OBSQ44.2 +055300 SEQ-FAIL-004. OBSQ44.2 +055400 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ44.2 +055500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ44.2 +055600 PERFORM FAIL. OBSQ44.2 +055700 GO TO SEQ-WRITE-004. OBSQ44.2 +055800 SEQ-PASS-004. OBSQ44.2 +055900 PERFORM PASS. OBSQ44.2 +056000 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ44.2 +056100 MOVE RECORDS-COUNT TO CORRECT-18V0. OBSQ44.2 +056200 SEQ-WRITE-004. OBSQ44.2 +056300 MOVE "SEQ-TEST-004" TO PAR-NAME. OBSQ44.2 +056400 MOVE "VERIFY FILE SQ-FS4" TO FEATURE. OBSQ44.2 +056500 PERFORM PRINT-DETAIL. OBSQ44.2 +056600 SEQ-CLOSE-004. OBSQ44.2 +056700 CLOSE SQ-FS4. OBSQ44.2 +056800 OBSQ4A-END-ROUTINE. OBSQ44.2 +056900 MOVE "END OF OBSQ4A VALIDATION TESTS" TO PRINT-REC. OBSQ44.2 +057000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. OBSQ44.2 +057100 GO TO CCVS-EXIT. OBSQ44.2 +057200 CCVS-EXIT SECTION. OBSQ44.2 +057300 CCVS-999999. OBSQ44.2 +057400 GO TO CLOSE-FILES. OBSQ44.2 diff --git a/tests/cobol85/OB/OBSQ5A.SUB b/tests/cobol85/OB/OBSQ5A.SUB new file mode 100755 index 00000000..d4f6e435 --- /dev/null +++ b/tests/cobol85/OB/OBSQ5A.SUB @@ -0,0 +1,626 @@ +000100 IDENTIFICATION DIVISION. OBSQ54.2 +000200 PROGRAM-ID. OBSQ54.2 +000300 OBSQ5A. OBSQ54.2 +000400**************************************************************** OBSQ54.2 +000500* * OBSQ54.2 +000600* VALIDATION FOR:- * OBSQ54.2 +000700* " HIGH ". OBSQ54.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * OBSQ54.2 +000900* * OBSQ54.2 +001000* CREATION DATE / VALIDATION DATE * OBSQ54.2 +001100* "4.2 ". OBSQ54.2 +001200* * OBSQ54.2 +001300* THE ROUTINE OBSQ5A TESTS THE USE OF THE MULTIPLE FILE OBSQ54.2 +001400* CLAUSE BY READING AND VALIDATING THE TWO MULTIPLE FILE TAPES OBSQ54.2 +001500* CREATED IN OBSQ3A. TAPE ONE IS PROCESSED USING THE MULTIPLE OBSQ54.2 +001600* FILE CLAUSE WITH POSITION PHRASE. ONLY FILE SQ-FS3 IS OBSQ54.2 +001700* SPECIFIED AND PROCESSED FROM THIS TAPE. TAPE TWO IS OBSQ54.2 +001800* PROCESSED USING THE MULTIPLE FILE CLAUSE WITHOUT THE OBSQ54.2 +001900* POSITION PHRASE. ALL FOUR FILES ON THIS TAPE ARE PROCESSED. OBSQ54.2 +002000* THESE FILES WERE CREATED USING A MULTIPLE FILE CLAUSE WITH OBSQ54.2 +002100* POSITION PHRASE. OBSQ54.2 +002200 ENVIRONMENT DIVISION. OBSQ54.2 +002300 CONFIGURATION SECTION. OBSQ54.2 +002400 SOURCE-COMPUTER. OBSQ54.2 +002500 Linux. OBSQ54.2 +002600 OBJECT-COMPUTER. OBSQ54.2 +002700 Linux. OBSQ54.2 +002800 INPUT-OUTPUT SECTION. OBSQ54.2 +002900 FILE-CONTROL. OBSQ54.2 +003000*P SELECT RAW-DATA ASSIGN TO OBSQ54.2 +003100*P "XXXXX062" OBSQ54.2 +003200*P ORGANIZATION IS INDEXED OBSQ54.2 +003300*P ACCESS MODE IS RANDOM OBSQ54.2 +003400*P RECORD KEY IS RAW-DATA-KEY. OBSQ54.2 +003500 SELECT PRINT-FILE ASSIGN TO OBSQ54.2 +003600 "report.log". OBSQ54.2 +003700 SELECT SQ-FS3 ASSIGN TO OBSQ54.2 +003800 "XXXXX009". OBSQ54.2 +003900 SELECT SQ-FS5 ASSIGN TO OBSQ54.2 +004000 "XXXXX005". OBSQ54.2 +004100 SELECT SQ-FS6 ASSIGN TO OBSQ54.2 +004200 "XXXXX011". OBSQ54.2 +004300 SELECT SQ-FS7 ASSIGN TO OBSQ54.2 +004400 "XXXXX012". OBSQ54.2 +004500 SELECT SQ-FS8 ASSIGN TO OBSQ54.2 +004600 "XXXXX013". OBSQ54.2 +004700 I-O-CONTROL. OBSQ54.2 +004800 MULTIPLE FILE TAPE CONTAINS SQ-FS3 POSITION 3; OBSQ54.2 +004900 MULTIPLE FILE TAPE SQ-FS5, OBSQ54.2 +005000 SQ-FS6, OBSQ54.2 +005100 SQ-FS7, OBSQ54.2 +005200 SQ-FS8. OBSQ54.2 +005300 DATA DIVISION. OBSQ54.2 +005400 FILE SECTION. OBSQ54.2 +005500*P OBSQ54.2 +005600*PD RAW-DATA. OBSQ54.2 +005700*P OBSQ54.2 +005800*P1 RAW-DATA-SATZ. OBSQ54.2 +005900*P 05 RAW-DATA-KEY PIC X(6). OBSQ54.2 +006000*P 05 C-DATE PIC 9(6). OBSQ54.2 +006100*P 05 C-TIME PIC 9(8). OBSQ54.2 +006200*P 05 C-NO-OF-TESTS PIC 99. OBSQ54.2 +006300*P 05 C-OK PIC 999. OBSQ54.2 +006400*P 05 C-ALL PIC 999. OBSQ54.2 +006500*P 05 C-FAIL PIC 999. OBSQ54.2 +006600*P 05 C-DELETED PIC 999. OBSQ54.2 +006700*P 05 C-INSPECT PIC 999. OBSQ54.2 +006800*P 05 C-NOTE PIC X(13). OBSQ54.2 +006900*P 05 C-INDENT PIC X. OBSQ54.2 +007000*P 05 C-ABORT PIC X(8). OBSQ54.2 +007100 FD PRINT-FILE. OBSQ54.2 +007200 01 PRINT-REC PICTURE X(120). OBSQ54.2 +007300 01 DUMMY-RECORD PICTURE X(120). OBSQ54.2 +007400 FD SQ-FS3 OBSQ54.2 +007500 LABEL RECORD IS STANDARD OBSQ54.2 +007600 RECORD CONTAINS 120 CHARACTERS OBSQ54.2 +007700 BLOCK CONTAINS 1200 CHARACTERS. OBSQ54.2 +007800 01 SQ-FS3R1-F-G-120 PIC X(120). OBSQ54.2 +007900 FD SQ-FS5 OBSQ54.2 +008000 LABEL RECORD STANDARD OBSQ54.2 +008100 BLOCK CONTAINS 5 RECORDS. OBSQ54.2 +008200 01 SQ-FS5R1-F-G-120 PIC X(120). OBSQ54.2 +008300 FD SQ-FS6 OBSQ54.2 +008400 LABEL RECORD STANDARD OBSQ54.2 +008500 BLOCK CONTAINS 10 RECORDS. OBSQ54.2 +008600 01 SQ-FS6R1-F-G-120 PIC X(120). OBSQ54.2 +008700 FD SQ-FS7 OBSQ54.2 +008800 LABEL RECORD STANDARD OBSQ54.2 +008900 BLOCK CONTAINS 2400 CHARACTERS. OBSQ54.2 +009000 01 SQ-FS7R1-F-G-120 PIC X(120). OBSQ54.2 +009100 FD SQ-FS8 OBSQ54.2 +009200 LABEL RECORD STANDARD OBSQ54.2 +009300 RECORD 120 OBSQ54.2 +009400 BLOCK CONTAINS 120 CHARACTERS. OBSQ54.2 +009500 01 SQ-FS8R1-F-G-120 PIC X(120). OBSQ54.2 +009600 WORKING-STORAGE SECTION. OBSQ54.2 +009700 77 COUNT-OF-RECS PICTURE 999 VALUE 0. OBSQ54.2 +009800 77 RECORDS-IN-ERROR PIC 999 VALUE 0. OBSQ54.2 +009900 01 FILE-RECORD-INFORMATION-REC. OBSQ54.2 +010000 03 FILE-RECORD-INFO-SKELETON. OBSQ54.2 +010100 05 FILLER PICTURE X(48) VALUE OBSQ54.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBSQ54.2 +010300 05 FILLER PICTURE X(46) VALUE OBSQ54.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBSQ54.2 +010500 05 FILLER PICTURE X(26) VALUE OBSQ54.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". OBSQ54.2 +010700 05 FILLER PICTURE X(37) VALUE OBSQ54.2 +010800 ",RECKEY= ". OBSQ54.2 +010900 05 FILLER PICTURE X(38) VALUE OBSQ54.2 +011000 ",ALTKEY1= ". OBSQ54.2 +011100 05 FILLER PICTURE X(38) VALUE OBSQ54.2 +011200 ",ALTKEY2= ". OBSQ54.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.OBSQ54.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBSQ54.2 +011500 05 FILE-RECORD-INFO-P1-120. OBSQ54.2 +011600 07 FILLER PIC X(5). OBSQ54.2 +011700 07 XFILE-NAME PIC X(6). OBSQ54.2 +011800 07 FILLER PIC X(8). OBSQ54.2 +011900 07 XRECORD-NAME PIC X(6). OBSQ54.2 +012000 07 FILLER PIC X(1). OBSQ54.2 +012100 07 REELUNIT-NUMBER PIC 9(1). OBSQ54.2 +012200 07 FILLER PIC X(7). OBSQ54.2 +012300 07 XRECORD-NUMBER PIC 9(6). OBSQ54.2 +012400 07 FILLER PIC X(6). OBSQ54.2 +012500 07 UPDATE-NUMBER PIC 9(2). OBSQ54.2 +012600 07 FILLER PIC X(5). OBSQ54.2 +012700 07 ODO-NUMBER PIC 9(4). OBSQ54.2 +012800 07 FILLER PIC X(5). OBSQ54.2 +012900 07 XPROGRAM-NAME PIC X(5). OBSQ54.2 +013000 07 FILLER PIC X(7). OBSQ54.2 +013100 07 XRECORD-LENGTH PIC 9(6). OBSQ54.2 +013200 07 FILLER PIC X(7). OBSQ54.2 +013300 07 CHARS-OR-RECORDS PIC X(2). OBSQ54.2 +013400 07 FILLER PIC X(1). OBSQ54.2 +013500 07 XBLOCK-SIZE PIC 9(4). OBSQ54.2 +013600 07 FILLER PIC X(6). OBSQ54.2 +013700 07 RECORDS-IN-FILE PIC 9(6). OBSQ54.2 +013800 07 FILLER PIC X(5). OBSQ54.2 +013900 07 XFILE-ORGANIZATION PIC X(2). OBSQ54.2 +014000 07 FILLER PIC X(6). OBSQ54.2 +014100 07 XLABEL-TYPE PIC X(1). OBSQ54.2 +014200 05 FILE-RECORD-INFO-P121-240. OBSQ54.2 +014300 07 FILLER PIC X(8). OBSQ54.2 +014400 07 XRECORD-KEY PIC X(29). OBSQ54.2 +014500 07 FILLER PIC X(9). OBSQ54.2 +014600 07 ALTERNATE-KEY1 PIC X(29). OBSQ54.2 +014700 07 FILLER PIC X(9). OBSQ54.2 +014800 07 ALTERNATE-KEY2 PIC X(29). OBSQ54.2 +014900 07 FILLER PIC X(7). OBSQ54.2 +015000 01 TEST-RESULTS. OBSQ54.2 +015100 02 FILLER PICTURE X VALUE SPACE. OBSQ54.2 +015200 02 FEATURE PICTURE X(20) VALUE SPACE. OBSQ54.2 +015300 02 FILLER PICTURE X VALUE SPACE. OBSQ54.2 +015400 02 P-OR-F PICTURE X(5) VALUE SPACE. OBSQ54.2 +015500 02 FILLER PICTURE X VALUE SPACE. OBSQ54.2 +015600 02 PAR-NAME. OBSQ54.2 +015700 03 FILLER PICTURE X(12) VALUE SPACE. OBSQ54.2 +015800 03 PARDOT-X PICTURE X VALUE SPACE. OBSQ54.2 +015900 03 DOTVALUE PICTURE 99 VALUE ZERO. OBSQ54.2 +016000 03 FILLER PIC X(5) VALUE SPACE. OBSQ54.2 +016100 02 FILLER PIC X(10) VALUE SPACE. OBSQ54.2 +016200 02 RE-MARK PIC X(61). OBSQ54.2 +016300 01 TEST-COMPUTED. OBSQ54.2 +016400 02 FILLER PIC X(30) VALUE SPACE. OBSQ54.2 +016500 02 FILLER PIC X(17) VALUE " COMPUTED=". OBSQ54.2 +016600 02 COMPUTED-X. OBSQ54.2 +016700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. OBSQ54.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). OBSQ54.2 +016900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). OBSQ54.2 +017000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). OBSQ54.2 +017100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). OBSQ54.2 +017200 03 CM-18V0 REDEFINES COMPUTED-A. OBSQ54.2 +017300 04 COMPUTED-18V0 PICTURE -9(18). OBSQ54.2 +017400 04 FILLER PICTURE X. OBSQ54.2 +017500 03 FILLER PIC X(50) VALUE SPACE. OBSQ54.2 +017600 01 TEST-CORRECT. OBSQ54.2 +017700 02 FILLER PIC X(30) VALUE SPACE. OBSQ54.2 +017800 02 FILLER PIC X(17) VALUE " CORRECT =". OBSQ54.2 +017900 02 CORRECT-X. OBSQ54.2 +018000 03 CORRECT-A PICTURE X(20) VALUE SPACE. OBSQ54.2 +018100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). OBSQ54.2 +018200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). OBSQ54.2 +018300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). OBSQ54.2 +018400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). OBSQ54.2 +018500 03 CR-18V0 REDEFINES CORRECT-A. OBSQ54.2 +018600 04 CORRECT-18V0 PICTURE -9(18). OBSQ54.2 +018700 04 FILLER PICTURE X. OBSQ54.2 +018800 03 FILLER PIC X(50) VALUE SPACE. OBSQ54.2 +018900 01 CCVS-C-1. OBSQ54.2 +019000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PAOBSQ54.2 +019100- "SS PARAGRAPH-NAME OBSQ54.2 +019200- " REMARKS". OBSQ54.2 +019300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. OBSQ54.2 +019400 01 CCVS-C-2. OBSQ54.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ54.2 +019600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". OBSQ54.2 +019700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. OBSQ54.2 +019800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". OBSQ54.2 +019900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. OBSQ54.2 +020000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. OBSQ54.2 +020100 01 REC-CT PICTURE 99 VALUE ZERO. OBSQ54.2 +020200 01 DELETE-CNT PICTURE 999 VALUE ZERO. OBSQ54.2 +020300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. OBSQ54.2 +020400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBSQ54.2 +020500 01 PASS-COUNTER PIC 999 VALUE ZERO. OBSQ54.2 +020600 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBSQ54.2 +020700 01 ERROR-HOLD PIC 999 VALUE ZERO. OBSQ54.2 +020800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBSQ54.2 +020900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBSQ54.2 +021000 01 REC-COUNT PIC 9(5) VALUE ZERO. OBSQ54.2 +021100 01 CCVS-H-1. OBSQ54.2 +021200 02 FILLER PICTURE X(27) VALUE SPACE. OBSQ54.2 +021300 02 FILLER PICTURE X(67) VALUE OBSQ54.2 +021400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION OBSQ54.2 +021500- " SYSTEM". OBSQ54.2 +021600 02 FILLER PICTURE X(26) VALUE SPACE. OBSQ54.2 +021700 01 CCVS-H-2. OBSQ54.2 +021800 02 FILLER PICTURE X(52) VALUE IS OBSQ54.2 +021900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". OBSQ54.2 +022000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". OBSQ54.2 +022100 02 TEST-ID PICTURE IS X(9). OBSQ54.2 +022200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. OBSQ54.2 +022300 01 CCVS-H-3. OBSQ54.2 +022400 02 FILLER PICTURE X(34) VALUE OBSQ54.2 +022500 " FOR OFFICIAL USE ONLY ". OBSQ54.2 +022600 02 FILLER PICTURE X(58) VALUE OBSQ54.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBSQ54.2 +022800 02 FILLER PICTURE X(28) VALUE OBSQ54.2 +022900 " COPYRIGHT 1985 ". OBSQ54.2 +023000 01 CCVS-E-1. OBSQ54.2 +023100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. OBSQ54.2 +023200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". OBSQ54.2 +023300 02 ID-AGAIN PICTURE IS X(9). OBSQ54.2 +023400 02 FILLER PICTURE X(45) VALUE IS OBSQ54.2 +023500 " NTIS DISTRIBUTION COBOL 85". OBSQ54.2 +023600 01 CCVS-E-2. OBSQ54.2 +023700 02 FILLER PICTURE X(31) VALUE OBSQ54.2 +023800 SPACE. OBSQ54.2 +023900 02 FILLER PICTURE X(21) VALUE SPACE. OBSQ54.2 +024000 02 CCVS-E-2-2. OBSQ54.2 +024100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. OBSQ54.2 +024200 03 FILLER PICTURE IS X VALUE IS SPACE. OBSQ54.2 +024300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". OBSQ54.2 +024400 01 CCVS-E-3. OBSQ54.2 +024500 02 FILLER PICTURE X(22) VALUE OBSQ54.2 +024600 " FOR OFFICIAL USE ONLY". OBSQ54.2 +024700 02 FILLER PICTURE X(12) VALUE SPACE. OBSQ54.2 +024800 02 FILLER PICTURE X(58) VALUE OBSQ54.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBSQ54.2 +025000 02 FILLER PICTURE X(13) VALUE SPACE. OBSQ54.2 +025100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". OBSQ54.2 +025200 01 CCVS-E-4. OBSQ54.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBSQ54.2 +025400 02 FILLER PIC XXXX VALUE " OF ". OBSQ54.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBSQ54.2 +025600 02 FILLER PIC X(40) VALUE OBSQ54.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". OBSQ54.2 +025800 01 XXINFO. OBSQ54.2 +025900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". OBSQ54.2 +026000 02 INFO-TEXT. OBSQ54.2 +026100 04 FILLER PIC X(20) VALUE SPACE. OBSQ54.2 +026200 04 XXCOMPUTED PIC X(20). OBSQ54.2 +026300 04 FILLER PIC X(5) VALUE SPACE. OBSQ54.2 +026400 04 XXCORRECT PIC X(20). OBSQ54.2 +026500 01 HYPHEN-LINE. OBSQ54.2 +026600 02 FILLER PICTURE IS X VALUE IS SPACE. OBSQ54.2 +026700 02 FILLER PICTURE IS X(65) VALUE IS "************************OBSQ54.2 +026800- "*****************************************". OBSQ54.2 +026900 02 FILLER PICTURE IS X(54) VALUE IS "************************OBSQ54.2 +027000- "******************************". OBSQ54.2 +027100 01 CCVS-PGM-ID PIC X(6) VALUE OBSQ54.2 +027200 "OBSQ5A". OBSQ54.2 +027300 PROCEDURE DIVISION. OBSQ54.2 +027400 CCVS1 SECTION. OBSQ54.2 +027500 OPEN-FILES. OBSQ54.2 +027600*P OPEN I-O RAW-DATA. OBSQ54.2 +027700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ54.2 +027800*P READ RAW-DATA INVALID KEY GO TO END-E-1. OBSQ54.2 +027900*P MOVE "ABORTED " TO C-ABORT. OBSQ54.2 +028000*P ADD 1 TO C-NO-OF-TESTS. OBSQ54.2 +028100*P ACCEPT C-DATE FROM DATE. OBSQ54.2 +028200*P ACCEPT C-TIME FROM TIME. OBSQ54.2 +028300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. OBSQ54.2 +028400*PND-E-1. OBSQ54.2 +028500*P CLOSE RAW-DATA. OBSQ54.2 +028600 OPEN OUTPUT PRINT-FILE. OBSQ54.2 +028700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBSQ54.2 +028800 MOVE SPACE TO TEST-RESULTS. OBSQ54.2 +028900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBSQ54.2 +029000 MOVE ZERO TO REC-SKL-SUB. OBSQ54.2 +029100 PERFORM CCVS-INIT-FILE 9 TIMES. OBSQ54.2 +029200 CCVS-INIT-FILE. OBSQ54.2 +029300 ADD 1 TO REC-SKL-SUB. OBSQ54.2 +029400 MOVE FILE-RECORD-INFO-SKELETON TO OBSQ54.2 +029500 FILE-RECORD-INFO (REC-SKL-SUB). OBSQ54.2 +029600 CCVS-INIT-EXIT. OBSQ54.2 +029700 GO TO CCVS1-EXIT. OBSQ54.2 +029800 CLOSE-FILES. OBSQ54.2 +029900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBSQ54.2 +030000*P OPEN I-O RAW-DATA. OBSQ54.2 +030100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. OBSQ54.2 +030200*P READ RAW-DATA INVALID KEY GO TO END-E-2. OBSQ54.2 +030300*P MOVE "OK. " TO C-ABORT. OBSQ54.2 +030400*P MOVE PASS-COUNTER TO C-OK. OBSQ54.2 +030500*P MOVE ERROR-HOLD TO C-ALL. OBSQ54.2 +030600*P MOVE ERROR-COUNTER TO C-FAIL. OBSQ54.2 +030700*P MOVE DELETE-CNT TO C-DELETED. OBSQ54.2 +030800*P MOVE INSPECT-COUNTER TO C-INSPECT. OBSQ54.2 +030900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. OBSQ54.2 +031000*PND-E-2. OBSQ54.2 +031100*P CLOSE RAW-DATA. OBSQ54.2 +031200 TERMINATE-CCVS. OBSQ54.2 +031300*S EXIT PROGRAM. OBSQ54.2 +031400*SERMINATE-CALL. OBSQ54.2 +031500 STOP RUN. OBSQ54.2 +031600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBSQ54.2 +031700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBSQ54.2 +031800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBSQ54.2 +031900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. OBSQ54.2 +032000 MOVE "****TEST DELETED****" TO RE-MARK. OBSQ54.2 +032100 PRINT-DETAIL. OBSQ54.2 +032200 IF REC-CT NOT EQUAL TO ZERO OBSQ54.2 +032300 MOVE "." TO PARDOT-X OBSQ54.2 +032400 MOVE REC-CT TO DOTVALUE. OBSQ54.2 +032500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBSQ54.2 +032600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBSQ54.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBSQ54.2 +032800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBSQ54.2 +032900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBSQ54.2 +033000 MOVE SPACE TO CORRECT-X. OBSQ54.2 +033100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBSQ54.2 +033200 MOVE SPACE TO RE-MARK. OBSQ54.2 +033300 HEAD-ROUTINE. OBSQ54.2 +033400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +033500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. OBSQ54.2 +033600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBSQ54.2 +033700 COLUMN-NAMES-ROUTINE. OBSQ54.2 +033800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +033900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +034000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +034100 END-ROUTINE. OBSQ54.2 +034200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBSQ54.2 +034300 END-RTN-EXIT. OBSQ54.2 +034400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +034500 END-ROUTINE-1. OBSQ54.2 +034600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBSQ54.2 +034700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. OBSQ54.2 +034800 ADD PASS-COUNTER TO ERROR-HOLD. OBSQ54.2 +034900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBSQ54.2 +035000 MOVE PASS-COUNTER TO CCVS-E-4-1. OBSQ54.2 +035100 MOVE ERROR-HOLD TO CCVS-E-4-2. OBSQ54.2 +035200 MOVE CCVS-E-4 TO CCVS-E-2-2. OBSQ54.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBSQ54.2 +035400 END-ROUTINE-12. OBSQ54.2 +035500 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBSQ54.2 +035600 IF ERROR-COUNTER IS EQUAL TO ZERO OBSQ54.2 +035700 MOVE "NO " TO ERROR-TOTAL OBSQ54.2 +035800 ELSE OBSQ54.2 +035900 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBSQ54.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. OBSQ54.2 +036100 PERFORM WRITE-LINE. OBSQ54.2 +036200 END-ROUTINE-13. OBSQ54.2 +036300 IF DELETE-CNT IS EQUAL TO ZERO OBSQ54.2 +036400 MOVE "NO " TO ERROR-TOTAL ELSE OBSQ54.2 +036500 MOVE DELETE-CNT TO ERROR-TOTAL. OBSQ54.2 +036600 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBSQ54.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +036800 IF INSPECT-COUNTER EQUAL TO ZERO OBSQ54.2 +036900 MOVE "NO " TO ERROR-TOTAL OBSQ54.2 +037000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBSQ54.2 +037100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBSQ54.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +037300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBSQ54.2 +037400 WRITE-LINE. OBSQ54.2 +037500 ADD 1 TO RECORD-COUNT. OBSQ54.2 +037600 IF RECORD-COUNT GREATER 50 OBSQ54.2 +037700 MOVE DUMMY-RECORD TO DUMMY-HOLD OBSQ54.2 +037800 MOVE SPACE TO DUMMY-RECORD OBSQ54.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBSQ54.2 +038000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBSQ54.2 +038100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBSQ54.2 +038200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBSQ54.2 +038300 MOVE DUMMY-HOLD TO DUMMY-RECORD OBSQ54.2 +038400 MOVE ZERO TO RECORD-COUNT. OBSQ54.2 +038500 PERFORM WRT-LN. OBSQ54.2 +038600 WRT-LN. OBSQ54.2 +038700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBSQ54.2 +038800 MOVE SPACE TO DUMMY-RECORD. OBSQ54.2 +038900 BLANK-LINE-PRINT. OBSQ54.2 +039000 PERFORM WRT-LN. OBSQ54.2 +039100 FAIL-ROUTINE. OBSQ54.2 +039200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ54.2 +039300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBSQ54.2 +039400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBSQ54.2 +039500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +039600 GO TO FAIL-ROUTINE-EX. OBSQ54.2 +039700 FAIL-ROUTINE-WRITE. OBSQ54.2 +039800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBSQ54.2 +039900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +040000 FAIL-ROUTINE-EX. EXIT. OBSQ54.2 +040100 BAIL-OUT. OBSQ54.2 +040200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBSQ54.2 +040300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBSQ54.2 +040400 BAIL-OUT-WRITE. OBSQ54.2 +040500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBSQ54.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBSQ54.2 +040700 BAIL-OUT-EX. EXIT. OBSQ54.2 +040800 CCVS1-EXIT. OBSQ54.2 +040900 EXIT. OBSQ54.2 +041000 SECT-OBSQ5A-0001 SECTION. OBSQ54.2 +041100 SEQ-INIT-001. OBSQ54.2 +041200 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +041300 OPEN INPUT SQ-FS3. OBSQ54.2 +041400 SEQ-TEST-001. OBSQ54.2 +041500 READ SQ-FS3 AT END GO TO SEQ-TEST-001-01. OBSQ54.2 +041600 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +041700 ADD 1 TO REC-COUNT. OBSQ54.2 +041800 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +041900 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +042000 GO TO SEQ-FAIL-001. OBSQ54.2 +042100 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +042200 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +042300 GO TO SEQ-TEST-001. OBSQ54.2 +042400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" OBSQ54.2 +042500 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +042600 GO TO SEQ-TEST-001. OBSQ54.2 +042700 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "CH" OBSQ54.2 +042800 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +042900 GO TO SEQ-TEST-001. OBSQ54.2 +043000 IF XBLOCK-SIZE (1) NOT EQUAL TO 1200 OBSQ54.2 +043100 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +043200 GO TO SEQ-TEST-001. OBSQ54.2 +043300 SEQ-TEST-001-01. OBSQ54.2 +043400 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +043500 GO TO SEQ-PASS-001. OBSQ54.2 +043600 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. OBSQ54.2 +043700 SEQ-FAIL-001. OBSQ54.2 +043800 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +043900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +044000 PERFORM FAIL. OBSQ54.2 +044100 GO TO SEQ-WRITE-001. OBSQ54.2 +044200 SEQ-PASS-001. OBSQ54.2 +044300 PERFORM PASS. OBSQ54.2 +044400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +044500 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +044600 SEQ-WRITE-001. OBSQ54.2 +044700 MOVE "SEQ-TEST-001" TO PAR-NAME. OBSQ54.2 +044800 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. OBSQ54.2 +044900 PERFORM PRINT-DETAIL. OBSQ54.2 +045000 SEQ-CLOSE-001. OBSQ54.2 +045100 CLOSE SQ-FS3. OBSQ54.2 +045200 SEQ-INIT-002. OBSQ54.2 +045300* THIS TEST READS AND VALIDATES FILE SQ-FS5. OBSQ54.2 +045400 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +045500 OPEN INPUT SQ-FS5. OBSQ54.2 +045600 SEQ-TEST-002. OBSQ54.2 +045700 READ SQ-FS5 AT END GO TO SEQ-TEST-002-01. OBSQ54.2 +045800 MOVE SQ-FS5R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +045900 ADD 1 TO REC-COUNT. OBSQ54.2 +046000 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +046100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +046200 GO TO SEQ-FAIL-002. OBSQ54.2 +046300 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +046400 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +046500 GO TO SEQ-TEST-002. OBSQ54.2 +046600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" OBSQ54.2 +046700 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +046800 GO TO SEQ-TEST-002. OBSQ54.2 +046900 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ54.2 +047000 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +047100 GO TO SEQ-TEST-002. OBSQ54.2 +047200 IF XBLOCK-SIZE (1) NOT EQUAL TO 5 OBSQ54.2 +047300 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +047400 GO TO SEQ-TEST-002. OBSQ54.2 +047500 SEQ-TEST-002-01. OBSQ54.2 +047600 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +047700 GO TO SEQ-PASS-002. OBSQ54.2 +047800 MOVE "ERRORS IN READINGS SQ-FS5" TO RE-MARK. OBSQ54.2 +047900 SEQ-FAIL-002. OBSQ54.2 +048000 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +048100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +048200 PERFORM FAIL. OBSQ54.2 +048300 GO TO SEQ-WRITE-002. OBSQ54.2 +048400 SEQ-PASS-002. OBSQ54.2 +048500 PERFORM PASS. OBSQ54.2 +048600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +048700 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +048800 SEQ-WRITE-002. OBSQ54.2 +048900 MOVE "SEQ-TEST-002" TO PAR-NAME. OBSQ54.2 +049000 MOVE "VERIFY FILE SQ-FS5" TO FEATURE OBSQ54.2 +049100 PERFORM PRINT-DETAIL. OBSQ54.2 +049200 SEQ-CLOSE-002. OBSQ54.2 +049300 CLOSE SQ-FS5 WITH NO REWIND. OBSQ54.2 +049400 SEQ-INIT-003. OBSQ54.2 +049500* THIS TEST READS AND VALIDATES FILE SQ-FS6. OBSQ54.2 +049600 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +049700 OPEN INPUT SQ-FS6 WITH NO REWIND. OBSQ54.2 +049800 SEQ-TEST-003. OBSQ54.2 +049900 READ SQ-FS6 AT END GO TO SEQ-TEST-003-01. OBSQ54.2 +050000 MOVE SQ-FS6R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +050100 ADD 1 TO REC-COUNT. OBSQ54.2 +050200 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +050300 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +050400 GO TO SEQ-FAIL-003. OBSQ54.2 +050500 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +050600 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +050700 GO TO SEQ-TEST-003. OBSQ54.2 +050800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" OBSQ54.2 +050900 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +051000 GO TO SEQ-TEST-003. OBSQ54.2 +051100 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "RC" OBSQ54.2 +051200 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +051300 GO TO SEQ-TEST-003. OBSQ54.2 +051400 IF XBLOCK-SIZE (1) NOT EQUAL TO 10 OBSQ54.2 +051500 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +051600 GO TO SEQ-TEST-003. OBSQ54.2 +051700 SEQ-TEST-003-01. OBSQ54.2 +051800 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +051900 GO TO SEQ-PASS-003. OBSQ54.2 +052000 MOVE "ERRORS IN READING SQ-FS6" TO RE-MARK. OBSQ54.2 +052100 SEQ-FAIL-003. OBSQ54.2 +052200 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +052300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +052400 PERFORM FAIL. OBSQ54.2 +052500 GO TO SEQ-WRITE-003. OBSQ54.2 +052600 SEQ-PASS-003. OBSQ54.2 +052700 PERFORM PASS. OBSQ54.2 +052800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +052900 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +053000 SEQ-WRITE-003. OBSQ54.2 +053100 MOVE "SEQ-TEST-003" TO PAR-NAME. OBSQ54.2 +053200 MOVE "VERIFY FILE SQ-FS6" TO FEATURE. OBSQ54.2 +053300 PERFORM PRINT-DETAIL. OBSQ54.2 +053400 SEQ-CLOSE-003. OBSQ54.2 +053500 CLOSE SQ-FS6 WITH NO REWIND. OBSQ54.2 +053600 SEQ-INIT-004. OBSQ54.2 +053700* THIS TEST READS AND VALIDATES FILE SQ-FS7. OBSQ54.2 +053800 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +053900 OPEN INPUT SQ-FS7 WITH NO REWIND. OBSQ54.2 +054000 SEQ-TEST-004. OBSQ54.2 +054100 READ SQ-FS7 AT END GO TO SEQ-TEST-004-01. OBSQ54.2 +054200 MOVE SQ-FS7R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +054300 ADD 1 TO REC-COUNT. OBSQ54.2 +054400 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +054500 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +054600 GO TO SEQ-FAIL-004. OBSQ54.2 +054700 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +054800 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +054900 GO TO SEQ-TEST-004. OBSQ54.2 +055000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS7" OBSQ54.2 +055100 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +055200 GO TO SEQ-TEST-004. OBSQ54.2 +055300 IF CHARS-OR-RECORDS (1) NOT EQUAL "CH" OBSQ54.2 +055400 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +055500 GO TO SEQ-TEST-004. OBSQ54.2 +055600 IF XBLOCK-SIZE (1) NOT EQUAL TO 2400 OBSQ54.2 +055700 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +055800 GO TO SEQ-TEST-004. OBSQ54.2 +055900 SEQ-TEST-004-01. OBSQ54.2 +056000 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +056100 GO TO SEQ-PASS-004. OBSQ54.2 +056200 MOVE "ERRORS IN READING SQ-FS7" TO RE-MARK. OBSQ54.2 +056300 SEQ-FAIL-004. OBSQ54.2 +056400 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +056500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +056600 PERFORM FAIL. OBSQ54.2 +056700 GO TO SEQ-WRITE-004. OBSQ54.2 +056800 SEQ-PASS-004. OBSQ54.2 +056900 PERFORM PASS. OBSQ54.2 +057000 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +057100 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +057200 SEQ-WRITE-004. OBSQ54.2 +057300 MOVE "SEQ-TEST-004" TO PAR-NAME. OBSQ54.2 +057400 MOVE "VERIFY FILE SQ-FS7" TO FEATURE. OBSQ54.2 +057500 PERFORM PRINT-DETAIL. OBSQ54.2 +057600 SEQ-CLOSE-004. OBSQ54.2 +057700 CLOSE SQ-FS7 WITH NO REWIND. OBSQ54.2 +057800 SEQ-INIT-005. OBSQ54.2 +057900* THIS TEST READS AND VALIDATES FILE SQ-FS8. OBSQ54.2 +058000 MOVE 0 TO REC-COUNT, RECORDS-IN-ERROR. OBSQ54.2 +058100 OPEN INPUT SQ-FS8 WITH NO REWIND. OBSQ54.2 +058200 SEQ-TEST-005. OBSQ54.2 +058300 READ SQ-FS8 AT END GO TO SEQ-TEST-005-01. OBSQ54.2 +058400 MOVE SQ-FS8R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). OBSQ54.2 +058500 ADD 1 TO REC-COUNT. OBSQ54.2 +058600 IF REC-COUNT GREATER THAN 750 OBSQ54.2 +058700 MOVE "MORE THAN 750 RECORDS" TO RE-MARK OBSQ54.2 +058800 GO TO SEQ-FAIL-005. OBSQ54.2 +058900 IF REC-COUNT NOT EQUAL TO XRECORD-NUMBER (1) OBSQ54.2 +059000 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +059100 GO TO SEQ-TEST-005. OBSQ54.2 +059200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" OBSQ54.2 +059300 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +059400 GO TO SEQ-TEST-005. OBSQ54.2 +059500 IF CHARS-OR-RECORDS (1) NOT EQUAL TO "CH" OBSQ54.2 +059600 ADD 1 TO RECORDS-IN-ERROR OBSQ54.2 +059700 GO TO SEQ-TEST-005. OBSQ54.2 +059800 IF XBLOCK-SIZE (1) NOT EQUAL TO 120 OBSQ54.2 +059900 ADD 1 TO RECORDS-IN-ERROR. OBSQ54.2 +060000 GO TO SEQ-TEST-005. OBSQ54.2 +060100 SEQ-TEST-005-01. OBSQ54.2 +060200 IF RECORDS-IN-ERROR EQUAL TO ZERO OBSQ54.2 +060300 GO TO SEQ-PASS-005. OBSQ54.2 +060400 MOVE "ERRORS IN READING SQ-FS8" TO RE-MARK. OBSQ54.2 +060500 SEQ-FAIL-005. OBSQ54.2 +060600 MOVE "RECORDS IN ERROR" TO COMPUTED-A. OBSQ54.2 +060700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. OBSQ54.2 +060800 PERFORM FAIL. OBSQ54.2 +060900 GO TO SEQ-WRITE-005. OBSQ54.2 +061000 SEQ-PASS-005. OBSQ54.2 +061100 PERFORM PASS. OBSQ54.2 +061200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. OBSQ54.2 +061300 MOVE REC-COUNT TO CORRECT-18V0. OBSQ54.2 +061400 SEQ-WRITE-005. OBSQ54.2 +061500 MOVE "SEQ-TEST-005" TO PAR-NAME. OBSQ54.2 +061600 MOVE "VERIFY FILE SQ-FS8" TO FEATURE. OBSQ54.2 +061700 PERFORM PRINT-DETAIL. OBSQ54.2 +061800 SEQ-CLOSE-005. OBSQ54.2 +061900 CLOSE SQ-FS8. OBSQ54.2 +062000 OBSQ5A-END-ROUTINE. OBSQ54.2 +062100 MOVE "END OF OBSQ5A VALIDATION TESTS" TO PRINT-REC. OBSQ54.2 +062200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. OBSQ54.2 +062300 GO TO CCVS-EXIT. OBSQ54.2 +062400 CCVS-EXIT SECTION. OBSQ54.2 +062500 CCVS-999999. OBSQ54.2 +062600 GO TO CLOSE-FILES. OBSQ54.2 diff --git a/tests/cobol85/OB/lib/OBIC2A.CBL b/tests/cobol85/OB/lib/OBIC2A.CBL new file mode 100755 index 00000000..e5ef3d91 --- /dev/null +++ b/tests/cobol85/OB/lib/OBIC2A.CBL @@ -0,0 +1,310 @@ +000100 IDENTIFICATION DIVISION. OBIC24.2 +000200 PROGRAM-ID. OBIC24.2 +000300 OBIC2A. OBIC24.2 +000400**************************************************************** OBIC24.2 +000500* * OBIC24.2 +000600* VALIDATION FOR:- * OBIC24.2 +000700* * OBIC24.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC24.2 +000900* * OBIC24.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBIC24.2 +001100* * OBIC24.2 +001200**************************************************************** OBIC24.2 +001300* * OBIC24.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * OBIC24.2 +001500* * OBIC24.2 +001600* X-55 - SYSTEM PRINTER NAME. * OBIC24.2 +001700* X-82 - SOURCE COMPUTER NAME. * OBIC24.2 +001800* X-83 - OBJECT COMPUTER NAME. * OBIC24.2 +001900* * OBIC24.2 +002000**************************************************************** OBIC24.2 +002100* OBIC24.2 +002200* THE SUBPROGRAM IC219 TESTS THE USE OF A SORT STATEMENT OBIC24.2 +002300* IN A SEGMENTED SUBPROGRAM. THE FIRST NON-DECLARATIVE SECTIONOBIC24.2 +002400* OF THE SUBPROGRAM CONSISTS OF A SORT STATEMENT AND A STOP RUNOBIC24.2 +002500* STATEMENT IN A FIXED PERMANENT SEGMENT. THE SORT INPUT OBIC24.2 +002600* PROCEDURE AND THE SORT OUTPUT PROCEDURE ARE CONTAINED IN TWO OBIC24.2 +002700* INDEPENDENT SEGMENTS. THE MAIN PROGRAM IC218 CALLS THIS OBIC24.2 +002800* SUBPROGRAM AND THE SUBPROGRAM IC220 IS CALLED FROM THE OBIC24.2 +002900* OUTPUT PROCEDURE SECTION TO PRINT THE OUTPUT REPORT. OBIC24.2 +003000* OBIC24.2 +003100******************************************************************OBIC24.2 +003200 ENVIRONMENT DIVISION. OBIC24.2 +003300 CONFIGURATION SECTION. OBIC24.2 +003400 SOURCE-COMPUTER. OBIC24.2 +003500 Linux. OBIC24.2 +003600 OBJECT-COMPUTER. OBIC24.2 +003700 Linux. OBIC24.2 +003800 INPUT-OUTPUT SECTION. OBIC24.2 +003900 FILE-CONTROL. OBIC24.2 +004000 SELECT ST-FS1 ASSIGN TO OBIC24.2 +004100 "XXXXX027". OBIC24.2 +004200 DATA DIVISION. OBIC24.2 +004300 FILE SECTION. OBIC24.2 +004400 SD ST-FS1 OBIC24.2 +004500 DATA RECORD IS ST-FS1R1-F-G-126. OBIC24.2 +004600 01 ST-FS1R1-F-G-126. OBIC24.2 +004700 02 ST-FS1-1-120. OBIC24.2 +004800 03 FILLER PICTURE X(34). OBIC24.2 +004900 03 ST-FS1-REC-NO PICTURE 9(6). OBIC24.2 +005000 03 FILLER PICTURE X(80). OBIC24.2 +005100 02 ST-FS1-121-124 PICTURE X(4). OBIC24.2 +005200 02 ST-FS1-125-126 PICTURE 99. OBIC24.2 +005300 WORKING-STORAGE SECTION. OBIC24.2 +005400 01 TEMP1 PICTURE X(4). OBIC24.2 +005500 01 TEMP2 PICTURE 999. OBIC24.2 +005600 01 TEMP3 PICTURE 999. OBIC24.2 +005700 01 TEMP4 PICTURE 9(6). OBIC24.2 +005800 01 FAIL-COUNT PICTURE 999 VALUE ZERO. OBIC24.2 +005900 01 EOF-FLAG PICTURE 9 VALUE ZERO. OBIC24.2 +006000 01 PRINT-LINE-VALUES. OBIC24.2 +006100 02 PASS-OR-FAIL PICTURE X(5). OBIC24.2 +006200 02 R-COUNT PICTURE 99. OBIC24.2 +006300 02 FEATURE-TESTED PICTURE X(20). OBIC24.2 +006400 02 COMPUTED-SORT-KEY. OBIC24.2 +006500 03 COMPUTED-1-4 PICTURE X(4). OBIC24.2 +006600 03 COMPUTED-5-6 PICTURE 99. OBIC24.2 +006700 03 COMPUTED-7-12 PICTURE 9(6). OBIC24.2 +006800 03 FILLER PICTURE X(8) VALUE SPACE. OBIC24.2 +006900 02 CORRECT-SORT-KEY. OBIC24.2 +007000 03 CORRECT-1-4 PICTURE X(4). OBIC24.2 +007100 03 CORRECT-5-6 PICTURE 99. OBIC24.2 +007200 03 CORRECT-7-12 PICTURE 9(6). OBIC24.2 +007300 03 FILLER PICTURE X(8) VALUE SPACE. OBIC24.2 +007400 02 PARAGRAPH-NAME PICTURE X(12). OBIC24.2 +007500 01 PRINT-FLAG PICTURE 9. OBIC24.2 +007600 01 FILE-RECORD-INFORMATION-REC. OBIC24.2 +007700 03 FILE-RECORD-INFO-SKELETON. OBIC24.2 +007800 05 FILLER PICTURE X(48) VALUE OBIC24.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". OBIC24.2 +008000 05 FILLER PICTURE X(46) VALUE OBIC24.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". OBIC24.2 +008200 05 FILLER PICTURE X(26) VALUE OBIC24.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". OBIC24.2 +008400 05 FILLER PICTURE X(37) VALUE OBIC24.2 +008500 ",RECKEY= ". OBIC24.2 +008600 05 FILLER PICTURE X(38) VALUE OBIC24.2 +008700 ",ALTKEY1= ". OBIC24.2 +008800 05 FILLER PICTURE X(38) VALUE OBIC24.2 +008900 ",ALTKEY2= ". OBIC24.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.OBIC24.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. OBIC24.2 +009200 05 FILE-RECORD-INFO-P1-120. OBIC24.2 +009300 07 FILLER PIC X(5). OBIC24.2 +009400 07 XFILE-NAME PIC X(6). OBIC24.2 +009500 07 FILLER PIC X(8). OBIC24.2 +009600 07 XRECORD-NAME PIC X(6). OBIC24.2 +009700 07 FILLER PIC X(1). OBIC24.2 +009800 07 REELUNIT-NUMBER PIC 9(1). OBIC24.2 +009900 07 FILLER PIC X(7). OBIC24.2 +010000 07 XRECORD-NUMBER PIC 9(6). OBIC24.2 +010100 07 FILLER PIC X(6). OBIC24.2 +010200 07 UPDATE-NUMBER PIC 9(2). OBIC24.2 +010300 07 FILLER PIC X(5). OBIC24.2 +010400 07 ODO-NUMBER PIC 9(4). OBIC24.2 +010500 07 FILLER PIC X(5). OBIC24.2 +010600 07 XPROGRAM-NAME PIC X(5). OBIC24.2 +010700 07 FILLER PIC X(7). OBIC24.2 +010800 07 XRECORD-LENGTH PIC 9(6). OBIC24.2 +010900 07 FILLER PIC X(7). OBIC24.2 +011000 07 CHARS-OR-RECORDS PIC X(2). OBIC24.2 +011100 07 FILLER PIC X(1). OBIC24.2 +011200 07 XBLOCK-SIZE PIC 9(4). OBIC24.2 +011300 07 FILLER PIC X(6). OBIC24.2 +011400 07 RECORDS-IN-FILE PIC 9(6). OBIC24.2 +011500 07 FILLER PIC X(5). OBIC24.2 +011600 07 XFILE-ORGANIZATION PIC X(2). OBIC24.2 +011700 07 FILLER PIC X(6). OBIC24.2 +011800 07 XLABEL-TYPE PIC X(1). OBIC24.2 +011900 05 FILE-RECORD-INFO-P121-240. OBIC24.2 +012000 07 FILLER PIC X(8). OBIC24.2 +012100 07 XRECORD-KEY PIC X(29). OBIC24.2 +012200 07 FILLER PIC X(9). OBIC24.2 +012300 07 ALTERNATE-KEY1 PIC X(29). OBIC24.2 +012400 07 FILLER PIC X(9). OBIC24.2 +012500 07 ALTERNATE-KEY2 PIC X(29). OBIC24.2 +012600 07 FILLER PIC X(7). OBIC24.2 +012700 LINKAGE SECTION. OBIC24.2 +012800 01 SORT-LINK PICTURE 9. OBIC24.2 +012900 PROCEDURE DIVISION USING SORT-LINK. OBIC24.2 +013000 SECT-IC219-0001 SECTION 30. OBIC24.2 +013100* OBIC24.2 +013200* THIS SECTION CONTAINS A SORT STATEMENT AND A STOP RUN OBIC24.2 +013300* STATEMENT, THE ONLY STATEMENTS PERMITTED IN THE FIRST NON- OBIC24.2 +013400* DECLARATIVE PORTION OF THE PROCEDURE DIVISION IN SORT LEVEL 1OBIC24.2 +013500* OBIC24.2 +013600 SORT-PARAGRAPH. OBIC24.2 +013700 SORT ST-FS1 OBIC24.2 +013800 ASCENDING KEY ST-FS1-121-124 OBIC24.2 +013900 ASCENDING KEY ST-FS1-125-126 OBIC24.2 +014000 ASCENDING KEY ST-FS1-REC-NO OBIC24.2 +014100 INPUT PROCEDURE IS SECT-IC219-0002 OBIC24.2 +014200 OUTPUT PROCEDURE IS SECT-IC219-0003. OBIC24.2 +014300 STOP RUN. OBIC24.2 +014400 SECT-IC219-0002 SECTION 60. OBIC24.2 +014500* OBIC24.2 +014600* THE SORT INPUT PROCEDURE RELEASES 500 SORT RECORDS OF OBIC24.2 +014700* LENGTH 126 CHARACTERS. THREE ITEMS ARE USED AS THE SORT KEY,OBIC24.2 +014800* THEY ARE CHARACTERS 121-124 PICX(4), CHARACTERS 125-126 OBIC24.2 +014900* PIC 99, AND THE RECORD NUMBER FIELD CHARACTERS 35-40 PIC 9(6)OBIC24.2 +015000* THE RECORDS ARE WRITTEN WITH THE SORT KEY ITEMS CONTAINING OBIC24.2 +015100* THE FOLLOWING CHARACTERS OBIC24.2 +015200* OBIC24.2 +015300* FIRST 100 RECORDS ABCD 00 THRU 99 000001 THRU 000100 OBIC24.2 +015400* SECOND 100 RECORDS AAAA 00 THRU 99 000101 THRU 000200 OBIC24.2 +015500* THIRD 100 RECORDS ABCD 00 THRU 99 000201 THRU 00300 OBIC24.2 +015600* FOURTH 100 RECORDS UVWY 00 THRU 99 000301 THRU 000400 OBIC24.2 +015700* FIFTH 100 RECORDS UVWX 00 THRU 99 000401 THRU 000500 OBIC24.2 +015800* OBIC24.2 +015900 SORT-INPUT-PROCEDURE. OBIC24.2 +016000 MOVE 1 TO SORT-LINK. OBIC24.2 +016100 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1). OBIC24.2 +016200 PERFORM RECORD-AREA-INIT. OBIC24.2 +016300 MOVE "ABCD" TO TEMP1. OBIC24.2 +016400 MOVE 0 TO TEMP2. OBIC24.2 +016500 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +016600 MOVE "AAAA" TO TEMP1. OBIC24.2 +016700 MOVE 0 TO TEMP2. OBIC24.2 +016800 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +016900 MOVE "ABCD" TO TEMP1. OBIC24.2 +017000 MOVE 0 TO TEMP2. OBIC24.2 +017100 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +017200 MOVE "UVWY" TO TEMP1. OBIC24.2 +017300 MOVE 0 TO TEMP2. OBIC24.2 +017400 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +017500 MOVE "UVWX" TO TEMP1. OBIC24.2 +017600 MOVE 0 TO TEMP2. OBIC24.2 +017700 PERFORM RELEASE-RECORD 100 TIMES. OBIC24.2 +017800 GO TO SECT-IC219-0002-EXIT. OBIC24.2 +017900 RECORD-AREA-INIT. OBIC24.2 +018000 MOVE "ST-FS1" TO XFILE-NAME (1). OBIC24.2 +018100 MOVE "R1-F-G" TO XRECORD-NAME (1). OBIC24.2 +018200 MOVE "IC219" TO XPROGRAM-NAME (1). OBIC24.2 +018300 MOVE 126 TO XRECORD-LENGTH (1). OBIC24.2 +018400 MOVE "RC" TO CHARS-OR-RECORDS (1). OBIC24.2 +018500 MOVE 0001 TO XBLOCK-SIZE (1). OBIC24.2 +018600 MOVE 500 TO RECORDS-IN-FILE (1). OBIC24.2 +018700 MOVE "NA" TO XFILE-ORGANIZATION (1). OBIC24.2 +018800 MOVE "N" TO XLABEL-TYPE (1). OBIC24.2 +018900 MOVE 1 TO XRECORD-NUMBER (1). OBIC24.2 +019000 RELEASE-RECORD. OBIC24.2 +019100 MOVE FILE-RECORD-INFO-P1-120 (1) TO ST-FS1-1-120. OBIC24.2 +019200 MOVE TEMP1 TO ST-FS1-121-124. OBIC24.2 +019300 MOVE TEMP2 TO ST-FS1-125-126. OBIC24.2 +019400 RELEASE ST-FS1R1-F-G-126. OBIC24.2 +019500 ADD 1 TO XRECORD-NUMBER (1). OBIC24.2 +019600 ADD 1 TO TEMP2. OBIC24.2 +019700 SECT-IC219-0002-EXIT. OBIC24.2 +019800 EXIT. OBIC24.2 +019900 SECT-IC219-0003 SECTION 80. OBIC24.2 +020000* OBIC24.2 +020100* THE SORT OUTPUT PROCEDURE RETURNS 500 SORT RECORDS. THE OBIC24.2 +020200* DATA ITEMS COMPRISING THE SORT KEY ARE CHECKED TO ENSURE THE OBIC24.2 +020300* RECORDS ARE RETURNED IN THE EXPECTED SORT ORDER. THE SUBPRO-OBIC24.2 +020400* GRAM IC220 IS CALLED TO PRODUCE THE OUTPUT REPORT FOR THE OBIC24.2 +020500* TEST RESULTS. OBIC24.2 +020600* OBIC24.2 +020700* THE RECORDS SHOULD BE RETURNED WITH THE SORT KEY ITEMS OBIC24.2 +020800* CONTAINING THE FOLLOWING CHARACTERS OBIC24.2 +020900* OBIC24.2 +021000* FIRST 100 RECORDS AAAA 00 THRU 99 000101 THRU 000200 OBIC24.2 +021100* ABCD 00 000001 OBIC24.2 +021200* NEXT ABCD 00 000201 OBIC24.2 +021300* 200 ABCD 01 000002 OBIC24.2 +021400* RECORDS ABCD 01 000202 OBIC24.2 +021500* . . . . . . OBIC24.2 +021600* ABCD 99 000100 OBIC24.2 +021700* ABCD 99 000300 OBIC24.2 +021800* FOURTH 100 RECORDS UVWX 00 THRU 99 000401 THRU 000500 OBIC24.2 +021900* FIFTH 100 RECORDS UVWY 00 THRU 99 000301 THRU 000400 OBIC24.2 +022000* OBIC24.2 +022100 SORT-OUTPUT-INIT. OBIC24.2 +022200 MOVE 2 TO SORT-LINK. OBIC24.2 +022300 MOVE 1 TO PRINT-FLAG. OBIC24.2 +022400 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC24.2 +022500 MOVE "SORT IN SUBPROGRAM" TO FEATURE-TESTED. OBIC24.2 +022600 MOVE "IC-SORT-TEST" TO PARAGRAPH-NAME. OBIC24.2 +022700 MOVE 0 TO R-COUNT. OBIC24.2 +022800 CHECK-OUTPUT-FROM-SORT. OBIC24.2 +022900 MOVE "AAAA" TO TEMP1. OBIC24.2 +023000 MOVE 0 TO TEMP3. OBIC24.2 +023100 MOVE 100 TO TEMP4. OBIC24.2 +023200 PERFORM CHECK-RECORD 100 TIMES. OBIC24.2 +023300 MOVE "ABCD" TO TEMP1. OBIC24.2 +023400 MOVE 0 TO TEMP3. OBIC24.2 +023500 MOVE 0 TO TEMP4. OBIC24.2 +023600 PERFORM CHECK-ABCD-RECORDS 100 TIMES. OBIC24.2 +023700 MOVE "UVWX" TO TEMP1. OBIC24.2 +023800 MOVE 0 TO TEMP3. OBIC24.2 +023900 MOVE 400 TO TEMP4. OBIC24.2 +024000 PERFORM CHECK-RECORD 100 TIMES. OBIC24.2 +024100 MOVE "UVWY" TO TEMP1. OBIC24.2 +024200 MOVE 0 TO TEMP3. OBIC24.2 +024300 MOVE 300 TO TEMP4. OBIC24.2 +024400 PERFORM CHECK-RECORD 100 TIMES. OBIC24.2 +024500 CHECK-RESULTS. OBIC24.2 +024600 IF EOF-FLAG EQUAL TO 1 OBIC24.2 +024700 MOVE "PREMATURE EOF" TO COMPUTED-SORT-KEY OBIC24.2 +024800 MOVE "DATA RECORD EXPECTED" TO CORRECT-SORT-KEY OBIC24.2 +024900 GO TO FAIL-WRITE. OBIC24.2 +025000 RETURN ST-FS1 AT END GO TO CHECK-FAIL-COUNT. OBIC24.2 +025100 MOVE "NO EOF - 500 READ" TO COMPUTED-SORT-KEY. OBIC24.2 +025200 MOVE "EOF EXPECTED" TO CORRECT-SORT-KEY. OBIC24.2 +025300 GO TO FAIL-WRITE. OBIC24.2 +025400 CHECK-FAIL-COUNT. OBIC24.2 +025500 IF FAIL-COUNT EQUAL TO ZERO OBIC24.2 +025600 MOVE "PASS " TO PASS-OR-FAIL OBIC24.2 +025700 GO TO WRITE-RESULTS. OBIC24.2 +025800 MOVE "SORT ERRORS" TO COMPUTED-SORT-KEY. OBIC24.2 +025900 MOVE SPACE TO CORRECT-SORT-KEY. OBIC24.2 +026000 FAIL-WRITE. OBIC24.2 +026100 MOVE "FAIL " TO PASS-OR-FAIL. OBIC24.2 +026200 WRITE-RESULTS. OBIC24.2 +026300 MOVE 0 TO R-COUNT. OBIC24.2 +026400 MOVE 2 TO PRINT-FLAG. OBIC24.2 +026500 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC24.2 +026600 WRAPUP-OUTPUT-PROC. OBIC24.2 +026700 MOVE 3 TO PRINT-FLAG. OBIC24.2 +026800 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC24.2 +026900 GO TO SECT-IC219-0003-EXIT. OBIC24.2 +027000 CHECK-RECORD. OBIC24.2 +027100 PERFORM RETURN-RECORD THROUGH RETURN-EXIT. OBIC24.2 +027200 ADD 1 TO TEMP4. OBIC24.2 +027300 PERFORM COMPARE-VALUES THROUGH COMPARE-EXIT. OBIC24.2 +027400 ADD 1 TO TEMP3. OBIC24.2 +027500 RETURN-RECORD. OBIC24.2 +027600 IF EOF-FLAG EQUAL TO 1 OBIC24.2 +027700 GO TO RETURN-EXIT. OBIC24.2 +027800 RETURN ST-FS1 AT END MOVE 1 TO EOF-FLAG. OBIC24.2 +027900 RETURN-EXIT. OBIC24.2 +028000 EXIT. OBIC24.2 +028100 CHECK-ABCD-RECORDS. OBIC24.2 +028200 PERFORM CHECK-RECORD. OBIC24.2 +028300 SUBTRACT 1 FROM TEMP3. OBIC24.2 +028400 ADD 199 TO TEMP4. OBIC24.2 +028500 PERFORM CHECK-RECORD. OBIC24.2 +028600 SUBTRACT 200 FROM TEMP4. OBIC24.2 +028700 COMPARE-VALUES. OBIC24.2 +028800 IF TEMP1 NOT EQUAL TO ST-FS1-121-124 OBIC24.2 +028900 GO TO SORT-FAIL. OBIC24.2 +029000 IF TEMP3 NOT EQUAL TO ST-FS1-125-126 OBIC24.2 +029100 GO TO SORT-FAIL. OBIC24.2 +029200 IF TEMP4 NOT EQUAL TO ST-FS1-REC-NO OBIC24.2 +029300 GO TO SORT-FAIL. OBIC24.2 +029400 GO TO COMPARE-EXIT. OBIC24.2 +029500 SORT-FAIL. OBIC24.2 +029600 MOVE "FAIL " TO PASS-OR-FAIL. OBIC24.2 +029700 ADD 1 TO R-COUNT. OBIC24.2 +029800 MOVE TEMP1 TO CORRECT-1-4. OBIC24.2 +029900 MOVE TEMP3 TO CORRECT-5-6. OBIC24.2 +030000 MOVE TEMP4 TO CORRECT-7-12. OBIC24.2 +030100 MOVE ST-FS1-121-124 TO COMPUTED-1-4. OBIC24.2 +030200 MOVE ST-FS1-125-126 TO COMPUTED-5-6. OBIC24.2 +030300 MOVE ST-FS1-REC-NO TO COMPUTED-7-12. OBIC24.2 +030400 MOVE 2 TO PRINT-FLAG. OBIC24.2 +030500 CALL "OBIC3A" USING PRINT-LINE-VALUES PRINT-FLAG. OBIC24.2 +030600 ADD 1 TO FAIL-COUNT. OBIC24.2 +030700 COMPARE-EXIT. OBIC24.2 +030800 EXIT. OBIC24.2 +030900 SECT-IC219-0003-EXIT. OBIC24.2 +031000 EXIT. OBIC24.2 diff --git a/tests/cobol85/OB/lib/OBIC3A.CBL b/tests/cobol85/OB/lib/OBIC3A.CBL new file mode 100755 index 00000000..fe526b11 --- /dev/null +++ b/tests/cobol85/OB/lib/OBIC3A.CBL @@ -0,0 +1,336 @@ +000100 IDENTIFICATION DIVISION. OBIC34.2 +000200 PROGRAM-ID. OBIC34.2 +000300 OBIC3A. OBIC34.2 +000400**************************************************************** OBIC34.2 +000500* * OBIC34.2 +000600* VALIDATION FOR:- * OBIC34.2 +000700* * OBIC34.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC34.2 +000900* * OBIC34.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBIC34.2 +001100* * OBIC34.2 +001200**************************************************************** OBIC34.2 +001300* * OBIC34.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * OBIC34.2 +001500* * OBIC34.2 +001600* X-55 - SYSTEM PRINTER NAME. * OBIC34.2 +001700* X-82 - SOURCE COMPUTER NAME. * OBIC34.2 +001800* X-83 - OBJECT COMPUTER NAME. * OBIC34.2 +001900* * OBIC34.2 +002000**************************************************************** OBIC34.2 +002100* OBIC34.2 +002200* THE SUBPROGRAM IC220 PRINTS THE RESULTS FOR THE TESTING OBIC34.2 +002300* OF A SEGMENTED LEVEL 1 SORT PROGRAM AS A SUBPROGRAM. IT IS OBIC34.2 +002400* CALLED BY THE MAIN PROGRAM IC218 AND THE SUBPROGRAM IC219. OBIC34.2 +002500* THE LINKAGE VARIABLE PRINT-FLAG INDICATES WHETHER THE OBIC34.2 +002600* HEADING (FLAG=1), FOOTING (FLAG=3), OR A REPORT LINE (FLAG=2)OBIC34.2 +002700* SHOULD BE PRINTED. OBIC34.2 +002800* OBIC34.2 +002900******************************************************************OBIC34.2 +003000 ENVIRONMENT DIVISION. OBIC34.2 +003100 CONFIGURATION SECTION. OBIC34.2 +003200 SOURCE-COMPUTER. OBIC34.2 +003300 Linux. OBIC34.2 +003400 OBJECT-COMPUTER. OBIC34.2 +003500 Linux. OBIC34.2 +003600 INPUT-OUTPUT SECTION. OBIC34.2 +003700 FILE-CONTROL. OBIC34.2 +003800 SELECT PRINT-FILE ASSIGN TO OBIC34.2 +003900 "report.log". OBIC34.2 +004000 DATA DIVISION. OBIC34.2 +004100 FILE SECTION. OBIC34.2 +004200 FD PRINT-FILE. OBIC34.2 +004300 01 PRINT-REC PICTURE X(120). OBIC34.2 +004400 01 DUMMY-RECORD PICTURE X(120). OBIC34.2 +004500 WORKING-STORAGE SECTION. OBIC34.2 +004600 01 TEST-RESULTS. OBIC34.2 +004700 02 FILLER PIC X VALUE SPACE. OBIC34.2 +004800 02 FEATURE PIC X(20) VALUE SPACE. OBIC34.2 +004900 02 FILLER PIC X VALUE SPACE. OBIC34.2 +005000 02 P-OR-F PIC X(5) VALUE SPACE. OBIC34.2 +005100 02 FILLER PIC X VALUE SPACE. OBIC34.2 +005200 02 PAR-NAME. OBIC34.2 +005300 03 FILLER PIC X(19) VALUE SPACE. OBIC34.2 +005400 03 PARDOT-X PIC X VALUE SPACE. OBIC34.2 +005500 03 DOTVALUE PIC 99 VALUE ZERO. OBIC34.2 +005600 02 FILLER PIC X(8) VALUE SPACE. OBIC34.2 +005700 02 RE-MARK PIC X(61). OBIC34.2 +005800 01 TEST-COMPUTED. OBIC34.2 +005900 02 FILLER PIC X(30) VALUE SPACE. OBIC34.2 +006000 02 FILLER PIC X(17) VALUE OBIC34.2 +006100 " COMPUTED=". OBIC34.2 +006200 02 COMPUTED-X. OBIC34.2 +006300 03 COMPUTED-A PIC X(20) VALUE SPACE. OBIC34.2 +006400 03 COMPUTED-N REDEFINES COMPUTED-A OBIC34.2 +006500 PIC -9(9).9(9). OBIC34.2 +006600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). OBIC34.2 +006700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). OBIC34.2 +006800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). OBIC34.2 +006900 03 CM-18V0 REDEFINES COMPUTED-A. OBIC34.2 +007000 04 COMPUTED-18V0 PIC -9(18). OBIC34.2 +007100 04 FILLER PIC X. OBIC34.2 +007200 03 FILLER PIC X(50) VALUE SPACE. OBIC34.2 +007300 01 TEST-CORRECT. OBIC34.2 +007400 02 FILLER PIC X(30) VALUE SPACE. OBIC34.2 +007500 02 FILLER PIC X(17) VALUE " CORRECT =". OBIC34.2 +007600 02 CORRECT-X. OBIC34.2 +007700 03 CORRECT-A PIC X(20) VALUE SPACE. OBIC34.2 +007800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). OBIC34.2 +007900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). OBIC34.2 +008000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). OBIC34.2 +008100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). OBIC34.2 +008200 03 CR-18V0 REDEFINES CORRECT-A. OBIC34.2 +008300 04 CORRECT-18V0 PIC -9(18). OBIC34.2 +008400 04 FILLER PIC X. OBIC34.2 +008500 03 FILLER PIC X(2) VALUE SPACE. OBIC34.2 +008600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. OBIC34.2 +008700 01 CCVS-C-1. OBIC34.2 +008800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAOBIC34.2 +008900- "SS PARAGRAPH-NAME OBIC34.2 +009000- " REMARKS". OBIC34.2 +009100 02 FILLER PIC X(20) VALUE SPACE. OBIC34.2 +009200 01 CCVS-C-2. OBIC34.2 +009300 02 FILLER PIC X VALUE SPACE. OBIC34.2 +009400 02 FILLER PIC X(6) VALUE "TESTED". OBIC34.2 +009500 02 FILLER PIC X(15) VALUE SPACE. OBIC34.2 +009600 02 FILLER PIC X(4) VALUE "FAIL". OBIC34.2 +009700 02 FILLER PIC X(94) VALUE SPACE. OBIC34.2 +009800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. OBIC34.2 +009900 01 REC-CT PIC 99 VALUE ZERO. OBIC34.2 +010000 01 DELETE-COUNTER PIC 999 VALUE ZERO. OBIC34.2 +010100 01 ERROR-COUNTER PIC 999 VALUE ZERO. OBIC34.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. OBIC34.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. OBIC34.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. OBIC34.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. OBIC34.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. OBIC34.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. OBIC34.2 +010800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. OBIC34.2 +010900 01 CCVS-H-1. OBIC34.2 +011000 02 FILLER PIC X(39) VALUE SPACES. OBIC34.2 +011100 02 FILLER PIC X(42) VALUE OBIC34.2 +011200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". OBIC34.2 +011300 02 FILLER PIC X(39) VALUE SPACES. OBIC34.2 +011400 01 CCVS-H-2A. OBIC34.2 +011500 02 FILLER PIC X(40) VALUE SPACE. OBIC34.2 +011600 02 FILLER PIC X(7) VALUE "CCVS85 ". OBIC34.2 +011700 02 FILLER PIC XXXX VALUE OBIC34.2 +011800 "4.2 ". OBIC34.2 +011900 02 FILLER PIC X(28) VALUE OBIC34.2 +012000 " COPY - NOT FOR DISTRIBUTION". OBIC34.2 +012100 02 FILLER PIC X(41) VALUE SPACE. OBIC34.2 +012200 OBIC34.2 +012300 01 CCVS-H-2B. OBIC34.2 +012400 02 FILLER PIC X(15) VALUE OBIC34.2 +012500 "TEST RESULT OF ". OBIC34.2 +012600 02 TEST-ID PIC X(9). OBIC34.2 +012700 02 FILLER PIC X(4) VALUE OBIC34.2 +012800 " IN ". OBIC34.2 +012900 02 FILLER PIC X(12) VALUE OBIC34.2 +013000 " HIGH ". OBIC34.2 +013100 02 FILLER PIC X(22) VALUE OBIC34.2 +013200 " LEVEL VALIDATION FOR ". OBIC34.2 +013300 02 FILLER PIC X(58) VALUE OBIC34.2 +013400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC34.2 +013500 01 CCVS-H-3. OBIC34.2 +013600 02 FILLER PIC X(34) VALUE OBIC34.2 +013700 " FOR OFFICIAL USE ONLY ". OBIC34.2 +013800 02 FILLER PIC X(58) VALUE OBIC34.2 +013900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".OBIC34.2 +014000 02 FILLER PIC X(28) VALUE OBIC34.2 +014100 " COPYRIGHT 1985 ". OBIC34.2 +014200 01 CCVS-E-1. OBIC34.2 +014300 02 FILLER PIC X(52) VALUE SPACE. OBIC34.2 +014400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". OBIC34.2 +014500 02 ID-AGAIN PIC X(9). OBIC34.2 +014600 02 FILLER PIC X(45) VALUE SPACES. OBIC34.2 +014700 01 CCVS-E-2. OBIC34.2 +014800 02 FILLER PIC X(31) VALUE SPACE. OBIC34.2 +014900 02 FILLER PIC X(21) VALUE SPACE. OBIC34.2 +015000 02 CCVS-E-2-2. OBIC34.2 +015100 03 ERROR-TOTAL PIC XXX VALUE SPACE. OBIC34.2 +015200 03 FILLER PIC X VALUE SPACE. OBIC34.2 +015300 03 ENDER-DESC PIC X(44) VALUE OBIC34.2 +015400 "ERRORS ENCOUNTERED". OBIC34.2 +015500 01 CCVS-E-3. OBIC34.2 +015600 02 FILLER PIC X(22) VALUE OBIC34.2 +015700 " FOR OFFICIAL USE ONLY". OBIC34.2 +015800 02 FILLER PIC X(12) VALUE SPACE. OBIC34.2 +015900 02 FILLER PIC X(58) VALUE OBIC34.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".OBIC34.2 +016100 02 FILLER PIC X(13) VALUE SPACE. OBIC34.2 +016200 02 FILLER PIC X(15) VALUE OBIC34.2 +016300 " COPYRIGHT 1985". OBIC34.2 +016400 01 CCVS-E-4. OBIC34.2 +016500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. OBIC34.2 +016600 02 FILLER PIC X(4) VALUE " OF ". OBIC34.2 +016700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. OBIC34.2 +016800 02 FILLER PIC X(40) VALUE OBIC34.2 +016900 " TESTS WERE EXECUTED SUCCESSFULLY". OBIC34.2 +017000 01 XXINFO. OBIC34.2 +017100 02 FILLER PIC X(19) VALUE OBIC34.2 +017200 "*** INFORMATION ***". OBIC34.2 +017300 02 INFO-TEXT. OBIC34.2 +017400 04 FILLER PIC X(8) VALUE SPACE. OBIC34.2 +017500 04 XXCOMPUTED PIC X(20). OBIC34.2 +017600 04 FILLER PIC X(5) VALUE SPACE. OBIC34.2 +017700 04 XXCORRECT PIC X(20). OBIC34.2 +017800 02 INF-ANSI-REFERENCE PIC X(48). OBIC34.2 +017900 01 HYPHEN-LINE. OBIC34.2 +018000 02 FILLER PIC IS X VALUE IS SPACE. OBIC34.2 +018100 02 FILLER PIC IS X(65) VALUE IS "************************OBIC34.2 +018200- "*****************************************". OBIC34.2 +018300 02 FILLER PIC IS X(54) VALUE IS "************************OBIC34.2 +018400- "******************************". OBIC34.2 +018500 01 CCVS-PGM-ID PIC X(9) VALUE OBIC34.2 +018600 "OBIC3A". OBIC34.2 +018700 LINKAGE SECTION. OBIC34.2 +018800 01 PRINT-LINE-VALUES. OBIC34.2 +018900 02 PASS-OR-FAIL PICTURE X(5). OBIC34.2 +019000 02 R-COUNT PICTURE 99. OBIC34.2 +019100 02 FEATURE-TESTED PICTURE X(20). OBIC34.2 +019200 02 COMPUTED-SORT-KEY PICTURE X(20). OBIC34.2 +019300 02 CORRECT-SORT-KEY PICTURE X(20). OBIC34.2 +019400 02 PARAGRAPH-NAME PICTURE X(12). OBIC34.2 +019500 01 PRINT-FLAG PICTURE 9. OBIC34.2 +019600 PROCEDURE DIVISION USING PRINT-LINE-VALUES PRINT-FLAG. OBIC34.2 +019700 SECT-IC220-0001 SECTION. OBIC34.2 +019800 BOILER-PLATE. OBIC34.2 +019900 GO TO CCVS1-EXIT. OBIC34.2 +020000 CLOSE-FILES. OBIC34.2 +020100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. OBIC34.2 +020200 TERMINATE-CCVS. OBIC34.2 +020300*S EXIT PROGRAM. OBIC34.2 +020400*SERMINATE-CALL. OBIC34.2 +020500 STOP RUN. OBIC34.2 +020600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. OBIC34.2 +020700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. OBIC34.2 +020800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. OBIC34.2 +020900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. OBIC34.2 +021000 MOVE "****TEST DELETED****" TO RE-MARK. OBIC34.2 +021100 PRINT-DETAIL. OBIC34.2 +021200 IF REC-CT NOT EQUAL TO ZERO OBIC34.2 +021300 MOVE "." TO PARDOT-X OBIC34.2 +021400 MOVE REC-CT TO DOTVALUE. OBIC34.2 +021500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. OBIC34.2 +021600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE OBIC34.2 +021700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX OBIC34.2 +021800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. OBIC34.2 +021900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. OBIC34.2 +022000 MOVE SPACE TO CORRECT-X. OBIC34.2 +022100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. OBIC34.2 +022200 MOVE SPACE TO RE-MARK. OBIC34.2 +022300 HEAD-ROUTINE. OBIC34.2 +022400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +022500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +022600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBIC34.2 +022700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. OBIC34.2 +022800 COLUMN-NAMES-ROUTINE. OBIC34.2 +022900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +023000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +023100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +023200 END-ROUTINE. OBIC34.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.OBIC34.2 +023400 END-RTN-EXIT. OBIC34.2 +023500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +023600 END-ROUTINE-1. OBIC34.2 +023700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO OBIC34.2 +023800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. OBIC34.2 +023900 ADD PASS-COUNTER TO ERROR-HOLD. OBIC34.2 +024000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. OBIC34.2 +024100 MOVE PASS-COUNTER TO CCVS-E-4-1. OBIC34.2 +024200 MOVE ERROR-HOLD TO CCVS-E-4-2. OBIC34.2 +024300 MOVE CCVS-E-4 TO CCVS-E-2-2. OBIC34.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. OBIC34.2 +024500 END-ROUTINE-12. OBIC34.2 +024600 MOVE "TEST(S) FAILED" TO ENDER-DESC. OBIC34.2 +024700 IF ERROR-COUNTER IS EQUAL TO ZERO OBIC34.2 +024800 MOVE "NO " TO ERROR-TOTAL OBIC34.2 +024900 ELSE OBIC34.2 +025000 MOVE ERROR-COUNTER TO ERROR-TOTAL. OBIC34.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. OBIC34.2 +025200 PERFORM WRITE-LINE. OBIC34.2 +025300 END-ROUTINE-13. OBIC34.2 +025400 IF DELETE-COUNTER IS EQUAL TO ZERO OBIC34.2 +025500 MOVE "NO " TO ERROR-TOTAL ELSE OBIC34.2 +025600 MOVE DELETE-COUNTER TO ERROR-TOTAL. OBIC34.2 +025700 MOVE "TEST(S) DELETED " TO ENDER-DESC. OBIC34.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +025900 IF INSPECT-COUNTER EQUAL TO ZERO OBIC34.2 +026000 MOVE "NO " TO ERROR-TOTAL OBIC34.2 +026100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. OBIC34.2 +026200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. OBIC34.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +026400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. OBIC34.2 +026500 WRITE-LINE. OBIC34.2 +026600 ADD 1 TO RECORD-COUNT. OBIC34.2 +026700 IF RECORD-COUNT GREATER 50 OBIC34.2 +026800 MOVE DUMMY-RECORD TO DUMMY-HOLD OBIC34.2 +026900 MOVE SPACE TO DUMMY-RECORD OBIC34.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE OBIC34.2 +027100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN OBIC34.2 +027200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES OBIC34.2 +027300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN OBIC34.2 +027400 MOVE DUMMY-HOLD TO DUMMY-RECORD OBIC34.2 +027500 MOVE ZERO TO RECORD-COUNT. OBIC34.2 +027600 PERFORM WRT-LN. OBIC34.2 +027700 WRT-LN. OBIC34.2 +027800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. OBIC34.2 +027900 MOVE SPACE TO DUMMY-RECORD. OBIC34.2 +028000 BLANK-LINE-PRINT. OBIC34.2 +028100 PERFORM WRT-LN. OBIC34.2 +028200 FAIL-ROUTINE. OBIC34.2 +028300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. OBIC34.2 +028400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.OBIC34.2 +028500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBIC34.2 +028600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. OBIC34.2 +028700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +028800 MOVE SPACES TO INF-ANSI-REFERENCE. OBIC34.2 +028900 GO TO FAIL-ROUTINE-EX. OBIC34.2 +029000 FAIL-ROUTINE-WRITE. OBIC34.2 +029100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE OBIC34.2 +029200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. OBIC34.2 +029300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +029400 MOVE SPACES TO COR-ANSI-REFERENCE. OBIC34.2 +029500 FAIL-ROUTINE-EX. EXIT. OBIC34.2 +029600 BAIL-OUT. OBIC34.2 +029700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. OBIC34.2 +029800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. OBIC34.2 +029900 BAIL-OUT-WRITE. OBIC34.2 +030000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. OBIC34.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. OBIC34.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. OBIC34.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. OBIC34.2 +030400 BAIL-OUT-EX. EXIT. OBIC34.2 +030500 CCVS1-EXIT. OBIC34.2 +030600 EXIT. OBIC34.2 +030700 SECT-IC220-0002 SECTION. OBIC34.2 +030800 BRANCH-STATEMENT. OBIC34.2 +030900 GO TO PRINT-HEADING PROCESS-LINE PRINT-FOOTING OBIC34.2 +031000 DEPENDING ON PRINT-FLAG. OBIC34.2 +031100 MOVE "ERROR IN PRINT-FLAG" TO DUMMY-RECORD. OBIC34.2 +031200 PERFORM WRITE-LINE. OBIC34.2 +031300 GO TO IC220-EXIT. OBIC34.2 +031400 PRINT-HEADING. OBIC34.2 +031500 MOVE 0 TO R-COUNT. OBIC34.2 +031600 OPEN-FILES. OBIC34.2 +031700 OPEN OUTPUT PRINT-FILE. OBIC34.2 +031800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. OBIC34.2 +031900 MOVE SPACE TO TEST-RESULTS. OBIC34.2 +032000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. OBIC34.2 +032100 GO TO IC220-EXIT. OBIC34.2 +032200 PRINT-FOOTING. OBIC34.2 +032300 PERFORM CLOSE-FILES. OBIC34.2 +032400 GO TO IC220-EXIT. OBIC34.2 +032500 PROCESS-LINE. OBIC34.2 +032600 IF PASS-OR-FAIL EQUAL TO "PASS " OBIC34.2 +032700 PERFORM PASS OBIC34.2 +032800 ELSE PERFORM FAIL OBIC34.2 +032900 MOVE COMPUTED-SORT-KEY TO COMPUTED-A OBIC34.2 +033000 MOVE CORRECT-SORT-KEY TO CORRECT-A. OBIC34.2 +033100 MOVE R-COUNT TO REC-CT. OBIC34.2 +033200 MOVE FEATURE-TESTED TO FEATURE. OBIC34.2 +033300 MOVE PARAGRAPH-NAME TO PAR-NAME. OBIC34.2 +033400 PERFORM PRINT-DETAIL. OBIC34.2 +033500 IC220-EXIT. OBIC34.2 +033600 EXIT PROGRAM. OBIC34.2 diff --git a/tests/cobol85/README b/tests/cobol85/README old mode 100644 new mode 100755 diff --git a/tests/cobol85/RL.txt b/tests/cobol85/RL.txt deleted file mode 100644 index 3449aa3d..00000000 --- a/tests/cobol85/RL.txt +++ /dev/null @@ -1,45 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -RL101A.CBL 1 1 0 0 0 OK -RL102A.SUB 11 11 0 0 0 OK -RL103A.SUB 11 11 0 0 0 OK -RL104A.CBL 12 12 0 0 0 OK -RL105A.CBL 4 4 0 0 0 OK -RL106A.CBL 4 4 0 0 0 OK -RL107A.CBL 19 19 0 0 0 OK -RL108A.CBL 1 1 0 0 0 OK -RL109A.SUB 11 11 0 0 0 OK -RL110A.SUB 10 10 0 0 0 OK -RL111A.CBL 24 24 0 0 0 OK -RL112A.CBL 12 12 0 0 0 OK -RL113A.CBL 11 11 0 0 0 OK -RL114A.CBL 13 13 0 0 0 OK -RL115A.CBL 13 13 0 0 0 OK -RL116A.CBL 3 3 0 0 0 OK -RL117A.CBL 8 6 0 2 0 OK -RL118A.CBL 4 2 0 2 0 OK -RL119A.CBL 1 1 0 0 0 OK -RL201A.CBL 1 1 0 0 0 OK -RL202A.SUB 11 11 0 0 0 OK -RL203A.SUB 11 11 0 0 0 OK -RL204A.CBL 12 12 0 0 0 OK -RL205A.CBL 67 66 0 1 0 OK -RL206A.CBL 501 501 0 0 0 OK -RL207A.SUB 20 20 0 0 0 OK -RL208A.SUB 11 11 0 0 0 OK -RL209A.CBL 1 1 0 0 0 OK -RL210A.CBL 1 1 0 0 0 OK -RL211A.CBL 501 501 0 0 0 OK -RL212A.CBL 1 1 0 0 0 OK -RL213A.SUB 521 521 0 0 0 OK -RL301M.CBL ----- test skipped ----- -RL302M.CBL ----- test skipped ----- -RL401M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 1832 1827 0 5 0 -% 100.0 99.7 0.0 0.3 0.0 - -Number of programs: 32 -Successfully executed: 32 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/RL/RL101A.CBL b/tests/cobol85/RL/RL101A.CBL new file mode 100644 index 00000000..2a02a93c --- /dev/null +++ b/tests/cobol85/RL/RL101A.CBL @@ -0,0 +1,457 @@ +000100 IDENTIFICATION DIVISION. RL1014.2 +000200 PROGRAM-ID. RL1014.2 +000300 RL101A. RL1014.2 +000400**************************************************************** RL1014.2 +000500* * RL1014.2 +000600* VALIDATION FOR:- * RL1014.2 +000700* * RL1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1014.2 +000900* * RL1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1014.2 +001100* * RL1014.2 +001200**************************************************************** RL1014.2 +001300* * RL1014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1014.2 +001500* * RL1014.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1014.2 +001700* RELATIVE I-O DATA FILE * RL1014.2 +001800* X-55 SYSTEM PRINTER * RL1014.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1014.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1014.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1014.2 +002200* X-82 SOURCE-COMPUTER * RL1014.2 +002300* X-83 OBJECT-COMPUTER. * RL1014.2 +002400* * RL1014.2 +002500**************************************************************** RL1014.2 +002600* RL111A * RL1014.2 +002700**************************************************************** RL1014.2 +002800* * RL1014.2 +002900* THIS PROGRAM WILL TEST THE NEW SYNTACTICAL CONSTRUCTS * RL1014.2 +003000* AND SEMENTIC ACTIONS ASSOCIATED WITH THE FOLLOWING * RL1014.2 +003100* CLAUSES: * RL1014.2 +003200* - ACCESS * RL1014.2 +003300* - READ * RL1014.2 +003400* - WRITE * RL1014.2 +003500* - REWRITE * RL1014.2 +003600* * RL1014.2 +003700* 1) THE PROGRAM WILL CREATE A RELATIVE I-O FILE * RL1014.2 +003800* 2) THEN IT WILL UPDATE SELECTIVE RECORDS OF THE FILE * RL1014.2 +003900* 3) THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR * RL1014.2 +004000* ACCURACY FOR EACH "OPEN", "CLOSE", "READ" AND * RL1014.2 +004100* "REWRITE" STATEMENT USED. * RL1014.2 +004200* 4) THE "READ", "WRITE" AND "REWRITE" STATEMENT WILL BE * RL1014.2 +004300* USED WITH THE APPROPRIATE "AT END", "NOT AT END", * RL1014.2 +004400* "INVALID KEY" AND "NOT INVALID KEY" PHRASES. * RL1014.2 +004500* * RL1014.2 +004600**************************************************************** RL1014.2 +004700 ENVIRONMENT DIVISION. RL1014.2 +004800 CONFIGURATION SECTION. RL1014.2 +004900 SOURCE-COMPUTER. RL1014.2 +005000 Linux. RL1014.2 +005100 OBJECT-COMPUTER. RL1014.2 +005200 Linux. RL1014.2 +005300 INPUT-OUTPUT SECTION. RL1014.2 +005400 FILE-CONTROL. RL1014.2 +005500 SELECT PRINT-FILE ASSIGN TO RL1014.2 +005600 "report.log". RL1014.2 +005700 SELECT RL-FS2 ASSIGN TO RL1014.2 +005800 "XXXXX021" RL1014.2 +005900 ORGANIZATION IS RELATIVE RL1014.2 +006000 ACCESS IS SEQUENTIAL RL1014.2 +006100 STATUS RL-FS2-STATUS. RL1014.2 +006200 DATA DIVISION. RL1014.2 +006300 FILE SECTION. RL1014.2 +006400 FD PRINT-FILE. RL1014.2 +006500 01 PRINT-REC PICTURE X(120). RL1014.2 +006600 01 DUMMY-RECORD PICTURE X(120). RL1014.2 +006700 FD RL-FS2 RL1014.2 +006800 LABEL RECORDS STANDARD RL1014.2 +006900*C VALUE OF RL1014.2 +007000*C OCLABELID RL1014.2 +007100*C IS RL1014.2 +007200*C "OCDUMMY" RL1014.2 +007300*G SYSIN RL1014.2 +007400 BLOCK CONTAINS 1 RECORDS RL1014.2 +007500 RECORD CONTAINS 120 CHARACTERS. RL1014.2 +007600 01 RL-FS2R1-F-G-120. RL1014.2 +007700 02 FILLER PIC X(120). RL1014.2 +007800 WORKING-STORAGE SECTION. RL1014.2 +007900 01 RL-FS2-STATUS PIC XX. RL1014.2 +008000 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL1014.2 +008100 01 FILE-RECORD-INFORMATION-REC. RL1014.2 +008200 03 FILE-RECORD-INFO-SKELETON. RL1014.2 +008300 05 FILLER PICTURE X(48) VALUE RL1014.2 +008400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1014.2 +008500 05 FILLER PICTURE X(46) VALUE RL1014.2 +008600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1014.2 +008700 05 FILLER PICTURE X(26) VALUE RL1014.2 +008800 ",LFIL=000000,ORG= ,LBLR= ". RL1014.2 +008900 05 FILLER PICTURE X(37) VALUE RL1014.2 +009000 ",RECKEY= ". RL1014.2 +009100 05 FILLER PICTURE X(38) VALUE RL1014.2 +009200 ",ALTKEY1= ". RL1014.2 +009300 05 FILLER PICTURE X(38) VALUE RL1014.2 +009400 ",ALTKEY2= ". RL1014.2 +009500 05 FILLER PICTURE X(7) VALUE SPACE.RL1014.2 +009600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1014.2 +009700 05 FILE-RECORD-INFO-P1-120. RL1014.2 +009800 07 FILLER PIC X(5). RL1014.2 +009900 07 XFILE-NAME PIC X(6). RL1014.2 +010000 07 FILLER PIC X(8). RL1014.2 +010100 07 XRECORD-NAME PIC X(6). RL1014.2 +010200 07 FILLER PIC X(1). RL1014.2 +010300 07 REELUNIT-NUMBER PIC 9(1). RL1014.2 +010400 07 FILLER PIC X(7). RL1014.2 +010500 07 XRECORD-NUMBER PIC 9(6). RL1014.2 +010600 07 FILLER PIC X(6). RL1014.2 +010700 07 UPDATE-NUMBER PIC 9(2). RL1014.2 +010800 07 FILLER PIC X(5). RL1014.2 +010900 07 ODO-NUMBER PIC 9(4). RL1014.2 +011000 07 FILLER PIC X(5). RL1014.2 +011100 07 XPROGRAM-NAME PIC X(5). RL1014.2 +011200 07 FILLER PIC X(7). RL1014.2 +011300 07 XRECORD-LENGTH PIC 9(6). RL1014.2 +011400 07 FILLER PIC X(7). RL1014.2 +011500 07 CHARS-OR-RECORDS PIC X(2). RL1014.2 +011600 07 FILLER PIC X(1). RL1014.2 +011700 07 XBLOCK-SIZE PIC 9(4). RL1014.2 +011800 07 FILLER PIC X(6). RL1014.2 +011900 07 RECORDS-IN-FILE PIC 9(6). RL1014.2 +012000 07 FILLER PIC X(5). RL1014.2 +012100 07 XFILE-ORGANIZATION PIC X(2). RL1014.2 +012200 07 FILLER PIC X(6). RL1014.2 +012300 07 XLABEL-TYPE PIC X(1). RL1014.2 +012400 05 FILE-RECORD-INFO-P121-240. RL1014.2 +012500 07 FILLER PIC X(8). RL1014.2 +012600 07 XRECORD-KEY PIC X(29). RL1014.2 +012700 07 FILLER PIC X(9). RL1014.2 +012800 07 ALTERNATE-KEY1 PIC X(29). RL1014.2 +012900 07 FILLER PIC X(9). RL1014.2 +013000 07 ALTERNATE-KEY2 PIC X(29). RL1014.2 +013100 07 FILLER PIC X(7). RL1014.2 +013200 01 TEST-RESULTS. RL1014.2 +013300 02 FILLER PIC X VALUE SPACE. RL1014.2 +013400 02 FEATURE PIC X(20) VALUE SPACE. RL1014.2 +013500 02 FILLER PIC X VALUE SPACE. RL1014.2 +013600 02 P-OR-F PIC X(5) VALUE SPACE. RL1014.2 +013700 02 FILLER PIC X VALUE SPACE. RL1014.2 +013800 02 PAR-NAME. RL1014.2 +013900 03 FILLER PIC X(19) VALUE SPACE. RL1014.2 +014000 03 PARDOT-X PIC X VALUE SPACE. RL1014.2 +014100 03 DOTVALUE PIC 99 VALUE ZERO. RL1014.2 +014200 02 FILLER PIC X(8) VALUE SPACE. RL1014.2 +014300 02 RE-MARK PIC X(61). RL1014.2 +014400 01 TEST-COMPUTED. RL1014.2 +014500 02 FILLER PIC X(30) VALUE SPACE. RL1014.2 +014600 02 FILLER PIC X(17) VALUE RL1014.2 +014700 " COMPUTED=". RL1014.2 +014800 02 COMPUTED-X. RL1014.2 +014900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1014.2 +015000 03 COMPUTED-N REDEFINES COMPUTED-A RL1014.2 +015100 PIC -9(9).9(9). RL1014.2 +015200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1014.2 +015300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1014.2 +015400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1014.2 +015500 03 CM-18V0 REDEFINES COMPUTED-A. RL1014.2 +015600 04 COMPUTED-18V0 PIC -9(18). RL1014.2 +015700 04 FILLER PIC X. RL1014.2 +015800 03 FILLER PIC X(50) VALUE SPACE. RL1014.2 +015900 01 TEST-CORRECT. RL1014.2 +016000 02 FILLER PIC X(30) VALUE SPACE. RL1014.2 +016100 02 FILLER PIC X(17) VALUE " CORRECT =". RL1014.2 +016200 02 CORRECT-X. RL1014.2 +016300 03 CORRECT-A PIC X(20) VALUE SPACE. RL1014.2 +016400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1014.2 +016500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1014.2 +016600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1014.2 +016700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1014.2 +016800 03 CR-18V0 REDEFINES CORRECT-A. RL1014.2 +016900 04 CORRECT-18V0 PIC -9(18). RL1014.2 +017000 04 FILLER PIC X. RL1014.2 +017100 03 FILLER PIC X(2) VALUE SPACE. RL1014.2 +017200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1014.2 +017300 01 CCVS-C-1. RL1014.2 +017400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1014.2 +017500- "SS PARAGRAPH-NAME RL1014.2 +017600- " REMARKS". RL1014.2 +017700 02 FILLER PIC X(20) VALUE SPACE. RL1014.2 +017800 01 CCVS-C-2. RL1014.2 +017900 02 FILLER PIC X VALUE SPACE. RL1014.2 +018000 02 FILLER PIC X(6) VALUE "TESTED". RL1014.2 +018100 02 FILLER PIC X(15) VALUE SPACE. RL1014.2 +018200 02 FILLER PIC X(4) VALUE "FAIL". RL1014.2 +018300 02 FILLER PIC X(94) VALUE SPACE. RL1014.2 +018400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1014.2 +018500 01 REC-CT PIC 99 VALUE ZERO. RL1014.2 +018600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1014.2 +018700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1014.2 +018800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1014.2 +018900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1014.2 +019000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1014.2 +019100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1014.2 +019200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1014.2 +019300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1014.2 +019400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1014.2 +019500 01 CCVS-H-1. RL1014.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL1014.2 +019700 02 FILLER PIC X(42) VALUE RL1014.2 +019800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1014.2 +019900 02 FILLER PIC X(39) VALUE SPACES. RL1014.2 +020000 01 CCVS-H-2A. RL1014.2 +020100 02 FILLER PIC X(40) VALUE SPACE. RL1014.2 +020200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1014.2 +020300 02 FILLER PIC XXXX VALUE RL1014.2 +020400 "4.2 ". RL1014.2 +020500 02 FILLER PIC X(28) VALUE RL1014.2 +020600 " COPY - NOT FOR DISTRIBUTION". RL1014.2 +020700 02 FILLER PIC X(41) VALUE SPACE. RL1014.2 +020800 RL1014.2 +020900 01 CCVS-H-2B. RL1014.2 +021000 02 FILLER PIC X(15) VALUE RL1014.2 +021100 "TEST RESULT OF ". RL1014.2 +021200 02 TEST-ID PIC X(9). RL1014.2 +021300 02 FILLER PIC X(4) VALUE RL1014.2 +021400 " IN ". RL1014.2 +021500 02 FILLER PIC X(12) VALUE RL1014.2 +021600 " HIGH ". RL1014.2 +021700 02 FILLER PIC X(22) VALUE RL1014.2 +021800 " LEVEL VALIDATION FOR ". RL1014.2 +021900 02 FILLER PIC X(58) VALUE RL1014.2 +022000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1014.2 +022100 01 CCVS-H-3. RL1014.2 +022200 02 FILLER PIC X(34) VALUE RL1014.2 +022300 " FOR OFFICIAL USE ONLY ". RL1014.2 +022400 02 FILLER PIC X(58) VALUE RL1014.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1014.2 +022600 02 FILLER PIC X(28) VALUE RL1014.2 +022700 " COPYRIGHT 1985 ". RL1014.2 +022800 01 CCVS-E-1. RL1014.2 +022900 02 FILLER PIC X(52) VALUE SPACE. RL1014.2 +023000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1014.2 +023100 02 ID-AGAIN PIC X(9). RL1014.2 +023200 02 FILLER PIC X(45) VALUE SPACES. RL1014.2 +023300 01 CCVS-E-2. RL1014.2 +023400 02 FILLER PIC X(31) VALUE SPACE. RL1014.2 +023500 02 FILLER PIC X(21) VALUE SPACE. RL1014.2 +023600 02 CCVS-E-2-2. RL1014.2 +023700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1014.2 +023800 03 FILLER PIC X VALUE SPACE. RL1014.2 +023900 03 ENDER-DESC PIC X(44) VALUE RL1014.2 +024000 "ERRORS ENCOUNTERED". RL1014.2 +024100 01 CCVS-E-3. RL1014.2 +024200 02 FILLER PIC X(22) VALUE RL1014.2 +024300 " FOR OFFICIAL USE ONLY". RL1014.2 +024400 02 FILLER PIC X(12) VALUE SPACE. RL1014.2 +024500 02 FILLER PIC X(58) VALUE RL1014.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1014.2 +024700 02 FILLER PIC X(13) VALUE SPACE. RL1014.2 +024800 02 FILLER PIC X(15) VALUE RL1014.2 +024900 " COPYRIGHT 1985". RL1014.2 +025000 01 CCVS-E-4. RL1014.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1014.2 +025200 02 FILLER PIC X(4) VALUE " OF ". RL1014.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1014.2 +025400 02 FILLER PIC X(40) VALUE RL1014.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". RL1014.2 +025600 01 XXINFO. RL1014.2 +025700 02 FILLER PIC X(19) VALUE RL1014.2 +025800 "*** INFORMATION ***". RL1014.2 +025900 02 INFO-TEXT. RL1014.2 +026000 04 FILLER PIC X(8) VALUE SPACE. RL1014.2 +026100 04 XXCOMPUTED PIC X(20). RL1014.2 +026200 04 FILLER PIC X(5) VALUE SPACE. RL1014.2 +026300 04 XXCORRECT PIC X(20). RL1014.2 +026400 02 INF-ANSI-REFERENCE PIC X(48). RL1014.2 +026500 01 HYPHEN-LINE. RL1014.2 +026600 02 FILLER PIC IS X VALUE IS SPACE. RL1014.2 +026700 02 FILLER PIC IS X(65) VALUE IS "************************RL1014.2 +026800- "*****************************************". RL1014.2 +026900 02 FILLER PIC IS X(54) VALUE IS "************************RL1014.2 +027000- "******************************". RL1014.2 +027100 01 CCVS-PGM-ID PIC X(9) VALUE RL1014.2 +027200 "RL101A". RL1014.2 +027300 PROCEDURE DIVISION. RL1014.2 +027400 CCVS1 SECTION. RL1014.2 +027500 OPEN-FILES. RL1014.2 +027600 OPEN OUTPUT PRINT-FILE. RL1014.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1014.2 +027800 MOVE SPACE TO TEST-RESULTS. RL1014.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1014.2 +028000 MOVE ZERO TO REC-SKL-SUB. RL1014.2 +028100 PERFORM CCVS-INIT-FILE 9 TIMES. RL1014.2 +028200 CCVS-INIT-FILE. RL1014.2 +028300 ADD 1 TO REC-SKL-SUB. RL1014.2 +028400 MOVE FILE-RECORD-INFO-SKELETON RL1014.2 +028500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1014.2 +028600 CCVS-INIT-EXIT. RL1014.2 +028700 GO TO CCVS1-EXIT. RL1014.2 +028800 CLOSE-FILES. RL1014.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1014.2 +029000 TERMINATE-CCVS. RL1014.2 +029100*S EXIT PROGRAM. RL1014.2 +029200*SERMINATE-CALL. RL1014.2 +029300 STOP RUN. RL1014.2 +029400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1014.2 +029500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1014.2 +029600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1014.2 +029700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1014.2 +029800 MOVE "****TEST DELETED****" TO RE-MARK. RL1014.2 +029900 PRINT-DETAIL. RL1014.2 +030000 IF REC-CT NOT EQUAL TO ZERO RL1014.2 +030100 MOVE "." TO PARDOT-X RL1014.2 +030200 MOVE REC-CT TO DOTVALUE. RL1014.2 +030300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1014.2 +030400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1014.2 +030500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1014.2 +030600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1014.2 +030700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1014.2 +030800 MOVE SPACE TO CORRECT-X. RL1014.2 +030900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1014.2 +031000 MOVE SPACE TO RE-MARK. RL1014.2 +031100 HEAD-ROUTINE. RL1014.2 +031200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +031300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +031400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1014.2 +031500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1014.2 +031600 COLUMN-NAMES-ROUTINE. RL1014.2 +031700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +031800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +031900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +032000 END-ROUTINE. RL1014.2 +032100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1014.2 +032200 END-RTN-EXIT. RL1014.2 +032300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +032400 END-ROUTINE-1. RL1014.2 +032500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1014.2 +032600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1014.2 +032700 ADD PASS-COUNTER TO ERROR-HOLD. RL1014.2 +032800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1014.2 +032900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1014.2 +033000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1014.2 +033100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1014.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1014.2 +033300 END-ROUTINE-12. RL1014.2 +033400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1014.2 +033500 IF ERROR-COUNTER IS EQUAL TO ZERO RL1014.2 +033600 MOVE "NO " TO ERROR-TOTAL RL1014.2 +033700 ELSE RL1014.2 +033800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1014.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1014.2 +034000 PERFORM WRITE-LINE. RL1014.2 +034100 END-ROUTINE-13. RL1014.2 +034200 IF DELETE-COUNTER IS EQUAL TO ZERO RL1014.2 +034300 MOVE "NO " TO ERROR-TOTAL ELSE RL1014.2 +034400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1014.2 +034500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1014.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +034700 IF INSPECT-COUNTER EQUAL TO ZERO RL1014.2 +034800 MOVE "NO " TO ERROR-TOTAL RL1014.2 +034900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1014.2 +035000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1014.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +035200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1014.2 +035300 WRITE-LINE. RL1014.2 +035400 ADD 1 TO RECORD-COUNT. RL1014.2 +035500 IF RECORD-COUNT GREATER 50 RL1014.2 +035600 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1014.2 +035700 MOVE SPACE TO DUMMY-RECORD RL1014.2 +035800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1014.2 +035900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1014.2 +036000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1014.2 +036100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1014.2 +036200 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1014.2 +036300 MOVE ZERO TO RECORD-COUNT. RL1014.2 +036400 PERFORM WRT-LN. RL1014.2 +036500 WRT-LN. RL1014.2 +036600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1014.2 +036700 MOVE SPACE TO DUMMY-RECORD. RL1014.2 +036800 BLANK-LINE-PRINT. RL1014.2 +036900 PERFORM WRT-LN. RL1014.2 +037000 FAIL-ROUTINE. RL1014.2 +037100 IF COMPUTED-X NOT EQUAL TO SPACE RL1014.2 +037200 GO TO FAIL-ROUTINE-WRITE. RL1014.2 +037300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1014.2 +037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1014.2 +037500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1014.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. RL1014.2 +037800 GO TO FAIL-ROUTINE-EX. RL1014.2 +037900 FAIL-ROUTINE-WRITE. RL1014.2 +038000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1014.2 +038100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1014.2 +038200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1014.2 +038300 MOVE SPACES TO COR-ANSI-REFERENCE. RL1014.2 +038400 FAIL-ROUTINE-EX. EXIT. RL1014.2 +038500 BAIL-OUT. RL1014.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1014.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1014.2 +038800 BAIL-OUT-WRITE. RL1014.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1014.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1014.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1014.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1014.2 +039300 BAIL-OUT-EX. EXIT. RL1014.2 +039400 CCVS1-EXIT. RL1014.2 +039500 EXIT. RL1014.2 +039600 SECT-RL101-001 SECTION. RL1014.2 +039700 REL-INIT-001. RL1014.2 +039800 MOVE "FILE CREATE RL-FS2" TO FEATURE. RL1014.2 +039900 OPEN OUTPUT RL-FS2. RL1014.2 +040000 MOVE "RL-FS2" TO XFILE-NAME (1). RL1014.2 +040100 MOVE "R1-F-G" TO XRECORD-NAME (1). RL1014.2 +040200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1014.2 +040300 MOVE 000120 TO XRECORD-LENGTH (1). RL1014.2 +040400 MOVE "RC" TO CHARS-OR-RECORDS (1). RL1014.2 +040500 MOVE 0001 TO XBLOCK-SIZE (1). RL1014.2 +040600 MOVE 000500 TO RECORDS-IN-FILE (1). RL1014.2 +040700 MOVE "RL" TO XFILE-ORGANIZATION (1). RL1014.2 +040800 MOVE "S" TO XLABEL-TYPE (1). RL1014.2 +040900 MOVE 000001 TO XRECORD-NUMBER (1). RL1014.2 +041000 REL-TEST-001. RL1014.2 +041100 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS2R1-F-G-120. RL1014.2 +041200 WRITE RL-FS2R1-F-G-120 RL1014.2 +041300 INVALID KEY GO TO REL-FAIL-001. RL1014.2 +041400 IF XRECORD-NUMBER (1) EQUAL TO 500 RL1014.2 +041500 GO TO REL-WRITE-001. RL1014.2 +041600 ADD 000001 TO XRECORD-NUMBER (1). RL1014.2 +041700 GO TO REL-TEST-001. RL1014.2 +041800 REL-DELETE-001. RL1014.2 +041900 PERFORM DE-LETE. RL1014.2 +042000 GO TO REL-WRITE-001. RL1014.2 +042100 REL-FAIL-001. RL1014.2 +042200 PERFORM FAIL. RL1014.2 +042300 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL1014.2 +042400 REL-WRITE-001. RL1014.2 +042500 MOVE "REL-TEST-001" TO PAR-NAME RL1014.2 +042600 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL1014.2 +042700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL1014.2 +042800 PERFORM PRINT-DETAIL. RL1014.2 +042900 CLOSE RL-FS2. RL1014.2 +043000 REL-INIT-002. RL1014.2 +043100 OPEN INPUT RL-FS2. RL1014.2 +043200 MOVE ZERO TO WRK-CS-09V00. RL1014.2 +043300 REL-TEST-002. RL1014.2 +043400 READ RL-FS2 RL1014.2 +043500 AT END GO TO REL-TEST-002-1. RL1014.2 +043600 MOVE RL-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1014.2 +043700 ADD 1 TO WRK-CS-09V00. RL1014.2 +043800 IF WRK-CS-09V00 GREATER 500 RL1014.2 +043900 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL1014.2 +044000 GO TO REL-TEST-002-1. RL1014.2 +044100 GO TO REL-TEST-002. RL1014.2 +044200 REL-DELETE-002. RL1014.2 +044300 REL-TEST-002-1. RL1014.2 +044400 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL1014.2 +044500 PERFORM FAIL RL1014.2 +044600 ELSE RL1014.2 +044700 PERFORM PASS. RL1014.2 +044800 GO TO REL-WRITE-002. RL1014.2 +044900 REL-WRITE-002. RL1014.2 +045000 MOVE "REL-TEST-002" TO PAR-NAME. RL1014.2 +045100 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL1014.2 +045200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL1014.2 +045300 PERFORM PRINT-DETAIL. RL1014.2 +045400 CLOSE RL-FS2. RL1014.2 +045500 CCVS-EXIT SECTION. RL1014.2 +045600 CCVS-999999. RL1014.2 +045700 GO TO CLOSE-FILES. RL1014.2 diff --git a/tests/cobol85/RL/RL102A.SUB b/tests/cobol85/RL/RL102A.SUB new file mode 100644 index 00000000..9b72b2e8 --- /dev/null +++ b/tests/cobol85/RL/RL102A.SUB @@ -0,0 +1,617 @@ +000100 IDENTIFICATION DIVISION. RL1024.2 +000200 PROGRAM-ID. RL1024.2 +000300 RL102A. RL1024.2 +000400**************************************************************** RL1024.2 +000500* * RL1024.2 +000600* VALIDATION FOR:- * RL1024.2 +000700* * RL1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1024.2 +000900* * RL1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1024.2 +001100* * RL1024.2 +001200**************************************************************** RL1024.2 +001300*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVERL1024.2 +001400* I-O FILE RANDOMLY (ACCESS MODE IS RANDOM). THE FILE RL1024.2 +001500* USED AS INPUT IS THAT FILE CREATED BY RL101. RL1024.2 +001600* RL1024.2 +001700* FIRST THE FILE IS VERIFED AS TO THE EXISTANCE AND RL1024.2 +001800* ACCURACY OF THE 500 RECORDS CREATED IN THE FIRST RL1024.2 +001900* PROGRAM. SECONDLY, RECORDS OF THE FILE ARE SEL- RL1024.2 +002000* ECTIVELY UPDATED; AND THIRDLY, THE ACCURACY OF EACH RL1024.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL1024.2 +002200* RL1024.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1024.2 +002400* PROGRAM ARE: RL1024.2 +002500* RL1024.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1024.2 +002700* RELATIVE I-O DATA FILE RL1024.2 +002800* X-55 SYSTEM PRINTER RL1024.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL1024.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL1024.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL1024.2 +003200* X-82 SOURCE-COMPUTER RL1024.2 +003300* X-83 OBJECT-COMPUTER. RL1024.2 +003400* RL1024.2 +003500**************************************************************** RL1024.2 +003600 ENVIRONMENT DIVISION. RL1024.2 +003700 CONFIGURATION SECTION. RL1024.2 +003800 SOURCE-COMPUTER. RL1024.2 +003900 Linux. RL1024.2 +004000 OBJECT-COMPUTER. RL1024.2 +004100 Linux. RL1024.2 +004200 INPUT-OUTPUT SECTION. RL1024.2 +004300 FILE-CONTROL. RL1024.2 +004400 SELECT PRINT-FILE ASSIGN TO RL1024.2 +004500 "report.log". RL1024.2 +004600 SELECT RL-FR1 ASSIGN TO RL1024.2 +004700 "XXXXX021" RL1024.2 +004800 ORGANIZATION IS RELATIVE RL1024.2 +004900 ACCESS MODE IS RANDOM RL1024.2 +005000 RELATIVE KEY RL-FR1-KEY. RL1024.2 +005100 DATA DIVISION. RL1024.2 +005200 FILE SECTION. RL1024.2 +005300 FD PRINT-FILE. RL1024.2 +005400 01 PRINT-REC PICTURE X(120). RL1024.2 +005500 01 DUMMY-RECORD PICTURE X(120). RL1024.2 +005600 FD RL-FR1 RL1024.2 +005700 LABEL RECORDS STANDARD RL1024.2 +005800*C VALUE OF RL1024.2 +005900*C OCLABELID RL1024.2 +006000*C IS RL1024.2 +006100*C "OCDUMMY" RL1024.2 +006200*G SYSIN RL1024.2 +006300 BLOCK CONTAINS 1 RECORDS RL1024.2 +006400 RECORD CONTAINS 120 CHARACTERS. RL1024.2 +006500 01 RL-FR1R1-F-G-120. RL1024.2 +006600 02 FILLER PICTURE X(120). RL1024.2 +006700 WORKING-STORAGE SECTION. RL1024.2 +006800 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +006900 01 RL-FR1-KEY PIC 9(09) USAGE COMP VALUE ZERO. RL1024.2 +007000 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. RL1024.2 +007100 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007200 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007300 01 I-O-ERROR-RL-FR1 PIC X(3) VALUE "NO ". RL1024.2 +007400 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007500 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007600 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. RL1024.2 +007700 01 WRK-DS-09V00-001 PIC S9(09) VALUE ZERO. RL1024.2 +007800 01 FILE-RECORD-INFORMATION-REC. RL1024.2 +007900 03 FILE-RECORD-INFO-SKELETON. RL1024.2 +008000 05 FILLER PICTURE X(48) VALUE RL1024.2 +008100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1024.2 +008200 05 FILLER PICTURE X(46) VALUE RL1024.2 +008300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1024.2 +008400 05 FILLER PICTURE X(26) VALUE RL1024.2 +008500 ",LFIL=000000,ORG= ,LBLR= ". RL1024.2 +008600 05 FILLER PICTURE X(37) VALUE RL1024.2 +008700 ",RECKEY= ". RL1024.2 +008800 05 FILLER PICTURE X(38) VALUE RL1024.2 +008900 ",ALTKEY1= ". RL1024.2 +009000 05 FILLER PICTURE X(38) VALUE RL1024.2 +009100 ",ALTKEY2= ". RL1024.2 +009200 05 FILLER PICTURE X(7) VALUE SPACE.RL1024.2 +009300 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1024.2 +009400 05 FILE-RECORD-INFO-P1-120. RL1024.2 +009500 07 FILLER PIC X(5). RL1024.2 +009600 07 XFILE-NAME PIC X(6). RL1024.2 +009700 07 FILLER PIC X(8). RL1024.2 +009800 07 XRECORD-NAME PIC X(6). RL1024.2 +009900 07 FILLER PIC X(1). RL1024.2 +010000 07 REELUNIT-NUMBER PIC 9(1). RL1024.2 +010100 07 FILLER PIC X(7). RL1024.2 +010200 07 XRECORD-NUMBER PIC 9(6). RL1024.2 +010300 07 FILLER PIC X(6). RL1024.2 +010400 07 UPDATE-NUMBER PIC 9(2). RL1024.2 +010500 07 FILLER PIC X(5). RL1024.2 +010600 07 ODO-NUMBER PIC 9(4). RL1024.2 +010700 07 FILLER PIC X(5). RL1024.2 +010800 07 XPROGRAM-NAME PIC X(5). RL1024.2 +010900 07 FILLER PIC X(7). RL1024.2 +011000 07 XRECORD-LENGTH PIC 9(6). RL1024.2 +011100 07 FILLER PIC X(7). RL1024.2 +011200 07 CHARS-OR-RECORDS PIC X(2). RL1024.2 +011300 07 FILLER PIC X(1). RL1024.2 +011400 07 XBLOCK-SIZE PIC 9(4). RL1024.2 +011500 07 FILLER PIC X(6). RL1024.2 +011600 07 RECORDS-IN-FILE PIC 9(6). RL1024.2 +011700 07 FILLER PIC X(5). RL1024.2 +011800 07 XFILE-ORGANIZATION PIC X(2). RL1024.2 +011900 07 FILLER PIC X(6). RL1024.2 +012000 07 XLABEL-TYPE PIC X(1). RL1024.2 +012100 05 FILE-RECORD-INFO-P121-240. RL1024.2 +012200 07 FILLER PIC X(8). RL1024.2 +012300 07 XRECORD-KEY PIC X(29). RL1024.2 +012400 07 FILLER PIC X(9). RL1024.2 +012500 07 ALTERNATE-KEY1 PIC X(29). RL1024.2 +012600 07 FILLER PIC X(9). RL1024.2 +012700 07 ALTERNATE-KEY2 PIC X(29). RL1024.2 +012800 07 FILLER PIC X(7). RL1024.2 +012900 01 TEST-RESULTS. RL1024.2 +013000 02 FILLER PIC X VALUE SPACE. RL1024.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. RL1024.2 +013200 02 FILLER PIC X VALUE SPACE. RL1024.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. RL1024.2 +013400 02 FILLER PIC X VALUE SPACE. RL1024.2 +013500 02 PAR-NAME. RL1024.2 +013600 03 FILLER PIC X(19) VALUE SPACE. RL1024.2 +013700 03 PARDOT-X PIC X VALUE SPACE. RL1024.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. RL1024.2 +013900 02 FILLER PIC X(8) VALUE SPACE. RL1024.2 +014000 02 RE-MARK PIC X(61). RL1024.2 +014100 01 TEST-COMPUTED. RL1024.2 +014200 02 FILLER PIC X(30) VALUE SPACE. RL1024.2 +014300 02 FILLER PIC X(17) VALUE RL1024.2 +014400 " COMPUTED=". RL1024.2 +014500 02 COMPUTED-X. RL1024.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1024.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A RL1024.2 +014800 PIC -9(9).9(9). RL1024.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1024.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1024.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1024.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. RL1024.2 +015300 04 COMPUTED-18V0 PIC -9(18). RL1024.2 +015400 04 FILLER PIC X. RL1024.2 +015500 03 FILLER PIC X(50) VALUE SPACE. RL1024.2 +015600 01 TEST-CORRECT. RL1024.2 +015700 02 FILLER PIC X(30) VALUE SPACE. RL1024.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". RL1024.2 +015900 02 CORRECT-X. RL1024.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. RL1024.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1024.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1024.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1024.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1024.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. RL1024.2 +016600 04 CORRECT-18V0 PIC -9(18). RL1024.2 +016700 04 FILLER PIC X. RL1024.2 +016800 03 FILLER PIC X(2) VALUE SPACE. RL1024.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1024.2 +017000 01 CCVS-C-1. RL1024.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1024.2 +017200- "SS PARAGRAPH-NAME RL1024.2 +017300- " REMARKS". RL1024.2 +017400 02 FILLER PIC X(20) VALUE SPACE. RL1024.2 +017500 01 CCVS-C-2. RL1024.2 +017600 02 FILLER PIC X VALUE SPACE. RL1024.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". RL1024.2 +017800 02 FILLER PIC X(15) VALUE SPACE. RL1024.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". RL1024.2 +018000 02 FILLER PIC X(94) VALUE SPACE. RL1024.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1024.2 +018200 01 REC-CT PIC 99 VALUE ZERO. RL1024.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1024.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1024.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1024.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1024.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1024.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1024.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1024.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1024.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1024.2 +019200 01 CCVS-H-1. RL1024.2 +019300 02 FILLER PIC X(39) VALUE SPACES. RL1024.2 +019400 02 FILLER PIC X(42) VALUE RL1024.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1024.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL1024.2 +019700 01 CCVS-H-2A. RL1024.2 +019800 02 FILLER PIC X(40) VALUE SPACE. RL1024.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1024.2 +020000 02 FILLER PIC XXXX VALUE RL1024.2 +020100 "4.2 ". RL1024.2 +020200 02 FILLER PIC X(28) VALUE RL1024.2 +020300 " COPY - NOT FOR DISTRIBUTION". RL1024.2 +020400 02 FILLER PIC X(41) VALUE SPACE. RL1024.2 +020500 RL1024.2 +020600 01 CCVS-H-2B. RL1024.2 +020700 02 FILLER PIC X(15) VALUE RL1024.2 +020800 "TEST RESULT OF ". RL1024.2 +020900 02 TEST-ID PIC X(9). RL1024.2 +021000 02 FILLER PIC X(4) VALUE RL1024.2 +021100 " IN ". RL1024.2 +021200 02 FILLER PIC X(12) VALUE RL1024.2 +021300 " HIGH ". RL1024.2 +021400 02 FILLER PIC X(22) VALUE RL1024.2 +021500 " LEVEL VALIDATION FOR ". RL1024.2 +021600 02 FILLER PIC X(58) VALUE RL1024.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1024.2 +021800 01 CCVS-H-3. RL1024.2 +021900 02 FILLER PIC X(34) VALUE RL1024.2 +022000 " FOR OFFICIAL USE ONLY ". RL1024.2 +022100 02 FILLER PIC X(58) VALUE RL1024.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1024.2 +022300 02 FILLER PIC X(28) VALUE RL1024.2 +022400 " COPYRIGHT 1985 ". RL1024.2 +022500 01 CCVS-E-1. RL1024.2 +022600 02 FILLER PIC X(52) VALUE SPACE. RL1024.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1024.2 +022800 02 ID-AGAIN PIC X(9). RL1024.2 +022900 02 FILLER PIC X(45) VALUE SPACES. RL1024.2 +023000 01 CCVS-E-2. RL1024.2 +023100 02 FILLER PIC X(31) VALUE SPACE. RL1024.2 +023200 02 FILLER PIC X(21) VALUE SPACE. RL1024.2 +023300 02 CCVS-E-2-2. RL1024.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1024.2 +023500 03 FILLER PIC X VALUE SPACE. RL1024.2 +023600 03 ENDER-DESC PIC X(44) VALUE RL1024.2 +023700 "ERRORS ENCOUNTERED". RL1024.2 +023800 01 CCVS-E-3. RL1024.2 +023900 02 FILLER PIC X(22) VALUE RL1024.2 +024000 " FOR OFFICIAL USE ONLY". RL1024.2 +024100 02 FILLER PIC X(12) VALUE SPACE. RL1024.2 +024200 02 FILLER PIC X(58) VALUE RL1024.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1024.2 +024400 02 FILLER PIC X(13) VALUE SPACE. RL1024.2 +024500 02 FILLER PIC X(15) VALUE RL1024.2 +024600 " COPYRIGHT 1985". RL1024.2 +024700 01 CCVS-E-4. RL1024.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1024.2 +024900 02 FILLER PIC X(4) VALUE " OF ". RL1024.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1024.2 +025100 02 FILLER PIC X(40) VALUE RL1024.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". RL1024.2 +025300 01 XXINFO. RL1024.2 +025400 02 FILLER PIC X(19) VALUE RL1024.2 +025500 "*** INFORMATION ***". RL1024.2 +025600 02 INFO-TEXT. RL1024.2 +025700 04 FILLER PIC X(8) VALUE SPACE. RL1024.2 +025800 04 XXCOMPUTED PIC X(20). RL1024.2 +025900 04 FILLER PIC X(5) VALUE SPACE. RL1024.2 +026000 04 XXCORRECT PIC X(20). RL1024.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). RL1024.2 +026200 01 HYPHEN-LINE. RL1024.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. RL1024.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************RL1024.2 +026500- "*****************************************". RL1024.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************RL1024.2 +026700- "******************************". RL1024.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE RL1024.2 +026900 "RL102A". RL1024.2 +027000 PROCEDURE DIVISION. RL1024.2 +027100 CCVS1 SECTION. RL1024.2 +027200 OPEN-FILES. RL1024.2 +027300 OPEN OUTPUT PRINT-FILE. RL1024.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1024.2 +027500 MOVE SPACE TO TEST-RESULTS. RL1024.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1024.2 +027700 MOVE ZERO TO REC-SKL-SUB. RL1024.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. RL1024.2 +027900 CCVS-INIT-FILE. RL1024.2 +028000 ADD 1 TO REC-SKL-SUB. RL1024.2 +028100 MOVE FILE-RECORD-INFO-SKELETON RL1024.2 +028200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1024.2 +028300 CCVS-INIT-EXIT. RL1024.2 +028400 GO TO CCVS1-EXIT. RL1024.2 +028500 CLOSE-FILES. RL1024.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1024.2 +028700 TERMINATE-CCVS. RL1024.2 +028800*S EXIT PROGRAM. RL1024.2 +028900*SERMINATE-CALL. RL1024.2 +029000 STOP RUN. RL1024.2 +029100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1024.2 +029200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1024.2 +029300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1024.2 +029400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1024.2 +029500 MOVE "****TEST DELETED****" TO RE-MARK. RL1024.2 +029600 PRINT-DETAIL. RL1024.2 +029700 IF REC-CT NOT EQUAL TO ZERO RL1024.2 +029800 MOVE "." TO PARDOT-X RL1024.2 +029900 MOVE REC-CT TO DOTVALUE. RL1024.2 +030000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1024.2 +030100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1024.2 +030200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1024.2 +030300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1024.2 +030400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1024.2 +030500 MOVE SPACE TO CORRECT-X. RL1024.2 +030600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1024.2 +030700 MOVE SPACE TO RE-MARK. RL1024.2 +030800 HEAD-ROUTINE. RL1024.2 +030900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +031000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +031100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1024.2 +031200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1024.2 +031300 COLUMN-NAMES-ROUTINE. RL1024.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +031700 END-ROUTINE. RL1024.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1024.2 +031900 END-RTN-EXIT. RL1024.2 +032000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +032100 END-ROUTINE-1. RL1024.2 +032200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1024.2 +032300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1024.2 +032400 ADD PASS-COUNTER TO ERROR-HOLD. RL1024.2 +032500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1024.2 +032600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1024.2 +032700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1024.2 +032800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1024.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1024.2 +033000 END-ROUTINE-12. RL1024.2 +033100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1024.2 +033200 IF ERROR-COUNTER IS EQUAL TO ZERO RL1024.2 +033300 MOVE "NO " TO ERROR-TOTAL RL1024.2 +033400 ELSE RL1024.2 +033500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1024.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1024.2 +033700 PERFORM WRITE-LINE. RL1024.2 +033800 END-ROUTINE-13. RL1024.2 +033900 IF DELETE-COUNTER IS EQUAL TO ZERO RL1024.2 +034000 MOVE "NO " TO ERROR-TOTAL ELSE RL1024.2 +034100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1024.2 +034200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1024.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +034400 IF INSPECT-COUNTER EQUAL TO ZERO RL1024.2 +034500 MOVE "NO " TO ERROR-TOTAL RL1024.2 +034600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1024.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1024.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1024.2 +035000 WRITE-LINE. RL1024.2 +035100 ADD 1 TO RECORD-COUNT. RL1024.2 +035200 IF RECORD-COUNT GREATER 50 RL1024.2 +035300 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1024.2 +035400 MOVE SPACE TO DUMMY-RECORD RL1024.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1024.2 +035600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1024.2 +035700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1024.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1024.2 +035900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1024.2 +036000 MOVE ZERO TO RECORD-COUNT. RL1024.2 +036100 PERFORM WRT-LN. RL1024.2 +036200 WRT-LN. RL1024.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1024.2 +036400 MOVE SPACE TO DUMMY-RECORD. RL1024.2 +036500 BLANK-LINE-PRINT. RL1024.2 +036600 PERFORM WRT-LN. RL1024.2 +036700 FAIL-ROUTINE. RL1024.2 +036800 IF COMPUTED-X NOT EQUAL TO SPACE RL1024.2 +036900 GO TO FAIL-ROUTINE-WRITE. RL1024.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1024.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1024.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1024.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1024.2 +037500 GO TO FAIL-ROUTINE-EX. RL1024.2 +037600 FAIL-ROUTINE-WRITE. RL1024.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1024.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1024.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1024.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. RL1024.2 +038100 FAIL-ROUTINE-EX. EXIT. RL1024.2 +038200 BAIL-OUT. RL1024.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1024.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1024.2 +038500 BAIL-OUT-WRITE. RL1024.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1024.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1024.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1024.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1024.2 +039000 BAIL-OUT-EX. EXIT. RL1024.2 +039100 CCVS1-EXIT. RL1024.2 +039200 EXIT. RL1024.2 +039300 SECT-RL102-001 SECTION. RL1024.2 +039400 REL-INIT-003. RL1024.2 +039500 OPEN INPUT RL-FR1. RL1024.2 +039600 MOVE "REL-TEST-003" TO PAR-NAME. RL1024.2 +039700 MOVE ZERO TO RL-FR1-KEY. RL1024.2 +039800 MOVE ZERO TO WRK-CS-09V00-002 RL1024.2 +039900 MOVE ZERO TO WRK-CS-09V00-003 RL1024.2 +040000* RL1024.2 +040100 MOVE 01 TO REC-CT. RL1024.2 +040200 MOVE "READ RANDOM" TO FEATURE. RL1024.2 +040300 REL-TEST-003-R. RL1024.2 +040400 ADD 1 TO WRK-CS-09V00-003 RL1024.2 +040500 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1024.2 +040600 IF RL-FR1-KEY GREATER +501 RL1024.2 +040700 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A RL1024.2 +040800 MOVE RL-FR1-KEY TO CORRECT-18V0 RL1024.2 +040900 PERFORM FAIL RL1024.2 +041000 PERFORM PRINT-DETAIL RL1024.2 +041100 ADD 1 TO REC-CT RL1024.2 +041200 GO TO REL-WRITE-003. RL1024.2 +041300 READ RL-FR1 RL1024.2 +041400 INVALID KEY GO TO REL-WRITE-003. RL1024.2 +041500 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1024.2 +041600 IF XRECORD-NUMBER (1) EQUAL TO RL-FR1-KEY RL1024.2 +041700 GO TO REL-TEST-003-R. RL1024.2 +041800 MOVE "YES" TO I-O-ERROR-RL-FR1. RL1024.2 +041900 ADD 1 TO WRK-CS-09V00-002 RL1024.2 +042000 GO TO REL-TEST-003-R. RL1024.2 +042100 REL-WRITE-003. RL1024.2 +042200 IF RL-FR1-KEY NOT EQUAL TO 501 RL1024.2 +042300 MOVE "WRONG KEY/NOT 500" TO CORRECT-A RL1024.2 +042400 MOVE RL-FR1-KEY TO COMPUTED-18V0 RL1024.2 +042500 PERFORM FAIL RL1024.2 +042600 ELSE RL1024.2 +042700 PERFORM PASS. RL1024.2 +042800 PERFORM PRINT-DETAIL. RL1024.2 +042900* RL1024.2 +043000*01 RL1024.2 +043100* RL1024.2 +043200 ADD 1 TO REC-CT. RL1024.2 +043300 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL1024.2 +043400 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A RL1024.2 +043500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 RL1024.2 +043600 PERFORM FAIL RL1024.2 +043700 ELSE RL1024.2 +043800 PERFORM PASS. RL1024.2 +043900 PERFORM PRINT-DETAIL. RL1024.2 +044000* RL1024.2 +044100*02 RL1024.2 +044200* RL1024.2 +044300 ADD 1 TO REC-CT. RL1024.2 +044400 IF WRK-CS-09V00-003 NOT EQUAL TO 501 RL1024.2 +044500 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1024.2 +044600 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL1024.2 +044700 MOVE 501 TO CORRECT-18V0 RL1024.2 +044800 PERFORM FAIL RL1024.2 +044900 ELSE RL1024.2 +045000 PERFORM PASS. RL1024.2 +045100 PERFORM PRINT-DETAIL. RL1024.2 +045200* RL1024.2 +045300*03 RL1024.2 +045400* RL1024.2 +045500 ADD 1 TO REC-CT. RL1024.2 +045600 IF I-O-ERROR-RL-FR1 EQUAL TO "YES" RL1024.2 +045700 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 RL1024.2 +045800 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK RL1024.2 +045900 PERFORM FAIL RL1024.2 +046000 ELSE RL1024.2 +046100 PERFORM PASS. RL1024.2 +046200 PERFORM PRINT-DETAIL. RL1024.2 +046300* RL1024.2 +046400*04 RL1024.2 +046500* RL1024.2 +046600 ADD 1 TO REC-CT. RL1024.2 +046700 CLOSE RL-FR1. RL1024.2 +046800 REL-INIT-004-R . RL1024.2 +046900 MOVE "REL-TEST-004" TO PAR-NAME. RL1024.2 +047000 OPEN I-O RL-FR1. RL1024.2 +047100 MOVE ZERO TO RL-FR1-KEY. RL1024.2 +047200 MOVE ZERO TO WRK-CS-09V00-002. RL1024.2 +047300 MOVE ZERO TO WRK-CS-09V00-003. RL1024.2 +047400 MOVE ZERO TO WRK-CS-09V00-004. RL1024.2 +047500 MOVE ZERO TO WRK-CS-09V00-005. RL1024.2 +047600* RL1024.2 +047700 MOVE 01 TO REC-CT. RL1024.2 +047800 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1024.2 +047900 MOVE "REWRITE" TO FEATURE. RL1024.2 +048000 REL-TEST-004-R. RL1024.2 +048100 ADD 5 TO WRK-CS-09V00-003. RL1024.2 +048200 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1024.2 +048300 IF RL-FR1-KEY GREATER 505 RL1024.2 +048400 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A RL1024.2 +048500 MOVE RL-FR1-KEY TO CORRECT-18V0 RL1024.2 +048600 PERFORM FAIL RL1024.2 +048700 PERFORM PRINT-DETAIL RL1024.2 +048800 ADD 1 TO REC-CT RL1024.2 +048900 GO TO REL-TEST-004-3. RL1024.2 +049000 READ RL-FR1 RL1024.2 +049100 INVALID KEY GO TO REL-TEST-004-1. RL1024.2 +049200 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1) RL1024.2 +049300 ADD 01 TO UPDATE-NUMBER (1). RL1024.2 +049400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1024.2 +049500 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FR1R1-F-G-120. RL1024.2 +049600 REWRITE RL-FR1R1-F-G-120 RL1024.2 +049700 INVALID KEY GO TO REL-TEST-004-2. RL1024.2 +049800 GO TO REL-TEST-004-R. RL1024.2 +049900 REL-TEST-004-1. RL1024.2 +050000 IF RL-FR1-KEY LESS THAN 501 RL1024.2 +050100 ADD 1 TO WRK-CS-09V00-004 RL1024.2 +050200 GO TO REL-TEST-004-R. RL1024.2 +050300 PERFORM PASS. RL1024.2 +050400 PERFORM PRINT-DETAIL. RL1024.2 +050500* RL1024.2 +050600*01 RL1024.2 +050700* RL1024.2 +050800 ADD 1 TO REC-CT. RL1024.2 +050900 GO TO REL-TEST-004-3. RL1024.2 +051000 REL-TEST-004-2. RL1024.2 +051100 ADD 1 TO WRK-CS-09V00-005. RL1024.2 +051200 IF RL-FR1-KEY LESS 501 RL1024.2 +051300 GO TO REL-TEST-004-R. RL1024.2 +051400 REL-TEST-004-3. RL1024.2 +051500 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO RL1024.2 +051600 MOVE "INVALID KEY ON READ" TO COMPUTED-A RL1024.2 +051700 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL1024.2 +051800 PERFORM FAIL RL1024.2 +051900 ELSE RL1024.2 +052000 PERFORM PASS. RL1024.2 +052100 PERFORM PRINT-DETAIL. RL1024.2 +052200* RL1024.2 +052300*02 RL1024.2 +052400* RL1024.2 +052500 ADD 1 TO REC-CT. RL1024.2 +052600 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO RL1024.2 +052700 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A RL1024.2 +052800 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL1024.2 +052900 PERFORM FAIL RL1024.2 +053000 ELSE RL1024.2 +053100 PERFORM PASS. RL1024.2 +053200 PERFORM PRINT-DETAIL. RL1024.2 +053300* RL1024.2 +053400*03 RL1024.2 +053500* RL1024.2 +053600 ADD 1 TO REC-CT. RL1024.2 +053700 CLOSE RL-FR1. RL1024.2 +053800 REL-INIT-005. RL1024.2 +053900 MOVE "REL-TEST-005" TO PAR-NAME. RL1024.2 +054000 OPEN INPUT RL-FR1. RL1024.2 +054100 MOVE 501 TO WRK-CS-09V00-003. RL1024.2 +054200 MOVE ZERO TO WRK-CS-09V00-004. RL1024.2 +054300 MOVE ZERO TO WRK-CS-09V00-005. RL1024.2 +054400 MOVE ZERO TO WRK-CS-09V00-002. RL1024.2 +054500 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1024.2 +054600 MOVE 01 TO REC-CT. RL1024.2 +054700* RL1024.2 +054800 MOVE "READ RANDOM" TO FEATURE. RL1024.2 +054900 REL-TEST-005-R. RL1024.2 +055000 SUBTRACT 1 FROM WRK-CS-09V00-003. RL1024.2 +055100 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1024.2 +055200 IF WRK-CS-09V00-003 LESS THAN ZERO RL1024.2 +055300 MOVE "INVALID KEY/NOT TAKEN" TO RE-MARK RL1024.2 +055400 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL1024.2 +055500 MOVE ZERO TO CORRECT-18V0 RL1024.2 +055600 PERFORM FAIL RL1024.2 +055700 PERFORM PRINT-DETAIL RL1024.2 +055800 ADD 1 TO REC-CT RL1024.2 +055900 GO TO REL-TEST-005-3. RL1024.2 +056000 READ RL-FR1 RL1024.2 +056100 INVALID KEY GO TO REL-TEST-005-1. RL1024.2 +056200 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1024.2 +056300 IF UPDATE-NUMBER (1) EQUAL TO 00 RL1024.2 +056400 ADD 1 TO WRK-CS-09V00-004. RL1024.2 +056500 IF UPDATE-NUMBER (1) EQUAL TO 01 RL1024.2 +056600 ADD 1 TO WRK-CS-09V00-005. RL1024.2 +056700 GO TO REL-TEST-005-R. RL1024.2 +056800 REL-TEST-005-1. RL1024.2 +056900 IF RL-FR1-KEY GREATER ZERO RL1024.2 +057000 ADD 1 TO WRK-CS-09V00-002 RL1024.2 +057100 GO TO REL-TEST-005-R. RL1024.2 +057200 PERFORM PASS. RL1024.2 +057300 PERFORM PRINT-DETAIL. RL1024.2 +057400 ADD 1 TO REC-CT. RL1024.2 +057500*01 RL1024.2 +057600 GO TO REL-TEST-005-3. RL1024.2 +057700 REL-TEST-005-3. RL1024.2 +057800 IF WRK-CS-09V00-004 NOT EQUAL TO 400 RL1024.2 +057900 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL1024.2 +058000 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL1024.2 +058100 MOVE "SHOULD BE 400" TO RE-MARK RL1024.2 +058200 PERFORM FAIL RL1024.2 +058300 ELSE RL1024.2 +058400 PERFORM PASS. RL1024.2 +058500 PERFORM PRINT-DETAIL. RL1024.2 +058600* RL1024.2 +058700* RL1024.2 +058800*02 RL1024.2 +058900* RL1024.2 +059000 ADD 1 TO REC-CT. RL1024.2 +059100 IF WRK-CS-09V00-005 NOT EQUAL TO 100 RL1024.2 +059200 MOVE "UPDATED RECORDS" TO COMPUTED-A RL1024.2 +059300 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL1024.2 +059400 MOVE "SHOULD BE 100" TO RE-MARK RL1024.2 +059500 PERFORM FAIL RL1024.2 +059600 ELSE RL1024.2 +059700 PERFORM PASS. RL1024.2 +059800 PERFORM PRINT-DETAIL. RL1024.2 +059900* RL1024.2 +060000*03 RL1024.2 +060100* RL1024.2 +060200 ADD 1 TO REC-CT. RL1024.2 +060300 IF WRK-CS-09V00-002 GREATER 1 RL1024.2 +060400 MOVE WRK-CS-09V00-002 TO COMPUTED-N RL1024.2 +060500 MOVE "INVALID KEY/READS" TO CORRECT-A RL1024.2 +060600 PERFORM FAIL RL1024.2 +060700 ELSE RL1024.2 +060800 PERFORM PASS. RL1024.2 +060900 PERFORM PRINT-DETAIL. RL1024.2 +061000* RL1024.2 +061100*04 RL1024.2 +061200* RL1024.2 +061300 ADD 1 TO REC-CT. RL1024.2 +061400 CLOSE RL-FR1. RL1024.2 +061500 CCVS-EXIT SECTION. RL1024.2 +061600 CCVS-999999. RL1024.2 +061700 GO TO CLOSE-FILES. RL1024.2 diff --git a/tests/cobol85/RL/RL103A.SUB b/tests/cobol85/RL/RL103A.SUB new file mode 100644 index 00000000..ffcc47eb --- /dev/null +++ b/tests/cobol85/RL/RL103A.SUB @@ -0,0 +1,616 @@ +000100 IDENTIFICATION DIVISION. RL1034.2 +000200 PROGRAM-ID. RL1034.2 +000300 RL103A. RL1034.2 +000400**************************************************************** RL1034.2 +000500* * RL1034.2 +000600* VALIDATION FOR:- * RL1034.2 +000700* * RL1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1034.2 +000900* * RL1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1034.2 +001100* * RL1034.2 +001200**************************************************************** RL1034.2 +001300*GENERAL: THIS PROGRAM IS THE THIRD OF A SERIES. THE FUNCTION RL1034.2 +001400* OF THIS PROGRAM IS TO PROCESS THE FILE SEQUENTIALLY RL1034.2 +001500* (ACCESS MODE IS SEQUENTIAL). THE FILE USED IS THAT RL1034.2 +001600* RESULTING FROM RL102. RL1034.2 +001700* RL1034.2 +001800* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RL1034.2 +001900* RECORDS. SECONDLY, RECORDS OF THER FILE ARE RL1034.2 +002000* SELECTIVELY DELETED AND THIRDLY THE ACCURACY OF EACH RL1034.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL1034.2 +002200* RL1034.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1034.2 +002400* PROGRAM ARE: RL1034.2 +002500* RL1034.2 +002600* RL1034.2 +002700* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1034.2 +002800* RELATIVE I-O DATA FILE RL1034.2 +002900* X-55 SYSTEM PRINTER RL1034.2 +003000* X-69 ADDITIONAL VALUE OF CLAUSES RL1034.2 +003100* X-74 VALUE OF IMPLEMENTOR-NAME RL1034.2 +003200* X-75 OBJECT OF VALUE OF CLAUSE RL1034.2 +003300* X-82 SOURCE-COMPUTER RL1034.2 +003400* X-83 OBJECT-COMPUTER. RL1034.2 +003500* RL1034.2 +003600**************************************************************** RL1034.2 +003700 ENVIRONMENT DIVISION. RL1034.2 +003800 CONFIGURATION SECTION. RL1034.2 +003900 SOURCE-COMPUTER. RL1034.2 +004000 Linux. RL1034.2 +004100 OBJECT-COMPUTER. RL1034.2 +004200 Linux. RL1034.2 +004300 INPUT-OUTPUT SECTION. RL1034.2 +004400 FILE-CONTROL. RL1034.2 +004500 SELECT PRINT-FILE ASSIGN TO RL1034.2 +004600 "report.log". RL1034.2 +004700 SELECT RL-FS1 ASSIGN TO RL1034.2 +004800 "XXXXX021" RL1034.2 +004900 ORGANIZATION IS RELATIVE RL1034.2 +005000 ACCESS MODE IS SEQUENTIAL RL1034.2 +005100 RELATIVE KEY IS RL-FS1-KEY. RL1034.2 +005200 DATA DIVISION. RL1034.2 +005300 FILE SECTION. RL1034.2 +005400 FD PRINT-FILE. RL1034.2 +005500 01 PRINT-REC PICTURE X(120). RL1034.2 +005600 01 DUMMY-RECORD PICTURE X(120). RL1034.2 +005700 FD RL-FS1 RL1034.2 +005800 LABEL RECORDS STANDARD RL1034.2 +005900*C VALUE OF RL1034.2 +006000*C OCLABELID RL1034.2 +006100*C IS RL1034.2 +006200*C "OCDUMMY" RL1034.2 +006300*G SYSIN RL1034.2 +006400 BLOCK CONTAINS 01 RECORDS RL1034.2 +006500 RECORD CONTAINS 120. RL1034.2 +006600 01 RL-FS1R1-F-G-120. RL1034.2 +006700 02 RL-WRK-120 PIC X(120). RL1034.2 +006800 WORKING-STORAGE SECTION. RL1034.2 +006900 01 RL-FS1-KEY PIC 9(08) USAGE COMP VALUE ZERO. RL1034.2 +007000 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007100 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007200 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007300 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007400 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007500 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. RL1034.2 +007600 01 I-O-ERROR-RL-FS1 PIC X(3) VALUE "NO ". RL1034.2 +007700 01 FILE-RECORD-INFORMATION-REC. RL1034.2 +007800 03 FILE-RECORD-INFO-SKELETON. RL1034.2 +007900 05 FILLER PICTURE X(48) VALUE RL1034.2 +008000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1034.2 +008100 05 FILLER PICTURE X(46) VALUE RL1034.2 +008200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1034.2 +008300 05 FILLER PICTURE X(26) VALUE RL1034.2 +008400 ",LFIL=000000,ORG= ,LBLR= ". RL1034.2 +008500 05 FILLER PICTURE X(37) VALUE RL1034.2 +008600 ",RECKEY= ". RL1034.2 +008700 05 FILLER PICTURE X(38) VALUE RL1034.2 +008800 ",ALTKEY1= ". RL1034.2 +008900 05 FILLER PICTURE X(38) VALUE RL1034.2 +009000 ",ALTKEY2= ". RL1034.2 +009100 05 FILLER PICTURE X(7) VALUE SPACE.RL1034.2 +009200 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1034.2 +009300 05 FILE-RECORD-INFO-P1-120. RL1034.2 +009400 07 FILLER PIC X(5). RL1034.2 +009500 07 XFILE-NAME PIC X(6). RL1034.2 +009600 07 FILLER PIC X(8). RL1034.2 +009700 07 XRECORD-NAME PIC X(6). RL1034.2 +009800 07 FILLER PIC X(1). RL1034.2 +009900 07 REELUNIT-NUMBER PIC 9(1). RL1034.2 +010000 07 FILLER PIC X(7). RL1034.2 +010100 07 XRECORD-NUMBER PIC 9(6). RL1034.2 +010200 07 FILLER PIC X(6). RL1034.2 +010300 07 UPDATE-NUMBER PIC 9(2). RL1034.2 +010400 07 FILLER PIC X(5). RL1034.2 +010500 07 ODO-NUMBER PIC 9(4). RL1034.2 +010600 07 FILLER PIC X(5). RL1034.2 +010700 07 XPROGRAM-NAME PIC X(5). RL1034.2 +010800 07 FILLER PIC X(7). RL1034.2 +010900 07 XRECORD-LENGTH PIC 9(6). RL1034.2 +011000 07 FILLER PIC X(7). RL1034.2 +011100 07 CHARS-OR-RECORDS PIC X(2). RL1034.2 +011200 07 FILLER PIC X(1). RL1034.2 +011300 07 XBLOCK-SIZE PIC 9(4). RL1034.2 +011400 07 FILLER PIC X(6). RL1034.2 +011500 07 RECORDS-IN-FILE PIC 9(6). RL1034.2 +011600 07 FILLER PIC X(5). RL1034.2 +011700 07 XFILE-ORGANIZATION PIC X(2). RL1034.2 +011800 07 FILLER PIC X(6). RL1034.2 +011900 07 XLABEL-TYPE PIC X(1). RL1034.2 +012000 05 FILE-RECORD-INFO-P121-240. RL1034.2 +012100 07 FILLER PIC X(8). RL1034.2 +012200 07 XRECORD-KEY PIC X(29). RL1034.2 +012300 07 FILLER PIC X(9). RL1034.2 +012400 07 ALTERNATE-KEY1 PIC X(29). RL1034.2 +012500 07 FILLER PIC X(9). RL1034.2 +012600 07 ALTERNATE-KEY2 PIC X(29). RL1034.2 +012700 07 FILLER PIC X(7). RL1034.2 +012800 01 TEST-RESULTS. RL1034.2 +012900 02 FILLER PIC X VALUE SPACE. RL1034.2 +013000 02 FEATURE PIC X(20) VALUE SPACE. RL1034.2 +013100 02 FILLER PIC X VALUE SPACE. RL1034.2 +013200 02 P-OR-F PIC X(5) VALUE SPACE. RL1034.2 +013300 02 FILLER PIC X VALUE SPACE. RL1034.2 +013400 02 PAR-NAME. RL1034.2 +013500 03 FILLER PIC X(19) VALUE SPACE. RL1034.2 +013600 03 PARDOT-X PIC X VALUE SPACE. RL1034.2 +013700 03 DOTVALUE PIC 99 VALUE ZERO. RL1034.2 +013800 02 FILLER PIC X(8) VALUE SPACE. RL1034.2 +013900 02 RE-MARK PIC X(61). RL1034.2 +014000 01 TEST-COMPUTED. RL1034.2 +014100 02 FILLER PIC X(30) VALUE SPACE. RL1034.2 +014200 02 FILLER PIC X(17) VALUE RL1034.2 +014300 " COMPUTED=". RL1034.2 +014400 02 COMPUTED-X. RL1034.2 +014500 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1034.2 +014600 03 COMPUTED-N REDEFINES COMPUTED-A RL1034.2 +014700 PIC -9(9).9(9). RL1034.2 +014800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1034.2 +014900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1034.2 +015000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1034.2 +015100 03 CM-18V0 REDEFINES COMPUTED-A. RL1034.2 +015200 04 COMPUTED-18V0 PIC -9(18). RL1034.2 +015300 04 FILLER PIC X. RL1034.2 +015400 03 FILLER PIC X(50) VALUE SPACE. RL1034.2 +015500 01 TEST-CORRECT. RL1034.2 +015600 02 FILLER PIC X(30) VALUE SPACE. RL1034.2 +015700 02 FILLER PIC X(17) VALUE " CORRECT =". RL1034.2 +015800 02 CORRECT-X. RL1034.2 +015900 03 CORRECT-A PIC X(20) VALUE SPACE. RL1034.2 +016000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1034.2 +016100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1034.2 +016200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1034.2 +016300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1034.2 +016400 03 CR-18V0 REDEFINES CORRECT-A. RL1034.2 +016500 04 CORRECT-18V0 PIC -9(18). RL1034.2 +016600 04 FILLER PIC X. RL1034.2 +016700 03 FILLER PIC X(2) VALUE SPACE. RL1034.2 +016800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1034.2 +016900 01 CCVS-C-1. RL1034.2 +017000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1034.2 +017100- "SS PARAGRAPH-NAME RL1034.2 +017200- " REMARKS". RL1034.2 +017300 02 FILLER PIC X(20) VALUE SPACE. RL1034.2 +017400 01 CCVS-C-2. RL1034.2 +017500 02 FILLER PIC X VALUE SPACE. RL1034.2 +017600 02 FILLER PIC X(6) VALUE "TESTED". RL1034.2 +017700 02 FILLER PIC X(15) VALUE SPACE. RL1034.2 +017800 02 FILLER PIC X(4) VALUE "FAIL". RL1034.2 +017900 02 FILLER PIC X(94) VALUE SPACE. RL1034.2 +018000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1034.2 +018100 01 REC-CT PIC 99 VALUE ZERO. RL1034.2 +018200 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1034.2 +018300 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1034.2 +018400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1034.2 +018500 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1034.2 +018600 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1034.2 +018700 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1034.2 +018800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1034.2 +018900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1034.2 +019000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1034.2 +019100 01 CCVS-H-1. RL1034.2 +019200 02 FILLER PIC X(39) VALUE SPACES. RL1034.2 +019300 02 FILLER PIC X(42) VALUE RL1034.2 +019400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1034.2 +019500 02 FILLER PIC X(39) VALUE SPACES. RL1034.2 +019600 01 CCVS-H-2A. RL1034.2 +019700 02 FILLER PIC X(40) VALUE SPACE. RL1034.2 +019800 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1034.2 +019900 02 FILLER PIC XXXX VALUE RL1034.2 +020000 "4.2 ". RL1034.2 +020100 02 FILLER PIC X(28) VALUE RL1034.2 +020200 " COPY - NOT FOR DISTRIBUTION". RL1034.2 +020300 02 FILLER PIC X(41) VALUE SPACE. RL1034.2 +020400 RL1034.2 +020500 01 CCVS-H-2B. RL1034.2 +020600 02 FILLER PIC X(15) VALUE RL1034.2 +020700 "TEST RESULT OF ". RL1034.2 +020800 02 TEST-ID PIC X(9). RL1034.2 +020900 02 FILLER PIC X(4) VALUE RL1034.2 +021000 " IN ". RL1034.2 +021100 02 FILLER PIC X(12) VALUE RL1034.2 +021200 " HIGH ". RL1034.2 +021300 02 FILLER PIC X(22) VALUE RL1034.2 +021400 " LEVEL VALIDATION FOR ". RL1034.2 +021500 02 FILLER PIC X(58) VALUE RL1034.2 +021600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1034.2 +021700 01 CCVS-H-3. RL1034.2 +021800 02 FILLER PIC X(34) VALUE RL1034.2 +021900 " FOR OFFICIAL USE ONLY ". RL1034.2 +022000 02 FILLER PIC X(58) VALUE RL1034.2 +022100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1034.2 +022200 02 FILLER PIC X(28) VALUE RL1034.2 +022300 " COPYRIGHT 1985 ". RL1034.2 +022400 01 CCVS-E-1. RL1034.2 +022500 02 FILLER PIC X(52) VALUE SPACE. RL1034.2 +022600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1034.2 +022700 02 ID-AGAIN PIC X(9). RL1034.2 +022800 02 FILLER PIC X(45) VALUE SPACES. RL1034.2 +022900 01 CCVS-E-2. RL1034.2 +023000 02 FILLER PIC X(31) VALUE SPACE. RL1034.2 +023100 02 FILLER PIC X(21) VALUE SPACE. RL1034.2 +023200 02 CCVS-E-2-2. RL1034.2 +023300 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1034.2 +023400 03 FILLER PIC X VALUE SPACE. RL1034.2 +023500 03 ENDER-DESC PIC X(44) VALUE RL1034.2 +023600 "ERRORS ENCOUNTERED". RL1034.2 +023700 01 CCVS-E-3. RL1034.2 +023800 02 FILLER PIC X(22) VALUE RL1034.2 +023900 " FOR OFFICIAL USE ONLY". RL1034.2 +024000 02 FILLER PIC X(12) VALUE SPACE. RL1034.2 +024100 02 FILLER PIC X(58) VALUE RL1034.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1034.2 +024300 02 FILLER PIC X(13) VALUE SPACE. RL1034.2 +024400 02 FILLER PIC X(15) VALUE RL1034.2 +024500 " COPYRIGHT 1985". RL1034.2 +024600 01 CCVS-E-4. RL1034.2 +024700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1034.2 +024800 02 FILLER PIC X(4) VALUE " OF ". RL1034.2 +024900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1034.2 +025000 02 FILLER PIC X(40) VALUE RL1034.2 +025100 " TESTS WERE EXECUTED SUCCESSFULLY". RL1034.2 +025200 01 XXINFO. RL1034.2 +025300 02 FILLER PIC X(19) VALUE RL1034.2 +025400 "*** INFORMATION ***". RL1034.2 +025500 02 INFO-TEXT. RL1034.2 +025600 04 FILLER PIC X(8) VALUE SPACE. RL1034.2 +025700 04 XXCOMPUTED PIC X(20). RL1034.2 +025800 04 FILLER PIC X(5) VALUE SPACE. RL1034.2 +025900 04 XXCORRECT PIC X(20). RL1034.2 +026000 02 INF-ANSI-REFERENCE PIC X(48). RL1034.2 +026100 01 HYPHEN-LINE. RL1034.2 +026200 02 FILLER PIC IS X VALUE IS SPACE. RL1034.2 +026300 02 FILLER PIC IS X(65) VALUE IS "************************RL1034.2 +026400- "*****************************************". RL1034.2 +026500 02 FILLER PIC IS X(54) VALUE IS "************************RL1034.2 +026600- "******************************". RL1034.2 +026700 01 CCVS-PGM-ID PIC X(9) VALUE RL1034.2 +026800 "RL103A". RL1034.2 +026900 PROCEDURE DIVISION. RL1034.2 +027000 CCVS1 SECTION. RL1034.2 +027100 OPEN-FILES. RL1034.2 +027200 OPEN OUTPUT PRINT-FILE. RL1034.2 +027300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1034.2 +027400 MOVE SPACE TO TEST-RESULTS. RL1034.2 +027500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1034.2 +027600 MOVE ZERO TO REC-SKL-SUB. RL1034.2 +027700 PERFORM CCVS-INIT-FILE 9 TIMES. RL1034.2 +027800 CCVS-INIT-FILE. RL1034.2 +027900 ADD 1 TO REC-SKL-SUB. RL1034.2 +028000 MOVE FILE-RECORD-INFO-SKELETON RL1034.2 +028100 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1034.2 +028200 CCVS-INIT-EXIT. RL1034.2 +028300 GO TO CCVS1-EXIT. RL1034.2 +028400 CLOSE-FILES. RL1034.2 +028500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1034.2 +028600 TERMINATE-CCVS. RL1034.2 +028700*S EXIT PROGRAM. RL1034.2 +028800*SERMINATE-CALL. RL1034.2 +028900 STOP RUN. RL1034.2 +029000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1034.2 +029100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1034.2 +029200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1034.2 +029300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1034.2 +029400 MOVE "****TEST DELETED****" TO RE-MARK. RL1034.2 +029500 PRINT-DETAIL. RL1034.2 +029600 IF REC-CT NOT EQUAL TO ZERO RL1034.2 +029700 MOVE "." TO PARDOT-X RL1034.2 +029800 MOVE REC-CT TO DOTVALUE. RL1034.2 +029900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1034.2 +030000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1034.2 +030100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1034.2 +030200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1034.2 +030300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1034.2 +030400 MOVE SPACE TO CORRECT-X. RL1034.2 +030500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1034.2 +030600 MOVE SPACE TO RE-MARK. RL1034.2 +030700 HEAD-ROUTINE. RL1034.2 +030800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +030900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +031000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1034.2 +031100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1034.2 +031200 COLUMN-NAMES-ROUTINE. RL1034.2 +031300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +031400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +031500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +031600 END-ROUTINE. RL1034.2 +031700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1034.2 +031800 END-RTN-EXIT. RL1034.2 +031900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +032000 END-ROUTINE-1. RL1034.2 +032100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1034.2 +032200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1034.2 +032300 ADD PASS-COUNTER TO ERROR-HOLD. RL1034.2 +032400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1034.2 +032500 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1034.2 +032600 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1034.2 +032700 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1034.2 +032800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1034.2 +032900 END-ROUTINE-12. RL1034.2 +033000 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1034.2 +033100 IF ERROR-COUNTER IS EQUAL TO ZERO RL1034.2 +033200 MOVE "NO " TO ERROR-TOTAL RL1034.2 +033300 ELSE RL1034.2 +033400 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1034.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1034.2 +033600 PERFORM WRITE-LINE. RL1034.2 +033700 END-ROUTINE-13. RL1034.2 +033800 IF DELETE-COUNTER IS EQUAL TO ZERO RL1034.2 +033900 MOVE "NO " TO ERROR-TOTAL ELSE RL1034.2 +034000 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1034.2 +034100 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1034.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +034300 IF INSPECT-COUNTER EQUAL TO ZERO RL1034.2 +034400 MOVE "NO " TO ERROR-TOTAL RL1034.2 +034500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1034.2 +034600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1034.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +034800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1034.2 +034900 WRITE-LINE. RL1034.2 +035000 ADD 1 TO RECORD-COUNT. RL1034.2 +035100 IF RECORD-COUNT GREATER 50 RL1034.2 +035200 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1034.2 +035300 MOVE SPACE TO DUMMY-RECORD RL1034.2 +035400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1034.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1034.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1034.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1034.2 +035800 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1034.2 +035900 MOVE ZERO TO RECORD-COUNT. RL1034.2 +036000 PERFORM WRT-LN. RL1034.2 +036100 WRT-LN. RL1034.2 +036200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1034.2 +036300 MOVE SPACE TO DUMMY-RECORD. RL1034.2 +036400 BLANK-LINE-PRINT. RL1034.2 +036500 PERFORM WRT-LN. RL1034.2 +036600 FAIL-ROUTINE. RL1034.2 +036700 IF COMPUTED-X NOT EQUAL TO SPACE RL1034.2 +036800 GO TO FAIL-ROUTINE-WRITE. RL1034.2 +036900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1034.2 +037000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1034.2 +037100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1034.2 +037200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +037300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1034.2 +037400 GO TO FAIL-ROUTINE-EX. RL1034.2 +037500 FAIL-ROUTINE-WRITE. RL1034.2 +037600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1034.2 +037700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1034.2 +037800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1034.2 +037900 MOVE SPACES TO COR-ANSI-REFERENCE. RL1034.2 +038000 FAIL-ROUTINE-EX. EXIT. RL1034.2 +038100 BAIL-OUT. RL1034.2 +038200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1034.2 +038300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1034.2 +038400 BAIL-OUT-WRITE. RL1034.2 +038500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1034.2 +038600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1034.2 +038700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1034.2 +038800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1034.2 +038900 BAIL-OUT-EX. EXIT. RL1034.2 +039000 CCVS1-EXIT. RL1034.2 +039100 EXIT. RL1034.2 +039200 SECT-RL103-001 SECTION. RL1034.2 +039300 REL-INIT-006. RL1034.2 +039400 MOVE 99 TO RL-FS1-KEY. RL1034.2 +039500* THIS FILE "RL-FS1" IS ACCESSED SEQUENTIALLY AND HAS RL1034.2 +039600* ASSOCIATED WITH IT A RELATIVE KEY WHICH AT ALL TIMES SHOULD RL1034.2 +039700* CONTAIN THE NUMBER OF THE RECORD PREVIOUSLY READ. RL1034.2 +039800 OPEN INPUT RL-FS1. RL1034.2 +039900 MOVE "REL-TEST-006" TO PAR-NAME. RL1034.2 +040000 MOVE ZERO TO WRK-CS-09V00-006. RL1034.2 +040100 MOVE ZERO TO WRK-CS-09V00-007. RL1034.2 +040200 MOVE ZERO TO WRK-CS-09V00-008. RL1034.2 +040300 MOVE ZERO TO WRK-CS-09V00-009. RL1034.2 +040400 MOVE ZERO TO WRK-CS-09V00-010. RL1034.2 +040500 MOVE ZERO TO WRK-CS-09V00-011. RL1034.2 +040600 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +040700 MOVE RL-FS1-KEY TO WRK-CS-09V00-011. RL1034.2 +040800 MOVE 01 TO REC-CT. RL1034.2 +040900 MOVE "READ SEQUENTIAL" TO FEATURE. RL1034.2 +041000 REL-TEST-006-R. RL1034.2 +041100 ADD 1 TO WRK-CS-09V00-006. RL1034.2 +041200 READ RL-FS1 RL1034.2 +041300 AT END GO TO REL-TEST-006-3. RL1034.2 +041400 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +041500 IF UPDATE-NUMBER (1) EQUAL TO 00 RL1034.2 +041600 ADD 1 TO WRK-CS-09V00-007 RL1034.2 +041700 GO TO REL-TEST-006-2. RL1034.2 +041800 IF UPDATE-NUMBER (1) EQUAL TO 01 RL1034.2 +041900 ADD 1 TO WRK-CS-09V00-008 RL1034.2 +042000 GO TO REL-TEST-006-2. RL1034.2 +042100 ADD 1 TO WRK-CS-09V00-009. RL1034.2 +042200 REL-TEST-006-2. RL1034.2 +042300 IF RL-FS1-KEY NOT EQUAL TO XRECORD-NUMBER (1) RL1034.2 +042400 ADD 1 TO WRK-CS-09V00-010. RL1034.2 +042500 IF WRK-CS-09V00-006 GREATER 501 RL1034.2 +042600 GO TO REL-TEST-006-3. RL1034.2 +042700 GO TO REL-TEST-006-R. RL1034.2 +042800 REL-TEST-006-3. RL1034.2 +042900 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL1034.2 +043000 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1034.2 +043100 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1034.2 +043200 MOVE 501 TO CORRECT-18V0 RL1034.2 +043300 PERFORM FAIL RL1034.2 +043400 ELSE RL1034.2 +043500 PERFORM PASS. RL1034.2 +043600 PERFORM PRINT-DETAIL. RL1034.2 +043700* .01 RL1034.2 +043800 ADD 1 TO REC-CT. RL1034.2 +043900 IF WRK-CS-09V00-007 EQUAL TO 400 RL1034.2 +044000 PERFORM PASS RL1034.2 +044100 ELSE RL1034.2 +044200 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL1034.2 +044300 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 RL1034.2 +044400 MOVE "SHOULD BE 400" TO RE-MARK RL1034.2 +044500 PERFORM FAIL. RL1034.2 +044600 PERFORM PRINT-DETAIL. RL1034.2 +044700 ADD 1 TO REC-CT. RL1034.2 +044800* .02 RL1034.2 +044900 IF WRK-CS-09V00-008 EQUAL TO 100 RL1034.2 +045000 PERFORM PASS RL1034.2 +045100 ELSE RL1034.2 +045200 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL1034.2 +045300 MOVE 100 TO CORRECT-18V0 RL1034.2 +045400 MOVE "UPDATED RECORDS" TO RE-MARK RL1034.2 +045500 PERFORM FAIL. RL1034.2 +045600 PERFORM PRINT-DETAIL. RL1034.2 +045700 ADD 1 TO REC-CT. RL1034.2 +045800* .03 RL1034.2 +045900 IF WRK-CS-09V00-009 EQUAL TO ZERO RL1034.2 +046000 PERFORM PASS RL1034.2 +046100 ELSE RL1034.2 +046200 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL1034.2 +046300 MOVE ZERO TO CORRECT-18V0 RL1034.2 +046400 MOVE "BAD-UPDATES" TO RE-MARK RL1034.2 +046500 PERFORM FAIL. RL1034.2 +046600 PERFORM PRINT-DETAIL. RL1034.2 +046700 ADD 01 TO REC-CT. RL1034.2 +046800* .04 RL1034.2 +046900 IF WRK-CS-09V00-010 EQUAL TO ZERO RL1034.2 +047000 PERFORM PASS RL1034.2 +047100 ELSE RL1034.2 +047200 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL1034.2 +047300 MOVE ZERO TO CORRECT-18V0 RL1034.2 +047400 MOVE "KEY VS RECORD" TO RE-MARK RL1034.2 +047500 PERFORM FAIL. RL1034.2 +047600 PERFORM PRINT-DETAIL. RL1034.2 +047700 ADD 01 TO REC-CT. RL1034.2 +047800* .05 RL1034.2 +047900 MOVE WRK-CS-09V00-011 TO RL-FS1-KEY. RL1034.2 +048000 MOVE RL-FS1-KEY TO COMPUTED-18V0. RL1034.2 +048100 MOVE "INFORMATION" TO CORRECT-A. RL1034.2 +048200 MOVE "STATUS AFTER OPEN" TO RE-MARK. RL1034.2 +048300 PERFORM PRINT-DETAIL. RL1034.2 +048400 ADD 01 TO REC-CT. RL1034.2 +048500* .06 RL1034.2 +048600 CLOSE RL-FS1. RL1034.2 +048700 REL-INIT-007. RL1034.2 +048800 MOVE "REL-TEST-007" TO PAR-NAME RL1034.2 +048900 OPEN I-O RL-FS1. RL1034.2 +049000 MOVE ZERO TO WRK-CS-09V00-006 RL1034.2 +049100 MOVE ZERO TO WRK-CS-09V00-007 RL1034.2 +049200 MOVE ZERO TO WRK-CS-09V00-008 RL1034.2 +049300 MOVE ZERO TO WRK-CS-09V00-009 RL1034.2 +049400 MOVE ZERO TO WRK-CS-09V00-010 RL1034.2 +049500 MOVE ZERO TO WRK-CS-09V00-011 RL1034.2 +049600 MOVE 01 TO REC-CT. RL1034.2 +049700 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +049800 MOVE "DELETE" TO FEATURE. RL1034.2 +049900 REL-TEST-007-R. RL1034.2 +050000 ADD 1 TO WRK-CS-09V00-006 RL1034.2 +050100 ADD 1 TO WRK-CS-09V00-007. RL1034.2 +050200 READ RL-FS1 RL1034.2 +050300 AT END RL1034.2 +050400 MOVE "AT END PATH TAKEN " TO RE-MARK RL1034.2 +050500 GO TO REL-TEST-007-3. RL1034.2 +050600 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +050700 IF WRK-CS-09V00-007 EQUAL TO 4 RL1034.2 +050800 GO TO REL-TEST-007-2. RL1034.2 +050900 IF WRK-CS-09V00-006 GREATER 501 RL1034.2 +051000 MOVE "AT END NOT TAKEN" TO RE-MARK RL1034.2 +051100 GO TO REL-TEST-007-3. RL1034.2 +051200 GO TO REL-TEST-007-R. RL1034.2 +051300 REL-TEST-007-2. RL1034.2 +051400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1034.2 +051500 MOVE 99 TO UPDATE-NUMBER (1). RL1034.2 +051600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL1034.2 +051700 DELETE RL-FS1. RL1034.2 +051800 MOVE ZERO TO WRK-CS-09V00-007. RL1034.2 +051900 ADD 1 TO WRK-CS-09V00-008 RL1034.2 +052000 GO TO REL-TEST-007-R. RL1034.2 +052100 REL-TEST-007-3. RL1034.2 +052200 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL1034.2 +052300 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1034.2 +052400 MOVE 501 TO CORRECT-18V0 RL1034.2 +052500 PERFORM FAIL RL1034.2 +052600 ELSE RL1034.2 +052700 PERFORM PASS. RL1034.2 +052800 PERFORM PRINT-DETAIL. RL1034.2 +052900 ADD 01 TO REC-CT. RL1034.2 +053000* .01 RL1034.2 +053100 IF WRK-CS-09V00-008 NOT EQUAL TO 125 RL1034.2 +053200 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL1034.2 +053300 MOVE 125 TO CORRECT-18V0 RL1034.2 +053400 MOVE "DELETED RECORDS" TO RE-MARK RL1034.2 +053500 PERFORM FAIL RL1034.2 +053600 ELSE RL1034.2 +053700 PERFORM PASS. RL1034.2 +053800 PERFORM PRINT-DETAIL. RL1034.2 +053900 ADD 01 TO REC-CT. RL1034.2 +054000* .02 RL1034.2 +054100 CLOSE RL-FS1. RL1034.2 +054200 REL-INIT-008. RL1034.2 +054300 MOVE "REL-TEST-008" TO PAR-NAME. RL1034.2 +054400 MOVE ZERO TO WRK-CS-09V00-006 RL1034.2 +054500 MOVE ZERO TO WRK-CS-09V00-007 RL1034.2 +054600 MOVE ZERO TO WRK-CS-09V00-008 RL1034.2 +054700 MOVE ZERO TO WRK-CS-09V00-009 RL1034.2 +054800 MOVE ZERO TO WRK-CS-09V00-010 RL1034.2 +054900 MOVE ZERO TO WRK-CS-09V00-011 RL1034.2 +055000 MOVE 01 TO REC-CT. RL1034.2 +055100 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +055200 MOVE ZERO TO RL-FS1-KEY. RL1034.2 +055300 OPEN INPUT RL-FS1. RL1034.2 +055400 MOVE "READ UPDATED FILE" TO FEATURE. RL1034.2 +055500 REL-TEST-008-R. RL1034.2 +055600 ADD 1 TO WRK-CS-09V00-006. RL1034.2 +055700 ADD 1 TO WRK-CS-09V00-007. RL1034.2 +055800 ADD 1 TO WRK-CS-09V00-008. RL1034.2 +055900 READ RL-FS1 AT END GO TO REL-TEST-008-3. RL1034.2 +056000 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1034.2 +056100 IF UPDATE-NUMBER (1) EQUAL TO 99 RL1034.2 +056200 ADD 1 TO WRK-CS-09V00-009. RL1034.2 +056300 IF WRK-CS-09V00-007 EQUAL TO 4 RL1034.2 +056400 MOVE 01 TO WRK-CS-09V00-007 RL1034.2 +056500 ADD 1 TO WRK-CS-09V00-008. RL1034.2 +056600 IF RL-FS1-KEY EQUAL TO XRECORD-NUMBER (1) RL1034.2 +056700 ADD 1 TO WRK-CS-09V00-010. RL1034.2 +056800 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 RL1034.2 +056900 ADD 1 TO WRK-CS-09V00-011. RL1034.2 +057000 IF WRK-CS-09V00-006 GREATER 501 RL1034.2 +057100 GO TO REL-TEST-008-3. RL1034.2 +057200 GO TO REL-TEST-008-R. RL1034.2 +057300 REL-TEST-008-3. RL1034.2 +057400 IF WRK-CS-09V00-006 NOT EQUAL TO 376 RL1034.2 +057500 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1034.2 +057600 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1034.2 +057700 MOVE 376 TO CORRECT-18V0 RL1034.2 +057800 PERFORM FAIL RL1034.2 +057900 ELSE RL1034.2 +058000 PERFORM PASS. RL1034.2 +058100 PERFORM PRINT-DETAIL. RL1034.2 +058200 ADD 01 TO REC-CT. RL1034.2 +058300* .01 RL1034.2 +058400 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO RL1034.2 +058500 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL1034.2 +058600 MOVE ZERO TO CORRECT-18V0 RL1034.2 +058700 MOVE "DELETED RECORDS" TO RE-MARK RL1034.2 +058800 PERFORM FAIL RL1034.2 +058900 ELSE RL1034.2 +059000 PERFORM PASS. RL1034.2 +059100 PERFORM PRINT-DETAIL. RL1034.2 +059200 ADD 01 TO REC-CT. RL1034.2 +059300* .02 RL1034.2 +059400 IF WRK-CS-09V00-010 NOT EQUAL TO 375 RL1034.2 +059500 MOVE "KEY MISMATCH" TO RE-MARK RL1034.2 +059600 MOVE 375 TO CORRECT-18V0 RL1034.2 +059700 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL1034.2 +059800 PERFORM FAIL RL1034.2 +059900 ELSE RL1034.2 +060000 PERFORM PASS. RL1034.2 +060100 PERFORM PRINT-DETAIL. RL1034.2 +060200 ADD 01 TO REC-CT. RL1034.2 +060300* .03 RL1034.2 +060400 IF WRK-CS-09V00-011 NOT EQUAL TO 375 RL1034.2 +060500 MOVE 375 TO CORRECT-18V0 RL1034.2 +060600 MOVE "INCORRECT RECORD FOUND" TO RE-MARK RL1034.2 +060700 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 RL1034.2 +060800 PERFORM FAIL RL1034.2 +060900 ELSE RL1034.2 +061000 PERFORM PASS. RL1034.2 +061100 PERFORM PRINT-DETAIL. RL1034.2 +061200*04 RL1034.2 +061300 CLOSE RL-FS1. RL1034.2 +061400 CCVS-EXIT SECTION. RL1034.2 +061500 CCVS-999999. RL1034.2 +061600 GO TO CLOSE-FILES. RL1034.2 diff --git a/tests/cobol85/RL/RL104A.CBL b/tests/cobol85/RL/RL104A.CBL new file mode 100644 index 00000000..abb4ee4a --- /dev/null +++ b/tests/cobol85/RL/RL104A.CBL @@ -0,0 +1,639 @@ +000100 IDENTIFICATION DIVISION. RL1044.2 +000200 PROGRAM-ID. RL1044.2 +000300 RL104A. RL1044.2 +000400**************************************************************** RL1044.2 +000500* * RL1044.2 +000600* VALIDATION FOR:- * RL1044.2 +000700* * RL1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1044.2 +000900* * RL1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1044.2 +001100* * RL1044.2 +001200**************************************************************** RL1044.2 +001300* * RL1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1044.2 +001500* * RL1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1044.2 +001900* * RL1044.2 +002000**************************************************************** RL1044.2 +002100* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1044.2 +002200* SEMANTIC ACTIONS ASSOCIATED WITH THE FOLLOWING RL1044.2 +002300* ELEMENTS: RL1044.2 +002400* RL1044.2 +002500* (1) FILE STATUS RL1044.2 +002600* (2) USE AFTER EXCEPTION PROCEDURE ON FILE-NAME RL1044.2 +002700* (3) READ RL1044.2 +002800* (4) WRITE RL1044.2 +002900* (5) REWRITE RL1044.2 +003000* (6) RELATIVE KEY RL1044.2 +003100* (7) ACCESS MODE RL1044.2 +003200* RL1044.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL1044.2 +003400* (ACCESS MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RL1044.2 +003500* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL1044.2 +003600* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL1044.2 +003700* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL1044.2 +003800* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL1044.2 +003900* AT END ON INVALID KEY PHRASES. THE OMISSION OF THESERL1044.2 +004000* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL1044.2 +004100* HAS BEEN SPECIFIED. RL1044.2 +004200* RL1044.2 +004300**************************************************************** RL1044.2 +004400 ENVIRONMENT DIVISION. RL1044.2 +004500 CONFIGURATION SECTION. RL1044.2 +004600 SOURCE-COMPUTER. RL1044.2 +004700 Linux. RL1044.2 +004800 OBJECT-COMPUTER. RL1044.2 +004900 Linux. RL1044.2 +005000 INPUT-OUTPUT SECTION. RL1044.2 +005100 FILE-CONTROL. RL1044.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1044.2 +005300 "report.log". RL1044.2 +005400 SELECT RL-FS2 ASSIGN RL1044.2 +005500 "XXXXX022" RL1044.2 +005600 ORGANIZATION RELATIVE RL1044.2 +005700 ACCESS SEQUENTIAL RL1044.2 +005800 RELATIVE RL-FS2-KEY RL1044.2 +005900 FILE STATUS IS RL-FS2-STATUS. RL1044.2 +006000 DATA DIVISION. RL1044.2 +006100 FILE SECTION. RL1044.2 +006200 FD PRINT-FILE. RL1044.2 +006300 01 PRINT-REC PICTURE X(120). RL1044.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1044.2 +006500 FD RL-FS2 RL1044.2 +006600*C VALUE OF RL1044.2 +006700*C OCLABELID RL1044.2 +006800*C IS RL1044.2 +006900*C "OCDUMMY" RL1044.2 +007000*G SYSIN RL1044.2 +007100 LABEL RECORDS ARE STANDARD RL1044.2 +007200 BLOCK CONTAINS 1 RECORDS RL1044.2 +007300 DATA RECORD RL-FS2R1-F-G-240. RL1044.2 +007400 01 RL-FS2R1-F-G-240. RL1044.2 +007500 05 RL-FS2-WRK-120 PIC X(120). RL1044.2 +007600 05 RL-FS2-GRP-120. RL1044.2 +007700 10 RL-FS2-WRK-XN-0001-O120F RL1044.2 +007800 PICTURE X OCCURS 120 TIMES. RL1044.2 +007900 WORKING-STORAGE SECTION. RL1044.2 +008000 01 GRP-0001. RL1044.2 +008100 05 RL-FS2-KEY PIC 9(8) VALUE ZERO. RL1044.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1044.2 +008900 05 RL-FS2-STATUS PIC XX VALUE SPACE. RL1044.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1044.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1044.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1044.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1044.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1044.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1044.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1044.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1044.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1044.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1044.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1044.2 +010100 05 FILLER PICTURE X(48) VALUE RL1044.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1044.2 +010300 05 FILLER PICTURE X(46) VALUE RL1044.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1044.2 +010500 05 FILLER PICTURE X(26) VALUE RL1044.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1044.2 +010700 05 FILLER PICTURE X(37) VALUE RL1044.2 +010800 ",RECKEY= ". RL1044.2 +010900 05 FILLER PICTURE X(38) VALUE RL1044.2 +011000 ",ALTKEY1= ". RL1044.2 +011100 05 FILLER PICTURE X(38) VALUE RL1044.2 +011200 ",ALTKEY2= ". RL1044.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1044.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1044.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1044.2 +011600 07 FILLER PIC X(5). RL1044.2 +011700 07 XFILE-NAME PIC X(6). RL1044.2 +011800 07 FILLER PIC X(8). RL1044.2 +011900 07 XRECORD-NAME PIC X(6). RL1044.2 +012000 07 FILLER PIC X(1). RL1044.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1044.2 +012200 07 FILLER PIC X(7). RL1044.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1044.2 +012400 07 FILLER PIC X(6). RL1044.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1044.2 +012600 07 FILLER PIC X(5). RL1044.2 +012700 07 ODO-NUMBER PIC 9(4). RL1044.2 +012800 07 FILLER PIC X(5). RL1044.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1044.2 +013000 07 FILLER PIC X(7). RL1044.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1044.2 +013200 07 FILLER PIC X(7). RL1044.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1044.2 +013400 07 FILLER PIC X(1). RL1044.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1044.2 +013600 07 FILLER PIC X(6). RL1044.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1044.2 +013800 07 FILLER PIC X(5). RL1044.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1044.2 +014000 07 FILLER PIC X(6). RL1044.2 +014100 07 XLABEL-TYPE PIC X(1). RL1044.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1044.2 +014300 07 FILLER PIC X(8). RL1044.2 +014400 07 XRECORD-KEY PIC X(29). RL1044.2 +014500 07 FILLER PIC X(9). RL1044.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1044.2 +014700 07 FILLER PIC X(9). RL1044.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1044.2 +014900 07 FILLER PIC X(7). RL1044.2 +015000 01 TEST-RESULTS. RL1044.2 +015100 02 FILLER PIC X VALUE SPACE. RL1044.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1044.2 +015300 02 FILLER PIC X VALUE SPACE. RL1044.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1044.2 +015500 02 FILLER PIC X VALUE SPACE. RL1044.2 +015600 02 PAR-NAME. RL1044.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1044.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1044.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1044.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1044.2 +016100 02 RE-MARK PIC X(61). RL1044.2 +016200 01 TEST-COMPUTED. RL1044.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1044.2 +016400 02 FILLER PIC X(17) VALUE RL1044.2 +016500 " COMPUTED=". RL1044.2 +016600 02 COMPUTED-X. RL1044.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1044.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1044.2 +016900 PIC -9(9).9(9). RL1044.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1044.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1044.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1044.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1044.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1044.2 +017500 04 FILLER PIC X. RL1044.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1044.2 +017700 01 TEST-CORRECT. RL1044.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1044.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1044.2 +018000 02 CORRECT-X. RL1044.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1044.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1044.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1044.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1044.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1044.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1044.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1044.2 +018800 04 FILLER PIC X. RL1044.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1044.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1044.2 +019100 01 CCVS-C-1. RL1044.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1044.2 +019300- "SS PARAGRAPH-NAME RL1044.2 +019400- " REMARKS". RL1044.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1044.2 +019600 01 CCVS-C-2. RL1044.2 +019700 02 FILLER PIC X VALUE SPACE. RL1044.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1044.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1044.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1044.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1044.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1044.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1044.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1044.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1044.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1044.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1044.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1044.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1044.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1044.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1044.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1044.2 +021300 01 CCVS-H-1. RL1044.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1044.2 +021500 02 FILLER PIC X(42) VALUE RL1044.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1044.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1044.2 +021800 01 CCVS-H-2A. RL1044.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1044.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1044.2 +022100 02 FILLER PIC XXXX VALUE RL1044.2 +022200 "4.2 ". RL1044.2 +022300 02 FILLER PIC X(28) VALUE RL1044.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1044.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1044.2 +022600 RL1044.2 +022700 01 CCVS-H-2B. RL1044.2 +022800 02 FILLER PIC X(15) VALUE RL1044.2 +022900 "TEST RESULT OF ". RL1044.2 +023000 02 TEST-ID PIC X(9). RL1044.2 +023100 02 FILLER PIC X(4) VALUE RL1044.2 +023200 " IN ". RL1044.2 +023300 02 FILLER PIC X(12) VALUE RL1044.2 +023400 " HIGH ". RL1044.2 +023500 02 FILLER PIC X(22) VALUE RL1044.2 +023600 " LEVEL VALIDATION FOR ". RL1044.2 +023700 02 FILLER PIC X(58) VALUE RL1044.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1044.2 +023900 01 CCVS-H-3. RL1044.2 +024000 02 FILLER PIC X(34) VALUE RL1044.2 +024100 " FOR OFFICIAL USE ONLY ". RL1044.2 +024200 02 FILLER PIC X(58) VALUE RL1044.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1044.2 +024400 02 FILLER PIC X(28) VALUE RL1044.2 +024500 " COPYRIGHT 1985 ". RL1044.2 +024600 01 CCVS-E-1. RL1044.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1044.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1044.2 +024900 02 ID-AGAIN PIC X(9). RL1044.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1044.2 +025100 01 CCVS-E-2. RL1044.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1044.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1044.2 +025400 02 CCVS-E-2-2. RL1044.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1044.2 +025600 03 FILLER PIC X VALUE SPACE. RL1044.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1044.2 +025800 "ERRORS ENCOUNTERED". RL1044.2 +025900 01 CCVS-E-3. RL1044.2 +026000 02 FILLER PIC X(22) VALUE RL1044.2 +026100 " FOR OFFICIAL USE ONLY". RL1044.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1044.2 +026300 02 FILLER PIC X(58) VALUE RL1044.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1044.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1044.2 +026600 02 FILLER PIC X(15) VALUE RL1044.2 +026700 " COPYRIGHT 1985". RL1044.2 +026800 01 CCVS-E-4. RL1044.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1044.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1044.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1044.2 +027200 02 FILLER PIC X(40) VALUE RL1044.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1044.2 +027400 01 XXINFO. RL1044.2 +027500 02 FILLER PIC X(19) VALUE RL1044.2 +027600 "*** INFORMATION ***". RL1044.2 +027700 02 INFO-TEXT. RL1044.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1044.2 +027900 04 XXCOMPUTED PIC X(20). RL1044.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1044.2 +028100 04 XXCORRECT PIC X(20). RL1044.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1044.2 +028300 01 HYPHEN-LINE. RL1044.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1044.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1044.2 +028600- "*****************************************". RL1044.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1044.2 +028800- "******************************". RL1044.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1044.2 +029000 "RL104A". RL1044.2 +029100 PROCEDURE DIVISION. RL1044.2 +029200 DECLARATIVES. RL1044.2 +029300 RL-FS2-01 SECTION. RL1044.2 +029400 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FS2. RL1044.2 +029500 RL-FS2-01-01. RL1044.2 +029600 ADD 1 TO WRK-CS-09V00-013. RL1044.2 +029700 GO TO RL-FS2-01-03 RL1044.2 +029800 RL-FS2-01-05 RL1044.2 +029900 DEPENDING ON WRK-CS-09V00-012. RL1044.2 +030000 GO TO RL-FS2-01-EXIT. RL1044.2 +030100 RL-FS2-01-03. RL1044.2 +030200*ENTRY FROM SEGMENT REL-TEST-009. RL1044.2 +030300* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL1044.2 +030400 ADD 1 TO WRK-CS-09V00-014. RL1044.2 +030500 RL-FS2-01-05. RL1044.2 +030600 ADD 1 TO WRK-CS-09V00-017. RL1044.2 +030700 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1044.2 +030800 MOVE RL-FS2-STATUS TO WRK-XN-0002-002 RL1044.2 +030900 MOVE "10" TO WRK-XN-0002-003. RL1044.2 +031000 RL-FS2-01-EXIT. RL1044.2 +031100 EXIT. RL1044.2 +031200 END DECLARATIVES. RL1044.2 +031300 CCVS1 SECTION. RL1044.2 +031400 OPEN-FILES. RL1044.2 +031500 OPEN OUTPUT PRINT-FILE. RL1044.2 +031600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1044.2 +031700 MOVE SPACE TO TEST-RESULTS. RL1044.2 +031800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1044.2 +031900 MOVE ZERO TO REC-SKL-SUB. RL1044.2 +032000 PERFORM CCVS-INIT-FILE 9 TIMES. RL1044.2 +032100 CCVS-INIT-FILE. RL1044.2 +032200 ADD 1 TO REC-SKL-SUB. RL1044.2 +032300 MOVE FILE-RECORD-INFO-SKELETON RL1044.2 +032400 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1044.2 +032500 CCVS-INIT-EXIT. RL1044.2 +032600 GO TO CCVS1-EXIT. RL1044.2 +032700 CLOSE-FILES. RL1044.2 +032800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1044.2 +032900 TERMINATE-CCVS. RL1044.2 +033000*S EXIT PROGRAM. RL1044.2 +033100*SERMINATE-CALL. RL1044.2 +033200 STOP RUN. RL1044.2 +033300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1044.2 +033400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1044.2 +033500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1044.2 +033600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1044.2 +033700 MOVE "****TEST DELETED****" TO RE-MARK. RL1044.2 +033800 PRINT-DETAIL. RL1044.2 +033900 IF REC-CT NOT EQUAL TO ZERO RL1044.2 +034000 MOVE "." TO PARDOT-X RL1044.2 +034100 MOVE REC-CT TO DOTVALUE. RL1044.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1044.2 +034300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1044.2 +034400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1044.2 +034500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1044.2 +034600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1044.2 +034700 MOVE SPACE TO CORRECT-X. RL1044.2 +034800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1044.2 +034900 MOVE SPACE TO RE-MARK. RL1044.2 +035000 HEAD-ROUTINE. RL1044.2 +035100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +035200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +035300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1044.2 +035400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1044.2 +035500 COLUMN-NAMES-ROUTINE. RL1044.2 +035600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +035700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +035900 END-ROUTINE. RL1044.2 +036000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1044.2 +036100 END-RTN-EXIT. RL1044.2 +036200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +036300 END-ROUTINE-1. RL1044.2 +036400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1044.2 +036500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1044.2 +036600 ADD PASS-COUNTER TO ERROR-HOLD. RL1044.2 +036700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1044.2 +036800 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1044.2 +036900 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1044.2 +037000 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1044.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1044.2 +037200 END-ROUTINE-12. RL1044.2 +037300 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1044.2 +037400 IF ERROR-COUNTER IS EQUAL TO ZERO RL1044.2 +037500 MOVE "NO " TO ERROR-TOTAL RL1044.2 +037600 ELSE RL1044.2 +037700 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1044.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1044.2 +037900 PERFORM WRITE-LINE. RL1044.2 +038000 END-ROUTINE-13. RL1044.2 +038100 IF DELETE-COUNTER IS EQUAL TO ZERO RL1044.2 +038200 MOVE "NO " TO ERROR-TOTAL ELSE RL1044.2 +038300 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1044.2 +038400 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1044.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +038600 IF INSPECT-COUNTER EQUAL TO ZERO RL1044.2 +038700 MOVE "NO " TO ERROR-TOTAL RL1044.2 +038800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1044.2 +038900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1044.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +039100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1044.2 +039200 WRITE-LINE. RL1044.2 +039300 ADD 1 TO RECORD-COUNT. RL1044.2 +039400 IF RECORD-COUNT GREATER 50 RL1044.2 +039500 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1044.2 +039600 MOVE SPACE TO DUMMY-RECORD RL1044.2 +039700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1044.2 +039800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1044.2 +039900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1044.2 +040000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1044.2 +040100 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1044.2 +040200 MOVE ZERO TO RECORD-COUNT. RL1044.2 +040300 PERFORM WRT-LN. RL1044.2 +040400 WRT-LN. RL1044.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1044.2 +040600 MOVE SPACE TO DUMMY-RECORD. RL1044.2 +040700 BLANK-LINE-PRINT. RL1044.2 +040800 PERFORM WRT-LN. RL1044.2 +040900 FAIL-ROUTINE. RL1044.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE RL1044.2 +041100 GO TO FAIL-ROUTINE-WRITE. RL1044.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1044.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1044.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1044.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1044.2 +041700 GO TO FAIL-ROUTINE-EX. RL1044.2 +041800 FAIL-ROUTINE-WRITE. RL1044.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1044.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1044.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1044.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1044.2 +042300 FAIL-ROUTINE-EX. EXIT. RL1044.2 +042400 BAIL-OUT. RL1044.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1044.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1044.2 +042700 BAIL-OUT-WRITE. RL1044.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1044.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1044.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1044.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1044.2 +043200 BAIL-OUT-EX. EXIT. RL1044.2 +043300 CCVS1-EXIT. RL1044.2 +043400 EXIT. RL1044.2 +043500 SECT-RL-04-001 SECTION. RL1044.2 +043600 REL-INIT-009. RL1044.2 +043700 MOVE "REL-TEST-009" TO PAR-NAME. RL1044.2 +043800 MOVE "CREATE RL-FS2" TO FEATURE RL1044.2 +043900 MOVE "RL-FS2" TO XFILE-NAME (2). RL1044.2 +044000 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1044.2 +044100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1044.2 +044200 MOVE 000240 TO XRECORD-LENGTH (2). RL1044.2 +044300 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1044.2 +044400 MOVE 0001 TO XBLOCK-SIZE (2). RL1044.2 +044500 MOVE 000500 TO RECORDS-IN-FILE (2). RL1044.2 +044600 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1044.2 +044700 MOVE "S" TO XLABEL-TYPE (2). RL1044.2 +044800 MOVE 000001 TO XRECORD-NUMBER (2). RL1044.2 +044900*INITIALIZE RECORD WORK AREA NUMBER 2. RL1044.2 +045000 MOVE 1 TO WRK-CS-09V00-012. RL1044.2 +045100 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1044.2 +045200 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1044.2 +045300 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1044.2 +045400 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +045500 MOVE 90000002 TO RL-FS2-KEY. RL1044.2 +045600 MOVE 01 TO REC-CT. RL1044.2 +045700 OPEN OUTPUT RL-FS2. RL1044.2 +045800 MOVE RL-FS2-STATUS TO WRK-XN-0002-001. RL1044.2 +045900*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1044.2 +046000 REL-TEST-009-R. RL1044.2 +046100 MOVE "99" TO RL-FS2-STATUS. RL1044.2 +046200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FS2-WRK-120. RL1044.2 +046300 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1044.2 +046400 RL-FS2-GRP-120. RL1044.2 +046500 WRITE RL-FS2R1-F-G-240. RL1044.2 +046600 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +046700 GO TO REL-TEST-009-2. RL1044.2 +046800 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1044.2 +046900 GO TO REL-TEST-009-2. RL1044.2 +047000 ADD 01 TO XRECORD-NUMBER (2). RL1044.2 +047100 GO TO REL-TEST-009-R. RL1044.2 +047200 REL-TEST-009-2. RL1044.2 +047300 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1044.2 +047400 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1044.2 +047500 MOVE ZERO TO CORRECT-18V0 RL1044.2 +047600 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1044.2 +047700 PERFORM FAIL RL1044.2 +047800 ELSE RL1044.2 +047900 PERFORM PASS. RL1044.2 +048000 PERFORM PRINT-DETAIL. RL1044.2 +048100 ADD 01 TO REC-CT. RL1044.2 +048200* .01 RL1044.2 +048300 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1044.2 +048400 MOVE "INCORRECT COUNT" TO RE-MARK RL1044.2 +048500 MOVE 500 TO CORRECT-18V0 RL1044.2 +048600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1044.2 +048700 PERFORM FAIL RL1044.2 +048800 ELSE RL1044.2 +048900 PERFORM PASS. RL1044.2 +049000 PERFORM PRINT-DETAIL. RL1044.2 +049100 ADD 01 TO REC-CT. RL1044.2 +049200* .02 RL1044.2 +049300 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1044.2 +049400 MOVE "STATUS/OPEN" TO RE-MARK RL1044.2 +049500 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1044.2 +049600 MOVE "00" TO CORRECT-A RL1044.2 +049700 PERFORM FAIL RL1044.2 +049800 ELSE RL1044.2 +049900 PERFORM PASS. RL1044.2 +050000 PERFORM PRINT-DETAIL. RL1044.2 +050100 ADD 01 TO REC-CT. RL1044.2 +050200* .03 RL1044.2 +050300 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +050400 MOVE "STATUS/WRITE" TO RE-MARK RL1044.2 +050500 MOVE RL-FS2-STATUS TO COMPUTED-A RL1044.2 +050600 MOVE "00" TO CORRECT-A RL1044.2 +050700 PERFORM FAIL RL1044.2 +050800 ELSE RL1044.2 +050900 PERFORM PASS. RL1044.2 +051000 PERFORM PRINT-DETAIL. RL1044.2 +051100 ADD 01 TO REC-CT. RL1044.2 +051200* .04 RL1044.2 +051300 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +051400 CLOSE RL-FS2. RL1044.2 +051500 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +051600 MOVE "CLOSE/STATUS" TO RE-MARK RL1044.2 +051700 MOVE RL-FS2-STATUS TO COMPUTED-A RL1044.2 +051800 MOVE "00" TO CORRECT-A RL1044.2 +051900 PERFORM FAIL RL1044.2 +052000 ELSE RL1044.2 +052100 PERFORM PASS. RL1044.2 +052200 PERFORM PRINT-DETAIL. RL1044.2 +052300 ADD 01 TO REC-CT. RL1044.2 +052400* .05 RL1044.2 +052500 REL-INIT-010. RL1044.2 +052600 MOVE "REL-TEST-010" TO PAR-NAME. RL1044.2 +052700 MOVE 2 TO WRK-CS-09V00-012. RL1044.2 +052800 MOVE ZERO TO WRK-CS-09V00-013. RL1044.2 +052900 MOVE ZERO TO WRK-CS-09V00-014. RL1044.2 +053000 MOVE ZERO TO WRK-CS-09V00-015. RL1044.2 +053100 MOVE ZERO TO WRK-CS-09V00-016. RL1044.2 +053200 MOVE ZERO TO WRK-CS-09V00-017. RL1044.2 +053300 MOVE ZERO TO WRK-CS-09V00-018. RL1044.2 +053400 MOVE 01 TO REC-CT. RL1044.2 +053500 OPEN I-O RL-FS2. RL1044.2 +053600 MOVE SPACE TO WRK-XN-0002-002 RL1044.2 +053700 MOVE SPACE TO WRK-XN-0002-003 RL1044.2 +053800 MOVE SPACE TO WRK-XN-0002-004 RL1044.2 +053900 MOVE RL-FS2-STATUS TO WRK-XN-0002-001 RL1044.2 +054000 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +054100*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1044.2 +054200 MOVE "USE/FILE STATUE" TO FEATURE. RL1044.2 +054300 REL-TEST-010-R. RL1044.2 +054400 ADD 1 TO WRK-CS-09V00-014. RL1044.2 +054500 ADD 1 TO WRK-CS-09V00-015. RL1044.2 +054600 READ RL-FS2. RL1044.2 +054700 IF RL-FS2-STATUS EQUAL TO "10" RL1044.2 +054800 GO TO REL-TEST-010-3. RL1044.2 +054900 MOVE RL-FS2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1044.2 +055000 IF WRK-CS-09V00-015 EQUAL TO 5 RL1044.2 +055100 ADD 01 TO UPDATE-NUMBER (2) RL1044.2 +055200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FS2-WRK-120 RL1044.2 +055300 REWRITE RL-FS2R1-F-G-240 RL1044.2 +055400 MOVE ZERO TO WRK-CS-09V00-015 RL1044.2 +055500 GO TO REL-TEST-010-2. RL1044.2 +055600 IF WRK-CS-09V00-014 GREATER 500 RL1044.2 +055700 GO TO REL-TEST-010-3. RL1044.2 +055800 GO TO REL-TEST-010-R. RL1044.2 +055900 REL-TEST-010-2. RL1044.2 +056000 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +056100 ADD 1 TO WRK-CS-09V00-016. RL1044.2 +056200 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +056300 GO TO REL-TEST-010-R. RL1044.2 +056400 REL-TEST-010-3. RL1044.2 +056500 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1044.2 +056600 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1044.2 +056700 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1044.2 +056800 MOVE 1 TO CORRECT-18V0 RL1044.2 +056900 PERFORM FAIL RL1044.2 +057000 ELSE RL1044.2 +057100 PERFORM PASS. RL1044.2 +057200 PERFORM PRINT-DETAIL. RL1044.2 +057300 ADD 01 TO REC-CT. RL1044.2 +057400* .01 RL1044.2 +057500 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1044.2 +057600 MOVE "INCORRECT COUNT" TO RE-MARK RL1044.2 +057700 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1044.2 +057800 MOVE 501 TO CORRECT-18V0 RL1044.2 +057900 PERFORM FAIL RL1044.2 +058000 ELSE RL1044.2 +058100 PERFORM PASS. RL1044.2 +058200 PERFORM PRINT-DETAIL. RL1044.2 +058300 ADD 01 TO REC-CT. RL1044.2 +058400* .02 RL1044.2 +058500 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1044.2 +058600 MOVE "OPEN/STATUS" TO RE-MARK RL1044.2 +058700 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1044.2 +058800 MOVE "00" TO CORRECT-A RL1044.2 +058900 PERFORM FAIL RL1044.2 +059000 ELSE RL1044.2 +059100 PERFORM PASS. RL1044.2 +059200 PERFORM PRINT-DETAIL. RL1044.2 +059300 ADD 01 TO REC-CT. RL1044.2 +059400* .03 RL1044.2 +059500 IF RL-FS2-STATUS NOT EQUAL TO "10" RL1044.2 +059600 MOVE "ATEND/STATUS" TO RE-MARK RL1044.2 +059700 MOVE RL-FS2-STATUS TO COMPUTED-A RL1044.2 +059800 MOVE "10" TO CORRECT-A RL1044.2 +059900 PERFORM FAIL RL1044.2 +060000 ELSE RL1044.2 +060100 PERFORM PASS. RL1044.2 +060200 PERFORM PRINT-DETAIL. RL1044.2 +060300 ADD 01 TO REC-CT. RL1044.2 +060400* .04 RL1044.2 +060500 IF WRK-XN-0002-002 NOT EQUAL TO "10" RL1044.2 +060600 MOVE "EXCEPTIN/STATUS" TO RE-MARK RL1044.2 +060700 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1044.2 +060800 MOVE "10" TO CORRECT-A RL1044.2 +060900 PERFORM FAIL RL1044.2 +061000 ELSE RL1044.2 +061100 PERFORM PASS. RL1044.2 +061200 PERFORM PRINT-DETAIL. RL1044.2 +061300 ADD 01 TO REC-CT. RL1044.2 +061400* .05 RL1044.2 +061500 IF WRK-XN-0002-003 NOT EQUAL TO "10" RL1044.2 +061600 MOVE "NO/EXCEPTION" TO RE-MARK RL1044.2 +061700 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1044.2 +061800 MOVE "10" TO CORRECT-A RL1044.2 +061900 PERFORM FAIL RL1044.2 +062000 ELSE RL1044.2 +062100 PERFORM PASS. RL1044.2 +062200 PERFORM PRINT-DETAIL RL1044.2 +062300 ADD 01 TO REC-CT. RL1044.2 +062400* .06 RL1044.2 +062500 MOVE SPACE TO RL-FS2-STATUS. RL1044.2 +062600 CLOSE RL-FS2 RL1044.2 +062700 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1044.2 +062800 MOVE "CLOSE/STATUS" TO RE-MARK RL1044.2 +062900 MOVE RL-FS2-STATUS TO COMPUTED-A RL1044.2 +063000 MOVE "00" TO CORRECT-A RL1044.2 +063100 PERFORM FAIL RL1044.2 +063200 ELSE RL1044.2 +063300 PERFORM PASS. RL1044.2 +063400 PERFORM PRINT-DETAIL. RL1044.2 +063500 ADD 01 TO REC-CT. RL1044.2 +063600* .07 RL1044.2 +063700 CCVS-EXIT SECTION. RL1044.2 +063800 CCVS-999999. RL1044.2 +063900 GO TO CLOSE-FILES. RL1044.2 diff --git a/tests/cobol85/RL/RL105A.CBL b/tests/cobol85/RL/RL105A.CBL new file mode 100644 index 00000000..1e60eda0 --- /dev/null +++ b/tests/cobol85/RL/RL105A.CBL @@ -0,0 +1,633 @@ +000100 IDENTIFICATION DIVISION. RL1054.2 +000200 PROGRAM-ID. RL1054.2 +000300 RL105A. RL1054.2 +000400**************************************************************** RL1054.2 +000500* * RL1054.2 +000600* VALIDATION FOR:- * RL1054.2 +000700* * RL1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1054.2 +000900* * RL1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1054.2 +001100* * RL1054.2 +001200**************************************************************** RL1054.2 +001300*GENERAL: THIS PROGRAM PROCESSED THREE RELATIVE FILES RL1054.2 +001400* IDENTIFIED AS RL-FR1, RL-FR2 AND RL-FR3. THE RL1054.2 +001500* FUNCTION OF THIS PROGRAM IS TO CREATE THREE RELATIVE RL1054.2 +001600* I-O FILES RANDOMLLY (ACCESS MODE RANDOM) AND VERIFY RL1054.2 +001700* THAT THEY WERE CREATED CORRECTLY. THE FILES RL1054.2 +001800* PROCESSED CONTAIN FIXED LENGTH RECORDS. RL1054.2 +001900* RL1054.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1054.2 +002100* PROGRAM ARE: RL1054.2 +002200* RL1054.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1054.2 +002400* RELATIVE I-O DATA FILE-1 RL1054.2 +002500* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1054.2 +002600* RELATIVE I-O DATA FILE-2 RL1054.2 +002700* X-23 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1054.2 +002800* RELATIVE I-O DATA FILE-3 RL1054.2 +002900* X-55 SYSTEM PRINTER RL1054.2 +003000* X-69 ADDITIONAL VALUE OF CLAUSES RL1054.2 +003100* X-74 VALUE OF IMPLEMENTOR-NAME RL1054.2 +003200* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE-1 RL1054.2 +003300* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE-2 RL1054.2 +003400* X-77 OBJECT OF VALUE OF CLAUSE FOR FILE-3 RL1054.2 +003500* X-82 SOURCE-COMPUTER RL1054.2 +003600* X-83 OBJECT-COMPUTER. RL1054.2 +003700* RL1054.2 +003800**************************************************************** RL1054.2 +003900 ENVIRONMENT DIVISION. RL1054.2 +004000 CONFIGURATION SECTION. RL1054.2 +004100 SOURCE-COMPUTER. RL1054.2 +004200 Linux. RL1054.2 +004300 OBJECT-COMPUTER. RL1054.2 +004400 Linux. RL1054.2 +004500 INPUT-OUTPUT SECTION. RL1054.2 +004600 FILE-CONTROL. RL1054.2 +004700 SELECT PRINT-FILE ASSIGN TO RL1054.2 +004800 "report.log". RL1054.2 +004900 SELECT RL-FR1 ASSIGN TO RL1054.2 +005000 "XXXXX021" RL1054.2 +005100 ORGANIZATION IS RELATIVE RL1054.2 +005200 ACCESS MODE IS RANDOM RL1054.2 +005300 RELATIVE KEY IS KEY-1. RL1054.2 +005400 SELECT RL-FR2 ASSIGN RL1054.2 +005500 "XXXXX022" RL1054.2 +005600 ORGANIZATION IS RELATIVE RL1054.2 +005700 ACCESS MODE IS RANDOM RL1054.2 +005800 RELATIVE KEY IS KEY-2. RL1054.2 +005900 SELECT RL-FR3 ASSIGN TO RL1054.2 +006000 "XXXXX023" RL1054.2 +006100 ORGANIZATION IS RELATIVE RL1054.2 +006200 ACCESS MODE IS RANDOM RL1054.2 +006300 RELATIVE KEY IS KEY-3. RL1054.2 +006400 DATA DIVISION. RL1054.2 +006500 FILE SECTION. RL1054.2 +006600 FD PRINT-FILE. RL1054.2 +006700 01 PRINT-REC PICTURE X(120). RL1054.2 +006800 01 DUMMY-RECORD PICTURE X(120). RL1054.2 +006900 FD RL-FR1 RL1054.2 +007000*C VALUE OF RL1054.2 +007100*C OCLABELID RL1054.2 +007200*C IS RL1054.2 +007300*C "OCDUMMY" RL1054.2 +007400*G SYSIN RL1054.2 +007500 LABEL RECORDS ARE STANDARD RL1054.2 +007600 DATA RECORD IS GRP-1SEQ-RECORD-1. RL1054.2 +007700 01 GRP-1SEQ-RECORD-1. RL1054.2 +007800 02 EXPRESSION PICTURE X(51). RL1054.2 +007900 02 FILLER PICTURE X(49). RL1054.2 +008000 FD RL-FR2 RL1054.2 +008100*C VALUE OF RL1054.2 +008200*C OCLABELID RL1054.2 +008300*C IS RL1054.2 +008400*C "OCDUMMY" RL1054.2 +008500*G SYSIN RL1054.2 +008600 LABEL RECORDS ARE STANDARD RL1054.2 +008700 DATA RECORD IS GRP-1SEQ-RECORD-2. RL1054.2 +008800 01 GRP-1SEQ-RECORD-2. RL1054.2 +008900 02 FILLER PICTURE X(100). RL1054.2 +009000 FD RL-FR3 RL1054.2 +009100*C VALUE OF RL1054.2 +009200*C OCLABELID RL1054.2 +009300*C IS RL1054.2 +009400*C "OCDUMMY" RL1054.2 +009500*G SYSIN RL1054.2 +009600 LABEL RECORDS ARE STANDARD RL1054.2 +009700 DATA RECORD IS GRP-1SEQ-RECORD-3. RL1054.2 +009800 01 GRP-1SEQ-RECORD-3. RL1054.2 +009900 02 FILLER PICTURE X(100). RL1054.2 +010000 WORKING-STORAGE SECTION. RL1054.2 +010100 77 SUB-1 PICTURE 99 VALUE ZERO. RL1054.2 +010200 77 KEY-1 RL1054.2 +010300 PICTURE 9(5). RL1054.2 +010400 77 KEY-2 RL1054.2 +010500 PICTURE 9(5). RL1054.2 +010600 77 KEY-3 RL1054.2 +010700 PICTURE 9(5). RL1054.2 +010800 01 RECORD-MESSAGE. RL1054.2 +010900 02 FILLER PICTURE X(8) VALUE "RECORD ". RL1054.2 +011000 02 2POS-NUM PICTURE 99. RL1054.2 +011100 02 FILLER PICTURE X(40) VALUE RL1054.2 +011200 " OF THIS FILE CONTAINS THIS INFORMATION". RL1054.2 +011300 02 FILLER PICTURE X(50) VALUE SPACE. RL1054.2 +011400 01 GRP-SEQ-TEST-RECORD PICTURE X(100) VALUE SPACE. RL1054.2 +011500 01 GRP-HOLD-RECORD PICTURE X(100) VALUE SPACE. RL1054.2 +011600 01 READ-WRITE-COUNTER. RL1054.2 +011700 02 ENTRY-RW OCCURS 20 TIMES PICTURE X. RL1054.2 +011800 01 FILE-RECORD-INFORMATION-REC. RL1054.2 +011900 03 FILE-RECORD-INFO-SKELETON. RL1054.2 +012000 05 FILLER PICTURE X(48) VALUE RL1054.2 +012100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1054.2 +012200 05 FILLER PICTURE X(46) VALUE RL1054.2 +012300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1054.2 +012400 05 FILLER PICTURE X(26) VALUE RL1054.2 +012500 ",LFIL=000000,ORG= ,LBLR= ". RL1054.2 +012600 05 FILLER PICTURE X(37) VALUE RL1054.2 +012700 ",RECKEY= ". RL1054.2 +012800 05 FILLER PICTURE X(38) VALUE RL1054.2 +012900 ",ALTKEY1= ". RL1054.2 +013000 05 FILLER PICTURE X(38) VALUE RL1054.2 +013100 ",ALTKEY2= ". RL1054.2 +013200 05 FILLER PICTURE X(7) VALUE SPACE.RL1054.2 +013300 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1054.2 +013400 05 FILE-RECORD-INFO-P1-120. RL1054.2 +013500 07 FILLER PIC X(5). RL1054.2 +013600 07 XFILE-NAME PIC X(6). RL1054.2 +013700 07 FILLER PIC X(8). RL1054.2 +013800 07 XRECORD-NAME PIC X(6). RL1054.2 +013900 07 FILLER PIC X(1). RL1054.2 +014000 07 REELUNIT-NUMBER PIC 9(1). RL1054.2 +014100 07 FILLER PIC X(7). RL1054.2 +014200 07 XRECORD-NUMBER PIC 9(6). RL1054.2 +014300 07 FILLER PIC X(6). RL1054.2 +014400 07 UPDATE-NUMBER PIC 9(2). RL1054.2 +014500 07 FILLER PIC X(5). RL1054.2 +014600 07 ODO-NUMBER PIC 9(4). RL1054.2 +014700 07 FILLER PIC X(5). RL1054.2 +014800 07 XPROGRAM-NAME PIC X(5). RL1054.2 +014900 07 FILLER PIC X(7). RL1054.2 +015000 07 XRECORD-LENGTH PIC 9(6). RL1054.2 +015100 07 FILLER PIC X(7). RL1054.2 +015200 07 CHARS-OR-RECORDS PIC X(2). RL1054.2 +015300 07 FILLER PIC X(1). RL1054.2 +015400 07 XBLOCK-SIZE PIC 9(4). RL1054.2 +015500 07 FILLER PIC X(6). RL1054.2 +015600 07 RECORDS-IN-FILE PIC 9(6). RL1054.2 +015700 07 FILLER PIC X(5). RL1054.2 +015800 07 XFILE-ORGANIZATION PIC X(2). RL1054.2 +015900 07 FILLER PIC X(6). RL1054.2 +016000 07 XLABEL-TYPE PIC X(1). RL1054.2 +016100 05 FILE-RECORD-INFO-P121-240. RL1054.2 +016200 07 FILLER PIC X(8). RL1054.2 +016300 07 XRECORD-KEY PIC X(29). RL1054.2 +016400 07 FILLER PIC X(9). RL1054.2 +016500 07 ALTERNATE-KEY1 PIC X(29). RL1054.2 +016600 07 FILLER PIC X(9). RL1054.2 +016700 07 ALTERNATE-KEY2 PIC X(29). RL1054.2 +016800 07 FILLER PIC X(7). RL1054.2 +016900 01 TEST-RESULTS. RL1054.2 +017000 02 FILLER PIC X VALUE SPACE. RL1054.2 +017100 02 FEATURE PIC X(20) VALUE SPACE. RL1054.2 +017200 02 FILLER PIC X VALUE SPACE. RL1054.2 +017300 02 P-OR-F PIC X(5) VALUE SPACE. RL1054.2 +017400 02 FILLER PIC X VALUE SPACE. RL1054.2 +017500 02 PAR-NAME. RL1054.2 +017600 03 FILLER PIC X(19) VALUE SPACE. RL1054.2 +017700 03 PARDOT-X PIC X VALUE SPACE. RL1054.2 +017800 03 DOTVALUE PIC 99 VALUE ZERO. RL1054.2 +017900 02 FILLER PIC X(8) VALUE SPACE. RL1054.2 +018000 02 RE-MARK PIC X(61). RL1054.2 +018100 01 TEST-COMPUTED. RL1054.2 +018200 02 FILLER PIC X(30) VALUE SPACE. RL1054.2 +018300 02 FILLER PIC X(17) VALUE RL1054.2 +018400 " COMPUTED=". RL1054.2 +018500 02 COMPUTED-X. RL1054.2 +018600 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1054.2 +018700 03 COMPUTED-N REDEFINES COMPUTED-A RL1054.2 +018800 PIC -9(9).9(9). RL1054.2 +018900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1054.2 +019000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1054.2 +019100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1054.2 +019200 03 CM-18V0 REDEFINES COMPUTED-A. RL1054.2 +019300 04 COMPUTED-18V0 PIC -9(18). RL1054.2 +019400 04 FILLER PIC X. RL1054.2 +019500 03 FILLER PIC X(50) VALUE SPACE. RL1054.2 +019600 01 TEST-CORRECT. RL1054.2 +019700 02 FILLER PIC X(30) VALUE SPACE. RL1054.2 +019800 02 FILLER PIC X(17) VALUE " CORRECT =". RL1054.2 +019900 02 CORRECT-X. RL1054.2 +020000 03 CORRECT-A PIC X(20) VALUE SPACE. RL1054.2 +020100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1054.2 +020200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1054.2 +020300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1054.2 +020400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1054.2 +020500 03 CR-18V0 REDEFINES CORRECT-A. RL1054.2 +020600 04 CORRECT-18V0 PIC -9(18). RL1054.2 +020700 04 FILLER PIC X. RL1054.2 +020800 03 FILLER PIC X(2) VALUE SPACE. RL1054.2 +020900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1054.2 +021000 01 CCVS-C-1. RL1054.2 +021100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1054.2 +021200- "SS PARAGRAPH-NAME RL1054.2 +021300- " REMARKS". RL1054.2 +021400 02 FILLER PIC X(20) VALUE SPACE. RL1054.2 +021500 01 CCVS-C-2. RL1054.2 +021600 02 FILLER PIC X VALUE SPACE. RL1054.2 +021700 02 FILLER PIC X(6) VALUE "TESTED". RL1054.2 +021800 02 FILLER PIC X(15) VALUE SPACE. RL1054.2 +021900 02 FILLER PIC X(4) VALUE "FAIL". RL1054.2 +022000 02 FILLER PIC X(94) VALUE SPACE. RL1054.2 +022100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1054.2 +022200 01 REC-CT PIC 99 VALUE ZERO. RL1054.2 +022300 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1054.2 +022400 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1054.2 +022500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1054.2 +022600 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1054.2 +022700 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1054.2 +022800 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1054.2 +022900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1054.2 +023000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1054.2 +023100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1054.2 +023200 01 CCVS-H-1. RL1054.2 +023300 02 FILLER PIC X(39) VALUE SPACES. RL1054.2 +023400 02 FILLER PIC X(42) VALUE RL1054.2 +023500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1054.2 +023600 02 FILLER PIC X(39) VALUE SPACES. RL1054.2 +023700 01 CCVS-H-2A. RL1054.2 +023800 02 FILLER PIC X(40) VALUE SPACE. RL1054.2 +023900 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1054.2 +024000 02 FILLER PIC XXXX VALUE RL1054.2 +024100 "4.2 ". RL1054.2 +024200 02 FILLER PIC X(28) VALUE RL1054.2 +024300 " COPY - NOT FOR DISTRIBUTION". RL1054.2 +024400 02 FILLER PIC X(41) VALUE SPACE. RL1054.2 +024500 RL1054.2 +024600 01 CCVS-H-2B. RL1054.2 +024700 02 FILLER PIC X(15) VALUE RL1054.2 +024800 "TEST RESULT OF ". RL1054.2 +024900 02 TEST-ID PIC X(9). RL1054.2 +025000 02 FILLER PIC X(4) VALUE RL1054.2 +025100 " IN ". RL1054.2 +025200 02 FILLER PIC X(12) VALUE RL1054.2 +025300 " HIGH ". RL1054.2 +025400 02 FILLER PIC X(22) VALUE RL1054.2 +025500 " LEVEL VALIDATION FOR ". RL1054.2 +025600 02 FILLER PIC X(58) VALUE RL1054.2 +025700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1054.2 +025800 01 CCVS-H-3. RL1054.2 +025900 02 FILLER PIC X(34) VALUE RL1054.2 +026000 " FOR OFFICIAL USE ONLY ". RL1054.2 +026100 02 FILLER PIC X(58) VALUE RL1054.2 +026200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1054.2 +026300 02 FILLER PIC X(28) VALUE RL1054.2 +026400 " COPYRIGHT 1985 ". RL1054.2 +026500 01 CCVS-E-1. RL1054.2 +026600 02 FILLER PIC X(52) VALUE SPACE. RL1054.2 +026700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1054.2 +026800 02 ID-AGAIN PIC X(9). RL1054.2 +026900 02 FILLER PIC X(45) VALUE SPACES. RL1054.2 +027000 01 CCVS-E-2. RL1054.2 +027100 02 FILLER PIC X(31) VALUE SPACE. RL1054.2 +027200 02 FILLER PIC X(21) VALUE SPACE. RL1054.2 +027300 02 CCVS-E-2-2. RL1054.2 +027400 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1054.2 +027500 03 FILLER PIC X VALUE SPACE. RL1054.2 +027600 03 ENDER-DESC PIC X(44) VALUE RL1054.2 +027700 "ERRORS ENCOUNTERED". RL1054.2 +027800 01 CCVS-E-3. RL1054.2 +027900 02 FILLER PIC X(22) VALUE RL1054.2 +028000 " FOR OFFICIAL USE ONLY". RL1054.2 +028100 02 FILLER PIC X(12) VALUE SPACE. RL1054.2 +028200 02 FILLER PIC X(58) VALUE RL1054.2 +028300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1054.2 +028400 02 FILLER PIC X(13) VALUE SPACE. RL1054.2 +028500 02 FILLER PIC X(15) VALUE RL1054.2 +028600 " COPYRIGHT 1985". RL1054.2 +028700 01 CCVS-E-4. RL1054.2 +028800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1054.2 +028900 02 FILLER PIC X(4) VALUE " OF ". RL1054.2 +029000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1054.2 +029100 02 FILLER PIC X(40) VALUE RL1054.2 +029200 " TESTS WERE EXECUTED SUCCESSFULLY". RL1054.2 +029300 01 XXINFO. RL1054.2 +029400 02 FILLER PIC X(19) VALUE RL1054.2 +029500 "*** INFORMATION ***". RL1054.2 +029600 02 INFO-TEXT. RL1054.2 +029700 04 FILLER PIC X(8) VALUE SPACE. RL1054.2 +029800 04 XXCOMPUTED PIC X(20). RL1054.2 +029900 04 FILLER PIC X(5) VALUE SPACE. RL1054.2 +030000 04 XXCORRECT PIC X(20). RL1054.2 +030100 02 INF-ANSI-REFERENCE PIC X(48). RL1054.2 +030200 01 HYPHEN-LINE. RL1054.2 +030300 02 FILLER PIC IS X VALUE IS SPACE. RL1054.2 +030400 02 FILLER PIC IS X(65) VALUE IS "************************RL1054.2 +030500- "*****************************************". RL1054.2 +030600 02 FILLER PIC IS X(54) VALUE IS "************************RL1054.2 +030700- "******************************". RL1054.2 +030800 01 CCVS-PGM-ID PIC X(9) VALUE RL1054.2 +030900 "RL105A". RL1054.2 +031000 PROCEDURE DIVISION. RL1054.2 +031100 CCVS1 SECTION. RL1054.2 +031200 OPEN-FILES. RL1054.2 +031300 OPEN OUTPUT PRINT-FILE. RL1054.2 +031400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1054.2 +031500 MOVE SPACE TO TEST-RESULTS. RL1054.2 +031600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1054.2 +031700 MOVE ZERO TO REC-SKL-SUB. RL1054.2 +031800 PERFORM CCVS-INIT-FILE 9 TIMES. RL1054.2 +031900 CCVS-INIT-FILE. RL1054.2 +032000 ADD 1 TO REC-SKL-SUB. RL1054.2 +032100 MOVE FILE-RECORD-INFO-SKELETON RL1054.2 +032200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1054.2 +032300 CCVS-INIT-EXIT. RL1054.2 +032400 GO TO CCVS1-EXIT. RL1054.2 +032500 CLOSE-FILES. RL1054.2 +032600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1054.2 +032700 TERMINATE-CCVS. RL1054.2 +032800*S EXIT PROGRAM. RL1054.2 +032900*SERMINATE-CALL. RL1054.2 +033000 STOP RUN. RL1054.2 +033100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1054.2 +033200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1054.2 +033300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1054.2 +033400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1054.2 +033500 MOVE "****TEST DELETED****" TO RE-MARK. RL1054.2 +033600 PRINT-DETAIL. RL1054.2 +033700 IF REC-CT NOT EQUAL TO ZERO RL1054.2 +033800 MOVE "." TO PARDOT-X RL1054.2 +033900 MOVE REC-CT TO DOTVALUE. RL1054.2 +034000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1054.2 +034100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1054.2 +034200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1054.2 +034300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1054.2 +034400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1054.2 +034500 MOVE SPACE TO CORRECT-X. RL1054.2 +034600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1054.2 +034700 MOVE SPACE TO RE-MARK. RL1054.2 +034800 HEAD-ROUTINE. RL1054.2 +034900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +035000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +035100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1054.2 +035200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1054.2 +035300 COLUMN-NAMES-ROUTINE. RL1054.2 +035400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +035500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +035700 END-ROUTINE. RL1054.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1054.2 +035900 END-RTN-EXIT. RL1054.2 +036000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +036100 END-ROUTINE-1. RL1054.2 +036200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1054.2 +036300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1054.2 +036400 ADD PASS-COUNTER TO ERROR-HOLD. RL1054.2 +036500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1054.2 +036600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1054.2 +036700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1054.2 +036800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1054.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1054.2 +037000 END-ROUTINE-12. RL1054.2 +037100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1054.2 +037200 IF ERROR-COUNTER IS EQUAL TO ZERO RL1054.2 +037300 MOVE "NO " TO ERROR-TOTAL RL1054.2 +037400 ELSE RL1054.2 +037500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1054.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1054.2 +037700 PERFORM WRITE-LINE. RL1054.2 +037800 END-ROUTINE-13. RL1054.2 +037900 IF DELETE-COUNTER IS EQUAL TO ZERO RL1054.2 +038000 MOVE "NO " TO ERROR-TOTAL ELSE RL1054.2 +038100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1054.2 +038200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1054.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +038400 IF INSPECT-COUNTER EQUAL TO ZERO RL1054.2 +038500 MOVE "NO " TO ERROR-TOTAL RL1054.2 +038600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1054.2 +038700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1054.2 +038800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +038900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1054.2 +039000 WRITE-LINE. RL1054.2 +039100 ADD 1 TO RECORD-COUNT. RL1054.2 +039200 IF RECORD-COUNT GREATER 50 RL1054.2 +039300 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1054.2 +039400 MOVE SPACE TO DUMMY-RECORD RL1054.2 +039500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1054.2 +039600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1054.2 +039700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1054.2 +039800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1054.2 +039900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1054.2 +040000 MOVE ZERO TO RECORD-COUNT. RL1054.2 +040100 PERFORM WRT-LN. RL1054.2 +040200 WRT-LN. RL1054.2 +040300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1054.2 +040400 MOVE SPACE TO DUMMY-RECORD. RL1054.2 +040500 BLANK-LINE-PRINT. RL1054.2 +040600 PERFORM WRT-LN. RL1054.2 +040700 FAIL-ROUTINE. RL1054.2 +040800 IF COMPUTED-X NOT EQUAL TO SPACE RL1054.2 +040900 GO TO FAIL-ROUTINE-WRITE. RL1054.2 +041000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1054.2 +041100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1054.2 +041200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1054.2 +041300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +041400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1054.2 +041500 GO TO FAIL-ROUTINE-EX. RL1054.2 +041600 FAIL-ROUTINE-WRITE. RL1054.2 +041700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1054.2 +041800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1054.2 +041900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1054.2 +042000 MOVE SPACES TO COR-ANSI-REFERENCE. RL1054.2 +042100 FAIL-ROUTINE-EX. EXIT. RL1054.2 +042200 BAIL-OUT. RL1054.2 +042300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1054.2 +042400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1054.2 +042500 BAIL-OUT-WRITE. RL1054.2 +042600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1054.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1054.2 +042800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1054.2 +042900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1054.2 +043000 BAIL-OUT-EX. EXIT. RL1054.2 +043100 CCVS1-EXIT. RL1054.2 +043200 EXIT. RL1054.2 +043300 SECT-RL105-001 SECTION. RL1054.2 +043400 SECT-RC-01-001-INIT. RL1054.2 +043500 MOVE 1 TO KEY-1 KEY-2 KEY-3 2POS-NUM. RL1054.2 +043600 MOVE "READ/WRITE INVAL KEY" TO FEATURE. RL1054.2 +043700 WRITE-REL-RECORDS SECTION. RL1054.2 +043800 REL-INIT-1. RL1054.2 +043900 MOVE ZERO TO 2POS-NUM. RL1054.2 +044000 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +044100 OPEN OUTPUT RL-FR1. RL1054.2 +044200 REL-TEST-1. RL1054.2 +044300 PERFORM REL-WRITE-FOR-TEST-1 THRU 1-EXIT 19 TIMES. RL1054.2 +044400 IF READ-WRITE-COUNTER EQUAL TO "WWWWWWWWWWWWWWWWWWW " RL1054.2 +044500 MOVE "19 RECORDS PASSED TO TEST-2" TO RE-MARK RL1054.2 +044600 GO TO REL-TEST-1-WRITE. RL1054.2 +044700 MOVE "WWWWWWWWWWWWWWWWWWW " TO CORRECT-A. RL1054.2 +044800 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1054.2 +044900 PERFORM FAIL. RL1054.2 +045000 GO TO REL-TEST-1-WRITE. RL1054.2 +045100 REL-DELETE-TEST-1. RL1054.2 +045200 MOVE "***TESTS-DELETED ***" TO COMPUTED-A CORRECT-A. RL1054.2 +045300 MOVE "WRITE-REL-RECORDS SECTION " TO RE-MARK. RL1054.2 +045400 PERFORM REL-TEST-1-WRITE. RL1054.2 +045500 GO TO EXIT-SECTION-1. RL1054.2 +045600 REL-WRITE-FOR-TEST-1. RL1054.2 +045700 ADD 1 TO SUB-1. RL1054.2 +045800 MOVE "W" TO ENTRY-RW (SUB-1). RL1054.2 +045900 MOVE SUB-1 TO KEY-1. RL1054.2 +046000 ADD 1 TO 2POS-NUM. RL1054.2 +046100 MOVE RECORD-MESSAGE TO GRP-1SEQ-RECORD-1. RL1054.2 +046200 WRITE GRP-1SEQ-RECORD-1 INVALID KEY GO TO I-KEY-1. RL1054.2 +046300 GO TO 1-EXIT. RL1054.2 +046400 I-KEY-1. RL1054.2 +046500 MOVE "I" TO ENTRY-RW (SUB-1). RL1054.2 +046600 1-EXIT. RL1054.2 +046700 EXIT. RL1054.2 +046800 REL-TEST-1-WRITE. RL1054.2 +046900 MOVE "REL-TEST-1 " TO PAR-NAME. RL1054.2 +047000 PERFORM PRINT-DETAIL. RL1054.2 +047100 CLOSE RL-FR1. RL1054.2 +047200 REL-INIT-2. RL1054.2 +047300 MOVE 01 TO SUB-1 KEY-1. RL1054.2 +047400 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +047500 OPEN INPUT RL-FR1. RL1054.2 +047600 REL-TEST-2. RL1054.2 +047700 READ RL-FR1 RECORD INVALID RL1054.2 +047800 MOVE "E" TO ENTRY-RW (SUB-1) RL1054.2 +047900 GO TO COMPARE-FOR-TEST-2. RL1054.2 +048000 IF SUB-1 EQUAL TO 20 RL1054.2 +048100 GO TO COMPARE-FOR-TEST-2. RL1054.2 +048200 MOVE "R" TO ENTRY-RW (SUB-1). RL1054.2 +048300 ADD 1 TO SUB-1. RL1054.2 +048400 MOVE SUB-1 TO KEY-1. RL1054.2 +048500 GO TO REL-TEST-2. RL1054.2 +048600 COMPARE-FOR-TEST-2. RL1054.2 +048700 IF READ-WRITE-COUNTER EQUAL TO "RRRRRRRRRRRRRRRRRRRE" RL1054.2 +048800 PERFORM PASS RL1054.2 +048900 GO TO REL-TEST-2-WRITE. RL1054.2 +049000 MOVE "RRRRRRRRRRRRRRRRRRRE" TO CORRECT-A. RL1054.2 +049100 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1054.2 +049200 MOVE "INCORRECT RECORD COUNT " TO RE-MARK. RL1054.2 +049300 PERFORM FAIL. RL1054.2 +049400 REL-TEST-2-WRITE. RL1054.2 +049500 MOVE "REL-TEST-2 " TO PAR-NAME. RL1054.2 +049600 PERFORM PRINT-DETAIL. RL1054.2 +049700 EXIT-SECTION-1. RL1054.2 +049800 CLOSE RL-FR1. RL1054.2 +049900 BLOCKED-UNBLOCKED SECTION. RL1054.2 +050000 REL-INIT-3. RL1054.2 +050100 MOVE 0 TO SUB-1. RL1054.2 +050200 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +050300 OPEN OUTPUT RL-FR2. RL1054.2 +050400 MOVE 1 TO KEY-2 2POS-NUM. RL1054.2 +050500 REL-TEST-3. RL1054.2 +050600 PERFORM REL-WRITE-FOR-TEST-3 THRU 3-EXIT 8 TIMES. RL1054.2 +050700 PERFORM REL-WRITE-FOR-TEST-3 THRU 3-EXIT 8 TIMES. RL1054.2 +050800 CLOSE RL-FR2. RL1054.2 +050900 MOVE "REL-TEST-3 " TO PAR-NAME. RL1054.2 +051000 IF READ-WRITE-COUNTER NOT EQUAL TO "WWWWWWWWWWWWWWWW " RL1054.2 +051100 MOVE "INVALID KEYS ON WRITE " TO RE-MARK ELSE RL1054.2 +051200 MOVE "16 RECORDS PASSED TO TEST-4" TO RE-MARK. RL1054.2 +051300 MOVE SPACE TO CORRECT-A COMPUTED-A. RL1054.2 +051400 PERFORM PRINT-DETAIL. RL1054.2 +051500 GO TO REL-TEST-4. RL1054.2 +051600 REL-DELETE-TEST-3. RL1054.2 +051700 MOVE "***TESTS-DELETED ***" TO CORRECT-A COMPUTED-A. RL1054.2 +051800 MOVE "BLOCKED-UNBLOCKED SECTION " TO RE-MARK. RL1054.2 +051900 MOVE "REL-TEST-3 " TO PAR-NAME. RL1054.2 +052000 PERFORM PRINT-DETAIL. RL1054.2 +052100 GO TO REL-TEST-4. RL1054.2 +052200 REL-WRITE-FOR-TEST-3. RL1054.2 +052300 MOVE RECORD-MESSAGE TO GRP-1SEQ-RECORD-2. RL1054.2 +052400 WRITE GRP-1SEQ-RECORD-2 INVALID KEY GO TO I-KEY-3. RL1054.2 +052500 MOVE "W" TO ENTRY-RW (2POS-NUM). RL1054.2 +052600 ADD 1 TO 2POS-NUM. RL1054.2 +052700 MOVE 2POS-NUM TO KEY-2. RL1054.2 +052800 GO TO 3-EXIT. RL1054.2 +052900 I-KEY-3. RL1054.2 +053000 MOVE "I" TO ENTRY-RW (2POS-NUM). RL1054.2 +053100 ADD 1 TO 2POS-NUM. RL1054.2 +053200 MOVE 2POS-NUM TO KEY-2. RL1054.2 +053300 3-EXIT. RL1054.2 +053400 EXIT. RL1054.2 +053500 REL-TEST-4. RL1054.2 +053600 OPEN INPUT RL-FR2. RL1054.2 +053700 MOVE 01 TO 2POS-NUM. RL1054.2 +053800 MOVE 01 TO SUB-1 KEY-2. RL1054.2 +053900 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +054000 READ-FOR-TEST-4. RL1054.2 +054100 READ RL-FR2 INVALID RL1054.2 +054200 MOVE "INVALID KEY FILE-2 " TO COMPUTED-A RL1054.2 +054300 MOVE SPACE TO CORRECT-A RL1054.2 +054400 MOVE "INVALID KEY ON FIRST READ " TO RE-MARK RL1054.2 +054500 PERFORM FAIL RL1054.2 +054600 MOVE "I" TO ENTRY-RW (SUB-1) RL1054.2 +054700 GO TO REL-TEST-4-WRITE. RL1054.2 +054800 IF GRP-1SEQ-RECORD-2 NOT EQUAL TO RECORD-MESSAGE RL1054.2 +054900 MOVE "INCORRECT 1ST RECORD" TO COMPUTED-A RL1054.2 +055000 MOVE SPACE TO CORRECT-A RL1054.2 +055100 MOVE "RECORD NO. 1 INVALID" TO RE-MARK RL1054.2 +055200 PERFORM FAIL RL1054.2 +055300 MOVE "R" TO ENTRY-RW (SUB-1) RL1054.2 +055400 GO TO REL-TEST-4-WRITE. RL1054.2 +055500 MOVE "R" TO ENTRY-RW (SUB-1). RL1054.2 +055600 PERFORM PASS. RL1054.2 +055700 REL-TEST-4-WRITE. RL1054.2 +055800 MOVE "REL-TEST-4 " TO PAR-NAME. RL1054.2 +055900 PERFORM PRINT-DETAIL. RL1054.2 +056000 REL-TEST-5. RL1054.2 +056100 ADD 1 TO SUB-1. RL1054.2 +056200* NOTE THIS TEST DEPENDS ON TEST-4. RL1054.2 +056300 MOVE SUB-1 TO KEY-2. RL1054.2 +056400 READ RL-FR2 INVALID KEY RL1054.2 +056500 MOVE "E" TO ENTRY-RW (SUB-1) RL1054.2 +056600 GO TO COMPARE-FOR-TEST-5. RL1054.2 +056700 IF SUB-1 EQUAL TO 17 RL1054.2 +056800 GO TO COMPARE-FOR-TEST-5. RL1054.2 +056900 MOVE "R" TO ENTRY-RW (SUB-1). RL1054.2 +057000 GO TO REL-TEST-5. RL1054.2 +057100 COMPARE-FOR-TEST-5. RL1054.2 +057200 IF READ-WRITE-COUNTER EQUAL TO "RRRRRRRRRRRRRRRRE " RL1054.2 +057300 PERFORM PASS RL1054.2 +057400 GO TO REL-TEST-5-WRITE. RL1054.2 +057500 MOVE "RRRRRRRRRRRRRRRRE " TO CORRECT-A. RL1054.2 +057600 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1054.2 +057700 MOVE "INCORRECT RECORD COUNT " TO RE-MARK. RL1054.2 +057800 PERFORM FAIL. RL1054.2 +057900 REL-TEST-5-WRITE. RL1054.2 +058000 MOVE "REL-TEST-5 " TO PAR-NAME. RL1054.2 +058100 PERFORM PRINT-DETAIL. RL1054.2 +058200 CLOSE RL-FR2. RL1054.2 +058300 OPEN OUTPUT RL-FR3. RL1054.2 +058400 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +058500 MOVE 1 TO KEY-3 2POS-NUM. RL1054.2 +058600 REL-TEST-6. RL1054.2 +058700 PERFORM REL-WRITE-FOR-TEST-6 THRU 6-EXIT 7 TIMES. RL1054.2 +058800 PERFORM REL-WRITE-FOR-TEST-6 THRU 6-EXIT 9 TIMES. RL1054.2 +058900 IF READ-WRITE-COUNTER NOT EQUAL TO "WWWWWWWWWWWWWWWW " RL1054.2 +059000 MOVE "INVALID KEYS ON WRITE " TO RE-MARK ELSE RL1054.2 +059100 MOVE "16 RECORDS PASSED TO TEST-7" TO RE-MARK. RL1054.2 +059200 MOVE SPACE TO CORRECT-A COMPUTED-A. RL1054.2 +059300 MOVE "REL-TEST-6 " TO PAR-NAME. RL1054.2 +059400 PERFORM PRINT-DETAIL. RL1054.2 +059500 CLOSE RL-FR3. RL1054.2 +059600 GO TO REL-TEST-7. RL1054.2 +059700 REL-WRITE-FOR-TEST-6. RL1054.2 +059800 MOVE RECORD-MESSAGE TO GRP-1SEQ-RECORD-3. RL1054.2 +059900 WRITE GRP-1SEQ-RECORD-3 INVALID KEY GO TO I-KEY-6. RL1054.2 +060000 MOVE "W" TO ENTRY-RW (2POS-NUM). RL1054.2 +060100 ADD 1 TO 2POS-NUM. RL1054.2 +060200 MOVE 2POS-NUM TO KEY-3. RL1054.2 +060300 GO TO 6-EXIT. RL1054.2 +060400 I-KEY-6. RL1054.2 +060500 MOVE "I" TO ENTRY-RW (2POS-NUM). RL1054.2 +060600 ADD 1 TO 2POS-NUM. RL1054.2 +060700 MOVE 2POS-NUM TO KEY-3. RL1054.2 +060800 6-EXIT. RL1054.2 +060900 EXIT. RL1054.2 +061000 REL-TEST-7. RL1054.2 +061100 OPEN INPUT RL-FR3. RL1054.2 +061200 MOVE 08 TO SUB-1 KEY-3 2POS-NUM. RL1054.2 +061300 MOVE SPACE TO READ-WRITE-COUNTER. RL1054.2 +061400 READ-FOR-TEST-7. RL1054.2 +061500 READ RL-FR3 INVALID KEY RL1054.2 +061600 MOVE "INVALID KEY ON FILE3" TO COMPUTED-A RL1054.2 +061700 MOVE SPACE TO CORRECT-A RL1054.2 +061800 PERFORM FAIL RL1054.2 +061900 GO TO REL-TEST-7-WRITE. RL1054.2 +062000 IF GRP-1SEQ-RECORD-3 NOT EQUAL TO RECORD-MESSAGE RL1054.2 +062100 MOVE GRP-1SEQ-RECORD-3 TO COMPUTED-A RL1054.2 +062200 MOVE "8TH RECORD MESSAGE" TO CORRECT-A RL1054.2 +062300 MOVE "COMPUTED-A SHOWS 1ST 20 POS" TO RE-MARK RL1054.2 +062400 PERFORM FAIL RL1054.2 +062500 GO TO REL-TEST-7-WRITE. RL1054.2 +062600 PERFORM PASS. RL1054.2 +062700 REL-TEST-7-WRITE. RL1054.2 +062800 MOVE "REL-TEST-7 " TO PAR-NAME. RL1054.2 +062900 PERFORM PRINT-DETAIL. RL1054.2 +063000 CLOSE RL-FR3. RL1054.2 +063100 CCVS-EXIT SECTION. RL1054.2 +063200 CCVS-999999. RL1054.2 +063300 GO TO CLOSE-FILES. RL1054.2 diff --git a/tests/cobol85/RL/RL106A.CBL b/tests/cobol85/RL/RL106A.CBL new file mode 100644 index 00000000..d8192ad8 --- /dev/null +++ b/tests/cobol85/RL/RL106A.CBL @@ -0,0 +1,814 @@ +000100 IDENTIFICATION DIVISION. RL1064.2 +000200 PROGRAM-ID. RL1064.2 +000300 RL106A. RL1064.2 +000400**************************************************************** RL1064.2 +000500* * RL1064.2 +000600* VALIDATION FOR:- * RL1064.2 +000700* * RL1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1064.2 +000900* * RL1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1064.2 +001100* * RL1064.2 +001200**************************************************************** RL1064.2 +001300*GENERAL: THIS PROGRAM PROCESSES THREE RLEATIVE I-O FILES RL1064.2 +001400* IDENTIFIED AS RL-FR4,RL-FR5 AND RL-FR6. THE FUNCTIONRL1064.2 +001500* OF THIS PROGRAM IS TO CREATE THREE RELATIVE FILES RL1064.2 +001600* RANDOMLLY (ACCESS MODE RANDOM) AND VERIFY THAT THEY RL1064.2 +001700* WERE CREATED CORRECTLY. THE FILES PROCESSED RL1064.2 +001800* CONTAIN VARIABLE LENGTH RECORDS. RL1064.2 +001900* RL1064.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1064.2 +002100* PROGRAM ARE: RL1064.2 +002200* RL1064.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1064.2 +002400* RELATIVE I-O DATA FILE-1 RL1064.2 +002500* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1064.2 +002600* RELATIVE I-O DATA FILE-2 RL1064.2 +002700* X-23 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1064.2 +002800* RELATIVE I-O DATA FILE-3 RL1064.2 +002900* X-55 SYSTEM PRINTER RL1064.2 +003000* X-69 ADDITIONAL VALUE OF CLAUSES RL1064.2 +003100* X-74 VALUE OF IMPLEMENTOR-NAME RL1064.2 +003200* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE-1 RL1064.2 +003300* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE-2 RL1064.2 +003400* X-77 OBJECT OF VALUE OF CLAUSE FOR FILE-3 RL1064.2 +003500* X-82 SOURCE-COMPUTER RL1064.2 +003600* X-83 OBJECT-COMPUTER. RL1064.2 +003700* RL1064.2 +003800**************************************************************** RL1064.2 +003900 ENVIRONMENT DIVISION. RL1064.2 +004000 CONFIGURATION SECTION. RL1064.2 +004100 SOURCE-COMPUTER. RL1064.2 +004200 Linux. RL1064.2 +004300 OBJECT-COMPUTER. RL1064.2 +004400 Linux. RL1064.2 +004500 INPUT-OUTPUT SECTION. RL1064.2 +004600 FILE-CONTROL. RL1064.2 +004700 SELECT PRINT-FILE ASSIGN TO RL1064.2 +004800 "report.log". RL1064.2 +004900 SELECT RL-FR4 ASSIGN TO RL1064.2 +005000 "XXXXX021" RL1064.2 +005100 ORGANIZATION IS RELATIVE RL1064.2 +005200 ACCESS MODE IS RANDOM RL1064.2 +005300 RELATIVE KEY IS KEY-1. RL1064.2 +005400 SELECT RL-FR5 ASSIGN TO RL1064.2 +005500 "XXXXX022" RL1064.2 +005600 ORGANIZATION IS RELATIVE RL1064.2 +005700 ACCESS MODE IS RANDOM RL1064.2 +005800 RELATIVE KEY IS KEY-2. RL1064.2 +005900 SELECT RL-FR6 ASSIGN TO RL1064.2 +006000 "XXXXX023" RL1064.2 +006100 ORGANIZATION IS RELATIVE RL1064.2 +006200 ACCESS MODE IS RANDOM RL1064.2 +006300 RELATIVE KEY IS KEY-3. RL1064.2 +006400 I-O-CONTROL. RL1064.2 +006500 SAME RL-FR5 RL-FR6. RL1064.2 +006600 DATA DIVISION. RL1064.2 +006700 FILE SECTION. RL1064.2 +006800 FD PRINT-FILE. RL1064.2 +006900 01 PRINT-REC PICTURE X(120). RL1064.2 +007000 01 DUMMY-RECORD PICTURE X(120). RL1064.2 +007100 FD RL-FR4 RL1064.2 +007200*C VALUE OF RL1064.2 +007300*C OCLABELID RL1064.2 +007400*C IS RL1064.2 +007500*C "OCDUMMY" RL1064.2 +007600*G SYSIN RL1064.2 +007700 LABEL RECORDS ARE STANDARD RL1064.2 +007800 DATA RECORDS ARE GRP-1SEQ-RECORD-4A GRP-1SEQ-RECORD-4B. RL1064.2 +007900 01 GRP-1SEQ-RECORD-4A. RL1064.2 +008000 02 FILLER-4A PICTURE X(56). RL1064.2 +008100 01 GRP-1SEQ-RECORD-4B. RL1064.2 +008200 02 FILLER-4B PICTURE X(56). RL1064.2 +008300 02 LONG-REC-4B. RL1064.2 +008400 03 FILLER PICTURE X(15). RL1064.2 +008500 03 REC-NUMBER-4B PIC XX. RL1064.2 +008600 03 FILLER PICTURE X(27). RL1064.2 +008700 FD RL-FR5 RL1064.2 +008800 RECORD CONTAINS 56 TO 101 CHARACTERS RL1064.2 +008900*C VALUE OF RL1064.2 +009000*C OCLABELID RL1064.2 +009100*C IS RL1064.2 +009200*C "OCDUMMY" RL1064.2 +009300*G SYSIN RL1064.2 +009400 LABEL RECORDS ARE STANDARD RL1064.2 +009500 DATA RECORDS GRP-1SEQ-RECORD-5A GRP-1SEQ-RECORD-5B. RL1064.2 +009600 01 GRP-1SEQ-RECORD-5A. RL1064.2 +009700 02 FILLER-5A PICTURE X(56). RL1064.2 +009800 01 GRP-1SEQ-RECORD-5B. RL1064.2 +009900 02 FILLER-5B PICTURE X(56). RL1064.2 +010000 02 LONG-REC-5B. RL1064.2 +010100 03 FILLER PICTURE X(15). RL1064.2 +010200 03 REC-NUMBER-5B PIC XX. RL1064.2 +010300 03 FILLER PICTURE X(28). RL1064.2 +010400 FD RL-FR6 RL1064.2 +010500 BLOCK 3 RECORDS RL1064.2 +010600 RECORD CONTAINS 56 TO 102 CHARACTERS RL1064.2 +010700 LABEL RECORD STANDARD RL1064.2 +010800*C VALUE OF RL1064.2 +010900*C OCLABELID RL1064.2 +011000*C IS RL1064.2 +011100*C "OCDUMMY" RL1064.2 +011200 DATA RECORD GRP-1SEQ-RECORD-6A GRP-1SEQ-RECORD-6B. RL1064.2 +011300 01 GRP-1SEQ-RECORD-6A. RL1064.2 +011400 02 FILLER-6A PICTURE X(56). RL1064.2 +011500 01 GRP-1SEQ-RECORD-6B. RL1064.2 +011600 02 FILLER-6B PICTURE X(56). RL1064.2 +011700 02 LONG-REC-6B. RL1064.2 +011800 03 FILLER PICTURE X(15). RL1064.2 +011900 03 REC-NUMBER-6B PIC XX. RL1064.2 +012000 03 FILLER PICTURE X(29). RL1064.2 +012100 WORKING-STORAGE SECTION. RL1064.2 +012200 77 SUB-1 PICTURE 99. RL1064.2 +012300 77 KEY-1 RL1064.2 +012400 PICTURE 9(5). RL1064.2 +012500 77 KEY-2 RL1064.2 +012600 PICTURE 9(5). RL1064.2 +012700 77 KEY-3 RL1064.2 +012800 PICTURE 9(5). RL1064.2 +012900 01 READ-WRITE-COUNTER. RL1064.2 +013000 02 ENTRY-RW OCCURS 20 TIMES PICTURE X. RL1064.2 +013100 01 RECORD-BUILD. RL1064.2 +013200 02 FILLER PICTURE X(27) VALUE RL1064.2 +013300 " TYPE OF RECORD WRITTEN IS ". RL1064.2 +013400 02 RECORD-LONG-OR-SHORT PICTURE X(5) VALUE "SHORT". RL1064.2 +013500 02 FILLER PICTURE X(24) VALUE SPACE. RL1064.2 +013600 02 RECORD-LONG-ONLY. RL1064.2 +013700 03 FILLER PICTURE X(15) VALUE RL1064.2 +013800 " RECORD NUMBER ". RL1064.2 +013900 03 POS-NUM2 PICTURE 99. RL1064.2 +014000 03 FILLER-LONG PICTURE X(29) VALUE RL1064.2 +014100 " AREA USED FOR LONG RECORD ". RL1064.2 +014200 01 FILE-RECORD-INFORMATION-REC. RL1064.2 +014300 03 FILE-RECORD-INFO-SKELETON. RL1064.2 +014400 05 FILLER PICTURE X(48) VALUE RL1064.2 +014500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1064.2 +014600 05 FILLER PICTURE X(46) VALUE RL1064.2 +014700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1064.2 +014800 05 FILLER PICTURE X(26) VALUE RL1064.2 +014900 ",LFIL=000000,ORG= ,LBLR= ". RL1064.2 +015000 05 FILLER PICTURE X(37) VALUE RL1064.2 +015100 ",RECKEY= ". RL1064.2 +015200 05 FILLER PICTURE X(38) VALUE RL1064.2 +015300 ",ALTKEY1= ". RL1064.2 +015400 05 FILLER PICTURE X(38) VALUE RL1064.2 +015500 ",ALTKEY2= ". RL1064.2 +015600 05 FILLER PICTURE X(7) VALUE SPACE.RL1064.2 +015700 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1064.2 +015800 05 FILE-RECORD-INFO-P1-120. RL1064.2 +015900 07 FILLER PIC X(5). RL1064.2 +016000 07 XFILE-NAME PIC X(6). RL1064.2 +016100 07 FILLER PIC X(8). RL1064.2 +016200 07 XRECORD-NAME PIC X(6). RL1064.2 +016300 07 FILLER PIC X(1). RL1064.2 +016400 07 REELUNIT-NUMBER PIC 9(1). RL1064.2 +016500 07 FILLER PIC X(7). RL1064.2 +016600 07 XRECORD-NUMBER PIC 9(6). RL1064.2 +016700 07 FILLER PIC X(6). RL1064.2 +016800 07 UPDATE-NUMBER PIC 9(2). RL1064.2 +016900 07 FILLER PIC X(5). RL1064.2 +017000 07 ODO-NUMBER PIC 9(4). RL1064.2 +017100 07 FILLER PIC X(5). RL1064.2 +017200 07 XPROGRAM-NAME PIC X(5). RL1064.2 +017300 07 FILLER PIC X(7). RL1064.2 +017400 07 XRECORD-LENGTH PIC 9(6). RL1064.2 +017500 07 FILLER PIC X(7). RL1064.2 +017600 07 CHARS-OR-RECORDS PIC X(2). RL1064.2 +017700 07 FILLER PIC X(1). RL1064.2 +017800 07 XBLOCK-SIZE PIC 9(4). RL1064.2 +017900 07 FILLER PIC X(6). RL1064.2 +018000 07 RECORDS-IN-FILE PIC 9(6). RL1064.2 +018100 07 FILLER PIC X(5). RL1064.2 +018200 07 XFILE-ORGANIZATION PIC X(2). RL1064.2 +018300 07 FILLER PIC X(6). RL1064.2 +018400 07 XLABEL-TYPE PIC X(1). RL1064.2 +018500 05 FILE-RECORD-INFO-P121-240. RL1064.2 +018600 07 FILLER PIC X(8). RL1064.2 +018700 07 XRECORD-KEY PIC X(29). RL1064.2 +018800 07 FILLER PIC X(9). RL1064.2 +018900 07 ALTERNATE-KEY1 PIC X(29). RL1064.2 +019000 07 FILLER PIC X(9). RL1064.2 +019100 07 ALTERNATE-KEY2 PIC X(29). RL1064.2 +019200 07 FILLER PIC X(7). RL1064.2 +019300 01 TEST-RESULTS. RL1064.2 +019400 02 FILLER PIC X VALUE SPACE. RL1064.2 +019500 02 FEATURE PIC X(20) VALUE SPACE. RL1064.2 +019600 02 FILLER PIC X VALUE SPACE. RL1064.2 +019700 02 P-OR-F PIC X(5) VALUE SPACE. RL1064.2 +019800 02 FILLER PIC X VALUE SPACE. RL1064.2 +019900 02 PAR-NAME. RL1064.2 +020000 03 FILLER PIC X(19) VALUE SPACE. RL1064.2 +020100 03 PARDOT-X PIC X VALUE SPACE. RL1064.2 +020200 03 DOTVALUE PIC 99 VALUE ZERO. RL1064.2 +020300 02 FILLER PIC X(8) VALUE SPACE. RL1064.2 +020400 02 RE-MARK PIC X(61). RL1064.2 +020500 01 TEST-COMPUTED. RL1064.2 +020600 02 FILLER PIC X(30) VALUE SPACE. RL1064.2 +020700 02 FILLER PIC X(17) VALUE RL1064.2 +020800 " COMPUTED=". RL1064.2 +020900 02 COMPUTED-X. RL1064.2 +021000 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1064.2 +021100 03 COMPUTED-N REDEFINES COMPUTED-A RL1064.2 +021200 PIC -9(9).9(9). RL1064.2 +021300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1064.2 +021400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1064.2 +021500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1064.2 +021600 03 CM-18V0 REDEFINES COMPUTED-A. RL1064.2 +021700 04 COMPUTED-18V0 PIC -9(18). RL1064.2 +021800 04 FILLER PIC X. RL1064.2 +021900 03 FILLER PIC X(50) VALUE SPACE. RL1064.2 +022000 01 TEST-CORRECT. RL1064.2 +022100 02 FILLER PIC X(30) VALUE SPACE. RL1064.2 +022200 02 FILLER PIC X(17) VALUE " CORRECT =". RL1064.2 +022300 02 CORRECT-X. RL1064.2 +022400 03 CORRECT-A PIC X(20) VALUE SPACE. RL1064.2 +022500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1064.2 +022600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1064.2 +022700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1064.2 +022800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1064.2 +022900 03 CR-18V0 REDEFINES CORRECT-A. RL1064.2 +023000 04 CORRECT-18V0 PIC -9(18). RL1064.2 +023100 04 FILLER PIC X. RL1064.2 +023200 03 FILLER PIC X(2) VALUE SPACE. RL1064.2 +023300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1064.2 +023400 01 CCVS-C-1. RL1064.2 +023500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1064.2 +023600- "SS PARAGRAPH-NAME RL1064.2 +023700- " REMARKS". RL1064.2 +023800 02 FILLER PIC X(20) VALUE SPACE. RL1064.2 +023900 01 CCVS-C-2. RL1064.2 +024000 02 FILLER PIC X VALUE SPACE. RL1064.2 +024100 02 FILLER PIC X(6) VALUE "TESTED". RL1064.2 +024200 02 FILLER PIC X(15) VALUE SPACE. RL1064.2 +024300 02 FILLER PIC X(4) VALUE "FAIL". RL1064.2 +024400 02 FILLER PIC X(94) VALUE SPACE. RL1064.2 +024500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1064.2 +024600 01 REC-CT PIC 99 VALUE ZERO. RL1064.2 +024700 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1064.2 +024800 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1064.2 +024900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1064.2 +025000 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1064.2 +025100 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1064.2 +025200 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1064.2 +025300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1064.2 +025400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1064.2 +025500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1064.2 +025600 01 CCVS-H-1. RL1064.2 +025700 02 FILLER PIC X(39) VALUE SPACES. RL1064.2 +025800 02 FILLER PIC X(42) VALUE RL1064.2 +025900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1064.2 +026000 02 FILLER PIC X(39) VALUE SPACES. RL1064.2 +026100 01 CCVS-H-2A. RL1064.2 +026200 02 FILLER PIC X(40) VALUE SPACE. RL1064.2 +026300 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1064.2 +026400 02 FILLER PIC XXXX VALUE RL1064.2 +026500 "4.2 ". RL1064.2 +026600 02 FILLER PIC X(28) VALUE RL1064.2 +026700 " COPY - NOT FOR DISTRIBUTION". RL1064.2 +026800 02 FILLER PIC X(41) VALUE SPACE. RL1064.2 +026900 RL1064.2 +027000 01 CCVS-H-2B. RL1064.2 +027100 02 FILLER PIC X(15) VALUE RL1064.2 +027200 "TEST RESULT OF ". RL1064.2 +027300 02 TEST-ID PIC X(9). RL1064.2 +027400 02 FILLER PIC X(4) VALUE RL1064.2 +027500 " IN ". RL1064.2 +027600 02 FILLER PIC X(12) VALUE RL1064.2 +027700 " HIGH ". RL1064.2 +027800 02 FILLER PIC X(22) VALUE RL1064.2 +027900 " LEVEL VALIDATION FOR ". RL1064.2 +028000 02 FILLER PIC X(58) VALUE RL1064.2 +028100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1064.2 +028200 01 CCVS-H-3. RL1064.2 +028300 02 FILLER PIC X(34) VALUE RL1064.2 +028400 " FOR OFFICIAL USE ONLY ". RL1064.2 +028500 02 FILLER PIC X(58) VALUE RL1064.2 +028600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1064.2 +028700 02 FILLER PIC X(28) VALUE RL1064.2 +028800 " COPYRIGHT 1985 ". RL1064.2 +028900 01 CCVS-E-1. RL1064.2 +029000 02 FILLER PIC X(52) VALUE SPACE. RL1064.2 +029100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1064.2 +029200 02 ID-AGAIN PIC X(9). RL1064.2 +029300 02 FILLER PIC X(45) VALUE SPACES. RL1064.2 +029400 01 CCVS-E-2. RL1064.2 +029500 02 FILLER PIC X(31) VALUE SPACE. RL1064.2 +029600 02 FILLER PIC X(21) VALUE SPACE. RL1064.2 +029700 02 CCVS-E-2-2. RL1064.2 +029800 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1064.2 +029900 03 FILLER PIC X VALUE SPACE. RL1064.2 +030000 03 ENDER-DESC PIC X(44) VALUE RL1064.2 +030100 "ERRORS ENCOUNTERED". RL1064.2 +030200 01 CCVS-E-3. RL1064.2 +030300 02 FILLER PIC X(22) VALUE RL1064.2 +030400 " FOR OFFICIAL USE ONLY". RL1064.2 +030500 02 FILLER PIC X(12) VALUE SPACE. RL1064.2 +030600 02 FILLER PIC X(58) VALUE RL1064.2 +030700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1064.2 +030800 02 FILLER PIC X(13) VALUE SPACE. RL1064.2 +030900 02 FILLER PIC X(15) VALUE RL1064.2 +031000 " COPYRIGHT 1985". RL1064.2 +031100 01 CCVS-E-4. RL1064.2 +031200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1064.2 +031300 02 FILLER PIC X(4) VALUE " OF ". RL1064.2 +031400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1064.2 +031500 02 FILLER PIC X(40) VALUE RL1064.2 +031600 " TESTS WERE EXECUTED SUCCESSFULLY". RL1064.2 +031700 01 XXINFO. RL1064.2 +031800 02 FILLER PIC X(19) VALUE RL1064.2 +031900 "*** INFORMATION ***". RL1064.2 +032000 02 INFO-TEXT. RL1064.2 +032100 04 FILLER PIC X(8) VALUE SPACE. RL1064.2 +032200 04 XXCOMPUTED PIC X(20). RL1064.2 +032300 04 FILLER PIC X(5) VALUE SPACE. RL1064.2 +032400 04 XXCORRECT PIC X(20). RL1064.2 +032500 02 INF-ANSI-REFERENCE PIC X(48). RL1064.2 +032600 01 HYPHEN-LINE. RL1064.2 +032700 02 FILLER PIC IS X VALUE IS SPACE. RL1064.2 +032800 02 FILLER PIC IS X(65) VALUE IS "************************RL1064.2 +032900- "*****************************************". RL1064.2 +033000 02 FILLER PIC IS X(54) VALUE IS "************************RL1064.2 +033100- "******************************". RL1064.2 +033200 01 CCVS-PGM-ID PIC X(9) VALUE RL1064.2 +033300 "RL106A". RL1064.2 +033400 PROCEDURE DIVISION. RL1064.2 +033500 CCVS1 SECTION. RL1064.2 +033600 OPEN-FILES. RL1064.2 +033700 OPEN OUTPUT PRINT-FILE. RL1064.2 +033800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1064.2 +033900 MOVE SPACE TO TEST-RESULTS. RL1064.2 +034000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1064.2 +034100 MOVE ZERO TO REC-SKL-SUB. RL1064.2 +034200 PERFORM CCVS-INIT-FILE 9 TIMES. RL1064.2 +034300 CCVS-INIT-FILE. RL1064.2 +034400 ADD 1 TO REC-SKL-SUB. RL1064.2 +034500 MOVE FILE-RECORD-INFO-SKELETON RL1064.2 +034600 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1064.2 +034700 CCVS-INIT-EXIT. RL1064.2 +034800 GO TO CCVS1-EXIT. RL1064.2 +034900 CLOSE-FILES. RL1064.2 +035000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1064.2 +035100 TERMINATE-CCVS. RL1064.2 +035200*S EXIT PROGRAM. RL1064.2 +035300*SERMINATE-CALL. RL1064.2 +035400 STOP RUN. RL1064.2 +035500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1064.2 +035600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1064.2 +035700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1064.2 +035800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1064.2 +035900 MOVE "****TEST DELETED****" TO RE-MARK. RL1064.2 +036000 PRINT-DETAIL. RL1064.2 +036100 IF REC-CT NOT EQUAL TO ZERO RL1064.2 +036200 MOVE "." TO PARDOT-X RL1064.2 +036300 MOVE REC-CT TO DOTVALUE. RL1064.2 +036400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1064.2 +036500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1064.2 +036600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1064.2 +036700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1064.2 +036800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1064.2 +036900 MOVE SPACE TO CORRECT-X. RL1064.2 +037000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1064.2 +037100 MOVE SPACE TO RE-MARK. RL1064.2 +037200 HEAD-ROUTINE. RL1064.2 +037300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +037400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +037500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1064.2 +037600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1064.2 +037700 COLUMN-NAMES-ROUTINE. RL1064.2 +037800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +037900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +038000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +038100 END-ROUTINE. RL1064.2 +038200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1064.2 +038300 END-RTN-EXIT. RL1064.2 +038400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +038500 END-ROUTINE-1. RL1064.2 +038600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1064.2 +038700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1064.2 +038800 ADD PASS-COUNTER TO ERROR-HOLD. RL1064.2 +038900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1064.2 +039000 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1064.2 +039100 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1064.2 +039200 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1064.2 +039300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1064.2 +039400 END-ROUTINE-12. RL1064.2 +039500 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1064.2 +039600 IF ERROR-COUNTER IS EQUAL TO ZERO RL1064.2 +039700 MOVE "NO " TO ERROR-TOTAL RL1064.2 +039800 ELSE RL1064.2 +039900 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1064.2 +040000 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1064.2 +040100 PERFORM WRITE-LINE. RL1064.2 +040200 END-ROUTINE-13. RL1064.2 +040300 IF DELETE-COUNTER IS EQUAL TO ZERO RL1064.2 +040400 MOVE "NO " TO ERROR-TOTAL ELSE RL1064.2 +040500 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1064.2 +040600 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1064.2 +040700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +040800 IF INSPECT-COUNTER EQUAL TO ZERO RL1064.2 +040900 MOVE "NO " TO ERROR-TOTAL RL1064.2 +041000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1064.2 +041100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1064.2 +041200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +041300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1064.2 +041400 WRITE-LINE. RL1064.2 +041500 ADD 1 TO RECORD-COUNT. RL1064.2 +041600 IF RECORD-COUNT GREATER 50 RL1064.2 +041700 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1064.2 +041800 MOVE SPACE TO DUMMY-RECORD RL1064.2 +041900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1064.2 +042000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1064.2 +042100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1064.2 +042200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1064.2 +042300 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1064.2 +042400 MOVE ZERO TO RECORD-COUNT. RL1064.2 +042500 PERFORM WRT-LN. RL1064.2 +042600 WRT-LN. RL1064.2 +042700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1064.2 +042800 MOVE SPACE TO DUMMY-RECORD. RL1064.2 +042900 BLANK-LINE-PRINT. RL1064.2 +043000 PERFORM WRT-LN. RL1064.2 +043100 FAIL-ROUTINE. RL1064.2 +043200 IF COMPUTED-X NOT EQUAL TO SPACE RL1064.2 +043300 GO TO FAIL-ROUTINE-WRITE. RL1064.2 +043400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1064.2 +043500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1064.2 +043600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1064.2 +043700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +043800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1064.2 +043900 GO TO FAIL-ROUTINE-EX. RL1064.2 +044000 FAIL-ROUTINE-WRITE. RL1064.2 +044100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1064.2 +044200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1064.2 +044300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1064.2 +044400 MOVE SPACES TO COR-ANSI-REFERENCE. RL1064.2 +044500 FAIL-ROUTINE-EX. EXIT. RL1064.2 +044600 BAIL-OUT. RL1064.2 +044700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1064.2 +044800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1064.2 +044900 BAIL-OUT-WRITE. RL1064.2 +045000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1064.2 +045100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1064.2 +045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1064.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1064.2 +045400 BAIL-OUT-EX. EXIT. RL1064.2 +045500 CCVS1-EXIT. RL1064.2 +045600 EXIT. RL1064.2 +045700 SECT-RC106-001 SECTION. RL1064.2 +045800 SECT-RC-02-001-INIT. RL1064.2 +045900 MOVE 1 TO KEY-1 POS-NUM2. RL1064.2 +046000 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +046100 MOVE "R/W REL LENGTH RECS" TO FEATURE. RL1064.2 +046200 REL-TEST-8. RL1064.2 +046300 OPEN OUTPUT RL-FR4. RL1064.2 +046400 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +046500 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +046600 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +046700 ADD 1 TO POS-NUM2. RL1064.2 +046800 MOVE POS-NUM2 TO KEY-1. RL1064.2 +046900 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +047000 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +047100 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +047200 ADD 1 TO POS-NUM2. RL1064.2 +047300 MOVE POS-NUM2 TO KEY-1. RL1064.2 +047400 MOVE "LONG " TO RECORD-LONG-OR-SHORT. RL1064.2 +047500 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +047600 WRITE GRP-1SEQ-RECORD-4B INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +047700 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +047800 ADD 1 TO POS-NUM2. RL1064.2 +047900 MOVE POS-NUM2 TO KEY-1. RL1064.2 +048000 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +048100 WRITE GRP-1SEQ-RECORD-4B INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +048200 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +048300 ADD 1 TO POS-NUM2. RL1064.2 +048400 MOVE POS-NUM2 TO KEY-1. RL1064.2 +048500 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. RL1064.2 +048600 PERFORM WRITE-FOR-TEST-8 THRU 8-EXIT 11 TIMES. RL1064.2 +048700 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +048800 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +048900 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +049000 ADD 1 TO POS-NUM2. RL1064.2 +049100 MOVE POS-NUM2 TO KEY-1. RL1064.2 +049200 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +049300 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +049400 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +049500 ADD 1 TO POS-NUM2. RL1064.2 +049600 MOVE POS-NUM2 TO KEY-1. RL1064.2 +049700 MOVE "LONG " TO RECORD-LONG-OR-SHORT. RL1064.2 +049800 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +049900 WRITE GRP-1SEQ-RECORD-4B INVALID KEY GO TO INVALID-TEST-8. RL1064.2 +050000 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +050100 MOVE SPACE TO CORRECT-A COMPUTED-A. RL1064.2 +050200 MOVE SPACE TO P-OR-F. RL1064.2 +050300 IF READ-WRITE-COUNTER NOT EQUAL TO "WWWWWWWWWWWWWWWWWW " RL1064.2 +050400 MOVE READ-WRITE-COUNTER TO COMPUTED-A ELSE RL1064.2 +050500 MOVE "18 RECORDS PASSED TO TEST-9" TO RE-MARK. RL1064.2 +050600 GO TO REL-TEST-8-WRITE. RL1064.2 +050700 REL-DELETE-8. RL1064.2 +050800 PERFORM DE-LETE. RL1064.2 +050900*NOTE RL-FR4 IS NOT CREATED - SO SKIP TO REL-TEST-11. RL1064.2 +051000 MOVE "REL-TEST-8 " TO PAR-NAME. RL1064.2 +051100 PERFORM PRINT-DETAIL. RL1064.2 +051200 GO TO REL-TEST-11. RL1064.2 +051300 INVALID-TEST-8. RL1064.2 +051400 MOVE "I" TO ENTRY-RW (POS-NUM2). RL1064.2 +051500 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +051600 PERFORM FAIL. RL1064.2 +051700 MOVE "INVALID KEY ON WRITE " TO RE-MARK. RL1064.2 +051800 REL-TEST-8-WRITE. RL1064.2 +051900 MOVE "REL-TEST-8 " TO PAR-NAME. RL1064.2 +052000 PERFORM PRINT-DETAIL. RL1064.2 +052100 CLOSE RL-FR4. RL1064.2 +052200* RL1064.2 +052300 GO TO INIT-TEST-9. RL1064.2 +052400 WRITE-FOR-TEST-8. RL1064.2 +052500 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-4B. RL1064.2 +052600 WRITE GRP-1SEQ-RECORD-4A INVALID KEY GO TO I-KEY-8. RL1064.2 +052700 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +052800 ADD 1 TO POS-NUM2. RL1064.2 +052900 MOVE POS-NUM2 TO KEY-1. RL1064.2 +053000 GO TO 8-EXIT. RL1064.2 +053100 I-KEY-8. RL1064.2 +053200 MOVE "INVALID KEY ON WRITE " TO RE-MARK. RL1064.2 +053300 MOVE "I" TO ENTRY-RW (POS-NUM2). RL1064.2 +053400 ADD 1 TO POS-NUM2. RL1064.2 +053500 MOVE POS-NUM2 TO KEY-1. RL1064.2 +053600 PERFORM FAIL. RL1064.2 +053700 8-EXIT. RL1064.2 +053800 EXIT. RL1064.2 +053900 INIT-TEST-9. RL1064.2 +054000 OPEN INPUT RL-FR4. RL1064.2 +054100 MOVE 01 TO SUB-1 KEY-1. RL1064.2 +054200 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +054300 REL-TEST-9. RL1064.2 +054400 READ RL-FR4 INVALID KEY RL1064.2 +054500 MOVE "E" TO ENTRY-RW (SUB-1) RL1064.2 +054600 GO TO COMPARE-FOR-TEST-9. RL1064.2 +054700 IF SUB-1 EQUAL TO 19 RL1064.2 +054800 GO TO COMPARE-FOR-TEST-9. RL1064.2 +054900 MOVE "R" TO ENTRY-RW (SUB-1). RL1064.2 +055000 ADD 1 TO SUB-1. RL1064.2 +055100 MOVE SUB-1 TO KEY-1. RL1064.2 +055200 GO TO REL-TEST-9. RL1064.2 +055300 COMPARE-FOR-TEST-9. RL1064.2 +055400 IF READ-WRITE-COUNTER EQUAL TO "RRRRRRRRRRRRRRRRRRE " RL1064.2 +055500 PERFORM PASS RL1064.2 +055600 GO TO REL-TEST-9-WRITE. RL1064.2 +055700 MOVE "RRRRRRRRRRRRRRRRRRE " TO CORRECT-A. RL1064.2 +055800 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +055900 PERFORM FAIL. RL1064.2 +056000 MOVE "INCORRECT NUMBER OF READS " TO RE-MARK. RL1064.2 +056100 REL-TEST-9-WRITE. RL1064.2 +056200 MOVE "REL-TEST-9 " TO PAR-NAME. RL1064.2 +056300 PERFORM PRINT-DETAIL. RL1064.2 +056400 CLOSE RL-FR4. RL1064.2 +056500 INIT-TEST-10. RL1064.2 +056600 OPEN INPUT RL-FR4. RL1064.2 +056700 MOVE 10 TO SUB-1 KEY-1. RL1064.2 +056800 REL-TEST-10. RL1064.2 +056900 READ RL-FR4 INVALID KEY RL1064.2 +057000 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +057100 MOVE SPACE TO CORRECT-A RL1064.2 +057200 MOVE "INVAILD KEY RL-FR4 " TO RE-MARK RL1064.2 +057300 PERFORM FAIL RL1064.2 +057400 GO TO REL-TEST-10-WRITE. RL1064.2 +057500* NOTE *** IF REC-NUMBER-4B CONTAINS THE RECORD NUMBER RL1064.2 +057600* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD RL1064.2 +057700* OF VARIABLE LENGTH RECORDS. RL1064.2 +057800* NOTE CHECK LENGTH OF RECORD 10. RL1064.2 +057900 COMPARE-FOR-TEST-10. RL1064.2 +058000 IF REC-NUMBER-4B EQUAL TO "10" RL1064.2 +058100 MOVE "FIXED LENGTH RECORDS" TO COMPUTED-A. RL1064.2 +058200 REL-TEST-10-WRITE. RL1064.2 +058300 CLOSE RL-FR4. RL1064.2 +058400 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. RL1064.2 +058500 MOVE "REL-TEST-10 " TO PAR-NAME. RL1064.2 +058600 PERFORM PRINT-DETAIL. RL1064.2 +058700 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +058800 MOVE 1 TO KEY-2 POS-NUM2. RL1064.2 +058900 REL-TEST-11. RL1064.2 +059000 OPEN OUTPUT RL-FR5. RL1064.2 +059100 PERFORM REL-TEST-11-SHORT-REC 2 TIMES. RL1064.2 +059200 PERFORM REL-TEST-11-LONG-REC 2 TIMES. RL1064.2 +059300 PERFORM REL-TEST-11-SHORT-REC 4 TIMES. RL1064.2 +059400 PERFORM REL-TEST-11-LONG-REC 2 TIMES. RL1064.2 +059500 MOVE SPACE TO COMPUTED-A CORRECT-A. RL1064.2 +059600 MOVE "10 RECORDS PASSED TEST-12" TO RE-MARK. RL1064.2 +059700 GO TO REL-TEST-11-WRITE. RL1064.2 +059800 REL-DELETE-11. RL1064.2 +059900 PERFORM DE-LETE. RL1064.2 +060000* NOTE RL-FR5 IS NOT CREATED SO SKIP TO REL-TEST-15. RL1064.2 +060100 MOVE "REL-TEST-11 " TO PAR-NAME. RL1064.2 +060200 PERFORM PRINT-DETAIL. RL1064.2 +060300 GO TO REL-TEST-15. RL1064.2 +060400 REL-TEST-11-LONG-REC. RL1064.2 +060500 MOVE "LONG " TO RECORD-LONG-OR-SHORT. RL1064.2 +060600 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-5B. RL1064.2 +060700 WRITE GRP-1SEQ-RECORD-5B INVALID KEY GO TO I-KEY-11. RL1064.2 +060800 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +060900 ADD 1 TO POS-NUM2. RL1064.2 +061000 MOVE POS-NUM2 TO KEY-2. RL1064.2 +061100 REL-TEST-11-SHORT-REC. RL1064.2 +061200 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. RL1064.2 +061300 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-5B. RL1064.2 +061400 WRITE GRP-1SEQ-RECORD-5A INVALID KEY GO TO I-KEY-11. RL1064.2 +061500 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +061600 ADD 1 TO POS-NUM2. RL1064.2 +061700 MOVE POS-NUM2 TO KEY-2. RL1064.2 +061800 I-KEY-11. RL1064.2 +061900 MOVE "INVALID KEY ON WRITE " TO RE-MARK. RL1064.2 +062000 PERFORM FAIL. RL1064.2 +062100 MOVE "I" TO ENTRY-RW (POS-NUM2). RL1064.2 +062200 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +062300 REL-TEST-11-WRITE. RL1064.2 +062400 CLOSE RL-FR5. RL1064.2 +062500 MOVE "REL-TEST-11 " TO PAR-NAME. RL1064.2 +062600 PERFORM PRINT-DETAIL. RL1064.2 +062700* RL1064.2 +062800 INIT-TEST-12. RL1064.2 +062900 OPEN INPUT RL-FR5. RL1064.2 +063000 MOVE 01 TO SUB-1 KEY-2. RL1064.2 +063100 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +063200 REL-TEST-12. RL1064.2 +063300 READ RL-FR5 INVALID KEY RL1064.2 +063400 MOVE "E" TO ENTRY-RW (SUB-1) RL1064.2 +063500 GO TO COMPARE-FOR-TEST-12. RL1064.2 +063600 MOVE "R" TO ENTRY-RW (SUB-1). RL1064.2 +063700 IF SUB-1 EQUAL TO 11 RL1064.2 +063800 GO TO COMPARE-FOR-TEST-12. RL1064.2 +063900 ADD 1 TO SUB-1. RL1064.2 +064000* NOTE BLANK OUT GARBAGE IN INPUT AREA. RL1064.2 +064100* MOVE SPACE TO GRP-1SEQ-RECORD-5B. RL1064.2 +064200 MOVE SUB-1 TO KEY-2. RL1064.2 +064300 GO TO REL-TEST-12. RL1064.2 +064400 COMPARE-FOR-TEST-12. RL1064.2 +064500 IF READ-WRITE-COUNTER EQUAL TO "RRRRRRRRRRE" RL1064.2 +064600 PERFORM PASS RL1064.2 +064700 GO TO REL-TEST-12-WRITE. RL1064.2 +064800 MOVE "RRRRRRRRRRE" TO CORRECT-A. RL1064.2 +064900 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +065000 PERFORM FAIL. RL1064.2 +065100 REL-TEST-12-WRITE. RL1064.2 +065200 MOVE "REL-TEST-12 " TO PAR-NAME. RL1064.2 +065300 PERFORM PRINT-DETAIL. RL1064.2 +065400 CLOSE RL-FR5. RL1064.2 +065500 INIT-TEST-13. RL1064.2 +065600 OPEN INPUT RL-FR5. RL1064.2 +065700 MOVE 05 TO SUB-1 KEY-2. RL1064.2 +065800 READ-FOR-TEST-13. RL1064.2 +065900 READ RL-FR5 INVALID KEY RL1064.2 +066000 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +066100 MOVE SPACE TO CORRECT-A RL1064.2 +066200 MOVE "INVALID KEY RL-FR5 " TO RE-MARK RL1064.2 +066300 PERFORM FAIL RL1064.2 +066400 GO TO REL-TEST-13-WRITE. RL1064.2 +066500* NOTE *** IF REC-NUMBER-5B CONTAINS THE RECORD NUMBER RL1064.2 +066600* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD RL1064.2 +066700* OF VARIABLE LENGTH RECORDS. RL1064.2 +066800* NOTE CHECK LENGTH OF RECORD 5. RL1064.2 +066900 REL-TEST-13. RL1064.2 +067000 IF REC-NUMBER-5B EQUAL TO "05" RL1064.2 +067100 MOVE "FIXED LENGTH RECORDS" TO COMPUTED-A. RL1064.2 +067200 REL-TEST-13-WRITE. RL1064.2 +067300 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. RL1064.2 +067400 MOVE "REL-TEST-13 " TO PAR-NAME. RL1064.2 +067500 PERFORM PRINT-DETAIL. RL1064.2 +067600 MOVE 6 TO KEY-2. RL1064.2 +067700 REL-TEST-14. RL1064.2 +067800 READ RL-FR5 INVALID KEY RL1064.2 +067900 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +068000 MOVE SPACE TO CORRECT-A RL1064.2 +068100 MOVE "INVALID KEY ON RECORD 6 " TO RE-MARK RL1064.2 +068200 PERFORM FAIL RL1064.2 +068300 GO TO REL-TEST-14-WRITE. RL1064.2 +068400* NOTE CHECK LENGTH OF RECORD 6. RL1064.2 +068500 IF REC-NUMBER-5B EQUAL TO "06" RL1064.2 +068600 MOVE "FIXED LENGTH RECORDS" TO COMPUTED-A. RL1064.2 +068700 REL-TEST-14-WRITE. RL1064.2 +068800 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. RL1064.2 +068900 MOVE "REL-TEST-14 " TO PAR-NAME. RL1064.2 +069000 PERFORM PRINT-DETAIL. RL1064.2 +069100 MOVE SPACE TO READ-WRITE-COUNTER. RL1064.2 +069200 INIT-TEST-15. RL1064.2 +069300 CLOSE RL-FR5. RL1064.2 +069400 MOVE 1 TO KEY-1 KEY-2 KEY-3 POS-NUM2. RL1064.2 +069500 REL-TEST-15. RL1064.2 +069600 OPEN OUTPUT RL-FR6. RL1064.2 +069700 PERFORM REL-TEST-12-SHORT-REC 3 TIMES. RL1064.2 +069800 PERFORM REL-TEST-12-LONG-REC 2 TIMES. RL1064.2 +069900 PERFORM REL-TEST-12-SHORT-REC. RL1064.2 +070000 PERFORM REL-TEST-12-LONG-REC 2 TIMES. RL1064.2 +070100 PERFORM REL-TEST-12-SHORT-REC 3 TIMES. RL1064.2 +070200 PERFORM REL-TEST-12-LONG-REC. RL1064.2 +070300 MOVE SPACE TO COMPUTED-A CORRECT-A. RL1064.2 +070400 MOVE "12 RECORDS PASSED TEST-16" TO RE-MARK. RL1064.2 +070500 GO TO REL-TEST-15-WRITE. RL1064.2 +070600 REL-DELETE-15. RL1064.2 +070700 PERFORM DE-LETE. RL1064.2 +070800 MOVE "REL-TEST-15 " TO PAR-NAME. RL1064.2 +070900* NOTE THIS IS THE FINAL SERIES OF TESTS, IF THESE ARE RL1064.2 +071000* DELETED, THE PROGRAM IS AT AN END SO, RL1064.2 +071100* SKIP TO END-PARAGRAPH. RL1064.2 +071200 PERFORM PRINT-DETAIL. RL1064.2 +071300 GO TO CCVS-EXIT. RL1064.2 +071400 REL-TEST-12-LONG-REC. RL1064.2 +071500 MOVE "LONG " TO RECORD-LONG-OR-SHORT. RL1064.2 +071600 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-6B. RL1064.2 +071700 WRITE GRP-1SEQ-RECORD-6B INVALID KEY GO TO I-KEY-15. RL1064.2 +071800 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +071900 ADD 1 TO POS-NUM2. RL1064.2 +072000 MOVE POS-NUM2 TO KEY-3. RL1064.2 +072100 REL-TEST-12-SHORT-REC. RL1064.2 +072200 MOVE "SHORT" TO RECORD-LONG-OR-SHORT. RL1064.2 +072300 MOVE RECORD-BUILD TO GRP-1SEQ-RECORD-6B. RL1064.2 +072400 WRITE GRP-1SEQ-RECORD-6A INVALID KEY GO TO I-KEY-15. RL1064.2 +072500 MOVE "W" TO ENTRY-RW (POS-NUM2). RL1064.2 +072600 ADD 1 TO POS-NUM2. RL1064.2 +072700 MOVE POS-NUM2 TO KEY-3. RL1064.2 +072800 I-KEY-15. RL1064.2 +072900 MOVE "INVALID KEY ON WRITE " TO RE-MARK RL1064.2 +073000 PERFORM FAIL. RL1064.2 +073100 MOVE "I" TO ENTRY-RW (POS-NUM2). RL1064.2 +073200 MOVE READ-WRITE-COUNTER TO COMPUTED-A. RL1064.2 +073300 REL-TEST-15-WRITE. RL1064.2 +073400 MOVE "REL-TEST-15 " TO PAR-NAME. RL1064.2 +073500 PERFORM PRINT-DETAIL. RL1064.2 +073600 CLOSE RL-FR6. RL1064.2 +073700* RL1064.2 +073800 INIT-TEST-16. RL1064.2 +073900 OPEN INPUT RL-FR6. RL1064.2 +074000 MOVE 01 TO SUB-1 KEY-3. RL1064.2 +074100 REL-TEST-16. RL1064.2 +074200 READ RL-FR6 INVALID KEY RL1064.2 +074300 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +074400 MOVE SPACE TO CORRECT-A RL1064.2 +074500 MOVE "INVALID KEY ON RANDOM-FILE3" TO RE-MARK RL1064.2 +074600 PERFORM FAIL RL1064.2 +074700 GO TO REL-TEST-16-WRITE. RL1064.2 +074800 IF SUB-1 EQUAL TO 7 RL1064.2 +074900 GO TO COMPARE-FOR-TEST-16. RL1064.2 +075000 ADD 1 TO SUB-1. RL1064.2 +075100 MOVE SUB-1 TO KEY-3. RL1064.2 +075200 GO TO REL-TEST-16. RL1064.2 +075300 COMPARE-FOR-TEST-16. RL1064.2 +075400 IF REC-NUMBER-6B EQUAL TO "07" RL1064.2 +075500 PERFORM PASS RL1064.2 +075600 GO TO REL-TEST-16-WRITE. RL1064.2 +075700 MOVE "RECORD 07 EXPECTED" TO CORRECT-A. RL1064.2 +075800 MOVE SPACE TO FILLER-LONG. RL1064.2 +075900 MOVE RECORD-LONG-ONLY TO COMPUTED-A. RL1064.2 +076000 MOVE "COMPUTED-A SHOWS REC READ" TO RE-MARK. RL1064.2 +076100 PERFORM FAIL. RL1064.2 +076200 REL-TEST-16-WRITE. RL1064.2 +076300 MOVE "REL-TEST-16 " TO PAR-NAME. RL1064.2 +076400 PERFORM PRINT-DETAIL. RL1064.2 +076500 INIT-TEST-17. RL1064.2 +076600 MOVE 01 TO SUB-1 KEY-3. RL1064.2 +076700 READ-FOR-TEST-17. RL1064.2 +076800 READ RL-FR6 INVALID KEY RL1064.2 +076900 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +077000 MOVE SPACE TO CORRECT-A RL1064.2 +077100 MOVE "INVALID KEY RL-FR6 " TO RE-MARK RL1064.2 +077200 PERFORM FAIL RL1064.2 +077300 GO TO REL-TEST-17-WRITE. RL1064.2 +077400 IF SUB-1 EQUAL TO 02 RL1064.2 +077500 GO TO REL-TEST-17. RL1064.2 +077600 ADD 1 TO SUB-1. RL1064.2 +077700 MOVE SUB-1 TO KEY-3. RL1064.2 +077800 GO TO READ-FOR-TEST-17. RL1064.2 +077900 REL-TEST-17. RL1064.2 +078000 IF REC-NUMBER-6B EQUAL TO "02" RL1064.2 +078100 MOVE "FIXED LENGTH RECORDS" TO COMPUTED-A. RL1064.2 +078200 GO TO REL-TEST-17-WRITE. RL1064.2 +078300* NOTE CHECK LENGTH OF RECORD 2. RL1064.2 +078400* NOTE *** IF REC-NUMBER-6B CONTAINS THE RECORD NUMBER RL1064.2 +078500* THEN FIXED LENGTH RECORDS WERE WRITTEN INSTEAD RL1064.2 +078600* OF VARIABLE LENGTH RECORDS. RL1064.2 +078700 REL-TEST-17-WRITE. RL1064.2 +078800 MOVE "INFO ONLY-SEE PROGRAM" TO RE-MARK. RL1064.2 +078900 MOVE "REL-TEST-17 " TO PAR-NAME. RL1064.2 +079000 PERFORM PRINT-DETAIL. RL1064.2 +079100 INIT-TEST-18. RL1064.2 +079200 MOVE 12 TO SUB-1 KEY-3. RL1064.2 +079300 READ-FOR-TEST-18. RL1064.2 +079400 READ RL-FR6 INVALID KEY RL1064.2 +079500 MOVE "***INVALID KEY***" TO COMPUTED-A RL1064.2 +079600 MOVE "RECORD 12 IS MISSING" TO CORRECT-A RL1064.2 +079700 MOVE "ATTEMPT TO READ LAST RECORD" TO RE-MARK RL1064.2 +079800 PERFORM FAIL RL1064.2 +079900 GO TO REL-TEST-18-WRITE. RL1064.2 +080000* NOTE *** RECORD 12 WAS A LONG RECORD AND RL1064.2 +080100* REC-NUMBER-6B SHOULD CONTAIN 12. RL1064.2 +080200 REL-TEST-18. RL1064.2 +080300 IF REC-NUMBER-6B EQUAL TO "12" RL1064.2 +080400 PERFORM PASS RL1064.2 +080500 GO TO REL-TEST-18-WRITE. RL1064.2 +080600 MOVE "WRONG LENGTH RECORD" TO COMPUTED-A. RL1064.2 +080700 PERFORM FAIL. RL1064.2 +080800 REL-TEST-18-WRITE. RL1064.2 +080900 MOVE "REL-TEST-18 " TO PAR-NAME. RL1064.2 +081000 PERFORM PRINT-DETAIL. RL1064.2 +081100 CLOSE RL-FR6. RL1064.2 +081200 CCVS-EXIT SECTION. RL1064.2 +081300 CCVS-999999. RL1064.2 +081400 GO TO CLOSE-FILES. RL1064.2 diff --git a/tests/cobol85/RL/RL107A.CBL b/tests/cobol85/RL/RL107A.CBL new file mode 100644 index 00000000..363bb989 --- /dev/null +++ b/tests/cobol85/RL/RL107A.CBL @@ -0,0 +1,791 @@ +000100 IDENTIFICATION DIVISION. RL1074.2 +000200 PROGRAM-ID. RL1074.2 +000300 RL107A. RL1074.2 +000400**************************************************************** RL1074.2 +000500* * RL1074.2 +000600* VALIDATION FOR:- * RL1074.2 +000700* * RL1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1074.2 +000900* * RL1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1074.2 +001100* * RL1074.2 +001200**************************************************************** RL1074.2 +001300* * RL1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1074.2 +001500* * RL1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1074.2 +001900* * RL1074.2 +002000**************************************************************** RL1074.2 +002100*GENERAL: THIS PROGRAM PROCESSES TWO RELATIVE I-O FILES. THE RL1074.2 +002200* THE FUNCTION OF THIS PROGRAM IS TO CREATE TWO RL1074.2 +002300* RELATIVES FILES RANDOMLY (ACCESS MODE RANDOM) AND RL1074.2 +002400* VERIFY THAT THEY WERE CREATED CORRECTLY. THE FILES RL1074.2 +002500* ARE IDENTIFIED AS "RL-FR7" AND "RL-FR8". THE FILES RL1074.2 +002600* ARE CREATED PARTIALLY (NOT ALL VALUES FOR RELATIVE RL1074.2 +002700* KEY ARE USED) IN THE OUTPUT MODE AND SUBSEQUENTLY RL1074.2 +002800* COMPLETED IN THE I-O MODE. THE END RESULT IS THAT RL1074.2 +002900* THERE ARE NO NULL RECORDS IN ANY OF THE FILES. RL1074.2 +003000* RL1074.2 +003100* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1074.2 +003200* PROGRAM ARE: RL1074.2 +003300* RL1074.2 +003400* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1074.2 +003500* RELATIVE I-O DATA FILE-1 RL1074.2 +003600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1074.2 +003700* RELATIVE I-O DATA FILE-2 RL1074.2 +003800* X-55 SYSTEM PRINTER RL1074.2 +003900* X-69 ADDITIONAL VALUE OF CLAUSES RL1074.2 +004000* X-74 VALUE OF IMPLEMENTOR-NAME RL1074.2 +004100* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE-1 RL1074.2 +004200* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE-2 RL1074.2 +004300* X-82 SOURCE-COMPUTER RL1074.2 +004400* X-83 OBJECT-COMPUTER. RL1074.2 +004500* RL1074.2 +004600**************************************************************** RL1074.2 +004700 ENVIRONMENT DIVISION. RL1074.2 +004800 CONFIGURATION SECTION. RL1074.2 +004900 SOURCE-COMPUTER. RL1074.2 +005000 Linux. RL1074.2 +005100 OBJECT-COMPUTER. RL1074.2 +005200 Linux. RL1074.2 +005300 INPUT-OUTPUT SECTION. RL1074.2 +005400 FILE-CONTROL. RL1074.2 +005500 SELECT PRINT-FILE ASSIGN TO RL1074.2 +005600 "report.log". RL1074.2 +005700 SELECT RL-FR7 ASSIGN TO RL1074.2 +005800 "XXXXX021" RL1074.2 +005900 ORGANIZATION IS RELATIVE RL1074.2 +006000 ACCESS MODE IS RANDOM RL1074.2 +006100 RELATIVE KEY ACTUAL-KEY-1. RL1074.2 +006200 SELECT RL-FR8 ASSIGN TO RL1074.2 +006300 "XXXXX022" RL1074.2 +006400 ORGANIZATION IS RELATIVE RL1074.2 +006500 ACCESS MODE IS RANDOM RL1074.2 +006600 RELATIVE KEY IS ACTUAL-KEY-2. RL1074.2 +006700 DATA DIVISION. RL1074.2 +006800 FILE SECTION. RL1074.2 +006900 FD PRINT-FILE. RL1074.2 +007000 01 PRINT-REC PICTURE X(120). RL1074.2 +007100 01 DUMMY-RECORD PICTURE X(120). RL1074.2 +007200 FD RL-FR7 RL1074.2 +007300 LABEL RECORDS ARE STANDARD RL1074.2 +007400*C VALUE OF RL1074.2 +007500*C OCLABELID RL1074.2 +007600*C IS RL1074.2 +007700*C "OCDUMMY" RL1074.2 +007800*G SYSIN RL1074.2 +007900 DATA RECORD IS RAC-REC-1. RL1074.2 +008000 01 RAC-REC-1. RL1074.2 +008100 03 FILLER PICTURE IS X(24). RL1074.2 +008200 03 RECORD-NO-1 PICTURE IS 9999. RL1074.2 +008300 03 FILLER PICTURE IS XXXX. RL1074.2 +008400 03 UPDATE-FIELD PICTURE IS X(7). RL1074.2 +008500 03 FILLER PICTURE IS X(81). RL1074.2 +008600 FD RL-FR8 RL1074.2 +008700 LABEL RECORDS ARE STANDARD RL1074.2 +008800*C VALUE OF RL1074.2 +008900*C OCLABELID RL1074.2 +009000*C IS RL1074.2 +009100*C "OCDUMMY" RL1074.2 +009200*G SYSIN RL1074.2 +009300 DATA RECORDS ARE RAC-REC-2 RAC-REC-3. RL1074.2 +009400 01 RAC-REC-2. RL1074.2 +009500 03 FILLER PICTURE IS X(24). RL1074.2 +009600 03 RECORD-NO-2 PICTURE IS 9999. RL1074.2 +009700 03 FILLER PICTURE IS X(92). RL1074.2 +009800 01 RAC-REC-3. RL1074.2 +009900 03 FILLER PICTURE IS X(24). RL1074.2 +010000 03 RECORD-NO-3 PICTURE IS 9999. RL1074.2 +010100 03 FILLER PICTURE IS X(92). RL1074.2 +010200 WORKING-STORAGE SECTION. RL1074.2 +010300 01 RECORD-SKELTON. RL1074.2 +010400 03 FILLER PICTURE IS X(24) VALUE " THIS IS RECORD NUMBER ".RL1074.2 +010500 03 RECORD-NUMXXX PICTURE IS 9999 VALUE IS ZERO. RL1074.2 +010600 03 FILLER PICTURE IS X(92) VALUE SPACE. RL1074.2 +010700 01 ACTUAL-KEY-1 RL1074.2 +010800 PICTURE 9(5). RL1074.2 +010900 01 ACTUAL-KEY-2 RL1074.2 +011000 PICTURE 9(5). RL1074.2 +011100 01 FILE-RECORD-INFORMATION-REC. RL1074.2 +011200 03 FILE-RECORD-INFO-SKELETON. RL1074.2 +011300 05 FILLER PICTURE X(48) VALUE RL1074.2 +011400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1074.2 +011500 05 FILLER PICTURE X(46) VALUE RL1074.2 +011600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1074.2 +011700 05 FILLER PICTURE X(26) VALUE RL1074.2 +011800 ",LFIL=000000,ORG= ,LBLR= ". RL1074.2 +011900 05 FILLER PICTURE X(37) VALUE RL1074.2 +012000 ",RECKEY= ". RL1074.2 +012100 05 FILLER PICTURE X(38) VALUE RL1074.2 +012200 ",ALTKEY1= ". RL1074.2 +012300 05 FILLER PICTURE X(38) VALUE RL1074.2 +012400 ",ALTKEY2= ". RL1074.2 +012500 05 FILLER PICTURE X(7) VALUE SPACE.RL1074.2 +012600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1074.2 +012700 05 FILE-RECORD-INFO-P1-120. RL1074.2 +012800 07 FILLER PIC X(5). RL1074.2 +012900 07 XFILE-NAME PIC X(6). RL1074.2 +013000 07 FILLER PIC X(8). RL1074.2 +013100 07 XRECORD-NAME PIC X(6). RL1074.2 +013200 07 FILLER PIC X(1). RL1074.2 +013300 07 REELUNIT-NUMBER PIC 9(1). RL1074.2 +013400 07 FILLER PIC X(7). RL1074.2 +013500 07 XRECORD-NUMBER PIC 9(6). RL1074.2 +013600 07 FILLER PIC X(6). RL1074.2 +013700 07 UPDATE-NUMBER PIC 9(2). RL1074.2 +013800 07 FILLER PIC X(5). RL1074.2 +013900 07 ODO-NUMBER PIC 9(4). RL1074.2 +014000 07 FILLER PIC X(5). RL1074.2 +014100 07 XPROGRAM-NAME PIC X(5). RL1074.2 +014200 07 FILLER PIC X(7). RL1074.2 +014300 07 XRECORD-LENGTH PIC 9(6). RL1074.2 +014400 07 FILLER PIC X(7). RL1074.2 +014500 07 CHARS-OR-RECORDS PIC X(2). RL1074.2 +014600 07 FILLER PIC X(1). RL1074.2 +014700 07 XBLOCK-SIZE PIC 9(4). RL1074.2 +014800 07 FILLER PIC X(6). RL1074.2 +014900 07 RECORDS-IN-FILE PIC 9(6). RL1074.2 +015000 07 FILLER PIC X(5). RL1074.2 +015100 07 XFILE-ORGANIZATION PIC X(2). RL1074.2 +015200 07 FILLER PIC X(6). RL1074.2 +015300 07 XLABEL-TYPE PIC X(1). RL1074.2 +015400 05 FILE-RECORD-INFO-P121-240. RL1074.2 +015500 07 FILLER PIC X(8). RL1074.2 +015600 07 XRECORD-KEY PIC X(29). RL1074.2 +015700 07 FILLER PIC X(9). RL1074.2 +015800 07 ALTERNATE-KEY1 PIC X(29). RL1074.2 +015900 07 FILLER PIC X(9). RL1074.2 +016000 07 ALTERNATE-KEY2 PIC X(29). RL1074.2 +016100 07 FILLER PIC X(7). RL1074.2 +016200 01 TEST-RESULTS. RL1074.2 +016300 02 FILLER PIC X VALUE SPACE. RL1074.2 +016400 02 FEATURE PIC X(20) VALUE SPACE. RL1074.2 +016500 02 FILLER PIC X VALUE SPACE. RL1074.2 +016600 02 P-OR-F PIC X(5) VALUE SPACE. RL1074.2 +016700 02 FILLER PIC X VALUE SPACE. RL1074.2 +016800 02 PAR-NAME. RL1074.2 +016900 03 FILLER PIC X(19) VALUE SPACE. RL1074.2 +017000 03 PARDOT-X PIC X VALUE SPACE. RL1074.2 +017100 03 DOTVALUE PIC 99 VALUE ZERO. RL1074.2 +017200 02 FILLER PIC X(8) VALUE SPACE. RL1074.2 +017300 02 RE-MARK PIC X(61). RL1074.2 +017400 01 TEST-COMPUTED. RL1074.2 +017500 02 FILLER PIC X(30) VALUE SPACE. RL1074.2 +017600 02 FILLER PIC X(17) VALUE RL1074.2 +017700 " COMPUTED=". RL1074.2 +017800 02 COMPUTED-X. RL1074.2 +017900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1074.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A RL1074.2 +018100 PIC -9(9).9(9). RL1074.2 +018200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1074.2 +018300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1074.2 +018400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1074.2 +018500 03 CM-18V0 REDEFINES COMPUTED-A. RL1074.2 +018600 04 COMPUTED-18V0 PIC -9(18). RL1074.2 +018700 04 FILLER PIC X. RL1074.2 +018800 03 FILLER PIC X(50) VALUE SPACE. RL1074.2 +018900 01 TEST-CORRECT. RL1074.2 +019000 02 FILLER PIC X(30) VALUE SPACE. RL1074.2 +019100 02 FILLER PIC X(17) VALUE " CORRECT =". RL1074.2 +019200 02 CORRECT-X. RL1074.2 +019300 03 CORRECT-A PIC X(20) VALUE SPACE. RL1074.2 +019400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1074.2 +019500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1074.2 +019600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1074.2 +019700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1074.2 +019800 03 CR-18V0 REDEFINES CORRECT-A. RL1074.2 +019900 04 CORRECT-18V0 PIC -9(18). RL1074.2 +020000 04 FILLER PIC X. RL1074.2 +020100 03 FILLER PIC X(2) VALUE SPACE. RL1074.2 +020200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1074.2 +020300 01 CCVS-C-1. RL1074.2 +020400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1074.2 +020500- "SS PARAGRAPH-NAME RL1074.2 +020600- " REMARKS". RL1074.2 +020700 02 FILLER PIC X(20) VALUE SPACE. RL1074.2 +020800 01 CCVS-C-2. RL1074.2 +020900 02 FILLER PIC X VALUE SPACE. RL1074.2 +021000 02 FILLER PIC X(6) VALUE "TESTED". RL1074.2 +021100 02 FILLER PIC X(15) VALUE SPACE. RL1074.2 +021200 02 FILLER PIC X(4) VALUE "FAIL". RL1074.2 +021300 02 FILLER PIC X(94) VALUE SPACE. RL1074.2 +021400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1074.2 +021500 01 REC-CT PIC 99 VALUE ZERO. RL1074.2 +021600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1074.2 +021700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1074.2 +021800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1074.2 +021900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1074.2 +022000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1074.2 +022100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1074.2 +022200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1074.2 +022300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1074.2 +022400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1074.2 +022500 01 CCVS-H-1. RL1074.2 +022600 02 FILLER PIC X(39) VALUE SPACES. RL1074.2 +022700 02 FILLER PIC X(42) VALUE RL1074.2 +022800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1074.2 +022900 02 FILLER PIC X(39) VALUE SPACES. RL1074.2 +023000 01 CCVS-H-2A. RL1074.2 +023100 02 FILLER PIC X(40) VALUE SPACE. RL1074.2 +023200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1074.2 +023300 02 FILLER PIC XXXX VALUE RL1074.2 +023400 "4.2 ". RL1074.2 +023500 02 FILLER PIC X(28) VALUE RL1074.2 +023600 " COPY - NOT FOR DISTRIBUTION". RL1074.2 +023700 02 FILLER PIC X(41) VALUE SPACE. RL1074.2 +023800 RL1074.2 +023900 01 CCVS-H-2B. RL1074.2 +024000 02 FILLER PIC X(15) VALUE RL1074.2 +024100 "TEST RESULT OF ". RL1074.2 +024200 02 TEST-ID PIC X(9). RL1074.2 +024300 02 FILLER PIC X(4) VALUE RL1074.2 +024400 " IN ". RL1074.2 +024500 02 FILLER PIC X(12) VALUE RL1074.2 +024600 " HIGH ". RL1074.2 +024700 02 FILLER PIC X(22) VALUE RL1074.2 +024800 " LEVEL VALIDATION FOR ". RL1074.2 +024900 02 FILLER PIC X(58) VALUE RL1074.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1074.2 +025100 01 CCVS-H-3. RL1074.2 +025200 02 FILLER PIC X(34) VALUE RL1074.2 +025300 " FOR OFFICIAL USE ONLY ". RL1074.2 +025400 02 FILLER PIC X(58) VALUE RL1074.2 +025500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1074.2 +025600 02 FILLER PIC X(28) VALUE RL1074.2 +025700 " COPYRIGHT 1985 ". RL1074.2 +025800 01 CCVS-E-1. RL1074.2 +025900 02 FILLER PIC X(52) VALUE SPACE. RL1074.2 +026000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1074.2 +026100 02 ID-AGAIN PIC X(9). RL1074.2 +026200 02 FILLER PIC X(45) VALUE SPACES. RL1074.2 +026300 01 CCVS-E-2. RL1074.2 +026400 02 FILLER PIC X(31) VALUE SPACE. RL1074.2 +026500 02 FILLER PIC X(21) VALUE SPACE. RL1074.2 +026600 02 CCVS-E-2-2. RL1074.2 +026700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1074.2 +026800 03 FILLER PIC X VALUE SPACE. RL1074.2 +026900 03 ENDER-DESC PIC X(44) VALUE RL1074.2 +027000 "ERRORS ENCOUNTERED". RL1074.2 +027100 01 CCVS-E-3. RL1074.2 +027200 02 FILLER PIC X(22) VALUE RL1074.2 +027300 " FOR OFFICIAL USE ONLY". RL1074.2 +027400 02 FILLER PIC X(12) VALUE SPACE. RL1074.2 +027500 02 FILLER PIC X(58) VALUE RL1074.2 +027600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1074.2 +027700 02 FILLER PIC X(13) VALUE SPACE. RL1074.2 +027800 02 FILLER PIC X(15) VALUE RL1074.2 +027900 " COPYRIGHT 1985". RL1074.2 +028000 01 CCVS-E-4. RL1074.2 +028100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1074.2 +028200 02 FILLER PIC X(4) VALUE " OF ". RL1074.2 +028300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1074.2 +028400 02 FILLER PIC X(40) VALUE RL1074.2 +028500 " TESTS WERE EXECUTED SUCCESSFULLY". RL1074.2 +028600 01 XXINFO. RL1074.2 +028700 02 FILLER PIC X(19) VALUE RL1074.2 +028800 "*** INFORMATION ***". RL1074.2 +028900 02 INFO-TEXT. RL1074.2 +029000 04 FILLER PIC X(8) VALUE SPACE. RL1074.2 +029100 04 XXCOMPUTED PIC X(20). RL1074.2 +029200 04 FILLER PIC X(5) VALUE SPACE. RL1074.2 +029300 04 XXCORRECT PIC X(20). RL1074.2 +029400 02 INF-ANSI-REFERENCE PIC X(48). RL1074.2 +029500 01 HYPHEN-LINE. RL1074.2 +029600 02 FILLER PIC IS X VALUE IS SPACE. RL1074.2 +029700 02 FILLER PIC IS X(65) VALUE IS "************************RL1074.2 +029800- "*****************************************". RL1074.2 +029900 02 FILLER PIC IS X(54) VALUE IS "************************RL1074.2 +030000- "******************************". RL1074.2 +030100 01 CCVS-PGM-ID PIC X(9) VALUE RL1074.2 +030200 "RL107A". RL1074.2 +030300 PROCEDURE DIVISION. RL1074.2 +030400 CCVS1 SECTION. RL1074.2 +030500 OPEN-FILES. RL1074.2 +030600 OPEN OUTPUT PRINT-FILE. RL1074.2 +030700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1074.2 +030800 MOVE SPACE TO TEST-RESULTS. RL1074.2 +030900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1074.2 +031000 MOVE ZERO TO REC-SKL-SUB. RL1074.2 +031100 PERFORM CCVS-INIT-FILE 9 TIMES. RL1074.2 +031200 CCVS-INIT-FILE. RL1074.2 +031300 ADD 1 TO REC-SKL-SUB. RL1074.2 +031400 MOVE FILE-RECORD-INFO-SKELETON RL1074.2 +031500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1074.2 +031600 CCVS-INIT-EXIT. RL1074.2 +031700 GO TO CCVS1-EXIT. RL1074.2 +031800 CLOSE-FILES. RL1074.2 +031900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1074.2 +032000 TERMINATE-CCVS. RL1074.2 +032100*S EXIT PROGRAM. RL1074.2 +032200*SERMINATE-CALL. RL1074.2 +032300 STOP RUN. RL1074.2 +032400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1074.2 +032500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1074.2 +032600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1074.2 +032700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1074.2 +032800 MOVE "****TEST DELETED****" TO RE-MARK. RL1074.2 +032900 PRINT-DETAIL. RL1074.2 +033000 IF REC-CT NOT EQUAL TO ZERO RL1074.2 +033100 MOVE "." TO PARDOT-X RL1074.2 +033200 MOVE REC-CT TO DOTVALUE. RL1074.2 +033300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1074.2 +033400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1074.2 +033500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1074.2 +033600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1074.2 +033700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1074.2 +033800 MOVE SPACE TO CORRECT-X. RL1074.2 +033900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1074.2 +034000 MOVE SPACE TO RE-MARK. RL1074.2 +034100 HEAD-ROUTINE. RL1074.2 +034200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +034300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +034400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1074.2 +034500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1074.2 +034600 COLUMN-NAMES-ROUTINE. RL1074.2 +034700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +034800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +035000 END-ROUTINE. RL1074.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1074.2 +035200 END-RTN-EXIT. RL1074.2 +035300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +035400 END-ROUTINE-1. RL1074.2 +035500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1074.2 +035600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1074.2 +035700 ADD PASS-COUNTER TO ERROR-HOLD. RL1074.2 +035800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1074.2 +035900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1074.2 +036000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1074.2 +036100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1074.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1074.2 +036300 END-ROUTINE-12. RL1074.2 +036400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1074.2 +036500 IF ERROR-COUNTER IS EQUAL TO ZERO RL1074.2 +036600 MOVE "NO " TO ERROR-TOTAL RL1074.2 +036700 ELSE RL1074.2 +036800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1074.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1074.2 +037000 PERFORM WRITE-LINE. RL1074.2 +037100 END-ROUTINE-13. RL1074.2 +037200 IF DELETE-COUNTER IS EQUAL TO ZERO RL1074.2 +037300 MOVE "NO " TO ERROR-TOTAL ELSE RL1074.2 +037400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1074.2 +037500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1074.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO RL1074.2 +037800 MOVE "NO " TO ERROR-TOTAL RL1074.2 +037900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1074.2 +038000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1074.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +038200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1074.2 +038300 WRITE-LINE. RL1074.2 +038400 ADD 1 TO RECORD-COUNT. RL1074.2 +038500 IF RECORD-COUNT GREATER 50 RL1074.2 +038600 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1074.2 +038700 MOVE SPACE TO DUMMY-RECORD RL1074.2 +038800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1074.2 +038900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1074.2 +039000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1074.2 +039100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1074.2 +039200 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1074.2 +039300 MOVE ZERO TO RECORD-COUNT. RL1074.2 +039400 PERFORM WRT-LN. RL1074.2 +039500 WRT-LN. RL1074.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1074.2 +039700 MOVE SPACE TO DUMMY-RECORD. RL1074.2 +039800 BLANK-LINE-PRINT. RL1074.2 +039900 PERFORM WRT-LN. RL1074.2 +040000 FAIL-ROUTINE. RL1074.2 +040100 IF COMPUTED-X NOT EQUAL TO SPACE RL1074.2 +040200 GO TO FAIL-ROUTINE-WRITE. RL1074.2 +040300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1074.2 +040400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1074.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1074.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +040700 MOVE SPACES TO INF-ANSI-REFERENCE. RL1074.2 +040800 GO TO FAIL-ROUTINE-EX. RL1074.2 +040900 FAIL-ROUTINE-WRITE. RL1074.2 +041000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1074.2 +041100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1074.2 +041200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1074.2 +041300 MOVE SPACES TO COR-ANSI-REFERENCE. RL1074.2 +041400 FAIL-ROUTINE-EX. EXIT. RL1074.2 +041500 BAIL-OUT. RL1074.2 +041600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1074.2 +041700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1074.2 +041800 BAIL-OUT-WRITE. RL1074.2 +041900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1074.2 +042000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1074.2 +042100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1074.2 +042200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1074.2 +042300 BAIL-OUT-EX. EXIT. RL1074.2 +042400 CCVS1-EXIT. RL1074.2 +042500 EXIT. RL1074.2 +042600 SECT-RL107-001 SECTION. RL1074.2 +042700 TEST-1. RL1074.2 +042800 MOVE "OPEN OUTPUT RL-FR7" TO FEATURE. RL1074.2 +042900 MOVE "REL-TEST-001" TO PAR-NAME. RL1074.2 +043000 PERFORM PRINT-DETAIL. RL1074.2 +043100 OPEN OUTPUT RL-FR7. RL1074.2 +043200 TEST-2. RL1074.2 +043300 MOVE "OPEN OUTPUT RL-FR8" TO FEATURE. RL1074.2 +043400 MOVE "REL-TEST-002" TO PAR-NAME. RL1074.2 +043500 PERFORM PRINT-DETAIL. RL1074.2 +043600 OPEN OUTPUT RL-FR8. RL1074.2 +043700 TEST-3-INIT. RL1074.2 +043800 MOVE "WRITE RL-FR7" TO FEATURE. RL1074.2 +043900 MOVE "REL-TEST-003" TO PAR-NAME. RL1074.2 +044000 MOVE 0 TO ACTUAL-KEY-1. RL1074.2 +044100 MOVE ZERO TO RECORD-NUMXXX. RL1074.2 +044200 TEST-3. RL1074.2 +044300 ADD 1 TO RECORD-NUMXXX. RL1074.2 +044400 ADD 1 TO ACTUAL-KEY-1. RL1074.2 +044500 IF RECORD-NUMXXX IS GREATER THAN 25 GO TO TEST-3-EXIT. RL1074.2 +044600 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +044700 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +044800 GO TO TEST-3. RL1074.2 +044900 TEST-3-EXIT. RL1074.2 +045000 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +045100 PERFORM PRINT-DETAIL. RL1074.2 +045200 TEST-4-INIT. RL1074.2 +045300 MOVE "REL-TEST-004" TO PAR-NAME. RL1074.2 +045400 MOVE ZERO TO REC-CT. RL1074.2 +045500 MOVE 51 TO RECORD-NUMXXX. RL1074.2 +045600 MOVE 51 TO ACTUAL-KEY-1. RL1074.2 +045700 TEST-4. RL1074.2 +045800 SUBTRACT 1 FROM RECORD-NUMXXX. RL1074.2 +045900 SUBTRACT 1 FROM ACTUAL-KEY-1. RL1074.2 +046000 IF RECORD-NUMXXX IS LESS THAN 26 GO TO TEST-4-EXIT. RL1074.2 +046100 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +046200 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +046300 GO TO TEST-4. RL1074.2 +046400 TEST-4-EXIT. RL1074.2 +046500 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +046600 PERFORM PRINT-DETAIL. RL1074.2 +046700 TEST-5-INIT. RL1074.2 +046800 MOVE "REL-TEST-005" TO PAR-NAME. RL1074.2 +046900 MOVE ZERO TO REC-CT. RL1074.2 +047000 MOVE 48 TO ACTUAL-KEY-1. RL1074.2 +047100 MOVE 48 TO RECORD-NUMXXX. RL1074.2 +047200 TEST-5. RL1074.2 +047300 ADD 3 TO RECORD-NUMXXX. RL1074.2 +047400 ADD 3 TO ACTUAL-KEY-1. RL1074.2 +047500 IF RECORD-NUMXXX IS GREATER THAN 125 GO TO TEST-5-EXIT. RL1074.2 +047600 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +047700 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +047800 GO TO TEST-5. RL1074.2 +047900 TEST-5-EXIT. RL1074.2 +048000 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +048100 PERFORM PRINT-DETAIL. RL1074.2 +048200 TEST-6-INIT. RL1074.2 +048300 MOVE "REL-TEST-006" TO PAR-NAME. RL1074.2 +048400 MOVE ZERO TO REC-CT. RL1074.2 +048500 MOVE 49 TO ACTUAL-KEY-1. RL1074.2 +048600 MOVE 49 TO RECORD-NUMXXX. RL1074.2 +048700 TEST-6. RL1074.2 +048800 ADD 3 TO RECORD-NUMXXX. RL1074.2 +048900 ADD 3 TO ACTUAL-KEY-1. RL1074.2 +049000 IF RECORD-NUMXXX IS GREATER THAN 125 GO TO TEST-6-EXIT. RL1074.2 +049100 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +049200 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +049300 GO TO TEST-6. RL1074.2 +049400 TEST-6-EXIT. RL1074.2 +049500 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +049600 PERFORM PRINT-DETAIL. RL1074.2 +049700 TEST-7-INIT. RL1074.2 +049800 MOVE "REL-TEST-007" TO PAR-NAME. RL1074.2 +049900 MOVE ZERO TO REC-CT. RL1074.2 +050000 MOVE 128 TO ACTUAL-KEY-1. RL1074.2 +050100 MOVE 128 TO RECORD-NUMXXX. RL1074.2 +050200 TEST-7. RL1074.2 +050300 SUBTRACT 3 FROM RECORD-NUMXXX. RL1074.2 +050400 SUBTRACT 3 FROM ACTUAL-KEY-1. RL1074.2 +050500 IF RECORD-NUMXXX IS LESS THAN 53 GO TO TEST-7-EXIT. RL1074.2 +050600 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +050700 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +050800 GO TO TEST-7. RL1074.2 +050900 TEST-7-EXIT. RL1074.2 +051000 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +051100 PERFORM PRINT-DETAIL. RL1074.2 +051200 TEST-8-INIT. RL1074.2 +051300 MOVE "WRITE RL-FR8" TO FEATURE. RL1074.2 +051400 MOVE "REL-TEST-008" TO PAR-NAME. RL1074.2 +051500 MOVE ZERO TO REC-CT. RL1074.2 +051600 MOVE 0 TO ACTUAL-KEY-2. RL1074.2 +051700 MOVE 0 TO RECORD-NUMXXX. RL1074.2 +051800 TEST-8. RL1074.2 +051900 ADD 1 TO RECORD-NUMXXX. RL1074.2 +052000 ADD 1 TO ACTUAL-KEY-2. RL1074.2 +052100 IF RECORD-NUMXXX IS GREATER THAN 25 GO TO TEST-8-EXIT. RL1074.2 +052200 MOVE RECORD-SKELTON TO RAC-REC-2. RL1074.2 +052300 WRITE RAC-REC-2 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +052400 GO TO TEST-8. RL1074.2 +052500 TEST-8-EXIT. RL1074.2 +052600 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +052700 PERFORM PRINT-DETAIL. RL1074.2 +052800 TEST-9. RL1074.2 +052900 MOVE "CLOSE RL-FR7" TO FEATURE. RL1074.2 +053000 MOVE "REL-TEST-009" TO PAR-NAME. RL1074.2 +053100 MOVE ZERO TO REC-CT. RL1074.2 +053200 PERFORM PRINT-DETAIL. RL1074.2 +053300 CLOSE RL-FR7. RL1074.2 +053400 TEST-10. RL1074.2 +053500 MOVE "CLOSE RL-FR8" TO FEATURE. RL1074.2 +053600 MOVE "REL-TEST-010" TO PAR-NAME. RL1074.2 +053700 PERFORM PRINT-DETAIL. RL1074.2 +053800 CLOSE RL-FR8. RL1074.2 +053900 TEST-11. RL1074.2 +054000 MOVE "OPEN INPUT RL-FR8" TO FEATURE. RL1074.2 +054100 MOVE "REL-TEST-011" TO PAR-NAME. RL1074.2 +054200 PERFORM PRINT-DETAIL. RL1074.2 +054300 OPEN INPUT RL-FR8. RL1074.2 +054400 TEST-12. RL1074.2 +054500 MOVE "OPEN I-O RL-FR7" TO FEATURE. RL1074.2 +054600 MOVE "REL-TEST-012" TO PAR-NAME. RL1074.2 +054700 PERFORM PRINT-DETAIL. RL1074.2 +054800 OPEN I-O RL-FR7. RL1074.2 +054900 TEST-13-INIT. RL1074.2 +055000 MOVE "READ RL-FR7" TO FEATURE. RL1074.2 +055100 MOVE "REL-TEST-013" TO PAR-NAME. RL1074.2 +055200 MOVE 9 TO ACTUAL-KEY-1. RL1074.2 +055300 MOVE 9 TO RECORD-NUMXXX. RL1074.2 +055400 TEST-13. RL1074.2 +055500 ADD 1 TO ACTUAL-KEY-1. RL1074.2 +055600 ADD 1 TO RECORD-NUMXXX. RL1074.2 +055700 IF RECORD-NUMXXX IS GREATER THAN 20 GO TO TEST-13-EXIT. RL1074.2 +055800 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +055900 GO TO TEST-13. RL1074.2 +056000 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +056100 PERFORM ERROR-WRONG-RECORD. RL1074.2 +056200 GO TO TEST-13. RL1074.2 +056300 TEST-13-EXIT. RL1074.2 +056400 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +056500 PERFORM PRINT-DETAIL. RL1074.2 +056600 TEST-14-INIT. RL1074.2 +056700 MOVE "READ RL-FR8" TO FEATURE. RL1074.2 +056800 MOVE "REL-TEST-014" TO PAR-NAME. RL1074.2 +056900 MOVE ZERO TO REC-CT. RL1074.2 +057000 MOVE 0 TO ACTUAL-KEY-2. RL1074.2 +057100 MOVE 0 TO RECORD-NUMXXX. RL1074.2 +057200 TEST-14. RL1074.2 +057300 ADD 3 TO ACTUAL-KEY-2. RL1074.2 +057400 ADD 3 TO RECORD-NUMXXX. RL1074.2 +057500 IF RECORD-NUMXXX IS GREATER THAN 25 GO TO TEST-14-EXIT. RL1074.2 +057600 READ RL-FR8 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +057700 GO TO TEST-14. RL1074.2 +057800 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-2 RL1074.2 +057900 MOVE RECORD-NO-2 TO RECORD-NO-1 RL1074.2 +058000 PERFORM ERROR-WRONG-RECORD. RL1074.2 +058100 GO TO TEST-14. RL1074.2 +058200 TEST-14-EXIT. RL1074.2 +058300 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +058400 PERFORM PRINT-DETAIL. RL1074.2 +058500 TEST-15-INIT. RL1074.2 +058600 MOVE "READ RL-FR7" TO FEATURE. RL1074.2 +058700 MOVE "REL-TEST-015" TO PAR-NAME. RL1074.2 +058800 MOVE ZERO TO REC-CT. RL1074.2 +058900 MOVE 14 TO ACTUAL-KEY-1. RL1074.2 +059000 MOVE 14 TO RECORD-NUMXXX. RL1074.2 +059100 TEST-15. RL1074.2 +059200 ADD 14 TO ACTUAL-KEY-1. RL1074.2 +059300 ADD 14 TO RECORD-NUMXXX. RL1074.2 +059400 IF RECORD-NUMXXX IS GREATER THAN 125 GO TO TEST-15-EXIT. RL1074.2 +059500 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +059600 GO TO TEST-14. RL1074.2 +059700 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +059800 PERFORM ERROR-WRONG-RECORD. RL1074.2 +059900 GO TO TEST-15. RL1074.2 +060000 TEST-15-EXIT. RL1074.2 +060100 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +060200 PERFORM PRINT-DETAIL. RL1074.2 +060300 TEST-16-INIT. RL1074.2 +060400 MOVE "REL-TEST-016" TO PAR-NAME. RL1074.2 +060500 MOVE ZERO TO REC-CT. RL1074.2 +060600 MOVE 11 TO ACTUAL-KEY-1. RL1074.2 +060700 MOVE 11 TO RECORD-NUMXXX. RL1074.2 +060800 TEST-16. RL1074.2 +060900 ADD 17 TO ACTUAL-KEY-1. RL1074.2 +061000 ADD 17 TO RECORD-NUMXXX. RL1074.2 +061100 IF RECORD-NUMXXX IS GREATER THAN 125 GO TO TEST-16-EXIT. RL1074.2 +061200 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +061300 GO TO TEST-16. RL1074.2 +061400 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +061500 PERFORM ERROR-WRONG-RECORD. RL1074.2 +061600 GO TO TEST-16. RL1074.2 +061700 TEST-16-EXIT. RL1074.2 +061800 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +061900 PERFORM PRINT-DETAIL. RL1074.2 +062000 TEST-17-INIT. RL1074.2 +062100 MOVE "WRITE RL-FR7" TO FEATURE. RL1074.2 +062200 MOVE "REL-TEST-017" TO PAR-NAME. RL1074.2 +062300 MOVE ZERO TO REC-CT. RL1074.2 +062400 MOVE 125 TO ACTUAL-KEY-1. RL1074.2 +062500 MOVE 125 TO RECORD-NUMXXX. RL1074.2 +062600 TEST-17. RL1074.2 +062700 ADD 5 TO ACTUAL-KEY-1. RL1074.2 +062800 ADD 5 TO RECORD-NUMXXX. RL1074.2 +062900 IF RECORD-NUMXXX IS GREATER THAN 200 GO TO TEST-17-EXIT. RL1074.2 +063000 MOVE RECORD-SKELTON TO RAC-REC-1. RL1074.2 +063100 WRITE RAC-REC-1 INVALID KEY PERFORM ERROR-INVALID-KEY. RL1074.2 +063200 GO TO TEST-17. RL1074.2 +063300 TEST-17-EXIT. RL1074.2 +063400 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +063500 PERFORM PRINT-DETAIL. RL1074.2 +063600 TEST-18. RL1074.2 +063700 MOVE "READ RL-FR7" TO FEATURE. RL1074.2 +063800 MOVE "REL-TEST-018" TO PAR-NAME. RL1074.2 +063900 MOVE ZERO TO REC-CT. RL1074.2 +064000 MOVE 121 TO ACTUAL-KEY-1. RL1074.2 +064100 MOVE 121 TO RECORD-NUMXXX. RL1074.2 +064200 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +064300 GO TO TEST-19. RL1074.2 +064400 IF RECORD-NO-1 IS NOT EQUAL TO RECORD-NUMXXX RL1074.2 +064500 PERFORM ERROR-WRONG-RECORD RL1074.2 +064600 GO TO TEST-19. RL1074.2 +064700 PERFORM PASS. RL1074.2 +064800 PERFORM PRINT-DETAIL. RL1074.2 +064900 TEST-19. RL1074.2 +065000 MOVE "REL-TEST-019" TO PAR-NAME. RL1074.2 +065100 MOVE ZERO TO REC-CT. RL1074.2 +065200 MOVE 57 TO ACTUAL-KEY-1. RL1074.2 +065300 MOVE 57 TO RECORD-NUMXXX. RL1074.2 +065400 READ RL-FR7 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +065500 GO TO TEST-20. RL1074.2 +065600 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +065700 PERFORM ERROR-WRONG-RECORD RL1074.2 +065800 GO TO TEST-20. RL1074.2 +065900 PERFORM PASS. RL1074.2 +066000 PERFORM PRINT-DETAIL. RL1074.2 +066100 TEST-20. RL1074.2 +066200 MOVE "READ RL-FR8" TO FEATURE. RL1074.2 +066300 MOVE "REL-TEST-020" TO PAR-NAME. RL1074.2 +066400 MOVE ZERO TO REC-CT. RL1074.2 +066500 MOVE 12 TO RECORD-NUMXXX. RL1074.2 +066600 MOVE 12 TO ACTUAL-KEY-2. RL1074.2 +066700 READ RL-FR8 INVALID KEY PERFORM ERROR-INVALID-KEY RL1074.2 +066800 GO TO TEST-21. RL1074.2 +066900 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-2 RL1074.2 +067000 MOVE RECORD-NO-2 TO RECORD-NO-1 RL1074.2 +067100 PERFORM ERROR-WRONG-RECORD RL1074.2 +067200 GO TO TEST-21. RL1074.2 +067300 PERFORM PASS RL1074.2 +067400 PERFORM PRINT-DETAIL. RL1074.2 +067500 TEST-21. RL1074.2 +067600 MOVE "INVALID KEY RL-FR7" TO FEATURE. RL1074.2 +067700 MOVE "REL-TEST-021" TO PAR-NAME. RL1074.2 +067800 MOVE ZERO TO REC-CT. RL1074.2 +067900 MOVE 237 TO ACTUAL-KEY-1. RL1074.2 +068000 READ RL-FR7 INVALID KEY PERFORM PASS RL1074.2 +068100 PERFORM PRINT-DETAIL RL1074.2 +068200 GO TO TEST-22. RL1074.2 +068300 PERFORM ERROR-INVALID-KEY-EXPECTED. RL1074.2 +068400 TEST-22. RL1074.2 +068500 MOVE "REL-TEST-022" TO PAR-NAME. RL1074.2 +068600 MOVE 250 TO ACTUAL-KEY-1. RL1074.2 +068700 READ RL-FR7 INVALID KEY PERFORM PASS RL1074.2 +068800 PERFORM PRINT-DETAIL RL1074.2 +068900 GO TO TEST-23. RL1074.2 +069000 PERFORM ERROR-INVALID-KEY-EXPECTED. RL1074.2 +069100 TEST-23. RL1074.2 +069200 MOVE "INVALID KEY RL-FR8" TO FEATURE. RL1074.2 +069300 MOVE "REL-TEST-023" TO PAR-NAME. RL1074.2 +069400 MOVE 150 TO ACTUAL-KEY-2. RL1074.2 +069500 READ RL-FR8 INVALID KEY PERFORM PASS RL1074.2 +069600 PERFORM PRINT-DETAIL RL1074.2 +069700 GO TO TEST-24. RL1074.2 +069800 MOVE ACTUAL-KEY-2 TO ACTUAL-KEY-1. RL1074.2 +069900 PERFORM ERROR-INVALID-KEY-EXPECTED. RL1074.2 +070000 TEST-24. RL1074.2 +070100 MOVE "INVALID KEY RL-FR7" TO FEATURE. RL1074.2 +070200 MOVE "REL-TEST-024" TO PAR-NAME. RL1074.2 +070300 MOVE 230 TO ACTUAL-KEY-1. RL1074.2 +070400 READ RL-FR7 INVALID KEY PERFORM PASS RL1074.2 +070500 PERFORM PRINT-DETAIL RL1074.2 +070600 GO TO TEST-25-INIT. RL1074.2 +070700 PERFORM ERROR-INVALID-KEY-EXPECTED. RL1074.2 +070800 TEST-25-INIT. RL1074.2 +070900 MOVE "REWRITE RL-FR7" TO FEATURE. RL1074.2 +071000 MOVE "REL-TEST-025" TO PAR-NAME. RL1074.2 +071100 MOVE 0 TO ACTUAL-KEY-1. RL1074.2 +071200 MOVE 0 TO RECORD-NUMXXX. RL1074.2 +071300 MOVE ZERO TO REC-CT. RL1074.2 +071400 TEST-25. RL1074.2 +071500 ADD 10 TO ACTUAL-KEY-1. RL1074.2 +071600 ADD 10 TO RECORD-NUMXXX. RL1074.2 +071700 IF RECORD-NUMXXX IS GREATER THAN 100 GO TO TEST-25-RESET. RL1074.2 +071800 READ RL-FR7 INVALID KEY RL1074.2 +071900 MOVE "INVALID KEY ON READ BEFORE REWRITE" TO RE-MARK RL1074.2 +072000 PERFORM ERROR-WRONG-RECORD RL1074.2 +072100 GO TO TEST-25. RL1074.2 +072200 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +072300 PERFORM ERROR-WRONG-RECORD RL1074.2 +072400 GO TO TEST-25. RL1074.2 +072500 MOVE "UPDATED" TO UPDATE-FIELD. RL1074.2 +072600 REWRITE RAC-REC-1 INVALID KEY RL1074.2 +072700 MOVE "INVALID KEY ON REWRITE" TO RE-MARK RL1074.2 +072800 PERFORM ERROR-INVALID-KEY. RL1074.2 +072900 GO TO TEST-25. RL1074.2 +073000 TEST-25-RESET. RL1074.2 +073100 MOVE 0 TO ACTUAL-KEY-1. RL1074.2 +073200 MOVE 0 TO RECORD-NUMXXX. RL1074.2 +073300 TEST-25-READ. RL1074.2 +073400 ADD 10 TO ACTUAL-KEY-1. RL1074.2 +073500 ADD 10 TO RECORD-NUMXXX. RL1074.2 +073600 IF RECORD-NUMXXX IS GREATER THAN 100 GO TO TEST-25-EXIT. RL1074.2 +073700 READ RL-FR7 INVALID KEY RL1074.2 +073800 MOVE "INVALID KEY ON READ AFTER REWRITE" TO RE-MARK RL1074.2 +073900 PERFORM ERROR-INVALID-KEY RL1074.2 +074000 GO TO TEST-25-READ. RL1074.2 +074100 IF RECORD-NUMXXX IS NOT EQUAL TO RECORD-NO-1 RL1074.2 +074200 PERFORM ERROR-WRONG-RECORD RL1074.2 +074300 GO TO TEST-25-READ. RL1074.2 +074400 IF UPDATE-FIELD IS EQUAL TO "UPDATED" GO TO TEST-25-READ. RL1074.2 +074500 IF REC-CT IS EQUAL TO ZERO PERFORM FAIL. RL1074.2 +074600 ADD 1 TO REC-CT. RL1074.2 +074700 MOVE UPDATE-FIELD TO COMPUTED-A. RL1074.2 +074800 MOVE "UPDATED" TO CORRECT-A. RL1074.2 +074900 MOVE "RECORD NOT UPDATED PROPERLY" TO RE-MARK. RL1074.2 +075000 PERFORM PRINT-DETAIL. RL1074.2 +075100 GO TO TEST-25-READ. RL1074.2 +075200 TEST-25-EXIT. RL1074.2 +075300 IF REC-CT IS EQUAL TO ZERO PERFORM PASS RL1074.2 +075400 PERFORM PRINT-DETAIL. RL1074.2 +075500 TEST-26. RL1074.2 +075600 MOVE "CLOSE RL-FR8" TO FEATURE. RL1074.2 +075700 MOVE "REL-TEST-026" TO PAR-NAME. RL1074.2 +075800 MOVE ZERO TO REC-CT. RL1074.2 +075900 PERFORM PRINT-DETAIL. RL1074.2 +076000 CLOSE RL-FR8. RL1074.2 +076100 TEST-27. RL1074.2 +076200 MOVE "CLOSE RL-FR7" TO FEATURE. RL1074.2 +076300 MOVE "REL-TEST-027" TO PAR-NAME. RL1074.2 +076400 PERFORM PRINT-DETAIL. RL1074.2 +076500 CLOSE RL-FR7. RL1074.2 +076600 GO TO SECT-RC-03-001-EXIT. RL1074.2 +076700 ERROR-INVALID-KEY. RL1074.2 +076800 IF REC-CT IS EQUAL TO ZERO PERFORM FAIL. RL1074.2 +076900 ADD 1 TO REC-CT. RL1074.2 +077000 MOVE RECORD-NUMXXX TO CORRECT-18V0. RL1074.2 +077100 MOVE "INVALID KEY" TO COMPUTED-A. RL1074.2 +077200 PERFORM PRINT-DETAIL. RL1074.2 +077300 ERROR-INVALID-KEY-EXPECTED. RL1074.2 +077400 PERFORM FAIL. RL1074.2 +077500 ADD 1 TO REC-CT. RL1074.2 +077600 MOVE ACTUAL-KEY-1 TO COMPUTED-18V0. RL1074.2 +077700 MOVE "INVALID KEY" TO CORRECT-A. RL1074.2 +077800 MOVE "INVALID KEY EXPECTED ON READ" TO RE-MARK. RL1074.2 +077900 PERFORM PRINT-DETAIL. RL1074.2 +078000 ERROR-WRONG-RECORD. RL1074.2 +078100 IF REC-CT IS EQUAL TO ZERO PERFORM FAIL. RL1074.2 +078200 ADD 1 TO REC-CT. RL1074.2 +078300 MOVE RECORD-NO-1 TO COMPUTED-18V0. RL1074.2 +078400 MOVE RECORD-NUMXXX TO CORRECT-18V0. RL1074.2 +078500 MOVE "WRONG RECORD FOUND" TO RE-MARK. RL1074.2 +078600 PERFORM PRINT-DETAIL. RL1074.2 +078700 SECT-RC-03-001-EXIT. RL1074.2 +078800 EXIT. RL1074.2 +078900 CCVS-EXIT SECTION. RL1074.2 +079000 CCVS-999999. RL1074.2 +079100 GO TO CLOSE-FILES. RL1074.2 diff --git a/tests/cobol85/RL/RL108A.CBL b/tests/cobol85/RL/RL108A.CBL new file mode 100644 index 00000000..28b0158a --- /dev/null +++ b/tests/cobol85/RL/RL108A.CBL @@ -0,0 +1,462 @@ +000100 IDENTIFICATION DIVISION. RL1084.2 +000200 PROGRAM-ID. RL1084.2 +000300 RL108A. RL1084.2 +000400**************************************************************** RL1084.2 +000500* * RL1084.2 +000600* VALIDATION FOR:- * RL1084.2 +000700* * RL1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1084.2 +000900* * RL1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1084.2 +001100* * RL1084.2 +001200**************************************************************** RL1084.2 +001300* * RL1084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1084.2 +001500* * RL1084.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1084.2 +001700* X-61 - "LITERAL" IN "ASSIGN TO" CLAUSE FOR * RL1084.2 +001800* RELATIVE I-O DATA FILE. * RL1084.2 +001900* X-69 - ADDITIONAL "VALUE OF" CLAUSE. * RL1084.2 +002000* X-74 - VALUE OF IMPLEMENTOR-NAME. * RL1084.2 +002100* X-75 - OBJECT OF "VALUE" CLAUSE. * RL1084.2 +002200* X-82 - SOURCE COMPUTER NAME. * RL1084.2 +002300* X-83 - OBJECT COMPUTER NAME. * RL1084.2 +002400* * RL1084.2 +002500**************************************************************** RL1084.2 +002600*RL108A * RL1084.2 +002700*************************************************** RL1084.2 +002800*GENERAL: THIS RUN UNIT IS THE FIRST OF A SERIES WHICH RL1084.2 +002900* PROCESSES A RELATIVE I-O FILE. THE FUNCTION OF THIS RL1084.2 +003000* PROGRAM IS TO CREATE A RELATIVE FILE SEQUENTIALLY RL1084.2 +003100* (ACCESS MODE SEQUENTIAL) AND VERIFY THAT IT WAS RL1084.2 +003200* CREATED CORRECTLY. THE FILE IS IDENTIFED AS "RL-FS1"RL1084.2 +003300* AND IS PASSED TO SUBSEQUENT RUN UNITS FOR PROCESSING.RL1084.2 +003400* RL1084.2 +003500* THIS PROGRAM TESTS THE NEW SYNTACTICAL CONSTRUCTS AND RL1084.2 +003600* SEMANTIC ACTIONS OF THE FOLLOWING ELEMENTS: RL1084.2 +003700* - ASSIGN RL1084.2 +003800* - ORGANIZATION RL1084.2 +003900* - ACCESS RL1084.2 +004000* - READ RL1084.2 +004100* - WRITE RL1084.2 +004200**************************************************************** RL1084.2 +004300 ENVIRONMENT DIVISION. RL1084.2 +004400 CONFIGURATION SECTION. RL1084.2 +004500 SOURCE-COMPUTER. RL1084.2 +004600 Linux. RL1084.2 +004700 OBJECT-COMPUTER. RL1084.2 +004800 Linux. RL1084.2 +004900 INPUT-OUTPUT SECTION. RL1084.2 +005000 FILE-CONTROL. RL1084.2 +005100 SELECT PRINT-FILE ASSIGN TO RL1084.2 +005200 "report.log". RL1084.2 +005300 SELECT RL-FS1 ASSIGN TO RL1084.2 +005400 "XXXXX061" RL1084.2 +005500 ORGANIZATION RELATIVE RL1084.2 +005600 ACCESS SEQUENTIAL. RL1084.2 +005700* RL1084.2 +005800 DATA DIVISION. RL1084.2 +005900 FILE SECTION. RL1084.2 +006000 FD PRINT-FILE. RL1084.2 +006100 01 PRINT-REC PICTURE X(120). RL1084.2 +006200 01 DUMMY-RECORD PICTURE X(120). RL1084.2 +006300 FD RL-FS1 RL1084.2 +006400 LABEL RECORDS STANDARD RL1084.2 +006500*C VALUE OF RL1084.2 +006600*C OCLABELID RL1084.2 +006700*C IS RL1084.2 +006800*C "OCDUMMY" RL1084.2 +006900*G SYSIN RL1084.2 +007000 BLOCK CONTAINS 1 RECORDS RL1084.2 +007100 RECORD CONTAINS 120 CHARACTERS. RL1084.2 +007200 01 RL-FS1R1-F-G-120. RL1084.2 +007300 02 FILLER PIC X(120). RL1084.2 +007400 WORKING-STORAGE SECTION. RL1084.2 +007500 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL1084.2 +007600 01 FILE-RECORD-INFORMATION-REC. RL1084.2 +007700 03 FILE-RECORD-INFO-SKELETON. RL1084.2 +007800 05 FILLER PICTURE X(48) VALUE RL1084.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1084.2 +008000 05 FILLER PICTURE X(46) VALUE RL1084.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1084.2 +008200 05 FILLER PICTURE X(26) VALUE RL1084.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". RL1084.2 +008400 05 FILLER PICTURE X(37) VALUE RL1084.2 +008500 ",RECKEY= ". RL1084.2 +008600 05 FILLER PICTURE X(38) VALUE RL1084.2 +008700 ",ALTKEY1= ". RL1084.2 +008800 05 FILLER PICTURE X(38) VALUE RL1084.2 +008900 ",ALTKEY2= ". RL1084.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.RL1084.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1084.2 +009200 05 FILE-RECORD-INFO-P1-120. RL1084.2 +009300 07 FILLER PIC X(5). RL1084.2 +009400 07 XFILE-NAME PIC X(6). RL1084.2 +009500 07 FILLER PIC X(8). RL1084.2 +009600 07 XRECORD-NAME PIC X(6). RL1084.2 +009700 07 FILLER PIC X(1). RL1084.2 +009800 07 REELUNIT-NUMBER PIC 9(1). RL1084.2 +009900 07 FILLER PIC X(7). RL1084.2 +010000 07 XRECORD-NUMBER PIC 9(6). RL1084.2 +010100 07 FILLER PIC X(6). RL1084.2 +010200 07 UPDATE-NUMBER PIC 9(2). RL1084.2 +010300 07 FILLER PIC X(5). RL1084.2 +010400 07 ODO-NUMBER PIC 9(4). RL1084.2 +010500 07 FILLER PIC X(5). RL1084.2 +010600 07 XPROGRAM-NAME PIC X(5). RL1084.2 +010700 07 FILLER PIC X(7). RL1084.2 +010800 07 XRECORD-LENGTH PIC 9(6). RL1084.2 +010900 07 FILLER PIC X(7). RL1084.2 +011000 07 CHARS-OR-RECORDS PIC X(2). RL1084.2 +011100 07 FILLER PIC X(1). RL1084.2 +011200 07 XBLOCK-SIZE PIC 9(4). RL1084.2 +011300 07 FILLER PIC X(6). RL1084.2 +011400 07 RECORDS-IN-FILE PIC 9(6). RL1084.2 +011500 07 FILLER PIC X(5). RL1084.2 +011600 07 XFILE-ORGANIZATION PIC X(2). RL1084.2 +011700 07 FILLER PIC X(6). RL1084.2 +011800 07 XLABEL-TYPE PIC X(1). RL1084.2 +011900 05 FILE-RECORD-INFO-P121-240. RL1084.2 +012000 07 FILLER PIC X(8). RL1084.2 +012100 07 XRECORD-KEY PIC X(29). RL1084.2 +012200 07 FILLER PIC X(9). RL1084.2 +012300 07 ALTERNATE-KEY1 PIC X(29). RL1084.2 +012400 07 FILLER PIC X(9). RL1084.2 +012500 07 ALTERNATE-KEY2 PIC X(29). RL1084.2 +012600 07 FILLER PIC X(7). RL1084.2 +012700 01 TEST-RESULTS. RL1084.2 +012800 02 FILLER PIC X VALUE SPACE. RL1084.2 +012900 02 FEATURE PIC X(20) VALUE SPACE. RL1084.2 +013000 02 FILLER PIC X VALUE SPACE. RL1084.2 +013100 02 P-OR-F PIC X(5) VALUE SPACE. RL1084.2 +013200 02 FILLER PIC X VALUE SPACE. RL1084.2 +013300 02 PAR-NAME. RL1084.2 +013400 03 FILLER PIC X(19) VALUE SPACE. RL1084.2 +013500 03 PARDOT-X PIC X VALUE SPACE. RL1084.2 +013600 03 DOTVALUE PIC 99 VALUE ZERO. RL1084.2 +013700 02 FILLER PIC X(8) VALUE SPACE. RL1084.2 +013800 02 RE-MARK PIC X(61). RL1084.2 +013900 01 TEST-COMPUTED. RL1084.2 +014000 02 FILLER PIC X(30) VALUE SPACE. RL1084.2 +014100 02 FILLER PIC X(17) VALUE RL1084.2 +014200 " COMPUTED=". RL1084.2 +014300 02 COMPUTED-X. RL1084.2 +014400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1084.2 +014500 03 COMPUTED-N REDEFINES COMPUTED-A RL1084.2 +014600 PIC -9(9).9(9). RL1084.2 +014700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1084.2 +014800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1084.2 +014900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1084.2 +015000 03 CM-18V0 REDEFINES COMPUTED-A. RL1084.2 +015100 04 COMPUTED-18V0 PIC -9(18). RL1084.2 +015200 04 FILLER PIC X. RL1084.2 +015300 03 FILLER PIC X(50) VALUE SPACE. RL1084.2 +015400 01 TEST-CORRECT. RL1084.2 +015500 02 FILLER PIC X(30) VALUE SPACE. RL1084.2 +015600 02 FILLER PIC X(17) VALUE " CORRECT =". RL1084.2 +015700 02 CORRECT-X. RL1084.2 +015800 03 CORRECT-A PIC X(20) VALUE SPACE. RL1084.2 +015900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1084.2 +016000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1084.2 +016100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1084.2 +016200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1084.2 +016300 03 CR-18V0 REDEFINES CORRECT-A. RL1084.2 +016400 04 CORRECT-18V0 PIC -9(18). RL1084.2 +016500 04 FILLER PIC X. RL1084.2 +016600 03 FILLER PIC X(2) VALUE SPACE. RL1084.2 +016700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1084.2 +016800 01 CCVS-C-1. RL1084.2 +016900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1084.2 +017000- "SS PARAGRAPH-NAME RL1084.2 +017100- " REMARKS". RL1084.2 +017200 02 FILLER PIC X(20) VALUE SPACE. RL1084.2 +017300 01 CCVS-C-2. RL1084.2 +017400 02 FILLER PIC X VALUE SPACE. RL1084.2 +017500 02 FILLER PIC X(6) VALUE "TESTED". RL1084.2 +017600 02 FILLER PIC X(15) VALUE SPACE. RL1084.2 +017700 02 FILLER PIC X(4) VALUE "FAIL". RL1084.2 +017800 02 FILLER PIC X(94) VALUE SPACE. RL1084.2 +017900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1084.2 +018000 01 REC-CT PIC 99 VALUE ZERO. RL1084.2 +018100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1084.2 +018200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1084.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1084.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1084.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1084.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1084.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1084.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1084.2 +018900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1084.2 +019000 01 CCVS-H-1. RL1084.2 +019100 02 FILLER PIC X(39) VALUE SPACES. RL1084.2 +019200 02 FILLER PIC X(42) VALUE RL1084.2 +019300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1084.2 +019400 02 FILLER PIC X(39) VALUE SPACES. RL1084.2 +019500 01 CCVS-H-2A. RL1084.2 +019600 02 FILLER PIC X(40) VALUE SPACE. RL1084.2 +019700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1084.2 +019800 02 FILLER PIC XXXX VALUE RL1084.2 +019900 "4.2 ". RL1084.2 +020000 02 FILLER PIC X(28) VALUE RL1084.2 +020100 " COPY - NOT FOR DISTRIBUTION". RL1084.2 +020200 02 FILLER PIC X(41) VALUE SPACE. RL1084.2 +020300 RL1084.2 +020400 01 CCVS-H-2B. RL1084.2 +020500 02 FILLER PIC X(15) VALUE RL1084.2 +020600 "TEST RESULT OF ". RL1084.2 +020700 02 TEST-ID PIC X(9). RL1084.2 +020800 02 FILLER PIC X(4) VALUE RL1084.2 +020900 " IN ". RL1084.2 +021000 02 FILLER PIC X(12) VALUE RL1084.2 +021100 " HIGH ". RL1084.2 +021200 02 FILLER PIC X(22) VALUE RL1084.2 +021300 " LEVEL VALIDATION FOR ". RL1084.2 +021400 02 FILLER PIC X(58) VALUE RL1084.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1084.2 +021600 01 CCVS-H-3. RL1084.2 +021700 02 FILLER PIC X(34) VALUE RL1084.2 +021800 " FOR OFFICIAL USE ONLY ". RL1084.2 +021900 02 FILLER PIC X(58) VALUE RL1084.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1084.2 +022100 02 FILLER PIC X(28) VALUE RL1084.2 +022200 " COPYRIGHT 1985 ". RL1084.2 +022300 01 CCVS-E-1. RL1084.2 +022400 02 FILLER PIC X(52) VALUE SPACE. RL1084.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1084.2 +022600 02 ID-AGAIN PIC X(9). RL1084.2 +022700 02 FILLER PIC X(45) VALUE SPACES. RL1084.2 +022800 01 CCVS-E-2. RL1084.2 +022900 02 FILLER PIC X(31) VALUE SPACE. RL1084.2 +023000 02 FILLER PIC X(21) VALUE SPACE. RL1084.2 +023100 02 CCVS-E-2-2. RL1084.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1084.2 +023300 03 FILLER PIC X VALUE SPACE. RL1084.2 +023400 03 ENDER-DESC PIC X(44) VALUE RL1084.2 +023500 "ERRORS ENCOUNTERED". RL1084.2 +023600 01 CCVS-E-3. RL1084.2 +023700 02 FILLER PIC X(22) VALUE RL1084.2 +023800 " FOR OFFICIAL USE ONLY". RL1084.2 +023900 02 FILLER PIC X(12) VALUE SPACE. RL1084.2 +024000 02 FILLER PIC X(58) VALUE RL1084.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1084.2 +024200 02 FILLER PIC X(13) VALUE SPACE. RL1084.2 +024300 02 FILLER PIC X(15) VALUE RL1084.2 +024400 " COPYRIGHT 1985". RL1084.2 +024500 01 CCVS-E-4. RL1084.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1084.2 +024700 02 FILLER PIC X(4) VALUE " OF ". RL1084.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1084.2 +024900 02 FILLER PIC X(40) VALUE RL1084.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". RL1084.2 +025100 01 XXINFO. RL1084.2 +025200 02 FILLER PIC X(19) VALUE RL1084.2 +025300 "*** INFORMATION ***". RL1084.2 +025400 02 INFO-TEXT. RL1084.2 +025500 04 FILLER PIC X(8) VALUE SPACE. RL1084.2 +025600 04 XXCOMPUTED PIC X(20). RL1084.2 +025700 04 FILLER PIC X(5) VALUE SPACE. RL1084.2 +025800 04 XXCORRECT PIC X(20). RL1084.2 +025900 02 INF-ANSI-REFERENCE PIC X(48). RL1084.2 +026000 01 HYPHEN-LINE. RL1084.2 +026100 02 FILLER PIC IS X VALUE IS SPACE. RL1084.2 +026200 02 FILLER PIC IS X(65) VALUE IS "************************RL1084.2 +026300- "*****************************************". RL1084.2 +026400 02 FILLER PIC IS X(54) VALUE IS "************************RL1084.2 +026500- "******************************". RL1084.2 +026600 01 CCVS-PGM-ID PIC X(9) VALUE RL1084.2 +026700 "RL108A". RL1084.2 +026800 PROCEDURE DIVISION. RL1084.2 +026900 CCVS1 SECTION. RL1084.2 +027000 OPEN-FILES. RL1084.2 +027100 OPEN OUTPUT PRINT-FILE. RL1084.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1084.2 +027300 MOVE SPACE TO TEST-RESULTS. RL1084.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1084.2 +027500 MOVE ZERO TO REC-SKL-SUB. RL1084.2 +027600 PERFORM CCVS-INIT-FILE 9 TIMES. RL1084.2 +027700 CCVS-INIT-FILE. RL1084.2 +027800 ADD 1 TO REC-SKL-SUB. RL1084.2 +027900 MOVE FILE-RECORD-INFO-SKELETON RL1084.2 +028000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1084.2 +028100 CCVS-INIT-EXIT. RL1084.2 +028200 GO TO CCVS1-EXIT. RL1084.2 +028300 CLOSE-FILES. RL1084.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1084.2 +028500 TERMINATE-CCVS. RL1084.2 +028600*S EXIT PROGRAM. RL1084.2 +028700*SERMINATE-CALL. RL1084.2 +028800 STOP RUN. RL1084.2 +028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1084.2 +029000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1084.2 +029100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1084.2 +029200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1084.2 +029300 MOVE "****TEST DELETED****" TO RE-MARK. RL1084.2 +029400 PRINT-DETAIL. RL1084.2 +029500 IF REC-CT NOT EQUAL TO ZERO RL1084.2 +029600 MOVE "." TO PARDOT-X RL1084.2 +029700 MOVE REC-CT TO DOTVALUE. RL1084.2 +029800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1084.2 +029900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1084.2 +030000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1084.2 +030100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1084.2 +030200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1084.2 +030300 MOVE SPACE TO CORRECT-X. RL1084.2 +030400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1084.2 +030500 MOVE SPACE TO RE-MARK. RL1084.2 +030600 HEAD-ROUTINE. RL1084.2 +030700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +030800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +030900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1084.2 +031000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1084.2 +031100 COLUMN-NAMES-ROUTINE. RL1084.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +031500 END-ROUTINE. RL1084.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1084.2 +031700 END-RTN-EXIT. RL1084.2 +031800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +031900 END-ROUTINE-1. RL1084.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1084.2 +032100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1084.2 +032200 ADD PASS-COUNTER TO ERROR-HOLD. RL1084.2 +032300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1084.2 +032400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1084.2 +032500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1084.2 +032600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1084.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1084.2 +032800 END-ROUTINE-12. RL1084.2 +032900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1084.2 +033000 IF ERROR-COUNTER IS EQUAL TO ZERO RL1084.2 +033100 MOVE "NO " TO ERROR-TOTAL RL1084.2 +033200 ELSE RL1084.2 +033300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1084.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1084.2 +033500 PERFORM WRITE-LINE. RL1084.2 +033600 END-ROUTINE-13. RL1084.2 +033700 IF DELETE-COUNTER IS EQUAL TO ZERO RL1084.2 +033800 MOVE "NO " TO ERROR-TOTAL ELSE RL1084.2 +033900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1084.2 +034000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1084.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +034200 IF INSPECT-COUNTER EQUAL TO ZERO RL1084.2 +034300 MOVE "NO " TO ERROR-TOTAL RL1084.2 +034400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1084.2 +034500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1084.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +034700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1084.2 +034800 WRITE-LINE. RL1084.2 +034900 ADD 1 TO RECORD-COUNT. RL1084.2 +035000 IF RECORD-COUNT GREATER 50 RL1084.2 +035100 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1084.2 +035200 MOVE SPACE TO DUMMY-RECORD RL1084.2 +035300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1084.2 +035400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1084.2 +035500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1084.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1084.2 +035700 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1084.2 +035800 MOVE ZERO TO RECORD-COUNT. RL1084.2 +035900 PERFORM WRT-LN. RL1084.2 +036000 WRT-LN. RL1084.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1084.2 +036200 MOVE SPACE TO DUMMY-RECORD. RL1084.2 +036300 BLANK-LINE-PRINT. RL1084.2 +036400 PERFORM WRT-LN. RL1084.2 +036500 FAIL-ROUTINE. RL1084.2 +036600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL1084.2 +036700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1084.2 +036800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1084.2 +036900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1084.2 +037000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +037100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1084.2 +037200 GO TO FAIL-ROUTINE-EX. RL1084.2 +037300 FAIL-ROUTINE-WRITE. RL1084.2 +037400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1084.2 +037500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1084.2 +037600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1084.2 +037700 MOVE SPACES TO COR-ANSI-REFERENCE. RL1084.2 +037800 FAIL-ROUTINE-EX. EXIT. RL1084.2 +037900 BAIL-OUT. RL1084.2 +038000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1084.2 +038100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1084.2 +038200 BAIL-OUT-WRITE. RL1084.2 +038300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1084.2 +038400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1084.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1084.2 +038600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1084.2 +038700 BAIL-OUT-EX. EXIT. RL1084.2 +038800 CCVS1-EXIT. RL1084.2 +038900 EXIT. RL1084.2 +039000 SECT-RL108A-001 SECTION. RL1084.2 +039100 REL-INIT-001. RL1084.2 +039200 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL1084.2 +039300 OPEN OUTPUT RL-FS1. RL1084.2 +039400 MOVE "RL-FS1" TO XFILE-NAME (1). RL1084.2 +039500 MOVE "R1-F-G" TO XRECORD-NAME (1). RL1084.2 +039600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1084.2 +039700 MOVE 000120 TO XRECORD-LENGTH (1). RL1084.2 +039800 MOVE "RC" TO CHARS-OR-RECORDS (1). RL1084.2 +039900 MOVE 0001 TO XBLOCK-SIZE (1). RL1084.2 +040000 MOVE 000500 TO RECORDS-IN-FILE (1). RL1084.2 +040100 MOVE "RL" TO XFILE-ORGANIZATION (1). RL1084.2 +040200 MOVE "S" TO XLABEL-TYPE (1). RL1084.2 +040300 MOVE 000001 TO XRECORD-NUMBER (1). RL1084.2 +040400 REL-TEST-001. RL1084.2 +040500 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL1084.2 +040600 WRITE RL-FS1R1-F-G-120 RL1084.2 +040700 INVALID KEY GO TO REL-FAIL-001 RL1084.2 +040800 NOT INVALID KEY GO TO REL-TEST-001-A RL1084.2 +040900 END-WRITE. RL1084.2 +041000 REL-TEST-001-A. RL1084.2 +041100 IF XRECORD-NUMBER (1) EQUAL TO 500 RL1084.2 +041200 GO TO REL-WRITE-001. RL1084.2 +041300 ADD 000001 TO XRECORD-NUMBER (1). RL1084.2 +041400 GO TO REL-TEST-001. RL1084.2 +041500 REL-DELETE-001. RL1084.2 +041600 PERFORM DE-LETE. RL1084.2 +041700 GO TO REL-WRITE-001. RL1084.2 +041800 REL-FAIL-001. RL1084.2 +041900 PERFORM FAIL. RL1084.2 +042000 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL1084.2 +042100 REL-WRITE-001. RL1084.2 +042200 MOVE "VIII-37 4.9.4(A)" TO ANSI-REFERENCE. RL1084.2 +042300 MOVE "REL-TEST-001" TO PAR-NAME RL1084.2 +042400 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL1084.2 +042500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL1084.2 +042600 PERFORM PRINT-DETAIL. RL1084.2 +042700 CLOSE RL-FS1. RL1084.2 +042800 REL-INIT-002. RL1084.2 +042900 OPEN INPUT RL-FS1. RL1084.2 +043000 MOVE ZERO TO WRK-CS-09V00. RL1084.2 +043100 REL-TEST-002. RL1084.2 +043200 READ RL-FS1 RL1084.2 +043300 AT END GO TO REL-TEST-002-1 RL1084.2 +043400 NOT AT END GO TO REL-TEST-002-A RL1084.2 +043500 END-READ. RL1084.2 +043600 REL-TEST-002-A. RL1084.2 +043700 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1084.2 +043800 ADD 1 TO WRK-CS-09V00. RL1084.2 +043900 IF WRK-CS-09V00 GREATER 500 RL1084.2 +044000 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL1084.2 +044100 GO TO REL-TEST-002-1. RL1084.2 +044200 GO TO REL-TEST-002. RL1084.2 +044300 REL-DELETE-002. RL1084.2 +044400 PERFORM DE-LETE. RL1084.2 +044500 PERFORM PRINT-DETAIL. RL1084.2 +044600 GO TO CCVS-EXIT. RL1084.2 +044700 REL-TEST-002-1. RL1084.2 +044800 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL1084.2 +044900 PERFORM FAIL RL1084.2 +045000 ELSE RL1084.2 +045100 PERFORM PASS. RL1084.2 +045200 GO TO REL-WRITE-002. RL1084.2 +045300 REL-WRITE-002. RL1084.2 +045400 MOVE "VIII-26 4.5.4" TO ANSI-REFERENCE. RL1084.2 +045500 MOVE "REL-TEST-002" TO PAR-NAME. RL1084.2 +045600 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL1084.2 +045700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL1084.2 +045800 PERFORM PRINT-DETAIL. RL1084.2 +045900 CLOSE RL-FS1. RL1084.2 +046000 CCVS-EXIT SECTION. RL1084.2 +046100 CCVS-999999. RL1084.2 +046200 GO TO CLOSE-FILES. RL1084.2 diff --git a/tests/cobol85/RL/RL109A.SUB b/tests/cobol85/RL/RL109A.SUB new file mode 100644 index 00000000..a7504390 --- /dev/null +++ b/tests/cobol85/RL/RL109A.SUB @@ -0,0 +1,645 @@ +000100 IDENTIFICATION DIVISION. RL1094.2 +000200 PROGRAM-ID. RL1094.2 +000300 RL109A. RL1094.2 +000400**************************************************************** RL1094.2 +000500* * RL1094.2 +000600* VALIDATION FOR:- * RL1094.2 +000700* * RL1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1094.2 +000900* * RL1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1094.2 +001100* * RL1094.2 +001200**************************************************************** RL1094.2 +001300* * RL1094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1094.2 +001500* * RL1094.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1094.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1094.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1094.2 +001900* * RL1094.2 +002000**************************************************************** RL1094.2 +002100*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVERL1094.2 +002200* I-O FILE RANDOMLY (ACCESS MODE IS RANDOM). THE FILE RL1094.2 +002300* USED AS INPUT IS THAT FILE CREATED BY RL108A. RL1094.2 +002400* RL1094.2 +002500* FIRST THE FILE IS VERIFED AS TO THE EXISTANCE AND RL1094.2 +002600* ACCURACY OF THE 500 RECORDS CREATED IN THE FIRST RL1094.2 +002700* PROGRAM. SECONDLY, RECORDS OF THE FILE ARE SEL- RL1094.2 +002800* ECTIVELY UPDATED; AND THIRDLY, THE ACCURACY OF EACH RL1094.2 +002900* RECORD IN THE FILE IS AGAIN VERIFIED. RL1094.2 +003000* RL1094.2 +003100* THIS PROGRAM TESTS THE NEW SYNTACTICAL CONSTRUCTS AND RL1094.2 +003200* SEMENTIC ACTIONS OF THE FOLLOWING ELEMENTS: RL1094.2 +003300* - ORGANIZATION RL1094.2 +003400* - ACCESS RL1094.2 +003500* - READ RL1094.2 +003600* - REWRITE RL1094.2 +003700* RL1094.2 +003800* RL1094.2 +003900* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1094.2 +004000* PROGRAM ARE: RL1094.2 +004100* RL1094.2 +004200* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1094.2 +004300* RELATIVE I-O DATA FILE RL1094.2 +004400* X-55 SYSTEM PRINTER RL1094.2 +004500* X-69 ADDITIONAL VALUE OF CLAUSES RL1094.2 +004600* X-74 VALUE OF IMPLEMENTOR-NAME RL1094.2 +004700* X-75 OBJECT OF VALUE OF CLAUSE RL1094.2 +004800* X-82 SOURCE-COMPUTER RL1094.2 +004900* X-83 OBJECT-COMPUTER. RL1094.2 +005000* RL1094.2 +005100*************************************************** RL1094.2 +005200 ENVIRONMENT DIVISION. RL1094.2 +005300 CONFIGURATION SECTION. RL1094.2 +005400 SOURCE-COMPUTER. RL1094.2 +005500 Linux. RL1094.2 +005600 OBJECT-COMPUTER. RL1094.2 +005700 Linux. RL1094.2 +005800 INPUT-OUTPUT SECTION. RL1094.2 +005900 FILE-CONTROL. RL1094.2 +006000 SELECT PRINT-FILE ASSIGN TO RL1094.2 +006100 "report.log". RL1094.2 +006200 SELECT RL-FR1 ASSIGN TO RL1094.2 +006300 "XXXXX061" RL1094.2 +006400 ORGANIZATION IS RELATIVE RL1094.2 +006500 ACCESS MODE IS RANDOM RL1094.2 +006600 RELATIVE RL-FR1-KEY. RL1094.2 +006700 DATA DIVISION. RL1094.2 +006800 FILE SECTION. RL1094.2 +006900 FD PRINT-FILE. RL1094.2 +007000 01 PRINT-REC PICTURE X(120). RL1094.2 +007100 01 DUMMY-RECORD PICTURE X(120). RL1094.2 +007200 FD RL-FR1 RL1094.2 +007300 LABEL RECORDS STANDARD RL1094.2 +007400*C VALUE OF RL1094.2 +007500*C OCLABELID RL1094.2 +007600*C IS RL1094.2 +007700*C "OCDUMMY" RL1094.2 +007800*G SYSIN RL1094.2 +007900 BLOCK CONTAINS 1 RECORDS RL1094.2 +008000 RECORD CONTAINS 120 CHARACTERS. RL1094.2 +008100 01 RL-FR1R1-F-G-120. RL1094.2 +008200 02 FILLER PICTURE X(120). RL1094.2 +008300 WORKING-STORAGE SECTION. RL1094.2 +008400 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +008500 01 RL-FR1-KEY PIC 9(09) USAGE COMP VALUE ZERO. RL1094.2 +008600 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. RL1094.2 +008700 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +008800 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +008900 01 I-O-ERROR-RL-FR1 PIC X(3) VALUE "NO ". RL1094.2 +009000 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +009100 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +009200 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. RL1094.2 +009300 01 WRK-DS-09V00-001 PIC S9(09) VALUE ZERO. RL1094.2 +009400 01 FILE-RECORD-INFORMATION-REC. RL1094.2 +009500 03 FILE-RECORD-INFO-SKELETON. RL1094.2 +009600 05 FILLER PICTURE X(48) VALUE RL1094.2 +009700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1094.2 +009800 05 FILLER PICTURE X(46) VALUE RL1094.2 +009900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1094.2 +010000 05 FILLER PICTURE X(26) VALUE RL1094.2 +010100 ",LFIL=000000,ORG= ,LBLR= ". RL1094.2 +010200 05 FILLER PICTURE X(37) VALUE RL1094.2 +010300 ",RECKEY= ". RL1094.2 +010400 05 FILLER PICTURE X(38) VALUE RL1094.2 +010500 ",ALTKEY1= ". RL1094.2 +010600 05 FILLER PICTURE X(38) VALUE RL1094.2 +010700 ",ALTKEY2= ". RL1094.2 +010800 05 FILLER PICTURE X(7) VALUE SPACE.RL1094.2 +010900 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1094.2 +011000 05 FILE-RECORD-INFO-P1-120. RL1094.2 +011100 07 FILLER PIC X(5). RL1094.2 +011200 07 XFILE-NAME PIC X(6). RL1094.2 +011300 07 FILLER PIC X(8). RL1094.2 +011400 07 XRECORD-NAME PIC X(6). RL1094.2 +011500 07 FILLER PIC X(1). RL1094.2 +011600 07 REELUNIT-NUMBER PIC 9(1). RL1094.2 +011700 07 FILLER PIC X(7). RL1094.2 +011800 07 XRECORD-NUMBER PIC 9(6). RL1094.2 +011900 07 FILLER PIC X(6). RL1094.2 +012000 07 UPDATE-NUMBER PIC 9(2). RL1094.2 +012100 07 FILLER PIC X(5). RL1094.2 +012200 07 ODO-NUMBER PIC 9(4). RL1094.2 +012300 07 FILLER PIC X(5). RL1094.2 +012400 07 XPROGRAM-NAME PIC X(5). RL1094.2 +012500 07 FILLER PIC X(7). RL1094.2 +012600 07 XRECORD-LENGTH PIC 9(6). RL1094.2 +012700 07 FILLER PIC X(7). RL1094.2 +012800 07 CHARS-OR-RECORDS PIC X(2). RL1094.2 +012900 07 FILLER PIC X(1). RL1094.2 +013000 07 XBLOCK-SIZE PIC 9(4). RL1094.2 +013100 07 FILLER PIC X(6). RL1094.2 +013200 07 RECORDS-IN-FILE PIC 9(6). RL1094.2 +013300 07 FILLER PIC X(5). RL1094.2 +013400 07 XFILE-ORGANIZATION PIC X(2). RL1094.2 +013500 07 FILLER PIC X(6). RL1094.2 +013600 07 XLABEL-TYPE PIC X(1). RL1094.2 +013700 05 FILE-RECORD-INFO-P121-240. RL1094.2 +013800 07 FILLER PIC X(8). RL1094.2 +013900 07 XRECORD-KEY PIC X(29). RL1094.2 +014000 07 FILLER PIC X(9). RL1094.2 +014100 07 ALTERNATE-KEY1 PIC X(29). RL1094.2 +014200 07 FILLER PIC X(9). RL1094.2 +014300 07 ALTERNATE-KEY2 PIC X(29). RL1094.2 +014400 07 FILLER PIC X(7). RL1094.2 +014500 01 TEST-RESULTS. RL1094.2 +014600 02 FILLER PIC X VALUE SPACE. RL1094.2 +014700 02 FEATURE PIC X(20) VALUE SPACE. RL1094.2 +014800 02 FILLER PIC X VALUE SPACE. RL1094.2 +014900 02 P-OR-F PIC X(5) VALUE SPACE. RL1094.2 +015000 02 FILLER PIC X VALUE SPACE. RL1094.2 +015100 02 PAR-NAME. RL1094.2 +015200 03 FILLER PIC X(19) VALUE SPACE. RL1094.2 +015300 03 PARDOT-X PIC X VALUE SPACE. RL1094.2 +015400 03 DOTVALUE PIC 99 VALUE ZERO. RL1094.2 +015500 02 FILLER PIC X(8) VALUE SPACE. RL1094.2 +015600 02 RE-MARK PIC X(61). RL1094.2 +015700 01 TEST-COMPUTED. RL1094.2 +015800 02 FILLER PIC X(30) VALUE SPACE. RL1094.2 +015900 02 FILLER PIC X(17) VALUE RL1094.2 +016000 " COMPUTED=". RL1094.2 +016100 02 COMPUTED-X. RL1094.2 +016200 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1094.2 +016300 03 COMPUTED-N REDEFINES COMPUTED-A RL1094.2 +016400 PIC -9(9).9(9). RL1094.2 +016500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1094.2 +016600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1094.2 +016700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1094.2 +016800 03 CM-18V0 REDEFINES COMPUTED-A. RL1094.2 +016900 04 COMPUTED-18V0 PIC -9(18). RL1094.2 +017000 04 FILLER PIC X. RL1094.2 +017100 03 FILLER PIC X(50) VALUE SPACE. RL1094.2 +017200 01 TEST-CORRECT. RL1094.2 +017300 02 FILLER PIC X(30) VALUE SPACE. RL1094.2 +017400 02 FILLER PIC X(17) VALUE " CORRECT =". RL1094.2 +017500 02 CORRECT-X. RL1094.2 +017600 03 CORRECT-A PIC X(20) VALUE SPACE. RL1094.2 +017700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1094.2 +017800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1094.2 +017900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1094.2 +018000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1094.2 +018100 03 CR-18V0 REDEFINES CORRECT-A. RL1094.2 +018200 04 CORRECT-18V0 PIC -9(18). RL1094.2 +018300 04 FILLER PIC X. RL1094.2 +018400 03 FILLER PIC X(2) VALUE SPACE. RL1094.2 +018500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1094.2 +018600 01 CCVS-C-1. RL1094.2 +018700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1094.2 +018800- "SS PARAGRAPH-NAME RL1094.2 +018900- " REMARKS". RL1094.2 +019000 02 FILLER PIC X(20) VALUE SPACE. RL1094.2 +019100 01 CCVS-C-2. RL1094.2 +019200 02 FILLER PIC X VALUE SPACE. RL1094.2 +019300 02 FILLER PIC X(6) VALUE "TESTED". RL1094.2 +019400 02 FILLER PIC X(15) VALUE SPACE. RL1094.2 +019500 02 FILLER PIC X(4) VALUE "FAIL". RL1094.2 +019600 02 FILLER PIC X(94) VALUE SPACE. RL1094.2 +019700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1094.2 +019800 01 REC-CT PIC 99 VALUE ZERO. RL1094.2 +019900 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1094.2 +020000 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1094.2 +020100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1094.2 +020200 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1094.2 +020300 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1094.2 +020400 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1094.2 +020500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1094.2 +020600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1094.2 +020700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1094.2 +020800 01 CCVS-H-1. RL1094.2 +020900 02 FILLER PIC X(39) VALUE SPACES. RL1094.2 +021000 02 FILLER PIC X(42) VALUE RL1094.2 +021100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1094.2 +021200 02 FILLER PIC X(39) VALUE SPACES. RL1094.2 +021300 01 CCVS-H-2A. RL1094.2 +021400 02 FILLER PIC X(40) VALUE SPACE. RL1094.2 +021500 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1094.2 +021600 02 FILLER PIC XXXX VALUE RL1094.2 +021700 "4.2 ". RL1094.2 +021800 02 FILLER PIC X(28) VALUE RL1094.2 +021900 " COPY - NOT FOR DISTRIBUTION". RL1094.2 +022000 02 FILLER PIC X(41) VALUE SPACE. RL1094.2 +022100 RL1094.2 +022200 01 CCVS-H-2B. RL1094.2 +022300 02 FILLER PIC X(15) VALUE RL1094.2 +022400 "TEST RESULT OF ". RL1094.2 +022500 02 TEST-ID PIC X(9). RL1094.2 +022600 02 FILLER PIC X(4) VALUE RL1094.2 +022700 " IN ". RL1094.2 +022800 02 FILLER PIC X(12) VALUE RL1094.2 +022900 " HIGH ". RL1094.2 +023000 02 FILLER PIC X(22) VALUE RL1094.2 +023100 " LEVEL VALIDATION FOR ". RL1094.2 +023200 02 FILLER PIC X(58) VALUE RL1094.2 +023300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1094.2 +023400 01 CCVS-H-3. RL1094.2 +023500 02 FILLER PIC X(34) VALUE RL1094.2 +023600 " FOR OFFICIAL USE ONLY ". RL1094.2 +023700 02 FILLER PIC X(58) VALUE RL1094.2 +023800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1094.2 +023900 02 FILLER PIC X(28) VALUE RL1094.2 +024000 " COPYRIGHT 1985 ". RL1094.2 +024100 01 CCVS-E-1. RL1094.2 +024200 02 FILLER PIC X(52) VALUE SPACE. RL1094.2 +024300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1094.2 +024400 02 ID-AGAIN PIC X(9). RL1094.2 +024500 02 FILLER PIC X(45) VALUE SPACES. RL1094.2 +024600 01 CCVS-E-2. RL1094.2 +024700 02 FILLER PIC X(31) VALUE SPACE. RL1094.2 +024800 02 FILLER PIC X(21) VALUE SPACE. RL1094.2 +024900 02 CCVS-E-2-2. RL1094.2 +025000 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1094.2 +025100 03 FILLER PIC X VALUE SPACE. RL1094.2 +025200 03 ENDER-DESC PIC X(44) VALUE RL1094.2 +025300 "ERRORS ENCOUNTERED". RL1094.2 +025400 01 CCVS-E-3. RL1094.2 +025500 02 FILLER PIC X(22) VALUE RL1094.2 +025600 " FOR OFFICIAL USE ONLY". RL1094.2 +025700 02 FILLER PIC X(12) VALUE SPACE. RL1094.2 +025800 02 FILLER PIC X(58) VALUE RL1094.2 +025900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1094.2 +026000 02 FILLER PIC X(13) VALUE SPACE. RL1094.2 +026100 02 FILLER PIC X(15) VALUE RL1094.2 +026200 " COPYRIGHT 1985". RL1094.2 +026300 01 CCVS-E-4. RL1094.2 +026400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1094.2 +026500 02 FILLER PIC X(4) VALUE " OF ". RL1094.2 +026600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1094.2 +026700 02 FILLER PIC X(40) VALUE RL1094.2 +026800 " TESTS WERE EXECUTED SUCCESSFULLY". RL1094.2 +026900 01 XXINFO. RL1094.2 +027000 02 FILLER PIC X(19) VALUE RL1094.2 +027100 "*** INFORMATION ***". RL1094.2 +027200 02 INFO-TEXT. RL1094.2 +027300 04 FILLER PIC X(8) VALUE SPACE. RL1094.2 +027400 04 XXCOMPUTED PIC X(20). RL1094.2 +027500 04 FILLER PIC X(5) VALUE SPACE. RL1094.2 +027600 04 XXCORRECT PIC X(20). RL1094.2 +027700 02 INF-ANSI-REFERENCE PIC X(48). RL1094.2 +027800 01 HYPHEN-LINE. RL1094.2 +027900 02 FILLER PIC IS X VALUE IS SPACE. RL1094.2 +028000 02 FILLER PIC IS X(65) VALUE IS "************************RL1094.2 +028100- "*****************************************". RL1094.2 +028200 02 FILLER PIC IS X(54) VALUE IS "************************RL1094.2 +028300- "******************************". RL1094.2 +028400 01 CCVS-PGM-ID PIC X(9) VALUE RL1094.2 +028500 "RL109A". RL1094.2 +028600 PROCEDURE DIVISION. RL1094.2 +028700 CCVS1 SECTION. RL1094.2 +028800 OPEN-FILES. RL1094.2 +028900 OPEN OUTPUT PRINT-FILE. RL1094.2 +029000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1094.2 +029100 MOVE SPACE TO TEST-RESULTS. RL1094.2 +029200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1094.2 +029300 MOVE ZERO TO REC-SKL-SUB. RL1094.2 +029400 PERFORM CCVS-INIT-FILE 9 TIMES. RL1094.2 +029500 CCVS-INIT-FILE. RL1094.2 +029600 ADD 1 TO REC-SKL-SUB. RL1094.2 +029700 MOVE FILE-RECORD-INFO-SKELETON RL1094.2 +029800 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1094.2 +029900 CCVS-INIT-EXIT. RL1094.2 +030000 GO TO CCVS1-EXIT. RL1094.2 +030100 CLOSE-FILES. RL1094.2 +030200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1094.2 +030300 TERMINATE-CCVS. RL1094.2 +030400*S EXIT PROGRAM. RL1094.2 +030500*SERMINATE-CALL. RL1094.2 +030600 STOP RUN. RL1094.2 +030700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1094.2 +030800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1094.2 +030900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1094.2 +031000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1094.2 +031100 MOVE "****TEST DELETED****" TO RE-MARK. RL1094.2 +031200 PRINT-DETAIL. RL1094.2 +031300 IF REC-CT NOT EQUAL TO ZERO RL1094.2 +031400 MOVE "." TO PARDOT-X RL1094.2 +031500 MOVE REC-CT TO DOTVALUE. RL1094.2 +031600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1094.2 +031700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1094.2 +031800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1094.2 +031900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1094.2 +032000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1094.2 +032100 MOVE SPACE TO CORRECT-X. RL1094.2 +032200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1094.2 +032300 MOVE SPACE TO RE-MARK. RL1094.2 +032400 HEAD-ROUTINE. RL1094.2 +032500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +032600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +032700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1094.2 +032800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1094.2 +032900 COLUMN-NAMES-ROUTINE. RL1094.2 +033000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +033100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +033300 END-ROUTINE. RL1094.2 +033400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1094.2 +033500 END-RTN-EXIT. RL1094.2 +033600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +033700 END-ROUTINE-1. RL1094.2 +033800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1094.2 +033900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1094.2 +034000 ADD PASS-COUNTER TO ERROR-HOLD. RL1094.2 +034100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1094.2 +034200 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1094.2 +034300 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1094.2 +034400 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1094.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1094.2 +034600 END-ROUTINE-12. RL1094.2 +034700 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1094.2 +034800 IF ERROR-COUNTER IS EQUAL TO ZERO RL1094.2 +034900 MOVE "NO " TO ERROR-TOTAL RL1094.2 +035000 ELSE RL1094.2 +035100 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1094.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1094.2 +035300 PERFORM WRITE-LINE. RL1094.2 +035400 END-ROUTINE-13. RL1094.2 +035500 IF DELETE-COUNTER IS EQUAL TO ZERO RL1094.2 +035600 MOVE "NO " TO ERROR-TOTAL ELSE RL1094.2 +035700 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1094.2 +035800 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1094.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +036000 IF INSPECT-COUNTER EQUAL TO ZERO RL1094.2 +036100 MOVE "NO " TO ERROR-TOTAL RL1094.2 +036200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1094.2 +036300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1094.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +036500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1094.2 +036600 WRITE-LINE. RL1094.2 +036700 ADD 1 TO RECORD-COUNT. RL1094.2 +036800 IF RECORD-COUNT GREATER 50 RL1094.2 +036900 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1094.2 +037000 MOVE SPACE TO DUMMY-RECORD RL1094.2 +037100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1094.2 +037200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1094.2 +037300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1094.2 +037400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1094.2 +037500 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1094.2 +037600 MOVE ZERO TO RECORD-COUNT. RL1094.2 +037700 PERFORM WRT-LN. RL1094.2 +037800 WRT-LN. RL1094.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1094.2 +038000 MOVE SPACE TO DUMMY-RECORD. RL1094.2 +038100 BLANK-LINE-PRINT. RL1094.2 +038200 PERFORM WRT-LN. RL1094.2 +038300 FAIL-ROUTINE. RL1094.2 +038400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL1094.2 +038500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1094.2 +038600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1094.2 +038700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1094.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1094.2 +039000 GO TO FAIL-ROUTINE-EX. RL1094.2 +039100 FAIL-ROUTINE-WRITE. RL1094.2 +039200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1094.2 +039300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1094.2 +039400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1094.2 +039500 MOVE SPACES TO COR-ANSI-REFERENCE. RL1094.2 +039600 FAIL-ROUTINE-EX. EXIT. RL1094.2 +039700 BAIL-OUT. RL1094.2 +039800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1094.2 +039900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1094.2 +040000 BAIL-OUT-WRITE. RL1094.2 +040100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1094.2 +040200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1094.2 +040300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1094.2 +040400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1094.2 +040500 BAIL-OUT-EX. EXIT. RL1094.2 +040600 CCVS1-EXIT. RL1094.2 +040700 EXIT. RL1094.2 +040800 SECT-RL109A-001 SECTION. RL1094.2 +040900 REL-INIT-003. RL1094.2 +041000 OPEN INPUT RL-FR1. RL1094.2 +041100 MOVE "REL-TEST-003" TO PAR-NAME. RL1094.2 +041200 MOVE ZERO TO RL-FR1-KEY. RL1094.2 +041300 MOVE ZERO TO WRK-CS-09V00-002 RL1094.2 +041400 MOVE ZERO TO WRK-CS-09V00-003 RL1094.2 +041500* RL1094.2 +041600 MOVE 01 TO REC-CT. RL1094.2 +041700 MOVE "READ RANDOM" TO FEATURE. RL1094.2 +041800 REL-TEST-003-R. RL1094.2 +041900 ADD 1 TO WRK-CS-09V00-003 RL1094.2 +042000 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1094.2 +042100 IF RL-FR1-KEY GREATER +501 RL1094.2 +042200 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A RL1094.2 +042300 MOVE RL-FR1-KEY TO CORRECT-18V0 RL1094.2 +042400 PERFORM FAIL RL1094.2 +042500 PERFORM PRINT-DETAIL RL1094.2 +042600 ADD 1 TO REC-CT RL1094.2 +042700 GO TO REL-WRITE-003. RL1094.2 +042800 READ RL-FR1 RL1094.2 +042900 INVALID GO TO REL-WRITE-003 RL1094.2 +043000 NOT INVALID GO TO REL-TEST-003-A RL1094.2 +043100 END-READ. RL1094.2 +043200 REL-TEST-003-A. RL1094.2 +043300 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1094.2 +043400 IF XRECORD-NUMBER (1) EQUAL TO RL-FR1-KEY RL1094.2 +043500 GO TO REL-TEST-003-R. RL1094.2 +043600 MOVE "YES" TO I-O-ERROR-RL-FR1. RL1094.2 +043700 ADD 1 TO WRK-CS-09V00-002 RL1094.2 +043800 GO TO REL-TEST-003-R. RL1094.2 +043900 REL-WRITE-003. RL1094.2 +044000 MOVE "VIII-26 4.5.4" TO ANSI-REFERENCE. RL1094.2 +044100 IF RL-FR1-KEY NOT EQUAL TO 501 RL1094.2 +044200 MOVE "WRONG KEY/NOT 500" TO CORRECT-A RL1094.2 +044300 MOVE RL-FR1-KEY TO COMPUTED-18V0 RL1094.2 +044400 PERFORM FAIL RL1094.2 +044500 ELSE RL1094.2 +044600 PERFORM PASS. RL1094.2 +044700 PERFORM PRINT-DETAIL. RL1094.2 +044800* RL1094.2 +044900*01 RL1094.2 +045000* RL1094.2 +045100 ADD 1 TO REC-CT. RL1094.2 +045200 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL1094.2 +045300 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A RL1094.2 +045400 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 RL1094.2 +045500 PERFORM FAIL RL1094.2 +045600 ELSE RL1094.2 +045700 PERFORM PASS. RL1094.2 +045800 PERFORM PRINT-DETAIL. RL1094.2 +045900* RL1094.2 +046000*02 RL1094.2 +046100* RL1094.2 +046200 ADD 1 TO REC-CT. RL1094.2 +046300 IF WRK-CS-09V00-003 NOT EQUAL TO 501 RL1094.2 +046400 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1094.2 +046500 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL1094.2 +046600 MOVE 501 TO CORRECT-18V0 RL1094.2 +046700 PERFORM FAIL RL1094.2 +046800 ELSE RL1094.2 +046900 PERFORM PASS. RL1094.2 +047000 PERFORM PRINT-DETAIL. RL1094.2 +047100* RL1094.2 +047200*03 RL1094.2 +047300* RL1094.2 +047400 ADD 1 TO REC-CT. RL1094.2 +047500 IF I-O-ERROR-RL-FR1 EQUAL TO "YES" RL1094.2 +047600 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 RL1094.2 +047700 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK RL1094.2 +047800 PERFORM FAIL RL1094.2 +047900 ELSE RL1094.2 +048000 PERFORM PASS. RL1094.2 +048100 PERFORM PRINT-DETAIL. RL1094.2 +048200* RL1094.2 +048300*04 RL1094.2 +048400* RL1094.2 +048500 ADD 1 TO REC-CT. RL1094.2 +048600 CLOSE RL-FR1. RL1094.2 +048700 REL-INIT-004-R . RL1094.2 +048800 MOVE "VIII-30 4.6.4" TO ANSI-REFERENCE. RL1094.2 +048900 MOVE "REL-TEST-004" TO PAR-NAME. RL1094.2 +049000 OPEN I-O RL-FR1. RL1094.2 +049100 MOVE ZERO TO RL-FR1-KEY. RL1094.2 +049200 MOVE ZERO TO WRK-CS-09V00-002. RL1094.2 +049300 MOVE ZERO TO WRK-CS-09V00-003. RL1094.2 +049400 MOVE ZERO TO WRK-CS-09V00-004. RL1094.2 +049500 MOVE ZERO TO WRK-CS-09V00-005. RL1094.2 +049600* RL1094.2 +049700 MOVE 01 TO REC-CT. RL1094.2 +049800 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1094.2 +049900 MOVE "REWRITE" TO FEATURE. RL1094.2 +050000 REL-TEST-004-R. RL1094.2 +050100 ADD 5 TO WRK-CS-09V00-003. RL1094.2 +050200 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1094.2 +050300 IF RL-FR1-KEY GREATER 505 RL1094.2 +050400 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A RL1094.2 +050500 MOVE RL-FR1-KEY TO CORRECT-18V0 RL1094.2 +050600 PERFORM FAIL RL1094.2 +050700 PERFORM PRINT-DETAIL RL1094.2 +050800 ADD 1 TO REC-CT RL1094.2 +050900 GO TO REL-TEST-004-3. RL1094.2 +051000 READ RL-FR1 RL1094.2 +051100 INVALID KEY GO TO REL-TEST-004-1 RL1094.2 +051200 NOT INVALID KEY GO TO REL-TEST-004-A RL1094.2 +051300 END-READ. RL1094.2 +051400 REL-TEST-004-A. RL1094.2 +051500 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1) RL1094.2 +051600 ADD 01 TO UPDATE-NUMBER (1). RL1094.2 +051700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1094.2 +051800 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FR1R1-F-G-120. RL1094.2 +051900 REWRITE RL-FR1R1-F-G-120 RL1094.2 +052000 INVALID KEY GO TO REL-TEST-004-2 RL1094.2 +052100 NOT INVALID KEY GO TO REL-TEST-004-R RL1094.2 +052200 END-REWRITE. RL1094.2 +052300 REL-TEST-004-1. RL1094.2 +052400 IF RL-FR1-KEY LESS THAN 501 RL1094.2 +052500 ADD 1 TO WRK-CS-09V00-004 RL1094.2 +052600 GO TO REL-TEST-004-R. RL1094.2 +052700 PERFORM PASS. RL1094.2 +052800 PERFORM PRINT-DETAIL. RL1094.2 +052900* RL1094.2 +053000*01 RL1094.2 +053100* RL1094.2 +053200 ADD 1 TO REC-CT. RL1094.2 +053300 GO TO REL-TEST-004-3. RL1094.2 +053400 REL-TEST-004-2. RL1094.2 +053500 ADD 1 TO WRK-CS-09V00-005. RL1094.2 +053600 IF RL-FR1-KEY LESS 501 RL1094.2 +053700 GO TO REL-TEST-004-R. RL1094.2 +053800 REL-TEST-004-3. RL1094.2 +053900 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO RL1094.2 +054000 MOVE "INVALID KEY ON READ" TO COMPUTED-A RL1094.2 +054100 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL1094.2 +054200 PERFORM FAIL RL1094.2 +054300 ELSE RL1094.2 +054400 PERFORM PASS. RL1094.2 +054500 PERFORM PRINT-DETAIL. RL1094.2 +054600* RL1094.2 +054700*02 RL1094.2 +054800* RL1094.2 +054900 ADD 1 TO REC-CT. RL1094.2 +055000 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO RL1094.2 +055100 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A RL1094.2 +055200 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL1094.2 +055300 PERFORM FAIL RL1094.2 +055400 ELSE RL1094.2 +055500 PERFORM PASS. RL1094.2 +055600 PERFORM PRINT-DETAIL. RL1094.2 +055700* RL1094.2 +055800*03 RL1094.2 +055900* RL1094.2 +056000 ADD 1 TO REC-CT. RL1094.2 +056100 CLOSE RL-FR1. RL1094.2 +056200 REL-INIT-005. RL1094.2 +056300 MOVE "VIII-26 4.5.4" TO ANSI-REFERENCE. RL1094.2 +056400 MOVE "REL-TEST-005" TO PAR-NAME. RL1094.2 +056500 OPEN INPUT RL-FR1. RL1094.2 +056600 MOVE 501 TO WRK-CS-09V00-003. RL1094.2 +056700 MOVE ZERO TO WRK-CS-09V00-004. RL1094.2 +056800 MOVE ZERO TO WRK-CS-09V00-005. RL1094.2 +056900 MOVE ZERO TO WRK-CS-09V00-002. RL1094.2 +057000 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1094.2 +057100 MOVE 01 TO REC-CT. RL1094.2 +057200* RL1094.2 +057300 MOVE "READ RANDOM" TO FEATURE. RL1094.2 +057400 REL-TEST-005-R. RL1094.2 +057500 SUBTRACT 1 FROM WRK-CS-09V00-003. RL1094.2 +057600 MOVE WRK-CS-09V00-003 TO RL-FR1-KEY. RL1094.2 +057700 IF WRK-CS-09V00-003 LESS THAN ZERO RL1094.2 +057800 MOVE "INVALID KEY/NOT TAKEN" TO RE-MARK RL1094.2 +057900 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL1094.2 +058000 MOVE ZERO TO CORRECT-18V0 RL1094.2 +058100 PERFORM FAIL RL1094.2 +058200 PERFORM PRINT-DETAIL RL1094.2 +058300 ADD 1 TO REC-CT RL1094.2 +058400 GO TO REL-TEST-005-3. RL1094.2 +058500 READ RL-FR1 RL1094.2 +058600 INVALID KEY GO TO REL-TEST-005-1 RL1094.2 +058700 NOT INVALID KEY GO TO REL-TEST-005-A RL1094.2 +058800 END-READ. RL1094.2 +058900 REL-TEST-005-A. RL1094.2 +059000 MOVE RL-FR1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1094.2 +059100 IF UPDATE-NUMBER (1) EQUAL TO 00 RL1094.2 +059200 ADD 1 TO WRK-CS-09V00-004. RL1094.2 +059300 IF UPDATE-NUMBER (1) EQUAL TO 01 RL1094.2 +059400 ADD 1 TO WRK-CS-09V00-005. RL1094.2 +059500 GO TO REL-TEST-005-R. RL1094.2 +059600 REL-TEST-005-1. RL1094.2 +059700 IF RL-FR1-KEY GREATER ZERO RL1094.2 +059800 ADD 1 TO WRK-CS-09V00-002 RL1094.2 +059900 GO TO REL-TEST-005-R. RL1094.2 +060000 PERFORM PASS. RL1094.2 +060100 PERFORM PRINT-DETAIL. RL1094.2 +060200 ADD 1 TO REC-CT. RL1094.2 +060300*01 RL1094.2 +060400 GO TO REL-TEST-005-3. RL1094.2 +060500 REL-TEST-005-3. RL1094.2 +060600 IF WRK-CS-09V00-004 NOT EQUAL TO 400 RL1094.2 +060700 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL1094.2 +060800 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL1094.2 +060900 MOVE "SHOULD BE 400" TO RE-MARK RL1094.2 +061000 PERFORM FAIL RL1094.2 +061100 ELSE RL1094.2 +061200 PERFORM PASS. RL1094.2 +061300 PERFORM PRINT-DETAIL. RL1094.2 +061400* RL1094.2 +061500* RL1094.2 +061600*02 RL1094.2 +061700* RL1094.2 +061800 ADD 1 TO REC-CT. RL1094.2 +061900 IF WRK-CS-09V00-005 NOT EQUAL TO 100 RL1094.2 +062000 MOVE "UPDATED RECORDS" TO COMPUTED-A RL1094.2 +062100 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL1094.2 +062200 MOVE "SHOULD BE 100" TO RE-MARK RL1094.2 +062300 PERFORM FAIL RL1094.2 +062400 ELSE RL1094.2 +062500 PERFORM PASS. RL1094.2 +062600 PERFORM PRINT-DETAIL. RL1094.2 +062700* RL1094.2 +062800*03 RL1094.2 +062900* RL1094.2 +063000 ADD 1 TO REC-CT. RL1094.2 +063100 IF WRK-CS-09V00-002 GREATER 1 RL1094.2 +063200 MOVE WRK-CS-09V00-002 TO COMPUTED-N RL1094.2 +063300 MOVE "INVALID KEY/READS" TO CORRECT-A RL1094.2 +063400 PERFORM FAIL RL1094.2 +063500 ELSE RL1094.2 +063600 PERFORM PASS. RL1094.2 +063700 PERFORM PRINT-DETAIL. RL1094.2 +063800* RL1094.2 +063900*04 RL1094.2 +064000* RL1094.2 +064100 ADD 1 TO REC-CT. RL1094.2 +064200 CLOSE RL-FR1. RL1094.2 +064300 CCVS-EXIT SECTION. RL1094.2 +064400 CCVS-999999. RL1094.2 +064500 GO TO CLOSE-FILES. RL1094.2 diff --git a/tests/cobol85/RL/RL110A.SUB b/tests/cobol85/RL/RL110A.SUB new file mode 100644 index 00000000..94eec9d6 --- /dev/null +++ b/tests/cobol85/RL/RL110A.SUB @@ -0,0 +1,622 @@ +000100 IDENTIFICATION DIVISION. RL1104.2 +000200 PROGRAM-ID. RL1104.2 +000300 RL110A. RL1104.2 +000400**************************************************************** RL1104.2 +000500* * RL1104.2 +000600* VALIDATION FOR:- * RL1104.2 +000700* * RL1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1104.2 +000900* * RL1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1104.2 +001100* * RL1104.2 +001200**************************************************************** RL1104.2 +001300*GENERAL: THIS PROGRAM IS THE THIRD OF A SERIES. THE FUNCTION RL1104.2 +001400* OF THIS PROGRAM IS TO PROCESS THE FILE SEQUENTIALLY RL1104.2 +001500* (ACCESS MODE IS SEQUENTIAL). THE FILE USED IS THAT RL1104.2 +001600* RESULTING FROM RL109A. RL1104.2 +001700* RL1104.2 +001800* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RL1104.2 +001900* RECORDS. SECONDLY, RECORDS OF THER FILE ARE RL1104.2 +002000* SELECTIVELY DELETED AND THIRDLY THE ACCURACY OF EACH RL1104.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL1104.2 +002200* RL1104.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL1104.2 +002400* PROGRAM ARE: RL1104.2 +002500* RL1104.2 +002600* RL1104.2 +002700* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL1104.2 +002800* RELATIVE I-O DATA FILE RL1104.2 +002900* X-55 SYSTEM PRINTER RL1104.2 +003000* X-69 ADDITIONAL VALUE OF CLAUSES RL1104.2 +003100* X-74 VALUE OF IMPLEMENTOR-NAME RL1104.2 +003200* X-75 OBJECT OF VALUE OF CLAUSE RL1104.2 +003300* X-82 SOURCE-COMPUTER RL1104.2 +003400* X-83 OBJECT-COMPUTER. RL1104.2 +003500* RL1104.2 +003600*************************************************** RL1104.2 +003700 ENVIRONMENT DIVISION. RL1104.2 +003800 CONFIGURATION SECTION. RL1104.2 +003900 SOURCE-COMPUTER. RL1104.2 +004000 Linux. RL1104.2 +004100 OBJECT-COMPUTER. RL1104.2 +004200 Linux. RL1104.2 +004300 INPUT-OUTPUT SECTION. RL1104.2 +004400 FILE-CONTROL. RL1104.2 +004500 SELECT PRINT-FILE ASSIGN TO RL1104.2 +004600 "report.log". RL1104.2 +004700 SELECT RL-FS1 ASSIGN TO RL1104.2 +004800 "XXXXX061" RL1104.2 +004900 ORGANIZATION IS RELATIVE RL1104.2 +005000 ACCESS MODE IS SEQUENTIAL RL1104.2 +005100 RELATIVE KEY IS RL-FS1-KEY. RL1104.2 +005200 DATA DIVISION. RL1104.2 +005300 FILE SECTION. RL1104.2 +005400 FD PRINT-FILE. RL1104.2 +005500 01 PRINT-REC PICTURE X(120). RL1104.2 +005600 01 DUMMY-RECORD PICTURE X(120). RL1104.2 +005700 FD RL-FS1 RL1104.2 +005800 LABEL RECORDS STANDARD RL1104.2 +005900*C VALUE OF RL1104.2 +006000*C OCLABELID RL1104.2 +006100*C IS RL1104.2 +006200*C "OCDUMMY" RL1104.2 +006300*G SYSIN RL1104.2 +006400 BLOCK CONTAINS 01 RECORDS RL1104.2 +006500 RECORD CONTAINS 120. RL1104.2 +006600 01 RL-FS1R1-F-G-120. RL1104.2 +006700 02 RL-WRK-120 PIC X(120). RL1104.2 +006800 WORKING-STORAGE SECTION. RL1104.2 +006900 01 RL-FS1-KEY PIC 9(08) USAGE COMP VALUE ZERO. RL1104.2 +007000 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007100 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007200 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007300 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007400 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007500 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. RL1104.2 +007600 01 I-O-ERROR-RL-FS1 PIC X(3) VALUE "NO ". RL1104.2 +007700 01 FILE-RECORD-INFORMATION-REC. RL1104.2 +007800 03 FILE-RECORD-INFO-SKELETON. RL1104.2 +007900 05 FILLER PICTURE X(48) VALUE RL1104.2 +008000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1104.2 +008100 05 FILLER PICTURE X(46) VALUE RL1104.2 +008200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1104.2 +008300 05 FILLER PICTURE X(26) VALUE RL1104.2 +008400 ",LFIL=000000,ORG= ,LBLR= ". RL1104.2 +008500 05 FILLER PICTURE X(37) VALUE RL1104.2 +008600 ",RECKEY= ". RL1104.2 +008700 05 FILLER PICTURE X(38) VALUE RL1104.2 +008800 ",ALTKEY1= ". RL1104.2 +008900 05 FILLER PICTURE X(38) VALUE RL1104.2 +009000 ",ALTKEY2= ". RL1104.2 +009100 05 FILLER PICTURE X(7) VALUE SPACE.RL1104.2 +009200 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1104.2 +009300 05 FILE-RECORD-INFO-P1-120. RL1104.2 +009400 07 FILLER PIC X(5). RL1104.2 +009500 07 XFILE-NAME PIC X(6). RL1104.2 +009600 07 FILLER PIC X(8). RL1104.2 +009700 07 XRECORD-NAME PIC X(6). RL1104.2 +009800 07 FILLER PIC X(1). RL1104.2 +009900 07 REELUNIT-NUMBER PIC 9(1). RL1104.2 +010000 07 FILLER PIC X(7). RL1104.2 +010100 07 XRECORD-NUMBER PIC 9(6). RL1104.2 +010200 07 FILLER PIC X(6). RL1104.2 +010300 07 UPDATE-NUMBER PIC 9(2). RL1104.2 +010400 07 FILLER PIC X(5). RL1104.2 +010500 07 ODO-NUMBER PIC 9(4). RL1104.2 +010600 07 FILLER PIC X(5). RL1104.2 +010700 07 XPROGRAM-NAME PIC X(5). RL1104.2 +010800 07 FILLER PIC X(7). RL1104.2 +010900 07 XRECORD-LENGTH PIC 9(6). RL1104.2 +011000 07 FILLER PIC X(7). RL1104.2 +011100 07 CHARS-OR-RECORDS PIC X(2). RL1104.2 +011200 07 FILLER PIC X(1). RL1104.2 +011300 07 XBLOCK-SIZE PIC 9(4). RL1104.2 +011400 07 FILLER PIC X(6). RL1104.2 +011500 07 RECORDS-IN-FILE PIC 9(6). RL1104.2 +011600 07 FILLER PIC X(5). RL1104.2 +011700 07 XFILE-ORGANIZATION PIC X(2). RL1104.2 +011800 07 FILLER PIC X(6). RL1104.2 +011900 07 XLABEL-TYPE PIC X(1). RL1104.2 +012000 05 FILE-RECORD-INFO-P121-240. RL1104.2 +012100 07 FILLER PIC X(8). RL1104.2 +012200 07 XRECORD-KEY PIC X(29). RL1104.2 +012300 07 FILLER PIC X(9). RL1104.2 +012400 07 ALTERNATE-KEY1 PIC X(29). RL1104.2 +012500 07 FILLER PIC X(9). RL1104.2 +012600 07 ALTERNATE-KEY2 PIC X(29). RL1104.2 +012700 07 FILLER PIC X(7). RL1104.2 +012800 01 TEST-RESULTS. RL1104.2 +012900 02 FILLER PIC X VALUE SPACE. RL1104.2 +013000 02 FEATURE PIC X(20) VALUE SPACE. RL1104.2 +013100 02 FILLER PIC X VALUE SPACE. RL1104.2 +013200 02 P-OR-F PIC X(5) VALUE SPACE. RL1104.2 +013300 02 FILLER PIC X VALUE SPACE. RL1104.2 +013400 02 PAR-NAME. RL1104.2 +013500 03 FILLER PIC X(19) VALUE SPACE. RL1104.2 +013600 03 PARDOT-X PIC X VALUE SPACE. RL1104.2 +013700 03 DOTVALUE PIC 99 VALUE ZERO. RL1104.2 +013800 02 FILLER PIC X(8) VALUE SPACE. RL1104.2 +013900 02 RE-MARK PIC X(61). RL1104.2 +014000 01 TEST-COMPUTED. RL1104.2 +014100 02 FILLER PIC X(30) VALUE SPACE. RL1104.2 +014200 02 FILLER PIC X(17) VALUE RL1104.2 +014300 " COMPUTED=". RL1104.2 +014400 02 COMPUTED-X. RL1104.2 +014500 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1104.2 +014600 03 COMPUTED-N REDEFINES COMPUTED-A RL1104.2 +014700 PIC -9(9).9(9). RL1104.2 +014800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1104.2 +014900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1104.2 +015000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1104.2 +015100 03 CM-18V0 REDEFINES COMPUTED-A. RL1104.2 +015200 04 COMPUTED-18V0 PIC -9(18). RL1104.2 +015300 04 FILLER PIC X. RL1104.2 +015400 03 FILLER PIC X(50) VALUE SPACE. RL1104.2 +015500 01 TEST-CORRECT. RL1104.2 +015600 02 FILLER PIC X(30) VALUE SPACE. RL1104.2 +015700 02 FILLER PIC X(17) VALUE " CORRECT =". RL1104.2 +015800 02 CORRECT-X. RL1104.2 +015900 03 CORRECT-A PIC X(20) VALUE SPACE. RL1104.2 +016000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1104.2 +016100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1104.2 +016200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1104.2 +016300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1104.2 +016400 03 CR-18V0 REDEFINES CORRECT-A. RL1104.2 +016500 04 CORRECT-18V0 PIC -9(18). RL1104.2 +016600 04 FILLER PIC X. RL1104.2 +016700 03 FILLER PIC X(2) VALUE SPACE. RL1104.2 +016800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1104.2 +016900 01 CCVS-C-1. RL1104.2 +017000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1104.2 +017100- "SS PARAGRAPH-NAME RL1104.2 +017200- " REMARKS". RL1104.2 +017300 02 FILLER PIC X(20) VALUE SPACE. RL1104.2 +017400 01 CCVS-C-2. RL1104.2 +017500 02 FILLER PIC X VALUE SPACE. RL1104.2 +017600 02 FILLER PIC X(6) VALUE "TESTED". RL1104.2 +017700 02 FILLER PIC X(15) VALUE SPACE. RL1104.2 +017800 02 FILLER PIC X(4) VALUE "FAIL". RL1104.2 +017900 02 FILLER PIC X(94) VALUE SPACE. RL1104.2 +018000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1104.2 +018100 01 REC-CT PIC 99 VALUE ZERO. RL1104.2 +018200 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1104.2 +018300 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1104.2 +018400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1104.2 +018500 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1104.2 +018600 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1104.2 +018700 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1104.2 +018800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1104.2 +018900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1104.2 +019000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1104.2 +019100 01 CCVS-H-1. RL1104.2 +019200 02 FILLER PIC X(39) VALUE SPACES. RL1104.2 +019300 02 FILLER PIC X(42) VALUE RL1104.2 +019400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1104.2 +019500 02 FILLER PIC X(39) VALUE SPACES. RL1104.2 +019600 01 CCVS-H-2A. RL1104.2 +019700 02 FILLER PIC X(40) VALUE SPACE. RL1104.2 +019800 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1104.2 +019900 02 FILLER PIC XXXX VALUE RL1104.2 +020000 "4.2 ". RL1104.2 +020100 02 FILLER PIC X(28) VALUE RL1104.2 +020200 " COPY - NOT FOR DISTRIBUTION". RL1104.2 +020300 02 FILLER PIC X(41) VALUE SPACE. RL1104.2 +020400 RL1104.2 +020500 01 CCVS-H-2B. RL1104.2 +020600 02 FILLER PIC X(15) VALUE RL1104.2 +020700 "TEST RESULT OF ". RL1104.2 +020800 02 TEST-ID PIC X(9). RL1104.2 +020900 02 FILLER PIC X(4) VALUE RL1104.2 +021000 " IN ". RL1104.2 +021100 02 FILLER PIC X(12) VALUE RL1104.2 +021200 " HIGH ". RL1104.2 +021300 02 FILLER PIC X(22) VALUE RL1104.2 +021400 " LEVEL VALIDATION FOR ". RL1104.2 +021500 02 FILLER PIC X(58) VALUE RL1104.2 +021600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1104.2 +021700 01 CCVS-H-3. RL1104.2 +021800 02 FILLER PIC X(34) VALUE RL1104.2 +021900 " FOR OFFICIAL USE ONLY ". RL1104.2 +022000 02 FILLER PIC X(58) VALUE RL1104.2 +022100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1104.2 +022200 02 FILLER PIC X(28) VALUE RL1104.2 +022300 " COPYRIGHT 1985 ". RL1104.2 +022400 01 CCVS-E-1. RL1104.2 +022500 02 FILLER PIC X(52) VALUE SPACE. RL1104.2 +022600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1104.2 +022700 02 ID-AGAIN PIC X(9). RL1104.2 +022800 02 FILLER PIC X(45) VALUE SPACES. RL1104.2 +022900 01 CCVS-E-2. RL1104.2 +023000 02 FILLER PIC X(31) VALUE SPACE. RL1104.2 +023100 02 FILLER PIC X(21) VALUE SPACE. RL1104.2 +023200 02 CCVS-E-2-2. RL1104.2 +023300 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1104.2 +023400 03 FILLER PIC X VALUE SPACE. RL1104.2 +023500 03 ENDER-DESC PIC X(44) VALUE RL1104.2 +023600 "ERRORS ENCOUNTERED". RL1104.2 +023700 01 CCVS-E-3. RL1104.2 +023800 02 FILLER PIC X(22) VALUE RL1104.2 +023900 " FOR OFFICIAL USE ONLY". RL1104.2 +024000 02 FILLER PIC X(12) VALUE SPACE. RL1104.2 +024100 02 FILLER PIC X(58) VALUE RL1104.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1104.2 +024300 02 FILLER PIC X(13) VALUE SPACE. RL1104.2 +024400 02 FILLER PIC X(15) VALUE RL1104.2 +024500 " COPYRIGHT 1985". RL1104.2 +024600 01 CCVS-E-4. RL1104.2 +024700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1104.2 +024800 02 FILLER PIC X(4) VALUE " OF ". RL1104.2 +024900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1104.2 +025000 02 FILLER PIC X(40) VALUE RL1104.2 +025100 " TESTS WERE EXECUTED SUCCESSFULLY". RL1104.2 +025200 01 XXINFO. RL1104.2 +025300 02 FILLER PIC X(19) VALUE RL1104.2 +025400 "*** INFORMATION ***". RL1104.2 +025500 02 INFO-TEXT. RL1104.2 +025600 04 FILLER PIC X(8) VALUE SPACE. RL1104.2 +025700 04 XXCOMPUTED PIC X(20). RL1104.2 +025800 04 FILLER PIC X(5) VALUE SPACE. RL1104.2 +025900 04 XXCORRECT PIC X(20). RL1104.2 +026000 02 INF-ANSI-REFERENCE PIC X(48). RL1104.2 +026100 01 HYPHEN-LINE. RL1104.2 +026200 02 FILLER PIC IS X VALUE IS SPACE. RL1104.2 +026300 02 FILLER PIC IS X(65) VALUE IS "************************RL1104.2 +026400- "*****************************************". RL1104.2 +026500 02 FILLER PIC IS X(54) VALUE IS "************************RL1104.2 +026600- "******************************". RL1104.2 +026700 01 CCVS-PGM-ID PIC X(9) VALUE RL1104.2 +026800 "RL110A". RL1104.2 +026900 PROCEDURE DIVISION. RL1104.2 +027000 CCVS1 SECTION. RL1104.2 +027100 OPEN-FILES. RL1104.2 +027200 OPEN OUTPUT PRINT-FILE. RL1104.2 +027300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1104.2 +027400 MOVE SPACE TO TEST-RESULTS. RL1104.2 +027500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1104.2 +027600 MOVE ZERO TO REC-SKL-SUB. RL1104.2 +027700 PERFORM CCVS-INIT-FILE 9 TIMES. RL1104.2 +027800 CCVS-INIT-FILE. RL1104.2 +027900 ADD 1 TO REC-SKL-SUB. RL1104.2 +028000 MOVE FILE-RECORD-INFO-SKELETON RL1104.2 +028100 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1104.2 +028200 CCVS-INIT-EXIT. RL1104.2 +028300 GO TO CCVS1-EXIT. RL1104.2 +028400 CLOSE-FILES. RL1104.2 +028500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1104.2 +028600 TERMINATE-CCVS. RL1104.2 +028700*S EXIT PROGRAM. RL1104.2 +028800*SERMINATE-CALL. RL1104.2 +028900 STOP RUN. RL1104.2 +029000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1104.2 +029100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1104.2 +029200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1104.2 +029300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1104.2 +029400 MOVE "****TEST DELETED****" TO RE-MARK. RL1104.2 +029500 PRINT-DETAIL. RL1104.2 +029600 IF REC-CT NOT EQUAL TO ZERO RL1104.2 +029700 MOVE "." TO PARDOT-X RL1104.2 +029800 MOVE REC-CT TO DOTVALUE. RL1104.2 +029900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1104.2 +030000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1104.2 +030100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1104.2 +030200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1104.2 +030300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1104.2 +030400 MOVE SPACE TO CORRECT-X. RL1104.2 +030500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1104.2 +030600 MOVE SPACE TO RE-MARK. RL1104.2 +030700 HEAD-ROUTINE. RL1104.2 +030800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +030900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +031000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1104.2 +031100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1104.2 +031200 COLUMN-NAMES-ROUTINE. RL1104.2 +031300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +031400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +031500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +031600 END-ROUTINE. RL1104.2 +031700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1104.2 +031800 END-RTN-EXIT. RL1104.2 +031900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +032000 END-ROUTINE-1. RL1104.2 +032100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1104.2 +032200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1104.2 +032300 ADD PASS-COUNTER TO ERROR-HOLD. RL1104.2 +032400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1104.2 +032500 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1104.2 +032600 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1104.2 +032700 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1104.2 +032800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1104.2 +032900 END-ROUTINE-12. RL1104.2 +033000 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1104.2 +033100 IF ERROR-COUNTER IS EQUAL TO ZERO RL1104.2 +033200 MOVE "NO " TO ERROR-TOTAL RL1104.2 +033300 ELSE RL1104.2 +033400 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1104.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1104.2 +033600 PERFORM WRITE-LINE. RL1104.2 +033700 END-ROUTINE-13. RL1104.2 +033800 IF DELETE-COUNTER IS EQUAL TO ZERO RL1104.2 +033900 MOVE "NO " TO ERROR-TOTAL ELSE RL1104.2 +034000 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1104.2 +034100 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1104.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +034300 IF INSPECT-COUNTER EQUAL TO ZERO RL1104.2 +034400 MOVE "NO " TO ERROR-TOTAL RL1104.2 +034500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1104.2 +034600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1104.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +034800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1104.2 +034900 WRITE-LINE. RL1104.2 +035000 ADD 1 TO RECORD-COUNT. RL1104.2 +035100 IF RECORD-COUNT GREATER 50 RL1104.2 +035200 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1104.2 +035300 MOVE SPACE TO DUMMY-RECORD RL1104.2 +035400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1104.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1104.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1104.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1104.2 +035800 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1104.2 +035900 MOVE ZERO TO RECORD-COUNT. RL1104.2 +036000 PERFORM WRT-LN. RL1104.2 +036100 WRT-LN. RL1104.2 +036200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1104.2 +036300 MOVE SPACE TO DUMMY-RECORD. RL1104.2 +036400 BLANK-LINE-PRINT. RL1104.2 +036500 PERFORM WRT-LN. RL1104.2 +036600 FAIL-ROUTINE. RL1104.2 +036700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL1104.2 +036800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1104.2 +036900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1104.2 +037000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1104.2 +037100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +037200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1104.2 +037300 GO TO FAIL-ROUTINE-EX. RL1104.2 +037400 FAIL-ROUTINE-WRITE. RL1104.2 +037500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1104.2 +037600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1104.2 +037700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1104.2 +037800 MOVE SPACES TO COR-ANSI-REFERENCE. RL1104.2 +037900 FAIL-ROUTINE-EX. EXIT. RL1104.2 +038000 BAIL-OUT. RL1104.2 +038100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1104.2 +038200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1104.2 +038300 BAIL-OUT-WRITE. RL1104.2 +038400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1104.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1104.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1104.2 +038700 MOVE SPACES TO INF-ANSI-REFERENCE. RL1104.2 +038800 BAIL-OUT-EX. EXIT. RL1104.2 +038900 CCVS1-EXIT. RL1104.2 +039000 EXIT. RL1104.2 +039100 SECT-RL110A-001 SECTION. RL1104.2 +039200 REL-INIT-006. RL1104.2 +039300 MOVE 99 TO RL-FS1-KEY. RL1104.2 +039400* THIS FILE "RL-FS1" IS ACCESSED SEQUENTIALLY AND HAS RL1104.2 +039500* ASSOCIATED WITH IT A RELATIVE KEY WHICH AT ALL TIMES SHOULD RL1104.2 +039600* CONTAIN THE NUMBER OF THE RECORD PREVIOUSLY READ. RL1104.2 +039700 OPEN INPUT RL-FS1. RL1104.2 +039800 MOVE "REL-TEST-006" TO PAR-NAME. RL1104.2 +039900 MOVE "VII-26 4.5.4" TO ANSI-REFERENCE. RL1104.2 +040000 MOVE ZERO TO WRK-CS-09V00-006. RL1104.2 +040100 MOVE ZERO TO WRK-CS-09V00-007. RL1104.2 +040200 MOVE ZERO TO WRK-CS-09V00-008. RL1104.2 +040300 MOVE ZERO TO WRK-CS-09V00-009. RL1104.2 +040400 MOVE ZERO TO WRK-CS-09V00-010. RL1104.2 +040500 MOVE ZERO TO WRK-CS-09V00-011. RL1104.2 +040600 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +040700 MOVE RL-FS1-KEY TO WRK-CS-09V00-011. RL1104.2 +040800 MOVE 01 TO REC-CT. RL1104.2 +040900 MOVE "READ SEQUENTIAL" TO FEATURE. RL1104.2 +041000 REL-TEST-006-R. RL1104.2 +041100 ADD 1 TO WRK-CS-09V00-006. RL1104.2 +041200 READ RL-FS1 RL1104.2 +041300 END GO TO REL-TEST-006-3 RL1104.2 +041400 NOT AT END GO TO REL-TEST-006-A RL1104.2 +041500 END-READ. RL1104.2 +041600 REL-TEST-006-A. RL1104.2 +041700 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +041800 IF UPDATE-NUMBER (1) EQUAL TO 00 RL1104.2 +041900 ADD 1 TO WRK-CS-09V00-007 RL1104.2 +042000 GO TO REL-TEST-006-2. RL1104.2 +042100 IF UPDATE-NUMBER (1) EQUAL TO 01 RL1104.2 +042200 ADD 1 TO WRK-CS-09V00-008 RL1104.2 +042300 GO TO REL-TEST-006-2. RL1104.2 +042400 ADD 1 TO WRK-CS-09V00-009. RL1104.2 +042500 REL-TEST-006-2. RL1104.2 +042600 IF RL-FS1-KEY NOT EQUAL TO XRECORD-NUMBER (1) RL1104.2 +042700 ADD 1 TO WRK-CS-09V00-010. RL1104.2 +042800 IF WRK-CS-09V00-006 GREATER 501 RL1104.2 +042900 GO TO REL-TEST-006-3. RL1104.2 +043000 GO TO REL-TEST-006-R. RL1104.2 +043100 REL-TEST-006-3. RL1104.2 +043200 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL1104.2 +043300 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1104.2 +043400 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1104.2 +043500 MOVE 501 TO CORRECT-18V0 RL1104.2 +043600 PERFORM FAIL RL1104.2 +043700 ELSE RL1104.2 +043800 PERFORM PASS. RL1104.2 +043900 PERFORM PRINT-DETAIL. RL1104.2 +044000* .01 RL1104.2 +044100 ADD 1 TO REC-CT. RL1104.2 +044200 IF WRK-CS-09V00-007 EQUAL TO 400 RL1104.2 +044300 PERFORM PASS RL1104.2 +044400 ELSE RL1104.2 +044500 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL1104.2 +044600 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 RL1104.2 +044700 MOVE "SHOULD BE 400" TO RE-MARK RL1104.2 +044800 PERFORM FAIL. RL1104.2 +044900 PERFORM PRINT-DETAIL. RL1104.2 +045000 ADD 1 TO REC-CT. RL1104.2 +045100* .02 RL1104.2 +045200 IF WRK-CS-09V00-008 EQUAL TO 100 RL1104.2 +045300 PERFORM PASS RL1104.2 +045400 ELSE RL1104.2 +045500 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL1104.2 +045600 MOVE 100 TO CORRECT-18V0 RL1104.2 +045700 MOVE "UPDATED RECORDS" TO RE-MARK RL1104.2 +045800 PERFORM FAIL. RL1104.2 +045900 PERFORM PRINT-DETAIL. RL1104.2 +046000 ADD 1 TO REC-CT. RL1104.2 +046100* .03 RL1104.2 +046200 IF WRK-CS-09V00-009 EQUAL TO ZERO RL1104.2 +046300 PERFORM PASS RL1104.2 +046400 ELSE RL1104.2 +046500 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL1104.2 +046600 MOVE ZERO TO CORRECT-18V0 RL1104.2 +046700 MOVE "BAD-UPDATES" TO RE-MARK RL1104.2 +046800 PERFORM FAIL. RL1104.2 +046900 PERFORM PRINT-DETAIL. RL1104.2 +047000 ADD 01 TO REC-CT. RL1104.2 +047100* .04 RL1104.2 +047200 IF WRK-CS-09V00-010 EQUAL TO ZERO RL1104.2 +047300 PERFORM PASS RL1104.2 +047400 ELSE RL1104.2 +047500 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL1104.2 +047600 MOVE ZERO TO CORRECT-18V0 RL1104.2 +047700 MOVE "KEY VS RECORD" TO RE-MARK RL1104.2 +047800 PERFORM FAIL. RL1104.2 +047900 PERFORM PRINT-DETAIL. RL1104.2 +048000 ADD 01 TO REC-CT. RL1104.2 +048100* .05 RL1104.2 +048200 MOVE WRK-CS-09V00-011 TO RL-FS1-KEY. RL1104.2 +048300 MOVE RL-FS1-KEY TO COMPUTED-18V0. RL1104.2 +048400 MOVE "INFORMATION" TO CORRECT-A. RL1104.2 +048500 MOVE "STATUS AFTER OPEN" TO RE-MARK. RL1104.2 +048600 PERFORM PRINT-DETAIL. RL1104.2 +048700 ADD 01 TO REC-CT. RL1104.2 +048800* .06 RL1104.2 +048900 CLOSE RL-FS1. RL1104.2 +049000 REL-INIT-007. RL1104.2 +049100 MOVE "REL-TEST-007" TO PAR-NAME RL1104.2 +049200 MOVE "VII-26 4.5.4" TO ANSI-REFERENCE. RL1104.2 +049300 OPEN I-O RL-FS1. RL1104.2 +049400 MOVE ZERO TO WRK-CS-09V00-006 RL1104.2 +049500 MOVE ZERO TO WRK-CS-09V00-007 RL1104.2 +049600 MOVE ZERO TO WRK-CS-09V00-008 RL1104.2 +049700 MOVE ZERO TO WRK-CS-09V00-009 RL1104.2 +049800 MOVE ZERO TO WRK-CS-09V00-010 RL1104.2 +049900 MOVE ZERO TO WRK-CS-09V00-011 RL1104.2 +050000 MOVE 01 TO REC-CT. RL1104.2 +050100 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +050200 MOVE "DELETE" TO FEATURE. RL1104.2 +050300 REL-TEST-007-R. RL1104.2 +050400 ADD 1 TO WRK-CS-09V00-006 RL1104.2 +050500 ADD 1 TO WRK-CS-09V00-007. RL1104.2 +050600 READ RL-FS1 RL1104.2 +050700 AT END RL1104.2 +050800 MOVE "AT END PATH TAKEN " TO RE-MARK RL1104.2 +050900 GO TO REL-TEST-007-3 RL1104.2 +051000 NOT AT END RL1104.2 +051100 GO TO REL-TEST-007-A RL1104.2 +051200 END-READ. RL1104.2 +051300 REL-TEST-007-A. RL1104.2 +051400 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +051500 IF WRK-CS-09V00-007 EQUAL TO 4 RL1104.2 +051600 GO TO REL-TEST-007-2. RL1104.2 +051700 IF WRK-CS-09V00-006 GREATER 501 RL1104.2 +051800 MOVE "AT END NOT TAKEN" TO RE-MARK RL1104.2 +051900 GO TO REL-TEST-007-3. RL1104.2 +052000 GO TO REL-TEST-007-R. RL1104.2 +052100 REL-TEST-007-2. RL1104.2 +052200 MOVE "VII-19 4.3.4" TO ANSI-REFERENCE. RL1104.2 +052300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL1104.2 +052400 MOVE 99 TO UPDATE-NUMBER (1). RL1104.2 +052500 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL1104.2 +052600 DELETE RL-FS1 RL1104.2 +052700 END-DELETE. RL1104.2 +052800 REL-TEST-007-2-A. RL1104.2 +052900 MOVE ZERO TO WRK-CS-09V00-007. RL1104.2 +053000 ADD 1 TO WRK-CS-09V00-008. RL1104.2 +053100 GO TO REL-TEST-007-R. RL1104.2 +053200 REL-TEST-007-3. RL1104.2 +053300 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL1104.2 +053400 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1104.2 +053500 MOVE 501 TO CORRECT-18V0 RL1104.2 +053600 PERFORM FAIL RL1104.2 +053700 ELSE RL1104.2 +053800 PERFORM PASS. RL1104.2 +053900 PERFORM PRINT-DETAIL. RL1104.2 +054000 ADD 01 TO REC-CT. RL1104.2 +054100 CLOSE RL-FS1. RL1104.2 +054200 REL-INIT-008. RL1104.2 +054300 MOVE "REL-TEST-008" TO PAR-NAME. RL1104.2 +054400 MOVE "VII-26 4.5.4" TO ANSI-REFERENCE. RL1104.2 +054500 MOVE ZERO TO WRK-CS-09V00-006 RL1104.2 +054600 MOVE ZERO TO WRK-CS-09V00-007 RL1104.2 +054700 MOVE ZERO TO WRK-CS-09V00-008 RL1104.2 +054800 MOVE ZERO TO WRK-CS-09V00-009 RL1104.2 +054900 MOVE ZERO TO WRK-CS-09V00-010 RL1104.2 +055000 MOVE ZERO TO WRK-CS-09V00-011 RL1104.2 +055100 MOVE 01 TO REC-CT. RL1104.2 +055200 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +055300 MOVE ZERO TO RL-FS1-KEY. RL1104.2 +055400 OPEN INPUT RL-FS1. RL1104.2 +055500 MOVE "READ UPDATED FILE" TO FEATURE. RL1104.2 +055600 REL-TEST-008-R. RL1104.2 +055700 ADD 1 TO WRK-CS-09V00-006. RL1104.2 +055800 ADD 1 TO WRK-CS-09V00-007. RL1104.2 +055900 ADD 1 TO WRK-CS-09V00-008. RL1104.2 +056000 READ RL-FS1 RL1104.2 +056100 AT END GO TO REL-TEST-008-3 RL1104.2 +056200 NOT AT END GO TO REL-TEST-008-A RL1104.2 +056300 END-READ. RL1104.2 +056400 REL-TEST-008-A. RL1104.2 +056500 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL1104.2 +056600 IF UPDATE-NUMBER (1) EQUAL TO 99 RL1104.2 +056700 ADD 1 TO WRK-CS-09V00-009. RL1104.2 +056800 IF WRK-CS-09V00-007 EQUAL TO 4 RL1104.2 +056900 MOVE 01 TO WRK-CS-09V00-007 RL1104.2 +057000 ADD 1 TO WRK-CS-09V00-008. RL1104.2 +057100 IF RL-FS1-KEY EQUAL TO XRECORD-NUMBER (1) RL1104.2 +057200 ADD 1 TO WRK-CS-09V00-010. RL1104.2 +057300 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 RL1104.2 +057400 ADD 1 TO WRK-CS-09V00-011. RL1104.2 +057500 IF WRK-CS-09V00-006 GREATER 501 RL1104.2 +057600 GO TO REL-TEST-008-3. RL1104.2 +057700 GO TO REL-TEST-008-R. RL1104.2 +057800 REL-TEST-008-3. RL1104.2 +057900 IF WRK-CS-09V00-006 NOT EQUAL TO 376 RL1104.2 +058000 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL1104.2 +058100 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL1104.2 +058200 MOVE 376 TO CORRECT-18V0 RL1104.2 +058300 PERFORM FAIL RL1104.2 +058400 ELSE RL1104.2 +058500 PERFORM PASS. RL1104.2 +058600 PERFORM PRINT-DETAIL. RL1104.2 +058700 ADD 01 TO REC-CT. RL1104.2 +058800* .01 RL1104.2 +058900 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO RL1104.2 +059000 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL1104.2 +059100 MOVE ZERO TO CORRECT-18V0 RL1104.2 +059200 MOVE "DELETED RECORDS" TO RE-MARK RL1104.2 +059300 PERFORM FAIL RL1104.2 +059400 ELSE RL1104.2 +059500 PERFORM PASS. RL1104.2 +059600 PERFORM PRINT-DETAIL. RL1104.2 +059700 ADD 01 TO REC-CT. RL1104.2 +059800* .02 RL1104.2 +059900 IF WRK-CS-09V00-010 NOT EQUAL TO 375 RL1104.2 +060000 MOVE "KEY MISMATCH" TO RE-MARK RL1104.2 +060100 MOVE 375 TO CORRECT-18V0 RL1104.2 +060200 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL1104.2 +060300 PERFORM FAIL RL1104.2 +060400 ELSE RL1104.2 +060500 PERFORM PASS. RL1104.2 +060600 PERFORM PRINT-DETAIL. RL1104.2 +060700 ADD 01 TO REC-CT. RL1104.2 +060800* .03 RL1104.2 +060900 IF WRK-CS-09V00-011 NOT EQUAL TO 375 RL1104.2 +061000 MOVE 375 TO CORRECT-18V0 RL1104.2 +061100 MOVE "INCORRECT RECORD FOUND" TO RE-MARK RL1104.2 +061200 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 RL1104.2 +061300 PERFORM FAIL RL1104.2 +061400 ELSE RL1104.2 +061500 PERFORM PASS. RL1104.2 +061600 PERFORM PRINT-DETAIL. RL1104.2 +061700 ADD 01 TO REC-CT. RL1104.2 +061800*04 RL1104.2 +061900 CLOSE RL-FS1. RL1104.2 +062000 CCVS-EXIT SECTION. RL1104.2 +062100 CCVS-999999. RL1104.2 +062200 GO TO CLOSE-FILES. RL1104.2 diff --git a/tests/cobol85/RL/RL111A.CBL b/tests/cobol85/RL/RL111A.CBL new file mode 100644 index 00000000..689419b4 --- /dev/null +++ b/tests/cobol85/RL/RL111A.CBL @@ -0,0 +1,1094 @@ +000100 IDENTIFICATION DIVISION. RL1114.2 +000200 PROGRAM-ID. RL1114.2 +000300 RL111A. RL1114.2 +000400**************************************************************** RL1114.2 +000500* * RL1114.2 +000600* VALIDATION FOR:- * RL1114.2 +000700* * RL1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1114.2 +000900* * RL1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1114.2 +001100* * RL1114.2 +001200**************************************************************** RL1114.2 +001300* * RL1114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1114.2 +001500* * RL1114.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1114.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1114.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1114.2 +001900* * RL1114.2 +002000**************************************************************** RL1114.2 +002100* * RL1114.2 +002200* THIS PROGRAM WILL TEST THE SYNTACTICAL CONSTRUCTS AND * RL1114.2 +002300* SEMANTIC ACTIONS ASSOCIATED WITH THE FOLLOWING CLAUSES: * RL1114.2 +002400* * RL1114.2 +002500* - ACCESS * RL1114.2 +002600* - READ * RL1114.2 +002700* - WRITE * RL1114.2 +002800* - REWRITE * RL1114.2 +002900* * RL1114.2 +003000* 1) THE PROGRAM WILL CREATE A RELATIVE I-O FILE * RL1114.2 +003100* 2) THEN IT WILL UPDATE SELECTIVE RECORDS OF THE FILE * RL1114.2 +003200* 3) THE FILE STATUS CONTENTS ARE CAPTURED AND TESTED FOR * RL1114.2 +003300* ACCURACY FOR EACH "OPEN", "CLOSE", "READ" AND * RL1114.2 +003400* "REWRITE" STATEMENT USED. * RL1114.2 +003500* 4) THE "READ", "WRITE" AND "REWRITE" STATEMENT WILL BE * RL1114.2 +003600* USED WITH THE APPROPRIATE "AT END", "NOT AT END" * RL1114.2 +003700* "INVALID KEY" AND "NOT INVALID KEY" PHRASES. * RL1114.2 +003800* * RL1114.2 +003900**************************************************************** RL1114.2 +004000 ENVIRONMENT DIVISION. RL1114.2 +004100 CONFIGURATION SECTION. RL1114.2 +004200 SOURCE-COMPUTER. RL1114.2 +004300 Linux. RL1114.2 +004400 OBJECT-COMPUTER. RL1114.2 +004500 Linux. RL1114.2 +004600 INPUT-OUTPUT SECTION. RL1114.2 +004700 FILE-CONTROL. RL1114.2 +004800 SELECT PRINT-FILE ASSIGN TO RL1114.2 +004900 "report.log". RL1114.2 +005000 SELECT RL-FS2 ASSIGN RL1114.2 +005100 "XXXXX022" RL1114.2 +005200 ORGANIZATION RELATIVE RL1114.2 +005300 ACCESS IS SEQUENTIAL RL1114.2 +005400 RELATIVE KEY IS RL-FS2-KEY RL1114.2 +005500 STATUS RL-FS2-STATUS. RL1114.2 +005600 SELECT RL-FS3 ASSIGN RL1114.2 +005700 "XXXXX022" RL1114.2 +005800 ORGANIZATION RELATIVE RL1114.2 +005900 ACCESS IS RANDOM RL1114.2 +006000 RELATIVE KEY IS RL-FS3-KEY RL1114.2 +006100 STATUS RL-FS3-STATUS. RL1114.2 +006200 DATA DIVISION. RL1114.2 +006300 FILE SECTION. RL1114.2 +006400 FD PRINT-FILE. RL1114.2 +006500 01 PRINT-REC PICTURE X(120). RL1114.2 +006600 01 DUMMY-RECORD PICTURE X(120). RL1114.2 +006700 FD RL-FS2 RL1114.2 +006800*C VALUE OF RL1114.2 +006900*C OCLABELID RL1114.2 +007000*C IS RL1114.2 +007100*C "OCDUMMY" RL1114.2 +007200*G SYSIN RL1114.2 +007300 LABEL RECORDS ARE STANDARD RL1114.2 +007400 BLOCK CONTAINS 1 RECORDS RL1114.2 +007500 DATA RECORD RL-FS2R1-F-G-240. RL1114.2 +007600 01 RL-FS2R1-F-G-240. RL1114.2 +007700 05 RL-FS2-WRK-120 PIC X(120). RL1114.2 +007800 05 RL-FS2-GRP-120. RL1114.2 +007900 10 RL-FS2-WRK-XN-0001-O120F RL1114.2 +008000 PICTURE X OCCURS 120 TIMES. RL1114.2 +008100 FD RL-FS3 RL1114.2 +008200*C VALUE OF RL1114.2 +008300*C OCLABELID RL1114.2 +008400*C IS RL1114.2 +008500*C "OCDUMMY" RL1114.2 +008600*G SYSIN RL1114.2 +008700 LABEL RECORDS ARE STANDARD RL1114.2 +008800 BLOCK CONTAINS 1 RECORDS RL1114.2 +008900 DATA RECORD RL-FS3R1-F-G-240. RL1114.2 +009000 01 RL-FS3R1-F-G-240. RL1114.2 +009100 05 RL-FS3-WRK-120 PIC X(120). RL1114.2 +009200 05 RL-FS3-GRP-120. RL1114.2 +009300 10 RL-FS3-WRK-XN-0001-O120F RL1114.2 +009400 PICTURE X OCCURS 120 TIMES. RL1114.2 +009500 WORKING-STORAGE SECTION. RL1114.2 +009600 01 GRP-0001. RL1114.2 +009700 05 RL-FS2-KEY PIC 9(8) VALUE ZERO. RL1114.2 +009800 05 RL-FS3-KEY PIC 9(8) VALUE ZERO. RL1114.2 +009900 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010000 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010100 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010200 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010300 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010400 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010500 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1114.2 +010600 05 RL-FS2-STATUS PIC XX VALUE SPACE. RL1114.2 +010700 05 RL-FS3-STATUS PIC XX VALUE SPACE. RL1114.2 +010800 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1114.2 +010900 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1114.2 +011000 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1114.2 +011100 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1114.2 +011200 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1114.2 +011300 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1114.2 +011400 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1114.2 +011500 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1114.2 +011600 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1114.2 +011700 01 FILE-RECORD-INFORMATION-REC. RL1114.2 +011800 03 FILE-RECORD-INFO-SKELETON. RL1114.2 +011900 05 FILLER PICTURE X(48) VALUE RL1114.2 +012000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1114.2 +012100 05 FILLER PICTURE X(46) VALUE RL1114.2 +012200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1114.2 +012300 05 FILLER PICTURE X(26) VALUE RL1114.2 +012400 ",LFIL=000000,ORG= ,LBLR= ". RL1114.2 +012500 05 FILLER PICTURE X(37) VALUE RL1114.2 +012600 ",RECKEY= ". RL1114.2 +012700 05 FILLER PICTURE X(38) VALUE RL1114.2 +012800 ",ALTKEY1= ". RL1114.2 +012900 05 FILLER PICTURE X(38) VALUE RL1114.2 +013000 ",ALTKEY2= ". RL1114.2 +013100 05 FILLER PICTURE X(7) VALUE SPACE.RL1114.2 +013200 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1114.2 +013300 05 FILE-RECORD-INFO-P1-120. RL1114.2 +013400 07 FILLER PIC X(5). RL1114.2 +013500 07 XFILE-NAME PIC X(6). RL1114.2 +013600 07 FILLER PIC X(8). RL1114.2 +013700 07 XRECORD-NAME PIC X(6). RL1114.2 +013800 07 FILLER PIC X(1). RL1114.2 +013900 07 REELUNIT-NUMBER PIC 9(1). RL1114.2 +014000 07 FILLER PIC X(7). RL1114.2 +014100 07 XRECORD-NUMBER PIC 9(6). RL1114.2 +014200 07 FILLER PIC X(6). RL1114.2 +014300 07 UPDATE-NUMBER PIC 9(2). RL1114.2 +014400 07 FILLER PIC X(5). RL1114.2 +014500 07 ODO-NUMBER PIC 9(4). RL1114.2 +014600 07 FILLER PIC X(5). RL1114.2 +014700 07 XPROGRAM-NAME PIC X(5). RL1114.2 +014800 07 FILLER PIC X(7). RL1114.2 +014900 07 XRECORD-LENGTH PIC 9(6). RL1114.2 +015000 07 FILLER PIC X(7). RL1114.2 +015100 07 CHARS-OR-RECORDS PIC X(2). RL1114.2 +015200 07 FILLER PIC X(1). RL1114.2 +015300 07 XBLOCK-SIZE PIC 9(4). RL1114.2 +015400 07 FILLER PIC X(6). RL1114.2 +015500 07 RECORDS-IN-FILE PIC 9(6). RL1114.2 +015600 07 FILLER PIC X(5). RL1114.2 +015700 07 XFILE-ORGANIZATION PIC X(2). RL1114.2 +015800 07 FILLER PIC X(6). RL1114.2 +015900 07 XLABEL-TYPE PIC X(1). RL1114.2 +016000 05 FILE-RECORD-INFO-P121-240. RL1114.2 +016100 07 FILLER PIC X(8). RL1114.2 +016200 07 XRECORD-KEY PIC X(29). RL1114.2 +016300 07 FILLER PIC X(9). RL1114.2 +016400 07 ALTERNATE-KEY1 PIC X(29). RL1114.2 +016500 07 FILLER PIC X(9). RL1114.2 +016600 07 ALTERNATE-KEY2 PIC X(29). RL1114.2 +016700 07 FILLER PIC X(7). RL1114.2 +016800 01 WRK-XN-00001-1 PIC X. RL1114.2 +016900 01 WRK-XN-00001-2 PIC X. RL1114.2 +017000 01 TEST-RESULTS. RL1114.2 +017100 02 FILLER PIC X VALUE SPACE. RL1114.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. RL1114.2 +017300 02 FILLER PIC X VALUE SPACE. RL1114.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. RL1114.2 +017500 02 FILLER PIC X VALUE SPACE. RL1114.2 +017600 02 PAR-NAME. RL1114.2 +017700 03 FILLER PIC X(19) VALUE SPACE. RL1114.2 +017800 03 PARDOT-X PIC X VALUE SPACE. RL1114.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. RL1114.2 +018000 02 FILLER PIC X(8) VALUE SPACE. RL1114.2 +018100 02 RE-MARK PIC X(61). RL1114.2 +018200 01 TEST-COMPUTED. RL1114.2 +018300 02 FILLER PIC X(30) VALUE SPACE. RL1114.2 +018400 02 FILLER PIC X(17) VALUE RL1114.2 +018500 " COMPUTED=". RL1114.2 +018600 02 COMPUTED-X. RL1114.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1114.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A RL1114.2 +018900 PIC -9(9).9(9). RL1114.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1114.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1114.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1114.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. RL1114.2 +019400 04 COMPUTED-18V0 PIC -9(18). RL1114.2 +019500 04 FILLER PIC X. RL1114.2 +019600 03 FILLER PIC X(50) VALUE SPACE. RL1114.2 +019700 01 TEST-CORRECT. RL1114.2 +019800 02 FILLER PIC X(30) VALUE SPACE. RL1114.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1114.2 +020000 02 CORRECT-X. RL1114.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1114.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1114.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1114.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1114.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1114.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. RL1114.2 +020700 04 CORRECT-18V0 PIC -9(18). RL1114.2 +020800 04 FILLER PIC X. RL1114.2 +020900 03 FILLER PIC X(2) VALUE SPACE. RL1114.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1114.2 +021100 01 CCVS-C-1. RL1114.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1114.2 +021300- "SS PARAGRAPH-NAME RL1114.2 +021400- " REMARKS". RL1114.2 +021500 02 FILLER PIC X(20) VALUE SPACE. RL1114.2 +021600 01 CCVS-C-2. RL1114.2 +021700 02 FILLER PIC X VALUE SPACE. RL1114.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". RL1114.2 +021900 02 FILLER PIC X(15) VALUE SPACE. RL1114.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". RL1114.2 +022100 02 FILLER PIC X(94) VALUE SPACE. RL1114.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1114.2 +022300 01 REC-CT PIC 99 VALUE ZERO. RL1114.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1114.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1114.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1114.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1114.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1114.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1114.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1114.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1114.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1114.2 +023300 01 CCVS-H-1. RL1114.2 +023400 02 FILLER PIC X(39) VALUE SPACES. RL1114.2 +023500 02 FILLER PIC X(42) VALUE RL1114.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1114.2 +023700 02 FILLER PIC X(39) VALUE SPACES. RL1114.2 +023800 01 CCVS-H-2A. RL1114.2 +023900 02 FILLER PIC X(40) VALUE SPACE. RL1114.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1114.2 +024100 02 FILLER PIC XXXX VALUE RL1114.2 +024200 "4.2 ". RL1114.2 +024300 02 FILLER PIC X(28) VALUE RL1114.2 +024400 " COPY - NOT FOR DISTRIBUTION". RL1114.2 +024500 02 FILLER PIC X(41) VALUE SPACE. RL1114.2 +024600 RL1114.2 +024700 01 CCVS-H-2B. RL1114.2 +024800 02 FILLER PIC X(15) VALUE RL1114.2 +024900 "TEST RESULT OF ". RL1114.2 +025000 02 TEST-ID PIC X(9). RL1114.2 +025100 02 FILLER PIC X(4) VALUE RL1114.2 +025200 " IN ". RL1114.2 +025300 02 FILLER PIC X(12) VALUE RL1114.2 +025400 " HIGH ". RL1114.2 +025500 02 FILLER PIC X(22) VALUE RL1114.2 +025600 " LEVEL VALIDATION FOR ". RL1114.2 +025700 02 FILLER PIC X(58) VALUE RL1114.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1114.2 +025900 01 CCVS-H-3. RL1114.2 +026000 02 FILLER PIC X(34) VALUE RL1114.2 +026100 " FOR OFFICIAL USE ONLY ". RL1114.2 +026200 02 FILLER PIC X(58) VALUE RL1114.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1114.2 +026400 02 FILLER PIC X(28) VALUE RL1114.2 +026500 " COPYRIGHT 1985 ". RL1114.2 +026600 01 CCVS-E-1. RL1114.2 +026700 02 FILLER PIC X(52) VALUE SPACE. RL1114.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1114.2 +026900 02 ID-AGAIN PIC X(9). RL1114.2 +027000 02 FILLER PIC X(45) VALUE SPACES. RL1114.2 +027100 01 CCVS-E-2. RL1114.2 +027200 02 FILLER PIC X(31) VALUE SPACE. RL1114.2 +027300 02 FILLER PIC X(21) VALUE SPACE. RL1114.2 +027400 02 CCVS-E-2-2. RL1114.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1114.2 +027600 03 FILLER PIC X VALUE SPACE. RL1114.2 +027700 03 ENDER-DESC PIC X(44) VALUE RL1114.2 +027800 "ERRORS ENCOUNTERED". RL1114.2 +027900 01 CCVS-E-3. RL1114.2 +028000 02 FILLER PIC X(22) VALUE RL1114.2 +028100 " FOR OFFICIAL USE ONLY". RL1114.2 +028200 02 FILLER PIC X(12) VALUE SPACE. RL1114.2 +028300 02 FILLER PIC X(58) VALUE RL1114.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1114.2 +028500 02 FILLER PIC X(13) VALUE SPACE. RL1114.2 +028600 02 FILLER PIC X(15) VALUE RL1114.2 +028700 " COPYRIGHT 1985". RL1114.2 +028800 01 CCVS-E-4. RL1114.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1114.2 +029000 02 FILLER PIC X(4) VALUE " OF ". RL1114.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1114.2 +029200 02 FILLER PIC X(40) VALUE RL1114.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1114.2 +029400 01 XXINFO. RL1114.2 +029500 02 FILLER PIC X(19) VALUE RL1114.2 +029600 "*** INFORMATION ***". RL1114.2 +029700 02 INFO-TEXT. RL1114.2 +029800 04 FILLER PIC X(8) VALUE SPACE. RL1114.2 +029900 04 XXCOMPUTED PIC X(20). RL1114.2 +030000 04 FILLER PIC X(5) VALUE SPACE. RL1114.2 +030100 04 XXCORRECT PIC X(20). RL1114.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). RL1114.2 +030300 01 HYPHEN-LINE. RL1114.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. RL1114.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************RL1114.2 +030600- "*****************************************". RL1114.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************RL1114.2 +030800- "******************************". RL1114.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE RL1114.2 +031000 "RL111A". RL1114.2 +031100 PROCEDURE DIVISION. RL1114.2 +031200 DECLARATIVES. RL1114.2 +031300 RL-FS2-01 SECTION. RL1114.2 +031400 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FS2. RL1114.2 +031500 RL-FS2-01-01. RL1114.2 +031600 ADD 1 TO WRK-CS-09V00-013. RL1114.2 +031700 GO TO RL-FS2-01-03 RL1114.2 +031800 RL-FS2-01-05 RL1114.2 +031900 DEPENDING ON WRK-CS-09V00-012. RL1114.2 +032000 GO TO RL-FS2-01-EXIT. RL1114.2 +032100 RL-FS2-01-03. RL1114.2 +032200*ENTRY FROM SEGMENT REL-TEST-009. RL1114.2 +032300* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL1114.2 +032400 ADD 1 TO WRK-CS-09V00-014. RL1114.2 +032500 RL-FS2-01-05. RL1114.2 +032600 ADD 1 TO WRK-CS-09V00-017. RL1114.2 +032700 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1114.2 +032800 MOVE RL-FS2-STATUS TO WRK-XN-0002-002 RL1114.2 +032900 MOVE "10" TO WRK-XN-0002-003. RL1114.2 +033000 RL-FS2-01-EXIT. RL1114.2 +033100 EXIT. RL1114.2 +033200 RL-FS2-02 SECTION. RL1114.2 +033300 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FS3. RL1114.2 +033400 RL-FS2-02-01. RL1114.2 +033500 IF PAR-NAME = "REL-TEST-060-1" RL1114.2 +033600 GO TO RL-FS2-02-STAT. RL1114.2 +033700 ADD 1 TO WRK-CS-09V00-013. RL1114.2 +033800* GO TO RL-FS2-02-03 RL1114.2 +033900* RL-FS2-02-05 RL1114.2 +034000* DEPENDING ON WRK-CS-09V00-012. RL1114.2 +034100 GO TO D-CLOSE-FILES. RL1114.2 +034200 RL-FS2-02-STAT. RL1114.2 +034300 IF RL-FS3-STATUS = "48" RL1114.2 +034400 PERFORM D-PASS RL1114.2 +034500 ELSE RL1114.2 +034600 MOVE "WRITE TO FILE OPENED INPUT NOT ALLOWED" RL1114.2 +034700 TO RE-MARK RL1114.2 +034800 PERFORM D-FAIL. RL1114.2 +034900 PERFORM D-PRINT-DETAIL. RL1114.2 +035000 D-CLOSE-FILES. RL1114.2 +035100 CLOSE RL-FS3. RL1114.2 +035200 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. RL1114.2 +035300 CLOSE PRINT-FILE. RL1114.2 +035400 D-TERMINATE-CCVS. RL1114.2 +035500*S EXIT PROGRAM. RL1114.2 +035600*S-TERMINATE-CALL. RL1114.2 +035700 STOP RUN. RL1114.2 +035800 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1114.2 +035900 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1114.2 +036000 D-PRINT-DETAIL. RL1114.2 +036100 IF REC-CT NOT EQUAL TO ZERO RL1114.2 +036200 MOVE "." TO PARDOT-X RL1114.2 +036300 MOVE REC-CT TO DOTVALUE. RL1114.2 +036400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D-WRITE-LINE. RL1114.2 +036500 IF P-OR-F EQUAL TO "FAIL*" PERFORM D-WRITE-LINE RL1114.2 +036600 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX RL1114.2 +036700 ELSE PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. RL1114.2 +036800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1114.2 +036900 MOVE SPACE TO CORRECT-X. RL1114.2 +037000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1114.2 +037100 MOVE SPACE TO RE-MARK. RL1114.2 +037200 D-END-ROUTINE. RL1114.2 +037300 MOVE HYPHEN-LINE TO DUMMY-RECORD. RL1114.2 +037400 PERFORM D-WRITE-LINE 5 TIMES. RL1114.2 +037500 D-END-RTN-EXIT. RL1114.2 +037600 MOVE CCVS-E-1 TO DUMMY-RECORD. RL1114.2 +037700 PERFORM D-WRITE-LINE 2 TIMES. RL1114.2 +037800 D-END-ROUTINE-1. RL1114.2 +037900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1114.2 +038000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1114.2 +038100 ADD PASS-COUNTER TO ERROR-HOLD. RL1114.2 +038200 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1114.2 +038300 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1114.2 +038400 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1114.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. RL1114.2 +038600 D-END-ROUTINE-12. RL1114.2 +038700 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1114.2 +038800 IF ERROR-COUNTER IS EQUAL TO ZERO RL1114.2 +038900 MOVE "NO " TO ERROR-TOTAL RL1114.2 +039000 ELSE RL1114.2 +039100 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1114.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1114.2 +039300 PERFORM D-WRITE-LINE. RL1114.2 +039400 D-END-ROUTINE-13. RL1114.2 +039500 IF DELETE-COUNTER IS EQUAL TO ZERO RL1114.2 +039600 MOVE "NO " TO ERROR-TOTAL ELSE RL1114.2 +039700 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1114.2 +039800 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1114.2 +039900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1114.2 +040000 IF INSPECT-COUNTER EQUAL TO ZERO RL1114.2 +040100 MOVE "NO " TO ERROR-TOTAL RL1114.2 +040200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1114.2 +040300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1114.2 +040400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1114.2 +040500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1114.2 +040600 D-WRITE-LINE. RL1114.2 +040700 ADD 1 TO RECORD-COUNT. RL1114.2 +040800 IF RECORD-COUNT GREATER 50 RL1114.2 +040900 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1114.2 +041000 MOVE SPACE TO DUMMY-RECORD RL1114.2 +041100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1114.2 +041200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN RL1114.2 +041300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D-WRT-LN 2 TIMES RL1114.2 +041400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN RL1114.2 +041500 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1114.2 +041600 MOVE ZERO TO RECORD-COUNT. RL1114.2 +041700 PERFORM D-WRT-LN. RL1114.2 +041800 D-WRT-LN. RL1114.2 +041900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1114.2 +042000 MOVE SPACE TO DUMMY-RECORD. RL1114.2 +042100 D-FAIL-ROUTINE. RL1114.2 +042200 IF COMPUTED-X NOT EQUAL TO SPACE RL1114.2 +042300 GO TO D-FAIL-ROUTINE-WRITE. RL1114.2 +042400 IF CORRECT-X NOT EQUAL TO SPACE RL1114.2 +042500 GO TO D-FAIL-ROUTINE-WRITE. RL1114.2 +042600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1114.2 +042700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1114.2 +042800 MOVE XXINFO TO DUMMY-RECORD. RL1114.2 +042900 PERFORM D-WRITE-LINE 2 TIMES. RL1114.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1114.2 +043100 GO TO D-FAIL-ROUTINE-EX. RL1114.2 +043200 D-FAIL-ROUTINE-WRITE. RL1114.2 +043300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE RL1114.2 +043400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1114.2 +043500 MOVE TEST-CORRECT TO PRINT-REC RL1114.2 +043600 PERFORM D-WRITE-LINE 2 TIMES. RL1114.2 +043700 MOVE SPACES TO COR-ANSI-REFERENCE. RL1114.2 +043800 D-FAIL-ROUTINE-EX. EXIT. RL1114.2 +043900 D-BAIL-OUT. RL1114.2 +044000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. RL1114.2 +044100 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. RL1114.2 +044200 D-BAIL-OUT-WRITE. RL1114.2 +044300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1114.2 +044400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1114.2 +044500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. RL1114.2 +044600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1114.2 +044700 D-BAIL-OUT-EX. EXIT. RL1114.2 +044800 RL-FS2-02-03. RL1114.2 +044900*ENTRY FROM SEGMENT REL-TEST-009. RL1114.2 +045000* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL1114.2 +045100 ADD 1 TO WRK-CS-09V00-014. RL1114.2 +045200 RL-FS2-02-05. RL1114.2 +045300 ADD 1 TO WRK-CS-09V00-017. RL1114.2 +045400 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1114.2 +045500 MOVE RL-FS2-STATUS TO WRK-XN-0002-002 RL1114.2 +045600 MOVE "10" TO WRK-XN-0002-003. RL1114.2 +045700 RL-FS2-02-EXIT. RL1114.2 +045800 EXIT. RL1114.2 +045900 END DECLARATIVES. RL1114.2 +046000 CCVS1 SECTION. RL1114.2 +046100 OPEN-FILES. RL1114.2 +046200 OPEN OUTPUT PRINT-FILE. RL1114.2 +046300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1114.2 +046400 MOVE SPACE TO TEST-RESULTS. RL1114.2 +046500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1114.2 +046600 MOVE ZERO TO REC-SKL-SUB. RL1114.2 +046700 PERFORM CCVS-INIT-FILE 9 TIMES. RL1114.2 +046800 CCVS-INIT-FILE. RL1114.2 +046900 ADD 1 TO REC-SKL-SUB. RL1114.2 +047000 MOVE FILE-RECORD-INFO-SKELETON RL1114.2 +047100 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1114.2 +047200 CCVS-INIT-EXIT. RL1114.2 +047300 GO TO CCVS1-EXIT. RL1114.2 +047400 CLOSE-FILES. RL1114.2 +047500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1114.2 +047600 TERMINATE-CCVS. RL1114.2 +047700*S EXIT PROGRAM. RL1114.2 +047800*SERMINATE-CALL. RL1114.2 +047900 STOP RUN. RL1114.2 +048000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1114.2 +048100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1114.2 +048200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1114.2 +048300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1114.2 +048400 MOVE "****TEST DELETED****" TO RE-MARK. RL1114.2 +048500 PRINT-DETAIL. RL1114.2 +048600 IF REC-CT NOT EQUAL TO ZERO RL1114.2 +048700 MOVE "." TO PARDOT-X RL1114.2 +048800 MOVE REC-CT TO DOTVALUE. RL1114.2 +048900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1114.2 +049000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1114.2 +049100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1114.2 +049200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1114.2 +049300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1114.2 +049400 MOVE SPACE TO CORRECT-X. RL1114.2 +049500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1114.2 +049600 MOVE SPACE TO RE-MARK. RL1114.2 +049700 HEAD-ROUTINE. RL1114.2 +049800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +049900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +050000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1114.2 +050100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1114.2 +050200 COLUMN-NAMES-ROUTINE. RL1114.2 +050300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +050400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +050500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +050600 END-ROUTINE. RL1114.2 +050700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1114.2 +050800 END-RTN-EXIT. RL1114.2 +050900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +051000 END-ROUTINE-1. RL1114.2 +051100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1114.2 +051200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1114.2 +051300 ADD PASS-COUNTER TO ERROR-HOLD. RL1114.2 +051400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1114.2 +051500 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1114.2 +051600 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1114.2 +051700 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1114.2 +051800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1114.2 +051900 END-ROUTINE-12. RL1114.2 +052000 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1114.2 +052100 IF ERROR-COUNTER IS EQUAL TO ZERO RL1114.2 +052200 MOVE "NO " TO ERROR-TOTAL RL1114.2 +052300 ELSE RL1114.2 +052400 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1114.2 +052500 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1114.2 +052600 PERFORM WRITE-LINE. RL1114.2 +052700 END-ROUTINE-13. RL1114.2 +052800 IF DELETE-COUNTER IS EQUAL TO ZERO RL1114.2 +052900 MOVE "NO " TO ERROR-TOTAL ELSE RL1114.2 +053000 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1114.2 +053100 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1114.2 +053200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +053300 IF INSPECT-COUNTER EQUAL TO ZERO RL1114.2 +053400 MOVE "NO " TO ERROR-TOTAL RL1114.2 +053500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1114.2 +053600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1114.2 +053700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +053800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1114.2 +053900 WRITE-LINE. RL1114.2 +054000 ADD 1 TO RECORD-COUNT. RL1114.2 +054100 IF RECORD-COUNT GREATER 50 RL1114.2 +054200 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1114.2 +054300 MOVE SPACE TO DUMMY-RECORD RL1114.2 +054400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1114.2 +054500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1114.2 +054600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1114.2 +054700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1114.2 +054800 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1114.2 +054900 MOVE ZERO TO RECORD-COUNT. RL1114.2 +055000 PERFORM WRT-LN. RL1114.2 +055100 WRT-LN. RL1114.2 +055200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1114.2 +055300 MOVE SPACE TO DUMMY-RECORD. RL1114.2 +055400 BLANK-LINE-PRINT. RL1114.2 +055500 PERFORM WRT-LN. RL1114.2 +055600 FAIL-ROUTINE. RL1114.2 +055700 IF COMPUTED-X NOT EQUAL TO SPACE RL1114.2 +055800 GO TO FAIL-ROUTINE-WRITE. RL1114.2 +055900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1114.2 +056000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1114.2 +056100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1114.2 +056200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +056300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1114.2 +056400 GO TO FAIL-ROUTINE-EX. RL1114.2 +056500 FAIL-ROUTINE-WRITE. RL1114.2 +056600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1114.2 +056700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1114.2 +056800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1114.2 +056900 MOVE SPACES TO COR-ANSI-REFERENCE. RL1114.2 +057000 FAIL-ROUTINE-EX. EXIT. RL1114.2 +057100 BAIL-OUT. RL1114.2 +057200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1114.2 +057300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1114.2 +057400 BAIL-OUT-WRITE. RL1114.2 +057500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1114.2 +057600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1114.2 +057700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1114.2 +057800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1114.2 +057900 BAIL-OUT-EX. EXIT. RL1114.2 +058000 CCVS1-EXIT. RL1114.2 +058100 EXIT. RL1114.2 +058200 SECT-RL-04-001 SECTION. RL1114.2 +058300 REL-INIT-009. RL1114.2 +058400 MOVE "REL-TEST-009" TO PAR-NAME. RL1114.2 +058500 MOVE "CREATE RL-FS2" TO FEATURE RL1114.2 +058600 MOVE "RL-FS2" TO XFILE-NAME (2). RL1114.2 +058700 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1114.2 +058800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1114.2 +058900 MOVE 000240 TO XRECORD-LENGTH (2). RL1114.2 +059000 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1114.2 +059100 MOVE 0001 TO XBLOCK-SIZE (2). RL1114.2 +059200 MOVE 000500 TO RECORDS-IN-FILE (2). RL1114.2 +059300 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1114.2 +059400 MOVE "S" TO XLABEL-TYPE (2). RL1114.2 +059500 MOVE 000001 TO XRECORD-NUMBER (2). RL1114.2 +059600*INITIALIZE RECORD WORK AREA NUMBER 2. RL1114.2 +059700 MOVE 1 TO WRK-CS-09V00-012. RL1114.2 +059800 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1114.2 +059900 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1114.2 +060000 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1114.2 +060100 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +060200 MOVE 01 TO REC-CT. RL1114.2 +060300 OPEN OUTPUT RL-FS2. RL1114.2 +060400 MOVE RL-FS2-STATUS TO WRK-XN-0002-001. RL1114.2 +060500*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1114.2 +060600 REL-TEST-009-R. RL1114.2 +060700 MOVE "99" TO RL-FS2-STATUS. RL1114.2 +060800 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FS2-WRK-120. RL1114.2 +060900 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1114.2 +061000 RL-FS2-GRP-120. RL1114.2 +061100 WRITE RL-FS2R1-F-G-240. RL1114.2 +061200 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +061300 GO TO REL-TEST-009-2. RL1114.2 +061400 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1114.2 +061500 GO TO REL-TEST-009-2. RL1114.2 +061600 ADD 01 TO XRECORD-NUMBER (2). RL1114.2 +061700 GO TO REL-TEST-009-R. RL1114.2 +061800 REL-TEST-009-2. RL1114.2 +061900 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1114.2 +062000 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1114.2 +062100 MOVE ZERO TO CORRECT-18V0 RL1114.2 +062200 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1114.2 +062300 PERFORM FAIL RL1114.2 +062400 ELSE RL1114.2 +062500 PERFORM PASS. RL1114.2 +062600 PERFORM PRINT-DETAIL. RL1114.2 +062700 ADD 01 TO REC-CT. RL1114.2 +062800* .01 RL1114.2 +062900 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1114.2 +063000 MOVE "INCORRECT COUNT" TO RE-MARK RL1114.2 +063100 MOVE 500 TO CORRECT-18V0 RL1114.2 +063200 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1114.2 +063300 PERFORM FAIL RL1114.2 +063400 ELSE RL1114.2 +063500 PERFORM PASS. RL1114.2 +063600 PERFORM PRINT-DETAIL. RL1114.2 +063700 ADD 01 TO REC-CT. RL1114.2 +063800* .02 RL1114.2 +063900 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1114.2 +064000 MOVE "STATUS/OPEN" TO RE-MARK RL1114.2 +064100 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1114.2 +064200 MOVE "00" TO CORRECT-A RL1114.2 +064300 PERFORM FAIL RL1114.2 +064400 ELSE RL1114.2 +064500 PERFORM PASS. RL1114.2 +064600 PERFORM PRINT-DETAIL. RL1114.2 +064700 ADD 01 TO REC-CT. RL1114.2 +064800* .03 RL1114.2 +064900 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +065000 MOVE "STATUS/WRITE" TO RE-MARK RL1114.2 +065100 MOVE RL-FS2-STATUS TO COMPUTED-A RL1114.2 +065200 MOVE "00" TO CORRECT-A RL1114.2 +065300 PERFORM FAIL RL1114.2 +065400 ELSE RL1114.2 +065500 PERFORM PASS. RL1114.2 +065600 PERFORM PRINT-DETAIL. RL1114.2 +065700 ADD 01 TO REC-CT. RL1114.2 +065800* .04 RL1114.2 +065900 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +066000 CLOSE RL-FS2. RL1114.2 +066100 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +066200 MOVE "CLOSE/STATUS" TO RE-MARK RL1114.2 +066300 MOVE RL-FS2-STATUS TO COMPUTED-A RL1114.2 +066400 MOVE "00" TO CORRECT-A RL1114.2 +066500 PERFORM FAIL RL1114.2 +066600 ELSE RL1114.2 +066700 PERFORM PASS. RL1114.2 +066800 PERFORM PRINT-DETAIL. RL1114.2 +066900 ADD 01 TO REC-CT. RL1114.2 +067000* .05 RL1114.2 +067100 REL-INIT-010. RL1114.2 +067200 MOVE "REL-TEST-010" TO PAR-NAME. RL1114.2 +067300 MOVE 2 TO WRK-CS-09V00-012. RL1114.2 +067400 MOVE ZERO TO WRK-CS-09V00-013. RL1114.2 +067500 MOVE ZERO TO WRK-CS-09V00-014. RL1114.2 +067600 MOVE ZERO TO WRK-CS-09V00-015. RL1114.2 +067700 MOVE ZERO TO WRK-CS-09V00-016. RL1114.2 +067800 MOVE ZERO TO WRK-CS-09V00-017. RL1114.2 +067900 MOVE ZERO TO WRK-CS-09V00-018. RL1114.2 +068000 MOVE 01 TO REC-CT. RL1114.2 +068100 OPEN I-O RL-FS2. RL1114.2 +068200 MOVE SPACE TO WRK-XN-0002-002 RL1114.2 +068300 MOVE SPACE TO WRK-XN-0002-003 RL1114.2 +068400 MOVE SPACE TO WRK-XN-0002-004 RL1114.2 +068500 MOVE RL-FS2-STATUS TO WRK-XN-0002-001 RL1114.2 +068600 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +068700*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1114.2 +068800 MOVE "USE/FILE STATUS" TO FEATURE. RL1114.2 +068900 REL-TEST-010-R. RL1114.2 +069000 MOVE "REL-TEST-010-R" TO PAR-NAME. RL1114.2 +069100 MOVE "VIII-26 4.5.2" TO ANSI-REFERENCE. RL1114.2 +069200 ADD 1 TO WRK-CS-09V00-014. RL1114.2 +069300 ADD 1 TO WRK-CS-09V00-015. RL1114.2 +069400 READ RL-FS2. RL1114.2 +069500 IF RL-FS2-STATUS EQUAL TO "10" RL1114.2 +069600 GO TO REL-TEST-010-3. RL1114.2 +069700 MOVE RL-FS2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +069800 IF WRK-CS-09V00-015 EQUAL TO 5 RL1114.2 +069900 ADD 01 TO UPDATE-NUMBER (2) RL1114.2 +070000 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FS2-WRK-120 RL1114.2 +070100 REWRITE RL-FS2R1-F-G-240 RL1114.2 +070200 MOVE ZERO TO WRK-CS-09V00-015 RL1114.2 +070300 GO TO REL-TEST-010-2. RL1114.2 +070400 IF WRK-CS-09V00-014 GREATER 500 RL1114.2 +070500 GO TO REL-TEST-010-3. RL1114.2 +070600 GO TO REL-TEST-010-R. RL1114.2 +070700 REL-TEST-010-2. RL1114.2 +070800 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +070900 ADD 1 TO WRK-CS-09V00-016. RL1114.2 +071000 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +071100 GO TO REL-TEST-010-R. RL1114.2 +071200 REL-TEST-010-3. RL1114.2 +071300 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1114.2 +071400 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1114.2 +071500 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1114.2 +071600 MOVE 1 TO CORRECT-18V0 RL1114.2 +071700 PERFORM FAIL RL1114.2 +071800 ELSE RL1114.2 +071900 PERFORM PASS. RL1114.2 +072000 PERFORM PRINT-DETAIL. RL1114.2 +072100 ADD 01 TO REC-CT. RL1114.2 +072200* .01 RL1114.2 +072300 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1114.2 +072400 MOVE "INCORRECT COUNT" TO RE-MARK RL1114.2 +072500 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1114.2 +072600 MOVE 501 TO CORRECT-18V0 RL1114.2 +072700 PERFORM FAIL RL1114.2 +072800 ELSE RL1114.2 +072900 PERFORM PASS. RL1114.2 +073000 PERFORM PRINT-DETAIL. RL1114.2 +073100 ADD 01 TO REC-CT. RL1114.2 +073200* .02 RL1114.2 +073300 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1114.2 +073400 MOVE "OPEN/STATUS" TO RE-MARK RL1114.2 +073500 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1114.2 +073600 MOVE "00" TO CORRECT-A RL1114.2 +073700 PERFORM FAIL RL1114.2 +073800 ELSE RL1114.2 +073900 PERFORM PASS. RL1114.2 +074000 PERFORM PRINT-DETAIL. RL1114.2 +074100 ADD 01 TO REC-CT. RL1114.2 +074200* .03 RL1114.2 +074300 IF RL-FS2-STATUS NOT EQUAL TO "10" RL1114.2 +074400 MOVE "AT END/STATUS" TO RE-MARK RL1114.2 +074500 MOVE RL-FS2-STATUS TO COMPUTED-A RL1114.2 +074600 MOVE "10" TO CORRECT-A RL1114.2 +074700 PERFORM FAIL RL1114.2 +074800 ELSE RL1114.2 +074900 PERFORM PASS. RL1114.2 +075000 PERFORM PRINT-DETAIL. RL1114.2 +075100 ADD 01 TO REC-CT. RL1114.2 +075200* .04 RL1114.2 +075300 IF WRK-XN-0002-002 NOT EQUAL TO "10" RL1114.2 +075400 MOVE "EXCEPTION/STATUS" TO RE-MARK RL1114.2 +075500 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1114.2 +075600 MOVE "10" TO CORRECT-A RL1114.2 +075700 PERFORM FAIL RL1114.2 +075800 ELSE RL1114.2 +075900 PERFORM PASS. RL1114.2 +076000 PERFORM PRINT-DETAIL. RL1114.2 +076100 ADD 01 TO REC-CT. RL1114.2 +076200* .05 RL1114.2 +076300 IF WRK-XN-0002-003 NOT EQUAL TO "10" RL1114.2 +076400 MOVE "NO/EXCEPTION" TO RE-MARK RL1114.2 +076500 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1114.2 +076600 MOVE "10" TO CORRECT-A RL1114.2 +076700 PERFORM FAIL RL1114.2 +076800 ELSE RL1114.2 +076900 PERFORM PASS. RL1114.2 +077000 PERFORM PRINT-DETAIL RL1114.2 +077100 ADD 01 TO REC-CT. RL1114.2 +077200* .06 RL1114.2 +077300 MOVE SPACE TO RL-FS2-STATUS. RL1114.2 +077400 CLOSE RL-FS2 RL1114.2 +077500 IF RL-FS2-STATUS NOT EQUAL TO "00" RL1114.2 +077600 MOVE "CLOSE/STATUS" TO RE-MARK RL1114.2 +077700 MOVE RL-FS2-STATUS TO COMPUTED-A RL1114.2 +077800 MOVE "00" TO CORRECT-A RL1114.2 +077900 PERFORM FAIL RL1114.2 +078000 ELSE RL1114.2 +078100 PERFORM PASS. RL1114.2 +078200 PERFORM PRINT-DETAIL. RL1114.2 +078300 ADD 01 TO REC-CT. RL1114.2 +078400* .07 RL1114.2 +078500* RL1114.2 +078600* RL1114.2 +078700 SECT-RL111-003-COBOL8X SECTION. RL1114.2 +078800*============================== RL1114.2 +078900* RL1114.2 +079000**************************************************************** RL1114.2 +079100* * RL1114.2 +079200* THIS SECTION CONTAINS THE ADDITIONAL CODING/TESTS FOR * RL1114.2 +079300* THE NEW COBOL '85 FEATURES. * RL1114.2 +079400* * RL1114.2 +079500**************************************************************** RL1114.2 +079600 REL-INIT-020. RL1114.2 +079700 MOVE "VIII-26 4.5.2" TO ANSI-REFERENCE. RL1114.2 +079800 MOVE "NEW COBOL85 TESTS" TO FEATURE. RL1114.2 +079900 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +080000 MOVE 0 TO REC-CT. RL1114.2 +080100 MOVE SPACES TO RL-FS2-STATUS. RL1114.2 +080200 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +080300 OPEN I-O RL-FS2. RL1114.2 +080400 REL-TEST-020-1. RL1114.2 +080500 MOVE "REL-TEST-020-1" TO PAR-NAME. RL1114.2 +080600 IF RL-FS2-STATUS = "00" RL1114.2 +080700 PERFORM PASS RL1114.2 +080800 PERFORM PRINT-DETAIL RL1114.2 +080900 ELSE RL1114.2 +081000 MOVE "INVALID OPEN" TO RE-MARK RL1114.2 +081100 MOVE "00" TO CORRECT-X RL1114.2 +081200 MOVE RL-FS2-STATUS TO COMPUTED-X RL1114.2 +081300 PERFORM FAIL RL1114.2 +081400 PERFORM PRINT-DETAIL. RL1114.2 +081500 REL-TEST-020-2. RL1114.2 +081600 MOVE "REL-TEST-020-2" TO PAR-NAME. RL1114.2 +081700 READ RL-FS2 INTO FILE-RECORD-INFO-P1-120 (2) RL1114.2 +081800 END RL1114.2 +081900 MOVE "END ENCOUNTERED ON FIRST READ" TO RE-MARK RL1114.2 +082000 PERFORM FAIL RL1114.2 +082100 PERFORM PRINT-DETAIL RL1114.2 +082200 NOT AT END RL1114.2 +082300 PERFORM PASS RL1114.2 +082400 PERFORM PRINT-DETAIL RL1114.2 +082500 END-READ RL1114.2 +082600 MOVE "X" TO WRK-XN-00001-1. RL1114.2 +082700 REL-TEST-020-3. RL1114.2 +082800 MOVE "REL-TEST-020-3" TO PAR-NAME. RL1114.2 +082900 IF XRECORD-NUMBER (2) = 1 RL1114.2 +083000 PERFORM PASS RL1114.2 +083100 PERFORM PRINT-DETAIL RL1114.2 +083200 ELSE RL1114.2 +083300 MOVE "FIRST RECORD NOT READ ON FIRST READ" RL1114.2 +083400 TO RE-MARK RL1114.2 +083500 MOVE 1 TO CORRECT-N RL1114.2 +083600 MOVE XRECORD-NUMBER (2) TO COMPUTED-N RL1114.2 +083700 PERFORM FAIL RL1114.2 +083800 PERFORM PRINT-DETAIL. RL1114.2 +083900 REL-TEST-020-4. RL1114.2 +084000 MOVE "REL-TEST-020-4" TO PAR-NAME. RL1114.2 +084100 IF WRK-XN-00001-1 = "X" RL1114.2 +084200 PERFORM PASS RL1114.2 +084300 PERFORM PRINT-DETAIL RL1114.2 +084400 ELSE RL1114.2 +084500 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +084600 MOVE "X" TO CORRECT-X RL1114.2 +084700 MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +084800 PERFORM FAIL RL1114.2 +084900 PERFORM PRINT-DETAIL. RL1114.2 +085000* RL1114.2 +085100 REL-INIT-030. RL1114.2 +085200 MOVE "VIII-29 4.5.4" TO ANSI-REFERENCE. RL1114.2 +085300 MOVE 0 TO REC-CT. RL1114.2 +085400 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +085500 MOVE SPACES TO RL-FS2-STATUS. RL1114.2 +085600 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +085700 REL-TEST-030-1. RL1114.2 +085800 MOVE "REL-TEST-030-1" TO PAR-NAME. RL1114.2 +085900 READ RL-FS2 RL1114.2 +086000 END RL1114.2 +086100 MOVE "END ENCOUNTERED ON SECOND READ" TO RE-MARK RL1114.2 +086200 PERFORM FAIL RL1114.2 +086300 PERFORM PRINT-DETAIL RL1114.2 +086400 NOT AT END RL1114.2 +086500 PERFORM PASS RL1114.2 +086600 PERFORM PRINT-DETAIL RL1114.2 +086700 END-READ RL1114.2 +086800 MOVE "X" TO WRK-XN-00001-1. RL1114.2 +086900 REL-TEST-030-2. RL1114.2 +087000 MOVE "REL-TEST-030-2" TO PAR-NAME. RL1114.2 +087100 MOVE RL-FS2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +087200 IF XRECORD-NUMBER (2) = 2 RL1114.2 +087300 PERFORM PASS RL1114.2 +087400 PERFORM PRINT-DETAIL RL1114.2 +087500 ELSE RL1114.2 +087600 MOVE "SECOND RECORD NOT READ ON SECOND READ" RL1114.2 +087700 TO RE-MARK RL1114.2 +087800 MOVE 2 TO CORRECT-N RL1114.2 +087900 MOVE XRECORD-NUMBER (2) TO COMPUTED-N RL1114.2 +088000 PERFORM FAIL RL1114.2 +088100 PERFORM PRINT-DETAIL. RL1114.2 +088200 REL-TEST-030-3. RL1114.2 +088300 MOVE "REL-TEST-030-3" TO PAR-NAME. RL1114.2 +088400 IF WRK-XN-00001-1 = "X" RL1114.2 +088500 PERFORM PASS RL1114.2 +088600 PERFORM PRINT-DETAIL RL1114.2 +088700 ELSE RL1114.2 +088800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +088900 MOVE "X" TO CORRECT-X RL1114.2 +089000 MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +089100 PERFORM FAIL RL1114.2 +089200 PERFORM PRINT-DETAIL. RL1114.2 +089300* RL1114.2 +089400 REL-INIT-040. RL1114.2 +089500 CLOSE RL-FS2. RL1114.2 +089600 OPEN I-O RL-FS3. RL1114.2 +089700 MOVE "VIII-29 4.5.4" TO ANSI-REFERENCE. RL1114.2 +089800 MOVE 0 TO REC-CT. RL1114.2 +089900 MOVE 2 TO RL-FS3-KEY. RL1114.2 +090000 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +090100 MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +090200 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +090300 REL-TEST-040-1. RL1114.2 +090400 MOVE "REL-TEST-040-1" TO PAR-NAME. RL1114.2 +090500 WRITE RL-FS3R1-F-G-240 RL1114.2 +090600 INVALID RL1114.2 +090700 PERFORM PASS RL1114.2 +090800 PERFORM PRINT-DETAIL RL1114.2 +090900 NOT INVALID RL1114.2 +091000 MOVE "DUPLICATE KEY SHOULD NOT HAVE BEEN WRITTEN" RL1114.2 +091100 TO RE-MARK RL1114.2 +091200 PERFORM FAIL RL1114.2 +091300 PERFORM PRINT-DETAIL RL1114.2 +091400 END-WRITE RL1114.2 +091500 MOVE "X" TO WRK-XN-00001-1. RL1114.2 +091600 REL-TEST-040-2. RL1114.2 +091700 MOVE "REL-TEST-040-2" TO PAR-NAME. RL1114.2 +091800 IF WRK-XN-00001-1 = "X" RL1114.2 +091900 PERFORM PASS RL1114.2 +092000 PERFORM PRINT-DETAIL RL1114.2 +092100 ELSE RL1114.2 +092200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +092300 MOVE "X" TO CORRECT-X RL1114.2 +092400 MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +092500 PERFORM FAIL RL1114.2 +092600 PERFORM PRINT-DETAIL. RL1114.2 +092700* RL1114.2 +092800 REL-INIT-050. RL1114.2 +092900 MOVE "VIII-38 4.9.4 GR9(A)" TO ANSI-REFERENCE. RL1114.2 +093000 MOVE 0 TO REC-CT. RL1114.2 +093100 MOVE 600 TO RL-FS3-KEY. RL1114.2 +093200 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +093300 MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +093400 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +093500 REL-TEST-050-1. RL1114.2 +093600 MOVE "REL-TEST-050-1" TO PAR-NAME. RL1114.2 +093700 WRITE RL-FS3R1-F-G-240 RL1114.2 +093800 INVALID RL1114.2 +093900 MOVE "NEW KEY, RECORD SHOULD HAVE BEEN WRITTEN OK" RL1114.2 +094000 TO RE-MARK RL1114.2 +094100 PERFORM FAIL RL1114.2 +094200 PERFORM PRINT-DETAIL RL1114.2 +094300 NOT INVALID RL1114.2 +094400 PERFORM PASS RL1114.2 +094500 PERFORM PRINT-DETAIL RL1114.2 +094600 END-WRITE RL1114.2 +094700 MOVE "X" TO WRK-XN-00001-1. RL1114.2 +094800 REL-TEST-050-2. RL1114.2 +094900 MOVE "REL-TEST-050-2" TO PAR-NAME. RL1114.2 +095000 IF WRK-XN-00001-1 = "X" RL1114.2 +095100 PERFORM PASS RL1114.2 +095200 PERFORM PRINT-DETAIL RL1114.2 +095300 ELSE RL1114.2 +095400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +095500 MOVE "X" TO CORRECT-X RL1114.2 +095600 MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +095700 PERFORM FAIL RL1114.2 +095800 PERFORM PRINT-DETAIL. RL1114.2 +095900* RL1114.2 +096000 REL-INIT-060. RL1114.2 +096100 MOVE "VIII-38 4.5.4 GR9(B)" TO ANSI-REFERENCE. RL1114.2 +096200 CLOSE RL-FS3. RL1114.2 +096300 OPEN INPUT RL-FS3. RL1114.2 +096400 MOVE 0 TO REC-CT. RL1114.2 +096500 MOVE 99999998 TO RL-FS3-KEY. RL1114.2 +096600 MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +096700 MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +096800 MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +096900 REL-TEST-060-1. RL1114.2 +097000 MOVE "REL-TEST-060-1" TO PAR-NAME. RL1114.2 +097100 WRITE RL-FS3R1-F-G-240. RL1114.2 +097200 IF RL-FS3-STATUS NOT = "48" RL1114.2 +097300 MOVE "WRITE TO FILE OPENED INPUT NOT ALLOWED" RL1114.2 +097400 TO RE-MARK RL1114.2 +097500 ELSE RL1114.2 +097600 MOVE "SHOULD HAVE ACTIONED DECLARATIVES" TO RE-MARK. RL1114.2 +097700 PERFORM FAIL RL1114.2 +097800 PERFORM PRINT-DETAIL. RL1114.2 +097900* ENTRY TO THE DECLARATIVES CLOSES ALL FILES AND RL1114.2 +098000* TERMINATES THE PROGRAM. RL1114.2 +098100* EXECUTION SHOULD REACH THIS POINT ONLY AS RESULT OF AN ERROR RL1114.2 +098200 CLOSE RL-FS3. RL1114.2 +098300* RL1114.2 +098400 REL-INIT-070. RL1114.2 +098500* MOVE "VIII-30 4.6.2" TO ANSI-REFERENCE. RL1114.2 +098600* OPEN I-O RL-FS3. RL1114.2 +098700* MOVE 0 TO REC-CT. RL1114.2 +098800* MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +098900* MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +099000* MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +099100*REL-TEST-070-1. RL1114.2 +099200* MOVE "REL-TEST-070-1" TO PAR-NAME. RL1114.2 +099300* READ RL-FS3 RL1114.2 +099400* INVALID RL1114.2 +099500* MOVE "INVALID KEY ON FIRST READ" TO RE-MARK RL1114.2 +099600* PERFORM FAIL RL1114.2 +099700* PERFORM PRINT-DETAIL RL1114.2 +099800* NOT INVALID KEY RL1114.2 +099900* PERFORM PASS RL1114.2 +100000* PERFORM PRINT-DETAIL RL1114.2 +100100* END-READ RL1114.2 +100200* MOVE "X" TO WRK-XN-00001-1. RL1114.2 +100300*REL-TEST-070-2. RL1114.2 +100400* MOVE "REL-TEST-070-2" TO PAR-NAME. RL1114.2 +100500* IF WRK-XN-00001-1 = "X" RL1114.2 +100600* PERFORM PASS RL1114.2 +100700* PERFORM PRINT-DETAIL RL1114.2 +100800* ELSE RL1114.2 +100900* MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +101000* MOVE "X" TO CORRECT-X RL1114.2 +101100* MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +101200* PERFORM FAIL RL1114.2 +101300* PERFORM PRINT-DETAIL. RL1114.2 +101400*REL-TEST-070-3. RL1114.2 +101500* MOVE "REL-TEST-070-3" TO PAR-NAME. RL1114.2 +101600* RL1114.2 +101700* IF WRK-XN-00001-2 = "@" RL1114.2 +101800* PERFORM PASS RL1114.2 +101900* PERFORM PRINT-DETAIL RL1114.2 +102000* ELSE RL1114.2 +102100* MOVE "'USE AFTER' PROCEDURE NOT ACTIONED" RL1114.2 +102200* TO RE-MARK RL1114.2 +102300* MOVE "@" TO CORRECT-X RL1114.2 +102400* MOVE WRK-XN-00001-2 TO COMPUTED-X RL1114.2 +102500* PERFORM FAIL RL1114.2 +102600* PERFORM PRINT-DETAIL. RL1114.2 +102700* RL1114.2 +102800* RL1114.2 +102900*REL-INIT-080. RL1114.2 +103000* MOVE "VIII-30 4.6.2" TO ANSI-REFERENCE. RL1114.2 +103100* CLOSE RL-FS3. RL1114.2 +103200* OPEN I-O RL-FS3. RL1114.2 +103300* MOVE 0 TO REC-CT. RL1114.2 +103400* MOVE 900000002 TO RL-FS3-KEY. RL1114.2 +103500* MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +103600* MOVE SPACES TO RL-FS3-STATUS. RL1114.2 +103700* MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +103800*REL-TEST-080-1. RL1114.2 +103900* MOVE "REL-TEST-080-1" TO PAR-NAME. RL1114.2 +104000* READ RL-FS3 RL1114.2 +104100* INVALID RL1114.2 +104200* MOVE "INVALID KEY ON FIRST READ" TO RE-MARK RL1114.2 +104300* PERFORM FAIL RL1114.2 +104400* PERFORM PRINT-DETAIL RL1114.2 +104500* NOT INVALID KEY RL1114.2 +104600* PERFORM PASS RL1114.2 +104700* PERFORM PRINT-DETAIL RL1114.2 +104800* END-READ RL1114.2 +104900* MOVE "X" TO WRK-XN-00001-1. RL1114.2 +105000*REL-TEST-080-2. RL1114.2 +105100* MOVE "REL-TEST-080-2" TO PAR-NAME. RL1114.2 +105200* IF WRK-XN-00001-1 = "X" RL1114.2 +105300* PERFORM PASS RL1114.2 +105400* PERFORM PRINT-DETAIL RL1114.2 +105500* ELSE RL1114.2 +105600* MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +105700* MOVE "X" TO CORRECT-X RL1114.2 +105800* MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +105900* PERFORM FAIL RL1114.2 +106000* PERFORM PRINT-DETAIL. RL1114.2 +106100* RL1114.2 +106200* RL1114.2 +106300*REL-INIT-090. RL1114.2 +106400* MOVE "VIII-30 4.6.2" TO ANSI-REFERENCE. RL1114.2 +106500* MOVE SPACES TO WRK-XN-00001-1. RL1114.2 +106600* MOVE SPACES TO RL-FS2-STATUS. RL1114.2 +106700* MOVE SPACES TO FILE-RECORD-INFO-P1-120 (2). RL1114.2 +106800*REL-TEST-090-1. RL1114.2 +106900* MOVE "REL-TEST-090-1" TO PAR-NAME. RL1114.2 +107000* REWRITE RL-FS2R1-F-G-240 RL1114.2 +107100* INVALID KEY RL1114.2 +107200* MOVE "INVALID KEY ON REWRITE" TO RE-MARK RL1114.2 +107300* PERFORM FAIL RL1114.2 +107400* PERFORM PRINT-DETAIL RL1114.2 +107500* NOT INVALID KEY RL1114.2 +107600* PERFORM PASS RL1114.2 +107700* PERFORM PRINT-DETAIL RL1114.2 +107800* END-REWRITE RL1114.2 +107900* MOVE "X" TO WRK-XN-00001-1. RL1114.2 +108000*REL-TEST-090-2. RL1114.2 +108100* MOVE "REL-TEST-090-2" TO PAR-NAME. RL1114.2 +108200* IF WRK-XN-00001-1 = "X" RL1114.2 +108300* PERFORM PASS RL1114.2 +108400* PERFORM PRINT-DETAIL RL1114.2 +108500* ELSE RL1114.2 +108600* MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL1114.2 +108700* MOVE "X" TO CORRECT-X RL1114.2 +108800* MOVE WRK-XN-00001-1 TO COMPUTED-X RL1114.2 +108900* PERFORM FAIL RL1114.2 +109000* PERFORM PRINT-DETAIL. RL1114.2 +109100* RL1114.2 +109200 CCVS-EXIT SECTION. RL1114.2 +109300 CCVS-999999. RL1114.2 +109400 GO TO CLOSE-FILES. RL1114.2 diff --git a/tests/cobol85/RL/RL112A.CBL b/tests/cobol85/RL/RL112A.CBL new file mode 100644 index 00000000..97917c7c --- /dev/null +++ b/tests/cobol85/RL/RL112A.CBL @@ -0,0 +1,642 @@ +000100 IDENTIFICATION DIVISION. RL1124.2 +000200 PROGRAM-ID. RL1124.2 +000300 RL112A. RL1124.2 +000400**************************************************************** RL1124.2 +000500* * RL1124.2 +000600* VALIDATION FOR:- * RL1124.2 +000700* * RL1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1124.2 +000900* * RL1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1124.2 +001100* * RL1124.2 +001200**************************************************************** RL1124.2 +001300* * RL1124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1124.2 +001500* * RL1124.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1124.2 +001700* RELATIVE I-O DATA FILE * RL1124.2 +001800* X-55 SYSTEM PRINTER * RL1124.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1124.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1124.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1124.2 +002200* X-82 SOURCE-COMPUTER * RL1124.2 +002300* X-83 OBJECT-COMPUTER. * RL1124.2 +002400* * RL1124.2 +002500**************************************************************** RL1124.2 +002600* RL112A * RL1124.2 +002700**************************************************************** RL1124.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1124.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "USE" RL1124.2 +003000* STATEMENT. RL1124.2 +003100* RL1124.2 +003200* RL1124.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL1124.2 +003400* (ACCESS MODE RANDOM) AND THEN UPDATES SELECTIVE RL1124.2 +003500* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL1124.2 +003600* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL1124.2 +003700* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL1124.2 +003800* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL1124.2 +003900* AT END OR INVALID KEY PHRASES. THE OMISSION OF THESERL1124.2 +004000* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL1124.2 +004100* HAS BEEN SPECIFIED. RL1124.2 +004200* RL1124.2 +004300*************************************************** RL1124.2 +004400 ENVIRONMENT DIVISION. RL1124.2 +004500 CONFIGURATION SECTION. RL1124.2 +004600 SOURCE-COMPUTER. RL1124.2 +004700 Linux. RL1124.2 +004800 OBJECT-COMPUTER. RL1124.2 +004900 Linux. RL1124.2 +005000 INPUT-OUTPUT SECTION. RL1124.2 +005100 FILE-CONTROL. RL1124.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1124.2 +005300 "report.log". RL1124.2 +005400 SELECT RL-FD2 ASSIGN RL1124.2 +005500 "XXXXX022" RL1124.2 +005600 ORGANIZATION RELATIVE RL1124.2 +005700 ACCESS RANDOM RL1124.2 +005800 RELATIVE RL-FD2-KEY RL1124.2 +005900 FILE STATUS IS RL-FD2-STATUS. RL1124.2 +006000 DATA DIVISION. RL1124.2 +006100 FILE SECTION. RL1124.2 +006200 FD PRINT-FILE. RL1124.2 +006300 01 PRINT-REC PICTURE X(120). RL1124.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1124.2 +006500 FD RL-FD2 RL1124.2 +006600*C VALUE OF RL1124.2 +006700*C OCLABELID RL1124.2 +006800*C IS RL1124.2 +006900*C "OCDUMMY" RL1124.2 +007000*G SYSIN RL1124.2 +007100 LABEL RECORDS ARE STANDARD RL1124.2 +007200 BLOCK CONTAINS 1 RECORDS RL1124.2 +007300 DATA RECORD RL-FD2R1-F-G-240. RL1124.2 +007400 01 RL-FD2R1-F-G-240. RL1124.2 +007500 05 RL-FD2-WRK-120 PIC X(120). RL1124.2 +007600 05 RL-FD2-GRP-120. RL1124.2 +007700 10 RL-FD2-WRK-XN-0001-O120F RL1124.2 +007800 PICTURE X OCCURS 120 TIMES. RL1124.2 +007900 WORKING-STORAGE SECTION. RL1124.2 +008000 01 GRP-0001. RL1124.2 +008100 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1124.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1124.2 +008900 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1124.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1124.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1124.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1124.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1124.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1124.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1124.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1124.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1124.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1124.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1124.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1124.2 +010100 05 FILLER PICTURE X(48) VALUE RL1124.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1124.2 +010300 05 FILLER PICTURE X(46) VALUE RL1124.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1124.2 +010500 05 FILLER PICTURE X(26) VALUE RL1124.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1124.2 +010700 05 FILLER PICTURE X(37) VALUE RL1124.2 +010800 ",RECKEY= ". RL1124.2 +010900 05 FILLER PICTURE X(38) VALUE RL1124.2 +011000 ",ALTKEY1= ". RL1124.2 +011100 05 FILLER PICTURE X(38) VALUE RL1124.2 +011200 ",ALTKEY2= ". RL1124.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1124.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1124.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1124.2 +011600 07 FILLER PIC X(5). RL1124.2 +011700 07 XFILE-NAME PIC X(6). RL1124.2 +011800 07 FILLER PIC X(8). RL1124.2 +011900 07 XRECORD-NAME PIC X(6). RL1124.2 +012000 07 FILLER PIC X(1). RL1124.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1124.2 +012200 07 FILLER PIC X(7). RL1124.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1124.2 +012400 07 FILLER PIC X(6). RL1124.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1124.2 +012600 07 FILLER PIC X(5). RL1124.2 +012700 07 ODO-NUMBER PIC 9(4). RL1124.2 +012800 07 FILLER PIC X(5). RL1124.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1124.2 +013000 07 FILLER PIC X(7). RL1124.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1124.2 +013200 07 FILLER PIC X(7). RL1124.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1124.2 +013400 07 FILLER PIC X(1). RL1124.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1124.2 +013600 07 FILLER PIC X(6). RL1124.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1124.2 +013800 07 FILLER PIC X(5). RL1124.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1124.2 +014000 07 FILLER PIC X(6). RL1124.2 +014100 07 XLABEL-TYPE PIC X(1). RL1124.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1124.2 +014300 07 FILLER PIC X(8). RL1124.2 +014400 07 XRECORD-KEY PIC X(29). RL1124.2 +014500 07 FILLER PIC X(9). RL1124.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1124.2 +014700 07 FILLER PIC X(9). RL1124.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1124.2 +014900 07 FILLER PIC X(7). RL1124.2 +015000 01 TEST-RESULTS. RL1124.2 +015100 02 FILLER PIC X VALUE SPACE. RL1124.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1124.2 +015300 02 FILLER PIC X VALUE SPACE. RL1124.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1124.2 +015500 02 FILLER PIC X VALUE SPACE. RL1124.2 +015600 02 PAR-NAME. RL1124.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1124.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1124.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1124.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1124.2 +016100 02 RE-MARK PIC X(61). RL1124.2 +016200 01 TEST-COMPUTED. RL1124.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1124.2 +016400 02 FILLER PIC X(17) VALUE RL1124.2 +016500 " COMPUTED=". RL1124.2 +016600 02 COMPUTED-X. RL1124.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1124.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1124.2 +016900 PIC -9(9).9(9). RL1124.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1124.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1124.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1124.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1124.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1124.2 +017500 04 FILLER PIC X. RL1124.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1124.2 +017700 01 TEST-CORRECT. RL1124.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1124.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1124.2 +018000 02 CORRECT-X. RL1124.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1124.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1124.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1124.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1124.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1124.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1124.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1124.2 +018800 04 FILLER PIC X. RL1124.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1124.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1124.2 +019100 01 CCVS-C-1. RL1124.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1124.2 +019300- "SS PARAGRAPH-NAME RL1124.2 +019400- " REMARKS". RL1124.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1124.2 +019600 01 CCVS-C-2. RL1124.2 +019700 02 FILLER PIC X VALUE SPACE. RL1124.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1124.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1124.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1124.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1124.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1124.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1124.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1124.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1124.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1124.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1124.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1124.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1124.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1124.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1124.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1124.2 +021300 01 CCVS-H-1. RL1124.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1124.2 +021500 02 FILLER PIC X(42) VALUE RL1124.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1124.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1124.2 +021800 01 CCVS-H-2A. RL1124.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1124.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1124.2 +022100 02 FILLER PIC XXXX VALUE RL1124.2 +022200 "4.2 ". RL1124.2 +022300 02 FILLER PIC X(28) VALUE RL1124.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1124.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1124.2 +022600 RL1124.2 +022700 01 CCVS-H-2B. RL1124.2 +022800 02 FILLER PIC X(15) VALUE RL1124.2 +022900 "TEST RESULT OF ". RL1124.2 +023000 02 TEST-ID PIC X(9). RL1124.2 +023100 02 FILLER PIC X(4) VALUE RL1124.2 +023200 " IN ". RL1124.2 +023300 02 FILLER PIC X(12) VALUE RL1124.2 +023400 " HIGH ". RL1124.2 +023500 02 FILLER PIC X(22) VALUE RL1124.2 +023600 " LEVEL VALIDATION FOR ". RL1124.2 +023700 02 FILLER PIC X(58) VALUE RL1124.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1124.2 +023900 01 CCVS-H-3. RL1124.2 +024000 02 FILLER PIC X(34) VALUE RL1124.2 +024100 " FOR OFFICIAL USE ONLY ". RL1124.2 +024200 02 FILLER PIC X(58) VALUE RL1124.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1124.2 +024400 02 FILLER PIC X(28) VALUE RL1124.2 +024500 " COPYRIGHT 1985 ". RL1124.2 +024600 01 CCVS-E-1. RL1124.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1124.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1124.2 +024900 02 ID-AGAIN PIC X(9). RL1124.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1124.2 +025100 01 CCVS-E-2. RL1124.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1124.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1124.2 +025400 02 CCVS-E-2-2. RL1124.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1124.2 +025600 03 FILLER PIC X VALUE SPACE. RL1124.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1124.2 +025800 "ERRORS ENCOUNTERED". RL1124.2 +025900 01 CCVS-E-3. RL1124.2 +026000 02 FILLER PIC X(22) VALUE RL1124.2 +026100 " FOR OFFICIAL USE ONLY". RL1124.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1124.2 +026300 02 FILLER PIC X(58) VALUE RL1124.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1124.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1124.2 +026600 02 FILLER PIC X(15) VALUE RL1124.2 +026700 " COPYRIGHT 1985". RL1124.2 +026800 01 CCVS-E-4. RL1124.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1124.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1124.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1124.2 +027200 02 FILLER PIC X(40) VALUE RL1124.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1124.2 +027400 01 XXINFO. RL1124.2 +027500 02 FILLER PIC X(19) VALUE RL1124.2 +027600 "*** INFORMATION ***". RL1124.2 +027700 02 INFO-TEXT. RL1124.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1124.2 +027900 04 XXCOMPUTED PIC X(20). RL1124.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1124.2 +028100 04 XXCORRECT PIC X(20). RL1124.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1124.2 +028300 01 HYPHEN-LINE. RL1124.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1124.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1124.2 +028600- "*****************************************". RL1124.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1124.2 +028800- "******************************". RL1124.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1124.2 +029000 "RL112A". RL1124.2 +029100 PROCEDURE DIVISION. RL1124.2 +029200 DECLARATIVES. RL1124.2 +029300 RL-FD2-01 SECTION. RL1124.2 +029400 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FD2. RL1124.2 +029500 RL-FD2-01-01. RL1124.2 +029600 ADD 1 TO WRK-CS-09V00-013. RL1124.2 +029700 GO TO RL-FD2-01-03 RL1124.2 +029800 RL-FD2-01-05 RL1124.2 +029900 DEPENDING ON WRK-CS-09V00-012. RL1124.2 +030000 GO TO RL-FD2-01-EXIT. RL1124.2 +030100 RL-FD2-01-03. RL1124.2 +030200*ENTRY FROM SEGMENT REL-TEST-009. RL1124.2 +030300* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL1124.2 +030400 ADD 1 TO WRK-CS-09V00-014. RL1124.2 +030500 RL-FD2-01-05. RL1124.2 +030600 ADD 1 TO WRK-CS-09V00-017. RL1124.2 +030700 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1124.2 +030800 MOVE RL-FD2-STATUS TO WRK-XN-0002-002 RL1124.2 +030900 MOVE "23" TO WRK-XN-0002-003. RL1124.2 +031000 RL-FD2-01-EXIT. RL1124.2 +031100 EXIT. RL1124.2 +031200 END DECLARATIVES. RL1124.2 +031300 CCVS1 SECTION. RL1124.2 +031400 OPEN-FILES. RL1124.2 +031500 OPEN OUTPUT PRINT-FILE. RL1124.2 +031600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1124.2 +031700 MOVE SPACE TO TEST-RESULTS. RL1124.2 +031800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1124.2 +031900 MOVE ZERO TO REC-SKL-SUB. RL1124.2 +032000 PERFORM CCVS-INIT-FILE 9 TIMES. RL1124.2 +032100 CCVS-INIT-FILE. RL1124.2 +032200 ADD 1 TO REC-SKL-SUB. RL1124.2 +032300 MOVE FILE-RECORD-INFO-SKELETON RL1124.2 +032400 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1124.2 +032500 CCVS-INIT-EXIT. RL1124.2 +032600 GO TO CCVS1-EXIT. RL1124.2 +032700 CLOSE-FILES. RL1124.2 +032800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1124.2 +032900 TERMINATE-CCVS. RL1124.2 +033000*S EXIT PROGRAM. RL1124.2 +033100*SERMINATE-CALL. RL1124.2 +033200 STOP RUN. RL1124.2 +033300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1124.2 +033400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1124.2 +033500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1124.2 +033600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1124.2 +033700 MOVE "****TEST DELETED****" TO RE-MARK. RL1124.2 +033800 PRINT-DETAIL. RL1124.2 +033900 IF REC-CT NOT EQUAL TO ZERO RL1124.2 +034000 MOVE "." TO PARDOT-X RL1124.2 +034100 MOVE REC-CT TO DOTVALUE. RL1124.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1124.2 +034300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1124.2 +034400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1124.2 +034500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1124.2 +034600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1124.2 +034700 MOVE SPACE TO CORRECT-X. RL1124.2 +034800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1124.2 +034900 MOVE SPACE TO RE-MARK. RL1124.2 +035000 HEAD-ROUTINE. RL1124.2 +035100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +035200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +035300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1124.2 +035400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1124.2 +035500 COLUMN-NAMES-ROUTINE. RL1124.2 +035600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +035700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +035900 END-ROUTINE. RL1124.2 +036000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1124.2 +036100 END-RTN-EXIT. RL1124.2 +036200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +036300 END-ROUTINE-1. RL1124.2 +036400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1124.2 +036500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1124.2 +036600 ADD PASS-COUNTER TO ERROR-HOLD. RL1124.2 +036700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1124.2 +036800 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1124.2 +036900 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1124.2 +037000 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1124.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1124.2 +037200 END-ROUTINE-12. RL1124.2 +037300 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1124.2 +037400 IF ERROR-COUNTER IS EQUAL TO ZERO RL1124.2 +037500 MOVE "NO " TO ERROR-TOTAL RL1124.2 +037600 ELSE RL1124.2 +037700 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1124.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1124.2 +037900 PERFORM WRITE-LINE. RL1124.2 +038000 END-ROUTINE-13. RL1124.2 +038100 IF DELETE-COUNTER IS EQUAL TO ZERO RL1124.2 +038200 MOVE "NO " TO ERROR-TOTAL ELSE RL1124.2 +038300 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1124.2 +038400 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1124.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +038600 IF INSPECT-COUNTER EQUAL TO ZERO RL1124.2 +038700 MOVE "NO " TO ERROR-TOTAL RL1124.2 +038800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1124.2 +038900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1124.2 +039000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +039100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1124.2 +039200 WRITE-LINE. RL1124.2 +039300 ADD 1 TO RECORD-COUNT. RL1124.2 +039400 IF RECORD-COUNT GREATER 50 RL1124.2 +039500 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1124.2 +039600 MOVE SPACE TO DUMMY-RECORD RL1124.2 +039700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1124.2 +039800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1124.2 +039900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1124.2 +040000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1124.2 +040100 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1124.2 +040200 MOVE ZERO TO RECORD-COUNT. RL1124.2 +040300 PERFORM WRT-LN. RL1124.2 +040400 WRT-LN. RL1124.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1124.2 +040600 MOVE SPACE TO DUMMY-RECORD. RL1124.2 +040700 BLANK-LINE-PRINT. RL1124.2 +040800 PERFORM WRT-LN. RL1124.2 +040900 FAIL-ROUTINE. RL1124.2 +041000 IF COMPUTED-X NOT EQUAL TO SPACE RL1124.2 +041100 GO TO FAIL-ROUTINE-WRITE. RL1124.2 +041200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1124.2 +041300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1124.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1124.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1124.2 +041700 GO TO FAIL-ROUTINE-EX. RL1124.2 +041800 FAIL-ROUTINE-WRITE. RL1124.2 +041900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1124.2 +042000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1124.2 +042100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1124.2 +042200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1124.2 +042300 FAIL-ROUTINE-EX. EXIT. RL1124.2 +042400 BAIL-OUT. RL1124.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1124.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1124.2 +042700 BAIL-OUT-WRITE. RL1124.2 +042800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1124.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1124.2 +043000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1124.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1124.2 +043200 BAIL-OUT-EX. EXIT. RL1124.2 +043300 CCVS1-EXIT. RL1124.2 +043400 EXIT. RL1124.2 +043500 SECT-RL112A-001 SECTION. RL1124.2 +043600 REL-INIT-009. RL1124.2 +043700 MOVE "REL-TEST-009" TO PAR-NAME. RL1124.2 +043800 MOVE "CREATE RL-FD2" TO FEATURE RL1124.2 +043900 MOVE "RL-FD2" TO XFILE-NAME (2). RL1124.2 +044000 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1124.2 +044100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1124.2 +044200 MOVE 000240 TO XRECORD-LENGTH (2). RL1124.2 +044300 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1124.2 +044400 MOVE 0001 TO XBLOCK-SIZE (2). RL1124.2 +044500 MOVE 000500 TO RECORDS-IN-FILE (2). RL1124.2 +044600 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1124.2 +044700 MOVE "S" TO XLABEL-TYPE (2). RL1124.2 +044800 MOVE 000001 TO XRECORD-NUMBER (2). RL1124.2 +044900*INITIALIZE RECORD WORK AREA NUMBER 2. RL1124.2 +045000 MOVE 1 TO WRK-CS-09V00-012. RL1124.2 +045100 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1124.2 +045200 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1124.2 +045300 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1124.2 +045400 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +045500 MOVE 90000002 TO RL-FD2-KEY. RL1124.2 +045600 MOVE 01 TO REC-CT. RL1124.2 +045700 OPEN OUTPUT RL-FD2. RL1124.2 +045800 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1124.2 +045900*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1124.2 +046000 REL-TEST-009-R. RL1124.2 +046100 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1124.2 +046200 MOVE "99" TO RL-FD2-STATUS. RL1124.2 +046300 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1124.2 +046400 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1124.2 +046500 RL-FD2-GRP-120. RL1124.2 +046600 WRITE RL-FD2R1-F-G-240. RL1124.2 +046700 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +046800 GO TO REL-TEST-009-2. RL1124.2 +046900 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1124.2 +047000 GO TO REL-TEST-009-2. RL1124.2 +047100 ADD 01 TO XRECORD-NUMBER (2). RL1124.2 +047200 GO TO REL-TEST-009-R. RL1124.2 +047300 REL-TEST-009-2. RL1124.2 +047400 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1124.2 +047500 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1124.2 +047600 MOVE ZERO TO CORRECT-18V0 RL1124.2 +047700 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1124.2 +047800 PERFORM FAIL RL1124.2 +047900 ELSE RL1124.2 +048000 PERFORM PASS. RL1124.2 +048100 PERFORM PRINT-DETAIL. RL1124.2 +048200 ADD 01 TO REC-CT. RL1124.2 +048300* .01 RL1124.2 +048400 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1124.2 +048500 MOVE "INCORRECT COUNT" TO RE-MARK RL1124.2 +048600 MOVE 500 TO CORRECT-18V0 RL1124.2 +048700 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1124.2 +048800 PERFORM FAIL RL1124.2 +048900 ELSE RL1124.2 +049000 PERFORM PASS. RL1124.2 +049100 PERFORM PRINT-DETAIL. RL1124.2 +049200 ADD 01 TO REC-CT. RL1124.2 +049300* .02 RL1124.2 +049400 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1124.2 +049500 MOVE "STATUS/OPEN" TO RE-MARK RL1124.2 +049600 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1124.2 +049700 MOVE "00" TO CORRECT-A RL1124.2 +049800 PERFORM FAIL RL1124.2 +049900 ELSE RL1124.2 +050000 PERFORM PASS. RL1124.2 +050100 PERFORM PRINT-DETAIL. RL1124.2 +050200 ADD 01 TO REC-CT. RL1124.2 +050300* .03 RL1124.2 +050400 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +050500 MOVE "STATUS/WRITE" TO RE-MARK RL1124.2 +050600 MOVE RL-FD2-STATUS TO COMPUTED-A RL1124.2 +050700 MOVE "00" TO CORRECT-A RL1124.2 +050800 PERFORM FAIL RL1124.2 +050900 ELSE RL1124.2 +051000 PERFORM PASS. RL1124.2 +051100 PERFORM PRINT-DETAIL. RL1124.2 +051200 ADD 01 TO REC-CT. RL1124.2 +051300* .04 RL1124.2 +051400 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +051500 CLOSE RL-FD2. RL1124.2 +051600 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +051700 MOVE "CLOSE/STATUS" TO RE-MARK RL1124.2 +051800 MOVE RL-FD2-STATUS TO COMPUTED-A RL1124.2 +051900 MOVE "00" TO CORRECT-A RL1124.2 +052000 PERFORM FAIL RL1124.2 +052100 ELSE RL1124.2 +052200 PERFORM PASS. RL1124.2 +052300 PERFORM PRINT-DETAIL. RL1124.2 +052400 ADD 01 TO REC-CT. RL1124.2 +052500* .05 RL1124.2 +052600 REL-INIT-010. RL1124.2 +052700 MOVE "REL-TEST-010" TO PAR-NAME. RL1124.2 +052800 MOVE 2 TO WRK-CS-09V00-012. RL1124.2 +052900 MOVE ZERO TO RL-FD2-KEY. RL1124.2 +053000 MOVE ZERO TO WRK-CS-09V00-013. RL1124.2 +053100 MOVE ZERO TO WRK-CS-09V00-014. RL1124.2 +053200 MOVE ZERO TO WRK-CS-09V00-015. RL1124.2 +053300 MOVE ZERO TO WRK-CS-09V00-016. RL1124.2 +053400 MOVE ZERO TO WRK-CS-09V00-017. RL1124.2 +053500 MOVE ZERO TO WRK-CS-09V00-018. RL1124.2 +053600 MOVE 01 TO REC-CT. RL1124.2 +053700 OPEN I-O RL-FD2. RL1124.2 +053800 MOVE SPACE TO WRK-XN-0002-002 RL1124.2 +053900 MOVE SPACE TO WRK-XN-0002-003 RL1124.2 +054000 MOVE SPACE TO WRK-XN-0002-004 RL1124.2 +054100 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL1124.2 +054200 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +054300*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1124.2 +054400 MOVE "USE/FILE STATUS" TO FEATURE. RL1124.2 +054500 REL-TEST-010-R. RL1124.2 +054600 ADD 1 TO WRK-CS-09V00-014. RL1124.2 +054700 ADD 1 TO WRK-CS-09V00-015. RL1124.2 +054800 ADD 1 TO RL-FD2-KEY. RL1124.2 +054900 READ RL-FD2 RECORD. RL1124.2 +055000 IF RL-FD2-STATUS EQUAL TO "23" RL1124.2 +055100 GO TO REL-TEST-010-3. RL1124.2 +055200 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1124.2 +055300 IF WRK-CS-09V00-015 EQUAL TO 5 RL1124.2 +055400 ADD 01 TO UPDATE-NUMBER (2) RL1124.2 +055500 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL1124.2 +055600 REWRITE RL-FD2R1-F-G-240 RL1124.2 +055700 MOVE ZERO TO WRK-CS-09V00-015 RL1124.2 +055800 GO TO REL-TEST-010-2. RL1124.2 +055900 IF WRK-CS-09V00-014 GREATER 500 RL1124.2 +056000 GO TO REL-TEST-010-3. RL1124.2 +056100 GO TO REL-TEST-010-R. RL1124.2 +056200 REL-TEST-010-2. RL1124.2 +056300 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +056400 ADD 1 TO WRK-CS-09V00-016. RL1124.2 +056500 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +056600 GO TO REL-TEST-010-R. RL1124.2 +056700 REL-TEST-010-3. RL1124.2 +056800 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1124.2 +056900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1124.2 +057000 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1124.2 +057100 MOVE 1 TO CORRECT-18V0 RL1124.2 +057200 PERFORM FAIL RL1124.2 +057300 ELSE RL1124.2 +057400 PERFORM PASS. RL1124.2 +057500 PERFORM PRINT-DETAIL. RL1124.2 +057600 ADD 01 TO REC-CT. RL1124.2 +057700* .01 RL1124.2 +057800 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1124.2 +057900 MOVE "INCORRECT COUNT" TO RE-MARK RL1124.2 +058000 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1124.2 +058100 MOVE 501 TO CORRECT-18V0 RL1124.2 +058200 PERFORM FAIL RL1124.2 +058300 ELSE RL1124.2 +058400 PERFORM PASS. RL1124.2 +058500 PERFORM PRINT-DETAIL. RL1124.2 +058600 ADD 01 TO REC-CT. RL1124.2 +058700* .02 RL1124.2 +058800 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1124.2 +058900 MOVE "OPEN/STATUS" TO RE-MARK RL1124.2 +059000 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1124.2 +059100 MOVE "00" TO CORRECT-A RL1124.2 +059200 PERFORM FAIL RL1124.2 +059300 ELSE RL1124.2 +059400 PERFORM PASS. RL1124.2 +059500 PERFORM PRINT-DETAIL. RL1124.2 +059600 ADD 01 TO REC-CT. RL1124.2 +059700* .03 RL1124.2 +059800 IF RL-FD2-STATUS NOT EQUAL TO "23" RL1124.2 +059900 MOVE "ATEND/STATUS" TO RE-MARK RL1124.2 +060000 MOVE RL-FD2-STATUS TO COMPUTED-A RL1124.2 +060100 MOVE "23" TO CORRECT-A RL1124.2 +060200 PERFORM FAIL RL1124.2 +060300 ELSE RL1124.2 +060400 PERFORM PASS. RL1124.2 +060500 PERFORM PRINT-DETAIL. RL1124.2 +060600 ADD 01 TO REC-CT. RL1124.2 +060700* .04 RL1124.2 +060800 IF WRK-XN-0002-002 NOT EQUAL TO "23" RL1124.2 +060900 MOVE "EXCEPTION/STATUS" TO RE-MARK RL1124.2 +061000 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1124.2 +061100 MOVE "23" TO CORRECT-A RL1124.2 +061200 PERFORM FAIL RL1124.2 +061300 ELSE RL1124.2 +061400 PERFORM PASS. RL1124.2 +061500 PERFORM PRINT-DETAIL. RL1124.2 +061600 ADD 01 TO REC-CT. RL1124.2 +061700* .05 RL1124.2 +061800 IF WRK-XN-0002-003 NOT EQUAL TO "23" RL1124.2 +061900 MOVE "NO/EXCEPTION" TO RE-MARK RL1124.2 +062000 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1124.2 +062100 MOVE "23" TO CORRECT-A RL1124.2 +062200 PERFORM FAIL RL1124.2 +062300 ELSE RL1124.2 +062400 PERFORM PASS. RL1124.2 +062500 PERFORM PRINT-DETAIL RL1124.2 +062600 ADD 01 TO REC-CT. RL1124.2 +062700* .06 RL1124.2 +062800 MOVE SPACE TO RL-FD2-STATUS. RL1124.2 +062900 CLOSE RL-FD2 RL1124.2 +063000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1124.2 +063100 MOVE "CLOSE/STATUS" TO RE-MARK RL1124.2 +063200 MOVE RL-FD2-STATUS TO COMPUTED-A RL1124.2 +063300 MOVE "00" TO CORRECT-A RL1124.2 +063400 PERFORM FAIL RL1124.2 +063500 ELSE RL1124.2 +063600 PERFORM PASS. RL1124.2 +063700 PERFORM PRINT-DETAIL. RL1124.2 +063800 ADD 01 TO REC-CT. RL1124.2 +063900* .07 RL1124.2 +064000 CCVS-EXIT SECTION. RL1124.2 +064100 CCVS-999999. RL1124.2 +064200 GO TO CLOSE-FILES. RL1124.2 diff --git a/tests/cobol85/RL/RL113A.CBL b/tests/cobol85/RL/RL113A.CBL new file mode 100644 index 00000000..f3d20473 --- /dev/null +++ b/tests/cobol85/RL/RL113A.CBL @@ -0,0 +1,812 @@ +000100 IDENTIFICATION DIVISION. RL1134.2 +000200 PROGRAM-ID. RL1134.2 +000300 RL113A. RL1134.2 +000400**************************************************************** RL1134.2 +000500* * RL1134.2 +000600* VALIDATION FOR:- * RL1134.2 +000700* * RL1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1134.2 +000900* * RL1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1134.2 +001100* * RL1134.2 +001200**************************************************************** RL1134.2 +001300* * RL1134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1134.2 +001500* * RL1134.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1134.2 +001700* RELATIVE I-O DATA FILE * RL1134.2 +001800* X-55 SYSTEM PRINTER * RL1134.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1134.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1134.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1134.2 +002200* X-82 SOURCE-COMPUTER * RL1134.2 +002300* X-83 OBJECT-COMPUTER. * RL1134.2 +002400* * RL1134.2 +002500**************************************************************** RL1134.2 +002600* RL113A * RL1134.2 +002700**************************************************************** RL1134.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1134.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "USE" RL1134.2 +003000* STATEMENT. RL1134.2 +003100* RL1134.2 +003200* RL1134.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL1134.2 +003400* (ACCESS MODE RANDOM) AND THEN UPDATES SELECTIVE RL1134.2 +003500* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL1134.2 +003600* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL1134.2 +003700* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL1134.2 +003800* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL1134.2 +003900* AT END ON INVALID KEY PHRASES. THE OMISSION OF THESERL1134.2 +004000* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL1134.2 +004100* HAS BEEN SPECIFIED. RL1134.2 +004200* RL1134.2 +004300*************************************************** RL1134.2 +004400 ENVIRONMENT DIVISION. RL1134.2 +004500 CONFIGURATION SECTION. RL1134.2 +004600 SOURCE-COMPUTER. RL1134.2 +004700 Linux. RL1134.2 +004800 OBJECT-COMPUTER. RL1134.2 +004900 Linux. RL1134.2 +005000 INPUT-OUTPUT SECTION. RL1134.2 +005100 FILE-CONTROL. RL1134.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1134.2 +005300 "report.log". RL1134.2 +005400 SELECT RL-FD2 ASSIGN RL1134.2 +005500 "XXXXX022" RL1134.2 +005600 ORGANIZATION RELATIVE RL1134.2 +005700 ACCESS RANDOM RL1134.2 +005800 RELATIVE RL-FD2-KEY RL1134.2 +005900 FILE STATUS IS RL-FD2-STATUS. RL1134.2 +006000 DATA DIVISION. RL1134.2 +006100 FILE SECTION. RL1134.2 +006200 FD PRINT-FILE. RL1134.2 +006300 01 PRINT-REC PICTURE X(120). RL1134.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1134.2 +006500 FD RL-FD2 RL1134.2 +006600*C VALUE OF RL1134.2 +006700*C OCLABELID RL1134.2 +006800*C IS RL1134.2 +006900*C "OCDUMMY" RL1134.2 +007000*G SYSIN RL1134.2 +007100 LABEL RECORDS ARE STANDARD RL1134.2 +007200 BLOCK CONTAINS 1 RECORDS RL1134.2 +007300 DATA RECORD RL-FD2R1-F-G-240. RL1134.2 +007400 01 RL-FD2R1-F-G-240. RL1134.2 +007500 05 RL-FD2-WRK-120 PIC X(120). RL1134.2 +007600 05 RL-FD2-GRP-120. RL1134.2 +007700 10 RL-FD2-WRK-XN-0001-O120F RL1134.2 +007800 PICTURE X OCCURS 120 TIMES. RL1134.2 +007900 WORKING-STORAGE SECTION. RL1134.2 +008000 01 GRP-0001. RL1134.2 +008100 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1134.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1134.2 +008900 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1134.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1134.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1134.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1134.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1134.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1134.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1134.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1134.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1134.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1134.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1134.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1134.2 +010100 05 FILLER PICTURE X(48) VALUE RL1134.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1134.2 +010300 05 FILLER PICTURE X(46) VALUE RL1134.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1134.2 +010500 05 FILLER PICTURE X(26) VALUE RL1134.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1134.2 +010700 05 FILLER PICTURE X(37) VALUE RL1134.2 +010800 ",RECKEY= ". RL1134.2 +010900 05 FILLER PICTURE X(38) VALUE RL1134.2 +011000 ",ALTKEY1= ". RL1134.2 +011100 05 FILLER PICTURE X(38) VALUE RL1134.2 +011200 ",ALTKEY2= ". RL1134.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1134.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1134.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1134.2 +011600 07 FILLER PIC X(5). RL1134.2 +011700 07 XFILE-NAME PIC X(6). RL1134.2 +011800 07 FILLER PIC X(8). RL1134.2 +011900 07 XRECORD-NAME PIC X(6). RL1134.2 +012000 07 FILLER PIC X(1). RL1134.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1134.2 +012200 07 FILLER PIC X(7). RL1134.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1134.2 +012400 07 FILLER PIC X(6). RL1134.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1134.2 +012600 07 FILLER PIC X(5). RL1134.2 +012700 07 ODO-NUMBER PIC 9(4). RL1134.2 +012800 07 FILLER PIC X(5). RL1134.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1134.2 +013000 07 FILLER PIC X(7). RL1134.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1134.2 +013200 07 FILLER PIC X(7). RL1134.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1134.2 +013400 07 FILLER PIC X(1). RL1134.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1134.2 +013600 07 FILLER PIC X(6). RL1134.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1134.2 +013800 07 FILLER PIC X(5). RL1134.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1134.2 +014000 07 FILLER PIC X(6). RL1134.2 +014100 07 XLABEL-TYPE PIC X(1). RL1134.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1134.2 +014300 07 FILLER PIC X(8). RL1134.2 +014400 07 XRECORD-KEY PIC X(29). RL1134.2 +014500 07 FILLER PIC X(9). RL1134.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1134.2 +014700 07 FILLER PIC X(9). RL1134.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1134.2 +014900 07 FILLER PIC X(7). RL1134.2 +015000 01 TEST-RESULTS. RL1134.2 +015100 02 FILLER PIC X VALUE SPACE. RL1134.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1134.2 +015300 02 FILLER PIC X VALUE SPACE. RL1134.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1134.2 +015500 02 FILLER PIC X VALUE SPACE. RL1134.2 +015600 02 PAR-NAME. RL1134.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1134.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1134.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1134.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1134.2 +016100 02 RE-MARK PIC X(61). RL1134.2 +016200 01 TEST-COMPUTED. RL1134.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1134.2 +016400 02 FILLER PIC X(17) VALUE RL1134.2 +016500 " COMPUTED=". RL1134.2 +016600 02 COMPUTED-X. RL1134.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1134.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1134.2 +016900 PIC -9(9).9(9). RL1134.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1134.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1134.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1134.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1134.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1134.2 +017500 04 FILLER PIC X. RL1134.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1134.2 +017700 01 TEST-CORRECT. RL1134.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1134.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1134.2 +018000 02 CORRECT-X. RL1134.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1134.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1134.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1134.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1134.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1134.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1134.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1134.2 +018800 04 FILLER PIC X. RL1134.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1134.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1134.2 +019100 01 CCVS-C-1. RL1134.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1134.2 +019300- "SS PARAGRAPH-NAME RL1134.2 +019400- " REMARKS". RL1134.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1134.2 +019600 01 CCVS-C-2. RL1134.2 +019700 02 FILLER PIC X VALUE SPACE. RL1134.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1134.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1134.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1134.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1134.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1134.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1134.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1134.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1134.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1134.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1134.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1134.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1134.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1134.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1134.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1134.2 +021300 01 CCVS-H-1. RL1134.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1134.2 +021500 02 FILLER PIC X(42) VALUE RL1134.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1134.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1134.2 +021800 01 CCVS-H-2A. RL1134.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1134.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1134.2 +022100 02 FILLER PIC XXXX VALUE RL1134.2 +022200 "4.2 ". RL1134.2 +022300 02 FILLER PIC X(28) VALUE RL1134.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1134.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1134.2 +022600 RL1134.2 +022700 01 CCVS-H-2B. RL1134.2 +022800 02 FILLER PIC X(15) VALUE RL1134.2 +022900 "TEST RESULT OF ". RL1134.2 +023000 02 TEST-ID PIC X(9). RL1134.2 +023100 02 FILLER PIC X(4) VALUE RL1134.2 +023200 " IN ". RL1134.2 +023300 02 FILLER PIC X(12) VALUE RL1134.2 +023400 " HIGH ". RL1134.2 +023500 02 FILLER PIC X(22) VALUE RL1134.2 +023600 " LEVEL VALIDATION FOR ". RL1134.2 +023700 02 FILLER PIC X(58) VALUE RL1134.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1134.2 +023900 01 CCVS-H-3. RL1134.2 +024000 02 FILLER PIC X(34) VALUE RL1134.2 +024100 " FOR OFFICIAL USE ONLY ". RL1134.2 +024200 02 FILLER PIC X(58) VALUE RL1134.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1134.2 +024400 02 FILLER PIC X(28) VALUE RL1134.2 +024500 " COPYRIGHT 1985 ". RL1134.2 +024600 01 CCVS-E-1. RL1134.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1134.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1134.2 +024900 02 ID-AGAIN PIC X(9). RL1134.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1134.2 +025100 01 CCVS-E-2. RL1134.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1134.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1134.2 +025400 02 CCVS-E-2-2. RL1134.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1134.2 +025600 03 FILLER PIC X VALUE SPACE. RL1134.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1134.2 +025800 "ERRORS ENCOUNTERED". RL1134.2 +025900 01 CCVS-E-3. RL1134.2 +026000 02 FILLER PIC X(22) VALUE RL1134.2 +026100 " FOR OFFICIAL USE ONLY". RL1134.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1134.2 +026300 02 FILLER PIC X(58) VALUE RL1134.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1134.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1134.2 +026600 02 FILLER PIC X(15) VALUE RL1134.2 +026700 " COPYRIGHT 1985". RL1134.2 +026800 01 CCVS-E-4. RL1134.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1134.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1134.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1134.2 +027200 02 FILLER PIC X(40) VALUE RL1134.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1134.2 +027400 01 XXINFO. RL1134.2 +027500 02 FILLER PIC X(19) VALUE RL1134.2 +027600 "*** INFORMATION ***". RL1134.2 +027700 02 INFO-TEXT. RL1134.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1134.2 +027900 04 XXCOMPUTED PIC X(20). RL1134.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1134.2 +028100 04 XXCORRECT PIC X(20). RL1134.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1134.2 +028300 01 HYPHEN-LINE. RL1134.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1134.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1134.2 +028600- "*****************************************". RL1134.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1134.2 +028800- "******************************". RL1134.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1134.2 +029000 "RL113A". RL1134.2 +029100 PROCEDURE DIVISION. RL1134.2 +029200 DECLARATIVES. RL1134.2 +029300 RL-FD2-01 SECTION. RL1134.2 +029400 USE AFTER ERROR PROCEDURE INPUT. RL1134.2 +029500 RL-FD2-01-01. RL1134.2 +029600 MOVE "USE AFTER ERROR INPUT PROCEDURE SHOULD NOT BE OBEYED"RL1134.2 +029700 TO RE-MARK. RL1134.2 +029800 MOVE "RL-FD2-01-01" TO PAR-NAME. RL1134.2 +029900 MOVE "FAIL*" TO P-OR-F. RL1134.2 +030000 ADD 1 TO ERROR-COUNTER. RL1134.2 +030100* RL1134.2 +030200 IF REC-CT NOT EQUAL TO ZERO RL1134.2 +030300 MOVE "." TO PARDOT-X RL1134.2 +030400 MOVE REC-CT TO DOTVALUE. RL1134.2 +030500 MOVE TEST-RESULTS TO PRINT-REC. RL1134.2 +030600 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT. RL1134.2 +030700 IF P-OR-F EQUAL TO "FAIL*" RL1134.2 +030800 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT RL1134.2 +030900 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX RL1134.2 +031000 ELSE RL1134.2 +031100 PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. RL1134.2 +031200 MOVE SPACE TO P-OR-F. RL1134.2 +031300 MOVE SPACE TO COMPUTED-X. RL1134.2 +031400 MOVE SPACE TO CORRECT-X. RL1134.2 +031500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1134.2 +031600 MOVE SPACE TO RE-MARK. RL1134.2 +031700 GO TO RL-FD2-01-EXIT. RL1134.2 +031800 D1-FAIL-ROUTINE. RL1134.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE RL1134.2 +032000 GO TO D1-FAIL-ROUTINE-WRITE. RL1134.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE RL1134.2 +032200 GO TO D1-FAIL-ROUTINE-WRITE. RL1134.2 +032300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +032400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1134.2 +032500 MOVE XXINFO TO DUMMY-RECORD. RL1134.2 +032600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +032700 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +032900 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +033100 GO TO D1-FAIL-ROUTINE-EX. RL1134.2 +033200 D1-FAIL-ROUTINE-WRITE. RL1134.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC. RL1134.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +033500 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1134.2 +033700 MOVE TEST-CORRECT TO PRINT-REC. RL1134.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +033900 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +034000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +034100 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +034200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1134.2 +034300 D1-FAIL-ROUTINE-EX. RL1134.2 +034400 EXIT. RL1134.2 +034500 D1-BAIL-OUT. RL1134.2 +034600 IF COMPUTED-A NOT EQUAL TO SPACE RL1134.2 +034700 GO TO D1-BAIL-OUT-WRITE. RL1134.2 +034800 IF CORRECT-A EQUAL TO SPACE RL1134.2 +034900 GO TO D1-BAIL-OUT-EX. RL1134.2 +035000 D1-BAIL-OUT-WRITE. RL1134.2 +035100 MOVE CORRECT-A TO XXCORRECT. RL1134.2 +035200 MOVE COMPUTED-A TO XXCOMPUTED. RL1134.2 +035300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +035400 MOVE XXINFO TO DUMMY-RECORD. RL1134.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +035600 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +035800 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +035900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +036000 D1-BAIL-OUT-EX. RL1134.2 +036100 EXIT. RL1134.2 +036200 D1-WRITE-LINE. RL1134.2 +036300 ADD 1 TO RECORD-COUNT. RL1134.2 +036400 IF RECORD-COUNT GREATER 50 RL1134.2 +036500 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1134.2 +036600 MOVE SPACE TO DUMMY-RECORD RL1134.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1134.2 +036800 MOVE CCVS-C-1 TO DUMMY-RECORD RL1134.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +037000 MOVE SPACE TO DUMMY-RECORD RL1134.2 +037100 MOVE CCVS-C-2 TO DUMMY-RECORD RL1134.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +037300 MOVE SPACE TO DUMMY-RECORD RL1134.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +037500 MOVE SPACE TO DUMMY-RECORD RL1134.2 +037600 MOVE HYPHEN-LINE TO DUMMY-RECORD RL1134.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +037800 MOVE SPACE TO DUMMY-RECORD RL1134.2 +037900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1134.2 +038000 MOVE ZERO TO RECORD-COUNT. RL1134.2 +038100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +038200 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +038300 D1-WRITE-LINE-EXIT. RL1134.2 +038400 EXIT. RL1134.2 +038500 RL-FD2-01-EXIT. RL1134.2 +038600 EXIT. RL1134.2 +038700* RL1134.2 +038800 RL-FD2-02 SECTION. RL1134.2 +038900 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FD2. RL1134.2 +039000 RL-FD2-01-03. RL1134.2 +039100 MOVE "PASS " TO P-OR-F. RL1134.2 +039200 ADD 1 TO PASS-COUNTER. RL1134.2 +039300* RL1134.2 +039400 IF REC-CT NOT EQUAL TO ZERO RL1134.2 +039500 MOVE "." TO PARDOT-X RL1134.2 +039600 MOVE REC-CT TO DOTVALUE. RL1134.2 +039700 MOVE TEST-RESULTS TO PRINT-REC. RL1134.2 +039800 PERFORM D2-WRITE-LINE THRU D2-WRITE-LINE-EXIT. RL1134.2 +039900* RL1134.2 +040000 IF P-OR-F EQUAL TO "FAIL*" RL1134.2 +040100 PERFORM D2-WRITE-LINE THRU D2-WRITE-LINE-EXIT RL1134.2 +040200 PERFORM D2-FAIL-ROUTINE THRU D2-FAIL-ROUTINE-EX RL1134.2 +040300 ELSE RL1134.2 +040400 PERFORM D2-BAIL-OUT THRU D2-BAIL-OUT-EX. RL1134.2 +040500 MOVE SPACE TO P-OR-F. RL1134.2 +040600 MOVE SPACE TO COMPUTED-X. RL1134.2 +040700 MOVE SPACE TO CORRECT-X. RL1134.2 +040800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1134.2 +040900 MOVE SPACE TO RE-MARK. RL1134.2 +041000 GO TO RL-FD2-02-EXIT. RL1134.2 +041100 D2-FAIL-ROUTINE. RL1134.2 +041200 IF COMPUTED-X NOT EQUAL TO SPACE RL1134.2 +041300 GO TO D2-FAIL-ROUTINE-WRITE. RL1134.2 +041400 IF CORRECT-X NOT EQUAL TO SPACE RL1134.2 +041500 GO TO D2-FAIL-ROUTINE-WRITE. RL1134.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +041700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1134.2 +041800 MOVE XXINFO TO DUMMY-RECORD. RL1134.2 +041900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +042000 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +042100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +042200 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +042300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +042400 GO TO D2-FAIL-ROUTINE-EX. RL1134.2 +042500 D2-FAIL-ROUTINE-WRITE. RL1134.2 +042600 MOVE TEST-COMPUTED TO PRINT-REC. RL1134.2 +042700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +042800 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +042900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1134.2 +043000 MOVE TEST-CORRECT TO PRINT-REC. RL1134.2 +043100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +043200 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +043300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +043400 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +043500 MOVE SPACES TO COR-ANSI-REFERENCE. RL1134.2 +043600 D2-FAIL-ROUTINE-EX. RL1134.2 +043700 EXIT. RL1134.2 +043800 D2-BAIL-OUT. RL1134.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE RL1134.2 +044000 GO TO D2-BAIL-OUT-WRITE. RL1134.2 +044100 IF CORRECT-A EQUAL TO SPACE RL1134.2 +044200 GO TO D2-BAIL-OUT-EX. RL1134.2 +044300 D2-BAIL-OUT-WRITE. RL1134.2 +044400 MOVE CORRECT-A TO XXCORRECT. RL1134.2 +044500 MOVE COMPUTED-A TO XXCOMPUTED. RL1134.2 +044600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +044700 MOVE XXINFO TO DUMMY-RECORD. RL1134.2 +044800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +044900 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +045000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +045100 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +045200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +045300 D2-BAIL-OUT-EX. RL1134.2 +045400 EXIT. RL1134.2 +045500 RL-FD2-02-EXIT. RL1134.2 +045600 EXIT. RL1134.2 +045700 D2-WRITE-LINE. RL1134.2 +045800 ADD 1 TO RECORD-COUNT. RL1134.2 +045900 IF RECORD-COUNT GREATER 50 RL1134.2 +046000 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1134.2 +046100 MOVE SPACE TO DUMMY-RECORD RL1134.2 +046200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1134.2 +046300 MOVE CCVS-C-1 TO DUMMY-RECORD RL1134.2 +046400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +046500 MOVE SPACE TO DUMMY-RECORD RL1134.2 +046600 MOVE CCVS-C-2 TO DUMMY-RECORD RL1134.2 +046700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +046800 MOVE SPACE TO DUMMY-RECORD RL1134.2 +046900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +047000 MOVE SPACE TO DUMMY-RECORD RL1134.2 +047100 MOVE HYPHEN-LINE TO DUMMY-RECORD RL1134.2 +047200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1134.2 +047300 MOVE SPACE TO DUMMY-RECORD RL1134.2 +047400 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1134.2 +047500 MOVE ZERO TO RECORD-COUNT. RL1134.2 +047600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +047700 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +047800 D2-WRITE-LINE-EXIT. RL1134.2 +047900 EXIT. RL1134.2 +048000 END DECLARATIVES. RL1134.2 +048100 CCVS1 SECTION. RL1134.2 +048200 OPEN-FILES. RL1134.2 +048300 OPEN OUTPUT PRINT-FILE. RL1134.2 +048400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1134.2 +048500 MOVE SPACE TO TEST-RESULTS. RL1134.2 +048600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1134.2 +048700 MOVE ZERO TO REC-SKL-SUB. RL1134.2 +048800 PERFORM CCVS-INIT-FILE 9 TIMES. RL1134.2 +048900 CCVS-INIT-FILE. RL1134.2 +049000 ADD 1 TO REC-SKL-SUB. RL1134.2 +049100 MOVE FILE-RECORD-INFO-SKELETON RL1134.2 +049200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1134.2 +049300 CCVS-INIT-EXIT. RL1134.2 +049400 GO TO CCVS1-EXIT. RL1134.2 +049500 CLOSE-FILES. RL1134.2 +049600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1134.2 +049700 TERMINATE-CCVS. RL1134.2 +049800*S EXIT PROGRAM. RL1134.2 +049900*SERMINATE-CALL. RL1134.2 +050000 STOP RUN. RL1134.2 +050100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1134.2 +050200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1134.2 +050300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1134.2 +050400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1134.2 +050500 MOVE "****TEST DELETED****" TO RE-MARK. RL1134.2 +050600 PRINT-DETAIL. RL1134.2 +050700 IF REC-CT NOT EQUAL TO ZERO RL1134.2 +050800 MOVE "." TO PARDOT-X RL1134.2 +050900 MOVE REC-CT TO DOTVALUE. RL1134.2 +051000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1134.2 +051100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1134.2 +051200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1134.2 +051300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1134.2 +051400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1134.2 +051500 MOVE SPACE TO CORRECT-X. RL1134.2 +051600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1134.2 +051700 MOVE SPACE TO RE-MARK. RL1134.2 +051800 HEAD-ROUTINE. RL1134.2 +051900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +052000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +052100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1134.2 +052200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1134.2 +052300 COLUMN-NAMES-ROUTINE. RL1134.2 +052400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +052500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +052600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +052700 END-ROUTINE. RL1134.2 +052800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1134.2 +052900 END-RTN-EXIT. RL1134.2 +053000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +053100 END-ROUTINE-1. RL1134.2 +053200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1134.2 +053300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1134.2 +053400 ADD PASS-COUNTER TO ERROR-HOLD. RL1134.2 +053500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1134.2 +053600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1134.2 +053700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1134.2 +053800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1134.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1134.2 +054000 END-ROUTINE-12. RL1134.2 +054100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1134.2 +054200 IF ERROR-COUNTER IS EQUAL TO ZERO RL1134.2 +054300 MOVE "NO " TO ERROR-TOTAL RL1134.2 +054400 ELSE RL1134.2 +054500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1134.2 +054600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1134.2 +054700 PERFORM WRITE-LINE. RL1134.2 +054800 END-ROUTINE-13. RL1134.2 +054900 IF DELETE-COUNTER IS EQUAL TO ZERO RL1134.2 +055000 MOVE "NO " TO ERROR-TOTAL ELSE RL1134.2 +055100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1134.2 +055200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1134.2 +055300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +055400 IF INSPECT-COUNTER EQUAL TO ZERO RL1134.2 +055500 MOVE "NO " TO ERROR-TOTAL RL1134.2 +055600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1134.2 +055700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1134.2 +055800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +055900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1134.2 +056000 WRITE-LINE. RL1134.2 +056100 ADD 1 TO RECORD-COUNT. RL1134.2 +056200 IF RECORD-COUNT GREATER 50 RL1134.2 +056300 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1134.2 +056400 MOVE SPACE TO DUMMY-RECORD RL1134.2 +056500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1134.2 +056600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1134.2 +056700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1134.2 +056800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1134.2 +056900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1134.2 +057000 MOVE ZERO TO RECORD-COUNT. RL1134.2 +057100 PERFORM WRT-LN. RL1134.2 +057200 WRT-LN. RL1134.2 +057300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1134.2 +057400 MOVE SPACE TO DUMMY-RECORD. RL1134.2 +057500 BLANK-LINE-PRINT. RL1134.2 +057600 PERFORM WRT-LN. RL1134.2 +057700 FAIL-ROUTINE. RL1134.2 +057800 IF COMPUTED-X NOT EQUAL TO SPACE RL1134.2 +057900 GO TO FAIL-ROUTINE-WRITE. RL1134.2 +058000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1134.2 +058100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +058200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1134.2 +058300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +058400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +058500 GO TO FAIL-ROUTINE-EX. RL1134.2 +058600 FAIL-ROUTINE-WRITE. RL1134.2 +058700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1134.2 +058800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1134.2 +058900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1134.2 +059000 MOVE SPACES TO COR-ANSI-REFERENCE. RL1134.2 +059100 FAIL-ROUTINE-EX. EXIT. RL1134.2 +059200 BAIL-OUT. RL1134.2 +059300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1134.2 +059400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1134.2 +059500 BAIL-OUT-WRITE. RL1134.2 +059600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1134.2 +059700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1134.2 +059800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1134.2 +059900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1134.2 +060000 BAIL-OUT-EX. EXIT. RL1134.2 +060100 CCVS1-EXIT. RL1134.2 +060200 EXIT. RL1134.2 +060300 SECT-RL113A-001 SECTION. RL1134.2 +060400 REL-INIT-009. RL1134.2 +060500 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1134.2 +060600 MOVE "REL-TEST-009" TO PAR-NAME. RL1134.2 +060700 MOVE "CREATE RL-FD2" TO FEATURE RL1134.2 +060800 MOVE "RL-FD2" TO XFILE-NAME (2). RL1134.2 +060900 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1134.2 +061000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1134.2 +061100 MOVE 000240 TO XRECORD-LENGTH (2). RL1134.2 +061200 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1134.2 +061300 MOVE 0001 TO XBLOCK-SIZE (2). RL1134.2 +061400 MOVE 000500 TO RECORDS-IN-FILE (2). RL1134.2 +061500 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1134.2 +061600 MOVE "S" TO XLABEL-TYPE (2). RL1134.2 +061700 MOVE 000001 TO XRECORD-NUMBER (2). RL1134.2 +061800*INITIALIZE RECORD WORK AREA NUMBER 2. RL1134.2 +061900 MOVE 1 TO WRK-CS-09V00-012. RL1134.2 +062000 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1134.2 +062100 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1134.2 +062200 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1134.2 +062300 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +062400 MOVE 90000002 TO RL-FD2-KEY. RL1134.2 +062500 MOVE 01 TO REC-CT. RL1134.2 +062600 OPEN OUTPUT RL-FD2. RL1134.2 +062700 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1134.2 +062800*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1134.2 +062900 REL-TEST-009-R. RL1134.2 +063000 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1134.2 +063100 MOVE "99" TO RL-FD2-STATUS. RL1134.2 +063200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1134.2 +063300 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1134.2 +063400 RL-FD2-GRP-120. RL1134.2 +063500 WRITE RL-FD2R1-F-G-240. RL1134.2 +063600 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +063700 GO TO REL-TEST-009-2. RL1134.2 +063800 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1134.2 +063900 GO TO REL-TEST-009-2. RL1134.2 +064000 ADD 01 TO XRECORD-NUMBER (2). RL1134.2 +064100 GO TO REL-TEST-009-R. RL1134.2 +064200 REL-TEST-009-2. RL1134.2 +064300 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1134.2 +064400 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1134.2 +064500 MOVE ZERO TO CORRECT-18V0 RL1134.2 +064600 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1134.2 +064700 PERFORM FAIL RL1134.2 +064800 ELSE RL1134.2 +064900 PERFORM PASS. RL1134.2 +065000 PERFORM PRINT-DETAIL. RL1134.2 +065100 ADD 01 TO REC-CT. RL1134.2 +065200* .01 RL1134.2 +065300 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1134.2 +065400 MOVE "INCORRECT COUNT" TO RE-MARK RL1134.2 +065500 MOVE 500 TO CORRECT-18V0 RL1134.2 +065600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1134.2 +065700 PERFORM FAIL RL1134.2 +065800 ELSE RL1134.2 +065900 PERFORM PASS. RL1134.2 +066000 PERFORM PRINT-DETAIL. RL1134.2 +066100 ADD 01 TO REC-CT. RL1134.2 +066200* .02 RL1134.2 +066300 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1134.2 +066400 MOVE "STATUS/OPEN" TO RE-MARK RL1134.2 +066500 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1134.2 +066600 MOVE "00" TO CORRECT-A RL1134.2 +066700 PERFORM FAIL RL1134.2 +066800 ELSE RL1134.2 +066900 PERFORM PASS. RL1134.2 +067000 PERFORM PRINT-DETAIL. RL1134.2 +067100 ADD 01 TO REC-CT. RL1134.2 +067200* .03 RL1134.2 +067300 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +067400 MOVE "STATUS/WRITE" TO RE-MARK RL1134.2 +067500 MOVE RL-FD2-STATUS TO COMPUTED-A RL1134.2 +067600 MOVE "00" TO CORRECT-A RL1134.2 +067700 PERFORM FAIL RL1134.2 +067800 ELSE RL1134.2 +067900 PERFORM PASS. RL1134.2 +068000 PERFORM PRINT-DETAIL. RL1134.2 +068100 ADD 01 TO REC-CT. RL1134.2 +068200* .04 RL1134.2 +068300 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +068400 CLOSE RL-FD2. RL1134.2 +068500 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +068600 MOVE "CLOSE/STATUS" TO RE-MARK RL1134.2 +068700 MOVE RL-FD2-STATUS TO COMPUTED-A RL1134.2 +068800 MOVE "00" TO CORRECT-A RL1134.2 +068900 PERFORM FAIL RL1134.2 +069000 ELSE RL1134.2 +069100 PERFORM PASS. RL1134.2 +069200 PERFORM PRINT-DETAIL. RL1134.2 +069300 ADD 01 TO REC-CT. RL1134.2 +069400* .05 RL1134.2 +069500 REL-INIT-010. RL1134.2 +069600 MOVE "REL-TEST-010" TO PAR-NAME. RL1134.2 +069700 MOVE 2 TO WRK-CS-09V00-012. RL1134.2 +069800 MOVE ZERO TO RL-FD2-KEY. RL1134.2 +069900 MOVE ZERO TO WRK-CS-09V00-013. RL1134.2 +070000 MOVE ZERO TO WRK-CS-09V00-014. RL1134.2 +070100 MOVE ZERO TO WRK-CS-09V00-015. RL1134.2 +070200 MOVE ZERO TO WRK-CS-09V00-016. RL1134.2 +070300 MOVE ZERO TO WRK-CS-09V00-017. RL1134.2 +070400 MOVE ZERO TO WRK-CS-09V00-018. RL1134.2 +070500 MOVE 01 TO REC-CT. RL1134.2 +070600 OPEN I-O RL-FD2. RL1134.2 +070700 MOVE SPACE TO WRK-XN-0002-002 RL1134.2 +070800 MOVE SPACE TO WRK-XN-0002-003 RL1134.2 +070900 MOVE SPACE TO WRK-XN-0002-004 RL1134.2 +071000 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL1134.2 +071100 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +071200*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1134.2 +071300 MOVE "USE/FILE STATUS" TO FEATURE. RL1134.2 +071400 REL-TEST-010-R. RL1134.2 +071500 ADD 1 TO RL-FD2-KEY. RL1134.2 +071600 ADD 1 TO WRK-CS-09V00-014. RL1134.2 +071700 ADD 1 TO WRK-CS-09V00-015. RL1134.2 +071800 READ RL-FD2 RECORD. RL1134.2 +071900 IF RL-FD2-STATUS EQUAL TO "23" RL1134.2 +072000 GO TO REL-TEST-010-3. RL1134.2 +072100 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1134.2 +072200 IF WRK-CS-09V00-015 EQUAL TO 5 RL1134.2 +072300 ADD 01 TO UPDATE-NUMBER (2) RL1134.2 +072400 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL1134.2 +072500 REWRITE RL-FD2R1-F-G-240 RL1134.2 +072600 MOVE ZERO TO WRK-CS-09V00-015 RL1134.2 +072700 GO TO REL-TEST-010-2. RL1134.2 +072800 IF WRK-CS-09V00-014 GREATER 500 RL1134.2 +072900 MOVE 1 TO WRK-CS-09V00-013 RL1134.2 +073000 GO TO REL-TEST-010-3. RL1134.2 +073100 GO TO REL-TEST-010-R. RL1134.2 +073200 REL-TEST-010-2. RL1134.2 +073300 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +073400 ADD 1 TO WRK-CS-09V00-016. RL1134.2 +073500 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +073600 GO TO REL-TEST-010-R. RL1134.2 +073700 REL-TEST-010-3. RL1134.2 +073800 IF WRK-CS-09V00-013 NOT EQUAL TO 0 RL1134.2 +073900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1134.2 +074000 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1134.2 +074100 MOVE 0 TO CORRECT-18V0 RL1134.2 +074200 PERFORM FAIL RL1134.2 +074300 ELSE RL1134.2 +074400 PERFORM PASS. RL1134.2 +074500 PERFORM PRINT-DETAIL. RL1134.2 +074600 ADD 01 TO REC-CT. RL1134.2 +074700* .01 RL1134.2 +074800 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1134.2 +074900 MOVE "INCORRECT COUNT" TO RE-MARK RL1134.2 +075000 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1134.2 +075100 MOVE 501 TO CORRECT-18V0 RL1134.2 +075200 PERFORM FAIL RL1134.2 +075300 ELSE RL1134.2 +075400 PERFORM PASS. RL1134.2 +075500 PERFORM PRINT-DETAIL. RL1134.2 +075600 ADD 01 TO REC-CT. RL1134.2 +075700* .02 RL1134.2 +075800 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1134.2 +075900 MOVE "OPEN/STATUS" TO RE-MARK RL1134.2 +076000 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1134.2 +076100 MOVE "00" TO CORRECT-A RL1134.2 +076200 PERFORM FAIL RL1134.2 +076300 ELSE RL1134.2 +076400 PERFORM PASS. RL1134.2 +076500 PERFORM PRINT-DETAIL. RL1134.2 +076600 ADD 01 TO REC-CT. RL1134.2 +076700* .03 RL1134.2 +076800 IF RL-FD2-STATUS NOT EQUAL TO "23" RL1134.2 +076900 MOVE "AT END/STATUS" TO RE-MARK RL1134.2 +077000 MOVE RL-FD2-STATUS TO COMPUTED-A RL1134.2 +077100 MOVE "23" TO CORRECT-A RL1134.2 +077200 PERFORM FAIL RL1134.2 +077300 ELSE RL1134.2 +077400 PERFORM PASS. RL1134.2 +077500 PERFORM PRINT-DETAIL. RL1134.2 +077600 ADD 01 TO REC-CT. RL1134.2 +077700* .04 RL1134.2 +077800* IF WRK-XN-0002-002 NOT EQUAL TO "10" RL1134.2 +077900* MOVE "EXCEPTION/STATUS" TO RE-MARK RL1134.2 +078000* MOVE WRK-XN-0002-002 TO COMPUTED-A RL1134.2 +078100* MOVE "10" TO CORRECT-A RL1134.2 +078200* PERFORM FAIL RL1134.2 +078300* ELSE RL1134.2 +078400* PERFORM PASS. RL1134.2 +078500* PERFORM PRINT-DETAIL. RL1134.2 +078600* ADD 01 TO REC-CT. RL1134.2 +078700* .05 RL1134.2 +078800* IF WRK-XN-0002-003 NOT EQUAL TO "10" RL1134.2 +078900* MOVE "NO EXCEPTION" TO RE-MARK RL1134.2 +079000* MOVE WRK-XN-0002-003 TO COMPUTED-A RL1134.2 +079100* MOVE "10" TO CORRECT-A RL1134.2 +079200* PERFORM FAIL RL1134.2 +079300* ELSE RL1134.2 +079400* PERFORM PASS. RL1134.2 +079500* PERFORM PRINT-DETAIL RL1134.2 +079600* ADD 01 TO REC-CT. RL1134.2 +079700* .06 RL1134.2 +079800 MOVE SPACE TO RL-FD2-STATUS. RL1134.2 +079900 CLOSE RL-FD2 RL1134.2 +080000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1134.2 +080100 MOVE "CLOSE/STATUS" TO RE-MARK RL1134.2 +080200 MOVE RL-FD2-STATUS TO COMPUTED-A RL1134.2 +080300 MOVE "00" TO CORRECT-A RL1134.2 +080400 PERFORM FAIL RL1134.2 +080500 ELSE RL1134.2 +080600 PERFORM PASS. RL1134.2 +080700 PERFORM PRINT-DETAIL. RL1134.2 +080800 ADD 01 TO REC-CT. RL1134.2 +080900* .07 RL1134.2 +081000 CCVS-EXIT SECTION. RL1134.2 +081100 CCVS-999999. RL1134.2 +081200 GO TO CLOSE-FILES. RL1134.2 diff --git a/tests/cobol85/RL/RL114A.CBL b/tests/cobol85/RL/RL114A.CBL new file mode 100644 index 00000000..5e1c1bb6 --- /dev/null +++ b/tests/cobol85/RL/RL114A.CBL @@ -0,0 +1,824 @@ +000100 IDENTIFICATION DIVISION. RL1144.2 +000200 PROGRAM-ID. RL1144.2 +000300 RL114A. RL1144.2 +000400**************************************************************** RL1144.2 +000500* * RL1144.2 +000600* VALIDATION FOR:- * RL1144.2 +000700* * RL1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1144.2 +000900* * RL1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1144.2 +001100* * RL1144.2 +001200**************************************************************** RL1144.2 +001300* * RL1144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1144.2 +001500* * RL1144.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1144.2 +001700* RELATIVE I-O DATA FILE * RL1144.2 +001800* X-55 SYSTEM PRINTER * RL1144.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1144.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1144.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1144.2 +002200* X-82 SOURCE-COMPUTER * RL1144.2 +002300* X-83 OBJECT-COMPUTER. * RL1144.2 +002400* * RL1144.2 +002500**************************************************************** RL1144.2 +002600* RL114A * RL1144.2 +002700**************************************************************** RL1144.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1144.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "USE" RL1144.2 +003000* STATEMENT. RL1144.2 +003100* RL1144.2 +003200* RL1144.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE CONTAINING RL1144.2 +003400* 500 RECORDS (ACCESS MODE RANDOM). IT THEN CLOSES THERL1144.2 +003500* FILE AND RE-OPENS IT IS I-O AND READS ALL THE RECORDSRL1144.2 +003600* AND ATTEMPTS TO READ THE 501ST RECORD TO GIVE STATUS RL1144.2 +003700* CODE 23. SEE STANDARD REF VIII-4 1.3.4 (3) B, 1). RL1144.2 +003800* THE READ, WRITE AND REWRITE STATEMENTS ARE USED RL1144.2 +003900* WITHOUT THE APPROPRIATE AT END ON INVALID KEY PHRASESRL1144.2 +004000* WHICH IS PERMITTED IF AN APPLICABLE USE PROCEDURE RL1144.2 +004100* HAS BEEN SPECIFIED. RL1144.2 +004200* RL1144.2 +004300*************************************************** RL1144.2 +004400 ENVIRONMENT DIVISION. RL1144.2 +004500 CONFIGURATION SECTION. RL1144.2 +004600 SOURCE-COMPUTER. RL1144.2 +004700 Linux. RL1144.2 +004800 OBJECT-COMPUTER. RL1144.2 +004900 Linux. RL1144.2 +005000 INPUT-OUTPUT SECTION. RL1144.2 +005100 FILE-CONTROL. RL1144.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1144.2 +005300 "report.log". RL1144.2 +005400 SELECT RL-FD2 ASSIGN RL1144.2 +005500 "XXXXX022" RL1144.2 +005600 ORGANIZATION RELATIVE RL1144.2 +005700 ACCESS RANDOM RL1144.2 +005800 RELATIVE RL-FD2-KEY RL1144.2 +005900 FILE STATUS IS RL-FD2-STATUS. RL1144.2 +006000 DATA DIVISION. RL1144.2 +006100 FILE SECTION. RL1144.2 +006200 FD PRINT-FILE. RL1144.2 +006300 01 PRINT-REC PICTURE X(120). RL1144.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1144.2 +006500 FD RL-FD2 RL1144.2 +006600*C VALUE OF RL1144.2 +006700*C OCLABELID RL1144.2 +006800*C IS RL1144.2 +006900*C "OCDUMMY" RL1144.2 +007000*G SYSIN RL1144.2 +007100 LABEL RECORDS ARE STANDARD RL1144.2 +007200 BLOCK CONTAINS 1 RECORDS RL1144.2 +007300 DATA RECORD RL-FD2R1-F-G-240. RL1144.2 +007400 01 RL-FD2R1-F-G-240. RL1144.2 +007500 05 RL-FD2-WRK-120 PIC X(120). RL1144.2 +007600 05 RL-FD2-GRP-120. RL1144.2 +007700 10 RL-FD2-WRK-XN-0001-O120F RL1144.2 +007800 PICTURE X OCCURS 120 TIMES. RL1144.2 +007900 WORKING-STORAGE SECTION. RL1144.2 +008000 01 GRP-0001. RL1144.2 +008100 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1144.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1144.2 +008900 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1144.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1144.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1144.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1144.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1144.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1144.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1144.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1144.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1144.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1144.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1144.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1144.2 +010100 05 FILLER PICTURE X(48) VALUE RL1144.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1144.2 +010300 05 FILLER PICTURE X(46) VALUE RL1144.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1144.2 +010500 05 FILLER PICTURE X(26) VALUE RL1144.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1144.2 +010700 05 FILLER PICTURE X(37) VALUE RL1144.2 +010800 ",RECKEY= ". RL1144.2 +010900 05 FILLER PICTURE X(38) VALUE RL1144.2 +011000 ",ALTKEY1= ". RL1144.2 +011100 05 FILLER PICTURE X(38) VALUE RL1144.2 +011200 ",ALTKEY2= ". RL1144.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1144.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1144.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1144.2 +011600 07 FILLER PIC X(5). RL1144.2 +011700 07 XFILE-NAME PIC X(6). RL1144.2 +011800 07 FILLER PIC X(8). RL1144.2 +011900 07 XRECORD-NAME PIC X(6). RL1144.2 +012000 07 FILLER PIC X(1). RL1144.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1144.2 +012200 07 FILLER PIC X(7). RL1144.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1144.2 +012400 07 FILLER PIC X(6). RL1144.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1144.2 +012600 07 FILLER PIC X(5). RL1144.2 +012700 07 ODO-NUMBER PIC 9(4). RL1144.2 +012800 07 FILLER PIC X(5). RL1144.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1144.2 +013000 07 FILLER PIC X(7). RL1144.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1144.2 +013200 07 FILLER PIC X(7). RL1144.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1144.2 +013400 07 FILLER PIC X(1). RL1144.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1144.2 +013600 07 FILLER PIC X(6). RL1144.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1144.2 +013800 07 FILLER PIC X(5). RL1144.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1144.2 +014000 07 FILLER PIC X(6). RL1144.2 +014100 07 XLABEL-TYPE PIC X(1). RL1144.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1144.2 +014300 07 FILLER PIC X(8). RL1144.2 +014400 07 XRECORD-KEY PIC X(29). RL1144.2 +014500 07 FILLER PIC X(9). RL1144.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1144.2 +014700 07 FILLER PIC X(9). RL1144.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1144.2 +014900 07 FILLER PIC X(7). RL1144.2 +015000 01 TEST-RESULTS. RL1144.2 +015100 02 FILLER PIC X VALUE SPACE. RL1144.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1144.2 +015300 02 FILLER PIC X VALUE SPACE. RL1144.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1144.2 +015500 02 FILLER PIC X VALUE SPACE. RL1144.2 +015600 02 PAR-NAME. RL1144.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1144.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1144.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1144.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1144.2 +016100 02 RE-MARK PIC X(61). RL1144.2 +016200 01 TEST-COMPUTED. RL1144.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1144.2 +016400 02 FILLER PIC X(17) VALUE RL1144.2 +016500 " COMPUTED=". RL1144.2 +016600 02 COMPUTED-X. RL1144.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1144.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1144.2 +016900 PIC -9(9).9(9). RL1144.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1144.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1144.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1144.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1144.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1144.2 +017500 04 FILLER PIC X. RL1144.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1144.2 +017700 01 TEST-CORRECT. RL1144.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1144.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1144.2 +018000 02 CORRECT-X. RL1144.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1144.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1144.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1144.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1144.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1144.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1144.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1144.2 +018800 04 FILLER PIC X. RL1144.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1144.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1144.2 +019100 01 CCVS-C-1. RL1144.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1144.2 +019300- "SS PARAGRAPH-NAME RL1144.2 +019400- " REMARKS". RL1144.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1144.2 +019600 01 CCVS-C-2. RL1144.2 +019700 02 FILLER PIC X VALUE SPACE. RL1144.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1144.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1144.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1144.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1144.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1144.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1144.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1144.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1144.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1144.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1144.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1144.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1144.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1144.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1144.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1144.2 +021300 01 CCVS-H-1. RL1144.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1144.2 +021500 02 FILLER PIC X(42) VALUE RL1144.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1144.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1144.2 +021800 01 CCVS-H-2A. RL1144.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1144.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1144.2 +022100 02 FILLER PIC XXXX VALUE RL1144.2 +022200 "4.2 ". RL1144.2 +022300 02 FILLER PIC X(28) VALUE RL1144.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1144.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1144.2 +022600 RL1144.2 +022700 01 CCVS-H-2B. RL1144.2 +022800 02 FILLER PIC X(15) VALUE RL1144.2 +022900 "TEST RESULT OF ". RL1144.2 +023000 02 TEST-ID PIC X(9). RL1144.2 +023100 02 FILLER PIC X(4) VALUE RL1144.2 +023200 " IN ". RL1144.2 +023300 02 FILLER PIC X(12) VALUE RL1144.2 +023400 " HIGH ". RL1144.2 +023500 02 FILLER PIC X(22) VALUE RL1144.2 +023600 " LEVEL VALIDATION FOR ". RL1144.2 +023700 02 FILLER PIC X(58) VALUE RL1144.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1144.2 +023900 01 CCVS-H-3. RL1144.2 +024000 02 FILLER PIC X(34) VALUE RL1144.2 +024100 " FOR OFFICIAL USE ONLY ". RL1144.2 +024200 02 FILLER PIC X(58) VALUE RL1144.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1144.2 +024400 02 FILLER PIC X(28) VALUE RL1144.2 +024500 " COPYRIGHT 1985 ". RL1144.2 +024600 01 CCVS-E-1. RL1144.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1144.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1144.2 +024900 02 ID-AGAIN PIC X(9). RL1144.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1144.2 +025100 01 CCVS-E-2. RL1144.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1144.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1144.2 +025400 02 CCVS-E-2-2. RL1144.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1144.2 +025600 03 FILLER PIC X VALUE SPACE. RL1144.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1144.2 +025800 "ERRORS ENCOUNTERED". RL1144.2 +025900 01 CCVS-E-3. RL1144.2 +026000 02 FILLER PIC X(22) VALUE RL1144.2 +026100 " FOR OFFICIAL USE ONLY". RL1144.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1144.2 +026300 02 FILLER PIC X(58) VALUE RL1144.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1144.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1144.2 +026600 02 FILLER PIC X(15) VALUE RL1144.2 +026700 " COPYRIGHT 1985". RL1144.2 +026800 01 CCVS-E-4. RL1144.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1144.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1144.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1144.2 +027200 02 FILLER PIC X(40) VALUE RL1144.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1144.2 +027400 01 XXINFO. RL1144.2 +027500 02 FILLER PIC X(19) VALUE RL1144.2 +027600 "*** INFORMATION ***". RL1144.2 +027700 02 INFO-TEXT. RL1144.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1144.2 +027900 04 XXCOMPUTED PIC X(20). RL1144.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1144.2 +028100 04 XXCORRECT PIC X(20). RL1144.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1144.2 +028300 01 HYPHEN-LINE. RL1144.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1144.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1144.2 +028600- "*****************************************". RL1144.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1144.2 +028800- "******************************". RL1144.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1144.2 +029000 "RL114A". RL1144.2 +029100 PROCEDURE DIVISION. RL1144.2 +029200 DECLARATIVES. RL1144.2 +029300 RL-FD2-01 SECTION. RL1144.2 +029400 USE AFTER ERROR PROCEDURE RL-FD2. RL1144.2 +029500 RL-FD2-01-01. RL1144.2 +029600 MOVE "PASS " TO P-OR-F. RL1144.2 +029700 ADD 1 TO PASS-COUNTER. RL1144.2 +029800* RL1144.2 +029900 IF REC-CT NOT EQUAL TO ZERO RL1144.2 +030000 MOVE "." TO PARDOT-X RL1144.2 +030100 MOVE REC-CT TO DOTVALUE. RL1144.2 +030200 MOVE TEST-RESULTS TO PRINT-REC. RL1144.2 +030300 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT. RL1144.2 +030400 IF P-OR-F EQUAL TO "FAIL*" RL1144.2 +030500 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT RL1144.2 +030600 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX RL1144.2 +030700 ELSE RL1144.2 +030800 PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. RL1144.2 +030900 MOVE SPACE TO P-OR-F. RL1144.2 +031000 MOVE SPACE TO COMPUTED-X. RL1144.2 +031100 MOVE SPACE TO CORRECT-X. RL1144.2 +031200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1144.2 +031300 MOVE SPACE TO RE-MARK. RL1144.2 +031400 ADD 1 TO WRK-CS-09V00-013. RL1144.2 +031500 MOVE RL-FD2-STATUS TO WRK-XN-0002-002. RL1144.2 +031600 MOVE "23" TO WRK-XN-0002-003. RL1144.2 +031700 GO TO RL-FD2-01-EXIT. RL1144.2 +031800 D1-FAIL-ROUTINE. RL1144.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE RL1144.2 +032000 GO TO D1-FAIL-ROUTINE-WRITE. RL1144.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE RL1144.2 +032200 GO TO D1-FAIL-ROUTINE-WRITE. RL1144.2 +032300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +032400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1144.2 +032500 MOVE XXINFO TO DUMMY-RECORD. RL1144.2 +032600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +032700 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +032900 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +033100 GO TO D1-FAIL-ROUTINE-EX. RL1144.2 +033200 D1-FAIL-ROUTINE-WRITE. RL1144.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC. RL1144.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +033500 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1144.2 +033700 MOVE TEST-CORRECT TO PRINT-REC. RL1144.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +033900 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +034000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +034100 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +034200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1144.2 +034300 D1-FAIL-ROUTINE-EX. RL1144.2 +034400 EXIT. RL1144.2 +034500 D1-BAIL-OUT. RL1144.2 +034600 IF COMPUTED-A NOT EQUAL TO SPACE RL1144.2 +034700 GO TO D1-BAIL-OUT-WRITE. RL1144.2 +034800 IF CORRECT-A EQUAL TO SPACE RL1144.2 +034900 GO TO D1-BAIL-OUT-EX. RL1144.2 +035000 D1-BAIL-OUT-WRITE. RL1144.2 +035100 MOVE CORRECT-A TO XXCORRECT. RL1144.2 +035200 MOVE COMPUTED-A TO XXCOMPUTED. RL1144.2 +035300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +035400 MOVE XXINFO TO DUMMY-RECORD. RL1144.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +035600 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +035800 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +035900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +036000 D1-BAIL-OUT-EX. RL1144.2 +036100 EXIT. RL1144.2 +036200 D1-WRITE-LINE. RL1144.2 +036300 ADD 1 TO RECORD-COUNT. RL1144.2 +036400 IF RECORD-COUNT GREATER 50 RL1144.2 +036500 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1144.2 +036600 MOVE SPACE TO DUMMY-RECORD RL1144.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1144.2 +036800 MOVE CCVS-C-1 TO DUMMY-RECORD RL1144.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +037000 MOVE SPACE TO DUMMY-RECORD RL1144.2 +037100 MOVE CCVS-C-2 TO DUMMY-RECORD RL1144.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +037300 MOVE SPACE TO DUMMY-RECORD RL1144.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +037500 MOVE SPACE TO DUMMY-RECORD RL1144.2 +037600 MOVE HYPHEN-LINE TO DUMMY-RECORD RL1144.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +037800 MOVE SPACE TO DUMMY-RECORD RL1144.2 +037900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1144.2 +038000 MOVE ZERO TO RECORD-COUNT. RL1144.2 +038100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +038200 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +038300 D1-WRITE-LINE-EXIT. RL1144.2 +038400 EXIT. RL1144.2 +038500 RL-FD2-01-EXIT. RL1144.2 +038600 EXIT. RL1144.2 +038700 RL-FD2-01-03 SECTION. RL1144.2 +038800 USE AFTER EXCEPTION PROCEDURE OUTPUT. RL1144.2 +038900 RL-FD2-01-03-01. RL1144.2 +039000 MOVE "RL-FD2-01-03" TO PAR-NAME. RL1144.2 +039100 MOVE "USE AFTER EXCEPTION PROCEDURE SHOULD NOT BE OBEYED" RL1144.2 +039200 TO RE-MARK. RL1144.2 +039300 MOVE "FAIL*" TO P-OR-F. RL1144.2 +039400 ADD 1 TO ERROR-COUNTER. RL1144.2 +039500* RL1144.2 +039600 IF REC-CT NOT EQUAL TO ZERO RL1144.2 +039700 MOVE "." TO PARDOT-X RL1144.2 +039800 MOVE REC-CT TO DOTVALUE. RL1144.2 +039900 MOVE TEST-RESULTS TO PRINT-REC. RL1144.2 +040000 PERFORM D2-WRITE-LINE THRU D2-WRITE-LINE-EXIT. RL1144.2 +040100 IF P-OR-F EQUAL TO "FAIL*" RL1144.2 +040200 PERFORM D2-WRITE-LINE THRU D2-WRITE-LINE-EXIT RL1144.2 +040300 PERFORM D2-FAIL-ROUTINE THRU D2-FAIL-ROUTINE-EX RL1144.2 +040400 ELSE RL1144.2 +040500 PERFORM D2-BAIL-OUT THRU D2-BAIL-OUT-EX. RL1144.2 +040600 MOVE SPACE TO P-OR-F. RL1144.2 +040700 MOVE SPACE TO COMPUTED-X. RL1144.2 +040800 MOVE SPACE TO CORRECT-X. RL1144.2 +040900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1144.2 +041000 MOVE SPACE TO RE-MARK. RL1144.2 +041100 GO TO RL-FD2-01-03-EXIT. RL1144.2 +041200 D2-FAIL-ROUTINE. RL1144.2 +041300 IF COMPUTED-X NOT EQUAL TO SPACE RL1144.2 +041400 GO TO D2-FAIL-ROUTINE-WRITE. RL1144.2 +041500 IF CORRECT-X NOT EQUAL TO SPACE RL1144.2 +041600 GO TO D2-FAIL-ROUTINE-WRITE. RL1144.2 +041700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +041800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1144.2 +041900 MOVE XXINFO TO DUMMY-RECORD. RL1144.2 +042000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +042100 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +042200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +042300 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +042400 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +042500 GO TO D2-FAIL-ROUTINE-EX. RL1144.2 +042600 D2-FAIL-ROUTINE-WRITE. RL1144.2 +042700 MOVE TEST-COMPUTED TO PRINT-REC. RL1144.2 +042800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +042900 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +043000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1144.2 +043100 MOVE TEST-CORRECT TO PRINT-REC. RL1144.2 +043200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +043300 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +043400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +043500 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +043600 MOVE SPACES TO COR-ANSI-REFERENCE. RL1144.2 +043700 D2-FAIL-ROUTINE-EX. RL1144.2 +043800 EXIT. RL1144.2 +043900 D2-BAIL-OUT. RL1144.2 +044000 IF COMPUTED-A NOT EQUAL TO SPACE RL1144.2 +044100 GO TO D2-BAIL-OUT-WRITE. RL1144.2 +044200 IF CORRECT-A EQUAL TO SPACE RL1144.2 +044300 GO TO D2-BAIL-OUT-EX. RL1144.2 +044400 D2-BAIL-OUT-WRITE. RL1144.2 +044500 MOVE CORRECT-A TO XXCORRECT. RL1144.2 +044600 MOVE COMPUTED-A TO XXCOMPUTED. RL1144.2 +044700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +044800 MOVE XXINFO TO DUMMY-RECORD. RL1144.2 +044900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +045000 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +045100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +045200 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +045400 D2-BAIL-OUT-EX. RL1144.2 +045500 EXIT. RL1144.2 +045600 D2-WRITE-LINE. RL1144.2 +045700 ADD 1 TO RECORD-COUNT. RL1144.2 +045800 IF RECORD-COUNT GREATER 50 RL1144.2 +045900 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1144.2 +046000 MOVE SPACE TO DUMMY-RECORD RL1144.2 +046100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1144.2 +046200 MOVE CCVS-C-1 TO DUMMY-RECORD RL1144.2 +046300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +046400 MOVE SPACE TO DUMMY-RECORD RL1144.2 +046500 MOVE CCVS-C-2 TO DUMMY-RECORD RL1144.2 +046600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +046700 MOVE SPACE TO DUMMY-RECORD RL1144.2 +046800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +046900 MOVE SPACE TO DUMMY-RECORD RL1144.2 +047000 MOVE HYPHEN-LINE TO DUMMY-RECORD RL1144.2 +047100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1144.2 +047200 MOVE SPACE TO DUMMY-RECORD RL1144.2 +047300 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1144.2 +047400 MOVE ZERO TO RECORD-COUNT. RL1144.2 +047500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +047600 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +047700 D2-WRITE-LINE-EXIT. RL1144.2 +047800* EXIT. RL1144.2 +047900************ PRINT-DETAIL COPIED HERE ************** RL1144.2 +048000 IF REC-CT NOT EQUAL TO ZERO RL1144.2 +048100 MOVE "." TO PARDOT-X RL1144.2 +048200 MOVE REC-CT TO DOTVALUE. RL1144.2 +048300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D2-WRITE-LINE. RL1144.2 +048400 IF P-OR-F EQUAL TO "FAIL*" PERFORM D2-WRITE-LINE RL1144.2 +048500 PERFORM D2-FAIL-ROUTINE THRU D2-FAIL-ROUTINE-EX RL1144.2 +048600 ELSE PERFORM D2-BAIL-OUT THRU D2-BAIL-OUT-EX. RL1144.2 +048700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1144.2 +048800 MOVE SPACE TO CORRECT-X. RL1144.2 +048900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1144.2 +049000 MOVE SPACE TO RE-MARK. RL1144.2 +049100 RL-FD2-01-03-EXIT. RL1144.2 +049200 EXIT. RL1144.2 +049300 END DECLARATIVES. RL1144.2 +049400 CCVS1 SECTION. RL1144.2 +049500 OPEN-FILES. RL1144.2 +049600 OPEN OUTPUT PRINT-FILE. RL1144.2 +049700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1144.2 +049800 MOVE SPACE TO TEST-RESULTS. RL1144.2 +049900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1144.2 +050000 MOVE ZERO TO REC-SKL-SUB. RL1144.2 +050100 PERFORM CCVS-INIT-FILE 9 TIMES. RL1144.2 +050200 CCVS-INIT-FILE. RL1144.2 +050300 ADD 1 TO REC-SKL-SUB. RL1144.2 +050400 MOVE FILE-RECORD-INFO-SKELETON RL1144.2 +050500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1144.2 +050600 CCVS-INIT-EXIT. RL1144.2 +050700 GO TO CCVS1-EXIT. RL1144.2 +050800 CLOSE-FILES. RL1144.2 +050900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1144.2 +051000 TERMINATE-CCVS. RL1144.2 +051100*S EXIT PROGRAM. RL1144.2 +051200*SERMINATE-CALL. RL1144.2 +051300 STOP RUN. RL1144.2 +051400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1144.2 +051500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1144.2 +051600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1144.2 +051700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1144.2 +051800 MOVE "****TEST DELETED****" TO RE-MARK. RL1144.2 +051900 PRINT-DETAIL. RL1144.2 +052000 IF REC-CT NOT EQUAL TO ZERO RL1144.2 +052100 MOVE "." TO PARDOT-X RL1144.2 +052200 MOVE REC-CT TO DOTVALUE. RL1144.2 +052300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1144.2 +052400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1144.2 +052500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1144.2 +052600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1144.2 +052700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1144.2 +052800 MOVE SPACE TO CORRECT-X. RL1144.2 +052900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1144.2 +053000 MOVE SPACE TO RE-MARK. RL1144.2 +053100 HEAD-ROUTINE. RL1144.2 +053200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +053300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +053400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1144.2 +053500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1144.2 +053600 COLUMN-NAMES-ROUTINE. RL1144.2 +053700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +053800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +053900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +054000 END-ROUTINE. RL1144.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1144.2 +054200 END-RTN-EXIT. RL1144.2 +054300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +054400 END-ROUTINE-1. RL1144.2 +054500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1144.2 +054600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1144.2 +054700 ADD PASS-COUNTER TO ERROR-HOLD. RL1144.2 +054800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1144.2 +054900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1144.2 +055000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1144.2 +055100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1144.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1144.2 +055300 END-ROUTINE-12. RL1144.2 +055400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1144.2 +055500 IF ERROR-COUNTER IS EQUAL TO ZERO RL1144.2 +055600 MOVE "NO " TO ERROR-TOTAL RL1144.2 +055700 ELSE RL1144.2 +055800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1144.2 +055900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1144.2 +056000 PERFORM WRITE-LINE. RL1144.2 +056100 END-ROUTINE-13. RL1144.2 +056200 IF DELETE-COUNTER IS EQUAL TO ZERO RL1144.2 +056300 MOVE "NO " TO ERROR-TOTAL ELSE RL1144.2 +056400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1144.2 +056500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1144.2 +056600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +056700 IF INSPECT-COUNTER EQUAL TO ZERO RL1144.2 +056800 MOVE "NO " TO ERROR-TOTAL RL1144.2 +056900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1144.2 +057000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1144.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +057200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1144.2 +057300 WRITE-LINE. RL1144.2 +057400 ADD 1 TO RECORD-COUNT. RL1144.2 +057500 IF RECORD-COUNT GREATER 50 RL1144.2 +057600 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1144.2 +057700 MOVE SPACE TO DUMMY-RECORD RL1144.2 +057800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1144.2 +057900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1144.2 +058000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1144.2 +058100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1144.2 +058200 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1144.2 +058300 MOVE ZERO TO RECORD-COUNT. RL1144.2 +058400 PERFORM WRT-LN. RL1144.2 +058500 WRT-LN. RL1144.2 +058600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1144.2 +058700 MOVE SPACE TO DUMMY-RECORD. RL1144.2 +058800 BLANK-LINE-PRINT. RL1144.2 +058900 PERFORM WRT-LN. RL1144.2 +059000 FAIL-ROUTINE. RL1144.2 +059100 IF COMPUTED-X NOT EQUAL TO SPACE RL1144.2 +059200 GO TO FAIL-ROUTINE-WRITE. RL1144.2 +059300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1144.2 +059400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +059500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1144.2 +059600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +059700 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +059800 GO TO FAIL-ROUTINE-EX. RL1144.2 +059900 FAIL-ROUTINE-WRITE. RL1144.2 +060000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1144.2 +060100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1144.2 +060200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1144.2 +060300 MOVE SPACES TO COR-ANSI-REFERENCE. RL1144.2 +060400 FAIL-ROUTINE-EX. EXIT. RL1144.2 +060500 BAIL-OUT. RL1144.2 +060600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1144.2 +060700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1144.2 +060800 BAIL-OUT-WRITE. RL1144.2 +060900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1144.2 +061000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1144.2 +061100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1144.2 +061200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1144.2 +061300 BAIL-OUT-EX. EXIT. RL1144.2 +061400 CCVS1-EXIT. RL1144.2 +061500 EXIT. RL1144.2 +061600 SECT-RL114A-001 SECTION. RL1144.2 +061700 REL-INIT-009. RL1144.2 +061800 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1144.2 +061900 MOVE "REL-TEST-009" TO PAR-NAME. RL1144.2 +062000 MOVE "CREATE RL-FD2" TO FEATURE RL1144.2 +062100 MOVE "RL-FD2" TO XFILE-NAME (2). RL1144.2 +062200 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1144.2 +062300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1144.2 +062400 MOVE 000240 TO XRECORD-LENGTH (2). RL1144.2 +062500 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1144.2 +062600 MOVE 0001 TO XBLOCK-SIZE (2). RL1144.2 +062700 MOVE 000500 TO RECORDS-IN-FILE (2). RL1144.2 +062800 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1144.2 +062900 MOVE "S" TO XLABEL-TYPE (2). RL1144.2 +063000 MOVE 000001 TO XRECORD-NUMBER (2). RL1144.2 +063100*INITIALIZE RECORD WORK AREA NUMBER 2. RL1144.2 +063200 MOVE 1 TO WRK-CS-09V00-012. RL1144.2 +063300 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1144.2 +063400 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1144.2 +063500 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1144.2 +063600 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +063700 MOVE 90000002 TO RL-FD2-KEY. RL1144.2 +063800 MOVE 01 TO REC-CT. RL1144.2 +063900 OPEN OUTPUT RL-FD2. RL1144.2 +064000 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1144.2 +064100*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1144.2 +064200 REL-TEST-009-R. RL1144.2 +064300 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1144.2 +064400 MOVE "99" TO RL-FD2-STATUS. RL1144.2 +064500 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1144.2 +064600 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1144.2 +064700 RL-FD2-GRP-120. RL1144.2 +064800 WRITE RL-FD2R1-F-G-240. RL1144.2 +064900 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +065000 GO TO REL-TEST-009-2. RL1144.2 +065100 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1144.2 +065200 GO TO REL-TEST-009-2. RL1144.2 +065300 ADD 01 TO XRECORD-NUMBER (2). RL1144.2 +065400 GO TO REL-TEST-009-R. RL1144.2 +065500 REL-TEST-009-2. RL1144.2 +065600 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1144.2 +065700 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1144.2 +065800 MOVE ZERO TO CORRECT-18V0 RL1144.2 +065900 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1144.2 +066000 PERFORM FAIL RL1144.2 +066100 ELSE RL1144.2 +066200 PERFORM PASS. RL1144.2 +066300 PERFORM PRINT-DETAIL. RL1144.2 +066400 ADD 01 TO REC-CT. RL1144.2 +066500* .01 RL1144.2 +066600 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1144.2 +066700 MOVE "INCORRECT COUNT" TO RE-MARK RL1144.2 +066800 MOVE 500 TO CORRECT-18V0 RL1144.2 +066900 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1144.2 +067000 PERFORM FAIL RL1144.2 +067100 ELSE RL1144.2 +067200 PERFORM PASS. RL1144.2 +067300 PERFORM PRINT-DETAIL. RL1144.2 +067400 ADD 01 TO REC-CT. RL1144.2 +067500* .02 RL1144.2 +067600 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1144.2 +067700 MOVE "STATUS/OPEN" TO RE-MARK RL1144.2 +067800 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1144.2 +067900 MOVE "00" TO CORRECT-A RL1144.2 +068000 PERFORM FAIL RL1144.2 +068100 ELSE RL1144.2 +068200 PERFORM PASS. RL1144.2 +068300 PERFORM PRINT-DETAIL. RL1144.2 +068400 ADD 01 TO REC-CT. RL1144.2 +068500* .03 RL1144.2 +068600 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +068700 MOVE "STATUS/WRITE" TO RE-MARK RL1144.2 +068800 MOVE RL-FD2-STATUS TO COMPUTED-A RL1144.2 +068900 MOVE "00" TO CORRECT-A RL1144.2 +069000 PERFORM FAIL RL1144.2 +069100 ELSE RL1144.2 +069200 PERFORM PASS. RL1144.2 +069300 PERFORM PRINT-DETAIL. RL1144.2 +069400 ADD 01 TO REC-CT. RL1144.2 +069500* .04 RL1144.2 +069600 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +069700 CLOSE RL-FD2. RL1144.2 +069800 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +069900 MOVE "CLOSE/STATUS" TO RE-MARK RL1144.2 +070000 MOVE RL-FD2-STATUS TO COMPUTED-A RL1144.2 +070100 MOVE "00" TO CORRECT-A RL1144.2 +070200 PERFORM FAIL RL1144.2 +070300 ELSE RL1144.2 +070400 PERFORM PASS. RL1144.2 +070500 PERFORM PRINT-DETAIL. RL1144.2 +070600 ADD 01 TO REC-CT. RL1144.2 +070700* .05 RL1144.2 +070800 REL-INIT-010. RL1144.2 +070900 MOVE "REL-TEST-010" TO PAR-NAME. RL1144.2 +071000 MOVE 2 TO WRK-CS-09V00-012. RL1144.2 +071100 MOVE ZERO TO RL-FD2-KEY. RL1144.2 +071200 MOVE ZERO TO WRK-CS-09V00-013. RL1144.2 +071300 MOVE ZERO TO WRK-CS-09V00-014. RL1144.2 +071400 MOVE ZERO TO WRK-CS-09V00-015. RL1144.2 +071500 MOVE ZERO TO WRK-CS-09V00-016. RL1144.2 +071600 MOVE ZERO TO WRK-CS-09V00-017. RL1144.2 +071700 MOVE ZERO TO WRK-CS-09V00-018. RL1144.2 +071800 MOVE 01 TO REC-CT. RL1144.2 +071900 OPEN I-O RL-FD2. RL1144.2 +072000 MOVE SPACE TO WRK-XN-0002-002 RL1144.2 +072100 MOVE SPACE TO WRK-XN-0002-003 RL1144.2 +072200 MOVE SPACE TO WRK-XN-0002-004 RL1144.2 +072300 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL1144.2 +072400 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +072500*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1144.2 +072600 MOVE "USE/FILE STATUS" TO FEATURE. RL1144.2 +072700 REL-TEST-010-R. RL1144.2 +072800 ADD 1 TO RL-FD2-KEY. RL1144.2 +072900 ADD 1 TO WRK-CS-09V00-014. RL1144.2 +073000 ADD 1 TO WRK-CS-09V00-015. RL1144.2 +073100 READ RL-FD2. RL1144.2 +073200 IF RL-FD2-STATUS EQUAL TO "23" RL1144.2 +073300 GO TO REL-TEST-010-3. RL1144.2 +073400 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1144.2 +073500 IF WRK-CS-09V00-015 EQUAL TO 5 RL1144.2 +073600 ADD 01 TO UPDATE-NUMBER (2) RL1144.2 +073700 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL1144.2 +073800 REWRITE RL-FD2R1-F-G-240 RL1144.2 +073900 MOVE ZERO TO WRK-CS-09V00-015 RL1144.2 +074000 GO TO REL-TEST-010-2. RL1144.2 +074100 IF WRK-CS-09V00-014 GREATER 500 RL1144.2 +074200 GO TO REL-TEST-010-3. RL1144.2 +074300 GO TO REL-TEST-010-R. RL1144.2 +074400 REL-TEST-010-2. RL1144.2 +074500 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +074600 ADD 1 TO WRK-CS-09V00-016. RL1144.2 +074700 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +074800 GO TO REL-TEST-010-R. RL1144.2 +074900 REL-TEST-010-3. RL1144.2 +075000 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1144.2 +075100 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1144.2 +075200 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1144.2 +075300 MOVE 1 TO CORRECT-18V0 RL1144.2 +075400 PERFORM FAIL RL1144.2 +075500 ELSE RL1144.2 +075600 PERFORM PASS. RL1144.2 +075700 PERFORM PRINT-DETAIL. RL1144.2 +075800 ADD 01 TO REC-CT. RL1144.2 +075900* .01 RL1144.2 +076000 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1144.2 +076100 MOVE "INCORRECT COUNT" TO RE-MARK RL1144.2 +076200 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1144.2 +076300 MOVE 501 TO CORRECT-18V0 RL1144.2 +076400 PERFORM FAIL RL1144.2 +076500 ELSE RL1144.2 +076600 PERFORM PASS. RL1144.2 +076700 PERFORM PRINT-DETAIL. RL1144.2 +076800 ADD 01 TO REC-CT. RL1144.2 +076900* .02 RL1144.2 +077000 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1144.2 +077100 MOVE "OPEN/STATUS" TO RE-MARK RL1144.2 +077200 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1144.2 +077300 MOVE "00" TO CORRECT-A RL1144.2 +077400 PERFORM FAIL RL1144.2 +077500 ELSE RL1144.2 +077600 PERFORM PASS. RL1144.2 +077700 PERFORM PRINT-DETAIL. RL1144.2 +077800 ADD 01 TO REC-CT. RL1144.2 +077900* .03 RL1144.2 +078000 IF RL-FD2-STATUS NOT EQUAL TO "23" RL1144.2 +078100 MOVE "ATEND/STATUS" TO RE-MARK RL1144.2 +078200 MOVE RL-FD2-STATUS TO COMPUTED-A RL1144.2 +078300 MOVE "23" TO CORRECT-A RL1144.2 +078400 PERFORM FAIL RL1144.2 +078500 ELSE RL1144.2 +078600 PERFORM PASS. RL1144.2 +078700 PERFORM PRINT-DETAIL. RL1144.2 +078800 ADD 01 TO REC-CT. RL1144.2 +078900* .04 RL1144.2 +079000 IF WRK-XN-0002-002 NOT EQUAL TO "23" RL1144.2 +079100 MOVE "EXCEPTIN/STATUS" TO RE-MARK RL1144.2 +079200 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1144.2 +079300 MOVE "23" TO CORRECT-A RL1144.2 +079400 PERFORM FAIL RL1144.2 +079500 ELSE RL1144.2 +079600 PERFORM PASS. RL1144.2 +079700 PERFORM PRINT-DETAIL. RL1144.2 +079800 ADD 01 TO REC-CT. RL1144.2 +079900* .05 RL1144.2 +080000 IF WRK-XN-0002-003 NOT EQUAL TO "23" RL1144.2 +080100 MOVE "NO/EXCEPTION" TO RE-MARK RL1144.2 +080200 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1144.2 +080300 MOVE "23" TO CORRECT-A RL1144.2 +080400 PERFORM FAIL RL1144.2 +080500 ELSE RL1144.2 +080600 PERFORM PASS. RL1144.2 +080700 PERFORM PRINT-DETAIL RL1144.2 +080800 ADD 01 TO REC-CT. RL1144.2 +080900* .06 RL1144.2 +081000 MOVE SPACE TO RL-FD2-STATUS. RL1144.2 +081100 CLOSE RL-FD2 RL1144.2 +081200 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1144.2 +081300 MOVE "CLOSE/STATUS" TO RE-MARK RL1144.2 +081400 MOVE RL-FD2-STATUS TO COMPUTED-A RL1144.2 +081500 MOVE "00" TO CORRECT-A RL1144.2 +081600 PERFORM FAIL RL1144.2 +081700 ELSE RL1144.2 +081800 PERFORM PASS. RL1144.2 +081900 PERFORM PRINT-DETAIL. RL1144.2 +082000 ADD 01 TO REC-CT. RL1144.2 +082100* .07 RL1144.2 +082200 CCVS-EXIT SECTION. RL1144.2 +082300 CCVS-999999. RL1144.2 +082400 GO TO CLOSE-FILES. RL1144.2 diff --git a/tests/cobol85/RL/RL115A.CBL b/tests/cobol85/RL/RL115A.CBL new file mode 100644 index 00000000..e5e5e44c --- /dev/null +++ b/tests/cobol85/RL/RL115A.CBL @@ -0,0 +1,719 @@ +000100 IDENTIFICATION DIVISION. RL1154.2 +000200 PROGRAM-ID. RL1154.2 +000300 RL115A. RL1154.2 +000400**************************************************************** RL1154.2 +000500* * RL1154.2 +000600* VALIDATION FOR:- * RL1154.2 +000700* * RL1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1154.2 +000900* * RL1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1154.2 +001100* * RL1154.2 +001200**************************************************************** RL1154.2 +001300* * RL1154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1154.2 +001500* * RL1154.2 +001600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1154.2 +001700* RELATIVE I-O DATA FILE * RL1154.2 +001800* X-55 SYSTEM PRINTER * RL1154.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1154.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1154.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1154.2 +002200* X-82 SOURCE-COMPUTER * RL1154.2 +002300* X-83 OBJECT-COMPUTER. * RL1154.2 +002400* * RL1154.2 +002500**************************************************************** RL1154.2 +002600* RL115A * RL1154.2 +002700**************************************************************** RL1154.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1154.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "USE" RL1154.2 +003000* STATEMENT. RL1154.2 +003100* RL1154.2 +003200* RL1154.2 +003300* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL1154.2 +003400* (ACCESS MODE SEQUENTIAL) AND THEN UPDATES SELECTIVE RL1154.2 +003500* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL1154.2 +003600* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL1154.2 +003700* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL1154.2 +003800* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL1154.2 +003900* AT END ON INVALID KEY PHRASES. THE OMISSION OF THESERL1154.2 +004000* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL1154.2 +004100* HAS BEEN SPECIFIED. RL1154.2 +004200* RL1154.2 +004300*************************************************** RL1154.2 +004400 ENVIRONMENT DIVISION. RL1154.2 +004500 CONFIGURATION SECTION. RL1154.2 +004600 SOURCE-COMPUTER. RL1154.2 +004700 Linux. RL1154.2 +004800 OBJECT-COMPUTER. RL1154.2 +004900 Linux. RL1154.2 +005000 INPUT-OUTPUT SECTION. RL1154.2 +005100 FILE-CONTROL. RL1154.2 +005200 SELECT PRINT-FILE ASSIGN TO RL1154.2 +005300 "report.log". RL1154.2 +005400 SELECT RL-FD2 ASSIGN RL1154.2 +005500 "XXXXX022" RL1154.2 +005600 ORGANIZATION RELATIVE RL1154.2 +005700 ACCESS SEQUENTIAL RL1154.2 +005800 RELATIVE RL-FD2-KEY RL1154.2 +005900 FILE STATUS IS RL-FD2-STATUS. RL1154.2 +006000 DATA DIVISION. RL1154.2 +006100 FILE SECTION. RL1154.2 +006200 FD PRINT-FILE. RL1154.2 +006300 01 PRINT-REC PICTURE X(120). RL1154.2 +006400 01 DUMMY-RECORD PICTURE X(120). RL1154.2 +006500 FD RL-FD2 RL1154.2 +006600*C VALUE OF RL1154.2 +006700*C OCLABELID RL1154.2 +006800*C IS RL1154.2 +006900*C "OCDUMMY" RL1154.2 +007000*G SYSIN RL1154.2 +007100 LABEL RECORDS ARE STANDARD RL1154.2 +007200 BLOCK CONTAINS 1 RECORDS RL1154.2 +007300 DATA RECORD RL-FD2R1-F-G-240. RL1154.2 +007400 01 RL-FD2R1-F-G-240. RL1154.2 +007500 05 RL-FD2-WRK-120 PIC X(120). RL1154.2 +007600 05 RL-FD2-GRP-120. RL1154.2 +007700 10 RL-FD2-WRK-XN-0001-O120F RL1154.2 +007800 PICTURE X OCCURS 120 TIMES. RL1154.2 +007900 WORKING-STORAGE SECTION. RL1154.2 +008000 01 GRP-0001. RL1154.2 +008100 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1154.2 +008200 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008300 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008400 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008500 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008600 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008700 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008800 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1154.2 +008900 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1154.2 +009000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1154.2 +009100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1154.2 +009200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1154.2 +009300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1154.2 +009400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1154.2 +009500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1154.2 +009600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1154.2 +009700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1154.2 +009800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1154.2 +009900 01 FILE-RECORD-INFORMATION-REC. RL1154.2 +010000 03 FILE-RECORD-INFO-SKELETON. RL1154.2 +010100 05 FILLER PICTURE X(48) VALUE RL1154.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1154.2 +010300 05 FILLER PICTURE X(46) VALUE RL1154.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1154.2 +010500 05 FILLER PICTURE X(26) VALUE RL1154.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". RL1154.2 +010700 05 FILLER PICTURE X(37) VALUE RL1154.2 +010800 ",RECKEY= ". RL1154.2 +010900 05 FILLER PICTURE X(38) VALUE RL1154.2 +011000 ",ALTKEY1= ". RL1154.2 +011100 05 FILLER PICTURE X(38) VALUE RL1154.2 +011200 ",ALTKEY2= ". RL1154.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.RL1154.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1154.2 +011500 05 FILE-RECORD-INFO-P1-120. RL1154.2 +011600 07 FILLER PIC X(5). RL1154.2 +011700 07 XFILE-NAME PIC X(6). RL1154.2 +011800 07 FILLER PIC X(8). RL1154.2 +011900 07 XRECORD-NAME PIC X(6). RL1154.2 +012000 07 FILLER PIC X(1). RL1154.2 +012100 07 REELUNIT-NUMBER PIC 9(1). RL1154.2 +012200 07 FILLER PIC X(7). RL1154.2 +012300 07 XRECORD-NUMBER PIC 9(6). RL1154.2 +012400 07 FILLER PIC X(6). RL1154.2 +012500 07 UPDATE-NUMBER PIC 9(2). RL1154.2 +012600 07 FILLER PIC X(5). RL1154.2 +012700 07 ODO-NUMBER PIC 9(4). RL1154.2 +012800 07 FILLER PIC X(5). RL1154.2 +012900 07 XPROGRAM-NAME PIC X(5). RL1154.2 +013000 07 FILLER PIC X(7). RL1154.2 +013100 07 XRECORD-LENGTH PIC 9(6). RL1154.2 +013200 07 FILLER PIC X(7). RL1154.2 +013300 07 CHARS-OR-RECORDS PIC X(2). RL1154.2 +013400 07 FILLER PIC X(1). RL1154.2 +013500 07 XBLOCK-SIZE PIC 9(4). RL1154.2 +013600 07 FILLER PIC X(6). RL1154.2 +013700 07 RECORDS-IN-FILE PIC 9(6). RL1154.2 +013800 07 FILLER PIC X(5). RL1154.2 +013900 07 XFILE-ORGANIZATION PIC X(2). RL1154.2 +014000 07 FILLER PIC X(6). RL1154.2 +014100 07 XLABEL-TYPE PIC X(1). RL1154.2 +014200 05 FILE-RECORD-INFO-P121-240. RL1154.2 +014300 07 FILLER PIC X(8). RL1154.2 +014400 07 XRECORD-KEY PIC X(29). RL1154.2 +014500 07 FILLER PIC X(9). RL1154.2 +014600 07 ALTERNATE-KEY1 PIC X(29). RL1154.2 +014700 07 FILLER PIC X(9). RL1154.2 +014800 07 ALTERNATE-KEY2 PIC X(29). RL1154.2 +014900 07 FILLER PIC X(7). RL1154.2 +015000 01 TEST-RESULTS. RL1154.2 +015100 02 FILLER PIC X VALUE SPACE. RL1154.2 +015200 02 FEATURE PIC X(20) VALUE SPACE. RL1154.2 +015300 02 FILLER PIC X VALUE SPACE. RL1154.2 +015400 02 P-OR-F PIC X(5) VALUE SPACE. RL1154.2 +015500 02 FILLER PIC X VALUE SPACE. RL1154.2 +015600 02 PAR-NAME. RL1154.2 +015700 03 FILLER PIC X(19) VALUE SPACE. RL1154.2 +015800 03 PARDOT-X PIC X VALUE SPACE. RL1154.2 +015900 03 DOTVALUE PIC 99 VALUE ZERO. RL1154.2 +016000 02 FILLER PIC X(8) VALUE SPACE. RL1154.2 +016100 02 RE-MARK PIC X(61). RL1154.2 +016200 01 TEST-COMPUTED. RL1154.2 +016300 02 FILLER PIC X(30) VALUE SPACE. RL1154.2 +016400 02 FILLER PIC X(17) VALUE RL1154.2 +016500 " COMPUTED=". RL1154.2 +016600 02 COMPUTED-X. RL1154.2 +016700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1154.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A RL1154.2 +016900 PIC -9(9).9(9). RL1154.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1154.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1154.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1154.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. RL1154.2 +017400 04 COMPUTED-18V0 PIC -9(18). RL1154.2 +017500 04 FILLER PIC X. RL1154.2 +017600 03 FILLER PIC X(50) VALUE SPACE. RL1154.2 +017700 01 TEST-CORRECT. RL1154.2 +017800 02 FILLER PIC X(30) VALUE SPACE. RL1154.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1154.2 +018000 02 CORRECT-X. RL1154.2 +018100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1154.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1154.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1154.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1154.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1154.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. RL1154.2 +018700 04 CORRECT-18V0 PIC -9(18). RL1154.2 +018800 04 FILLER PIC X. RL1154.2 +018900 03 FILLER PIC X(2) VALUE SPACE. RL1154.2 +019000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1154.2 +019100 01 CCVS-C-1. RL1154.2 +019200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1154.2 +019300- "SS PARAGRAPH-NAME RL1154.2 +019400- " REMARKS". RL1154.2 +019500 02 FILLER PIC X(20) VALUE SPACE. RL1154.2 +019600 01 CCVS-C-2. RL1154.2 +019700 02 FILLER PIC X VALUE SPACE. RL1154.2 +019800 02 FILLER PIC X(6) VALUE "TESTED". RL1154.2 +019900 02 FILLER PIC X(15) VALUE SPACE. RL1154.2 +020000 02 FILLER PIC X(4) VALUE "FAIL". RL1154.2 +020100 02 FILLER PIC X(94) VALUE SPACE. RL1154.2 +020200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1154.2 +020300 01 REC-CT PIC 99 VALUE ZERO. RL1154.2 +020400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1154.2 +020500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1154.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1154.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1154.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1154.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1154.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1154.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1154.2 +021200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1154.2 +021300 01 CCVS-H-1. RL1154.2 +021400 02 FILLER PIC X(39) VALUE SPACES. RL1154.2 +021500 02 FILLER PIC X(42) VALUE RL1154.2 +021600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1154.2 +021700 02 FILLER PIC X(39) VALUE SPACES. RL1154.2 +021800 01 CCVS-H-2A. RL1154.2 +021900 02 FILLER PIC X(40) VALUE SPACE. RL1154.2 +022000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1154.2 +022100 02 FILLER PIC XXXX VALUE RL1154.2 +022200 "4.2 ". RL1154.2 +022300 02 FILLER PIC X(28) VALUE RL1154.2 +022400 " COPY - NOT FOR DISTRIBUTION". RL1154.2 +022500 02 FILLER PIC X(41) VALUE SPACE. RL1154.2 +022600 RL1154.2 +022700 01 CCVS-H-2B. RL1154.2 +022800 02 FILLER PIC X(15) VALUE RL1154.2 +022900 "TEST RESULT OF ". RL1154.2 +023000 02 TEST-ID PIC X(9). RL1154.2 +023100 02 FILLER PIC X(4) VALUE RL1154.2 +023200 " IN ". RL1154.2 +023300 02 FILLER PIC X(12) VALUE RL1154.2 +023400 " HIGH ". RL1154.2 +023500 02 FILLER PIC X(22) VALUE RL1154.2 +023600 " LEVEL VALIDATION FOR ". RL1154.2 +023700 02 FILLER PIC X(58) VALUE RL1154.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1154.2 +023900 01 CCVS-H-3. RL1154.2 +024000 02 FILLER PIC X(34) VALUE RL1154.2 +024100 " FOR OFFICIAL USE ONLY ". RL1154.2 +024200 02 FILLER PIC X(58) VALUE RL1154.2 +024300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1154.2 +024400 02 FILLER PIC X(28) VALUE RL1154.2 +024500 " COPYRIGHT 1985 ". RL1154.2 +024600 01 CCVS-E-1. RL1154.2 +024700 02 FILLER PIC X(52) VALUE SPACE. RL1154.2 +024800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1154.2 +024900 02 ID-AGAIN PIC X(9). RL1154.2 +025000 02 FILLER PIC X(45) VALUE SPACES. RL1154.2 +025100 01 CCVS-E-2. RL1154.2 +025200 02 FILLER PIC X(31) VALUE SPACE. RL1154.2 +025300 02 FILLER PIC X(21) VALUE SPACE. RL1154.2 +025400 02 CCVS-E-2-2. RL1154.2 +025500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1154.2 +025600 03 FILLER PIC X VALUE SPACE. RL1154.2 +025700 03 ENDER-DESC PIC X(44) VALUE RL1154.2 +025800 "ERRORS ENCOUNTERED". RL1154.2 +025900 01 CCVS-E-3. RL1154.2 +026000 02 FILLER PIC X(22) VALUE RL1154.2 +026100 " FOR OFFICIAL USE ONLY". RL1154.2 +026200 02 FILLER PIC X(12) VALUE SPACE. RL1154.2 +026300 02 FILLER PIC X(58) VALUE RL1154.2 +026400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1154.2 +026500 02 FILLER PIC X(13) VALUE SPACE. RL1154.2 +026600 02 FILLER PIC X(15) VALUE RL1154.2 +026700 " COPYRIGHT 1985". RL1154.2 +026800 01 CCVS-E-4. RL1154.2 +026900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1154.2 +027000 02 FILLER PIC X(4) VALUE " OF ". RL1154.2 +027100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1154.2 +027200 02 FILLER PIC X(40) VALUE RL1154.2 +027300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1154.2 +027400 01 XXINFO. RL1154.2 +027500 02 FILLER PIC X(19) VALUE RL1154.2 +027600 "*** INFORMATION ***". RL1154.2 +027700 02 INFO-TEXT. RL1154.2 +027800 04 FILLER PIC X(8) VALUE SPACE. RL1154.2 +027900 04 XXCOMPUTED PIC X(20). RL1154.2 +028000 04 FILLER PIC X(5) VALUE SPACE. RL1154.2 +028100 04 XXCORRECT PIC X(20). RL1154.2 +028200 02 INF-ANSI-REFERENCE PIC X(48). RL1154.2 +028300 01 HYPHEN-LINE. RL1154.2 +028400 02 FILLER PIC IS X VALUE IS SPACE. RL1154.2 +028500 02 FILLER PIC IS X(65) VALUE IS "************************RL1154.2 +028600- "*****************************************". RL1154.2 +028700 02 FILLER PIC IS X(54) VALUE IS "************************RL1154.2 +028800- "******************************". RL1154.2 +028900 01 CCVS-PGM-ID PIC X(9) VALUE RL1154.2 +029000 "RL115A". RL1154.2 +029100 PROCEDURE DIVISION. RL1154.2 +029200 DECLARATIVES. RL1154.2 +029300 RL-FD2-01 SECTION. RL1154.2 +029400 USE AFTER ERROR PROCEDURE I-O. RL1154.2 +029500 RL-FD2-01-01. RL1154.2 +029600 MOVE "PASS " TO P-OR-F. RL1154.2 +029700 ADD 1 TO PASS-COUNTER. RL1154.2 +029800* RL1154.2 +029900 IF REC-CT NOT EQUAL TO ZERO RL1154.2 +030000 MOVE "." TO PARDOT-X RL1154.2 +030100 MOVE REC-CT TO DOTVALUE. RL1154.2 +030200 MOVE TEST-RESULTS TO PRINT-REC. RL1154.2 +030300 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT. RL1154.2 +030400 IF P-OR-F EQUAL TO "FAIL*" RL1154.2 +030500 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT RL1154.2 +030600 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX RL1154.2 +030700 ELSE RL1154.2 +030800 PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. RL1154.2 +030900 MOVE SPACE TO P-OR-F. RL1154.2 +031000 MOVE SPACE TO COMPUTED-X. RL1154.2 +031100 MOVE SPACE TO CORRECT-X. RL1154.2 +031200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1154.2 +031300 MOVE SPACE TO RE-MARK. RL1154.2 +031400 ADD 1 TO WRK-CS-09V00-013. RL1154.2 +031500 MOVE RL-FD2-STATUS TO WRK-XN-0002-002. RL1154.2 +031600 MOVE "10" TO WRK-XN-0002-003. RL1154.2 +031700 GO TO RL-FD2-01-EXIT. RL1154.2 +031800 D1-FAIL-ROUTINE. RL1154.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE RL1154.2 +032000 GO TO D1-FAIL-ROUTINE-WRITE. RL1154.2 +032100 IF CORRECT-X NOT EQUAL TO SPACE RL1154.2 +032200 GO TO D1-FAIL-ROUTINE-WRITE. RL1154.2 +032300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1154.2 +032400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1154.2 +032500 MOVE XXINFO TO DUMMY-RECORD. RL1154.2 +032600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +032700 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +032900 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1154.2 +033100 GO TO D1-FAIL-ROUTINE-EX. RL1154.2 +033200 D1-FAIL-ROUTINE-WRITE. RL1154.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC. RL1154.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +033500 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1154.2 +033700 MOVE TEST-CORRECT TO PRINT-REC. RL1154.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +033900 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +034000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +034100 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +034200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1154.2 +034300 D1-FAIL-ROUTINE-EX. RL1154.2 +034400 EXIT. RL1154.2 +034500 D1-BAIL-OUT. RL1154.2 +034600 IF COMPUTED-A NOT EQUAL TO SPACE RL1154.2 +034700 GO TO D1-BAIL-OUT-WRITE. RL1154.2 +034800 IF CORRECT-A EQUAL TO SPACE RL1154.2 +034900 GO TO D1-BAIL-OUT-EX. RL1154.2 +035000 D1-BAIL-OUT-WRITE. RL1154.2 +035100 MOVE CORRECT-A TO XXCORRECT. RL1154.2 +035200 MOVE COMPUTED-A TO XXCOMPUTED. RL1154.2 +035300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1154.2 +035400 MOVE XXINFO TO DUMMY-RECORD. RL1154.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +035600 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +035800 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +035900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1154.2 +036000 D1-BAIL-OUT-EX. RL1154.2 +036100 EXIT. RL1154.2 +036200 D1-WRITE-LINE. RL1154.2 +036300 ADD 1 TO RECORD-COUNT. RL1154.2 +036400 IF RECORD-COUNT GREATER 50 RL1154.2 +036500 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1154.2 +036600 MOVE SPACE TO DUMMY-RECORD RL1154.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1154.2 +036800 MOVE CCVS-C-1 TO DUMMY-RECORD RL1154.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1154.2 +037000 MOVE SPACE TO DUMMY-RECORD RL1154.2 +037100 MOVE CCVS-C-2 TO DUMMY-RECORD RL1154.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1154.2 +037300 MOVE SPACE TO DUMMY-RECORD RL1154.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1154.2 +037500 MOVE SPACE TO DUMMY-RECORD RL1154.2 +037600 MOVE HYPHEN-LINE TO DUMMY-RECORD RL1154.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1154.2 +037800 MOVE SPACE TO DUMMY-RECORD RL1154.2 +037900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1154.2 +038000 MOVE ZERO TO RECORD-COUNT. RL1154.2 +038100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +038200 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +038300 D1-WRITE-LINE-EXIT. RL1154.2 +038400 EXIT. RL1154.2 +038500 RL-FD2-01-EXIT. RL1154.2 +038600 EXIT. RL1154.2 +038700 END DECLARATIVES. RL1154.2 +038800 CCVS1 SECTION. RL1154.2 +038900 OPEN-FILES. RL1154.2 +039000 OPEN OUTPUT PRINT-FILE. RL1154.2 +039100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1154.2 +039200 MOVE SPACE TO TEST-RESULTS. RL1154.2 +039300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1154.2 +039400 MOVE ZERO TO REC-SKL-SUB. RL1154.2 +039500 PERFORM CCVS-INIT-FILE 9 TIMES. RL1154.2 +039600 CCVS-INIT-FILE. RL1154.2 +039700 ADD 1 TO REC-SKL-SUB. RL1154.2 +039800 MOVE FILE-RECORD-INFO-SKELETON RL1154.2 +039900 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1154.2 +040000 CCVS-INIT-EXIT. RL1154.2 +040100 GO TO CCVS1-EXIT. RL1154.2 +040200 CLOSE-FILES. RL1154.2 +040300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1154.2 +040400 TERMINATE-CCVS. RL1154.2 +040500*S EXIT PROGRAM. RL1154.2 +040600*SERMINATE-CALL. RL1154.2 +040700 STOP RUN. RL1154.2 +040800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1154.2 +040900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1154.2 +041000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1154.2 +041100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1154.2 +041200 MOVE "****TEST DELETED****" TO RE-MARK. RL1154.2 +041300 PRINT-DETAIL. RL1154.2 +041400 IF REC-CT NOT EQUAL TO ZERO RL1154.2 +041500 MOVE "." TO PARDOT-X RL1154.2 +041600 MOVE REC-CT TO DOTVALUE. RL1154.2 +041700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1154.2 +041800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1154.2 +041900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1154.2 +042000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1154.2 +042100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1154.2 +042200 MOVE SPACE TO CORRECT-X. RL1154.2 +042300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1154.2 +042400 MOVE SPACE TO RE-MARK. RL1154.2 +042500 HEAD-ROUTINE. RL1154.2 +042600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +042700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +042800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1154.2 +042900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1154.2 +043000 COLUMN-NAMES-ROUTINE. RL1154.2 +043100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +043200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +043300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +043400 END-ROUTINE. RL1154.2 +043500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1154.2 +043600 END-RTN-EXIT. RL1154.2 +043700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +043800 END-ROUTINE-1. RL1154.2 +043900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1154.2 +044000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1154.2 +044100 ADD PASS-COUNTER TO ERROR-HOLD. RL1154.2 +044200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1154.2 +044300 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1154.2 +044400 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1154.2 +044500 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1154.2 +044600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1154.2 +044700 END-ROUTINE-12. RL1154.2 +044800 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1154.2 +044900 IF ERROR-COUNTER IS EQUAL TO ZERO RL1154.2 +045000 MOVE "NO " TO ERROR-TOTAL RL1154.2 +045100 ELSE RL1154.2 +045200 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1154.2 +045300 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1154.2 +045400 PERFORM WRITE-LINE. RL1154.2 +045500 END-ROUTINE-13. RL1154.2 +045600 IF DELETE-COUNTER IS EQUAL TO ZERO RL1154.2 +045700 MOVE "NO " TO ERROR-TOTAL ELSE RL1154.2 +045800 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1154.2 +045900 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1154.2 +046000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +046100 IF INSPECT-COUNTER EQUAL TO ZERO RL1154.2 +046200 MOVE "NO " TO ERROR-TOTAL RL1154.2 +046300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1154.2 +046400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1154.2 +046500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +046600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1154.2 +046700 WRITE-LINE. RL1154.2 +046800 ADD 1 TO RECORD-COUNT. RL1154.2 +046900 IF RECORD-COUNT GREATER 50 RL1154.2 +047000 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1154.2 +047100 MOVE SPACE TO DUMMY-RECORD RL1154.2 +047200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1154.2 +047300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1154.2 +047400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1154.2 +047500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1154.2 +047600 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1154.2 +047700 MOVE ZERO TO RECORD-COUNT. RL1154.2 +047800 PERFORM WRT-LN. RL1154.2 +047900 WRT-LN. RL1154.2 +048000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1154.2 +048100 MOVE SPACE TO DUMMY-RECORD. RL1154.2 +048200 BLANK-LINE-PRINT. RL1154.2 +048300 PERFORM WRT-LN. RL1154.2 +048400 FAIL-ROUTINE. RL1154.2 +048500 IF COMPUTED-X NOT EQUAL TO SPACE RL1154.2 +048600 GO TO FAIL-ROUTINE-WRITE. RL1154.2 +048700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1154.2 +048800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1154.2 +048900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1154.2 +049000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +049100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1154.2 +049200 GO TO FAIL-ROUTINE-EX. RL1154.2 +049300 FAIL-ROUTINE-WRITE. RL1154.2 +049400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1154.2 +049500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1154.2 +049600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1154.2 +049700 MOVE SPACES TO COR-ANSI-REFERENCE. RL1154.2 +049800 FAIL-ROUTINE-EX. EXIT. RL1154.2 +049900 BAIL-OUT. RL1154.2 +050000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1154.2 +050100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1154.2 +050200 BAIL-OUT-WRITE. RL1154.2 +050300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1154.2 +050400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1154.2 +050500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1154.2 +050600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1154.2 +050700 BAIL-OUT-EX. EXIT. RL1154.2 +050800 CCVS1-EXIT. RL1154.2 +050900 EXIT. RL1154.2 +051000 SECT-RL115A-001 SECTION. RL1154.2 +051100 REL-INIT-009. RL1154.2 +051200 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1154.2 +051300 MOVE "REL-TEST-009" TO PAR-NAME. RL1154.2 +051400 MOVE "CREATE RL-FD2" TO FEATURE RL1154.2 +051500 MOVE "RL-FD2" TO XFILE-NAME (2). RL1154.2 +051600 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1154.2 +051700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1154.2 +051800 MOVE 000240 TO XRECORD-LENGTH (2). RL1154.2 +051900 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1154.2 +052000 MOVE 0001 TO XBLOCK-SIZE (2). RL1154.2 +052100 MOVE 000500 TO RECORDS-IN-FILE (2). RL1154.2 +052200 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1154.2 +052300 MOVE "S" TO XLABEL-TYPE (2). RL1154.2 +052400 MOVE 000001 TO XRECORD-NUMBER (2). RL1154.2 +052500*INITIALIZE RECORD WORK AREA NUMBER 2. RL1154.2 +052600 MOVE 1 TO WRK-CS-09V00-012. RL1154.2 +052700 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1154.2 +052800 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1154.2 +052900 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1154.2 +053000 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +053100 MOVE 90000002 TO RL-FD2-KEY. RL1154.2 +053200 MOVE 01 TO REC-CT. RL1154.2 +053300 OPEN OUTPUT RL-FD2. RL1154.2 +053400 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1154.2 +053500*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1154.2 +053600 REL-TEST-009-R. RL1154.2 +053700 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1154.2 +053800 MOVE "99" TO RL-FD2-STATUS. RL1154.2 +053900 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1154.2 +054000 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1154.2 +054100 RL-FD2-GRP-120. RL1154.2 +054200 WRITE RL-FD2R1-F-G-240 INVALID KEY RL1154.2 +054300 GO TO REL-TEST-009-2. RL1154.2 +054400 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +054500 GO TO REL-TEST-009-2. RL1154.2 +054600 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1154.2 +054700 GO TO REL-TEST-009-2. RL1154.2 +054800 ADD 01 TO XRECORD-NUMBER (2). RL1154.2 +054900 GO TO REL-TEST-009-R. RL1154.2 +055000 REL-TEST-009-2. RL1154.2 +055100 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1154.2 +055200 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1154.2 +055300 MOVE ZERO TO CORRECT-18V0 RL1154.2 +055400 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1154.2 +055500 PERFORM FAIL RL1154.2 +055600 ELSE RL1154.2 +055700 PERFORM PASS. RL1154.2 +055800 PERFORM PRINT-DETAIL. RL1154.2 +055900 ADD 01 TO REC-CT. RL1154.2 +056000* .01 RL1154.2 +056100 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1154.2 +056200 MOVE "INCORRECT COUNT" TO RE-MARK RL1154.2 +056300 MOVE 500 TO CORRECT-18V0 RL1154.2 +056400 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1154.2 +056500 PERFORM FAIL RL1154.2 +056600 ELSE RL1154.2 +056700 PERFORM PASS. RL1154.2 +056800 PERFORM PRINT-DETAIL. RL1154.2 +056900 ADD 01 TO REC-CT. RL1154.2 +057000* .02 RL1154.2 +057100 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1154.2 +057200 MOVE "STATUS/OPEN" TO RE-MARK RL1154.2 +057300 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1154.2 +057400 MOVE "00" TO CORRECT-A RL1154.2 +057500 PERFORM FAIL RL1154.2 +057600 ELSE RL1154.2 +057700 PERFORM PASS. RL1154.2 +057800 PERFORM PRINT-DETAIL. RL1154.2 +057900 ADD 01 TO REC-CT. RL1154.2 +058000* .03 RL1154.2 +058100 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +058200 MOVE "STATUS/WRITE" TO RE-MARK RL1154.2 +058300 MOVE RL-FD2-STATUS TO COMPUTED-A RL1154.2 +058400 MOVE "00" TO CORRECT-A RL1154.2 +058500 PERFORM FAIL RL1154.2 +058600 ELSE RL1154.2 +058700 PERFORM PASS. RL1154.2 +058800 PERFORM PRINT-DETAIL. RL1154.2 +058900 ADD 01 TO REC-CT. RL1154.2 +059000* .04 RL1154.2 +059100 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +059200 CLOSE RL-FD2. RL1154.2 +059300 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +059400 MOVE "CLOSE/STATUS" TO RE-MARK RL1154.2 +059500 MOVE RL-FD2-STATUS TO COMPUTED-A RL1154.2 +059600 MOVE "00" TO CORRECT-A RL1154.2 +059700 PERFORM FAIL RL1154.2 +059800 ELSE RL1154.2 +059900 PERFORM PASS. RL1154.2 +060000 PERFORM PRINT-DETAIL. RL1154.2 +060100 ADD 01 TO REC-CT. RL1154.2 +060200* .05 RL1154.2 +060300 REL-INIT-010. RL1154.2 +060400 MOVE "REL-TEST-010" TO PAR-NAME. RL1154.2 +060500 MOVE 2 TO WRK-CS-09V00-012. RL1154.2 +060600 MOVE ZERO TO RL-FD2-KEY. RL1154.2 +060700 MOVE ZERO TO WRK-CS-09V00-013. RL1154.2 +060800 MOVE ZERO TO WRK-CS-09V00-014. RL1154.2 +060900 MOVE ZERO TO WRK-CS-09V00-015. RL1154.2 +061000 MOVE ZERO TO WRK-CS-09V00-016. RL1154.2 +061100 MOVE ZERO TO WRK-CS-09V00-017. RL1154.2 +061200 MOVE ZERO TO WRK-CS-09V00-018. RL1154.2 +061300 MOVE 01 TO REC-CT. RL1154.2 +061400 OPEN I-O RL-FD2. RL1154.2 +061500 MOVE SPACE TO WRK-XN-0002-002 RL1154.2 +061600 MOVE SPACE TO WRK-XN-0002-003 RL1154.2 +061700 MOVE SPACE TO WRK-XN-0002-004 RL1154.2 +061800 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL1154.2 +061900 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +062000*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL1154.2 +062100 MOVE "USE/FILE STATUS" TO FEATURE. RL1154.2 +062200 REL-TEST-010-R. RL1154.2 +062300 ADD 1 TO RL-FD2-KEY. RL1154.2 +062400 ADD 1 TO WRK-CS-09V00-014. RL1154.2 +062500 ADD 1 TO WRK-CS-09V00-015. RL1154.2 +062600 READ RL-FD2. RL1154.2 +062700 IF RL-FD2-STATUS EQUAL TO "10" RL1154.2 +062800 GO TO REL-TEST-010-3. RL1154.2 +062900 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL1154.2 +063000 IF WRK-CS-09V00-015 EQUAL TO 5 RL1154.2 +063100 ADD 01 TO UPDATE-NUMBER (2) RL1154.2 +063200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL1154.2 +063300 REWRITE RL-FD2R1-F-G-240 RL1154.2 +063400 MOVE ZERO TO WRK-CS-09V00-015 RL1154.2 +063500 GO TO REL-TEST-010-2. RL1154.2 +063600 IF WRK-CS-09V00-014 GREATER 500 RL1154.2 +063700 GO TO REL-TEST-010-3. RL1154.2 +063800 GO TO REL-TEST-010-R. RL1154.2 +063900 REL-TEST-010-2. RL1154.2 +064000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +064100 ADD 1 TO WRK-CS-09V00-016. RL1154.2 +064200 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +064300 GO TO REL-TEST-010-R. RL1154.2 +064400 REL-TEST-010-3. RL1154.2 +064500 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL1154.2 +064600 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1154.2 +064700 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL1154.2 +064800 MOVE 1 TO CORRECT-18V0 RL1154.2 +064900 PERFORM FAIL RL1154.2 +065000 ELSE RL1154.2 +065100 PERFORM PASS. RL1154.2 +065200 PERFORM PRINT-DETAIL. RL1154.2 +065300 ADD 01 TO REC-CT. RL1154.2 +065400* .01 RL1154.2 +065500 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL1154.2 +065600 MOVE "INCORRECT COUNT" TO RE-MARK RL1154.2 +065700 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1154.2 +065800 MOVE 501 TO CORRECT-18V0 RL1154.2 +065900 PERFORM FAIL RL1154.2 +066000 ELSE RL1154.2 +066100 PERFORM PASS. RL1154.2 +066200 PERFORM PRINT-DETAIL. RL1154.2 +066300 ADD 01 TO REC-CT. RL1154.2 +066400* .02 RL1154.2 +066500 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1154.2 +066600 MOVE "OPEN/STATUS" TO RE-MARK RL1154.2 +066700 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1154.2 +066800 MOVE "00" TO CORRECT-A RL1154.2 +066900 PERFORM FAIL RL1154.2 +067000 ELSE RL1154.2 +067100 PERFORM PASS. RL1154.2 +067200 PERFORM PRINT-DETAIL. RL1154.2 +067300 ADD 01 TO REC-CT. RL1154.2 +067400* .03 RL1154.2 +067500 IF RL-FD2-STATUS NOT EQUAL TO "10" RL1154.2 +067600 MOVE "ATEND/STATUS" TO RE-MARK RL1154.2 +067700 MOVE RL-FD2-STATUS TO COMPUTED-A RL1154.2 +067800 MOVE "10" TO CORRECT-A RL1154.2 +067900 PERFORM FAIL RL1154.2 +068000 ELSE RL1154.2 +068100 PERFORM PASS. RL1154.2 +068200 PERFORM PRINT-DETAIL. RL1154.2 +068300 ADD 01 TO REC-CT. RL1154.2 +068400* .04 RL1154.2 +068500 IF WRK-XN-0002-002 NOT EQUAL TO "10" RL1154.2 +068600 MOVE "EXCEPTIN/STATUS" TO RE-MARK RL1154.2 +068700 MOVE WRK-XN-0002-002 TO COMPUTED-A RL1154.2 +068800 MOVE "10" TO CORRECT-A RL1154.2 +068900 PERFORM FAIL RL1154.2 +069000 ELSE RL1154.2 +069100 PERFORM PASS. RL1154.2 +069200 PERFORM PRINT-DETAIL. RL1154.2 +069300 ADD 01 TO REC-CT. RL1154.2 +069400* .05 RL1154.2 +069500 IF WRK-XN-0002-003 NOT EQUAL TO "10" RL1154.2 +069600 MOVE "NO/EXCEPTION" TO RE-MARK RL1154.2 +069700 MOVE WRK-XN-0002-003 TO COMPUTED-A RL1154.2 +069800 MOVE "10" TO CORRECT-A RL1154.2 +069900 PERFORM FAIL RL1154.2 +070000 ELSE RL1154.2 +070100 PERFORM PASS. RL1154.2 +070200 PERFORM PRINT-DETAIL RL1154.2 +070300 ADD 01 TO REC-CT. RL1154.2 +070400* .06 RL1154.2 +070500 MOVE SPACE TO RL-FD2-STATUS. RL1154.2 +070600 CLOSE RL-FD2 RL1154.2 +070700 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1154.2 +070800 MOVE "CLOSE/STATUS" TO RE-MARK RL1154.2 +070900 MOVE RL-FD2-STATUS TO COMPUTED-A RL1154.2 +071000 MOVE "00" TO CORRECT-A RL1154.2 +071100 PERFORM FAIL RL1154.2 +071200 ELSE RL1154.2 +071300 PERFORM PASS. RL1154.2 +071400 PERFORM PRINT-DETAIL. RL1154.2 +071500 ADD 01 TO REC-CT. RL1154.2 +071600* .07 RL1154.2 +071700 CCVS-EXIT SECTION. RL1154.2 +071800 CCVS-999999. RL1154.2 +071900 GO TO CLOSE-FILES. RL1154.2 diff --git a/tests/cobol85/RL/RL116A.CBL b/tests/cobol85/RL/RL116A.CBL new file mode 100644 index 00000000..4f86f3f5 --- /dev/null +++ b/tests/cobol85/RL/RL116A.CBL @@ -0,0 +1,614 @@ +000100 IDENTIFICATION DIVISION. RL1164.2 +000200 PROGRAM-ID. RL1164.2 +000300 RL116A. RL1164.2 +000400**************************************************************** RL1164.2 +000500* * RL1164.2 +000600* VALIDATION FOR:- * RL1164.2 +000700* * RL1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1164.2 +000900* * RL1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1164.2 +001100* * RL1164.2 +001200**************************************************************** RL1164.2 +001300* * RL1164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1164.2 +001500* * RL1164.2 +001600* X-55 - SYSTEM PRINTER NAME. * RL1164.2 +001700* X-82 - SOURCE COMPUTER NAME. * RL1164.2 +001800* X-83 - OBJECT COMPUTER NAME. * RL1164.2 +001900* * RL1164.2 +002000**************************************************************** RL1164.2 +002100* * RL1164.2 +002200* X-CARDS USED BY THIS PROGRAM ARE :- * RL1164.2 +002300* * RL1164.2 +002400* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1164.2 +002500* RELATIVE I-O DATA FILE * RL1164.2 +002600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1164.2 +002700* RELATIVE I-O DATA FILE * RL1164.2 +002800* X-55 SYSTEM PRINTER * RL1164.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1164.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1164.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE * RL1164.2 +003200* X-82 SOURCE-COMPUTER * RL1164.2 +003300* X-83 OBJECT-COMPUTER. * RL1164.2 +003400* * RL1164.2 +003500**************************************************************** RL1164.2 +003600* RL116A * RL1164.2 +003700**************************************************************** RL1164.2 +003800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL1164.2 +003900* SEMANTIC ACTIONS ASSOCIATED WITH THE "STATUS" RL1164.2 +004000* CLAUSE FOR THE VALUES "00" AND "10". RL1164.2 +004100* RL1164.2 +004200* RL1164.2 +004300* RL1164.2 +004400*************************************************** RL1164.2 +004500 ENVIRONMENT DIVISION. RL1164.2 +004600 CONFIGURATION SECTION. RL1164.2 +004700 SOURCE-COMPUTER. RL1164.2 +004800 Linux. RL1164.2 +004900 OBJECT-COMPUTER. RL1164.2 +005000 Linux. RL1164.2 +005100 INPUT-OUTPUT SECTION. RL1164.2 +005200 FILE-CONTROL. RL1164.2 +005300 SELECT PRINT-FILE ASSIGN TO RL1164.2 +005400 "report.log". RL1164.2 +005500 SELECT RL-FD2 ASSIGN RL1164.2 +005600 "XXXXX022" RL1164.2 +005700 ORGANIZATION RELATIVE RL1164.2 +005800 ACCESS RANDOM RL1164.2 +005900 RELATIVE RL-FD2-KEY RL1164.2 +006000 FILE STATUS IS RL-FD2-STATUS. RL1164.2 +006100 SELECT RL-FD3 ASSIGN RL1164.2 +006200 "XXXXX022" RL1164.2 +006300 ORGANIZATION RELATIVE RL1164.2 +006400 ACCESS SEQUENTIAL RL1164.2 +006500 RELATIVE RL-FD3-KEY RL1164.2 +006600 FILE STATUS IS RL-FD3-STATUS. RL1164.2 +006700 DATA DIVISION. RL1164.2 +006800 FILE SECTION. RL1164.2 +006900 FD PRINT-FILE. RL1164.2 +007000 01 PRINT-REC PICTURE X(120). RL1164.2 +007100 01 DUMMY-RECORD PICTURE X(120). RL1164.2 +007200 FD RL-FD2 RL1164.2 +007300*C VALUE OF RL1164.2 +007400*C OCLABELID RL1164.2 +007500*C IS RL1164.2 +007600*C "OCDUMMY" RL1164.2 +007700*G SYSIN RL1164.2 +007800 LABEL RECORDS ARE STANDARD RL1164.2 +007900 BLOCK CONTAINS 1 RECORDS RL1164.2 +008000 DATA RECORD RL-FD2R1-F-G-240. RL1164.2 +008100 01 RL-FD2R1-F-G-240. RL1164.2 +008200 05 RL-FD2-WRK-120 PIC X(120). RL1164.2 +008300 05 RL-FD2-GRP-120. RL1164.2 +008400 10 RL-FD2-WRK-XN-0001-O120F RL1164.2 +008500 PICTURE X OCCURS 120 TIMES. RL1164.2 +008600 FD RL-FD3 RL1164.2 +008700*C VALUE OF RL1164.2 +008800*C OCLABELID RL1164.2 +008900*C IS RL1164.2 +009000*C "OCDUMMY" RL1164.2 +009100*G SYSIN RL1164.2 +009200 LABEL RECORDS ARE STANDARD RL1164.2 +009300 BLOCK CONTAINS 1 RECORDS RL1164.2 +009400 DATA RECORD RL-FD3R1-F-G-240. RL1164.2 +009500 01 RL-FD3R1-F-G-240. RL1164.2 +009600 05 RL-FD3-WRK-120 PIC X(120). RL1164.2 +009700 05 RL-FD3-GRP-130. RL1164.2 +009800 10 RL-FD3-WRK-XN-0001-O120F RL1164.2 +009900 PICTURE X OCCURS 120 TIMES. RL1164.2 +010000 WORKING-STORAGE SECTION. RL1164.2 +010100 01 GRP-0001. RL1164.2 +010200 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1164.2 +010300 05 RL-FD3-KEY PIC 9(8) VALUE ZERO. RL1164.2 +010400 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010500 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010600 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010700 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010800 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +010900 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +011000 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1164.2 +011100 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1164.2 +011200 05 RL-FD3-STATUS PIC XX VALUE SPACE. RL1164.2 +011300 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1164.2 +011400 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1164.2 +011500 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1164.2 +011600 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1164.2 +011700 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1164.2 +011800 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1164.2 +011900 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1164.2 +012000 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1164.2 +012100 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1164.2 +012200 01 FILE-RECORD-INFORMATION-REC. RL1164.2 +012300 03 FILE-RECORD-INFO-SKELETON. RL1164.2 +012400 05 FILLER PICTURE X(48) VALUE RL1164.2 +012500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1164.2 +012600 05 FILLER PICTURE X(46) VALUE RL1164.2 +012700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1164.2 +012800 05 FILLER PICTURE X(26) VALUE RL1164.2 +012900 ",LFIL=000000,ORG= ,LBLR= ". RL1164.2 +013000 05 FILLER PICTURE X(37) VALUE RL1164.2 +013100 ",RECKEY= ". RL1164.2 +013200 05 FILLER PICTURE X(38) VALUE RL1164.2 +013300 ",ALTKEY1= ". RL1164.2 +013400 05 FILLER PICTURE X(38) VALUE RL1164.2 +013500 ",ALTKEY2= ". RL1164.2 +013600 05 FILLER PICTURE X(7) VALUE SPACE.RL1164.2 +013700 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1164.2 +013800 05 FILE-RECORD-INFO-P1-120. RL1164.2 +013900 07 FILLER PIC X(5). RL1164.2 +014000 07 XFILE-NAME PIC X(6). RL1164.2 +014100 07 FILLER PIC X(8). RL1164.2 +014200 07 XRECORD-NAME PIC X(6). RL1164.2 +014300 07 FILLER PIC X(1). RL1164.2 +014400 07 REELUNIT-NUMBER PIC 9(1). RL1164.2 +014500 07 FILLER PIC X(7). RL1164.2 +014600 07 XRECORD-NUMBER PIC 9(6). RL1164.2 +014700 07 FILLER PIC X(6). RL1164.2 +014800 07 UPDATE-NUMBER PIC 9(2). RL1164.2 +014900 07 FILLER PIC X(5). RL1164.2 +015000 07 ODO-NUMBER PIC 9(4). RL1164.2 +015100 07 FILLER PIC X(5). RL1164.2 +015200 07 XPROGRAM-NAME PIC X(5). RL1164.2 +015300 07 FILLER PIC X(7). RL1164.2 +015400 07 XRECORD-LENGTH PIC 9(6). RL1164.2 +015500 07 FILLER PIC X(7). RL1164.2 +015600 07 CHARS-OR-RECORDS PIC X(2). RL1164.2 +015700 07 FILLER PIC X(1). RL1164.2 +015800 07 XBLOCK-SIZE PIC 9(4). RL1164.2 +015900 07 FILLER PIC X(6). RL1164.2 +016000 07 RECORDS-IN-FILE PIC 9(6). RL1164.2 +016100 07 FILLER PIC X(5). RL1164.2 +016200 07 XFILE-ORGANIZATION PIC X(2). RL1164.2 +016300 07 FILLER PIC X(6). RL1164.2 +016400 07 XLABEL-TYPE PIC X(1). RL1164.2 +016500 05 FILE-RECORD-INFO-P121-240. RL1164.2 +016600 07 FILLER PIC X(8). RL1164.2 +016700 07 XRECORD-KEY PIC X(29). RL1164.2 +016800 07 FILLER PIC X(9). RL1164.2 +016900 07 ALTERNATE-KEY1 PIC X(29). RL1164.2 +017000 07 FILLER PIC X(9). RL1164.2 +017100 07 ALTERNATE-KEY2 PIC X(29). RL1164.2 +017200 07 FILLER PIC X(7). RL1164.2 +017300 01 TEST-RESULTS. RL1164.2 +017400 02 FILLER PIC X VALUE SPACE. RL1164.2 +017500 02 FEATURE PIC X(20) VALUE SPACE. RL1164.2 +017600 02 FILLER PIC X VALUE SPACE. RL1164.2 +017700 02 P-OR-F PIC X(5) VALUE SPACE. RL1164.2 +017800 02 FILLER PIC X VALUE SPACE. RL1164.2 +017900 02 PAR-NAME. RL1164.2 +018000 03 FILLER PIC X(19) VALUE SPACE. RL1164.2 +018100 03 PARDOT-X PIC X VALUE SPACE. RL1164.2 +018200 03 DOTVALUE PIC 99 VALUE ZERO. RL1164.2 +018300 02 FILLER PIC X(8) VALUE SPACE. RL1164.2 +018400 02 RE-MARK PIC X(61). RL1164.2 +018500 01 TEST-COMPUTED. RL1164.2 +018600 02 FILLER PIC X(30) VALUE SPACE. RL1164.2 +018700 02 FILLER PIC X(17) VALUE RL1164.2 +018800 " COMPUTED=". RL1164.2 +018900 02 COMPUTED-X. RL1164.2 +019000 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1164.2 +019100 03 COMPUTED-N REDEFINES COMPUTED-A RL1164.2 +019200 PIC -9(9).9(9). RL1164.2 +019300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1164.2 +019400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1164.2 +019500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1164.2 +019600 03 CM-18V0 REDEFINES COMPUTED-A. RL1164.2 +019700 04 COMPUTED-18V0 PIC -9(18). RL1164.2 +019800 04 FILLER PIC X. RL1164.2 +019900 03 FILLER PIC X(50) VALUE SPACE. RL1164.2 +020000 01 TEST-CORRECT. RL1164.2 +020100 02 FILLER PIC X(30) VALUE SPACE. RL1164.2 +020200 02 FILLER PIC X(17) VALUE " CORRECT =". RL1164.2 +020300 02 CORRECT-X. RL1164.2 +020400 03 CORRECT-A PIC X(20) VALUE SPACE. RL1164.2 +020500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1164.2 +020600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1164.2 +020700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1164.2 +020800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1164.2 +020900 03 CR-18V0 REDEFINES CORRECT-A. RL1164.2 +021000 04 CORRECT-18V0 PIC -9(18). RL1164.2 +021100 04 FILLER PIC X. RL1164.2 +021200 03 FILLER PIC X(2) VALUE SPACE. RL1164.2 +021300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1164.2 +021400 01 CCVS-C-1. RL1164.2 +021500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1164.2 +021600- "SS PARAGRAPH-NAME RL1164.2 +021700- " REMARKS". RL1164.2 +021800 02 FILLER PIC X(20) VALUE SPACE. RL1164.2 +021900 01 CCVS-C-2. RL1164.2 +022000 02 FILLER PIC X VALUE SPACE. RL1164.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". RL1164.2 +022200 02 FILLER PIC X(15) VALUE SPACE. RL1164.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". RL1164.2 +022400 02 FILLER PIC X(94) VALUE SPACE. RL1164.2 +022500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1164.2 +022600 01 REC-CT PIC 99 VALUE ZERO. RL1164.2 +022700 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1164.2 +022800 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1164.2 +022900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1164.2 +023000 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1164.2 +023100 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1164.2 +023200 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1164.2 +023300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1164.2 +023400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1164.2 +023500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1164.2 +023600 01 CCVS-H-1. RL1164.2 +023700 02 FILLER PIC X(39) VALUE SPACES. RL1164.2 +023800 02 FILLER PIC X(42) VALUE RL1164.2 +023900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1164.2 +024000 02 FILLER PIC X(39) VALUE SPACES. RL1164.2 +024100 01 CCVS-H-2A. RL1164.2 +024200 02 FILLER PIC X(40) VALUE SPACE. RL1164.2 +024300 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1164.2 +024400 02 FILLER PIC XXXX VALUE RL1164.2 +024500 "4.2 ". RL1164.2 +024600 02 FILLER PIC X(28) VALUE RL1164.2 +024700 " COPY - NOT FOR DISTRIBUTION". RL1164.2 +024800 02 FILLER PIC X(41) VALUE SPACE. RL1164.2 +024900 RL1164.2 +025000 01 CCVS-H-2B. RL1164.2 +025100 02 FILLER PIC X(15) VALUE RL1164.2 +025200 "TEST RESULT OF ". RL1164.2 +025300 02 TEST-ID PIC X(9). RL1164.2 +025400 02 FILLER PIC X(4) VALUE RL1164.2 +025500 " IN ". RL1164.2 +025600 02 FILLER PIC X(12) VALUE RL1164.2 +025700 " HIGH ". RL1164.2 +025800 02 FILLER PIC X(22) VALUE RL1164.2 +025900 " LEVEL VALIDATION FOR ". RL1164.2 +026000 02 FILLER PIC X(58) VALUE RL1164.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1164.2 +026200 01 CCVS-H-3. RL1164.2 +026300 02 FILLER PIC X(34) VALUE RL1164.2 +026400 " FOR OFFICIAL USE ONLY ". RL1164.2 +026500 02 FILLER PIC X(58) VALUE RL1164.2 +026600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1164.2 +026700 02 FILLER PIC X(28) VALUE RL1164.2 +026800 " COPYRIGHT 1985 ". RL1164.2 +026900 01 CCVS-E-1. RL1164.2 +027000 02 FILLER PIC X(52) VALUE SPACE. RL1164.2 +027100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1164.2 +027200 02 ID-AGAIN PIC X(9). RL1164.2 +027300 02 FILLER PIC X(45) VALUE SPACES. RL1164.2 +027400 01 CCVS-E-2. RL1164.2 +027500 02 FILLER PIC X(31) VALUE SPACE. RL1164.2 +027600 02 FILLER PIC X(21) VALUE SPACE. RL1164.2 +027700 02 CCVS-E-2-2. RL1164.2 +027800 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1164.2 +027900 03 FILLER PIC X VALUE SPACE. RL1164.2 +028000 03 ENDER-DESC PIC X(44) VALUE RL1164.2 +028100 "ERRORS ENCOUNTERED". RL1164.2 +028200 01 CCVS-E-3. RL1164.2 +028300 02 FILLER PIC X(22) VALUE RL1164.2 +028400 " FOR OFFICIAL USE ONLY". RL1164.2 +028500 02 FILLER PIC X(12) VALUE SPACE. RL1164.2 +028600 02 FILLER PIC X(58) VALUE RL1164.2 +028700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1164.2 +028800 02 FILLER PIC X(13) VALUE SPACE. RL1164.2 +028900 02 FILLER PIC X(15) VALUE RL1164.2 +029000 " COPYRIGHT 1985". RL1164.2 +029100 01 CCVS-E-4. RL1164.2 +029200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1164.2 +029300 02 FILLER PIC X(4) VALUE " OF ". RL1164.2 +029400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1164.2 +029500 02 FILLER PIC X(40) VALUE RL1164.2 +029600 " TESTS WERE EXECUTED SUCCESSFULLY". RL1164.2 +029700 01 XXINFO. RL1164.2 +029800 02 FILLER PIC X(19) VALUE RL1164.2 +029900 "*** INFORMATION ***". RL1164.2 +030000 02 INFO-TEXT. RL1164.2 +030100 04 FILLER PIC X(8) VALUE SPACE. RL1164.2 +030200 04 XXCOMPUTED PIC X(20). RL1164.2 +030300 04 FILLER PIC X(5) VALUE SPACE. RL1164.2 +030400 04 XXCORRECT PIC X(20). RL1164.2 +030500 02 INF-ANSI-REFERENCE PIC X(48). RL1164.2 +030600 01 HYPHEN-LINE. RL1164.2 +030700 02 FILLER PIC IS X VALUE IS SPACE. RL1164.2 +030800 02 FILLER PIC IS X(65) VALUE IS "************************RL1164.2 +030900- "*****************************************". RL1164.2 +031000 02 FILLER PIC IS X(54) VALUE IS "************************RL1164.2 +031100- "******************************". RL1164.2 +031200 01 CCVS-PGM-ID PIC X(9) VALUE RL1164.2 +031300 "RL116A". RL1164.2 +031400 PROCEDURE DIVISION. RL1164.2 +031500 DECLARATIVES. RL1164.2 +031600 RL-FD2-01 SECTION. RL1164.2 +031700 USE AFTER ERROR PROCEDURE I-O. RL1164.2 +031800 RL-FD2-01-01. RL1164.2 +031900 MOVE "PASS " TO P-OR-F. RL1164.2 +032000 ADD 1 TO PASS-COUNTER. RL1164.2 +032100* RL1164.2 +032200 IF REC-CT NOT EQUAL TO ZERO RL1164.2 +032300 MOVE "." TO PARDOT-X RL1164.2 +032400 MOVE REC-CT TO DOTVALUE. RL1164.2 +032500 MOVE TEST-RESULTS TO PRINT-REC. RL1164.2 +032600 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT. RL1164.2 +032700 IF P-OR-F EQUAL TO "FAIL*" RL1164.2 +032800 PERFORM D1-WRITE-LINE THRU D1-WRITE-LINE-EXIT RL1164.2 +032900 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX RL1164.2 +033000 ELSE RL1164.2 +033100 PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. RL1164.2 +033200 MOVE SPACE TO P-OR-F. RL1164.2 +033300 MOVE SPACE TO COMPUTED-X. RL1164.2 +033400 MOVE SPACE TO CORRECT-X. RL1164.2 +033500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1164.2 +033600 MOVE SPACE TO RE-MARK. RL1164.2 +033700 GO TO RL-FD2-01-EXIT. RL1164.2 +033800 D1-FAIL-ROUTINE. RL1164.2 +033900 IF COMPUTED-X NOT EQUAL TO SPACE RL1164.2 +034000 GO TO D1-FAIL-ROUTINE-WRITE. RL1164.2 +034100 IF CORRECT-X NOT EQUAL TO SPACE RL1164.2 +034200 GO TO D1-FAIL-ROUTINE-WRITE. RL1164.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1164.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1164.2 +034500 MOVE XXINFO TO DUMMY-RECORD. RL1164.2 +034600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +034700 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +034800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +034900 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1164.2 +035100 GO TO D1-FAIL-ROUTINE-EX. RL1164.2 +035200 D1-FAIL-ROUTINE-WRITE. RL1164.2 +035300 MOVE TEST-COMPUTED TO PRINT-REC. RL1164.2 +035400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +035500 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +035600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1164.2 +035700 MOVE TEST-CORRECT TO PRINT-REC. RL1164.2 +035800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +035900 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +036000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +036100 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +036200 MOVE SPACES TO COR-ANSI-REFERENCE. RL1164.2 +036300 D1-FAIL-ROUTINE-EX. RL1164.2 +036400 EXIT. RL1164.2 +036500 D1-BAIL-OUT. RL1164.2 +036600 IF COMPUTED-A NOT EQUAL TO SPACE RL1164.2 +036700 GO TO D1-BAIL-OUT-WRITE. RL1164.2 +036800 IF CORRECT-A EQUAL TO SPACE RL1164.2 +036900 GO TO D1-BAIL-OUT-EX. RL1164.2 +037000 D1-BAIL-OUT-WRITE. RL1164.2 +037100 MOVE CORRECT-A TO XXCORRECT. RL1164.2 +037200 MOVE COMPUTED-A TO XXCOMPUTED. RL1164.2 +037300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1164.2 +037400 MOVE XXINFO TO DUMMY-RECORD. RL1164.2 +037500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +037600 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +037800 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +037900 MOVE SPACES TO INF-ANSI-REFERENCE. RL1164.2 +038000 D1-BAIL-OUT-EX. RL1164.2 +038100 EXIT. RL1164.2 +038200 D1-WRITE-LINE. RL1164.2 +038300 ADD 1 TO RECORD-COUNT. RL1164.2 +038400 IF RECORD-COUNT GREATER 50 RL1164.2 +038500 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1164.2 +038600 MOVE SPACE TO DUMMY-RECORD RL1164.2 +038700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1164.2 +038800 MOVE CCVS-C-1 TO DUMMY-RECORD RL1164.2 +038900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1164.2 +039000 MOVE SPACE TO DUMMY-RECORD RL1164.2 +039100 MOVE CCVS-C-2 TO DUMMY-RECORD RL1164.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1164.2 +039300 MOVE SPACE TO DUMMY-RECORD RL1164.2 +039400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1164.2 +039500 MOVE SPACE TO DUMMY-RECORD RL1164.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD RL1164.2 +039700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES RL1164.2 +039800 MOVE SPACE TO DUMMY-RECORD RL1164.2 +039900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1164.2 +040000 MOVE ZERO TO RECORD-COUNT. RL1164.2 +040100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +040200 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +040300 D1-WRITE-LINE-EXIT. RL1164.2 +040400 EXIT. RL1164.2 +040500 RL-FD2-01-EXIT. RL1164.2 +040600 EXIT. RL1164.2 +040700 END DECLARATIVES. RL1164.2 +040800 CCVS1 SECTION. RL1164.2 +040900 OPEN-FILES. RL1164.2 +041000 OPEN OUTPUT PRINT-FILE. RL1164.2 +041100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1164.2 +041200 MOVE SPACE TO TEST-RESULTS. RL1164.2 +041300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1164.2 +041400 MOVE ZERO TO REC-SKL-SUB. RL1164.2 +041500 PERFORM CCVS-INIT-FILE 9 TIMES. RL1164.2 +041600 CCVS-INIT-FILE. RL1164.2 +041700 ADD 1 TO REC-SKL-SUB. RL1164.2 +041800 MOVE FILE-RECORD-INFO-SKELETON RL1164.2 +041900 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1164.2 +042000 CCVS-INIT-EXIT. RL1164.2 +042100 GO TO CCVS1-EXIT. RL1164.2 +042200 CLOSE-FILES. RL1164.2 +042300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1164.2 +042400 TERMINATE-CCVS. RL1164.2 +042500*S EXIT PROGRAM. RL1164.2 +042600*SERMINATE-CALL. RL1164.2 +042700 STOP RUN. RL1164.2 +042800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1164.2 +042900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1164.2 +043000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1164.2 +043100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1164.2 +043200 MOVE "****TEST DELETED****" TO RE-MARK. RL1164.2 +043300 PRINT-DETAIL. RL1164.2 +043400 IF REC-CT NOT EQUAL TO ZERO RL1164.2 +043500 MOVE "." TO PARDOT-X RL1164.2 +043600 MOVE REC-CT TO DOTVALUE. RL1164.2 +043700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1164.2 +043800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1164.2 +043900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1164.2 +044000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1164.2 +044100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1164.2 +044200 MOVE SPACE TO CORRECT-X. RL1164.2 +044300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1164.2 +044400 MOVE SPACE TO RE-MARK. RL1164.2 +044500 HEAD-ROUTINE. RL1164.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1164.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1164.2 +045000 COLUMN-NAMES-ROUTINE. RL1164.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +045400 END-ROUTINE. RL1164.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1164.2 +045600 END-RTN-EXIT. RL1164.2 +045700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +045800 END-ROUTINE-1. RL1164.2 +045900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1164.2 +046000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1164.2 +046100 ADD PASS-COUNTER TO ERROR-HOLD. RL1164.2 +046200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1164.2 +046300 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1164.2 +046400 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1164.2 +046500 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1164.2 +046600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1164.2 +046700 END-ROUTINE-12. RL1164.2 +046800 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1164.2 +046900 IF ERROR-COUNTER IS EQUAL TO ZERO RL1164.2 +047000 MOVE "NO " TO ERROR-TOTAL RL1164.2 +047100 ELSE RL1164.2 +047200 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1164.2 +047300 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1164.2 +047400 PERFORM WRITE-LINE. RL1164.2 +047500 END-ROUTINE-13. RL1164.2 +047600 IF DELETE-COUNTER IS EQUAL TO ZERO RL1164.2 +047700 MOVE "NO " TO ERROR-TOTAL ELSE RL1164.2 +047800 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1164.2 +047900 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1164.2 +048000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +048100 IF INSPECT-COUNTER EQUAL TO ZERO RL1164.2 +048200 MOVE "NO " TO ERROR-TOTAL RL1164.2 +048300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1164.2 +048400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1164.2 +048500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +048600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1164.2 +048700 WRITE-LINE. RL1164.2 +048800 ADD 1 TO RECORD-COUNT. RL1164.2 +048900 IF RECORD-COUNT GREATER 50 RL1164.2 +049000 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1164.2 +049100 MOVE SPACE TO DUMMY-RECORD RL1164.2 +049200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1164.2 +049300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1164.2 +049400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1164.2 +049500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1164.2 +049600 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1164.2 +049700 MOVE ZERO TO RECORD-COUNT. RL1164.2 +049800 PERFORM WRT-LN. RL1164.2 +049900 WRT-LN. RL1164.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1164.2 +050100 MOVE SPACE TO DUMMY-RECORD. RL1164.2 +050200 BLANK-LINE-PRINT. RL1164.2 +050300 PERFORM WRT-LN. RL1164.2 +050400 FAIL-ROUTINE. RL1164.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE RL1164.2 +050600 GO TO FAIL-ROUTINE-WRITE. RL1164.2 +050700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1164.2 +050800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1164.2 +050900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1164.2 +051000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +051100 MOVE SPACES TO INF-ANSI-REFERENCE. RL1164.2 +051200 GO TO FAIL-ROUTINE-EX. RL1164.2 +051300 FAIL-ROUTINE-WRITE. RL1164.2 +051400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1164.2 +051500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1164.2 +051600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1164.2 +051700 MOVE SPACES TO COR-ANSI-REFERENCE. RL1164.2 +051800 FAIL-ROUTINE-EX. EXIT. RL1164.2 +051900 BAIL-OUT. RL1164.2 +052000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1164.2 +052100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1164.2 +052200 BAIL-OUT-WRITE. RL1164.2 +052300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1164.2 +052400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1164.2 +052500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1164.2 +052600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1164.2 +052700 BAIL-OUT-EX. EXIT. RL1164.2 +052800 CCVS1-EXIT. RL1164.2 +052900 EXIT. RL1164.2 +053000 SECT-RL116A-001 SECTION. RL1164.2 +053100 REL-INIT-009. RL1164.2 +053200 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1164.2 +053300 MOVE "REL-TEST-009" TO PAR-NAME. RL1164.2 +053400 MOVE "CREATE RL-FD2" TO FEATURE RL1164.2 +053500 MOVE "RL-FD2" TO XFILE-NAME (2). RL1164.2 +053600 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1164.2 +053700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1164.2 +053800 MOVE 000240 TO XRECORD-LENGTH (2). RL1164.2 +053900 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1164.2 +054000 MOVE 0001 TO XBLOCK-SIZE (2). RL1164.2 +054100 MOVE 000500 TO RECORDS-IN-FILE (2). RL1164.2 +054200 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1164.2 +054300 MOVE "S" TO XLABEL-TYPE (2). RL1164.2 +054400 MOVE 000001 TO XRECORD-NUMBER (2). RL1164.2 +054500*INITIALIZE RECORD WORK AREA NUMBER 2. RL1164.2 +054600 MOVE 1 TO WRK-CS-09V00-012. RL1164.2 +054700 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1164.2 +054800 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1164.2 +054900 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1164.2 +055000 MOVE SPACE TO RL-FD2-STATUS. RL1164.2 +055100 MOVE 90000002 TO RL-FD2-KEY. RL1164.2 +055200 MOVE 01 TO REC-CT. RL1164.2 +055300 OPEN OUTPUT RL-FD2. RL1164.2 +055400 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1164.2 +055500*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1164.2 +055600 REL-INIT-1. RL1164.2 +055700 MOVE "REL-TEST-1" TO PAR-NAME. RL1164.2 +055800 MOVE "VII-3 1.3.4 1A" TO ANSI-REFERENCE. RL1164.2 +055900 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1164.2 +056000 MOVE "99" TO RL-FD2-STATUS. RL1164.2 +056100 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1164.2 +056200 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-GRP-120. RL1164.2 +056300 WRITE RL-FD2R1-F-G-240 RL1164.2 +056400 INVALID KEY CONTINUE. RL1164.2 +056500 REL-TEST-1. RL1164.2 +056600 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1164.2 +056700 MOVE "INVALID WRITE" TO RE-MARK RL1164.2 +056800 MOVE RL-FD2-STATUS TO COMPUTED-X RL1164.2 +056900 MOVE "00" TO CORRECT-X RL1164.2 +057000 PERFORM FAIL RL1164.2 +057100 PERFORM PRINT-DETAIL RL1164.2 +057200 ELSE RL1164.2 +057300 PERFORM PASS RL1164.2 +057400 PERFORM PRINT-DETAIL. RL1164.2 +057500* RL1164.2 +057600 REL-INIT-2. RL1164.2 +057700 MOVE "REL-TEST-2" TO PAR-NAME. RL1164.2 +057800 MOVE "VII-3 1.3.4 2A" TO ANSI-REFERENCE. RL1164.2 +057900 IF RL-FD2-STATUS NOT = "00" RL1164.2 +058000 MOVE "TEST-2 NOT PERFORMED DUE TO FAILURE OF TEST-1"RL1164.2 +058100 TO RE-MARK RL1164.2 +058200 PERFORM FAIL RL1164.2 +058300 PERFORM PRINT-DETAIL RL1164.2 +058400 GO TO REL-TEST-2-EXIT. RL1164.2 +058500 CLOSE RL-FD2. RL1164.2 +058600 OPEN INPUT RL-FD3. RL1164.2 +058700 MOVE 1 TO RL-FD3-KEY. RL1164.2 +058800 REL-TEST-2-0. RL1164.2 +058900 READ RL-FD3 RL1164.2 +059000 AT END GO TO REL-TEST-2-1. RL1164.2 +059100 GO TO REL-TEST-2-0. RL1164.2 +059200 REL-TEST-2-1. RL1164.2 +059300 IF RL-FD3-STATUS NOT = "10" RL1164.2 +059400 MOVE RL-FD3-STATUS TO COMPUTED-X RL1164.2 +059500 MOVE "10" TO CORRECT-X RL1164.2 +059600 PERFORM FAIL RL1164.2 +059700 PERFORM PRINT-DETAIL RL1164.2 +059800 ELSE RL1164.2 +059900 PERFORM PASS RL1164.2 +060000 PERFORM PRINT-DETAIL. RL1164.2 +060100 CLOSE RL-FD3 RL1164.2 +060200 IF RL-FD3-STATUS NOT EQUAL TO "00" RL1164.2 +060300 MOVE "CLOSE/STATUS" TO RE-MARK RL1164.2 +060400 MOVE RL-FD3-STATUS TO COMPUTED-A RL1164.2 +060500 MOVE "00" TO CORRECT-A RL1164.2 +060600 PERFORM FAIL RL1164.2 +060700 ELSE RL1164.2 +060800 PERFORM PASS. RL1164.2 +060900 PERFORM PRINT-DETAIL. RL1164.2 +061000 REL-TEST-2-EXIT. RL1164.2 +061100* RL1164.2 +061200 CCVS-EXIT SECTION. RL1164.2 +061300 CCVS-999999. RL1164.2 +061400 GO TO CLOSE-FILES. RL1164.2 diff --git a/tests/cobol85/RL/RL117A.CBL b/tests/cobol85/RL/RL117A.CBL new file mode 100644 index 00000000..980df360 --- /dev/null +++ b/tests/cobol85/RL/RL117A.CBL @@ -0,0 +1,604 @@ +000100 IDENTIFICATION DIVISION. RL1174.2 +000200 PROGRAM-ID. RL1174.2 +000300 RL117A. RL1174.2 +000400**************************************************************** RL1174.2 +000500* * RL1174.2 +000600* VALIDATION FOR:- * RL1174.2 +000700* * RL1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1174.2 +000900* * RL1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1174.2 +001100* * RL1174.2 +001200**************************************************************** RL1174.2 +001300* * RL1174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1174.2 +001500* * RL1174.2 +001600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1174.2 +001700* RELATIVE I-O DATA FILE * RL1174.2 +001800* X-55 SYSTEM PRINTER * RL1174.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1174.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1174.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1174.2 +002200* X-82 SOURCE-COMPUTER * RL1174.2 +002300* X-83 OBJECT-COMPUTER. * RL1174.2 +002400* * RL1174.2 +002500**************************************************************** RL1174.2 +002600* RL117A * RL1174.2 +002700**************************************************************** RL1174.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND * RL1174.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "STATUS" * RL1174.2 +003000* CLAUSE FOR THE VALUES "10" AND "14". * RL1174.2 +003100* * RL1174.2 +003200* * RL1174.2 +003300* * RL1174.2 +003400**************************************************************** RL1174.2 +003500 ENVIRONMENT DIVISION. RL1174.2 +003600 CONFIGURATION SECTION. RL1174.2 +003700 SOURCE-COMPUTER. RL1174.2 +003800 Linux. RL1174.2 +003900 OBJECT-COMPUTER. RL1174.2 +004000 Linux. RL1174.2 +004100 INPUT-OUTPUT SECTION. RL1174.2 +004200 FILE-CONTROL. RL1174.2 +004300 SELECT PRINT-FILE ASSIGN TO RL1174.2 +004400 "report.log". RL1174.2 +004500 SELECT RL-FD2 ASSIGN RL1174.2 +004600 "XXXXX022" RL1174.2 +004700 ORGANIZATION RELATIVE RL1174.2 +004800 ACCESS RANDOM RL1174.2 +004900 RELATIVE RL-FD2-KEY RL1174.2 +005000 FILE STATUS IS RL-FD2-STATUS. RL1174.2 +005100 SELECT RL-FD3 ASSIGN RL1174.2 +005200 "XXXXX022" RL1174.2 +005300 ORGANIZATION RELATIVE RL1174.2 +005400 ACCESS SEQUENTIAL RL1174.2 +005500 RELATIVE RL-FD3-KEY RL1174.2 +005600 FILE STATUS IS RL-FD3-STATUS. RL1174.2 +005700 DATA DIVISION. RL1174.2 +005800 FILE SECTION. RL1174.2 +005900 FD PRINT-FILE. RL1174.2 +006000 01 PRINT-REC PICTURE X(120). RL1174.2 +006100 01 DUMMY-RECORD PICTURE X(120). RL1174.2 +006200 FD RL-FD2 RL1174.2 +006300*C VALUE OF RL1174.2 +006400*C OCLABELID RL1174.2 +006500*C IS RL1174.2 +006600*C "OCDUMMY" RL1174.2 +006700*G SYSIN RL1174.2 +006800 LABEL RECORDS ARE STANDARD RL1174.2 +006900 BLOCK CONTAINS 1 RECORDS RL1174.2 +007000 DATA RECORD RL-FD2R1-F-G-240. RL1174.2 +007100 01 RL-FD2R1-F-G-240. RL1174.2 +007200 05 RL-FD2-WRK-120 PIC X(120). RL1174.2 +007300 05 RL-FD2-GRP-120. RL1174.2 +007400 10 RL-FD2-WRK-XN-0001-O120F RL1174.2 +007500 PICTURE X OCCURS 120 TIMES. RL1174.2 +007600 FD RL-FD3 RL1174.2 +007700*C VALUE OF RL1174.2 +007800*C OCLABELID RL1174.2 +007900*C IS RL1174.2 +008000*C "OCDUMMY" RL1174.2 +008100*G SYSIN RL1174.2 +008200 LABEL RECORDS ARE STANDARD RL1174.2 +008300 BLOCK CONTAINS 1 RECORDS RL1174.2 +008400 DATA RECORD RL-FD3R1-F-G-240. RL1174.2 +008500 01 RL-FD3R1-F-G-240. RL1174.2 +008600 05 RL-FD3-WRK-120 PIC X(120). RL1174.2 +008700 05 RL-FD3-GRP-120. RL1174.2 +008800 10 RL-FD3-WRK-XN-0001-O120F RL1174.2 +008900 PICTURE X OCCURS 120 TIMES. RL1174.2 +009000 WORKING-STORAGE SECTION. RL1174.2 +009100 01 GRP-0001. RL1174.2 +009200 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL1174.2 +009300 05 RL-FD3-KEY PIC 99 VALUE ZERO. RL1174.2 +009400 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009500 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009600 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009700 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009800 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +009900 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +010000 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1174.2 +010100 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1174.2 +010200 05 RL-FD3-STATUS PIC XX VALUE SPACE. RL1174.2 +010300 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1174.2 +010400 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1174.2 +010500 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1174.2 +010600 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1174.2 +010700 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1174.2 +010800 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1174.2 +010900 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1174.2 +011000 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1174.2 +011100 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1174.2 +011200 01 FILE-RECORD-INFORMATION-REC. RL1174.2 +011300 03 FILE-RECORD-INFO-SKELETON. RL1174.2 +011400 05 FILLER PICTURE X(48) VALUE RL1174.2 +011500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1174.2 +011600 05 FILLER PICTURE X(46) VALUE RL1174.2 +011700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1174.2 +011800 05 FILLER PICTURE X(26) VALUE RL1174.2 +011900 ",LFIL=000000,ORG= ,LBLR= ". RL1174.2 +012000 05 FILLER PICTURE X(37) VALUE RL1174.2 +012100 ",RECKEY= ". RL1174.2 +012200 05 FILLER PICTURE X(38) VALUE RL1174.2 +012300 ",ALTKEY1= ". RL1174.2 +012400 05 FILLER PICTURE X(38) VALUE RL1174.2 +012500 ",ALTKEY2= ". RL1174.2 +012600 05 FILLER PICTURE X(7) VALUE SPACE.RL1174.2 +012700 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1174.2 +012800 05 FILE-RECORD-INFO-P1-120. RL1174.2 +012900 07 FILLER PIC X(5). RL1174.2 +013000 07 XFILE-NAME PIC X(6). RL1174.2 +013100 07 FILLER PIC X(8). RL1174.2 +013200 07 XRECORD-NAME PIC X(6). RL1174.2 +013300 07 FILLER PIC X(1). RL1174.2 +013400 07 REELUNIT-NUMBER PIC 9(1). RL1174.2 +013500 07 FILLER PIC X(7). RL1174.2 +013600 07 XRECORD-NUMBER PIC 9(6). RL1174.2 +013700 07 FILLER PIC X(6). RL1174.2 +013800 07 UPDATE-NUMBER PIC 9(2). RL1174.2 +013900 07 FILLER PIC X(5). RL1174.2 +014000 07 ODO-NUMBER PIC 9(4). RL1174.2 +014100 07 FILLER PIC X(5). RL1174.2 +014200 07 XPROGRAM-NAME PIC X(5). RL1174.2 +014300 07 FILLER PIC X(7). RL1174.2 +014400 07 XRECORD-LENGTH PIC 9(6). RL1174.2 +014500 07 FILLER PIC X(7). RL1174.2 +014600 07 CHARS-OR-RECORDS PIC X(2). RL1174.2 +014700 07 FILLER PIC X(1). RL1174.2 +014800 07 XBLOCK-SIZE PIC 9(4). RL1174.2 +014900 07 FILLER PIC X(6). RL1174.2 +015000 07 RECORDS-IN-FILE PIC 9(6). RL1174.2 +015100 07 FILLER PIC X(5). RL1174.2 +015200 07 XFILE-ORGANIZATION PIC X(2). RL1174.2 +015300 07 FILLER PIC X(6). RL1174.2 +015400 07 XLABEL-TYPE PIC X(1). RL1174.2 +015500 05 FILE-RECORD-INFO-P121-240. RL1174.2 +015600 07 FILLER PIC X(8). RL1174.2 +015700 07 XRECORD-KEY PIC X(29). RL1174.2 +015800 07 FILLER PIC X(9). RL1174.2 +015900 07 ALTERNATE-KEY1 PIC X(29). RL1174.2 +016000 07 FILLER PIC X(9). RL1174.2 +016100 07 ALTERNATE-KEY2 PIC X(29). RL1174.2 +016200 07 FILLER PIC X(7). RL1174.2 +016300 01 TEST-RESULTS. RL1174.2 +016400 02 FILLER PIC X VALUE SPACE. RL1174.2 +016500 02 FEATURE PIC X(20) VALUE SPACE. RL1174.2 +016600 02 FILLER PIC X VALUE SPACE. RL1174.2 +016700 02 P-OR-F PIC X(5) VALUE SPACE. RL1174.2 +016800 02 FILLER PIC X VALUE SPACE. RL1174.2 +016900 02 PAR-NAME. RL1174.2 +017000 03 FILLER PIC X(19) VALUE SPACE. RL1174.2 +017100 03 PARDOT-X PIC X VALUE SPACE. RL1174.2 +017200 03 DOTVALUE PIC 99 VALUE ZERO. RL1174.2 +017300 02 FILLER PIC X(8) VALUE SPACE. RL1174.2 +017400 02 RE-MARK PIC X(61). RL1174.2 +017500 01 TEST-COMPUTED. RL1174.2 +017600 02 FILLER PIC X(30) VALUE SPACE. RL1174.2 +017700 02 FILLER PIC X(17) VALUE RL1174.2 +017800 " COMPUTED=". RL1174.2 +017900 02 COMPUTED-X. RL1174.2 +018000 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1174.2 +018100 03 COMPUTED-N REDEFINES COMPUTED-A RL1174.2 +018200 PIC -9(9).9(9). RL1174.2 +018300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1174.2 +018400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1174.2 +018500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1174.2 +018600 03 CM-18V0 REDEFINES COMPUTED-A. RL1174.2 +018700 04 COMPUTED-18V0 PIC -9(18). RL1174.2 +018800 04 FILLER PIC X. RL1174.2 +018900 03 FILLER PIC X(50) VALUE SPACE. RL1174.2 +019000 01 TEST-CORRECT. RL1174.2 +019100 02 FILLER PIC X(30) VALUE SPACE. RL1174.2 +019200 02 FILLER PIC X(17) VALUE " CORRECT =". RL1174.2 +019300 02 CORRECT-X. RL1174.2 +019400 03 CORRECT-A PIC X(20) VALUE SPACE. RL1174.2 +019500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1174.2 +019600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1174.2 +019700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1174.2 +019800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1174.2 +019900 03 CR-18V0 REDEFINES CORRECT-A. RL1174.2 +020000 04 CORRECT-18V0 PIC -9(18). RL1174.2 +020100 04 FILLER PIC X. RL1174.2 +020200 03 FILLER PIC X(2) VALUE SPACE. RL1174.2 +020300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1174.2 +020400 01 CCVS-C-1. RL1174.2 +020500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1174.2 +020600- "SS PARAGRAPH-NAME RL1174.2 +020700- " REMARKS". RL1174.2 +020800 02 FILLER PIC X(20) VALUE SPACE. RL1174.2 +020900 01 CCVS-C-2. RL1174.2 +021000 02 FILLER PIC X VALUE SPACE. RL1174.2 +021100 02 FILLER PIC X(6) VALUE "TESTED". RL1174.2 +021200 02 FILLER PIC X(15) VALUE SPACE. RL1174.2 +021300 02 FILLER PIC X(4) VALUE "FAIL". RL1174.2 +021400 02 FILLER PIC X(94) VALUE SPACE. RL1174.2 +021500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1174.2 +021600 01 REC-CT PIC 99 VALUE ZERO. RL1174.2 +021700 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1174.2 +021800 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1174.2 +021900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1174.2 +022000 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1174.2 +022100 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1174.2 +022200 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1174.2 +022300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1174.2 +022400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1174.2 +022500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1174.2 +022600 01 CCVS-H-1. RL1174.2 +022700 02 FILLER PIC X(39) VALUE SPACES. RL1174.2 +022800 02 FILLER PIC X(42) VALUE RL1174.2 +022900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1174.2 +023000 02 FILLER PIC X(39) VALUE SPACES. RL1174.2 +023100 01 CCVS-H-2A. RL1174.2 +023200 02 FILLER PIC X(40) VALUE SPACE. RL1174.2 +023300 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1174.2 +023400 02 FILLER PIC XXXX VALUE RL1174.2 +023500 "4.2 ". RL1174.2 +023600 02 FILLER PIC X(28) VALUE RL1174.2 +023700 " COPY - NOT FOR DISTRIBUTION". RL1174.2 +023800 02 FILLER PIC X(41) VALUE SPACE. RL1174.2 +023900 RL1174.2 +024000 01 CCVS-H-2B. RL1174.2 +024100 02 FILLER PIC X(15) VALUE RL1174.2 +024200 "TEST RESULT OF ". RL1174.2 +024300 02 TEST-ID PIC X(9). RL1174.2 +024400 02 FILLER PIC X(4) VALUE RL1174.2 +024500 " IN ". RL1174.2 +024600 02 FILLER PIC X(12) VALUE RL1174.2 +024700 " HIGH ". RL1174.2 +024800 02 FILLER PIC X(22) VALUE RL1174.2 +024900 " LEVEL VALIDATION FOR ". RL1174.2 +025000 02 FILLER PIC X(58) VALUE RL1174.2 +025100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1174.2 +025200 01 CCVS-H-3. RL1174.2 +025300 02 FILLER PIC X(34) VALUE RL1174.2 +025400 " FOR OFFICIAL USE ONLY ". RL1174.2 +025500 02 FILLER PIC X(58) VALUE RL1174.2 +025600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1174.2 +025700 02 FILLER PIC X(28) VALUE RL1174.2 +025800 " COPYRIGHT 1985 ". RL1174.2 +025900 01 CCVS-E-1. RL1174.2 +026000 02 FILLER PIC X(52) VALUE SPACE. RL1174.2 +026100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1174.2 +026200 02 ID-AGAIN PIC X(9). RL1174.2 +026300 02 FILLER PIC X(45) VALUE SPACES. RL1174.2 +026400 01 CCVS-E-2. RL1174.2 +026500 02 FILLER PIC X(31) VALUE SPACE. RL1174.2 +026600 02 FILLER PIC X(21) VALUE SPACE. RL1174.2 +026700 02 CCVS-E-2-2. RL1174.2 +026800 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1174.2 +026900 03 FILLER PIC X VALUE SPACE. RL1174.2 +027000 03 ENDER-DESC PIC X(44) VALUE RL1174.2 +027100 "ERRORS ENCOUNTERED". RL1174.2 +027200 01 CCVS-E-3. RL1174.2 +027300 02 FILLER PIC X(22) VALUE RL1174.2 +027400 " FOR OFFICIAL USE ONLY". RL1174.2 +027500 02 FILLER PIC X(12) VALUE SPACE. RL1174.2 +027600 02 FILLER PIC X(58) VALUE RL1174.2 +027700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1174.2 +027800 02 FILLER PIC X(13) VALUE SPACE. RL1174.2 +027900 02 FILLER PIC X(15) VALUE RL1174.2 +028000 " COPYRIGHT 1985". RL1174.2 +028100 01 CCVS-E-4. RL1174.2 +028200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1174.2 +028300 02 FILLER PIC X(4) VALUE " OF ". RL1174.2 +028400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1174.2 +028500 02 FILLER PIC X(40) VALUE RL1174.2 +028600 " TESTS WERE EXECUTED SUCCESSFULLY". RL1174.2 +028700 01 XXINFO. RL1174.2 +028800 02 FILLER PIC X(19) VALUE RL1174.2 +028900 "*** INFORMATION ***". RL1174.2 +029000 02 INFO-TEXT. RL1174.2 +029100 04 FILLER PIC X(8) VALUE SPACE. RL1174.2 +029200 04 XXCOMPUTED PIC X(20). RL1174.2 +029300 04 FILLER PIC X(5) VALUE SPACE. RL1174.2 +029400 04 XXCORRECT PIC X(20). RL1174.2 +029500 02 INF-ANSI-REFERENCE PIC X(48). RL1174.2 +029600 01 HYPHEN-LINE. RL1174.2 +029700 02 FILLER PIC IS X VALUE IS SPACE. RL1174.2 +029800 02 FILLER PIC IS X(65) VALUE IS "************************RL1174.2 +029900- "*****************************************". RL1174.2 +030000 02 FILLER PIC IS X(54) VALUE IS "************************RL1174.2 +030100- "******************************". RL1174.2 +030200 01 CCVS-PGM-ID PIC X(9) VALUE RL1174.2 +030300 "RL117A". RL1174.2 +030400 PROCEDURE DIVISION. RL1174.2 +030500 CCVS1 SECTION. RL1174.2 +030600 OPEN-FILES. RL1174.2 +030700 OPEN OUTPUT PRINT-FILE. RL1174.2 +030800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1174.2 +030900 MOVE SPACE TO TEST-RESULTS. RL1174.2 +031000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1174.2 +031100 MOVE ZERO TO REC-SKL-SUB. RL1174.2 +031200 PERFORM CCVS-INIT-FILE 9 TIMES. RL1174.2 +031300 CCVS-INIT-FILE. RL1174.2 +031400 ADD 1 TO REC-SKL-SUB. RL1174.2 +031500 MOVE FILE-RECORD-INFO-SKELETON RL1174.2 +031600 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1174.2 +031700 CCVS-INIT-EXIT. RL1174.2 +031800 GO TO CCVS1-EXIT. RL1174.2 +031900 CLOSE-FILES. RL1174.2 +032000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1174.2 +032100 TERMINATE-CCVS. RL1174.2 +032200*S EXIT PROGRAM. RL1174.2 +032300*SERMINATE-CALL. RL1174.2 +032400 STOP RUN. RL1174.2 +032500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1174.2 +032600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1174.2 +032700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1174.2 +032800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1174.2 +032900 MOVE "****TEST DELETED****" TO RE-MARK. RL1174.2 +033000 PRINT-DETAIL. RL1174.2 +033100 IF REC-CT NOT EQUAL TO ZERO RL1174.2 +033200 MOVE "." TO PARDOT-X RL1174.2 +033300 MOVE REC-CT TO DOTVALUE. RL1174.2 +033400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1174.2 +033500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1174.2 +033600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1174.2 +033700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1174.2 +033800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1174.2 +033900 MOVE SPACE TO CORRECT-X. RL1174.2 +034000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1174.2 +034100 MOVE SPACE TO RE-MARK. RL1174.2 +034200 HEAD-ROUTINE. RL1174.2 +034300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +034400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +034500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1174.2 +034600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1174.2 +034700 COLUMN-NAMES-ROUTINE. RL1174.2 +034800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +034900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +035000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +035100 END-ROUTINE. RL1174.2 +035200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1174.2 +035300 END-RTN-EXIT. RL1174.2 +035400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +035500 END-ROUTINE-1. RL1174.2 +035600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1174.2 +035700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1174.2 +035800 ADD PASS-COUNTER TO ERROR-HOLD. RL1174.2 +035900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1174.2 +036000 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1174.2 +036100 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1174.2 +036200 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1174.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1174.2 +036400 END-ROUTINE-12. RL1174.2 +036500 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1174.2 +036600 IF ERROR-COUNTER IS EQUAL TO ZERO RL1174.2 +036700 MOVE "NO " TO ERROR-TOTAL RL1174.2 +036800 ELSE RL1174.2 +036900 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1174.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1174.2 +037100 PERFORM WRITE-LINE. RL1174.2 +037200 END-ROUTINE-13. RL1174.2 +037300 IF DELETE-COUNTER IS EQUAL TO ZERO RL1174.2 +037400 MOVE "NO " TO ERROR-TOTAL ELSE RL1174.2 +037500 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1174.2 +037600 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1174.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +037800 IF INSPECT-COUNTER EQUAL TO ZERO RL1174.2 +037900 MOVE "NO " TO ERROR-TOTAL RL1174.2 +038000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1174.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1174.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1174.2 +038400 WRITE-LINE. RL1174.2 +038500 ADD 1 TO RECORD-COUNT. RL1174.2 +038600 IF RECORD-COUNT GREATER 50 RL1174.2 +038700 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1174.2 +038800 MOVE SPACE TO DUMMY-RECORD RL1174.2 +038900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1174.2 +039000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1174.2 +039100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1174.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1174.2 +039300 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1174.2 +039400 MOVE ZERO TO RECORD-COUNT. RL1174.2 +039500 PERFORM WRT-LN. RL1174.2 +039600 WRT-LN. RL1174.2 +039700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1174.2 +039800 MOVE SPACE TO DUMMY-RECORD. RL1174.2 +039900 BLANK-LINE-PRINT. RL1174.2 +040000 PERFORM WRT-LN. RL1174.2 +040100 FAIL-ROUTINE. RL1174.2 +040200 IF COMPUTED-X NOT EQUAL TO SPACE RL1174.2 +040300 GO TO FAIL-ROUTINE-WRITE. RL1174.2 +040400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1174.2 +040500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1174.2 +040600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1174.2 +040700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +040800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1174.2 +040900 GO TO FAIL-ROUTINE-EX. RL1174.2 +041000 FAIL-ROUTINE-WRITE. RL1174.2 +041100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1174.2 +041200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1174.2 +041300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1174.2 +041400 MOVE SPACES TO COR-ANSI-REFERENCE. RL1174.2 +041500 FAIL-ROUTINE-EX. EXIT. RL1174.2 +041600 BAIL-OUT. RL1174.2 +041700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1174.2 +041800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1174.2 +041900 BAIL-OUT-WRITE. RL1174.2 +042000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1174.2 +042100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1174.2 +042200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1174.2 +042300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1174.2 +042400 BAIL-OUT-EX. EXIT. RL1174.2 +042500 CCVS1-EXIT. RL1174.2 +042600 EXIT. RL1174.2 +042700 SECT-RL117A-001 SECTION. RL1174.2 +042800 REL-INIT-009. RL1174.2 +042900 MOVE "VIII-36 4.8.4 GR4" TO ANSI-REFERENCE. RL1174.2 +043000 MOVE "REL-TEST-009" TO PAR-NAME. RL1174.2 +043100 MOVE "CREATE RL-FD2" TO FEATURE RL1174.2 +043200 MOVE "RL-FD2" TO XFILE-NAME (2). RL1174.2 +043300 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1174.2 +043400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1174.2 +043500 MOVE 000240 TO XRECORD-LENGTH (2). RL1174.2 +043600 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1174.2 +043700 MOVE 0001 TO XBLOCK-SIZE (2). RL1174.2 +043800 MOVE 000500 TO RECORDS-IN-FILE (2). RL1174.2 +043900 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1174.2 +044000 MOVE "S" TO XLABEL-TYPE (2). RL1174.2 +044100 MOVE 000001 TO XRECORD-NUMBER (2). RL1174.2 +044200*INITIALIZE RECORD WORK AREA NUMBER 2. RL1174.2 +044300 MOVE 1 TO WRK-CS-09V00-012. RL1174.2 +044400 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1174.2 +044500 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1174.2 +044600 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1174.2 +044700 MOVE SPACE TO RL-FD2-STATUS. RL1174.2 +044800 MOVE 90000002 TO RL-FD2-KEY. RL1174.2 +044900 MOVE 01 TO REC-CT. RL1174.2 +045000 OPEN OUTPUT RL-FD2. RL1174.2 +045100 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL1174.2 +045200*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL1174.2 +045300 REL-TEST-009-R. RL1174.2 +045400 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1174.2 +045500 MOVE "99" TO RL-FD2-STATUS. RL1174.2 +045600 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1174.2 +045700 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL1174.2 +045800 RL-FD2-GRP-120. RL1174.2 +045900 WRITE RL-FD2R1-F-G-240 INVALID KEY RL1174.2 +046000 GO TO REL-TEST-009-2. RL1174.2 +046100 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1174.2 +046200 GO TO REL-TEST-009-2. RL1174.2 +046300 IF XRECORD-NUMBER (2) EQUAL TO 500 RL1174.2 +046400 GO TO REL-TEST-009-2. RL1174.2 +046500 ADD 01 TO XRECORD-NUMBER (2). RL1174.2 +046600 GO TO REL-TEST-009-R. RL1174.2 +046700 REL-TEST-009-2. RL1174.2 +046800 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL1174.2 +046900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL1174.2 +047000 MOVE ZERO TO CORRECT-18V0 RL1174.2 +047100 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL1174.2 +047200 PERFORM FAIL RL1174.2 +047300 ELSE RL1174.2 +047400 PERFORM PASS. RL1174.2 +047500 PERFORM PRINT-DETAIL. RL1174.2 +047600 ADD 01 TO REC-CT. RL1174.2 +047700* .01 RL1174.2 +047800 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL1174.2 +047900 MOVE "INCORRECT COUNT" TO RE-MARK RL1174.2 +048000 MOVE 500 TO CORRECT-18V0 RL1174.2 +048100 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL1174.2 +048200 PERFORM FAIL RL1174.2 +048300 ELSE RL1174.2 +048400 PERFORM PASS. RL1174.2 +048500 PERFORM PRINT-DETAIL. RL1174.2 +048600 ADD 01 TO REC-CT. RL1174.2 +048700* .02 RL1174.2 +048800 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL1174.2 +048900 MOVE "STATUS/OPEN" TO RE-MARK RL1174.2 +049000 MOVE WRK-XN-0002-001 TO COMPUTED-A RL1174.2 +049100 MOVE "00" TO CORRECT-A RL1174.2 +049200 PERFORM FAIL RL1174.2 +049300 ELSE RL1174.2 +049400 PERFORM PASS. RL1174.2 +049500 PERFORM PRINT-DETAIL. RL1174.2 +049600 ADD 01 TO REC-CT. RL1174.2 +049700* .03 RL1174.2 +049800 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1174.2 +049900 MOVE "STATUS/WRITE" TO RE-MARK RL1174.2 +050000 MOVE RL-FD2-STATUS TO COMPUTED-A RL1174.2 +050100 MOVE "00" TO CORRECT-A RL1174.2 +050200 PERFORM FAIL RL1174.2 +050300 ELSE RL1174.2 +050400 PERFORM PASS. RL1174.2 +050500 PERFORM PRINT-DETAIL. RL1174.2 +050600 ADD 01 TO REC-CT. RL1174.2 +050700* .04 RL1174.2 +050800 MOVE SPACE TO RL-FD2-STATUS. RL1174.2 +050900 CLOSE RL-FD2. RL1174.2 +051000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL1174.2 +051100 MOVE "CLOSE/STATUS" TO RE-MARK RL1174.2 +051200 MOVE RL-FD2-STATUS TO COMPUTED-A RL1174.2 +051300 MOVE "00" TO CORRECT-A RL1174.2 +051400 PERFORM FAIL RL1174.2 +051500 ELSE RL1174.2 +051600 PERFORM PASS. RL1174.2 +051700 PERFORM PRINT-DETAIL. RL1174.2 +051800* RL1174.2 +051900 REL-INIT-1. RL1174.2 +052000 MOVE "REL-TEST-1" TO PAR-NAME. RL1174.2 +052100 MOVE "VII-3 1.3.4 2A" TO ANSI-REFERENCE. RL1174.2 +052200 MOVE 0 TO REC-CT. RL1174.2 +052300 OPEN I-O RL-FD3. RL1174.2 +052400* DELETE THE NEXT LINE TO DELETE THE TEST RL1174.2 +052500* GO TO REL-INIT-1-BETA. RL1174.2 +052600 REL-INIT-1-ALPHA. RL1174.2 +052700 GO TO REL-DELETE-1. RL1174.2 +052800 REL-INIT-1-BETA. RL1174.2 +052900 MOVE SPACE TO RL-FD3-STATUS. RL1174.2 +053000 PERFORM REL-INIT-1-A 501 TIMES. RL1174.2 +053100 GO TO REL-TEST-1. RL1174.2 +053200 REL-INIT-1-A. RL1174.2 +053300 READ RL-FD3 AT END GO TO REL-TEST-1. RL1174.2 +053400 REL-DELETE-1. RL1174.2 +053500 PERFORM DE-LETE. RL1174.2 +053600 PERFORM PRINT-DETAIL. RL1174.2 +053700 GO TO REL-INIT-2. RL1174.2 +053800 REL-TEST-1. RL1174.2 +053900 IF RL-FD3-STATUS NOT EQUAL TO "10" RL1174.2 +054000 MOVE "AT END STATUS" TO RE-MARK RL1174.2 +054100 MOVE RL-FD3-STATUS TO COMPUTED-A RL1174.2 +054200 MOVE "10" TO CORRECT-A RL1174.2 +054300 PERFORM FAIL RL1174.2 +054400 PERFORM PRINT-DETAIL RL1174.2 +054500 ELSE RL1174.2 +054600 PERFORM PASS RL1174.2 +054700 PERFORM PRINT-DETAIL. RL1174.2 +054800* RL1174.2 +054900 REL-INIT-2. RL1174.2 +055000 MOVE "REL-TEST-2" TO PAR-NAME. RL1174.2 +055100 MOVE "VII-3 1.3.4 2D" TO ANSI-REFERENCE. RL1174.2 +055200 MOVE SPACE TO RL-FD3-STATUS. RL1174.2 +055300* DELETE THE NEXT LINE TO DELETE THE TEST RL1174.2 +055400* GO TO REL-INIT-2-BETA. RL1174.2 +055500 REL-INIT-2-ALPHA. RL1174.2 +055600 GO TO REL-DELETE-2. RL1174.2 +055700 REL-INIT-2-BETA. RL1174.2 +055800 READ RL-FD3 AT END GO TO REL-TEST-2. RL1174.2 +055900 GO TO REL-TEST-2. RL1174.2 +056000 REL-DELETE-2. RL1174.2 +056100 PERFORM DE-LETE. RL1174.2 +056200 PERFORM PRINT-DETAIL. RL1174.2 +056300 GO TO REL-INIT-3. RL1174.2 +056400 REL-TEST-2. RL1174.2 +056500 IF RL-FD3-STATUS NOT EQUAL TO "46" RL1174.2 +056600 MOVE "SEQUENTIAL READ FOLLOWING 'AT END' CONDITION"RL1174.2 +056700 TO RE-MARK RL1174.2 +056800 MOVE RL-FD3-STATUS TO COMPUTED-A RL1174.2 +056900 MOVE "46" TO CORRECT-A RL1174.2 +057000 PERFORM FAIL RL1174.2 +057100 PERFORM PRINT-DETAIL RL1174.2 +057200 ELSE RL1174.2 +057300 PERFORM PASS RL1174.2 +057400 PERFORM PRINT-DETAIL. RL1174.2 +057500* RL1174.2 +057600 REL-INIT-3. RL1174.2 +057700 MOVE "REL-TEST-3" TO PAR-NAME. RL1174.2 +057800 MOVE "VII-3 1.3.4 2B" TO ANSI-REFERENCE. RL1174.2 +057900 CLOSE RL-FD3. RL1174.2 +058000 OPEN INPUT RL-FD3. RL1174.2 +058100 PERFORM REL-INIT-3-A 100 TIMES. RL1174.2 +058200 GO TO REL-TEST-3. RL1174.2 +058300 REL-INIT-3-A. RL1174.2 +058400 READ RL-FD3 RECORD AT END GO TO REL-TEST-3. RL1174.2 +058500 REL-DELETE-3. RL1174.2 +058600 PERFORM DE-LETE. RL1174.2 +058700 PERFORM PRINT-DETAIL. RL1174.2 +058800 GO TO RL-TEST-3-EXIT. RL1174.2 +058900 REL-TEST-3. RL1174.2 +059000 IF RL-FD3-STATUS NOT EQUAL TO "14" RL1174.2 +059100 MOVE RL-FD3-STATUS TO COMPUTED-A RL1174.2 +059200 MOVE "14" TO CORRECT-A RL1174.2 +059300 PERFORM FAIL RL1174.2 +059400 PERFORM PRINT-DETAIL RL1174.2 +059500 ELSE RL1174.2 +059600 PERFORM PASS RL1174.2 +059700 PERFORM PRINT-DETAIL RL1174.2 +059800 CLOSE RL-FD3. RL1174.2 +059900 RL-TEST-3-EXIT. RL1174.2 +060000 EXIT. RL1174.2 +060100* RL1174.2 +060200 CCVS-EXIT SECTION. RL1174.2 +060300 CCVS-999999. RL1174.2 +060400 GO TO CLOSE-FILES. RL1174.2 diff --git a/tests/cobol85/RL/RL118A.CBL b/tests/cobol85/RL/RL118A.CBL new file mode 100644 index 00000000..01f0e9ae --- /dev/null +++ b/tests/cobol85/RL/RL118A.CBL @@ -0,0 +1,554 @@ +000100 IDENTIFICATION DIVISION. RL1184.2 +000200 PROGRAM-ID. RL1184.2 +000300 RL118A. RL1184.2 +000400**************************************************************** RL1184.2 +000500* * RL1184.2 +000600* VALIDATION FOR:- * RL1184.2 +000700* * RL1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1184.2 +000900* * RL1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1184.2 +001100* * RL1184.2 +001200**************************************************************** RL1184.2 +001300* * RL1184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1184.2 +001500* * RL1184.2 +001600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1184.2 +001700* RELATIVE I-O DATA FILE * RL1184.2 +001800* X-55 SYSTEM PRINTER * RL1184.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1184.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1184.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1184.2 +002200* X-82 SOURCE-COMPUTER * RL1184.2 +002300* X-83 OBJECT-COMPUTER. * RL1184.2 +002400* * RL1184.2 +002500**************************************************************** RL1184.2 +002600* RL118A * RL1184.2 +002700**************************************************************** RL1184.2 +002800* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND * RL1184.2 +002900* SEMANTIC ACTIONS ASSOCIATED WITH THE "STATUS" * RL1184.2 +003000* CLAUSE FOR THE VALUES "22", "23" AND "24". * RL1184.2 +003100**************************************************************** RL1184.2 +003200 ENVIRONMENT DIVISION. RL1184.2 +003300 CONFIGURATION SECTION. RL1184.2 +003400 SOURCE-COMPUTER. RL1184.2 +003500 Linux. RL1184.2 +003600 OBJECT-COMPUTER. RL1184.2 +003700 Linux. RL1184.2 +003800 INPUT-OUTPUT SECTION. RL1184.2 +003900 FILE-CONTROL. RL1184.2 +004000 SELECT PRINT-FILE ASSIGN TO RL1184.2 +004100 "report.log". RL1184.2 +004200 SELECT RL-FD2 ASSIGN RL1184.2 +004300 "XXXXX022" RL1184.2 +004400 ORGANIZATION RELATIVE RL1184.2 +004500 ACCESS RANDOM RL1184.2 +004600 RELATIVE RL-FD2-KEY RL1184.2 +004700 FILE STATUS IS RL-FD2-STATUS. RL1184.2 +004800 SELECT RL-FD3 ASSIGN RL1184.2 +004900 "XXXXX022" RL1184.2 +005000 ORGANIZATION RELATIVE RL1184.2 +005100 ACCESS RANDOM RL1184.2 +005200 RELATIVE RL-FD3-KEY RL1184.2 +005300 FILE STATUS IS RL-FD3-STATUS. RL1184.2 +005400 DATA DIVISION. RL1184.2 +005500 FILE SECTION. RL1184.2 +005600 FD PRINT-FILE. RL1184.2 +005700 01 PRINT-REC PICTURE X(120). RL1184.2 +005800 01 DUMMY-RECORD PICTURE X(120). RL1184.2 +005900 FD RL-FD2 RL1184.2 +006000*C VALUE OF RL1184.2 +006100*C OCLABELID RL1184.2 +006200*C IS RL1184.2 +006300*C "OCDUMMY" RL1184.2 +006400*G SYSIN RL1184.2 +006500 LABEL RECORDS ARE STANDARD RL1184.2 +006600 BLOCK CONTAINS 1 RECORDS RL1184.2 +006700 DATA RECORD RL-FD2R1-F-G-240. RL1184.2 +006800 01 RL-FD2R1-F-G-240. RL1184.2 +006900 05 RL-FD2-WRK-120 PIC X(120). RL1184.2 +007000 05 RL-FD2-GRP-120. RL1184.2 +007100 10 RL-FD2-WRK-XN-0001-O120F RL1184.2 +007200 PICTURE X OCCURS 120 TIMES. RL1184.2 +007300 FD RL-FD3 RL1184.2 +007400*C VALUE OF RL1184.2 +007500*C OCLABELID RL1184.2 +007600*C IS RL1184.2 +007700*C "OCDUMMY" RL1184.2 +007800*G SYSIN RL1184.2 +007900 LABEL RECORDS ARE STANDARD RL1184.2 +008000 BLOCK CONTAINS 1 RECORDS RL1184.2 +008100 DATA RECORD RL-FD3R1-F-G-240. RL1184.2 +008200 01 RL-FD3R1-F-G-240. RL1184.2 +008300 05 RL-FD3-WRK-120 PIC X(120). RL1184.2 +008400 05 RL-FD3-GRP-120. RL1184.2 +008500 10 RL-FD3-WRK-XN-0001-O120F RL1184.2 +008600 PICTURE X OCCURS 120 TIMES. RL1184.2 +008700 WORKING-STORAGE SECTION. RL1184.2 +008800 01 GRP-0001. RL1184.2 +008900 05 RL-FD2-KEY PIC 99 VALUE ZERO. RL1184.2 +009000 05 RL-FD3-KEY PIC 999 VALUE ZERO. RL1184.2 +009100 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009200 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009300 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009400 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009500 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009600 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009700 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1184.2 +009800 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL1184.2 +009900 05 RL-FD3-STATUS PIC XX VALUE SPACE. RL1184.2 +010000 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1184.2 +010100 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1184.2 +010200 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1184.2 +010300 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1184.2 +010400 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1184.2 +010500 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1184.2 +010600 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1184.2 +010700 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1184.2 +010800 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1184.2 +010900 01 FILE-RECORD-INFORMATION-REC. RL1184.2 +011000 03 FILE-RECORD-INFO-SKELETON. RL1184.2 +011100 05 FILLER PICTURE X(48) VALUE RL1184.2 +011200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1184.2 +011300 05 FILLER PICTURE X(46) VALUE RL1184.2 +011400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1184.2 +011500 05 FILLER PICTURE X(26) VALUE RL1184.2 +011600 ",LFIL=000000,ORG= ,LBLR= ". RL1184.2 +011700 05 FILLER PICTURE X(37) VALUE RL1184.2 +011800 ",RECKEY= ". RL1184.2 +011900 05 FILLER PICTURE X(38) VALUE RL1184.2 +012000 ",ALTKEY1= ". RL1184.2 +012100 05 FILLER PICTURE X(38) VALUE RL1184.2 +012200 ",ALTKEY2= ". RL1184.2 +012300 05 FILLER PICTURE X(7) VALUE SPACE.RL1184.2 +012400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1184.2 +012500 05 FILE-RECORD-INFO-P1-120. RL1184.2 +012600 07 FILLER PIC X(5). RL1184.2 +012700 07 XFILE-NAME PIC X(6). RL1184.2 +012800 07 FILLER PIC X(8). RL1184.2 +012900 07 XRECORD-NAME PIC X(6). RL1184.2 +013000 07 FILLER PIC X(1). RL1184.2 +013100 07 REELUNIT-NUMBER PIC 9(1). RL1184.2 +013200 07 FILLER PIC X(7). RL1184.2 +013300 07 XRECORD-NUMBER PIC 9(6). RL1184.2 +013400 07 FILLER PIC X(6). RL1184.2 +013500 07 UPDATE-NUMBER PIC 9(2). RL1184.2 +013600 07 FILLER PIC X(5). RL1184.2 +013700 07 ODO-NUMBER PIC 9(4). RL1184.2 +013800 07 FILLER PIC X(5). RL1184.2 +013900 07 XPROGRAM-NAME PIC X(5). RL1184.2 +014000 07 FILLER PIC X(7). RL1184.2 +014100 07 XRECORD-LENGTH PIC 9(6). RL1184.2 +014200 07 FILLER PIC X(7). RL1184.2 +014300 07 CHARS-OR-RECORDS PIC X(2). RL1184.2 +014400 07 FILLER PIC X(1). RL1184.2 +014500 07 XBLOCK-SIZE PIC 9(4). RL1184.2 +014600 07 FILLER PIC X(6). RL1184.2 +014700 07 RECORDS-IN-FILE PIC 9(6). RL1184.2 +014800 07 FILLER PIC X(5). RL1184.2 +014900 07 XFILE-ORGANIZATION PIC X(2). RL1184.2 +015000 07 FILLER PIC X(6). RL1184.2 +015100 07 XLABEL-TYPE PIC X(1). RL1184.2 +015200 05 FILE-RECORD-INFO-P121-240. RL1184.2 +015300 07 FILLER PIC X(8). RL1184.2 +015400 07 XRECORD-KEY PIC X(29). RL1184.2 +015500 07 FILLER PIC X(9). RL1184.2 +015600 07 ALTERNATE-KEY1 PIC X(29). RL1184.2 +015700 07 FILLER PIC X(9). RL1184.2 +015800 07 ALTERNATE-KEY2 PIC X(29). RL1184.2 +015900 07 FILLER PIC X(7). RL1184.2 +016000 01 TEST-RESULTS. RL1184.2 +016100 02 FILLER PIC X VALUE SPACE. RL1184.2 +016200 02 FEATURE PIC X(20) VALUE SPACE. RL1184.2 +016300 02 FILLER PIC X VALUE SPACE. RL1184.2 +016400 02 P-OR-F PIC X(5) VALUE SPACE. RL1184.2 +016500 02 FILLER PIC X VALUE SPACE. RL1184.2 +016600 02 PAR-NAME. RL1184.2 +016700 03 FILLER PIC X(19) VALUE SPACE. RL1184.2 +016800 03 PARDOT-X PIC X VALUE SPACE. RL1184.2 +016900 03 DOTVALUE PIC 99 VALUE ZERO. RL1184.2 +017000 02 FILLER PIC X(8) VALUE SPACE. RL1184.2 +017100 02 RE-MARK PIC X(61). RL1184.2 +017200 01 TEST-COMPUTED. RL1184.2 +017300 02 FILLER PIC X(30) VALUE SPACE. RL1184.2 +017400 02 FILLER PIC X(17) VALUE RL1184.2 +017500 " COMPUTED=". RL1184.2 +017600 02 COMPUTED-X. RL1184.2 +017700 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1184.2 +017800 03 COMPUTED-N REDEFINES COMPUTED-A RL1184.2 +017900 PIC -9(9).9(9). RL1184.2 +018000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1184.2 +018100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1184.2 +018200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1184.2 +018300 03 CM-18V0 REDEFINES COMPUTED-A. RL1184.2 +018400 04 COMPUTED-18V0 PIC -9(18). RL1184.2 +018500 04 FILLER PIC X. RL1184.2 +018600 03 FILLER PIC X(50) VALUE SPACE. RL1184.2 +018700 01 TEST-CORRECT. RL1184.2 +018800 02 FILLER PIC X(30) VALUE SPACE. RL1184.2 +018900 02 FILLER PIC X(17) VALUE " CORRECT =". RL1184.2 +019000 02 CORRECT-X. RL1184.2 +019100 03 CORRECT-A PIC X(20) VALUE SPACE. RL1184.2 +019200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1184.2 +019300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1184.2 +019400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1184.2 +019500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1184.2 +019600 03 CR-18V0 REDEFINES CORRECT-A. RL1184.2 +019700 04 CORRECT-18V0 PIC -9(18). RL1184.2 +019800 04 FILLER PIC X. RL1184.2 +019900 03 FILLER PIC X(2) VALUE SPACE. RL1184.2 +020000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1184.2 +020100 01 CCVS-C-1. RL1184.2 +020200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1184.2 +020300- "SS PARAGRAPH-NAME RL1184.2 +020400- " REMARKS". RL1184.2 +020500 02 FILLER PIC X(20) VALUE SPACE. RL1184.2 +020600 01 CCVS-C-2. RL1184.2 +020700 02 FILLER PIC X VALUE SPACE. RL1184.2 +020800 02 FILLER PIC X(6) VALUE "TESTED". RL1184.2 +020900 02 FILLER PIC X(15) VALUE SPACE. RL1184.2 +021000 02 FILLER PIC X(4) VALUE "FAIL". RL1184.2 +021100 02 FILLER PIC X(94) VALUE SPACE. RL1184.2 +021200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1184.2 +021300 01 REC-CT PIC 99 VALUE ZERO. RL1184.2 +021400 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1184.2 +021500 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1184.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1184.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1184.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1184.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1184.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1184.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1184.2 +022200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1184.2 +022300 01 CCVS-H-1. RL1184.2 +022400 02 FILLER PIC X(39) VALUE SPACES. RL1184.2 +022500 02 FILLER PIC X(42) VALUE RL1184.2 +022600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1184.2 +022700 02 FILLER PIC X(39) VALUE SPACES. RL1184.2 +022800 01 CCVS-H-2A. RL1184.2 +022900 02 FILLER PIC X(40) VALUE SPACE. RL1184.2 +023000 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1184.2 +023100 02 FILLER PIC XXXX VALUE RL1184.2 +023200 "4.2 ". RL1184.2 +023300 02 FILLER PIC X(28) VALUE RL1184.2 +023400 " COPY - NOT FOR DISTRIBUTION". RL1184.2 +023500 02 FILLER PIC X(41) VALUE SPACE. RL1184.2 +023600 RL1184.2 +023700 01 CCVS-H-2B. RL1184.2 +023800 02 FILLER PIC X(15) VALUE RL1184.2 +023900 "TEST RESULT OF ". RL1184.2 +024000 02 TEST-ID PIC X(9). RL1184.2 +024100 02 FILLER PIC X(4) VALUE RL1184.2 +024200 " IN ". RL1184.2 +024300 02 FILLER PIC X(12) VALUE RL1184.2 +024400 " HIGH ". RL1184.2 +024500 02 FILLER PIC X(22) VALUE RL1184.2 +024600 " LEVEL VALIDATION FOR ". RL1184.2 +024700 02 FILLER PIC X(58) VALUE RL1184.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1184.2 +024900 01 CCVS-H-3. RL1184.2 +025000 02 FILLER PIC X(34) VALUE RL1184.2 +025100 " FOR OFFICIAL USE ONLY ". RL1184.2 +025200 02 FILLER PIC X(58) VALUE RL1184.2 +025300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1184.2 +025400 02 FILLER PIC X(28) VALUE RL1184.2 +025500 " COPYRIGHT 1985 ". RL1184.2 +025600 01 CCVS-E-1. RL1184.2 +025700 02 FILLER PIC X(52) VALUE SPACE. RL1184.2 +025800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1184.2 +025900 02 ID-AGAIN PIC X(9). RL1184.2 +026000 02 FILLER PIC X(45) VALUE SPACES. RL1184.2 +026100 01 CCVS-E-2. RL1184.2 +026200 02 FILLER PIC X(31) VALUE SPACE. RL1184.2 +026300 02 FILLER PIC X(21) VALUE SPACE. RL1184.2 +026400 02 CCVS-E-2-2. RL1184.2 +026500 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1184.2 +026600 03 FILLER PIC X VALUE SPACE. RL1184.2 +026700 03 ENDER-DESC PIC X(44) VALUE RL1184.2 +026800 "ERRORS ENCOUNTERED". RL1184.2 +026900 01 CCVS-E-3. RL1184.2 +027000 02 FILLER PIC X(22) VALUE RL1184.2 +027100 " FOR OFFICIAL USE ONLY". RL1184.2 +027200 02 FILLER PIC X(12) VALUE SPACE. RL1184.2 +027300 02 FILLER PIC X(58) VALUE RL1184.2 +027400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1184.2 +027500 02 FILLER PIC X(13) VALUE SPACE. RL1184.2 +027600 02 FILLER PIC X(15) VALUE RL1184.2 +027700 " COPYRIGHT 1985". RL1184.2 +027800 01 CCVS-E-4. RL1184.2 +027900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1184.2 +028000 02 FILLER PIC X(4) VALUE " OF ". RL1184.2 +028100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1184.2 +028200 02 FILLER PIC X(40) VALUE RL1184.2 +028300 " TESTS WERE EXECUTED SUCCESSFULLY". RL1184.2 +028400 01 XXINFO. RL1184.2 +028500 02 FILLER PIC X(19) VALUE RL1184.2 +028600 "*** INFORMATION ***". RL1184.2 +028700 02 INFO-TEXT. RL1184.2 +028800 04 FILLER PIC X(8) VALUE SPACE. RL1184.2 +028900 04 XXCOMPUTED PIC X(20). RL1184.2 +029000 04 FILLER PIC X(5) VALUE SPACE. RL1184.2 +029100 04 XXCORRECT PIC X(20). RL1184.2 +029200 02 INF-ANSI-REFERENCE PIC X(48). RL1184.2 +029300 01 HYPHEN-LINE. RL1184.2 +029400 02 FILLER PIC IS X VALUE IS SPACE. RL1184.2 +029500 02 FILLER PIC IS X(65) VALUE IS "************************RL1184.2 +029600- "*****************************************". RL1184.2 +029700 02 FILLER PIC IS X(54) VALUE IS "************************RL1184.2 +029800- "******************************". RL1184.2 +029900 01 CCVS-PGM-ID PIC X(9) VALUE RL1184.2 +030000 "RL118A". RL1184.2 +030100 PROCEDURE DIVISION. RL1184.2 +030200 CCVS1 SECTION. RL1184.2 +030300 OPEN-FILES. RL1184.2 +030400 OPEN OUTPUT PRINT-FILE. RL1184.2 +030500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1184.2 +030600 MOVE SPACE TO TEST-RESULTS. RL1184.2 +030700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1184.2 +030800 MOVE ZERO TO REC-SKL-SUB. RL1184.2 +030900 PERFORM CCVS-INIT-FILE 9 TIMES. RL1184.2 +031000 CCVS-INIT-FILE. RL1184.2 +031100 ADD 1 TO REC-SKL-SUB. RL1184.2 +031200 MOVE FILE-RECORD-INFO-SKELETON RL1184.2 +031300 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1184.2 +031400 CCVS-INIT-EXIT. RL1184.2 +031500 GO TO CCVS1-EXIT. RL1184.2 +031600 CLOSE-FILES. RL1184.2 +031700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1184.2 +031800 TERMINATE-CCVS. RL1184.2 +031900*S EXIT PROGRAM. RL1184.2 +032000*SERMINATE-CALL. RL1184.2 +032100 STOP RUN. RL1184.2 +032200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1184.2 +032300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1184.2 +032400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1184.2 +032500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1184.2 +032600 MOVE "****TEST DELETED****" TO RE-MARK. RL1184.2 +032700 PRINT-DETAIL. RL1184.2 +032800 IF REC-CT NOT EQUAL TO ZERO RL1184.2 +032900 MOVE "." TO PARDOT-X RL1184.2 +033000 MOVE REC-CT TO DOTVALUE. RL1184.2 +033100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1184.2 +033200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1184.2 +033300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1184.2 +033400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1184.2 +033500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1184.2 +033600 MOVE SPACE TO CORRECT-X. RL1184.2 +033700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1184.2 +033800 MOVE SPACE TO RE-MARK. RL1184.2 +033900 HEAD-ROUTINE. RL1184.2 +034000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +034100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +034200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1184.2 +034300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1184.2 +034400 COLUMN-NAMES-ROUTINE. RL1184.2 +034500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +034600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +034800 END-ROUTINE. RL1184.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1184.2 +035000 END-RTN-EXIT. RL1184.2 +035100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +035200 END-ROUTINE-1. RL1184.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1184.2 +035400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1184.2 +035500 ADD PASS-COUNTER TO ERROR-HOLD. RL1184.2 +035600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1184.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1184.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1184.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1184.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1184.2 +036100 END-ROUTINE-12. RL1184.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1184.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO RL1184.2 +036400 MOVE "NO " TO ERROR-TOTAL RL1184.2 +036500 ELSE RL1184.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1184.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1184.2 +036800 PERFORM WRITE-LINE. RL1184.2 +036900 END-ROUTINE-13. RL1184.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO RL1184.2 +037100 MOVE "NO " TO ERROR-TOTAL ELSE RL1184.2 +037200 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1184.2 +037300 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1184.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +037500 IF INSPECT-COUNTER EQUAL TO ZERO RL1184.2 +037600 MOVE "NO " TO ERROR-TOTAL RL1184.2 +037700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1184.2 +037800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1184.2 +037900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +038000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1184.2 +038100 WRITE-LINE. RL1184.2 +038200 ADD 1 TO RECORD-COUNT. RL1184.2 +038300 IF RECORD-COUNT GREATER 50 RL1184.2 +038400 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1184.2 +038500 MOVE SPACE TO DUMMY-RECORD RL1184.2 +038600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1184.2 +038700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1184.2 +038800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1184.2 +038900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1184.2 +039000 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1184.2 +039100 MOVE ZERO TO RECORD-COUNT. RL1184.2 +039200 PERFORM WRT-LN. RL1184.2 +039300 WRT-LN. RL1184.2 +039400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1184.2 +039500 MOVE SPACE TO DUMMY-RECORD. RL1184.2 +039600 BLANK-LINE-PRINT. RL1184.2 +039700 PERFORM WRT-LN. RL1184.2 +039800 FAIL-ROUTINE. RL1184.2 +039900 IF COMPUTED-X NOT EQUAL TO SPACE RL1184.2 +040000 GO TO FAIL-ROUTINE-WRITE. RL1184.2 +040100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1184.2 +040200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1184.2 +040300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1184.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +040500 MOVE SPACES TO INF-ANSI-REFERENCE. RL1184.2 +040600 GO TO FAIL-ROUTINE-EX. RL1184.2 +040700 FAIL-ROUTINE-WRITE. RL1184.2 +040800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1184.2 +040900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1184.2 +041000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1184.2 +041100 MOVE SPACES TO COR-ANSI-REFERENCE. RL1184.2 +041200 FAIL-ROUTINE-EX. EXIT. RL1184.2 +041300 BAIL-OUT. RL1184.2 +041400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1184.2 +041500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1184.2 +041600 BAIL-OUT-WRITE. RL1184.2 +041700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1184.2 +041800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1184.2 +041900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1184.2 +042000 MOVE SPACES TO INF-ANSI-REFERENCE. RL1184.2 +042100 BAIL-OUT-EX. EXIT. RL1184.2 +042200 CCVS1-EXIT. RL1184.2 +042300 EXIT. RL1184.2 +042400 SECT-RL118A-001 SECTION. RL1184.2 +042500 REL-INIT-009. RL1184.2 +042600 MOVE "REL-TEST-009" TO PAR-NAME. RL1184.2 +042700 MOVE "CREATE RL-FD2" TO FEATURE RL1184.2 +042800 MOVE "RL-FD2" TO XFILE-NAME (2). RL1184.2 +042900 MOVE "R1-F-G" TO XRECORD-NAME (2). RL1184.2 +043000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL1184.2 +043100 MOVE 000240 TO XRECORD-LENGTH (2). RL1184.2 +043200 MOVE "RC" TO CHARS-OR-RECORDS (2). RL1184.2 +043300 MOVE 0001 TO XBLOCK-SIZE (2). RL1184.2 +043400 MOVE 000500 TO RECORDS-IN-FILE (2). RL1184.2 +043500 MOVE "RL" TO XFILE-ORGANIZATION (2). RL1184.2 +043600 MOVE "S" TO XLABEL-TYPE (2). RL1184.2 +043700 MOVE 000001 TO XRECORD-NUMBER (2). RL1184.2 +043800*INITIALIZE RECORD WORK AREA NUMBER 2. RL1184.2 +043900 MOVE 1 TO WRK-CS-09V00-012. RL1184.2 +044000 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL1184.2 +044100 WRK-CS-09V00-015 WRK-CS-09V00-016 RL1184.2 +044200 WRK-CS-09V00-017 WRK-CS-09V00-018. RL1184.2 +044300* RL1184.2 +044400 REL-INIT-1. RL1184.2 +044500 MOVE "REL-TEST-1" TO PAR-NAME. RL1184.2 +044600 MOVE "VII-3 1.3.4 3C" TO ANSI-REFERENCE. RL1184.2 +044700 MOVE 0 TO XRECORD-NUMBER (2). RL1184.2 +044800 OPEN OUTPUT RL-FD2. RL1184.2 +044900 MOVE SPACE TO RL-FD2-STATUS. RL1184.2 +045000 PERFORM REL-INIT-1-A 100 TIMES. RL1184.2 +045100 GO TO REL-DELETE-1. RL1184.2 +045200 REL-INIT-1-A. RL1184.2 +045300 ADD 1 TO XRECORD-NUMBER (2). RL1184.2 +045400 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL1184.2 +045500 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1184.2 +045600 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-GRP-120. RL1184.2 +045700 WRITE RL-FD2R1-F-G-240 RL1184.2 +045800 INVALID GO TO REL-DELETE-1. RL1184.2 +045900 REL-DELETE-1. RL1184.2 +046000 PERFORM DE-LETE. RL1184.2 +046100 PERFORM PRINT-DETAIL. RL1184.2 +046200 GO TO REL-INIT-2. RL1184.2 +046300 REL-TEST-1. RL1184.2 +046400 IF RL-FD2-STATUS NOT EQUAL TO "24" RL1184.2 +046500 MOVE "100TH RECORD SHOULD NOT BE WRITTEN" RL1184.2 +046600 TO RE-MARK RL1184.2 +046700 MOVE RL-FD2-STATUS TO COMPUTED-A RL1184.2 +046800 MOVE "24" TO CORRECT-A RL1184.2 +046900 PERFORM FAIL RL1184.2 +047000 PERFORM PRINT-DETAIL RL1184.2 +047100 ELSE RL1184.2 +047200 PERFORM PASS RL1184.2 +047300 PERFORM PRINT-DETAIL. RL1184.2 +047400* RL1184.2 +047500 REL-INIT-2. RL1184.2 +047600 MOVE "REL-TEST-2" TO PAR-NAME. RL1184.2 +047700 MOVE "VII-3 1.3.4 3A" TO ANSI-REFERENCE. RL1184.2 +047800 MOVE SPACE TO RL-FD2-STATUS. RL1184.2 +047900 MOVE 27 TO RL-FD2-KEY. RL1184.2 +048000 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL1184.2 +048100 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-GRP-120. RL1184.2 +048200 WRITE RL-FD2R1-F-G-240 RL1184.2 +048300 INVALID GO TO REL-TEST-2. RL1184.2 +048400 GO TO REL-TEST-2. RL1184.2 +048500 REL-DELETE-2. RL1184.2 +048600 PERFORM DE-LETE. RL1184.2 +048700 PERFORM PRINT-DETAIL. RL1184.2 +048800 GO TO REL-INIT-3. RL1184.2 +048900 REL-TEST-2. RL1184.2 +049000 IF RL-FD2-STATUS NOT EQUAL TO "22" RL1184.2 +049100 MOVE "DUPLICATE KEY SHOULD HAVE OCCURRED" RL1184.2 +049200 TO RE-MARK RL1184.2 +049300 MOVE RL-FD2-STATUS TO COMPUTED-A RL1184.2 +049400 MOVE "22" TO CORRECT-A RL1184.2 +049500 PERFORM FAIL RL1184.2 +049600 PERFORM PRINT-DETAIL RL1184.2 +049700 ELSE RL1184.2 +049800 PERFORM PASS RL1184.2 +049900 PERFORM PRINT-DETAIL. RL1184.2 +050000* RL1184.2 +050100* RL1184.2 +050200 REL-INIT-3. RL1184.2 +050300 MOVE "REL-TEST-3" TO PAR-NAME. RL1184.2 +050400 MOVE "VII-3 1.3.4 3B" TO ANSI-REFERENCE. RL1184.2 +050500 CLOSE RL-FD2. RL1184.2 +050600 OPEN I-O RL-FD3. RL1184.2 +050700 MOVE 999 TO RL-FD3-KEY. RL1184.2 +050800 READ RL-FD3 INVALID GO TO REL-TEST-3. RL1184.2 +050900 GO TO REL-TEST-3. RL1184.2 +051000 REL-DELETE-3. RL1184.2 +051100 PERFORM DE-LETE. RL1184.2 +051200 PERFORM PRINT-DETAIL. RL1184.2 +051300 GO TO REL-DELETE-4. RL1184.2 +051400 REL-TEST-3. RL1184.2 +051500 IF RL-FD3-STATUS NOT EQUAL TO "23" RL1184.2 +051600 MOVE "RECORD READ SHOULD NOT EXIST" TO RE-MARK RL1184.2 +051700 MOVE RL-FD3-STATUS TO COMPUTED-A RL1184.2 +051800 MOVE "23" TO CORRECT-A RL1184.2 +051900 PERFORM FAIL RL1184.2 +052000 PERFORM PRINT-DETAIL RL1184.2 +052100 ELSE RL1184.2 +052200 PERFORM PASS RL1184.2 +052300 PERFORM PRINT-DETAIL. RL1184.2 +052400* RL1184.2 +052500 REL-INIT-4. RL1184.2 +052600 MOVE "REL-TEST-4" TO PAR-NAME. RL1184.2 +052700 MOVE "VII-3 1.3.4 3C" TO ANSI-REFERENCE. RL1184.2 +052800 MOVE SPACE TO RL-FD2-STATUS. RL1184.2 +052900 MOVE 100 TO RL-FD3-KEY. RL1184.2 +053000 GO TO REL-DELETE-4. RL1184.2 +053100* WRITE RL-FD3R1-F-G-240 RL1184.2 +053200* INVALID GO TO REL-DELETE-4. RL1184.2 +053300* GO TO REL-TEST-4. RL1184.2 +053400 REL-DELETE-4. RL1184.2 +053500 PERFORM DE-LETE. RL1184.2 +053600 PERFORM PRINT-DETAIL. RL1184.2 +053700 GO TO REL-TEST-4-EXIT. RL1184.2 +053800 REL-TEST-4. RL1184.2 +053900 IF RL-FD3-STATUS NOT EQUAL TO "24" RL1184.2 +054000 MOVE "BOUNDARY VIOLATION SHOULD HAVE OCCURRED" RL1184.2 +054100 TO RE-MARK RL1184.2 +054200 MOVE RL-FD3-STATUS TO COMPUTED-A RL1184.2 +054300 MOVE "24" TO CORRECT-A RL1184.2 +054400 PERFORM FAIL RL1184.2 +054500 PERFORM PRINT-DETAIL RL1184.2 +054600 ELSE RL1184.2 +054700 PERFORM PASS RL1184.2 +054800 PERFORM PRINT-DETAIL. RL1184.2 +054900 REL-TEST-4-EXIT. RL1184.2 +055000 CLOSE RL-FD3. RL1184.2 +055100* RL1184.2 +055200 CCVS-EXIT SECTION. RL1184.2 +055300 CCVS-999999. RL1184.2 +055400 GO TO CLOSE-FILES. RL1184.2 diff --git a/tests/cobol85/RL/RL119A.CBL b/tests/cobol85/RL/RL119A.CBL new file mode 100644 index 00000000..bfa22392 --- /dev/null +++ b/tests/cobol85/RL/RL119A.CBL @@ -0,0 +1,545 @@ +000100 IDENTIFICATION DIVISION. RL1194.2 +000200 PROGRAM-ID. RL1194.2 +000300 RL119A. RL1194.2 +000400**************************************************************** RL1194.2 +000500* * RL1194.2 +000600* VALIDATION FOR:- * RL1194.2 +000700* * RL1194.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1194.2 +000900* * RL1194.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1194.2 +001100* * RL1194.2 +001200**************************************************************** RL1194.2 +001300* * RL1194.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * RL1194.2 +001500* * RL1194.2 +001600* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1194.2 +001700* RELATIVE I-O DATA FILE * RL1194.2 +001800* X-55 SYSTEM PRINTER * RL1194.2 +001900* X-69 ADDITIONAL VALUE OF CLAUSES * RL1194.2 +002000* X-74 VALUE OF IMPLEMENTOR-NAME * RL1194.2 +002100* X-75 OBJECT OF VALUE OF CLAUSE * RL1194.2 +002200* X-82 SOURCE-COMPUTER * RL1194.2 +002300* X-83 OBJECT-COMPUTER. * RL1194.2 +002400* X-92 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL1194.2 +002500* RELATIVE I-O DATA FILE * RL1194.2 +002600* * RL1194.2 +002700**************************************************************** RL1194.2 +002800* RL119A * RL1194.2 +002900**************************************************************** RL1194.2 +003000* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND * RL1194.2 +003100* SEMANTIC ACTIONS ASSOCIATED WITH THE "STATUS" * RL1194.2 +003200* CLAUSE FOR THE VALUES "35". * RL1194.2 +003300* * RL1194.2 +003400* THE CODE FOR THE VALUE "39" HAS BEEN ASTERISKED * RL1194.2 +003500* OUT AS NO SUITABLE METHOD OF TESTING THIS * RL1194.2 +003600* CONDITION IS AVAILABLE AT THE TIME OF WRITING. * RL1194.2 +003700**************************************************************** RL1194.2 +003800 ENVIRONMENT DIVISION. RL1194.2 +003900 CONFIGURATION SECTION. RL1194.2 +004000 SOURCE-COMPUTER. RL1194.2 +004100 Linux. RL1194.2 +004200 OBJECT-COMPUTER. RL1194.2 +004300 Linux. RL1194.2 +004400 INPUT-OUTPUT SECTION. RL1194.2 +004500 FILE-CONTROL. RL1194.2 +004600 SELECT PRINT-FILE ASSIGN TO RL1194.2 +004700 "report.log". RL1194.2 +004800 SELECT RL-FD3 ASSIGN RL1194.2 +004900 "XXXXX092" RL1194.2 +005000 ORGANIZATION RELATIVE RL1194.2 +005100 ACCESS RANDOM RL1194.2 +005200 RELATIVE RL-FD3-KEY RL1194.2 +005300 FILE STATUS IS RL-FD3-STATUS. RL1194.2 +005400 DATA DIVISION. RL1194.2 +005500 FILE SECTION. RL1194.2 +005600 FD PRINT-FILE. RL1194.2 +005700 01 PRINT-REC PICTURE X(120). RL1194.2 +005800 01 DUMMY-RECORD PICTURE X(120). RL1194.2 +005900 FD RL-FD3 RL1194.2 +006000*C VALUE OF RL1194.2 +006100*C OCLABELID RL1194.2 +006200*C IS RL1194.2 +006300*C "OCDUMMY" RL1194.2 +006400*G SYSIN RL1194.2 +006500 LABEL RECORDS ARE STANDARD RL1194.2 +006600 BLOCK CONTAINS 1 RECORDS RL1194.2 +006700 DATA RECORD RL-FD3R1-F-G-240. RL1194.2 +006800 01 RL-FD3R1-F-G-240. RL1194.2 +006900 05 RL-FD3-WRK-120 PIC X(120). RL1194.2 +007000 05 RL-FD3-GRP-120. RL1194.2 +007100 10 RL-FD3-WRK-XN-0001-O120F RL1194.2 +007200 PICTURE X OCCURS 120 TIMES. RL1194.2 +007300 WORKING-STORAGE SECTION. RL1194.2 +007400 01 GRP-0001. RL1194.2 +007500 05 RL-FD3-KEY PIC 9(8) VALUE ZERO. RL1194.2 +007600 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +007700 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +007800 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +007900 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +008000 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +008100 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +008200 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL1194.2 +008300 05 RL-FD3-STATUS PIC XX VALUE SPACE. RL1194.2 +008400 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL1194.2 +008500 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL1194.2 +008600 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL1194.2 +008700 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL1194.2 +008800 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL1194.2 +008900 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL1194.2 +009000 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL1194.2 +009100 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL1194.2 +009200 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL1194.2 +009300 01 FILE-RECORD-INFORMATION-REC. RL1194.2 +009400 03 FILE-RECORD-INFO-SKELETON. RL1194.2 +009500 05 FILLER PICTURE X(48) VALUE RL1194.2 +009600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL1194.2 +009700 05 FILLER PICTURE X(46) VALUE RL1194.2 +009800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL1194.2 +009900 05 FILLER PICTURE X(26) VALUE RL1194.2 +010000 ",LFIL=000000,ORG= ,LBLR= ". RL1194.2 +010100 05 FILLER PICTURE X(37) VALUE RL1194.2 +010200 ",RECKEY= ". RL1194.2 +010300 05 FILLER PICTURE X(38) VALUE RL1194.2 +010400 ",ALTKEY1= ". RL1194.2 +010500 05 FILLER PICTURE X(38) VALUE RL1194.2 +010600 ",ALTKEY2= ". RL1194.2 +010700 05 FILLER PICTURE X(7) VALUE SPACE.RL1194.2 +010800 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL1194.2 +010900 05 FILE-RECORD-INFO-P1-120. RL1194.2 +011000 07 FILLER PIC X(5). RL1194.2 +011100 07 XFILE-NAME PIC X(6). RL1194.2 +011200 07 FILLER PIC X(8). RL1194.2 +011300 07 XRECORD-NAME PIC X(6). RL1194.2 +011400 07 FILLER PIC X(1). RL1194.2 +011500 07 REELUNIT-NUMBER PIC 9(1). RL1194.2 +011600 07 FILLER PIC X(7). RL1194.2 +011700 07 XRECORD-NUMBER PIC 9(6). RL1194.2 +011800 07 FILLER PIC X(6). RL1194.2 +011900 07 UPDATE-NUMBER PIC 9(2). RL1194.2 +012000 07 FILLER PIC X(5). RL1194.2 +012100 07 ODO-NUMBER PIC 9(4). RL1194.2 +012200 07 FILLER PIC X(5). RL1194.2 +012300 07 XPROGRAM-NAME PIC X(5). RL1194.2 +012400 07 FILLER PIC X(7). RL1194.2 +012500 07 XRECORD-LENGTH PIC 9(6). RL1194.2 +012600 07 FILLER PIC X(7). RL1194.2 +012700 07 CHARS-OR-RECORDS PIC X(2). RL1194.2 +012800 07 FILLER PIC X(1). RL1194.2 +012900 07 XBLOCK-SIZE PIC 9(4). RL1194.2 +013000 07 FILLER PIC X(6). RL1194.2 +013100 07 RECORDS-IN-FILE PIC 9(6). RL1194.2 +013200 07 FILLER PIC X(5). RL1194.2 +013300 07 XFILE-ORGANIZATION PIC X(2). RL1194.2 +013400 07 FILLER PIC X(6). RL1194.2 +013500 07 XLABEL-TYPE PIC X(1). RL1194.2 +013600 05 FILE-RECORD-INFO-P121-240. RL1194.2 +013700 07 FILLER PIC X(8). RL1194.2 +013800 07 XRECORD-KEY PIC X(29). RL1194.2 +013900 07 FILLER PIC X(9). RL1194.2 +014000 07 ALTERNATE-KEY1 PIC X(29). RL1194.2 +014100 07 FILLER PIC X(9). RL1194.2 +014200 07 ALTERNATE-KEY2 PIC X(29). RL1194.2 +014300 07 FILLER PIC X(7). RL1194.2 +014400 01 TEST-RESULTS. RL1194.2 +014500 02 FILLER PIC X VALUE SPACE. RL1194.2 +014600 02 FEATURE PIC X(20) VALUE SPACE. RL1194.2 +014700 02 FILLER PIC X VALUE SPACE. RL1194.2 +014800 02 P-OR-F PIC X(5) VALUE SPACE. RL1194.2 +014900 02 FILLER PIC X VALUE SPACE. RL1194.2 +015000 02 PAR-NAME. RL1194.2 +015100 03 FILLER PIC X(19) VALUE SPACE. RL1194.2 +015200 03 PARDOT-X PIC X VALUE SPACE. RL1194.2 +015300 03 DOTVALUE PIC 99 VALUE ZERO. RL1194.2 +015400 02 FILLER PIC X(8) VALUE SPACE. RL1194.2 +015500 02 RE-MARK PIC X(61). RL1194.2 +015600 01 TEST-COMPUTED. RL1194.2 +015700 02 FILLER PIC X(30) VALUE SPACE. RL1194.2 +015800 02 FILLER PIC X(17) VALUE RL1194.2 +015900 " COMPUTED=". RL1194.2 +016000 02 COMPUTED-X. RL1194.2 +016100 03 COMPUTED-A PIC X(20) VALUE SPACE. RL1194.2 +016200 03 COMPUTED-N REDEFINES COMPUTED-A RL1194.2 +016300 PIC -9(9).9(9). RL1194.2 +016400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL1194.2 +016500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL1194.2 +016600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL1194.2 +016700 03 CM-18V0 REDEFINES COMPUTED-A. RL1194.2 +016800 04 COMPUTED-18V0 PIC -9(18). RL1194.2 +016900 04 FILLER PIC X. RL1194.2 +017000 03 FILLER PIC X(50) VALUE SPACE. RL1194.2 +017100 01 TEST-CORRECT. RL1194.2 +017200 02 FILLER PIC X(30) VALUE SPACE. RL1194.2 +017300 02 FILLER PIC X(17) VALUE " CORRECT =". RL1194.2 +017400 02 CORRECT-X. RL1194.2 +017500 03 CORRECT-A PIC X(20) VALUE SPACE. RL1194.2 +017600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL1194.2 +017700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL1194.2 +017800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL1194.2 +017900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL1194.2 +018000 03 CR-18V0 REDEFINES CORRECT-A. RL1194.2 +018100 04 CORRECT-18V0 PIC -9(18). RL1194.2 +018200 04 FILLER PIC X. RL1194.2 +018300 03 FILLER PIC X(2) VALUE SPACE. RL1194.2 +018400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL1194.2 +018500 01 CCVS-C-1. RL1194.2 +018600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL1194.2 +018700- "SS PARAGRAPH-NAME RL1194.2 +018800- " REMARKS". RL1194.2 +018900 02 FILLER PIC X(20) VALUE SPACE. RL1194.2 +019000 01 CCVS-C-2. RL1194.2 +019100 02 FILLER PIC X VALUE SPACE. RL1194.2 +019200 02 FILLER PIC X(6) VALUE "TESTED". RL1194.2 +019300 02 FILLER PIC X(15) VALUE SPACE. RL1194.2 +019400 02 FILLER PIC X(4) VALUE "FAIL". RL1194.2 +019500 02 FILLER PIC X(94) VALUE SPACE. RL1194.2 +019600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL1194.2 +019700 01 REC-CT PIC 99 VALUE ZERO. RL1194.2 +019800 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL1194.2 +019900 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL1194.2 +020000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL1194.2 +020100 01 PASS-COUNTER PIC 999 VALUE ZERO. RL1194.2 +020200 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL1194.2 +020300 01 ERROR-HOLD PIC 999 VALUE ZERO. RL1194.2 +020400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL1194.2 +020500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL1194.2 +020600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL1194.2 +020700 01 CCVS-H-1. RL1194.2 +020800 02 FILLER PIC X(39) VALUE SPACES. RL1194.2 +020900 02 FILLER PIC X(42) VALUE RL1194.2 +021000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL1194.2 +021100 02 FILLER PIC X(39) VALUE SPACES. RL1194.2 +021200 01 CCVS-H-2A. RL1194.2 +021300 02 FILLER PIC X(40) VALUE SPACE. RL1194.2 +021400 02 FILLER PIC X(7) VALUE "CCVS85 ". RL1194.2 +021500 02 FILLER PIC XXXX VALUE RL1194.2 +021600 "4.2 ". RL1194.2 +021700 02 FILLER PIC X(28) VALUE RL1194.2 +021800 " COPY - NOT FOR DISTRIBUTION". RL1194.2 +021900 02 FILLER PIC X(41) VALUE SPACE. RL1194.2 +022000 RL1194.2 +022100 01 CCVS-H-2B. RL1194.2 +022200 02 FILLER PIC X(15) VALUE RL1194.2 +022300 "TEST RESULT OF ". RL1194.2 +022400 02 TEST-ID PIC X(9). RL1194.2 +022500 02 FILLER PIC X(4) VALUE RL1194.2 +022600 " IN ". RL1194.2 +022700 02 FILLER PIC X(12) VALUE RL1194.2 +022800 " HIGH ". RL1194.2 +022900 02 FILLER PIC X(22) VALUE RL1194.2 +023000 " LEVEL VALIDATION FOR ". RL1194.2 +023100 02 FILLER PIC X(58) VALUE RL1194.2 +023200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1194.2 +023300 01 CCVS-H-3. RL1194.2 +023400 02 FILLER PIC X(34) VALUE RL1194.2 +023500 " FOR OFFICIAL USE ONLY ". RL1194.2 +023600 02 FILLER PIC X(58) VALUE RL1194.2 +023700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL1194.2 +023800 02 FILLER PIC X(28) VALUE RL1194.2 +023900 " COPYRIGHT 1985 ". RL1194.2 +024000 01 CCVS-E-1. RL1194.2 +024100 02 FILLER PIC X(52) VALUE SPACE. RL1194.2 +024200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL1194.2 +024300 02 ID-AGAIN PIC X(9). RL1194.2 +024400 02 FILLER PIC X(45) VALUE SPACES. RL1194.2 +024500 01 CCVS-E-2. RL1194.2 +024600 02 FILLER PIC X(31) VALUE SPACE. RL1194.2 +024700 02 FILLER PIC X(21) VALUE SPACE. RL1194.2 +024800 02 CCVS-E-2-2. RL1194.2 +024900 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL1194.2 +025000 03 FILLER PIC X VALUE SPACE. RL1194.2 +025100 03 ENDER-DESC PIC X(44) VALUE RL1194.2 +025200 "ERRORS ENCOUNTERED". RL1194.2 +025300 01 CCVS-E-3. RL1194.2 +025400 02 FILLER PIC X(22) VALUE RL1194.2 +025500 " FOR OFFICIAL USE ONLY". RL1194.2 +025600 02 FILLER PIC X(12) VALUE SPACE. RL1194.2 +025700 02 FILLER PIC X(58) VALUE RL1194.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL1194.2 +025900 02 FILLER PIC X(13) VALUE SPACE. RL1194.2 +026000 02 FILLER PIC X(15) VALUE RL1194.2 +026100 " COPYRIGHT 1985". RL1194.2 +026200 01 CCVS-E-4. RL1194.2 +026300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL1194.2 +026400 02 FILLER PIC X(4) VALUE " OF ". RL1194.2 +026500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL1194.2 +026600 02 FILLER PIC X(40) VALUE RL1194.2 +026700 " TESTS WERE EXECUTED SUCCESSFULLY". RL1194.2 +026800 01 XXINFO. RL1194.2 +026900 02 FILLER PIC X(19) VALUE RL1194.2 +027000 "*** INFORMATION ***". RL1194.2 +027100 02 INFO-TEXT. RL1194.2 +027200 04 FILLER PIC X(8) VALUE SPACE. RL1194.2 +027300 04 XXCOMPUTED PIC X(20). RL1194.2 +027400 04 FILLER PIC X(5) VALUE SPACE. RL1194.2 +027500 04 XXCORRECT PIC X(20). RL1194.2 +027600 02 INF-ANSI-REFERENCE PIC X(48). RL1194.2 +027700 01 HYPHEN-LINE. RL1194.2 +027800 02 FILLER PIC IS X VALUE IS SPACE. RL1194.2 +027900 02 FILLER PIC IS X(65) VALUE IS "************************RL1194.2 +028000- "*****************************************". RL1194.2 +028100 02 FILLER PIC IS X(54) VALUE IS "************************RL1194.2 +028200- "******************************". RL1194.2 +028300 01 CCVS-PGM-ID PIC X(9) VALUE RL1194.2 +028400 "RL119A". RL1194.2 +028500 PROCEDURE DIVISION. RL1194.2 +028600 DECLARATIVES. RL1194.2 +028700 RL-FD3-01 SECTION. RL1194.2 +028800 USE AFTER ERROR PROCEDURE RL-FD3. RL1194.2 +028900 RL-FD3-01-01. RL1194.2 +029000 IF RL-FD3-STATUS EQUAL TO "35" RL1194.2 +029100 PERFORM D-PASS RL1194.2 +029200 ELSE RL1194.2 +029300 MOVE RL-FD3-STATUS TO COMPUTED-A RL1194.2 +029400 MOVE "35" TO CORRECT-A RL1194.2 +029500 PERFORM D-FAIL. RL1194.2 +029600 PERFORM D-PRINT-DETAIL. RL1194.2 +029700 GO TO D-CLOSE-FILES. RL1194.2 +029800 D-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1194.2 +029900 D-FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1194.2 +030000 D-CLOSE-FILES. RL1194.2 +030100 PERFORM D-END-ROUTINE THRU D-END-ROUTINE-13. RL1194.2 +030200 CLOSE PRINT-FILE. RL1194.2 +030300 STOP RUN. RL1194.2 +030400 D-PRINT-DETAIL. RL1194.2 +030500 IF REC-CT NOT EQUAL TO ZERO RL1194.2 +030600 MOVE "." TO PARDOT-X RL1194.2 +030700 MOVE REC-CT TO DOTVALUE. RL1194.2 +030800 MOVE TEST-RESULTS TO PRINT-REC. RL1194.2 +030900 PERFORM D-WRITE-LINE. RL1194.2 +031000 IF P-OR-F EQUAL TO "FAIL*" PERFORM D-WRITE-LINE RL1194.2 +031100 PERFORM D-FAIL-ROUTINE THRU D-FAIL-ROUTINE-EX RL1194.2 +031200 ELSE PERFORM D-BAIL-OUT THRU D-BAIL-OUT-EX. RL1194.2 +031300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1194.2 +031400 MOVE SPACE TO CORRECT-X. RL1194.2 +031500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1194.2 +031600 MOVE SPACE TO RE-MARK. RL1194.2 +031700 D-END-ROUTINE. RL1194.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. RL1194.2 +031900 PERFORM D-WRITE-LINE 5 TIMES. RL1194.2 +032000 D-END-RTN-EXIT. RL1194.2 +032100 MOVE CCVS-E-1 TO DUMMY-RECORD. RL1194.2 +032200 PERFORM D-WRITE-LINE 2 TIMES. RL1194.2 +032300 D-END-ROUTINE-1. RL1194.2 +032400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1194.2 +032500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1194.2 +032600 ADD PASS-COUNTER TO ERROR-HOLD. RL1194.2 +032700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO D-END-ROUTINE-12. RL1194.2 +032800 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1194.2 +032900 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1194.2 +033000 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1194.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM D-WRITE-LINE. RL1194.2 +033200 D-END-ROUTINE-12. RL1194.2 +033300 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1194.2 +033400 IF ERROR-COUNTER IS EQUAL TO ZERO RL1194.2 +033500 MOVE "NO " TO ERROR-TOTAL RL1194.2 +033600 ELSE RL1194.2 +033700 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1194.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1194.2 +033900 PERFORM D-WRITE-LINE. RL1194.2 +034000 D-END-ROUTINE-13. RL1194.2 +034100 IF DELETE-COUNTER IS EQUAL TO ZERO RL1194.2 +034200 MOVE "NO " TO ERROR-TOTAL ELSE RL1194.2 +034300 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1194.2 +034400 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1194.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1194.2 +034600 IF INSPECT-COUNTER EQUAL TO ZERO RL1194.2 +034700 MOVE "NO " TO ERROR-TOTAL RL1194.2 +034800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1194.2 +034900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1194.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1194.2 +035100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM D-WRITE-LINE. RL1194.2 +035200 D-WRITE-LINE. RL1194.2 +035300 ADD 1 TO RECORD-COUNT. RL1194.2 +035400 IF RECORD-COUNT GREATER 50 RL1194.2 +035500 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1194.2 +035600 MOVE SPACE TO DUMMY-RECORD RL1194.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1194.2 +035800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D-WRT-LN RL1194.2 +035900 MOVE CCVS-C-2 TO DUMMY-RECORD RL1194.2 +036000 PERFORM D-WRT-LN 2 TIMES RL1194.2 +036100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D-WRT-LN RL1194.2 +036200 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1194.2 +036300 MOVE ZERO TO RECORD-COUNT. RL1194.2 +036400 PERFORM D-WRT-LN. RL1194.2 +036500 D-WRT-LN. RL1194.2 +036600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1194.2 +036700 MOVE SPACE TO DUMMY-RECORD. RL1194.2 +036800 D-FAIL-ROUTINE. RL1194.2 +036900 IF COMPUTED-X NOT EQUAL TO SPACE RL1194.2 +037000 GO TO D-FAIL-ROUTINE-WRITE. RL1194.2 +037100 IF CORRECT-X NOT EQUAL TO SPACE RL1194.2 +037200 GO TO D-FAIL-ROUTINE-WRITE. RL1194.2 +037300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1194.2 +037400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1194.2 +037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. RL1194.2 +037600 MOVE SPACES TO INF-ANSI-REFERENCE. RL1194.2 +037700 GO TO D-FAIL-ROUTINE-EX. RL1194.2 +037800 D-FAIL-ROUTINE-WRITE. RL1194.2 +037900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D-WRITE-LINE RL1194.2 +038000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1194.2 +038100 MOVE TEST-CORRECT TO PRINT-REC RL1194.2 +038200 PERFORM D-WRITE-LINE 2 TIMES. RL1194.2 +038300 MOVE SPACES TO COR-ANSI-REFERENCE. RL1194.2 +038400 D-FAIL-ROUTINE-EX. EXIT. RL1194.2 +038500 D-BAIL-OUT. RL1194.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D-BAIL-OUT-WRITE. RL1194.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO D-BAIL-OUT-EX. RL1194.2 +038800 D-BAIL-OUT-WRITE. RL1194.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1194.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1194.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM D-WRITE-LINE 2 TIMES. RL1194.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. RL1194.2 +039300 D-BAIL-OUT-EX. EXIT. RL1194.2 +039400 END DECLARATIVES. RL1194.2 +039500 CCVS1 SECTION. RL1194.2 +039600 OPEN-FILES. RL1194.2 +039700 OPEN OUTPUT PRINT-FILE. RL1194.2 +039800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL1194.2 +039900 MOVE SPACE TO TEST-RESULTS. RL1194.2 +040000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL1194.2 +040100 MOVE ZERO TO REC-SKL-SUB. RL1194.2 +040200 PERFORM CCVS-INIT-FILE 9 TIMES. RL1194.2 +040300 CCVS-INIT-FILE. RL1194.2 +040400 ADD 1 TO REC-SKL-SUB. RL1194.2 +040500 MOVE FILE-RECORD-INFO-SKELETON RL1194.2 +040600 TO FILE-RECORD-INFO (REC-SKL-SUB). RL1194.2 +040700 CCVS-INIT-EXIT. RL1194.2 +040800 GO TO CCVS1-EXIT. RL1194.2 +040900 CLOSE-FILES. RL1194.2 +041000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL1194.2 +041100 TERMINATE-CCVS. RL1194.2 +041200*S EXIT PROGRAM. RL1194.2 +041300*SERMINATE-CALL. RL1194.2 +041400 STOP RUN. RL1194.2 +041500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL1194.2 +041600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL1194.2 +041700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL1194.2 +041800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL1194.2 +041900 MOVE "****TEST DELETED****" TO RE-MARK. RL1194.2 +042000 PRINT-DETAIL. RL1194.2 +042100 IF REC-CT NOT EQUAL TO ZERO RL1194.2 +042200 MOVE "." TO PARDOT-X RL1194.2 +042300 MOVE REC-CT TO DOTVALUE. RL1194.2 +042400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL1194.2 +042500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL1194.2 +042600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL1194.2 +042700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL1194.2 +042800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL1194.2 +042900 MOVE SPACE TO CORRECT-X. RL1194.2 +043000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL1194.2 +043100 MOVE SPACE TO RE-MARK. RL1194.2 +043200 HEAD-ROUTINE. RL1194.2 +043300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +043400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +043500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1194.2 +043600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL1194.2 +043700 COLUMN-NAMES-ROUTINE. RL1194.2 +043800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +043900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +044000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +044100 END-ROUTINE. RL1194.2 +044200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL1194.2 +044300 END-RTN-EXIT. RL1194.2 +044400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +044500 END-ROUTINE-1. RL1194.2 +044600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL1194.2 +044700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL1194.2 +044800 ADD PASS-COUNTER TO ERROR-HOLD. RL1194.2 +044900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL1194.2 +045000 MOVE PASS-COUNTER TO CCVS-E-4-1. RL1194.2 +045100 MOVE ERROR-HOLD TO CCVS-E-4-2. RL1194.2 +045200 MOVE CCVS-E-4 TO CCVS-E-2-2. RL1194.2 +045300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL1194.2 +045400 END-ROUTINE-12. RL1194.2 +045500 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL1194.2 +045600 IF ERROR-COUNTER IS EQUAL TO ZERO RL1194.2 +045700 MOVE "NO " TO ERROR-TOTAL RL1194.2 +045800 ELSE RL1194.2 +045900 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL1194.2 +046000 MOVE CCVS-E-2 TO DUMMY-RECORD. RL1194.2 +046100 PERFORM WRITE-LINE. RL1194.2 +046200 END-ROUTINE-13. RL1194.2 +046300 IF DELETE-COUNTER IS EQUAL TO ZERO RL1194.2 +046400 MOVE "NO " TO ERROR-TOTAL ELSE RL1194.2 +046500 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL1194.2 +046600 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL1194.2 +046700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +046800 IF INSPECT-COUNTER EQUAL TO ZERO RL1194.2 +046900 MOVE "NO " TO ERROR-TOTAL RL1194.2 +047000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL1194.2 +047100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL1194.2 +047200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +047300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL1194.2 +047400 WRITE-LINE. RL1194.2 +047500 ADD 1 TO RECORD-COUNT. RL1194.2 +047600 IF RECORD-COUNT GREATER 50 RL1194.2 +047700 MOVE DUMMY-RECORD TO DUMMY-HOLD RL1194.2 +047800 MOVE SPACE TO DUMMY-RECORD RL1194.2 +047900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL1194.2 +048000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL1194.2 +048100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL1194.2 +048200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL1194.2 +048300 MOVE DUMMY-HOLD TO DUMMY-RECORD RL1194.2 +048400 MOVE ZERO TO RECORD-COUNT. RL1194.2 +048500 PERFORM WRT-LN. RL1194.2 +048600 WRT-LN. RL1194.2 +048700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL1194.2 +048800 MOVE SPACE TO DUMMY-RECORD. RL1194.2 +048900 BLANK-LINE-PRINT. RL1194.2 +049000 PERFORM WRT-LN. RL1194.2 +049100 FAIL-ROUTINE. RL1194.2 +049200 IF COMPUTED-X NOT EQUAL TO SPACE RL1194.2 +049300 GO TO FAIL-ROUTINE-WRITE. RL1194.2 +049400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL1194.2 +049500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1194.2 +049600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL1194.2 +049700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +049800 MOVE SPACES TO INF-ANSI-REFERENCE. RL1194.2 +049900 GO TO FAIL-ROUTINE-EX. RL1194.2 +050000 FAIL-ROUTINE-WRITE. RL1194.2 +050100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL1194.2 +050200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL1194.2 +050300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL1194.2 +050400 MOVE SPACES TO COR-ANSI-REFERENCE. RL1194.2 +050500 FAIL-ROUTINE-EX. EXIT. RL1194.2 +050600 BAIL-OUT. RL1194.2 +050700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL1194.2 +050800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL1194.2 +050900 BAIL-OUT-WRITE. RL1194.2 +051000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL1194.2 +051100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL1194.2 +051200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL1194.2 +051300 MOVE SPACES TO INF-ANSI-REFERENCE. RL1194.2 +051400 BAIL-OUT-EX. EXIT. RL1194.2 +051500 CCVS1-EXIT. RL1194.2 +051600 EXIT. RL1194.2 +051700 SECT-RL119A-001 SECTION. RL1194.2 +051800* RL1194.2 +051900 REL-INIT-1. RL1194.2 +052000 MOVE "REL-TEST-1" TO PAR-NAME. RL1194.2 +052100 MOVE "VIII-4 1.3.4 4B" TO ANSI-REFERENCE. RL1194.2 +052200 MOVE SPACE TO RL-FD3-STATUS. RL1194.2 +052300 OPEN I-O RL-FD3. RL1194.2 +052400 GO TO REL-TEST-1. RL1194.2 +052500 REL-DELETE-1. RL1194.2 +052600 PERFORM DE-LETE. RL1194.2 +052700 PERFORM PRINT-DETAIL. RL1194.2 +052800 GO TO REL-TEST-1-EXIT. RL1194.2 +052900 REL-TEST-1. RL1194.2 +053000 IF RL-FD3-STATUS NOT EQUAL TO "35" RL1194.2 +053100 MOVE "NON-EXISTING FILE HAS BEEN OPENED" RL1194.2 +053200 TO RE-MARK RL1194.2 +053300 MOVE RL-FD3-STATUS TO COMPUTED-A RL1194.2 +053400 MOVE "35" TO CORRECT-A RL1194.2 +053500 PERFORM FAIL RL1194.2 +053600 PERFORM PRINT-DETAIL RL1194.2 +053700 ELSE RL1194.2 +053800 PERFORM PASS RL1194.2 +053900 PERFORM PRINT-DETAIL. RL1194.2 +054000 REL-TEST-1-EXIT. RL1194.2 +054100* EXIT. RL1194.2 +054200* RL1194.2 +054300 CCVS-EXIT SECTION. RL1194.2 +054400 CCVS-999999. RL1194.2 +054500 GO TO CLOSE-FILES. RL1194.2 diff --git a/tests/cobol85/RL/RL201A.CBL b/tests/cobol85/RL/RL201A.CBL new file mode 100644 index 00000000..662b66db --- /dev/null +++ b/tests/cobol85/RL/RL201A.CBL @@ -0,0 +1,444 @@ +000100 IDENTIFICATION DIVISION. RL2014.2 +000200 PROGRAM-ID. RL2014.2 +000300 RL201A. RL2014.2 +000400**************************************************************** RL2014.2 +000500* * RL2014.2 +000600* VALIDATION FOR:- * RL2014.2 +000700* * RL2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2014.2 +000900* * RL2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2014.2 +001100* * RL2014.2 +001200**************************************************************** RL2014.2 +001300*GENERAL: THIS RUN UNIT IS THE FIRST OF A SERIES WHICH RL2014.2 +001400* PROCESSES A RELATIVE I-O FILE. THE FUNCTION OF THIS RL2014.2 +001500* PROGRAM IS TO CREATE A RELATIVE FILE SEQUENTIALLY RL2014.2 +001600* (ACCESS MODE SEQUENTIAL) AND VERIFY THAT IT WAS RL2014.2 +001700* CREATED CORRECTLY. THE FILE IS IDENTIFED AS "RL-FS1"RL2014.2 +001800* AND IS PASSED TO SUBSEQUENT RUN UNITS FOR PROCESSING.RL2014.2 +001900* RL2014.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2014.2 +002100* PROGRAM ARE: RL2014.2 +002200* RL2014.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2014.2 +002400* RELATIVE I-O DATA FILE RL2014.2 +002500* X-55 SYSTEM PRINTER RL2014.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES RL2014.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME RL2014.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE RL2014.2 +002900* X-82 SOURCE-COMPUTER RL2014.2 +003000* X-83 OBJECT-COMPUTER. RL2014.2 +003100* RL2014.2 +003200**************************************************************** RL2014.2 +003300 ENVIRONMENT DIVISION. RL2014.2 +003400 CONFIGURATION SECTION. RL2014.2 +003500 SOURCE-COMPUTER. RL2014.2 +003600 Linux. RL2014.2 +003700 OBJECT-COMPUTER. RL2014.2 +003800 Linux. RL2014.2 +003900 INPUT-OUTPUT SECTION. RL2014.2 +004000 FILE-CONTROL. RL2014.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2014.2 +004200 "report.log". RL2014.2 +004300 SELECT RL-FS1 ASSIGN TO RL2014.2 +004400 "XXXXX021" RL2014.2 +004500 ORGANIZATION IS RELATIVE. RL2014.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2014.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2014.2 +004800 DATA DIVISION. RL2014.2 +004900 FILE SECTION. RL2014.2 +005000 FD PRINT-FILE. RL2014.2 +005100 01 PRINT-REC PICTURE X(120). RL2014.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2014.2 +005300 FD RL-FS1 RL2014.2 +005400 LABEL RECORDS STANDARD RL2014.2 +005500*C VALUE OF RL2014.2 +005600*C OCLABELID RL2014.2 +005700*C IS RL2014.2 +005800*C "OCDUMMY" RL2014.2 +005900*G SYSIN RL2014.2 +006000 BLOCK CONTAINS 1 RECORDS RL2014.2 +006100 RECORD CONTAINS 120 CHARACTERS. RL2014.2 +006200 01 RL-FS1R1-F-G-120. RL2014.2 +006300 02 FILLER PIC X(120). RL2014.2 +006400 WORKING-STORAGE SECTION. RL2014.2 +006500 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2014.2 +006600 01 FILE-RECORD-INFORMATION-REC. RL2014.2 +006700 03 FILE-RECORD-INFO-SKELETON. RL2014.2 +006800 05 FILLER PICTURE X(48) VALUE RL2014.2 +006900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2014.2 +007000 05 FILLER PICTURE X(46) VALUE RL2014.2 +007100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2014.2 +007200 05 FILLER PICTURE X(26) VALUE RL2014.2 +007300 ",LFIL=000000,ORG= ,LBLR= ". RL2014.2 +007400 05 FILLER PICTURE X(37) VALUE RL2014.2 +007500 ",RECKEY= ". RL2014.2 +007600 05 FILLER PICTURE X(38) VALUE RL2014.2 +007700 ",ALTKEY1= ". RL2014.2 +007800 05 FILLER PICTURE X(38) VALUE RL2014.2 +007900 ",ALTKEY2= ". RL2014.2 +008000 05 FILLER PICTURE X(7) VALUE SPACE.RL2014.2 +008100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2014.2 +008200 05 FILE-RECORD-INFO-P1-120. RL2014.2 +008300 07 FILLER PIC X(5). RL2014.2 +008400 07 XFILE-NAME PIC X(6). RL2014.2 +008500 07 FILLER PIC X(8). RL2014.2 +008600 07 XRECORD-NAME PIC X(6). RL2014.2 +008700 07 FILLER PIC X(1). RL2014.2 +008800 07 REELUNIT-NUMBER PIC 9(1). RL2014.2 +008900 07 FILLER PIC X(7). RL2014.2 +009000 07 XRECORD-NUMBER PIC 9(6). RL2014.2 +009100 07 FILLER PIC X(6). RL2014.2 +009200 07 UPDATE-NUMBER PIC 9(2). RL2014.2 +009300 07 FILLER PIC X(5). RL2014.2 +009400 07 ODO-NUMBER PIC 9(4). RL2014.2 +009500 07 FILLER PIC X(5). RL2014.2 +009600 07 XPROGRAM-NAME PIC X(5). RL2014.2 +009700 07 FILLER PIC X(7). RL2014.2 +009800 07 XRECORD-LENGTH PIC 9(6). RL2014.2 +009900 07 FILLER PIC X(7). RL2014.2 +010000 07 CHARS-OR-RECORDS PIC X(2). RL2014.2 +010100 07 FILLER PIC X(1). RL2014.2 +010200 07 XBLOCK-SIZE PIC 9(4). RL2014.2 +010300 07 FILLER PIC X(6). RL2014.2 +010400 07 RECORDS-IN-FILE PIC 9(6). RL2014.2 +010500 07 FILLER PIC X(5). RL2014.2 +010600 07 XFILE-ORGANIZATION PIC X(2). RL2014.2 +010700 07 FILLER PIC X(6). RL2014.2 +010800 07 XLABEL-TYPE PIC X(1). RL2014.2 +010900 05 FILE-RECORD-INFO-P121-240. RL2014.2 +011000 07 FILLER PIC X(8). RL2014.2 +011100 07 XRECORD-KEY PIC X(29). RL2014.2 +011200 07 FILLER PIC X(9). RL2014.2 +011300 07 ALTERNATE-KEY1 PIC X(29). RL2014.2 +011400 07 FILLER PIC X(9). RL2014.2 +011500 07 ALTERNATE-KEY2 PIC X(29). RL2014.2 +011600 07 FILLER PIC X(7). RL2014.2 +011700 01 TEST-RESULTS. RL2014.2 +011800 02 FILLER PIC X VALUE SPACE. RL2014.2 +011900 02 FEATURE PIC X(20) VALUE SPACE. RL2014.2 +012000 02 FILLER PIC X VALUE SPACE. RL2014.2 +012100 02 P-OR-F PIC X(5) VALUE SPACE. RL2014.2 +012200 02 FILLER PIC X VALUE SPACE. RL2014.2 +012300 02 PAR-NAME. RL2014.2 +012400 03 FILLER PIC X(19) VALUE SPACE. RL2014.2 +012500 03 PARDOT-X PIC X VALUE SPACE. RL2014.2 +012600 03 DOTVALUE PIC 99 VALUE ZERO. RL2014.2 +012700 02 FILLER PIC X(8) VALUE SPACE. RL2014.2 +012800 02 RE-MARK PIC X(61). RL2014.2 +012900 01 TEST-COMPUTED. RL2014.2 +013000 02 FILLER PIC X(30) VALUE SPACE. RL2014.2 +013100 02 FILLER PIC X(17) VALUE RL2014.2 +013200 " COMPUTED=". RL2014.2 +013300 02 COMPUTED-X. RL2014.2 +013400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2014.2 +013500 03 COMPUTED-N REDEFINES COMPUTED-A RL2014.2 +013600 PIC -9(9).9(9). RL2014.2 +013700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2014.2 +013800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2014.2 +013900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2014.2 +014000 03 CM-18V0 REDEFINES COMPUTED-A. RL2014.2 +014100 04 COMPUTED-18V0 PIC -9(18). RL2014.2 +014200 04 FILLER PIC X. RL2014.2 +014300 03 FILLER PIC X(50) VALUE SPACE. RL2014.2 +014400 01 TEST-CORRECT. RL2014.2 +014500 02 FILLER PIC X(30) VALUE SPACE. RL2014.2 +014600 02 FILLER PIC X(17) VALUE " CORRECT =". RL2014.2 +014700 02 CORRECT-X. RL2014.2 +014800 03 CORRECT-A PIC X(20) VALUE SPACE. RL2014.2 +014900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2014.2 +015000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2014.2 +015100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2014.2 +015200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2014.2 +015300 03 CR-18V0 REDEFINES CORRECT-A. RL2014.2 +015400 04 CORRECT-18V0 PIC -9(18). RL2014.2 +015500 04 FILLER PIC X. RL2014.2 +015600 03 FILLER PIC X(2) VALUE SPACE. RL2014.2 +015700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2014.2 +015800 01 CCVS-C-1. RL2014.2 +015900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2014.2 +016000- "SS PARAGRAPH-NAME RL2014.2 +016100- " REMARKS". RL2014.2 +016200 02 FILLER PIC X(20) VALUE SPACE. RL2014.2 +016300 01 CCVS-C-2. RL2014.2 +016400 02 FILLER PIC X VALUE SPACE. RL2014.2 +016500 02 FILLER PIC X(6) VALUE "TESTED". RL2014.2 +016600 02 FILLER PIC X(15) VALUE SPACE. RL2014.2 +016700 02 FILLER PIC X(4) VALUE "FAIL". RL2014.2 +016800 02 FILLER PIC X(94) VALUE SPACE. RL2014.2 +016900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2014.2 +017000 01 REC-CT PIC 99 VALUE ZERO. RL2014.2 +017100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2014.2 +017200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2014.2 +017300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2014.2 +017400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2014.2 +017500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2014.2 +017600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2014.2 +017700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2014.2 +017800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2014.2 +017900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2014.2 +018000 01 CCVS-H-1. RL2014.2 +018100 02 FILLER PIC X(39) VALUE SPACES. RL2014.2 +018200 02 FILLER PIC X(42) VALUE RL2014.2 +018300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2014.2 +018400 02 FILLER PIC X(39) VALUE SPACES. RL2014.2 +018500 01 CCVS-H-2A. RL2014.2 +018600 02 FILLER PIC X(40) VALUE SPACE. RL2014.2 +018700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2014.2 +018800 02 FILLER PIC XXXX VALUE RL2014.2 +018900 "4.2 ". RL2014.2 +019000 02 FILLER PIC X(28) VALUE RL2014.2 +019100 " COPY - NOT FOR DISTRIBUTION". RL2014.2 +019200 02 FILLER PIC X(41) VALUE SPACE. RL2014.2 +019300 RL2014.2 +019400 01 CCVS-H-2B. RL2014.2 +019500 02 FILLER PIC X(15) VALUE RL2014.2 +019600 "TEST RESULT OF ". RL2014.2 +019700 02 TEST-ID PIC X(9). RL2014.2 +019800 02 FILLER PIC X(4) VALUE RL2014.2 +019900 " IN ". RL2014.2 +020000 02 FILLER PIC X(12) VALUE RL2014.2 +020100 " HIGH ". RL2014.2 +020200 02 FILLER PIC X(22) VALUE RL2014.2 +020300 " LEVEL VALIDATION FOR ". RL2014.2 +020400 02 FILLER PIC X(58) VALUE RL2014.2 +020500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2014.2 +020600 01 CCVS-H-3. RL2014.2 +020700 02 FILLER PIC X(34) VALUE RL2014.2 +020800 " FOR OFFICIAL USE ONLY ". RL2014.2 +020900 02 FILLER PIC X(58) VALUE RL2014.2 +021000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2014.2 +021100 02 FILLER PIC X(28) VALUE RL2014.2 +021200 " COPYRIGHT 1985 ". RL2014.2 +021300 01 CCVS-E-1. RL2014.2 +021400 02 FILLER PIC X(52) VALUE SPACE. RL2014.2 +021500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2014.2 +021600 02 ID-AGAIN PIC X(9). RL2014.2 +021700 02 FILLER PIC X(45) VALUE SPACES. RL2014.2 +021800 01 CCVS-E-2. RL2014.2 +021900 02 FILLER PIC X(31) VALUE SPACE. RL2014.2 +022000 02 FILLER PIC X(21) VALUE SPACE. RL2014.2 +022100 02 CCVS-E-2-2. RL2014.2 +022200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2014.2 +022300 03 FILLER PIC X VALUE SPACE. RL2014.2 +022400 03 ENDER-DESC PIC X(44) VALUE RL2014.2 +022500 "ERRORS ENCOUNTERED". RL2014.2 +022600 01 CCVS-E-3. RL2014.2 +022700 02 FILLER PIC X(22) VALUE RL2014.2 +022800 " FOR OFFICIAL USE ONLY". RL2014.2 +022900 02 FILLER PIC X(12) VALUE SPACE. RL2014.2 +023000 02 FILLER PIC X(58) VALUE RL2014.2 +023100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2014.2 +023200 02 FILLER PIC X(13) VALUE SPACE. RL2014.2 +023300 02 FILLER PIC X(15) VALUE RL2014.2 +023400 " COPYRIGHT 1985". RL2014.2 +023500 01 CCVS-E-4. RL2014.2 +023600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2014.2 +023700 02 FILLER PIC X(4) VALUE " OF ". RL2014.2 +023800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2014.2 +023900 02 FILLER PIC X(40) VALUE RL2014.2 +024000 " TESTS WERE EXECUTED SUCCESSFULLY". RL2014.2 +024100 01 XXINFO. RL2014.2 +024200 02 FILLER PIC X(19) VALUE RL2014.2 +024300 "*** INFORMATION ***". RL2014.2 +024400 02 INFO-TEXT. RL2014.2 +024500 04 FILLER PIC X(8) VALUE SPACE. RL2014.2 +024600 04 XXCOMPUTED PIC X(20). RL2014.2 +024700 04 FILLER PIC X(5) VALUE SPACE. RL2014.2 +024800 04 XXCORRECT PIC X(20). RL2014.2 +024900 02 INF-ANSI-REFERENCE PIC X(48). RL2014.2 +025000 01 HYPHEN-LINE. RL2014.2 +025100 02 FILLER PIC IS X VALUE IS SPACE. RL2014.2 +025200 02 FILLER PIC IS X(65) VALUE IS "************************RL2014.2 +025300- "*****************************************". RL2014.2 +025400 02 FILLER PIC IS X(54) VALUE IS "************************RL2014.2 +025500- "******************************". RL2014.2 +025600 01 CCVS-PGM-ID PIC X(9) VALUE RL2014.2 +025700 "RL201A". RL2014.2 +025800 PROCEDURE DIVISION. RL2014.2 +025900 CCVS1 SECTION. RL2014.2 +026000 OPEN-FILES. RL2014.2 +026100 OPEN OUTPUT PRINT-FILE. RL2014.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2014.2 +026300 MOVE SPACE TO TEST-RESULTS. RL2014.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2014.2 +026500 MOVE ZERO TO REC-SKL-SUB. RL2014.2 +026600 PERFORM CCVS-INIT-FILE 9 TIMES. RL2014.2 +026700 CCVS-INIT-FILE. RL2014.2 +026800 ADD 1 TO REC-SKL-SUB. RL2014.2 +026900 MOVE FILE-RECORD-INFO-SKELETON RL2014.2 +027000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2014.2 +027100 CCVS-INIT-EXIT. RL2014.2 +027200 GO TO CCVS1-EXIT. RL2014.2 +027300 CLOSE-FILES. RL2014.2 +027400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2014.2 +027500 TERMINATE-CCVS. RL2014.2 +027600*S EXIT PROGRAM. RL2014.2 +027700*SERMINATE-CALL. RL2014.2 +027800 STOP RUN. RL2014.2 +027900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2014.2 +028000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2014.2 +028100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2014.2 +028200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2014.2 +028300 MOVE "****TEST DELETED****" TO RE-MARK. RL2014.2 +028400 PRINT-DETAIL. RL2014.2 +028500 IF REC-CT NOT EQUAL TO ZERO RL2014.2 +028600 MOVE "." TO PARDOT-X RL2014.2 +028700 MOVE REC-CT TO DOTVALUE. RL2014.2 +028800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2014.2 +028900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2014.2 +029000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2014.2 +029100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2014.2 +029200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2014.2 +029300 MOVE SPACE TO CORRECT-X. RL2014.2 +029400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2014.2 +029500 MOVE SPACE TO RE-MARK. RL2014.2 +029600 HEAD-ROUTINE. RL2014.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2014.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2014.2 +030100 COLUMN-NAMES-ROUTINE. RL2014.2 +030200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +030300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +030400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +030500 END-ROUTINE. RL2014.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2014.2 +030700 END-RTN-EXIT. RL2014.2 +030800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +030900 END-ROUTINE-1. RL2014.2 +031000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2014.2 +031100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2014.2 +031200 ADD PASS-COUNTER TO ERROR-HOLD. RL2014.2 +031300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2014.2 +031400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2014.2 +031500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2014.2 +031600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2014.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2014.2 +031800 END-ROUTINE-12. RL2014.2 +031900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2014.2 +032000 IF ERROR-COUNTER IS EQUAL TO ZERO RL2014.2 +032100 MOVE "NO " TO ERROR-TOTAL RL2014.2 +032200 ELSE RL2014.2 +032300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2014.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2014.2 +032500 PERFORM WRITE-LINE. RL2014.2 +032600 END-ROUTINE-13. RL2014.2 +032700 IF DELETE-COUNTER IS EQUAL TO ZERO RL2014.2 +032800 MOVE "NO " TO ERROR-TOTAL ELSE RL2014.2 +032900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2014.2 +033000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2014.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +033200 IF INSPECT-COUNTER EQUAL TO ZERO RL2014.2 +033300 MOVE "NO " TO ERROR-TOTAL RL2014.2 +033400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2014.2 +033500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2014.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +033700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2014.2 +033800 WRITE-LINE. RL2014.2 +033900 ADD 1 TO RECORD-COUNT. RL2014.2 +034000 IF RECORD-COUNT GREATER 50 RL2014.2 +034100 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2014.2 +034200 MOVE SPACE TO DUMMY-RECORD RL2014.2 +034300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2014.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2014.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2014.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2014.2 +034700 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2014.2 +034800 MOVE ZERO TO RECORD-COUNT. RL2014.2 +034900 PERFORM WRT-LN. RL2014.2 +035000 WRT-LN. RL2014.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2014.2 +035200 MOVE SPACE TO DUMMY-RECORD. RL2014.2 +035300 BLANK-LINE-PRINT. RL2014.2 +035400 PERFORM WRT-LN. RL2014.2 +035500 FAIL-ROUTINE. RL2014.2 +035600 IF COMPUTED-X NOT EQUAL TO SPACE RL2014.2 +035700 GO TO FAIL-ROUTINE-WRITE. RL2014.2 +035800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2014.2 +035900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2014.2 +036000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2014.2 +036100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +036200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2014.2 +036300 GO TO FAIL-ROUTINE-EX. RL2014.2 +036400 FAIL-ROUTINE-WRITE. RL2014.2 +036500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2014.2 +036600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2014.2 +036700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2014.2 +036800 MOVE SPACES TO COR-ANSI-REFERENCE. RL2014.2 +036900 FAIL-ROUTINE-EX. EXIT. RL2014.2 +037000 BAIL-OUT. RL2014.2 +037100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2014.2 +037200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2014.2 +037300 BAIL-OUT-WRITE. RL2014.2 +037400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2014.2 +037500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2014.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2014.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2014.2 +037800 BAIL-OUT-EX. EXIT. RL2014.2 +037900 CCVS1-EXIT. RL2014.2 +038000 EXIT. RL2014.2 +038100 SECT-RL201-001 SECTION. RL2014.2 +038200 REL-INIT-001. RL2014.2 +038300 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL2014.2 +038400 OPEN OUTPUT RL-FS1. RL2014.2 +038500 MOVE "RL-FS1" TO XFILE-NAME (1). RL2014.2 +038600 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2014.2 +038700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2014.2 +038800 MOVE 000120 TO XRECORD-LENGTH (1). RL2014.2 +038900 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2014.2 +039000 MOVE 0001 TO XBLOCK-SIZE (1). RL2014.2 +039100 MOVE 000500 TO RECORDS-IN-FILE (1). RL2014.2 +039200 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2014.2 +039300 MOVE "S" TO XLABEL-TYPE (1). RL2014.2 +039400 MOVE 000001 TO XRECORD-NUMBER (1). RL2014.2 +039500 REL-TEST-001. RL2014.2 +039600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL2014.2 +039700 WRITE RL-FS1R1-F-G-120 RL2014.2 +039800 INVALID KEY GO TO REL-FAIL-001. RL2014.2 +039900 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2014.2 +040000 GO TO REL-WRITE-001. RL2014.2 +040100 ADD 000001 TO XRECORD-NUMBER (1). RL2014.2 +040200 GO TO REL-TEST-001. RL2014.2 +040300 REL-DELETE-001. RL2014.2 +040400 PERFORM DE-LETE. RL2014.2 +040500 GO TO REL-WRITE-001. RL2014.2 +040600 REL-FAIL-001. RL2014.2 +040700 PERFORM FAIL. RL2014.2 +040800 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2014.2 +040900 REL-WRITE-001. RL2014.2 +041000 MOVE "REL-TEST-001" TO PAR-NAME RL2014.2 +041100 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2014.2 +041200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2014.2 +041300 PERFORM PRINT-DETAIL. RL2014.2 +041400 CLOSE RL-FS1. RL2014.2 +041500 REL-INIT-002. RL2014.2 +041600 OPEN INPUT RL-FS1. RL2014.2 +041700 MOVE ZERO TO WRK-CS-09V00. RL2014.2 +041800 REL-TEST-002. RL2014.2 +041900 READ RL-FS1 RL2014.2 +042000 AT END GO TO REL-TEST-002-1. RL2014.2 +042100 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2014.2 +042200 ADD 1 TO WRK-CS-09V00. RL2014.2 +042300 IF WRK-CS-09V00 GREATER 500 RL2014.2 +042400 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2014.2 +042500 GO TO REL-TEST-002-1. RL2014.2 +042600 GO TO REL-TEST-002. RL2014.2 +042700 REL-DELETE-002. RL2014.2 +042800 PERFORM DE-LETE. RL2014.2 +042900 PERFORM PRINT-DETAIL. RL2014.2 +043000 REL-TEST-002-1. RL2014.2 +043100 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2014.2 +043200 PERFORM FAIL RL2014.2 +043300 ELSE RL2014.2 +043400 PERFORM PASS. RL2014.2 +043500 GO TO REL-WRITE-002. RL2014.2 +043600 REL-WRITE-002. RL2014.2 +043700 MOVE "REL-TEST-002" TO PAR-NAME. RL2014.2 +043800 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2014.2 +043900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2014.2 +044000 PERFORM PRINT-DETAIL. RL2014.2 +044100 CLOSE RL-FS1. RL2014.2 +044200 CCVS-EXIT SECTION. RL2014.2 +044300 CCVS-999999. RL2014.2 +044400 GO TO CLOSE-FILES. RL2014.2 diff --git a/tests/cobol85/RL/RL202A.SUB b/tests/cobol85/RL/RL202A.SUB new file mode 100644 index 00000000..ca9ee776 --- /dev/null +++ b/tests/cobol85/RL/RL202A.SUB @@ -0,0 +1,617 @@ +000100 IDENTIFICATION DIVISION. RL2024.2 +000200 PROGRAM-ID. RL2024.2 +000300 RL202A. RL2024.2 +000400**************************************************************** RL2024.2 +000500* * RL2024.2 +000600* VALIDATION FOR:- * RL2024.2 +000700* * RL2024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2024.2 +000900* * RL2024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2024.2 +001100* * RL2024.2 +001200**************************************************************** RL2024.2 +001300*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVERL2024.2 +001400* I-O FILE RANDOMLY (ACCESS MODE IS DYNAMIC). THE FILE RL2024.2 +001500* USED AS INPUT IS THAT FILE CREATED BY RL201. RL2024.2 +001600* RL2024.2 +001700* FIRST THE FILE IS VERIFED AS TO THE EXISTANCE AND RL2024.2 +001800* ACCURACY OF THE 500 RECORDS CREATED IN THE FIRST RL2024.2 +001900* PROGRAM. SECONDLY, RECORDS OF THE FILE ARE SEL- RL2024.2 +002000* ECTIVELY UPDATED; AND THIRDLY, THE ACCURACY OF EACH RL2024.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL2024.2 +002200* RL2024.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2024.2 +002400* PROGRAM ARE: RL2024.2 +002500* RL2024.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2024.2 +002700* RELATIVE I-O DATA FILE RL2024.2 +002800* X-55 SYSTEM PRINTER RL2024.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2024.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2024.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2024.2 +003200* X-82 SOURCE-COMPUTER RL2024.2 +003300* X-83 OBJECT-COMPUTER. RL2024.2 +003400* RL2024.2 +003500*************************************************** RL2024.2 +003600 ENVIRONMENT DIVISION. RL2024.2 +003700 CONFIGURATION SECTION. RL2024.2 +003800 SOURCE-COMPUTER. RL2024.2 +003900 Linux. RL2024.2 +004000 OBJECT-COMPUTER. RL2024.2 +004100 Linux. RL2024.2 +004200 INPUT-OUTPUT SECTION. RL2024.2 +004300 FILE-CONTROL. RL2024.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2024.2 +004500 "report.log". RL2024.2 +004600 SELECT RL-FD1 ASSIGN TO RL2024.2 +004700 "XXXXX021" RL2024.2 +004800 ORGANIZATION IS RELATIVE RL2024.2 +004900 ACCESS MODE IS DYNAMIC RL2024.2 +005000 RELATIVE KEY RL-FD1-KEY. RL2024.2 +005100 DATA DIVISION. RL2024.2 +005200 FILE SECTION. RL2024.2 +005300 FD PRINT-FILE. RL2024.2 +005400 01 PRINT-REC PICTURE X(120). RL2024.2 +005500 01 DUMMY-RECORD PICTURE X(120). RL2024.2 +005600 FD RL-FD1 RL2024.2 +005700 LABEL RECORDS STANDARD RL2024.2 +005800*C VALUE OF RL2024.2 +005900*C OCLABELID RL2024.2 +006000*C IS RL2024.2 +006100*C "OCDUMMY" RL2024.2 +006200*G SYSIN RL2024.2 +006300 BLOCK CONTAINS 1 RECORDS RL2024.2 +006400 RECORD CONTAINS 120 CHARACTERS. RL2024.2 +006500 01 RL-FD1R1-F-G-120. RL2024.2 +006600 02 FILLER PICTURE X(120). RL2024.2 +006700 WORKING-STORAGE SECTION. RL2024.2 +006800 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +006900 01 RL-FD1-KEY PIC 9(09) USAGE COMP VALUE ZERO. RL2024.2 +007000 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. RL2024.2 +007100 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007200 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007300 01 I-O-ERROR-RL-FD1 PIC X(3) VALUE "NO ". RL2024.2 +007400 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007500 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007600 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. RL2024.2 +007700 01 WRK-DS-09V00-001 PIC S9(09) VALUE ZERO. RL2024.2 +007800 01 FILE-RECORD-INFORMATION-REC. RL2024.2 +007900 03 FILE-RECORD-INFO-SKELETON. RL2024.2 +008000 05 FILLER PICTURE X(48) VALUE RL2024.2 +008100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2024.2 +008200 05 FILLER PICTURE X(46) VALUE RL2024.2 +008300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2024.2 +008400 05 FILLER PICTURE X(26) VALUE RL2024.2 +008500 ",LFIL=000000,ORG= ,LBLR= ". RL2024.2 +008600 05 FILLER PICTURE X(37) VALUE RL2024.2 +008700 ",RECKEY= ". RL2024.2 +008800 05 FILLER PICTURE X(38) VALUE RL2024.2 +008900 ",ALTKEY1= ". RL2024.2 +009000 05 FILLER PICTURE X(38) VALUE RL2024.2 +009100 ",ALTKEY2= ". RL2024.2 +009200 05 FILLER PICTURE X(7) VALUE SPACE.RL2024.2 +009300 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2024.2 +009400 05 FILE-RECORD-INFO-P1-120. RL2024.2 +009500 07 FILLER PIC X(5). RL2024.2 +009600 07 XFILE-NAME PIC X(6). RL2024.2 +009700 07 FILLER PIC X(8). RL2024.2 +009800 07 XRECORD-NAME PIC X(6). RL2024.2 +009900 07 FILLER PIC X(1). RL2024.2 +010000 07 REELUNIT-NUMBER PIC 9(1). RL2024.2 +010100 07 FILLER PIC X(7). RL2024.2 +010200 07 XRECORD-NUMBER PIC 9(6). RL2024.2 +010300 07 FILLER PIC X(6). RL2024.2 +010400 07 UPDATE-NUMBER PIC 9(2). RL2024.2 +010500 07 FILLER PIC X(5). RL2024.2 +010600 07 ODO-NUMBER PIC 9(4). RL2024.2 +010700 07 FILLER PIC X(5). RL2024.2 +010800 07 XPROGRAM-NAME PIC X(5). RL2024.2 +010900 07 FILLER PIC X(7). RL2024.2 +011000 07 XRECORD-LENGTH PIC 9(6). RL2024.2 +011100 07 FILLER PIC X(7). RL2024.2 +011200 07 CHARS-OR-RECORDS PIC X(2). RL2024.2 +011300 07 FILLER PIC X(1). RL2024.2 +011400 07 XBLOCK-SIZE PIC 9(4). RL2024.2 +011500 07 FILLER PIC X(6). RL2024.2 +011600 07 RECORDS-IN-FILE PIC 9(6). RL2024.2 +011700 07 FILLER PIC X(5). RL2024.2 +011800 07 XFILE-ORGANIZATION PIC X(2). RL2024.2 +011900 07 FILLER PIC X(6). RL2024.2 +012000 07 XLABEL-TYPE PIC X(1). RL2024.2 +012100 05 FILE-RECORD-INFO-P121-240. RL2024.2 +012200 07 FILLER PIC X(8). RL2024.2 +012300 07 XRECORD-KEY PIC X(29). RL2024.2 +012400 07 FILLER PIC X(9). RL2024.2 +012500 07 ALTERNATE-KEY1 PIC X(29). RL2024.2 +012600 07 FILLER PIC X(9). RL2024.2 +012700 07 ALTERNATE-KEY2 PIC X(29). RL2024.2 +012800 07 FILLER PIC X(7). RL2024.2 +012900 01 TEST-RESULTS. RL2024.2 +013000 02 FILLER PIC X VALUE SPACE. RL2024.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. RL2024.2 +013200 02 FILLER PIC X VALUE SPACE. RL2024.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. RL2024.2 +013400 02 FILLER PIC X VALUE SPACE. RL2024.2 +013500 02 PAR-NAME. RL2024.2 +013600 03 FILLER PIC X(19) VALUE SPACE. RL2024.2 +013700 03 PARDOT-X PIC X VALUE SPACE. RL2024.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. RL2024.2 +013900 02 FILLER PIC X(8) VALUE SPACE. RL2024.2 +014000 02 RE-MARK PIC X(61). RL2024.2 +014100 01 TEST-COMPUTED. RL2024.2 +014200 02 FILLER PIC X(30) VALUE SPACE. RL2024.2 +014300 02 FILLER PIC X(17) VALUE RL2024.2 +014400 " COMPUTED=". RL2024.2 +014500 02 COMPUTED-X. RL2024.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2024.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A RL2024.2 +014800 PIC -9(9).9(9). RL2024.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2024.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2024.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2024.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. RL2024.2 +015300 04 COMPUTED-18V0 PIC -9(18). RL2024.2 +015400 04 FILLER PIC X. RL2024.2 +015500 03 FILLER PIC X(50) VALUE SPACE. RL2024.2 +015600 01 TEST-CORRECT. RL2024.2 +015700 02 FILLER PIC X(30) VALUE SPACE. RL2024.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". RL2024.2 +015900 02 CORRECT-X. RL2024.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. RL2024.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2024.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2024.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2024.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2024.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. RL2024.2 +016600 04 CORRECT-18V0 PIC -9(18). RL2024.2 +016700 04 FILLER PIC X. RL2024.2 +016800 03 FILLER PIC X(2) VALUE SPACE. RL2024.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2024.2 +017000 01 CCVS-C-1. RL2024.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2024.2 +017200- "SS PARAGRAPH-NAME RL2024.2 +017300- " REMARKS". RL2024.2 +017400 02 FILLER PIC X(20) VALUE SPACE. RL2024.2 +017500 01 CCVS-C-2. RL2024.2 +017600 02 FILLER PIC X VALUE SPACE. RL2024.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". RL2024.2 +017800 02 FILLER PIC X(15) VALUE SPACE. RL2024.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". RL2024.2 +018000 02 FILLER PIC X(94) VALUE SPACE. RL2024.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2024.2 +018200 01 REC-CT PIC 99 VALUE ZERO. RL2024.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2024.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2024.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2024.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2024.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2024.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2024.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2024.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2024.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2024.2 +019200 01 CCVS-H-1. RL2024.2 +019300 02 FILLER PIC X(39) VALUE SPACES. RL2024.2 +019400 02 FILLER PIC X(42) VALUE RL2024.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2024.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL2024.2 +019700 01 CCVS-H-2A. RL2024.2 +019800 02 FILLER PIC X(40) VALUE SPACE. RL2024.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2024.2 +020000 02 FILLER PIC XXXX VALUE RL2024.2 +020100 "4.2 ". RL2024.2 +020200 02 FILLER PIC X(28) VALUE RL2024.2 +020300 " COPY - NOT FOR DISTRIBUTION". RL2024.2 +020400 02 FILLER PIC X(41) VALUE SPACE. RL2024.2 +020500 RL2024.2 +020600 01 CCVS-H-2B. RL2024.2 +020700 02 FILLER PIC X(15) VALUE RL2024.2 +020800 "TEST RESULT OF ". RL2024.2 +020900 02 TEST-ID PIC X(9). RL2024.2 +021000 02 FILLER PIC X(4) VALUE RL2024.2 +021100 " IN ". RL2024.2 +021200 02 FILLER PIC X(12) VALUE RL2024.2 +021300 " HIGH ". RL2024.2 +021400 02 FILLER PIC X(22) VALUE RL2024.2 +021500 " LEVEL VALIDATION FOR ". RL2024.2 +021600 02 FILLER PIC X(58) VALUE RL2024.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2024.2 +021800 01 CCVS-H-3. RL2024.2 +021900 02 FILLER PIC X(34) VALUE RL2024.2 +022000 " FOR OFFICIAL USE ONLY ". RL2024.2 +022100 02 FILLER PIC X(58) VALUE RL2024.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2024.2 +022300 02 FILLER PIC X(28) VALUE RL2024.2 +022400 " COPYRIGHT 1985 ". RL2024.2 +022500 01 CCVS-E-1. RL2024.2 +022600 02 FILLER PIC X(52) VALUE SPACE. RL2024.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2024.2 +022800 02 ID-AGAIN PIC X(9). RL2024.2 +022900 02 FILLER PIC X(45) VALUE SPACES. RL2024.2 +023000 01 CCVS-E-2. RL2024.2 +023100 02 FILLER PIC X(31) VALUE SPACE. RL2024.2 +023200 02 FILLER PIC X(21) VALUE SPACE. RL2024.2 +023300 02 CCVS-E-2-2. RL2024.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2024.2 +023500 03 FILLER PIC X VALUE SPACE. RL2024.2 +023600 03 ENDER-DESC PIC X(44) VALUE RL2024.2 +023700 "ERRORS ENCOUNTERED". RL2024.2 +023800 01 CCVS-E-3. RL2024.2 +023900 02 FILLER PIC X(22) VALUE RL2024.2 +024000 " FOR OFFICIAL USE ONLY". RL2024.2 +024100 02 FILLER PIC X(12) VALUE SPACE. RL2024.2 +024200 02 FILLER PIC X(58) VALUE RL2024.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2024.2 +024400 02 FILLER PIC X(13) VALUE SPACE. RL2024.2 +024500 02 FILLER PIC X(15) VALUE RL2024.2 +024600 " COPYRIGHT 1985". RL2024.2 +024700 01 CCVS-E-4. RL2024.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2024.2 +024900 02 FILLER PIC X(4) VALUE " OF ". RL2024.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2024.2 +025100 02 FILLER PIC X(40) VALUE RL2024.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". RL2024.2 +025300 01 XXINFO. RL2024.2 +025400 02 FILLER PIC X(19) VALUE RL2024.2 +025500 "*** INFORMATION ***". RL2024.2 +025600 02 INFO-TEXT. RL2024.2 +025700 04 FILLER PIC X(8) VALUE SPACE. RL2024.2 +025800 04 XXCOMPUTED PIC X(20). RL2024.2 +025900 04 FILLER PIC X(5) VALUE SPACE. RL2024.2 +026000 04 XXCORRECT PIC X(20). RL2024.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). RL2024.2 +026200 01 HYPHEN-LINE. RL2024.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. RL2024.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************RL2024.2 +026500- "*****************************************". RL2024.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************RL2024.2 +026700- "******************************". RL2024.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE RL2024.2 +026900 "RL202A". RL2024.2 +027000 PROCEDURE DIVISION. RL2024.2 +027100 CCVS1 SECTION. RL2024.2 +027200 OPEN-FILES. RL2024.2 +027300 OPEN OUTPUT PRINT-FILE. RL2024.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2024.2 +027500 MOVE SPACE TO TEST-RESULTS. RL2024.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2024.2 +027700 MOVE ZERO TO REC-SKL-SUB. RL2024.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. RL2024.2 +027900 CCVS-INIT-FILE. RL2024.2 +028000 ADD 1 TO REC-SKL-SUB. RL2024.2 +028100 MOVE FILE-RECORD-INFO-SKELETON RL2024.2 +028200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2024.2 +028300 CCVS-INIT-EXIT. RL2024.2 +028400 GO TO CCVS1-EXIT. RL2024.2 +028500 CLOSE-FILES. RL2024.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2024.2 +028700 TERMINATE-CCVS. RL2024.2 +028800*S EXIT PROGRAM. RL2024.2 +028900*SERMINATE-CALL. RL2024.2 +029000 STOP RUN. RL2024.2 +029100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2024.2 +029200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2024.2 +029300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2024.2 +029400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2024.2 +029500 MOVE "****TEST DELETED****" TO RE-MARK. RL2024.2 +029600 PRINT-DETAIL. RL2024.2 +029700 IF REC-CT NOT EQUAL TO ZERO RL2024.2 +029800 MOVE "." TO PARDOT-X RL2024.2 +029900 MOVE REC-CT TO DOTVALUE. RL2024.2 +030000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2024.2 +030100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2024.2 +030200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2024.2 +030300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2024.2 +030400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2024.2 +030500 MOVE SPACE TO CORRECT-X. RL2024.2 +030600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2024.2 +030700 MOVE SPACE TO RE-MARK. RL2024.2 +030800 HEAD-ROUTINE. RL2024.2 +030900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +031000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +031100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2024.2 +031200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2024.2 +031300 COLUMN-NAMES-ROUTINE. RL2024.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +031700 END-ROUTINE. RL2024.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2024.2 +031900 END-RTN-EXIT. RL2024.2 +032000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +032100 END-ROUTINE-1. RL2024.2 +032200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2024.2 +032300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2024.2 +032400 ADD PASS-COUNTER TO ERROR-HOLD. RL2024.2 +032500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2024.2 +032600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2024.2 +032700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2024.2 +032800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2024.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2024.2 +033000 END-ROUTINE-12. RL2024.2 +033100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2024.2 +033200 IF ERROR-COUNTER IS EQUAL TO ZERO RL2024.2 +033300 MOVE "NO " TO ERROR-TOTAL RL2024.2 +033400 ELSE RL2024.2 +033500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2024.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2024.2 +033700 PERFORM WRITE-LINE. RL2024.2 +033800 END-ROUTINE-13. RL2024.2 +033900 IF DELETE-COUNTER IS EQUAL TO ZERO RL2024.2 +034000 MOVE "NO " TO ERROR-TOTAL ELSE RL2024.2 +034100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2024.2 +034200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2024.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +034400 IF INSPECT-COUNTER EQUAL TO ZERO RL2024.2 +034500 MOVE "NO " TO ERROR-TOTAL RL2024.2 +034600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2024.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2024.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2024.2 +035000 WRITE-LINE. RL2024.2 +035100 ADD 1 TO RECORD-COUNT. RL2024.2 +035200 IF RECORD-COUNT GREATER 50 RL2024.2 +035300 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2024.2 +035400 MOVE SPACE TO DUMMY-RECORD RL2024.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2024.2 +035600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2024.2 +035700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2024.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2024.2 +035900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2024.2 +036000 MOVE ZERO TO RECORD-COUNT. RL2024.2 +036100 PERFORM WRT-LN. RL2024.2 +036200 WRT-LN. RL2024.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2024.2 +036400 MOVE SPACE TO DUMMY-RECORD. RL2024.2 +036500 BLANK-LINE-PRINT. RL2024.2 +036600 PERFORM WRT-LN. RL2024.2 +036700 FAIL-ROUTINE. RL2024.2 +036800 IF COMPUTED-X NOT EQUAL TO SPACE RL2024.2 +036900 GO TO FAIL-ROUTINE-WRITE. RL2024.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2024.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2024.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2024.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. RL2024.2 +037500 GO TO FAIL-ROUTINE-EX. RL2024.2 +037600 FAIL-ROUTINE-WRITE. RL2024.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2024.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2024.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2024.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. RL2024.2 +038100 FAIL-ROUTINE-EX. EXIT. RL2024.2 +038200 BAIL-OUT. RL2024.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2024.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2024.2 +038500 BAIL-OUT-WRITE. RL2024.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2024.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2024.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2024.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. RL2024.2 +039000 BAIL-OUT-EX. EXIT. RL2024.2 +039100 CCVS1-EXIT. RL2024.2 +039200 EXIT. RL2024.2 +039300 SECT-RL202-001 SECTION. RL2024.2 +039400 REL-INIT-003. RL2024.2 +039500 OPEN INPUT RL-FD1. RL2024.2 +039600 MOVE "REL-TEST-003" TO PAR-NAME. RL2024.2 +039700 MOVE ZERO TO RL-FD1-KEY. RL2024.2 +039800 MOVE ZERO TO WRK-CS-09V00-002 RL2024.2 +039900 MOVE ZERO TO WRK-CS-09V00-003 RL2024.2 +040000* RL2024.2 +040100 MOVE 01 TO REC-CT. RL2024.2 +040200 MOVE "READ RANDOM" TO FEATURE. RL2024.2 +040300 REL-TEST-003-R. RL2024.2 +040400 ADD 1 TO WRK-CS-09V00-003 RL2024.2 +040500 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2024.2 +040600 IF RL-FD1-KEY GREATER +501 RL2024.2 +040700 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A RL2024.2 +040800 MOVE RL-FD1-KEY TO CORRECT-18V0 RL2024.2 +040900 PERFORM FAIL RL2024.2 +041000 PERFORM PRINT-DETAIL RL2024.2 +041100 ADD 1 TO REC-CT RL2024.2 +041200 GO TO REL-WRITE-003. RL2024.2 +041300 READ RL-FD1 RL2024.2 +041400 INVALID KEY GO TO REL-WRITE-003. RL2024.2 +041500 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2024.2 +041600 IF XRECORD-NUMBER (1) EQUAL TO RL-FD1-KEY RL2024.2 +041700 GO TO REL-TEST-003-R. RL2024.2 +041800 MOVE "YES" TO I-O-ERROR-RL-FD1. RL2024.2 +041900 ADD 1 TO WRK-CS-09V00-002 RL2024.2 +042000 GO TO REL-TEST-003-R. RL2024.2 +042100 REL-WRITE-003. RL2024.2 +042200 IF RL-FD1-KEY NOT EQUAL TO 501 RL2024.2 +042300 MOVE "WRONG KEY/NOT 500" TO CORRECT-A RL2024.2 +042400 MOVE RL-FD1-KEY TO COMPUTED-18V0 RL2024.2 +042500 PERFORM FAIL RL2024.2 +042600 ELSE RL2024.2 +042700 PERFORM PASS. RL2024.2 +042800 PERFORM PRINT-DETAIL. RL2024.2 +042900* RL2024.2 +043000*01 RL2024.2 +043100* RL2024.2 +043200 ADD 1 TO REC-CT. RL2024.2 +043300 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2024.2 +043400 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A RL2024.2 +043500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 RL2024.2 +043600 PERFORM FAIL RL2024.2 +043700 ELSE RL2024.2 +043800 PERFORM PASS. RL2024.2 +043900 PERFORM PRINT-DETAIL. RL2024.2 +044000* RL2024.2 +044100*02 RL2024.2 +044200* RL2024.2 +044300 ADD 1 TO REC-CT. RL2024.2 +044400 IF WRK-CS-09V00-003 NOT EQUAL TO 501 RL2024.2 +044500 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2024.2 +044600 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL2024.2 +044700 MOVE 501 TO CORRECT-18V0 RL2024.2 +044800 PERFORM FAIL RL2024.2 +044900 ELSE RL2024.2 +045000 PERFORM PASS. RL2024.2 +045100 PERFORM PRINT-DETAIL. RL2024.2 +045200* RL2024.2 +045300*03 RL2024.2 +045400* RL2024.2 +045500 ADD 1 TO REC-CT. RL2024.2 +045600 IF I-O-ERROR-RL-FD1 EQUAL TO "YES" RL2024.2 +045700 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 RL2024.2 +045800 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK RL2024.2 +045900 PERFORM FAIL RL2024.2 +046000 ELSE RL2024.2 +046100 PERFORM PASS. RL2024.2 +046200 PERFORM PRINT-DETAIL. RL2024.2 +046300* RL2024.2 +046400*04 RL2024.2 +046500* RL2024.2 +046600 ADD 1 TO REC-CT. RL2024.2 +046700 CLOSE RL-FD1. RL2024.2 +046800 REL-INIT-004-R . RL2024.2 +046900 MOVE "REL-TEST-004" TO PAR-NAME. RL2024.2 +047000 OPEN I-O RL-FD1. RL2024.2 +047100 MOVE ZERO TO RL-FD1-KEY. RL2024.2 +047200 MOVE ZERO TO WRK-CS-09V00-002. RL2024.2 +047300 MOVE ZERO TO WRK-CS-09V00-003. RL2024.2 +047400 MOVE ZERO TO WRK-CS-09V00-004. RL2024.2 +047500 MOVE ZERO TO WRK-CS-09V00-005. RL2024.2 +047600* RL2024.2 +047700 MOVE 01 TO REC-CT. RL2024.2 +047800 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2024.2 +047900 MOVE "REWRITE" TO FEATURE. RL2024.2 +048000 REL-TEST-004-R. RL2024.2 +048100 ADD 5 TO WRK-CS-09V00-003. RL2024.2 +048200 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2024.2 +048300 IF RL-FD1-KEY GREATER 505 RL2024.2 +048400 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A RL2024.2 +048500 MOVE RL-FD1-KEY TO CORRECT-18V0 RL2024.2 +048600 PERFORM FAIL RL2024.2 +048700 PERFORM PRINT-DETAIL RL2024.2 +048800 ADD 1 TO REC-CT RL2024.2 +048900 GO TO REL-TEST-004-3. RL2024.2 +049000 READ RL-FD1 RL2024.2 +049100 INVALID KEY GO TO REL-TEST-004-1. RL2024.2 +049200 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1) RL2024.2 +049300 ADD 01 TO UPDATE-NUMBER (1). RL2024.2 +049400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2024.2 +049500 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-120. RL2024.2 +049600 REWRITE RL-FD1R1-F-G-120 RL2024.2 +049700 INVALID KEY GO TO REL-TEST-004-2. RL2024.2 +049800 GO TO REL-TEST-004-R. RL2024.2 +049900 REL-TEST-004-1. RL2024.2 +050000 IF RL-FD1-KEY LESS THAN 501 RL2024.2 +050100 ADD 1 TO WRK-CS-09V00-004 RL2024.2 +050200 GO TO REL-TEST-004-R. RL2024.2 +050300 PERFORM PASS. RL2024.2 +050400 PERFORM PRINT-DETAIL. RL2024.2 +050500* RL2024.2 +050600*01 RL2024.2 +050700* RL2024.2 +050800 ADD 1 TO REC-CT. RL2024.2 +050900 GO TO REL-TEST-004-3. RL2024.2 +051000 REL-TEST-004-2. RL2024.2 +051100 ADD 1 TO WRK-CS-09V00-005. RL2024.2 +051200 IF RL-FD1-KEY LESS 501 RL2024.2 +051300 GO TO REL-TEST-004-R. RL2024.2 +051400 REL-TEST-004-3. RL2024.2 +051500 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO RL2024.2 +051600 MOVE "INVALID KEY ON READ" TO COMPUTED-A RL2024.2 +051700 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL2024.2 +051800 PERFORM FAIL RL2024.2 +051900 ELSE RL2024.2 +052000 PERFORM PASS. RL2024.2 +052100 PERFORM PRINT-DETAIL. RL2024.2 +052200* RL2024.2 +052300*02 RL2024.2 +052400* RL2024.2 +052500 ADD 1 TO REC-CT. RL2024.2 +052600 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO RL2024.2 +052700 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A RL2024.2 +052800 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL2024.2 +052900 PERFORM FAIL RL2024.2 +053000 ELSE RL2024.2 +053100 PERFORM PASS. RL2024.2 +053200 PERFORM PRINT-DETAIL. RL2024.2 +053300* RL2024.2 +053400*03 RL2024.2 +053500* RL2024.2 +053600 ADD 1 TO REC-CT. RL2024.2 +053700 CLOSE RL-FD1. RL2024.2 +053800 REL-INIT-005. RL2024.2 +053900 MOVE "REL-TEST-005" TO PAR-NAME. RL2024.2 +054000 OPEN INPUT RL-FD1. RL2024.2 +054100 MOVE 501 TO WRK-CS-09V00-003. RL2024.2 +054200 MOVE ZERO TO WRK-CS-09V00-004. RL2024.2 +054300 MOVE ZERO TO WRK-CS-09V00-005. RL2024.2 +054400 MOVE ZERO TO WRK-CS-09V00-002. RL2024.2 +054500 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2024.2 +054600 MOVE 01 TO REC-CT. RL2024.2 +054700* RL2024.2 +054800 MOVE "READ RANDOM" TO FEATURE. RL2024.2 +054900 REL-TEST-005-R. RL2024.2 +055000 SUBTRACT 1 FROM WRK-CS-09V00-003. RL2024.2 +055100 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2024.2 +055200 IF WRK-CS-09V00-003 LESS THAN ZERO RL2024.2 +055300 MOVE "INVALID KEY/NOT TAKEN" TO RE-MARK RL2024.2 +055400 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL2024.2 +055500 MOVE ZERO TO CORRECT-18V0 RL2024.2 +055600 PERFORM FAIL RL2024.2 +055700 PERFORM PRINT-DETAIL RL2024.2 +055800 ADD 1 TO REC-CT RL2024.2 +055900 GO TO REL-TEST-005-3. RL2024.2 +056000 READ RL-FD1 RL2024.2 +056100 INVALID KEY GO TO REL-TEST-005-1. RL2024.2 +056200 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2024.2 +056300 IF UPDATE-NUMBER (1) EQUAL TO 00 RL2024.2 +056400 ADD 1 TO WRK-CS-09V00-004. RL2024.2 +056500 IF UPDATE-NUMBER (1) EQUAL TO 01 RL2024.2 +056600 ADD 1 TO WRK-CS-09V00-005. RL2024.2 +056700 GO TO REL-TEST-005-R. RL2024.2 +056800 REL-TEST-005-1. RL2024.2 +056900 IF RL-FD1-KEY GREATER ZERO RL2024.2 +057000 ADD 1 TO WRK-CS-09V00-002 RL2024.2 +057100 GO TO REL-TEST-005-R. RL2024.2 +057200 PERFORM PASS. RL2024.2 +057300 PERFORM PRINT-DETAIL. RL2024.2 +057400 ADD 1 TO REC-CT. RL2024.2 +057500*01 RL2024.2 +057600 GO TO REL-TEST-005-3. RL2024.2 +057700 REL-TEST-005-3. RL2024.2 +057800 IF WRK-CS-09V00-004 NOT EQUAL TO 400 RL2024.2 +057900 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL2024.2 +058000 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL2024.2 +058100 MOVE "SHOULD BE 400" TO RE-MARK RL2024.2 +058200 PERFORM FAIL RL2024.2 +058300 ELSE RL2024.2 +058400 PERFORM PASS. RL2024.2 +058500 PERFORM PRINT-DETAIL. RL2024.2 +058600* RL2024.2 +058700* RL2024.2 +058800*02 RL2024.2 +058900* RL2024.2 +059000 ADD 1 TO REC-CT. RL2024.2 +059100 IF WRK-CS-09V00-005 NOT EQUAL TO 100 RL2024.2 +059200 MOVE "UPDATED RECORDS" TO COMPUTED-A RL2024.2 +059300 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL2024.2 +059400 MOVE "SHOULD BE 100" TO RE-MARK RL2024.2 +059500 PERFORM FAIL RL2024.2 +059600 ELSE RL2024.2 +059700 PERFORM PASS. RL2024.2 +059800 PERFORM PRINT-DETAIL. RL2024.2 +059900* RL2024.2 +060000*03 RL2024.2 +060100* RL2024.2 +060200 ADD 1 TO REC-CT. RL2024.2 +060300 IF WRK-CS-09V00-002 GREATER 1 RL2024.2 +060400 MOVE WRK-CS-09V00-002 TO COMPUTED-N RL2024.2 +060500 MOVE "INVALID KEY/READS" TO CORRECT-A RL2024.2 +060600 PERFORM FAIL RL2024.2 +060700 ELSE RL2024.2 +060800 PERFORM PASS. RL2024.2 +060900 PERFORM PRINT-DETAIL. RL2024.2 +061000* RL2024.2 +061100*04 RL2024.2 +061200* RL2024.2 +061300 ADD 1 TO REC-CT. RL2024.2 +061400 CLOSE RL-FD1. RL2024.2 +061500 CCVS-EXIT SECTION. RL2024.2 +061600 CCVS-999999. RL2024.2 +061700 GO TO CLOSE-FILES. RL2024.2 diff --git a/tests/cobol85/RL/RL203A.SUB b/tests/cobol85/RL/RL203A.SUB new file mode 100644 index 00000000..74e8c14b --- /dev/null +++ b/tests/cobol85/RL/RL203A.SUB @@ -0,0 +1,614 @@ +000100 IDENTIFICATION DIVISION. RL2034.2 +000200 PROGRAM-ID. RL2034.2 +000300 RL203A. RL2034.2 +000400**************************************************************** RL2034.2 +000500* * RL2034.2 +000600* VALIDATION FOR:- * RL2034.2 +000700* * RL2034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2034.2 +000900* * RL2034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2034.2 +001100* * RL2034.2 +001200**************************************************************** RL2034.2 +001300*GENERAL: THIS PROGRAM IS THE THIRD OF A SERIES. THE FUNCTION RL2034.2 +001400* OF THIS PROGRAM IS TO PROCESS THE FILE SEQUENTIALLY RL2034.2 +001500* (ACCESS MODE IS DYNAMIC). THE FILE USED IS THAT RL2034.2 +001600* RESULTING FROM RL102. RL2034.2 +001700* RL2034.2 +001800* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RL2034.2 +001900* RECORDS. SECONDLY, RECORDS OF THER FILE ARE RL2034.2 +002000* SELECTIVELY DELETED AND THIRDLY THE ACCURACY OF EACH RL2034.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL2034.2 +002200* RL2034.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2034.2 +002400* PROGRAM ARE: RL2034.2 +002500* RL2034.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2034.2 +002700* RELATIVE I-O DATA FILE RL2034.2 +002800* X-55 SYSTEM PRINTER RL2034.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2034.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2034.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2034.2 +003200* X-82 SOURCE-COMPUTER RL2034.2 +003300* X-83 OBJECT-COMPUTER. RL2034.2 +003400* RL2034.2 +003500*************************************************** RL2034.2 +003600 ENVIRONMENT DIVISION. RL2034.2 +003700 CONFIGURATION SECTION. RL2034.2 +003800 SOURCE-COMPUTER. RL2034.2 +003900 Linux. RL2034.2 +004000 OBJECT-COMPUTER. RL2034.2 +004100 Linux. RL2034.2 +004200 INPUT-OUTPUT SECTION. RL2034.2 +004300 FILE-CONTROL. RL2034.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2034.2 +004500 "report.log". RL2034.2 +004600 SELECT RL-FD1 ASSIGN TO RL2034.2 +004700 "XXXXX021" RL2034.2 +004800 ACCESS MODE IS DYNAMIC RL2034.2 +004900 RELATIVE KEY IS RL-FD1-KEY RL2034.2 +005000 ORGANIZATION IS RELATIVE. RL2034.2 +005100 DATA DIVISION. RL2034.2 +005200 FILE SECTION. RL2034.2 +005300 FD PRINT-FILE. RL2034.2 +005400 01 PRINT-REC PICTURE X(120). RL2034.2 +005500 01 DUMMY-RECORD PICTURE X(120). RL2034.2 +005600 FD RL-FD1 RL2034.2 +005700 LABEL RECORDS STANDARD RL2034.2 +005800*C VALUE OF RL2034.2 +005900*C OCLABELID RL2034.2 +006000*C IS RL2034.2 +006100*C "OCDUMMY" RL2034.2 +006200*G SYSIN RL2034.2 +006300 BLOCK CONTAINS 01 RECORDS RL2034.2 +006400 RECORD CONTAINS 120. RL2034.2 +006500 01 RL-FD1R1-F-G-120. RL2034.2 +006600 02 RL-WRK-120 PIC X(120). RL2034.2 +006700 WORKING-STORAGE SECTION. RL2034.2 +006800 01 RL-FD1-KEY PIC 9(08) USAGE COMP VALUE ZERO. RL2034.2 +006900 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007000 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007100 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007200 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007300 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007400 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. RL2034.2 +007500 01 I-O-ERROR-RL-FD1 PIC X(3) VALUE "NO ". RL2034.2 +007600 01 FILE-RECORD-INFORMATION-REC. RL2034.2 +007700 03 FILE-RECORD-INFO-SKELETON. RL2034.2 +007800 05 FILLER PICTURE X(48) VALUE RL2034.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2034.2 +008000 05 FILLER PICTURE X(46) VALUE RL2034.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2034.2 +008200 05 FILLER PICTURE X(26) VALUE RL2034.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". RL2034.2 +008400 05 FILLER PICTURE X(37) VALUE RL2034.2 +008500 ",RECKEY= ". RL2034.2 +008600 05 FILLER PICTURE X(38) VALUE RL2034.2 +008700 ",ALTKEY1= ". RL2034.2 +008800 05 FILLER PICTURE X(38) VALUE RL2034.2 +008900 ",ALTKEY2= ". RL2034.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.RL2034.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2034.2 +009200 05 FILE-RECORD-INFO-P1-120. RL2034.2 +009300 07 FILLER PIC X(5). RL2034.2 +009400 07 XFILE-NAME PIC X(6). RL2034.2 +009500 07 FILLER PIC X(8). RL2034.2 +009600 07 XRECORD-NAME PIC X(6). RL2034.2 +009700 07 FILLER PIC X(1). RL2034.2 +009800 07 REELUNIT-NUMBER PIC 9(1). RL2034.2 +009900 07 FILLER PIC X(7). RL2034.2 +010000 07 XRECORD-NUMBER PIC 9(6). RL2034.2 +010100 07 FILLER PIC X(6). RL2034.2 +010200 07 UPDATE-NUMBER PIC 9(2). RL2034.2 +010300 07 FILLER PIC X(5). RL2034.2 +010400 07 ODO-NUMBER PIC 9(4). RL2034.2 +010500 07 FILLER PIC X(5). RL2034.2 +010600 07 XPROGRAM-NAME PIC X(5). RL2034.2 +010700 07 FILLER PIC X(7). RL2034.2 +010800 07 XRECORD-LENGTH PIC 9(6). RL2034.2 +010900 07 FILLER PIC X(7). RL2034.2 +011000 07 CHARS-OR-RECORDS PIC X(2). RL2034.2 +011100 07 FILLER PIC X(1). RL2034.2 +011200 07 XBLOCK-SIZE PIC 9(4). RL2034.2 +011300 07 FILLER PIC X(6). RL2034.2 +011400 07 RECORDS-IN-FILE PIC 9(6). RL2034.2 +011500 07 FILLER PIC X(5). RL2034.2 +011600 07 XFILE-ORGANIZATION PIC X(2). RL2034.2 +011700 07 FILLER PIC X(6). RL2034.2 +011800 07 XLABEL-TYPE PIC X(1). RL2034.2 +011900 05 FILE-RECORD-INFO-P121-240. RL2034.2 +012000 07 FILLER PIC X(8). RL2034.2 +012100 07 XRECORD-KEY PIC X(29). RL2034.2 +012200 07 FILLER PIC X(9). RL2034.2 +012300 07 ALTERNATE-KEY1 PIC X(29). RL2034.2 +012400 07 FILLER PIC X(9). RL2034.2 +012500 07 ALTERNATE-KEY2 PIC X(29). RL2034.2 +012600 07 FILLER PIC X(7). RL2034.2 +012700 01 TEST-RESULTS. RL2034.2 +012800 02 FILLER PIC X VALUE SPACE. RL2034.2 +012900 02 FEATURE PIC X(20) VALUE SPACE. RL2034.2 +013000 02 FILLER PIC X VALUE SPACE. RL2034.2 +013100 02 P-OR-F PIC X(5) VALUE SPACE. RL2034.2 +013200 02 FILLER PIC X VALUE SPACE. RL2034.2 +013300 02 PAR-NAME. RL2034.2 +013400 03 FILLER PIC X(19) VALUE SPACE. RL2034.2 +013500 03 PARDOT-X PIC X VALUE SPACE. RL2034.2 +013600 03 DOTVALUE PIC 99 VALUE ZERO. RL2034.2 +013700 02 FILLER PIC X(8) VALUE SPACE. RL2034.2 +013800 02 RE-MARK PIC X(61). RL2034.2 +013900 01 TEST-COMPUTED. RL2034.2 +014000 02 FILLER PIC X(30) VALUE SPACE. RL2034.2 +014100 02 FILLER PIC X(17) VALUE RL2034.2 +014200 " COMPUTED=". RL2034.2 +014300 02 COMPUTED-X. RL2034.2 +014400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2034.2 +014500 03 COMPUTED-N REDEFINES COMPUTED-A RL2034.2 +014600 PIC -9(9).9(9). RL2034.2 +014700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2034.2 +014800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2034.2 +014900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2034.2 +015000 03 CM-18V0 REDEFINES COMPUTED-A. RL2034.2 +015100 04 COMPUTED-18V0 PIC -9(18). RL2034.2 +015200 04 FILLER PIC X. RL2034.2 +015300 03 FILLER PIC X(50) VALUE SPACE. RL2034.2 +015400 01 TEST-CORRECT. RL2034.2 +015500 02 FILLER PIC X(30) VALUE SPACE. RL2034.2 +015600 02 FILLER PIC X(17) VALUE " CORRECT =". RL2034.2 +015700 02 CORRECT-X. RL2034.2 +015800 03 CORRECT-A PIC X(20) VALUE SPACE. RL2034.2 +015900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2034.2 +016000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2034.2 +016100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2034.2 +016200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2034.2 +016300 03 CR-18V0 REDEFINES CORRECT-A. RL2034.2 +016400 04 CORRECT-18V0 PIC -9(18). RL2034.2 +016500 04 FILLER PIC X. RL2034.2 +016600 03 FILLER PIC X(2) VALUE SPACE. RL2034.2 +016700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2034.2 +016800 01 CCVS-C-1. RL2034.2 +016900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2034.2 +017000- "SS PARAGRAPH-NAME RL2034.2 +017100- " REMARKS". RL2034.2 +017200 02 FILLER PIC X(20) VALUE SPACE. RL2034.2 +017300 01 CCVS-C-2. RL2034.2 +017400 02 FILLER PIC X VALUE SPACE. RL2034.2 +017500 02 FILLER PIC X(6) VALUE "TESTED". RL2034.2 +017600 02 FILLER PIC X(15) VALUE SPACE. RL2034.2 +017700 02 FILLER PIC X(4) VALUE "FAIL". RL2034.2 +017800 02 FILLER PIC X(94) VALUE SPACE. RL2034.2 +017900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2034.2 +018000 01 REC-CT PIC 99 VALUE ZERO. RL2034.2 +018100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2034.2 +018200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2034.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2034.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2034.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2034.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2034.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2034.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2034.2 +018900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2034.2 +019000 01 CCVS-H-1. RL2034.2 +019100 02 FILLER PIC X(39) VALUE SPACES. RL2034.2 +019200 02 FILLER PIC X(42) VALUE RL2034.2 +019300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2034.2 +019400 02 FILLER PIC X(39) VALUE SPACES. RL2034.2 +019500 01 CCVS-H-2A. RL2034.2 +019600 02 FILLER PIC X(40) VALUE SPACE. RL2034.2 +019700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2034.2 +019800 02 FILLER PIC XXXX VALUE RL2034.2 +019900 "4.2 ". RL2034.2 +020000 02 FILLER PIC X(28) VALUE RL2034.2 +020100 " COPY - NOT FOR DISTRIBUTION". RL2034.2 +020200 02 FILLER PIC X(41) VALUE SPACE. RL2034.2 +020300 RL2034.2 +020400 01 CCVS-H-2B. RL2034.2 +020500 02 FILLER PIC X(15) VALUE RL2034.2 +020600 "TEST RESULT OF ". RL2034.2 +020700 02 TEST-ID PIC X(9). RL2034.2 +020800 02 FILLER PIC X(4) VALUE RL2034.2 +020900 " IN ". RL2034.2 +021000 02 FILLER PIC X(12) VALUE RL2034.2 +021100 " HIGH ". RL2034.2 +021200 02 FILLER PIC X(22) VALUE RL2034.2 +021300 " LEVEL VALIDATION FOR ". RL2034.2 +021400 02 FILLER PIC X(58) VALUE RL2034.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2034.2 +021600 01 CCVS-H-3. RL2034.2 +021700 02 FILLER PIC X(34) VALUE RL2034.2 +021800 " FOR OFFICIAL USE ONLY ". RL2034.2 +021900 02 FILLER PIC X(58) VALUE RL2034.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2034.2 +022100 02 FILLER PIC X(28) VALUE RL2034.2 +022200 " COPYRIGHT 1985 ". RL2034.2 +022300 01 CCVS-E-1. RL2034.2 +022400 02 FILLER PIC X(52) VALUE SPACE. RL2034.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2034.2 +022600 02 ID-AGAIN PIC X(9). RL2034.2 +022700 02 FILLER PIC X(45) VALUE SPACES. RL2034.2 +022800 01 CCVS-E-2. RL2034.2 +022900 02 FILLER PIC X(31) VALUE SPACE. RL2034.2 +023000 02 FILLER PIC X(21) VALUE SPACE. RL2034.2 +023100 02 CCVS-E-2-2. RL2034.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2034.2 +023300 03 FILLER PIC X VALUE SPACE. RL2034.2 +023400 03 ENDER-DESC PIC X(44) VALUE RL2034.2 +023500 "ERRORS ENCOUNTERED". RL2034.2 +023600 01 CCVS-E-3. RL2034.2 +023700 02 FILLER PIC X(22) VALUE RL2034.2 +023800 " FOR OFFICIAL USE ONLY". RL2034.2 +023900 02 FILLER PIC X(12) VALUE SPACE. RL2034.2 +024000 02 FILLER PIC X(58) VALUE RL2034.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2034.2 +024200 02 FILLER PIC X(13) VALUE SPACE. RL2034.2 +024300 02 FILLER PIC X(15) VALUE RL2034.2 +024400 " COPYRIGHT 1985". RL2034.2 +024500 01 CCVS-E-4. RL2034.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2034.2 +024700 02 FILLER PIC X(4) VALUE " OF ". RL2034.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2034.2 +024900 02 FILLER PIC X(40) VALUE RL2034.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". RL2034.2 +025100 01 XXINFO. RL2034.2 +025200 02 FILLER PIC X(19) VALUE RL2034.2 +025300 "*** INFORMATION ***". RL2034.2 +025400 02 INFO-TEXT. RL2034.2 +025500 04 FILLER PIC X(8) VALUE SPACE. RL2034.2 +025600 04 XXCOMPUTED PIC X(20). RL2034.2 +025700 04 FILLER PIC X(5) VALUE SPACE. RL2034.2 +025800 04 XXCORRECT PIC X(20). RL2034.2 +025900 02 INF-ANSI-REFERENCE PIC X(48). RL2034.2 +026000 01 HYPHEN-LINE. RL2034.2 +026100 02 FILLER PIC IS X VALUE IS SPACE. RL2034.2 +026200 02 FILLER PIC IS X(65) VALUE IS "************************RL2034.2 +026300- "*****************************************". RL2034.2 +026400 02 FILLER PIC IS X(54) VALUE IS "************************RL2034.2 +026500- "******************************". RL2034.2 +026600 01 CCVS-PGM-ID PIC X(9) VALUE RL2034.2 +026700 "RL203A". RL2034.2 +026800 PROCEDURE DIVISION. RL2034.2 +026900 CCVS1 SECTION. RL2034.2 +027000 OPEN-FILES. RL2034.2 +027100 OPEN OUTPUT PRINT-FILE. RL2034.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2034.2 +027300 MOVE SPACE TO TEST-RESULTS. RL2034.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2034.2 +027500 MOVE ZERO TO REC-SKL-SUB. RL2034.2 +027600 PERFORM CCVS-INIT-FILE 9 TIMES. RL2034.2 +027700 CCVS-INIT-FILE. RL2034.2 +027800 ADD 1 TO REC-SKL-SUB. RL2034.2 +027900 MOVE FILE-RECORD-INFO-SKELETON RL2034.2 +028000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2034.2 +028100 CCVS-INIT-EXIT. RL2034.2 +028200 GO TO CCVS1-EXIT. RL2034.2 +028300 CLOSE-FILES. RL2034.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2034.2 +028500 TERMINATE-CCVS. RL2034.2 +028600*S EXIT PROGRAM. RL2034.2 +028700*SERMINATE-CALL. RL2034.2 +028800 STOP RUN. RL2034.2 +028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2034.2 +029000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2034.2 +029100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2034.2 +029200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2034.2 +029300 MOVE "****TEST DELETED****" TO RE-MARK. RL2034.2 +029400 PRINT-DETAIL. RL2034.2 +029500 IF REC-CT NOT EQUAL TO ZERO RL2034.2 +029600 MOVE "." TO PARDOT-X RL2034.2 +029700 MOVE REC-CT TO DOTVALUE. RL2034.2 +029800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2034.2 +029900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2034.2 +030000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2034.2 +030100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2034.2 +030200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2034.2 +030300 MOVE SPACE TO CORRECT-X. RL2034.2 +030400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2034.2 +030500 MOVE SPACE TO RE-MARK. RL2034.2 +030600 HEAD-ROUTINE. RL2034.2 +030700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +030800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +030900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2034.2 +031000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2034.2 +031100 COLUMN-NAMES-ROUTINE. RL2034.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +031500 END-ROUTINE. RL2034.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2034.2 +031700 END-RTN-EXIT. RL2034.2 +031800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +031900 END-ROUTINE-1. RL2034.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2034.2 +032100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2034.2 +032200 ADD PASS-COUNTER TO ERROR-HOLD. RL2034.2 +032300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2034.2 +032400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2034.2 +032500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2034.2 +032600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2034.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2034.2 +032800 END-ROUTINE-12. RL2034.2 +032900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2034.2 +033000 IF ERROR-COUNTER IS EQUAL TO ZERO RL2034.2 +033100 MOVE "NO " TO ERROR-TOTAL RL2034.2 +033200 ELSE RL2034.2 +033300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2034.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2034.2 +033500 PERFORM WRITE-LINE. RL2034.2 +033600 END-ROUTINE-13. RL2034.2 +033700 IF DELETE-COUNTER IS EQUAL TO ZERO RL2034.2 +033800 MOVE "NO " TO ERROR-TOTAL ELSE RL2034.2 +033900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2034.2 +034000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2034.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +034200 IF INSPECT-COUNTER EQUAL TO ZERO RL2034.2 +034300 MOVE "NO " TO ERROR-TOTAL RL2034.2 +034400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2034.2 +034500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2034.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +034700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2034.2 +034800 WRITE-LINE. RL2034.2 +034900 ADD 1 TO RECORD-COUNT. RL2034.2 +035000 IF RECORD-COUNT GREATER 50 RL2034.2 +035100 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2034.2 +035200 MOVE SPACE TO DUMMY-RECORD RL2034.2 +035300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2034.2 +035400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2034.2 +035500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2034.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2034.2 +035700 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2034.2 +035800 MOVE ZERO TO RECORD-COUNT. RL2034.2 +035900 PERFORM WRT-LN. RL2034.2 +036000 WRT-LN. RL2034.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2034.2 +036200 MOVE SPACE TO DUMMY-RECORD. RL2034.2 +036300 BLANK-LINE-PRINT. RL2034.2 +036400 PERFORM WRT-LN. RL2034.2 +036500 FAIL-ROUTINE. RL2034.2 +036600 IF COMPUTED-X NOT EQUAL TO SPACE RL2034.2 +036700 GO TO FAIL-ROUTINE-WRITE. RL2034.2 +036800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2034.2 +036900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2034.2 +037000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2034.2 +037100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +037200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2034.2 +037300 GO TO FAIL-ROUTINE-EX. RL2034.2 +037400 FAIL-ROUTINE-WRITE. RL2034.2 +037500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2034.2 +037600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2034.2 +037700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2034.2 +037800 MOVE SPACES TO COR-ANSI-REFERENCE. RL2034.2 +037900 FAIL-ROUTINE-EX. EXIT. RL2034.2 +038000 BAIL-OUT. RL2034.2 +038100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2034.2 +038200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2034.2 +038300 BAIL-OUT-WRITE. RL2034.2 +038400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2034.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2034.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2034.2 +038700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2034.2 +038800 BAIL-OUT-EX. EXIT. RL2034.2 +038900 CCVS1-EXIT. RL2034.2 +039000 EXIT. RL2034.2 +039100 SECT-RL-03-001 SECTION. RL2034.2 +039200 REL-INIT-006. RL2034.2 +039300 MOVE 99 TO RL-FD1-KEY. RL2034.2 +039400* CONTAIN THE NUMBER OF THE RECORD PREVIOUSLY READ. RL2034.2 +039500 OPEN INPUT RL-FD1. RL2034.2 +039600 MOVE "REL-TEST-006" TO PAR-NAME. RL2034.2 +039700 MOVE ZERO TO WRK-CS-09V00-006. RL2034.2 +039800 MOVE ZERO TO WRK-CS-09V00-007. RL2034.2 +039900 MOVE ZERO TO WRK-CS-09V00-008. RL2034.2 +040000 MOVE ZERO TO WRK-CS-09V00-009. RL2034.2 +040100 MOVE ZERO TO WRK-CS-09V00-010. RL2034.2 +040200 MOVE ZERO TO WRK-CS-09V00-011. RL2034.2 +040300 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +040400 MOVE RL-FD1-KEY TO WRK-CS-09V00-011. RL2034.2 +040500 MOVE 01 TO REC-CT. RL2034.2 +040600 MOVE "READ SEQUENTIAL" TO FEATURE. RL2034.2 +040700 REL-TEST-006-R. RL2034.2 +040800 ADD 1 TO WRK-CS-09V00-006. RL2034.2 +040900 READ RL-FD1 NEXT RECORD RL2034.2 +041000 AT END GO TO REL-TEST-006-3. RL2034.2 +041100 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +041200 IF UPDATE-NUMBER (1) EQUAL TO 00 RL2034.2 +041300 ADD 1 TO WRK-CS-09V00-007 RL2034.2 +041400 GO TO REL-TEST-006-2. RL2034.2 +041500 IF UPDATE-NUMBER (1) EQUAL TO 01 RL2034.2 +041600 ADD 1 TO WRK-CS-09V00-008 RL2034.2 +041700 GO TO REL-TEST-006-2. RL2034.2 +041800 ADD 1 TO WRK-CS-09V00-009. RL2034.2 +041900 REL-TEST-006-2. RL2034.2 +042000 IF RL-FD1-KEY NOT EQUAL TO XRECORD-NUMBER (1) RL2034.2 +042100 ADD 1 TO WRK-CS-09V00-010. RL2034.2 +042200 IF WRK-CS-09V00-006 GREATER 501 RL2034.2 +042300 GO TO REL-TEST-006-3. RL2034.2 +042400 GO TO REL-TEST-006-R. RL2034.2 +042500 REL-TEST-006-3. RL2034.2 +042600 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL2034.2 +042700 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2034.2 +042800 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2034.2 +042900 MOVE 501 TO CORRECT-18V0 RL2034.2 +043000 PERFORM FAIL RL2034.2 +043100 ELSE RL2034.2 +043200 PERFORM PASS. RL2034.2 +043300 PERFORM PRINT-DETAIL. RL2034.2 +043400* .01 RL2034.2 +043500 ADD 1 TO REC-CT. RL2034.2 +043600 IF WRK-CS-09V00-007 EQUAL TO 400 RL2034.2 +043700 PERFORM PASS RL2034.2 +043800 ELSE RL2034.2 +043900 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL2034.2 +044000 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 RL2034.2 +044100 MOVE "SHOULD BE 400" TO RE-MARK RL2034.2 +044200 PERFORM FAIL. RL2034.2 +044300 PERFORM PRINT-DETAIL. RL2034.2 +044400 ADD 1 TO REC-CT. RL2034.2 +044500* .02 RL2034.2 +044600 IF WRK-CS-09V00-008 EQUAL TO 100 RL2034.2 +044700 PERFORM PASS RL2034.2 +044800 ELSE RL2034.2 +044900 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL2034.2 +045000 MOVE 100 TO CORRECT-18V0 RL2034.2 +045100 MOVE "UPDATED RECORDS" TO RE-MARK RL2034.2 +045200 PERFORM FAIL. RL2034.2 +045300 PERFORM PRINT-DETAIL. RL2034.2 +045400 ADD 1 TO REC-CT. RL2034.2 +045500* .03 RL2034.2 +045600 IF WRK-CS-09V00-009 EQUAL TO ZERO RL2034.2 +045700 PERFORM PASS RL2034.2 +045800 ELSE RL2034.2 +045900 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL2034.2 +046000 MOVE ZERO TO CORRECT-18V0 RL2034.2 +046100 MOVE "BAD-UPDATES" TO RE-MARK RL2034.2 +046200 PERFORM FAIL. RL2034.2 +046300 PERFORM PRINT-DETAIL. RL2034.2 +046400 ADD 01 TO REC-CT. RL2034.2 +046500* .04 RL2034.2 +046600 IF WRK-CS-09V00-010 EQUAL TO ZERO RL2034.2 +046700 PERFORM PASS RL2034.2 +046800 ELSE RL2034.2 +046900 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL2034.2 +047000 MOVE ZERO TO CORRECT-18V0 RL2034.2 +047100 MOVE "KEY VS RECORD" TO RE-MARK RL2034.2 +047200 PERFORM FAIL. RL2034.2 +047300 PERFORM PRINT-DETAIL. RL2034.2 +047400 ADD 01 TO REC-CT. RL2034.2 +047500* .05 RL2034.2 +047600 MOVE WRK-CS-09V00-011 TO RL-FD1-KEY. RL2034.2 +047700 MOVE RL-FD1-KEY TO COMPUTED-18V0. RL2034.2 +047800 MOVE "INFORMATION" TO CORRECT-A. RL2034.2 +047900 MOVE "STATUS AFTER OPEN" TO RE-MARK. RL2034.2 +048000 PERFORM PRINT-DETAIL. RL2034.2 +048100 ADD 01 TO REC-CT. RL2034.2 +048200* .06 RL2034.2 +048300 CLOSE RL-FD1. RL2034.2 +048400 REL-INIT-007. RL2034.2 +048500 MOVE "REL-TEST-007" TO PAR-NAME RL2034.2 +048600 OPEN I-O RL-FD1. RL2034.2 +048700 MOVE ZERO TO WRK-CS-09V00-006 RL2034.2 +048800 MOVE ZERO TO WRK-CS-09V00-007 RL2034.2 +048900 MOVE ZERO TO WRK-CS-09V00-008 RL2034.2 +049000 MOVE ZERO TO WRK-CS-09V00-009 RL2034.2 +049100 MOVE ZERO TO WRK-CS-09V00-010 RL2034.2 +049200 MOVE ZERO TO WRK-CS-09V00-011 RL2034.2 +049300 MOVE 01 TO REC-CT. RL2034.2 +049400 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +049500 MOVE "DELETE" TO FEATURE. RL2034.2 +049600 REL-TEST-007-R. RL2034.2 +049700 ADD 1 TO WRK-CS-09V00-006 RL2034.2 +049800 ADD 1 TO WRK-CS-09V00-007. RL2034.2 +049900 READ RL-FD1 NEXT RECORD RL2034.2 +050000 AT END RL2034.2 +050100 MOVE "AT END PATH TAKEN " TO RE-MARK RL2034.2 +050200 GO TO REL-TEST-007-3. RL2034.2 +050300 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +050400 IF WRK-CS-09V00-007 EQUAL TO 4 RL2034.2 +050500 GO TO REL-TEST-007-2. RL2034.2 +050600 IF WRK-CS-09V00-006 GREATER 501 RL2034.2 +050700 MOVE "AT END NOT TAKEN" TO RE-MARK RL2034.2 +050800 GO TO REL-TEST-007-3. RL2034.2 +050900 GO TO REL-TEST-007-R. RL2034.2 +051000 REL-TEST-007-2. RL2034.2 +051100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2034.2 +051200 MOVE 99 TO UPDATE-NUMBER (1). RL2034.2 +051300 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-120. RL2034.2 +051400 DELETE RL-FD1 RL2034.2 +051500 INVALID KEY GO TO REL-TEST-007-3. RL2034.2 +051600 MOVE ZERO TO WRK-CS-09V00-007. RL2034.2 +051700 ADD 1 TO WRK-CS-09V00-008 RL2034.2 +051800 GO TO REL-TEST-007-R. RL2034.2 +051900 REL-TEST-007-3. RL2034.2 +052000 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL2034.2 +052100 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2034.2 +052200 MOVE 501 TO CORRECT-18V0 RL2034.2 +052300 PERFORM FAIL RL2034.2 +052400 ELSE RL2034.2 +052500 PERFORM PASS. RL2034.2 +052600 PERFORM PRINT-DETAIL. RL2034.2 +052700 ADD 01 TO REC-CT. RL2034.2 +052800* .01 RL2034.2 +052900 IF WRK-CS-09V00-008 NOT EQUAL TO 125 RL2034.2 +053000 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL2034.2 +053100 MOVE 125 TO CORRECT-18V0 RL2034.2 +053200 MOVE "DELETED RECORDS" TO RE-MARK RL2034.2 +053300 PERFORM FAIL RL2034.2 +053400 ELSE RL2034.2 +053500 PERFORM PASS. RL2034.2 +053600 PERFORM PRINT-DETAIL. RL2034.2 +053700 ADD 01 TO REC-CT. RL2034.2 +053800* .02 RL2034.2 +053900 CLOSE RL-FD1. RL2034.2 +054000 REL-INIT-008. RL2034.2 +054100 MOVE "REL-TEST-008" TO PAR-NAME. RL2034.2 +054200 MOVE ZERO TO WRK-CS-09V00-006 RL2034.2 +054300 MOVE ZERO TO WRK-CS-09V00-007 RL2034.2 +054400 MOVE ZERO TO WRK-CS-09V00-008 RL2034.2 +054500 MOVE ZERO TO WRK-CS-09V00-009 RL2034.2 +054600 MOVE ZERO TO WRK-CS-09V00-010 RL2034.2 +054700 MOVE ZERO TO WRK-CS-09V00-011 RL2034.2 +054800 MOVE 01 TO REC-CT. RL2034.2 +054900 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +055000 MOVE ZERO TO RL-FD1-KEY. RL2034.2 +055100 OPEN INPUT RL-FD1. RL2034.2 +055200 MOVE "READ UPDATED FILE" TO FEATURE. RL2034.2 +055300 REL-TEST-008-R. RL2034.2 +055400 ADD 1 TO WRK-CS-09V00-006. RL2034.2 +055500 ADD 1 TO WRK-CS-09V00-007. RL2034.2 +055600 ADD 1 TO WRK-CS-09V00-008. RL2034.2 +055700 READ RL-FD1 NEXT RECORD AT END GO TO REL-TEST-008-3. RL2034.2 +055800 MOVE RL-FD1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2034.2 +055900 IF UPDATE-NUMBER (1) EQUAL TO 99 RL2034.2 +056000 ADD 1 TO WRK-CS-09V00-009. RL2034.2 +056100 IF WRK-CS-09V00-007 EQUAL TO 4 RL2034.2 +056200 MOVE 01 TO WRK-CS-09V00-007 RL2034.2 +056300 ADD 1 TO WRK-CS-09V00-008. RL2034.2 +056400 IF RL-FD1-KEY EQUAL TO XRECORD-NUMBER (1) RL2034.2 +056500 ADD 1 TO WRK-CS-09V00-010. RL2034.2 +056600 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 RL2034.2 +056700 ADD 1 TO WRK-CS-09V00-011. RL2034.2 +056800 IF WRK-CS-09V00-006 GREATER 501 RL2034.2 +056900 GO TO REL-TEST-008-3. RL2034.2 +057000 GO TO REL-TEST-008-R. RL2034.2 +057100 REL-TEST-008-3. RL2034.2 +057200 IF WRK-CS-09V00-006 NOT EQUAL TO 376 RL2034.2 +057300 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2034.2 +057400 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2034.2 +057500 MOVE 376 TO CORRECT-18V0 RL2034.2 +057600 PERFORM FAIL RL2034.2 +057700 ELSE RL2034.2 +057800 PERFORM PASS. RL2034.2 +057900 PERFORM PRINT-DETAIL. RL2034.2 +058000 ADD 01 TO REC-CT. RL2034.2 +058100* .01 RL2034.2 +058200 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO RL2034.2 +058300 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL2034.2 +058400 MOVE ZERO TO CORRECT-18V0 RL2034.2 +058500 MOVE "DELETED RECORDS" TO RE-MARK RL2034.2 +058600 PERFORM FAIL RL2034.2 +058700 ELSE RL2034.2 +058800 PERFORM PASS. RL2034.2 +058900 PERFORM PRINT-DETAIL. RL2034.2 +059000 ADD 01 TO REC-CT. RL2034.2 +059100* .02 RL2034.2 +059200 IF WRK-CS-09V00-010 NOT EQUAL TO 375 RL2034.2 +059300 MOVE "KEY MISMATCH" TO RE-MARK RL2034.2 +059400 MOVE 375 TO CORRECT-18V0 RL2034.2 +059500 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL2034.2 +059600 PERFORM FAIL RL2034.2 +059700 ELSE RL2034.2 +059800 PERFORM PASS. RL2034.2 +059900 PERFORM PRINT-DETAIL. RL2034.2 +060000 ADD 01 TO REC-CT. RL2034.2 +060100* .03 RL2034.2 +060200 IF WRK-CS-09V00-011 NOT EQUAL TO 375 RL2034.2 +060300 MOVE 375 TO CORRECT-18V0 RL2034.2 +060400 MOVE "INCORRECT RECORD FOUND" TO RE-MARK RL2034.2 +060500 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 RL2034.2 +060600 PERFORM FAIL RL2034.2 +060700 ELSE RL2034.2 +060800 PERFORM PASS. RL2034.2 +060900 PERFORM PRINT-DETAIL. RL2034.2 +061000*04 RL2034.2 +061100 CLOSE RL-FD1. RL2034.2 +061200 CCVS-EXIT SECTION. RL2034.2 +061300 CCVS-999999. RL2034.2 +061400 GO TO CLOSE-FILES. RL2034.2 diff --git a/tests/cobol85/RL/RL204A.CBL b/tests/cobol85/RL/RL204A.CBL new file mode 100644 index 00000000..8440f610 --- /dev/null +++ b/tests/cobol85/RL/RL204A.CBL @@ -0,0 +1,644 @@ +000100 IDENTIFICATION DIVISION. RL2044.2 +000200 PROGRAM-ID. RL2044.2 +000300 RL204A. RL2044.2 +000400**************************************************************** RL2044.2 +000500* * RL2044.2 +000600* VALIDATION FOR:- * RL2044.2 +000700* * RL2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2044.2 +000900* * RL2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2044.2 +001100* * RL2044.2 +001200**************************************************************** RL2044.2 +001300* THIS PROGRAM TESTS THE SYNTACTICAL CONSTRUCTS AND RL2044.2 +001400* SEMANTIC ACTIONS ASSOCIATED WITH THE FOLLOWING RL2044.2 +001500* ELEMENTS: RL2044.2 +001600* RL2044.2 +001700* (1) FILE STATUS RL2044.2 +001800* (2) USE AFTER EXCEPTION PROCEDURE ON FILE-NAME RL2044.2 +001900* (3) READ RL2044.2 +002000* (4) WRITE RL2044.2 +002100* (5) REWRITE RL2044.2 +002200* (6) RELATIVE KEY RL2044.2 +002300* (7) ACCESS MODE RL2044.2 +002400* RL2044.2 +002500* THIS PROGRAM CREATES A RELATIVE I-O FILE SEQUENTIALLYRL2044.2 +002600* (ACCESS MODE DYNAMIC) AND THEN UPDATES SELECTIVE RL2044.2 +002700* RECORDS OF THE FILE. THE FILE STATUS CONTENTS ARE RL2044.2 +002800* CAPTURED AND TESTED FOR ACCURACY FOR EACH OPEN, CLOSERL2044.2 +002900* READ AND REWRITE STATEMENT USED. THE READ, WRITE ANDRL2044.2 +003000* REWRITE STATEMENTS ARE USED WITHOUT THE APPROPRIATE RL2044.2 +003100* AT END ON INVALID KEY PHRASES. THE OMISSION OF THESERL2044.2 +003200* PHRASES ARE PERMITTED IF AN APPLICABLE USE PROCEDURE RL2044.2 +003300* HAS BEEN SPECIFIED. RL2044.2 +003400* RL2044.2 +003500* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2044.2 +003600* PROGRAM ARE: RL2044.2 +003700* RL2044.2 +003800* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2044.2 +003900* RELATIVE I-O DATA FILE RL2044.2 +004000* X-55 SYSTEM PRINTER RL2044.2 +004100* X-69 ADDITIONAL VALUE OF CLAUSES RL2044.2 +004200* X-74 VALUE OF IMPLEMENTOR-NAME RL2044.2 +004300* X-75 OBJECT OF VALUE OF CLAUSE RL2044.2 +004400* X-82 SOURCE-COMPUTER RL2044.2 +004500* X-83 OBJECT-COMPUTER. RL2044.2 +004600* RL2044.2 +004700*************************************************** RL2044.2 +004800 ENVIRONMENT DIVISION. RL2044.2 +004900 CONFIGURATION SECTION. RL2044.2 +005000 SOURCE-COMPUTER. RL2044.2 +005100 Linux. RL2044.2 +005200 OBJECT-COMPUTER. RL2044.2 +005300 Linux. RL2044.2 +005400 INPUT-OUTPUT SECTION. RL2044.2 +005500 FILE-CONTROL. RL2044.2 +005600 SELECT PRINT-FILE ASSIGN TO RL2044.2 +005700 "report.log". RL2044.2 +005800 SELECT RL-FD2 ASSIGN RL2044.2 +005900 "XXXXX022" RL2044.2 +006000 ORGANIZATION RELATIVE RL2044.2 +006100 ACCESS DYNAMIC RL2044.2 +006200 RELATIVE RL-FD2-KEY RL2044.2 +006300 FILE STATUS IS RL-FD2-STATUS. RL2044.2 +006400 DATA DIVISION. RL2044.2 +006500 FILE SECTION. RL2044.2 +006600 FD PRINT-FILE. RL2044.2 +006700 01 PRINT-REC PICTURE X(120). RL2044.2 +006800 01 DUMMY-RECORD PICTURE X(120). RL2044.2 +006900 FD RL-FD2 RL2044.2 +007000*C VALUE OF RL2044.2 +007100*C OCLABELID RL2044.2 +007200*C IS RL2044.2 +007300*C "OCDUMMY" RL2044.2 +007400*G SYSIN RL2044.2 +007500 LABEL RECORDS ARE STANDARD RL2044.2 +007600 BLOCK CONTAINS 1 RECORDS RL2044.2 +007700 DATA RECORD RL-FD2R1-F-G-240. RL2044.2 +007800 01 RL-FD2R1-F-G-240. RL2044.2 +007900 05 RL-FD2-WRK-120 PIC X(120). RL2044.2 +008000 05 RL-FD2-GRP-120. RL2044.2 +008100 10 RL-FD2-WRK-XN-0001-O120F RL2044.2 +008200 PICTURE X OCCURS 120 TIMES. RL2044.2 +008300 WORKING-STORAGE SECTION. RL2044.2 +008400 01 GRP-0001. RL2044.2 +008500 05 RL-FD2-KEY PIC 9(8) VALUE ZERO. RL2044.2 +008600 05 WRK-CS-09V00-012 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +008700 05 WRK-CS-09V00-013 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +008800 05 WRK-CS-09V00-014 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +008900 05 WRK-CS-09V00-015 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +009000 05 WRK-CS-09V00-016 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +009100 05 WRK-CS-09V00-017 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +009200 05 WRK-CS-09V00-018 PIC S9(9) USAGE COMP VALUE ZERO. RL2044.2 +009300 05 RL-FD2-STATUS PIC XX VALUE SPACE. RL2044.2 +009400 05 WRK-XN-0002-001 PIC X(2) VALUE SPACE. RL2044.2 +009500 05 WRK-XN-0002-002 PIC X(2) VALUE SPACE. RL2044.2 +009600 05 WRK-XN-0002-003 PIC X(2) VALUE SPACE. RL2044.2 +009700 05 WRK-XN-0002-004 PIC X(2) VALUE SPACE. RL2044.2 +009800 05 WRK-XN-0002-005 PIC X(2) VALUE SPACE. RL2044.2 +009900 05 WRK-XN-0002-006 PIC X(2) VALUE SPACE. RL2044.2 +010000 05 WRK-XN-0002-007 PIC X(2) VALUE SPACE. RL2044.2 +010100 05 WRK-XN-0002-008 PIC X(2) VALUE SPACE. RL2044.2 +010200 05 WRK-XN-0002-009 PIC X(2) VALUE SPACE. RL2044.2 +010300 01 FILE-RECORD-INFORMATION-REC. RL2044.2 +010400 03 FILE-RECORD-INFO-SKELETON. RL2044.2 +010500 05 FILLER PICTURE X(48) VALUE RL2044.2 +010600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2044.2 +010700 05 FILLER PICTURE X(46) VALUE RL2044.2 +010800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2044.2 +010900 05 FILLER PICTURE X(26) VALUE RL2044.2 +011000 ",LFIL=000000,ORG= ,LBLR= ". RL2044.2 +011100 05 FILLER PICTURE X(37) VALUE RL2044.2 +011200 ",RECKEY= ". RL2044.2 +011300 05 FILLER PICTURE X(38) VALUE RL2044.2 +011400 ",ALTKEY1= ". RL2044.2 +011500 05 FILLER PICTURE X(38) VALUE RL2044.2 +011600 ",ALTKEY2= ". RL2044.2 +011700 05 FILLER PICTURE X(7) VALUE SPACE.RL2044.2 +011800 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2044.2 +011900 05 FILE-RECORD-INFO-P1-120. RL2044.2 +012000 07 FILLER PIC X(5). RL2044.2 +012100 07 XFILE-NAME PIC X(6). RL2044.2 +012200 07 FILLER PIC X(8). RL2044.2 +012300 07 XRECORD-NAME PIC X(6). RL2044.2 +012400 07 FILLER PIC X(1). RL2044.2 +012500 07 REELUNIT-NUMBER PIC 9(1). RL2044.2 +012600 07 FILLER PIC X(7). RL2044.2 +012700 07 XRECORD-NUMBER PIC 9(6). RL2044.2 +012800 07 FILLER PIC X(6). RL2044.2 +012900 07 UPDATE-NUMBER PIC 9(2). RL2044.2 +013000 07 FILLER PIC X(5). RL2044.2 +013100 07 ODO-NUMBER PIC 9(4). RL2044.2 +013200 07 FILLER PIC X(5). RL2044.2 +013300 07 XPROGRAM-NAME PIC X(5). RL2044.2 +013400 07 FILLER PIC X(7). RL2044.2 +013500 07 XRECORD-LENGTH PIC 9(6). RL2044.2 +013600 07 FILLER PIC X(7). RL2044.2 +013700 07 CHARS-OR-RECORDS PIC X(2). RL2044.2 +013800 07 FILLER PIC X(1). RL2044.2 +013900 07 XBLOCK-SIZE PIC 9(4). RL2044.2 +014000 07 FILLER PIC X(6). RL2044.2 +014100 07 RECORDS-IN-FILE PIC 9(6). RL2044.2 +014200 07 FILLER PIC X(5). RL2044.2 +014300 07 XFILE-ORGANIZATION PIC X(2). RL2044.2 +014400 07 FILLER PIC X(6). RL2044.2 +014500 07 XLABEL-TYPE PIC X(1). RL2044.2 +014600 05 FILE-RECORD-INFO-P121-240. RL2044.2 +014700 07 FILLER PIC X(8). RL2044.2 +014800 07 XRECORD-KEY PIC X(29). RL2044.2 +014900 07 FILLER PIC X(9). RL2044.2 +015000 07 ALTERNATE-KEY1 PIC X(29). RL2044.2 +015100 07 FILLER PIC X(9). RL2044.2 +015200 07 ALTERNATE-KEY2 PIC X(29). RL2044.2 +015300 07 FILLER PIC X(7). RL2044.2 +015400 01 TEST-RESULTS. RL2044.2 +015500 02 FILLER PIC X VALUE SPACE. RL2044.2 +015600 02 FEATURE PIC X(20) VALUE SPACE. RL2044.2 +015700 02 FILLER PIC X VALUE SPACE. RL2044.2 +015800 02 P-OR-F PIC X(5) VALUE SPACE. RL2044.2 +015900 02 FILLER PIC X VALUE SPACE. RL2044.2 +016000 02 PAR-NAME. RL2044.2 +016100 03 FILLER PIC X(19) VALUE SPACE. RL2044.2 +016200 03 PARDOT-X PIC X VALUE SPACE. RL2044.2 +016300 03 DOTVALUE PIC 99 VALUE ZERO. RL2044.2 +016400 02 FILLER PIC X(8) VALUE SPACE. RL2044.2 +016500 02 RE-MARK PIC X(61). RL2044.2 +016600 01 TEST-COMPUTED. RL2044.2 +016700 02 FILLER PIC X(30) VALUE SPACE. RL2044.2 +016800 02 FILLER PIC X(17) VALUE RL2044.2 +016900 " COMPUTED=". RL2044.2 +017000 02 COMPUTED-X. RL2044.2 +017100 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2044.2 +017200 03 COMPUTED-N REDEFINES COMPUTED-A RL2044.2 +017300 PIC -9(9).9(9). RL2044.2 +017400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2044.2 +017500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2044.2 +017600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2044.2 +017700 03 CM-18V0 REDEFINES COMPUTED-A. RL2044.2 +017800 04 COMPUTED-18V0 PIC -9(18). RL2044.2 +017900 04 FILLER PIC X. RL2044.2 +018000 03 FILLER PIC X(50) VALUE SPACE. RL2044.2 +018100 01 TEST-CORRECT. RL2044.2 +018200 02 FILLER PIC X(30) VALUE SPACE. RL2044.2 +018300 02 FILLER PIC X(17) VALUE " CORRECT =". RL2044.2 +018400 02 CORRECT-X. RL2044.2 +018500 03 CORRECT-A PIC X(20) VALUE SPACE. RL2044.2 +018600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2044.2 +018700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2044.2 +018800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2044.2 +018900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2044.2 +019000 03 CR-18V0 REDEFINES CORRECT-A. RL2044.2 +019100 04 CORRECT-18V0 PIC -9(18). RL2044.2 +019200 04 FILLER PIC X. RL2044.2 +019300 03 FILLER PIC X(2) VALUE SPACE. RL2044.2 +019400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2044.2 +019500 01 CCVS-C-1. RL2044.2 +019600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2044.2 +019700- "SS PARAGRAPH-NAME RL2044.2 +019800- " REMARKS". RL2044.2 +019900 02 FILLER PIC X(20) VALUE SPACE. RL2044.2 +020000 01 CCVS-C-2. RL2044.2 +020100 02 FILLER PIC X VALUE SPACE. RL2044.2 +020200 02 FILLER PIC X(6) VALUE "TESTED". RL2044.2 +020300 02 FILLER PIC X(15) VALUE SPACE. RL2044.2 +020400 02 FILLER PIC X(4) VALUE "FAIL". RL2044.2 +020500 02 FILLER PIC X(94) VALUE SPACE. RL2044.2 +020600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2044.2 +020700 01 REC-CT PIC 99 VALUE ZERO. RL2044.2 +020800 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2044.2 +020900 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2044.2 +021000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2044.2 +021100 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2044.2 +021200 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2044.2 +021300 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2044.2 +021400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2044.2 +021500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2044.2 +021600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2044.2 +021700 01 CCVS-H-1. RL2044.2 +021800 02 FILLER PIC X(39) VALUE SPACES. RL2044.2 +021900 02 FILLER PIC X(42) VALUE RL2044.2 +022000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2044.2 +022100 02 FILLER PIC X(39) VALUE SPACES. RL2044.2 +022200 01 CCVS-H-2A. RL2044.2 +022300 02 FILLER PIC X(40) VALUE SPACE. RL2044.2 +022400 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2044.2 +022500 02 FILLER PIC XXXX VALUE RL2044.2 +022600 "4.2 ". RL2044.2 +022700 02 FILLER PIC X(28) VALUE RL2044.2 +022800 " COPY - NOT FOR DISTRIBUTION". RL2044.2 +022900 02 FILLER PIC X(41) VALUE SPACE. RL2044.2 +023000 RL2044.2 +023100 01 CCVS-H-2B. RL2044.2 +023200 02 FILLER PIC X(15) VALUE RL2044.2 +023300 "TEST RESULT OF ". RL2044.2 +023400 02 TEST-ID PIC X(9). RL2044.2 +023500 02 FILLER PIC X(4) VALUE RL2044.2 +023600 " IN ". RL2044.2 +023700 02 FILLER PIC X(12) VALUE RL2044.2 +023800 " HIGH ". RL2044.2 +023900 02 FILLER PIC X(22) VALUE RL2044.2 +024000 " LEVEL VALIDATION FOR ". RL2044.2 +024100 02 FILLER PIC X(58) VALUE RL2044.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2044.2 +024300 01 CCVS-H-3. RL2044.2 +024400 02 FILLER PIC X(34) VALUE RL2044.2 +024500 " FOR OFFICIAL USE ONLY ". RL2044.2 +024600 02 FILLER PIC X(58) VALUE RL2044.2 +024700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2044.2 +024800 02 FILLER PIC X(28) VALUE RL2044.2 +024900 " COPYRIGHT 1985 ". RL2044.2 +025000 01 CCVS-E-1. RL2044.2 +025100 02 FILLER PIC X(52) VALUE SPACE. RL2044.2 +025200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2044.2 +025300 02 ID-AGAIN PIC X(9). RL2044.2 +025400 02 FILLER PIC X(45) VALUE SPACES. RL2044.2 +025500 01 CCVS-E-2. RL2044.2 +025600 02 FILLER PIC X(31) VALUE SPACE. RL2044.2 +025700 02 FILLER PIC X(21) VALUE SPACE. RL2044.2 +025800 02 CCVS-E-2-2. RL2044.2 +025900 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2044.2 +026000 03 FILLER PIC X VALUE SPACE. RL2044.2 +026100 03 ENDER-DESC PIC X(44) VALUE RL2044.2 +026200 "ERRORS ENCOUNTERED". RL2044.2 +026300 01 CCVS-E-3. RL2044.2 +026400 02 FILLER PIC X(22) VALUE RL2044.2 +026500 " FOR OFFICIAL USE ONLY". RL2044.2 +026600 02 FILLER PIC X(12) VALUE SPACE. RL2044.2 +026700 02 FILLER PIC X(58) VALUE RL2044.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2044.2 +026900 02 FILLER PIC X(13) VALUE SPACE. RL2044.2 +027000 02 FILLER PIC X(15) VALUE RL2044.2 +027100 " COPYRIGHT 1985". RL2044.2 +027200 01 CCVS-E-4. RL2044.2 +027300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2044.2 +027400 02 FILLER PIC X(4) VALUE " OF ". RL2044.2 +027500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2044.2 +027600 02 FILLER PIC X(40) VALUE RL2044.2 +027700 " TESTS WERE EXECUTED SUCCESSFULLY". RL2044.2 +027800 01 XXINFO. RL2044.2 +027900 02 FILLER PIC X(19) VALUE RL2044.2 +028000 "*** INFORMATION ***". RL2044.2 +028100 02 INFO-TEXT. RL2044.2 +028200 04 FILLER PIC X(8) VALUE SPACE. RL2044.2 +028300 04 XXCOMPUTED PIC X(20). RL2044.2 +028400 04 FILLER PIC X(5) VALUE SPACE. RL2044.2 +028500 04 XXCORRECT PIC X(20). RL2044.2 +028600 02 INF-ANSI-REFERENCE PIC X(48). RL2044.2 +028700 01 HYPHEN-LINE. RL2044.2 +028800 02 FILLER PIC IS X VALUE IS SPACE. RL2044.2 +028900 02 FILLER PIC IS X(65) VALUE IS "************************RL2044.2 +029000- "*****************************************". RL2044.2 +029100 02 FILLER PIC IS X(54) VALUE IS "************************RL2044.2 +029200- "******************************". RL2044.2 +029300 01 CCVS-PGM-ID PIC X(9) VALUE RL2044.2 +029400 "RL204A". RL2044.2 +029500 PROCEDURE DIVISION. RL2044.2 +029600 DECLARATIVES. RL2044.2 +029700 RL-FD2-01 SECTION. RL2044.2 +029800 USE AFTER STANDARD EXCEPTION PROCEDURE ON RL-FD2. RL2044.2 +029900 RL-FD2-01-01. RL2044.2 +030000 ADD 1 TO WRK-CS-09V00-013. RL2044.2 +030100 GO TO RL-FD2-01-03 RL2044.2 +030200 RL-FD2-01-05 RL2044.2 +030300 DEPENDING ON WRK-CS-09V00-012. RL2044.2 +030400 GO TO RL-FD2-01-EXIT. RL2044.2 +030500 RL-FD2-01-03. RL2044.2 +030600*ENTRY FROM SEGMENT REL-TEST-009. RL2044.2 +030700* SHOULD NOT ENTER HERE UNLESS SPACE ALLOCATION TOO SMALL. RL2044.2 +030800 ADD 1 TO WRK-CS-09V00-014. RL2044.2 +030900 RL-FD2-01-05. RL2044.2 +031000 ADD 1 TO WRK-CS-09V00-017. RL2044.2 +031100 IF XRECORD-NUMBER (2) EQUAL TO 500 RL2044.2 +031200 MOVE RL-FD2-STATUS TO WRK-XN-0002-002 RL2044.2 +031300 MOVE "10" TO WRK-XN-0002-003. RL2044.2 +031400 RL-FD2-01-EXIT. RL2044.2 +031500 EXIT. RL2044.2 +031600 END DECLARATIVES. RL2044.2 +031700 CCVS1 SECTION. RL2044.2 +031800 OPEN-FILES. RL2044.2 +031900 OPEN OUTPUT PRINT-FILE. RL2044.2 +032000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2044.2 +032100 MOVE SPACE TO TEST-RESULTS. RL2044.2 +032200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2044.2 +032300 MOVE ZERO TO REC-SKL-SUB. RL2044.2 +032400 PERFORM CCVS-INIT-FILE 9 TIMES. RL2044.2 +032500 CCVS-INIT-FILE. RL2044.2 +032600 ADD 1 TO REC-SKL-SUB. RL2044.2 +032700 MOVE FILE-RECORD-INFO-SKELETON RL2044.2 +032800 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2044.2 +032900 CCVS-INIT-EXIT. RL2044.2 +033000 GO TO CCVS1-EXIT. RL2044.2 +033100 CLOSE-FILES. RL2044.2 +033200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2044.2 +033300 TERMINATE-CCVS. RL2044.2 +033400*S EXIT PROGRAM. RL2044.2 +033500*SERMINATE-CALL. RL2044.2 +033600 STOP RUN. RL2044.2 +033700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2044.2 +033800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2044.2 +033900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2044.2 +034000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2044.2 +034100 MOVE "****TEST DELETED****" TO RE-MARK. RL2044.2 +034200 PRINT-DETAIL. RL2044.2 +034300 IF REC-CT NOT EQUAL TO ZERO RL2044.2 +034400 MOVE "." TO PARDOT-X RL2044.2 +034500 MOVE REC-CT TO DOTVALUE. RL2044.2 +034600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2044.2 +034700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2044.2 +034800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2044.2 +034900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2044.2 +035000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2044.2 +035100 MOVE SPACE TO CORRECT-X. RL2044.2 +035200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2044.2 +035300 MOVE SPACE TO RE-MARK. RL2044.2 +035400 HEAD-ROUTINE. RL2044.2 +035500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +035600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +035700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2044.2 +035800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2044.2 +035900 COLUMN-NAMES-ROUTINE. RL2044.2 +036000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +036100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +036200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +036300 END-ROUTINE. RL2044.2 +036400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2044.2 +036500 END-RTN-EXIT. RL2044.2 +036600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +036700 END-ROUTINE-1. RL2044.2 +036800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2044.2 +036900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2044.2 +037000 ADD PASS-COUNTER TO ERROR-HOLD. RL2044.2 +037100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2044.2 +037200 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2044.2 +037300 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2044.2 +037400 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2044.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2044.2 +037600 END-ROUTINE-12. RL2044.2 +037700 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2044.2 +037800 IF ERROR-COUNTER IS EQUAL TO ZERO RL2044.2 +037900 MOVE "NO " TO ERROR-TOTAL RL2044.2 +038000 ELSE RL2044.2 +038100 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2044.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2044.2 +038300 PERFORM WRITE-LINE. RL2044.2 +038400 END-ROUTINE-13. RL2044.2 +038500 IF DELETE-COUNTER IS EQUAL TO ZERO RL2044.2 +038600 MOVE "NO " TO ERROR-TOTAL ELSE RL2044.2 +038700 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2044.2 +038800 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2044.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +039000 IF INSPECT-COUNTER EQUAL TO ZERO RL2044.2 +039100 MOVE "NO " TO ERROR-TOTAL RL2044.2 +039200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2044.2 +039300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2044.2 +039400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +039500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2044.2 +039600 WRITE-LINE. RL2044.2 +039700 ADD 1 TO RECORD-COUNT. RL2044.2 +039800 IF RECORD-COUNT GREATER 50 RL2044.2 +039900 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2044.2 +040000 MOVE SPACE TO DUMMY-RECORD RL2044.2 +040100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2044.2 +040200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2044.2 +040300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2044.2 +040400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2044.2 +040500 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2044.2 +040600 MOVE ZERO TO RECORD-COUNT. RL2044.2 +040700 PERFORM WRT-LN. RL2044.2 +040800 WRT-LN. RL2044.2 +040900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2044.2 +041000 MOVE SPACE TO DUMMY-RECORD. RL2044.2 +041100 BLANK-LINE-PRINT. RL2044.2 +041200 PERFORM WRT-LN. RL2044.2 +041300 FAIL-ROUTINE. RL2044.2 +041400 IF COMPUTED-X NOT EQUAL TO SPACE RL2044.2 +041500 GO TO FAIL-ROUTINE-WRITE. RL2044.2 +041600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2044.2 +041700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2044.2 +041800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2044.2 +041900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +042000 MOVE SPACES TO INF-ANSI-REFERENCE. RL2044.2 +042100 GO TO FAIL-ROUTINE-EX. RL2044.2 +042200 FAIL-ROUTINE-WRITE. RL2044.2 +042300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2044.2 +042400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2044.2 +042500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2044.2 +042600 MOVE SPACES TO COR-ANSI-REFERENCE. RL2044.2 +042700 FAIL-ROUTINE-EX. EXIT. RL2044.2 +042800 BAIL-OUT. RL2044.2 +042900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2044.2 +043000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2044.2 +043100 BAIL-OUT-WRITE. RL2044.2 +043200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2044.2 +043300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2044.2 +043400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2044.2 +043500 MOVE SPACES TO INF-ANSI-REFERENCE. RL2044.2 +043600 BAIL-OUT-EX. EXIT. RL2044.2 +043700 CCVS1-EXIT. RL2044.2 +043800 EXIT. RL2044.2 +043900 SECT-RL204-001 SECTION. RL2044.2 +044000 REL-INIT-009. RL2044.2 +044100 MOVE "REL-TEST-009" TO PAR-NAME. RL2044.2 +044200 MOVE "CREATE RL-FD2" TO FEATURE RL2044.2 +044300 MOVE "RL-FD2" TO XFILE-NAME (2). RL2044.2 +044400 MOVE "R1-F-G" TO XRECORD-NAME (2). RL2044.2 +044500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). RL2044.2 +044600 MOVE 000240 TO XRECORD-LENGTH (2). RL2044.2 +044700 MOVE "RC" TO CHARS-OR-RECORDS (2). RL2044.2 +044800 MOVE 0001 TO XBLOCK-SIZE (2). RL2044.2 +044900 MOVE 000500 TO RECORDS-IN-FILE (2). RL2044.2 +045000 MOVE "RL" TO XFILE-ORGANIZATION (2). RL2044.2 +045100 MOVE "S" TO XLABEL-TYPE (2). RL2044.2 +045200 MOVE 000001 TO XRECORD-NUMBER (2). RL2044.2 +045300*INITIALIZE RECORD WORK AREA NUMBER 2. RL2044.2 +045400 MOVE 1 TO WRK-CS-09V00-012. RL2044.2 +045500 MOVE ZERO TO WRK-CS-09V00-013 WRK-CS-09V00-014 RL2044.2 +045600 WRK-CS-09V00-015 WRK-CS-09V00-016 RL2044.2 +045700 WRK-CS-09V00-017 WRK-CS-09V00-018. RL2044.2 +045800 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +045900 MOVE 90000002 TO RL-FD2-KEY. RL2044.2 +046000 MOVE 01 TO REC-CT. RL2044.2 +046100 OPEN OUTPUT RL-FD2. RL2044.2 +046200 MOVE RL-FD2-STATUS TO WRK-XN-0002-001. RL2044.2 +046300*CAPTURE STATUS KEY AFTER OPEN STATEMENT IS EXECUTED. RL2044.2 +046400 REL-TEST-009-R. RL2044.2 +046500 MOVE XRECORD-NUMBER (2) TO RL-FD2-KEY. RL2044.2 +046600 MOVE "99" TO RL-FD2-STATUS. RL2044.2 +046700 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120. RL2044.2 +046800 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL2044.2 +046900 RL-FD2-GRP-120. RL2044.2 +047000 WRITE RL-FD2R1-F-G-240. RL2044.2 +047100 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +047200 GO TO REL-TEST-009-2. RL2044.2 +047300 IF XRECORD-NUMBER (2) EQUAL TO 500 RL2044.2 +047400 GO TO REL-TEST-009-2. RL2044.2 +047500 ADD 01 TO XRECORD-NUMBER (2). RL2044.2 +047600 GO TO REL-TEST-009-R. RL2044.2 +047700 REL-TEST-009-2. RL2044.2 +047800 IF WRK-CS-09V00-014 NOT EQUAL TO ZERO RL2044.2 +047900 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL2044.2 +048000 MOVE ZERO TO CORRECT-18V0 RL2044.2 +048100 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL2044.2 +048200 PERFORM FAIL RL2044.2 +048300 ELSE RL2044.2 +048400 PERFORM PASS. RL2044.2 +048500 PERFORM PRINT-DETAIL. RL2044.2 +048600 ADD 01 TO REC-CT. RL2044.2 +048700* .01 RL2044.2 +048800 IF XRECORD-NUMBER (2) NOT EQUAL TO 500 RL2044.2 +048900 MOVE "INCORRECT COUNT" TO RE-MARK RL2044.2 +049000 MOVE 500 TO CORRECT-18V0 RL2044.2 +049100 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 RL2044.2 +049200 PERFORM FAIL RL2044.2 +049300 ELSE RL2044.2 +049400 PERFORM PASS. RL2044.2 +049500 PERFORM PRINT-DETAIL. RL2044.2 +049600 ADD 01 TO REC-CT. RL2044.2 +049700* .02 RL2044.2 +049800 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL2044.2 +049900 MOVE "STATUS/OPEN" TO RE-MARK RL2044.2 +050000 MOVE WRK-XN-0002-001 TO COMPUTED-A RL2044.2 +050100 MOVE "00" TO CORRECT-A RL2044.2 +050200 PERFORM FAIL RL2044.2 +050300 ELSE RL2044.2 +050400 PERFORM PASS. RL2044.2 +050500 PERFORM PRINT-DETAIL. RL2044.2 +050600 ADD 01 TO REC-CT. RL2044.2 +050700* .03 RL2044.2 +050800 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +050900 MOVE "STATUS/WRITE" TO RE-MARK RL2044.2 +051000 MOVE RL-FD2-STATUS TO COMPUTED-A RL2044.2 +051100 MOVE "00" TO CORRECT-A RL2044.2 +051200 PERFORM FAIL RL2044.2 +051300 ELSE RL2044.2 +051400 PERFORM PASS. RL2044.2 +051500 PERFORM PRINT-DETAIL. RL2044.2 +051600 ADD 01 TO REC-CT. RL2044.2 +051700* .04 RL2044.2 +051800 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +051900 CLOSE RL-FD2. RL2044.2 +052000 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +052100 MOVE "CLOSE/STATUS" TO RE-MARK RL2044.2 +052200 MOVE RL-FD2-STATUS TO COMPUTED-A RL2044.2 +052300 MOVE "00" TO CORRECT-A RL2044.2 +052400 PERFORM FAIL RL2044.2 +052500 ELSE RL2044.2 +052600 PERFORM PASS. RL2044.2 +052700 PERFORM PRINT-DETAIL. RL2044.2 +052800 ADD 01 TO REC-CT. RL2044.2 +052900* .05 RL2044.2 +053000 REL-INIT-010. RL2044.2 +053100 MOVE "REL-TEST-010" TO PAR-NAME. RL2044.2 +053200 MOVE 2 TO WRK-CS-09V00-012. RL2044.2 +053300 MOVE ZERO TO WRK-CS-09V00-013. RL2044.2 +053400 MOVE ZERO TO WRK-CS-09V00-014. RL2044.2 +053500 MOVE ZERO TO WRK-CS-09V00-015. RL2044.2 +053600 MOVE ZERO TO WRK-CS-09V00-016. RL2044.2 +053700 MOVE ZERO TO WRK-CS-09V00-017. RL2044.2 +053800 MOVE ZERO TO WRK-CS-09V00-018. RL2044.2 +053900 MOVE 01 TO REC-CT. RL2044.2 +054000 OPEN I-O RL-FD2. RL2044.2 +054100 MOVE SPACE TO WRK-XN-0002-002 RL2044.2 +054200 MOVE SPACE TO WRK-XN-0002-003 RL2044.2 +054300 MOVE SPACE TO WRK-XN-0002-004 RL2044.2 +054400 MOVE RL-FD2-STATUS TO WRK-XN-0002-001 RL2044.2 +054500 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +054600*CAPTURE THE CONTENTS OF STATUS KEY AFTER OPEN IS EXECUTED. RL2044.2 +054700 MOVE "USE/FILE STATUS" TO FEATURE. RL2044.2 +054800 REL-TEST-010-R. RL2044.2 +054900 ADD 1 TO WRK-CS-09V00-014. RL2044.2 +055000 ADD 1 TO WRK-CS-09V00-015. RL2044.2 +055100 READ RL-FD2 NEXT RECORD. RL2044.2 +055200 IF RL-FD2-STATUS EQUAL TO "10" RL2044.2 +055300 GO TO REL-TEST-010-3. RL2044.2 +055400 MOVE RL-FD2-WRK-120 TO FILE-RECORD-INFO-P1-120 (2). RL2044.2 +055500 IF WRK-CS-09V00-015 EQUAL TO 5 RL2044.2 +055600 ADD 01 TO UPDATE-NUMBER (2) RL2044.2 +055700 MOVE FILE-RECORD-INFO-P1-120 (2) TO RL-FD2-WRK-120 RL2044.2 +055800 REWRITE RL-FD2R1-F-G-240 RL2044.2 +055900 MOVE ZERO TO WRK-CS-09V00-015 RL2044.2 +056000 GO TO REL-TEST-010-2. RL2044.2 +056100 IF WRK-CS-09V00-014 GREATER 500 RL2044.2 +056200 GO TO REL-TEST-010-3. RL2044.2 +056300 GO TO REL-TEST-010-R. RL2044.2 +056400 REL-TEST-010-2. RL2044.2 +056500 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +056600 ADD 1 TO WRK-CS-09V00-016. RL2044.2 +056700 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +056800 GO TO REL-TEST-010-R. RL2044.2 +056900 REL-TEST-010-3. RL2044.2 +057000 IF WRK-CS-09V00-013 NOT EQUAL TO 1 RL2044.2 +057100 MOVE "EXCEPTIONS/ERRORS" TO RE-MARK RL2044.2 +057200 MOVE WRK-CS-09V00-013 TO COMPUTED-18V0 RL2044.2 +057300 MOVE 1 TO CORRECT-18V0 RL2044.2 +057400 PERFORM FAIL RL2044.2 +057500 ELSE RL2044.2 +057600 PERFORM PASS. RL2044.2 +057700 PERFORM PRINT-DETAIL. RL2044.2 +057800 ADD 01 TO REC-CT. RL2044.2 +057900* .01 RL2044.2 +058000 IF WRK-CS-09V00-014 NOT EQUAL TO 501 RL2044.2 +058100 MOVE "INCORRECT COUNT" TO RE-MARK RL2044.2 +058200 MOVE WRK-CS-09V00-014 TO COMPUTED-18V0 RL2044.2 +058300 MOVE 501 TO CORRECT-18V0 RL2044.2 +058400 PERFORM FAIL RL2044.2 +058500 ELSE RL2044.2 +058600 PERFORM PASS. RL2044.2 +058700 PERFORM PRINT-DETAIL. RL2044.2 +058800 ADD 01 TO REC-CT. RL2044.2 +058900* .02 RL2044.2 +059000 IF WRK-XN-0002-001 NOT EQUAL TO "00" RL2044.2 +059100 MOVE "OPEN/STATUS" TO RE-MARK RL2044.2 +059200 MOVE WRK-XN-0002-001 TO COMPUTED-A RL2044.2 +059300 MOVE "00" TO CORRECT-A RL2044.2 +059400 PERFORM FAIL RL2044.2 +059500 ELSE RL2044.2 +059600 PERFORM PASS. RL2044.2 +059700 PERFORM PRINT-DETAIL. RL2044.2 +059800 ADD 01 TO REC-CT. RL2044.2 +059900* .03 RL2044.2 +060000 IF RL-FD2-STATUS NOT EQUAL TO "10" RL2044.2 +060100 MOVE "ATEND/STATUS" TO RE-MARK RL2044.2 +060200 MOVE RL-FD2-STATUS TO COMPUTED-A RL2044.2 +060300 MOVE "10" TO CORRECT-A RL2044.2 +060400 PERFORM FAIL RL2044.2 +060500 ELSE RL2044.2 +060600 PERFORM PASS. RL2044.2 +060700 PERFORM PRINT-DETAIL. RL2044.2 +060800 ADD 01 TO REC-CT. RL2044.2 +060900* .04 RL2044.2 +061000 IF WRK-XN-0002-002 NOT EQUAL TO "10" RL2044.2 +061100 MOVE "EXCEPTIN/STATUS" TO RE-MARK RL2044.2 +061200 MOVE WRK-XN-0002-002 TO COMPUTED-A RL2044.2 +061300 MOVE "10" TO CORRECT-A RL2044.2 +061400 PERFORM FAIL RL2044.2 +061500 ELSE RL2044.2 +061600 PERFORM PASS. RL2044.2 +061700 PERFORM PRINT-DETAIL. RL2044.2 +061800 ADD 01 TO REC-CT. RL2044.2 +061900* .05 RL2044.2 +062000 IF WRK-XN-0002-003 NOT EQUAL TO "10" RL2044.2 +062100 MOVE "NO/EXCEPTION" TO RE-MARK RL2044.2 +062200 MOVE WRK-XN-0002-003 TO COMPUTED-A RL2044.2 +062300 MOVE "10" TO CORRECT-A RL2044.2 +062400 PERFORM FAIL RL2044.2 +062500 ELSE RL2044.2 +062600 PERFORM PASS. RL2044.2 +062700 PERFORM PRINT-DETAIL RL2044.2 +062800 ADD 01 TO REC-CT. RL2044.2 +062900* .06 RL2044.2 +063000 MOVE SPACE TO RL-FD2-STATUS. RL2044.2 +063100 CLOSE RL-FD2 RL2044.2 +063200 IF RL-FD2-STATUS NOT EQUAL TO "00" RL2044.2 +063300 MOVE "CLOSE/STATUS" TO RE-MARK RL2044.2 +063400 MOVE RL-FD2-STATUS TO COMPUTED-A RL2044.2 +063500 MOVE "00" TO CORRECT-A RL2044.2 +063600 PERFORM FAIL RL2044.2 +063700 ELSE RL2044.2 +063800 PERFORM PASS. RL2044.2 +063900 PERFORM PRINT-DETAIL. RL2044.2 +064000 ADD 01 TO REC-CT. RL2044.2 +064100* .07 RL2044.2 +064200 CCVS-EXIT SECTION. RL2044.2 +064300 CCVS-999999. RL2044.2 +064400 GO TO CLOSE-FILES. RL2044.2 diff --git a/tests/cobol85/RL/RL205A.CBL b/tests/cobol85/RL/RL205A.CBL new file mode 100644 index 00000000..d8cde0b0 --- /dev/null +++ b/tests/cobol85/RL/RL205A.CBL @@ -0,0 +1,2410 @@ +000100 IDENTIFICATION DIVISION. RL2054.2 +000200 PROGRAM-ID. RL2054.2 +000300 RL205A. RL2054.2 +000400**************************************************************** RL2054.2 +000500* * RL2054.2 +000600* VALIDATION FOR:- * RL2054.2 +000700* * RL2054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2054.2 +000900* * RL2054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2054.2 +001100* * RL2054.2 +001200**************************************************************** RL2054.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO TEST THE PERMISSIBLE SYN- RL2054.2 +001400* TACTICAL CONSTRUCTS OF COBOL ELEMENTS ASSOCIATED WITH LEVEL 2RL2054.2 +001500* OF THE RELATIVE I-O MODULE. THE ELEMENTS TESTED IN THIS RL2054.2 +001600* ROUTINE ARE: RL2054.2 +001700* RL2054.2 +001800* USE AFTER ERROR PROCEDURE FILE-NAME-1 FILE-NAME-2 RL2054.2 +001900* READ ..... NEXT RL2054.2 +002000* READ ..... NEXT RECORD INTO .... RL2054.2 +002100* READ ..... NEXT INTO ..... RL2054.2 +002200* READ ..... NEXT INTO ..... AT END .... RL2054.2 +002300* READ ..... RL2054.2 +002400* READ ..... INTO ..... RL2054.2 +002500* READ ..... RECORD RL2054.2 +002600* READ ..... RECORD INVALID ..... RL2054.2 +002700* READ ..... RECORD INVALID KEY .... RL2054.2 +002800* START FILE-NAME-2 RL2054.2 +002900* START FILE-NAME-2 KEY EQUAL TO .... RL2054.2 +003000* START FILE-NAME-2 KEY IS EQUAL TO .... RL2054.2 +003100* START FILE-NAME-2 KEY IS EQUAL ..... RL2054.2 +003200* START FILE-NAME-2 KEY IS = ...... RL2054.2 +003300* START FILE-NAME-2 KEY IS GREATER ..... RL2054.2 +003400* START FILE-NAME-2 KEY GREATER THAN .... RL2054.2 +003500* START FILE-NAME-2 KEY IS GREATER ..... RL2054.2 +003600* START FILE-NAME-2 KEY IS > .... RL2054.2 +003700* START FILE-NAME-2 KEY > .... RL2054.2 +003800* START FILE-NAME-2 KEY IS NOT LESS THAN .... RL2054.2 +003900* START FILE-NAME-2 KEY IS NOT LESS .... RL2054.2 +004000* START FILE-NAME-2 KEY NOT LESS .... RL2054.2 +004100* START FILE-NAME-2 KEY IS NOT < ..... RL2054.2 +004200* START FILE-NAME-1 KEY IS EQUAL TO INVALID KEY ..... RL2054.2 +004300* START FILE-NAME-1 KEY IS EQUAL TO INVALID .... RL2054.2 +004400* START FILE-NAME-1 INVALID KEY .... RL2054.2 +004500* START FILE-NAME-1 ; INVALID KEY .... RL2054.2 +004600* START FILE-NAME-1 KEY EQUAL TO ..... RL2054.2 +004700* FILE POSITION INDICATOR RL2054.2 +004800* RL2054.2 +004900* EACH ELEMENT TESTED WILL BE EXERCISED SEMANTICALLY BY THIS RL2054.2 +005000* ROUTINE. RL2054.2 +005100* FOR A RELATIVE OR INDEXED FILE IN THE DYNAMIC ACCESS MODE, RL2054.2 +005200* EXECUTION OF AN "OPEN I-O" STATEMENT FOLLOWED BYONE OR RL2054.2 +005300* MORE "WRITE" STATEMENTS AND THEN A "READ NEXT" STATEMENT RL2054.2 +005400* WILL CAUSE THE "READ" STATEMENT TO ACCESS THE FIRST RECORD RL2054.2 +005500* IN THE FILE AT THE TIME OF EXECUTION OF THE "READ" RL2054.2 +005600* STATEMENT. SYNTAX TESTS FOR THE "START" STATEMENT ARE RL2054.2 +005700* ALSO INCLUDED. RL2054.2 +005800* RL2054.2 +005900* RL2054.2 +006000* X-CARDS WHICH MUST BE REPLACED FOR THIS PROGRAM ARE RL2054.2 +006100* RL2054.2 +006200* X-21 RELATIVE FILE IMPLEMENTOR-NAME IN ASSGN TO RL2054.2 +006300* CLAUSE FOR DATA FILE RL-FS1 RL2054.2 +006400* X-22 RELATIVE FILE IMPLEMENTOR-NAME IN ASSIGN TO RL2054.2 +006500* CLAUSE FOR DATA FILE RL-FD2 RL2054.2 +006600* X-55 IMPLEMENTOR-NAME FOR SYSTEM PRINTER RL2054.2 +006700* X-69 ADDITIONAL VALUE OF PHRASES RL2054.2 +006800* X-74 VALUE OF IMPLEMENTOR-NAME RL2054.2 +006900* X-75 OBJECT OF VALUE OF CLAUSE FOR FILE RL-FS1 RL2054.2 +007000* X-76 OBJECT OF VALUE OF CLAUSE FOR FILE RL-FD2 RL2054.2 +007100* X-82 IMPLEMENTOR-NAME FOR SOURCE-COMPUTER RL2054.2 +007200* X-83 IMPLEMENTOR-NAME FOR OBJECT-COMPUTER RL2054.2 +007300* RL2054.2 +007400* NOTE: X-CARDS 69,74,75 AND 76 ARE OPTIONAL RL2054.2 +007500* AND NEED ONLY TO BE PRESENT IF THE COMPILER RE- RL2054.2 +007600* QUIRES THIS CODE BE AVAILABLE FOR PROPER PROGRAM RL2054.2 +007700* COMPILATION AND EXECUTION. IF THE VP-ROUTINE IS RL2054.2 +007800* USED THE X-CARDS MAY BE AUTOMATICALLY SELECTED RL2054.2 +007900* FOR INCLUSION IN THE PROGRAM BY SPECIFYING THE RL2054.2 +008000* APPROPRIATE LETTER IN THE "*OPT" VP-ROUTINE RL2054.2 +008100* CONTROL CARD. THE LETTER CORRESPONDS TO A RL2054.2 +008200* CHARACTER IN POSITION 7 OF THE SOURCE LINE AND RL2054.2 +008300* THEY ARE AS FOLLOWS RL2054.2 +008400* RL2054.2 +008500* C SELECTS X-CARDS 74,75 AND 76 RL2054.2 +008600* G SELECTS X-CARDS 69 RL2054.2 +008700* RL2054.2 +008800* NOTE: THERE IS OPTIONAL SOURCE CODE IN THIS PROGRAM RL2054.2 +008900* FOR THE CONVENIENCE OF THE USER. THIS OPTIONAL RL2054.2 +009000* CODE IS IDENTIFIED BY THE LETTER X IN RL2054.2 +009100* POSITION 7 OF THE SOURCE LINE. USE OF RL2054.2 +009200* SOURCE CODE WITH LETTER X WILL PRINT THE CONTENTS RL2054.2 +009300* OF THE FILES AFTER THE TEST REPORT. RL2054.2 +009400* IF THE VP-ROUTINE IS USED THE APPROPRIATE RL2054.2 +009500* SOURCE CODE MAY BE SELECTED BY SPECIFYING THE RL2054.2 +009600* RESPECTIVE LETTER IN THE "*OPT" VP-ROUTINE CONTROLRL2054.2 +009700* CARD. RL2054.2 +009800* RL2054.2 +009900****************************************************** RL2054.2 +010000 ENVIRONMENT DIVISION. RL2054.2 +010100 CONFIGURATION SECTION. RL2054.2 +010200 SOURCE-COMPUTER. RL2054.2 +010300 Linux. RL2054.2 +010400 OBJECT-COMPUTER. RL2054.2 +010500 Linux. RL2054.2 +010600 INPUT-OUTPUT SECTION. RL2054.2 +010700 FILE-CONTROL. RL2054.2 +010800 SELECT PRINT-FILE ASSIGN TO RL2054.2 +010900 "report.log". RL2054.2 +011000 SELECT RL-FD1 RL2054.2 +011100 ASSIGN TO RL2054.2 +011200 "XXXXX021" RL2054.2 +011300 ORGANIZATION IS RELATIVE RL2054.2 +011400 ACCESS MODE IS DYNAMIC RL2054.2 +011500 RELATIVE KEY IS RL-FD1-KEY. RL2054.2 +011600 SELECT RL-FS2 RL2054.2 +011700 ASSIGN TO RL2054.2 +011800 "XXXXX022" RL2054.2 +011900 ACCESS MODE IS SEQUENTIAL RL2054.2 +012000 RELATIVE KEY IS RL-FS2-KEY RL2054.2 +012100 ORGANIZATION IS RELATIVE. RL2054.2 +012200 DATA DIVISION. RL2054.2 +012300 FILE SECTION. RL2054.2 +012400 FD PRINT-FILE. RL2054.2 +012500 01 PRINT-REC PICTURE X(120). RL2054.2 +012600 01 DUMMY-RECORD PICTURE X(120). RL2054.2 +012700 FD RL-FD1 RL2054.2 +012800 RECORD CONTAINS 240 CHARACTERS RL2054.2 +012900*C VALUE OF RL2054.2 +013000*C OCLABELID RL2054.2 +013100*C IS RL2054.2 +013200*C "OCDUMMY" RL2054.2 +013300*G SYSIN RL2054.2 +013400 . RL2054.2 +013500 01 RL-FD1R1-F-G-240. RL2054.2 +013600 05 RL-FD1-REC-001-120 PICTURE X(120). RL2054.2 +013700 05 RL-FD1-REC-121-240. RL2054.2 +013800 10 FILLER PICTURE X(8). RL2054.2 +013900 10 RL-FD1-FILLER. RL2054.2 +014000 15 RL-FS1-KEYNUM PICTURE 9(5). RL2054.2 +014100 10 FILLER PICTURE X(5). RL2054.2 +014200 10 FILLER PICTURE X(19). RL2054.2 +014300 10 FILLER PICTURE X(9). RL2054.2 +014400 10 RL-FD1-FILLER1. RL2054.2 +014500 15 RL-FD1-FILLER1NUM PICTURE 9(5). RL2054.2 +014600 10 FILLER PICTURE 9(5). RL2054.2 +014700 10 FILLER PICTURE X(19). RL2054.2 +014800 10 FILLER PICTURE X(45). RL2054.2 +014900 FD RL-FS2 RL2054.2 +015000*C VALUE OF RL2054.2 +015100*C OCLABELID RL2054.2 +015200*C IS RL2054.2 +015300*C "OCDUMMY" RL2054.2 +015400*G SYSIN RL2054.2 +015500 . RL2054.2 +015600 01 RL-FS2R1-F-G-240. RL2054.2 +015700 05 RL-FS2-REC-001-120 PICTURE X(120). RL2054.2 +015800 05 RL-FS2-REC-121-240. RL2054.2 +015900 10 FILLER PICTURE X(8). RL2054.2 +016000 10 RL-FS2-FILLER. RL2054.2 +016100 15 RL-FS2-KEYNUM PICTURE 9(5). RL2054.2 +016200 10 FILLER PICTURE 9(5). RL2054.2 +016300 10 FILLER PICTURE X(19). RL2054.2 +016400 10 FILLER PICTURE X(9). RL2054.2 +016500 10 RL-FS2-FILLER1. RL2054.2 +016600 15 RL-FS2-FILLER1NUM PICTURE 9(5). RL2054.2 +016700 10 FILLER PICTURE 9(5). RL2054.2 +016800 10 FILLER PICTURE X(19). RL2054.2 +016900 10 FILLER PICTURE X(45). RL2054.2 +017000 WORKING-STORAGE SECTION. RL2054.2 +017100 01 WRK-XN-00001 PIC X. RL2054.2 +017200 01 WRK-XN-00002 PIC X. RL2054.2 +017300 01 RL-FD1-KEY PICTURE 9(5) VALUE ZERO. RL2054.2 +017400 01 RL-FS2-KEY PICTURE 9(5) VALUE ZERO. RL2054.2 +017500 01 RL-FD1-FILESIZE PICTURE 9(6) VALUE 300. RL2054.2 +017600 01 RL-FS2-FILESIZE PICTURE 9(6) VALUE 300. RL2054.2 +017700 01 WRK-RL-FD1-RECKEY-CHAR. RL2054.2 +017800 03 WRK-RL-FD1-RECKEY PIC 9(5) VALUE ZERO. RL2054.2 +017900 01 WRK-RL-FS2-RECKEY PIC 9(5) VALUE ZERO. RL2054.2 +018000 01 WRK-RL-FD1-FILLER. RL2054.2 +018100 03 WRK-DU-05V00-002 PICTURE 9(5) VALUE ZERO. RL2054.2 +018200 01 WRK-RL-FS2-FILLER. RL2054.2 +018300 03 WRK-DU-05V00-004 PICTURE 9(5) VALUE ZERO. RL2054.2 +018400 01 EXCUT-COUNTER-06V00 PICTURE S9(6) VALUE ZERO. RL2054.2 +018500 01 INV-KEY-COUNTER PICTURE S9(6) VALUE ZERO. RL2054.2 +018600 01 LOGICAL-FILE-REC PICTURE S9(6) VALUE ZERO. RL2054.2 +018700 01 ERROR-COUNTER-06V00 PICTURE S9(6) VALUE ZERO. RL2054.2 +018800 01 ASCEND-DESEND-SWITCH PICTURE XX VALUE "UP". RL2054.2 +018900 88 ASCEND VALUE "UP". RL2054.2 +019000 88 DSCEND VALUE "DN". RL2054.2 +019100 01 FILE-RECORD-INFORMATION-REC. RL2054.2 +019200 03 FILE-RECORD-INFO-SKELETON. RL2054.2 +019300 05 FILLER PICTURE X(48) VALUE RL2054.2 +019400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2054.2 +019500 05 FILLER PICTURE X(46) VALUE RL2054.2 +019600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2054.2 +019700 05 FILLER PICTURE X(26) VALUE RL2054.2 +019800 ",LFIL=000000,ORG= ,LBLR= ". RL2054.2 +019900 05 FILLER PICTURE X(37) VALUE RL2054.2 +020000 ",RECKEY= ". RL2054.2 +020100 05 FILLER PICTURE X(38) VALUE RL2054.2 +020200 ",ALTKEY1= ". RL2054.2 +020300 05 FILLER PICTURE X(38) VALUE RL2054.2 +020400 ",ALTKEY2= ". RL2054.2 +020500 05 FILLER PICTURE X(7) VALUE SPACE.RL2054.2 +020600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2054.2 +020700 05 FILE-RECORD-INFO-P1-120. RL2054.2 +020800 07 FILLER PIC X(5). RL2054.2 +020900 07 XFILE-NAME PIC X(6). RL2054.2 +021000 07 FILLER PIC X(8). RL2054.2 +021100 07 XRECORD-NAME PIC X(6). RL2054.2 +021200 07 FILLER PIC X(1). RL2054.2 +021300 07 REELUNIT-NUMBER PIC 9(1). RL2054.2 +021400 07 FILLER PIC X(7). RL2054.2 +021500 07 XRECORD-NUMBER PIC 9(6). RL2054.2 +021600 07 FILLER PIC X(6). RL2054.2 +021700 07 UPDATE-NUMBER PIC 9(2). RL2054.2 +021800 07 FILLER PIC X(5). RL2054.2 +021900 07 ODO-NUMBER PIC 9(4). RL2054.2 +022000 07 FILLER PIC X(5). RL2054.2 +022100 07 XPROGRAM-NAME PIC X(5). RL2054.2 +022200 07 FILLER PIC X(7). RL2054.2 +022300 07 XRECORD-LENGTH PIC 9(6). RL2054.2 +022400 07 FILLER PIC X(7). RL2054.2 +022500 07 CHARS-OR-RECORDS PIC X(2). RL2054.2 +022600 07 FILLER PIC X(1). RL2054.2 +022700 07 XBLOCK-SIZE PIC 9(4). RL2054.2 +022800 07 FILLER PIC X(6). RL2054.2 +022900 07 RECORDS-IN-FILE PIC 9(6). RL2054.2 +023000 07 FILLER PIC X(5). RL2054.2 +023100 07 XFILE-ORGANIZATION PIC X(2). RL2054.2 +023200 07 FILLER PIC X(6). RL2054.2 +023300 07 XLABEL-TYPE PIC X(1). RL2054.2 +023400 05 FILE-RECORD-INFO-P121-240. RL2054.2 +023500 07 FILLER PIC X(8). RL2054.2 +023600 07 XRECORD-KEY PIC X(29). RL2054.2 +023700 07 FILLER PIC X(9). RL2054.2 +023800 07 ALTERNATE-KEY1 PIC X(29). RL2054.2 +023900 07 FILLER PIC X(9). RL2054.2 +024000 07 ALTERNATE-KEY2 PIC X(29). RL2054.2 +024100 07 FILLER PIC X(7). RL2054.2 +024200 01 TEST-RESULTS. RL2054.2 +024300 02 FILLER PIC X VALUE SPACE. RL2054.2 +024400 02 FEATURE PIC X(20) VALUE SPACE. RL2054.2 +024500 02 FILLER PIC X VALUE SPACE. RL2054.2 +024600 02 P-OR-F PIC X(5) VALUE SPACE. RL2054.2 +024700 02 FILLER PIC X VALUE SPACE. RL2054.2 +024800 02 PAR-NAME. RL2054.2 +024900 03 FILLER PIC X(19) VALUE SPACE. RL2054.2 +025000 03 PARDOT-X PIC X VALUE SPACE. RL2054.2 +025100 03 DOTVALUE PIC 99 VALUE ZERO. RL2054.2 +025200 02 FILLER PIC X(8) VALUE SPACE. RL2054.2 +025300 02 RE-MARK PIC X(61). RL2054.2 +025400 01 TEST-COMPUTED. RL2054.2 +025500 02 FILLER PIC X(30) VALUE SPACE. RL2054.2 +025600 02 FILLER PIC X(17) VALUE RL2054.2 +025700 " COMPUTED=". RL2054.2 +025800 02 COMPUTED-X. RL2054.2 +025900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2054.2 +026000 03 COMPUTED-N REDEFINES COMPUTED-A RL2054.2 +026100 PIC -9(9).9(9). RL2054.2 +026200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2054.2 +026300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2054.2 +026400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2054.2 +026500 03 CM-18V0 REDEFINES COMPUTED-A. RL2054.2 +026600 04 COMPUTED-18V0 PIC -9(18). RL2054.2 +026700 04 FILLER PIC X. RL2054.2 +026800 03 FILLER PIC X(50) VALUE SPACE. RL2054.2 +026900 01 TEST-CORRECT. RL2054.2 +027000 02 FILLER PIC X(30) VALUE SPACE. RL2054.2 +027100 02 FILLER PIC X(17) VALUE " CORRECT =". RL2054.2 +027200 02 CORRECT-X. RL2054.2 +027300 03 CORRECT-A PIC X(20) VALUE SPACE. RL2054.2 +027400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2054.2 +027500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2054.2 +027600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2054.2 +027700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2054.2 +027800 03 CR-18V0 REDEFINES CORRECT-A. RL2054.2 +027900 04 CORRECT-18V0 PIC -9(18). RL2054.2 +028000 04 FILLER PIC X. RL2054.2 +028100 03 FILLER PIC X(2) VALUE SPACE. RL2054.2 +028200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2054.2 +028300 01 CCVS-C-1. RL2054.2 +028400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2054.2 +028500- "SS PARAGRAPH-NAME RL2054.2 +028600- " REMARKS". RL2054.2 +028700 02 FILLER PIC X(20) VALUE SPACE. RL2054.2 +028800 01 CCVS-C-2. RL2054.2 +028900 02 FILLER PIC X VALUE SPACE. RL2054.2 +029000 02 FILLER PIC X(6) VALUE "TESTED". RL2054.2 +029100 02 FILLER PIC X(15) VALUE SPACE. RL2054.2 +029200 02 FILLER PIC X(4) VALUE "FAIL". RL2054.2 +029300 02 FILLER PIC X(94) VALUE SPACE. RL2054.2 +029400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2054.2 +029500 01 REC-CT PIC 99 VALUE ZERO. RL2054.2 +029600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2054.2 +029700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2054.2 +029800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2054.2 +029900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2054.2 +030000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2054.2 +030100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2054.2 +030200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2054.2 +030300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2054.2 +030400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2054.2 +030500 01 CCVS-H-1. RL2054.2 +030600 02 FILLER PIC X(39) VALUE SPACES. RL2054.2 +030700 02 FILLER PIC X(42) VALUE RL2054.2 +030800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2054.2 +030900 02 FILLER PIC X(39) VALUE SPACES. RL2054.2 +031000 01 CCVS-H-2A. RL2054.2 +031100 02 FILLER PIC X(40) VALUE SPACE. RL2054.2 +031200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2054.2 +031300 02 FILLER PIC XXXX VALUE RL2054.2 +031400 "4.2 ". RL2054.2 +031500 02 FILLER PIC X(28) VALUE RL2054.2 +031600 " COPY - NOT FOR DISTRIBUTION". RL2054.2 +031700 02 FILLER PIC X(41) VALUE SPACE. RL2054.2 +031800 RL2054.2 +031900 01 CCVS-H-2B. RL2054.2 +032000 02 FILLER PIC X(15) VALUE RL2054.2 +032100 "TEST RESULT OF ". RL2054.2 +032200 02 TEST-ID PIC X(9). RL2054.2 +032300 02 FILLER PIC X(4) VALUE RL2054.2 +032400 " IN ". RL2054.2 +032500 02 FILLER PIC X(12) VALUE RL2054.2 +032600 " HIGH ". RL2054.2 +032700 02 FILLER PIC X(22) VALUE RL2054.2 +032800 " LEVEL VALIDATION FOR ". RL2054.2 +032900 02 FILLER PIC X(58) VALUE RL2054.2 +033000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2054.2 +033100 01 CCVS-H-3. RL2054.2 +033200 02 FILLER PIC X(34) VALUE RL2054.2 +033300 " FOR OFFICIAL USE ONLY ". RL2054.2 +033400 02 FILLER PIC X(58) VALUE RL2054.2 +033500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2054.2 +033600 02 FILLER PIC X(28) VALUE RL2054.2 +033700 " COPYRIGHT 1985 ". RL2054.2 +033800 01 CCVS-E-1. RL2054.2 +033900 02 FILLER PIC X(52) VALUE SPACE. RL2054.2 +034000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2054.2 +034100 02 ID-AGAIN PIC X(9). RL2054.2 +034200 02 FILLER PIC X(45) VALUE SPACES. RL2054.2 +034300 01 CCVS-E-2. RL2054.2 +034400 02 FILLER PIC X(31) VALUE SPACE. RL2054.2 +034500 02 FILLER PIC X(21) VALUE SPACE. RL2054.2 +034600 02 CCVS-E-2-2. RL2054.2 +034700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2054.2 +034800 03 FILLER PIC X VALUE SPACE. RL2054.2 +034900 03 ENDER-DESC PIC X(44) VALUE RL2054.2 +035000 "ERRORS ENCOUNTERED". RL2054.2 +035100 01 CCVS-E-3. RL2054.2 +035200 02 FILLER PIC X(22) VALUE RL2054.2 +035300 " FOR OFFICIAL USE ONLY". RL2054.2 +035400 02 FILLER PIC X(12) VALUE SPACE. RL2054.2 +035500 02 FILLER PIC X(58) VALUE RL2054.2 +035600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2054.2 +035700 02 FILLER PIC X(13) VALUE SPACE. RL2054.2 +035800 02 FILLER PIC X(15) VALUE RL2054.2 +035900 " COPYRIGHT 1985". RL2054.2 +036000 01 CCVS-E-4. RL2054.2 +036100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2054.2 +036200 02 FILLER PIC X(4) VALUE " OF ". RL2054.2 +036300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2054.2 +036400 02 FILLER PIC X(40) VALUE RL2054.2 +036500 " TESTS WERE EXECUTED SUCCESSFULLY". RL2054.2 +036600 01 XXINFO. RL2054.2 +036700 02 FILLER PIC X(19) VALUE RL2054.2 +036800 "*** INFORMATION ***". RL2054.2 +036900 02 INFO-TEXT. RL2054.2 +037000 04 FILLER PIC X(8) VALUE SPACE. RL2054.2 +037100 04 XXCOMPUTED PIC X(20). RL2054.2 +037200 04 FILLER PIC X(5) VALUE SPACE. RL2054.2 +037300 04 XXCORRECT PIC X(20). RL2054.2 +037400 02 INF-ANSI-REFERENCE PIC X(48). RL2054.2 +037500 01 HYPHEN-LINE. RL2054.2 +037600 02 FILLER PIC IS X VALUE IS SPACE. RL2054.2 +037700 02 FILLER PIC IS X(65) VALUE IS "************************RL2054.2 +037800- "*****************************************". RL2054.2 +037900 02 FILLER PIC IS X(54) VALUE IS "************************RL2054.2 +038000- "******************************". RL2054.2 +038100 01 CCVS-PGM-ID PIC X(9) VALUE RL2054.2 +038200 "RL205A". RL2054.2 +038300 PROCEDURE DIVISION. RL2054.2 +038400 DECLARATIVES. RL2054.2 +038500 USE-RL205-TEST SECTION. RL2054.2 +038600 USE AFTER ERROR PROCEDURE RL-FD1 RL-FS2. RL2054.2 +038700 USE-PAR-001. RL2054.2 +038800 ADD 010000 TO ERROR-COUNTER-06V00. RL2054.2 +038900 USE-PAR-EXIT. RL2054.2 +039000 EXIT. RL2054.2 +039100 END DECLARATIVES. RL2054.2 +039200 CCVS1 SECTION. RL2054.2 +039300 OPEN-FILES. RL2054.2 +039400 OPEN OUTPUT PRINT-FILE. RL2054.2 +039500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2054.2 +039600 MOVE SPACE TO TEST-RESULTS. RL2054.2 +039700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2054.2 +039800 MOVE ZERO TO REC-SKL-SUB. RL2054.2 +039900 PERFORM CCVS-INIT-FILE 9 TIMES. RL2054.2 +040000 CCVS-INIT-FILE. RL2054.2 +040100 ADD 1 TO REC-SKL-SUB. RL2054.2 +040200 MOVE FILE-RECORD-INFO-SKELETON RL2054.2 +040300 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2054.2 +040400 CCVS-INIT-EXIT. RL2054.2 +040500 GO TO CCVS1-EXIT. RL2054.2 +040600 CLOSE-FILES. RL2054.2 +040700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2054.2 +040800 TERMINATE-CCVS. RL2054.2 +040900*S EXIT PROGRAM. RL2054.2 +041000*SERMINATE-CALL. RL2054.2 +041100 STOP RUN. RL2054.2 +041200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2054.2 +041300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2054.2 +041400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2054.2 +041500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2054.2 +041600 MOVE "****TEST DELETED****" TO RE-MARK. RL2054.2 +041700 PRINT-DETAIL. RL2054.2 +041800 IF REC-CT NOT EQUAL TO ZERO RL2054.2 +041900 MOVE "." TO PARDOT-X RL2054.2 +042000 MOVE REC-CT TO DOTVALUE. RL2054.2 +042100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2054.2 +042200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2054.2 +042300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2054.2 +042400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2054.2 +042500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2054.2 +042600 MOVE SPACE TO CORRECT-X. RL2054.2 +042700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2054.2 +042800 MOVE SPACE TO RE-MARK. RL2054.2 +042900 HEAD-ROUTINE. RL2054.2 +043000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +043100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +043200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2054.2 +043300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2054.2 +043400 COLUMN-NAMES-ROUTINE. RL2054.2 +043500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +043600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +043700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +043800 END-ROUTINE. RL2054.2 +043900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2054.2 +044000 END-RTN-EXIT. RL2054.2 +044100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +044200 END-ROUTINE-1. RL2054.2 +044300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2054.2 +044400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2054.2 +044500 ADD PASS-COUNTER TO ERROR-HOLD. RL2054.2 +044600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2054.2 +044700 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2054.2 +044800 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2054.2 +044900 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2054.2 +045000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2054.2 +045100 END-ROUTINE-12. RL2054.2 +045200 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2054.2 +045300 IF ERROR-COUNTER IS EQUAL TO ZERO RL2054.2 +045400 MOVE "NO " TO ERROR-TOTAL RL2054.2 +045500 ELSE RL2054.2 +045600 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2054.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2054.2 +045800 PERFORM WRITE-LINE. RL2054.2 +045900 END-ROUTINE-13. RL2054.2 +046000 IF DELETE-COUNTER IS EQUAL TO ZERO RL2054.2 +046100 MOVE "NO " TO ERROR-TOTAL ELSE RL2054.2 +046200 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2054.2 +046300 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2054.2 +046400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +046500 IF INSPECT-COUNTER EQUAL TO ZERO RL2054.2 +046600 MOVE "NO " TO ERROR-TOTAL RL2054.2 +046700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2054.2 +046800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2054.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +047000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2054.2 +047100 WRITE-LINE. RL2054.2 +047200 ADD 1 TO RECORD-COUNT. RL2054.2 +047300 IF RECORD-COUNT GREATER 50 RL2054.2 +047400 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2054.2 +047500 MOVE SPACE TO DUMMY-RECORD RL2054.2 +047600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2054.2 +047700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2054.2 +047800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2054.2 +047900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2054.2 +048000 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2054.2 +048100 MOVE ZERO TO RECORD-COUNT. RL2054.2 +048200 PERFORM WRT-LN. RL2054.2 +048300 WRT-LN. RL2054.2 +048400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2054.2 +048500 MOVE SPACE TO DUMMY-RECORD. RL2054.2 +048600 BLANK-LINE-PRINT. RL2054.2 +048700 PERFORM WRT-LN. RL2054.2 +048800 FAIL-ROUTINE. RL2054.2 +048900 IF COMPUTED-X NOT EQUAL TO SPACE RL2054.2 +049000 GO TO FAIL-ROUTINE-WRITE. RL2054.2 +049100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2054.2 +049200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2054.2 +049300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2054.2 +049400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +049500 MOVE SPACES TO INF-ANSI-REFERENCE. RL2054.2 +049600 GO TO FAIL-ROUTINE-EX. RL2054.2 +049700 FAIL-ROUTINE-WRITE. RL2054.2 +049800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2054.2 +049900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2054.2 +050000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2054.2 +050100 MOVE SPACES TO COR-ANSI-REFERENCE. RL2054.2 +050200 FAIL-ROUTINE-EX. EXIT. RL2054.2 +050300 BAIL-OUT. RL2054.2 +050400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2054.2 +050500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2054.2 +050600 BAIL-OUT-WRITE. RL2054.2 +050700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2054.2 +050800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2054.2 +050900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2054.2 +051000 MOVE SPACES TO INF-ANSI-REFERENCE. RL2054.2 +051100 BAIL-OUT-EX. EXIT. RL2054.2 +051200 CCVS1-EXIT. RL2054.2 +051300 EXIT. RL2054.2 +051400 SECT-RL205-0001 SECTION. RL2054.2 +051500 REL-INIT-001. RL2054.2 +051600 OPEN OUTPUT RL-FD1. RL2054.2 +051700 OPEN OUTPUT RL-FS2. RL2054.2 +051800 MOVE "RL-FD1" TO XFILE-NAME (1). RL2054.2 +051900 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2054.2 +052000 MOVE ZERO TO XRECORD-NUMBER (1). RL2054.2 +052100 MOVE ".XXX." TO XPROGRAM-NAME (1). RL2054.2 +052200 MOVE 000240 TO XRECORD-LENGTH (1). RL2054.2 +052300 MOVE 0001 TO XBLOCK-SIZE (1). RL2054.2 +052400 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2054.2 +052500 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2054.2 +052600 MOVE "S" TO XLABEL-TYPE (1). RL2054.2 +052700 MOVE 000300 TO RL-FD1-FILESIZE. RL2054.2 +052800 MOVE 000300 TO RECORDS-IN-FILE (1). RL2054.2 +052900 MOVE 00001 TO WRK-RL-FD1-RECKEY. RL2054.2 +053000 MOVE 00300 TO WRK-DU-05V00-002. RL2054.2 +053100 MOVE ZERO TO EXCUT-COUNTER-06V00. RL2054.2 +053200 MOVE ZERO TO INV-KEY-COUNTER. RL2054.2 +053300 MOVE "REL-TEST-001" TO PAR-NAME. RL2054.2 +053400 MOVE ZERO TO REC-CT. RL2054.2 +053500 MOVE "RL-FS2" TO XFILE-NAME (2). RL2054.2 +053600 MOVE "R1-F-G" TO XRECORD-NAME (2). RL2054.2 +053700 MOVE ZERO TO XRECORD-NUMBER (2). RL2054.2 +053800 MOVE ".XXX." TO XPROGRAM-NAME (2). RL2054.2 +053900 MOVE 000240 TO XRECORD-LENGTH (2). RL2054.2 +054000 MOVE 0001 TO XBLOCK-SIZE (2). RL2054.2 +054100 MOVE "RC" TO CHARS-OR-RECORDS (2). RL2054.2 +054200 MOVE "RL" TO XFILE-ORGANIZATION (2). RL2054.2 +054300 MOVE "S" TO XLABEL-TYPE (2). RL2054.2 +054400 MOVE 00300 TO RL-FS2-FILESIZE. RL2054.2 +054500 MOVE 00300 TO RECORDS-IN-FILE (2). RL2054.2 +054600 MOVE 00001 TO WRK-RL-FS2-RECKEY. RL2054.2 +054700 MOVE 00300 TO WRK-DU-05V00-004. RL2054.2 +054800 REL-TEST-001-R1. RL2054.2 +054900 ADD 0001 TO XRECORD-NUMBER (1). RL2054.2 +055000 MOVE WRK-RL-FD1-RECKEY TO XRECORD-KEY (1). RL2054.2 +055100 MOVE WRK-RL-FD1-FILLER TO ALTERNATE-KEY1 (1). RL2054.2 +055200 MOVE FILE-RECORD-INFO (1) TO RL-FD1R1-F-G-240. RL2054.2 +055300 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +055400 WRITE RL-FD1R1-F-G-240 RL2054.2 +055500 INVALID KEY RL2054.2 +055600 ADD 000001 TO INV-KEY-COUNTER. RL2054.2 +055700 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +055800 ADD 00001 TO WRK-RL-FD1-RECKEY. RL2054.2 +055900 SUBTRACT 00001 FROM WRK-DU-05V00-002. RL2054.2 +056000 IF XRECORD-NUMBER (1) LESS THAN RL-FD1-FILESIZE RL2054.2 +056100 GO TO REL-TEST-001-R1. RL2054.2 +056200 CLOSE RL-FD1. RL2054.2 +056300 REL-TEST-001-01. RL2054.2 +056400 MOVE "CREATE FILE RL-FD1" TO FEATURE. RL2054.2 +056500 MOVE 01 TO REC-CT. RL2054.2 +056600 IF EXCUT-COUNTER-06V00 NOT EQUAL TO RL-FD1-FILESIZE RL2054.2 +056700 PERFORM FAIL RL2054.2 +056800 MOVE RL-FD1-FILESIZE TO CORRECT-N RL2054.2 +056900 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-N RL2054.2 +057000 MOVE "INCORRECT NUMBER OF WRITES" TO RE-MARK RL2054.2 +057100 PERFORM PRINT-DETAIL RL2054.2 +057200 GO TO REL-INIT-001-R2. RL2054.2 +057300 IF INV-KEY-COUNTER NOT EQUAL TO ZERO RL2054.2 +057400 PERFORM FAIL RL2054.2 +057500 MOVE INV-KEY-COUNTER TO COMPUTED-N RL2054.2 +057600 MOVE ZERO TO CORRECT-N RL2054.2 +057700 MOVE "INVALID KEY ON WRITE" TO RE-MARK RL2054.2 +057800 PERFORM PRINT-DETAIL RL2054.2 +057900 GO TO REL-INIT-001-R2. RL2054.2 +058000* RL2054.2 +058100* 01 RL2054.2 +058200* RL2054.2 +058300 PERFORM PASS. RL2054.2 +058400 PERFORM REL-WRITE-001. RL2054.2 +058500 REL-INIT-001-R2. RL2054.2 +058600 MOVE ZERO TO INV-KEY-COUNTER. RL2054.2 +058700 MOVE ZERO TO EXCUT-COUNTER-06V00. RL2054.2 +058800 REL-TEST-001-R2. RL2054.2 +058900 ADD 0001 TO XRECORD-NUMBER (2). RL2054.2 +059000 MOVE WRK-RL-FS2-RECKEY TO XRECORD-KEY (2). RL2054.2 +059100 MOVE WRK-RL-FS2-FILLER TO ALTERNATE-KEY1 (2). RL2054.2 +059200 MOVE FILE-RECORD-INFO (2) TO RL-FS2R1-F-G-240. RL2054.2 +059300 WRITE RL-FS2R1-F-G-240 RL2054.2 +059400 INVALID KEY RL2054.2 +059500 ADD 000001 TO INV-KEY-COUNTER. RL2054.2 +059600 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +059700 ADD 00001 TO WRK-RL-FS2-RECKEY. RL2054.2 +059800 SUBTRACT 00001 FROM WRK-DU-05V00-004. RL2054.2 +059900 IF XRECORD-NUMBER (2) LESS THAN RL-FS2-FILESIZE RL2054.2 +060000 GO TO REL-TEST-001-R2. RL2054.2 +060100 CLOSE RL-FS2. RL2054.2 +060200 REL-TEST-001-02. RL2054.2 +060300 MOVE "CREATE FILE RL-FS2" TO FEATURE. RL2054.2 +060400 MOVE 02 TO REC-CT. RL2054.2 +060500 IF EXCUT-COUNTER-06V00 NOT EQUAL TO RL-FS2-FILESIZE RL2054.2 +060600 PERFORM FAIL RL2054.2 +060700 MOVE RL-FS2-FILESIZE TO CORRECT-N RL2054.2 +060800 MOVE EXCUT-COUNTER-06V00 TO COMPUTED-N RL2054.2 +060900 MOVE "INCORRECT NUMBER OF WRITES" TO RE-MARK RL2054.2 +061000 PERFORM PRINT-DETAIL RL2054.2 +061100 GO TO REL-EXIT-001. RL2054.2 +061200* RL2054.2 +061300* 02 RL2054.2 +061400* RL2054.2 +061500 IF INV-KEY-COUNTER NOT EQUAL TO ZERO RL2054.2 +061600 PERFORM FAIL RL2054.2 +061700 MOVE INV-KEY-COUNTER TO COMPUTED-N RL2054.2 +061800 MOVE ZERO TO CORRECT-N RL2054.2 +061900 MOVE "INVALID KEY ON WRITE" TO RE-MARK RL2054.2 +062000 PERFORM PRINT-DETAIL RL2054.2 +062100 GO TO REL-EXIT-001. RL2054.2 +062200 PERFORM PASS. RL2054.2 +062300 PERFORM REL-WRITE-001. RL2054.2 +062400 GO TO REL-EXIT-001. RL2054.2 +062500 REL-WRITE-001. RL2054.2 +062600 PERFORM PRINT-DETAIL. RL2054.2 +062700 REL-DELETE-001. RL2054.2 +062800 PERFORM DE-LETE. RL2054.2 +062900 PERFORM PRINT-DETAIL. RL2054.2 +063000 REL-EXIT-001. RL2054.2 +063100 EXIT. RL2054.2 +063200 REL-INIT-002. RL2054.2 +063300 PERFORM BLANK-LINE-PRINT. RL2054.2 +063400 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINED AS RL2054.2 +063500- "ACCESS MODE IS DYNAMIC." TO PRINT-REC. RL2054.2 +063600 PERFORM WRITE-LINE. RL2054.2 +063700 PERFORM BLANK-LINE-PRINT. RL2054.2 +063800 MOVE "READ NEXT" TO FEATURE. RL2054.2 +063900 MOVE ZERO TO REC-CT. RL2054.2 +064000 MOVE "REL-TEST-002" TO PAR-NAME. RL2054.2 +064100 REL-INIT-002-R1. RL2054.2 +064200 OPEN INPUT RL-FD1. RL2054.2 +064300 PERFORM REL-INIT-002-R. RL2054.2 +064400 REL-TEST-002-R1. RL2054.2 +064500 READ RL-FD1 NEXT. RL2054.2 +064600 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +064700 PERFORM REL-VERIFY-002 RL2054.2 +064800 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +064900 GO TO REL-TEST-002-R1. RL2054.2 +065000 CLOSE RL-FD1. RL2054.2 +065100 REL-TEST-002-01. RL2054.2 +065200 MOVE 01 TO REC-CT. RL2054.2 +065300 PERFORM REL-TEST-002. RL2054.2 +065400 GO TO REL-EXIT-002-01. RL2054.2 +065500* RL2054.2 +065600* 01 RL2054.2 +065700* RL2054.2 +065800 REL-DELETE-002-01. RL2054.2 +065900 MOVE 01 TO REC-CT. RL2054.2 +066000 PERFORM DE-LETE. RL2054.2 +066100 PERFORM REL-WRITE-002. RL2054.2 +066200 REL-EXIT-002-01. RL2054.2 +066300 EXIT. RL2054.2 +066400 REL-INIT-002-R2. RL2054.2 +066500 PERFORM REL-INIT-002-R. RL2054.2 +066600 OPEN INPUT RL-FD1. RL2054.2 +066700 REL-TEST-002-R2. RL2054.2 +066800 MOVE SPACE TO FILE-RECORD-INFO (9). RL2054.2 +066900 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +067000 READ RL-FD1 NEXT RECORD RL2054.2 +067100 INTO FILE-RECORD-INFO (9). RL2054.2 +067200 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +067300 PERFORM REL-VERIFY-002. RL2054.2 +067400 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC RL2054.2 +067500 ADD 000100 TO ERROR-COUNTER-06V00. RL2054.2 +067600 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +067700 GO TO REL-TEST-002-R2. RL2054.2 +067800 CLOSE RL-FD1. RL2054.2 +067900 REL-TEST-002-02. RL2054.2 +068000 MOVE 02 TO REC-CT. RL2054.2 +068100 PERFORM REL-TEST-002. RL2054.2 +068200* RL2054.2 +068300* 02 RL2054.2 +068400* RL2054.2 +068500 GO TO REL-EXIT-002-02. RL2054.2 +068600 REL-DELETE-002-02. RL2054.2 +068700 MOVE 02 TO REC-CT. RL2054.2 +068800 PERFORM DE-LETE. RL2054.2 +068900 PERFORM REL-WRITE-002. RL2054.2 +069000 REL-EXIT-002-02. RL2054.2 +069100 EXIT. RL2054.2 +069200 REL-INIT-002-R3. RL2054.2 +069300 OPEN INPUT RL-FD1. RL2054.2 +069400 PERFORM REL-INIT-002-R. RL2054.2 +069500 REL-TEST-002-R3. RL2054.2 +069600 MOVE SPACE TO FILE-RECORD-INFO (9). RL2054.2 +069700 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +069800 READ RL-FD1 NEXT RL2054.2 +069900 INTO FILE-RECORD-INFO (9). RL2054.2 +070000 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +070100 PERFORM REL-VERIFY-002. RL2054.2 +070200 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC RL2054.2 +070300 ADD 000100 TO ERROR-COUNTER-06V00. RL2054.2 +070400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +070500 GO TO REL-TEST-002-R3. RL2054.2 +070600 CLOSE RL-FD1. RL2054.2 +070700 REL-TEST-002-03. RL2054.2 +070800 MOVE 03 TO REC-CT. RL2054.2 +070900 PERFORM REL-TEST-002. RL2054.2 +071000* RL2054.2 +071100* 03 RL2054.2 +071200* RL2054.2 +071300 GO TO REL-EXIT-002-03. RL2054.2 +071400 REL-DELETE-002-03. RL2054.2 +071500 MOVE 03 TO REC-CT. RL2054.2 +071600 PERFORM DE-LETE. RL2054.2 +071700 PERFORM REL-WRITE-002. RL2054.2 +071800 REL-EXIT-002-03. RL2054.2 +071900 EXIT. RL2054.2 +072000 REL-INIT-002-R4. RL2054.2 +072100 OPEN INPUT RL-FD1. RL2054.2 +072200 PERFORM REL-INIT-002-R. RL2054.2 +072300 MOVE RL-FD1-FILESIZE TO ERROR-COUNTER-06V00. RL2054.2 +072400 ADD 000001 TO ERROR-COUNTER-06V00. RL2054.2 +072500 REL-TEST-002-R4. RL2054.2 +072600 MOVE SPACE TO FILE-RECORD-INFO (9). RL2054.2 +072700 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +072800 READ RL-FD1 NEXT INTO FILE-RECORD-INFO (9) AT END RL2054.2 +072900 SUBTRACT 000001 FROM ERROR-COUNTER-06V00 RL2054.2 +073000 GO TO REL-TEST-002-04. RL2054.2 +073100 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +073200 PERFORM REL-VERIFY-002. RL2054.2 +073300 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-REC RL2054.2 +073400 ADD 00100 TO ERROR-COUNTER-06V00. RL2054.2 +073500 IF EXCUT-COUNTER-06V00 GREATER THAN RL-FD1-FILESIZE RL2054.2 +073600 NEXT SENTENCE RL2054.2 +073700 ELSE RL2054.2 +073800 GO TO REL-TEST-002-R4. RL2054.2 +073900* RL2054.2 +074000* TEST REL-002-04 TESTS THE COBOL CONSTRUCT "READ FILE- RL2054.2 +074100* NAME NEXT INTO IDENTIFIER AT END". THE TEST READS THE FILE RL2054.2 +074200* SEQUENTIALY VIA THE RELATIVE KEY (RECORD KEY IS THE KEY OF RL2054.2 +074300* REFERENCE) UNTIL AN END-OF-FILE CONDITION OCCURS. A CHECK RL2054.2 +074400* IS MADE TO VERIFY THAT THE PROPER RECORDS WERE RETRIVED AND RL2054.2 +074500* THE AT END PATH WAS TAKEN ON THE 301 ST READ. RL2054.2 +074600* RL2054.2 +074700 REL-TEST-002-04. RL2054.2 +074800 CLOSE RL-FD1. RL2054.2 +074900 MOVE 04 TO REC-CT. RL2054.2 +075000 PERFORM REL-TEST-002. RL2054.2 +075100* .04 RL2054.2 +075200 GO TO REL-EXIT-002-04. RL2054.2 +075300 REL-DELETE-002-04. RL2054.2 +075400 MOVE 04 TO REC-CT. RL2054.2 +075500 PERFORM DE-LETE. RL2054.2 +075600 PERFORM REL-WRITE-002. RL2054.2 +075700 REL-EXIT-002-04. RL2054.2 +075800 EXIT. RL2054.2 +075900 REL-INIT-002-R5. RL2054.2 +076000 OPEN INPUT RL-FD1. RL2054.2 +076100 PERFORM REL-INIT-002-R. RL2054.2 +076200 MOVE "READ" TO FEATURE. RL2054.2 +076300 MOVE ZERO TO WRK-RL-FD1-RECKEY. RL2054.2 +076400 REL-TEST-002-R5. RL2054.2 +076500 ADD 00005 TO WRK-RL-FD1-RECKEY. RL2054.2 +076600 ADD 000004 TO LOGICAL-FILE-REC. RL2054.2 +076700 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +076800 READ RL-FD1. RL2054.2 +076900 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +077000 PERFORM REL-VERIFY-002. RL2054.2 +077100 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +077200 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +077300 GO TO REL-TEST-002-R5. RL2054.2 +077400 CLOSE RL-FD1. RL2054.2 +077500 REL-TEST-002-05. RL2054.2 +077600 MOVE 05 TO REC-CT. RL2054.2 +077700 PERFORM REL-TEST-002. RL2054.2 +077800* .05 RL2054.2 +077900 GO TO REL-EXIT-002-05. RL2054.2 +078000 REL-DELETE-002-05. RL2054.2 +078100 MOVE 05 TO REC-CT. RL2054.2 +078200 PERFORM DE-LETE. RL2054.2 +078300 PERFORM REL-WRITE-002. RL2054.2 +078400 REL-EXIT-002-05. RL2054.2 +078500 EXIT. RL2054.2 +078600 REL-INIT-002-R6. RL2054.2 +078700 OPEN INPUT RL-FD1. RL2054.2 +078800 PERFORM REL-INIT-002-R. RL2054.2 +078900 MOVE ZERO TO WRK-RL-FD1-RECKEY. RL2054.2 +079000 REL-TEST-002-R6. RL2054.2 +079100 MOVE SPACE TO FILE-RECORD-INFO (9). RL2054.2 +079200 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +079300 ADD 00005 TO WRK-RL-FD1-RECKEY. RL2054.2 +079400 ADD 000004 TO LOGICAL-FILE-REC. RL2054.2 +079500 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +079600 READ RL-FD1 INTO FILE-RECORD-INFO (9). RL2054.2 +079700 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +079800 PERFORM REL-VERIFY-002. RL2054.2 +079900 IF XRECORD-NUMBER (9) NOT EQUAL TO LOGICAL-FILE-RECRL2054.2 +080000 ADD 000100 TO ERROR-COUNTER-06V00. RL2054.2 +080100 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +080200 GO TO REL-TEST-002-R6. RL2054.2 +080300 CLOSE RL-FD1. RL2054.2 +080400 REL-TEST-002-06. RL2054.2 +080500 MOVE 06 TO REC-CT. RL2054.2 +080600 PERFORM REL-TEST-002. RL2054.2 +080700* .06 RL2054.2 +080800 GO TO REL-EXIT-002-06. RL2054.2 +080900 REL-DELETE-002-06. RL2054.2 +081000 MOVE 06 TO REC-CT. RL2054.2 +081100 PERFORM DE-LETE. RL2054.2 +081200 PERFORM REL-WRITE-002. RL2054.2 +081300 REL-EXIT-002-06. RL2054.2 +081400 EXIT. RL2054.2 +081500 REL-INIT-002-R7. RL2054.2 +081600 OPEN INPUT RL-FD1. RL2054.2 +081700 PERFORM REL-INIT-002-R. RL2054.2 +081800 MOVE ZERO TO WRK-RL-FD1-RECKEY. RL2054.2 +081900 MOVE ZERO TO LOGICAL-FILE-REC. RL2054.2 +082000 REL-TEST-002-R7. RL2054.2 +082100 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +082200 ADD 00005 TO WRK-RL-FD1-RECKEY. RL2054.2 +082300 ADD 0004 TO LOGICAL-FILE-REC. RL2054.2 +082400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +082500 READ RL-FD1 RECORD. RL2054.2 +082600 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +082700 PERFORM REL-VERIFY-002. RL2054.2 +082800 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +082900 GO TO REL-TEST-002-R7. RL2054.2 +083000 CLOSE RL-FD1. RL2054.2 +083100 REL-TEST-002-07. RL2054.2 +083200 MOVE 07 TO REC-CT. RL2054.2 +083300 PERFORM REL-TEST-002. RL2054.2 +083400* .07 RL2054.2 +083500 GO TO REL-EXIT-002-07. RL2054.2 +083600 REL-DELETE-002-07. RL2054.2 +083700 MOVE 07 TO REC-CT. RL2054.2 +083800 PERFORM DE-LETE. RL2054.2 +083900 PERFORM REL-WRITE-002. RL2054.2 +084000 REL-EXIT-002-07. RL2054.2 +084100 EXIT. RL2054.2 +084200 REL-INIT-002-R8. RL2054.2 +084300 OPEN INPUT RL-FD1. RL2054.2 +084400 PERFORM REL-INIT-002-R. RL2054.2 +084500 MOVE 00301 TO WRK-RL-FD1-RECKEY. RL2054.2 +084600 MOVE SPACE TO RL-FD1R1-F-G-240. RL2054.2 +084700 REL-TEST-002-R8. RL2054.2 +084800 ADD 00005 TO WRK-RL-FD1-RECKEY. RL2054.2 +084900 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +085000 READ RL-FD1 RECORD INVALID RL2054.2 +085100 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +085200 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +085300 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +085400 GO TO REL-TEST-002-R8. RL2054.2 +085500 CLOSE RL-FD1. RL2054.2 +085600 REL-TEST-002-08. RL2054.2 +085700 MOVE 08 TO REC-CT. RL2054.2 +085800 PERFORM REL-TEST-002. RL2054.2 +085900* .08 RL2054.2 +086000 GO TO REL-EXIT-002-08. RL2054.2 +086100 REL-DELETE-002-08. RL2054.2 +086200 MOVE 08 TO REC-CT. RL2054.2 +086300 PERFORM DE-LETE. RL2054.2 +086400 PERFORM REL-WRITE-002. RL2054.2 +086500 REL-EXIT-002-08. RL2054.2 +086600 EXIT. RL2054.2 +086700 REL-INIT-002-R9. RL2054.2 +086800 OPEN INPUT RL-FD1. RL2054.2 +086900 PERFORM REL-INIT-002-R. RL2054.2 +087000 MOVE 00301 TO WRK-RL-FD1-RECKEY. RL2054.2 +087100 MOVE SPACE TO RL-FD1R1-F-G-240. RL2054.2 +087200 REL-TEST-002-R9. RL2054.2 +087300 ADD 00004 TO WRK-RL-FD1-RECKEY. RL2054.2 +087400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +087500 MOVE SPACE TO FILE-RECORD-INFO (1). RL2054.2 +087600 READ RL-FD1 RECORD INVALID KEY RL2054.2 +087700 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +087800 ADD 00001 TO EXCUT-COUNTER-06V00. RL2054.2 +087900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +088000 GO TO REL-TEST-002-R9. RL2054.2 +088100 CLOSE RL-FD1. RL2054.2 +088200 REL-TEST-002-09. RL2054.2 +088300 MOVE 09 TO REC-CT. RL2054.2 +088400 PERFORM REL-TEST-002. RL2054.2 +088500* .09 RL2054.2 +088600 GO TO REL-EXIT-002-09. RL2054.2 +088700 REL-DELETE-002-09. RL2054.2 +088800 MOVE 09 TO REC-CT. RL2054.2 +088900 PERFORM DE-LETE. RL2054.2 +089000 PERFORM REL-WRITE-002. RL2054.2 +089100 REL-EXIT-002-09. RL2054.2 +089200 GO TO REL-EXIT-002. RL2054.2 +089300 REL-INIT-002-R. RL2054.2 +089400 MOVE 00010 TO ERROR-COUNTER-06V00. RL2054.2 +089500 MOVE ZERO TO EXCUT-COUNTER-06V00. RL2054.2 +089600 MOVE ZERO TO INV-KEY-COUNTER. RL2054.2 +089700 MOVE ZERO TO LOGICAL-FILE-REC. RL2054.2 +089800 REL-VERIFY-002. RL2054.2 +089900 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +090000 ADD 000001 TO LOGICAL-FILE-REC. RL2054.2 +090100 IF XRECORD-NUMBER (1) EQUAL TO LOGICAL-FILE-REC RL2054.2 +090200 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +090300 REL-TEST-002. RL2054.2 +090400 IF ERROR-COUNTER-06V00 EQUAL TO ZERO RL2054.2 +090500 PERFORM PASS RL2054.2 +090600 ELSE RL2054.2 +090700 PERFORM FAIL RL2054.2 +090800 MOVE ZERO TO CORRECT-N RL2054.2 +090900 MOVE ERROR-COUNTER-06V00 TO COMPUTED-N RL2054.2 +091000 MOVE "SEE PARA. - REL-TEST-002" TO RE-MARK. RL2054.2 +091100 PERFORM REL-WRITE-002. RL2054.2 +091200* RL2054.2 +091300* EACH TEST IS EXECUTED 10 TIMES EXCEPT FOR REL-TEST-002-04RL2054.2 +091400* WHICH IS EXECUTED 300 TIMES. FOLLOWING THE LAST RL2054.2 +091500* EXECUTION A TEST IS MADE ON ERROR-COUNTER-06V00 WHICH IS RL2054.2 +091600* EXPECTED TO BE ZERO. IF ERROR-COUNTER-06V00 IS NOT ZERO RL2054.2 +091700* THE VALUE IN THE COUNTER INDICATES HOW THE EXECUTION FAILED RL2054.2 +091800* AND THE NUMBER OF TIMES THE UNEXPECTED ACTION OCCURRED RL2054.2 +091900* DURING THE TEST. BEFORE THE TEST BEGINS ERROR-COUNTER-06V00 RL2054.2 +092000* IS INITIALIZED WITH A VALUE. EACH TIME THE CORRECT RECORD RL2054.2 +092100* WAS MADE AVAILABLE FOLLOWING THE READ, OR AN INVALID KEY RL2054.2 +092200* CONDITION OCCURRED THAT WAS EXPECTED FOLLOWING A READ OR RL2054.2 +092300* START, ERROR-COUNTER-06V00 IS DECREMENTED BY 1. RL2054.2 +092400* FOR EACH EXECUTION THAT DID NOT PRODUCE THE EXPECTED RL2054.2 +092500* RESULTS THE ERROR-COUNTER-06V00 IS INCREMENTED BY THE VALUE RL2054.2 +092600* FOR THE ACTION LISTED BELOW, E.G., VALUE 20003 WOULD INDICATERL2054.2 +092700* THAT OF THE 10 EXECUTIONS DURING THE TEST (READING LEFT TO RL2054.2 +092800* RIGHT) 2 INVALID KEY CONDITIONS AND 3 RECORDS RETRIEVED RL2054.2 +092900* AS A RESULT OF THE READ OR START WAS NOT-AS EXPECTED. RL2054.2 +093000* RL2054.2 +093100* RL2054.2 +093200* RL2054.2 +093300* COMPUTED RESULT INDICATED RL2054.2 +093400* INCREMENTS ACTION RL2054.2 +093500* RL2054.2 +093600* 000100 THE RECORD FOUND IN THE IDENTIFIER RL2054.2 +093700* SPECIFIED IN THE INTO PHRASE OF THE RL2054.2 +093800* READ STATEMENT WAS NOT THE RECORD RL2054.2 +093900* EXPECTED FOLLOWING EXECUTION OF THE RL2054.2 +094000* READ. RL2054.2 +094100* RL2054.2 +094200* 000001 THE RECORD RETREIVED FROM THE FILE RL2054.2 +094300* FOLLOWING THE READ WAS NOT THE ONE RL2054.2 +094400* EXPECTED. RL2054.2 +094500* RL2054.2 +094600* 010000 AN UNEXPECTED INVALID KEY OR AT END RL2054.2 +094700* CONDITION OCCURRED. NOTE - ASSUMPTION RL2054.2 +094800* IS THAT THE "USE" STATEMENT IS ONLY RL2054.2 +094900* EXECUTED WHEN AN INVALID KEY OR AT END RL2054.2 +095000* CONDITION OCCURS AND THE INVALID KEY OR RL2054.2 +095100* AT END PHRASE HAS NOT BEEN SPECIFIED. RL2054.2 +095200* RL2054.2 +095300 REL-WRITE-002. RL2054.2 +095400 PERFORM PRINT-DETAIL. RL2054.2 +095500 REL-EXIT-002. RL2054.2 +095600 EXIT. RL2054.2 +095700 REL-INIT-003. RL2054.2 +095800 OPEN INPUT RL-FD1. RL2054.2 +095900 OPEN INPUT RL-FS2. RL2054.2 +096000 PERFORM BLANK-LINE-PRINT. RL2054.2 +096100 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINE AS RL2054.2 +096200- "ACCESS MODE IS SEQUENTIAL" TO PRINT-REC. RL2054.2 +096300 PERFORM WRITE-LINE. RL2054.2 +096400 PERFORM BLANK-LINE-PRINT. RL2054.2 +096500 MOVE "START EQUAL TO" TO FEATURE. RL2054.2 +096600 MOVE "REL-TEST-003" TO PAR-NAME. RL2054.2 +096700 MOVE ZERO TO REC-CT. RL2054.2 +096800 PERFORM REL-INIT-003-R. RL2054.2 +096900 REL-TEST-003-R1. RL2054.2 +097000 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +097100 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +097200 START RL-FS2. RL2054.2 +097300 READ RL-FS2 RECORD AT END RL2054.2 +097400 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +097500 GO TO REL-TEST-003-01. RL2054.2 +097600 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +097700 PERFORM REL-VERIFY-003A. RL2054.2 +097800 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +097900 GO TO REL-TEST-003-R1. RL2054.2 +098000 REL-TEST-003-01. RL2054.2 +098100 MOVE 01 TO REC-CT. RL2054.2 +098200 PERFORM REL-TEST-003. RL2054.2 +098300* .01 RL2054.2 +098400 GO TO REL-EXIT-003-01. RL2054.2 +098500 REL-DELETE-003-01. RL2054.2 +098600 PERFORM DE-LETE. RL2054.2 +098700 PERFORM REL-WRITE-003. RL2054.2 +098800 REL-EXIT-003-01. RL2054.2 +098900 EXIT. RL2054.2 +099000 REL-INIT-003-R2. RL2054.2 +099100 PERFORM REL-INIT-003-R. RL2054.2 +099200 REL-TEST-003-R2. RL2054.2 +099300 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +099400 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +099500 START RL-FS2 KEY EQUAL TO RL-FS2-KEY. RL2054.2 +099600 READ RL-FS2 RECORD AT END RL2054.2 +099700 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +099800 GO TO REL-TEST-003-02. RL2054.2 +099900 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +100000 PERFORM REL-VERIFY-003A. RL2054.2 +100100 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +100200 GO TO REL-TEST-003-R2. RL2054.2 +100300 REL-TEST-003-02. RL2054.2 +100400 MOVE 02 TO REC-CT. RL2054.2 +100500 PERFORM REL-TEST-003. RL2054.2 +100600* .02 RL2054.2 +100700 GO TO REL-EXIT-003-02. RL2054.2 +100800 REL-DELETE-003-02. RL2054.2 +100900 MOVE 02 TO REC-CT. RL2054.2 +101000 PERFORM DE-LETE. RL2054.2 +101100 PERFORM REL-WRITE-003. RL2054.2 +101200 REL-EXIT-003-02. RL2054.2 +101300 EXIT. RL2054.2 +101400 REL-INIT-003-R3. RL2054.2 +101500 PERFORM REL-INIT-003-R. RL2054.2 +101600 REL-TEST-003-R3. RL2054.2 +101700 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +101800 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +101900 START RL-FS2 KEY IS EQUAL TO RL-FS2-KEY. RL2054.2 +102000 READ RL-FS2 RECORD AT END RL2054.2 +102100 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +102200 GO TO REL-TEST-003-03. RL2054.2 +102300 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +102400 PERFORM REL-VERIFY-003A. RL2054.2 +102500 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +102600 GO TO REL-TEST-003-R3. RL2054.2 +102700 REL-TEST-003-03. RL2054.2 +102800 MOVE 03 TO REC-CT. RL2054.2 +102900 PERFORM REL-TEST-003. RL2054.2 +103000* .03 RL2054.2 +103100 GO TO REL-EXIT-003-03. RL2054.2 +103200 REL-DELETE-003-03. RL2054.2 +103300 MOVE 03 TO REC-CT. RL2054.2 +103400 PERFORM DE-LETE. RL2054.2 +103500 PERFORM REL-WRITE-003. RL2054.2 +103600 REL-EXIT-003-03. RL2054.2 +103700 EXIT. RL2054.2 +103800 REL-INIT-003-R4. RL2054.2 +103900 PERFORM REL-INIT-003-R. RL2054.2 +104000 REL-TEST-003-R4. RL2054.2 +104100 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +104200 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +104300 START RL-FS2 KEY IS EQUAL RL-FS2-KEY. RL2054.2 +104400 READ RL-FS2 RECORD AT END RL2054.2 +104500 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +104600 GO TO REL-TEST-003-04. RL2054.2 +104700 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +104800 PERFORM REL-VERIFY-003A. RL2054.2 +104900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +105000 GO TO REL-TEST-003-R4. RL2054.2 +105100 REL-TEST-003-04. RL2054.2 +105200 MOVE 04 TO REC-CT. RL2054.2 +105300 PERFORM REL-TEST-003. RL2054.2 +105400* .04 RL2054.2 +105500 GO TO REL-EXIT-003-04. RL2054.2 +105600 REL-DELETE-003-04. RL2054.2 +105700 MOVE 04 TO REC-CT. RL2054.2 +105800 PERFORM DE-LETE. RL2054.2 +105900 PERFORM REL-WRITE-003. RL2054.2 +106000 REL-EXIT-003-04. RL2054.2 +106100 EXIT. RL2054.2 +106200 REL-INIT-003-R5. RL2054.2 +106300 PERFORM REL-INIT-003-R. RL2054.2 +106400 REL-TEST-003-R5. RL2054.2 +106500 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +106600 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +106700 START RL-FS2 KEY IS = RL-FS2-KEY. RL2054.2 +106800 READ RL-FS2 RECORD AT END RL2054.2 +106900 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +107000 GO TO REL-TEST-003-05. RL2054.2 +107100 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +107200 PERFORM REL-VERIFY-003A. RL2054.2 +107300 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +107400 GO TO REL-TEST-003-R5. RL2054.2 +107500 REL-TEST-003-05. RL2054.2 +107600 MOVE 05 TO REC-CT. RL2054.2 +107700 PERFORM REL-TEST-003. RL2054.2 +107800* .05 RL2054.2 +107900 GO TO REL-EXIT-003-05. RL2054.2 +108000 REL-DELETE-003-05. RL2054.2 +108100 MOVE 05 TO REC-CT. RL2054.2 +108200 PERFORM DE-LETE. RL2054.2 +108300 PERFORM REL-WRITE-003. RL2054.2 +108400 REL-EXIT-003-05. RL2054.2 +108500 EXIT. RL2054.2 +108600 REL-INIT-003-R6. RL2054.2 +108700 PERFORM REL-INIT-003-R. RL2054.2 +108800 ADD 000001 TO LOGICAL-FILE-REC. RL2054.2 +108900 MOVE "START GREATER THAN" TO FEATURE. RL2054.2 +109000 REL-TEST-003-R6. RL2054.2 +109100 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +109200 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +109300 START RL-FS2 KEY IS GREATER THAN RL-FS2-KEY. RL2054.2 +109400 READ RL-FS2 RECORD AT END RL2054.2 +109500 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +109600 GO TO REL-TEST-003-06. RL2054.2 +109700 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +109800 PERFORM REL-VERIFY-003A. RL2054.2 +109900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +110000 GO TO REL-TEST-003-R6. RL2054.2 +110100 REL-TEST-003-06. RL2054.2 +110200 MOVE 06 TO REC-CT. RL2054.2 +110300 PERFORM REL-TEST-003. RL2054.2 +110400* .06 RL2054.2 +110500 GO TO REL-EXIT-003-06. RL2054.2 +110600 REL-DELETE-003-06. RL2054.2 +110700 MOVE 06 TO REC-CT. RL2054.2 +110800 PERFORM DE-LETE. RL2054.2 +110900 PERFORM REL-WRITE-003. RL2054.2 +111000 REL-EXIT-003-06. RL2054.2 +111100 EXIT. RL2054.2 +111200 REL-INIT-003-R7. RL2054.2 +111300 PERFORM REL-INIT-003-R. RL2054.2 +111400 ADD 000001 TO LOGICAL-FILE-REC. RL2054.2 +111500 REL-TEST-003-R7. RL2054.2 +111600 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +111700 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +111800 START RL-FS2 KEY GREATER THAN RL-FS2-KEY. RL2054.2 +111900 READ RL-FS2 RECORD AT END RL2054.2 +112000 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +112100 GO TO REL-TEST-003-07. RL2054.2 +112200 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +112300 PERFORM REL-VERIFY-003A. RL2054.2 +112400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +112500 GO TO REL-TEST-003-R7. RL2054.2 +112600 REL-TEST-003-07. RL2054.2 +112700 MOVE 07 TO REC-CT. RL2054.2 +112800 PERFORM REL-TEST-003. RL2054.2 +112900* .07 RL2054.2 +113000 GO TO REL-EXIT-003-07. RL2054.2 +113100 REL-DELETE-003-07. RL2054.2 +113200 MOVE 07 TO REC-CT. RL2054.2 +113300 PERFORM DE-LETE. RL2054.2 +113400 PERFORM REL-WRITE-003. RL2054.2 +113500 REL-EXIT-003-07. RL2054.2 +113600 EXIT. RL2054.2 +113700 REL-INIT-003-R8. RL2054.2 +113800 PERFORM REL-INIT-003-R. RL2054.2 +113900 ADD 00001 TO LOGICAL-FILE-REC. RL2054.2 +114000 REL-TEST-003-R8. RL2054.2 +114100 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +114200 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +114300 START RL-FS2 KEY IS GREATER RL-FS2-KEY. RL2054.2 +114400 READ RL-FS2 RECORD AT END RL2054.2 +114500 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +114600 GO TO REL-TEST-003-08. RL2054.2 +114700 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +114800 PERFORM REL-VERIFY-003A. RL2054.2 +114900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +115000 GO TO REL-TEST-003-R8. RL2054.2 +115100 REL-TEST-003-08. RL2054.2 +115200 MOVE 08 TO REC-CT. RL2054.2 +115300 PERFORM REL-TEST-003. RL2054.2 +115400* .08 RL2054.2 +115500 GO TO REL-EXIT-003-08. RL2054.2 +115600 REL-DELETE-003-08. RL2054.2 +115700 MOVE 08 TO REC-CT. RL2054.2 +115800 PERFORM DE-LETE. RL2054.2 +115900 PERFORM REL-WRITE-003. RL2054.2 +116000 REL-EXIT-003-08. RL2054.2 +116100 EXIT. RL2054.2 +116200 REL-INIT-003-R9. RL2054.2 +116300 PERFORM REL-INIT-003-R. RL2054.2 +116400 ADD 00001 TO LOGICAL-FILE-REC. RL2054.2 +116500 REL-TEST-003-R9. RL2054.2 +116600 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +116700 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +116800 START RL-FS2 KEY IS > RL-FS2-KEY. RL2054.2 +116900 READ RL-FS2 RECORD AT END RL2054.2 +117000 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +117100 GO TO REL-TEST-003-09. RL2054.2 +117200 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +117300 PERFORM REL-VERIFY-003A. RL2054.2 +117400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +117500 GO TO REL-TEST-003-R9. RL2054.2 +117600 REL-TEST-003-09. RL2054.2 +117700 MOVE 09 TO REC-CT. RL2054.2 +117800 PERFORM REL-TEST-003. RL2054.2 +117900* .09 RL2054.2 +118000 GO TO REL-EXIT-003-09. RL2054.2 +118100 REL-DELETE-003-09. RL2054.2 +118200 MOVE 09 TO REC-CT. RL2054.2 +118300 PERFORM DE-LETE. RL2054.2 +118400 PERFORM REL-WRITE-003. RL2054.2 +118500 REL-EXIT-003-09. RL2054.2 +118600 EXIT. RL2054.2 +118700 REL-INIT-003-R10. RL2054.2 +118800 PERFORM REL-INIT-003-R. RL2054.2 +118900 ADD 00001 TO LOGICAL-FILE-REC. RL2054.2 +119000 REL-TEST-003-R10. RL2054.2 +119100 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +119200 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +119300 START RL-FS2 KEY > RL-FS2-KEY. RL2054.2 +119400 READ RL-FS2 RECORD AT END RL2054.2 +119500 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +119600 GO TO REL-TEST-003-10. RL2054.2 +119700 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +119800 PERFORM REL-VERIFY-003A. RL2054.2 +119900 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +120000 GO TO REL-TEST-003-R10. RL2054.2 +120100 REL-TEST-003-10. RL2054.2 +120200 MOVE 10 TO REC-CT. RL2054.2 +120300 PERFORM REL-TEST-003. RL2054.2 +120400* .10 RL2054.2 +120500 GO TO REL-EXIT-003-10. RL2054.2 +120600 REL-DELETE-003-10. RL2054.2 +120700 MOVE 10 TO REC-CT. RL2054.2 +120800 PERFORM DE-LETE. RL2054.2 +120900 PERFORM REL-WRITE-003. RL2054.2 +121000 REL-EXIT-003-10. RL2054.2 +121100 EXIT. RL2054.2 +121200 REL-INIT-003-R11. RL2054.2 +121300 MOVE "START NOT LESS THAN" TO FEATURE. RL2054.2 +121400 PERFORM REL-INIT-003-R. RL2054.2 +121500 REL-TEST-003-R11. RL2054.2 +121600 ADD 00003 TO WRK-RL-FS2-RECKEY. RL2054.2 +121700 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +121800 START RL-FS2 KEY IS NOT LESS THAN RL-FS2-KEY. RL2054.2 +121900 READ RL-FS2 RECORD AT END RL2054.2 +122000 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +122100 GO TO REL-TEST-003-11. RL2054.2 +122200 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +122300 PERFORM REL-VERIFY-003A. RL2054.2 +122400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +122500 GO TO REL-TEST-003-R11. RL2054.2 +122600 REL-TEST-003-11. RL2054.2 +122700 MOVE 11 TO REC-CT. RL2054.2 +122800 PERFORM REL-TEST-003. RL2054.2 +122900* .11 RL2054.2 +123000 GO TO REL-EXIT-003-11. RL2054.2 +123100 REL-DELETE-003-11. RL2054.2 +123200 MOVE 11 TO REC-CT. RL2054.2 +123300 PERFORM DE-LETE. RL2054.2 +123400 PERFORM REL-WRITE-003. RL2054.2 +123500 REL-EXIT-003-11. RL2054.2 +123600 EXIT. RL2054.2 +123700 REL-INIT-003-R12. RL2054.2 +123800 PERFORM REL-INIT-003-R. RL2054.2 +123900 REL-TEST-003-R12. RL2054.2 +124000 ADD 0003 TO WRK-RL-FS2-RECKEY. RL2054.2 +124100 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +124200 START RL-FS2 KEY IS NOT LESS RL-FS2-KEY. RL2054.2 +124300 READ RL-FS2 RECORD AT END RL2054.2 +124400 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +124500 GO TO REL-TEST-003-12. RL2054.2 +124600 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +124700 PERFORM REL-VERIFY-003A. RL2054.2 +124800 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +124900 GO TO REL-TEST-003-R12. RL2054.2 +125000 REL-TEST-003-12. RL2054.2 +125100 MOVE 12 TO REC-CT. RL2054.2 +125200 PERFORM REL-TEST-003. RL2054.2 +125300* .12 RL2054.2 +125400 GO TO REL-EXIT-003-12. RL2054.2 +125500 REL-DELETE-003-12. RL2054.2 +125600 MOVE 12 TO REC-CT. RL2054.2 +125700 PERFORM DE-LETE. RL2054.2 +125800 PERFORM REL-WRITE-003. RL2054.2 +125900 REL-EXIT-003-12. RL2054.2 +126000 EXIT. RL2054.2 +126100 REL-INIT-003-R13. RL2054.2 +126200 PERFORM REL-INIT-003-R. RL2054.2 +126300 REL-TEST-003-R13. RL2054.2 +126400 ADD 003 TO WRK-RL-FS2-RECKEY. RL2054.2 +126500 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +126600 START RL-FS2 KEY NOT LESS THAN RL-FS2-KEY. RL2054.2 +126700 READ RL-FS2 RECORD AT END RL2054.2 +126800 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +126900 GO TO REL-TEST-003-13. RL2054.2 +127000 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +127100 PERFORM REL-VERIFY-003A. RL2054.2 +127200 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +127300 GO TO REL-TEST-003-R13. RL2054.2 +127400 REL-TEST-003-13. RL2054.2 +127500 MOVE 13 TO REC-CT. RL2054.2 +127600 PERFORM REL-TEST-003. RL2054.2 +127700* .13 RL2054.2 +127800 GO TO REL-EXIT-003-13. RL2054.2 +127900 REL-DELETE-003-13. RL2054.2 +128000 MOVE 13 TO REC-CT. RL2054.2 +128100 PERFORM DE-LETE. RL2054.2 +128200 PERFORM REL-WRITE-003. RL2054.2 +128300 REL-EXIT-003-13. RL2054.2 +128400 EXIT. RL2054.2 +128500 REL-INIT-003-R14. RL2054.2 +128600 PERFORM REL-INIT-003-R. RL2054.2 +128700 REL-TEST-003-R14. RL2054.2 +128800 ADD 003 TO WRK-RL-FS2-RECKEY. RL2054.2 +128900 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +129000 START RL-FS2 KEY IS NOT < RL-FS2-KEY. RL2054.2 +129100 READ RL-FS2 RECORD AT END RL2054.2 +129200 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +129300 GO TO REL-TEST-003-14. RL2054.2 +129400 MOVE RL-FS2R1-F-G-240 TO FILE-RECORD-INFO (2). RL2054.2 +129500 PERFORM REL-VERIFY-003A. RL2054.2 +129600 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +129700 GO TO REL-TEST-003-R14. RL2054.2 +129800 REL-TEST-003-14. RL2054.2 +129900 MOVE 14 TO REC-CT. RL2054.2 +130000 PERFORM REL-TEST-003. RL2054.2 +130100* .14 RL2054.2 +130200 GO TO REL-EXIT-003-14. RL2054.2 +130300 REL-DELETE-003-14. RL2054.2 +130400 MOVE 14 TO REC-CT. RL2054.2 +130500 PERFORM DE-LETE. RL2054.2 +130600 PERFORM REL-WRITE-003. RL2054.2 +130700 REL-EXIT-003-14. RL2054.2 +130800 EXIT. RL2054.2 +130900 REL-INIT-003-R15. RL2054.2 +131000 PERFORM BLANK-LINE-PRINT. RL2054.2 +131100 MOVE "THE FOLLOWING TESTS ACCESS A FILE DEFINED AS RL2054.2 +131200- "ACCESS MODE IS DYNAMIC" TO PRINT-REC. RL2054.2 +131300 PERFORM WRITE-LINE. RL2054.2 +131400 PERFORM BLANK-LINE-PRINT. RL2054.2 +131500 MOVE "START EQUAL TO " TO FEATURE. RL2054.2 +131600 PERFORM REL-INIT-003-R. RL2054.2 +131700 REL-TEST-003-R15. RL2054.2 +131800 ADD 0002 TO WRK-RL-FD1-RECKEY. RL2054.2 +131900 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +132000 START RL-FD1 KEY IS EQUAL TO RL-FD1-KEY INVALID KEY RL2054.2 +132100 ADD 010000 TO ERROR-COUNTER-06V00. RL2054.2 +132200 READ RL-FD1 NEXT RECORD AT END RL2054.2 +132300 ADD 010000 TO ERROR-COUNTER-06V00 RL2054.2 +132400 GO TO REL-TEST-003-15. RL2054.2 +132500 MOVE RL-FD1R1-F-G-240 TO FILE-RECORD-INFO (1). RL2054.2 +132600 PERFORM REL-VERIFY-003B. RL2054.2 +132700 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +132800 GO TO REL-TEST-003-R15. RL2054.2 +132900 REL-TEST-003-15. RL2054.2 +133000 MOVE 15 TO REC-CT. RL2054.2 +133100 PERFORM REL-TEST-003. RL2054.2 +133200* .15 RL2054.2 +133300 GO TO REL-EXIT-003-15. RL2054.2 +133400 REL-DELETE-003-15. RL2054.2 +133500 MOVE 15 TO REC-CT. RL2054.2 +133600 PERFORM DE-LETE. RL2054.2 +133700 PERFORM REL-WRITE-003. RL2054.2 +133800 REL-EXIT-003-15. RL2054.2 +133900 EXIT. RL2054.2 +134000 REL-INIT-003-R16. RL2054.2 +134100 MOVE "START INVALID KEY" TO FEATURE. RL2054.2 +134200 PERFORM REL-INIT-003-R. RL2054.2 +134300 MOVE RL-FD1-FILESIZE TO WRK-RL-FD1-RECKEY. RL2054.2 +134400 MOVE RL-FD1-FILESIZE TO LOGICAL-FILE-REC. RL2054.2 +134500 REL-TEST-003-R16. RL2054.2 +134600 ADD 0002 TO WRK-RL-FD1-RECKEY. RL2054.2 +134700 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +134800 START RL-FD1 KEY IS EQUAL TO RL-FD1-KEY INVALID RL2054.2 +134900 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +135000 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +135100 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +135200 GO TO REL-TEST-003-R16. RL2054.2 +135300 REL-TEST-003-16. RL2054.2 +135400 MOVE 16 TO REC-CT. RL2054.2 +135500 PERFORM REL-TEST-003. RL2054.2 +135600* .16 RL2054.2 +135700 GO TO REL-EXIT-003-16. RL2054.2 +135800 REL-DELETE-003-16. RL2054.2 +135900 MOVE 16 TO REC-CT. RL2054.2 +136000 PERFORM DE-LETE. RL2054.2 +136100 PERFORM REL-WRITE-003. RL2054.2 +136200 REL-EXIT-003-16. RL2054.2 +136300 EXIT. RL2054.2 +136400 REL-INIT-003-R17. RL2054.2 +136500 PERFORM REL-INIT-003-R. RL2054.2 +136600 MOVE RL-FD1-FILESIZE TO LOGICAL-FILE-REC. RL2054.2 +136700 MOVE RL-FD1-FILESIZE TO WRK-RL-FD1-RECKEY. RL2054.2 +136800 REL-TEST-003-R17. RL2054.2 +136900 ADD 00003 TO WRK-RL-FD1-RECKEY. RL2054.2 +137000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +137100 START RL-FD1 INVALID KEY RL2054.2 +137200 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +137300 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +137400 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +137500 GO TO REL-TEST-003-R17. RL2054.2 +137600 REL-TEST-003-17. RL2054.2 +137700 MOVE 17 TO REC-CT. RL2054.2 +137800 PERFORM REL-TEST-003. RL2054.2 +137900* .17 RL2054.2 +138000 GO TO REL-EXIT-003-17. RL2054.2 +138100 REL-DELETE-003-17. RL2054.2 +138200 MOVE 17 TO REC-CT. RL2054.2 +138300 PERFORM DE-LETE. RL2054.2 +138400 PERFORM REL-WRITE-003. RL2054.2 +138500 REL-EXIT-003-17. RL2054.2 +138600 EXIT. RL2054.2 +138700 REL-INIT-003-R18. RL2054.2 +138800 PERFORM REL-INIT-003-R. RL2054.2 +138900 MOVE RL-FD1-FILESIZE TO LOGICAL-FILE-REC. RL2054.2 +139000 MOVE RL-FD1-FILESIZE TO WRK-RL-FD1-RECKEY. RL2054.2 +139100 REL-TEST-003-R18. RL2054.2 +139200 ADD 00003 TO WRK-RL-FD1-RECKEY. RL2054.2 +139300 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +139400 START RL-FD1 ; INVALID KEY RL2054.2 +139500 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +139600 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +139700 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +139800 GO TO REL-TEST-003-R18. RL2054.2 +139900 REL-TEST-003-18. RL2054.2 +140000 MOVE 18 TO REC-CT. RL2054.2 +140100 PERFORM REL-TEST-003. RL2054.2 +140200* .18 RL2054.2 +140300 GO TO REL-EXIT-003-18. RL2054.2 +140400 REL-DELETE-003-18. RL2054.2 +140500 MOVE 18 TO REC-CT. RL2054.2 +140600 PERFORM DE-LETE. RL2054.2 +140700 PERFORM REL-WRITE-003. RL2054.2 +140800 REL-EXIT-003-18. RL2054.2 +140900 EXIT. RL2054.2 +141000 REL-INIT-003-R19. RL2054.2 +141100 PERFORM REL-INIT-003-R. RL2054.2 +141200 MOVE RL-FD1-FILESIZE TO WRK-RL-FD1-RECKEY. RL2054.2 +141300 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +141400 REL-TEST-003-R19. RL2054.2 +141500 ADD 000002 TO WRK-RL-FD1-RECKEY. RL2054.2 +141600 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +141700 START RL-FD1 KEY IS EQUAL TO RL-FD1-KEY ; INVALID KEY RL2054.2 +141800 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +141900 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +142000 IF EXCUT-COUNTER-06V00 LESS THAN 10 RL2054.2 +142100 GO TO REL-TEST-003-R19. RL2054.2 +142200 REL-TEST-003-19. RL2054.2 +142300 MOVE 19 TO REC-CT. RL2054.2 +142400 PERFORM REL-TEST-003. RL2054.2 +142500* .19 RL2054.2 +142600 GO TO REL-END-003. RL2054.2 +142700 REL-DELETE-003-19. RL2054.2 +142800 MOVE 19 TO REC-CT. RL2054.2 +142900 PERFORM DE-LETE. RL2054.2 +143000 PERFORM REL-WRITE-003. RL2054.2 +143100 REL-EXIT-003-19. RL2054.2 +143200 EXIT. RL2054.2 +143300 REL-INIT-003-R. RL2054.2 +143400 MOVE ZERO TO LOGICAL-FILE-REC. RL2054.2 +143500 MOVE ZERO TO EXCUT-COUNTER-06V00. RL2054.2 +143600 MOVE 00055 TO WRK-DU-05V00-002. RL2054.2 +143700 MOVE 00050 TO WRK-DU-05V00-004. RL2054.2 +143800 MOVE ZERO TO WRK-RL-FS2-RECKEY. RL2054.2 +143900 MOVE ZERO TO WRK-RL-FD1-RECKEY. RL2054.2 +144000 MOVE 10 TO ERROR-COUNTER-06V00. RL2054.2 +144100 REL-VERIFY-003A. RL2054.2 +144200 IF ASCEND RL2054.2 +144300 ADD 000003 TO LOGICAL-FILE-REC RL2054.2 +144400 ELSE RL2054.2 +144500 SUBTRACT 000003 FROM LOGICAL-FILE-REC. RL2054.2 +144600 IF LOGICAL-FILE-REC EQUAL TO XRECORD-NUMBER (2) RL2054.2 +144700 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +144800 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +144900 REL-VERIFY-003B. RL2054.2 +145000 IF ASCEND RL2054.2 +145100 ADD 000002 TO LOGICAL-FILE-REC RL2054.2 +145200 ELSE RL2054.2 +145300 SUBTRACT 000002 FROM LOGICAL-FILE-REC. RL2054.2 +145400 IF LOGICAL-FILE-REC EQUAL TO XRECORD-NUMBER (1) RL2054.2 +145500 SUBTRACT 000001 FROM ERROR-COUNTER-06V00. RL2054.2 +145600 ADD 000001 TO EXCUT-COUNTER-06V00. RL2054.2 +145700 REL-TEST-003. RL2054.2 +145800 IF EXCUT-COUNTER-06V00 NOT EQUAL TO 000010 RL2054.2 +145900 MULTIPLY 100 BY EXCUT-COUNTER-06V00 RL2054.2 +146000 ADD EXCUT-COUNTER-06V00 TO ERROR-COUNTER-06V00. RL2054.2 +146100 IF ERROR-COUNTER-06V00 EQUAL TO ZERO RL2054.2 +146200 PERFORM PASS RL2054.2 +146300 ELSE RL2054.2 +146400 PERFORM FAIL RL2054.2 +146500 MOVE ZERO TO CORRECT-N RL2054.2 +146600 MOVE ERROR-COUNTER-06V00 TO COMPUTED-N RL2054.2 +146700 MOVE "SEE PARA. - REL-TEST-003" TO RE-MARK. RL2054.2 +146800 PERFORM REL-WRITE-003. RL2054.2 +146900* RL2054.2 +147000* EACH TEST IS EXECUTED 10 TIMES. FOLLOWING THE 10TH RL2054.2 +147100* EXECUTION A TEST IS MADE ON ERROR-COUNTER-06V00 WHICH IS RL2054.2 +147200* EXPECTED TO BE ZERO. IF ERROR-COUNTER-06V00 IS NOT ZERO RL2054.2 +147300* THE VALUE IN THE COUNTER INDICATES HOW THE EXECUTION FAILED RL2054.2 +147400* AND THE NUMBER OF TIMES THE UNEXPECTED ACTION OCCURRED RL2054.2 +147500* DURING THE TEST. BEFORE THE TEST BEGINS ERROR-COUNTER-06V00 RL2054.2 +147600* IS LOADED WITH THE VALUE 10. EACH TIME THE CORRECT RECORD RL2054.2 +147700* WAS MADE AVAILABLE FOLLOWING THE READ, OR AN INVALID KEY RL2054.2 +147800* CONDITION OCCURRED THAT WAS EXPECTED FOLLOWING A READ OR RL2054.2 +147900* START, ERROR-COUNTER-06V00 IS DECREMENTED BY 1. RL2054.2 +148000* FOR EACH ACTION THAT DID NOT OCCUR AS RL2054.2 +148100* EXPECTED THE ERROR-COUNTER-06V00 IS INCREMENTED BY THE VALUE RL2054.2 +148200* FOR THE ACTION LISTED BELOW, E.G., VALUE 20003 WOULD INDICATERL2054.2 +148300* THAT OF THE 10 EXECUTIONS DURING THE TEST (READING LEFT TO RL2054.2 +148400* RIGHT) 2 INVALID KEY CONDITIONS AND 3 RECORDS RETRIEVED RL2054.2 +148500* AS A RESULT OF THE READ OR START WAS NOT AS EXPECTED. RL2054.2 +148600* RL2054.2 +148700* COMPUTED RESULT INDICATED RL2054.2 +148800* INCREMENTS ACTION RL2054.2 +148900* RL2054.2 +149000* 000001 THE RECORD RETREIVED FROM THE FILE RL2054.2 +149100* FOLLOWING THE READ WAS NOT THE ONE RL2054.2 +149200* EXPECTED. RL2054.2 +149300* RL2054.2 +149400* 000100 INDICATES,BY 10"S THE NUMBER OF TIMES THE RL2054.2 +149500* TEST WAS EXECUTED. RL2054.2 +149600* RL2054.2 +149700* 010000 AN UNEXPECTED INVALID KEY OR AT END RL2054.2 +149800* CONDITION OCCURRED. NOTE - ASSUMPTION RL2054.2 +149900* IS THAT THE "USE" STATEMENT IS ONLY RL2054.2 +150000* EXECUTED WHEN AN INVALID KEY OR AT END RL2054.2 +150100* CONDITION OCCURS AND THE INVALID KEY OR RL2054.2 +150200* AT END PHRASE HAS NOT BEEN SPECIFIED. RL2054.2 +150300* RL2054.2 +150400 REL-WRITE-003. RL2054.2 +150500 PERFORM PRINT-DETAIL. RL2054.2 +150600 REL-END-003. RL2054.2 +150700 CLOSE RL-FD1. RL2054.2 +150800 CLOSE RL-FS2. RL2054.2 +150900 REL-EXIT-003. RL2054.2 +151000 EXIT. RL2054.2 +151100* RL2054.2 +151200* THE FOLLOWING SECTION CONTAINS ALL THE NEW TESTS FOR 8X: RL2054.2 +151300* RL2054.2 +151400 NEW-COBOL-8X-TESTS SECTION. RL2054.2 +151500*========================== RL2054.2 +151600 REL-8X-INIT-1. RL2054.2 +151700 MOVE "XVII-70 2.2.37" TO ANSI-REFERENCE. RL2054.2 +151800 MOVE "REL-8X-TEST-1" TO PAR-NAME. RL2054.2 +151900 OPEN I-O RL-FD1. RL2054.2 +152000* DELETE THE NEXT LINE TO DELETE THE TEST RL2054.2 +152100* GO TO REL-8X-INIT-1-BETA. RL2054.2 +152200 REL-8X-INIT-1-ALPHA. RL2054.2 +152300 GO TO REL-8X-DELETE-1. RL2054.2 +152400 REL-8X-INIT-1-BETA. RL2054.2 +152500 MOVE LOW-VALUES TO WRK-RL-FD1-RECKEY-CHAR. RL2054.2 +152600 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +152700 MOVE 301 TO RECORDS-IN-FILE (1). RL2054.2 +152800 MOVE FILE-RECORD-INFO (1) TO RL-FD1R1-F-G-240. RL2054.2 +152900 WRITE RL-FD1R1-F-G-240 RL2054.2 +153000 INVALID KEY RL2054.2 +153100 MOVE "INVALID KEY ON WRITING NEW 1ST RECORD" RL2054.2 +153200 TO RE-MARK RL2054.2 +153300 PERFORM FAIL RL2054.2 +153400 PERFORM PRINT-DETAIL RL2054.2 +153500 GO TO REL-8X-INIT-2. RL2054.2 +153600 MOVE 302 TO RECORDS-IN-FILE (1). RL2054.2 +153700 MOVE FILE-RECORD-INFO (1) TO RL-FD1R1-F-G-240. RL2054.2 +153800 MOVE ZERO TO RL-FD1-KEY. RL2054.2 +153900 WRITE RL-FD1R1-F-G-240 RL2054.2 +154000 INVALID KEY RL2054.2 +154100 MOVE "INVALID KEY ON WRITING NEW 2ND RECORD" RL2054.2 +154200 TO RE-MARK RL2054.2 +154300 PERFORM FAIL RL2054.2 +154400 PERFORM PRINT-DETAIL RL2054.2 +154500 GO TO REL-8X-INIT-2. RL2054.2 +154600 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +154700 GO TO REL-8X-TEST-1-0. RL2054.2 +154800 REL-8X-DELETE-1. RL2054.2 +154900 PERFORM DE-LETE. RL2054.2 +155000 PERFORM PRINT-DETAIL. RL2054.2 +155100 GO TO REL-8X-INIT-2. RL2054.2 +155200 REL-8X-TEST-1-0. RL2054.2 +155300 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +155400 REL-8X-TEST-1-1. RL2054.2 +155500 IF RECORDS-IN-FILE (1) = 301 RL2054.2 +155600 PERFORM PASS RL2054.2 +155700 GO TO REL-8X-WRITE-1. RL2054.2 +155800 MOVE "FIRST RECORD JUST INSERTED NOT FOUND" TO RE-MARK. RL2054.2 +155900 PERFORM FAIL. RL2054.2 +156000 REL-8X-WRITE-1. RL2054.2 +156100 PERFORM PRINT-DETAIL. RL2054.2 +156200* RL2054.2 +156300 REL-8X-INIT-2. RL2054.2 +156400 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +156500 MOVE "REL-8X-TEST-2" TO PAR-NAME. RL2054.2 +156600 OPEN I-O RL-FS2. RL2054.2 +156700 MOVE 123 TO WRK-RL-FS2-RECKEY. RL2054.2 +156800 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +156900 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +157000 GO TO REL-8X-TEST-2-0. RL2054.2 +157100 REL-8X-DELETE-2. RL2054.2 +157200 PERFORM DE-LETE. RL2054.2 +157300 PERFORM PRINT-DETAIL. RL2054.2 +157400 GO TO REL-8X-INIT-3. RL2054.2 +157500 REL-8X-TEST-2-0. RL2054.2 +157600 START RL-FS2 RL2054.2 +157700 KEY IS GREATER THAN OR EQUAL TO RL-FS2-KEY. RL2054.2 +157800 READ RL-FS2 NEXT INTO FILE-RECORD-INFO (1) RL2054.2 +157900 AT END MOVE "AT END ENCOUNTERED" TO RE-MARK RL2054.2 +158000 PERFORM FAIL RL2054.2 +158100 PERFORM PRINT-DETAIL RL2054.2 +158200 GO TO REL-8X-INIT-3. RL2054.2 +158300 REL-8X-TEST-2-1. RL2054.2 +158400 IF XRECORD-NUMBER (1) < 123 RL2054.2 +158500 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +158600 TO RE-MARK RL2054.2 +158700 MOVE 123 TO CORRECT-N RL2054.2 +158800 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +158900 PERFORM FAIL RL2054.2 +159000 PERFORM PRINT-DETAIL RL2054.2 +159100 ELSE RL2054.2 +159200 PERFORM PASS RL2054.2 +159300 PERFORM PRINT-DETAIL. RL2054.2 +159400* RL2054.2 +159500 REL-8X-INIT-3. RL2054.2 +159600 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +159700 MOVE "REL-8X-TEST-3" TO PAR-NAME. RL2054.2 +159800 MOVE 154 TO WRK-RL-FS2-RECKEY. RL2054.2 +159900 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +160000 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +160100 GO TO REL-8X-TEST-3-0. RL2054.2 +160200 REL-8X-DELETE-3. RL2054.2 +160300 PERFORM DE-LETE. RL2054.2 +160400 PERFORM PRINT-DETAIL. RL2054.2 +160500 GO TO REL-8X-INIT-4. RL2054.2 +160600 REL-8X-TEST-3-0. RL2054.2 +160700 START RL-FS2 RL2054.2 +160800 KEY GREATER OR EQUAL TO RL-FS2-KEY. RL2054.2 +160900 READ RL-FS2 NEXT INTO FILE-RECORD-INFO (1) RL2054.2 +161000 AT END MOVE "AT END ENCOUNTERED" TO RE-MARK RL2054.2 +161100 PERFORM FAIL RL2054.2 +161200 PERFORM PRINT-DETAIL RL2054.2 +161300 GO TO REL-8X-INIT-4. RL2054.2 +161400 REL-8X-TEST-3-1. RL2054.2 +161500 IF XRECORD-NUMBER (1) < 154 RL2054.2 +161600 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +161700 TO RE-MARK RL2054.2 +161800 MOVE 154 TO CORRECT-N RL2054.2 +161900 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +162000 PERFORM FAIL RL2054.2 +162100 PERFORM PRINT-DETAIL RL2054.2 +162200 ELSE RL2054.2 +162300 PERFORM PASS RL2054.2 +162400 PERFORM PRINT-DETAIL. RL2054.2 +162500* RL2054.2 +162600 REL-8X-INIT-4. RL2054.2 +162700 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +162800 MOVE "REL-8X-TEST-4" TO PAR-NAME. RL2054.2 +162900 MOVE 226 TO WRK-RL-FS2-RECKEY. RL2054.2 +163000 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +163100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +163200 GO TO REL-8X-TEST-4-0. RL2054.2 +163300 REL-8X-DELETE-4. RL2054.2 +163400 PERFORM DE-LETE. RL2054.2 +163500 PERFORM PRINT-DETAIL. RL2054.2 +163600 GO TO REL-8X-INIT-5. RL2054.2 +163700 REL-8X-TEST-4-0. RL2054.2 +163800 START RL-FS2 RL2054.2 +163900 KEY IS >= RL-FS2-KEY. RL2054.2 +164000 READ RL-FS2 NEXT INTO FILE-RECORD-INFO (1) RL2054.2 +164100 AT END MOVE "AT END ENCOUNTERED" TO RE-MARK RL2054.2 +164200 PERFORM FAIL RL2054.2 +164300 PERFORM PRINT-DETAIL RL2054.2 +164400 GO TO REL-8X-INIT-5. RL2054.2 +164500 REL-8X-TEST-4-1. RL2054.2 +164600 IF XRECORD-NUMBER (1) < 226 RL2054.2 +164700 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +164800 TO RE-MARK RL2054.2 +164900 MOVE 226 TO CORRECT-N RL2054.2 +165000 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +165100 PERFORM FAIL RL2054.2 +165200 PERFORM PRINT-DETAIL RL2054.2 +165300 ELSE RL2054.2 +165400 PERFORM PASS RL2054.2 +165500 PERFORM PRINT-DETAIL. RL2054.2 +165600* RL2054.2 +165700 REL-8X-INIT-5. RL2054.2 +165800 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +165900 MOVE "REL-8X-TEST-5" TO PAR-NAME. RL2054.2 +166000 MOVE 300 TO WRK-RL-FS2-RECKEY. RL2054.2 +166100 MOVE WRK-RL-FS2-RECKEY TO RL-FS2-KEY. RL2054.2 +166200 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +166300 GO TO REL-8X-TEST-5-0. RL2054.2 +166400 REL-8X-DELETE-5. RL2054.2 +166500 PERFORM DE-LETE. RL2054.2 +166600 PERFORM PRINT-DETAIL. RL2054.2 +166700 GO TO REL-8X-INIT-6. RL2054.2 +166800 REL-8X-TEST-5-0. RL2054.2 +166900 START RL-FS2 RL2054.2 +167000 KEY >= RL-FS2-KEY. RL2054.2 +167100 READ RL-FS2 NEXT INTO FILE-RECORD-INFO (1) RL2054.2 +167200 AT END MOVE "AT END ENCOUNTERED" TO RE-MARK RL2054.2 +167300 PERFORM FAIL RL2054.2 +167400 PERFORM PRINT-DETAIL RL2054.2 +167500 GO TO REL-8X-INIT-6. RL2054.2 +167600 REL-8X-TEST-5-1. RL2054.2 +167700 IF XRECORD-NUMBER (1) < 300 RL2054.2 +167800 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +167900 TO RE-MARK RL2054.2 +168000 MOVE 300 TO CORRECT-N RL2054.2 +168100 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +168200 PERFORM FAIL RL2054.2 +168300 PERFORM PRINT-DETAIL RL2054.2 +168400 ELSE RL2054.2 +168500 PERFORM PASS RL2054.2 +168600 PERFORM PRINT-DETAIL. RL2054.2 +168700* RL2054.2 +168800 REL-8X-INIT-6. RL2054.2 +168900 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +169000 MOVE "REL-8X-TEST-6" TO PAR-NAME. RL2054.2 +169100 MOVE 123 TO WRK-RL-FD1-RECKEY. RL2054.2 +169200 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +169300 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +169400 MOVE SPACE TO WRK-XN-00001. RL2054.2 +169500 MOVE 1 TO REC-CT. RL2054.2 +169600 GO TO REL-8X-TEST-6-0. RL2054.2 +169700 REL-8X-DELETE-6. RL2054.2 +169800 PERFORM DE-LETE. RL2054.2 +169900 PERFORM PRINT-DETAIL. RL2054.2 +170000 GO TO REL-8X-INIT-7. RL2054.2 +170100 REL-8X-TEST-6-0. RL2054.2 +170200 START RL-FD1 RL2054.2 +170300 KEY IS GREATER THAN OR EQUAL TO RL-FD1-KEY RL2054.2 +170400 NOT INVALID KEY RL2054.2 +170500 MOVE "A" TO WRK-XN-00001. RL2054.2 +170600 REL-8X-TEST-6-1. RL2054.2 +170700 IF WRK-XN-00001 NOT = "A" RL2054.2 +170800 MOVE "NOT INVALID KEY DID NOT EXECUTE" RL2054.2 +170900 TO RE-MARK RL2054.2 +171000 MOVE "A" TO CORRECT-X RL2054.2 +171100 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +171200 PERFORM FAIL RL2054.2 +171300 PERFORM PRINT-DETAIL RL2054.2 +171400 ELSE RL2054.2 +171500 PERFORM PASS RL2054.2 +171600 PERFORM PRINT-DETAIL. RL2054.2 +171700 ADD 1 TO REC-CT. RL2054.2 +171800 REL-8X-TEST-6-2. RL2054.2 +171900 MOVE "REL-8X-TEST-6-2" TO PAR-NAME. RL2054.2 +172000 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +172100 IF XRECORD-NUMBER (1) < 123 RL2054.2 +172200 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +172300 TO RE-MARK RL2054.2 +172400 PERFORM FAIL RL2054.2 +172500 PERFORM PRINT-DETAIL RL2054.2 +172600 ELSE RL2054.2 +172700 PERFORM PASS RL2054.2 +172800 PERFORM PRINT-DETAIL. RL2054.2 +172900* RL2054.2 +173000 REL-8X-INIT-7. RL2054.2 +173100 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +173200 MOVE "REL-8X-TEST-7" TO PAR-NAME. RL2054.2 +173300 MOVE 154 TO WRK-RL-FD1-RECKEY. RL2054.2 +173400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +173500 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +173600 MOVE SPACE TO WRK-XN-00001. RL2054.2 +173700 MOVE 1 TO REC-CT. RL2054.2 +173800 GO TO REL-8X-TEST-7-0. RL2054.2 +173900 REL-8X-DELETE-7. RL2054.2 +174000 PERFORM DE-LETE. RL2054.2 +174100 PERFORM PRINT-DETAIL. RL2054.2 +174200 GO TO REL-8X-INIT-8. RL2054.2 +174300 REL-8X-TEST-7-0. RL2054.2 +174400 START RL-FD1 RL2054.2 +174500 KEY GREATER OR EQUAL TO RL-FD1-KEY RL2054.2 +174600 NOT INVALID KEY RL2054.2 +174700 MOVE "A" TO WRK-XN-00001. RL2054.2 +174800 REL-8X-TEST-7-1. RL2054.2 +174900 IF WRK-XN-00001 NOT = "A" RL2054.2 +175000 MOVE "NOT INVALID KEY DID NOT EXECUTE" RL2054.2 +175100 TO RE-MARK RL2054.2 +175200 MOVE "A" TO CORRECT-X RL2054.2 +175300 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +175400 PERFORM FAIL RL2054.2 +175500 PERFORM PRINT-DETAIL RL2054.2 +175600 ELSE RL2054.2 +175700 PERFORM PASS RL2054.2 +175800 PERFORM PRINT-DETAIL. RL2054.2 +175900 ADD 1 TO REC-CT. RL2054.2 +176000 REL-8X-TEST-7-2. RL2054.2 +176100 MOVE "REL-8X-TEST-7-2" TO PAR-NAME. RL2054.2 +176200 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +176300 IF XRECORD-NUMBER (1) < 154 RL2054.2 +176400 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +176500 TO RE-MARK RL2054.2 +176600 MOVE 154 TO CORRECT-N RL2054.2 +176700 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +176800 PERFORM FAIL RL2054.2 +176900 PERFORM PRINT-DETAIL RL2054.2 +177000 ELSE RL2054.2 +177100 PERFORM PASS RL2054.2 +177200 PERFORM PRINT-DETAIL. RL2054.2 +177300* RL2054.2 +177400 REL-8X-INIT-8. RL2054.2 +177500 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +177600 MOVE "REL-8X-TEST-8" TO PAR-NAME. RL2054.2 +177700 MOVE 226 TO WRK-RL-FD1-RECKEY. RL2054.2 +177800 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +177900 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +178000 MOVE SPACE TO WRK-XN-00001. RL2054.2 +178100 MOVE 1 TO REC-CT. RL2054.2 +178200 GO TO REL-8X-TEST-8-0. RL2054.2 +178300 REL-8X-DELETE-8. RL2054.2 +178400 PERFORM DE-LETE. RL2054.2 +178500 PERFORM PRINT-DETAIL. RL2054.2 +178600 GO TO REL-8X-INIT-9. RL2054.2 +178700 REL-8X-TEST-8-0. RL2054.2 +178800 START RL-FD1 RL2054.2 +178900 KEY IS >= RL-FD1-KEY RL2054.2 +179000 NOT INVALID KEY RL2054.2 +179100 MOVE "A" TO WRK-XN-00001. RL2054.2 +179200 REL-8X-TEST-8-1. RL2054.2 +179300 IF WRK-XN-00001 NOT = "A" RL2054.2 +179400 MOVE "NOT INVALID KEY DID NOT EXECUTE" RL2054.2 +179500 TO RE-MARK RL2054.2 +179600 MOVE "A" TO CORRECT-X RL2054.2 +179700 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +179800 PERFORM FAIL RL2054.2 +179900 PERFORM PRINT-DETAIL RL2054.2 +180000 ELSE RL2054.2 +180100 PERFORM PASS RL2054.2 +180200 PERFORM PRINT-DETAIL. RL2054.2 +180300 ADD 1 TO REC-CT. RL2054.2 +180400 REL-8X-TEST-8-2. RL2054.2 +180500 MOVE "REL-8X-TEST-8-2" TO PAR-NAME. RL2054.2 +180600 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +180700 IF XRECORD-NUMBER (1) < 226 RL2054.2 +180800 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +180900 TO RE-MARK RL2054.2 +181000 MOVE 226 TO CORRECT-N RL2054.2 +181100 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +181200 PERFORM FAIL RL2054.2 +181300 PERFORM PRINT-DETAIL RL2054.2 +181400 ELSE RL2054.2 +181500 PERFORM PASS RL2054.2 +181600 PERFORM PRINT-DETAIL. RL2054.2 +181700* RL2054.2 +181800 REL-8X-INIT-9. RL2054.2 +181900 MOVE "VIII-33 4.7.2" TO ANSI-REFERENCE. RL2054.2 +182000 MOVE "REL-8X-TEST-9" TO PAR-NAME. RL2054.2 +182100 MOVE 300 TO WRK-RL-FD1-RECKEY. RL2054.2 +182200 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +182300 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +182400 MOVE SPACE TO WRK-XN-00001. RL2054.2 +182500 MOVE 1 TO REC-CT. RL2054.2 +182600 GO TO REL-8X-TEST-9-0. RL2054.2 +182700 REL-8X-DELETE-9. RL2054.2 +182800 PERFORM DE-LETE. RL2054.2 +182900 PERFORM PRINT-DETAIL. RL2054.2 +183000 GO TO REL-8X-INIT-10. RL2054.2 +183100 REL-8X-TEST-9-0. RL2054.2 +183200 START RL-FD1 RL2054.2 +183300 KEY >= RL-FD1-KEY RL2054.2 +183400 NOT INVALID KEY RL2054.2 +183500 MOVE "A" TO WRK-XN-00001. RL2054.2 +183600 REL-8X-TEST-9-1. RL2054.2 +183700 IF WRK-XN-00001 NOT = "A" RL2054.2 +183800 MOVE "NOT INVALID KEY DID NOT EXECUTE" RL2054.2 +183900 TO RE-MARK RL2054.2 +184000 MOVE "A" TO CORRECT-X RL2054.2 +184100 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +184200 PERFORM FAIL RL2054.2 +184300 PERFORM PRINT-DETAIL RL2054.2 +184400 ELSE RL2054.2 +184500 PERFORM PASS RL2054.2 +184600 PERFORM PRINT-DETAIL. RL2054.2 +184700 ADD 1 TO REC-CT. RL2054.2 +184800 REL-8X-TEST-9-2. RL2054.2 +184900 MOVE "REL-8X-TEST-9-2" TO PAR-NAME. RL2054.2 +185000 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +185100 IF XRECORD-NUMBER (1) < 300 RL2054.2 +185200 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +185300 TO RE-MARK RL2054.2 +185400 MOVE 300 TO CORRECT-N RL2054.2 +185500 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +185600 PERFORM FAIL RL2054.2 +185700 PERFORM PRINT-DETAIL RL2054.2 +185800 ELSE RL2054.2 +185900 PERFORM PASS RL2054.2 +186000 PERFORM PRINT-DETAIL. RL2054.2 +186100* RL2054.2 +186200 REL-8X-INIT-10. RL2054.2 +186300 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +186400 MOVE "REL-8X-TEST-10" TO PAR-NAME. RL2054.2 +186500 MOVE 200 TO WRK-RL-FD1-RECKEY. RL2054.2 +186600 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +186700 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +186800 MOVE SPACE TO WRK-XN-00001. RL2054.2 +186900 MOVE 1 TO REC-CT. RL2054.2 +187000 GO TO REL-8X-TEST-10-0. RL2054.2 +187100 REL-8X-DELETE-10. RL2054.2 +187200 PERFORM DE-LETE. RL2054.2 +187300 PERFORM PRINT-DETAIL. RL2054.2 +187400 GO TO REL-8X-INIT-11. RL2054.2 +187500 REL-8X-TEST-10-0. RL2054.2 +187600 START RL-FD1 RL2054.2 +187700 KEY >= RL-FD1-KEY RL2054.2 +187800 INVALID KEY RL2054.2 +187900 MOVE "A" TO WRK-XN-00001. RL2054.2 +188000 REL-8X-TEST-10-1. RL2054.2 +188100 IF WRK-XN-00001 NOT = SPACE RL2054.2 +188200 MOVE "INVALID KEY SHOULD NOT EXECUTE" RL2054.2 +188300 TO RE-MARK RL2054.2 +188400 MOVE SPACE TO CORRECT-X RL2054.2 +188500 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +188600 PERFORM FAIL RL2054.2 +188700 PERFORM PRINT-DETAIL RL2054.2 +188800 ELSE RL2054.2 +188900 PERFORM PASS RL2054.2 +189000 PERFORM PRINT-DETAIL. RL2054.2 +189100 ADD 1 TO REC-CT. RL2054.2 +189200 REL-8X-TEST-10-2. RL2054.2 +189300 MOVE "REL-8X-TEST-10-2" TO PAR-NAME. RL2054.2 +189400 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +189500 IF XRECORD-NUMBER (1) < 200 RL2054.2 +189600 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +189700 TO RE-MARK RL2054.2 +189800 MOVE 200 TO CORRECT-N RL2054.2 +189900 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +190000 PERFORM FAIL RL2054.2 +190100 PERFORM PRINT-DETAIL RL2054.2 +190200 ELSE RL2054.2 +190300 PERFORM PASS RL2054.2 +190400 PERFORM PRINT-DETAIL. RL2054.2 +190500* RL2054.2 +190600 REL-8X-INIT-11. RL2054.2 +190700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +190800 MOVE "REL-8X-TEST-11" TO PAR-NAME. RL2054.2 +190900 MOVE 555 TO WRK-RL-FD1-RECKEY. RL2054.2 +191000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +191100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +191200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +191300 MOVE 1 TO REC-CT. RL2054.2 +191400 GO TO REL-8X-TEST-11-0. RL2054.2 +191500 REL-8X-DELETE-11. RL2054.2 +191600 PERFORM DE-LETE. RL2054.2 +191700 PERFORM PRINT-DETAIL. RL2054.2 +191800 GO TO REL-8X-INIT-12. RL2054.2 +191900 REL-8X-TEST-11-0. RL2054.2 +192000 START RL-FD1 RL2054.2 +192100 KEY >= RL-FD1-KEY RL2054.2 +192200 INVALID KEY RL2054.2 +192300 MOVE "A" TO WRK-XN-00001. RL2054.2 +192400 REL-8X-TEST-11-1. RL2054.2 +192500 IF WRK-XN-00001 NOT = "A" RL2054.2 +192600 MOVE "INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +192700 TO RE-MARK RL2054.2 +192800 MOVE "A" TO CORRECT-X RL2054.2 +192900 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +193000 PERFORM FAIL RL2054.2 +193100 PERFORM PRINT-DETAIL RL2054.2 +193200 ELSE RL2054.2 +193300 PERFORM PASS RL2054.2 +193400 PERFORM PRINT-DETAIL. RL2054.2 +193500* RL2054.2 +193600 REL-8X-INIT-12. RL2054.2 +193700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +193800 MOVE "REL-8X-TEST-12" TO PAR-NAME. RL2054.2 +193900 MOVE 027 TO WRK-RL-FD1-RECKEY. RL2054.2 +194000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +194100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +194200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +194300 MOVE 1 TO REC-CT. RL2054.2 +194400 GO TO REL-8X-TEST-12-0. RL2054.2 +194500 REL-8X-DELETE-12. RL2054.2 +194600 PERFORM DE-LETE. RL2054.2 +194700 PERFORM PRINT-DETAIL. RL2054.2 +194800 GO TO REL-8X-INIT-13. RL2054.2 +194900 REL-8X-TEST-12-0. RL2054.2 +195000 START RL-FD1 RL2054.2 +195100 KEY >= RL-FD1-KEY RL2054.2 +195200 NOT INVALID KEY RL2054.2 +195300 MOVE "A" TO WRK-XN-00001. RL2054.2 +195400 REL-8X-TEST-12-1. RL2054.2 +195500 IF WRK-XN-00001 NOT = "A" RL2054.2 +195600 MOVE "NOT INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +195700 TO RE-MARK RL2054.2 +195800 MOVE "A" TO CORRECT-X RL2054.2 +195900 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +196000 PERFORM FAIL RL2054.2 +196100 PERFORM PRINT-DETAIL RL2054.2 +196200 ELSE RL2054.2 +196300 PERFORM PASS RL2054.2 +196400 PERFORM PRINT-DETAIL. RL2054.2 +196500 ADD 1 TO REC-CT. RL2054.2 +196600 REL-8X-TEST-12-2. RL2054.2 +196700 MOVE "REL-8X-TEST-12-2" TO PAR-NAME. RL2054.2 +196800 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +196900 IF XRECORD-NUMBER (1) < 27 RL2054.2 +197000 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +197100 TO RE-MARK RL2054.2 +197200 MOVE 27 TO CORRECT-N RL2054.2 +197300 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +197400 PERFORM FAIL RL2054.2 +197500 PERFORM PRINT-DETAIL RL2054.2 +197600 ELSE RL2054.2 +197700 PERFORM PASS RL2054.2 +197800 PERFORM PRINT-DETAIL. RL2054.2 +197900* RL2054.2 +198000 REL-8X-INIT-13. RL2054.2 +198100 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +198200 MOVE "REL-8X-TEST-13" TO PAR-NAME. RL2054.2 +198300 MOVE 555 TO WRK-RL-FD1-RECKEY. RL2054.2 +198400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +198500 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +198600 MOVE SPACE TO WRK-XN-00001. RL2054.2 +198700 MOVE 1 TO REC-CT. RL2054.2 +198800 GO TO REL-8X-TEST-13-0. RL2054.2 +198900 REL-8X-DELETE-13. RL2054.2 +199000 PERFORM DE-LETE. RL2054.2 +199100 PERFORM PRINT-DETAIL. RL2054.2 +199200 GO TO REL-8X-INIT-14. RL2054.2 +199300 REL-8X-TEST-13-0. RL2054.2 +199400 START RL-FD1 RL2054.2 +199500 KEY >= RL-FD1-KEY RL2054.2 +199600 NOT INVALID KEY RL2054.2 +199700 MOVE "A" TO WRK-XN-00001. RL2054.2 +199800 REL-8X-TEST-13-1. RL2054.2 +199900 IF WRK-XN-00001 NOT = SPACE RL2054.2 +200000 MOVE "NOT INVALID KEY SHOULD NOT HAVE EXECUTED" RL2054.2 +200100 TO RE-MARK RL2054.2 +200200 MOVE SPACE TO CORRECT-X RL2054.2 +200300 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +200400 PERFORM FAIL RL2054.2 +200500 PERFORM PRINT-DETAIL RL2054.2 +200600 ELSE RL2054.2 +200700 PERFORM PASS RL2054.2 +200800 PERFORM PRINT-DETAIL. RL2054.2 +200900* RL2054.2 +201000 REL-8X-INIT-14. RL2054.2 +201100 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +201200 MOVE "REL-8X-TEST-14" TO PAR-NAME. RL2054.2 +201300 MOVE 101 TO WRK-RL-FD1-RECKEY. RL2054.2 +201400 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +201500 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +201600 MOVE SPACE TO WRK-XN-00001. RL2054.2 +201700 MOVE 1 TO REC-CT. RL2054.2 +201800 GO TO REL-8X-TEST-14-0. RL2054.2 +201900 REL-8X-DELETE-14. RL2054.2 +202000 PERFORM DE-LETE. RL2054.2 +202100 PERFORM PRINT-DETAIL. RL2054.2 +202200 GO TO REL-8X-INIT-15. RL2054.2 +202300 REL-8X-TEST-14-0. RL2054.2 +202400 START RL-FD1 RL2054.2 +202500 KEY >= RL-FD1-KEY RL2054.2 +202600 INVALID KEY RL2054.2 +202700 MOVE "B" TO WRK-XN-00001 RL2054.2 +202800 NOT INVALID KEY RL2054.2 +202900 MOVE "A" TO WRK-XN-00001. RL2054.2 +203000 REL-8X-TEST-14-1. RL2054.2 +203100 IF WRK-XN-00001 NOT = "A" RL2054.2 +203200 MOVE "NOT INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +203300 TO RE-MARK RL2054.2 +203400 MOVE "A" TO CORRECT-X RL2054.2 +203500 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +203600 PERFORM FAIL RL2054.2 +203700 PERFORM PRINT-DETAIL RL2054.2 +203800 ELSE RL2054.2 +203900 PERFORM PASS RL2054.2 +204000 PERFORM PRINT-DETAIL. RL2054.2 +204100 ADD 1 TO REC-CT. RL2054.2 +204200 REL-8X-TEST-14-2. RL2054.2 +204300 MOVE "REL-8X-TEST-14-2" TO PAR-NAME. RL2054.2 +204400 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +204500 IF XRECORD-NUMBER (1) < 101 RL2054.2 +204600 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +204700 TO RE-MARK RL2054.2 +204800 MOVE 101 TO CORRECT-N RL2054.2 +204900 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +205000 PERFORM FAIL RL2054.2 +205100 PERFORM PRINT-DETAIL RL2054.2 +205200 ELSE RL2054.2 +205300 PERFORM PASS RL2054.2 +205400 PERFORM PRINT-DETAIL. RL2054.2 +205500* RL2054.2 +205600 REL-8X-INIT-15. RL2054.2 +205700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +205800 MOVE "REL-8X-TEST-15" TO PAR-NAME. RL2054.2 +205900 MOVE 666 TO WRK-RL-FD1-RECKEY. RL2054.2 +206000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +206100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +206200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +206300 MOVE 1 TO REC-CT. RL2054.2 +206400 GO TO REL-8X-TEST-15-0. RL2054.2 +206500 REL-8X-DELETE-15. RL2054.2 +206600 PERFORM DE-LETE. RL2054.2 +206700 PERFORM PRINT-DETAIL. RL2054.2 +206800 GO TO REL-8X-INIT-16. RL2054.2 +206900 REL-8X-TEST-15-0. RL2054.2 +207000 START RL-FD1 RL2054.2 +207100 KEY >= RL-FD1-KEY RL2054.2 +207200 INVALID KEY RL2054.2 +207300 MOVE "A" TO WRK-XN-00001 RL2054.2 +207400 NOT INVALID KEY RL2054.2 +207500 MOVE "B" TO WRK-XN-00001. RL2054.2 +207600 REL-8X-TEST-15-1. RL2054.2 +207700 IF WRK-XN-00001 NOT = "A" RL2054.2 +207800 MOVE "INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +207900 TO RE-MARK RL2054.2 +208000 MOVE "A" TO CORRECT-X RL2054.2 +208100 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +208200 PERFORM FAIL RL2054.2 +208300 PERFORM PRINT-DETAIL RL2054.2 +208400 ELSE RL2054.2 +208500 PERFORM PASS RL2054.2 +208600 PERFORM PRINT-DETAIL. RL2054.2 +208700* RL2054.2 +208800 REL-8X-INIT-16. RL2054.2 +208900 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +209000 MOVE "REL-8X-TEST-16" TO PAR-NAME. RL2054.2 +209100 MOVE 200 TO WRK-RL-FD1-RECKEY. RL2054.2 +209200 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +209300 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +209400 MOVE SPACE TO WRK-XN-00001. RL2054.2 +209500 MOVE SPACE TO WRK-XN-00002. RL2054.2 +209600 MOVE 1 TO REC-CT. RL2054.2 +209700 GO TO REL-8X-TEST-16-0. RL2054.2 +209800 REL-8X-DELETE-16. RL2054.2 +209900 PERFORM DE-LETE. RL2054.2 +210000 PERFORM PRINT-DETAIL. RL2054.2 +210100 GO TO REL-8X-INIT-17. RL2054.2 +210200 REL-8X-TEST-16-0. RL2054.2 +210300 START RL-FD1 RL2054.2 +210400 KEY >= RL-FD1-KEY RL2054.2 +210500 INVALID KEY RL2054.2 +210600 MOVE "A" TO WRK-XN-00001 RL2054.2 +210700 END-START RL2054.2 +210800 MOVE "Z" TO WRK-XN-00002. RL2054.2 +210900 REL-8X-TEST-16-1. RL2054.2 +211000 IF WRK-XN-00001 NOT = SPACE RL2054.2 +211100 MOVE "INVALID KEY SHOULD NOT HAVE EXECUTED" RL2054.2 +211200 TO RE-MARK RL2054.2 +211300 MOVE SPACE TO CORRECT-X RL2054.2 +211400 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +211500 PERFORM FAIL RL2054.2 +211600 PERFORM PRINT-DETAIL RL2054.2 +211700 ELSE RL2054.2 +211800 PERFORM PASS RL2054.2 +211900 PERFORM PRINT-DETAIL. RL2054.2 +212000 ADD 1 TO REC-CT. RL2054.2 +212100 REL-8X-TEST-16-2. RL2054.2 +212200 MOVE "REL-8X-TEST-16-2" TO PAR-NAME. RL2054.2 +212300 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +212400 IF XRECORD-NUMBER (1) < 200 RL2054.2 +212500 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +212600 TO RE-MARK RL2054.2 +212700 MOVE 200 TO CORRECT-N RL2054.2 +212800 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +212900 PERFORM FAIL RL2054.2 +213000 PERFORM PRINT-DETAIL RL2054.2 +213100 ELSE RL2054.2 +213200 PERFORM PASS RL2054.2 +213300 PERFORM PRINT-DETAIL. RL2054.2 +213400 ADD 1 TO REC-CT. RL2054.2 +213500 REL-8X-TEST-16-3. RL2054.2 +213600 MOVE "REL-8X-TEST-16-3" TO PAR-NAME. RL2054.2 +213700 IF WRK-XN-00002 NOT = "Z" RL2054.2 +213800 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +213900 MOVE "Z" TO CORRECT-X RL2054.2 +214000 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +214100 PERFORM FAIL RL2054.2 +214200 PERFORM PRINT-DETAIL RL2054.2 +214300 ELSE RL2054.2 +214400 PERFORM PASS RL2054.2 +214500 PERFORM PRINT-DETAIL. RL2054.2 +214600* RL2054.2 +214700 REL-8X-INIT-17. RL2054.2 +214800 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +214900 MOVE "REL-8X-TEST-17" TO PAR-NAME. RL2054.2 +215000 MOVE 555 TO WRK-RL-FD1-RECKEY. RL2054.2 +215100 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +215200 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +215300 MOVE SPACE TO WRK-XN-00001. RL2054.2 +215400 MOVE SPACE TO WRK-XN-00002. RL2054.2 +215500 MOVE 1 TO REC-CT. RL2054.2 +215600 GO TO REL-8X-TEST-17-0. RL2054.2 +215700 REL-8X-DELETE-17. RL2054.2 +215800 PERFORM DE-LETE. RL2054.2 +215900 PERFORM PRINT-DETAIL. RL2054.2 +216000 GO TO REL-8X-INIT-18. RL2054.2 +216100 REL-8X-TEST-17-0. RL2054.2 +216200 START RL-FD1 RL2054.2 +216300 KEY >= RL-FD1-KEY RL2054.2 +216400 INVALID KEY RL2054.2 +216500 MOVE "A" TO WRK-XN-00001 RL2054.2 +216600 END-START RL2054.2 +216700 MOVE "Z" TO WRK-XN-00002. RL2054.2 +216800 REL-8X-TEST-17-1. RL2054.2 +216900 IF WRK-XN-00001 NOT = "A" RL2054.2 +217000 MOVE "INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +217100 TO RE-MARK RL2054.2 +217200 MOVE "A" TO CORRECT-X RL2054.2 +217300 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +217400 PERFORM FAIL RL2054.2 +217500 PERFORM PRINT-DETAIL RL2054.2 +217600 ELSE RL2054.2 +217700 PERFORM PASS RL2054.2 +217800 PERFORM PRINT-DETAIL. RL2054.2 +217900 ADD 1 TO REC-CT. RL2054.2 +218000 REL-8X-TEST-17-2. RL2054.2 +218100 MOVE "REL-8X-TEST-17-2" TO PAR-NAME. RL2054.2 +218200 IF WRK-XN-00002 NOT = "Z" RL2054.2 +218300 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +218400 MOVE "Z" TO CORRECT-X RL2054.2 +218500 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +218600 PERFORM FAIL RL2054.2 +218700 PERFORM PRINT-DETAIL RL2054.2 +218800 ELSE RL2054.2 +218900 PERFORM PASS RL2054.2 +219000 PERFORM PRINT-DETAIL. RL2054.2 +219100* RL2054.2 +219200 REL-8X-INIT-18. RL2054.2 +219300 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +219400 MOVE "REL-8X-TEST-18" TO PAR-NAME. RL2054.2 +219500 MOVE 027 TO WRK-RL-FD1-RECKEY. RL2054.2 +219600 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +219700 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +219800 MOVE SPACE TO WRK-XN-00001. RL2054.2 +219900 MOVE SPACE TO WRK-XN-00002. RL2054.2 +220000 MOVE 1 TO REC-CT. RL2054.2 +220100 GO TO REL-8X-TEST-18-0. RL2054.2 +220200 REL-8X-DELETE-18. RL2054.2 +220300 PERFORM DE-LETE. RL2054.2 +220400 PERFORM PRINT-DETAIL. RL2054.2 +220500 GO TO REL-8X-INIT-19. RL2054.2 +220600 REL-8X-TEST-18-0. RL2054.2 +220700 START RL-FD1 RL2054.2 +220800 KEY >= RL-FD1-KEY RL2054.2 +220900 NOT INVALID KEY RL2054.2 +221000 MOVE "A" TO WRK-XN-00001 RL2054.2 +221100 END-START RL2054.2 +221200 MOVE "Z" TO WRK-XN-00002. RL2054.2 +221300 REL-8X-TEST-18-1. RL2054.2 +221400 IF WRK-XN-00001 NOT = "A" RL2054.2 +221500 MOVE "NOT INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +221600 TO RE-MARK RL2054.2 +221700 MOVE "A" TO CORRECT-X RL2054.2 +221800 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +221900 PERFORM FAIL RL2054.2 +222000 PERFORM PRINT-DETAIL RL2054.2 +222100 ELSE RL2054.2 +222200 PERFORM PASS RL2054.2 +222300 PERFORM PRINT-DETAIL. RL2054.2 +222400 ADD 1 TO REC-CT. RL2054.2 +222500 REL-8X-TEST-18-2. RL2054.2 +222600 MOVE "REL-8X-TEST-18-2" TO PAR-NAME. RL2054.2 +222700 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +222800 IF XRECORD-NUMBER (1) < 27 RL2054.2 +222900 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +223000 TO RE-MARK RL2054.2 +223100 MOVE 27 TO CORRECT-N RL2054.2 +223200 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +223300 PERFORM FAIL RL2054.2 +223400 PERFORM PRINT-DETAIL RL2054.2 +223500 ELSE RL2054.2 +223600 PERFORM PASS RL2054.2 +223700 PERFORM PRINT-DETAIL. RL2054.2 +223800 ADD 1 TO REC-CT. RL2054.2 +223900 REL-8X-TEST-18-3. RL2054.2 +224000 MOVE "REL-8X-TEST-18-3" TO PAR-NAME. RL2054.2 +224100 IF WRK-XN-00002 NOT = "Z" RL2054.2 +224200 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +224300 MOVE "Z" TO CORRECT-X RL2054.2 +224400 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +224500 PERFORM FAIL RL2054.2 +224600 PERFORM PRINT-DETAIL RL2054.2 +224700 ELSE RL2054.2 +224800 PERFORM PASS RL2054.2 +224900 PERFORM PRINT-DETAIL. RL2054.2 +225000* RL2054.2 +225100 REL-8X-INIT-19. RL2054.2 +225200 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +225300 MOVE "REL-8X-TEST-19" TO PAR-NAME. RL2054.2 +225400 MOVE 555 TO WRK-RL-FD1-RECKEY. RL2054.2 +225500 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +225600 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +225700 MOVE SPACE TO WRK-XN-00001. RL2054.2 +225800 MOVE SPACE TO WRK-XN-00002. RL2054.2 +225900 MOVE 1 TO REC-CT. RL2054.2 +226000 GO TO REL-8X-TEST-19-0. RL2054.2 +226100 REL-8X-DELETE-19. RL2054.2 +226200 PERFORM DE-LETE. RL2054.2 +226300 PERFORM PRINT-DETAIL. RL2054.2 +226400 GO TO REL-8X-INIT-20. RL2054.2 +226500 REL-8X-TEST-19-0. RL2054.2 +226600 START RL-FD1 RL2054.2 +226700 KEY >= RL-FD1-KEY RL2054.2 +226800 NOT INVALID KEY RL2054.2 +226900 MOVE "A" TO WRK-XN-00001 RL2054.2 +227000 END-START RL2054.2 +227100 MOVE "Z" TO WRK-XN-00002. RL2054.2 +227200 REL-8X-TEST-19-1. RL2054.2 +227300 IF WRK-XN-00001 NOT = SPACE RL2054.2 +227400 MOVE "NOT INVALID KEY SHOULD NOT HAVE EXECUTED" RL2054.2 +227500 TO RE-MARK RL2054.2 +227600 MOVE SPACE TO CORRECT-X RL2054.2 +227700 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +227800 PERFORM FAIL RL2054.2 +227900 PERFORM PRINT-DETAIL RL2054.2 +228000 ELSE RL2054.2 +228100 PERFORM PASS RL2054.2 +228200 PERFORM PRINT-DETAIL. RL2054.2 +228300 ADD 1 TO REC-CT. RL2054.2 +228400 REL-8X-TEST-19-2. RL2054.2 +228500 MOVE "REL-8X-TEST-19-2" TO PAR-NAME. RL2054.2 +228600 IF WRK-XN-00002 NOT = "Z" RL2054.2 +228700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +228800 MOVE "Z" TO CORRECT-X RL2054.2 +228900 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +229000 PERFORM FAIL RL2054.2 +229100 PERFORM PRINT-DETAIL RL2054.2 +229200 ELSE RL2054.2 +229300 PERFORM PASS RL2054.2 +229400 PERFORM PRINT-DETAIL. RL2054.2 +229500* RL2054.2 +229600 REL-8X-INIT-20. RL2054.2 +229700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +229800 MOVE "REL-8X-TEST-20" TO PAR-NAME. RL2054.2 +229900 MOVE 101 TO WRK-RL-FD1-RECKEY. RL2054.2 +230000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +230100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +230200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +230300 MOVE 1 TO REC-CT. RL2054.2 +230400 GO TO REL-8X-TEST-20-0. RL2054.2 +230500 REL-8X-DELETE-20. RL2054.2 +230600 PERFORM DE-LETE. RL2054.2 +230700 PERFORM PRINT-DETAIL. RL2054.2 +230800 GO TO REL-8X-INIT-21. RL2054.2 +230900 REL-8X-TEST-20-0. RL2054.2 +231000 START RL-FD1 RL2054.2 +231100 KEY >= RL-FD1-KEY RL2054.2 +231200 INVALID KEY RL2054.2 +231300 MOVE "B" TO WRK-XN-00001 RL2054.2 +231400 NOT INVALID KEY RL2054.2 +231500 MOVE "A" TO WRK-XN-00001 RL2054.2 +231600 END-START RL2054.2 +231700 MOVE "Z" TO WRK-XN-00002. RL2054.2 +231800 REL-8X-TEST-20-1. RL2054.2 +231900 IF WRK-XN-00001 NOT = "A" RL2054.2 +232000 MOVE "NOT INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +232100 TO RE-MARK RL2054.2 +232200 MOVE "A" TO CORRECT-X RL2054.2 +232300 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +232400 PERFORM FAIL RL2054.2 +232500 PERFORM PRINT-DETAIL RL2054.2 +232600 ELSE RL2054.2 +232700 PERFORM PASS RL2054.2 +232800 PERFORM PRINT-DETAIL. RL2054.2 +232900 ADD 1 TO REC-CT. RL2054.2 +233000 REL-8X-TEST-20-2. RL2054.2 +233100 MOVE "REL-8X-TEST-20-2" TO PAR-NAME. RL2054.2 +233200 READ RL-FD1 INTO FILE-RECORD-INFO (1). RL2054.2 +233300 IF XRECORD-NUMBER (1) < 101 RL2054.2 +233400 MOVE "RECORD NUMBER LESS THAN RELATIVE KEY" RL2054.2 +233500 TO RE-MARK RL2054.2 +233600 MOVE 101 TO CORRECT-N RL2054.2 +233700 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2054.2 +233800 PERFORM FAIL RL2054.2 +233900 PERFORM PRINT-DETAIL RL2054.2 +234000 ELSE RL2054.2 +234100 PERFORM PASS RL2054.2 +234200 PERFORM PRINT-DETAIL. RL2054.2 +234300 ADD 1 TO REC-CT. RL2054.2 +234400 REL-8X-TEST-20-3. RL2054.2 +234500 MOVE "REL-8X-TEST-20-3" TO PAR-NAME. RL2054.2 +234600 IF WRK-XN-00002 NOT = "Z" RL2054.2 +234700 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +234800 MOVE "Z" TO CORRECT-X RL2054.2 +234900 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +235000 PERFORM FAIL RL2054.2 +235100 PERFORM PRINT-DETAIL RL2054.2 +235200 ELSE RL2054.2 +235300 PERFORM PASS RL2054.2 +235400 PERFORM PRINT-DETAIL. RL2054.2 +235500* RL2054.2 +235600 REL-8X-INIT-21. RL2054.2 +235700 MOVE "VIII-33 4.7.2 (GR7)" TO ANSI-REFERENCE. RL2054.2 +235800 MOVE "REL-8X-TEST-21" TO PAR-NAME. RL2054.2 +235900 MOVE 666 TO WRK-RL-FD1-RECKEY. RL2054.2 +236000 MOVE WRK-RL-FD1-RECKEY TO RL-FD1-KEY. RL2054.2 +236100 MOVE SPACES TO FILE-RECORD-INFO (1). RL2054.2 +236200 MOVE SPACE TO WRK-XN-00001. RL2054.2 +236300 MOVE SPACE TO WRK-XN-00002. RL2054.2 +236400 MOVE 1 TO REC-CT. RL2054.2 +236500 GO TO REL-8X-TEST-21-0. RL2054.2 +236600 REL-8X-DELETE-21. RL2054.2 +236700 PERFORM DE-LETE. RL2054.2 +236800 PERFORM PRINT-DETAIL. RL2054.2 +236900 GO TO REL-8X-END-21. RL2054.2 +237000 REL-8X-TEST-21-0. RL2054.2 +237100 START RL-FD1 RL2054.2 +237200 KEY >= RL-FD1-KEY RL2054.2 +237300 INVALID KEY RL2054.2 +237400 MOVE "A" TO WRK-XN-00001 RL2054.2 +237500 NOT INVALID KEY RL2054.2 +237600 MOVE "B" TO WRK-XN-00001 RL2054.2 +237700 END-START RL2054.2 +237800 MOVE "Z" TO WRK-XN-00002. RL2054.2 +237900 REL-8X-TEST-21-1. RL2054.2 +238000 IF WRK-XN-00001 NOT = "A" RL2054.2 +238100 MOVE "INVALID KEY SHOULD HAVE EXECUTED" RL2054.2 +238200 TO RE-MARK RL2054.2 +238300 MOVE "A" TO CORRECT-X RL2054.2 +238400 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +238500 PERFORM FAIL RL2054.2 +238600 PERFORM PRINT-DETAIL RL2054.2 +238700 ELSE RL2054.2 +238800 PERFORM PASS RL2054.2 +238900 PERFORM PRINT-DETAIL. RL2054.2 +239000 ADD 1 TO REC-CT. RL2054.2 +239100 REL-8X-TEST-21-2. RL2054.2 +239200 MOVE "REL-8X-TEST-21-2" TO PAR-NAME. RL2054.2 +239300 IF WRK-XN-00002 NOT = "Z" RL2054.2 +239400 MOVE "SCOPE TERMINATOR IGNORED" TO RE-MARK RL2054.2 +239500 MOVE "Z" TO CORRECT-X RL2054.2 +239600 MOVE WRK-XN-00001 TO COMPUTED-X RL2054.2 +239700 PERFORM FAIL RL2054.2 +239800 PERFORM PRINT-DETAIL RL2054.2 +239900 ELSE RL2054.2 +240000 PERFORM PASS RL2054.2 +240100 PERFORM PRINT-DETAIL. RL2054.2 +240200 REL-8X-END-21. RL2054.2 +240300 CLOSE RL-FD1. RL2054.2 +240400 CLOSE RL-FS2. RL2054.2 +240500 REL-8X-EXIT. RL2054.2 +240600 EXIT. RL2054.2 +240700* RL2054.2 +240800 CCVS-EXIT SECTION. RL2054.2 +240900 CCVS-999999. RL2054.2 +241000 GO TO CLOSE-FILES. RL2054.2 diff --git a/tests/cobol85/RL/RL206A.CBL b/tests/cobol85/RL/RL206A.CBL new file mode 100644 index 00000000..cca19a77 --- /dev/null +++ b/tests/cobol85/RL/RL206A.CBL @@ -0,0 +1,563 @@ +000100 IDENTIFICATION DIVISION. RL2064.2 +000200 PROGRAM-ID. RL2064.2 +000300 RL206A. RL2064.2 +000400**************************************************************** RL2064.2 +000500* * RL2064.2 +000600* VALIDATION FOR:- * RL2064.2 +000700* * RL2064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2064.2 +000900* * RL2064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2064.2 +001100* * RL2064.2 +001200**************************************************************** RL2064.2 +001300*GENERAL: THIS RUN UNIT IS THE FIRST OF A SERIES WHICH RL2064.2 +001400* PROCESSES A RELATIVE I-O FILE. THE FUNCTION OF THIS RL2064.2 +001500* PROGRAM IS TO CREATE A RELATIVE FILE SEQUENTIALLY RL2064.2 +001600* (ACCESS MODE SEQUENTIAL) AND VERIFY THAT IT WAS RL2064.2 +001700* CREATED CORRECTLY. THE FILE IS IDENTIFED AS "RL-FS1"RL2064.2 +001800* AND IS PASSED TO SUBSEQUENT RUN UNITS FOR PROCESSING.RL2064.2 +001900* RL2064.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2064.2 +002100* PROGRAM ARE: RL2064.2 +002200* RL2064.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2064.2 +002400* RELATIVE I-O DATA FILE RL2064.2 +002500* X-55 SYSTEM PRINTER RL2064.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES RL2064.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME RL2064.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE RL2064.2 +002900* X-82 SOURCE-COMPUTER RL2064.2 +003000* X-83 OBJECT-COMPUTER. RL2064.2 +003100* RL2064.2 +003200**************************************************************** RL2064.2 +003300 ENVIRONMENT DIVISION. RL2064.2 +003400 CONFIGURATION SECTION. RL2064.2 +003500 SOURCE-COMPUTER. RL2064.2 +003600 Linux. RL2064.2 +003700 OBJECT-COMPUTER. RL2064.2 +003800 Linux. RL2064.2 +003900 INPUT-OUTPUT SECTION. RL2064.2 +004000 FILE-CONTROL. RL2064.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2064.2 +004200 "report.log". RL2064.2 +004300 SELECT RL-FS1 ASSIGN TO RL2064.2 +004400 "XXXXX021" RL2064.2 +004500 ORGANIZATION IS RELATIVE. RL2064.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2064.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2064.2 +004800 DATA DIVISION. RL2064.2 +004900 FILE SECTION. RL2064.2 +005000 FD PRINT-FILE. RL2064.2 +005100 01 PRINT-REC PICTURE X(120). RL2064.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2064.2 +005300 FD RL-FS1 RL2064.2 +005400 LABEL RECORDS STANDARD RL2064.2 +005500*C VALUE OF RL2064.2 +005600*C OCLABELID RL2064.2 +005700*C IS RL2064.2 +005800*C "OCDUMMY" RL2064.2 +005900*G SYSIN RL2064.2 +006000 BLOCK CONTAINS 1 RECORDS RL2064.2 +006100 RECORD IS VARYING IN SIZE RL2064.2 +006200 FROM 120 TO 140 CHARACTERS RL2064.2 +006300 DEPENDING ON WRK-SIZE. RL2064.2 +006400 01 RL-FS1R1-F-G-140. RL2064.2 +006500 02 FILLER PIC X(140). RL2064.2 +006600 WORKING-STORAGE SECTION. RL2064.2 +006700 01 WRK-SIZE PIC 9(3). RL2064.2 +006800 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2064.2 +006900 01 FILE-RECORD-INFORMATION-REC. RL2064.2 +007000 03 FILE-RECORD-INFO-SKELETON. RL2064.2 +007100 05 FILLER PICTURE X(48) VALUE RL2064.2 +007200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2064.2 +007300 05 FILLER PICTURE X(46) VALUE RL2064.2 +007400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2064.2 +007500 05 FILLER PICTURE X(26) VALUE RL2064.2 +007600 ",LFIL=000000,ORG= ,LBLR= ". RL2064.2 +007700 05 FILLER PICTURE X(37) VALUE RL2064.2 +007800 ",RECKEY= ". RL2064.2 +007900 05 FILLER PICTURE X(38) VALUE RL2064.2 +008000 ",ALTKEY1= ". RL2064.2 +008100 05 FILLER PICTURE X(38) VALUE RL2064.2 +008200 ",ALTKEY2= ". RL2064.2 +008300 05 FILLER PICTURE X(7) VALUE SPACE.RL2064.2 +008400 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2064.2 +008500 05 FILE-RECORD-INFO-P1-120. RL2064.2 +008600 07 FILLER PIC X(5). RL2064.2 +008700 07 XFILE-NAME PIC X(6). RL2064.2 +008800 07 FILLER PIC X(8). RL2064.2 +008900 07 XRECORD-NAME PIC X(6). RL2064.2 +009000 07 FILLER PIC X(1). RL2064.2 +009100 07 REELUNIT-NUMBER PIC 9(1). RL2064.2 +009200 07 FILLER PIC X(7). RL2064.2 +009300 07 XRECORD-NUMBER PIC 9(6). RL2064.2 +009400 07 FILLER PIC X(6). RL2064.2 +009500 07 UPDATE-NUMBER PIC 9(2). RL2064.2 +009600 07 FILLER PIC X(5). RL2064.2 +009700 07 ODO-NUMBER PIC 9(4). RL2064.2 +009800 07 FILLER PIC X(5). RL2064.2 +009900 07 XPROGRAM-NAME PIC X(5). RL2064.2 +010000 07 FILLER PIC X(7). RL2064.2 +010100 07 XRECORD-LENGTH PIC 9(6). RL2064.2 +010200 07 FILLER PIC X(7). RL2064.2 +010300 07 CHARS-OR-RECORDS PIC X(2). RL2064.2 +010400 07 FILLER PIC X(1). RL2064.2 +010500 07 XBLOCK-SIZE PIC 9(4). RL2064.2 +010600 07 FILLER PIC X(6). RL2064.2 +010700 07 RECORDS-IN-FILE PIC 9(6). RL2064.2 +010800 07 FILLER PIC X(5). RL2064.2 +010900 07 XFILE-ORGANIZATION PIC X(2). RL2064.2 +011000 07 FILLER PIC X(6). RL2064.2 +011100 07 XLABEL-TYPE PIC X(1). RL2064.2 +011200 05 FILE-RECORD-INFO-P121-240. RL2064.2 +011300 07 FILLER PIC X(8). RL2064.2 +011400 07 XRECORD-KEY PIC X(29). RL2064.2 +011500 07 FILLER PIC X(9). RL2064.2 +011600 07 ALTERNATE-KEY1 PIC X(29). RL2064.2 +011700 07 FILLER PIC X(9). RL2064.2 +011800 07 ALTERNATE-KEY2 PIC X(29). RL2064.2 +011900 07 FILLER PIC X(7). RL2064.2 +012000 01 NEW-140-CHAR-AREA. RL2064.2 +012100 03 FILLER PIC X(120). RL2064.2 +012200 03 EXTRA-20-CHARS PIC X(20). RL2064.2 +012300 RL2064.2 +012400 01 TEST-RESULTS. RL2064.2 +012500 02 FILLER PIC X VALUE SPACE. RL2064.2 +012600 02 FEATURE PIC X(20) VALUE SPACE. RL2064.2 +012700 02 FILLER PIC X VALUE SPACE. RL2064.2 +012800 02 P-OR-F PIC X(5) VALUE SPACE. RL2064.2 +012900 02 FILLER PIC X VALUE SPACE. RL2064.2 +013000 02 PAR-NAME. RL2064.2 +013100 03 FILLER PIC X(19) VALUE SPACE. RL2064.2 +013200 03 PARDOT-X PIC X VALUE SPACE. RL2064.2 +013300 03 DOTVALUE PIC 99 VALUE ZERO. RL2064.2 +013400 02 FILLER PIC X(8) VALUE SPACE. RL2064.2 +013500 02 RE-MARK PIC X(61). RL2064.2 +013600 01 TEST-COMPUTED. RL2064.2 +013700 02 FILLER PIC X(30) VALUE SPACE. RL2064.2 +013800 02 FILLER PIC X(17) VALUE RL2064.2 +013900 " COMPUTED=". RL2064.2 +014000 02 COMPUTED-X. RL2064.2 +014100 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2064.2 +014200 03 COMPUTED-N REDEFINES COMPUTED-A RL2064.2 +014300 PIC -9(9).9(9). RL2064.2 +014400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2064.2 +014500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2064.2 +014600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2064.2 +014700 03 CM-18V0 REDEFINES COMPUTED-A. RL2064.2 +014800 04 COMPUTED-18V0 PIC -9(18). RL2064.2 +014900 04 FILLER PIC X. RL2064.2 +015000 03 FILLER PIC X(50) VALUE SPACE. RL2064.2 +015100 01 TEST-CORRECT. RL2064.2 +015200 02 FILLER PIC X(30) VALUE SPACE. RL2064.2 +015300 02 FILLER PIC X(17) VALUE " CORRECT =". RL2064.2 +015400 02 CORRECT-X. RL2064.2 +015500 03 CORRECT-A PIC X(20) VALUE SPACE. RL2064.2 +015600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2064.2 +015700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2064.2 +015800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2064.2 +015900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2064.2 +016000 03 CR-18V0 REDEFINES CORRECT-A. RL2064.2 +016100 04 CORRECT-18V0 PIC -9(18). RL2064.2 +016200 04 FILLER PIC X. RL2064.2 +016300 03 FILLER PIC X(2) VALUE SPACE. RL2064.2 +016400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2064.2 +016500 01 CCVS-C-1. RL2064.2 +016600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2064.2 +016700- "SS PARAGRAPH-NAME RL2064.2 +016800- " REMARKS". RL2064.2 +016900 02 FILLER PIC X(20) VALUE SPACE. RL2064.2 +017000 01 CCVS-C-2. RL2064.2 +017100 02 FILLER PIC X VALUE SPACE. RL2064.2 +017200 02 FILLER PIC X(6) VALUE "TESTED". RL2064.2 +017300 02 FILLER PIC X(15) VALUE SPACE. RL2064.2 +017400 02 FILLER PIC X(4) VALUE "FAIL". RL2064.2 +017500 02 FILLER PIC X(94) VALUE SPACE. RL2064.2 +017600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2064.2 +017700 01 REC-CT PIC 99 VALUE ZERO. RL2064.2 +017800 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2064.2 +017900 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2064.2 +018000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2064.2 +018100 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2064.2 +018200 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2064.2 +018300 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2064.2 +018400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2064.2 +018500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2064.2 +018600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2064.2 +018700 01 CCVS-H-1. RL2064.2 +018800 02 FILLER PIC X(39) VALUE SPACES. RL2064.2 +018900 02 FILLER PIC X(42) VALUE RL2064.2 +019000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2064.2 +019100 02 FILLER PIC X(39) VALUE SPACES. RL2064.2 +019200 01 CCVS-H-2A. RL2064.2 +019300 02 FILLER PIC X(40) VALUE SPACE. RL2064.2 +019400 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2064.2 +019500 02 FILLER PIC XXXX VALUE RL2064.2 +019600 "4.2 ". RL2064.2 +019700 02 FILLER PIC X(28) VALUE RL2064.2 +019800 " COPY - NOT FOR DISTRIBUTION". RL2064.2 +019900 02 FILLER PIC X(41) VALUE SPACE. RL2064.2 +020000 RL2064.2 +020100 01 CCVS-H-2B. RL2064.2 +020200 02 FILLER PIC X(15) VALUE RL2064.2 +020300 "TEST RESULT OF ". RL2064.2 +020400 02 TEST-ID PIC X(9). RL2064.2 +020500 02 FILLER PIC X(4) VALUE RL2064.2 +020600 " IN ". RL2064.2 +020700 02 FILLER PIC X(12) VALUE RL2064.2 +020800 " HIGH ". RL2064.2 +020900 02 FILLER PIC X(22) VALUE RL2064.2 +021000 " LEVEL VALIDATION FOR ". RL2064.2 +021100 02 FILLER PIC X(58) VALUE RL2064.2 +021200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2064.2 +021300 01 CCVS-H-3. RL2064.2 +021400 02 FILLER PIC X(34) VALUE RL2064.2 +021500 " FOR OFFICIAL USE ONLY ". RL2064.2 +021600 02 FILLER PIC X(58) VALUE RL2064.2 +021700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2064.2 +021800 02 FILLER PIC X(28) VALUE RL2064.2 +021900 " COPYRIGHT 1985 ". RL2064.2 +022000 01 CCVS-E-1. RL2064.2 +022100 02 FILLER PIC X(52) VALUE SPACE. RL2064.2 +022200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2064.2 +022300 02 ID-AGAIN PIC X(9). RL2064.2 +022400 02 FILLER PIC X(45) VALUE SPACES. RL2064.2 +022500 01 CCVS-E-2. RL2064.2 +022600 02 FILLER PIC X(31) VALUE SPACE. RL2064.2 +022700 02 FILLER PIC X(21) VALUE SPACE. RL2064.2 +022800 02 CCVS-E-2-2. RL2064.2 +022900 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2064.2 +023000 03 FILLER PIC X VALUE SPACE. RL2064.2 +023100 03 ENDER-DESC PIC X(44) VALUE RL2064.2 +023200 "ERRORS ENCOUNTERED". RL2064.2 +023300 01 CCVS-E-3. RL2064.2 +023400 02 FILLER PIC X(22) VALUE RL2064.2 +023500 " FOR OFFICIAL USE ONLY". RL2064.2 +023600 02 FILLER PIC X(12) VALUE SPACE. RL2064.2 +023700 02 FILLER PIC X(58) VALUE RL2064.2 +023800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2064.2 +023900 02 FILLER PIC X(13) VALUE SPACE. RL2064.2 +024000 02 FILLER PIC X(15) VALUE RL2064.2 +024100 " COPYRIGHT 1985". RL2064.2 +024200 01 CCVS-E-4. RL2064.2 +024300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2064.2 +024400 02 FILLER PIC X(4) VALUE " OF ". RL2064.2 +024500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2064.2 +024600 02 FILLER PIC X(40) VALUE RL2064.2 +024700 " TESTS WERE EXECUTED SUCCESSFULLY". RL2064.2 +024800 01 XXINFO. RL2064.2 +024900 02 FILLER PIC X(19) VALUE RL2064.2 +025000 "*** INFORMATION ***". RL2064.2 +025100 02 INFO-TEXT. RL2064.2 +025200 04 FILLER PIC X(8) VALUE SPACE. RL2064.2 +025300 04 XXCOMPUTED PIC X(20). RL2064.2 +025400 04 FILLER PIC X(5) VALUE SPACE. RL2064.2 +025500 04 XXCORRECT PIC X(20). RL2064.2 +025600 02 INF-ANSI-REFERENCE PIC X(48). RL2064.2 +025700 01 HYPHEN-LINE. RL2064.2 +025800 02 FILLER PIC IS X VALUE IS SPACE. RL2064.2 +025900 02 FILLER PIC IS X(65) VALUE IS "************************RL2064.2 +026000- "*****************************************". RL2064.2 +026100 02 FILLER PIC IS X(54) VALUE IS "************************RL2064.2 +026200- "******************************". RL2064.2 +026300 01 CCVS-PGM-ID PIC X(9) VALUE RL2064.2 +026400 "RL206A". RL2064.2 +026500 PROCEDURE DIVISION. RL2064.2 +026600 CCVS1 SECTION. RL2064.2 +026700 OPEN-FILES. RL2064.2 +026800 OPEN OUTPUT PRINT-FILE. RL2064.2 +026900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2064.2 +027000 MOVE SPACE TO TEST-RESULTS. RL2064.2 +027100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2064.2 +027200 MOVE ZERO TO REC-SKL-SUB. RL2064.2 +027300 PERFORM CCVS-INIT-FILE 9 TIMES. RL2064.2 +027400 CCVS-INIT-FILE. RL2064.2 +027500 ADD 1 TO REC-SKL-SUB. RL2064.2 +027600 MOVE FILE-RECORD-INFO-SKELETON RL2064.2 +027700 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2064.2 +027800 CCVS-INIT-EXIT. RL2064.2 +027900 GO TO CCVS1-EXIT. RL2064.2 +028000 CLOSE-FILES. RL2064.2 +028100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2064.2 +028200 TERMINATE-CCVS. RL2064.2 +028300*S EXIT PROGRAM. RL2064.2 +028400*SERMINATE-CALL. RL2064.2 +028500 STOP RUN. RL2064.2 +028600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2064.2 +028700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2064.2 +028800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2064.2 +028900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2064.2 +029000 MOVE "****TEST DELETED****" TO RE-MARK. RL2064.2 +029100 PRINT-DETAIL. RL2064.2 +029200 IF REC-CT NOT EQUAL TO ZERO RL2064.2 +029300 MOVE "." TO PARDOT-X RL2064.2 +029400 MOVE REC-CT TO DOTVALUE. RL2064.2 +029500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2064.2 +029600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2064.2 +029700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2064.2 +029800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2064.2 +029900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2064.2 +030000 MOVE SPACE TO CORRECT-X. RL2064.2 +030100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2064.2 +030200 MOVE SPACE TO RE-MARK. RL2064.2 +030300 HEAD-ROUTINE. RL2064.2 +030400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +030500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +030600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2064.2 +030700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2064.2 +030800 COLUMN-NAMES-ROUTINE. RL2064.2 +030900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +031000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +031200 END-ROUTINE. RL2064.2 +031300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2064.2 +031400 END-RTN-EXIT. RL2064.2 +031500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +031600 END-ROUTINE-1. RL2064.2 +031700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2064.2 +031800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2064.2 +031900 ADD PASS-COUNTER TO ERROR-HOLD. RL2064.2 +032000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2064.2 +032100 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2064.2 +032200 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2064.2 +032300 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2064.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2064.2 +032500 END-ROUTINE-12. RL2064.2 +032600 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2064.2 +032700 IF ERROR-COUNTER IS EQUAL TO ZERO RL2064.2 +032800 MOVE "NO " TO ERROR-TOTAL RL2064.2 +032900 ELSE RL2064.2 +033000 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2064.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2064.2 +033200 PERFORM WRITE-LINE. RL2064.2 +033300 END-ROUTINE-13. RL2064.2 +033400 IF DELETE-COUNTER IS EQUAL TO ZERO RL2064.2 +033500 MOVE "NO " TO ERROR-TOTAL ELSE RL2064.2 +033600 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2064.2 +033700 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2064.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +033900 IF INSPECT-COUNTER EQUAL TO ZERO RL2064.2 +034000 MOVE "NO " TO ERROR-TOTAL RL2064.2 +034100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2064.2 +034200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2064.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +034400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2064.2 +034500 WRITE-LINE. RL2064.2 +034600 ADD 1 TO RECORD-COUNT. RL2064.2 +034700 IF RECORD-COUNT GREATER 50 RL2064.2 +034800 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2064.2 +034900 MOVE SPACE TO DUMMY-RECORD RL2064.2 +035000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2064.2 +035100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2064.2 +035200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2064.2 +035300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2064.2 +035400 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2064.2 +035500 MOVE ZERO TO RECORD-COUNT. RL2064.2 +035600 PERFORM WRT-LN. RL2064.2 +035700 WRT-LN. RL2064.2 +035800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2064.2 +035900 MOVE SPACE TO DUMMY-RECORD. RL2064.2 +036000 BLANK-LINE-PRINT. RL2064.2 +036100 PERFORM WRT-LN. RL2064.2 +036200 FAIL-ROUTINE. RL2064.2 +036300 IF COMPUTED-X NOT EQUAL TO SPACE RL2064.2 +036400 GO TO FAIL-ROUTINE-WRITE. RL2064.2 +036500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL2064.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2064.2 +036700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2064.2 +036800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +036900 MOVE SPACES TO INF-ANSI-REFERENCE. RL2064.2 +037000 GO TO FAIL-ROUTINE-EX. RL2064.2 +037100 FAIL-ROUTINE-WRITE. RL2064.2 +037200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2064.2 +037300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2064.2 +037400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2064.2 +037500 MOVE SPACES TO COR-ANSI-REFERENCE. RL2064.2 +037600 FAIL-ROUTINE-EX. EXIT. RL2064.2 +037700 BAIL-OUT. RL2064.2 +037800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2064.2 +037900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2064.2 +038000 BAIL-OUT-WRITE. RL2064.2 +038100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2064.2 +038200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2064.2 +038300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2064.2 +038400 MOVE SPACES TO INF-ANSI-REFERENCE. RL2064.2 +038500 BAIL-OUT-EX. EXIT. RL2064.2 +038600 CCVS1-EXIT. RL2064.2 +038700 EXIT. RL2064.2 +038800 SECT-RL206A-001 SECTION. RL2064.2 +038900 REL-INIT-001. RL2064.2 +039000 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL2064.2 +039100 OPEN OUTPUT RL-FS1. RL2064.2 +039200 MOVE "RL-FS1" TO XFILE-NAME (1). RL2064.2 +039300 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2064.2 +039400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2064.2 +039500 MOVE 000120 TO XRECORD-LENGTH (1). RL2064.2 +039600 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2064.2 +039700 MOVE 0001 TO XBLOCK-SIZE (1). RL2064.2 +039800 MOVE 000500 TO RECORDS-IN-FILE (1). RL2064.2 +039900 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2064.2 +040000 MOVE "S" TO XLABEL-TYPE (1). RL2064.2 +040100 MOVE 000001 TO XRECORD-NUMBER (1). RL2064.2 +040200 REL-TEST-001. RL2064.2 +040300 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-140-CHAR-AREA. RL2064.2 +040400 MOVE "ABCDEFGHIJKLMNOPQRST" TO EXTRA-20-CHARS. RL2064.2 +040500 MOVE NEW-140-CHAR-AREA TO RL-FS1R1-F-G-140. RL2064.2 +040600 IF XRECORD-NUMBER (1) > 32 RL2064.2 +040700 MOVE 140 TO WRK-SIZE. RL2064.2 +040800 IF XRECORD-NUMBER (1) = 32 RL2064.2 +040900 MOVE 135 TO WRK-SIZE. RL2064.2 +041000 IF XRECORD-NUMBER (1) = 31 RL2064.2 +041100 MOVE 125 TO WRK-SIZE. RL2064.2 +041200 IF XRECORD-NUMBER (1) < 31 RL2064.2 +041300 MOVE 140 TO WRK-SIZE. RL2064.2 +041400 IF XRECORD-NUMBER (1) < 21 RL2064.2 +041500 MOVE 130 TO WRK-SIZE. RL2064.2 +041600 IF XRECORD-NUMBER (1) < 11 RL2064.2 +041700 MOVE 120 TO WRK-SIZE. RL2064.2 +041800 WRITE RL-FS1R1-F-G-140 RL2064.2 +041900 INVALID KEY GO TO REL-FAIL-001. RL2064.2 +042000 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2064.2 +042100 GO TO REL-WRITE-001. RL2064.2 +042200 ADD 000001 TO XRECORD-NUMBER (1). RL2064.2 +042300 GO TO REL-TEST-001. RL2064.2 +042400 REL-DELETE-001. RL2064.2 +042500 PERFORM DE-LETE. RL2064.2 +042600 GO TO REL-WRITE-001. RL2064.2 +042700 REL-FAIL-001. RL2064.2 +042800 PERFORM FAIL. RL2064.2 +042900 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2064.2 +043000 REL-WRITE-001. RL2064.2 +043100 MOVE "REL-TEST-001" TO PAR-NAME RL2064.2 +043200 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2064.2 +043300 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2064.2 +043400 PERFORM PRINT-DETAIL. RL2064.2 +043500 CLOSE RL-FS1. RL2064.2 +043600 REL-INIT-002. RL2064.2 +043700 OPEN INPUT RL-FS1. RL2064.2 +043800 MOVE ZERO TO WRK-CS-09V00. RL2064.2 +043900 REL-TEST-002. RL2064.2 +044000 READ RL-FS1 INTO NEW-140-CHAR-AREA RL2064.2 +044100 AT END GO TO REL-TEST-002-1. RL2064.2 +044200 ADD 1 TO WRK-CS-09V00. RL2064.2 +044300 IF WRK-CS-09V00 GREATER 500 RL2064.2 +044400 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2064.2 +044500 GO TO REL-TEST-002-1. RL2064.2 +044600 PERFORM SIZE-TEST-1. RL2064.2 +044700 GO TO REL-TEST-002. RL2064.2 +044800 REL-DELETE-002. RL2064.2 +044900 PERFORM DE-LETE. RL2064.2 +045000 PERFORM PRINT-DETAIL. RL2064.2 +045100 REL-TEST-002-1. RL2064.2 +045200 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2064.2 +045300 PERFORM FAIL RL2064.2 +045400 ELSE RL2064.2 +045500 PERFORM PASS. RL2064.2 +045600 GO TO REL-WRITE-002. RL2064.2 +045700 REL-WRITE-002. RL2064.2 +045800 MOVE "REL-TEST-002" TO PAR-NAME. RL2064.2 +045900 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2064.2 +046000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2064.2 +046100 PERFORM PRINT-DETAIL. RL2064.2 +046200 CLOSE RL-FS1. RL2064.2 +046300 GO TO CCVS-EXIT. RL2064.2 +046400 SIZE-TEST-1 SECTION. RL2064.2 +046500*=================== RL2064.2 +046600 REL-SIZE-TEST-1. RL2064.2 +046700 IF WRK-CS-09V00 > 32 RL2064.2 +046800 PERFORM SIZE-TEST-2. RL2064.2 +046900 IF WRK-CS-09V00 = 32 RL2064.2 +047000 PERFORM SIZE-TEST-3. RL2064.2 +047100 IF WRK-CS-09V00 = 31 RL2064.2 +047200 PERFORM SIZE-TEST-4. RL2064.2 +047300 IF WRK-CS-09V00 < 11 RL2064.2 +047400 PERFORM SIZE-TEST-7 RL2064.2 +047500 GO TO SIZE-TEST-1-EXIT. RL2064.2 +047600 IF WRK-CS-09V00 < 21 RL2064.2 +047700 PERFORM SIZE-TEST-6 RL2064.2 +047800 GO TO SIZE-TEST-1-EXIT. RL2064.2 +047900 IF WRK-CS-09V00 < 31 RL2064.2 +048000 PERFORM SIZE-TEST-5. RL2064.2 +048100 SIZE-TEST-1-EXIT. RL2064.2 +048200 EXIT. RL2064.2 +048300 SIZE-TEST-2 SECTION. RL2064.2 +048400 REL-SIZE-TEST-2. RL2064.2 +048500 IF WRK-SIZE NOT = 140 RL2064.2 +048600 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +048700 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +048800 MOVE 140 TO CORRECT-18V0 RL2064.2 +048900 PERFORM FAIL RL2064.2 +049000 PERFORM PRINT-DETAIL RL2064.2 +049100 ELSE RL2064.2 +049200 PERFORM PASS. RL2064.2 +049300* PERFORM PRINT-DETAIL. RL2064.2 +049400 SIZE-TEST-2-EXIT. RL2064.2 +049500 EXIT. RL2064.2 +049600 SIZE-TEST-3 SECTION. RL2064.2 +049700 REL-SIZE-TEST-3. RL2064.2 +049800 IF WRK-SIZE NOT = 135 RL2064.2 +049900 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +050000 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +050100 MOVE 135 TO CORRECT-18V0 RL2064.2 +050200 PERFORM FAIL RL2064.2 +050300 PERFORM PRINT-DETAIL RL2064.2 +050400 ELSE RL2064.2 +050500 PERFORM PASS. RL2064.2 +050600* PERFORM PRINT-DETAIL. RL2064.2 +050700 SIZE-TEST-3-EXIT. RL2064.2 +050800 EXIT. RL2064.2 +050900 SIZE-TEST-4 SECTION. RL2064.2 +051000 REL-SIZE-TEST-4. RL2064.2 +051100 IF WRK-SIZE NOT = 125 RL2064.2 +051200 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +051300 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +051400 MOVE 125 TO CORRECT-18V0 RL2064.2 +051500 PERFORM FAIL RL2064.2 +051600 PERFORM PRINT-DETAIL RL2064.2 +051700 ELSE RL2064.2 +051800 PERFORM PASS. RL2064.2 +051900* PERFORM PRINT-DETAIL. RL2064.2 +052000 SIZE-TEST-4-EXIT. RL2064.2 +052100 EXIT. RL2064.2 +052200 SIZE-TEST-5 SECTION. RL2064.2 +052300 REL-SIZE-TEST-5. RL2064.2 +052400 IF WRK-SIZE NOT = 140 RL2064.2 +052500 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +052600 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +052700 MOVE 140 TO CORRECT-18V0 RL2064.2 +052800 PERFORM FAIL RL2064.2 +052900 PERFORM PRINT-DETAIL RL2064.2 +053000 ELSE RL2064.2 +053100 PERFORM PASS. RL2064.2 +053200* PERFORM PRINT-DETAIL. RL2064.2 +053300 SIZE-TEST-5-EXIT. RL2064.2 +053400 EXIT. RL2064.2 +053500 SIZE-TEST-6 SECTION. RL2064.2 +053600 REL-SIZE-TEST-6. RL2064.2 +053700 IF WRK-SIZE NOT = 130 RL2064.2 +053800 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +053900 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +054000 MOVE 130 TO CORRECT-18V0 RL2064.2 +054100 PERFORM FAIL RL2064.2 +054200 PERFORM PRINT-DETAIL RL2064.2 +054300 ELSE RL2064.2 +054400 PERFORM PASS. RL2064.2 +054500* PERFORM PRINT-DETAIL. RL2064.2 +054600 SIZE-TEST-6-EXIT. RL2064.2 +054700 EXIT. RL2064.2 +054800 SIZE-TEST-7 SECTION. RL2064.2 +054900 REL-SIZE-TEST-7. RL2064.2 +055000 IF WRK-SIZE NOT = 120 RL2064.2 +055100 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2064.2 +055200 MOVE WRK-SIZE TO COMPUTED-18V0 RL2064.2 +055300 MOVE 120 TO CORRECT-18V0 RL2064.2 +055400 PERFORM FAIL RL2064.2 +055500 PERFORM PRINT-DETAIL RL2064.2 +055600 ELSE RL2064.2 +055700 PERFORM PASS. RL2064.2 +055800* PERFORM PRINT-DETAIL. RL2064.2 +055900 SIZE-TEST-7-EXIT. RL2064.2 +056000 EXIT. RL2064.2 +056100 CCVS-EXIT SECTION. RL2064.2 +056200 CCVS-999999. RL2064.2 +056300 GO TO CLOSE-FILES. RL2064.2 diff --git a/tests/cobol85/RL/RL207A.SUB b/tests/cobol85/RL/RL207A.SUB new file mode 100644 index 00000000..ee5c2f8c --- /dev/null +++ b/tests/cobol85/RL/RL207A.SUB @@ -0,0 +1,1064 @@ +000100 IDENTIFICATION DIVISION. RL2074.2 +000200 PROGRAM-ID. RL2074.2 +000300 RL207A. RL2074.2 +000400**************************************************************** RL2074.2 +000500* * RL2074.2 +000600* VALIDATION FOR:- * RL2074.2 +000700* * RL2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2074.2 +000900* * RL2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2074.2 +001100* * RL2074.2 +001200**************************************************************** RL2074.2 +001300*GENERAL: THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVERL2074.2 +001400* I-O FILE RANDOMLY (ACCESS MODE IS DYNAMIC). THE FILE RL2074.2 +001500* USED AS INPUT IS THAT FILE CREATED BY RL206A. RL2074.2 +001600* RL2074.2 +001700* FIRST THE FILE IS VERIFED AS TO THE EXISTANCE AND RL2074.2 +001800* ACCURACY OF THE 500 RECORDS CREATED IN THE FIRST RL2074.2 +001900* PROGRAM. SECONDLY, RECORDS OF THE FILE ARE SEL- RL2074.2 +002000* ECTIVELY UPDATED; AND THIRDLY, THE ACCURACY OF EACH RL2074.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL2074.2 +002200* RL2074.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2074.2 +002400* PROGRAM ARE: RL2074.2 +002500* RL2074.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2074.2 +002700* RELATIVE I-O DATA FILE RL2074.2 +002800* X-55 SYSTEM PRINTER RL2074.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2074.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2074.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2074.2 +003200* X-82 SOURCE-COMPUTER RL2074.2 +003300* X-83 OBJECT-COMPUTER. RL2074.2 +003400* RL2074.2 +003500**************************************************************** RL2074.2 +003600 ENVIRONMENT DIVISION. RL2074.2 +003700 CONFIGURATION SECTION. RL2074.2 +003800 SOURCE-COMPUTER. RL2074.2 +003900 Linux. RL2074.2 +004000 OBJECT-COMPUTER. RL2074.2 +004100 Linux. RL2074.2 +004200 INPUT-OUTPUT SECTION. RL2074.2 +004300 FILE-CONTROL. RL2074.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2074.2 +004500 "report.log". RL2074.2 +004600 SELECT RL-FD1 ASSIGN TO RL2074.2 +004700 "XXXXX021" RL2074.2 +004800 ORGANIZATION IS RELATIVE RL2074.2 +004900 ACCESS MODE IS DYNAMIC RL2074.2 +005000 RELATIVE KEY RL-FD1-KEY RL2074.2 +005100 STATUS WS-STATUS. RL2074.2 +005200 DATA DIVISION. RL2074.2 +005300 FILE SECTION. RL2074.2 +005400 FD PRINT-FILE. RL2074.2 +005500 01 PRINT-REC PICTURE X(120). RL2074.2 +005600 01 DUMMY-RECORD PICTURE X(120). RL2074.2 +005700 FD RL-FD1 RL2074.2 +005800 LABEL RECORDS STANDARD RL2074.2 +005900*C VALUE OF RL2074.2 +006000*C OCLABELID RL2074.2 +006100*C IS RL2074.2 +006200*C "OCDUMMY" RL2074.2 +006300*G SYSIN RL2074.2 +006400 BLOCK CONTAINS 1 RECORDS RL2074.2 +006500 RECORD VARYING 120 TO 140 DEPENDING WRK-SIZE. RL2074.2 +006600 01 RL-FD1R1-F-G-140. RL2074.2 +006700 02 FILLER PICTURE X(140). RL2074.2 +006800 WORKING-STORAGE SECTION. RL2074.2 +006900 01 WS-STATUS PIC XX. RL2074.2 +007000 01 WRK-SIZE PIC 999. RL2074.2 +007100 01 WRK-CS-09V00 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007200 01 RL-FD1-KEY PIC 9(09) USAGE COMP VALUE ZERO. RL2074.2 +007300 01 WRK-DS-09V00-002 PIC S9(9) VALUE ZERO. RL2074.2 +007400 01 WRK-CS-09V00-002 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007500 01 WRK-CS-09V00-003 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007600 01 I-O-ERROR-RL-FD1 PIC X(3) VALUE "NO ". RL2074.2 +007700 01 WRK-CS-09V00-001 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007800 01 WRK-CS-09V00-004 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +007900 01 WRK-CS-09V00-005 PIC S9(09) USAGE COMP VALUE ZERO. RL2074.2 +008000 01 WRK-DS-09V00-001 PIC S9(09) VALUE ZERO. RL2074.2 +008100 01 FILE-RECORD-INFORMATION-REC. RL2074.2 +008200 03 FILE-RECORD-INFO-SKELETON. RL2074.2 +008300 05 FILLER PICTURE X(48) VALUE RL2074.2 +008400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2074.2 +008500 05 FILLER PICTURE X(46) VALUE RL2074.2 +008600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2074.2 +008700 05 FILLER PICTURE X(26) VALUE RL2074.2 +008800 ",LFIL=000000,ORG= ,LBLR= ". RL2074.2 +008900 05 FILLER PICTURE X(37) VALUE RL2074.2 +009000 ",RECKEY= ". RL2074.2 +009100 05 FILLER PICTURE X(38) VALUE RL2074.2 +009200 ",ALTKEY1= ". RL2074.2 +009300 05 FILLER PICTURE X(38) VALUE RL2074.2 +009400 ",ALTKEY2= ". RL2074.2 +009500 05 FILLER PICTURE X(7) VALUE SPACE.RL2074.2 +009600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2074.2 +009700 05 FILE-RECORD-INFO-P1-120. RL2074.2 +009800 07 FILLER PIC X(5). RL2074.2 +009900 07 XFILE-NAME PIC X(6). RL2074.2 +010000 07 FILLER PIC X(8). RL2074.2 +010100 07 XRECORD-NAME PIC X(6). RL2074.2 +010200 07 FILLER PIC X(1). RL2074.2 +010300 07 REELUNIT-NUMBER PIC 9(1). RL2074.2 +010400 07 FILLER PIC X(7). RL2074.2 +010500 07 XRECORD-NUMBER PIC 9(6). RL2074.2 +010600 07 FILLER PIC X(6). RL2074.2 +010700 07 UPDATE-NUMBER PIC 9(2). RL2074.2 +010800 07 FILLER PIC X(5). RL2074.2 +010900 07 ODO-NUMBER PIC 9(4). RL2074.2 +011000 07 FILLER PIC X(5). RL2074.2 +011100 07 XPROGRAM-NAME PIC X(5). RL2074.2 +011200 07 FILLER PIC X(7). RL2074.2 +011300 07 XRECORD-LENGTH PIC 9(6). RL2074.2 +011400 07 FILLER PIC X(7). RL2074.2 +011500 07 CHARS-OR-RECORDS PIC X(2). RL2074.2 +011600 07 FILLER PIC X(1). RL2074.2 +011700 07 XBLOCK-SIZE PIC 9(4). RL2074.2 +011800 07 FILLER PIC X(6). RL2074.2 +011900 07 RECORDS-IN-FILE PIC 9(6). RL2074.2 +012000 07 FILLER PIC X(5). RL2074.2 +012100 07 XFILE-ORGANIZATION PIC X(2). RL2074.2 +012200 07 FILLER PIC X(6). RL2074.2 +012300 07 XLABEL-TYPE PIC X(1). RL2074.2 +012400 05 FILE-RECORD-INFO-P121-240. RL2074.2 +012500 07 FILLER PIC X(8). RL2074.2 +012600 07 XRECORD-KEY PIC X(29). RL2074.2 +012700 07 FILLER PIC X(9). RL2074.2 +012800 07 ALTERNATE-KEY1 PIC X(29). RL2074.2 +012900 07 FILLER PIC X(9). RL2074.2 +013000 07 ALTERNATE-KEY2 PIC X(29). RL2074.2 +013100 07 FILLER PIC X(7). RL2074.2 +013200 01 NEW-115-CHAR-AREA. RL2074.2 +013300 03 NEW-115-120 PIC X(115). RL2074.2 +013400 01 NEW-125-CHAR-AREA. RL2074.2 +013500 03 NEW-125-120 PIC X(120). RL2074.2 +013600 03 EXTRA-5-CHARS PIC X(5). RL2074.2 +013700 01 NEW-128-CHAR-AREA. RL2074.2 +013800 03 NEW-128-120 PIC X(120). RL2074.2 +013900 03 EXTRA-8-CHARS PIC X(8). RL2074.2 +014000 01 NEW-130-CHAR-AREA. RL2074.2 +014100 03 NEW-130-120 PIC X(120). RL2074.2 +014200 03 EXTRA-10-CHARS PIC X(10). RL2074.2 +014300 01 NEW-132-CHAR-AREA. RL2074.2 +014400 03 NEW-132-120 PIC X(120). RL2074.2 +014500 03 EXTRA-12-CHARS PIC X(12). RL2074.2 +014600 01 NEW-135-CHAR-AREA. RL2074.2 +014700 03 NEW-135-120 PIC X(120). RL2074.2 +014800 03 EXTRA-15-CHARS PIC X(15). RL2074.2 +014900 01 NEW-140-CHAR-AREA. RL2074.2 +015000 03 NEW-140-120 PIC X(120). RL2074.2 +015100 03 EXTRA-20-CHARS PIC X(20). RL2074.2 +015200 01 NEW-145-CHAR-AREA. RL2074.2 +015300 03 NEW-145-120 PIC X(120). RL2074.2 +015400 03 EXTRA-25-CHARS PIC X(25). RL2074.2 +015500 RL2074.2 +015600 01 TEST-RESULTS. RL2074.2 +015700 02 FILLER PIC X VALUE SPACE. RL2074.2 +015800 02 FEATURE PIC X(20) VALUE SPACE. RL2074.2 +015900 02 FILLER PIC X VALUE SPACE. RL2074.2 +016000 02 P-OR-F PIC X(5) VALUE SPACE. RL2074.2 +016100 02 FILLER PIC X VALUE SPACE. RL2074.2 +016200 02 PAR-NAME. RL2074.2 +016300 03 FILLER PIC X(19) VALUE SPACE. RL2074.2 +016400 03 PARDOT-X PIC X VALUE SPACE. RL2074.2 +016500 03 DOTVALUE PIC 99 VALUE ZERO. RL2074.2 +016600 02 FILLER PIC X(8) VALUE SPACE. RL2074.2 +016700 02 RE-MARK PIC X(61). RL2074.2 +016800 01 TEST-COMPUTED. RL2074.2 +016900 02 FILLER PIC X(30) VALUE SPACE. RL2074.2 +017000 02 FILLER PIC X(17) VALUE RL2074.2 +017100 " COMPUTED=". RL2074.2 +017200 02 COMPUTED-X. RL2074.2 +017300 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2074.2 +017400 03 COMPUTED-N REDEFINES COMPUTED-A RL2074.2 +017500 PIC -9(9).9(9). RL2074.2 +017600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2074.2 +017700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2074.2 +017800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2074.2 +017900 03 CM-18V0 REDEFINES COMPUTED-A. RL2074.2 +018000 04 COMPUTED-18V0 PIC -9(18). RL2074.2 +018100 04 FILLER PIC X. RL2074.2 +018200 03 FILLER PIC X(50) VALUE SPACE. RL2074.2 +018300 01 TEST-CORRECT. RL2074.2 +018400 02 FILLER PIC X(30) VALUE SPACE. RL2074.2 +018500 02 FILLER PIC X(17) VALUE " CORRECT =". RL2074.2 +018600 02 CORRECT-X. RL2074.2 +018700 03 CORRECT-A PIC X(20) VALUE SPACE. RL2074.2 +018800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2074.2 +018900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2074.2 +019000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2074.2 +019100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2074.2 +019200 03 CR-18V0 REDEFINES CORRECT-A. RL2074.2 +019300 04 CORRECT-18V0 PIC -9(18). RL2074.2 +019400 04 FILLER PIC X. RL2074.2 +019500 03 FILLER PIC X(2) VALUE SPACE. RL2074.2 +019600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2074.2 +019700 01 CCVS-C-1. RL2074.2 +019800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2074.2 +019900- "SS PARAGRAPH-NAME RL2074.2 +020000- " REMARKS". RL2074.2 +020100 02 FILLER PIC X(20) VALUE SPACE. RL2074.2 +020200 01 CCVS-C-2. RL2074.2 +020300 02 FILLER PIC X VALUE SPACE. RL2074.2 +020400 02 FILLER PIC X(6) VALUE "TESTED". RL2074.2 +020500 02 FILLER PIC X(15) VALUE SPACE. RL2074.2 +020600 02 FILLER PIC X(4) VALUE "FAIL". RL2074.2 +020700 02 FILLER PIC X(94) VALUE SPACE. RL2074.2 +020800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2074.2 +020900 01 REC-CT PIC 99 VALUE ZERO. RL2074.2 +021000 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2074.2 +021100 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2074.2 +021200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2074.2 +021300 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2074.2 +021400 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2074.2 +021500 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2074.2 +021600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2074.2 +021700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2074.2 +021800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2074.2 +021900 01 CCVS-H-1. RL2074.2 +022000 02 FILLER PIC X(39) VALUE SPACES. RL2074.2 +022100 02 FILLER PIC X(42) VALUE RL2074.2 +022200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2074.2 +022300 02 FILLER PIC X(39) VALUE SPACES. RL2074.2 +022400 01 CCVS-H-2A. RL2074.2 +022500 02 FILLER PIC X(40) VALUE SPACE. RL2074.2 +022600 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2074.2 +022700 02 FILLER PIC XXXX VALUE RL2074.2 +022800 "4.2 ". RL2074.2 +022900 02 FILLER PIC X(28) VALUE RL2074.2 +023000 " COPY - NOT FOR DISTRIBUTION". RL2074.2 +023100 02 FILLER PIC X(41) VALUE SPACE. RL2074.2 +023200 RL2074.2 +023300 01 CCVS-H-2B. RL2074.2 +023400 02 FILLER PIC X(15) VALUE RL2074.2 +023500 "TEST RESULT OF ". RL2074.2 +023600 02 TEST-ID PIC X(9). RL2074.2 +023700 02 FILLER PIC X(4) VALUE RL2074.2 +023800 " IN ". RL2074.2 +023900 02 FILLER PIC X(12) VALUE RL2074.2 +024000 " HIGH ". RL2074.2 +024100 02 FILLER PIC X(22) VALUE RL2074.2 +024200 " LEVEL VALIDATION FOR ". RL2074.2 +024300 02 FILLER PIC X(58) VALUE RL2074.2 +024400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2074.2 +024500 01 CCVS-H-3. RL2074.2 +024600 02 FILLER PIC X(34) VALUE RL2074.2 +024700 " FOR OFFICIAL USE ONLY ". RL2074.2 +024800 02 FILLER PIC X(58) VALUE RL2074.2 +024900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2074.2 +025000 02 FILLER PIC X(28) VALUE RL2074.2 +025100 " COPYRIGHT 1985 ". RL2074.2 +025200 01 CCVS-E-1. RL2074.2 +025300 02 FILLER PIC X(52) VALUE SPACE. RL2074.2 +025400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2074.2 +025500 02 ID-AGAIN PIC X(9). RL2074.2 +025600 02 FILLER PIC X(45) VALUE SPACES. RL2074.2 +025700 01 CCVS-E-2. RL2074.2 +025800 02 FILLER PIC X(31) VALUE SPACE. RL2074.2 +025900 02 FILLER PIC X(21) VALUE SPACE. RL2074.2 +026000 02 CCVS-E-2-2. RL2074.2 +026100 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2074.2 +026200 03 FILLER PIC X VALUE SPACE. RL2074.2 +026300 03 ENDER-DESC PIC X(44) VALUE RL2074.2 +026400 "ERRORS ENCOUNTERED". RL2074.2 +026500 01 CCVS-E-3. RL2074.2 +026600 02 FILLER PIC X(22) VALUE RL2074.2 +026700 " FOR OFFICIAL USE ONLY". RL2074.2 +026800 02 FILLER PIC X(12) VALUE SPACE. RL2074.2 +026900 02 FILLER PIC X(58) VALUE RL2074.2 +027000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2074.2 +027100 02 FILLER PIC X(13) VALUE SPACE. RL2074.2 +027200 02 FILLER PIC X(15) VALUE RL2074.2 +027300 " COPYRIGHT 1985". RL2074.2 +027400 01 CCVS-E-4. RL2074.2 +027500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2074.2 +027600 02 FILLER PIC X(4) VALUE " OF ". RL2074.2 +027700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2074.2 +027800 02 FILLER PIC X(40) VALUE RL2074.2 +027900 " TESTS WERE EXECUTED SUCCESSFULLY". RL2074.2 +028000 01 XXINFO. RL2074.2 +028100 02 FILLER PIC X(19) VALUE RL2074.2 +028200 "*** INFORMATION ***". RL2074.2 +028300 02 INFO-TEXT. RL2074.2 +028400 04 FILLER PIC X(8) VALUE SPACE. RL2074.2 +028500 04 XXCOMPUTED PIC X(20). RL2074.2 +028600 04 FILLER PIC X(5) VALUE SPACE. RL2074.2 +028700 04 XXCORRECT PIC X(20). RL2074.2 +028800 02 INF-ANSI-REFERENCE PIC X(48). RL2074.2 +028900 01 HYPHEN-LINE. RL2074.2 +029000 02 FILLER PIC IS X VALUE IS SPACE. RL2074.2 +029100 02 FILLER PIC IS X(65) VALUE IS "************************RL2074.2 +029200- "*****************************************". RL2074.2 +029300 02 FILLER PIC IS X(54) VALUE IS "************************RL2074.2 +029400- "******************************". RL2074.2 +029500 01 CCVS-PGM-ID PIC X(9) VALUE RL2074.2 +029600 "RL207A". RL2074.2 +029700 PROCEDURE DIVISION. RL2074.2 +029800 CCVS1 SECTION. RL2074.2 +029900 OPEN-FILES. RL2074.2 +030000 OPEN OUTPUT PRINT-FILE. RL2074.2 +030100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2074.2 +030200 MOVE SPACE TO TEST-RESULTS. RL2074.2 +030300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2074.2 +030400 MOVE ZERO TO REC-SKL-SUB. RL2074.2 +030500 PERFORM CCVS-INIT-FILE 9 TIMES. RL2074.2 +030600 CCVS-INIT-FILE. RL2074.2 +030700 ADD 1 TO REC-SKL-SUB. RL2074.2 +030800 MOVE FILE-RECORD-INFO-SKELETON RL2074.2 +030900 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2074.2 +031000 CCVS-INIT-EXIT. RL2074.2 +031100 GO TO CCVS1-EXIT. RL2074.2 +031200 CLOSE-FILES. RL2074.2 +031300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2074.2 +031400 TERMINATE-CCVS. RL2074.2 +031500*S EXIT PROGRAM. RL2074.2 +031600*SERMINATE-CALL. RL2074.2 +031700 STOP RUN. RL2074.2 +031800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2074.2 +031900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2074.2 +032000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2074.2 +032100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2074.2 +032200 MOVE "****TEST DELETED****" TO RE-MARK. RL2074.2 +032300 PRINT-DETAIL. RL2074.2 +032400 IF REC-CT NOT EQUAL TO ZERO RL2074.2 +032500 MOVE "." TO PARDOT-X RL2074.2 +032600 MOVE REC-CT TO DOTVALUE. RL2074.2 +032700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2074.2 +032800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2074.2 +032900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2074.2 +033000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2074.2 +033100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2074.2 +033200 MOVE SPACE TO CORRECT-X. RL2074.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2074.2 +033400 MOVE SPACE TO RE-MARK. RL2074.2 +033500 HEAD-ROUTINE. RL2074.2 +033600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +033700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +033800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2074.2 +033900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2074.2 +034000 COLUMN-NAMES-ROUTINE. RL2074.2 +034100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +034200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +034400 END-ROUTINE. RL2074.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2074.2 +034600 END-RTN-EXIT. RL2074.2 +034700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +034800 END-ROUTINE-1. RL2074.2 +034900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2074.2 +035000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2074.2 +035100 ADD PASS-COUNTER TO ERROR-HOLD. RL2074.2 +035200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2074.2 +035300 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2074.2 +035400 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2074.2 +035500 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2074.2 +035600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2074.2 +035700 END-ROUTINE-12. RL2074.2 +035800 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2074.2 +035900 IF ERROR-COUNTER IS EQUAL TO ZERO RL2074.2 +036000 MOVE "NO " TO ERROR-TOTAL RL2074.2 +036100 ELSE RL2074.2 +036200 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2074.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2074.2 +036400 PERFORM WRITE-LINE. RL2074.2 +036500 END-ROUTINE-13. RL2074.2 +036600 IF DELETE-COUNTER IS EQUAL TO ZERO RL2074.2 +036700 MOVE "NO " TO ERROR-TOTAL ELSE RL2074.2 +036800 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2074.2 +036900 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2074.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +037100 IF INSPECT-COUNTER EQUAL TO ZERO RL2074.2 +037200 MOVE "NO " TO ERROR-TOTAL RL2074.2 +037300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2074.2 +037400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2074.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +037600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2074.2 +037700 WRITE-LINE. RL2074.2 +037800 ADD 1 TO RECORD-COUNT. RL2074.2 +037900 IF RECORD-COUNT GREATER 50 RL2074.2 +038000 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2074.2 +038100 MOVE SPACE TO DUMMY-RECORD RL2074.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2074.2 +038300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2074.2 +038400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2074.2 +038500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2074.2 +038600 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2074.2 +038700 MOVE ZERO TO RECORD-COUNT. RL2074.2 +038800 PERFORM WRT-LN. RL2074.2 +038900 WRT-LN. RL2074.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2074.2 +039100 MOVE SPACE TO DUMMY-RECORD. RL2074.2 +039200 BLANK-LINE-PRINT. RL2074.2 +039300 PERFORM WRT-LN. RL2074.2 +039400 FAIL-ROUTINE. RL2074.2 +039500 IF COMPUTED-X NOT EQUAL TO SPACE RL2074.2 +039600 GO TO FAIL-ROUTINE-WRITE. RL2074.2 +039700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2074.2 +039800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2074.2 +039900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2074.2 +040000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +040100 MOVE SPACES TO INF-ANSI-REFERENCE. RL2074.2 +040200 GO TO FAIL-ROUTINE-EX. RL2074.2 +040300 FAIL-ROUTINE-WRITE. RL2074.2 +040400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2074.2 +040500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2074.2 +040600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2074.2 +040700 MOVE SPACES TO COR-ANSI-REFERENCE. RL2074.2 +040800 FAIL-ROUTINE-EX. EXIT. RL2074.2 +040900 BAIL-OUT. RL2074.2 +041000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2074.2 +041100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2074.2 +041200 BAIL-OUT-WRITE. RL2074.2 +041300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2074.2 +041400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2074.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2074.2 +041600 MOVE SPACES TO INF-ANSI-REFERENCE. RL2074.2 +041700 BAIL-OUT-EX. EXIT. RL2074.2 +041800 CCVS1-EXIT. RL2074.2 +041900 EXIT. RL2074.2 +042000 SECT-RL207A-001 SECTION. RL2074.2 +042100 REL-INIT-003. RL2074.2 +042200 MOVE "VIII-26 4.5.4" TO ANSI-REFERENCE. RL2074.2 +042300 OPEN INPUT RL-FD1. RL2074.2 +042400 MOVE "REL-TEST-003" TO PAR-NAME. RL2074.2 +042500 MOVE ZERO TO RL-FD1-KEY. RL2074.2 +042600 MOVE ZERO TO WRK-CS-09V00-002. RL2074.2 +042700 MOVE ZERO TO WRK-CS-09V00-003. RL2074.2 +042800* RL2074.2 +042900 MOVE 01 TO REC-CT. RL2074.2 +043000 MOVE "READ RANDOM" TO FEATURE. RL2074.2 +043100 REL-TEST-003-R. RL2074.2 +043200 ADD 1 TO WRK-CS-09V00-003. RL2074.2 +043300 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +043400 IF RL-FD1-KEY GREATER +501 RL2074.2 +043500 MOVE "INVALID KEY NOT TAKEN" TO COMPUTED-A RL2074.2 +043600 MOVE RL-FD1-KEY TO CORRECT-18V0 RL2074.2 +043700 PERFORM FAIL RL2074.2 +043800 PERFORM PRINT-DETAIL RL2074.2 +043900 ADD 1 TO REC-CT RL2074.2 +044000 GO TO REL-WRITE-003. RL2074.2 +044100 READ RL-FD1 RL2074.2 +044200 INVALID KEY GO TO REL-WRITE-003. RL2074.2 +044300 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +044400 IF XRECORD-NUMBER (1) EQUAL TO RL-FD1-KEY RL2074.2 +044500 GO TO REL-TEST-003-R. RL2074.2 +044600 MOVE "YES" TO I-O-ERROR-RL-FD1. RL2074.2 +044700 ADD 1 TO WRK-CS-09V00-002. RL2074.2 +044800 GO TO REL-TEST-003-R. RL2074.2 +044900 REL-WRITE-003. RL2074.2 +045000 IF RL-FD1-KEY NOT EQUAL TO 501 RL2074.2 +045100 MOVE "WRONG KEY/NOT 500" TO CORRECT-A RL2074.2 +045200 MOVE RL-FD1-KEY TO COMPUTED-18V0 RL2074.2 +045300 PERFORM FAIL RL2074.2 +045400 ELSE RL2074.2 +045500 PERFORM PASS. RL2074.2 +045600 PERFORM PRINT-DETAIL. RL2074.2 +045700* RL2074.2 +045800*01 RL2074.2 +045900* RL2074.2 +046000 ADD 1 TO REC-CT. RL2074.2 +046100 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2074.2 +046200 MOVE "WRONG RECORD/NOT 500" TO CORRECT-A RL2074.2 +046300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 RL2074.2 +046400 PERFORM FAIL RL2074.2 +046500 ELSE RL2074.2 +046600 PERFORM PASS. RL2074.2 +046700 PERFORM PRINT-DETAIL. RL2074.2 +046800* RL2074.2 +046900*02 RL2074.2 +047000* RL2074.2 +047100 ADD 1 TO REC-CT. RL2074.2 +047200 IF WRK-CS-09V00-003 NOT EQUAL TO 501 RL2074.2 +047300 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2074.2 +047400 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL2074.2 +047500 MOVE 501 TO CORRECT-18V0 RL2074.2 +047600 PERFORM FAIL RL2074.2 +047700 ELSE RL2074.2 +047800 PERFORM PASS. RL2074.2 +047900 PERFORM PRINT-DETAIL. RL2074.2 +048000* RL2074.2 +048100*03 RL2074.2 +048200* RL2074.2 +048300 ADD 1 TO REC-CT. RL2074.2 +048400 IF I-O-ERROR-RL-FD1 EQUAL TO "YES" RL2074.2 +048500 MOVE WRK-CS-09V00-002 TO COMPUTED-18V0 RL2074.2 +048600 MOVE "RECORDS DID NOT COMPARE" TO RE-MARK RL2074.2 +048700 PERFORM FAIL RL2074.2 +048800 ELSE RL2074.2 +048900 PERFORM PASS. RL2074.2 +049000 PERFORM PRINT-DETAIL. RL2074.2 +049100* RL2074.2 +049200*04 RL2074.2 +049300* RL2074.2 +049400 ADD 1 TO REC-CT. RL2074.2 +049500 CLOSE RL-FD1. RL2074.2 +049600 REL-INIT-004-R . RL2074.2 +049700 MOVE "REL-TEST-004" TO PAR-NAME. RL2074.2 +049800 OPEN I-O RL-FD1. RL2074.2 +049900 MOVE ZERO TO RL-FD1-KEY. RL2074.2 +050000 MOVE ZERO TO WRK-CS-09V00-002. RL2074.2 +050100 MOVE ZERO TO WRK-CS-09V00-003. RL2074.2 +050200 MOVE ZERO TO WRK-CS-09V00-004. RL2074.2 +050300 MOVE ZERO TO WRK-CS-09V00-005. RL2074.2 +050400* RL2074.2 +050500 MOVE 01 TO REC-CT. RL2074.2 +050600 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +050700 MOVE "REWRITE" TO FEATURE. RL2074.2 +050800 REL-TEST-004-R. RL2074.2 +050900 ADD 5 TO WRK-CS-09V00-003. RL2074.2 +051000 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +051100 IF RL-FD1-KEY GREATER 505 RL2074.2 +051200 MOVE "INVALID KEY/NOT TAKEN" TO COMPUTED-A RL2074.2 +051300 MOVE RL-FD1-KEY TO CORRECT-18V0 RL2074.2 +051400 PERFORM FAIL RL2074.2 +051500 PERFORM PRINT-DETAIL RL2074.2 +051600 ADD 1 TO REC-CT RL2074.2 +051700 GO TO REL-TEST-004-3. RL2074.2 +051800 READ RL-FD1 RL2074.2 +051900 INVALID KEY GO TO REL-TEST-004-1. RL2074.2 +052000 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1) RL2074.2 +052100 ADD 01 TO UPDATE-NUMBER (1). RL2074.2 +052200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2074.2 +052300 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-140. RL2074.2 +052400 REWRITE RL-FD1R1-F-G-140 RL2074.2 +052500 INVALID KEY GO TO REL-TEST-004-2. RL2074.2 +052600 GO TO REL-TEST-004-R. RL2074.2 +052700 REL-TEST-004-1. RL2074.2 +052800 IF RL-FD1-KEY LESS THAN 501 RL2074.2 +052900 ADD 1 TO WRK-CS-09V00-004 RL2074.2 +053000 GO TO REL-TEST-004-R. RL2074.2 +053100 PERFORM PASS. RL2074.2 +053200 PERFORM PRINT-DETAIL. RL2074.2 +053300* RL2074.2 +053400*01 RL2074.2 +053500* RL2074.2 +053600 ADD 1 TO REC-CT. RL2074.2 +053700 GO TO REL-TEST-004-3. RL2074.2 +053800 REL-TEST-004-2. RL2074.2 +053900 ADD 1 TO WRK-CS-09V00-005. RL2074.2 +054000 IF RL-FD1-KEY LESS 501 RL2074.2 +054100 GO TO REL-TEST-004-R. RL2074.2 +054200 REL-TEST-004-3. RL2074.2 +054300 IF WRK-CS-09V00-004 NOT EQUAL TO ZERO RL2074.2 +054400 MOVE "INVALID KEY ON READ" TO COMPUTED-A RL2074.2 +054500 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL2074.2 +054600 PERFORM FAIL RL2074.2 +054700 ELSE RL2074.2 +054800 PERFORM PASS. RL2074.2 +054900 PERFORM PRINT-DETAIL. RL2074.2 +055000* RL2074.2 +055100*02 RL2074.2 +055200* RL2074.2 +055300 ADD 1 TO REC-CT. RL2074.2 +055400 IF WRK-CS-09V00-005 NOT EQUAL TO ZERO RL2074.2 +055500 MOVE "INVALID KEY ON REWRITE" TO COMPUTED-A RL2074.2 +055600 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL2074.2 +055700 PERFORM FAIL RL2074.2 +055800 ELSE RL2074.2 +055900 PERFORM PASS. RL2074.2 +056000 PERFORM PRINT-DETAIL. RL2074.2 +056100* RL2074.2 +056200*03 RL2074.2 +056300* RL2074.2 +056400 ADD 1 TO REC-CT. RL2074.2 +056500 CLOSE RL-FD1. RL2074.2 +056600 REL-INIT-005. RL2074.2 +056700 MOVE "REL-TEST-005" TO PAR-NAME. RL2074.2 +056800 OPEN INPUT RL-FD1. RL2074.2 +056900 MOVE 501 TO WRK-CS-09V00-003. RL2074.2 +057000 MOVE ZERO TO WRK-CS-09V00-004. RL2074.2 +057100 MOVE ZERO TO WRK-CS-09V00-005. RL2074.2 +057200 MOVE ZERO TO WRK-CS-09V00-002. RL2074.2 +057300 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +057400 MOVE 01 TO REC-CT. RL2074.2 +057500* RL2074.2 +057600 MOVE "READ RANDOM" TO FEATURE. RL2074.2 +057700 REL-TEST-005-R. RL2074.2 +057800 SUBTRACT 1 FROM WRK-CS-09V00-003. RL2074.2 +057900 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +058000 IF WRK-CS-09V00-003 LESS THAN ZERO RL2074.2 +058100 MOVE "INVALID KEY/NOT TAKEN" TO RE-MARK RL2074.2 +058200 MOVE WRK-CS-09V00-003 TO COMPUTED-18V0 RL2074.2 +058300 MOVE ZERO TO CORRECT-18V0 RL2074.2 +058400 PERFORM FAIL RL2074.2 +058500 PERFORM PRINT-DETAIL RL2074.2 +058600 ADD 1 TO REC-CT RL2074.2 +058700 GO TO REL-TEST-005-3. RL2074.2 +058800 READ RL-FD1 RL2074.2 +058900 INVALID KEY GO TO REL-TEST-005-1. RL2074.2 +059000 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +059100 IF UPDATE-NUMBER (1) EQUAL TO 00 RL2074.2 +059200 ADD 1 TO WRK-CS-09V00-004. RL2074.2 +059300 IF UPDATE-NUMBER (1) EQUAL TO 01 RL2074.2 +059400 ADD 1 TO WRK-CS-09V00-005. RL2074.2 +059500 GO TO REL-TEST-005-R. RL2074.2 +059600 REL-TEST-005-1. RL2074.2 +059700 IF RL-FD1-KEY GREATER ZERO RL2074.2 +059800 ADD 1 TO WRK-CS-09V00-002 RL2074.2 +059900 GO TO REL-TEST-005-R. RL2074.2 +060000 PERFORM PASS. RL2074.2 +060100 PERFORM PRINT-DETAIL. RL2074.2 +060200 ADD 1 TO REC-CT. RL2074.2 +060300*01 RL2074.2 +060400 GO TO REL-TEST-005-3. RL2074.2 +060500 REL-TEST-005-3. RL2074.2 +060600 IF WRK-CS-09V00-004 NOT EQUAL TO 400 RL2074.2 +060700 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL2074.2 +060800 MOVE WRK-CS-09V00-004 TO CORRECT-18V0 RL2074.2 +060900 MOVE "SHOULD BE 400" TO RE-MARK RL2074.2 +061000 PERFORM FAIL RL2074.2 +061100 ELSE RL2074.2 +061200 PERFORM PASS. RL2074.2 +061300 PERFORM PRINT-DETAIL. RL2074.2 +061400* RL2074.2 +061500* RL2074.2 +061600*02 RL2074.2 +061700* RL2074.2 +061800 ADD 1 TO REC-CT. RL2074.2 +061900 IF WRK-CS-09V00-005 NOT EQUAL TO 100 RL2074.2 +062000 MOVE "UPDATED RECORDS" TO COMPUTED-A RL2074.2 +062100 MOVE WRK-CS-09V00-005 TO CORRECT-18V0 RL2074.2 +062200 MOVE "SHOULD BE 100" TO RE-MARK RL2074.2 +062300 PERFORM FAIL RL2074.2 +062400 ELSE RL2074.2 +062500 PERFORM PASS. RL2074.2 +062600 PERFORM PRINT-DETAIL. RL2074.2 +062700* RL2074.2 +062800*03 RL2074.2 +062900* RL2074.2 +063000 ADD 1 TO REC-CT. RL2074.2 +063100 IF WRK-CS-09V00-002 GREATER 1 RL2074.2 +063200 MOVE WRK-CS-09V00-002 TO COMPUTED-N RL2074.2 +063300 MOVE "INVALID KEY/READS" TO CORRECT-A RL2074.2 +063400 PERFORM FAIL RL2074.2 +063500 ELSE RL2074.2 +063600 PERFORM PASS. RL2074.2 +063700 PERFORM PRINT-DETAIL. RL2074.2 +063800* RL2074.2 +063900*04 RL2074.2 +064000* RL2074.2 +064100 ADD 1 TO REC-CT. RL2074.2 +064200 CLOSE RL-FD1. RL2074.2 +064300 REL-INIT-006. RL2074.2 +064400 MOVE "REL-TEST-006" TO PAR-NAME. RL2074.2 +064500 OPEN I-O RL-FD1. RL2074.2 +064600 MOVE "VAR. SIZE REC UPDATE" TO FEATURE. RL2074.2 +064700 MOVE 1 TO WRK-CS-09V00-003. RL2074.2 +064800 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +064900 READ RL-FD1 RL2074.2 +065000 INVALID KEY MOVE "REL-INIT-006 READ1" TO PAR-NAME RL2074.2 +065100 MOVE "INVALID KEY ON 1ST RECORD READ" RL2074.2 +065200 TO RE-MARK RL2074.2 +065300 PERFORM FAIL RL2074.2 +065400 PERFORM PRINT-DETAIL RL2074.2 +065500 GO TO REL-INIT-007. RL2074.2 +065600 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +065700 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +065800 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-140. RL2074.2 +065900 MOVE 120 TO WRK-SIZE. RL2074.2 +066000 REWRITE RL-FD1R1-F-G-140 RL2074.2 +066100 INVALID KEY MOVE "REL-INIT-006 REWRITE" TO PAR-NAME RL2074.2 +066200 MOVE "INVALID KEY ON 1ST RECORD REWRITE" RL2074.2 +066300 TO RE-MARK RL2074.2 +066400 PERFORM FAIL RL2074.2 +066500 PERFORM PRINT-DETAIL RL2074.2 +066600 GO TO REL-INIT-007. RL2074.2 +066700 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +066800 READ RL-FD1 RL2074.2 +066900 INVALID KEY MOVE "REL-INIT-006 READ2" TO PAR-NAME RL2074.2 +067000 MOVE "INVALID KEY ON 1ST RECORD READ" RL2074.2 +067100 TO RE-MARK RL2074.2 +067200 PERFORM FAIL RL2074.2 +067300 PERFORM PRINT-DETAIL RL2074.2 +067400 GO TO REL-INIT-007. RL2074.2 +067500 REL-TEST-006. RL2074.2 +067600 MOVE "REL-TEST-006" TO PAR-NAME. RL2074.2 +067700 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +067800 IF UPDATE-NUMBER (1) = 98 RL2074.2 +067900 PERFORM PASS RL2074.2 +068000 PERFORM PRINT-DETAIL RL2074.2 +068100 ELSE RL2074.2 +068200 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +068300 TO RE-MARK RL2074.2 +068400 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +068500 MOVE 98 TO CORRECT-N RL2074.2 +068600 PERFORM FAIL RL2074.2 +068700 PERFORM PRINT-DETAIL. RL2074.2 +068800* RL2074.2 +068900 REL-INIT-007. RL2074.2 +069000 MOVE "REL-TEST-007" TO PAR-NAME. RL2074.2 +069100 MOVE 11 TO WRK-CS-09V00-003. RL2074.2 +069200 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +069300 READ RL-FD1 RL2074.2 +069400 INVALID KEY MOVE "REL-INIT-007 READ1" TO PAR-NAME RL2074.2 +069500 MOVE "INVALID KEY ON 11TH RECORD READ" RL2074.2 +069600 TO RE-MARK RL2074.2 +069700 PERFORM FAIL RL2074.2 +069800 PERFORM PRINT-DETAIL RL2074.2 +069900 GO TO REL-INIT-008. RL2074.2 +070000 MOVE RL-FD1R1-F-G-140 TO NEW-130-CHAR-AREA. RL2074.2 +070100 MOVE NEW-130-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +070200 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +070300 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-130-120. RL2074.2 +070400 MOVE NEW-130-CHAR-AREA TO RL-FD1R1-F-G-140. RL2074.2 +070500 MOVE 130 TO WRK-SIZE. RL2074.2 +070600 REWRITE RL-FD1R1-F-G-140 RL2074.2 +070700 INVALID KEY MOVE "REL-INIT-007 REWRITE" TO PAR-NAME RL2074.2 +070800 MOVE "INVALID KEY ON 11TH RECORD REWRITE"RL2074.2 +070900 TO RE-MARK RL2074.2 +071000 PERFORM FAIL RL2074.2 +071100 PERFORM PRINT-DETAIL RL2074.2 +071200 GO TO REL-INIT-008. RL2074.2 +071300 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +071400 READ RL-FD1 RL2074.2 +071500 INVALID KEY MOVE "REL-INIT-007 READ2" TO PAR-NAME RL2074.2 +071600 MOVE "INVALID KEY ON 11TH RECORD READ" RL2074.2 +071700 TO RE-MARK RL2074.2 +071800 PERFORM FAIL RL2074.2 +071900 PERFORM PRINT-DETAIL RL2074.2 +072000 GO TO REL-INIT-008. RL2074.2 +072100 REL-TEST-007. RL2074.2 +072200 MOVE "REL-TEST-007" TO PAR-NAME. RL2074.2 +072300 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +072400 IF UPDATE-NUMBER (1) = 98 RL2074.2 +072500 PERFORM PASS RL2074.2 +072600 PERFORM PRINT-DETAIL RL2074.2 +072700 ELSE RL2074.2 +072800 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +072900 TO RE-MARK RL2074.2 +073000 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +073100 MOVE 98 TO CORRECT-N RL2074.2 +073200 PERFORM FAIL RL2074.2 +073300 PERFORM PRINT-DETAIL. RL2074.2 +073400* RL2074.2 +073500 REL-INIT-008. RL2074.2 +073600 MOVE "REL-TEST-008" TO PAR-NAME. RL2074.2 +073700 MOVE 21 TO WRK-CS-09V00-003. RL2074.2 +073800 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +073900 READ RL-FD1 RL2074.2 +074000 INVALID KEY MOVE "REL-INIT-008 READ1" TO PAR-NAME RL2074.2 +074100 MOVE "INVALID KEY ON 21ST RECORD READ" RL2074.2 +074200 TO RE-MARK RL2074.2 +074300 PERFORM FAIL RL2074.2 +074400 PERFORM PRINT-DETAIL RL2074.2 +074500 GO TO REL-INIT-009. RL2074.2 +074600 MOVE RL-FD1R1-F-G-140 TO NEW-140-CHAR-AREA. RL2074.2 +074700 MOVE NEW-140-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +074800 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +074900 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-140-120. RL2074.2 +075000 MOVE NEW-140-CHAR-AREA TO RL-FD1R1-F-G-140. RL2074.2 +075100 MOVE 140 TO WRK-SIZE. RL2074.2 +075200 REWRITE RL-FD1R1-F-G-140 RL2074.2 +075300 INVALID KEY MOVE "REL-INIT-008 REWRITE" TO PAR-NAME RL2074.2 +075400 MOVE "INVALID KEY ON 21ST RECORD REWRITE"RL2074.2 +075500 TO RE-MARK RL2074.2 +075600 PERFORM FAIL RL2074.2 +075700 PERFORM PRINT-DETAIL RL2074.2 +075800 GO TO REL-INIT-009. RL2074.2 +075900 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +076000 READ RL-FD1 RL2074.2 +076100 INVALID KEY MOVE "REL-INIT-008 READ2" TO PAR-NAME RL2074.2 +076200 MOVE "INVALID KEY ON 21ST RECORD READ" RL2074.2 +076300 TO RE-MARK RL2074.2 +076400 PERFORM FAIL RL2074.2 +076500 PERFORM PRINT-DETAIL RL2074.2 +076600 GO TO REL-INIT-009. RL2074.2 +076700 REL-TEST-008. RL2074.2 +076800 MOVE "REL-TEST-008" TO PAR-NAME. RL2074.2 +076900 MOVE RL-FD1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +077000 IF UPDATE-NUMBER (1) = 98 RL2074.2 +077100 PERFORM PASS RL2074.2 +077200 PERFORM PRINT-DETAIL RL2074.2 +077300 ELSE RL2074.2 +077400 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +077500 TO RE-MARK RL2074.2 +077600 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +077700 MOVE 98 TO CORRECT-N RL2074.2 +077800 PERFORM FAIL RL2074.2 +077900 PERFORM PRINT-DETAIL. RL2074.2 +078000* RL2074.2 +078100 REL-INIT-009. RL2074.2 +078200 MOVE "REL-TEST-009" TO PAR-NAME. RL2074.2 +078300 MOVE 31 TO WRK-CS-09V00-003. RL2074.2 +078400 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +078500 READ RL-FD1 RL2074.2 +078600 INVALID KEY MOVE "REL-INIT-009 READ1" TO PAR-NAME RL2074.2 +078700 MOVE "INVALID KEY ON 31ST RECORD READ" RL2074.2 +078800 TO RE-MARK RL2074.2 +078900 PERFORM FAIL RL2074.2 +079000 PERFORM PRINT-DETAIL RL2074.2 +079100 GO TO REL-INIT-010. RL2074.2 +079200 MOVE RL-FD1R1-F-G-140 TO NEW-125-CHAR-AREA. RL2074.2 +079300 MOVE NEW-125-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +079400 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +079500 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-128-120. RL2074.2 +079600 MOVE "ABCDEFGH" TO EXTRA-8-CHARS. RL2074.2 +079700 MOVE NEW-128-CHAR-AREA TO RL-FD1R1-F-G-140. RL2074.2 +079800 MOVE 128 TO WRK-SIZE. RL2074.2 +079900 REL-TEST-009-1. RL2074.2 +080000 MOVE "REL-TEST-009-1" TO PAR-NAME. RL2074.2 +080100 REWRITE RL-FD1R1-F-G-140 RL2074.2 +080200 INVALID KEY MOVE "INVALID KEY - 31ST RECORD REWRITE" RL2074.2 +080300 TO RE-MARK RL2074.2 +080400 PERFORM FAIL RL2074.2 +080500 PERFORM PRINT-DETAIL RL2074.2 +080600 GO TO REL-INIT-010. RL2074.2 +080700 PERFORM PASS. RL2074.2 +080800 PERFORM PRINT-DETAIL. RL2074.2 +080900 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +081000 READ RL-FD1 RL2074.2 +081100 INVALID KEY MOVE "REL-INIT-009 READ2" TO PAR-NAME RL2074.2 +081200 MOVE "INVALID KEY ON 31ST RECORD READ" RL2074.2 +081300 TO RE-MARK RL2074.2 +081400 PERFORM FAIL RL2074.2 +081500 PERFORM PRINT-DETAIL RL2074.2 +081600 GO TO REL-INIT-010. RL2074.2 +081700 REL-TEST-009-2. RL2074.2 +081800 MOVE "REL-TEST-009-2" TO PAR-NAME. RL2074.2 +081900 MOVE RL-FD1R1-F-G-140 TO NEW-128-CHAR-AREA. RL2074.2 +082000 MOVE NEW-128-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +082100 IF UPDATE-NUMBER (1) = 98 RL2074.2 +082200 PERFORM PASS RL2074.2 +082300 PERFORM PRINT-DETAIL RL2074.2 +082400 ELSE RL2074.2 +082500 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +082600 TO RE-MARK RL2074.2 +082700 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +082800 MOVE 98 TO CORRECT-N RL2074.2 +082900 PERFORM FAIL RL2074.2 +083000 PERFORM PRINT-DETAIL. RL2074.2 +083100 REL-TEST-009-3. RL2074.2 +083200 MOVE "REL-TEST-009-3" TO PAR-NAME. RL2074.2 +083300 IF EXTRA-8-CHARS = "ABCDEFGH" RL2074.2 +083400 PERFORM PASS RL2074.2 +083500 PERFORM PRINT-DETAIL RL2074.2 +083600 ELSE RL2074.2 +083700 MOVE "INVALID UPDATE OF DIFFERENT LENGTH. RECS" RL2074.2 +083800 TO RE-MARK RL2074.2 +083900 MOVE "ABCDEFGH" TO CORRECT-X RL2074.2 +084000 MOVE EXTRA-8-CHARS TO COMPUTED-X RL2074.2 +084100 PERFORM FAIL RL2074.2 +084200 PERFORM PRINT-DETAIL. RL2074.2 +084300* RL2074.2 +084400 REL-INIT-010. RL2074.2 +084500 MOVE "REL-TEST-010" TO PAR-NAME. RL2074.2 +084600 MOVE 32 TO WRK-CS-09V00-003. RL2074.2 +084700 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +084800 READ RL-FD1 RL2074.2 +084900 INVALID KEY MOVE "REL-INIT-010 READ1" TO PAR-NAME RL2074.2 +085000 MOVE "INVALID KEY ON 32ND RECORD READ" RL2074.2 +085100 TO RE-MARK RL2074.2 +085200 PERFORM FAIL RL2074.2 +085300 PERFORM PRINT-DETAIL RL2074.2 +085400 GO TO REL-INIT-011. RL2074.2 +085500 MOVE RL-FD1R1-F-G-140 TO NEW-135-CHAR-AREA. RL2074.2 +085600 MOVE NEW-135-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +085700 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +085800 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-132-120. RL2074.2 +085900 MOVE "ABCDEFGHIJKL" TO EXTRA-12-CHARS. RL2074.2 +086000 MOVE NEW-132-CHAR-AREA TO RL-FD1R1-F-G-140. RL2074.2 +086100 MOVE 132 TO WRK-SIZE. RL2074.2 +086200 REL-TEST-010-1. RL2074.2 +086300 MOVE "REL-TEST-010-1" TO PAR-NAME. RL2074.2 +086400 REWRITE RL-FD1R1-F-G-140 RL2074.2 +086500 INVALID KEY MOVE "INVALID KEY - 32ND RECORD REWRITE" RL2074.2 +086600 TO RE-MARK RL2074.2 +086700 PERFORM FAIL RL2074.2 +086800 PERFORM PRINT-DETAIL RL2074.2 +086900 GO TO REL-INIT-011. RL2074.2 +087000 PERFORM PASS. RL2074.2 +087100 PERFORM PRINT-DETAIL. RL2074.2 +087200 MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +087300 READ RL-FD1 RL2074.2 +087400 INVALID KEY RL2074.2 +087500 MOVE "INVALID KEY ON 32ND RECORD READ" RL2074.2 +087600 TO RE-MARK RL2074.2 +087700 PERFORM FAIL RL2074.2 +087800 PERFORM PRINT-DETAIL RL2074.2 +087900 GO TO REL-INIT-011. RL2074.2 +088000 REL-TEST-010-2. RL2074.2 +088100 MOVE "REL-TEST-010-2" TO PAR-NAME. RL2074.2 +088200 MOVE RL-FD1R1-F-G-140 TO NEW-132-CHAR-AREA. RL2074.2 +088300 MOVE NEW-132-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +088400 IF UPDATE-NUMBER (1) = 98 RL2074.2 +088500 PERFORM PASS RL2074.2 +088600 PERFORM PRINT-DETAIL RL2074.2 +088700 ELSE RL2074.2 +088800 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +088900 TO RE-MARK RL2074.2 +089000 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +089100 MOVE 98 TO CORRECT-N RL2074.2 +089200 PERFORM FAIL RL2074.2 +089300 PERFORM PRINT-DETAIL. RL2074.2 +089400 REL-TEST-010-3. RL2074.2 +089500 MOVE "REL-TEST-010-3" TO PAR-NAME. RL2074.2 +089600 IF EXTRA-12-CHARS = "ABCDEFGHIJKL" RL2074.2 +089700 PERFORM PASS RL2074.2 +089800 PERFORM PRINT-DETAIL RL2074.2 +089900 ELSE RL2074.2 +090000 MOVE "INVALID UPDATE OF DIFFERENT LENGTH. RECS" RL2074.2 +090100 TO RE-MARK RL2074.2 +090200 MOVE "ABCDEFGHIJKL" TO CORRECT-X RL2074.2 +090300 MOVE EXTRA-12-CHARS TO COMPUTED-X RL2074.2 +090400 PERFORM FAIL RL2074.2 +090500 PERFORM PRINT-DETAIL. RL2074.2 +090600* RL2074.2 +090700 REL-INIT-011. RL2074.2 +090800 MOVE "REL-TEST-011" TO PAR-NAME. RL2074.2 +090900 MOVE 33 TO WRK-CS-09V00-003. RL2074.2 +091000 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +091100 READ RL-FD1 RL2074.2 +091200 INVALID KEY MOVE "REL-INIT-011 READ1" TO PAR-NAME RL2074.2 +091300 MOVE "INVALID KEY ON 33RD RECORD READ" RL2074.2 +091400 TO RE-MARK RL2074.2 +091500 PERFORM FAIL RL2074.2 +091600 PERFORM PRINT-DETAIL RL2074.2 +091700 GO TO REL-INIT-012. RL2074.2 +091800 MOVE RL-FD1R1-F-G-140 TO NEW-145-CHAR-AREA. RL2074.2 +091900 MOVE NEW-145-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +092000 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +092100 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-145-120. RL2074.2 +092200 MOVE "ABCDEFGHIJKLMNOPQRSTUVWXY" TO EXTRA-25-CHARS. RL2074.2 +092300 MOVE 145 TO WRK-SIZE. RL2074.2 +092400 REL-TEST-011-1. RL2074.2 +092500 MOVE "REL-TEST-011-1" TO PAR-NAME. RL2074.2 +092600* REWRITE RL-FD1R1-F-G-140 FROM NEW-145-CHAR-AREA RL2074.2 +092700* INVALID GO TO REL-TEST-011-1-A. RL2074.2 +092800*REL-TEST-011-1-A. RL2074.2 +092900* IF WS-STATUS = "44" RL2074.2 +093000* PERFORM PASS RL2074.2 +093100* PERFORM PRINT-DETAIL RL2074.2 +093200* ELSE RL2074.2 +093300* MOVE "INCORRECT FILE STATUS HAS OCCURED" RL2074.2 +093400* TO RE-MARK RL2074.2 +093500* MOVE "44" TO CORRECT-X RL2074.2 +093600* MOVE WS-STATUS TO COMPUTED-X RL2074.2 +093700* PERFORM FAIL RL2074.2 +093800* PERFORM PRINT-DETAIL. RL2074.2 +093900* MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +094000* READ RL-FD1 INTO NEW-140-CHAR-AREA RL2074.2 +094100* INVALID KEY RL2074.2 +094200* MOVE "INVALID KEY ON 33RD RECORD READ" RL2074.2 +094300* TO RE-MARK RL2074.2 +094400* PERFORM FAIL RL2074.2 +094500* PERFORM PRINT-DETAIL RL2074.2 +094600 GO TO CCVS-EXIT. RL2074.2 +094700 REL-TEST-011-2. RL2074.2 +094800 MOVE "REL-TEST-011-2" TO PAR-NAME. RL2074.2 +094900 MOVE NEW-140-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +095000 IF UPDATE-NUMBER (1) = ZERO RL2074.2 +095100 PERFORM PASS RL2074.2 +095200 PERFORM PRINT-DETAIL RL2074.2 +095300 ELSE RL2074.2 +095400 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +095500 TO RE-MARK RL2074.2 +095600 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +095700 MOVE 00 TO CORRECT-N RL2074.2 +095800 PERFORM FAIL RL2074.2 +095900 PERFORM PRINT-DETAIL. RL2074.2 +096000 REL-TEST-011-3. RL2074.2 +096100 MOVE "REL-TEST-011-3" TO PAR-NAME. RL2074.2 +096200 IF EXTRA-20-CHARS = "ABCDEFGHIJKLMNOPQRST" RL2074.2 +096300 PERFORM PASS RL2074.2 +096400 PERFORM PRINT-DETAIL RL2074.2 +096500 ELSE RL2074.2 +096600 MOVE "INVALID UPDATE OF DIFFERENT LENGTH. RECS" RL2074.2 +096700 TO RE-MARK RL2074.2 +096800 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-X RL2074.2 +096900 MOVE EXTRA-20-CHARS TO COMPUTED-X RL2074.2 +097000 PERFORM FAIL RL2074.2 +097100 PERFORM PRINT-DETAIL. RL2074.2 +097200 REL-TEST-011-4. RL2074.2 +097300 MOVE "REL-TEST-011-4" TO PAR-NAME. RL2074.2 +097400 IF WRK-SIZE = 140 RL2074.2 +097500 PERFORM PASS RL2074.2 +097600 PERFORM PRINT-DETAIL RL2074.2 +097700 ELSE RL2074.2 +097800 MOVE "INCORRECT RECORD LENGTH READ" RL2074.2 +097900 TO RE-MARK RL2074.2 +098000 MOVE 140 TO CORRECT-18V0 RL2074.2 +098100 MOVE WRK-SIZE TO COMPUTED-18V0 RL2074.2 +098200 PERFORM FAIL RL2074.2 +098300 PERFORM PRINT-DETAIL. RL2074.2 +098400* RL2074.2 +098500 REL-INIT-012. RL2074.2 +098600 MOVE "REL-TEST-012" TO PAR-NAME. RL2074.2 +098700 MOVE 34 TO WRK-CS-09V00-003. RL2074.2 +098800 MOVE WRK-CS-09V00-003 TO RL-FD1-KEY. RL2074.2 +098900 READ RL-FD1 RL2074.2 +099000 INVALID KEY MOVE "REL-INIT-012 READ1" TO PAR-NAME RL2074.2 +099100 MOVE "INVALID KEY ON 34TH RECORD READ" RL2074.2 +099200 TO RE-MARK RL2074.2 +099300 PERFORM FAIL RL2074.2 +099400 PERFORM PRINT-DETAIL RL2074.2 +099500 GO TO CCVS-EXIT. RL2074.2 +099600 MOVE LOW-VALUES TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +099700 MOVE 98 TO UPDATE-NUMBER (1). RL2074.2 +099800 MOVE FILE-RECORD-INFO-P1-120 (1) TO NEW-115-120. RL2074.2 +099900 MOVE 115 TO WRK-SIZE. RL2074.2 +100000 REL-TEST-012-1. RL2074.2 +100100 MOVE "REL-TEST-012-1" TO PAR-NAME. RL2074.2 +100200 RL2074.2 +100300 REWRITE RL-FD1R1-F-G-140 FROM NEW-115-CHAR-AREA RL2074.2 +100400 INVALID GO TO REL-TEST-012-2. RL2074.2 +100500*REL-TEST-012-1-A. RL2074.2 +100600* IF WS-STATUS = "44" RL2074.2 +100700* PERFORM PASS RL2074.2 +100800* PERFORM PRINT-DETAIL RL2074.2 +100900* ELSE RL2074.2 +101000* MOVE "INCORRECT FILE STATUS HAS OCCURED" RL2074.2 +101100* TO RE-MARK RL2074.2 +101200* MOVE "44" TO CORRECT-X RL2074.2 +101300* MOVE WS-STATUS TO COMPUTED-X RL2074.2 +101400* PERFORM FAIL RL2074.2 +101500* PERFORM PRINT-DETAIL. RL2074.2 +101600* MOVE SPACES TO RL-FD1R1-F-G-140. RL2074.2 +101700* READ RL-FD1 INTO NEW-140-CHAR-AREA RL2074.2 +101800* INVALID KEY MOVE "REL-INIT-012 READ2" TO PAR-NAME RL2074.2 +101900* MOVE "INVALID KEY ON 34TH RECORD READ" RL2074.2 +102000* TO RE-MARK RL2074.2 +102100* PERFORM FAIL RL2074.2 +102200* PERFORM PRINT-DETAIL RL2074.2 +102300* GO TO REL-INIT-012. RL2074.2 +102400 REL-TEST-012-2. RL2074.2 +102500 MOVE "REL-TEST-012-2" TO PAR-NAME. RL2074.2 +102600 MOVE NEW-140-120 TO FILE-RECORD-INFO-P1-120 (1). RL2074.2 +102700 IF UPDATE-NUMBER (1) = ZERO RL2074.2 +102800 PERFORM PASS RL2074.2 +102900 PERFORM PRINT-DETAIL RL2074.2 +103000 ELSE RL2074.2 +103100 MOVE "INVALID UPDATE OF UPDATE NUMBER FIELD" RL2074.2 +103200 TO RE-MARK RL2074.2 +103300 MOVE UPDATE-NUMBER (1) TO COMPUTED-X RL2074.2 +103400 MOVE 00 TO CORRECT-N RL2074.2 +103500 PERFORM FAIL RL2074.2 +103600 PERFORM PRINT-DETAIL. RL2074.2 +103700 REL-TEST-012-3. RL2074.2 +103800 MOVE "REL-TEST-012-3" TO PAR-NAME. RL2074.2 +103900 IF EXTRA-20-CHARS = "ABCDEFGHIJKLMNOPQRST" RL2074.2 +104000 PERFORM PASS RL2074.2 +104100 PERFORM PRINT-DETAIL RL2074.2 +104200 ELSE RL2074.2 +104300 MOVE "INVALID UPDATE OF DIFFERENT LENGTH. RECS" RL2074.2 +104400 TO RE-MARK RL2074.2 +104500 MOVE "ABCDEFGHIJKLMNOPQRST" TO CORRECT-X RL2074.2 +104600 MOVE EXTRA-20-CHARS TO COMPUTED-X RL2074.2 +104700 PERFORM FAIL RL2074.2 +104800 PERFORM PRINT-DETAIL. RL2074.2 +104900 REL-TEST-012-4. RL2074.2 +105000 MOVE "REL-TEST-012-4" TO PAR-NAME. RL2074.2 +105100 IF WRK-SIZE = 140 RL2074.2 +105200 PERFORM PASS RL2074.2 +105300 PERFORM PRINT-DETAIL RL2074.2 +105400 ELSE RL2074.2 +105500 MOVE "INCORRECT RECORD LENGTH READ" RL2074.2 +105600 TO RE-MARK RL2074.2 +105700 MOVE 140 TO CORRECT-18V0 RL2074.2 +105800 MOVE WRK-SIZE TO COMPUTED-18V0 RL2074.2 +105900 PERFORM FAIL RL2074.2 +106000 PERFORM PRINT-DETAIL. RL2074.2 +106100* RL2074.2 +106200 CCVS-EXIT SECTION. RL2074.2 +106300 CCVS-999999. RL2074.2 +106400 GO TO CLOSE-FILES. RL2074.2 diff --git a/tests/cobol85/RL/RL208A.SUB b/tests/cobol85/RL/RL208A.SUB new file mode 100644 index 00000000..d4e34650 --- /dev/null +++ b/tests/cobol85/RL/RL208A.SUB @@ -0,0 +1,615 @@ +000100 IDENTIFICATION DIVISION. RL2084.2 +000200 PROGRAM-ID. RL2084.2 +000300 RL208A. RL2084.2 +000400**************************************************************** RL2084.2 +000500* * RL2084.2 +000600* VALIDATION FOR:- * RL2084.2 +000700* * RL2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2084.2 +000900* * RL2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2084.2 +001100* * RL2084.2 +001200**************************************************************** RL2084.2 +001300*GENERAL: THIS PROGRAM IS THE THIRD OF A SERIES. THE FUNCTION RL2084.2 +001400* OF THIS PROGRAM IS TO PROCESS THE FILE SEQUENTIALLY RL2084.2 +001500* (ACCESS MODE IS DYNAMIC). THE FILE USED IS THAT RL2084.2 +001600* RESULTING FROM RL206A RL2084.2 +001700* RL2084.2 +001800* FIRST, THE FILE IS VERIFIED FOR ACCURACY OF ITS 500 RL2084.2 +001900* RECORDS. SECONDLY, RECORDS OF THE FILE ARE RL2084.2 +002000* SELECTIVELY DELETED AND THIRDLY THE ACCURACY OF EACH RL2084.2 +002100* RECORD IN THE FILE IS AGAIN VERIFIED. RL2084.2 +002200* RL2084.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2084.2 +002400* PROGRAM ARE: RL2084.2 +002500* RL2084.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2084.2 +002700* RELATIVE I-O DATA FILE RL2084.2 +002800* X-55 SYSTEM PRINTER RL2084.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2084.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2084.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2084.2 +003200* X-82 SOURCE-COMPUTER RL2084.2 +003300* X-83 OBJECT-COMPUTER. RL2084.2 +003400* RL2084.2 +003500**************************************************************** RL2084.2 +003600 ENVIRONMENT DIVISION. RL2084.2 +003700 CONFIGURATION SECTION. RL2084.2 +003800 SOURCE-COMPUTER. RL2084.2 +003900 Linux. RL2084.2 +004000 OBJECT-COMPUTER. RL2084.2 +004100 Linux. RL2084.2 +004200 INPUT-OUTPUT SECTION. RL2084.2 +004300 FILE-CONTROL. RL2084.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2084.2 +004500 "report.log". RL2084.2 +004600 SELECT RL-FD1 ASSIGN TO RL2084.2 +004700 "XXXXX021" RL2084.2 +004800 ACCESS MODE IS DYNAMIC RL2084.2 +004900 RELATIVE KEY IS RL-FD1-KEY RL2084.2 +005000 ORGANIZATION IS RELATIVE. RL2084.2 +005100 DATA DIVISION. RL2084.2 +005200 FILE SECTION. RL2084.2 +005300 FD PRINT-FILE. RL2084.2 +005400 01 PRINT-REC PICTURE X(132). RL2084.2 +005500 01 DUMMY-RECORD PICTURE X(132). RL2084.2 +005600 FD RL-FD1 RL2084.2 +005700 LABEL RECORDS STANDARD RL2084.2 +005800*C VALUE OF RL2084.2 +005900*C OCLABELID RL2084.2 +006000*C IS RL2084.2 +006100*C "OCDUMMY" RL2084.2 +006200*G SYSIN RL2084.2 +006300 BLOCK CONTAINS 01 RECORDS RL2084.2 +006400 RECORD IS VARYING IN SIZE RL2084.2 +006500 FROM 120 TO 140 CHARACTERS. RL2084.2 +006600 01 RL-FD1R1-F-G-140. RL2084.2 +006700 02 RL-WRK-120 PIC X(120). RL2084.2 +006800 02 FILLER PIC X(20). RL2084.2 +006900 WORKING-STORAGE SECTION. RL2084.2 +007000 01 RL-FD1-KEY PIC 9(08) USAGE COMP VALUE ZERO. RL2084.2 +007100 01 WRK-CS-09V00-006 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007200 01 WRK-CS-09V00-007 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007300 01 WRK-CS-09V00-008 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007400 01 WRK-CS-09V00-009 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007500 01 WRK-CS-09V00-010 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007600 01 WRK-CS-09V00-011 PIC S9(09) USAGE COMP VALUE ZERO. RL2084.2 +007700 01 I-O-ERROR-RL-FD1 PIC X(3) VALUE "NO ". RL2084.2 +007800 01 FILE-RECORD-INFORMATION-REC. RL2084.2 +007900 03 FILE-RECORD-INFO-SKELETON. RL2084.2 +008000 05 FILLER PICTURE X(48) VALUE RL2084.2 +008100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2084.2 +008200 05 FILLER PICTURE X(46) VALUE RL2084.2 +008300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2084.2 +008400 05 FILLER PICTURE X(26) VALUE RL2084.2 +008500 ",LFIL=000000,ORG= ,LBLR= ". RL2084.2 +008600 05 FILLER PICTURE X(37) VALUE RL2084.2 +008700 ",RECKEY= ". RL2084.2 +008800 05 FILLER PICTURE X(38) VALUE RL2084.2 +008900 ",ALTKEY1= ". RL2084.2 +009000 05 FILLER PICTURE X(38) VALUE RL2084.2 +009100 ",ALTKEY2= ". RL2084.2 +009200 05 FILLER PICTURE X(7) VALUE SPACE.RL2084.2 +009300 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2084.2 +009400 05 FILE-RECORD-INFO-P1-120. RL2084.2 +009500 07 FILLER PIC X(5). RL2084.2 +009600 07 XFILE-NAME PIC X(6). RL2084.2 +009700 07 FILLER PIC X(8). RL2084.2 +009800 07 XRECORD-NAME PIC X(6). RL2084.2 +009900 07 FILLER PIC X(1). RL2084.2 +010000 07 REELUNIT-NUMBER PIC 9(1). RL2084.2 +010100 07 FILLER PIC X(7). RL2084.2 +010200 07 XRECORD-NUMBER PIC 9(6). RL2084.2 +010300 07 FILLER PIC X(6). RL2084.2 +010400 07 UPDATE-NUMBER PIC 9(2). RL2084.2 +010500 07 FILLER PIC X(5). RL2084.2 +010600 07 ODO-NUMBER PIC 9(4). RL2084.2 +010700 07 FILLER PIC X(5). RL2084.2 +010800 07 XPROGRAM-NAME PIC X(5). RL2084.2 +010900 07 FILLER PIC X(7). RL2084.2 +011000 07 XRECORD-LENGTH PIC 9(6). RL2084.2 +011100 07 FILLER PIC X(7). RL2084.2 +011200 07 CHARS-OR-RECORDS PIC X(2). RL2084.2 +011300 07 FILLER PIC X(1). RL2084.2 +011400 07 XBLOCK-SIZE PIC 9(4). RL2084.2 +011500 07 FILLER PIC X(6). RL2084.2 +011600 07 RECORDS-IN-FILE PIC 9(6). RL2084.2 +011700 07 FILLER PIC X(5). RL2084.2 +011800 07 XFILE-ORGANIZATION PIC X(2). RL2084.2 +011900 07 FILLER PIC X(6). RL2084.2 +012000 07 XLABEL-TYPE PIC X(1). RL2084.2 +012100 05 FILE-RECORD-INFO-P121-240. RL2084.2 +012200 07 FILLER PIC X(8). RL2084.2 +012300 07 XRECORD-KEY PIC X(29). RL2084.2 +012400 07 FILLER PIC X(9). RL2084.2 +012500 07 ALTERNATE-KEY1 PIC X(29). RL2084.2 +012600 07 FILLER PIC X(9). RL2084.2 +012700 07 ALTERNATE-KEY2 PIC X(29). RL2084.2 +012800 07 FILLER PIC X(7). RL2084.2 +012900 01 TEST-RESULTS. RL2084.2 +013000 02 FILLER PIC X VALUE SPACE. RL2084.2 +013100 02 FEATURE PIC X(20) VALUE SPACE. RL2084.2 +013200 02 FILLER PIC X VALUE SPACE. RL2084.2 +013300 02 P-OR-F PIC X(5) VALUE SPACE. RL2084.2 +013400 02 FILLER PIC X VALUE SPACE. RL2084.2 +013500 02 PAR-NAME. RL2084.2 +013600 03 FILLER PIC X(19) VALUE SPACE. RL2084.2 +013700 03 PARDOT-X PIC X VALUE SPACE. RL2084.2 +013800 03 DOTVALUE PIC 99 VALUE ZERO. RL2084.2 +013900 02 FILLER PIC X(8) VALUE SPACE. RL2084.2 +014000 02 RE-MARK PIC X(61). RL2084.2 +014100 01 TEST-COMPUTED. RL2084.2 +014200 02 FILLER PIC X(30) VALUE SPACE. RL2084.2 +014300 02 FILLER PIC X(17) VALUE RL2084.2 +014400 " COMPUTED=". RL2084.2 +014500 02 COMPUTED-X. RL2084.2 +014600 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2084.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A RL2084.2 +014800 PIC -9(9).9(9). RL2084.2 +014900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2084.2 +015000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2084.2 +015100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2084.2 +015200 03 CM-18V0 REDEFINES COMPUTED-A. RL2084.2 +015300 04 COMPUTED-18V0 PIC -9(18). RL2084.2 +015400 04 FILLER PIC X. RL2084.2 +015500 03 FILLER PIC X(50) VALUE SPACE. RL2084.2 +015600 01 TEST-CORRECT. RL2084.2 +015700 02 FILLER PIC X(30) VALUE SPACE. RL2084.2 +015800 02 FILLER PIC X(17) VALUE " CORRECT =". RL2084.2 +015900 02 CORRECT-X. RL2084.2 +016000 03 CORRECT-A PIC X(20) VALUE SPACE. RL2084.2 +016100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2084.2 +016200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2084.2 +016300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2084.2 +016400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2084.2 +016500 03 CR-18V0 REDEFINES CORRECT-A. RL2084.2 +016600 04 CORRECT-18V0 PIC -9(18). RL2084.2 +016700 04 FILLER PIC X. RL2084.2 +016800 03 FILLER PIC X(2) VALUE SPACE. RL2084.2 +016900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2084.2 +017000 01 CCVS-C-1. RL2084.2 +017100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2084.2 +017200- "SS PARAGRAPH-NAME RL2084.2 +017300- " REMARKS". RL2084.2 +017400 02 FILLER PIC X(20) VALUE SPACE. RL2084.2 +017500 01 CCVS-C-2. RL2084.2 +017600 02 FILLER PIC X VALUE SPACE. RL2084.2 +017700 02 FILLER PIC X(6) VALUE "TESTED". RL2084.2 +017800 02 FILLER PIC X(15) VALUE SPACE. RL2084.2 +017900 02 FILLER PIC X(4) VALUE "FAIL". RL2084.2 +018000 02 FILLER PIC X(94) VALUE SPACE. RL2084.2 +018100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2084.2 +018200 01 REC-CT PIC 99 VALUE ZERO. RL2084.2 +018300 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2084.2 +018400 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2084.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2084.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2084.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2084.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2084.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2084.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2084.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2084.2 +019200 01 CCVS-H-1. RL2084.2 +019300 02 FILLER PIC X(39) VALUE SPACES. RL2084.2 +019400 02 FILLER PIC X(42) VALUE RL2084.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2084.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL2084.2 +019700 01 CCVS-H-2A. RL2084.2 +019800 02 FILLER PIC X(40) VALUE SPACE. RL2084.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2084.2 +020000 02 FILLER PIC XXXX VALUE RL2084.2 +020100 "4.2 ". RL2084.2 +020200 02 FILLER PIC X(28) VALUE RL2084.2 +020300 " COPY - NOT FOR DISTRIBUTION". RL2084.2 +020400 02 FILLER PIC X(41) VALUE SPACE. RL2084.2 +020500 RL2084.2 +020600 01 CCVS-H-2B. RL2084.2 +020700 02 FILLER PIC X(15) VALUE RL2084.2 +020800 "TEST RESULT OF ". RL2084.2 +020900 02 TEST-ID PIC X(9). RL2084.2 +021000 02 FILLER PIC X(4) VALUE RL2084.2 +021100 " IN ". RL2084.2 +021200 02 FILLER PIC X(12) VALUE RL2084.2 +021300 " HIGH ". RL2084.2 +021400 02 FILLER PIC X(22) VALUE RL2084.2 +021500 " LEVEL VALIDATION FOR ". RL2084.2 +021600 02 FILLER PIC X(58) VALUE RL2084.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2084.2 +021800 01 CCVS-H-3. RL2084.2 +021900 02 FILLER PIC X(34) VALUE RL2084.2 +022000 " FOR OFFICIAL USE ONLY ". RL2084.2 +022100 02 FILLER PIC X(58) VALUE RL2084.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2084.2 +022300 02 FILLER PIC X(28) VALUE RL2084.2 +022400 " COPYRIGHT 1985 ". RL2084.2 +022500 01 CCVS-E-1. RL2084.2 +022600 02 FILLER PIC X(52) VALUE SPACE. RL2084.2 +022700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2084.2 +022800 02 ID-AGAIN PIC X(9). RL2084.2 +022900 02 FILLER PIC X(45) VALUE SPACES. RL2084.2 +023000 01 CCVS-E-2. RL2084.2 +023100 02 FILLER PIC X(31) VALUE SPACE. RL2084.2 +023200 02 FILLER PIC X(21) VALUE SPACE. RL2084.2 +023300 02 CCVS-E-2-2. RL2084.2 +023400 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2084.2 +023500 03 FILLER PIC X VALUE SPACE. RL2084.2 +023600 03 ENDER-DESC PIC X(44) VALUE RL2084.2 +023700 "ERRORS ENCOUNTERED". RL2084.2 +023800 01 CCVS-E-3. RL2084.2 +023900 02 FILLER PIC X(22) VALUE RL2084.2 +024000 " FOR OFFICIAL USE ONLY". RL2084.2 +024100 02 FILLER PIC X(12) VALUE SPACE. RL2084.2 +024200 02 FILLER PIC X(58) VALUE RL2084.2 +024300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2084.2 +024400 02 FILLER PIC X(13) VALUE SPACE. RL2084.2 +024500 02 FILLER PIC X(15) VALUE RL2084.2 +024600 " COPYRIGHT 1985". RL2084.2 +024700 01 CCVS-E-4. RL2084.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2084.2 +024900 02 FILLER PIC X(4) VALUE " OF ". RL2084.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2084.2 +025100 02 FILLER PIC X(40) VALUE RL2084.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". RL2084.2 +025300 01 XXINFO. RL2084.2 +025400 02 FILLER PIC X(19) VALUE RL2084.2 +025500 "*** INFORMATION ***". RL2084.2 +025600 02 INFO-TEXT. RL2084.2 +025700 04 FILLER PIC X(8) VALUE SPACE. RL2084.2 +025800 04 XXCOMPUTED PIC X(20). RL2084.2 +025900 04 FILLER PIC X(5) VALUE SPACE. RL2084.2 +026000 04 XXCORRECT PIC X(20). RL2084.2 +026100 02 INF-ANSI-REFERENCE PIC X(48). RL2084.2 +026200 01 HYPHEN-LINE. RL2084.2 +026300 02 FILLER PIC IS X VALUE IS SPACE. RL2084.2 +026400 02 FILLER PIC IS X(65) VALUE IS "************************RL2084.2 +026500- "*****************************************". RL2084.2 +026600 02 FILLER PIC IS X(54) VALUE IS "************************RL2084.2 +026700- "******************************". RL2084.2 +026800 01 CCVS-PGM-ID PIC X(9) VALUE RL2084.2 +026900 "RL208A". RL2084.2 +027000 PROCEDURE DIVISION. RL2084.2 +027100 CCVS1 SECTION. RL2084.2 +027200 OPEN-FILES. RL2084.2 +027300 OPEN OUTPUT PRINT-FILE. RL2084.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2084.2 +027500 MOVE SPACE TO TEST-RESULTS. RL2084.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2084.2 +027700 MOVE ZERO TO REC-SKL-SUB. RL2084.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. RL2084.2 +027900 CCVS-INIT-FILE. RL2084.2 +028000 ADD 1 TO REC-SKL-SUB. RL2084.2 +028100 MOVE FILE-RECORD-INFO-SKELETON RL2084.2 +028200 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2084.2 +028300 CCVS-INIT-EXIT. RL2084.2 +028400 GO TO CCVS1-EXIT. RL2084.2 +028500 CLOSE-FILES. RL2084.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2084.2 +028700 TERMINATE-CCVS. RL2084.2 +028800*S EXIT PROGRAM. RL2084.2 +028900*SERMINATE-CALL. RL2084.2 +029000 STOP RUN. RL2084.2 +029100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2084.2 +029200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2084.2 +029300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2084.2 +029400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2084.2 +029500 MOVE "****TEST DELETED****" TO RE-MARK. RL2084.2 +029600 PRINT-DETAIL. RL2084.2 +029700 IF REC-CT NOT EQUAL TO ZERO RL2084.2 +029800 MOVE "." TO PARDOT-X RL2084.2 +029900 MOVE REC-CT TO DOTVALUE. RL2084.2 +030000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2084.2 +030100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2084.2 +030200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2084.2 +030300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2084.2 +030400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2084.2 +030500 MOVE SPACE TO CORRECT-X. RL2084.2 +030600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2084.2 +030700 MOVE SPACE TO RE-MARK. RL2084.2 +030800 HEAD-ROUTINE. RL2084.2 +030900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +031000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +031100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2084.2 +031200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2084.2 +031300 COLUMN-NAMES-ROUTINE. RL2084.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +031700 END-ROUTINE. RL2084.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2084.2 +031900 END-RTN-EXIT. RL2084.2 +032000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +032100 END-ROUTINE-1. RL2084.2 +032200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2084.2 +032300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2084.2 +032400 ADD PASS-COUNTER TO ERROR-HOLD. RL2084.2 +032500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2084.2 +032600 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2084.2 +032700 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2084.2 +032800 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2084.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2084.2 +033000 END-ROUTINE-12. RL2084.2 +033100 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2084.2 +033200 IF ERROR-COUNTER IS EQUAL TO ZERO RL2084.2 +033300 MOVE "NO " TO ERROR-TOTAL RL2084.2 +033400 ELSE RL2084.2 +033500 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2084.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2084.2 +033700 PERFORM WRITE-LINE. RL2084.2 +033800 END-ROUTINE-13. RL2084.2 +033900 IF DELETE-COUNTER IS EQUAL TO ZERO RL2084.2 +034000 MOVE "NO " TO ERROR-TOTAL ELSE RL2084.2 +034100 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2084.2 +034200 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2084.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +034400 IF INSPECT-COUNTER EQUAL TO ZERO RL2084.2 +034500 MOVE "NO " TO ERROR-TOTAL RL2084.2 +034600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2084.2 +034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2084.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2084.2 +035000 WRITE-LINE. RL2084.2 +035100 ADD 1 TO RECORD-COUNT. RL2084.2 +035200 IF RECORD-COUNT GREATER 50 RL2084.2 +035300 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2084.2 +035400 MOVE SPACE TO DUMMY-RECORD RL2084.2 +035500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2084.2 +035600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2084.2 +035700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2084.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2084.2 +035900 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2084.2 +036000 MOVE ZERO TO RECORD-COUNT. RL2084.2 +036100 PERFORM WRT-LN. RL2084.2 +036200 WRT-LN. RL2084.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2084.2 +036400 MOVE SPACE TO DUMMY-RECORD. RL2084.2 +036500 BLANK-LINE-PRINT. RL2084.2 +036600 PERFORM WRT-LN. RL2084.2 +036700 FAIL-ROUTINE. RL2084.2 +036800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL2084.2 +036900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. RL2084.2 +037000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2084.2 +037100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2084.2 +037200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +037300 MOVE SPACES TO INF-ANSI-REFERENCE. RL2084.2 +037400 GO TO FAIL-ROUTINE-EX. RL2084.2 +037500 FAIL-ROUTINE-WRITE. RL2084.2 +037600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2084.2 +037700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2084.2 +037800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2084.2 +037900 MOVE SPACES TO COR-ANSI-REFERENCE. RL2084.2 +038000 FAIL-ROUTINE-EX. EXIT. RL2084.2 +038100 BAIL-OUT. RL2084.2 +038200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2084.2 +038300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2084.2 +038400 BAIL-OUT-WRITE. RL2084.2 +038500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2084.2 +038600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2084.2 +038700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2084.2 +038800 MOVE SPACES TO INF-ANSI-REFERENCE. RL2084.2 +038900 BAIL-OUT-EX. EXIT. RL2084.2 +039000 CCVS1-EXIT. RL2084.2 +039100 EXIT. RL2084.2 +039200 SECT-RL208A-001 SECTION. RL2084.2 +039300 REL-INIT-012. RL2084.2 +039400 MOVE 99 TO RL-FD1-KEY. RL2084.2 +039500* CONTAIN THE NUMBER OF THE RECORD PREVIOUSLY READ. RL2084.2 +039600 OPEN INPUT RL-FD1. RL2084.2 +039700 MOVE "REL-TEST-012" TO PAR-NAME. RL2084.2 +039800 MOVE ZERO TO WRK-CS-09V00-006. RL2084.2 +039900 MOVE ZERO TO WRK-CS-09V00-007. RL2084.2 +040000 MOVE ZERO TO WRK-CS-09V00-008. RL2084.2 +040100 MOVE ZERO TO WRK-CS-09V00-009. RL2084.2 +040200 MOVE ZERO TO WRK-CS-09V00-010. RL2084.2 +040300 MOVE ZERO TO WRK-CS-09V00-011. RL2084.2 +040400 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +040500 MOVE RL-FD1-KEY TO WRK-CS-09V00-011. RL2084.2 +040600 MOVE 01 TO REC-CT. RL2084.2 +040700 MOVE "READ SEQUENTIAL" TO FEATURE. RL2084.2 +040800 REL-TEST-012-R. RL2084.2 +040900 ADD 1 TO WRK-CS-09V00-006. RL2084.2 +041000 READ RL-FD1 NEXT RECORD RL2084.2 +041100 AT END GO TO REL-TEST-012-3. RL2084.2 +041200 MOVE RL-WRK-120 TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +041300 IF UPDATE-NUMBER (1) EQUAL TO 00 RL2084.2 +041400 ADD 1 TO WRK-CS-09V00-007 RL2084.2 +041500 GO TO REL-TEST-012-2. RL2084.2 +041600 IF UPDATE-NUMBER (1) EQUAL TO 01 OR 98 RL2084.2 +041700 ADD 1 TO WRK-CS-09V00-008 RL2084.2 +041800 GO TO REL-TEST-012-2. RL2084.2 +041900 ADD 1 TO WRK-CS-09V00-009. RL2084.2 +042000 REL-TEST-012-2. RL2084.2 +042100 IF RL-FD1-KEY NOT EQUAL TO XRECORD-NUMBER (1) RL2084.2 +042200 ADD 1 TO WRK-CS-09V00-010. RL2084.2 +042300 IF WRK-CS-09V00-006 GREATER 501 RL2084.2 +042400 GO TO REL-TEST-012-3. RL2084.2 +042500 GO TO REL-TEST-012-R. RL2084.2 +042600 REL-TEST-012-3. RL2084.2 +042700 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL2084.2 +042800 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2084.2 +042900 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2084.2 +043000 MOVE 501 TO CORRECT-18V0 RL2084.2 +043100 PERFORM FAIL RL2084.2 +043200 ELSE RL2084.2 +043300 PERFORM PASS. RL2084.2 +043400 PERFORM PRINT-DETAIL. RL2084.2 +043500* .01 RL2084.2 +043600 ADD 1 TO REC-CT. RL2084.2 +043700 IF WRK-CS-09V00-007 EQUAL TO 395 RL2084.2 +043800 PERFORM PASS RL2084.2 +043900 ELSE RL2084.2 +044000 MOVE "NON-UPDATED RECORDS" TO COMPUTED-A RL2084.2 +044100 MOVE WRK-CS-09V00-007 TO CORRECT-18V0 RL2084.2 +044200 MOVE "SHOULD BE 395" TO RE-MARK RL2084.2 +044300 PERFORM FAIL. RL2084.2 +044400 PERFORM PRINT-DETAIL. RL2084.2 +044500 ADD 1 TO REC-CT. RL2084.2 +044600* .02 RL2084.2 +044700 IF WRK-CS-09V00-008 EQUAL TO 105 RL2084.2 +044800 PERFORM PASS RL2084.2 +044900 ELSE RL2084.2 +045000 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL2084.2 +045100 MOVE 105 TO CORRECT-18V0 RL2084.2 +045200 MOVE "UPDATED RECORDS" TO RE-MARK RL2084.2 +045300 PERFORM FAIL. RL2084.2 +045400 PERFORM PRINT-DETAIL. RL2084.2 +045500 ADD 1 TO REC-CT. RL2084.2 +045600* .03 RL2084.2 +045700 IF WRK-CS-09V00-009 EQUAL TO ZERO RL2084.2 +045800 PERFORM PASS RL2084.2 +045900 ELSE RL2084.2 +046000 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL2084.2 +046100 MOVE ZERO TO CORRECT-18V0 RL2084.2 +046200 MOVE "BAD-UPDATES" TO RE-MARK RL2084.2 +046300 PERFORM FAIL. RL2084.2 +046400 PERFORM PRINT-DETAIL. RL2084.2 +046500 ADD 01 TO REC-CT. RL2084.2 +046600* .04 RL2084.2 +046700 IF WRK-CS-09V00-010 EQUAL TO ZERO RL2084.2 +046800 PERFORM PASS RL2084.2 +046900 ELSE RL2084.2 +047000 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL2084.2 +047100 MOVE ZERO TO CORRECT-18V0 RL2084.2 +047200 MOVE "KEY VS RECORD" TO RE-MARK RL2084.2 +047300 PERFORM FAIL. RL2084.2 +047400 PERFORM PRINT-DETAIL. RL2084.2 +047500 ADD 01 TO REC-CT. RL2084.2 +047600* .05 RL2084.2 +047700 MOVE WRK-CS-09V00-011 TO RL-FD1-KEY. RL2084.2 +047800 MOVE RL-FD1-KEY TO COMPUTED-18V0. RL2084.2 +047900 MOVE "INFORMATION" TO CORRECT-A. RL2084.2 +048000 MOVE "STATUS AFTER OPEN" TO RE-MARK. RL2084.2 +048100 PERFORM PRINT-DETAIL. RL2084.2 +048200 ADD 01 TO REC-CT. RL2084.2 +048300* .06 RL2084.2 +048400 CLOSE RL-FD1. RL2084.2 +048500 REL-INIT-013. RL2084.2 +048600 MOVE "REL-TEST-013" TO PAR-NAME RL2084.2 +048700 OPEN I-O RL-FD1. RL2084.2 +048800 MOVE ZERO TO WRK-CS-09V00-006 RL2084.2 +048900 MOVE ZERO TO WRK-CS-09V00-007 RL2084.2 +049000 MOVE ZERO TO WRK-CS-09V00-008 RL2084.2 +049100 MOVE ZERO TO WRK-CS-09V00-009 RL2084.2 +049200 MOVE ZERO TO WRK-CS-09V00-010 RL2084.2 +049300 MOVE ZERO TO WRK-CS-09V00-011 RL2084.2 +049400 MOVE 01 TO REC-CT. RL2084.2 +049500 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +049600 MOVE "DELETE" TO FEATURE. RL2084.2 +049700 REL-TEST-013-R. RL2084.2 +049800 ADD 1 TO WRK-CS-09V00-006 RL2084.2 +049900 ADD 1 TO WRK-CS-09V00-007. RL2084.2 +050000 READ RL-FD1 NEXT RECORD RL2084.2 +050100 AT END RL2084.2 +050200 MOVE "AT END PATH TAKEN " TO RE-MARK RL2084.2 +050300 GO TO REL-TEST-013-3. RL2084.2 +050400 MOVE RL-WRK-120 TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +050500 IF (WRK-CS-09V00-007 = 1 OR 11 OR 21 OR 31 OR 32) RL2084.2 +050600 GO TO REL-TEST-013-2. RL2084.2 +050700 IF WRK-CS-09V00-006 GREATER 501 RL2084.2 +050800 MOVE "AT END NOT TAKEN" TO RE-MARK RL2084.2 +050900 GO TO REL-TEST-013-3. RL2084.2 +051000 GO TO REL-TEST-013-R. RL2084.2 +051100 REL-TEST-013-2. RL2084.2 +051200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2084.2 +051300 MOVE 99 TO UPDATE-NUMBER (1). RL2084.2 +051400 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FD1R1-F-G-140. RL2084.2 +051500 DELETE RL-FD1 RL2084.2 +051600 INVALID KEY GO TO REL-TEST-013-3. RL2084.2 +051700 ADD 1 TO WRK-CS-09V00-008 RL2084.2 +051800 GO TO REL-TEST-013-R. RL2084.2 +051900 REL-TEST-013-3. RL2084.2 +052000 IF WRK-CS-09V00-006 NOT EQUAL TO 501 RL2084.2 +052100 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2084.2 +052200 MOVE 501 TO CORRECT-18V0 RL2084.2 +052300 PERFORM FAIL RL2084.2 +052400 ELSE RL2084.2 +052500 PERFORM PASS. RL2084.2 +052600 PERFORM PRINT-DETAIL. RL2084.2 +052700 ADD 01 TO REC-CT. RL2084.2 +052800* .01 RL2084.2 +052900 IF WRK-CS-09V00-008 NOT EQUAL TO 5 RL2084.2 +053000 MOVE WRK-CS-09V00-008 TO COMPUTED-18V0 RL2084.2 +053100 MOVE 5 TO CORRECT-18V0 RL2084.2 +053200 MOVE "DELETED RECORDS" TO RE-MARK RL2084.2 +053300 PERFORM FAIL RL2084.2 +053400 ELSE RL2084.2 +053500 PERFORM PASS. RL2084.2 +053600 PERFORM PRINT-DETAIL. RL2084.2 +053700 ADD 01 TO REC-CT. RL2084.2 +053800* .02 RL2084.2 +053900 CLOSE RL-FD1. RL2084.2 +054000 REL-INIT-014. RL2084.2 +054100 MOVE "REL-TEST-014" TO PAR-NAME. RL2084.2 +054200 MOVE ZERO TO WRK-CS-09V00-006 RL2084.2 +054300 MOVE ZERO TO WRK-CS-09V00-007 RL2084.2 +054400 MOVE ZERO TO WRK-CS-09V00-008 RL2084.2 +054500 MOVE ZERO TO WRK-CS-09V00-009 RL2084.2 +054600 MOVE ZERO TO WRK-CS-09V00-010 RL2084.2 +054700 MOVE ZERO TO WRK-CS-09V00-011 RL2084.2 +054800 MOVE 01 TO REC-CT. RL2084.2 +054900 MOVE SPACE TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +055000 MOVE ZERO TO RL-FD1-KEY. RL2084.2 +055100 OPEN INPUT RL-FD1. RL2084.2 +055200 MOVE "READ UPDATED FILE" TO FEATURE. RL2084.2 +055300 REL-TEST-014-R. RL2084.2 +055400 ADD 1 TO WRK-CS-09V00-006. RL2084.2 +055500 ADD 1 TO WRK-CS-09V00-007. RL2084.2 +055600 ADD 1 TO WRK-CS-09V00-008. RL2084.2 +055700 READ RL-FD1 NEXT RECORD AT END GO TO REL-TEST-014-3. RL2084.2 +055800 MOVE RL-WRK-120 TO FILE-RECORD-INFO-P1-120 (1). RL2084.2 +055900 IF UPDATE-NUMBER (1) EQUAL TO 99 RL2084.2 +056000 ADD 1 TO WRK-CS-09V00-009. RL2084.2 +056100 IF (WRK-CS-09V00-008 = 1 OR 11 OR 21 OR 31) RL2084.2 +056200 ADD 1 TO WRK-CS-09V00-008. RL2084.2 +056300 IF (WRK-CS-09V00-008 = 32) RL2084.2 +056400 ADD 1 TO WRK-CS-09V00-008. RL2084.2 +056500 IF RL-FD1-KEY EQUAL TO XRECORD-NUMBER (1) RL2084.2 +056600 ADD 1 TO WRK-CS-09V00-010. RL2084.2 +056700 IF XRECORD-NUMBER (1) EQUAL TO WRK-CS-09V00-008 RL2084.2 +056800 ADD 1 TO WRK-CS-09V00-011. RL2084.2 +056900 IF WRK-CS-09V00-006 GREATER 501 RL2084.2 +057000 GO TO REL-TEST-014-3. RL2084.2 +057100 GO TO REL-TEST-014-R. RL2084.2 +057200 REL-TEST-014-3. RL2084.2 +057300 IF WRK-CS-09V00-006 NOT EQUAL TO 496 RL2084.2 +057400 MOVE "INCORRECT RECORD COUNT" TO RE-MARK RL2084.2 +057500 MOVE WRK-CS-09V00-006 TO COMPUTED-18V0 RL2084.2 +057600 MOVE 496 TO CORRECT-18V0 RL2084.2 +057700 PERFORM FAIL RL2084.2 +057800 ELSE RL2084.2 +057900 PERFORM PASS. RL2084.2 +058000 PERFORM PRINT-DETAIL. RL2084.2 +058100 ADD 01 TO REC-CT. RL2084.2 +058200* .01 RL2084.2 +058300 IF WRK-CS-09V00-009 NOT EQUAL TO ZERO RL2084.2 +058400 MOVE WRK-CS-09V00-009 TO COMPUTED-18V0 RL2084.2 +058500 MOVE ZERO TO CORRECT-18V0 RL2084.2 +058600 MOVE "DELETED RECORDS" TO RE-MARK RL2084.2 +058700 PERFORM FAIL RL2084.2 +058800 ELSE RL2084.2 +058900 PERFORM PASS. RL2084.2 +059000 PERFORM PRINT-DETAIL. RL2084.2 +059100 ADD 01 TO REC-CT. RL2084.2 +059200* .02 RL2084.2 +059300 IF WRK-CS-09V00-010 NOT EQUAL TO 495 RL2084.2 +059400 MOVE "KEY MISMATCH" TO RE-MARK RL2084.2 +059500 MOVE 495 TO CORRECT-18V0 RL2084.2 +059600 MOVE WRK-CS-09V00-010 TO COMPUTED-18V0 RL2084.2 +059700 PERFORM FAIL RL2084.2 +059800 ELSE RL2084.2 +059900 PERFORM PASS. RL2084.2 +060000 PERFORM PRINT-DETAIL. RL2084.2 +060100 ADD 01 TO REC-CT. RL2084.2 +060200* .03 RL2084.2 +060300 IF WRK-CS-09V00-011 NOT EQUAL TO 495 RL2084.2 +060400 MOVE 495 TO CORRECT-18V0 RL2084.2 +060500 MOVE "INCORRECT RECORD FOUND" TO RE-MARK RL2084.2 +060600 MOVE WRK-CS-09V00-011 TO COMPUTED-18V0 RL2084.2 +060700 PERFORM FAIL RL2084.2 +060800 ELSE RL2084.2 +060900 PERFORM PASS. RL2084.2 +061000 PERFORM PRINT-DETAIL. RL2084.2 +061100*04 RL2084.2 +061200 CLOSE RL-FD1. RL2084.2 +061300 CCVS-EXIT SECTION. RL2084.2 +061400 CCVS-999999. RL2084.2 +061500 GO TO CLOSE-FILES. RL2084.2 diff --git a/tests/cobol85/RL/RL209A.CBL b/tests/cobol85/RL/RL209A.CBL new file mode 100644 index 00000000..cec9a705 --- /dev/null +++ b/tests/cobol85/RL/RL209A.CBL @@ -0,0 +1,460 @@ +000100 IDENTIFICATION DIVISION. RL2094.2 +000200 PROGRAM-ID. RL2094.2 +000300 RL209A. RL2094.2 +000400**************************************************************** RL2094.2 +000500* * RL2094.2 +000600* VALIDATION FOR:- * RL2094.2 +000700* * RL2094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2094.2 +000900* * RL2094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2094.2 +001100* * RL2094.2 +001200**************************************************************** RL2094.2 +001300* * RL2094.2 +001400* THE FUNCTION OF THIS PROGRAM IS TO CREATE A RELATIVE FILE * RL2094.2 +001500* SEQUENTIALLY WITH VARIABLE LENGTH RECORDS AND VERIFY THAT * RL2094.2 +001600* IT WAS CREATED CORRECTLY. * RL2094.2 +001700* THE FILE WILL BE IDENTIFIED AS: "RL-VS1". * RL2094.2 +001800* THE PROGRAM WILL CREATE A RELATIVE FILE OF 500 VARIABLE * RL2094.2 +001900* LENGTH RECORDS. * RL2094.2 +002000* THE RECORD SIZE WILL BE 120 TO 140 CHARACTERS. * RL2094.2 +002100* * RL2094.2 +002200**************************************************************** RL2094.2 +002300* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2094.2 +002400* PROGRAM ARE: RL2094.2 +002500* RL2094.2 +002600* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2094.2 +002700* RELATIVE I-O DATA FILE RL2094.2 +002800* X-55 SYSTEM PRINTER RL2094.2 +002900* X-69 ADDITIONAL VALUE OF CLAUSES RL2094.2 +003000* X-74 VALUE OF IMPLEMENTOR-NAME RL2094.2 +003100* X-75 OBJECT OF VALUE OF CLAUSE RL2094.2 +003200* X-82 SOURCE-COMPUTER RL2094.2 +003300* X-83 OBJECT-COMPUTER. RL2094.2 +003400* RL2094.2 +003500**************************************************************** RL2094.2 +003600 ENVIRONMENT DIVISION. RL2094.2 +003700 CONFIGURATION SECTION. RL2094.2 +003800 SOURCE-COMPUTER. RL2094.2 +003900 Linux. RL2094.2 +004000 OBJECT-COMPUTER. RL2094.2 +004100 Linux. RL2094.2 +004200 INPUT-OUTPUT SECTION. RL2094.2 +004300 FILE-CONTROL. RL2094.2 +004400 SELECT PRINT-FILE ASSIGN TO RL2094.2 +004500 "report.log". RL2094.2 +004600 SELECT RL-FS1 ASSIGN TO RL2094.2 +004700 "XXXXX021" RL2094.2 +004800 ORGANIZATION IS RELATIVE. RL2094.2 +004900* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2094.2 +005000* SEQUENTIAL HAD BEEN SPECIFIED. RL2094.2 +005100 DATA DIVISION. RL2094.2 +005200 FILE SECTION. RL2094.2 +005300 FD PRINT-FILE. RL2094.2 +005400 01 PRINT-REC PICTURE X(120). RL2094.2 +005500 01 DUMMY-RECORD PICTURE X(120). RL2094.2 +005600 FD RL-FS1 RL2094.2 +005700 LABEL RECORDS STANDARD RL2094.2 +005800*C VALUE OF RL2094.2 +005900*C OCLABELID RL2094.2 +006000*C IS RL2094.2 +006100*C "OCDUMMY" RL2094.2 +006200*G SYSIN RL2094.2 +006300 RECORD IS VARYING IN SIZE RL2094.2 +006400 FROM 120 TO 140 CHARACTERS RL2094.2 +006500 DEPENDING ON WRK-SIZE. RL2094.2 +006600 01 RL-FS1R1-F-G-120. RL2094.2 +006700 02 FILLER PIC X(140). RL2094.2 +006800 WORKING-STORAGE SECTION. RL2094.2 +006900 01 WRK-SIZE PIC 9(3). RL2094.2 +007000 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2094.2 +007100 01 FILE-RECORD-INFORMATION-REC. RL2094.2 +007200 03 FILE-RECORD-INFO-SKELETON. RL2094.2 +007300 05 FILLER PICTURE X(48) VALUE RL2094.2 +007400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2094.2 +007500 05 FILLER PICTURE X(46) VALUE RL2094.2 +007600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2094.2 +007700 05 FILLER PICTURE X(26) VALUE RL2094.2 +007800 ",LFIL=000000,ORG= ,LBLR= ". RL2094.2 +007900 05 FILLER PICTURE X(37) VALUE RL2094.2 +008000 ",RECKEY= ". RL2094.2 +008100 05 FILLER PICTURE X(38) VALUE RL2094.2 +008200 ",ALTKEY1= ". RL2094.2 +008300 05 FILLER PICTURE X(38) VALUE RL2094.2 +008400 ",ALTKEY2= ". RL2094.2 +008500 05 FILLER PICTURE X(7) VALUE SPACE.RL2094.2 +008600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2094.2 +008700 05 FILE-RECORD-INFO-P1-120. RL2094.2 +008800 07 FILLER PIC X(5). RL2094.2 +008900 07 XFILE-NAME PIC X(6). RL2094.2 +009000 07 FILLER PIC X(8). RL2094.2 +009100 07 XRECORD-NAME PIC X(6). RL2094.2 +009200 07 FILLER PIC X(1). RL2094.2 +009300 07 REELUNIT-NUMBER PIC 9(1). RL2094.2 +009400 07 FILLER PIC X(7). RL2094.2 +009500 07 XRECORD-NUMBER PIC 9(6). RL2094.2 +009600 07 FILLER PIC X(6). RL2094.2 +009700 07 UPDATE-NUMBER PIC 9(2). RL2094.2 +009800 07 FILLER PIC X(5). RL2094.2 +009900 07 ODO-NUMBER PIC 9(4). RL2094.2 +010000 07 FILLER PIC X(5). RL2094.2 +010100 07 XPROGRAM-NAME PIC X(5). RL2094.2 +010200 07 FILLER PIC X(7). RL2094.2 +010300 07 XRECORD-LENGTH PIC 9(6). RL2094.2 +010400 07 FILLER PIC X(7). RL2094.2 +010500 07 CHARS-OR-RECORDS PIC X(2). RL2094.2 +010600 07 FILLER PIC X(1). RL2094.2 +010700 07 XBLOCK-SIZE PIC 9(4). RL2094.2 +010800 07 FILLER PIC X(6). RL2094.2 +010900 07 RECORDS-IN-FILE PIC 9(6). RL2094.2 +011000 07 FILLER PIC X(5). RL2094.2 +011100 07 XFILE-ORGANIZATION PIC X(2). RL2094.2 +011200 07 FILLER PIC X(6). RL2094.2 +011300 07 XLABEL-TYPE PIC X(1). RL2094.2 +011400 05 FILE-RECORD-INFO-P121-240. RL2094.2 +011500 07 FILLER PIC X(8). RL2094.2 +011600 07 XRECORD-KEY PIC X(29). RL2094.2 +011700 07 FILLER PIC X(9). RL2094.2 +011800 07 ALTERNATE-KEY1 PIC X(29). RL2094.2 +011900 07 FILLER PIC X(9). RL2094.2 +012000 07 ALTERNATE-KEY2 PIC X(29). RL2094.2 +012100 07 FILLER PIC X(7). RL2094.2 +012200 01 TEST-RESULTS. RL2094.2 +012300 02 FILLER PIC X VALUE SPACE. RL2094.2 +012400 02 FEATURE PIC X(20) VALUE SPACE. RL2094.2 +012500 02 FILLER PIC X VALUE SPACE. RL2094.2 +012600 02 P-OR-F PIC X(5) VALUE SPACE. RL2094.2 +012700 02 FILLER PIC X VALUE SPACE. RL2094.2 +012800 02 PAR-NAME. RL2094.2 +012900 03 FILLER PIC X(19) VALUE SPACE. RL2094.2 +013000 03 PARDOT-X PIC X VALUE SPACE. RL2094.2 +013100 03 DOTVALUE PIC 99 VALUE ZERO. RL2094.2 +013200 02 FILLER PIC X(8) VALUE SPACE. RL2094.2 +013300 02 RE-MARK PIC X(61). RL2094.2 +013400 01 TEST-COMPUTED. RL2094.2 +013500 02 FILLER PIC X(30) VALUE SPACE. RL2094.2 +013600 02 FILLER PIC X(17) VALUE RL2094.2 +013700 " COMPUTED=". RL2094.2 +013800 02 COMPUTED-X. RL2094.2 +013900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2094.2 +014000 03 COMPUTED-N REDEFINES COMPUTED-A RL2094.2 +014100 PIC -9(9).9(9). RL2094.2 +014200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2094.2 +014300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2094.2 +014400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2094.2 +014500 03 CM-18V0 REDEFINES COMPUTED-A. RL2094.2 +014600 04 COMPUTED-18V0 PIC -9(18). RL2094.2 +014700 04 FILLER PIC X. RL2094.2 +014800 03 FILLER PIC X(50) VALUE SPACE. RL2094.2 +014900 01 TEST-CORRECT. RL2094.2 +015000 02 FILLER PIC X(30) VALUE SPACE. RL2094.2 +015100 02 FILLER PIC X(17) VALUE " CORRECT =". RL2094.2 +015200 02 CORRECT-X. RL2094.2 +015300 03 CORRECT-A PIC X(20) VALUE SPACE. RL2094.2 +015400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2094.2 +015500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2094.2 +015600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2094.2 +015700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2094.2 +015800 03 CR-18V0 REDEFINES CORRECT-A. RL2094.2 +015900 04 CORRECT-18V0 PIC -9(18). RL2094.2 +016000 04 FILLER PIC X. RL2094.2 +016100 03 FILLER PIC X(2) VALUE SPACE. RL2094.2 +016200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2094.2 +016300 01 CCVS-C-1. RL2094.2 +016400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2094.2 +016500- "SS PARAGRAPH-NAME RL2094.2 +016600- " REMARKS". RL2094.2 +016700 02 FILLER PIC X(20) VALUE SPACE. RL2094.2 +016800 01 CCVS-C-2. RL2094.2 +016900 02 FILLER PIC X VALUE SPACE. RL2094.2 +017000 02 FILLER PIC X(6) VALUE "TESTED". RL2094.2 +017100 02 FILLER PIC X(15) VALUE SPACE. RL2094.2 +017200 02 FILLER PIC X(4) VALUE "FAIL". RL2094.2 +017300 02 FILLER PIC X(94) VALUE SPACE. RL2094.2 +017400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2094.2 +017500 01 REC-CT PIC 99 VALUE ZERO. RL2094.2 +017600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2094.2 +017700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2094.2 +017800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2094.2 +017900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2094.2 +018000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2094.2 +018100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2094.2 +018200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2094.2 +018300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2094.2 +018400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2094.2 +018500 01 CCVS-H-1. RL2094.2 +018600 02 FILLER PIC X(39) VALUE SPACES. RL2094.2 +018700 02 FILLER PIC X(42) VALUE RL2094.2 +018800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2094.2 +018900 02 FILLER PIC X(39) VALUE SPACES. RL2094.2 +019000 01 CCVS-H-2A. RL2094.2 +019100 02 FILLER PIC X(40) VALUE SPACE. RL2094.2 +019200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2094.2 +019300 02 FILLER PIC XXXX VALUE RL2094.2 +019400 "4.2 ". RL2094.2 +019500 02 FILLER PIC X(28) VALUE RL2094.2 +019600 " COPY - NOT FOR DISTRIBUTION". RL2094.2 +019700 02 FILLER PIC X(41) VALUE SPACE. RL2094.2 +019800 RL2094.2 +019900 01 CCVS-H-2B. RL2094.2 +020000 02 FILLER PIC X(15) VALUE RL2094.2 +020100 "TEST RESULT OF ". RL2094.2 +020200 02 TEST-ID PIC X(9). RL2094.2 +020300 02 FILLER PIC X(4) VALUE RL2094.2 +020400 " IN ". RL2094.2 +020500 02 FILLER PIC X(12) VALUE RL2094.2 +020600 " HIGH ". RL2094.2 +020700 02 FILLER PIC X(22) VALUE RL2094.2 +020800 " LEVEL VALIDATION FOR ". RL2094.2 +020900 02 FILLER PIC X(58) VALUE RL2094.2 +021000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2094.2 +021100 01 CCVS-H-3. RL2094.2 +021200 02 FILLER PIC X(34) VALUE RL2094.2 +021300 " FOR OFFICIAL USE ONLY ". RL2094.2 +021400 02 FILLER PIC X(58) VALUE RL2094.2 +021500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2094.2 +021600 02 FILLER PIC X(28) VALUE RL2094.2 +021700 " COPYRIGHT 1985 ". RL2094.2 +021800 01 CCVS-E-1. RL2094.2 +021900 02 FILLER PIC X(52) VALUE SPACE. RL2094.2 +022000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2094.2 +022100 02 ID-AGAIN PIC X(9). RL2094.2 +022200 02 FILLER PIC X(45) VALUE SPACES. RL2094.2 +022300 01 CCVS-E-2. RL2094.2 +022400 02 FILLER PIC X(31) VALUE SPACE. RL2094.2 +022500 02 FILLER PIC X(21) VALUE SPACE. RL2094.2 +022600 02 CCVS-E-2-2. RL2094.2 +022700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2094.2 +022800 03 FILLER PIC X VALUE SPACE. RL2094.2 +022900 03 ENDER-DESC PIC X(44) VALUE RL2094.2 +023000 "ERRORS ENCOUNTERED". RL2094.2 +023100 01 CCVS-E-3. RL2094.2 +023200 02 FILLER PIC X(22) VALUE RL2094.2 +023300 " FOR OFFICIAL USE ONLY". RL2094.2 +023400 02 FILLER PIC X(12) VALUE SPACE. RL2094.2 +023500 02 FILLER PIC X(58) VALUE RL2094.2 +023600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2094.2 +023700 02 FILLER PIC X(13) VALUE SPACE. RL2094.2 +023800 02 FILLER PIC X(15) VALUE RL2094.2 +023900 " COPYRIGHT 1985". RL2094.2 +024000 01 CCVS-E-4. RL2094.2 +024100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2094.2 +024200 02 FILLER PIC X(4) VALUE " OF ". RL2094.2 +024300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2094.2 +024400 02 FILLER PIC X(40) VALUE RL2094.2 +024500 " TESTS WERE EXECUTED SUCCESSFULLY". RL2094.2 +024600 01 XXINFO. RL2094.2 +024700 02 FILLER PIC X(19) VALUE RL2094.2 +024800 "*** INFORMATION ***". RL2094.2 +024900 02 INFO-TEXT. RL2094.2 +025000 04 FILLER PIC X(8) VALUE SPACE. RL2094.2 +025100 04 XXCOMPUTED PIC X(20). RL2094.2 +025200 04 FILLER PIC X(5) VALUE SPACE. RL2094.2 +025300 04 XXCORRECT PIC X(20). RL2094.2 +025400 02 INF-ANSI-REFERENCE PIC X(48). RL2094.2 +025500 01 HYPHEN-LINE. RL2094.2 +025600 02 FILLER PIC IS X VALUE IS SPACE. RL2094.2 +025700 02 FILLER PIC IS X(65) VALUE IS "************************RL2094.2 +025800- "*****************************************". RL2094.2 +025900 02 FILLER PIC IS X(54) VALUE IS "************************RL2094.2 +026000- "******************************". RL2094.2 +026100 01 CCVS-PGM-ID PIC X(9) VALUE RL2094.2 +026200 "RL209A". RL2094.2 +026300 PROCEDURE DIVISION. RL2094.2 +026400 CCVS1 SECTION. RL2094.2 +026500 OPEN-FILES. RL2094.2 +026600 OPEN OUTPUT PRINT-FILE. RL2094.2 +026700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2094.2 +026800 MOVE SPACE TO TEST-RESULTS. RL2094.2 +026900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2094.2 +027000 MOVE ZERO TO REC-SKL-SUB. RL2094.2 +027100 PERFORM CCVS-INIT-FILE 9 TIMES. RL2094.2 +027200 CCVS-INIT-FILE. RL2094.2 +027300 ADD 1 TO REC-SKL-SUB. RL2094.2 +027400 MOVE FILE-RECORD-INFO-SKELETON RL2094.2 +027500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2094.2 +027600 CCVS-INIT-EXIT. RL2094.2 +027700 GO TO CCVS1-EXIT. RL2094.2 +027800 CLOSE-FILES. RL2094.2 +027900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2094.2 +028000 TERMINATE-CCVS. RL2094.2 +028100*S EXIT PROGRAM. RL2094.2 +028200*SERMINATE-CALL. RL2094.2 +028300 STOP RUN. RL2094.2 +028400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2094.2 +028500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2094.2 +028600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2094.2 +028700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2094.2 +028800 MOVE "****TEST DELETED****" TO RE-MARK. RL2094.2 +028900 PRINT-DETAIL. RL2094.2 +029000 IF REC-CT NOT EQUAL TO ZERO RL2094.2 +029100 MOVE "." TO PARDOT-X RL2094.2 +029200 MOVE REC-CT TO DOTVALUE. RL2094.2 +029300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2094.2 +029400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2094.2 +029500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2094.2 +029600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2094.2 +029700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2094.2 +029800 MOVE SPACE TO CORRECT-X. RL2094.2 +029900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2094.2 +030000 MOVE SPACE TO RE-MARK. RL2094.2 +030100 HEAD-ROUTINE. RL2094.2 +030200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +030300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +030400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2094.2 +030500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2094.2 +030600 COLUMN-NAMES-ROUTINE. RL2094.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +031000 END-ROUTINE. RL2094.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2094.2 +031200 END-RTN-EXIT. RL2094.2 +031300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +031400 END-ROUTINE-1. RL2094.2 +031500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2094.2 +031600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2094.2 +031700 ADD PASS-COUNTER TO ERROR-HOLD. RL2094.2 +031800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2094.2 +031900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2094.2 +032000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2094.2 +032100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2094.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2094.2 +032300 END-ROUTINE-12. RL2094.2 +032400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2094.2 +032500 IF ERROR-COUNTER IS EQUAL TO ZERO RL2094.2 +032600 MOVE "NO " TO ERROR-TOTAL RL2094.2 +032700 ELSE RL2094.2 +032800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2094.2 +032900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2094.2 +033000 PERFORM WRITE-LINE. RL2094.2 +033100 END-ROUTINE-13. RL2094.2 +033200 IF DELETE-COUNTER IS EQUAL TO ZERO RL2094.2 +033300 MOVE "NO " TO ERROR-TOTAL ELSE RL2094.2 +033400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2094.2 +033500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2094.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +033700 IF INSPECT-COUNTER EQUAL TO ZERO RL2094.2 +033800 MOVE "NO " TO ERROR-TOTAL RL2094.2 +033900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2094.2 +034000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2094.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +034200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2094.2 +034300 WRITE-LINE. RL2094.2 +034400 ADD 1 TO RECORD-COUNT. RL2094.2 +034500 IF RECORD-COUNT GREATER 50 RL2094.2 +034600 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2094.2 +034700 MOVE SPACE TO DUMMY-RECORD RL2094.2 +034800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2094.2 +034900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2094.2 +035000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2094.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2094.2 +035200 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2094.2 +035300 MOVE ZERO TO RECORD-COUNT. RL2094.2 +035400 PERFORM WRT-LN. RL2094.2 +035500 WRT-LN. RL2094.2 +035600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2094.2 +035700 MOVE SPACE TO DUMMY-RECORD. RL2094.2 +035800 BLANK-LINE-PRINT. RL2094.2 +035900 PERFORM WRT-LN. RL2094.2 +036000 FAIL-ROUTINE. RL2094.2 +036100 IF COMPUTED-X NOT EQUAL TO SPACE RL2094.2 +036200 GO TO FAIL-ROUTINE-WRITE. RL2094.2 +036300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2094.2 +036400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2094.2 +036500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2094.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2094.2 +036800 GO TO FAIL-ROUTINE-EX. RL2094.2 +036900 FAIL-ROUTINE-WRITE. RL2094.2 +037000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2094.2 +037100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2094.2 +037200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2094.2 +037300 MOVE SPACES TO COR-ANSI-REFERENCE. RL2094.2 +037400 FAIL-ROUTINE-EX. EXIT. RL2094.2 +037500 BAIL-OUT. RL2094.2 +037600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2094.2 +037700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2094.2 +037800 BAIL-OUT-WRITE. RL2094.2 +037900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2094.2 +038000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2094.2 +038100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2094.2 +038200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2094.2 +038300 BAIL-OUT-EX. EXIT. RL2094.2 +038400 CCVS1-EXIT. RL2094.2 +038500 EXIT. RL2094.2 +038600 SECT-RL201-001 SECTION. RL2094.2 +038700 REL-INIT-001. RL2094.2 +038800 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL2094.2 +038900 OPEN OUTPUT RL-FS1. RL2094.2 +039000 MOVE "RL-FS1" TO XFILE-NAME (1). RL2094.2 +039100 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2094.2 +039200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2094.2 +039300 MOVE 000120 TO XRECORD-LENGTH (1). RL2094.2 +039400 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2094.2 +039500 MOVE 0001 TO XBLOCK-SIZE (1). RL2094.2 +039600 MOVE 000500 TO RECORDS-IN-FILE (1). RL2094.2 +039700 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2094.2 +039800 MOVE "S" TO XLABEL-TYPE (1). RL2094.2 +039900 MOVE 000001 TO XRECORD-NUMBER (1). RL2094.2 +040000 REL-TEST-001. RL2094.2 +040100 MOVE 120 TO WRK-SIZE. RL2094.2 +040200 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL2094.2 +040300 WRITE RL-FS1R1-F-G-120 RL2094.2 +040400 INVALID KEY GO TO REL-FAIL-001. RL2094.2 +040500 IF XRECORD-NUMBER (1) EQUAL TO 250 RL2094.2 +040600 GO TO REL-TEST-001-2. RL2094.2 +040700 ADD 000001 TO XRECORD-NUMBER (1). RL2094.2 +040800 GO TO REL-TEST-001. RL2094.2 +040900 REL-TEST-001-1. RL2094.2 +041000 MOVE 140 TO WRK-SIZE XRECORD-LENGTH(1). RL2094.2 +041100 MOVE FILE-RECORD-INFO(1) TO RL-FS1R1-F-G-120. RL2094.2 +041200 WRITE RL-FS1R1-F-G-120 RL2094.2 +041300 INVALID KEY GO TO REL-FAIL-001. RL2094.2 +041400 IF XRECORD-NUMBER(1) EQUAL TO 500 RL2094.2 +041500 GO TO REL-WRITE-001. RL2094.2 +041600 REL-TEST-001-2. RL2094.2 +041700 ADD 000001 TO XRECORD-NUMBER(1). RL2094.2 +041800 GO TO REL-TEST-001-1. RL2094.2 +041900 REL-DELETE-001. RL2094.2 +042000 PERFORM DE-LETE. RL2094.2 +042100 GO TO REL-WRITE-001. RL2094.2 +042200 REL-FAIL-001. RL2094.2 +042300 PERFORM FAIL. RL2094.2 +042400 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2094.2 +042500 REL-WRITE-001. RL2094.2 +042600 MOVE "REL-TEST-001" TO PAR-NAME RL2094.2 +042700 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2094.2 +042800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2094.2 +042900 PERFORM PRINT-DETAIL. RL2094.2 +043000 CLOSE RL-FS1. RL2094.2 +043100 REL-INIT-002. RL2094.2 +043200 OPEN INPUT RL-FS1. RL2094.2 +043300 MOVE ZERO TO WRK-CS-09V00. RL2094.2 +043400 REL-TEST-002. RL2094.2 +043500 READ RL-FS1 RL2094.2 +043600 AT END GO TO REL-TEST-002-1. RL2094.2 +043700 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2094.2 +043800 ADD 1 TO WRK-CS-09V00. RL2094.2 +043900 IF WRK-CS-09V00 GREATER 500 RL2094.2 +044000 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2094.2 +044100 GO TO REL-TEST-002-1. RL2094.2 +044200 GO TO REL-TEST-002. RL2094.2 +044300 REL-DELETE-002. RL2094.2 +044400 PERFORM DE-LETE. RL2094.2 +044500 PERFORM PRINT-DETAIL. RL2094.2 +044600 REL-TEST-002-1. RL2094.2 +044700 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2094.2 +044800 PERFORM FAIL RL2094.2 +044900 ELSE RL2094.2 +045000 PERFORM PASS. RL2094.2 +045100 GO TO REL-WRITE-002. RL2094.2 +045200 REL-WRITE-002. RL2094.2 +045300 MOVE "REL-TEST-002" TO PAR-NAME. RL2094.2 +045400 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2094.2 +045500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2094.2 +045600 PERFORM PRINT-DETAIL. RL2094.2 +045700 CLOSE RL-FS1. RL2094.2 +045800 CCVS-EXIT SECTION. RL2094.2 +045900 CCVS-999999. RL2094.2 +046000 GO TO CLOSE-FILES. RL2094.2 diff --git a/tests/cobol85/RL/RL210A.CBL b/tests/cobol85/RL/RL210A.CBL new file mode 100644 index 00000000..c15b0bcb --- /dev/null +++ b/tests/cobol85/RL/RL210A.CBL @@ -0,0 +1,487 @@ +000100 IDENTIFICATION DIVISION. RL2104.2 +000200 PROGRAM-ID. RL2104.2 +000300 RL210A. RL2104.2 +000400**************************************************************** RL2104.2 +000500* * RL2104.2 +000600* VALIDATION FOR:- * RL2104.2 +000700* * RL2104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2104.2 +000900* * RL2104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2104.2 +001100* * RL2104.2 +001200**************************************************************** RL2104.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO CREATE A RELATIVE FILE * RL2104.2 +001400* SEQUENTIALLY WITH VARIABLE LENGTH RECORDS AND VERIFY THAT * RL2104.2 +001500* IT WAS CREATED CORRECTLY. * RL2104.2 +001600* THE PROGRAM WILL CREATE A RELATIVE FILE OF 500 VARIABLE * RL2104.2 +001700* LENGTH RECORDS. * RL2104.2 +001800* THE RECORD SIZE WILL BE 120 TO 140 CHARACTERS. * RL2104.2 +001900* RL2104.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2104.2 +002100* PROGRAM ARE: RL2104.2 +002200* RL2104.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2104.2 +002400* RELATIVE I-O DATA FILE RL2104.2 +002500* X-55 SYSTEM PRINTER RL2104.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES RL2104.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME RL2104.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE RL2104.2 +002900* X-82 SOURCE-COMPUTER RL2104.2 +003000* X-83 OBJECT-COMPUTER. RL2104.2 +003100* RL2104.2 +003200**************************************************************** RL2104.2 +003300 ENVIRONMENT DIVISION. RL2104.2 +003400 CONFIGURATION SECTION. RL2104.2 +003500 SOURCE-COMPUTER. RL2104.2 +003600 Linux. RL2104.2 +003700 OBJECT-COMPUTER. RL2104.2 +003800 Linux. RL2104.2 +003900 INPUT-OUTPUT SECTION. RL2104.2 +004000 FILE-CONTROL. RL2104.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2104.2 +004200 "report.log". RL2104.2 +004300 SELECT RL-VS1 ASSIGN TO RL2104.2 +004400 "XXXXX021" RL2104.2 +004500 ORGANIZATION IS RELATIVE. RL2104.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2104.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2104.2 +004800 DATA DIVISION. RL2104.2 +004900 FILE SECTION. RL2104.2 +005000 FD PRINT-FILE. RL2104.2 +005100 01 PRINT-REC PICTURE X(120). RL2104.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2104.2 +005300 FD RL-VS1 RL2104.2 +005400 LABEL RECORDS STANDARD RL2104.2 +005500*C VALUE OF RL2104.2 +005600*C OCLABELID RL2104.2 +005700*C IS RL2104.2 +005800*C "OCDUMMY" RL2104.2 +005900*G SYSIN RL2104.2 +006000 BLOCK CONTAINS 1 RECORDS RL2104.2 +006100 RECORD IS VARYING. RL2104.2 +006200 01 RL-VS1R2-F-G-140. RL2104.2 +006300 02 FILLER PIC X(120). RL2104.2 +006400 02 RL-VS1R2-F-G-121-124 PIC 9(4). RL2104.2 +006500 02 RL-GROUP. RL2104.2 +006600 03 RL-VS1R2-F-G-125-140 PIC X OCCURS 1 TO 16 RL2104.2 +006700 DEPENDING ON RL-VS1R2-F-G-121-124. RL2104.2 +006800 01 RL-VS1R1-F-G-120. RL2104.2 +006900 02 FILLER PIC X(120). RL2104.2 +007000 WORKING-STORAGE SECTION. RL2104.2 +007100 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2104.2 +007200 01 FILE-RECORD-INFORMATION-REC. RL2104.2 +007300 03 FILE-RECORD-INFO-SKELETON. RL2104.2 +007400 05 FILLER PICTURE X(48) VALUE RL2104.2 +007500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2104.2 +007600 05 FILLER PICTURE X(46) VALUE RL2104.2 +007700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2104.2 +007800 05 FILLER PICTURE X(26) VALUE RL2104.2 +007900 ",LFIL=000000,ORG= ,LBLR= ". RL2104.2 +008000 05 FILLER PICTURE X(37) VALUE RL2104.2 +008100 ",RECKEY= ". RL2104.2 +008200 05 FILLER PICTURE X(38) VALUE RL2104.2 +008300 ",ALTKEY1= ". RL2104.2 +008400 05 FILLER PICTURE X(38) VALUE RL2104.2 +008500 ",ALTKEY2= ". RL2104.2 +008600 05 FILLER PICTURE X(7) VALUE SPACE.RL2104.2 +008700 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2104.2 +008800 05 FILE-RECORD-INFO-P1-120. RL2104.2 +008900 07 FILLER PIC X(5). RL2104.2 +009000 07 XFILE-NAME PIC X(6). RL2104.2 +009100 07 FILLER PIC X(8). RL2104.2 +009200 07 XRECORD-NAME PIC X(6). RL2104.2 +009300 07 FILLER PIC X(1). RL2104.2 +009400 07 REELUNIT-NUMBER PIC 9(1). RL2104.2 +009500 07 FILLER PIC X(7). RL2104.2 +009600 07 XRECORD-NUMBER PIC 9(6). RL2104.2 +009700 07 FILLER PIC X(6). RL2104.2 +009800 07 UPDATE-NUMBER PIC 9(2). RL2104.2 +009900 07 FILLER PIC X(5). RL2104.2 +010000 07 ODO-NUMBER PIC 9(4). RL2104.2 +010100 07 FILLER PIC X(5). RL2104.2 +010200 07 XPROGRAM-NAME PIC X(5). RL2104.2 +010300 07 FILLER PIC X(7). RL2104.2 +010400 07 XRECORD-LENGTH PIC 9(6). RL2104.2 +010500 07 FILLER PIC X(7). RL2104.2 +010600 07 CHARS-OR-RECORDS PIC X(2). RL2104.2 +010700 07 FILLER PIC X(1). RL2104.2 +010800 07 XBLOCK-SIZE PIC 9(4). RL2104.2 +010900 07 FILLER PIC X(6). RL2104.2 +011000 07 RECORDS-IN-FILE PIC 9(6). RL2104.2 +011100 07 FILLER PIC X(5). RL2104.2 +011200 07 XFILE-ORGANIZATION PIC X(2). RL2104.2 +011300 07 FILLER PIC X(6). RL2104.2 +011400 07 XLABEL-TYPE PIC X(1). RL2104.2 +011500 05 FILE-RECORD-INFO-P121-240. RL2104.2 +011600 07 FILLER PIC X(8). RL2104.2 +011700 07 XRECORD-KEY PIC X(29). RL2104.2 +011800 07 FILLER PIC X(9). RL2104.2 +011900 07 ALTERNATE-KEY1 PIC X(29). RL2104.2 +012000 07 FILLER PIC X(9). RL2104.2 +012100 07 ALTERNATE-KEY2 PIC X(29). RL2104.2 +012200 07 FILLER PIC X(7). RL2104.2 +012300 01 TEST-RESULTS. RL2104.2 +012400 02 FILLER PIC X VALUE SPACE. RL2104.2 +012500 02 FEATURE PIC X(20) VALUE SPACE. RL2104.2 +012600 02 FILLER PIC X VALUE SPACE. RL2104.2 +012700 02 P-OR-F PIC X(5) VALUE SPACE. RL2104.2 +012800 02 FILLER PIC X VALUE SPACE. RL2104.2 +012900 02 PAR-NAME. RL2104.2 +013000 03 FILLER PIC X(19) VALUE SPACE. RL2104.2 +013100 03 PARDOT-X PIC X VALUE SPACE. RL2104.2 +013200 03 DOTVALUE PIC 99 VALUE ZERO. RL2104.2 +013300 02 FILLER PIC X(8) VALUE SPACE. RL2104.2 +013400 02 RE-MARK PIC X(61). RL2104.2 +013500 01 TEST-COMPUTED. RL2104.2 +013600 02 FILLER PIC X(30) VALUE SPACE. RL2104.2 +013700 02 FILLER PIC X(17) VALUE RL2104.2 +013800 " COMPUTED=". RL2104.2 +013900 02 COMPUTED-X. RL2104.2 +014000 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2104.2 +014100 03 COMPUTED-N REDEFINES COMPUTED-A RL2104.2 +014200 PIC -9(9).9(9). RL2104.2 +014300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2104.2 +014400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2104.2 +014500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2104.2 +014600 03 CM-18V0 REDEFINES COMPUTED-A. RL2104.2 +014700 04 COMPUTED-18V0 PIC -9(18). RL2104.2 +014800 04 FILLER PIC X. RL2104.2 +014900 03 FILLER PIC X(50) VALUE SPACE. RL2104.2 +015000 01 TEST-CORRECT. RL2104.2 +015100 02 FILLER PIC X(30) VALUE SPACE. RL2104.2 +015200 02 FILLER PIC X(17) VALUE " CORRECT =". RL2104.2 +015300 02 CORRECT-X. RL2104.2 +015400 03 CORRECT-A PIC X(20) VALUE SPACE. RL2104.2 +015500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2104.2 +015600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2104.2 +015700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2104.2 +015800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2104.2 +015900 03 CR-18V0 REDEFINES CORRECT-A. RL2104.2 +016000 04 CORRECT-18V0 PIC -9(18). RL2104.2 +016100 04 FILLER PIC X. RL2104.2 +016200 03 FILLER PIC X(2) VALUE SPACE. RL2104.2 +016300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2104.2 +016400 01 CCVS-C-1. RL2104.2 +016500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2104.2 +016600- "SS PARAGRAPH-NAME RL2104.2 +016700- " REMARKS". RL2104.2 +016800 02 FILLER PIC X(20) VALUE SPACE. RL2104.2 +016900 01 CCVS-C-2. RL2104.2 +017000 02 FILLER PIC X VALUE SPACE. RL2104.2 +017100 02 FILLER PIC X(6) VALUE "TESTED". RL2104.2 +017200 02 FILLER PIC X(15) VALUE SPACE. RL2104.2 +017300 02 FILLER PIC X(4) VALUE "FAIL". RL2104.2 +017400 02 FILLER PIC X(94) VALUE SPACE. RL2104.2 +017500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2104.2 +017600 01 REC-CT PIC 99 VALUE ZERO. RL2104.2 +017700 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2104.2 +017800 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2104.2 +017900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2104.2 +018000 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2104.2 +018100 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2104.2 +018200 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2104.2 +018300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2104.2 +018400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2104.2 +018500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2104.2 +018600 01 CCVS-H-1. RL2104.2 +018700 02 FILLER PIC X(39) VALUE SPACES. RL2104.2 +018800 02 FILLER PIC X(42) VALUE RL2104.2 +018900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2104.2 +019000 02 FILLER PIC X(39) VALUE SPACES. RL2104.2 +019100 01 CCVS-H-2A. RL2104.2 +019200 02 FILLER PIC X(40) VALUE SPACE. RL2104.2 +019300 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2104.2 +019400 02 FILLER PIC XXXX VALUE RL2104.2 +019500 "4.2 ". RL2104.2 +019600 02 FILLER PIC X(28) VALUE RL2104.2 +019700 " COPY - NOT FOR DISTRIBUTION". RL2104.2 +019800 02 FILLER PIC X(41) VALUE SPACE. RL2104.2 +019900 RL2104.2 +020000 01 CCVS-H-2B. RL2104.2 +020100 02 FILLER PIC X(15) VALUE RL2104.2 +020200 "TEST RESULT OF ". RL2104.2 +020300 02 TEST-ID PIC X(9). RL2104.2 +020400 02 FILLER PIC X(4) VALUE RL2104.2 +020500 " IN ". RL2104.2 +020600 02 FILLER PIC X(12) VALUE RL2104.2 +020700 " HIGH ". RL2104.2 +020800 02 FILLER PIC X(22) VALUE RL2104.2 +020900 " LEVEL VALIDATION FOR ". RL2104.2 +021000 02 FILLER PIC X(58) VALUE RL2104.2 +021100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2104.2 +021200 01 CCVS-H-3. RL2104.2 +021300 02 FILLER PIC X(34) VALUE RL2104.2 +021400 " FOR OFFICIAL USE ONLY ". RL2104.2 +021500 02 FILLER PIC X(58) VALUE RL2104.2 +021600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2104.2 +021700 02 FILLER PIC X(28) VALUE RL2104.2 +021800 " COPYRIGHT 1985 ". RL2104.2 +021900 01 CCVS-E-1. RL2104.2 +022000 02 FILLER PIC X(52) VALUE SPACE. RL2104.2 +022100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2104.2 +022200 02 ID-AGAIN PIC X(9). RL2104.2 +022300 02 FILLER PIC X(45) VALUE SPACES. RL2104.2 +022400 01 CCVS-E-2. RL2104.2 +022500 02 FILLER PIC X(31) VALUE SPACE. RL2104.2 +022600 02 FILLER PIC X(21) VALUE SPACE. RL2104.2 +022700 02 CCVS-E-2-2. RL2104.2 +022800 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2104.2 +022900 03 FILLER PIC X VALUE SPACE. RL2104.2 +023000 03 ENDER-DESC PIC X(44) VALUE RL2104.2 +023100 "ERRORS ENCOUNTERED". RL2104.2 +023200 01 CCVS-E-3. RL2104.2 +023300 02 FILLER PIC X(22) VALUE RL2104.2 +023400 " FOR OFFICIAL USE ONLY". RL2104.2 +023500 02 FILLER PIC X(12) VALUE SPACE. RL2104.2 +023600 02 FILLER PIC X(58) VALUE RL2104.2 +023700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2104.2 +023800 02 FILLER PIC X(13) VALUE SPACE. RL2104.2 +023900 02 FILLER PIC X(15) VALUE RL2104.2 +024000 " COPYRIGHT 1985". RL2104.2 +024100 01 CCVS-E-4. RL2104.2 +024200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2104.2 +024300 02 FILLER PIC X(4) VALUE " OF ". RL2104.2 +024400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2104.2 +024500 02 FILLER PIC X(40) VALUE RL2104.2 +024600 " TESTS WERE EXECUTED SUCCESSFULLY". RL2104.2 +024700 01 XXINFO. RL2104.2 +024800 02 FILLER PIC X(19) VALUE RL2104.2 +024900 "*** INFORMATION ***". RL2104.2 +025000 02 INFO-TEXT. RL2104.2 +025100 04 FILLER PIC X(8) VALUE SPACE. RL2104.2 +025200 04 XXCOMPUTED PIC X(20). RL2104.2 +025300 04 FILLER PIC X(5) VALUE SPACE. RL2104.2 +025400 04 XXCORRECT PIC X(20). RL2104.2 +025500 02 INF-ANSI-REFERENCE PIC X(48). RL2104.2 +025600 01 HYPHEN-LINE. RL2104.2 +025700 02 FILLER PIC IS X VALUE IS SPACE. RL2104.2 +025800 02 FILLER PIC IS X(65) VALUE IS "************************RL2104.2 +025900- "*****************************************". RL2104.2 +026000 02 FILLER PIC IS X(54) VALUE IS "************************RL2104.2 +026100- "******************************". RL2104.2 +026200 01 CCVS-PGM-ID PIC X(9) VALUE RL2104.2 +026300 "RL210A". RL2104.2 +026400 PROCEDURE DIVISION. RL2104.2 +026500 CCVS1 SECTION. RL2104.2 +026600 OPEN-FILES. RL2104.2 +026700 OPEN OUTPUT PRINT-FILE. RL2104.2 +026800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2104.2 +026900 MOVE SPACE TO TEST-RESULTS. RL2104.2 +027000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2104.2 +027100 MOVE ZERO TO REC-SKL-SUB. RL2104.2 +027200 PERFORM CCVS-INIT-FILE 9 TIMES. RL2104.2 +027300 CCVS-INIT-FILE. RL2104.2 +027400 ADD 1 TO REC-SKL-SUB. RL2104.2 +027500 MOVE FILE-RECORD-INFO-SKELETON RL2104.2 +027600 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2104.2 +027700 CCVS-INIT-EXIT. RL2104.2 +027800 GO TO CCVS1-EXIT. RL2104.2 +027900 CLOSE-FILES. RL2104.2 +028000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2104.2 +028100 TERMINATE-CCVS. RL2104.2 +028200*S EXIT PROGRAM. RL2104.2 +028300*SERMINATE-CALL. RL2104.2 +028400 STOP RUN. RL2104.2 +028500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2104.2 +028600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2104.2 +028700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2104.2 +028800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2104.2 +028900 MOVE "****TEST DELETED****" TO RE-MARK. RL2104.2 +029000 PRINT-DETAIL. RL2104.2 +029100 IF REC-CT NOT EQUAL TO ZERO RL2104.2 +029200 MOVE "." TO PARDOT-X RL2104.2 +029300 MOVE REC-CT TO DOTVALUE. RL2104.2 +029400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2104.2 +029500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2104.2 +029600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2104.2 +029700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2104.2 +029800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2104.2 +029900 MOVE SPACE TO CORRECT-X. RL2104.2 +030000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2104.2 +030100 MOVE SPACE TO RE-MARK. RL2104.2 +030200 HEAD-ROUTINE. RL2104.2 +030300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +030400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +030500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2104.2 +030600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2104.2 +030700 COLUMN-NAMES-ROUTINE. RL2104.2 +030800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +030900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +031000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +031100 END-ROUTINE. RL2104.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2104.2 +031300 END-RTN-EXIT. RL2104.2 +031400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +031500 END-ROUTINE-1. RL2104.2 +031600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2104.2 +031700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2104.2 +031800 ADD PASS-COUNTER TO ERROR-HOLD. RL2104.2 +031900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2104.2 +032000 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2104.2 +032100 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2104.2 +032200 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2104.2 +032300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2104.2 +032400 END-ROUTINE-12. RL2104.2 +032500 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2104.2 +032600 IF ERROR-COUNTER IS EQUAL TO ZERO RL2104.2 +032700 MOVE "NO " TO ERROR-TOTAL RL2104.2 +032800 ELSE RL2104.2 +032900 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2104.2 +033000 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2104.2 +033100 PERFORM WRITE-LINE. RL2104.2 +033200 END-ROUTINE-13. RL2104.2 +033300 IF DELETE-COUNTER IS EQUAL TO ZERO RL2104.2 +033400 MOVE "NO " TO ERROR-TOTAL ELSE RL2104.2 +033500 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2104.2 +033600 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2104.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +033800 IF INSPECT-COUNTER EQUAL TO ZERO RL2104.2 +033900 MOVE "NO " TO ERROR-TOTAL RL2104.2 +034000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2104.2 +034100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2104.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +034300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2104.2 +034400 WRITE-LINE. RL2104.2 +034500 ADD 1 TO RECORD-COUNT. RL2104.2 +034600 IF RECORD-COUNT GREATER 50 RL2104.2 +034700 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2104.2 +034800 MOVE SPACE TO DUMMY-RECORD RL2104.2 +034900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2104.2 +035000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2104.2 +035100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2104.2 +035200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2104.2 +035300 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2104.2 +035400 MOVE ZERO TO RECORD-COUNT. RL2104.2 +035500 PERFORM WRT-LN. RL2104.2 +035600 WRT-LN. RL2104.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2104.2 +035800 MOVE SPACE TO DUMMY-RECORD. RL2104.2 +035900 BLANK-LINE-PRINT. RL2104.2 +036000 PERFORM WRT-LN. RL2104.2 +036100 FAIL-ROUTINE. RL2104.2 +036200 IF COMPUTED-X NOT EQUAL TO SPACE RL2104.2 +036300 GO TO FAIL-ROUTINE-WRITE. RL2104.2 +036400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2104.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2104.2 +036600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2104.2 +036700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +036800 MOVE SPACES TO INF-ANSI-REFERENCE. RL2104.2 +036900 GO TO FAIL-ROUTINE-EX. RL2104.2 +037000 FAIL-ROUTINE-WRITE. RL2104.2 +037100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2104.2 +037200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2104.2 +037300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2104.2 +037400 MOVE SPACES TO COR-ANSI-REFERENCE. RL2104.2 +037500 FAIL-ROUTINE-EX. EXIT. RL2104.2 +037600 BAIL-OUT. RL2104.2 +037700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2104.2 +037800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2104.2 +037900 BAIL-OUT-WRITE. RL2104.2 +038000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2104.2 +038100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2104.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2104.2 +038300 MOVE SPACES TO INF-ANSI-REFERENCE. RL2104.2 +038400 BAIL-OUT-EX. EXIT. RL2104.2 +038500 CCVS1-EXIT. RL2104.2 +038600 EXIT. RL2104.2 +038700 SECT-RL210A-001 SECTION. RL2104.2 +038800 REL-INIT-001. RL2104.2 +038900 MOVE "FILE CREATE RL-VS1" TO FEATURE. RL2104.2 +039000 OPEN OUTPUT RL-VS1. RL2104.2 +039100 MOVE "RL-VS1" TO XFILE-NAME (1). RL2104.2 +039200 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2104.2 +039300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2104.2 +039400 MOVE 000120 TO XRECORD-LENGTH (1). RL2104.2 +039500 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2104.2 +039600 MOVE 0001 TO XBLOCK-SIZE (1). RL2104.2 +039700 MOVE 000500 TO RECORDS-IN-FILE (1). RL2104.2 +039800 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2104.2 +039900 MOVE "S" TO XLABEL-TYPE (1). RL2104.2 +040000 MOVE 000001 TO XRECORD-NUMBER (1). RL2104.2 +040100 REL-TEST-001. RL2104.2 +040200 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-VS1R1-F-G-120. RL2104.2 +040300 IF XRECORD-NUMBER (1) < 201 RL2104.2 +040400 WRITE RL-VS1R1-F-G-120 RL2104.2 +040500 INVALID KEY GO TO REL-FAIL-001 RL2104.2 +040600 ELSE RL2104.2 +040700 MOVE 16 TO RL-VS1R2-F-G-121-124 RL2104.2 +040800 MOVE "ABCDEFGHIJKLMNOP" TO RL-GROUP RL2104.2 +040900 WRITE RL-VS1R2-F-G-140 RL2104.2 +041000 INVALID KEY GO TO REL-FAIL-001. RL2104.2 +041100 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2104.2 +041200 GO TO REL-WRITE-001. RL2104.2 +041300 ADD 000001 TO XRECORD-NUMBER (1). RL2104.2 +041400 GO TO REL-TEST-001. RL2104.2 +041500 REL-DELETE-001. RL2104.2 +041600 PERFORM DE-LETE. RL2104.2 +041700 GO TO REL-WRITE-001. RL2104.2 +041800 REL-FAIL-001. RL2104.2 +041900 PERFORM FAIL. RL2104.2 +042000 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2104.2 +042100 REL-WRITE-001. RL2104.2 +042200 MOVE "REL-TEST-001" TO PAR-NAME RL2104.2 +042300 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2104.2 +042400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2104.2 +042500 PERFORM PRINT-DETAIL. RL2104.2 +042600 CLOSE RL-VS1. RL2104.2 +042700 REL-INIT-002. RL2104.2 +042800 OPEN INPUT RL-VS1. RL2104.2 +042900 MOVE ZERO TO WRK-CS-09V00. RL2104.2 +043000 REL-TEST-002. RL2104.2 +043100 MOVE SPACES TO RL-VS1R2-F-G-140. RL2104.2 +043200 READ RL-VS1 RL2104.2 +043300 AT END GO TO REL-TEST-002-2. RL2104.2 +043400 MOVE RL-VS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2104.2 +043500 ADD 1 TO WRK-CS-09V00. RL2104.2 +043600 IF WRK-CS-09V00 GREATER 500 RL2104.2 +043700 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2104.2 +043800 GO TO REL-TEST-002-2. RL2104.2 +043900 REL-TEST-002-1-1. RL2104.2 +044000 MOVE "VIII-31 3.8.4 GR 10B" TO ANSI-REFERENCE. RL2104.2 +044100 MOVE "REL-TEST-002-1-1" TO PAR-NAME. RL2104.2 +044200 IF XLABEL-TYPE (1) NOT = "S" RL2104.2 +044300 MOVE XLABEL-TYPE (1) TO COMPUTED-X RL2104.2 +044400 MOVE "S" TO CORRECT-X RL2104.2 +044500 MOVE "INVALID RECORD READ" TO RE-MARK RL2104.2 +044600 PERFORM FAIL RL2104.2 +044700 PERFORM PRINT-DETAIL. RL2104.2 +044800 REL-TEST-002-1-2. RL2104.2 +044900 MOVE "VIII-31 3.8.4 GR 10C" TO ANSI-REFERENCE. RL2104.2 +045000 MOVE "REL-TEST-002-1-2" TO PAR-NAME. RL2104.2 +045100 IF XRECORD-NUMBER (1) > 200 RL2104.2 +045200 IF RL-VS1R2-F-G-121-124 NOT = 16 RL2104.2 +045300 MOVE RL-VS1R2-F-G-121-124 TO COMPUTED-N RL2104.2 +045400 MOVE 16 TO CORRECT-N RL2104.2 +045500 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2104.2 +045600 PERFORM FAIL RL2104.2 +045700 PERFORM PRINT-DETAIL. RL2104.2 +045800 REL-TEST-002-1-3. RL2104.2 +045900 MOVE "VIII-31 3.8.4 GR 10B" TO ANSI-REFERENCE. RL2104.2 +046000 MOVE "REL-TEST-002-1-3" TO PAR-NAME. RL2104.2 +046100 IF XRECORD-NUMBER (1) > 200 RL2104.2 +046200 IF RL-GROUP NOT = "ABCDEFGHIJKLMNOP" RL2104.2 +046300 MOVE "ABCDEFGHIJKLMNOP" TO CORRECT-X RL2104.2 +046400 MOVE RL-GROUP TO COMPUTED-X RL2104.2 +046500 MOVE "INVALID RECORD READ" TO RE-MARK RL2104.2 +046600 PERFORM FAIL RL2104.2 +046700 PERFORM PRINT-DETAIL. RL2104.2 +046800 GO TO REL-TEST-002. RL2104.2 +046900 REL-DELETE-002. RL2104.2 +047000 PERFORM DE-LETE. RL2104.2 +047100 PERFORM PRINT-DETAIL. RL2104.2 +047200 REL-TEST-002-2. RL2104.2 +047300 MOVE "REL-TEST-002-2" TO PAR-NAME. RL2104.2 +047400 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2104.2 +047500 PERFORM FAIL RL2104.2 +047600 ELSE RL2104.2 +047700 PERFORM PASS. RL2104.2 +047800 GO TO REL-WRITE-002. RL2104.2 +047900 REL-WRITE-002. RL2104.2 +048000 MOVE "REL-TEST-002" TO PAR-NAME. RL2104.2 +048100 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2104.2 +048200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2104.2 +048300 PERFORM PRINT-DETAIL. RL2104.2 +048400 CLOSE RL-VS1. RL2104.2 +048500 CCVS-EXIT SECTION. RL2104.2 +048600 CCVS-999999. RL2104.2 +048700 GO TO CLOSE-FILES. RL2104.2 diff --git a/tests/cobol85/RL/RL211A.CBL b/tests/cobol85/RL/RL211A.CBL new file mode 100644 index 00000000..00f62a4a --- /dev/null +++ b/tests/cobol85/RL/RL211A.CBL @@ -0,0 +1,553 @@ +000100 IDENTIFICATION DIVISION. RL2114.2 +000200 PROGRAM-ID. RL2114.2 +000300 RL211A. RL2114.2 +000400**************************************************************** RL2114.2 +000500* * RL2114.2 +000600* VALIDATION FOR:- * RL2114.2 +000700* * RL2114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2114.2 +000900* * RL2114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2114.2 +001100* * RL2114.2 +001200**************************************************************** RL2114.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO CREATE A RELATIVE FILE * RL2114.2 +001400* SEQUENTIALLY WITH VARIABLE LENGTH RECORDS AND VERIFY THAT * RL2114.2 +001500* IT WAS CREATED CORRECTLY. * RL2114.2 +001600* THE PROGRAM WILL CREATE A RELATIVE FILE OF 500 VARIABLE * RL2114.2 +001700* LENGTH RECORDS. * RL2114.2 +001800* THE RECORD SIZE WILL BE 120 TO 140 CHARACTERS. * RL2114.2 +001900* RL2114.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS RL2114.2 +002100* PROGRAM ARE: RL2114.2 +002200* RL2114.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2114.2 +002400* RELATIVE I-O DATA FILE RL2114.2 +002500* X-55 SYSTEM PRINTER RL2114.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES RL2114.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME RL2114.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE RL2114.2 +002900* X-82 SOURCE-COMPUTER RL2114.2 +003000* X-83 OBJECT-COMPUTER. RL2114.2 +003100* RL2114.2 +003200**************************************************************** RL2114.2 +003300 ENVIRONMENT DIVISION. RL2114.2 +003400 CONFIGURATION SECTION. RL2114.2 +003500 SOURCE-COMPUTER. RL2114.2 +003600 Linux. RL2114.2 +003700 OBJECT-COMPUTER. RL2114.2 +003800 Linux. RL2114.2 +003900 INPUT-OUTPUT SECTION. RL2114.2 +004000 FILE-CONTROL. RL2114.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2114.2 +004200 "report.log". RL2114.2 +004300 SELECT RL-VS1 ASSIGN TO RL2114.2 +004400 "XXXXX021" RL2114.2 +004500 ORGANIZATION IS RELATIVE. RL2114.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2114.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2114.2 +004800 DATA DIVISION. RL2114.2 +004900 FILE SECTION. RL2114.2 +005000 FD PRINT-FILE. RL2114.2 +005100 01 PRINT-REC PICTURE X(120). RL2114.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2114.2 +005300 FD RL-VS1 RL2114.2 +005400 LABEL RECORDS STANDARD RL2114.2 +005500*C VALUE OF RL2114.2 +005600*C OCLABELID RL2114.2 +005700*C IS RL2114.2 +005800*C "OCDUMMY" RL2114.2 +005900*G SYSIN RL2114.2 +006000 BLOCK CONTAINS 1 RECORDS RL2114.2 +006100 RECORD IS VARYING. RL2114.2 +006200 01 RL-VS1R1-F-G-140. RL2114.2 +006300 02 FILLER PIC X. RL2114.2 +006400 02 FILLER PIC X(7). RL2114.2 +006500 02 FILLER PIC X(108). RL2114.2 +006600 02 RL-VS1R1-F-G-117-119 PIC 9(3). RL2114.2 +006700 02 RL-GROUP. RL2114.2 +006800 03 RL-VS1R1-F-G-120-140 PIC X OCCURS 1 TO 21 RL2114.2 +006900 DEPENDING ON RL-VS1R1-F-G-117-119. RL2114.2 +007000 WORKING-STORAGE SECTION. RL2114.2 +007100 01 WS-VS1R1-F-G-140. RL2114.2 +007200 02 FILLER PIC X(116). RL2114.2 +007300 02 WS-VS1R1-F-G-117-119 PIC 9(3). RL2114.2 +007400 02 WS-VS1R1-F-G-120-140 PIC X(21). RL2114.2 +007500 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2114.2 +007600 01 FILE-RECORD-INFORMATION-REC. RL2114.2 +007700 03 FILE-RECORD-INFO-SKELETON. RL2114.2 +007800 05 FILLER PICTURE X(48) VALUE RL2114.2 +007900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2114.2 +008000 05 FILLER PICTURE X(46) VALUE RL2114.2 +008100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2114.2 +008200 05 FILLER PICTURE X(26) VALUE RL2114.2 +008300 ",LFIL=000000,ORG= ,LBLR= ". RL2114.2 +008400 05 FILLER PICTURE X(37) VALUE RL2114.2 +008500 ",RECKEY= ". RL2114.2 +008600 05 FILLER PICTURE X(38) VALUE RL2114.2 +008700 ",ALTKEY1= ". RL2114.2 +008800 05 FILLER PICTURE X(38) VALUE RL2114.2 +008900 ",ALTKEY2= ". RL2114.2 +009000 05 FILLER PICTURE X(7) VALUE SPACE.RL2114.2 +009100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2114.2 +009200 05 FILE-RECORD-INFO-P1-120. RL2114.2 +009300 07 FILLER PIC X(5). RL2114.2 +009400 07 XFILE-NAME PIC X(6). RL2114.2 +009500 07 FILLER PIC X(8). RL2114.2 +009600 07 XRECORD-NAME PIC X(6). RL2114.2 +009700 07 FILLER PIC X(1). RL2114.2 +009800 07 REELUNIT-NUMBER PIC 9(1). RL2114.2 +009900 07 FILLER PIC X(7). RL2114.2 +010000 07 XRECORD-NUMBER PIC 9(6). RL2114.2 +010100 07 FILLER PIC X(6). RL2114.2 +010200 07 UPDATE-NUMBER PIC 9(2). RL2114.2 +010300 07 FILLER PIC X(5). RL2114.2 +010400 07 ODO-NUMBER PIC 9(4). RL2114.2 +010500 07 FILLER PIC X(5). RL2114.2 +010600 07 XPROGRAM-NAME PIC X(5). RL2114.2 +010700 07 FILLER PIC X(7). RL2114.2 +010800 07 XRECORD-LENGTH PIC 9(6). RL2114.2 +010900 07 FILLER PIC X(7). RL2114.2 +011000 07 CHARS-OR-RECORDS PIC X(2). RL2114.2 +011100 07 FILLER PIC X(1). RL2114.2 +011200 07 XBLOCK-SIZE PIC 9(4). RL2114.2 +011300 07 FILLER PIC X(6). RL2114.2 +011400 07 RECORDS-IN-FILE PIC 9(6). RL2114.2 +011500 07 FILLER PIC X(5). RL2114.2 +011600 07 XFILE-ORGANIZATION PIC X(2). RL2114.2 +011700 07 FILLER PIC X(6). RL2114.2 +011800 07 XLABEL-TYPE PIC X(1). RL2114.2 +011900 05 FILE-RECORD-INFO-P121-240. RL2114.2 +012000 07 FILLER PIC X(8). RL2114.2 +012100 07 XRECORD-KEY PIC X(29). RL2114.2 +012200 07 FILLER PIC X(9). RL2114.2 +012300 07 ALTERNATE-KEY1 PIC X(29). RL2114.2 +012400 07 FILLER PIC X(9). RL2114.2 +012500 07 ALTERNATE-KEY2 PIC X(29). RL2114.2 +012600 07 FILLER PIC X(7). RL2114.2 +012700 01 TEST-RESULTS. RL2114.2 +012800 02 FILLER PIC X VALUE SPACE. RL2114.2 +012900 02 FEATURE PIC X(20) VALUE SPACE. RL2114.2 +013000 02 FILLER PIC X VALUE SPACE. RL2114.2 +013100 02 P-OR-F PIC X(5) VALUE SPACE. RL2114.2 +013200 02 FILLER PIC X VALUE SPACE. RL2114.2 +013300 02 PAR-NAME. RL2114.2 +013400 03 FILLER PIC X(19) VALUE SPACE. RL2114.2 +013500 03 PARDOT-X PIC X VALUE SPACE. RL2114.2 +013600 03 DOTVALUE PIC 99 VALUE ZERO. RL2114.2 +013700 02 FILLER PIC X(8) VALUE SPACE. RL2114.2 +013800 02 RE-MARK PIC X(61). RL2114.2 +013900 01 TEST-COMPUTED. RL2114.2 +014000 02 FILLER PIC X(30) VALUE SPACE. RL2114.2 +014100 02 FILLER PIC X(17) VALUE RL2114.2 +014200 " COMPUTED=". RL2114.2 +014300 02 COMPUTED-X. RL2114.2 +014400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2114.2 +014500 03 COMPUTED-N REDEFINES COMPUTED-A RL2114.2 +014600 PIC -9(9).9(9). RL2114.2 +014700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2114.2 +014800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2114.2 +014900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2114.2 +015000 03 CM-18V0 REDEFINES COMPUTED-A. RL2114.2 +015100 04 COMPUTED-18V0 PIC -9(18). RL2114.2 +015200 04 FILLER PIC X. RL2114.2 +015300 03 FILLER PIC X(50) VALUE SPACE. RL2114.2 +015400 01 TEST-CORRECT. RL2114.2 +015500 02 FILLER PIC X(30) VALUE SPACE. RL2114.2 +015600 02 FILLER PIC X(17) VALUE " CORRECT =". RL2114.2 +015700 02 CORRECT-X. RL2114.2 +015800 03 CORRECT-A PIC X(20) VALUE SPACE. RL2114.2 +015900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2114.2 +016000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2114.2 +016100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2114.2 +016200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2114.2 +016300 03 CR-18V0 REDEFINES CORRECT-A. RL2114.2 +016400 04 CORRECT-18V0 PIC -9(18). RL2114.2 +016500 04 FILLER PIC X. RL2114.2 +016600 03 FILLER PIC X(2) VALUE SPACE. RL2114.2 +016700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2114.2 +016800 01 CCVS-C-1. RL2114.2 +016900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2114.2 +017000- "SS PARAGRAPH-NAME RL2114.2 +017100- " REMARKS". RL2114.2 +017200 02 FILLER PIC X(20) VALUE SPACE. RL2114.2 +017300 01 CCVS-C-2. RL2114.2 +017400 02 FILLER PIC X VALUE SPACE. RL2114.2 +017500 02 FILLER PIC X(6) VALUE "TESTED". RL2114.2 +017600 02 FILLER PIC X(15) VALUE SPACE. RL2114.2 +017700 02 FILLER PIC X(4) VALUE "FAIL". RL2114.2 +017800 02 FILLER PIC X(94) VALUE SPACE. RL2114.2 +017900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2114.2 +018000 01 REC-CT PIC 99 VALUE ZERO. RL2114.2 +018100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2114.2 +018200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2114.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2114.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2114.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2114.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2114.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2114.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2114.2 +018900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2114.2 +019000 01 CCVS-H-1. RL2114.2 +019100 02 FILLER PIC X(39) VALUE SPACES. RL2114.2 +019200 02 FILLER PIC X(42) VALUE RL2114.2 +019300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2114.2 +019400 02 FILLER PIC X(39) VALUE SPACES. RL2114.2 +019500 01 CCVS-H-2A. RL2114.2 +019600 02 FILLER PIC X(40) VALUE SPACE. RL2114.2 +019700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2114.2 +019800 02 FILLER PIC XXXX VALUE RL2114.2 +019900 "4.2 ". RL2114.2 +020000 02 FILLER PIC X(28) VALUE RL2114.2 +020100 " COPY - NOT FOR DISTRIBUTION". RL2114.2 +020200 02 FILLER PIC X(41) VALUE SPACE. RL2114.2 +020300 RL2114.2 +020400 01 CCVS-H-2B. RL2114.2 +020500 02 FILLER PIC X(15) VALUE RL2114.2 +020600 "TEST RESULT OF ". RL2114.2 +020700 02 TEST-ID PIC X(9). RL2114.2 +020800 02 FILLER PIC X(4) VALUE RL2114.2 +020900 " IN ". RL2114.2 +021000 02 FILLER PIC X(12) VALUE RL2114.2 +021100 " HIGH ". RL2114.2 +021200 02 FILLER PIC X(22) VALUE RL2114.2 +021300 " LEVEL VALIDATION FOR ". RL2114.2 +021400 02 FILLER PIC X(58) VALUE RL2114.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2114.2 +021600 01 CCVS-H-3. RL2114.2 +021700 02 FILLER PIC X(34) VALUE RL2114.2 +021800 " FOR OFFICIAL USE ONLY ". RL2114.2 +021900 02 FILLER PIC X(58) VALUE RL2114.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2114.2 +022100 02 FILLER PIC X(28) VALUE RL2114.2 +022200 " COPYRIGHT 1985 ". RL2114.2 +022300 01 CCVS-E-1. RL2114.2 +022400 02 FILLER PIC X(52) VALUE SPACE. RL2114.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2114.2 +022600 02 ID-AGAIN PIC X(9). RL2114.2 +022700 02 FILLER PIC X(45) VALUE SPACES. RL2114.2 +022800 01 CCVS-E-2. RL2114.2 +022900 02 FILLER PIC X(31) VALUE SPACE. RL2114.2 +023000 02 FILLER PIC X(21) VALUE SPACE. RL2114.2 +023100 02 CCVS-E-2-2. RL2114.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2114.2 +023300 03 FILLER PIC X VALUE SPACE. RL2114.2 +023400 03 ENDER-DESC PIC X(44) VALUE RL2114.2 +023500 "ERRORS ENCOUNTERED". RL2114.2 +023600 01 CCVS-E-3. RL2114.2 +023700 02 FILLER PIC X(22) VALUE RL2114.2 +023800 " FOR OFFICIAL USE ONLY". RL2114.2 +023900 02 FILLER PIC X(12) VALUE SPACE. RL2114.2 +024000 02 FILLER PIC X(58) VALUE RL2114.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2114.2 +024200 02 FILLER PIC X(13) VALUE SPACE. RL2114.2 +024300 02 FILLER PIC X(15) VALUE RL2114.2 +024400 " COPYRIGHT 1985". RL2114.2 +024500 01 CCVS-E-4. RL2114.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2114.2 +024700 02 FILLER PIC X(4) VALUE " OF ". RL2114.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2114.2 +024900 02 FILLER PIC X(40) VALUE RL2114.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". RL2114.2 +025100 01 XXINFO. RL2114.2 +025200 02 FILLER PIC X(19) VALUE RL2114.2 +025300 "*** INFORMATION ***". RL2114.2 +025400 02 INFO-TEXT. RL2114.2 +025500 04 FILLER PIC X(8) VALUE SPACE. RL2114.2 +025600 04 XXCOMPUTED PIC X(20). RL2114.2 +025700 04 FILLER PIC X(5) VALUE SPACE. RL2114.2 +025800 04 XXCORRECT PIC X(20). RL2114.2 +025900 02 INF-ANSI-REFERENCE PIC X(48). RL2114.2 +026000 01 HYPHEN-LINE. RL2114.2 +026100 02 FILLER PIC IS X VALUE IS SPACE. RL2114.2 +026200 02 FILLER PIC IS X(65) VALUE IS "************************RL2114.2 +026300- "*****************************************". RL2114.2 +026400 02 FILLER PIC IS X(54) VALUE IS "************************RL2114.2 +026500- "******************************". RL2114.2 +026600 01 CCVS-PGM-ID PIC X(9) VALUE RL2114.2 +026700 "RL211A". RL2114.2 +026800 PROCEDURE DIVISION. RL2114.2 +026900 CCVS1 SECTION. RL2114.2 +027000 OPEN-FILES. RL2114.2 +027100 OPEN OUTPUT PRINT-FILE. RL2114.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2114.2 +027300 MOVE SPACE TO TEST-RESULTS. RL2114.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2114.2 +027500 MOVE ZERO TO REC-SKL-SUB. RL2114.2 +027600 PERFORM CCVS-INIT-FILE 9 TIMES. RL2114.2 +027700 CCVS-INIT-FILE. RL2114.2 +027800 ADD 1 TO REC-SKL-SUB. RL2114.2 +027900 MOVE FILE-RECORD-INFO-SKELETON RL2114.2 +028000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2114.2 +028100 CCVS-INIT-EXIT. RL2114.2 +028200 GO TO CCVS1-EXIT. RL2114.2 +028300 CLOSE-FILES. RL2114.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2114.2 +028500 TERMINATE-CCVS. RL2114.2 +028600*S EXIT PROGRAM. RL2114.2 +028700*SERMINATE-CALL. RL2114.2 +028800 STOP RUN. RL2114.2 +028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2114.2 +029000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2114.2 +029100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2114.2 +029200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2114.2 +029300 MOVE "****TEST DELETED****" TO RE-MARK. RL2114.2 +029400 PRINT-DETAIL. RL2114.2 +029500 IF REC-CT NOT EQUAL TO ZERO RL2114.2 +029600 MOVE "." TO PARDOT-X RL2114.2 +029700 MOVE REC-CT TO DOTVALUE. RL2114.2 +029800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2114.2 +029900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2114.2 +030000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2114.2 +030100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2114.2 +030200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2114.2 +030300 MOVE SPACE TO CORRECT-X. RL2114.2 +030400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2114.2 +030500 MOVE SPACE TO RE-MARK. RL2114.2 +030600 HEAD-ROUTINE. RL2114.2 +030700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +030800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +030900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2114.2 +031000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2114.2 +031100 COLUMN-NAMES-ROUTINE. RL2114.2 +031200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +031300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +031500 END-ROUTINE. RL2114.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2114.2 +031700 END-RTN-EXIT. RL2114.2 +031800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +031900 END-ROUTINE-1. RL2114.2 +032000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2114.2 +032100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2114.2 +032200 ADD PASS-COUNTER TO ERROR-HOLD. RL2114.2 +032300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2114.2 +032400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2114.2 +032500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2114.2 +032600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2114.2 +032700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2114.2 +032800 END-ROUTINE-12. RL2114.2 +032900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2114.2 +033000 IF ERROR-COUNTER IS EQUAL TO ZERO RL2114.2 +033100 MOVE "NO " TO ERROR-TOTAL RL2114.2 +033200 ELSE RL2114.2 +033300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2114.2 +033400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2114.2 +033500 PERFORM WRITE-LINE. RL2114.2 +033600 END-ROUTINE-13. RL2114.2 +033700 IF DELETE-COUNTER IS EQUAL TO ZERO RL2114.2 +033800 MOVE "NO " TO ERROR-TOTAL ELSE RL2114.2 +033900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2114.2 +034000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2114.2 +034100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +034200 IF INSPECT-COUNTER EQUAL TO ZERO RL2114.2 +034300 MOVE "NO " TO ERROR-TOTAL RL2114.2 +034400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2114.2 +034500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2114.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +034700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2114.2 +034800 WRITE-LINE. RL2114.2 +034900 ADD 1 TO RECORD-COUNT. RL2114.2 +035000 IF RECORD-COUNT GREATER 50 RL2114.2 +035100 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2114.2 +035200 MOVE SPACE TO DUMMY-RECORD RL2114.2 +035300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2114.2 +035400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2114.2 +035500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2114.2 +035600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2114.2 +035700 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2114.2 +035800 MOVE ZERO TO RECORD-COUNT. RL2114.2 +035900 PERFORM WRT-LN. RL2114.2 +036000 WRT-LN. RL2114.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2114.2 +036200 MOVE SPACE TO DUMMY-RECORD. RL2114.2 +036300 BLANK-LINE-PRINT. RL2114.2 +036400 PERFORM WRT-LN. RL2114.2 +036500 FAIL-ROUTINE. RL2114.2 +036600 IF COMPUTED-X NOT EQUAL TO SPACE RL2114.2 +036700 GO TO FAIL-ROUTINE-WRITE. RL2114.2 +036800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2114.2 +036900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2114.2 +037000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2114.2 +037100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +037200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2114.2 +037300 GO TO FAIL-ROUTINE-EX. RL2114.2 +037400 FAIL-ROUTINE-WRITE. RL2114.2 +037500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2114.2 +037600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2114.2 +037700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2114.2 +037800 MOVE SPACES TO COR-ANSI-REFERENCE. RL2114.2 +037900 FAIL-ROUTINE-EX. EXIT. RL2114.2 +038000 BAIL-OUT. RL2114.2 +038100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2114.2 +038200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2114.2 +038300 BAIL-OUT-WRITE. RL2114.2 +038400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2114.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2114.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2114.2 +038700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2114.2 +038800 BAIL-OUT-EX. EXIT. RL2114.2 +038900 CCVS1-EXIT. RL2114.2 +039000 EXIT. RL2114.2 +039100 SECT-RL211A-001 SECTION. RL2114.2 +039200 REL-INIT-001. RL2114.2 +039300 MOVE "FILE CREATE RL-VS1" TO FEATURE. RL2114.2 +039400 OPEN OUTPUT RL-VS1. RL2114.2 +039500 MOVE "RL-VS1" TO XFILE-NAME (1). RL2114.2 +039600 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2114.2 +039700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2114.2 +039800 MOVE 000120 TO XRECORD-LENGTH (1). RL2114.2 +039900 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2114.2 +040000 MOVE 0001 TO XBLOCK-SIZE (1). RL2114.2 +040100 MOVE 000500 TO RECORDS-IN-FILE (1). RL2114.2 +040200 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2114.2 +040300 MOVE "S" TO XLABEL-TYPE (1). RL2114.2 +040400 MOVE 000001 TO XRECORD-NUMBER (1). RL2114.2 +040500 REL-TEST-001. RL2114.2 +040600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-VS1R1-F-G-140. RL2114.2 +040700 IF XRECORD-NUMBER (1) > 32 RL2114.2 +040800 MOVE 21 TO RL-VS1R1-F-G-117-119. RL2114.2 +040900 IF XRECORD-NUMBER (1) = 32 RL2114.2 +041000 MOVE 16 TO RL-VS1R1-F-G-117-119. RL2114.2 +041100 IF XRECORD-NUMBER (1) = 31 RL2114.2 +041200 MOVE 6 TO RL-VS1R1-F-G-117-119. RL2114.2 +041300 IF XRECORD-NUMBER (1) < 31 RL2114.2 +041400 MOVE 21 TO RL-VS1R1-F-G-117-119. RL2114.2 +041500 IF XRECORD-NUMBER (1) < 21 RL2114.2 +041600 MOVE 11 TO RL-VS1R1-F-G-117-119. RL2114.2 +041700 IF XRECORD-NUMBER (1) < 11 RL2114.2 +041800 MOVE 1 TO RL-VS1R1-F-G-117-119. RL2114.2 +041900 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO RL-GROUP. RL2114.2 +042000 WRITE RL-VS1R1-F-G-140 RL2114.2 +042100 INVALID KEY GO TO REL-FAIL-001. RL2114.2 +042200 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2114.2 +042300 GO TO REL-WRITE-001. RL2114.2 +042400 ADD 000001 TO XRECORD-NUMBER (1). RL2114.2 +042500 GO TO REL-TEST-001. RL2114.2 +042600 REL-DELETE-001. RL2114.2 +042700 PERFORM DE-LETE. RL2114.2 +042800 GO TO REL-WRITE-001. RL2114.2 +042900 REL-FAIL-001. RL2114.2 +043000 PERFORM FAIL. RL2114.2 +043100 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2114.2 +043200 REL-WRITE-001. RL2114.2 +043300 MOVE "REL-TEST-001" TO PAR-NAME RL2114.2 +043400 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2114.2 +043500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2114.2 +043600 PERFORM PRINT-DETAIL. RL2114.2 +043700 CLOSE RL-VS1. RL2114.2 +043800 OPEN INPUT RL-VS1. RL2114.2 +043900 MOVE ZERO TO WRK-CS-09V00. RL2114.2 +044000 REL-INIT-1. RL2114.2 +044100 MOVE SPACES TO RL-VS1R1-F-G-140. RL2114.2 +044200 READ RL-VS1 RL2114.2 +044300 AT END GO TO REL-TEST-002-2. RL2114.2 +044400 MOVE RL-VS1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1). RL2114.2 +044500 MOVE RL-VS1R1-F-G-140 TO WS-VS1R1-F-G-140. RL2114.2 +044600 ADD 1 TO WRK-CS-09V00. RL2114.2 +044700 IF WRK-CS-09V00 GREATER 500 RL2114.2 +044800 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2114.2 +044900 GO TO REL-TEST-002-2. RL2114.2 +045000 REL-TEST-1. RL2114.2 +045100 MOVE "VII-31 3.8.4 GR 5 & 5A" TO ANSI-REFERENCE. RL2114.2 +045200 MOVE "REL-TEST-1" TO PAR-NAME. RL2114.2 +045300 IF WRK-CS-09V00 < 11 RL2114.2 +045400 IF WS-VS1R1-F-G-120-140 = RL2114.2 +045500 "A " RL2114.2 +045600 PERFORM PASS RL2114.2 +045700* PERFORM PRINT-DETAIL RL2114.2 +045800 ELSE RL2114.2 +045900 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +046000 MOVE "A " TO CORRECT-X RL2114.2 +046100 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +046200 PERFORM FAIL RL2114.2 +046300 PERFORM PRINT-DETAIL. RL2114.2 +046400 REL-TEST-2. RL2114.2 +046500 MOVE "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE. RL2114.2 +046600 MOVE "REL-TEST-2" TO PAR-NAME. RL2114.2 +046700 IF (WRK-CS-09V00 > 10 AND < 21) RL2114.2 +046800 IF WS-VS1R1-F-G-120-140 = RL2114.2 +046900 "ABCDEFGHIJK " RL2114.2 +047000 PERFORM PASS RL2114.2 +047100* PERFORM PRINT-DETAIL RL2114.2 +047200 ELSE RL2114.2 +047300 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +047400 MOVE "ABCDEFGHIJK " TO CORRECT-X RL2114.2 +047500 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +047600 PERFORM FAIL RL2114.2 +047700 PERFORM PRINT-DETAIL. RL2114.2 +047800 REL-TEST-3. RL2114.2 +047900 MOVE "VII-31 3.8.4 GR 5 & 5B" TO ANSI-REFERENCE. RL2114.2 +048000 MOVE "REL-TEST-3" TO PAR-NAME. RL2114.2 +048100 IF (WRK-CS-09V00 > 20 AND < 31) RL2114.2 +048200 IF WS-VS1R1-F-G-120-140 = RL2114.2 +048300 "ABCDEFGHIJKLMNOPQRSTU" RL2114.2 +048400 PERFORM PASS RL2114.2 +048500* PERFORM PRINT-DETAIL RL2114.2 +048600 ELSE RL2114.2 +048700 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +048800 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO CORRECT-X RL2114.2 +048900 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +049000 PERFORM FAIL RL2114.2 +049100 PERFORM PRINT-DETAIL. RL2114.2 +049200 REL-TEST-4. RL2114.2 +049300 MOVE "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE. RL2114.2 +049400 MOVE "REL-TEST-4" TO PAR-NAME. RL2114.2 +049500 IF WRK-CS-09V00 = 31 RL2114.2 +049600 IF WS-VS1R1-F-G-120-140 = RL2114.2 +049700 "ABCDEF " RL2114.2 +049800 PERFORM PASS RL2114.2 +049900* PERFORM PRINT-DETAIL RL2114.2 +050000 ELSE RL2114.2 +050100 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +050200 MOVE "ABCDEF " TO CORRECT-X RL2114.2 +050300 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +050400 PERFORM FAIL RL2114.2 +050500 PERFORM PRINT-DETAIL. RL2114.2 +050600 REL-TEST-5. RL2114.2 +050700 MOVE "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE. RL2114.2 +050800 MOVE "REL-TEST-5" TO PAR-NAME. RL2114.2 +050900 IF WRK-CS-09V00 = 32 RL2114.2 +051000 IF WS-VS1R1-F-G-120-140 = RL2114.2 +051100 "ABCDEFGHIJKLMNOP " RL2114.2 +051200 PERFORM PASS RL2114.2 +051300* PERFORM PRINT-DETAIL RL2114.2 +051400 ELSE RL2114.2 +051500 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +051600 MOVE "ABCDEFGHIJKLMNOP " TO CORRECT-X RL2114.2 +051700 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +051800 PERFORM FAIL RL2114.2 +051900 PERFORM PRINT-DETAIL. RL2114.2 +052000 REL-TEST-6. RL2114.2 +052100 MOVE "VII-31 3.8.4 GR 5 & 5B" TO ANSI-REFERENCE. RL2114.2 +052200 MOVE "REL-TEST-6" TO PAR-NAME. RL2114.2 +052300 IF WRK-CS-09V00 > 32 RL2114.2 +052400 IF WS-VS1R1-F-G-120-140 = RL2114.2 +052500 "ABCDEFGHIJKLMNOPQRSTU" RL2114.2 +052600 PERFORM PASS RL2114.2 +052700* PERFORM PRINT-DETAIL RL2114.2 +052800 ELSE RL2114.2 +052900 MOVE WS-VS1R1-F-G-120-140 TO COMPUTED-X RL2114.2 +053000 MOVE "ABCDEFGHIJKLMNOPQRSTU" TO CORRECT-X RL2114.2 +053100 MOVE "WRONG LENGTH RECORD" TO RE-MARK RL2114.2 +053200 PERFORM FAIL RL2114.2 +053300 PERFORM PRINT-DETAIL. RL2114.2 +053400 GO TO REL-INIT-1. RL2114.2 +053500 REL-DELETE-002. RL2114.2 +053600 PERFORM DE-LETE. RL2114.2 +053700 PERFORM PRINT-DETAIL. RL2114.2 +053800 REL-TEST-002-2. RL2114.2 +053900 MOVE "REL-TEST-002-2" TO PAR-NAME. RL2114.2 +054000 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2114.2 +054100 PERFORM FAIL RL2114.2 +054200 ELSE RL2114.2 +054300 PERFORM PASS. RL2114.2 +054400 GO TO REL-WRITE-002. RL2114.2 +054500 REL-WRITE-002. RL2114.2 +054600 MOVE "REL-TEST-002" TO PAR-NAME. RL2114.2 +054700 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2114.2 +054800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2114.2 +054900 PERFORM PRINT-DETAIL. RL2114.2 +055000 CLOSE RL-VS1. RL2114.2 +055100 CCVS-EXIT SECTION. RL2114.2 +055200 CCVS-999999. RL2114.2 +055300 GO TO CLOSE-FILES. RL2114.2 diff --git a/tests/cobol85/RL/RL212A.CBL b/tests/cobol85/RL/RL212A.CBL new file mode 100644 index 00000000..606732bd --- /dev/null +++ b/tests/cobol85/RL/RL212A.CBL @@ -0,0 +1,444 @@ +000100 IDENTIFICATION DIVISION. RL2124.2 +000200 PROGRAM-ID. RL2124.2 +000300 RL212A. RL2124.2 +000400**************************************************************** RL2124.2 +000500* * RL2124.2 +000600* VALIDATION FOR:- * RL2124.2 +000700* * RL2124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2124.2 +000900* * RL2124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2124.2 +001100* * RL2124.2 +001200**************************************************************** RL2124.2 +001300* THIS RUN UNIT IS THE FIRST OF A SERIES OF TWO PROGRAMS * RL2124.2 +001400* PROCESSES A RELATIVE I-O FILE. THE FUNCTION OF THIS * RL2124.2 +001500* PROGRAM IS TO CREATE A RELATIVE FILE SEQUENTIALLY * RL2124.2 +001600* (ACCESS MODE SEQUENTIAL) AND VERIFY THAT IT WAS * RL2124.2 +001700* CREATED CORRECTLY. THE FILE IS IDENTIFED AS "RL-FS1" * RL2124.2 +001800* AND WILL CONTAIN 500 RECORDS OF 120 CHARACTERS. * RL2124.2 +001900* * RL2124.2 +002000* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS * RL2124.2 +002100* PROGRAM ARE: * RL2124.2 +002200* * RL2124.2 +002300* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL2124.2 +002400* RELATIVE I-O DATA FILE * RL2124.2 +002500* X-55 SYSTEM PRINTER * RL2124.2 +002600* X-69 ADDITIONAL VALUE OF CLAUSES * RL2124.2 +002700* X-74 VALUE OF IMPLEMENTOR-NAME * RL2124.2 +002800* X-75 OBJECT OF VALUE OF CLAUSE * RL2124.2 +002900* X-82 SOURCE-COMPUTER * RL2124.2 +003000* X-83 OBJECT-COMPUTER. * RL2124.2 +003100* * RL2124.2 +003200**************************************************************** RL2124.2 +003300 ENVIRONMENT DIVISION. RL2124.2 +003400 CONFIGURATION SECTION. RL2124.2 +003500 SOURCE-COMPUTER. RL2124.2 +003600 Linux. RL2124.2 +003700 OBJECT-COMPUTER. RL2124.2 +003800 Linux. RL2124.2 +003900 INPUT-OUTPUT SECTION. RL2124.2 +004000 FILE-CONTROL. RL2124.2 +004100 SELECT PRINT-FILE ASSIGN TO RL2124.2 +004200 "report.log". RL2124.2 +004300 SELECT RL-FS1 ASSIGN TO RL2124.2 +004400 "XXXXX021" RL2124.2 +004500 ORGANIZATION IS RELATIVE. RL2124.2 +004600* ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH RL2124.2 +004700* SEQUENTIAL HAD BEEN SPECIFIED. RL2124.2 +004800 DATA DIVISION. RL2124.2 +004900 FILE SECTION. RL2124.2 +005000 FD PRINT-FILE. RL2124.2 +005100 01 PRINT-REC PICTURE X(120). RL2124.2 +005200 01 DUMMY-RECORD PICTURE X(120). RL2124.2 +005300 FD RL-FS1 RL2124.2 +005400 LABEL RECORDS STANDARD RL2124.2 +005500*C VALUE OF RL2124.2 +005600*C OCLABELID RL2124.2 +005700*C IS RL2124.2 +005800*C "OCDUMMY" RL2124.2 +005900*G SYSIN RL2124.2 +006000 BLOCK CONTAINS 1 RECORDS RL2124.2 +006100 RECORD CONTAINS 120 CHARACTERS. RL2124.2 +006200 01 RL-FS1R1-F-G-120. RL2124.2 +006300 02 FILLER PIC X(120). RL2124.2 +006400 WORKING-STORAGE SECTION. RL2124.2 +006500 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2124.2 +006600 01 FILE-RECORD-INFORMATION-REC. RL2124.2 +006700 03 FILE-RECORD-INFO-SKELETON. RL2124.2 +006800 05 FILLER PICTURE X(48) VALUE RL2124.2 +006900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2124.2 +007000 05 FILLER PICTURE X(46) VALUE RL2124.2 +007100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2124.2 +007200 05 FILLER PICTURE X(26) VALUE RL2124.2 +007300 ",LFIL=000000,ORG= ,LBLR= ". RL2124.2 +007400 05 FILLER PICTURE X(37) VALUE RL2124.2 +007500 ",RECKEY= ". RL2124.2 +007600 05 FILLER PICTURE X(38) VALUE RL2124.2 +007700 ",ALTKEY1= ". RL2124.2 +007800 05 FILLER PICTURE X(38) VALUE RL2124.2 +007900 ",ALTKEY2= ". RL2124.2 +008000 05 FILLER PICTURE X(7) VALUE SPACE.RL2124.2 +008100 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2124.2 +008200 05 FILE-RECORD-INFO-P1-120. RL2124.2 +008300 07 FILLER PIC X(5). RL2124.2 +008400 07 XFILE-NAME PIC X(6). RL2124.2 +008500 07 FILLER PIC X(8). RL2124.2 +008600 07 XRECORD-NAME PIC X(6). RL2124.2 +008700 07 FILLER PIC X(1). RL2124.2 +008800 07 REELUNIT-NUMBER PIC 9(1). RL2124.2 +008900 07 FILLER PIC X(7). RL2124.2 +009000 07 XRECORD-NUMBER PIC 9(6). RL2124.2 +009100 07 FILLER PIC X(6). RL2124.2 +009200 07 UPDATE-NUMBER PIC 9(2). RL2124.2 +009300 07 FILLER PIC X(5). RL2124.2 +009400 07 ODO-NUMBER PIC 9(4). RL2124.2 +009500 07 FILLER PIC X(5). RL2124.2 +009600 07 XPROGRAM-NAME PIC X(5). RL2124.2 +009700 07 FILLER PIC X(7). RL2124.2 +009800 07 XRECORD-LENGTH PIC 9(6). RL2124.2 +009900 07 FILLER PIC X(7). RL2124.2 +010000 07 CHARS-OR-RECORDS PIC X(2). RL2124.2 +010100 07 FILLER PIC X(1). RL2124.2 +010200 07 XBLOCK-SIZE PIC 9(4). RL2124.2 +010300 07 FILLER PIC X(6). RL2124.2 +010400 07 RECORDS-IN-FILE PIC 9(6). RL2124.2 +010500 07 FILLER PIC X(5). RL2124.2 +010600 07 XFILE-ORGANIZATION PIC X(2). RL2124.2 +010700 07 FILLER PIC X(6). RL2124.2 +010800 07 XLABEL-TYPE PIC X(1). RL2124.2 +010900 05 FILE-RECORD-INFO-P121-240. RL2124.2 +011000 07 FILLER PIC X(8). RL2124.2 +011100 07 XRECORD-KEY PIC X(29). RL2124.2 +011200 07 FILLER PIC X(9). RL2124.2 +011300 07 ALTERNATE-KEY1 PIC X(29). RL2124.2 +011400 07 FILLER PIC X(9). RL2124.2 +011500 07 ALTERNATE-KEY2 PIC X(29). RL2124.2 +011600 07 FILLER PIC X(7). RL2124.2 +011700 01 TEST-RESULTS. RL2124.2 +011800 02 FILLER PIC X VALUE SPACE. RL2124.2 +011900 02 FEATURE PIC X(20) VALUE SPACE. RL2124.2 +012000 02 FILLER PIC X VALUE SPACE. RL2124.2 +012100 02 P-OR-F PIC X(5) VALUE SPACE. RL2124.2 +012200 02 FILLER PIC X VALUE SPACE. RL2124.2 +012300 02 PAR-NAME. RL2124.2 +012400 03 FILLER PIC X(19) VALUE SPACE. RL2124.2 +012500 03 PARDOT-X PIC X VALUE SPACE. RL2124.2 +012600 03 DOTVALUE PIC 99 VALUE ZERO. RL2124.2 +012700 02 FILLER PIC X(8) VALUE SPACE. RL2124.2 +012800 02 RE-MARK PIC X(61). RL2124.2 +012900 01 TEST-COMPUTED. RL2124.2 +013000 02 FILLER PIC X(30) VALUE SPACE. RL2124.2 +013100 02 FILLER PIC X(17) VALUE RL2124.2 +013200 " COMPUTED=". RL2124.2 +013300 02 COMPUTED-X. RL2124.2 +013400 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2124.2 +013500 03 COMPUTED-N REDEFINES COMPUTED-A RL2124.2 +013600 PIC -9(9).9(9). RL2124.2 +013700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2124.2 +013800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2124.2 +013900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2124.2 +014000 03 CM-18V0 REDEFINES COMPUTED-A. RL2124.2 +014100 04 COMPUTED-18V0 PIC -9(18). RL2124.2 +014200 04 FILLER PIC X. RL2124.2 +014300 03 FILLER PIC X(50) VALUE SPACE. RL2124.2 +014400 01 TEST-CORRECT. RL2124.2 +014500 02 FILLER PIC X(30) VALUE SPACE. RL2124.2 +014600 02 FILLER PIC X(17) VALUE " CORRECT =". RL2124.2 +014700 02 CORRECT-X. RL2124.2 +014800 03 CORRECT-A PIC X(20) VALUE SPACE. RL2124.2 +014900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2124.2 +015000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2124.2 +015100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2124.2 +015200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2124.2 +015300 03 CR-18V0 REDEFINES CORRECT-A. RL2124.2 +015400 04 CORRECT-18V0 PIC -9(18). RL2124.2 +015500 04 FILLER PIC X. RL2124.2 +015600 03 FILLER PIC X(2) VALUE SPACE. RL2124.2 +015700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2124.2 +015800 01 CCVS-C-1. RL2124.2 +015900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2124.2 +016000- "SS PARAGRAPH-NAME RL2124.2 +016100- " REMARKS". RL2124.2 +016200 02 FILLER PIC X(20) VALUE SPACE. RL2124.2 +016300 01 CCVS-C-2. RL2124.2 +016400 02 FILLER PIC X VALUE SPACE. RL2124.2 +016500 02 FILLER PIC X(6) VALUE "TESTED". RL2124.2 +016600 02 FILLER PIC X(15) VALUE SPACE. RL2124.2 +016700 02 FILLER PIC X(4) VALUE "FAIL". RL2124.2 +016800 02 FILLER PIC X(94) VALUE SPACE. RL2124.2 +016900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2124.2 +017000 01 REC-CT PIC 99 VALUE ZERO. RL2124.2 +017100 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2124.2 +017200 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2124.2 +017300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2124.2 +017400 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2124.2 +017500 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2124.2 +017600 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2124.2 +017700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2124.2 +017800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2124.2 +017900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2124.2 +018000 01 CCVS-H-1. RL2124.2 +018100 02 FILLER PIC X(39) VALUE SPACES. RL2124.2 +018200 02 FILLER PIC X(42) VALUE RL2124.2 +018300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2124.2 +018400 02 FILLER PIC X(39) VALUE SPACES. RL2124.2 +018500 01 CCVS-H-2A. RL2124.2 +018600 02 FILLER PIC X(40) VALUE SPACE. RL2124.2 +018700 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2124.2 +018800 02 FILLER PIC XXXX VALUE RL2124.2 +018900 "4.2 ". RL2124.2 +019000 02 FILLER PIC X(28) VALUE RL2124.2 +019100 " COPY - NOT FOR DISTRIBUTION". RL2124.2 +019200 02 FILLER PIC X(41) VALUE SPACE. RL2124.2 +019300 RL2124.2 +019400 01 CCVS-H-2B. RL2124.2 +019500 02 FILLER PIC X(15) VALUE RL2124.2 +019600 "TEST RESULT OF ". RL2124.2 +019700 02 TEST-ID PIC X(9). RL2124.2 +019800 02 FILLER PIC X(4) VALUE RL2124.2 +019900 " IN ". RL2124.2 +020000 02 FILLER PIC X(12) VALUE RL2124.2 +020100 " HIGH ". RL2124.2 +020200 02 FILLER PIC X(22) VALUE RL2124.2 +020300 " LEVEL VALIDATION FOR ". RL2124.2 +020400 02 FILLER PIC X(58) VALUE RL2124.2 +020500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2124.2 +020600 01 CCVS-H-3. RL2124.2 +020700 02 FILLER PIC X(34) VALUE RL2124.2 +020800 " FOR OFFICIAL USE ONLY ". RL2124.2 +020900 02 FILLER PIC X(58) VALUE RL2124.2 +021000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2124.2 +021100 02 FILLER PIC X(28) VALUE RL2124.2 +021200 " COPYRIGHT 1985 ". RL2124.2 +021300 01 CCVS-E-1. RL2124.2 +021400 02 FILLER PIC X(52) VALUE SPACE. RL2124.2 +021500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2124.2 +021600 02 ID-AGAIN PIC X(9). RL2124.2 +021700 02 FILLER PIC X(45) VALUE SPACES. RL2124.2 +021800 01 CCVS-E-2. RL2124.2 +021900 02 FILLER PIC X(31) VALUE SPACE. RL2124.2 +022000 02 FILLER PIC X(21) VALUE SPACE. RL2124.2 +022100 02 CCVS-E-2-2. RL2124.2 +022200 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2124.2 +022300 03 FILLER PIC X VALUE SPACE. RL2124.2 +022400 03 ENDER-DESC PIC X(44) VALUE RL2124.2 +022500 "ERRORS ENCOUNTERED". RL2124.2 +022600 01 CCVS-E-3. RL2124.2 +022700 02 FILLER PIC X(22) VALUE RL2124.2 +022800 " FOR OFFICIAL USE ONLY". RL2124.2 +022900 02 FILLER PIC X(12) VALUE SPACE. RL2124.2 +023000 02 FILLER PIC X(58) VALUE RL2124.2 +023100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2124.2 +023200 02 FILLER PIC X(13) VALUE SPACE. RL2124.2 +023300 02 FILLER PIC X(15) VALUE RL2124.2 +023400 " COPYRIGHT 1985". RL2124.2 +023500 01 CCVS-E-4. RL2124.2 +023600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2124.2 +023700 02 FILLER PIC X(4) VALUE " OF ". RL2124.2 +023800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2124.2 +023900 02 FILLER PIC X(40) VALUE RL2124.2 +024000 " TESTS WERE EXECUTED SUCCESSFULLY". RL2124.2 +024100 01 XXINFO. RL2124.2 +024200 02 FILLER PIC X(19) VALUE RL2124.2 +024300 "*** INFORMATION ***". RL2124.2 +024400 02 INFO-TEXT. RL2124.2 +024500 04 FILLER PIC X(8) VALUE SPACE. RL2124.2 +024600 04 XXCOMPUTED PIC X(20). RL2124.2 +024700 04 FILLER PIC X(5) VALUE SPACE. RL2124.2 +024800 04 XXCORRECT PIC X(20). RL2124.2 +024900 02 INF-ANSI-REFERENCE PIC X(48). RL2124.2 +025000 01 HYPHEN-LINE. RL2124.2 +025100 02 FILLER PIC IS X VALUE IS SPACE. RL2124.2 +025200 02 FILLER PIC IS X(65) VALUE IS "************************RL2124.2 +025300- "*****************************************". RL2124.2 +025400 02 FILLER PIC IS X(54) VALUE IS "************************RL2124.2 +025500- "******************************". RL2124.2 +025600 01 CCVS-PGM-ID PIC X(9) VALUE RL2124.2 +025700 "RL212A". RL2124.2 +025800 PROCEDURE DIVISION. RL2124.2 +025900 CCVS1 SECTION. RL2124.2 +026000 OPEN-FILES. RL2124.2 +026100 OPEN OUTPUT PRINT-FILE. RL2124.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2124.2 +026300 MOVE SPACE TO TEST-RESULTS. RL2124.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2124.2 +026500 MOVE ZERO TO REC-SKL-SUB. RL2124.2 +026600 PERFORM CCVS-INIT-FILE 9 TIMES. RL2124.2 +026700 CCVS-INIT-FILE. RL2124.2 +026800 ADD 1 TO REC-SKL-SUB. RL2124.2 +026900 MOVE FILE-RECORD-INFO-SKELETON RL2124.2 +027000 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2124.2 +027100 CCVS-INIT-EXIT. RL2124.2 +027200 GO TO CCVS1-EXIT. RL2124.2 +027300 CLOSE-FILES. RL2124.2 +027400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2124.2 +027500 TERMINATE-CCVS. RL2124.2 +027600*S EXIT PROGRAM. RL2124.2 +027700*SERMINATE-CALL. RL2124.2 +027800 STOP RUN. RL2124.2 +027900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2124.2 +028000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2124.2 +028100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2124.2 +028200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2124.2 +028300 MOVE "****TEST DELETED****" TO RE-MARK. RL2124.2 +028400 PRINT-DETAIL. RL2124.2 +028500 IF REC-CT NOT EQUAL TO ZERO RL2124.2 +028600 MOVE "." TO PARDOT-X RL2124.2 +028700 MOVE REC-CT TO DOTVALUE. RL2124.2 +028800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2124.2 +028900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2124.2 +029000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2124.2 +029100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2124.2 +029200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2124.2 +029300 MOVE SPACE TO CORRECT-X. RL2124.2 +029400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2124.2 +029500 MOVE SPACE TO RE-MARK. RL2124.2 +029600 HEAD-ROUTINE. RL2124.2 +029700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +029800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +029900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2124.2 +030000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2124.2 +030100 COLUMN-NAMES-ROUTINE. RL2124.2 +030200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +030300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +030400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +030500 END-ROUTINE. RL2124.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2124.2 +030700 END-RTN-EXIT. RL2124.2 +030800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +030900 END-ROUTINE-1. RL2124.2 +031000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2124.2 +031100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2124.2 +031200 ADD PASS-COUNTER TO ERROR-HOLD. RL2124.2 +031300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2124.2 +031400 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2124.2 +031500 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2124.2 +031600 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2124.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2124.2 +031800 END-ROUTINE-12. RL2124.2 +031900 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2124.2 +032000 IF ERROR-COUNTER IS EQUAL TO ZERO RL2124.2 +032100 MOVE "NO " TO ERROR-TOTAL RL2124.2 +032200 ELSE RL2124.2 +032300 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2124.2 +032400 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2124.2 +032500 PERFORM WRITE-LINE. RL2124.2 +032600 END-ROUTINE-13. RL2124.2 +032700 IF DELETE-COUNTER IS EQUAL TO ZERO RL2124.2 +032800 MOVE "NO " TO ERROR-TOTAL ELSE RL2124.2 +032900 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2124.2 +033000 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2124.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +033200 IF INSPECT-COUNTER EQUAL TO ZERO RL2124.2 +033300 MOVE "NO " TO ERROR-TOTAL RL2124.2 +033400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2124.2 +033500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2124.2 +033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +033700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2124.2 +033800 WRITE-LINE. RL2124.2 +033900 ADD 1 TO RECORD-COUNT. RL2124.2 +034000 IF RECORD-COUNT GREATER 50 RL2124.2 +034100 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2124.2 +034200 MOVE SPACE TO DUMMY-RECORD RL2124.2 +034300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2124.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2124.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2124.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2124.2 +034700 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2124.2 +034800 MOVE ZERO TO RECORD-COUNT. RL2124.2 +034900 PERFORM WRT-LN. RL2124.2 +035000 WRT-LN. RL2124.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2124.2 +035200 MOVE SPACE TO DUMMY-RECORD. RL2124.2 +035300 BLANK-LINE-PRINT. RL2124.2 +035400 PERFORM WRT-LN. RL2124.2 +035500 FAIL-ROUTINE. RL2124.2 +035600 IF COMPUTED-X NOT EQUAL TO SPACE RL2124.2 +035700 GO TO FAIL-ROUTINE-WRITE. RL2124.2 +035800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2124.2 +035900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2124.2 +036000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2124.2 +036100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +036200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2124.2 +036300 GO TO FAIL-ROUTINE-EX. RL2124.2 +036400 FAIL-ROUTINE-WRITE. RL2124.2 +036500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2124.2 +036600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2124.2 +036700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2124.2 +036800 MOVE SPACES TO COR-ANSI-REFERENCE. RL2124.2 +036900 FAIL-ROUTINE-EX. EXIT. RL2124.2 +037000 BAIL-OUT. RL2124.2 +037100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2124.2 +037200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2124.2 +037300 BAIL-OUT-WRITE. RL2124.2 +037400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2124.2 +037500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2124.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2124.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2124.2 +037800 BAIL-OUT-EX. EXIT. RL2124.2 +037900 CCVS1-EXIT. RL2124.2 +038000 EXIT. RL2124.2 +038100 SECT-RL212A-001 SECTION. RL2124.2 +038200 REL-INIT-001. RL2124.2 +038300 MOVE "FILE CREATE RL-FS1" TO FEATURE. RL2124.2 +038400 OPEN OUTPUT RL-FS1. RL2124.2 +038500 MOVE "RL-FS1" TO XFILE-NAME (1). RL2124.2 +038600 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2124.2 +038700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2124.2 +038800 MOVE 000120 TO XRECORD-LENGTH (1). RL2124.2 +038900 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2124.2 +039000 MOVE 0001 TO XBLOCK-SIZE (1). RL2124.2 +039100 MOVE 000500 TO RECORDS-IN-FILE (1). RL2124.2 +039200 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2124.2 +039300 MOVE "S" TO XLABEL-TYPE (1). RL2124.2 +039400 MOVE 000001 TO XRECORD-NUMBER (1). RL2124.2 +039500 REL-TEST-001. RL2124.2 +039600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL2124.2 +039700 WRITE RL-FS1R1-F-G-120 RL2124.2 +039800 INVALID KEY GO TO REL-FAIL-001. RL2124.2 +039900 IF XRECORD-NUMBER (1) EQUAL TO 500 RL2124.2 +040000 GO TO REL-WRITE-001. RL2124.2 +040100 ADD 000001 TO XRECORD-NUMBER (1). RL2124.2 +040200 GO TO REL-TEST-001. RL2124.2 +040300 REL-DELETE-001. RL2124.2 +040400 PERFORM DE-LETE. RL2124.2 +040500 GO TO REL-WRITE-001. RL2124.2 +040600 REL-FAIL-001. RL2124.2 +040700 PERFORM FAIL. RL2124.2 +040800 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2124.2 +040900 REL-WRITE-001. RL2124.2 +041000 MOVE "REL-TEST-001" TO PAR-NAME RL2124.2 +041100 MOVE "FILE CREATED, LFILE " TO COMPUTED-A. RL2124.2 +041200 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2124.2 +041300 PERFORM PRINT-DETAIL. RL2124.2 +041400 CLOSE RL-FS1. RL2124.2 +041500 REL-INIT-002. RL2124.2 +041600 OPEN INPUT RL-FS1. RL2124.2 +041700 MOVE ZERO TO WRK-CS-09V00. RL2124.2 +041800 REL-TEST-002. RL2124.2 +041900 READ RL-FS1 RL2124.2 +042000 AT END GO TO REL-TEST-002-1. RL2124.2 +042100 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2124.2 +042200 ADD 1 TO WRK-CS-09V00. RL2124.2 +042300 IF WRK-CS-09V00 GREATER 500 RL2124.2 +042400 MOVE "MORE THAN 500 RECORDS" TO RE-MARK RL2124.2 +042500 GO TO REL-TEST-002-1. RL2124.2 +042600 GO TO REL-TEST-002. RL2124.2 +042700 REL-DELETE-002. RL2124.2 +042800 PERFORM DE-LETE. RL2124.2 +042900 PERFORM PRINT-DETAIL. RL2124.2 +043000 REL-TEST-002-1. RL2124.2 +043100 IF XRECORD-NUMBER (1) NOT EQUAL TO 500 RL2124.2 +043200 PERFORM FAIL RL2124.2 +043300 ELSE RL2124.2 +043400 PERFORM PASS. RL2124.2 +043500 GO TO REL-WRITE-002. RL2124.2 +043600 REL-WRITE-002. RL2124.2 +043700 MOVE "REL-TEST-002" TO PAR-NAME. RL2124.2 +043800 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2124.2 +043900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2124.2 +044000 PERFORM PRINT-DETAIL. RL2124.2 +044100 CLOSE RL-FS1. RL2124.2 +044200 CCVS-EXIT SECTION. RL2124.2 +044300 CCVS-999999. RL2124.2 +044400 GO TO CLOSE-FILES. RL2124.2 diff --git a/tests/cobol85/RL/RL213A.SUB b/tests/cobol85/RL/RL213A.SUB new file mode 100644 index 00000000..e7e4d220 --- /dev/null +++ b/tests/cobol85/RL/RL213A.SUB @@ -0,0 +1,475 @@ +000100 IDENTIFICATION DIVISION. RL2134.2 +000200 PROGRAM-ID. RL2134.2 +000300 RL213A. RL2134.2 +000400**************************************************************** RL2134.2 +000500* * RL2134.2 +000600* VALIDATION FOR:- * RL2134.2 +000700* * RL2134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2134.2 +000900* * RL2134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2134.2 +001100* * RL2134.2 +001200**************************************************************** RL2134.2 +001300* THE FUNCTION OF THIS PROGRAM IS TO PROCESS A RELATIVE I-O * RL2134.2 +001400* FILE SEQUENTIALLY (ACCESS MODE SEQUENTIAL). THE FILE * RL2134.2 +001500* USED AS INPUT IS THE FILE "RL-FS1" CREATED BY RL212A AND * RL2134.2 +001600* THE OTHER FILE "RL-FS2" WILL NOT BE PRESENT AT THE * RL2134.2 +001700* EXECUTION OF THE PROGRAM. * RL2134.2 +001800* * RL2134.2 +001900* X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS * RL2134.2 +002000* PROGRAM ARE: * RL2134.2 +002100* * RL2134.2 +002200* X-21 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL2134.2 +002300* RELATIVE I-O DATA FILE (RL-FS1) * RL2134.2 +002400* X-22 IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR * RL2134.2 +002500* RELATIVE I-O DATA FILE (RL-FS2) * RL2134.2 +002600* X-55 SYSTEM PRINTER * RL2134.2 +002700* X-69 ADDITIONAL VALUE OF CLAUSES * RL2134.2 +002800* X-74 VALUE OF IMPLEMENTOR-NAME * RL2134.2 +002900* X-75 OBJECT OF VALUE OF CLAUSE * RL2134.2 +003000* X-82 SOURCE-COMPUTER * RL2134.2 +003100* X-83 OBJECT-COMPUTER. * RL2134.2 +003200* * RL2134.2 +003300**************************************************************** RL2134.2 +003400 ENVIRONMENT DIVISION. RL2134.2 +003500 CONFIGURATION SECTION. RL2134.2 +003600 SOURCE-COMPUTER. RL2134.2 +003700 Linux. RL2134.2 +003800 OBJECT-COMPUTER. RL2134.2 +003900 Linux. RL2134.2 +004000 INPUT-OUTPUT SECTION. RL2134.2 +004100 FILE-CONTROL. RL2134.2 +004200 SELECT PRINT-FILE ASSIGN TO RL2134.2 +004300 "report.log". RL2134.2 +004400 SELECT OPTIONAL RL-FS1 ASSIGN TO RL2134.2 +004500 "XXXXX021" RL2134.2 +004600 ORGANIZATION IS RELATIVE RL2134.2 +004700 ACCESS SEQUENTIAL. RL2134.2 +004800 SELECT OPTIONAL RL-FS2 ASSIGN TO RL2134.2 +004900 "XXXXX022" RL2134.2 +005000 ORGANIZATION IS RELATIVE RL2134.2 +005100 ACCESS SEQUENTIAL. RL2134.2 +005200 DATA DIVISION. RL2134.2 +005300 FILE SECTION. RL2134.2 +005400 FD PRINT-FILE. RL2134.2 +005500 01 PRINT-REC PICTURE X(120). RL2134.2 +005600 01 DUMMY-RECORD PICTURE X(120). RL2134.2 +005700 FD RL-FS1 RL2134.2 +005800 LABEL RECORDS STANDARD RL2134.2 +005900*C VALUE OF RL2134.2 +006000*C OCLABELID RL2134.2 +006100*C IS RL2134.2 +006200*C "OCDUMMY" RL2134.2 +006300*G SYSIN RL2134.2 +006400 BLOCK CONTAINS 1 RECORDS RL2134.2 +006500 RECORD CONTAINS 120 CHARACTERS. RL2134.2 +006600 01 RL-FS1R1-F-G-120. RL2134.2 +006700 02 FILLER PIC X(120). RL2134.2 +006800 FD RL-FS2 RL2134.2 +006900 LABEL RECORDS STANDARD RL2134.2 +007000*C VALUE OF RL2134.2 +007100*C OCLABELID RL2134.2 +007200*C IS RL2134.2 +007300*C "OCDUMMY" RL2134.2 +007400*G SYSIN RL2134.2 +007500 BLOCK CONTAINS 1 RECORDS RL2134.2 +007600 RECORD CONTAINS 120 CHARACTERS. RL2134.2 +007700 01 RL-FS2R1-F-G-120. RL2134.2 +007800 02 FILLER PIC X(120). RL2134.2 +007900 WORKING-STORAGE SECTION. RL2134.2 +008000 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. RL2134.2 +008100 01 FILE-RECORD-INFORMATION-REC. RL2134.2 +008200 03 FILE-RECORD-INFO-SKELETON. RL2134.2 +008300 05 FILLER PICTURE X(48) VALUE RL2134.2 +008400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". RL2134.2 +008500 05 FILLER PICTURE X(46) VALUE RL2134.2 +008600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". RL2134.2 +008700 05 FILLER PICTURE X(26) VALUE RL2134.2 +008800 ",LFIL=000000,ORG= ,LBLR= ". RL2134.2 +008900 05 FILLER PICTURE X(37) VALUE RL2134.2 +009000 ",RECKEY= ". RL2134.2 +009100 05 FILLER PICTURE X(38) VALUE RL2134.2 +009200 ",ALTKEY1= ". RL2134.2 +009300 05 FILLER PICTURE X(38) VALUE RL2134.2 +009400 ",ALTKEY2= ". RL2134.2 +009500 05 FILLER PICTURE X(7) VALUE SPACE.RL2134.2 +009600 03 FILE-RECORD-INFO OCCURS 10 TIMES. RL2134.2 +009700 05 FILE-RECORD-INFO-P1-120. RL2134.2 +009800 07 FILLER PIC X(5). RL2134.2 +009900 07 XFILE-NAME PIC X(6). RL2134.2 +010000 07 FILLER PIC X(8). RL2134.2 +010100 07 XRECORD-NAME PIC X(6). RL2134.2 +010200 07 FILLER PIC X(1). RL2134.2 +010300 07 REELUNIT-NUMBER PIC 9(1). RL2134.2 +010400 07 FILLER PIC X(7). RL2134.2 +010500 07 XRECORD-NUMBER PIC 9(6). RL2134.2 +010600 07 FILLER PIC X(6). RL2134.2 +010700 07 UPDATE-NUMBER PIC 9(2). RL2134.2 +010800 07 FILLER PIC X(5). RL2134.2 +010900 07 ODO-NUMBER PIC 9(4). RL2134.2 +011000 07 FILLER PIC X(5). RL2134.2 +011100 07 XPROGRAM-NAME PIC X(5). RL2134.2 +011200 07 FILLER PIC X(7). RL2134.2 +011300 07 XRECORD-LENGTH PIC 9(6). RL2134.2 +011400 07 FILLER PIC X(7). RL2134.2 +011500 07 CHARS-OR-RECORDS PIC X(2). RL2134.2 +011600 07 FILLER PIC X(1). RL2134.2 +011700 07 XBLOCK-SIZE PIC 9(4). RL2134.2 +011800 07 FILLER PIC X(6). RL2134.2 +011900 07 RECORDS-IN-FILE PIC 9(6). RL2134.2 +012000 07 FILLER PIC X(5). RL2134.2 +012100 07 XFILE-ORGANIZATION PIC X(2). RL2134.2 +012200 07 FILLER PIC X(6). RL2134.2 +012300 07 XLABEL-TYPE PIC X(1). RL2134.2 +012400 05 FILE-RECORD-INFO-P121-240. RL2134.2 +012500 07 FILLER PIC X(8). RL2134.2 +012600 07 XRECORD-KEY PIC X(29). RL2134.2 +012700 07 FILLER PIC X(9). RL2134.2 +012800 07 ALTERNATE-KEY1 PIC X(29). RL2134.2 +012900 07 FILLER PIC X(9). RL2134.2 +013000 07 ALTERNATE-KEY2 PIC X(29). RL2134.2 +013100 07 FILLER PIC X(7). RL2134.2 +013200 01 TEST-RESULTS. RL2134.2 +013300 02 FILLER PIC X VALUE SPACE. RL2134.2 +013400 02 FEATURE PIC X(20) VALUE SPACE. RL2134.2 +013500 02 FILLER PIC X VALUE SPACE. RL2134.2 +013600 02 P-OR-F PIC X(5) VALUE SPACE. RL2134.2 +013700 02 FILLER PIC X VALUE SPACE. RL2134.2 +013800 02 PAR-NAME. RL2134.2 +013900 03 FILLER PIC X(19) VALUE SPACE. RL2134.2 +014000 03 PARDOT-X PIC X VALUE SPACE. RL2134.2 +014100 03 DOTVALUE PIC 99 VALUE ZERO. RL2134.2 +014200 02 FILLER PIC X(8) VALUE SPACE. RL2134.2 +014300 02 RE-MARK PIC X(61). RL2134.2 +014400 01 TEST-COMPUTED. RL2134.2 +014500 02 FILLER PIC X(30) VALUE SPACE. RL2134.2 +014600 02 FILLER PIC X(17) VALUE RL2134.2 +014700 " COMPUTED=". RL2134.2 +014800 02 COMPUTED-X. RL2134.2 +014900 03 COMPUTED-A PIC X(20) VALUE SPACE. RL2134.2 +015000 03 COMPUTED-N REDEFINES COMPUTED-A RL2134.2 +015100 PIC -9(9).9(9). RL2134.2 +015200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). RL2134.2 +015300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). RL2134.2 +015400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). RL2134.2 +015500 03 CM-18V0 REDEFINES COMPUTED-A. RL2134.2 +015600 04 COMPUTED-18V0 PIC -9(18). RL2134.2 +015700 04 FILLER PIC X. RL2134.2 +015800 03 FILLER PIC X(50) VALUE SPACE. RL2134.2 +015900 01 TEST-CORRECT. RL2134.2 +016000 02 FILLER PIC X(30) VALUE SPACE. RL2134.2 +016100 02 FILLER PIC X(17) VALUE " CORRECT =". RL2134.2 +016200 02 CORRECT-X. RL2134.2 +016300 03 CORRECT-A PIC X(20) VALUE SPACE. RL2134.2 +016400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). RL2134.2 +016500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). RL2134.2 +016600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). RL2134.2 +016700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). RL2134.2 +016800 03 CR-18V0 REDEFINES CORRECT-A. RL2134.2 +016900 04 CORRECT-18V0 PIC -9(18). RL2134.2 +017000 04 FILLER PIC X. RL2134.2 +017100 03 FILLER PIC X(2) VALUE SPACE. RL2134.2 +017200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. RL2134.2 +017300 01 CCVS-C-1. RL2134.2 +017400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PARL2134.2 +017500- "SS PARAGRAPH-NAME RL2134.2 +017600- " REMARKS". RL2134.2 +017700 02 FILLER PIC X(20) VALUE SPACE. RL2134.2 +017800 01 CCVS-C-2. RL2134.2 +017900 02 FILLER PIC X VALUE SPACE. RL2134.2 +018000 02 FILLER PIC X(6) VALUE "TESTED". RL2134.2 +018100 02 FILLER PIC X(15) VALUE SPACE. RL2134.2 +018200 02 FILLER PIC X(4) VALUE "FAIL". RL2134.2 +018300 02 FILLER PIC X(94) VALUE SPACE. RL2134.2 +018400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. RL2134.2 +018500 01 REC-CT PIC 99 VALUE ZERO. RL2134.2 +018600 01 DELETE-COUNTER PIC 999 VALUE ZERO. RL2134.2 +018700 01 ERROR-COUNTER PIC 999 VALUE ZERO. RL2134.2 +018800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. RL2134.2 +018900 01 PASS-COUNTER PIC 999 VALUE ZERO. RL2134.2 +019000 01 TOTAL-ERROR PIC 999 VALUE ZERO. RL2134.2 +019100 01 ERROR-HOLD PIC 999 VALUE ZERO. RL2134.2 +019200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. RL2134.2 +019300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. RL2134.2 +019400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. RL2134.2 +019500 01 CCVS-H-1. RL2134.2 +019600 02 FILLER PIC X(39) VALUE SPACES. RL2134.2 +019700 02 FILLER PIC X(42) VALUE RL2134.2 +019800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". RL2134.2 +019900 02 FILLER PIC X(39) VALUE SPACES. RL2134.2 +020000 01 CCVS-H-2A. RL2134.2 +020100 02 FILLER PIC X(40) VALUE SPACE. RL2134.2 +020200 02 FILLER PIC X(7) VALUE "CCVS85 ". RL2134.2 +020300 02 FILLER PIC XXXX VALUE RL2134.2 +020400 "4.2 ". RL2134.2 +020500 02 FILLER PIC X(28) VALUE RL2134.2 +020600 " COPY - NOT FOR DISTRIBUTION". RL2134.2 +020700 02 FILLER PIC X(41) VALUE SPACE. RL2134.2 +020800 RL2134.2 +020900 01 CCVS-H-2B. RL2134.2 +021000 02 FILLER PIC X(15) VALUE RL2134.2 +021100 "TEST RESULT OF ". RL2134.2 +021200 02 TEST-ID PIC X(9). RL2134.2 +021300 02 FILLER PIC X(4) VALUE RL2134.2 +021400 " IN ". RL2134.2 +021500 02 FILLER PIC X(12) VALUE RL2134.2 +021600 " HIGH ". RL2134.2 +021700 02 FILLER PIC X(22) VALUE RL2134.2 +021800 " LEVEL VALIDATION FOR ". RL2134.2 +021900 02 FILLER PIC X(58) VALUE RL2134.2 +022000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2134.2 +022100 01 CCVS-H-3. RL2134.2 +022200 02 FILLER PIC X(34) VALUE RL2134.2 +022300 " FOR OFFICIAL USE ONLY ". RL2134.2 +022400 02 FILLER PIC X(58) VALUE RL2134.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2134.2 +022600 02 FILLER PIC X(28) VALUE RL2134.2 +022700 " COPYRIGHT 1985 ". RL2134.2 +022800 01 CCVS-E-1. RL2134.2 +022900 02 FILLER PIC X(52) VALUE SPACE. RL2134.2 +023000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". RL2134.2 +023100 02 ID-AGAIN PIC X(9). RL2134.2 +023200 02 FILLER PIC X(45) VALUE SPACES. RL2134.2 +023300 01 CCVS-E-2. RL2134.2 +023400 02 FILLER PIC X(31) VALUE SPACE. RL2134.2 +023500 02 FILLER PIC X(21) VALUE SPACE. RL2134.2 +023600 02 CCVS-E-2-2. RL2134.2 +023700 03 ERROR-TOTAL PIC XXX VALUE SPACE. RL2134.2 +023800 03 FILLER PIC X VALUE SPACE. RL2134.2 +023900 03 ENDER-DESC PIC X(44) VALUE RL2134.2 +024000 "ERRORS ENCOUNTERED". RL2134.2 +024100 01 CCVS-E-3. RL2134.2 +024200 02 FILLER PIC X(22) VALUE RL2134.2 +024300 " FOR OFFICIAL USE ONLY". RL2134.2 +024400 02 FILLER PIC X(12) VALUE SPACE. RL2134.2 +024500 02 FILLER PIC X(58) VALUE RL2134.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2134.2 +024700 02 FILLER PIC X(13) VALUE SPACE. RL2134.2 +024800 02 FILLER PIC X(15) VALUE RL2134.2 +024900 " COPYRIGHT 1985". RL2134.2 +025000 01 CCVS-E-4. RL2134.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. RL2134.2 +025200 02 FILLER PIC X(4) VALUE " OF ". RL2134.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. RL2134.2 +025400 02 FILLER PIC X(40) VALUE RL2134.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". RL2134.2 +025600 01 XXINFO. RL2134.2 +025700 02 FILLER PIC X(19) VALUE RL2134.2 +025800 "*** INFORMATION ***". RL2134.2 +025900 02 INFO-TEXT. RL2134.2 +026000 04 FILLER PIC X(8) VALUE SPACE. RL2134.2 +026100 04 XXCOMPUTED PIC X(20). RL2134.2 +026200 04 FILLER PIC X(5) VALUE SPACE. RL2134.2 +026300 04 XXCORRECT PIC X(20). RL2134.2 +026400 02 INF-ANSI-REFERENCE PIC X(48). RL2134.2 +026500 01 HYPHEN-LINE. RL2134.2 +026600 02 FILLER PIC IS X VALUE IS SPACE. RL2134.2 +026700 02 FILLER PIC IS X(65) VALUE IS "************************RL2134.2 +026800- "*****************************************". RL2134.2 +026900 02 FILLER PIC IS X(54) VALUE IS "************************RL2134.2 +027000- "******************************". RL2134.2 +027100 01 CCVS-PGM-ID PIC X(9) VALUE RL2134.2 +027200 "RL213A". RL2134.2 +027300 PROCEDURE DIVISION. RL2134.2 +027400 CCVS1 SECTION. RL2134.2 +027500 OPEN-FILES. RL2134.2 +027600 OPEN OUTPUT PRINT-FILE. RL2134.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. RL2134.2 +027800 MOVE SPACE TO TEST-RESULTS. RL2134.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. RL2134.2 +028000 MOVE ZERO TO REC-SKL-SUB. RL2134.2 +028100 PERFORM CCVS-INIT-FILE 9 TIMES. RL2134.2 +028200 CCVS-INIT-FILE. RL2134.2 +028300 ADD 1 TO REC-SKL-SUB. RL2134.2 +028400 MOVE FILE-RECORD-INFO-SKELETON RL2134.2 +028500 TO FILE-RECORD-INFO (REC-SKL-SUB). RL2134.2 +028600 CCVS-INIT-EXIT. RL2134.2 +028700 GO TO CCVS1-EXIT. RL2134.2 +028800 CLOSE-FILES. RL2134.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. RL2134.2 +029000 TERMINATE-CCVS. RL2134.2 +029100*S EXIT PROGRAM. RL2134.2 +029200*SERMINATE-CALL. RL2134.2 +029300 STOP RUN. RL2134.2 +029400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. RL2134.2 +029500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. RL2134.2 +029600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. RL2134.2 +029700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. RL2134.2 +029800 MOVE "****TEST DELETED****" TO RE-MARK. RL2134.2 +029900 PRINT-DETAIL. RL2134.2 +030000 IF REC-CT NOT EQUAL TO ZERO RL2134.2 +030100 MOVE "." TO PARDOT-X RL2134.2 +030200 MOVE REC-CT TO DOTVALUE. RL2134.2 +030300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. RL2134.2 +030400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE RL2134.2 +030500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX RL2134.2 +030600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. RL2134.2 +030700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. RL2134.2 +030800 MOVE SPACE TO CORRECT-X. RL2134.2 +030900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. RL2134.2 +031000 MOVE SPACE TO RE-MARK. RL2134.2 +031100 HEAD-ROUTINE. RL2134.2 +031200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +031300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +031400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2134.2 +031500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. RL2134.2 +031600 COLUMN-NAMES-ROUTINE. RL2134.2 +031700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +031800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +031900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +032000 END-ROUTINE. RL2134.2 +032100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2134.2 +032200 END-RTN-EXIT. RL2134.2 +032300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +032400 END-ROUTINE-1. RL2134.2 +032500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO RL2134.2 +032600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. RL2134.2 +032700 ADD PASS-COUNTER TO ERROR-HOLD. RL2134.2 +032800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. RL2134.2 +032900 MOVE PASS-COUNTER TO CCVS-E-4-1. RL2134.2 +033000 MOVE ERROR-HOLD TO CCVS-E-4-2. RL2134.2 +033100 MOVE CCVS-E-4 TO CCVS-E-2-2. RL2134.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. RL2134.2 +033300 END-ROUTINE-12. RL2134.2 +033400 MOVE "TEST(S) FAILED" TO ENDER-DESC. RL2134.2 +033500 IF ERROR-COUNTER IS EQUAL TO ZERO RL2134.2 +033600 MOVE "NO " TO ERROR-TOTAL RL2134.2 +033700 ELSE RL2134.2 +033800 MOVE ERROR-COUNTER TO ERROR-TOTAL. RL2134.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. RL2134.2 +034000 PERFORM WRITE-LINE. RL2134.2 +034100 END-ROUTINE-13. RL2134.2 +034200 IF DELETE-COUNTER IS EQUAL TO ZERO RL2134.2 +034300 MOVE "NO " TO ERROR-TOTAL ELSE RL2134.2 +034400 MOVE DELETE-COUNTER TO ERROR-TOTAL. RL2134.2 +034500 MOVE "TEST(S) DELETED " TO ENDER-DESC. RL2134.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +034700 IF INSPECT-COUNTER EQUAL TO ZERO RL2134.2 +034800 MOVE "NO " TO ERROR-TOTAL RL2134.2 +034900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. RL2134.2 +035000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. RL2134.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +035200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. RL2134.2 +035300 WRITE-LINE. RL2134.2 +035400 ADD 1 TO RECORD-COUNT. RL2134.2 +035500 IF RECORD-COUNT GREATER 50 RL2134.2 +035600 MOVE DUMMY-RECORD TO DUMMY-HOLD RL2134.2 +035700 MOVE SPACE TO DUMMY-RECORD RL2134.2 +035800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE RL2134.2 +035900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN RL2134.2 +036000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES RL2134.2 +036100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN RL2134.2 +036200 MOVE DUMMY-HOLD TO DUMMY-RECORD RL2134.2 +036300 MOVE ZERO TO RECORD-COUNT. RL2134.2 +036400 PERFORM WRT-LN. RL2134.2 +036500 WRT-LN. RL2134.2 +036600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. RL2134.2 +036700 MOVE SPACE TO DUMMY-RECORD. RL2134.2 +036800 BLANK-LINE-PRINT. RL2134.2 +036900 PERFORM WRT-LN. RL2134.2 +037000 FAIL-ROUTINE. RL2134.2 +037100 IF COMPUTED-X NOT EQUAL TO SPACE RL2134.2 +037200 GO TO FAIL-ROUTINE-WRITE. RL2134.2 +037300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2134.2 +037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2134.2 +037500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. RL2134.2 +037600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +037700 MOVE SPACES TO INF-ANSI-REFERENCE. RL2134.2 +037800 GO TO FAIL-ROUTINE-EX. RL2134.2 +037900 FAIL-ROUTINE-WRITE. RL2134.2 +038000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE RL2134.2 +038100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. RL2134.2 +038200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2134.2 +038300 MOVE SPACES TO COR-ANSI-REFERENCE. RL2134.2 +038400 FAIL-ROUTINE-EX. EXIT. RL2134.2 +038500 BAIL-OUT. RL2134.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. RL2134.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. RL2134.2 +038800 BAIL-OUT-WRITE. RL2134.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. RL2134.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. RL2134.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. RL2134.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. RL2134.2 +039300 BAIL-OUT-EX. EXIT. RL2134.2 +039400 CCVS1-EXIT. RL2134.2 +039500 EXIT. RL2134.2 +039600 SECT-RL213A-001 SECTION. RL2134.2 +039700 REL-INIT-001. RL2134.2 +039800 MOVE "EXTEND FILE RL-FS1" TO FEATURE. RL2134.2 +039900 OPEN EXTEND RL-FS1. RL2134.2 +040000 MOVE "RL-FS1" TO XFILE-NAME (1). RL2134.2 +040100 MOVE "R1-F-G" TO XRECORD-NAME (1). RL2134.2 +040200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). RL2134.2 +040300 MOVE 000120 TO XRECORD-LENGTH (1). RL2134.2 +040400 MOVE "RC" TO CHARS-OR-RECORDS (1). RL2134.2 +040500 MOVE 0001 TO XBLOCK-SIZE (1). RL2134.2 +040600 MOVE 000520 TO RECORDS-IN-FILE (1). RL2134.2 +040700 MOVE "RL" TO XFILE-ORGANIZATION (1). RL2134.2 +040800 MOVE "S" TO XLABEL-TYPE (1). RL2134.2 +040900 MOVE 000501 TO XRECORD-NUMBER (1). RL2134.2 +041000 GO TO REL-TEST-001. RL2134.2 +041100 REL-DELETE-001. RL2134.2 +041200 PERFORM DE-LETE. RL2134.2 +041300 PERFORM PRINT-DETAIL. RL2134.2 +041400 GO TO CCVS-EXIT. RL2134.2 +041500 REL-TEST-001. RL2134.2 +041600 MOVE FILE-RECORD-INFO-P1-120 (1) TO RL-FS1R1-F-G-120. RL2134.2 +041700 WRITE RL-FS1R1-F-G-120 RL2134.2 +041800 INVALID KEY GO TO REL-FAIL-001. RL2134.2 +041900 IF XRECORD-NUMBER (1) EQUAL TO 520 RL2134.2 +042000 GO TO REL-WRITE-001. RL2134.2 +042100 ADD 000001 TO XRECORD-NUMBER (1). RL2134.2 +042200 GO TO REL-TEST-001. RL2134.2 +042300 REL-FAIL-001. RL2134.2 +042400 PERFORM FAIL. RL2134.2 +042500 MOVE "BOUNDARY VIOLATION" TO RE-MARK. RL2134.2 +042600 REL-WRITE-001. RL2134.2 +042700 MOVE "REL-TEST-001" TO PAR-NAME RL2134.2 +042800 MOVE "FILE EXTENDED, LFILE" TO COMPUTED-A. RL2134.2 +042900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2134.2 +043000 PERFORM PRINT-DETAIL. RL2134.2 +043100 CLOSE RL-FS1. RL2134.2 +043200* RL2134.2 +043300 REL-INIT-002. RL2134.2 +043400 OPEN INPUT RL-FS1. RL2134.2 +043500 MOVE ZERO TO WRK-CS-09V00. RL2134.2 +043600 GO TO REL-TEST-002. RL2134.2 +043700 REL-DELETE-002. RL2134.2 +043800 PERFORM DE-LETE. RL2134.2 +043900 PERFORM PRINT-DETAIL. RL2134.2 +044000 GO TO CCVS-EXIT. RL2134.2 +044100 REL-TEST-002. RL2134.2 +044200 READ RL-FS1 RL2134.2 +044300 AT END GO TO REL-TEST-002-2. RL2134.2 +044400 MOVE RL-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). RL2134.2 +044500 ADD 1 TO WRK-CS-09V00. RL2134.2 +044600 IF WRK-CS-09V00 GREATER 520 RL2134.2 +044700 MOVE "MORE THAN 520 RECORDS" TO RE-MARK RL2134.2 +044800 GO TO REL-TEST-002-2. RL2134.2 +044900 REL-TEST-002-1. RL2134.2 +045000 MOVE "REL-TEST-002-1" TO PAR-NAME. RL2134.2 +045100 IF XRECORD-NUMBER (1) NOT = WRK-CS-09V00 RL2134.2 +045200 MOVE "INCORRECT RECORD NUMBER" TO RE-MARK RL2134.2 +045300 MOVE XRECORD-NUMBER (1) TO COMPUTED-N RL2134.2 +045400 MOVE WRK-CS-09V00 TO CORRECT-N RL2134.2 +045500 PERFORM FAIL RL2134.2 +045600 PERFORM PRINT-DETAIL RL2134.2 +045700 ELSE RL2134.2 +045800 PERFORM PASS. RL2134.2 +045900* PERFORM PRINT-DETAIL. RL2134.2 +046000 GO TO REL-TEST-002. RL2134.2 +046100 REL-TEST-002-2. RL2134.2 +046200 MOVE "REL-TEST-002-2" TO PAR-NAME. RL2134.2 +046300 IF XRECORD-NUMBER (1) NOT EQUAL TO 520 RL2134.2 +046400 PERFORM FAIL RL2134.2 +046500 ELSE RL2134.2 +046600 PERFORM PASS. RL2134.2 +046700 REL-WRITE-002. RL2134.2 +046800 MOVE "REL-TEST-002" TO PAR-NAME. RL2134.2 +046900 MOVE "FILE VERIFIED, LFILE" TO COMPUTED-A. RL2134.2 +047000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. RL2134.2 +047100 PERFORM PRINT-DETAIL. RL2134.2 +047200 CLOSE RL-FS1. RL2134.2 +047300 CCVS-EXIT SECTION. RL2134.2 +047400 CCVS-999999. RL2134.2 +047500 GO TO CLOSE-FILES. RL2134.2 diff --git a/tests/cobol85/RL/RL301M.CBL b/tests/cobol85/RL/RL301M.CBL new file mode 100644 index 00000000..ac20328d --- /dev/null +++ b/tests/cobol85/RL/RL301M.CBL @@ -0,0 +1,67 @@ +000100 IDENTIFICATION DIVISION. RL3014.2 +000200 PROGRAM-ID. RL3014.2 +000300 RL301M. RL3014.2 +000400*The following program tests the flagging of intermediate RL3014.2 +000500*subset features that are used in relative RL3014.2 +000600*input-output. RL3014.2 +000700 ENVIRONMENT DIVISION. RL3014.2 +000800 CONFIGURATION SECTION. RL3014.2 +000900 SOURCE-COMPUTER. RL3014.2 +001000 Linux. RL3014.2 +001100 OBJECT-COMPUTER. RL3014.2 +001200 Linux. RL3014.2 +001300 INPUT-OUTPUT SECTION. RL3014.2 +001400 FILE-CONTROL. RL3014.2 +001500 SELECT TFIL ASSIGN RL3014.2 +001600 "XXXXX021" RL3014.2 +001700 ORGANIZATION IS RELATIVE RL3014.2 +001800*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +001900 ACCESS MODE IS RANDOM RL3014.2 +002000*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +002100 RELATIVE KEY IS RKEY. RL3014.2 +002200 DATA DIVISION. RL3014.2 +002300 FILE SECTION. RL3014.2 +002400 FD TFIL. RL3014.2 +002500 01 FREC. RL3014.2 +002600 03 GUBBINS PIC 9(8). RL3014.2 +002700 RL3014.2 +002800 WORKING-STORAGE SECTION. RL3014.2 +002900 01 VARIABLES. RL3014.2 +003000 03 STATE PIC X(4) VALUE SPACES. RL3014.2 +003100 03 RKEY PIC 9(8) VALUE ZERO. RL3014.2 +003200 RL3014.2 +003300 PROCEDURE DIVISION. RL3014.2 +003400 RL3014.2 +003500 RL301M-CONTROL. RL3014.2 +003600 OPEN I-O TFIL. RL3014.2 +003700 PERFORM RL301M-READ THRU RL301M-DELETE 1 TIMES. RL3014.2 +003800 CLOSE TFIL. RL3014.2 +003900 STOP RUN. RL3014.2 +004000 RL3014.2 +004100 RL301M-READ. RL3014.2 +004200 READ TFIL INVALID KEY PERFORM INV-PARA RL3014.2 +004300 NOT INVALID KEY PERFORM DONE-PARA. RL3014.2 +004400*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +004500 RL3014.2 +004600 RL301M-REWRITE. RL3014.2 +004700 REWRITE FREC INVALID KEY PERFORM INV-PARA RL3014.2 +004800 NOT INVALID KEY PERFORM DONE-PARA. RL3014.2 +004900*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +005000 RL3014.2 +005100 RL301M-WRITE. RL3014.2 +005200 WRITE FREC INVALID KEY PERFORM INV-PARA RL3014.2 +005300 NOT INVALID KEY PERFORM DONE-PARA. RL3014.2 +005400*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +005500 RL3014.2 +005600 RL301M-DELETE. RL3014.2 +005700 DELETE TFIL INVALID KEY PERFORM INV-PARA RL3014.2 +005800 NOT INVALID KEY PERFORM DONE-PARA. RL3014.2 +005900*Message expected for above statement: NON-CONFORMING STANDARD RL3014.2 +006000 RL3014.2 +006100 INV-PARA. RL3014.2 +006200 MOVE "INVA" TO STATE. RL3014.2 +006300 RL3014.2 +006400 DONE-PARA. RL3014.2 +006500 MOVE "DONE" TO STATE. RL3014.2 +006600 RL3014.2 +006700*TOTAL NUMBER OF FLAGS EXPECTED = 6. RL3014.2 diff --git a/tests/cobol85/RL/RL302M.CBL b/tests/cobol85/RL/RL302M.CBL new file mode 100644 index 00000000..3413415c --- /dev/null +++ b/tests/cobol85/RL/RL302M.CBL @@ -0,0 +1,70 @@ +000100 IDENTIFICATION DIVISION. RL3024.2 +000200 PROGRAM-ID. RL3024.2 +000300 RL302M. RL3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF RL3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN INTERMEDIATE SUBSET RL3024.2 +000600*RELATIVE INPUT-OUTPUT. RL3024.2 +000700*INPUT-OUTPUT. RL3024.2 +000800 ENVIRONMENT DIVISION. RL3024.2 +000900 CONFIGURATION SECTION. RL3024.2 +001000 SOURCE-COMPUTER. RL3024.2 +001100 Linux. RL3024.2 +001200 OBJECT-COMPUTER. RL3024.2 +001300 Linux. RL3024.2 +001400 INPUT-OUTPUT SECTION. RL3024.2 +001500 FILE-CONTROL. RL3024.2 +001600 SELECT TFIL ASSIGN RL3024.2 +001700 "XXXXX021" RL3024.2 +001800 ORGANIZATION IS RELATIVE RL3024.2 +001900 ACCESS MODE IS RANDOM RL3024.2 +002000 RELATIVE KEY IS RKEY. RL3024.2 +002100 RL3024.2 +002200 SELECT SQ-FRR ASSIGN RL3024.2 +002300 "XXXXX013" RL3024.2 +002400 ORGANIZATION IS SEQUENTIAL. RL3024.2 +002500 RL3024.2 +002600 SELECT RR-FS1 ASSIGN RL3024.2 +002700 "XXXXX021" RL3024.2 +002800 ORGANIZATION IS RELATIVE. RL3024.2 +002900 I-O-CONTROL. RL3024.2 +003000 XXXXX053. RL3024.2 +003100*Message expected for above statement: OBSOLETE RL3024.2 +003200 RL3024.2 +003300 DATA DIVISION. RL3024.2 +003400 FILE SECTION. RL3024.2 +003500 FD TFIL RL3024.2 +003600 LABEL RECORDS STANDARD RL3024.2 +003700*Message expected for above statement: OBSOLETE RL3024.2 +003800 VALUE OF RL3024.2 +003900 OCLABELID RL3024.2 +004000 IS RL3024.2 +004100 "OCDUMMY" RL3024.2 +004200*Message expected for above statement: OBSOLETE RL3024.2 +004300 DATA RECORDS ARE FREC. RL3024.2 +004400*Message expected for above statement: OBSOLETE RL3024.2 +004500 RL3024.2 +004600 01 FREC. RL3024.2 +004700 03 GUBBINS PIC 9(8). RL3024.2 +004800 RL3024.2 +004900 FD SQ-FRR. RL3024.2 +005000 01 SREC. RL3024.2 +005100 03 SKEY PIC X(8). RL3024.2 +005200 RL3024.2 +005300 FD RR-FS1. RL3024.2 +005400 01 RREC. RL3024.2 +005500 03 FKEY PIC X(8). RL3024.2 +005600 RL3024.2 +005700 WORKING-STORAGE SECTION. RL3024.2 +005800 RL3024.2 +005900 01 VARIABLES. RL3024.2 +006000 03 RKEY PIC 9(8) VALUE ZERO. RL3024.2 +006100 03 VKEY PIC 9(8) VALUE ZERO. RL3024.2 +006200 03 DKEY PIC 9(8) VALUE ZERO. RL3024.2 +006300 RL3024.2 +006400 PROCEDURE DIVISION. RL3024.2 +006500 RL3024.2 +006600 RL302M-CONTROL. RL3024.2 +006700 DISPLAY "THIS IS A DUMMY PARAGRAPH". RL3024.2 +006800 STOP RUN. RL3024.2 +006900 RL3024.2 +007000*TOTAL NUMBER OF FLAGS EXPECTED = 4. RL3024.2 diff --git a/tests/cobol85/RL/RL401M.CBL b/tests/cobol85/RL/RL401M.CBL new file mode 100644 index 00000000..b111b428 --- /dev/null +++ b/tests/cobol85/RL/RL401M.CBL @@ -0,0 +1,78 @@ +000100 IDENTIFICATION DIVISION. RL4014.2 +000200 PROGRAM-ID. RL4014.2 +000300 RL401M. RL4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF RL4014.2 +000500*HIGH SUBSET FEATURES THAT ARE USED IN RELATIVE RL4014.2 +000600*INPUT-OUTPUT. RL4014.2 +000700 ENVIRONMENT DIVISION. RL4014.2 +000800 CONFIGURATION SECTION. RL4014.2 +000900 SOURCE-COMPUTER. RL4014.2 +001000 Linux. RL4014.2 +001100 OBJECT-COMPUTER. RL4014.2 +001200 Linux. RL4014.2 +001300 INPUT-OUTPUT SECTION. RL4014.2 +001400 FILE-CONTROL. RL4014.2 +001500 SELECT OPTIONAL TFIL ASSIGN RL4014.2 +001600*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +001700 "XXXXX021" RL4014.2 +001800 RESERVE 2 AREAS RL4014.2 +001900*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +002000 ORGANIZATION IS RELATIVE RL4014.2 +002100 ACCESS MODE IS DYNAMIC RL4014.2 +002200*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +002300 RELATIVE KEY IS RKEY. RL4014.2 +002400 RL4014.2 +002500 SELECT TFIL2 ASSIGN RL4014.2 +002600 "XXXXX022" RL4014.2 +002700 ORGANIZATION IS RELATIVE. RL4014.2 +002800 RL4014.2 +002900 I-O-CONTROL. RL4014.2 +003000 SAME RECORD AREA FOR TFIL2, TFIL. RL4014.2 +003100*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +003200 RL4014.2 +003300 DATA DIVISION. RL4014.2 +003400 FILE SECTION. RL4014.2 +003500 FD TFIL RL4014.2 +003600 RECORD IS VARYING IN SIZE FROM 1 TO 8 CHARACTERS. RL4014.2 +003700*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +003800 RL4014.2 +003900 01 FREC. RL4014.2 +004000 03 GUBBINS PIC 9(8). RL4014.2 +004100 RL4014.2 +004200 RL4014.2 +004300 FD TFIL2. RL4014.2 +004400 01 FREC2. RL4014.2 +004500 03 RKEY2 PIC 9(8). RL4014.2 +004600 RL4014.2 +004700 WORKING-STORAGE SECTION. RL4014.2 +004800 01 RKEY PIC 9(8) VALUE ZERO. RL4014.2 +004900 RL4014.2 +005000 PROCEDURE DIVISION. RL4014.2 +005100 RL4014.2 +005200 RL401M-CONTROL. RL4014.2 +005300 OPEN INPUT TFIL. RL4014.2 +005400 PERFORM RL401M-CLOSE THRU RL401M-START. RL4014.2 +005500 CLOSE TFIL. RL4014.2 +005600 CLOSE TFIL2. RL4014.2 +005700 STOP RUN. RL4014.2 +005800 RL4014.2 +005900 RL401M-CLOSE. RL4014.2 +006000 CLOSE TFIL WITH LOCK. RL4014.2 +006100*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +006200 OPEN INPUT TFIL. RL4014.2 +006300 RL4014.2 +006400 RL401M-OPENEXT. RL4014.2 +006500 OPEN EXTEND TFIL2. RL4014.2 +006600*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +006700 RL4014.2 +006800 RL401M-READNEXT. RL4014.2 +006900 READ TFIL NEXT RECORD RL4014.2 +007000 AT END DISPLAY "AT END". RL4014.2 +007100*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +007200 RL4014.2 +007300 RL401M-START. RL4014.2 +007400 START TFIL KEY IS EQUAL TO RKEY RL4014.2 +007500 INVALID KEY STOP RUN. RL4014.2 +007600*Message expected for above statement: NON-CONFORMING STANDARD RL4014.2 +007700 RL4014.2 +007800*TOTAL NUMBER OF FLAGS EXPECTED = 9. RL4014.2 diff --git a/tests/cobol85/SG.txt b/tests/cobol85/SG.txt deleted file mode 100644 index 7f64c572..00000000 --- a/tests/cobol85/SG.txt +++ /dev/null @@ -1,23 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -SG101A.CBL 151 151 0 0 0 OK -SG102A.CBL ----- test skipped ----- -SG103A.CBL ----- test skipped ----- -SG104A.CBL 9 9 0 0 0 OK -SG105A.CBL 9 9 0 0 0 OK -SG106A.CBL 9 9 0 0 0 OK -SG201A.CBL ----- test skipped ----- -SG202A.CBL ----- test skipped ----- -SG203A.CBL ----- test skipped ----- -SG204A.CBL 15 15 0 0 0 OK -SG302M.CBL ----- test skipped ----- -SG303M.CBL ----- test skipped ----- -SG401M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 193 193 0 0 0 -% 100.0 100.0 0.0 0.0 0.0 - -Number of programs: 5 -Successfully executed: 5 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/SG/SG101A.CBL b/tests/cobol85/SG/SG101A.CBL new file mode 100755 index 00000000..0be1466e --- /dev/null +++ b/tests/cobol85/SG/SG101A.CBL @@ -0,0 +1,2849 @@ +000100 IDENTIFICATION DIVISION. SG1014.2 +000200 PROGRAM-ID. SG1014.2 +000300 SG101A. SG1014.2 +000400 AUTHOR. SG1014.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1014.2 +000600 INSTALLATION. SG1014.2 +000700 GENERAL SERVICES ADMINISTRATION SG1014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1014.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1014.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1014.2 +001200 SG1014.2 +001300 PHONE (703) 756-6153 SG1014.2 +001400 SG1014.2 +001500 " HIGH ". SG1014.2 +001600 DATE-WRITTEN. SG1014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1014.2 +001800 CREATION DATE / VALIDATION DATE SG1014.2 +001900 "4.2 ". SG1014.2 +002000 SECURITY. SG1014.2 +002100 NONE. SG1014.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG1014.2 +002300 THE ABILITY OF THE COMPILER TO ACCEPT 100 SEGMENTS SG1014.2 +002400 AND REFERENCE SEGMENTS GREATER THAN 49 IN THEIR INITIAL SG1014.2 +002500 STATE WITH SEGMENTS LESS THAN 50 IN THEIR LAST-USED SG1014.2 +002600 STATE SG1014.2 +002700 SG1014.2 +002800 ENVIRONMENT DIVISION. SG1014.2 +002900 CONFIGURATION SECTION. SG1014.2 +003000 SOURCE-COMPUTER. SG1014.2 +003100 Linux. SG1014.2 +003200 OBJECT-COMPUTER. SG1014.2 +003300 Linux. SG1014.2 +003400 INPUT-OUTPUT SECTION. SG1014.2 +003500 FILE-CONTROL. SG1014.2 +003600 SELECT PRINT-FILE ASSIGN TO SG1014.2 +003700 "report.log". SG1014.2 +003800 DATA DIVISION. SG1014.2 +003900 FILE SECTION. SG1014.2 +004000 FD PRINT-FILE SG1014.2 +004100 LABEL RECORDS SG1014.2 +004200 OMITTED SG1014.2 +004300 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1014.2 +004400 01 PRINT-REC PICTURE X(120). SG1014.2 +004500 01 DUMMY-RECORD PICTURE X(120). SG1014.2 +004600 WORKING-STORAGE SECTION. SG1014.2 +004700 77 TEST-CHECK PICTURE XXXX VALUE SPACE. SG1014.2 +004800 01 TEST-RESULTS. SG1014.2 +004900 02 FILLER PICTURE X VALUE SPACE. SG1014.2 +005000 02 FEATURE PICTURE X(20) VALUE SPACE. SG1014.2 +005100 02 FILLER PICTURE X VALUE SPACE. SG1014.2 +005200 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1014.2 +005300 02 FILLER PICTURE X VALUE SPACE. SG1014.2 +005400 02 PAR-NAME. SG1014.2 +005500 03 FILLER PICTURE X(12) VALUE SPACE. SG1014.2 +005600 03 PARDOT-X PICTURE X VALUE SPACE. SG1014.2 +005700 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1014.2 +005800 03 FILLER PIC X(5) VALUE SPACE. SG1014.2 +005900 02 FILLER PIC X(10) VALUE SPACE. SG1014.2 +006000 02 RE-MARK PIC X(61). SG1014.2 +006100 01 TEST-COMPUTED. SG1014.2 +006200 02 FILLER PIC X(30) VALUE SPACE. SG1014.2 +006300 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1014.2 +006400 02 COMPUTED-X. SG1014.2 +006500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1014.2 +006600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1014.2 +006700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1014.2 +006800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1014.2 +006900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1014.2 +007000 03 CM-18V0 REDEFINES COMPUTED-A. SG1014.2 +007100 04 COMPUTED-18V0 PICTURE -9(18). SG1014.2 +007200 04 FILLER PICTURE X. SG1014.2 +007300 03 FILLER PIC X(50) VALUE SPACE. SG1014.2 +007400 01 TEST-CORRECT. SG1014.2 +007500 02 FILLER PIC X(30) VALUE SPACE. SG1014.2 +007600 02 FILLER PIC X(17) VALUE " CORRECT =". SG1014.2 +007700 02 CORRECT-X. SG1014.2 +007800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1014.2 +007900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1014.2 +008000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1014.2 +008100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1014.2 +008200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1014.2 +008300 03 CR-18V0 REDEFINES CORRECT-A. SG1014.2 +008400 04 CORRECT-18V0 PICTURE -9(18). SG1014.2 +008500 04 FILLER PICTURE X. SG1014.2 +008600 03 FILLER PIC X(50) VALUE SPACE. SG1014.2 +008700 01 CCVS-C-1. SG1014.2 +008800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1014.2 +008900- "SS PARAGRAPH-NAME SG1014.2 +009000- " REMARKS". SG1014.2 +009100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1014.2 +009200 01 CCVS-C-2. SG1014.2 +009300 02 FILLER PICTURE IS X VALUE IS SPACE. SG1014.2 +009400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1014.2 +009500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1014.2 +009600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1014.2 +009700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1014.2 +009800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1014.2 +009900 01 REC-CT PICTURE 99 VALUE ZERO. SG1014.2 +010000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1014.2 +010100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1014.2 +010200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1014.2 +010300 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1014.2 +010400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1014.2 +010500 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1014.2 +010600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1014.2 +010700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1014.2 +010800 01 CCVS-H-1. SG1014.2 +010900 02 FILLER PICTURE X(27) VALUE SPACE. SG1014.2 +011000 02 FILLER PICTURE X(67) VALUE SG1014.2 +011100 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1014.2 +011200- " SYSTEM". SG1014.2 +011300 02 FILLER PICTURE X(26) VALUE SPACE. SG1014.2 +011400 01 CCVS-H-2. SG1014.2 +011500 02 FILLER PICTURE X(52) VALUE IS SG1014.2 +011600 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1014.2 +011700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1014.2 +011800 02 TEST-ID PICTURE IS X(9). SG1014.2 +011900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1014.2 +012000 01 CCVS-H-3. SG1014.2 +012100 02 FILLER PICTURE X(34) VALUE SG1014.2 +012200 " FOR OFFICIAL USE ONLY ". SG1014.2 +012300 02 FILLER PICTURE X(58) VALUE SG1014.2 +012400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1014.2 +012500 02 FILLER PICTURE X(28) VALUE SG1014.2 +012600 " COPYRIGHT 1974 ". SG1014.2 +012700 01 CCVS-E-1. SG1014.2 +012800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1014.2 +012900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1014.2 +013000 02 ID-AGAIN PICTURE IS X(9). SG1014.2 +013100 02 FILLER PICTURE X(45) VALUE IS SG1014.2 +013200 " NTIS DISTRIBUTION COBOL 74". SG1014.2 +013300 01 CCVS-E-2. SG1014.2 +013400 02 FILLER PICTURE X(31) VALUE SG1014.2 +013500 SPACE. SG1014.2 +013600 02 FILLER PICTURE X(21) VALUE SPACE. SG1014.2 +013700 02 CCVS-E-2-2. SG1014.2 +013800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1014.2 +013900 03 FILLER PICTURE IS X VALUE IS SPACE. SG1014.2 +014000 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1014.2 +014100 01 CCVS-E-3. SG1014.2 +014200 02 FILLER PICTURE X(22) VALUE SG1014.2 +014300 " FOR OFFICIAL USE ONLY". SG1014.2 +014400 02 FILLER PICTURE X(12) VALUE SPACE. SG1014.2 +014500 02 FILLER PICTURE X(58) VALUE SG1014.2 +014600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1014.2 +014700 02 FILLER PICTURE X(13) VALUE SPACE. SG1014.2 +014800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1014.2 +014900 01 CCVS-E-4. SG1014.2 +015000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1014.2 +015100 02 FILLER PIC XXXX VALUE " OF ". SG1014.2 +015200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1014.2 +015300 02 FILLER PIC X(40) VALUE SG1014.2 +015400 " TESTS WERE EXECUTED SUCCESSFULLY". SG1014.2 +015500 01 XXINFO. SG1014.2 +015600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1014.2 +015700 02 INFO-TEXT. SG1014.2 +015800 04 FILLER PIC X(20) VALUE SPACE. SG1014.2 +015900 04 XXCOMPUTED PIC X(20). SG1014.2 +016000 04 FILLER PIC X(5) VALUE SPACE. SG1014.2 +016100 04 XXCORRECT PIC X(20). SG1014.2 +016200 01 HYPHEN-LINE. SG1014.2 +016300 02 FILLER PICTURE IS X VALUE IS SPACE. SG1014.2 +016400 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1014.2 +016500- "*****************************************". SG1014.2 +016600 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1014.2 +016700- "******************************". SG1014.2 +016800 01 CCVS-PGM-ID PIC X(6) VALUE SG1014.2 +016900 "SG101A". SG1014.2 +017000 PROCEDURE DIVISION. SG1014.2 +017100 CCVS1 SECTION. SG1014.2 +017200 OPEN-FILES. SG1014.2 +017300 OPEN OUTPUT PRINT-FILE. SG1014.2 +017400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1014.2 +017500 MOVE SPACE TO TEST-RESULTS. SG1014.2 +017600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1014.2 +017700 GO TO CCVS1-EXIT. SG1014.2 +017800 CLOSE-FILES. SG1014.2 +017900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1014.2 +018000 TERMINATE-CCVS. SG1014.2 +018100*S EXIT PROGRAM. SG1014.2 +018200*SERMINATE-CALL. SG1014.2 +018300 STOP RUN. SG1014.2 +018400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1014.2 +018500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1014.2 +018600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1014.2 +018700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1014.2 +018800 MOVE "****TEST DELETED****" TO RE-MARK. SG1014.2 +018900 PRINT-DETAIL. SG1014.2 +019000 IF REC-CT NOT EQUAL TO ZERO SG1014.2 +019100 MOVE "." TO PARDOT-X SG1014.2 +019200 MOVE REC-CT TO DOTVALUE. SG1014.2 +019300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1014.2 +019400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1014.2 +019500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1014.2 +019600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1014.2 +019700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1014.2 +019800 MOVE SPACE TO CORRECT-X. SG1014.2 +019900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1014.2 +020000 MOVE SPACE TO RE-MARK. SG1014.2 +020100 HEAD-ROUTINE. SG1014.2 +020200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +020300 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1014.2 +020400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1014.2 +020500 COLUMN-NAMES-ROUTINE. SG1014.2 +020600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +020700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +020800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +020900 END-ROUTINE. SG1014.2 +021000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1014.2 +021100 END-RTN-EXIT. SG1014.2 +021200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +021300 END-ROUTINE-1. SG1014.2 +021400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1014.2 +021500 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1014.2 +021600 ADD PASS-COUNTER TO ERROR-HOLD. SG1014.2 +021700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1014.2 +021800 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1014.2 +021900 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1014.2 +022000 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1014.2 +022100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1014.2 +022200 END-ROUTINE-12. SG1014.2 +022300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1014.2 +022400 IF ERROR-COUNTER IS EQUAL TO ZERO SG1014.2 +022500 MOVE "NO " TO ERROR-TOTAL SG1014.2 +022600 ELSE SG1014.2 +022700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1014.2 +022800 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1014.2 +022900 PERFORM WRITE-LINE. SG1014.2 +023000 END-ROUTINE-13. SG1014.2 +023100 IF DELETE-CNT IS EQUAL TO ZERO SG1014.2 +023200 MOVE "NO " TO ERROR-TOTAL ELSE SG1014.2 +023300 MOVE DELETE-CNT TO ERROR-TOTAL. SG1014.2 +023400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1014.2 +023500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +023600 IF INSPECT-COUNTER EQUAL TO ZERO SG1014.2 +023700 MOVE "NO " TO ERROR-TOTAL SG1014.2 +023800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1014.2 +023900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1014.2 +024000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +024100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1014.2 +024200 WRITE-LINE. SG1014.2 +024300 ADD 1 TO RECORD-COUNT. SG1014.2 +024400 IF RECORD-COUNT GREATER 50 SG1014.2 +024500 MOVE DUMMY-RECORD TO DUMMY-HOLD SG1014.2 +024600 MOVE SPACE TO DUMMY-RECORD SG1014.2 +024700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1014.2 +024800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1014.2 +024900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1014.2 +025000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1014.2 +025100 MOVE DUMMY-HOLD TO DUMMY-RECORD SG1014.2 +025200 MOVE ZERO TO RECORD-COUNT. SG1014.2 +025300 PERFORM WRT-LN. SG1014.2 +025400 WRT-LN. SG1014.2 +025500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1014.2 +025600 MOVE SPACE TO DUMMY-RECORD. SG1014.2 +025700 BLANK-LINE-PRINT. SG1014.2 +025800 PERFORM WRT-LN. SG1014.2 +025900 FAIL-ROUTINE. SG1014.2 +026000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1014.2 +026100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1014.2 +026200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1014.2 +026300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +026400 GO TO FAIL-ROUTINE-EX. SG1014.2 +026500 FAIL-ROUTINE-WRITE. SG1014.2 +026600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1014.2 +026700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1014.2 +026800 FAIL-ROUTINE-EX. EXIT. SG1014.2 +026900 BAIL-OUT. SG1014.2 +027000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1014.2 +027100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1014.2 +027200 BAIL-OUT-WRITE. SG1014.2 +027300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1014.2 +027400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1014.2 +027500 BAIL-OUT-EX. EXIT. SG1014.2 +027600 CCVS1-EXIT. SG1014.2 +027700 EXIT. SG1014.2 +027800 SECT-SG-01-001 SECTION 00. SG1014.2 +027900 SG-01-001. SG1014.2 +028000 MOVE "SEGMENTATION" TO FEATURE. SG1014.2 +028100 GO TO SEG-TEST-1. SG1014.2 +028200 00 SECTION 00. SG1014.2 +028300 PARA-00. SG1014.2 +028400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +028500 RUN-THE-TESTS SECTION. SG1014.2 +028600 SEG-TEST-1. SG1014.2 +028700 MOVE SPACE TO TEST-CHECK. SG1014.2 +028800 PERFORM 00. SG1014.2 +028900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +029000 PERFORM PASS SG1014.2 +029100 GO TO SEG-WRITE-1. SG1014.2 +029200 MOVE SPACE TO COMPUTED-A. SG1014.2 +029300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +029400 PERFORM FAIL. SG1014.2 +029500 GO TO SEG-WRITE-1. SG1014.2 +029600 SEG-DELETE-1. SG1014.2 +029700 PERFORM DE-LETE. SG1014.2 +029800 SEG-WRITE-1. SG1014.2 +029900 MOVE "SEG-TEST-1 " TO PAR-NAME. SG1014.2 +030000 PERFORM PRINT-DETAIL. SG1014.2 +030100 SEG-TEST-2. SG1014.2 +030200 MOVE SPACE TO TEST-CHECK. SG1014.2 +030300 PERFORM 01. SG1014.2 +030400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +030500 PERFORM PASS SG1014.2 +030600 GO TO SEG-WRITE-2. SG1014.2 +030700 MOVE SPACE TO COMPUTED-A. SG1014.2 +030800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +030900 PERFORM FAIL. SG1014.2 +031000 GO TO SEG-WRITE-2. SG1014.2 +031100 SEG-DELETE-2. SG1014.2 +031200 PERFORM DE-LETE. SG1014.2 +031300 SEG-WRITE-2. SG1014.2 +031400 MOVE "SEG-TEST-2 " TO PAR-NAME. SG1014.2 +031500 PERFORM PRINT-DETAIL. SG1014.2 +031600 SEG-TEST-3. SG1014.2 +031700 MOVE SPACE TO TEST-CHECK. SG1014.2 +031800 PERFORM 02. SG1014.2 +031900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +032000 PERFORM PASS SG1014.2 +032100 GO TO SEG-WRITE-3. SG1014.2 +032200 MOVE SPACE TO COMPUTED-A. SG1014.2 +032300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +032400 PERFORM FAIL. SG1014.2 +032500 GO TO SEG-WRITE-3. SG1014.2 +032600 SEG-DELETE-3. SG1014.2 +032700 PERFORM DE-LETE. SG1014.2 +032800 SEG-WRITE-3. SG1014.2 +032900 MOVE "SEG-TEST-3 " TO PAR-NAME. SG1014.2 +033000 PERFORM PRINT-DETAIL. SG1014.2 +033100 SEG-TEST-4. SG1014.2 +033200 MOVE SPACE TO TEST-CHECK. SG1014.2 +033300 PERFORM 03. SG1014.2 +033400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +033500 PERFORM PASS SG1014.2 +033600 GO TO SEG-WRITE-4. SG1014.2 +033700 MOVE SPACE TO COMPUTED-A. SG1014.2 +033800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +033900 PERFORM FAIL. SG1014.2 +034000 GO TO SEG-WRITE-4. SG1014.2 +034100 SEG-DELETE-4. SG1014.2 +034200 PERFORM DE-LETE. SG1014.2 +034300 SEG-WRITE-4. SG1014.2 +034400 MOVE "SEG-TEST-4 " TO PAR-NAME. SG1014.2 +034500 PERFORM PRINT-DETAIL. SG1014.2 +034600 SEG-TEST-5. SG1014.2 +034700 MOVE SPACE TO TEST-CHECK. SG1014.2 +034800 PERFORM 04. SG1014.2 +034900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +035000 PERFORM PASS SG1014.2 +035100 GO TO SEG-WRITE-5. SG1014.2 +035200 MOVE SPACE TO COMPUTED-A. SG1014.2 +035300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +035400 PERFORM FAIL. SG1014.2 +035500 GO TO SEG-WRITE-5. SG1014.2 +035600 SEG-DELETE-5. SG1014.2 +035700 PERFORM DE-LETE. SG1014.2 +035800 SEG-WRITE-5. SG1014.2 +035900 MOVE "SEG-TEST-5 " TO PAR-NAME. SG1014.2 +036000 PERFORM PRINT-DETAIL. SG1014.2 +036100 SEG-TEST-6. SG1014.2 +036200 MOVE SPACE TO TEST-CHECK. SG1014.2 +036300 PERFORM 05. SG1014.2 +036400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +036500 PERFORM PASS SG1014.2 +036600 GO TO SEG-WRITE-6. SG1014.2 +036700 MOVE SPACE TO COMPUTED-A. SG1014.2 +036800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +036900 PERFORM FAIL. SG1014.2 +037000 GO TO SEG-WRITE-6. SG1014.2 +037100 SEG-DELETE-6. SG1014.2 +037200 PERFORM DE-LETE. SG1014.2 +037300 SEG-WRITE-6. SG1014.2 +037400 MOVE "SEG-TEST-6 " TO PAR-NAME. SG1014.2 +037500 PERFORM PRINT-DETAIL. SG1014.2 +037600 SEG-TEST-7. SG1014.2 +037700 MOVE SPACE TO TEST-CHECK. SG1014.2 +037800 PERFORM 06. SG1014.2 +037900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +038000 PERFORM PASS SG1014.2 +038100 GO TO SEG-WRITE-7. SG1014.2 +038200 MOVE SPACE TO COMPUTED-A. SG1014.2 +038300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +038400 PERFORM FAIL. SG1014.2 +038500 GO TO SEG-WRITE-7. SG1014.2 +038600 SEG-DELETE-7. SG1014.2 +038700 PERFORM DE-LETE. SG1014.2 +038800 SEG-WRITE-7. SG1014.2 +038900 MOVE "SEG-TEST-7 " TO PAR-NAME. SG1014.2 +039000 PERFORM PRINT-DETAIL. SG1014.2 +039100 SEG-TEST-8. SG1014.2 +039200 MOVE SPACE TO TEST-CHECK. SG1014.2 +039300 PERFORM 07. SG1014.2 +039400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +039500 PERFORM PASS SG1014.2 +039600 GO TO SEG-WRITE-8. SG1014.2 +039700 MOVE SPACE TO COMPUTED-A. SG1014.2 +039800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +039900 PERFORM FAIL. SG1014.2 +040000 GO TO SEG-WRITE-8. SG1014.2 +040100 SEG-DELETE-8. SG1014.2 +040200 PERFORM DE-LETE. SG1014.2 +040300 SEG-WRITE-8. SG1014.2 +040400 MOVE "SEG-TEST-8 " TO PAR-NAME. SG1014.2 +040500 PERFORM PRINT-DETAIL. SG1014.2 +040600 SEG-TEST-9. SG1014.2 +040700 MOVE SPACE TO TEST-CHECK. SG1014.2 +040800 PERFORM 08. SG1014.2 +040900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +041000 PERFORM PASS SG1014.2 +041100 GO TO SEG-WRITE-9. SG1014.2 +041200 MOVE SPACE TO COMPUTED-A. SG1014.2 +041300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +041400 PERFORM FAIL. SG1014.2 +041500 GO TO SEG-WRITE-9. SG1014.2 +041600 SEG-DELETE-9. SG1014.2 +041700 PERFORM DE-LETE. SG1014.2 +041800 SEG-WRITE-9. SG1014.2 +041900 MOVE "SEG-TEST-9 " TO PAR-NAME. SG1014.2 +042000 PERFORM PRINT-DETAIL. SG1014.2 +042100 SEG-TEST-10. SG1014.2 +042200 MOVE SPACE TO TEST-CHECK. SG1014.2 +042300 PERFORM 09. SG1014.2 +042400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +042500 PERFORM PASS SG1014.2 +042600 GO TO SEG-WRITE-10. SG1014.2 +042700 MOVE SPACE TO COMPUTED-A. SG1014.2 +042800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +042900 PERFORM FAIL. SG1014.2 +043000 GO TO SEG-WRITE-10. SG1014.2 +043100 SEG-DELETE-10. SG1014.2 +043200 PERFORM DE-LETE. SG1014.2 +043300 SEG-WRITE-10. SG1014.2 +043400 MOVE "SEG-TEST-10 " TO PAR-NAME. SG1014.2 +043500 PERFORM PRINT-DETAIL. SG1014.2 +043600 SEG-TEST-11. SG1014.2 +043700 MOVE SPACE TO TEST-CHECK. SG1014.2 +043800 PERFORM 10. SG1014.2 +043900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +044000 PERFORM PASS SG1014.2 +044100 GO TO SEG-WRITE-11. SG1014.2 +044200 MOVE SPACE TO COMPUTED-A. SG1014.2 +044300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +044400 PERFORM FAIL. SG1014.2 +044500 GO TO SEG-WRITE-11. SG1014.2 +044600 SEG-DELETE-11. SG1014.2 +044700 PERFORM DE-LETE. SG1014.2 +044800 SEG-WRITE-11. SG1014.2 +044900 MOVE "SEG-TEST-11 " TO PAR-NAME. SG1014.2 +045000 PERFORM PRINT-DETAIL. SG1014.2 +045100 SEG-TEST-12. SG1014.2 +045200 MOVE SPACE TO TEST-CHECK. SG1014.2 +045300 PERFORM 11. SG1014.2 +045400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +045500 PERFORM PASS SG1014.2 +045600 GO TO SEG-WRITE-12. SG1014.2 +045700 MOVE SPACE TO COMPUTED-A. SG1014.2 +045800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +045900 PERFORM FAIL. SG1014.2 +046000 GO TO SEG-WRITE-12. SG1014.2 +046100 SEG-DELETE-12. SG1014.2 +046200 PERFORM DE-LETE. SG1014.2 +046300 SEG-WRITE-12. SG1014.2 +046400 MOVE "SEG-TEST-12 " TO PAR-NAME. SG1014.2 +046500 PERFORM PRINT-DETAIL. SG1014.2 +046600 SEG-TEST-13. SG1014.2 +046700 MOVE SPACE TO TEST-CHECK. SG1014.2 +046800 PERFORM 12. SG1014.2 +046900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +047000 PERFORM PASS SG1014.2 +047100 GO TO SEG-WRITE-13. SG1014.2 +047200 MOVE SPACE TO COMPUTED-A. SG1014.2 +047300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +047400 PERFORM FAIL. SG1014.2 +047500 GO TO SEG-WRITE-13. SG1014.2 +047600 SEG-DELETE-13. SG1014.2 +047700 PERFORM DE-LETE. SG1014.2 +047800 SEG-WRITE-13. SG1014.2 +047900 MOVE "SEG-TEST-13 " TO PAR-NAME. SG1014.2 +048000 PERFORM PRINT-DETAIL. SG1014.2 +048100 SEG-TEST-14. SG1014.2 +048200 MOVE SPACE TO TEST-CHECK. SG1014.2 +048300 PERFORM 13. SG1014.2 +048400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +048500 PERFORM PASS SG1014.2 +048600 GO TO SEG-WRITE-14. SG1014.2 +048700 MOVE SPACE TO COMPUTED-A. SG1014.2 +048800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +048900 PERFORM FAIL. SG1014.2 +049000 GO TO SEG-WRITE-14. SG1014.2 +049100 SEG-DELETE-14. SG1014.2 +049200 PERFORM DE-LETE. SG1014.2 +049300 SEG-WRITE-14. SG1014.2 +049400 MOVE "SEG-TEST-14 " TO PAR-NAME. SG1014.2 +049500 PERFORM PRINT-DETAIL. SG1014.2 +049600 SEG-TEST-15. SG1014.2 +049700 MOVE SPACE TO TEST-CHECK. SG1014.2 +049800 PERFORM 14. SG1014.2 +049900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +050000 PERFORM PASS SG1014.2 +050100 GO TO SEG-WRITE-15. SG1014.2 +050200 MOVE SPACE TO COMPUTED-A. SG1014.2 +050300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +050400 PERFORM FAIL. SG1014.2 +050500 GO TO SEG-WRITE-15. SG1014.2 +050600 SEG-DELETE-15. SG1014.2 +050700 PERFORM DE-LETE. SG1014.2 +050800 SEG-WRITE-15. SG1014.2 +050900 MOVE "SEG-TEST-15 " TO PAR-NAME. SG1014.2 +051000 PERFORM PRINT-DETAIL. SG1014.2 +051100 SEG-TEST-16. SG1014.2 +051200 MOVE SPACE TO TEST-CHECK. SG1014.2 +051300 PERFORM 15. SG1014.2 +051400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +051500 PERFORM PASS SG1014.2 +051600 GO TO SEG-WRITE-16. SG1014.2 +051700 MOVE SPACE TO COMPUTED-A. SG1014.2 +051800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +051900 PERFORM FAIL. SG1014.2 +052000 GO TO SEG-WRITE-16. SG1014.2 +052100 SEG-DELETE-16. SG1014.2 +052200 PERFORM DE-LETE. SG1014.2 +052300 SEG-WRITE-16. SG1014.2 +052400 MOVE "SEG-TEST-16 " TO PAR-NAME. SG1014.2 +052500 PERFORM PRINT-DETAIL. SG1014.2 +052600 SEG-TEST-17. SG1014.2 +052700 MOVE SPACE TO TEST-CHECK. SG1014.2 +052800 PERFORM 16. SG1014.2 +052900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +053000 PERFORM PASS SG1014.2 +053100 GO TO SEG-WRITE-17. SG1014.2 +053200 MOVE SPACE TO COMPUTED-A. SG1014.2 +053300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +053400 PERFORM FAIL. SG1014.2 +053500 GO TO SEG-WRITE-17. SG1014.2 +053600 SEG-DELETE-17. SG1014.2 +053700 PERFORM DE-LETE. SG1014.2 +053800 SEG-WRITE-17. SG1014.2 +053900 MOVE "SEG-TEST-17 " TO PAR-NAME. SG1014.2 +054000 PERFORM PRINT-DETAIL. SG1014.2 +054100 SEG-TEST-18. SG1014.2 +054200 MOVE SPACE TO TEST-CHECK. SG1014.2 +054300 PERFORM 17. SG1014.2 +054400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +054500 PERFORM PASS SG1014.2 +054600 GO TO SEG-WRITE-18. SG1014.2 +054700 MOVE SPACE TO COMPUTED-A. SG1014.2 +054800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +054900 PERFORM FAIL. SG1014.2 +055000 GO TO SEG-WRITE-18. SG1014.2 +055100 SEG-DELETE-18. SG1014.2 +055200 PERFORM DE-LETE. SG1014.2 +055300 SEG-WRITE-18. SG1014.2 +055400 MOVE "SEG-TEST-18 " TO PAR-NAME. SG1014.2 +055500 PERFORM PRINT-DETAIL. SG1014.2 +055600 SEG-TEST-19. SG1014.2 +055700 MOVE SPACE TO TEST-CHECK. SG1014.2 +055800 PERFORM 18. SG1014.2 +055900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +056000 PERFORM PASS SG1014.2 +056100 GO TO SEG-WRITE-19. SG1014.2 +056200 MOVE SPACE TO COMPUTED-A. SG1014.2 +056300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +056400 PERFORM FAIL. SG1014.2 +056500 GO TO SEG-WRITE-19. SG1014.2 +056600 SEG-DELETE-19. SG1014.2 +056700 PERFORM DE-LETE. SG1014.2 +056800 SEG-WRITE-19. SG1014.2 +056900 MOVE "SEG-TEST-19 " TO PAR-NAME. SG1014.2 +057000 PERFORM PRINT-DETAIL. SG1014.2 +057100 SEG-TEST-20. SG1014.2 +057200 MOVE SPACE TO TEST-CHECK. SG1014.2 +057300 PERFORM 19. SG1014.2 +057400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +057500 PERFORM PASS SG1014.2 +057600 GO TO SEG-WRITE-20. SG1014.2 +057700 MOVE SPACE TO COMPUTED-A. SG1014.2 +057800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +057900 PERFORM FAIL. SG1014.2 +058000 GO TO SEG-WRITE-20. SG1014.2 +058100 SEG-DELETE-20. SG1014.2 +058200 PERFORM DE-LETE. SG1014.2 +058300 SEG-WRITE-20. SG1014.2 +058400 MOVE "SEG-TEST-20 " TO PAR-NAME. SG1014.2 +058500 PERFORM PRINT-DETAIL. SG1014.2 +058600 SEG-TEST-21. SG1014.2 +058700 MOVE SPACE TO TEST-CHECK. SG1014.2 +058800 PERFORM 20. SG1014.2 +058900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +059000 PERFORM PASS SG1014.2 +059100 GO TO SEG-WRITE-21. SG1014.2 +059200 MOVE SPACE TO COMPUTED-A. SG1014.2 +059300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +059400 PERFORM FAIL. SG1014.2 +059500 GO TO SEG-WRITE-21. SG1014.2 +059600 SEG-DELETE-21. SG1014.2 +059700 PERFORM DE-LETE. SG1014.2 +059800 SEG-WRITE-21. SG1014.2 +059900 MOVE "SEG-TEST-21 " TO PAR-NAME. SG1014.2 +060000 PERFORM PRINT-DETAIL. SG1014.2 +060100 SEG-TEST-22. SG1014.2 +060200 MOVE SPACE TO TEST-CHECK. SG1014.2 +060300 PERFORM 21. SG1014.2 +060400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +060500 PERFORM PASS SG1014.2 +060600 GO TO SEG-WRITE-22. SG1014.2 +060700 MOVE SPACE TO COMPUTED-A. SG1014.2 +060800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +060900 PERFORM FAIL. SG1014.2 +061000 GO TO SEG-WRITE-22. SG1014.2 +061100 SEG-DELETE-22. SG1014.2 +061200 PERFORM DE-LETE. SG1014.2 +061300 SEG-WRITE-22. SG1014.2 +061400 MOVE "SEG-TEST-22 " TO PAR-NAME. SG1014.2 +061500 PERFORM PRINT-DETAIL. SG1014.2 +061600 SEG-TEST-23. SG1014.2 +061700 MOVE SPACE TO TEST-CHECK. SG1014.2 +061800 PERFORM 22. SG1014.2 +061900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +062000 PERFORM PASS SG1014.2 +062100 GO TO SEG-WRITE-23. SG1014.2 +062200 MOVE SPACE TO COMPUTED-A. SG1014.2 +062300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +062400 PERFORM FAIL. SG1014.2 +062500 GO TO SEG-WRITE-23. SG1014.2 +062600 SEG-DELETE-23. SG1014.2 +062700 PERFORM DE-LETE. SG1014.2 +062800 SEG-WRITE-23. SG1014.2 +062900 MOVE "SEG-TEST-23 " TO PAR-NAME. SG1014.2 +063000 PERFORM PRINT-DETAIL. SG1014.2 +063100 SEG-TEST-24. SG1014.2 +063200 MOVE SPACE TO TEST-CHECK. SG1014.2 +063300 PERFORM 23. SG1014.2 +063400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +063500 PERFORM PASS SG1014.2 +063600 GO TO SEG-WRITE-24. SG1014.2 +063700 MOVE SPACE TO COMPUTED-A. SG1014.2 +063800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +063900 PERFORM FAIL. SG1014.2 +064000 GO TO SEG-WRITE-24. SG1014.2 +064100 SEG-DELETE-24. SG1014.2 +064200 PERFORM DE-LETE. SG1014.2 +064300 SEG-WRITE-24. SG1014.2 +064400 MOVE "SEG-TEST-24 " TO PAR-NAME. SG1014.2 +064500 PERFORM PRINT-DETAIL. SG1014.2 +064600 SEG-TEST-25. SG1014.2 +064700 MOVE SPACE TO TEST-CHECK. SG1014.2 +064800 PERFORM 24. SG1014.2 +064900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +065000 PERFORM PASS SG1014.2 +065100 GO TO SEG-WRITE-25. SG1014.2 +065200 MOVE SPACE TO COMPUTED-A. SG1014.2 +065300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +065400 PERFORM FAIL. SG1014.2 +065500 GO TO SEG-WRITE-25. SG1014.2 +065600 SEG-DELETE-25. SG1014.2 +065700 PERFORM DE-LETE. SG1014.2 +065800 SEG-WRITE-25. SG1014.2 +065900 MOVE "SEG-TEST-25 " TO PAR-NAME. SG1014.2 +066000 PERFORM PRINT-DETAIL. SG1014.2 +066100 SEG-TEST-26. SG1014.2 +066200 MOVE SPACE TO TEST-CHECK. SG1014.2 +066300 PERFORM 25. SG1014.2 +066400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +066500 PERFORM PASS SG1014.2 +066600 GO TO SEG-WRITE-26. SG1014.2 +066700 MOVE SPACE TO COMPUTED-A. SG1014.2 +066800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +066900 PERFORM FAIL. SG1014.2 +067000 GO TO SEG-WRITE-26. SG1014.2 +067100 SEG-DELETE-26. SG1014.2 +067200 PERFORM DE-LETE. SG1014.2 +067300 SEG-WRITE-26. SG1014.2 +067400 MOVE "SEG-TEST-26 " TO PAR-NAME. SG1014.2 +067500 PERFORM PRINT-DETAIL. SG1014.2 +067600 SEG-TEST-27. SG1014.2 +067700 MOVE SPACE TO TEST-CHECK. SG1014.2 +067800 PERFORM 26. SG1014.2 +067900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +068000 PERFORM PASS SG1014.2 +068100 GO TO SEG-WRITE-27. SG1014.2 +068200 MOVE SPACE TO COMPUTED-A. SG1014.2 +068300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +068400 PERFORM FAIL. SG1014.2 +068500 GO TO SEG-WRITE-27. SG1014.2 +068600 SEG-DELETE-27. SG1014.2 +068700 PERFORM DE-LETE. SG1014.2 +068800 SEG-WRITE-27. SG1014.2 +068900 MOVE "SEG-TEST-27 " TO PAR-NAME. SG1014.2 +069000 PERFORM PRINT-DETAIL. SG1014.2 +069100 SEG-TEST-28. SG1014.2 +069200 MOVE SPACE TO TEST-CHECK. SG1014.2 +069300 PERFORM 27. SG1014.2 +069400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +069500 PERFORM PASS SG1014.2 +069600 GO TO SEG-WRITE-28. SG1014.2 +069700 MOVE SPACE TO COMPUTED-A. SG1014.2 +069800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +069900 PERFORM FAIL. SG1014.2 +070000 GO TO SEG-WRITE-28. SG1014.2 +070100 SEG-DELETE-28. SG1014.2 +070200 PERFORM DE-LETE. SG1014.2 +070300 SEG-WRITE-28. SG1014.2 +070400 MOVE "SEG-TEST-28 " TO PAR-NAME. SG1014.2 +070500 PERFORM PRINT-DETAIL. SG1014.2 +070600 SEG-TEST-29. SG1014.2 +070700 MOVE SPACE TO TEST-CHECK. SG1014.2 +070800 PERFORM 28. SG1014.2 +070900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +071000 PERFORM PASS SG1014.2 +071100 GO TO SEG-WRITE-29. SG1014.2 +071200 MOVE SPACE TO COMPUTED-A. SG1014.2 +071300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +071400 PERFORM FAIL. SG1014.2 +071500 GO TO SEG-WRITE-29. SG1014.2 +071600 SEG-DELETE-29. SG1014.2 +071700 PERFORM DE-LETE. SG1014.2 +071800 SEG-WRITE-29. SG1014.2 +071900 MOVE "SEG-TEST-29 " TO PAR-NAME. SG1014.2 +072000 PERFORM PRINT-DETAIL. SG1014.2 +072100 SEG-TEST-30. SG1014.2 +072200 MOVE SPACE TO TEST-CHECK. SG1014.2 +072300 PERFORM 29. SG1014.2 +072400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +072500 PERFORM PASS SG1014.2 +072600 GO TO SEG-WRITE-30. SG1014.2 +072700 MOVE SPACE TO COMPUTED-A. SG1014.2 +072800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +072900 PERFORM FAIL. SG1014.2 +073000 GO TO SEG-WRITE-30. SG1014.2 +073100 SEG-DELETE-30. SG1014.2 +073200 PERFORM DE-LETE. SG1014.2 +073300 SEG-WRITE-30. SG1014.2 +073400 MOVE "SEG-TEST-30 " TO PAR-NAME. SG1014.2 +073500 PERFORM PRINT-DETAIL. SG1014.2 +073600 SEG-TEST-31. SG1014.2 +073700 MOVE SPACE TO TEST-CHECK. SG1014.2 +073800 PERFORM 30. SG1014.2 +073900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +074000 PERFORM PASS SG1014.2 +074100 GO TO SEG-WRITE-31. SG1014.2 +074200 MOVE SPACE TO COMPUTED-A. SG1014.2 +074300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +074400 PERFORM FAIL. SG1014.2 +074500 GO TO SEG-WRITE-31. SG1014.2 +074600 SEG-DELETE-31. SG1014.2 +074700 PERFORM DE-LETE. SG1014.2 +074800 SEG-WRITE-31. SG1014.2 +074900 MOVE "SEG-TEST-31 " TO PAR-NAME. SG1014.2 +075000 PERFORM PRINT-DETAIL. SG1014.2 +075100 SEG-TEST-32. SG1014.2 +075200 MOVE SPACE TO TEST-CHECK. SG1014.2 +075300 PERFORM 31. SG1014.2 +075400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +075500 PERFORM PASS SG1014.2 +075600 GO TO SEG-WRITE-32. SG1014.2 +075700 MOVE SPACE TO COMPUTED-A. SG1014.2 +075800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +075900 PERFORM FAIL. SG1014.2 +076000 GO TO SEG-WRITE-32. SG1014.2 +076100 SEG-DELETE-32. SG1014.2 +076200 PERFORM DE-LETE. SG1014.2 +076300 SEG-WRITE-32. SG1014.2 +076400 MOVE "SEG-TEST-32 " TO PAR-NAME. SG1014.2 +076500 PERFORM PRINT-DETAIL. SG1014.2 +076600 SEG-TEST-33. SG1014.2 +076700 MOVE SPACE TO TEST-CHECK. SG1014.2 +076800 PERFORM 32. SG1014.2 +076900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +077000 PERFORM PASS SG1014.2 +077100 GO TO SEG-WRITE-33. SG1014.2 +077200 MOVE SPACE TO COMPUTED-A. SG1014.2 +077300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +077400 PERFORM FAIL. SG1014.2 +077500 GO TO SEG-WRITE-33. SG1014.2 +077600 SEG-DELETE-33. SG1014.2 +077700 PERFORM DE-LETE. SG1014.2 +077800 SEG-WRITE-33. SG1014.2 +077900 MOVE "SEG-TEST-33 " TO PAR-NAME. SG1014.2 +078000 PERFORM PRINT-DETAIL. SG1014.2 +078100 SEG-TEST-34. SG1014.2 +078200 MOVE SPACE TO TEST-CHECK. SG1014.2 +078300 PERFORM 33. SG1014.2 +078400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +078500 PERFORM PASS SG1014.2 +078600 GO TO SEG-WRITE-34. SG1014.2 +078700 MOVE SPACE TO COMPUTED-A. SG1014.2 +078800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +078900 PERFORM FAIL. SG1014.2 +079000 GO TO SEG-WRITE-34. SG1014.2 +079100 SEG-DELETE-34. SG1014.2 +079200 PERFORM DE-LETE. SG1014.2 +079300 SEG-WRITE-34. SG1014.2 +079400 MOVE "SEG-TEST-34 " TO PAR-NAME. SG1014.2 +079500 PERFORM PRINT-DETAIL. SG1014.2 +079600 SEG-TEST-35. SG1014.2 +079700 MOVE SPACE TO TEST-CHECK. SG1014.2 +079800 PERFORM 34. SG1014.2 +079900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +080000 PERFORM PASS SG1014.2 +080100 GO TO SEG-WRITE-35. SG1014.2 +080200 MOVE SPACE TO COMPUTED-A. SG1014.2 +080300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +080400 PERFORM FAIL. SG1014.2 +080500 GO TO SEG-WRITE-35. SG1014.2 +080600 SEG-DELETE-35. SG1014.2 +080700 PERFORM DE-LETE. SG1014.2 +080800 SEG-WRITE-35. SG1014.2 +080900 MOVE "SEG-TEST-35 " TO PAR-NAME. SG1014.2 +081000 PERFORM PRINT-DETAIL. SG1014.2 +081100 SEG-TEST-36. SG1014.2 +081200 MOVE SPACE TO TEST-CHECK. SG1014.2 +081300 PERFORM 35. SG1014.2 +081400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +081500 PERFORM PASS SG1014.2 +081600 GO TO SEG-WRITE-36. SG1014.2 +081700 MOVE SPACE TO COMPUTED-A. SG1014.2 +081800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +081900 PERFORM FAIL. SG1014.2 +082000 GO TO SEG-WRITE-36. SG1014.2 +082100 SEG-DELETE-36. SG1014.2 +082200 PERFORM DE-LETE. SG1014.2 +082300 SEG-WRITE-36. SG1014.2 +082400 MOVE "SEG-TEST-36 " TO PAR-NAME. SG1014.2 +082500 PERFORM PRINT-DETAIL. SG1014.2 +082600 SEG-TEST-37. SG1014.2 +082700 MOVE SPACE TO TEST-CHECK. SG1014.2 +082800 PERFORM 36. SG1014.2 +082900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +083000 PERFORM PASS SG1014.2 +083100 GO TO SEG-WRITE-37. SG1014.2 +083200 MOVE SPACE TO COMPUTED-A. SG1014.2 +083300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +083400 PERFORM FAIL. SG1014.2 +083500 GO TO SEG-WRITE-37. SG1014.2 +083600 SEG-DELETE-37. SG1014.2 +083700 PERFORM DE-LETE. SG1014.2 +083800 SEG-WRITE-37. SG1014.2 +083900 MOVE "SEG-TEST-37 " TO PAR-NAME. SG1014.2 +084000 PERFORM PRINT-DETAIL. SG1014.2 +084100 SEG-TEST-38. SG1014.2 +084200 MOVE SPACE TO TEST-CHECK. SG1014.2 +084300 PERFORM 37. SG1014.2 +084400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +084500 PERFORM PASS SG1014.2 +084600 GO TO SEG-WRITE-38. SG1014.2 +084700 MOVE SPACE TO COMPUTED-A. SG1014.2 +084800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +084900 PERFORM FAIL. SG1014.2 +085000 GO TO SEG-WRITE-38. SG1014.2 +085100 SEG-DELETE-38. SG1014.2 +085200 PERFORM DE-LETE. SG1014.2 +085300 SEG-WRITE-38. SG1014.2 +085400 MOVE "SEG-TEST-38 " TO PAR-NAME. SG1014.2 +085500 PERFORM PRINT-DETAIL. SG1014.2 +085600 SEG-TEST-39. SG1014.2 +085700 MOVE SPACE TO TEST-CHECK. SG1014.2 +085800 PERFORM 38. SG1014.2 +085900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +086000 PERFORM PASS SG1014.2 +086100 GO TO SEG-WRITE-39. SG1014.2 +086200 MOVE SPACE TO COMPUTED-A. SG1014.2 +086300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +086400 PERFORM FAIL. SG1014.2 +086500 GO TO SEG-WRITE-39. SG1014.2 +086600 SEG-DELETE-39. SG1014.2 +086700 PERFORM DE-LETE. SG1014.2 +086800 SEG-WRITE-39. SG1014.2 +086900 MOVE "SEG-TEST-39 " TO PAR-NAME. SG1014.2 +087000 PERFORM PRINT-DETAIL. SG1014.2 +087100 SEG-TEST-40. SG1014.2 +087200 MOVE SPACE TO TEST-CHECK. SG1014.2 +087300 PERFORM 39. SG1014.2 +087400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +087500 PERFORM PASS SG1014.2 +087600 GO TO SEG-WRITE-40. SG1014.2 +087700 MOVE SPACE TO COMPUTED-A. SG1014.2 +087800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +087900 PERFORM FAIL. SG1014.2 +088000 GO TO SEG-WRITE-40. SG1014.2 +088100 SEG-DELETE-40. SG1014.2 +088200 PERFORM DE-LETE. SG1014.2 +088300 SEG-WRITE-40. SG1014.2 +088400 MOVE "SEG-TEST-40 " TO PAR-NAME. SG1014.2 +088500 PERFORM PRINT-DETAIL. SG1014.2 +088600 SEG-TEST-41. SG1014.2 +088700 MOVE SPACE TO TEST-CHECK. SG1014.2 +088800 PERFORM 40. SG1014.2 +088900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +089000 PERFORM PASS SG1014.2 +089100 GO TO SEG-WRITE-41. SG1014.2 +089200 MOVE SPACE TO COMPUTED-A. SG1014.2 +089300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +089400 PERFORM FAIL. SG1014.2 +089500 GO TO SEG-WRITE-41. SG1014.2 +089600 SEG-DELETE-41. SG1014.2 +089700 PERFORM DE-LETE. SG1014.2 +089800 SEG-WRITE-41. SG1014.2 +089900 MOVE "SEG-TEST-41 " TO PAR-NAME. SG1014.2 +090000 PERFORM PRINT-DETAIL. SG1014.2 +090100 SEG-TEST-42. SG1014.2 +090200 MOVE SPACE TO TEST-CHECK. SG1014.2 +090300 PERFORM 41. SG1014.2 +090400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +090500 PERFORM PASS SG1014.2 +090600 GO TO SEG-WRITE-42. SG1014.2 +090700 MOVE SPACE TO COMPUTED-A. SG1014.2 +090800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +090900 PERFORM FAIL. SG1014.2 +091000 GO TO SEG-WRITE-42. SG1014.2 +091100 SEG-DELETE-42. SG1014.2 +091200 PERFORM DE-LETE. SG1014.2 +091300 SEG-WRITE-42. SG1014.2 +091400 MOVE "SEG-TEST-42 " TO PAR-NAME. SG1014.2 +091500 PERFORM PRINT-DETAIL. SG1014.2 +091600 SEG-TEST-43. SG1014.2 +091700 MOVE SPACE TO TEST-CHECK. SG1014.2 +091800 PERFORM 42. SG1014.2 +091900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +092000 PERFORM PASS SG1014.2 +092100 GO TO SEG-WRITE-43. SG1014.2 +092200 MOVE SPACE TO COMPUTED-A. SG1014.2 +092300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +092400 PERFORM FAIL. SG1014.2 +092500 GO TO SEG-WRITE-43. SG1014.2 +092600 SEG-DELETE-43. SG1014.2 +092700 PERFORM DE-LETE. SG1014.2 +092800 SEG-WRITE-43. SG1014.2 +092900 MOVE "SEG-TEST-43 " TO PAR-NAME. SG1014.2 +093000 PERFORM PRINT-DETAIL. SG1014.2 +093100 SEG-TEST-44. SG1014.2 +093200 MOVE SPACE TO TEST-CHECK. SG1014.2 +093300 PERFORM 43. SG1014.2 +093400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +093500 PERFORM PASS SG1014.2 +093600 GO TO SEG-WRITE-44. SG1014.2 +093700 MOVE SPACE TO COMPUTED-A. SG1014.2 +093800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +093900 PERFORM FAIL. SG1014.2 +094000 GO TO SEG-WRITE-44. SG1014.2 +094100 SEG-DELETE-44. SG1014.2 +094200 PERFORM DE-LETE. SG1014.2 +094300 SEG-WRITE-44. SG1014.2 +094400 MOVE "SEG-TEST-44 " TO PAR-NAME. SG1014.2 +094500 PERFORM PRINT-DETAIL. SG1014.2 +094600 SEG-TEST-45. SG1014.2 +094700 MOVE SPACE TO TEST-CHECK. SG1014.2 +094800 PERFORM 44. SG1014.2 +094900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +095000 PERFORM PASS SG1014.2 +095100 GO TO SEG-WRITE-45. SG1014.2 +095200 MOVE SPACE TO COMPUTED-A. SG1014.2 +095300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +095400 PERFORM FAIL. SG1014.2 +095500 GO TO SEG-WRITE-45. SG1014.2 +095600 SEG-DELETE-45. SG1014.2 +095700 PERFORM DE-LETE. SG1014.2 +095800 SEG-WRITE-45. SG1014.2 +095900 MOVE "SEG-TEST-45 " TO PAR-NAME. SG1014.2 +096000 PERFORM PRINT-DETAIL. SG1014.2 +096100 SEG-TEST-46. SG1014.2 +096200 MOVE SPACE TO TEST-CHECK. SG1014.2 +096300 PERFORM 45. SG1014.2 +096400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +096500 PERFORM PASS SG1014.2 +096600 GO TO SEG-WRITE-46. SG1014.2 +096700 MOVE SPACE TO COMPUTED-A. SG1014.2 +096800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +096900 PERFORM FAIL. SG1014.2 +097000 GO TO SEG-WRITE-46. SG1014.2 +097100 SEG-DELETE-46. SG1014.2 +097200 PERFORM DE-LETE. SG1014.2 +097300 SEG-WRITE-46. SG1014.2 +097400 MOVE "SEG-TEST-46 " TO PAR-NAME. SG1014.2 +097500 PERFORM PRINT-DETAIL. SG1014.2 +097600 SEG-TEST-47. SG1014.2 +097700 MOVE SPACE TO TEST-CHECK. SG1014.2 +097800 PERFORM 46. SG1014.2 +097900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +098000 PERFORM PASS SG1014.2 +098100 GO TO SEG-WRITE-47. SG1014.2 +098200 MOVE SPACE TO COMPUTED-A. SG1014.2 +098300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +098400 PERFORM FAIL. SG1014.2 +098500 GO TO SEG-WRITE-47. SG1014.2 +098600 SEG-DELETE-47. SG1014.2 +098700 PERFORM DE-LETE. SG1014.2 +098800 SEG-WRITE-47. SG1014.2 +098900 MOVE "SEG-TEST-47 " TO PAR-NAME. SG1014.2 +099000 PERFORM PRINT-DETAIL. SG1014.2 +099100 SEG-TEST-48. SG1014.2 +099200 MOVE SPACE TO TEST-CHECK. SG1014.2 +099300 PERFORM 47. SG1014.2 +099400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +099500 PERFORM PASS SG1014.2 +099600 GO TO SEG-WRITE-48. SG1014.2 +099700 MOVE SPACE TO COMPUTED-A. SG1014.2 +099800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +099900 PERFORM FAIL. SG1014.2 +100000 GO TO SEG-WRITE-48. SG1014.2 +100100 SEG-DELETE-48. SG1014.2 +100200 PERFORM DE-LETE. SG1014.2 +100300 SEG-WRITE-48. SG1014.2 +100400 MOVE "SEG-TEST-48 " TO PAR-NAME. SG1014.2 +100500 PERFORM PRINT-DETAIL. SG1014.2 +100600 SEG-TEST-49. SG1014.2 +100700 MOVE SPACE TO TEST-CHECK. SG1014.2 +100800 PERFORM 48. SG1014.2 +100900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +101000 PERFORM PASS SG1014.2 +101100 GO TO SEG-WRITE-49. SG1014.2 +101200 MOVE SPACE TO COMPUTED-A. SG1014.2 +101300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +101400 PERFORM FAIL. SG1014.2 +101500 GO TO SEG-WRITE-49. SG1014.2 +101600 SEG-DELETE-49. SG1014.2 +101700 PERFORM DE-LETE. SG1014.2 +101800 SEG-WRITE-49. SG1014.2 +101900 MOVE "SEG-TEST-49 " TO PAR-NAME. SG1014.2 +102000 PERFORM PRINT-DETAIL. SG1014.2 +102100 SEG-TEST-50. SG1014.2 +102200 MOVE SPACE TO TEST-CHECK. SG1014.2 +102300 PERFORM 49. SG1014.2 +102400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +102500 PERFORM PASS SG1014.2 +102600 GO TO SEG-WRITE-50. SG1014.2 +102700 MOVE SPACE TO COMPUTED-A. SG1014.2 +102800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +102900 PERFORM FAIL. SG1014.2 +103000 GO TO SEG-WRITE-50. SG1014.2 +103100 SEG-DELETE-50. SG1014.2 +103200 PERFORM DE-LETE. SG1014.2 +103300 SEG-WRITE-50. SG1014.2 +103400 MOVE "SEG-TEST-50 " TO PAR-NAME. SG1014.2 +103500 PERFORM PRINT-DETAIL. SG1014.2 +103600 SEG-TEST-51. SG1014.2 +103700 MOVE SPACE TO TEST-CHECK. SG1014.2 +103800 PERFORM 50. SG1014.2 +103900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +104000 PERFORM PASS SG1014.2 +104100 GO TO SEG-WRITE-51. SG1014.2 +104200 MOVE SPACE TO COMPUTED-A. SG1014.2 +104300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +104400 PERFORM FAIL. SG1014.2 +104500 GO TO SEG-WRITE-51. SG1014.2 +104600 SEG-DELETE-51. SG1014.2 +104700 PERFORM DE-LETE. SG1014.2 +104800 SEG-WRITE-51. SG1014.2 +104900 MOVE "SEG-TEST-51 " TO PAR-NAME. SG1014.2 +105000 PERFORM PRINT-DETAIL. SG1014.2 +105100 SEG-TEST-52. SG1014.2 +105200 MOVE SPACE TO TEST-CHECK. SG1014.2 +105300 PERFORM 51. SG1014.2 +105400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +105500 PERFORM PASS SG1014.2 +105600 GO TO SEG-WRITE-52. SG1014.2 +105700 MOVE SPACE TO COMPUTED-A. SG1014.2 +105800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +105900 PERFORM FAIL. SG1014.2 +106000 GO TO SEG-WRITE-52. SG1014.2 +106100 SEG-DELETE-52. SG1014.2 +106200 PERFORM DE-LETE. SG1014.2 +106300 SEG-WRITE-52. SG1014.2 +106400 MOVE "SEG-TEST-52 " TO PAR-NAME. SG1014.2 +106500 PERFORM PRINT-DETAIL. SG1014.2 +106600 SEG-TEST-53. SG1014.2 +106700 MOVE SPACE TO TEST-CHECK. SG1014.2 +106800 PERFORM 52. SG1014.2 +106900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +107000 PERFORM PASS SG1014.2 +107100 GO TO SEG-WRITE-53. SG1014.2 +107200 MOVE SPACE TO COMPUTED-A. SG1014.2 +107300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +107400 PERFORM FAIL. SG1014.2 +107500 GO TO SEG-WRITE-53. SG1014.2 +107600 SEG-DELETE-53. SG1014.2 +107700 PERFORM DE-LETE. SG1014.2 +107800 SEG-WRITE-53. SG1014.2 +107900 MOVE "SEG-TEST-53 " TO PAR-NAME. SG1014.2 +108000 PERFORM PRINT-DETAIL. SG1014.2 +108100 SEG-TEST-54. SG1014.2 +108200 MOVE SPACE TO TEST-CHECK. SG1014.2 +108300 PERFORM 53. SG1014.2 +108400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +108500 PERFORM PASS SG1014.2 +108600 GO TO SEG-WRITE-54. SG1014.2 +108700 MOVE SPACE TO COMPUTED-A. SG1014.2 +108800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +108900 PERFORM FAIL. SG1014.2 +109000 GO TO SEG-WRITE-54. SG1014.2 +109100 SEG-DELETE-54. SG1014.2 +109200 PERFORM DE-LETE. SG1014.2 +109300 SEG-WRITE-54. SG1014.2 +109400 MOVE "SEG-TEST-54 " TO PAR-NAME. SG1014.2 +109500 PERFORM PRINT-DETAIL. SG1014.2 +109600 SEG-TEST-55. SG1014.2 +109700 MOVE SPACE TO TEST-CHECK. SG1014.2 +109800 PERFORM 54. SG1014.2 +109900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +110000 PERFORM PASS SG1014.2 +110100 GO TO SEG-WRITE-55. SG1014.2 +110200 MOVE SPACE TO COMPUTED-A. SG1014.2 +110300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +110400 PERFORM FAIL. SG1014.2 +110500 GO TO SEG-WRITE-55. SG1014.2 +110600 SEG-DELETE-55. SG1014.2 +110700 PERFORM DE-LETE. SG1014.2 +110800 SEG-WRITE-55. SG1014.2 +110900 MOVE "SEG-TEST-55 " TO PAR-NAME. SG1014.2 +111000 PERFORM PRINT-DETAIL. SG1014.2 +111100 SEG-TEST-56. SG1014.2 +111200 MOVE SPACE TO TEST-CHECK. SG1014.2 +111300 PERFORM 55. SG1014.2 +111400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +111500 PERFORM PASS SG1014.2 +111600 GO TO SEG-WRITE-56. SG1014.2 +111700 MOVE SPACE TO COMPUTED-A. SG1014.2 +111800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +111900 PERFORM FAIL. SG1014.2 +112000 GO TO SEG-WRITE-56. SG1014.2 +112100 SEG-DELETE-56. SG1014.2 +112200 PERFORM DE-LETE. SG1014.2 +112300 SEG-WRITE-56. SG1014.2 +112400 MOVE "SEG-TEST-56 " TO PAR-NAME. SG1014.2 +112500 PERFORM PRINT-DETAIL. SG1014.2 +112600 SEG-TEST-57. SG1014.2 +112700 MOVE SPACE TO TEST-CHECK. SG1014.2 +112800 PERFORM 56. SG1014.2 +112900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +113000 PERFORM PASS SG1014.2 +113100 GO TO SEG-WRITE-57. SG1014.2 +113200 MOVE SPACE TO COMPUTED-A. SG1014.2 +113300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +113400 PERFORM FAIL. SG1014.2 +113500 GO TO SEG-WRITE-57. SG1014.2 +113600 SEG-DELETE-57. SG1014.2 +113700 PERFORM DE-LETE. SG1014.2 +113800 SEG-WRITE-57. SG1014.2 +113900 MOVE "SEG-TEST-57 " TO PAR-NAME. SG1014.2 +114000 PERFORM PRINT-DETAIL. SG1014.2 +114100 SEG-TEST-58. SG1014.2 +114200 MOVE SPACE TO TEST-CHECK. SG1014.2 +114300 PERFORM 57. SG1014.2 +114400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +114500 PERFORM PASS SG1014.2 +114600 GO TO SEG-WRITE-58. SG1014.2 +114700 MOVE SPACE TO COMPUTED-A. SG1014.2 +114800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +114900 PERFORM FAIL. SG1014.2 +115000 GO TO SEG-WRITE-58. SG1014.2 +115100 SEG-DELETE-58. SG1014.2 +115200 PERFORM DE-LETE. SG1014.2 +115300 SEG-WRITE-58. SG1014.2 +115400 MOVE "SEG-TEST-58 " TO PAR-NAME. SG1014.2 +115500 PERFORM PRINT-DETAIL. SG1014.2 +115600 SEG-TEST-59. SG1014.2 +115700 MOVE SPACE TO TEST-CHECK. SG1014.2 +115800 PERFORM 58. SG1014.2 +115900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +116000 PERFORM PASS SG1014.2 +116100 GO TO SEG-WRITE-59. SG1014.2 +116200 MOVE SPACE TO COMPUTED-A. SG1014.2 +116300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +116400 PERFORM FAIL. SG1014.2 +116500 GO TO SEG-WRITE-59. SG1014.2 +116600 SEG-DELETE-59. SG1014.2 +116700 PERFORM DE-LETE. SG1014.2 +116800 SEG-WRITE-59. SG1014.2 +116900 MOVE "SEG-TEST-59 " TO PAR-NAME. SG1014.2 +117000 PERFORM PRINT-DETAIL. SG1014.2 +117100 SEG-TEST-60. SG1014.2 +117200 MOVE SPACE TO TEST-CHECK. SG1014.2 +117300 PERFORM 59. SG1014.2 +117400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +117500 PERFORM PASS SG1014.2 +117600 GO TO SEG-WRITE-60. SG1014.2 +117700 MOVE SPACE TO COMPUTED-A. SG1014.2 +117800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +117900 PERFORM FAIL. SG1014.2 +118000 GO TO SEG-WRITE-60. SG1014.2 +118100 SEG-DELETE-60. SG1014.2 +118200 PERFORM DE-LETE. SG1014.2 +118300 SEG-WRITE-60. SG1014.2 +118400 MOVE "SEG-TEST-60 " TO PAR-NAME. SG1014.2 +118500 PERFORM PRINT-DETAIL. SG1014.2 +118600 SEG-TEST-61. SG1014.2 +118700 MOVE SPACE TO TEST-CHECK. SG1014.2 +118800 PERFORM 60. SG1014.2 +118900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +119000 PERFORM PASS SG1014.2 +119100 GO TO SEG-WRITE-61. SG1014.2 +119200 MOVE SPACE TO COMPUTED-A. SG1014.2 +119300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +119400 PERFORM FAIL. SG1014.2 +119500 GO TO SEG-WRITE-61. SG1014.2 +119600 SEG-DELETE-61. SG1014.2 +119700 PERFORM DE-LETE. SG1014.2 +119800 SEG-WRITE-61. SG1014.2 +119900 MOVE "SEG-TEST-61 " TO PAR-NAME. SG1014.2 +120000 PERFORM PRINT-DETAIL. SG1014.2 +120100 SEG-TEST-62. SG1014.2 +120200 MOVE SPACE TO TEST-CHECK. SG1014.2 +120300 PERFORM 61. SG1014.2 +120400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +120500 PERFORM PASS SG1014.2 +120600 GO TO SEG-WRITE-62. SG1014.2 +120700 MOVE SPACE TO COMPUTED-A. SG1014.2 +120800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +120900 PERFORM FAIL. SG1014.2 +121000 GO TO SEG-WRITE-62. SG1014.2 +121100 SEG-DELETE-62. SG1014.2 +121200 PERFORM DE-LETE. SG1014.2 +121300 SEG-WRITE-62. SG1014.2 +121400 MOVE "SEG-TEST-62 " TO PAR-NAME. SG1014.2 +121500 PERFORM PRINT-DETAIL. SG1014.2 +121600 SEG-TEST-63. SG1014.2 +121700 MOVE SPACE TO TEST-CHECK. SG1014.2 +121800 PERFORM 62. SG1014.2 +121900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +122000 PERFORM PASS SG1014.2 +122100 GO TO SEG-WRITE-63. SG1014.2 +122200 MOVE SPACE TO COMPUTED-A. SG1014.2 +122300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +122400 PERFORM FAIL. SG1014.2 +122500 GO TO SEG-WRITE-63. SG1014.2 +122600 SEG-DELETE-63. SG1014.2 +122700 PERFORM DE-LETE. SG1014.2 +122800 SEG-WRITE-63. SG1014.2 +122900 MOVE "SEG-TEST-63 " TO PAR-NAME. SG1014.2 +123000 PERFORM PRINT-DETAIL. SG1014.2 +123100 SEG-TEST-64. SG1014.2 +123200 MOVE SPACE TO TEST-CHECK. SG1014.2 +123300 PERFORM 63. SG1014.2 +123400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +123500 PERFORM PASS SG1014.2 +123600 GO TO SEG-WRITE-64. SG1014.2 +123700 MOVE SPACE TO COMPUTED-A. SG1014.2 +123800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +123900 PERFORM FAIL. SG1014.2 +124000 GO TO SEG-WRITE-64. SG1014.2 +124100 SEG-DELETE-64. SG1014.2 +124200 PERFORM DE-LETE. SG1014.2 +124300 SEG-WRITE-64. SG1014.2 +124400 MOVE "SEG-TEST-64 " TO PAR-NAME. SG1014.2 +124500 PERFORM PRINT-DETAIL. SG1014.2 +124600 SEG-TEST-65. SG1014.2 +124700 MOVE SPACE TO TEST-CHECK. SG1014.2 +124800 PERFORM 64. SG1014.2 +124900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +125000 PERFORM PASS SG1014.2 +125100 GO TO SEG-WRITE-65. SG1014.2 +125200 MOVE SPACE TO COMPUTED-A. SG1014.2 +125300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +125400 PERFORM FAIL. SG1014.2 +125500 GO TO SEG-WRITE-65. SG1014.2 +125600 SEG-DELETE-65. SG1014.2 +125700 PERFORM DE-LETE. SG1014.2 +125800 SEG-WRITE-65. SG1014.2 +125900 MOVE "SEG-TEST-65 " TO PAR-NAME. SG1014.2 +126000 PERFORM PRINT-DETAIL. SG1014.2 +126100 SEG-TEST-66. SG1014.2 +126200 MOVE SPACE TO TEST-CHECK. SG1014.2 +126300 PERFORM 65. SG1014.2 +126400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +126500 PERFORM PASS SG1014.2 +126600 GO TO SEG-WRITE-66. SG1014.2 +126700 MOVE SPACE TO COMPUTED-A. SG1014.2 +126800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +126900 PERFORM FAIL. SG1014.2 +127000 GO TO SEG-WRITE-66. SG1014.2 +127100 SEG-DELETE-66. SG1014.2 +127200 PERFORM DE-LETE. SG1014.2 +127300 SEG-WRITE-66. SG1014.2 +127400 MOVE "SEG-TEST-66 " TO PAR-NAME. SG1014.2 +127500 PERFORM PRINT-DETAIL. SG1014.2 +127600 SEG-TEST-67. SG1014.2 +127700 MOVE SPACE TO TEST-CHECK. SG1014.2 +127800 PERFORM 66. SG1014.2 +127900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +128000 PERFORM PASS SG1014.2 +128100 GO TO SEG-WRITE-67. SG1014.2 +128200 MOVE SPACE TO COMPUTED-A. SG1014.2 +128300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +128400 PERFORM FAIL. SG1014.2 +128500 GO TO SEG-WRITE-67. SG1014.2 +128600 SEG-DELETE-67. SG1014.2 +128700 PERFORM DE-LETE. SG1014.2 +128800 SEG-WRITE-67. SG1014.2 +128900 MOVE "SEG-TEST-67 " TO PAR-NAME. SG1014.2 +129000 PERFORM PRINT-DETAIL. SG1014.2 +129100 SEG-TEST-68. SG1014.2 +129200 MOVE SPACE TO TEST-CHECK. SG1014.2 +129300 PERFORM 67. SG1014.2 +129400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +129500 PERFORM PASS SG1014.2 +129600 GO TO SEG-WRITE-68. SG1014.2 +129700 MOVE SPACE TO COMPUTED-A. SG1014.2 +129800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +129900 PERFORM FAIL. SG1014.2 +130000 GO TO SEG-WRITE-68. SG1014.2 +130100 SEG-DELETE-68. SG1014.2 +130200 PERFORM DE-LETE. SG1014.2 +130300 SEG-WRITE-68. SG1014.2 +130400 MOVE "SEG-TEST-68 " TO PAR-NAME. SG1014.2 +130500 PERFORM PRINT-DETAIL. SG1014.2 +130600 SEG-TEST-69. SG1014.2 +130700 MOVE SPACE TO TEST-CHECK. SG1014.2 +130800 PERFORM 68. SG1014.2 +130900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +131000 PERFORM PASS SG1014.2 +131100 GO TO SEG-WRITE-69. SG1014.2 +131200 MOVE SPACE TO COMPUTED-A. SG1014.2 +131300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +131400 PERFORM FAIL. SG1014.2 +131500 GO TO SEG-WRITE-69. SG1014.2 +131600 SEG-DELETE-69. SG1014.2 +131700 PERFORM DE-LETE. SG1014.2 +131800 SEG-WRITE-69. SG1014.2 +131900 MOVE "SEG-TEST-69 " TO PAR-NAME. SG1014.2 +132000 PERFORM PRINT-DETAIL. SG1014.2 +132100 SEG-TEST-70. SG1014.2 +132200 MOVE SPACE TO TEST-CHECK. SG1014.2 +132300 PERFORM 69. SG1014.2 +132400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +132500 PERFORM PASS SG1014.2 +132600 GO TO SEG-WRITE-70. SG1014.2 +132700 MOVE SPACE TO COMPUTED-A. SG1014.2 +132800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +132900 PERFORM FAIL. SG1014.2 +133000 GO TO SEG-WRITE-70. SG1014.2 +133100 SEG-DELETE-70. SG1014.2 +133200 PERFORM DE-LETE. SG1014.2 +133300 SEG-WRITE-70. SG1014.2 +133400 MOVE "SEG-TEST-70 " TO PAR-NAME. SG1014.2 +133500 PERFORM PRINT-DETAIL. SG1014.2 +133600 SEG-TEST-71. SG1014.2 +133700 MOVE SPACE TO TEST-CHECK. SG1014.2 +133800 PERFORM 70. SG1014.2 +133900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +134000 PERFORM PASS SG1014.2 +134100 GO TO SEG-WRITE-71. SG1014.2 +134200 MOVE SPACE TO COMPUTED-A. SG1014.2 +134300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +134400 PERFORM FAIL. SG1014.2 +134500 GO TO SEG-WRITE-71. SG1014.2 +134600 SEG-DELETE-71. SG1014.2 +134700 PERFORM DE-LETE. SG1014.2 +134800 SEG-WRITE-71. SG1014.2 +134900 MOVE "SEG-TEST-71 " TO PAR-NAME. SG1014.2 +135000 PERFORM PRINT-DETAIL. SG1014.2 +135100 SEG-TEST-72. SG1014.2 +135200 MOVE SPACE TO TEST-CHECK. SG1014.2 +135300 PERFORM 71. SG1014.2 +135400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +135500 PERFORM PASS SG1014.2 +135600 GO TO SEG-WRITE-72. SG1014.2 +135700 MOVE SPACE TO COMPUTED-A. SG1014.2 +135800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +135900 PERFORM FAIL. SG1014.2 +136000 GO TO SEG-WRITE-72. SG1014.2 +136100 SEG-DELETE-72. SG1014.2 +136200 PERFORM DE-LETE. SG1014.2 +136300 SEG-WRITE-72. SG1014.2 +136400 MOVE "SEG-TEST-72 " TO PAR-NAME. SG1014.2 +136500 PERFORM PRINT-DETAIL. SG1014.2 +136600 SEG-TEST-73. SG1014.2 +136700 MOVE SPACE TO TEST-CHECK. SG1014.2 +136800 PERFORM 72. SG1014.2 +136900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +137000 PERFORM PASS SG1014.2 +137100 GO TO SEG-WRITE-73. SG1014.2 +137200 MOVE SPACE TO COMPUTED-A. SG1014.2 +137300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +137400 PERFORM FAIL. SG1014.2 +137500 GO TO SEG-WRITE-73. SG1014.2 +137600 SEG-DELETE-73. SG1014.2 +137700 PERFORM DE-LETE. SG1014.2 +137800 SEG-WRITE-73. SG1014.2 +137900 MOVE "SEG-TEST-73 " TO PAR-NAME. SG1014.2 +138000 PERFORM PRINT-DETAIL. SG1014.2 +138100 SEG-TEST-74. SG1014.2 +138200 MOVE SPACE TO TEST-CHECK. SG1014.2 +138300 PERFORM 73. SG1014.2 +138400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +138500 PERFORM PASS SG1014.2 +138600 GO TO SEG-WRITE-74. SG1014.2 +138700 MOVE SPACE TO COMPUTED-A. SG1014.2 +138800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +138900 PERFORM FAIL. SG1014.2 +139000 GO TO SEG-WRITE-74. SG1014.2 +139100 SEG-DELETE-74. SG1014.2 +139200 PERFORM DE-LETE. SG1014.2 +139300 SEG-WRITE-74. SG1014.2 +139400 MOVE "SEG-TEST-74 " TO PAR-NAME. SG1014.2 +139500 PERFORM PRINT-DETAIL. SG1014.2 +139600 SEG-TEST-75. SG1014.2 +139700 MOVE SPACE TO TEST-CHECK. SG1014.2 +139800 PERFORM 74. SG1014.2 +139900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +140000 PERFORM PASS SG1014.2 +140100 GO TO SEG-WRITE-75. SG1014.2 +140200 MOVE SPACE TO COMPUTED-A. SG1014.2 +140300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +140400 PERFORM FAIL. SG1014.2 +140500 GO TO SEG-WRITE-75. SG1014.2 +140600 SEG-DELETE-75. SG1014.2 +140700 PERFORM DE-LETE. SG1014.2 +140800 SEG-WRITE-75. SG1014.2 +140900 MOVE "SEG-TEST-75 " TO PAR-NAME. SG1014.2 +141000 PERFORM PRINT-DETAIL. SG1014.2 +141100 SEG-TEST-76. SG1014.2 +141200 MOVE SPACE TO TEST-CHECK. SG1014.2 +141300 PERFORM 75. SG1014.2 +141400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +141500 PERFORM PASS SG1014.2 +141600 GO TO SEG-WRITE-76. SG1014.2 +141700 MOVE SPACE TO COMPUTED-A. SG1014.2 +141800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +141900 PERFORM FAIL. SG1014.2 +142000 GO TO SEG-WRITE-76. SG1014.2 +142100 SEG-DELETE-76. SG1014.2 +142200 PERFORM DE-LETE. SG1014.2 +142300 SEG-WRITE-76. SG1014.2 +142400 MOVE "SEG-TEST-76 " TO PAR-NAME. SG1014.2 +142500 PERFORM PRINT-DETAIL. SG1014.2 +142600 SEG-TEST-77. SG1014.2 +142700 MOVE SPACE TO TEST-CHECK. SG1014.2 +142800 PERFORM 76. SG1014.2 +142900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +143000 PERFORM PASS SG1014.2 +143100 GO TO SEG-WRITE-77. SG1014.2 +143200 MOVE SPACE TO COMPUTED-A. SG1014.2 +143300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +143400 PERFORM FAIL. SG1014.2 +143500 GO TO SEG-WRITE-77. SG1014.2 +143600 SEG-DELETE-77. SG1014.2 +143700 PERFORM DE-LETE. SG1014.2 +143800 SEG-WRITE-77. SG1014.2 +143900 MOVE "SEG-TEST-77 " TO PAR-NAME. SG1014.2 +144000 PERFORM PRINT-DETAIL. SG1014.2 +144100 SEG-TEST-78. SG1014.2 +144200 MOVE SPACE TO TEST-CHECK. SG1014.2 +144300 PERFORM 77. SG1014.2 +144400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +144500 PERFORM PASS SG1014.2 +144600 GO TO SEG-WRITE-78. SG1014.2 +144700 MOVE SPACE TO COMPUTED-A. SG1014.2 +144800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +144900 PERFORM FAIL. SG1014.2 +145000 GO TO SEG-WRITE-78. SG1014.2 +145100 SEG-DELETE-78. SG1014.2 +145200 PERFORM DE-LETE. SG1014.2 +145300 SEG-WRITE-78. SG1014.2 +145400 MOVE "SEG-TEST-78 " TO PAR-NAME. SG1014.2 +145500 PERFORM PRINT-DETAIL. SG1014.2 +145600 SEG-TEST-79. SG1014.2 +145700 MOVE SPACE TO TEST-CHECK. SG1014.2 +145800 PERFORM 78. SG1014.2 +145900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +146000 PERFORM PASS SG1014.2 +146100 GO TO SEG-WRITE-79. SG1014.2 +146200 MOVE SPACE TO COMPUTED-A. SG1014.2 +146300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +146400 PERFORM FAIL. SG1014.2 +146500 GO TO SEG-WRITE-79. SG1014.2 +146600 SEG-DELETE-79. SG1014.2 +146700 PERFORM DE-LETE. SG1014.2 +146800 SEG-WRITE-79. SG1014.2 +146900 MOVE "SEG-TEST-79 " TO PAR-NAME. SG1014.2 +147000 PERFORM PRINT-DETAIL. SG1014.2 +147100 SEG-TEST-80. SG1014.2 +147200 MOVE SPACE TO TEST-CHECK. SG1014.2 +147300 PERFORM 79. SG1014.2 +147400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +147500 PERFORM PASS SG1014.2 +147600 GO TO SEG-WRITE-80. SG1014.2 +147700 MOVE SPACE TO COMPUTED-A. SG1014.2 +147800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +147900 PERFORM FAIL. SG1014.2 +148000 GO TO SEG-WRITE-80. SG1014.2 +148100 SEG-DELETE-80. SG1014.2 +148200 PERFORM DE-LETE. SG1014.2 +148300 SEG-WRITE-80. SG1014.2 +148400 MOVE "SEG-TEST-80 " TO PAR-NAME. SG1014.2 +148500 PERFORM PRINT-DETAIL. SG1014.2 +148600 SEG-TEST-81. SG1014.2 +148700 MOVE SPACE TO TEST-CHECK. SG1014.2 +148800 PERFORM 80. SG1014.2 +148900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +149000 PERFORM PASS SG1014.2 +149100 GO TO SEG-WRITE-81. SG1014.2 +149200 MOVE SPACE TO COMPUTED-A. SG1014.2 +149300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +149400 PERFORM FAIL. SG1014.2 +149500 GO TO SEG-WRITE-81. SG1014.2 +149600 SEG-DELETE-81. SG1014.2 +149700 PERFORM DE-LETE. SG1014.2 +149800 SEG-WRITE-81. SG1014.2 +149900 MOVE "SEG-TEST-81 " TO PAR-NAME. SG1014.2 +150000 PERFORM PRINT-DETAIL. SG1014.2 +150100 SEG-TEST-82. SG1014.2 +150200 MOVE SPACE TO TEST-CHECK. SG1014.2 +150300 PERFORM 81. SG1014.2 +150400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +150500 PERFORM PASS SG1014.2 +150600 GO TO SEG-WRITE-82. SG1014.2 +150700 MOVE SPACE TO COMPUTED-A. SG1014.2 +150800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +150900 PERFORM FAIL. SG1014.2 +151000 GO TO SEG-WRITE-82. SG1014.2 +151100 SEG-DELETE-82. SG1014.2 +151200 PERFORM DE-LETE. SG1014.2 +151300 SEG-WRITE-82. SG1014.2 +151400 MOVE "SEG-TEST-82 " TO PAR-NAME. SG1014.2 +151500 PERFORM PRINT-DETAIL. SG1014.2 +151600 SEG-TEST-83. SG1014.2 +151700 MOVE SPACE TO TEST-CHECK. SG1014.2 +151800 PERFORM 82. SG1014.2 +151900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +152000 PERFORM PASS SG1014.2 +152100 GO TO SEG-WRITE-83. SG1014.2 +152200 MOVE SPACE TO COMPUTED-A. SG1014.2 +152300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +152400 PERFORM FAIL. SG1014.2 +152500 GO TO SEG-WRITE-83. SG1014.2 +152600 SEG-DELETE-83. SG1014.2 +152700 PERFORM DE-LETE. SG1014.2 +152800 SEG-WRITE-83. SG1014.2 +152900 MOVE "SEG-TEST-83 " TO PAR-NAME. SG1014.2 +153000 PERFORM PRINT-DETAIL. SG1014.2 +153100 SEG-TEST-84. SG1014.2 +153200 MOVE SPACE TO TEST-CHECK. SG1014.2 +153300 PERFORM 83. SG1014.2 +153400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +153500 PERFORM PASS SG1014.2 +153600 GO TO SEG-WRITE-84. SG1014.2 +153700 MOVE SPACE TO COMPUTED-A. SG1014.2 +153800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +153900 PERFORM FAIL. SG1014.2 +154000 GO TO SEG-WRITE-84. SG1014.2 +154100 SEG-DELETE-84. SG1014.2 +154200 PERFORM DE-LETE. SG1014.2 +154300 SEG-WRITE-84. SG1014.2 +154400 MOVE "SEG-TEST-84 " TO PAR-NAME. SG1014.2 +154500 PERFORM PRINT-DETAIL. SG1014.2 +154600 SEG-TEST-85. SG1014.2 +154700 MOVE SPACE TO TEST-CHECK. SG1014.2 +154800 PERFORM 84. SG1014.2 +154900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +155000 PERFORM PASS SG1014.2 +155100 GO TO SEG-WRITE-85. SG1014.2 +155200 MOVE SPACE TO COMPUTED-A. SG1014.2 +155300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +155400 PERFORM FAIL. SG1014.2 +155500 GO TO SEG-WRITE-85. SG1014.2 +155600 SEG-DELETE-85. SG1014.2 +155700 PERFORM DE-LETE. SG1014.2 +155800 SEG-WRITE-85. SG1014.2 +155900 MOVE "SEG-TEST-85 " TO PAR-NAME. SG1014.2 +156000 PERFORM PRINT-DETAIL. SG1014.2 +156100 SEG-TEST-86. SG1014.2 +156200 MOVE SPACE TO TEST-CHECK. SG1014.2 +156300 PERFORM 85. SG1014.2 +156400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +156500 PERFORM PASS SG1014.2 +156600 GO TO SEG-WRITE-86. SG1014.2 +156700 MOVE SPACE TO COMPUTED-A. SG1014.2 +156800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +156900 PERFORM FAIL. SG1014.2 +157000 GO TO SEG-WRITE-86. SG1014.2 +157100 SEG-DELETE-86. SG1014.2 +157200 PERFORM DE-LETE. SG1014.2 +157300 SEG-WRITE-86. SG1014.2 +157400 MOVE "SEG-TEST-86 " TO PAR-NAME. SG1014.2 +157500 PERFORM PRINT-DETAIL. SG1014.2 +157600 SEG-TEST-87. SG1014.2 +157700 MOVE SPACE TO TEST-CHECK. SG1014.2 +157800 PERFORM 86. SG1014.2 +157900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +158000 PERFORM PASS SG1014.2 +158100 GO TO SEG-WRITE-87. SG1014.2 +158200 MOVE SPACE TO COMPUTED-A. SG1014.2 +158300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +158400 PERFORM FAIL. SG1014.2 +158500 GO TO SEG-WRITE-87. SG1014.2 +158600 SEG-DELETE-87. SG1014.2 +158700 PERFORM DE-LETE. SG1014.2 +158800 SEG-WRITE-87. SG1014.2 +158900 MOVE "SEG-TEST-87 " TO PAR-NAME. SG1014.2 +159000 PERFORM PRINT-DETAIL. SG1014.2 +159100 SEG-TEST-88. SG1014.2 +159200 MOVE SPACE TO TEST-CHECK. SG1014.2 +159300 PERFORM 87. SG1014.2 +159400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +159500 PERFORM PASS SG1014.2 +159600 GO TO SEG-WRITE-88. SG1014.2 +159700 MOVE SPACE TO COMPUTED-A. SG1014.2 +159800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +159900 PERFORM FAIL. SG1014.2 +160000 GO TO SEG-WRITE-88. SG1014.2 +160100 SEG-DELETE-88. SG1014.2 +160200 PERFORM DE-LETE. SG1014.2 +160300 SEG-WRITE-88. SG1014.2 +160400 MOVE "SEG-TEST-88 " TO PAR-NAME. SG1014.2 +160500 PERFORM PRINT-DETAIL. SG1014.2 +160600 SEG-TEST-89. SG1014.2 +160700 MOVE SPACE TO TEST-CHECK. SG1014.2 +160800 PERFORM 88. SG1014.2 +160900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +161000 PERFORM PASS SG1014.2 +161100 GO TO SEG-WRITE-89. SG1014.2 +161200 MOVE SPACE TO COMPUTED-A. SG1014.2 +161300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +161400 PERFORM FAIL. SG1014.2 +161500 GO TO SEG-WRITE-89. SG1014.2 +161600 SEG-DELETE-89. SG1014.2 +161700 PERFORM DE-LETE. SG1014.2 +161800 SEG-WRITE-89. SG1014.2 +161900 MOVE "SEG-TEST-89 " TO PAR-NAME. SG1014.2 +162000 PERFORM PRINT-DETAIL. SG1014.2 +162100 SEG-TEST-90. SG1014.2 +162200 MOVE SPACE TO TEST-CHECK. SG1014.2 +162300 PERFORM 89. SG1014.2 +162400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +162500 PERFORM PASS SG1014.2 +162600 GO TO SEG-WRITE-90. SG1014.2 +162700 MOVE SPACE TO COMPUTED-A. SG1014.2 +162800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +162900 PERFORM FAIL. SG1014.2 +163000 GO TO SEG-WRITE-90. SG1014.2 +163100 SEG-DELETE-90. SG1014.2 +163200 PERFORM DE-LETE. SG1014.2 +163300 SEG-WRITE-90. SG1014.2 +163400 MOVE "SEG-TEST-90 " TO PAR-NAME. SG1014.2 +163500 PERFORM PRINT-DETAIL. SG1014.2 +163600 SEG-TEST-91. SG1014.2 +163700 MOVE SPACE TO TEST-CHECK. SG1014.2 +163800 PERFORM 90. SG1014.2 +163900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +164000 PERFORM PASS SG1014.2 +164100 GO TO SEG-WRITE-91. SG1014.2 +164200 MOVE SPACE TO COMPUTED-A. SG1014.2 +164300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +164400 PERFORM FAIL. SG1014.2 +164500 GO TO SEG-WRITE-91. SG1014.2 +164600 SEG-DELETE-91. SG1014.2 +164700 PERFORM DE-LETE. SG1014.2 +164800 SEG-WRITE-91. SG1014.2 +164900 MOVE "SEG-TEST-91 " TO PAR-NAME. SG1014.2 +165000 PERFORM PRINT-DETAIL. SG1014.2 +165100 SEG-TEST-92. SG1014.2 +165200 MOVE SPACE TO TEST-CHECK. SG1014.2 +165300 PERFORM 91. SG1014.2 +165400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +165500 PERFORM PASS SG1014.2 +165600 GO TO SEG-WRITE-92. SG1014.2 +165700 MOVE SPACE TO COMPUTED-A. SG1014.2 +165800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +165900 PERFORM FAIL. SG1014.2 +166000 GO TO SEG-WRITE-92. SG1014.2 +166100 SEG-DELETE-92. SG1014.2 +166200 PERFORM DE-LETE. SG1014.2 +166300 SEG-WRITE-92. SG1014.2 +166400 MOVE "SEG-TEST-92 " TO PAR-NAME. SG1014.2 +166500 PERFORM PRINT-DETAIL. SG1014.2 +166600 SEG-TEST-93. SG1014.2 +166700 MOVE SPACE TO TEST-CHECK. SG1014.2 +166800 PERFORM 92. SG1014.2 +166900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +167000 PERFORM PASS SG1014.2 +167100 GO TO SEG-WRITE-93. SG1014.2 +167200 MOVE SPACE TO COMPUTED-A. SG1014.2 +167300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +167400 PERFORM FAIL. SG1014.2 +167500 GO TO SEG-WRITE-93. SG1014.2 +167600 SEG-DELETE-93. SG1014.2 +167700 PERFORM DE-LETE. SG1014.2 +167800 SEG-WRITE-93. SG1014.2 +167900 MOVE "SEG-TEST-93 " TO PAR-NAME. SG1014.2 +168000 PERFORM PRINT-DETAIL. SG1014.2 +168100 SEG-TEST-94. SG1014.2 +168200 MOVE SPACE TO TEST-CHECK. SG1014.2 +168300 PERFORM 93. SG1014.2 +168400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +168500 PERFORM PASS SG1014.2 +168600 GO TO SEG-WRITE-94. SG1014.2 +168700 MOVE SPACE TO COMPUTED-A. SG1014.2 +168800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +168900 PERFORM FAIL. SG1014.2 +169000 GO TO SEG-WRITE-94. SG1014.2 +169100 SEG-DELETE-94. SG1014.2 +169200 PERFORM DE-LETE. SG1014.2 +169300 SEG-WRITE-94. SG1014.2 +169400 MOVE "SEG-TEST-94 " TO PAR-NAME. SG1014.2 +169500 PERFORM PRINT-DETAIL. SG1014.2 +169600 SEG-TEST-95. SG1014.2 +169700 MOVE SPACE TO TEST-CHECK. SG1014.2 +169800 PERFORM 94. SG1014.2 +169900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +170000 PERFORM PASS SG1014.2 +170100 GO TO SEG-WRITE-95. SG1014.2 +170200 MOVE SPACE TO COMPUTED-A. SG1014.2 +170300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +170400 PERFORM FAIL. SG1014.2 +170500 GO TO SEG-WRITE-95. SG1014.2 +170600 SEG-DELETE-95. SG1014.2 +170700 PERFORM DE-LETE. SG1014.2 +170800 SEG-WRITE-95. SG1014.2 +170900 MOVE "SEG-TEST-95 " TO PAR-NAME. SG1014.2 +171000 PERFORM PRINT-DETAIL. SG1014.2 +171100 SEG-TEST-96. SG1014.2 +171200 MOVE SPACE TO TEST-CHECK. SG1014.2 +171300 PERFORM 95. SG1014.2 +171400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +171500 PERFORM PASS SG1014.2 +171600 GO TO SEG-WRITE-96. SG1014.2 +171700 MOVE SPACE TO COMPUTED-A. SG1014.2 +171800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +171900 PERFORM FAIL. SG1014.2 +172000 GO TO SEG-WRITE-96. SG1014.2 +172100 SEG-DELETE-96. SG1014.2 +172200 PERFORM DE-LETE. SG1014.2 +172300 SEG-WRITE-96. SG1014.2 +172400 MOVE "SEG-TEST-96 " TO PAR-NAME. SG1014.2 +172500 PERFORM PRINT-DETAIL. SG1014.2 +172600 SEG-TEST-97. SG1014.2 +172700 MOVE SPACE TO TEST-CHECK. SG1014.2 +172800 PERFORM 96. SG1014.2 +172900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +173000 PERFORM PASS SG1014.2 +173100 GO TO SEG-WRITE-97. SG1014.2 +173200 MOVE SPACE TO COMPUTED-A. SG1014.2 +173300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +173400 PERFORM FAIL. SG1014.2 +173500 GO TO SEG-WRITE-97. SG1014.2 +173600 SEG-DELETE-97. SG1014.2 +173700 PERFORM DE-LETE. SG1014.2 +173800 SEG-WRITE-97. SG1014.2 +173900 MOVE "SEG-TEST-97 " TO PAR-NAME. SG1014.2 +174000 PERFORM PRINT-DETAIL. SG1014.2 +174100 SEG-TEST-98. SG1014.2 +174200 MOVE SPACE TO TEST-CHECK. SG1014.2 +174300 PERFORM 97. SG1014.2 +174400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +174500 PERFORM PASS SG1014.2 +174600 GO TO SEG-WRITE-98. SG1014.2 +174700 MOVE SPACE TO COMPUTED-A. SG1014.2 +174800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +174900 PERFORM FAIL. SG1014.2 +175000 GO TO SEG-WRITE-98. SG1014.2 +175100 SEG-DELETE-98. SG1014.2 +175200 PERFORM DE-LETE. SG1014.2 +175300 SEG-WRITE-98. SG1014.2 +175400 MOVE "SEG-TEST-98 " TO PAR-NAME. SG1014.2 +175500 PERFORM PRINT-DETAIL. SG1014.2 +175600 SEG-TEST-99. SG1014.2 +175700 MOVE SPACE TO TEST-CHECK. SG1014.2 +175800 PERFORM 98. SG1014.2 +175900 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +176000 PERFORM PASS SG1014.2 +176100 GO TO SEG-WRITE-99. SG1014.2 +176200 MOVE SPACE TO COMPUTED-A. SG1014.2 +176300 MOVE "GOOD" TO CORRECT-A. SG1014.2 +176400 PERFORM FAIL. SG1014.2 +176500 GO TO SEG-WRITE-99. SG1014.2 +176600 SEG-DELETE-99. SG1014.2 +176700 PERFORM DE-LETE. SG1014.2 +176800 SEG-WRITE-99. SG1014.2 +176900 MOVE "SEG-TEST-99 " TO PAR-NAME. SG1014.2 +177000 PERFORM PRINT-DETAIL. SG1014.2 +177100 SEG-TEST-100. SG1014.2 +177200 MOVE SPACE TO TEST-CHECK. SG1014.2 +177300 PERFORM 99. SG1014.2 +177400 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +177500 PERFORM PASS SG1014.2 +177600 GO TO SEG-WRITE-100. SG1014.2 +177700 MOVE SPACE TO COMPUTED-A. SG1014.2 +177800 MOVE "GOOD" TO CORRECT-A. SG1014.2 +177900 PERFORM FAIL. SG1014.2 +178000 GO TO SEG-WRITE-100. SG1014.2 +178100 SEG-DELETE-100. SG1014.2 +178200 PERFORM DE-LETE. SG1014.2 +178300 SEG-WRITE-100. SG1014.2 +178400 MOVE "SEG-TEST-100" TO PAR-NAME. SG1014.2 +178500 PERFORM PRINT-DETAIL. SG1014.2 +178600 GO TO SECOND-HALF. SG1014.2 +178700 01 SECTION 01. SG1014.2 +178800 PARA-01. SG1014.2 +178900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +179000 02 SECTION 02. SG1014.2 +179100 PARA-02. SG1014.2 +179200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +179300 03 SECTION 03. SG1014.2 +179400 PARA-03. SG1014.2 +179500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +179600 04 SECTION 04. SG1014.2 +179700 PARA-04. SG1014.2 +179800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +179900 05 SECTION 05. SG1014.2 +180000 PARA-05. SG1014.2 +180100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +180200 06 SECTION 06. SG1014.2 +180300 PARA-06. SG1014.2 +180400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +180500 07 SECTION 07. SG1014.2 +180600 PARA-07. SG1014.2 +180700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +180800 08 SECTION 08. SG1014.2 +180900 PARA-08. SG1014.2 +181000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +181100 09 SECTION 09. SG1014.2 +181200 PARA-09. SG1014.2 +181300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +181400 10 SECTION 10. SG1014.2 +181500 PARA-10. SG1014.2 +181600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +181700 11 SECTION 11. SG1014.2 +181800 PARA-11. SG1014.2 +181900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +182000 12 SECTION 12. SG1014.2 +182100 PARA-12. SG1014.2 +182200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +182300 13 SECTION 13. SG1014.2 +182400 PARA-13. SG1014.2 +182500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +182600 14 SECTION 14. SG1014.2 +182700 PARA-14. SG1014.2 +182800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +182900 15 SECTION 15. SG1014.2 +183000 PARA-15. SG1014.2 +183100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +183200 16 SECTION 16. SG1014.2 +183300 PARA-16. SG1014.2 +183400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +183500 17 SECTION 17. SG1014.2 +183600 PARA-17. SG1014.2 +183700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +183800 18 SECTION 18. SG1014.2 +183900 PARA-18. SG1014.2 +184000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +184100 19 SECTION 19. SG1014.2 +184200 PARA-19. SG1014.2 +184300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +184400 20 SECTION 20. SG1014.2 +184500 PARA-20. SG1014.2 +184600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +184700 21 SECTION 21. SG1014.2 +184800 PARA-21. SG1014.2 +184900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +185000 22 SECTION 22. SG1014.2 +185100 PARA-22. SG1014.2 +185200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +185300 23 SECTION 23. SG1014.2 +185400 PARA-23. SG1014.2 +185500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +185600 24 SECTION 24. SG1014.2 +185700 PARA-24. SG1014.2 +185800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +185900 25 SECTION 25. SG1014.2 +186000 PARA-25. SG1014.2 +186100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +186200 26 SECTION 26. SG1014.2 +186300 PARA-26. SG1014.2 +186400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +186500 27 SECTION 27. SG1014.2 +186600 PARA-27. SG1014.2 +186700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +186800 28 SECTION 28. SG1014.2 +186900 PARA-28. SG1014.2 +187000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +187100 29 SECTION 29. SG1014.2 +187200 PARA-29. SG1014.2 +187300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +187400 30 SECTION 30. SG1014.2 +187500 PARA-30. SG1014.2 +187600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +187700 31 SECTION 31. SG1014.2 +187800 PARA-31. SG1014.2 +187900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +188000 32 SECTION 32. SG1014.2 +188100 PARA-32. SG1014.2 +188200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +188300 33 SECTION 33. SG1014.2 +188400 PARA-33. SG1014.2 +188500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +188600 34 SECTION 34. SG1014.2 +188700 PARA-34. SG1014.2 +188800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +188900 35 SECTION 35. SG1014.2 +189000 PARA-35. SG1014.2 +189100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +189200 36 SECTION 36. SG1014.2 +189300 PARA-36. SG1014.2 +189400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +189500 37 SECTION 37. SG1014.2 +189600 PARA-37. SG1014.2 +189700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +189800 38 SECTION 38. SG1014.2 +189900 PARA-38. SG1014.2 +190000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +190100 39 SECTION 39. SG1014.2 +190200 PARA-39. SG1014.2 +190300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +190400 40 SECTION 40. SG1014.2 +190500 PARA-40. SG1014.2 +190600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +190700 41 SECTION 41. SG1014.2 +190800 PARA-41. SG1014.2 +190900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +191000 42 SECTION 42. SG1014.2 +191100 PARA-42. SG1014.2 +191200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +191300 43 SECTION 43. SG1014.2 +191400 PARA-43. SG1014.2 +191500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +191600 44 SECTION 44. SG1014.2 +191700 PARA-44. SG1014.2 +191800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +191900 45 SECTION 45. SG1014.2 +192000 PARA-45. SG1014.2 +192100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +192200 46 SECTION 46. SG1014.2 +192300 PARA-46. SG1014.2 +192400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +192500 47 SECTION 47. SG1014.2 +192600 PARA-47. SG1014.2 +192700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +192800 48 SECTION 48. SG1014.2 +192900 PARA-48. SG1014.2 +193000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +193100 49 SECTION 49. SG1014.2 +193200 PARA-49. SG1014.2 +193300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +193400 SECOND-HALF SECTION 50. SG1014.2 +193500 SEG-TEST-101. SG1014.2 +193600 MOVE SPACE TO TEST-CHECK. SG1014.2 +193700 PERFORM 50. SG1014.2 +193800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +193900 PERFORM PASS SG1014.2 +194000 GO TO SEG-WRITE-101. SG1014.2 +194100 MOVE SPACE TO COMPUTED-A. SG1014.2 +194200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +194300 PERFORM FAIL. SG1014.2 +194400 GO TO SEG-WRITE-101. SG1014.2 +194500 SEG-DELETE-101. SG1014.2 +194600 PERFORM DE-LETE. SG1014.2 +194700 SEG-WRITE-101. SG1014.2 +194800 MOVE "SEG-TEST-101" TO PAR-NAME. SG1014.2 +194900 PERFORM PRINT-DETAIL. SG1014.2 +195000 SEG-TEST-102. SG1014.2 +195100 MOVE SPACE TO TEST-CHECK. SG1014.2 +195200 PERFORM 49. SG1014.2 +195300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +195400 PERFORM PASS SG1014.2 +195500 GO TO SEG-WRITE-102. SG1014.2 +195600 MOVE SPACE TO COMPUTED-A. SG1014.2 +195700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +195800 PERFORM FAIL. SG1014.2 +195900 GO TO SEG-WRITE-102. SG1014.2 +196000 SEG-DELETE-102. SG1014.2 +196100 PERFORM DE-LETE. SG1014.2 +196200 SEG-WRITE-102. SG1014.2 +196300 MOVE "SEG-TEST-102" TO PAR-NAME. SG1014.2 +196400 PERFORM PRINT-DETAIL. SG1014.2 +196500 SEG-TEST-103. SG1014.2 +196600 MOVE SPACE TO TEST-CHECK. SG1014.2 +196700 PERFORM 48. SG1014.2 +196800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +196900 PERFORM PASS SG1014.2 +197000 GO TO SEG-WRITE-103. SG1014.2 +197100 MOVE SPACE TO COMPUTED-A. SG1014.2 +197200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +197300 PERFORM FAIL. SG1014.2 +197400 GO TO SEG-WRITE-103. SG1014.2 +197500 SEG-DELETE-103. SG1014.2 +197600 PERFORM DE-LETE. SG1014.2 +197700 SEG-WRITE-103. SG1014.2 +197800 MOVE "SEG-TEST-103" TO PAR-NAME. SG1014.2 +197900 PERFORM PRINT-DETAIL. SG1014.2 +198000 SEG-TEST-104. SG1014.2 +198100 MOVE SPACE TO TEST-CHECK. SG1014.2 +198200 PERFORM 47. SG1014.2 +198300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +198400 PERFORM PASS SG1014.2 +198500 GO TO SEG-WRITE-104. SG1014.2 +198600 MOVE SPACE TO COMPUTED-A. SG1014.2 +198700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +198800 PERFORM FAIL. SG1014.2 +198900 GO TO SEG-WRITE-104. SG1014.2 +199000 SEG-DELETE-104. SG1014.2 +199100 PERFORM DE-LETE. SG1014.2 +199200 SEG-WRITE-104. SG1014.2 +199300 MOVE "SEG-TEST-104" TO PAR-NAME. SG1014.2 +199400 PERFORM PRINT-DETAIL. SG1014.2 +199500 SEG-TEST-105. SG1014.2 +199600 MOVE SPACE TO TEST-CHECK. SG1014.2 +199700 PERFORM 46. SG1014.2 +199800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +199900 PERFORM PASS SG1014.2 +200000 GO TO SEG-WRITE-105. SG1014.2 +200100 MOVE SPACE TO COMPUTED-A. SG1014.2 +200200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +200300 PERFORM FAIL. SG1014.2 +200400 GO TO SEG-WRITE-105. SG1014.2 +200500 SEG-DELETE-105. SG1014.2 +200600 PERFORM DE-LETE. SG1014.2 +200700 SEG-WRITE-105. SG1014.2 +200800 MOVE "SEG-TEST-105" TO PAR-NAME. SG1014.2 +200900 PERFORM PRINT-DETAIL. SG1014.2 +201000 SEG-TEST-106. SG1014.2 +201100 MOVE SPACE TO TEST-CHECK. SG1014.2 +201200 PERFORM 45. SG1014.2 +201300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +201400 PERFORM PASS SG1014.2 +201500 GO TO SEG-WRITE-106. SG1014.2 +201600 MOVE SPACE TO COMPUTED-A. SG1014.2 +201700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +201800 PERFORM FAIL. SG1014.2 +201900 GO TO SEG-WRITE-106. SG1014.2 +202000 SEG-DELETE-106. SG1014.2 +202100 PERFORM DE-LETE. SG1014.2 +202200 SEG-WRITE-106. SG1014.2 +202300 MOVE "SEG-TEST-106" TO PAR-NAME. SG1014.2 +202400 PERFORM PRINT-DETAIL. SG1014.2 +202500 SEG-TEST-107. SG1014.2 +202600 MOVE SPACE TO TEST-CHECK. SG1014.2 +202700 PERFORM 44. SG1014.2 +202800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +202900 PERFORM PASS SG1014.2 +203000 GO TO SEG-WRITE-107. SG1014.2 +203100 MOVE SPACE TO COMPUTED-A. SG1014.2 +203200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +203300 PERFORM FAIL. SG1014.2 +203400 GO TO SEG-WRITE-107. SG1014.2 +203500 SEG-DELETE-107. SG1014.2 +203600 PERFORM DE-LETE. SG1014.2 +203700 SEG-WRITE-107. SG1014.2 +203800 MOVE "SEG-TEST-107" TO PAR-NAME. SG1014.2 +203900 PERFORM PRINT-DETAIL. SG1014.2 +204000 SEG-TEST-108. SG1014.2 +204100 MOVE SPACE TO TEST-CHECK. SG1014.2 +204200 PERFORM 43. SG1014.2 +204300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +204400 PERFORM PASS SG1014.2 +204500 GO TO SEG-WRITE-108. SG1014.2 +204600 MOVE SPACE TO COMPUTED-A. SG1014.2 +204700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +204800 PERFORM FAIL. SG1014.2 +204900 GO TO SEG-WRITE-108. SG1014.2 +205000 SEG-DELETE-108. SG1014.2 +205100 PERFORM DE-LETE. SG1014.2 +205200 SEG-WRITE-108. SG1014.2 +205300 MOVE "SEG-TEST-108" TO PAR-NAME. SG1014.2 +205400 PERFORM PRINT-DETAIL. SG1014.2 +205500 SEG-TEST-109. SG1014.2 +205600 MOVE SPACE TO TEST-CHECK. SG1014.2 +205700 PERFORM 42. SG1014.2 +205800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +205900 PERFORM PASS SG1014.2 +206000 GO TO SEG-WRITE-109. SG1014.2 +206100 MOVE SPACE TO COMPUTED-A. SG1014.2 +206200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +206300 PERFORM FAIL. SG1014.2 +206400 GO TO SEG-WRITE-109. SG1014.2 +206500 SEG-DELETE-109. SG1014.2 +206600 PERFORM DE-LETE. SG1014.2 +206700 SEG-WRITE-109. SG1014.2 +206800 MOVE "SEG-TEST-109" TO PAR-NAME. SG1014.2 +206900 PERFORM PRINT-DETAIL. SG1014.2 +207000 SEG-TEST-110. SG1014.2 +207100 MOVE SPACE TO TEST-CHECK. SG1014.2 +207200 PERFORM 41. SG1014.2 +207300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +207400 PERFORM PASS SG1014.2 +207500 GO TO SEG-WRITE-110. SG1014.2 +207600 MOVE SPACE TO COMPUTED-A. SG1014.2 +207700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +207800 PERFORM FAIL. SG1014.2 +207900 GO TO SEG-WRITE-110. SG1014.2 +208000 SEG-DELETE-110. SG1014.2 +208100 PERFORM DE-LETE. SG1014.2 +208200 SEG-WRITE-110. SG1014.2 +208300 MOVE "SEG-TEST-110" TO PAR-NAME. SG1014.2 +208400 PERFORM PRINT-DETAIL. SG1014.2 +208500 SEG-TEST-111. SG1014.2 +208600 MOVE SPACE TO TEST-CHECK. SG1014.2 +208700 PERFORM 40. SG1014.2 +208800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +208900 PERFORM PASS SG1014.2 +209000 GO TO SEG-WRITE-111. SG1014.2 +209100 MOVE SPACE TO COMPUTED-A. SG1014.2 +209200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +209300 PERFORM FAIL. SG1014.2 +209400 GO TO SEG-WRITE-111. SG1014.2 +209500 SEG-DELETE-111. SG1014.2 +209600 PERFORM DE-LETE. SG1014.2 +209700 SEG-WRITE-111. SG1014.2 +209800 MOVE "SEG-TEST-111" TO PAR-NAME. SG1014.2 +209900 PERFORM PRINT-DETAIL. SG1014.2 +210000 SEG-TEST-112. SG1014.2 +210100 MOVE SPACE TO TEST-CHECK. SG1014.2 +210200 PERFORM 39. SG1014.2 +210300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +210400 PERFORM PASS SG1014.2 +210500 GO TO SEG-WRITE-112. SG1014.2 +210600 MOVE SPACE TO COMPUTED-A. SG1014.2 +210700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +210800 PERFORM FAIL. SG1014.2 +210900 GO TO SEG-WRITE-112. SG1014.2 +211000 SEG-DELETE-112. SG1014.2 +211100 PERFORM DE-LETE. SG1014.2 +211200 SEG-WRITE-112. SG1014.2 +211300 MOVE "SEG-TEST-112" TO PAR-NAME. SG1014.2 +211400 PERFORM PRINT-DETAIL. SG1014.2 +211500 SEG-TEST-113. SG1014.2 +211600 MOVE SPACE TO TEST-CHECK. SG1014.2 +211700 PERFORM 38. SG1014.2 +211800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +211900 PERFORM PASS SG1014.2 +212000 GO TO SEG-WRITE-113. SG1014.2 +212100 MOVE SPACE TO COMPUTED-A. SG1014.2 +212200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +212300 PERFORM FAIL. SG1014.2 +212400 GO TO SEG-WRITE-113. SG1014.2 +212500 SEG-DELETE-113. SG1014.2 +212600 PERFORM DE-LETE. SG1014.2 +212700 SEG-WRITE-113. SG1014.2 +212800 MOVE "SEG-TEST-113" TO PAR-NAME. SG1014.2 +212900 PERFORM PRINT-DETAIL. SG1014.2 +213000 SEG-TEST-114. SG1014.2 +213100 MOVE SPACE TO TEST-CHECK. SG1014.2 +213200 PERFORM 37. SG1014.2 +213300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +213400 PERFORM PASS SG1014.2 +213500 GO TO SEG-WRITE-114. SG1014.2 +213600 MOVE SPACE TO COMPUTED-A. SG1014.2 +213700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +213800 PERFORM FAIL. SG1014.2 +213900 GO TO SEG-WRITE-114. SG1014.2 +214000 SEG-DELETE-114. SG1014.2 +214100 PERFORM DE-LETE. SG1014.2 +214200 SEG-WRITE-114. SG1014.2 +214300 MOVE "SEG-TEST-114" TO PAR-NAME. SG1014.2 +214400 PERFORM PRINT-DETAIL. SG1014.2 +214500 SEG-TEST-115. SG1014.2 +214600 MOVE SPACE TO TEST-CHECK. SG1014.2 +214700 PERFORM 36. SG1014.2 +214800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +214900 PERFORM PASS SG1014.2 +215000 GO TO SEG-WRITE-115. SG1014.2 +215100 MOVE SPACE TO COMPUTED-A. SG1014.2 +215200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +215300 PERFORM FAIL. SG1014.2 +215400 GO TO SEG-WRITE-115. SG1014.2 +215500 SEG-DELETE-115. SG1014.2 +215600 PERFORM DE-LETE. SG1014.2 +215700 SEG-WRITE-115. SG1014.2 +215800 MOVE "SEG-TEST-115" TO PAR-NAME. SG1014.2 +215900 PERFORM PRINT-DETAIL. SG1014.2 +216000 SEG-TEST-116. SG1014.2 +216100 MOVE SPACE TO TEST-CHECK. SG1014.2 +216200 PERFORM 35. SG1014.2 +216300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +216400 PERFORM PASS SG1014.2 +216500 GO TO SEG-WRITE-116. SG1014.2 +216600 MOVE SPACE TO COMPUTED-A. SG1014.2 +216700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +216800 PERFORM FAIL. SG1014.2 +216900 GO TO SEG-WRITE-116. SG1014.2 +217000 SEG-DELETE-116. SG1014.2 +217100 PERFORM DE-LETE. SG1014.2 +217200 SEG-WRITE-116. SG1014.2 +217300 MOVE "SEG-TEST-116" TO PAR-NAME. SG1014.2 +217400 PERFORM PRINT-DETAIL. SG1014.2 +217500 SEG-TEST-117. SG1014.2 +217600 MOVE SPACE TO TEST-CHECK. SG1014.2 +217700 PERFORM 34. SG1014.2 +217800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +217900 PERFORM PASS SG1014.2 +218000 GO TO SEG-WRITE-117. SG1014.2 +218100 MOVE SPACE TO COMPUTED-A. SG1014.2 +218200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +218300 PERFORM FAIL. SG1014.2 +218400 GO TO SEG-WRITE-117. SG1014.2 +218500 SEG-DELETE-117. SG1014.2 +218600 PERFORM DE-LETE. SG1014.2 +218700 SEG-WRITE-117. SG1014.2 +218800 MOVE "SEG-TEST-117" TO PAR-NAME. SG1014.2 +218900 PERFORM PRINT-DETAIL. SG1014.2 +219000 SEG-TEST-118. SG1014.2 +219100 MOVE SPACE TO TEST-CHECK. SG1014.2 +219200 PERFORM 33. SG1014.2 +219300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +219400 PERFORM PASS SG1014.2 +219500 GO TO SEG-WRITE-118. SG1014.2 +219600 MOVE SPACE TO COMPUTED-A. SG1014.2 +219700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +219800 PERFORM FAIL. SG1014.2 +219900 GO TO SEG-WRITE-118. SG1014.2 +220000 SEG-DELETE-118. SG1014.2 +220100 PERFORM DE-LETE. SG1014.2 +220200 SEG-WRITE-118. SG1014.2 +220300 MOVE "SEG-TEST-118" TO PAR-NAME. SG1014.2 +220400 PERFORM PRINT-DETAIL. SG1014.2 +220500 SEG-TEST-119. SG1014.2 +220600 MOVE SPACE TO TEST-CHECK. SG1014.2 +220700 PERFORM 32. SG1014.2 +220800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +220900 PERFORM PASS SG1014.2 +221000 GO TO SEG-WRITE-119. SG1014.2 +221100 MOVE SPACE TO COMPUTED-A. SG1014.2 +221200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +221300 PERFORM FAIL. SG1014.2 +221400 GO TO SEG-WRITE-119. SG1014.2 +221500 SEG-DELETE-119. SG1014.2 +221600 PERFORM DE-LETE. SG1014.2 +221700 SEG-WRITE-119. SG1014.2 +221800 MOVE "SEG-TEST-119" TO PAR-NAME. SG1014.2 +221900 PERFORM PRINT-DETAIL. SG1014.2 +222000 SEG-TEST-120. SG1014.2 +222100 MOVE SPACE TO TEST-CHECK. SG1014.2 +222200 PERFORM 31. SG1014.2 +222300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +222400 PERFORM PASS SG1014.2 +222500 GO TO SEG-WRITE-120. SG1014.2 +222600 MOVE SPACE TO COMPUTED-A. SG1014.2 +222700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +222800 PERFORM FAIL. SG1014.2 +222900 GO TO SEG-WRITE-120. SG1014.2 +223000 SEG-DELETE-120. SG1014.2 +223100 PERFORM DE-LETE. SG1014.2 +223200 SEG-WRITE-120. SG1014.2 +223300 MOVE "SEG-TEST-120" TO PAR-NAME. SG1014.2 +223400 PERFORM PRINT-DETAIL. SG1014.2 +223500 SEG-TEST-121. SG1014.2 +223600 MOVE SPACE TO TEST-CHECK. SG1014.2 +223700 PERFORM 30. SG1014.2 +223800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +223900 PERFORM PASS SG1014.2 +224000 GO TO SEG-WRITE-121. SG1014.2 +224100 MOVE SPACE TO COMPUTED-A. SG1014.2 +224200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +224300 PERFORM FAIL. SG1014.2 +224400 GO TO SEG-WRITE-121. SG1014.2 +224500 SEG-DELETE-121. SG1014.2 +224600 PERFORM DE-LETE. SG1014.2 +224700 SEG-WRITE-121. SG1014.2 +224800 MOVE "SEG-TEST-121" TO PAR-NAME. SG1014.2 +224900 PERFORM PRINT-DETAIL. SG1014.2 +225000 SEG-TEST-122. SG1014.2 +225100 MOVE SPACE TO TEST-CHECK. SG1014.2 +225200 PERFORM 29. SG1014.2 +225300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +225400 PERFORM PASS SG1014.2 +225500 GO TO SEG-WRITE-122. SG1014.2 +225600 MOVE SPACE TO COMPUTED-A. SG1014.2 +225700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +225800 PERFORM FAIL. SG1014.2 +225900 GO TO SEG-WRITE-122. SG1014.2 +226000 SEG-DELETE-122. SG1014.2 +226100 PERFORM DE-LETE. SG1014.2 +226200 SEG-WRITE-122. SG1014.2 +226300 MOVE "SEG-TEST-122" TO PAR-NAME. SG1014.2 +226400 PERFORM PRINT-DETAIL. SG1014.2 +226500 SEG-TEST-123. SG1014.2 +226600 MOVE SPACE TO TEST-CHECK. SG1014.2 +226700 PERFORM 28. SG1014.2 +226800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +226900 PERFORM PASS SG1014.2 +227000 GO TO SEG-WRITE-123. SG1014.2 +227100 MOVE SPACE TO COMPUTED-A. SG1014.2 +227200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +227300 PERFORM FAIL. SG1014.2 +227400 GO TO SEG-WRITE-123. SG1014.2 +227500 SEG-DELETE-123. SG1014.2 +227600 PERFORM DE-LETE. SG1014.2 +227700 SEG-WRITE-123. SG1014.2 +227800 MOVE "SEG-TEST-123" TO PAR-NAME. SG1014.2 +227900 PERFORM PRINT-DETAIL. SG1014.2 +228000 SEG-TEST-124. SG1014.2 +228100 MOVE SPACE TO TEST-CHECK. SG1014.2 +228200 PERFORM 27. SG1014.2 +228300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +228400 PERFORM PASS SG1014.2 +228500 GO TO SEG-WRITE-124. SG1014.2 +228600 MOVE SPACE TO COMPUTED-A. SG1014.2 +228700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +228800 PERFORM FAIL. SG1014.2 +228900 GO TO SEG-WRITE-124. SG1014.2 +229000 SEG-DELETE-124. SG1014.2 +229100 PERFORM DE-LETE. SG1014.2 +229200 SEG-WRITE-124. SG1014.2 +229300 MOVE "SEG-TEST-124" TO PAR-NAME. SG1014.2 +229400 PERFORM PRINT-DETAIL. SG1014.2 +229500 SEG-TEST-125. SG1014.2 +229600 MOVE SPACE TO TEST-CHECK. SG1014.2 +229700 PERFORM 26. SG1014.2 +229800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +229900 PERFORM PASS SG1014.2 +230000 GO TO SEG-WRITE-125. SG1014.2 +230100 MOVE SPACE TO COMPUTED-A. SG1014.2 +230200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +230300 PERFORM FAIL. SG1014.2 +230400 GO TO SEG-WRITE-125. SG1014.2 +230500 SEG-DELETE-125. SG1014.2 +230600 PERFORM DE-LETE. SG1014.2 +230700 SEG-WRITE-125. SG1014.2 +230800 MOVE "SEG-TEST-125" TO PAR-NAME. SG1014.2 +230900 PERFORM PRINT-DETAIL. SG1014.2 +231000 SEG-TEST-126. SG1014.2 +231100 MOVE SPACE TO TEST-CHECK. SG1014.2 +231200 PERFORM 25. SG1014.2 +231300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +231400 PERFORM PASS SG1014.2 +231500 GO TO SEG-WRITE-126. SG1014.2 +231600 MOVE SPACE TO COMPUTED-A. SG1014.2 +231700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +231800 PERFORM FAIL. SG1014.2 +231900 GO TO SEG-WRITE-126. SG1014.2 +232000 SEG-DELETE-126. SG1014.2 +232100 PERFORM DE-LETE. SG1014.2 +232200 SEG-WRITE-126. SG1014.2 +232300 MOVE "SEG-TEST-126" TO PAR-NAME. SG1014.2 +232400 PERFORM PRINT-DETAIL. SG1014.2 +232500 SEG-TEST-127. SG1014.2 +232600 MOVE SPACE TO TEST-CHECK. SG1014.2 +232700 PERFORM 24. SG1014.2 +232800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +232900 PERFORM PASS SG1014.2 +233000 GO TO SEG-WRITE-127. SG1014.2 +233100 MOVE SPACE TO COMPUTED-A. SG1014.2 +233200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +233300 PERFORM FAIL. SG1014.2 +233400 GO TO SEG-WRITE-127. SG1014.2 +233500 SEG-DELETE-127. SG1014.2 +233600 PERFORM DE-LETE. SG1014.2 +233700 SEG-WRITE-127. SG1014.2 +233800 MOVE "SEG-TEST-127" TO PAR-NAME. SG1014.2 +233900 PERFORM PRINT-DETAIL. SG1014.2 +234000 SEG-TEST-128. SG1014.2 +234100 MOVE SPACE TO TEST-CHECK. SG1014.2 +234200 PERFORM 23. SG1014.2 +234300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +234400 PERFORM PASS SG1014.2 +234500 GO TO SEG-WRITE-128. SG1014.2 +234600 MOVE SPACE TO COMPUTED-A. SG1014.2 +234700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +234800 PERFORM FAIL. SG1014.2 +234900 GO TO SEG-WRITE-128. SG1014.2 +235000 SEG-DELETE-128. SG1014.2 +235100 PERFORM DE-LETE. SG1014.2 +235200 SEG-WRITE-128. SG1014.2 +235300 MOVE "SEG-TEST-128" TO PAR-NAME. SG1014.2 +235400 PERFORM PRINT-DETAIL. SG1014.2 +235500 SEG-TEST-129. SG1014.2 +235600 MOVE SPACE TO TEST-CHECK. SG1014.2 +235700 PERFORM 22. SG1014.2 +235800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +235900 PERFORM PASS SG1014.2 +236000 GO TO SEG-WRITE-129. SG1014.2 +236100 MOVE SPACE TO COMPUTED-A. SG1014.2 +236200 MOVE "GOOD" TO CORRECT-A. SG1014.2 +236300 PERFORM FAIL. SG1014.2 +236400 GO TO SEG-WRITE-129. SG1014.2 +236500 SEG-DELETE-129. SG1014.2 +236600 PERFORM DE-LETE. SG1014.2 +236700 SEG-WRITE-129. SG1014.2 +236800 MOVE "SEG-TEST-129" TO PAR-NAME. SG1014.2 +236900 PERFORM PRINT-DETAIL. SG1014.2 +237000 SEG-TEST-130. SG1014.2 +237100 MOVE SPACE TO TEST-CHECK. SG1014.2 +237200 PERFORM 21. SG1014.2 +237300 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +237400 PERFORM PASS SG1014.2 +237500 GO TO SEG-WRITE-130. SG1014.2 +237600 MOVE SPACE TO COMPUTED-A. SG1014.2 +237700 MOVE "GOOD" TO CORRECT-A. SG1014.2 +237800 PERFORM FAIL. SG1014.2 +237900 GO TO SEG-WRITE-130. SG1014.2 +238000 SEG-DELETE-130. SG1014.2 +238100 PERFORM DE-LETE. SG1014.2 +238200 SEG-WRITE-130. SG1014.2 +238300 MOVE "SEG-TEST-130" TO PAR-NAME. SG1014.2 +238400 PERFORM PRINT-DETAIL. SG1014.2 +238500 SEG-TEST-131. SG1014.2 +238600 MOVE SPACE TO TEST-CHECK. SG1014.2 +238700 PERFORM 20. SG1014.2 +238800 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +238900 PERFORM PASS SG1014.2 +239000 GO TO SEG-WRITE-131. SG1014.2 +239100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +239200 PERFORM FAIL. SG1014.2 +239300 GO TO SEG-WRITE-131. SG1014.2 +239400 SEG-DELETE-131. SG1014.2 +239500 PERFORM DE-LETE. SG1014.2 +239600 SEG-WRITE-131. SG1014.2 +239700 MOVE "SEG-TEST-131" TO PAR-NAME. SG1014.2 +239800 PERFORM PRINT-DETAIL. SG1014.2 +239900 SEG-TEST-132. SG1014.2 +240000 MOVE SPACE TO TEST-CHECK. SG1014.2 +240100 PERFORM 19. SG1014.2 +240200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +240300 PERFORM PASS SG1014.2 +240400 GO TO SEG-WRITE-132. SG1014.2 +240500 MOVE SPACE TO COMPUTED-A. SG1014.2 +240600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +240700 PERFORM FAIL. SG1014.2 +240800 GO TO SEG-WRITE-132. SG1014.2 +240900 SEG-DELETE-132. SG1014.2 +241000 PERFORM DE-LETE. SG1014.2 +241100 SEG-WRITE-132. SG1014.2 +241200 MOVE "SEG-TEST-132" TO PAR-NAME. SG1014.2 +241300 PERFORM PRINT-DETAIL. SG1014.2 +241400 SEG-TEST-133. SG1014.2 +241500 MOVE SPACE TO TEST-CHECK. SG1014.2 +241600 PERFORM 18. SG1014.2 +241700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +241800 PERFORM PASS SG1014.2 +241900 GO TO SEG-WRITE-133. SG1014.2 +242000 MOVE SPACE TO COMPUTED-A. SG1014.2 +242100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +242200 PERFORM FAIL. SG1014.2 +242300 GO TO SEG-WRITE-133. SG1014.2 +242400 SEG-DELETE-133. SG1014.2 +242500 PERFORM DE-LETE. SG1014.2 +242600 SEG-WRITE-133. SG1014.2 +242700 MOVE "SEG-TEST-133" TO PAR-NAME. SG1014.2 +242800 PERFORM PRINT-DETAIL. SG1014.2 +242900 SEG-TEST-134. SG1014.2 +243000 MOVE SPACE TO TEST-CHECK. SG1014.2 +243100 PERFORM 17. SG1014.2 +243200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +243300 PERFORM PASS SG1014.2 +243400 GO TO SEG-WRITE-134. SG1014.2 +243500 MOVE SPACE TO COMPUTED-A. SG1014.2 +243600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +243700 PERFORM FAIL. SG1014.2 +243800 GO TO SEG-WRITE-134. SG1014.2 +243900 SEG-DELETE-134. SG1014.2 +244000 PERFORM DE-LETE. SG1014.2 +244100 SEG-WRITE-134. SG1014.2 +244200 MOVE "SEG-TEST-134" TO PAR-NAME. SG1014.2 +244300 PERFORM PRINT-DETAIL. SG1014.2 +244400 SEG-TEST-135. SG1014.2 +244500 MOVE SPACE TO TEST-CHECK. SG1014.2 +244600 PERFORM 16. SG1014.2 +244700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +244800 PERFORM PASS SG1014.2 +244900 GO TO SEG-WRITE-135. SG1014.2 +245000 MOVE SPACE TO COMPUTED-A. SG1014.2 +245100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +245200 PERFORM FAIL. SG1014.2 +245300 GO TO SEG-WRITE-135. SG1014.2 +245400 SEG-DELETE-135. SG1014.2 +245500 PERFORM DE-LETE. SG1014.2 +245600 SEG-WRITE-135. SG1014.2 +245700 MOVE "SEG-TEST-135" TO PAR-NAME. SG1014.2 +245800 PERFORM PRINT-DETAIL. SG1014.2 +245900 SEG-TEST-136. SG1014.2 +246000 MOVE SPACE TO TEST-CHECK. SG1014.2 +246100 PERFORM 15. SG1014.2 +246200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +246300 PERFORM PASS SG1014.2 +246400 GO TO SEG-WRITE-136. SG1014.2 +246500 MOVE SPACE TO COMPUTED-A. SG1014.2 +246600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +246700 PERFORM FAIL. SG1014.2 +246800 GO TO SEG-WRITE-136. SG1014.2 +246900 SEG-DELETE-136. SG1014.2 +247000 PERFORM DE-LETE. SG1014.2 +247100 SEG-WRITE-136. SG1014.2 +247200 MOVE "SEG-TEST-136" TO PAR-NAME. SG1014.2 +247300 PERFORM PRINT-DETAIL. SG1014.2 +247400 SEG-TEST-137. SG1014.2 +247500 MOVE SPACE TO TEST-CHECK. SG1014.2 +247600 PERFORM 14. SG1014.2 +247700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +247800 PERFORM PASS SG1014.2 +247900 GO TO SEG-WRITE-137. SG1014.2 +248000 MOVE SPACE TO COMPUTED-A. SG1014.2 +248100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +248200 PERFORM FAIL. SG1014.2 +248300 GO TO SEG-WRITE-137. SG1014.2 +248400 SEG-DELETE-137. SG1014.2 +248500 PERFORM DE-LETE. SG1014.2 +248600 SEG-WRITE-137. SG1014.2 +248700 MOVE "SEG-TEST-137" TO PAR-NAME. SG1014.2 +248800 PERFORM PRINT-DETAIL. SG1014.2 +248900 SEG-TEST-138. SG1014.2 +249000 MOVE SPACE TO TEST-CHECK. SG1014.2 +249100 PERFORM 13. SG1014.2 +249200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +249300 PERFORM PASS SG1014.2 +249400 GO TO SEG-WRITE-138. SG1014.2 +249500 MOVE SPACE TO COMPUTED-A. SG1014.2 +249600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +249700 PERFORM FAIL. SG1014.2 +249800 GO TO SEG-WRITE-138. SG1014.2 +249900 SEG-DELETE-138. SG1014.2 +250000 PERFORM DE-LETE. SG1014.2 +250100 SEG-WRITE-138. SG1014.2 +250200 MOVE "SEG-TEST-138" TO PAR-NAME. SG1014.2 +250300 PERFORM PRINT-DETAIL. SG1014.2 +250400 SEG-TEST-139. SG1014.2 +250500 MOVE SPACE TO TEST-CHECK. SG1014.2 +250600 PERFORM 12. SG1014.2 +250700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +250800 PERFORM PASS SG1014.2 +250900 GO TO SEG-WRITE-139. SG1014.2 +251000 MOVE SPACE TO COMPUTED-A. SG1014.2 +251100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +251200 PERFORM FAIL. SG1014.2 +251300 GO TO SEG-WRITE-139. SG1014.2 +251400 SEG-DELETE-139. SG1014.2 +251500 PERFORM DE-LETE. SG1014.2 +251600 SEG-WRITE-139. SG1014.2 +251700 MOVE "SEG-TEST-139" TO PAR-NAME. SG1014.2 +251800 PERFORM PRINT-DETAIL. SG1014.2 +251900 SEG-TEST-140. SG1014.2 +252000 MOVE SPACE TO TEST-CHECK. SG1014.2 +252100 PERFORM 11. SG1014.2 +252200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +252300 PERFORM PASS SG1014.2 +252400 GO TO SEG-WRITE-140. SG1014.2 +252500 MOVE SPACE TO COMPUTED-A. SG1014.2 +252600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +252700 PERFORM FAIL. SG1014.2 +252800 GO TO SEG-WRITE-140. SG1014.2 +252900 SEG-DELETE-140. SG1014.2 +253000 PERFORM DE-LETE. SG1014.2 +253100 SEG-WRITE-140. SG1014.2 +253200 MOVE "SEG-TEST-140" TO PAR-NAME. SG1014.2 +253300 PERFORM PRINT-DETAIL. SG1014.2 +253400 SEG-TEST-141. SG1014.2 +253500 MOVE SPACE TO TEST-CHECK. SG1014.2 +253600 PERFORM 10. SG1014.2 +253700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +253800 PERFORM PASS SG1014.2 +253900 GO TO SEG-WRITE-141. SG1014.2 +254000 MOVE SPACE TO COMPUTED-A. SG1014.2 +254100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +254200 PERFORM FAIL. SG1014.2 +254300 GO TO SEG-WRITE-141. SG1014.2 +254400 SEG-DELETE-141. SG1014.2 +254500 PERFORM DE-LETE. SG1014.2 +254600 SEG-WRITE-141. SG1014.2 +254700 MOVE "SEG-TEST-141" TO PAR-NAME. SG1014.2 +254800 PERFORM PRINT-DETAIL. SG1014.2 +254900 SEG-TEST-142. SG1014.2 +255000 MOVE SPACE TO TEST-CHECK. SG1014.2 +255100 PERFORM 09. SG1014.2 +255200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +255300 PERFORM PASS SG1014.2 +255400 GO TO SEG-WRITE-142. SG1014.2 +255500 MOVE SPACE TO COMPUTED-A. SG1014.2 +255600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +255700 PERFORM FAIL. SG1014.2 +255800 GO TO SEG-WRITE-142. SG1014.2 +255900 SEG-DELETE-142. SG1014.2 +256000 PERFORM DE-LETE. SG1014.2 +256100 SEG-WRITE-142. SG1014.2 +256200 MOVE "SEG-TEST-142" TO PAR-NAME. SG1014.2 +256300 PERFORM PRINT-DETAIL. SG1014.2 +256400 SEG-TEST-143. SG1014.2 +256500 MOVE SPACE TO TEST-CHECK. SG1014.2 +256600 PERFORM 08. SG1014.2 +256700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +256800 PERFORM PASS SG1014.2 +256900 GO TO SEG-WRITE-143. SG1014.2 +257000 MOVE SPACE TO COMPUTED-A. SG1014.2 +257100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +257200 PERFORM FAIL. SG1014.2 +257300 GO TO SEG-WRITE-143. SG1014.2 +257400 SEG-DELETE-143. SG1014.2 +257500 PERFORM DE-LETE. SG1014.2 +257600 SEG-WRITE-143. SG1014.2 +257700 MOVE "SEG-TEST-143" TO PAR-NAME. SG1014.2 +257800 PERFORM PRINT-DETAIL. SG1014.2 +257900 SEG-TEST-144. SG1014.2 +258000 MOVE SPACE TO TEST-CHECK. SG1014.2 +258100 PERFORM 07. SG1014.2 +258200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +258300 PERFORM PASS SG1014.2 +258400 GO TO SEG-WRITE-144. SG1014.2 +258500 MOVE SPACE TO COMPUTED-A. SG1014.2 +258600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +258700 PERFORM FAIL. SG1014.2 +258800 GO TO SEG-WRITE-144. SG1014.2 +258900 SEG-DELETE-144. SG1014.2 +259000 PERFORM DE-LETE. SG1014.2 +259100 SEG-WRITE-144. SG1014.2 +259200 MOVE "SEG-TEST-144" TO PAR-NAME. SG1014.2 +259300 PERFORM PRINT-DETAIL. SG1014.2 +259400 SEG-TEST-145. SG1014.2 +259500 MOVE SPACE TO TEST-CHECK. SG1014.2 +259600 PERFORM 06. SG1014.2 +259700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +259800 PERFORM PASS SG1014.2 +259900 GO TO SEG-WRITE-145. SG1014.2 +260000 MOVE SPACE TO COMPUTED-A. SG1014.2 +260100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +260200 PERFORM FAIL. SG1014.2 +260300 GO TO SEG-WRITE-145. SG1014.2 +260400 SEG-DELETE-145. SG1014.2 +260500 PERFORM DE-LETE. SG1014.2 +260600 SEG-WRITE-145. SG1014.2 +260700 MOVE "SEG-TEST-145" TO PAR-NAME. SG1014.2 +260800 PERFORM PRINT-DETAIL. SG1014.2 +260900 SEG-TEST-146. SG1014.2 +261000 MOVE SPACE TO TEST-CHECK. SG1014.2 +261100 PERFORM 05. SG1014.2 +261200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +261300 PERFORM PASS SG1014.2 +261400 GO TO SEG-WRITE-146. SG1014.2 +261500 MOVE SPACE TO COMPUTED-A. SG1014.2 +261600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +261700 PERFORM FAIL. SG1014.2 +261800 GO TO SEG-WRITE-146. SG1014.2 +261900 SEG-DELETE-146. SG1014.2 +262000 PERFORM DE-LETE. SG1014.2 +262100 SEG-WRITE-146. SG1014.2 +262200 MOVE "SEG-TEST-146" TO PAR-NAME. SG1014.2 +262300 PERFORM PRINT-DETAIL. SG1014.2 +262400 SEG-TEST-147. SG1014.2 +262500 MOVE SPACE TO TEST-CHECK. SG1014.2 +262600 PERFORM 04. SG1014.2 +262700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +262800 PERFORM PASS SG1014.2 +262900 GO TO SEG-WRITE-147. SG1014.2 +263000 MOVE SPACE TO COMPUTED-A. SG1014.2 +263100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +263200 PERFORM FAIL. SG1014.2 +263300 GO TO SEG-WRITE-147. SG1014.2 +263400 SEG-DELETE-147. SG1014.2 +263500 PERFORM DE-LETE. SG1014.2 +263600 SEG-WRITE-147. SG1014.2 +263700 MOVE "SEG-TEST-147" TO PAR-NAME. SG1014.2 +263800 PERFORM PRINT-DETAIL. SG1014.2 +263900 SEG-TEST-148. SG1014.2 +264000 MOVE SPACE TO TEST-CHECK. SG1014.2 +264100 PERFORM 03. SG1014.2 +264200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +264300 PERFORM PASS SG1014.2 +264400 GO TO SEG-WRITE-148. SG1014.2 +264500 MOVE SPACE TO COMPUTED-A. SG1014.2 +264600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +264700 PERFORM FAIL. SG1014.2 +264800 GO TO SEG-WRITE-148. SG1014.2 +264900 SEG-DELETE-148. SG1014.2 +265000 PERFORM DE-LETE. SG1014.2 +265100 SEG-WRITE-148. SG1014.2 +265200 MOVE "SEG-TEST-148" TO PAR-NAME. SG1014.2 +265300 PERFORM PRINT-DETAIL. SG1014.2 +265400 SEG-TEST-149. SG1014.2 +265500 MOVE SPACE TO TEST-CHECK. SG1014.2 +265600 PERFORM 02. SG1014.2 +265700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +265800 PERFORM PASS SG1014.2 +265900 GO TO SEG-WRITE-149. SG1014.2 +266000 MOVE SPACE TO COMPUTED-A. SG1014.2 +266100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +266200 PERFORM FAIL. SG1014.2 +266300 GO TO SEG-WRITE-149. SG1014.2 +266400 SEG-DELETE-149. SG1014.2 +266500 PERFORM DE-LETE. SG1014.2 +266600 SEG-WRITE-149. SG1014.2 +266700 MOVE "SEG-TEST-149" TO PAR-NAME. SG1014.2 +266800 PERFORM PRINT-DETAIL. SG1014.2 +266900 SEG-TEST-150. SG1014.2 +267000 MOVE SPACE TO TEST-CHECK. SG1014.2 +267100 PERFORM 01. SG1014.2 +267200 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +267300 PERFORM PASS SG1014.2 +267400 GO TO SEG-WRITE-150. SG1014.2 +267500 MOVE SPACE TO COMPUTED-A. SG1014.2 +267600 MOVE "GOOD" TO CORRECT-A. SG1014.2 +267700 PERFORM FAIL. SG1014.2 +267800 GO TO SEG-WRITE-150. SG1014.2 +267900 SEG-DELETE-150. SG1014.2 +268000 PERFORM DE-LETE. SG1014.2 +268100 SEG-WRITE-150. SG1014.2 +268200 MOVE "SEG-TEST-150" TO PAR-NAME. SG1014.2 +268300 PERFORM PRINT-DETAIL. SG1014.2 +268400 SEG-TEST-151. SG1014.2 +268500 MOVE SPACE TO TEST-CHECK. SG1014.2 +268600 PERFORM 00. SG1014.2 +268700 IF TEST-CHECK EQUAL TO "GOOD" SG1014.2 +268800 PERFORM PASS SG1014.2 +268900 GO TO SEG-WRITE-151. SG1014.2 +269000 MOVE SPACE TO COMPUTED-A. SG1014.2 +269100 MOVE "GOOD" TO CORRECT-A. SG1014.2 +269200 PERFORM FAIL. SG1014.2 +269300 GO TO SEG-WRITE-151. SG1014.2 +269400 SEG-DELETE-151. SG1014.2 +269500 PERFORM DE-LETE. SG1014.2 +269600 SEG-WRITE-151. SG1014.2 +269700 MOVE "SEG-TEST-151" TO PAR-NAME. SG1014.2 +269800 PERFORM PRINT-DETAIL. SG1014.2 +269900 GO TO CLOSE-FILES. SG1014.2 +270000 50 SECTION 50. SG1014.2 +270100 PARA-50. SG1014.2 +270200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +270300 51 SECTION 51. SG1014.2 +270400 PARA-51. SG1014.2 +270500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +270600 52 SECTION 52. SG1014.2 +270700 PARA-52. SG1014.2 +270800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +270900 53 SECTION 53. SG1014.2 +271000 PARA-53. SG1014.2 +271100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +271200 54 SECTION 54. SG1014.2 +271300 PARA-54. SG1014.2 +271400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +271500 55 SECTION 55. SG1014.2 +271600 PARA-55. SG1014.2 +271700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +271800 56 SECTION 56. SG1014.2 +271900 PARA-56. SG1014.2 +272000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +272100 57 SECTION 57. SG1014.2 +272200 PARA-57. SG1014.2 +272300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +272400 58 SECTION 58. SG1014.2 +272500 PARA-58. SG1014.2 +272600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +272700 59 SECTION 59. SG1014.2 +272800 PARA-59. SG1014.2 +272900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +273000 60 SECTION 60. SG1014.2 +273100 PARA-60. SG1014.2 +273200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +273300 61 SECTION 61. SG1014.2 +273400 PARA-61. SG1014.2 +273500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +273600 62 SECTION 62. SG1014.2 +273700 PARA-62. SG1014.2 +273800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +273900 63 SECTION 63. SG1014.2 +274000 PARA-63. SG1014.2 +274100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +274200 64 SECTION 64. SG1014.2 +274300 PARA-64. SG1014.2 +274400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +274500 65 SECTION 65. SG1014.2 +274600 PARA-65. SG1014.2 +274700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +274800 66 SECTION 66. SG1014.2 +274900 PARA-66. SG1014.2 +275000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +275100 67 SECTION 67. SG1014.2 +275200 PARA-67. SG1014.2 +275300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +275400 68 SECTION 68. SG1014.2 +275500 PARA-68. SG1014.2 +275600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +275700 69 SECTION 69. SG1014.2 +275800 PARA-69. SG1014.2 +275900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +276000 70 SECTION 70. SG1014.2 +276100 PARA-70. SG1014.2 +276200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +276300 71 SECTION 71. SG1014.2 +276400 PARA-71. SG1014.2 +276500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +276600 72 SECTION 72. SG1014.2 +276700 PARA-72. SG1014.2 +276800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +276900 73 SECTION 73. SG1014.2 +277000 PARA-73. SG1014.2 +277100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +277200 74 SECTION 74. SG1014.2 +277300 PARA-74. SG1014.2 +277400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +277500 75 SECTION 75. SG1014.2 +277600 PARA-75. SG1014.2 +277700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +277800 76 SECTION 76. SG1014.2 +277900 PARA-76. SG1014.2 +278000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +278100 77 SECTION 77. SG1014.2 +278200 PARA-77. SG1014.2 +278300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +278400 78 SECTION 78. SG1014.2 +278500 PARA-78. SG1014.2 +278600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +278700 79 SECTION 79. SG1014.2 +278800 PARA-79. SG1014.2 +278900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +279000 80 SECTION 80. SG1014.2 +279100 PARA-80. SG1014.2 +279200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +279300 81 SECTION 81. SG1014.2 +279400 PARA-81. SG1014.2 +279500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +279600 82 SECTION 82. SG1014.2 +279700 PARA-82. SG1014.2 +279800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +279900 83 SECTION 83. SG1014.2 +280000 PARA-83. SG1014.2 +280100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +280200 84 SECTION 84. SG1014.2 +280300 PARA-84. SG1014.2 +280400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +280500 85 SECTION 85. SG1014.2 +280600 PARA-85. SG1014.2 +280700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +280800 86 SECTION 86. SG1014.2 +280900 PARA-86. SG1014.2 +281000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +281100 87 SECTION 87. SG1014.2 +281200 PARA-87. SG1014.2 +281300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +281400 88 SECTION 88. SG1014.2 +281500 PARA-88. SG1014.2 +281600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +281700 89 SECTION 89. SG1014.2 +281800 PARA-89. SG1014.2 +281900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +282000 90 SECTION 90. SG1014.2 +282100 PARA-90. SG1014.2 +282200 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +282300 91 SECTION 91. SG1014.2 +282400 PARA-91. SG1014.2 +282500 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +282600 92 SECTION 92. SG1014.2 +282700 PARA-92. SG1014.2 +282800 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +282900 93 SECTION 93. SG1014.2 +283000 PARA-93. SG1014.2 +283100 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +283200 94 SECTION 94. SG1014.2 +283300 PARA-94. SG1014.2 +283400 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +283500 95 SECTION 95. SG1014.2 +283600 PARA-95. SG1014.2 +283700 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +283800 96 SECTION 96. SG1014.2 +283900 PARA-96. SG1014.2 +284000 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +284100 97 SECTION 97. SG1014.2 +284200 PARA-97. SG1014.2 +284300 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +284400 98 SECTION 98. SG1014.2 +284500 PARA-98. SG1014.2 +284600 MOVE "GOOD" TO TEST-CHECK. SG1014.2 +284700 99 SECTION 99. SG1014.2 +284800 PARA-99. SG1014.2 +284900 MOVE "GOOD" TO TEST-CHECK. SG1014.2 diff --git a/tests/cobol85/SG/SG102A.CBL b/tests/cobol85/SG/SG102A.CBL new file mode 100755 index 00000000..eabf87a9 --- /dev/null +++ b/tests/cobol85/SG/SG102A.CBL @@ -0,0 +1,610 @@ +000100 IDENTIFICATION DIVISION. SG1024.2 +000200 PROGRAM-ID. SG1024.2 +000300 SG102A. SG1024.2 +000400 AUTHOR. SG1024.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1024.2 +000600 INSTALLATION. SG1024.2 +000700 GENERAL SERVICES ADMINISTRATION SG1024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1024.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1024.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1024.2 +001200 SG1024.2 +001300 PHONE (703) 756-6153 SG1024.2 +001400 SG1024.2 +001500 " HIGH ". SG1024.2 +001600 DATE-WRITTEN. SG1024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1024.2 +001800 CREATION DATE / VALIDATION DATE SG1024.2 +001900 "4.2 ". SG1024.2 +002000 SECURITY. SG1024.2 +002100 NONE. SG1024.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG1024.2 +002300 VARIOUS ALTER AND PERFORM STATEMENTS ARE EXERCISED SG1024.2 +002400 AND A DIRECTORY IS PREPARED IN EACH TEST TO TRACE SG1024.2 +002500 PROGRAM FLOW. SG1024.2 +002600 SG1024.2 +002700 ENVIRONMENT DIVISION. SG1024.2 +002800 CONFIGURATION SECTION. SG1024.2 +002900 SOURCE-COMPUTER. SG1024.2 +003000 Linux. SG1024.2 +003100 OBJECT-COMPUTER. SG1024.2 +003200 Linux. SG1024.2 +003300 INPUT-OUTPUT SECTION. SG1024.2 +003400 FILE-CONTROL. SG1024.2 +003500 SELECT PRINT-FILE ASSIGN TO SG1024.2 +003600 "report.log". SG1024.2 +003700 DATA DIVISION. SG1024.2 +003800 FILE SECTION. SG1024.2 +003900 FD PRINT-FILE SG1024.2 +004000 LABEL RECORDS SG1024.2 +004100 OMITTED SG1024.2 +004200 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1024.2 +004300 01 PRINT-REC PICTURE X(120). SG1024.2 +004400 01 DUMMY-RECORD PICTURE X(120). SG1024.2 +004500 WORKING-STORAGE SECTION. SG1024.2 +004600 77 SEG-CALC PICTURE 9 VALUE 0. SG1024.2 +004700 77 RANGE-SUB PICTURE 9 VALUE 0. SG1024.2 +004800 01 COMPUTED-RANGE. SG1024.2 +004900 02 RANGE-X OCCURS 7 TIMES PICTURE X. SG1024.2 +005000 01 TEST-RESULTS. SG1024.2 +005100 02 FILLER PICTURE X VALUE SPACE. SG1024.2 +005200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1024.2 +005300 02 FILLER PICTURE X VALUE SPACE. SG1024.2 +005400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1024.2 +005500 02 FILLER PICTURE X VALUE SPACE. SG1024.2 +005600 02 PAR-NAME. SG1024.2 +005700 03 FILLER PICTURE X(12) VALUE SPACE. SG1024.2 +005800 03 PARDOT-X PICTURE X VALUE SPACE. SG1024.2 +005900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1024.2 +006000 03 FILLER PIC X(5) VALUE SPACE. SG1024.2 +006100 02 FILLER PIC X(10) VALUE SPACE. SG1024.2 +006200 02 RE-MARK PIC X(61). SG1024.2 +006300 01 TEST-COMPUTED. SG1024.2 +006400 02 FILLER PIC X(30) VALUE SPACE. SG1024.2 +006500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1024.2 +006600 02 COMPUTED-X. SG1024.2 +006700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1024.2 +006800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1024.2 +006900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1024.2 +007000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1024.2 +007100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1024.2 +007200 03 CM-18V0 REDEFINES COMPUTED-A. SG1024.2 +007300 04 COMPUTED-18V0 PICTURE -9(18). SG1024.2 +007400 04 FILLER PICTURE X. SG1024.2 +007500 03 FILLER PIC X(50) VALUE SPACE. SG1024.2 +007600 01 TEST-CORRECT. SG1024.2 +007700 02 FILLER PIC X(30) VALUE SPACE. SG1024.2 +007800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1024.2 +007900 02 CORRECT-X. SG1024.2 +008000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1024.2 +008100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1024.2 +008200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1024.2 +008300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1024.2 +008400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1024.2 +008500 03 CR-18V0 REDEFINES CORRECT-A. SG1024.2 +008600 04 CORRECT-18V0 PICTURE -9(18). SG1024.2 +008700 04 FILLER PICTURE X. SG1024.2 +008800 03 FILLER PIC X(50) VALUE SPACE. SG1024.2 +008900 01 CCVS-C-1. SG1024.2 +009000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1024.2 +009100- "SS PARAGRAPH-NAME SG1024.2 +009200- " REMARKS". SG1024.2 +009300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1024.2 +009400 01 CCVS-C-2. SG1024.2 +009500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1024.2 +009600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1024.2 +009700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1024.2 +009800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1024.2 +009900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1024.2 +010000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1024.2 +010100 01 REC-CT PICTURE 99 VALUE ZERO. SG1024.2 +010200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1024.2 +010300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1024.2 +010400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1024.2 +010500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1024.2 +010600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1024.2 +010700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1024.2 +010800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1024.2 +010900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1024.2 +011000 01 CCVS-H-1. SG1024.2 +011100 02 FILLER PICTURE X(27) VALUE SPACE. SG1024.2 +011200 02 FILLER PICTURE X(67) VALUE SG1024.2 +011300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1024.2 +011400- " SYSTEM". SG1024.2 +011500 02 FILLER PICTURE X(26) VALUE SPACE. SG1024.2 +011600 01 CCVS-H-2. SG1024.2 +011700 02 FILLER PICTURE X(52) VALUE IS SG1024.2 +011800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1024.2 +011900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1024.2 +012000 02 TEST-ID PICTURE IS X(9). SG1024.2 +012100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1024.2 +012200 01 CCVS-H-3. SG1024.2 +012300 02 FILLER PICTURE X(34) VALUE SG1024.2 +012400 " FOR OFFICIAL USE ONLY ". SG1024.2 +012500 02 FILLER PICTURE X(58) VALUE SG1024.2 +012600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1024.2 +012700 02 FILLER PICTURE X(28) VALUE SG1024.2 +012800 " COPYRIGHT 1974 ". SG1024.2 +012900 01 CCVS-E-1. SG1024.2 +013000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1024.2 +013100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1024.2 +013200 02 ID-AGAIN PICTURE IS X(9). SG1024.2 +013300 02 FILLER PICTURE X(45) VALUE IS SG1024.2 +013400 " NTIS DISTRIBUTION COBOL 74". SG1024.2 +013500 01 CCVS-E-2. SG1024.2 +013600 02 FILLER PICTURE X(31) VALUE SG1024.2 +013700 SPACE. SG1024.2 +013800 02 FILLER PICTURE X(21) VALUE SPACE. SG1024.2 +013900 02 CCVS-E-2-2. SG1024.2 +014000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1024.2 +014100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1024.2 +014200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1024.2 +014300 01 CCVS-E-3. SG1024.2 +014400 02 FILLER PICTURE X(22) VALUE SG1024.2 +014500 " FOR OFFICIAL USE ONLY". SG1024.2 +014600 02 FILLER PICTURE X(12) VALUE SPACE. SG1024.2 +014700 02 FILLER PICTURE X(58) VALUE SG1024.2 +014800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1024.2 +014900 02 FILLER PICTURE X(13) VALUE SPACE. SG1024.2 +015000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1024.2 +015100 01 CCVS-E-4. SG1024.2 +015200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1024.2 +015300 02 FILLER PIC XXXX VALUE " OF ". SG1024.2 +015400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1024.2 +015500 02 FILLER PIC X(40) VALUE SG1024.2 +015600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1024.2 +015700 01 XXINFO. SG1024.2 +015800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1024.2 +015900 02 INFO-TEXT. SG1024.2 +016000 04 FILLER PIC X(20) VALUE SPACE. SG1024.2 +016100 04 XXCOMPUTED PIC X(20). SG1024.2 +016200 04 FILLER PIC X(5) VALUE SPACE. SG1024.2 +016300 04 XXCORRECT PIC X(20). SG1024.2 +016400 01 HYPHEN-LINE. SG1024.2 +016500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1024.2 +016600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1024.2 +016700- "*****************************************". SG1024.2 +016800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1024.2 +016900- "******************************". SG1024.2 +017000 01 CCVS-PGM-ID PIC X(6) VALUE SG1024.2 +017100 "SG102A". SG1024.2 +017200 PROCEDURE DIVISION. SG1024.2 +017300 SECT-SG-02-001 SECTION 50. SG1024.2 +017400 SG-02-001. SG1024.2 +017500 PERFORM CCVS1. SG1024.2 +017600 GO TO SEG-TEST-1. SG1024.2 +017700 CCVS1 SECTION. SG1024.2 +017800 OPEN-FILES. SG1024.2 +017900 OPEN OUTPUT PRINT-FILE. SG1024.2 +018000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1024.2 +018100 MOVE SPACE TO TEST-RESULTS. SG1024.2 +018200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1024.2 +018300 GO TO CCVS1-EXIT. SG1024.2 +018400 CLOSE-FILES. SG1024.2 +018500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1024.2 +018600 TERMINATE-CCVS. SG1024.2 +018700*S EXIT PROGRAM. SG1024.2 +018800*SERMINATE-CALL. SG1024.2 +018900 STOP RUN. SG1024.2 +019000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1024.2 +019100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1024.2 +019200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1024.2 +019300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1024.2 +019400 MOVE "****TEST DELETED****" TO RE-MARK. SG1024.2 +019500 PRINT-DETAIL. SG1024.2 +019600 IF REC-CT NOT EQUAL TO ZERO SG1024.2 +019700 MOVE "." TO PARDOT-X SG1024.2 +019800 MOVE REC-CT TO DOTVALUE. SG1024.2 +019900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1024.2 +020000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1024.2 +020100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1024.2 +020200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1024.2 +020300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1024.2 +020400 MOVE SPACE TO CORRECT-X. SG1024.2 +020500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1024.2 +020600 MOVE SPACE TO RE-MARK. SG1024.2 +020700 HEAD-ROUTINE. SG1024.2 +020800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +020900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1024.2 +021000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1024.2 +021100 COLUMN-NAMES-ROUTINE. SG1024.2 +021200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +021300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +021400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +021500 END-ROUTINE. SG1024.2 +021600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1024.2 +021700 END-RTN-EXIT. SG1024.2 +021800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +021900 END-ROUTINE-1. SG1024.2 +022000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1024.2 +022100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1024.2 +022200 ADD PASS-COUNTER TO ERROR-HOLD. SG1024.2 +022300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1024.2 +022400 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1024.2 +022500 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1024.2 +022600 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1024.2 +022700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1024.2 +022800 END-ROUTINE-12. SG1024.2 +022900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1024.2 +023000 IF ERROR-COUNTER IS EQUAL TO ZERO SG1024.2 +023100 MOVE "NO " TO ERROR-TOTAL SG1024.2 +023200 ELSE SG1024.2 +023300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1024.2 +023400 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1024.2 +023500 PERFORM WRITE-LINE. SG1024.2 +023600 END-ROUTINE-13. SG1024.2 +023700 IF DELETE-CNT IS EQUAL TO ZERO SG1024.2 +023800 MOVE "NO " TO ERROR-TOTAL ELSE SG1024.2 +023900 MOVE DELETE-CNT TO ERROR-TOTAL. SG1024.2 +024000 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1024.2 +024100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +024200 IF INSPECT-COUNTER EQUAL TO ZERO SG1024.2 +024300 MOVE "NO " TO ERROR-TOTAL SG1024.2 +024400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1024.2 +024500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1024.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +024700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1024.2 +024800 WRITE-LINE. SG1024.2 +024900 ADD 1 TO RECORD-COUNT. SG1024.2 +025000 IF RECORD-COUNT GREATER 50 SG1024.2 +025100 MOVE DUMMY-RECORD TO DUMMY-HOLD SG1024.2 +025200 MOVE SPACE TO DUMMY-RECORD SG1024.2 +025300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1024.2 +025400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1024.2 +025500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1024.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1024.2 +025700 MOVE DUMMY-HOLD TO DUMMY-RECORD SG1024.2 +025800 MOVE ZERO TO RECORD-COUNT. SG1024.2 +025900 PERFORM WRT-LN. SG1024.2 +026000 WRT-LN. SG1024.2 +026100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1024.2 +026200 MOVE SPACE TO DUMMY-RECORD. SG1024.2 +026300 BLANK-LINE-PRINT. SG1024.2 +026400 PERFORM WRT-LN. SG1024.2 +026500 FAIL-ROUTINE. SG1024.2 +026600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1024.2 +026700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1024.2 +026800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1024.2 +026900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +027000 GO TO FAIL-ROUTINE-EX. SG1024.2 +027100 FAIL-ROUTINE-WRITE. SG1024.2 +027200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1024.2 +027300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1024.2 +027400 FAIL-ROUTINE-EX. EXIT. SG1024.2 +027500 BAIL-OUT. SG1024.2 +027600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1024.2 +027700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1024.2 +027800 BAIL-OUT-WRITE. SG1024.2 +027900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1024.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1024.2 +028100 BAIL-OUT-EX. EXIT. SG1024.2 +028200 CCVS1-EXIT. SG1024.2 +028300 EXIT. SG1024.2 +028400 TEST-1 SECTION 00. SG1024.2 +028500 TEST-1A. SG1024.2 +028600 GO TO TEST-1D. SG1024.2 +028700 TEST-1B. SG1024.2 +028800 ADD 2 TO SEG-CALC. SG1024.2 +028900 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +029000 ADD 2 TO RANGE-SUB. SG1024.2 +029100 GO TO TEST-1D. SG1024.2 +029200 TEST-1C. SG1024.2 +029300 ALTER PARA-1-22 TO PROCEED TO PARA-2-22. SG1024.2 +029400* NOTE ALTERED PARAGRAPH IN SECTION 22. SG1024.2 +029500 PERFORM TEST22. SG1024.2 +029600 TEST-1D. SG1024.2 +029700 EXIT. SG1024.2 +029800 SEG-TEST2 SECTION 00. SG1024.2 +029900 SEG-TEST-2. SG1024.2 +030000 MOVE 0 TO SEG-CALC. SG1024.2 +030100 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +030200 ALTER TEST-1A TO PROCEED TO TEST-1B. SG1024.2 +030300 MOVE "-" TO RANGE-X (2) RANGE-X (4) RANGE-X (6). SG1024.2 +030400 MOVE 0 TO RANGE-X (1). SG1024.2 +030500 MOVE 3 TO RANGE-SUB. SG1024.2 +030600 PERFORM TEST-1. SG1024.2 +030700 ALTER TEST-1A TO PROCEED TO TEST-1C. SG1024.2 +030800 PERFORM TEST-1. SG1024.2 +030900 PERFORM TEST-1. SG1024.2 +031000 IF SEG-CALC EQUAL TO 2 SG1024.2 +031100 PERFORM PASS SG1024.2 +031200 GO TO TEST-2-WRITE. SG1024.2 +031300 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +031400 MOVE "0-2-0-2" TO CORRECT-A. SG1024.2 +031500 PERFORM FAIL. SG1024.2 +031600 GO TO TEST-2-WRITE. SG1024.2 +031700 TEST-2-DELETE. SG1024.2 +031800 PERFORM DE-LETE. SG1024.2 +031900 TEST-2-WRITE. SG1024.2 +032000 MOVE "SEG-TEST-2" TO PAR-NAME. SG1024.2 +032100 PERFORM PRINT-DETAIL. SG1024.2 +032200 GO TO SEG-TEST-3. SG1024.2 +032300 TEST-6-1 SECTION 07. SG1024.2 +032400 TEST-6A. SG1024.2 +032500 ALTER TEST-6B TO PROCEED TO TEST-6D. SG1024.2 +032600 TEST-6-2 SECTION 08. SG1024.2 +032700 TEST-6B. SG1024.2 +032800 GO TO TEST-6E. SG1024.2 +032900 TEST-6-3 SECTION 09. SG1024.2 +033000 TEST-6C. SG1024.2 +033100 SUBTRACT 9 FROM SEG-CALC. SG1024.2 +033200 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +033300 ADD 2 TO RANGE-SUB. SG1024.2 +033400 TEST-6-4 SECTION 10. SG1024.2 +033500 TEST-6D. SG1024.2 +033600 ALTER TEST-6B TO PROCEED TO TEST-6F. SG1024.2 +033700 TEST-6-5 SECTION 11. SG1024.2 +033800 TEST-6E. SG1024.2 +033900 SUBTRACT SEG-CALC FROM SEG-CALC. SG1024.2 +034000 MOVE 0 TO RANGE-X (RANGE-SUB). SG1024.2 +034100 ADD 2 TO RANGE-SUB. SG1024.2 +034200 GO TO TEST-6-2. SG1024.2 +034300 START-TESTING SECTION 11. SG1024.2 +034400 SEG-TEST-1. SG1024.2 +034500 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +034600 MOVE 4 TO SEG-CALC. SG1024.2 +034700 MOVE "-" TO RANGE-X (2) RANGE-X (4). SG1024.2 +034800 MOVE 4 TO RANGE-X (1). SG1024.2 +034900 MOVE 3 TO RANGE-SUB. SG1024.2 +035000 ALTER TEST-1A TO PROCEED TO TEST-1C. SG1024.2 +035100* NOTE ALTERED PARAGRAPH IN SECTION 00. SG1024.2 +035200 PERFORM TEST-1. SG1024.2 +035300 PERFORM TEST-1. SG1024.2 +035400* NOTE 2ND PERFORM VERIFIES THAT TEST-1A IS STILL ALTERED SG1024.2 +035500* TO TEST-1B. SG1024.2 +035600 IF SEG-CALC EQUAL TO 2 SG1024.2 +035700 PERFORM PASS SG1024.2 +035800 GO TO TEST-1-WRITE. SG1024.2 +035900 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +036000 MOVE "4-0-2" TO CORRECT-A. SG1024.2 +036100 PERFORM FAIL. SG1024.2 +036200 GO TO TEST-1-WRITE. SG1024.2 +036300 TEST-1-DELETE. SG1024.2 +036400 PERFORM DE-LETE. SG1024.2 +036500 TEST-1-WRITE. SG1024.2 +036600 MOVE "SEG-TEST-1" TO PAR-NAME. SG1024.2 +036700 MOVE "SEGMENTATION" TO FEATURE. SG1024.2 +036800 PERFORM PRINT-DETAIL. SG1024.2 +036900 GO TO SEG-TEST-2. SG1024.2 +037000 TEST-8-BRANCH SECTION 12. SG1024.2 +037100 PARA-8. SG1024.2 +037200 GO TO SEG-TEST8. SG1024.2 +037300 TEST-6-6 SECTION 15. SG1024.2 +037400 TEST-6F. SG1024.2 +037500 ADD 9 TO SEG-CALC. SG1024.2 +037600 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +037700 ADD 2 TO RANGE-SUB. SG1024.2 +037800 TEST-6-7 SECTION 18. SG1024.2 +037900 TEST-6G. SG1024.2 +038000 ALTER TEST-6B TO PROCEED TO TEST-6-8. SG1024.2 +038100 GO TO TEST-6-2. SG1024.2 +038200 TEST-6-8 SECTION 20. SG1024.2 +038300 TEST-6H. SG1024.2 +038400 SUBTRACT 1 FROM SEG-CALC. SG1024.2 +038500 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +038600 ADD 2 TO RANGE-SUB. SG1024.2 +038700 TEST-6-9 SECTION 22. SG1024.2 +038800 TEST-6I. SG1024.2 +038900 EXIT. SG1024.2 +039000 TEST22 SECTION 22. SG1024.2 +039100 PARA-1-22. SG1024.2 +039200 GO TO PARA-3-22. SG1024.2 +039300 PARA-2-22. SG1024.2 +039400 MOVE 0 TO SEG-CALC. SG1024.2 +039500 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +039600 ADD 2 TO RANGE-SUB. SG1024.2 +039700 ALTER TEST-1A TO PROCEED TO TEST-1B. SG1024.2 +039800 PARA-3-22. SG1024.2 +039900 EXIT. SG1024.2 +040000 TEST-4 SECTION 43. SG1024.2 +040100 TEST-4A. SG1024.2 +040200 GO TO TEST-4C. SG1024.2 +040300 TEST-4B. SG1024.2 +040400 SUBTRACT 1 FROM SEG-CALC. SG1024.2 +040500 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +040600 ADD 2 TO RANGE-SUB. SG1024.2 +040700 IF SEG-CALC IS GREATER THAN 0 SG1024.2 +040800 GO TO TEST-4A. SG1024.2 +040900 GO TO TEST-4D. SG1024.2 +041000 TEST-4C. SG1024.2 +041100 ALTER TEST-4A TO PROCEED TO TEST-4B. SG1024.2 +041200 GO TO TEST-4B. SG1024.2 +041300 TEST-4D. SG1024.2 +041400 EXIT. SG1024.2 +041500 SEG-TEST5 SECTION 43. SG1024.2 +041600 SEG-TEST-5. SG1024.2 +041700 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +041800 MOVE 5 TO SEG-CALC. SG1024.2 +041900 MOVE SEG-CALC TO RANGE-X (1). SG1024.2 +042000 MOVE "-" TO RANGE-X (2) RANGE-X (4). SG1024.2 +042100 MOVE 3 TO RANGE-SUB. SG1024.2 +042200 PERFORM TEST-5. SG1024.2 +042300 SEG-5A. SG1024.2 +042400 GO TO SEG-5C. SG1024.2 +042500 SEG-5B. SG1024.2 +042600 PERFORM TEST-5B THRU TEST-5C. SG1024.2 +042700 IF SEG-CALC EQUAL TO 7 SG1024.2 +042800 PERFORM PASS SG1024.2 +042900 GO TO TEST-5-WRITE. SG1024.2 +043000 SEG-5C. SG1024.2 +043100 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +043200 MOVE "5-6-7" TO CORRECT-A. SG1024.2 +043300 PERFORM FAIL. SG1024.2 +043400 GO TO TEST-5-WRITE. SG1024.2 +043500 TEST-5-DELETE. SG1024.2 +043600 PERFORM DE-LETE. SG1024.2 +043700 TEST-5-WRITE. SG1024.2 +043800 MOVE "SEG-TEST-5" TO PAR-NAME. SG1024.2 +043900 PERFORM PRINT-DETAIL. SG1024.2 +044000 GO TO SEG-TEST-6. SG1024.2 +044100 SEG-TEST7 SECTION 74. SG1024.2 +044200 SEG-TEST-7. SG1024.2 +044300 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +044400 MOVE 3 TO SEG-CALC. SG1024.2 +044500 MOVE 3 TO RANGE-SUB. SG1024.2 +044600 MOVE SEG-CALC TO RANGE-X (1). SG1024.2 +044700 MOVE "-" TO RANGE-X (2) RANGE-X (4) RANGE-X (6). SG1024.2 +044800 ALTER TEST-7A TO PROCEED TO TEST-7D. SG1024.2 +044900 PERFORM TEST-7-1 THRU TEST-7-4. SG1024.2 +045000 PERFORM TEST-7-1 THRU TEST-7-4. SG1024.2 +045100 IF SEG-CALC EQUAL TO 4 SG1024.2 +045200 PERFORM PASS SG1024.2 +045300 GO TO TEST-7-WRITE. SG1024.2 +045400 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +045500 MOVE "3-2-5-4" TO CORRECT-A. SG1024.2 +045600 PERFORM FAIL. SG1024.2 +045700 GO TO TEST-7-WRITE. SG1024.2 +045800 TEST-7-DELETE. SG1024.2 +045900 PERFORM DE-LETE. SG1024.2 +046000 TEST-7-WRITE. SG1024.2 +046100 MOVE "SEG-TEST-7" TO PAR-NAME. SG1024.2 +046200 PERFORM PRINT-DETAIL. SG1024.2 +046300 MOVE 0 TO SEG-CALC. SG1024.2 +046400 GO TO TEST-8-BRANCH. SG1024.2 +046500 TEST-7-1 SECTION 74. SG1024.2 +046600 TEST-7A. SG1024.2 +046700 GO TO TEST-7B. SG1024.2 +046800 TEST-7-2 SECTION 74. SG1024.2 +046900 TEST-7B. SG1024.2 +047000 ALTER TEST-7A TO PROCEED TO TEST-7C. SG1024.2 +047100 TEST-7-3 SECTION 74. SG1024.2 +047200 TEST-7C. SG1024.2 +047300 ADD 3 TO SEG-CALC. SG1024.2 +047400 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +047500 ADD 2 TO RANGE-SUB. SG1024.2 +047600 TEST-7D. SG1024.2 +047700 SUBTRACT 1 FROM SEG-CALC. SG1024.2 +047800 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +047900 ADD 2 TO RANGE-SUB. SG1024.2 +048000 PERFORM TEST-7B. SG1024.2 +048100 TEST-7-4 SECTION 74. SG1024.2 +048200 TEST-7E. SG1024.2 +048300 GO TO TEST-7F. SG1024.2 +048400 TEST-7F. SG1024.2 +048500 ALTER TEST-7E TO PROCEED TO TEST-7G. SG1024.2 +048600 TEST-7G. SG1024.2 +048700 EXIT. SG1024.2 +048800 SEG-TEST3 SECTION 66. SG1024.2 +048900 SEG-TEST-3. SG1024.2 +049000 MOVE 2 TO SEG-CALC. SG1024.2 +049100 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +049200 MOVE 2 TO RANGE-X (1). SG1024.2 +049300 MOVE "-" TO RANGE-X (2) RANGE-X (4). SG1024.2 +049400 MOVE 3 TO RANGE-SUB. SG1024.2 +049500 PERFORM TEST-3. SG1024.2 +049600 ALTER TEST-3X TO PROCEED TO TEST-3B. SG1024.2 +049700 ALTER TEST-3A TO PROCEED TO TEST-3C. SG1024.2 +049800 PERFORM TEST-3A THRU TEST-3EXIT. SG1024.2 +049900 PERFORM TEST-3C. SG1024.2 +050000 GO TO TEST-3X. SG1024.2 +050100* NOTE PERFORMING AND GO TO SECTION 66 PARAGRAPHS. SG1024.2 +050200 TEST-3-DELETE. SG1024.2 +050300 PERFORM DE-LETE. SG1024.2 +050400 TEST-3-WRITE. SG1024.2 +050500 MOVE "SEG-TEST-3" TO PAR-NAME. SG1024.2 +050600 PERFORM PRINT-DETAIL. SG1024.2 +050700 GO TO SEG-TEST-4. SG1024.2 +050800 TEST-3 SECTION 66. SG1024.2 +050900 TEST-3X. SG1024.2 +051000 GO TO TEST-3D. SG1024.2 +051100 TEST-3A. SG1024.2 +051200 GO TO TEST-3B. SG1024.2 +051300 TEST-3B. SG1024.2 +051400 IF SEG-CALC EQUAL TO 6 SG1024.2 +051500 PERFORM PASS SG1024.2 +051600 GO TO TEST-3-WRITE. SG1024.2 +051700 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +051800 MOVE "2-4-6" TO CORRECT-A. SG1024.2 +051900 PERFORM FAIL. SG1024.2 +052000 GO TO TEST-3-WRITE. SG1024.2 +052100 TEST-3C. SG1024.2 +052200 ADD 2 TO SEG-CALC. SG1024.2 +052300 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +052400 ADD 2 TO RANGE-SUB. SG1024.2 +052500 TEST-3D. SG1024.2 +052600 IF SEG-CALC EQUAL TO 2 GO TO TEST-3EXIT. SG1024.2 +052700 PERFORM TEST-3C. SG1024.2 +052800 GO TO TEST-3B. SG1024.2 +052900 TEST-3EXIT. SG1024.2 +053000 EXIT. SG1024.2 +053100 SEG-TEST4 SECTION 66. SG1024.2 +053200 SEG-TEST-4. SG1024.2 +053300 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +053400 MOVE 3 TO RANGE-SUB. SG1024.2 +053500 MOVE 3 TO SEG-CALC. SG1024.2 +053600 MOVE 3 TO RANGE-X (1). SG1024.2 +053700 MOVE "-" TO RANGE-X (2) RANGE-X (4) RANGE-X (6). SG1024.2 +053800 PERFORM TEST-4. SG1024.2 +053900 IF SEG-CALC EQUAL TO 0 SG1024.2 +054000 PERFORM PASS SG1024.2 +054100 GO TO TEST-4-WRITE. SG1024.2 +054200 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +054300 MOVE "3-2-1-0" TO CORRECT-A. SG1024.2 +054400 PERFORM FAIL. SG1024.2 +054500 GO TO TEST-4-WRITE. SG1024.2 +054600 TEST-4-DELETE. SG1024.2 +054700 PERFORM DE-LETE. SG1024.2 +054800 TEST-4-WRITE. SG1024.2 +054900 MOVE "SEG-TEST-4" TO PAR-NAME. SG1024.2 +055000 PERFORM PRINT-DETAIL. SG1024.2 +055100 GO TO SEG-TEST-5. SG1024.2 +055200 SEG-TEST6 SECTION 83. SG1024.2 +055300 SEG-TEST-6. SG1024.2 +055400 MOVE 9 TO SEG-CALC. SG1024.2 +055500 MOVE SPACE TO COMPUTED-RANGE. SG1024.2 +055600 MOVE SEG-CALC TO RANGE-X (1). SG1024.2 +055700 MOVE "-" TO RANGE-X (2) RANGE-X (4) RANGE-X (6). SG1024.2 +055800 MOVE 3 TO RANGE-SUB. SG1024.2 +055900 PERFORM TEST-6A THRU TEST-6I. SG1024.2 +056000 IF SEG-CALC EQUAL TO 8 SG1024.2 +056100 PERFORM PASS SG1024.2 +056200 GO TO TEST-6-WRITE. SG1024.2 +056300 MOVE COMPUTED-RANGE TO COMPUTED-A. SG1024.2 +056400 MOVE "9-0-9-8" TO CORRECT-A. SG1024.2 +056500 PERFORM FAIL. SG1024.2 +056600 GO TO TEST-6-WRITE. SG1024.2 +056700 TEST-6-DELETE. SG1024.2 +056800 PERFORM DE-LETE. SG1024.2 +056900 TEST-6-WRITE. SG1024.2 +057000 MOVE "SEG-TEST-6" TO PAR-NAME. SG1024.2 +057100 PERFORM PRINT-DETAIL. SG1024.2 +057200 GO TO SEG-TEST-7. SG1024.2 +057300* NOTE PERFORM RESIDENT SECTIONS 7 THRU 22. SG1024.2 +057400 SEG-TEST8 SECTION 84. SG1024.2 +057500 SEG-TEST-8. SG1024.2 +057600 ALTER PARA-8 TO PROCEED TO SEG-TEST-8A. SG1024.2 +057700 ADD 1 TO SEG-CALC. SG1024.2 +057800 IF SEG-CALC EQUAL TO 2 SG1024.2 +057900 PERFORM FAIL SG1024.2 +058000 GO TO TEST-8-WRITE. SG1024.2 +058100 GO TO TEST-8-BRANCH. SG1024.2 +058200 SEG-TEST-8A SECTION 85. SG1024.2 +058300 PARA-85. SG1024.2 +058400 PERFORM PASS. SG1024.2 +058500 TEST-8-WRITE. SG1024.2 +058600 MOVE "ALTER RES TO NON-RES" TO FEATURE. SG1024.2 +058700 MOVE "SEG-TEST-8" TO PAR-NAME. SG1024.2 +058800 PERFORM PRINT-DETAIL. SG1024.2 +058900 GO TO CLOSE-FILES. SG1024.2 +059000 TEST-5 SECTION 99. SG1024.2 +059100 TEST-5A. SG1024.2 +059200 GO TO TEST-5B. SG1024.2 +059300 TEST-5B. SG1024.2 +059400 ALTER SEG-5A TO PROCEED TO SEG-5B. SG1024.2 +059500 ALTER TEST-5A TO PROCEED TO TEST-5C. SG1024.2 +059600 PERFORM SEG-99A THROUGH SEG-99C. SG1024.2 +059700 GO TO TEST-5A. SG1024.2 +059800 TEST-5C. SG1024.2 +059900 EXIT. SG1024.2 +060000 SEG SECTION 99. SG1024.2 +060100 SEG-99A. SG1024.2 +060200 GO TO SEG-99B. SG1024.2 +060300 SEG-99B. SG1024.2 +060400 ALTER SEG-99A TO PROCEED TO SEG-99C. SG1024.2 +060500 ALTER TEST-5A TO PROCEED TO TEST-5B. SG1024.2 +060600 ADD 1 TO SEG-CALC. SG1024.2 +060700 MOVE SEG-CALC TO RANGE-X (RANGE-SUB). SG1024.2 +060800 ADD 2 TO RANGE-SUB. SG1024.2 +060900 SEG-99C. SG1024.2 +061000 EXIT. SG1024.2 diff --git a/tests/cobol85/SG/SG103A.CBL b/tests/cobol85/SG/SG103A.CBL new file mode 100755 index 00000000..fe95a4a8 --- /dev/null +++ b/tests/cobol85/SG/SG103A.CBL @@ -0,0 +1,485 @@ +000100 IDENTIFICATION DIVISION. SG1034.2 +000200 PROGRAM-ID. SG1034.2 +000300 SG103A. SG1034.2 +000400 AUTHOR. SG1034.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1034.2 +000600 INSTALLATION. SG1034.2 +000700 GENERAL SERVICES ADMINISTRATION SG1034.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1034.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1034.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1034.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1034.2 +001200 SG1034.2 +001300 PHONE (703) 756-6153 SG1034.2 +001400 SG1034.2 +001500 " HIGH ". SG1034.2 +001600 DATE-WRITTEN. SG1034.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1034.2 +001800 CREATION DATE / VALIDATION DATE SG1034.2 +001900 "4.2 ". SG1034.2 +002000 SECURITY. SG1034.2 +002100 NONE. SG1034.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG1034.2 +002300 THE ALTER, PERFORM, AND GO TO STATEMENTS ARE USED SG1034.2 +002400 TO CHECK INITIAL AND LAST-USED STATES. SG1034.2 +002500 SG1034.2 +002600 ENVIRONMENT DIVISION. SG1034.2 +002700 CONFIGURATION SECTION. SG1034.2 +002800 SOURCE-COMPUTER. SG1034.2 +002900 Linux. SG1034.2 +003000 OBJECT-COMPUTER. SG1034.2 +003100 Linux. SG1034.2 +003200 INPUT-OUTPUT SECTION. SG1034.2 +003300 FILE-CONTROL. SG1034.2 +003400 SELECT PRINT-FILE ASSIGN TO SG1034.2 +003500 "report.log". SG1034.2 +003600 DATA DIVISION. SG1034.2 +003700 FILE SECTION. SG1034.2 +003800 FD PRINT-FILE SG1034.2 +003900 LABEL RECORDS SG1034.2 +004000 OMITTED SG1034.2 +004100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1034.2 +004200 01 PRINT-REC PICTURE X(120). SG1034.2 +004300 01 DUMMY-RECORD PICTURE X(120). SG1034.2 +004400 WORKING-STORAGE SECTION. SG1034.2 +004500 77 ENT-COUNTER PIC 9 VALUE ZERO. SG1034.2 +004600 01 INITIAL-STATE-A PICTURE 9 VALUE 0. SG1034.2 +004700 01 GO-TO-IND PICTURE X VALUE " ". SG1034.2 +004800 01 PERFORM-RSLT. SG1034.2 +004900 02 PERFORM-RSLT-1 PICTURE X VALUE " ". SG1034.2 +005000 02 PERFORM-RSLT-2 PICTURE X VALUE " ". SG1034.2 +005100 02 PERFORM-RSLT-3 PICTURE X VALUE " ". SG1034.2 +005200 02 PERFORM-RSLT-4 PICTURE X VALUE " ". SG1034.2 +005300 01 ALTER-RSLT. SG1034.2 +005400 02 ALTER-RSLT-1 PICTURE X VALUE " ". SG1034.2 +005500 02 ALTER-RSLT-2 PICTURE X VALUE " ". SG1034.2 +005600 02 ALTER-RSLT-3 PICTURE X VALUE " ". SG1034.2 +005700 01 FALL-RSLT. SG1034.2 +005800 02 FALL-RSLT-1 PICTURE X VALUE " ". SG1034.2 +005900 02 FALL-RSLT-2 PICTURE X VALUE " ". SG1034.2 +006000 01 TEST-RESULTS. SG1034.2 +006100 02 FILLER PICTURE X VALUE SPACE. SG1034.2 +006200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1034.2 +006300 02 FILLER PICTURE X VALUE SPACE. SG1034.2 +006400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1034.2 +006500 02 FILLER PICTURE X VALUE SPACE. SG1034.2 +006600 02 PAR-NAME. SG1034.2 +006700 03 FILLER PICTURE X(12) VALUE SPACE. SG1034.2 +006800 03 PARDOT-X PICTURE X VALUE SPACE. SG1034.2 +006900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1034.2 +007000 03 FILLER PIC X(5) VALUE SPACE. SG1034.2 +007100 02 FILLER PIC X(10) VALUE SPACE. SG1034.2 +007200 02 RE-MARK PIC X(61). SG1034.2 +007300 01 TEST-COMPUTED. SG1034.2 +007400 02 FILLER PIC X(30) VALUE SPACE. SG1034.2 +007500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1034.2 +007600 02 COMPUTED-X. SG1034.2 +007700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1034.2 +007800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1034.2 +007900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1034.2 +008000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1034.2 +008100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1034.2 +008200 03 CM-18V0 REDEFINES COMPUTED-A. SG1034.2 +008300 04 COMPUTED-18V0 PICTURE -9(18). SG1034.2 +008400 04 FILLER PICTURE X. SG1034.2 +008500 03 FILLER PIC X(50) VALUE SPACE. SG1034.2 +008600 01 TEST-CORRECT. SG1034.2 +008700 02 FILLER PIC X(30) VALUE SPACE. SG1034.2 +008800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1034.2 +008900 02 CORRECT-X. SG1034.2 +009000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1034.2 +009100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1034.2 +009200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1034.2 +009300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1034.2 +009400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1034.2 +009500 03 CR-18V0 REDEFINES CORRECT-A. SG1034.2 +009600 04 CORRECT-18V0 PICTURE -9(18). SG1034.2 +009700 04 FILLER PICTURE X. SG1034.2 +009800 03 FILLER PIC X(50) VALUE SPACE. SG1034.2 +009900 01 CCVS-C-1. SG1034.2 +010000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1034.2 +010100- "SS PARAGRAPH-NAME SG1034.2 +010200- " REMARKS". SG1034.2 +010300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1034.2 +010400 01 CCVS-C-2. SG1034.2 +010500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1034.2 +010600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1034.2 +010700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1034.2 +010800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1034.2 +010900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1034.2 +011000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1034.2 +011100 01 REC-CT PICTURE 99 VALUE ZERO. SG1034.2 +011200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1034.2 +011300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1034.2 +011400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1034.2 +011500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1034.2 +011600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1034.2 +011700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1034.2 +011800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1034.2 +011900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1034.2 +012000 01 CCVS-H-1. SG1034.2 +012100 02 FILLER PICTURE X(27) VALUE SPACE. SG1034.2 +012200 02 FILLER PICTURE X(67) VALUE SG1034.2 +012300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1034.2 +012400- " SYSTEM". SG1034.2 +012500 02 FILLER PICTURE X(26) VALUE SPACE. SG1034.2 +012600 01 CCVS-H-2. SG1034.2 +012700 02 FILLER PICTURE X(52) VALUE IS SG1034.2 +012800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1034.2 +012900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1034.2 +013000 02 TEST-ID PICTURE IS X(9). SG1034.2 +013100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1034.2 +013200 01 CCVS-H-3. SG1034.2 +013300 02 FILLER PICTURE X(34) VALUE SG1034.2 +013400 " FOR OFFICIAL USE ONLY ". SG1034.2 +013500 02 FILLER PICTURE X(58) VALUE SG1034.2 +013600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1034.2 +013700 02 FILLER PICTURE X(28) VALUE SG1034.2 +013800 " COPYRIGHT 1974 ". SG1034.2 +013900 01 CCVS-E-1. SG1034.2 +014000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1034.2 +014100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1034.2 +014200 02 ID-AGAIN PICTURE IS X(9). SG1034.2 +014300 02 FILLER PICTURE X(45) VALUE IS SG1034.2 +014400 " NTIS DISTRIBUTION COBOL 74". SG1034.2 +014500 01 CCVS-E-2. SG1034.2 +014600 02 FILLER PICTURE X(31) VALUE SG1034.2 +014700 SPACE. SG1034.2 +014800 02 FILLER PICTURE X(21) VALUE SPACE. SG1034.2 +014900 02 CCVS-E-2-2. SG1034.2 +015000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1034.2 +015100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1034.2 +015200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1034.2 +015300 01 CCVS-E-3. SG1034.2 +015400 02 FILLER PICTURE X(22) VALUE SG1034.2 +015500 " FOR OFFICIAL USE ONLY". SG1034.2 +015600 02 FILLER PICTURE X(12) VALUE SPACE. SG1034.2 +015700 02 FILLER PICTURE X(58) VALUE SG1034.2 +015800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1034.2 +015900 02 FILLER PICTURE X(13) VALUE SPACE. SG1034.2 +016000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1034.2 +016100 01 CCVS-E-4. SG1034.2 +016200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1034.2 +016300 02 FILLER PIC XXXX VALUE " OF ". SG1034.2 +016400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1034.2 +016500 02 FILLER PIC X(40) VALUE SG1034.2 +016600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1034.2 +016700 01 XXINFO. SG1034.2 +016800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1034.2 +016900 02 INFO-TEXT. SG1034.2 +017000 04 FILLER PIC X(20) VALUE SPACE. SG1034.2 +017100 04 XXCOMPUTED PIC X(20). SG1034.2 +017200 04 FILLER PIC X(5) VALUE SPACE. SG1034.2 +017300 04 XXCORRECT PIC X(20). SG1034.2 +017400 01 HYPHEN-LINE. SG1034.2 +017500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1034.2 +017600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1034.2 +017700- "*****************************************". SG1034.2 +017800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1034.2 +017900- "******************************". SG1034.2 +018000 01 CCVS-PGM-ID PIC X(6) VALUE SG1034.2 +018100 "SG103A". SG1034.2 +018200 PROCEDURE DIVISION. SG1034.2 +018300 SEC00 SECTION. SG1034.2 +018400 P0001. SG1034.2 +018500 GO TO P0003. SG1034.2 +018600 CCVS1 SECTION. SG1034.2 +018700 OPEN-FILES. SG1034.2 +018800 OPEN OUTPUT PRINT-FILE. SG1034.2 +018900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1034.2 +019000 MOVE SPACE TO TEST-RESULTS. SG1034.2 +019100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1034.2 +019200 GO TO CCVS1-EXIT. SG1034.2 +019300 CLOSE-FILES. SG1034.2 +019400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1034.2 +019500 TERMINATE-CCVS. SG1034.2 +019600*S EXIT PROGRAM. SG1034.2 +019700*SERMINATE-CALL. SG1034.2 +019800 STOP RUN. SG1034.2 +019900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1034.2 +020000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1034.2 +020100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1034.2 +020200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1034.2 +020300 MOVE "****TEST DELETED****" TO RE-MARK. SG1034.2 +020400 PRINT-DETAIL. SG1034.2 +020500 IF REC-CT NOT EQUAL TO ZERO SG1034.2 +020600 MOVE "." TO PARDOT-X SG1034.2 +020700 MOVE REC-CT TO DOTVALUE. SG1034.2 +020800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1034.2 +020900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1034.2 +021000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1034.2 +021100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1034.2 +021200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1034.2 +021300 MOVE SPACE TO CORRECT-X. SG1034.2 +021400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1034.2 +021500 MOVE SPACE TO RE-MARK. SG1034.2 +021600 HEAD-ROUTINE. SG1034.2 +021700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +021800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1034.2 +021900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1034.2 +022000 COLUMN-NAMES-ROUTINE. SG1034.2 +022100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +022200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +022300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +022400 END-ROUTINE. SG1034.2 +022500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1034.2 +022600 END-RTN-EXIT. SG1034.2 +022700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +022800 END-ROUTINE-1. SG1034.2 +022900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1034.2 +023000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1034.2 +023100 ADD PASS-COUNTER TO ERROR-HOLD. SG1034.2 +023200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1034.2 +023300 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1034.2 +023400 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1034.2 +023500 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1034.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1034.2 +023700 END-ROUTINE-12. SG1034.2 +023800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1034.2 +023900 IF ERROR-COUNTER IS EQUAL TO ZERO SG1034.2 +024000 MOVE "NO " TO ERROR-TOTAL SG1034.2 +024100 ELSE SG1034.2 +024200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1034.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1034.2 +024400 PERFORM WRITE-LINE. SG1034.2 +024500 END-ROUTINE-13. SG1034.2 +024600 IF DELETE-CNT IS EQUAL TO ZERO SG1034.2 +024700 MOVE "NO " TO ERROR-TOTAL ELSE SG1034.2 +024800 MOVE DELETE-CNT TO ERROR-TOTAL. SG1034.2 +024900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1034.2 +025000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +025100 IF INSPECT-COUNTER EQUAL TO ZERO SG1034.2 +025200 MOVE "NO " TO ERROR-TOTAL SG1034.2 +025300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1034.2 +025400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1034.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +025600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1034.2 +025700 WRITE-LINE. SG1034.2 +025800 ADD 1 TO RECORD-COUNT. SG1034.2 +025900 IF RECORD-COUNT GREATER 50 SG1034.2 +026000 MOVE DUMMY-RECORD TO DUMMY-HOLD SG1034.2 +026100 MOVE SPACE TO DUMMY-RECORD SG1034.2 +026200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1034.2 +026300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1034.2 +026400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1034.2 +026500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1034.2 +026600 MOVE DUMMY-HOLD TO DUMMY-RECORD SG1034.2 +026700 MOVE ZERO TO RECORD-COUNT. SG1034.2 +026800 PERFORM WRT-LN. SG1034.2 +026900 WRT-LN. SG1034.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1034.2 +027100 MOVE SPACE TO DUMMY-RECORD. SG1034.2 +027200 BLANK-LINE-PRINT. SG1034.2 +027300 PERFORM WRT-LN. SG1034.2 +027400 FAIL-ROUTINE. SG1034.2 +027500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1034.2 +027600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1034.2 +027700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1034.2 +027800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +027900 GO TO FAIL-ROUTINE-EX. SG1034.2 +028000 FAIL-ROUTINE-WRITE. SG1034.2 +028100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1034.2 +028200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1034.2 +028300 FAIL-ROUTINE-EX. EXIT. SG1034.2 +028400 BAIL-OUT. SG1034.2 +028500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1034.2 +028600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1034.2 +028700 BAIL-OUT-WRITE. SG1034.2 +028800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1034.2 +028900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1034.2 +029000 BAIL-OUT-EX. EXIT. SG1034.2 +029100 CCVS1-EXIT. SG1034.2 +029200 EXIT. SG1034.2 +029300 SECT-SG-03-001 SECTION 00. SG1034.2 +029400 P0002. SG1034.2 +029500 MOVE "D" TO PERFORM-RSLT-4. SG1034.2 +029600 P0003. SG1034.2 +029700 PERFORM CCVS1. SG1034.2 +029800 SEC20 SECTION 20. SG1034.2 +029900 TEST-1. SG1034.2 +030000 PERFORM SEC80. SG1034.2 +030100* NOTE THAT AN INDEPENDENT SEGMENT SHOULD BE MADE AVAILABLE TO SG1034.2 +030200* THE PROGRAM IN ITS INITIAL STATE EACH TIME IT IS SG1034.2 +030300* REFERENCED, AN ALTER STATEMENT WILL BE USED TO TEST THISSG1034.2 +030400* FEATURE. SG1034.2 +030500 PERFORM SEC80. SG1034.2 +030600 IF INITIAL-STATE-A EQUAL TO 2 PERFORM PASS SG1034.2 +030700 ELSE MOVE INITIAL-STATE-A TO COMPUTED-A SG1034.2 +030800 MOVE "2" TO CORRECT-A SG1034.2 +030900 PERFORM FAIL. SG1034.2 +031000 GO TO TEST-1-WRITE. SG1034.2 +031100 TEST-1-DELETE. SG1034.2 +031200 PERFORM DE-LETE. SG1034.2 +031300 TEST-1-WRITE. SG1034.2 +031400 MOVE "INITIAL STATE" TO FEATURE. SG1034.2 +031500 MOVE "TEST-1" TO PAR-NAME. SG1034.2 +031600 PERFORM PRINT-DETAIL. SG1034.2 +031700 TEST-2. SG1034.2 +031800 MOVE SPACE TO CORRECT-A. SG1034.2 +031900* NOTE THAT A "GO TO" A NON-RESIDENT ROUTINE WILL BE TESTED. SG1034.2 +032000 GO TO P6001. SG1034.2 +032100 GO-TO-RETURN. SG1034.2 +032200 IF GO-TO-IND EQUAL TO "G" PERFORM PASS SG1034.2 +032300 ELSE MOVE GO-TO-IND TO COMPUTED-A SG1034.2 +032400 MOVE "G" TO CORRECT-A SG1034.2 +032500 PERFORM FAIL. SG1034.2 +032600 GO TO TEST-2-WRITE. SG1034.2 +032700 TEST-2-DELETE. SG1034.2 +032800 PERFORM DE-LETE. SG1034.2 +032900 TEST-2-WRITE. SG1034.2 +033000 MOVE "GO TO INDEP SEG" TO FEATURE. SG1034.2 +033100 MOVE "TEST-2" TO PAR-NAME. SG1034.2 +033200 PERFORM PRINT-DETAIL. SG1034.2 +033300 TEST-3. SG1034.2 +033400 MOVE SPACE TO CORRECT-A. SG1034.2 +033500* NOTE THAT THIS TEST PERFORMS A ROUTINE LOCATED IN AN SG1034.2 +033600* INDEPENDENT SEGMENT. SG1034.2 +033700 PERFORM P9301 THRU P9303. SG1034.2 +033800 IF PERFORM-RSLT EQUAL TO "ABCD" PERFORM PASS SG1034.2 +033900 ELSE MOVE PERFORM-RSLT TO COMPUTED-A SG1034.2 +034000 MOVE "ABCD" TO CORRECT-A SG1034.2 +034100 PERFORM FAIL. SG1034.2 +034200 GO TO TEST-3-WRITE. SG1034.2 +034300 TEST-3-DELETE. SG1034.2 +034400 PERFORM DE-LETE. SG1034.2 +034500 TEST-3-WRITE. SG1034.2 +034600 MOVE "PERFORM IND SEG" TO FEATURE. SG1034.2 +034700 MOVE "TEST-3" TO PAR-NAME. SG1034.2 +034800 PERFORM PRINT-DETAIL. SG1034.2 +034900 TEST-4. SG1034.2 +035000 MOVE SPACE TO CORRECT-A. SG1034.2 +035100* NOTE THAT THIS TEST CAUSES AN INDEPENDENT SEGMENT TO ALTER SG1034.2 +035200* A STATEMENT IN THE FIXED PORTION AND THEN CHECKS TO SG1034.2 +035300* SEE THAT THE ALTER IS IN EFFECT. SG1034.2 +035400 PERFORM SEC95. SG1034.2 +035500 ALTER-RES. SG1034.2 +035600 GO TO ALTER-RES1. SG1034.2 +035700 ALTER-RES1. SG1034.2 +035800 MOVE "A" TO ALTER-RSLT-2. SG1034.2 +035900 GO TO ALTER-RES3. SG1034.2 +036000 ALTER-RES2. SG1034.2 +036100 MOVE "B" TO ALTER-RSLT-3. SG1034.2 +036200 ALTER-RES3. SG1034.2 +036300 IF ALTER-RSLT EQUAL TO "E B" PERFORM PASS SG1034.2 +036400 ELSE MOVE ALTER-RSLT TO COMPUTED-A SG1034.2 +036500 MOVE "E B" TO CORRECT-A SG1034.2 +036600 PERFORM FAIL. SG1034.2 +036700 GO TO TEST-4-WRITE. SG1034.2 +036800 TEST-4-DELETE. SG1034.2 +036900 PERFORM DE-LETE. SG1034.2 +037000 TEST-4-WRITE. SG1034.2 +037100 MOVE "ALT RES FRM IND" TO FEATURE. SG1034.2 +037200 MOVE "TEST-4" TO PAR-NAME. SG1034.2 +037300 PERFORM PRINT-DETAIL. SG1034.2 +037400 TEST-5. SG1034.2 +037500 IF PAR-NAME EQUAL TO "TEST-6 " GO TO P2006. SG1034.2 +037600 MOVE "TEST-5" TO PAR-NAME. SG1034.2 +037700* NOTE THAT THIS TEST REQUIRES THE LOGICAL PATH OF THE PROGRAM SG1034.2 +037800* TO PROCEED FROM THE FIXED PORTION THROUGH AN SG1034.2 +037900* INDEPENDENT SEGMENT. SG1034.2 +038000 P2005. SG1034.2 +038100 MOVE "A" TO FALL-RSLT-1. SG1034.2 +038200 P2006. EXIT. SG1034.2 +038300 SEC51 SECTION 51. SG1034.2 +038400 P5101. SG1034.2 +038500 IF PAR-NAME EQUAL TO "TEST-6 " GO TO P5102. SG1034.2 +038600 MOVE "B" TO FALL-RSLT-2. SG1034.2 +038700 IF FALL-RSLT EQUAL TO "AB" PERFORM PASS SG1034.2 +038800 ELSE MOVE FALL-RSLT TO COMPUTED-A SG1034.2 +038900 MOVE "AB" TO CORRECT-A SG1034.2 +039000 PERFORM FAIL. SG1034.2 +039100 GO TO TEST-5-WRITE. SG1034.2 +039200 TEST-5-DELETE. SG1034.2 +039300 PERFORM DE-LETE. SG1034.2 +039400 TEST-5-WRITE. SG1034.2 +039500 MOVE "FALL THRU TEST" TO FEATURE. SG1034.2 +039600 PERFORM PRINT-DETAIL. SG1034.2 +039700 MOVE "TEST-6" TO PAR-NAME. SG1034.2 +039800 GO TO TEST-5. SG1034.2 +039900 P5102. GO TO P5103. SG1034.2 +040000 P5103. SG1034.2 +040100 ALTER P5102 TO PROCEED TO P5104. SG1034.2 +040200 MOVE SPACE TO FALL-RSLT. SG1034.2 +040300 GO TO P5105. SG1034.2 +040400 P5104. MOVE "XX" TO FALL-RSLT. SG1034.2 +040500 P5105. EXIT. SG1034.2 +040600 P5106. SG1034.2 +040700 ADD 1 TO ENT-COUNTER. SG1034.2 +040800 IF ENT-COUNTER EQUAL TO 2 SG1034.2 +040900 GO TO TEST-6. SG1034.2 +041000 GO TO TEST-5. SG1034.2 +041100 TEST-6. SG1034.2 +041200 IF FALL-RSLT EQUAL TO SPACE SG1034.2 +041300 PERFORM PASS SG1034.2 +041400 GO TO TEST-6-WRITE. SG1034.2 +041500 MOVE "SPACE" TO CORRECT-A. SG1034.2 +041600 MOVE FALL-RSLT TO COMPUTED-A. SG1034.2 +041700 PERFORM FAIL. SG1034.2 +041800 GO TO TEST-6-WRITE. SG1034.2 +041900 TEST-6-DELETE. SG1034.2 +042000 PERFORM DE-LETE. SG1034.2 +042100 TEST-6-WRITE. SG1034.2 +042200 PERFORM PRINT-DETAIL. SG1034.2 +042300 MOVE ZERO TO ENT-COUNTER. SG1034.2 +042400 MOVE SPACE TO GO-TO-IND. SG1034.2 +042500 TEST-7. SG1034.2 +042600 GO TO P9901. SG1034.2 +042700 PARA-7A. SG1034.2 +042800 GO TO P9901. SG1034.2 +042900 PARA-7B. SG1034.2 +043000 IF GO-TO-IND EQUAL TO SPACE SG1034.2 +043100 PERFORM PASS SG1034.2 +043200 GO TO TEST-7-WRITE. SG1034.2 +043300 MOVE "SPACE" TO CORRECT-A. SG1034.2 +043400 MOVE GO-TO-IND TO COMPUTED-A. SG1034.2 +043500 PERFORM FAIL. SG1034.2 +043600 GO TO TEST-7-WRITE. SG1034.2 +043700 TEST-7-DELETE. SG1034.2 +043800 PERFORM DE-LETE. SG1034.2 +043900 TEST-7-WRITE. SG1034.2 +044000 MOVE "TEST-7" TO PAR-NAME. SG1034.2 +044100 MOVE "GO TO ALTER IND" TO FEATURE. SG1034.2 +044200 PERFORM PRINT-DETAIL. SG1034.2 +044300 WRAP-UP. SG1034.2 +044400 GO TO CLOSE-FILES. SG1034.2 +044500 SEC60 SECTION 60. SG1034.2 +044600 P6001. SG1034.2 +044700 MOVE "G" TO GO-TO-IND. SG1034.2 +044800 GO TO GO-TO-RETURN. SG1034.2 +044900 SEC80 SECTION 80. SG1034.2 +045000 P8001. SG1034.2 +045100 GO TO P8002. SG1034.2 +045200 P8002. SG1034.2 +045300 ALTER P8001 TO PROCEED TO P8003. SG1034.2 +045400 ADD 1 TO INITIAL-STATE-A. SG1034.2 +045500 GO TO P8004. SG1034.2 +045600 P8003. SG1034.2 +045700 MOVE 9 TO INITIAL-STATE-A. SG1034.2 +045800 P8004. SG1034.2 +045900 EXIT. SG1034.2 +046000 SEC93 SECTION 93. SG1034.2 +046100 P9301. SG1034.2 +046200 MOVE "A" TO PERFORM-RSLT-1. SG1034.2 +046300 PERFORM P9302. SG1034.2 +046400 MOVE "C" TO PERFORM-RSLT-3. SG1034.2 +046500 GO TO P9303. SG1034.2 +046600 P9302. SG1034.2 +046700 MOVE "B" TO PERFORM-RSLT-2. SG1034.2 +046800 P9303. SG1034.2 +046900 PERFORM P0002. SG1034.2 +047000 SEC95 SECTION 95. SG1034.2 +047100 P9501. SG1034.2 +047200 MOVE "E" TO ALTER-RSLT-1. SG1034.2 +047300 ALTER ALTER-RES TO PROCEED TO ALTER-RES2. SG1034.2 +047400 SEC99 SECTION 99. SG1034.2 +047500 P9901. SG1034.2 +047600 GO TO P9902. SG1034.2 +047700 P9902. SG1034.2 +047800 ALTER P9901 TO P9903. SG1034.2 +047900 IF ENT-COUNTER EQUAL TO ZERO SG1034.2 +048000 ADD 1 TO ENT-COUNTER SG1034.2 +048100 GO TO PARA-7A. SG1034.2 +048200 GO TO PARA-7B. SG1034.2 +048300 P9903. SG1034.2 +048400 MOVE "X" TO GO-TO-IND. SG1034.2 +048500 GO TO PARA-7B. SG1034.2 diff --git a/tests/cobol85/SG/SG104A.CBL b/tests/cobol85/SG/SG104A.CBL new file mode 100755 index 00000000..7414e281 --- /dev/null +++ b/tests/cobol85/SG/SG104A.CBL @@ -0,0 +1,592 @@ +000100 IDENTIFICATION DIVISION. SG1044.2 +000200 PROGRAM-ID. SG1044.2 +000300 SG104A. SG1044.2 +000400 AUTHOR. SG1044.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1044.2 +000600 INSTALLATION. SG1044.2 +000700 GENERAL SERVICES ADMINISTRATION SG1044.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1044.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1044.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1044.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1044.2 +001200 SG1044.2 +001300 PHONE (703) 756-6153 SG1044.2 +001400 SG1044.2 +001500 " HIGH ". SG1044.2 +001600 DATE-WRITTEN. SG1044.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1044.2 +001800 CREATION DATE / VALIDATION DATE SG1044.2 +001900 "4.2 ". SG1044.2 +002000 SECURITY. SG1044.2 +002100 NONE. SG1044.2 +002200 SG104A IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT SG1044.2 +002300 PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE SG1044.2 +002400 OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE SG1044.2 +002500 REPORT. SG1044.2 +002600 SORT SORT SORT SORT SORT SORT SORT SORT SG1044.2 +002700 KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8SG1044.2 +002800 S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 SG1044.2 +002900 USAGE JUST JUST USAGESG1044.2 +003000 COMP RIGHT RIGHT COMP SG1044.2 +003100 SG1044.2 +003200 +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 SG1044.2 +003300 -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 SG1044.2 +003400 -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 SG1044.2 +003500 -054321 BBB -.1234 X A AAAAAAAA 501 +99 SG1044.2 +003600 -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 SG1044.2 +003700 -054321 BBB -.1234 BBBBBB A Z 501 +99 SG1044.2 +003800 -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 SG1044.2 +003900 -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 SG1044.2 +004000 SG1044.2 +004100 THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT SG1044.2 +004200 ASCENDING KEYS IN ONE FILE. SG1044.2 +004300 SG1044.2 +004400 ENVIRONMENT DIVISION. SG1044.2 +004500 CONFIGURATION SECTION. SG1044.2 +004600 SOURCE-COMPUTER. SG1044.2 +004700 Linux. SG1044.2 +004800 OBJECT-COMPUTER. SG1044.2 +004900 Linux. SG1044.2 +005000 INPUT-OUTPUT SECTION. SG1044.2 +005100 FILE-CONTROL. SG1044.2 +005200 SELECT PRINT-FILE ASSIGN TO SG1044.2 +005300 "report.log". SG1044.2 +005400 SELECT SORTFILE-1H ASSIGN TO SG1044.2 +005500 "XXXXX027". SG1044.2 +005600 DATA DIVISION. SG1044.2 +005700 FILE SECTION. SG1044.2 +005800 FD PRINT-FILE SG1044.2 +005900 LABEL RECORDS SG1044.2 +006000 OMITTED SG1044.2 +006100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1044.2 +006200 01 PRINT-REC PICTURE X(120). SG1044.2 +006300 01 DUMMY-RECORD PICTURE X(120). SG1044.2 +006400 SD SORTFILE-1H SG1044.2 +006500 DATA RECORD IS SORTFILE-REC. SG1044.2 +006600 01 SORTFILE-REC. SG1044.2 +006700 02 SORTKEY-8 PICTURE S99 COMPUTATIONAL. SG1044.2 +006800 02 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. SG1044.2 +006900 02 SORTKEY-7 PICTURE 999. SG1044.2 +007000 02 SORTKEY-3 PICTURE SV9(16). SG1044.2 +007100 02 FILLER PICTURE XX. SG1044.2 +007200 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. SG1044.2 +007300 02 SORTKEY-6 PICTURE X(10). SG1044.2 +007400 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. SG1044.2 +007500 02 SORTKEY-5 PICTURE A(20). SG1044.2 +007600 02 FILLER PICTURE XXX. SG1044.2 +007700 WORKING-STORAGE SECTION. SG1044.2 +007800 77 UTIL-CTR PICTURE S99999. SG1044.2 +007900 77 SPAC-E PICTURE X VALUE " ". SG1044.2 +008000 01 TEST-RESULTS. SG1044.2 +008100 02 FILLER PICTURE X VALUE SPACE. SG1044.2 +008200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1044.2 +008300 02 FILLER PICTURE X VALUE SPACE. SG1044.2 +008400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1044.2 +008500 02 FILLER PICTURE X VALUE SPACE. SG1044.2 +008600 02 PAR-NAME. SG1044.2 +008700 03 FILLER PICTURE X(12) VALUE SPACE. SG1044.2 +008800 03 PARDOT-X PICTURE X VALUE SPACE. SG1044.2 +008900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1044.2 +009000 03 FILLER PIC X(5) VALUE SPACE. SG1044.2 +009100 02 FILLER PIC X(10) VALUE SPACE. SG1044.2 +009200 02 RE-MARK PIC X(61). SG1044.2 +009300 01 TEST-COMPUTED. SG1044.2 +009400 02 FILLER PIC X(30) VALUE SPACE. SG1044.2 +009500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1044.2 +009600 02 COMPUTED-X. SG1044.2 +009700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1044.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1044.2 +009900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1044.2 +010000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1044.2 +010100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1044.2 +010200 03 CM-18V0 REDEFINES COMPUTED-A. SG1044.2 +010300 04 COMPUTED-18V0 PICTURE -9(18). SG1044.2 +010400 04 FILLER PICTURE X. SG1044.2 +010500 03 FILLER PIC X(50) VALUE SPACE. SG1044.2 +010600 01 TEST-CORRECT. SG1044.2 +010700 02 FILLER PIC X(30) VALUE SPACE. SG1044.2 +010800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1044.2 +010900 02 CORRECT-X. SG1044.2 +011000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1044.2 +011100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1044.2 +011200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1044.2 +011300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1044.2 +011400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1044.2 +011500 03 CR-18V0 REDEFINES CORRECT-A. SG1044.2 +011600 04 CORRECT-18V0 PICTURE -9(18). SG1044.2 +011700 04 FILLER PICTURE X. SG1044.2 +011800 03 FILLER PIC X(50) VALUE SPACE. SG1044.2 +011900 01 CCVS-C-1. SG1044.2 +012000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1044.2 +012100- "SS PARAGRAPH-NAME SG1044.2 +012200- " REMARKS". SG1044.2 +012300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1044.2 +012400 01 CCVS-C-2. SG1044.2 +012500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1044.2 +012600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1044.2 +012700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1044.2 +012800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1044.2 +012900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1044.2 +013000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1044.2 +013100 01 REC-CT PICTURE 99 VALUE ZERO. SG1044.2 +013200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1044.2 +013300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1044.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1044.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1044.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1044.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1044.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1044.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1044.2 +014000 01 CCVS-H-1. SG1044.2 +014100 02 FILLER PICTURE X(27) VALUE SPACE. SG1044.2 +014200 02 FILLER PICTURE X(67) VALUE SG1044.2 +014300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1044.2 +014400- " SYSTEM". SG1044.2 +014500 02 FILLER PICTURE X(26) VALUE SPACE. SG1044.2 +014600 01 CCVS-H-2. SG1044.2 +014700 02 FILLER PICTURE X(52) VALUE IS SG1044.2 +014800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1044.2 +014900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1044.2 +015000 02 TEST-ID PICTURE IS X(9). SG1044.2 +015100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1044.2 +015200 01 CCVS-H-3. SG1044.2 +015300 02 FILLER PICTURE X(34) VALUE SG1044.2 +015400 " FOR OFFICIAL USE ONLY ". SG1044.2 +015500 02 FILLER PICTURE X(58) VALUE SG1044.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1044.2 +015700 02 FILLER PICTURE X(28) VALUE SG1044.2 +015800 " COPYRIGHT 1974 ". SG1044.2 +015900 01 CCVS-E-1. SG1044.2 +016000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1044.2 +016100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1044.2 +016200 02 ID-AGAIN PICTURE IS X(9). SG1044.2 +016300 02 FILLER PICTURE X(45) VALUE IS SG1044.2 +016400 " NTIS DISTRIBUTION COBOL 74". SG1044.2 +016500 01 CCVS-E-2. SG1044.2 +016600 02 FILLER PICTURE X(31) VALUE SG1044.2 +016700 SPACE. SG1044.2 +016800 02 FILLER PICTURE X(21) VALUE SPACE. SG1044.2 +016900 02 CCVS-E-2-2. SG1044.2 +017000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1044.2 +017100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1044.2 +017200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1044.2 +017300 01 CCVS-E-3. SG1044.2 +017400 02 FILLER PICTURE X(22) VALUE SG1044.2 +017500 " FOR OFFICIAL USE ONLY". SG1044.2 +017600 02 FILLER PICTURE X(12) VALUE SPACE. SG1044.2 +017700 02 FILLER PICTURE X(58) VALUE SG1044.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1044.2 +017900 02 FILLER PICTURE X(13) VALUE SPACE. SG1044.2 +018000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1044.2 +018100 01 CCVS-E-4. SG1044.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1044.2 +018300 02 FILLER PIC XXXX VALUE " OF ". SG1044.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1044.2 +018500 02 FILLER PIC X(40) VALUE SG1044.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1044.2 +018700 01 XXINFO. SG1044.2 +018800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1044.2 +018900 02 INFO-TEXT. SG1044.2 +019000 04 FILLER PIC X(20) VALUE SPACE. SG1044.2 +019100 04 XXCOMPUTED PIC X(20). SG1044.2 +019200 04 FILLER PIC X(5) VALUE SPACE. SG1044.2 +019300 04 XXCORRECT PIC X(20). SG1044.2 +019400 01 HYPHEN-LINE. SG1044.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1044.2 +019600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1044.2 +019700- "*****************************************". SG1044.2 +019800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1044.2 +019900- "******************************". SG1044.2 +020000 01 CCVS-PGM-ID PIC X(6) VALUE SG1044.2 +020100 "SG104A". SG1044.2 +020200 PROCEDURE DIVISION. SG1044.2 +020300 SORT-PARA SECTION 69. SG1044.2 +020400 SORT-PARAGRAPH. SG1044.2 +020500 SORT SORTFILE-1H ON SG1044.2 +020600 ASCENDING KEY SORTKEY-1 SG1044.2 +020700 ASCENDING SORTKEY-2 SG1044.2 +020800 ASCENDING SORTKEY-3 SG1044.2 +020900 ASCENDING SORTKEY-4 SG1044.2 +021000 ASCENDING SORTKEY-5 SG1044.2 +021100 ASCENDING SORTKEY-6 SG1044.2 +021200 ASCENDING SORTKEY-7 SG1044.2 +021300 ASCENDING SORTKEY-8 SG1044.2 +021400 INPUT PROCEDURE INPROC SG1044.2 +021500 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. SG1044.2 +021600 STOP RUN. SG1044.2 +021700 INPROC SECTION 69. SG1044.2 +021800 BUILD-FILE. SG1044.2 +021900 PERFORM BUILD-RECORD. SG1044.2 +022000 MOVE +123456 TO SORTKEY-1. SG1044.2 +022100 PERFORM RELEASE-RECORD. SG1044.2 +022200 PERFORM BUILD-RECORD. SG1044.2 +022300 MOVE "X" TO SORTKEY-2. SG1044.2 +022400 PERFORM RELEASE-RECORD. SG1044.2 +022500 PERFORM BUILD-RECORD. SG1044.2 +022600 MOVE +.6 TO SORTKEY-3. SG1044.2 +022700 PERFORM RELEASE-RECORD. SG1044.2 +022800 PERFORM BUILD-RECORD. SG1044.2 +022900 MOVE "X" TO SORTKEY-4. SG1044.2 +023000 PERFORM RELEASE-RECORD. SG1044.2 +023100 PERFORM BUILD-RECORD. SG1044.2 +023200 MOVE "Z" TO SORTKEY-5. SG1044.2 +023300 PERFORM RELEASE-RECORD. SG1044.2 +023400 PERFORM BUILD-RECORD. SG1044.2 +023500 MOVE "Z" TO SORTKEY-6. SG1044.2 +023600 PERFORM RELEASE-RECORD. SG1044.2 +023700 PERFORM BUILD-RECORD. SG1044.2 +023800 MOVE +418 TO SORTKEY-7. SG1044.2 +023900 PERFORM RELEASE-RECORD. SG1044.2 +024000 PERFORM BUILD-RECORD. SG1044.2 +024100 MOVE -14 TO SORTKEY-8. SG1044.2 +024200 PERFORM RELEASE-RECORD. SG1044.2 +024300 GO TO BUILD-EXIT. SG1044.2 +024400 BUILD-RECORD. SG1044.2 +024500 MOVE -054321 TO SORTKEY-1. SG1044.2 +024600 MOVE "BBB" TO SORTKEY-2. SG1044.2 +024700 MOVE -.1234567890123456 TO SORTKEY-3. SG1044.2 +024800 MOVE "BBBBBB" TO SORTKEY-4. SG1044.2 +024900 MOVE "A" TO SORTKEY-5. SG1044.2 +025000 MOVE "AAAAAAAA" TO SORTKEY-6. SG1044.2 +025100 MOVE -501 TO SORTKEY-7. SG1044.2 +025200* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED SG1044.2 +025300* FIELD. SG1044.2 +025400 MOVE +99 TO SORTKEY-8. SG1044.2 +025500 RELEASE-RECORD. SG1044.2 +025600 RELEASE SORTFILE-REC. SG1044.2 +025700 BUILD-EXIT. SG1044.2 +025800 EXIT. SG1044.2 +025900 OUTPROC SECTION 69. SG1044.2 +026000 OPEN-FILES. SG1044.2 +026100 OPEN OUTPUT PRINT-FILE. SG1044.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1044.2 +026300 MOVE SPACE TO TEST-RESULTS. SG1044.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1044.2 +026500 IF SPAC-E IS LESS THAN "B" SG1044.2 +026600 GO TO SPACE-IS-LESS-THAN-B. SG1044.2 +026700 B-IS-LESS-THAN-SPACE SECTION 69. SG1044.2 +026800 SORT-INIT-A. SG1044.2 +026900 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1044.2 +027000* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1044.2 +027100* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, SG1044.2 +027200* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, SG1044.2 +027300* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. SG1044.2 +027400 SORT-TEST-1. SG1044.2 +027500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +027600 IF SORTKEY-7 EQUAL TO 418 SG1044.2 +027700 PERFORM PASS GO TO SORT-WRITE-1. SG1044.2 +027800 SORT-FAIL-1. SG1044.2 +027900 PERFORM FAIL. SG1044.2 +028000 MOVE SORTKEY-7 TO COMPUTED-N. SG1044.2 +028100 MOVE 418 TO CORRECT-N. SG1044.2 +028200 SORT-WRITE-1. SG1044.2 +028300 MOVE "SORT-TEST-1 " TO PAR-NAME. SG1044.2 +028400 PERFORM PRINT-DETAIL. SG1044.2 +028500 SORT-TEST-2. SG1044.2 +028600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +028700 IF SORTKEY-8 EQUAL TO -14 SG1044.2 +028800 PERFORM PASS GO TO SORT-WRITE-2. SG1044.2 +028900 SORT-FAIL-2. SG1044.2 +029000 PERFORM FAIL. SG1044.2 +029100 MOVE SORTKEY-8 TO COMPUTED-N. SG1044.2 +029200 MOVE -14 TO CORRECT-N. SG1044.2 +029300 SORT-WRITE-2. SG1044.2 +029400 MOVE "SORT-TEST-2 " TO PAR-NAME. SG1044.2 +029500 PERFORM PRINT-DETAIL. SG1044.2 +029600 SORT-TEST-3. SG1044.2 +029700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +029800 IF SORTKEY-6 EQUAL TO "Z " SG1044.2 +029900 PERFORM PASS GO TO SORT-WRITE-3. SG1044.2 +030000 SORT-FAIL-3. SG1044.2 +030100 PERFORM FAIL. SG1044.2 +030200 MOVE SORTKEY-6 TO COMPUTED-A. SG1044.2 +030300 MOVE "Z " TO CORRECT-A. SG1044.2 +030400 SORT-WRITE-3. SG1044.2 +030500 MOVE "SORT-TEST-3 " TO PAR-NAME. SG1044.2 +030600 PERFORM PRINT-DETAIL. SG1044.2 +030700 SORT-TEST-4. SG1044.2 +030800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +030900 IF SORTKEY-5 EQUAL TO "Z " SG1044.2 +031000 PERFORM PASS GO TO SORT-WRITE-4. SG1044.2 +031100 SORT-FAIL-4. SG1044.2 +031200 PERFORM FAIL. SG1044.2 +031300 MOVE SORTKEY-5 TO COMPUTED-A. SG1044.2 +031400 MOVE "Z " TO CORRECT-A. SG1044.2 +031500 SORT-WRITE-4. SG1044.2 +031600 MOVE "SORT-TEST-4 " TO PAR-NAME. SG1044.2 +031700 PERFORM PRINT-DETAIL. SG1044.2 +031800 SORT-TEST-5. SG1044.2 +031900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +032000 IF SORTKEY-4 EQUAL TO " X" SG1044.2 +032100 PERFORM PASS GO TO SORT-WRITE-5. SG1044.2 +032200 SORT-FAIL-5. SG1044.2 +032300 PERFORM FAIL. SG1044.2 +032400 MOVE SORTKEY-4 TO COMPUTED-A. SG1044.2 +032500 MOVE " X" TO CORRECT-A. SG1044.2 +032600 SORT-WRITE-5. SG1044.2 +032700 MOVE "SORT-TEST-5 " TO PAR-NAME. SG1044.2 +032800 PERFORM PRINT-DETAIL. SG1044.2 +032900 SORT-TEST-6. SG1044.2 +033000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +033100 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1044.2 +033200 PERFORM PASS GO TO SORT-WRITE-6. SG1044.2 +033300 SORT-FAIL-6. SG1044.2 +033400 PERFORM FAIL. SG1044.2 +033500 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1044.2 +033600 MOVE +.6000000000000000 TO CORRECT-0V18. SG1044.2 +033700 SORT-WRITE-6. SG1044.2 +033800 MOVE "SORT-TEST-6 " TO PAR-NAME. SG1044.2 +033900 PERFORM PRINT-DETAIL. SG1044.2 +034000 SORT-TEST-7. SG1044.2 +034100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +034200 IF SORTKEY-2 EQUAL TO " X" SG1044.2 +034300 PERFORM PASS GO TO SORT-WRITE-7. SG1044.2 +034400 SORT-FAIL-7. SG1044.2 +034500 PERFORM FAIL. SG1044.2 +034600 MOVE SORTKEY-2 TO COMPUTED-A. SG1044.2 +034700 MOVE " X" TO CORRECT-A. SG1044.2 +034800 SORT-WRITE-7. SG1044.2 +034900 MOVE "SORT-TEST-7 " TO PAR-NAME. SG1044.2 +035000 PERFORM PRINT-DETAIL. SG1044.2 +035100 SORT-TEST-8. SG1044.2 +035200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +035300 IF SORTKEY-1 EQUAL TO +123456 SG1044.2 +035400 PERFORM PASS GO TO SORT-WRITE-8. SG1044.2 +035500 SORT-FAIL-8. SG1044.2 +035600 PERFORM FAIL. SG1044.2 +035700 MOVE SORTKEY-1 TO COMPUTED-N. SG1044.2 +035800 MOVE +123456 TO CORRECT-N. SG1044.2 +035900 SORT-WRITE-8. SG1044.2 +036000 MOVE "SORT-TEST-8 " TO PAR-NAME. SG1044.2 +036100 PERFORM PRINT-DETAIL. SG1044.2 +036200 SORT-REMARK-A. SG1044.2 +036300 MOVE SPACE TO FEATURE. SG1044.2 +036400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1044.2 +036500 PERFORM PRINT-DETAIL. SG1044.2 +036600 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. SG1044.2 +036700 PERFORM PRINT-DETAIL. SG1044.2 +036800 MOVE "UNNECESSARY." TO RE-MARK. SG1044.2 +036900 PERFORM PRINT-DETAIL. SG1044.2 +037000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1044.2 +037100 GO TO CONTINUE-TESTING. SG1044.2 +037200 SPACE-IS-LESS-THAN-B SECTION 69. SG1044.2 +037300 SORT-REMARK-B. SG1044.2 +037400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1044.2 +037500 PERFORM PRINT-DETAIL. SG1044.2 +037600 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. SG1044.2 +037700 PERFORM PRINT-DETAIL. SG1044.2 +037800 MOVE "UNNECESSARY." TO RE-MARK. SG1044.2 +037900 PERFORM PRINT-DETAIL. SG1044.2 +038000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1044.2 +038100* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1044.2 +038200* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, SG1044.2 +038300* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, SG1044.2 +038400* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. SG1044.2 +038500 SORT-TEST-9. SG1044.2 +038600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +038700 IF SORTKEY-2 EQUAL TO " X" SG1044.2 +038800 PERFORM PASS GO TO SORT-WRITE-9. SG1044.2 +038900 SORT-FAIL-9. SG1044.2 +039000 PERFORM FAIL. SG1044.2 +039100 MOVE SORTKEY-2 TO COMPUTED-A. SG1044.2 +039200 MOVE " X" TO CORRECT-A. SG1044.2 +039300 SORT-WRITE-9. SG1044.2 +039400 MOVE "SORT-TEST-9 " TO PAR-NAME. SG1044.2 +039500 PERFORM PRINT-DETAIL. SG1044.2 +039600 SORT-TEST-10. SG1044.2 +039700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +039800 IF SORTKEY-4 EQUAL TO " X" SG1044.2 +039900 PERFORM PASS GO TO SORT-WRITE-10. SG1044.2 +040000 SORT-FAIL-10. SG1044.2 +040100 PERFORM FAIL. SG1044.2 +040200 MOVE SORTKEY-4 TO COMPUTED-A. SG1044.2 +040300 MOVE " X" TO CORRECT-A. SG1044.2 +040400 SORT-WRITE-10. SG1044.2 +040500 MOVE "SORT-TEST-10" TO PAR-NAME. SG1044.2 +040600 PERFORM PRINT-DETAIL. SG1044.2 +040700 SORT-TEST-11. SG1044.2 +040800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +040900 IF SORTKEY-7 EQUAL TO 418 SG1044.2 +041000 PERFORM PASS GO TO SORT-WRITE-11. SG1044.2 +041100 SORT-FAIL-11. SG1044.2 +041200 PERFORM FAIL. SG1044.2 +041300 MOVE SORTKEY-7 TO COMPUTED-N SG1044.2 +041400 MOVE 418 TO CORRECT-N. SG1044.2 +041500 SORT-WRITE-11. SG1044.2 +041600 MOVE "SORT-TEST-11" TO PAR-NAME. SG1044.2 +041700 PERFORM PRINT-DETAIL. SG1044.2 +041800 SORT-TEST-12. SG1044.2 +041900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +042000 IF SORTKEY-8 EQUAL TO -14 SG1044.2 +042100 PERFORM PASS GO TO SORT-WRITE-12. SG1044.2 +042200 SORT-FAIL-12. SG1044.2 +042300 PERFORM FAIL. SG1044.2 +042400 MOVE SORTKEY-8 TO COMPUTED-N. SG1044.2 +042500 MOVE -14 TO CORRECT-N. SG1044.2 +042600 SORT-WRITE-12. SG1044.2 +042700 MOVE "SORT-TEST-12" TO PAR-NAME. SG1044.2 +042800 PERFORM PRINT-DETAIL. SG1044.2 +042900 SORT-TEST-13. SG1044.2 +043000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +043100 IF SORTKEY-6 EQUAL TO "Z " SG1044.2 +043200 PERFORM PASS GO TO SORT-WRITE-13. SG1044.2 +043300 SORT-FAIL-13. SG1044.2 +043400 PERFORM FAIL. SG1044.2 +043500 MOVE SORTKEY-6 TO COMPUTED-A. SG1044.2 +043600 MOVE "Z " TO CORRECT-A. SG1044.2 +043700 SORT-WRITE-13. SG1044.2 +043800 MOVE "SORT-TEST-13" TO PAR-NAME. SG1044.2 +043900 PERFORM PRINT-DETAIL. SG1044.2 +044000 SORT-TEST-14. SG1044.2 +044100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +044200 IF SORTKEY-5 EQUAL TO "Z " SG1044.2 +044300 PERFORM PASS GO TO SORT-WRITE-14. SG1044.2 +044400 SORT-FAIL-14. SG1044.2 +044500 PERFORM FAIL. SG1044.2 +044600 MOVE SORTKEY-5 TO COMPUTED-A. SG1044.2 +044700 MOVE "Z " TO CORRECT-A. SG1044.2 +044800 SORT-WRITE-14. SG1044.2 +044900 MOVE "SORT-TEST-14" TO PAR-NAME. SG1044.2 +045000 PERFORM PRINT-DETAIL. SG1044.2 +045100 SORT-TEST-15. SG1044.2 +045200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +045300 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1044.2 +045400 PERFORM PASS GO TO SORT-WRITE-15. SG1044.2 +045500 SORT-FAIL-15. SG1044.2 +045600 PERFORM FAIL. SG1044.2 +045700 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1044.2 +045800 MOVE +.6000000000000000 TO CORRECT-0V18. SG1044.2 +045900 SORT-WRITE-15. SG1044.2 +046000 MOVE "SORT-TEST-15" TO PAR-NAME. SG1044.2 +046100 PERFORM PRINT-DETAIL. SG1044.2 +046200 SORT-TEST-16. SG1044.2 +046300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1044.2 +046400 IF SORTKEY-1 EQUAL TO +123456 SG1044.2 +046500 PERFORM PASS GO TO SORT-WRITE-16. SG1044.2 +046600 SORT-FAIL-16. SG1044.2 +046700 PERFORM FAIL. SG1044.2 +046800 MOVE SORTKEY-1 TO COMPUTED-N. SG1044.2 +046900 MOVE +123456 TO CORRECT-N. SG1044.2 +047000 SORT-WRITE-16. SG1044.2 +047100 MOVE "SORT-TEST-16" TO PAR-NAME. SG1044.2 +047200 PERFORM PRINT-DETAIL. SG1044.2 +047300 CONTINUE-TESTING SECTION 69. SG1044.2 +047400 SORT-TEST-17. SG1044.2 +047500 RETURN SORTFILE-1H AT END SG1044.2 +047600 PERFORM PASS GO TO SORT-WRITE-17. SG1044.2 +047700 SORT-FAIL-17. SG1044.2 +047800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SG1044.2 +047900 PERFORM FAIL. SG1044.2 +048000 SORT-WRITE-17. SG1044.2 +048100 MOVE "SORT-TEST-17" TO PAR-NAME. SG1044.2 +048200 PERFORM PRINT-DETAIL. SG1044.2 +048300 GO TO OUTPROC-EXIT. SG1044.2 +048400 RETURN-ERROR. SG1044.2 +048500 MOVE "RETURN-ERROR" TO PAR-NAME. SG1044.2 +048600 PERFORM FAIL. SG1044.2 +048700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SG1044.2 +048800 PERFORM PRINT-DETAIL. SG1044.2 +048900 GO TO CCVS1-EXIT. SG1044.2 +049000 CLOSE-FILES. SG1044.2 +049100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1044.2 +049200 TERMINATE-CCVS. SG1044.2 +049300*S EXIT PROGRAM. SG1044.2 +049400*SERMINATE-CALL. SG1044.2 +049500 STOP RUN. SG1044.2 +049600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1044.2 +049700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1044.2 +049800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1044.2 +049900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1044.2 +050000 MOVE "****TEST DELETED****" TO RE-MARK. SG1044.2 +050100 PRINT-DETAIL. SG1044.2 +050200 IF REC-CT NOT EQUAL TO ZERO SG1044.2 +050300 MOVE "." TO PARDOT-X SG1044.2 +050400 MOVE REC-CT TO DOTVALUE. SG1044.2 +050500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1044.2 +050600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1044.2 +050700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1044.2 +050800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1044.2 +050900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1044.2 +051000 MOVE SPACE TO CORRECT-X. SG1044.2 +051100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1044.2 +051200 MOVE SPACE TO RE-MARK. SG1044.2 +051300 HEAD-ROUTINE. SG1044.2 +051400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +051500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1044.2 +051600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1044.2 +051700 COLUMN-NAMES-ROUTINE. SG1044.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +052100 END-ROUTINE. SG1044.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1044.2 +052300 END-RTN-EXIT. SG1044.2 +052400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +052500 END-ROUTINE-1. SG1044.2 +052600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1044.2 +052700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1044.2 +052800 ADD PASS-COUNTER TO ERROR-HOLD. SG1044.2 +052900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1044.2 +053000 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1044.2 +053100 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1044.2 +053200 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1044.2 +053300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1044.2 +053400 END-ROUTINE-12. SG1044.2 +053500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1044.2 +053600 IF ERROR-COUNTER IS EQUAL TO ZERO SG1044.2 +053700 MOVE "NO " TO ERROR-TOTAL SG1044.2 +053800 ELSE SG1044.2 +053900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1044.2 +054000 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1044.2 +054100 PERFORM WRITE-LINE. SG1044.2 +054200 END-ROUTINE-13. SG1044.2 +054300 IF DELETE-CNT IS EQUAL TO ZERO SG1044.2 +054400 MOVE "NO " TO ERROR-TOTAL ELSE SG1044.2 +054500 MOVE DELETE-CNT TO ERROR-TOTAL. SG1044.2 +054600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1044.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +054800 IF INSPECT-COUNTER EQUAL TO ZERO SG1044.2 +054900 MOVE "NO " TO ERROR-TOTAL SG1044.2 +055000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1044.2 +055100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1044.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +055300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1044.2 +055400 WRITE-LINE. SG1044.2 +055500 ADD 1 TO RECORD-COUNT. SG1044.2 +055600 IF RECORD-COUNT GREATER 50 SG1044.2 +055700 MOVE DUMMY-RECORD TO DUMMY-HOLD SG1044.2 +055800 MOVE SPACE TO DUMMY-RECORD SG1044.2 +055900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1044.2 +056000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1044.2 +056100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1044.2 +056200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1044.2 +056300 MOVE DUMMY-HOLD TO DUMMY-RECORD SG1044.2 +056400 MOVE ZERO TO RECORD-COUNT. SG1044.2 +056500 PERFORM WRT-LN. SG1044.2 +056600 WRT-LN. SG1044.2 +056700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1044.2 +056800 MOVE SPACE TO DUMMY-RECORD. SG1044.2 +056900 BLANK-LINE-PRINT. SG1044.2 +057000 PERFORM WRT-LN. SG1044.2 +057100 FAIL-ROUTINE. SG1044.2 +057200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1044.2 +057300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1044.2 +057400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1044.2 +057500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +057600 GO TO FAIL-ROUTINE-EX. SG1044.2 +057700 FAIL-ROUTINE-WRITE. SG1044.2 +057800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1044.2 +057900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1044.2 +058000 FAIL-ROUTINE-EX. EXIT. SG1044.2 +058100 BAIL-OUT. SG1044.2 +058200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1044.2 +058300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1044.2 +058400 BAIL-OUT-WRITE. SG1044.2 +058500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1044.2 +058600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1044.2 +058700 BAIL-OUT-EX. EXIT. SG1044.2 +058800 CCVS1-EXIT. SG1044.2 +058900 EXIT. SG1044.2 +059000 OUTPROC-EXIT SECTION 69. SG1044.2 +059100 EXIT-ONLY. SG1044.2 +059200 PERFORM CLOSE-FILES. SG1044.2 diff --git a/tests/cobol85/SG/SG105A.CBL b/tests/cobol85/SG/SG105A.CBL new file mode 100755 index 00000000..830a784d --- /dev/null +++ b/tests/cobol85/SG/SG105A.CBL @@ -0,0 +1,592 @@ +000100 IDENTIFICATION DIVISION. SG1054.2 +000200 PROGRAM-ID. SG1054.2 +000300 SG105A. SG1054.2 +000400 AUTHOR. SG1054.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1054.2 +000600 INSTALLATION. SG1054.2 +000700 GENERAL SERVICES ADMINISTRATION SG1054.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1054.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1054.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1054.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1054.2 +001200 SG1054.2 +001300 PHONE (703) 756-6153 SG1054.2 +001400 SG1054.2 +001500 " HIGH ". SG1054.2 +001600 DATE-WRITTEN. SG1054.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1054.2 +001800 CREATION DATE / VALIDATION DATE SG1054.2 +001900 "4.2 ". SG1054.2 +002000 SECURITY. SG1054.2 +002100 NONE. SG1054.2 +002200 SG105A IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT SG1054.2 +002300 PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE SG1054.2 +002400 OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE SG1054.2 +002500 REPORT. SG1054.2 +002600 SORT SORT SORT SORT SORT SORT SORT SORT SG1054.2 +002700 KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8SG1054.2 +002800 S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 SG1054.2 +002900 USAGE JUST JUST USAGESG1054.2 +003000 COMP RIGHT RIGHT COMP SG1054.2 +003100 SG1054.2 +003200 +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 SG1054.2 +003300 -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 SG1054.2 +003400 -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 SG1054.2 +003500 -054321 BBB -.1234 X A AAAAAAAA 501 +99 SG1054.2 +003600 -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 SG1054.2 +003700 -054321 BBB -.1234 BBBBBB A Z 501 +99 SG1054.2 +003800 -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 SG1054.2 +003900 -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 SG1054.2 +004000 SG1054.2 +004100 THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT SG1054.2 +004200 ASCENDING KEYS IN ONE FILE. SG1054.2 +004300 SG1054.2 +004400 ENVIRONMENT DIVISION. SG1054.2 +004500 CONFIGURATION SECTION. SG1054.2 +004600 SOURCE-COMPUTER. SG1054.2 +004700 Linux. SG1054.2 +004800 OBJECT-COMPUTER. SG1054.2 +004900 Linux. SG1054.2 +005000 INPUT-OUTPUT SECTION. SG1054.2 +005100 FILE-CONTROL. SG1054.2 +005200 SELECT PRINT-FILE ASSIGN TO SG1054.2 +005300 "report.log". SG1054.2 +005400 SELECT SORTFILE-1H ASSIGN TO SG1054.2 +005500 "XXXXX027". SG1054.2 +005600 DATA DIVISION. SG1054.2 +005700 FILE SECTION. SG1054.2 +005800 FD PRINT-FILE SG1054.2 +005900 LABEL RECORDS SG1054.2 +006000 OMITTED SG1054.2 +006100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1054.2 +006200 01 PRINT-REC PICTURE X(120). SG1054.2 +006300 01 DUMMY-RECORD PICTURE X(120). SG1054.2 +006400 SD SORTFILE-1H SG1054.2 +006500 DATA RECORD IS SORTFILE-REC. SG1054.2 +006600 01 SORTFILE-REC. SG1054.2 +006700 02 SORTKEY-8 PICTURE S99 COMPUTATIONAL. SG1054.2 +006800 02 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. SG1054.2 +006900 02 SORTKEY-7 PICTURE 999. SG1054.2 +007000 02 SORTKEY-3 PICTURE SV9(16). SG1054.2 +007100 02 FILLER PICTURE XX. SG1054.2 +007200 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. SG1054.2 +007300 02 SORTKEY-6 PICTURE X(10). SG1054.2 +007400 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. SG1054.2 +007500 02 SORTKEY-5 PICTURE A(20). SG1054.2 +007600 02 FILLER PICTURE XXX. SG1054.2 +007700 WORKING-STORAGE SECTION. SG1054.2 +007800 77 UTIL-CTR PICTURE S99999. SG1054.2 +007900 77 SPAC-E PICTURE X VALUE " ". SG1054.2 +008000 01 TEST-RESULTS. SG1054.2 +008100 02 FILLER PICTURE X VALUE SPACE. SG1054.2 +008200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1054.2 +008300 02 FILLER PICTURE X VALUE SPACE. SG1054.2 +008400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1054.2 +008500 02 FILLER PICTURE X VALUE SPACE. SG1054.2 +008600 02 PAR-NAME. SG1054.2 +008700 03 FILLER PICTURE X(12) VALUE SPACE. SG1054.2 +008800 03 PARDOT-X PICTURE X VALUE SPACE. SG1054.2 +008900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1054.2 +009000 03 FILLER PIC X(5) VALUE SPACE. SG1054.2 +009100 02 FILLER PIC X(10) VALUE SPACE. SG1054.2 +009200 02 RE-MARK PIC X(61). SG1054.2 +009300 01 TEST-COMPUTED. SG1054.2 +009400 02 FILLER PIC X(30) VALUE SPACE. SG1054.2 +009500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1054.2 +009600 02 COMPUTED-X. SG1054.2 +009700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1054.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1054.2 +009900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1054.2 +010000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1054.2 +010100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1054.2 +010200 03 CM-18V0 REDEFINES COMPUTED-A. SG1054.2 +010300 04 COMPUTED-18V0 PICTURE -9(18). SG1054.2 +010400 04 FILLER PICTURE X. SG1054.2 +010500 03 FILLER PIC X(50) VALUE SPACE. SG1054.2 +010600 01 TEST-CORRECT. SG1054.2 +010700 02 FILLER PIC X(30) VALUE SPACE. SG1054.2 +010800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1054.2 +010900 02 CORRECT-X. SG1054.2 +011000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1054.2 +011100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1054.2 +011200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1054.2 +011300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1054.2 +011400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1054.2 +011500 03 CR-18V0 REDEFINES CORRECT-A. SG1054.2 +011600 04 CORRECT-18V0 PICTURE -9(18). SG1054.2 +011700 04 FILLER PICTURE X. SG1054.2 +011800 03 FILLER PIC X(50) VALUE SPACE. SG1054.2 +011900 01 CCVS-C-1. SG1054.2 +012000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1054.2 +012100- "SS PARAGRAPH-NAME SG1054.2 +012200- " REMARKS". SG1054.2 +012300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1054.2 +012400 01 CCVS-C-2. SG1054.2 +012500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1054.2 +012600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1054.2 +012700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1054.2 +012800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1054.2 +012900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1054.2 +013000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1054.2 +013100 01 REC-CT PICTURE 99 VALUE ZERO. SG1054.2 +013200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1054.2 +013300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1054.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1054.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1054.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1054.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1054.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1054.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1054.2 +014000 01 CCVS-H-1. SG1054.2 +014100 02 FILLER PICTURE X(27) VALUE SPACE. SG1054.2 +014200 02 FILLER PICTURE X(67) VALUE SG1054.2 +014300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1054.2 +014400- " SYSTEM". SG1054.2 +014500 02 FILLER PICTURE X(26) VALUE SPACE. SG1054.2 +014600 01 CCVS-H-2. SG1054.2 +014700 02 FILLER PICTURE X(52) VALUE IS SG1054.2 +014800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1054.2 +014900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1054.2 +015000 02 TEST-ID PICTURE IS X(9). SG1054.2 +015100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1054.2 +015200 01 CCVS-H-3. SG1054.2 +015300 02 FILLER PICTURE X(34) VALUE SG1054.2 +015400 " FOR OFFICIAL USE ONLY ". SG1054.2 +015500 02 FILLER PICTURE X(58) VALUE SG1054.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1054.2 +015700 02 FILLER PICTURE X(28) VALUE SG1054.2 +015800 " COPYRIGHT 1974 ". SG1054.2 +015900 01 CCVS-E-1. SG1054.2 +016000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1054.2 +016100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1054.2 +016200 02 ID-AGAIN PICTURE IS X(9). SG1054.2 +016300 02 FILLER PICTURE X(45) VALUE IS SG1054.2 +016400 " NTIS DISTRIBUTION COBOL 74". SG1054.2 +016500 01 CCVS-E-2. SG1054.2 +016600 02 FILLER PICTURE X(31) VALUE SG1054.2 +016700 SPACE. SG1054.2 +016800 02 FILLER PICTURE X(21) VALUE SPACE. SG1054.2 +016900 02 CCVS-E-2-2. SG1054.2 +017000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1054.2 +017100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1054.2 +017200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1054.2 +017300 01 CCVS-E-3. SG1054.2 +017400 02 FILLER PICTURE X(22) VALUE SG1054.2 +017500 " FOR OFFICIAL USE ONLY". SG1054.2 +017600 02 FILLER PICTURE X(12) VALUE SPACE. SG1054.2 +017700 02 FILLER PICTURE X(58) VALUE SG1054.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1054.2 +017900 02 FILLER PICTURE X(13) VALUE SPACE. SG1054.2 +018000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1054.2 +018100 01 CCVS-E-4. SG1054.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1054.2 +018300 02 FILLER PIC XXXX VALUE " OF ". SG1054.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1054.2 +018500 02 FILLER PIC X(40) VALUE SG1054.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1054.2 +018700 01 XXINFO. SG1054.2 +018800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1054.2 +018900 02 INFO-TEXT. SG1054.2 +019000 04 FILLER PIC X(20) VALUE SPACE. SG1054.2 +019100 04 XXCOMPUTED PIC X(20). SG1054.2 +019200 04 FILLER PIC X(5) VALUE SPACE. SG1054.2 +019300 04 XXCORRECT PIC X(20). SG1054.2 +019400 01 HYPHEN-LINE. SG1054.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1054.2 +019600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1054.2 +019700- "*****************************************". SG1054.2 +019800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1054.2 +019900- "******************************". SG1054.2 +020000 01 CCVS-PGM-ID PIC X(6) VALUE SG1054.2 +020100 "SG105A". SG1054.2 +020200 PROCEDURE DIVISION. SG1054.2 +020300 SORT-PARA SECTION 73. SG1054.2 +020400 SORT-PARAGRAPH. SG1054.2 +020500 SORT SORTFILE-1H ON SG1054.2 +020600 ASCENDING KEY SORTKEY-1 SG1054.2 +020700 ASCENDING SORTKEY-2 SG1054.2 +020800 ASCENDING SORTKEY-3 SG1054.2 +020900 ASCENDING SORTKEY-4 SG1054.2 +021000 ASCENDING SORTKEY-5 SG1054.2 +021100 ASCENDING SORTKEY-6 SG1054.2 +021200 ASCENDING SORTKEY-7 SG1054.2 +021300 ASCENDING SORTKEY-8 SG1054.2 +021400 INPUT PROCEDURE INPROC SG1054.2 +021500 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. SG1054.2 +021600 STOP RUN. SG1054.2 +021700 INPROC SECTION 20. SG1054.2 +021800 BUILD-FILE. SG1054.2 +021900 PERFORM BUILD-RECORD. SG1054.2 +022000 MOVE +123456 TO SORTKEY-1. SG1054.2 +022100 PERFORM RELEASE-RECORD. SG1054.2 +022200 PERFORM BUILD-RECORD. SG1054.2 +022300 MOVE "X" TO SORTKEY-2. SG1054.2 +022400 PERFORM RELEASE-RECORD. SG1054.2 +022500 PERFORM BUILD-RECORD. SG1054.2 +022600 MOVE +.6 TO SORTKEY-3. SG1054.2 +022700 PERFORM RELEASE-RECORD. SG1054.2 +022800 PERFORM BUILD-RECORD. SG1054.2 +022900 MOVE "X" TO SORTKEY-4. SG1054.2 +023000 PERFORM RELEASE-RECORD. SG1054.2 +023100 PERFORM BUILD-RECORD. SG1054.2 +023200 MOVE "Z" TO SORTKEY-5. SG1054.2 +023300 PERFORM RELEASE-RECORD. SG1054.2 +023400 PERFORM BUILD-RECORD. SG1054.2 +023500 MOVE "Z" TO SORTKEY-6. SG1054.2 +023600 PERFORM RELEASE-RECORD. SG1054.2 +023700 PERFORM BUILD-RECORD. SG1054.2 +023800 MOVE +418 TO SORTKEY-7. SG1054.2 +023900 PERFORM RELEASE-RECORD. SG1054.2 +024000 PERFORM BUILD-RECORD. SG1054.2 +024100 MOVE -14 TO SORTKEY-8. SG1054.2 +024200 PERFORM RELEASE-RECORD. SG1054.2 +024300 GO TO BUILD-EXIT. SG1054.2 +024400 BUILD-RECORD. SG1054.2 +024500 MOVE -054321 TO SORTKEY-1. SG1054.2 +024600 MOVE "BBB" TO SORTKEY-2. SG1054.2 +024700 MOVE -.1234567890123456 TO SORTKEY-3. SG1054.2 +024800 MOVE "BBBBBB" TO SORTKEY-4. SG1054.2 +024900 MOVE "A" TO SORTKEY-5. SG1054.2 +025000 MOVE "AAAAAAAA" TO SORTKEY-6. SG1054.2 +025100 MOVE -501 TO SORTKEY-7. SG1054.2 +025200* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED SG1054.2 +025300* FIELD. SG1054.2 +025400 MOVE +99 TO SORTKEY-8. SG1054.2 +025500 RELEASE-RECORD. SG1054.2 +025600 RELEASE SORTFILE-REC. SG1054.2 +025700 BUILD-EXIT. SG1054.2 +025800 EXIT. SG1054.2 +025900 OUTPROC SECTION 00. SG1054.2 +026000 OPEN-FILES. SG1054.2 +026100 OPEN OUTPUT PRINT-FILE. SG1054.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1054.2 +026300 MOVE SPACE TO TEST-RESULTS. SG1054.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1054.2 +026500 IF SPAC-E IS LESS THAN "B" SG1054.2 +026600 GO TO SPACE-IS-LESS-THAN-B. SG1054.2 +026700 B-IS-LESS-THAN-SPACE SECTION 00. SG1054.2 +026800 SORT-INIT-A. SG1054.2 +026900 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1054.2 +027000* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1054.2 +027100* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, SG1054.2 +027200* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, SG1054.2 +027300* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. SG1054.2 +027400 SORT-TEST-1. SG1054.2 +027500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +027600 IF SORTKEY-7 EQUAL TO 418 SG1054.2 +027700 PERFORM PASS GO TO SORT-WRITE-1. SG1054.2 +027800 SORT-FAIL-1. SG1054.2 +027900 PERFORM FAIL. SG1054.2 +028000 MOVE SORTKEY-7 TO COMPUTED-N. SG1054.2 +028100 MOVE 418 TO CORRECT-N. SG1054.2 +028200 SORT-WRITE-1. SG1054.2 +028300 MOVE "SORT-TEST-1 " TO PAR-NAME. SG1054.2 +028400 PERFORM PRINT-DETAIL. SG1054.2 +028500 SORT-TEST-2. SG1054.2 +028600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +028700 IF SORTKEY-8 EQUAL TO -14 SG1054.2 +028800 PERFORM PASS GO TO SORT-WRITE-2. SG1054.2 +028900 SORT-FAIL-2. SG1054.2 +029000 PERFORM FAIL. SG1054.2 +029100 MOVE SORTKEY-8 TO COMPUTED-N. SG1054.2 +029200 MOVE -14 TO CORRECT-N. SG1054.2 +029300 SORT-WRITE-2. SG1054.2 +029400 MOVE "SORT-TEST-2 " TO PAR-NAME. SG1054.2 +029500 PERFORM PRINT-DETAIL. SG1054.2 +029600 SORT-TEST-3. SG1054.2 +029700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +029800 IF SORTKEY-6 EQUAL TO "Z " SG1054.2 +029900 PERFORM PASS GO TO SORT-WRITE-3. SG1054.2 +030000 SORT-FAIL-3. SG1054.2 +030100 PERFORM FAIL. SG1054.2 +030200 MOVE SORTKEY-6 TO COMPUTED-A. SG1054.2 +030300 MOVE "Z " TO CORRECT-A. SG1054.2 +030400 SORT-WRITE-3. SG1054.2 +030500 MOVE "SORT-TEST-3 " TO PAR-NAME. SG1054.2 +030600 PERFORM PRINT-DETAIL. SG1054.2 +030700 SORT-TEST-4. SG1054.2 +030800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +030900 IF SORTKEY-5 EQUAL TO "Z " SG1054.2 +031000 PERFORM PASS GO TO SORT-WRITE-4. SG1054.2 +031100 SORT-FAIL-4. SG1054.2 +031200 PERFORM FAIL. SG1054.2 +031300 MOVE SORTKEY-5 TO COMPUTED-A. SG1054.2 +031400 MOVE "Z " TO CORRECT-A. SG1054.2 +031500 SORT-WRITE-4. SG1054.2 +031600 MOVE "SORT-TEST-4 " TO PAR-NAME. SG1054.2 +031700 PERFORM PRINT-DETAIL. SG1054.2 +031800 SORT-TEST-5. SG1054.2 +031900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +032000 IF SORTKEY-4 EQUAL TO " X" SG1054.2 +032100 PERFORM PASS GO TO SORT-WRITE-5. SG1054.2 +032200 SORT-FAIL-5. SG1054.2 +032300 PERFORM FAIL. SG1054.2 +032400 MOVE SORTKEY-4 TO COMPUTED-A. SG1054.2 +032500 MOVE " X" TO CORRECT-A. SG1054.2 +032600 SORT-WRITE-5. SG1054.2 +032700 MOVE "SORT-TEST-5 " TO PAR-NAME. SG1054.2 +032800 PERFORM PRINT-DETAIL. SG1054.2 +032900 SORT-TEST-6. SG1054.2 +033000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +033100 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1054.2 +033200 PERFORM PASS GO TO SORT-WRITE-6. SG1054.2 +033300 SORT-FAIL-6. SG1054.2 +033400 PERFORM FAIL. SG1054.2 +033500 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1054.2 +033600 MOVE +.6000000000000000 TO CORRECT-0V18. SG1054.2 +033700 SORT-WRITE-6. SG1054.2 +033800 MOVE "SORT-TEST-6 " TO PAR-NAME. SG1054.2 +033900 PERFORM PRINT-DETAIL. SG1054.2 +034000 SORT-TEST-7. SG1054.2 +034100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +034200 IF SORTKEY-2 EQUAL TO " X" SG1054.2 +034300 PERFORM PASS GO TO SORT-WRITE-7. SG1054.2 +034400 SORT-FAIL-7. SG1054.2 +034500 PERFORM FAIL. SG1054.2 +034600 MOVE SORTKEY-2 TO COMPUTED-A. SG1054.2 +034700 MOVE " X" TO CORRECT-A. SG1054.2 +034800 SORT-WRITE-7. SG1054.2 +034900 MOVE "SORT-TEST-7 " TO PAR-NAME. SG1054.2 +035000 PERFORM PRINT-DETAIL. SG1054.2 +035100 SORT-TEST-8. SG1054.2 +035200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +035300 IF SORTKEY-1 EQUAL TO +123456 SG1054.2 +035400 PERFORM PASS GO TO SORT-WRITE-8. SG1054.2 +035500 SORT-FAIL-8. SG1054.2 +035600 PERFORM FAIL. SG1054.2 +035700 MOVE SORTKEY-1 TO COMPUTED-N. SG1054.2 +035800 MOVE +123456 TO CORRECT-N. SG1054.2 +035900 SORT-WRITE-8. SG1054.2 +036000 MOVE "SORT-TEST-8 " TO PAR-NAME. SG1054.2 +036100 PERFORM PRINT-DETAIL. SG1054.2 +036200 SORT-REMARK-A. SG1054.2 +036300 MOVE SPACE TO FEATURE. SG1054.2 +036400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1054.2 +036500 PERFORM PRINT-DETAIL. SG1054.2 +036600 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. SG1054.2 +036700 PERFORM PRINT-DETAIL. SG1054.2 +036800 MOVE "UNNECESSARY." TO RE-MARK. SG1054.2 +036900 PERFORM PRINT-DETAIL. SG1054.2 +037000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1054.2 +037100 GO TO CONTINUE-TESTING. SG1054.2 +037200 SPACE-IS-LESS-THAN-B SECTION 00. SG1054.2 +037300 SORT-REMARK-B. SG1054.2 +037400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1054.2 +037500 PERFORM PRINT-DETAIL. SG1054.2 +037600 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. SG1054.2 +037700 PERFORM PRINT-DETAIL. SG1054.2 +037800 MOVE "UNNECESSARY." TO RE-MARK. SG1054.2 +037900 PERFORM PRINT-DETAIL. SG1054.2 +038000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1054.2 +038100* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1054.2 +038200* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, SG1054.2 +038300* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, SG1054.2 +038400* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. SG1054.2 +038500 SORT-TEST-9. SG1054.2 +038600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +038700 IF SORTKEY-2 EQUAL TO " X" SG1054.2 +038800 PERFORM PASS GO TO SORT-WRITE-9. SG1054.2 +038900 SORT-FAIL-9. SG1054.2 +039000 PERFORM FAIL. SG1054.2 +039100 MOVE SORTKEY-2 TO COMPUTED-A. SG1054.2 +039200 MOVE " X" TO CORRECT-A. SG1054.2 +039300 SORT-WRITE-9. SG1054.2 +039400 MOVE "SORT-TEST-9 " TO PAR-NAME. SG1054.2 +039500 PERFORM PRINT-DETAIL. SG1054.2 +039600 SORT-TEST-10. SG1054.2 +039700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +039800 IF SORTKEY-4 EQUAL TO " X" SG1054.2 +039900 PERFORM PASS GO TO SORT-WRITE-10. SG1054.2 +040000 SORT-FAIL-10. SG1054.2 +040100 PERFORM FAIL. SG1054.2 +040200 MOVE SORTKEY-4 TO COMPUTED-A. SG1054.2 +040300 MOVE " X" TO CORRECT-A. SG1054.2 +040400 SORT-WRITE-10. SG1054.2 +040500 MOVE "SORT-TEST-10" TO PAR-NAME. SG1054.2 +040600 PERFORM PRINT-DETAIL. SG1054.2 +040700 SORT-TEST-11. SG1054.2 +040800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +040900 IF SORTKEY-7 EQUAL TO 418 SG1054.2 +041000 PERFORM PASS GO TO SORT-WRITE-11. SG1054.2 +041100 SORT-FAIL-11. SG1054.2 +041200 PERFORM FAIL. SG1054.2 +041300 MOVE SORTKEY-7 TO COMPUTED-N SG1054.2 +041400 MOVE 418 TO CORRECT-N. SG1054.2 +041500 SORT-WRITE-11. SG1054.2 +041600 MOVE "SORT-TEST-11" TO PAR-NAME. SG1054.2 +041700 PERFORM PRINT-DETAIL. SG1054.2 +041800 SORT-TEST-12. SG1054.2 +041900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +042000 IF SORTKEY-8 EQUAL TO -14 SG1054.2 +042100 PERFORM PASS GO TO SORT-WRITE-12. SG1054.2 +042200 SORT-FAIL-12. SG1054.2 +042300 PERFORM FAIL. SG1054.2 +042400 MOVE SORTKEY-8 TO COMPUTED-N. SG1054.2 +042500 MOVE -14 TO CORRECT-N. SG1054.2 +042600 SORT-WRITE-12. SG1054.2 +042700 MOVE "SORT-TEST-12" TO PAR-NAME. SG1054.2 +042800 PERFORM PRINT-DETAIL. SG1054.2 +042900 SORT-TEST-13. SG1054.2 +043000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +043100 IF SORTKEY-6 EQUAL TO "Z " SG1054.2 +043200 PERFORM PASS GO TO SORT-WRITE-13. SG1054.2 +043300 SORT-FAIL-13. SG1054.2 +043400 PERFORM FAIL. SG1054.2 +043500 MOVE SORTKEY-6 TO COMPUTED-A. SG1054.2 +043600 MOVE "Z " TO CORRECT-A. SG1054.2 +043700 SORT-WRITE-13. SG1054.2 +043800 MOVE "SORT-TEST-13" TO PAR-NAME. SG1054.2 +043900 PERFORM PRINT-DETAIL. SG1054.2 +044000 SORT-TEST-14. SG1054.2 +044100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +044200 IF SORTKEY-5 EQUAL TO "Z " SG1054.2 +044300 PERFORM PASS GO TO SORT-WRITE-14. SG1054.2 +044400 SORT-FAIL-14. SG1054.2 +044500 PERFORM FAIL. SG1054.2 +044600 MOVE SORTKEY-5 TO COMPUTED-A. SG1054.2 +044700 MOVE "Z " TO CORRECT-A. SG1054.2 +044800 SORT-WRITE-14. SG1054.2 +044900 MOVE "SORT-TEST-14" TO PAR-NAME. SG1054.2 +045000 PERFORM PRINT-DETAIL. SG1054.2 +045100 SORT-TEST-15. SG1054.2 +045200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +045300 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1054.2 +045400 PERFORM PASS GO TO SORT-WRITE-15. SG1054.2 +045500 SORT-FAIL-15. SG1054.2 +045600 PERFORM FAIL. SG1054.2 +045700 MOVE SORTKEY-3 TO COMPUTED-18V0. SG1054.2 +045800 MOVE +.6000000000000000 TO CORRECT-18V0. SG1054.2 +045900 SORT-WRITE-15. SG1054.2 +046000 MOVE "SORT-TEST-15" TO PAR-NAME. SG1054.2 +046100 PERFORM PRINT-DETAIL. SG1054.2 +046200 SORT-TEST-16. SG1054.2 +046300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1054.2 +046400 IF SORTKEY-1 EQUAL TO +123456 SG1054.2 +046500 PERFORM PASS GO TO SORT-WRITE-16. SG1054.2 +046600 SORT-FAIL-16. SG1054.2 +046700 PERFORM FAIL. SG1054.2 +046800 MOVE SORTKEY-1 TO COMPUTED-N. SG1054.2 +046900 MOVE +123456 TO CORRECT-N. SG1054.2 +047000 SORT-WRITE-16. SG1054.2 +047100 MOVE "SORT-TEST-16" TO PAR-NAME. SG1054.2 +047200 PERFORM PRINT-DETAIL. SG1054.2 +047300 CONTINUE-TESTING SECTION 00. SG1054.2 +047400 SORT-TEST-17. SG1054.2 +047500 RETURN SORTFILE-1H AT END SG1054.2 +047600 PERFORM PASS GO TO SORT-WRITE-17. SG1054.2 +047700 SORT-FAIL-17. SG1054.2 +047800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SG1054.2 +047900 PERFORM FAIL. SG1054.2 +048000 SORT-WRITE-17. SG1054.2 +048100 MOVE "SORT-TEST-17" TO PAR-NAME. SG1054.2 +048200 PERFORM PRINT-DETAIL. SG1054.2 +048300 GO TO OUTPROC-EXIT. SG1054.2 +048400 RETURN-ERROR. SG1054.2 +048500 MOVE "RETURN-ERROR" TO PAR-NAME. SG1054.2 +048600 PERFORM FAIL. SG1054.2 +048700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SG1054.2 +048800 PERFORM PRINT-DETAIL. SG1054.2 +048900 GO TO CCVS1-EXIT. SG1054.2 +049000 CLOSE-FILES. SG1054.2 +049100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1054.2 +049200 TERMINATE-CCVS. SG1054.2 +049300*S EXIT PROGRAM. SG1054.2 +049400*SERMINATE-CALL. SG1054.2 +049500 STOP RUN. SG1054.2 +049600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1054.2 +049700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1054.2 +049800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1054.2 +049900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1054.2 +050000 MOVE "****TEST DELETED****" TO RE-MARK. SG1054.2 +050100 PRINT-DETAIL. SG1054.2 +050200 IF REC-CT NOT EQUAL TO ZERO SG1054.2 +050300 MOVE "." TO PARDOT-X SG1054.2 +050400 MOVE REC-CT TO DOTVALUE. SG1054.2 +050500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1054.2 +050600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1054.2 +050700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1054.2 +050800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1054.2 +050900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1054.2 +051000 MOVE SPACE TO CORRECT-X. SG1054.2 +051100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1054.2 +051200 MOVE SPACE TO RE-MARK. SG1054.2 +051300 HEAD-ROUTINE. SG1054.2 +051400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +051500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1054.2 +051600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1054.2 +051700 COLUMN-NAMES-ROUTINE. SG1054.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +052100 END-ROUTINE. SG1054.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1054.2 +052300 END-RTN-EXIT. SG1054.2 +052400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +052500 END-ROUTINE-1. SG1054.2 +052600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1054.2 +052700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1054.2 +052800 ADD PASS-COUNTER TO ERROR-HOLD. SG1054.2 +052900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1054.2 +053000 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1054.2 +053100 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1054.2 +053200 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1054.2 +053300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1054.2 +053400 END-ROUTINE-12. SG1054.2 +053500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1054.2 +053600 IF ERROR-COUNTER IS EQUAL TO ZERO SG1054.2 +053700 MOVE "NO " TO ERROR-TOTAL SG1054.2 +053800 ELSE SG1054.2 +053900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1054.2 +054000 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1054.2 +054100 PERFORM WRITE-LINE. SG1054.2 +054200 END-ROUTINE-13. SG1054.2 +054300 IF DELETE-CNT IS EQUAL TO ZERO SG1054.2 +054400 MOVE "NO " TO ERROR-TOTAL ELSE SG1054.2 +054500 MOVE DELETE-CNT TO ERROR-TOTAL. SG1054.2 +054600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1054.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +054800 IF INSPECT-COUNTER EQUAL TO ZERO SG1054.2 +054900 MOVE "NO " TO ERROR-TOTAL SG1054.2 +055000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1054.2 +055100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1054.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +055300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1054.2 +055400 WRITE-LINE. SG1054.2 +055500 ADD 1 TO RECORD-COUNT. SG1054.2 +055600 IF RECORD-COUNT GREATER 50 SG1054.2 +055700 MOVE DUMMY-RECORD TO DUMMY-HOLD SG1054.2 +055800 MOVE SPACE TO DUMMY-RECORD SG1054.2 +055900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1054.2 +056000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1054.2 +056100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1054.2 +056200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1054.2 +056300 MOVE DUMMY-HOLD TO DUMMY-RECORD SG1054.2 +056400 MOVE ZERO TO RECORD-COUNT. SG1054.2 +056500 PERFORM WRT-LN. SG1054.2 +056600 WRT-LN. SG1054.2 +056700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1054.2 +056800 MOVE SPACE TO DUMMY-RECORD. SG1054.2 +056900 BLANK-LINE-PRINT. SG1054.2 +057000 PERFORM WRT-LN. SG1054.2 +057100 FAIL-ROUTINE. SG1054.2 +057200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1054.2 +057300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1054.2 +057400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1054.2 +057500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +057600 GO TO FAIL-ROUTINE-EX. SG1054.2 +057700 FAIL-ROUTINE-WRITE. SG1054.2 +057800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1054.2 +057900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1054.2 +058000 FAIL-ROUTINE-EX. EXIT. SG1054.2 +058100 BAIL-OUT. SG1054.2 +058200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1054.2 +058300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1054.2 +058400 BAIL-OUT-WRITE. SG1054.2 +058500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1054.2 +058600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1054.2 +058700 BAIL-OUT-EX. EXIT. SG1054.2 +058800 CCVS1-EXIT. SG1054.2 +058900 EXIT. SG1054.2 +059000 OUTPROC-EXIT SECTION 00. SG1054.2 +059100 EXIT-ONLY. SG1054.2 +059200 PERFORM CLOSE-FILES. SG1054.2 diff --git a/tests/cobol85/SG/SG106A.CBL b/tests/cobol85/SG/SG106A.CBL new file mode 100755 index 00000000..d697dbf9 --- /dev/null +++ b/tests/cobol85/SG/SG106A.CBL @@ -0,0 +1,592 @@ +000100 IDENTIFICATION DIVISION. SG1064.2 +000200 PROGRAM-ID. SG1064.2 +000300 SG106A. SG1064.2 +000400 AUTHOR. SG1064.2 +000500 FEDERAL COMPILER TESTING CENTER. SG1064.2 +000600 INSTALLATION. SG1064.2 +000700 GENERAL SERVICES ADMINISTRATION SG1064.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG1064.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG1064.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG1064.2 +001100 FALLS CHURCH VIRGINIA 22041. SG1064.2 +001200 SG1064.2 +001300 PHONE (703) 756-6153 SG1064.2 +001400 SG1064.2 +001500 " HIGH ". SG1064.2 +001600 DATE-WRITTEN. SG1064.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG1064.2 +001800 CREATION DATE / VALIDATION DATE SG1064.2 +001900 "4.2 ". SG1064.2 +002000 SECURITY. SG1064.2 +002100 NONE. SG1064.2 +002200 SG106A IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT SG1064.2 +002300 PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE SG1064.2 +002400 OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE SG1064.2 +002500 REPORT. SG1064.2 +002600 SORT SORT SORT SORT SORT SORT SORT SORT SG1064.2 +002700 KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8SG1064.2 +002800 S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 SG1064.2 +002900 USAGE JUST JUST USAGESG1064.2 +003000 COMP RIGHT RIGHT COMP SG1064.2 +003100 SG1064.2 +003200 +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 SG1064.2 +003300 -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 SG1064.2 +003400 -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 SG1064.2 +003500 -054321 BBB -.1234 X A AAAAAAAA 501 +99 SG1064.2 +003600 -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 SG1064.2 +003700 -054321 BBB -.1234 BBBBBB A Z 501 +99 SG1064.2 +003800 -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 SG1064.2 +003900 -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 SG1064.2 +004000 SG1064.2 +004100 THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT SG1064.2 +004200 ASCENDING KEYS IN ONE FILE. SG1064.2 +004300 SG1064.2 +004400 ENVIRONMENT DIVISION. SG1064.2 +004500 CONFIGURATION SECTION. SG1064.2 +004600 SOURCE-COMPUTER. SG1064.2 +004700 Linux. SG1064.2 +004800 OBJECT-COMPUTER. SG1064.2 +004900 Linux. SG1064.2 +005000 INPUT-OUTPUT SECTION. SG1064.2 +005100 FILE-CONTROL. SG1064.2 +005200 SELECT PRINT-FILE ASSIGN TO SG1064.2 +005300 "report.log". SG1064.2 +005400 SELECT SORTFILE-1H ASSIGN TO SG1064.2 +005500 "XXXXX027". SG1064.2 +005600 DATA DIVISION. SG1064.2 +005700 FILE SECTION. SG1064.2 +005800 FD PRINT-FILE SG1064.2 +005900 LABEL RECORDS SG1064.2 +006000 OMITTED SG1064.2 +006100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG1064.2 +006200 01 PRINT-REC PICTURE X(120). SG1064.2 +006300 01 DUMMY-RECORD PICTURE X(120). SG1064.2 +006400 SD SORTFILE-1H SG1064.2 +006500 DATA RECORD IS SORTFILE-REC. SG1064.2 +006600 01 SORTFILE-REC. SG1064.2 +006700 02 SORTKEY-8 PICTURE S99 COMPUTATIONAL. SG1064.2 +006800 02 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. SG1064.2 +006900 02 SORTKEY-7 PICTURE 999. SG1064.2 +007000 02 SORTKEY-3 PICTURE SV9(16). SG1064.2 +007100 02 FILLER PICTURE XX. SG1064.2 +007200 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. SG1064.2 +007300 02 SORTKEY-6 PICTURE X(10). SG1064.2 +007400 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. SG1064.2 +007500 02 SORTKEY-5 PICTURE A(20). SG1064.2 +007600 02 FILLER PICTURE XXX. SG1064.2 +007700 WORKING-STORAGE SECTION. SG1064.2 +007800 77 UTIL-CTR PICTURE S99999. SG1064.2 +007900 77 SPAC-E PICTURE X VALUE " ". SG1064.2 +008000 01 TEST-RESULTS. SG1064.2 +008100 02 FILLER PICTURE X VALUE SPACE. SG1064.2 +008200 02 FEATURE PICTURE X(20) VALUE SPACE. SG1064.2 +008300 02 FILLER PICTURE X VALUE SPACE. SG1064.2 +008400 02 P-OR-F PICTURE X(5) VALUE SPACE. SG1064.2 +008500 02 FILLER PICTURE X VALUE SPACE. SG1064.2 +008600 02 PAR-NAME. SG1064.2 +008700 03 FILLER PICTURE X(12) VALUE SPACE. SG1064.2 +008800 03 PARDOT-X PICTURE X VALUE SPACE. SG1064.2 +008900 03 DOTVALUE PICTURE 99 VALUE ZERO. SG1064.2 +009000 03 FILLER PIC X(5) VALUE SPACE. SG1064.2 +009100 02 FILLER PIC X(10) VALUE SPACE. SG1064.2 +009200 02 RE-MARK PIC X(61). SG1064.2 +009300 01 TEST-COMPUTED. SG1064.2 +009400 02 FILLER PIC X(30) VALUE SPACE. SG1064.2 +009500 02 FILLER PIC X(17) VALUE " COMPUTED=". SG1064.2 +009600 02 COMPUTED-X. SG1064.2 +009700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG1064.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG1064.2 +009900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG1064.2 +010000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG1064.2 +010100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG1064.2 +010200 03 CM-18V0 REDEFINES COMPUTED-A. SG1064.2 +010300 04 COMPUTED-18V0 PICTURE -9(18). SG1064.2 +010400 04 FILLER PICTURE X. SG1064.2 +010500 03 FILLER PIC X(50) VALUE SPACE. SG1064.2 +010600 01 TEST-CORRECT. SG1064.2 +010700 02 FILLER PIC X(30) VALUE SPACE. SG1064.2 +010800 02 FILLER PIC X(17) VALUE " CORRECT =". SG1064.2 +010900 02 CORRECT-X. SG1064.2 +011000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG1064.2 +011100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG1064.2 +011200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG1064.2 +011300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG1064.2 +011400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG1064.2 +011500 03 CR-18V0 REDEFINES CORRECT-A. SG1064.2 +011600 04 CORRECT-18V0 PICTURE -9(18). SG1064.2 +011700 04 FILLER PICTURE X. SG1064.2 +011800 03 FILLER PIC X(50) VALUE SPACE. SG1064.2 +011900 01 CCVS-C-1. SG1064.2 +012000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG1064.2 +012100- "SS PARAGRAPH-NAME SG1064.2 +012200- " REMARKS". SG1064.2 +012300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG1064.2 +012400 01 CCVS-C-2. SG1064.2 +012500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1064.2 +012600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG1064.2 +012700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG1064.2 +012800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG1064.2 +012900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG1064.2 +013000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG1064.2 +013100 01 REC-CT PICTURE 99 VALUE ZERO. SG1064.2 +013200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG1064.2 +013300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG1064.2 +013400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG1064.2 +013500 01 PASS-COUNTER PIC 999 VALUE ZERO. SG1064.2 +013600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG1064.2 +013700 01 ERROR-HOLD PIC 999 VALUE ZERO. SG1064.2 +013800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG1064.2 +013900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG1064.2 +014000 01 CCVS-H-1. SG1064.2 +014100 02 FILLER PICTURE X(27) VALUE SPACE. SG1064.2 +014200 02 FILLER PICTURE X(67) VALUE SG1064.2 +014300 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG1064.2 +014400- " SYSTEM". SG1064.2 +014500 02 FILLER PICTURE X(26) VALUE SPACE. SG1064.2 +014600 01 CCVS-H-2. SG1064.2 +014700 02 FILLER PICTURE X(52) VALUE IS SG1064.2 +014800 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG1064.2 +014900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG1064.2 +015000 02 TEST-ID PICTURE IS X(9). SG1064.2 +015100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG1064.2 +015200 01 CCVS-H-3. SG1064.2 +015300 02 FILLER PICTURE X(34) VALUE SG1064.2 +015400 " FOR OFFICIAL USE ONLY ". SG1064.2 +015500 02 FILLER PICTURE X(58) VALUE SG1064.2 +015600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG1064.2 +015700 02 FILLER PICTURE X(28) VALUE SG1064.2 +015800 " COPYRIGHT 1974 ". SG1064.2 +015900 01 CCVS-E-1. SG1064.2 +016000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG1064.2 +016100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG1064.2 +016200 02 ID-AGAIN PICTURE IS X(9). SG1064.2 +016300 02 FILLER PICTURE X(45) VALUE IS SG1064.2 +016400 " NTIS DISTRIBUTION COBOL 74". SG1064.2 +016500 01 CCVS-E-2. SG1064.2 +016600 02 FILLER PICTURE X(31) VALUE SG1064.2 +016700 SPACE. SG1064.2 +016800 02 FILLER PICTURE X(21) VALUE SPACE. SG1064.2 +016900 02 CCVS-E-2-2. SG1064.2 +017000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG1064.2 +017100 03 FILLER PICTURE IS X VALUE IS SPACE. SG1064.2 +017200 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG1064.2 +017300 01 CCVS-E-3. SG1064.2 +017400 02 FILLER PICTURE X(22) VALUE SG1064.2 +017500 " FOR OFFICIAL USE ONLY". SG1064.2 +017600 02 FILLER PICTURE X(12) VALUE SPACE. SG1064.2 +017700 02 FILLER PICTURE X(58) VALUE SG1064.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG1064.2 +017900 02 FILLER PICTURE X(13) VALUE SPACE. SG1064.2 +018000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG1064.2 +018100 01 CCVS-E-4. SG1064.2 +018200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG1064.2 +018300 02 FILLER PIC XXXX VALUE " OF ". SG1064.2 +018400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG1064.2 +018500 02 FILLER PIC X(40) VALUE SG1064.2 +018600 " TESTS WERE EXECUTED SUCCESSFULLY". SG1064.2 +018700 01 XXINFO. SG1064.2 +018800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG1064.2 +018900 02 INFO-TEXT. SG1064.2 +019000 04 FILLER PIC X(20) VALUE SPACE. SG1064.2 +019100 04 XXCOMPUTED PIC X(20). SG1064.2 +019200 04 FILLER PIC X(5) VALUE SPACE. SG1064.2 +019300 04 XXCORRECT PIC X(20). SG1064.2 +019400 01 HYPHEN-LINE. SG1064.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SG1064.2 +019600 02 FILLER PICTURE IS X(65) VALUE IS "************************SG1064.2 +019700- "*****************************************". SG1064.2 +019800 02 FILLER PICTURE IS X(54) VALUE IS "************************SG1064.2 +019900- "******************************". SG1064.2 +020000 01 CCVS-PGM-ID PIC X(6) VALUE SG1064.2 +020100 "SG106A". SG1064.2 +020200 PROCEDURE DIVISION. SG1064.2 +020300 SORT-PARA SECTION 09. SG1064.2 +020400 SORT-PARAGRAPH. SG1064.2 +020500 SORT SORTFILE-1H ON SG1064.2 +020600 ASCENDING KEY SORTKEY-1 SG1064.2 +020700 ASCENDING SORTKEY-2 SG1064.2 +020800 ASCENDING SORTKEY-3 SG1064.2 +020900 ASCENDING SORTKEY-4 SG1064.2 +021000 ASCENDING SORTKEY-5 SG1064.2 +021100 ASCENDING SORTKEY-6 SG1064.2 +021200 ASCENDING SORTKEY-7 SG1064.2 +021300 ASCENDING SORTKEY-8 SG1064.2 +021400 INPUT PROCEDURE INPROC SG1064.2 +021500 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. SG1064.2 +021600 STOP RUN. SG1064.2 +021700 INPROC SECTION 69. SG1064.2 +021800 BUILD-FILE. SG1064.2 +021900 PERFORM BUILD-RECORD. SG1064.2 +022000 MOVE +123456 TO SORTKEY-1. SG1064.2 +022100 PERFORM RELEASE-RECORD. SG1064.2 +022200 PERFORM BUILD-RECORD. SG1064.2 +022300 MOVE "X" TO SORTKEY-2. SG1064.2 +022400 PERFORM RELEASE-RECORD. SG1064.2 +022500 PERFORM BUILD-RECORD. SG1064.2 +022600 MOVE +.6 TO SORTKEY-3. SG1064.2 +022700 PERFORM RELEASE-RECORD. SG1064.2 +022800 PERFORM BUILD-RECORD. SG1064.2 +022900 MOVE "X" TO SORTKEY-4. SG1064.2 +023000 PERFORM RELEASE-RECORD. SG1064.2 +023100 PERFORM BUILD-RECORD. SG1064.2 +023200 MOVE "Z" TO SORTKEY-5. SG1064.2 +023300 PERFORM RELEASE-RECORD. SG1064.2 +023400 PERFORM BUILD-RECORD. SG1064.2 +023500 MOVE "Z" TO SORTKEY-6. SG1064.2 +023600 PERFORM RELEASE-RECORD. SG1064.2 +023700 PERFORM BUILD-RECORD. SG1064.2 +023800 MOVE +418 TO SORTKEY-7. SG1064.2 +023900 PERFORM RELEASE-RECORD. SG1064.2 +024000 PERFORM BUILD-RECORD. SG1064.2 +024100 MOVE -14 TO SORTKEY-8. SG1064.2 +024200 PERFORM RELEASE-RECORD. SG1064.2 +024300 GO TO BUILD-EXIT. SG1064.2 +024400 BUILD-RECORD. SG1064.2 +024500 MOVE -054321 TO SORTKEY-1. SG1064.2 +024600 MOVE "BBB" TO SORTKEY-2. SG1064.2 +024700 MOVE -.1234567890123456 TO SORTKEY-3. SG1064.2 +024800 MOVE "BBBBBB" TO SORTKEY-4. SG1064.2 +024900 MOVE "A" TO SORTKEY-5. SG1064.2 +025000 MOVE "AAAAAAAA" TO SORTKEY-6. SG1064.2 +025100 MOVE -501 TO SORTKEY-7. SG1064.2 +025200* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED SG1064.2 +025300* FIELD. SG1064.2 +025400 MOVE +99 TO SORTKEY-8. SG1064.2 +025500 RELEASE-RECORD. SG1064.2 +025600 RELEASE SORTFILE-REC. SG1064.2 +025700 BUILD-EXIT. SG1064.2 +025800 EXIT. SG1064.2 +025900 OUTPROC SECTION 99. SG1064.2 +026000 OPEN-FILES. SG1064.2 +026100 OPEN OUTPUT PRINT-FILE. SG1064.2 +026200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG1064.2 +026300 MOVE SPACE TO TEST-RESULTS. SG1064.2 +026400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG1064.2 +026500 IF SPAC-E IS LESS THAN "B" SG1064.2 +026600 GO TO SPACE-IS-LESS-THAN-B. SG1064.2 +026700 B-IS-LESS-THAN-SPACE SECTION 99. SG1064.2 +026800 SORT-INIT-A. SG1064.2 +026900 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1064.2 +027000* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1064.2 +027100* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, SG1064.2 +027200* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, SG1064.2 +027300* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. SG1064.2 +027400 SORT-TEST-1. SG1064.2 +027500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +027600 IF SORTKEY-7 EQUAL TO 418 SG1064.2 +027700 PERFORM PASS GO TO SORT-WRITE-1. SG1064.2 +027800 SORT-FAIL-1. SG1064.2 +027900 PERFORM FAIL. SG1064.2 +028000 MOVE SORTKEY-7 TO COMPUTED-N. SG1064.2 +028100 MOVE 418 TO CORRECT-N. SG1064.2 +028200 SORT-WRITE-1. SG1064.2 +028300 MOVE "SORT-TEST-1 " TO PAR-NAME. SG1064.2 +028400 PERFORM PRINT-DETAIL. SG1064.2 +028500 SORT-TEST-2. SG1064.2 +028600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +028700 IF SORTKEY-8 EQUAL TO -14 SG1064.2 +028800 PERFORM PASS GO TO SORT-WRITE-2. SG1064.2 +028900 SORT-FAIL-2. SG1064.2 +029000 PERFORM FAIL. SG1064.2 +029100 MOVE SORTKEY-8 TO COMPUTED-N. SG1064.2 +029200 MOVE -14 TO CORRECT-N. SG1064.2 +029300 SORT-WRITE-2. SG1064.2 +029400 MOVE "SORT-TEST-2 " TO PAR-NAME. SG1064.2 +029500 PERFORM PRINT-DETAIL. SG1064.2 +029600 SORT-TEST-3. SG1064.2 +029700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +029800 IF SORTKEY-6 EQUAL TO "Z " SG1064.2 +029900 PERFORM PASS GO TO SORT-WRITE-3. SG1064.2 +030000 SORT-FAIL-3. SG1064.2 +030100 PERFORM FAIL. SG1064.2 +030200 MOVE SORTKEY-6 TO COMPUTED-A. SG1064.2 +030300 MOVE "Z " TO CORRECT-A. SG1064.2 +030400 SORT-WRITE-3. SG1064.2 +030500 MOVE "SORT-TEST-3 " TO PAR-NAME. SG1064.2 +030600 PERFORM PRINT-DETAIL. SG1064.2 +030700 SORT-TEST-4. SG1064.2 +030800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +030900 IF SORTKEY-5 EQUAL TO "Z " SG1064.2 +031000 PERFORM PASS GO TO SORT-WRITE-4. SG1064.2 +031100 SORT-FAIL-4. SG1064.2 +031200 PERFORM FAIL. SG1064.2 +031300 MOVE SORTKEY-5 TO COMPUTED-A. SG1064.2 +031400 MOVE "Z " TO CORRECT-A. SG1064.2 +031500 SORT-WRITE-4. SG1064.2 +031600 MOVE "SORT-TEST-4 " TO PAR-NAME. SG1064.2 +031700 PERFORM PRINT-DETAIL. SG1064.2 +031800 SORT-TEST-5. SG1064.2 +031900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +032000 IF SORTKEY-4 EQUAL TO " X" SG1064.2 +032100 PERFORM PASS GO TO SORT-WRITE-5. SG1064.2 +032200 SORT-FAIL-5. SG1064.2 +032300 PERFORM FAIL. SG1064.2 +032400 MOVE SORTKEY-4 TO COMPUTED-A. SG1064.2 +032500 MOVE " X" TO CORRECT-A. SG1064.2 +032600 SORT-WRITE-5. SG1064.2 +032700 MOVE "SORT-TEST-5 " TO PAR-NAME. SG1064.2 +032800 PERFORM PRINT-DETAIL. SG1064.2 +032900 SORT-TEST-6. SG1064.2 +033000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +033100 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1064.2 +033200 PERFORM PASS GO TO SORT-WRITE-6. SG1064.2 +033300 SORT-FAIL-6. SG1064.2 +033400 PERFORM FAIL. SG1064.2 +033500 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1064.2 +033600 MOVE +.6000000000000000 TO CORRECT-0V18. SG1064.2 +033700 SORT-WRITE-6. SG1064.2 +033800 MOVE "SORT-TEST-6 " TO PAR-NAME. SG1064.2 +033900 PERFORM PRINT-DETAIL. SG1064.2 +034000 SORT-TEST-7. SG1064.2 +034100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +034200 IF SORTKEY-2 EQUAL TO " X" SG1064.2 +034300 PERFORM PASS GO TO SORT-WRITE-7. SG1064.2 +034400 SORT-FAIL-7. SG1064.2 +034500 PERFORM FAIL. SG1064.2 +034600 MOVE SORTKEY-2 TO COMPUTED-A. SG1064.2 +034700 MOVE " X" TO CORRECT-A. SG1064.2 +034800 SORT-WRITE-7. SG1064.2 +034900 MOVE "SORT-TEST-7 " TO PAR-NAME. SG1064.2 +035000 PERFORM PRINT-DETAIL. SG1064.2 +035100 SORT-TEST-8. SG1064.2 +035200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +035300 IF SORTKEY-1 EQUAL TO +123456 SG1064.2 +035400 PERFORM PASS GO TO SORT-WRITE-8. SG1064.2 +035500 SORT-FAIL-8. SG1064.2 +035600 PERFORM FAIL. SG1064.2 +035700 MOVE SORTKEY-1 TO COMPUTED-N. SG1064.2 +035800 MOVE +123456 TO CORRECT-N. SG1064.2 +035900 SORT-WRITE-8. SG1064.2 +036000 MOVE "SORT-TEST-8 " TO PAR-NAME. SG1064.2 +036100 PERFORM PRINT-DETAIL. SG1064.2 +036200 SORT-REMARK-A. SG1064.2 +036300 MOVE SPACE TO FEATURE. SG1064.2 +036400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1064.2 +036500 PERFORM PRINT-DETAIL. SG1064.2 +036600 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. SG1064.2 +036700 PERFORM PRINT-DETAIL. SG1064.2 +036800 MOVE "UNNECESSARY." TO RE-MARK. SG1064.2 +036900 PERFORM PRINT-DETAIL. SG1064.2 +037000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1064.2 +037100 GO TO CONTINUE-TESTING. SG1064.2 +037200 SPACE-IS-LESS-THAN-B SECTION 99. SG1064.2 +037300 SORT-REMARK-B. SG1064.2 +037400 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. SG1064.2 +037500 PERFORM PRINT-DETAIL. SG1064.2 +037600 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. SG1064.2 +037700 PERFORM PRINT-DETAIL. SG1064.2 +037800 MOVE "UNNECESSARY." TO RE-MARK. SG1064.2 +037900 PERFORM PRINT-DETAIL. SG1064.2 +038000 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. SG1064.2 +038100* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING SG1064.2 +038200* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, SG1064.2 +038300* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, SG1064.2 +038400* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. SG1064.2 +038500 SORT-TEST-9. SG1064.2 +038600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +038700 IF SORTKEY-2 EQUAL TO " X" SG1064.2 +038800 PERFORM PASS GO TO SORT-WRITE-9. SG1064.2 +038900 SORT-FAIL-9. SG1064.2 +039000 PERFORM FAIL. SG1064.2 +039100 MOVE SORTKEY-2 TO COMPUTED-A. SG1064.2 +039200 MOVE " X" TO CORRECT-A. SG1064.2 +039300 SORT-WRITE-9. SG1064.2 +039400 MOVE "SORT-TEST-9 " TO PAR-NAME. SG1064.2 +039500 PERFORM PRINT-DETAIL. SG1064.2 +039600 SORT-TEST-10. SG1064.2 +039700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +039800 IF SORTKEY-4 EQUAL TO " X" SG1064.2 +039900 PERFORM PASS GO TO SORT-WRITE-10. SG1064.2 +040000 SORT-FAIL-10. SG1064.2 +040100 PERFORM FAIL. SG1064.2 +040200 MOVE SORTKEY-4 TO COMPUTED-A. SG1064.2 +040300 MOVE " X" TO CORRECT-A. SG1064.2 +040400 SORT-WRITE-10. SG1064.2 +040500 MOVE "SORT-TEST-10" TO PAR-NAME. SG1064.2 +040600 PERFORM PRINT-DETAIL. SG1064.2 +040700 SORT-TEST-11. SG1064.2 +040800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +040900 IF SORTKEY-7 EQUAL TO 418 SG1064.2 +041000 PERFORM PASS GO TO SORT-WRITE-11. SG1064.2 +041100 SORT-FAIL-11. SG1064.2 +041200 PERFORM FAIL. SG1064.2 +041300 MOVE SORTKEY-7 TO COMPUTED-N SG1064.2 +041400 MOVE 418 TO CORRECT-N. SG1064.2 +041500 SORT-WRITE-11. SG1064.2 +041600 MOVE "SORT-TEST-11" TO PAR-NAME. SG1064.2 +041700 PERFORM PRINT-DETAIL. SG1064.2 +041800 SORT-TEST-12. SG1064.2 +041900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +042000 IF SORTKEY-8 EQUAL TO -14 SG1064.2 +042100 PERFORM PASS GO TO SORT-WRITE-12. SG1064.2 +042200 SORT-FAIL-12. SG1064.2 +042300 PERFORM FAIL. SG1064.2 +042400 MOVE SORTKEY-8 TO COMPUTED-N. SG1064.2 +042500 MOVE -14 TO CORRECT-N. SG1064.2 +042600 SORT-WRITE-12. SG1064.2 +042700 MOVE "SORT-TEST-12" TO PAR-NAME. SG1064.2 +042800 PERFORM PRINT-DETAIL. SG1064.2 +042900 SORT-TEST-13. SG1064.2 +043000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +043100 IF SORTKEY-6 EQUAL TO "Z " SG1064.2 +043200 PERFORM PASS GO TO SORT-WRITE-13. SG1064.2 +043300 SORT-FAIL-13. SG1064.2 +043400 PERFORM FAIL. SG1064.2 +043500 MOVE SORTKEY-6 TO COMPUTED-A. SG1064.2 +043600 MOVE "Z " TO CORRECT-A. SG1064.2 +043700 SORT-WRITE-13. SG1064.2 +043800 MOVE "SORT-TEST-13" TO PAR-NAME. SG1064.2 +043900 PERFORM PRINT-DETAIL. SG1064.2 +044000 SORT-TEST-14. SG1064.2 +044100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +044200 IF SORTKEY-5 EQUAL TO "Z " SG1064.2 +044300 PERFORM PASS GO TO SORT-WRITE-14. SG1064.2 +044400 SORT-FAIL-14. SG1064.2 +044500 PERFORM FAIL. SG1064.2 +044600 MOVE SORTKEY-5 TO COMPUTED-A. SG1064.2 +044700 MOVE "Z " TO CORRECT-A. SG1064.2 +044800 SORT-WRITE-14. SG1064.2 +044900 MOVE "SORT-TEST-14" TO PAR-NAME. SG1064.2 +045000 PERFORM PRINT-DETAIL. SG1064.2 +045100 SORT-TEST-15. SG1064.2 +045200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +045300 IF SORTKEY-3 EQUAL TO +.6000000000000000 SG1064.2 +045400 PERFORM PASS GO TO SORT-WRITE-15. SG1064.2 +045500 SORT-FAIL-15. SG1064.2 +045600 PERFORM FAIL. SG1064.2 +045700 MOVE SORTKEY-3 TO COMPUTED-0V18. SG1064.2 +045800 MOVE +.6000000000000000 TO CORRECT-0V18. SG1064.2 +045900 SORT-WRITE-15. SG1064.2 +046000 MOVE "SORT-TEST-15" TO PAR-NAME. SG1064.2 +046100 PERFORM PRINT-DETAIL. SG1064.2 +046200 SORT-TEST-16. SG1064.2 +046300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. SG1064.2 +046400 IF SORTKEY-1 EQUAL TO +123456 SG1064.2 +046500 PERFORM PASS GO TO SORT-WRITE-16. SG1064.2 +046600 SORT-FAIL-16. SG1064.2 +046700 PERFORM FAIL. SG1064.2 +046800 MOVE SORTKEY-1 TO COMPUTED-N. SG1064.2 +046900 MOVE +123456 TO CORRECT-N. SG1064.2 +047000 SORT-WRITE-16. SG1064.2 +047100 MOVE "SORT-TEST-16" TO PAR-NAME. SG1064.2 +047200 PERFORM PRINT-DETAIL. SG1064.2 +047300 CONTINUE-TESTING SECTION 99. SG1064.2 +047400 SORT-TEST-17. SG1064.2 +047500 RETURN SORTFILE-1H AT END SG1064.2 +047600 PERFORM PASS GO TO SORT-WRITE-17. SG1064.2 +047700 SORT-FAIL-17. SG1064.2 +047800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SG1064.2 +047900 PERFORM FAIL. SG1064.2 +048000 SORT-WRITE-17. SG1064.2 +048100 MOVE "SORT-TEST-17" TO PAR-NAME. SG1064.2 +048200 PERFORM PRINT-DETAIL. SG1064.2 +048300 GO TO OUTPROC-EXIT. SG1064.2 +048400 RETURN-ERROR. SG1064.2 +048500 MOVE "RETURN-ERROR" TO PAR-NAME. SG1064.2 +048600 PERFORM FAIL. SG1064.2 +048700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SG1064.2 +048800 PERFORM PRINT-DETAIL. SG1064.2 +048900 GO TO CCVS1-EXIT. SG1064.2 +049000 CLOSE-FILES. SG1064.2 +049100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG1064.2 +049200 TERMINATE-CCVS. SG1064.2 +049300*S EXIT PROGRAM. SG1064.2 +049400*SERMINATE-CALL. SG1064.2 +049500 STOP RUN. SG1064.2 +049600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG1064.2 +049700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG1064.2 +049800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG1064.2 +049900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG1064.2 +050000 MOVE "****TEST DELETED****" TO RE-MARK. SG1064.2 +050100 PRINT-DETAIL. SG1064.2 +050200 IF REC-CT NOT EQUAL TO ZERO SG1064.2 +050300 MOVE "." TO PARDOT-X SG1064.2 +050400 MOVE REC-CT TO DOTVALUE. SG1064.2 +050500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG1064.2 +050600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG1064.2 +050700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG1064.2 +050800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG1064.2 +050900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG1064.2 +051000 MOVE SPACE TO CORRECT-X. SG1064.2 +051100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG1064.2 +051200 MOVE SPACE TO RE-MARK. SG1064.2 +051300 HEAD-ROUTINE. SG1064.2 +051400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +051500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG1064.2 +051600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG1064.2 +051700 COLUMN-NAMES-ROUTINE. SG1064.2 +051800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +051900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +052100 END-ROUTINE. SG1064.2 +052200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG1064.2 +052300 END-RTN-EXIT. SG1064.2 +052400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +052500 END-ROUTINE-1. SG1064.2 +052600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG1064.2 +052700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG1064.2 +052800 ADD PASS-COUNTER TO ERROR-HOLD. SG1064.2 +052900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG1064.2 +053000 MOVE PASS-COUNTER TO CCVS-E-4-1. SG1064.2 +053100 MOVE ERROR-HOLD TO CCVS-E-4-2. SG1064.2 +053200 MOVE CCVS-E-4 TO CCVS-E-2-2. SG1064.2 +053300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG1064.2 +053400 END-ROUTINE-12. SG1064.2 +053500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG1064.2 +053600 IF ERROR-COUNTER IS EQUAL TO ZERO SG1064.2 +053700 MOVE "NO " TO ERROR-TOTAL SG1064.2 +053800 ELSE SG1064.2 +053900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG1064.2 +054000 MOVE CCVS-E-2 TO DUMMY-RECORD. SG1064.2 +054100 PERFORM WRITE-LINE. SG1064.2 +054200 END-ROUTINE-13. SG1064.2 +054300 IF DELETE-CNT IS EQUAL TO ZERO SG1064.2 +054400 MOVE "NO " TO ERROR-TOTAL ELSE SG1064.2 +054500 MOVE DELETE-CNT TO ERROR-TOTAL. SG1064.2 +054600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG1064.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +054800 IF INSPECT-COUNTER EQUAL TO ZERO SG1064.2 +054900 MOVE "NO " TO ERROR-TOTAL SG1064.2 +055000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG1064.2 +055100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG1064.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +055300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG1064.2 +055400 WRITE-LINE. SG1064.2 +055500 ADD 1 TO RECORD-COUNT. SG1064.2 +055600 IF RECORD-COUNT GREATER 50 SG1064.2 +055700 MOVE DUMMY-RECORD TO DUMMY-HOLD SG1064.2 +055800 MOVE SPACE TO DUMMY-RECORD SG1064.2 +055900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG1064.2 +056000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG1064.2 +056100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG1064.2 +056200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG1064.2 +056300 MOVE DUMMY-HOLD TO DUMMY-RECORD SG1064.2 +056400 MOVE ZERO TO RECORD-COUNT. SG1064.2 +056500 PERFORM WRT-LN. SG1064.2 +056600 WRT-LN. SG1064.2 +056700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG1064.2 +056800 MOVE SPACE TO DUMMY-RECORD. SG1064.2 +056900 BLANK-LINE-PRINT. SG1064.2 +057000 PERFORM WRT-LN. SG1064.2 +057100 FAIL-ROUTINE. SG1064.2 +057200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1064.2 +057300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG1064.2 +057400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG1064.2 +057500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +057600 GO TO FAIL-ROUTINE-EX. SG1064.2 +057700 FAIL-ROUTINE-WRITE. SG1064.2 +057800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG1064.2 +057900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG1064.2 +058000 FAIL-ROUTINE-EX. EXIT. SG1064.2 +058100 BAIL-OUT. SG1064.2 +058200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG1064.2 +058300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG1064.2 +058400 BAIL-OUT-WRITE. SG1064.2 +058500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG1064.2 +058600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG1064.2 +058700 BAIL-OUT-EX. EXIT. SG1064.2 +058800 CCVS1-EXIT. SG1064.2 +058900 EXIT. SG1064.2 +059000 OUTPROC-EXIT SECTION 99. SG1064.2 +059100 EXIT-ONLY. SG1064.2 +059200 PERFORM CLOSE-FILES. SG1064.2 diff --git a/tests/cobol85/SG/SG201A.CBL b/tests/cobol85/SG/SG201A.CBL new file mode 100755 index 00000000..69164d6e --- /dev/null +++ b/tests/cobol85/SG/SG201A.CBL @@ -0,0 +1,1950 @@ +000100 IDENTIFICATION DIVISION. SG2014.2 +000200 PROGRAM-ID. SG2014.2 +000300 SG201A. SG2014.2 +000400 AUTHOR. SG2014.2 +000500 FEDERAL COMPILER TESTING CENTER. SG2014.2 +000600 INSTALLATION. SG2014.2 +000700 GENERAL SERVICES ADMINISTRATION SG2014.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG2014.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG2014.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG2014.2 +001100 FALLS CHURCH VIRGINIA 22041. SG2014.2 +001200 SG2014.2 +001300 PHONE (703) 756-6153 SG2014.2 +001400 SG2014.2 +001500 " HIGH ". SG2014.2 +001600 DATE-WRITTEN. SG2014.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG2014.2 +001800 CREATION DATE / VALIDATION DATE SG2014.2 +001900 "4.2 ". SG2014.2 +002000 SECURITY. SG2014.2 +002100 NONE. SG2014.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG2014.2 +002300 SEGMENT-LIMIT FEATURE IS TESTED BY USE OF ALTER SG2014.2 +002400 PERFORM AND GO TO STATEMENTS VERIFYING LAST-USED SG2014.2 +002500 STATE ON SEGMENTS GREATER THAN AND EQUAL TO THE SG2014.2 +002600 SEGMENT-LIMIT INCLUDING SEGMENTS PERMANENTLY RESIDENT SG2014.2 +002700 (LESS THAN SEGMENT-LIMIT) WITH THE INITIAL STATE SG2014.2 +002800 ON SEGMENTS GREATER THAN 49. SG2014.2 +002900 SG2014.2 +003000* SG2014.2 +003100 ENVIRONMENT DIVISION. SG2014.2 +003200 CONFIGURATION SECTION. SG2014.2 +003300 SOURCE-COMPUTER. SG2014.2 +003400 Linux. SG2014.2 +003500 OBJECT-COMPUTER. SG2014.2 +003600 Linux SG2014.2 +003700 SEGMENT-LIMIT IS 30. SG2014.2 +003800 INPUT-OUTPUT SECTION. SG2014.2 +003900 FILE-CONTROL. SG2014.2 +004000 SELECT PRINT-FILE ASSIGN TO SG2014.2 +004100 "report.log". SG2014.2 +004200 DATA DIVISION. SG2014.2 +004300 FILE SECTION. SG2014.2 +004400 FD PRINT-FILE SG2014.2 +004500 LABEL RECORDS SG2014.2 +004600 OMITTED SG2014.2 +004700 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG2014.2 +004800 01 PRINT-REC PICTURE X(120). SG2014.2 +004900 01 DUMMY-RECORD PICTURE X(120). SG2014.2 +005000 WORKING-STORAGE SECTION. SG2014.2 +005100 77 TEST-CHECK PICTURE XXXX VALUE SPACE. SG2014.2 +005200 01 TEST-RESULTS. SG2014.2 +005300 02 FILLER PICTURE X VALUE SPACE. SG2014.2 +005400 02 FEATURE PICTURE X(20) VALUE SPACE. SG2014.2 +005500 02 FILLER PICTURE X VALUE SPACE. SG2014.2 +005600 02 P-OR-F PICTURE X(5) VALUE SPACE. SG2014.2 +005700 02 FILLER PICTURE X VALUE SPACE. SG2014.2 +005800 02 PAR-NAME. SG2014.2 +005900 03 FILLER PICTURE X(12) VALUE SPACE. SG2014.2 +006000 03 PARDOT-X PICTURE X VALUE SPACE. SG2014.2 +006100 03 DOTVALUE PICTURE 99 VALUE ZERO. SG2014.2 +006200 03 FILLER PIC X(5) VALUE SPACE. SG2014.2 +006300 02 FILLER PIC X(10) VALUE SPACE. SG2014.2 +006400 02 RE-MARK PIC X(61). SG2014.2 +006500 01 TEST-COMPUTED. SG2014.2 +006600 02 FILLER PIC X(30) VALUE SPACE. SG2014.2 +006700 02 FILLER PIC X(17) VALUE " COMPUTED=". SG2014.2 +006800 02 COMPUTED-X. SG2014.2 +006900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG2014.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG2014.2 +007100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG2014.2 +007200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG2014.2 +007300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG2014.2 +007400 03 CM-18V0 REDEFINES COMPUTED-A. SG2014.2 +007500 04 COMPUTED-18V0 PICTURE -9(18). SG2014.2 +007600 04 FILLER PICTURE X. SG2014.2 +007700 03 FILLER PIC X(50) VALUE SPACE. SG2014.2 +007800 01 TEST-CORRECT. SG2014.2 +007900 02 FILLER PIC X(30) VALUE SPACE. SG2014.2 +008000 02 FILLER PIC X(17) VALUE " CORRECT =". SG2014.2 +008100 02 CORRECT-X. SG2014.2 +008200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG2014.2 +008300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG2014.2 +008400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG2014.2 +008500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG2014.2 +008600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG2014.2 +008700 03 CR-18V0 REDEFINES CORRECT-A. SG2014.2 +008800 04 CORRECT-18V0 PICTURE -9(18). SG2014.2 +008900 04 FILLER PICTURE X. SG2014.2 +009000 03 FILLER PIC X(50) VALUE SPACE. SG2014.2 +009100 01 CCVS-C-1. SG2014.2 +009200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG2014.2 +009300- "SS PARAGRAPH-NAME SG2014.2 +009400- " REMARKS". SG2014.2 +009500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG2014.2 +009600 01 CCVS-C-2. SG2014.2 +009700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2014.2 +009800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG2014.2 +009900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG2014.2 +010000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG2014.2 +010100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG2014.2 +010200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG2014.2 +010300 01 REC-CT PICTURE 99 VALUE ZERO. SG2014.2 +010400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG2014.2 +010500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG2014.2 +010600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG2014.2 +010700 01 PASS-COUNTER PIC 999 VALUE ZERO. SG2014.2 +010800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG2014.2 +010900 01 ERROR-HOLD PIC 999 VALUE ZERO. SG2014.2 +011000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG2014.2 +011100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG2014.2 +011200 01 CCVS-H-1. SG2014.2 +011300 02 FILLER PICTURE X(27) VALUE SPACE. SG2014.2 +011400 02 FILLER PICTURE X(67) VALUE SG2014.2 +011500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG2014.2 +011600- " SYSTEM". SG2014.2 +011700 02 FILLER PICTURE X(26) VALUE SPACE. SG2014.2 +011800 01 CCVS-H-2. SG2014.2 +011900 02 FILLER PICTURE X(52) VALUE IS SG2014.2 +012000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG2014.2 +012100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG2014.2 +012200 02 TEST-ID PICTURE IS X(9). SG2014.2 +012300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG2014.2 +012400 01 CCVS-H-3. SG2014.2 +012500 02 FILLER PICTURE X(34) VALUE SG2014.2 +012600 " FOR OFFICIAL USE ONLY ". SG2014.2 +012700 02 FILLER PICTURE X(58) VALUE SG2014.2 +012800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG2014.2 +012900 02 FILLER PICTURE X(28) VALUE SG2014.2 +013000 " COPYRIGHT 1974 ". SG2014.2 +013100 01 CCVS-E-1. SG2014.2 +013200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG2014.2 +013300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG2014.2 +013400 02 ID-AGAIN PICTURE IS X(9). SG2014.2 +013500 02 FILLER PICTURE X(45) VALUE IS SG2014.2 +013600 " NTIS DISTRIBUTION COBOL 74". SG2014.2 +013700 01 CCVS-E-2. SG2014.2 +013800 02 FILLER PICTURE X(31) VALUE SG2014.2 +013900 SPACE. SG2014.2 +014000 02 FILLER PICTURE X(21) VALUE SPACE. SG2014.2 +014100 02 CCVS-E-2-2. SG2014.2 +014200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG2014.2 +014300 03 FILLER PICTURE IS X VALUE IS SPACE. SG2014.2 +014400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG2014.2 +014500 01 CCVS-E-3. SG2014.2 +014600 02 FILLER PICTURE X(22) VALUE SG2014.2 +014700 " FOR OFFICIAL USE ONLY". SG2014.2 +014800 02 FILLER PICTURE X(12) VALUE SPACE. SG2014.2 +014900 02 FILLER PICTURE X(58) VALUE SG2014.2 +015000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG2014.2 +015100 02 FILLER PICTURE X(13) VALUE SPACE. SG2014.2 +015200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG2014.2 +015300 01 CCVS-E-4. SG2014.2 +015400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG2014.2 +015500 02 FILLER PIC XXXX VALUE " OF ". SG2014.2 +015600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG2014.2 +015700 02 FILLER PIC X(40) VALUE SG2014.2 +015800 " TESTS WERE EXECUTED SUCCESSFULLY". SG2014.2 +015900 01 XXINFO. SG2014.2 +016000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG2014.2 +016100 02 INFO-TEXT. SG2014.2 +016200 04 FILLER PIC X(20) VALUE SPACE. SG2014.2 +016300 04 XXCOMPUTED PIC X(20). SG2014.2 +016400 04 FILLER PIC X(5) VALUE SPACE. SG2014.2 +016500 04 XXCORRECT PIC X(20). SG2014.2 +016600 01 HYPHEN-LINE. SG2014.2 +016700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2014.2 +016800 02 FILLER PICTURE IS X(65) VALUE IS "************************SG2014.2 +016900- "*****************************************". SG2014.2 +017000 02 FILLER PICTURE IS X(54) VALUE IS "************************SG2014.2 +017100- "******************************". SG2014.2 +017200 01 CCVS-PGM-ID PIC X(6) VALUE SG2014.2 +017300 "SG201A". SG2014.2 +017400 PROCEDURE DIVISION. SG2014.2 +017500 HOUSEKEEPING SECTION 50. SG2014.2 +017600 PARAGRAPH-1. SG2014.2 +017700 PERFORM CCVS1. SG2014.2 +017800 GO TO SEG-TEST-1. SG2014.2 +017900 CCVS1 SECTION. SG2014.2 +018000 OPEN-FILES. SG2014.2 +018100 OPEN OUTPUT PRINT-FILE. SG2014.2 +018200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG2014.2 +018300 MOVE SPACE TO TEST-RESULTS. SG2014.2 +018400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG2014.2 +018500 GO TO CCVS1-EXIT. SG2014.2 +018600 CLOSE-FILES. SG2014.2 +018700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG2014.2 +018800 TERMINATE-CCVS. SG2014.2 +018900*S EXIT PROGRAM. SG2014.2 +019000*SERMINATE-CALL. SG2014.2 +019100 STOP RUN. SG2014.2 +019200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2014.2 +019300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2014.2 +019400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2014.2 +019500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2014.2 +019600 MOVE "****TEST DELETED****" TO RE-MARK. SG2014.2 +019700 PRINT-DETAIL. SG2014.2 +019800 IF REC-CT NOT EQUAL TO ZERO SG2014.2 +019900 MOVE "." TO PARDOT-X SG2014.2 +020000 MOVE REC-CT TO DOTVALUE. SG2014.2 +020100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG2014.2 +020200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG2014.2 +020300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG2014.2 +020400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG2014.2 +020500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2014.2 +020600 MOVE SPACE TO CORRECT-X. SG2014.2 +020700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2014.2 +020800 MOVE SPACE TO RE-MARK. SG2014.2 +020900 HEAD-ROUTINE. SG2014.2 +021000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +021100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG2014.2 +021200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG2014.2 +021300 COLUMN-NAMES-ROUTINE. SG2014.2 +021400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +021500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +021600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +021700 END-ROUTINE. SG2014.2 +021800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG2014.2 +021900 END-RTN-EXIT. SG2014.2 +022000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +022100 END-ROUTINE-1. SG2014.2 +022200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG2014.2 +022300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG2014.2 +022400 ADD PASS-COUNTER TO ERROR-HOLD. SG2014.2 +022500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG2014.2 +022600 MOVE PASS-COUNTER TO CCVS-E-4-1. SG2014.2 +022700 MOVE ERROR-HOLD TO CCVS-E-4-2. SG2014.2 +022800 MOVE CCVS-E-4 TO CCVS-E-2-2. SG2014.2 +022900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG2014.2 +023000 END-ROUTINE-12. SG2014.2 +023100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG2014.2 +023200 IF ERROR-COUNTER IS EQUAL TO ZERO SG2014.2 +023300 MOVE "NO " TO ERROR-TOTAL SG2014.2 +023400 ELSE SG2014.2 +023500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG2014.2 +023600 MOVE CCVS-E-2 TO DUMMY-RECORD. SG2014.2 +023700 PERFORM WRITE-LINE. SG2014.2 +023800 END-ROUTINE-13. SG2014.2 +023900 IF DELETE-CNT IS EQUAL TO ZERO SG2014.2 +024000 MOVE "NO " TO ERROR-TOTAL ELSE SG2014.2 +024100 MOVE DELETE-CNT TO ERROR-TOTAL. SG2014.2 +024200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG2014.2 +024300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +024400 IF INSPECT-COUNTER EQUAL TO ZERO SG2014.2 +024500 MOVE "NO " TO ERROR-TOTAL SG2014.2 +024600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG2014.2 +024700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG2014.2 +024800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +024900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2014.2 +025000 WRITE-LINE. SG2014.2 +025100 ADD 1 TO RECORD-COUNT. SG2014.2 +025200 IF RECORD-COUNT GREATER 50 SG2014.2 +025300 MOVE DUMMY-RECORD TO DUMMY-HOLD SG2014.2 +025400 MOVE SPACE TO DUMMY-RECORD SG2014.2 +025500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2014.2 +025600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG2014.2 +025700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG2014.2 +025800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG2014.2 +025900 MOVE DUMMY-HOLD TO DUMMY-RECORD SG2014.2 +026000 MOVE ZERO TO RECORD-COUNT. SG2014.2 +026100 PERFORM WRT-LN. SG2014.2 +026200 WRT-LN. SG2014.2 +026300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2014.2 +026400 MOVE SPACE TO DUMMY-RECORD. SG2014.2 +026500 BLANK-LINE-PRINT. SG2014.2 +026600 PERFORM WRT-LN. SG2014.2 +026700 FAIL-ROUTINE. SG2014.2 +026800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2014.2 +026900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2014.2 +027000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2014.2 +027100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +027200 GO TO FAIL-ROUTINE-EX. SG2014.2 +027300 FAIL-ROUTINE-WRITE. SG2014.2 +027400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG2014.2 +027500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG2014.2 +027600 FAIL-ROUTINE-EX. EXIT. SG2014.2 +027700 BAIL-OUT. SG2014.2 +027800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG2014.2 +027900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG2014.2 +028000 BAIL-OUT-WRITE. SG2014.2 +028100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2014.2 +028200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2014.2 +028300 BAIL-OUT-EX. EXIT. SG2014.2 +028400 CCVS1-EXIT. SG2014.2 +028500 EXIT. SG2014.2 +028600 RUN-THE-TESTS SECTION. SG2014.2 +028700 SEG-TEST-1. SG2014.2 +028800 MOVE SPACE TO TEST-CHECK. SG2014.2 +028900 PERFORM 00. SG2014.2 +029000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +029100 PERFORM PASS SG2014.2 +029200 GO TO SEG-WRITE-1. SG2014.2 +029300 MOVE SPACE TO COMPUTED-A. SG2014.2 +029400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +029500 PERFORM FAIL. SG2014.2 +029600 GO TO SEG-WRITE-1. SG2014.2 +029700 SEG-DELETE-1. SG2014.2 +029800 PERFORM DE-LETE. SG2014.2 +029900 SEG-WRITE-1. SG2014.2 +030000 MOVE "SEGMENT-LIMIT" TO FEATURE. SG2014.2 +030100 MOVE "SEG-TEST-1 " TO PAR-NAME. SG2014.2 +030200 PERFORM PRINT-DETAIL. SG2014.2 +030300 SEG-TEST-2. SG2014.2 +030400 MOVE SPACE TO TEST-CHECK. SG2014.2 +030500 PERFORM 30. SG2014.2 +030600 PERFORM 30. SG2014.2 +030700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +030800 PERFORM PASS SG2014.2 +030900 GO TO SEG-WRITE-2. SG2014.2 +031000 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +031100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +031200 PERFORM FAIL. SG2014.2 +031300 GO TO SEG-WRITE-2. SG2014.2 +031400 SEG-DELETE-2. SG2014.2 +031500 PERFORM DE-LETE. SG2014.2 +031600 SEG-WRITE-2. SG2014.2 +031700 MOVE "SEG-TEST-2 " TO PAR-NAME. SG2014.2 +031800 PERFORM PRINT-DETAIL. SG2014.2 +031900 SEG-TEST-3. SG2014.2 +032000 MOVE SPACE TO TEST-CHECK. SG2014.2 +032100 PERFORM 31. SG2014.2 +032200 PERFORM 31. SG2014.2 +032300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +032400 PERFORM PASS SG2014.2 +032500 GO TO SEG-WRITE-3. SG2014.2 +032600 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +032700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +032800 PERFORM FAIL. SG2014.2 +032900 GO TO SEG-WRITE-3. SG2014.2 +033000 SEG-DELETE-3. SG2014.2 +033100 PERFORM DE-LETE. SG2014.2 +033200 SEG-WRITE-3. SG2014.2 +033300 MOVE "SEG-TEST-3 " TO PAR-NAME. SG2014.2 +033400 PERFORM PRINT-DETAIL. SG2014.2 +033500 SEG-TEST-4. SG2014.2 +033600 MOVE SPACE TO TEST-CHECK. SG2014.2 +033700 PERFORM 32. SG2014.2 +033800 PERFORM 32. SG2014.2 +033900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +034000 PERFORM PASS SG2014.2 +034100 GO TO SEG-WRITE-4. SG2014.2 +034200 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +034300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +034400 PERFORM FAIL. SG2014.2 +034500 GO TO SEG-WRITE-4. SG2014.2 +034600 SEG-DELETE-4. SG2014.2 +034700 PERFORM DE-LETE. SG2014.2 +034800 SEG-WRITE-4. SG2014.2 +034900 MOVE "SEG-TEST-4 " TO PAR-NAME. SG2014.2 +035000 PERFORM PRINT-DETAIL. SG2014.2 +035100 SEG-TEST-5. SG2014.2 +035200 MOVE SPACE TO TEST-CHECK. SG2014.2 +035300 PERFORM 33. SG2014.2 +035400 PERFORM 33. SG2014.2 +035500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +035600 PERFORM PASS SG2014.2 +035700 GO TO SEG-WRITE-5. SG2014.2 +035800 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +035900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +036000 PERFORM FAIL. SG2014.2 +036100 GO TO SEG-WRITE-5. SG2014.2 +036200 SEG-DELETE-5. SG2014.2 +036300 PERFORM DE-LETE. SG2014.2 +036400 SEG-WRITE-5. SG2014.2 +036500 MOVE "SEG-TEST-5 " TO PAR-NAME. SG2014.2 +036600 PERFORM PRINT-DETAIL. SG2014.2 +036700 SEG-TEST-6. SG2014.2 +036800 MOVE SPACE TO TEST-CHECK. SG2014.2 +036900 PERFORM 34. SG2014.2 +037000 PERFORM 34. SG2014.2 +037100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +037200 PERFORM PASS SG2014.2 +037300 GO TO SEG-WRITE-6. SG2014.2 +037400 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +037500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +037600 PERFORM FAIL. SG2014.2 +037700 GO TO SEG-WRITE-6. SG2014.2 +037800 SEG-DELETE-6. SG2014.2 +037900 PERFORM DE-LETE. SG2014.2 +038000 SEG-WRITE-6. SG2014.2 +038100 MOVE "SEG-TEST-6 " TO PAR-NAME. SG2014.2 +038200 PERFORM PRINT-DETAIL. SG2014.2 +038300 SEG-TEST-7. SG2014.2 +038400 MOVE SPACE TO TEST-CHECK. SG2014.2 +038500 PERFORM 35. SG2014.2 +038600 PERFORM 35. SG2014.2 +038700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +038800 PERFORM PASS SG2014.2 +038900 GO TO SEG-WRITE-7. SG2014.2 +039000 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +039100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +039200 PERFORM FAIL. SG2014.2 +039300 GO TO SEG-WRITE-7. SG2014.2 +039400 SEG-DELETE-7. SG2014.2 +039500 PERFORM DE-LETE. SG2014.2 +039600 SEG-WRITE-7. SG2014.2 +039700 MOVE "SEG-TEST-7 " TO PAR-NAME. SG2014.2 +039800 PERFORM PRINT-DETAIL. SG2014.2 +039900 SEG-TEST-8. SG2014.2 +040000 MOVE SPACE TO TEST-CHECK. SG2014.2 +040100 PERFORM 36. SG2014.2 +040200 PERFORM 36. SG2014.2 +040300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +040400 PERFORM PASS SG2014.2 +040500 GO TO SEG-WRITE-8. SG2014.2 +040600 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +040700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +040800 PERFORM FAIL. SG2014.2 +040900 GO TO SEG-WRITE-8. SG2014.2 +041000 SEG-DELETE-8. SG2014.2 +041100 PERFORM DE-LETE. SG2014.2 +041200 SEG-WRITE-8. SG2014.2 +041300 MOVE "SEG-TEST-8 " TO PAR-NAME. SG2014.2 +041400 PERFORM PRINT-DETAIL. SG2014.2 +041500 SEG-TEST-9. SG2014.2 +041600 MOVE SPACE TO TEST-CHECK. SG2014.2 +041700 PERFORM 37. SG2014.2 +041800 PERFORM 37. SG2014.2 +041900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +042000 PERFORM PASS SG2014.2 +042100 GO TO SEG-WRITE-9. SG2014.2 +042200 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +042300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +042400 PERFORM FAIL. SG2014.2 +042500 GO TO SEG-WRITE-9. SG2014.2 +042600 SEG-DELETE-9. SG2014.2 +042700 PERFORM DE-LETE. SG2014.2 +042800 SEG-WRITE-9. SG2014.2 +042900 MOVE "SEG-TEST-9 " TO PAR-NAME. SG2014.2 +043000 PERFORM PRINT-DETAIL. SG2014.2 +043100 SEG-TEST-10. SG2014.2 +043200 MOVE SPACE TO TEST-CHECK. SG2014.2 +043300 PERFORM 38. SG2014.2 +043400 PERFORM 38. SG2014.2 +043500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +043600 PERFORM PASS SG2014.2 +043700 GO TO SEG-WRITE-10. SG2014.2 +043800 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +043900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +044000 PERFORM FAIL. SG2014.2 +044100 GO TO SEG-WRITE-10. SG2014.2 +044200 SEG-DELETE-10. SG2014.2 +044300 PERFORM DE-LETE. SG2014.2 +044400 SEG-WRITE-10. SG2014.2 +044500 MOVE "SEG-TEST-10 " TO PAR-NAME. SG2014.2 +044600 PERFORM PRINT-DETAIL. SG2014.2 +044700 SEG-TEST-11. SG2014.2 +044800 MOVE SPACE TO TEST-CHECK. SG2014.2 +044900 PERFORM 39. SG2014.2 +045000 PERFORM 39. SG2014.2 +045100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +045200 PERFORM PASS SG2014.2 +045300 GO TO SEG-WRITE-11. SG2014.2 +045400 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +045500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +045600 PERFORM FAIL. SG2014.2 +045700 GO TO SEG-WRITE-11. SG2014.2 +045800 SEG-DELETE-11. SG2014.2 +045900 PERFORM DE-LETE. SG2014.2 +046000 SEG-WRITE-11. SG2014.2 +046100 MOVE "SEG-TEST-11 " TO PAR-NAME. SG2014.2 +046200 PERFORM PRINT-DETAIL. SG2014.2 +046300 SEG-TEST-12. SG2014.2 +046400 MOVE SPACE TO TEST-CHECK. SG2014.2 +046500 PERFORM 40. SG2014.2 +046600 PERFORM 40. SG2014.2 +046700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +046800 PERFORM PASS SG2014.2 +046900 GO TO SEG-WRITE-12. SG2014.2 +047000 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +047100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +047200 PERFORM FAIL. SG2014.2 +047300 GO TO SEG-WRITE-12. SG2014.2 +047400 SEG-DELETE-12. SG2014.2 +047500 PERFORM DE-LETE. SG2014.2 +047600 SEG-WRITE-12. SG2014.2 +047700 MOVE "SEG-TEST-12 " TO PAR-NAME. SG2014.2 +047800 PERFORM PRINT-DETAIL. SG2014.2 +047900 SEG-TEST-13. SG2014.2 +048000 MOVE SPACE TO TEST-CHECK. SG2014.2 +048100 PERFORM 41. SG2014.2 +048200 PERFORM 41. SG2014.2 +048300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +048400 PERFORM PASS SG2014.2 +048500 GO TO SEG-WRITE-13. SG2014.2 +048600 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +048700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +048800 PERFORM FAIL. SG2014.2 +048900 GO TO SEG-WRITE-13. SG2014.2 +049000 SEG-DELETE-13. SG2014.2 +049100 PERFORM DE-LETE. SG2014.2 +049200 SEG-WRITE-13. SG2014.2 +049300 MOVE "SEG-TEST-13 " TO PAR-NAME. SG2014.2 +049400 PERFORM PRINT-DETAIL. SG2014.2 +049500 SEG-TEST-14. SG2014.2 +049600 MOVE SPACE TO TEST-CHECK. SG2014.2 +049700 PERFORM 42. SG2014.2 +049800 PERFORM 42. SG2014.2 +049900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +050000 PERFORM PASS SG2014.2 +050100 GO TO SEG-WRITE-14. SG2014.2 +050200 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +050300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +050400 PERFORM FAIL. SG2014.2 +050500 GO TO SEG-WRITE-14. SG2014.2 +050600 SEG-DELETE-14. SG2014.2 +050700 PERFORM DE-LETE. SG2014.2 +050800 SEG-WRITE-14. SG2014.2 +050900 MOVE "SEG-TEST-14 " TO PAR-NAME. SG2014.2 +051000 PERFORM PRINT-DETAIL. SG2014.2 +051100 SEG-TEST-15. SG2014.2 +051200 MOVE SPACE TO TEST-CHECK. SG2014.2 +051300 PERFORM 43. SG2014.2 +051400 PERFORM 43. SG2014.2 +051500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +051600 PERFORM PASS SG2014.2 +051700 GO TO SEG-WRITE-15. SG2014.2 +051800 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +051900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +052000 PERFORM FAIL. SG2014.2 +052100 GO TO SEG-WRITE-15. SG2014.2 +052200 SEG-DELETE-15. SG2014.2 +052300 PERFORM DE-LETE. SG2014.2 +052400 SEG-WRITE-15. SG2014.2 +052500 MOVE "SEG-TEST-15 " TO PAR-NAME. SG2014.2 +052600 PERFORM PRINT-DETAIL. SG2014.2 +052700 SEG-TEST-16. SG2014.2 +052800 MOVE SPACE TO TEST-CHECK. SG2014.2 +052900 PERFORM 44. SG2014.2 +053000 PERFORM 44. SG2014.2 +053100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +053200 PERFORM PASS SG2014.2 +053300 GO TO SEG-WRITE-16. SG2014.2 +053400 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +053500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +053600 PERFORM FAIL. SG2014.2 +053700 GO TO SEG-WRITE-16. SG2014.2 +053800 SEG-DELETE-16. SG2014.2 +053900 PERFORM DE-LETE. SG2014.2 +054000 SEG-WRITE-16. SG2014.2 +054100 MOVE "SEG-TEST-16 " TO PAR-NAME. SG2014.2 +054200 PERFORM PRINT-DETAIL. SG2014.2 +054300 SEG-TEST-17. SG2014.2 +054400 MOVE SPACE TO TEST-CHECK. SG2014.2 +054500 PERFORM 45. SG2014.2 +054600 PERFORM 45. SG2014.2 +054700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +054800 PERFORM PASS SG2014.2 +054900 GO TO SEG-WRITE-17. SG2014.2 +055000 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +055100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +055200 PERFORM FAIL. SG2014.2 +055300 GO TO SEG-WRITE-17. SG2014.2 +055400 SEG-DELETE-17. SG2014.2 +055500 PERFORM DE-LETE. SG2014.2 +055600 SEG-WRITE-17. SG2014.2 +055700 MOVE "SEG-TEST-17 " TO PAR-NAME. SG2014.2 +055800 PERFORM PRINT-DETAIL. SG2014.2 +055900 SEG-TEST-18. SG2014.2 +056000 MOVE SPACE TO TEST-CHECK. SG2014.2 +056100 PERFORM 46. SG2014.2 +056200 PERFORM 46. SG2014.2 +056300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +056400 PERFORM PASS SG2014.2 +056500 GO TO SEG-WRITE-18. SG2014.2 +056600 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +056700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +056800 PERFORM FAIL. SG2014.2 +056900 GO TO SEG-WRITE-18. SG2014.2 +057000 SEG-DELETE-18. SG2014.2 +057100 PERFORM DE-LETE. SG2014.2 +057200 SEG-WRITE-18. SG2014.2 +057300 MOVE "SEG-TEST-18 " TO PAR-NAME. SG2014.2 +057400 PERFORM PRINT-DETAIL. SG2014.2 +057500 SEG-TEST-19. SG2014.2 +057600 MOVE SPACE TO TEST-CHECK. SG2014.2 +057700 PERFORM 47. SG2014.2 +057800 PERFORM 47. SG2014.2 +057900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +058000 PERFORM PASS SG2014.2 +058100 GO TO SEG-WRITE-19. SG2014.2 +058200 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +058300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +058400 PERFORM FAIL. SG2014.2 +058500 GO TO SEG-WRITE-19. SG2014.2 +058600 SEG-DELETE-19. SG2014.2 +058700 PERFORM DE-LETE. SG2014.2 +058800 SEG-WRITE-19. SG2014.2 +058900 MOVE "SEG-TEST-19 " TO PAR-NAME. SG2014.2 +059000 PERFORM PRINT-DETAIL. SG2014.2 +059100 SEG-TEST-20. SG2014.2 +059200 MOVE SPACE TO TEST-CHECK. SG2014.2 +059300 PERFORM 48. SG2014.2 +059400 PERFORM 48. SG2014.2 +059500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +059600 PERFORM PASS SG2014.2 +059700 GO TO SEG-WRITE-20. SG2014.2 +059800 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +059900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +060000 PERFORM FAIL. SG2014.2 +060100 GO TO SEG-WRITE-20. SG2014.2 +060200 SEG-DELETE-20. SG2014.2 +060300 PERFORM DE-LETE. SG2014.2 +060400 SEG-WRITE-20. SG2014.2 +060500 MOVE "SEG-TEST-20 " TO PAR-NAME. SG2014.2 +060600 PERFORM PRINT-DETAIL. SG2014.2 +060700 SEG-TEST-21. SG2014.2 +060800 MOVE SPACE TO TEST-CHECK. SG2014.2 +060900 PERFORM 49. SG2014.2 +061000 PERFORM 49. SG2014.2 +061100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +061200 PERFORM PASS SG2014.2 +061300 GO TO SEG-WRITE-21. SG2014.2 +061400 MOVE TEST-CHECK TO COMPUTED-A. SG2014.2 +061500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +061600 PERFORM FAIL. SG2014.2 +061700 GO TO SEG-WRITE-21. SG2014.2 +061800 SEG-DELETE-21. SG2014.2 +061900 PERFORM DE-LETE. SG2014.2 +062000 SEG-WRITE-21. SG2014.2 +062100 MOVE "SEG-TEST-21 " TO PAR-NAME. SG2014.2 +062200 PERFORM PRINT-DETAIL. SG2014.2 +062300 SEG-TEST-22. SG2014.2 +062400 MOVE SPACE TO TEST-CHECK. SG2014.2 +062500 PERFORM 50. SG2014.2 +062600 MOVE SPACE TO TEST-CHECK. SG2014.2 +062700 PERFORM 50. SG2014.2 +062800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +062900 PERFORM PASS SG2014.2 +063000 GO TO SEG-WRITE-22. SG2014.2 +063100 MOVE SPACE TO COMPUTED-A. SG2014.2 +063200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +063300 PERFORM FAIL. SG2014.2 +063400 GO TO SEG-WRITE-22. SG2014.2 +063500 SEG-DELETE-22. SG2014.2 +063600 PERFORM DE-LETE. SG2014.2 +063700 SEG-WRITE-22. SG2014.2 +063800 MOVE "SEG-TEST-22 " TO PAR-NAME. SG2014.2 +063900 PERFORM PRINT-DETAIL. SG2014.2 +064000 SEG-TEST-23. SG2014.2 +064100 MOVE SPACE TO TEST-CHECK. SG2014.2 +064200 PERFORM 51. SG2014.2 +064300 MOVE SPACE TO TEST-CHECK. SG2014.2 +064400 PERFORM 51. SG2014.2 +064500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +064600 PERFORM PASS SG2014.2 +064700 GO TO SEG-WRITE-23. SG2014.2 +064800 MOVE SPACE TO COMPUTED-A. SG2014.2 +064900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +065000 PERFORM FAIL. SG2014.2 +065100 GO TO SEG-WRITE-23. SG2014.2 +065200 SEG-DELETE-23. SG2014.2 +065300 PERFORM DE-LETE. SG2014.2 +065400 SEG-WRITE-23. SG2014.2 +065500 MOVE "SEG-TEST-23 " TO PAR-NAME. SG2014.2 +065600 PERFORM PRINT-DETAIL. SG2014.2 +065700 SEG-TEST-24. SG2014.2 +065800 MOVE SPACE TO TEST-CHECK. SG2014.2 +065900 PERFORM 52. SG2014.2 +066000 MOVE SPACE TO TEST-CHECK. SG2014.2 +066100 PERFORM 52. SG2014.2 +066200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +066300 PERFORM PASS SG2014.2 +066400 GO TO SEG-WRITE-24. SG2014.2 +066500 MOVE SPACE TO COMPUTED-A. SG2014.2 +066600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +066700 PERFORM FAIL. SG2014.2 +066800 GO TO SEG-WRITE-24. SG2014.2 +066900 SEG-DELETE-24. SG2014.2 +067000 PERFORM DE-LETE. SG2014.2 +067100 SEG-WRITE-24. SG2014.2 +067200 MOVE "SEG-TEST-24 " TO PAR-NAME. SG2014.2 +067300 PERFORM PRINT-DETAIL. SG2014.2 +067400 SEG-TEST-25. SG2014.2 +067500 MOVE SPACE TO TEST-CHECK. SG2014.2 +067600 PERFORM 53. SG2014.2 +067700 MOVE SPACE TO TEST-CHECK. SG2014.2 +067800 PERFORM 53. SG2014.2 +067900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +068000 PERFORM PASS SG2014.2 +068100 GO TO SEG-WRITE-25. SG2014.2 +068200 MOVE SPACE TO COMPUTED-A. SG2014.2 +068300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +068400 PERFORM FAIL. SG2014.2 +068500 GO TO SEG-WRITE-25. SG2014.2 +068600 SEG-DELETE-25. SG2014.2 +068700 PERFORM DE-LETE. SG2014.2 +068800 SEG-WRITE-25. SG2014.2 +068900 MOVE "SEG-TEST-25 " TO PAR-NAME. SG2014.2 +069000 PERFORM PRINT-DETAIL. SG2014.2 +069100 SEG-TEST-26. SG2014.2 +069200 MOVE SPACE TO TEST-CHECK. SG2014.2 +069300 PERFORM 54. SG2014.2 +069400 MOVE SPACE TO TEST-CHECK. SG2014.2 +069500 PERFORM 54. SG2014.2 +069600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +069700 PERFORM PASS SG2014.2 +069800 GO TO SEG-WRITE-26. SG2014.2 +069900 MOVE SPACE TO COMPUTED-A. SG2014.2 +070000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +070100 PERFORM FAIL. SG2014.2 +070200 GO TO SEG-WRITE-26. SG2014.2 +070300 SEG-DELETE-26. SG2014.2 +070400 PERFORM DE-LETE. SG2014.2 +070500 SEG-WRITE-26. SG2014.2 +070600 MOVE "SEG-TEST-26 " TO PAR-NAME. SG2014.2 +070700 PERFORM PRINT-DETAIL. SG2014.2 +070800 SEG-TEST-27. SG2014.2 +070900 MOVE SPACE TO TEST-CHECK. SG2014.2 +071000 PERFORM 55. SG2014.2 +071100 MOVE SPACE TO TEST-CHECK. SG2014.2 +071200 PERFORM 55. SG2014.2 +071300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +071400 PERFORM PASS SG2014.2 +071500 GO TO SEG-WRITE-27. SG2014.2 +071600 MOVE SPACE TO COMPUTED-A. SG2014.2 +071700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +071800 PERFORM FAIL. SG2014.2 +071900 GO TO SEG-WRITE-27. SG2014.2 +072000 SEG-DELETE-27. SG2014.2 +072100 PERFORM DE-LETE. SG2014.2 +072200 SEG-WRITE-27. SG2014.2 +072300 MOVE "SEG-TEST-27 " TO PAR-NAME. SG2014.2 +072400 PERFORM PRINT-DETAIL. SG2014.2 +072500 SEG-TEST-28. SG2014.2 +072600 MOVE SPACE TO TEST-CHECK. SG2014.2 +072700 PERFORM 56. SG2014.2 +072800 MOVE SPACE TO TEST-CHECK. SG2014.2 +072900 PERFORM 56. SG2014.2 +073000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +073100 PERFORM PASS SG2014.2 +073200 GO TO SEG-WRITE-28. SG2014.2 +073300 MOVE SPACE TO COMPUTED-A. SG2014.2 +073400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +073500 PERFORM FAIL. SG2014.2 +073600 GO TO SEG-WRITE-28. SG2014.2 +073700 SEG-DELETE-28. SG2014.2 +073800 PERFORM DE-LETE. SG2014.2 +073900 SEG-WRITE-28. SG2014.2 +074000 MOVE "SEG-TEST-28 " TO PAR-NAME. SG2014.2 +074100 PERFORM PRINT-DETAIL. SG2014.2 +074200 SEG-TEST-29. SG2014.2 +074300 MOVE SPACE TO TEST-CHECK. SG2014.2 +074400 PERFORM 57. SG2014.2 +074500 MOVE SPACE TO TEST-CHECK. SG2014.2 +074600 PERFORM 57. SG2014.2 +074700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +074800 PERFORM PASS SG2014.2 +074900 GO TO SEG-WRITE-29. SG2014.2 +075000 MOVE SPACE TO COMPUTED-A. SG2014.2 +075100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +075200 PERFORM FAIL. SG2014.2 +075300 GO TO SEG-WRITE-29. SG2014.2 +075400 SEG-DELETE-29. SG2014.2 +075500 PERFORM DE-LETE. SG2014.2 +075600 SEG-WRITE-29. SG2014.2 +075700 MOVE "SEG-TEST-29 " TO PAR-NAME. SG2014.2 +075800 PERFORM PRINT-DETAIL. SG2014.2 +075900 SEG-TEST-30. SG2014.2 +076000 MOVE SPACE TO TEST-CHECK. SG2014.2 +076100 PERFORM 58. SG2014.2 +076200 MOVE SPACE TO TEST-CHECK. SG2014.2 +076300 PERFORM 58. SG2014.2 +076400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +076500 PERFORM PASS SG2014.2 +076600 GO TO SEG-WRITE-30. SG2014.2 +076700 MOVE SPACE TO COMPUTED-A. SG2014.2 +076800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +076900 PERFORM FAIL. SG2014.2 +077000 GO TO SEG-WRITE-30. SG2014.2 +077100 SEG-DELETE-30. SG2014.2 +077200 PERFORM DE-LETE. SG2014.2 +077300 SEG-WRITE-30. SG2014.2 +077400 MOVE "SEG-TEST-30 " TO PAR-NAME. SG2014.2 +077500 PERFORM PRINT-DETAIL. SG2014.2 +077600 SEG-TEST-31. SG2014.2 +077700 MOVE SPACE TO TEST-CHECK. SG2014.2 +077800 PERFORM 59. SG2014.2 +077900 MOVE SPACE TO TEST-CHECK. SG2014.2 +078000 PERFORM 59. SG2014.2 +078100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +078200 PERFORM PASS SG2014.2 +078300 GO TO SEG-WRITE-31. SG2014.2 +078400 MOVE SPACE TO COMPUTED-A. SG2014.2 +078500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +078600 PERFORM FAIL. SG2014.2 +078700 GO TO SEG-WRITE-31. SG2014.2 +078800 SEG-DELETE-31. SG2014.2 +078900 PERFORM DE-LETE. SG2014.2 +079000 SEG-WRITE-31. SG2014.2 +079100 MOVE "SEG-TEST-31 " TO PAR-NAME. SG2014.2 +079200 PERFORM PRINT-DETAIL. SG2014.2 +079300 SEG-TEST-32. SG2014.2 +079400 MOVE SPACE TO TEST-CHECK. SG2014.2 +079500 PERFORM 60. SG2014.2 +079600 MOVE SPACE TO TEST-CHECK. SG2014.2 +079700 PERFORM 60. SG2014.2 +079800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +079900 PERFORM PASS SG2014.2 +080000 GO TO SEG-WRITE-32. SG2014.2 +080100 MOVE SPACE TO COMPUTED-A. SG2014.2 +080200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +080300 PERFORM FAIL. SG2014.2 +080400 GO TO SEG-WRITE-32. SG2014.2 +080500 SEG-DELETE-32. SG2014.2 +080600 PERFORM DE-LETE. SG2014.2 +080700 SEG-WRITE-32. SG2014.2 +080800 MOVE "SEG-TEST-32 " TO PAR-NAME. SG2014.2 +080900 PERFORM PRINT-DETAIL. SG2014.2 +081000 SEG-TEST-33. SG2014.2 +081100 MOVE SPACE TO TEST-CHECK. SG2014.2 +081200 PERFORM 60. SG2014.2 +081300 MOVE SPACE TO TEST-CHECK. SG2014.2 +081400 PERFORM 60. SG2014.2 +081500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +081600 PERFORM PASS SG2014.2 +081700 GO TO SEG-WRITE-33. SG2014.2 +081800 MOVE SPACE TO COMPUTED-A. SG2014.2 +081900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +082000 PERFORM FAIL. SG2014.2 +082100 GO TO SEG-WRITE-33. SG2014.2 +082200 SEG-DELETE-33. SG2014.2 +082300 PERFORM DE-LETE. SG2014.2 +082400 SEG-WRITE-33. SG2014.2 +082500 MOVE "SEG-TEST-33 " TO PAR-NAME. SG2014.2 +082600 PERFORM PRINT-DETAIL. SG2014.2 +082700 SEG-TEST-34. SG2014.2 +082800 MOVE SPACE TO TEST-CHECK. SG2014.2 +082900 PERFORM 59. SG2014.2 +083000 MOVE SPACE TO TEST-CHECK. SG2014.2 +083100 PERFORM 59. SG2014.2 +083200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +083300 PERFORM PASS SG2014.2 +083400 GO TO SEG-WRITE-34. SG2014.2 +083500 MOVE SPACE TO COMPUTED-A. SG2014.2 +083600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +083700 PERFORM FAIL. SG2014.2 +083800 GO TO SEG-WRITE-34. SG2014.2 +083900 SEG-DELETE-34. SG2014.2 +084000 PERFORM DE-LETE. SG2014.2 +084100 SEG-WRITE-34. SG2014.2 +084200 MOVE "SEG-TEST-34 " TO PAR-NAME. SG2014.2 +084300 PERFORM PRINT-DETAIL. SG2014.2 +084400 SEG-TEST-35. SG2014.2 +084500 MOVE SPACE TO TEST-CHECK. SG2014.2 +084600 PERFORM 58. SG2014.2 +084700 MOVE SPACE TO TEST-CHECK. SG2014.2 +084800 PERFORM 58. SG2014.2 +084900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +085000 PERFORM PASS SG2014.2 +085100 GO TO SEG-WRITE-35. SG2014.2 +085200 MOVE SPACE TO COMPUTED-A. SG2014.2 +085300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +085400 PERFORM FAIL. SG2014.2 +085500 GO TO SEG-WRITE-35. SG2014.2 +085600 SEG-DELETE-35. SG2014.2 +085700 PERFORM DE-LETE. SG2014.2 +085800 SEG-WRITE-35. SG2014.2 +085900 MOVE "SEG-TEST-35 " TO PAR-NAME. SG2014.2 +086000 PERFORM PRINT-DETAIL. SG2014.2 +086100 SEG-TEST-36. SG2014.2 +086200 MOVE SPACE TO TEST-CHECK. SG2014.2 +086300 PERFORM 57. SG2014.2 +086400 MOVE SPACE TO TEST-CHECK. SG2014.2 +086500 PERFORM 57. SG2014.2 +086600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +086700 PERFORM PASS SG2014.2 +086800 GO TO SEG-WRITE-36. SG2014.2 +086900 MOVE SPACE TO COMPUTED-A. SG2014.2 +087000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +087100 PERFORM FAIL. SG2014.2 +087200 GO TO SEG-WRITE-36. SG2014.2 +087300 SEG-DELETE-36. SG2014.2 +087400 PERFORM DE-LETE. SG2014.2 +087500 SEG-WRITE-36. SG2014.2 +087600 MOVE "SEG-TEST-36 " TO PAR-NAME. SG2014.2 +087700 PERFORM PRINT-DETAIL. SG2014.2 +087800 SEG-TEST-37. SG2014.2 +087900 MOVE SPACE TO TEST-CHECK. SG2014.2 +088000 PERFORM 56. SG2014.2 +088100 MOVE SPACE TO TEST-CHECK. SG2014.2 +088200 PERFORM 56. SG2014.2 +088300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +088400 PERFORM PASS SG2014.2 +088500 GO TO SEG-WRITE-37. SG2014.2 +088600 MOVE SPACE TO COMPUTED-A. SG2014.2 +088700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +088800 PERFORM FAIL. SG2014.2 +088900 GO TO SEG-WRITE-37. SG2014.2 +089000 SEG-DELETE-37. SG2014.2 +089100 PERFORM DE-LETE. SG2014.2 +089200 SEG-WRITE-37. SG2014.2 +089300 MOVE "SEG-TEST-37 " TO PAR-NAME. SG2014.2 +089400 PERFORM PRINT-DETAIL. SG2014.2 +089500 SEG-TEST-38. SG2014.2 +089600 MOVE SPACE TO TEST-CHECK. SG2014.2 +089700 PERFORM 55. SG2014.2 +089800 MOVE SPACE TO TEST-CHECK. SG2014.2 +089900 PERFORM 55. SG2014.2 +090000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +090100 PERFORM PASS SG2014.2 +090200 GO TO SEG-WRITE-38. SG2014.2 +090300 MOVE SPACE TO COMPUTED-A. SG2014.2 +090400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +090500 GO TO SEG-WRITE-38. SG2014.2 +090600 SEG-DELETE-38. SG2014.2 +090700 PERFORM DE-LETE. SG2014.2 +090800 SEG-WRITE-38. SG2014.2 +090900 MOVE "SEG-TEST-38 " TO PAR-NAME. SG2014.2 +091000 PERFORM PRINT-DETAIL. SG2014.2 +091100 SEG-TEST-39. SG2014.2 +091200 MOVE SPACE TO TEST-CHECK. SG2014.2 +091300 PERFORM 54. SG2014.2 +091400 MOVE SPACE TO TEST-CHECK. SG2014.2 +091500 PERFORM 54. SG2014.2 +091600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +091700 PERFORM PASS SG2014.2 +091800 GO TO SEG-WRITE-39. SG2014.2 +091900 MOVE SPACE TO COMPUTED-A. SG2014.2 +092000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +092100 PERFORM FAIL. SG2014.2 +092200 GO TO SEG-WRITE-39. SG2014.2 +092300 SEG-DELETE-39. SG2014.2 +092400 PERFORM DE-LETE. SG2014.2 +092500 SEG-WRITE-39. SG2014.2 +092600 MOVE "SEG-TEST-39 " TO PAR-NAME. SG2014.2 +092700 PERFORM PRINT-DETAIL. SG2014.2 +092800 SEG-TEST-40. SG2014.2 +092900 MOVE SPACE TO TEST-CHECK. SG2014.2 +093000 PERFORM 53. SG2014.2 +093100 MOVE SPACE TO TEST-CHECK. SG2014.2 +093200 PERFORM 53. SG2014.2 +093300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +093400 PERFORM PASS SG2014.2 +093500 GO TO SEG-WRITE-40. SG2014.2 +093600 MOVE SPACE TO COMPUTED-A. SG2014.2 +093700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +093800 PERFORM FAIL. SG2014.2 +093900 GO TO SEG-WRITE-40. SG2014.2 +094000 SEG-DELETE-40. SG2014.2 +094100 PERFORM DE-LETE. SG2014.2 +094200 SEG-WRITE-40. SG2014.2 +094300 MOVE "SEG-TEST-40 " TO PAR-NAME. SG2014.2 +094400 PERFORM PRINT-DETAIL. SG2014.2 +094500 SEG-TEST-41. SG2014.2 +094600 MOVE SPACE TO TEST-CHECK. SG2014.2 +094700 PERFORM 52. SG2014.2 +094800 MOVE SPACE TO TEST-CHECK. SG2014.2 +094900 PERFORM 52. SG2014.2 +095000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +095100 PERFORM PASS SG2014.2 +095200 GO TO SEG-WRITE-41. SG2014.2 +095300 MOVE SPACE TO COMPUTED-A. SG2014.2 +095400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +095500 PERFORM FAIL. SG2014.2 +095600 GO TO SEG-WRITE-41. SG2014.2 +095700 SEG-DELETE-41. SG2014.2 +095800 PERFORM DE-LETE. SG2014.2 +095900 SEG-WRITE-41. SG2014.2 +096000 MOVE "SEG-TEST-41 " TO PAR-NAME. SG2014.2 +096100 PERFORM PRINT-DETAIL. SG2014.2 +096200 SEG-TEST-42. SG2014.2 +096300 MOVE SPACE TO TEST-CHECK. SG2014.2 +096400 PERFORM 51. SG2014.2 +096500 MOVE SPACE TO TEST-CHECK. SG2014.2 +096600 PERFORM 51. SG2014.2 +096700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +096800 PERFORM PASS SG2014.2 +096900 GO TO SEG-WRITE-42. SG2014.2 +097000 MOVE SPACE TO COMPUTED-A. SG2014.2 +097100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +097200 PERFORM FAIL. SG2014.2 +097300 GO TO SEG-WRITE-42. SG2014.2 +097400 SEG-DELETE-42. SG2014.2 +097500 PERFORM DE-LETE. SG2014.2 +097600 SEG-WRITE-42. SG2014.2 +097700 MOVE "SEG-TEST-42 " TO PAR-NAME. SG2014.2 +097800 PERFORM PRINT-DETAIL. SG2014.2 +097900 SEG-TEST-43. SG2014.2 +098000 MOVE SPACE TO TEST-CHECK. SG2014.2 +098100 PERFORM 50. SG2014.2 +098200 MOVE SPACE TO TEST-CHECK. SG2014.2 +098300 PERFORM 50. SG2014.2 +098400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +098500 PERFORM PASS SG2014.2 +098600 GO TO SEG-WRITE-43. SG2014.2 +098700 MOVE SPACE TO COMPUTED-A. SG2014.2 +098800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +098900 PERFORM FAIL. SG2014.2 +099000 GO TO SEG-WRITE-43. SG2014.2 +099100 SEG-DELETE-43. SG2014.2 +099200 PERFORM DE-LETE. SG2014.2 +099300 SEG-WRITE-43. SG2014.2 +099400 MOVE "SEG-TEST-43 " TO PAR-NAME. SG2014.2 +099500 PERFORM PRINT-DETAIL. SG2014.2 +099600 SEG-TEST-44. SG2014.2 +099700 MOVE SPACE TO TEST-CHECK. SG2014.2 +099800 PERFORM 49. SG2014.2 +099900 MOVE SPACE TO TEST-CHECK. SG2014.2 +100000 PERFORM 49. SG2014.2 +100100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +100200 PERFORM PASS SG2014.2 +100300 GO TO SEG-WRITE-44. SG2014.2 +100400 MOVE SPACE TO COMPUTED-A. SG2014.2 +100500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +100600 PERFORM FAIL. SG2014.2 +100700 GO TO SEG-WRITE-44. SG2014.2 +100800 SEG-DELETE-44. SG2014.2 +100900 PERFORM DE-LETE. SG2014.2 +101000 SEG-WRITE-44. SG2014.2 +101100 MOVE "SEG-TEST-44 " TO PAR-NAME. SG2014.2 +101200 PERFORM PRINT-DETAIL. SG2014.2 +101300 SEG-TEST-45. SG2014.2 +101400 MOVE SPACE TO TEST-CHECK. SG2014.2 +101500 PERFORM 48. SG2014.2 +101600 MOVE SPACE TO TEST-CHECK. SG2014.2 +101700 PERFORM 48. SG2014.2 +101800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +101900 PERFORM PASS SG2014.2 +102000 GO TO SEG-WRITE-45. SG2014.2 +102100 MOVE SPACE TO COMPUTED-A. SG2014.2 +102200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +102300 PERFORM FAIL. SG2014.2 +102400 GO TO SEG-WRITE-45. SG2014.2 +102500 SEG-DELETE-45. SG2014.2 +102600 PERFORM DE-LETE. SG2014.2 +102700 SEG-WRITE-45. SG2014.2 +102800 MOVE "SEG-TEST-45 " TO PAR-NAME. SG2014.2 +102900 PERFORM PRINT-DETAIL. SG2014.2 +103000 SEG-TEST-46. SG2014.2 +103100 MOVE SPACE TO TEST-CHECK. SG2014.2 +103200 PERFORM 47. SG2014.2 +103300 MOVE SPACE TO TEST-CHECK. SG2014.2 +103400 PERFORM 47. SG2014.2 +103500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +103600 PERFORM PASS SG2014.2 +103700 GO TO SEG-WRITE-46. SG2014.2 +103800 MOVE SPACE TO COMPUTED-A. SG2014.2 +103900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +104000 PERFORM FAIL. SG2014.2 +104100 GO TO SEG-WRITE-46. SG2014.2 +104200 SEG-DELETE-46. SG2014.2 +104300 PERFORM DE-LETE. SG2014.2 +104400 SEG-WRITE-46. SG2014.2 +104500 MOVE "SEG-TEST-46 " TO PAR-NAME. SG2014.2 +104600 PERFORM PRINT-DETAIL. SG2014.2 +104700 SEG-TEST-47. SG2014.2 +104800 MOVE SPACE TO TEST-CHECK. SG2014.2 +104900 PERFORM 46. SG2014.2 +105000 MOVE SPACE TO TEST-CHECK. SG2014.2 +105100 PERFORM 46. SG2014.2 +105200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +105300 PERFORM PASS SG2014.2 +105400 GO TO SEG-WRITE-47. SG2014.2 +105500 MOVE SPACE TO COMPUTED-A. SG2014.2 +105600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +105700 PERFORM FAIL. SG2014.2 +105800 GO TO SEG-WRITE-47. SG2014.2 +105900 SEG-DELETE-47. SG2014.2 +106000 PERFORM DE-LETE. SG2014.2 +106100 SEG-WRITE-47. SG2014.2 +106200 MOVE "SEG-TEST-47 " TO PAR-NAME. SG2014.2 +106300 PERFORM PRINT-DETAIL. SG2014.2 +106400 SEG-TEST-48. SG2014.2 +106500 MOVE SPACE TO TEST-CHECK. SG2014.2 +106600 PERFORM 45. SG2014.2 +106700 MOVE SPACE TO TEST-CHECK. SG2014.2 +106800 PERFORM 45. SG2014.2 +106900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +107000 PERFORM PASS SG2014.2 +107100 GO TO SEG-WRITE-48. SG2014.2 +107200 MOVE SPACE TO COMPUTED-A. SG2014.2 +107300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +107400 PERFORM FAIL. SG2014.2 +107500 GO TO SEG-WRITE-48. SG2014.2 +107600 SEG-DELETE-48. SG2014.2 +107700 PERFORM DE-LETE. SG2014.2 +107800 SEG-WRITE-48. SG2014.2 +107900 MOVE "SEG-TEST-48 " TO PAR-NAME. SG2014.2 +108000 PERFORM PRINT-DETAIL. SG2014.2 +108100 SEG-TEST-49. SG2014.2 +108200 MOVE SPACE TO TEST-CHECK. SG2014.2 +108300 PERFORM 44. SG2014.2 +108400 MOVE SPACE TO TEST-CHECK. SG2014.2 +108500 PERFORM 44. SG2014.2 +108600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +108700 PERFORM PASS SG2014.2 +108800 GO TO SEG-WRITE-49. SG2014.2 +108900 MOVE SPACE TO COMPUTED-A. SG2014.2 +109000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +109100 PERFORM FAIL. SG2014.2 +109200 GO TO SEG-WRITE-49. SG2014.2 +109300 SEG-DELETE-49. SG2014.2 +109400 PERFORM DE-LETE. SG2014.2 +109500 SEG-WRITE-49. SG2014.2 +109600 MOVE "SEG-TEST-49 " TO PAR-NAME. SG2014.2 +109700 PERFORM PRINT-DETAIL. SG2014.2 +109800 SEG-TEST-50. SG2014.2 +109900 MOVE SPACE TO TEST-CHECK. SG2014.2 +110000 PERFORM 43. SG2014.2 +110100 MOVE SPACE TO TEST-CHECK. SG2014.2 +110200 PERFORM 43. SG2014.2 +110300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +110400 PERFORM PASS SG2014.2 +110500 GO TO SEG-WRITE-50. SG2014.2 +110600 MOVE SPACE TO COMPUTED-A. SG2014.2 +110700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +110800 PERFORM FAIL. SG2014.2 +110900 GO TO SEG-WRITE-50. SG2014.2 +111000 SEG-DELETE-50. SG2014.2 +111100 PERFORM DE-LETE. SG2014.2 +111200 SEG-WRITE-50. SG2014.2 +111300 MOVE "SEG-TEST-50 " TO PAR-NAME. SG2014.2 +111400 PERFORM PRINT-DETAIL. SG2014.2 +111500 SEG-TEST-51. SG2014.2 +111600 MOVE SPACE TO TEST-CHECK. SG2014.2 +111700 PERFORM 42. SG2014.2 +111800 MOVE SPACE TO TEST-CHECK. SG2014.2 +111900 PERFORM 42. SG2014.2 +112000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +112100 PERFORM PASS SG2014.2 +112200 GO TO SEG-WRITE-51. SG2014.2 +112300 MOVE SPACE TO COMPUTED-A. SG2014.2 +112400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +112500 PERFORM FAIL. SG2014.2 +112600 GO TO SEG-WRITE-51. SG2014.2 +112700 SEG-DELETE-51. SG2014.2 +112800 PERFORM DE-LETE. SG2014.2 +112900 SEG-WRITE-51. SG2014.2 +113000 MOVE "SEG-TEST-51 " TO PAR-NAME. SG2014.2 +113100 PERFORM PRINT-DETAIL. SG2014.2 +113200 SEG-TEST-52. SG2014.2 +113300 MOVE SPACE TO TEST-CHECK. SG2014.2 +113400 PERFORM 41. SG2014.2 +113500 MOVE SPACE TO TEST-CHECK. SG2014.2 +113600 PERFORM 41. SG2014.2 +113700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +113800 PERFORM PASS SG2014.2 +113900 GO TO SEG-WRITE-52. SG2014.2 +114000 MOVE SPACE TO COMPUTED-A. SG2014.2 +114100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +114200 PERFORM FAIL. SG2014.2 +114300 GO TO SEG-WRITE-52. SG2014.2 +114400 SEG-DELETE-52. SG2014.2 +114500 PERFORM DE-LETE. SG2014.2 +114600 SEG-WRITE-52. SG2014.2 +114700 MOVE "SEG-TEST-52 " TO PAR-NAME. SG2014.2 +114800 PERFORM PRINT-DETAIL. SG2014.2 +114900 SEG-TEST-53. SG2014.2 +115000 MOVE SPACE TO TEST-CHECK. SG2014.2 +115100 PERFORM 40. SG2014.2 +115200 MOVE SPACE TO TEST-CHECK. SG2014.2 +115300 PERFORM 40. SG2014.2 +115400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +115500 PERFORM PASS SG2014.2 +115600 GO TO SEG-WRITE-53. SG2014.2 +115700 MOVE SPACE TO COMPUTED-A. SG2014.2 +115800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +115900 PERFORM FAIL. SG2014.2 +116000 GO TO SEG-WRITE-53. SG2014.2 +116100 SEG-DELETE-53. SG2014.2 +116200 PERFORM DE-LETE. SG2014.2 +116300 SEG-WRITE-53. SG2014.2 +116400 MOVE "SEG-TEST-53 " TO PAR-NAME. SG2014.2 +116500 PERFORM PRINT-DETAIL. SG2014.2 +116600 SEG-TEST-54. SG2014.2 +116700 MOVE SPACE TO TEST-CHECK. SG2014.2 +116800 PERFORM 39. SG2014.2 +116900 MOVE SPACE TO TEST-CHECK. SG2014.2 +117000 PERFORM 39. SG2014.2 +117100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +117200 PERFORM PASS SG2014.2 +117300 GO TO SEG-WRITE-54. SG2014.2 +117400 MOVE SPACE TO COMPUTED-A. SG2014.2 +117500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +117600 PERFORM FAIL. SG2014.2 +117700 GO TO SEG-WRITE-54. SG2014.2 +117800 SEG-DELETE-54. SG2014.2 +117900 PERFORM DE-LETE. SG2014.2 +118000 SEG-WRITE-54. SG2014.2 +118100 MOVE "SEG-TEST-54 " TO PAR-NAME. SG2014.2 +118200 PERFORM PRINT-DETAIL. SG2014.2 +118300 SEG-TEST-55. SG2014.2 +118400 MOVE SPACE TO TEST-CHECK. SG2014.2 +118500 PERFORM 38. SG2014.2 +118600 MOVE SPACE TO TEST-CHECK. SG2014.2 +118700 PERFORM 38. SG2014.2 +118800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +118900 PERFORM PASS SG2014.2 +119000 GO TO SEG-WRITE-55. SG2014.2 +119100 MOVE SPACE TO COMPUTED-A. SG2014.2 +119200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +119300 PERFORM FAIL. SG2014.2 +119400 GO TO SEG-WRITE-55. SG2014.2 +119500 SEG-DELETE-55. SG2014.2 +119600 PERFORM DE-LETE. SG2014.2 +119700 SEG-WRITE-55. SG2014.2 +119800 MOVE "SEG-TEST-55 " TO PAR-NAME. SG2014.2 +119900 PERFORM PRINT-DETAIL. SG2014.2 +120000 SEG-TEST-56. SG2014.2 +120100 MOVE SPACE TO TEST-CHECK. SG2014.2 +120200 PERFORM 37. SG2014.2 +120300 MOVE SPACE TO TEST-CHECK. SG2014.2 +120400 PERFORM 37. SG2014.2 +120500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +120600 PERFORM PASS SG2014.2 +120700 GO TO SEG-WRITE-56. SG2014.2 +120800 MOVE SPACE TO COMPUTED-A. SG2014.2 +120900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +121000 PERFORM FAIL. SG2014.2 +121100 GO TO SEG-WRITE-56. SG2014.2 +121200 SEG-DELETE-56. SG2014.2 +121300 PERFORM DE-LETE. SG2014.2 +121400 SEG-WRITE-56. SG2014.2 +121500 MOVE "SEG-TEST-56 " TO PAR-NAME. SG2014.2 +121600 PERFORM PRINT-DETAIL. SG2014.2 +121700 SEG-TEST-57. SG2014.2 +121800 MOVE SPACE TO TEST-CHECK. SG2014.2 +121900 PERFORM 36. SG2014.2 +122000 MOVE SPACE TO TEST-CHECK. SG2014.2 +122100 PERFORM 36. SG2014.2 +122200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +122300 PERFORM PASS SG2014.2 +122400 GO TO SEG-WRITE-57. SG2014.2 +122500 MOVE SPACE TO COMPUTED-A. SG2014.2 +122600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +122700 PERFORM FAIL. SG2014.2 +122800 GO TO SEG-WRITE-57. SG2014.2 +122900 SEG-DELETE-57. SG2014.2 +123000 PERFORM DE-LETE. SG2014.2 +123100 SEG-WRITE-57. SG2014.2 +123200 MOVE "SEG-TEST-57 " TO PAR-NAME. SG2014.2 +123300 PERFORM PRINT-DETAIL. SG2014.2 +123400 SEG-TEST-58. SG2014.2 +123500 MOVE SPACE TO TEST-CHECK. SG2014.2 +123600 PERFORM 35. SG2014.2 +123700 MOVE SPACE TO TEST-CHECK. SG2014.2 +123800 PERFORM 35. SG2014.2 +123900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +124000 PERFORM PASS SG2014.2 +124100 GO TO SEG-WRITE-58. SG2014.2 +124200 MOVE SPACE TO COMPUTED-A. SG2014.2 +124300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +124400 PERFORM FAIL. SG2014.2 +124500 GO TO SEG-WRITE-58. SG2014.2 +124600 SEG-DELETE-58. SG2014.2 +124700 PERFORM DE-LETE. SG2014.2 +124800 SEG-WRITE-58. SG2014.2 +124900 MOVE "SEG-TEST-58 " TO PAR-NAME. SG2014.2 +125000 PERFORM PRINT-DETAIL. SG2014.2 +125100 SEG-TEST-59. SG2014.2 +125200 MOVE SPACE TO TEST-CHECK. SG2014.2 +125300 PERFORM 34. SG2014.2 +125400 MOVE SPACE TO TEST-CHECK. SG2014.2 +125500 PERFORM 34. SG2014.2 +125600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +125700 PERFORM PASS SG2014.2 +125800 GO TO SEG-WRITE-59. SG2014.2 +125900 MOVE SPACE TO COMPUTED-A. SG2014.2 +126000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +126100 PERFORM FAIL. SG2014.2 +126200 GO TO SEG-WRITE-59. SG2014.2 +126300 SEG-DELETE-59. SG2014.2 +126400 PERFORM DE-LETE. SG2014.2 +126500 SEG-WRITE-59. SG2014.2 +126600 MOVE "SEG-TEST-59 " TO PAR-NAME. SG2014.2 +126700 PERFORM PRINT-DETAIL. SG2014.2 +126800 SEG-TEST-60. SG2014.2 +126900 MOVE SPACE TO TEST-CHECK. SG2014.2 +127000 PERFORM 33. SG2014.2 +127100 MOVE SPACE TO TEST-CHECK. SG2014.2 +127200 PERFORM 33. SG2014.2 +127300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +127400 PERFORM PASS SG2014.2 +127500 GO TO SEG-WRITE-60. SG2014.2 +127600 MOVE SPACE TO COMPUTED-A. SG2014.2 +127700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +127800 PERFORM FAIL. SG2014.2 +127900 GO TO SEG-WRITE-60. SG2014.2 +128000 SEG-DELETE-60. SG2014.2 +128100 PERFORM DE-LETE. SG2014.2 +128200 SEG-WRITE-60. SG2014.2 +128300 MOVE "SEG-TEST-60 " TO PAR-NAME. SG2014.2 +128400 PERFORM PRINT-DETAIL. SG2014.2 +128500 SEG-TEST-61. SG2014.2 +128600 MOVE SPACE TO TEST-CHECK. SG2014.2 +128700 PERFORM 32. SG2014.2 +128800 MOVE SPACE TO TEST-CHECK. SG2014.2 +128900 PERFORM 32. SG2014.2 +129000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +129100 PERFORM PASS SG2014.2 +129200 GO TO SEG-WRITE-61. SG2014.2 +129300 MOVE SPACE TO COMPUTED-A. SG2014.2 +129400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +129500 PERFORM FAIL. SG2014.2 +129600 GO TO SEG-WRITE-61. SG2014.2 +129700 SEG-DELETE-61. SG2014.2 +129800 PERFORM DE-LETE. SG2014.2 +129900 SEG-WRITE-61. SG2014.2 +130000 MOVE "SEG-TEST-61 " TO PAR-NAME. SG2014.2 +130100 PERFORM PRINT-DETAIL. SG2014.2 +130200 SEG-TEST-62. SG2014.2 +130300 MOVE SPACE TO TEST-CHECK. SG2014.2 +130400 PERFORM 31. SG2014.2 +130500 MOVE SPACE TO TEST-CHECK. SG2014.2 +130600 PERFORM 31. SG2014.2 +130700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +130800 PERFORM PASS SG2014.2 +130900 GO TO SEG-WRITE-62. SG2014.2 +131000 MOVE SPACE TO COMPUTED-A. SG2014.2 +131100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +131200 PERFORM FAIL. SG2014.2 +131300 GO TO SEG-WRITE-62. SG2014.2 +131400 SEG-DELETE-62. SG2014.2 +131500 PERFORM DE-LETE. SG2014.2 +131600 SEG-WRITE-62. SG2014.2 +131700 MOVE "SEG-TEST-62 " TO PAR-NAME. SG2014.2 +131800 PERFORM PRINT-DETAIL. SG2014.2 +131900 SEG-TEST-63. SG2014.2 +132000 MOVE SPACE TO TEST-CHECK. SG2014.2 +132100 PERFORM 30. SG2014.2 +132200 MOVE SPACE TO TEST-CHECK. SG2014.2 +132300 PERFORM 30. SG2014.2 +132400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +132500 PERFORM PASS SG2014.2 +132600 GO TO SEG-WRITE-63. SG2014.2 +132700 MOVE SPACE TO COMPUTED-A. SG2014.2 +132800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +132900 PERFORM FAIL. SG2014.2 +133000 GO TO SEG-WRITE-63. SG2014.2 +133100 SEG-DELETE-63. SG2014.2 +133200 PERFORM DE-LETE. SG2014.2 +133300 SEG-WRITE-63. SG2014.2 +133400 MOVE "SEG-TEST-63 " TO PAR-NAME. SG2014.2 +133500 PERFORM PRINT-DETAIL. SG2014.2 +133600 SEG-TEST-64. SG2014.2 +133700 MOVE SPACE TO TEST-CHECK. SG2014.2 +133800 PERFORM 99. SG2014.2 +133900 MOVE SPACE TO TEST-CHECK. SG2014.2 +134000 PERFORM 99. SG2014.2 +134100 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +134200 PERFORM PASS SG2014.2 +134300 GO TO SEG-WRITE-64. SG2014.2 +134400 MOVE SPACE TO COMPUTED-A. SG2014.2 +134500 MOVE "GOOD" TO CORRECT-A. SG2014.2 +134600 PERFORM FAIL. SG2014.2 +134700 GO TO SEG-WRITE-64. SG2014.2 +134800 SEG-DELETE-64. SG2014.2 +134900 PERFORM DE-LETE. SG2014.2 +135000 SEG-WRITE-64. SG2014.2 +135100 MOVE "SEG-TEST-64 " TO PAR-NAME. SG2014.2 +135200 PERFORM PRINT-DETAIL. SG2014.2 +135300 SEG-TEST-65. SG2014.2 +135400 MOVE SPACE TO TEST-CHECK. SG2014.2 +135500 PERFORM 99. SG2014.2 +135600 MOVE SPACE TO TEST-CHECK. SG2014.2 +135700 PERFORM 99. SG2014.2 +135800 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +135900 PERFORM PASS SG2014.2 +136000 GO TO SEG-WRITE-65. SG2014.2 +136100 MOVE SPACE TO COMPUTED-A. SG2014.2 +136200 MOVE "GOOD" TO CORRECT-A. SG2014.2 +136300 PERFORM FAIL. SG2014.2 +136400 GO TO SEG-WRITE-65. SG2014.2 +136500 SEG-DELETE-65. SG2014.2 +136600 PERFORM DE-LETE. SG2014.2 +136700 SEG-WRITE-65. SG2014.2 +136800 MOVE "SEG-TEST-65 " TO PAR-NAME. SG2014.2 +136900 PERFORM PRINT-DETAIL. SG2014.2 +137000 SEG-TEST-66. SG2014.2 +137100 MOVE SPACE TO TEST-CHECK. SG2014.2 +137200 PERFORM 37. SG2014.2 +137300 MOVE SPACE TO TEST-CHECK. SG2014.2 +137400 PERFORM 37. SG2014.2 +137500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +137600 PERFORM PASS SG2014.2 +137700 GO TO SEG-WRITE-66. SG2014.2 +137800 MOVE SPACE TO COMPUTED-A. SG2014.2 +137900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +138000 PERFORM FAIL. SG2014.2 +138100 GO TO SEG-WRITE-66. SG2014.2 +138200 SEG-DELETE-66. SG2014.2 +138300 PERFORM DE-LETE. SG2014.2 +138400 SEG-WRITE-66. SG2014.2 +138500 MOVE "SEG-TEST-66 " TO PAR-NAME. SG2014.2 +138600 PERFORM PRINT-DETAIL. SG2014.2 +138700 SEG-TEST-67. SG2014.2 +138800 MOVE SPACE TO TEST-CHECK. SG2014.2 +138900 PERFORM 38. SG2014.2 +139000 MOVE SPACE TO TEST-CHECK. SG2014.2 +139100 PERFORM 38. SG2014.2 +139200 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +139300 PERFORM PASS SG2014.2 +139400 GO TO SEG-WRITE-67. SG2014.2 +139500 MOVE SPACE TO COMPUTED-A. SG2014.2 +139600 MOVE "GOOD" TO CORRECT-A. SG2014.2 +139700 PERFORM FAIL. SG2014.2 +139800 GO TO SEG-WRITE-67. SG2014.2 +139900 SEG-DELETE-67. SG2014.2 +140000 PERFORM DE-LETE. SG2014.2 +140100 SEG-WRITE-67. SG2014.2 +140200 MOVE "SEG-TEST-67 " TO PAR-NAME. SG2014.2 +140300 PERFORM PRINT-DETAIL. SG2014.2 +140400 SEG-TEST-68. SG2014.2 +140500 MOVE SPACE TO TEST-CHECK. SG2014.2 +140600 PERFORM 39. SG2014.2 +140700 MOVE SPACE TO TEST-CHECK. SG2014.2 +140800 PERFORM 39. SG2014.2 +140900 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +141000 PERFORM PASS SG2014.2 +141100 GO TO SEG-WRITE-68. SG2014.2 +141200 MOVE SPACE TO COMPUTED-A. SG2014.2 +141300 MOVE "GOOD" TO CORRECT-A. SG2014.2 +141400 PERFORM FAIL. SG2014.2 +141500 GO TO SEG-WRITE-68. SG2014.2 +141600 SEG-DELETE-68. SG2014.2 +141700 PERFORM DE-LETE. SG2014.2 +141800 SEG-WRITE-68. SG2014.2 +141900 MOVE "SEG-TEST-68 " TO PAR-NAME. SG2014.2 +142000 PERFORM PRINT-DETAIL. SG2014.2 +142100 SEG-TEST-69. SG2014.2 +142200 MOVE SPACE TO TEST-CHECK. SG2014.2 +142300 PERFORM 40. SG2014.2 +142400 MOVE SPACE TO TEST-CHECK. SG2014.2 +142500 PERFORM 40. SG2014.2 +142600 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +142700 PERFORM PASS SG2014.2 +142800 GO TO SEG-WRITE-69. SG2014.2 +142900 MOVE SPACE TO COMPUTED-A. SG2014.2 +143000 MOVE "GOOD" TO CORRECT-A. SG2014.2 +143100 PERFORM FAIL. SG2014.2 +143200 GO TO SEG-WRITE-69. SG2014.2 +143300 SEG-DELETE-69. SG2014.2 +143400 PERFORM DE-LETE. SG2014.2 +143500 SEG-WRITE-69. SG2014.2 +143600 MOVE "SEG-TEST-69 " TO PAR-NAME. SG2014.2 +143700 PERFORM PRINT-DETAIL. SG2014.2 +143800 SEG-TEST-70. SG2014.2 +143900 MOVE SPACE TO TEST-CHECK. SG2014.2 +144000 PERFORM 41. SG2014.2 +144100 MOVE SPACE TO TEST-CHECK. SG2014.2 +144200 PERFORM 41. SG2014.2 +144300 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +144400 PERFORM PASS SG2014.2 +144500 GO TO SEG-WRITE-70. SG2014.2 +144600 MOVE SPACE TO COMPUTED-A. SG2014.2 +144700 MOVE "GOOD" TO CORRECT-A. SG2014.2 +144800 PERFORM FAIL. SG2014.2 +144900 GO TO SEG-WRITE-70. SG2014.2 +145000 SEG-DELETE-70. SG2014.2 +145100 PERFORM DE-LETE. SG2014.2 +145200 SEG-WRITE-70. SG2014.2 +145300 MOVE "SEG-TEST-70 " TO PAR-NAME. SG2014.2 +145400 PERFORM PRINT-DETAIL. SG2014.2 +145500 SEG-TEST-71. SG2014.2 +145600 MOVE SPACE TO TEST-CHECK. SG2014.2 +145700 PERFORM 42. SG2014.2 +145800 MOVE SPACE TO TEST-CHECK. SG2014.2 +145900 PERFORM 42. SG2014.2 +146000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +146100 PERFORM PASS SG2014.2 +146200 GO TO SEG-WRITE-71. SG2014.2 +146300 MOVE SPACE TO COMPUTED-A. SG2014.2 +146400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +146500 PERFORM FAIL. SG2014.2 +146600 GO TO SEG-WRITE-71. SG2014.2 +146700 SEG-DELETE-71. SG2014.2 +146800 PERFORM DE-LETE. SG2014.2 +146900 SEG-WRITE-71. SG2014.2 +147000 MOVE "SEG-TEST-71 " TO PAR-NAME. SG2014.2 +147100 PERFORM PRINT-DETAIL. SG2014.2 +147200 SEG-TEST-72. SG2014.2 +147300 MOVE SPACE TO TEST-CHECK. SG2014.2 +147400 PERFORM 43. SG2014.2 +147500 MOVE SPACE TO TEST-CHECK. SG2014.2 +147600 PERFORM 43. SG2014.2 +147700 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +147800 PERFORM PASS SG2014.2 +147900 GO TO SEG-WRITE-72. SG2014.2 +148000 MOVE SPACE TO COMPUTED-A. SG2014.2 +148100 MOVE "GOOD" TO CORRECT-A. SG2014.2 +148200 PERFORM FAIL. SG2014.2 +148300 GO TO SEG-WRITE-72. SG2014.2 +148400 SEG-DELETE-72. SG2014.2 +148500 PERFORM DE-LETE. SG2014.2 +148600 SEG-WRITE-72. SG2014.2 +148700 MOVE "SEG-TEST-72 " TO PAR-NAME. SG2014.2 +148800 PERFORM PRINT-DETAIL. SG2014.2 +148900 SEG-TEST-73. SG2014.2 +149000 MOVE SPACE TO TEST-CHECK. SG2014.2 +149100 PERFORM 44. SG2014.2 +149200 MOVE SPACE TO TEST-CHECK. SG2014.2 +149300 PERFORM 44. SG2014.2 +149400 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +149500 PERFORM PASS SG2014.2 +149600 GO TO SEG-WRITE-73. SG2014.2 +149700 MOVE SPACE TO COMPUTED-A. SG2014.2 +149800 MOVE "GOOD" TO CORRECT-A. SG2014.2 +149900 PERFORM FAIL. SG2014.2 +150000 GO TO SEG-WRITE-73. SG2014.2 +150100 SEG-DELETE-73. SG2014.2 +150200 PERFORM DE-LETE. SG2014.2 +150300 SEG-WRITE-73. SG2014.2 +150400 MOVE "SEG-TEST-73 " TO PAR-NAME. SG2014.2 +150500 PERFORM PRINT-DETAIL. SG2014.2 +150600 SECOND-HALF SECTION 50. SG2014.2 +150700 SEG-TEST-74. SG2014.2 +150800 MOVE SPACE TO TEST-CHECK. SG2014.2 +150900 PERFORM 01. SG2014.2 +151000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +151100 PERFORM PASS SG2014.2 +151200 GO TO SEG-WRITE-74. SG2014.2 +151300 MOVE SPACE TO COMPUTED-A. SG2014.2 +151400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +151500 PERFORM FAIL. SG2014.2 +151600 GO TO SEG-WRITE-74. SG2014.2 +151700 SEG-DELETE-74. SG2014.2 +151800 PERFORM DE-LETE. SG2014.2 +151900 SEG-WRITE-74. SG2014.2 +152000 MOVE "SEG-TEST-74 " TO PAR-NAME. SG2014.2 +152100 PERFORM PRINT-DETAIL. SG2014.2 +152200 SEG-TEST-75. SG2014.2 +152300 MOVE SPACE TO TEST-CHECK. SG2014.2 +152400 PERFORM 02. SG2014.2 +152500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +152600 PERFORM PASS SG2014.2 +152700 GO TO SEG-WRITE-75. SG2014.2 +152800 MOVE SPACE TO COMPUTED-A. SG2014.2 +152900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +153000 PERFORM FAIL. SG2014.2 +153100 GO TO SEG-WRITE-75. SG2014.2 +153200 SEG-DELETE-75. SG2014.2 +153300 PERFORM DE-LETE. SG2014.2 +153400 SEG-WRITE-75. SG2014.2 +153500 MOVE "SEG-TEST-75 " TO PAR-NAME. SG2014.2 +153600 PERFORM PRINT-DETAIL. SG2014.2 +153700 SEG-TEST-76. SG2014.2 +153800 MOVE SPACE TO TEST-CHECK. SG2014.2 +153900 PERFORM 03. SG2014.2 +154000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +154100 PERFORM PASS SG2014.2 +154200 GO TO SEG-WRITE-76. SG2014.2 +154300 MOVE SPACE TO COMPUTED-A. SG2014.2 +154400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +154500 PERFORM FAIL. SG2014.2 +154600 GO TO SEG-WRITE-76. SG2014.2 +154700 SEG-DELETE-76. SG2014.2 +154800 PERFORM DE-LETE. SG2014.2 +154900 SEG-WRITE-76. SG2014.2 +155000 MOVE "SEG-TEST-76 " TO PAR-NAME. SG2014.2 +155100 PERFORM PRINT-DETAIL. SG2014.2 +155200 SEG-TEST-77. SG2014.2 +155300 MOVE SPACE TO TEST-CHECK. SG2014.2 +155400 PERFORM 04. SG2014.2 +155500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +155600 PERFORM PASS SG2014.2 +155700 GO TO SEG-WRITE-77. SG2014.2 +155800 MOVE SPACE TO COMPUTED-A. SG2014.2 +155900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +156000 PERFORM FAIL. SG2014.2 +156100 GO TO SEG-WRITE-77. SG2014.2 +156200 SEG-DELETE-77. SG2014.2 +156300 PERFORM DE-LETE. SG2014.2 +156400 SEG-WRITE-77. SG2014.2 +156500 MOVE "SEG-TEST-77 " TO PAR-NAME. SG2014.2 +156600 PERFORM PRINT-DETAIL. SG2014.2 +156700 SEG-TEST-78. SG2014.2 +156800 MOVE SPACE TO TEST-CHECK. SG2014.2 +156900 PERFORM 05. SG2014.2 +157000 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +157100 PERFORM PASS SG2014.2 +157200 GO TO SEG-WRITE-78. SG2014.2 +157300 MOVE SPACE TO COMPUTED-A. SG2014.2 +157400 MOVE "GOOD" TO CORRECT-A. SG2014.2 +157500 PERFORM FAIL. SG2014.2 +157600 GO TO SEG-WRITE-78. SG2014.2 +157700 SEG-DELETE-78. SG2014.2 +157800 PERFORM DE-LETE. SG2014.2 +157900 SEG-WRITE-78. SG2014.2 +158000 MOVE "SEG-TEST-78 " TO PAR-NAME. SG2014.2 +158100 PERFORM PRINT-DETAIL. SG2014.2 +158200 SEG-TEST-79. SG2014.2 +158300 MOVE SPACE TO TEST-CHECK. SG2014.2 +158400 PERFORM 06. SG2014.2 +158500 IF TEST-CHECK EQUAL TO "GOOD" SG2014.2 +158600 PERFORM PASS SG2014.2 +158700 GO TO SEG-WRITE-79. SG2014.2 +158800 MOVE SPACE TO COMPUTED-A. SG2014.2 +158900 MOVE "GOOD" TO CORRECT-A. SG2014.2 +159000 PERFORM FAIL. SG2014.2 +159100 GO TO SEG-WRITE-79. SG2014.2 +159200 SEG-DELETE-79. SG2014.2 +159300 PERFORM DE-LETE. SG2014.2 +159400 SEG-WRITE-79. SG2014.2 +159500 MOVE "SEG-TEST-79 " TO PAR-NAME. SG2014.2 +159600 PERFORM PRINT-DETAIL. SG2014.2 +159700 GO TO CLOSE-FILES. SG2014.2 +159800 00 SECTION 00. SG2014.2 +159900 PARA-00. SG2014.2 +160000 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +160100 01 SECTION 01. SG2014.2 +160200 PARA-01. SG2014.2 +160300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +160400 02 SECTION 02. SG2014.2 +160500 PARA-02. SG2014.2 +160600 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +160700 03 SECTION 03. SG2014.2 +160800 PARA-03. SG2014.2 +160900 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +161000 04 SECTION 04. SG2014.2 +161100 PARA-04. SG2014.2 +161200 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +161300 05 SECTION 05. SG2014.2 +161400 PARA-05. SG2014.2 +161500 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +161600 06 SECTION 06. SG2014.2 +161700 PARA-06. SG2014.2 +161800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +161900 30 SECTION 30. SG2014.2 +162000 PARA-30. SG2014.2 +162100 GO TO PARA-30C. SG2014.2 +162200 PARA-30A. SG2014.2 +162300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +162400 PARA-30B. SG2014.2 +162500 GO TO PARA-30D. SG2014.2 +162600 PARA-30C. SG2014.2 +162700 ALTER PARA-30 TO PROCEED TO PARA-30A. SG2014.2 +162800 PARA-30D. SG2014.2 +162900 EXIT. SG2014.2 +163000 31 SECTION 31. SG2014.2 +163100 PARA-31. SG2014.2 +163200 GO TO PARA-31C. SG2014.2 +163300 PARA-31A. SG2014.2 +163400 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +163500 PARA-31B. SG2014.2 +163600 GO TO PARA-31D. SG2014.2 +163700 PARA-31C. SG2014.2 +163800 ALTER PARA-31 TO PROCEED TO PARA-31A. SG2014.2 +163900 PARA-31D. SG2014.2 +164000 EXIT. SG2014.2 +164100 32 SECTION 32. SG2014.2 +164200 PARA-32. SG2014.2 +164300 GO TO PARA-32C. SG2014.2 +164400 PARA-32A. SG2014.2 +164500 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +164600 PARA-32B. SG2014.2 +164700 GO TO PARA-32D. SG2014.2 +164800 PARA-32C. SG2014.2 +164900 ALTER PARA-32 TO PROCEED TO PARA-32A. SG2014.2 +165000 PARA-32D. SG2014.2 +165100 EXIT. SG2014.2 +165200 33 SECTION 33. SG2014.2 +165300 PARA-33. SG2014.2 +165400 GO TO PARA-33C. SG2014.2 +165500 PARA-33A. SG2014.2 +165600 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +165700 PARA-33B. SG2014.2 +165800 GO TO PARA-33D. SG2014.2 +165900 PARA-33C. SG2014.2 +166000 ALTER PARA-33 TO PROCEED TO PARA-33A. SG2014.2 +166100 PARA-33D. SG2014.2 +166200 EXIT. SG2014.2 +166300 34 SECTION 34. SG2014.2 +166400 PARA-34. SG2014.2 +166500 GO TO PARA-34C. SG2014.2 +166600 PARA-34A. SG2014.2 +166700 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +166800 PARA-34B. SG2014.2 +166900 GO TO PARA-34D. SG2014.2 +167000 PARA-34C. SG2014.2 +167100 ALTER PARA-34 TO PROCEED TO PARA-34A. SG2014.2 +167200 PARA-34D. SG2014.2 +167300 EXIT. SG2014.2 +167400 35 SECTION 35. SG2014.2 +167500 PARA-35. SG2014.2 +167600 GO TO PARA-35C. SG2014.2 +167700 PARA-35A. SG2014.2 +167800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +167900 PARA-35B. SG2014.2 +168000 GO TO PARA-35D. SG2014.2 +168100 PARA-35C. SG2014.2 +168200 ALTER PARA-35 TO PROCEED TO PARA-35A. SG2014.2 +168300 PARA-35D. SG2014.2 +168400 EXIT. SG2014.2 +168500 36 SECTION 36. SG2014.2 +168600 PARA-36. SG2014.2 +168700 GO TO PARA-36C. SG2014.2 +168800 PARA-36A. SG2014.2 +168900 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +169000 PARA-36B. SG2014.2 +169100 GO TO PARA-36D. SG2014.2 +169200 PARA-36C. SG2014.2 +169300 ALTER PARA-36 TO PROCEED TO PARA-36A. SG2014.2 +169400 PARA-36D. SG2014.2 +169500 EXIT. SG2014.2 +169600 37 SECTION 37. SG2014.2 +169700 PARA-37. SG2014.2 +169800 GO TO PARA-37C. SG2014.2 +169900 PARA-37A. SG2014.2 +170000 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +170100 PARA-37B. SG2014.2 +170200 GO TO PARA-37D. SG2014.2 +170300 PARA-37C. SG2014.2 +170400 ALTER PARA-37 TO PROCEED TO PARA-37A. SG2014.2 +170500 PARA-37D. SG2014.2 +170600 EXIT. SG2014.2 +170700 38 SECTION 38. SG2014.2 +170800 PARA-38. SG2014.2 +170900 GO TO PARA-38C. SG2014.2 +171000 PARA-38A. SG2014.2 +171100 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +171200 PARA-38B. SG2014.2 +171300 GO TO PARA-38D. SG2014.2 +171400 PARA-38C. SG2014.2 +171500 ALTER PARA-38 TO PROCEED TO PARA-38A. SG2014.2 +171600 PARA-38D. SG2014.2 +171700 EXIT. SG2014.2 +171800 39 SECTION 39. SG2014.2 +171900 PARA-39. SG2014.2 +172000 GO TO PARA-39C. SG2014.2 +172100 PARA-39A. SG2014.2 +172200 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +172300 PARA-39B. SG2014.2 +172400 GO TO PARA-39D. SG2014.2 +172500 PARA-39C. SG2014.2 +172600 ALTER PARA-39 TO PROCEED TO PARA-39A. SG2014.2 +172700 PARA-39D. SG2014.2 +172800 EXIT. SG2014.2 +172900 40 SECTION 40. SG2014.2 +173000 PARA-40. SG2014.2 +173100 GO TO PARA-40C. SG2014.2 +173200 PARA-40A. SG2014.2 +173300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +173400 PARA-40B. SG2014.2 +173500 GO TO PARA-40D. SG2014.2 +173600 PARA-40C. SG2014.2 +173700 ALTER PARA-40 TO PROCEED TO PARA-40A. SG2014.2 +173800 PARA-40D. SG2014.2 +173900 EXIT. SG2014.2 +174000 41 SECTION 41. SG2014.2 +174100 PARA-41. SG2014.2 +174200 GO TO PARA-41C. SG2014.2 +174300 PARA-41A. SG2014.2 +174400 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +174500 PARA-41B. SG2014.2 +174600 GO TO PARA-41D. SG2014.2 +174700 PARA-41C. SG2014.2 +174800 ALTER PARA-41 TO PROCEED TO PARA-41A. SG2014.2 +174900 PARA-41D. SG2014.2 +175000 EXIT. SG2014.2 +175100 42 SECTION 42. SG2014.2 +175200 PARA-42. SG2014.2 +175300 GO TO PARA-42C. SG2014.2 +175400 PARA-42A. SG2014.2 +175500 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +175600 PARA-42B. SG2014.2 +175700 GO TO PARA-42D. SG2014.2 +175800 PARA-42C. SG2014.2 +175900 ALTER PARA-42 TO PROCEED TO PARA-42A. SG2014.2 +176000 PARA-42D. SG2014.2 +176100 EXIT. SG2014.2 +176200 43 SECTION 43. SG2014.2 +176300 PARA-43. SG2014.2 +176400 GO TO PARA-43C. SG2014.2 +176500 PARA-43A. SG2014.2 +176600 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +176700 PARA-43B. SG2014.2 +176800 GO TO PARA-43D. SG2014.2 +176900 PARA-43C. SG2014.2 +177000 ALTER PARA-43 TO PROCEED TO PARA-43A. SG2014.2 +177100 PARA-43D. SG2014.2 +177200 EXIT. SG2014.2 +177300 44 SECTION 44. SG2014.2 +177400 PARA-44. SG2014.2 +177500 GO TO PARA-44C. SG2014.2 +177600 PARA-44A. SG2014.2 +177700 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +177800 PARA-44B. SG2014.2 +177900 GO TO PARA-44D. SG2014.2 +178000 PARA-44C. SG2014.2 +178100 ALTER PARA-44 TO PROCEED TO PARA-44A. SG2014.2 +178200 PARA-44D. SG2014.2 +178300 EXIT. SG2014.2 +178400 45 SECTION 45. SG2014.2 +178500 PARA-45. SG2014.2 +178600 GO TO PARA-45C. SG2014.2 +178700 PARA-45A. SG2014.2 +178800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +178900 PARA-45B. SG2014.2 +179000 GO TO PARA-45D. SG2014.2 +179100 PARA-45C. SG2014.2 +179200 ALTER PARA-45 TO PROCEED TO PARA-45A. SG2014.2 +179300 PARA-45D. SG2014.2 +179400 EXIT. SG2014.2 +179500 46 SECTION 46. SG2014.2 +179600 PARA-46. SG2014.2 +179700 GO TO PARA-46C. SG2014.2 +179800 PARA-46A. SG2014.2 +179900 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +180000 PARA-46B. SG2014.2 +180100 GO TO PARA-46D. SG2014.2 +180200 PARA-46C. SG2014.2 +180300 ALTER PARA-46 TO PROCEED TO PARA-46A. SG2014.2 +180400 PARA-46D. SG2014.2 +180500 EXIT. SG2014.2 +180600 47 SECTION 47. SG2014.2 +180700 PARA-47. SG2014.2 +180800 GO TO PARA-47C. SG2014.2 +180900 PARA-47A. SG2014.2 +181000 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +181100 PARA-47B. SG2014.2 +181200 GO TO PARA-47D. SG2014.2 +181300 PARA-47C. SG2014.2 +181400 ALTER PARA-47 TO PROCEED TO PARA-47A. SG2014.2 +181500 PARA-47D. SG2014.2 +181600 EXIT. SG2014.2 +181700 48 SECTION 48. SG2014.2 +181800 PARA-48. SG2014.2 +181900 GO TO PARA-48C. SG2014.2 +182000 PARA-48A. SG2014.2 +182100 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +182200 PARA-48B. SG2014.2 +182300 GO TO PARA-48D. SG2014.2 +182400 PARA-48C. SG2014.2 +182500 ALTER PARA-48 TO PROCEED TO PARA-48A. SG2014.2 +182600 PARA-48D. SG2014.2 +182700 EXIT. SG2014.2 +182800 49 SECTION 49. SG2014.2 +182900 PARA-49. SG2014.2 +183000 GO TO PARA-49C. SG2014.2 +183100 PARA-49A. SG2014.2 +183200 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +183300 PARA-49B. SG2014.2 +183400 GO TO PARA-49D. SG2014.2 +183500 PARA-49C. SG2014.2 +183600 ALTER PARA-49 TO PROCEED TO PARA-49A. SG2014.2 +183700 PARA-49D. SG2014.2 +183800 EXIT. SG2014.2 +183900 50 SECTION 50. SG2014.2 +184000 PARA-50. SG2014.2 +184100 GO TO PARA-50A. SG2014.2 +184200 PARA-50A. SG2014.2 +184300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +184400 PARA-50B. SG2014.2 +184500 ALTER PARA-50 TO PROCEED TO PARA-50C. SG2014.2 +184600 PARA-50C. SG2014.2 +184700 EXIT. SG2014.2 +184800 51 SECTION 51. SG2014.2 +184900 PARA-51. SG2014.2 +185000 GO TO PARA-51A. SG2014.2 +185100 PARA-51A. SG2014.2 +185200 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +185300 PARA-51B. SG2014.2 +185400 ALTER PARA-51 TO PROCEED TO PARA-51C. SG2014.2 +185500 PARA-51C. SG2014.2 +185600 EXIT. SG2014.2 +185700 52 SECTION 52. SG2014.2 +185800 PARA-52. SG2014.2 +185900 GO TO PARA-52A. SG2014.2 +186000 PARA-52A. SG2014.2 +186100 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +186200 PARA-52B. SG2014.2 +186300 ALTER PARA-52 TO PROCEED TO PARA-52C. SG2014.2 +186400 PARA-52C. SG2014.2 +186500 EXIT. SG2014.2 +186600 53 SECTION 53. SG2014.2 +186700 PARA-53. SG2014.2 +186800 GO TO PARA-53A. SG2014.2 +186900 PARA-53A. SG2014.2 +187000 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +187100 PARA-53B. SG2014.2 +187200 ALTER PARA-53 TO PROCEED TO PARA-53C. SG2014.2 +187300 PARA-53C. SG2014.2 +187400 EXIT. SG2014.2 +187500 54 SECTION 54. SG2014.2 +187600 PARA-54. SG2014.2 +187700 GO TO PARA-54A. SG2014.2 +187800 PARA-54A. SG2014.2 +187900 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +188000 PARA-54B. SG2014.2 +188100 ALTER PARA-54 TO PROCEED TO PARA-54C. SG2014.2 +188200 PARA-54C. SG2014.2 +188300 EXIT. SG2014.2 +188400 55 SECTION 55. SG2014.2 +188500 PARA-55. SG2014.2 +188600 GO TO PARA-55A. SG2014.2 +188700 PARA-55A. SG2014.2 +188800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +188900 PARA-55B. SG2014.2 +189000 ALTER PARA-55 TO PROCEED TO PARA-55C. SG2014.2 +189100 PARA-55C. SG2014.2 +189200 EXIT. SG2014.2 +189300 56 SECTION 56. SG2014.2 +189400 PARA-56. SG2014.2 +189500 GO TO PARA-56A. SG2014.2 +189600 PARA-56A. SG2014.2 +189700 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +189800 PARA-56B. SG2014.2 +189900 ALTER PARA-56 TO PROCEED TO PARA-56C. SG2014.2 +190000 PARA-56C. SG2014.2 +190100 EXIT. SG2014.2 +190200 57 SECTION 57. SG2014.2 +190300 PARA-57. SG2014.2 +190400 GO TO PARA-57A. SG2014.2 +190500 PARA-57A. SG2014.2 +190600 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +190700 PARA-57B. SG2014.2 +190800 ALTER PARA-57 TO PROCEED TO PARA-57C. SG2014.2 +190900 PARA-57C. SG2014.2 +191000 EXIT. SG2014.2 +191100 58 SECTION 58. SG2014.2 +191200 PARA-58. SG2014.2 +191300 GO TO PARA-58A. SG2014.2 +191400 PARA-58A. SG2014.2 +191500 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +191600 PARA-58B. SG2014.2 +191700 ALTER PARA-58 TO PROCEED TO PARA-58C. SG2014.2 +191800 PARA-58C. SG2014.2 +191900 EXIT. SG2014.2 +192000 59 SECTION 59. SG2014.2 +192100 PARA-59. SG2014.2 +192200 GO TO PARA-59A. SG2014.2 +192300 PARA-59A. SG2014.2 +192400 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +192500 PARA-59B. SG2014.2 +192600 ALTER PARA-59 TO PROCEED TO PARA-59C. SG2014.2 +192700 PARA-59C. SG2014.2 +192800 EXIT. SG2014.2 +192900 60 SECTION 60. SG2014.2 +193000 PARA-60. SG2014.2 +193100 GO TO PARA-60A. SG2014.2 +193200 PARA-60A. SG2014.2 +193300 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +193400 PARA-60B. SG2014.2 +193500 ALTER PARA-60 TO PROCEED TO PARA-60C. SG2014.2 +193600 PARA-60C. SG2014.2 +193700 EXIT. SG2014.2 +193800 99 SECTION 99. SG2014.2 +193900 PARA-99. SG2014.2 +194000 GO TO PARA-99A. SG2014.2 +194100 PARA-99A. SG2014.2 +194200 ALTER PARA-99 TO PARA-99B. SG2014.2 +194300 GO TO PARA-99C. SG2014.2 +194400 PARA-99B. SG2014.2 +194500 MOVE SPACE TO TEST-CHECK. SG2014.2 +194600 GO TO PARA-99D. SG2014.2 +194700 PARA-99C. SG2014.2 +194800 MOVE "GOOD" TO TEST-CHECK. SG2014.2 +194900 PARA-99D. SG2014.2 +195000 EXIT. SG2014.2 diff --git a/tests/cobol85/SG/SG202A.CBL b/tests/cobol85/SG/SG202A.CBL new file mode 100755 index 00000000..7ce985df --- /dev/null +++ b/tests/cobol85/SG/SG202A.CBL @@ -0,0 +1,432 @@ +000100 IDENTIFICATION DIVISION. SG2024.2 +000200 PROGRAM-ID. SG2024.2 +000300 SG202A. SG2024.2 +000400 AUTHOR. SG2024.2 +000500 FEDERAL COMPILER TESTING CENTER. SG2024.2 +000600 INSTALLATION. SG2024.2 +000700 GENERAL SERVICES ADMINISTRATION SG2024.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG2024.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG2024.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG2024.2 +001100 FALLS CHURCH VIRGINIA 22041. SG2024.2 +001200 SG2024.2 +001300 PHONE (703) 756-6153 SG2024.2 +001400 SG2024.2 +001500 " HIGH ". SG2024.2 +001600 DATE-WRITTEN. SG2024.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG2024.2 +001800 CREATION DATE / VALIDATION DATE SG2024.2 +001900 "4.2 ". SG2024.2 +002000 SECURITY. SG2024.2 +002100 NONE. SG2024.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG2024.2 +002300 BASED ON A SEGMENT-LIMIT OF 25 THESE TESTS ARE SG2024.2 +002400 DESIGNED TO ALTER SEGMENTS THAT HAVE NOT YET BEEN SG2024.2 +002500 CALLED FOR EXECUTION, FALL THRU TO INDEPENDENT SG2024.2 +002600 SEGMENTS, AND PERFORM FIXED OVERLAYABLE SEGMENTS. SG2024.2 +002700 SG2024.2 +002800* SG2024.2 +002900 ENVIRONMENT DIVISION. SG2024.2 +003000 CONFIGURATION SECTION. SG2024.2 +003100 SOURCE-COMPUTER. SG2024.2 +003200 Linux. SG2024.2 +003300 OBJECT-COMPUTER. SG2024.2 +003400 Linux SG2024.2 +003500 SEGMENT-LIMIT IS 25. SG2024.2 +003600 INPUT-OUTPUT SECTION. SG2024.2 +003700 FILE-CONTROL. SG2024.2 +003800 SELECT PRINT-FILE ASSIGN TO SG2024.2 +003900 "report.log". SG2024.2 +004000 DATA DIVISION. SG2024.2 +004100 FILE SECTION. SG2024.2 +004200 FD PRINT-FILE SG2024.2 +004300 LABEL RECORDS SG2024.2 +004400 OMITTED SG2024.2 +004500 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG2024.2 +004600 01 PRINT-REC PICTURE X(120). SG2024.2 +004700 01 DUMMY-RECORD PICTURE X(120). SG2024.2 +004800 WORKING-STORAGE SECTION. SG2024.2 +004900 01 LAST-STATE-A. SG2024.2 +005000 02 LAST-STATE-B PICTURE 9 VALUE 0. SG2024.2 +005100 02 LAST-STATE-C PICTURE 9 VALUE 0. SG2024.2 +005200 01 ALTER-NOT-CALL PICTURE X. SG2024.2 +005300 01 PERF-OVER-RES. SG2024.2 +005400 02 PERF-OVER-RES-A PICTURE X. SG2024.2 +005500 02 PERF-OVER-RES-B PICTURE X. SG2024.2 +005600 01 PERF-RES-OVER. SG2024.2 +005700 02 PERF-RES-OVER-A PICTURE X. SG2024.2 +005800 02 PERF-RES-OVER-B PICTURE X. SG2024.2 +005900 01 FALL-RSLT. SG2024.2 +006000 02 FALL-RSLT-1 PICTURE X VALUE " ". SG2024.2 +006100 02 FALL-RSLT-2 PICTURE X VALUE " ". SG2024.2 +006200 01 TEST-RESULTS. SG2024.2 +006300 02 FILLER PICTURE X VALUE SPACE. SG2024.2 +006400 02 FEATURE PICTURE X(20) VALUE SPACE. SG2024.2 +006500 02 FILLER PICTURE X VALUE SPACE. SG2024.2 +006600 02 P-OR-F PICTURE X(5) VALUE SPACE. SG2024.2 +006700 02 FILLER PICTURE X VALUE SPACE. SG2024.2 +006800 02 PAR-NAME. SG2024.2 +006900 03 FILLER PICTURE X(12) VALUE SPACE. SG2024.2 +007000 03 PARDOT-X PICTURE X VALUE SPACE. SG2024.2 +007100 03 DOTVALUE PICTURE 99 VALUE ZERO. SG2024.2 +007200 03 FILLER PIC X(5) VALUE SPACE. SG2024.2 +007300 02 FILLER PIC X(10) VALUE SPACE. SG2024.2 +007400 02 RE-MARK PIC X(61). SG2024.2 +007500 01 TEST-COMPUTED. SG2024.2 +007600 02 FILLER PIC X(30) VALUE SPACE. SG2024.2 +007700 02 FILLER PIC X(17) VALUE " COMPUTED=". SG2024.2 +007800 02 COMPUTED-X. SG2024.2 +007900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG2024.2 +008000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG2024.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG2024.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG2024.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG2024.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. SG2024.2 +008500 04 COMPUTED-18V0 PICTURE -9(18). SG2024.2 +008600 04 FILLER PICTURE X. SG2024.2 +008700 03 FILLER PIC X(50) VALUE SPACE. SG2024.2 +008800 01 TEST-CORRECT. SG2024.2 +008900 02 FILLER PIC X(30) VALUE SPACE. SG2024.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". SG2024.2 +009100 02 CORRECT-X. SG2024.2 +009200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG2024.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG2024.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG2024.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG2024.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG2024.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. SG2024.2 +009800 04 CORRECT-18V0 PICTURE -9(18). SG2024.2 +009900 04 FILLER PICTURE X. SG2024.2 +010000 03 FILLER PIC X(50) VALUE SPACE. SG2024.2 +010100 01 CCVS-C-1. SG2024.2 +010200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG2024.2 +010300- "SS PARAGRAPH-NAME SG2024.2 +010400- " REMARKS". SG2024.2 +010500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG2024.2 +010600 01 CCVS-C-2. SG2024.2 +010700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2024.2 +010800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG2024.2 +010900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG2024.2 +011000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG2024.2 +011100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG2024.2 +011200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG2024.2 +011300 01 REC-CT PICTURE 99 VALUE ZERO. SG2024.2 +011400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG2024.2 +011500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG2024.2 +011600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG2024.2 +011700 01 PASS-COUNTER PIC 999 VALUE ZERO. SG2024.2 +011800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG2024.2 +011900 01 ERROR-HOLD PIC 999 VALUE ZERO. SG2024.2 +012000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG2024.2 +012100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG2024.2 +012200 01 CCVS-H-1. SG2024.2 +012300 02 FILLER PICTURE X(27) VALUE SPACE. SG2024.2 +012400 02 FILLER PICTURE X(67) VALUE SG2024.2 +012500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG2024.2 +012600- " SYSTEM". SG2024.2 +012700 02 FILLER PICTURE X(26) VALUE SPACE. SG2024.2 +012800 01 CCVS-H-2. SG2024.2 +012900 02 FILLER PICTURE X(52) VALUE IS SG2024.2 +013000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG2024.2 +013100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG2024.2 +013200 02 TEST-ID PICTURE IS X(9). SG2024.2 +013300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG2024.2 +013400 01 CCVS-H-3. SG2024.2 +013500 02 FILLER PICTURE X(34) VALUE SG2024.2 +013600 " FOR OFFICIAL USE ONLY ". SG2024.2 +013700 02 FILLER PICTURE X(58) VALUE SG2024.2 +013800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG2024.2 +013900 02 FILLER PICTURE X(28) VALUE SG2024.2 +014000 " COPYRIGHT 1974 ". SG2024.2 +014100 01 CCVS-E-1. SG2024.2 +014200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG2024.2 +014300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG2024.2 +014400 02 ID-AGAIN PICTURE IS X(9). SG2024.2 +014500 02 FILLER PICTURE X(45) VALUE IS SG2024.2 +014600 " NTIS DISTRIBUTION COBOL 74". SG2024.2 +014700 01 CCVS-E-2. SG2024.2 +014800 02 FILLER PICTURE X(31) VALUE SG2024.2 +014900 SPACE. SG2024.2 +015000 02 FILLER PICTURE X(21) VALUE SPACE. SG2024.2 +015100 02 CCVS-E-2-2. SG2024.2 +015200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG2024.2 +015300 03 FILLER PICTURE IS X VALUE IS SPACE. SG2024.2 +015400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG2024.2 +015500 01 CCVS-E-3. SG2024.2 +015600 02 FILLER PICTURE X(22) VALUE SG2024.2 +015700 " FOR OFFICIAL USE ONLY". SG2024.2 +015800 02 FILLER PICTURE X(12) VALUE SPACE. SG2024.2 +015900 02 FILLER PICTURE X(58) VALUE SG2024.2 +016000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG2024.2 +016100 02 FILLER PICTURE X(13) VALUE SPACE. SG2024.2 +016200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG2024.2 +016300 01 CCVS-E-4. SG2024.2 +016400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG2024.2 +016500 02 FILLER PIC XXXX VALUE " OF ". SG2024.2 +016600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG2024.2 +016700 02 FILLER PIC X(40) VALUE SG2024.2 +016800 " TESTS WERE EXECUTED SUCCESSFULLY". SG2024.2 +016900 01 XXINFO. SG2024.2 +017000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG2024.2 +017100 02 INFO-TEXT. SG2024.2 +017200 04 FILLER PIC X(20) VALUE SPACE. SG2024.2 +017300 04 XXCOMPUTED PIC X(20). SG2024.2 +017400 04 FILLER PIC X(5) VALUE SPACE. SG2024.2 +017500 04 XXCORRECT PIC X(20). SG2024.2 +017600 01 HYPHEN-LINE. SG2024.2 +017700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2024.2 +017800 02 FILLER PICTURE IS X(65) VALUE IS "************************SG2024.2 +017900- "*****************************************". SG2024.2 +018000 02 FILLER PICTURE IS X(54) VALUE IS "************************SG2024.2 +018100- "******************************". SG2024.2 +018200 01 CCVS-PGM-ID PIC X(6) VALUE SG2024.2 +018300 "SG202A". SG2024.2 +018400 PROCEDURE DIVISION. SG2024.2 +018500 SEC00 SECTION. SG2024.2 +018600 PARAGRAPH-NAME-1. SG2024.2 +018700 GO TO P0010. SG2024.2 +018800 CCVS1 SECTION. SG2024.2 +018900 OPEN-FILES. SG2024.2 +019000 OPEN OUTPUT PRINT-FILE. SG2024.2 +019100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG2024.2 +019200 MOVE SPACE TO TEST-RESULTS. SG2024.2 +019300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG2024.2 +019400 GO TO CCVS1-EXIT. SG2024.2 +019500 CLOSE-FILES. SG2024.2 +019600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG2024.2 +019700 TERMINATE-CCVS. SG2024.2 +019800*S EXIT PROGRAM. SG2024.2 +019900*SERMINATE-CALL. SG2024.2 +020000 STOP RUN. SG2024.2 +020100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2024.2 +020200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2024.2 +020300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2024.2 +020400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2024.2 +020500 MOVE "****TEST DELETED****" TO RE-MARK. SG2024.2 +020600 PRINT-DETAIL. SG2024.2 +020700 IF REC-CT NOT EQUAL TO ZERO SG2024.2 +020800 MOVE "." TO PARDOT-X SG2024.2 +020900 MOVE REC-CT TO DOTVALUE. SG2024.2 +021000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG2024.2 +021100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG2024.2 +021200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG2024.2 +021300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG2024.2 +021400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2024.2 +021500 MOVE SPACE TO CORRECT-X. SG2024.2 +021600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2024.2 +021700 MOVE SPACE TO RE-MARK. SG2024.2 +021800 HEAD-ROUTINE. SG2024.2 +021900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +022000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG2024.2 +022100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG2024.2 +022200 COLUMN-NAMES-ROUTINE. SG2024.2 +022300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +022400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +022500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +022600 END-ROUTINE. SG2024.2 +022700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG2024.2 +022800 END-RTN-EXIT. SG2024.2 +022900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +023000 END-ROUTINE-1. SG2024.2 +023100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG2024.2 +023200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG2024.2 +023300 ADD PASS-COUNTER TO ERROR-HOLD. SG2024.2 +023400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG2024.2 +023500 MOVE PASS-COUNTER TO CCVS-E-4-1. SG2024.2 +023600 MOVE ERROR-HOLD TO CCVS-E-4-2. SG2024.2 +023700 MOVE CCVS-E-4 TO CCVS-E-2-2. SG2024.2 +023800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG2024.2 +023900 END-ROUTINE-12. SG2024.2 +024000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG2024.2 +024100 IF ERROR-COUNTER IS EQUAL TO ZERO SG2024.2 +024200 MOVE "NO " TO ERROR-TOTAL SG2024.2 +024300 ELSE SG2024.2 +024400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG2024.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. SG2024.2 +024600 PERFORM WRITE-LINE. SG2024.2 +024700 END-ROUTINE-13. SG2024.2 +024800 IF DELETE-CNT IS EQUAL TO ZERO SG2024.2 +024900 MOVE "NO " TO ERROR-TOTAL ELSE SG2024.2 +025000 MOVE DELETE-CNT TO ERROR-TOTAL. SG2024.2 +025100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG2024.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +025300 IF INSPECT-COUNTER EQUAL TO ZERO SG2024.2 +025400 MOVE "NO " TO ERROR-TOTAL SG2024.2 +025500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG2024.2 +025600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG2024.2 +025700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +025800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2024.2 +025900 WRITE-LINE. SG2024.2 +026000 ADD 1 TO RECORD-COUNT. SG2024.2 +026100 IF RECORD-COUNT GREATER 50 SG2024.2 +026200 MOVE DUMMY-RECORD TO DUMMY-HOLD SG2024.2 +026300 MOVE SPACE TO DUMMY-RECORD SG2024.2 +026400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2024.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG2024.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG2024.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG2024.2 +026800 MOVE DUMMY-HOLD TO DUMMY-RECORD SG2024.2 +026900 MOVE ZERO TO RECORD-COUNT. SG2024.2 +027000 PERFORM WRT-LN. SG2024.2 +027100 WRT-LN. SG2024.2 +027200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2024.2 +027300 MOVE SPACE TO DUMMY-RECORD. SG2024.2 +027400 BLANK-LINE-PRINT. SG2024.2 +027500 PERFORM WRT-LN. SG2024.2 +027600 FAIL-ROUTINE. SG2024.2 +027700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2024.2 +027800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2024.2 +027900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2024.2 +028000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +028100 GO TO FAIL-ROUTINE-EX. SG2024.2 +028200 FAIL-ROUTINE-WRITE. SG2024.2 +028300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG2024.2 +028400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG2024.2 +028500 FAIL-ROUTINE-EX. EXIT. SG2024.2 +028600 BAIL-OUT. SG2024.2 +028700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG2024.2 +028800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG2024.2 +028900 BAIL-OUT-WRITE. SG2024.2 +029000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2024.2 +029100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2024.2 +029200 BAIL-OUT-EX. EXIT. SG2024.2 +029300 CCVS1-EXIT. SG2024.2 +029400 EXIT. SG2024.2 +029500 SECT-SG-02-001 SECTION 00 . SG2024.2 +029600 SG-02-001. SG2024.2 +029700 P0003. SG2024.2 +029800 MOVE "B" TO PERF-OVER-RES-B. SG2024.2 +029900 P0004. SG2024.2 +030000 MOVE "X" TO PERF-RES-OVER-A. SG2024.2 +030100 GO TO P4801. SG2024.2 +030200 P0010. SG2024.2 +030300 PERFORM CCVS1. SG2024.2 +030400 TEST-1. SG2024.2 +030500 MOVE SPACE TO CORRECT-A. SG2024.2 +030600* NOTE THAT A TEST WILL BE MADE TO ENSURE THAT A ROUTINE SG2024.2 +030700* PERFORMED IN THE OVERLAYABLE PART OF THE PERMANENT SG2024.2 +030800* SEGMENT WILL BE LEFT IN ITS LAST USED STATE --- AN SG2024.2 +030900* ALTER STATEMENT WILL BE USED FOR THIS TEST. SG2024.2 +031000 PERFORM SEC39. SG2024.2 +031100 PERFORM P3901 THRU P3904. SG2024.2 +031200 PERFORM SEC39. SG2024.2 +031300 IF LAST-STATE-A EQUAL TO "23" PERFORM PASS SG2024.2 +031400 ELSE MOVE LAST-STATE-A TO COMPUTED-A SG2024.2 +031500 MOVE "23" TO CORRECT-A SG2024.2 +031600 PERFORM FAIL. SG2024.2 +031700 GO TO TEST-1-WRITE. SG2024.2 +031800 TEST-1-DELETE. SG2024.2 +031900 PERFORM DE-LETE. SG2024.2 +032000 TEST-1-WRITE. SG2024.2 +032100 MOVE "TEST-1" TO PAR-NAME. SG2024.2 +032200 MOVE "LAST USED STATE" TO FEATURE. SG2024.2 +032300 PERFORM PRINT-DETAIL. SG2024.2 +032400 TEST-2. SG2024.2 +032500 MOVE SPACE TO CORRECT-A. SG2024.2 +032600* NOTE THAT A TEST WILL BE MADE TO ENSURE THAT A STATEMENT SG2024.2 +032700* IN THE OVERLAYABLE PART OF THE FIXED PORTION CAN BE SG2024.2 +032800* ALTERED FROM THE PERMANENT SEGMENT EVEN THOUGH THE SG2024.2 +032900* ALTER REFERS TO A SEGMENT NOT YET CALLED FOR SG2024.2 +033000* EXECUTION. SG2024.2 +033100 ALTER P4001 TO PROCEED TO P4003. SG2024.2 +033200 PERFORM SEC40. SG2024.2 +033300 IF ALTER-NOT-CALL EQUAL TO "B" PERFORM PASS SG2024.2 +033400 ELSE MOVE ALTER-NOT-CALL TO COMPUTED-A SG2024.2 +033500 MOVE "B" TO CORRECT-A SG2024.2 +033600 PERFORM FAIL. SG2024.2 +033700 GO TO TEST-2-WRITE. SG2024.2 +033800 TEST-2-DELETE. SG2024.2 +033900 PERFORM DE-LETE. SG2024.2 +034000 TEST-2-WRITE. SG2024.2 +034100 MOVE "TEST-2" TO PAR-NAME. SG2024.2 +034200 MOVE "ALTER NOT CALLD" TO FEATURE. SG2024.2 +034300 PERFORM PRINT-DETAIL. SG2024.2 +034400 TEST-3. SG2024.2 +034500 MOVE SPACE TO CORRECT-A. SG2024.2 +034600* NOTE THIS TEST WILL ENSURE THAT A PERFORM STATEMENT SG2024.2 +034700* REFERENCING A OVERLAYABLE FOLLOWED BY A PERMANENT SG2024.2 +034800* SEGMENT OF THE FIXED PORTION WILL BE EXECUTED OK. SG2024.2 +034900 PERFORM P4501 THRU P0003. SG2024.2 +035000 IF PERF-OVER-RES IS EQUAL TO "AB" PERFORM PASS SG2024.2 +035100 ELSE MOVE PERF-OVER-RES TO COMPUTED-A SG2024.2 +035200 MOVE "AB" TO CORRECT-A SG2024.2 +035300 PERFORM FAIL. SG2024.2 +035400 GO TO TEST-3-WRITE. SG2024.2 +035500 TEST-3-DELETE. SG2024.2 +035600 PERFORM DE-LETE. SG2024.2 +035700 TEST-3-WRITE. SG2024.2 +035800 MOVE "TEST-3" TO PAR-NAME. SG2024.2 +035900 MOVE "PERFORM OVER/FIX" TO FEATURE. SG2024.2 +036000 PERFORM PRINT-DETAIL. SG2024.2 +036100 TEST-4. SG2024.2 +036200 MOVE SPACE TO CORRECT-A. SG2024.2 +036300* NOTE THIS TEST WILL ENSURE THAT A PERFORM STATEMENT SG2024.2 +036400* REFERENCING A PERMANENT SEGMENT FOLLOWED BY AN SG2024.2 +036500* OVERLAYABLE SEGMENT OF THE FIXED PORTION WILL SG2024.2 +036600* BE EXECUTED OK. SG2024.2 +036700 PERFORM P0004 THRU P4802. SG2024.2 +036800 IF PERF-RES-OVER EQUAL TO "XY" PERFORM PASS SG2024.2 +036900 ELSE MOVE PERF-RES-OVER TO COMPUTED-A SG2024.2 +037000 MOVE "XY" TO CORRECT-A SG2024.2 +037100 PERFORM FAIL. SG2024.2 +037200 GO TO TEST-4-WRITE. SG2024.2 +037300 TEST-4-DELETE. SG2024.2 +037400 PERFORM DE-LETE. SG2024.2 +037500 TEST-4-WRITE. SG2024.2 +037600 MOVE "TEST-4" TO PAR-NAME. SG2024.2 +037700 MOVE "PERFORM FIX/OVER" TO FEATURE. SG2024.2 +037800 PERFORM PRINT-DETAIL. SG2024.2 +037900 TEST-5. SG2024.2 +038000 MOVE SPACE TO CORRECT-A. SG2024.2 +038100* NOTE THIS TEST WILL ENSURE THAT THE LOGICAL PATH OF A SG2024.2 +038200* PROGRAM CAN PROCEED FROM THE PERMANENT SEGMENT OF SG2024.2 +038300* OF THE FIXED PORTION (IE IMPLIED FALL-THRU). SG2024.2 +038400 MOVE "A" TO FALL-RSLT-1. SG2024.2 +038500 SEC28 SECTION 28. SG2024.2 +038600 P2801. SG2024.2 +038700 MOVE "B" TO FALL-RSLT-2. SG2024.2 +038800 IF FALL-RSLT EQUAL TO "AB" PERFORM PASS SG2024.2 +038900 ELSE MOVE FALL-RSLT TO COMPUTED-A SG2024.2 +039000 MOVE "AB" TO CORRECT-A SG2024.2 +039100 PERFORM FAIL. SG2024.2 +039200 GO TO TEST-5-WRITE. SG2024.2 +039300 TEST-5-DELETE. SG2024.2 +039400 PERFORM DE-LETE. SG2024.2 +039500 TEST-5-WRITE. SG2024.2 +039600 MOVE "TEST-5" TO PAR-NAME. SG2024.2 +039700 MOVE "FALL THRU IMPLIED" TO FEATURE. SG2024.2 +039800 PERFORM PRINT-DETAIL. SG2024.2 +039900 CLOSE-ROUTINE. SG2024.2 +040000 GO TO CLOSE-FILES. SG2024.2 +040100 SEC39 SECTION 39. SG2024.2 +040200 P3901. SG2024.2 +040300 GO TO P3902. SG2024.2 +040400 P3902. SG2024.2 +040500 ALTER P3901 TO PROCEED TO P3903. SG2024.2 +040600 ADD 1 TO LAST-STATE-B. SG2024.2 +040700 GO TO P3904. SG2024.2 +040800 P3903. SG2024.2 +040900 ALTER P3901 TO PROCEED TO P3902. SG2024.2 +041000 ADD 3 TO LAST-STATE-C. SG2024.2 +041100 P3904. SG2024.2 +041200 EXIT. SG2024.2 +041300 SEC40 SECTION 40. SG2024.2 +041400 P4001. SG2024.2 +041500 GO TO P4002. SG2024.2 +041600 P4002. SG2024.2 +041700 MOVE "A" TO ALTER-NOT-CALL. SG2024.2 +041800 GO TO P4004. SG2024.2 +041900 P4003. SG2024.2 +042000 MOVE "B" TO ALTER-NOT-CALL. SG2024.2 +042100 P4004. SG2024.2 +042200 EXIT. SG2024.2 +042300 SEC45 SECTION 45. SG2024.2 +042400 P4501. SG2024.2 +042500 MOVE "A" TO PERF-OVER-RES-A. SG2024.2 +042600 P4502. SG2024.2 +042700 GO TO P0003. SG2024.2 +042800 SEC48 SECTION 48. SG2024.2 +042900 P4801. SG2024.2 +043000 MOVE "Y" TO PERF-RES-OVER-B. SG2024.2 +043100 P4802. SG2024.2 +043200 EXIT. SG2024.2 diff --git a/tests/cobol85/SG/SG203A.CBL b/tests/cobol85/SG/SG203A.CBL new file mode 100755 index 00000000..6e0e7656 --- /dev/null +++ b/tests/cobol85/SG/SG203A.CBL @@ -0,0 +1,794 @@ +000100 IDENTIFICATION DIVISION. SG2034.2 +000200 PROGRAM-ID. SG2034.2 +000300 SG203A. SG2034.2 +000400 AUTHOR. SG2034.2 +000500 FEDERAL COMPILER TESTING CENTER. SG2034.2 +000600 INSTALLATION. SG2034.2 +000700 GENERAL SERVICES ADMINISTRATION SG2034.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG2034.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG2034.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG2034.2 +001100 FALLS CHURCH VIRGINIA 22041. SG2034.2 +001200 SG2034.2 +001300 PHONE (703) 756-6153 SG2034.2 +001400 SG2034.2 +001500 " HIGH ". SG2034.2 +001600 DATE-WRITTEN. SG2034.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG2034.2 +001800 CREATION DATE / VALIDATION DATE SG2034.2 +001900 "4.2 ". SG2034.2 +002000 SECURITY. SG2034.2 +002100 NONE. SG2034.2 +002200 THE FOLLOWING FEATURES ARE TESTED BY THIS PROGRAM --- SG2034.2 +002300 VARIOUS OPTIONS OF THE PERFORM AND ALTER STATEMENTS SG2034.2 +002400 ARE USED IN CONJUNCTION WITH THE SEGMENT-LIMIT CLAUSE SG2034.2 +002500 CHECKING INITIAL AND LAST-USED STATES. SG2034.2 +002600* SG2034.2 +002700 ENVIRONMENT DIVISION. SG2034.2 +002800 CONFIGURATION SECTION. SG2034.2 +002900 SOURCE-COMPUTER. SG2034.2 +003000 Linux. SG2034.2 +003100 OBJECT-COMPUTER. SG2034.2 +003200 Linux SG2034.2 +003300 SEGMENT-LIMIT IS 30. SG2034.2 +003400 INPUT-OUTPUT SECTION. SG2034.2 +003500 FILE-CONTROL. SG2034.2 +003600 SELECT PRINT-FILE ASSIGN TO SG2034.2 +003700 "report.log". SG2034.2 +003800 DATA DIVISION. SG2034.2 +003900 FILE SECTION. SG2034.2 +004000 FD PRINT-FILE SG2034.2 +004100 LABEL RECORDS SG2034.2 +004200 OMITTED SG2034.2 +004300 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG2034.2 +004400 01 PRINT-REC PICTURE X(120). SG2034.2 +004500 01 DUMMY-RECORD PICTURE X(120). SG2034.2 +004600 WORKING-STORAGE SECTION. SG2034.2 +004700 77 TEST-COUNTER PICTURE 99 VALUE ZERO. SG2034.2 +004800 77 TEST-CHECK PICTURE XXXX VALUE SPACE. SG2034.2 +004900 01 TEST-RESULTS. SG2034.2 +005000 02 FILLER PICTURE X VALUE SPACE. SG2034.2 +005100 02 FEATURE PICTURE X(20) VALUE SPACE. SG2034.2 +005200 02 FILLER PICTURE X VALUE SPACE. SG2034.2 +005300 02 P-OR-F PICTURE X(5) VALUE SPACE. SG2034.2 +005400 02 FILLER PICTURE X VALUE SPACE. SG2034.2 +005500 02 PAR-NAME. SG2034.2 +005600 03 FILLER PICTURE X(12) VALUE SPACE. SG2034.2 +005700 03 PARDOT-X PICTURE X VALUE SPACE. SG2034.2 +005800 03 DOTVALUE PICTURE 99 VALUE ZERO. SG2034.2 +005900 03 FILLER PIC X(5) VALUE SPACE. SG2034.2 +006000 02 FILLER PIC X(10) VALUE SPACE. SG2034.2 +006100 02 RE-MARK PIC X(61). SG2034.2 +006200 01 TEST-COMPUTED. SG2034.2 +006300 02 FILLER PIC X(30) VALUE SPACE. SG2034.2 +006400 02 FILLER PIC X(17) VALUE " COMPUTED=". SG2034.2 +006500 02 COMPUTED-X. SG2034.2 +006600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG2034.2 +006700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG2034.2 +006800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG2034.2 +006900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG2034.2 +007000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG2034.2 +007100 03 CM-18V0 REDEFINES COMPUTED-A. SG2034.2 +007200 04 COMPUTED-18V0 PICTURE -9(18). SG2034.2 +007300 04 FILLER PICTURE X. SG2034.2 +007400 03 FILLER PIC X(50) VALUE SPACE. SG2034.2 +007500 01 TEST-CORRECT. SG2034.2 +007600 02 FILLER PIC X(30) VALUE SPACE. SG2034.2 +007700 02 FILLER PIC X(17) VALUE " CORRECT =". SG2034.2 +007800 02 CORRECT-X. SG2034.2 +007900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG2034.2 +008000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG2034.2 +008100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG2034.2 +008200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG2034.2 +008300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG2034.2 +008400 03 CR-18V0 REDEFINES CORRECT-A. SG2034.2 +008500 04 CORRECT-18V0 PICTURE -9(18). SG2034.2 +008600 04 FILLER PICTURE X. SG2034.2 +008700 03 FILLER PIC X(50) VALUE SPACE. SG2034.2 +008800 01 CCVS-C-1. SG2034.2 +008900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG2034.2 +009000- "SS PARAGRAPH-NAME SG2034.2 +009100- " REMARKS". SG2034.2 +009200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG2034.2 +009300 01 CCVS-C-2. SG2034.2 +009400 02 FILLER PICTURE IS X VALUE IS SPACE. SG2034.2 +009500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG2034.2 +009600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG2034.2 +009700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG2034.2 +009800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG2034.2 +009900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG2034.2 +010000 01 REC-CT PICTURE 99 VALUE ZERO. SG2034.2 +010100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG2034.2 +010200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG2034.2 +010300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG2034.2 +010400 01 PASS-COUNTER PIC 999 VALUE ZERO. SG2034.2 +010500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG2034.2 +010600 01 ERROR-HOLD PIC 999 VALUE ZERO. SG2034.2 +010700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG2034.2 +010800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG2034.2 +010900 01 CCVS-H-1. SG2034.2 +011000 02 FILLER PICTURE X(27) VALUE SPACE. SG2034.2 +011100 02 FILLER PICTURE X(67) VALUE SG2034.2 +011200 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG2034.2 +011300- " SYSTEM". SG2034.2 +011400 02 FILLER PICTURE X(26) VALUE SPACE. SG2034.2 +011500 01 CCVS-H-2. SG2034.2 +011600 02 FILLER PICTURE X(52) VALUE IS SG2034.2 +011700 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG2034.2 +011800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG2034.2 +011900 02 TEST-ID PICTURE IS X(9). SG2034.2 +012000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG2034.2 +012100 01 CCVS-H-3. SG2034.2 +012200 02 FILLER PICTURE X(34) VALUE SG2034.2 +012300 " FOR OFFICIAL USE ONLY ". SG2034.2 +012400 02 FILLER PICTURE X(58) VALUE SG2034.2 +012500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG2034.2 +012600 02 FILLER PICTURE X(28) VALUE SG2034.2 +012700 " COPYRIGHT 1974 ". SG2034.2 +012800 01 CCVS-E-1. SG2034.2 +012900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG2034.2 +013000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG2034.2 +013100 02 ID-AGAIN PICTURE IS X(9). SG2034.2 +013200 02 FILLER PICTURE X(45) VALUE IS SG2034.2 +013300 " NTIS DISTRIBUTION COBOL 74". SG2034.2 +013400 01 CCVS-E-2. SG2034.2 +013500 02 FILLER PICTURE X(31) VALUE SG2034.2 +013600 SPACE. SG2034.2 +013700 02 FILLER PICTURE X(21) VALUE SPACE. SG2034.2 +013800 02 CCVS-E-2-2. SG2034.2 +013900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG2034.2 +014000 03 FILLER PICTURE IS X VALUE IS SPACE. SG2034.2 +014100 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG2034.2 +014200 01 CCVS-E-3. SG2034.2 +014300 02 FILLER PICTURE X(22) VALUE SG2034.2 +014400 " FOR OFFICIAL USE ONLY". SG2034.2 +014500 02 FILLER PICTURE X(12) VALUE SPACE. SG2034.2 +014600 02 FILLER PICTURE X(58) VALUE SG2034.2 +014700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG2034.2 +014800 02 FILLER PICTURE X(13) VALUE SPACE. SG2034.2 +014900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG2034.2 +015000 01 CCVS-E-4. SG2034.2 +015100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG2034.2 +015200 02 FILLER PIC XXXX VALUE " OF ". SG2034.2 +015300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG2034.2 +015400 02 FILLER PIC X(40) VALUE SG2034.2 +015500 " TESTS WERE EXECUTED SUCCESSFULLY". SG2034.2 +015600 01 XXINFO. SG2034.2 +015700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG2034.2 +015800 02 INFO-TEXT. SG2034.2 +015900 04 FILLER PIC X(20) VALUE SPACE. SG2034.2 +016000 04 XXCOMPUTED PIC X(20). SG2034.2 +016100 04 FILLER PIC X(5) VALUE SPACE. SG2034.2 +016200 04 XXCORRECT PIC X(20). SG2034.2 +016300 01 HYPHEN-LINE. SG2034.2 +016400 02 FILLER PICTURE IS X VALUE IS SPACE. SG2034.2 +016500 02 FILLER PICTURE IS X(65) VALUE IS "************************SG2034.2 +016600- "*****************************************". SG2034.2 +016700 02 FILLER PICTURE IS X(54) VALUE IS "************************SG2034.2 +016800- "******************************". SG2034.2 +016900 01 CCVS-PGM-ID PIC X(6) VALUE SG2034.2 +017000 "SG203A". SG2034.2 +017100 PROCEDURE DIVISION. SG2034.2 +017200 SECT-SG-03-001 SECTION 49. SG2034.2 +017300 INIT-SG203. SG2034.2 +017400 PERFORM CCVS1. SG2034.2 +017500 GO TO 50. SG2034.2 +017600 CCVS1 SECTION. SG2034.2 +017700 OPEN-FILES. SG2034.2 +017800 OPEN OUTPUT PRINT-FILE. SG2034.2 +017900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG2034.2 +018000 MOVE SPACE TO TEST-RESULTS. SG2034.2 +018100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG2034.2 +018200 GO TO CCVS1-EXIT. SG2034.2 +018300 CLOSE-FILES. SG2034.2 +018400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG2034.2 +018500 TERMINATE-CCVS. SG2034.2 +018600*S EXIT PROGRAM. SG2034.2 +018700*SERMINATE-CALL. SG2034.2 +018800 STOP RUN. SG2034.2 +018900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2034.2 +019000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2034.2 +019100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2034.2 +019200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2034.2 +019300 MOVE "****TEST DELETED****" TO RE-MARK. SG2034.2 +019400 PRINT-DETAIL. SG2034.2 +019500 IF REC-CT NOT EQUAL TO ZERO SG2034.2 +019600 MOVE "." TO PARDOT-X SG2034.2 +019700 MOVE REC-CT TO DOTVALUE. SG2034.2 +019800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG2034.2 +019900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG2034.2 +020000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG2034.2 +020100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG2034.2 +020200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2034.2 +020300 MOVE SPACE TO CORRECT-X. SG2034.2 +020400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2034.2 +020500 MOVE SPACE TO RE-MARK. SG2034.2 +020600 HEAD-ROUTINE. SG2034.2 +020700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +020800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG2034.2 +020900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG2034.2 +021000 COLUMN-NAMES-ROUTINE. SG2034.2 +021100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +021200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +021300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +021400 END-ROUTINE. SG2034.2 +021500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG2034.2 +021600 END-RTN-EXIT. SG2034.2 +021700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +021800 END-ROUTINE-1. SG2034.2 +021900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG2034.2 +022000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG2034.2 +022100 ADD PASS-COUNTER TO ERROR-HOLD. SG2034.2 +022200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG2034.2 +022300 MOVE PASS-COUNTER TO CCVS-E-4-1. SG2034.2 +022400 MOVE ERROR-HOLD TO CCVS-E-4-2. SG2034.2 +022500 MOVE CCVS-E-4 TO CCVS-E-2-2. SG2034.2 +022600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG2034.2 +022700 END-ROUTINE-12. SG2034.2 +022800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG2034.2 +022900 IF ERROR-COUNTER IS EQUAL TO ZERO SG2034.2 +023000 MOVE "NO " TO ERROR-TOTAL SG2034.2 +023100 ELSE SG2034.2 +023200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG2034.2 +023300 MOVE CCVS-E-2 TO DUMMY-RECORD. SG2034.2 +023400 PERFORM WRITE-LINE. SG2034.2 +023500 END-ROUTINE-13. SG2034.2 +023600 IF DELETE-CNT IS EQUAL TO ZERO SG2034.2 +023700 MOVE "NO " TO ERROR-TOTAL ELSE SG2034.2 +023800 MOVE DELETE-CNT TO ERROR-TOTAL. SG2034.2 +023900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG2034.2 +024000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +024100 IF INSPECT-COUNTER EQUAL TO ZERO SG2034.2 +024200 MOVE "NO " TO ERROR-TOTAL SG2034.2 +024300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG2034.2 +024400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG2034.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +024600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2034.2 +024700 WRITE-LINE. SG2034.2 +024800 ADD 1 TO RECORD-COUNT. SG2034.2 +024900 IF RECORD-COUNT GREATER 50 SG2034.2 +025000 MOVE DUMMY-RECORD TO DUMMY-HOLD SG2034.2 +025100 MOVE SPACE TO DUMMY-RECORD SG2034.2 +025200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2034.2 +025300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG2034.2 +025400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG2034.2 +025500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG2034.2 +025600 MOVE DUMMY-HOLD TO DUMMY-RECORD SG2034.2 +025700 MOVE ZERO TO RECORD-COUNT. SG2034.2 +025800 PERFORM WRT-LN. SG2034.2 +025900 WRT-LN. SG2034.2 +026000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2034.2 +026100 MOVE SPACE TO DUMMY-RECORD. SG2034.2 +026200 BLANK-LINE-PRINT. SG2034.2 +026300 PERFORM WRT-LN. SG2034.2 +026400 FAIL-ROUTINE. SG2034.2 +026500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2034.2 +026600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2034.2 +026700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2034.2 +026800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +026900 GO TO FAIL-ROUTINE-EX. SG2034.2 +027000 FAIL-ROUTINE-WRITE. SG2034.2 +027100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG2034.2 +027200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG2034.2 +027300 FAIL-ROUTINE-EX. EXIT. SG2034.2 +027400 BAIL-OUT. SG2034.2 +027500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG2034.2 +027600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG2034.2 +027700 BAIL-OUT-WRITE. SG2034.2 +027800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2034.2 +027900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2034.2 +028000 BAIL-OUT-EX. EXIT. SG2034.2 +028100 CCVS1-EXIT. SG2034.2 +028200 EXIT. SG2034.2 +028300 50 SECTION 50. SG2034.2 +028400 PARA-50. SG2034.2 +028500 MOVE SPACE TO TEST-CHECK. SG2034.2 +028600 29 SECTION 29. SG2034.2 +028700 PARA-29. SG2034.2 +028800 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +028900* NOTE *******TEST 1 BEGINS HERE**********. SG2034.2 +029000 67 SECTION 67. SG2034.2 +029100 PARA-67. SG2034.2 +029200 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +029300 PERFORM PASS SG2034.2 +029400 GO TO WRITE-67. SG2034.2 +029500 MOVE "GOOD" TO CORRECT-A. SG2034.2 +029600 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +029700 PERFORM FAIL. SG2034.2 +029800 GO TO WRITE-67. SG2034.2 +029900 DELETE-67. SG2034.2 +030000 PERFORM DE-LETE. SG2034.2 +030100 WRITE-67. SG2034.2 +030200 MOVE "SEGM-TEST-01" TO PAR-NAME. SG2034.2 +030300 MOVE "TEST BEGINS IN PARA-67" TO RE-MARK. SG2034.2 +030400 MOVE "FALL THRU IND SEG" TO FEATURE. SG2034.2 +030500 PERFORM PRINT-DETAIL. SG2034.2 +030600* NOTE *******TEST 2 BEGINS HERE**********. SG2034.2 +030700 30 SECTION 30. SG2034.2 +030800 PARA-30. SG2034.2 +030900 MOVE SPACE TO TEST-CHECK. SG2034.2 +031000 51 SECTION 51. SG2034.2 +031100 PARA-51. SG2034.2 +031200 MOVE "BAD " TO TEST-CHECK. SG2034.2 +031300 52 SECTION 52. SG2034.2 +031400 PARA-52. SG2034.2 +031500 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +031600 31 SECTION 31. SG2034.2 +031700 PARA-31. SG2034.2 +031800 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +031900 PERFORM PASS SG2034.2 +032000 GO TO WRITE-31. SG2034.2 +032100 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +032200 MOVE "GOOD" TO CORRECT-A. SG2034.2 +032300 PERFORM FAIL. SG2034.2 +032400 GO TO WRITE-31. SG2034.2 +032500 DELETE-31. SG2034.2 +032600 PERFORM DE-LETE. SG2034.2 +032700 WRITE-31. SG2034.2 +032800 MOVE "SEGM-TEST-02" TO PAR-NAME. SG2034.2 +032900 MOVE "TEST BEGINS IN PARA-31" TO RE-MARK. SG2034.2 +033000 PERFORM PRINT-DETAIL. SG2034.2 +033100* NOTE *******TEST 3 BEGINS HERE**********. SG2034.2 +033200 53 SECTION 53. SG2034.2 +033300 PARA-53. SG2034.2 +033400 GO TO PARA-54. SG2034.2 +033500 99 SECTION 99. SG2034.2 +033600 PARA-99. SG2034.2 +033700 PERFORM PARA-32 THROUGH PARA-33 8 TIMES. SG2034.2 +033800 IF TEST-COUNTER EQUAL TO 8 SG2034.2 +033900 PERFORM PASS SG2034.2 +034000 GO TO WRITE-99. SG2034.2 +034100 MOVE TEST-COUNTER TO COMPUTED-N. SG2034.2 +034200 MOVE 8 TO CORRECT-N. SG2034.2 +034300 PERFORM FAIL. SG2034.2 +034400 GO TO WRITE-99. SG2034.2 +034500 DELETE-99. SG2034.2 +034600 PERFORM DE-LETE. SG2034.2 +034700 WRITE-99. SG2034.2 +034800 MOVE "SEGM-TEST-03" TO PAR-NAME. SG2034.2 +034900 MOVE "TEST BEGINS IN PARA-99" TO RE-MARK. SG2034.2 +035000 MOVE "PERFORM IND SEG " TO FEATURE. SG2034.2 +035100 PERFORM PRINT-DETAIL. SG2034.2 +035200* NOTE *******TEST 4 BEGINS HERE**********. SG2034.2 +035300 ALTER PARA-32 TO PARA-32A. SG2034.2 +035400 GO TO PARA-34. SG2034.2 +035500 54 SECTION 54. SG2034.2 +035600 PARA-54. SG2034.2 +035700 GO TO PARA-54A. SG2034.2 +035800 PARA-54A. SG2034.2 +035900 ALTER PARA-54 TO PROCEED TO PARA-54B. SG2034.2 +036000 GO TO PARA-54. SG2034.2 +036100 PARA-54B. SG2034.2 +036200 ALTER PARA-54 TO PROCEED TO PARA-54A. SG2034.2 +036300 GO TO PARA-99. SG2034.2 +036400 32 SECTION 32. SG2034.2 +036500 PARA-32. SG2034.2 +036600 GO TO PARA-32A. SG2034.2 +036700 PARA-32A. SG2034.2 +036800 ALTER PARA-32 TO PROCEED TO PARA-32C. SG2034.2 +036900 PARA-32B. SG2034.2 +037000 MOVE 16 TO TEST-COUNTER. SG2034.2 +037100 GO TO PARA-32. SG2034.2 +037200 PARA-32C. SG2034.2 +037300 SUBTRACT 1 FROM TEST-COUNTER. SG2034.2 +037400 33 SECTION 33. SG2034.2 +037500 PARA-33. SG2034.2 +037600 EXIT. SG2034.2 +037700 34 SECTION 34. SG2034.2 +037800 PARA-34. SG2034.2 +037900 GO TO PARA-34A. SG2034.2 +038000 PARA-34A. SG2034.2 +038100 ALTER PARA-34 TO PROCEED TO PARA-55. SG2034.2 +038200 GO TO PARA-32. SG2034.2 +038300 55 SECTION 55. SG2034.2 +038400 PARA-55. SG2034.2 +038500 IF TEST-COUNTER EQUAL TO 15 SG2034.2 +038600 PERFORM PASS SG2034.2 +038700 GO TO WRITE-55. SG2034.2 +038800 MOVE TEST-COUNTER TO COMPUTED-N. SG2034.2 +038900 MOVE 15 TO CORRECT-N. SG2034.2 +039000 PERFORM FAIL. SG2034.2 +039100 GO TO WRITE-55. SG2034.2 +039200 DELETE-55. SG2034.2 +039300 PERFORM DE-LETE. SG2034.2 +039400 WRITE-55. SG2034.2 +039500 MOVE "SEGM-TEST-04" TO PAR-NAME. SG2034.2 +039600 MOVE "TEST BEGINS IN PARA-55" TO RE-MARK. SG2034.2 +039700 MOVE "ALTER OVLY FIXED SEG" TO FEATURE. SG2034.2 +039800 PERFORM PRINT-DETAIL. SG2034.2 +039900* NOTE *******TEST 5 BEGINS HERE**********. SG2034.2 +040000 56 SECTION 56. SG2034.2 +040100 PARA-56. SG2034.2 +040200 ALTER PARA-34 TO PROCEED TO PARA-56A. SG2034.2 +040300 MOVE 5 TO TEST-COUNTER. SG2034.2 +040400 GO TO PARA-32C. SG2034.2 +040500 PARA-56A. SG2034.2 +040600 IF TEST-COUNTER EQUAL TO 4 SG2034.2 +040700 PERFORM PASS SG2034.2 +040800 GO TO WRITE-56. SG2034.2 +040900 MOVE TEST-COUNTER TO COMPUTED-N. SG2034.2 +041000 MOVE 4 TO CORRECT-N. SG2034.2 +041100 PERFORM FAIL. SG2034.2 +041200 GO TO WRITE-56. SG2034.2 +041300 DELETE-56. SG2034.2 +041400 PERFORM DE-LETE. SG2034.2 +041500 WRITE-56. SG2034.2 +041600 MOVE "SEGM-TEST-05" TO PAR-NAME. SG2034.2 +041700 MOVE "TEST BEGINS IN PARA-56" TO RE-MARK. SG2034.2 +041800 PERFORM PRINT-DETAIL. SG2034.2 +041900* NOTE *******TEST 6 BEGINS HERE**********. SG2034.2 +042000 57 SECTION 57. SG2034.2 +042100 PARA-57. SG2034.2 +042200 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +042300 ALTER PARA-00 TO PROCEED TO PARA-00B. SG2034.2 +042400 GO TO PARA-00. SG2034.2 +042500 PARA-00. SG2034.2 +042600 GO TO PARA-00A. SG2034.2 +042700 PARA-00A. SG2034.2 +042800 MOVE "BAD " TO TEST-CHECK. SG2034.2 +042900 PARA-00B. SG2034.2 +043000* NOTE THIS PARAGRAPH SERVES NO PURPOSE OTHER THAN TO SG2034.2 +043100* VERIFY THAT FALLING THRU WILL NOT DISTURB PROGRAM FLOW. SG2034.2 +043200 59 SECTION 59. SG2034.2 +043300 PARA-59. SG2034.2 +043400* THIS SECTION SERVES NO PURPOSE EXCEPT TO VERIFY THAT SG2034.2 +043500* PROGRAM FLOW WILL NOT BE AFFECTED AND THE FOLLOWING SG2034.2 +043600* STATEMENT WILL BE IGNORED. SG2034.2 +043700 IF TEST-CHECK EQUAL TO "BAD " SG2034.2 +043800 MOVE "BAD " TO TEST-CHECK. SG2034.2 +043900 01 SECTION 01. SG2034.2 +044000 PARA-01. SG2034.2 +044100 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +044200 PERFORM PASS SG2034.2 +044300 GO TO WRITE-01. SG2034.2 +044400 MOVE "GOOD" TO CORRECT-A. SG2034.2 +044500 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +044600 PERFORM FAIL. SG2034.2 +044700 GO TO WRITE-01. SG2034.2 +044800 DELETE-01. SG2034.2 +044900 PERFORM DE-LETE. SG2034.2 +045000 WRITE-01. SG2034.2 +045100 MOVE "SEGM-TEST-06" TO PAR-NAME. SG2034.2 +045200 MOVE "TEST BEGINS IN PARA-01" TO RE-MARK. SG2034.2 +045300 MOVE "FALL THRU IND SEG" TO FEATURE. SG2034.2 +045400 PERFORM PRINT-DETAIL. SG2034.2 +045500* NOTE *******TEST 7 BEGINS HERE**********. SG2034.2 +045600 02 SECTION 02. SG2034.2 +045700 PARA-02. SG2034.2 +045800 MOVE SPACE TO TEST-CHECK. SG2034.2 +045900 PERFORM 59. SG2034.2 +046000 IF TEST-CHECK EQUAL TO SPACE SG2034.2 +046100 PERFORM PASS SG2034.2 +046200 GO TO WRITE-02. SG2034.2 +046300 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +046400 MOVE SPACE TO CORRECT-A. SG2034.2 +046500 PERFORM FAIL. SG2034.2 +046600 GO TO WRITE-02. SG2034.2 +046700 DELETE-02. SG2034.2 +046800 PERFORM DE-LETE. SG2034.2 +046900 WRITE-02. SG2034.2 +047000 MOVE "SEGM-TEST-07" TO PAR-NAME. SG2034.2 +047100 MOVE "TEST BEGINS IN PARA-02" TO RE-MARK. SG2034.2 +047200 MOVE "PERFORM IND SEG" TO FEATURE. SG2034.2 +047300 PERFORM PRINT-DETAIL. SG2034.2 +047400* NOTE *******TEST 8 BEGINS HERE**********. SG2034.2 +047500 35 SECTION 35. SG2034.2 +047600 PARA-35. SG2034.2 +047700 ALTER PARA-34 TO PROCEED TO PARA-35A. SG2034.2 +047800 MOVE 1 TO TEST-COUNTER. SG2034.2 +047900 GO TO PARA-32. SG2034.2 +048000 PARA-35A. SG2034.2 +048100 IF TEST-COUNTER EQUAL TO ZERO SG2034.2 +048200 PERFORM PASS SG2034.2 +048300 GO TO WRITE-35. SG2034.2 +048400 MOVE TEST-COUNTER TO COMPUTED-N. SG2034.2 +048500 MOVE 0 TO CORRECT-N. SG2034.2 +048600 PERFORM FAIL. SG2034.2 +048700 GO TO WRITE-35. SG2034.2 +048800 DELETE-35. SG2034.2 +048900 PERFORM DE-LETE. SG2034.2 +049000 WRITE-35. SG2034.2 +049100 MOVE "SEGM-TEST-08" TO PAR-NAME. SG2034.2 +049200 MOVE "TEST BEGINS IN PARA-35" TO RE-MARK. SG2034.2 +049300 MOVE "ALTER OVLY FIXED SEG" TO FEATURE. SG2034.2 +049400 PERFORM PRINT-DETAIL. SG2034.2 +049500* NOTE *******TEST 9 BEGINS HERE**********. SG2034.2 +049600 36 SECTION 36. SG2034.2 +049700 PARA-36. SG2034.2 +049800 GO TO PARA-36A. SG2034.2 +049900 PARA-36A. SG2034.2 +050000 ALTER PARA-36 TO PROCEED TO PARA-36B. SG2034.2 +050100 MOVE SPACE TO TEST-CHECK. SG2034.2 +050200 GO TO 85. SG2034.2 +050300 PARA-36B. SG2034.2 +050400 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +050500 PERFORM PASS SG2034.2 +050600 GO TO WRITE-36. SG2034.2 +050700 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +050800 MOVE "GOOD" TO CORRECT-A. SG2034.2 +050900 PERFORM FAIL. SG2034.2 +051000 GO TO WRITE-36. SG2034.2 +051100 DELETE-36. SG2034.2 +051200 PERFORM DE-LETE. SG2034.2 +051300 WRITE-36. SG2034.2 +051400 MOVE "SEGM-TEST-09" TO PAR-NAME. SG2034.2 +051500 MOVE "TEST BEGINS IN PARA-36" TO RE-MARK. SG2034.2 +051600 MOVE "GO TO NON-RES SEG" TO FEATURE. SG2034.2 +051700 PERFORM PRINT-DETAIL. SG2034.2 +051800* NOTE *******TEST 10 BEGINS HERE*********. SG2034.2 +051900 GO TO PARA-58. SG2034.2 +052000 85 SECTION 85. SG2034.2 +052100 PARA-85. SG2034.2 +052200 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +052300 GO TO 36. SG2034.2 +052400 98 SECTION 98. SG2034.2 +052500 PARA-98. SG2034.2 +052600 MOVE "GOOD" TO TEST-CHECK SG2034.2 +052700 GO TO PARA-37. SG2034.2 +052800 58 SECTION 58. SG2034.2 +052900 PARA-58. SG2034.2 +053000 MOVE SPACE TO TEST-CHECK. SG2034.2 +053100 PARA-58A. SG2034.2 +053200 GO TO PARA-58B. SG2034.2 +053300 PARA-58B. SG2034.2 +053400 MOVE "BAD " TO TEST-CHECK. SG2034.2 +053500 GO TO PARA-58D. SG2034.2 +053600 PARA-58C. SG2034.2 +053700 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +053800 GO TO PARA-58E. SG2034.2 +053900 PARA-58D. SG2034.2 +054000 ALTER PARA-58A TO PARA-58C. SG2034.2 +054100 PARA-58E. SG2034.2 +054200 EXIT. SG2034.2 +054300 37 SECTION 37. SG2034.2 +054400 PARA-37. SG2034.2 +054500 PERFORM PARA-58A THRU PARA-58E. SG2034.2 +054600 IF TEST-CHECK EQUAL TO "BAD " SG2034.2 +054700 PERFORM PASS SG2034.2 +054800 GO TO WRITE-37. SG2034.2 +054900 MOVE "BAD " TO CORRECT-A. SG2034.2 +055000 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +055100 PERFORM FAIL. SG2034.2 +055200 GO TO WRITE-37. SG2034.2 +055300 DELETE-37. SG2034.2 +055400 PERFORM DE-LETE. SG2034.2 +055500 WRITE-37. SG2034.2 +055600 MOVE "SEGM-TEST-10" TO PAR-NAME. SG2034.2 +055700 MOVE "TEST BEGINS IN PARA-37" TO RE-MARK. SG2034.2 +055800 MOVE "INITIAL STATE" TO FEATURE. SG2034.2 +055900 PERFORM PRINT-DETAIL. SG2034.2 +056000* NOTE *******TEST 11 BEGINS HERE*********. SG2034.2 +056100 38 SECTION 38. SG2034.2 +056200 PARA-38. SG2034.2 +056300 PERFORM PARA-58D. SG2034.2 +056400 PERFORM PARA-58A THRU PARA-58E. SG2034.2 +056500 IF TEST-CHECK EQUAL TO "BAD " SG2034.2 +056600 PERFORM PASS SG2034.2 +056700 GO TO WRITE-38. SG2034.2 +056800 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +056900 MOVE "BAD " TO CORRECT-A. SG2034.2 +057000 PERFORM FAIL. SG2034.2 +057100 GO TO WRITE-38. SG2034.2 +057200 DELETE-38. SG2034.2 +057300 PERFORM DE-LETE. SG2034.2 +057400 WRITE-38. SG2034.2 +057500 MOVE "SEGM-TEST-11" TO PAR-NAME. SG2034.2 +057600 MOVE "TEST BEGINS IN PARA-38" TO RE-MARK. SG2034.2 +057700 PERFORM PRINT-DETAIL. SG2034.2 +057800* NOTE *******TEST 12 BEGINS HERE*********. SG2034.2 +057900 03 SECTION 03. SG2034.2 +058000 PARA-03. SG2034.2 +058100 MOVE SPACE TO TEST-CHECK. SG2034.2 +058200 PERFORM PARA-39D. SG2034.2 +058300 PERFORM PARA-39A THROUGH PARA-39E. SG2034.2 +058400 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +058500 PERFORM PASS SG2034.2 +058600 GO TO WRITE-03. SG2034.2 +058700 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +058800 MOVE "GOOD" TO CORRECT-A. SG2034.2 +058900 PERFORM FAIL. SG2034.2 +059000 GO TO WRITE-03. SG2034.2 +059100 DELETE-03. SG2034.2 +059200 PERFORM DE-LETE. SG2034.2 +059300 WRITE-03. SG2034.2 +059400 MOVE "SEGM-TEST-12" TO PAR-NAME. SG2034.2 +059500 MOVE "TEST BEGINS IN PARA-03" TO RE-MARK. SG2034.2 +059600 MOVE "LAST USED STATE" TO FEATURE. SG2034.2 +059700 PERFORM PRINT-DETAIL. SG2034.2 +059800* NOTE *******TEST 13 BEGINS HERE*********. SG2034.2 +059900 39 SECTION 39. SG2034.2 +060000 PARA-39A. SG2034.2 +060100 GO TO PARA-39B. SG2034.2 +060200 PARA-39B. SG2034.2 +060300 MOVE "BAD " TO TEST-CHECK. SG2034.2 +060400 GO TO PARA-39D. SG2034.2 +060500 PARA-39C. SG2034.2 +060600 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +060700 GO TO PARA-39E. SG2034.2 +060800 PARA-39D. SG2034.2 +060900 ALTER PARA-39A TO PARA-39C. SG2034.2 +061000 PARA-39E. SG2034.2 +061100 EXIT. SG2034.2 +061200 04 SECTION 04. SG2034.2 +061300 PARA-04. SG2034.2 +061400 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +061500 PERFORM PASS SG2034.2 +061600 GO TO WRITE-04. SG2034.2 +061700 MOVE "GOOD" TO CORRECT-A. SG2034.2 +061800 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +061900 PERFORM FAIL. SG2034.2 +062000 GO TO WRITE-04. SG2034.2 +062100 DELETE-04. SG2034.2 +062200 PERFORM DE-LETE. SG2034.2 +062300 WRITE-04. SG2034.2 +062400 MOVE "SEGM-TEST-13" TO PAR-NAME. SG2034.2 +062500 MOVE "TEST BEGINS IN PARA-04" TO RE-MARK. SG2034.2 +062600 PERFORM PRINT-DETAIL. SG2034.2 +062700* NOTE *******TEST 14 BEGINS HERE*********. SG2034.2 +062800 MOVE SPACE TO TEST-CHECK. SG2034.2 +062900 MOVE 0 TO TEST-COUNTER. SG2034.2 +063000 40 SECTION 40. SG2034.2 +063100 PARA-40. SG2034.2 +063200 GO TO PARA-68. SG2034.2 +063300 PARA-40A. SG2034.2 +063400 GO TO PARA-68. SG2034.2 +063500 PARA-40B. SG2034.2 +063600 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +063700 PERFORM PASS SG2034.2 +063800 GO TO WRITE-40. SG2034.2 +063900 MOVE "GOOD" TO CORRECT-A. SG2034.2 +064000 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +064100 PERFORM FAIL. SG2034.2 +064200 GO TO WRITE-40. SG2034.2 +064300 DELETE-40. SG2034.2 +064400 PERFORM DE-LETE. SG2034.2 +064500 WRITE-40. SG2034.2 +064600 MOVE "SEGM-TEST-14" TO PAR-NAME. SG2034.2 +064700 MOVE "TEST BEGINS IN PARA-40B" TO RE-MARK. SG2034.2 +064800 MOVE "INITIAL STATE" TO FEATURE. SG2034.2 +064900 PERFORM PRINT-DETAIL. SG2034.2 +065000* NOTE *******TEST 15 BEGINS HERE*********. SG2034.2 +065100 MOVE SPACE TO TEST-CHECK. SG2034.2 +065200 IF TEST-COUNTER EQUAL TO 2 GO TO PARA-68C. SG2034.2 +065300* NOTE ***** THE PREVIOUS IF STMT WAS INSERTED TO KEEP TEST-14 SG2034.2 +065400* FROM LOOPING IF SEGMENT 68 WAS NOT IN THE INITIAL STATE SG2034.2 +065500* EACH TIME IT WAS ENTERED -- TEST-15 WILL ALSO FAIL SG2034.2 +065600* IN THIS CASE *****. SG2034.2 +065700 MOVE 2 TO TEST-COUNTER. SG2034.2 +065800* NOTE FALL THRU. SG2034.2 +065900 68 SECTION 68. SG2034.2 +066000 PARA-68. SG2034.2 +066100 GO TO PARA-68A. SG2034.2 +066200 PARA-68A. SG2034.2 +066300 ALTER PARA-68 TO PROCEED TO PARA-68B. SG2034.2 +066400 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +066500 IF TEST-COUNTER EQUAL TO 0 SG2034.2 +066600 ADD 1 TO TEST-COUNTER SG2034.2 +066700 GO TO PARA-40A. SG2034.2 +066800 IF TEST-COUNTER EQUAL TO 1 GO TO PARA-40B. SG2034.2 +066900 GO TO PARA-68C. SG2034.2 +067000 PARA-68B. SG2034.2 +067100 MOVE "BAD " TO TEST-CHECK. SG2034.2 +067200 ADD 1 TO TEST-COUNTER. SG2034.2 +067300 GO TO PARA-40B. SG2034.2 +067400 PARA-68C. SG2034.2 +067500 IF TEST-CHECK EQUAL TO "GOOD" SG2034.2 +067600 PERFORM PASS SG2034.2 +067700 GO TO WRITE-68. SG2034.2 +067800 MOVE "GOOD" TO CORRECT-A. SG2034.2 +067900 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +068000 PERFORM FAIL. SG2034.2 +068100 GO TO WRITE-68. SG2034.2 +068200 DELETE-68. SG2034.2 +068300 PERFORM DE-LETE. SG2034.2 +068400 WRITE-68. SG2034.2 +068500 MOVE "SEGM-TEST-15" TO PAR-NAME. SG2034.2 +068600 MOVE "TEST BEGINS IN PARA-68C" TO RE-MARK. SG2034.2 +068700 PERFORM PRINT-DETAIL. SG2034.2 +068800 41 SECTION 41. SG2034.2 +068900 PARA-41A. SG2034.2 +069000 MOVE SPACE TO TEST-CHECK. SG2034.2 +069100* NOTE ***** TEST 16 BEGINS HERE *****. SG2034.2 +069200 PERFORM TEST-16. SG2034.2 +069300 ALTER PARA-41B TO PARA-41D. SG2034.2 +069400 PERFORM PARA-41B THRU PARA-41E. SG2034.2 +069500 PERFORM TEST-16. SG2034.2 +069600 IF TEST-CHECK EQUAL TO "END" SG2034.2 +069700 PERFORM PASS SG2034.2 +069800 GO TO WRITE-41. SG2034.2 +069900 MOVE "END " TO CORRECT-A. SG2034.2 +070000 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +070100 PERFORM FAIL. SG2034.2 +070200 GO TO WRITE-41. SG2034.2 +070300 DELETE-41. SG2034.2 +070400 PERFORM DE-LETE. SG2034.2 +070500 WRITE-41. SG2034.2 +070600 MOVE "SEGM-TEST-16" TO PAR-NAME. SG2034.2 +070700 MOVE "TEST BEGINS IN PARA-41A" TO RE-MARK. SG2034.2 +070800 PERFORM PRINT-DETAIL. SG2034.2 +070900 GO TO 45. SG2034.2 +071000 TEST-16 SECTION 41. SG2034.2 +071100 PARA-41B. SG2034.2 +071200 GO TO PARA-41C. SG2034.2 +071300 PARA-41C. SG2034.2 +071400 MOVE "PFM1" TO TEST-CHECK. SG2034.2 +071500 GO TO PARA-41E. SG2034.2 +071600 PARA-41D. SG2034.2 +071700 MOVE "ALT1" TO TEST-CHECK. SG2034.2 +071800 ALTER PARA-41B TO PARA-41F. SG2034.2 +071900 GO TO TEST-16. SG2034.2 +072000 PARA-41F. SG2034.2 +072100 MOVE "END " TO TEST-CHECK. SG2034.2 +072200 GO TO PARA-41E. SG2034.2 +072300 PARA-41E. SG2034.2 +072400 EXIT. SG2034.2 +072500 TEST-16A SECTION 41. SG2034.2 +072600 61DUMMY. SG2034.2 +072700 EXIT. SG2034.2 +072800 45 SECTION 45. SG2034.2 +072900 PARA-45A. SG2034.2 +073000 MOVE SPACE TO TEST-CHECK. SG2034.2 +073100* NOTE ***** TEST 17 BEGINS HERE *****. SG2034.2 +073200 PERFORM PARA-45C. SG2034.2 +073300* NOTE PERFORM PARAGRAPH THAT ALTERS A PARAGRAPH IN A UNIQUE SG2034.2 +073400* SEGMENT CONTAINING THE SAME PRIORITY NUMBER. SG2034.2 +073500 PERFORM 45A THRU 45B. SG2034.2 +073600* NOTE THE WRITE PARAGRAPH FOR THIS TEST IS IN SEGMENT 46. SG2034.2 +073700 GO TO 45A. SG2034.2 +073800 DELETE-45. SG2034.2 +073900 PERFORM DE-LETE. SG2034.2 +074000 GO TO WRITE-46. SG2034.2 +074100 45A SECTION 45. SG2034.2 +074200 PARA-45B. SG2034.2 +074300 GO TO PARA-45D. SG2034.2 +074400 45B SECTION 45. SG2034.2 +074500 PARA-45C. SG2034.2 +074600 ALTER PARA-45B TO PROCEED TO PARA-45E. SG2034.2 +074700 PARA-45D. SG2034.2 +074800 MOVE "BAD " TO TEST-CHECK. SG2034.2 +074900 GO TO PARA-45G. SG2034.2 +075000 PARA-45E. SG2034.2 +075100 MOVE "GOOD" TO TEST-CHECK. SG2034.2 +075200 ALTER PARA-45B TO PROCEED TO PARA-45F. SG2034.2 +075300 GO TO PARA-45G. SG2034.2 +075400 PARA-45F. SG2034.2 +075500 MOVE "BETR" TO TEST-CHECK. SG2034.2 +075600* NOTE THE GO TO STMT IN PARA-45A SHOULD SHIFT CONTROL THRU SG2034.2 +075700* THIS PARAGRAPH AND FALL THRU TO THE EXIT FOLLOWED BY THE SG2034.2 +075800* COMPARISON OF TEST-CHECK. SG2034.2 +075900 PARA-45G. SG2034.2 +076000 EXIT. SG2034.2 +076100 46 SECTION 46. SG2034.2 +076200 PARA-46. SG2034.2 +076300 IF TEST-CHECK EQUAL TO "BETR" SG2034.2 +076400 PERFORM PASS SG2034.2 +076500 GO TO WRITE-46. SG2034.2 +076600 MOVE "BETR" TO CORRECT-A. SG2034.2 +076700 MOVE TEST-CHECK TO COMPUTED-A. SG2034.2 +076800 PERFORM FAIL. SG2034.2 +076900 WRITE-46. SG2034.2 +077000 MOVE "SEGM-TEST-17" TO PAR-NAME. SG2034.2 +077100 MOVE "TEST BEGINS IN PARA-46" TO RE-MARK. SG2034.2 +077200 PERFORM PRINT-DETAIL. SG2034.2 +077300 TEST-18 SECTION 47. SG2034.2 +077400 PARA-47. SG2034.2 +077500 MOVE SPACE TO TEST-CHECK. SG2034.2 +077600* NOTE ************** TEST 18 BEGINS HERE ***************. SG2034.2 +077700 ALTER PARA-05 TO PROCEED TO 69. SG2034.2 +077800 GO TO 05. SG2034.2 +077900 05 SECTION 05. SG2034.2 +078000 PARA-05. SG2034.2 +078100 GO TO. SG2034.2 +078200 PARA-05A. SG2034.2 +078300 MOVE "BAD" TO COMPUTED-A. SG2034.2 +078400 PERFORM FAIL. SG2034.2 +078500 GO TO WRITE-69. SG2034.2 +078600 69 SECTION 69. SG2034.2 +078700 PARA-69. SG2034.2 +078800 PERFORM PASS. SG2034.2 +078900 WRITE-69. SG2034.2 +079000 MOVE "ALTER RES TO NON-RES" TO FEATURE. SG2034.2 +079100 MOVE "SEGM-TEST-18" TO PAR-NAME. SG2034.2 +079200 MOVE "TEST BEGINS IN PARA-47" TO RE-MARK. SG2034.2 +079300 PERFORM PRINT-DETAIL. SG2034.2 +079400 GO TO CLOSE-FILES. SG2034.2 diff --git a/tests/cobol85/SG/SG204A.CBL b/tests/cobol85/SG/SG204A.CBL new file mode 100755 index 00000000..60fdc061 --- /dev/null +++ b/tests/cobol85/SG/SG204A.CBL @@ -0,0 +1,880 @@ +000100 IDENTIFICATION DIVISION. SG2044.2 +000200 PROGRAM-ID. SG2044.2 +000300 SG204A. SG2044.2 +000400 AUTHOR. SG2044.2 +000500 FEDERAL COMPILER TESTING CENTER. SG2044.2 +000600 INSTALLATION. SG2044.2 +000700 GENERAL SERVICES ADMINISTRATION SG2044.2 +000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. SG2044.2 +000900 SOFTWARE DEVELOPMENT OFFICE. SG2044.2 +001000 5203 LEESBURG PIKE SUITE 1100 SG2044.2 +001100 FALLS CHURCH VIRGINIA 22041. SG2044.2 +001200 SG2044.2 +001300 PHONE (703) 756-6153 SG2044.2 +001400 SG2044.2 +001500 " HIGH ". SG2044.2 +001600 DATE-WRITTEN. SG2044.2 +001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. SG2044.2 +001800 CREATION DATE / VALIDATION DATE SG2044.2 +001900 "4.2 ". SG2044.2 +002000 SECURITY. SG2044.2 +002100 NONE. SG2044.2 +002200 THIS PROGRAM CONTAINS 3 SORTS USING NUMERIC OR ALPHABETIC SG2044.2 +002300 KEYS - BUT NOT BOTH IN THE SAME KEY DUE TO DIFFERING SG2044.2 +002400 COLLATING SEQUENCES AMONG COMPUTERS. EXTERNAL FILES ARE SG2044.2 +002500 GENERATED INTERNALLY FOR SUBSEQUENT USE. THE SELECT CLAUSE SG2044.2 +002600 IS HIGHLY DEPENDENT ON HARDWARE. THE USER SHOULD EXERCISE THESG2044.2 +002700 VARIOUS OPTIONS OF HARDWARE ASSIGNMENTS TO THE EXTENT THEY SG2044.2 +002800 ARE AVAILABLE. THE SORT OF A MULTI-REEL FILE IS EXERCISED SG2044.2 +002900 IN PROGRAM ST202. HOWEVER THE EXERCISE OF THE "FOR MULTIPLE SG2044.2 +003000 REEL-UNIT" OF THE GIVING OPTION IS NOT DUE TO THE INDETER- SG2044.2 +003100 MINATE LENGTH OF SUCH A FILE (E.G. RECORDING DENSITY OR SIZE SG2044.2 +003200 OF UNIT) AND PROCESSING COST. SORT INPUT-OUTPUT OPTIONS SG2044.2 +003300 WILL BE EXERCISED AS FOLLOWS. SG2044.2 +003400 SORT 1 USING GIVING SG2044.2 +003500 SORT 2 INPUT PROC GIVING SG2044.2 +003600 SORT 3 INPUT PROC OUTPUT PROC SG2044.2 +003700 THIS PROGRAM ALSO EXERCISES THE "SAME RECORD AREA" CLAUSE. SG2044.2 +003800 SG2044.2 +003900 ENVIRONMENT DIVISION. SG2044.2 +004000 CONFIGURATION SECTION. SG2044.2 +004100 SOURCE-COMPUTER. SG2044.2 +004200 Linux. SG2044.2 +004300 OBJECT-COMPUTER. SG2044.2 +004400 Linux. SG2044.2 +004500 INPUT-OUTPUT SECTION. SG2044.2 +004600 FILE-CONTROL. SG2044.2 +004700 SELECT PRINT-FILE ASSIGN TO SG2044.2 +004800 "report.log". SG2044.2 +004900 SELECT SORT1 ASSIGN TO SG2044.2 +005000 "XXXXX027". SG2044.2 +005100 SELECT SORT2 ASSIGN TO SG2044.2 +005200 "XXXXX028". SG2044.2 +005300 SELECT SORT3 ASSIGN TO SG2044.2 +005400 "XXXXX029". SG2044.2 +005500 SELECT FILE1 ASSIGN TO SG2044.2 +005600 "XXXXX001". SG2044.2 +005700 SELECT FILE2 ASSIGN TO SG2044.2 +005800 "XXXXX014" SG2044.2 +005900 RESERVE 1 AREA. SG2044.2 +006000 SELECT FILE3 ASSIGN TO SG2044.2 +006100 "XXXXX015" SG2044.2 +006200 RESERVE 4 AREAS. SG2044.2 +006300 I-O-CONTROL. SG2044.2 +006400 SAME RECORD AREA FOR SORT1 SORT2 SG2044.2 +006500 SAME RECORD AREA FOR SORT3 FILE3. SG2044.2 +006600 DATA DIVISION. SG2044.2 +006700 FILE SECTION. SG2044.2 +006800 FD PRINT-FILE SG2044.2 +006900 LABEL RECORDS SG2044.2 +007000 OMITTED SG2044.2 +007100 DATA RECORD IS PRINT-REC DUMMY-RECORD. SG2044.2 +007200 01 PRINT-REC PICTURE X(120). SG2044.2 +007300 01 DUMMY-RECORD PICTURE X(120). SG2044.2 +007400 FD FILE1 SG2044.2 +007500 LABEL RECORDS ARE STANDARD SG2044.2 +007600 VALUE OF SG2044.2 +007700 OCLABELID SG2044.2 +007800 IS SG2044.2 +007900 "OCDUMMY" SG2044.2 +008000 BLOCK CONTAINS 10 RECORDS SG2044.2 +008100 DATA RECORD R1. SG2044.2 +008200 01 R1. SG2044.2 +008300 02 FILLER PICTURE X(120). SG2044.2 +008400 FD FILE2 SG2044.2 +008500 LABEL RECORDS ARE STANDARD SG2044.2 +008600 VALUE OF SG2044.2 +008700 OCLABELID SG2044.2 +008800 IS SG2044.2 +008900 "OCDUMMY" SG2044.2 +009000 BLOCK CONTAINS 10 RECORDS SG2044.2 +009100 DATA RECORD R2. SG2044.2 +009200 01 R2. SG2044.2 +009300 02 R2-KEYS. SG2044.2 +009400 03 R2-1 PICTURE 999. SG2044.2 +009500 03 R2-2 PICTURE AA. SG2044.2 +009600 03 R2-3 PICTURE AA. SG2044.2 +009700 02 FILLER PICTURE X(113). SG2044.2 +009800 FD FILE3 SG2044.2 +009900 BLOCK CONTAINS 10 RECORDS SG2044.2 +010000 LABEL RECORDS ARE STANDARD SG2044.2 +010100 VALUE OF SG2044.2 +010200 OCLABELID SG2044.2 +010300 IS SG2044.2 +010400 "OCDUMMY" SG2044.2 +010500 DATA RECORD IS R3. SG2044.2 +010600 01 R3. SG2044.2 +010700 02 R3-KEYS. SG2044.2 +010800 03 R3-1 PICTURE 999. SG2044.2 +010900 03 R3-2 PICTURE AA. SG2044.2 +011000 03 R3-3 PICTURE AA. SG2044.2 +011100 03 R3-4 PICTURE 9999. SG2044.2 +011200 02 FILLER PICTURE X(109). SG2044.2 +011300 SD SORT1 SG2044.2 +011400 RECORD CONTAINS 120 CHARACTERS SG2044.2 +011500 DATA RECORD IS S1. SG2044.2 +011600 01 S1. SG2044.2 +011700 02 S1-KEYS. SG2044.2 +011800 03 S1-1 PICTURE 999. SG2044.2 +011900 03 S1-2 PICTURE AA. SG2044.2 +012000 02 FILLER PICTURE X(115). SG2044.2 +012100 SD SORT2 SG2044.2 +012200 RECORD 120 SG2044.2 +012300 DATA RECORD IS S2. SG2044.2 +012400 01 S2. SG2044.2 +012500 02 S2-KEYS. SG2044.2 +012600 03 S2-1 PICTURE 999. SG2044.2 +012700 03 S2-2 PICTURE AA. SG2044.2 +012800 03 S2-3 PICTURE AA. SG2044.2 +012900 02 FILLER PICTURE X(113). SG2044.2 +013000 SD SORT3 SG2044.2 +013100 RECORD 120 CHARACTERS SG2044.2 +013200 DATA RECORD S3. SG2044.2 +013300 01 S3. SG2044.2 +013400 02 S3-KEYS. SG2044.2 +013500 03 S3-1 PICTURE 999. SG2044.2 +013600 03 S3-2 PICTURE AA. SG2044.2 +013700 03 S3-3 PICTURE AA. SG2044.2 +013800 03 S3-4 PICTURE 9999. SG2044.2 +013900 02 FILLER PICTURE X(109). SG2044.2 +014000 WORKING-STORAGE SECTION. SG2044.2 +014100 77 SUBSCRIPT-1 PICTURE 99 COMPUTATIONAL VALUE ZERO. SG2044.2 +014200 77 C0 PICTURE 99 COMPUTATIONAL VALUE ZERO. SG2044.2 +014300 77 C1 PICTURE 99 COMPUTATIONAL VALUE 1. SG2044.2 +014400 77 CA PICTURE A VALUE "A". SG2044.2 +014500 77 CB PICTURE A VALUE "B". SG2044.2 +014600 01 ALPHA-TABLE. SG2044.2 +014700 02 ALPHA-TAB PICTURE IS A(25) VALUE IS "ABCDEFGHIJKLMNPQRSTUSG2044.2 +014800- "VWXYZ". SG2044.2 +014900 02 ALPHA-TBL REDEFINES ALPHA-TAB PICTURE A OCCURS 25 TIMES. SG2044.2 +015000 01 W-KEYS. SG2044.2 +015100 02 W-S3-KEYS. SG2044.2 +015200 03 W-S2-KEYS. SG2044.2 +015300 04 W-S1-KEYS. SG2044.2 +015400 05 S1-1W PICTURE 999 VALUE 567. SG2044.2 +015500 05 S1-2W. SG2044.2 +015600 06 S1-2W-A PICTURE A. SG2044.2 +015700 06 S1-2W-B PICTURE A. SG2044.2 +015800 04 S2-3W. SG2044.2 +015900 05 S2-3W-A PICTURE A. SG2044.2 +016000 05 S2-3W-B PICTURE A. SG2044.2 +016100 03 S3-4W PICTURE 9999 VALUE 7051. SG2044.2 +016200 01 TEST-RESULTS. SG2044.2 +016300 02 FILLER PICTURE X VALUE SPACE. SG2044.2 +016400 02 FEATURE PICTURE X(20) VALUE SPACE. SG2044.2 +016500 02 FILLER PICTURE X VALUE SPACE. SG2044.2 +016600 02 P-OR-F PICTURE X(5) VALUE SPACE. SG2044.2 +016700 02 FILLER PICTURE X VALUE SPACE. SG2044.2 +016800 02 PAR-NAME. SG2044.2 +016900 03 FILLER PICTURE X(12) VALUE SPACE. SG2044.2 +017000 03 PARDOT-X PICTURE X VALUE SPACE. SG2044.2 +017100 03 DOTVALUE PICTURE 99 VALUE ZERO. SG2044.2 +017200 03 FILLER PIC X(5) VALUE SPACE. SG2044.2 +017300 02 FILLER PIC X(10) VALUE SPACE. SG2044.2 +017400 02 RE-MARK PIC X(61). SG2044.2 +017500 01 TEST-COMPUTED. SG2044.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SG2044.2 +017700 02 FILLER PIC X(17) VALUE " COMPUTED=". SG2044.2 +017800 02 COMPUTED-X. SG2044.2 +017900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SG2044.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SG2044.2 +018100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SG2044.2 +018200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SG2044.2 +018300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SG2044.2 +018400 03 CM-18V0 REDEFINES COMPUTED-A. SG2044.2 +018500 04 COMPUTED-18V0 PICTURE -9(18). SG2044.2 +018600 04 FILLER PICTURE X. SG2044.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SG2044.2 +018800 01 TEST-CORRECT. SG2044.2 +018900 02 FILLER PIC X(30) VALUE SPACE. SG2044.2 +019000 02 FILLER PIC X(17) VALUE " CORRECT =". SG2044.2 +019100 02 CORRECT-X. SG2044.2 +019200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SG2044.2 +019300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SG2044.2 +019400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SG2044.2 +019500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SG2044.2 +019600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SG2044.2 +019700 03 CR-18V0 REDEFINES CORRECT-A. SG2044.2 +019800 04 CORRECT-18V0 PICTURE -9(18). SG2044.2 +019900 04 FILLER PICTURE X. SG2044.2 +020000 03 FILLER PIC X(50) VALUE SPACE. SG2044.2 +020100 01 CCVS-C-1. SG2044.2 +020200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASG2044.2 +020300- "SS PARAGRAPH-NAME SG2044.2 +020400- " REMARKS". SG2044.2 +020500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SG2044.2 +020600 01 CCVS-C-2. SG2044.2 +020700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2044.2 +020800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SG2044.2 +020900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SG2044.2 +021000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SG2044.2 +021100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SG2044.2 +021200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SG2044.2 +021300 01 REC-CT PICTURE 99 VALUE ZERO. SG2044.2 +021400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SG2044.2 +021500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SG2044.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SG2044.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. SG2044.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SG2044.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. SG2044.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SG2044.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SG2044.2 +022200 01 CCVS-H-1. SG2044.2 +022300 02 FILLER PICTURE X(27) VALUE SPACE. SG2044.2 +022400 02 FILLER PICTURE X(67) VALUE SG2044.2 +022500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION SG2044.2 +022600- " SYSTEM". SG2044.2 +022700 02 FILLER PICTURE X(26) VALUE SPACE. SG2044.2 +022800 01 CCVS-H-2. SG2044.2 +022900 02 FILLER PICTURE X(52) VALUE IS SG2044.2 +023000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". SG2044.2 +023100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SG2044.2 +023200 02 TEST-ID PICTURE IS X(9). SG2044.2 +023300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SG2044.2 +023400 01 CCVS-H-3. SG2044.2 +023500 02 FILLER PICTURE X(34) VALUE SG2044.2 +023600 " FOR OFFICIAL USE ONLY ". SG2044.2 +023700 02 FILLER PICTURE X(58) VALUE SG2044.2 +023800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SG2044.2 +023900 02 FILLER PICTURE X(28) VALUE SG2044.2 +024000 " COPYRIGHT 1974 ". SG2044.2 +024100 01 CCVS-E-1. SG2044.2 +024200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SG2044.2 +024300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SG2044.2 +024400 02 ID-AGAIN PICTURE IS X(9). SG2044.2 +024500 02 FILLER PICTURE X(45) VALUE IS SG2044.2 +024600 " NTIS DISTRIBUTION COBOL 74". SG2044.2 +024700 01 CCVS-E-2. SG2044.2 +024800 02 FILLER PICTURE X(31) VALUE SG2044.2 +024900 SPACE. SG2044.2 +025000 02 FILLER PICTURE X(21) VALUE SPACE. SG2044.2 +025100 02 CCVS-E-2-2. SG2044.2 +025200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SG2044.2 +025300 03 FILLER PICTURE IS X VALUE IS SPACE. SG2044.2 +025400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". SG2044.2 +025500 01 CCVS-E-3. SG2044.2 +025600 02 FILLER PICTURE X(22) VALUE SG2044.2 +025700 " FOR OFFICIAL USE ONLY". SG2044.2 +025800 02 FILLER PICTURE X(12) VALUE SPACE. SG2044.2 +025900 02 FILLER PICTURE X(58) VALUE SG2044.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SG2044.2 +026100 02 FILLER PICTURE X(13) VALUE SPACE. SG2044.2 +026200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". SG2044.2 +026300 01 CCVS-E-4. SG2044.2 +026400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SG2044.2 +026500 02 FILLER PIC XXXX VALUE " OF ". SG2044.2 +026600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SG2044.2 +026700 02 FILLER PIC X(40) VALUE SG2044.2 +026800 " TESTS WERE EXECUTED SUCCESSFULLY". SG2044.2 +026900 01 XXINFO. SG2044.2 +027000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SG2044.2 +027100 02 INFO-TEXT. SG2044.2 +027200 04 FILLER PIC X(20) VALUE SPACE. SG2044.2 +027300 04 XXCOMPUTED PIC X(20). SG2044.2 +027400 04 FILLER PIC X(5) VALUE SPACE. SG2044.2 +027500 04 XXCORRECT PIC X(20). SG2044.2 +027600 01 HYPHEN-LINE. SG2044.2 +027700 02 FILLER PICTURE IS X VALUE IS SPACE. SG2044.2 +027800 02 FILLER PICTURE IS X(65) VALUE IS "************************SG2044.2 +027900- "*****************************************". SG2044.2 +028000 02 FILLER PICTURE IS X(54) VALUE IS "************************SG2044.2 +028100- "******************************". SG2044.2 +028200 01 CCVS-PGM-ID PIC X(6) VALUE SG2044.2 +028300 "SG204A". SG2044.2 +028400 PROCEDURE DIVISION. SG2044.2 +028500 CCVS1 SECTION. SG2044.2 +028600 OPEN-FILES. SG2044.2 +028700 OPEN OUTPUT PRINT-FILE. SG2044.2 +028800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SG2044.2 +028900 MOVE SPACE TO TEST-RESULTS. SG2044.2 +029000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SG2044.2 +029100 GO TO CCVS1-EXIT. SG2044.2 +029200 CLOSE-FILES. SG2044.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SG2044.2 +029400 TERMINATE-CCVS. SG2044.2 +029500*S EXIT PROGRAM. SG2044.2 +029600*SERMINATE-CALL. SG2044.2 +029700 STOP RUN. SG2044.2 +029800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2044.2 +029900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2044.2 +030000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2044.2 +030100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2044.2 +030200 MOVE "****TEST DELETED****" TO RE-MARK. SG2044.2 +030300 PRINT-DETAIL. SG2044.2 +030400 IF REC-CT NOT EQUAL TO ZERO SG2044.2 +030500 MOVE "." TO PARDOT-X SG2044.2 +030600 MOVE REC-CT TO DOTVALUE. SG2044.2 +030700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SG2044.2 +030800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SG2044.2 +030900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SG2044.2 +031000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SG2044.2 +031100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2044.2 +031200 MOVE SPACE TO CORRECT-X. SG2044.2 +031300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2044.2 +031400 MOVE SPACE TO RE-MARK. SG2044.2 +031500 HEAD-ROUTINE. SG2044.2 +031600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +031700 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SG2044.2 +031800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SG2044.2 +031900 COLUMN-NAMES-ROUTINE. SG2044.2 +032000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +032100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +032200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +032300 END-ROUTINE. SG2044.2 +032400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SG2044.2 +032500 END-RTN-EXIT. SG2044.2 +032600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +032700 END-ROUTINE-1. SG2044.2 +032800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SG2044.2 +032900 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SG2044.2 +033000 ADD PASS-COUNTER TO ERROR-HOLD. SG2044.2 +033100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SG2044.2 +033200 MOVE PASS-COUNTER TO CCVS-E-4-1. SG2044.2 +033300 MOVE ERROR-HOLD TO CCVS-E-4-2. SG2044.2 +033400 MOVE CCVS-E-4 TO CCVS-E-2-2. SG2044.2 +033500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SG2044.2 +033600 END-ROUTINE-12. SG2044.2 +033700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SG2044.2 +033800 IF ERROR-COUNTER IS EQUAL TO ZERO SG2044.2 +033900 MOVE "NO " TO ERROR-TOTAL SG2044.2 +034000 ELSE SG2044.2 +034100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SG2044.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. SG2044.2 +034300 PERFORM WRITE-LINE. SG2044.2 +034400 END-ROUTINE-13. SG2044.2 +034500 IF DELETE-CNT IS EQUAL TO ZERO SG2044.2 +034600 MOVE "NO " TO ERROR-TOTAL ELSE SG2044.2 +034700 MOVE DELETE-CNT TO ERROR-TOTAL. SG2044.2 +034800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SG2044.2 +034900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +035000 IF INSPECT-COUNTER EQUAL TO ZERO SG2044.2 +035100 MOVE "NO " TO ERROR-TOTAL SG2044.2 +035200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SG2044.2 +035300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SG2044.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +035500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SG2044.2 +035600 WRITE-LINE. SG2044.2 +035700 ADD 1 TO RECORD-COUNT. SG2044.2 +035800 IF RECORD-COUNT GREATER 50 SG2044.2 +035900 MOVE DUMMY-RECORD TO DUMMY-HOLD SG2044.2 +036000 MOVE SPACE TO DUMMY-RECORD SG2044.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2044.2 +036200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SG2044.2 +036300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SG2044.2 +036400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SG2044.2 +036500 MOVE DUMMY-HOLD TO DUMMY-RECORD SG2044.2 +036600 MOVE ZERO TO RECORD-COUNT. SG2044.2 +036700 PERFORM WRT-LN. SG2044.2 +036800 WRT-LN. SG2044.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2044.2 +037000 MOVE SPACE TO DUMMY-RECORD. SG2044.2 +037100 BLANK-LINE-PRINT. SG2044.2 +037200 PERFORM WRT-LN. SG2044.2 +037300 FAIL-ROUTINE. SG2044.2 +037400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2044.2 +037500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SG2044.2 +037600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2044.2 +037700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +037800 GO TO FAIL-ROUTINE-EX. SG2044.2 +037900 FAIL-ROUTINE-WRITE. SG2044.2 +038000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SG2044.2 +038100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SG2044.2 +038200 FAIL-ROUTINE-EX. EXIT. SG2044.2 +038300 BAIL-OUT. SG2044.2 +038400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SG2044.2 +038500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SG2044.2 +038600 BAIL-OUT-WRITE. SG2044.2 +038700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2044.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SG2044.2 +038900 BAIL-OUT-EX. EXIT. SG2044.2 +039000 CCVS1-EXIT. SG2044.2 +039100 EXIT. SG2044.2 +039200 P1-CREATE-F1. SG2044.2 +039300 OPEN OUTPUT FILE1. SG2044.2 +039400 MOVE CA TO S1-2W-A. SG2044.2 +039500 MOVE CB TO S2-3W-A. SG2044.2 +039600 P2-CREATE-F1. SG2044.2 +039700 PERFORM P4-CREATE-F1 2 TIMES. SG2044.2 +039800 P3-CREATE-F1. SG2044.2 +039900 MOVE CA TO S2-3W-A. SG2044.2 +040000 PERFORM P4-CREATE-F1 2 TIMES. SG2044.2 +040100 CLOSE FILE1. SG2044.2 +040200 GO TO FIRST-SORT. SG2044.2 +040300 P4-CREATE-F1. SG2044.2 +040400 MOVE C0 TO SUBSCRIPT-1. SG2044.2 +040500 PERFORM P5-CREATE-F1 25 TIMES. SG2044.2 +040600 P5-CREATE-F1. SG2044.2 +040700 ADD C1 TO SUBSCRIPT-1. SG2044.2 +040800 SUBTRACT C1 FROM S3-4W. SG2044.2 +040900 MOVE ALPHA-TBL (SUBSCRIPT-1) TO S1-2W-B S2-3W-B. SG2044.2 +041000 MOVE W-S3-KEYS TO R1. SG2044.2 +041100 WRITE R1. SG2044.2 +041200 F1-NOTE. SG2044.2 +041300* NOTE. SG2044.2 +041400* KEY-1 WILL BE 567 IN ALL RECORDS. SG2044.2 +041500* KEY-2 WILL BE >A> IN FIRST LETTER WITH 4 OCCURRENCES OF THESG2044.2 +041600* ALPHABET IN THE SECOND LETTER. SG2044.2 +041700* KEY-3 WILL BE >A> OR >B> IN FIRST LETTER WITH 2 OCCURRENCESSG2044.2 +041800* OF THE ALPHABET FOR EACH IN THE SECOND LETTER. SG2044.2 +041900* KEY-4 WILL VARY FROM 7050 THRU 6951. SG2044.2 +042000* THE LETTER "O" HAS BEEN OMITTED. SG2044.2 +042100 SRT-1 SECTION 69. SG2044.2 +042200 FIRST-SORT. SG2044.2 +042300 SORT SORT1 SG2044.2 +042400 ON DESCENDING KEY S1-1 SG2044.2 +042500 ON ASCENDING KEY S1-2 SG2044.2 +042600 USING FILE1 SG2044.2 +042700 GIVING FILE2. SG2044.2 +042800* NOTE SORT STATEMENT WITH ALL OPTIONAL WORDS. SG2044.2 +042900* NOTE OUTPUT WILL BE TESTED IN THE FOLLOWING INPUT PROCEDURE. SG2044.2 +043000 SRT-2 SECTION 48. SG2044.2 +043100 SECOND-SORT. SG2044.2 +043200 SORT SORT2 SG2044.2 +043300 ASCENDING S2-1 SG2044.2 +043400 DESCENDING S2-2 SG2044.2 +043500 ASCENDING S2-3 SG2044.2 +043600 INPUT PROCEDURE SRT-2-INPUT SG2044.2 +043700 GIVING FILE3. SG2044.2 +043800* NOTE SORT STATEMENT WITH ALL OPTIONAL WORDS OMITTED. SG2044.2 +043900 GO TO SRT-3. SG2044.2 +044000 SRT-2-INPUT SECTION 74. SG2044.2 +044100 OPEN-1. SG2044.2 +044200 OPEN INPUT FILE2. SG2044.2 +044300 MOVE "SORT, INPUT PROC" TO FEATURE. SG2044.2 +044400 SORT-TEST-1. SG2044.2 +044500 PERFORM READ-RELEASE-FILE2. SG2044.2 +044600 IF W-S1-KEYS EQUAL TO "567AA" SG2044.2 +044700 PERFORM PASS-1 GO TO SORT-WRITE-1. SG2044.2 +044800 GO TO SORT-FAIL-1. SG2044.2 +044900 SORT-DELETE-1. SG2044.2 +045000 PERFORM DE-LETE-1. SG2044.2 +045100 GO TO SORT-WRITE-1. SG2044.2 +045200 SORT-FAIL-1. SG2044.2 +045300 MOVE W-S1-KEYS TO COMPUTED-A. SG2044.2 +045400 MOVE "567AA" TO CORRECT-A. SG2044.2 +045500 PERFORM FAIL-1. SG2044.2 +045600 SORT-WRITE-1. SG2044.2 +045700 MOVE "SORT-TEST-1 " TO PAR-NAME. SG2044.2 +045800 PERFORM PRINT-DETAIL-1. SG2044.2 +045900 SORT-TEST-2. SG2044.2 +046000 PERFORM READ-RELEASE-FILE2 35 TIMES. SG2044.2 +046100 IF W-S1-KEYS EQUAL TO "567AI" SG2044.2 +046200 PERFORM PASS-1 GO TO SORT-WRITE-2. SG2044.2 +046300 GO TO SORT-FAIL-2. SG2044.2 +046400 SORT-DELETE-2. SG2044.2 +046500 PERFORM DE-LETE-1. SG2044.2 +046600 GO TO SORT-WRITE-2. SG2044.2 +046700 SORT-FAIL-2. SG2044.2 +046800 MOVE W-S1-KEYS TO COMPUTED-A. SG2044.2 +046900 MOVE "567AI" TO CORRECT-A. SG2044.2 +047000 PERFORM FAIL-1. SG2044.2 +047100 SORT-WRITE-2. SG2044.2 +047200 MOVE "SORT-TEST-2 " TO PAR-NAME. SG2044.2 +047300 PERFORM PRINT-DETAIL-1. SG2044.2 +047400 SORT-TEST-3. SG2044.2 +047500 PERFORM READ-RELEASE-FILE2 35 TIMES. SG2044.2 +047600 IF W-S1-KEYS EQUAL TO "567AS" SG2044.2 +047700 PERFORM PASS-1 GO TO SORT-WRITE-3. SG2044.2 +047800 GO TO SORT-FAIL-3. SG2044.2 +047900 SORT-DELETE-3. SG2044.2 +048000 PERFORM DE-LETE-1. SG2044.2 +048100 GO TO SORT-WRITE-3. SG2044.2 +048200 SORT-FAIL-3. SG2044.2 +048300 MOVE W-S1-KEYS TO COMPUTED-A. SG2044.2 +048400 MOVE "567AS" TO CORRECT-A. SG2044.2 +048500 PERFORM FAIL-1. SG2044.2 +048600 SORT-WRITE-3. SG2044.2 +048700 MOVE "SORT-TEST-3 " TO PAR-NAME. SG2044.2 +048800 PERFORM PRINT-DETAIL-1. SG2044.2 +048900 SORT-TEST-4. SG2044.2 +049000 PERFORM READ-RELEASE-FILE2 29 TIMES. SG2044.2 +049100 IF W-S1-KEYS EQUAL TO "567AZ" SG2044.2 +049200 PERFORM PASS-1 GO TO SORT-WRITE-4. SG2044.2 +049300 GO TO SORT-FAIL-4. SG2044.2 +049400 SORT-DELETE-4. SG2044.2 +049500 PERFORM DE-LETE-1. SG2044.2 +049600 GO TO SORT-WRITE-4. SG2044.2 +049700 SORT-FAIL-4. SG2044.2 +049800 MOVE W-S1-KEYS TO COMPUTED-A. SG2044.2 +049900 MOVE "567AZ" TO CORRECT-A. SG2044.2 +050000 PERFORM FAIL-1. SG2044.2 +050100 SORT-WRITE-4. SG2044.2 +050200 MOVE "SORT-TEST-4 " TO PAR-NAME. SG2044.2 +050300 PERFORM PRINT-DETAIL-1. SG2044.2 +050400 CLOSE-1. SG2044.2 +050500 CLOSE FILE2. SG2044.2 +050600 GO TO EXIT-1. SG2044.2 +050700 READ-RELEASE-FILE2. SG2044.2 +050800 READ FILE2 AT END GO TO TERMINAL-1. SG2044.2 +050900 MOVE R2 TO W-S3-KEYS. SG2044.2 +051000 RELEASE S2 FROM R2. SG2044.2 +051100 TERMINAL-1. SG2044.2 +051200 PERFORM FAIL-1. SG2044.2 +051300 MOVE "TERMINAL-1" TO PAR-NAME. SG2044.2 +051400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. SG2044.2 +051500 PERFORM PRINT-DETAIL-1. SG2044.2 +051600 MOVE SPACE TO FEATURE. SG2044.2 +051700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. SG2044.2 +051800 PERFORM PRINT-DETAIL-1. SG2044.2 +051900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. SG2044.2 +052000 PERFORM PRINT-DETAIL-1. SG2044.2 +052100 GO TO CLOSE-1. SG2044.2 +052200 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2044.2 +052300 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2044.2 +052400 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2044.2 +052500 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2044.2 +052600 MOVE "****TEST DELETED****" TO RE-MARK. SG2044.2 +052700 PRINT-DETAIL-1. SG2044.2 +052800 IF REC-CT NOT EQUAL TO ZERO SG2044.2 +052900 MOVE "." TO PARDOT-X SG2044.2 +053000 MOVE REC-CT TO DOTVALUE. SG2044.2 +053100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. SG2044.2 +053200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 SG2044.2 +053300 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 SG2044.2 +053400 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. SG2044.2 +053500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2044.2 +053600 MOVE SPACE TO CORRECT-X. SG2044.2 +053700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2044.2 +053800 MOVE SPACE TO RE-MARK. SG2044.2 +053900 WRITE-LINE-1. SG2044.2 +054000 ADD 1 TO RECORD-COUNT. SG2044.2 +054100 IF RECORD-COUNT GREATER 50 SG2044.2 +054200 MOVE DUMMY-RECORD TO DUMMY-HOLD SG2044.2 +054300 MOVE SPACE TO DUMMY-RECORD SG2044.2 +054400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2044.2 +054500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 SG2044.2 +054600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES SG2044.2 +054700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 SG2044.2 +054800 MOVE DUMMY-HOLD TO DUMMY-RECORD SG2044.2 +054900 MOVE ZERO TO RECORD-COUNT. SG2044.2 +055000 PERFORM WRT-LN-1. SG2044.2 +055100 WRT-LN-1. SG2044.2 +055200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2044.2 +055300 MOVE SPACE TO DUMMY-RECORD. SG2044.2 +055400 BLANK-LINE-PRINT-1. SG2044.2 +055500 PERFORM WRT-LN-1. SG2044.2 +055600 FAIL-ROUTINE-1. SG2044.2 +055700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SG2044.2 +055800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SG2044.2 +055900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2044.2 +056000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SG2044.2 +056100 GO TO FAIL-ROUTINE-EX-1. SG2044.2 +056200 FAIL-RTN-WRITE-1. SG2044.2 +056300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 SG2044.2 +056400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. SG2044.2 +056500 FAIL-ROUTINE-EX-1. EXIT. SG2044.2 +056600 BAIL-OUT-1. SG2044.2 +056700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. SG2044.2 +056800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. SG2044.2 +056900 BAIL-OUT-WRITE-1. SG2044.2 +057000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2044.2 +057100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SG2044.2 +057200 BAIL-OUT-EX-1. EXIT. SG2044.2 +057300 EXIT-1. SG2044.2 +057400 EXIT. SG2044.2 +057500 SRT-3 SECTION. SG2044.2 +057600 THIRD-SORT. SG2044.2 +057700 SORT SORT3 SG2044.2 +057800 ON DESCENDING KEY S3-1 S3-2 S3-3 SG2044.2 +057900 ASCENDING S3-4 SG2044.2 +058000 INPUT PROCEDURE IS SRT3-INPUT SG2044.2 +058100 OUTPUT PROCEDURE SRT3-OUTPUT-1 THRU SRT3-OUTPUT-2. SG2044.2 +058200 NOTE-SORT-3. SG2044.2 +058300* NOTE SORT STATEMENT WITH INCLUSION-OMISSION OF OPTIONAL SG2044.2 +058400* WORDS AND THRU OPTION. THE OUTPUT OF SRT-2 IS TESTED SG2044.2 +058500* IN THE INPUT PROCEDURE OF THIS (THIRD) SORT. THE OUTPUT SG2044.2 +058600* OF THE THIRD SORT IS TESTED IN THE OUTPUT PROCEDURE SG2044.2 +058700* WITHOUT THE GENERATION OF AN OUTPUT FILE. SG2044.2 +058800 END-FIRST-PROGRAM. SG2044.2 +058900 GO TO CCVS-EXIT. SG2044.2 +059000 SRT3-INPUT SECTION 49. SG2044.2 +059100 OPEN-2. SG2044.2 +059200 OPEN INPUT FILE3. SG2044.2 +059300 MOVE "SORT, INPUT PROC" TO FEATURE. SG2044.2 +059400 SORT-TEST-5. SG2044.2 +059500 PERFORM READ-RELEASE-FILE3. SG2044.2 +059600 MOVE R3-KEYS TO W-S3-KEYS. SG2044.2 +059700 IF W-S2-KEYS EQUAL TO "567AZAZ" SG2044.2 +059800 PERFORM PASS-2 GO TO SORT-WRITE-5. SG2044.2 +059900 GO TO SORT-FAIL-5. SG2044.2 +060000 SORT-DELETE-5. SG2044.2 +060100 PERFORM DE-LETE-2. SG2044.2 +060200 GO TO SORT-WRITE-5. SG2044.2 +060300 SORT-FAIL-5. SG2044.2 +060400 MOVE W-S2-KEYS TO COMPUTED-A. SG2044.2 +060500 MOVE "567AZAZ" TO CORRECT-A. SG2044.2 +060600 PERFORM FAIL-2. SG2044.2 +060700 SORT-WRITE-5. SG2044.2 +060800 MOVE "SORT-TEST-5 " TO PAR-NAME. SG2044.2 +060900 PERFORM PRINT-DETAIL-2. SG2044.2 +061000 SORT-TEST-6. SG2044.2 +061100 PERFORM READ-RELEASE-FILE3 35 TIMES. SG2044.2 +061200 MOVE R3-KEYS TO W-S3-KEYS. SG2044.2 +061300 IF W-S2-KEYS EQUAL TO "567ARBR" SG2044.2 +061400 PERFORM PASS-2 GO TO SORT-WRITE-6. SG2044.2 +061500 GO TO SORT-FAIL-6. SG2044.2 +061600 SORT-DELETE-6. SG2044.2 +061700 PERFORM DE-LETE-2. SG2044.2 +061800 GO TO SORT-WRITE-6. SG2044.2 +061900 SORT-FAIL-6. SG2044.2 +062000 MOVE W-S2-KEYS TO COMPUTED-A. SG2044.2 +062100 MOVE "567ARBR" TO CORRECT-A. SG2044.2 +062200 PERFORM FAIL-2. SG2044.2 +062300 SORT-WRITE-6. SG2044.2 +062400 MOVE "SORT-TEST-6 " TO PAR-NAME. SG2044.2 +062500 PERFORM PRINT-DETAIL-2. SG2044.2 +062600 SORT-TEST-7. SG2044.2 +062700 PERFORM READ-RELEASE-FILE3 35 TIMES. SG2044.2 +062800 MOVE R3-KEYS TO W-S3-KEYS. SG2044.2 +062900 IF W-S2-KEYS EQUAL TO "567AHBH" SG2044.2 +063000 PERFORM PASS-2 GO TO SORT-WRITE-7. SG2044.2 +063100 GO TO SORT-FAIL-7. SG2044.2 +063200 SORT-DELETE-7. SG2044.2 +063300 PERFORM DE-LETE-2. SG2044.2 +063400 GO TO SORT-WRITE-7. SG2044.2 +063500 SORT-FAIL-7. SG2044.2 +063600 MOVE W-S2-KEYS TO COMPUTED-A. SG2044.2 +063700 MOVE "567AHBH" TO CORRECT-A. SG2044.2 +063800 PERFORM FAIL-2. SG2044.2 +063900 SORT-WRITE-7. SG2044.2 +064000 MOVE "SORT-TEST-7 " TO PAR-NAME. SG2044.2 +064100 PERFORM PRINT-DETAIL-2. SG2044.2 +064200 SORT-TEST-8. SG2044.2 +064300 PERFORM READ-RELEASE-FILE3 29 TIMES. SG2044.2 +064400 MOVE R3-KEYS TO W-S3-KEYS. SG2044.2 +064500 IF W-S2-KEYS EQUAL TO "567AABA" SG2044.2 +064600 PERFORM PASS-2 GO TO SORT-WRITE-8. SG2044.2 +064700 GO TO SORT-FAIL-8. SG2044.2 +064800 SORT-DELETE-8. SG2044.2 +064900 PERFORM DE-LETE-2. SG2044.2 +065000 GO TO SORT-WRITE-8. SG2044.2 +065100 SORT-FAIL-8. SG2044.2 +065200 MOVE W-S2-KEYS TO COMPUTED-A. SG2044.2 +065300 MOVE "567AABA" TO CORRECT-A. SG2044.2 +065400 PERFORM FAIL-2. SG2044.2 +065500 SORT-WRITE-8. SG2044.2 +065600 MOVE "SORT-TEST-8 " TO PAR-NAME. SG2044.2 +065700 PERFORM PRINT-DETAIL-2. SG2044.2 +065800 CLOSE-2. SG2044.2 +065900 CLOSE FILE3. SG2044.2 +066000 GO TO EXIT-2. SG2044.2 +066100 READ-RELEASE-FILE3. SG2044.2 +066200 READ FILE3 AT END GO TO TERMINAL-2. SG2044.2 +066300 RELEASE S3. SG2044.2 +066400* NOTE THE FROM OPTION AND MOVE ARE REDUNDANT WITH SAME SG2044.2 +066500* RECORD AREA CLAUSE IN I-O CONTROL PARAGRAPH. SG2044.2 +066600 TERMINAL-2. SG2044.2 +066700 PERFORM FAIL-2. SG2044.2 +066800 MOVE "TERMINAL-2" TO PAR-NAME. SG2044.2 +066900 MOVE "END OF FILE PREMATURELY" TO RE-MARK. SG2044.2 +067000 PERFORM PRINT-DETAIL-2. SG2044.2 +067100 MOVE SPACE TO FEATURE. SG2044.2 +067200 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. SG2044.2 +067300 PERFORM PRINT-DETAIL-2. SG2044.2 +067400 MOVE "LAST SUCCESSFUL TEST" TO RE-MARK. SG2044.2 +067500 PERFORM PRINT-DETAIL-2. SG2044.2 +067600 GO TO CLOSE-2. SG2044.2 +067700 INSPT-2. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SG2044.2 +067800 PASS-2. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2044.2 +067900 FAIL-2. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SG2044.2 +068000 DE-LETE-2. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SG2044.2 +068100 MOVE "****TEST DELETED****" TO RE-MARK. SG2044.2 +068200 PRINT-DETAIL-2. SG2044.2 +068300 IF REC-CT NOT EQUAL TO ZERO SG2044.2 +068400 MOVE "." TO PARDOT-X SG2044.2 +068500 MOVE REC-CT TO DOTVALUE. SG2044.2 +068600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-2. SG2044.2 +068700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-2 SG2044.2 +068800 PERFORM FAIL-ROUTINE-2 THRU FAIL-ROUTINE-EX-2 SG2044.2 +068900 ELSE PERFORM BAIL-OUT-2 THRU BAIL-OUT-EX-2. SG2044.2 +069000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SG2044.2 +069100 MOVE SPACE TO CORRECT-X. SG2044.2 +069200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SG2044.2 +069300 MOVE SPACE TO RE-MARK. SG2044.2 +069400 WRITE-LINE-2. SG2044.2 +069500 ADD 1 TO RECORD-COUNT. SG2044.2 +069600 IF RECORD-COUNT GREATER 50 SG2044.2 +069700 MOVE DUMMY-RECORD TO DUMMY-HOLD SG2044.2 +069800 MOVE SPACE TO DUMMY-RECORD SG2044.2 +069900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SG2044.2 +070000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-2 SG2044.2 +070100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-2 2 TIMES SG2044.2 +070200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-2 SG2044.2 +070300 MOVE DUMMY-HOLD TO DUMMY-RECORD SG2044.2 +070400 MOVE ZERO TO RECORD-COUNT. SG2044.2 +070500 PERFORM WRT-LN-2. SG2044.2 +070600 WRT-LN-2. SG2044.2 +070700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2044.2 +070800 MOVE SPACE TO DUMMY-RECORD. SG2044.2 +070900 BLANK-LINE-PRINT-2. SG2044.2 +071000 PERFORM WRT-LN-2. SG2044.2 +071100 FAIL-ROUTINE-2. SG2044.2 +071200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. SG2044.2 +071300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. SG2044.2 +071400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SG2044.2 +071500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. SG2044.2 +071600 GO TO FAIL-ROUTINE-EX-2. SG2044.2 +071700 FAIL-RTN-WRITE-2. SG2044.2 +071800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-2 SG2044.2 +071900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-2 2 TIMES. SG2044.2 +072000 FAIL-ROUTINE-EX-2. EXIT. SG2044.2 +072100 BAIL-OUT-2. SG2044.2 +072200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-2. SG2044.2 +072300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-2. SG2044.2 +072400 BAIL-OUT-WRITE-2. SG2044.2 +072500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SG2044.2 +072600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. SG2044.2 +072700 BAIL-OUT-EX-2. EXIT. SG2044.2 +072800 EXIT-2. SG2044.2 +072900 EXIT. SG2044.2 +073000 SRT3-OUTPUT-1 SECTION 25. SG2044.2 +073100 INIT-3. SG2044.2 +073200 MOVE "SORT, OUTPUT PROC" TO FEATURE. SG2044.2 +073300 SORT-TEST-9. SG2044.2 +073400 PERFORM RETURN-SORT3. SG2044.2 +073500 IF S3-KEYS EQUAL TO "567AZBZ7001" SG2044.2 +073600 PERFORM PASS-3 GO TO SORT-WRITE-9. SG2044.2 +073700 GO TO SORT-FAIL-9. SG2044.2 +073800 SORT-DELETE-9. SG2044.2 +073900 PERFORM DE-LETE-3. SG2044.2 +074000 GO TO SORT-WRITE-9. SG2044.2 +074100 SORT-FAIL-9. SG2044.2 +074200 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +074300 MOVE "567AZBZ7001" TO CORRECT-A. SG2044.2 +074400 PERFORM FAIL-3. SG2044.2 +074500 SORT-WRITE-9. SG2044.2 +074600 MOVE "SORT-TEST-9 " TO PAR-NAME. SG2044.2 +074700 PERFORM PRINT-DETAIL-3. SG2044.2 +074800 SORT-TEST-10. SG2044.2 +074900 PERFORM RETURN-SORT3. SG2044.2 +075000 IF S3-KEYS EQUAL TO "567AZBZ7026" SG2044.2 +075100 PERFORM PASS-3 GO TO SORT-WRITE-10. SG2044.2 +075200 GO TO SORT-FAIL-10. SG2044.2 +075300 SORT-DELETE-10. SG2044.2 +075400 PERFORM DE-LETE-3. SG2044.2 +075500 GO TO SORT-WRITE-10. SG2044.2 +075600 SORT-FAIL-10. SG2044.2 +075700 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +075800 MOVE "567AZBZ7026" TO CORRECT-A. SG2044.2 +075900 PERFORM FAIL-3. SG2044.2 +076000 SORT-WRITE-10. SG2044.2 +076100 MOVE "SORT-TEST-10" TO PAR-NAME. SG2044.2 +076200 PERFORM PRINT-DETAIL-3. SG2044.2 +076300 SORT-TEST-11. SG2044.2 +076400 PERFORM RETURN-SORT3 35 TIMES. SG2044.2 +076500 IF S3-KEYS EQUAL TO "567AQBQ7010" SG2044.2 +076600 PERFORM PASS-3 GO TO SORT-WRITE-11. SG2044.2 +076700 GO TO SORT-FAIL-11. SG2044.2 +076800 SORT-DELETE-11. SG2044.2 +076900 PERFORM DE-LETE-3. SG2044.2 +077000 GO TO SORT-WRITE-11. SG2044.2 +077100 SORT-FAIL-11. SG2044.2 +077200 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +077300 MOVE "567AQBQ7010" TO CORRECT-A. SG2044.2 +077400 PERFORM FAIL-3. SG2044.2 +077500 SORT-WRITE-11. SG2044.2 +077600 MOVE "SORT-TEST-11" TO PAR-NAME. SG2044.2 +077700 PERFORM PRINT-DETAIL-3. SG2044.2 +077800 SORT-TEST-12. SG2044.2 +077900 PERFORM RETURN-SORT3. SG2044.2 +078000 IF S3-KEYS EQUAL TO "567AQBQ7035" SG2044.2 +078100 PERFORM PASS-3 GO TO SORT-WRITE-12. SG2044.2 +078200 GO TO SORT-FAIL-12. SG2044.2 +078300 SORT-DELETE-12. SG2044.2 +078400 PERFORM DE-LETE-3. SG2044.2 +078500 GO TO SORT-WRITE-12. SG2044.2 +078600 SORT-FAIL-12. SG2044.2 +078700 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +078800 MOVE "567AQBQ7035" TO CORRECT-A. SG2044.2 +078900 PERFORM FAIL-3. SG2044.2 +079000 SORT-WRITE-12. SG2044.2 +079100 MOVE "SORT-TEST-12" TO PAR-NAME. SG2044.2 +079200 PERFORM PRINT-DETAIL-3. SG2044.2 +079300 SORT-TEST-13. SG2044.2 +079400 PERFORM RETURN-SORT3 35 TIMES. SG2044.2 +079500 IF S3-KEYS EQUAL TO "567AGBG7019" SG2044.2 +079600 PERFORM PASS-3 GO TO SORT-WRITE-13. SG2044.2 +079700 GO TO SORT-FAIL-13. SG2044.2 +079800 SORT-DELETE-13. SG2044.2 +079900 PERFORM DE-LETE-3. SG2044.2 +080000 GO TO SORT-WRITE-13. SG2044.2 +080100 SORT-FAIL-13. SG2044.2 +080200 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +080300 MOVE "567AGBG7019" TO CORRECT-A. SG2044.2 +080400 PERFORM FAIL-3. SG2044.2 +080500 SORT-WRITE-13. SG2044.2 +080600 MOVE "SORT-TEST-13" TO PAR-NAME. SG2044.2 +080700 PERFORM PRINT-DETAIL-3. SG2044.2 +080800 SORT-TEST-14. SG2044.2 +080900 PERFORM RETURN-SORT3 27 TIMES. SG2044.2 +081000 IF S3-KEYS EQUAL TO "567AAAA7000" SG2044.2 +081100 PERFORM PASS-3 GO TO SORT-WRITE-14. SG2044.2 +081200 GO TO SORT-FAIL-14. SG2044.2 +081300 SORT-DELETE-14. SG2044.2 +081400 PERFORM DE-LETE-3. SG2044.2 +081500 GO TO SORT-WRITE-14. SG2044.2 +081600 SORT-FAIL-14. SG2044.2 +081700 MOVE S3-KEYS TO COMPUTED-A. SG2044.2 +081800 MOVE "567AAAA7000" TO CORRECT-A. SG2044.2 +081900 PERFORM FAIL-3. SG2044.2 +082000 SORT-WRITE-14. SG2044.2 +082100 MOVE "SORT-TEST-14" TO PAR-NAME. SG2044.2 +082200 PERFORM PRINT-DETAIL-3. SG2044.2 +082300 SORT-TEST-15. SG2044.2 +082400 RETURN SORT3 RECORD AT END SG2044.2 +082500 PERFORM PASS-3 GO TO SORT-WRITE-15. SG2044.2 +082600* NOTE THE FOLLOWING SENTENCES SHOULD NOT BE EXECUTED. SG2044.2 +082700 PERFORM FAIL-3. SG2044.2 +082800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SG2044.2 +082900 GO TO SORT-WRITE-15. SG2044.2 +083000 SORT-DELETE-15. SG2044.2 +083100 PERFORM DE-LETE-3. SG2044.2 +083200 SORT-WRITE-15. SG2044.2 +083300 MOVE "SORT-TEST-15" TO PAR-NAME. SG2044.2 +083400 PERFORM PRINT-DETAIL-3. SG2044.2 +083500 CLOSE-3. SG2044.2 +083600 GO TO EXIT-3. SG2044.2 +083700 SRT3-OUTPUT-2 SECTION 25. SG2044.2 +083800 RETURN-SORT3. SG2044.2 +083900 RETURN SORT3 RECORD AT END GO TO TERMINAL-3. SG2044.2 +084000* NOTE RETURN VERB WITH ALL OPTIONS EXCEPT INTO. SG2044.2 +084100 TERMINAL-3. SG2044.2 +084200 PERFORM FAIL-3. SG2044.2 +084300 MOVE "TERMINAL-3" TO PAR-NAME. SG2044.2 +084400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. SG2044.2 +084500 PERFORM PRINT-DETAIL-3. SG2044.2 +084600 MOVE SPACE TO FEATURE. SG2044.2 +084700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. SG2044.2 +084800 PERFORM PRINT-DETAIL-3. SG2044.2 +084900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK SG2044.2 +085000 PERFORM PRINT-DETAIL-3. SG2044.2 +085100 GO TO CLOSE-3. SG2044.2 +085200 PASS-3. SG2044.2 +085300 MOVE "PASS" TO P-OR-F. ADD 1 TO PASS-COUNTER. SG2044.2 +085400 FAIL-3. SG2044.2 +085500 ADD 1 TO ERROR-COUNTER. SG2044.2 +085600 MOVE "FAIL*" TO P-OR-F. SG2044.2 +085700 DE-LETE-3. SG2044.2 +085800 MOVE SPACE TO P-OR-F. SG2044.2 +085900 MOVE " ************ " TO COMPUTED-A. SG2044.2 +086000 MOVE " ************ " TO CORRECT-A. SG2044.2 +086100 MOVE "****TEST DELETED****" TO RE-MARK. SG2044.2 +086200 ADD 1 TO DELETE-CNT. SG2044.2 +086300 PRINT-DETAIL-3. SG2044.2 +086400 IF REC-CT NOT EQUAL TO ZERO SG2044.2 +086500 MOVE "." TO PARDOT-X SG2044.2 +086600 MOVE REC-CT TO DOTVALUE. SG2044.2 +086700 MOVE TEST-RESULTS TO PRINT-REC. SG2044.2 +086800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SG2044.2 +086900 MOVE SPACE TO P-OR-F. SG2044.2 +087000 MOVE SPACE TO COMPUTED-A. SG2044.2 +087100 MOVE SPACE TO CORRECT-A. SG2044.2 +087200 IF REC-CT EQUAL TO ZERO SG2044.2 +087300 MOVE SPACE TO PAR-NAME. SG2044.2 +087400 MOVE SPACE TO RE-MARK. SG2044.2 +087500 EXIT-3. SG2044.2 +087600 EXIT. SG2044.2 +087700 END-CCVS SECTION 25. SG2044.2 +087800 CCVS-EXIT SECTION. SG2044.2 +087900 CCVS-999999. SG2044.2 +088000 GO TO CLOSE-FILES. SG2044.2 diff --git a/tests/cobol85/SG/SG302M.CBL b/tests/cobol85/SG/SG302M.CBL new file mode 100755 index 00000000..0c9135c0 --- /dev/null +++ b/tests/cobol85/SG/SG302M.CBL @@ -0,0 +1,21 @@ +000100 IDENTIFICATION DIVISION. SG3024.2 +000200 PROGRAM-ID. SG3024.2 +000300 SG302M. SG3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF SG3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN SEGMENTATION LEVEL 1. SG3024.2 +000600 ENVIRONMENT DIVISION. SG3024.2 +000700 CONFIGURATION SECTION. SG3024.2 +000800 SOURCE-COMPUTER. SG3024.2 +000900 Linux. SG3024.2 +001000 OBJECT-COMPUTER. SG3024.2 +001100 Linux. SG3024.2 +001200 SG3024.2 +001300 SG3024.2 +001400 DATA DIVISION. SG3024.2 +001500 PROCEDURE DIVISION. SG3024.2 +001600 BEANO SECTION 1. SG3024.2 +001700*Message expected for above statement: OBSOLETE SG3024.2 +001800 SG302M-CONTROL. SG3024.2 +001900 DISPLAY "THIS IS A DUMMY PARAGRAPH". SG3024.2 +002000 STOP RUN. SG3024.2 +002100*TOTAL NUMBER OF FLAGS EXPECTED = 1. SG3024.2 diff --git a/tests/cobol85/SG/SG303M.CBL b/tests/cobol85/SG/SG303M.CBL new file mode 100755 index 00000000..105594c4 --- /dev/null +++ b/tests/cobol85/SG/SG303M.CBL @@ -0,0 +1,37 @@ +000100 IDENTIFICATION DIVISION. SG3034.2 +000200 PROGRAM-ID. SG3034.2 +000300 SG303M. SG3034.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF SG3034.2 +000500*OBSOLETE FEATURES THAT ARE USED IN SEGMENTATION LEVEL 2. SG3034.2 +000600 ENVIRONMENT DIVISION. SG3034.2 +000700 CONFIGURATION SECTION. SG3034.2 +000800 SOURCE-COMPUTER. SG3034.2 +000900 Linux. SG3034.2 +001000 OBJECT-COMPUTER. SG3034.2 +001100 Linux SG3034.2 +001200 SEGMENT-LIMIT IS 20. SG3034.2 +001300*Message expected for above statement: OBSOLETE SG3034.2 +001400 DATA DIVISION. SG3034.2 +001500 PROCEDURE DIVISION. SG3034.2 +001600 SG3034.2 +001700 NUMBER1 SECTION 18. SG3034.2 +001800*Message expected for above statement: OBSOLETE SG3034.2 +001900 SG3034.2 +002000 SG303M-CONTROL. SG3034.2 +002100 EXIT. SG3034.2 +002200 SG3034.2 +002300 NUMBER2 SECTION 19. SG3034.2 +002400*Message expected for above statement: OBSOLETE SG3034.2 +002500 SG3034.2 +002600 SG303M-DUMMY1. SG3034.2 +002700 DISPLAY "THIS IS A DUMMY PARAGRAPH". SG3034.2 +002800 SG3034.2 +002900 NUMBER3 SECTION 18. SG3034.2 +003000*Message expected for above statement: OBSOLETE SG3034.2 +003100 SG3034.2 +003200 SG303M-DUMMY2. SG3034.2 +003300 DISPLAY "THIS IS A DUMMY PARAGRAPH TOO!". SG3034.2 +003400 SG3034.2 +003500 SG3034.2 +003600 SG3034.2 +003700*TOTAL NUMBER OF FLAGS EXPECTED = 4. SG3034.2 diff --git a/tests/cobol85/SG/SG401M.CBL b/tests/cobol85/SG/SG401M.CBL new file mode 100755 index 00000000..73581bba --- /dev/null +++ b/tests/cobol85/SG/SG401M.CBL @@ -0,0 +1,39 @@ +000100 IDENTIFICATION DIVISION. SG4014.2 +000200 PROGRAM-ID. SG4014.2 +000300 SG401M. SG4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF LEVEL 2 SG4014.2 +000500*FEATURES OF THE SEGMENTATION MODULE. SG4014.2 +000600 ENVIRONMENT DIVISION. SG4014.2 +000700 CONFIGURATION SECTION. SG4014.2 +000800 SOURCE-COMPUTER. SG4014.2 +000900 Linux. SG4014.2 +001000 OBJECT-COMPUTER. SG4014.2 +001100 Linux SG4014.2 +001200 SEGMENT-LIMIT IS 18. SG4014.2 +001300*Message expected for above statement: NON-CONFORMING STANDARD SG4014.2 +001400 SG4014.2 +001500 SG4014.2 +001600 DATA DIVISION. SG4014.2 +001700 PROCEDURE DIVISION. SG4014.2 +001800 SG4014.2 +001900 NUMBER1 SECTION 18. SG4014.2 +002000 SG4014.2 +002100 SG401M-CONTROL. SG4014.2 +002200 EXIT. SG4014.2 +002300 SG4014.2 +002400 NUMBER2 SECTION 19. SG4014.2 +002500 SG4014.2 +002600 SG401M-DUMMY. SG4014.2 +002700 DISPLAY "THIS IS A DUMMY PARAGRAPH". SG4014.2 +002800 SG4014.2 +002900 NUMBER3 SECTION 18. SG4014.2 +003000*Message expected for above statement: NON-CONFORMING STANDARD SG4014.2 +003100 SG401M-DUMMY2. SG4014.2 +003200 DISPLAY "THIS IS A DUMMY PARAGRAPH TOO!". SG4014.2 +003300 SG4014.2 +003400 SG4014.2 +003500* A MESSAGE IS EXPECTED FOR THE EXISTENCE OF TWO SECTIONS SG4014.2 +003600* WITH THE SAME SECTION NUMBER THAT ARE NOT SG4014.2 +003700* "PHYSICALLY CONTIGUOUS IN THE SOURCE PROGRAM". SG4014.2 +003800 SG4014.2 +003900*TOTAL NUMBER OF FLAGS EXPECTED = 2. SG4014.2 diff --git a/tests/cobol85/SM.txt b/tests/cobol85/SM.txt deleted file mode 100644 index d80547de..00000000 --- a/tests/cobol85/SM.txt +++ /dev/null @@ -1,27 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -SM101A.CBL 8 8 0 0 0 OK -SM102A.SUB 4 4 0 0 0 OK -SM103A.CBL 6 6 0 0 0 OK -SM104A.SUB 7 7 0 0 0 OK -SM105A.CBL 9 9 0 0 0 OK -SM106A.CBL 1 0 0 0 1 OK -SM107A.CBL 200 200 0 0 0 OK -SM201A.CBL 11 11 0 0 0 OK -SM202A.SUB 7 7 0 0 0 OK -SM203A.CBL 1 1 0 0 0 OK -SM204A.SUB 4 4 0 0 0 OK -SM205A.CBL 9 9 0 0 0 OK -SM206A.CBL 16 14 0 2 0 OK -SM207A.CBL 2 2 0 0 0 OK -SM208A.CBL 9 8 0 1 0 OK -SM301M.CBL ----- test skipped ----- -SM401M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 294 290 0 3 1 -% 100.0 98.6 0.0 1.0 0.3 - -Number of programs: 15 -Successfully executed: 15 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/SM/SM101A.CBL b/tests/cobol85/SM/SM101A.CBL new file mode 100755 index 00000000..e8582867 --- /dev/null +++ b/tests/cobol85/SM/SM101A.CBL @@ -0,0 +1,569 @@ +000100 IDENTIFICATION DIVISION. SM1014.2 +000200 PROGRAM-ID. SM1014.2 +000300 SM101A. SM1014.2 +000400**************************************************************** SM1014.2 +000500* * SM1014.2 +000600* VALIDATION FOR:- * SM1014.2 +000700* * SM1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1014.2 +000900* * SM1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1014.2 +001100* * SM1014.2 +001200* * SM1014.2 +001300* X-CARDS USED BY THIS PROGRAM ARE :- * SM1014.2 +001400* * SM1014.2 +001500* X-55 - SYSTEM PRINTER NAME. * SM1014.2 +001600* X-82 - SOURCE COMPUTER NAME. * SM1014.2 +001700* X-83 - OBJECT COMPUTER NAME. * SM1014.2 +001800* * SM1014.2 +001900**************************************************************** SM1014.2 +002000* * SM1014.2 +002100* PROGRAM SM101A TESTS THE USE OF THE "COPY" STATEMENT * SM1014.2 +002200* IN A FILE DESCRIPTION WITH ITS RELATED 01 ENTRIES IN THE * SM1014.2 +002300* WORKING-STORAGE SECTION AND IN THE PROCEDURE DIVISION. * SM1014.2 +002400* IT CREATES A SEQUENTIAL FILE WHICH IS INPUT TO SM102A TO * SM1014.2 +002500* CHECK THE PROPER EXECUTION OF THE "COPY" STATEMENT IN * SM1014.2 +002600* SM101A. IT ALSO TESTS THE EFFECT OF A "COPY" STATEMENT * SM1014.2 +002700* APPEARING ON A DEBUGGING LINE. * SM1014.2 +002800* * SM1014.2 +002900**************************************************************** SM1014.2 +003000 ENVIRONMENT DIVISION. SM1014.2 +003100 CONFIGURATION SECTION. SM1014.2 +003200 SOURCE-COMPUTER. SM1014.2 +003300 Linux. SM1014.2 +003400 OBJECT-COMPUTER. SM1014.2 +003500 Linux. SM1014.2 +003600 INPUT-OUTPUT SECTION. SM1014.2 +003700 FILE-CONTROL. SM1014.2 +003800 SELECT PRINT-FILE ASSIGN TO SM1014.2 +003900 "report.log". SM1014.2 +004000 SELECT TEST-FILE ASSIGN TO SM1014.2 +004100 "XXXXX001". SM1014.2 +004200 DATA DIVISION. SM1014.2 +004300 FILE SECTION. SM1014.2 +004400 FD PRINT-FILE. SM1014.2 +004500 01 PRINT-REC PICTURE X(120). SM1014.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM1014.2 +004700 SM1014.2 +004800 SM1014.2 +004900 SM1014.2 +005000 SM1014.2 +005100 SM1014.2 +005200* SM1014.2 +005300*********************** COPY STATEMENT USED **********************SM1014.2 +005400* SM1014.2 +005500*FD TEST-FILE COPY K1FDA. SM1014.2 +005600* SM1014.2 +005700******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +005800 FD TEST-FILE COPY K1FDA.SM1014.2 +005900*********************** END OF COPIED TEXT ***********************SM1014.2 +006000 SM1014.2 +006100 SM1014.2 +006200 SM1014.2 +006300 SM1014.2 +006400 SM1014.2 +006500* SM1014.2 +006600*********************** COPY STATEMENT USED **********************SM1014.2 +006700* SM1014.2 +006800*01 TST-TEST COPY K101A. SM1014.2 +006900* SM1014.2 +007000******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +007100 01 TST-TEST COPY K101A.SM1014.2 +007200*********************** END OF COPIED TEXT ***********************SM1014.2 +007300 WORKING-STORAGE SECTION. SM1014.2 +007400* SM1014.2 +007500*********************** COPY STATEMENT USED **********************SM1014.2 +007600* SM1014.2 +007700*77 RCD-1 COPY K1W01. SM1014.2 +007800* SM1014.2 +007900******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +008000 77 RCD-1 COPY K1W01.SM1014.2 +008100*********************** END OF COPIED TEXT ***********************SM1014.2 +008200 77 RCD-3 PICTURE 9(5) VALUE 10901. SM1014.2 +008300* SM1014.2 +008400*********************** COPY STATEMENT USED **********************SM1014.2 +008500* SM1014.2 +008600*77 COPY K1W02. SM1014.2 +008700* SM1014.2 +008800******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +008900 77 COPY K1W02. SM1014.2 +009000*********************** END OF COPIED TEXT ***********************SM1014.2 +009100 14003. SM1014.2 +009200 77 RCD-6 PICTURE 9(5) VALUE 19922. SM1014.2 +009300* SM1014.2 +009400*********************** COPY STATEMENT USED **********************SM1014.2 +009500* SM1014.2 +009600*77 COPY K1W03. VALUE 3543. SM1014.2 +009700* SM1014.2 +009800******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +009900 77 COPY K1W03. VALUE 3543. SM1014.2 +010000*********************** END OF COPIED TEXT ***********************SM1014.2 +010100 77 COPYSECT-1 PICTURE 9(5) VALUE 72459. SM1014.2 +010200 77 COPYSECT-2 PICTURE 9(5) VALUE 12132. SM1014.2 +010300 77 COPYSECT-3 PICTURE X(5) VALUE "TSTLI". SM1014.2 +010400 77 COPYSECT-4 PICTURE X(5) VALUE "BCOPY". SM1014.2 +010500* SM1014.2 +010600*********************** COPY STATEMENT USED **********************SM1014.2 +010700* SM1014.2 +010800*COPY K1W04. SM1014.2 +010900* SM1014.2 +011000******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +011100 COPY K1W04. SM1014.2 +011200*********************** END OF COPIED TEXT ***********************SM1014.2 +011300 77 PROC-1 PICTURE 999 VALUE 123. SM1014.2 +011400 77 PROC-2 PICTURE 999 VALUE 456. SM1014.2 +011500 77 WSTR-1 PICTURE X(3) VALUE "ABC". SM1014.2 +011600 SM1014.2 +011700 SM1014.2 +011800 SM1014.2 +011900 SM1014.2 +012000 SM1014.2 +012100 01 WSTR-2. SM1014.2 +012200* SM1014.2 +012300*********************** COPY STATEMENT USED **********************SM1014.2 +012400* SM1014.2 +012500* COPY K1WKA. SM1014.2 +012600* SM1014.2 +012700******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +012800 COPY K1WKA. SM1014.2 +012900*********************** END OF COPIED TEXT ***********************SM1014.2 +013000 01 TEST-RESULTS. SM1014.2 +013100 02 FILLER PIC X VALUE SPACE. SM1014.2 +013200 02 FEATURE PIC X(20) VALUE SPACE. SM1014.2 +013300 02 FILLER PIC X VALUE SPACE. SM1014.2 +013400 02 P-OR-F PIC X(5) VALUE SPACE. SM1014.2 +013500 02 FILLER PIC X VALUE SPACE. SM1014.2 +013600 02 PAR-NAME. SM1014.2 +013700 03 FILLER PIC X(19) VALUE SPACE. SM1014.2 +013800 03 PARDOT-X PIC X VALUE SPACE. SM1014.2 +013900 03 DOTVALUE PIC 99 VALUE ZERO. SM1014.2 +014000 02 FILLER PIC X(8) VALUE SPACE. SM1014.2 +014100 02 RE-MARK PIC X(61). SM1014.2 +014200 01 TEST-COMPUTED. SM1014.2 +014300 02 FILLER PIC X(30) VALUE SPACE. SM1014.2 +014400 02 FILLER PIC X(17) VALUE SM1014.2 +014500 " COMPUTED=". SM1014.2 +014600 02 COMPUTED-X. SM1014.2 +014700 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1014.2 +014800 03 COMPUTED-N REDEFINES COMPUTED-A SM1014.2 +014900 PIC -9(9).9(9). SM1014.2 +015000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1014.2 +015100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1014.2 +015200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1014.2 +015300 03 CM-18V0 REDEFINES COMPUTED-A. SM1014.2 +015400 04 COMPUTED-18V0 PIC -9(18). SM1014.2 +015500 04 FILLER PIC X. SM1014.2 +015600 03 FILLER PIC X(50) VALUE SPACE. SM1014.2 +015700 01 TEST-CORRECT. SM1014.2 +015800 02 FILLER PIC X(30) VALUE SPACE. SM1014.2 +015900 02 FILLER PIC X(17) VALUE " CORRECT =". SM1014.2 +016000 02 CORRECT-X. SM1014.2 +016100 03 CORRECT-A PIC X(20) VALUE SPACE. SM1014.2 +016200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1014.2 +016300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1014.2 +016400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1014.2 +016500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1014.2 +016600 03 CR-18V0 REDEFINES CORRECT-A. SM1014.2 +016700 04 CORRECT-18V0 PIC -9(18). SM1014.2 +016800 04 FILLER PIC X. SM1014.2 +016900 03 FILLER PIC X(2) VALUE SPACE. SM1014.2 +017000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1014.2 +017100 01 CCVS-C-1. SM1014.2 +017200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1014.2 +017300- "SS PARAGRAPH-NAME SM1014.2 +017400- " REMARKS". SM1014.2 +017500 02 FILLER PIC X(20) VALUE SPACE. SM1014.2 +017600 01 CCVS-C-2. SM1014.2 +017700 02 FILLER PIC X VALUE SPACE. SM1014.2 +017800 02 FILLER PIC X(6) VALUE "TESTED". SM1014.2 +017900 02 FILLER PIC X(15) VALUE SPACE. SM1014.2 +018000 02 FILLER PIC X(4) VALUE "FAIL". SM1014.2 +018100 02 FILLER PIC X(94) VALUE SPACE. SM1014.2 +018200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1014.2 +018300 01 REC-CT PIC 99 VALUE ZERO. SM1014.2 +018400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1014.2 +018500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1014.2 +018600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1014.2 +018700 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1014.2 +018800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1014.2 +018900 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1014.2 +019000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1014.2 +019100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1014.2 +019200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1014.2 +019300 01 CCVS-H-1. SM1014.2 +019400 02 FILLER PIC X(39) VALUE SPACES. SM1014.2 +019500 02 FILLER PIC X(42) VALUE SM1014.2 +019600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1014.2 +019700 02 FILLER PIC X(39) VALUE SPACES. SM1014.2 +019800 01 CCVS-H-2A. SM1014.2 +019900 02 FILLER PIC X(40) VALUE SPACE. SM1014.2 +020000 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1014.2 +020100 02 FILLER PIC XXXX VALUE SM1014.2 +020200 "4.2 ". SM1014.2 +020300 02 FILLER PIC X(28) VALUE SM1014.2 +020400 " COPY - NOT FOR DISTRIBUTION". SM1014.2 +020500 02 FILLER PIC X(41) VALUE SPACE. SM1014.2 +020600 SM1014.2 +020700 01 CCVS-H-2B. SM1014.2 +020800 02 FILLER PIC X(15) VALUE SM1014.2 +020900 "TEST RESULT OF ". SM1014.2 +021000 02 TEST-ID PIC X(9). SM1014.2 +021100 02 FILLER PIC X(4) VALUE SM1014.2 +021200 " IN ". SM1014.2 +021300 02 FILLER PIC X(12) VALUE SM1014.2 +021400 " HIGH ". SM1014.2 +021500 02 FILLER PIC X(22) VALUE SM1014.2 +021600 " LEVEL VALIDATION FOR ". SM1014.2 +021700 02 FILLER PIC X(58) VALUE SM1014.2 +021800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1014.2 +021900 01 CCVS-H-3. SM1014.2 +022000 02 FILLER PIC X(34) VALUE SM1014.2 +022100 " FOR OFFICIAL USE ONLY ". SM1014.2 +022200 02 FILLER PIC X(58) VALUE SM1014.2 +022300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1014.2 +022400 02 FILLER PIC X(28) VALUE SM1014.2 +022500 " COPYRIGHT 1985 ". SM1014.2 +022600 01 CCVS-E-1. SM1014.2 +022700 02 FILLER PIC X(52) VALUE SPACE. SM1014.2 +022800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1014.2 +022900 02 ID-AGAIN PIC X(9). SM1014.2 +023000 02 FILLER PIC X(45) VALUE SPACES. SM1014.2 +023100 01 CCVS-E-2. SM1014.2 +023200 02 FILLER PIC X(31) VALUE SPACE. SM1014.2 +023300 02 FILLER PIC X(21) VALUE SPACE. SM1014.2 +023400 02 CCVS-E-2-2. SM1014.2 +023500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1014.2 +023600 03 FILLER PIC X VALUE SPACE. SM1014.2 +023700 03 ENDER-DESC PIC X(44) VALUE SM1014.2 +023800 "ERRORS ENCOUNTERED". SM1014.2 +023900 01 CCVS-E-3. SM1014.2 +024000 02 FILLER PIC X(22) VALUE SM1014.2 +024100 " FOR OFFICIAL USE ONLY". SM1014.2 +024200 02 FILLER PIC X(12) VALUE SPACE. SM1014.2 +024300 02 FILLER PIC X(58) VALUE SM1014.2 +024400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1014.2 +024500 02 FILLER PIC X(13) VALUE SPACE. SM1014.2 +024600 02 FILLER PIC X(15) VALUE SM1014.2 +024700 " COPYRIGHT 1985". SM1014.2 +024800 01 CCVS-E-4. SM1014.2 +024900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1014.2 +025000 02 FILLER PIC X(4) VALUE " OF ". SM1014.2 +025100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1014.2 +025200 02 FILLER PIC X(40) VALUE SM1014.2 +025300 " TESTS WERE EXECUTED SUCCESSFULLY". SM1014.2 +025400 01 XXINFO. SM1014.2 +025500 02 FILLER PIC X(19) VALUE SM1014.2 +025600 "*** INFORMATION ***". SM1014.2 +025700 02 INFO-TEXT. SM1014.2 +025800 04 FILLER PIC X(8) VALUE SPACE. SM1014.2 +025900 04 XXCOMPUTED PIC X(20). SM1014.2 +026000 04 FILLER PIC X(5) VALUE SPACE. SM1014.2 +026100 04 XXCORRECT PIC X(20). SM1014.2 +026200 02 INF-ANSI-REFERENCE PIC X(48). SM1014.2 +026300 01 HYPHEN-LINE. SM1014.2 +026400 02 FILLER PIC IS X VALUE IS SPACE. SM1014.2 +026500 02 FILLER PIC IS X(65) VALUE IS "************************SM1014.2 +026600- "*****************************************". SM1014.2 +026700 02 FILLER PIC IS X(54) VALUE IS "************************SM1014.2 +026800- "******************************". SM1014.2 +026900 01 CCVS-PGM-ID PIC X(9) VALUE SM1014.2 +027000 "SM101A". SM1014.2 +027100 PROCEDURE DIVISION. SM1014.2 +027200 CCVS1 SECTION. SM1014.2 +027300 OPEN-FILES. SM1014.2 +027400 OPEN OUTPUT PRINT-FILE. SM1014.2 +027500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1014.2 +027600 MOVE SPACE TO TEST-RESULTS. SM1014.2 +027700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1014.2 +027800 GO TO CCVS1-EXIT. SM1014.2 +027900 CLOSE-FILES. SM1014.2 +028000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1014.2 +028100 TERMINATE-CCVS. SM1014.2 +028200*S EXIT PROGRAM. SM1014.2 +028300*SERMINATE-CALL. SM1014.2 +028400 STOP RUN. SM1014.2 +028500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1014.2 +028600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1014.2 +028700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1014.2 +028800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1014.2 +028900 MOVE "****TEST DELETED****" TO RE-MARK. SM1014.2 +029000 PRINT-DETAIL. SM1014.2 +029100 IF REC-CT NOT EQUAL TO ZERO SM1014.2 +029200 MOVE "." TO PARDOT-X SM1014.2 +029300 MOVE REC-CT TO DOTVALUE. SM1014.2 +029400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1014.2 +029500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1014.2 +029600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1014.2 +029700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1014.2 +029800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1014.2 +029900 MOVE SPACE TO CORRECT-X. SM1014.2 +030000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1014.2 +030100 MOVE SPACE TO RE-MARK. SM1014.2 +030200 HEAD-ROUTINE. SM1014.2 +030300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +030400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +030500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1014.2 +030600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1014.2 +030700 COLUMN-NAMES-ROUTINE. SM1014.2 +030800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +030900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +031000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +031100 END-ROUTINE. SM1014.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1014.2 +031300 END-RTN-EXIT. SM1014.2 +031400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +031500 END-ROUTINE-1. SM1014.2 +031600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1014.2 +031700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1014.2 +031800 ADD PASS-COUNTER TO ERROR-HOLD. SM1014.2 +031900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1014.2 +032000 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1014.2 +032100 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1014.2 +032200 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1014.2 +032300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1014.2 +032400 END-ROUTINE-12. SM1014.2 +032500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1014.2 +032600 IF ERROR-COUNTER IS EQUAL TO ZERO SM1014.2 +032700 MOVE "NO " TO ERROR-TOTAL SM1014.2 +032800 ELSE SM1014.2 +032900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1014.2 +033000 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1014.2 +033100 PERFORM WRITE-LINE. SM1014.2 +033200 END-ROUTINE-13. SM1014.2 +033300 IF DELETE-COUNTER IS EQUAL TO ZERO SM1014.2 +033400 MOVE "NO " TO ERROR-TOTAL ELSE SM1014.2 +033500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1014.2 +033600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1014.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +033800 IF INSPECT-COUNTER EQUAL TO ZERO SM1014.2 +033900 MOVE "NO " TO ERROR-TOTAL SM1014.2 +034000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1014.2 +034100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1014.2 +034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +034300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1014.2 +034400 WRITE-LINE. SM1014.2 +034500 ADD 1 TO RECORD-COUNT. SM1014.2 +034600 IF RECORD-COUNT GREATER 50 SM1014.2 +034700 MOVE DUMMY-RECORD TO DUMMY-HOLD SM1014.2 +034800 MOVE SPACE TO DUMMY-RECORD SM1014.2 +034900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1014.2 +035000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1014.2 +035100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1014.2 +035200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1014.2 +035300 MOVE DUMMY-HOLD TO DUMMY-RECORD SM1014.2 +035400 MOVE ZERO TO RECORD-COUNT. SM1014.2 +035500 PERFORM WRT-LN. SM1014.2 +035600 WRT-LN. SM1014.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1014.2 +035800 MOVE SPACE TO DUMMY-RECORD. SM1014.2 +035900 BLANK-LINE-PRINT. SM1014.2 +036000 PERFORM WRT-LN. SM1014.2 +036100 FAIL-ROUTINE. SM1014.2 +036200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1014.2 +036300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1014.2 +036400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1014.2 +036500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1014.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. SM1014.2 +036800 GO TO FAIL-ROUTINE-EX. SM1014.2 +036900 FAIL-ROUTINE-WRITE. SM1014.2 +037000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1014.2 +037100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1014.2 +037200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1014.2 +037300 MOVE SPACES TO COR-ANSI-REFERENCE. SM1014.2 +037400 FAIL-ROUTINE-EX. EXIT. SM1014.2 +037500 BAIL-OUT. SM1014.2 +037600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1014.2 +037700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1014.2 +037800 BAIL-OUT-WRITE. SM1014.2 +037900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1014.2 +038000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1014.2 +038100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1014.2 +038200 MOVE SPACES TO INF-ANSI-REFERENCE. SM1014.2 +038300 BAIL-OUT-EX. EXIT. SM1014.2 +038400 CCVS1-EXIT. SM1014.2 +038500 EXIT. SM1014.2 +038600 INITIALIZATION SECTION. SM1014.2 +038700 SM101A-INIT. SM1014.2 +038800 OPEN OUTPUT TEST-FILE. SM1014.2 +038900 MOVE "OUTPUT OF SM101A IS USED AS" TO RE-MARK. SM1014.2 +039000 PERFORM PRINT-DETAIL. SM1014.2 +039100 MOVE "INPUT FOR SM102A." TO RE-MARK. SM1014.2 +039200 PERFORM PRINT-DETAIL. SM1014.2 +039300 MOVE "COPY ---" TO FEATURE. SM1014.2 +039400 PERFORM PRINT-DETAIL. SM1014.2 +039500 WORKING-STORAGE-TEST SECTION. SM1014.2 +039600 COPY-TEST-1. SM1014.2 +039700 IF WSTR-1 EQUAL TO WSTR-2 SM1014.2 +039800 PERFORM PASS GO TO COPY-WRITE-1. SM1014.2 +039900* NOTE TESTS COPYING OF WORKING-STORAGE ENTRIES. SM1014.2 +040000 GO TO COPY-FAIL-1. SM1014.2 +040100 COPY-DELETE-1. SM1014.2 +040200 PERFORM DE-LETE. SM1014.2 +040300 GO TO COPY-WRITE-1. SM1014.2 +040400 COPY-FAIL-1. SM1014.2 +040500 MOVE WSTR-2 TO COMPUTED-A. SM1014.2 +040600 MOVE "ABC" TO CORRECT-A SM1014.2 +040700 PERFORM FAIL. SM1014.2 +040800 COPY-WRITE-1. SM1014.2 +040900 MOVE " WKNG-STORAGE ENTRY" TO FEATURE SM1014.2 +041000 MOVE "COPY-TEST-1 " TO PAR-NAME. SM1014.2 +041100 PERFORM PRINT-DETAIL. SM1014.2 +041200 PARAGRAPH-TEST SECTION. SM1014.2 +041300 COPY-TEST-2. SM1014.2 +041400 SM1014.2 +041500 SM1014.2 +041600 SM1014.2 +041700 SM1014.2 +041800 SM1014.2 +041900* SM1014.2 +042000*********************** COPY STATEMENT USED **********************SM1014.2 +042100* SM1014.2 +042200* COPY K1PRA. SM1014.2 +042300* SM1014.2 +042400******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +042500 COPY K1PRA.SM1014.2 +042600*********************** END OF COPIED TEXT ***********************SM1014.2 +042700 COPY-TESTT-2. SM1014.2 +042800 IF PROC-1 EQUAL TO PROC-2 SM1014.2 +042900 PERFORM PASS GO TO COPY-WRITE-2. SM1014.2 +043000* NOTE TESTS COPYING OF A PROCEDURE DIVISION STATEMENT. SM1014.2 +043100 GO TO COPY-FAIL-2. SM1014.2 +043200 COPY-DELETE-2. SM1014.2 +043300 PERFORM DE-LETE. SM1014.2 +043400 GO TO COPY-WRITE-2. SM1014.2 +043500 COPY-FAIL-2. SM1014.2 +043600 MOVE PROC-2 TO COMPUTED-N. SM1014.2 +043700 MOVE 123 TO CORRECT-N. SM1014.2 +043800 PERFORM FAIL. SM1014.2 +043900 COPY-WRITE-2. SM1014.2 +044000 MOVE " PROCEDURE" TO FEATURE SM1014.2 +044100 MOVE "COPY-TEST-2 " TO PAR-NAME. SM1014.2 +044200 PERFORM PRINT-DETAIL. SM1014.2 +044300 SECTION-TEST SECTION. SM1014.2 +044400 SM1014.2 +044500 SM1014.2 +044600 SM1014.2 +044700 SM1014.2 +044800 SM1014.2 +044900* SM1014.2 +045000*********************** COPY STATEMENT USED **********************SM1014.2 +045100* SM1014.2 +045200* COPY K1SEA. SM1014.2 +045300* SM1014.2 +045400******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +045500 COPY K1SEA.SM1014.2 +045600D COPY K1SEA.SM1014.2 +045700*********************** END OF COPIED TEXT ***********************SM1014.2 +045800 COPY-INIT-A. SM1014.2 +045900 MOVE " SECTION" TO FEATURE. SM1014.2 +046000 COPY-TEST-3. SM1014.2 +046100 IF COPYSECT-1 EQUAL TO 95427 SM1014.2 +046200 PERFORM PASS GO TO COPY-WRITE-3. SM1014.2 +046300* NOTE COPY-TEST-3, 4, 5, 6 TEST THE COPYING OF AN SM1014.2 +046400* ENTIRE SECTION. SM1014.2 +046500 GO TO COPY-FAIL-3. SM1014.2 +046600 COPY-DELETE-3. SM1014.2 +046700 PERFORM DE-LETE. SM1014.2 +046800 GO TO COPY-WRITE-3. SM1014.2 +046900 COPY-FAIL-3. SM1014.2 +047000 MOVE COPYSECT-1 TO COMPUTED-N. SM1014.2 +047100 MOVE 95427 TO CORRECT-N. SM1014.2 +047200 PERFORM FAIL. SM1014.2 +047300 COPY-WRITE-3. SM1014.2 +047400 MOVE "COPY-TEST-3 " TO PAR-NAME. SM1014.2 +047500 PERFORM PRINT-DETAIL. SM1014.2 +047600 COPY-TEST-4. SM1014.2 +047700 IF COPYSECT-2 EQUAL TO 23121 SM1014.2 +047800 PERFORM PASS GO TO COPY-WRITE-4. SM1014.2 +047900 GO TO COPY-FAIL-4. SM1014.2 +048000 COPY-DELETE-4. SM1014.2 +048100 PERFORM DE-LETE. SM1014.2 +048200 GO TO COPY-WRITE-4. SM1014.2 +048300 COPY-FAIL-4. SM1014.2 +048400 MOVE COPYSECT-2 TO COMPUTED-N. SM1014.2 +048500 MOVE 23121 TO CORRECT-N. SM1014.2 +048600 PERFORM FAIL. SM1014.2 +048700 COPY-WRITE-4. SM1014.2 +048800 MOVE "COPY-TEST-4 " TO PAR-NAME. SM1014.2 +048900 PERFORM PRINT-DETAIL. SM1014.2 +049000 COPY-TEST-5. SM1014.2 +049100 IF COPYSECT-3 EQUAL TO "LIBCO" SM1014.2 +049200 PERFORM PASS GO TO COPY-WRITE-5. SM1014.2 +049300 GO TO COPY-FAIL-5. SM1014.2 +049400 COPY-DELETE-5. SM1014.2 +049500 PERFORM DE-LETE. SM1014.2 +049600 GO TO COPY-WRITE-5. SM1014.2 +049700 COPY-FAIL-5. SM1014.2 +049800 MOVE COPYSECT-3 TO COMPUTED-A. SM1014.2 +049900 MOVE "LIBCO" TO CORRECT-A. SM1014.2 +050000 PERFORM FAIL. SM1014.2 +050100 COPY-WRITE-5. SM1014.2 +050200 MOVE "COPY-TEST-5 " TO PAR-NAME. SM1014.2 +050300 PERFORM PRINT-DETAIL. SM1014.2 +050400 COPY-TEST-6. SM1014.2 +050500 IF COPYSECT-4 EQUAL TO "PYTST" SM1014.2 +050600 PERFORM PASS GO TO COPY-WRITE-6. SM1014.2 +050700 GO TO COPY-FAIL-6. SM1014.2 +050800 COPY-DELETE-6. SM1014.2 +050900 PERFORM DE-LETE. SM1014.2 +051000 GO TO COPY-WRITE-6. SM1014.2 +051100 COPY-FAIL-6. SM1014.2 +051200 MOVE COPYSECT-4 TO COMPUTED-A. SM1014.2 +051300 MOVE "PYTST" TO CORRECT-A. SM1014.2 +051400 PERFORM FAIL. SM1014.2 +051500 COPY-WRITE-6. SM1014.2 +051600 MOVE "COPY-TEST-6 " TO PAR-NAME. SM1014.2 +051700 PERFORM PRINT-DETAIL. SM1014.2 +051800 BUILD SECTION. SM1014.2 +051900 COPY-TEST-7. SM1014.2 +052000 MOVE RCD-1 TO TST-FLD-1. SM1014.2 +052100 WRITE TST-TEST. SM1014.2 +052200 MOVE RCD-2 TO TST-FLD-1. SM1014.2 +052300 WRITE TST-TEST. SM1014.2 +052400 MOVE RCD-3 TO TST-FLD-1. SM1014.2 +052500 WRITE TST-TEST. SM1014.2 +052600 MOVE RCD-4 TO TST-FLD-1. SM1014.2 +052700 WRITE TST-TEST. SM1014.2 +052800 MOVE RCD-5 TO TST-FLD-1. SM1014.2 +052900 WRITE TST-TEST. SM1014.2 +053000 MOVE RCD-6 TO TST-FLD-1. SM1014.2 +053100 WRITE TST-TEST. SM1014.2 +053200 MOVE RCD-7 TO TST-FLD-1. SM1014.2 +053300 WRITE TST-TEST. SM1014.2 +053400 PERFORM PASS. SM1014.2 +053500 GO TO COPY-WRITE-7. SM1014.2 +053600 COPY-DELETE-7. SM1014.2 +053700 PERFORM DE-LETE. SM1014.2 +053800 COPY-WRITE-7. SM1014.2 +053900 MOVE " FILE DESCRIPTION" TO FEATURE. SM1014.2 +054000 MOVE "COPY-TEST-7" TO PAR-NAME. SM1014.2 +054100 MOVE "OUTPUT CHECKED IN SM102A" TO RE-MARK. SM1014.2 +054200 PERFORM PRINT-DETAIL. SM1014.2 +054300 COPY-TEST-8. SM1014.2 +054400* SM1014.2 +054500*********************** COPY STATEMENT USED **********************SM1014.2 +054600* SM1014.2 +054700* ADD COPY K1P01. TO WRK-DS-05V00. SM1014.2 +054800* SM1014.2 +054900******************** COPIED TEXT BEGINS BELOW ********************SM1014.2 +055000 ADD COPY K1P01. TO WRK-DS-05V00. SM1014.2 +055100*********************** END OF COPIED TEXT ***********************SM1014.2 +055200 IF WRK-DS-05V00 EQUAL TO 97523 SM1014.2 +055300 PERFORM PASS SM1014.2 +055400 GO TO COPY-WRITE-8. SM1014.2 +055500 GO TO COPY-FAIL-8. SM1014.2 +055600 COPY-DELETE-8. SM1014.2 +055700 PERFORM DE-LETE. SM1014.2 +055800 GO TO COPY-WRITE-8. SM1014.2 +055900 COPY-FAIL-8. SM1014.2 +056000 MOVE WRK-DS-05V00 TO COMPUTED-N. SM1014.2 +056100 MOVE 97523 TO CORRECT-N. SM1014.2 +056200 PERFORM FAIL. SM1014.2 +056300 COPY-WRITE-8. SM1014.2 +056400 MOVE "COPY-TEST-8" TO PAR-NAME. SM1014.2 +056500 PERFORM PRINT-DETAIL. SM1014.2 +056600 CLOSE TEST-FILE. SM1014.2 +056700 CCVS-EXIT SECTION. SM1014.2 +056800 CCVS-999999. SM1014.2 +056900 GO TO CLOSE-FILES. SM1014.2 diff --git a/tests/cobol85/SM/SM102A.SUB b/tests/cobol85/SM/SM102A.SUB new file mode 100755 index 00000000..daafee6e --- /dev/null +++ b/tests/cobol85/SM/SM102A.SUB @@ -0,0 +1,393 @@ +000100 IDENTIFICATION DIVISION. SM1024.2 +000200 PROGRAM-ID. SM1024.2 +000300 SM102A. SM1024.2 +000400**************************************************************** SM1024.2 +000500* * SM1024.2 +000600* VALIDATION FOR:- * SM1024.2 +000700* * SM1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1024.2 +000900* * SM1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1024.2 +001100* * SM1024.2 +001200**************************************************************** SM1024.2 +001300* * SM1024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1024.2 +001500* * SM1024.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1024.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1024.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1024.2 +001900* * SM1024.2 +002000**************************************************************** SM1024.2 +002100* * SM1024.2 +002200* PROGRAM SM102A TESTS THE OUTPUT FILE PRODUCED BY SM101A * SM1024.2 +002300* TO ENSURE THE PROPER EXECUTION OF THE "COPY" STATEMENT * SM1024.2 +002400* IN THAT PROGRAM. * SM1024.2 +002500* * SM1024.2 +002600**************************************************************** SM1024.2 +002700 ENVIRONMENT DIVISION. SM1024.2 +002800 CONFIGURATION SECTION. SM1024.2 +002900 SOURCE-COMPUTER. SM1024.2 +003000 Linux. SM1024.2 +003100 OBJECT-COMPUTER. SM1024.2 +003200 Linux. SM1024.2 +003300 INPUT-OUTPUT SECTION. SM1024.2 +003400 FILE-CONTROL. SM1024.2 +003500 SELECT PRINT-FILE ASSIGN TO SM1024.2 +003600 "report.log". SM1024.2 +003700 SELECT TEST-FILE ASSIGN TO SM1024.2 +003800 "XXXXX001". SM1024.2 +003900 DATA DIVISION. SM1024.2 +004000 FILE SECTION. SM1024.2 +004100 FD PRINT-FILE. SM1024.2 +004200 01 PRINT-REC PICTURE X(120). SM1024.2 +004300 01 DUMMY-RECORD PICTURE X(120). SM1024.2 +004400 FD TEST-FILE SM1024.2 +004500 LABEL RECORD STANDARD SM1024.2 +004600*C VALUE OF SM1024.2 +004700*C OCLABELID SM1024.2 +004800*C IS SM1024.2 +004900*C "OCDUMMY" SM1024.2 +005000*G SYSIN SM1024.2 +005100 DATA RECORD IS TST-TEST. SM1024.2 +005200 01 TST-TEST. SM1024.2 +005300 02 TST-FLD-1 PICTURE 9(5). SM1024.2 +005400 02 FILLER PICTURE X(115). SM1024.2 +005500 WORKING-STORAGE SECTION. SM1024.2 +005600 01 TEST-RESULTS. SM1024.2 +005700 02 FILLER PIC X VALUE SPACE. SM1024.2 +005800 02 FEATURE PIC X(20) VALUE SPACE. SM1024.2 +005900 02 FILLER PIC X VALUE SPACE. SM1024.2 +006000 02 P-OR-F PIC X(5) VALUE SPACE. SM1024.2 +006100 02 FILLER PIC X VALUE SPACE. SM1024.2 +006200 02 PAR-NAME. SM1024.2 +006300 03 FILLER PIC X(19) VALUE SPACE. SM1024.2 +006400 03 PARDOT-X PIC X VALUE SPACE. SM1024.2 +006500 03 DOTVALUE PIC 99 VALUE ZERO. SM1024.2 +006600 02 FILLER PIC X(8) VALUE SPACE. SM1024.2 +006700 02 RE-MARK PIC X(61). SM1024.2 +006800 01 TEST-COMPUTED. SM1024.2 +006900 02 FILLER PIC X(30) VALUE SPACE. SM1024.2 +007000 02 FILLER PIC X(17) VALUE SM1024.2 +007100 " COMPUTED=". SM1024.2 +007200 02 COMPUTED-X. SM1024.2 +007300 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1024.2 +007400 03 COMPUTED-N REDEFINES COMPUTED-A SM1024.2 +007500 PIC -9(9).9(9). SM1024.2 +007600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1024.2 +007700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1024.2 +007800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1024.2 +007900 03 CM-18V0 REDEFINES COMPUTED-A. SM1024.2 +008000 04 COMPUTED-18V0 PIC -9(18). SM1024.2 +008100 04 FILLER PIC X. SM1024.2 +008200 03 FILLER PIC X(50) VALUE SPACE. SM1024.2 +008300 01 TEST-CORRECT. SM1024.2 +008400 02 FILLER PIC X(30) VALUE SPACE. SM1024.2 +008500 02 FILLER PIC X(17) VALUE " CORRECT =". SM1024.2 +008600 02 CORRECT-X. SM1024.2 +008700 03 CORRECT-A PIC X(20) VALUE SPACE. SM1024.2 +008800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1024.2 +008900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1024.2 +009000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1024.2 +009100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1024.2 +009200 03 CR-18V0 REDEFINES CORRECT-A. SM1024.2 +009300 04 CORRECT-18V0 PIC -9(18). SM1024.2 +009400 04 FILLER PIC X. SM1024.2 +009500 03 FILLER PIC X(2) VALUE SPACE. SM1024.2 +009600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1024.2 +009700 01 CCVS-C-1. SM1024.2 +009800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1024.2 +009900- "SS PARAGRAPH-NAME SM1024.2 +010000- " REMARKS". SM1024.2 +010100 02 FILLER PIC X(20) VALUE SPACE. SM1024.2 +010200 01 CCVS-C-2. SM1024.2 +010300 02 FILLER PIC X VALUE SPACE. SM1024.2 +010400 02 FILLER PIC X(6) VALUE "TESTED". SM1024.2 +010500 02 FILLER PIC X(15) VALUE SPACE. SM1024.2 +010600 02 FILLER PIC X(4) VALUE "FAIL". SM1024.2 +010700 02 FILLER PIC X(94) VALUE SPACE. SM1024.2 +010800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1024.2 +010900 01 REC-CT PIC 99 VALUE ZERO. SM1024.2 +011000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1024.2 +011100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1024.2 +011200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1024.2 +011300 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1024.2 +011400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1024.2 +011500 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1024.2 +011600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1024.2 +011700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1024.2 +011800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1024.2 +011900 01 CCVS-H-1. SM1024.2 +012000 02 FILLER PIC X(39) VALUE SPACES. SM1024.2 +012100 02 FILLER PIC X(42) VALUE SM1024.2 +012200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1024.2 +012300 02 FILLER PIC X(39) VALUE SPACES. SM1024.2 +012400 01 CCVS-H-2A. SM1024.2 +012500 02 FILLER PIC X(40) VALUE SPACE. SM1024.2 +012600 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1024.2 +012700 02 FILLER PIC XXXX VALUE SM1024.2 +012800 "4.2 ". SM1024.2 +012900 02 FILLER PIC X(28) VALUE SM1024.2 +013000 " COPY - NOT FOR DISTRIBUTION". SM1024.2 +013100 02 FILLER PIC X(41) VALUE SPACE. SM1024.2 +013200 SM1024.2 +013300 01 CCVS-H-2B. SM1024.2 +013400 02 FILLER PIC X(15) VALUE SM1024.2 +013500 "TEST RESULT OF ". SM1024.2 +013600 02 TEST-ID PIC X(9). SM1024.2 +013700 02 FILLER PIC X(4) VALUE SM1024.2 +013800 " IN ". SM1024.2 +013900 02 FILLER PIC X(12) VALUE SM1024.2 +014000 " HIGH ". SM1024.2 +014100 02 FILLER PIC X(22) VALUE SM1024.2 +014200 " LEVEL VALIDATION FOR ". SM1024.2 +014300 02 FILLER PIC X(58) VALUE SM1024.2 +014400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1024.2 +014500 01 CCVS-H-3. SM1024.2 +014600 02 FILLER PIC X(34) VALUE SM1024.2 +014700 " FOR OFFICIAL USE ONLY ". SM1024.2 +014800 02 FILLER PIC X(58) VALUE SM1024.2 +014900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1024.2 +015000 02 FILLER PIC X(28) VALUE SM1024.2 +015100 " COPYRIGHT 1985 ". SM1024.2 +015200 01 CCVS-E-1. SM1024.2 +015300 02 FILLER PIC X(52) VALUE SPACE. SM1024.2 +015400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1024.2 +015500 02 ID-AGAIN PIC X(9). SM1024.2 +015600 02 FILLER PIC X(45) VALUE SPACES. SM1024.2 +015700 01 CCVS-E-2. SM1024.2 +015800 02 FILLER PIC X(31) VALUE SPACE. SM1024.2 +015900 02 FILLER PIC X(21) VALUE SPACE. SM1024.2 +016000 02 CCVS-E-2-2. SM1024.2 +016100 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1024.2 +016200 03 FILLER PIC X VALUE SPACE. SM1024.2 +016300 03 ENDER-DESC PIC X(44) VALUE SM1024.2 +016400 "ERRORS ENCOUNTERED". SM1024.2 +016500 01 CCVS-E-3. SM1024.2 +016600 02 FILLER PIC X(22) VALUE SM1024.2 +016700 " FOR OFFICIAL USE ONLY". SM1024.2 +016800 02 FILLER PIC X(12) VALUE SPACE. SM1024.2 +016900 02 FILLER PIC X(58) VALUE SM1024.2 +017000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1024.2 +017100 02 FILLER PIC X(13) VALUE SPACE. SM1024.2 +017200 02 FILLER PIC X(15) VALUE SM1024.2 +017300 " COPYRIGHT 1985". SM1024.2 +017400 01 CCVS-E-4. SM1024.2 +017500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1024.2 +017600 02 FILLER PIC X(4) VALUE " OF ". SM1024.2 +017700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1024.2 +017800 02 FILLER PIC X(40) VALUE SM1024.2 +017900 " TESTS WERE EXECUTED SUCCESSFULLY". SM1024.2 +018000 01 XXINFO. SM1024.2 +018100 02 FILLER PIC X(19) VALUE SM1024.2 +018200 "*** INFORMATION ***". SM1024.2 +018300 02 INFO-TEXT. SM1024.2 +018400 04 FILLER PIC X(8) VALUE SPACE. SM1024.2 +018500 04 XXCOMPUTED PIC X(20). SM1024.2 +018600 04 FILLER PIC X(5) VALUE SPACE. SM1024.2 +018700 04 XXCORRECT PIC X(20). SM1024.2 +018800 02 INF-ANSI-REFERENCE PIC X(48). SM1024.2 +018900 01 HYPHEN-LINE. SM1024.2 +019000 02 FILLER PIC IS X VALUE IS SPACE. SM1024.2 +019100 02 FILLER PIC IS X(65) VALUE IS "************************SM1024.2 +019200- "*****************************************". SM1024.2 +019300 02 FILLER PIC IS X(54) VALUE IS "************************SM1024.2 +019400- "******************************". SM1024.2 +019500 01 CCVS-PGM-ID PIC X(9) VALUE SM1024.2 +019600 "SM102A". SM1024.2 +019700 PROCEDURE DIVISION. SM1024.2 +019800 CCVS1 SECTION. SM1024.2 +019900 OPEN-FILES. SM1024.2 +020000 OPEN OUTPUT PRINT-FILE. SM1024.2 +020100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1024.2 +020200 MOVE SPACE TO TEST-RESULTS. SM1024.2 +020300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1024.2 +020400 GO TO CCVS1-EXIT. SM1024.2 +020500 CLOSE-FILES. SM1024.2 +020600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1024.2 +020700 TERMINATE-CCVS. SM1024.2 +020800*S EXIT PROGRAM. SM1024.2 +020900*SERMINATE-CALL. SM1024.2 +021000 STOP RUN. SM1024.2 +021100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1024.2 +021200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1024.2 +021300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1024.2 +021400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1024.2 +021500 MOVE "****TEST DELETED****" TO RE-MARK. SM1024.2 +021600 PRINT-DETAIL. SM1024.2 +021700 IF REC-CT NOT EQUAL TO ZERO SM1024.2 +021800 MOVE "." TO PARDOT-X SM1024.2 +021900 MOVE REC-CT TO DOTVALUE. SM1024.2 +022000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1024.2 +022100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1024.2 +022200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1024.2 +022300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1024.2 +022400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1024.2 +022500 MOVE SPACE TO CORRECT-X. SM1024.2 +022600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1024.2 +022700 MOVE SPACE TO RE-MARK. SM1024.2 +022800 HEAD-ROUTINE. SM1024.2 +022900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +023000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +023100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1024.2 +023200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1024.2 +023300 COLUMN-NAMES-ROUTINE. SM1024.2 +023400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +023500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +023600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +023700 END-ROUTINE. SM1024.2 +023800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1024.2 +023900 END-RTN-EXIT. SM1024.2 +024000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +024100 END-ROUTINE-1. SM1024.2 +024200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1024.2 +024300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1024.2 +024400 ADD PASS-COUNTER TO ERROR-HOLD. SM1024.2 +024500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1024.2 +024600 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1024.2 +024700 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1024.2 +024800 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1024.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1024.2 +025000 END-ROUTINE-12. SM1024.2 +025100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1024.2 +025200 IF ERROR-COUNTER IS EQUAL TO ZERO SM1024.2 +025300 MOVE "NO " TO ERROR-TOTAL SM1024.2 +025400 ELSE SM1024.2 +025500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1024.2 +025600 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1024.2 +025700 PERFORM WRITE-LINE. SM1024.2 +025800 END-ROUTINE-13. SM1024.2 +025900 IF DELETE-COUNTER IS EQUAL TO ZERO SM1024.2 +026000 MOVE "NO " TO ERROR-TOTAL ELSE SM1024.2 +026100 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1024.2 +026200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1024.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +026400 IF INSPECT-COUNTER EQUAL TO ZERO SM1024.2 +026500 MOVE "NO " TO ERROR-TOTAL SM1024.2 +026600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1024.2 +026700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1024.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +026900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1024.2 +027000 WRITE-LINE. SM1024.2 +027100 ADD 1 TO RECORD-COUNT. SM1024.2 +027200 IF RECORD-COUNT GREATER 50 SM1024.2 +027300 MOVE DUMMY-RECORD TO DUMMY-HOLD SM1024.2 +027400 MOVE SPACE TO DUMMY-RECORD SM1024.2 +027500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1024.2 +027600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1024.2 +027700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1024.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1024.2 +027900 MOVE DUMMY-HOLD TO DUMMY-RECORD SM1024.2 +028000 MOVE ZERO TO RECORD-COUNT. SM1024.2 +028100 PERFORM WRT-LN. SM1024.2 +028200 WRT-LN. SM1024.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1024.2 +028400 MOVE SPACE TO DUMMY-RECORD. SM1024.2 +028500 BLANK-LINE-PRINT. SM1024.2 +028600 PERFORM WRT-LN. SM1024.2 +028700 FAIL-ROUTINE. SM1024.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1024.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1024.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1024.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1024.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. SM1024.2 +029400 GO TO FAIL-ROUTINE-EX. SM1024.2 +029500 FAIL-ROUTINE-WRITE. SM1024.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1024.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1024.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1024.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. SM1024.2 +030000 FAIL-ROUTINE-EX. EXIT. SM1024.2 +030100 BAIL-OUT. SM1024.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1024.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1024.2 +030400 BAIL-OUT-WRITE. SM1024.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1024.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1024.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1024.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. SM1024.2 +030900 BAIL-OUT-EX. EXIT. SM1024.2 +031000 CCVS1-EXIT. SM1024.2 +031100 EXIT. SM1024.2 +031200 INITIALIZATION SECTION. SM1024.2 +031300 SM102-INIT. SM1024.2 +031400 OPEN INPUT TEST-FILE. SM1024.2 +031500 MOVE "SM102A CHECKS A FILE WHICH" TO RE-MARK. SM1024.2 +031600 PERFORM PRINT-DETAIL. SM1024.2 +031700 MOVE "WAS GENERATED IN SM101A." TO RE-MARK. SM1024.2 +031800 PERFORM PRINT-DETAIL. SM1024.2 +031900 MOVE "COPY FILE DESCR" TO FEATURE. SM1024.2 +032000 FD-TEST SECTION. SM1024.2 +032100 COPY-TEST-8. SM1024.2 +032200 PERFORM READ-TSTFILE. SM1024.2 +032300 IF TST-FLD-1 EQUAL TO 97523 SM1024.2 +032400 PERFORM PASS GO TO COPY-WRITE-8. SM1024.2 +032500 GO TO COPY-FAIL-8. SM1024.2 +032600 COPY-DELETE-8. SM1024.2 +032700 PERFORM DE-LETE. SM1024.2 +032800 GO TO COPY-WRITE-8. SM1024.2 +032900 COPY-FAIL-8. SM1024.2 +033000 MOVE TST-FLD-1 TO COMPUTED-N. SM1024.2 +033100 MOVE 97523 TO CORRECT-N. SM1024.2 +033200 PERFORM FAIL. SM1024.2 +033300 COPY-WRITE-8. SM1024.2 +033400 MOVE "COPY-TEST-8 " TO PAR-NAME. SM1024.2 +033500 PERFORM PRINT-DETAIL. SM1024.2 +033600 COPY-TEST-9. SM1024.2 +033700 PERFORM READ-TSTFILE. SM1024.2 +033800 IF TST-FLD-1 EQUAL TO 23497 SM1024.2 +033900 PERFORM PASS GO TO COPY-WRITE-9. SM1024.2 +034000 GO TO COPY-FAIL-9. SM1024.2 +034100 COPY-DELETE-9. SM1024.2 +034200 PERFORM DE-LETE. SM1024.2 +034300 GO TO COPY-WRITE-9. SM1024.2 +034400 COPY-FAIL-9. SM1024.2 +034500 MOVE TST-FLD-1 TO COMPUTED-N. SM1024.2 +034600 MOVE 23497 TO CORRECT-N. SM1024.2 +034700 PERFORM FAIL. SM1024.2 +034800 COPY-WRITE-9. SM1024.2 +034900 MOVE "COPY-TEST-9 " TO PAR-NAME. SM1024.2 +035000 PERFORM PRINT-DETAIL. SM1024.2 +035100 COPY-TEST-10. SM1024.2 +035200 PERFORM READ-TSTFILE 3 TIMES. SM1024.2 +035300 IF TST-FLD-1 EQUAL TO 14003 SM1024.2 +035400 PERFORM PASS GO TO COPY-WRITE-10. SM1024.2 +035500 GO TO COPY-FAIL-10. SM1024.2 +035600 COPY-DELETE-10. SM1024.2 +035700 PERFORM DE-LETE. SM1024.2 +035800 GO TO COPY-WRITE-10. SM1024.2 +035900 COPY-FAIL-10. SM1024.2 +036000 MOVE TST-FLD-1 TO COMPUTED-N. SM1024.2 +036100 MOVE 14003 TO CORRECT-N. SM1024.2 +036200 PERFORM FAIL. SM1024.2 +036300 COPY-WRITE-10. SM1024.2 +036400 MOVE "COPY-TEST-10 " TO PAR-NAME. SM1024.2 +036500 PERFORM PRINT-DETAIL. SM1024.2 +036600 COPY-TEST-11. SM1024.2 +036700 PERFORM READ-TSTFILE 2 TIMES. SM1024.2 +036800 IF TST-FLD-1 EQUAL TO 03543 SM1024.2 +036900 PERFORM PASS GO TO COPY-WRITE-11. SM1024.2 +037000 GO TO COPY-FAIL-11. SM1024.2 +037100 COPY-DELETE-11. SM1024.2 +037200 PERFORM DE-LETE. SM1024.2 +037300 GO TO COPY-WRITE-11. SM1024.2 +037400 COPY-FAIL-11. SM1024.2 +037500 MOVE TST-FLD-1 TO COMPUTED-N. SM1024.2 +037600 MOVE 03543 TO CORRECT-N. SM1024.2 +037700 PERFORM FAIL. SM1024.2 +037800 COPY-WRITE-11. SM1024.2 +037900 MOVE "COPY-TEST-11 " TO PAR-NAME. SM1024.2 +038000 PERFORM PRINT-DETAIL. SM1024.2 +038100 CLOSE TEST-FILE. SM1024.2 +038200 GO TO CCVS-EXIT. SM1024.2 +038300 READ-TSTFILE. SM1024.2 +038400 READ TEST-FILE AT END GO TO BAD-FILE. SM1024.2 +038500 BAD-FILE. SM1024.2 +038600 PERFORM FAIL. SM1024.2 +038700 MOVE "BAD-FILE" TO PAR-NAME. SM1024.2 +038800 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM1024.2 +038900 PERFORM PRINT-DETAIL. SM1024.2 +039000 CLOSE TEST-FILE. SM1024.2 +039100 CCVS-EXIT SECTION. SM1024.2 +039200 CCVS-999999. SM1024.2 +039300 GO TO CLOSE-FILES. SM1024.2 diff --git a/tests/cobol85/SM/SM103A.CBL b/tests/cobol85/SM/SM103A.CBL new file mode 100755 index 00000000..9868ff47 --- /dev/null +++ b/tests/cobol85/SM/SM103A.CBL @@ -0,0 +1,555 @@ +000100 IDENTIFICATION DIVISION. SM1034.2 +000200 PROGRAM-ID. SM1034.2 +000300 SM103A. SM1034.2 +000400**************************************************************** SM1034.2 +000500* * SM1034.2 +000600* VALIDATION FOR:- * SM1034.2 +000700* * SM1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1034.2 +000900* * SM1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1034.2 +001100* * SM1034.2 +001200**************************************************************** SM1034.2 +001300* * SM1034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1034.2 +001500* * SM1034.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1034.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1034.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1034.2 +001900* * SM1034.2 +002000**************************************************************** SM1034.2 +002100* * SM1034.2 +002200* PROGRAM SM103A TESTS THE USE OF THE "COPY" STATEMENT IN * SM1034.2 +002300* THE IDENTIFICATION DIVISION AND ENVIRONMENT DIVISION * SM1034.2 +002400* (SOURCE-COMPUTER, OBJECT-COMPUTER, SPECIAL-NAMES, * SM1034.2 +002500* FILE-CONTROL AND I-O-CONTROL ENTRIES). * SM1034.2 +002600* A SEQUENTIAL FILE IS PRODUCED WHICH IS READ AND CHECKED * SM1034.2 +002700* BY SM104A. * SM1034.2 +002800* THE MAXIMUM AND MINIMUM LENGTHS OF A LIBRARY TEXT WORD * SM1034.2 +002900* ARE ALSO TESTED. * SM1034.2 +003000* * SM1034.2 +003100**************************************************************** SM1034.2 +003200 SECURITY. SM1034.2 +003300 COPY K3SNA. SM1034.2 +003400 ENVIRONMENT DIVISION. SM1034.2 +003500 CONFIGURATION SECTION. SM1034.2 +003600 SM1034.2 +003700 SM1034.2 +003800 SM1034.2 +003900 SM1034.2 +004000 SM1034.2 +004100* SM1034.2 +004200*********************** COPY STATEMENT USED **********************SM1034.2 +004300* SM1034.2 +004400*SOURCE-COMPUTER. COPY K3SCA SM1034.2 +004500* SM1034.2 +004600******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +004700 SOURCE-COMPUTER. COPY K3SCA.SM1034.2 +004800*********************** END OF COPIED TEXT ***********************SM1034.2 +004900 SM1034.2 +005000 SM1034.2 +005100 SM1034.2 +005200 SM1034.2 +005300 SM1034.2 +005400* SM1034.2 +005500*********************** COPY STATEMENT USED **********************SM1034.2 +005600* SM1034.2 +005700*OBJECT-COMPUTER. COPY K3OCA SM1034.2 +005800* SM1034.2 +005900******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +006000 OBJECT-COMPUTER. COPY K3OCA.SM1034.2 +006100*********************** END OF COPIED TEXT ***********************SM1034.2 +006200 SM1034.2 +006300 SM1034.2 +006400 SM1034.2 +006500 SM1034.2 +006600 SM1034.2 +006700* SM1034.2 +006800*********************** COPY STATEMENT USED **********************SM1034.2 +006900* SM1034.2 +007000*SPECIAL-NAMES. COPY K3SNA. SM1034.2 +007100* SM1034.2 +007200******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +007300 SPECIAL-NAMES. COPY K3SNA.SM1034.2 +007400*********************** END OF COPIED TEXT ***********************SM1034.2 +007500 INPUT-OUTPUT SECTION. SM1034.2 +007600 SM1034.2 +007700 SM1034.2 +007800 SM1034.2 +007900 SM1034.2 +008000 SM1034.2 +008100* SM1034.2 +008200*********************** COPY STATEMENT USED **********************SM1034.2 +008300* SM1034.2 +008400*FILE-CONTROL. COPY K3FCA. SM1034.2 +008500* SM1034.2 +008600******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +008700 FILE-CONTROL. COPY K3FCA.SM1034.2 +008800*********************** END OF COPIED TEXT ***********************SM1034.2 +008900 SM1034.2 +009000 SM1034.2 +009100 SM1034.2 +009200 SM1034.2 +009300 SM1034.2 +009400* SM1034.2 +009500*********************** COPY STATEMENT USED **********************SM1034.2 +009600* SM1034.2 +009700*I-O-CONTROL COPY K3IOA SM1034.2 +009800* SM1034.2 +009900******************** COPIED TEXT BEGINS BELOW ********************SM1034.2 +010000 I-O-CONTROL. COPY K3IOA.SM1034.2 +010100*********************** END OF COPIED TEXT ***********************SM1034.2 +010200 DATA DIVISION. SM1034.2 +010300 FILE SECTION. SM1034.2 +010400 FD PRINT-FILE. SM1034.2 +010500 01 PRINT-REC PICTURE X(120). SM1034.2 +010600 01 DUMMY-RECORD PICTURE X(120). SM1034.2 +010700 FD TEST-FILE SM1034.2 +010800 LABEL RECORD STANDARD SM1034.2 +010900*C VALUE OF SM1034.2 +011000*C OCLABELID SM1034.2 +011100*C IS SM1034.2 +011200*C "OCDUMMY" SM1034.2 +011300*G SYSIN SM1034.2 +011400 DATA RECORD TEST-REC. SM1034.2 +011500 01 TEST-REC. SM1034.2 +011600 02 TST-FLD-1 PICTURE 9(5). SM1034.2 +011700 02 TST-FLD-2 PICTURE X(13). SM1034.2 +011800 02 FILLER PICTURE X(102). SM1034.2 +011900 FD TEST-FILE2 SM1034.2 +012000 LABEL RECORD STANDARD SM1034.2 +012100*C VALUE OF SM1034.2 +012200*C OCLABELID SM1034.2 +012300*C IS SM1034.2 +012400*C "OCDUMMY" SM1034.2 +012500*G SYSIN SM1034.2 +012600 DATA RECORD TEST-REC2. SM1034.2 +012700 01 TEST-REC2. SM1034.2 +012800 02 TST-FLD-3 PICTURE 9(5). SM1034.2 +012900 02 TST-FLD-4 PICTURE X(13). SM1034.2 +013000 02 FILLER PICTURE X(102). SM1034.2 +013100 WORKING-STORAGE SECTION. SM1034.2 +013200 77 RCD-1 PICTURE 9(5) VALUE 97532. SM1034.2 +013300 77 RCD-2 PICTURE 9(5) VALUE 23479. SM1034.2 +013400 77 RCD-3 PICTURE 9(5) VALUE 10901. SM1034.2 +013500 77 RCD-4 PICTURE 9(5) VALUE 02734. SM1034.2 +013600 77 RCD-5 PICTURE 9(5) VALUE 14003. SM1034.2 +013700 77 RCD-6 PICTURE 9(5) VALUE 19922. SM1034.2 +013800 77 RCD-7 PICTURE 9(5) VALUE 03543. SM1034.2 +013900 01 S-N-1 PICTURE 9(8)V99 VALUE IS 12345678,91. SM1034.2 +014000 01 S-N-2 PICTURE ZZ.ZZZ.ZZZ,99. SM1034.2 +014100 01 WRK-DU-9 PIC 9 VALUE ZERO. SM1034.2 +014200 01 WRK-DU-99 PIC 99 VALUE ZERO. SM1034.2 +014300 01 WRK-DU-99-LONGER PIC 99 VALUE ZERO. SM1034.2 +014400 01 WRK-DU-00001 PIC 9. SM1034.2 +014500 01 WRK-XN-00322 PIC X(322). SM1034.2 +014600 01 FILLER REDEFINES WRK-XN-00322. SM1034.2 +014700 03 WRK-XN-00322-1 PIC X. SM1034.2 +014800 03 WRK-XN-00322-2-322. SM1034.2 +014900 05 WRK-XN-00322-2-3 PIC X. SM1034.2 +015000 05 WRK-XN-00322-20 PIC X(20) SM1034.2 +015100 OCCURS 16 SM1034.2 +015200 INDEXED BY X1. SM1034.2 +015300 01 TEST-RESULTS. SM1034.2 +015400 02 FILLER PIC X VALUE SPACE. SM1034.2 +015500 02 FEATURE PIC X(20) VALUE SPACE. SM1034.2 +015600 02 FILLER PIC X VALUE SPACE. SM1034.2 +015700 02 P-OR-F PIC X(5) VALUE SPACE. SM1034.2 +015800 02 FILLER PIC X VALUE SPACE. SM1034.2 +015900 02 PAR-NAME. SM1034.2 +016000 03 FILLER PIC X(19) VALUE SPACE. SM1034.2 +016100 03 PARDOT-X PIC X VALUE SPACE. SM1034.2 +016200 03 DOTVALUE PIC 99 VALUE ZERO. SM1034.2 +016300 02 FILLER PIC X(8) VALUE SPACE. SM1034.2 +016400 02 RE-MARK PIC X(61). SM1034.2 +016500 01 TEST-COMPUTED. SM1034.2 +016600 02 FILLER PIC X(30) VALUE SPACE. SM1034.2 +016700 02 FILLER PIC X(17) VALUE SM1034.2 +016800 " COMPUTED=". SM1034.2 +016900 02 COMPUTED-X. SM1034.2 +017000 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1034.2 +017100 03 COMPUTED-N REDEFINES COMPUTED-A SM1034.2 +017200 PIC -9(9).9(9). SM1034.2 +017300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1034.2 +017400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1034.2 +017500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1034.2 +017600 03 CM-18V0 REDEFINES COMPUTED-A. SM1034.2 +017700 04 COMPUTED-18V0 PIC -9(18). SM1034.2 +017800 04 FILLER PIC X. SM1034.2 +017900 03 FILLER PIC X(50) VALUE SPACE. SM1034.2 +018000 01 TEST-CORRECT. SM1034.2 +018100 02 FILLER PIC X(30) VALUE SPACE. SM1034.2 +018200 02 FILLER PIC X(17) VALUE " CORRECT =". SM1034.2 +018300 02 CORRECT-X. SM1034.2 +018400 03 CORRECT-A PIC X(20) VALUE SPACE. SM1034.2 +018500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1034.2 +018600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1034.2 +018700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1034.2 +018800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1034.2 +018900 03 CR-18V0 REDEFINES CORRECT-A. SM1034.2 +019000 04 CORRECT-18V0 PIC -9(18). SM1034.2 +019100 04 FILLER PIC X. SM1034.2 +019200 03 FILLER PIC X(2) VALUE SPACE. SM1034.2 +019300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1034.2 +019400 01 CCVS-C-1. SM1034.2 +019500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1034.2 +019600- "SS PARAGRAPH-NAME SM1034.2 +019700- " REMARKS". SM1034.2 +019800 02 FILLER PIC X(20) VALUE SPACE. SM1034.2 +019900 01 CCVS-C-2. SM1034.2 +020000 02 FILLER PIC X VALUE SPACE. SM1034.2 +020100 02 FILLER PIC X(6) VALUE "TESTED". SM1034.2 +020200 02 FILLER PIC X(15) VALUE SPACE. SM1034.2 +020300 02 FILLER PIC X(4) VALUE "FAIL". SM1034.2 +020400 02 FILLER PIC X(94) VALUE SPACE. SM1034.2 +020500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1034.2 +020600 01 REC-CT PIC 99 VALUE ZERO. SM1034.2 +020700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1034.2 +020800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1034.2 +020900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1034.2 +021000 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1034.2 +021100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1034.2 +021200 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1034.2 +021300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1034.2 +021400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1034.2 +021500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1034.2 +021600 01 CCVS-H-1. SM1034.2 +021700 02 FILLER PIC X(39) VALUE SPACES. SM1034.2 +021800 02 FILLER PIC X(42) VALUE SM1034.2 +021900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1034.2 +022000 02 FILLER PIC X(39) VALUE SPACES. SM1034.2 +022100 01 CCVS-H-2A. SM1034.2 +022200 02 FILLER PIC X(40) VALUE SPACE. SM1034.2 +022300 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1034.2 +022400 02 FILLER PIC XXXX VALUE SM1034.2 +022500 "4.2 ". SM1034.2 +022600 02 FILLER PIC X(28) VALUE SM1034.2 +022700 " COPY - NOT FOR DISTRIBUTION". SM1034.2 +022800 02 FILLER PIC X(41) VALUE SPACE. SM1034.2 +022900 SM1034.2 +023000 01 CCVS-H-2B. SM1034.2 +023100 02 FILLER PIC X(15) VALUE SM1034.2 +023200 "TEST RESULT OF ". SM1034.2 +023300 02 TEST-ID PIC X(9). SM1034.2 +023400 02 FILLER PIC X(4) VALUE SM1034.2 +023500 " IN ". SM1034.2 +023600 02 FILLER PIC X(12) VALUE SM1034.2 +023700 " HIGH ". SM1034.2 +023800 02 FILLER PIC X(22) VALUE SM1034.2 +023900 " LEVEL VALIDATION FOR ". SM1034.2 +024000 02 FILLER PIC X(58) VALUE SM1034.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1034.2 +024200 01 CCVS-H-3. SM1034.2 +024300 02 FILLER PIC X(34) VALUE SM1034.2 +024400 " FOR OFFICIAL USE ONLY ". SM1034.2 +024500 02 FILLER PIC X(58) VALUE SM1034.2 +024600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1034.2 +024700 02 FILLER PIC X(28) VALUE SM1034.2 +024800 " COPYRIGHT 1985 ". SM1034.2 +024900 01 CCVS-E-1. SM1034.2 +025000 02 FILLER PIC X(52) VALUE SPACE. SM1034.2 +025100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1034.2 +025200 02 ID-AGAIN PIC X(9). SM1034.2 +025300 02 FILLER PIC X(45) VALUE SPACES. SM1034.2 +025400 01 CCVS-E-2. SM1034.2 +025500 02 FILLER PIC X(31) VALUE SPACE. SM1034.2 +025600 02 FILLER PIC X(21) VALUE SPACE. SM1034.2 +025700 02 CCVS-E-2-2. SM1034.2 +025800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1034.2 +025900 03 FILLER PIC X VALUE SPACE. SM1034.2 +026000 03 ENDER-DESC PIC X(44) VALUE SM1034.2 +026100 "ERRORS ENCOUNTERED". SM1034.2 +026200 01 CCVS-E-3. SM1034.2 +026300 02 FILLER PIC X(22) VALUE SM1034.2 +026400 " FOR OFFICIAL USE ONLY". SM1034.2 +026500 02 FILLER PIC X(12) VALUE SPACE. SM1034.2 +026600 02 FILLER PIC X(58) VALUE SM1034.2 +026700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1034.2 +026800 02 FILLER PIC X(13) VALUE SPACE. SM1034.2 +026900 02 FILLER PIC X(15) VALUE SM1034.2 +027000 " COPYRIGHT 1985". SM1034.2 +027100 01 CCVS-E-4. SM1034.2 +027200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1034.2 +027300 02 FILLER PIC X(4) VALUE " OF ". SM1034.2 +027400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1034.2 +027500 02 FILLER PIC X(40) VALUE SM1034.2 +027600 " TESTS WERE EXECUTED SUCCESSFULLY". SM1034.2 +027700 01 XXINFO. SM1034.2 +027800 02 FILLER PIC X(19) VALUE SM1034.2 +027900 "*** INFORMATION ***". SM1034.2 +028000 02 INFO-TEXT. SM1034.2 +028100 04 FILLER PIC X(8) VALUE SPACE. SM1034.2 +028200 04 XXCOMPUTED PIC X(20). SM1034.2 +028300 04 FILLER PIC X(5) VALUE SPACE. SM1034.2 +028400 04 XXCORRECT PIC X(20). SM1034.2 +028500 02 INF-ANSI-REFERENCE PIC X(48). SM1034.2 +028600 01 HYPHEN-LINE. SM1034.2 +028700 02 FILLER PIC IS X VALUE IS SPACE. SM1034.2 +028800 02 FILLER PIC IS X(65) VALUE IS "************************SM1034.2 +028900- "*****************************************". SM1034.2 +029000 02 FILLER PIC IS X(54) VALUE IS "************************SM1034.2 +029100- "******************************". SM1034.2 +029200 01 CCVS-PGM-ID PIC X(9) VALUE SM1034.2 +029300 "SM103A". SM1034.2 +029400 PROCEDURE DIVISION. SM1034.2 +029500 CCVS1 SECTION. SM1034.2 +029600 OPEN-FILES. SM1034.2 +029700 OPEN OUTPUT PRINT-FILE. SM1034.2 +029800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1034.2 +029900 MOVE SPACE TO TEST-RESULTS. SM1034.2 +030000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1034.2 +030100 GO TO CCVS1-EXIT. SM1034.2 +030200 CLOSE-FILES. SM1034.2 +030300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1034.2 +030400 TERMINATE-CCVS. SM1034.2 +030500*S EXIT PROGRAM. SM1034.2 +030600*SERMINATE-CALL. SM1034.2 +030700 STOP RUN. SM1034.2 +030800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1034.2 +030900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1034.2 +031000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1034.2 +031100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1034.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. SM1034.2 +031300 PRINT-DETAIL. SM1034.2 +031400 IF REC-CT NOT EQUAL TO ZERO SM1034.2 +031500 MOVE "." TO PARDOT-X SM1034.2 +031600 MOVE REC-CT TO DOTVALUE. SM1034.2 +031700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1034.2 +031800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1034.2 +031900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1034.2 +032000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1034.2 +032100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1034.2 +032200 MOVE SPACE TO CORRECT-X. SM1034.2 +032300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1034.2 +032400 MOVE SPACE TO RE-MARK. SM1034.2 +032500 HEAD-ROUTINE. SM1034.2 +032600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +032700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +032800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1034.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1034.2 +033000 COLUMN-NAMES-ROUTINE. SM1034.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +033400 END-ROUTINE. SM1034.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1034.2 +033600 END-RTN-EXIT. SM1034.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +033800 END-ROUTINE-1. SM1034.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1034.2 +034000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1034.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. SM1034.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1034.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1034.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1034.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1034.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1034.2 +034700 END-ROUTINE-12. SM1034.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1034.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO SM1034.2 +035000 MOVE "NO " TO ERROR-TOTAL SM1034.2 +035100 ELSE SM1034.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1034.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1034.2 +035400 PERFORM WRITE-LINE. SM1034.2 +035500 END-ROUTINE-13. SM1034.2 +035600 IF DELETE-COUNTER IS EQUAL TO ZERO SM1034.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE SM1034.2 +035800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1034.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1034.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO SM1034.2 +036200 MOVE "NO " TO ERROR-TOTAL SM1034.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1034.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1034.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1034.2 +036700 WRITE-LINE. SM1034.2 +036800 ADD 1 TO RECORD-COUNT. SM1034.2 +036900 IF RECORD-COUNT GREATER 50 SM1034.2 +037000 MOVE DUMMY-RECORD TO DUMMY-HOLD SM1034.2 +037100 MOVE SPACE TO DUMMY-RECORD SM1034.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1034.2 +037300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1034.2 +037400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1034.2 +037500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1034.2 +037600 MOVE DUMMY-HOLD TO DUMMY-RECORD SM1034.2 +037700 MOVE ZERO TO RECORD-COUNT. SM1034.2 +037800 PERFORM WRT-LN. SM1034.2 +037900 WRT-LN. SM1034.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1034.2 +038100 MOVE SPACE TO DUMMY-RECORD. SM1034.2 +038200 BLANK-LINE-PRINT. SM1034.2 +038300 PERFORM WRT-LN. SM1034.2 +038400 FAIL-ROUTINE. SM1034.2 +038500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1034.2 +038600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1034.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1034.2 +038800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1034.2 +038900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +039000 MOVE SPACES TO INF-ANSI-REFERENCE. SM1034.2 +039100 GO TO FAIL-ROUTINE-EX. SM1034.2 +039200 FAIL-ROUTINE-WRITE. SM1034.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1034.2 +039400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1034.2 +039500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1034.2 +039600 MOVE SPACES TO COR-ANSI-REFERENCE. SM1034.2 +039700 FAIL-ROUTINE-EX. EXIT. SM1034.2 +039800 BAIL-OUT. SM1034.2 +039900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1034.2 +040000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1034.2 +040100 BAIL-OUT-WRITE. SM1034.2 +040200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1034.2 +040300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1034.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1034.2 +040500 MOVE SPACES TO INF-ANSI-REFERENCE. SM1034.2 +040600 BAIL-OUT-EX. EXIT. SM1034.2 +040700 CCVS1-EXIT. SM1034.2 +040800 EXIT. SM1034.2 +040900 INITIALIZATION SECTION. SM1034.2 +041000 SM103A-INIT. SM1034.2 +041100 MOVE "ALL TESTS IN SM103A PRODUCE" TO RE-MARK. SM1034.2 +041200 PERFORM PRINT-DETAIL. SM1034.2 +041300 MOVE "OUTPUT CHECKED IN SM104A." TO RE-MARK. SM1034.2 +041400 PERFORM PRINT-DETAIL. SM1034.2 +041500 MOVE "COPY ---" TO FEATURE. SM1034.2 +041600 PERFORM PRINT-DETAIL. SM1034.2 +041700 SPECIAL-NAMES-TEST SECTION. SM1034.2 +041800 COPY-TEST-1. SM1034.2 +041900 MOVE S-N-1 TO S-N-2. SM1034.2 +042000* NOTE THIS ROUTINE USES A COPIED DECIMAL-POINT IS COMMA SM1034.2 +042100* CLAUSE IN SPECIAL-NAMES --- THE EDITING IN S-N-2 SM1034.2 +042200* WOULD NOT BE VALID WITHOUT THIS CLAUSE. SM1034.2 +042300 PERFORM PASS. SM1034.2 +042400 GO TO COPY-WRITE-1. SM1034.2 +042500 COPY-DELETE-1. SM1034.2 +042600 PERFORM DE-LETE. SM1034.2 +042700 COPY-WRITE-1. SM1034.2 +042800 MOVE " DEC POINT IS COMMA" TO FEATURE. SM1034.2 +042900 MOVE "COPY-TEST-1 " TO PAR-NAME. SM1034.2 +043000 PERFORM PRINT-DETAIL. SM1034.2 +043100 BUILD SECTION. SM1034.2 +043200 COPY-TEST-2. SM1034.2 +043300 OPEN OUTPUT TEST-FILE. SM1034.2 +043400 MOVE S-N-2 TO TST-FLD-2. SM1034.2 +043500 MOVE RCD-1 TO TST-FLD-1. SM1034.2 +043600 WRITE TEST-REC. SM1034.2 +043700 MOVE RCD-2 TO TST-FLD-1. SM1034.2 +043800 WRITE TEST-REC. SM1034.2 +043900 MOVE RCD-3 TO TST-FLD-1. SM1034.2 +044000 WRITE TEST-REC. SM1034.2 +044100 MOVE RCD-4 TO TST-FLD-1. SM1034.2 +044200 WRITE TEST-REC. SM1034.2 +044300 MOVE RCD-5 TO TST-FLD-1. SM1034.2 +044400 WRITE TEST-REC. SM1034.2 +044500 MOVE RCD-6 TO TST-FLD-1. SM1034.2 +044600 WRITE TEST-REC. SM1034.2 +044700 MOVE RCD-7 TO TST-FLD-1. SM1034.2 +044800 WRITE TEST-REC. SM1034.2 +044900 CLOSE TEST-FILE. SM1034.2 +045000 OPEN OUTPUT TEST-FILE2. SM1034.2 +045100 MOVE ZERO TO TST-FLD-3. SM1034.2 +045200 MOVE "DDDDD" TO TST-FLD-4. SM1034.2 +045300 WRITE TEST-REC2. SM1034.2 +045400 CLOSE TEST-FILE2. SM1034.2 +045500 PERFORM PASS. SM1034.2 +045600 GO TO COPY-WRITE-2. SM1034.2 +045700 COPY-DELETE-2. SM1034.2 +045800 PERFORM DE-LETE. SM1034.2 +045900 COPY-WRITE-2. SM1034.2 +046000 MOVE " ENVIR DIV ENTRIES" TO FEATURE. SM1034.2 +046100 MOVE "COPY-TEST-2 " TO PAR-NAME. SM1034.2 +046200 PERFORM PRINT-DETAIL. SM1034.2 +046300* SM1034.2 +046400 COPY-TEST-3. SM1034.2 +046500* ===--> MINIMUM LENGTH TEXT WORD <--=== SM1034.2 +046600 MOVE "XII-2 2.3 SR8" TO ANSI-REFERENCE. SM1034.2 +046700 MOVE "COPY-TEST-3" TO PAR-NAME. SM1034.2 +046800 MOVE 8 TO WRK-DU-00001. SM1034.2 +046900 GO TO COPY-TEST-3-0. SM1034.2 +047000 COPY-DELETE-3. SM1034.2 +047100 PERFORM DE-LETE. SM1034.2 +047200 PERFORM PRINT-DETAIL. SM1034.2 +047300 GO TO COPY-INIT-4. SM1034.2 +047400 COPY-TEST-3-0. SM1034.2 +047500********************* COPY TEXT USED *************************** SM1034.2 +047600* 8 * SM1034.2 +047700*********************END OF COPY TEXT*************************** SM1034.2 +047800 IF WRK-DU-00001 = SM1034.2 +047900 COPY K3SML. SM1034.2 +048000 PERFORM PASS SM1034.2 +048100 PERFORM PRINT-DETAIL SM1034.2 +048200 ELSE SM1034.2 +048300 MOVE "COPYING SINGLE CHARACTER FAILED" SM1034.2 +048400 TO RE-MARK SM1034.2 +048500 MOVE 8 TO CORRECT-N SM1034.2 +048600 MOVE WRK-DU-00001 TO COMPUTED-N SM1034.2 +048700 PERFORM FAIL SM1034.2 +048800 PERFORM PRINT-DETAIL. SM1034.2 +048900* SM1034.2 +049000 COPY-INIT-4. SM1034.2 +049100* ===--> MAXIMUM LENGTH TEXT WORD <--=== SM1034.2 +049200 MOVE "XII-2 2.3 (SR8) AND XII-5 2.4(GR11)" SM1034.2 +049300 TO ANSI-REFERENCE. SM1034.2 +049400 MOVE "COPY-TEST-4" TO PAR-NAME. SM1034.2 +049500 MOVE SPACES TO WRK-XN-00322. SM1034.2 +049600 MOVE 1 TO REC-CT. SM1034.2 +049700 GO TO COPY-TEST-4-0. SM1034.2 +049800 COPY-DELETE-4. SM1034.2 +049900 PERFORM DE-LETE. SM1034.2 +050000 PERFORM PRINT-DETAIL. SM1034.2 +050100 GO TO CCVS-EXIT. SM1034.2 +050200 COPY-TEST-4-0. SM1034.2 +050300********************* COPY TEXT USED *************************** SM1034.2 +050400* MOVE 1 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADDSM1034.2 +050500* 1 TO WRK-DU-99, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-99, ADD 1SM1034.2 +050600* TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 SM1034.2 +050700* TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-99, ADD 1 TO SM1034.2 +050800* WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 10 TO SM1034.2 +050900* WRK-DU-99-LONGER. SM1034.2 +051000*********************END OF COPY TEXT*************************** SM1034.2 +051100* SM1034.2 +051200 COPY K3LGE. SM1034.2 +051300* SM1034.2 +051400 COPY-TEST-4-1. SM1034.2 +051500 MOVE "COPY-TEST-4-1" TO PAR-NAME. SM1034.2 +051600 IF WRK-DU-9 = 6 SM1034.2 +051700 PERFORM PASS SM1034.2 +051800 PERFORM PRINT-DETAIL SM1034.2 +051900 ELSE SM1034.2 +052000 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM1034.2 +052100 TO RE-MARK SM1034.2 +052200 MOVE 6 TO CORRECT-N SM1034.2 +052300 MOVE WRK-DU-9 TO COMPUTED-N SM1034.2 +052400 PERFORM FAIL SM1034.2 +052500 PERFORM PRINT-DETAIL. SM1034.2 +052600 ADD 1 TO REC-CT. SM1034.2 +052700 COPY-TEST-4-2. SM1034.2 +052800 MOVE "COPY-TEST-4-2" TO PAR-NAME. SM1034.2 +052900 IF WRK-DU-99 = 9 SM1034.2 +053000 PERFORM PASS SM1034.2 +053100 PERFORM PRINT-DETAIL SM1034.2 +053200 ELSE SM1034.2 +053300 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM1034.2 +053400 TO RE-MARK SM1034.2 +053500 MOVE 9 TO CORRECT-N SM1034.2 +053600 MOVE WRK-DU-99 TO COMPUTED-N SM1034.2 +053700 PERFORM FAIL SM1034.2 +053800 PERFORM PRINT-DETAIL. SM1034.2 +053900 ADD 1 TO REC-CT. SM1034.2 +054000 COPY-TEST-4-3. SM1034.2 +054100 MOVE "COPY-TEST-4-3" TO PAR-NAME. SM1034.2 +054200 IF WRK-DU-99-LONGER = 10 SM1034.2 +054300 PERFORM PASS SM1034.2 +054400 PERFORM PRINT-DETAIL SM1034.2 +054500 ELSE SM1034.2 +054600 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM1034.2 +054700 TO RE-MARK SM1034.2 +054800 MOVE 10 TO CORRECT-N SM1034.2 +054900 MOVE WRK-DU-99-LONGER TO COMPUTED-N SM1034.2 +055000 PERFORM FAIL SM1034.2 +055100 PERFORM PRINT-DETAIL. SM1034.2 +055200* SM1034.2 +055300 CCVS-EXIT SECTION. SM1034.2 +055400 CCVS-999999. SM1034.2 +055500 GO TO CLOSE-FILES. SM1034.2 diff --git a/tests/cobol85/SM/SM104A.SUB b/tests/cobol85/SM/SM104A.SUB new file mode 100755 index 00000000..5006af32 --- /dev/null +++ b/tests/cobol85/SM/SM104A.SUB @@ -0,0 +1,449 @@ +000100 IDENTIFICATION DIVISION. SM1044.2 +000200 PROGRAM-ID. SM1044.2 +000300 SM104A. SM1044.2 +000400**************************************************************** SM1044.2 +000500* * SM1044.2 +000600* VALIDATION FOR:- * SM1044.2 +000700* * SM1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1044.2 +000900* * SM1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1044.2 +001100* * SM1044.2 +001200**************************************************************** SM1044.2 +001300* * SM1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1044.2 +001500* * SM1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1044.2 +001900* * SM1044.2 +002000**************************************************************** SM1044.2 +002100* * SM1044.2 +002200* PROGRAM SM104A READS AND CHECKS THE FILE PRODUCED BY * SM1044.2 +002300* SM103A TO VERIFY THE PROPER EXECUTION OF THE "COPY" * SM1044.2 +002400* STATEMENTS IN THAT PROGRAM. * SM1044.2 +002500* * SM1044.2 +002600**************************************************************** SM1044.2 +002700 ENVIRONMENT DIVISION. SM1044.2 +002800 CONFIGURATION SECTION. SM1044.2 +002900 SOURCE-COMPUTER. SM1044.2 +003000 Linux. SM1044.2 +003100 OBJECT-COMPUTER. SM1044.2 +003200 Linux. SM1044.2 +003300 INPUT-OUTPUT SECTION. SM1044.2 +003400 FILE-CONTROL. SM1044.2 +003500 SELECT PRINT-FILE ASSIGN TO SM1044.2 +003600 "report.log". SM1044.2 +003700 SELECT TEST-FILE ASSIGN TO SM1044.2 +003800* THE FOLLOWING LINE WILL BE CHANGED BY TPF ONLY WHEN THE SM1044.2 +003900* PROGRAM-ID IS PART OF THE REPLACEMENT BY THE X-CARD SM1044.2 +004000* DURING EXTRACTION. SM1044.2 +004100 "XXXXX001". SM1044.2 +004200 DATA DIVISION. SM1044.2 +004300 FILE SECTION. SM1044.2 +004400 FD PRINT-FILE. SM1044.2 +004500 01 PRINT-REC PICTURE X(120). SM1044.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM1044.2 +004700 FD TEST-FILE SM1044.2 +004800 LABEL RECORD STANDARD SM1044.2 +004900*C VALUE OF SM1044.2 +005000*C OCLABELID SM1044.2 +005100*C IS SM1044.2 +005200*C "OCDUMMY" SM1044.2 +005300*G SYSIN SM1044.2 +005400 DATA RECORD TEST-REC. SM1044.2 +005500 01 TEST-REC. SM1044.2 +005600 02 TST-FLD-1 PICTURE 9(5). SM1044.2 +005700 02 TST-FLD-2 PICTURE X(13). SM1044.2 +005800 02 FILLER PICTURE X(102). SM1044.2 +005900 WORKING-STORAGE SECTION. SM1044.2 +006000 01 TEST-RESULTS. SM1044.2 +006100 02 FILLER PIC X VALUE SPACE. SM1044.2 +006200 02 FEATURE PIC X(20) VALUE SPACE. SM1044.2 +006300 02 FILLER PIC X VALUE SPACE. SM1044.2 +006400 02 P-OR-F PIC X(5) VALUE SPACE. SM1044.2 +006500 02 FILLER PIC X VALUE SPACE. SM1044.2 +006600 02 PAR-NAME. SM1044.2 +006700 03 FILLER PIC X(19) VALUE SPACE. SM1044.2 +006800 03 PARDOT-X PIC X VALUE SPACE. SM1044.2 +006900 03 DOTVALUE PIC 99 VALUE ZERO. SM1044.2 +007000 02 FILLER PIC X(8) VALUE SPACE. SM1044.2 +007100 02 RE-MARK PIC X(61). SM1044.2 +007200 01 TEST-COMPUTED. SM1044.2 +007300 02 FILLER PIC X(30) VALUE SPACE. SM1044.2 +007400 02 FILLER PIC X(17) VALUE SM1044.2 +007500 " COMPUTED=". SM1044.2 +007600 02 COMPUTED-X. SM1044.2 +007700 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1044.2 +007800 03 COMPUTED-N REDEFINES COMPUTED-A SM1044.2 +007900 PIC -9(9).9(9). SM1044.2 +008000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1044.2 +008100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1044.2 +008200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1044.2 +008300 03 CM-18V0 REDEFINES COMPUTED-A. SM1044.2 +008400 04 COMPUTED-18V0 PIC -9(18). SM1044.2 +008500 04 FILLER PIC X. SM1044.2 +008600 03 FILLER PIC X(50) VALUE SPACE. SM1044.2 +008700 01 TEST-CORRECT. SM1044.2 +008800 02 FILLER PIC X(30) VALUE SPACE. SM1044.2 +008900 02 FILLER PIC X(17) VALUE " CORRECT =". SM1044.2 +009000 02 CORRECT-X. SM1044.2 +009100 03 CORRECT-A PIC X(20) VALUE SPACE. SM1044.2 +009200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1044.2 +009300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1044.2 +009400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1044.2 +009500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1044.2 +009600 03 CR-18V0 REDEFINES CORRECT-A. SM1044.2 +009700 04 CORRECT-18V0 PIC -9(18). SM1044.2 +009800 04 FILLER PIC X. SM1044.2 +009900 03 FILLER PIC X(2) VALUE SPACE. SM1044.2 +010000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1044.2 +010100 01 CCVS-C-1. SM1044.2 +010200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1044.2 +010300- "SS PARAGRAPH-NAME SM1044.2 +010400- " REMARKS". SM1044.2 +010500 02 FILLER PIC X(20) VALUE SPACE. SM1044.2 +010600 01 CCVS-C-2. SM1044.2 +010700 02 FILLER PIC X VALUE SPACE. SM1044.2 +010800 02 FILLER PIC X(6) VALUE "TESTED". SM1044.2 +010900 02 FILLER PIC X(15) VALUE SPACE. SM1044.2 +011000 02 FILLER PIC X(4) VALUE "FAIL". SM1044.2 +011100 02 FILLER PIC X(94) VALUE SPACE. SM1044.2 +011200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1044.2 +011300 01 REC-CT PIC 99 VALUE ZERO. SM1044.2 +011400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1044.2 +011500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1044.2 +011600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1044.2 +011700 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1044.2 +011800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1044.2 +011900 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1044.2 +012000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1044.2 +012100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1044.2 +012200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1044.2 +012300 01 CCVS-H-1. SM1044.2 +012400 02 FILLER PIC X(39) VALUE SPACES. SM1044.2 +012500 02 FILLER PIC X(42) VALUE SM1044.2 +012600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1044.2 +012700 02 FILLER PIC X(39) VALUE SPACES. SM1044.2 +012800 01 CCVS-H-2A. SM1044.2 +012900 02 FILLER PIC X(40) VALUE SPACE. SM1044.2 +013000 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1044.2 +013100 02 FILLER PIC XXXX VALUE SM1044.2 +013200 "4.2 ". SM1044.2 +013300 02 FILLER PIC X(28) VALUE SM1044.2 +013400 " COPY - NOT FOR DISTRIBUTION". SM1044.2 +013500 02 FILLER PIC X(41) VALUE SPACE. SM1044.2 +013600 SM1044.2 +013700 01 CCVS-H-2B. SM1044.2 +013800 02 FILLER PIC X(15) VALUE SM1044.2 +013900 "TEST RESULT OF ". SM1044.2 +014000 02 TEST-ID PIC X(9). SM1044.2 +014100 02 FILLER PIC X(4) VALUE SM1044.2 +014200 " IN ". SM1044.2 +014300 02 FILLER PIC X(12) VALUE SM1044.2 +014400 " HIGH ". SM1044.2 +014500 02 FILLER PIC X(22) VALUE SM1044.2 +014600 " LEVEL VALIDATION FOR ". SM1044.2 +014700 02 FILLER PIC X(58) VALUE SM1044.2 +014800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1044.2 +014900 01 CCVS-H-3. SM1044.2 +015000 02 FILLER PIC X(34) VALUE SM1044.2 +015100 " FOR OFFICIAL USE ONLY ". SM1044.2 +015200 02 FILLER PIC X(58) VALUE SM1044.2 +015300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1044.2 +015400 02 FILLER PIC X(28) VALUE SM1044.2 +015500 " COPYRIGHT 1985 ". SM1044.2 +015600 01 CCVS-E-1. SM1044.2 +015700 02 FILLER PIC X(52) VALUE SPACE. SM1044.2 +015800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1044.2 +015900 02 ID-AGAIN PIC X(9). SM1044.2 +016000 02 FILLER PIC X(45) VALUE SPACES. SM1044.2 +016100 01 CCVS-E-2. SM1044.2 +016200 02 FILLER PIC X(31) VALUE SPACE. SM1044.2 +016300 02 FILLER PIC X(21) VALUE SPACE. SM1044.2 +016400 02 CCVS-E-2-2. SM1044.2 +016500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1044.2 +016600 03 FILLER PIC X VALUE SPACE. SM1044.2 +016700 03 ENDER-DESC PIC X(44) VALUE SM1044.2 +016800 "ERRORS ENCOUNTERED". SM1044.2 +016900 01 CCVS-E-3. SM1044.2 +017000 02 FILLER PIC X(22) VALUE SM1044.2 +017100 " FOR OFFICIAL USE ONLY". SM1044.2 +017200 02 FILLER PIC X(12) VALUE SPACE. SM1044.2 +017300 02 FILLER PIC X(58) VALUE SM1044.2 +017400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1044.2 +017500 02 FILLER PIC X(13) VALUE SPACE. SM1044.2 +017600 02 FILLER PIC X(15) VALUE SM1044.2 +017700 " COPYRIGHT 1985". SM1044.2 +017800 01 CCVS-E-4. SM1044.2 +017900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1044.2 +018000 02 FILLER PIC X(4) VALUE " OF ". SM1044.2 +018100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1044.2 +018200 02 FILLER PIC X(40) VALUE SM1044.2 +018300 " TESTS WERE EXECUTED SUCCESSFULLY". SM1044.2 +018400 01 XXINFO. SM1044.2 +018500 02 FILLER PIC X(19) VALUE SM1044.2 +018600 "*** INFORMATION ***". SM1044.2 +018700 02 INFO-TEXT. SM1044.2 +018800 04 FILLER PIC X(8) VALUE SPACE. SM1044.2 +018900 04 XXCOMPUTED PIC X(20). SM1044.2 +019000 04 FILLER PIC X(5) VALUE SPACE. SM1044.2 +019100 04 XXCORRECT PIC X(20). SM1044.2 +019200 02 INF-ANSI-REFERENCE PIC X(48). SM1044.2 +019300 01 HYPHEN-LINE. SM1044.2 +019400 02 FILLER PIC IS X VALUE IS SPACE. SM1044.2 +019500 02 FILLER PIC IS X(65) VALUE IS "************************SM1044.2 +019600- "*****************************************". SM1044.2 +019700 02 FILLER PIC IS X(54) VALUE IS "************************SM1044.2 +019800- "******************************". SM1044.2 +019900 01 CCVS-PGM-ID PIC X(9) VALUE SM1044.2 +020000 "SM104A". SM1044.2 +020100 PROCEDURE DIVISION. SM1044.2 +020200 CCVS1 SECTION. SM1044.2 +020300 OPEN-FILES. SM1044.2 +020400 OPEN OUTPUT PRINT-FILE. SM1044.2 +020500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1044.2 +020600 MOVE SPACE TO TEST-RESULTS. SM1044.2 +020700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1044.2 +020800 GO TO CCVS1-EXIT. SM1044.2 +020900 CLOSE-FILES. SM1044.2 +021000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1044.2 +021100 TERMINATE-CCVS. SM1044.2 +021200*S EXIT PROGRAM. SM1044.2 +021300*SERMINATE-CALL. SM1044.2 +021400 STOP RUN. SM1044.2 +021500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1044.2 +021600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1044.2 +021700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1044.2 +021800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1044.2 +021900 MOVE "****TEST DELETED****" TO RE-MARK. SM1044.2 +022000 PRINT-DETAIL. SM1044.2 +022100 IF REC-CT NOT EQUAL TO ZERO SM1044.2 +022200 MOVE "." TO PARDOT-X SM1044.2 +022300 MOVE REC-CT TO DOTVALUE. SM1044.2 +022400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1044.2 +022500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1044.2 +022600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1044.2 +022700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1044.2 +022800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1044.2 +022900 MOVE SPACE TO CORRECT-X. SM1044.2 +023000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1044.2 +023100 MOVE SPACE TO RE-MARK. SM1044.2 +023200 HEAD-ROUTINE. SM1044.2 +023300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +023400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +023500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1044.2 +023600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1044.2 +023700 COLUMN-NAMES-ROUTINE. SM1044.2 +023800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +023900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +024000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +024100 END-ROUTINE. SM1044.2 +024200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1044.2 +024300 END-RTN-EXIT. SM1044.2 +024400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +024500 END-ROUTINE-1. SM1044.2 +024600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1044.2 +024700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1044.2 +024800 ADD PASS-COUNTER TO ERROR-HOLD. SM1044.2 +024900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1044.2 +025000 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1044.2 +025100 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1044.2 +025200 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1044.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1044.2 +025400 END-ROUTINE-12. SM1044.2 +025500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1044.2 +025600 IF ERROR-COUNTER IS EQUAL TO ZERO SM1044.2 +025700 MOVE "NO " TO ERROR-TOTAL SM1044.2 +025800 ELSE SM1044.2 +025900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1044.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1044.2 +026100 PERFORM WRITE-LINE. SM1044.2 +026200 END-ROUTINE-13. SM1044.2 +026300 IF DELETE-COUNTER IS EQUAL TO ZERO SM1044.2 +026400 MOVE "NO " TO ERROR-TOTAL ELSE SM1044.2 +026500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1044.2 +026600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1044.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +026800 IF INSPECT-COUNTER EQUAL TO ZERO SM1044.2 +026900 MOVE "NO " TO ERROR-TOTAL SM1044.2 +027000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1044.2 +027100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1044.2 +027200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +027300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1044.2 +027400 WRITE-LINE. SM1044.2 +027500 ADD 1 TO RECORD-COUNT. SM1044.2 +027600 IF RECORD-COUNT GREATER 50 SM1044.2 +027700 MOVE DUMMY-RECORD TO DUMMY-HOLD SM1044.2 +027800 MOVE SPACE TO DUMMY-RECORD SM1044.2 +027900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1044.2 +028000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1044.2 +028100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1044.2 +028200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1044.2 +028300 MOVE DUMMY-HOLD TO DUMMY-RECORD SM1044.2 +028400 MOVE ZERO TO RECORD-COUNT. SM1044.2 +028500 PERFORM WRT-LN. SM1044.2 +028600 WRT-LN. SM1044.2 +028700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1044.2 +028800 MOVE SPACE TO DUMMY-RECORD. SM1044.2 +028900 BLANK-LINE-PRINT. SM1044.2 +029000 PERFORM WRT-LN. SM1044.2 +029100 FAIL-ROUTINE. SM1044.2 +029200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1044.2 +029300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1044.2 +029400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1044.2 +029500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1044.2 +029600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +029700 MOVE SPACES TO INF-ANSI-REFERENCE. SM1044.2 +029800 GO TO FAIL-ROUTINE-EX. SM1044.2 +029900 FAIL-ROUTINE-WRITE. SM1044.2 +030000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1044.2 +030100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1044.2 +030200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1044.2 +030300 MOVE SPACES TO COR-ANSI-REFERENCE. SM1044.2 +030400 FAIL-ROUTINE-EX. EXIT. SM1044.2 +030500 BAIL-OUT. SM1044.2 +030600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1044.2 +030700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1044.2 +030800 BAIL-OUT-WRITE. SM1044.2 +030900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1044.2 +031000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1044.2 +031100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1044.2 +031200 MOVE SPACES TO INF-ANSI-REFERENCE. SM1044.2 +031300 BAIL-OUT-EX. EXIT. SM1044.2 +031400 CCVS1-EXIT. SM1044.2 +031500 EXIT. SM1044.2 +031600 INITIALIZATION SECTION. SM1044.2 +031700 SM104A-INIT. SM1044.2 +031800 OPEN INPUT TEST-FILE. SM1044.2 +031900 MOVE "ALL TESTS IN SM104A CHECK" TO RE-MARK. SM1044.2 +032000 PERFORM PRINT-DETAIL. SM1044.2 +032100 MOVE "OUTPUT OF SM103A." TO RE-MARK. SM1044.2 +032200 PERFORM PRINT-DETAIL. SM1044.2 +032300 MOVE "COPY ---" TO FEATURE. SM1044.2 +032400 PERFORM PRINT-DETAIL. SM1044.2 +032500 COPY-INIT-A. SM1044.2 +032600 MOVE "COPY WITHIN NOTE" TO FEATURE. SM1044.2 +032700 COPY-TEST-1. SM1044.2 +032800 SM1044.2 +032900 SM1044.2 +033000 SM1044.2 +033100 SM1044.2 +033200 SM1044.2 +033300* SM1044.2 +033400******************* COPY WITHIN NOTE USED ************************SM1044.2 +033500* SM1044.2 +033600* NOTE COPY K4NTA. SM1044.2 +033700* SM1044.2 +033800**************** NO TEXT EXPANSION SHOULD OCCUR ******************SM1044.2 +033900* NOTE COPY K4NTA.SM1044.2 +034000 COPY-PASS-1. SM1044.2 +034100 PERFORM PASS. SM1044.2 +034200* NOTE K4NTA IS IN THE LIBRARY BUT IT SHOULD SM1044.2 +034300* NOT BE COPIED. SM1044.2 +034400 COPY-WRITE-1. SM1044.2 +034500 MOVE "COPY-TEST-1" TO PAR-NAME. SM1044.2 +034600 PERFORM PRINT-DETAIL. SM1044.2 +034700 COPY-TEST-2. SM1044.2 +034800* NOTE THE WORDS COPY WHICH ARE IN THIS NOTE SHOULD SM1044.2 +034900* NOT BE TREATED AS COPY VERBS, AND THE FOLLOWING SM1044.2 +035000* "STATEMENTS" SHOULD BE TREATED AS PART OF THIS NOTE.SM1044.2 +035100* PERFORM FAIL. SM1044.2 +035200* MOVE "SEE COPY-TEST-2" TO RE-MARK. SM1044.2 +035300* GO TO COPY-WRITE-2. SM1044.2 +035400 COPY-PASS-2. SM1044.2 +035500 PERFORM PASS. SM1044.2 +035600 COPY-WRITE-2. SM1044.2 +035700 MOVE "COPY-TEST-2" TO PAR-NAME. SM1044.2 +035800 PERFORM PRINT-DETAIL. SM1044.2 +035900 ENVIRONMENT-TEST SECTION. SM1044.2 +036000 COPY-TEST-3. SM1044.2 +036100 PERFORM READ-TEST-FILE. SM1044.2 +036200 IF TST-FLD-2 EQUAL TO "12.345.678,91" SM1044.2 +036300 PERFORM PASS GO TO COPY-WRITE-3. SM1044.2 +036400 GO TO COPY-FAIL-3. SM1044.2 +036500 COPY-DELETE-3. SM1044.2 +036600 PERFORM DE-LETE. SM1044.2 +036700 GO TO COPY-WRITE-3. SM1044.2 +036800 COPY-FAIL-3. SM1044.2 +036900 MOVE TST-FLD-2 TO COMPUTED-N. SM1044.2 +037000 MOVE "12.345.678,91" TO CORRECT-A. SM1044.2 +037100 PERFORM FAIL. SM1044.2 +037200 COPY-WRITE-3. SM1044.2 +037300 MOVE " DEC POINT IS COMMA" TO FEATURE. SM1044.2 +037400 MOVE "COPY-TEST-3 " TO PAR-NAME. SM1044.2 +037500 PERFORM PRINT-DETAIL. SM1044.2 +037600 COPY-INIT-B. SM1044.2 +037700 MOVE " ENVIR DIV ENTRIES" TO FEATURE. SM1044.2 +037800 COPY-TEST-4. SM1044.2 +037900 IF TST-FLD-1 EQUAL TO 97532 SM1044.2 +038000 PERFORM PASS GO TO COPY-WRITE-4. SM1044.2 +038100 GO TO COPY-FAIL-4. SM1044.2 +038200 COPY-DELETE-4. SM1044.2 +038300 PERFORM DE-LETE. SM1044.2 +038400 GO TO COPY-WRITE-4. SM1044.2 +038500 COPY-FAIL-4. SM1044.2 +038600 MOVE TST-FLD-1 TO COMPUTED-N. SM1044.2 +038700 MOVE 97532 TO CORRECT-N. SM1044.2 +038800 PERFORM FAIL. SM1044.2 +038900 COPY-WRITE-4. SM1044.2 +039000 MOVE "COPY-TEST-4 " TO PAR-NAME. SM1044.2 +039100 PERFORM PRINT-DETAIL. SM1044.2 +039200 COPY-TEST-5. SM1044.2 +039300 PERFORM READ-TEST-FILE. SM1044.2 +039400 IF TST-FLD-1 EQUAL TO 23479 SM1044.2 +039500 PERFORM PASS GO TO COPY-WRITE-5. SM1044.2 +039600 GO TO COPY-FAIL-5. SM1044.2 +039700 COPY-DELETE-5. SM1044.2 +039800 PERFORM DE-LETE. SM1044.2 +039900 GO TO COPY-WRITE-5. SM1044.2 +040000 COPY-FAIL-5. SM1044.2 +040100 MOVE TST-FLD-1 TO COMPUTED-N. SM1044.2 +040200 MOVE 23479 TO CORRECT-N. SM1044.2 +040300 PERFORM FAIL. SM1044.2 +040400 COPY-WRITE-5. SM1044.2 +040500 MOVE "COPY-TEST-5 " TO PAR-NAME. SM1044.2 +040600 PERFORM PRINT-DETAIL. SM1044.2 +040700 COPY-TEST-6. SM1044.2 +040800 PERFORM READ-TEST-FILE 3 TIMES. SM1044.2 +040900 IF TST-FLD-1 EQUAL TO 14003 SM1044.2 +041000 PERFORM PASS GO TO COPY-WRITE-6. SM1044.2 +041100 GO TO COPY-FAIL-6. SM1044.2 +041200 COPY-DELETE-6. SM1044.2 +041300 PERFORM DE-LETE. SM1044.2 +041400 GO TO COPY-WRITE-6. SM1044.2 +041500 COPY-FAIL-6. SM1044.2 +041600 MOVE TST-FLD-1 TO COMPUTED-N. SM1044.2 +041700 MOVE 14003 TO CORRECT-N. SM1044.2 +041800 PERFORM FAIL. SM1044.2 +041900 COPY-WRITE-6. SM1044.2 +042000 MOVE "COPY-TEST-6 " TO PAR-NAME. SM1044.2 +042100 PERFORM PRINT-DETAIL. SM1044.2 +042200 COPY-TEST-7. SM1044.2 +042300 PERFORM READ-TEST-FILE 2 TIMES. SM1044.2 +042400 IF TST-FLD-1 EQUAL TO 03543 SM1044.2 +042500 PERFORM PASS GO TO COPY-WRITE-7. SM1044.2 +042600 GO TO COPY-FAIL-7. SM1044.2 +042700 COPY-DELETE-7. SM1044.2 +042800 PERFORM DE-LETE. SM1044.2 +042900 GO TO COPY-WRITE-7. SM1044.2 +043000 COPY-FAIL-7. SM1044.2 +043100 MOVE TST-FLD-1 TO COMPUTED-N. SM1044.2 +043200 MOVE 03543 TO CORRECT-N. SM1044.2 +043300 PERFORM FAIL. SM1044.2 +043400 COPY-WRITE-7. SM1044.2 +043500 MOVE "COPY-TEST-7 " TO PAR-NAME. SM1044.2 +043600 PERFORM PRINT-DETAIL. SM1044.2 +043700 CLOSE TEST-FILE. SM1044.2 +043800 GO TO CCVS-EXIT. SM1044.2 +043900 READ-TEST-FILE. SM1044.2 +044000 READ TEST-FILE AT END GO TO BAD-FILE. SM1044.2 +044100 BAD-FILE. SM1044.2 +044200 MOVE "BAD-FILE" TO PAR-NAME. SM1044.2 +044300 PERFORM FAIL. SM1044.2 +044400 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM1044.2 +044500 PERFORM PRINT-DETAIL. SM1044.2 +044600 CLOSE TEST-FILE. SM1044.2 +044700 CCVS-EXIT SECTION. SM1044.2 +044800 CCVS-999999. SM1044.2 +044900 GO TO CLOSE-FILES. SM1044.2 diff --git a/tests/cobol85/SM/SM105A.CBL b/tests/cobol85/SM/SM105A.CBL new file mode 100755 index 00000000..9bfb0daf --- /dev/null +++ b/tests/cobol85/SM/SM105A.CBL @@ -0,0 +1,612 @@ +000100 IDENTIFICATION DIVISION. SM1054.2 +000200 PROGRAM-ID. SM1054.2 +000300 SM105A. SM1054.2 +000400**************************************************************** SM1054.2 +000500* * SM1054.2 +000600* VALIDATION FOR:- * SM1054.2 +000700* * SM1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1054.2 +000900* * SM1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1054.2 +001100* * SM1054.2 +001200**************************************************************** SM1054.2 +001300* * SM1054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1054.2 +001500* * SM1054.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1054.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1054.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1054.2 +001900* * SM1054.2 +002000**************************************************************** SM1054.2 +002100* * SM1054.2 +002200* PROGRAM NC105A TESTS THE USE OF THE "COPY" STATEMENT IN * SM1054.2 +002300* THE DATA DIVISION FOR A SORT DESCRIPTION ENTRY AND THE * SM1054.2 +002400* ASSOCIATED RECORD DESCRIPTION ENTRIES. * SM1054.2 +002500* * SM1054.2 +002600**************************************************************** SM1054.2 +002700 SM1054.2 +002800 ENVIRONMENT DIVISION. SM1054.2 +002900 CONFIGURATION SECTION. SM1054.2 +003000 SOURCE-COMPUTER. SM1054.2 +003100 Linux. SM1054.2 +003200 OBJECT-COMPUTER. SM1054.2 +003300 Linux. SM1054.2 +003400 INPUT-OUTPUT SECTION. SM1054.2 +003500 FILE-CONTROL. SM1054.2 +003600 SELECT PRINT-FILE ASSIGN TO SM1054.2 +003700 "report.log". SM1054.2 +003800 SELECT SORTFILE-1E ASSIGN TO SM1054.2 +003900 "XXXXX027". SM1054.2 +004000 SELECT SORTOUT-1E ASSIGN TO SM1054.2 +004100 "XXXXX001". SM1054.2 +004200 DATA DIVISION. SM1054.2 +004300 FILE SECTION. SM1054.2 +004400 FD PRINT-FILE. SM1054.2 +004500 01 PRINT-REC PICTURE X(120). SM1054.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM1054.2 +004700 SM1054.2 +004800 SM1054.2 +004900 SM1054.2 +005000 SM1054.2 +005100 SM1054.2 +005200* SM1054.2 +005300*********************** COPY STATEMENT USED **********************SM1054.2 +005400* SM1054.2 +005500*SD SORTFILE-1E COPY K5SDA. SM1054.2 +005600* SM1054.2 +005700******************** COPIED TEXT BEGINS BELOW ********************SM1054.2 +005800 SD SORTFILE-1E COPY K5SDA.SM1054.2 +005900*********************** END OF COPIED TEXT ***********************SM1054.2 +006000 SM1054.2 +006100 SM1054.2 +006200 SM1054.2 +006300 SM1054.2 +006400 SM1054.2 +006500 01 S-RECORD. SM1054.2 +006600* SM1054.2 +006700*********************** COPY STATEMENT USED **********************SM1054.2 +006800* SM1054.2 +006900* COPY K501A. SM1054.2 +007000* SM1054.2 +007100******************** COPIED TEXT BEGINS BELOW ********************SM1054.2 +007200 COPY K501A.SM1054.2 +007300*********************** END OF COPIED TEXT ***********************SM1054.2 +007400 FD SORTOUT-1E SM1054.2 +007500 BLOCK CONTAINS 10 RECORDS SM1054.2 +007600 LABEL RECORDS ARE STANDARD SM1054.2 +007700*C VALUE OF SM1054.2 +007800*C OCLABELID SM1054.2 +007900*C IS SM1054.2 +008000*C "OCDUMMY" SM1054.2 +008100*G SYSIN SM1054.2 +008200 DATA RECORD SORTED. SM1054.2 +008300 01 SORTED PICTURE X(120). SM1054.2 +008400 WORKING-STORAGE SECTION. SM1054.2 +008500 77 C0 PICTURE 9 VALUE 0. SM1054.2 +008600 77 C1 PICTURE 9 VALUE 1. SM1054.2 +008700 77 C2 PICTURE 9 VALUE 2. SM1054.2 +008800 77 C6 PICTURE 9 VALUE 6. SM1054.2 +008900 77 C3 PICTURE 9 VALUE 3. SM1054.2 +009000 01 WKEYS-GROUP. SM1054.2 +009100 02 WKEY-1 PICTURE 9. SM1054.2 +009200 02 WKEY-2 PICTURE 99. SM1054.2 +009300 02 WKEY-3 PICTURE 999. SM1054.2 +009400 02 WKEY-4 PICTURE 9999. SM1054.2 +009500 02 WKEY-5 PICTURE 9(5). SM1054.2 +009600 01 WKEYS-RDF REDEFINES WKEYS-GROUP PICTURE 9(15). SM1054.2 +009700 01 TEST-RESULTS. SM1054.2 +009800 02 FILLER PIC X VALUE SPACE. SM1054.2 +009900 02 FEATURE PIC X(20) VALUE SPACE. SM1054.2 +010000 02 FILLER PIC X VALUE SPACE. SM1054.2 +010100 02 P-OR-F PIC X(5) VALUE SPACE. SM1054.2 +010200 02 FILLER PIC X VALUE SPACE. SM1054.2 +010300 02 PAR-NAME. SM1054.2 +010400 03 FILLER PIC X(19) VALUE SPACE. SM1054.2 +010500 03 PARDOT-X PIC X VALUE SPACE. SM1054.2 +010600 03 DOTVALUE PIC 99 VALUE ZERO. SM1054.2 +010700 02 FILLER PIC X(8) VALUE SPACE. SM1054.2 +010800 02 RE-MARK PIC X(61). SM1054.2 +010900 01 TEST-COMPUTED. SM1054.2 +011000 02 FILLER PIC X(30) VALUE SPACE. SM1054.2 +011100 02 FILLER PIC X(17) VALUE SM1054.2 +011200 " COMPUTED=". SM1054.2 +011300 02 COMPUTED-X. SM1054.2 +011400 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1054.2 +011500 03 COMPUTED-N REDEFINES COMPUTED-A SM1054.2 +011600 PIC -9(9).9(9). SM1054.2 +011700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1054.2 +011800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1054.2 +011900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1054.2 +012000 03 CM-18V0 REDEFINES COMPUTED-A. SM1054.2 +012100 04 COMPUTED-18V0 PIC -9(18). SM1054.2 +012200 04 FILLER PIC X. SM1054.2 +012300 03 FILLER PIC X(50) VALUE SPACE. SM1054.2 +012400 01 TEST-CORRECT. SM1054.2 +012500 02 FILLER PIC X(30) VALUE SPACE. SM1054.2 +012600 02 FILLER PIC X(17) VALUE " CORRECT =". SM1054.2 +012700 02 CORRECT-X. SM1054.2 +012800 03 CORRECT-A PIC X(20) VALUE SPACE. SM1054.2 +012900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1054.2 +013000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1054.2 +013100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1054.2 +013200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1054.2 +013300 03 CR-18V0 REDEFINES CORRECT-A. SM1054.2 +013400 04 CORRECT-18V0 PIC -9(18). SM1054.2 +013500 04 FILLER PIC X. SM1054.2 +013600 03 FILLER PIC X(2) VALUE SPACE. SM1054.2 +013700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1054.2 +013800 01 CCVS-C-1. SM1054.2 +013900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1054.2 +014000- "SS PARAGRAPH-NAME SM1054.2 +014100- " REMARKS". SM1054.2 +014200 02 FILLER PIC X(20) VALUE SPACE. SM1054.2 +014300 01 CCVS-C-2. SM1054.2 +014400 02 FILLER PIC X VALUE SPACE. SM1054.2 +014500 02 FILLER PIC X(6) VALUE "TESTED". SM1054.2 +014600 02 FILLER PIC X(15) VALUE SPACE. SM1054.2 +014700 02 FILLER PIC X(4) VALUE "FAIL". SM1054.2 +014800 02 FILLER PIC X(94) VALUE SPACE. SM1054.2 +014900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1054.2 +015000 01 REC-CT PIC 99 VALUE ZERO. SM1054.2 +015100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1054.2 +015200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1054.2 +015300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1054.2 +015400 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1054.2 +015500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1054.2 +015600 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1054.2 +015700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1054.2 +015800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1054.2 +015900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1054.2 +016000 01 CCVS-H-1. SM1054.2 +016100 02 FILLER PIC X(39) VALUE SPACES. SM1054.2 +016200 02 FILLER PIC X(42) VALUE SM1054.2 +016300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1054.2 +016400 02 FILLER PIC X(39) VALUE SPACES. SM1054.2 +016500 01 CCVS-H-2A. SM1054.2 +016600 02 FILLER PIC X(41) VALUE SPACE. SM1054.2 +016700 02 FILLER PIC X(39) VALUE SM1054.2 +016800 "CCVS85 NCC COPY - NOT FOR DISTRIBUTION". SM1054.2 +016900 02 FILLER PIC X(40) VALUE SPACE. SM1054.2 +017000 SM1054.2 +017100 01 CCVS-H-2B. SM1054.2 +017200 02 FILLER PIC X(15) VALUE SM1054.2 +017300 "TEST RESULT OF ". SM1054.2 +017400 02 TEST-ID PIC X(9). SM1054.2 +017500 02 FILLER PIC X(4) VALUE SM1054.2 +017600 " IN ". SM1054.2 +017700 02 FILLER PIC X(12) VALUE SM1054.2 +017800 " HIGH ". SM1054.2 +017900 02 FILLER PIC X(22) VALUE SM1054.2 +018000 " LEVEL VALIDATION FOR ". SM1054.2 +018100 02 FILLER PIC X(58) VALUE SM1054.2 +018200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1054.2 +018300 01 CCVS-H-3. SM1054.2 +018400 02 FILLER PIC X(34) VALUE SM1054.2 +018500 " FOR OFFICIAL USE ONLY ". SM1054.2 +018600 02 FILLER PIC X(58) VALUE SM1054.2 +018700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1054.2 +018800 02 FILLER PIC X(28) VALUE SM1054.2 +018900 " COPYRIGHT 1985 ". SM1054.2 +019000 01 CCVS-E-1. SM1054.2 +019100 02 FILLER PIC X(52) VALUE SPACE. SM1054.2 +019200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1054.2 +019300 02 ID-AGAIN PIC X(9). SM1054.2 +019400 02 FILLER PIC X(45) VALUE SM1054.2 +019500 " NTIS DISTRIBUTION COBOL 85". SM1054.2 +019600 01 CCVS-E-2. SM1054.2 +019700 02 FILLER PIC X(31) VALUE SPACE. SM1054.2 +019800 02 FILLER PIC X(21) VALUE SPACE. SM1054.2 +019900 02 CCVS-E-2-2. SM1054.2 +020000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1054.2 +020100 03 FILLER PIC X VALUE SPACE. SM1054.2 +020200 03 ENDER-DESC PIC X(44) VALUE SM1054.2 +020300 "ERRORS ENCOUNTERED". SM1054.2 +020400 01 CCVS-E-3. SM1054.2 +020500 02 FILLER PIC X(22) VALUE SM1054.2 +020600 " FOR OFFICIAL USE ONLY". SM1054.2 +020700 02 FILLER PIC X(12) VALUE SPACE. SM1054.2 +020800 02 FILLER PIC X(58) VALUE SM1054.2 +020900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1054.2 +021000 02 FILLER PIC X(13) VALUE SPACE. SM1054.2 +021100 02 FILLER PIC X(15) VALUE SM1054.2 +021200 " COPYRIGHT 1985". SM1054.2 +021300 01 CCVS-E-4. SM1054.2 +021400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1054.2 +021500 02 FILLER PIC X(4) VALUE " OF ". SM1054.2 +021600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1054.2 +021700 02 FILLER PIC X(40) VALUE SM1054.2 +021800 " TESTS WERE EXECUTED SUCCESSFULLY". SM1054.2 +021900 01 XXINFO. SM1054.2 +022000 02 FILLER PIC X(19) VALUE SM1054.2 +022100 "*** INFORMATION ***". SM1054.2 +022200 02 INFO-TEXT. SM1054.2 +022300 04 FILLER PIC X(8) VALUE SPACE. SM1054.2 +022400 04 XXCOMPUTED PIC X(20). SM1054.2 +022500 04 FILLER PIC X(5) VALUE SPACE. SM1054.2 +022600 04 XXCORRECT PIC X(20). SM1054.2 +022700 02 INF-ANSI-REFERENCE PIC X(48). SM1054.2 +022800 01 HYPHEN-LINE. SM1054.2 +022900 02 FILLER PIC IS X VALUE IS SPACE. SM1054.2 +023000 02 FILLER PIC IS X(65) VALUE IS "************************SM1054.2 +023100- "*****************************************". SM1054.2 +023200 02 FILLER PIC IS X(54) VALUE IS "************************SM1054.2 +023300- "******************************". SM1054.2 +023400 01 CCVS-PGM-ID PIC X(9) VALUE SM1054.2 +023500 "SM105A". SM1054.2 +023600 PROCEDURE DIVISION. SM1054.2 +023700 CCVS1 SECTION. SM1054.2 +023800 OPEN-FILES. SM1054.2 +023900 OPEN OUTPUT PRINT-FILE. SM1054.2 +024000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1054.2 +024100 MOVE SPACE TO TEST-RESULTS. SM1054.2 +024200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1054.2 +024300 GO TO CCVS1-EXIT. SM1054.2 +024400 CLOSE-FILES. SM1054.2 +024500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1054.2 +024600 TERMINATE-CCVS. SM1054.2 +024700*S EXIT PROGRAM. SM1054.2 +024800*SERMINATE-CALL. SM1054.2 +024900 STOP RUN. SM1054.2 +025000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1054.2 +025100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1054.2 +025200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1054.2 +025300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1054.2 +025400 MOVE "****TEST DELETED****" TO RE-MARK. SM1054.2 +025500 PRINT-DETAIL. SM1054.2 +025600 IF REC-CT NOT EQUAL TO ZERO SM1054.2 +025700 MOVE "." TO PARDOT-X SM1054.2 +025800 MOVE REC-CT TO DOTVALUE. SM1054.2 +025900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1054.2 +026000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1054.2 +026100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1054.2 +026200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1054.2 +026300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1054.2 +026400 MOVE SPACE TO CORRECT-X. SM1054.2 +026500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1054.2 +026600 MOVE SPACE TO RE-MARK. SM1054.2 +026700 HEAD-ROUTINE. SM1054.2 +026800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +026900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +027000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1054.2 +027100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1054.2 +027200 COLUMN-NAMES-ROUTINE. SM1054.2 +027300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +027400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +027500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +027600 END-ROUTINE. SM1054.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1054.2 +027800 END-RTN-EXIT. SM1054.2 +027900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +028000 END-ROUTINE-1. SM1054.2 +028100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1054.2 +028200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1054.2 +028300 ADD PASS-COUNTER TO ERROR-HOLD. SM1054.2 +028400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1054.2 +028500 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1054.2 +028600 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1054.2 +028700 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1054.2 +028800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1054.2 +028900 END-ROUTINE-12. SM1054.2 +029000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1054.2 +029100 IF ERROR-COUNTER IS EQUAL TO ZERO SM1054.2 +029200 MOVE "NO " TO ERROR-TOTAL SM1054.2 +029300 ELSE SM1054.2 +029400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1054.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1054.2 +029600 PERFORM WRITE-LINE. SM1054.2 +029700 END-ROUTINE-13. SM1054.2 +029800 IF DELETE-COUNTER IS EQUAL TO ZERO SM1054.2 +029900 MOVE "NO " TO ERROR-TOTAL ELSE SM1054.2 +030000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1054.2 +030100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1054.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +030300 IF INSPECT-COUNTER EQUAL TO ZERO SM1054.2 +030400 MOVE "NO " TO ERROR-TOTAL SM1054.2 +030500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1054.2 +030600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1054.2 +030700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +030800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1054.2 +030900 WRITE-LINE. SM1054.2 +031000 ADD 1 TO RECORD-COUNT. SM1054.2 +031100 IF RECORD-COUNT GREATER 50 SM1054.2 +031200 MOVE DUMMY-RECORD TO DUMMY-HOLD SM1054.2 +031300 MOVE SPACE TO DUMMY-RECORD SM1054.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1054.2 +031500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1054.2 +031600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1054.2 +031700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1054.2 +031800 MOVE DUMMY-HOLD TO DUMMY-RECORD SM1054.2 +031900 MOVE ZERO TO RECORD-COUNT. SM1054.2 +032000 PERFORM WRT-LN. SM1054.2 +032100 WRT-LN. SM1054.2 +032200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1054.2 +032300 MOVE SPACE TO DUMMY-RECORD. SM1054.2 +032400 BLANK-LINE-PRINT. SM1054.2 +032500 PERFORM WRT-LN. SM1054.2 +032600 FAIL-ROUTINE. SM1054.2 +032700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1054.2 +032800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1054.2 +032900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1054.2 +033000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1054.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. SM1054.2 +033300 GO TO FAIL-ROUTINE-EX. SM1054.2 +033400 FAIL-ROUTINE-WRITE. SM1054.2 +033500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1054.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1054.2 +033700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1054.2 +033800 MOVE SPACES TO COR-ANSI-REFERENCE. SM1054.2 +033900 FAIL-ROUTINE-EX. EXIT. SM1054.2 +034000 BAIL-OUT. SM1054.2 +034100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1054.2 +034200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1054.2 +034300 BAIL-OUT-WRITE. SM1054.2 +034400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1054.2 +034500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1054.2 +034600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1054.2 +034700 MOVE SPACES TO INF-ANSI-REFERENCE. SM1054.2 +034800 BAIL-OUT-EX. EXIT. SM1054.2 +034900 CCVS1-EXIT. SM1054.2 +035000 EXIT. SM1054.2 +035100 SORT-INIT SECTION. SM1054.2 +035200 I-1. SM1054.2 +035300 SORT SORTFILE-1E SM1054.2 +035400 ON ASCENDING KEY KEY-1 SM1054.2 +035500 ON DESCENDING KEY KEY-2 SM1054.2 +035600 ON ASCENDING KEY KEY-3 SM1054.2 +035700 DESCENDING KEY-4 KEY-5 SM1054.2 +035800 INPUT PROCEDURE IS INSORT SM1054.2 +035900 OUTPUT PROCEDURE IS OUTP1 THRU OUTP3. SM1054.2 +036000 I-2. SM1054.2 +036100 GO TO CLOSE-FILES. SM1054.2 +036200 INSORT SECTION. SM1054.2 +036300 IN-2. SM1054.2 +036400 MOVE 900009000000000 TO RDF-KEYS. SM1054.2 +036500 RELEASE S-RECORD. SM1054.2 +036600 MOVE 009000000900009 TO RDF-KEYS. SM1054.2 +036700 RELEASE S-RECORD. SM1054.2 +036800 MOVE 900008000000000 TO RDF-KEYS. SM1054.2 +036900 RELEASE S-RECORD. SM1054.2 +037000 MOVE 009000000900008 TO RDF-KEYS. SM1054.2 +037100 RELEASE S-RECORD. SM1054.2 +037200* NOTE HI-LOW CONTROL RECORDS DONE. SM1054.2 +037300 MOVE 300003000000000 TO WKEYS-RDF. SM1054.2 +037400 IN-3. SM1054.2 +037500 PERFORM IN-4 2 TIMES. SM1054.2 +037600 GO TO IN-EXIT. SM1054.2 +037700 IN-4. SM1054.2 +037800 SUBTRACT C1 FROM WKEY-1. SM1054.2 +037900 PERFORM IN-5 6 TIMES. SM1054.2 +038000 IN-5. SM1054.2 +038100 IF WKEY-2 IS EQUAL TO C6 SM1054.2 +038200 MOVE C0 TO WKEY-2. SM1054.2 +038300 ADD C1 TO WKEY-2. SM1054.2 +038400 PERFORM IN-6 2 TIMES. SM1054.2 +038500 IN-6. SM1054.2 +038600 IF WKEY-3 IS EQUAL TO C1 SM1054.2 +038700 MOVE C3 TO WKEY-3. SM1054.2 +038800 SUBTRACT C1 FROM WKEY-3. SM1054.2 +038900 PERFORM IN-7 2 TIMES. SM1054.2 +039000 IN-7. SM1054.2 +039100 IF WKEY-4 EQUAL TO C2 SM1054.2 +039200 MOVE C0 TO WKEY-4. SM1054.2 +039300 ADD C1 TO WKEY-4. SM1054.2 +039400 PERFORM IN-8 2 TIMES. SM1054.2 +039500 IN-8. SM1054.2 +039600 IF WKEY-5 IS EQUAL TO C2 SM1054.2 +039700 MOVE C0 TO WKEY-5. SM1054.2 +039800 ADD C1 TO WKEY-5. SM1054.2 +039900 MOVE WKEYS-RDF TO RDF-KEYS. SM1054.2 +040000 RELEASE S-RECORD. SM1054.2 +040100 IN-EXIT. SM1054.2 +040200 EXIT. SM1054.2 +040300 OUTP1 SECTION. SM1054.2 +040400 SM105-INIT. SM1054.2 +040500 OPEN OUTPUT SORTOUT-1E. SM1054.2 +040600 MOVE "COPY SORT DESCR" TO FEATURE. SM1054.2 +040700 COPY-TEST-1. SM1054.2 +040800 PERFORM RET-1. SM1054.2 +040900 IF RDF-KEYS EQUAL TO 009000000900009 SM1054.2 +041000 PERFORM PASS-1 GO TO COPY-WRITE-1. SM1054.2 +041100 GO TO COPY-FAIL-1-1. SM1054.2 +041200 COPY-DELETE-1. SM1054.2 +041300 PERFORM DE-LETE-1. SM1054.2 +041400 GO TO COPY-WRITE-1. SM1054.2 +041500 COPY-FAIL-1-1. SM1054.2 +041600 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +041700 MOVE 009000000900009 TO CORRECT-18V0. SM1054.2 +041800 PERFORM FAIL-1. SM1054.2 +041900 COPY-WRITE-1. SM1054.2 +042000 MOVE "COPY-TEST-1 " TO PAR-NAME. SM1054.2 +042100 PERFORM PRINT-DETAIL-1. SM1054.2 +042200 COPY-TEST-2. SM1054.2 +042300 PERFORM RET-1. SM1054.2 +042400 IF RDF-KEYS EQUAL TO 009000000900008 SM1054.2 +042500 PERFORM PASS-1 GO TO COPY-WRITE-2. SM1054.2 +042600 GO TO COPY-FAIL-1-2. SM1054.2 +042700 COPY-DELETE-2. SM1054.2 +042800 PERFORM DE-LETE-1. SM1054.2 +042900 GO TO COPY-WRITE-2. SM1054.2 +043000 COPY-FAIL-1-2. SM1054.2 +043100 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +043200 MOVE 009000000900008 TO CORRECT-18V0. SM1054.2 +043300 PERFORM FAIL-1. SM1054.2 +043400 COPY-WRITE-2. SM1054.2 +043500 MOVE "COPY-TEST-2 " TO PAR-NAME. SM1054.2 +043600 PERFORM PRINT-DETAIL-1. SM1054.2 +043700 COPY-TEST-3. SM1054.2 +043800 PERFORM RET-1. SM1054.2 +043900 IF RDF-KEYS EQUAL TO 106001000200002 SM1054.2 +044000 PERFORM PASS-1 GO TO COPY-WRITE-3. SM1054.2 +044100 GO TO COPY-FAIL-1-3. SM1054.2 +044200 COPY-DELETE-3. SM1054.2 +044300 PERFORM DE-LETE-1. SM1054.2 +044400 GO TO COPY-WRITE-3. SM1054.2 +044500 COPY-FAIL-1-3. SM1054.2 +044600 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +044700 MOVE 106001000200002 TO CORRECT-18V0. SM1054.2 +044800 PERFORM FAIL-1. SM1054.2 +044900 COPY-WRITE-3. SM1054.2 +045000 MOVE "COPY-TEST-3 " TO PAR-NAME. SM1054.2 +045100 PERFORM PRINT-DETAIL-1. SM1054.2 +045200 OUTP2 SECTION. SM1054.2 +045300 COPY-TEST-4. SM1054.2 +045400 PERFORM RET-2 48 TIMES. SM1054.2 +045500 IF RDF-KEYS EQUAL TO 206001000200002 SM1054.2 +045600 PERFORM PASS-1 GO TO COPY-WRITE-4. SM1054.2 +045700 GO TO COPY-FAIL-1-4. SM1054.2 +045800 COPY-DELETE-4. SM1054.2 +045900 PERFORM DE-LETE-1. SM1054.2 +046000 GO TO COPY-WRITE-4. SM1054.2 +046100 COPY-FAIL-1-4. SM1054.2 +046200 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +046300 MOVE 206001000200002 TO CORRECT-18V0. SM1054.2 +046400 PERFORM FAIL-1. SM1054.2 +046500 COPY-WRITE-4. SM1054.2 +046600 MOVE "COPY-TEST-4 " TO PAR-NAME. SM1054.2 +046700 PERFORM PRINT-DETAIL-1. SM1054.2 +046800 COPY-TEST-5. SM1054.2 +046900 PERFORM RET-2 40 TIMES. SM1054.2 +047000 IF RDF-KEYS EQUAL TO 201001000200002 SM1054.2 +047100 PERFORM PASS-1 GO TO COPY-WRITE-5. SM1054.2 +047200 GO TO COPY-FAIL-1-5. SM1054.2 +047300 COPY-DELETE-5. SM1054.2 +047400 PERFORM DE-LETE-1. SM1054.2 +047500 GO TO COPY-WRITE-5. SM1054.2 +047600 COPY-FAIL-1-5. SM1054.2 +047700 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +047800 MOVE 201001000200002 TO CORRECT-18V0. SM1054.2 +047900 PERFORM FAIL-1. SM1054.2 +048000 COPY-WRITE-5. SM1054.2 +048100 MOVE "COPY-TEST-5 " TO PAR-NAME. SM1054.2 +048200 PERFORM PRINT-DETAIL-1. SM1054.2 +048300 COPY-TEST-6. SM1054.2 +048400 PERFORM RET-2 7 TIMES. SM1054.2 +048500 IF RDF-KEYS EQUAL TO 201002000100001 SM1054.2 +048600 PERFORM PASS-1 GO TO COPY-WRITE-6. SM1054.2 +048700 GO TO COPY-FAIL-1-6. SM1054.2 +048800 COPY-DELETE-6. SM1054.2 +048900 PERFORM DE-LETE-1. SM1054.2 +049000 GO TO COPY-WRITE-6. SM1054.2 +049100 COPY-FAIL-1-6. SM1054.2 +049200 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +049300 MOVE 201002000100001 TO CORRECT-18V0. SM1054.2 +049400 PERFORM FAIL-1. SM1054.2 +049500 COPY-WRITE-6. SM1054.2 +049600 MOVE "COPY-TEST-6 " TO PAR-NAME. SM1054.2 +049700 PERFORM PRINT-DETAIL-1. SM1054.2 +049800 COPY-TEST-7. SM1054.2 +049900 PERFORM RET-2. SM1054.2 +050000 IF RDF-KEYS EQUAL TO 900008000000000 SM1054.2 +050100 PERFORM PASS-1 GO TO COPY-WRITE-7. SM1054.2 +050200 GO TO COPY-FAIL-1-7. SM1054.2 +050300 COPY-DELETE-7. SM1054.2 +050400 PERFORM DE-LETE-1. SM1054.2 +050500 GO TO COPY-WRITE-7. SM1054.2 +050600 COPY-FAIL-1-7. SM1054.2 +050700 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +050800 MOVE 900008000000000 TO CORRECT-18V0. SM1054.2 +050900 PERFORM FAIL-1. SM1054.2 +051000 COPY-WRITE-7. SM1054.2 +051100 MOVE "COPY-TEST-7 " TO PAR-NAME. SM1054.2 +051200 PERFORM PRINT-DETAIL-1. SM1054.2 +051300 COPY-TEST-8. SM1054.2 +051400 PERFORM RET-2. SM1054.2 +051500 IF RDF-KEYS EQUAL TO 900009000000000 SM1054.2 +051600 PERFORM PASS-1 GO TO COPY-WRITE-8. SM1054.2 +051700 GO TO COPY-FAIL-1-8. SM1054.2 +051800 COPY-DELETE-8. SM1054.2 +051900 PERFORM DE-LETE-1. SM1054.2 +052000 GO TO COPY-WRITE-8. SM1054.2 +052100 COPY-FAIL-1-8. SM1054.2 +052200 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +052300 MOVE 900009000000000 TO CORRECT-18V0. SM1054.2 +052400 PERFORM FAIL-1. SM1054.2 +052500 COPY-WRITE-8. SM1054.2 +052600 MOVE "COPY-TEST-8 " TO PAR-NAME. SM1054.2 +052700 PERFORM PRINT-DETAIL-1. SM1054.2 +052800 COPY-TEST-9. SM1054.2 +052900 RETURN SORTFILE-1E END SM1054.2 +053000 PERFORM PASS-1 GO TO COPY-WRITE-9. SM1054.2 +053100* NOTE THE FOLLOWING STATEMENTS SHOULD NOT BE EXECUTED. SM1054.2 +053200 PERFORM FAIL-1. SM1054.2 +053300 MOVE RDF-KEYS TO COMPUTED-18V0. SM1054.2 +053400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SM1054.2 +053500 GO TO COPY-WRITE-9. SM1054.2 +053600 COPY-DELETE-9. SM1054.2 +053700 PERFORM DE-LETE-1. SM1054.2 +053800 COPY-WRITE-9. SM1054.2 +053900 MOVE "COPY-TEST-9 " TO PAR-NAME. SM1054.2 +054000 PERFORM PRINT-DETAIL-1. SM1054.2 +054100 OUTP3 SECTION. SM1054.2 +054200 RET-0. SM1054.2 +054300 CLOSE SORTOUT-1E. SM1054.2 +054400 GO TO LIB1E-EXIT. SM1054.2 +054500 RET-1. SM1054.2 +054600 RETURN SORTFILE-1E RECORD AT END GO TO BAD-FILE. SM1054.2 +054700 MOVE S-RECORD TO SORTED. SM1054.2 +054800 WRITE SORTED. SM1054.2 +054900 RET-2. SM1054.2 +055000 RETURN SORTFILE-1E END GO TO BAD-FILE. SM1054.2 +055100 MOVE S-RECORD TO SORTED. SM1054.2 +055200 WRITE SORTED. SM1054.2 +055300 BAD-FILE. SM1054.2 +055400 PERFORM FAIL-1. SM1054.2 +055500 MOVE "BAD-FILE" TO PAR-NAME. SM1054.2 +055600 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM1054.2 +055700 PERFORM PRINT-DETAIL-1. SM1054.2 +055800 CLOSE SORTOUT-1E. SM1054.2 +055900 GO TO LIB1E-EXIT. SM1054.2 +056000 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1054.2 +056100 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1054.2 +056200 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1054.2 +056300 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1054.2 +056400 MOVE "****TEST DELETED****" TO RE-MARK. SM1054.2 +056500 PRINT-DETAIL-1. SM1054.2 +056600 IF REC-CT NOT EQUAL TO ZERO SM1054.2 +056700 MOVE "." TO PARDOT-X SM1054.2 +056800 MOVE REC-CT TO DOTVALUE. SM1054.2 +056900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. SM1054.2 +057000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 SM1054.2 +057100 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 SM1054.2 +057200 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. SM1054.2 +057300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1054.2 +057400 MOVE SPACE TO CORRECT-X. SM1054.2 +057500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1054.2 +057600 MOVE SPACE TO RE-MARK. SM1054.2 +057700 WRITE-LINE-1. SM1054.2 +057800 ADD 1 TO RECORD-COUNT. SM1054.2 +057900 IF RECORD-COUNT GREATER 50 SM1054.2 +058000 MOVE DUMMY-RECORD TO DUMMY-HOLD SM1054.2 +058100 MOVE SPACE TO DUMMY-RECORD SM1054.2 +058200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1054.2 +058300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 SM1054.2 +058400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES SM1054.2 +058500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 SM1054.2 +058600 MOVE DUMMY-HOLD TO DUMMY-RECORD SM1054.2 +058700 MOVE ZERO TO RECORD-COUNT. SM1054.2 +058800 PERFORM WRT-LN-1. SM1054.2 +058900 WRT-LN-1. SM1054.2 +059000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1054.2 +059100 MOVE SPACE TO DUMMY-RECORD. SM1054.2 +059200 BLANK-LINE-PRINT-1. SM1054.2 +059300 PERFORM WRT-LN-1. SM1054.2 +059400 FAIL-ROUTINE-1. SM1054.2 +059500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SM1054.2 +059600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SM1054.2 +059700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1054.2 +059800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SM1054.2 +059900 GO TO FAIL-ROUTINE-EX-1. SM1054.2 +060000 FAIL-RTN-WRITE-1. SM1054.2 +060100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 SM1054.2 +060200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. SM1054.2 +060300 FAIL-ROUTINE-EX-1. EXIT. SM1054.2 +060400 BAIL-OUT-1. SM1054.2 +060500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. SM1054.2 +060600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. SM1054.2 +060700 BAIL-OUT-WRITE-1. SM1054.2 +060800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1054.2 +060900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SM1054.2 +061000 BAIL-OUT-EX-1. EXIT. SM1054.2 +061100 LIB1E-EXIT. SM1054.2 +061200 EXIT. SM1054.2 diff --git a/tests/cobol85/SM/SM106A.CBL b/tests/cobol85/SM/SM106A.CBL new file mode 100755 index 00000000..3f0353e5 --- /dev/null +++ b/tests/cobol85/SM/SM106A.CBL @@ -0,0 +1,29 @@ +000100 IDENTIFICATION DIVISION. SM1064.2 +000200 PROGRAM-ID. SM1064.2 +000300 SM106A. SM1064.2 +000400**************************************************************** SM1064.2 +000500* * SM1064.2 +000600* VALIDATION FOR:- * SM1064.2 +000700* * SM1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1064.2 +000900* * SM1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1064.2 +001100* * SM1064.2 +001200**************************************************************** SM1064.2 +001300* * SM1064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1064.2 +001500* * SM1064.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1064.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1064.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1064.2 +001900* * SM1064.2 +002000**************************************************************** SM1064.2 +002100 ENVIRONMENT DIVISION. SM1064.2 +002200* SM1064.2 +002300*********************** COPY STATEMENT USED **********************SM1064.2 +002400* SM1064.2 +002500*COPY K6SCA SM1064.2 +002600* SM1064.2 +002700******************** COPIED TEXT BEGINS BELOW ********************SM1064.2 +002800 COPY K6SCA. SM1064.2 +002900*********************** END OF COPIED TEXT ***********************SM1064.2 diff --git a/tests/cobol85/SM/SM107A.CBL b/tests/cobol85/SM/SM107A.CBL new file mode 100755 index 00000000..205e20fd --- /dev/null +++ b/tests/cobol85/SM/SM107A.CBL @@ -0,0 +1,312 @@ +000100 IDENTIFICATION DIVISION. SM1074.2 +000200 PROGRAM-ID. SM1074.2 +000300 SM107A. SM1074.2 +000400**************************************************************** SM1074.2 +000500* * SM1074.2 +000600* VALIDATION FOR:- * SM1074.2 +000700* * SM1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1074.2 +000900* * SM1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1074.2 +001100* * SM1074.2 +001200**************************************************************** SM1074.2 +001300* * SM1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM1074.2 +001500* * SM1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM1074.2 +001900* * SM1074.2 +002000**************************************************************** SM1074.2 +002100* * SM1074.2 +002200* PROGRAM SM107A TESTS THE CAPABILITY TO COPY 1599 RECORDS * SM1074.2 +002300* BY A SINGLE "COPY" STATEMENT IN THE PROCEDURE DIVISION. * SM1074.2 +002400* * SM1074.2 +002500**************************************************************** SM1074.2 +002600 ENVIRONMENT DIVISION. SM1074.2 +002700 CONFIGURATION SECTION. SM1074.2 +002800 SOURCE-COMPUTER. SM1074.2 +002900 Linux. SM1074.2 +003000 OBJECT-COMPUTER. SM1074.2 +003100 Linux. SM1074.2 +003200 INPUT-OUTPUT SECTION. SM1074.2 +003300 FILE-CONTROL. SM1074.2 +003400 SELECT PRINT-FILE ASSIGN TO SM1074.2 +003500 "report.log". SM1074.2 +003600 DATA DIVISION. SM1074.2 +003700 FILE SECTION. SM1074.2 +003800 FD PRINT-FILE. SM1074.2 +003900 01 PRINT-REC PICTURE X(120). SM1074.2 +004000 01 DUMMY-RECORD PICTURE X(120). SM1074.2 +004100 WORKING-STORAGE SECTION. SM1074.2 +004200 01 TEST-RESULTS. SM1074.2 +004300 02 FILLER PIC X VALUE SPACE. SM1074.2 +004400 02 FEATURE PIC X(20) VALUE SPACE. SM1074.2 +004500 02 FILLER PIC X VALUE SPACE. SM1074.2 +004600 02 P-OR-F PIC X(5) VALUE SPACE. SM1074.2 +004700 02 FILLER PIC X VALUE SPACE. SM1074.2 +004800 02 PAR-NAME. SM1074.2 +004900 03 FILLER PIC X(19) VALUE SPACE. SM1074.2 +005000 03 PARDOT-X PIC X VALUE SPACE. SM1074.2 +005100 03 DOTVALUE PIC 99 VALUE ZERO. SM1074.2 +005200 02 FILLER PIC X(8) VALUE SPACE. SM1074.2 +005300 02 RE-MARK PIC X(61). SM1074.2 +005400 01 TEST-COMPUTED. SM1074.2 +005500 02 FILLER PIC X(30) VALUE SPACE. SM1074.2 +005600 02 FILLER PIC X(17) VALUE SM1074.2 +005700 " COMPUTED=". SM1074.2 +005800 02 COMPUTED-X. SM1074.2 +005900 03 COMPUTED-A PIC X(20) VALUE SPACE. SM1074.2 +006000 03 COMPUTED-N REDEFINES COMPUTED-A SM1074.2 +006100 PIC -9(9).9(9). SM1074.2 +006200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM1074.2 +006300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM1074.2 +006400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM1074.2 +006500 03 CM-18V0 REDEFINES COMPUTED-A. SM1074.2 +006600 04 COMPUTED-18V0 PIC -9(18). SM1074.2 +006700 04 FILLER PIC X. SM1074.2 +006800 03 FILLER PIC X(50) VALUE SPACE. SM1074.2 +006900 01 TEST-CORRECT. SM1074.2 +007000 02 FILLER PIC X(30) VALUE SPACE. SM1074.2 +007100 02 FILLER PIC X(17) VALUE " CORRECT =". SM1074.2 +007200 02 CORRECT-X. SM1074.2 +007300 03 CORRECT-A PIC X(20) VALUE SPACE. SM1074.2 +007400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM1074.2 +007500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM1074.2 +007600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM1074.2 +007700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM1074.2 +007800 03 CR-18V0 REDEFINES CORRECT-A. SM1074.2 +007900 04 CORRECT-18V0 PIC -9(18). SM1074.2 +008000 04 FILLER PIC X. SM1074.2 +008100 03 FILLER PIC X(2) VALUE SPACE. SM1074.2 +008200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM1074.2 +008300 01 CCVS-C-1. SM1074.2 +008400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM1074.2 +008500- "SS PARAGRAPH-NAME SM1074.2 +008600- " REMARKS". SM1074.2 +008700 02 FILLER PIC X(20) VALUE SPACE. SM1074.2 +008800 01 CCVS-C-2. SM1074.2 +008900 02 FILLER PIC X VALUE SPACE. SM1074.2 +009000 02 FILLER PIC X(6) VALUE "TESTED". SM1074.2 +009100 02 FILLER PIC X(15) VALUE SPACE. SM1074.2 +009200 02 FILLER PIC X(4) VALUE "FAIL". SM1074.2 +009300 02 FILLER PIC X(94) VALUE SPACE. SM1074.2 +009400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM1074.2 +009500 01 REC-CT PIC 99 VALUE ZERO. SM1074.2 +009600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM1074.2 +009700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM1074.2 +009800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM1074.2 +009900 01 PASS-COUNTER PIC 999 VALUE ZERO. SM1074.2 +010000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM1074.2 +010100 01 ERROR-HOLD PIC 999 VALUE ZERO. SM1074.2 +010200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM1074.2 +010300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM1074.2 +010400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM1074.2 +010500 01 CCVS-H-1. SM1074.2 +010600 02 FILLER PIC X(39) VALUE SPACES. SM1074.2 +010700 02 FILLER PIC X(42) VALUE SM1074.2 +010800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM1074.2 +010900 02 FILLER PIC X(39) VALUE SPACES. SM1074.2 +011000 01 CCVS-H-2A. SM1074.2 +011100 02 FILLER PIC X(40) VALUE SPACE. SM1074.2 +011200 02 FILLER PIC X(7) VALUE "CCVS85 ". SM1074.2 +011300 02 FILLER PIC XXXX VALUE SM1074.2 +011400 "4.2 ". SM1074.2 +011500 02 FILLER PIC X(28) VALUE SM1074.2 +011600 " COPY - NOT FOR DISTRIBUTION". SM1074.2 +011700 02 FILLER PIC X(41) VALUE SPACE. SM1074.2 +011800 SM1074.2 +011900 01 CCVS-H-2B. SM1074.2 +012000 02 FILLER PIC X(15) VALUE SM1074.2 +012100 "TEST RESULT OF ". SM1074.2 +012200 02 TEST-ID PIC X(9). SM1074.2 +012300 02 FILLER PIC X(4) VALUE SM1074.2 +012400 " IN ". SM1074.2 +012500 02 FILLER PIC X(12) VALUE SM1074.2 +012600 " HIGH ". SM1074.2 +012700 02 FILLER PIC X(22) VALUE SM1074.2 +012800 " LEVEL VALIDATION FOR ". SM1074.2 +012900 02 FILLER PIC X(58) VALUE SM1074.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1074.2 +013100 01 CCVS-H-3. SM1074.2 +013200 02 FILLER PIC X(34) VALUE SM1074.2 +013300 " FOR OFFICIAL USE ONLY ". SM1074.2 +013400 02 FILLER PIC X(58) VALUE SM1074.2 +013500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM1074.2 +013600 02 FILLER PIC X(28) VALUE SM1074.2 +013700 " COPYRIGHT 1985 ". SM1074.2 +013800 01 CCVS-E-1. SM1074.2 +013900 02 FILLER PIC X(52) VALUE SPACE. SM1074.2 +014000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM1074.2 +014100 02 ID-AGAIN PIC X(9). SM1074.2 +014200 02 FILLER PIC X(45) VALUE SPACES. SM1074.2 +014300 01 CCVS-E-2. SM1074.2 +014400 02 FILLER PIC X(31) VALUE SPACE. SM1074.2 +014500 02 FILLER PIC X(21) VALUE SPACE. SM1074.2 +014600 02 CCVS-E-2-2. SM1074.2 +014700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM1074.2 +014800 03 FILLER PIC X VALUE SPACE. SM1074.2 +014900 03 ENDER-DESC PIC X(44) VALUE SM1074.2 +015000 "ERRORS ENCOUNTERED". SM1074.2 +015100 01 CCVS-E-3. SM1074.2 +015200 02 FILLER PIC X(22) VALUE SM1074.2 +015300 " FOR OFFICIAL USE ONLY". SM1074.2 +015400 02 FILLER PIC X(12) VALUE SPACE. SM1074.2 +015500 02 FILLER PIC X(58) VALUE SM1074.2 +015600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM1074.2 +015700 02 FILLER PIC X(13) VALUE SPACE. SM1074.2 +015800 02 FILLER PIC X(15) VALUE SM1074.2 +015900 " COPYRIGHT 1985". SM1074.2 +016000 01 CCVS-E-4. SM1074.2 +016100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM1074.2 +016200 02 FILLER PIC X(4) VALUE " OF ". SM1074.2 +016300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM1074.2 +016400 02 FILLER PIC X(40) VALUE SM1074.2 +016500 " TESTS WERE EXECUTED SUCCESSFULLY". SM1074.2 +016600 01 XXINFO. SM1074.2 +016700 02 FILLER PIC X(19) VALUE SM1074.2 +016800 "*** INFORMATION ***". SM1074.2 +016900 02 INFO-TEXT. SM1074.2 +017000 04 FILLER PIC X(8) VALUE SPACE. SM1074.2 +017100 04 XXCOMPUTED PIC X(20). SM1074.2 +017200 04 FILLER PIC X(5) VALUE SPACE. SM1074.2 +017300 04 XXCORRECT PIC X(20). SM1074.2 +017400 02 INF-ANSI-REFERENCE PIC X(48). SM1074.2 +017500 01 HYPHEN-LINE. SM1074.2 +017600 02 FILLER PIC IS X VALUE IS SPACE. SM1074.2 +017700 02 FILLER PIC IS X(65) VALUE IS "************************SM1074.2 +017800- "*****************************************". SM1074.2 +017900 02 FILLER PIC IS X(54) VALUE IS "************************SM1074.2 +018000- "******************************". SM1074.2 +018100 01 CCVS-PGM-ID PIC X(9) VALUE SM1074.2 +018200 "SM107A". SM1074.2 +018300 PROCEDURE DIVISION. SM1074.2 +018400 CCVS1 SECTION. SM1074.2 +018500 OPEN-FILES. SM1074.2 +018600 OPEN OUTPUT PRINT-FILE. SM1074.2 +018700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM1074.2 +018800 MOVE SPACE TO TEST-RESULTS. SM1074.2 +018900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM1074.2 +019000 GO TO CCVS1-EXIT. SM1074.2 +019100 CLOSE-FILES. SM1074.2 +019200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM1074.2 +019300 TERMINATE-CCVS. SM1074.2 +019400*S EXIT PROGRAM. SM1074.2 +019500*SERMINATE-CALL. SM1074.2 +019600 STOP RUN. SM1074.2 +019700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM1074.2 +019800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM1074.2 +019900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM1074.2 +020000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM1074.2 +020100 MOVE "****TEST DELETED****" TO RE-MARK. SM1074.2 +020200 PRINT-DETAIL. SM1074.2 +020300 IF REC-CT NOT EQUAL TO ZERO SM1074.2 +020400 MOVE "." TO PARDOT-X SM1074.2 +020500 MOVE REC-CT TO DOTVALUE. SM1074.2 +020600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM1074.2 +020700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM1074.2 +020800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM1074.2 +020900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM1074.2 +021000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM1074.2 +021100 MOVE SPACE TO CORRECT-X. SM1074.2 +021200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM1074.2 +021300 MOVE SPACE TO RE-MARK. SM1074.2 +021400 HEAD-ROUTINE. SM1074.2 +021500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +021600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +021700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1074.2 +021800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM1074.2 +021900 COLUMN-NAMES-ROUTINE. SM1074.2 +022000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +022100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +022200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +022300 END-ROUTINE. SM1074.2 +022400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM1074.2 +022500 END-RTN-EXIT. SM1074.2 +022600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +022700 END-ROUTINE-1. SM1074.2 +022800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM1074.2 +022900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM1074.2 +023000 ADD PASS-COUNTER TO ERROR-HOLD. SM1074.2 +023100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM1074.2 +023200 MOVE PASS-COUNTER TO CCVS-E-4-1. SM1074.2 +023300 MOVE ERROR-HOLD TO CCVS-E-4-2. SM1074.2 +023400 MOVE CCVS-E-4 TO CCVS-E-2-2. SM1074.2 +023500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM1074.2 +023600 END-ROUTINE-12. SM1074.2 +023700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM1074.2 +023800 IF ERROR-COUNTER IS EQUAL TO ZERO SM1074.2 +023900 MOVE "NO " TO ERROR-TOTAL SM1074.2 +024000 ELSE SM1074.2 +024100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM1074.2 +024200 MOVE CCVS-E-2 TO DUMMY-RECORD. SM1074.2 +024300 PERFORM WRITE-LINE. SM1074.2 +024400 END-ROUTINE-13. SM1074.2 +024500 IF DELETE-COUNTER IS EQUAL TO ZERO SM1074.2 +024600 MOVE "NO " TO ERROR-TOTAL ELSE SM1074.2 +024700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM1074.2 +024800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM1074.2 +024900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +025000 IF INSPECT-COUNTER EQUAL TO ZERO SM1074.2 +025100 MOVE "NO " TO ERROR-TOTAL SM1074.2 +025200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM1074.2 +025300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM1074.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +025500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM1074.2 +025600 WRITE-LINE. SM1074.2 +025700 ADD 1 TO RECORD-COUNT. SM1074.2 +025800 IF RECORD-COUNT GREATER 50 SM1074.2 +025900 MOVE DUMMY-RECORD TO DUMMY-HOLD SM1074.2 +026000 MOVE SPACE TO DUMMY-RECORD SM1074.2 +026100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM1074.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM1074.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM1074.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM1074.2 +026500 MOVE DUMMY-HOLD TO DUMMY-RECORD SM1074.2 +026600 MOVE ZERO TO RECORD-COUNT. SM1074.2 +026700 PERFORM WRT-LN. SM1074.2 +026800 WRT-LN. SM1074.2 +026900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM1074.2 +027000 MOVE SPACE TO DUMMY-RECORD. SM1074.2 +027100 BLANK-LINE-PRINT. SM1074.2 +027200 PERFORM WRT-LN. SM1074.2 +027300 FAIL-ROUTINE. SM1074.2 +027400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM1074.2 +027500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM1074.2 +027600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1074.2 +027700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM1074.2 +027800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +027900 MOVE SPACES TO INF-ANSI-REFERENCE. SM1074.2 +028000 GO TO FAIL-ROUTINE-EX. SM1074.2 +028100 FAIL-ROUTINE-WRITE. SM1074.2 +028200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM1074.2 +028300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM1074.2 +028400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM1074.2 +028500 MOVE SPACES TO COR-ANSI-REFERENCE. SM1074.2 +028600 FAIL-ROUTINE-EX. EXIT. SM1074.2 +028700 BAIL-OUT. SM1074.2 +028800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM1074.2 +028900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM1074.2 +029000 BAIL-OUT-WRITE. SM1074.2 +029100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM1074.2 +029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM1074.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM1074.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. SM1074.2 +029500 BAIL-OUT-EX. EXIT. SM1074.2 +029600 CCVS1-EXIT. SM1074.2 +029700 EXIT. SM1074.2 +029800 WARNING-MSG. SM1074.2 +029900 MOVE " IF NO OTHER REPORT LINES APPEAR BELOW, ""COPY K7SEA"" SM1074.2 +030000- "FAILED." TO PRINT-REC. SM1074.2 +030100 PERFORM WRITE-LINE. SM1074.2 +030200* SM1074.2 +030300*********************** COPY STATEMENT USED **********************SM1074.2 +030400* SM1074.2 +030500*COPY K7SEA SM1074.2 +030600* SM1074.2 +030700******************** COPIED TEXT BEGINS BELOW ********************SM1074.2 +030800 COPY K7SEA. SM1074.2 +030900*********************** END OF COPIED TEXT ***********************SM1074.2 +031000 CCVS-EXIT SECTION. SM1074.2 +031100 CCVS-999999. SM1074.2 +031200 GO TO CLOSE-FILES. SM1074.2 diff --git a/tests/cobol85/SM/SM201A.CBL b/tests/cobol85/SM/SM201A.CBL new file mode 100755 index 00000000..ada7f532 --- /dev/null +++ b/tests/cobol85/SM/SM201A.CBL @@ -0,0 +1,634 @@ +000100 IDENTIFICATION DIVISION. SM2014.2 +000200 PROGRAM-ID. SM2014.2 +000300 SM201A. SM2014.2 +000400**************************************************************** SM2014.2 +000500* * SM2014.2 +000600* VALIDATION FOR:- * SM2014.2 +000700* * SM2014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2014.2 +000900* * SM2014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2014.2 +001100* * SM2014.2 +001200**************************************************************** SM2014.2 +001300* * SM2014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2014.2 +001500* * SM2014.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2014.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2014.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2014.2 +001900* * SM2014.2 +002000**************************************************************** SM2014.2 +002100* * SM2014.2 +002200* PROGRAM SM201A TESTS THE "REPLACING" PHRASE OF THE "COPY" * SM2014.2 +002300* STATEMENT IN THE WORKING-STORAGE SECTION AND * SM2014.2 +002400* PROCEDURE DIVISION AND PRODUCES A SEQUENTIAL OUTPUT FILE * SM2014.2 +002500* USING "COPY"ED CODE, WHICH IS SUBSEQUENTLY CHECKED BY * SM2014.2 +002600* SM202A. * SM2014.2 +002700* * SM2014.2 +002800**************************************************************** SM2014.2 +002900 ENVIRONMENT DIVISION. SM2014.2 +003000 CONFIGURATION SECTION. SM2014.2 +003100 SOURCE-COMPUTER. SM2014.2 +003200 Linux. SM2014.2 +003300 OBJECT-COMPUTER. SM2014.2 +003400 Linux. SM2014.2 +003500 INPUT-OUTPUT SECTION. SM2014.2 +003600 FILE-CONTROL. SM2014.2 +003700 SELECT PRINT-FILE ASSIGN TO SM2014.2 +003800 "report.log". SM2014.2 +003900 SELECT TEST-FILE ASSIGN TO SM2014.2 +004000 "XXXXX001". SM2014.2 +004100 DATA DIVISION. SM2014.2 +004200 FILE SECTION. SM2014.2 +004300 FD PRINT-FILE. SM2014.2 +004400 01 PRINT-REC PICTURE X(120). SM2014.2 +004500 01 DUMMY-RECORD PICTURE X(120). SM2014.2 +004600 SM2014.2 +004700 SM2014.2 +004800 SM2014.2 +004900 SM2014.2 +005000 SM2014.2 +005100* SM2014.2 +005200*********************** COPY STATEMENT USED **********************SM2014.2 +005300* SM2014.2 +005400*FD TEST-FILE COPY K1FDA SM2014.2 +005500* REPLACING SM2014.2 +005600* PROOF-REC BY TST-TEST. SM2014.2 +005700* SM2014.2 +005800******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +005900 FD TEST-FILE COPY K1FDA SM2014.2 +006000 REPLACING SM2014.2 +006100 PROOF-REC BY TST-TEST. SM2014.2 +006200*********************** END OF COPIED TEXT ***********************SM2014.2 +006300 SM2014.2 +006400 SM2014.2 +006500 SM2014.2 +006600 SM2014.2 +006700 SM2014.2 +006800* SM2014.2 +006900*********************** COPY STATEMENT USED **********************SM2014.2 +007000* SM2014.2 +007100*01 TST-TEST COPY K101A SM2014.2 +007200* REPLACING SM2014.2 +007300* TST-FLD-1 BY TF-1. SM2014.2 +007400* SM2014.2 +007500******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +007600 01 TST-TEST COPY K101A SM2014.2 +007700 REPLACING SM2014.2 +007800 TST-FLD-1 BY TF-1. SM2014.2 +007900*********************** END OF COPIED TEXT ***********************SM2014.2 +008000 WORKING-STORAGE SECTION. SM2014.2 +008100 77 RCD-1 PICTURE 9(5) VALUE 97532. SM2014.2 +008200 77 RCD-2 PICTURE 9(5) VALUE 23479. SM2014.2 +008300 77 RCD-3 PICTURE 9(5) VALUE 10901. SM2014.2 +008400 77 RCD-4 PICTURE 9(5) VALUE 02734. SM2014.2 +008500 77 RCD-5 PICTURE 9(5) VALUE 14003. SM2014.2 +008600 77 RCD-6 PICTURE 9(5) VALUE 19922. SM2014.2 +008700 77 RCD-7 PICTURE 9(5) VALUE 03543. SM2014.2 +008800* SM2014.2 +008900*********************** COPY STATEMENT USED **********************SM2014.2 +009000* SM2014.2 +009100*01 TEXT-TEST-1 COPY K101A SM2014.2 +009200* REPLACING ==02 TST-FLD-1 PICTURE 9(5). 02 FILLER SM2014.2 +009300* PICTURE X(115)== SM2014.2 +009400* BY ==02 FILLER PICTURE X(115). 02 TXT-FLD-1 SM2014.2 +009500* PIC 9(5)==. SM2014.2 +009600* SM2014.2 +009700******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +009800 01 TEXT-TEST-1 COPY K101A SM2014.2 +009900 REPLACING ==02 TST-FLD-1 PICTURE 9(5). 02 FILLER SM2014.2 +010000 PICTURE X(115)== SM2014.2 +010100 BY ==02 FILLER PICTURE X(115). 02 TXT-FLD-1 SM2014.2 +010200 PIC 9(5)==. SM2014.2 +010300*********************** END OF COPIED TEXT ***********************SM2014.2 +010400 01 WSTR-1. SM2014.2 +010500 02 WSTR-1A PICTURE XXX VALUE "ABC". SM2014.2 +010600 SM2014.2 +010700 SM2014.2 +010800 SM2014.2 +010900 SM2014.2 +011000 SM2014.2 +011100 01 WSTR-2. SM2014.2 +011200* SM2014.2 +011300*********************** COPY STATEMENT USED **********************SM2014.2 +011400* SM2014.2 +011500* COPY K1WKA SM2014.2 +011600* REPLACING WSTR-2A BY WSTR999. SM2014.2 +011700* SM2014.2 +011800******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +011900 COPY K1WKA SM2014.2 +012000 REPLACING WSTR-2A BY WSTR999. SM2014.2 +012100*********************** END OF COPIED TEXT ***********************SM2014.2 +012200 SM2014.2 +012300 SM2014.2 +012400 SM2014.2 +012500 SM2014.2 +012600 SM2014.2 +012700 01 WSTR-3. SM2014.2 +012800* SM2014.2 +012900*********************** COPY STATEMENT USED **********************SM2014.2 +013000* SM2014.2 +013100* COPY K1WKA.SM2014.2 +013200* SM2014.2 +013300******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +013400 COPY K1WKA.SM2014.2 +013500*********************** END OF COPIED TEXT ***********************SM2014.2 +013600 SM2014.2 +013700 SM2014.2 +013800 SM2014.2 +013900 SM2014.2 +014000 SM2014.2 +014100* SM2014.2 +014200*********************** COPY STATEMENT USED **********************SM2014.2 +014300* SM2014.2 +014400*01 WSTR-4. COPY K1WKB SM2014.2 +014500* REPLACING WSTR4A BY WSTR91 SM2014.2 +014600* WSTR4B BY WSTR92 SM2014.2 +014700* WSTR4C BY WSTR93. SM2014.2 +014800* SM2014.2 +014900******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +015000 01 WSTR-4. COPY K1WKB SM2014.2 +015100 REPLACING WSTR4A BY WSTR91 SM2014.2 +015200 WSTR4B BY WSTR92 SM2014.2 +015300 WSTR4C BY WSTR93. SM2014.2 +015400*********************** END OF COPIED TEXT ***********************SM2014.2 +015500 SM2014.2 +015600 SM2014.2 +015700 SM2014.2 +015800 SM2014.2 +015900 SM2014.2 +016000* SM2014.2 +016100*********************** COPY STATEMENT USED **********************SM2014.2 +016200* SM2014.2 +016300*01 WSTR-5. COPY K1WKB.SM2014.2 +016400* SM2014.2 +016500******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +016600 01 WSTR-5. COPY K1WKB.SM2014.2 +016700*********************** END OF COPIED TEXT ***********************SM2014.2 +016800 01 TEST-RESULTS. SM2014.2 +016900 02 FILLER PIC X VALUE SPACE. SM2014.2 +017000 02 FEATURE PIC X(20) VALUE SPACE. SM2014.2 +017100 02 FILLER PIC X VALUE SPACE. SM2014.2 +017200 02 P-OR-F PIC X(5) VALUE SPACE. SM2014.2 +017300 02 FILLER PIC X VALUE SPACE. SM2014.2 +017400 02 PAR-NAME. SM2014.2 +017500 03 FILLER PIC X(19) VALUE SPACE. SM2014.2 +017600 03 PARDOT-X PIC X VALUE SPACE. SM2014.2 +017700 03 DOTVALUE PIC 99 VALUE ZERO. SM2014.2 +017800 02 FILLER PIC X(8) VALUE SPACE. SM2014.2 +017900 02 RE-MARK PIC X(61). SM2014.2 +018000 01 TEST-COMPUTED. SM2014.2 +018100 02 FILLER PIC X(30) VALUE SPACE. SM2014.2 +018200 02 FILLER PIC X(17) VALUE SM2014.2 +018300 " COMPUTED=". SM2014.2 +018400 02 COMPUTED-X. SM2014.2 +018500 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2014.2 +018600 03 COMPUTED-N REDEFINES COMPUTED-A SM2014.2 +018700 PIC -9(9).9(9). SM2014.2 +018800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2014.2 +018900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2014.2 +019000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2014.2 +019100 03 CM-18V0 REDEFINES COMPUTED-A. SM2014.2 +019200 04 COMPUTED-18V0 PIC -9(18). SM2014.2 +019300 04 FILLER PIC X. SM2014.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SM2014.2 +019500 01 TEST-CORRECT. SM2014.2 +019600 02 FILLER PIC X(30) VALUE SPACE. SM2014.2 +019700 02 FILLER PIC X(17) VALUE " CORRECT =". SM2014.2 +019800 02 CORRECT-X. SM2014.2 +019900 03 CORRECT-A PIC X(20) VALUE SPACE. SM2014.2 +020000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2014.2 +020100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2014.2 +020200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2014.2 +020300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2014.2 +020400 03 CR-18V0 REDEFINES CORRECT-A. SM2014.2 +020500 04 CORRECT-18V0 PIC -9(18). SM2014.2 +020600 04 FILLER PIC X. SM2014.2 +020700 03 FILLER PIC X(2) VALUE SPACE. SM2014.2 +020800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2014.2 +020900 01 CCVS-C-1. SM2014.2 +021000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2014.2 +021100- "SS PARAGRAPH-NAME SM2014.2 +021200- " REMARKS". SM2014.2 +021300 02 FILLER PIC X(20) VALUE SPACE. SM2014.2 +021400 01 CCVS-C-2. SM2014.2 +021500 02 FILLER PIC X VALUE SPACE. SM2014.2 +021600 02 FILLER PIC X(6) VALUE "TESTED". SM2014.2 +021700 02 FILLER PIC X(15) VALUE SPACE. SM2014.2 +021800 02 FILLER PIC X(4) VALUE "FAIL". SM2014.2 +021900 02 FILLER PIC X(94) VALUE SPACE. SM2014.2 +022000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2014.2 +022100 01 REC-CT PIC 99 VALUE ZERO. SM2014.2 +022200 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2014.2 +022300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2014.2 +022400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2014.2 +022500 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2014.2 +022600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2014.2 +022700 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2014.2 +022800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2014.2 +022900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2014.2 +023000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2014.2 +023100 01 CCVS-H-1. SM2014.2 +023200 02 FILLER PIC X(39) VALUE SPACES. SM2014.2 +023300 02 FILLER PIC X(42) VALUE SM2014.2 +023400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2014.2 +023500 02 FILLER PIC X(39) VALUE SPACES. SM2014.2 +023600 01 CCVS-H-2A. SM2014.2 +023700 02 FILLER PIC X(40) VALUE SPACE. SM2014.2 +023800 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2014.2 +023900 02 FILLER PIC XXXX VALUE SM2014.2 +024000 "4.2 ". SM2014.2 +024100 02 FILLER PIC X(28) VALUE SM2014.2 +024200 " COPY - NOT FOR DISTRIBUTION". SM2014.2 +024300 02 FILLER PIC X(41) VALUE SPACE. SM2014.2 +024400 SM2014.2 +024500 01 CCVS-H-2B. SM2014.2 +024600 02 FILLER PIC X(15) VALUE SM2014.2 +024700 "TEST RESULT OF ". SM2014.2 +024800 02 TEST-ID PIC X(9). SM2014.2 +024900 02 FILLER PIC X(4) VALUE SM2014.2 +025000 " IN ". SM2014.2 +025100 02 FILLER PIC X(12) VALUE SM2014.2 +025200 " HIGH ". SM2014.2 +025300 02 FILLER PIC X(22) VALUE SM2014.2 +025400 " LEVEL VALIDATION FOR ". SM2014.2 +025500 02 FILLER PIC X(58) VALUE SM2014.2 +025600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2014.2 +025700 01 CCVS-H-3. SM2014.2 +025800 02 FILLER PIC X(34) VALUE SM2014.2 +025900 " FOR OFFICIAL USE ONLY ". SM2014.2 +026000 02 FILLER PIC X(58) VALUE SM2014.2 +026100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2014.2 +026200 02 FILLER PIC X(28) VALUE SM2014.2 +026300 " COPYRIGHT 1985 ". SM2014.2 +026400 01 CCVS-E-1. SM2014.2 +026500 02 FILLER PIC X(52) VALUE SPACE. SM2014.2 +026600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2014.2 +026700 02 ID-AGAIN PIC X(9). SM2014.2 +026800 02 FILLER PIC X(45) VALUE SPACES. SM2014.2 +026900 01 CCVS-E-2. SM2014.2 +027000 02 FILLER PIC X(31) VALUE SPACE. SM2014.2 +027100 02 FILLER PIC X(21) VALUE SPACE. SM2014.2 +027200 02 CCVS-E-2-2. SM2014.2 +027300 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2014.2 +027400 03 FILLER PIC X VALUE SPACE. SM2014.2 +027500 03 ENDER-DESC PIC X(44) VALUE SM2014.2 +027600 "ERRORS ENCOUNTERED". SM2014.2 +027700 01 CCVS-E-3. SM2014.2 +027800 02 FILLER PIC X(22) VALUE SM2014.2 +027900 " FOR OFFICIAL USE ONLY". SM2014.2 +028000 02 FILLER PIC X(12) VALUE SPACE. SM2014.2 +028100 02 FILLER PIC X(58) VALUE SM2014.2 +028200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2014.2 +028300 02 FILLER PIC X(13) VALUE SPACE. SM2014.2 +028400 02 FILLER PIC X(15) VALUE SM2014.2 +028500 " COPYRIGHT 1985". SM2014.2 +028600 01 CCVS-E-4. SM2014.2 +028700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2014.2 +028800 02 FILLER PIC X(4) VALUE " OF ". SM2014.2 +028900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2014.2 +029000 02 FILLER PIC X(40) VALUE SM2014.2 +029100 " TESTS WERE EXECUTED SUCCESSFULLY". SM2014.2 +029200 01 XXINFO. SM2014.2 +029300 02 FILLER PIC X(19) VALUE SM2014.2 +029400 "*** INFORMATION ***". SM2014.2 +029500 02 INFO-TEXT. SM2014.2 +029600 04 FILLER PIC X(8) VALUE SPACE. SM2014.2 +029700 04 XXCOMPUTED PIC X(20). SM2014.2 +029800 04 FILLER PIC X(5) VALUE SPACE. SM2014.2 +029900 04 XXCORRECT PIC X(20). SM2014.2 +030000 02 INF-ANSI-REFERENCE PIC X(48). SM2014.2 +030100 01 HYPHEN-LINE. SM2014.2 +030200 02 FILLER PIC IS X VALUE IS SPACE. SM2014.2 +030300 02 FILLER PIC IS X(65) VALUE IS "************************SM2014.2 +030400- "*****************************************". SM2014.2 +030500 02 FILLER PIC IS X(54) VALUE IS "************************SM2014.2 +030600- "******************************". SM2014.2 +030700 01 CCVS-PGM-ID PIC X(9) VALUE SM2014.2 +030800 "SM201A". SM2014.2 +030900 PROCEDURE DIVISION. SM2014.2 +031000 CCVS1 SECTION. SM2014.2 +031100 OPEN-FILES. SM2014.2 +031200 OPEN OUTPUT PRINT-FILE. SM2014.2 +031300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2014.2 +031400 MOVE SPACE TO TEST-RESULTS. SM2014.2 +031500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2014.2 +031600 GO TO CCVS1-EXIT. SM2014.2 +031700 CLOSE-FILES. SM2014.2 +031800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2014.2 +031900 TERMINATE-CCVS. SM2014.2 +032000*S EXIT PROGRAM. SM2014.2 +032100*SERMINATE-CALL. SM2014.2 +032200 STOP RUN. SM2014.2 +032300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2014.2 +032400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2014.2 +032500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2014.2 +032600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2014.2 +032700 MOVE "****TEST DELETED****" TO RE-MARK. SM2014.2 +032800 PRINT-DETAIL. SM2014.2 +032900 IF REC-CT NOT EQUAL TO ZERO SM2014.2 +033000 MOVE "." TO PARDOT-X SM2014.2 +033100 MOVE REC-CT TO DOTVALUE. SM2014.2 +033200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2014.2 +033300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2014.2 +033400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2014.2 +033500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2014.2 +033600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2014.2 +033700 MOVE SPACE TO CORRECT-X. SM2014.2 +033800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2014.2 +033900 MOVE SPACE TO RE-MARK. SM2014.2 +034000 HEAD-ROUTINE. SM2014.2 +034100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +034200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +034300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2014.2 +034400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2014.2 +034500 COLUMN-NAMES-ROUTINE. SM2014.2 +034600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +034700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +034900 END-ROUTINE. SM2014.2 +035000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2014.2 +035100 END-RTN-EXIT. SM2014.2 +035200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +035300 END-ROUTINE-1. SM2014.2 +035400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2014.2 +035500 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2014.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SM2014.2 +035700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2014.2 +035800 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2014.2 +035900 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2014.2 +036000 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2014.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2014.2 +036200 END-ROUTINE-12. SM2014.2 +036300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2014.2 +036400 IF ERROR-COUNTER IS EQUAL TO ZERO SM2014.2 +036500 MOVE "NO " TO ERROR-TOTAL SM2014.2 +036600 ELSE SM2014.2 +036700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2014.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2014.2 +036900 PERFORM WRITE-LINE. SM2014.2 +037000 END-ROUTINE-13. SM2014.2 +037100 IF DELETE-COUNTER IS EQUAL TO ZERO SM2014.2 +037200 MOVE "NO " TO ERROR-TOTAL ELSE SM2014.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2014.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2014.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +037600 IF INSPECT-COUNTER EQUAL TO ZERO SM2014.2 +037700 MOVE "NO " TO ERROR-TOTAL SM2014.2 +037800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2014.2 +037900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2014.2 +038000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +038100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2014.2 +038200 WRITE-LINE. SM2014.2 +038300 ADD 1 TO RECORD-COUNT. SM2014.2 +038400 IF RECORD-COUNT GREATER 50 SM2014.2 +038500 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2014.2 +038600 MOVE SPACE TO DUMMY-RECORD SM2014.2 +038700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2014.2 +038800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2014.2 +038900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2014.2 +039000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2014.2 +039100 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2014.2 +039200 MOVE ZERO TO RECORD-COUNT. SM2014.2 +039300 PERFORM WRT-LN. SM2014.2 +039400 WRT-LN. SM2014.2 +039500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2014.2 +039600 MOVE SPACE TO DUMMY-RECORD. SM2014.2 +039700 BLANK-LINE-PRINT. SM2014.2 +039800 PERFORM WRT-LN. SM2014.2 +039900 FAIL-ROUTINE. SM2014.2 +040000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2014.2 +040100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2014.2 +040200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2014.2 +040300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2014.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +040500 MOVE SPACES TO INF-ANSI-REFERENCE. SM2014.2 +040600 GO TO FAIL-ROUTINE-EX. SM2014.2 +040700 FAIL-ROUTINE-WRITE. SM2014.2 +040800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2014.2 +040900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2014.2 +041000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2014.2 +041100 MOVE SPACES TO COR-ANSI-REFERENCE. SM2014.2 +041200 FAIL-ROUTINE-EX. EXIT. SM2014.2 +041300 BAIL-OUT. SM2014.2 +041400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2014.2 +041500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2014.2 +041600 BAIL-OUT-WRITE. SM2014.2 +041700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2014.2 +041800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2014.2 +041900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2014.2 +042000 MOVE SPACES TO INF-ANSI-REFERENCE. SM2014.2 +042100 BAIL-OUT-EX. EXIT. SM2014.2 +042200 CCVS1-EXIT. SM2014.2 +042300 EXIT. SM2014.2 +042400 INITIALIZATION SECTION. SM2014.2 +042500 SM201A-INIT. SM2014.2 +042600 OPEN OUTPUT TEST-FILE. SM2014.2 +042700 MOVE "OUTPUT OF SM201A IS USED AS" TO RE-MARK. SM2014.2 +042800 PERFORM PRINT-DETAIL. SM2014.2 +042900 MOVE "INPUT FOR SM202A." TO RE-MARK. SM2014.2 +043000 PERFORM PRINT-DETAIL. SM2014.2 +043100 MOVE "COPY 01 LEVEL --- " TO FEATURE. SM2014.2 +043200 PERFORM PRINT-DETAIL. SM2014.2 +043300 WORKING-STORAGE-TEST SECTION. SM2014.2 +043400 COPY-TEST-1. SM2014.2 +043500 IF WSTR-1A EQUAL TO WSTR999 SM2014.2 +043600 PERFORM PASS GO TO COPY-WRITE-1. SM2014.2 +043700* NOTE TESTS COPYING WITH REPLACEMENT IN WORKING-STORAGE. SM2014.2 +043800 GO TO COPY-FAIL-1. SM2014.2 +043900 COPY-DELETE-1. SM2014.2 +044000 PERFORM DE-LETE. SM2014.2 +044100 GO TO COPY-WRITE-1. SM2014.2 +044200 COPY-FAIL-1. SM2014.2 +044300 MOVE WSTR999 TO COMPUTED-A. SM2014.2 +044400 MOVE "ABC" TO CORRECT-A. SM2014.2 +044500 PERFORM FAIL. SM2014.2 +044600 COPY-WRITE-1. SM2014.2 +044700 MOVE " REPLACING" TO FEATURE. SM2014.2 +044800 MOVE "COPY-TEST-1 " TO PAR-NAME. SM2014.2 +044900 PERFORM PRINT-DETAIL. SM2014.2 +045000 COPY-TEST-2. SM2014.2 +045100 IF WSTR-2A EQUAL TO "ABC" SM2014.2 +045200 PERFORM PASS GO TO COPY-WRITE-2. SM2014.2 +045300* NOTE TESTS ORDINARY COPY OF ENTRIES WHICH ARE ALSO COPIEDSM2014.2 +045400* BY COPY REPLACING. SM2014.2 +045500 GO TO COPY-FAIL-2. SM2014.2 +045600 COPY-DELETE-2. SM2014.2 +045700 PERFORM DE-LETE. SM2014.2 +045800 GO TO COPY-WRITE-2. SM2014.2 +045900 COPY-FAIL-2. SM2014.2 +046000 MOVE WSTR-2A TO COMPUTED-A. SM2014.2 +046100 MOVE "ABC" TO CORRECT-A. SM2014.2 +046200 PERFORM FAIL. SM2014.2 +046300 COPY-WRITE-2. SM2014.2 +046400 MOVE " (NO REPLACING)" TO FEATURE. SM2014.2 +046500 MOVE "COPY-TEST-2 " TO PAR-NAME. SM2014.2 +046600 PERFORM PRINT-DETAIL. SM2014.2 +046700 COPY-INIT-A. SM2014.2 +046800 MOVE " REPLACING" TO FEATURE. SM2014.2 +046900 COPY-TEST-3. SM2014.2 +047000 IF WSTR91 EQUAL TO "ABC" SM2014.2 +047100 PERFORM PASS GO TO COPY-WRITE-3. SM2014.2 +047200* NOTE COPY-TEST-3, 4, AND 5 TEST COPYING WITH A SM2014.2 +047300* SERIES OF REPLACEMENTS. SM2014.2 +047400 GO TO COPY-FAIL-3. SM2014.2 +047500 COPY-DELETE-3. SM2014.2 +047600 PERFORM DE-LETE. SM2014.2 +047700 GO TO COPY-WRITE-3. SM2014.2 +047800 COPY-FAIL-3. SM2014.2 +047900 MOVE WSTR91 TO COMPUTED-A. SM2014.2 +048000 MOVE "ABC" TO CORRECT-A. SM2014.2 +048100 PERFORM FAIL. SM2014.2 +048200 COPY-WRITE-3. SM2014.2 +048300 MOVE "COPY-TEST-3 " TO PAR-NAME. SM2014.2 +048400 PERFORM PRINT-DETAIL. SM2014.2 +048500 COPY-TEST-4. SM2014.2 +048600 IF WSTR92 EQUAL TO "DEF" SM2014.2 +048700 PERFORM PASS GO TO COPY-WRITE-4. SM2014.2 +048800 GO TO COPY-FAIL-4. SM2014.2 +048900 COPY-DELETE-4. SM2014.2 +049000 PERFORM DE-LETE. SM2014.2 +049100 GO TO COPY-WRITE-4. SM2014.2 +049200 COPY-FAIL-4. SM2014.2 +049300 MOVE WSTR92 TO COMPUTED-A. SM2014.2 +049400 MOVE "DEF" TO CORRECT-A. SM2014.2 +049500 PERFORM FAIL. SM2014.2 +049600 COPY-WRITE-4. SM2014.2 +049700 MOVE "COPY-TEST-4 " TO PAR-NAME. SM2014.2 +049800 PERFORM PRINT-DETAIL. SM2014.2 +049900 COPY-TEST-5. SM2014.2 +050000 IF WSTR93 EQUAL TO "GHI" SM2014.2 +050100 PERFORM PASS GO TO COPY-WRITE-5. SM2014.2 +050200 GO TO COPY-FAIL-5. SM2014.2 +050300 COPY-DELETE-5. SM2014.2 +050400 PERFORM DE-LETE. SM2014.2 +050500 GO TO COPY-WRITE-5. SM2014.2 +050600 COPY-FAIL-5. SM2014.2 +050700 MOVE WSTR93 TO COMPUTED-A. SM2014.2 +050800 MOVE "GHI" TO CORRECT-A. SM2014.2 +050900 PERFORM FAIL. SM2014.2 +051000 COPY-WRITE-5. SM2014.2 +051100 MOVE "COPY-TEST-5 " TO PAR-NAME. SM2014.2 +051200 PERFORM PRINT-DETAIL. SM2014.2 +051300 COPY-INIT-B. SM2014.2 +051400 MOVE " (NOT REPLACING)" TO FEATURE. SM2014.2 +051500 COPY-TEST-6. SM2014.2 +051600 IF WSTR4A EQUAL TO "ABC" SM2014.2 +051700 PERFORM PASS GO TO COPY-WRITE-6. SM2014.2 +051800* NOTE COPY-TEST-6, 7, AND 8 TEST ORDINARY COPYING OF SM2014.2 +051900* ENTRIES WHICH ARE ALSO COPIED WITH REPLACEMENT. SM2014.2 +052000 GO TO COPY-FAIL-6. SM2014.2 +052100 COPY-DELETE-6. SM2014.2 +052200 PERFORM DE-LETE. SM2014.2 +052300 GO TO COPY-WRITE-6. SM2014.2 +052400 COPY-FAIL-6. SM2014.2 +052500 MOVE WSTR4A TO COMPUTED-A. SM2014.2 +052600 MOVE "ABC" TO CORRECT-A. SM2014.2 +052700 PERFORM FAIL. SM2014.2 +052800 COPY-WRITE-6. SM2014.2 +052900 MOVE "COPY-TEST-6 " TO PAR-NAME. SM2014.2 +053000 PERFORM PRINT-DETAIL. SM2014.2 +053100 COPY-TEST-7. SM2014.2 +053200 IF WSTR4B EQUAL TO "DEF" SM2014.2 +053300 PERFORM PASS GO TO COPY-WRITE-7. SM2014.2 +053400 GO TO COPY-FAIL-7. SM2014.2 +053500 COPY-DELETE-7. SM2014.2 +053600 PERFORM DE-LETE. SM2014.2 +053700 GO TO COPY-WRITE-7. SM2014.2 +053800 COPY-FAIL-7. SM2014.2 +053900 MOVE WSTR4B TO COMPUTED-A. SM2014.2 +054000 MOVE "DEF" TO CORRECT-A. SM2014.2 +054100 PERFORM FAIL. SM2014.2 +054200 COPY-WRITE-7. SM2014.2 +054300 MOVE "COPY-TEST-7 " TO PAR-NAME. SM2014.2 +054400 PERFORM PRINT-DETAIL. SM2014.2 +054500 COPY-TEST-8. SM2014.2 +054600 IF WSTR4C EQUAL TO "GHI" SM2014.2 +054700 PERFORM PASS GO TO COPY-WRITE-8. SM2014.2 +054800 GO TO COPY-FAIL-8. SM2014.2 +054900 COPY-DELETE-8. SM2014.2 +055000 PERFORM DE-LETE. SM2014.2 +055100 GO TO COPY-WRITE-8. SM2014.2 +055200 COPY-FAIL-8. SM2014.2 +055300 MOVE WSTR4C TO COMPUTED-A. SM2014.2 +055400 MOVE "GHI" TO CORRECT-A. SM2014.2 +055500 PERFORM FAIL. SM2014.2 +055600 COPY-WRITE-8. SM2014.2 +055700 MOVE "COPY-TEST-8 " TO PAR-NAME. SM2014.2 +055800 PERFORM PRINT-DETAIL. SM2014.2 +055900 PARAGRAPH-TEST SECTION. SM2014.2 +056000 COPY-TEST-9. SM2014.2 +056100 SM2014.2 +056200 SM2014.2 +056300 SM2014.2 +056400 SM2014.2 +056500 SM2014.2 +056600* SM2014.2 +056700*********************** COPY STATEMENT USED **********************SM2014.2 +056800* SM2014.2 +056900* COPY K1PRB SM2014.2 +057000* REPLACING WSTR4C BY WSTR4B. SM2014.2 +057100* SM2014.2 +057200******************** COPIED TEXT BEGINS BELOW ********************SM2014.2 +057300 COPY K1PRB SM2014.2 +057400 REPLACING WSTR4C BY WSTR4B. SM2014.2 +057500*********************** END OF COPIED TEXT ***********************SM2014.2 +057600* NOTE COPY A PROCEDURE WHICH REFERENCES COPIED DATA. SM2014.2 +057700 IF WSTR-4 EQUAL TO "DEFABCDEF" SM2014.2 +057800 PERFORM PASS GO TO COPY-WRITE-9. SM2014.2 +057900 GO TO COPY-FAIL-9. SM2014.2 +058000 COPY-DELETE-9. SM2014.2 +058100 PERFORM DE-LETE. SM2014.2 +058200 GO TO COPY-WRITE-9. SM2014.2 +058300 COPY-FAIL-9. SM2014.2 +058400 MOVE WSTR-4 TO COMPUTED-A. SM2014.2 +058500 MOVE "DEFABCDEF" TO CORRECT-A. SM2014.2 +058600 PERFORM FAIL. SM2014.2 +058700 COPY-WRITE-9. SM2014.2 +058800 MOVE "COPY PARA REPLACING" TO FEATURE. SM2014.2 +058900 MOVE "COPY-TEST-9 " TO PAR-NAME. SM2014.2 +059000 PERFORM PRINT-DETAIL. SM2014.2 +059100 BUILD SECTION. SM2014.2 +059200 COPY-TEST-10. SM2014.2 +059300 MOVE RCD-1 TO TF-1. SM2014.2 +059400 WRITE TST-TEST. SM2014.2 +059500 MOVE RCD-2 TO TF-1. SM2014.2 +059600 WRITE TST-TEST. SM2014.2 +059700 MOVE RCD-3 TO TF-1. SM2014.2 +059800 WRITE TST-TEST. SM2014.2 +059900 MOVE RCD-4 TO TF-1. SM2014.2 +060000 WRITE TST-TEST. SM2014.2 +060100 MOVE RCD-5 TO TF-1. SM2014.2 +060200 WRITE TST-TEST. SM2014.2 +060300 MOVE RCD-6 TO TF-1. SM2014.2 +060400 WRITE TST-TEST. SM2014.2 +060500 MOVE RCD-7 TO TF-1. SM2014.2 +060600 WRITE TST-TEST. SM2014.2 +060700 PERFORM PASS. SM2014.2 +060800 GO TO COPY-WRITE-10. SM2014.2 +060900 COPY-DELETE-10. SM2014.2 +061000 PERFORM DE-LETE. SM2014.2 +061100 COPY-WRITE-10. SM2014.2 +061200 MOVE "COPY FD REPLACING" TO FEATURE. SM2014.2 +061300 MOVE "COPY-TEST-10 " TO PAR-NAME. SM2014.2 +061400 MOVE "OUTPUT PASSED ONTO SM202" TO RE-MARK. SM2014.2 +061500 PERFORM PRINT-DETAIL. SM2014.2 +061600 CLOSE TEST-FILE. SM2014.2 +061700 MORE-TESTS SECTION. SM2014.2 +061800 COPY-TEST-11. SM2014.2 +061900 MOVE SPACES TO TEXT-TEST-1. SM2014.2 +062000 MOVE 12345 TO TXT-FLD-1. SM2014.2 +062100 IF TEXT-TEST-1 IS EQUAL TO " SM2014.2 +062200- " SM2014.2 +062300- " 12345" SM2014.2 +062400 PERFORM PASS ELSE PERFORM FAIL. SM2014.2 +062500 GO TO COPY-WRITE-11. SM2014.2 +062600 COPY-DELETE-11. SM2014.2 +062700 PERFORM DE-LETE. SM2014.2 +062800 COPY-WRITE-11. SM2014.2 +062900 MOVE "PSEUDO TEXT" TO FEATURE. SM2014.2 +063000 MOVE "COPY-TEST-11" TO PAR-NAME. SM2014.2 +063100 PERFORM PRINT-DETAIL. SM2014.2 +063200 CCVS-EXIT SECTION. SM2014.2 +063300 CCVS-999999. SM2014.2 +063400 GO TO CLOSE-FILES. SM2014.2 diff --git a/tests/cobol85/SM/SM202A.SUB b/tests/cobol85/SM/SM202A.SUB new file mode 100755 index 00000000..4fb18c0d --- /dev/null +++ b/tests/cobol85/SM/SM202A.SUB @@ -0,0 +1,529 @@ +000100 IDENTIFICATION DIVISION. SM2024.2 +000200 PROGRAM-ID. SM2024.2 +000300 SM202A. SM2024.2 +000400**************************************************************** SM2024.2 +000500* * SM2024.2 +000600* VALIDATION FOR:- * SM2024.2 +000700* * SM2024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2024.2 +000900* * SM2024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2024.2 +001100* * SM2024.2 +001200**************************************************************** SM2024.2 +001300* * SM2024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2024.2 +001500* * SM2024.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2024.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2024.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2024.2 +001900* * SM2024.2 +002000**************************************************************** SM2024.2 +002100* * SM2024.2 +002200* PROGRAM SM202A READS THE FILE PRODUCED BY SM201A TO * SM2024.2 +002300* VERIFY THE PROPER EXECUTION OF THE "COPY REPLACING" * SM2024.2 +002400* STATEMENTS IN SM201A. A NUMBER OF FURTHER TESTS USING * SM2024.2 +002500* VARIOUS NUMERIC AMD ALPHANUMERIC LITERALS, QUALIFIED * SM2024.2 +002600* DATA NAMES AND MULTIPLE "REPLACING" OPERANDS ARE ALSO * SM2024.2 +002700* CARRIED OUT. * SM2024.2 +002800* * SM2024.2 +002900**************************************************************** SM2024.2 +003000 ENVIRONMENT DIVISION. SM2024.2 +003100 CONFIGURATION SECTION. SM2024.2 +003200 SOURCE-COMPUTER. SM2024.2 +003300 Linux. SM2024.2 +003400 OBJECT-COMPUTER. SM2024.2 +003500 Linux. SM2024.2 +003600 INPUT-OUTPUT SECTION. SM2024.2 +003700 FILE-CONTROL. SM2024.2 +003800 SELECT PRINT-FILE ASSIGN TO SM2024.2 +003900 "report.log". SM2024.2 +004000 SELECT TEST-FILE ASSIGN TO SM2024.2 +004100 "XXXXX001". SM2024.2 +004200 DATA DIVISION. SM2024.2 +004300 FILE SECTION. SM2024.2 +004400 FD PRINT-FILE. SM2024.2 +004500 01 PRINT-REC PICTURE X(120). SM2024.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM2024.2 +004700 FD TEST-FILE SM2024.2 +004800 LABEL RECORD STANDARD SM2024.2 +004900*C VALUE OF SM2024.2 +005000*C OCLABELID SM2024.2 +005100*C IS SM2024.2 +005200*C "OCDUMMY" SM2024.2 +005300*G SYSIN SM2024.2 +005400 DATA RECORD IS PROOF-REC. SM2024.2 +005500 01 PROOF-REC. SM2024.2 +005600 02 TF-1 PICTURE 9(5). SM2024.2 +005700 02 FILLER PICTURE X(115). SM2024.2 +005800 WORKING-STORAGE SECTION. SM2024.2 +005900 01 COUNTER-16 PICTURE 9 VALUE 1. SM2024.2 +006000 01 TOTAL-AREA. SM2024.2 +006100 02 AREA-1 PICTURE AAAAA. SM2024.2 +006200 02 AREA-2 PICTURE XXXXB. SM2024.2 +006300 02 AREA-3 PICTURE XXXXX. SM2024.2 +006400 02 AREA-4 PICTURE ZZZZZ. SM2024.2 +006500 01 MISLEADING-DATA. SM2024.2 +006600 02 FALSE-DATA-1 PICTURE AAAAA VALUE "FALSE". SM2024.2 +006700 02 FALSE-DATA-2 PICTURE XXXXX VALUE " TENT". SM2024.2 +006800 02 FALSE-DATA-3 PICTURE XXXXX VALUE "- 5 =". SM2024.2 +006900 02 FALSE-DATA-4 PICTURE 99999 VALUE 00012. SM2024.2 +007000 01 QUALIFIED-DATA. SM2024.2 +007100 02 TRUE-Q-02. SM2024.2 +007200 03 TRUE-Q-03. SM2024.2 +007300 04 TRUE-Q-04 PICTURE A(5) VALUE "TRUE ". SM2024.2 +007400 03 FALSE-Q-03. SM2024.2 +007500 04 TRUE-Q-04 PICTURE A(5) VALUE "FIGHT". SM2024.2 +007600 02 FALSE-Q-02. SM2024.2 +007700 03 TRUE-Q-03. SM2024.2 +007800 04 TRUE-Q-04 PICTURE A(5) VALUE "DRIVE". SM2024.2 +007900 03 FALSE-Q-03. SM2024.2 +008000 04 TRUE-Q-04 PICTURE A(5) VALUE "THROW". SM2024.2 +008100 01 RE-SUB-DATA PICTURE X(40) VALUE SM2024.2 +008200 "ABCDEFGHIJKLMNOPQRST+ 2 =UVWXYZYXWVUTSRQ". SM2024.2 +008300 01 SUBSCRIPTED-DATA REDEFINES RE-SUB-DATA. SM2024.2 +008400 02 X OCCURS 2 TIMES. SM2024.2 +008500 03 Y OCCURS 2 TIMES. SM2024.2 +008600 04 Z OCCURS 2 TIMES PICTURE X(5). SM2024.2 +008700 01 TEST-RESULTS. SM2024.2 +008800 02 FILLER PIC X VALUE SPACE. SM2024.2 +008900 02 FEATURE PIC X(20) VALUE SPACE. SM2024.2 +009000 02 FILLER PIC X VALUE SPACE. SM2024.2 +009100 02 P-OR-F PIC X(5) VALUE SPACE. SM2024.2 +009200 02 FILLER PIC X VALUE SPACE. SM2024.2 +009300 02 PAR-NAME. SM2024.2 +009400 03 FILLER PIC X(19) VALUE SPACE. SM2024.2 +009500 03 PARDOT-X PIC X VALUE SPACE. SM2024.2 +009600 03 DOTVALUE PIC 99 VALUE ZERO. SM2024.2 +009700 02 FILLER PIC X(8) VALUE SPACE. SM2024.2 +009800 02 RE-MARK PIC X(61). SM2024.2 +009900 01 TEST-COMPUTED. SM2024.2 +010000 02 FILLER PIC X(30) VALUE SPACE. SM2024.2 +010100 02 FILLER PIC X(17) VALUE SM2024.2 +010200 " COMPUTED=". SM2024.2 +010300 02 COMPUTED-X. SM2024.2 +010400 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2024.2 +010500 03 COMPUTED-N REDEFINES COMPUTED-A SM2024.2 +010600 PIC -9(9).9(9). SM2024.2 +010700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2024.2 +010800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2024.2 +010900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2024.2 +011000 03 CM-18V0 REDEFINES COMPUTED-A. SM2024.2 +011100 04 COMPUTED-18V0 PIC -9(18). SM2024.2 +011200 04 FILLER PIC X. SM2024.2 +011300 03 FILLER PIC X(50) VALUE SPACE. SM2024.2 +011400 01 TEST-CORRECT. SM2024.2 +011500 02 FILLER PIC X(30) VALUE SPACE. SM2024.2 +011600 02 FILLER PIC X(17) VALUE " CORRECT =". SM2024.2 +011700 02 CORRECT-X. SM2024.2 +011800 03 CORRECT-A PIC X(20) VALUE SPACE. SM2024.2 +011900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2024.2 +012000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2024.2 +012100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2024.2 +012200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2024.2 +012300 03 CR-18V0 REDEFINES CORRECT-A. SM2024.2 +012400 04 CORRECT-18V0 PIC -9(18). SM2024.2 +012500 04 FILLER PIC X. SM2024.2 +012600 03 FILLER PIC X(2) VALUE SPACE. SM2024.2 +012700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2024.2 +012800 01 CCVS-C-1. SM2024.2 +012900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2024.2 +013000- "SS PARAGRAPH-NAME SM2024.2 +013100- " REMARKS". SM2024.2 +013200 02 FILLER PIC X(20) VALUE SPACE. SM2024.2 +013300 01 CCVS-C-2. SM2024.2 +013400 02 FILLER PIC X VALUE SPACE. SM2024.2 +013500 02 FILLER PIC X(6) VALUE "TESTED". SM2024.2 +013600 02 FILLER PIC X(15) VALUE SPACE. SM2024.2 +013700 02 FILLER PIC X(4) VALUE "FAIL". SM2024.2 +013800 02 FILLER PIC X(94) VALUE SPACE. SM2024.2 +013900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2024.2 +014000 01 REC-CT PIC 99 VALUE ZERO. SM2024.2 +014100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2024.2 +014200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2024.2 +014300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2024.2 +014400 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2024.2 +014500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2024.2 +014600 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2024.2 +014700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2024.2 +014800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2024.2 +014900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2024.2 +015000 01 CCVS-H-1. SM2024.2 +015100 02 FILLER PIC X(39) VALUE SPACES. SM2024.2 +015200 02 FILLER PIC X(42) VALUE SM2024.2 +015300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2024.2 +015400 02 FILLER PIC X(39) VALUE SPACES. SM2024.2 +015500 01 CCVS-H-2A. SM2024.2 +015600 02 FILLER PIC X(40) VALUE SPACE. SM2024.2 +015700 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2024.2 +015800 02 FILLER PIC XXXX VALUE SM2024.2 +015900 "4.2 ". SM2024.2 +016000 02 FILLER PIC X(28) VALUE SM2024.2 +016100 " COPY - NOT FOR DISTRIBUTION". SM2024.2 +016200 02 FILLER PIC X(41) VALUE SPACE. SM2024.2 +016300 SM2024.2 +016400 01 CCVS-H-2B. SM2024.2 +016500 02 FILLER PIC X(15) VALUE SM2024.2 +016600 "TEST RESULT OF ". SM2024.2 +016700 02 TEST-ID PIC X(9). SM2024.2 +016800 02 FILLER PIC X(4) VALUE SM2024.2 +016900 " IN ". SM2024.2 +017000 02 FILLER PIC X(12) VALUE SM2024.2 +017100 " HIGH ". SM2024.2 +017200 02 FILLER PIC X(22) VALUE SM2024.2 +017300 " LEVEL VALIDATION FOR ". SM2024.2 +017400 02 FILLER PIC X(58) VALUE SM2024.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2024.2 +017600 01 CCVS-H-3. SM2024.2 +017700 02 FILLER PIC X(34) VALUE SM2024.2 +017800 " FOR OFFICIAL USE ONLY ". SM2024.2 +017900 02 FILLER PIC X(58) VALUE SM2024.2 +018000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2024.2 +018100 02 FILLER PIC X(28) VALUE SM2024.2 +018200 " COPYRIGHT 1985 ". SM2024.2 +018300 01 CCVS-E-1. SM2024.2 +018400 02 FILLER PIC X(52) VALUE SPACE. SM2024.2 +018500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2024.2 +018600 02 ID-AGAIN PIC X(9). SM2024.2 +018700 02 FILLER PIC X(45) VALUE SPACES. SM2024.2 +018800 01 CCVS-E-2. SM2024.2 +018900 02 FILLER PIC X(31) VALUE SPACE. SM2024.2 +019000 02 FILLER PIC X(21) VALUE SPACE. SM2024.2 +019100 02 CCVS-E-2-2. SM2024.2 +019200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2024.2 +019300 03 FILLER PIC X VALUE SPACE. SM2024.2 +019400 03 ENDER-DESC PIC X(44) VALUE SM2024.2 +019500 "ERRORS ENCOUNTERED". SM2024.2 +019600 01 CCVS-E-3. SM2024.2 +019700 02 FILLER PIC X(22) VALUE SM2024.2 +019800 " FOR OFFICIAL USE ONLY". SM2024.2 +019900 02 FILLER PIC X(12) VALUE SPACE. SM2024.2 +020000 02 FILLER PIC X(58) VALUE SM2024.2 +020100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2024.2 +020200 02 FILLER PIC X(13) VALUE SPACE. SM2024.2 +020300 02 FILLER PIC X(15) VALUE SM2024.2 +020400 " COPYRIGHT 1985". SM2024.2 +020500 01 CCVS-E-4. SM2024.2 +020600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2024.2 +020700 02 FILLER PIC X(4) VALUE " OF ". SM2024.2 +020800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2024.2 +020900 02 FILLER PIC X(40) VALUE SM2024.2 +021000 " TESTS WERE EXECUTED SUCCESSFULLY". SM2024.2 +021100 01 XXINFO. SM2024.2 +021200 02 FILLER PIC X(19) VALUE SM2024.2 +021300 "*** INFORMATION ***". SM2024.2 +021400 02 INFO-TEXT. SM2024.2 +021500 04 FILLER PIC X(8) VALUE SPACE. SM2024.2 +021600 04 XXCOMPUTED PIC X(20). SM2024.2 +021700 04 FILLER PIC X(5) VALUE SPACE. SM2024.2 +021800 04 XXCORRECT PIC X(20). SM2024.2 +021900 02 INF-ANSI-REFERENCE PIC X(48). SM2024.2 +022000 01 HYPHEN-LINE. SM2024.2 +022100 02 FILLER PIC IS X VALUE IS SPACE. SM2024.2 +022200 02 FILLER PIC IS X(65) VALUE IS "************************SM2024.2 +022300- "*****************************************". SM2024.2 +022400 02 FILLER PIC IS X(54) VALUE IS "************************SM2024.2 +022500- "******************************". SM2024.2 +022600 01 CCVS-PGM-ID PIC X(9) VALUE SM2024.2 +022700 "SM202A". SM2024.2 +022800 PROCEDURE DIVISION. SM2024.2 +022900 CCVS1 SECTION. SM2024.2 +023000 OPEN-FILES. SM2024.2 +023100 OPEN OUTPUT PRINT-FILE. SM2024.2 +023200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2024.2 +023300 MOVE SPACE TO TEST-RESULTS. SM2024.2 +023400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2024.2 +023500 GO TO CCVS1-EXIT. SM2024.2 +023600 CLOSE-FILES. SM2024.2 +023700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2024.2 +023800 TERMINATE-CCVS. SM2024.2 +023900*S EXIT PROGRAM. SM2024.2 +024000*SERMINATE-CALL. SM2024.2 +024100 STOP RUN. SM2024.2 +024200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2024.2 +024300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2024.2 +024400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2024.2 +024500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2024.2 +024600 MOVE "****TEST DELETED****" TO RE-MARK. SM2024.2 +024700 PRINT-DETAIL. SM2024.2 +024800 IF REC-CT NOT EQUAL TO ZERO SM2024.2 +024900 MOVE "." TO PARDOT-X SM2024.2 +025000 MOVE REC-CT TO DOTVALUE. SM2024.2 +025100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2024.2 +025200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2024.2 +025300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2024.2 +025400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2024.2 +025500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2024.2 +025600 MOVE SPACE TO CORRECT-X. SM2024.2 +025700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2024.2 +025800 MOVE SPACE TO RE-MARK. SM2024.2 +025900 HEAD-ROUTINE. SM2024.2 +026000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +026100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +026200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2024.2 +026300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2024.2 +026400 COLUMN-NAMES-ROUTINE. SM2024.2 +026500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +026600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +026700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +026800 END-ROUTINE. SM2024.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2024.2 +027000 END-RTN-EXIT. SM2024.2 +027100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +027200 END-ROUTINE-1. SM2024.2 +027300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2024.2 +027400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2024.2 +027500 ADD PASS-COUNTER TO ERROR-HOLD. SM2024.2 +027600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2024.2 +027700 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2024.2 +027800 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2024.2 +027900 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2024.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2024.2 +028100 END-ROUTINE-12. SM2024.2 +028200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2024.2 +028300 IF ERROR-COUNTER IS EQUAL TO ZERO SM2024.2 +028400 MOVE "NO " TO ERROR-TOTAL SM2024.2 +028500 ELSE SM2024.2 +028600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2024.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2024.2 +028800 PERFORM WRITE-LINE. SM2024.2 +028900 END-ROUTINE-13. SM2024.2 +029000 IF DELETE-COUNTER IS EQUAL TO ZERO SM2024.2 +029100 MOVE "NO " TO ERROR-TOTAL ELSE SM2024.2 +029200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2024.2 +029300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2024.2 +029400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +029500 IF INSPECT-COUNTER EQUAL TO ZERO SM2024.2 +029600 MOVE "NO " TO ERROR-TOTAL SM2024.2 +029700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2024.2 +029800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2024.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +030000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2024.2 +030100 WRITE-LINE. SM2024.2 +030200 ADD 1 TO RECORD-COUNT. SM2024.2 +030300 IF RECORD-COUNT GREATER 50 SM2024.2 +030400 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2024.2 +030500 MOVE SPACE TO DUMMY-RECORD SM2024.2 +030600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2024.2 +030700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2024.2 +030800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2024.2 +030900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2024.2 +031000 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2024.2 +031100 MOVE ZERO TO RECORD-COUNT. SM2024.2 +031200 PERFORM WRT-LN. SM2024.2 +031300 WRT-LN. SM2024.2 +031400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2024.2 +031500 MOVE SPACE TO DUMMY-RECORD. SM2024.2 +031600 BLANK-LINE-PRINT. SM2024.2 +031700 PERFORM WRT-LN. SM2024.2 +031800 FAIL-ROUTINE. SM2024.2 +031900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2024.2 +032000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2024.2 +032100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2024.2 +032200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2024.2 +032300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +032400 MOVE SPACES TO INF-ANSI-REFERENCE. SM2024.2 +032500 GO TO FAIL-ROUTINE-EX. SM2024.2 +032600 FAIL-ROUTINE-WRITE. SM2024.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2024.2 +032800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2024.2 +032900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2024.2 +033000 MOVE SPACES TO COR-ANSI-REFERENCE. SM2024.2 +033100 FAIL-ROUTINE-EX. EXIT. SM2024.2 +033200 BAIL-OUT. SM2024.2 +033300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2024.2 +033400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2024.2 +033500 BAIL-OUT-WRITE. SM2024.2 +033600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2024.2 +033700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2024.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2024.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. SM2024.2 +034000 BAIL-OUT-EX. EXIT. SM2024.2 +034100 CCVS1-EXIT. SM2024.2 +034200 EXIT. SM2024.2 +034300 INITIALIZATION SECTION. SM2024.2 +034400 SM202A-INIT. SM2024.2 +034500 OPEN INPUT TEST-FILE. SM2024.2 +034600 MOVE "SM202A CHECKS A FILE WHICH" TO RE-MARK. SM2024.2 +034700 PERFORM PRINT-DETAIL. SM2024.2 +034800 MOVE "WAS GENERATED IN SM201A." TO RE-MARK. SM2024.2 +034900 PERFORM PRINT-DETAIL. SM2024.2 +035000 MOVE "COPY FD REPLACING" TO FEATURE. SM2024.2 +035100 FD-TEST SECTION. SM2024.2 +035200 COPY-TEST-11. SM2024.2 +035300 PERFORM READ-TEST-FILE. SM2024.2 +035400 IF TF-1 EQUAL TO 97532 SM2024.2 +035500 PERFORM PASS GO TO COPY-WRITE-11. SM2024.2 +035600 GO TO COPY-FAIL-11. SM2024.2 +035700 COPY-DELETE-11. SM2024.2 +035800 PERFORM DE-LETE. SM2024.2 +035900 GO TO COPY-WRITE-11. SM2024.2 +036000 COPY-FAIL-11. SM2024.2 +036100 MOVE TF-1 TO COMPUTED-N. SM2024.2 +036200 MOVE 97532 TO CORRECT-N. SM2024.2 +036300 PERFORM FAIL. SM2024.2 +036400 COPY-WRITE-11. SM2024.2 +036500 MOVE "COPY-TEST-11 " TO PAR-NAME. SM2024.2 +036600 PERFORM PRINT-DETAIL. SM2024.2 +036700 COPY-TEST-12. SM2024.2 +036800 PERFORM READ-TEST-FILE. SM2024.2 +036900 IF TF-1 EQUAL TO 23479 SM2024.2 +037000 PERFORM PASS GO TO COPY-WRITE-12. SM2024.2 +037100 GO TO COPY-FAIL-12. SM2024.2 +037200 COPY-DELETE-12. SM2024.2 +037300 PERFORM DE-LETE. SM2024.2 +037400 GO TO COPY-WRITE-12. SM2024.2 +037500 COPY-FAIL-12. SM2024.2 +037600 MOVE TF-1 TO COMPUTED-N. SM2024.2 +037700 MOVE 23479 TO CORRECT-N. SM2024.2 +037800 PERFORM FAIL. SM2024.2 +037900 COPY-WRITE-12. SM2024.2 +038000 MOVE "COPY-TEST-12 " TO PAR-NAME. SM2024.2 +038100 PERFORM PRINT-DETAIL. SM2024.2 +038200 COPY-TEST-13. SM2024.2 +038300 PERFORM READ-TEST-FILE 3 TIMES. SM2024.2 +038400 IF TF-1 EQUAL TO 14003 SM2024.2 +038500 PERFORM PASS GO TO COPY-WRITE-13. SM2024.2 +038600 GO TO COPY-FAIL-13. SM2024.2 +038700 COPY-DELETE-13. SM2024.2 +038800 PERFORM DE-LETE. SM2024.2 +038900 GO TO COPY-WRITE-13. SM2024.2 +039000 COPY-FAIL-13. SM2024.2 +039100 MOVE TF-1 TO COMPUTED-N. SM2024.2 +039200 MOVE 14003 TO CORRECT-N. SM2024.2 +039300 PERFORM FAIL. SM2024.2 +039400 COPY-WRITE-13. SM2024.2 +039500 MOVE "COPY-TEST-13 " TO PAR-NAME. SM2024.2 +039600 PERFORM PRINT-DETAIL. SM2024.2 +039700 COPY-TEST-14. SM2024.2 +039800 PERFORM READ-TEST-FILE 2 TIMES. SM2024.2 +039900 IF TF-1 EQUAL TO 03543 SM2024.2 +040000 PERFORM PASS GO TO COPY-WRITE-14. SM2024.2 +040100 GO TO COPY-FAIL-14. SM2024.2 +040200 COPY-DELETE-14. SM2024.2 +040300 PERFORM DE-LETE. SM2024.2 +040400 GO TO COPY-WRITE-14. SM2024.2 +040500 COPY-FAIL-14. SM2024.2 +040600 MOVE TF-1 TO COMPUTED-N. SM2024.2 +040700 MOVE 03543 TO CORRECT-N. SM2024.2 +040800 PERFORM FAIL. SM2024.2 +040900 COPY-WRITE-14. SM2024.2 +041000 MOVE "COPY-TEST-14 " TO PAR-NAME. SM2024.2 +041100 PERFORM PRINT-DETAIL. SM2024.2 +041200 COPY-INIT-A. SM2024.2 +041300 MOVE "COPY REPLACING --- " TO FEATURE. SM2024.2 +041400 PERFORM PRINT-DETAIL. SM2024.2 +041500 MOVE " PARAGRAPH-NAMES " TO FEATURE. SM2024.2 +041600 COPY-TEST-15 SECTION. SM2024.2 +041700 SM2024.2 +041800 SM2024.2 +041900 SM2024.2 +042000 SM2024.2 +042100 SM2024.2 +042200* SM2024.2 +042300*********************** COPY STATEMENT USED **********************SM2024.2 +042400* SM2024.2 +042500* COPY K2SEA SM2024.2 +042600* REPLACING PARA-X BY PARA-2 SM2024.2 +042700* 12345 BY PARA-3 SM2024.2 +042800* DUMMY-PASS BY PASS. SM2024.2 +042900* SM2024.2 +043000******************** COPIED TEXT BEGINS BELOW ********************SM2024.2 +043100 COPY K2SEA SM2024.2 +043200 REPLACING PARA-X BY PARA-2 SM2024.2 +043300 12345 BY PARA-3 SM2024.2 +043400 DUMMY-PASS BY PASS. SM2024.2 +043500*********************** END OF COPIED TEXT ***********************SM2024.2 +043600 COPY-A-15 SECTION. SM2024.2 +043700 COPY-DELETE-15. SM2024.2 +043800 PERFORM DE-LETE. SM2024.2 +043900 COPY-WRITE-15. SM2024.2 +044000 MOVE "COPY-TEST-15" TO PAR-NAME. SM2024.2 +044100 PERFORM PRINT-DETAIL. SM2024.2 +044200 COPY-PARA SECTION. SM2024.2 +044300 COPY-INIT-B. SM2024.2 +044400 MOVE " BY LITERALS " TO FEATURE. SM2024.2 +044500 COPY-TEST-16. SM2024.2 +044600 SM2024.2 +044700 SM2024.2 +044800 SM2024.2 +044900 SM2024.2 +045000 SM2024.2 +045100* SM2024.2 +045200*********************** COPY STATEMENT USED **********************SM2024.2 +045300* SM2024.2 +045400* COPY K2PRA SM2024.2 +045500* REPLACING FALSE-DATA-1 BY "TRUE " SM2024.2 +045600* FALSE-DATA-2 BY " TWO$" SM2024.2 +045700* FALSE-DATA-3 BY "+ 2 =" SM2024.2 +045800* FALSE-DATA-4 BY 4. SM2024.2 +045900* SM2024.2 +046000******************** COPIED TEXT BEGINS BELOW ********************SM2024.2 +046100 COPY K2PRA SM2024.2 +046200 REPLACING FALSE-DATA-1 BY "TRUE " SM2024.2 +046300 FALSE-DATA-2 BY " TWO$" SM2024.2 +046400 FALSE-DATA-3 BY "+ 2 =" SM2024.2 +046500 FALSE-DATA-4 BY 4. SM2024.2 +046600*********************** END OF COPIED TEXT ***********************SM2024.2 +046700 COPY-DELETE-16. SM2024.2 +046800 PERFORM DE-LETE. SM2024.2 +046900 COPY-WRITE-16. SM2024.2 +047000 IF COUNTER-16 IS EQUAL TO 0 SM2024.2 +047100 PERFORM FAIL SM2024.2 +047200 GO TO COPY-WRITE-17 SM2024.2 +047300 ELSE SM2024.2 +047400 SUBTRACT 1 FROM COUNTER-16. SM2024.2 +047500 IF P-OR-F EQUAL TO "FAIL*" SM2024.2 +047600 MOVE TOTAL-AREA TO COMPUTED-A SM2024.2 +047700 MOVE "TRUE TWO + 2 = 4" TO CORRECT-A. SM2024.2 +047800 MOVE "COPY-TEST-16" TO PAR-NAME. SM2024.2 +047900 PERFORM PRINT-DETAIL. SM2024.2 +048000 COPY-INIT-17. SM2024.2 +048100 MOVE SPACE TO TOTAL-AREA. SM2024.2 +048200 COPY-TEST-17. SM2024.2 +048300 SM2024.2 +048400 SM2024.2 +048500 SM2024.2 +048600 SM2024.2 +048700 SM2024.2 +048800* SM2024.2 +048900*********************** COPY STATEMENT USED **********************SM2024.2 +049000* SM2024.2 +049100* COPY K2PRA SM2024.2 +049200* REPLACING FALSE-DATA-1 BY TRUE-Q-04 OF TRUE-Q-03 SM2024.2 +049300* IN TRUE-Q-02 SM2024.2 +049400* COPY-WRITE-16 BY COPY-WRITE-17 SM2024.2 +049500* FALSE-DATA-2 BY " TWO FIVE " SM2024.2 +049600* FALSE-DATA-3 BY Z(2, 1, 1) SM2024.2 +049700* FALSE-DATA-4 BY +000004.99. SM2024.2 +049800* SM2024.2 +049900******************** COPIED TEXT BEGINS BELOW ********************SM2024.2 +050000 COPY K2PRA SM2024.2 +050100 REPLACING FALSE-DATA-1 BY TRUE-Q-04 OF TRUE-Q-03 SM2024.2 +050200 IN TRUE-Q-02 SM2024.2 +050300 COPY-WRITE-16 BY COPY-WRITE-17 SM2024.2 +050400 FALSE-DATA-2 BY " TWO FIVE " SM2024.2 +050500 FALSE-DATA-3 BY Z (2, 1, 1) SM2024.2 +050600 FALSE-DATA-4 BY +000004.99. SM2024.2 +050700*********************** END OF COPIED TEXT ***********************SM2024.2 +050800 COPY-DELETE-17. SM2024.2 +050900 PERFORM DE-LETE. SM2024.2 +051000 COPY-WRITE-17. SM2024.2 +051100 IF P-OR-F EQUAL TO "FAIL*" SM2024.2 +051200 MOVE TOTAL-AREA TO COMPUTED-A SM2024.2 +051300 MOVE "TRUE TWO + 2 = 4" TO CORRECT-A. SM2024.2 +051400 MOVE "COPY-TEST-17" TO PAR-NAME. SM2024.2 +051500 PERFORM PRINT-DETAIL. SM2024.2 +051600 CLOSE TEST-FILE. SM2024.2 +051700 GO TO CCVS-EXIT. SM2024.2 +051800 READ-TEST-FILE. SM2024.2 +051900 READ TEST-FILE AT END GO TO BAD-FILE. SM2024.2 +052000 BAD-FILE. SM2024.2 +052100 PERFORM FAIL. SM2024.2 +052200 MOVE "BAD-FILE" TO PAR-NAME. SM2024.2 +052300 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM2024.2 +052400 PERFORM PRINT-DETAIL. SM2024.2 +052500 CLOSE TEST-FILE. SM2024.2 +052600 GO TO CCVS-EXIT. SM2024.2 +052700 CCVS-EXIT SECTION. SM2024.2 +052800 CCVS-999999. SM2024.2 +052900 GO TO CLOSE-FILES. SM2024.2 diff --git a/tests/cobol85/SM/SM203A.CBL b/tests/cobol85/SM/SM203A.CBL new file mode 100755 index 00000000..d93275eb --- /dev/null +++ b/tests/cobol85/SM/SM203A.CBL @@ -0,0 +1,379 @@ +000100 IDENTIFICATION DIVISION. SM2034.2 +000200 PROGRAM-ID. SM2034.2 +000300 SM203A. SM2034.2 +000400**************************************************************** SM2034.2 +000500* * SM2034.2 +000600* VALIDATION FOR:- * SM2034.2 +000700* * SM2034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2034.2 +000900* * SM2034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2034.2 +001100* * SM2034.2 +001200**************************************************************** SM2034.2 +001300* * SM2034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2034.2 +001500* * SM2034.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2034.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2034.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2034.2 +001900* * SM2034.2 +002000**************************************************************** SM2034.2 +002100* * SM2034.2 +002200* PROGRAM SM203A TESTS THE USE OF THE "COPY" STATEMENT * SM2034.2 +002300* "REPLACING" PHRASE IN THE ENVIRONMENT DIVISION. * SM2034.2 +002400* A SEQUENTIAL FILE IS PRODUCED USING "COPY"ED TEXT AND * SM2034.2 +002500* THIS IS CHECKED IN PROGRAM SM204A. * SM2034.2 +002600* * SM2034.2 +002700**************************************************************** SM2034.2 +002800 ENVIRONMENT DIVISION. SM2034.2 +002900 CONFIGURATION SECTION. SM2034.2 +003000 SOURCE-COMPUTER. SM2034.2 +003100 Linux. SM2034.2 +003200 OBJECT-COMPUTER. SM2034.2 +003300 Linux. SM2034.2 +003400 SPECIAL-NAMES. COPY K3SNB SM2034.2 +003500 REPLACING DUMMY-SW-1 BY SW-1 SM2034.2 +003600 DUMMY-ON BY SWITCH-ON SM2034.2 +003700 DUMMY-OFF BY SWITCH-OFF. SM2034.2 +003800 INPUT-OUTPUT SECTION. SM2034.2 +003900 SM2034.2 +004000 SM2034.2 +004100 SM2034.2 +004200 SM2034.2 +004300 SM2034.2 +004400* SM2034.2 +004500*********************** COPY STATEMENT USED **********************SM2034.2 +004600* SM2034.2 +004700*FILE-CONTROL. COPY K3FCB SM2034.2 +004800* REPLACING DUMMY-TEST-FILE BY TEST-FILE. SM2034.2 +004900* SM2034.2 +005000******************** COPIED TEXT BEGINS BELOW ********************SM2034.2 +005100 FILE-CONTROL. COPY K3FCB SM2034.2 +005200 REPLACING DUMMY-TEST-FILE BY TEST-FILE. SM2034.2 +005300*********************** END OF COPIED TEXT ***********************SM2034.2 +005400 SM2034.2 +005500 SM2034.2 +005600 SM2034.2 +005700 SM2034.2 +005800 SM2034.2 +005900* SM2034.2 +006000*********************** COPY STATEMENT USED **********************SM2034.2 +006100* SM2034.2 +006200*I-O-CONTROL. COPY K3IOB SM2034.2 +006300* REPLACING DUMMY-PRINT-FILE BY PRINT-FILE. SM2034.2 +006400* SM2034.2 +006500******************** COPIED TEXT BEGINS BELOW ********************SM2034.2 +006600 I-O-CONTROL. COPY K3IOB SM2034.2 +006700 REPLACING DUMMY-PRINT-FILE BY PRINT-FILE. SM2034.2 +006800*********************** END OF COPIED TEXT ***********************SM2034.2 +006900 DATA DIVISION. SM2034.2 +007000 FILE SECTION. SM2034.2 +007100 FD PRINT-FILE. SM2034.2 +007200 01 PRINT-REC PICTURE X(120). SM2034.2 +007300 01 DUMMY-RECORD PICTURE X(120). SM2034.2 +007400 FD TEST-FILE SM2034.2 +007500 LABEL RECORD STANDARD SM2034.2 +007600*C VALUE OF SM2034.2 +007700*C OCLABELID SM2034.2 +007800*C IS SM2034.2 +007900*C "OCDUMMY" SM2034.2 +008000*G SYSIN SM2034.2 +008100 DATA RECORD IS PROOF-REC. SM2034.2 +008200 01 PROOF-REC. SM2034.2 +008300 02 TF-1 PICTURE 9(5). SM2034.2 +008400 02 FILLER PICTURE X(115). SM2034.2 +008500 WORKING-STORAGE SECTION. SM2034.2 +008600 77 RCD-1 PICTURE 9(5) VALUE 97532. SM2034.2 +008700 77 RCD-2 PICTURE 9(5) VALUE 23479. SM2034.2 +008800 77 RCD-3 PICTURE 9(5) VALUE 10901. SM2034.2 +008900 77 RCD-4 PICTURE 9(5) VALUE 02734. SM2034.2 +009000 77 RCD-5 PICTURE 9(5) VALUE 14003. SM2034.2 +009100 77 RCD-6 PICTURE 9(5) VALUE 19922. SM2034.2 +009200 77 RCD-7 PICTURE 9(5) VALUE 03543. SM2034.2 +009300 01 TEST-RESULTS. SM2034.2 +009400 02 FILLER PIC X VALUE SPACE. SM2034.2 +009500 02 FEATURE PIC X(20) VALUE SPACE. SM2034.2 +009600 02 FILLER PIC X VALUE SPACE. SM2034.2 +009700 02 P-OR-F PIC X(5) VALUE SPACE. SM2034.2 +009800 02 FILLER PIC X VALUE SPACE. SM2034.2 +009900 02 PAR-NAME. SM2034.2 +010000 03 FILLER PIC X(19) VALUE SPACE. SM2034.2 +010100 03 PARDOT-X PIC X VALUE SPACE. SM2034.2 +010200 03 DOTVALUE PIC 99 VALUE ZERO. SM2034.2 +010300 02 FILLER PIC X(8) VALUE SPACE. SM2034.2 +010400 02 RE-MARK PIC X(61). SM2034.2 +010500 01 TEST-COMPUTED. SM2034.2 +010600 02 FILLER PIC X(30) VALUE SPACE. SM2034.2 +010700 02 FILLER PIC X(17) VALUE SM2034.2 +010800 " COMPUTED=". SM2034.2 +010900 02 COMPUTED-X. SM2034.2 +011000 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2034.2 +011100 03 COMPUTED-N REDEFINES COMPUTED-A SM2034.2 +011200 PIC -9(9).9(9). SM2034.2 +011300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2034.2 +011400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2034.2 +011500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2034.2 +011600 03 CM-18V0 REDEFINES COMPUTED-A. SM2034.2 +011700 04 COMPUTED-18V0 PIC -9(18). SM2034.2 +011800 04 FILLER PIC X. SM2034.2 +011900 03 FILLER PIC X(50) VALUE SPACE. SM2034.2 +012000 01 TEST-CORRECT. SM2034.2 +012100 02 FILLER PIC X(30) VALUE SPACE. SM2034.2 +012200 02 FILLER PIC X(17) VALUE " CORRECT =". SM2034.2 +012300 02 CORRECT-X. SM2034.2 +012400 03 CORRECT-A PIC X(20) VALUE SPACE. SM2034.2 +012500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2034.2 +012600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2034.2 +012700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2034.2 +012800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2034.2 +012900 03 CR-18V0 REDEFINES CORRECT-A. SM2034.2 +013000 04 CORRECT-18V0 PIC -9(18). SM2034.2 +013100 04 FILLER PIC X. SM2034.2 +013200 03 FILLER PIC X(2) VALUE SPACE. SM2034.2 +013300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2034.2 +013400 01 CCVS-C-1. SM2034.2 +013500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2034.2 +013600- "SS PARAGRAPH-NAME SM2034.2 +013700- " REMARKS". SM2034.2 +013800 02 FILLER PIC X(20) VALUE SPACE. SM2034.2 +013900 01 CCVS-C-2. SM2034.2 +014000 02 FILLER PIC X VALUE SPACE. SM2034.2 +014100 02 FILLER PIC X(6) VALUE "TESTED". SM2034.2 +014200 02 FILLER PIC X(15) VALUE SPACE. SM2034.2 +014300 02 FILLER PIC X(4) VALUE "FAIL". SM2034.2 +014400 02 FILLER PIC X(94) VALUE SPACE. SM2034.2 +014500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2034.2 +014600 01 REC-CT PIC 99 VALUE ZERO. SM2034.2 +014700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2034.2 +014800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2034.2 +014900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2034.2 +015000 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2034.2 +015100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2034.2 +015200 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2034.2 +015300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2034.2 +015400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2034.2 +015500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2034.2 +015600 01 CCVS-H-1. SM2034.2 +015700 02 FILLER PIC X(39) VALUE SPACES. SM2034.2 +015800 02 FILLER PIC X(42) VALUE SM2034.2 +015900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2034.2 +016000 02 FILLER PIC X(39) VALUE SPACES. SM2034.2 +016100 01 CCVS-H-2A. SM2034.2 +016200 02 FILLER PIC X(40) VALUE SPACE. SM2034.2 +016300 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2034.2 +016400 02 FILLER PIC XXXX VALUE SM2034.2 +016500 "4.2 ". SM2034.2 +016600 02 FILLER PIC X(28) VALUE SM2034.2 +016700 " COPY - NOT FOR DISTRIBUTION". SM2034.2 +016800 02 FILLER PIC X(41) VALUE SPACE. SM2034.2 +016900 SM2034.2 +017000 01 CCVS-H-2B. SM2034.2 +017100 02 FILLER PIC X(15) VALUE SM2034.2 +017200 "TEST RESULT OF ". SM2034.2 +017300 02 TEST-ID PIC X(9). SM2034.2 +017400 02 FILLER PIC X(4) VALUE SM2034.2 +017500 " IN ". SM2034.2 +017600 02 FILLER PIC X(12) VALUE SM2034.2 +017700 " HIGH ". SM2034.2 +017800 02 FILLER PIC X(22) VALUE SM2034.2 +017900 " LEVEL VALIDATION FOR ". SM2034.2 +018000 02 FILLER PIC X(58) VALUE SM2034.2 +018100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2034.2 +018200 01 CCVS-H-3. SM2034.2 +018300 02 FILLER PIC X(34) VALUE SM2034.2 +018400 " FOR OFFICIAL USE ONLY ". SM2034.2 +018500 02 FILLER PIC X(58) VALUE SM2034.2 +018600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2034.2 +018700 02 FILLER PIC X(28) VALUE SM2034.2 +018800 " COPYRIGHT 1985 ". SM2034.2 +018900 01 CCVS-E-1. SM2034.2 +019000 02 FILLER PIC X(52) VALUE SPACE. SM2034.2 +019100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2034.2 +019200 02 ID-AGAIN PIC X(9). SM2034.2 +019300 02 FILLER PIC X(45) VALUE SPACES. SM2034.2 +019400 01 CCVS-E-2. SM2034.2 +019500 02 FILLER PIC X(31) VALUE SPACE. SM2034.2 +019600 02 FILLER PIC X(21) VALUE SPACE. SM2034.2 +019700 02 CCVS-E-2-2. SM2034.2 +019800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2034.2 +019900 03 FILLER PIC X VALUE SPACE. SM2034.2 +020000 03 ENDER-DESC PIC X(44) VALUE SM2034.2 +020100 "ERRORS ENCOUNTERED". SM2034.2 +020200 01 CCVS-E-3. SM2034.2 +020300 02 FILLER PIC X(22) VALUE SM2034.2 +020400 " FOR OFFICIAL USE ONLY". SM2034.2 +020500 02 FILLER PIC X(12) VALUE SPACE. SM2034.2 +020600 02 FILLER PIC X(58) VALUE SM2034.2 +020700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2034.2 +020800 02 FILLER PIC X(13) VALUE SPACE. SM2034.2 +020900 02 FILLER PIC X(15) VALUE SM2034.2 +021000 " COPYRIGHT 1985". SM2034.2 +021100 01 CCVS-E-4. SM2034.2 +021200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2034.2 +021300 02 FILLER PIC X(4) VALUE " OF ". SM2034.2 +021400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2034.2 +021500 02 FILLER PIC X(40) VALUE SM2034.2 +021600 " TESTS WERE EXECUTED SUCCESSFULLY". SM2034.2 +021700 01 XXINFO. SM2034.2 +021800 02 FILLER PIC X(19) VALUE SM2034.2 +021900 "*** INFORMATION ***". SM2034.2 +022000 02 INFO-TEXT. SM2034.2 +022100 04 FILLER PIC X(8) VALUE SPACE. SM2034.2 +022200 04 XXCOMPUTED PIC X(20). SM2034.2 +022300 04 FILLER PIC X(5) VALUE SPACE. SM2034.2 +022400 04 XXCORRECT PIC X(20). SM2034.2 +022500 02 INF-ANSI-REFERENCE PIC X(48). SM2034.2 +022600 01 HYPHEN-LINE. SM2034.2 +022700 02 FILLER PIC IS X VALUE IS SPACE. SM2034.2 +022800 02 FILLER PIC IS X(65) VALUE IS "************************SM2034.2 +022900- "*****************************************". SM2034.2 +023000 02 FILLER PIC IS X(54) VALUE IS "************************SM2034.2 +023100- "******************************". SM2034.2 +023200 01 CCVS-PGM-ID PIC X(9) VALUE SM2034.2 +023300 "SM203A". SM2034.2 +023400 PROCEDURE DIVISION. SM2034.2 +023500 CCVS1 SECTION. SM2034.2 +023600 OPEN-FILES. SM2034.2 +023700 OPEN OUTPUT PRINT-FILE. SM2034.2 +023800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2034.2 +023900 MOVE SPACE TO TEST-RESULTS. SM2034.2 +024000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2034.2 +024100 GO TO CCVS1-EXIT. SM2034.2 +024200 CLOSE-FILES. SM2034.2 +024300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2034.2 +024400 TERMINATE-CCVS. SM2034.2 +024500*S EXIT PROGRAM. SM2034.2 +024600*SERMINATE-CALL. SM2034.2 +024700 STOP RUN. SM2034.2 +024800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2034.2 +024900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2034.2 +025000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2034.2 +025100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2034.2 +025200 MOVE "****TEST DELETED****" TO RE-MARK. SM2034.2 +025300 PRINT-DETAIL. SM2034.2 +025400 IF REC-CT NOT EQUAL TO ZERO SM2034.2 +025500 MOVE "." TO PARDOT-X SM2034.2 +025600 MOVE REC-CT TO DOTVALUE. SM2034.2 +025700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2034.2 +025800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2034.2 +025900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2034.2 +026000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2034.2 +026100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2034.2 +026200 MOVE SPACE TO CORRECT-X. SM2034.2 +026300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2034.2 +026400 MOVE SPACE TO RE-MARK. SM2034.2 +026500 HEAD-ROUTINE. SM2034.2 +026600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +026700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +026800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2034.2 +026900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2034.2 +027000 COLUMN-NAMES-ROUTINE. SM2034.2 +027100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +027200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +027300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +027400 END-ROUTINE. SM2034.2 +027500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2034.2 +027600 END-RTN-EXIT. SM2034.2 +027700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +027800 END-ROUTINE-1. SM2034.2 +027900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2034.2 +028000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2034.2 +028100 ADD PASS-COUNTER TO ERROR-HOLD. SM2034.2 +028200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2034.2 +028300 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2034.2 +028400 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2034.2 +028500 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2034.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2034.2 +028700 END-ROUTINE-12. SM2034.2 +028800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2034.2 +028900 IF ERROR-COUNTER IS EQUAL TO ZERO SM2034.2 +029000 MOVE "NO " TO ERROR-TOTAL SM2034.2 +029100 ELSE SM2034.2 +029200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2034.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2034.2 +029400 PERFORM WRITE-LINE. SM2034.2 +029500 END-ROUTINE-13. SM2034.2 +029600 IF DELETE-COUNTER IS EQUAL TO ZERO SM2034.2 +029700 MOVE "NO " TO ERROR-TOTAL ELSE SM2034.2 +029800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2034.2 +029900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2034.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +030100 IF INSPECT-COUNTER EQUAL TO ZERO SM2034.2 +030200 MOVE "NO " TO ERROR-TOTAL SM2034.2 +030300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2034.2 +030400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2034.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +030600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2034.2 +030700 WRITE-LINE. SM2034.2 +030800 ADD 1 TO RECORD-COUNT. SM2034.2 +030900 IF RECORD-COUNT GREATER 50 SM2034.2 +031000 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2034.2 +031100 MOVE SPACE TO DUMMY-RECORD SM2034.2 +031200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2034.2 +031300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2034.2 +031400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2034.2 +031500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2034.2 +031600 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2034.2 +031700 MOVE ZERO TO RECORD-COUNT. SM2034.2 +031800 PERFORM WRT-LN. SM2034.2 +031900 WRT-LN. SM2034.2 +032000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2034.2 +032100 MOVE SPACE TO DUMMY-RECORD. SM2034.2 +032200 BLANK-LINE-PRINT. SM2034.2 +032300 PERFORM WRT-LN. SM2034.2 +032400 FAIL-ROUTINE. SM2034.2 +032500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2034.2 +032600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2034.2 +032700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2034.2 +032800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2034.2 +032900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +033000 MOVE SPACES TO INF-ANSI-REFERENCE. SM2034.2 +033100 GO TO FAIL-ROUTINE-EX. SM2034.2 +033200 FAIL-ROUTINE-WRITE. SM2034.2 +033300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2034.2 +033400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2034.2 +033500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2034.2 +033600 MOVE SPACES TO COR-ANSI-REFERENCE. SM2034.2 +033700 FAIL-ROUTINE-EX. EXIT. SM2034.2 +033800 BAIL-OUT. SM2034.2 +033900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2034.2 +034000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2034.2 +034100 BAIL-OUT-WRITE. SM2034.2 +034200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2034.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2034.2 +034400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2034.2 +034500 MOVE SPACES TO INF-ANSI-REFERENCE. SM2034.2 +034600 BAIL-OUT-EX. EXIT. SM2034.2 +034700 CCVS1-EXIT. SM2034.2 +034800 EXIT. SM2034.2 +034900 INITIALIZATION SECTION. SM2034.2 +035000 SM203-INIT. SM2034.2 +035100 OPEN OUTPUT TEST-FILE. SM2034.2 +035200 BUILD SECTION. SM2034.2 +035300 COPY-TEST-1. SM2034.2 +035400 MOVE RCD-1 TO TF-1. SM2034.2 +035500 WRITE PROOF-REC. SM2034.2 +035600 MOVE RCD-2 TO TF-1. SM2034.2 +035700 WRITE PROOF-REC. SM2034.2 +035800 MOVE RCD-3 TO TF-1. SM2034.2 +035900 WRITE PROOF-REC. SM2034.2 +036000 MOVE RCD-4 TO TF-1. SM2034.2 +036100 WRITE PROOF-REC. SM2034.2 +036200 MOVE RCD-5 TO TF-1. SM2034.2 +036300 WRITE PROOF-REC. SM2034.2 +036400 MOVE RCD-6 TO TF-1. SM2034.2 +036500 WRITE PROOF-REC. SM2034.2 +036600 MOVE RCD-7 TO TF-1. SM2034.2 +036700 WRITE PROOF-REC. SM2034.2 +036800 PERFORM PASS. SM2034.2 +036900 GO TO COPY-WRITE-1. SM2034.2 +037000 COPY-DELETE-1. SM2034.2 +037100 PERFORM DE-LETE. SM2034.2 +037200 COPY-WRITE-1. SM2034.2 +037300 MOVE "COPY ENV DIV REPLAC" TO FEATURE. SM2034.2 +037400 MOVE "COPY-TEST-1 " TO PAR-NAME. SM2034.2 +037500 PERFORM PRINT-DETAIL. SM2034.2 +037600 CLOSE TEST-FILE. SM2034.2 +037700 CCVS-EXIT SECTION. SM2034.2 +037800 CCVS-999999. SM2034.2 +037900 GO TO CLOSE-FILES. SM2034.2 diff --git a/tests/cobol85/SM/SM204A.SUB b/tests/cobol85/SM/SM204A.SUB new file mode 100755 index 00000000..344d3a36 --- /dev/null +++ b/tests/cobol85/SM/SM204A.SUB @@ -0,0 +1,397 @@ +000100 IDENTIFICATION DIVISION. SM2044.2 +000200 PROGRAM-ID. SM2044.2 +000300 SM204A. SM2044.2 +000400**************************************************************** SM2044.2 +000500* * SM2044.2 +000600* VALIDATION FOR:- * SM2044.2 +000700* * SM2044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2044.2 +000900* * SM2044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2044.2 +001100* * SM2044.2 +001200**************************************************************** SM2044.2 +001300* * SM2044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2044.2 +001500* * SM2044.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2044.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2044.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2044.2 +001900* * SM2044.2 +002000**************************************************************** SM2044.2 +002100* * SM2044.2 +002200* SM204A CHECKS THE FILE PRODUCED BY PROGRAM SM203A TO * SM2044.2 +002300* VERIFY THE PROPER EXECUTION OF THE "COPY"ED STATEMENTS * SM2044.2 +002400* IN THAT PROGRAM'S ENVIRONMENT DIVISION. * SM2044.2 +002500* * SM2044.2 +002600**************************************************************** SM2044.2 +002700 ENVIRONMENT DIVISION. SM2044.2 +002800 CONFIGURATION SECTION. SM2044.2 +002900 SOURCE-COMPUTER. SM2044.2 +003000 Linux. SM2044.2 +003100 OBJECT-COMPUTER. SM2044.2 +003200 Linux. SM2044.2 +003300 INPUT-OUTPUT SECTION. SM2044.2 +003400 FILE-CONTROL. SM2044.2 +003500 SELECT PRINT-FILE ASSIGN TO SM2044.2 +003600 "report.log". SM2044.2 +003700 SELECT TEST-FILE ASSIGN TO SM2044.2 +003800* THE FOLLOWING LINE WILL BE CHANGED BY TPF ONLY WHEN THE SM2044.2 +003900* PROGRAM-ID IS PART OF THE REPLACEMENT BY THE X-CARD SM2044.2 +004000* DURING EXTRACTION. SM2044.2 +004100 "XXXXX002". SM2044.2 +004200 DATA DIVISION. SM2044.2 +004300 FILE SECTION. SM2044.2 +004400 FD PRINT-FILE. SM2044.2 +004500 01 PRINT-REC PICTURE X(120). SM2044.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM2044.2 +004700 FD TEST-FILE SM2044.2 +004800 LABEL RECORD STANDARD SM2044.2 +004900*C VALUE OF SM2044.2 +005000*C OCLABELID SM2044.2 +005100*C IS SM2044.2 +005200*C "OCDUMMY" SM2044.2 +005300*G SYSIN SM2044.2 +005400 DATA RECORD PROOF-REC. SM2044.2 +005500 01 PROOF-REC. SM2044.2 +005600 02 TF-1 PICTURE 9(5). SM2044.2 +005700 02 FILLER PICTURE X(115). SM2044.2 +005800 WORKING-STORAGE SECTION. SM2044.2 +005900 01 TEST-RESULTS. SM2044.2 +006000 02 FILLER PIC X VALUE SPACE. SM2044.2 +006100 02 FEATURE PIC X(20) VALUE SPACE. SM2044.2 +006200 02 FILLER PIC X VALUE SPACE. SM2044.2 +006300 02 P-OR-F PIC X(5) VALUE SPACE. SM2044.2 +006400 02 FILLER PIC X VALUE SPACE. SM2044.2 +006500 02 PAR-NAME. SM2044.2 +006600 03 FILLER PIC X(19) VALUE SPACE. SM2044.2 +006700 03 PARDOT-X PIC X VALUE SPACE. SM2044.2 +006800 03 DOTVALUE PIC 99 VALUE ZERO. SM2044.2 +006900 02 FILLER PIC X(8) VALUE SPACE. SM2044.2 +007000 02 RE-MARK PIC X(61). SM2044.2 +007100 01 TEST-COMPUTED. SM2044.2 +007200 02 FILLER PIC X(30) VALUE SPACE. SM2044.2 +007300 02 FILLER PIC X(17) VALUE SM2044.2 +007400 " COMPUTED=". SM2044.2 +007500 02 COMPUTED-X. SM2044.2 +007600 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2044.2 +007700 03 COMPUTED-N REDEFINES COMPUTED-A SM2044.2 +007800 PIC -9(9).9(9). SM2044.2 +007900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2044.2 +008000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2044.2 +008100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2044.2 +008200 03 CM-18V0 REDEFINES COMPUTED-A. SM2044.2 +008300 04 COMPUTED-18V0 PIC -9(18). SM2044.2 +008400 04 FILLER PIC X. SM2044.2 +008500 03 FILLER PIC X(50) VALUE SPACE. SM2044.2 +008600 01 TEST-CORRECT. SM2044.2 +008700 02 FILLER PIC X(30) VALUE SPACE. SM2044.2 +008800 02 FILLER PIC X(17) VALUE " CORRECT =". SM2044.2 +008900 02 CORRECT-X. SM2044.2 +009000 03 CORRECT-A PIC X(20) VALUE SPACE. SM2044.2 +009100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2044.2 +009200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2044.2 +009300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2044.2 +009400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2044.2 +009500 03 CR-18V0 REDEFINES CORRECT-A. SM2044.2 +009600 04 CORRECT-18V0 PIC -9(18). SM2044.2 +009700 04 FILLER PIC X. SM2044.2 +009800 03 FILLER PIC X(2) VALUE SPACE. SM2044.2 +009900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2044.2 +010000 01 CCVS-C-1. SM2044.2 +010100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2044.2 +010200- "SS PARAGRAPH-NAME SM2044.2 +010300- " REMARKS". SM2044.2 +010400 02 FILLER PIC X(20) VALUE SPACE. SM2044.2 +010500 01 CCVS-C-2. SM2044.2 +010600 02 FILLER PIC X VALUE SPACE. SM2044.2 +010700 02 FILLER PIC X(6) VALUE "TESTED". SM2044.2 +010800 02 FILLER PIC X(15) VALUE SPACE. SM2044.2 +010900 02 FILLER PIC X(4) VALUE "FAIL". SM2044.2 +011000 02 FILLER PIC X(94) VALUE SPACE. SM2044.2 +011100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2044.2 +011200 01 REC-CT PIC 99 VALUE ZERO. SM2044.2 +011300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2044.2 +011400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2044.2 +011500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2044.2 +011600 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2044.2 +011700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2044.2 +011800 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2044.2 +011900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2044.2 +012000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2044.2 +012100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2044.2 +012200 01 CCVS-H-1. SM2044.2 +012300 02 FILLER PIC X(39) VALUE SPACES. SM2044.2 +012400 02 FILLER PIC X(42) VALUE SM2044.2 +012500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2044.2 +012600 02 FILLER PIC X(39) VALUE SPACES. SM2044.2 +012700 01 CCVS-H-2A. SM2044.2 +012800 02 FILLER PIC X(40) VALUE SPACE. SM2044.2 +012900 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2044.2 +013000 02 FILLER PIC XXXX VALUE SM2044.2 +013100 "4.2 ". SM2044.2 +013200 02 FILLER PIC X(28) VALUE SM2044.2 +013300 " COPY - NOT FOR DISTRIBUTION". SM2044.2 +013400 02 FILLER PIC X(41) VALUE SPACE. SM2044.2 +013500 SM2044.2 +013600 01 CCVS-H-2B. SM2044.2 +013700 02 FILLER PIC X(15) VALUE SM2044.2 +013800 "TEST RESULT OF ". SM2044.2 +013900 02 TEST-ID PIC X(9). SM2044.2 +014000 02 FILLER PIC X(4) VALUE SM2044.2 +014100 " IN ". SM2044.2 +014200 02 FILLER PIC X(12) VALUE SM2044.2 +014300 " HIGH ". SM2044.2 +014400 02 FILLER PIC X(22) VALUE SM2044.2 +014500 " LEVEL VALIDATION FOR ". SM2044.2 +014600 02 FILLER PIC X(58) VALUE SM2044.2 +014700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2044.2 +014800 01 CCVS-H-3. SM2044.2 +014900 02 FILLER PIC X(34) VALUE SM2044.2 +015000 " FOR OFFICIAL USE ONLY ". SM2044.2 +015100 02 FILLER PIC X(58) VALUE SM2044.2 +015200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2044.2 +015300 02 FILLER PIC X(28) VALUE SM2044.2 +015400 " COPYRIGHT 1985 ". SM2044.2 +015500 01 CCVS-E-1. SM2044.2 +015600 02 FILLER PIC X(52) VALUE SPACE. SM2044.2 +015700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2044.2 +015800 02 ID-AGAIN PIC X(9). SM2044.2 +015900 02 FILLER PIC X(45) VALUE SPACES. SM2044.2 +016000 01 CCVS-E-2. SM2044.2 +016100 02 FILLER PIC X(31) VALUE SPACE. SM2044.2 +016200 02 FILLER PIC X(21) VALUE SPACE. SM2044.2 +016300 02 CCVS-E-2-2. SM2044.2 +016400 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2044.2 +016500 03 FILLER PIC X VALUE SPACE. SM2044.2 +016600 03 ENDER-DESC PIC X(44) VALUE SM2044.2 +016700 "ERRORS ENCOUNTERED". SM2044.2 +016800 01 CCVS-E-3. SM2044.2 +016900 02 FILLER PIC X(22) VALUE SM2044.2 +017000 " FOR OFFICIAL USE ONLY". SM2044.2 +017100 02 FILLER PIC X(12) VALUE SPACE. SM2044.2 +017200 02 FILLER PIC X(58) VALUE SM2044.2 +017300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2044.2 +017400 02 FILLER PIC X(13) VALUE SPACE. SM2044.2 +017500 02 FILLER PIC X(15) VALUE SM2044.2 +017600 " COPYRIGHT 1985". SM2044.2 +017700 01 CCVS-E-4. SM2044.2 +017800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2044.2 +017900 02 FILLER PIC X(4) VALUE " OF ". SM2044.2 +018000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2044.2 +018100 02 FILLER PIC X(40) VALUE SM2044.2 +018200 " TESTS WERE EXECUTED SUCCESSFULLY". SM2044.2 +018300 01 XXINFO. SM2044.2 +018400 02 FILLER PIC X(19) VALUE SM2044.2 +018500 "*** INFORMATION ***". SM2044.2 +018600 02 INFO-TEXT. SM2044.2 +018700 04 FILLER PIC X(8) VALUE SPACE. SM2044.2 +018800 04 XXCOMPUTED PIC X(20). SM2044.2 +018900 04 FILLER PIC X(5) VALUE SPACE. SM2044.2 +019000 04 XXCORRECT PIC X(20). SM2044.2 +019100 02 INF-ANSI-REFERENCE PIC X(48). SM2044.2 +019200 01 HYPHEN-LINE. SM2044.2 +019300 02 FILLER PIC IS X VALUE IS SPACE. SM2044.2 +019400 02 FILLER PIC IS X(65) VALUE IS "************************SM2044.2 +019500- "*****************************************". SM2044.2 +019600 02 FILLER PIC IS X(54) VALUE IS "************************SM2044.2 +019700- "******************************". SM2044.2 +019800 01 CCVS-PGM-ID PIC X(9) VALUE SM2044.2 +019900 "SM204A". SM2044.2 +020000 PROCEDURE DIVISION. SM2044.2 +020100 CCVS1 SECTION. SM2044.2 +020200 OPEN-FILES. SM2044.2 +020300 OPEN OUTPUT PRINT-FILE. SM2044.2 +020400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2044.2 +020500 MOVE SPACE TO TEST-RESULTS. SM2044.2 +020600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2044.2 +020700 GO TO CCVS1-EXIT. SM2044.2 +020800 CLOSE-FILES. SM2044.2 +020900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2044.2 +021000 TERMINATE-CCVS. SM2044.2 +021100*S EXIT PROGRAM. SM2044.2 +021200*SERMINATE-CALL. SM2044.2 +021300 STOP RUN. SM2044.2 +021400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2044.2 +021500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2044.2 +021600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2044.2 +021700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2044.2 +021800 MOVE "****TEST DELETED****" TO RE-MARK. SM2044.2 +021900 PRINT-DETAIL. SM2044.2 +022000 IF REC-CT NOT EQUAL TO ZERO SM2044.2 +022100 MOVE "." TO PARDOT-X SM2044.2 +022200 MOVE REC-CT TO DOTVALUE. SM2044.2 +022300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2044.2 +022400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2044.2 +022500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2044.2 +022600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2044.2 +022700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2044.2 +022800 MOVE SPACE TO CORRECT-X. SM2044.2 +022900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2044.2 +023000 MOVE SPACE TO RE-MARK. SM2044.2 +023100 HEAD-ROUTINE. SM2044.2 +023200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +023300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +023400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2044.2 +023500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2044.2 +023600 COLUMN-NAMES-ROUTINE. SM2044.2 +023700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +023800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +023900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +024000 END-ROUTINE. SM2044.2 +024100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2044.2 +024200 END-RTN-EXIT. SM2044.2 +024300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +024400 END-ROUTINE-1. SM2044.2 +024500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2044.2 +024600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2044.2 +024700 ADD PASS-COUNTER TO ERROR-HOLD. SM2044.2 +024800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2044.2 +024900 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2044.2 +025000 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2044.2 +025100 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2044.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2044.2 +025300 END-ROUTINE-12. SM2044.2 +025400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2044.2 +025500 IF ERROR-COUNTER IS EQUAL TO ZERO SM2044.2 +025600 MOVE "NO " TO ERROR-TOTAL SM2044.2 +025700 ELSE SM2044.2 +025800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2044.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2044.2 +026000 PERFORM WRITE-LINE. SM2044.2 +026100 END-ROUTINE-13. SM2044.2 +026200 IF DELETE-COUNTER IS EQUAL TO ZERO SM2044.2 +026300 MOVE "NO " TO ERROR-TOTAL ELSE SM2044.2 +026400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2044.2 +026500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2044.2 +026600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +026700 IF INSPECT-COUNTER EQUAL TO ZERO SM2044.2 +026800 MOVE "NO " TO ERROR-TOTAL SM2044.2 +026900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2044.2 +027000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2044.2 +027100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +027200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2044.2 +027300 WRITE-LINE. SM2044.2 +027400 ADD 1 TO RECORD-COUNT. SM2044.2 +027500 IF RECORD-COUNT GREATER 50 SM2044.2 +027600 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2044.2 +027700 MOVE SPACE TO DUMMY-RECORD SM2044.2 +027800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2044.2 +027900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2044.2 +028000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2044.2 +028100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2044.2 +028200 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2044.2 +028300 MOVE ZERO TO RECORD-COUNT. SM2044.2 +028400 PERFORM WRT-LN. SM2044.2 +028500 WRT-LN. SM2044.2 +028600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2044.2 +028700 MOVE SPACE TO DUMMY-RECORD. SM2044.2 +028800 BLANK-LINE-PRINT. SM2044.2 +028900 PERFORM WRT-LN. SM2044.2 +029000 FAIL-ROUTINE. SM2044.2 +029100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2044.2 +029200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2044.2 +029300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2044.2 +029400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2044.2 +029500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +029600 MOVE SPACES TO INF-ANSI-REFERENCE. SM2044.2 +029700 GO TO FAIL-ROUTINE-EX. SM2044.2 +029800 FAIL-ROUTINE-WRITE. SM2044.2 +029900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2044.2 +030000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2044.2 +030100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2044.2 +030200 MOVE SPACES TO COR-ANSI-REFERENCE. SM2044.2 +030300 FAIL-ROUTINE-EX. EXIT. SM2044.2 +030400 BAIL-OUT. SM2044.2 +030500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2044.2 +030600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2044.2 +030700 BAIL-OUT-WRITE. SM2044.2 +030800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2044.2 +030900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2044.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2044.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. SM2044.2 +031200 BAIL-OUT-EX. EXIT. SM2044.2 +031300 CCVS1-EXIT. SM2044.2 +031400 EXIT. SM2044.2 +031500 INITIALIZATION SECTION. SM2044.2 +031600 SM204-INIT. SM2044.2 +031700 OPEN INPUT TEST-FILE. SM2044.2 +031800 MOVE "ALL TESTS IN SM204A CHECK" TO RE-MARK. SM2044.2 +031900 PERFORM PRINT-DETAIL. SM2044.2 +032000 MOVE "OUTPUT OF SM203A." TO RE-MARK. SM2044.2 +032100 PERFORM PRINT-DETAIL. SM2044.2 +032200 MOVE "COPY ENV DIV REPLAC" TO FEATURE. SM2044.2 +032300 COPY-TEST-2. SM2044.2 +032400 PERFORM READ-TEST-FILE. SM2044.2 +032500 IF TF-1 EQUAL TO 97532 SM2044.2 +032600 PERFORM PASS GO TO COPY-WRITE-2. SM2044.2 +032700 GO TO COPY-FAIL-2. SM2044.2 +032800 COPY-DELETE-2. SM2044.2 +032900 PERFORM DE-LETE. SM2044.2 +033000 GO TO COPY-WRITE-2. SM2044.2 +033100 COPY-FAIL-2. SM2044.2 +033200 MOVE TF-1 TO COMPUTED-N. SM2044.2 +033300 MOVE 97532 TO CORRECT-N. SM2044.2 +033400 PERFORM FAIL. SM2044.2 +033500 COPY-WRITE-2. SM2044.2 +033600 MOVE "COPY-TEST-2 " TO PAR-NAME. SM2044.2 +033700 PERFORM PRINT-DETAIL. SM2044.2 +033800 COPY-TEST-3. SM2044.2 +033900 PERFORM READ-TEST-FILE. SM2044.2 +034000 IF TF-1 EQUAL TO 23479 SM2044.2 +034100 PERFORM PASS GO TO COPY-WRITE-3. SM2044.2 +034200 GO TO COPY-FAIL-3. SM2044.2 +034300 COPY-DELETE-3. SM2044.2 +034400 PERFORM DE-LETE. SM2044.2 +034500 GO TO COPY-WRITE-3. SM2044.2 +034600 COPY-FAIL-3. SM2044.2 +034700 MOVE TF-1 TO COMPUTED-N. SM2044.2 +034800 MOVE 23479 TO CORRECT-N. SM2044.2 +034900 PERFORM FAIL. SM2044.2 +035000 COPY-WRITE-3. SM2044.2 +035100 MOVE "COPY-TEST-3 " TO PAR-NAME. SM2044.2 +035200 PERFORM PRINT-DETAIL. SM2044.2 +035300 COPY-TEST-4. SM2044.2 +035400 PERFORM READ-TEST-FILE 3 TIMES. SM2044.2 +035500 IF TF-1 EQUAL TO 14003 SM2044.2 +035600 PERFORM PASS GO TO COPY-WRITE-4. SM2044.2 +035700 GO TO COPY-FAIL-4. SM2044.2 +035800 COPY-DELETE-4. SM2044.2 +035900 PERFORM DE-LETE. SM2044.2 +036000 GO TO COPY-WRITE-4. SM2044.2 +036100 COPY-FAIL-4. SM2044.2 +036200 MOVE TF-1 TO COMPUTED-N. SM2044.2 +036300 MOVE 14003 TO CORRECT-N. SM2044.2 +036400 PERFORM FAIL. SM2044.2 +036500 COPY-WRITE-4. SM2044.2 +036600 MOVE "COPY-TEST-4 " TO PAR-NAME. SM2044.2 +036700 PERFORM PRINT-DETAIL. SM2044.2 +036800 COPY-TEST-5. SM2044.2 +036900 PERFORM READ-TEST-FILE 2 TIMES. SM2044.2 +037000 IF TF-1 EQUAL TO 03543 SM2044.2 +037100 PERFORM PASS GO TO COPY-WRITE-5. SM2044.2 +037200 GO TO COPY-FAIL-5. SM2044.2 +037300 COPY-DELETE-5. SM2044.2 +037400 PERFORM DE-LETE. SM2044.2 +037500 GO TO COPY-WRITE-5. SM2044.2 +037600 COPY-FAIL-5. SM2044.2 +037700 MOVE TF-1 TO COMPUTED-N. SM2044.2 +037800 MOVE 03543 TO CORRECT-N. SM2044.2 +037900 PERFORM FAIL. SM2044.2 +038000 COPY-WRITE-5. SM2044.2 +038100 MOVE "COPY SPECIAL-NAMES" TO FEATURE. SM2044.2 +038200 MOVE "COPY-TEST-5 " TO PAR-NAME. SM2044.2 +038300 PERFORM PRINT-DETAIL. SM2044.2 +038400 CLOSE TEST-FILE. SM2044.2 +038500 GO TO CCVS-EXIT. SM2044.2 +038600 READ-TEST-FILE. SM2044.2 +038700 READ TEST-FILE AT END GO TO BAD-FILE. SM2044.2 +038800 BAD-FILE. SM2044.2 +038900 PERFORM FAIL. SM2044.2 +039000 MOVE "BAD-FILE" TO PAR-NAME. SM2044.2 +039100 MOVE "EOF FOUND PREMATURELY" TO RE-MARK. SM2044.2 +039200 PERFORM PRINT-DETAIL. SM2044.2 +039300 CLOSE TEST-FILE. SM2044.2 +039400 GO TO CCVS-EXIT. SM2044.2 +039500 CCVS-EXIT SECTION. SM2044.2 +039600 CCVS-999999. SM2044.2 +039700 GO TO CLOSE-FILES. SM2044.2 diff --git a/tests/cobol85/SM/SM205A.CBL b/tests/cobol85/SM/SM205A.CBL new file mode 100755 index 00000000..ef30e2c0 --- /dev/null +++ b/tests/cobol85/SM/SM205A.CBL @@ -0,0 +1,621 @@ +000100 IDENTIFICATION DIVISION. SM2054.2 +000200 PROGRAM-ID. SM2054.2 +000300 SM205A. SM2054.2 +000400**************************************************************** SM2054.2 +000500* * SM2054.2 +000600* VALIDATION FOR:- * SM2054.2 +000700* * SM2054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2054.2 +000900* * SM2054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2054.2 +001100* * SM2054.2 +001200**************************************************************** SM2054.2 +001300* * SM2054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2054.2 +001500* * SM2054.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2054.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2054.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2054.2 +001900* * SM2054.2 +002000**************************************************************** SM2054.2 +002100* * SM2054.2 +002200* PROGRAM SM205A TESTS THE USE OF THE "COPY" STATEMENT WITH * SM2054.2 +002300* ITS "REPLACING" PHRASE FOR A SORT DESCRIPTION AND RELATED * SM2054.2 +002400* ENTRIES. (THIS PROGRAM ASSUMES THAT PROGRAM ST101 * SM2054.2 +002500* PERFORMS CORRECTLY). * SM2054.2 +002600* * SM2054.2 +002700**************************************************************** SM2054.2 +002800 ENVIRONMENT DIVISION. SM2054.2 +002900 CONFIGURATION SECTION. SM2054.2 +003000 SOURCE-COMPUTER. SM2054.2 +003100 Linux. SM2054.2 +003200 OBJECT-COMPUTER. SM2054.2 +003300 Linux. SM2054.2 +003400 INPUT-OUTPUT SECTION. SM2054.2 +003500 FILE-CONTROL. SM2054.2 +003600 SELECT PRINT-FILE ASSIGN TO SM2054.2 +003700 "report.log". SM2054.2 +003800 SELECT SORTFILE-2E ASSIGN TO SM2054.2 +003900 "XXXXX027". SM2054.2 +004000 SELECT SORTOUT-2E ASSIGN TO SM2054.2 +004100 "XXXXX001". SM2054.2 +004200 DATA DIVISION. SM2054.2 +004300 FILE SECTION. SM2054.2 +004400 FD PRINT-FILE. SM2054.2 +004500 01 PRINT-REC PICTURE X(120). SM2054.2 +004600 01 DUMMY-RECORD PICTURE X(120). SM2054.2 +004700 SM2054.2 +004800 SM2054.2 +004900 SM2054.2 +005000 SM2054.2 +005100 SM2054.2 +005200* SM2054.2 +005300*********************** COPY STATEMENT USED **********************SM2054.2 +005400* SM2054.2 +005500*SD SORTFILE-2E COPY K5SDB SM2054.2 +005600* REPLACING J-RECORD BY S-RECORD. SM2054.2 +005700* SM2054.2 +005800******************** COPIED TEXT BEGINS BELOW ********************SM2054.2 +005900 SD SORTFILE-2E COPY K5SDB SM2054.2 +006000 REPLACING J-RECORD BY S-RECORD. SM2054.2 +006100*********************** END OF COPIED TEXT ***********************SM2054.2 +006200 SM2054.2 +006300 SM2054.2 +006400 SM2054.2 +006500 SM2054.2 +006600 SM2054.2 +006700* SM2054.2 +006800*********************** COPY STATEMENT USED **********************SM2054.2 +006900* SM2054.2 +007000*01 S-RECORD. COPY K501B SM2054.2 +007100* REPLACING KEY-A BY KEY-1 SM2054.2 +007200* XYZ-KEYS BY RDF-KEYS. SM2054.2 +007300* SM2054.2 +007400******************** COPIED TEXT BEGINS BELOW ********************SM2054.2 +007500 01 S-RECORD. COPY K501B SM2054.2 +007600 REPLACING KEY-A BY KEY-1 SM2054.2 +007700 XYZ-KEYS BY RDF-KEYS. SM2054.2 +007800*********************** END OF COPIED TEXT ***********************SM2054.2 +007900 FD SORTOUT-2E SM2054.2 +008000 BLOCK CONTAINS 10 RECORDS SM2054.2 +008100 LABEL RECORDS ARE STANDARD SM2054.2 +008200*C VALUE OF SM2054.2 +008300*C OCLABELID SM2054.2 +008400*C IS SM2054.2 +008500*C "OCDUMMY" SM2054.2 +008600*G SYSIN SM2054.2 +008700 DATA RECORD SORTED. SM2054.2 +008800 01 SORTED PICTURE X(120). SM2054.2 +008900 WORKING-STORAGE SECTION. SM2054.2 +009000 77 C0 PICTURE 9 VALUE 0. SM2054.2 +009100 77 C1 PICTURE 9 VALUE 1. SM2054.2 +009200 77 C2 PICTURE 9 VALUE 2. SM2054.2 +009300 77 C6 PICTURE 9 VALUE 6. SM2054.2 +009400 77 C3 PICTURE 9 VALUE 3. SM2054.2 +009500 01 WKEYS-GROUP. SM2054.2 +009600 02 WKEY-1 PICTURE 9. SM2054.2 +009700 02 WKEY-2 PICTURE 99. SM2054.2 +009800 02 WKEY-3 PICTURE 999. SM2054.2 +009900 02 WKEY-4 PICTURE 9999. SM2054.2 +010000 02 WKEY-5 PICTURE 9(5). SM2054.2 +010100 01 WKEYS-RDF REDEFINES WKEYS-GROUP PICTURE 9(15). SM2054.2 +010200 01 TEST-RESULTS. SM2054.2 +010300 02 FILLER PIC X VALUE SPACE. SM2054.2 +010400 02 FEATURE PIC X(20) VALUE SPACE. SM2054.2 +010500 02 FILLER PIC X VALUE SPACE. SM2054.2 +010600 02 P-OR-F PIC X(5) VALUE SPACE. SM2054.2 +010700 02 FILLER PIC X VALUE SPACE. SM2054.2 +010800 02 PAR-NAME. SM2054.2 +010900 03 FILLER PIC X(19) VALUE SPACE. SM2054.2 +011000 03 PARDOT-X PIC X VALUE SPACE. SM2054.2 +011100 03 DOTVALUE PIC 99 VALUE ZERO. SM2054.2 +011200 02 FILLER PIC X(8) VALUE SPACE. SM2054.2 +011300 02 RE-MARK PIC X(61). SM2054.2 +011400 01 TEST-COMPUTED. SM2054.2 +011500 02 FILLER PIC X(30) VALUE SPACE. SM2054.2 +011600 02 FILLER PIC X(17) VALUE SM2054.2 +011700 " COMPUTED=". SM2054.2 +011800 02 COMPUTED-X. SM2054.2 +011900 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2054.2 +012000 03 COMPUTED-N REDEFINES COMPUTED-A SM2054.2 +012100 PIC -9(9).9(9). SM2054.2 +012200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2054.2 +012300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2054.2 +012400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2054.2 +012500 03 CM-18V0 REDEFINES COMPUTED-A. SM2054.2 +012600 04 COMPUTED-18V0 PIC -9(18). SM2054.2 +012700 04 FILLER PIC X. SM2054.2 +012800 03 FILLER PIC X(50) VALUE SPACE. SM2054.2 +012900 01 TEST-CORRECT. SM2054.2 +013000 02 FILLER PIC X(30) VALUE SPACE. SM2054.2 +013100 02 FILLER PIC X(17) VALUE " CORRECT =". SM2054.2 +013200 02 CORRECT-X. SM2054.2 +013300 03 CORRECT-A PIC X(20) VALUE SPACE. SM2054.2 +013400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2054.2 +013500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2054.2 +013600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2054.2 +013700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2054.2 +013800 03 CR-18V0 REDEFINES CORRECT-A. SM2054.2 +013900 04 CORRECT-18V0 PIC -9(18). SM2054.2 +014000 04 FILLER PIC X. SM2054.2 +014100 03 FILLER PIC X(2) VALUE SPACE. SM2054.2 +014200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2054.2 +014300 01 CCVS-C-1. SM2054.2 +014400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2054.2 +014500- "SS PARAGRAPH-NAME SM2054.2 +014600- " REMARKS". SM2054.2 +014700 02 FILLER PIC X(20) VALUE SPACE. SM2054.2 +014800 01 CCVS-C-2. SM2054.2 +014900 02 FILLER PIC X VALUE SPACE. SM2054.2 +015000 02 FILLER PIC X(6) VALUE "TESTED". SM2054.2 +015100 02 FILLER PIC X(15) VALUE SPACE. SM2054.2 +015200 02 FILLER PIC X(4) VALUE "FAIL". SM2054.2 +015300 02 FILLER PIC X(94) VALUE SPACE. SM2054.2 +015400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2054.2 +015500 01 REC-CT PIC 99 VALUE ZERO. SM2054.2 +015600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2054.2 +015700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2054.2 +015800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2054.2 +015900 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2054.2 +016000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2054.2 +016100 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2054.2 +016200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2054.2 +016300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2054.2 +016400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2054.2 +016500 01 CCVS-H-1. SM2054.2 +016600 02 FILLER PIC X(39) VALUE SPACES. SM2054.2 +016700 02 FILLER PIC X(42) VALUE SM2054.2 +016800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2054.2 +016900 02 FILLER PIC X(39) VALUE SPACES. SM2054.2 +017000 01 CCVS-H-2A. SM2054.2 +017100 02 FILLER PIC X(40) VALUE SPACE. SM2054.2 +017200 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2054.2 +017300 02 FILLER PIC XXXX VALUE SM2054.2 +017400 "4.2 ". SM2054.2 +017500 02 FILLER PIC X(28) VALUE SM2054.2 +017600 " COPY - NOT FOR DISTRIBUTION". SM2054.2 +017700 02 FILLER PIC X(41) VALUE SPACE. SM2054.2 +017800 SM2054.2 +017900 01 CCVS-H-2B. SM2054.2 +018000 02 FILLER PIC X(15) VALUE SM2054.2 +018100 "TEST RESULT OF ". SM2054.2 +018200 02 TEST-ID PIC X(9). SM2054.2 +018300 02 FILLER PIC X(4) VALUE SM2054.2 +018400 " IN ". SM2054.2 +018500 02 FILLER PIC X(12) VALUE SM2054.2 +018600 " HIGH ". SM2054.2 +018700 02 FILLER PIC X(22) VALUE SM2054.2 +018800 " LEVEL VALIDATION FOR ". SM2054.2 +018900 02 FILLER PIC X(58) VALUE SM2054.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2054.2 +019100 01 CCVS-H-3. SM2054.2 +019200 02 FILLER PIC X(34) VALUE SM2054.2 +019300 " FOR OFFICIAL USE ONLY ". SM2054.2 +019400 02 FILLER PIC X(58) VALUE SM2054.2 +019500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2054.2 +019600 02 FILLER PIC X(28) VALUE SM2054.2 +019700 " COPYRIGHT 1985 ". SM2054.2 +019800 01 CCVS-E-1. SM2054.2 +019900 02 FILLER PIC X(52) VALUE SPACE. SM2054.2 +020000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2054.2 +020100 02 ID-AGAIN PIC X(9). SM2054.2 +020200 02 FILLER PIC X(45) VALUE SPACES. SM2054.2 +020300 01 CCVS-E-2. SM2054.2 +020400 02 FILLER PIC X(31) VALUE SPACE. SM2054.2 +020500 02 FILLER PIC X(21) VALUE SPACE. SM2054.2 +020600 02 CCVS-E-2-2. SM2054.2 +020700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2054.2 +020800 03 FILLER PIC X VALUE SPACE. SM2054.2 +020900 03 ENDER-DESC PIC X(44) VALUE SM2054.2 +021000 "ERRORS ENCOUNTERED". SM2054.2 +021100 01 CCVS-E-3. SM2054.2 +021200 02 FILLER PIC X(22) VALUE SM2054.2 +021300 " FOR OFFICIAL USE ONLY". SM2054.2 +021400 02 FILLER PIC X(12) VALUE SPACE. SM2054.2 +021500 02 FILLER PIC X(58) VALUE SM2054.2 +021600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2054.2 +021700 02 FILLER PIC X(13) VALUE SPACE. SM2054.2 +021800 02 FILLER PIC X(15) VALUE SM2054.2 +021900 " COPYRIGHT 1985". SM2054.2 +022000 01 CCVS-E-4. SM2054.2 +022100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2054.2 +022200 02 FILLER PIC X(4) VALUE " OF ". SM2054.2 +022300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2054.2 +022400 02 FILLER PIC X(40) VALUE SM2054.2 +022500 " TESTS WERE EXECUTED SUCCESSFULLY". SM2054.2 +022600 01 XXINFO. SM2054.2 +022700 02 FILLER PIC X(19) VALUE SM2054.2 +022800 "*** INFORMATION ***". SM2054.2 +022900 02 INFO-TEXT. SM2054.2 +023000 04 FILLER PIC X(8) VALUE SPACE. SM2054.2 +023100 04 XXCOMPUTED PIC X(20). SM2054.2 +023200 04 FILLER PIC X(5) VALUE SPACE. SM2054.2 +023300 04 XXCORRECT PIC X(20). SM2054.2 +023400 02 INF-ANSI-REFERENCE PIC X(48). SM2054.2 +023500 01 HYPHEN-LINE. SM2054.2 +023600 02 FILLER PIC IS X VALUE IS SPACE. SM2054.2 +023700 02 FILLER PIC IS X(65) VALUE IS "************************SM2054.2 +023800- "*****************************************". SM2054.2 +023900 02 FILLER PIC IS X(54) VALUE IS "************************SM2054.2 +024000- "******************************". SM2054.2 +024100 01 CCVS-PGM-ID PIC X(9) VALUE SM2054.2 +024200 "SM205A". SM2054.2 +024300 PROCEDURE DIVISION. SM2054.2 +024400 CCVS1 SECTION. SM2054.2 +024500 OPEN-FILES. SM2054.2 +024600 OPEN OUTPUT PRINT-FILE. SM2054.2 +024700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2054.2 +024800 MOVE SPACE TO TEST-RESULTS. SM2054.2 +024900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2054.2 +025000 GO TO CCVS1-EXIT. SM2054.2 +025100 CLOSE-FILES. SM2054.2 +025200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2054.2 +025300 TERMINATE-CCVS. SM2054.2 +025400*S EXIT PROGRAM. SM2054.2 +025500*SERMINATE-CALL. SM2054.2 +025600 STOP RUN. SM2054.2 +025700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2054.2 +025800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2054.2 +025900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2054.2 +026000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2054.2 +026100 MOVE "****TEST DELETED****" TO RE-MARK. SM2054.2 +026200 PRINT-DETAIL. SM2054.2 +026300 IF REC-CT NOT EQUAL TO ZERO SM2054.2 +026400 MOVE "." TO PARDOT-X SM2054.2 +026500 MOVE REC-CT TO DOTVALUE. SM2054.2 +026600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2054.2 +026700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2054.2 +026800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2054.2 +026900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2054.2 +027000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2054.2 +027100 MOVE SPACE TO CORRECT-X. SM2054.2 +027200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2054.2 +027300 MOVE SPACE TO RE-MARK. SM2054.2 +027400 HEAD-ROUTINE. SM2054.2 +027500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +027600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +027700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2054.2 +027800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2054.2 +027900 COLUMN-NAMES-ROUTINE. SM2054.2 +028000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +028100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +028200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +028300 END-ROUTINE. SM2054.2 +028400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2054.2 +028500 END-RTN-EXIT. SM2054.2 +028600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +028700 END-ROUTINE-1. SM2054.2 +028800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2054.2 +028900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2054.2 +029000 ADD PASS-COUNTER TO ERROR-HOLD. SM2054.2 +029100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2054.2 +029200 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2054.2 +029300 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2054.2 +029400 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2054.2 +029500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2054.2 +029600 END-ROUTINE-12. SM2054.2 +029700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2054.2 +029800 IF ERROR-COUNTER IS EQUAL TO ZERO SM2054.2 +029900 MOVE "NO " TO ERROR-TOTAL SM2054.2 +030000 ELSE SM2054.2 +030100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2054.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2054.2 +030300 PERFORM WRITE-LINE. SM2054.2 +030400 END-ROUTINE-13. SM2054.2 +030500 IF DELETE-COUNTER IS EQUAL TO ZERO SM2054.2 +030600 MOVE "NO " TO ERROR-TOTAL ELSE SM2054.2 +030700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2054.2 +030800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2054.2 +030900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +031000 IF INSPECT-COUNTER EQUAL TO ZERO SM2054.2 +031100 MOVE "NO " TO ERROR-TOTAL SM2054.2 +031200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2054.2 +031300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2054.2 +031400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +031500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2054.2 +031600 WRITE-LINE. SM2054.2 +031700 ADD 1 TO RECORD-COUNT. SM2054.2 +031800 IF RECORD-COUNT GREATER 50 SM2054.2 +031900 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2054.2 +032000 MOVE SPACE TO DUMMY-RECORD SM2054.2 +032100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2054.2 +032200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2054.2 +032300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2054.2 +032400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2054.2 +032500 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2054.2 +032600 MOVE ZERO TO RECORD-COUNT. SM2054.2 +032700 PERFORM WRT-LN. SM2054.2 +032800 WRT-LN. SM2054.2 +032900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2054.2 +033000 MOVE SPACE TO DUMMY-RECORD. SM2054.2 +033100 BLANK-LINE-PRINT. SM2054.2 +033200 PERFORM WRT-LN. SM2054.2 +033300 FAIL-ROUTINE. SM2054.2 +033400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2054.2 +033500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2054.2 +033600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2054.2 +033700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2054.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. SM2054.2 +034000 GO TO FAIL-ROUTINE-EX. SM2054.2 +034100 FAIL-ROUTINE-WRITE. SM2054.2 +034200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2054.2 +034300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2054.2 +034400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2054.2 +034500 MOVE SPACES TO COR-ANSI-REFERENCE. SM2054.2 +034600 FAIL-ROUTINE-EX. EXIT. SM2054.2 +034700 BAIL-OUT. SM2054.2 +034800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2054.2 +034900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2054.2 +035000 BAIL-OUT-WRITE. SM2054.2 +035100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2054.2 +035200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2054.2 +035300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2054.2 +035400 MOVE SPACES TO INF-ANSI-REFERENCE. SM2054.2 +035500 BAIL-OUT-EX. EXIT. SM2054.2 +035600 CCVS1-EXIT. SM2054.2 +035700 EXIT. SM2054.2 +035800 SORT-INIT SECTION. SM2054.2 +035900 I-1. SM2054.2 +036000 SORT SORTFILE-2E SM2054.2 +036100 ON ASCENDING KEY KEY-1 SM2054.2 +036200 ON DESCENDING KEY KEY-2 SM2054.2 +036300 ON ASCENDING KEY KEY-3 SM2054.2 +036400 DESCENDING KEY-4 KEY-5 SM2054.2 +036500 INPUT PROCEDURE IS INSORT SM2054.2 +036600 OUTPUT PROCEDURE IS OUTP1 THRU OUTP3. SM2054.2 +036700 I-2. SM2054.2 +036800 GO TO CLOSE-FILES. SM2054.2 +036900 INSORT SECTION. SM2054.2 +037000 IN-1. SM2054.2 +037100* NOTE TESTS ORDINARY COPYING OF ENTRIES WHICH ARE ALSO SM2054.2 +037200* COPIED WITH REPLACEMENT. SM2054.2 +037300 IN-2. SM2054.2 +037400 MOVE 900009000000000 TO RDF-KEYS. SM2054.2 +037500 RELEASE S-RECORD. SM2054.2 +037600 MOVE 009000000900009 TO RDF-KEYS. SM2054.2 +037700 RELEASE S-RECORD. SM2054.2 +037800 MOVE 900008000000000 TO RDF-KEYS. SM2054.2 +037900 RELEASE S-RECORD. SM2054.2 +038000 MOVE 009000000900008 TO RDF-KEYS. SM2054.2 +038100 RELEASE S-RECORD. SM2054.2 +038200* NOTE HI-LOW CONTROL RECORDS DONE. SM2054.2 +038300 MOVE 300003000000000 TO WKEYS-RDF. SM2054.2 +038400 IN-3. SM2054.2 +038500 PERFORM IN-4 2 TIMES. SM2054.2 +038600 GO TO IN-EXIT. SM2054.2 +038700 IN-4. SM2054.2 +038800 SUBTRACT C1 FROM WKEY-1. SM2054.2 +038900 PERFORM IN-5 6 TIMES. SM2054.2 +039000 IN-5. SM2054.2 +039100 IF WKEY-2 IS EQUAL TO C6 SM2054.2 +039200 MOVE C0 TO WKEY-2. SM2054.2 +039300 ADD C1 TO WKEY-2. SM2054.2 +039400 PERFORM IN-6 2 TIMES. SM2054.2 +039500 IN-6. SM2054.2 +039600 IF WKEY-3 IS EQUAL TO C1 SM2054.2 +039700 MOVE C3 TO WKEY-3. SM2054.2 +039800 SUBTRACT C1 FROM WKEY-3. SM2054.2 +039900 PERFORM IN-7 2 TIMES. SM2054.2 +040000 IN-7. SM2054.2 +040100 IF WKEY-4 EQUAL TO C2 SM2054.2 +040200 MOVE C0 TO WKEY-4. SM2054.2 +040300 ADD C1 TO WKEY-4. SM2054.2 +040400 PERFORM IN-8 2 TIMES. SM2054.2 +040500 IN-8. SM2054.2 +040600 IF WKEY-5 IS EQUAL TO C2 SM2054.2 +040700 MOVE C0 TO WKEY-5. SM2054.2 +040800 ADD C1 TO WKEY-5. SM2054.2 +040900 MOVE WKEYS-RDF TO RDF-KEYS. SM2054.2 +041000 RELEASE S-RECORD. SM2054.2 +041100 IN-EXIT. SM2054.2 +041200 EXIT. SM2054.2 +041300 OUTP1 SECTION. SM2054.2 +041400 WOUTPT1. SM2054.2 +041500 OPEN OUTPUT SORTOUT-2E. SM2054.2 +041600 MOVE SPACE TO TEST-RESULTS. SM2054.2 +041700 MOVE "COPY SD REPLACING" TO FEATURE. SM2054.2 +041800 COPY-TEST-1. SM2054.2 +041900 PERFORM RET-1. SM2054.2 +042000 IF RDF-KEYS EQUAL TO 009000000900009 SM2054.2 +042100 PERFORM PASS-1 GO TO COPY-WRITE-1. SM2054.2 +042200 GO TO COPY-FAIL-1-1. SM2054.2 +042300 COPY-DELETE-1. SM2054.2 +042400 PERFORM DE-LETE-1. SM2054.2 +042500 GO TO COPY-WRITE-1. SM2054.2 +042600 COPY-FAIL-1-1. SM2054.2 +042700 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +042800 MOVE 009000000900009 TO CORRECT-18V0. SM2054.2 +042900 PERFORM FAIL-1. SM2054.2 +043000 COPY-WRITE-1. SM2054.2 +043100 MOVE "COPY-TEST-1 " TO PAR-NAME. SM2054.2 +043200 PERFORM PRINT-DETAIL-1. SM2054.2 +043300 COPY-TEST-2. SM2054.2 +043400 PERFORM RET-1. SM2054.2 +043500 IF RDF-KEYS EQUAL TO 009000000900008 SM2054.2 +043600 PERFORM PASS-1 GO TO COPY-WRITE-2. SM2054.2 +043700 GO TO COPY-FAIL-1-2. SM2054.2 +043800 COPY-DELETE-2. SM2054.2 +043900 PERFORM DE-LETE-1. SM2054.2 +044000 GO TO COPY-WRITE-2. SM2054.2 +044100 COPY-FAIL-1-2. SM2054.2 +044200 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +044300 MOVE 009000000900008 TO CORRECT-18V0. SM2054.2 +044400 PERFORM FAIL-1. SM2054.2 +044500 COPY-WRITE-2. SM2054.2 +044600 MOVE "COPY-TEST-2 " TO PAR-NAME. SM2054.2 +044700 PERFORM PRINT-DETAIL-1. SM2054.2 +044800 COPY-TEST-3. SM2054.2 +044900 PERFORM RET-1. SM2054.2 +045000 IF RDF-KEYS EQUAL TO 106001000200002 SM2054.2 +045100 PERFORM PASS-1 GO TO COPY-WRITE-3. SM2054.2 +045200 GO TO COPY-FAIL-1-3. SM2054.2 +045300 COPY-DELETE-3. SM2054.2 +045400 PERFORM DE-LETE-1. SM2054.2 +045500 GO TO COPY-WRITE-3. SM2054.2 +045600 COPY-FAIL-1-3. SM2054.2 +045700 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +045800 MOVE 106001000200002 TO CORRECT-18V0. SM2054.2 +045900 PERFORM FAIL-1. SM2054.2 +046000 COPY-WRITE-3. SM2054.2 +046100 MOVE "COPY-TEST-3 " TO PAR-NAME. SM2054.2 +046200 PERFORM PRINT-DETAIL-1. SM2054.2 +046300 COPY-TEST-4. SM2054.2 +046400 PERFORM RET-2 48 TIMES. SM2054.2 +046500 IF RDF-KEYS EQUAL TO 206001000200002 SM2054.2 +046600 PERFORM PASS-1 GO TO COPY-WRITE-4. SM2054.2 +046700 GO TO COPY-FAIL-1-4. SM2054.2 +046800 COPY-DELETE-4. SM2054.2 +046900 PERFORM DE-LETE-1. SM2054.2 +047000 GO TO COPY-WRITE-4. SM2054.2 +047100 COPY-FAIL-1-4. SM2054.2 +047200 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +047300 MOVE 206001000200002 TO CORRECT-18V0. SM2054.2 +047400 PERFORM FAIL-1. SM2054.2 +047500 COPY-WRITE-4. SM2054.2 +047600* NOTE COPYING OF A PROCEDURE WHICH REFERENCES COPIED DATA.SM2054.2 +047700 MOVE "COPY-TEST-4 " TO PAR-NAME. SM2054.2 +047800 PERFORM PRINT-DETAIL-1. SM2054.2 +047900 COPY-TEST-5. SM2054.2 +048000 PERFORM RET-2 40 TIMES. SM2054.2 +048100 IF RDF-KEYS EQUAL TO 201001000200002 SM2054.2 +048200 PERFORM PASS-1 GO TO COPY-WRITE-5. SM2054.2 +048300 GO TO COPY-FAIL-1-5. SM2054.2 +048400 COPY-DELETE-5. SM2054.2 +048500 PERFORM DE-LETE-1. SM2054.2 +048600 GO TO COPY-WRITE-5. SM2054.2 +048700 COPY-FAIL-1-5. SM2054.2 +048800 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +048900 MOVE 201001000200002 TO CORRECT-18V0. SM2054.2 +049000 PERFORM FAIL-1. SM2054.2 +049100 COPY-WRITE-5. SM2054.2 +049200 MOVE "COPY-TEST-5 " TO PAR-NAME. SM2054.2 +049300 PERFORM PRINT-DETAIL-1. SM2054.2 +049400 COPY-TEST-6. SM2054.2 +049500 PERFORM RET-2 7 TIMES. SM2054.2 +049600 IF RDF-KEYS EQUAL TO 201002000100001 SM2054.2 +049700 PERFORM PASS-1 GO TO COPY-WRITE-6. SM2054.2 +049800 GO TO COPY-FAIL-1-6. SM2054.2 +049900 COPY-DELETE-6. SM2054.2 +050000 PERFORM DE-LETE-1. SM2054.2 +050100 GO TO COPY-WRITE-6. SM2054.2 +050200 COPY-FAIL-1-6. SM2054.2 +050300 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +050400 MOVE 201002000100001 TO CORRECT-18V0. SM2054.2 +050500 PERFORM FAIL-1. SM2054.2 +050600 COPY-WRITE-6. SM2054.2 +050700 MOVE "COPY-TEST-6 " TO PAR-NAME. SM2054.2 +050800 PERFORM PRINT-DETAIL-1. SM2054.2 +050900 COPY-TEST-7. SM2054.2 +051000 PERFORM RET-2. SM2054.2 +051100 IF RDF-KEYS EQUAL TO 900008000000000 SM2054.2 +051200 PERFORM PASS-1 GO TO COPY-WRITE-7. SM2054.2 +051300 GO TO COPY-FAIL-1-7. SM2054.2 +051400 COPY-DELETE-7. SM2054.2 +051500 PERFORM DE-LETE-1. SM2054.2 +051600 GO TO COPY-WRITE-7. SM2054.2 +051700 COPY-FAIL-1-7. SM2054.2 +051800 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +051900 MOVE 900008000000000 TO CORRECT-18V0. SM2054.2 +052000 PERFORM FAIL-1. SM2054.2 +052100 COPY-WRITE-7. SM2054.2 +052200 MOVE "COPY-TEST-7 " TO PAR-NAME. SM2054.2 +052300 PERFORM PRINT-DETAIL-1. SM2054.2 +052400 COPY-TEST-8. SM2054.2 +052500 PERFORM RET-2. SM2054.2 +052600 IF RDF-KEYS EQUAL TO 900009000000000 SM2054.2 +052700 PERFORM PASS-1 GO TO COPY-WRITE-8. SM2054.2 +052800 GO TO COPY-FAIL-1-8. SM2054.2 +052900 COPY-DELETE-8. SM2054.2 +053000 PERFORM DE-LETE-1. SM2054.2 +053100 GO TO COPY-WRITE-8. SM2054.2 +053200 COPY-FAIL-1-8. SM2054.2 +053300 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +053400 MOVE 900009000000000 TO CORRECT-18V0. SM2054.2 +053500 PERFORM FAIL-1. SM2054.2 +053600 COPY-WRITE-8. SM2054.2 +053700 MOVE "COPY-TEST-8 " TO PAR-NAME. SM2054.2 +053800 PERFORM PRINT-DETAIL-1. SM2054.2 +053900 OUTP2 SECTION. SM2054.2 +054000 COPY-TEST-9. SM2054.2 +054100 RETURN SORTFILE-2E END SM2054.2 +054200 PERFORM PASS-1 GO TO COPY-WRITE-9. SM2054.2 +054300* NOTE THE FOLLOWING STATEMENTS SHOULD NOT BE EXECUTED. SM2054.2 +054400 MOVE RDF-KEYS TO COMPUTED-18V0. SM2054.2 +054500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. SM2054.2 +054600 COPY-DELETE-9. SM2054.2 +054700 PERFORM DE-LETE-1. SM2054.2 +054800 COPY-WRITE-9. SM2054.2 +054900 MOVE "COPY-TEST-9 " TO PAR-NAME. SM2054.2 +055000 PERFORM PRINT-DETAIL-1. SM2054.2 +055100 CLOSE SORTOUT-2E. SM2054.2 +055200 GO TO LIB2E-EXIT. SM2054.2 +055300 OUTP3 SECTION. SM2054.2 +055400 RET-1. SM2054.2 +055500 RETURN SORTFILE-2E RECORD AT END GO TO BAD-FILE. SM2054.2 +055600 MOVE S-RECORD TO SORTED. SM2054.2 +055700 WRITE SORTED. SM2054.2 +055800 RET-2. SM2054.2 +055900 RETURN SORTFILE-2E END GO TO BAD-FILE. SM2054.2 +056000 MOVE S-RECORD TO SORTED. SM2054.2 +056100 WRITE SORTED. SM2054.2 +056200 BAD-FILE. SM2054.2 +056300 PERFORM FAIL-1. SM2054.2 +056400 MOVE "BAD-FILE" TO PAR-NAME. SM2054.2 +056500 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. SM2054.2 +056600 PERFORM PRINT-DETAIL-1. SM2054.2 +056700 CLOSE SORTOUT-2E. SM2054.2 +056800 GO TO LIB2E-EXIT. SM2054.2 +056900 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2054.2 +057000 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2054.2 +057100 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2054.2 +057200 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2054.2 +057300 MOVE "****TEST DELETED****" TO RE-MARK. SM2054.2 +057400 PRINT-DETAIL-1. SM2054.2 +057500 IF REC-CT NOT EQUAL TO ZERO SM2054.2 +057600 MOVE "." TO PARDOT-X SM2054.2 +057700 MOVE REC-CT TO DOTVALUE. SM2054.2 +057800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. SM2054.2 +057900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 SM2054.2 +058000 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 SM2054.2 +058100 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. SM2054.2 +058200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2054.2 +058300 MOVE SPACE TO CORRECT-X. SM2054.2 +058400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2054.2 +058500 MOVE SPACE TO RE-MARK. SM2054.2 +058600 WRITE-LINE-1. SM2054.2 +058700 ADD 1 TO RECORD-COUNT. SM2054.2 +058800 IF RECORD-COUNT GREATER 50 SM2054.2 +058900 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2054.2 +059000 MOVE SPACE TO DUMMY-RECORD SM2054.2 +059100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2054.2 +059200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 SM2054.2 +059300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES SM2054.2 +059400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 SM2054.2 +059500 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2054.2 +059600 MOVE ZERO TO RECORD-COUNT. SM2054.2 +059700 PERFORM WRT-LN-1. SM2054.2 +059800 WRT-LN-1. SM2054.2 +059900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2054.2 +060000 MOVE SPACE TO DUMMY-RECORD. SM2054.2 +060100 BLANK-LINE-PRINT-1. SM2054.2 +060200 PERFORM WRT-LN-1. SM2054.2 +060300 FAIL-ROUTINE-1. SM2054.2 +060400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SM2054.2 +060500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. SM2054.2 +060600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2054.2 +060700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SM2054.2 +060800 GO TO FAIL-ROUTINE-EX-1. SM2054.2 +060900 FAIL-RTN-WRITE-1. SM2054.2 +061000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 SM2054.2 +061100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. SM2054.2 +061200 FAIL-ROUTINE-EX-1. EXIT. SM2054.2 +061300 BAIL-OUT-1. SM2054.2 +061400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. SM2054.2 +061500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. SM2054.2 +061600 BAIL-OUT-WRITE-1. SM2054.2 +061700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2054.2 +061800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. SM2054.2 +061900 BAIL-OUT-EX-1. EXIT. SM2054.2 +062000 LIB2E-EXIT. SM2054.2 +062100 EXIT. SM2054.2 diff --git a/tests/cobol85/SM/SM206A.CBL b/tests/cobol85/SM/SM206A.CBL new file mode 100755 index 00000000..7421a720 --- /dev/null +++ b/tests/cobol85/SM/SM206A.CBL @@ -0,0 +1,711 @@ +000100 IDENTIFICATION DIVISION. SM2064.2 +000200 PROGRAM-ID. SM2064.2 +000300 SM206A. SM2064.2 +000400**************************************************************** SM2064.2 +000500* * SM2064.2 +000600* VALIDATION FOR:- * SM2064.2 +000700* * SM2064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2064.2 +000900* * SM2064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2064.2 +001100* * SM2064.2 +001200**************************************************************** SM2064.2 +001300* * SM2064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2064.2 +001500* * SM2064.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2064.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2064.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2064.2 +001900* * SM2064.2 +002000**************************************************************** SM2064.2 +002100* * SM2064.2 +002200* PROGRAM NC206A TESTS THE "REPLACING" PHRASE OF THE "COPY" * SM2064.2 +002300* STATEMENT USING A VARIETY OF PSEUDO-TEXT OPERANDS. * SM2064.2 +002400* MAXIMUM AND MINIMUM LENGTH TEXT WORDS ARE ALSO TESTED. * SM2064.2 +002500* * SM2064.2 +002600**************************************************************** SM2064.2 +002700 ENVIRONMENT DIVISION. SM2064.2 +002800 CONFIGURATION SECTION. SM2064.2 +002900 SOURCE-COMPUTER. SM2064.2 +003000 Linux. SM2064.2 +003100 OBJECT-COMPUTER. SM2064.2 +003200 Linux. SM2064.2 +003300 INPUT-OUTPUT SECTION. SM2064.2 +003400 FILE-CONTROL. SM2064.2 +003500 SELECT PRINT-FILE ASSIGN TO SM2064.2 +003600 "report.log". SM2064.2 +003700 DATA DIVISION. SM2064.2 +003800 FILE SECTION. SM2064.2 +003900 FD PRINT-FILE. SM2064.2 +004000 01 PRINT-REC PICTURE X(120). SM2064.2 +004100 01 DUMMY-RECORD PICTURE X(120). SM2064.2 +004200 WORKING-STORAGE SECTION. SM2064.2 +004300 01 GRP-001. SM2064.2 +004400 02 GRP-002. SM2064.2 +004500 04 GRP-004. SM2064.2 +004600 06 GRP-006. SM2064.2 +004700 08 WRK-XN-00005-001 PIC X(5) VALUE "FIRST". SM2064.2 +004800 08 WRK-XN-00050-O005F-001 OCCURS 5 TIMES. SM2064.2 +004900 10 WRK-XN-00005-O005-001 PIC X(5). SM2064.2 +005000 10 WRK-DS-05V00-O005-001 PIC S9(5). SM2064.2 +005100 02 GRP-003. SM2064.2 +005200 04 GRP-004. SM2064.2 +005300 06 GRP-006. SM2064.2 +005400 08 WRK-XN-00005-001 PIC X(5) VALUE "SECON". SM2064.2 +005500 08 WRK-XN-00050-O005F-001 OCCURS 5 TIMES. SM2064.2 +005600 10 WRK-XN-00005-O005-001 PIC X(5). SM2064.2 +005700 10 WRK-DS-05V00-O005-001 PIC S9(5). SM2064.2 +005800 01 GRP-007. SM2064.2 +005900 08 WRK-XN-00005-001 PIC X(5) VALUE "THIRD". SM2064.2 +006000 01 WRK-DS-09V00-901 PIC S9(9) VALUE ZERO. SM2064.2 +006100 01 WRK-DS-09V00-902 PIC S9(9) VALUE ZERO. SM2064.2 +006200 01 WRK-XN-00001 PIC X. SM2064.2 +006300 01 WRK-XN-00322 PIC X(322). SM2064.2 +006400 01 FILLER REDEFINES WRK-XN-00322. SM2064.2 +006500 03 WRK-XN-00322-1 PIC X. SM2064.2 +006600 03 WRK-XN-00322-2-322. SM2064.2 +006700 05 WRK-XN-00322-2-3 PIC X. SM2064.2 +006800 05 WRK-XN-00322-20 PIC X(20) SM2064.2 +006900 OCCURS 16 SM2064.2 +007000 INDEXED BY X1. SM2064.2 +007100 01 WRK-DU-9 PIC 9 VALUE ZERO. SM2064.2 +007200 01 WRK-DU-99 PIC 99 VALUE ZERO. SM2064.2 +007300 01 WRK-DU-99-LONGER PIC 99 VALUE ZERO. SM2064.2 +007400 01 TEST-RESULTS. SM2064.2 +007500 02 FILLER PIC X VALUE SPACE. SM2064.2 +007600 02 FEATURE PIC X(20) VALUE SPACE. SM2064.2 +007700 02 FILLER PIC X VALUE SPACE. SM2064.2 +007800 02 P-OR-F PIC X(5) VALUE SPACE. SM2064.2 +007900 02 FILLER PIC X VALUE SPACE. SM2064.2 +008000 02 PAR-NAME. SM2064.2 +008100 03 FILLER PIC X(19) VALUE SPACE. SM2064.2 +008200 03 PARDOT-X PIC X VALUE SPACE. SM2064.2 +008300 03 DOTVALUE PIC 99 VALUE ZERO. SM2064.2 +008400 02 FILLER PIC X(8) VALUE SPACE. SM2064.2 +008500 02 RE-MARK PIC X(61). SM2064.2 +008600 01 TEST-COMPUTED. SM2064.2 +008700 02 FILLER PIC X(30) VALUE SPACE. SM2064.2 +008800 02 FILLER PIC X(17) VALUE SM2064.2 +008900 " COMPUTED=". SM2064.2 +009000 02 COMPUTED-X. SM2064.2 +009100 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2064.2 +009200 03 COMPUTED-N REDEFINES COMPUTED-A SM2064.2 +009300 PIC -9(9).9(9). SM2064.2 +009400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2064.2 +009500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2064.2 +009600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2064.2 +009700 03 CM-18V0 REDEFINES COMPUTED-A. SM2064.2 +009800 04 COMPUTED-18V0 PIC -9(18). SM2064.2 +009900 04 FILLER PIC X. SM2064.2 +010000 03 FILLER PIC X(50) VALUE SPACE. SM2064.2 +010100 01 TEST-CORRECT. SM2064.2 +010200 02 FILLER PIC X(30) VALUE SPACE. SM2064.2 +010300 02 FILLER PIC X(17) VALUE " CORRECT =". SM2064.2 +010400 02 CORRECT-X. SM2064.2 +010500 03 CORRECT-A PIC X(20) VALUE SPACE. SM2064.2 +010600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2064.2 +010700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2064.2 +010800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2064.2 +010900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2064.2 +011000 03 CR-18V0 REDEFINES CORRECT-A. SM2064.2 +011100 04 CORRECT-18V0 PIC -9(18). SM2064.2 +011200 04 FILLER PIC X. SM2064.2 +011300 03 FILLER PIC X(2) VALUE SPACE. SM2064.2 +011400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2064.2 +011500 01 CCVS-C-1. SM2064.2 +011600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2064.2 +011700- "SS PARAGRAPH-NAME SM2064.2 +011800- " REMARKS". SM2064.2 +011900 02 FILLER PIC X(20) VALUE SPACE. SM2064.2 +012000 01 CCVS-C-2. SM2064.2 +012100 02 FILLER PIC X VALUE SPACE. SM2064.2 +012200 02 FILLER PIC X(6) VALUE "TESTED". SM2064.2 +012300 02 FILLER PIC X(15) VALUE SPACE. SM2064.2 +012400 02 FILLER PIC X(4) VALUE "FAIL". SM2064.2 +012500 02 FILLER PIC X(94) VALUE SPACE. SM2064.2 +012600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2064.2 +012700 01 REC-CT PIC 99 VALUE ZERO. SM2064.2 +012800 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2064.2 +012900 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2064.2 +013000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2064.2 +013100 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2064.2 +013200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2064.2 +013300 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2064.2 +013400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2064.2 +013500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2064.2 +013600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2064.2 +013700 01 CCVS-H-1. SM2064.2 +013800 02 FILLER PIC X(39) VALUE SPACES. SM2064.2 +013900 02 FILLER PIC X(42) VALUE SM2064.2 +014000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2064.2 +014100 02 FILLER PIC X(39) VALUE SPACES. SM2064.2 +014200 01 CCVS-H-2A. SM2064.2 +014300 02 FILLER PIC X(40) VALUE SPACE. SM2064.2 +014400 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2064.2 +014500 02 FILLER PIC XXXX VALUE SM2064.2 +014600 "4.2 ". SM2064.2 +014700 02 FILLER PIC X(28) VALUE SM2064.2 +014800 " COPY - NOT FOR DISTRIBUTION". SM2064.2 +014900 02 FILLER PIC X(41) VALUE SPACE. SM2064.2 +015000 SM2064.2 +015100 01 CCVS-H-2B. SM2064.2 +015200 02 FILLER PIC X(15) VALUE SM2064.2 +015300 "TEST RESULT OF ". SM2064.2 +015400 02 TEST-ID PIC X(9). SM2064.2 +015500 02 FILLER PIC X(4) VALUE SM2064.2 +015600 " IN ". SM2064.2 +015700 02 FILLER PIC X(12) VALUE SM2064.2 +015800 " HIGH ". SM2064.2 +015900 02 FILLER PIC X(22) VALUE SM2064.2 +016000 " LEVEL VALIDATION FOR ". SM2064.2 +016100 02 FILLER PIC X(58) VALUE SM2064.2 +016200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2064.2 +016300 01 CCVS-H-3. SM2064.2 +016400 02 FILLER PIC X(34) VALUE SM2064.2 +016500 " FOR OFFICIAL USE ONLY ". SM2064.2 +016600 02 FILLER PIC X(58) VALUE SM2064.2 +016700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2064.2 +016800 02 FILLER PIC X(28) VALUE SM2064.2 +016900 " COPYRIGHT 1985 ". SM2064.2 +017000 01 CCVS-E-1. SM2064.2 +017100 02 FILLER PIC X(52) VALUE SPACE. SM2064.2 +017200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2064.2 +017300 02 ID-AGAIN PIC X(9). SM2064.2 +017400 02 FILLER PIC X(45) VALUE SPACES. SM2064.2 +017500 01 CCVS-E-2. SM2064.2 +017600 02 FILLER PIC X(31) VALUE SPACE. SM2064.2 +017700 02 FILLER PIC X(21) VALUE SPACE. SM2064.2 +017800 02 CCVS-E-2-2. SM2064.2 +017900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2064.2 +018000 03 FILLER PIC X VALUE SPACE. SM2064.2 +018100 03 ENDER-DESC PIC X(44) VALUE SM2064.2 +018200 "ERRORS ENCOUNTERED". SM2064.2 +018300 01 CCVS-E-3. SM2064.2 +018400 02 FILLER PIC X(22) VALUE SM2064.2 +018500 " FOR OFFICIAL USE ONLY". SM2064.2 +018600 02 FILLER PIC X(12) VALUE SPACE. SM2064.2 +018700 02 FILLER PIC X(58) VALUE SM2064.2 +018800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2064.2 +018900 02 FILLER PIC X(13) VALUE SPACE. SM2064.2 +019000 02 FILLER PIC X(15) VALUE SM2064.2 +019100 " COPYRIGHT 1985". SM2064.2 +019200 01 CCVS-E-4. SM2064.2 +019300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2064.2 +019400 02 FILLER PIC X(4) VALUE " OF ". SM2064.2 +019500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2064.2 +019600 02 FILLER PIC X(40) VALUE SM2064.2 +019700 " TESTS WERE EXECUTED SUCCESSFULLY". SM2064.2 +019800 01 XXINFO. SM2064.2 +019900 02 FILLER PIC X(19) VALUE SM2064.2 +020000 "*** INFORMATION ***". SM2064.2 +020100 02 INFO-TEXT. SM2064.2 +020200 04 FILLER PIC X(8) VALUE SPACE. SM2064.2 +020300 04 XXCOMPUTED PIC X(20). SM2064.2 +020400 04 FILLER PIC X(5) VALUE SPACE. SM2064.2 +020500 04 XXCORRECT PIC X(20). SM2064.2 +020600 02 INF-ANSI-REFERENCE PIC X(48). SM2064.2 +020700 01 HYPHEN-LINE. SM2064.2 +020800 02 FILLER PIC IS X VALUE IS SPACE. SM2064.2 +020900 02 FILLER PIC IS X(65) VALUE IS "************************SM2064.2 +021000- "*****************************************". SM2064.2 +021100 02 FILLER PIC IS X(54) VALUE IS "************************SM2064.2 +021200- "******************************". SM2064.2 +021300 01 CCVS-PGM-ID PIC X(9) VALUE SM2064.2 +021400 "SM206A". SM2064.2 +021500 PROCEDURE DIVISION. SM2064.2 +021600 CCVS1 SECTION. SM2064.2 +021700 OPEN-FILES. SM2064.2 +021800 OPEN OUTPUT PRINT-FILE. SM2064.2 +021900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2064.2 +022000 MOVE SPACE TO TEST-RESULTS. SM2064.2 +022100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2064.2 +022200 GO TO CCVS1-EXIT. SM2064.2 +022300 CLOSE-FILES. SM2064.2 +022400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2064.2 +022500 TERMINATE-CCVS. SM2064.2 +022600*S EXIT PROGRAM. SM2064.2 +022700*SERMINATE-CALL. SM2064.2 +022800 STOP RUN. SM2064.2 +022900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2064.2 +023000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2064.2 +023100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2064.2 +023200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2064.2 +023300 MOVE "****TEST DELETED****" TO RE-MARK. SM2064.2 +023400 PRINT-DETAIL. SM2064.2 +023500 IF REC-CT NOT EQUAL TO ZERO SM2064.2 +023600 MOVE "." TO PARDOT-X SM2064.2 +023700 MOVE REC-CT TO DOTVALUE. SM2064.2 +023800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2064.2 +023900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2064.2 +024000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2064.2 +024100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2064.2 +024200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2064.2 +024300 MOVE SPACE TO CORRECT-X. SM2064.2 +024400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2064.2 +024500 MOVE SPACE TO RE-MARK. SM2064.2 +024600 HEAD-ROUTINE. SM2064.2 +024700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +024800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +024900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2064.2 +025000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2064.2 +025100 COLUMN-NAMES-ROUTINE. SM2064.2 +025200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +025300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +025400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +025500 END-ROUTINE. SM2064.2 +025600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2064.2 +025700 END-RTN-EXIT. SM2064.2 +025800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +025900 END-ROUTINE-1. SM2064.2 +026000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2064.2 +026100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2064.2 +026200 ADD PASS-COUNTER TO ERROR-HOLD. SM2064.2 +026300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2064.2 +026400 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2064.2 +026500 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2064.2 +026600 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2064.2 +026700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2064.2 +026800 END-ROUTINE-12. SM2064.2 +026900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2064.2 +027000 IF ERROR-COUNTER IS EQUAL TO ZERO SM2064.2 +027100 MOVE "NO " TO ERROR-TOTAL SM2064.2 +027200 ELSE SM2064.2 +027300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2064.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2064.2 +027500 PERFORM WRITE-LINE. SM2064.2 +027600 END-ROUTINE-13. SM2064.2 +027700 IF DELETE-COUNTER IS EQUAL TO ZERO SM2064.2 +027800 MOVE "NO " TO ERROR-TOTAL ELSE SM2064.2 +027900 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2064.2 +028000 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2064.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +028200 IF INSPECT-COUNTER EQUAL TO ZERO SM2064.2 +028300 MOVE "NO " TO ERROR-TOTAL SM2064.2 +028400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2064.2 +028500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2064.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +028700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2064.2 +028800 WRITE-LINE. SM2064.2 +028900 ADD 1 TO RECORD-COUNT. SM2064.2 +029000 IF RECORD-COUNT GREATER 50 SM2064.2 +029100 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2064.2 +029200 MOVE SPACE TO DUMMY-RECORD SM2064.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2064.2 +029400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2064.2 +029500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2064.2 +029600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2064.2 +029700 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2064.2 +029800 MOVE ZERO TO RECORD-COUNT. SM2064.2 +029900 PERFORM WRT-LN. SM2064.2 +030000 WRT-LN. SM2064.2 +030100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2064.2 +030200 MOVE SPACE TO DUMMY-RECORD. SM2064.2 +030300 BLANK-LINE-PRINT. SM2064.2 +030400 PERFORM WRT-LN. SM2064.2 +030500 FAIL-ROUTINE. SM2064.2 +030600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2064.2 +030700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2064.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2064.2 +030900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2064.2 +031000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +031100 MOVE SPACES TO INF-ANSI-REFERENCE. SM2064.2 +031200 GO TO FAIL-ROUTINE-EX. SM2064.2 +031300 FAIL-ROUTINE-WRITE. SM2064.2 +031400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2064.2 +031500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2064.2 +031600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2064.2 +031700 MOVE SPACES TO COR-ANSI-REFERENCE. SM2064.2 +031800 FAIL-ROUTINE-EX. EXIT. SM2064.2 +031900 BAIL-OUT. SM2064.2 +032000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2064.2 +032100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2064.2 +032200 BAIL-OUT-WRITE. SM2064.2 +032300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2064.2 +032400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2064.2 +032500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2064.2 +032600 MOVE SPACES TO INF-ANSI-REFERENCE. SM2064.2 +032700 BAIL-OUT-EX. EXIT. SM2064.2 +032800 CCVS1-EXIT. SM2064.2 +032900 EXIT. SM2064.2 +033000 SECT-SM206-0001 SECTION. SM2064.2 +033100* SM2064.2 +033200*********************** COPY STATEMENT USED **********************SM2064.2 +033300* SM2064.2 +033400* COPY KP001SM2064.2 +033500* REPLACING ==PERFORM FAIL. == BY ====. SM2064.2 +033600* SM2064.2 +033700******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +033800 COPY KP001SM2064.2 +033900 REPLACING ==PERFORM FAIL. == BY ====. SM2064.2 +034000*********************** END OF COPIED TEXT ***********************SM2064.2 +034100 SECT-SM206-0002 SECTION. SM2064.2 +034200 PST-INIT-002. SM2064.2 +034300 MOVE +00005 TO WRK-DS-05V00-O005-001 OF GRP-002 (1). SM2064.2 +034400 MOVE +000000005 TO WRK-DS-09V00-901. SM2064.2 +034500 PST-TEST-002. SM2064.2 +034600* THIS TEST EXERCISES THE REPLACING PHRASE BY REPLACING SM2064.2 +034700* PSEUDO-TEXT BY AN IDENTIFIER. SM2064.2 +034800 MOVE "PSEUDO-TEXT/IDENTIFR" TO FEATURE. SM2064.2 +034900* SM2064.2 +035000*********************** COPY STATEMENT USED **********************SM2064.2 +035100* SM2064.2 +035200* COPY KP002SM2064.2 +035300* REPLACING == WRK-DS-09V00-901 SM2064.2 +035400* SUBTRACT 1 FROM SM2064.2 +035500* WRK-DS-05V00-O005-001 IN GRP-002 (1)== SM2064.2 +035600* BY WRK-DS-05V00-O005-001 IN WRK-XN-00050-0005 SM2064.2 +035700*-(COL 7) F-001 IN GRP-006 IN GRP-004 IN GRP-002 IN GRP-0SM2064.2 +035800*-(COL 7) 01 (1). SM2064.2 +035900* SM2064.2 +036000******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +036100 COPY KP002SM2064.2 +036200 REPLACING == WRK-DS-09V00-901 SM2064.2 +036300 SUBTRACT 1 FROM SM2064.2 +036400 WRK-DS-05V00-O005-001 IN GRP-002 (1)== SM2064.2 +036500 BY WRK-DS-05V00-O005-001 IN WRK-XN-00050-O005SM2064.2 +036600- F-001 IN GRP-006 IN GRP-004 IN GRP-002 IN GRP-0SM2064.2 +036700- 01 (1). SM2064.2 +036800*********************** END OF COPIED TEXT ***********************SM2064.2 +036900 MOVE "PST-TEST-002" TO PAR-NAME. SM2064.2 +037000 MOVE 01 TO REC-CT. SM2064.2 +037100 IF WRK-DS-05V00-O005-001 OF GRP-002 (1) EQUAL TO +6 SM2064.2 +037200 PERFORM PASS SM2064.2 +037300 ELSE SM2064.2 +037400 MOVE +6 TO CORRECT-18V0 SM2064.2 +037500 MOVE WRK-DS-05V00-O005-001 OF GRP-002 (1) TO SM2064.2 +037600 COMPUTED-18V0 SM2064.2 +037700 PERFORM FAIL. SM2064.2 +037800 PERFORM PRINT-DETAIL. SM2064.2 +037900* THIS IDENTIFIER SHOULD HAVE BEEN INCREMENTED BY ONE AS A SM2064.2 +038000* RESULT OF THE REPLACING PHRASE SPECIFIED IN THE COPY SM2064.2 +038100* STATEMENT. SM2064.2 +038200 ADD +01 TO REC-CT. SM2064.2 +038300 IF WRK-DS-09V00-901 NOT EQUAL TO +5 SM2064.2 +038400 MOVE +5 TO CORRECT-18V0 SM2064.2 +038500 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0 SM2064.2 +038600 PERFORM FAIL SM2064.2 +038700 ELSE SM2064.2 +038800 PERFORM PASS. SM2064.2 +038900* THIS IDENTIFIER SHOULD NOT HAVE BEEN ALTERED AS A RESULT OF SM2064.2 +039000* THE REPLACING PHRASE OF THE COPY STATEMENT. SM2064.2 +039100 PERFORM PRINT-DETAIL. SM2064.2 +039200 ADD +01 TO REC-CT. SM2064.2 +039300 IF WRK-DS-05V00-O005-001 IN WRK-XN-00050-O005F-001 IN SM2064.2 +039400 GRP-006 IN GRP-004 IN GRP-003 (2) EQUAL TO +9 SM2064.2 +039500 PERFORM PASS SM2064.2 +039600 ELSE SM2064.2 +039700 MOVE WRK-DS-05V00-O005-001 IN SM2064.2 +039800 WRK-XN-00050-O005F-001 IN SM2064.2 +039900 GRP-006 IN SM2064.2 +040000 GRP-004 IN SM2064.2 +040100 GRP-003 (2) TO COMPUTED-18V0 SM2064.2 +040200 MOVE +9 TO CORRECT-18V0 SM2064.2 +040300 PERFORM FAIL. SM2064.2 +040400* THE REPLACING PHRASE SHOULD NOT HAVE AFFECTED THE ACTION TO SM2064.2 +040500* BE TAKEN ON THIS IDENTIFIER IN THE TEXT BEING COPIED. SM2064.2 +040600* SM2064.2 +040700* SM2064.2 +040800 PERFORM PRINT-DETAIL. SM2064.2 +040900*THIS IS THE BEGINNING OF PST-TEST-003. SM2064.2 +041000* SM2064.2 +041100 PST-INIT-003. SM2064.2 +041200 MOVE "PSEUDO-TEXT/LITERAL" TO FEATURE. SM2064.2 +041300 MOVE "PST-TEST-003" TO PAR-NAME. SM2064.2 +041400 MOVE +00005 TO WRK-DS-05V00-O005-001 OF GRP-002 (3). SM2064.2 +041500 MOVE +000000005 TO WRK-DS-09V00-901. SM2064.2 +041600 MOVE ZERO TO WRK-DS-05V00-O005-001 IN GRP-003 (3). SM2064.2 +041700* SM2064.2 +041800*********************** COPY STATEMENT USED **********************SM2064.2 +041900* SM2064.2 +042000* COPY KP003SM2064.2 +042100* REPLACING ==+00001== BY +2 SM2064.2 +042200* == 1 == BY -3. SM2064.2 +042300* SM2064.2 +042400******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +042500 COPY KP003SM2064.2 +042600 REPLACING ==+00001== BY +2 SM2064.2 +042700 == 1 == BY -3 . SM2064.2 +042800*********************** END OF COPIED TEXT ***********************SM2064.2 +042900 PST-TEST-003-1. SM2064.2 +043000 MOVE 01 TO REC-CT. SM2064.2 +043100 IF WRK-DS-05V00-O005-001 IN GRP-003 (3) EQUAL TO +00009 SM2064.2 +043200 PERFORM PASS SM2064.2 +043300 ELSE SM2064.2 +043400 MOVE +009 TO CORRECT-18V0 SM2064.2 +043500 MOVE WRK-DS-05V00-O005-001 IN SM2064.2 +043600 GRP-003 (3) TO COMPUTED-18V0 SM2064.2 +043700 PERFORM FAIL. SM2064.2 +043800 PERFORM PRINT-DETAIL. SM2064.2 +043900 ADD +01 TO REC-CT. SM2064.2 +044000 IF WRK-DS-09V00-901 EQUAL TO +000000007 SM2064.2 +044100 PERFORM PASS SM2064.2 +044200 ELSE SM2064.2 +044300 PERFORM FAIL SM2064.2 +044400 MOVE +7 TO CORRECT-18V0 SM2064.2 +044500 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0. SM2064.2 +044600 PERFORM PRINT-DETAIL. SM2064.2 +044700 ADD +01 TO REC-CT. SM2064.2 +044800 IF WRK-DS-05V00-O005-001 OF GRP-002 (3) EQUAL TO +8 SM2064.2 +044900 PERFORM PASS SM2064.2 +045000 ELSE SM2064.2 +045100 MOVE +8 TO CORRECT-18V0 SM2064.2 +045200 PERFORM FAIL SM2064.2 +045300 MOVE WRK-DS-05V00-O005-001 IN GRP-002 (3) TO SM2064.2 +045400 COMPUTED-18V0. SM2064.2 +045500 PERFORM PRINT-DETAIL. SM2064.2 +045600 MOVE 0 TO WRK-DS-09V00-901. SM2064.2 +045700*THE NEXT BIT OF CODING REPRESENTS WHAT WE FEEL IS PST-TEST-004, SM2064.2 +045800* WHAT YOU SEE IS WHAT THIS COMPILER FEELS IS SM2064.2 +045900* PST-TEST-004. SM2064.2 +046000* SM2064.2 +046100*********************** COPY STATEMENT USED **********************SM2064.2 +046200* SM2064.2 +046300* COPY KP004SM2064.2 +046400* REPLACING ==THIS IS NOT REAL COBOL-74 SYNTAX HOWESM2064.2 +046500*-(COL 7) VER SHOVE== SM2064.2 +046600* BY MOVE SM2064.2 +046700* == DELETE== SM2064.2 +046800* BY DE-LETE. SM2064.2 +046900* SM2064.2 +047000******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +047100 COPY KP004 SM2064.2 +047200 REPLACING ==THIS IS NOT REAL COBOL-74 SYNTAX HOWESM2064.2 +047300- VER SHOVE== SM2064.2 +047400 BY MOVE SM2064.2 +047500 == DELETE== SM2064.2 +047600 BY DE-LETE. SM2064.2 +047700*********************** END OF COPIED TEXT ***********************SM2064.2 +047800 PST-WRITE-004. SM2064.2 +047900 MOVE "PST-TEST-004" TO PAR-NAME. SM2064.2 +048000 MOVE 01 TO REC-CT. SM2064.2 +048100 IF WRK-DS-09V00-901 EQUAL TO 5 SM2064.2 +048200 PERFORM PASS SM2064.2 +048300 ELSE SM2064.2 +048400 PERFORM FAIL SM2064.2 +048500 MOVE 5 TO CORRECT-18V0 SM2064.2 +048600 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0. SM2064.2 +048700 PERFORM PRINT-DETAIL. SM2064.2 +048800 ADD 1 TO REC-CT. SM2064.2 +048900 IF WRK-DS-09V00-902 EQUAL TO 2 SM2064.2 +049000 PERFORM PASS SM2064.2 +049100 ELSE SM2064.2 +049200 MOVE 2 TO CORRECT-18V0 SM2064.2 +049300 MOVE WRK-DS-09V00-902 TO COMPUTED-18V0 SM2064.2 +049400 PERFORM FAIL. SM2064.2 +049500 PERFORM PRINT-DETAIL. SM2064.2 +049600 PST-TEST-005. SM2064.2 +049700 MOVE 0 TO WRK-DS-09V00-901. SM2064.2 +049800* SM2064.2 +049900*********************** COPY STATEMENT USED **********************SM2064.2 +050000* SM2064.2 +050100* COPY KP005SM2064.2 +050200* REPLACING == 1 == BY == 5 == SM2064.2 +050300* == 5 == BY == 7 ==. SM2064.2 +050400* SM2064.2 +050500******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +050600 COPY KP005SM2064.2 +050700 REPLACING == 1 == BY == 5 == SM2064.2 +050800 == 5 == BY == 7 ==. SM2064.2 +050900*********************** END OF COPIED TEXT ***********************SM2064.2 +051000 IF WRK-DS-09V00-901 IS EQUAL TO 5 SM2064.2 +051100 PERFORM PASS GO TO PST-WRITE-005. SM2064.2 +051200 PERFORM FAIL. SM2064.2 +051300 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0. SM2064.2 +051400 MOVE 5 TO CORRECT-18V0. SM2064.2 +051500 IF WRK-DS-09V00-901 IS EQUAL TO 7 SM2064.2 +051600 MOVE "CASCADED REPLACEMENT PERFORMED" TO RE-MARK. SM2064.2 +051700 GO TO PST-WRITE-005. SM2064.2 +051800 PST-DELETE-005. SM2064.2 +051900 PERFORM DE-LETE. SM2064.2 +052000 PST-WRITE-005. SM2064.2 +052100 MOVE "CASCADED REPLACE PST" TO FEATURE. SM2064.2 +052200 MOVE "PST-TEST-005" TO PAR-NAME. SM2064.2 +052300 MOVE 01 TO REC-CT. SM2064.2 +052400 PERFORM PRINT-DETAIL. SM2064.2 +052500 PST-TEST-006. SM2064.2 +052600 MOVE 0 TO WRK-DS-09V00-901. SM2064.2 +052700* SM2064.2 +052800*********************** COPY STATEMENT USED **********************SM2064.2 +052900* SM2064.2 +053000* COPY KP006SM2064.2 +053100* REPLACING ==001== BY == 3 == SM2064.2 +053200* ==005== BY == 7 ==. SM2064.2 +053300* SM2064.2 +053400******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +053500 COPY KP006SM2064.2 +053600 REPLACING ==001== BY == 3 == SM2064.2 +053700 ==005== BY == 7 ==. SM2064.2 +053800*********************** END OF COPIED TEXT ***********************SM2064.2 +053900 IF WRK-DS-09V00-901 IS EQUAL TO 1005 SM2064.2 +054000 PERFORM PASS GO TO PST-WRITE-006. SM2064.2 +054100 PERFORM FAIL. SM2064.2 +054200 MOVE WRK-DS-09V00-901 TO COMPUTED-18V0. SM2064.2 +054300 MOVE 1005 TO CORRECT-18V0. SM2064.2 +054400 IF WRK-DS-09V00-901 IS EQUAL TO 10 SM2064.2 +054500 MOVE "PART REPLACING, CONT IGNORED" TO RE-MARK. SM2064.2 +054600 IF WRK-DS-09V00-901 IS EQUAL TO 37 SM2064.2 +054700 MOVE "PART REPLACING, CONT HONORED" TO RE-MARK. SM2064.2 +054800 GO TO PST-WRITE-006. SM2064.2 +054900 PST-DELETE-006. SM2064.2 +055000 PERFORM DE-LETE. SM2064.2 +055100 PST-WRITE-006. SM2064.2 +055200 MOVE "CONT LIT/PST PART RPL" TO FEATURE. SM2064.2 +055300 MOVE "PST-TEST-006" TO PAR-NAME. SM2064.2 +055400 PERFORM PRINT-DETAIL. SM2064.2 +055500 PST-TEST-007. SM2064.2 +055600 PERFORM FAIL. SM2064.2 +055700 SUBTRACT 1 FROM ERROR-COUNTER. SM2064.2 +055800* SM2064.2 +055900*********************** COPY STATEMENT USED **********************SM2064.2 +056000* SM2064.2 +056100* COPY KP007 SM2064.2 +056200* REPLACING ==FAIL. SUBTRACT 1 FROM ERROR-COUNTER. == SM2064.2 +056300* BY ==PASS. ==. SM2064.2 +056400* SM2064.2 +056500******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +056600 COPY KP007 SM2064.2 +056700 REPLACING ==FAIL. SUBTRACT 1 FROM ERROR-COUNTER. == SM2064.2 +056800 BY ==PASS. ==. SM2064.2 +056900*********************** END OF COPIED TEXT ***********************SM2064.2 +057000 IF P-OR-F IS EQUAL TO "FAIL*" ADD 1 TO ERROR-COUNTER. SM2064.2 +057100 GO TO PST-WRITE-007. SM2064.2 +057200 PST-DELETE-007. SM2064.2 +057300 PERFORM DE-LETE. SM2064.2 +057400 PST-WRITE-007. SM2064.2 +057500 MOVE "PST/EMBEDDED COMMENT" TO FEATURE. SM2064.2 +057600 MOVE "PST-TEST-007" TO PAR-NAME. SM2064.2 +057700 MOVE 01 TO REC-CT. SM2064.2 +057800 PERFORM PRINT-DETAIL. SM2064.2 +057900 PST-TEST-008. SM2064.2 +058000* PERFORM PASS. SM2064.2 +058100* SM2064.2 +058200*********************** COPY STATEMENT USED **********************SM2064.2 +058300* SM2064.2 +058400*D COPY KP007. SM2064.2 +058500* SM2064.2 +058600******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +058700*D COPY KP007. SM2064.2 +058800*********************** END OF COPIED TEXT ***********************SM2064.2 +058900* IF P-OR-F IS EQUAL TO "FAIL*" ADD 1 TO ERROR-COUNTER. SM2064.2 +059000* GO TO PST-WRITE-008. SM2064.2 +059100 PST-DELETE-008. SM2064.2 +059200 PERFORM DE-LETE. SM2064.2 +059300 PST-WRITE-008. SM2064.2 +059400 MOVE "COPY IN DEBUG LINE" TO FEATURE. SM2064.2 +059500 MOVE "PST-TEST-008" TO PAR-NAME. SM2064.2 +059600 PERFORM PRINT-DETAIL. SM2064.2 +059700 PST-TEST-009. SM2064.2 +059800 PERFORM FAIL. SM2064.2 +059900 SUBTRACT 1 FROM ERROR-COUNTER. SM2064.2 +060000* SM2064.2 +060100*********************** COPY STATEMENT USED **********************SM2064.2 +060200* SM2064.2 +060300* COPY KP008 SM2064.2 +060400* REPLACING ==FAIL. THIS IS GARBAGE. SUBTRACT 1 FROM SM2064.2 +060500* ERROR-COUNTER. == SM2064.2 +060600* BY ==PASS. ==. SM2064.2 +060700* SM2064.2 +060800******************** COPIED TEXT BEGINS BELOW ********************SM2064.2 +060900 COPY KP008 SM2064.2 +061000 REPLACING ==FAIL. THIS IS GARBAGE. SUBTRACT 1 FROM SM2064.2 +061100 ERROR-COUNTER. == SM2064.2 +061200 BY ==PASS. ==. SM2064.2 +061300*********************** END OF COPIED TEXT ***********************SM2064.2 +061400 IF P-OR-F IS EQUAL TO "FAIL*" ADD 1 TO ERROR-COUNTER. SM2064.2 +061500 GO TO PST-WRITE-009. SM2064.2 +061600 PST-DELETE-009. SM2064.2 +061700 PERFORM DE-LETE. SM2064.2 +061800 PST-WRITE-009. SM2064.2 +061900 MOVE "DEBUG LINE IN TEXT" TO FEATURE. SM2064.2 +062000 MOVE "PST-TEST-009" TO PAR-NAME. SM2064.2 +062100 PERFORM PRINT-DETAIL. SM2064.2 +062200* SM2064.2 +062300 PST-TEST-10. SM2064.2 +062400* ===--> MINIMUM LENGTH TEXT WORD <--=== SM2064.2 +062500 MOVE "XII-2 2.3 SR8" TO ANSI-REFERENCE. SM2064.2 +062600 MOVE "PST-TEST-10" TO PAR-NAME. SM2064.2 +062700 MOVE "T" TO WRK-XN-00001. SM2064.2 +062800 GO TO PST-TEST-10-0. SM2064.2 +062900 PST-DELETE-10. SM2064.2 +063000 PERFORM DE-LETE. SM2064.2 +063100 PERFORM PRINT-DETAIL. SM2064.2 +063200 GO TO PST-INIT-11. SM2064.2 +063300 PST-TEST-10-0. SM2064.2 +063400********************* COPY TEXT USED *************************** SM2064.2 +063500* IF WRK-XN-00001 = "G" * SM2064.2 +063600*********************END OF COPY TEXT*************************** SM2064.2 +063700 COPY KP009 SM2064.2 +063800 REPLACING =="G"== BY =="T"==. SM2064.2 +063900 SM2064.2 +064000 PERFORM PASS SM2064.2 +064100 PERFORM PRINT-DETAIL SM2064.2 +064200 ELSE SM2064.2 +064300 MOVE "REPLACING SINGLE CHARACTER FAILED" SM2064.2 +064400 TO RE-MARK SM2064.2 +064500 MOVE "T" TO CORRECT-X SM2064.2 +064600 MOVE WRK-XN-00001 TO COMPUTED-X SM2064.2 +064700 PERFORM FAIL SM2064.2 +064800 PERFORM PRINT-DETAIL. SM2064.2 +064900* SM2064.2 +065000 PST-INIT-11. SM2064.2 +065100* ===--> MAXIMUM LENGTH TEXT WORD <--=== SM2064.2 +065200 MOVE "XII-2 2.3 (SR8) AND XII-5 2.4(GR11)" SM2064.2 +065300 TO ANSI-REFERENCE. SM2064.2 +065400 MOVE "PST-TEST-11" TO PAR-NAME. SM2064.2 +065500 MOVE SPACES TO WRK-XN-00322. SM2064.2 +065600 MOVE 1 TO REC-CT. SM2064.2 +065700 REP-TEST-11-0. SM2064.2 +065800********************* COPY TEXT USED *************************** SM2064.2 +065900* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066000* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066100* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066200* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066300* YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYSM2064.2 +066400* YYYYYYYYYYYYYYYYY SM2064.2 +066500*********************END OF COPY TEXT*************************** SM2064.2 +066600 PST-DELETE-11. SM2064.2 +066700 PERFORM DE-LETE. SM2064.2 +066800 PERFORM PRINT-DETAIL. SM2064.2 +066900 GO TO CCVS-EXIT. SM2064.2 +067000 PST-TEST-11-1. SM2064.2 +067100 MOVE "PST-TEST-11-1" TO PAR-NAME. SM2064.2 +067200 IF WRK-DU-9 = 6 SM2064.2 +067300 PERFORM PASS SM2064.2 +067400 PERFORM PRINT-DETAIL SM2064.2 +067500 ELSE SM2064.2 +067600 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM2064.2 +067700 TO RE-MARK SM2064.2 +067800 MOVE 6 TO CORRECT-N SM2064.2 +067900 MOVE WRK-DU-9 TO COMPUTED-N SM2064.2 +068000 PERFORM FAIL SM2064.2 +068100 PERFORM PRINT-DETAIL. SM2064.2 +068200 ADD 1 TO REC-CT. SM2064.2 +068300 PST-TEST-11-2. SM2064.2 +068400 MOVE "PST-TEST-11-2" TO PAR-NAME. SM2064.2 +068500 IF WRK-DU-99 = 9 SM2064.2 +068600 PERFORM PASS SM2064.2 +068700 PERFORM PRINT-DETAIL SM2064.2 +068800 ELSE SM2064.2 +068900 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM2064.2 +069000 TO RE-MARK SM2064.2 +069100 MOVE 9 TO CORRECT-N SM2064.2 +069200 MOVE WRK-DU-99 TO COMPUTED-N SM2064.2 +069300 PERFORM FAIL SM2064.2 +069400 PERFORM PRINT-DETAIL. SM2064.2 +069500 ADD 1 TO REC-CT. SM2064.2 +069600 PST-TEST-11-3. SM2064.2 +069700 MOVE "PST-TEST-11-3" TO PAR-NAME. SM2064.2 +069800 IF WRK-DU-99-LONGER = 10 SM2064.2 +069900 PERFORM PASS SM2064.2 +070000 PERFORM PRINT-DETAIL SM2064.2 +070100 ELSE SM2064.2 +070200 MOVE "COPYING ALL 322 CHARACTERS FAILED" SM2064.2 +070300 TO RE-MARK SM2064.2 +070400 MOVE 10 TO CORRECT-N SM2064.2 +070500 MOVE WRK-DU-99-LONGER TO COMPUTED-N SM2064.2 +070600 PERFORM FAIL SM2064.2 +070700 PERFORM PRINT-DETAIL. SM2064.2 +070800* SM2064.2 +070900 CCVS-EXIT SECTION. SM2064.2 +071000 CCVS-999999. SM2064.2 +071100 GO TO CLOSE-FILES. SM2064.2 diff --git a/tests/cobol85/SM/SM207A.CBL b/tests/cobol85/SM/SM207A.CBL new file mode 100755 index 00000000..cad31baa --- /dev/null +++ b/tests/cobol85/SM/SM207A.CBL @@ -0,0 +1,362 @@ +000100 IDENTIFICATION DIVISION. SM2074.2 +000200 PROGRAM-ID. SM2074.2 +000300 SM207A. SM2074.2 +000400**************************************************************** SM2074.2 +000500* * SM2074.2 +000600* VALIDATION FOR:- * SM2074.2 +000700* * SM2074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2074.2 +000900* * SM2074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2074.2 +001100* * SM2074.2 +001200**************************************************************** SM2074.2 +001300* * SM2074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2074.2 +001500* * SM2074.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2074.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2074.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2074.2 +001900* * SM2074.2 +002000**************************************************************** SM2074.2 +002100* * SM2074.2 +002200* PROGRAM SM207A TESTS THE "COPY" STATEMENT USING TWO * SM2074.2 +002300* DIFFERENT LIBRARY NAMES TO QUALIFY THE SAME TEXT NAME. * SM2074.2 +002400* * SM2074.2 +002500**************************************************************** SM2074.2 +002600* VP-ROUTINE CONTROL OF LIBRARY CREATION SM2074.2 +002700* -------------------------------------- SM2074.2 +002800* WHEN THE LIBRARIES ARE PREPARED (CREATED) IN PREPARATION FOR SM2074.2 +002900* RUNNING OF SM207, THE TEXT WHICH WILL BE PLACED IN THE SM2074.2 +003000* LIBRARY EQUATED TO X-47 SHOULD BE SELECTED FROM THE SM2074.2 +003100* POPULATION FILE USING THE PLUS-CARD "+ALTLB". THE TEXT SM2074.2 +003200* WHICH WILL BE PLACED IN THE LIBRARY EQUATED TO X-48 SHOULD SM2074.2 +003300* BE SELECTED FROM THE POPULATION FILE USING THE PLUS-CARD SM2074.2 +003400* "+ALTL1,,,ALTLB". SM2074.2 +003500 SM2074.2 +003600 SM2074.2 +003700 ENVIRONMENT DIVISION. SM2074.2 +003800 CONFIGURATION SECTION. SM2074.2 +003900 SOURCE-COMPUTER. SM2074.2 +004000 Linux. SM2074.2 +004100 OBJECT-COMPUTER. SM2074.2 +004200 Linux. SM2074.2 +004300 INPUT-OUTPUT SECTION. SM2074.2 +004400 FILE-CONTROL. SM2074.2 +004500 SELECT PRINT-FILE ASSIGN TO SM2074.2 +004600 "report.log". SM2074.2 +004700 DATA DIVISION. SM2074.2 +004800 FILE SECTION. SM2074.2 +004900 FD PRINT-FILE. SM2074.2 +005000 01 PRINT-REC PICTURE X(120). SM2074.2 +005100 01 DUMMY-RECORD PICTURE X(120). SM2074.2 +005200 WORKING-STORAGE SECTION. SM2074.2 +005300 01 TEST-RESULTS. SM2074.2 +005400 02 FILLER PIC X VALUE SPACE. SM2074.2 +005500 02 FEATURE PIC X(20) VALUE SPACE. SM2074.2 +005600 02 FILLER PIC X VALUE SPACE. SM2074.2 +005700 02 P-OR-F PIC X(5) VALUE SPACE. SM2074.2 +005800 02 FILLER PIC X VALUE SPACE. SM2074.2 +005900 02 PAR-NAME. SM2074.2 +006000 03 FILLER PIC X(19) VALUE SPACE. SM2074.2 +006100 03 PARDOT-X PIC X VALUE SPACE. SM2074.2 +006200 03 DOTVALUE PIC 99 VALUE ZERO. SM2074.2 +006300 02 FILLER PIC X(8) VALUE SPACE. SM2074.2 +006400 02 RE-MARK PIC X(61). SM2074.2 +006500 01 TEST-COMPUTED. SM2074.2 +006600 02 FILLER PIC X(30) VALUE SPACE. SM2074.2 +006700 02 FILLER PIC X(17) VALUE SM2074.2 +006800 " COMPUTED=". SM2074.2 +006900 02 COMPUTED-X. SM2074.2 +007000 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2074.2 +007100 03 COMPUTED-N REDEFINES COMPUTED-A SM2074.2 +007200 PIC -9(9).9(9). SM2074.2 +007300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2074.2 +007400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2074.2 +007500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2074.2 +007600 03 CM-18V0 REDEFINES COMPUTED-A. SM2074.2 +007700 04 COMPUTED-18V0 PIC -9(18). SM2074.2 +007800 04 FILLER PIC X. SM2074.2 +007900 03 FILLER PIC X(50) VALUE SPACE. SM2074.2 +008000 01 TEST-CORRECT. SM2074.2 +008100 02 FILLER PIC X(30) VALUE SPACE. SM2074.2 +008200 02 FILLER PIC X(17) VALUE " CORRECT =". SM2074.2 +008300 02 CORRECT-X. SM2074.2 +008400 03 CORRECT-A PIC X(20) VALUE SPACE. SM2074.2 +008500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2074.2 +008600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2074.2 +008700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2074.2 +008800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2074.2 +008900 03 CR-18V0 REDEFINES CORRECT-A. SM2074.2 +009000 04 CORRECT-18V0 PIC -9(18). SM2074.2 +009100 04 FILLER PIC X. SM2074.2 +009200 03 FILLER PIC X(2) VALUE SPACE. SM2074.2 +009300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2074.2 +009400 01 CCVS-C-1. SM2074.2 +009500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2074.2 +009600- "SS PARAGRAPH-NAME SM2074.2 +009700- " REMARKS". SM2074.2 +009800 02 FILLER PIC X(20) VALUE SPACE. SM2074.2 +009900 01 CCVS-C-2. SM2074.2 +010000 02 FILLER PIC X VALUE SPACE. SM2074.2 +010100 02 FILLER PIC X(6) VALUE "TESTED". SM2074.2 +010200 02 FILLER PIC X(15) VALUE SPACE. SM2074.2 +010300 02 FILLER PIC X(4) VALUE "FAIL". SM2074.2 +010400 02 FILLER PIC X(94) VALUE SPACE. SM2074.2 +010500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2074.2 +010600 01 REC-CT PIC 99 VALUE ZERO. SM2074.2 +010700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2074.2 +010800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2074.2 +010900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2074.2 +011000 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2074.2 +011100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2074.2 +011200 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2074.2 +011300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2074.2 +011400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2074.2 +011500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2074.2 +011600 01 CCVS-H-1. SM2074.2 +011700 02 FILLER PIC X(39) VALUE SPACES. SM2074.2 +011800 02 FILLER PIC X(42) VALUE SM2074.2 +011900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2074.2 +012000 02 FILLER PIC X(39) VALUE SPACES. SM2074.2 +012100 01 CCVS-H-2A. SM2074.2 +012200 02 FILLER PIC X(40) VALUE SPACE. SM2074.2 +012300 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2074.2 +012400 02 FILLER PIC XXXX VALUE SM2074.2 +012500 "4.2 ". SM2074.2 +012600 02 FILLER PIC X(28) VALUE SM2074.2 +012700 " COPY - NOT FOR DISTRIBUTION". SM2074.2 +012800 02 FILLER PIC X(41) VALUE SPACE. SM2074.2 +012900 SM2074.2 +013000 01 CCVS-H-2B. SM2074.2 +013100 02 FILLER PIC X(15) VALUE SM2074.2 +013200 "TEST RESULT OF ". SM2074.2 +013300 02 TEST-ID PIC X(9). SM2074.2 +013400 02 FILLER PIC X(4) VALUE SM2074.2 +013500 " IN ". SM2074.2 +013600 02 FILLER PIC X(12) VALUE SM2074.2 +013700 " HIGH ". SM2074.2 +013800 02 FILLER PIC X(22) VALUE SM2074.2 +013900 " LEVEL VALIDATION FOR ". SM2074.2 +014000 02 FILLER PIC X(58) VALUE SM2074.2 +014100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2074.2 +014200 01 CCVS-H-3. SM2074.2 +014300 02 FILLER PIC X(34) VALUE SM2074.2 +014400 " FOR OFFICIAL USE ONLY ". SM2074.2 +014500 02 FILLER PIC X(58) VALUE SM2074.2 +014600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2074.2 +014700 02 FILLER PIC X(28) VALUE SM2074.2 +014800 " COPYRIGHT 1985 ". SM2074.2 +014900 01 CCVS-E-1. SM2074.2 +015000 02 FILLER PIC X(52) VALUE SPACE. SM2074.2 +015100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2074.2 +015200 02 ID-AGAIN PIC X(9). SM2074.2 +015300 02 FILLER PIC X(45) VALUE SPACES. SM2074.2 +015400 01 CCVS-E-2. SM2074.2 +015500 02 FILLER PIC X(31) VALUE SPACE. SM2074.2 +015600 02 FILLER PIC X(21) VALUE SPACE. SM2074.2 +015700 02 CCVS-E-2-2. SM2074.2 +015800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2074.2 +015900 03 FILLER PIC X VALUE SPACE. SM2074.2 +016000 03 ENDER-DESC PIC X(44) VALUE SM2074.2 +016100 "ERRORS ENCOUNTERED". SM2074.2 +016200 01 CCVS-E-3. SM2074.2 +016300 02 FILLER PIC X(22) VALUE SM2074.2 +016400 " FOR OFFICIAL USE ONLY". SM2074.2 +016500 02 FILLER PIC X(12) VALUE SPACE. SM2074.2 +016600 02 FILLER PIC X(58) VALUE SM2074.2 +016700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2074.2 +016800 02 FILLER PIC X(13) VALUE SPACE. SM2074.2 +016900 02 FILLER PIC X(15) VALUE SM2074.2 +017000 " COPYRIGHT 1985". SM2074.2 +017100 01 CCVS-E-4. SM2074.2 +017200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2074.2 +017300 02 FILLER PIC X(4) VALUE " OF ". SM2074.2 +017400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2074.2 +017500 02 FILLER PIC X(40) VALUE SM2074.2 +017600 " TESTS WERE EXECUTED SUCCESSFULLY". SM2074.2 +017700 01 XXINFO. SM2074.2 +017800 02 FILLER PIC X(19) VALUE SM2074.2 +017900 "*** INFORMATION ***". SM2074.2 +018000 02 INFO-TEXT. SM2074.2 +018100 04 FILLER PIC X(8) VALUE SPACE. SM2074.2 +018200 04 XXCOMPUTED PIC X(20). SM2074.2 +018300 04 FILLER PIC X(5) VALUE SPACE. SM2074.2 +018400 04 XXCORRECT PIC X(20). SM2074.2 +018500 02 INF-ANSI-REFERENCE PIC X(48). SM2074.2 +018600 01 HYPHEN-LINE. SM2074.2 +018700 02 FILLER PIC IS X VALUE IS SPACE. SM2074.2 +018800 02 FILLER PIC IS X(65) VALUE IS "************************SM2074.2 +018900- "*****************************************". SM2074.2 +019000 02 FILLER PIC IS X(54) VALUE IS "************************SM2074.2 +019100- "******************************". SM2074.2 +019200 01 CCVS-PGM-ID PIC X(9) VALUE SM2074.2 +019300 "SM207A". SM2074.2 +019400 PROCEDURE DIVISION. SM2074.2 +019500 CCVS1 SECTION. SM2074.2 +019600 OPEN-FILES. SM2074.2 +019700 OPEN OUTPUT PRINT-FILE. SM2074.2 +019800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2074.2 +019900 MOVE SPACE TO TEST-RESULTS. SM2074.2 +020000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2074.2 +020100 GO TO CCVS1-EXIT. SM2074.2 +020200 CLOSE-FILES. SM2074.2 +020300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2074.2 +020400 TERMINATE-CCVS. SM2074.2 +020500*S EXIT PROGRAM. SM2074.2 +020600*SERMINATE-CALL. SM2074.2 +020700 STOP RUN. SM2074.2 +020800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2074.2 +020900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2074.2 +021000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2074.2 +021100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2074.2 +021200 MOVE "****TEST DELETED****" TO RE-MARK. SM2074.2 +021300 PRINT-DETAIL. SM2074.2 +021400 IF REC-CT NOT EQUAL TO ZERO SM2074.2 +021500 MOVE "." TO PARDOT-X SM2074.2 +021600 MOVE REC-CT TO DOTVALUE. SM2074.2 +021700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2074.2 +021800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2074.2 +021900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2074.2 +022000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2074.2 +022100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2074.2 +022200 MOVE SPACE TO CORRECT-X. SM2074.2 +022300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2074.2 +022400 MOVE SPACE TO RE-MARK. SM2074.2 +022500 HEAD-ROUTINE. SM2074.2 +022600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +022700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +022800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2074.2 +022900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2074.2 +023000 COLUMN-NAMES-ROUTINE. SM2074.2 +023100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +023200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +023400 END-ROUTINE. SM2074.2 +023500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2074.2 +023600 END-RTN-EXIT. SM2074.2 +023700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +023800 END-ROUTINE-1. SM2074.2 +023900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2074.2 +024000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2074.2 +024100 ADD PASS-COUNTER TO ERROR-HOLD. SM2074.2 +024200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2074.2 +024300 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2074.2 +024400 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2074.2 +024500 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2074.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2074.2 +024700 END-ROUTINE-12. SM2074.2 +024800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2074.2 +024900 IF ERROR-COUNTER IS EQUAL TO ZERO SM2074.2 +025000 MOVE "NO " TO ERROR-TOTAL SM2074.2 +025100 ELSE SM2074.2 +025200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2074.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2074.2 +025400 PERFORM WRITE-LINE. SM2074.2 +025500 END-ROUTINE-13. SM2074.2 +025600 IF DELETE-COUNTER IS EQUAL TO ZERO SM2074.2 +025700 MOVE "NO " TO ERROR-TOTAL ELSE SM2074.2 +025800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2074.2 +025900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2074.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +026100 IF INSPECT-COUNTER EQUAL TO ZERO SM2074.2 +026200 MOVE "NO " TO ERROR-TOTAL SM2074.2 +026300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2074.2 +026400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2074.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +026600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2074.2 +026700 WRITE-LINE. SM2074.2 +026800 ADD 1 TO RECORD-COUNT. SM2074.2 +026900 IF RECORD-COUNT GREATER 50 SM2074.2 +027000 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2074.2 +027100 MOVE SPACE TO DUMMY-RECORD SM2074.2 +027200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2074.2 +027300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2074.2 +027400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2074.2 +027500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2074.2 +027600 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2074.2 +027700 MOVE ZERO TO RECORD-COUNT. SM2074.2 +027800 PERFORM WRT-LN. SM2074.2 +027900 WRT-LN. SM2074.2 +028000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2074.2 +028100 MOVE SPACE TO DUMMY-RECORD. SM2074.2 +028200 BLANK-LINE-PRINT. SM2074.2 +028300 PERFORM WRT-LN. SM2074.2 +028400 FAIL-ROUTINE. SM2074.2 +028500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2074.2 +028600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2074.2 +028700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2074.2 +028800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2074.2 +028900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +029000 MOVE SPACES TO INF-ANSI-REFERENCE. SM2074.2 +029100 GO TO FAIL-ROUTINE-EX. SM2074.2 +029200 FAIL-ROUTINE-WRITE. SM2074.2 +029300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2074.2 +029400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2074.2 +029500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2074.2 +029600 MOVE SPACES TO COR-ANSI-REFERENCE. SM2074.2 +029700 FAIL-ROUTINE-EX. EXIT. SM2074.2 +029800 BAIL-OUT. SM2074.2 +029900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2074.2 +030000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2074.2 +030100 BAIL-OUT-WRITE. SM2074.2 +030200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2074.2 +030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2074.2 +030400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2074.2 +030500 MOVE SPACES TO INF-ANSI-REFERENCE. SM2074.2 +030600 BAIL-OUT-EX. EXIT. SM2074.2 +030700 CCVS1-EXIT. SM2074.2 +030800 EXIT. SM2074.2 +030900 SECT-SM207A-001 SECTION. SM2074.2 +031000 QUAL-TEST-01. SM2074.2 +031100 MOVE "NOTHING COPIED" TO RE-MARK. SM2074.2 +031200 PERFORM FAIL. SM2074.2 +031300* SM2074.2 +031400*********************** COPY STATEMENT USED **********************SM2074.2 +031500* SM2074.2 +031600* COPY ALTLB OF SM2074.2 +031700* ".". SM2074.2 +031800* SM2074.2 +031900******************** COPIED TEXT BEGINS BELOW ********************SM2074.2 +032000 COPY ALTLB OF SM2074.2 +032100 ".". SM2074.2 +032200*********************** END OF COPIED TEXT ***********************SM2074.2 +032300 GO TO QUAL-WRITE-01. SM2074.2 +032400 QUAL-DELETE-01. SM2074.2 +032500 PERFORM DE-LETE. SM2074.2 +032600 QUAL-WRITE-01. SM2074.2 +032700 MOVE "QUAL-TEST-01" TO PAR-NAME. SM2074.2 +032800 MOVE "QUALIFIED LIBRY NAME" TO FEATURE. SM2074.2 +032900 PERFORM PRINT-DETAIL. SM2074.2 +033000 QUAL-TEST-02. SM2074.2 +033100 ADD 1 TO ERROR-COUNTER. SM2074.2 +033200* SM2074.2 +033300*********************** COPY STATEMENT USED **********************SM2074.2 +033400* SM2074.2 +033500* COPY ALTLB IN SM2074.2 +033600* "../copyalt". SM2074.2 +033700* SM2074.2 +033800******************** COPIED TEXT BEGINS BELOW ********************SM2074.2 +033900 COPY ALTLB IN SM2074.2 +034000 "../copyalt". SM2074.2 +034100*********************** END OF COPIED TEXT ***********************SM2074.2 +034200 IF P-OR-F IS EQUAL TO "PASS " SM2074.2 +034300 PERFORM FAIL SM2074.2 +034400 MOVE "TEXT COPIED FROM WRONG LIBRARY" TO RE-MARK SM2074.2 +034500 GO TO QUAL-WRITE-02. SM2074.2 +034600 IF P-OR-F IS EQUAL TO "FAIL*" SM2074.2 +034700 PERFORM PASS SM2074.2 +034800 SUBTRACT 1 FROM ERROR-COUNTER SM2074.2 +034900 MOVE SPACES TO RE-MARK SM2074.2 +035000 GO TO QUAL-WRITE-02. SM2074.2 +035100 PERFORM FAIL. SM2074.2 +035200 SUBTRACT 1 FROM ERROR-COUNTER. SM2074.2 +035300 MOVE "NOTHING COPIED" TO RE-MARK. SM2074.2 +035400 GO TO QUAL-WRITE-02. SM2074.2 +035500 QUAL-DELETE-02. SM2074.2 +035600 PERFORM DE-LETE. SM2074.2 +035700 QUAL-WRITE-02. SM2074.2 +035800 MOVE "QUAL-TEST-02" TO PAR-NAME. SM2074.2 +035900 PERFORM PRINT-DETAIL. SM2074.2 +036000 CCVS-EXIT SECTION. SM2074.2 +036100 CCVS-999999. SM2074.2 +036200 GO TO CLOSE-FILES. SM2074.2 diff --git a/tests/cobol85/SM/SM208A.CBL b/tests/cobol85/SM/SM208A.CBL new file mode 100755 index 00000000..17673ad3 --- /dev/null +++ b/tests/cobol85/SM/SM208A.CBL @@ -0,0 +1,642 @@ +000100 IDENTIFICATION DIVISION. SM2084.2 +000200 PROGRAM-ID. SM208A. SM2084.2 +000300 REPLACE OFF. SM2084.2 +000400**************************************************************** SM2084.2 +000500* * SM2084.2 +000600* VALIDATION FOR:- * SM2084.2 +000700* * SM2084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2084.2 +000900* * SM2084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2084.2 +001100* * SM2084.2 +001200**************************************************************** SM2084.2 +001300* * SM2084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * SM2084.2 +001500* * SM2084.2 +001600* X-55 - SYSTEM PRINTER NAME. * SM2084.2 +001700* X-82 - SOURCE COMPUTER NAME. * SM2084.2 +001800* X-83 - OBJECT COMPUTER NAME. * SM2084.2 +001900* * SM2084.2 +002000**************************************************************** SM2084.2 +002100* * SM2084.2 +002200* PROGRAM SM208A TESTS FORMATS 1 AND 2 OF THE "REPLACE" * SM2084.2 +002300* STATEMENT WITH VARIOUS COMBINATIONS OF PSEUDO-TEXT IN * SM2084.2 +002400* EACH OF THE FOUR DIVISIONS. * SM2084.2 +002500* * SM2084.2 +002600**************************************************************** SM2084.2 +002700 SM2084.2 +002800 SM2084.2 +002900 ENVIRONMENT DIVISION. SM2084.2 +003000 CONFIGURATION SECTION. SM2084.2 +003100 SOURCE-COMPUTER. SM2084.2 +003200 Linux. SM2084.2 +003300 OBJECT-COMPUTER. SM2084.2 +003400 Linux. SM2084.2 +003500 INPUT-OUTPUT SECTION. SM2084.2 +003600 FILE-CONTROL. SM2084.2 +003700 SELECT PRINT-FILE ASSIGN TO SM2084.2 +003800 "report.log". SM2084.2 +003900 DATA DIVISION. SM2084.2 +004000 FILE SECTION. SM2084.2 +004100 FD PRINT-FILE. SM2084.2 +004200 01 PRINT-REC PICTURE X(120). SM2084.2 +004300 01 DUMMY-RECORD PICTURE X(120). SM2084.2 +004400 WORKING-STORAGE SECTION. SM2084.2 +004500* THE ANSI-REFERENCE FOR THE TEST OF THE FIRST FOUR "01" SM2084.2 +004600* LEVEL DATA-ITEMS IS "XII-7 3.4 GR3 AND XII-6 3.4 GR2". SM2084.2 +004700 REPLACE ==PICTURE== BY ==PIC==. SM2084.2 +004800 01 A PICTURE X. SM2084.2 +004900 01 B PICTURE S9(7) COMP. SM2084.2 +005000 01 C PICTURE XXBXX/XX. SM2084.2 +005100 REPLACE OFF. SM2084.2 +005200 01 D PICTURE X(7) VALUE "PICTURE". SM2084.2 +005300 01 WRK-XN-00001 PIC X. SM2084.2 +005400 01 WRK-XN-00020 PIC X(20). SM2084.2 +005500 01 WRK-XN-00322 PIC X(322). SM2084.2 +005600 01 FILLER REDEFINES WRK-XN-00322. SM2084.2 +005700 03 WRK-XN-00322-1 PIC X. SM2084.2 +005800 03 WRK-XN-00322-2-322. SM2084.2 +005900 05 WRK-XN-00322-2 PIC X. SM2084.2 +006000 05 WRK-XN-00322-20 PIC X(20) SM2084.2 +006100 OCCURS 16 SM2084.2 +006200 INDEXED BY X1. SM2084.2 +006300 01 WS-A PIC X. SM2084.2 +006400 01 WS-B PIC X. SM2084.2 +006500 01 WS-C PIC X. SM2084.2 +006600 01 WS-D PIC X. SM2084.2 +006700 01 WS-E PIC X. SM2084.2 +006800 01 WS-F PIC X. SM2084.2 +006900 01 TEST-RESULTS. SM2084.2 +007000 02 FILLER PIC X VALUE SPACE. SM2084.2 +007100 02 FEATURE PIC X(20) VALUE SPACE. SM2084.2 +007200 02 FILLER PIC X VALUE SPACE. SM2084.2 +007300 02 P-OR-F PIC X(5) VALUE SPACE. SM2084.2 +007400 02 FILLER PIC X VALUE SPACE. SM2084.2 +007500 02 PAR-NAME. SM2084.2 +007600 03 FILLER PIC X(19) VALUE SPACE. SM2084.2 +007700 03 PARDOT-X PIC X VALUE SPACE. SM2084.2 +007800 03 DOTVALUE PIC 99 VALUE ZERO. SM2084.2 +007900 02 FILLER PIC X(8) VALUE SPACE. SM2084.2 +008000 02 RE-MARK PIC X(61). SM2084.2 +008100 01 TEST-COMPUTED. SM2084.2 +008200 02 FILLER PIC X(30) VALUE SPACE. SM2084.2 +008300 02 FILLER PIC X(17) VALUE SM2084.2 +008400 " COMPUTED=". SM2084.2 +008500 02 COMPUTED-X. SM2084.2 +008600 03 COMPUTED-A PIC X(20) VALUE SPACE. SM2084.2 +008700 03 COMPUTED-N REDEFINES COMPUTED-A SM2084.2 +008800 PIC -9(9).9(9). SM2084.2 +008900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SM2084.2 +009000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SM2084.2 +009100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SM2084.2 +009200 03 CM-18V0 REDEFINES COMPUTED-A. SM2084.2 +009300 04 COMPUTED-18V0 PIC -9(18). SM2084.2 +009400 04 FILLER PIC X. SM2084.2 +009500 03 FILLER PIC X(50) VALUE SPACE. SM2084.2 +009600 01 TEST-CORRECT. SM2084.2 +009700 02 FILLER PIC X(30) VALUE SPACE. SM2084.2 +009800 02 FILLER PIC X(17) VALUE " CORRECT =". SM2084.2 +009900 02 CORRECT-X. SM2084.2 +010000 03 CORRECT-A PIC X(20) VALUE SPACE. SM2084.2 +010100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SM2084.2 +010200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SM2084.2 +010300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SM2084.2 +010400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SM2084.2 +010500 03 CR-18V0 REDEFINES CORRECT-A. SM2084.2 +010600 04 CORRECT-18V0 PIC -9(18). SM2084.2 +010700 04 FILLER PIC X. SM2084.2 +010800 03 FILLER PIC X(2) VALUE SPACE. SM2084.2 +010900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SM2084.2 +011000 01 CCVS-C-1. SM2084.2 +011100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PASM2084.2 +011200- "SS PARAGRAPH-NAME SM2084.2 +011300- " REMARKS". SM2084.2 +011400 02 FILLER PIC X(20) VALUE SPACE. SM2084.2 +011500 01 CCVS-C-2. SM2084.2 +011600 02 FILLER PIC X VALUE SPACE. SM2084.2 +011700 02 FILLER PIC X(6) VALUE "TESTED". SM2084.2 +011800 02 FILLER PIC X(15) VALUE SPACE. SM2084.2 +011900 02 FILLER PIC X(4) VALUE "FAIL". SM2084.2 +012000 02 FILLER PIC X(94) VALUE SPACE. SM2084.2 +012100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SM2084.2 +012200 01 REC-CT PIC 99 VALUE ZERO. SM2084.2 +012300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SM2084.2 +012400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SM2084.2 +012500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SM2084.2 +012600 01 PASS-COUNTER PIC 999 VALUE ZERO. SM2084.2 +012700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SM2084.2 +012800 01 ERROR-HOLD PIC 999 VALUE ZERO. SM2084.2 +012900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SM2084.2 +013000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SM2084.2 +013100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SM2084.2 +013200 01 CCVS-H-1. SM2084.2 +013300 02 FILLER PIC X(39) VALUE SPACES. SM2084.2 +013400 02 FILLER PIC X(42) VALUE SM2084.2 +013500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SM2084.2 +013600 02 FILLER PIC X(39) VALUE SPACES. SM2084.2 +013700 01 CCVS-H-2A. SM2084.2 +013800 02 FILLER PIC X(40) VALUE SPACE. SM2084.2 +013900 02 FILLER PIC X(7) VALUE "CCVS85 ". SM2084.2 +014000 02 FILLER PIC XXXX VALUE SM2084.2 +014100 "4.2 ". SM2084.2 +014200 02 FILLER PIC X(28) VALUE SM2084.2 +014300 " COPY - NOT FOR DISTRIBUTION". SM2084.2 +014400 02 FILLER PIC X(41) VALUE SPACE. SM2084.2 +014500 SM2084.2 +014600 01 CCVS-H-2B. SM2084.2 +014700 02 FILLER PIC X(15) VALUE SM2084.2 +014800 "TEST RESULT OF ". SM2084.2 +014900 02 TEST-ID PIC X(9). SM2084.2 +015000 02 FILLER PIC X(4) VALUE SM2084.2 +015100 " IN ". SM2084.2 +015200 02 FILLER PIC X(12) VALUE SM2084.2 +015300 " HIGH ". SM2084.2 +015400 02 FILLER PIC X(22) VALUE SM2084.2 +015500 " LEVEL VALIDATION FOR ". SM2084.2 +015600 02 FILLER PIC X(58) VALUE SM2084.2 +015700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2084.2 +015800 01 CCVS-H-3. SM2084.2 +015900 02 FILLER PIC X(34) VALUE SM2084.2 +016000 " FOR OFFICIAL USE ONLY ". SM2084.2 +016100 02 FILLER PIC X(58) VALUE SM2084.2 +016200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SM2084.2 +016300 02 FILLER PIC X(28) VALUE SM2084.2 +016400 " COPYRIGHT 1985 ". SM2084.2 +016500 01 CCVS-E-1. SM2084.2 +016600 02 FILLER PIC X(52) VALUE SPACE. SM2084.2 +016700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SM2084.2 +016800 02 ID-AGAIN PIC X(9). SM2084.2 +016900 02 FILLER PIC X(45) VALUE SPACES. SM2084.2 +017000 01 CCVS-E-2. SM2084.2 +017100 02 FILLER PIC X(31) VALUE SPACE. SM2084.2 +017200 02 FILLER PIC X(21) VALUE SPACE. SM2084.2 +017300 02 CCVS-E-2-2. SM2084.2 +017400 03 ERROR-TOTAL PIC XXX VALUE SPACE. SM2084.2 +017500 03 FILLER PIC X VALUE SPACE. SM2084.2 +017600 03 ENDER-DESC PIC X(44) VALUE SM2084.2 +017700 "ERRORS ENCOUNTERED". SM2084.2 +017800 01 CCVS-E-3. SM2084.2 +017900 02 FILLER PIC X(22) VALUE SM2084.2 +018000 " FOR OFFICIAL USE ONLY". SM2084.2 +018100 02 FILLER PIC X(12) VALUE SPACE. SM2084.2 +018200 02 FILLER PIC X(58) VALUE SM2084.2 +018300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SM2084.2 +018400 02 FILLER PIC X(13) VALUE SPACE. SM2084.2 +018500 02 FILLER PIC X(15) VALUE SM2084.2 +018600 " COPYRIGHT 1985". SM2084.2 +018700 01 CCVS-E-4. SM2084.2 +018800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SM2084.2 +018900 02 FILLER PIC X(4) VALUE " OF ". SM2084.2 +019000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SM2084.2 +019100 02 FILLER PIC X(40) VALUE SM2084.2 +019200 " TESTS WERE EXECUTED SUCCESSFULLY". SM2084.2 +019300 01 XXINFO. SM2084.2 +019400 02 FILLER PIC X(19) VALUE SM2084.2 +019500 "*** INFORMATION ***". SM2084.2 +019600 02 INFO-TEXT. SM2084.2 +019700 04 FILLER PIC X(8) VALUE SPACE. SM2084.2 +019800 04 XXCOMPUTED PIC X(20). SM2084.2 +019900 04 FILLER PIC X(5) VALUE SPACE. SM2084.2 +020000 04 XXCORRECT PIC X(20). SM2084.2 +020100 02 INF-ANSI-REFERENCE PIC X(48). SM2084.2 +020200 01 HYPHEN-LINE. SM2084.2 +020300 02 FILLER PIC IS X VALUE IS SPACE. SM2084.2 +020400 02 FILLER PIC IS X(65) VALUE IS "************************SM2084.2 +020500- "*****************************************". SM2084.2 +020600 02 FILLER PIC IS X(54) VALUE IS "************************SM2084.2 +020700- "******************************". SM2084.2 +020800 01 CCVS-PGM-ID PIC X(9) VALUE SM2084.2 +020900 "SM208A". SM2084.2 +021000 PROCEDURE DIVISION. SM2084.2 +021100 CCVS1 SECTION. SM2084.2 +021200 OPEN-FILES. SM2084.2 +021300 OPEN OUTPUT PRINT-FILE. SM2084.2 +021400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SM2084.2 +021500 MOVE SPACE TO TEST-RESULTS. SM2084.2 +021600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SM2084.2 +021700 GO TO CCVS1-EXIT. SM2084.2 +021800 CLOSE-FILES. SM2084.2 +021900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SM2084.2 +022000 TERMINATE-CCVS. SM2084.2 +022100*S EXIT PROGRAM. SM2084.2 +022200*SERMINATE-CALL. SM2084.2 +022300 STOP RUN. SM2084.2 +022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SM2084.2 +022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SM2084.2 +022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SM2084.2 +022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. SM2084.2 +022800 MOVE "****TEST DELETED****" TO RE-MARK. SM2084.2 +022900 PRINT-DETAIL. SM2084.2 +023000 IF REC-CT NOT EQUAL TO ZERO SM2084.2 +023100 MOVE "." TO PARDOT-X SM2084.2 +023200 MOVE REC-CT TO DOTVALUE. SM2084.2 +023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SM2084.2 +023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SM2084.2 +023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SM2084.2 +023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SM2084.2 +023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SM2084.2 +023800 MOVE SPACE TO CORRECT-X. SM2084.2 +023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SM2084.2 +024000 MOVE SPACE TO RE-MARK. SM2084.2 +024100 HEAD-ROUTINE. SM2084.2 +024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2084.2 +024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SM2084.2 +024600 COLUMN-NAMES-ROUTINE. SM2084.2 +024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +025000 END-ROUTINE. SM2084.2 +025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SM2084.2 +025200 END-RTN-EXIT. SM2084.2 +025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +025400 END-ROUTINE-1. SM2084.2 +025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SM2084.2 +025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. SM2084.2 +025700 ADD PASS-COUNTER TO ERROR-HOLD. SM2084.2 +025800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SM2084.2 +025900 MOVE PASS-COUNTER TO CCVS-E-4-1. SM2084.2 +026000 MOVE ERROR-HOLD TO CCVS-E-4-2. SM2084.2 +026100 MOVE CCVS-E-4 TO CCVS-E-2-2. SM2084.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SM2084.2 +026300 END-ROUTINE-12. SM2084.2 +026400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SM2084.2 +026500 IF ERROR-COUNTER IS EQUAL TO ZERO SM2084.2 +026600 MOVE "NO " TO ERROR-TOTAL SM2084.2 +026700 ELSE SM2084.2 +026800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SM2084.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. SM2084.2 +027000 PERFORM WRITE-LINE. SM2084.2 +027100 END-ROUTINE-13. SM2084.2 +027200 IF DELETE-COUNTER IS EQUAL TO ZERO SM2084.2 +027300 MOVE "NO " TO ERROR-TOTAL ELSE SM2084.2 +027400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SM2084.2 +027500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SM2084.2 +027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +027700 IF INSPECT-COUNTER EQUAL TO ZERO SM2084.2 +027800 MOVE "NO " TO ERROR-TOTAL SM2084.2 +027900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SM2084.2 +028000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SM2084.2 +028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +028200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SM2084.2 +028300 WRITE-LINE. SM2084.2 +028400 ADD 1 TO RECORD-COUNT. SM2084.2 +028500 IF RECORD-COUNT GREATER 50 SM2084.2 +028600 MOVE DUMMY-RECORD TO DUMMY-HOLD SM2084.2 +028700 MOVE SPACE TO DUMMY-RECORD SM2084.2 +028800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SM2084.2 +028900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SM2084.2 +029000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SM2084.2 +029100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SM2084.2 +029200 MOVE DUMMY-HOLD TO DUMMY-RECORD SM2084.2 +029300 MOVE ZERO TO RECORD-COUNT. SM2084.2 +029400 PERFORM WRT-LN. SM2084.2 +029500 WRT-LN. SM2084.2 +029600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SM2084.2 +029700 MOVE SPACE TO DUMMY-RECORD. SM2084.2 +029800 BLANK-LINE-PRINT. SM2084.2 +029900 PERFORM WRT-LN. SM2084.2 +030000 FAIL-ROUTINE. SM2084.2 +030100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SM2084.2 +030200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.SM2084.2 +030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2084.2 +030400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SM2084.2 +030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +030600 MOVE SPACES TO INF-ANSI-REFERENCE. SM2084.2 +030700 GO TO FAIL-ROUTINE-EX. SM2084.2 +030800 FAIL-ROUTINE-WRITE. SM2084.2 +030900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SM2084.2 +031000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SM2084.2 +031100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SM2084.2 +031200 MOVE SPACES TO COR-ANSI-REFERENCE. SM2084.2 +031300 FAIL-ROUTINE-EX. EXIT. SM2084.2 +031400 BAIL-OUT. SM2084.2 +031500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SM2084.2 +031600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SM2084.2 +031700 BAIL-OUT-WRITE. SM2084.2 +031800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SM2084.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SM2084.2 +032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SM2084.2 +032100 MOVE SPACES TO INF-ANSI-REFERENCE. SM2084.2 +032200 BAIL-OUT-EX. EXIT. SM2084.2 +032300 CCVS1-EXIT. SM2084.2 +032400 EXIT. SM2084.2 +032500 SECT-SM208A-001 SECTION. SM2084.2 +032600 REP-INIT-1. SM2084.2 +032700* ===--> MULTIPLE OPERANDS <--=== SM2084.2 +032800 MOVE "XII-6 3.2" TO ANSI-REFERENCE. SM2084.2 +032900 MOVE "REP-TEST-1" TO PAR-NAME. SM2084.2 +033000 MOVE SPACE TO WRK-XN-00001. SM2084.2 +033100 REP-TEST-1-0. SM2084.2 +033200 REPLACE ==AO== BY ==TO== SM2084.2 +033300 ==IE== BY ==IF== SM2084.2 +033400 == = == BY ==EQUAL==. SM2084.2 +033500 GO TO REP-TEST-1-1. SM2084.2 +033600 REP-DELETE-1. SM2084.2 +033700 PERFORM DE-LETE. SM2084.2 +033800 PERFORM PRINT-DETAIL. SM2084.2 +033900 GO TO REP-INIT-2. SM2084.2 +034000 REP-TEST-1-1. SM2084.2 +034100 MOVE "*" AO WRK-XN-00001. SM2084.2 +034200 IE WRK-XN-00001 = "*" SM2084.2 +034300 PERFORM PASS SM2084.2 +034400 PERFORM PRINT-DETAIL SM2084.2 +034500 ELSE SM2084.2 +034600 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +034700 MOVE "*" TO CORRECT-X SM2084.2 +034800 MOVE WRK-XN-00001 TO COMPUTED-X SM2084.2 +034900 PERFORM FAIL SM2084.2 +035000 PERFORM PRINT-DETAIL. SM2084.2 +035100 REPLACE OFF. SM2084.2 +035200* SM2084.2 +035300 REP-INIT-2. SM2084.2 +035400* ===--> MINIMUM AND MAXIMUM LENGTHS <--=== SM2084.2 +035500 MOVE "XII-6 3.3 (SR5&6) AND XII-8 3.4(GR11)" SM2084.2 +035600 TO ANSI-REFERENCE. SM2084.2 +035700 MOVE "REP-TEST-2" TO PAR-NAME. SM2084.2 +035800 MOVE SPACES TO WRK-XN-00322. SM2084.2 +035900 MOVE 1 TO REC-CT. SM2084.2 +036000 REP-TEST-2-0. SM2084.2 +036100 REPLACE =="Z"== BY =="""""""""""""""""SM2084.2 +036200- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036300- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036400- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036500- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036600- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +036700- """"""==. SM2084.2 +036800 MOVE "Z" TO WRK-XN-00322. SM2084.2 +036900 REPLACE OFF. SM2084.2 +037000 GO TO REP-TEST-2-1. SM2084.2 +037100 REP-DELETE-2. SM2084.2 +037200 PERFORM DE-LETE. SM2084.2 +037300 PERFORM PRINT-DETAIL. SM2084.2 +037400 GO TO REP-INIT-3. SM2084.2 +037500 REP-TEST-2-1. SM2084.2 +037600 IF WRK-XN-00322 = """""""""""""""""SM2084.2 +037700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +037800- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +037900- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +038000- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +038100- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +038200- """""" SM2084.2 +038300 PERFORM PASS SM2084.2 +038400 PERFORM PRINT-DETAIL SM2084.2 +038500 ELSE SM2084.2 +038600 MOVE "REPLACING SINGLE CHARACTER BY 160 QUOTES" SM2084.2 +038700 TO RE-MARK SM2084.2 +038800 MOVE """" TO CORRECT-X SM2084.2 +038900 MOVE WRK-XN-00322-1 TO COMPUTED-X SM2084.2 +039000 PERFORM FAIL SM2084.2 +039100 PERFORM PRINT-DETAIL SM2084.2 +039200 ADD 1 TO REC-CT SM2084.2 +039300 MOVE """""""""""""""" TO CORRECT-X SM2084.2 +039400 MOVE WRK-XN-00322-2 TO COMPUTED-X SM2084.2 +039500* PERFORM FAIL SM2084.2 +039600 PERFORM PRINT-DETAIL SM2084.2 +039700 PERFORM WITH TEST AFTER SM2084.2 +039800 VARYING X1 FROM 1 BY 1 SM2084.2 +039900 UNTIL X1 > 7 SM2084.2 +040000 ADD 1 TO REC-CT SM2084.2 +040100 MOVE """""""""""""""""""""""""""""""""""""""""" SM2084.2 +040200 TO CORRECT-X SM2084.2 +040300 MOVE WRK-XN-00322-20 (X1) TO COMPUTED-X SM2084.2 +040400 PERFORM PRINT-DETAIL SM2084.2 +040500 END-PERFORM. SM2084.2 +040600* SM2084.2 +040700 REP-INIT-3. SM2084.2 +040800* ===--> MINIMUM AND MAXIMUM LENGTHS <--=== SM2084.2 +040900 MOVE "XII-6 3.3 (SR5&6) AND XII-8 3.4(GR11)" SM2084.2 +041000 TO ANSI-REFERENCE. SM2084.2 +041100 MOVE "REP-TEST-3" TO PAR-NAME. SM2084.2 +041200 MOVE SPACES TO WRK-XN-00322. SM2084.2 +041300 MOVE 1 TO REC-CT. SM2084.2 +041400 REP-TEST-3-0. SM2084.2 +041500 REPLACE =="""""""""""""""""SM2084.2 +041600- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +041700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +041800- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +041900- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042000- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042100- """"""== BY =="Y"==. SM2084.2 +042200 MOVE """""""""""""""""SM2084.2 +042300- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042400- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042500- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042600- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042700- """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""SM2084.2 +042800- """""" TO WRK-XN-00322. SM2084.2 +042900 REPLACE OFF. SM2084.2 +043000 GO TO REP-TEST-3-1. SM2084.2 +043100 REP-DELETE-3. SM2084.2 +043200 PERFORM DE-LETE. SM2084.2 +043300 PERFORM PRINT-DETAIL. SM2084.2 +043400 GO TO REP-INIT-4. SM2084.2 +043500 REP-TEST-3-1. SM2084.2 +043600 IF WRK-XN-00322-1 = "Y" SM2084.2 +043700 AND WRK-XN-00322-2-322 = SPACES SM2084.2 +043800 PERFORM PASS SM2084.2 +043900 PERFORM PRINT-DETAIL SM2084.2 +044000 ELSE SM2084.2 +044100 MOVE "REPLACING 160 QUOTES BY A SINGLE CHARACTER" SM2084.2 +044200 TO RE-MARK SM2084.2 +044300 MOVE "Y" TO CORRECT-X SM2084.2 +044400 MOVE WRK-XN-00322-1 TO COMPUTED-X SM2084.2 +044500 PERFORM FAIL SM2084.2 +044600 PERFORM PRINT-DETAIL SM2084.2 +044700 ADD 1 TO REC-CT SM2084.2 +044800 MOVE SPACE TO CORRECT-X SM2084.2 +044900 MOVE WRK-XN-00322-2 TO COMPUTED-X SM2084.2 +045000* PERFORM FAIL SM2084.2 +045100 PERFORM PRINT-DETAIL SM2084.2 +045200 PERFORM WITH TEST AFTER SM2084.2 +045300 VARYING X1 FROM 1 BY 1 SM2084.2 +045400 UNTIL X1 > 7 SM2084.2 +045500 ADD 1 TO REC-CT SM2084.2 +045600 MOVE SPACES TO CORRECT-X SM2084.2 +045700 MOVE WRK-XN-00322-20 (X1) TO COMPUTED-X SM2084.2 +045800 PERFORM PRINT-DETAIL SM2084.2 +045900 END-PERFORM. SM2084.2 +046000* SM2084.2 +046100 REP-INIT-4. SM2084.2 +046200* ===--> INSERTING SPACES <--=== SM2084.2 +046300 MOVE "XII-8 3.4 (GR10)" TO ANSI-REFERENCE. SM2084.2 +046400 MOVE "REP-TEST-4" TO PAR-NAME. SM2084.2 +046500 MOVE SPACE TO WRK-XN-00001. SM2084.2 +046600 REP-TEST-4-0. SM2084.2 +046700 REPLACE ==MOVE "*" AO WRK-XN-00001. SM2084.2 +046800 IE WRK-XN-00001 = "*"== SM2084.2 +046900 BY SM2084.2 +047000 ==MOVE "*" TO WRK-XN-00001. SM2084.2 +047100 SM2084.2 +047200 IF WRK-XN-00001 = "*"==. SM2084.2 +047300 GO TO REP-TEST-4-1. SM2084.2 +047400 REP-DELETE-4. SM2084.2 +047500 PERFORM DE-LETE. SM2084.2 +047600 PERFORM PRINT-DETAIL. SM2084.2 +047700 GO TO REP-INIT-5. SM2084.2 +047800 REP-TEST-4-1. SM2084.2 +047900 MOVE "*" AO WRK-XN-00001. SM2084.2 +048000 IE WRK-XN-00001 = "*" SM2084.2 +048100 PERFORM PASS SM2084.2 +048200 PERFORM PRINT-DETAIL SM2084.2 +048300 ELSE SM2084.2 +048400 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +048500 MOVE "*" TO CORRECT-X SM2084.2 +048600 MOVE WRK-XN-00001 TO COMPUTED-X SM2084.2 +048700 PERFORM FAIL SM2084.2 +048800 PERFORM PRINT-DETAIL. SM2084.2 +048900 REPLACE OFF. SM2084.2 +049000* SM2084.2 +049100 REP-INIT-5. SM2084.2 +049200* ===--> DELETING SOURCE <--=== SM2084.2 +049300 MOVE "XII-6 3.3 (SR4)" TO ANSI-REFERENCE. SM2084.2 +049400 MOVE "REP-TEST-5" TO PAR-NAME. SM2084.2 +049500 MOVE SPACES TO WRK-XN-00020 WRK-XN-00001. SM2084.2 +049600 REP-TEST-5-0. SM2084.2 +049700 REPLACE ==NOT== BY ====. SM2084.2 +049800 MOVE "AA BB CC DD EE FF GG" TO WRK-XN-00020. SM2084.2 +049900 IF WRK-XN-00020 NOT EQUAL SPACES SM2084.2 +050000 MOVE "*" TO WRK-XN-00001. SM2084.2 +050100 REPLACE OFF. SM2084.2 +050200 GO TO REP-TEST-5-1. SM2084.2 +050300 REP-DELETE-5. SM2084.2 +050400 PERFORM DE-LETE. SM2084.2 +050500 PERFORM PRINT-DETAIL. SM2084.2 +050600 GO TO REP-INIT-6. SM2084.2 +050700 REP-TEST-5-1. SM2084.2 +050800 IF WRK-XN-00001 EQUAL SPACES SM2084.2 +050900 PERFORM PASS SM2084.2 +051000 PERFORM PRINT-DETAIL SM2084.2 +051100 ELSE SM2084.2 +051200 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +051300 PERFORM FAIL SM2084.2 +051400 PERFORM PRINT-DETAIL. SM2084.2 +051500* SM2084.2 +051600 REP-INIT-6. SM2084.2 +051700* ===--> EMBEDDED COMMENT AND BLANK LINES <--=== SM2084.2 +051800 MOVE "XII-7/8 3.4 (GR7)" TO ANSI-REFERENCE. SM2084.2 +051900 MOVE "REP-TEST-6" TO PAR-NAME. SM2084.2 +052000 REP-TEST-6-0. SM2084.2 +052100 REPLACE ==MOVE "FAIL" TO== SM2084.2 +052200 BY ==MOVE "PASS" TO==. SM2084.2 +052300 MOVE SM2084.2 +052400* SM2084.2 +052500* SM2084.2 +052600* SM2084.2 +052700 "FAIL" SM2084.2 +052800 SM2084.2 +052900 TO P-OR-F. SM2084.2 +053000 SM2084.2 +053100* SM2084.2 +053200 REPLACE OFF. SM2084.2 +053300 GO TO REP-TEST-6-1. SM2084.2 +053400 REP-DELETE-6. SM2084.2 +053500 PERFORM DE-LETE. SM2084.2 +053600 PERFORM PRINT-DETAIL. SM2084.2 +053700 GO TO REP-INIT-7. SM2084.2 +053800 REP-TEST-6-1. SM2084.2 +053900 IF P-OR-F = "PASS" SM2084.2 +054000 PERFORM PASS SM2084.2 +054100 PERFORM PRINT-DETAIL SM2084.2 +054200 ELSE SM2084.2 +054300 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +054400 MOVE "PASS" TO CORRECT-X SM2084.2 +054500 MOVE P-OR-F TO COMPUTED-X SM2084.2 +054600 PERFORM FAIL SM2084.2 +054700 PERFORM PRINT-DETAIL. SM2084.2 +054800* SM2084.2 +054900 REP-INIT-7. SM2084.2 +055000* ===--> EMBEDDED DEBUG LINES <--=== SM2084.2 +055100 MOVE "XII-8 3.4 (GR8)" TO ANSI-REFERENCE. SM2084.2 +055200 MOVE "REP-TEST-7" TO PAR-NAME. SM2084.2 +055300 MOVE "A" TO WS-A. SM2084.2 +055400 MOVE "B" TO WS-B. SM2084.2 +055500 MOVE "C" TO WS-C. SM2084.2 +055600 MOVE "D" TO WS-D. SM2084.2 +055700 MOVE "E" TO WS-E. SM2084.2 +055800 MOVE "F" TO WS-F. SM2084.2 +055900 REP-TEST-7-0. SM2084.2 +056000 REPLACE ==MOVE WS-A TO WS-B== SM2084.2 +056100 BY ==MOVE WS-C TO WS-B== SM2084.2 +056200 ==MOVE WS-D TO WS-F== SM2084.2 +056300 BY ==MOVE WS-E TO WS-F==. SM2084.2 +056400 SM2084.2 +056500 MOVE WS-A TO WS-B. SM2084.2 +056600 SM2084.2 +056700*D MOVE SM2084.2 +056800*D WS-D SM2084.2 +056900*D TO WS-F. SM2084.2 +057000 SM2084.2 +057100* SM2084.2 +057200 REPLACE OFF. SM2084.2 +057300* GO TO REP-TEST-7-1. SM2084.2 +057400 REP-DELETE-7. SM2084.2 +057500 PERFORM DE-LETE. SM2084.2 +057600 PERFORM PRINT-DETAIL. SM2084.2 +057700 GO TO REP-INIT-8. SM2084.2 +057800 REP-TEST-7-1. SM2084.2 +057900 IF WS-B = "C" SM2084.2 +058000 PERFORM PASS SM2084.2 +058100 PERFORM PRINT-DETAIL SM2084.2 +058200 ELSE SM2084.2 +058300 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +058400 MOVE "C" TO CORRECT-X SM2084.2 +058500 MOVE WS-B TO COMPUTED-X SM2084.2 +058600 PERFORM FAIL SM2084.2 +058700 PERFORM PRINT-DETAIL. SM2084.2 +058800* SM2084.2 +058900 REP-INIT-8. SM2084.2 +059000* ===--> SEPARATORS <--=== SM2084.2 +059100 MOVE "XII-7 3.4 GR6(b)" TO ANSI-REFERENCE. SM2084.2 +059200 MOVE "REP-TEST-8" TO PAR-NAME. SM2084.2 +059300 MOVE SPACES TO P-OR-F. SM2084.2 +059400 REP-TEST-8-0. SM2084.2 +059500 REPLACE ==MOVE; "FAIL" , TO== SM2084.2 +059600 BY ==MOVE "PASS" TO==. SM2084.2 +059700 MOVE , "FAIL"; TO P-OR-F. SM2084.2 +059800 REPLACE OFF. SM2084.2 +059900 GO TO REP-TEST-8-1. SM2084.2 +060000 REP-DELETE-8. SM2084.2 +060100 PERFORM DE-LETE. SM2084.2 +060200 PERFORM PRINT-DETAIL. SM2084.2 +060300 GO TO REP-INIT-9. SM2084.2 +060400 REP-TEST-8-1. SM2084.2 +060500 IF P-OR-F = "PASS" SM2084.2 +060600 PERFORM PASS SM2084.2 +060700 PERFORM PRINT-DETAIL SM2084.2 +060800 ELSE SM2084.2 +060900 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +061000 MOVE "PASS" TO CORRECT-X SM2084.2 +061100 MOVE P-OR-F TO COMPUTED-X SM2084.2 +061200 PERFORM FAIL SM2084.2 +061300 PERFORM PRINT-DETAIL. SM2084.2 +061400* SM2084.2 +061500 REP-INIT-9. SM2084.2 +061600* ===--> SEQUENCE OF COPY AND REPLACE STATEMENTS <--=== SM2084.2 +061700 MOVE "XII-7 3.4 GR4" TO ANSI-REFERENCE. SM2084.2 +061800 MOVE "REP-TEST-9" TO PAR-NAME. SM2084.2 +061900 MOVE "FAIL" TO P-OR-F. SM2084.2 +062000 REP-TEST-9-0. SM2084.2 +062100 REPLACE =="FAIL"== BY =="PASS"==. SM2084.2 +062200 COPY KK208A. SM2084.2 +062300 REPLACE OFF. SM2084.2 +062400 GO TO REP-TEST-9-1. SM2084.2 +062500 REP-DELETE-9. SM2084.2 +062600 PERFORM DE-LETE. SM2084.2 +062700 PERFORM PRINT-DETAIL. SM2084.2 +062800 GO TO CCVS-EXIT. SM2084.2 +062900 REP-TEST-9-1. SM2084.2 +063000 IF P-OR-F = "PASS" SM2084.2 +063100 PERFORM PASS SM2084.2 +063200 PERFORM PRINT-DETAIL SM2084.2 +063300 ELSE SM2084.2 +063400 MOVE "REPLACE FAILED" TO RE-MARK SM2084.2 +063500 MOVE "PASS" TO CORRECT-X SM2084.2 +063600 MOVE P-OR-F TO COMPUTED-X SM2084.2 +063700 PERFORM FAIL SM2084.2 +063800 PERFORM PRINT-DETAIL. SM2084.2 +063900* SM2084.2 +064000 CCVS-EXIT SECTION. SM2084.2 +064100 CCVS-999999. SM2084.2 +064200 GO TO CLOSE-FILES. SM2084.2 diff --git a/tests/cobol85/SM/SM301M.CBL b/tests/cobol85/SM/SM301M.CBL new file mode 100755 index 00000000..3641b9d6 --- /dev/null +++ b/tests/cobol85/SM/SM301M.CBL @@ -0,0 +1,27 @@ +000100 IDENTIFICATION DIVISION. SM3014.2 +000200 PROGRAM-ID. SM3014.2 +000300 SM301M. SM3014.2 +000400*The following program tests the flagging of the intermediate SM3014.2 +000500*subset COPY feature. SM3014.2 +000600 ENVIRONMENT DIVISION. SM3014.2 +000700 CONFIGURATION SECTION. SM3014.2 +000800 SOURCE-COMPUTER. SM3014.2 +000900 Linux. SM3014.2 +001000 OBJECT-COMPUTER. SM3014.2 +001100 Linux. SM3014.2 +001200 SM3014.2 +001300 SM3014.2 +001400 DATA DIVISION. SM3014.2 +001500 SM3014.2 +001600 PROCEDURE DIVISION. SM3014.2 +001700 SM3014.2 +001800 SM301M-CONTROL. SM3014.2 +001900 PERFORM SM301M-COPY. SM3014.2 +002000 STOP RUN. SM3014.2 +002100 SM3014.2 +002200 SM301M-COPY. SM3014.2 +002300*Message expected for following statement: NON-CONFORMING STANDARDSM3014.2 +002400 COPY KSM31. SM3014.2 +002500 SM3014.2 +002600 SM3014.2 +002700*TOTAL NUMBER OF FLAGS EXPECTED = 1. SM3014.2 diff --git a/tests/cobol85/SM/SM401M.CBL b/tests/cobol85/SM/SM401M.CBL new file mode 100755 index 00000000..0e1e7750 --- /dev/null +++ b/tests/cobol85/SM/SM401M.CBL @@ -0,0 +1,30 @@ +000100 IDENTIFICATION DIVISION. SM4014.2 +000200 PROGRAM-ID. SM4014.2 +000300 SM401M. SM4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF HIGH SM4014.2 +000500*SUBSET FEATURES THAT ARE USED IN SOURCE TEXT SM4014.2 +000600*MANIPULATION. SM4014.2 +000700 ENVIRONMENT DIVISION. SM4014.2 +000800 CONFIGURATION SECTION. SM4014.2 +000900 SOURCE-COMPUTER. SM4014.2 +001000 Linux. SM4014.2 +001100 OBJECT-COMPUTER. SM4014.2 +001200 Linux. SM4014.2 +001300 SM4014.2 +001400 SM4014.2 +001500 DATA DIVISION. SM4014.2 +001600 PROCEDURE DIVISION. SM4014.2 +001700 SM4014.2 +001800 SM401M-CONTROL. SM4014.2 +001900 PERFORM SM401M-COPYREP THRU SM401M-REPL. SM4014.2 +002000 STOP RUN. SM4014.2 +002100 SM4014.2 +002200 SM401M-COPYREP. SM4014.2 +002300*Message expected for following statement: NON-CONFORMING STANDARDSM3014.2 +002400 COPY KSM41 REPLACING "PIG" BY "HORSE". SM4014.2 +002500 SM4014.2 +002600 SM401M-REPL. SM4014.2 +002700 REPLACE OFF. SM4014.2 +002800*Message expected for above statement: NON-CONFORMING STANDARD SM4014.2 +002900 SM4014.2 +003000*TOTAL NUMBER OF FLAGS EXPECTED = 2. SM4014.2 diff --git a/tests/cobol85/SQ.txt b/tests/cobol85/SQ.txt deleted file mode 100644 index 3aae21a9..00000000 --- a/tests/cobol85/SQ.txt +++ /dev/null @@ -1,95 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -SQ101M.CBL 57 0 0 0 57 OK -SQ102A.CBL 11 11 0 0 0 OK -SQ103A.CBL 30 30 0 0 0 OK -SQ104A.CBL 11 11 0 0 0 OK -SQ105A.CBL 22 22 0 0 0 OK -SQ106A.CBL 75 69 0 6 0 OK -SQ107A.CBL 6 6 0 0 0 OK -SQ108A.CBL 8 8 0 0 0 OK -SQ109M.CBL 6 6 0 0 0 OK -SQ110M.CBL 6 6 0 0 0 OK -SQ111A.CBL 1 1 0 0 0 OK -SQ112A.CBL 7 7 0 0 0 OK -SQ113A.CBL 22 22 0 0 0 OK -SQ114A.CBL 15 15 0 0 0 OK -SQ115A.CBL 3 3 0 0 0 OK -SQ116A.CBL 10 10 0 0 0 OK -SQ117A.CBL 8 8 0 0 0 OK -SQ121A.CBL 3 3 0 0 0 OK -SQ122A.CBL 7 7 0 0 0 OK -SQ123A.CBL 9 9 0 0 0 OK -SQ124A.CBL 19 19 0 0 0 OK -SQ125A.CBL 2 2 0 0 0 OK -SQ126A.CBL 7 7 0 0 0 OK -SQ127A.CBL 6 6 0 0 0 OK -SQ128A.CBL 9 9 0 0 0 OK -SQ129A.CBL 1 1 0 0 0 OK -SQ130A.CBL 1 1 0 0 0 OK -SQ131A.CBL 2 2 0 0 0 OK -SQ132A.CBL 1 1 0 0 0 OK -SQ133A.CBL 15 15 0 0 0 OK -SQ134A.CBL 15 15 0 0 0 OK -SQ135A.CBL 1 1 0 0 0 OK -SQ136A.CBL 1 1 0 0 0 OK -SQ137A.CBL 1 1 0 0 0 OK -SQ138A.CBL 1 1 0 0 0 OK -SQ139A.CBL 1 1 0 0 0 OK -SQ140A.CBL 1 1 0 0 0 OK -SQ141A.CBL 1 1 0 0 0 OK -SQ142A.CBL 1 1 0 0 0 OK -SQ143A.CBL 1 1 0 0 0 OK -SQ144A.CBL 1 1 0 0 0 OK -SQ146A.CBL 1 1 0 0 0 OK -SQ147A.CBL 1 1 0 0 0 OK -SQ148A.CBL 2 2 0 0 0 OK -SQ149A.CBL 1 1 0 0 0 OK -SQ150A.CBL 1 1 0 0 0 OK -SQ151A.CBL 1 1 0 0 0 OK -SQ152A.CBL 1 1 0 0 0 OK -SQ153A.CBL 1 1 0 0 0 OK -SQ154A.CBL 1 1 0 0 0 OK -SQ155A.CBL 1 1 0 0 0 OK -SQ156A.CBL 1 1 0 0 0 OK -SQ201M.CBL 23 12 0 0 11 OK -SQ202A.CBL 1 1 0 0 0 OK -SQ203A.SUB 4 4 0 0 0 OK -SQ204A.CBL 2 2 0 0 0 OK -SQ205A.CBL 2 2 0 0 0 OK -SQ206A.CBL 4 4 0 0 0 OK -SQ207M.CBL ----- test skipped ----- -SQ208M.CBL 7 0 0 0 7 OK -SQ209M.CBL 3 0 0 0 3 OK -SQ210M.CBL 3 0 0 0 3 OK -SQ211A.CBL 4 4 0 0 0 OK -SQ212A.CBL 1 1 0 0 0 OK -SQ213A.CBL 7 7 0 0 0 OK -SQ214A.CBL 5 5 0 0 0 OK -SQ215A.CBL 4 4 0 0 0 OK -SQ216A.CBL 7 7 0 0 0 OK -SQ217A.CBL 7 7 0 0 0 OK -SQ218A.CBL 6 6 0 0 0 OK -SQ219A.CBL 6 6 0 0 0 OK -SQ220A.CBL 6 6 0 0 0 OK -SQ221A.CBL 6 6 0 0 0 OK -SQ222A.CBL 6 6 0 0 0 OK -SQ223A.CBL 6 6 0 0 0 OK -SQ224A.CBL 3 3 0 0 0 OK -SQ225A.CBL 3 3 0 0 0 OK -SQ226A.CBL 37 37 0 0 0 OK -SQ227A.CBL 16 16 0 0 0 OK -SQ228A.CBL 1 1 0 0 0 OK -SQ229A.CBL 1 1 0 0 0 OK -SQ230A.CBL 1 1 0 0 0 OK -SQ302M.CBL ----- test skipped ----- -SQ303M.CBL ----- test skipped ----- -SQ401M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 599 512 0 6 81 -% 100.0 85.5 0.0 1.0 13.5 - -Number of programs: 81 -Successfully executed: 81 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/SQ/SQ101M.CBL b/tests/cobol85/SQ/SQ101M.CBL new file mode 100755 index 00000000..8b5ef281 --- /dev/null +++ b/tests/cobol85/SQ/SQ101M.CBL @@ -0,0 +1,1881 @@ +000100 IDENTIFICATION DIVISION. SQ1014.2 +000200 PROGRAM-ID. SQ1014.2 +000300 SQ101M. SQ1014.2 +000400**************************************************************** SQ1014.2 +000500* * SQ1014.2 +000600* VALIDATION FOR:- * SQ1014.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1014.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1014.2 +000900* REVISED 1986, AUGUST * SQ1014.2 +001000* * SQ1014.2 +001100* CREATION DATE / VALIDATION DATE * SQ1014.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1014.2 +001300* * SQ1014.2 +001400**************************************************************** SQ1014.2 +001500* * SQ1014.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1014.2 +001700* * SQ1014.2 +001800* X-55 SYSTEM PRINTER * SQ1014.2 +001900* X-82 SOURCE-COMPUTER * SQ1014.2 +002000* X-83 OBJECT-COMPUTER. * SQ1014.2 +002100* * SQ1014.2 +002200**************************************************************** SQ1014.2 +002300* * SQ1014.2 +002400* SQ101M TESTS THE LEVEL 1 FACILITIES FOR CONTROL OF THE * SQ1014.2 +002500* POSITION OF LINES ON A PRINTED PAGE. THE PRINCIPAL * SQ1014.2 +002600* FACILITY IS THE ADVANCING PHRASE OF THE WRITE STATEMENT * SQ1014.2 +002700* WHEN THE ASSOCIATED PHYSICAL FILE IS DESIGNATED AS A * SQ1014.2 +002800* PRINTER. THE FROM PHRASE OF THE WRITE STATEMENT IS ALSO * SQ1014.2 +002900* TESTED. * SQ1014.2 +003000* * SQ1014.2 +003100* ALL POSSIBLE LEVEL 1 COMBINATIONS OF THE FORMAT OF THE * SQ1014.2 +003200* ADVANCING PHRASE ARE TESTED WITH AND WITHOUT THE FROM * SQ1014.2 +003300* PHRASE. THE VALUES USED FOR INTEGER INCLUDE ONE-DIGIT * SQ1014.2 +003400* AND TWO-DIGIT UNSIGNED NUMERIC LITERALS, EIGHTEEN DIGIT * SQ1014.2 +003500* NUMERIC LITERALS WITH LEADING ZEROS, AND THE FIGURATIVE * SQ1014.2 +003600* CONSTANT ZERO. DATA ITEMS USED AS IDENTIFIER-2 INCLUDE * SQ1014.2 +003700* LEVEL 77, LEVEL 01, AND SUBORDINATE ELEMENTARY ITEMS. A * SQ1014.2 +003800* SIMILAR RANGE OF TYPES, BUT INCLUDING GROUP ITEMS, IS * SQ1014.2 +003900* USED FOR IDENTIFIER-2. * SQ1014.2 +004000* * SQ1014.2 +004100* IN ADDITION TO THE ABOVE TESTS, A TEST IS MADE TO ENSURE * SQ1014.2 +004200* THAT CHARACTERS DESIGNATED TO BE PRINTED IN COLUMN 1 DO * SQ1014.2 +004300* NOT ACT AS CARRIAGE CONTROL CHARACTERS. * SQ1014.2 +004400* * SQ1014.2 +004500* BECAUSE OF THE NATURE OF THESE TESTS A "PASS" OR "FAIL" * SQ1014.2 +004600* CANNOT BE DETERMINED WITHIN THE PROGRAM. THE PRINTED * SQ1014.2 +004700* OUTPUT MUST BE EXAMINED TO DETERMINE WHETHER EACH TEST * SQ1014.2 +004800* HAS BEEN PASSED OR FAILED. * SQ1014.2 +004900* * SQ1014.2 +005000**************************************************************** SQ1014.2 +005100* SQ1014.2 +005200* SQ1014.2 +005300 ENVIRONMENT DIVISION. SQ1014.2 +005400 CONFIGURATION SECTION. SQ1014.2 +005500 SOURCE-COMPUTER. SQ1014.2 +005600 Linux. SQ1014.2 +005700 OBJECT-COMPUTER. SQ1014.2 +005800 Linux. SQ1014.2 +005900* SQ1014.2 +006000 INPUT-OUTPUT SECTION. SQ1014.2 +006100 FILE-CONTROL. SQ1014.2 +006200 SELECT PRINT-FILE ASSIGN TO SQ1014.2 +006300 "report.log". SQ1014.2 +006400* SQ1014.2 +006500*P SELECT RAW-DATA ASSIGN TO SQ1014.2 +006600*P "XXXXX062" SQ1014.2 +006700*P ORGANIZATION IS INDEXED SQ1014.2 +006800*P ACCESS MODE IS RANDOM SQ1014.2 +006900*P RECORD-KEY IS RAW-DATA-KEY. SQ1014.2 +007000*P SQ1014.2 +007100* SQ1014.2 +007200 DATA DIVISION. SQ1014.2 +007300 FILE SECTION. SQ1014.2 +007400 FD PRINT-FILE SQ1014.2 +007500*C LABEL RECORDS SQ1014.2 +007600*C OMITTED SQ1014.2 +007700*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1014.2 +007800 . SQ1014.2 +007900 01 PRINT-REC PICTURE X(120). SQ1014.2 +008000 01 DUMMY-RECORD PICTURE X(120). SQ1014.2 +008100*P SQ1014.2 +008200*PD RAW-DATA. SQ1014.2 +008300*P1 RAW-DATA-SATZ. SQ1014.2 +008400*P 05 RAW-DATA-KEY PIC X(6). SQ1014.2 +008500*P 05 C-DATE PIC 9(6). SQ1014.2 +008600*P 05 C-TIME PIC 9(8). SQ1014.2 +008700*P 05 NO-OF-TESTS PIC 99. SQ1014.2 +008800*P 05 C-OK PIC 999. SQ1014.2 +008900*P 05 C-ALL PIC 999. SQ1014.2 +009000*P 05 C-FAIL PIC 999. SQ1014.2 +009100*P 05 C-DELETED PIC 999. SQ1014.2 +009200*P 05 C-INSPECT PIC 999. SQ1014.2 +009300*P 05 C-NOTE PIC X(13). SQ1014.2 +009400*P 05 C-INDENT PIC X. SQ1014.2 +009500*P 05 C-ABORT PIC X(8). SQ1014.2 +009600* SQ1014.2 +009700* SQ1014.2 +009800 WORKING-STORAGE SECTION. SQ1014.2 +009900* SQ1014.2 +010000*************************************************************** SQ1014.2 +010100* * SQ1014.2 +010200* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1014.2 +010300* * SQ1014.2 +010400*************************************************************** SQ1014.2 +010500* SQ1014.2 +010600 77 QU-OTE PIC X VALUE QUOTE. SQ1014.2 +010700 77 IDENTIFIER-2 PIC 99 VALUE 0. SQ1014.2 +010800 77 LONG-ZERO PIC 9(18) VALUE 0. SQ1014.2 +010900 77 LONG-ONE PIC 9(18) VALUE 1. SQ1014.2 +011000 01 IDENT-2-S99 PIC S99. SQ1014.2 +011100 01 IDENT-2-C99 PIC 99 COMP. SQ1014.2 +011200* SQ1014.2 +011300 01 ONE PIC 9 VALUE 1. SQ1014.2 +011400* SQ1014.2 +011500 01 SPACING-VALUES-1. SQ1014.2 +011600 02 TWO PIC 9 VALUE 2. SQ1014.2 +011700 02 SPACING-VALUES-2. SQ1014.2 +011800 03 THREE PIC 9 VALUE 3. SQ1014.2 +011900 03 SPACING-VALUES-3. SQ1014.2 +012000 04 FOUR PIC 9 VALUE 4. SQ1014.2 +012100* SQ1014.2 +012200 01 CHAR-LINE. SQ1014.2 +012300 03 LIN-CH PIC X. SQ1014.2 +012400 03 FILLER PIC X. SQ1014.2 +012500 03 LIN-SER PIC 999. SQ1014.2 +012600 03 FILLER PIC X(115). SQ1014.2 +012700* SQ1014.2 +012800 77 SEVENTY-SEVEN PIC X(120) VALUE " THIS WAS WRITTEN FROMSQ1014.2 +012900- " A 77 LEVEL ENTRY. IT SHOULD BE 2 LINES BELOW AND 1 LINE ABSQ1014.2 +013000- "OVE THE BRACKETING WRT-TEST LINES.". SQ1014.2 +013100* SQ1014.2 +013200 77 SEVENTY-SEVEN-2 PIC X(120) VALUE "THIS LINE WAS WRITTEN SQ1014.2 +013300- "FROM A 77 LEVEL ENTRY. IT SHOULD BE 7 LINES BELOW AND 1 LINSQ1014.2 +013400- "E ABOVE THE BRACKETING WRT-TEST LINES.". SQ1014.2 +013500* SQ1014.2 +013600 01 OH-ONE PIC X(120) VALUE "THIS LINE WAS WRITTEN SQ1014.2 +013700- "FROM AN 01 LEVEL ENTRY. IT SHOULD BE 1 LINE BELOW AND 5 LINESQ1014.2 +013800- "S ABOVE THE BRACKETING WRT-TEST LINES.". SQ1014.2 +013900* SQ1014.2 +014000 01 LEVEL-1. SQ1014.2 +014100 03 OH-THREE PIC X(120) VALUE "THIS LINE WAS WRITTEN SQ1014.2 +014200- "FROM AN 03 LEVEL ENTRY. IT SHOULD BE 1 LINE BELOW AND 6 LSQ1014.2 +014300- "INES ABOVE THE BRACKETING WRT-TEST LINES.". SQ1014.2 +014400* SQ1014.2 +014500 01 TEST-LINE-1. SQ1014.2 +014600 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +014700 02 FILLER PIC X(20) VALUE "THIS LINE SHOULD BE ". SQ1014.2 +014800 02 LINES-BELOW-1 PIC XX. SQ1014.2 +014900 02 FILLER PIC X(17) VALUE " LINES BELOW AND ". SQ1014.2 +015000 02 LINES-ABOVE-1 PIC XX. SQ1014.2 +015100 02 FILLER PIC X(59) VALUE SQ1014.2 +015200 " LINES ABOVE THE BRACKETING WRT-TEST LINES". SQ1014.2 +015300* SQ1014.2 +015400 01 LEVEL-ONE. SQ1014.2 +015500 02 LEVEL-TWO. SQ1014.2 +015600 03 TEST-LINE-2. SQ1014.2 +015700 04 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +015800 04 FILLER PIC X(20) VALUE "THIS LINE SHOULD SQ1014.2 +015900- "BE ". SQ1014.2 +016000 04 LINES-BELOW-2 PIC XX. SQ1014.2 +016100 04 FILLER PIC X(17) VALUE " LINES BELOW AND ".SQ1014.2 +016200 04 LINES-ABOVE-2 PIC XX. SQ1014.2 +016300 04 FILLER PIC X(59) VALUE SQ1014.2 +016400 " LINES ABOVE THE BRACKETING WRT-TEST LINES". SQ1014.2 +016500* SQ1014.2 +016600 01 OVERPRINTED-LINE. SQ1014.2 +016700 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +016800 02 FILLER PIC X(9) VALUE "WRT-TEST-". SQ1014.2 +016900 02 OVERPRINTED-TEST PIC XX. SQ1014.2 +017000 02 FILLER PIC X(89) VALUE "/ THIS LINE SHOULD BE SQ1014.2 +017100- "OVERPRINTED. AAAAAAA". SQ1014.2 +017200 01 OVERPRINT-LINE. SQ1014.2 +017300 02 FILLER PIC X(68) VALUE SPACE. SQ1014.2 +017400 02 FILLER PIC X(17) VALUE "BBBBBBB WRT-TEST-". SQ1014.2 +017500 02 OVERPRINT-TEST PIC XX. SQ1014.2 +017600 02 FILLER PIC X(33) VALUE SQ1014.2 +017700 "/ THIS LINE SHOULD OVERPRINT". SQ1014.2 +017800 01 LAST-LINE. SQ1014.2 +017900 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +018000 02 FILLER PIC X(100) VALUE "THIS LINE SHOULD BE 1 SQ1014.2 +018100- "LINE BELOW THE WRT-TEST LINE AND ALSO BE THE LAST LINE ONSQ1014.2 +018200- " THIS PAGE". SQ1014.2 +018300* SQ1014.2 +018400 01 NEW-PAGE-LINE. SQ1014.2 +018500 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +018600 02 FILLER PIC X(100) VALUE "THIS LINE SHOULD APPEASQ1014.2 +018700- "R AT THE TOP OF A NEW PAGE". SQ1014.2 +018800 01 NEXT-LINE. SQ1014.2 +018900 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +019000 02 FILLER PIC X(100) VALUE "A WRT-TEST LINE SHOULDSQ1014.2 +019100- " FOLLOW IMMEDIATELY ON THE NEXT LINE". SQ1014.2 +019200* SQ1014.2 +019300 01 NOTE-1. SQ1014.2 +019400 02 FILLER PIC X(40) VALUE "BECAUSE OF THE NATURE SQ1014.2 +019500- "OF THESE TESTS A ". SQ1014.2 +019600 02 FILLER PIC X VALUE QUOTE. SQ1014.2 +019700 02 FILLER PIC X(4) VALUE "PASS". SQ1014.2 +019800 02 FILLER PIC X VALUE QUOTE. SQ1014.2 +019900 02 FILLER PIC X(4) VALUE " OR ". SQ1014.2 +020000 02 FILLER PIC X VALUE QUOTE. SQ1014.2 +020100 02 FILLER PIC X(4) VALUE "FAIL". SQ1014.2 +020200 02 FILLER PIC X VALUE QUOTE. SQ1014.2 +020300 02 FILLER PIC X(64) VALUE " CANNOT BE DETERMINED SQ1014.2 +020400- "WITHIN THE PROGRAM. THE USER MUST VISUALLY". SQ1014.2 +020500 01 NOTE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ1014.2 +020600- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ1014.2 +020700- "IONS. NOTE THAT SOME OVERPRINTING". SQ1014.2 +020800 01 NOTE-3 PIC X(120) VALUE "SHOULD OCCUR, AND IN ESQ1014.2 +020900- "VERY CASE THE OVERPRINTED LINE WILL READ---". SQ1014.2 +021000 01 NOTE-4. SQ1014.2 +021100 02 FILLER PIC X(20) VALUE SPACE. SQ1014.2 +021200 02 FILLER PIC X(100) VALUE "WRT-TEST-XX/ THIS LINESQ1014.2 +021300- " SHOULD BE OVERPRINTED. AAAAAAA". SQ1014.2 +021400 01 NOTE-5 PIC X(120) VALUE "---AND THE LINE WHICH SQ1014.2 +021500- "OVERPRINTS SHOULD READ---". SQ1014.2 +021600 01 NOTE-6. SQ1014.2 +021700 02 FILLER PIC X(68) VALUE SPACE. SQ1014.2 +021800 02 FILLER PIC X(52) VALUE "BBBBBBB WRT-TEST-XX/ TSQ1014.2 +021900- "HIS LINE SHOULD OVERPRINT". SQ1014.2 +022000 01 NOTE-7 PIC X(120) VALUE "ONLY FIVE OF THE LETTESQ1014.2 +022100- "RS A AND B SHOULD BE JUMBLED TOGETHER; THE REST SHOULD BE RESQ1014.2 +022200- "ADABLE. IF ANY OTHER LINE IS". SQ1014.2 +022300* SQ1014.2 +022400 01 NOTE-8 PIC X(120) VALUE SQ1014.2 +022500 "INVOLVED IN OVERPRINTING, AN ERROR HAS OCCURRED". SQ1014.2 +022600* SQ1014.2 +022700*************************************************************** SQ1014.2 +022800* * SQ1014.2 +022900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1014.2 +023000* * SQ1014.2 +023100*************************************************************** SQ1014.2 +023200* SQ1014.2 +023300 01 REC-SKEL-SUB PIC 99. SQ1014.2 +023400* SQ1014.2 +023500 01 FILE-RECORD-INFORMATION-REC. SQ1014.2 +023600 03 FILE-RECORD-INFO-SKELETON. SQ1014.2 +023700 05 FILLER PICTURE X(48) VALUE SQ1014.2 +023800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1014.2 +023900 05 FILLER PICTURE X(46) VALUE SQ1014.2 +024000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1014.2 +024100 05 FILLER PICTURE X(26) VALUE SQ1014.2 +024200 ",LFIL=000000,ORG= ,LBLR= ". SQ1014.2 +024300 05 FILLER PICTURE X(37) VALUE SQ1014.2 +024400 ",RECKEY= ". SQ1014.2 +024500 05 FILLER PICTURE X(38) VALUE SQ1014.2 +024600 ",ALTKEY1= ". SQ1014.2 +024700 05 FILLER PICTURE X(38) VALUE SQ1014.2 +024800 ",ALTKEY2= ". SQ1014.2 +024900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1014.2 +025000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1014.2 +025100 05 FILE-RECORD-INFO-P1-120. SQ1014.2 +025200 07 FILLER PIC X(5). SQ1014.2 +025300 07 XFILE-NAME PIC X(6). SQ1014.2 +025400 07 FILLER PIC X(8). SQ1014.2 +025500 07 XRECORD-NAME PIC X(6). SQ1014.2 +025600 07 FILLER PIC X(1). SQ1014.2 +025700 07 REELUNIT-NUMBER PIC 9(1). SQ1014.2 +025800 07 FILLER PIC X(7). SQ1014.2 +025900 07 XRECORD-NUMBER PIC 9(6). SQ1014.2 +026000 07 FILLER PIC X(6). SQ1014.2 +026100 07 UPDATE-NUMBER PIC 9(2). SQ1014.2 +026200 07 FILLER PIC X(5). SQ1014.2 +026300 07 ODO-NUMBER PIC 9(4). SQ1014.2 +026400 07 FILLER PIC X(5). SQ1014.2 +026500 07 XPROGRAM-NAME PIC X(5). SQ1014.2 +026600 07 FILLER PIC X(7). SQ1014.2 +026700 07 XRECORD-LENGTH PIC 9(6). SQ1014.2 +026800 07 FILLER PIC X(7). SQ1014.2 +026900 07 CHARS-OR-RECORDS PIC X(2). SQ1014.2 +027000 07 FILLER PIC X(1). SQ1014.2 +027100 07 XBLOCK-SIZE PIC 9(4). SQ1014.2 +027200 07 FILLER PIC X(6). SQ1014.2 +027300 07 RECORDS-IN-FILE PIC 9(6). SQ1014.2 +027400 07 FILLER PIC X(5). SQ1014.2 +027500 07 XFILE-ORGANIZATION PIC X(2). SQ1014.2 +027600 07 FILLER PIC X(6). SQ1014.2 +027700 07 XLABEL-TYPE PIC X(1). SQ1014.2 +027800 05 FILE-RECORD-INFO-P121-240. SQ1014.2 +027900 07 FILLER PIC X(8). SQ1014.2 +028000 07 XRECORD-KEY PIC X(29). SQ1014.2 +028100 07 FILLER PIC X(9). SQ1014.2 +028200 07 ALTERNATE-KEY1 PIC X(29). SQ1014.2 +028300 07 FILLER PIC X(9). SQ1014.2 +028400 07 ALTERNATE-KEY2 PIC X(29). SQ1014.2 +028500 07 FILLER PIC X(7). SQ1014.2 +028600* SQ1014.2 +028700 01 TEST-RESULTS. SQ1014.2 +028800 02 FILLER PIC X VALUE SPACE. SQ1014.2 +028900 02 FEATURE PIC X(24) VALUE SPACE. SQ1014.2 +029000 02 FILLER PIC X VALUE SPACE. SQ1014.2 +029100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1014.2 +029200 02 FILLER PIC X VALUE SPACE. SQ1014.2 +029300 02 PAR-NAME. SQ1014.2 +029400 03 FILLER PIC X(14) VALUE SPACE. SQ1014.2 +029500 03 PARDOT-X PIC X VALUE SPACE. SQ1014.2 +029600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1014.2 +029700 02 FILLER PIC X(9) VALUE SPACE. SQ1014.2 +029800 02 RE-MARK PIC X(61). SQ1014.2 +029900 01 TEST-COMPUTED. SQ1014.2 +030000 02 FILLER PIC X(30) VALUE SPACE. SQ1014.2 +030100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1014.2 +030200 02 COMPUTED-X. SQ1014.2 +030300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1014.2 +030400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1014.2 +030500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1014.2 +030600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1014.2 +030700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1014.2 +030800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1014.2 +030900 04 COMPUTED-18V0 PIC -9(18). SQ1014.2 +031000 04 FILLER PIC X. SQ1014.2 +031100 03 FILLER PIC X(50) VALUE SPACE. SQ1014.2 +031200 01 TEST-CORRECT. SQ1014.2 +031300 02 FILLER PIC X(30) VALUE SPACE. SQ1014.2 +031400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1014.2 +031500 02 CORRECT-X. SQ1014.2 +031600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1014.2 +031700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1014.2 +031800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1014.2 +031900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1014.2 +032000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1014.2 +032100 03 CR-18V0 REDEFINES CORRECT-A. SQ1014.2 +032200 04 CORRECT-18V0 PIC -9(18). SQ1014.2 +032300 04 FILLER PIC X. SQ1014.2 +032400 03 FILLER PIC X(2) VALUE SPACE. SQ1014.2 +032500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1014.2 +032600 01 CCVS-C-1. SQ1014.2 +032700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1014.2 +032800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1014.2 +032900- "SS PARAGRAPH-NAME SQ1014.2 +033000- " REMARKS". SQ1014.2 +033100 02 FILLER PIC X(17) VALUE SPACE. SQ1014.2 +033200 01 CCVS-C-2. SQ1014.2 +033300 02 FILLER PIC XXXX VALUE SPACE. SQ1014.2 +033400 02 FILLER PIC X(6) VALUE "TESTED". SQ1014.2 +033500 02 FILLER PIC X(16) VALUE SPACE. SQ1014.2 +033600 02 FILLER PIC X(4) VALUE "FAIL". SQ1014.2 +033700 02 FILLER PIC X(90) VALUE SPACE. SQ1014.2 +033800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1014.2 +033900 01 REC-CT PIC 99 VALUE ZERO. SQ1014.2 +034000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1014.2 +034100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1014.2 +034200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1014.2 +034300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1014.2 +034400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1014.2 +034500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1014.2 +034600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1014.2 +034700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1014.2 +034800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1014.2 +034900 01 CCVS-H-1. SQ1014.2 +035000 02 FILLER PIC X(39) VALUE SPACES. SQ1014.2 +035100 02 FILLER PIC X(42) VALUE SQ1014.2 +035200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1014.2 +035300 02 FILLER PIC X(39) VALUE SPACES. SQ1014.2 +035400 01 CCVS-H-2A. SQ1014.2 +035500 02 FILLER PIC X(40) VALUE SPACE. SQ1014.2 +035600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1014.2 +035700 02 FILLER PIC XXXX VALUE SQ1014.2 +035800 "4.2 ". SQ1014.2 +035900 02 FILLER PIC X(28) VALUE SQ1014.2 +036000 " COPY - NOT FOR DISTRIBUTION". SQ1014.2 +036100 02 FILLER PIC X(41) VALUE SPACE. SQ1014.2 +036200* SQ1014.2 +036300 01 CCVS-H-2B. SQ1014.2 +036400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1014.2 +036500 02 TEST-ID PIC X(9). SQ1014.2 +036600 02 FILLER PIC X(4) VALUE " IN ". SQ1014.2 +036700 02 FILLER PIC X(12) VALUE SQ1014.2 +036800 " HIGH ". SQ1014.2 +036900 02 FILLER PIC X(22) VALUE SQ1014.2 +037000 " LEVEL VALIDATION FOR ". SQ1014.2 +037100 02 FILLER PIC X(58) VALUE SQ1014.2 +037200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1014.2 +037300 01 CCVS-H-3. SQ1014.2 +037400 02 FILLER PIC X(34) VALUE SQ1014.2 +037500 " FOR OFFICIAL USE ONLY ". SQ1014.2 +037600 02 FILLER PIC X(58) VALUE SQ1014.2 +037700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1014.2 +037800 02 FILLER PIC X(28) VALUE SQ1014.2 +037900 " COPYRIGHT 1985,1986 ". SQ1014.2 +038000 01 CCVS-E-1. SQ1014.2 +038100 02 FILLER PIC X(52) VALUE SPACE. SQ1014.2 +038200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1014.2 +038300 02 ID-AGAIN PIC X(9). SQ1014.2 +038400 02 FILLER PIC X(45) VALUE SPACES. SQ1014.2 +038500 01 CCVS-E-2. SQ1014.2 +038600 02 FILLER PIC X(31) VALUE SPACE. SQ1014.2 +038700 02 FILLER PIC X(21) VALUE SPACE. SQ1014.2 +038800 02 CCVS-E-2-2. SQ1014.2 +038900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1014.2 +039000 03 FILLER PIC X VALUE SPACE. SQ1014.2 +039100 03 ENDER-DESC PIC X(44) VALUE SQ1014.2 +039200 "ERRORS ENCOUNTERED". SQ1014.2 +039300 01 CCVS-E-3. SQ1014.2 +039400 02 FILLER PIC X(22) VALUE SQ1014.2 +039500 " FOR OFFICIAL USE ONLY". SQ1014.2 +039600 02 FILLER PIC X(12) VALUE SPACE. SQ1014.2 +039700 02 FILLER PIC X(58) VALUE SQ1014.2 +039800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1014.2 +039900 02 FILLER PIC X(8) VALUE SPACE. SQ1014.2 +040000 02 FILLER PIC X(20) VALUE SQ1014.2 +040100 " COPYRIGHT 1985,1986". SQ1014.2 +040200 01 CCVS-E-4. SQ1014.2 +040300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1014.2 +040400 02 FILLER PIC X(4) VALUE " OF ". SQ1014.2 +040500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1014.2 +040600 02 FILLER PIC X(40) VALUE SQ1014.2 +040700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1014.2 +040800 01 XXINFO. SQ1014.2 +040900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1014.2 +041000 02 INFO-TEXT. SQ1014.2 +041100 04 FILLER PIC X(8) VALUE SPACE. SQ1014.2 +041200 04 XXCOMPUTED PIC X(20). SQ1014.2 +041300 04 FILLER PIC X(5) VALUE SPACE. SQ1014.2 +041400 04 XXCORRECT PIC X(20). SQ1014.2 +041500 02 INF-ANSI-REFERENCE PIC X(48). SQ1014.2 +041600 01 HYPHEN-LINE. SQ1014.2 +041700 02 FILLER PIC IS X VALUE IS SPACE. SQ1014.2 +041800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1014.2 +041900- "*****************************************". SQ1014.2 +042000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1014.2 +042100- "******************************". SQ1014.2 +042200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1014.2 +042300 "SQ101M". SQ1014.2 +042400 PROCEDURE DIVISION. SQ1014.2 +042500 CCVS1 SECTION. SQ1014.2 +042600 OPEN-FILES. SQ1014.2 +042700*P OPEN I-O RAW-DATA. SQ1014.2 +042800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1014.2 +042900*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1014.2 +043000*P MOVE "ABORTED " TO C-ABORT. SQ1014.2 +043100*P ADD 1 TO C-NO-OF-TESTS. SQ1014.2 +043200*P ACCEPT C-DATE FROM DATE. SQ1014.2 +043300*P ACCEPT C-TIME FROM TIME. SQ1014.2 +043400*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1014.2 +043500*PND-E-1. SQ1014.2 +043600*P CLOSE RAW-DATA. SQ1014.2 +043700 OPEN OUTPUT PRINT-FILE. SQ1014.2 +043800 MOVE CCVS-PGM-ID TO TEST-ID. SQ1014.2 +043900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1014.2 +044000 MOVE SPACE TO TEST-RESULTS. SQ1014.2 +044100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1014.2 +044200 MOVE ZERO TO REC-SKEL-SUB. SQ1014.2 +044300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1014.2 +044400 GO TO CCVS1-EXIT. SQ1014.2 +044500* SQ1014.2 +044600 CCVS-INIT-FILE. SQ1014.2 +044700 ADD 1 TO REC-SKL-SUB. SQ1014.2 +044800 MOVE FILE-RECORD-INFO-SKELETON TO SQ1014.2 +044900 FILE-RECORD-INFO (REC-SKL-SUB). SQ1014.2 +045000* SQ1014.2 +045100 CLOSE-FILES. SQ1014.2 +045200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1014.2 +045300 CLOSE PRINT-FILE. SQ1014.2 +045400*P OPEN I-O RAW-DATA. SQ1014.2 +045500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1014.2 +045600*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1014.2 +045700*P MOVE "OK. " TO C-ABORT. SQ1014.2 +045800*P MOVE PASS-COUNTER TO C-OK. SQ1014.2 +045900*P MOVE ERROR-HOLD TO C-ALL. SQ1014.2 +046000*P MOVE ERROR-COUNTER TO C-FAIL. SQ1014.2 +046100*P MOVE DELETE-CNT TO C-DELETED. SQ1014.2 +046200*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1014.2 +046300*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1014.2 +046400*PND-E-2. SQ1014.2 +046500*P CLOSE RAW-DATA. SQ1014.2 +046600 TERMINATE-CCVS. SQ1014.2 +046700*S EXIT PROGRAM. SQ1014.2 +046800 STOP RUN. SQ1014.2 +046900* SQ1014.2 +047000 INSPT. SQ1014.2 +047100 MOVE "INSPT" TO P-OR-F. SQ1014.2 +047200 ADD 1 TO INSPECT-COUNTER. SQ1014.2 +047300* SQ1014.2 +047400 PASS. SQ1014.2 +047500 MOVE "PASS " TO P-OR-F. SQ1014.2 +047600 ADD 1 TO PASS-COUNTER. SQ1014.2 +047700* SQ1014.2 +047800 FAIL. SQ1014.2 +047900 MOVE "FAIL*" TO P-OR-F. SQ1014.2 +048000 ADD 1 TO ERROR-COUNTER. SQ1014.2 +048100* SQ1014.2 +048200 DE-LETE. SQ1014.2 +048300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1014.2 +048400 MOVE "*****" TO P-OR-F. SQ1014.2 +048500 ADD 1 TO DELETE-COUNTER. SQ1014.2 +048600 PERFORM PRINT-DETAIL. SQ1014.2 +048700* SQ1014.2 +048800 PRINT-DETAIL. SQ1014.2 +048900 IF REC-CT NOT EQUAL TO ZERO SQ1014.2 +049000 MOVE "." TO PARDOT-X SQ1014.2 +049100 MOVE REC-CT TO DOTVALUE. SQ1014.2 +049200 MOVE TEST-RESULTS TO PRINT-REC. SQ1014.2 +049300 PERFORM WRITE-LINE. SQ1014.2 +049400 IF P-OR-F EQUAL TO "FAIL*" SQ1014.2 +049500 PERFORM WRITE-LINE SQ1014.2 +049600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1014.2 +049700 ELSE SQ1014.2 +049800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1014.2 +049900 MOVE SPACE TO P-OR-F. SQ1014.2 +050000 MOVE SPACE TO COMPUTED-X. SQ1014.2 +050100 MOVE SPACE TO CORRECT-X. SQ1014.2 +050200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1014.2 +050300 MOVE SPACE TO RE-MARK. SQ1014.2 +050400* SQ1014.2 +050500 HEAD-ROUTINE. SQ1014.2 +050600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +050700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +050800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1014.2 +050900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1014.2 +051000 COLUMN-NAMES-ROUTINE. SQ1014.2 +051100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1014.2 +051200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +051300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1014.2 +051400 END-ROUTINE. SQ1014.2 +051500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1014.2 +051600 PERFORM WRITE-LINE 5 TIMES. SQ1014.2 +051700 END-RTN-EXIT. SQ1014.2 +051800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1014.2 +051900 PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +052000* SQ1014.2 +052100 END-ROUTINE-1. SQ1014.2 +052200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1014.2 +052300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1014.2 +052400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1014.2 +052500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1014.2 +052600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1014.2 +052700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1014.2 +052800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1014.2 +052900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1014.2 +053000 PERFORM WRITE-LINE. SQ1014.2 +053100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1014.2 +053200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1014.2 +053300 MOVE "NO " TO ERROR-TOTAL SQ1014.2 +053400 ELSE SQ1014.2 +053500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1014.2 +053600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1014.2 +053700 PERFORM WRITE-LINE. SQ1014.2 +053800 END-ROUTINE-13. SQ1014.2 +053900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1014.2 +054000 MOVE "NO " TO ERROR-TOTAL SQ1014.2 +054100 ELSE SQ1014.2 +054200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1014.2 +054300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1014.2 +054400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1014.2 +054500 PERFORM WRITE-LINE. SQ1014.2 +054600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1014.2 +054700 MOVE "NO " TO ERROR-TOTAL SQ1014.2 +054800 ELSE SQ1014.2 +054900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1014.2 +055000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1014.2 +055100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1014.2 +055200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1014.2 +055300* SQ1014.2 +055400 WRITE-LINE. SQ1014.2 +055500 ADD 1 TO RECORD-COUNT. SQ1014.2 +055600 IF RECORD-COUNT GREATER 50 SQ1014.2 +055700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1014.2 +055800 MOVE SPACE TO DUMMY-RECORD SQ1014.2 +055900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1014.2 +056000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1014.2 +056100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1014.2 +056200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1014.2 +056300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1014.2 +056400 MOVE ZERO TO RECORD-COUNT. SQ1014.2 +056500 PERFORM WRT-LN. SQ1014.2 +056600* SQ1014.2 +056700 WRT-LN. SQ1014.2 +056800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1014.2 +056900 MOVE SPACE TO DUMMY-RECORD. SQ1014.2 +057000 BLANK-LINE-PRINT. SQ1014.2 +057100 PERFORM WRT-LN. SQ1014.2 +057200 FAIL-ROUTINE. SQ1014.2 +057300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1014.2 +057400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1014.2 +057500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1014.2 +057600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1014.2 +057700 MOVE XXINFO TO DUMMY-RECORD. SQ1014.2 +057800 PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +057900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1014.2 +058000 GO TO FAIL-ROUTINE-EX. SQ1014.2 +058100 FAIL-ROUTINE-WRITE. SQ1014.2 +058200 MOVE TEST-COMPUTED TO PRINT-REC SQ1014.2 +058300 PERFORM WRITE-LINE SQ1014.2 +058400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1014.2 +058500 MOVE TEST-CORRECT TO PRINT-REC SQ1014.2 +058600 PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +058700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1014.2 +058800 FAIL-ROUTINE-EX. SQ1014.2 +058900 EXIT. SQ1014.2 +059000 BAIL-OUT. SQ1014.2 +059100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1014.2 +059200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1014.2 +059300 BAIL-OUT-WRITE. SQ1014.2 +059400 MOVE CORRECT-A TO XXCORRECT. SQ1014.2 +059500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1014.2 +059600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1014.2 +059700 MOVE XXINFO TO DUMMY-RECORD. SQ1014.2 +059800 PERFORM WRITE-LINE 2 TIMES. SQ1014.2 +059900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1014.2 +060000 BAIL-OUT-EX. SQ1014.2 +060100 EXIT. SQ1014.2 +060200 CCVS1-EXIT. SQ1014.2 +060300 EXIT. SQ1014.2 +060400* SQ1014.2 +060500**************************************************************** SQ1014.2 +060600* * SQ1014.2 +060700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1014.2 +060800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1014.2 +060900* * SQ1014.2 +061000**************************************************************** SQ1014.2 +061100* SQ1014.2 +061200 SECT-SQ101-0001 SECTION. SQ1014.2 +061300 WRT-PREAMBLE. SQ1014.2 +061400 MOVE NOTE-1 TO PRINT-REC. SQ1014.2 +061500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +061600 MOVE NOTE-2 TO PRINT-REC. SQ1014.2 +061700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +061800 MOVE NOTE-3 TO PRINT-REC. SQ1014.2 +061900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062000 MOVE NOTE-4 TO PRINT-REC. SQ1014.2 +062100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062200 MOVE NOTE-5 TO PRINT-REC. SQ1014.2 +062300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062400 MOVE NOTE-6 TO PRINT-REC. SQ1014.2 +062500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062600 MOVE NOTE-7 TO PRINT-REC. SQ1014.2 +062700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +062800 MOVE NOTE-8 TO PRINT-REC. SQ1014.2 +062900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +063000 MOVE SPACE TO DUMMY-RECORD. SQ1014.2 +063100 PERFORM BLANK-LINE-PRINT. SQ1014.2 +063200* SQ1014.2 +063300**************************************************************** SQ1014.2 +063400* * SQ1014.2 +063500* THE STANDARD PAGE HEADING OF THE MONITOR OUTPUT AND THE * SQ1014.2 +063600* PREAMBLE DESCRIBING MONTORING REQUIREMENTS WILL HAVE USED * SQ1014.2 +063700* 24 LINES ON THE FIRST PAGE OF PRINTED OUTPUT. THE TESTS * SQ1014.2 +063800* ARE ARRANGED WHEREVER POSSIBLE SO THAT THE BLANK LINES * SQ1014.2 +063900* WHICH MUST BE COUNTED DO NOT INCLUDE A BOUNDARY BETWEEN * SQ1014.2 +064000* TWO PAGES. * SQ1014.2 +064100* * SQ1014.2 +064200* IT IS ASSUMED THAT A PHYSICAL PAGE CAN SHOW AT LEAST 60 * SQ1014.2 +064300* PRINTED LINES. THERE ARE THUS AT LEAST 36 LINES LEFT ON * SQ1014.2 +064400* THIS FIRST PAGE. * SQ1014.2 +064500* * SQ1014.2 +064600**************************************************************** SQ1014.2 +064700* SQ1014.2 +064800 WRT-INIT-GF-01. SQ1014.2 +064900* SQ1014.2 +065000* THIS TEST ADVANCES THE PRINT POSITION 8 LINES SQ1014.2 +065100* SQ1014.2 +065200 MOVE "WRT BEFORE ADV INT LINES" TO FEATURE. SQ1014.2 +065300 MOVE "WRT-TEST-GF-01" TO PAR-NAME. SQ1014.2 +065400 GO TO WRT-TEST-GF-01. SQ1014.2 +065500 WRT-DELETE-GF-01. SQ1014.2 +065600 PERFORM DE-LETE. SQ1014.2 +065700 GO TO WRT-END-GF-01. SQ1014.2 +065800 WRT-TEST-GF-01. SQ1014.2 +065900 PERFORM INSPT. SQ1014.2 +066000 PERFORM WRITE-TEST-LINE. SQ1014.2 +066100 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +066200 MOVE "8" TO LINES-ABOVE-1. SQ1014.2 +066300 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +066400 WRITE PRINT-REC BEFORE ADVANCING 7 LINES. SQ1014.2 +066500 WRT-END-GF-01. SQ1014.2 +066600* SQ1014.2 +066700 WRT-INIT-GF-02. SQ1014.2 +066800* SQ1014.2 +066900* THIS TEST ADVANCES THE PRINT POSITION 7 LINES SQ1014.2 +067000* SQ1014.2 +067100 MOVE "WRT BEFORE ADV INT LINE" TO FEATURE. SQ1014.2 +067200 MOVE "WRT-TEST-GF-02" TO PAR-NAME. SQ1014.2 +067300 GO TO WRT-TEST-GF-02. SQ1014.2 +067400 WRT-DELETE-GF-02. SQ1014.2 +067500 PERFORM DE-LETE. SQ1014.2 +067600 GO TO WRT-END-GF-02. SQ1014.2 +067700 WRT-TEST-GF-02. SQ1014.2 +067800 PERFORM INSPT. SQ1014.2 +067900 PERFORM WRITE-TEST-LINE. SQ1014.2 +068000 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +068100 MOVE "7" TO LINES-ABOVE-1. SQ1014.2 +068200 MOVE TEST-LINE-1 TO DUMMY-RECORD. SQ1014.2 +068300 WRITE DUMMY-RECORD BEFORE ADVANCING 6 LINE. SQ1014.2 +068400 WRT-END-GF-02. SQ1014.2 +068500* SQ1014.2 +068600 WRT-INIT-GF-03. SQ1014.2 +068700* SQ1014.2 +068800* THIS TEST ADVANCES THE PRINT POSITION 6 LINES SQ1014.2 +068900* SQ1014.2 +069000 MOVE "WRT BEFORE INTEGER LINES" TO FEATURE. SQ1014.2 +069100 MOVE "WRT-TEST-GF-03" TO PAR-NAME. SQ1014.2 +069200 GO TO WRT-TEST-GF-03. SQ1014.2 +069300 WRT-DELETE-GF-03. SQ1014.2 +069400 PERFORM DE-LETE. SQ1014.2 +069500 GO TO WRT-END-GF-03. SQ1014.2 +069600 WRT-TEST-GF-03. SQ1014.2 +069700 PERFORM INSPT. SQ1014.2 +069800 PERFORM WRITE-TEST-LINE. SQ1014.2 +069900 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +070000 MOVE "6" TO LINES-ABOVE-2. SQ1014.2 +070100 MOVE TEST-LINE-2 TO PRINT-REC. SQ1014.2 +070200 WRITE PRINT-REC BEFORE 5 LINES. SQ1014.2 +070300 WRT-END-GF-03. SQ1014.2 +070400* SQ1014.2 +070500 WRT-INIT-GF-04. SQ1014.2 +070600* SQ1014.2 +070700* THIS TEST ADVANCES THE PRINT POSITION 5 LINES SQ1014.2 +070800* SQ1014.2 +070900 MOVE "WRT BEFORE INTEGER LINE" TO FEATURE. SQ1014.2 +071000 MOVE "WRT-TEST-GF-04" TO PAR-NAME. SQ1014.2 +071100 GO TO WRT-TEST-GF-04. SQ1014.2 +071200 WRT-DELETE-GF-04. SQ1014.2 +071300 PERFORM DE-LETE. SQ1014.2 +071400 GO TO WRT-END-GF-04. SQ1014.2 +071500 WRT-TEST-GF-04. SQ1014.2 +071600 PERFORM INSPT. SQ1014.2 +071700 PERFORM WRITE-TEST-LINE. SQ1014.2 +071800 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +071900 MOVE "5" TO LINES-ABOVE-2. SQ1014.2 +072000 MOVE TEST-LINE-2 TO DUMMY-RECORD. SQ1014.2 +072100 WRITE DUMMY-RECORD BEFORE 4 LINE. SQ1014.2 +072200 WRT-END-GF-04. SQ1014.2 +072300* SQ1014.2 +072400 WRT-INIT-GF-05. SQ1014.2 +072500* SQ1014.2 +072600* THIS TEST ADVANCES THE PRINT POSITION 5 LINES SQ1014.2 +072700* SQ1014.2 +072800 MOVE "WRT AFTER ADV INT LINES" TO FEATURE. SQ1014.2 +072900 MOVE "WRT-TEST-GF-05" TO PAR-NAME. SQ1014.2 +073000 GO TO WRT-TEST-GF-05. SQ1014.2 +073100 WRT-DELETE-GF-05. SQ1014.2 +073200 PERFORM DE-LETE. SQ1014.2 +073300 GO TO WRT-END-GF-05. SQ1014.2 +073400 WRT-TEST-GF-05. SQ1014.2 +073500 PERFORM INSPT. SQ1014.2 +073600 PERFORM WRITE-TEST-LINE. SQ1014.2 +073700 MOVE "4" TO LINES-BELOW-1. SQ1014.2 +073800 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +073900 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +074000 WRITE PRINT-REC AFTER ADVANCING 3 LINES. SQ1014.2 +074100 WRT-END-GF-05. SQ1014.2 +074200* SQ1014.2 +074300 WRT-INIT-GF-06. SQ1014.2 +074400* SQ1014.2 +074500* THE NEXT TEST IN NORMAL SEQUENCE WOULD COME VERY NEAR TO SQ1014.2 +074600* OVERFLOWING THE CURRENT PAGE, SO THE FIRST OF THE TESTS OF SQ1014.2 +074700* ADVANCING PAGE IS INSERTED HERE. IT SHOULD LEAVE LINE 2 SQ1014.2 +074800* ON THE NEW PAGE AS THE CURRENT LINE, SO THAT THE FIRST SQ1014.2 +074900* WRT-TEST LINE ON THE NEW PAGE IS THE THIRD PRINTABLE LINE. SQ1014.2 +075000* SQ1014.2 +075100 MOVE "WRT BEFORE ADV PAGE" TO FEATURE. SQ1014.2 +075200 MOVE "WRT-TEST-GF-06" TO PAR-NAME. SQ1014.2 +075300 GO TO WRT-TEST-GF-06. SQ1014.2 +075400 WRT-DELETE-GF-06. SQ1014.2 +075500 PERFORM DE-LETE. SQ1014.2 +075600 GO TO WRT-END-GF-06. SQ1014.2 +075700 WRT-TEST-GF-06. SQ1014.2 +075800 PERFORM INSPT. SQ1014.2 +075900 PERFORM WRITE-TEST-LINE. SQ1014.2 +076000 MOVE LAST-LINE TO PRINT-REC. SQ1014.2 +076100 WRITE PRINT-REC BEFORE ADVANCING PAGE. SQ1014.2 +076200 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +076300 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ1014.2 +076400 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +076500 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ1014.2 +076600 WRT-END-GF-06. SQ1014.2 +076700* SQ1014.2 +076800 WRT-INIT-GF-07. SQ1014.2 +076900* SQ1014.2 +077000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES TO LINE 6 SQ1014.2 +077100* SQ1014.2 +077200 MOVE "WRT AFTER ADV INT LINE" TO FEATURE. SQ1014.2 +077300 MOVE "WRT-TEST-GF-07" TO PAR-NAME. SQ1014.2 +077400 GO TO WRT-TEST-GF-07. SQ1014.2 +077500 WRT-DELETE-GF-07. SQ1014.2 +077600 PERFORM DE-LETE. SQ1014.2 +077700 GO TO WRT-END-GF-07. SQ1014.2 +077800 WRT-TEST-GF-07. SQ1014.2 +077900 PERFORM INSPT. SQ1014.2 +078000 PERFORM WRITE-TEST-LINE. SQ1014.2 +078100 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +078200 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +078300 MOVE TEST-LINE-1 TO DUMMY-RECORD. SQ1014.2 +078400 WRITE DUMMY-RECORD AFTER ADVANCING 2 LINES. SQ1014.2 +078500 WRT-END-GF-07. SQ1014.2 +078600* SQ1014.2 +078700 WRT-INIT-GF-08. SQ1014.2 +078800* SQ1014.2 +078900* THIS TEST IS IN TWO PARTS. IT PRINTS ON THE LINE BELOW SQ1014.2 +079000* THE MARKER LINE, THEN OVERPRINTS THAT LINE, ADVANCING ZERO SQ1014.2 +079100* LINES AFTER PRINTING. SQ1014.2 +079200* TOTAL PAPER ADVANCE IS TWO LINES, TO LINE 8. SQ1014.2 +079300* SQ1014.2 +079400 MOVE "WRT AFTER INT LINE/S" TO FEATURE. SQ1014.2 +079500 MOVE "WRT-TEST-GF-08" TO PAR-NAME. SQ1014.2 +079600 GO TO WRT-TEST-GF-08. SQ1014.2 +079700 WRT-DELETE-GF-08. SQ1014.2 +079800 PERFORM DE-LETE. SQ1014.2 +079900 GO TO WRT-END-GF-08. SQ1014.2 +080000 WRT-TEST-GF-08. SQ1014.2 +080100 PERFORM INSPT. SQ1014.2 +080200 PERFORM WRITE-TEST-LINE. SQ1014.2 +080300 MOVE "08" TO OVERPRINTED-TEST. SQ1014.2 +080400 MOVE OVERPRINTED-LINE TO PRINT-REC. SQ1014.2 +080500 WRITE PRINT-REC AFTER 1 LINES. SQ1014.2 +080600 MOVE "08" TO OVERPRINT-TEST. SQ1014.2 +080700 MOVE OVERPRINT-LINE TO PRINT-REC. SQ1014.2 +080800 WRITE PRINT-REC AFTER 0 LINE. SQ1014.2 +080900 WRT-END-GF-08. SQ1014.2 +081000* SQ1014.2 +081100 WRT-INIT-GF-09. SQ1014.2 +081200* SQ1014.2 +081300* THIS TEST ADVANCES THE PRINT POSITION 12 LINES, TO LINE 20 SQ1014.2 +081400* SQ1014.2 +081500 MOVE 1 TO REC-CT. SQ1014.2 +081600 MOVE "WRT FRM BFR ADV INT LINS" TO FEATURE. SQ1014.2 +081700 MOVE "WRT-TEST-GF-09" TO PAR-NAME. SQ1014.2 +081800 GO TO WRT-TEST-GF-09. SQ1014.2 +081900 WRT-DELETE-GF-09. SQ1014.2 +082000 PERFORM DE-LETE. SQ1014.2 +082100 GO TO WRT-END-GF-09. SQ1014.2 +082200 WRT-TEST-GF-09. SQ1014.2 +082300 PERFORM INSPT. SQ1014.2 +082400 PERFORM WRITE-TEST-LINE. SQ1014.2 +082500 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +082600 MOVE "11" TO LINES-ABOVE-1. SQ1014.2 +082700 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE ADVANCING 10 LINES. SQ1014.2 +082800 WRT-END-GF-09. SQ1014.2 +082900* SQ1014.2 +083000 WRT-INIT-GF-10. SQ1014.2 +083100* SQ1014.2 +083200* THIS TEST ADVANCES THE PRINT POSITION 22 LINES, TO LINE 44 SQ1014.2 +083300* SQ1014.2 +083400 MOVE "WRT FRM BFR ADV INT LINE" TO FEATURE. SQ1014.2 +083500 MOVE "WRT-TEST-GF-10" TO PAR-NAME. SQ1014.2 +083600 GO TO WRT-TEST-GF-10. SQ1014.2 +083700 WRT-DELETE-GF-10. SQ1014.2 +083800 PERFORM DE-LETE. SQ1014.2 +083900 GO TO WRT-END-GF-10. SQ1014.2 +084000 WRT-TEST-GF-10. SQ1014.2 +084100 PERFORM INSPT. SQ1014.2 +084200 PERFORM WRITE-TEST-LINE. SQ1014.2 +084300 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +084400 MOVE "21" TO LINES-ABOVE-2. SQ1014.2 +084500 WRITE DUMMY-RECORD FROM TEST-LINE-2 BEFORE ADVANCING 20 LINE.SQ1014.2 +084600 WRT-END-GF-10. SQ1014.2 +084700* SQ1014.2 +084800 WRT-INIT-GF-11. SQ1014.2 +084900* SQ1014.2 +085000* THIS TEST ADVANCES THE PRINT POSITION 13 LINES, TO LINE 57 SQ1014.2 +085100* SQ1014.2 +085200 MOVE "WRT FRM BEFORE INT LINES" TO FEATURE. SQ1014.2 +085300 MOVE "WRT-TEST-GF-11" TO PAR-NAME. SQ1014.2 +085400 GO TO WRT-TEST-GF-11. SQ1014.2 +085500 WRT-DELETE-GF-11. SQ1014.2 +085600 PERFORM DE-LETE. SQ1014.2 +085700 GO TO WRT-END-GF-11. SQ1014.2 +085800 WRT-TEST-GF-11. SQ1014.2 +085900 PERFORM INSPT. SQ1014.2 +086000 PERFORM WRITE-TEST-LINE. SQ1014.2 +086100 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +086200 MOVE "12" TO LINES-ABOVE-1. SQ1014.2 +086300 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE 11 LINES. SQ1014.2 +086400 WRT-END-GF-11. SQ1014.2 +086500* SQ1014.2 +086600 WRT-INIT-GF-12. SQ1014.2 +086700* SQ1014.2 +086800* THE NEXT TEST IN NORMAL SEQUENCE WOULD PROBABLY OVERFLOW SQ1014.2 +086900* THE CURRENT PAGE, SO ANOTHER TEST OF ADVANCING PAGE IS SQ1014.2 +087000* INSERTED HERE. IT SHOULD LEAVE LINE 2 ON THE NEW PAGE AS SQ1014.2 +087100* THE CURRENT LINE, SO THAT THE FIRST WRT-TEST LINE ON THE SQ1014.2 +087200* NEW PAGE IS ON THE THIRD PRINTABLE LINE. SQ1014.2 +087300* SQ1014.2 +087400 MOVE "WRITE BEFORE PAGE" TO FEATURE. SQ1014.2 +087500 MOVE "WRT-TEST-GF-12" TO PAR-NAME. SQ1014.2 +087600 GO TO WRT-TEST-GF-12. SQ1014.2 +087700 WRT-DELETE-GF-12. SQ1014.2 +087800 PERFORM DE-LETE. SQ1014.2 +087900 GO TO WRT-END-GF-12. SQ1014.2 +088000 WRT-TEST-GF-12. SQ1014.2 +088100 PERFORM INSPT. SQ1014.2 +088200 PERFORM WRITE-TEST-LINE. SQ1014.2 +088300 MOVE LAST-LINE TO PRINT-REC. SQ1014.2 +088400 WRITE PRINT-REC BEFORE PAGE. SQ1014.2 +088500 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +088600 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ1014.2 +088700 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +088800 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ1014.2 +088900 WRT-END-GF-12. SQ1014.2 +089000* SQ1014.2 +089100 WRT-INIT-GF-13. SQ1014.2 +089200* SQ1014.2 +089300* THIS TEST ADVANCES THE PRINT POSITION 42 LINES, TO LINE 44 SQ1014.2 +089400* SQ1014.2 +089500 MOVE "WRT FROM BEFORE INT LINE" TO FEATURE. SQ1014.2 +089600 MOVE "WRT-TEST-GF-13" TO PAR-NAME. SQ1014.2 +089700 GO TO WRT-TEST-GF-13. SQ1014.2 +089800 WRT-DELETE-GF-13. SQ1014.2 +089900 PERFORM DE-LETE. SQ1014.2 +090000 GO TO WRT-END-GF-13. SQ1014.2 +090100 WRT-TEST-GF-13. SQ1014.2 +090200 PERFORM INSPT. SQ1014.2 +090300 PERFORM WRITE-TEST-LINE. SQ1014.2 +090400 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +090500 MOVE "41" TO LINES-ABOVE-2. SQ1014.2 +090600 WRITE DUMMY-RECORD FROM TEST-LINE-2 BEFORE 40 LINE. SQ1014.2 +090700 WRT-END-GF-13. SQ1014.2 +090800* SQ1014.2 +090900 WRT-INIT-GF-14. SQ1014.2 +091000* SQ1014.2 +091100* THE NEXT TEST IN NORMAL SEQUENCE WOULD PROBABLY OVERFLOW SQ1014.2 +091200* THE CURRENT PAGE, SO ANOTHER TEST OF ADVANCING PAGE IS SQ1014.2 +091300* INSERTED HERE. IT SHOULD LEAVE LINE 2 ON THE NEW PAGE AS SQ1014.2 +091400* THE CURRENT LINE, SO THAT THE FIRST WRT-TEST LINE ON THE SQ1014.2 +091500* NEW PAGE IS ON THE THIRD PRINTABLE LINE. SQ1014.2 +091600* SQ1014.2 +091700 MOVE "WRT AFTER ADV PAGE" TO FEATURE. SQ1014.2 +091800 MOVE "WRT-TEST-GF-14" TO PAR-NAME. SQ1014.2 +091900 GO TO WRT-TEST-GF-14. SQ1014.2 +092000 WRT-DELETE-GF-14. SQ1014.2 +092100 PERFORM DE-LETE. SQ1014.2 +092200 GO TO WRT-END-GF-14. SQ1014.2 +092300 WRT-TEST-GF-14. SQ1014.2 +092400 PERFORM INSPT. SQ1014.2 +092500 PERFORM WRITE-TEST-LINE. SQ1014.2 +092600 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +092700 WRITE PRINT-REC AFTER ADVANCING PAGE. SQ1014.2 +092800 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +092900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +093000 WRT-END-GF-14. SQ1014.2 +093100* SQ1014.2 +093200 WRT-INIT-GF-15. SQ1014.2 +093300* SQ1014.2 +093400* THIS TEST ADVANCES THE PRINT POSITION 52 LINES, TO LINE 54 SQ1014.2 +093500* SQ1014.2 +093600 MOVE "WRT FRM AFT ADV INT LINS" TO FEATURE. SQ1014.2 +093700 MOVE "WRT-TEST-GF-15" TO PAR-NAME. SQ1014.2 +093800 GO TO WRT-TEST-GF-15. SQ1014.2 +093900 WRT-DELETE-GF-15. SQ1014.2 +094000 PERFORM DE-LETE. SQ1014.2 +094100 GO TO WRT-END-GF-15. SQ1014.2 +094200 WRT-TEST-GF-15. SQ1014.2 +094300 PERFORM INSPT. SQ1014.2 +094400 PERFORM WRITE-TEST-LINE. SQ1014.2 +094500 MOVE "51" TO LINES-BELOW-1. SQ1014.2 +094600 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +094700 WRITE PRINT-REC FROM TEST-LINE-1 AFTER ADVANCING 50 LINES. SQ1014.2 +094800 WRT-END-GF-15. SQ1014.2 +094900* SQ1014.2 +095000 WRT-INIT-GF-16. SQ1014.2 +095100* SQ1014.2 +095200* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 55 SQ1014.2 +095300* SQ1014.2 +095400 MOVE "WRT FRM AFT ADV INT LINE" TO FEATURE. SQ1014.2 +095500 MOVE "WRT-TEST-GF-16" TO PAR-NAME. SQ1014.2 +095600 GO TO WRT-TEST-GF-16. SQ1014.2 +095700 WRT-DELETE-GF-16. SQ1014.2 +095800 PERFORM DE-LETE. SQ1014.2 +095900 GO TO WRT-END-GF-16. SQ1014.2 +096000 WRT-TEST-GF-16. SQ1014.2 +096100 PERFORM INSPT. SQ1014.2 +096200 PERFORM WRITE-TEST-LINE. SQ1014.2 +096300 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +096400 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +096500 WRITE PRINT-REC FROM TEST-LINE-1 AFTER ADVANCING 1 LINE. SQ1014.2 +096600 WRT-END-GF-16. SQ1014.2 +096700* SQ1014.2 +096800 WRT-INIT-GF-17. SQ1014.2 +096900* SQ1014.2 +097000* THE NEXT TEST IN NORMAL SEQUENCE WOULD PROBABLY OVERFLOW SQ1014.2 +097100* THE CURRENT PAGE, SO ANOTHER TEST OF ADVANCING PAGE IS SQ1014.2 +097200* INSERTED HERE. IT SHOULD LEAVE LINE 2 ON THE NEW PAGE AS SQ1014.2 +097300* THE CURRENT LINE, SO THAT THE FIRST WRT-TEST LINE ON THE SQ1014.2 +097400* NEW PAGE IS ON THE THIRD PRINTABLE LINE. SQ1014.2 +097500* SQ1014.2 +097600 MOVE "WRITE AFTER PAGE" TO FEATURE. SQ1014.2 +097700 MOVE "WRT-TEST-GF-17" TO PAR-NAME. SQ1014.2 +097800 GO TO WRT-TEST-GF-17. SQ1014.2 +097900 WRT-DELETE-GF-17. SQ1014.2 +098000 PERFORM DE-LETE. SQ1014.2 +098100 GO TO WRT-END-GF-17. SQ1014.2 +098200 WRT-TEST-GF-17. SQ1014.2 +098300 PERFORM INSPT. SQ1014.2 +098400 PERFORM WRITE-TEST-LINE. SQ1014.2 +098500 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +098600 WRITE PRINT-REC AFTER PAGE. SQ1014.2 +098700 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +098800 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +098900 WRT-END-GF-17. SQ1014.2 +099000* SQ1014.2 +099100 WRT-INIT-GF-18. SQ1014.2 +099200* SQ1014.2 +099300* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 5 SQ1014.2 +099400* SQ1014.2 +099500 MOVE "WRT FRM AFTER INT LINE/S" TO FEATURE. SQ1014.2 +099600 MOVE "WRT-TEST-GF-18" TO PAR-NAME. SQ1014.2 +099700 GO TO WRT-TEST-GF-18. SQ1014.2 +099800 WRT-DELETE-GF-18. SQ1014.2 +099900 PERFORM DE-LETE. SQ1014.2 +100000 GO TO WRT-END-GF-18. SQ1014.2 +100100 WRT-TEST-GF-18. SQ1014.2 +100200 PERFORM INSPT. SQ1014.2 +100300 PERFORM WRITE-TEST-LINE. SQ1014.2 +100400 MOVE "18" TO OVERPRINTED-TEST. SQ1014.2 +100500 WRITE PRINT-REC FROM OVERPRINTED-LINE AFTER SQ1014.2 +100600 000000000000000001 LINE. SQ1014.2 +100700 MOVE "18" TO OVERPRINT-TEST. SQ1014.2 +100800 WRITE PRINT-REC FROM OVERPRINT-LINE AFTER SQ1014.2 +100900 000000000000000000 LINES. SQ1014.2 +101000 WRT-END-GF-18. SQ1014.2 +101100* SQ1014.2 +101200 WRT-INIT-GF-19. SQ1014.2 +101300* SQ1014.2 +101400* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 8 SQ1014.2 +101500* SQ1014.2 +101600 MOVE "WRITE" TO FEATURE. SQ1014.2 +101700 MOVE "WRT-TEST-GF-19" TO PAR-NAME. SQ1014.2 +101800 GO TO WRT-TEST-GF-19. SQ1014.2 +101900 WRT-DELETE-GF-19. SQ1014.2 +102000 PERFORM DE-LETE. SQ1014.2 +102100 GO TO WRT-END-GF-19. SQ1014.2 +102200 WRT-TEST-GF-19. SQ1014.2 +102300 PERFORM INSPT. SQ1014.2 +102400 PERFORM WRITE-TEST-LINE. SQ1014.2 +102500 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +102600 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +102700 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +102800 WRITE PRINT-REC. SQ1014.2 +102900 WRT-END-GF-19. SQ1014.2 +103000* SQ1014.2 +103100 WRT-INIT-GF-20. SQ1014.2 +103200* SQ1014.2 +103300* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 11 SQ1014.2 +103400* SQ1014.2 +103500 MOVE "WRITE FROM" TO FEATURE. SQ1014.2 +103600 MOVE "WRT-TEST-GF-20" TO PAR-NAME. SQ1014.2 +103700 GO TO WRT-TEST-GF-20. SQ1014.2 +103800 WRT-DELETE-GF-20. SQ1014.2 +103900 PERFORM DE-LETE. SQ1014.2 +104000 GO TO WRT-END-GF-20. SQ1014.2 +104100 WRT-TEST-GF-20. SQ1014.2 +104200 PERFORM INSPT. SQ1014.2 +104300 PERFORM WRITE-TEST-LINE. SQ1014.2 +104400 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +104500 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +104600 WRITE PRINT-REC FROM TEST-LINE-1. SQ1014.2 +104700 WRT-END-GF-20. SQ1014.2 +104800* SQ1014.2 +104900 WRT-INIT-GF-21. SQ1014.2 +105000* SQ1014.2 +105100* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 14 SQ1014.2 +105200* IDENTIFIER-1 IS A SUBORDINATE GROUP ITEM SQ1014.2 +105300* SQ1014.2 +105400 MOVE "WRT SUBGR BFR ADV INT" TO FEATURE. SQ1014.2 +105500 MOVE "WRT-TEST-GF-21" TO PAR-NAME. SQ1014.2 +105600 GO TO WRT-TEST-GF-21. SQ1014.2 +105700 WRT-DELETE-GF-21. SQ1014.2 +105800 PERFORM DE-LETE. SQ1014.2 +105900 GO TO WRT-END-GF-21. SQ1014.2 +106000 WRT-TEST-GF-21. SQ1014.2 +106100 PERFORM INSPT. SQ1014.2 +106200 PERFORM WRITE-TEST-LINE. SQ1014.2 +106300 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +106400 MOVE "2" TO LINES-ABOVE-2. SQ1014.2 +106500 WRITE PRINT-REC FROM TEST-LINE-2 BEFORE ADVANCING 1. SQ1014.2 +106600 WRT-END-GF-21. SQ1014.2 +106700* SQ1014.2 +106800 WRT-INIT-GF-22. SQ1014.2 +106900* SQ1014.2 +107000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 18 SQ1014.2 +107100* IDENTIFIER-1 IS A SUBORDINATE GROUP ITEM SQ1014.2 +107200* SQ1014.2 +107300 MOVE "WRT SUBGRP BEFORE INT" TO FEATURE. SQ1014.2 +107400 MOVE "WRT-TEST-GF-22" TO PAR-NAME. SQ1014.2 +107500 GO TO WRT-TEST-GF-22. SQ1014.2 +107600 WRT-DELETE-GF-22. SQ1014.2 +107700 PERFORM DE-LETE. SQ1014.2 +107800 GO TO WRT-END-GF-22. SQ1014.2 +107900 WRT-TEST-GF-22. SQ1014.2 +108000 PERFORM INSPT. SQ1014.2 +108100 PERFORM WRITE-TEST-LINE. SQ1014.2 +108200 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +108300 MOVE "3" TO LINES-ABOVE-2. SQ1014.2 +108400 WRITE PRINT-REC FROM TEST-LINE-2 BEFORE 2. SQ1014.2 +108500 WRT-END-GF-22. SQ1014.2 +108600* SQ1014.2 +108700 WRT-INIT-GF-23. SQ1014.2 +108800* SQ1014.2 +108900* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 21 SQ1014.2 +109000* SQ1014.2 +109100 MOVE "WRT FROM 77 AFT ADV INT" TO FEATURE. SQ1014.2 +109200 MOVE "WRT-TEST-23" TO PAR-NAME. SQ1014.2 +109300 GO TO WRT-TEST-GF-23. SQ1014.2 +109400 WRT-DELETE-GF-23. SQ1014.2 +109500 PERFORM DE-LETE. SQ1014.2 +109600 GO TO WRT-END-GF-23. SQ1014.2 +109700 WRT-TEST-GF-23. SQ1014.2 +109800 PERFORM INSPT. SQ1014.2 +109900 PERFORM WRITE-TEST-LINE. SQ1014.2 +110000 WRITE PRINT-REC FROM SEVENTY-SEVEN AFTER ADVANCING 1. SQ1014.2 +110100 WRT-END-GF-23. SQ1014.2 +110200* SQ1014.2 +110300 WRT-INIT-GF-24. SQ1014.2 +110400* SQ1014.2 +110500* THIS TEST ADVANCES THE PRINT POSITION 5 LINES, TO LINE 26 SQ1014.2 +110600* SQ1014.2 +110700 MOVE "WRT FROM AFTER INT" TO FEATURE. SQ1014.2 +110800 MOVE "WRT-TEST-GF-24" TO PAR-NAME. SQ1014.2 +110900 GO TO WRT-TEST-GF-24. SQ1014.2 +111000 WRT-DELETE-GF-24. SQ1014.2 +111100 PERFORM DE-LETE. SQ1014.2 +111200 GO TO WRT-END-GF-24. SQ1014.2 +111300 WRT-TEST-GF-24. SQ1014.2 +111400 PERFORM INSPT. SQ1014.2 +111500 PERFORM WRITE-TEST-LINE. SQ1014.2 +111600 MOVE "4" TO LINES-BELOW-1. SQ1014.2 +111700 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +111800 WRITE PRINT-REC FROM TEST-LINE-1 AFTER 3. SQ1014.2 +111900 WRT-END-GF-24. SQ1014.2 +112000* SQ1014.2 +112100 WRT-INIT-GF-25. SQ1014.2 +112200* SQ1014.2 +112300* THIS TEST ADVANCES THE PRINT POSITION 2 LINES, TO LINE 28 SQ1014.2 +112400* SQ1014.2 +112500 MOVE "WRT BEFORE ADV ZERO" TO FEATURE. SQ1014.2 +112600 MOVE "WRT-TEST-GF-25" TO PAR-NAME. SQ1014.2 +112700 GO TO WRT-TEST-GF-25. SQ1014.2 +112800 WRT-DELETE-GF-25. SQ1014.2 +112900 PERFORM DE-LETE. SQ1014.2 +113000 GO TO WRT-END-GF-25. SQ1014.2 +113100 WRT-TEST-GF-25. SQ1014.2 +113200 PERFORM INSPT. SQ1014.2 +113300 PERFORM WRITE-TEST-LINE. SQ1014.2 +113400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +113500 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +113600 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +113700 WRITE PRINT-REC BEFORE ADVANCING ZERO. SQ1014.2 +113800 WRT-END-GF-25. SQ1014.2 +113900* SQ1014.2 +114000 WRT-INIT-GF-26. SQ1014.2 +114100* SQ1014.2 +114200* THIS TEST ADVANCES THE PRINT POSITION 7 LINES, TO LINE 35 SQ1014.2 +114300* SQ1014.2 +114400 MOVE "WRT BEFORE INT" TO FEATURE. SQ1014.2 +114500 MOVE "WRT-TEST-GF-26" TO PAR-NAME. SQ1014.2 +114600 GO TO WRT-TEST-GF-26. SQ1014.2 +114700 WRT-DELETE-GF-26. SQ1014.2 +114800 PERFORM DE-LETE. SQ1014.2 +114900 GO TO WRT-END-GF-26. SQ1014.2 +115000 WRT-TEST-GF-26. SQ1014.2 +115100 PERFORM INSPT. SQ1014.2 +115200 PERFORM WRITE-TEST-LINE. SQ1014.2 +115300 MOVE "1" TO LINES-BELOW-2. SQ1014.2 +115400 MOVE "6" TO LINES-ABOVE-2. SQ1014.2 +115500 MOVE TEST-LINE-2 TO PRINT-REC. SQ1014.2 +115600 WRITE PRINT-REC BEFORE 5. SQ1014.2 +115700 WRT-END-GF-26. SQ1014.2 +115800* SQ1014.2 +115900 WRT-INIT-GF-27. SQ1014.2 +116000* SQ1014.2 +116100* THIS TEST ADVANCES THE PRINT POSITION 7 LINES, TO LINE 42 SQ1014.2 +116200* SQ1014.2 +116300 MOVE "WRT AFTER ADVANCING INT" TO FEATURE. SQ1014.2 +116400 MOVE "WRT-TEST-GF-27" TO PAR-NAME. SQ1014.2 +116500 GO TO WRT-TEST-GF-27. SQ1014.2 +116600 WRT-DELETE-GF-27. SQ1014.2 +116700 PERFORM DE-LETE. SQ1014.2 +116800 GO TO WRT-END-GF-27. SQ1014.2 +116900 WRT-TEST-GF-27. SQ1014.2 +117000 PERFORM INSPT. SQ1014.2 +117100 PERFORM WRITE-TEST-LINE. SQ1014.2 +117200 MOVE "6" TO LINES-BELOW-2. SQ1014.2 +117300 MOVE "1" TO LINES-ABOVE-2. SQ1014.2 +117400 MOVE TEST-LINE-2 TO PRINT-REC. SQ1014.2 +117500 WRITE PRINT-REC AFTER ADVANCING 5. SQ1014.2 +117600 WRT-END-GF-27. SQ1014.2 +117700* SQ1014.2 +117800 WRT-INIT-GF-28. SQ1014.2 +117900* SQ1014.2 +118000* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 45 SQ1014.2 +118100* SQ1014.2 +118200 MOVE "WRT AFTER INT" TO FEATURE. SQ1014.2 +118300 MOVE "WRT-TEST-GF-28" TO PAR-NAME. SQ1014.2 +118400 GO TO WRT-TEST-GF-28. SQ1014.2 +118500 WRT-DELETE-GF-28. SQ1014.2 +118600 PERFORM DE-LETE. SQ1014.2 +118700 GO TO WRT-END-GF-28. SQ1014.2 +118800 WRT-TEST-GF-28. SQ1014.2 +118900 PERFORM INSPT. SQ1014.2 +119000 PERFORM WRITE-TEST-LINE. SQ1014.2 +119100 MOVE "2" TO LINES-BELOW-2. SQ1014.2 +119200 MOVE "1" TO LINES-ABOVE-2. SQ1014.2 +119300 MOVE TEST-LINE-2 TO PRINT-REC. SQ1014.2 +119400 WRITE PRINT-REC AFTER 1. SQ1014.2 +119500 WRT-END-GF-28. SQ1014.2 +119600* SQ1014.2 +119700 WRT-INIT-GF-29. SQ1014.2 +119800* SQ1014.2 +119900* THIS TEST ADVANCES THE PRINT POSITION TO A NEW PAGE. IT SQ1014.2 +120000* SHOULD LEAVE LINE 2 ON THE NEW PAGE AS THE CURRENT LINE, SO SQ1014.2 +120100* THAT THE FIRST WRT-TEST LINE ON THE NEW PAGE IS ON THE SQ1014.2 +120200* THIRD PRINTABLE LINE. SQ1014.2 +120300* SQ1014.2 +120400 MOVE "WRT FROM BEFORE ADV PAGE" TO FEATURE. SQ1014.2 +120500 MOVE "WRT-TEST-GF-29" TO PAR-NAME. SQ1014.2 +120600 GO TO WRT-TEST-GF-29. SQ1014.2 +120700 WRT-DELETE-GF-29. SQ1014.2 +120800 PERFORM DE-LETE. SQ1014.2 +120900 GO TO WRT-END-GF-29. SQ1014.2 +121000 WRT-TEST-GF-29. SQ1014.2 +121100 PERFORM INSPT. SQ1014.2 +121200 PERFORM WRITE-TEST-LINE. SQ1014.2 +121300 WRITE DUMMY-RECORD FROM LAST-LINE BEFORE ADVANCING PAGE. SQ1014.2 +121400 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +121500 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ1014.2 +121600 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +121700 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ1014.2 +121800 WRT-END-GF-29. SQ1014.2 +121900* SQ1014.2 +122000 WRT-INIT-GF-30. SQ1014.2 +122100* SQ1014.2 +122200* THIS TEST ADVANCES THE PRINT POSITION MANY LINES, SQ1014.2 +122300* OVERFLOWING SEVERAL PAGES. NO SPECIAL PROVISION IS MADE SQ1014.2 +122400* FOR OVERFLOW HANDLING. SQ1014.2 +122500* SQ1014.2 +122600 MOVE "CHARACTERS IN COLUMN 1" TO FEATURE. SQ1014.2 +122700 MOVE "WRT-TEST-GF-30" TO PAR-NAME. SQ1014.2 +122800 GO TO WRT-TEST-GF-30. SQ1014.2 +122900 WRT-DELETE-GF-30. SQ1014.2 +123000 PERFORM DE-LETE. SQ1014.2 +123100 GO TO WRT-END-GF-30. SQ1014.2 +123200 WRT-TEST-GF-30. SQ1014.2 +123300 PERFORM INSPT. SQ1014.2 +123400 PERFORM WRITE-TEST-LINE. SQ1014.2 +123500 PERFORM BLANK-LINE-PRINT. SQ1014.2 +123600 MOVE " COLUMN 1 OF EACH OF THE LINES BELOW CONTAINS A NON-BLASQ1014.2 +123700- "NK CHARACTER. IN THE PAST, CHARACTERS IN THIS POSITION MIGHSQ1014.2 +123800- "T" TO PRINT-REC. SQ1014.2 +123900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +124000 MOVE " HAVE CONTROLLED PAPER MOVEMENT AND BEEN SUPPRESSED. TSQ1014.2 +124100- "HIS PRACTICE DOES NOT CONFORM TO THE STANDARD." SQ1014.2 +124200 TO PRINT-REC. SQ1014.2 +124300 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ1014.2 +124400 MOVE " ALL LINES SHOULD BE PRINTED SINGLE-SPACED, AND EACH SQ1014.2 +124500- " CONTAINS A SEQUENCE NUMBER, STARTING WITH 001" SQ1014.2 +124600 TO PRINT-REC. SQ1014.2 +124700 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ1014.2 +124800 MOVE " THE CHARACTERS PRINTED SHOULD BE AS FOLLOWS --- 0 1 2 SQ1014.2 +124900- "3 4 5 6 7 8 9 + - * / = $ , . ; ( ) < > A B C . . . Z AND" SQ1014.2 +125000 TO PRINT-REC. SQ1014.2 +125100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +125200 MOVE " a b c . . . z AND QUOTE" TO PRINT-REC. SQ1014.2 +125300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +125400 MOVE " PRINTING BEGINS ON THE NEXT LINE BELOW ---" SQ1014.2 +125500 TO PRINT-REC. SQ1014.2 +125600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +125700 MOVE SPACES TO CHAR-LINE. SQ1014.2 +125800 MOVE ZERO TO LIN-SER. SQ1014.2 +125900 MOVE "0" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126000 MOVE "1" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126100 MOVE "2" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126200 MOVE "3" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126300 MOVE "4" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126400 MOVE "5" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126500 MOVE "6" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126600 MOVE "7" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126700 MOVE "8" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126800 MOVE "9" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +126900 MOVE "+" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127000 MOVE "-" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127100 MOVE "*" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127200 MOVE "/" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127300 MOVE "=" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127400 MOVE "$" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127500 MOVE "," TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127600 MOVE "." TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127700 MOVE ";" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127800 MOVE "(" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +127900 MOVE ")" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128000 MOVE "<" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128100 MOVE ">" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128200 MOVE "A" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128300 MOVE "B" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128400 MOVE "C" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128500 MOVE "D" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128600 MOVE "E" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128700 MOVE "F" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128800 MOVE "G" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +128900 MOVE "H" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129000 MOVE "I" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129100 MOVE "J" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129200 MOVE "K" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129300 MOVE "L" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129400 MOVE "M" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129500 MOVE "N" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129600 MOVE "O" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129700 MOVE "P" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129800 MOVE "Q" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +129900 MOVE "R" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130000 MOVE "S" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130100 MOVE "T" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130200 MOVE "U" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130300 MOVE "V" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130400 MOVE "W" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130500 MOVE "X" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130600 MOVE "Y" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130700 MOVE "Z" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130800 MOVE "a" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +130900 MOVE "b" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131000 MOVE "c" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131100 MOVE "d" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131200 MOVE "e" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131300 MOVE "f" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131400 MOVE "g" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131500 MOVE "h" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131600 MOVE "i" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131700 MOVE "j" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131800 MOVE "k" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +131900 MOVE "l" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132000 MOVE "m" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132100 MOVE "n" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132200 MOVE "o" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132300 MOVE "p" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132400 MOVE "q" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132500 MOVE "r" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132600 MOVE "s" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132700 MOVE "t" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132800 MOVE "u" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +132900 MOVE "v" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133000 MOVE "w" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133100 MOVE "x" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133200 MOVE "y" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133300 MOVE "z" TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133400 MOVE QU-OTE TO LIN-CH PERFORM COL-1-CHAR-PRINT. SQ1014.2 +133500 WRT-END-GF-30. SQ1014.2 +133600* SQ1014.2 +133700 WRT-INIT-GF-31. SQ1014.2 +133800* SQ1014.2 +133900* THIS TEST ADVANCES THE PRINT POSITION TO A NEW PAGE. IT SQ1014.2 +134000* SHOULD LEAVE LINE 2 ON THE NEW PAGE AS THE CURRENT LINE, SO SQ1014.2 +134100* THAT THE FIRST WRT-TEST LINE ON THE NEW PAGE IS ON THE SQ1014.2 +134200* THIRD PRINTABLE LINE. SQ1014.2 +134300* SQ1014.2 +134400 MOVE "WRT FROM BEFORE PAGE" TO FEATURE. SQ1014.2 +134500 MOVE "WRT-TEST-GF-31" TO PAR-NAME. SQ1014.2 +134600 GO TO WRT-TEST-GF-31. SQ1014.2 +134700 WRT-DELETE-GF-31. SQ1014.2 +134800 PERFORM DE-LETE. SQ1014.2 +134900 GO TO WRT-END-GF-31. SQ1014.2 +135000 WRT-TEST-GF-31. SQ1014.2 +135100 PERFORM INSPT. SQ1014.2 +135200 PERFORM WRITE-TEST-LINE. SQ1014.2 +135300 WRITE DUMMY-RECORD FROM LAST-LINE BEFORE PAGE. SQ1014.2 +135400 MOVE NEW-PAGE-LINE TO PRINT-REC. SQ1014.2 +135500 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ1014.2 +135600 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +135700 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ1014.2 +135800 WRT-END-GF-31. SQ1014.2 +135900* SQ1014.2 +136000 WRT-INIT-GF-32. SQ1014.2 +136100* SQ1014.2 +136200* THIS TEST ADVANCES THE PRINT POSITION 2 LINES, TO LINE 5 SQ1014.2 +136300* SQ1014.2 +136400 MOVE "WRT FRM BFR ADV P99 LINE" TO FEATURE. SQ1014.2 +136500 MOVE "WRT-TEST-GF-32" TO PAR-NAME. SQ1014.2 +136600 GO TO WRT-TEST-GF-32. SQ1014.2 +136700 WRT-DELETE-GF-32. SQ1014.2 +136800 PERFORM DE-LETE. SQ1014.2 +136900 GO TO WRT-END-GF-32. SQ1014.2 +137000 WRT-TEST-GF-32. SQ1014.2 +137100 PERFORM INSPT. SQ1014.2 +137200 PERFORM WRITE-TEST-LINE. SQ1014.2 +137300 MOVE 0 TO IDENTIFIER-2. SQ1014.2 +137400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +137500 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +137600 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE ADVANCING SQ1014.2 +137700 IDENTIFIER-2 LINE. SQ1014.2 +137800 WRT-END-GF-32. SQ1014.2 +137900* SQ1014.2 +138000 WRT-INIT-GF-33. SQ1014.2 +138100* SQ1014.2 +138200* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 8 SQ1014.2 +138300* SQ1014.2 +138400 MOVE "WRT FRM BFR ADV P99 LINS" TO FEATURE. SQ1014.2 +138500 MOVE "WRT-TEST-GF-33" TO PAR-NAME. SQ1014.2 +138600 GO TO WRT-TEST-GF-33. SQ1014.2 +138700 WRT-DELETE-GF-33. SQ1014.2 +138800 PERFORM DE-LETE. SQ1014.2 +138900 GO TO WRT-END-GF-33. SQ1014.2 +139000 WRT-TEST-GF-33. SQ1014.2 +139100 PERFORM INSPT. SQ1014.2 +139200 PERFORM WRITE-TEST-LINE. SQ1014.2 +139300 MOVE 1 TO IDENTIFIER-2. SQ1014.2 +139400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +139500 MOVE "2" TO LINES-ABOVE-1. SQ1014.2 +139600 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE ADVANCING SQ1014.2 +139700 IDENTIFIER-2 LINES. SQ1014.2 +139800 WRT-END-GF-33. SQ1014.2 +139900* SQ1014.2 +140000 WRT-INIT-GF-34. SQ1014.2 +140100* SQ1014.2 +140200* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 12 SQ1014.2 +140300* SQ1014.2 +140400 MOVE "WRT FRM BEFORE ADV PIC99" TO FEATURE. SQ1014.2 +140500 MOVE "WRT-TEST-GF-34" TO PAR-NAME. SQ1014.2 +140600 GO TO WRT-TEST-GF-34. SQ1014.2 +140700 WRT-DELETE-GF-34. SQ1014.2 +140800 PERFORM DE-LETE. SQ1014.2 +140900 GO TO WRT-END-GF-34. SQ1014.2 +141000 WRT-TEST-GF-34. SQ1014.2 +141100 PERFORM INSPT. SQ1014.2 +141200 PERFORM WRITE-TEST-LINE. SQ1014.2 +141300 MOVE 2 TO IDENTIFIER-2. SQ1014.2 +141400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +141500 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +141600 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE ADVANCING SQ1014.2 +141700 IDENTIFIER-2. SQ1014.2 +141800 WRT-END-GF-34. SQ1014.2 +141900* SQ1014.2 +142000 WRT-INIT-GF-35. SQ1014.2 +142100* SQ1014.2 +142200* THIS TEST ADVANCES THE PRINT POSITION 5 LINES, TO LINE 17 SQ1014.2 +142300* SQ1014.2 +142400 MOVE "WRT FROM BEFORE P99 LINE" TO FEATURE. SQ1014.2 +142500 MOVE "WRT-TEST-GF-35" TO PAR-NAME. SQ1014.2 +142600 GO TO WRT-TEST-GF-35. SQ1014.2 +142700 WRT-DELETE-GF-35. SQ1014.2 +142800 PERFORM DE-LETE. SQ1014.2 +142900 GO TO WRT-END-GF-35. SQ1014.2 +143000 WRT-TEST-GF-35. SQ1014.2 +143100 PERFORM INSPT. SQ1014.2 +143200 PERFORM WRITE-TEST-LINE. SQ1014.2 +143300 MOVE 3 TO IDENTIFIER-2. SQ1014.2 +143400 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +143500 MOVE "4" TO LINES-ABOVE-1. SQ1014.2 +143600 WRITE PRINT-REC FROM TEST-LINE-1 BEFORE IDENTIFIER-2 LINE. SQ1014.2 +143700 WRT-END-GF-35. SQ1014.2 +143800* SQ1014.2 +143900 WRT-INIT-GF-36. SQ1014.2 +144000* SQ1014.2 +144100* THIS TEST ADVANCES THE PRINT POSITION 6 LINES, TO LINE 23 SQ1014.2 +144200* SQ1014.2 +144300 MOVE "WRT FRM BEFORE P99 LINES" TO FEATURE. SQ1014.2 +144400 MOVE "WRT-TEST-GF-36" TO PAR-NAME. SQ1014.2 +144500 GO TO WRT-TEST-GF-36. SQ1014.2 +144600 WRT-DELETE-GF-36. SQ1014.2 +144700 PERFORM DE-LETE. SQ1014.2 +144800 GO TO WRT-END-GF-36. SQ1014.2 +144900 WRT-TEST-GF-36. SQ1014.2 +145000 PERFORM INSPT. SQ1014.2 +145100 PERFORM WRITE-TEST-LINE. SQ1014.2 +145200 MOVE 4 TO IDENTIFIER-2. SQ1014.2 +145300 WRITE PRINT-REC FROM OH-ONE BEFORE IDENTIFIER-2 LINES. SQ1014.2 +145400 WRT-END-GF-36. SQ1014.2 +145500* SQ1014.2 +145600 WRT-INIT-GF-37. SQ1014.2 +145700* SQ1014.2 +145800* THIS TEST ADVANCES THE PRINT POSITION 7 LINES, TO LINE 29 SQ1014.2 +145900* SQ1014.2 +146000 MOVE "WRT FROM 03 BEFORE PIC99" TO FEATURE. SQ1014.2 +146100 MOVE "WRT-TEST-GF-37" TO PAR-NAME. SQ1014.2 +146200 GO TO WRT-TEST-GF-37. SQ1014.2 +146300 WRT-DELETE-GF-37. SQ1014.2 +146400 PERFORM DE-LETE. SQ1014.2 +146500 GO TO WRT-END-GF-37. SQ1014.2 +146600 WRT-TEST-GF-37. SQ1014.2 +146700 PERFORM INSPT. SQ1014.2 +146800 PERFORM WRITE-TEST-LINE. SQ1014.2 +146900 MOVE 5 TO IDENTIFIER-2. SQ1014.2 +147000 WRITE PRINT-REC FROM OH-THREE BEFORE IDENTIFIER-2. SQ1014.2 +147100 WRT-END-GF-37. SQ1014.2 +147200* SQ1014.2 +147300 WRT-INIT-GF-38. SQ1014.2 +147400* SQ1014.2 +147500* THIS TEST ADVANCES THE PRINT POSITION 8 LINES, TO LINE 37 SQ1014.2 +147600* SQ1014.2 +147700 MOVE "WRT FRM AFT ADV P99 LINE" TO FEATURE. SQ1014.2 +147800 MOVE "WRT-TEST-GF-38" TO PAR-NAME. SQ1014.2 +147900 GO TO WRT-TEST-GF-38. SQ1014.2 +148000 WRT-DELETE-GF-38. SQ1014.2 +148100 PERFORM DE-LETE. SQ1014.2 +148200 GO TO WRT-END-GF-38. SQ1014.2 +148300 WRT-TEST-GF-38. SQ1014.2 +148400 PERFORM INSPT. SQ1014.2 +148500 PERFORM WRITE-TEST-LINE. SQ1014.2 +148600 MOVE 6 TO IDENTIFIER-2. SQ1014.2 +148700 WRITE PRINT-REC FROM SEVENTY-SEVEN-2 AFTER ADVANCING SQ1014.2 +148800 IDENTIFIER-2 LINE. SQ1014.2 +148900 WRT-END-GF-38. SQ1014.2 +149000* SQ1014.2 +149100 WRT-INIT-GF-39. SQ1014.2 +149200* SQ1014.2 +149300* THIS TEST ADVANCES THE PRINT POSITION 9 LINES, TO LINE 46 SQ1014.2 +149400* SQ1014.2 +149500 MOVE "WRT FRM AFT ADV P99 LINS" TO FEATURE. SQ1014.2 +149600 MOVE "WRT-TEST-GF-39" TO PAR-NAME. SQ1014.2 +149700 GO TO WRT-TEST-GF-39. SQ1014.2 +149800 WRT-DELETE-GF-39. SQ1014.2 +149900 PERFORM DE-LETE. SQ1014.2 +150000 GO TO WRT-END-GF-39. SQ1014.2 +150100 WRT-TEST-GF-39. SQ1014.2 +150200 PERFORM INSPT. SQ1014.2 +150300 PERFORM WRITE-TEST-LINE. SQ1014.2 +150400 MOVE 7 TO IDENTIFIER-2. SQ1014.2 +150500 MOVE "8" TO LINES-BELOW-1. SQ1014.2 +150600 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +150700 WRITE PRINT-REC FROM TEST-LINE-1 AFTER ADVANCING SQ1014.2 +150800 IDENTIFIER-2 LINES. SQ1014.2 +150900 WRT-END-GF-39. SQ1014.2 +151000* SQ1014.2 +151100 WRT-INIT-GF-40. SQ1014.2 +151200* SQ1014.2 +151300* THIS TEST ADVANCES THE PRINT POSITION 10 LINES, TO LINE 56 SQ1014.2 +151400* SQ1014.2 +151500 MOVE "WRT FRM AFT ADV ID2" TO FEATURE. SQ1014.2 +151600 MOVE "WRT-TEST-44" TO PAR-NAME. SQ1014.2 +151700 PERFORM WRITE-TEST-LINE. SQ1014.2 +151800 MOVE 8 TO IDENTIFIER-2. SQ1014.2 +151900 MOVE "9" TO LINES-BELOW-1. SQ1014.2 +152000 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +152100 WRITE PRINT-REC FROM TEST-LINE-1 AFTER ADVANCING SQ1014.2 +152200 IDENTIFIER-2. SQ1014.2 +152300 WRT-END-GF-40. SQ1014.2 +152400* SQ1014.2 +152500 WRT-INIT-GF-41. SQ1014.2 +152600* SQ1014.2 +152700* THIS TEST ADVANCES THE PRINT POSITION TO A NEW PAGE. IT SQ1014.2 +152800* SHOULD LEAVE LINE 2 ON THE NEW PAGE AS THE CURRENT LINE, SO SQ1014.2 +152900* THAT THE FIRST WRT-TEST LINE ON THE NEW PAGE IS ON THE SQ1014.2 +153000* THIRD PRINTABLE LINE. SQ1014.2 +153100* SQ1014.2 +153200 MOVE "WRT FROM AFTER ADV PAGE" TO FEATURE. SQ1014.2 +153300 MOVE "WRT-TEST-GF-41" TO PAR-NAME. SQ1014.2 +153400 GO TO WRT-TEST-GF-41. SQ1014.2 +153500 WRT-DELETE-GF-41. SQ1014.2 +153600 PERFORM DE-LETE. SQ1014.2 +153700 GO TO WRT-END-GF-41. SQ1014.2 +153800 WRT-TEST-GF-41. SQ1014.2 +153900 PERFORM INSPT. SQ1014.2 +154000 PERFORM WRITE-TEST-LINE. SQ1014.2 +154100 WRITE PRINT-REC FROM NEW-PAGE-LINE AFTER ADVANCING PAGE. SQ1014.2 +154200 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +154300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +154400 WRT-END-GF-41. SQ1014.2 +154500* SQ1014.2 +154600 WRT-INIT-GF-42. SQ1014.2 +154700* SQ1014.2 +154800* THIS TEST ADVANCES THE PRINT POSITION 2 LINES, TO LINE 5 SQ1014.2 +154900* SQ1014.2 +155000 MOVE "WRT FROM AFTER ID2 LINE" TO FEATURE. SQ1014.2 +155100 MOVE "WRT-TEST-GF-42" TO PAR-NAME. SQ1014.2 +155200 GO TO WRT-TEST-GF-42. SQ1014.2 +155300 WRT-DELETE-GF-42. SQ1014.2 +155400 PERFORM DE-LETE. SQ1014.2 +155500 GO TO WRT-END-GF-42. SQ1014.2 +155600 WRT-TEST-GF-42. SQ1014.2 +155700 PERFORM INSPT. SQ1014.2 +155800 PERFORM WRITE-TEST-LINE. SQ1014.2 +155900 MOVE 0 TO IDENTIFIER-2. SQ1014.2 +156000 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +156100 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +156200 WRITE PRINT-REC FROM TEST-LINE-1 AFTER IDENTIFIER-2 LINE. SQ1014.2 +156300 WRT-END-GF-42. SQ1014.2 +156400* SQ1014.2 +156500 WRT-INIT-GF-43. SQ1014.2 +156600* SQ1014.2 +156700* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 9 SQ1014.2 +156800* SQ1014.2 +156900 MOVE "WRT FROM AFTER S99 LINES" TO FEATURE. SQ1014.2 +157000 MOVE "WRT-TEST-GF-43" TO PAR-NAME. SQ1014.2 +157100 GO TO WRT-TEST-GF-43. SQ1014.2 +157200 WRT-DELETE-GF-43. SQ1014.2 +157300 PERFORM DE-LETE. SQ1014.2 +157400 GO TO WRT-END-GF-43. SQ1014.2 +157500 WRT-TEST-GF-43. SQ1014.2 +157600 PERFORM INSPT. SQ1014.2 +157700 PERFORM WRITE-TEST-LINE. SQ1014.2 +157800 MOVE 2 TO IDENT-2-S99. SQ1014.2 +157900 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +158000 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +158100 WRITE PRINT-REC FROM TEST-LINE-1 AFTER IDENT-2-S99 LINES. SQ1014.2 +158200 WRT-END-GF-43. SQ1014.2 +158300* SQ1014.2 +158400 WRT-INIT-GF-44. SQ1014.2 +158500* SQ1014.2 +158600* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 12 SQ1014.2 +158700* SQ1014.2 +158800 MOVE "WRT FROM AFTER C99" TO FEATURE. SQ1014.2 +158900 MOVE "WRT-TEST-GF-44" TO PAR-NAME. SQ1014.2 +159000 GO TO WRT-TEST-GF-44. SQ1014.2 +159100 WRT-DELETE-GF-44. SQ1014.2 +159200 PERFORM DE-LETE. SQ1014.2 +159300 GO TO WRT-END-GF-44. SQ1014.2 +159400 WRT-TEST-GF-44. SQ1014.2 +159500 PERFORM INSPT. SQ1014.2 +159600 PERFORM WRITE-TEST-LINE. SQ1014.2 +159700 MOVE 1 TO IDENT-2-C99. SQ1014.2 +159800 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +159900 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +160000 WRITE PRINT-REC FROM TEST-LINE-1 AFTER IDENT-2-C99. SQ1014.2 +160100 WRT-END-GF-44. SQ1014.2 +160200* SQ1014.2 +160300 WRT-INIT-GF-45. SQ1014.2 +160400* SQ1014.2 +160500* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 16 SQ1014.2 +160600* SQ1014.2 +160700 MOVE "WRT BEFORE ADV S99 LINE" TO FEATURE. SQ1014.2 +160800 MOVE "WRT-TEST-GF-45" TO PAR-NAME. SQ1014.2 +160900 GO TO WRT-TEST-GF-45. SQ1014.2 +161000 WRT-DELETE-GF-45. SQ1014.2 +161100 PERFORM DE-LETE. SQ1014.2 +161200 GO TO WRT-END-GF-45. SQ1014.2 +161300 WRT-TEST-GF-45. SQ1014.2 +161400 PERFORM INSPT. SQ1014.2 +161500 PERFORM WRITE-TEST-LINE. SQ1014.2 +161600 MOVE 2 TO IDENT-2-S99. SQ1014.2 +161700 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +161800 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +161900 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +162000 WRITE PRINT-REC BEFORE ADVANCING IDENT-2-S99 LINE. SQ1014.2 +162100 WRT-END-GF-45. SQ1014.2 +162200* SQ1014.2 +162300 WRT-INIT-GF-46. SQ1014.2 +162400* SQ1014.2 +162500* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 20 SQ1014.2 +162600* SQ1014.2 +162700 MOVE "WRT BEFORE ADV S99 LINES" TO FEATURE. SQ1014.2 +162800 MOVE "WRT-TEST-GF-46" TO PAR-NAME. SQ1014.2 +162900 GO TO WRT-TEST-GF-46. SQ1014.2 +163000 WRT-DELETE-GF-46. SQ1014.2 +163100 PERFORM DE-LETE. SQ1014.2 +163200 GO TO WRT-END-GF-46. SQ1014.2 +163300 WRT-TEST-GF-46. SQ1014.2 +163400 PERFORM INSPT. SQ1014.2 +163500 PERFORM WRITE-TEST-LINE. SQ1014.2 +163600 MOVE 2 TO IDENT-2-S99. SQ1014.2 +163700 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +163800 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +163900 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +164000 WRITE PRINT-REC BEFORE ADVANCING IDENT-2-S99 LINES. SQ1014.2 +164100 WRT-END-GF-46. SQ1014.2 +164200* SQ1014.2 +164300 WRT-INIT-GF-47. SQ1014.2 +164400* SQ1014.2 +164500* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 24 SQ1014.2 +164600* SQ1014.2 +164700 MOVE "WRT BEFORE ADV S99" TO FEATURE. SQ1014.2 +164800 MOVE "WRT-TEST-GF-47" TO PAR-NAME. SQ1014.2 +164900 GO TO WRT-TEST-GF-47. SQ1014.2 +165000 WRT-DELETE-GF-47. SQ1014.2 +165100 PERFORM DE-LETE. SQ1014.2 +165200 GO TO WRT-END-GF-47. SQ1014.2 +165300 WRT-TEST-GF-47. SQ1014.2 +165400 PERFORM INSPT. SQ1014.2 +165500 PERFORM WRITE-TEST-LINE. SQ1014.2 +165600 MOVE 2 TO IDENT-2-S99. SQ1014.2 +165700 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +165800 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +165900 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +166000 WRITE PRINT-REC BEFORE ADVANCING IDENT-2-S99. SQ1014.2 +166100 WRT-END-GF-47. SQ1014.2 +166200* SQ1014.2 +166300 WRT-INIT-GF-48. SQ1014.2 +166400* SQ1014.2 +166500* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 27 SQ1014.2 +166600* SQ1014.2 +166700 MOVE "WRT BEFORE PIC9 LINE" TO FEATURE. SQ1014.2 +166800 MOVE "WRT-TEST-GF-48" TO PAR-NAME. SQ1014.2 +166900 GO TO WRT-TEST-GF-48. SQ1014.2 +167000 WRT-DELETE-GF-48. SQ1014.2 +167100 PERFORM DE-LETE. SQ1014.2 +167200 GO TO WRT-END-GF-48. SQ1014.2 +167300 WRT-TEST-GF-48. SQ1014.2 +167400 PERFORM INSPT. SQ1014.2 +167500 PERFORM WRITE-TEST-LINE. SQ1014.2 +167600 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +167700 MOVE "2" TO LINES-ABOVE-1. SQ1014.2 +167800 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +167900 WRITE PRINT-REC BEFORE ONE LINE. SQ1014.2 +168000 PERFORM INSPT. SQ1014.2 +168100 WRT-END-GF-48. SQ1014.2 +168200* SQ1014.2 +168300 WRT-INIT-GF-49. SQ1014.2 +168400* SQ1014.2 +168500* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 31 SQ1014.2 +168600* SQ1014.2 +168700 MOVE "WRT BEFORE PIC9 LINES" TO FEATURE. SQ1014.2 +168800 MOVE "WRT-TEST-GF-49" TO PAR-NAME. SQ1014.2 +168900 GO TO WRT-TEST-GF-49. SQ1014.2 +169000 WRT-DELETE-GF-49. SQ1014.2 +169100 PERFORM DE-LETE. SQ1014.2 +169200 GO TO WRT-END-GF-49. SQ1014.2 +169300 WRT-TEST-GF-49. SQ1014.2 +169400 PERFORM INSPT. SQ1014.2 +169500 PERFORM WRITE-TEST-LINE. SQ1014.2 +169600 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +169700 MOVE "3" TO LINES-ABOVE-1. SQ1014.2 +169800 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +169900 WRITE PRINT-REC BEFORE TWO LINES. SQ1014.2 +170000 WRT-END-GF-49. SQ1014.2 +170100* SQ1014.2 +170200 WRT-INIT-GF-50. SQ1014.2 +170300* SQ1014.2 +170400* THIS TEST ADVANCES THE PRINT POSITION 5 LINES, TO LINE 36 SQ1014.2 +170500* SQ1014.2 +170600 MOVE "WRT BEFORE PIC9" TO FEATURE. SQ1014.2 +170700 MOVE "WRT-TEST-GF-50" TO PAR-NAME. SQ1014.2 +170800 GO TO WRT-TEST-GF-50. SQ1014.2 +170900 WRT-DELETE-GF-50. SQ1014.2 +171000 PERFORM DE-LETE. SQ1014.2 +171100 GO TO WRT-END-GF-50. SQ1014.2 +171200 WRT-TEST-GF-50. SQ1014.2 +171300 PERFORM INSPT. SQ1014.2 +171400 PERFORM WRITE-TEST-LINE. SQ1014.2 +171500 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +171600 MOVE "4" TO LINES-ABOVE-1. SQ1014.2 +171700 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +171800 WRITE PRINT-REC BEFORE THREE. SQ1014.2 +171900 WRT-END-GF-50. SQ1014.2 +172000* SQ1014.2 +172100 WRT-INIT-GF-51. SQ1014.2 +172200* SQ1014.2 +172300* THIS TEST ADVANCES THE PRINT POSITION 6 LINES, TO LINE 42 SQ1014.2 +172400* SQ1014.2 +172500 MOVE "WRT AFTER ADV PIC9 LINE" TO FEATURE. SQ1014.2 +172600 MOVE "WRT-TEST-GF-51" TO PAR-NAME. SQ1014.2 +172700 GO TO WRT-TEST-GF-51. SQ1014.2 +172800 WRT-DELETE-GF-51. SQ1014.2 +172900 PERFORM DE-LETE. SQ1014.2 +173000 GO TO WRT-END-GF-51. SQ1014.2 +173100 WRT-TEST-GF-51. SQ1014.2 +173200 PERFORM INSPT. SQ1014.2 +173300 PERFORM WRITE-TEST-LINE. SQ1014.2 +173400 MOVE "5" TO LINES-BELOW-1. SQ1014.2 +173500 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +173600 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +173700 WRITE PRINT-REC AFTER ADVANCING FOUR LINE. SQ1014.2 +173800 WRT-END-GF-51. SQ1014.2 +173900* SQ1014.2 +174000 WRT-INIT-GF-52. SQ1014.2 +174100* SQ1014.2 +174200* THIS TEST ADVANCES THE PRINT POSITION 2 LINES, TO LINE 44 SQ1014.2 +174300* SQ1014.2 +174400 MOVE "WRT AFT ADV 9(18) LINES" TO FEATURE. SQ1014.2 +174500 MOVE "WRT-TEST-GF-52" TO PAR-NAME. SQ1014.2 +174600 GO TO WRT-TEST-GF-52. SQ1014.2 +174700 WRT-DELETE-GF-52. SQ1014.2 +174800 PERFORM DE-LETE. SQ1014.2 +174900 GO TO WRT-END-GF-52. SQ1014.2 +175000 WRT-TEST-GF-52. SQ1014.2 +175100 PERFORM INSPT. SQ1014.2 +175200 PERFORM WRITE-TEST-LINE. SQ1014.2 +175300 MOVE "1" TO LINES-BELOW-1. SQ1014.2 +175400 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +175500 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +175600 WRITE PRINT-REC AFTER ADVANCING LONG-ZERO LINES. SQ1014.2 +175700 WRT-END-GF-52. SQ1014.2 +175800* SQ1014.2 +175900 WRT-INIT-GF-53. SQ1014.2 +176000* SQ1014.2 +176100* THIS TEST ADVANCES THE PRINT POSITION 3 LINES, TO LINE 47 SQ1014.2 +176200* SQ1014.2 +176300 MOVE "WRT AFTER ADV 9(18)" TO FEATURE. SQ1014.2 +176400 MOVE "WRT-TEST-GF-53" TO PAR-NAME. SQ1014.2 +176500 GO TO WRT-TEST-GF-53. SQ1014.2 +176600 WRT-DELETE-GF-53. SQ1014.2 +176700 PERFORM DE-LETE. SQ1014.2 +176800 GO TO WRT-END-GF-53. SQ1014.2 +176900 WRT-TEST-GF-53. SQ1014.2 +177000 PERFORM INSPT. SQ1014.2 +177100 PERFORM WRITE-TEST-LINE. SQ1014.2 +177200 MOVE "2" TO LINES-BELOW-1. SQ1014.2 +177300 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +177400 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +177500 WRITE PRINT-REC AFTER ADVANCING LONG-ONE. SQ1014.2 +177600 WRT-END-GF-53. SQ1014.2 +177700* SQ1014.2 +177800 WRT-INIT-GF-54. SQ1014.2 +177900* SQ1014.2 +178000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 51 SQ1014.2 +178100* SQ1014.2 +178200 MOVE "WRT AFTER S99 LINE" TO FEATURE. SQ1014.2 +178300 MOVE "WRT-TEST-GF-54" TO PAR-NAME. SQ1014.2 +178400 GO TO WRT-TEST-GF-54. SQ1014.2 +178500 WRT-DELETE-GF-54. SQ1014.2 +178600 PERFORM DE-LETE. SQ1014.2 +178700 GO TO WRT-END-GF-54. SQ1014.2 +178800 WRT-TEST-GF-54. SQ1014.2 +178900 PERFORM INSPT. SQ1014.2 +179000 PERFORM WRITE-TEST-LINE. SQ1014.2 +179100 MOVE 2 TO IDENT-2-S99. SQ1014.2 +179200 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +179300 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +179400 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +179500 WRITE PRINT-REC AFTER IDENT-2-S99 LINE. SQ1014.2 +179600 WRT-END-GF-54. SQ1014.2 +179700* SQ1014.2 +179800 WRT-INIT-GF-55. SQ1014.2 +179900* SQ1014.2 +180000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 55 SQ1014.2 +180100* SQ1014.2 +180200 MOVE "WRT AFTER PIC99 LINES" TO FEATURE. SQ1014.2 +180300 MOVE "WRT-TEST-GF-55" TO PAR-NAME. SQ1014.2 +180400 GO TO WRT-TEST-GF-55. SQ1014.2 +180500 WRT-DELETE-GF-55. SQ1014.2 +180600 PERFORM DE-LETE. SQ1014.2 +180700 GO TO WRT-END-GF-55. SQ1014.2 +180800 WRT-TEST-GF-55. SQ1014.2 +180900 PERFORM INSPT. SQ1014.2 +181000 PERFORM WRITE-TEST-LINE. SQ1014.2 +181100 MOVE 2 TO IDENTIFIER-2. SQ1014.2 +181200 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +181300 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +181400 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +181500 WRITE PRINT-REC AFTER IDENTIFIER-2 LINES. SQ1014.2 +181600 WRT-END-GF-55. SQ1014.2 +181700* SQ1014.2 +181800 WRT-INIT-GF-56. SQ1014.2 +181900* SQ1014.2 +182000* THIS TEST ADVANCES THE PRINT POSITION 4 LINES, TO LINE 59 SQ1014.2 +182100* SQ1014.2 +182200 MOVE "WRT AFTER PIC99" TO FEATURE. SQ1014.2 +182300 MOVE "WRT-TEST-GF-56" TO PAR-NAME. SQ1014.2 +182400 GO TO WRT-TEST-GF-56. SQ1014.2 +182500 WRT-DELETE-GF-56. SQ1014.2 +182600 PERFORM DE-LETE. SQ1014.2 +182700 GO TO WRT-END-GF-56. SQ1014.2 +182800 WRT-TEST-GF-56. SQ1014.2 +182900 PERFORM INSPT. SQ1014.2 +183000 PERFORM WRITE-TEST-LINE. SQ1014.2 +183100 MOVE 2 TO IDENTIFIER-2. SQ1014.2 +183200 MOVE "3" TO LINES-BELOW-1. SQ1014.2 +183300 MOVE "1" TO LINES-ABOVE-1. SQ1014.2 +183400 MOVE TEST-LINE-1 TO PRINT-REC. SQ1014.2 +183500 WRITE PRINT-REC AFTER IDENTIFIER-2. SQ1014.2 +183600 WRT-END-GF-56. SQ1014.2 +183700* SQ1014.2 +183800 WRT-INIT-GF-57. SQ1014.2 +183900* SQ1014.2 +184000* THIS TEST ADVANCES THE PRINT POSITION TO A NEW PAGE. IT SQ1014.2 +184100* SHOULD LEAVE LINE 2 ON THE NEW PAGE AS THE CURRENT LINE, SO SQ1014.2 +184200* THAT THE FIRST WRT-TEST LINE ON THE NEW PAGE IS ON THE SQ1014.2 +184300* THIRD PRINTABLE LINE. SQ1014.2 +184400* SQ1014.2 +184500 MOVE "WRT FROM AFTER PAGE" TO FEATURE. SQ1014.2 +184600 MOVE "WRT-TEST-GF-57" TO PAR-NAME. SQ1014.2 +184700 GO TO WRT-TEST-GF-57. SQ1014.2 +184800 WRT-DELETE-GF-57. SQ1014.2 +184900 PERFORM DE-LETE. SQ1014.2 +185000 GO TO WRT-END-GF-57. SQ1014.2 +185100 WRT-TEST-GF-57. SQ1014.2 +185200 PERFORM INSPT. SQ1014.2 +185300 PERFORM WRITE-TEST-LINE. SQ1014.2 +185400 WRITE PRINT-REC FROM NEW-PAGE-LINE AFTER PAGE. SQ1014.2 +185500 MOVE NEXT-LINE TO PRINT-REC. SQ1014.2 +185600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +185700 WRT-END-GF-57. SQ1014.2 +185800* SQ1014.2 +185900 AFTER-LAST-TEST. SQ1014.2 +186000 MOVE "FINAL WRT TEST LINE" TO FEATURE. SQ1014.2 +186100 MOVE "AFTER-LAST-TEST" TO PAR-NAME. SQ1014.2 +186200 PERFORM WRITE-TEST-LINE. SQ1014.2 +186300* SQ1014.2 +186400* SQ1014.2 +186500 SQ-END-ROUTINE. SQ1014.2 +186600 GO TO CCVS-EXIT. SQ1014.2 +186700* SQ1014.2 +186800 WRITE-TEST-LINE. SQ1014.2 +186900 MOVE TEST-RESULTS TO PRINT-REC. SQ1014.2 +187000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +187100 MOVE SPACE TO PRINT-REC. SQ1014.2 +187200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +187300* SQ1014.2 +187400 COL-1-CHAR-PRINT. SQ1014.2 +187500 ADD 1 TO LIN-SER SQ1014.2 +187600 MOVE CHAR-LINE TO PRINT-REC SQ1014.2 +187700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1014.2 +187800* SQ1014.2 +187900 CCVS-EXIT SECTION. SQ1014.2 +188000 CCVS-999999. SQ1014.2 +188100 GO TO CLOSE-FILES. SQ1014.2 diff --git a/tests/cobol85/SQ/SQ102A.CBL b/tests/cobol85/SQ/SQ102A.CBL new file mode 100755 index 00000000..dea451bf --- /dev/null +++ b/tests/cobol85/SQ/SQ102A.CBL @@ -0,0 +1,841 @@ +000100 IDENTIFICATION DIVISION. SQ1024.2 +000200 PROGRAM-ID. SQ1024.2 +000300 SQ102A. SQ1024.2 +000400**************************************************************** SQ1024.2 +000500* * SQ1024.2 +000600* VALIDATION FOR:- * SQ1024.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1024.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1024.2 +000900* REVISED 1986, AUGUST * SQ1024.2 +001000* * SQ1024.2 +001100* CREATION DATE / VALIDATION DATE * SQ1024.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1024.2 +001300* * SQ1024.2 +001400**************************************************************** SQ1024.2 +001500* * SQ1024.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1024.2 +001700* * SQ1024.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE * SQ1024.2 +001900* X-55 SYSTEM PRINTER * SQ1024.2 +002000* X-82 SOURCE-COMPUTER * SQ1024.2 +002100* X-83 OBJECT-COMPUTER. * SQ1024.2 +002200* * SQ1024.2 +002300**************************************************************** SQ1024.2 +002400* * SQ1024.2 +002500* SQ102A CREATES A MAGNETIC TAPE FILE CONTAINING 750 FIXED * SQ1024.2 +002600* LENGTH RECORDS, EACH 120 CHARACTERS LONG. THE FILE IS * SQ1024.2 +002700* READ TWICE. THE FIRST PASS CHECKS THAT ALL THE EXPECTED * SQ1024.2 +002800* RECORDS ARE PRESENT. THE SECOND PASS PERFORMS SIMILAR * SQ1024.2 +002900* CHECKS, BUT USES ALL FOUR VARIANTS OF THE READ STATEMENT * SQ1024.2 +003000* WITH THE END PHRASE THAT CAN BE PRODUCED BY INCLUDING OR * SQ1024.2 +003100* OMITTING THE OPTIONAL WORDS "RECORD" AND "AT". * SQ1024.2 +003200* * SQ1024.2 +003300* THE PROGRAM OMITS THE OPTIONAL WORDS "ORGANIZATION IS" * SQ1024.2 +003400* FROM THE "ORGANIZATION IS SEQUENTIAL" CLAUSE OF THE * SQ1024.2 +003500* FILE-CONTROL ENTRY, AND PLACES THE ASSIGN CLAUSE IN A * SQ1024.2 +003600* POSITION OTHER THAN FIRST IN THE SAME ENTRY. * SQ1024.2 +003700* * SQ1024.2 +003800**************************************************************** SQ1024.2 +003900* SQ1024.2 +004000* SQ1024.2 +004100 ENVIRONMENT DIVISION. SQ1024.2 +004200 CONFIGURATION SECTION. SQ1024.2 +004300 SOURCE-COMPUTER. SQ1024.2 +004400 Linux. SQ1024.2 +004500 OBJECT-COMPUTER. SQ1024.2 +004600 Linux. SQ1024.2 +004700* SQ1024.2 +004800 INPUT-OUTPUT SECTION. SQ1024.2 +004900 FILE-CONTROL. SQ1024.2 +005000 SELECT PRINT-FILE ASSIGN TO SQ1024.2 +005100 "report.log". SQ1024.2 +005200* SQ1024.2 +005300*P SELECT RAW-DATA ASSIGN TO SQ1024.2 +005400*P "XXXXX062" SQ1024.2 +005500*P ORGANIZATION IS INDEXED SQ1024.2 +005600*P ACCESS MODE IS RANDOM SQ1024.2 +005700*P RECORD-KEY IS RAW-DATA-KEY. SQ1024.2 +005800*P SQ1024.2 +005900 SELECT SQ-FS1 SQ1024.2 +006000 ACCESS MODE IS SEQUENTIAL SQ1024.2 +006100 SEQUENTIAL SQ1024.2 +006200 ASSIGN TO SQ1024.2 +006300 "XXXXX001" SQ1024.2 +006400 . SQ1024.2 +006500* SQ1024.2 +006600* SQ1024.2 +006700 DATA DIVISION. SQ1024.2 +006800 FILE SECTION. SQ1024.2 +006900 FD PRINT-FILE SQ1024.2 +007000*C LABEL RECORDS SQ1024.2 +007100*C OMITTED SQ1024.2 +007200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1024.2 +007300 . SQ1024.2 +007400 01 PRINT-REC PICTURE X(120). SQ1024.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ1024.2 +007600*P SQ1024.2 +007700*PD RAW-DATA. SQ1024.2 +007800*P1 RAW-DATA-SATZ. SQ1024.2 +007900*P 05 RAW-DATA-KEY PIC X(6). SQ1024.2 +008000*P 05 C-DATE PIC 9(6). SQ1024.2 +008100*P 05 C-TIME PIC 9(8). SQ1024.2 +008200*P 05 NO-OF-TESTS PIC 99. SQ1024.2 +008300*P 05 C-OK PIC 999. SQ1024.2 +008400*P 05 C-ALL PIC 999. SQ1024.2 +008500*P 05 C-FAIL PIC 999. SQ1024.2 +008600*P 05 C-DELETED PIC 999. SQ1024.2 +008700*P 05 C-INSPECT PIC 999. SQ1024.2 +008800*P 05 C-NOTE PIC X(13). SQ1024.2 +008900*P 05 C-INDENT PIC X. SQ1024.2 +009000*P 05 C-ABORT PIC X(8). SQ1024.2 +009100* SQ1024.2 +009200 FD SQ-FS1 SQ1024.2 +009300*C LABEL RECORD IS STANDARD SQ1024.2 +009400 . SQ1024.2 +009500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1024.2 +009600* SQ1024.2 +009700 WORKING-STORAGE SECTION. SQ1024.2 +009800* SQ1024.2 +009900*************************************************************** SQ1024.2 +010000* * SQ1024.2 +010100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1024.2 +010200* * SQ1024.2 +010300*************************************************************** SQ1024.2 +010400* SQ1024.2 +010500 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1024.2 +010600 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1024.2 +010700 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1024.2 +010800* SQ1024.2 +010900*************************************************************** SQ1024.2 +011000* * SQ1024.2 +011100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1024.2 +011200* * SQ1024.2 +011300*************************************************************** SQ1024.2 +011400* SQ1024.2 +011500 01 REC-SKEL-SUB PIC 99. SQ1024.2 +011600* SQ1024.2 +011700 01 FILE-RECORD-INFORMATION-REC. SQ1024.2 +011800 03 FILE-RECORD-INFO-SKELETON. SQ1024.2 +011900 05 FILLER PICTURE X(48) VALUE SQ1024.2 +012000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1024.2 +012100 05 FILLER PICTURE X(46) VALUE SQ1024.2 +012200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1024.2 +012300 05 FILLER PICTURE X(26) VALUE SQ1024.2 +012400 ",LFIL=000000,ORG= ,LBLR= ". SQ1024.2 +012500 05 FILLER PICTURE X(37) VALUE SQ1024.2 +012600 ",RECKEY= ". SQ1024.2 +012700 05 FILLER PICTURE X(38) VALUE SQ1024.2 +012800 ",ALTKEY1= ". SQ1024.2 +012900 05 FILLER PICTURE X(38) VALUE SQ1024.2 +013000 ",ALTKEY2= ". SQ1024.2 +013100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1024.2 +013200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1024.2 +013300 05 FILE-RECORD-INFO-P1-120. SQ1024.2 +013400 07 FILLER PIC X(5). SQ1024.2 +013500 07 XFILE-NAME PIC X(6). SQ1024.2 +013600 07 FILLER PIC X(8). SQ1024.2 +013700 07 XRECORD-NAME PIC X(6). SQ1024.2 +013800 07 FILLER PIC X(1). SQ1024.2 +013900 07 REELUNIT-NUMBER PIC 9(1). SQ1024.2 +014000 07 FILLER PIC X(7). SQ1024.2 +014100 07 XRECORD-NUMBER PIC 9(6). SQ1024.2 +014200 07 FILLER PIC X(6). SQ1024.2 +014300 07 UPDATE-NUMBER PIC 9(2). SQ1024.2 +014400 07 FILLER PIC X(5). SQ1024.2 +014500 07 ODO-NUMBER PIC 9(4). SQ1024.2 +014600 07 FILLER PIC X(5). SQ1024.2 +014700 07 XPROGRAM-NAME PIC X(5). SQ1024.2 +014800 07 FILLER PIC X(7). SQ1024.2 +014900 07 XRECORD-LENGTH PIC 9(6). SQ1024.2 +015000 07 FILLER PIC X(7). SQ1024.2 +015100 07 CHARS-OR-RECORDS PIC X(2). SQ1024.2 +015200 07 FILLER PIC X(1). SQ1024.2 +015300 07 XBLOCK-SIZE PIC 9(4). SQ1024.2 +015400 07 FILLER PIC X(6). SQ1024.2 +015500 07 RECORDS-IN-FILE PIC 9(6). SQ1024.2 +015600 07 FILLER PIC X(5). SQ1024.2 +015700 07 XFILE-ORGANIZATION PIC X(2). SQ1024.2 +015800 07 FILLER PIC X(6). SQ1024.2 +015900 07 XLABEL-TYPE PIC X(1). SQ1024.2 +016000 05 FILE-RECORD-INFO-P121-240. SQ1024.2 +016100 07 FILLER PIC X(8). SQ1024.2 +016200 07 XRECORD-KEY PIC X(29). SQ1024.2 +016300 07 FILLER PIC X(9). SQ1024.2 +016400 07 ALTERNATE-KEY1 PIC X(29). SQ1024.2 +016500 07 FILLER PIC X(9). SQ1024.2 +016600 07 ALTERNATE-KEY2 PIC X(29). SQ1024.2 +016700 07 FILLER PIC X(7). SQ1024.2 +016800* SQ1024.2 +016900 01 TEST-RESULTS. SQ1024.2 +017000 02 FILLER PIC X VALUE SPACE. SQ1024.2 +017100 02 PAR-NAME. SQ1024.2 +017200 03 FILLER PIC X(14) VALUE SPACE. SQ1024.2 +017300 03 PARDOT-X PIC X VALUE SPACE. SQ1024.2 +017400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1024.2 +017500 02 FILLER PIC X VALUE SPACE. SQ1024.2 +017600 02 FEATURE PIC X(24) VALUE SPACE. SQ1024.2 +017700 02 FILLER PIC X VALUE SPACE. SQ1024.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1024.2 +017900 02 FILLER PIC X(9) VALUE SPACE. SQ1024.2 +018000 02 RE-MARK PIC X(61). SQ1024.2 +018100 01 TEST-COMPUTED. SQ1024.2 +018200 02 FILLER PIC X(30) VALUE SPACE. SQ1024.2 +018300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1024.2 +018400 02 COMPUTED-X. SQ1024.2 +018500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1024.2 +018600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1024.2 +018700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1024.2 +018800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1024.2 +018900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1024.2 +019000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1024.2 +019100 04 COMPUTED-18V0 PIC -9(18). SQ1024.2 +019200 04 FILLER PIC X. SQ1024.2 +019300 03 FILLER PIC X(50) VALUE SPACE. SQ1024.2 +019400 01 TEST-CORRECT. SQ1024.2 +019500 02 FILLER PIC X(30) VALUE SPACE. SQ1024.2 +019600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1024.2 +019700 02 CORRECT-X. SQ1024.2 +019800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1024.2 +019900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1024.2 +020000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1024.2 +020100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1024.2 +020200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1024.2 +020300 03 CR-18V0 REDEFINES CORRECT-A. SQ1024.2 +020400 04 CORRECT-18V0 PIC -9(18). SQ1024.2 +020500 04 FILLER PIC X. SQ1024.2 +020600 03 FILLER PIC X(2) VALUE SPACE. SQ1024.2 +020700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1024.2 +020800 01 CCVS-C-1. SQ1024.2 +020900 02 FILLER PIC IS X VALUE SPACE. SQ1024.2 +021000 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1024.2 +021100 02 FILLER PIC IS X VALUE SPACE. SQ1024.2 +021200 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1024.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1024.2 +021400 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1024.2 +021500 02 FILLER PIC IS X(9) VALUE SPACE. SQ1024.2 +021600 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1024.2 +021700 01 CCVS-C-2. SQ1024.2 +021800 02 FILLER PIC X(19) VALUE SPACE. SQ1024.2 +021900 02 FILLER PIC X(6) VALUE "TESTED". SQ1024.2 +022000 02 FILLER PIC X(19) VALUE SPACE. SQ1024.2 +022100 02 FILLER PIC X(4) VALUE "FAIL". SQ1024.2 +022200 02 FILLER PIC X(72) VALUE SPACE. SQ1024.2 +022300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1024.2 +022400 01 REC-CT PIC 99 VALUE ZERO. SQ1024.2 +022500 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1024.2 +022600 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1024.2 +022700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1024.2 +022800 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1024.2 +022900 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1024.2 +023000 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1024.2 +023100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1024.2 +023200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1024.2 +023300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1024.2 +023400 01 CCVS-H-1. SQ1024.2 +023500 02 FILLER PIC X(39) VALUE SPACES. SQ1024.2 +023600 02 FILLER PIC X(42) VALUE SQ1024.2 +023700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1024.2 +023800 02 FILLER PIC X(39) VALUE SPACES. SQ1024.2 +023900 01 CCVS-H-2A. SQ1024.2 +024000 02 FILLER PIC X(40) VALUE SPACE. SQ1024.2 +024100 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1024.2 +024200 02 FILLER PIC XXXX VALUE SQ1024.2 +024300 "4.2 ". SQ1024.2 +024400 02 FILLER PIC X(28) VALUE SQ1024.2 +024500 " COPY - NOT FOR DISTRIBUTION". SQ1024.2 +024600 02 FILLER PIC X(41) VALUE SPACE. SQ1024.2 +024700* SQ1024.2 +024800 01 CCVS-H-2B. SQ1024.2 +024900 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1024.2 +025000 02 TEST-ID PIC X(9). SQ1024.2 +025100 02 FILLER PIC X(4) VALUE " IN ". SQ1024.2 +025200 02 FILLER PIC X(12) VALUE SQ1024.2 +025300 " HIGH ". SQ1024.2 +025400 02 FILLER PIC X(22) VALUE SQ1024.2 +025500 " LEVEL VALIDATION FOR ". SQ1024.2 +025600 02 FILLER PIC X(58) VALUE SQ1024.2 +025700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1024.2 +025800 01 CCVS-H-3. SQ1024.2 +025900 02 FILLER PIC X(34) VALUE SQ1024.2 +026000 " FOR OFFICIAL USE ONLY ". SQ1024.2 +026100 02 FILLER PIC X(58) VALUE SQ1024.2 +026200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1024.2 +026300 02 FILLER PIC X(28) VALUE SQ1024.2 +026400 " COPYRIGHT 1985,1986 ". SQ1024.2 +026500 01 CCVS-E-1. SQ1024.2 +026600 02 FILLER PIC X(52) VALUE SPACE. SQ1024.2 +026700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1024.2 +026800 02 ID-AGAIN PIC X(9). SQ1024.2 +026900 02 FILLER PIC X(45) VALUE SPACES. SQ1024.2 +027000 01 CCVS-E-2. SQ1024.2 +027100 02 FILLER PIC X(31) VALUE SPACE. SQ1024.2 +027200 02 FILLER PIC X(21) VALUE SPACE. SQ1024.2 +027300 02 CCVS-E-2-2. SQ1024.2 +027400 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1024.2 +027500 03 FILLER PIC X VALUE SPACE. SQ1024.2 +027600 03 ENDER-DESC PIC X(44) VALUE SQ1024.2 +027700 "ERRORS ENCOUNTERED". SQ1024.2 +027800 01 CCVS-E-3. SQ1024.2 +027900 02 FILLER PIC X(22) VALUE SQ1024.2 +028000 " FOR OFFICIAL USE ONLY". SQ1024.2 +028100 02 FILLER PIC X(12) VALUE SPACE. SQ1024.2 +028200 02 FILLER PIC X(58) VALUE SQ1024.2 +028300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1024.2 +028400 02 FILLER PIC X(8) VALUE SPACE. SQ1024.2 +028500 02 FILLER PIC X(20) VALUE SQ1024.2 +028600 " COPYRIGHT 1985,1986". SQ1024.2 +028700 01 CCVS-E-4. SQ1024.2 +028800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1024.2 +028900 02 FILLER PIC X(4) VALUE " OF ". SQ1024.2 +029000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1024.2 +029100 02 FILLER PIC X(40) VALUE SQ1024.2 +029200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1024.2 +029300 01 XXINFO. SQ1024.2 +029400 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1024.2 +029500 02 INFO-TEXT. SQ1024.2 +029600 04 FILLER PIC X(8) VALUE SPACE. SQ1024.2 +029700 04 XXCOMPUTED PIC X(20). SQ1024.2 +029800 04 FILLER PIC X(5) VALUE SPACE. SQ1024.2 +029900 04 XXCORRECT PIC X(20). SQ1024.2 +030000 02 INF-ANSI-REFERENCE PIC X(48). SQ1024.2 +030100 01 HYPHEN-LINE. SQ1024.2 +030200 02 FILLER PIC IS X VALUE IS SPACE. SQ1024.2 +030300 02 FILLER PIC IS X(65) VALUE IS "************************SQ1024.2 +030400- "*****************************************". SQ1024.2 +030500 02 FILLER PIC IS X(54) VALUE IS "************************SQ1024.2 +030600- "******************************". SQ1024.2 +030700 01 CCVS-PGM-ID PIC X(9) VALUE SQ1024.2 +030800 "SQ102A". SQ1024.2 +030900* SQ1024.2 +031000* SQ1024.2 +031100 PROCEDURE DIVISION. SQ1024.2 +031200* SQ1024.2 +031300 CCVS1 SECTION. SQ1024.2 +031400 OPEN-FILES. SQ1024.2 +031500*P OPEN I-O RAW-DATA. SQ1024.2 +031600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1024.2 +031700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1024.2 +031800*P MOVE "ABORTED " TO C-ABORT. SQ1024.2 +031900*P ADD 1 TO C-NO-OF-TESTS. SQ1024.2 +032000*P ACCEPT C-DATE FROM DATE. SQ1024.2 +032100*P ACCEPT C-TIME FROM TIME. SQ1024.2 +032200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1024.2 +032300*PND-E-1. SQ1024.2 +032400*P CLOSE RAW-DATA. SQ1024.2 +032500 OPEN OUTPUT PRINT-FILE. SQ1024.2 +032600 MOVE CCVS-PGM-ID TO TEST-ID. SQ1024.2 +032700 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1024.2 +032800 MOVE SPACE TO TEST-RESULTS. SQ1024.2 +032900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1024.2 +033000 MOVE ZERO TO REC-SKEL-SUB. SQ1024.2 +033100 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1024.2 +033200 GO TO CCVS1-EXIT. SQ1024.2 +033300* SQ1024.2 +033400 CCVS-INIT-FILE. SQ1024.2 +033500 ADD 1 TO REC-SKL-SUB. SQ1024.2 +033600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1024.2 +033700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1024.2 +033800* SQ1024.2 +033900 CLOSE-FILES. SQ1024.2 +034000 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1024.2 +034100 CLOSE PRINT-FILE. SQ1024.2 +034200*P OPEN I-O RAW-DATA. SQ1024.2 +034300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1024.2 +034400*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1024.2 +034500*P MOVE "OK. " TO C-ABORT. SQ1024.2 +034600*P MOVE PASS-COUNTER TO C-OK. SQ1024.2 +034700*P MOVE ERROR-HOLD TO C-ALL. SQ1024.2 +034800*P MOVE ERROR-COUNTER TO C-FAIL. SQ1024.2 +034900*P MOVE DELETE-CNT TO C-DELETED. SQ1024.2 +035000*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1024.2 +035100*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1024.2 +035200*PND-E-2. SQ1024.2 +035300*P CLOSE RAW-DATA. SQ1024.2 +035400 TERMINATE-CCVS. SQ1024.2 +035500*S EXIT PROGRAM. SQ1024.2 +035600 STOP RUN. SQ1024.2 +035700* SQ1024.2 +035800 INSPT. SQ1024.2 +035900 MOVE "INSPT" TO P-OR-F. SQ1024.2 +036000 ADD 1 TO INSPECT-COUNTER. SQ1024.2 +036100 PERFORM PRINT-DETAIL. SQ1024.2 +036200* SQ1024.2 +036300 PASS. SQ1024.2 +036400 MOVE "PASS " TO P-OR-F. SQ1024.2 +036500 ADD 1 TO PASS-COUNTER. SQ1024.2 +036600 PERFORM PRINT-DETAIL. SQ1024.2 +036700* SQ1024.2 +036800 FAIL. SQ1024.2 +036900 MOVE "FAIL*" TO P-OR-F. SQ1024.2 +037000 ADD 1 TO ERROR-COUNTER. SQ1024.2 +037100 PERFORM PRINT-DETAIL. SQ1024.2 +037200* SQ1024.2 +037300 DE-LETE. SQ1024.2 +037400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1024.2 +037500 MOVE "*****" TO P-OR-F. SQ1024.2 +037600 ADD 1 TO DELETE-COUNTER. SQ1024.2 +037700 PERFORM PRINT-DETAIL. SQ1024.2 +037800* SQ1024.2 +037900 PRINT-DETAIL. SQ1024.2 +038000 IF REC-CT NOT EQUAL TO ZERO SQ1024.2 +038100 MOVE "." TO PARDOT-X SQ1024.2 +038200 MOVE REC-CT TO DOTVALUE. SQ1024.2 +038300 MOVE TEST-RESULTS TO PRINT-REC. SQ1024.2 +038400 PERFORM WRITE-LINE. SQ1024.2 +038500 IF P-OR-F EQUAL TO "FAIL*" SQ1024.2 +038600 PERFORM WRITE-LINE SQ1024.2 +038700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1024.2 +038800 ELSE SQ1024.2 +038900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1024.2 +039000 MOVE SPACE TO P-OR-F. SQ1024.2 +039100 MOVE SPACE TO COMPUTED-X. SQ1024.2 +039200 MOVE SPACE TO CORRECT-X. SQ1024.2 +039300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1024.2 +039400 MOVE SPACE TO RE-MARK. SQ1024.2 +039500* SQ1024.2 +039600 HEAD-ROUTINE. SQ1024.2 +039700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +039800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +039900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1024.2 +040000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1024.2 +040100 COLUMN-NAMES-ROUTINE. SQ1024.2 +040200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1024.2 +040300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +040400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1024.2 +040500 END-ROUTINE. SQ1024.2 +040600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1024.2 +040700 PERFORM WRITE-LINE 5 TIMES. SQ1024.2 +040800 END-RTN-EXIT. SQ1024.2 +040900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1024.2 +041000 PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +041100* SQ1024.2 +041200 END-ROUTINE-1. SQ1024.2 +041300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1024.2 +041400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1024.2 +041500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1024.2 +041600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1024.2 +041700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1024.2 +041800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1024.2 +041900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1024.2 +042000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1024.2 +042100 PERFORM WRITE-LINE. SQ1024.2 +042200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1024.2 +042300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1024.2 +042400 MOVE "NO " TO ERROR-TOTAL SQ1024.2 +042500 ELSE SQ1024.2 +042600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1024.2 +042700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1024.2 +042800 PERFORM WRITE-LINE. SQ1024.2 +042900 END-ROUTINE-13. SQ1024.2 +043000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1024.2 +043100 MOVE "NO " TO ERROR-TOTAL SQ1024.2 +043200 ELSE SQ1024.2 +043300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1024.2 +043400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1024.2 +043500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1024.2 +043600 PERFORM WRITE-LINE. SQ1024.2 +043700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1024.2 +043800 MOVE "NO " TO ERROR-TOTAL SQ1024.2 +043900 ELSE SQ1024.2 +044000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1024.2 +044100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1024.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1024.2 +044300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1024.2 +044400* SQ1024.2 +044500 WRITE-LINE. SQ1024.2 +044600 ADD 1 TO RECORD-COUNT. SQ1024.2 +044700 IF RECORD-COUNT GREATER 50 SQ1024.2 +044800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1024.2 +044900 MOVE SPACE TO DUMMY-RECORD SQ1024.2 +045000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1024.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1024.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1024.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1024.2 +045400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1024.2 +045500 MOVE ZERO TO RECORD-COUNT. SQ1024.2 +045600 PERFORM WRT-LN. SQ1024.2 +045700* SQ1024.2 +045800 WRT-LN. SQ1024.2 +045900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1024.2 +046000 MOVE SPACE TO DUMMY-RECORD. SQ1024.2 +046100 BLANK-LINE-PRINT. SQ1024.2 +046200 PERFORM WRT-LN. SQ1024.2 +046300 FAIL-ROUTINE. SQ1024.2 +046400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1024.2 +046500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1024.2 +046600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1024.2 +046700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1024.2 +046800 MOVE XXINFO TO DUMMY-RECORD. SQ1024.2 +046900 PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +047000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1024.2 +047100 GO TO FAIL-ROUTINE-EX. SQ1024.2 +047200 FAIL-ROUTINE-WRITE. SQ1024.2 +047300 MOVE TEST-COMPUTED TO PRINT-REC SQ1024.2 +047400 PERFORM WRITE-LINE SQ1024.2 +047500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1024.2 +047600 MOVE TEST-CORRECT TO PRINT-REC SQ1024.2 +047700 PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +047800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1024.2 +047900 FAIL-ROUTINE-EX. SQ1024.2 +048000 EXIT. SQ1024.2 +048100 BAIL-OUT. SQ1024.2 +048200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1024.2 +048300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1024.2 +048400 BAIL-OUT-WRITE. SQ1024.2 +048500 MOVE CORRECT-A TO XXCORRECT. SQ1024.2 +048600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1024.2 +048700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1024.2 +048800 MOVE XXINFO TO DUMMY-RECORD. SQ1024.2 +048900 PERFORM WRITE-LINE 2 TIMES. SQ1024.2 +049000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1024.2 +049100 BAIL-OUT-EX. SQ1024.2 +049200 EXIT. SQ1024.2 +049300 CCVS1-EXIT. SQ1024.2 +049400 EXIT. SQ1024.2 +049500* SQ1024.2 +049600**************************************************************** SQ1024.2 +049700* * SQ1024.2 +049800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1024.2 +049900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1024.2 +050000* * SQ1024.2 +050100**************************************************************** SQ1024.2 +050200* SQ1024.2 +050300 SECT-SQ102-0001 SECTION. SQ1024.2 +050400 SEQ-INIT-WR-01. SQ1024.2 +050500 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1024.2 +050600 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1024.2 +050700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1024.2 +050800 MOVE 000120 TO XRECORD-LENGTH (1). SQ1024.2 +050900 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1024.2 +051000 MOVE 0001 TO XBLOCK-SIZE (1). SQ1024.2 +051100 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1024.2 +051200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1024.2 +051300 MOVE "S" TO XLABEL-TYPE (1). SQ1024.2 +051400 MOVE ZERO TO XRECORD-NUMBER (1). SQ1024.2 +051500 MOVE "CREATE 750 RECORD FILE" TO FEATURE. SQ1024.2 +051600 MOVE "SEQ-TEST-WR-01" TO PAR-NAME. SQ1024.2 +051700* SQ1024.2 +051800 SEQ-TEST-WR-01. SQ1024.2 +051900 OPEN OUTPUT SQ-FS1. SQ1024.2 +052000* SQ1024.2 +052100 SEQ-TEST-WR-01-LOOP. SQ1024.2 +052200 ADD 1 TO XRECORD-NUMBER (1). SQ1024.2 +052300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1024.2 +052400 WRITE SQ-FS1R1-F-G-120. SQ1024.2 +052500 IF XRECORD-NUMBER (1) LESS THAN 750 SQ1024.2 +052600 GO TO SEQ-TEST-WR-01-LOOP. SQ1024.2 +052700* SQ1024.2 +052800 CLOSE SQ-FS1. SQ1024.2 +052900* SQ1024.2 +053000* A SEQUENTIAL TAPE FILE HAS BEEN CREATED. IT CONTAINS 750 SQ1024.2 +053100* RECORDS, EACH 120 CHARACTERS LONG. THE FILE WILL NOW BE SQ1024.2 +053200* READ AND THE RECORDS VERIFIED. SQ1024.2 +053300* SQ1024.2 +053400 SEQ-INIT-GF-02. SQ1024.2 +053500 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1024.2 +053600 MOVE "VERIFY NEW FILE" TO FEATURE. SQ1024.2 +053700 MOVE 1 TO REC-CT. SQ1024.2 +053800 GO TO SEQ-TEST-GF-02-01. SQ1024.2 +053900 SEQ-DELETE-02-01. SQ1024.2 +054000 GO TO SEQ-DELETE-02-02. SQ1024.2 +054100 SEQ-TEST-GF-02-01. SQ1024.2 +054200 OPEN INPUT SQ-FS1. SQ1024.2 +054300* SQ1024.2 +054400 SEQ-INIT-GF-02-02. SQ1024.2 +054500 MOVE FILE-RECORD-INFO-P1-120 (1) SQ1024.2 +054600 TO FILE-RECORD-INFO-P1-120 (2). SQ1024.2 +054700 MOVE ZERO TO XRECORD-NUMBER (2). SQ1024.2 +054800 GO TO SEQ-TEST-GF-02-02. SQ1024.2 +054900 SEQ-DELETE-02-02. SQ1024.2 +055000 PERFORM DE-LETE. SQ1024.2 +055100 ADD 1 TO REC-CT. SQ1024.2 +055200 PERFORM DE-LETE. SQ1024.2 +055300 GO TO SEQ-DELETE-GF-02-05. SQ1024.2 +055400 SEQ-TEST-GF-02-02. SQ1024.2 +055500 SEQ-TEST-GF-02-02-LOOP. SQ1024.2 +055600 READ SQ-FS1 SQ1024.2 +055700 AT END GO TO SEQ-TEST-GF-02-02-1. SQ1024.2 +055800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +055900 ADD 1 TO XRECORD-NUMBER (2). SQ1024.2 +056000 IF XRECORD-NUMBER (2) GREATER THAN 750 SQ1024.2 +056100 GO TO SEQ-TEST-GF-02-02-1. SQ1024.2 +056200 IF FILE-RECORD-INFO-P1-120 (1) SQ1024.2 +056300 NOT EQUAL TO FILE-RECORD-INFO-P1-120 (2) SQ1024.2 +056400 ADD 1 TO RECORDS-IN-ERROR. SQ1024.2 +056500 GO TO SEQ-TEST-GF-02-02-LOOP. SQ1024.2 +056600* SQ1024.2 +056700 SEQ-TEST-GF-02-02-1. SQ1024.2 +056800 IF XRECORD-NUMBER (2) = 750 SQ1024.2 +056900 PERFORM PASS SQ1024.2 +057000 ELSE SQ1024.2 +057100 MOVE "RECORD COUNTING ERROR" TO RE-MARK SQ1024.2 +057200 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +057300 MOVE 750 TO CORRECT-18V0 SQ1024.2 +057400 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +057500 PERFORM FAIL. SQ1024.2 +057600* SQ1024.2 +057700 ADD 1 TO REC-CT. SQ1024.2 +057800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1024.2 +057900 PERFORM PASS SQ1024.2 +058000 ELSE SQ1024.2 +058100 MOVE "RECORD CONTENT ERRORS" TO RE-MARK SQ1024.2 +058200 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +058300 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1024.2 +058400 MOVE "VII-44; 4.4.2" TO ANSI-REFERENCE SQ1024.2 +058500 PERFORM FAIL. SQ1024.2 +058600* SQ1024.2 +058700 SEQ-INIT-GF-02-05. SQ1024.2 +058800 GO TO SEQ-TEST-GF-02-05. SQ1024.2 +058900 SEQ-DELETE-GF-02-05. SQ1024.2 +059000 GO TO SEQ-TEST-GF-02-END. SQ1024.2 +059100 SEQ-TEST-GF-02-05. SQ1024.2 +059200 CLOSE SQ-FS1. SQ1024.2 +059300 SEQ-TEST-GF-02-END. SQ1024.2 +059400* SQ1024.2 +059500* SQ1024.2 +059600 SEQ-INIT-GF-03. SQ1024.2 +059700 GO TO SEQ-TEST-GF-03. SQ1024.2 +059800 SEQ-DELETE-03. SQ1024.2 +059900 GO TO SEQ-TEST-03-END. SQ1024.2 +060000 SEQ-TEST-GF-03. SQ1024.2 +060100 OPEN INPUT SQ-FS1. SQ1024.2 +060200 SEQ-TEST-03-END. SQ1024.2 +060300* SQ1024.2 +060400* SQ1024.2 +060500* THIS SERIES OF TESTS CHECKS FOUR LEVEL 1 VARIANTS OF SQ1024.2 +060600* THE READ STATEMENT SQ1024.2 +060700* SQ1024.2 +060800 SEQ-INIT-GF-04. SQ1024.2 +060900 MOVE ZERO TO XRECORD-NUMBER (2). SQ1024.2 +061000 MOVE ZERO TO RECORDS-IN-ERROR. SQ1024.2 +061100 MOVE "READ...RECORD AT END" TO FEATURE. SQ1024.2 +061200 MOVE "SEQ-TEST-GF-O4" TO PAR-NAME. SQ1024.2 +061300 MOVE ZERO TO ERROR-FLAG. SQ1024.2 +061400 MOVE 1 TO REC-CT. SQ1024.2 +061500 GO TO SEQ-TEST-GF-04. SQ1024.2 +061600 SEQ-DELETE-04. SQ1024.2 +061700 PERFORM DE-LETE. SQ1024.2 +061800 ADD 1 TO REC-CT. SQ1024.2 +061900 PERFORM DE-LETE. SQ1024.2 +062000 GO TO SEQ-TEST-04-END. SQ1024.2 +062100 SEQ-TEST-GF-04. SQ1024.2 +062200 READ SQ-FS1 RECORD AT END SQ1024.2 +062300 MOVE 1 TO EOF-FLAG SQ1024.2 +062400 GO TO SEQ-TEST-GF-04-01. SQ1024.2 +062500 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +062600 ADD 1 TO XRECORD-NUMBER (2) SQ1024.2 +062700 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1024.2 +062800 ADD 1 TO RECORDS-IN-ERROR SQ1024.2 +062900 MOVE 1 TO ERROR-FLAG. SQ1024.2 +063000 IF XRECORD-NUMBER (2) LESS THAN 200 SQ1024.2 +063100 GO TO SEQ-TEST-GF-04. SQ1024.2 +063200* SQ1024.2 +063300 SEQ-TEST-GF-04-01. SQ1024.2 +063400 IF EOF-FLAG NOT EQUAL TO ZERO SQ1024.2 +063500 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1024.2 +063600 MOVE 750 TO CORRECT-18V0 SQ1024.2 +063700 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +063800 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +063900 PERFORM FAIL SQ1024.2 +064000 ELSE SQ1024.2 +064100 PERFORM PASS. SQ1024.2 +064200* SQ1024.2 +064300 SEQ-TEST-GF-04-02. SQ1024.2 +064400 ADD 1 TO REC-CT. SQ1024.2 +064500 IF ERROR-FLAG EQUAL TO ZERO SQ1024.2 +064600 PERFORM PASS SQ1024.2 +064700 ELSE SQ1024.2 +064800 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1024.2 +064900 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +065000 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1024.2 +065100 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +065200 PERFORM FAIL. SQ1024.2 +065300 SEQ-TEST-04-END. SQ1024.2 +065400* SQ1024.2 +065500* SQ1024.2 +065600 SEQ-INIT-GF-O5. SQ1024.2 +065700 MOVE 1 TO REC-CT. SQ1024.2 +065800 IF EOF-FLAG EQUAL TO 1 SQ1024.2 +065900 GO TO SEQ-DELETE-05. SQ1024.2 +066000 MOVE ZERO TO ERROR-FLAG. SQ1024.2 +066100 MOVE "READ...AT END..." TO FEATURE SQ1024.2 +066200 MOVE "SEQ-TEST-GF-O5" TO PAR-NAME. SQ1024.2 +066300 MOVE ZERO TO RECORDS-IN-ERROR. SQ1024.2 +066400 GO TO SEQ-TEST-GF-05. SQ1024.2 +066500 SEQ-DELETE-05. SQ1024.2 +066600 PERFORM DE-LETE. SQ1024.2 +066700 ADD 1 TO REC-CT. SQ1024.2 +066800 PERFORM DE-LETE. SQ1024.2 +066900 GO TO SEQ-TEST-05-END. SQ1024.2 +067000 SEQ-TEST-GF-05. SQ1024.2 +067100 READ SQ-FS1 AT END SQ1024.2 +067200 MOVE 1 TO EOF-FLAG SQ1024.2 +067300 GO TO SEQ-TEST-GF-05-01. SQ1024.2 +067400 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +067500 ADD 1 TO XRECORD-NUMBER (2) SQ1024.2 +067600 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1024.2 +067700 ADD 1 TO RECORDS-IN-ERROR SQ1024.2 +067800 MOVE 1 TO ERROR-FLAG. SQ1024.2 +067900 IF XRECORD-NUMBER (2) LESS THAN 400 SQ1024.2 +068000 GO TO SEQ-TEST-GF-05. SQ1024.2 +068100* SQ1024.2 +068200 SEQ-TEST-GF-05-01. SQ1024.2 +068300 IF EOF-FLAG NOT EQUAL TO ZERO SQ1024.2 +068400 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1024.2 +068500 MOVE 750 TO CORRECT-18V0 SQ1024.2 +068600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +068700 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +068800 PERFORM FAIL SQ1024.2 +068900 ELSE SQ1024.2 +069000 PERFORM PASS. SQ1024.2 +069100* SQ1024.2 +069200 SEQ-TEST-GF-05-02. SQ1024.2 +069300 ADD 1 TO REC-CT. SQ1024.2 +069400 IF ERROR-FLAG EQUAL TO ZERO SQ1024.2 +069500 PERFORM PASS SQ1024.2 +069600 ELSE SQ1024.2 +069700 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1024.2 +069800 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +069900 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1024.2 +070000 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +070100 PERFORM FAIL. SQ1024.2 +070200 SEQ-TEST-05-END. SQ1024.2 +070300* SQ1024.2 +070400* SQ1024.2 +070500 SEQ-INIT-GF-O6. SQ1024.2 +070600 MOVE 1 TO REC-CT. SQ1024.2 +070700 IF EOF-FLAG EQUAL TO 1 SQ1024.2 +070800 GO TO SEQ-DELETE-06. SQ1024.2 +070900 MOVE ZERO TO ERROR-FLAG. SQ1024.2 +071000 MOVE "READ...RECORD END..." TO FEATURE SQ1024.2 +071100 MOVE "SEQ-TEST-GF-O6" TO PAR-NAME. SQ1024.2 +071200 MOVE ZERO TO RECORDS-IN-ERROR. SQ1024.2 +071300 GO TO SEQ-TEST-GF-06. SQ1024.2 +071400 SEQ-DELETE-06. SQ1024.2 +071500 PERFORM DE-LETE. SQ1024.2 +071600 ADD 1 TO REC-CT. SQ1024.2 +071700 PERFORM DE-LETE. SQ1024.2 +071800 GO TO SEQ-TEST-06-END. SQ1024.2 +071900 SEQ-TEST-GF-06. SQ1024.2 +072000 READ SQ-FS1 RECORD END SQ1024.2 +072100 MOVE 1 TO EOF-FLAG SQ1024.2 +072200 GO TO SEQ-TEST-GF-06-01. SQ1024.2 +072300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +072400 ADD 1 TO XRECORD-NUMBER (2) SQ1024.2 +072500 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1024.2 +072600 ADD 1 TO RECORDS-IN-ERROR SQ1024.2 +072700 MOVE 1 TO ERROR-FLAG. SQ1024.2 +072800 IF XRECORD-NUMBER (2) LESS THAN 600 SQ1024.2 +072900 GO TO SEQ-TEST-GF-06. SQ1024.2 +073000* SQ1024.2 +073100 SEQ-TEST-GF-06-01. SQ1024.2 +073200 IF EOF-FLAG NOT EQUAL TO ZERO SQ1024.2 +073300 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1024.2 +073400 MOVE 750 TO CORRECT-18V0 SQ1024.2 +073500 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +073600 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +073700 PERFORM FAIL SQ1024.2 +073800 ELSE SQ1024.2 +073900 PERFORM PASS. SQ1024.2 +074000* SQ1024.2 +074100 SEQ-TEST-GF-06-02. SQ1024.2 +074200 ADD 1 TO REC-CT. SQ1024.2 +074300 IF ERROR-FLAG EQUAL TO ZERO SQ1024.2 +074400 PERFORM PASS SQ1024.2 +074500 ELSE SQ1024.2 +074600 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1024.2 +074700 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +074800 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1024.2 +074900 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +075000 PERFORM FAIL. SQ1024.2 +075100 SEQ-TEST-06-END. SQ1024.2 +075200* SQ1024.2 +075300* SQ1024.2 +075400 SEQ-INIT-GF-O7. SQ1024.2 +075500 MOVE 1 TO REC-CT. SQ1024.2 +075600 IF EOF-FLAG EQUAL TO 1 SQ1024.2 +075700 GO TO SEQ-DELETE-07. SQ1024.2 +075800 MOVE ZERO TO ERROR-FLAG. SQ1024.2 +075900 MOVE "READ... END..." TO FEATURE SQ1024.2 +076000 MOVE "SEQ-TEST-GF-O7" TO PAR-NAME. SQ1024.2 +076100 MOVE ZERO TO RECORDS-IN-ERROR. SQ1024.2 +076200 GO TO SEQ-TEST-GF-07. SQ1024.2 +076300 SEQ-DELETE-07. SQ1024.2 +076400 PERFORM DE-LETE. SQ1024.2 +076500 ADD 1 TO REC-CT. SQ1024.2 +076600 PERFORM DE-LETE. SQ1024.2 +076700 GO TO SEQ-TEST-07-END. SQ1024.2 +076800 SEQ-TEST-GF-07. SQ1024.2 +076900 READ SQ-FS1 END SQ1024.2 +077000 MOVE 1 TO EOF-FLAG SQ1024.2 +077100 GO TO SEQ-TEST-GF-07-01. SQ1024.2 +077200 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1024.2 +077300 ADD 1 TO XRECORD-NUMBER (2) SQ1024.2 +077400 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1024.2 +077500 ADD 1 TO RECORDS-IN-ERROR SQ1024.2 +077600 MOVE 1 TO ERROR-FLAG. SQ1024.2 +077700 IF XRECORD-NUMBER (2) LESS THAN 750 SQ1024.2 +077800 GO TO SEQ-TEST-GF-07. SQ1024.2 +077900* SQ1024.2 +078000 SEQ-TEST-GF-07-01. SQ1024.2 +078100 IF EOF-FLAG NOT EQUAL TO ZERO SQ1024.2 +078200 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1024.2 +078300 MOVE 750 TO CORRECT-18V0 SQ1024.2 +078400 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1024.2 +078500 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +078600 PERFORM FAIL SQ1024.2 +078700 ELSE SQ1024.2 +078800 PERFORM PASS. SQ1024.2 +078900* SQ1024.2 +079000 SEQ-TEST-GF-07-02. SQ1024.2 +079100 ADD 1 TO REC-CT. SQ1024.2 +079200 IF ERROR-FLAG EQUAL TO ZERO SQ1024.2 +079300 PERFORM PASS SQ1024.2 +079400 ELSE SQ1024.2 +079500 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1024.2 +079600 MOVE ZERO TO CORRECT-18V0 SQ1024.2 +079700 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1024.2 +079800 MOVE "VII-44" TO ANSI-REFERENCE SQ1024.2 +079900 PERFORM FAIL. SQ1024.2 +080000 SEQ-TEST-07-END. SQ1024.2 +080100* SQ1024.2 +080200* SQ1024.2 +080300 SEQ-INIT-GF-O8. SQ1024.2 +080400 MOVE 1 TO REC-CT. SQ1024.2 +080500 IF EOF-FLAG EQUAL TO 1 SQ1024.2 +080600 GO TO SEQ-DELETE-08. SQ1024.2 +080700 MOVE "READ... END... AT EOF" TO FEATURE SQ1024.2 +080800 MOVE "SEQ-TEST-GF-O8" TO PAR-NAME. SQ1024.2 +080900 GO TO SEQ-TEST-GF-08. SQ1024.2 +081000 SEQ-DELETE-08. SQ1024.2 +081100 PERFORM DE-LETE. SQ1024.2 +081200 GO TO SEQ-TEST-08-END. SQ1024.2 +081300 SEQ-TEST-GF-08. SQ1024.2 +081400 READ SQ-FS1 END SQ1024.2 +081500 MOVE 1 TO EOF-FLAG. SQ1024.2 +081600* SQ1024.2 +081700 SEQ-TEST-GF-08-01. SQ1024.2 +081800 IF EOF-FLAG NOT EQUAL TO 1 SQ1024.2 +081900 MOVE EOF-FLAG TO COMPUTED-18V0 SQ1024.2 +082000 MOVE 1 TO CORRECT-18V0 SQ1024.2 +082100 MOVE "EOF NOT FOUND AFTER 750 RECORDS" TO RE-MARK SQ1024.2 +082200 PERFORM FAIL SQ1024.2 +082300 ELSE SQ1024.2 +082400 PERFORM PASS. SQ1024.2 +082500 SEQ-TEST-08-END. SQ1024.2 +082600* SQ1024.2 +082700* SQ1024.2 +082800 SEQ-INIT-GF-O9. SQ1024.2 +082900 GO TO SEQ-TEST-GF-09. SQ1024.2 +083000 SEQ-DELETE-09. SQ1024.2 +083100 GO TO SEQ-TEST-09-END. SQ1024.2 +083200 SEQ-TEST-GF-09. SQ1024.2 +083300 CLOSE SQ-FS1. SQ1024.2 +083400 SEQ-TEST-09-END. SQ1024.2 +083500* SQ1024.2 +083600* SQ1024.2 +083700 TERMINATE-ROUTINE. SQ1024.2 +083800 EXIT. SQ1024.2 +083900 CCVS-EXIT SECTION. SQ1024.2 +084000 CCVS-999999. SQ1024.2 +084100 GO TO CLOSE-FILES. SQ1024.2 diff --git a/tests/cobol85/SQ/SQ103A.CBL b/tests/cobol85/SQ/SQ103A.CBL new file mode 100755 index 00000000..31f99bf9 --- /dev/null +++ b/tests/cobol85/SQ/SQ103A.CBL @@ -0,0 +1,1055 @@ +000100 IDENTIFICATION DIVISION. SQ1034.2 +000200 PROGRAM-ID. SQ1034.2 +000300 SQ103A. SQ1034.2 +000400**************************************************************** SQ1034.2 +000500* * SQ1034.2 +000600* VALIDATION FOR:- * SQ1034.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1034.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1034.2 +000900* REVISED 1986, AUGUST * SQ1034.2 +001000* * SQ1034.2 +001100* CREATION DATE / VALIDATION DATE * SQ1034.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1034.2 +001300* * SQ1034.2 +001400**************************************************************** SQ1034.2 +001500* * SQ1034.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1034.2 +001700* * SQ1034.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE SQ1034.2 +001900* X-55 SYSTEM PRINTER * SQ1034.2 +002000* X-82 SOURCE-COMPUTER * SQ1034.2 +002100* X-83 OBJECT-COMPUTER. * SQ1034.2 +002200* * SQ1034.2 +002300**************************************************************** SQ1034.2 +002400* * SQ1034.2 +002500* THIS PROGRAM CREATES A TAPE FILE OF 500 FIXED LENGTH * SQ1034.2 +002600* RECORDS, EACH 120 CHARACTERS LONG. THE FILE IS CLOSED * SQ1034.2 +002700* AND OPENED AGAIN AS AN INPUT FILE. THE FILE IS READ * SQ1034.2 +002800* USING A READ STATEMENT WITH THE AT END PHRASE. RECORDS * SQ1034.2 +002900* ARE COUNTED AND COMPARED WITH THE VALUES WRITTEN TO * SQ1034.2 +003000* ENSURE THAT THEY WERE PROCESSED CORRECTLY. THERE IS A * SQ1034.2 +003100* DECLARATIVE PROCEDURE FOR THE FILE AND TESTS ARE MADE * SQ1034.2 +003200* DURING THIS PASS TO CHECK THAT IT IS NOT ENTERED AFTER * SQ1034.2 +003300* I-O STATEMENT, INCLUDING THAT WHICH RAISES THE AT END * SQ1034.2 +003400* CONDITION. THE FILE IS CLOSED AND OPENED IN THE INPUT * SQ1034.2 +003500* MODE AGAIN. ON THIS PASS, THE FILE IS READ USING READ * SQ1034.2 +003600* STATEMENTS WITHOUT THE AT END PHRASE. FIRST HUNDRED * SQ1034.2 +003700* RECORDS ARE READ USING A READ STATEMENT WITH THE OPTIONAL * SQ1034.2 +003800* WORD "RECORD", THE REMAINDER WITHOUT IT. ON THIS PASS, * SQ1034.2 +003900* THE AT END CONDITION SHOULD CAUSE EXECUTION OF THE * SQ1034.2 +004000* DECLARATIVE PROCEDURE. * SQ1034.2 +004100* * SQ1034.2 +004200* THE FILE-CONTROL ENTRY FOR THE FILE CONTAINS A FILE * SQ1034.2 +004300* STATUS CLAUSE, AND TESTS CHECK THAT EACH I-O OPERATION * SQ1034.2 +004400* RETURNS THE APPROPRIATE STATUS VALUE. * SQ1034.2 +004500* * SQ1034.2 +004600**************************************************************** SQ1034.2 +004700* SQ1034.2 +004800* SQ1034.2 +004900 ENVIRONMENT DIVISION. SQ1034.2 +005000 CONFIGURATION SECTION. SQ1034.2 +005100 SOURCE-COMPUTER. SQ1034.2 +005200 Linux. SQ1034.2 +005300 OBJECT-COMPUTER. SQ1034.2 +005400 Linux. SQ1034.2 +005500* SQ1034.2 +005600 INPUT-OUTPUT SECTION. SQ1034.2 +005700 FILE-CONTROL. SQ1034.2 +005800 SELECT PRINT-FILE ASSIGN TO SQ1034.2 +005900 "report.log". SQ1034.2 +006000* SQ1034.2 +006100*P SELECT RAW-DATA ASSIGN TO SQ1034.2 +006200*P "XXXXX062" SQ1034.2 +006300*P ORGANIZATION IS INDEXED SQ1034.2 +006400*P ACCESS MODE IS RANDOM SQ1034.2 +006500*P RECORD-KEY IS RAW-DATA-KEY. SQ1034.2 +006600*P SQ1034.2 +006700 SELECT SQ-FS2 ASSIGN TO SQ1034.2 +006800 "XXXXX001" SQ1034.2 +006900 ACCESS MODE IS SEQUENTIAL SQ1034.2 +007000 FILE STATUS IS SQ-FS2-STATUS SQ1034.2 +007100 ORGANIZATION SEQUENTIAL SQ1034.2 +007200 . SQ1034.2 +007300* SQ1034.2 +007400* SQ1034.2 +007500 DATA DIVISION. SQ1034.2 +007600 FILE SECTION. SQ1034.2 +007700 FD PRINT-FILE SQ1034.2 +007800*C LABEL RECORDS SQ1034.2 +007900*C OMITTED SQ1034.2 +008000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1034.2 +008100 . SQ1034.2 +008200 01 PRINT-REC PICTURE X(120). SQ1034.2 +008300 01 DUMMY-RECORD PICTURE X(120). SQ1034.2 +008400*P SQ1034.2 +008500*PD RAW-DATA. SQ1034.2 +008600*P1 RAW-DATA-SATZ. SQ1034.2 +008700*P 05 RAW-DATA-KEY PIC X(6). SQ1034.2 +008800*P 05 C-DATE PIC 9(6). SQ1034.2 +008900*P 05 C-TIME PIC 9(8). SQ1034.2 +009000*P 05 NO-OF-TESTS PIC 99. SQ1034.2 +009100*P 05 C-OK PIC 999. SQ1034.2 +009200*P 05 C-ALL PIC 999. SQ1034.2 +009300*P 05 C-FAIL PIC 999. SQ1034.2 +009400*P 05 C-DELETED PIC 999. SQ1034.2 +009500*P 05 C-INSPECT PIC 999. SQ1034.2 +009600*P 05 C-NOTE PIC X(13). SQ1034.2 +009700*P 05 C-INDENT PIC X. SQ1034.2 +009800*P 05 C-ABORT PIC X(8). SQ1034.2 +009900* SQ1034.2 +010000 FD SQ-FS2 SQ1034.2 +010100*C LABEL RECORD IS STANDARD SQ1034.2 +010200 . SQ1034.2 +010300 01 SQ-FS2R1-F-G-120 PIC X(120). SQ1034.2 +010400* SQ1034.2 +010500 WORKING-STORAGE SECTION. SQ1034.2 +010600* SQ1034.2 +010700*************************************************************** SQ1034.2 +010800* * SQ1034.2 +010900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1034.2 +011000* * SQ1034.2 +011100*************************************************************** SQ1034.2 +011200* SQ1034.2 +011300 01 SQ-FS2-STATUS. SQ1034.2 +011400 03 SQ-FS2-KEY-1 PIC X. SQ1034.2 +011500 03 SQ-FS2-KEY-2 PIC X. SQ1034.2 +011600* SQ1034.2 +011700 01 SQ-FS2-STATUS-COPY PIC XX. SQ1034.2 +011800 01 DECL-EXEC-SW PIC 9. SQ1034.2 +011900 01 DECL-EXEC-COUNT PIC 99999. SQ1034.2 +012000 01 EOF-FLAG PIC 9 VALUE 0. SQ1034.2 +012100 01 WRK-CS-09V00 PICTURE S9(9) USAGE COMPUTATIONAL. SQ1034.2 +012200 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP. SQ1034.2 +012300 01 ERROR-FLAG PICTURE 9. SQ1034.2 +012400* SQ1034.2 +012500*************************************************************** SQ1034.2 +012600* * SQ1034.2 +012700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1034.2 +012800* * SQ1034.2 +012900*************************************************************** SQ1034.2 +013000* SQ1034.2 +013100 01 REC-SKEL-SUB PIC 99. SQ1034.2 +013200* SQ1034.2 +013300 01 FILE-RECORD-INFORMATION-REC. SQ1034.2 +013400 03 FILE-RECORD-INFO-SKELETON. SQ1034.2 +013500 05 FILLER PICTURE X(48) VALUE SQ1034.2 +013600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1034.2 +013700 05 FILLER PICTURE X(46) VALUE SQ1034.2 +013800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1034.2 +013900 05 FILLER PICTURE X(26) VALUE SQ1034.2 +014000 ",LFIL=000000,ORG= ,LBLR= ". SQ1034.2 +014100 05 FILLER PICTURE X(37) VALUE SQ1034.2 +014200 ",RECKEY= ". SQ1034.2 +014300 05 FILLER PICTURE X(38) VALUE SQ1034.2 +014400 ",ALTKEY1= ". SQ1034.2 +014500 05 FILLER PICTURE X(38) VALUE SQ1034.2 +014600 ",ALTKEY2= ". SQ1034.2 +014700 05 FILLER PICTURE X(7) VALUE SPACE.SQ1034.2 +014800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1034.2 +014900 05 FILE-RECORD-INFO-P1-120. SQ1034.2 +015000 07 FILLER PIC X(5). SQ1034.2 +015100 07 XFILE-NAME PIC X(6). SQ1034.2 +015200 07 FILLER PIC X(8). SQ1034.2 +015300 07 XRECORD-NAME PIC X(6). SQ1034.2 +015400 07 FILLER PIC X(1). SQ1034.2 +015500 07 REELUNIT-NUMBER PIC 9(1). SQ1034.2 +015600 07 FILLER PIC X(7). SQ1034.2 +015700 07 XRECORD-NUMBER PIC 9(6). SQ1034.2 +015800 07 FILLER PIC X(6). SQ1034.2 +015900 07 UPDATE-NUMBER PIC 9(2). SQ1034.2 +016000 07 FILLER PIC X(5). SQ1034.2 +016100 07 ODO-NUMBER PIC 9(4). SQ1034.2 +016200 07 FILLER PIC X(5). SQ1034.2 +016300 07 XPROGRAM-NAME PIC X(5). SQ1034.2 +016400 07 FILLER PIC X(7). SQ1034.2 +016500 07 XRECORD-LENGTH PIC 9(6). SQ1034.2 +016600 07 FILLER PIC X(7). SQ1034.2 +016700 07 CHARS-OR-RECORDS PIC X(2). SQ1034.2 +016800 07 FILLER PIC X(1). SQ1034.2 +016900 07 XBLOCK-SIZE PIC 9(4). SQ1034.2 +017000 07 FILLER PIC X(6). SQ1034.2 +017100 07 RECORDS-IN-FILE PIC 9(6). SQ1034.2 +017200 07 FILLER PIC X(5). SQ1034.2 +017300 07 XFILE-ORGANIZATION PIC X(2). SQ1034.2 +017400 07 FILLER PIC X(6). SQ1034.2 +017500 07 XLABEL-TYPE PIC X(1). SQ1034.2 +017600 05 FILE-RECORD-INFO-P121-240. SQ1034.2 +017700 07 FILLER PIC X(8). SQ1034.2 +017800 07 XRECORD-KEY PIC X(29). SQ1034.2 +017900 07 FILLER PIC X(9). SQ1034.2 +018000 07 ALTERNATE-KEY1 PIC X(29). SQ1034.2 +018100 07 FILLER PIC X(9). SQ1034.2 +018200 07 ALTERNATE-KEY2 PIC X(29). SQ1034.2 +018300 07 FILLER PIC X(7). SQ1034.2 +018400* SQ1034.2 +018500 01 TEST-RESULTS. SQ1034.2 +018600 02 FILLER PIC X VALUE SPACE. SQ1034.2 +018700 02 PAR-NAME. SQ1034.2 +018800 03 FILLER PIC X(14) VALUE SPACE. SQ1034.2 +018900 03 PARDOT-X PIC X VALUE SPACE. SQ1034.2 +019000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1034.2 +019100 02 FILLER PIC X VALUE SPACE. SQ1034.2 +019200 02 FEATURE PIC X(24) VALUE SPACE. SQ1034.2 +019300 02 FILLER PIC X VALUE SPACE. SQ1034.2 +019400 02 P-OR-F PIC X(5) VALUE SPACE. SQ1034.2 +019500 02 FILLER PIC X(9) VALUE SPACE. SQ1034.2 +019600 02 RE-MARK PIC X(61). SQ1034.2 +019700 01 TEST-COMPUTED. SQ1034.2 +019800 02 FILLER PIC X(30) VALUE SPACE. SQ1034.2 +019900 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1034.2 +020000 02 COMPUTED-X. SQ1034.2 +020100 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1034.2 +020200 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1034.2 +020300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1034.2 +020400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1034.2 +020500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1034.2 +020600 03 CM-18V0 REDEFINES COMPUTED-A. SQ1034.2 +020700 04 COMPUTED-18V0 PIC -9(18). SQ1034.2 +020800 04 FILLER PIC X. SQ1034.2 +020900 03 FILLER PIC X(50) VALUE SPACE. SQ1034.2 +021000 01 TEST-CORRECT. SQ1034.2 +021100 02 FILLER PIC X(30) VALUE SPACE. SQ1034.2 +021200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1034.2 +021300 02 CORRECT-X. SQ1034.2 +021400 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1034.2 +021500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1034.2 +021600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1034.2 +021700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1034.2 +021800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1034.2 +021900 03 CR-18V0 REDEFINES CORRECT-A. SQ1034.2 +022000 04 CORRECT-18V0 PIC -9(18). SQ1034.2 +022100 04 FILLER PIC X. SQ1034.2 +022200 03 FILLER PIC X(2) VALUE SPACE. SQ1034.2 +022300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1034.2 +022400* SQ1034.2 +022500 01 CCVS-C-1. SQ1034.2 +022600 02 FILLER PIC IS X VALUE SPACE. SQ1034.2 +022700 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1034.2 +022800 02 FILLER PIC IS X VALUE SPACE. SQ1034.2 +022900 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1034.2 +023000 02 FILLER PIC IS X VALUE SPACE. SQ1034.2 +023100 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1034.2 +023200 02 FILLER PIC IS X(9) VALUE SPACE. SQ1034.2 +023300 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1034.2 +023400 01 CCVS-C-2. SQ1034.2 +023500 02 FILLER PIC X(20) VALUE SPACE. SQ1034.2 +023600 02 FILLER PIC X(6) VALUE "TESTED". SQ1034.2 +023700 02 FILLER PIC X(18) VALUE SPACE. SQ1034.2 +023800 02 FILLER PIC X(4) VALUE "FAIL". SQ1034.2 +023900 02 FILLER PIC X(72) VALUE SPACE. SQ1034.2 +024000* SQ1034.2 +024100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1034.2 +024200 01 REC-CT PIC 99 VALUE ZERO. SQ1034.2 +024300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1034.2 +024400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1034.2 +024500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1034.2 +024600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1034.2 +024700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1034.2 +024800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1034.2 +024900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1034.2 +025000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1034.2 +025100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1034.2 +025200 01 CCVS-H-1. SQ1034.2 +025300 02 FILLER PIC X(39) VALUE SPACES. SQ1034.2 +025400 02 FILLER PIC X(42) VALUE SQ1034.2 +025500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1034.2 +025600 02 FILLER PIC X(39) VALUE SPACES. SQ1034.2 +025700 01 CCVS-H-2A. SQ1034.2 +025800 02 FILLER PIC X(40) VALUE SPACE. SQ1034.2 +025900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1034.2 +026000 02 FILLER PIC XXXX VALUE SQ1034.2 +026100 "4.2 ". SQ1034.2 +026200 02 FILLER PIC X(28) VALUE SQ1034.2 +026300 " COPY - NOT FOR DISTRIBUTION". SQ1034.2 +026400 02 FILLER PIC X(41) VALUE SPACE. SQ1034.2 +026500* SQ1034.2 +026600 01 CCVS-H-2B. SQ1034.2 +026700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1034.2 +026800 02 TEST-ID PIC X(9). SQ1034.2 +026900 02 FILLER PIC X(4) VALUE " IN ". SQ1034.2 +027000 02 FILLER PIC X(12) VALUE SQ1034.2 +027100 " HIGH ". SQ1034.2 +027200 02 FILLER PIC X(22) VALUE SQ1034.2 +027300 " LEVEL VALIDATION FOR ". SQ1034.2 +027400 02 FILLER PIC X(58) VALUE SQ1034.2 +027500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1034.2 +027600 01 CCVS-H-3. SQ1034.2 +027700 02 FILLER PIC X(34) VALUE SQ1034.2 +027800 " FOR OFFICIAL USE ONLY ". SQ1034.2 +027900 02 FILLER PIC X(58) VALUE SQ1034.2 +028000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1034.2 +028100 02 FILLER PIC X(28) VALUE SQ1034.2 +028200 " COPYRIGHT 1985,1986 ". SQ1034.2 +028300 01 CCVS-E-1. SQ1034.2 +028400 02 FILLER PIC X(52) VALUE SPACE. SQ1034.2 +028500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1034.2 +028600 02 ID-AGAIN PIC X(9). SQ1034.2 +028700 02 FILLER PIC X(45) VALUE SPACES. SQ1034.2 +028800 01 CCVS-E-2. SQ1034.2 +028900 02 FILLER PIC X(31) VALUE SPACE. SQ1034.2 +029000 02 FILLER PIC X(21) VALUE SPACE. SQ1034.2 +029100 02 CCVS-E-2-2. SQ1034.2 +029200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1034.2 +029300 03 FILLER PIC X VALUE SPACE. SQ1034.2 +029400 03 ENDER-DESC PIC X(44) VALUE SQ1034.2 +029500 "ERRORS ENCOUNTERED". SQ1034.2 +029600 01 CCVS-E-3. SQ1034.2 +029700 02 FILLER PIC X(22) VALUE SQ1034.2 +029800 " FOR OFFICIAL USE ONLY". SQ1034.2 +029900 02 FILLER PIC X(12) VALUE SPACE. SQ1034.2 +030000 02 FILLER PIC X(58) VALUE SQ1034.2 +030100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1034.2 +030200 02 FILLER PIC X(8) VALUE SPACE. SQ1034.2 +030300 02 FILLER PIC X(20) VALUE SQ1034.2 +030400 " COPYRIGHT 1985,1986". SQ1034.2 +030500 01 CCVS-E-4. SQ1034.2 +030600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1034.2 +030700 02 FILLER PIC X(4) VALUE " OF ". SQ1034.2 +030800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1034.2 +030900 02 FILLER PIC X(40) VALUE SQ1034.2 +031000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1034.2 +031100 01 XXINFO. SQ1034.2 +031200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1034.2 +031300 02 INFO-TEXT. SQ1034.2 +031400 04 FILLER PIC X(8) VALUE SPACE. SQ1034.2 +031500 04 XXCOMPUTED PIC X(20). SQ1034.2 +031600 04 FILLER PIC X(5) VALUE SPACE. SQ1034.2 +031700 04 XXCORRECT PIC X(20). SQ1034.2 +031800 02 INF-ANSI-REFERENCE PIC X(48). SQ1034.2 +031900 01 HYPHEN-LINE. SQ1034.2 +032000 02 FILLER PIC IS X VALUE IS SPACE. SQ1034.2 +032100 02 FILLER PIC IS X(65) VALUE IS "************************SQ1034.2 +032200- "*****************************************". SQ1034.2 +032300 02 FILLER PIC IS X(54) VALUE IS "************************SQ1034.2 +032400- "******************************". SQ1034.2 +032500 01 CCVS-PGM-ID PIC X(9) VALUE SQ1034.2 +032600 "SQ103A". SQ1034.2 +032700* SQ1034.2 +032800* SQ1034.2 +032900 PROCEDURE DIVISION. SQ1034.2 +033000 DECLARATIVES. SQ1034.2 +033100 SECT-SQ103-0001 SECTION. SQ1034.2 +033200 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-FS2. SQ1034.2 +033300 TEST-STATUS. SQ1034.2 +033400 MOVE ZERO TO DECL-EXEC-SW. SQ1034.2 +033500 ADD 1 TO DECL-EXEC-COUNT. SQ1034.2 +033600 END DECLARATIVES. SQ1034.2 +033700* SQ1034.2 +033800 CCVS1 SECTION. SQ1034.2 +033900 OPEN-FILES. SQ1034.2 +034000*P OPEN I-O RAW-DATA. SQ1034.2 +034100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1034.2 +034200*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1034.2 +034300*P MOVE "ABORTED " TO C-ABORT. SQ1034.2 +034400*P ADD 1 TO C-NO-OF-TESTS. SQ1034.2 +034500*P ACCEPT C-DATE FROM DATE. SQ1034.2 +034600*P ACCEPT C-TIME FROM TIME. SQ1034.2 +034700*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1034.2 +034800*PND-E-1. SQ1034.2 +034900*P CLOSE RAW-DATA. SQ1034.2 +035000 OPEN OUTPUT PRINT-FILE. SQ1034.2 +035100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1034.2 +035200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1034.2 +035300 MOVE SPACE TO TEST-RESULTS. SQ1034.2 +035400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1034.2 +035500 MOVE ZERO TO REC-SKEL-SUB. SQ1034.2 +035600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1034.2 +035700 GO TO CCVS1-EXIT. SQ1034.2 +035800* SQ1034.2 +035900 CCVS-INIT-FILE. SQ1034.2 +036000 ADD 1 TO REC-SKL-SUB. SQ1034.2 +036100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1034.2 +036200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1034.2 +036300* SQ1034.2 +036400 CLOSE-FILES. SQ1034.2 +036500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1034.2 +036600 CLOSE PRINT-FILE. SQ1034.2 +036700*P OPEN I-O RAW-DATA. SQ1034.2 +036800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1034.2 +036900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1034.2 +037000*P MOVE "OK. " TO C-ABORT. SQ1034.2 +037100*P MOVE PASS-COUNTER TO C-OK. SQ1034.2 +037200*P MOVE ERROR-HOLD TO C-ALL. SQ1034.2 +037300*P MOVE ERROR-COUNTER TO C-FAIL. SQ1034.2 +037400*P MOVE DELETE-CNT TO C-DELETED. SQ1034.2 +037500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1034.2 +037600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1034.2 +037700*PND-E-2. SQ1034.2 +037800*P CLOSE RAW-DATA. SQ1034.2 +037900 TERMINATE-CCVS. SQ1034.2 +038000*S EXIT PROGRAM. SQ1034.2 +038100 STOP RUN. SQ1034.2 +038200* SQ1034.2 +038300 INSPT. SQ1034.2 +038400 MOVE "INSPT" TO P-OR-F. SQ1034.2 +038500 ADD 1 TO INSPECT-COUNTER. SQ1034.2 +038600 PERFORM PRINT-DETAIL. SQ1034.2 +038700* SQ1034.2 +038800 PASS. SQ1034.2 +038900 MOVE "PASS " TO P-OR-F. SQ1034.2 +039000 ADD 1 TO PASS-COUNTER. SQ1034.2 +039100 PERFORM PRINT-DETAIL. SQ1034.2 +039200* SQ1034.2 +039300 FAIL. SQ1034.2 +039400 MOVE "FAIL*" TO P-OR-F. SQ1034.2 +039500 ADD 1 TO ERROR-COUNTER. SQ1034.2 +039600 PERFORM PRINT-DETAIL. SQ1034.2 +039700* SQ1034.2 +039800 DE-LETE. SQ1034.2 +039900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1034.2 +040000 MOVE "*****" TO P-OR-F. SQ1034.2 +040100 ADD 1 TO DELETE-COUNTER. SQ1034.2 +040200 PERFORM PRINT-DETAIL. SQ1034.2 +040300* SQ1034.2 +040400 PRINT-DETAIL. SQ1034.2 +040500 IF REC-CT NOT EQUAL TO ZERO SQ1034.2 +040600 MOVE "." TO PARDOT-X SQ1034.2 +040700 MOVE REC-CT TO DOTVALUE. SQ1034.2 +040800 MOVE TEST-RESULTS TO PRINT-REC. SQ1034.2 +040900 PERFORM WRITE-LINE. SQ1034.2 +041000 IF P-OR-F EQUAL TO "FAIL*" SQ1034.2 +041100 PERFORM WRITE-LINE SQ1034.2 +041200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1034.2 +041300 ELSE SQ1034.2 +041400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1034.2 +041500 MOVE SPACE TO P-OR-F. SQ1034.2 +041600 MOVE SPACE TO COMPUTED-X. SQ1034.2 +041700 MOVE SPACE TO CORRECT-X. SQ1034.2 +041800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1034.2 +041900 MOVE SPACE TO RE-MARK. SQ1034.2 +042000* SQ1034.2 +042100 HEAD-ROUTINE. SQ1034.2 +042200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +042300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +042400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1034.2 +042500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1034.2 +042600 COLUMN-NAMES-ROUTINE. SQ1034.2 +042700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1034.2 +042800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +042900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1034.2 +043000 END-ROUTINE. SQ1034.2 +043100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1034.2 +043200 PERFORM WRITE-LINE 5 TIMES. SQ1034.2 +043300 END-RTN-EXIT. SQ1034.2 +043400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1034.2 +043500 PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +043600* SQ1034.2 +043700 END-ROUTINE-1. SQ1034.2 +043800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1034.2 +043900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1034.2 +044000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1034.2 +044100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1034.2 +044200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1034.2 +044300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1034.2 +044400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1034.2 +044500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1034.2 +044600 PERFORM WRITE-LINE. SQ1034.2 +044700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1034.2 +044800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1034.2 +044900 MOVE "NO " TO ERROR-TOTAL SQ1034.2 +045000 ELSE SQ1034.2 +045100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1034.2 +045200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1034.2 +045300 PERFORM WRITE-LINE. SQ1034.2 +045400 END-ROUTINE-13. SQ1034.2 +045500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1034.2 +045600 MOVE "NO " TO ERROR-TOTAL SQ1034.2 +045700 ELSE SQ1034.2 +045800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1034.2 +045900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1034.2 +046000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1034.2 +046100 PERFORM WRITE-LINE. SQ1034.2 +046200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1034.2 +046300 MOVE "NO " TO ERROR-TOTAL SQ1034.2 +046400 ELSE SQ1034.2 +046500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1034.2 +046600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1034.2 +046700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1034.2 +046800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1034.2 +046900* SQ1034.2 +047000 WRITE-LINE. SQ1034.2 +047100 ADD 1 TO RECORD-COUNT. SQ1034.2 +047200 IF RECORD-COUNT GREATER 50 SQ1034.2 +047300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1034.2 +047400 MOVE SPACE TO DUMMY-RECORD SQ1034.2 +047500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1034.2 +047600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1034.2 +047700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1034.2 +047800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1034.2 +047900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1034.2 +048000 MOVE ZERO TO RECORD-COUNT. SQ1034.2 +048100 PERFORM WRT-LN. SQ1034.2 +048200* SQ1034.2 +048300 WRT-LN. SQ1034.2 +048400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1034.2 +048500 MOVE SPACE TO DUMMY-RECORD. SQ1034.2 +048600 BLANK-LINE-PRINT. SQ1034.2 +048700 PERFORM WRT-LN. SQ1034.2 +048800 FAIL-ROUTINE. SQ1034.2 +048900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1034.2 +049000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1034.2 +049100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1034.2 +049200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1034.2 +049300 MOVE XXINFO TO DUMMY-RECORD. SQ1034.2 +049400 PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +049500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1034.2 +049600 GO TO FAIL-ROUTINE-EX. SQ1034.2 +049700 FAIL-ROUTINE-WRITE. SQ1034.2 +049800 MOVE TEST-COMPUTED TO PRINT-REC SQ1034.2 +049900 PERFORM WRITE-LINE SQ1034.2 +050000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1034.2 +050100 MOVE TEST-CORRECT TO PRINT-REC SQ1034.2 +050200 PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +050300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1034.2 +050400 FAIL-ROUTINE-EX. SQ1034.2 +050500 EXIT. SQ1034.2 +050600 BAIL-OUT. SQ1034.2 +050700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1034.2 +050800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1034.2 +050900 BAIL-OUT-WRITE. SQ1034.2 +051000 MOVE CORRECT-A TO XXCORRECT. SQ1034.2 +051100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1034.2 +051200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1034.2 +051300 MOVE XXINFO TO DUMMY-RECORD. SQ1034.2 +051400 PERFORM WRITE-LINE 2 TIMES. SQ1034.2 +051500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1034.2 +051600 BAIL-OUT-EX. SQ1034.2 +051700 EXIT. SQ1034.2 +051800 CCVS1-EXIT. SQ1034.2 +051900 EXIT. SQ1034.2 +052000* SQ1034.2 +052100**************************************************************** SQ1034.2 +052200* * SQ1034.2 +052300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1034.2 +052400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1034.2 +052500* * SQ1034.2 +052600**************************************************************** SQ1034.2 +052700* SQ1034.2 +052800 SECT-SQ103-0002 SECTION. SQ1034.2 +052900 INITIAL-PARA. SQ1034.2 +053000 MOVE "SQ-FS2" TO XFILE-NAME (1). SQ1034.2 +053100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1034.2 +053200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1034.2 +053300 MOVE 120 TO XRECORD-LENGTH (1). SQ1034.2 +053400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1034.2 +053500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1034.2 +053600 MOVE 500 TO RECORDS-IN-FILE (1). SQ1034.2 +053700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1034.2 +053800 MOVE "S" TO XLABEL-TYPE (1). SQ1034.2 +053900* SQ1034.2 +054000 SEQ-INIT-01. SQ1034.2 +054100 MOVE "SEQ-TEST-GF-01" TO PAR-NAME. SQ1034.2 +054200 MOVE "OPEN OUTPUT, TAPE FILE" TO FEATURE. SQ1034.2 +054300 MOVE 1 TO REC-CT. SQ1034.2 +054400 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +054500 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +054600 MOVE 000001 TO XRECORD-NUMBER (1). SQ1034.2 +054700 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +054800 GO TO SEQ-TEST-GF-01. SQ1034.2 +054900 SEQ-DELETE-01. SQ1034.2 +055000 PERFORM DE-LETE. SQ1034.2 +055100 ADD 1 TO REC-CT SQ1034.2 +055200 PERFORM DE-LETE. SQ1034.2 +055300 GO TO SEQ-DELETE-02. SQ1034.2 +055400 SEQ-TEST-GF-01. SQ1034.2 +055500 OPEN OUTPUT SQ-FS2. SQ1034.2 +055600 IF DECL-EXEC-SW = 1 SQ1034.2 +055700 PERFORM PASS SQ1034.2 +055800 ELSE SQ1034.2 +055900 MOVE 1 TO CORRECT-18V0 SQ1034.2 +056000 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +056100 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE" TO RE-MARK SQ1034.2 +056200 PERFORM FAIL. SQ1034.2 +056300 ADD 1 TO REC-CT. SQ1034.2 +056400 IF SQ-FS2-STATUS EQUAL "00" SQ1034.2 +056500 PERFORM PASS SQ1034.2 +056600 ELSE SQ1034.2 +056700 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +056800 MOVE "00" TO CORRECT-A SQ1034.2 +056900 MOVE "UNEXPECTED I-O STATUS FROM OPEN" TO RE-MARK SQ1034.2 +057000 PERFORM FAIL. SQ1034.2 +057100* SQ1034.2 +057200 SEQ-INIT-02. SQ1034.2 +057300 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +057400 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +057500 MOVE "00" TO SQ-FS2-STATUS-COPY. SQ1034.2 +057600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1034.2 +057700 GO TO SEQ-TEST-GF-02. SQ1034.2 +057800 SEQ-DELETE-02. SQ1034.2 +057900 MOVE 1 TO REC-CT. SQ1034.2 +058000 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1034.2 +058100 MOVE "WRITE 500 RECORDS" TO FEATURE. SQ1034.2 +058200 PERFORM DE-LETE. SQ1034.2 +058300 ADD 1 TO REC-CT. SQ1034.2 +058400 PERFORM DE-LETE. SQ1034.2 +058500 GO TO SEQ-TEST-02-END. SQ1034.2 +058600 SEQ-TEST-GF-02. SQ1034.2 +058700 MOVE 1 TO REC-CT. SQ1034.2 +058800 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1034.2 +058900 MOVE "WRITE 500 RECORDS" TO FEATURE. SQ1034.2 +059000 SEQ-TEST-GF-02-LOOP. SQ1034.2 +059100 ADD 1 TO XRECORD-NUMBER (1). SQ1034.2 +059200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS2R1-F-G-120. SQ1034.2 +059300 WRITE SQ-FS2R1-F-G-120. SQ1034.2 +059400 IF SQ-FS2-STATUS NOT = "00" SQ1034.2 +059500 MOVE SQ-FS2-STATUS TO SQ-FS2-STATUS-COPY. SQ1034.2 +059600 IF XRECORD-NUMBER (1) LESS THAN 500 SQ1034.2 +059700 GO TO SEQ-TEST-GF-02-LOOP. SQ1034.2 +059800* SQ1034.2 +059900 IF DECL-EXEC-COUNT = ZERO SQ1034.2 +060000 PERFORM PASS SQ1034.2 +060100 ELSE SQ1034.2 +060200 MOVE DECL-EXEC-COUNT TO COMPUTED-18V0 SQ1034.2 +060300 MOVE 1 TO CORRECT-18V0 SQ1034.2 +060400 MOVE "DECLARATIVE ENTERED AT LEAST ONCE" TO RE-MARK SQ1034.2 +060500 PERFORM FAIL. SQ1034.2 +060600 ADD 1 TO REC-CT. SQ1034.2 +060700 IF SQ-FS2-STATUS-COPY EQUAL TO "00" SQ1034.2 +060800 PERFORM PASS SQ1034.2 +060900 ELSE SQ1034.2 +061000 MOVE SQ-FS2-STATUS-COPY TO COMPUTED-A SQ1034.2 +061100 MOVE "00" TO CORRECT-A SQ1034.2 +061200 MOVE "AT LEAST ONE UNSUCCESSFUL WRITE" TO RE-MARK SQ1034.2 +061300 PERFORM FAIL. SQ1034.2 +061400 SEQ-TEST-02-END. SQ1034.2 +061500* SQ1034.2 +061600 SEQ-INIT-03. SQ1034.2 +061700 MOVE 1 TO REC-CT. SQ1034.2 +061800 MOVE "SEQ-TEST-GF-03" TO PAR-NAME. SQ1034.2 +061900 MOVE "CLOSE FILE FROM OUTPUT" TO FEATURE. SQ1034.2 +062000 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +062100 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +062200 GO TO SEQ-TEST-GF-03. SQ1034.2 +062300 SEQ-DELETE-03. SQ1034.2 +062400 PERFORM DE-LETE. SQ1034.2 +062500 ADD 1 TO REC-CT. SQ1034.2 +062600 PERFORM DE-LETE. SQ1034.2 +062700 GO TO SEQ-TEST-03-END. SQ1034.2 +062800 SEQ-TEST-GF-03. SQ1034.2 +062900 CLOSE SQ-FS2. SQ1034.2 +063000 IF DECL-EXEC-SW = 1 SQ1034.2 +063100 PERFORM PASS SQ1034.2 +063200 ELSE SQ1034.2 +063300 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +063400 MOVE 1 TO CORRECT-18V0 SQ1034.2 +063500 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE ON CLOSE" SQ1034.2 +063600 TO RE-MARK SQ1034.2 +063700 PERFORM FAIL. SQ1034.2 +063800 ADD 1 TO REC-CT. SQ1034.2 +063900 IF SQ-FS2-STATUS = "00" SQ1034.2 +064000 PERFORM PASS SQ1034.2 +064100 ELSE SQ1034.2 +064200 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +064300 MOVE "00" TO CORRECT-A SQ1034.2 +064400 MOVE "I-O STATUS AFTER CLOSE INDICATES FAILURE" SQ1034.2 +064500 TO RE-MARK SQ1034.2 +064600 PERFORM FAIL. SQ1034.2 +064700 SEQ-TEST-03-END. SQ1034.2 +064800* SQ1034.2 +064900* A SEQUENTIAL TAPE FILE HAS BEEN CREATED. IT CONTAINS 500 SQ1034.2 +065000* FIXED-LENGTH RECORDS, EACH 120 CHARACTERS LONG. THE NEXT SQ1034.2 +065100* GROUP OF TESTS READS THIS FILE, COUNTING THE RECORDS AND SQ1034.2 +065200* CHECKING THEIR CONTENT. SQ1034.2 +065300* SQ1034.2 +065400 SEQ-INIT-04. SQ1034.2 +065500 MOVE 1 TO REC-CT. SQ1034.2 +065600 MOVE "SEQ-TEST-GF-04" TO PAR-NAME. SQ1034.2 +065700 MOVE "OPEN NEWLY-WRITTEN FILE" TO FEATURE. SQ1034.2 +065800 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +065900 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +066000 GO TO SEQ-TEST-GF-04. SQ1034.2 +066100 SEQ-DELETE-04. SQ1034.2 +066200 PERFORM DE-LETE. SQ1034.2 +066300 ADD 1 TO REC-CT. SQ1034.2 +066400 PERFORM DE-LETE. SQ1034.2 +066500 GO TO SEQ-TEST-04-END. SQ1034.2 +066600 SEQ-TEST-GF-04. SQ1034.2 +066700 OPEN INPUT SQ-FS2. SQ1034.2 +066800 IF SQ-FS2-STATUS = "00" SQ1034.2 +066900 PERFORM PASS SQ1034.2 +067000 ELSE SQ1034.2 +067100 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +067200 MOVE "00" TO CORRECT-A SQ1034.2 +067300 MOVE "I-O STATUS INDICATES ABNORMAL OPEN" TO RE-MARK SQ1034.2 +067400 PERFORM FAIL. SQ1034.2 +067500 ADD 1 TO REC-CT. SQ1034.2 +067600 IF DECL-EXEC-SW = 1 SQ1034.2 +067700 PERFORM PASS SQ1034.2 +067800 ELSE SQ1034.2 +067900 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +068000 MOVE 1 TO CORRECT-18V0 SQ1034.2 +068100 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE" TO RE-MARK SQ1034.2 +068200 PERFORM FAIL. SQ1034.2 +068300 SEQ-TEST-04-END. SQ1034.2 +068400* SQ1034.2 +068500 SEQ-INIT-05. SQ1034.2 +068600 MOVE 1 TO REC-CT. SQ1034.2 +068700 MOVE ZERO TO XRECORD-NUMBER (1). SQ1034.2 +068800 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +068900 MOVE ZERO TO EOF-FLAG. SQ1034.2 +069000 MOVE ZERO TO RECORDS-IN-ERROR. SQ1034.2 +069100 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +069200 MOVE "00" TO SQ-FS2-STATUS-COPY. SQ1034.2 +069300 MOVE "READ 500 RECORD FILE" TO FEATURE. SQ1034.2 +069400 MOVE "SEQ-TEST-GF-05" TO PAR-NAME. SQ1034.2 +069500 GO TO SEQ-TEST-GF-05. SQ1034.2 +069600 SEQ-DELETE-05. SQ1034.2 +069700 PERFORM DE-LETE. SQ1034.2 +069800 ADD 1 TO REC-CT. SQ1034.2 +069900 PERFORM DE-LETE. SQ1034.2 +070000 ADD 1 TO REC-CT. SQ1034.2 +070100 PERFORM DE-LETE. SQ1034.2 +070200 ADD 1 TO REC-CT. SQ1034.2 +070300 PERFORM DE-LETE. SQ1034.2 +070400 ADD 1 TO REC-CT. SQ1034.2 +070500 PERFORM DE-LETE. SQ1034.2 +070600 ADD 1 TO REC-CT. SQ1034.2 +070700 PERFORM DE-LETE. SQ1034.2 +070800 GO TO SEQ-TEST-05-END. SQ1034.2 +070900 SEQ-TEST-GF-05. SQ1034.2 +071000 SEQ-TEST-GF-05-LOOP. SQ1034.2 +071100 READ SQ-FS2 RECORD END SQ1034.2 +071200 MOVE 1 TO EOF-FLAG SQ1034.2 +071300 GO TO SEQ-TEST-GF-05-02. SQ1034.2 +071400 IF SQ-FS2-STATUS = "10" SQ1034.2 +071500 GO TO SEQ-TEST-GF-05-02. SQ1034.2 +071600 IF SQ-FS2-STATUS NOT = "00" SQ1034.2 +071700 MOVE SQ-FS2-STATUS TO SQ-FS2-STATUS-COPY. SQ1034.2 +071800 ADD 1 TO XRECORD-NUMBER (1). SQ1034.2 +071900 IF SQ-FS2R1-F-G-120 NOT EQUAL FILE-RECORD-INFO-P1-120 (1) SQ1034.2 +072000 ADD 1 TO RECORDS-IN-ERROR. SQ1034.2 +072100 IF XRECORD-NUMBER (1) LESS THAN OR EQUAL TO 500 SQ1034.2 +072200 GO TO SEQ-TEST-GF-05-LOOP. SQ1034.2 +072300* SQ1034.2 +072400 SEQ-TEST-GF-05-02. SQ1034.2 +072500 IF XRECORD-NUMBER (1) = 500 SQ1034.2 +072600 PERFORM PASS SQ1034.2 +072700 ELSE SQ1034.2 +072800 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 SQ1034.2 +072900 MOVE 500 TO CORRECT-18V0 SQ1034.2 +073000 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1034.2 +073100 TO RE-MARK SQ1034.2 +073200 PERFORM FAIL. SQ1034.2 +073300 ADD 1 TO REC-CT. SQ1034.2 +073400 IF DECL-EXEC-COUNT = ZERO SQ1034.2 +073500 PERFORM PASS SQ1034.2 +073600 ELSE SQ1034.2 +073700 MOVE DECL-EXEC-COUNT TO COMPUTED-18V0 SQ1034.2 +073800 MOVE 1 TO CORRECT-18V0 SQ1034.2 +073900 MOVE "DECLARATIVE ENTERED AT LEAST ONCE" TO RE-MARK SQ1034.2 +074000 PERFORM FAIL. SQ1034.2 +074100 ADD 1 TO REC-CT. SQ1034.2 +074200 IF SQ-FS2-STATUS-COPY EQUAL TO "00" SQ1034.2 +074300 PERFORM PASS SQ1034.2 +074400 ELSE SQ1034.2 +074500 MOVE SQ-FS2-STATUS-COPY TO COMPUTED-A SQ1034.2 +074600 MOVE "00" TO CORRECT-A SQ1034.2 +074700 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1034.2 +074800 PERFORM FAIL. SQ1034.2 +074900 ADD 1 TO REC-CT. SQ1034.2 +075000 IF EOF-FLAG = 1 SQ1034.2 +075100 PERFORM PASS SQ1034.2 +075200 ELSE SQ1034.2 +075300 MOVE EOF-FLAG TO COMPUTED-18V0 SQ1034.2 +075400 MOVE 1 TO CORRECT-18V0 SQ1034.2 +075500 MOVE "AT END STATEMENT NOT EXECUTED" TO RE-MARK SQ1034.2 +075600 MOVE "VII-46, 4.4.4(10)C" TO ANSI-REFERENCE SQ1034.2 +075700 PERFORM FAIL. SQ1034.2 +075800 ADD 1 TO REC-CT. SQ1034.2 +075900 IF SQ-FS2-STATUS EQUAL TO "10" SQ1034.2 +076000 PERFORM PASS SQ1034.2 +076100 ELSE SQ1034.2 +076200 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +076300 MOVE "10" TO CORRECT-A SQ1034.2 +076400 MOVE "UNEXPECTED I-O STATUS FROM FINAL READ" SQ1034.2 +076500 TO RE-MARK SQ1034.2 +076600 MOVE "VII-46, 4.4.4(10)A, VII-3" TO ANSI-REFERENCE SQ1034.2 +076700 PERFORM FAIL. SQ1034.2 +076800 ADD 1 TO REC-CT. SQ1034.2 +076900 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1034.2 +077000 PERFORM PASS SQ1034.2 +077100 ELSE SQ1034.2 +077200 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1034.2 +077300 MOVE ZERO TO CORRECT-18V0 SQ1034.2 +077400 MOVE "INCORRECT RECORD CONTENTS FOUND" TO RE-MARK SQ1034.2 +077500 PERFORM FAIL. SQ1034.2 +077600 SEQ-TEST-05-END. SQ1034.2 +077700* SQ1034.2 +077800 SEQ-INIT-06. SQ1034.2 +077900 MOVE "SEQ-TEST-GF-06" TO PAR-NAME. SQ1034.2 +078000 MOVE "CLOSE FILE FROM INPUT" TO FEATURE. SQ1034.2 +078100 MOVE 1 TO REC-CT. SQ1034.2 +078200 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +078300 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +078400 GO TO SEQ-TEST-GF-06. SQ1034.2 +078500 SEQ-DELETE-06. SQ1034.2 +078600 PERFORM DE-LETE. SQ1034.2 +078700 ADD 1 TO REC-CT. SQ1034.2 +078800 PERFORM DE-LETE. SQ1034.2 +078900 GO TO SEQ-TEST-06-END. SQ1034.2 +079000 SEQ-TEST-GF-06. SQ1034.2 +079100 CLOSE SQ-FS2. SQ1034.2 +079200 IF DECL-EXEC-SW = 1 SQ1034.2 +079300 PERFORM PASS SQ1034.2 +079400 ELSE SQ1034.2 +079500 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +079600 MOVE 1 TO CORRECT-18V0 SQ1034.2 +079700 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE ON CLOSE" SQ1034.2 +079800 TO RE-MARK SQ1034.2 +079900 PERFORM FAIL. SQ1034.2 +080000 ADD 1 TO REC-CT. SQ1034.2 +080100 IF SQ-FS2-STATUS = "00" SQ1034.2 +080200 PERFORM PASS SQ1034.2 +080300 ELSE SQ1034.2 +080400 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +080500 MOVE "00" TO CORRECT-A SQ1034.2 +080600 MOVE "I-O STATUS AFTER CLOSE INDICATES FAILURE" SQ1034.2 +080700 TO RE-MARK SQ1034.2 +080800 PERFORM FAIL. SQ1034.2 +080900 SEQ-TEST-06-END. SQ1034.2 +081000* SQ1034.2 +081100* SQ1034.2 +081200* TWO OPTIONS FOR THE READ STATEMENT ARE CHECKED IN THIS SQ1034.2 +081300* SERIES OF TESTS, THE ABSENCE OF ALL OPTIONAL PHRASES, AND SQ1034.2 +081400* THE ABSENCE OF ALL EXCEPT THE OPTIONAL WORD "RECORD". SQ1034.2 +081500* SQ1034.2 +081600 SEQ-INIT-07. SQ1034.2 +081700 MOVE 1 TO REC-CT. SQ1034.2 +081800 MOVE "SEQ-TEST-GF-07" TO PAR-NAME. SQ1034.2 +081900 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ1034.2 +082000 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +082100 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +082200 GO TO SEQ-TEST-GF-07. SQ1034.2 +082300 SEQ-DELETE-07. SQ1034.2 +082400 PERFORM DE-LETE. SQ1034.2 +082500 ADD 1 TO REC-CT. SQ1034.2 +082600 PERFORM DE-LETE. SQ1034.2 +082700 GO TO SEQ-TEST-07-END. SQ1034.2 +082800 SEQ-TEST-GF-07. SQ1034.2 +082900 OPEN INPUT SQ-FS2. SQ1034.2 +083000 IF SQ-FS2-STATUS = "00" SQ1034.2 +083100 PERFORM PASS SQ1034.2 +083200 ELSE SQ1034.2 +083300 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +083400 MOVE "00" TO CORRECT-A SQ1034.2 +083500 MOVE "I-O STATUS INDICATES ABNORMAL OPEN" TO RE-MARK SQ1034.2 +083600 PERFORM FAIL. SQ1034.2 +083700 ADD 1 TO REC-CT. SQ1034.2 +083800 IF DECL-EXEC-SW = 1 SQ1034.2 +083900 PERFORM PASS SQ1034.2 +084000 ELSE SQ1034.2 +084100 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +084200 MOVE 1 TO CORRECT-18V0 SQ1034.2 +084300 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE" TO RE-MARK SQ1034.2 +084400 PERFORM FAIL. SQ1034.2 +084500 SEQ-TEST-07-END. SQ1034.2 +084600* SQ1034.2 +084700 SEQ-INIT-08. SQ1034.2 +084800 MOVE 1 TO REC-CT. SQ1034.2 +084900 MOVE ZERO TO RECORDS-IN-ERROR. SQ1034.2 +085000 MOVE ZERO TO XRECORD-NUMBER (1). SQ1034.2 +085100 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +085200 MOVE ZERO TO EOF-FLAG. SQ1034.2 +085300 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +085400 MOVE "00" TO SQ-FS2-STATUS-COPY. SQ1034.2 +085500 MOVE "READ ... RECORD" TO FEATURE. SQ1034.2 +085600 MOVE "SEQ-TEST-GF-08" TO PAR-NAME. SQ1034.2 +085700 GO TO SEQ-TEST-GF-08. SQ1034.2 +085800 SEQ-DELETE-08. SQ1034.2 +085900 PERFORM DE-LETE. SQ1034.2 +086000 ADD 1 TO REC-CT. SQ1034.2 +086100 PERFORM DE-LETE. SQ1034.2 +086200 ADD 1 TO REC-CT. SQ1034.2 +086300 PERFORM DE-LETE. SQ1034.2 +086400 ADD 1 TO REC-CT. SQ1034.2 +086500 PERFORM DE-LETE. SQ1034.2 +086600 GO TO SEQ-TEST-08-END. SQ1034.2 +086700 SEQ-TEST-GF-08. SQ1034.2 +086800 SEQ-TEST-GF-08-LOOP. SQ1034.2 +086900 READ SQ-FS2 RECORD. SQ1034.2 +087000 IF SQ-FS2-STATUS = "10" SQ1034.2 +087100 MOVE 1 TO EOF-FLAG SQ1034.2 +087200 GO TO SEQ-TEST-GF-08-02. SQ1034.2 +087300 IF SQ-FS2-STATUS NOT = "00" SQ1034.2 +087400 MOVE SQ-FS2-STATUS TO SQ-FS2-STATUS-COPY. SQ1034.2 +087500 ADD 1 TO XRECORD-NUMBER (1). SQ1034.2 +087600 IF SQ-FS2R1-F-G-120 NOT EQUAL FILE-RECORD-INFO-P1-120 (1) SQ1034.2 +087700 ADD 1 TO RECORDS-IN-ERROR. SQ1034.2 +087800 IF XRECORD-NUMBER (1) LESS THAN 100 SQ1034.2 +087900 GO TO SEQ-TEST-GF-08-LOOP. SQ1034.2 +088000* SQ1034.2 +088100 SEQ-TEST-GF-08-02. SQ1034.2 +088200 IF XRECORD-NUMBER (1) = 100 SQ1034.2 +088300 PERFORM PASS SQ1034.2 +088400 ELSE SQ1034.2 +088500 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 SQ1034.2 +088600 MOVE 100 TO CORRECT-18V0 SQ1034.2 +088700 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1034.2 +088800 TO RE-MARK SQ1034.2 +088900 PERFORM FAIL. SQ1034.2 +089000 ADD 1 TO REC-CT. SQ1034.2 +089100 IF DECL-EXEC-COUNT = ZERO SQ1034.2 +089200 PERFORM PASS SQ1034.2 +089300 ELSE SQ1034.2 +089400 MOVE DECL-EXEC-COUNT TO COMPUTED-18V0 SQ1034.2 +089500 MOVE 1 TO CORRECT-18V0 SQ1034.2 +089600 MOVE "DECLARATIVE ENTERED AT LEAST ONCE" TO RE-MARK SQ1034.2 +089700 PERFORM FAIL. SQ1034.2 +089800 ADD 1 TO REC-CT. SQ1034.2 +089900 IF SQ-FS2-STATUS-COPY EQUAL TO "00" SQ1034.2 +090000 PERFORM PASS SQ1034.2 +090100 ELSE SQ1034.2 +090200 MOVE SQ-FS2-STATUS-COPY TO COMPUTED-A SQ1034.2 +090300 MOVE "00" TO CORRECT-A SQ1034.2 +090400 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1034.2 +090500 PERFORM FAIL. SQ1034.2 +090600 ADD 1 TO REC-CT. SQ1034.2 +090700 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1034.2 +090800 PERFORM PASS SQ1034.2 +090900 ELSE SQ1034.2 +091000 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1034.2 +091100 MOVE ZERO TO CORRECT-18V0 SQ1034.2 +091200 MOVE "INCORRECT RECORD CONTENTS FOUND" TO RE-MARK SQ1034.2 +091300 PERFORM FAIL. SQ1034.2 +091400 SEQ-TEST-08-END. SQ1034.2 +091500* SQ1034.2 +091600 SEQ-INIT-09. SQ1034.2 +091700 MOVE 1 TO REC-CT. SQ1034.2 +091800 MOVE ZERO TO DECL-EXEC-COUNT. SQ1034.2 +091900 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +092000 MOVE "00" TO SQ-FS2-STATUS-COPY. SQ1034.2 +092100 MOVE "READ ..." TO FEATURE. SQ1034.2 +092200 MOVE "SEQ-TEST-GF-09" TO PAR-NAME. SQ1034.2 +092300 GO TO SEQ-TEST-GF-09. SQ1034.2 +092400 SEQ-DELETE-09. SQ1034.2 +092500 PERFORM DE-LETE. SQ1034.2 +092600 ADD 1 TO REC-CT. SQ1034.2 +092700 PERFORM DE-LETE. SQ1034.2 +092800 ADD 1 TO REC-CT. SQ1034.2 +092900 PERFORM DE-LETE. SQ1034.2 +093000 ADD 1 TO REC-CT. SQ1034.2 +093100 PERFORM DE-LETE. SQ1034.2 +093200 GO TO SEQ-TEST-09-END. SQ1034.2 +093300 SEQ-TEST-GF-09. SQ1034.2 +093400 IF EOF-FLAG = 1 SQ1034.2 +093500 GO TO SEQ-TEST-GF-09-02. SQ1034.2 +093600 SEQ-TEST-GF-09-LOOP. SQ1034.2 +093700 READ SQ-FS2. SQ1034.2 +093800 IF SQ-FS2-STATUS = "10" SQ1034.2 +093900 MOVE 1 TO EOF-FLAG SQ1034.2 +094000 GO TO SEQ-TEST-GF-09-02. SQ1034.2 +094100 IF SQ-FS2-STATUS NOT = "00" SQ1034.2 +094200 MOVE SQ-FS2-STATUS TO SQ-FS2-STATUS-COPY. SQ1034.2 +094300 ADD 1 TO XRECORD-NUMBER (1). SQ1034.2 +094400 IF SQ-FS2R1-F-G-120 NOT EQUAL FILE-RECORD-INFO-P1-120 (1) SQ1034.2 +094500 ADD 1 TO RECORDS-IN-ERROR. SQ1034.2 +094600 IF XRECORD-NUMBER (1) LESS THAN OR EQUAL TO 499 SQ1034.2 +094700 GO TO SEQ-TEST-GF-09-LOOP. SQ1034.2 +094800* SQ1034.2 +094900 SEQ-TEST-GF-09-02. SQ1034.2 +095000 IF XRECORD-NUMBER (1) = 500 SQ1034.2 +095100 PERFORM PASS SQ1034.2 +095200 ELSE SQ1034.2 +095300 MOVE XRECORD-NUMBER (1) TO COMPUTED-18V0 SQ1034.2 +095400 MOVE 500 TO CORRECT-18V0 SQ1034.2 +095500 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1034.2 +095600 TO RE-MARK SQ1034.2 +095700 PERFORM FAIL. SQ1034.2 +095800 ADD 1 TO REC-CT. SQ1034.2 +095900 IF DECL-EXEC-COUNT = ZERO SQ1034.2 +096000 PERFORM PASS SQ1034.2 +096100 ELSE SQ1034.2 +096200 MOVE DECL-EXEC-COUNT TO COMPUTED-18V0 SQ1034.2 +096300 MOVE 1 TO CORRECT-18V0 SQ1034.2 +096400 MOVE "DECLARATIVE ENTERED AT LEAST ONCE" TO RE-MARK SQ1034.2 +096500 PERFORM FAIL. SQ1034.2 +096600 ADD 1 TO REC-CT. SQ1034.2 +096700 IF SQ-FS2-STATUS-COPY EQUAL TO "00" SQ1034.2 +096800 PERFORM PASS SQ1034.2 +096900 ELSE SQ1034.2 +097000 MOVE SQ-FS2-STATUS-COPY TO COMPUTED-A SQ1034.2 +097100 MOVE "00" TO CORRECT-A SQ1034.2 +097200 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1034.2 +097300 PERFORM FAIL. SQ1034.2 +097400 ADD 1 TO REC-CT. SQ1034.2 +097500 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1034.2 +097600 PERFORM PASS SQ1034.2 +097700 ELSE SQ1034.2 +097800 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1034.2 +097900 MOVE ZERO TO CORRECT-18V0 SQ1034.2 +098000 MOVE "INCORRECT RECORD CONTENTS FOUND" TO RE-MARK SQ1034.2 +098100 PERFORM FAIL. SQ1034.2 +098200 SEQ-TEST-09-END. SQ1034.2 +098300* SQ1034.2 +098400 SEQ-INIT-10. SQ1034.2 +098500 MOVE 1 TO REC-CT. SQ1034.2 +098600 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +098700 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +098800 MOVE "SEQ-TEST-GF-10" TO PAR-NAME. SQ1034.2 +098900 MOVE "READ ... RAISING AT END" TO FEATURE. SQ1034.2 +099000 IF EOF-FLAG NOT EQUAL TO ZERO SQ1034.2 +099100 GO TO SEQ-DELETE-10. SQ1034.2 +099200 GO TO SEQ-TEST-GF-10. SQ1034.2 +099300 SEQ-DELETE-10. SQ1034.2 +099400 PERFORM DE-LETE. SQ1034.2 +099500 ADD 1 TO REC-CT. SQ1034.2 +099600 PERFORM DE-LETE. SQ1034.2 +099700 GO TO SEQ-TEST-10-END. SQ1034.2 +099800 SEQ-TEST-GF-10. SQ1034.2 +099900 READ SQ-FS2. SQ1034.2 +100000 IF DECL-EXEC-SW = 0 SQ1034.2 +100100 PERFORM PASS SQ1034.2 +100200 ELSE SQ1034.2 +100300 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +100400 MOVE ZERO TO CORRECT-18V0 SQ1034.2 +100500 MOVE "DECLARATIVE NOT EXECUTED" TO RE-MARK SQ1034.2 +100600 MOVE "VII-46, 4.4.4(10)C" TO ANSI-REFERENCE SQ1034.2 +100700 PERFORM FAIL. SQ1034.2 +100800 ADD 1 TO REC-CT. SQ1034.2 +100900 IF SQ-FS2-STATUS = "10" SQ1034.2 +101000 PERFORM PASS SQ1034.2 +101100 ELSE SQ1034.2 +101200 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +101300 MOVE "10" TO CORRECT-A SQ1034.2 +101400 MOVE "I-O STATUS FOR END OF FILE EXPECTED" TO RE-MARK SQ1034.2 +101500 PERFORM FAIL. SQ1034.2 +101600 SEQ-TEST-10-END. SQ1034.2 +101700* SQ1034.2 +101800 SEQ-INIT-11. SQ1034.2 +101900 MOVE "SEQ-TEST-GF-11" TO PAR-NAME. SQ1034.2 +102000 MOVE "CLOSE FILE FROM INPUT" TO FEATURE. SQ1034.2 +102100 MOVE 1 TO REC-CT. SQ1034.2 +102200 MOVE 1 TO DECL-EXEC-SW. SQ1034.2 +102300 MOVE "**" TO SQ-FS2-STATUS. SQ1034.2 +102400 GO TO SEQ-TEST-GF-11. SQ1034.2 +102500 SEQ-DELETE-11. SQ1034.2 +102600 PERFORM DE-LETE. SQ1034.2 +102700 ADD 1 TO REC-CT. SQ1034.2 +102800 PERFORM DE-LETE. SQ1034.2 +102900 GO TO SEQ-TEST-11-END. SQ1034.2 +103000 SEQ-TEST-GF-11. SQ1034.2 +103100 CLOSE SQ-FS2. SQ1034.2 +103200 IF DECL-EXEC-SW = 1 SQ1034.2 +103300 PERFORM PASS SQ1034.2 +103400 ELSE SQ1034.2 +103500 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1034.2 +103600 MOVE 1 TO CORRECT-18V0 SQ1034.2 +103700 MOVE "UNEXPECTED EXECUTION OF DECLARATIVE ON CLOSE" SQ1034.2 +103800 TO RE-MARK SQ1034.2 +103900 PERFORM FAIL. SQ1034.2 +104000 ADD 1 TO REC-CT. SQ1034.2 +104100 IF SQ-FS2-STATUS = "00" SQ1034.2 +104200 PERFORM PASS SQ1034.2 +104300 ELSE SQ1034.2 +104400 MOVE SQ-FS2-STATUS TO COMPUTED-A SQ1034.2 +104500 MOVE "00" TO CORRECT-A SQ1034.2 +104600 MOVE "I-O STATUS AFTER CLOSE INDICATES FAILURE" SQ1034.2 +104700 TO RE-MARK SQ1034.2 +104800 PERFORM FAIL. SQ1034.2 +104900 SEQ-TEST-11-END. SQ1034.2 +105000* SQ1034.2 +105100 TERMINATE-ROUTINE. SQ1034.2 +105200 EXIT. SQ1034.2 +105300 CCVS-EXIT SECTION. SQ1034.2 +105400 CCVS-999999. SQ1034.2 +105500 GO TO CLOSE-FILES. SQ1034.2 diff --git a/tests/cobol85/SQ/SQ104A.CBL b/tests/cobol85/SQ/SQ104A.CBL new file mode 100755 index 00000000..3a2f41a2 --- /dev/null +++ b/tests/cobol85/SQ/SQ104A.CBL @@ -0,0 +1,845 @@ +000100 IDENTIFICATION DIVISION. SQ1044.2 +000200 PROGRAM-ID. SQ1044.2 +000300 SQ104A. SQ1044.2 +000400**************************************************************** SQ1044.2 +000500* * SQ1044.2 +000600* VALIDATION FOR:- * SQ1044.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1044.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1044.2 +000900* REVISED 1986, AUGUST * SQ1044.2 +001000* * SQ1044.2 +001100* CREATION DATE / VALIDATION DATE * SQ1044.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1044.2 +001300* * SQ1044.2 +001400**************************************************************** SQ1044.2 +001500* * SQ1044.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1044.2 +001700* * SQ1044.2 +001800* X-14 SEQUENTIAL MASS STORAGE * SQ1044.2 +001900* X-55 SYSTEM PRINTER * SQ1044.2 +002000* X-82 SOURCE-COMPUTER * SQ1044.2 +002100* X-83 OBJECT-COMPUTER. * SQ1044.2 +002200* * SQ1044.2 +002300**************************************************************** SQ1044.2 +002400* * SQ1044.2 +002500* SQ104A CREATES A SEQUENTIAL MASS STORAGE FILE CONTAINING * SQ1044.2 +002600* 649 FIXED LENGTH RECORDS, EACH 120 CHARACTERS LONG. THE * SQ1044.2 +002700* FILE READ IS TWICE. THE FIRST PASS CHECKS THAT ALL THE * SQ1044.2 +002800* EXPECTED RECORDS ARE PRESENT. THE SECOND PASS PERFORMS * SQ1044.2 +002900* SIMILAR CHECKS, BUT USES ALL FOUR VARIANTS OF THE READ * SQ1044.2 +003000* STATEMENT WITH THE END PHRASE THAT CAN BE PRODUCED BY * SQ1044.2 +003100* INCLUDING OR OMITTING THE OPTIONAL WORDS "RECORD" AND * SQ1044.2 +003200* "AT". * SQ1044.2 +003300* * SQ1044.2 +003400* THE PROGRAM OMITS THE OPTIONAL WORDS "ORGANIZATION IS" * SQ1044.2 +003500* FROM THE "ORGANIZATION IS SEQUENTIAL" CLAUSE OF THE * SQ1044.2 +003600* FILE-CONTROL ENTRY, AND PLACES THE ASSIGN CLAUSE IN A * SQ1044.2 +003700* POSITION OTHER THAN FIRST IN THE SAME ENTRY. * SQ1044.2 +003800* * SQ1044.2 +003900**************************************************************** SQ1044.2 +004000* SQ1044.2 +004100* SQ1044.2 +004200 ENVIRONMENT DIVISION. SQ1044.2 +004300 CONFIGURATION SECTION. SQ1044.2 +004400 SOURCE-COMPUTER. SQ1044.2 +004500 Linux. SQ1044.2 +004600 OBJECT-COMPUTER. SQ1044.2 +004700 Linux. SQ1044.2 +004800* SQ1044.2 +004900 INPUT-OUTPUT SECTION. SQ1044.2 +005000 FILE-CONTROL. SQ1044.2 +005100 SELECT PRINT-FILE ASSIGN TO SQ1044.2 +005200 "report.log". SQ1044.2 +005300* SQ1044.2 +005400*P SELECT RAW-DATA ASSIGN TO SQ1044.2 +005500*P "XXXXX062" SQ1044.2 +005600*P ORGANIZATION IS INDEXED SQ1044.2 +005700*P ACCESS MODE IS RANDOM SQ1044.2 +005800*P RECORD-KEY IS RAW-DATA-KEY. SQ1044.2 +005900*P SQ1044.2 +006000 SELECT SQ-FS3 SQ1044.2 +006100 ACCESS MODE SEQUENTIAL SQ1044.2 +006200 ASSIGN TO SQ1044.2 +006300 "XXXXX014" SQ1044.2 +006400 ORGANIZATION IS SEQUENTIAL SQ1044.2 +006500 . SQ1044.2 +006600* SQ1044.2 +006700* SQ1044.2 +006800 DATA DIVISION. SQ1044.2 +006900 FILE SECTION. SQ1044.2 +007000*P SQ1044.2 +007100*PD RAW-DATA. SQ1044.2 +007200*P1 RAW-DATA-SATZ. SQ1044.2 +007300*P 05 RAW-DATA-KEY PIC X(6). SQ1044.2 +007400*P 05 C-DATE PIC 9(6). SQ1044.2 +007500*P 05 C-TIME PIC 9(8). SQ1044.2 +007600*P 05 NO-OF-TESTS PIC 99. SQ1044.2 +007700*P 05 C-OK PIC 999. SQ1044.2 +007800*P 05 C-ALL PIC 999. SQ1044.2 +007900*P 05 C-FAIL PIC 999. SQ1044.2 +008000*P 05 C-DELETED PIC 999. SQ1044.2 +008100*P 05 C-INSPECT PIC 999. SQ1044.2 +008200*P 05 C-NOTE PIC X(13). SQ1044.2 +008300*P 05 C-INDENT PIC X. SQ1044.2 +008400*P 05 C-ABORT PIC X(8). SQ1044.2 +008500* SQ1044.2 +008600 FD SQ-FS3 SQ1044.2 +008700*C LABEL RECORD IS STANDARD SQ1044.2 +008800*C DATA RECORD SQ-FS3R1-F-G-120 SQ1044.2 +008900 BLOCK CONTAINS 120 CHARACTERS SQ1044.2 +009000 RECORD CONTAINS 120 CHARACTERS. SQ1044.2 +009100 01 SQ-FS3R1-F-G-120 PIC X(120). SQ1044.2 +009200* SQ1044.2 +009300 FD PRINT-FILE SQ1044.2 +009400*C LABEL RECORDS SQ1044.2 +009500*C OMITTED SQ1044.2 +009600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1044.2 +009700 . SQ1044.2 +009800 01 PRINT-REC PICTURE X(120). SQ1044.2 +009900 01 DUMMY-RECORD PICTURE X(120). SQ1044.2 +010000* SQ1044.2 +010100 WORKING-STORAGE SECTION. SQ1044.2 +010200* SQ1044.2 +010300*************************************************************** SQ1044.2 +010400* * SQ1044.2 +010500* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1044.2 +010600* * SQ1044.2 +010700*************************************************************** SQ1044.2 +010800* SQ1044.2 +010900 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1044.2 +011000 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1044.2 +011100 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1044.2 +011200* SQ1044.2 +011300*************************************************************** SQ1044.2 +011400* * SQ1044.2 +011500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1044.2 +011600* * SQ1044.2 +011700*************************************************************** SQ1044.2 +011800* SQ1044.2 +011900 01 REC-SKEL-SUB PIC 99. SQ1044.2 +012000* SQ1044.2 +012100 01 FILE-RECORD-INFORMATION-REC. SQ1044.2 +012200 03 FILE-RECORD-INFO-SKELETON. SQ1044.2 +012300 05 FILLER PICTURE X(48) VALUE SQ1044.2 +012400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1044.2 +012500 05 FILLER PICTURE X(46) VALUE SQ1044.2 +012600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1044.2 +012700 05 FILLER PICTURE X(26) VALUE SQ1044.2 +012800 ",LFIL=000000,ORG= ,LBLR= ". SQ1044.2 +012900 05 FILLER PICTURE X(37) VALUE SQ1044.2 +013000 ",RECKEY= ". SQ1044.2 +013100 05 FILLER PICTURE X(38) VALUE SQ1044.2 +013200 ",ALTKEY1= ". SQ1044.2 +013300 05 FILLER PICTURE X(38) VALUE SQ1044.2 +013400 ",ALTKEY2= ". SQ1044.2 +013500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1044.2 +013600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1044.2 +013700 05 FILE-RECORD-INFO-P1-120. SQ1044.2 +013800 07 FILLER PIC X(5). SQ1044.2 +013900 07 XFILE-NAME PIC X(6). SQ1044.2 +014000 07 FILLER PIC X(8). SQ1044.2 +014100 07 XRECORD-NAME PIC X(6). SQ1044.2 +014200 07 FILLER PIC X(1). SQ1044.2 +014300 07 REELUNIT-NUMBER PIC 9(1). SQ1044.2 +014400 07 FILLER PIC X(7). SQ1044.2 +014500 07 XRECORD-NUMBER PIC 9(6). SQ1044.2 +014600 07 FILLER PIC X(6). SQ1044.2 +014700 07 UPDATE-NUMBER PIC 9(2). SQ1044.2 +014800 07 FILLER PIC X(5). SQ1044.2 +014900 07 ODO-NUMBER PIC 9(4). SQ1044.2 +015000 07 FILLER PIC X(5). SQ1044.2 +015100 07 XPROGRAM-NAME PIC X(5). SQ1044.2 +015200 07 FILLER PIC X(7). SQ1044.2 +015300 07 XRECORD-LENGTH PIC 9(6). SQ1044.2 +015400 07 FILLER PIC X(7). SQ1044.2 +015500 07 CHARS-OR-RECORDS PIC X(2). SQ1044.2 +015600 07 FILLER PIC X(1). SQ1044.2 +015700 07 XBLOCK-SIZE PIC 9(4). SQ1044.2 +015800 07 FILLER PIC X(6). SQ1044.2 +015900 07 RECORDS-IN-FILE PIC 9(6). SQ1044.2 +016000 07 FILLER PIC X(5). SQ1044.2 +016100 07 XFILE-ORGANIZATION PIC X(2). SQ1044.2 +016200 07 FILLER PIC X(6). SQ1044.2 +016300 07 XLABEL-TYPE PIC X(1). SQ1044.2 +016400 05 FILE-RECORD-INFO-P121-240. SQ1044.2 +016500 07 FILLER PIC X(8). SQ1044.2 +016600 07 XRECORD-KEY PIC X(29). SQ1044.2 +016700 07 FILLER PIC X(9). SQ1044.2 +016800 07 ALTERNATE-KEY1 PIC X(29). SQ1044.2 +016900 07 FILLER PIC X(9). SQ1044.2 +017000 07 ALTERNATE-KEY2 PIC X(29). SQ1044.2 +017100 07 FILLER PIC X(7). SQ1044.2 +017200* SQ1044.2 +017300 01 TEST-RESULTS. SQ1044.2 +017400 02 FILLER PIC X VALUE SPACE. SQ1044.2 +017500 02 PAR-NAME. SQ1044.2 +017600 03 FILLER PIC X(14) VALUE SPACE. SQ1044.2 +017700 03 PARDOT-X PIC X VALUE SPACE. SQ1044.2 +017800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1044.2 +017900 02 FILLER PIC X VALUE SPACE. SQ1044.2 +018000 02 FEATURE PIC X(24) VALUE SPACE. SQ1044.2 +018100 02 FILLER PIC X VALUE SPACE. SQ1044.2 +018200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1044.2 +018300 02 FILLER PIC X(9) VALUE SPACE. SQ1044.2 +018400 02 RE-MARK PIC X(61). SQ1044.2 +018500 01 TEST-COMPUTED. SQ1044.2 +018600 02 FILLER PIC X(30) VALUE SPACE. SQ1044.2 +018700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1044.2 +018800 02 COMPUTED-X. SQ1044.2 +018900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1044.2 +019000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1044.2 +019100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1044.2 +019200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1044.2 +019300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1044.2 +019400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1044.2 +019500 04 COMPUTED-18V0 PIC -9(18). SQ1044.2 +019600 04 FILLER PIC X. SQ1044.2 +019700 03 FILLER PIC X(50) VALUE SPACE. SQ1044.2 +019800 01 TEST-CORRECT. SQ1044.2 +019900 02 FILLER PIC X(30) VALUE SPACE. SQ1044.2 +020000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1044.2 +020100 02 CORRECT-X. SQ1044.2 +020200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1044.2 +020300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1044.2 +020400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1044.2 +020500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1044.2 +020600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1044.2 +020700 03 CR-18V0 REDEFINES CORRECT-A. SQ1044.2 +020800 04 CORRECT-18V0 PIC -9(18). SQ1044.2 +020900 04 FILLER PIC X. SQ1044.2 +021000 03 FILLER PIC X(2) VALUE SPACE. SQ1044.2 +021100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1044.2 +021200 01 CCVS-C-1. SQ1044.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1044.2 +021400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1044.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1044.2 +021600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1044.2 +021700 02 FILLER PIC IS X VALUE SPACE. SQ1044.2 +021800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1044.2 +021900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1044.2 +022000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1044.2 +022100 01 CCVS-C-2. SQ1044.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1044.2 +022300 02 FILLER PIC X(6) VALUE "TESTED". SQ1044.2 +022400 02 FILLER PIC X(19) VALUE SPACE. SQ1044.2 +022500 02 FILLER PIC X(4) VALUE "FAIL". SQ1044.2 +022600 02 FILLER PIC X(72) VALUE SPACE. SQ1044.2 +022700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1044.2 +022800 01 REC-CT PIC 99 VALUE ZERO. SQ1044.2 +022900 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1044.2 +023000 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1044.2 +023100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1044.2 +023200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1044.2 +023300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1044.2 +023400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1044.2 +023500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1044.2 +023600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1044.2 +023700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1044.2 +023800 01 CCVS-H-1. SQ1044.2 +023900 02 FILLER PIC X(39) VALUE SPACES. SQ1044.2 +024000 02 FILLER PIC X(42) VALUE SQ1044.2 +024100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1044.2 +024200 02 FILLER PIC X(39) VALUE SPACES. SQ1044.2 +024300 01 CCVS-H-2A. SQ1044.2 +024400 02 FILLER PIC X(40) VALUE SPACE. SQ1044.2 +024500 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1044.2 +024600 02 FILLER PIC XXXX VALUE SQ1044.2 +024700 "4.2 ". SQ1044.2 +024800 02 FILLER PIC X(28) VALUE SQ1044.2 +024900 " COPY - NOT FOR DISTRIBUTION". SQ1044.2 +025000 02 FILLER PIC X(41) VALUE SPACE. SQ1044.2 +025100* SQ1044.2 +025200 01 CCVS-H-2B. SQ1044.2 +025300 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1044.2 +025400 02 TEST-ID PIC X(9). SQ1044.2 +025500 02 FILLER PIC X(4) VALUE " IN ". SQ1044.2 +025600 02 FILLER PIC X(12) VALUE SQ1044.2 +025700 " HIGH ". SQ1044.2 +025800 02 FILLER PIC X(22) VALUE SQ1044.2 +025900 " LEVEL VALIDATION FOR ". SQ1044.2 +026000 02 FILLER PIC X(58) VALUE SQ1044.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1044.2 +026200 01 CCVS-H-3. SQ1044.2 +026300 02 FILLER PIC X(34) VALUE SQ1044.2 +026400 " FOR OFFICIAL USE ONLY ". SQ1044.2 +026500 02 FILLER PIC X(58) VALUE SQ1044.2 +026600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1044.2 +026700 02 FILLER PIC X(28) VALUE SQ1044.2 +026800 " COPYRIGHT 1985,1986 ". SQ1044.2 +026900 01 CCVS-E-1. SQ1044.2 +027000 02 FILLER PIC X(52) VALUE SPACE. SQ1044.2 +027100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1044.2 +027200 02 ID-AGAIN PIC X(9). SQ1044.2 +027300 02 FILLER PIC X(45) VALUE SPACES. SQ1044.2 +027400 01 CCVS-E-2. SQ1044.2 +027500 02 FILLER PIC X(31) VALUE SPACE. SQ1044.2 +027600 02 FILLER PIC X(21) VALUE SPACE. SQ1044.2 +027700 02 CCVS-E-2-2. SQ1044.2 +027800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1044.2 +027900 03 FILLER PIC X VALUE SPACE. SQ1044.2 +028000 03 ENDER-DESC PIC X(44) VALUE SQ1044.2 +028100 "ERRORS ENCOUNTERED". SQ1044.2 +028200 01 CCVS-E-3. SQ1044.2 +028300 02 FILLER PIC X(22) VALUE SQ1044.2 +028400 " FOR OFFICIAL USE ONLY". SQ1044.2 +028500 02 FILLER PIC X(12) VALUE SPACE. SQ1044.2 +028600 02 FILLER PIC X(58) VALUE SQ1044.2 +028700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1044.2 +028800 02 FILLER PIC X(8) VALUE SPACE. SQ1044.2 +028900 02 FILLER PIC X(20) VALUE SQ1044.2 +029000 " COPYRIGHT 1985,1986". SQ1044.2 +029100 01 CCVS-E-4. SQ1044.2 +029200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1044.2 +029300 02 FILLER PIC X(4) VALUE " OF ". SQ1044.2 +029400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1044.2 +029500 02 FILLER PIC X(40) VALUE SQ1044.2 +029600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1044.2 +029700 01 XXINFO. SQ1044.2 +029800 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1044.2 +029900 02 INFO-TEXT. SQ1044.2 +030000 04 FILLER PIC X(8) VALUE SPACE. SQ1044.2 +030100 04 XXCOMPUTED PIC X(20). SQ1044.2 +030200 04 FILLER PIC X(5) VALUE SPACE. SQ1044.2 +030300 04 XXCORRECT PIC X(20). SQ1044.2 +030400 02 INF-ANSI-REFERENCE PIC X(48). SQ1044.2 +030500 01 HYPHEN-LINE. SQ1044.2 +030600 02 FILLER PIC IS X VALUE IS SPACE. SQ1044.2 +030700 02 FILLER PIC IS X(65) VALUE IS "************************SQ1044.2 +030800- "*****************************************". SQ1044.2 +030900 02 FILLER PIC IS X(54) VALUE IS "************************SQ1044.2 +031000- "******************************". SQ1044.2 +031100 01 CCVS-PGM-ID PIC X(9) VALUE SQ1044.2 +031200 "SQ104A". SQ1044.2 +031300* SQ1044.2 +031400* SQ1044.2 +031500 PROCEDURE DIVISION. SQ1044.2 +031600* SQ1044.2 +031700 CCVS1 SECTION. SQ1044.2 +031800 OPEN-FILES. SQ1044.2 +031900*P OPEN I-O RAW-DATA. SQ1044.2 +032000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1044.2 +032100*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1044.2 +032200*P MOVE "ABORTED " TO C-ABORT. SQ1044.2 +032300*P ADD 1 TO C-NO-OF-TESTS. SQ1044.2 +032400*P ACCEPT C-DATE FROM DATE. SQ1044.2 +032500*P ACCEPT C-TIME FROM TIME. SQ1044.2 +032600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1044.2 +032700*PND-E-1. SQ1044.2 +032800*P CLOSE RAW-DATA. SQ1044.2 +032900 OPEN OUTPUT PRINT-FILE. SQ1044.2 +033000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1044.2 +033100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1044.2 +033200 MOVE SPACE TO TEST-RESULTS. SQ1044.2 +033300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1044.2 +033400 MOVE ZERO TO REC-SKEL-SUB. SQ1044.2 +033500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1044.2 +033600 GO TO CCVS1-EXIT. SQ1044.2 +033700* SQ1044.2 +033800 CCVS-INIT-FILE. SQ1044.2 +033900 ADD 1 TO REC-SKL-SUB. SQ1044.2 +034000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1044.2 +034100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1044.2 +034200* SQ1044.2 +034300 CLOSE-FILES. SQ1044.2 +034400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1044.2 +034500 CLOSE PRINT-FILE. SQ1044.2 +034600*P OPEN I-O RAW-DATA. SQ1044.2 +034700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1044.2 +034800*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1044.2 +034900*P MOVE "OK. " TO C-ABORT. SQ1044.2 +035000*P MOVE PASS-COUNTER TO C-OK. SQ1044.2 +035100*P MOVE ERROR-HOLD TO C-ALL. SQ1044.2 +035200*P MOVE ERROR-COUNTER TO C-FAIL. SQ1044.2 +035300*P MOVE DELETE-CNT TO C-DELETED. SQ1044.2 +035400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1044.2 +035500*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1044.2 +035600*PND-E-2. SQ1044.2 +035700*P CLOSE RAW-DATA. SQ1044.2 +035800 TERMINATE-CCVS. SQ1044.2 +035900*S EXIT PROGRAM. SQ1044.2 +036000 STOP RUN. SQ1044.2 +036100* SQ1044.2 +036200 INSPT. SQ1044.2 +036300 MOVE "INSPT" TO P-OR-F. SQ1044.2 +036400 ADD 1 TO INSPECT-COUNTER. SQ1044.2 +036500 PERFORM PRINT-DETAIL. SQ1044.2 +036600* SQ1044.2 +036700 PASS. SQ1044.2 +036800 MOVE "PASS " TO P-OR-F. SQ1044.2 +036900 ADD 1 TO PASS-COUNTER. SQ1044.2 +037000 PERFORM PRINT-DETAIL. SQ1044.2 +037100* SQ1044.2 +037200 FAIL. SQ1044.2 +037300 MOVE "FAIL*" TO P-OR-F. SQ1044.2 +037400 ADD 1 TO ERROR-COUNTER. SQ1044.2 +037500 PERFORM PRINT-DETAIL. SQ1044.2 +037600* SQ1044.2 +037700 DE-LETE. SQ1044.2 +037800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1044.2 +037900 MOVE "*****" TO P-OR-F. SQ1044.2 +038000 ADD 1 TO DELETE-COUNTER. SQ1044.2 +038100 PERFORM PRINT-DETAIL. SQ1044.2 +038200* SQ1044.2 +038300 PRINT-DETAIL. SQ1044.2 +038400 IF REC-CT NOT EQUAL TO ZERO SQ1044.2 +038500 MOVE "." TO PARDOT-X SQ1044.2 +038600 MOVE REC-CT TO DOTVALUE. SQ1044.2 +038700 MOVE TEST-RESULTS TO PRINT-REC. SQ1044.2 +038800 PERFORM WRITE-LINE. SQ1044.2 +038900 IF P-OR-F EQUAL TO "FAIL*" SQ1044.2 +039000 PERFORM WRITE-LINE SQ1044.2 +039100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1044.2 +039200 ELSE SQ1044.2 +039300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1044.2 +039400 MOVE SPACE TO P-OR-F. SQ1044.2 +039500 MOVE SPACE TO COMPUTED-X. SQ1044.2 +039600 MOVE SPACE TO CORRECT-X. SQ1044.2 +039700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1044.2 +039800 MOVE SPACE TO RE-MARK. SQ1044.2 +039900* SQ1044.2 +040000 HEAD-ROUTINE. SQ1044.2 +040100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +040200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +040300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1044.2 +040400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1044.2 +040500 COLUMN-NAMES-ROUTINE. SQ1044.2 +040600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1044.2 +040700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +040800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1044.2 +040900 END-ROUTINE. SQ1044.2 +041000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1044.2 +041100 PERFORM WRITE-LINE 5 TIMES. SQ1044.2 +041200 END-RTN-EXIT. SQ1044.2 +041300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1044.2 +041400 PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +041500* SQ1044.2 +041600 END-ROUTINE-1. SQ1044.2 +041700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1044.2 +041800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1044.2 +041900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1044.2 +042000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1044.2 +042100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1044.2 +042200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1044.2 +042300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1044.2 +042400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1044.2 +042500 PERFORM WRITE-LINE. SQ1044.2 +042600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1044.2 +042700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1044.2 +042800 MOVE "NO " TO ERROR-TOTAL SQ1044.2 +042900 ELSE SQ1044.2 +043000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1044.2 +043100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1044.2 +043200 PERFORM WRITE-LINE. SQ1044.2 +043300 END-ROUTINE-13. SQ1044.2 +043400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1044.2 +043500 MOVE "NO " TO ERROR-TOTAL SQ1044.2 +043600 ELSE SQ1044.2 +043700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1044.2 +043800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1044.2 +043900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1044.2 +044000 PERFORM WRITE-LINE. SQ1044.2 +044100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1044.2 +044200 MOVE "NO " TO ERROR-TOTAL SQ1044.2 +044300 ELSE SQ1044.2 +044400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1044.2 +044500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1044.2 +044600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1044.2 +044700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1044.2 +044800* SQ1044.2 +044900 WRITE-LINE. SQ1044.2 +045000 ADD 1 TO RECORD-COUNT. SQ1044.2 +045100 IF RECORD-COUNT GREATER 50 SQ1044.2 +045200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1044.2 +045300 MOVE SPACE TO DUMMY-RECORD SQ1044.2 +045400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1044.2 +045500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1044.2 +045600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1044.2 +045700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1044.2 +045800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1044.2 +045900 MOVE ZERO TO RECORD-COUNT. SQ1044.2 +046000 PERFORM WRT-LN. SQ1044.2 +046100* SQ1044.2 +046200 WRT-LN. SQ1044.2 +046300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1044.2 +046400 MOVE SPACE TO DUMMY-RECORD. SQ1044.2 +046500 BLANK-LINE-PRINT. SQ1044.2 +046600 PERFORM WRT-LN. SQ1044.2 +046700 FAIL-ROUTINE. SQ1044.2 +046800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1044.2 +046900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1044.2 +047000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1044.2 +047100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1044.2 +047200 MOVE XXINFO TO DUMMY-RECORD. SQ1044.2 +047300 PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +047400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1044.2 +047500 GO TO FAIL-ROUTINE-EX. SQ1044.2 +047600 FAIL-ROUTINE-WRITE. SQ1044.2 +047700 MOVE TEST-COMPUTED TO PRINT-REC SQ1044.2 +047800 PERFORM WRITE-LINE SQ1044.2 +047900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1044.2 +048000 MOVE TEST-CORRECT TO PRINT-REC SQ1044.2 +048100 PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +048200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1044.2 +048300 FAIL-ROUTINE-EX. SQ1044.2 +048400 EXIT. SQ1044.2 +048500 BAIL-OUT. SQ1044.2 +048600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1044.2 +048700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1044.2 +048800 BAIL-OUT-WRITE. SQ1044.2 +048900 MOVE CORRECT-A TO XXCORRECT. SQ1044.2 +049000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1044.2 +049100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1044.2 +049200 MOVE XXINFO TO DUMMY-RECORD. SQ1044.2 +049300 PERFORM WRITE-LINE 2 TIMES. SQ1044.2 +049400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1044.2 +049500 BAIL-OUT-EX. SQ1044.2 +049600 EXIT. SQ1044.2 +049700 CCVS1-EXIT. SQ1044.2 +049800 EXIT. SQ1044.2 +049900* SQ1044.2 +050000**************************************************************** SQ1044.2 +050100* * SQ1044.2 +050200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1044.2 +050300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1044.2 +050400* * SQ1044.2 +050500**************************************************************** SQ1044.2 +050600* SQ1044.2 +050700 SECT-SQ104-0001 SECTION. SQ1044.2 +050800 SEQ-INIT-WR-01. SQ1044.2 +050900 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ1044.2 +051000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1044.2 +051100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1044.2 +051200 MOVE 000120 TO XRECORD-LENGTH (1). SQ1044.2 +051300 MOVE "CH" TO CHARS-OR-RECORDS (1). SQ1044.2 +051400 MOVE 0120 TO XBLOCK-SIZE (1). SQ1044.2 +051500 MOVE 000649 TO RECORDS-IN-FILE (1). SQ1044.2 +051600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1044.2 +051700 MOVE "S" TO XLABEL-TYPE (1). SQ1044.2 +051800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1044.2 +051900 MOVE "CREATE 649 RECORD FILE" TO FEATURE. SQ1044.2 +052000 MOVE "SEQ-TEST-WR-01" TO PAR-NAME. SQ1044.2 +052100* SQ1044.2 +052200 SEQ-TEST-WR-01. SQ1044.2 +052300 OPEN OUTPUT SQ-FS3. SQ1044.2 +052400* SQ1044.2 +052500 SEQ-TEST-WR-01-LOOP. SQ1044.2 +052600 ADD 1 TO XRECORD-NUMBER (1). SQ1044.2 +052700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ1044.2 +052800 WRITE SQ-FS3R1-F-G-120. SQ1044.2 +052900 IF XRECORD-NUMBER (1) LESS THAN 649 SQ1044.2 +053000 GO TO SEQ-TEST-WR-01-LOOP. SQ1044.2 +053100* SQ1044.2 +053200 CLOSE SQ-FS3. SQ1044.2 +053300* SQ1044.2 +053400* A SEQUENTIAL TAPE FILE HAS BEEN CREATED. IT CONTAINS 649 SQ1044.2 +053500* RECORDS, EACH 120 CHARACTERS LONG. THE FILE WILL NOW BE SQ1044.2 +053600* READ AND THE RECORDS VERIFIED. SQ1044.2 +053700* SQ1044.2 +053800 SEQ-INIT-GF-02. SQ1044.2 +053900 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1044.2 +054000 MOVE "VERIFY NEW FILE" TO FEATURE. SQ1044.2 +054100 MOVE 1 TO REC-CT. SQ1044.2 +054200 GO TO SEQ-TEST-GF-02-01. SQ1044.2 +054300 SEQ-DELETE-02-01. SQ1044.2 +054400 GO TO SEQ-DELETE-02-02. SQ1044.2 +054500 SEQ-TEST-GF-02-01. SQ1044.2 +054600 OPEN INPUT SQ-FS3. SQ1044.2 +054700* SQ1044.2 +054800 SEQ-INIT-GF-02-02. SQ1044.2 +054900 MOVE FILE-RECORD-INFO-P1-120 (1) SQ1044.2 +055000 TO FILE-RECORD-INFO-P1-120 (2). SQ1044.2 +055100 MOVE ZERO TO XRECORD-NUMBER (2). SQ1044.2 +055200 GO TO SEQ-TEST-GF-02-02. SQ1044.2 +055300 SEQ-DELETE-02-02. SQ1044.2 +055400 PERFORM DE-LETE. SQ1044.2 +055500 ADD 1 TO REC-CT. SQ1044.2 +055600 PERFORM DE-LETE. SQ1044.2 +055700 GO TO SEQ-DELETE-GF-02-05. SQ1044.2 +055800 SEQ-TEST-GF-02-02. SQ1044.2 +055900 SEQ-TEST-GF-02-02-LOOP. SQ1044.2 +056000 READ SQ-FS3 SQ1044.2 +056100 AT END GO TO SEQ-TEST-GF-02-02-1. SQ1044.2 +056200 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +056300 ADD 1 TO XRECORD-NUMBER (2). SQ1044.2 +056400 IF XRECORD-NUMBER (2) GREATER THAN 649 SQ1044.2 +056500 GO TO SEQ-TEST-GF-02-02-1. SQ1044.2 +056600 IF FILE-RECORD-INFO-P1-120 (1) SQ1044.2 +056700 NOT EQUAL TO FILE-RECORD-INFO-P1-120 (2) SQ1044.2 +056800 ADD 1 TO RECORDS-IN-ERROR. SQ1044.2 +056900 GO TO SEQ-TEST-GF-02-02-LOOP. SQ1044.2 +057000* SQ1044.2 +057100 SEQ-TEST-GF-02-02-1. SQ1044.2 +057200 IF XRECORD-NUMBER (2) = 649 SQ1044.2 +057300 PERFORM PASS SQ1044.2 +057400 ELSE SQ1044.2 +057500 MOVE "RECORD COUNTING ERROR" TO RE-MARK SQ1044.2 +057600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +057700 MOVE 649 TO CORRECT-18V0 SQ1044.2 +057800 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +057900 PERFORM FAIL. SQ1044.2 +058000* SQ1044.2 +058100 ADD 1 TO REC-CT. SQ1044.2 +058200 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1044.2 +058300 PERFORM PASS SQ1044.2 +058400 ELSE SQ1044.2 +058500 MOVE "RECORD CONTENT ERRORS" TO RE-MARK SQ1044.2 +058600 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +058700 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1044.2 +058800 MOVE "VII-44; 4.4.2" TO ANSI-REFERENCE SQ1044.2 +058900 PERFORM FAIL. SQ1044.2 +059000* SQ1044.2 +059100 SEQ-INIT-GF-02-05. SQ1044.2 +059200 GO TO SEQ-TEST-GF-02-05. SQ1044.2 +059300 SEQ-DELETE-GF-02-05. SQ1044.2 +059400 GO TO SEQ-TEST-GF-02-END. SQ1044.2 +059500 SEQ-TEST-GF-02-05. SQ1044.2 +059600 CLOSE SQ-FS3. SQ1044.2 +059700 SEQ-TEST-GF-02-END. SQ1044.2 +059800* SQ1044.2 +059900* SQ1044.2 +060000 SEQ-INIT-GF-03. SQ1044.2 +060100 GO TO SEQ-TEST-GF-03. SQ1044.2 +060200 SEQ-DELETE-03. SQ1044.2 +060300 GO TO SEQ-TEST-03-END. SQ1044.2 +060400 SEQ-TEST-GF-03. SQ1044.2 +060500 OPEN INPUT SQ-FS3. SQ1044.2 +060600 SEQ-TEST-03-END. SQ1044.2 +060700* SQ1044.2 +060800* SQ1044.2 +060900* THIS SERIES OF TESTS CHECKS FOUR LEVEL 1 VARIANTS OF SQ1044.2 +061000* THE READ STATEMENT SQ1044.2 +061100* SQ1044.2 +061200 SEQ-INIT-GF-04. SQ1044.2 +061300 MOVE ZERO TO XRECORD-NUMBER (2). SQ1044.2 +061400 MOVE ZERO TO RECORDS-IN-ERROR. SQ1044.2 +061500 MOVE "READ...RECORD AT END" TO FEATURE. SQ1044.2 +061600 MOVE "SEQ-TEST-GF-O4" TO PAR-NAME. SQ1044.2 +061700 MOVE ZERO TO ERROR-FLAG. SQ1044.2 +061800 MOVE 1 TO REC-CT. SQ1044.2 +061900 GO TO SEQ-TEST-GF-04. SQ1044.2 +062000 SEQ-DELETE-04. SQ1044.2 +062100 PERFORM DE-LETE. SQ1044.2 +062200 ADD 1 TO REC-CT. SQ1044.2 +062300 PERFORM DE-LETE. SQ1044.2 +062400 GO TO SEQ-TEST-04-END. SQ1044.2 +062500 SEQ-TEST-GF-04. SQ1044.2 +062600 READ SQ-FS3 RECORD AT END SQ1044.2 +062700 MOVE 1 TO EOF-FLAG SQ1044.2 +062800 GO TO SEQ-TEST-GF-04-01. SQ1044.2 +062900 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +063000 ADD 1 TO XRECORD-NUMBER (2) SQ1044.2 +063100 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1044.2 +063200 ADD 1 TO RECORDS-IN-ERROR SQ1044.2 +063300 MOVE 1 TO ERROR-FLAG. SQ1044.2 +063400 IF XRECORD-NUMBER (2) LESS THAN 50 SQ1044.2 +063500 GO TO SEQ-TEST-GF-04. SQ1044.2 +063600* SQ1044.2 +063700 SEQ-TEST-GF-04-01. SQ1044.2 +063800 IF EOF-FLAG NOT EQUAL TO ZERO SQ1044.2 +063900 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1044.2 +064000 MOVE 649 TO CORRECT-18V0 SQ1044.2 +064100 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +064200 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +064300 PERFORM FAIL SQ1044.2 +064400 ELSE SQ1044.2 +064500 PERFORM PASS. SQ1044.2 +064600* SQ1044.2 +064700 SEQ-TEST-GF-04-02. SQ1044.2 +064800 ADD 1 TO REC-CT. SQ1044.2 +064900 IF ERROR-FLAG EQUAL TO ZERO SQ1044.2 +065000 PERFORM PASS SQ1044.2 +065100 ELSE SQ1044.2 +065200 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1044.2 +065300 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +065400 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1044.2 +065500 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +065600 PERFORM FAIL. SQ1044.2 +065700 SEQ-TEST-04-END. SQ1044.2 +065800* SQ1044.2 +065900* SQ1044.2 +066000 SEQ-INIT-GF-O5. SQ1044.2 +066100 IF EOF-FLAG EQUAL TO 1 SQ1044.2 +066200 GO TO SEQ-DELETE-05. SQ1044.2 +066300 MOVE ZERO TO ERROR-FLAG. SQ1044.2 +066400 MOVE "READ...AT END..." TO FEATURE SQ1044.2 +066500 MOVE "SEQ-TEST-GF-O5" TO PAR-NAME. SQ1044.2 +066600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1044.2 +066700 MOVE 1 TO REC-CT. SQ1044.2 +066800 GO TO SEQ-TEST-GF-05. SQ1044.2 +066900 SEQ-DELETE-05. SQ1044.2 +067000 PERFORM DE-LETE. SQ1044.2 +067100 ADD 1 TO REC-CT. SQ1044.2 +067200 PERFORM DE-LETE. SQ1044.2 +067300 GO TO SEQ-TEST-05-END. SQ1044.2 +067400 SEQ-TEST-GF-05. SQ1044.2 +067500 READ SQ-FS3 AT END SQ1044.2 +067600 MOVE 1 TO EOF-FLAG SQ1044.2 +067700 GO TO SEQ-TEST-GF-05-01. SQ1044.2 +067800 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +067900 ADD 1 TO XRECORD-NUMBER (2) SQ1044.2 +068000 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1044.2 +068100 ADD 1 TO RECORDS-IN-ERROR SQ1044.2 +068200 MOVE 1 TO ERROR-FLAG. SQ1044.2 +068300 IF XRECORD-NUMBER (2) LESS THAN 200 SQ1044.2 +068400 GO TO SEQ-TEST-GF-05. SQ1044.2 +068500* SQ1044.2 +068600 SEQ-TEST-GF-05-01. SQ1044.2 +068700 IF EOF-FLAG NOT EQUAL TO ZERO SQ1044.2 +068800 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1044.2 +068900 MOVE 649 TO CORRECT-18V0 SQ1044.2 +069000 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +069100 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +069200 PERFORM FAIL SQ1044.2 +069300 ELSE SQ1044.2 +069400 PERFORM PASS. SQ1044.2 +069500* SQ1044.2 +069600 SEQ-TEST-GF-05-02. SQ1044.2 +069700 ADD 1 TO REC-CT. SQ1044.2 +069800 IF ERROR-FLAG EQUAL TO ZERO SQ1044.2 +069900 PERFORM PASS SQ1044.2 +070000 ELSE SQ1044.2 +070100 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1044.2 +070200 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +070300 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1044.2 +070400 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +070500 PERFORM FAIL. SQ1044.2 +070600 SEQ-TEST-05-END. SQ1044.2 +070700* SQ1044.2 +070800* SQ1044.2 +070900 SEQ-INIT-GF-O6. SQ1044.2 +071000 IF EOF-FLAG EQUAL TO 1 SQ1044.2 +071100 GO TO SEQ-DELETE-06. SQ1044.2 +071200 MOVE ZERO TO ERROR-FLAG. SQ1044.2 +071300 MOVE "READ...RECORD END..." TO FEATURE SQ1044.2 +071400 MOVE "SEQ-TEST-GF-O6" TO PAR-NAME. SQ1044.2 +071500 MOVE ZERO TO RECORDS-IN-ERROR. SQ1044.2 +071600 MOVE 1 TO REC-CT. SQ1044.2 +071700 GO TO SEQ-TEST-GF-06. SQ1044.2 +071800 SEQ-DELETE-06. SQ1044.2 +071900 PERFORM DE-LETE. SQ1044.2 +072000 ADD 1 TO REC-CT. SQ1044.2 +072100 PERFORM DE-LETE. SQ1044.2 +072200 GO TO SEQ-TEST-06-END. SQ1044.2 +072300 SEQ-TEST-GF-06. SQ1044.2 +072400 READ SQ-FS3 RECORD END SQ1044.2 +072500 MOVE 1 TO EOF-FLAG SQ1044.2 +072600 GO TO SEQ-TEST-GF-06-01. SQ1044.2 +072700 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +072800 ADD 1 TO XRECORD-NUMBER (2) SQ1044.2 +072900 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1044.2 +073000 ADD 1 TO RECORDS-IN-ERROR SQ1044.2 +073100 MOVE 1 TO ERROR-FLAG. SQ1044.2 +073200 IF XRECORD-NUMBER (2) LESS THAN 499 SQ1044.2 +073300 GO TO SEQ-TEST-GF-06. SQ1044.2 +073400* SQ1044.2 +073500 SEQ-TEST-GF-06-01. SQ1044.2 +073600 IF EOF-FLAG NOT EQUAL TO ZERO SQ1044.2 +073700 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1044.2 +073800 MOVE 649 TO CORRECT-18V0 SQ1044.2 +073900 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +074000 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +074100 PERFORM FAIL SQ1044.2 +074200 ELSE SQ1044.2 +074300 PERFORM PASS. SQ1044.2 +074400* SQ1044.2 +074500 SEQ-TEST-GF-06-02. SQ1044.2 +074600 ADD 1 TO REC-CT. SQ1044.2 +074700 IF ERROR-FLAG EQUAL TO ZERO SQ1044.2 +074800 PERFORM PASS SQ1044.2 +074900 ELSE SQ1044.2 +075000 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1044.2 +075100 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +075200 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1044.2 +075300 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +075400 PERFORM FAIL. SQ1044.2 +075500 SEQ-TEST-06-END. SQ1044.2 +075600* SQ1044.2 +075700* SQ1044.2 +075800 SEQ-INIT-GF-O7. SQ1044.2 +075900 IF EOF-FLAG EQUAL TO 1 SQ1044.2 +076000 GO TO SEQ-DELETE-07. SQ1044.2 +076100 MOVE ZERO TO ERROR-FLAG. SQ1044.2 +076200 MOVE "READ... END..." TO FEATURE SQ1044.2 +076300 MOVE "SEQ-TEST-GF-O7" TO PAR-NAME. SQ1044.2 +076400 MOVE ZERO TO RECORDS-IN-ERROR. SQ1044.2 +076500 MOVE 1 TO REC-CT. SQ1044.2 +076600 GO TO SEQ-TEST-GF-07. SQ1044.2 +076700 SEQ-DELETE-07. SQ1044.2 +076800 PERFORM DE-LETE. SQ1044.2 +076900 ADD 1 TO REC-CT. SQ1044.2 +077000 PERFORM DE-LETE. SQ1044.2 +077100 GO TO SEQ-TEST-07-END. SQ1044.2 +077200 SEQ-TEST-GF-07. SQ1044.2 +077300 READ SQ-FS3 END SQ1044.2 +077400 MOVE 1 TO EOF-FLAG SQ1044.2 +077500 GO TO SEQ-TEST-GF-07-01. SQ1044.2 +077600 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1044.2 +077700 ADD 1 TO XRECORD-NUMBER (2) SQ1044.2 +077800 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1044.2 +077900 ADD 1 TO RECORDS-IN-ERROR SQ1044.2 +078000 MOVE 1 TO ERROR-FLAG. SQ1044.2 +078100 IF XRECORD-NUMBER (2) LESS THAN 649 SQ1044.2 +078200 GO TO SEQ-TEST-GF-07. SQ1044.2 +078300* SQ1044.2 +078400 SEQ-TEST-GF-07-01. SQ1044.2 +078500 IF EOF-FLAG NOT EQUAL TO ZERO SQ1044.2 +078600 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1044.2 +078700 MOVE 649 TO CORRECT-18V0 SQ1044.2 +078800 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1044.2 +078900 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +079000 PERFORM FAIL SQ1044.2 +079100 ELSE SQ1044.2 +079200 PERFORM PASS. SQ1044.2 +079300* SQ1044.2 +079400 SEQ-TEST-GF-07-02. SQ1044.2 +079500 ADD 1 TO REC-CT. SQ1044.2 +079600 IF ERROR-FLAG EQUAL TO ZERO SQ1044.2 +079700 PERFORM PASS SQ1044.2 +079800 ELSE SQ1044.2 +079900 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1044.2 +080000 MOVE ZERO TO CORRECT-18V0 SQ1044.2 +080100 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1044.2 +080200 MOVE "VII-44" TO ANSI-REFERENCE SQ1044.2 +080300 PERFORM FAIL. SQ1044.2 +080400 SEQ-TEST-07-END. SQ1044.2 +080500* SQ1044.2 +080600* SQ1044.2 +080700 SEQ-INIT-GF-O8. SQ1044.2 +080800 IF EOF-FLAG EQUAL TO 1 SQ1044.2 +080900 GO TO SEQ-DELETE-08. SQ1044.2 +081000 MOVE "READ... END... AT EOF" TO FEATURE SQ1044.2 +081100 MOVE "SEQ-TEST-GF-O8" TO PAR-NAME. SQ1044.2 +081200 MOVE 1 TO REC-CT. SQ1044.2 +081300 GO TO SEQ-TEST-GF-08. SQ1044.2 +081400 SEQ-DELETE-08. SQ1044.2 +081500 PERFORM DE-LETE. SQ1044.2 +081600 GO TO SEQ-TEST-08-END. SQ1044.2 +081700 SEQ-TEST-GF-08. SQ1044.2 +081800 READ SQ-FS3 END SQ1044.2 +081900 MOVE 1 TO EOF-FLAG. SQ1044.2 +082000* SQ1044.2 +082100 SEQ-TEST-GF-08-01. SQ1044.2 +082200 IF EOF-FLAG NOT EQUAL TO 1 SQ1044.2 +082300 MOVE EOF-FLAG TO COMPUTED-18V0 SQ1044.2 +082400 MOVE 1 TO CORRECT-18V0 SQ1044.2 +082500 MOVE "EOF NOT FOUND AFTER 649 RECORDS" TO RE-MARK SQ1044.2 +082600 PERFORM FAIL SQ1044.2 +082700 ELSE SQ1044.2 +082800 PERFORM PASS. SQ1044.2 +082900 SEQ-TEST-08-END. SQ1044.2 +083000* SQ1044.2 +083100* SQ1044.2 +083200 SEQ-INIT-GF-O9. SQ1044.2 +083300 GO TO SEQ-TEST-GF-09. SQ1044.2 +083400 SEQ-DELETE-09. SQ1044.2 +083500 GO TO SEQ-TEST-09-END. SQ1044.2 +083600 SEQ-TEST-GF-09. SQ1044.2 +083700 CLOSE SQ-FS3. SQ1044.2 +083800 SEQ-TEST-09-END. SQ1044.2 +083900* SQ1044.2 +084000* SQ1044.2 +084100 TERMINATE-ROUTINE. SQ1044.2 +084200 EXIT. SQ1044.2 +084300 CCVS-EXIT SECTION. SQ1044.2 +084400 CCVS-999999. SQ1044.2 +084500 GO TO CLOSE-FILES. SQ1044.2 diff --git a/tests/cobol85/SQ/SQ105A.CBL b/tests/cobol85/SQ/SQ105A.CBL new file mode 100755 index 00000000..31a6dd0c --- /dev/null +++ b/tests/cobol85/SQ/SQ105A.CBL @@ -0,0 +1,1174 @@ +000100 IDENTIFICATION DIVISION. SQ1054.2 +000200 PROGRAM-ID. SQ1054.2 +000300 SQ105A. SQ1054.2 +000400**************************************************************** SQ1054.2 +000500* * SQ1054.2 +000600* VALIDATION FOR:- * SQ1054.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1054.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1054.2 +000900* REVISED 1986, AUGUST * SQ1054.2 +001000* * SQ1054.2 +001100* CREATION DATE / VALIDATION DATE * SQ1054.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1054.2 +001300* * SQ1054.2 +001400**************************************************************** SQ1054.2 +001500* * SQ1054.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1054.2 +001700* * SQ1054.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1054.2 +001900* X-55 SYSTEM PRINTER * SQ1054.2 +002000* X-82 SOURCE-COMPUTER * SQ1054.2 +002100* X-83 OBJECT-COMPUTER. * SQ1054.2 +002200* * SQ1054.2 +002300**************************************************************** SQ1054.2 +002400* * SQ1054.2 +002500* SQ105A CREATES A SEQUENTIAL MASS STORAGE FILE CONTAINING * SQ1054.2 +002600* 980 RECORDS, EACH 125 CHARACTERS LONG. THERE ARE TWO * SQ1054.2 +002700* USE PROCEDURES IN THE DECLARATIVE SECTION, ONE FOR * SQ1054.2 +002800* EXCEPTION ON OUTPUT, THE OTHER FOR EXCEPTION ON INPUT. * SQ1054.2 +002900* THE FILE IS READ TWICE. IN THE FIRST PASS, RECORDS ARE * SQ1054.2 +003000* READ WITH READ STATEMENTS WHICH DO NOT CONTAIN ANY * SQ1054.2 +003100* OPTIONAL PHRASES EXCEPT THE OPTIONAL WORD "RECORD". ON * SQ1054.2 +003200* THE SECOND PASS, THE READ STATEMENT CONTAINS NO OPTIONAL * SQ1054.2 +003300* WORDS OR PHRASES AT ALL. ON BOTH PASSES, THE END OF FILE * SQ1054.2 +003400* SHOULD CAUSE EXECUTION OF THE DECLARATIVE PROCEDURE FOR * SQ1054.2 +003500* INPUT. THE DECLARATIVE PROCEDURE FOR OUTPUT SHOULD BE * SQ1054.2 +003600* ON BOTH PASSES. * SQ1054.2 +003700* * SQ1054.2 +003800* THE OPTIONAL ORGANIZATION AND ACCESS MODE CLAUSES ARE * SQ1054.2 +003900* BOTH OMITTED. * SQ1054.2 +004000* * SQ1054.2 +004100**************************************************************** SQ1054.2 +004200* SQ1054.2 +004300* SQ1054.2 +004400 ENVIRONMENT DIVISION. SQ1054.2 +004500 CONFIGURATION SECTION. SQ1054.2 +004600 SOURCE-COMPUTER. SQ1054.2 +004700 Linux. SQ1054.2 +004800 OBJECT-COMPUTER. SQ1054.2 +004900 Linux. SQ1054.2 +005000* SQ1054.2 +005100 INPUT-OUTPUT SECTION. SQ1054.2 +005200 FILE-CONTROL. SQ1054.2 +005300 SELECT PRINT-FILE ASSIGN TO SQ1054.2 +005400 "report.log". SQ1054.2 +005500* SQ1054.2 +005600*P SELECT RAW-DATA ASSIGN TO SQ1054.2 +005700*P "XXXXX062" SQ1054.2 +005800*P ORGANIZATION IS INDEXED SQ1054.2 +005900*P ACCESS MODE IS RANDOM SQ1054.2 +006000*P RECORD-KEY IS RAW-DATA-KEY. SQ1054.2 +006100*P SQ1054.2 +006200 SELECT SQ-FS4 ASSIGN SQ1054.2 +006300 "XXXXX014" SQ1054.2 +006400 STATUS SQ-FS4-STATUS. SQ1054.2 +006500* SQ1054.2 +006600* SQ1054.2 +006700 DATA DIVISION. SQ1054.2 +006800 FILE SECTION. SQ1054.2 +006900 FD PRINT-FILE SQ1054.2 +007000*C LABEL RECORDS SQ1054.2 +007100*C OMITTED SQ1054.2 +007200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1054.2 +007300 . SQ1054.2 +007400 01 PRINT-REC PICTURE X(120). SQ1054.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ1054.2 +007600*P SQ1054.2 +007700*PD RAW-DATA. SQ1054.2 +007800*P1 RAW-DATA-SATZ. SQ1054.2 +007900*P 05 RAW-DATA-KEY PIC X(6). SQ1054.2 +008000*P 05 C-DATE PIC 9(6). SQ1054.2 +008100*P 05 C-TIME PIC 9(8). SQ1054.2 +008200*P 05 NO-OF-TESTS PIC 99. SQ1054.2 +008300*P 05 C-OK PIC 999. SQ1054.2 +008400*P 05 C-ALL PIC 999. SQ1054.2 +008500*P 05 C-FAIL PIC 999. SQ1054.2 +008600*P 05 C-DELETED PIC 999. SQ1054.2 +008700*P 05 C-INSPECT PIC 999. SQ1054.2 +008800*P 05 C-NOTE PIC X(13). SQ1054.2 +008900*P 05 C-INDENT PIC X. SQ1054.2 +009000*P 05 C-ABORT PIC X(8). SQ1054.2 +009100* SQ1054.2 +009200 FD SQ-FS4 SQ1054.2 +009300 BLOCK CONTAINS 2 RECORDS SQ1054.2 +009400 RECORD 125 SQ1054.2 +009500*C LABEL RECORD STANDARD SQ1054.2 +009600 DATA RECORDS SQ-FS4R1-F-G-125. SQ1054.2 +009700* SQ1054.2 +009800 01 SQ-FS4R1-F-G-125. SQ1054.2 +009900 02 SQ-FS4-FIRST PIC X(120). SQ1054.2 +010000 02 SQ-FS4-REC-NO PIC 9(5). SQ1054.2 +010100* SQ1054.2 +010200 WORKING-STORAGE SECTION. SQ1054.2 +010300* SQ1054.2 +010400*************************************************************** SQ1054.2 +010500* * SQ1054.2 +010600* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1054.2 +010700* * SQ1054.2 +010800*************************************************************** SQ1054.2 +010900* SQ1054.2 +011000 01 SQ-FS4-STATUS. SQ1054.2 +011100 03 SQ-FS4-STATUS-1 PIC X. SQ1054.2 +011200 03 SQ-FS4-STATUS-2 PIC X. SQ1054.2 +011300* SQ1054.2 +011400 01 SQ-FS4-STATUS-COPY PIC XX. SQ1054.2 +011500 01 DECL-EXEC-SW. SQ1054.2 +011600 05 DECL-EXEC-SW-O PIC X. SQ1054.2 +011700 05 DECL-EXEC-SW-I PIC X. SQ1054.2 +011800 01 WRK-CS-09V00 PIC S9(9) USAGE COMPUTATIONAL VALUE ZERO. SQ1054.2 +011900 01 EOF-FLAG PIC 9 VALUE ZERO. SQ1054.2 +012000 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1054.2 +012100 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1054.2 +012200 01 PERM-ERRORS PIC S9(5) USAGE COMP VALUE ZERO. SQ1054.2 +012300* SQ1054.2 +012400 01 MAJOR-DELETIONS PIC 99. SQ1054.2 +012500 01 COUNT-OF-RECS PIC 9(5). SQ1054.2 +012600* SQ1054.2 +012700* SQ1054.2 +012800*************************************************************** SQ1054.2 +012900* * SQ1054.2 +013000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1054.2 +013100* * SQ1054.2 +013200*************************************************************** SQ1054.2 +013300* SQ1054.2 +013400 01 REC-SKEL-SUB PIC 99. SQ1054.2 +013500* SQ1054.2 +013600 01 FILE-RECORD-INFORMATION-REC. SQ1054.2 +013700 03 FILE-RECORD-INFO-SKELETON. SQ1054.2 +013800 05 FILLER PICTURE X(48) VALUE SQ1054.2 +013900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1054.2 +014000 05 FILLER PICTURE X(46) VALUE SQ1054.2 +014100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1054.2 +014200 05 FILLER PICTURE X(26) VALUE SQ1054.2 +014300 ",LFIL=000000,ORG= ,LBLR= ". SQ1054.2 +014400 05 FILLER PICTURE X(37) VALUE SQ1054.2 +014500 ",RECKEY= ". SQ1054.2 +014600 05 FILLER PICTURE X(38) VALUE SQ1054.2 +014700 ",ALTKEY1= ". SQ1054.2 +014800 05 FILLER PICTURE X(38) VALUE SQ1054.2 +014900 ",ALTKEY2= ". SQ1054.2 +015000 05 FILLER PICTURE X(7) VALUE SPACE.SQ1054.2 +015100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1054.2 +015200 05 FILE-RECORD-INFO-P1-120. SQ1054.2 +015300 07 FILLER PIC X(5). SQ1054.2 +015400 07 XFILE-NAME PIC X(6). SQ1054.2 +015500 07 FILLER PIC X(8). SQ1054.2 +015600 07 XRECORD-NAME PIC X(6). SQ1054.2 +015700 07 FILLER PIC X(1). SQ1054.2 +015800 07 REELUNIT-NUMBER PIC 9(1). SQ1054.2 +015900 07 FILLER PIC X(7). SQ1054.2 +016000 07 XRECORD-NUMBER PIC 9(6). SQ1054.2 +016100 07 FILLER PIC X(6). SQ1054.2 +016200 07 UPDATE-NUMBER PIC 9(2). SQ1054.2 +016300 07 FILLER PIC X(5). SQ1054.2 +016400 07 ODO-NUMBER PIC 9(4). SQ1054.2 +016500 07 FILLER PIC X(5). SQ1054.2 +016600 07 XPROGRAM-NAME PIC X(5). SQ1054.2 +016700 07 FILLER PIC X(7). SQ1054.2 +016800 07 XRECORD-LENGTH PIC 9(6). SQ1054.2 +016900 07 FILLER PIC X(7). SQ1054.2 +017000 07 CHARS-OR-RECORDS PIC X(2). SQ1054.2 +017100 07 FILLER PIC X(1). SQ1054.2 +017200 07 XBLOCK-SIZE PIC 9(4). SQ1054.2 +017300 07 FILLER PIC X(6). SQ1054.2 +017400 07 RECORDS-IN-FILE PIC 9(6). SQ1054.2 +017500 07 FILLER PIC X(5). SQ1054.2 +017600 07 XFILE-ORGANIZATION PIC X(2). SQ1054.2 +017700 07 FILLER PIC X(6). SQ1054.2 +017800 07 XLABEL-TYPE PIC X(1). SQ1054.2 +017900 05 FILE-RECORD-INFO-P121-240. SQ1054.2 +018000 07 FILLER PIC X(8). SQ1054.2 +018100 07 XRECORD-KEY PIC X(29). SQ1054.2 +018200 07 FILLER PIC X(9). SQ1054.2 +018300 07 ALTERNATE-KEY1 PIC X(29). SQ1054.2 +018400 07 FILLER PIC X(9). SQ1054.2 +018500 07 ALTERNATE-KEY2 PIC X(29). SQ1054.2 +018600 07 FILLER PIC X(7). SQ1054.2 +018700* SQ1054.2 +018800 01 TEST-RESULTS. SQ1054.2 +018900 02 FILLER PIC X VALUE SPACE. SQ1054.2 +019000 02 PAR-NAME. SQ1054.2 +019100 03 FILLER PIC X(14) VALUE SPACE. SQ1054.2 +019200 03 PARDOT-X PIC X VALUE SPACE. SQ1054.2 +019300 03 DOTVALUE PIC 99 VALUE ZERO. SQ1054.2 +019400 02 FILLER PIC X VALUE SPACE. SQ1054.2 +019500 02 FEATURE PIC X(24) VALUE SPACE. SQ1054.2 +019600 02 FILLER PIC X VALUE SPACE. SQ1054.2 +019700 02 P-OR-F PIC X(5) VALUE SPACE. SQ1054.2 +019800 02 FILLER PIC X(9) VALUE SPACE. SQ1054.2 +019900 02 RE-MARK PIC X(61). SQ1054.2 +020000 01 TEST-COMPUTED. SQ1054.2 +020100 02 FILLER PIC X(30) VALUE SPACE. SQ1054.2 +020200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1054.2 +020300 02 COMPUTED-X. SQ1054.2 +020400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1054.2 +020500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1054.2 +020600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1054.2 +020700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1054.2 +020800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1054.2 +020900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1054.2 +021000 04 COMPUTED-18V0 PIC -9(18). SQ1054.2 +021100 04 FILLER PIC X. SQ1054.2 +021200 03 FILLER PIC X(50) VALUE SPACE. SQ1054.2 +021300 01 TEST-CORRECT. SQ1054.2 +021400 02 FILLER PIC X(30) VALUE SPACE. SQ1054.2 +021500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1054.2 +021600 02 CORRECT-X. SQ1054.2 +021700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1054.2 +021800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1054.2 +021900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1054.2 +022000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1054.2 +022100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1054.2 +022200 03 CR-18V0 REDEFINES CORRECT-A. SQ1054.2 +022300 04 CORRECT-18V0 PIC -9(18). SQ1054.2 +022400 04 FILLER PIC X. SQ1054.2 +022500 03 FILLER PIC X(2) VALUE SPACE. SQ1054.2 +022600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1054.2 +022700* SQ1054.2 +022800 01 CCVS-C-1. SQ1054.2 +022900 02 FILLER PIC IS X VALUE SPACE. SQ1054.2 +023000 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1054.2 +023100 02 FILLER PIC IS X VALUE SPACE. SQ1054.2 +023200 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1054.2 +023300 02 FILLER PIC IS X VALUE SPACE. SQ1054.2 +023400 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1054.2 +023500 02 FILLER PIC IS X(9) VALUE SPACE. SQ1054.2 +023600 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1054.2 +023700 01 CCVS-C-2. SQ1054.2 +023800 02 FILLER PIC X(19) VALUE SPACE. SQ1054.2 +023900 02 FILLER PIC X(6) VALUE "TESTED". SQ1054.2 +024000 02 FILLER PIC X(19) VALUE SPACE. SQ1054.2 +024100 02 FILLER PIC X(4) VALUE "FAIL". SQ1054.2 +024200 02 FILLER PIC X(72) VALUE SPACE. SQ1054.2 +024300* SQ1054.2 +024400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1054.2 +024500 01 REC-CT PIC 99 VALUE ZERO. SQ1054.2 +024600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1054.2 +024700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1054.2 +024800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1054.2 +024900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1054.2 +025000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1054.2 +025100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1054.2 +025200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1054.2 +025300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1054.2 +025400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1054.2 +025500 01 CCVS-H-1. SQ1054.2 +025600 02 FILLER PIC X(39) VALUE SPACES. SQ1054.2 +025700 02 FILLER PIC X(42) VALUE SQ1054.2 +025800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1054.2 +025900 02 FILLER PIC X(39) VALUE SPACES. SQ1054.2 +026000 01 CCVS-H-2A. SQ1054.2 +026100 02 FILLER PIC X(40) VALUE SPACE. SQ1054.2 +026200 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1054.2 +026300 02 FILLER PIC XXXX VALUE SQ1054.2 +026400 "4.2 ". SQ1054.2 +026500 02 FILLER PIC X(28) VALUE SQ1054.2 +026600 " COPY - NOT FOR DISTRIBUTION". SQ1054.2 +026700 02 FILLER PIC X(41) VALUE SPACE. SQ1054.2 +026800* SQ1054.2 +026900 01 CCVS-H-2B. SQ1054.2 +027000 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1054.2 +027100 02 TEST-ID PIC X(9). SQ1054.2 +027200 02 FILLER PIC X(4) VALUE " IN ". SQ1054.2 +027300 02 FILLER PIC X(12) VALUE SQ1054.2 +027400 " HIGH ". SQ1054.2 +027500 02 FILLER PIC X(22) VALUE SQ1054.2 +027600 " LEVEL VALIDATION FOR ". SQ1054.2 +027700 02 FILLER PIC X(58) VALUE SQ1054.2 +027800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1054.2 +027900 01 CCVS-H-3. SQ1054.2 +028000 02 FILLER PIC X(34) VALUE SQ1054.2 +028100 " FOR OFFICIAL USE ONLY ". SQ1054.2 +028200 02 FILLER PIC X(58) VALUE SQ1054.2 +028300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1054.2 +028400 02 FILLER PIC X(28) VALUE SQ1054.2 +028500 " COPYRIGHT 1985,1986 ". SQ1054.2 +028600 01 CCVS-E-1. SQ1054.2 +028700 02 FILLER PIC X(52) VALUE SPACE. SQ1054.2 +028800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1054.2 +028900 02 ID-AGAIN PIC X(9). SQ1054.2 +029000 02 FILLER PIC X(45) VALUE SPACES. SQ1054.2 +029100 01 CCVS-E-2. SQ1054.2 +029200 02 FILLER PIC X(31) VALUE SPACE. SQ1054.2 +029300 02 FILLER PIC X(21) VALUE SPACE. SQ1054.2 +029400 02 CCVS-E-2-2. SQ1054.2 +029500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1054.2 +029600 03 FILLER PIC X VALUE SPACE. SQ1054.2 +029700 03 ENDER-DESC PIC X(44) VALUE SQ1054.2 +029800 "ERRORS ENCOUNTERED". SQ1054.2 +029900 01 CCVS-E-3. SQ1054.2 +030000 02 FILLER PIC X(22) VALUE SQ1054.2 +030100 " FOR OFFICIAL USE ONLY". SQ1054.2 +030200 02 FILLER PIC X(12) VALUE SPACE. SQ1054.2 +030300 02 FILLER PIC X(58) VALUE SQ1054.2 +030400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1054.2 +030500 02 FILLER PIC X(8) VALUE SPACE. SQ1054.2 +030600 02 FILLER PIC X(20) VALUE SQ1054.2 +030700 " COPYRIGHT 1985,1986". SQ1054.2 +030800 01 CCVS-E-4. SQ1054.2 +030900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1054.2 +031000 02 FILLER PIC X(4) VALUE " OF ". SQ1054.2 +031100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1054.2 +031200 02 FILLER PIC X(40) VALUE SQ1054.2 +031300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1054.2 +031400 01 XXINFO. SQ1054.2 +031500 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1054.2 +031600 02 INFO-TEXT. SQ1054.2 +031700 04 FILLER PIC X(8) VALUE SPACE. SQ1054.2 +031800 04 XXCOMPUTED PIC X(20). SQ1054.2 +031900 04 FILLER PIC X(5) VALUE SPACE. SQ1054.2 +032000 04 XXCORRECT PIC X(20). SQ1054.2 +032100 02 INF-ANSI-REFERENCE PIC X(48). SQ1054.2 +032200 01 HYPHEN-LINE. SQ1054.2 +032300 02 FILLER PIC IS X VALUE IS SPACE. SQ1054.2 +032400 02 FILLER PIC IS X(65) VALUE IS "************************SQ1054.2 +032500- "*****************************************". SQ1054.2 +032600 02 FILLER PIC IS X(54) VALUE IS "************************SQ1054.2 +032700- "******************************". SQ1054.2 +032800 01 CCVS-PGM-ID PIC X(9) VALUE SQ1054.2 +032900 "SQ105A". SQ1054.2 +033000* SQ1054.2 +033100* SQ1054.2 +033200 PROCEDURE DIVISION. SQ1054.2 +033300 DECLARATIVES. SQ1054.2 +033400 SECT-SQ105-0001 SECTION. SQ1054.2 +033500 USE AFTER STANDARD ERROR PROCEDURE OUTPUT. SQ1054.2 +033600 OUTPUT-ERROR-PROCESS. SQ1054.2 +033700 MOVE "O" TO DECL-EXEC-SW-O. SQ1054.2 +033800 MOVE 2 TO PERM-ERRORS. SQ1054.2 +033900 ADD 1 TO RECORDS-IN-ERROR. SQ1054.2 +034000 IF SQ-FS4-STATUS-1 EQUAL TO "3" SQ1054.2 +034100 MOVE 1 TO PERM-ERRORS. SQ1054.2 +034200 SECT-SQ105-0002 SECTION. SQ1054.2 +034300 USE AFTER ERROR PROCEDURE ON INPUT. SQ1054.2 +034400 INPUT-PROCESS. SQ1054.2 +034500 MOVE "I" TO DECL-EXEC-SW-I. SQ1054.2 +034600 IF SQ-FS4-STATUS-1 EQUAL TO "1" SQ1054.2 +034700 MOVE 1 TO EOF-FLAG. SQ1054.2 +034800 IF SQ-FS4-STATUS-1 GREATER THAN "1" SQ1054.2 +034900 MOVE 1 TO PERM-ERRORS. SQ1054.2 +035000* SQ1054.2 +035100 END DECLARATIVES. SQ1054.2 +035200* SQ1054.2 +035300* SQ1054.2 +035400 CCVS1 SECTION. SQ1054.2 +035500 OPEN-FILES. SQ1054.2 +035600*P OPEN I-O RAW-DATA. SQ1054.2 +035700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1054.2 +035800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1054.2 +035900*P MOVE "ABORTED " TO C-ABORT. SQ1054.2 +036000*P ADD 1 TO C-NO-OF-TESTS. SQ1054.2 +036100*P ACCEPT C-DATE FROM DATE. SQ1054.2 +036200*P ACCEPT C-TIME FROM TIME. SQ1054.2 +036300*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1054.2 +036400*PND-E-1. SQ1054.2 +036500*P CLOSE RAW-DATA. SQ1054.2 +036600 OPEN OUTPUT PRINT-FILE. SQ1054.2 +036700 MOVE CCVS-PGM-ID TO TEST-ID. SQ1054.2 +036800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1054.2 +036900 MOVE SPACE TO TEST-RESULTS. SQ1054.2 +037000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1054.2 +037100 MOVE ZERO TO REC-SKEL-SUB. SQ1054.2 +037200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1054.2 +037300 GO TO CCVS1-EXIT. SQ1054.2 +037400* SQ1054.2 +037500 CCVS-INIT-FILE. SQ1054.2 +037600 ADD 1 TO REC-SKL-SUB. SQ1054.2 +037700 MOVE FILE-RECORD-INFO-SKELETON TO SQ1054.2 +037800 FILE-RECORD-INFO (REC-SKL-SUB). SQ1054.2 +037900* SQ1054.2 +038000 CLOSE-FILES. SQ1054.2 +038100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1054.2 +038200 CLOSE PRINT-FILE. SQ1054.2 +038300*P OPEN I-O RAW-DATA. SQ1054.2 +038400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1054.2 +038500*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1054.2 +038600*P MOVE "OK. " TO C-ABORT. SQ1054.2 +038700*P MOVE PASS-COUNTER TO C-OK. SQ1054.2 +038800*P MOVE ERROR-HOLD TO C-ALL. SQ1054.2 +038900*P MOVE ERROR-COUNTER TO C-FAIL. SQ1054.2 +039000*P MOVE DELETE-CNT TO C-DELETED. SQ1054.2 +039100*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1054.2 +039200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1054.2 +039300*PND-E-2. SQ1054.2 +039400*P CLOSE RAW-DATA. SQ1054.2 +039500 TERMINATE-CCVS. SQ1054.2 +039600*S EXIT PROGRAM. SQ1054.2 +039700 STOP RUN. SQ1054.2 +039800* SQ1054.2 +039900 INSPT. SQ1054.2 +040000 MOVE "INSPT" TO P-OR-F. SQ1054.2 +040100 ADD 1 TO INSPECT-COUNTER. SQ1054.2 +040200 PERFORM PRINT-DETAIL. SQ1054.2 +040300* SQ1054.2 +040400 PASS. SQ1054.2 +040500 MOVE "PASS " TO P-OR-F. SQ1054.2 +040600 ADD 1 TO PASS-COUNTER. SQ1054.2 +040700 PERFORM PRINT-DETAIL. SQ1054.2 +040800* SQ1054.2 +040900 FAIL. SQ1054.2 +041000 MOVE "FAIL*" TO P-OR-F. SQ1054.2 +041100 ADD 1 TO ERROR-COUNTER. SQ1054.2 +041200 PERFORM PRINT-DETAIL. SQ1054.2 +041300* SQ1054.2 +041400 DE-LETE. SQ1054.2 +041500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1054.2 +041600 MOVE "*****" TO P-OR-F. SQ1054.2 +041700 ADD 1 TO DELETE-COUNTER. SQ1054.2 +041800 PERFORM PRINT-DETAIL. SQ1054.2 +041900* SQ1054.2 +042000 PRINT-DETAIL. SQ1054.2 +042100 IF REC-CT NOT EQUAL TO ZERO SQ1054.2 +042200 MOVE "." TO PARDOT-X SQ1054.2 +042300 MOVE REC-CT TO DOTVALUE. SQ1054.2 +042400 MOVE TEST-RESULTS TO PRINT-REC. SQ1054.2 +042500 PERFORM WRITE-LINE. SQ1054.2 +042600 IF P-OR-F EQUAL TO "FAIL*" SQ1054.2 +042700 PERFORM WRITE-LINE SQ1054.2 +042800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1054.2 +042900 ELSE SQ1054.2 +043000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1054.2 +043100 MOVE SPACE TO P-OR-F. SQ1054.2 +043200 MOVE SPACE TO COMPUTED-X. SQ1054.2 +043300 MOVE SPACE TO CORRECT-X. SQ1054.2 +043400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1054.2 +043500 MOVE SPACE TO RE-MARK. SQ1054.2 +043600* SQ1054.2 +043700 HEAD-ROUTINE. SQ1054.2 +043800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +043900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +044000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1054.2 +044100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1054.2 +044200 COLUMN-NAMES-ROUTINE. SQ1054.2 +044300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1054.2 +044400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +044500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1054.2 +044600 END-ROUTINE. SQ1054.2 +044700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1054.2 +044800 PERFORM WRITE-LINE 5 TIMES. SQ1054.2 +044900 END-RTN-EXIT. SQ1054.2 +045000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1054.2 +045100 PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +045200* SQ1054.2 +045300 END-ROUTINE-1. SQ1054.2 +045400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1054.2 +045500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1054.2 +045600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1054.2 +045700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1054.2 +045800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1054.2 +045900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1054.2 +046000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1054.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1054.2 +046200 PERFORM WRITE-LINE. SQ1054.2 +046300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1054.2 +046400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1054.2 +046500 MOVE "NO " TO ERROR-TOTAL SQ1054.2 +046600 ELSE SQ1054.2 +046700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1054.2 +046800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1054.2 +046900 PERFORM WRITE-LINE. SQ1054.2 +047000 END-ROUTINE-13. SQ1054.2 +047100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1054.2 +047200 MOVE "NO " TO ERROR-TOTAL SQ1054.2 +047300 ELSE SQ1054.2 +047400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1054.2 +047500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1054.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1054.2 +047700 PERFORM WRITE-LINE. SQ1054.2 +047800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1054.2 +047900 MOVE "NO " TO ERROR-TOTAL SQ1054.2 +048000 ELSE SQ1054.2 +048100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1054.2 +048200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1054.2 +048300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1054.2 +048400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1054.2 +048500* SQ1054.2 +048600 WRITE-LINE. SQ1054.2 +048700 ADD 1 TO RECORD-COUNT. SQ1054.2 +048800 IF RECORD-COUNT GREATER 50 SQ1054.2 +048900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1054.2 +049000 MOVE SPACE TO DUMMY-RECORD SQ1054.2 +049100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1054.2 +049200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1054.2 +049300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1054.2 +049400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1054.2 +049500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1054.2 +049600 MOVE ZERO TO RECORD-COUNT. SQ1054.2 +049700 PERFORM WRT-LN. SQ1054.2 +049800* SQ1054.2 +049900 WRT-LN. SQ1054.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1054.2 +050100 MOVE SPACE TO DUMMY-RECORD. SQ1054.2 +050200 BLANK-LINE-PRINT. SQ1054.2 +050300 PERFORM WRT-LN. SQ1054.2 +050400 FAIL-ROUTINE. SQ1054.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1054.2 +050600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1054.2 +050700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1054.2 +050800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1054.2 +050900 MOVE XXINFO TO DUMMY-RECORD. SQ1054.2 +051000 PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +051100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1054.2 +051200 GO TO FAIL-ROUTINE-EX. SQ1054.2 +051300 FAIL-ROUTINE-WRITE. SQ1054.2 +051400 MOVE TEST-COMPUTED TO PRINT-REC SQ1054.2 +051500 PERFORM WRITE-LINE SQ1054.2 +051600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1054.2 +051700 MOVE TEST-CORRECT TO PRINT-REC SQ1054.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +051900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1054.2 +052000 FAIL-ROUTINE-EX. SQ1054.2 +052100 EXIT. SQ1054.2 +052200 BAIL-OUT. SQ1054.2 +052300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1054.2 +052400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1054.2 +052500 BAIL-OUT-WRITE. SQ1054.2 +052600 MOVE CORRECT-A TO XXCORRECT. SQ1054.2 +052700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1054.2 +052800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1054.2 +052900 MOVE XXINFO TO DUMMY-RECORD. SQ1054.2 +053000 PERFORM WRITE-LINE 2 TIMES. SQ1054.2 +053100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1054.2 +053200 BAIL-OUT-EX. SQ1054.2 +053300 EXIT. SQ1054.2 +053400 CCVS1-EXIT. SQ1054.2 +053500 EXIT. SQ1054.2 +053600* SQ1054.2 +053700**************************************************************** SQ1054.2 +053800* * SQ1054.2 +053900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1054.2 +054000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1054.2 +054100* * SQ1054.2 +054200**************************************************************** SQ1054.2 +054300* SQ1054.2 +054400 SECT-SQ105-0003 SECTION. SQ1054.2 +054500 INITIAL-PARA. SQ1054.2 +054600 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1054.2 +054700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1054.2 +054800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1054.2 +054900 MOVE 000125 TO XRECORD-LENGTH (1). SQ1054.2 +055000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1054.2 +055100 MOVE 0002 TO XBLOCK-SIZE (1). SQ1054.2 +055200 MOVE 000980 TO RECORDS-IN-FILE (1). SQ1054.2 +055300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1054.2 +055400 MOVE "S" TO XLABEL-TYPE (1). SQ1054.2 +055500 MOVE ZERO TO MAJOR-DELETIONS. SQ1054.2 +055600* SQ1054.2 +055700* THE INITIAL ACTIONS ARE TO CREATE A FILE FOR USE SQ1054.2 +055800* IN LATER TESTS. FILE STATUS VALUES AND DECLARATIVE SQ1054.2 +055900* EXECUTION DURING THE CREATION PROCESS ARE MONITORED. SQ1054.2 +056000* SQ1054.2 +056100 SEQ-INIT-01. SQ1054.2 +056200 MOVE ZERO TO XRECORD-NUMBER (1). SQ1054.2 +056300 MOVE 0 TO COUNT-OF-RECS. SQ1054.2 +056400 MOVE "CREATE 980 RECORD FILE" TO FEATURE. SQ1054.2 +056500 MOVE "SEQ-TEST-WR-01" TO PAR-NAME. SQ1054.2 +056600 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +056700 MOVE "00" TO SQ-FS4-STATUS-COPY. SQ1054.2 +056800 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +056900 MOVE 1 TO REC-CT. SQ1054.2 +057000 GO TO SEQ-TEST-WR-01. SQ1054.2 +057100 SEQ-DELETE-01. SQ1054.2 +057200 MOVE 1 TO MAJOR-DELETIONS. SQ1054.2 +057300 GO TO SEQ-DELETE-01-01. SQ1054.2 +057400 SEQ-TEST-WR-01. SQ1054.2 +057500 OPEN OUTPUT SQ-FS4. SQ1054.2 +057600 IF SQ-FS4-STATUS NOT EQUAL TO "00" SQ1054.2 +057700 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY SQ1054.2 +057800 MOVE "00" TO SQ-FS4-STATUS. SQ1054.2 +057900* SQ1054.2 +058000 SEQ-TEST-WR-01-LOOP. SQ1054.2 +058100 ADD 1 TO XRECORD-NUMBER (1). SQ1054.2 +058200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1054.2 +058300 ADD 1 TO COUNT-OF-RECS. SQ1054.2 +058400 MOVE COUNT-OF-RECS TO SQ-FS4-REC-NO. SQ1054.2 +058500 WRITE SQ-FS4R1-F-G-125. SQ1054.2 +058600 IF SQ-FS4-STATUS NOT EQUAL TO "00" SQ1054.2 +058700 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY SQ1054.2 +058800 MOVE "00" TO SQ-FS4-STATUS. SQ1054.2 +058900 IF PERM-ERRORS EQUAL TO 1 SQ1054.2 +059000 GO TO SEQ-TEST-WR-01-LOOP-EXIT. SQ1054.2 +059100 IF COUNT-OF-RECS LESS THAN 980 SQ1054.2 +059200 GO TO SEQ-TEST-WR-01-LOOP. SQ1054.2 +059300* SQ1054.2 +059400 SEQ-TEST-WR-01-LOOP-EXIT. SQ1054.2 +059500* SQ1054.2 +059600 CLOSE SQ-FS4. SQ1054.2 +059700 IF SQ-FS4-STATUS NOT EQUAL TO "00" SQ1054.2 +059800 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY SQ1054.2 +059900 MOVE "00" TO SQ-FS4-STATUS. SQ1054.2 +060000* SQ1054.2 +060100 GO TO SEQ-TEST-WR-01-01. SQ1054.2 +060200 SEQ-DELETE-01-01. SQ1054.2 +060300 PERFORM DE-LETE. SQ1054.2 +060400 GO TO SEQ-INIT-WR-01-02. SQ1054.2 +060500 SEQ-TEST-WR-01-01. SQ1054.2 +060600* SQ1054.2 +060700 IF SQ-FS4-STATUS-COPY EQUAL "00" SQ1054.2 +060800 PERFORM PASS SQ1054.2 +060900 ELSE SQ1054.2 +061000 MOVE SQ-FS4-STATUS-COPY TO COMPUTED-A SQ1054.2 +061100 MOVE "00" TO CORRECT-A SQ1054.2 +061200 MOVE "ERROR I-O STATUS DURING FILE CREATION" SQ1054.2 +061300 TO RE-MARK SQ1054.2 +061400 PERFORM FAIL. SQ1054.2 +061500* SQ1054.2 +061600 SEQ-INIT-WR-01-02. SQ1054.2 +061700 ADD 1 TO REC-CT. SQ1054.2 +061800 IF MAJOR-DELETIONS = 1 SQ1054.2 +061900 GO TO SEQ-DELETE-01-02. SQ1054.2 +062000 GO TO SEQ-TEST-WR-01-02. SQ1054.2 +062100 SEQ-DELETE-01-02. SQ1054.2 +062200 PERFORM DE-LETE. SQ1054.2 +062300 GO TO SEQ-TEST-01-END. SQ1054.2 +062400 SEQ-TEST-WR-01-02. SQ1054.2 +062500 IF DECL-EXEC-SW = "**" SQ1054.2 +062600 PERFORM PASS SQ1054.2 +062700 ELSE SQ1054.2 +062800 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +062900 MOVE "**" TO CORRECT-A SQ1054.2 +063000 MOVE SQ1054.2 +063100 "UNEXPECTED DECLARATIVE EXECUTION DURING FILE CREATION" SQ1054.2 +063200 TO RE-MARK SQ1054.2 +063300 PERFORM FAIL. SQ1054.2 +063400 SEQ-TEST-01-END. SQ1054.2 +063500* SQ1054.2 +063600* A SEQUENTIAL MASS STORAGE FILE WITH 125 CHARACTER RECORDS, SQ1054.2 +063700* TWO RECORDS PER BLOCK, HAS BEEN CREATED. THE FILE SQ1054.2 +063800* CONTAINS 980 RECORDS. THE FOLLOWING TESTS READ AND SQ1054.2 +063900* VERIFY THE RECORDS IN THE FILE. THE READ STATEMENT DOES SQ1054.2 +064000* NOT CONTAIN AN AT END PHRASE, SO THE INPUT DECLARATIVE SQ1054.2 +064100* SHOULD BE EXECUTED AT THE END OF THE FILE. THE READ SQ1054.2 +064200* STATEMENT CONTAINS THE OPTIONAL WORD "RECORD" SQ1054.2 +064300* SQ1054.2 +064400 SEQ-INIT-02. SQ1054.2 +064500 MOVE 1 TO REC-CT. SQ1054.2 +064600 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +064700 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +064800 MOVE "OPEN FILE FOR CHECK" TO FEATURE. SQ1054.2 +064900 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1054.2 +065000 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +065100 GO TO SEQ-DELETE-02. SQ1054.2 +065200 GO TO SEQ-TEST-GF-02. SQ1054.2 +065300 SEQ-DELETE-02. SQ1054.2 +065400 ADD 2 TO MAJOR-DELETIONS. SQ1054.2 +065500 GO TO SEQ-DELETE-02-01. SQ1054.2 +065600* SQ1054.2 +065700 SEQ-TEST-GF-02. SQ1054.2 +065800 OPEN INPUT SQ-FS4. SQ1054.2 +065900 GO TO SEQ-TEST-GF-02-01. SQ1054.2 +066000 SEQ-DELETE-02-01. SQ1054.2 +066100 PERFORM DE-LETE. SQ1054.2 +066200 GO TO SEQ-TEST-02-01-END. SQ1054.2 +066300 SEQ-TEST-GF-02-01. SQ1054.2 +066400 IF SQ-FS4-STATUS = "00" SQ1054.2 +066500 PERFORM PASS SQ1054.2 +066600 ELSE SQ1054.2 +066700 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +066800 MOVE "00" TO CORRECT-A SQ1054.2 +066900 MOVE "FAILURE STATUS CODE AFTER OPEN" TO RE-MARK SQ1054.2 +067000 PERFORM FAIL. SQ1054.2 +067100 IF SQ-FS4-STATUS GREATER THAN "10" SQ1054.2 +067200 ADD 2 TO MAJOR-DELETIONS. SQ1054.2 +067300 SEQ-TEST-02-01-END. SQ1054.2 +067400* SQ1054.2 +067500 ADD 1 TO REC-CT. SQ1054.2 +067600 GO TO SEQ-TEST-GF-02-02. SQ1054.2 +067700 SEQ-DELETE-02-02. SQ1054.2 +067800 PERFORM DE-LETE. SQ1054.2 +067900 GO TO SEQ-TEST-02-02-END. SQ1054.2 +068000 SEQ-TEST-GF-02-02. SQ1054.2 +068100 IF DECL-EXEC-SW = "**" SQ1054.2 +068200 PERFORM PASS SQ1054.2 +068300 ELSE SQ1054.2 +068400 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +068500 MOVE "**" TO CORRECT-A SQ1054.2 +068600 MOVE "DECLARATIVE EXECUTED ON OPEN" TO RE-MARK SQ1054.2 +068700 PERFORM FAIL. SQ1054.2 +068800 SEQ-TEST-02-02-END. SQ1054.2 +068900* SQ1054.2 +069000 SEQ-INIT-03. SQ1054.2 +069100 MOVE 1 TO REC-CT. SQ1054.2 +069200 MOVE "READ ... RECORD" TO FEATURE. SQ1054.2 +069300 MOVE "SEQ-TEST-GF-03" TO PAR-NAME. SQ1054.2 +069400 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +069500 GO TO SEQ-DELETE-03. SQ1054.2 +069600 GO TO SEQ-TEST-GF-03. SQ1054.2 +069700 SEQ-DELETE-03. SQ1054.2 +069800 ADD 4 TO MAJOR-DELETIONS. SQ1054.2 +069900 GO TO SEQ-DELETE-03-01. SQ1054.2 +070000 SEQ-TEST-GF-03. SQ1054.2 +070100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1054.2 +070200 MOVE ZERO TO COUNT-OF-RECS. SQ1054.2 +070300 MOVE ZERO TO PERM-ERRORS. SQ1054.2 +070400 MOVE ZERO TO RECORDS-IN-ERROR. SQ1054.2 +070500 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +070600 MOVE "00" TO SQ-FS4-STATUS-COPY. SQ1054.2 +070700 SEQ-TEST-03-LOOP. SQ1054.2 +070800 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +070900 READ SQ-FS4 RECORD. SQ1054.2 +071000 IF DECL-EXEC-SW NOT = "**" SQ1054.2 +071100 GO TO SEQ-TEST-GF-03-01. SQ1054.2 +071200 IF SQ-FS4-STATUS = "10" SQ1054.2 +071300 GO TO SEQ-TEST-GF-03-LOOP-END. SQ1054.2 +071400 IF SQ-FS4-STATUS NOT = "00" SQ1054.2 +071500 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY. SQ1054.2 +071600 ADD 1 TO XRECORD-NUMBER (1). SQ1054.2 +071700 ADD 1 TO COUNT-OF-RECS. SQ1054.2 +071800 IF SQ-FS4-FIRST NOT EQUAL TO FILE-RECORD-INFO-P1-120 (1) SQ1054.2 +071900 OR SQ-FS4-REC-NO NOT EQUAL TO COUNT-OF-RECS SQ1054.2 +072000 ADD 1 TO RECORDS-IN-ERROR. SQ1054.2 +072100 IF COUNT-OF-RECS LESS THAN 980 SQ1054.2 +072200 GO TO SEQ-TEST-03-LOOP. SQ1054.2 +072300* SQ1054.2 +072400 SEQ-TEST-GF-03-LOOP-END. SQ1054.2 +072500 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +072600 GO TO SEQ-DELETE-03-01. SQ1054.2 +072700 GO TO SEQ-TEST-GF-03-01. SQ1054.2 +072800 SEQ-DELETE-03-01. SQ1054.2 +072900 PERFORM DE-LETE. SQ1054.2 +073000 GO TO SEQ-TEST-03-01-END. SQ1054.2 +073100 SEQ-TEST-GF-03-01. SQ1054.2 +073200 IF COUNT-OF-RECS EQUAL TO 980 SQ1054.2 +073300 PERFORM PASS SQ1054.2 +073400 ELSE SQ1054.2 +073500 MOVE COUNT-OF-RECS TO COMPUTED-18V0 SQ1054.2 +073600 MOVE 980 TO CORRECT-18V0 SQ1054.2 +073700 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1054.2 +073800 TO RE-MARK SQ1054.2 +073900 PERFORM FAIL. SQ1054.2 +074000 SEQ-TEST-03-01-END. SQ1054.2 +074100* SQ1054.2 +074200 ADD 1 TO REC-CT. SQ1054.2 +074300 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +074400 GO TO SEQ-TEST-03-02-END. SQ1054.2 +074500 GO TO SEQ-TEST-GF-03-02. SQ1054.2 +074600 SEQ-DELETE-03-02. SQ1054.2 +074700 PERFORM DE-LETE. SQ1054.2 +074800 GO TO SEQ-TEST-03-02-END. SQ1054.2 +074900 SEQ-TEST-GF-03-02. SQ1054.2 +075000 IF DECL-EXEC-SW = "**" SQ1054.2 +075100 PERFORM PASS SQ1054.2 +075200 ELSE SQ1054.2 +075300 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +075400 MOVE "**" TO CORRECT-A SQ1054.2 +075500 MOVE "DECLARATIVES ENTERED AT LEAST ONCE" TO RE-MARK SQ1054.2 +075600 PERFORM FAIL. SQ1054.2 +075700 SEQ-TEST-03-02-END. SQ1054.2 +075800* SQ1054.2 +075900 ADD 1 TO REC-CT. SQ1054.2 +076000 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +076100 GO TO SEQ-TEST-03-03-END. SQ1054.2 +076200 GO TO SEQ-TEST-GF-03-03. SQ1054.2 +076300 SEQ-DELETE-03-03. SQ1054.2 +076400 PERFORM DE-LETE. SQ1054.2 +076500 GO TO SEQ-TEST-03-03-END. SQ1054.2 +076600 SEQ-TEST-GF-03-03. SQ1054.2 +076700 IF SQ-FS4-STATUS-COPY = "00" SQ1054.2 +076800 PERFORM PASS SQ1054.2 +076900 ELSE SQ1054.2 +077000 MOVE SQ-FS4-STATUS-COPY TO COMPUTED-A SQ1054.2 +077100 MOVE "00" TO CORRECT-A SQ1054.2 +077200 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1054.2 +077300 MOVE "VII-2" TO ANSI-REFERENCE SQ1054.2 +077400 PERFORM FAIL. SQ1054.2 +077500 SEQ-TEST-03-03-END. SQ1054.2 +077600* SQ1054.2 +077700 ADD 1 TO REC-CT. SQ1054.2 +077800 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +077900 GO TO SEQ-TEST-03-04-END. SQ1054.2 +078000 GO TO SEQ-TEST-GF-03-04. SQ1054.2 +078100 SEQ-DELETE-03-04. SQ1054.2 +078200 PERFORM DE-LETE. SQ1054.2 +078300 GO TO SEQ-TEST-03-04-END. SQ1054.2 +078400 SEQ-TEST-GF-03-04. SQ1054.2 +078500 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1054.2 +078600 PERFORM PASS SQ1054.2 +078700 ELSE SQ1054.2 +078800 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1054.2 +078900 MOVE ZERO TO CORRECT-18V0 SQ1054.2 +079000 MOVE "ONE OR MORE ERRORS IN RECORDS READ" TO RE-MARK SQ1054.2 +079100 PERFORM FAIL. SQ1054.2 +079200 SEQ-TEST-03-04-END. SQ1054.2 +079300* SQ1054.2 +079400* SQ1054.2 +079500 SEQ-INIT-04. SQ1054.2 +079600 MOVE 1 TO REC-CT. SQ1054.2 +079700 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +079800 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +079900 MOVE "READ ... RECORD, EOF" TO FEATURE. SQ1054.2 +080000 MOVE "SEQ-TEST-GF-04" TO PAR-NAME. SQ1054.2 +080100 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +080200 GO TO SEQ-DELETE-04. SQ1054.2 +080300 GO TO SEQ-TEST-GF-04. SQ1054.2 +080400 SEQ-DELETE-04. SQ1054.2 +080500 ADD 8 TO MAJOR-DELETIONS. SQ1054.2 +080600 PERFORM DE-LETE. SQ1054.2 +080700 GO TO SEQ-DELETE-04-01. SQ1054.2 +080800 SEQ-TEST-GF-04. SQ1054.2 +080900 READ SQ-FS4 RECORD. SQ1054.2 +081000* SQ1054.2 +081100 GO TO SEQ-TEST-GF-04-01. SQ1054.2 +081200 SEQ-DELETE-04-01. SQ1054.2 +081300 PERFORM DE-LETE. SQ1054.2 +081400 GO TO SEQ-TEST-04-01-END. SQ1054.2 +081500 SEQ-TEST-GF-04-01. SQ1054.2 +081600 IF SQ-FS4-STATUS = "10" SQ1054.2 +081700 PERFORM PASS SQ1054.2 +081800 ELSE SQ1054.2 +081900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +082000 MOVE "10" TO CORRECT-A SQ1054.2 +082100 MOVE "END OF FILE STATUS CODE NOT GIVEN AT EOF" SQ1054.2 +082200 TO RE-MARK SQ1054.2 +082300 MOVE "VII-3, 1.3.5(2)A" TO ANSI-REFERENCE SQ1054.2 +082400 PERFORM FAIL. SQ1054.2 +082500 SEQ-TEST-04-01-END. SQ1054.2 +082600* SQ1054.2 +082700 ADD 1 TO REC-CT. SQ1054.2 +082800 IF MAJOR-DELETIONS NOT EQUAL TO 0 SQ1054.2 +082900 GO TO SEQ-DELETE-04-02. SQ1054.2 +083000 GO TO SEQ-TEST-GF-04-02. SQ1054.2 +083100 SEQ-DELETE-04-02. SQ1054.2 +083200 PERFORM DE-LETE. SQ1054.2 +083300 GO TO SEQ-TEST-04-02-END. SQ1054.2 +083400 SEQ-TEST-GF-04-02. SQ1054.2 +083500 IF DECL-EXEC-SW EQUAL "*I" SQ1054.2 +083600 PERFORM PASS SQ1054.2 +083700 ELSE SQ1054.2 +083800 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +083900 MOVE "*I" TO CORRECT-A SQ1054.2 +084000 MOVE "CORRECT DECLARATIVE NOT EXECUTED AT EOF" SQ1054.2 +084100 TO RE-MARK SQ1054.2 +084200 MOVE "VII-2, VII-46, 4.4.4(10)C" TO ANSI-REFERENCE SQ1054.2 +084300 PERFORM FAIL. SQ1054.2 +084400 SEQ-TEST-04-02-END. SQ1054.2 +084500* SQ1054.2 +084600* SQ1054.2 +084700 SEQ-INIT-05. SQ1054.2 +084800 MOVE 1 TO REC-CT. SQ1054.2 +084900 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +085000 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +085100 MOVE "CLOSE AFTER READ" TO FEATURE. SQ1054.2 +085200 MOVE "SEQ-TEST-GF-05" TO PAR-NAME. SQ1054.2 +085300 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +085400 GO TO SEQ-DELETE-05. SQ1054.2 +085500 GO TO SEQ-TEST-GF-05. SQ1054.2 +085600 SEQ-DELETE-05. SQ1054.2 +085700 GO TO SEQ-DELETE-05-01. SQ1054.2 +085800 SEQ-TEST-GF-05. SQ1054.2 +085900 CLOSE SQ-FS4. SQ1054.2 +086000* SQ1054.2 +086100 GO TO SEQ-TEST-GF-05-01. SQ1054.2 +086200 SEQ-DELETE-05-01. SQ1054.2 +086300 PERFORM DE-LETE. SQ1054.2 +086400 GO TO SEQ-TEST-05-01-END. SQ1054.2 +086500 SEQ-TEST-GF-05-01. SQ1054.2 +086600 IF SQ-FS4-STATUS = "00" SQ1054.2 +086700 PERFORM PASS SQ1054.2 +086800 ELSE SQ1054.2 +086900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +087000 MOVE "00" TO CORRECT-A SQ1054.2 +087100 MOVE "UNEXPECTED I-O STATUS VALUE FROM CLOSE" SQ1054.2 +087200 TO RE-MARK SQ1054.2 +087300 MOVE "VII-3, VII-38, 4.2.4(4)" TO ANSI-REFERENCE SQ1054.2 +087400 PERFORM FAIL. SQ1054.2 +087500 SEQ-TEST-05-01-END. SQ1054.2 +087600* SQ1054.2 +087700 ADD 1 TO REC-CT. SQ1054.2 +087800 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +087900 GO TO SEQ-DELETE-05-02. SQ1054.2 +088000 GO TO SEQ-TEST-GF-05-02. SQ1054.2 +088100 SEQ-DELETE-05-02. SQ1054.2 +088200 PERFORM DE-LETE. SQ1054.2 +088300 GO TO SEQ-TEST-05-02-END. SQ1054.2 +088400 SEQ-TEST-GF-05-02. SQ1054.2 +088500 IF DECL-EXEC-SW = "**" SQ1054.2 +088600 PERFORM PASS SQ1054.2 +088700 ELSE SQ1054.2 +088800 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +088900 MOVE "**" TO CORRECT-A SQ1054.2 +089000 MOVE "DECLARATIVE EXECUTED ON CLOSE FILE" TO RE-MARK SQ1054.2 +089100 PERFORM FAIL. SQ1054.2 +089200 SEQ-TEST-05-02-END. SQ1054.2 +089300 IF MAJOR-DELETIONS NOT LESS THAN 8 SQ1054.2 +089400 SUBTRACT 8 FROM MAJOR-DELETIONS. SQ1054.2 +089500 IF MAJOR-DELETIONS NOT LESS THAN 4 SQ1054.2 +089600 SUBTRACT 4 FROM MAJOR-DELETIONS. SQ1054.2 +089700 IF MAJOR-DELETIONS NOT LESS THAN 2 SQ1054.2 +089800 SUBTRACT 2 FROM MAJOR-DELETIONS. SQ1054.2 +089900* SQ1054.2 +090000* SQ1054.2 +090100* HAVING PROCESSED THE FILE WITH A READ ... RECORD STATEMENT, SQ1054.2 +090200* IT WILL NOW BE PROCESSED WITH A READ STATEMENT WITHOUT THE SQ1054.2 +090300* OPTIONAL WORD RECORD, AND THE SAME TESTS CARRIED OUT. SQ1054.2 +090400* SQ1054.2 +090500 SEQ-INIT-06. SQ1054.2 +090600 MOVE 1 TO REC-CT. SQ1054.2 +090700 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +090800 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +090900 MOVE "OPEN FILE FOR CHECK" TO FEATURE. SQ1054.2 +091000 MOVE "SEQ-TEST-GF-06" TO PAR-NAME. SQ1054.2 +091100 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +091200 GO TO SEQ-DELETE-06. SQ1054.2 +091300 GO TO SEQ-TEST-GF-06. SQ1054.2 +091400 SEQ-DELETE-06. SQ1054.2 +091500 ADD 2 TO MAJOR-DELETIONS. SQ1054.2 +091600 GO TO SEQ-DELETE-06-01. SQ1054.2 +091700* SQ1054.2 +091800 SEQ-TEST-GF-06. SQ1054.2 +091900 OPEN INPUT SQ-FS4. SQ1054.2 +092000 GO TO SEQ-TEST-GF-06-01. SQ1054.2 +092100 SEQ-DELETE-06-01. SQ1054.2 +092200 PERFORM DE-LETE. SQ1054.2 +092300 GO TO SEQ-TEST-06-01-END. SQ1054.2 +092400 SEQ-TEST-GF-06-01. SQ1054.2 +092500 IF SQ-FS4-STATUS = "00" SQ1054.2 +092600 PERFORM PASS SQ1054.2 +092700 ELSE SQ1054.2 +092800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +092900 MOVE "00" TO CORRECT-A SQ1054.2 +093000 MOVE "FAILURE STATUS CODE AFTER OPEN" TO RE-MARK SQ1054.2 +093100 PERFORM FAIL. SQ1054.2 +093200 IF SQ-FS4-STATUS GREATER THAN "10" SQ1054.2 +093300 ADD 2 TO MAJOR-DELETIONS. SQ1054.2 +093400 SEQ-TEST-06-01-END. SQ1054.2 +093500* SQ1054.2 +093600 ADD 1 TO REC-CT. SQ1054.2 +093700 GO TO SEQ-TEST-GF-06-02. SQ1054.2 +093800 SEQ-DELETE-06-02. SQ1054.2 +093900 PERFORM DE-LETE. SQ1054.2 +094000 GO TO SEQ-TEST-06-02-END. SQ1054.2 +094100 SEQ-TEST-GF-06-02. SQ1054.2 +094200 IF DECL-EXEC-SW = "**" SQ1054.2 +094300 PERFORM PASS SQ1054.2 +094400 ELSE SQ1054.2 +094500 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +094600 MOVE "**" TO CORRECT-A SQ1054.2 +094700 MOVE "DECLARATIVE EXECUTED ON OPEN" TO RE-MARK SQ1054.2 +094800 PERFORM FAIL. SQ1054.2 +094900 SEQ-TEST-06-02-END. SQ1054.2 +095000* SQ1054.2 +095100* SQ1054.2 +095200* THE NEXT GROUP OF TEST READ THE RECORDS FROM THE FILE, SQ1054.2 +095300* USING A READ STATEMENT WITHOUT OPTIONAL PHRASES. THE SQ1054.2 +095400* RECORDS RETURNED FROM THE FILE ARE CHECKED FOR EXPECTED SQ1054.2 +095500* CONTENTS. FILE STATUS VALUES AND EXECUTION OF SQ1054.2 +095600* DECLARATIVE PROCEDURES ARE ALSO CHECKED. SQ1054.2 +095700* SQ1054.2 +095800 SEQ-INIT-07. SQ1054.2 +095900 MOVE 1 TO REC-CT. SQ1054.2 +096000 MOVE "READ ..." TO FEATURE. SQ1054.2 +096100 MOVE "SEQ-TEST-GF-07" TO PAR-NAME. SQ1054.2 +096200 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +096300 GO TO SEQ-DELETE-07. SQ1054.2 +096400 GO TO SEQ-TEST-GF-07. SQ1054.2 +096500 SEQ-DELETE-07. SQ1054.2 +096600 ADD 4 TO MAJOR-DELETIONS. SQ1054.2 +096700 GO TO SEQ-DELETE-07-01. SQ1054.2 +096800 SEQ-TEST-GF-07. SQ1054.2 +096900 MOVE ZERO TO XRECORD-NUMBER (1). SQ1054.2 +097000 MOVE ZERO TO COUNT-OF-RECS. SQ1054.2 +097100 MOVE ZERO TO PERM-ERRORS. SQ1054.2 +097200 MOVE ZERO TO RECORDS-IN-ERROR. SQ1054.2 +097300 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +097400 MOVE "00" TO SQ-FS4-STATUS-COPY. SQ1054.2 +097500 SEQ-TEST-07-LOOP. SQ1054.2 +097600 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +097700 READ SQ-FS4. SQ1054.2 +097800 IF DECL-EXEC-SW NOT = "**" SQ1054.2 +097900 GO TO SEQ-TEST-GF-07-01. SQ1054.2 +098000 IF SQ-FS4-STATUS = "10" SQ1054.2 +098100 GO TO SEQ-TEST-GF-07-LOOP-END. SQ1054.2 +098200 IF SQ-FS4-STATUS NOT = "00" SQ1054.2 +098300 MOVE SQ-FS4-STATUS TO SQ-FS4-STATUS-COPY. SQ1054.2 +098400 ADD 1 TO XRECORD-NUMBER (1). SQ1054.2 +098500 ADD 1 TO COUNT-OF-RECS. SQ1054.2 +098600 IF SQ-FS4-FIRST NOT EQUAL TO FILE-RECORD-INFO-P1-120 (1) SQ1054.2 +098700 OR SQ-FS4-REC-NO NOT EQUAL TO COUNT-OF-RECS SQ1054.2 +098800 ADD 1 TO RECORDS-IN-ERROR. SQ1054.2 +098900 IF COUNT-OF-RECS LESS THAN 980 SQ1054.2 +099000 GO TO SEQ-TEST-07-LOOP. SQ1054.2 +099100* SQ1054.2 +099200 SEQ-TEST-GF-07-LOOP-END. SQ1054.2 +099300 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +099400 GO TO SEQ-DELETE-07-01. SQ1054.2 +099500 GO TO SEQ-TEST-GF-07-01. SQ1054.2 +099600 SEQ-DELETE-07-01. SQ1054.2 +099700 PERFORM DE-LETE. SQ1054.2 +099800 GO TO SEQ-TEST-07-01-END. SQ1054.2 +099900 SEQ-TEST-GF-07-01. SQ1054.2 +100000 IF COUNT-OF-RECS EQUAL TO 980 SQ1054.2 +100100 PERFORM PASS SQ1054.2 +100200 ELSE SQ1054.2 +100300 MOVE COUNT-OF-RECS TO COMPUTED-18V0 SQ1054.2 +100400 MOVE 980 TO CORRECT-18V0 SQ1054.2 +100500 MOVE "UNEXPECTED NUMBER OF RECORDS BEFORE EOF" SQ1054.2 +100600 TO RE-MARK SQ1054.2 +100700 PERFORM FAIL. SQ1054.2 +100800 SEQ-TEST-07-01-END. SQ1054.2 +100900* SQ1054.2 +101000 ADD 1 TO REC-CT. SQ1054.2 +101100 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +101200 GO TO SEQ-TEST-07-02-END. SQ1054.2 +101300 GO TO SEQ-TEST-GF-07-02. SQ1054.2 +101400 SEQ-DELETE-07-02. SQ1054.2 +101500 PERFORM DE-LETE. SQ1054.2 +101600 GO TO SEQ-TEST-07-02-END. SQ1054.2 +101700 SEQ-TEST-GF-07-02. SQ1054.2 +101800 IF DECL-EXEC-SW = "**" SQ1054.2 +101900 PERFORM PASS SQ1054.2 +102000 ELSE SQ1054.2 +102100 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +102200 MOVE "**" TO CORRECT-A SQ1054.2 +102300 MOVE "DECLARATIVES ENTERED AT LEAST ONCE" TO RE-MARK SQ1054.2 +102400 PERFORM FAIL. SQ1054.2 +102500 SEQ-TEST-07-02-END. SQ1054.2 +102600* SQ1054.2 +102700 ADD 1 TO REC-CT. SQ1054.2 +102800 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +102900 GO TO SEQ-TEST-07-03-END. SQ1054.2 +103000 GO TO SEQ-TEST-GF-07-03. SQ1054.2 +103100 SEQ-DELETE-07-03. SQ1054.2 +103200 PERFORM DE-LETE. SQ1054.2 +103300 GO TO SEQ-TEST-07-03-END. SQ1054.2 +103400 SEQ-TEST-GF-07-03. SQ1054.2 +103500 IF SQ-FS4-STATUS-COPY = "00" SQ1054.2 +103600 PERFORM PASS SQ1054.2 +103700 ELSE SQ1054.2 +103800 MOVE SQ-FS4-STATUS-COPY TO COMPUTED-A SQ1054.2 +103900 MOVE "00" TO CORRECT-A SQ1054.2 +104000 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1054.2 +104100 MOVE "VII-2" TO ANSI-REFERENCE SQ1054.2 +104200 PERFORM FAIL. SQ1054.2 +104300 SEQ-TEST-07-03-END. SQ1054.2 +104400* SQ1054.2 +104500 ADD 1 TO REC-CT. SQ1054.2 +104600 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +104700 GO TO SEQ-TEST-07-04-END. SQ1054.2 +104800 GO TO SEQ-TEST-GF-07-04. SQ1054.2 +104900 SEQ-DELETE-07-04. SQ1054.2 +105000 PERFORM DE-LETE. SQ1054.2 +105100 GO TO SEQ-TEST-07-04-END. SQ1054.2 +105200 SEQ-TEST-GF-07-04. SQ1054.2 +105300 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1054.2 +105400 PERFORM PASS SQ1054.2 +105500 ELSE SQ1054.2 +105600 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1054.2 +105700 MOVE ZERO TO CORRECT-18V0 SQ1054.2 +105800 MOVE "ONE OR MORE ERRORS IN RECORDS READ" TO RE-MARK SQ1054.2 +105900 PERFORM FAIL. SQ1054.2 +106000 SEQ-TEST-07-04-END. SQ1054.2 +106100* SQ1054.2 +106200* SQ1054.2 +106300* THE NEXT TEST EXECUTES ONE READ STATEMENT WITH THE FILE SQ1054.2 +106400* POSITIONED AFTER THE LAST RECORD. THE READ STATEMENT DOES SQ1054.2 +106500* NOT CONTAIN AN AT END PHRASE, SO THE APPROPRIATE SQ1054.2 +106600* DECLARATIVE SHOULD BE EXECUTED. SQ1054.2 +106700* SQ1054.2 +106800 SEQ-INIT-08. SQ1054.2 +106900 MOVE 1 TO REC-CT. SQ1054.2 +107000 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +107100 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +107200 MOVE "READ ... EOF" TO FEATURE. SQ1054.2 +107300 MOVE "SEQ-TEST-GF-08" TO PAR-NAME. SQ1054.2 +107400 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +107500 GO TO SEQ-DELETE-08. SQ1054.2 +107600 GO TO SEQ-TEST-GF-08. SQ1054.2 +107700 SEQ-DELETE-08. SQ1054.2 +107800 ADD 8 TO MAJOR-DELETIONS. SQ1054.2 +107900 PERFORM DE-LETE. SQ1054.2 +108000 GO TO SEQ-DELETE-08-01. SQ1054.2 +108100 SEQ-TEST-GF-08. SQ1054.2 +108200 READ SQ-FS4. SQ1054.2 +108300* SQ1054.2 +108400 GO TO SEQ-TEST-GF-08-01. SQ1054.2 +108500 SEQ-DELETE-08-01. SQ1054.2 +108600 PERFORM DE-LETE. SQ1054.2 +108700 GO TO SEQ-TEST-08-01-END. SQ1054.2 +108800 SEQ-TEST-GF-08-01. SQ1054.2 +108900 IF SQ-FS4-STATUS = "10" SQ1054.2 +109000 PERFORM PASS SQ1054.2 +109100 ELSE SQ1054.2 +109200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +109300 MOVE "10" TO CORRECT-A SQ1054.2 +109400 MOVE "END OF FILE STATUS CODE NOT GIVEN AT EOF" SQ1054.2 +109500 TO RE-MARK SQ1054.2 +109600 MOVE "VII-3, 1.3.5(2)A" TO ANSI-REFERENCE SQ1054.2 +109700 PERFORM FAIL. SQ1054.2 +109800 SEQ-TEST-08-01-END. SQ1054.2 +109900* SQ1054.2 +110000 ADD 1 TO REC-CT. SQ1054.2 +110100 IF MAJOR-DELETIONS NOT EQUAL TO 0 SQ1054.2 +110200 GO TO SEQ-DELETE-08-02. SQ1054.2 +110300 GO TO SEQ-TEST-GF-08-02. SQ1054.2 +110400 SEQ-DELETE-08-02. SQ1054.2 +110500 PERFORM DE-LETE. SQ1054.2 +110600 GO TO SEQ-TEST-08-02-END. SQ1054.2 +110700 SEQ-TEST-GF-08-02. SQ1054.2 +110800 IF DECL-EXEC-SW EQUAL "*I" SQ1054.2 +110900 PERFORM PASS SQ1054.2 +111000 ELSE SQ1054.2 +111100 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +111200 MOVE "*I" TO CORRECT-A SQ1054.2 +111300 MOVE "CORRECT DECLARATIVE NOT EXECUTED AT EOF" SQ1054.2 +111400 TO RE-MARK SQ1054.2 +111500 MOVE "VII-2, VII-46, 4.4.4(10)C" TO ANSI-REFERENCE SQ1054.2 +111600 PERFORM FAIL. SQ1054.2 +111700 SEQ-TEST-08-02-END. SQ1054.2 +111800* SQ1054.2 +111900* SQ1054.2 +112000* CLOSE THE FILE AND CHECK FILE STATUS AND THAT THE SQ1054.2 +112100* DECLARATIVE IS NOT EXECUTED SQ1054.2 +112200* SQ1054.2 +112300 SEQ-INIT-09. SQ1054.2 +112400 MOVE 1 TO REC-CT. SQ1054.2 +112500 MOVE "**" TO SQ-FS4-STATUS. SQ1054.2 +112600 MOVE "**" TO DECL-EXEC-SW. SQ1054.2 +112700 MOVE "CLOSE AFTER READ" TO FEATURE. SQ1054.2 +112800 MOVE "SEQ-TEST-GF-09" TO PAR-NAME. SQ1054.2 +112900 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +113000 GO TO SEQ-DELETE-09. SQ1054.2 +113100 GO TO SEQ-TEST-GF-09. SQ1054.2 +113200 SEQ-DELETE-09. SQ1054.2 +113300 GO TO SEQ-DELETE-09-01. SQ1054.2 +113400 SEQ-TEST-GF-09. SQ1054.2 +113500 CLOSE SQ-FS4. SQ1054.2 +113600* SQ1054.2 +113700 GO TO SEQ-TEST-GF-09-01. SQ1054.2 +113800 SEQ-DELETE-09-01. SQ1054.2 +113900 PERFORM DE-LETE. SQ1054.2 +114000 GO TO SEQ-TEST-09-01-END. SQ1054.2 +114100 SEQ-TEST-GF-09-01. SQ1054.2 +114200 IF SQ-FS4-STATUS = "00" SQ1054.2 +114300 PERFORM PASS SQ1054.2 +114400 ELSE SQ1054.2 +114500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1054.2 +114600 MOVE "00" TO CORRECT-A SQ1054.2 +114700 MOVE "UNEXPECTED I-O STATUS VALUE FROM CLOSE" SQ1054.2 +114800 TO RE-MARK SQ1054.2 +114900 MOVE "VII-3, VII-38, 4.2.4(4)" TO ANSI-REFERENCE SQ1054.2 +115000 PERFORM FAIL. SQ1054.2 +115100 SEQ-TEST-09-01-END. SQ1054.2 +115200* SQ1054.2 +115300 ADD 1 TO REC-CT. SQ1054.2 +115400 IF MAJOR-DELETIONS NOT = 0 SQ1054.2 +115500 GO TO SEQ-DELETE-09-02. SQ1054.2 +115600 GO TO SEQ-TEST-GF-09-02. SQ1054.2 +115700 SEQ-DELETE-09-02. SQ1054.2 +115800 PERFORM DE-LETE. SQ1054.2 +115900 GO TO SEQ-TEST-09-02-END. SQ1054.2 +116000 SEQ-TEST-GF-09-02. SQ1054.2 +116100 IF DECL-EXEC-SW = "**" SQ1054.2 +116200 PERFORM PASS SQ1054.2 +116300 ELSE SQ1054.2 +116400 MOVE DECL-EXEC-SW TO COMPUTED-A SQ1054.2 +116500 MOVE "**" TO CORRECT-A SQ1054.2 +116600 MOVE "DECLARATIVE EXECUTED ON CLOSE FILE" TO RE-MARK SQ1054.2 +116700 PERFORM FAIL. SQ1054.2 +116800 SEQ-TEST-09-02-END. SQ1054.2 +116900* SQ1054.2 +117000 TERMINATE-ROUTINE. SQ1054.2 +117100 EXIT. SQ1054.2 +117200 CCVS-EXIT SECTION. SQ1054.2 +117300 CCVS-999999. SQ1054.2 +117400 GO TO CLOSE-FILES. SQ1054.2 diff --git a/tests/cobol85/SQ/SQ106A.CBL b/tests/cobol85/SQ/SQ106A.CBL new file mode 100755 index 00000000..a86a7948 --- /dev/null +++ b/tests/cobol85/SQ/SQ106A.CBL @@ -0,0 +1,2660 @@ +000100 IDENTIFICATION DIVISION. SQ1064.2 +000200 PROGRAM-ID. SQ1064.2 +000300 SQ106A. SQ1064.2 +000400**************************************************************** SQ1064.2 +000500* * SQ1064.2 +000600* VALIDATION FOR:- * SQ1064.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1064.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1064.2 +000900* REVISED 1986, AUGUST * SQ1064.2 +001000* * SQ1064.2 +001100* CREATION DATE / VALIDATION DATE * SQ1064.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1064.2 +001300* * SQ1064.2 +001400**************************************************************** SQ1064.2 +001500* * SQ1064.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1064.2 +001700* * SQ1064.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE * SQ1064.2 +001900* X-55 SYSTEM PRINTER * SQ1064.2 +002000* X-82 SOURCE-COMPUTER * SQ1064.2 +002100* X-83 OBJECT-COMPUTER. * SQ1064.2 +002200* * SQ1064.2 +002300**************************************************************** SQ1064.2 +002400 SQ1064.2 +002500* THIS PROGRAM BUILDS A SEQUENTIAL TAPE FILE WHICH CONTAINS * SQ1064.2 +002600* BOTH 120 CHARACTER AND 151 CHARACTER RECORDS. * SQ1064.2 +002700* * SQ1064.2 +002800* THE SEQUENCE OF RECORD TYPES IS SLSSLSLLLSS, WHERE S * SQ1064.2 +002900* INDICATES 120 CHARACTERS AND L INDICATES 151 CHARACTERS, * SQ1064.2 +003000* FOR A TOTAL OF 11 RECORDS IN THE FILE. SIX OF THE * SQ1064.2 +003100* RECORDS ARE WRITEN USING WRITE FROM, THE OTHERS USING A * SQ1064.2 +003200* WRITE STATEMENT WITHOUT THE FROM PHRASE. THE FILE IS * SQ1064.2 +003300* THEN CLOSED AND REOPENED FOR INPUT. IT IS READ USING * SQ1064.2 +003400* TWELVE DIFFERENT FORMATS OF THE READ STATEMENT. THE * SQ1064.2 +003500* VARIANTS ARE PRODUCED BY INCLUDING OR OMITTING THE NOT AT * SQ1064.2 +003600* END AND END-READ PHRASES, AND INCLUDING OR EXCLUDING THE * SQ1064.2 +003700* OPTIONAL WORD "AT" IN THE END AND NOT END PHRASES. * SQ1064.2 +003800* FIELDS IN EACH RECORD ARE CHECKED AGAINST THE EXPECTED * SQ1064.2 +003900* VALUES. * SQ1064.2 +004000* * SQ1064.2 +004100* WHERE A SHORT RECORD IS EXPECTED, A CHECK IS MADE THAT * SQ1064.2 +004200* THE RECORD AREA DOES NOT CONTAIN THE VALUES THAT WERE * SQ1064.2 +004300* PRESENT IN THAT PART OF THE RECORD AREA BEYOND THE RECORD * SQ1064.2 +004400* WHEN IT WAS WRITTEN. THIS ASSUMPTION IS NOT FULLY * SQ1064.2 +004500* JUSTIFIED, AS THE CONTENT OF THE RECORD AREA BEYOND THE * SQ1064.2 +004600* END OF THE RECORD WHEN A SHORT RECORD IS READ IS * SQ1064.2 +004700* UNDEFINED, BUT IT IS UNLIKELY THAT THE VALUES TESTED FOR * SQ1064.2 +004800* WOULD OCCUR BY CHANCE. * SQ1064.2 +004900* * SQ1064.2 +005000**************************************************************** SQ1064.2 +005100* SQ1064.2 +005200 ENVIRONMENT DIVISION. SQ1064.2 +005300 CONFIGURATION SECTION. SQ1064.2 +005400 SOURCE-COMPUTER. SQ1064.2 +005500 Linux. SQ1064.2 +005600 OBJECT-COMPUTER. SQ1064.2 +005700 Linux. SQ1064.2 +005800 INPUT-OUTPUT SECTION. SQ1064.2 +005900 FILE-CONTROL. SQ1064.2 +006000*P SELECT RAW-DATA ASSIGN TO SQ1064.2 +006100*P "XXXXX062" SQ1064.2 +006200*P ORGANIZATION IS INDEXED SQ1064.2 +006300*P ACCESS MODE IS RANDOM SQ1064.2 +006400*P RECORD KEY IS RAW-DATA-KEY. SQ1064.2 +006500* SQ1064.2 +006600 SELECT PRINT-FILE ASSIGN TO SQ1064.2 +006700 "report.log". SQ1064.2 +006800* SQ1064.2 +006900 SELECT SQ-VS6 ASSIGN SQ1064.2 +007000 "XXXXX001" SQ1064.2 +007100 STATUS SQ-STATUS SQ1064.2 +007200 ORGANIZATION IS SEQUENTIAL. SQ1064.2 +007300* SQ1064.2 +007400* SQ1064.2 +007500 DATA DIVISION. SQ1064.2 +007600 FILE SECTION. SQ1064.2 +007700*P SQ1064.2 +007800*PD RAW-DATA. SQ1064.2 +007900*P SQ1064.2 +008000*P1 RAW-DATA-SATZ. SQ1064.2 +008100*P 05 RAW-DATA-KEY PIC X(6). SQ1064.2 +008200*P 05 C-DATE PIC 9(6). SQ1064.2 +008300*P 05 C-TIME PIC 9(8). SQ1064.2 +008400*P 05 C-NO-OF-TESTS PIC 99. SQ1064.2 +008500*P 05 C-OK PIC 999. SQ1064.2 +008600*P 05 C-ALL PIC 999. SQ1064.2 +008700*P 05 C-FAIL PIC 999. SQ1064.2 +008800*P 05 C-DELETED PIC 999. SQ1064.2 +008900*P 05 C-INSPECT PIC 999. SQ1064.2 +009000*P 05 C-NOTE PIC X(13). SQ1064.2 +009100*P 05 C-INDENT PIC X. SQ1064.2 +009200*P 05 C-ABORT PIC X(8). SQ1064.2 +009300* SQ1064.2 +009400 FD PRINT-FILE SQ1064.2 +009500*C LABEL RECORDS SQ1064.2 +009600*C OMITTED SQ1064.2 +009700*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1064.2 +009800 . SQ1064.2 +009900 01 PRINT-REC PICTURE X(120). SQ1064.2 +010000 01 DUMMY-RECORD PICTURE X(120). SQ1064.2 +010100* SQ1064.2 +010200* SQ1064.2 +010300 FD SQ-VS6 SQ1064.2 +010400*C LABEL RECORDS ARE STANDARD SQ1064.2 +010500*C DATA RECORDS ARE SQ-VS6R1-M-G-120 SQ-VS6R2-M-G-151 SQ1064.2 +010600 RECORD CONTAINS 120 TO 151 CHARACTERS. SQ1064.2 +010700* SQ1064.2 +010800 01 SQ-VS6R1-M-G-120. SQ1064.2 +010900 02 SQ-VS6R1-FIRST PIC X(120). SQ1064.2 +011000* SQ1064.2 +011100 01 SQ-VS6R2-M-G-151. SQ1064.2 +011200 02 SQ-VS6R2-FIRST PIC X(120). SQ1064.2 +011300 02 SQ-VS6R2-SECOND. SQ1064.2 +011400 05 SQ-VS6R2-SECOND-L. SQ1064.2 +011500 07 LONG-OR-SHORT PIC X(5). SQ1064.2 +011600 07 SQ-VS6-RECNO PIC X(5). SQ1064.2 +011700 05 SQ-VS6R2-SECOND-R. SQ1064.2 +011800 07 SQ-VS6-FILLER PIC X(21). SQ1064.2 +011900* SQ1064.2 +012000* SQ1064.2 +012100 WORKING-STORAGE SECTION. SQ1064.2 +012200* SQ1064.2 +012300*************************************************************** SQ1064.2 +012400* * SQ1064.2 +012500* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1064.2 +012600* * SQ1064.2 +012700*************************************************************** SQ1064.2 +012800* SQ1064.2 +012900 01 SQ-STATUS. SQ1064.2 +013000 03 SQ-STATUS-1 PIC X. SQ1064.2 +013100 03 SQ-STATUS-2 PIC X. SQ1064.2 +013200* SQ1064.2 +013300 01 BUFFER-COPY. SQ1064.2 +013400 03 BUFFER-COPY-120 PIC X(120). SQ1064.2 +013500 03 BUFFER-COPY-SECOND. SQ1064.2 +013600 05 BUFFER-COPY-SECOND-L. SQ1064.2 +013700 07 BUFFER-COPY-L-OR-S PIC X(5). SQ1064.2 +013800 07 BUFFER-COPY-RECNO PIC 9(5). SQ1064.2 +013900 05 BUFFER-COPY-SECOND-R. SQ1064.2 +014000 07 BUFFER-COPY-END PIC X(21). SQ1064.2 +014100* SQ1064.2 +014200 01 EOF-FLAG PIC X(12). SQ1064.2 +014300 01 NOT-EOF-FLAG PIC X(12). SQ1064.2 +014400 01 END-READ-FLAG PIC X(12). SQ1064.2 +014500* SQ1064.2 +014600 01 DELETE-SW. SQ1064.2 +014700 03 DELETE-SW-1 PIC X. SQ1064.2 +014800 03 DELETE-SW-1-GROUP. SQ1064.2 +014900 05 DELETE-SW-2 PIC X. SQ1064.2 +015000 05 DELETE-SW-2-GROUP. SQ1064.2 +015100 07 DELETE-SW-3 PIC X. SQ1064.2 +015200* SQ1064.2 +015300*************************************************************** SQ1064.2 +015400* * SQ1064.2 +015500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1064.2 +015600* * SQ1064.2 +015700*************************************************************** SQ1064.2 +015800* SQ1064.2 +015900 01 REC-SKEL-SUB PIC 99. SQ1064.2 +016000* SQ1064.2 +016100 01 FILE-RECORD-INFORMATION-REC. SQ1064.2 +016200 03 FILE-RECORD-INFO-SKELETON. SQ1064.2 +016300 05 FILLER PICTURE X(48) VALUE SQ1064.2 +016400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1064.2 +016500 05 FILLER PICTURE X(46) VALUE SQ1064.2 +016600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1064.2 +016700 05 FILLER PICTURE X(26) VALUE SQ1064.2 +016800 ",LFIL=000000,ORG= ,LBLR= ". SQ1064.2 +016900 05 FILLER PICTURE X(37) VALUE SQ1064.2 +017000 ",RECKEY= ". SQ1064.2 +017100 05 FILLER PICTURE X(38) VALUE SQ1064.2 +017200 ",ALTKEY1= ". SQ1064.2 +017300 05 FILLER PICTURE X(38) VALUE SQ1064.2 +017400 ",ALTKEY2= ". SQ1064.2 +017500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1064.2 +017600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1064.2 +017700 05 FILE-RECORD-INFO-P1-120. SQ1064.2 +017800 07 FILLER PIC X(5). SQ1064.2 +017900 07 XFILE-NAME PIC X(6). SQ1064.2 +018000 07 FILLER PIC X(8). SQ1064.2 +018100 07 XRECORD-NAME PIC X(6). SQ1064.2 +018200 07 FILLER PIC X(1). SQ1064.2 +018300 07 REELUNIT-NUMBER PIC 9(1). SQ1064.2 +018400 07 FILLER PIC X(7). SQ1064.2 +018500 07 XRECORD-NUMBER PIC 9(6). SQ1064.2 +018600 07 FILLER PIC X(6). SQ1064.2 +018700 07 UPDATE-NUMBER PIC 9(2). SQ1064.2 +018800 07 FILLER PIC X(5). SQ1064.2 +018900 07 ODO-NUMBER PIC 9(4). SQ1064.2 +019000 07 FILLER PIC X(5). SQ1064.2 +019100 07 XPROGRAM-NAME PIC X(5). SQ1064.2 +019200 07 FILLER PIC X(7). SQ1064.2 +019300 07 XRECORD-LENGTH PIC 9(6). SQ1064.2 +019400 07 FILLER PIC X(7). SQ1064.2 +019500 07 CHARS-OR-RECORDS PIC X(2). SQ1064.2 +019600 07 FILLER PIC X(1). SQ1064.2 +019700 07 XBLOCK-SIZE PIC 9(4). SQ1064.2 +019800 07 FILLER PIC X(6). SQ1064.2 +019900 07 RECORDS-IN-FILE PIC 9(6). SQ1064.2 +020000 07 FILLER PIC X(5). SQ1064.2 +020100 07 XFILE-ORGANIZATION PIC X(2). SQ1064.2 +020200 07 FILLER PIC X(6). SQ1064.2 +020300 07 XLABEL-TYPE PIC X(1). SQ1064.2 +020400 05 FILE-RECORD-INFO-P121-240. SQ1064.2 +020500 07 FILLER PIC X(8). SQ1064.2 +020600 07 XRECORD-KEY PIC X(29). SQ1064.2 +020700 07 FILLER PIC X(9). SQ1064.2 +020800 07 ALTERNATE-KEY1 PIC X(29). SQ1064.2 +020900 07 FILLER PIC X(9). SQ1064.2 +021000 07 ALTERNATE-KEY2 PIC X(29). SQ1064.2 +021100 07 FILLER PIC X(7). SQ1064.2 +021200* SQ1064.2 +021300 01 TEST-RESULTS. SQ1064.2 +021400 02 FILLER PIC X VALUE SPACE. SQ1064.2 +021500 02 PAR-NAME. SQ1064.2 +021600 03 FILLER PIC X(14) VALUE SPACE. SQ1064.2 +021700 03 PARDOT-X PIC X VALUE SPACE. SQ1064.2 +021800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1064.2 +021900 02 FILLER PIC X VALUE SPACE. SQ1064.2 +022000 02 FEATURE PIC X(24) VALUE SPACE. SQ1064.2 +022100 02 FILLER PIC X VALUE SPACE. SQ1064.2 +022200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1064.2 +022300 02 FILLER PIC X(9) VALUE SPACE. SQ1064.2 +022400 02 RE-MARK PIC X(61). SQ1064.2 +022500 01 TEST-COMPUTED. SQ1064.2 +022600 02 FILLER PIC X(30) VALUE SPACE. SQ1064.2 +022700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1064.2 +022800 02 COMPUTED-X. SQ1064.2 +022900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1064.2 +023000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1064.2 +023100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1064.2 +023200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1064.2 +023300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1064.2 +023400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1064.2 +023500 04 COMPUTED-18V0 PIC -9(18). SQ1064.2 +023600 04 FILLER PIC X. SQ1064.2 +023700 03 FILLER PIC X(50) VALUE SPACE. SQ1064.2 +023800 01 TEST-CORRECT. SQ1064.2 +023900 02 FILLER PIC X(30) VALUE SPACE. SQ1064.2 +024000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1064.2 +024100 02 CORRECT-X. SQ1064.2 +024200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1064.2 +024300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1064.2 +024400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1064.2 +024500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1064.2 +024600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1064.2 +024700 03 CR-18V0 REDEFINES CORRECT-A. SQ1064.2 +024800 04 CORRECT-18V0 PIC -9(18). SQ1064.2 +024900 04 FILLER PIC X. SQ1064.2 +025000 03 FILLER PIC X(2) VALUE SPACE. SQ1064.2 +025100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1064.2 +025200* SQ1064.2 +025300 01 CCVS-C-1. SQ1064.2 +025400 02 FILLER PIC IS X VALUE SPACE. SQ1064.2 +025500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1064.2 +025600 02 FILLER PIC IS X VALUE SPACE. SQ1064.2 +025700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1064.2 +025800 02 FILLER PIC IS X VALUE SPACE. SQ1064.2 +025900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1064.2 +026000 02 FILLER PIC IS X(9) VALUE SPACE. SQ1064.2 +026100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1064.2 +026200 01 CCVS-C-2. SQ1064.2 +026300 02 FILLER PIC X(19) VALUE SPACE. SQ1064.2 +026400 02 FILLER PIC X(6) VALUE "TESTED". SQ1064.2 +026500 02 FILLER PIC X(19) VALUE SPACE. SQ1064.2 +026600 02 FILLER PIC X(4) VALUE "FAIL". SQ1064.2 +026700 02 FILLER PIC X(72) VALUE SPACE. SQ1064.2 +026800* SQ1064.2 +026900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1064.2 +027000 01 REC-CT PIC 99 VALUE ZERO. SQ1064.2 +027100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1064.2 +027200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1064.2 +027300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1064.2 +027400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1064.2 +027500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1064.2 +027600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1064.2 +027700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1064.2 +027800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1064.2 +027900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1064.2 +028000 01 CCVS-H-1. SQ1064.2 +028100 02 FILLER PIC X(39) VALUE SPACES. SQ1064.2 +028200 02 FILLER PIC X(42) VALUE SQ1064.2 +028300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1064.2 +028400 02 FILLER PIC X(39) VALUE SPACES. SQ1064.2 +028500 01 CCVS-H-2A. SQ1064.2 +028600 02 FILLER PIC X(40) VALUE SPACE. SQ1064.2 +028700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1064.2 +028800 02 FILLER PIC XXXX VALUE SQ1064.2 +028900 "4.2 ". SQ1064.2 +029000 02 FILLER PIC X(28) VALUE SQ1064.2 +029100 " COPY - NOT FOR DISTRIBUTION". SQ1064.2 +029200 02 FILLER PIC X(41) VALUE SPACE. SQ1064.2 +029300* SQ1064.2 +029400 01 CCVS-H-2B. SQ1064.2 +029500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1064.2 +029600 02 TEST-ID PIC X(9). SQ1064.2 +029700 02 FILLER PIC X(4) VALUE " IN ". SQ1064.2 +029800 02 FILLER PIC X(12) VALUE SQ1064.2 +029900 " HIGH ". SQ1064.2 +030000 02 FILLER PIC X(22) VALUE SQ1064.2 +030100 " LEVEL VALIDATION FOR ". SQ1064.2 +030200 02 FILLER PIC X(58) VALUE SQ1064.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1064.2 +030400 01 CCVS-H-3. SQ1064.2 +030500 02 FILLER PIC X(34) VALUE SQ1064.2 +030600 " FOR OFFICIAL USE ONLY ". SQ1064.2 +030700 02 FILLER PIC X(58) VALUE SQ1064.2 +030800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1064.2 +030900 02 FILLER PIC X(28) VALUE SQ1064.2 +031000 " COPYRIGHT 1985,1986 ". SQ1064.2 +031100 01 CCVS-E-1. SQ1064.2 +031200 02 FILLER PIC X(52) VALUE SPACE. SQ1064.2 +031300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1064.2 +031400 02 ID-AGAIN PIC X(9). SQ1064.2 +031500 02 FILLER PIC X(45) VALUE SPACES. SQ1064.2 +031600 01 CCVS-E-2. SQ1064.2 +031700 02 FILLER PIC X(31) VALUE SPACE. SQ1064.2 +031800 02 FILLER PIC X(21) VALUE SPACE. SQ1064.2 +031900 02 CCVS-E-2-2. SQ1064.2 +032000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1064.2 +032100 03 FILLER PIC X VALUE SPACE. SQ1064.2 +032200 03 ENDER-DESC PIC X(44) VALUE SQ1064.2 +032300 "ERRORS ENCOUNTERED". SQ1064.2 +032400 01 CCVS-E-3. SQ1064.2 +032500 02 FILLER PIC X(22) VALUE SQ1064.2 +032600 " FOR OFFICIAL USE ONLY". SQ1064.2 +032700 02 FILLER PIC X(12) VALUE SPACE. SQ1064.2 +032800 02 FILLER PIC X(58) VALUE SQ1064.2 +032900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1064.2 +033000 02 FILLER PIC X(8) VALUE SPACE. SQ1064.2 +033100 02 FILLER PIC X(20) VALUE SQ1064.2 +033200 " COPYRIGHT 1985,1986". SQ1064.2 +033300 01 CCVS-E-4. SQ1064.2 +033400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1064.2 +033500 02 FILLER PIC X(4) VALUE " OF ". SQ1064.2 +033600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1064.2 +033700 02 FILLER PIC X(40) VALUE SQ1064.2 +033800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1064.2 +033900 01 XXINFO. SQ1064.2 +034000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1064.2 +034100 02 INFO-TEXT. SQ1064.2 +034200 04 FILLER PIC X(8) VALUE SPACE. SQ1064.2 +034300 04 XXCOMPUTED PIC X(20). SQ1064.2 +034400 04 FILLER PIC X(5) VALUE SPACE. SQ1064.2 +034500 04 XXCORRECT PIC X(20). SQ1064.2 +034600 02 INF-ANSI-REFERENCE PIC X(48). SQ1064.2 +034700 01 HYPHEN-LINE. SQ1064.2 +034800 02 FILLER PIC IS X VALUE IS SPACE. SQ1064.2 +034900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1064.2 +035000- "*****************************************". SQ1064.2 +035100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1064.2 +035200- "******************************". SQ1064.2 +035300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1064.2 +035400 "SQ106A". SQ1064.2 +035500* SQ1064.2 +035600* SQ1064.2 +035700 PROCEDURE DIVISION. SQ1064.2 +035800 CCVS1 SECTION. SQ1064.2 +035900 OPEN-FILES. SQ1064.2 +036000*P OPEN I-O RAW-DATA. SQ1064.2 +036100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1064.2 +036200*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1064.2 +036300*P MOVE "ABORTED " TO C-ABORT. SQ1064.2 +036400*P ADD 1 TO C-NO-OF-TESTS. SQ1064.2 +036500*P ACCEPT C-DATE FROM DATE. SQ1064.2 +036600*P ACCEPT C-TIME FROM TIME. SQ1064.2 +036700*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1064.2 +036800*PND-E-1. SQ1064.2 +036900*P CLOSE RAW-DATA. SQ1064.2 +037000 OPEN OUTPUT PRINT-FILE. SQ1064.2 +037100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1064.2 +037200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1064.2 +037300 MOVE SPACE TO TEST-RESULTS. SQ1064.2 +037400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1064.2 +037500 MOVE ZERO TO REC-SKEL-SUB. SQ1064.2 +037600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1064.2 +037700 GO TO CCVS1-EXIT. SQ1064.2 +037800* SQ1064.2 +037900 CCVS-INIT-FILE. SQ1064.2 +038000 ADD 1 TO REC-SKL-SUB. SQ1064.2 +038100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1064.2 +038200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1064.2 +038300* SQ1064.2 +038400 CLOSE-FILES. SQ1064.2 +038500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1064.2 +038600 CLOSE PRINT-FILE. SQ1064.2 +038700*P OPEN I-O RAW-DATA. SQ1064.2 +038800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1064.2 +038900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1064.2 +039000*P MOVE "OK. " TO C-ABORT. SQ1064.2 +039100*P MOVE PASS-COUNTER TO C-OK. SQ1064.2 +039200*P MOVE ERROR-HOLD TO C-ALL. SQ1064.2 +039300*P MOVE ERROR-COUNTER TO C-FAIL. SQ1064.2 +039400*P MOVE DELETE-CNT TO C-DELETED. SQ1064.2 +039500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1064.2 +039600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1064.2 +039700*PND-E-2. SQ1064.2 +039800*P CLOSE RAW-DATA. SQ1064.2 +039900 TERMINATE-CCVS. SQ1064.2 +040000*S EXIT PROGRAM. SQ1064.2 +040100 STOP RUN. SQ1064.2 +040200* SQ1064.2 +040300 INSPT. SQ1064.2 +040400 MOVE "INSPT" TO P-OR-F. SQ1064.2 +040500 ADD 1 TO INSPECT-COUNTER. SQ1064.2 +040600 PERFORM PRINT-DETAIL. SQ1064.2 +040700* SQ1064.2 +040800 PASS. SQ1064.2 +040900 MOVE "PASS " TO P-OR-F. SQ1064.2 +041000 ADD 1 TO PASS-COUNTER. SQ1064.2 +041100 PERFORM PRINT-DETAIL. SQ1064.2 +041200* SQ1064.2 +041300 FAIL. SQ1064.2 +041400 MOVE "FAIL*" TO P-OR-F. SQ1064.2 +041500 ADD 1 TO ERROR-COUNTER. SQ1064.2 +041600 PERFORM PRINT-DETAIL. SQ1064.2 +041700* SQ1064.2 +041800 DE-LETE. SQ1064.2 +041900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1064.2 +042000 MOVE "*****" TO P-OR-F. SQ1064.2 +042100 ADD 1 TO DELETE-COUNTER. SQ1064.2 +042200 PERFORM PRINT-DETAIL. SQ1064.2 +042300* SQ1064.2 +042400 PRINT-DETAIL. SQ1064.2 +042500 IF REC-CT NOT EQUAL TO ZERO SQ1064.2 +042600 MOVE "." TO PARDOT-X SQ1064.2 +042700 MOVE REC-CT TO DOTVALUE. SQ1064.2 +042800 MOVE TEST-RESULTS TO PRINT-REC. SQ1064.2 +042900 PERFORM WRITE-LINE. SQ1064.2 +043000 IF P-OR-F EQUAL TO "FAIL*" SQ1064.2 +043100 PERFORM WRITE-LINE SQ1064.2 +043200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1064.2 +043300 ELSE SQ1064.2 +043400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1064.2 +043500 MOVE SPACE TO P-OR-F. SQ1064.2 +043600 MOVE SPACE TO COMPUTED-X. SQ1064.2 +043700 MOVE SPACE TO CORRECT-X. SQ1064.2 +043800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1064.2 +043900 MOVE SPACE TO RE-MARK. SQ1064.2 +044000* SQ1064.2 +044100 HEAD-ROUTINE. SQ1064.2 +044200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +044300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +044400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1064.2 +044500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1064.2 +044600 COLUMN-NAMES-ROUTINE. SQ1064.2 +044700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1064.2 +044800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +044900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1064.2 +045000 END-ROUTINE. SQ1064.2 +045100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1064.2 +045200 PERFORM WRITE-LINE 5 TIMES. SQ1064.2 +045300 END-RTN-EXIT. SQ1064.2 +045400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1064.2 +045500 PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +045600* SQ1064.2 +045700 END-ROUTINE-1. SQ1064.2 +045800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1064.2 +045900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1064.2 +046000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1064.2 +046100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1064.2 +046200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1064.2 +046300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1064.2 +046400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1064.2 +046500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1064.2 +046600 PERFORM WRITE-LINE. SQ1064.2 +046700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1064.2 +046800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1064.2 +046900 MOVE "NO " TO ERROR-TOTAL SQ1064.2 +047000 ELSE SQ1064.2 +047100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1064.2 +047200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1064.2 +047300 PERFORM WRITE-LINE. SQ1064.2 +047400 END-ROUTINE-13. SQ1064.2 +047500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1064.2 +047600 MOVE "NO " TO ERROR-TOTAL SQ1064.2 +047700 ELSE SQ1064.2 +047800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1064.2 +047900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1064.2 +048000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1064.2 +048100 PERFORM WRITE-LINE. SQ1064.2 +048200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1064.2 +048300 MOVE "NO " TO ERROR-TOTAL SQ1064.2 +048400 ELSE SQ1064.2 +048500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1064.2 +048600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1064.2 +048700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1064.2 +048800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1064.2 +048900* SQ1064.2 +049000 WRITE-LINE. SQ1064.2 +049100 ADD 1 TO RECORD-COUNT. SQ1064.2 +049200 IF RECORD-COUNT GREATER 50 SQ1064.2 +049300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1064.2 +049400 MOVE SPACE TO DUMMY-RECORD SQ1064.2 +049500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1064.2 +049600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1064.2 +049700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1064.2 +049800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1064.2 +049900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1064.2 +050000 MOVE ZERO TO RECORD-COUNT. SQ1064.2 +050100 PERFORM WRT-LN. SQ1064.2 +050200* SQ1064.2 +050300 WRT-LN. SQ1064.2 +050400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1064.2 +050500 MOVE SPACE TO DUMMY-RECORD. SQ1064.2 +050600 BLANK-LINE-PRINT. SQ1064.2 +050700 PERFORM WRT-LN. SQ1064.2 +050800 FAIL-ROUTINE. SQ1064.2 +050900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1064.2 +051000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1064.2 +051100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1064.2 +051200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1064.2 +051300 MOVE XXINFO TO DUMMY-RECORD. SQ1064.2 +051400 PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +051500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1064.2 +051600 GO TO FAIL-ROUTINE-EX. SQ1064.2 +051700 FAIL-ROUTINE-WRITE. SQ1064.2 +051800 MOVE TEST-COMPUTED TO PRINT-REC SQ1064.2 +051900 PERFORM WRITE-LINE SQ1064.2 +052000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1064.2 +052100 MOVE TEST-CORRECT TO PRINT-REC SQ1064.2 +052200 PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +052300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1064.2 +052400 FAIL-ROUTINE-EX. SQ1064.2 +052500 EXIT. SQ1064.2 +052600 BAIL-OUT. SQ1064.2 +052700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1064.2 +052800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1064.2 +052900 BAIL-OUT-WRITE. SQ1064.2 +053000 MOVE CORRECT-A TO XXCORRECT. SQ1064.2 +053100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1064.2 +053200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1064.2 +053300 MOVE XXINFO TO DUMMY-RECORD. SQ1064.2 +053400 PERFORM WRITE-LINE 2 TIMES. SQ1064.2 +053500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1064.2 +053600 BAIL-OUT-EX. SQ1064.2 +053700 EXIT. SQ1064.2 +053800 CCVS1-EXIT. SQ1064.2 +053900 EXIT. SQ1064.2 +054000* SQ1064.2 +054100**************************************************************** SQ1064.2 +054200* * SQ1064.2 +054300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1064.2 +054400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1064.2 +054500* * SQ1064.2 +054600**************************************************************** SQ1064.2 +054700* SQ1064.2 +054800 SECT-SQ106-0001 SECTION. SQ1064.2 +054900 SEQ-INIT-01. SQ1064.2 +055000 MOVE SPACE TO DELETE-SW. SQ1064.2 +055100* SQ1064.2 +055200 MOVE "SQ-VS6" TO XFILE-NAME (1). SQ1064.2 +055300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1064.2 +055400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1064.2 +055500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1064.2 +055600 MOVE 11 TO RECORDS-IN-FILE (1). SQ1064.2 +055700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1064.2 +055800 MOVE "S" TO XLABEL-TYPE (1). SQ1064.2 +055900 MOVE 0 TO XRECORD-NUMBER (1). SQ1064.2 +056000 MOVE ZERO TO BUFFER-COPY-RECNO. SQ1064.2 +056100 MOVE "MULTIPLE REC LENGTHS" TO BUFFER-COPY-END. SQ1064.2 +056200* SQ1064.2 +056300* THE FIRST ACTION IS TO OPEN THE FILE FOR OUTPUT, AND SO SQ1064.2 +056400* CREATE IT. IF THE OPEN IS DELETED, ALL SUCCEDING TESTS SQ1064.2 +056500* ARE AUTOMATICALLY DELETED WITH IT. A SUBORDINATE TEST SQ1064.2 +056600* CHECKS THE I-O STATUS RETURNED FROM THE OPEN OPERATION. SQ1064.2 +056700* SQ1064.2 +056800 MOVE "**" TO SQ-STATUS. SQ1064.2 +056900 MOVE "OPEN FILE FOR OUTPUT" TO FEATURE. SQ1064.2 +057000 MOVE "SEQ-TEST-GF-01" TO PAR-NAME. SQ1064.2 +057100 GO TO SEQ-TEST-GF-01. SQ1064.2 +057200 SEQ-DELETE-01. SQ1064.2 +057300 MOVE "*" TO DELETE-SW-1. SQ1064.2 +057400 GO TO SEQ-DELETE-01-01. SQ1064.2 +057500 SEQ-TEST-GF-01. SQ1064.2 +057600 OPEN OUTPUT SQ-VS6. SQ1064.2 +057700 GO TO SEQ-TEST-GF-01-01. SQ1064.2 +057800 SEQ-DELETE-01-01. SQ1064.2 +057900 PERFORM DE-LETE. SQ1064.2 +058000 GO TO SEQ-TEST-01-01-END. SQ1064.2 +058100 SEQ-TEST-GF-01-01. SQ1064.2 +058200 IF SQ-STATUS = "00" SQ1064.2 +058300 PERFORM PASS SQ1064.2 +058400 ELSE SQ1064.2 +058500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +058600 MOVE "00" TO CORRECT-A SQ1064.2 +058700 MOVE "UNEXPECTED I-O STATUS FROM OPEN" TO RE-MARK SQ1064.2 +058800 MOVE "VII-2, VII-39" TO ANSI-REFERENCE SQ1064.2 +058900 PERFORM FAIL SQ1064.2 +059000 MOVE "*" TO DELETE-SW-1. SQ1064.2 +059100 SEQ-TEST-01-01-END. SQ1064.2 +059200* SQ1064.2 +059300* SQ1064.2 +059400* UNLESS AN ERROR OCCURRED DURING EXECUTION OF THE OPEN SQ1064.2 +059500* STATEMENT, THE FILE IS NOW OPEN, AND READY FOR RECORDS TO SQ1064.2 +059600* BE WRITTEN TO IT. IF AN ERROR I-O STATUS VALUE WAS SQ1064.2 +059700* RETURNED, ALL THE REMAINING TESTS ARE DELETED. SQ1064.2 +059800* SQ1064.2 +059900* CREATE A SHORT RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +060000* SQ1064.2 +060100 SEQ-INIT-02. SQ1064.2 +060200 MOVE 1 TO REC-CT. SQ1064.2 +060300 MOVE "WRITE SHORT RECORD" TO FEATURE. SQ1064.2 +060400 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1064.2 +060500 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +060600 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +060700 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +060800 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +060900 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +061000 MOVE "**" TO SQ-STATUS. SQ1064.2 +061100 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +061200 GO TO SEQ-DELETE-02. SQ1064.2 +061300 GO TO SEQ-TEST-WR-02. SQ1064.2 +061400 SEQ-DELETE-02. SQ1064.2 +061500 GO TO SEQ-DELETE-02-01. SQ1064.2 +061600 SEQ-TEST-WR-02. SQ1064.2 +061700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +061800 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +061900 WRITE SQ-VS6R1-M-G-120. SQ1064.2 +062000 GO TO SEQ-TEST-WR-02-01. SQ1064.2 +062100 SEQ-DELETE-02-01. SQ1064.2 +062200 PERFORM DE-LETE. SQ1064.2 +062300 GO TO SEQ-TEST-02-01-END. SQ1064.2 +062400 SEQ-TEST-WR-02-01. SQ1064.2 +062500 IF SQ-STATUS = "00" SQ1064.2 +062600 PERFORM PASS SQ1064.2 +062700 ELSE SQ1064.2 +062800 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +062900 MOVE "00" TO CORRECT-A SQ1064.2 +063000 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +063100 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +063200 PERFORM FAIL. SQ1064.2 +063300 SEQ-TEST-02-01-END. SQ1064.2 +063400* SQ1064.2 +063500* CREATE A LONG RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +063600* SQ1064.2 +063700 SEQ-INIT-03. SQ1064.2 +063800 MOVE 1 TO REC-CT. SQ1064.2 +063900 MOVE "WRITE LONG RECORD" TO FEATURE. SQ1064.2 +064000 MOVE "SEQ-TEST-WR-03" TO PAR-NAME. SQ1064.2 +064100 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +064200 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +064300 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +064400 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +064500 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +064600 MOVE "**" TO SQ-STATUS. SQ1064.2 +064700 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +064800 GO TO SEQ-DELETE-03. SQ1064.2 +064900 GO TO SEQ-TEST-WR-03. SQ1064.2 +065000 SEQ-DELETE-03. SQ1064.2 +065100 GO TO SEQ-DELETE-03-01. SQ1064.2 +065200 SEQ-TEST-WR-03. SQ1064.2 +065300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +065400 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +065500 WRITE SQ-VS6R2-M-G-151. SQ1064.2 +065600 GO TO SEQ-TEST-WR-03-01. SQ1064.2 +065700 SEQ-DELETE-03-01. SQ1064.2 +065800 PERFORM DE-LETE. SQ1064.2 +065900 GO TO SEQ-TEST-03-01-END. SQ1064.2 +066000 SEQ-TEST-WR-03-01. SQ1064.2 +066100 IF SQ-STATUS = "00" SQ1064.2 +066200 PERFORM PASS SQ1064.2 +066300 ELSE SQ1064.2 +066400 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +066500 MOVE "00" TO CORRECT-A SQ1064.2 +066600 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +066700 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +066800 PERFORM FAIL. SQ1064.2 +066900 SEQ-TEST-03-01-END. SQ1064.2 +067000* SQ1064.2 +067100* SQ1064.2 +067200* CREATE A SHORT RECORD USING WRITE FROM, WITH A 151 SQ1064.2 +067300* CHARACTER AREA AS THE SOURCE. SQ1064.2 +067400* SQ1064.2 +067500 SEQ-INIT-04. SQ1064.2 +067600 MOVE 1 TO REC-CT. SQ1064.2 +067700 MOVE "WRITE SHORT RECORD FROM" TO FEATURE. SQ1064.2 +067800 MOVE "SEQ-TEST-WR-04" TO PAR-NAME. SQ1064.2 +067900 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +068000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +068100 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +068200 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +068300 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +068400 MOVE "**" TO SQ-STATUS. SQ1064.2 +068500 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +068600 GO TO SEQ-DELETE-04. SQ1064.2 +068700 GO TO SEQ-TEST-WR-04. SQ1064.2 +068800 SEQ-DELETE-04. SQ1064.2 +068900 GO TO SEQ-DELETE-04-01. SQ1064.2 +069000 SEQ-TEST-WR-04. SQ1064.2 +069100 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +069200 WRITE SQ-VS6R1-M-G-120 FROM BUFFER-COPY. SQ1064.2 +069300 GO TO SEQ-TEST-WR-04-01. SQ1064.2 +069400 SEQ-DELETE-04-01. SQ1064.2 +069500 PERFORM DE-LETE. SQ1064.2 +069600 GO TO SEQ-TEST-04-01-END. SQ1064.2 +069700 SEQ-TEST-WR-04-01. SQ1064.2 +069800 IF SQ-STATUS = "00" SQ1064.2 +069900 PERFORM PASS SQ1064.2 +070000 ELSE SQ1064.2 +070100 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +070200 MOVE "00" TO CORRECT-A SQ1064.2 +070300 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +070400 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +070500 PERFORM FAIL. SQ1064.2 +070600 SEQ-TEST-04-01-END. SQ1064.2 +070700* SQ1064.2 +070800* SQ1064.2 +070900* CREATE A SHORT RECORD USING WRITE FROM, WITH A 151 SQ1064.2 +071000* CHARACTER SOURCE FIELD. SQ1064.2 +071100* SQ1064.2 +071200 SEQ-INIT-05. SQ1064.2 +071300 MOVE 1 TO REC-CT. SQ1064.2 +071400 MOVE "WRITE SHORT RECORD FROM" TO FEATURE. SQ1064.2 +071500 MOVE "SEQ-TEST-WR-05" TO PAR-NAME. SQ1064.2 +071600 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +071700 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +071800 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +071900 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +072000 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +072100 MOVE "**" TO SQ-STATUS. SQ1064.2 +072200 IF DELETE-SW-1 NOT EQUAL SPACE SQ1064.2 +072300 GO TO SEQ-DELETE-05. SQ1064.2 +072400 GO TO SEQ-TEST-WR-05. SQ1064.2 +072500 SEQ-DELETE-05. SQ1064.2 +072600 GO TO SEQ-DELETE-05-01. SQ1064.2 +072700 SEQ-TEST-WR-05. SQ1064.2 +072800 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +072900 WRITE SQ-VS6R1-M-G-120 FROM BUFFER-COPY. SQ1064.2 +073000 GO TO SEQ-TEST-WR-05-01. SQ1064.2 +073100 SEQ-DELETE-05-01. SQ1064.2 +073200 PERFORM DE-LETE. SQ1064.2 +073300 GO TO SEQ-TEST-05-01-END. SQ1064.2 +073400 SEQ-TEST-WR-05-01. SQ1064.2 +073500 IF SQ-STATUS = "00" SQ1064.2 +073600 PERFORM PASS SQ1064.2 +073700 ELSE SQ1064.2 +073800 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +073900 MOVE "00" TO CORRECT-A SQ1064.2 +074000 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +074100 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +074200 PERFORM FAIL. SQ1064.2 +074300 SEQ-TEST-05-01-END. SQ1064.2 +074400* SQ1064.2 +074500* SQ1064.2 +074600* CREATE A LONG RECORD USING WRITE FROM. SQ1064.2 +074700* SQ1064.2 +074800 SEQ-INIT-06. SQ1064.2 +074900 MOVE 1 TO REC-CT. SQ1064.2 +075000 MOVE "WRITE LONG RECORD FROM" TO FEATURE. SQ1064.2 +075100 MOVE "SEQ-TEST-WR-06" TO PAR-NAME. SQ1064.2 +075200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +075300 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +075400 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +075500 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +075600 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +075700 MOVE "**" TO SQ-STATUS. SQ1064.2 +075800 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +075900 GO TO SEQ-DELETE-06. SQ1064.2 +076000 GO TO SEQ-TEST-WR-06. SQ1064.2 +076100 SEQ-DELETE-06. SQ1064.2 +076200 GO TO SEQ-DELETE-06-01. SQ1064.2 +076300 SEQ-TEST-WR-06. SQ1064.2 +076400 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +076500 WRITE SQ-VS6R2-M-G-151 FROM BUFFER-COPY. SQ1064.2 +076600 GO TO SEQ-TEST-WR-06-01. SQ1064.2 +076700 SEQ-DELETE-06-01. SQ1064.2 +076800 PERFORM DE-LETE. SQ1064.2 +076900 GO TO SEQ-TEST-06-01-END. SQ1064.2 +077000 SEQ-TEST-WR-06-01. SQ1064.2 +077100 IF SQ-STATUS = "00" SQ1064.2 +077200 PERFORM PASS SQ1064.2 +077300 ELSE SQ1064.2 +077400 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +077500 MOVE "00" TO CORRECT-A SQ1064.2 +077600 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +077700 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +077800 PERFORM FAIL. SQ1064.2 +077900 SEQ-TEST-06-01-END. SQ1064.2 +078000* SQ1064.2 +078100* SQ1064.2 +078200* CREATE A SHORT RECORD USING WRITE FROM, WITH A 151 SQ1064.2 +078300* CHARACTER AREA AS THE SOURCE. SQ1064.2 +078400* SQ1064.2 +078500 SEQ-INIT-07. SQ1064.2 +078600 MOVE 1 TO REC-CT. SQ1064.2 +078700 MOVE "WRITE SHORT RECORD FROM" TO FEATURE. SQ1064.2 +078800 MOVE "SEQ-TEST-WR-07" TO PAR-NAME. SQ1064.2 +078900 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +079000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +079100 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +079200 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +079300 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +079400 MOVE "**" TO SQ-STATUS. SQ1064.2 +079500 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +079600 GO TO SEQ-DELETE-07. SQ1064.2 +079700 GO TO SEQ-TEST-WR-07. SQ1064.2 +079800 SEQ-DELETE-07. SQ1064.2 +079900 GO TO SEQ-DELETE-07-01. SQ1064.2 +080000 SEQ-TEST-WR-07. SQ1064.2 +080100 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +080200 WRITE SQ-VS6R1-M-G-120 FROM BUFFER-COPY. SQ1064.2 +080300 GO TO SEQ-TEST-WR-07-01. SQ1064.2 +080400 SEQ-DELETE-07-01. SQ1064.2 +080500 PERFORM DE-LETE. SQ1064.2 +080600 GO TO SEQ-TEST-07-01-END. SQ1064.2 +080700 SEQ-TEST-WR-07-01. SQ1064.2 +080800 IF SQ-STATUS = "00" SQ1064.2 +080900 PERFORM PASS SQ1064.2 +081000 ELSE SQ1064.2 +081100 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +081200 MOVE "00" TO CORRECT-A SQ1064.2 +081300 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +081400 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +081500 PERFORM FAIL. SQ1064.2 +081600 SEQ-TEST-07-01-END. SQ1064.2 +081700* SQ1064.2 +081800* SQ1064.2 +081900* CREATE A LONG RECORD USING WRITE FROM, USING A 151 SQ1064.2 +082000* CHARACTER SOURCE AREA. SQ1064.2 +082100* SQ1064.2 +082200 SEQ-INIT-08. SQ1064.2 +082300 MOVE 1 TO REC-CT. SQ1064.2 +082400 MOVE "WRITE LONG RECORD FROM" TO FEATURE. SQ1064.2 +082500 MOVE "SEQ-TEST-WR-08" TO PAR-NAME. SQ1064.2 +082600 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +082700 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +082800 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +082900 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +083000 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +083100 MOVE "**" TO SQ-STATUS. SQ1064.2 +083200 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +083300 GO TO SEQ-DELETE-08. SQ1064.2 +083400 GO TO SEQ-TEST-WR-08. SQ1064.2 +083500 SEQ-DELETE-08. SQ1064.2 +083600 GO TO SEQ-DELETE-08-01. SQ1064.2 +083700 SEQ-TEST-WR-08. SQ1064.2 +083800 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +083900 WRITE SQ-VS6R2-M-G-151 FROM BUFFER-COPY. SQ1064.2 +084000 GO TO SEQ-TEST-WR-08-01. SQ1064.2 +084100 SEQ-DELETE-08-01. SQ1064.2 +084200 PERFORM DE-LETE. SQ1064.2 +084300 GO TO SEQ-TEST-08-01-END. SQ1064.2 +084400 SEQ-TEST-WR-08-01. SQ1064.2 +084500 IF SQ-STATUS = "00" SQ1064.2 +084600 PERFORM PASS SQ1064.2 +084700 ELSE SQ1064.2 +084800 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +084900 MOVE "00" TO CORRECT-A SQ1064.2 +085000 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +085100 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +085200 PERFORM FAIL. SQ1064.2 +085300 SEQ-TEST-08-01-END. SQ1064.2 +085400* SQ1064.2 +085500* SQ1064.2 +085600* CREATE A LONG RECORD USING WRITE FROM, USING A 151 SQ1064.2 +085700* CHARACTER SOURCE AREA. SQ1064.2 +085800* SQ1064.2 +085900 SEQ-INIT-09. SQ1064.2 +086000 MOVE 1 TO REC-CT. SQ1064.2 +086100 MOVE "WRITE LONG RECORD FROM" TO FEATURE. SQ1064.2 +086200 MOVE "SEQ-TEST-WR-09" TO PAR-NAME. SQ1064.2 +086300 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +086400 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +086500 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +086600 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +086700 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +086800 MOVE "**" TO SQ-STATUS. SQ1064.2 +086900 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +087000 GO TO SEQ-DELETE-09. SQ1064.2 +087100 GO TO SEQ-TEST-WR-09. SQ1064.2 +087200 SEQ-DELETE-09. SQ1064.2 +087300 GO TO SEQ-DELETE-09-01. SQ1064.2 +087400 SEQ-TEST-WR-09. SQ1064.2 +087500 MOVE FILE-RECORD-INFO-P1-120 (1) TO BUFFER-COPY-120. SQ1064.2 +087600 WRITE SQ-VS6R2-M-G-151 FROM BUFFER-COPY. SQ1064.2 +087700 GO TO SEQ-TEST-WR-09-01. SQ1064.2 +087800 SEQ-DELETE-09-01. SQ1064.2 +087900 PERFORM DE-LETE. SQ1064.2 +088000 GO TO SEQ-TEST-09-01-END. SQ1064.2 +088100 SEQ-TEST-WR-09-01. SQ1064.2 +088200 IF SQ-STATUS = "00" SQ1064.2 +088300 PERFORM PASS SQ1064.2 +088400 ELSE SQ1064.2 +088500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +088600 MOVE "00" TO CORRECT-A SQ1064.2 +088700 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +088800 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +088900 PERFORM FAIL. SQ1064.2 +089000 SEQ-TEST-09-01-END. SQ1064.2 +089100* SQ1064.2 +089200* SQ1064.2 +089300* CREATE A LONG RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +089400* SQ1064.2 +089500 SEQ-INIT-10. SQ1064.2 +089600 MOVE 1 TO REC-CT. SQ1064.2 +089700 MOVE "WRITE LONG RECORD" TO FEATURE. SQ1064.2 +089800 MOVE "SEQ-TEST-WR-10" TO PAR-NAME. SQ1064.2 +089900 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +090000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +090100 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1064.2 +090200 MOVE 151 TO XRECORD-LENGTH (1). SQ1064.2 +090300 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +090400 MOVE "**" TO SQ-STATUS. SQ1064.2 +090500 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +090600 GO TO SEQ-DELETE-10. SQ1064.2 +090700 GO TO SEQ-TEST-WR-10. SQ1064.2 +090800 SEQ-DELETE-10. SQ1064.2 +090900 GO TO SEQ-DELETE-10-01. SQ1064.2 +091000 SEQ-TEST-WR-10. SQ1064.2 +091100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +091200 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +091300 WRITE SQ-VS6R2-M-G-151. SQ1064.2 +091400 GO TO SEQ-TEST-WR-10-01. SQ1064.2 +091500 SEQ-DELETE-10-01. SQ1064.2 +091600 PERFORM DE-LETE. SQ1064.2 +091700 GO TO SEQ-TEST-10-01-END. SQ1064.2 +091800 SEQ-TEST-WR-10-01. SQ1064.2 +091900 IF SQ-STATUS = "00" SQ1064.2 +092000 PERFORM PASS SQ1064.2 +092100 ELSE SQ1064.2 +092200 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +092300 MOVE "00" TO CORRECT-A SQ1064.2 +092400 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +092500 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +092600 PERFORM FAIL. SQ1064.2 +092700 SEQ-TEST-10-01-END. SQ1064.2 +092800* SQ1064.2 +092900* SQ1064.2 +093000* CREATE A SHORT RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +093100* SQ1064.2 +093200 SEQ-INIT-11. SQ1064.2 +093300 MOVE 1 TO REC-CT. SQ1064.2 +093400 MOVE "WRITE SHORT RECORD" TO FEATURE. SQ1064.2 +093500 MOVE "SEQ-TEST-WR-11" TO PAR-NAME. SQ1064.2 +093600 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +093700 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +093800 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +093900 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +094000 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +094100 MOVE "**" TO SQ-STATUS. SQ1064.2 +094200 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +094300 GO TO SEQ-DELETE-11. SQ1064.2 +094400 GO TO SEQ-TEST-WR-11. SQ1064.2 +094500 SEQ-DELETE-11. SQ1064.2 +094600 GO TO SEQ-DELETE-11-01. SQ1064.2 +094700 SEQ-TEST-WR-11. SQ1064.2 +094800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +094900 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +095000 WRITE SQ-VS6R1-M-G-120. SQ1064.2 +095100 GO TO SEQ-TEST-WR-11-01. SQ1064.2 +095200 SEQ-DELETE-11-01. SQ1064.2 +095300 PERFORM DE-LETE. SQ1064.2 +095400 GO TO SEQ-TEST-11-01-END. SQ1064.2 +095500 SEQ-TEST-WR-11-01. SQ1064.2 +095600 IF SQ-STATUS = "00" SQ1064.2 +095700 PERFORM PASS SQ1064.2 +095800 ELSE SQ1064.2 +095900 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +096000 MOVE "00" TO CORRECT-A SQ1064.2 +096100 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +096200 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +096300 PERFORM FAIL. SQ1064.2 +096400 SEQ-TEST-11-01-END. SQ1064.2 +096500* SQ1064.2 +096600* CREATE A SHORT RECORD USING THE BASIC WRITE STATEMENT SQ1064.2 +096700* SQ1064.2 +096800 SEQ-INIT-12. SQ1064.2 +096900 MOVE 1 TO REC-CT. SQ1064.2 +097000 MOVE "WRITE SHORT RECORD" TO FEATURE. SQ1064.2 +097100 MOVE "SEQ-TEST-WR-12" TO PAR-NAME. SQ1064.2 +097200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +097300 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +097400 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1064.2 +097500 MOVE 120 TO XRECORD-LENGTH (1). SQ1064.2 +097600 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +097700 MOVE "**" TO SQ-STATUS. SQ1064.2 +097800 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +097900 GO TO SEQ-DELETE-12. SQ1064.2 +098000 GO TO SEQ-TEST-WR-12. SQ1064.2 +098100 SEQ-DELETE-12. SQ1064.2 +098200 GO TO SEQ-DELETE-12-01. SQ1064.2 +098300 SEQ-TEST-WR-12. SQ1064.2 +098400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ1064.2 +098500 MOVE BUFFER-COPY-SECOND TO SQ-VS6R2-SECOND. SQ1064.2 +098600 WRITE SQ-VS6R1-M-G-120. SQ1064.2 +098700 GO TO SEQ-TEST-WR-12-01. SQ1064.2 +098800 SEQ-DELETE-12-01. SQ1064.2 +098900 PERFORM DE-LETE. SQ1064.2 +099000 GO TO SEQ-TEST-12-01-END. SQ1064.2 +099100 SEQ-TEST-WR-12-01. SQ1064.2 +099200 IF SQ-STATUS = "00" SQ1064.2 +099300 PERFORM PASS SQ1064.2 +099400 ELSE SQ1064.2 +099500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +099600 MOVE "00" TO CORRECT-A SQ1064.2 +099700 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1064.2 +099800 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1064.2 +099900 PERFORM FAIL. SQ1064.2 +100000 SEQ-TEST-12-01-END. SQ1064.2 +100100* SQ1064.2 +100200* SQ1064.2 +100300* ALL REQUIRED RECORDS HAVE BEEN WRITTEN, SO THE FILE SQ1064.2 +100400* CAN BE CLOSED. SQ1064.2 +100500* SQ1064.2 +100600 SEQ-INIT-13. SQ1064.2 +100700 MOVE 1 TO REC-CT. SQ1064.2 +100800 MOVE "CLOSE NEW FILE" TO FEATURE. SQ1064.2 +100900 MOVE "SEQ-TEST-WR-13" TO PAR-NAME. SQ1064.2 +101000 MOVE "**" TO SQ-STATUS. SQ1064.2 +101100 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +101200 GO TO SEQ-DELETE-13. SQ1064.2 +101300 GO TO SEQ-TEST-WR-13. SQ1064.2 +101400 SEQ-DELETE-13. SQ1064.2 +101500 GO TO SEQ-DELETE-13-01. SQ1064.2 +101600 SEQ-TEST-WR-13. SQ1064.2 +101700 CLOSE SQ-VS6. SQ1064.2 +101800 GO TO SEQ-TEST-WR-13-01. SQ1064.2 +101900 SEQ-DELETE-13-01. SQ1064.2 +102000 PERFORM DE-LETE. SQ1064.2 +102100 GO TO SEQ-TEST-13-01-END. SQ1064.2 +102200 SEQ-TEST-WR-13-01. SQ1064.2 +102300 IF SQ-STATUS = "00" SQ1064.2 +102400 PERFORM PASS SQ1064.2 +102500 ELSE SQ1064.2 +102600 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +102700 MOVE "00" TO CORRECT-A SQ1064.2 +102800 MOVE "UNEXPECTED I-O STATUS FROM CLOSE" TO RE-MARK SQ1064.2 +102900 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1064.2 +103000 PERFORM FAIL. SQ1064.2 +103100 SEQ-TEST-13-01-END. SQ1064.2 +103200* SQ1064.2 +103300* SQ1064.2 +103400* A SEQUENTIAL TAPE FILE CONTAINING 11 RECORDS HAS BEEN SQ1064.2 +103500* CREATED. THE FILE CONTAINS RECORDS OF 120 CHARACTERS AND SQ1064.2 +103600* RECORDS OF 151 CHARACTERS. THE SEQUENCE IN WHICH THE SQ1064.2 +103700* RECORDS WERE WRITTEN IS SLSSLSLLLSS. THE NEXT GROUP OF SQ1064.2 +103800* OPENS THE FILE FOR INPUT AND READS IT, USING TWELVE SQ1064.2 +103900* DIFFERENT FORMATS OF THE READ STATEMENT. DELETION OF THIS SQ1064.2 +104000* TEST CAUSES DELETION OF ALL SUBSEQUENT TESTS. SQ1064.2 +104100* SQ1064.2 +104200* SQ1064.2 +104300 SEQ-INIT-14. SQ1064.2 +104400 MOVE "**" TO SQ-STATUS. SQ1064.2 +104500 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ1064.2 +104600 MOVE "SEQ-TEST-GF-14" TO PAR-NAME. SQ1064.2 +104700 IF DELETE-SW NOT = SPACE SQ1064.2 +104800 GO TO SEQ-DELETE-14. SQ1064.2 +104900 GO TO SEQ-TEST-GF-14. SQ1064.2 +105000 SEQ-DELETE-14. SQ1064.2 +105100 MOVE "*" TO DELETE-SW-1. SQ1064.2 +105200 GO TO SEQ-DELETE-14-01. SQ1064.2 +105300 SEQ-TEST-GF-14. SQ1064.2 +105400 OPEN INPUT SQ-VS6. SQ1064.2 +105500 GO TO SEQ-TEST-GF-14-01. SQ1064.2 +105600 SEQ-DELETE-14-01. SQ1064.2 +105700 PERFORM DE-LETE. SQ1064.2 +105800 GO TO SEQ-TEST-14-01-END. SQ1064.2 +105900 SEQ-TEST-GF-14-01. SQ1064.2 +106000 IF SQ-STATUS = "00" SQ1064.2 +106100 PERFORM PASS SQ1064.2 +106200 ELSE SQ1064.2 +106300 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +106400 MOVE "00" TO CORRECT-A SQ1064.2 +106500 MOVE "UNEXPECTED I-O STATUS FROM OPEN" TO RE-MARK SQ1064.2 +106600 MOVE "VII-2, VII-39" TO ANSI-REFERENCE SQ1064.2 +106700 PERFORM FAIL SQ1064.2 +106800 MOVE "*" TO DELETE-SW-1. SQ1064.2 +106900 SEQ-TEST-14-01-END. SQ1064.2 +107000* SQ1064.2 +107100* SQ1064.2 +107200* UNLESS AN ERROR OCCURRED DURING EXECUTION OF THE OPEN SQ1064.2 +107300* STATEMENT, THE FILE IS NOW OPEN, AND READY FOR RECORDS TO SQ1064.2 +107400* BE WRITTEN TO IT. IF AN ERROR I-O STATUS VALUE WAS SQ1064.2 +107500* RETURNED, ALL THE REMAINING TESTS ARE DELETED. SQ1064.2 +107600* SQ1064.2 +107700* READ A SHORT RECORD, USING READ ... AT END SQ1064.2 +107800* SQ1064.2 +107900 SEQ-INIT-15. SQ1064.2 +108000 MOVE 1 TO REC-CT. SQ1064.2 +108100 MOVE 1 TO XRECORD-NUMBER (1). SQ1064.2 +108200 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +108300 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +108400 MOVE 1 TO BUFFER-COPY-RECNO. SQ1064.2 +108500 MOVE "**" TO SQ-STATUS. SQ1064.2 +108600 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +108700 MOVE "READ SHORT AT END" TO FEATURE. SQ1064.2 +108800 MOVE "SEQ-TEST-RD-15" TO PAR-NAME. SQ1064.2 +108900 IF DELETE-SW NOT = SPACE SQ1064.2 +109000 GO TO SEQ-DELETE-15. SQ1064.2 +109100 GO TO SEQ-TEST-RD-15. SQ1064.2 +109200 SEQ-DELETE-15. SQ1064.2 +109300 MOVE "*" TO DELETE-SW-3. SQ1064.2 +109400 GO TO SEQ-DELETE-15-01. SQ1064.2 +109500* SQ1064.2 +109600* EXECUTE THE READ STATEMENT SQ1064.2 +109700* SQ1064.2 +109800 SEQ-TEST-RD-15. SQ1064.2 +109900 READ SQ-VS6 AT END SQ1064.2 +110000 MOVE "EXECUTED" TO EOF-FLAG. SQ1064.2 +110100 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +110200 GO TO SEQ-TEST-RD-15-01. SQ1064.2 +110300* SQ1064.2 +110400* CHECK THE FILE STATUS VALUE SQ1064.2 +110500* SQ1064.2 +110600 SEQ-DELETE-15-01. SQ1064.2 +110700 PERFORM DE-LETE. SQ1064.2 +110800 GO TO SEQ-TEST-15-01-END. SQ1064.2 +110900 SEQ-TEST-RD-15-01. SQ1064.2 +111000 IF SQ-STATUS = "00" SQ1064.2 +111100 PERFORM PASS SQ1064.2 +111200 ELSE SQ1064.2 +111300 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +111400 MOVE "00" TO CORRECT-A SQ1064.2 +111500 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +111600 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +111700 PERFORM FAIL. SQ1064.2 +111800 SEQ-TEST-15-01-END. SQ1064.2 +111900* SQ1064.2 +112000* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +112100* SQ1064.2 +112200 ADD 1 TO REC-CT. SQ1064.2 +112300 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +112400 GO TO SEQ-DELETE-15-02. SQ1064.2 +112500 GO TO SEQ-TEST-RD-15-02. SQ1064.2 +112600 SEQ-DELETE-15-02. SQ1064.2 +112700 PERFORM DE-LETE. SQ1064.2 +112800 GO TO SEQ-TEST-15-02-END. SQ1064.2 +112900 SEQ-TEST-RD-15-02. SQ1064.2 +113000 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +113100 PERFORM PASS SQ1064.2 +113200 ELSE SQ1064.2 +113300 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +113400 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +113500 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +113600 PERFORM FAIL. SQ1064.2 +113700 SEQ-TEST-15-02-END. SQ1064.2 +113800* SQ1064.2 +113900* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +114000* SQ1064.2 +114100 ADD 1 TO REC-CT. SQ1064.2 +114200* IF DELETE-SW NOT = TO SPACE SQ1064.2 +114300* GO TO SEQ-DELETE-15-03. SQ1064.2 +114400* GO TO SEQ-TEST-RD-15-03. SQ1064.2 +114500 SEQ-DELETE-15-03. SQ1064.2 +114600 PERFORM DE-LETE. SQ1064.2 +114700 GO TO SEQ-TEST-15-03-END. SQ1064.2 +114800 SEQ-TEST-RD-15-03. SQ1064.2 +114900 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +115000 PERFORM PASS SQ1064.2 +115100 ELSE SQ1064.2 +115200 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +115300 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +115400 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +115500 PERFORM FAIL. SQ1064.2 +115600 SEQ-TEST-15-03-END. SQ1064.2 +115700* SQ1064.2 +115800* CHECK EXECUTION OF THE END PATH SQ1064.2 +115900* SQ1064.2 +116000 ADD 1 TO REC-CT. SQ1064.2 +116100 IF DELETE-SW NOT = SPACE SQ1064.2 +116200 GO TO SEQ-DELETE-15-04. SQ1064.2 +116300 GO TO SEQ-TEST-RD-15-04. SQ1064.2 +116400 SEQ-DELETE-15-04. SQ1064.2 +116500 PERFORM DE-LETE. SQ1064.2 +116600 GO TO SEQ-TEST-15-04-END. SQ1064.2 +116700 SEQ-TEST-RD-15-04. SQ1064.2 +116800 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +116900 PERFORM PASS SQ1064.2 +117000 ELSE SQ1064.2 +117100 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +117200 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +117300 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +117400 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +117500 MOVE "*" TO DELETE-SW-2 SQ1064.2 +117600 PERFORM FAIL. SQ1064.2 +117700 SEQ-TEST-15-04-END. SQ1064.2 +117800 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +117900* SQ1064.2 +118000* SQ1064.2 +118100* READ A LONG RECORD, USING READ ... END SQ1064.2 +118200* SQ1064.2 +118300 SEQ-INIT-16. SQ1064.2 +118400 MOVE 1 TO REC-CT. SQ1064.2 +118500 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +118600 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +118700 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +118800 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +118900 MOVE "**" TO SQ-STATUS. SQ1064.2 +119000 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +119100 MOVE "READ LONG END" TO FEATURE. SQ1064.2 +119200 MOVE "SEQ-TEST-RD-16" TO PAR-NAME. SQ1064.2 +119300 IF DELETE-SW NOT = SPACE SQ1064.2 +119400 GO TO SEQ-DELETE-16. SQ1064.2 +119500 GO TO SEQ-TEST-RD-16. SQ1064.2 +119600 SEQ-DELETE-16. SQ1064.2 +119700 MOVE "*" TO DELETE-SW-3. SQ1064.2 +119800 GO TO SEQ-DELETE-16-01. SQ1064.2 +119900* SQ1064.2 +120000* EXECUTE THE READ STATEMENT SQ1064.2 +120100* SQ1064.2 +120200 SEQ-TEST-RD-16. SQ1064.2 +120300 READ SQ-VS6 END SQ1064.2 +120400 MOVE "EXECUTED" TO EOF-FLAG. SQ1064.2 +120500 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +120600 GO TO SEQ-TEST-RD-16-01. SQ1064.2 +120700 SEQ-DELETE-16-01. SQ1064.2 +120800 PERFORM DE-LETE. SQ1064.2 +120900 GO TO SEQ-TEST-16-01-END. SQ1064.2 +121000* SQ1064.2 +121100* CHECK THE FILE STATUS RETURNED SQ1064.2 +121200* SQ1064.2 +121300 SEQ-TEST-RD-16-01. SQ1064.2 +121400 IF SQ-STATUS = "00" SQ1064.2 +121500 PERFORM PASS SQ1064.2 +121600 ELSE SQ1064.2 +121700 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +121800 MOVE "00" TO CORRECT-A SQ1064.2 +121900 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +122000 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +122100 PERFORM FAIL. SQ1064.2 +122200 SEQ-TEST-16-01-END. SQ1064.2 +122300* SQ1064.2 +122400* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +122500* SQ1064.2 +122600 ADD 1 TO REC-CT. SQ1064.2 +122700 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +122800 GO TO SEQ-DELETE-16-02. SQ1064.2 +122900 GO TO SEQ-TEST-RD-16-02. SQ1064.2 +123000 SEQ-DELETE-16-02. SQ1064.2 +123100 PERFORM DE-LETE. SQ1064.2 +123200 GO TO SEQ-TEST-16-02-END. SQ1064.2 +123300 SEQ-TEST-RD-16-02. SQ1064.2 +123400 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +123500 PERFORM PASS SQ1064.2 +123600 ELSE SQ1064.2 +123700 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +123800 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +123900 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +124000 PERFORM FAIL. SQ1064.2 +124100 SEQ-TEST-16-02-END. SQ1064.2 +124200* SQ1064.2 +124300* CHECK THE RECORD EXTENSION AREA SQ1064.2 +124400* SQ1064.2 +124500 ADD 1 TO REC-CT. SQ1064.2 +124600 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +124700 GO TO SEQ-DELETE-16-03. SQ1064.2 +124800 GO TO SEQ-TEST-RD-16-03. SQ1064.2 +124900 SEQ-DELETE-16-03. SQ1064.2 +125000 PERFORM DE-LETE. SQ1064.2 +125100 GO TO SEQ-TEST-16-03-END. SQ1064.2 +125200 SEQ-TEST-RD-16-03. SQ1064.2 +125300 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +125400 PERFORM PASS SQ1064.2 +125500 ELSE SQ1064.2 +125600 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +125700 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +125800 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +125900 PERFORM FAIL. SQ1064.2 +126000 SEQ-TEST-16-03-END. SQ1064.2 +126100* SQ1064.2 +126200* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +126300* SQ1064.2 +126400 ADD 1 TO REC-CT. SQ1064.2 +126500 IF DELETE-SW NOT = SPACE SQ1064.2 +126600 GO TO SEQ-DELETE-16-04. SQ1064.2 +126700 GO TO SEQ-TEST-RD-16-04. SQ1064.2 +126800 SEQ-DELETE-16-04. SQ1064.2 +126900 PERFORM DE-LETE. SQ1064.2 +127000 GO TO SEQ-TEST-16-04-END. SQ1064.2 +127100 SEQ-TEST-RD-16-04. SQ1064.2 +127200 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +127300 PERFORM PASS SQ1064.2 +127400 ELSE SQ1064.2 +127500 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +127600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +127700 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +127800 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +127900 MOVE "*" TO DELETE-SW-2 SQ1064.2 +128000 PERFORM FAIL. SQ1064.2 +128100 SEQ-TEST-16-04-END. SQ1064.2 +128200 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +128300* SQ1064.2 +128400* SQ1064.2 +128500* READ A SHORT RECORD, USING READ ... AT END ... NOT AT END SQ1064.2 +128600* SQ1064.2 +128700 SEQ-INIT-17. SQ1064.2 +128800 MOVE 1 TO REC-CT. SQ1064.2 +128900 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +129000 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +129100 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +129200 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +129300 MOVE "**" TO SQ-STATUS. SQ1064.2 +129400 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +129500 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +129600 MOVE "READ SHORT AT END N A E" TO FEATURE. SQ1064.2 +129700 MOVE "SEQ-TEST-RD-17" TO PAR-NAME. SQ1064.2 +129800 IF DELETE-SW NOT = SPACE SQ1064.2 +129900 GO TO SEQ-DELETE-17. SQ1064.2 +130000 GO TO SEQ-TEST-RD-17. SQ1064.2 +130100 SEQ-DELETE-17. SQ1064.2 +130200 MOVE "*" TO DELETE-SW-3. SQ1064.2 +130300 GO TO SEQ-DELETE-17-01. SQ1064.2 +130400* SQ1064.2 +130500* EXECUTE THE READ STATEMENT SQ1064.2 +130600* SQ1064.2 +130700 SEQ-TEST-RD-17. SQ1064.2 +130800 READ SQ-VS6 SQ1064.2 +130900 AT END SQ1064.2 +131000 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +131100 NOT AT END SQ1064.2 +131200 MOVE "EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +131300 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +131400 GO TO SEQ-TEST-RD-17-01. SQ1064.2 +131500* SQ1064.2 +131600* CHECK THE FILE STATUS VALUE SQ1064.2 +131700* SQ1064.2 +131800 SEQ-DELETE-17-01. SQ1064.2 +131900 PERFORM DE-LETE. SQ1064.2 +132000 GO TO SEQ-TEST-17-01-END. SQ1064.2 +132100 SEQ-TEST-RD-17-01. SQ1064.2 +132200 IF SQ-STATUS = "00" SQ1064.2 +132300 PERFORM PASS SQ1064.2 +132400 ELSE SQ1064.2 +132500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +132600 MOVE "00" TO CORRECT-A SQ1064.2 +132700 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +132800 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +132900 PERFORM FAIL. SQ1064.2 +133000 SEQ-TEST-17-01-END. SQ1064.2 +133100* SQ1064.2 +133200* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +133300* SQ1064.2 +133400 ADD 1 TO REC-CT. SQ1064.2 +133500 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +133600 GO TO SEQ-DELETE-17-02. SQ1064.2 +133700 GO TO SEQ-TEST-RD-17-02. SQ1064.2 +133800 SEQ-DELETE-17-02. SQ1064.2 +133900 PERFORM DE-LETE. SQ1064.2 +134000 GO TO SEQ-TEST-17-02-END. SQ1064.2 +134100 SEQ-TEST-RD-17-02. SQ1064.2 +134200 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +134300 PERFORM PASS SQ1064.2 +134400 ELSE SQ1064.2 +134500 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +134600 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +134700 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +134800 PERFORM FAIL. SQ1064.2 +134900 SEQ-TEST-17-02-END. SQ1064.2 +135000* SQ1064.2 +135100* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +135200* SQ1064.2 +135300 ADD 1 TO REC-CT. SQ1064.2 +135400* IF DELETE-SW NOT = TO SPACE SQ1064.2 +135500* GO TO SEQ-DELETE-17-03. SQ1064.2 +135600* GO TO SEQ-TEST-RD-17-03. SQ1064.2 +135700 SEQ-DELETE-17-03. SQ1064.2 +135800 PERFORM DE-LETE. SQ1064.2 +135900 GO TO SEQ-TEST-17-03-END. SQ1064.2 +136000 SEQ-TEST-RD-17-03. SQ1064.2 +136100 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +136200 PERFORM PASS SQ1064.2 +136300 ELSE SQ1064.2 +136400 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +136500 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +136600 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +136700 PERFORM FAIL. SQ1064.2 +136800 SEQ-TEST-17-03-END. SQ1064.2 +136900* SQ1064.2 +137000* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +137100* SQ1064.2 +137200 ADD 1 TO REC-CT. SQ1064.2 +137300 IF DELETE-SW NOT = SPACE SQ1064.2 +137400 GO TO SEQ-DELETE-17-04. SQ1064.2 +137500 GO TO SEQ-TEST-RD-17-04. SQ1064.2 +137600 SEQ-DELETE-17-04. SQ1064.2 +137700 PERFORM DE-LETE. SQ1064.2 +137800 GO TO SEQ-TEST-17-04-END. SQ1064.2 +137900 SEQ-TEST-RD-17-04. SQ1064.2 +138000 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +138100 PERFORM PASS SQ1064.2 +138200 ELSE SQ1064.2 +138300 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +138400 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +138500 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +138600 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +138700 PERFORM FAIL. SQ1064.2 +138800 SEQ-TEST-17-04-END. SQ1064.2 +138900* SQ1064.2 +139000* CHECK EXECUTION OF THE END PATH SQ1064.2 +139100* SQ1064.2 +139200 ADD 1 TO REC-CT. SQ1064.2 +139300 IF DELETE-SW NOT = SPACE SQ1064.2 +139400 GO TO SEQ-DELETE-17-05. SQ1064.2 +139500 GO TO SEQ-TEST-RD-17-05. SQ1064.2 +139600 SEQ-DELETE-17-05. SQ1064.2 +139700 PERFORM DE-LETE. SQ1064.2 +139800 GO TO SEQ-TEST-17-05-END. SQ1064.2 +139900 SEQ-TEST-RD-17-05. SQ1064.2 +140000 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +140100 PERFORM PASS SQ1064.2 +140200 ELSE SQ1064.2 +140300 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +140400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +140500 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +140600 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +140700 MOVE "*" TO DELETE-SW-2 SQ1064.2 +140800 PERFORM FAIL. SQ1064.2 +140900 SEQ-TEST-17-05-END. SQ1064.2 +141000 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +141100* SQ1064.2 +141200* SQ1064.2 +141300* READ A SHORT RECORD, USING READ ... END ... NOT AT END SQ1064.2 +141400* SQ1064.2 +141500 SEQ-INIT-18. SQ1064.2 +141600 MOVE 1 TO REC-CT. SQ1064.2 +141700 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +141800 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +141900 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +142000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +142100 MOVE "**" TO SQ-STATUS. SQ1064.2 +142200 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +142300 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +142400 MOVE "READ SHORT END N A E" TO FEATURE. SQ1064.2 +142500 MOVE "SEQ-TEST-RD-18" TO PAR-NAME. SQ1064.2 +142600 IF DELETE-SW NOT = SPACE SQ1064.2 +142700 GO TO SEQ-DELETE-18. SQ1064.2 +142800 GO TO SEQ-TEST-RD-18. SQ1064.2 +142900 SEQ-DELETE-18. SQ1064.2 +143000 MOVE "*" TO DELETE-SW-3. SQ1064.2 +143100 GO TO SEQ-DELETE-18-01. SQ1064.2 +143200* SQ1064.2 +143300* EXECUTE THE READ STATEMENT SQ1064.2 +143400* SQ1064.2 +143500 SEQ-TEST-RD-18. SQ1064.2 +143600 READ SQ-VS6 SQ1064.2 +143700 END SQ1064.2 +143800 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +143900 NOT AT END SQ1064.2 +144000 MOVE "EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +144100 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +144200 GO TO SEQ-TEST-RD-18-01. SQ1064.2 +144300* SQ1064.2 +144400* CHECK THE FILE STATUS VALUE SQ1064.2 +144500* SQ1064.2 +144600 SEQ-DELETE-18-01. SQ1064.2 +144700 PERFORM DE-LETE. SQ1064.2 +144800 GO TO SEQ-TEST-18-01-END. SQ1064.2 +144900 SEQ-TEST-RD-18-01. SQ1064.2 +145000 IF SQ-STATUS = "00" SQ1064.2 +145100 PERFORM PASS SQ1064.2 +145200 ELSE SQ1064.2 +145300 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +145400 MOVE "00" TO CORRECT-A SQ1064.2 +145500 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +145600 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +145700 PERFORM FAIL. SQ1064.2 +145800 SEQ-TEST-18-01-END. SQ1064.2 +145900* SQ1064.2 +146000* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +146100* SQ1064.2 +146200 ADD 1 TO REC-CT. SQ1064.2 +146300 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +146400 GO TO SEQ-DELETE-18-02. SQ1064.2 +146500 GO TO SEQ-TEST-RD-18-02. SQ1064.2 +146600 SEQ-DELETE-18-02. SQ1064.2 +146700 PERFORM DE-LETE. SQ1064.2 +146800 GO TO SEQ-TEST-18-02-END. SQ1064.2 +146900 SEQ-TEST-RD-18-02. SQ1064.2 +147000 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +147100 PERFORM PASS SQ1064.2 +147200 ELSE SQ1064.2 +147300 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +147400 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +147500 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +147600 PERFORM FAIL. SQ1064.2 +147700 SEQ-TEST-18-02-END. SQ1064.2 +147800* SQ1064.2 +147900* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +148000* SQ1064.2 +148100 ADD 1 TO REC-CT. SQ1064.2 +148200* IF DELETE-SW NOT = TO SPACE SQ1064.2 +148300* GO TO SEQ-DELETE-18-03. SQ1064.2 +148400* GO TO SEQ-TEST-RD-18-03. SQ1064.2 +148500 SEQ-DELETE-18-03. SQ1064.2 +148600 PERFORM DE-LETE. SQ1064.2 +148700 GO TO SEQ-TEST-18-03-END. SQ1064.2 +148800 SEQ-TEST-RD-18-03. SQ1064.2 +148900 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +149000 PERFORM PASS SQ1064.2 +149100 ELSE SQ1064.2 +149200 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +149300 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +149400 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +149500 PERFORM FAIL. SQ1064.2 +149600 SEQ-TEST-18-03-END. SQ1064.2 +149700* SQ1064.2 +149800* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +149900* SQ1064.2 +150000 ADD 1 TO REC-CT. SQ1064.2 +150100 IF DELETE-SW NOT = SPACE SQ1064.2 +150200 GO TO SEQ-DELETE-18-04. SQ1064.2 +150300 GO TO SEQ-TEST-RD-18-04. SQ1064.2 +150400 SEQ-DELETE-18-04. SQ1064.2 +150500 PERFORM DE-LETE. SQ1064.2 +150600 GO TO SEQ-TEST-18-04-END. SQ1064.2 +150700 SEQ-TEST-RD-18-04. SQ1064.2 +150800 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +150900 PERFORM PASS SQ1064.2 +151000 ELSE SQ1064.2 +151100 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +151200 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +151300 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +151400 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +151500 PERFORM FAIL. SQ1064.2 +151600 SEQ-TEST-18-04-END. SQ1064.2 +151700* SQ1064.2 +151800* CHECK EXECUTION OF THE END PATH SQ1064.2 +151900* SQ1064.2 +152000 ADD 1 TO REC-CT. SQ1064.2 +152100 IF DELETE-SW NOT = SPACE SQ1064.2 +152200 GO TO SEQ-DELETE-18-05. SQ1064.2 +152300 GO TO SEQ-TEST-RD-18-05. SQ1064.2 +152400 SEQ-DELETE-18-05. SQ1064.2 +152500 PERFORM DE-LETE. SQ1064.2 +152600 GO TO SEQ-TEST-18-05-END. SQ1064.2 +152700 SEQ-TEST-RD-18-05. SQ1064.2 +152800 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +152900 PERFORM PASS SQ1064.2 +153000 ELSE SQ1064.2 +153100 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +153200 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +153300 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +153400 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +153500 MOVE "*" TO DELETE-SW-2 SQ1064.2 +153600 PERFORM FAIL. SQ1064.2 +153700 SEQ-TEST-18-05-END. SQ1064.2 +153800 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +153900* SQ1064.2 +154000* SQ1064.2 +154100* READ A LONG RECORD, USING READ ... AT END ... NOT END ... SQ1064.2 +154200* SQ1064.2 +154300 SEQ-INIT-19. SQ1064.2 +154400 MOVE 1 TO REC-CT. SQ1064.2 +154500 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +154600 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +154700 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +154800 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +154900 MOVE "**" TO SQ-STATUS. SQ1064.2 +155000 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +155100 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +155200 MOVE "READ LONG AT END NOT END" TO FEATURE. SQ1064.2 +155300 MOVE "SEQ-TEST-RD-19" TO PAR-NAME. SQ1064.2 +155400 IF DELETE-SW NOT = SPACE SQ1064.2 +155500 GO TO SEQ-DELETE-19. SQ1064.2 +155600 GO TO SEQ-TEST-RD-19. SQ1064.2 +155700 SEQ-DELETE-19. SQ1064.2 +155800 MOVE "*" TO DELETE-SW-3. SQ1064.2 +155900 GO TO SEQ-DELETE-19-01. SQ1064.2 +156000* SQ1064.2 +156100* EXECUTE THE READ STATEMENT SQ1064.2 +156200* SQ1064.2 +156300 SEQ-TEST-RD-19. SQ1064.2 +156400 READ SQ-VS6 SQ1064.2 +156500 AT END SQ1064.2 +156600 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +156700 NOT END SQ1064.2 +156800 MOVE "EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +156900 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +157000 GO TO SEQ-TEST-RD-19-01. SQ1064.2 +157100 SEQ-DELETE-19-01. SQ1064.2 +157200 PERFORM DE-LETE. SQ1064.2 +157300 GO TO SEQ-TEST-19-01-END. SQ1064.2 +157400* SQ1064.2 +157500* CHECK THE FILE STATUS RETURNED SQ1064.2 +157600* SQ1064.2 +157700 SEQ-TEST-RD-19-01. SQ1064.2 +157800 IF SQ-STATUS = "00" SQ1064.2 +157900 PERFORM PASS SQ1064.2 +158000 ELSE SQ1064.2 +158100 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +158200 MOVE "00" TO CORRECT-A SQ1064.2 +158300 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +158400 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +158500 PERFORM FAIL. SQ1064.2 +158600 SEQ-TEST-19-01-END. SQ1064.2 +158700* SQ1064.2 +158800* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +158900* SQ1064.2 +159000 ADD 1 TO REC-CT. SQ1064.2 +159100 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +159200 GO TO SEQ-DELETE-19-02. SQ1064.2 +159300 GO TO SEQ-TEST-RD-19-02. SQ1064.2 +159400 SEQ-DELETE-19-02. SQ1064.2 +159500 PERFORM DE-LETE. SQ1064.2 +159600 GO TO SEQ-TEST-19-02-END. SQ1064.2 +159700 SEQ-TEST-RD-19-02. SQ1064.2 +159800 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +159900 PERFORM PASS SQ1064.2 +160000 ELSE SQ1064.2 +160100 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +160200 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +160300 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +160400 PERFORM FAIL. SQ1064.2 +160500 SEQ-TEST-19-02-END. SQ1064.2 +160600* SQ1064.2 +160700* CHECK THE RECORD EXTENSION AREA SQ1064.2 +160800* SQ1064.2 +160900 ADD 1 TO REC-CT. SQ1064.2 +161000 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +161100 GO TO SEQ-DELETE-19-03. SQ1064.2 +161200 GO TO SEQ-TEST-RD-19-03. SQ1064.2 +161300 SEQ-DELETE-19-03. SQ1064.2 +161400 PERFORM DE-LETE. SQ1064.2 +161500 GO TO SEQ-TEST-19-03-END. SQ1064.2 +161600 SEQ-TEST-RD-19-03. SQ1064.2 +161700 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +161800 PERFORM PASS SQ1064.2 +161900 ELSE SQ1064.2 +162000 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +162100 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +162200 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +162300 PERFORM FAIL. SQ1064.2 +162400 SEQ-TEST-19-03-END. SQ1064.2 +162500* SQ1064.2 +162600* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +162700* SQ1064.2 +162800 ADD 1 TO REC-CT. SQ1064.2 +162900 IF DELETE-SW NOT = SPACE SQ1064.2 +163000 GO TO SEQ-DELETE-19-04. SQ1064.2 +163100 GO TO SEQ-TEST-RD-19-04. SQ1064.2 +163200 SEQ-DELETE-19-04. SQ1064.2 +163300 PERFORM DE-LETE. SQ1064.2 +163400 GO TO SEQ-TEST-19-04-END. SQ1064.2 +163500 SEQ-TEST-RD-19-04. SQ1064.2 +163600 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +163700 PERFORM PASS SQ1064.2 +163800 ELSE SQ1064.2 +163900 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +164000 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +164100 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +164200 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +164300 PERFORM FAIL. SQ1064.2 +164400 SEQ-TEST-19-04-END. SQ1064.2 +164500* SQ1064.2 +164600* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +164700* SQ1064.2 +164800 ADD 1 TO REC-CT. SQ1064.2 +164900 IF DELETE-SW NOT = SPACE SQ1064.2 +165000 GO TO SEQ-DELETE-19-05. SQ1064.2 +165100 GO TO SEQ-TEST-RD-19-05. SQ1064.2 +165200 SEQ-DELETE-19-05. SQ1064.2 +165300 PERFORM DE-LETE. SQ1064.2 +165400 GO TO SEQ-TEST-19-05-END. SQ1064.2 +165500 SEQ-TEST-RD-19-05. SQ1064.2 +165600 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +165700 PERFORM PASS SQ1064.2 +165800 ELSE SQ1064.2 +165900 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +166000 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +166100 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +166200 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +166300 MOVE "*" TO DELETE-SW-2 SQ1064.2 +166400 PERFORM FAIL. SQ1064.2 +166500 SEQ-TEST-19-05-END. SQ1064.2 +166600 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +166700* SQ1064.2 +166800* SQ1064.2 +166900* READ A SHORT RECORD, USING READ ... END ... NOT END SQ1064.2 +167000* SQ1064.2 +167100 SEQ-INIT-20. SQ1064.2 +167200 MOVE 1 TO REC-CT. SQ1064.2 +167300 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +167400 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +167500 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +167600 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +167700 MOVE "**" TO SQ-STATUS. SQ1064.2 +167800 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +167900 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +168000 MOVE "READ SHORT END NOT END" TO FEATURE. SQ1064.2 +168100 MOVE "SEQ-TEST-RD-20" TO PAR-NAME. SQ1064.2 +168200 IF DELETE-SW NOT = SPACE SQ1064.2 +168300 GO TO SEQ-DELETE-20. SQ1064.2 +168400 GO TO SEQ-TEST-RD-20. SQ1064.2 +168500 SEQ-DELETE-20. SQ1064.2 +168600 MOVE "*" TO DELETE-SW-3. SQ1064.2 +168700 GO TO SEQ-DELETE-20-01. SQ1064.2 +168800* SQ1064.2 +168900* EXECUTE THE READ STATEMENT SQ1064.2 +169000* SQ1064.2 +169100 SEQ-TEST-RD-20. SQ1064.2 +169200 READ SQ-VS6 SQ1064.2 +169300 END SQ1064.2 +169400 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +169500 NOT END SQ1064.2 +169600 MOVE "EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +169700 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +169800 GO TO SEQ-TEST-RD-20-01. SQ1064.2 +169900* SQ1064.2 +170000* CHECK THE FILE STATUS VALUE SQ1064.2 +170100* SQ1064.2 +170200 SEQ-DELETE-20-01. SQ1064.2 +170300 PERFORM DE-LETE. SQ1064.2 +170400 GO TO SEQ-TEST-20-01-END. SQ1064.2 +170500 SEQ-TEST-RD-20-01. SQ1064.2 +170600 IF SQ-STATUS = "00" SQ1064.2 +170700 PERFORM PASS SQ1064.2 +170800 ELSE SQ1064.2 +170900 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +171000 MOVE "00" TO CORRECT-A SQ1064.2 +171100 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +171200 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +171300 PERFORM FAIL. SQ1064.2 +171400 SEQ-TEST-20-01-END. SQ1064.2 +171500* SQ1064.2 +171600* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +171700* SQ1064.2 +171800 ADD 1 TO REC-CT. SQ1064.2 +171900 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +172000 GO TO SEQ-DELETE-20-02. SQ1064.2 +172100 GO TO SEQ-TEST-RD-20-02. SQ1064.2 +172200 SEQ-DELETE-20-02. SQ1064.2 +172300 PERFORM DE-LETE. SQ1064.2 +172400 GO TO SEQ-TEST-20-02-END. SQ1064.2 +172500 SEQ-TEST-RD-20-02. SQ1064.2 +172600 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +172700 PERFORM PASS SQ1064.2 +172800 ELSE SQ1064.2 +172900 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +173000 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +173100 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +173200 PERFORM FAIL. SQ1064.2 +173300 SEQ-TEST-20-02-END. SQ1064.2 +173400* SQ1064.2 +173500* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +173600* SQ1064.2 +173700 ADD 1 TO REC-CT. SQ1064.2 +173800* IF DELETE-SW NOT = TO SPACE SQ1064.2 +173900* GO TO SEQ-DELETE-20-03. SQ1064.2 +174000* GO TO SEQ-TEST-RD-20-03. SQ1064.2 +174100 SEQ-DELETE-20-03. SQ1064.2 +174200 PERFORM DE-LETE. SQ1064.2 +174300 GO TO SEQ-TEST-20-03-END. SQ1064.2 +174400 SEQ-TEST-RD-20-03. SQ1064.2 +174500 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +174600 PERFORM PASS SQ1064.2 +174700 ELSE SQ1064.2 +174800 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +174900 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +175000 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +175100 PERFORM FAIL. SQ1064.2 +175200 SEQ-TEST-20-03-END. SQ1064.2 +175300* SQ1064.2 +175400* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +175500* SQ1064.2 +175600 ADD 1 TO REC-CT. SQ1064.2 +175700 IF DELETE-SW NOT = SPACE SQ1064.2 +175800 GO TO SEQ-DELETE-20-04. SQ1064.2 +175900 GO TO SEQ-TEST-RD-20-04. SQ1064.2 +176000 SEQ-DELETE-20-04. SQ1064.2 +176100 PERFORM DE-LETE. SQ1064.2 +176200 GO TO SEQ-TEST-20-04-END. SQ1064.2 +176300 SEQ-TEST-RD-20-04. SQ1064.2 +176400 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +176500 PERFORM PASS SQ1064.2 +176600 ELSE SQ1064.2 +176700 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +176800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +176900 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +177000 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +177100 PERFORM FAIL. SQ1064.2 +177200 SEQ-TEST-20-04-END. SQ1064.2 +177300* SQ1064.2 +177400* CHECK EXECUTION OF THE END PATH SQ1064.2 +177500* SQ1064.2 +177600 ADD 1 TO REC-CT. SQ1064.2 +177700 IF DELETE-SW NOT = SPACE SQ1064.2 +177800 GO TO SEQ-DELETE-20-05. SQ1064.2 +177900 GO TO SEQ-TEST-RD-20-05. SQ1064.2 +178000 SEQ-DELETE-20-05. SQ1064.2 +178100 PERFORM DE-LETE. SQ1064.2 +178200 GO TO SEQ-TEST-20-05-END. SQ1064.2 +178300 SEQ-TEST-RD-20-05. SQ1064.2 +178400 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +178500 PERFORM PASS SQ1064.2 +178600 ELSE SQ1064.2 +178700 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +178800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +178900 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +179000 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +179100 MOVE "*" TO DELETE-SW-2 SQ1064.2 +179200 PERFORM FAIL. SQ1064.2 +179300 SEQ-TEST-20-05-END. SQ1064.2 +179400 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +179500* SQ1064.2 +179600* SQ1064.2 +179700* READ A LONG RECORD, SQ1064.2 +179800* USING READ ... AT END ... END-READ SQ1064.2 +179900* SQ1064.2 +180000 SEQ-INIT-21. SQ1064.2 +180100 MOVE 1 TO REC-CT. SQ1064.2 +180200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +180300 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +180400 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +180500 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +180600 MOVE "**" TO SQ-STATUS. SQ1064.2 +180700 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +180800 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +180900 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +181000 MOVE "READ LONG AT END END-RD" TO FEATURE. SQ1064.2 +181100 MOVE "SEQ-TEST-RD-21" TO PAR-NAME. SQ1064.2 +181200 IF DELETE-SW NOT = SPACE SQ1064.2 +181300 GO TO SEQ-DELETE-21. SQ1064.2 +181400 GO TO SEQ-TEST-RD-21. SQ1064.2 +181500 SEQ-DELETE-21. SQ1064.2 +181600 MOVE "*" TO DELETE-SW-3. SQ1064.2 +181700 GO TO SEQ-DELETE-21-01. SQ1064.2 +181800* SQ1064.2 +181900* EXECUTE THE READ STATEMENT SQ1064.2 +182000* SQ1064.2 +182100 SEQ-TEST-RD-21. SQ1064.2 +182200 READ SQ-VS6 SQ1064.2 +182300 AT END SQ1064.2 +182400 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +182500 END-READ SQ1064.2 +182600 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +182700 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +182800 GO TO SEQ-TEST-RD-21-01. SQ1064.2 +182900 SEQ-DELETE-21-01. SQ1064.2 +183000 PERFORM DE-LETE. SQ1064.2 +183100 GO TO SEQ-TEST-21-01-END. SQ1064.2 +183200* SQ1064.2 +183300* CHECK THE FILE STATUS RETURNED SQ1064.2 +183400* SQ1064.2 +183500 SEQ-TEST-RD-21-01. SQ1064.2 +183600 IF SQ-STATUS = "00" SQ1064.2 +183700 PERFORM PASS SQ1064.2 +183800 ELSE SQ1064.2 +183900 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +184000 MOVE "00" TO CORRECT-A SQ1064.2 +184100 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +184200 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +184300 PERFORM FAIL. SQ1064.2 +184400 SEQ-TEST-21-01-END. SQ1064.2 +184500* SQ1064.2 +184600* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +184700* SQ1064.2 +184800 ADD 1 TO REC-CT. SQ1064.2 +184900 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +185000 GO TO SEQ-DELETE-21-02. SQ1064.2 +185100 GO TO SEQ-TEST-RD-21-02. SQ1064.2 +185200 SEQ-DELETE-21-02. SQ1064.2 +185300 PERFORM DE-LETE. SQ1064.2 +185400 GO TO SEQ-TEST-21-02-END. SQ1064.2 +185500 SEQ-TEST-RD-21-02. SQ1064.2 +185600 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +185700 PERFORM PASS SQ1064.2 +185800 ELSE SQ1064.2 +185900 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +186000 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +186100 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +186200 PERFORM FAIL. SQ1064.2 +186300 SEQ-TEST-21-02-END. SQ1064.2 +186400* SQ1064.2 +186500* CHECK THE RECORD EXTENSION AREA SQ1064.2 +186600* SQ1064.2 +186700 ADD 1 TO REC-CT. SQ1064.2 +186800 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +186900 GO TO SEQ-DELETE-21-03. SQ1064.2 +187000 GO TO SEQ-TEST-RD-21-03. SQ1064.2 +187100 SEQ-DELETE-21-03. SQ1064.2 +187200 PERFORM DE-LETE. SQ1064.2 +187300 GO TO SEQ-TEST-21-03-END. SQ1064.2 +187400 SEQ-TEST-RD-21-03. SQ1064.2 +187500 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +187600 PERFORM PASS SQ1064.2 +187700 ELSE SQ1064.2 +187800 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +187900 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +188000 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +188100 PERFORM FAIL. SQ1064.2 +188200 SEQ-TEST-21-03-END. SQ1064.2 +188300* SQ1064.2 +188400* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +188500* SQ1064.2 +188600 ADD 1 TO REC-CT. SQ1064.2 +188700 IF DELETE-SW NOT = SPACE SQ1064.2 +188800 GO TO SEQ-DELETE-21-04. SQ1064.2 +188900 GO TO SEQ-TEST-RD-21-04. SQ1064.2 +189000 SEQ-DELETE-21-04. SQ1064.2 +189100 PERFORM DE-LETE. SQ1064.2 +189200 GO TO SEQ-TEST-21-04-END. SQ1064.2 +189300 SEQ-TEST-RD-21-04. SQ1064.2 +189400 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +189500 PERFORM PASS SQ1064.2 +189600 ELSE SQ1064.2 +189700 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +189800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +189900 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +190000 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +190100 PERFORM FAIL. SQ1064.2 +190200 SEQ-TEST-21-04-END. SQ1064.2 +190300* SQ1064.2 +190400* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +190500* SQ1064.2 +190600 ADD 1 TO REC-CT. SQ1064.2 +190700 IF DELETE-SW NOT = SPACE SQ1064.2 +190800 GO TO SEQ-DELETE-21-05. SQ1064.2 +190900 GO TO SEQ-TEST-RD-21-05. SQ1064.2 +191000 SEQ-DELETE-21-05. SQ1064.2 +191100 PERFORM DE-LETE. SQ1064.2 +191200 GO TO SEQ-TEST-21-05-END. SQ1064.2 +191300 SEQ-TEST-RD-21-05. SQ1064.2 +191400 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +191500 PERFORM PASS SQ1064.2 +191600 ELSE SQ1064.2 +191700 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +191800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +191900 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +192000 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +192100 MOVE "*" TO DELETE-SW-2 SQ1064.2 +192200 PERFORM FAIL. SQ1064.2 +192300 SEQ-TEST-21-05-END. SQ1064.2 +192400 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +192500* SQ1064.2 +192600* SQ1064.2 +192700* READ A LONG RECORD, SQ1064.2 +192800* USING READ ... END ... END-READ SQ1064.2 +192900* SQ1064.2 +193000 SEQ-INIT-22. SQ1064.2 +193100 MOVE 1 TO REC-CT. SQ1064.2 +193200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +193300 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +193400 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +193500 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +193600 MOVE "**" TO SQ-STATUS. SQ1064.2 +193700 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +193800 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +193900 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +194000 MOVE "READ LONG END END-READ" TO FEATURE. SQ1064.2 +194100 MOVE "SEQ-TEST-RD-22" TO PAR-NAME. SQ1064.2 +194200 IF DELETE-SW NOT = SPACE SQ1064.2 +194300 GO TO SEQ-DELETE-22. SQ1064.2 +194400 GO TO SEQ-TEST-RD-22. SQ1064.2 +194500 SEQ-DELETE-22. SQ1064.2 +194600 MOVE "*" TO DELETE-SW-3. SQ1064.2 +194700 GO TO SEQ-DELETE-22-01. SQ1064.2 +194800* SQ1064.2 +194900* EXECUTE THE READ STATEMENT SQ1064.2 +195000* SQ1064.2 +195100 SEQ-TEST-RD-22. SQ1064.2 +195200 READ SQ-VS6 SQ1064.2 +195300 END SQ1064.2 +195400 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +195500 END-READ SQ1064.2 +195600 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +195700 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +195800 GO TO SEQ-TEST-RD-22-01. SQ1064.2 +195900 SEQ-DELETE-22-01. SQ1064.2 +196000 PERFORM DE-LETE. SQ1064.2 +196100 GO TO SEQ-TEST-22-01-END. SQ1064.2 +196200* SQ1064.2 +196300* CHECK THE FILE STATUS RETURNED SQ1064.2 +196400* SQ1064.2 +196500 SEQ-TEST-RD-22-01. SQ1064.2 +196600 IF SQ-STATUS = "00" SQ1064.2 +196700 PERFORM PASS SQ1064.2 +196800 ELSE SQ1064.2 +196900 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +197000 MOVE "00" TO CORRECT-A SQ1064.2 +197100 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +197200 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +197300 PERFORM FAIL. SQ1064.2 +197400 SEQ-TEST-22-01-END. SQ1064.2 +197500* SQ1064.2 +197600* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +197700* SQ1064.2 +197800 ADD 1 TO REC-CT. SQ1064.2 +197900 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +198000 GO TO SEQ-DELETE-22-02. SQ1064.2 +198100 GO TO SEQ-TEST-RD-22-02. SQ1064.2 +198200 SEQ-DELETE-22-02. SQ1064.2 +198300 PERFORM DE-LETE. SQ1064.2 +198400 GO TO SEQ-TEST-22-02-END. SQ1064.2 +198500 SEQ-TEST-RD-22-02. SQ1064.2 +198600 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +198700 PERFORM PASS SQ1064.2 +198800 ELSE SQ1064.2 +198900 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +199000 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +199100 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +199200 PERFORM FAIL. SQ1064.2 +199300 SEQ-TEST-22-02-END. SQ1064.2 +199400* SQ1064.2 +199500* CHECK THE RECORD EXTENSION AREA SQ1064.2 +199600* SQ1064.2 +199700 ADD 1 TO REC-CT. SQ1064.2 +199800 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +199900 GO TO SEQ-DELETE-22-03. SQ1064.2 +200000 GO TO SEQ-TEST-RD-22-03. SQ1064.2 +200100 SEQ-DELETE-22-03. SQ1064.2 +200200 PERFORM DE-LETE. SQ1064.2 +200300 GO TO SEQ-TEST-22-03-END. SQ1064.2 +200400 SEQ-TEST-RD-22-03. SQ1064.2 +200500 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +200600 PERFORM PASS SQ1064.2 +200700 ELSE SQ1064.2 +200800 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +200900 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +201000 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +201100 PERFORM FAIL. SQ1064.2 +201200 SEQ-TEST-22-03-END. SQ1064.2 +201300* SQ1064.2 +201400* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +201500* SQ1064.2 +201600 ADD 1 TO REC-CT. SQ1064.2 +201700 IF DELETE-SW NOT = SPACE SQ1064.2 +201800 GO TO SEQ-DELETE-22-04. SQ1064.2 +201900 GO TO SEQ-TEST-RD-22-04. SQ1064.2 +202000 SEQ-DELETE-22-04. SQ1064.2 +202100 PERFORM DE-LETE. SQ1064.2 +202200 GO TO SEQ-TEST-22-04-END. SQ1064.2 +202300 SEQ-TEST-RD-22-04. SQ1064.2 +202400 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +202500 PERFORM PASS SQ1064.2 +202600 ELSE SQ1064.2 +202700 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +202800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +202900 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +203000 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +203100 PERFORM FAIL. SQ1064.2 +203200 SEQ-TEST-22-04-END. SQ1064.2 +203300* SQ1064.2 +203400* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +203500* SQ1064.2 +203600 ADD 1 TO REC-CT. SQ1064.2 +203700 IF DELETE-SW NOT = SPACE SQ1064.2 +203800 GO TO SEQ-DELETE-22-05. SQ1064.2 +203900 GO TO SEQ-TEST-RD-22-05. SQ1064.2 +204000 SEQ-DELETE-22-05. SQ1064.2 +204100 PERFORM DE-LETE. SQ1064.2 +204200 GO TO SEQ-TEST-22-05-END. SQ1064.2 +204300 SEQ-TEST-RD-22-05. SQ1064.2 +204400 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +204500 PERFORM PASS SQ1064.2 +204600 ELSE SQ1064.2 +204700 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +204800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +204900 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +205000 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +205100 MOVE "*" TO DELETE-SW-2 SQ1064.2 +205200 PERFORM FAIL. SQ1064.2 +205300 SEQ-TEST-22-05-END. SQ1064.2 +205400 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +205500* SQ1064.2 +205600* SQ1064.2 +205700* READ A LONG RECORD, SQ1064.2 +205800* USING READ ... AT END ... NOT AT END ... END-READ SQ1064.2 +205900* SQ1064.2 +206000 SEQ-INIT-23. SQ1064.2 +206100 MOVE 1 TO REC-CT. SQ1064.2 +206200 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +206300 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +206400 MOVE "LONG" TO BUFFER-COPY-L-OR-S. SQ1064.2 +206500 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +206600 MOVE "**" TO SQ-STATUS. SQ1064.2 +206700 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +206800 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +206900 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +207000 MOVE "READ LONG AT END NAE E-R" TO FEATURE. SQ1064.2 +207100 MOVE "SEQ-TEST-RD-23" TO PAR-NAME. SQ1064.2 +207200 IF DELETE-SW NOT = SPACE SQ1064.2 +207300 GO TO SEQ-DELETE-23. SQ1064.2 +207400 GO TO SEQ-TEST-RD-23. SQ1064.2 +207500 SEQ-DELETE-23. SQ1064.2 +207600 MOVE "*" TO DELETE-SW-3. SQ1064.2 +207700 GO TO SEQ-DELETE-23-01. SQ1064.2 +207800* SQ1064.2 +207900* EXECUTE THE READ STATEMENT SQ1064.2 +208000* SQ1064.2 +208100 SEQ-TEST-RD-23. SQ1064.2 +208200 READ SQ-VS6 SQ1064.2 +208300 AT END SQ1064.2 +208400 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +208500 NOT AT END SQ1064.2 +208600 MOVE "EXECUTED" TO NOT-EOF-FLAG SQ1064.2 +208700 END-READ SQ1064.2 +208800 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +208900 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +209000 GO TO SEQ-TEST-RD-23-01. SQ1064.2 +209100 SEQ-DELETE-23-01. SQ1064.2 +209200 PERFORM DE-LETE. SQ1064.2 +209300 GO TO SEQ-TEST-23-01-END. SQ1064.2 +209400* SQ1064.2 +209500* CHECK THE FILE STATUS RETURNED SQ1064.2 +209600* SQ1064.2 +209700 SEQ-TEST-RD-23-01. SQ1064.2 +209800 IF SQ-STATUS = "00" SQ1064.2 +209900 PERFORM PASS SQ1064.2 +210000 ELSE SQ1064.2 +210100 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +210200 MOVE "00" TO CORRECT-A SQ1064.2 +210300 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +210400 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +210500 PERFORM FAIL. SQ1064.2 +210600 SEQ-TEST-23-01-END. SQ1064.2 +210700* SQ1064.2 +210800* CHECK THE IDENTITY OF THE RECORD RETURNED SQ1064.2 +210900* SQ1064.2 +211000 ADD 1 TO REC-CT. SQ1064.2 +211100 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +211200 GO TO SEQ-DELETE-23-02. SQ1064.2 +211300 GO TO SEQ-TEST-RD-23-02. SQ1064.2 +211400 SEQ-DELETE-23-02. SQ1064.2 +211500 PERFORM DE-LETE. SQ1064.2 +211600 GO TO SEQ-TEST-23-02-END. SQ1064.2 +211700 SEQ-TEST-RD-23-02. SQ1064.2 +211800 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +211900 PERFORM PASS SQ1064.2 +212000 ELSE SQ1064.2 +212100 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +212200 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +212300 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +212400 PERFORM FAIL. SQ1064.2 +212500 SEQ-TEST-23-02-END. SQ1064.2 +212600* SQ1064.2 +212700* CHECK THE RECORD EXTENSION AREA SQ1064.2 +212800* SQ1064.2 +212900 ADD 1 TO REC-CT. SQ1064.2 +213000 IF DELETE-SW NOT EQUAL TO SPACE SQ1064.2 +213100 GO TO SEQ-DELETE-23-03. SQ1064.2 +213200 GO TO SEQ-TEST-RD-23-03. SQ1064.2 +213300 SEQ-DELETE-23-03. SQ1064.2 +213400 PERFORM DE-LETE. SQ1064.2 +213500 GO TO SEQ-TEST-23-03-END. SQ1064.2 +213600 SEQ-TEST-RD-23-03. SQ1064.2 +213700 IF SQ-VS6R2-SECOND-L = BUFFER-COPY-SECOND-L SQ1064.2 +213800 PERFORM PASS SQ1064.2 +213900 ELSE SQ1064.2 +214000 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +214100 MOVE BUFFER-COPY-SECOND-L TO CORRECT-A SQ1064.2 +214200 MOVE "INCORRECT VALUE IN BUFFER EXTENSION" TO RE-MARK SQ1064.2 +214300 PERFORM FAIL. SQ1064.2 +214400 SEQ-TEST-23-03-END. SQ1064.2 +214500* SQ1064.2 +214600* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +214700* SQ1064.2 +214800 ADD 1 TO REC-CT. SQ1064.2 +214900 IF DELETE-SW NOT = SPACE SQ1064.2 +215000 GO TO SEQ-DELETE-23-04. SQ1064.2 +215100 GO TO SEQ-TEST-RD-23-04. SQ1064.2 +215200 SEQ-DELETE-23-04. SQ1064.2 +215300 PERFORM DE-LETE. SQ1064.2 +215400 GO TO SEQ-TEST-23-04-END. SQ1064.2 +215500 SEQ-TEST-RD-23-04. SQ1064.2 +215600 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +215700 PERFORM PASS SQ1064.2 +215800 ELSE SQ1064.2 +215900 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +216000 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +216100 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +216200 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +216300 PERFORM FAIL. SQ1064.2 +216400 SEQ-TEST-23-04-END. SQ1064.2 +216500* SQ1064.2 +216600* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +216700* SQ1064.2 +216800 ADD 1 TO REC-CT. SQ1064.2 +216900 IF DELETE-SW NOT = SPACE SQ1064.2 +217000 GO TO SEQ-DELETE-23-05. SQ1064.2 +217100 GO TO SEQ-TEST-RD-23-05. SQ1064.2 +217200 SEQ-DELETE-23-05. SQ1064.2 +217300 PERFORM DE-LETE. SQ1064.2 +217400 GO TO SEQ-TEST-23-05-END. SQ1064.2 +217500 SEQ-TEST-RD-23-05. SQ1064.2 +217600 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +217700 PERFORM PASS SQ1064.2 +217800 ELSE SQ1064.2 +217900 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +218000 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +218100 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +218200 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +218300 PERFORM FAIL. SQ1064.2 +218400 SEQ-TEST-23-05-END. SQ1064.2 +218500* SQ1064.2 +218600* CHECK EXECUTION OF THE END PHRASE SQ1064.2 +218700* SQ1064.2 +218800 ADD 1 TO REC-CT. SQ1064.2 +218900 IF DELETE-SW NOT = SPACE SQ1064.2 +219000 GO TO SEQ-DELETE-23-06. SQ1064.2 +219100 GO TO SEQ-TEST-RD-23-06. SQ1064.2 +219200 SEQ-DELETE-23-06. SQ1064.2 +219300 PERFORM DE-LETE. SQ1064.2 +219400 GO TO SEQ-TEST-23-06-END. SQ1064.2 +219500 SEQ-TEST-RD-23-06. SQ1064.2 +219600 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +219700 PERFORM PASS SQ1064.2 +219800 ELSE SQ1064.2 +219900 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +220000 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +220100 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +220200 MOVE "V11-46,4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +220300 MOVE "*" TO DELETE-SW-2 SQ1064.2 +220400 PERFORM FAIL. SQ1064.2 +220500 SEQ-TEST-23-06-END. SQ1064.2 +220600 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +220700* SQ1064.2 +220800* SQ1064.2 +220900* READ A SHORT RECORD, SQ1064.2 +221000* USING READ ... END ... NOT AT END ... END-READ SQ1064.2 +221100* SQ1064.2 +221200 SEQ-INIT-24. SQ1064.2 +221300 MOVE 1 TO REC-CT. SQ1064.2 +221400 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +221500 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +221600 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +221700 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +221800 MOVE "**" TO SQ-STATUS. SQ1064.2 +221900 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +222000 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +222100 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +222200 MOVE "READ SHORT END N A R E-R" TO FEATURE. SQ1064.2 +222300 MOVE "SEQ-TEST-RD-24" TO PAR-NAME. SQ1064.2 +222400 IF DELETE-SW NOT = SPACE SQ1064.2 +222500 GO TO SEQ-DELETE-24. SQ1064.2 +222600 GO TO SEQ-TEST-RD-24. SQ1064.2 +222700 SEQ-DELETE-24. SQ1064.2 +222800 MOVE "*" TO DELETE-SW-3. SQ1064.2 +222900 GO TO SEQ-DELETE-24-01. SQ1064.2 +223000* SQ1064.2 +223100* EXECUTE THE READ STATEMENT SQ1064.2 +223200* SQ1064.2 +223300 SEQ-TEST-RD-24. SQ1064.2 +223400 READ SQ-VS6 SQ1064.2 +223500 END SQ1064.2 +223600 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +223700 NOT AT END SQ1064.2 +223800 MOVE "EXECUTED" TO NOT-EOF-FLAG SQ1064.2 +223900 END-READ SQ1064.2 +224000 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +224100 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +224200 GO TO SEQ-TEST-RD-24-01. SQ1064.2 +224300* SQ1064.2 +224400* CHECK THE FILE STATUS VALUE SQ1064.2 +224500* SQ1064.2 +224600 SEQ-DELETE-24-01. SQ1064.2 +224700 PERFORM DE-LETE. SQ1064.2 +224800 GO TO SEQ-TEST-24-01-END. SQ1064.2 +224900 SEQ-TEST-RD-24-01. SQ1064.2 +225000 IF SQ-STATUS = "00" SQ1064.2 +225100 PERFORM PASS SQ1064.2 +225200 ELSE SQ1064.2 +225300 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +225400 MOVE "00" TO CORRECT-A SQ1064.2 +225500 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +225600 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +225700 PERFORM FAIL. SQ1064.2 +225800 SEQ-TEST-24-01-END. SQ1064.2 +225900* SQ1064.2 +226000* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +226100* SQ1064.2 +226200 ADD 1 TO REC-CT. SQ1064.2 +226300 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +226400 GO TO SEQ-DELETE-24-02. SQ1064.2 +226500 GO TO SEQ-TEST-RD-24-02. SQ1064.2 +226600 SEQ-DELETE-24-02. SQ1064.2 +226700 PERFORM DE-LETE. SQ1064.2 +226800 GO TO SEQ-TEST-24-02-END. SQ1064.2 +226900 SEQ-TEST-RD-24-02. SQ1064.2 +227000 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +227100 PERFORM PASS SQ1064.2 +227200 ELSE SQ1064.2 +227300 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +227400 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +227500 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +227600 PERFORM FAIL. SQ1064.2 +227700 SEQ-TEST-24-02-END. SQ1064.2 +227800* SQ1064.2 +227900* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +228000* SQ1064.2 +228100 ADD 1 TO REC-CT. SQ1064.2 +228200* IF DELETE-SW NOT = TO SPACE SQ1064.2 +228300* GO TO SEQ-DELETE-24-03. SQ1064.2 +228400* GO TO SEQ-TEST-RD-24-03. SQ1064.2 +228500 SEQ-DELETE-24-03. SQ1064.2 +228600 PERFORM DE-LETE. SQ1064.2 +228700 GO TO SEQ-TEST-24-03-END. SQ1064.2 +228800 SEQ-TEST-RD-24-03. SQ1064.2 +228900 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +229000 PERFORM PASS SQ1064.2 +229100 ELSE SQ1064.2 +229200 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +229300 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +229400 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +229500 PERFORM FAIL. SQ1064.2 +229600 SEQ-TEST-24-03-END. SQ1064.2 +229700* SQ1064.2 +229800* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +229900* SQ1064.2 +230000 ADD 1 TO REC-CT. SQ1064.2 +230100 IF DELETE-SW NOT = SPACE SQ1064.2 +230200 GO TO SEQ-DELETE-24-04. SQ1064.2 +230300 GO TO SEQ-TEST-RD-24-04. SQ1064.2 +230400 SEQ-DELETE-24-04. SQ1064.2 +230500 PERFORM DE-LETE. SQ1064.2 +230600 GO TO SEQ-TEST-24-04-END. SQ1064.2 +230700 SEQ-TEST-RD-24-04. SQ1064.2 +230800 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +230900 PERFORM PASS SQ1064.2 +231000 ELSE SQ1064.2 +231100 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +231200 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +231300 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +231400 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +231500 PERFORM FAIL. SQ1064.2 +231600 SEQ-TEST-24-04-END. SQ1064.2 +231700* SQ1064.2 +231800* SQ1064.2 +231900* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +232000* SQ1064.2 +232100 ADD 1 TO REC-CT. SQ1064.2 +232200 IF DELETE-SW NOT = SPACE SQ1064.2 +232300 GO TO SEQ-DELETE-24-05. SQ1064.2 +232400 GO TO SEQ-TEST-RD-24-05. SQ1064.2 +232500 SEQ-DELETE-24-05. SQ1064.2 +232600 PERFORM DE-LETE. SQ1064.2 +232700 GO TO SEQ-TEST-24-05-END. SQ1064.2 +232800 SEQ-TEST-RD-24-05. SQ1064.2 +232900 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +233000 PERFORM PASS SQ1064.2 +233100 ELSE SQ1064.2 +233200 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +233300 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +233400 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +233500 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +233600 PERFORM FAIL. SQ1064.2 +233700 SEQ-TEST-24-05-END. SQ1064.2 +233800* SQ1064.2 +233900* CHECK EXECUTION OF THE END PATH SQ1064.2 +234000* SQ1064.2 +234100 ADD 1 TO REC-CT. SQ1064.2 +234200 IF DELETE-SW NOT = SPACE SQ1064.2 +234300 GO TO SEQ-DELETE-24-06. SQ1064.2 +234400 GO TO SEQ-TEST-RD-24-06. SQ1064.2 +234500 SEQ-DELETE-24-06. SQ1064.2 +234600 PERFORM DE-LETE. SQ1064.2 +234700 GO TO SEQ-TEST-24-06-END. SQ1064.2 +234800 SEQ-TEST-RD-24-06. SQ1064.2 +234900 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +235000 PERFORM PASS SQ1064.2 +235100 ELSE SQ1064.2 +235200 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +235300 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +235400 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +235500 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +235600 MOVE "*" TO DELETE-SW-2 SQ1064.2 +235700 PERFORM FAIL. SQ1064.2 +235800 SEQ-TEST-24-06-END. SQ1064.2 +235900 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +236000* SQ1064.2 +236100* SQ1064.2 +236200* READ A SHORT RECORD, SQ1064.2 +236300* USING READ ... AT END ... NOT END ... END-READ SQ1064.2 +236400* SQ1064.2 +236500 SEQ-INIT-25. SQ1064.2 +236600 MOVE 1 TO REC-CT. SQ1064.2 +236700 ADD 1 TO XRECORD-NUMBER (1). SQ1064.2 +236800 MOVE "**********" TO SQ-VS6R2-SECOND-L. SQ1064.2 +236900 MOVE "SHORT" TO BUFFER-COPY-L-OR-S. SQ1064.2 +237000 ADD 1 TO BUFFER-COPY-RECNO. SQ1064.2 +237100 MOVE "**" TO SQ-STATUS. SQ1064.2 +237200 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +237300 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +237400 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +237500 MOVE "READ SHORT A END N E E-R" TO FEATURE. SQ1064.2 +237600 MOVE "SEQ-TEST-RD-25" TO PAR-NAME. SQ1064.2 +237700 IF DELETE-SW NOT = SPACE SQ1064.2 +237800 GO TO SEQ-DELETE-25. SQ1064.2 +237900 GO TO SEQ-TEST-RD-25. SQ1064.2 +238000 SEQ-DELETE-25. SQ1064.2 +238100 MOVE "*" TO DELETE-SW-3. SQ1064.2 +238200 GO TO SEQ-DELETE-25-01. SQ1064.2 +238300* SQ1064.2 +238400* EXECUTE THE READ STATEMENT SQ1064.2 +238500* SQ1064.2 +238600 SEQ-TEST-RD-25. SQ1064.2 +238700 READ SQ-VS6 SQ1064.2 +238800 AT END SQ1064.2 +238900 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +239000 NOT END SQ1064.2 +239100 MOVE "EXECUTED" TO NOT-EOF-FLAG SQ1064.2 +239200 END-READ SQ1064.2 +239300 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +239400 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +239500 GO TO SEQ-TEST-RD-25-01. SQ1064.2 +239600* SQ1064.2 +239700* CHECK THE FILE STATUS VALUE SQ1064.2 +239800* SQ1064.2 +239900 SEQ-DELETE-25-01. SQ1064.2 +240000 PERFORM DE-LETE. SQ1064.2 +240100 GO TO SEQ-TEST-25-01-END. SQ1064.2 +240200 SEQ-TEST-RD-25-01. SQ1064.2 +240300 IF SQ-STATUS = "00" SQ1064.2 +240400 PERFORM PASS SQ1064.2 +240500 ELSE SQ1064.2 +240600 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +240700 MOVE "00" TO CORRECT-A SQ1064.2 +240800 MOVE "UNEXPECTED I-O STATUS ON READ" TO RE-MARK SQ1064.2 +240900 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +241000 PERFORM FAIL. SQ1064.2 +241100 SEQ-TEST-25-01-END. SQ1064.2 +241200* SQ1064.2 +241300* CHECK THE RECORD NUMBER OF THE RECORD READ SQ1064.2 +241400* SQ1064.2 +241500 ADD 1 TO REC-CT. SQ1064.2 +241600 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +241700 GO TO SEQ-DELETE-25-02. SQ1064.2 +241800 GO TO SEQ-TEST-RD-25-02. SQ1064.2 +241900 SEQ-DELETE-25-02. SQ1064.2 +242000 PERFORM DE-LETE. SQ1064.2 +242100 GO TO SEQ-TEST-25-02-END. SQ1064.2 +242200 SEQ-TEST-RD-25-02. SQ1064.2 +242300 IF XRECORD-NUMBER (1) = XRECORD-NUMBER (2) SQ1064.2 +242400 PERFORM PASS SQ1064.2 +242500 ELSE SQ1064.2 +242600 MOVE XRECORD-NUMBER (2) TO COMPUTED-A SQ1064.2 +242700 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1064.2 +242800 MOVE "UNEXPECTED RECORD RETURNED" TO RE-MARK SQ1064.2 +242900 PERFORM FAIL. SQ1064.2 +243000 SEQ-TEST-25-02-END. SQ1064.2 +243100* SQ1064.2 +243200* CHECK THE EXTENDED PART OF THE RECORD SQ1064.2 +243300* SQ1064.2 +243400 ADD 1 TO REC-CT. SQ1064.2 +243500* IF DELETE-SW NOT = TO SPACE SQ1064.2 +243600* GO TO SEQ-DELETE-25-03. SQ1064.2 +243700* GO TO SEQ-TEST-RD-25-03. SQ1064.2 +243800 SEQ-DELETE-25-03. SQ1064.2 +243900 PERFORM DE-LETE. SQ1064.2 +244000 GO TO SEQ-TEST-25-03-END. SQ1064.2 +244100 SEQ-TEST-RD-25-03. SQ1064.2 +244200 IF SQ-VS6R2-SECOND-L NOT = BUFFER-COPY-SECOND-L SQ1064.2 +244300 PERFORM PASS SQ1064.2 +244400 ELSE SQ1064.2 +244500 MOVE SQ-VS6R2-SECOND-L TO COMPUTED-A SQ1064.2 +244600 MOVE "**UNDEFINED**" TO CORRECT-A SQ1064.2 +244700 MOVE "BUFFER CONTENTS FOR LONG RECORD" TO RE-MARK SQ1064.2 +244800 PERFORM FAIL. SQ1064.2 +244900 SEQ-TEST-25-03-END. SQ1064.2 +245000* SQ1064.2 +245100* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +245200* SQ1064.2 +245300 ADD 1 TO REC-CT. SQ1064.2 +245400 IF DELETE-SW NOT = SPACE SQ1064.2 +245500 GO TO SEQ-DELETE-25-04. SQ1064.2 +245600 GO TO SEQ-TEST-RD-25-04. SQ1064.2 +245700 SEQ-DELETE-25-04. SQ1064.2 +245800 PERFORM DE-LETE. SQ1064.2 +245900 GO TO SEQ-TEST-25-04-END. SQ1064.2 +246000 SEQ-TEST-RD-25-04. SQ1064.2 +246100 IF NOT-EOF-FLAG = "EXECUTED" SQ1064.2 +246200 PERFORM PASS SQ1064.2 +246300 ELSE SQ1064.2 +246400 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +246500 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +246600 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +246700 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +246800 PERFORM FAIL. SQ1064.2 +246900 SEQ-TEST-25-04-END. SQ1064.2 +247000* SQ1064.2 +247100* SQ1064.2 +247200* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +247300* SQ1064.2 +247400 ADD 1 TO REC-CT. SQ1064.2 +247500 IF DELETE-SW NOT = SPACE SQ1064.2 +247600 GO TO SEQ-DELETE-25-05. SQ1064.2 +247700 GO TO SEQ-TEST-RD-25-05. SQ1064.2 +247800 SEQ-DELETE-25-05. SQ1064.2 +247900 PERFORM DE-LETE. SQ1064.2 +248000 GO TO SEQ-TEST-25-05-END. SQ1064.2 +248100 SEQ-TEST-RD-25-05. SQ1064.2 +248200 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +248300 PERFORM PASS SQ1064.2 +248400 ELSE SQ1064.2 +248500 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +248600 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +248700 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +248800 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +248900 PERFORM FAIL. SQ1064.2 +249000 SEQ-TEST-25-05-END. SQ1064.2 +249100* SQ1064.2 +249200* CHECK EXECUTION OF THE END PATH SQ1064.2 +249300* SQ1064.2 +249400 ADD 1 TO REC-CT. SQ1064.2 +249500 IF DELETE-SW NOT = SPACE SQ1064.2 +249600 GO TO SEQ-DELETE-25-06. SQ1064.2 +249700 GO TO SEQ-TEST-RD-25-06. SQ1064.2 +249800 SEQ-DELETE-25-06. SQ1064.2 +249900 PERFORM DE-LETE. SQ1064.2 +250000 GO TO SEQ-TEST-25-06-END. SQ1064.2 +250100 SEQ-TEST-RD-25-06. SQ1064.2 +250200 IF EOF-FLAG = "NOT EXECUTED" SQ1064.2 +250300 PERFORM PASS SQ1064.2 +250400 ELSE SQ1064.2 +250500 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +250600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +250700 MOVE "AT END BRANCH TAKEN BEFORE EOF" TO RE-MARK SQ1064.2 +250800 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +250900 MOVE "*" TO DELETE-SW-2 SQ1064.2 +251000 PERFORM FAIL. SQ1064.2 +251100 SEQ-TEST-25-06-END. SQ1064.2 +251200 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +251300* SQ1064.2 +251400* SQ1064.2 +251500* READ AT END OF FILE, RAISING EOF CONDITION SQ1064.2 +251600* USING READ ... END ... NOT END ... END-READ SQ1064.2 +251700* SQ1064.2 +251800 SEQ-INIT-26. SQ1064.2 +251900 MOVE 1 TO REC-CT. SQ1064.2 +252000 MOVE "**" TO SQ-STATUS. SQ1064.2 +252100 MOVE "NOT EXECUTED" TO EOF-FLAG. SQ1064.2 +252200 MOVE "NOT EXECUTED" TO NOT-EOF-FLAG. SQ1064.2 +252300 MOVE "NOT EXECUTED" TO END-READ-FLAG. SQ1064.2 +252400 MOVE "READ SHORT A END N E E-R" TO FEATURE. SQ1064.2 +252500 MOVE "SEQ-TEST-RD-26" TO PAR-NAME. SQ1064.2 +252600 IF DELETE-SW NOT = SPACE SQ1064.2 +252700 GO TO SEQ-DELETE-26. SQ1064.2 +252800 GO TO SEQ-TEST-RD-26. SQ1064.2 +252900 SEQ-DELETE-26. SQ1064.2 +253000 MOVE "*" TO DELETE-SW-3. SQ1064.2 +253100 GO TO SEQ-DELETE-26-01. SQ1064.2 +253200* SQ1064.2 +253300* EXECUTE THE READ STATEMENT SQ1064.2 +253400* SQ1064.2 +253500 SEQ-TEST-RD-26. SQ1064.2 +253600 READ SQ-VS6 SQ1064.2 +253700 END SQ1064.2 +253800 MOVE "EXECUTED" TO EOF-FLAG SQ1064.2 +253900 NOT END SQ1064.2 +254000 MOVE "EXECUTED" TO NOT-EOF-FLAG SQ1064.2 +254100 END-READ SQ1064.2 +254200 MOVE "EXECUTED" TO END-READ-FLAG. SQ1064.2 +254300 MOVE SQ-VS6R1-M-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1064.2 +254400 GO TO SEQ-TEST-RD-26-01. SQ1064.2 +254500* SQ1064.2 +254600* CHECK THE FILE STATUS VALUE SQ1064.2 +254700* SQ1064.2 +254800 SEQ-DELETE-26-01. SQ1064.2 +254900 PERFORM DE-LETE. SQ1064.2 +255000 GO TO SEQ-TEST-26-01-END. SQ1064.2 +255100 SEQ-TEST-RD-26-01. SQ1064.2 +255200 IF SQ-STATUS = "10" SQ1064.2 +255300 PERFORM PASS SQ1064.2 +255400 ELSE SQ1064.2 +255500 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +255600 MOVE "10" TO CORRECT-A SQ1064.2 +255700 MOVE "I-O STATUS FOR EOF NOT RETURNED" TO RE-MARK SQ1064.2 +255800 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1064.2 +255900 PERFORM FAIL. SQ1064.2 +256000 SEQ-TEST-26-01-END. SQ1064.2 +256100* SQ1064.2 +256200* SQ1064.2 +256300* CHECK EXECUTION OF THE NOT END PATH SQ1064.2 +256400* SQ1064.2 +256500 ADD 1 TO REC-CT. SQ1064.2 +256600 IF DELETE-SW NOT = SPACE SQ1064.2 +256700 GO TO SEQ-DELETE-26-02. SQ1064.2 +256800 GO TO SEQ-TEST-RD-26-02. SQ1064.2 +256900 SEQ-DELETE-26-02. SQ1064.2 +257000 PERFORM DE-LETE. SQ1064.2 +257100 GO TO SEQ-TEST-26-02-END. SQ1064.2 +257200 SEQ-TEST-RD-26-02. SQ1064.2 +257300 IF NOT-EOF-FLAG = "NOT EXECUTED" SQ1064.2 +257400 PERFORM PASS SQ1064.2 +257500 ELSE SQ1064.2 +257600 MOVE NOT-EOF-FLAG TO COMPUTED-A SQ1064.2 +257700 MOVE "NOT EXECUTED" TO CORRECT-A SQ1064.2 +257800 MOVE "NOT END PATH EXECUTED AT EOF" TO RE-MARK SQ1064.2 +257900 MOVE "VII-46,4.4.4(11)" TO ANSI-REFERENCE SQ1064.2 +258000 PERFORM FAIL. SQ1064.2 +258100 SEQ-TEST-26-02-END. SQ1064.2 +258200* SQ1064.2 +258300* SQ1064.2 +258400* CHECK EXECUTION OF THE STATEMENT AFTER END-READ SQ1064.2 +258500* SQ1064.2 +258600 ADD 1 TO REC-CT. SQ1064.2 +258700 IF DELETE-SW NOT = SPACE SQ1064.2 +258800 GO TO SEQ-DELETE-26-03. SQ1064.2 +258900 GO TO SEQ-TEST-RD-26-03. SQ1064.2 +259000 SEQ-DELETE-26-03. SQ1064.2 +259100 PERFORM DE-LETE. SQ1064.2 +259200 GO TO SEQ-TEST-26-03-END. SQ1064.2 +259300 SEQ-TEST-RD-26-03. SQ1064.2 +259400 IF END-READ-FLAG = "EXECUTED" SQ1064.2 +259500 PERFORM PASS SQ1064.2 +259600 ELSE SQ1064.2 +259700 MOVE END-READ-FLAG TO COMPUTED-A SQ1064.2 +259800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +259900 MOVE "NOT END PATH NOT EXECUTED" TO RE-MARK SQ1064.2 +260000 MOVE "IV-40, VII-47,4.4.4(14)" TO ANSI-REFERENCE SQ1064.2 +260100 PERFORM FAIL. SQ1064.2 +260200 SEQ-TEST-26-03-END. SQ1064.2 +260300* SQ1064.2 +260400* CHECK EXECUTION OF THE END PATH SQ1064.2 +260500* SQ1064.2 +260600 ADD 1 TO REC-CT. SQ1064.2 +260700 IF DELETE-SW NOT = SPACE SQ1064.2 +260800 GO TO SEQ-DELETE-26-04. SQ1064.2 +260900 GO TO SEQ-TEST-RD-26-04. SQ1064.2 +261000 SEQ-DELETE-26-04. SQ1064.2 +261100 PERFORM DE-LETE. SQ1064.2 +261200 GO TO SEQ-TEST-26-04-END. SQ1064.2 +261300 SEQ-TEST-RD-26-04. SQ1064.2 +261400 IF EOF-FLAG = "EXECUTED" SQ1064.2 +261500 PERFORM PASS SQ1064.2 +261600 ELSE SQ1064.2 +261700 MOVE EOF-FLAG TO COMPUTED-A SQ1064.2 +261800 MOVE "EXECUTED" TO CORRECT-A SQ1064.2 +261900 MOVE "AT END BRANCH NOT TAKEN AT EOF" TO RE-MARK SQ1064.2 +262000 MOVE "V11-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1064.2 +262100 PERFORM FAIL. SQ1064.2 +262200 SEQ-TEST-26-04-END. SQ1064.2 +262300 MOVE SPACE TO DELETE-SW-3. SQ1064.2 +262400* SQ1064.2 +262500* SQ1064.2 +262600* THE END OF THE FILE HAS BEEN REACHED, SO IT CAN BE CLOSED SQ1064.2 +262700* SQ1064.2 +262800 SEQ-INIT-27. SQ1064.2 +262900 MOVE 1 TO REC-CT. SQ1064.2 +263000 MOVE "CLOSE FILE AFTER READING" TO FEATURE. SQ1064.2 +263100 MOVE "SEQ-TEST-CL-27" TO PAR-NAME. SQ1064.2 +263200 MOVE "**" TO SQ-STATUS. SQ1064.2 +263300 IF DELETE-SW NOT EQUAL SPACE SQ1064.2 +263400 GO TO SEQ-DELETE-27. SQ1064.2 +263500 GO TO SEQ-TEST-CL-27. SQ1064.2 +263600 SEQ-DELETE-27. SQ1064.2 +263700 GO TO SEQ-DELETE-27-01. SQ1064.2 +263800 SEQ-TEST-CL-27. SQ1064.2 +263900 CLOSE SQ-VS6. SQ1064.2 +264000 GO TO SEQ-TEST-CL-27-01. SQ1064.2 +264100 SEQ-DELETE-27-01. SQ1064.2 +264200 PERFORM DE-LETE. SQ1064.2 +264300 GO TO SEQ-TEST-27-01-END. SQ1064.2 +264400 SEQ-TEST-CL-27-01. SQ1064.2 +264500 IF SQ-STATUS = "00" SQ1064.2 +264600 PERFORM PASS SQ1064.2 +264700 ELSE SQ1064.2 +264800 MOVE SQ-STATUS TO COMPUTED-A SQ1064.2 +264900 MOVE "00" TO CORRECT-A SQ1064.2 +265000 MOVE "UNEXPECTED I-O STATUS FROM CLOSE" TO RE-MARK SQ1064.2 +265100 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1064.2 +265200 PERFORM FAIL. SQ1064.2 +265300 SEQ-TEST-27-01-END. SQ1064.2 +265400* SQ1064.2 +265500* SQ1064.2 +265600 TERMINATE-ROUTINE. SQ1064.2 +265700 EXIT. SQ1064.2 +265800 CCVS-EXIT SECTION. SQ1064.2 +265900 CCVS-999999. SQ1064.2 +266000 GO TO CLOSE-FILES. SQ1064.2 diff --git a/tests/cobol85/SQ/SQ107A.CBL b/tests/cobol85/SQ/SQ107A.CBL new file mode 100755 index 00000000..00695d66 --- /dev/null +++ b/tests/cobol85/SQ/SQ107A.CBL @@ -0,0 +1,708 @@ +000100 IDENTIFICATION DIVISION. SQ1074.2 +000200 PROGRAM-ID. SQ1074.2 +000300 SQ107A. SQ1074.2 +000400**************************************************************** SQ1074.2 +000500* * SQ1074.2 +000600* VALIDATION FOR:- * SQ1074.2 +000700* " HIGH ". SQ1074.2 +000800* * SQ1074.2 +000900* CREATION DATE / VALIDATION DATE * SQ1074.2 +001000* "4.2 ". SQ1074.2 +001100* * SQ1074.2 +001200**************************************************************** SQ1074.2 +001300 SQ1074.2 +001400* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ1074.2 +001500* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ1074.2 +001600* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ1074.2 +001700* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ1074.2 +001800* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ1074.2 +001900* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ1074.2 +002000* AGAINST THE EXPECTED VALUES. SQ1074.2 +002100* SQ1074.2 +002200* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ1074.2 +002300* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ1074.2 +002400* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ1074.2 +002500* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ1074.2 +002600* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ1074.2 +002700* SQ1074.2 +002800* NEW FEATURE: THE LOGICAL RECORD EXTEND ACROSS THE PHYSICAL SQ1074.2 +002900* RECORD. (VII-23; 3.3.3 (2) A) SQ1074.2 +003000* SQ1074.2 +003100* SQ1074.2 +003200* USED X-CARDS: SQ1074.2 +003300* XXXXX014 SQ1074.2 +003400* XXXXX055 SQ1074.2 +003500* P XXXXX062 SQ1074.2 +003600* XXXXX082 SQ1074.2 +003700* XXXXX083 SQ1074.2 +003800* C XXXXX084 SQ1074.2 +003900* SQ1074.2 +004000* SQ1074.2 +004100 ENVIRONMENT DIVISION. SQ1074.2 +004200 CONFIGURATION SECTION. SQ1074.2 +004300 SOURCE-COMPUTER. SQ1074.2 +004400 Linux. SQ1074.2 +004500 OBJECT-COMPUTER. SQ1074.2 +004600 Linux. SQ1074.2 +004700 INPUT-OUTPUT SECTION. SQ1074.2 +004800 FILE-CONTROL. SQ1074.2 +004900*P SELECT RAW-DATA ASSIGN TO SQ1074.2 +005000*P "XXXXX062" SQ1074.2 +005100*P ORGANIZATION IS INDEXED SQ1074.2 +005200*P ACCESS MODE IS RANDOM SQ1074.2 +005300*P RECORD KEY IS RAW-DATA-KEY. SQ1074.2 +005400 SELECT PRINT-FILE ASSIGN TO SQ1074.2 +005500 "report.log". SQ1074.2 +005600 SELECT SQ-VS7 ASSIGN TO SQ1074.2 +005700 "XXXXX014" SQ1074.2 +005800 ORGANIZATION SEQUENTIAL SQ1074.2 +005900 ACCESS SEQUENTIAL. SQ1074.2 +006000 DATA DIVISION. SQ1074.2 +006100 FILE SECTION. SQ1074.2 +006200*P SQ1074.2 +006300*PD RAW-DATA. SQ1074.2 +006400*P SQ1074.2 +006500*P1 RAW-DATA-SATZ. SQ1074.2 +006600*P 05 RAW-DATA-KEY PIC X(6). SQ1074.2 +006700*P 05 C-DATE PIC 9(6). SQ1074.2 +006800*P 05 C-TIME PIC 9(8). SQ1074.2 +006900*P 05 C-NO-OF-TESTS PIC 99. SQ1074.2 +007000*P 05 C-OK PIC 999. SQ1074.2 +007100*P 05 C-ALL PIC 999. SQ1074.2 +007200*P 05 C-FAIL PIC 999. SQ1074.2 +007300*P 05 C-DELETED PIC 999. SQ1074.2 +007400*P 05 C-INSPECT PIC 999. SQ1074.2 +007500*P 05 C-NOTE PIC X(13). SQ1074.2 +007600*P 05 C-INDENT PIC X. SQ1074.2 +007700*P 05 C-ABORT PIC X(8). SQ1074.2 +007800 FD PRINT-FILE SQ1074.2 +007900*C LABEL RECORDS SQ1074.2 +008000*C OMITTED SQ1074.2 +008100*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1074.2 +008200 . SQ1074.2 +008300 01 PRINT-REC PICTURE X(120). SQ1074.2 +008400 01 DUMMY-RECORD PICTURE X(120). SQ1074.2 +008500 FD SQ-VS7 SQ1074.2 +008600*C LABEL RECORDS ARE STANDARD SQ1074.2 +008700 BLOCK CONTAINS 100 CHARACTERS. SQ1074.2 +008800 01 SQ-VS7R1-M-G-120. SQ1074.2 +008900 02 SQ-VS7R1-FIRST PICTURE X(120). SQ1074.2 +009000 01 SQ-VS7R2-M-G-151. SQ1074.2 +009100 02 SQ-VS7R2-FIRST PICTURE X(120). SQ1074.2 +009200 02 LONG-OR-SHORT PICTURE X(5). SQ1074.2 +009300 02 SQ-VS7-RECNO PICTURE X(5). SQ1074.2 +009400 02 SQ-VS7-FILLER PICTURE X(21). SQ1074.2 +009500 WORKING-STORAGE SECTION. SQ1074.2 +009600 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ1074.2 +009700 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ1074.2 +009800 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ1074.2 +009900 01 ERROR-FLAG PICTURE 9. SQ1074.2 +010000 01 EOF-FLAG PICTURE 9. SQ1074.2 +010100 01 DUMP-AREA. SQ1074.2 +010200 02 TYPE-OF-REC PICTURE X(5). SQ1074.2 +010300 02 RECNO PICTURE 9(5). SQ1074.2 +010400 02 FILLER PICTURE X(21). SQ1074.2 +010500 01 FILE-RECORD-INFORMATION-REC. SQ1074.2 +010600 03 FILE-RECORD-INFO-SKELETON. SQ1074.2 +010700 05 FILLER PICTURE X(48) VALUE SQ1074.2 +010800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1074.2 +010900 05 FILLER PICTURE X(46) VALUE SQ1074.2 +011000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1074.2 +011100 05 FILLER PICTURE X(26) VALUE SQ1074.2 +011200 ",LFIL=000000,ORG= ,LBLR= ". SQ1074.2 +011300 05 FILLER PICTURE X(37) VALUE SQ1074.2 +011400 ",RECKEY= ". SQ1074.2 +011500 05 FILLER PICTURE X(38) VALUE SQ1074.2 +011600 ",ALTKEY1= ". SQ1074.2 +011700 05 FILLER PICTURE X(38) VALUE SQ1074.2 +011800 ",ALTKEY2= ". SQ1074.2 +011900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1074.2 +012000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1074.2 +012100 05 FILE-RECORD-INFO-P1-120. SQ1074.2 +012200 07 FILLER PIC X(5). SQ1074.2 +012300 07 XFILE-NAME PIC X(6). SQ1074.2 +012400 07 FILLER PIC X(8). SQ1074.2 +012500 07 XRECORD-NAME PIC X(6). SQ1074.2 +012600 07 FILLER PIC X(1). SQ1074.2 +012700 07 REELUNIT-NUMBER PIC 9(1). SQ1074.2 +012800 07 FILLER PIC X(7). SQ1074.2 +012900 07 XRECORD-NUMBER PIC 9(6). SQ1074.2 +013000 07 FILLER PIC X(6). SQ1074.2 +013100 07 UPDATE-NUMBER PIC 9(2). SQ1074.2 +013200 07 FILLER PIC X(5). SQ1074.2 +013300 07 ODO-NUMBER PIC 9(4). SQ1074.2 +013400 07 FILLER PIC X(5). SQ1074.2 +013500 07 XPROGRAM-NAME PIC X(5). SQ1074.2 +013600 07 FILLER PIC X(7). SQ1074.2 +013700 07 XRECORD-LENGTH PIC 9(6). SQ1074.2 +013800 07 FILLER PIC X(7). SQ1074.2 +013900 07 CHARS-OR-RECORDS PIC X(2). SQ1074.2 +014000 07 FILLER PIC X(1). SQ1074.2 +014100 07 XBLOCK-SIZE PIC 9(4). SQ1074.2 +014200 07 FILLER PIC X(6). SQ1074.2 +014300 07 RECORDS-IN-FILE PIC 9(6). SQ1074.2 +014400 07 FILLER PIC X(5). SQ1074.2 +014500 07 XFILE-ORGANIZATION PIC X(2). SQ1074.2 +014600 07 FILLER PIC X(6). SQ1074.2 +014700 07 XLABEL-TYPE PIC X(1). SQ1074.2 +014800 05 FILE-RECORD-INFO-P121-240. SQ1074.2 +014900 07 FILLER PIC X(8). SQ1074.2 +015000 07 XRECORD-KEY PIC X(29). SQ1074.2 +015100 07 FILLER PIC X(9). SQ1074.2 +015200 07 ALTERNATE-KEY1 PIC X(29). SQ1074.2 +015300 07 FILLER PIC X(9). SQ1074.2 +015400 07 ALTERNATE-KEY2 PIC X(29). SQ1074.2 +015500 07 FILLER PIC X(7). SQ1074.2 +015600 01 TEST-RESULTS. SQ1074.2 +015700 02 FILLER PICTURE X VALUE SPACE. SQ1074.2 +015800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1074.2 +015900 02 FILLER PICTURE X VALUE SPACE. SQ1074.2 +016000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1074.2 +016100 02 FILLER PICTURE X VALUE SPACE. SQ1074.2 +016200 02 PAR-NAME. SQ1074.2 +016300 03 FILLER PICTURE X(12) VALUE SPACE. SQ1074.2 +016400 03 PARDOT-X PICTURE X VALUE SPACE. SQ1074.2 +016500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1074.2 +016600 03 FILLER PIC X(5) VALUE SPACE. SQ1074.2 +016700 02 FILLER PIC X(10) VALUE SPACE. SQ1074.2 +016800 02 RE-MARK PIC X(61). SQ1074.2 +016900 01 TEST-COMPUTED. SQ1074.2 +017000 02 FILLER PIC X(30) VALUE SPACE. SQ1074.2 +017100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1074.2 +017200 02 COMPUTED-X. SQ1074.2 +017300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1074.2 +017400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1074.2 +017500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1074.2 +017600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1074.2 +017700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1074.2 +017800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1074.2 +017900 04 COMPUTED-18V0 PICTURE -9(18). SQ1074.2 +018000 04 FILLER PICTURE X. SQ1074.2 +018100 03 FILLER PIC X(50) VALUE SPACE. SQ1074.2 +018200 01 TEST-CORRECT. SQ1074.2 +018300 02 FILLER PIC X(30) VALUE SPACE. SQ1074.2 +018400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1074.2 +018500 02 CORRECT-X. SQ1074.2 +018600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1074.2 +018700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1074.2 +018800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1074.2 +018900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1074.2 +019000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1074.2 +019100 03 CR-18V0 REDEFINES CORRECT-A. SQ1074.2 +019200 04 CORRECT-18V0 PICTURE -9(18). SQ1074.2 +019300 04 FILLER PICTURE X. SQ1074.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SQ1074.2 +019500 01 CCVS-C-1. SQ1074.2 +019600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1074.2 +019700- "SS PARAGRAPH-NAME SQ1074.2 +019800- " REMARKS". SQ1074.2 +019900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1074.2 +020000 01 CCVS-C-2. SQ1074.2 +020100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1074.2 +020200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1074.2 +020300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1074.2 +020400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1074.2 +020500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1074.2 +020600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1074.2 +020700 01 REC-CT PICTURE 99 VALUE ZERO. SQ1074.2 +020800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1074.2 +020900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1074.2 +021000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1074.2 +021100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1074.2 +021200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1074.2 +021300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1074.2 +021400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1074.2 +021500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1074.2 +021600 01 CCVS-H-1. SQ1074.2 +021700 02 FILLER PICTURE X(27) VALUE SPACE. SQ1074.2 +021800 02 FILLER PICTURE X(67) VALUE SQ1074.2 +021900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1074.2 +022000- " SYSTEM". SQ1074.2 +022100 02 FILLER PICTURE X(26) VALUE SPACE. SQ1074.2 +022200 01 CCVS-H-2. SQ1074.2 +022300 02 FILLER PICTURE X(52) VALUE IS SQ1074.2 +022400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1074.2 +022500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1074.2 +022600 02 TEST-ID PICTURE IS X(9). SQ1074.2 +022700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1074.2 +022800 01 CCVS-H-3. SQ1074.2 +022900 02 FILLER PICTURE X(34) VALUE SQ1074.2 +023000 " FOR OFFICIAL USE ONLY ". SQ1074.2 +023100 02 FILLER PICTURE X(58) VALUE SQ1074.2 +023200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1074.2 +023300 02 FILLER PICTURE X(28) VALUE SQ1074.2 +023400 " COPYRIGHT 1985 ". SQ1074.2 +023500 01 CCVS-E-1. SQ1074.2 +023600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1074.2 +023700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1074.2 +023800 02 ID-AGAIN PICTURE IS X(9). SQ1074.2 +023900 02 FILLER PICTURE X(45) VALUE IS SQ1074.2 +024000 " NTIS DISTRIBUTION COBOL 85". SQ1074.2 +024100 01 CCVS-E-2. SQ1074.2 +024200 02 FILLER PICTURE X(31) VALUE SQ1074.2 +024300 SPACE. SQ1074.2 +024400 02 FILLER PICTURE X(21) VALUE SPACE. SQ1074.2 +024500 02 CCVS-E-2-2. SQ1074.2 +024600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1074.2 +024700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1074.2 +024800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1074.2 +024900 01 CCVS-E-3. SQ1074.2 +025000 02 FILLER PICTURE X(22) VALUE SQ1074.2 +025100 " FOR OFFICIAL USE ONLY". SQ1074.2 +025200 02 FILLER PICTURE X(12) VALUE SPACE. SQ1074.2 +025300 02 FILLER PICTURE X(58) VALUE SQ1074.2 +025400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1074.2 +025500 02 FILLER PICTURE X(13) VALUE SPACE. SQ1074.2 +025600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1074.2 +025700 01 CCVS-E-4. SQ1074.2 +025800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1074.2 +025900 02 FILLER PIC XXXX VALUE " OF ". SQ1074.2 +026000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1074.2 +026100 02 FILLER PIC X(40) VALUE SQ1074.2 +026200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1074.2 +026300 01 XXINFO. SQ1074.2 +026400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1074.2 +026500 02 INFO-TEXT. SQ1074.2 +026600 04 FILLER PIC X(20) VALUE SPACE. SQ1074.2 +026700 04 XXCOMPUTED PIC X(20). SQ1074.2 +026800 04 FILLER PIC X(5) VALUE SPACE. SQ1074.2 +026900 04 XXCORRECT PIC X(20). SQ1074.2 +027000 01 HYPHEN-LINE. SQ1074.2 +027100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1074.2 +027200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1074.2 +027300- "*****************************************". SQ1074.2 +027400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1074.2 +027500- "******************************". SQ1074.2 +027600 01 CCVS-PGM-ID PIC X(6) VALUE SQ1074.2 +027700 "SQ107A". SQ1074.2 +027800 PROCEDURE DIVISION. SQ1074.2 +027900 CCVS1 SECTION. SQ1074.2 +028000 OPEN-FILES. SQ1074.2 +028100*P OPEN I-O RAW-DATA. SQ1074.2 +028200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1074.2 +028300*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1074.2 +028400*P MOVE "ABORTED " TO C-ABORT. SQ1074.2 +028500*P ADD 1 TO C-NO-OF-TESTS. SQ1074.2 +028600*P ACCEPT C-DATE FROM DATE. SQ1074.2 +028700*P ACCEPT C-TIME FROM TIME. SQ1074.2 +028800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1074.2 +028900*PND-E-1. SQ1074.2 +029000*P CLOSE RAW-DATA. SQ1074.2 +029100 OPEN OUTPUT PRINT-FILE. SQ1074.2 +029200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1074.2 +029300 MOVE SPACE TO TEST-RESULTS. SQ1074.2 +029400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1074.2 +029500 MOVE ZERO TO REC-SKL-SUB. SQ1074.2 +029600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1074.2 +029700 CCVS-INIT-FILE. SQ1074.2 +029800 ADD 1 TO REC-SKL-SUB. SQ1074.2 +029900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1074.2 +030000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1074.2 +030100 CCVS-INIT-EXIT. SQ1074.2 +030200 GO TO CCVS1-EXIT. SQ1074.2 +030300 CLOSE-FILES. SQ1074.2 +030400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1074.2 +030500*P OPEN I-O RAW-DATA. SQ1074.2 +030600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1074.2 +030700*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1074.2 +030800*P MOVE "OK. " TO C-ABORT. SQ1074.2 +030900*P MOVE PASS-COUNTER TO C-OK. SQ1074.2 +031000*P MOVE ERROR-HOLD TO C-ALL. SQ1074.2 +031100*P MOVE ERROR-COUNTER TO C-FAIL. SQ1074.2 +031200*P MOVE DELETE-CNT TO C-DELETED. SQ1074.2 +031300*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1074.2 +031400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1074.2 +031500*PND-E-2. SQ1074.2 +031600*P CLOSE RAW-DATA. SQ1074.2 +031700 TERMINATE-CCVS. SQ1074.2 +031800*S EXIT PROGRAM. SQ1074.2 +031900*SERMINATE-CALL. SQ1074.2 +032000 STOP RUN. SQ1074.2 +032100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1074.2 +032200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1074.2 +032300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1074.2 +032400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1074.2 +032500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1074.2 +032600 PRINT-DETAIL. SQ1074.2 +032700 IF REC-CT NOT EQUAL TO ZERO SQ1074.2 +032800 MOVE "." TO PARDOT-X SQ1074.2 +032900 MOVE REC-CT TO DOTVALUE. SQ1074.2 +033000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1074.2 +033100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1074.2 +033200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1074.2 +033300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1074.2 +033400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1074.2 +033500 MOVE SPACE TO CORRECT-X. SQ1074.2 +033600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1074.2 +033700 MOVE SPACE TO RE-MARK. SQ1074.2 +033800 HEAD-ROUTINE. SQ1074.2 +033900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +034000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1074.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1074.2 +034200 COLUMN-NAMES-ROUTINE. SQ1074.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +034600 END-ROUTINE. SQ1074.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1074.2 +034800 END-RTN-EXIT. SQ1074.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +035000 END-ROUTINE-1. SQ1074.2 +035100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1074.2 +035200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1074.2 +035300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1074.2 +035400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1074.2 +035500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1074.2 +035600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1074.2 +035700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1074.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1074.2 +035900 END-ROUTINE-12. SQ1074.2 +036000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1074.2 +036100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1074.2 +036200 MOVE "NO " TO ERROR-TOTAL SQ1074.2 +036300 ELSE SQ1074.2 +036400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1074.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1074.2 +036600 PERFORM WRITE-LINE. SQ1074.2 +036700 END-ROUTINE-13. SQ1074.2 +036800 IF DELETE-CNT IS EQUAL TO ZERO SQ1074.2 +036900 MOVE "NO " TO ERROR-TOTAL ELSE SQ1074.2 +037000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1074.2 +037100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1074.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +037300 IF INSPECT-COUNTER EQUAL TO ZERO SQ1074.2 +037400 MOVE "NO " TO ERROR-TOTAL SQ1074.2 +037500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1074.2 +037600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1074.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +037800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1074.2 +037900 WRITE-LINE. SQ1074.2 +038000 ADD 1 TO RECORD-COUNT. SQ1074.2 +038100 IF RECORD-COUNT GREATER 50 SQ1074.2 +038200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1074.2 +038300 MOVE SPACE TO DUMMY-RECORD SQ1074.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1074.2 +038500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1074.2 +038600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1074.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1074.2 +038800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1074.2 +038900 MOVE ZERO TO RECORD-COUNT. SQ1074.2 +039000 PERFORM WRT-LN. SQ1074.2 +039100 WRT-LN. SQ1074.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1074.2 +039300 MOVE SPACE TO DUMMY-RECORD. SQ1074.2 +039400 BLANK-LINE-PRINT. SQ1074.2 +039500 PERFORM WRT-LN. SQ1074.2 +039600 FAIL-ROUTINE. SQ1074.2 +039700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1074.2 +039800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1074.2 +039900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1074.2 +040000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +040100 GO TO FAIL-ROUTINE-EX. SQ1074.2 +040200 FAIL-ROUTINE-WRITE. SQ1074.2 +040300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1074.2 +040400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +040500 FAIL-ROUTINE-EX. EXIT. SQ1074.2 +040600 BAIL-OUT. SQ1074.2 +040700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1074.2 +040800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1074.2 +040900 BAIL-OUT-WRITE. SQ1074.2 +041000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1074.2 +041100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1074.2 +041200 BAIL-OUT-EX. EXIT. SQ1074.2 +041300 CCVS1-EXIT. SQ1074.2 +041400 EXIT. SQ1074.2 +041500 SECT-SQ107A-0001 SECTION. SQ1074.2 +041600 SEQ-INIT-017. SQ1074.2 +041700 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ1074.2 +041800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1074.2 +041900 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1074.2 +042000 MOVE 0001 TO XBLOCK-SIZE (1). SQ1074.2 +042100 MOVE 000450 TO RECORDS-IN-FILE (1). SQ1074.2 +042200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1074.2 +042300 MOVE "S" TO XLABEL-TYPE (1). SQ1074.2 +042400 MOVE 000000 TO XRECORD-NUMBER (1). SQ1074.2 +042500 MOVE ZERO TO COUNT-OF-RECS. SQ1074.2 +042600 OPEN OUTPUT SQ-VS7. SQ1074.2 +042700 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ1074.2 +042800 SEQ-TEST-017. SQ1074.2 +042900 PERFORM WRITE-SHORT-REC. SQ1074.2 +043000 PERFORM WRITE-LONG-REC. SQ1074.2 +043100 PERFORM WRITE-SHORT-REC 10 TIMES. SQ1074.2 +043200 PERFORM WRITE-LONG-REC 100 TIMES. SQ1074.2 +043300 PERFORM WRITE-SHORT-REC 338 TIMES. SQ1074.2 +043400 SEQ-WRITE-017. SQ1074.2 +043500 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ1074.2 +043600 MOVE "SEQ-TEST-017" TO PAR-NAME. SQ1074.2 +043700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1074.2 +043800 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1074.2 +043900 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ1074.2 +044000 PERFORM PRINT-DETAIL. SQ1074.2 +044100* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ1074.2 +044200* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ1074.2 +044300* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ1074.2 +044400* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ1074.2 +044500* 100L-338S. SQ1074.2 +044600 SEQ-CLOSE-017. SQ1074.2 +044700 CLOSE SQ-VS7. SQ1074.2 +044800 GO TO READ-INIT-GF-01. SQ1074.2 +044900 WRITE-SHORT-REC. SQ1074.2 +045000 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ1074.2 +045100 MOVE 000120 TO XRECORD-LENGTH (1). SQ1074.2 +045200 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +045300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1074.2 +045400 MOVE "SHORT" TO LONG-OR-SHORT. SQ1074.2 +045500 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ1074.2 +045600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ1074.2 +045700 WRITE SQ-VS7R1-M-G-120. SQ1074.2 +045800 WRITE-LONG-REC. SQ1074.2 +045900 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ1074.2 +046000 MOVE 000151 TO XRECORD-LENGTH (1). SQ1074.2 +046100 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +046200 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1074.2 +046300 MOVE "LONG" TO LONG-OR-SHORT. SQ1074.2 +046400 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ1074.2 +046500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ1074.2 +046600 WRITE SQ-VS7R2-M-G-151. SQ1074.2 +046700 READ-INIT-GF-01. SQ1074.2 +046800 MOVE ZERO TO COUNT-OF-RECS. SQ1074.2 +046900 MOVE ZERO TO EOF-FLAG. SQ1074.2 +047000 MOVE ZERO TO RECORDS-IN-ERROR. SQ1074.2 +047100 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +047200 OPEN INPUT SQ-VS7. SQ1074.2 +047300 READ-TEST-GF-01. SQ1074.2 +047400 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ1074.2 +047500 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +047600 MOVE "EOF ON FIRST READ" TO RE-MARK SQ1074.2 +047700 GO TO SEQ-EOF-018. SQ1074.2 +047800 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +047900 GO TO READ-FAIL-GF-01. SQ1074.2 +048000 READ-PASS-GF-01. SQ1074.2 +048100 PERFORM PASS. SQ1074.2 +048200 GO TO READ-WRITE-GF-01. SQ1074.2 +048300 READ-FAIL-GF-01. SQ1074.2 +048400 PERFORM FAIL. SQ1074.2 +048500 MOVE "ERROR ON FIRST READ" TO RE-MARK. SQ1074.2 +048600 READ-WRITE-GF-01. SQ1074.2 +048700 MOVE "READ SHORT RECORD" TO FEATURE. SQ1074.2 +048800 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1074.2 +048900 PERFORM PRINT-DETAIL. SQ1074.2 +049000 GO TO READ-INIT-GF-02. SQ1074.2 +049100 READ-SHORT-REC. SQ1074.2 +049200 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +049300 GO TO READ-SHORT-REC-EXIT. SQ1074.2 +049400 READ SQ-VS7 AT END SQ1074.2 +049500 MOVE 1 TO EOF-FLAG SQ1074.2 +049600 GO TO READ-SHORT-REC-EXIT. SQ1074.2 +049700 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +049800 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ1074.2 +049900 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ1074.2 +050000 GO TO READ-SHORT-REC-ERROR. SQ1074.2 +050100 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ1074.2 +050200 GO TO READ-SHORT-REC-ERROR. SQ1074.2 +050300 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1074.2 +050400 GO TO READ-SHORT-REC-ERROR. SQ1074.2 +050500 IF XLABEL-TYPE (1) EQUAL TO "S" SQ1074.2 +050600 GO TO READ-SHORT-REC-EXIT. SQ1074.2 +050700 READ-SHORT-REC-ERROR. SQ1074.2 +050800 ADD 1 TO RECORDS-IN-ERROR. SQ1074.2 +050900 MOVE 1 TO ERROR-FLAG. SQ1074.2 +051000 READ-SHORT-REC-EXIT. SQ1074.2 +051100 EXIT. SQ1074.2 +051200 READ-INIT-GF-02. SQ1074.2 +051300 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +051400 READ-TEST-GF-02. SQ1074.2 +051500 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ1074.2 +051600 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +051700 MOVE "EOF ON SECOND READ" TO RE-MARK SQ1074.2 +051800 GO TO SEQ-EOF-018. SQ1074.2 +051900 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +052000 GO TO READ-FAIL-GF-02. SQ1074.2 +052100 READ-PASS-GF-02. SQ1074.2 +052200 PERFORM PASS. SQ1074.2 +052300 GO TO READ-WRITE-GF-02. SQ1074.2 +052400 READ-FAIL-GF-02. SQ1074.2 +052500 PERFORM FAIL. SQ1074.2 +052600 MOVE "VII-23; ERROR ON SECOND READ" TO RE-MARK. SQ1074.2 +052700 READ-WRITE-GF-02. SQ1074.2 +052800 MOVE "READ LONG RECORD" TO FEATURE. SQ1074.2 +052900 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1074.2 +053000 PERFORM PRINT-DETAIL. SQ1074.2 +053100 GO TO READ-INIT-GF-03. SQ1074.2 +053200 READ-LONG-REC. SQ1074.2 +053300 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +053400 GO TO READ-LONG-REC-EXIT. SQ1074.2 +053500 READ SQ-VS7 END SQ1074.2 +053600 MOVE 1 TO EOF-FLAG SQ1074.2 +053700 GO TO READ-LONG-REC-EXIT. SQ1074.2 +053800 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +053900 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ1074.2 +054000 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ1074.2 +054100 GO TO READ-LONG-REC-ERROR. SQ1074.2 +054200 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ1074.2 +054300 GO TO READ-LONG-REC-ERROR. SQ1074.2 +054400 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ1074.2 +054500 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ1074.2 +054600 GO TO READ-LONG-REC-ERROR. SQ1074.2 +054700 IF LONG-OR-SHORT EQUAL TO "LONG " SQ1074.2 +054800 GO TO READ-LONG-REC-EXIT. SQ1074.2 +054900 READ-LONG-REC-ERROR. SQ1074.2 +055000 ADD 1 TO RECORDS-IN-ERROR. SQ1074.2 +055100 MOVE 1 TO ERROR-FLAG. SQ1074.2 +055200 READ-LONG-REC-EXIT. SQ1074.2 +055300 EXIT. SQ1074.2 +055400 READ-INIT-GF-03. SQ1074.2 +055500 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +055600 READ-TEST-GF-03. SQ1074.2 +055700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ1074.2 +055800 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +055900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ1074.2 +056000 GO TO SEQ-EOF-018. SQ1074.2 +056100 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +056200 GO TO READ-FAIL-GF-03. SQ1074.2 +056300 READ-PASS-GF-03. SQ1074.2 +056400 PERFORM PASS. SQ1074.2 +056500 GO TO READ-WRITE-GF-03. SQ1074.2 +056600 READ-FAIL-GF-03. SQ1074.2 +056700 MOVE "VII-23; ERROR READING SHORT RECORD" TO RE-MARK. SQ1074.2 +056800 PERFORM FAIL. SQ1074.2 +056900 READ-WRITE-GF-03. SQ1074.2 +057000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ1074.2 +057100 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1074.2 +057200 PERFORM PRINT-DETAIL. SQ1074.2 +057300 READ-INIT-GF-04. SQ1074.2 +057400 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +057500 READ-TEST-GF-04. SQ1074.2 +057600 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ1074.2 +057700 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +057800 MOVE "UNEXPECTED EOF" TO RE-MARK SQ1074.2 +057900 GO TO SEQ-EOF-018. SQ1074.2 +058000 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +058100 GO TO READ-FAIL-GF-04. SQ1074.2 +058200 READ-PASS-GF-04. SQ1074.2 +058300 PERFORM PASS. SQ1074.2 +058400 GO TO READ-WRITE-GF-04. SQ1074.2 +058500 READ-FAIL-GF-04. SQ1074.2 +058600 PERFORM FAIL. SQ1074.2 +058700 MOVE "VII-23; ERROR READING LONG RECORD" TO RE-MARK. SQ1074.2 +058800 READ-WRITE-GF-04. SQ1074.2 +058900 MOVE "READ LONG RECORDS" TO FEATURE. SQ1074.2 +059000 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1074.2 +059100 PERFORM PRINT-DETAIL. SQ1074.2 +059200 READ-INIT-GF-06. SQ1074.2 +059300 MOVE ZERO TO ERROR-FLAG. SQ1074.2 +059400 READ-TEST-GF-05. SQ1074.2 +059500 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ1074.2 +059600 IF EOF-FLAG EQUAL TO 1 SQ1074.2 +059700 MOVE "UNEXPECTED EOF" TO RE-MARK SQ1074.2 +059800 GO TO SEQ-EOF-018. SQ1074.2 +059900 IF ERROR-FLAG EQUAL TO 1 SQ1074.2 +060000 GO TO READ-FAIL-GF-05. SQ1074.2 +060100 READ-PASS-GF-05. SQ1074.2 +060200 PERFORM PASS. SQ1074.2 +060300 GO TO READ-WRITE-GF-05. SQ1074.2 +060400 READ-FAIL-GF-05. SQ1074.2 +060500 PERFORM FAIL. SQ1074.2 +060600 MOVE "VII-23; ERROR READING SHORT RECORD" TO RE-MARK. SQ1074.2 +060700 READ-WRITE-GF-05. SQ1074.2 +060800 MOVE "READ SHORT RECORDS" TO FEATURE. SQ1074.2 +060900 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1074.2 +061000 PERFORM PRINT-DETAIL. SQ1074.2 +061100 SEQ-INIT-018. SQ1074.2 +061200 READ SQ-VS7 RECORD END SQ1074.2 +061300 GO TO SEQ-TEST-018. SQ1074.2 +061400 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ1074.2 +061500 GO TO SEQ-FAIL-018. SQ1074.2 +061600 SEQ-EOF-018. SQ1074.2 +061700 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1074.2 +061800 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1074.2 +061900 GO TO SEQ-FAIL-018. SQ1074.2 +062000 SEQ-TEST-018. SQ1074.2 +062100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1074.2 +062200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1074.2 +062300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1074.2 +062400 GO TO SEQ-FAIL-018. SQ1074.2 +062500 SEQ-PASS-018. SQ1074.2 +062600 PERFORM PASS. SQ1074.2 +062700 GO TO SEQ-WRITE-018. SQ1074.2 +062800 SEQ-FAIL-018. SQ1074.2 +062900 PERFORM FAIL. SQ1074.2 +063000 SEQ-WRITE-018. SQ1074.2 +063100 MOVE "SEQ-TEST-018" TO PAR-NAME. SQ1074.2 +063200 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ1074.2 +063300 PERFORM PRINT-DETAIL. SQ1074.2 +063400 SEQ-CLOSE-018. SQ1074.2 +063500 CLOSE SQ-VS7. SQ1074.2 +063600 SECT-SQ107A-0002 SECTION. SQ1074.2 +063700* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ1074.2 +063800* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ1074.2 +063900* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ1074.2 +064000* 130 IS UNIQUE FOR EACH RECORD. SQ1074.2 +064100 INFO-INIT-004. SQ1074.2 +064200 OPEN INPUT SQ-VS7. SQ1074.2 +064300 MOVE ZERO TO COUNT-OF-RECS. SQ1074.2 +064400 INFO-TEST-004. SQ1074.2 +064500 READ SQ-VS7 AT END SQ1074.2 +064600 GO TO INFO-END. SQ1074.2 +064700 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +064800 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ1074.2 +064900 GO TO NO-INFO-004. SQ1074.2 +065000 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ1074.2 +065100 MOVE "RECORD READ =" TO COMPUTED-A. SQ1074.2 +065200 MOVE 0001 TO CORRECT-18V0. SQ1074.2 +065300 GO TO INFO-WRITE-004. SQ1074.2 +065400 NO-INFO-004. SQ1074.2 +065500 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ1074.2 +065600 INFO-WRITE-004. SQ1074.2 +065700 MOVE "READ SHORT RECORD" TO FEATURE. SQ1074.2 +065800 MOVE "SEQ-INFO-004" TO PAR-NAME. SQ1074.2 +065900 PERFORM PRINT-DETAIL. SQ1074.2 +066000 INFO-INIT-005. SQ1074.2 +066100 READ SQ-VS7 RECORD AT END SQ1074.2 +066200 GO TO INFO-END. SQ1074.2 +066300 READ SQ-VS7 END SQ1074.2 +066400 GO TO INFO-END. SQ1074.2 +066500 INFO-TEST-005. SQ1074.2 +066600 READ SQ-VS7 AT END SQ1074.2 +066700 GO TO INFO-END. SQ1074.2 +066800 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ1074.2 +066900 GO TO NO-INFO-005. SQ1074.2 +067000 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ1074.2 +067100 MOVE "RECORD READ =" TO COMPUTED-A. SQ1074.2 +067200 MOVE 0004 TO CORRECT-18V0. SQ1074.2 +067300 GO TO INFO-WRITE-005. SQ1074.2 +067400 NO-INFO-005. SQ1074.2 +067500 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ1074.2 +067600 INFO-WRITE-005. SQ1074.2 +067700 MOVE "READ SHORT RECORD" TO FEATURE. SQ1074.2 +067800 MOVE "SEQ-INFO-005" TO PAR-NAME. SQ1074.2 +067900 PERFORM PRINT-DETAIL. SQ1074.2 +068000 INFO-INIT-006. SQ1074.2 +068100 ADD 3 TO COUNT-OF-RECS. SQ1074.2 +068200 INFO-INIT-006-1. SQ1074.2 +068300 READ SQ-VS7 RECORD SQ1074.2 +068400 END GO TO INFO-END. SQ1074.2 +068500 ADD 1 TO COUNT-OF-RECS. SQ1074.2 +068600 IF COUNT-OF-RECS EQUAL TO 450 SQ1074.2 +068700 GO TO INFO-TEST-006. SQ1074.2 +068800 GO TO INFO-INIT-006-1. SQ1074.2 +068900 INFO-TEST-006. SQ1074.2 +069000 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ1074.2 +069100 GO TO NO-INFO-006. SQ1074.2 +069200 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ1074.2 +069300 MOVE "RECORD READ =" TO COMPUTED-A. SQ1074.2 +069400 MOVE 0450 TO CORRECT-18V0. SQ1074.2 +069500 GO TO INFO-WRITE-006. SQ1074.2 +069600 NO-INFO-006. SQ1074.2 +069700 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ1074.2 +069800 INFO-WRITE-006. SQ1074.2 +069900 MOVE "READ SHORT RECORD" TO FEATURE. SQ1074.2 +070000 MOVE "SEQ-INFO-006" TO PAR-NAME. SQ1074.2 +070100 PERFORM PRINT-DETAIL. SQ1074.2 +070200 INFO-END. SQ1074.2 +070300 CLOSE SQ-VS7. SQ1074.2 +070400 TERMINATE-ROUTINE. SQ1074.2 +070500 EXIT. SQ1074.2 +070600 CCVS-EXIT SECTION. SQ1074.2 +070700 CCVS-999999. SQ1074.2 +070800 GO TO CLOSE-FILES. SQ1074.2 diff --git a/tests/cobol85/SQ/SQ108A.CBL b/tests/cobol85/SQ/SQ108A.CBL new file mode 100755 index 00000000..43043acf --- /dev/null +++ b/tests/cobol85/SQ/SQ108A.CBL @@ -0,0 +1,799 @@ +000100 IDENTIFICATION DIVISION. SQ1084.2 +000200 PROGRAM-ID. SQ1084.2 +000300 SQ108A. SQ1084.2 +000400**************************************************************** SQ1084.2 +000500* * SQ1084.2 +000600* VALIDATION FOR:- * SQ1084.2 +000700* " HIGH ". SQ1084.2 +000800* * SQ1084.2 +000900* CREATION DATE / VALIDATION DATE * SQ1084.2 +001000* "4.2 ". SQ1084.2 +001100* * SQ1084.2 +001200**************************************************************** SQ1084.2 +001300 SQ1084.2 +001400* THE ROUTINE SQ108A CREATES A FIXED LENGTH MASS STORAGE SQ1084.2 +001500* FILE. THE FILE IS CREATED USING WRITE STATEMENTS, VERIFIED SQ1084.2 +001600* IN SEQ-TEST-20 AND THEN READ USING READ...INTO STATEMENTS. SQ1084.2 +001700* THE READ...INTO TESTS CHECK FOR TRUNCATION AND BLANK FILL SQ1084.2 +001800* OF THE IDENTIFIER AREA. SQ1084.2 +001900* SQ1084.2 +002000* USED X-CARDS: SQ1084.2 +002100* XXXXX014 SQ1084.2 +002200* XXXXX055 SQ1084.2 +002300* P XXXXX062 SQ1084.2 +002400* XXXXX082 SQ1084.2 +002500* XXXXX083 SQ1084.2 +002600* C XXXXX084 SQ1084.2 +002700* SQ1084.2 +002800* SQ1084.2 +002900 ENVIRONMENT DIVISION. SQ1084.2 +003000 CONFIGURATION SECTION. SQ1084.2 +003100 SOURCE-COMPUTER. SQ1084.2 +003200 Linux. SQ1084.2 +003300 OBJECT-COMPUTER. SQ1084.2 +003400 Linux. SQ1084.2 +003500 INPUT-OUTPUT SECTION. SQ1084.2 +003600 FILE-CONTROL. SQ1084.2 +003700*P SELECT RAW-DATA ASSIGN TO SQ1084.2 +003800*P "XXXXX062" SQ1084.2 +003900*P ORGANIZATION IS INDEXED SQ1084.2 +004000*P ACCESS MODE IS RANDOM SQ1084.2 +004100*P RECORD KEY IS RAW-DATA-KEY. SQ1084.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1084.2 +004300 "report.log". SQ1084.2 +004400 SELECT SQ-FS8 ASSIGN TO SQ1084.2 +004500 "XXXXX014" SQ1084.2 +004600 ORGANIZATION IS SEQUENTIAL SQ1084.2 +004700 ACCESS MODE IS SEQUENTIAL. SQ1084.2 +004800 DATA DIVISION. SQ1084.2 +004900 FILE SECTION. SQ1084.2 +005000*P SQ1084.2 +005100*PD RAW-DATA. SQ1084.2 +005200*P SQ1084.2 +005300*P1 RAW-DATA-SATZ. SQ1084.2 +005400*P 05 RAW-DATA-KEY PIC X(6). SQ1084.2 +005500*P 05 C-DATE PIC 9(6). SQ1084.2 +005600*P 05 C-TIME PIC 9(8). SQ1084.2 +005700*P 05 C-NO-OF-TESTS PIC 99. SQ1084.2 +005800*P 05 C-OK PIC 999. SQ1084.2 +005900*P 05 C-ALL PIC 999. SQ1084.2 +006000*P 05 C-FAIL PIC 999. SQ1084.2 +006100*P 05 C-DELETED PIC 999. SQ1084.2 +006200*P 05 C-INSPECT PIC 999. SQ1084.2 +006300*P 05 C-NOTE PIC X(13). SQ1084.2 +006400*P 05 C-INDENT PIC X. SQ1084.2 +006500*P 05 C-ABORT PIC X(8). SQ1084.2 +006600 FD PRINT-FILE SQ1084.2 +006700*C LABEL RECORDS SQ1084.2 +006800*C OMITTED SQ1084.2 +006900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1084.2 +007000 . SQ1084.2 +007100 01 PRINT-REC PICTURE X(120). SQ1084.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ1084.2 +007300 FD SQ-FS8 SQ1084.2 +007400*C LABEL RECORD STANDARD SQ1084.2 +007500 BLOCK CONTAINS 1 RECORDS. SQ1084.2 +007600 01 SQ-FS8R1-F-G-141. SQ1084.2 +007700 02 SQ-FS8R1-PART1 PICTURE X(120). SQ1084.2 +007800 02 SQ-FS8R1-PART2 PICTURE X(21). SQ1084.2 +007900 WORKING-STORAGE SECTION. SQ1084.2 +008000 01 END-OF-RECORD-AREA. SQ1084.2 +008100 02 ALPHA-AREA PIC X(17). SQ1084.2 +008200 02 NUMBER-AREA PIC 9999. SQ1084.2 +008300 01 COUNT-OF-RECS PIC 9999. SQ1084.2 +008400 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. SQ1084.2 +008500 01 ERROR-FLAG PICTURE 9 VALUE 0. SQ1084.2 +008600 01 EOF-FLAG PICTURE 9 VALUE 0. SQ1084.2 +008700 01 READ-INTO-AREA1. SQ1084.2 +008800 02 AREA1-1 PIC X(87). SQ1084.2 +008900 01 FOLLOWS-AREA1 PIC X(10). SQ1084.2 +009000 01 READ-INTO-AREA2. SQ1084.2 +009100 02 AREA2-1 PIC X(120). SQ1084.2 +009200 01 FOLLOWS-AREA2 PIC X(10). SQ1084.2 +009300 01 READ-INTO-AREA3. SQ1084.2 +009400 02 AREA3-1 PIC X(141). SQ1084.2 +009500 02 AREA3-2 PIC X(7). SQ1084.2 +009600 01 READ-INTO-AREA4. SQ1084.2 +009700 02 AREA4-1 PICTURE X(120). SQ1084.2 +009800 02 AREA4-2 PICTURE X(21). SQ1084.2 +009900 01 FILE-RECORD-INFORMATION-REC. SQ1084.2 +010000 03 FILE-RECORD-INFO-SKELETON. SQ1084.2 +010100 05 FILLER PICTURE X(48) VALUE SQ1084.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1084.2 +010300 05 FILLER PICTURE X(46) VALUE SQ1084.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1084.2 +010500 05 FILLER PICTURE X(26) VALUE SQ1084.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". SQ1084.2 +010700 05 FILLER PICTURE X(37) VALUE SQ1084.2 +010800 ",RECKEY= ". SQ1084.2 +010900 05 FILLER PICTURE X(38) VALUE SQ1084.2 +011000 ",ALTKEY1= ". SQ1084.2 +011100 05 FILLER PICTURE X(38) VALUE SQ1084.2 +011200 ",ALTKEY2= ". SQ1084.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1084.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1084.2 +011500 05 FILE-RECORD-INFO-P1-120. SQ1084.2 +011600 07 FILLER PIC X(5). SQ1084.2 +011700 07 XFILE-NAME PIC X(6). SQ1084.2 +011800 07 FILLER PIC X(8). SQ1084.2 +011900 07 XRECORD-NAME PIC X(6). SQ1084.2 +012000 07 FILLER PIC X(1). SQ1084.2 +012100 07 REELUNIT-NUMBER PIC 9(1). SQ1084.2 +012200 07 FILLER PIC X(7). SQ1084.2 +012300 07 XRECORD-NUMBER PIC 9(6). SQ1084.2 +012400 07 FILLER PIC X(6). SQ1084.2 +012500 07 UPDATE-NUMBER PIC 9(2). SQ1084.2 +012600 07 FILLER PIC X(5). SQ1084.2 +012700 07 ODO-NUMBER PIC 9(4). SQ1084.2 +012800 07 FILLER PIC X(5). SQ1084.2 +012900 07 XPROGRAM-NAME PIC X(5). SQ1084.2 +013000 07 FILLER PIC X(7). SQ1084.2 +013100 07 XRECORD-LENGTH PIC 9(6). SQ1084.2 +013200 07 FILLER PIC X(7). SQ1084.2 +013300 07 CHARS-OR-RECORDS PIC X(2). SQ1084.2 +013400 07 FILLER PIC X(1). SQ1084.2 +013500 07 XBLOCK-SIZE PIC 9(4). SQ1084.2 +013600 07 FILLER PIC X(6). SQ1084.2 +013700 07 RECORDS-IN-FILE PIC 9(6). SQ1084.2 +013800 07 FILLER PIC X(5). SQ1084.2 +013900 07 XFILE-ORGANIZATION PIC X(2). SQ1084.2 +014000 07 FILLER PIC X(6). SQ1084.2 +014100 07 XLABEL-TYPE PIC X(1). SQ1084.2 +014200 05 FILE-RECORD-INFO-P121-240. SQ1084.2 +014300 07 FILLER PIC X(8). SQ1084.2 +014400 07 XRECORD-KEY PIC X(29). SQ1084.2 +014500 07 FILLER PIC X(9). SQ1084.2 +014600 07 ALTERNATE-KEY1 PIC X(29). SQ1084.2 +014700 07 FILLER PIC X(9). SQ1084.2 +014800 07 ALTERNATE-KEY2 PIC X(29). SQ1084.2 +014900 07 FILLER PIC X(7). SQ1084.2 +015000 01 TEST-RESULTS. SQ1084.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ1084.2 +015200 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1084.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ1084.2 +015400 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1084.2 +015500 02 FILLER PICTURE X VALUE SPACE. SQ1084.2 +015600 02 PAR-NAME. SQ1084.2 +015700 03 FILLER PICTURE X(12) VALUE SPACE. SQ1084.2 +015800 03 PARDOT-X PICTURE X VALUE SPACE. SQ1084.2 +015900 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1084.2 +016000 03 FILLER PIC X(5) VALUE SPACE. SQ1084.2 +016100 02 FILLER PIC X(10) VALUE SPACE. SQ1084.2 +016200 02 RE-MARK PIC X(61). SQ1084.2 +016300 01 TEST-COMPUTED. SQ1084.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1084.2 +016500 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1084.2 +016600 02 COMPUTED-X. SQ1084.2 +016700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1084.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1084.2 +016900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1084.2 +017000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1084.2 +017100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1084.2 +017200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1084.2 +017300 04 COMPUTED-18V0 PICTURE -9(18). SQ1084.2 +017400 04 FILLER PICTURE X. SQ1084.2 +017500 03 FILLER PIC X(50) VALUE SPACE. SQ1084.2 +017600 01 TEST-CORRECT. SQ1084.2 +017700 02 FILLER PIC X(30) VALUE SPACE. SQ1084.2 +017800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1084.2 +017900 02 CORRECT-X. SQ1084.2 +018000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1084.2 +018100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1084.2 +018200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1084.2 +018300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1084.2 +018400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1084.2 +018500 03 CR-18V0 REDEFINES CORRECT-A. SQ1084.2 +018600 04 CORRECT-18V0 PICTURE -9(18). SQ1084.2 +018700 04 FILLER PICTURE X. SQ1084.2 +018800 03 FILLER PIC X(50) VALUE SPACE. SQ1084.2 +018900 01 CCVS-C-1. SQ1084.2 +019000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1084.2 +019100- "SS PARAGRAPH-NAME SQ1084.2 +019200- " REMARKS". SQ1084.2 +019300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1084.2 +019400 01 CCVS-C-2. SQ1084.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1084.2 +019600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1084.2 +019700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1084.2 +019800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1084.2 +019900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1084.2 +020000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1084.2 +020100 01 REC-CT PICTURE 99 VALUE ZERO. SQ1084.2 +020200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1084.2 +020300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1084.2 +020400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1084.2 +020500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1084.2 +020600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1084.2 +020700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1084.2 +020800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1084.2 +020900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1084.2 +021000 01 CCVS-H-1. SQ1084.2 +021100 02 FILLER PICTURE X(27) VALUE SPACE. SQ1084.2 +021200 02 FILLER PICTURE X(67) VALUE SQ1084.2 +021300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1084.2 +021400- " SYSTEM". SQ1084.2 +021500 02 FILLER PICTURE X(26) VALUE SPACE. SQ1084.2 +021600 01 CCVS-H-2. SQ1084.2 +021700 02 FILLER PICTURE X(52) VALUE IS SQ1084.2 +021800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1084.2 +021900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1084.2 +022000 02 TEST-ID PICTURE IS X(9). SQ1084.2 +022100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1084.2 +022200 01 CCVS-H-3. SQ1084.2 +022300 02 FILLER PICTURE X(34) VALUE SQ1084.2 +022400 " FOR OFFICIAL USE ONLY ". SQ1084.2 +022500 02 FILLER PICTURE X(58) VALUE SQ1084.2 +022600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1084.2 +022700 02 FILLER PICTURE X(28) VALUE SQ1084.2 +022800 " COPYRIGHT 1985 ". SQ1084.2 +022900 01 CCVS-E-1. SQ1084.2 +023000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1084.2 +023100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1084.2 +023200 02 ID-AGAIN PICTURE IS X(9). SQ1084.2 +023300 02 FILLER PICTURE X(45) VALUE IS SQ1084.2 +023400 " NTIS DISTRIBUTION COBOL 85". SQ1084.2 +023500 01 CCVS-E-2. SQ1084.2 +023600 02 FILLER PICTURE X(31) VALUE SQ1084.2 +023700 SPACE. SQ1084.2 +023800 02 FILLER PICTURE X(21) VALUE SPACE. SQ1084.2 +023900 02 CCVS-E-2-2. SQ1084.2 +024000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1084.2 +024100 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1084.2 +024200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1084.2 +024300 01 CCVS-E-3. SQ1084.2 +024400 02 FILLER PICTURE X(22) VALUE SQ1084.2 +024500 " FOR OFFICIAL USE ONLY". SQ1084.2 +024600 02 FILLER PICTURE X(12) VALUE SPACE. SQ1084.2 +024700 02 FILLER PICTURE X(58) VALUE SQ1084.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1084.2 +024900 02 FILLER PICTURE X(13) VALUE SPACE. SQ1084.2 +025000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1084.2 +025100 01 CCVS-E-4. SQ1084.2 +025200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1084.2 +025300 02 FILLER PIC XXXX VALUE " OF ". SQ1084.2 +025400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1084.2 +025500 02 FILLER PIC X(40) VALUE SQ1084.2 +025600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1084.2 +025700 01 XXINFO. SQ1084.2 +025800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1084.2 +025900 02 INFO-TEXT. SQ1084.2 +026000 04 FILLER PIC X(20) VALUE SPACE. SQ1084.2 +026100 04 XXCOMPUTED PIC X(20). SQ1084.2 +026200 04 FILLER PIC X(5) VALUE SPACE. SQ1084.2 +026300 04 XXCORRECT PIC X(20). SQ1084.2 +026400 01 HYPHEN-LINE. SQ1084.2 +026500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1084.2 +026600 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1084.2 +026700- "*****************************************". SQ1084.2 +026800 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1084.2 +026900- "******************************". SQ1084.2 +027000 01 CCVS-PGM-ID PIC X(6) VALUE SQ1084.2 +027100 "SQ108A". SQ1084.2 +027200 PROCEDURE DIVISION. SQ1084.2 +027300 CCVS1 SECTION. SQ1084.2 +027400 OPEN-FILES. SQ1084.2 +027500*P OPEN I-O RAW-DATA. SQ1084.2 +027600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1084.2 +027700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1084.2 +027800*P MOVE "ABORTED " TO C-ABORT. SQ1084.2 +027900*P ADD 1 TO C-NO-OF-TESTS. SQ1084.2 +028000*P ACCEPT C-DATE FROM DATE. SQ1084.2 +028100*P ACCEPT C-TIME FROM TIME. SQ1084.2 +028200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1084.2 +028300*PND-E-1. SQ1084.2 +028400*P CLOSE RAW-DATA. SQ1084.2 +028500 OPEN OUTPUT PRINT-FILE. SQ1084.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1084.2 +028700 MOVE SPACE TO TEST-RESULTS. SQ1084.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1084.2 +028900 MOVE ZERO TO REC-SKL-SUB. SQ1084.2 +029000 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1084.2 +029100 CCVS-INIT-FILE. SQ1084.2 +029200 ADD 1 TO REC-SKL-SUB. SQ1084.2 +029300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1084.2 +029400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1084.2 +029500 CCVS-INIT-EXIT. SQ1084.2 +029600 GO TO CCVS1-EXIT. SQ1084.2 +029700 CLOSE-FILES. SQ1084.2 +029800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1084.2 +029900*P OPEN I-O RAW-DATA. SQ1084.2 +030000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1084.2 +030100*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1084.2 +030200*P MOVE "OK. " TO C-ABORT. SQ1084.2 +030300*P MOVE PASS-COUNTER TO C-OK. SQ1084.2 +030400*P MOVE ERROR-HOLD TO C-ALL. SQ1084.2 +030500*P MOVE ERROR-COUNTER TO C-FAIL. SQ1084.2 +030600*P MOVE DELETE-CNT TO C-DELETED. SQ1084.2 +030700*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1084.2 +030800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1084.2 +030900*PND-E-2. SQ1084.2 +031000*P CLOSE RAW-DATA. SQ1084.2 +031100 TERMINATE-CCVS. SQ1084.2 +031200*S EXIT PROGRAM. SQ1084.2 +031300*SERMINATE-CALL. SQ1084.2 +031400 STOP RUN. SQ1084.2 +031500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1084.2 +031600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1084.2 +031700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1084.2 +031800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1084.2 +031900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1084.2 +032000 PRINT-DETAIL. SQ1084.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ1084.2 +032200 MOVE "." TO PARDOT-X SQ1084.2 +032300 MOVE REC-CT TO DOTVALUE. SQ1084.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1084.2 +032500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1084.2 +032600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1084.2 +032700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1084.2 +032800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1084.2 +032900 MOVE SPACE TO CORRECT-X. SQ1084.2 +033000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1084.2 +033100 MOVE SPACE TO RE-MARK. SQ1084.2 +033200 HEAD-ROUTINE. SQ1084.2 +033300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +033400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1084.2 +033500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1084.2 +033600 COLUMN-NAMES-ROUTINE. SQ1084.2 +033700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +033800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +034000 END-ROUTINE. SQ1084.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1084.2 +034200 END-RTN-EXIT. SQ1084.2 +034300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +034400 END-ROUTINE-1. SQ1084.2 +034500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1084.2 +034600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1084.2 +034700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1084.2 +034800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1084.2 +034900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1084.2 +035000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1084.2 +035100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1084.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1084.2 +035300 END-ROUTINE-12. SQ1084.2 +035400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1084.2 +035500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1084.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ1084.2 +035700 ELSE SQ1084.2 +035800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1084.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1084.2 +036000 PERFORM WRITE-LINE. SQ1084.2 +036100 END-ROUTINE-13. SQ1084.2 +036200 IF DELETE-CNT IS EQUAL TO ZERO SQ1084.2 +036300 MOVE "NO " TO ERROR-TOTAL ELSE SQ1084.2 +036400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1084.2 +036500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1084.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +036700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1084.2 +036800 MOVE "NO " TO ERROR-TOTAL SQ1084.2 +036900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1084.2 +037000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1084.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +037200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1084.2 +037300 WRITE-LINE. SQ1084.2 +037400 ADD 1 TO RECORD-COUNT. SQ1084.2 +037500 IF RECORD-COUNT GREATER 50 SQ1084.2 +037600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1084.2 +037700 MOVE SPACE TO DUMMY-RECORD SQ1084.2 +037800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1084.2 +037900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1084.2 +038000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1084.2 +038100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1084.2 +038200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1084.2 +038300 MOVE ZERO TO RECORD-COUNT. SQ1084.2 +038400 PERFORM WRT-LN. SQ1084.2 +038500 WRT-LN. SQ1084.2 +038600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1084.2 +038700 MOVE SPACE TO DUMMY-RECORD. SQ1084.2 +038800 BLANK-LINE-PRINT. SQ1084.2 +038900 PERFORM WRT-LN. SQ1084.2 +039000 FAIL-ROUTINE. SQ1084.2 +039100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1084.2 +039200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1084.2 +039300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1084.2 +039400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +039500 GO TO FAIL-ROUTINE-EX. SQ1084.2 +039600 FAIL-ROUTINE-WRITE. SQ1084.2 +039700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1084.2 +039800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +039900 FAIL-ROUTINE-EX. EXIT. SQ1084.2 +040000 BAIL-OUT. SQ1084.2 +040100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1084.2 +040200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1084.2 +040300 BAIL-OUT-WRITE. SQ1084.2 +040400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1084.2 +040500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1084.2 +040600 BAIL-OUT-EX. EXIT. SQ1084.2 +040700 CCVS1-EXIT. SQ1084.2 +040800 EXIT. SQ1084.2 +040900 SECT-SQ-108-0001 SECTION. SQ1084.2 +041000 SEQ-INIT-019. SQ1084.2 +041100 MOVE "SQ-FS8" TO XFILE-NAME (1). SQ1084.2 +041200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1084.2 +041300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1084.2 +041400 MOVE 141 TO XRECORD-LENGTH (1). SQ1084.2 +041500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1084.2 +041600 MOVE 1 TO XBLOCK-SIZE (1). SQ1084.2 +041700 MOVE 710 TO RECORDS-IN-FILE (1). SQ1084.2 +041800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1084.2 +041900 MOVE "O" TO XLABEL-TYPE (1). SQ1084.2 +042000 MOVE 0 TO NUMBER-AREA. SQ1084.2 +042100 MOVE "READ...INTO FILE " TO ALPHA-AREA. SQ1084.2 +042200 OPEN OUTPUT SQ-FS8. SQ1084.2 +042300 SEQ-TEST-019. SQ1084.2 +042400 ADD 1 TO NUMBER-AREA. SQ1084.2 +042500 MOVE NUMBER-AREA TO XRECORD-NUMBER (1). SQ1084.2 +042600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS8R1-PART1. SQ1084.2 +042700 MOVE END-OF-RECORD-AREA TO SQ-FS8R1-PART2. SQ1084.2 +042800 WRITE SQ-FS8R1-F-G-141. SQ1084.2 +042900 IF NUMBER-AREA EQUAL TO 710 SQ1084.2 +043000 GO TO SEQ-WRITE-019. SQ1084.2 +043100 GO TO SEQ-TEST-019. SQ1084.2 +043200 SEQ-WRITE-019. SQ1084.2 +043300 MOVE "CREATE FILE SQ-FS8" TO FEATURE. SQ1084.2 +043400 MOVE "SEQ-TEST-019" TO PAR-NAME. SQ1084.2 +043500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1084.2 +043600 MOVE NUMBER-AREA TO CORRECT-18V0. SQ1084.2 +043700 PERFORM PRINT-DETAIL. SQ1084.2 +043800 CLOSE SQ-FS8. SQ1084.2 +043900* A MASS STORAGE SEQUENTIAL FILE WITH 141 CHARACTER SQ1084.2 +044000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 710 RECORDS. SQ1084.2 +044100 RERAD-INIT-020. SQ1084.2 +044200 MOVE ZERO TO COUNT-OF-RECS. SQ1084.2 +044300* THIS TEST READS AND CHECKS THE FILE CREATED SQ1084.2 +044400* IN RERAD-TEST-019. SQ1084.2 +044500 OPEN INPUT SQ-FS8. SQ1084.2 +044600 SEQ-TEST-020. SQ1084.2 +044700 READ SQ-FS8 RECORD SQ1084.2 +044800 AT END GO TO SEQ-TEST-020-1. SQ1084.2 +044900 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +045000 IF COUNT-OF-RECS GREATER THAN 710 SQ1084.2 +045100 MOVE "MORE THAN 710 RECORDS" TO RE-MARK SQ1084.2 +045200 GO TO SEQ-FAIL-020. SQ1084.2 +045300 MOVE SQ-FS8R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +045400 MOVE SQ-FS8R1-PART2 TO END-OF-RECORD-AREA. SQ1084.2 +045500 IF COUNT-OF-RECS NOT EQUAL TO NUMBER-AREA SQ1084.2 +045600 GO TO SEQ-TEST-020-2. SQ1084.2 +045700 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +045800 GO TO SEQ-TEST-020-2. SQ1084.2 +045900 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +046000 GO TO SEQ-TEST-020-2. SQ1084.2 +046100 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1084.2 +046200 GO TO SEQ-TEST-020-2. SQ1084.2 +046300 IF ALPHA-AREA EQUAL TO "READ...INTO FILE " SQ1084.2 +046400 GO TO SEQ-TEST-020. SQ1084.2 +046500 SEQ-TEST-020-2. SQ1084.2 +046600 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +046700 GO TO SEQ-TEST-020. SQ1084.2 +046800 SEQ-TEST-020-1. SQ1084.2 +046900 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1084.2 +047000 GO TO SEQ-PASS-020. SQ1084.2 +047100 MOVE "ERRORS IN READING SQ-FS8" TO RE-MARK. SQ1084.2 +047200 SEQ-FAIL-020. SQ1084.2 +047300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1084.2 +047400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1084.2 +047500 PERFORM FAIL. SQ1084.2 +047600 GO TO SEQ-WRITE-020. SQ1084.2 +047700 SEQ-PASS-020. SQ1084.2 +047800 PERFORM PASS. SQ1084.2 +047900 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1084.2 +048000 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1084.2 +048100 SEQ-WRITE-020. SQ1084.2 +048200 MOVE "SEQ-TEST-020" TO PAR-NAME. SQ1084.2 +048300 MOVE "VERIFY FILE SQ-FS8" TO FEATURE. SQ1084.2 +048400 PERFORM PRINT-DETAIL. SQ1084.2 +048500 SEQ-CLOSE-020. SQ1084.2 +048600 CLOSE SQ-FS8. SQ1084.2 +048700 READ-INIT-GF-01. SQ1084.2 +048800 MOVE ZERO TO COUNT-OF-RECS. SQ1084.2 +048900 MOVE ZERO TO RECORDS-IN-ERROR. SQ1084.2 +049000 MOVE ZERO TO ERROR-FLAG. SQ1084.2 +049100 MOVE ZERO TO EOF-FLAG. SQ1084.2 +049200 MOVE "READ 141 INTO 87 " TO FEATURE. SQ1084.2 +049300 MOVE "READ...RECORD INTO...AT END 01 LEVEL" TO RE-MARK. SQ1084.2 +049400 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1084.2 +049500* THIS TEST READS RECORDS OF 141 CHARACTERS INTO A SQ1084.2 +049600* WORKING-STORAGE AREA OF 87 CHARACTERS AND CHECKS THE AREA SQ1084.2 +049700* FOLLOWING TO ENSURE TRUNCATION TOOK PLACE. OTHER FIELDS SQ1084.2 +049800* IN THE RECORD AREA ARE ALSO CHECKED. SQ1084.2 +049900 OPEN INPUT SQ-FS8. SQ1084.2 +050000 READ-TEST-GF-01. SQ1084.2 +050100 MOVE SPACE TO FOLLOWS-AREA1. SQ1084.2 +050200 READ SQ-FS8 RECORD INTO READ-INTO-AREA1 SQ1084.2 +050300 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +050400 MOVE 1 TO EOF-FLAG SQ1084.2 +050500 GO TO READ-FAIL-GF-01. SQ1084.2 +050600 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +050700 IF COUNT-OF-RECS EQUAL TO 125 SQ1084.2 +050800 GO TO READ-TEST-GF-01-1. SQ1084.2 +050900 IF FOLLOWS-AREA1 NOT EQUAL TO SPACE SQ1084.2 +051000 MOVE "WORKING-STORAGE CLOBBERED" TO RE-MARK SQ1084.2 +051100 MOVE FOLLOWS-AREA1 TO COMPUTED-A SQ1084.2 +051200 GO TO READ-FAIL-GF-01. SQ1084.2 +051300 MOVE SPACE TO CHARS-OR-RECORDS (1). SQ1084.2 +051400 MOVE AREA1-1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +051500 IF CHARS-OR-RECORDS (1) EQUAL TO "RC" SQ1084.2 +051600 MOVE "NO TRUNC ON READ" TO COMPUTED-A SQ1084.2 +051700 GO TO READ-FAIL-GF-01. SQ1084.2 +051800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +051900 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +052000 GO TO READ-TEST-GF-01. SQ1084.2 +052100 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +052200 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +052300 GO TO READ-TEST-GF-01. SQ1084.2 +052400 READ-TEST-GF-01-1. SQ1084.2 +052500 IF RECORDS-IN-ERROR EQUAL TO 0 SQ1084.2 +052600 GO TO READ-PASS-GF-01. SQ1084.2 +052700 READ-FAIL-GF-01. SQ1084.2 +052800 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +052900 MOVE "VII-45; 4.4.3 (7), (8) " TO RE-MARK.SQ1084.2 +053000 PERFORM FAIL. SQ1084.2 +053100 GO TO READ-WRITE-GF-01. SQ1084.2 +053200 READ-PASS-GF-01. SQ1084.2 +053300 PERFORM PASS. SQ1084.2 +053400 READ-WRITE-GF-01. SQ1084.2 +053500 PERFORM PRINT-DETAIL. SQ1084.2 +053600 READ-INIT-GF-02. SQ1084.2 +053700 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +053800 GO TO SEQ-EOF-21. SQ1084.2 +053900 MOVE 0 TO ERROR-FLAG. SQ1084.2 +054000* THIS TEST READS RECORDS OF 141 CHARACTERS INTO AN 02 SQ1084.2 +054100* LEVEL IDENTIFIER WITH PIC X(120). SQ1084.2 +054200 MOVE "READ 141 INTO 120 " TO FEATURE. SQ1084.2 +054300 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1084.2 +054400 MOVE "READ...INTO...AT END 02 LEVEL" TO RE-MARK. SQ1084.2 +054500 READ-TEST-GF-02. SQ1084.2 +054600 MOVE SPACE TO FOLLOWS-AREA2. SQ1084.2 +054700 READ SQ-FS8 INTO AREA2-1 SQ1084.2 +054800 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +054900 MOVE 1 TO EOF-FLAG SQ1084.2 +055000 GO TO READ-FAIL-GF-02. SQ1084.2 +055100 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +055200 IF COUNT-OF-RECS EQUAL TO 250 SQ1084.2 +055300 GO TO READ-TEST-GF-02-1. SQ1084.2 +055400 IF FOLLOWS-AREA2 NOT EQUAL TO SPACE SQ1084.2 +055500 MOVE "WORKING-STORAGE CLOBBERED" TO RE-MARK SQ1084.2 +055600 MOVE FOLLOWS-AREA2 TO COMPUTED-A SQ1084.2 +055700 GO TO READ-FAIL-GF-02. SQ1084.2 +055800 MOVE AREA2-1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +055900 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +056000 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +056100 MOVE 1 TO ERROR-FLAG SQ1084.2 +056200 GO TO READ-TEST-GF-02. SQ1084.2 +056300 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +056400 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +056500 MOVE 1 TO ERROR-FLAG. SQ1084.2 +056600 GO TO READ-TEST-GF-02. SQ1084.2 +056700 READ-TEST-GF-02-1. SQ1084.2 +056800 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +056900 GO TO READ-PASS-GF-02. SQ1084.2 +057000 READ-FAIL-GF-02. SQ1084.2 +057100 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +057200 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +057300 PERFORM FAIL. SQ1084.2 +057400 GO TO READ-WRITE-GF-02. SQ1084.2 +057500 READ-PASS-GF-02. SQ1084.2 +057600 PERFORM PASS. SQ1084.2 +057700 READ-WRITE-GF-02. SQ1084.2 +057800 PERFORM PRINT-DETAIL. SQ1084.2 +057900 READ-INIT-GF-03. SQ1084.2 +058000 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +058100 GO TO SEQ-EOF-21. SQ1084.2 +058200 MOVE 0 TO ERROR-FLAG. SQ1084.2 +058300 MOVE "READ 141 INTO 148 " TO FEATURE. SQ1084.2 +058400 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1084.2 +058500 MOVE "READ...RECORD INTO...END 01 LEVEL" TO RE-MARK. SQ1084.2 +058600* THIS TEST READS RECORDS OF 141 CHARACTERS INTO A WORKING-SQ1084.2 +058700* STORAGE RECORD OF 148 CHARACTERS. THE LAST 7 CHARACTERS ARE SQ1084.2 +058800* TESTED TO ENSURE THAT SPACE FILLING ON THE RIGHT OCCURRED. SQ1084.2 +058900 READ-TEST-GF-03. SQ1084.2 +059000 MOVE "ABCDEFG" TO AREA3-2. SQ1084.2 +059100 READ SQ-FS8 RECORD INTO READ-INTO-AREA3 SQ1084.2 +059200 END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +059300 MOVE 1 TO EOF-FLAG SQ1084.2 +059400 GO TO READ-FAIL-GF-03. SQ1084.2 +059500 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +059600 IF COUNT-OF-RECS EQUAL TO 350 SQ1084.2 +059700 GO TO READ-TEST-GF-03-1. SQ1084.2 +059800 IF AREA3-2 NOT EQUAL TO SPACE SQ1084.2 +059900 MOVE "NO SPACE FILL" TO RE-MARK SQ1084.2 +060000 MOVE AREA3-2 TO COMPUTED-A SQ1084.2 +060100 GO TO READ-FAIL-GF-03. SQ1084.2 +060200 MOVE AREA3-1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +060300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +060400 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +060500 MOVE 1 TO ERROR-FLAG SQ1084.2 +060600 GO TO READ-TEST-GF-03. SQ1084.2 +060700 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +060800 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +060900 MOVE 1 TO ERROR-FLAG SQ1084.2 +061000 GO TO READ-TEST-GF-03. SQ1084.2 +061100 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +061200 ADD 1 TO RECORDS-IN-ERROR SQ1084.2 +061300 MOVE 1 TO ERROR-FLAG. SQ1084.2 +061400 GO TO READ-TEST-GF-03. SQ1084.2 +061500 READ-TEST-GF-03-1. SQ1084.2 +061600 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +061700 GO TO READ-PASS-GF-03. SQ1084.2 +061800 READ-FAIL-GF-03. SQ1084.2 +061900 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +062000 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +062100 PERFORM FAIL. SQ1084.2 +062200 GO TO READ-WRITE-GF-03. SQ1084.2 +062300 READ-PASS-GF-03. SQ1084.2 +062400 PERFORM PASS. SQ1084.2 +062500 READ-WRITE-GF-03. SQ1084.2 +062600 PERFORM PRINT-DETAIL. SQ1084.2 +062700 READ-INIT-GF-04. SQ1084.2 +062800 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +062900 GO TO SEQ-EOF-21. SQ1084.2 +063000 MOVE 0 TO ERROR-FLAG. SQ1084.2 +063100 MOVE "READ 141 INTO 141" TO FEATURE. SQ1084.2 +063200 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1084.2 +063300 MOVE "READ...INTO...END 01 LEVEL" TO RE-MARK. SQ1084.2 +063400* THIS TEST READS RECORDS OF 141 CHARACTERS INTO A SQ1084.2 +063500* WORKING-STORAGE RECORD OF 141 CHARACTERS. SQ1084.2 +063600 READ-TEST-GF-04. SQ1084.2 +063700 READ SQ-FS8 INTO READ-INTO-AREA4 SQ1084.2 +063800 END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +063900 MOVE 1 TO EOF-FLAG SQ1084.2 +064000 GO TO READ-FAIL-GF-04. SQ1084.2 +064100 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +064200 IF COUNT-OF-RECS EQUAL TO 400 SQ1084.2 +064300 GO TO READ-TEST-GF-04-1. SQ1084.2 +064400 MOVE AREA4-2 TO END-OF-RECORD-AREA. SQ1084.2 +064500 IF ALPHA-AREA NOT EQUAL TO "READ...INTO FILE " SQ1084.2 +064600 GO TO READ-FAIL-GF-04-1. SQ1084.2 +064700 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +064800 GO TO READ-FAIL-GF-04-1. SQ1084.2 +064900 MOVE AREA4-1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +065000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +065100 GO TO READ-FAIL-GF-04-1. SQ1084.2 +065200 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +065300 GO TO READ-FAIL-GF-04-1. SQ1084.2 +065400 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +065500 GO TO READ-FAIL-GF-04-1. SQ1084.2 +065600 GO TO READ-TEST-GF-04. SQ1084.2 +065700 READ-FAIL-GF-04-1. SQ1084.2 +065800 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +065900 MOVE 1 TO ERROR-FLAG. SQ1084.2 +066000 GO TO READ-TEST-GF-04. SQ1084.2 +066100 READ-TEST-GF-04-1. SQ1084.2 +066200 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +066300 GO TO READ-PASS-GF-04. SQ1084.2 +066400 READ-FAIL-GF-04. SQ1084.2 +066500 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +066600 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +066700 PERFORM FAIL. SQ1084.2 +066800 GO TO READ-WRITE-GF-04. SQ1084.2 +066900 READ-PASS-GF-04. SQ1084.2 +067000 PERFORM PASS. SQ1084.2 +067100 READ-WRITE-GF-04. SQ1084.2 +067200 PERFORM PRINT-DETAIL. SQ1084.2 +067300 READ-INIT-GF-05. SQ1084.2 +067400 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +067500 GO TO SEQ-EOF-21. SQ1084.2 +067600 MOVE 0 TO ERROR-FLAG. SQ1084.2 +067700 MOVE "READ 141 INTO 120" TO FEATURE. SQ1084.2 +067800 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1084.2 +067900 MOVE "READ INTO SUBSCRIPTED DATA ITEM 05 LEVEL" TO RE-MARK. SQ1084.2 +068000* THIS TEST READS A RECORD OF 141 CHARACTERS INTO A SQ1084.2 +068100* SUBSCRIPTED DATA ITEM OF 120 CHARACTERS. SQ1084.2 +068200 READ-TEST-GF-05. SQ1084.2 +068300 READ SQ-FS8 RECORD INTO FILE-RECORD-INFO-P1-120 (1) SQ1084.2 +068400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +068500 MOVE 1 TO EOF-FLAG SQ1084.2 +068600 GO TO READ-FAIL-GF-05. SQ1084.2 +068700 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +068800 IF COUNT-OF-RECS EQUAL TO 425 SQ1084.2 +068900 GO TO READ-TEST-GF-05-1. SQ1084.2 +069000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +069100 GO TO READ-FAIL-GF-05-1. SQ1084.2 +069200 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +069300 GO TO READ-FAIL-GF-05-1. SQ1084.2 +069400 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +069500 GO TO READ-FAIL-GF-05-1. SQ1084.2 +069600 GO TO READ-TEST-GF-05. SQ1084.2 +069700 READ-FAIL-GF-05-1. SQ1084.2 +069800 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +069900 MOVE 1 TO ERROR-FLAG. SQ1084.2 +070000 GO TO READ-TEST-GF-05. SQ1084.2 +070100 READ-TEST-GF-05-1. SQ1084.2 +070200 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +070300 GO TO READ-PASS-GF-05. SQ1084.2 +070400 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +070500 READ-FAIL-GF-05. SQ1084.2 +070600 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +070700 PERFORM FAIL. SQ1084.2 +070800 GO TO READ-WRITE-GF-05. SQ1084.2 +070900 READ-PASS-GF-05. SQ1084.2 +071000 PERFORM PASS. SQ1084.2 +071100 READ-WRITE-GF-05. SQ1084.2 +071200 PERFORM PRINT-DETAIL. SQ1084.2 +071300 READ-INIT-GF-06. SQ1084.2 +071400 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +071500 GO TO SEQ-EOF-21. SQ1084.2 +071600 MOVE 0 TO ERROR-FLAG. SQ1084.2 +071700 MOVE "READ 141 INTO 141" TO FEATURE. SQ1084.2 +071800 MOVE "READ-TEST-GF-06" TO PAR-NAME. SQ1084.2 +071900 MOVE "CHECK OF FD RECORD ON RD INTO 01 LEVEL" TO RE-MARK. SQ1084.2 +072000* THIS TEST READS A RECORD INTO A WORKING-STORAGE AREA SQ1084.2 +072100* AND CHECKS THE CONTENTS OF THE FD RECORD AREA TO ENSURE SQ1084.2 +072200* THAT IT IS NOT AFFECTED BY THE INTO PHRASE. SQ1084.2 +072300 READ-TEST-GF-06. SQ1084.2 +072400 READ SQ-FS8 RECORD INTO READ-INTO-AREA4 SQ1084.2 +072500 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1084.2 +072600 MOVE 1 TO EOF-FLAG SQ1084.2 +072700 GO TO READ-FAIL-GF-06. SQ1084.2 +072800 ADD 1 TO COUNT-OF-RECS. SQ1084.2 +072900 IF COUNT-OF-RECS EQUAL TO 710 SQ1084.2 +073000 GO TO READ-TEST-GF-06-1. SQ1084.2 +073100 MOVE SQ-FS8R1-PART2 TO END-OF-RECORD-AREA. SQ1084.2 +073200 IF ALPHA-AREA NOT EQUAL TO "READ...INTO FILE " SQ1084.2 +073300 GO TO READ-FAIL-GF-06-1. SQ1084.2 +073400 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +073500 GO TO READ-FAIL-GF-06-1. SQ1084.2 +073600 MOVE SQ-FS8R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1084.2 +073700 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS8" SQ1084.2 +073800 GO TO READ-FAIL-GF-06-1. SQ1084.2 +073900 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1084.2 +074000 GO TO READ-FAIL-GF-06-1. SQ1084.2 +074100 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1084.2 +074200 GO TO READ-FAIL-GF-06-1. SQ1084.2 +074300 GO TO READ-TEST-GF-06. SQ1084.2 +074400 READ-FAIL-GF-06-1. SQ1084.2 +074500 ADD 1 TO RECORDS-IN-ERROR. SQ1084.2 +074600 MOVE 1 TO ERROR-FLAG. SQ1084.2 +074700 GO TO READ-TEST-GF-06. SQ1084.2 +074800 READ-TEST-GF-06-1. SQ1084.2 +074900 IF ERROR-FLAG EQUAL TO 0 SQ1084.2 +075000 GO TO READ-TEST-GF-06-2. SQ1084.2 +075100 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1084.2 +075200 GO TO READ-FAIL-GF-06. SQ1084.2 +075300 READ-TEST-GF-06-2. SQ1084.2 +075400 IF READ-INTO-AREA4 EQUAL TO SQ-FS8R1-F-G-141 SQ1084.2 +075500 GO TO READ-PASS-GF-06. SQ1084.2 +075600 READ-FAIL-GF-06. SQ1084.2 +075700 MOVE "VII-45; 4.4.3 (7) & (8) " TO RE-MARK.SQ1084.2 +075800 PERFORM FAIL. SQ1084.2 +075900 GO TO READ-WRITE-GF-06. SQ1084.2 +076000 READ-PASS-GF-06. SQ1084.2 +076100 PERFORM PASS. SQ1084.2 +076200 READ-WRITE-GF-06. SQ1084.2 +076300 PERFORM PRINT-DETAIL. SQ1084.2 +076400 SEQ-INIT-21. SQ1084.2 +076500* THIS TEST CHECKS IF ANY ERRORS WERE ENCOUNTERED ON THE SQ1084.2 +076600* PRECEDING READS, AND READS THE FILE ONCE MORE EXPECTING SQ1084.2 +076700* THE END CONDITION TO OCCUR. SQ1084.2 +076800 IF EOF-FLAG EQUAL TO 1 SQ1084.2 +076900 GO TO SEQ-EOF-21. SQ1084.2 +077000 SEQ-TEST-21. SQ1084.2 +077100 READ SQ-FS8 RECORD INTO READ-INTO-AREA4 SQ1084.2 +077200 AT END GO TO SEQ-TEST-21-1. SQ1084.2 +077300 MOVE "MORE THAN 710 RECORDS" TO RE-MARK. SQ1084.2 +077400 GO TO SEQ-FAIL-21. SQ1084.2 +077500 SEQ-TEST-21-1. SQ1084.2 +077600 IF RECORDS-IN-ERROR NOT EQUAL TO 0 SQ1084.2 +077700 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1084.2 +077800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1084.2 +077900 GO TO SEQ-FAIL-21. SQ1084.2 +078000 SEQ-PASS-21. SQ1084.2 +078100 PERFORM PASS. SQ1084.2 +078200 GO TO SEQ-WRITE-21. SQ1084.2 +078300 SEQ-EOF-21. SQ1084.2 +078400 MOVE "LESS THAN 710 RECORDS" TO RE-MARK. SQ1084.2 +078500 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1084.2 +078600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1084.2 +078700 SEQ-FAIL-21. SQ1084.2 +078800 PERFORM FAIL. SQ1084.2 +078900 SEQ-WRITE-21. SQ1084.2 +079000 MOVE "SEQ-TEST-21" TO PAR-NAME. SQ1084.2 +079100 MOVE "READ SQ-FS8 INTO END" TO FEATURE. SQ1084.2 +079200 PERFORM PRINT-DETAIL. SQ1084.2 +079300 SEQ-CLOSE-021. SQ1084.2 +079400 CLOSE SQ-FS8. SQ1084.2 +079500 TERMINATE-ROUTINE. SQ1084.2 +079600 EXIT. SQ1084.2 +079700 CCVS-EXIT SECTION. SQ1084.2 +079800 CCVS-999999. SQ1084.2 +079900 GO TO CLOSE-FILES. SQ1084.2 diff --git a/tests/cobol85/SQ/SQ109M.CBL b/tests/cobol85/SQ/SQ109M.CBL new file mode 100755 index 00000000..c623891f --- /dev/null +++ b/tests/cobol85/SQ/SQ109M.CBL @@ -0,0 +1,615 @@ +000100 IDENTIFICATION DIVISION. SQ1094.2 +000200 PROGRAM-ID. SQ1094.2 +000300 SQ109M. SQ1094.2 +000400**************************************************************** SQ1094.2 +000500* * SQ1094.2 +000600* VALIDATION FOR:- * SQ1094.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1094.2 +000800* * SQ1094.2 +000900* CREATION DATE / VALIDATION DATE * SQ1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1094.2 +001100* * SQ1094.2 +001200**************************************************************** SQ1094.2 +001300 SQ1094.2 +001400* THIS ROUTINE CREATES A 2 REEL TAPE FILE OF FIXED SQ1094.2 +001500* LENGTH RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN SQ1094.2 +001600* INPUT FILE. THE FILE IS READ AND FIELDS IN THE INPUT RECORDSSQ1094.2 +001700* ARE COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDSSQ1094.2 +001800* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED SQ1094.2 +001900* AGAIN AS AN INPUT FILE. FOUR READ FORMAT OPTIONS ARE USED SQ1094.2 +002000* TO READ THE FILE AND FIELDS IN THE RECORDS ARE VERIFIED. SQ1094.2 +002100* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR SQ1094.2 +002200* LEVEL ONE FEATURES. SQ1094.2 +002300* SQ1094.2 +002400* USED X-CARDS: SQ1094.2 +002500* XXXXX006 SQ1094.2 +002600* XXXXX055 SQ1094.2 +002700* P XXXXX062 SQ1094.2 +002800* XXXXX082 SQ1094.2 +002900* XXXXX083 SQ1094.2 +003000* C XXXXX084 SQ1094.2 +003100* SQ1094.2 +003200* SQ1094.2 +003300 ENVIRONMENT DIVISION. SQ1094.2 +003400 CONFIGURATION SECTION. SQ1094.2 +003500 SOURCE-COMPUTER. SQ1094.2 +003600 Linux. SQ1094.2 +003700 OBJECT-COMPUTER. SQ1094.2 +003800 Linux. SQ1094.2 +003900 INPUT-OUTPUT SECTION. SQ1094.2 +004000 FILE-CONTROL. SQ1094.2 +004100*P SELECT RAW-DATA ASSIGN TO SQ1094.2 +004200*P "XXXXX062" SQ1094.2 +004300*P ORGANIZATION IS INDEXED SQ1094.2 +004400*P ACCESS MODE IS RANDOM SQ1094.2 +004500*P RECORD KEY IS RAW-DATA-KEY. SQ1094.2 +004600 SELECT PRINT-FILE ASSIGN TO SQ1094.2 +004700 "report.log". SQ1094.2 +004800 SELECT SQ-FS1 ASSIGN TO SQ1094.2 +004900 "XXXXX006" SQ1094.2 +005000 ORGANIZATION IS SEQUENTIAL SQ1094.2 +005100 ACCESS MODE IS SEQUENTIAL. SQ1094.2 +005200 DATA DIVISION. SQ1094.2 +005300 FILE SECTION. SQ1094.2 +005400*P SQ1094.2 +005500*PD RAW-DATA. SQ1094.2 +005600*P SQ1094.2 +005700*P1 RAW-DATA-SATZ. SQ1094.2 +005800*P 05 RAW-DATA-KEY PIC X(6). SQ1094.2 +005900*P 05 C-DATE PIC 9(6). SQ1094.2 +006000*P 05 C-TIME PIC 9(8). SQ1094.2 +006100*P 05 C-NO-OF-TESTS PIC 99. SQ1094.2 +006200*P 05 C-OK PIC 999. SQ1094.2 +006300*P 05 C-ALL PIC 999. SQ1094.2 +006400*P 05 C-FAIL PIC 999. SQ1094.2 +006500*P 05 C-DELETED PIC 999. SQ1094.2 +006600*P 05 C-INSPECT PIC 999. SQ1094.2 +006700*P 05 C-NOTE PIC X(13). SQ1094.2 +006800*P 05 C-INDENT PIC X. SQ1094.2 +006900*P 05 C-ABORT PIC X(8). SQ1094.2 +007000 FD PRINT-FILE SQ1094.2 +007100*C LABEL RECORDS SQ1094.2 +007200*C OMITTED SQ1094.2 +007300*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1094.2 +007400 . SQ1094.2 +007500 01 PRINT-REC PICTURE X(120). SQ1094.2 +007600 01 DUMMY-RECORD PICTURE X(120). SQ1094.2 +007700 FD SQ-FS1 SQ1094.2 +007800*C LABEL RECORD STANDARD SQ1094.2 +007900 . SQ1094.2 +008000 01 SQ-FS1R1-F-G-120. SQ1094.2 +008100 02 FILLER PIC X(120). SQ1094.2 +008200 WORKING-STORAGE SECTION. SQ1094.2 +008300 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ1094.2 +008400 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1094.2 +008500 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1094.2 +008600 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1094.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1094.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1094.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1094.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1094.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1094.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1094.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1094.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1094.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1094.2 +009600 ",RECKEY= ". SQ1094.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1094.2 +009800 ",ALTKEY1= ". SQ1094.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1094.2 +010000 ",ALTKEY2= ". SQ1094.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1094.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1094.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1094.2 +010400 07 FILLER PIC X(5). SQ1094.2 +010500 07 XFILE-NAME PIC X(6). SQ1094.2 +010600 07 FILLER PIC X(8). SQ1094.2 +010700 07 XRECORD-NAME PIC X(6). SQ1094.2 +010800 07 FILLER PIC X(1). SQ1094.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1094.2 +011000 07 FILLER PIC X(7). SQ1094.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1094.2 +011200 07 FILLER PIC X(6). SQ1094.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1094.2 +011400 07 FILLER PIC X(5). SQ1094.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1094.2 +011600 07 FILLER PIC X(5). SQ1094.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1094.2 +011800 07 FILLER PIC X(7). SQ1094.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1094.2 +012000 07 FILLER PIC X(7). SQ1094.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1094.2 +012200 07 FILLER PIC X(1). SQ1094.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1094.2 +012400 07 FILLER PIC X(6). SQ1094.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1094.2 +012600 07 FILLER PIC X(5). SQ1094.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1094.2 +012800 07 FILLER PIC X(6). SQ1094.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1094.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1094.2 +013100 07 FILLER PIC X(8). SQ1094.2 +013200 07 XRECORD-KEY PIC X(29). SQ1094.2 +013300 07 FILLER PIC X(9). SQ1094.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1094.2 +013500 07 FILLER PIC X(9). SQ1094.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1094.2 +013700 07 FILLER PIC X(7). SQ1094.2 +013800 01 TEST-RESULTS. SQ1094.2 +013900 02 FILLER PICTURE X VALUE SPACE. SQ1094.2 +014000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1094.2 +014100 02 FILLER PICTURE X VALUE SPACE. SQ1094.2 +014200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1094.2 +014300 02 FILLER PICTURE X VALUE SPACE. SQ1094.2 +014400 02 PAR-NAME. SQ1094.2 +014500 03 FILLER PICTURE X(12) VALUE SPACE. SQ1094.2 +014600 03 PARDOT-X PICTURE X VALUE SPACE. SQ1094.2 +014700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1094.2 +014800 03 FILLER PIC X(5) VALUE SPACE. SQ1094.2 +014900 02 FILLER PIC X(10) VALUE SPACE. SQ1094.2 +015000 02 RE-MARK PIC X(61). SQ1094.2 +015100 01 TEST-COMPUTED. SQ1094.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1094.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1094.2 +015400 02 COMPUTED-X. SQ1094.2 +015500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1094.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1094.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1094.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1094.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1094.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1094.2 +016100 04 COMPUTED-18V0 PICTURE -9(18). SQ1094.2 +016200 04 FILLER PICTURE X. SQ1094.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1094.2 +016400 01 TEST-CORRECT. SQ1094.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1094.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1094.2 +016700 02 CORRECT-X. SQ1094.2 +016800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1094.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1094.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1094.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1094.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1094.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1094.2 +017400 04 CORRECT-18V0 PICTURE -9(18). SQ1094.2 +017500 04 FILLER PICTURE X. SQ1094.2 +017600 03 FILLER PIC X(50) VALUE SPACE. SQ1094.2 +017700 01 CCVS-C-1. SQ1094.2 +017800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1094.2 +017900- "SS PARAGRAPH-NAME SQ1094.2 +018000- " REMARKS". SQ1094.2 +018100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1094.2 +018200 01 CCVS-C-2. SQ1094.2 +018300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1094.2 +018400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1094.2 +018500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1094.2 +018600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1094.2 +018700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1094.2 +018800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1094.2 +018900 01 REC-CT PICTURE 99 VALUE ZERO. SQ1094.2 +019000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1094.2 +019100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1094.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1094.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1094.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1094.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1094.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1094.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1094.2 +019800 01 CCVS-H-1. SQ1094.2 +019900 02 FILLER PICTURE X(27) VALUE SPACE. SQ1094.2 +020000 02 FILLER PICTURE X(67) VALUE SQ1094.2 +020100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1094.2 +020200- " SYSTEM". SQ1094.2 +020300 02 FILLER PICTURE X(26) VALUE SPACE. SQ1094.2 +020400 01 CCVS-H-2. SQ1094.2 +020500 02 FILLER PICTURE X(52) VALUE IS SQ1094.2 +020600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1094.2 +020700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1094.2 +020800 02 TEST-ID PICTURE IS X(9). SQ1094.2 +020900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1094.2 +021000 01 CCVS-H-3. SQ1094.2 +021100 02 FILLER PICTURE X(34) VALUE SQ1094.2 +021200 " FOR OFFICIAL USE ONLY ". SQ1094.2 +021300 02 FILLER PICTURE X(58) VALUE SQ1094.2 +021400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1094.2 +021500 02 FILLER PICTURE X(28) VALUE SQ1094.2 +021600 " COPYRIGHT 1985 ". SQ1094.2 +021700 01 CCVS-E-1. SQ1094.2 +021800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1094.2 +021900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1094.2 +022000 02 ID-AGAIN PICTURE IS X(9). SQ1094.2 +022100 02 FILLER PICTURE X(45) VALUE IS SQ1094.2 +022200 " NTIS DISTRIBUTION COBOL 85". SQ1094.2 +022300 01 CCVS-E-2. SQ1094.2 +022400 02 FILLER PICTURE X(31) VALUE SQ1094.2 +022500 SPACE. SQ1094.2 +022600 02 FILLER PICTURE X(21) VALUE SPACE. SQ1094.2 +022700 02 CCVS-E-2-2. SQ1094.2 +022800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1094.2 +022900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1094.2 +023000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1094.2 +023100 01 CCVS-E-3. SQ1094.2 +023200 02 FILLER PICTURE X(22) VALUE SQ1094.2 +023300 " FOR OFFICIAL USE ONLY". SQ1094.2 +023400 02 FILLER PICTURE X(12) VALUE SPACE. SQ1094.2 +023500 02 FILLER PICTURE X(58) VALUE SQ1094.2 +023600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1094.2 +023700 02 FILLER PICTURE X(13) VALUE SPACE. SQ1094.2 +023800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1094.2 +023900 01 CCVS-E-4. SQ1094.2 +024000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1094.2 +024100 02 FILLER PIC XXXX VALUE " OF ". SQ1094.2 +024200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1094.2 +024300 02 FILLER PIC X(40) VALUE SQ1094.2 +024400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1094.2 +024500 01 XXINFO. SQ1094.2 +024600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1094.2 +024700 02 INFO-TEXT. SQ1094.2 +024800 04 FILLER PIC X(20) VALUE SPACE. SQ1094.2 +024900 04 XXCOMPUTED PIC X(20). SQ1094.2 +025000 04 FILLER PIC X(5) VALUE SPACE. SQ1094.2 +025100 04 XXCORRECT PIC X(20). SQ1094.2 +025200 01 HYPHEN-LINE. SQ1094.2 +025300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1094.2 +025400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1094.2 +025500- "*****************************************". SQ1094.2 +025600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1094.2 +025700- "******************************". SQ1094.2 +025800 01 CCVS-PGM-ID PIC X(6) VALUE SQ1094.2 +025900 "SQ109M". SQ1094.2 +026000 PROCEDURE DIVISION. SQ1094.2 +026100 CCVS1 SECTION. SQ1094.2 +026200 OPEN-FILES. SQ1094.2 +026300*P OPEN I-O RAW-DATA. SQ1094.2 +026400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1094.2 +026500*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1094.2 +026600*P MOVE "ABORTED " TO C-ABORT. SQ1094.2 +026700*P ADD 1 TO C-NO-OF-TESTS. SQ1094.2 +026800*P ACCEPT C-DATE FROM DATE. SQ1094.2 +026900*P ACCEPT C-TIME FROM TIME. SQ1094.2 +027000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1094.2 +027100*PND-E-1. SQ1094.2 +027200*P CLOSE RAW-DATA. SQ1094.2 +027300 OPEN OUTPUT PRINT-FILE. SQ1094.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1094.2 +027500 MOVE SPACE TO TEST-RESULTS. SQ1094.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1094.2 +027700 MOVE ZERO TO REC-SKL-SUB. SQ1094.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1094.2 +027900 CCVS-INIT-FILE. SQ1094.2 +028000 ADD 1 TO REC-SKL-SUB. SQ1094.2 +028100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1094.2 +028200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1094.2 +028300 CCVS-INIT-EXIT. SQ1094.2 +028400 GO TO CCVS1-EXIT. SQ1094.2 +028500 CLOSE-FILES. SQ1094.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1094.2 +028700*P OPEN I-O RAW-DATA. SQ1094.2 +028800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1094.2 +028900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1094.2 +029000*P MOVE "OK. " TO C-ABORT. SQ1094.2 +029100*P MOVE PASS-COUNTER TO C-OK. SQ1094.2 +029200*P MOVE ERROR-HOLD TO C-ALL. SQ1094.2 +029300*P MOVE ERROR-COUNTER TO C-FAIL. SQ1094.2 +029400*P MOVE DELETE-CNT TO C-DELETED. SQ1094.2 +029500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1094.2 +029600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1094.2 +029700*PND-E-2. SQ1094.2 +029800*P CLOSE RAW-DATA. SQ1094.2 +029900 TERMINATE-CCVS. SQ1094.2 +030000*S EXIT PROGRAM. SQ1094.2 +030100*SERMINATE-CALL. SQ1094.2 +030200 STOP RUN. SQ1094.2 +030300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1094.2 +030400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1094.2 +030500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1094.2 +030600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1094.2 +030700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1094.2 +030800 PRINT-DETAIL. SQ1094.2 +030900 IF REC-CT NOT EQUAL TO ZERO SQ1094.2 +031000 MOVE "." TO PARDOT-X SQ1094.2 +031100 MOVE REC-CT TO DOTVALUE. SQ1094.2 +031200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1094.2 +031300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1094.2 +031400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1094.2 +031500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1094.2 +031600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1094.2 +031700 MOVE SPACE TO CORRECT-X. SQ1094.2 +031800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1094.2 +031900 MOVE SPACE TO RE-MARK. SQ1094.2 +032000 HEAD-ROUTINE. SQ1094.2 +032100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +032200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1094.2 +032300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1094.2 +032400 COLUMN-NAMES-ROUTINE. SQ1094.2 +032500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +032600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +032800 END-ROUTINE. SQ1094.2 +032900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1094.2 +033000 END-RTN-EXIT. SQ1094.2 +033100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +033200 END-ROUTINE-1. SQ1094.2 +033300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1094.2 +033400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1094.2 +033500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1094.2 +033600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1094.2 +033700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1094.2 +033800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1094.2 +033900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1094.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1094.2 +034100 END-ROUTINE-12. SQ1094.2 +034200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1094.2 +034300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1094.2 +034400 MOVE "NO " TO ERROR-TOTAL SQ1094.2 +034500 ELSE SQ1094.2 +034600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1094.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1094.2 +034800 PERFORM WRITE-LINE. SQ1094.2 +034900 END-ROUTINE-13. SQ1094.2 +035000 IF DELETE-CNT IS EQUAL TO ZERO SQ1094.2 +035100 MOVE "NO " TO ERROR-TOTAL ELSE SQ1094.2 +035200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1094.2 +035300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1094.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +035500 IF INSPECT-COUNTER EQUAL TO ZERO SQ1094.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ1094.2 +035700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1094.2 +035800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1094.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +036000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1094.2 +036100 WRITE-LINE. SQ1094.2 +036200 ADD 1 TO RECORD-COUNT. SQ1094.2 +036300 IF RECORD-COUNT GREATER 50 SQ1094.2 +036400 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1094.2 +036500 MOVE SPACE TO DUMMY-RECORD SQ1094.2 +036600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1094.2 +036700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1094.2 +036800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1094.2 +036900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1094.2 +037000 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1094.2 +037100 MOVE ZERO TO RECORD-COUNT. SQ1094.2 +037200 PERFORM WRT-LN. SQ1094.2 +037300 WRT-LN. SQ1094.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1094.2 +037500 MOVE SPACE TO DUMMY-RECORD. SQ1094.2 +037600 BLANK-LINE-PRINT. SQ1094.2 +037700 PERFORM WRT-LN. SQ1094.2 +037800 FAIL-ROUTINE. SQ1094.2 +037900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1094.2 +038000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1094.2 +038100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1094.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +038300 GO TO FAIL-ROUTINE-EX. SQ1094.2 +038400 FAIL-ROUTINE-WRITE. SQ1094.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1094.2 +038600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +038700 FAIL-ROUTINE-EX. EXIT. SQ1094.2 +038800 BAIL-OUT. SQ1094.2 +038900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1094.2 +039000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1094.2 +039100 BAIL-OUT-WRITE. SQ1094.2 +039200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1094.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1094.2 +039400 BAIL-OUT-EX. EXIT. SQ1094.2 +039500 CCVS1-EXIT. SQ1094.2 +039600 EXIT. SQ1094.2 +039700 SECT-SQ109-0001 SECTION. SQ1094.2 +039800 SEQ-INIT-001. SQ1094.2 +039900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1094.2 +040000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1094.2 +040100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1094.2 +040200 MOVE 000120 TO XRECORD-LENGTH (1). SQ1094.2 +040300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1094.2 +040400 MOVE 0001 TO XBLOCK-SIZE (1). SQ1094.2 +040500 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1094.2 +040600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1094.2 +040700 MOVE "S" TO XLABEL-TYPE (1). SQ1094.2 +040800 MOVE 000001 TO XRECORD-NUMBER (1). SQ1094.2 +040900 OPEN OUTPUT SQ-FS1. SQ1094.2 +041000 SEQ-TEST-001. SQ1094.2 +041100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1094.2 +041200 WRITE SQ-FS1R1-F-G-120. SQ1094.2 +041300 IF XRECORD-NUMBER (1) EQUAL TO 325 SQ1094.2 +041400 ADD 1 TO REELUNIT-NUMBER (1) SQ1094.2 +041500 CLOSE SQ-FS1 REEL. SQ1094.2 +041600*I MOVE "CLOSE REEL DELETED" TO RE-MARK. SQ1094.2 +041700 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ1094.2 +041800 GO TO SEQ-WRITE-001. SQ1094.2 +041900 ADD 1 TO XRECORD-NUMBER (1). SQ1094.2 +042000 GO TO SEQ-TEST-001. SQ1094.2 +042100 SEQ-WRITE-001. SQ1094.2 +042200 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ1094.2 +042300 MOVE "SEQ-TEST-001" TO PAR-NAME. SQ1094.2 +042400 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1094.2 +042500 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1094.2 +042600 PERFORM PRINT-DETAIL. SQ1094.2 +042700 CLOSE SQ-FS1. SQ1094.2 +042800* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1094.2 +042900* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ1094.2 +043000 SEQ-INIT-002. SQ1094.2 +043100 MOVE ZERO TO WRK-CS-09V00. SQ1094.2 +043200* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1094.2 +043300* SEQ-TEST-001. SQ1094.2 +043400 OPEN INPUT SQ-FS1. SQ1094.2 +043500 SEQ-TEST-002. SQ1094.2 +043600 READ SQ-FS1 SQ1094.2 +043700 AT END GO TO SEQ-TEST-002-1. SQ1094.2 +043800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1094.2 +043900 ADD 1 TO WRK-CS-09V00. SQ1094.2 +044000 IF WRK-CS-09V00 GREATER THAN 750 SQ1094.2 +044100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1094.2 +044200 GO TO SEQ-FAIL-002. SQ1094.2 +044300 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1094.2 +044400 ADD 1 TO RECORDS-IN-ERROR SQ1094.2 +044500 GO TO SEQ-TEST-002. SQ1094.2 +044600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1094.2 +044700 ADD 1 TO RECORDS-IN-ERROR SQ1094.2 +044800 GO TO SEQ-TEST-002. SQ1094.2 +044900 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1094.2 +045000 ADD 1 TO RECORDS-IN-ERROR. SQ1094.2 +045100 GO TO SEQ-TEST-002. SQ1094.2 +045200 SEQ-TEST-002-1. SQ1094.2 +045300 IF WRK-CS-09V00 EQUAL TO ZERO SQ1094.2 +045400 MOVE "AT END ON FIRST READ" TO RE-MARK SQ1094.2 +045500 GO TO SEQ-FAIL-002. SQ1094.2 +045600 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1094.2 +045700 GO TO SEQ-PASS-002. SQ1094.2 +045800 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1094.2 +045900 SEQ-FAIL-002. SQ1094.2 +046000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1094.2 +046100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1094.2 +046200 PERFORM FAIL. SQ1094.2 +046300 GO TO SEQ-WRITE-002. SQ1094.2 +046400 SEQ-PASS-002. SQ1094.2 +046500 PERFORM PASS. SQ1094.2 +046600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1094.2 +046700 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1094.2 +046800 SEQ-WRITE-002. SQ1094.2 +046900 MOVE "SEQ-TEST-002" TO PAR-NAME. SQ1094.2 +047000 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1094.2 +047100 PERFORM PRINT-DETAIL. SQ1094.2 +047200 SEQ-CLOSE-002. SQ1094.2 +047300 CLOSE SQ-FS1. SQ1094.2 +047400 READ-INIT-GF-01. SQ1094.2 +047500 MOVE ZERO TO WRK-CS-09V00. SQ1094.2 +047600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1094.2 +047700 OPEN INPUT SQ-FS1. SQ1094.2 +047800* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1094.2 +047900* IN THIS SERIES OF TESTS. SQ1094.2 +048000 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1094.2 +048100 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1094.2 +048200 MOVE ZERO TO ERROR-FLAG. SQ1094.2 +048300 READ-TEST-GF-01. SQ1094.2 +048400 READ SQ-FS1 RECORD AT END SQ1094.2 +048500 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1094.2 +048600 MOVE 1 TO EOF-FLAG SQ1094.2 +048700 GO TO READ-FAIL-GF-01. SQ1094.2 +048800 PERFORM RECORD-CHECK. SQ1094.2 +048900 IF WRK-CS-09V00 EQUAL TO 200 SQ1094.2 +049000 GO TO READ-TEST-GF-01-1. SQ1094.2 +049100 GO TO READ-TEST-GF-01. SQ1094.2 +049200 RECORD-CHECK. SQ1094.2 +049300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1094.2 +049400 ADD 1 TO WRK-CS-09V00. SQ1094.2 +049500 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1094.2 +049600 ADD 1 TO RECORDS-IN-ERROR SQ1094.2 +049700 MOVE 1 TO ERROR-FLAG. SQ1094.2 +049800 READ-TEST-GF-01-1. SQ1094.2 +049900 IF ERROR-FLAG EQUAL TO ZERO SQ1094.2 +050000 GO TO READ-PASS-GF-01. SQ1094.2 +050100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1094.2 +050200 READ-FAIL-GF-01. SQ1094.2 +050300 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1094.2 +050400 PERFORM FAIL. SQ1094.2 +050500 GO TO READ-WRITE-GF-01. SQ1094.2 +050600 READ-PASS-GF-01. SQ1094.2 +050700 PERFORM PASS. SQ1094.2 +050800 READ-WRITE-GF-01. SQ1094.2 +050900 PERFORM PRINT-DETAIL. SQ1094.2 +051000 READ-INIT-GF-02. SQ1094.2 +051100 IF EOF-FLAG EQUAL TO 1 SQ1094.2 +051200 GO TO SEQ-EOF-003. SQ1094.2 +051300 MOVE ZERO TO ERROR-FLAG. SQ1094.2 +051400 MOVE "READ...AT END..." TO FEATURE. SQ1094.2 +051500 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1094.2 +051600 READ-TEST-GF-02. SQ1094.2 +051700 READ SQ-FS1 AT END SQ1094.2 +051800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1094.2 +051900 MOVE 1 TO EOF-FLAG SQ1094.2 +052000 GO TO READ-FAIL-GF-02. SQ1094.2 +052100 PERFORM RECORD-CHECK. SQ1094.2 +052200 IF WRK-CS-09V00 EQUAL TO 400 SQ1094.2 +052300 GO TO READ-TEST-GF-02-1. SQ1094.2 +052400 GO TO READ-TEST-GF-02. SQ1094.2 +052500 READ-TEST-GF-02-1. SQ1094.2 +052600 IF ERROR-FLAG EQUAL TO ZERO SQ1094.2 +052700 GO TO READ-PASS-GF-02. SQ1094.2 +052800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1094.2 +052900 READ-FAIL-GF-02. SQ1094.2 +053000 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1094.2 +053100 PERFORM FAIL. SQ1094.2 +053200 GO TO READ-WRITE-GF-02. SQ1094.2 +053300 READ-PASS-GF-02. SQ1094.2 +053400 PERFORM PASS. SQ1094.2 +053500 READ-WRITE-GF-02. SQ1094.2 +053600 PERFORM PRINT-DETAIL. SQ1094.2 +053700 READ-INIT-GF-03. SQ1094.2 +053800 IF EOF-FLAG EQUAL TO 1 SQ1094.2 +053900 GO TO SEQ-EOF-003. SQ1094.2 +054000 MOVE ZERO TO ERROR-FLAG. SQ1094.2 +054100 MOVE "READ...RECORD END..." TO FEATURE. SQ1094.2 +054200 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1094.2 +054300 READ-TEST-GF-03. SQ1094.2 +054400 READ SQ-FS1 RECORD END SQ1094.2 +054500 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1094.2 +054600 MOVE 1 TO EOF-FLAG SQ1094.2 +054700 GO TO READ-FAIL-GF-03. SQ1094.2 +054800 PERFORM RECORD-CHECK. SQ1094.2 +054900 IF WRK-CS-09V00 EQUAL TO 600 SQ1094.2 +055000 GO TO READ-TEST-GF-03-1. SQ1094.2 +055100 GO TO READ-TEST-GF-03. SQ1094.2 +055200 READ-TEST-GF-03-1. SQ1094.2 +055300 IF ERROR-FLAG EQUAL TO ZERO SQ1094.2 +055400 GO TO READ-PASS-GF-03. SQ1094.2 +055500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1094.2 +055600 READ-FAIL-GF-03. SQ1094.2 +055700 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1094.2 +055800 PERFORM FAIL. SQ1094.2 +055900 GO TO READ-WRITE-GF-03. SQ1094.2 +056000 READ-PASS-GF-03. SQ1094.2 +056100 PERFORM PASS. SQ1094.2 +056200 READ-WRITE-GF-03. SQ1094.2 +056300 PERFORM PRINT-DETAIL. SQ1094.2 +056400 READ-INIT-GF-04. SQ1094.2 +056500 IF EOF-FLAG EQUAL TO 1 SQ1094.2 +056600 GO TO SEQ-EOF-003. SQ1094.2 +056700 MOVE ZERO TO ERROR-FLAG. SQ1094.2 +056800 MOVE "READ...END..." TO FEATURE. SQ1094.2 +056900 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1094.2 +057000 READ-TEST-GF-04. SQ1094.2 +057100 READ SQ-FS1 END GO TO READ-TEST-GF-04-1. SQ1094.2 +057200 PERFORM RECORD-CHECK. SQ1094.2 +057300 IF WRK-CS-09V00 GREATER THAN 750 SQ1094.2 +057400 GO TO READ-TEST-GF-04-1. SQ1094.2 +057500 GO TO READ-TEST-GF-04. SQ1094.2 +057600 READ-TEST-GF-04-1. SQ1094.2 +057700 IF ERROR-FLAG EQUAL TO ZERO SQ1094.2 +057800 GO TO READ-PASS-GF-04. SQ1094.2 +057900 READ-FAIL-GF-04. SQ1094.2 +058000 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1094.2 +058100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1094.2 +058200 PERFORM FAIL. SQ1094.2 +058300 GO TO READ-WRITE-GF-04. SQ1094.2 +058400 READ-PASS-GF-04. SQ1094.2 +058500 PERFORM PASS. SQ1094.2 +058600 READ-WRITE-GF-04. SQ1094.2 +058700 PERFORM PRINT-DETAIL. SQ1094.2 +058800 SEQ-TEST-003. SQ1094.2 +058900 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1094.2 +059000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1094.2 +059100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1094.2 +059200 GO TO SEQ-FAIL-003. SQ1094.2 +059300 IF WRK-CS-09V00 GREATER THAN 750 SQ1094.2 +059400 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1094.2 +059500 GO TO SEQ-FAIL-003. SQ1094.2 +059600 SEQ-PASS-003. SQ1094.2 +059700 PERFORM PASS. SQ1094.2 +059800 GO TO SEQ-WRITE-003. SQ1094.2 +059900 SEQ-EOF-003. SQ1094.2 +060000 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. SQ1094.2 +060100 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1094.2 +060200 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1094.2 +060300 SEQ-FAIL-003. SQ1094.2 +060400 PERFORM FAIL. SQ1094.2 +060500 SEQ-WRITE-003. SQ1094.2 +060600 MOVE "SEQ-TEST-003" TO PAR-NAME. SQ1094.2 +060700 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ1094.2 +060800 PERFORM PRINT-DETAIL. SQ1094.2 +060900 SEQ-CLOSE-003. SQ1094.2 +061000 CLOSE SQ-FS1. SQ1094.2 +061100 TERMINATE-ROUTINE. SQ1094.2 +061200 EXIT. SQ1094.2 +061300 CCVS-EXIT SECTION. SQ1094.2 +061400 CCVS-999999. SQ1094.2 +061500 GO TO CLOSE-FILES. SQ1094.2 diff --git a/tests/cobol85/SQ/SQ110M.CBL b/tests/cobol85/SQ/SQ110M.CBL new file mode 100755 index 00000000..a3891aa6 --- /dev/null +++ b/tests/cobol85/SQ/SQ110M.CBL @@ -0,0 +1,615 @@ +000100 IDENTIFICATION DIVISION. SQ1104.2 +000200 PROGRAM-ID. SQ1104.2 +000300 SQ110M. SQ1104.2 +000400**************************************************************** SQ1104.2 +000500* * SQ1104.2 +000600* VALIDATION FOR:- * SQ1104.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1104.2 +000800* * SQ1104.2 +000900* CREATION DATE / VALIDATION DATE * SQ1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1104.2 +001100* * SQ1104.2 +001200**************************************************************** SQ1104.2 +001300 SQ1104.2 +001400* THIS ROUTINE CREATES A 2 UNIT MASS-STORAGE SQ1104.2 +001500* FILE WHICH HAS FIXED LENGTH RECORDS. THE FILE IS THEN SQ1104.2 +001600* CLOSED AND OPENED AS AN INPUT FILE. THE FILE IS READ AND SQ1104.2 +001700* FIELDS IN THE INPUT RECORDS ARE COMPARED TO THE VALUES SQ1104.2 +001800* WRITTEN TO ENSURE THAT THE RECORDS WERE PROCESSED CORRECTLY. SQ1104.2 +001900* SQ1104.2 +002000* THE FILE IS CLOSED AND OPENED AGAIN AS AN INPUT FILE. FOUR SQ1104.2 +002100* READ FORMAT OPTIONS ARE USED TO READ THE FILE AND FIELDS IN SQ1104.2 +002200* THE RECORDS ARE VERIFIED. THE OPEN, CLOSE, READ, AND WRITE SQ1104.2 +002300* STATEMENTS ARE TESTED FOR LEVEL ONE FEATURES. SQ1104.2 +002400* SQ1104.2 +002500* USED X-CARDS: SQ1104.2 +002600* XXXXX019 SQ1104.2 +002700* XXXXX055 SQ1104.2 +002800* P XXXXX062 SQ1104.2 +002900* XXXXX082 SQ1104.2 +003000* XXXXX083 SQ1104.2 +003100* C XXXXX084 SQ1104.2 +003200* SQ1104.2 +003300* SQ1104.2 +003400 ENVIRONMENT DIVISION. SQ1104.2 +003500 CONFIGURATION SECTION. SQ1104.2 +003600 SOURCE-COMPUTER. SQ1104.2 +003700 Linux. SQ1104.2 +003800 OBJECT-COMPUTER. SQ1104.2 +003900 Linux. SQ1104.2 +004000 INPUT-OUTPUT SECTION. SQ1104.2 +004100 FILE-CONTROL. SQ1104.2 +004200*P SELECT RAW-DATA ASSIGN TO SQ1104.2 +004300*P "XXXXX062" SQ1104.2 +004400*P ORGANIZATION IS INDEXED SQ1104.2 +004500*P ACCESS MODE IS RANDOM SQ1104.2 +004600*P RECORD KEY IS RAW-DATA-KEY. SQ1104.2 +004700 SELECT PRINT-FILE ASSIGN TO SQ1104.2 +004800 "report.log". SQ1104.2 +004900 SELECT SQ-FS3 ASSIGN TO SQ1104.2 +005000 "XXXXX019" SQ1104.2 +005100 ORGANIZATION IS SEQUENTIAL SQ1104.2 +005200 ACCESS MODE IS SEQUENTIAL. SQ1104.2 +005300 DATA DIVISION. SQ1104.2 +005400 FILE SECTION. SQ1104.2 +005500*P SQ1104.2 +005600*PD RAW-DATA. SQ1104.2 +005700*P SQ1104.2 +005800*P1 RAW-DATA-SATZ. SQ1104.2 +005900*P 05 RAW-DATA-KEY PIC X(6). SQ1104.2 +006000*P 05 C-DATE PIC 9(6). SQ1104.2 +006100*P 05 C-TIME PIC 9(8). SQ1104.2 +006200*P 05 C-NO-OF-TESTS PIC 99. SQ1104.2 +006300*P 05 C-OK PIC 999. SQ1104.2 +006400*P 05 C-ALL PIC 999. SQ1104.2 +006500*P 05 C-FAIL PIC 999. SQ1104.2 +006600*P 05 C-DELETED PIC 999. SQ1104.2 +006700*P 05 C-INSPECT PIC 999. SQ1104.2 +006800*P 05 C-NOTE PIC X(13). SQ1104.2 +006900*P 05 C-INDENT PIC X. SQ1104.2 +007000*P 05 C-ABORT PIC X(8). SQ1104.2 +007100 FD PRINT-FILE SQ1104.2 +007200*C LABEL RECORDS SQ1104.2 +007300*C OMITTED SQ1104.2 +007400*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1104.2 +007500 . SQ1104.2 +007600 01 PRINT-REC PICTURE X(120). SQ1104.2 +007700 01 DUMMY-RECORD PICTURE X(120). SQ1104.2 +007800 FD SQ-FS3 SQ1104.2 +007900*C LABEL RECORDS ARE STANDARD SQ1104.2 +008000*C DATA RECORD SQ-FS3R1-F-G-120 SQ1104.2 +008100 BLOCK CONTAINS 120 CHARACTERS SQ1104.2 +008200 RECORD CONTAINS 120 CHARACTERS. SQ1104.2 +008300 01 SQ-FS3R1-F-G-120. SQ1104.2 +008400 02 FILLER PIC X(120). SQ1104.2 +008500 WORKING-STORAGE SECTION. SQ1104.2 +008600 01 WRK-CS-09V00 PICTURE S9(9) USAGE COMP VALUE ZERO. SQ1104.2 +008700 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. SQ1104.2 +008800 01 ERROR-FLAG PICTURE 9 VALUE 0. SQ1104.2 +008900 01 EOF-FLAG PICTURE 9 VALUE 0. SQ1104.2 +009000 01 FILE-RECORD-INFORMATION-REC. SQ1104.2 +009100 03 FILE-RECORD-INFO-SKELETON. SQ1104.2 +009200 05 FILLER PICTURE X(48) VALUE SQ1104.2 +009300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1104.2 +009400 05 FILLER PICTURE X(46) VALUE SQ1104.2 +009500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1104.2 +009600 05 FILLER PICTURE X(26) VALUE SQ1104.2 +009700 ",LFIL=000000,ORG= ,LBLR= ". SQ1104.2 +009800 05 FILLER PICTURE X(37) VALUE SQ1104.2 +009900 ",RECKEY= ". SQ1104.2 +010000 05 FILLER PICTURE X(38) VALUE SQ1104.2 +010100 ",ALTKEY1= ". SQ1104.2 +010200 05 FILLER PICTURE X(38) VALUE SQ1104.2 +010300 ",ALTKEY2= ". SQ1104.2 +010400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1104.2 +010500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1104.2 +010600 05 FILE-RECORD-INFO-P1-120. SQ1104.2 +010700 07 FILLER PIC X(5). SQ1104.2 +010800 07 XFILE-NAME PIC X(6). SQ1104.2 +010900 07 FILLER PIC X(8). SQ1104.2 +011000 07 XRECORD-NAME PIC X(6). SQ1104.2 +011100 07 FILLER PIC X(1). SQ1104.2 +011200 07 REELUNIT-NUMBER PIC 9(1). SQ1104.2 +011300 07 FILLER PIC X(7). SQ1104.2 +011400 07 XRECORD-NUMBER PIC 9(6). SQ1104.2 +011500 07 FILLER PIC X(6). SQ1104.2 +011600 07 UPDATE-NUMBER PIC 9(2). SQ1104.2 +011700 07 FILLER PIC X(5). SQ1104.2 +011800 07 ODO-NUMBER PIC 9(4). SQ1104.2 +011900 07 FILLER PIC X(5). SQ1104.2 +012000 07 XPROGRAM-NAME PIC X(5). SQ1104.2 +012100 07 FILLER PIC X(7). SQ1104.2 +012200 07 XRECORD-LENGTH PIC 9(6). SQ1104.2 +012300 07 FILLER PIC X(7). SQ1104.2 +012400 07 CHARS-OR-RECORDS PIC X(2). SQ1104.2 +012500 07 FILLER PIC X(1). SQ1104.2 +012600 07 XBLOCK-SIZE PIC 9(4). SQ1104.2 +012700 07 FILLER PIC X(6). SQ1104.2 +012800 07 RECORDS-IN-FILE PIC 9(6). SQ1104.2 +012900 07 FILLER PIC X(5). SQ1104.2 +013000 07 XFILE-ORGANIZATION PIC X(2). SQ1104.2 +013100 07 FILLER PIC X(6). SQ1104.2 +013200 07 XLABEL-TYPE PIC X(1). SQ1104.2 +013300 05 FILE-RECORD-INFO-P121-240. SQ1104.2 +013400 07 FILLER PIC X(8). SQ1104.2 +013500 07 XRECORD-KEY PIC X(29). SQ1104.2 +013600 07 FILLER PIC X(9). SQ1104.2 +013700 07 ALTERNATE-KEY1 PIC X(29). SQ1104.2 +013800 07 FILLER PIC X(9). SQ1104.2 +013900 07 ALTERNATE-KEY2 PIC X(29). SQ1104.2 +014000 07 FILLER PIC X(7). SQ1104.2 +014100 01 TEST-RESULTS. SQ1104.2 +014200 02 FILLER PICTURE X VALUE SPACE. SQ1104.2 +014300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1104.2 +014400 02 FILLER PICTURE X VALUE SPACE. SQ1104.2 +014500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1104.2 +014600 02 FILLER PICTURE X VALUE SPACE. SQ1104.2 +014700 02 PAR-NAME. SQ1104.2 +014800 03 FILLER PICTURE X(12) VALUE SPACE. SQ1104.2 +014900 03 PARDOT-X PICTURE X VALUE SPACE. SQ1104.2 +015000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1104.2 +015100 03 FILLER PIC X(5) VALUE SPACE. SQ1104.2 +015200 02 FILLER PIC X(10) VALUE SPACE. SQ1104.2 +015300 02 RE-MARK PIC X(61). SQ1104.2 +015400 01 TEST-COMPUTED. SQ1104.2 +015500 02 FILLER PIC X(30) VALUE SPACE. SQ1104.2 +015600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1104.2 +015700 02 COMPUTED-X. SQ1104.2 +015800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1104.2 +015900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1104.2 +016000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1104.2 +016100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1104.2 +016200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1104.2 +016300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1104.2 +016400 04 COMPUTED-18V0 PICTURE -9(18). SQ1104.2 +016500 04 FILLER PICTURE X. SQ1104.2 +016600 03 FILLER PIC X(50) VALUE SPACE. SQ1104.2 +016700 01 TEST-CORRECT. SQ1104.2 +016800 02 FILLER PIC X(30) VALUE SPACE. SQ1104.2 +016900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1104.2 +017000 02 CORRECT-X. SQ1104.2 +017100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1104.2 +017200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1104.2 +017300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1104.2 +017400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1104.2 +017500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1104.2 +017600 03 CR-18V0 REDEFINES CORRECT-A. SQ1104.2 +017700 04 CORRECT-18V0 PICTURE -9(18). SQ1104.2 +017800 04 FILLER PICTURE X. SQ1104.2 +017900 03 FILLER PIC X(50) VALUE SPACE. SQ1104.2 +018000 01 CCVS-C-1. SQ1104.2 +018100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1104.2 +018200- "SS PARAGRAPH-NAME SQ1104.2 +018300- " REMARKS". SQ1104.2 +018400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1104.2 +018500 01 CCVS-C-2. SQ1104.2 +018600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1104.2 +018700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1104.2 +018800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1104.2 +018900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1104.2 +019000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1104.2 +019100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1104.2 +019200 01 REC-CT PICTURE 99 VALUE ZERO. SQ1104.2 +019300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1104.2 +019400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1104.2 +019500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1104.2 +019600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1104.2 +019700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1104.2 +019800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1104.2 +019900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1104.2 +020000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1104.2 +020100 01 CCVS-H-1. SQ1104.2 +020200 02 FILLER PICTURE X(27) VALUE SPACE. SQ1104.2 +020300 02 FILLER PICTURE X(67) VALUE SQ1104.2 +020400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1104.2 +020500- " SYSTEM". SQ1104.2 +020600 02 FILLER PICTURE X(26) VALUE SPACE. SQ1104.2 +020700 01 CCVS-H-2. SQ1104.2 +020800 02 FILLER PICTURE X(52) VALUE IS SQ1104.2 +020900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1104.2 +021000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1104.2 +021100 02 TEST-ID PICTURE IS X(9). SQ1104.2 +021200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1104.2 +021300 01 CCVS-H-3. SQ1104.2 +021400 02 FILLER PICTURE X(34) VALUE SQ1104.2 +021500 " FOR OFFICIAL USE ONLY ". SQ1104.2 +021600 02 FILLER PICTURE X(58) VALUE SQ1104.2 +021700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1104.2 +021800 02 FILLER PICTURE X(28) VALUE SQ1104.2 +021900 " COPYRIGHT 1985 ". SQ1104.2 +022000 01 CCVS-E-1. SQ1104.2 +022100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1104.2 +022200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1104.2 +022300 02 ID-AGAIN PICTURE IS X(9). SQ1104.2 +022400 02 FILLER PICTURE X(45) VALUE IS SQ1104.2 +022500 " NTIS DISTRIBUTION COBOL 85". SQ1104.2 +022600 01 CCVS-E-2. SQ1104.2 +022700 02 FILLER PICTURE X(31) VALUE SQ1104.2 +022800 SPACE. SQ1104.2 +022900 02 FILLER PICTURE X(21) VALUE SPACE. SQ1104.2 +023000 02 CCVS-E-2-2. SQ1104.2 +023100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1104.2 +023200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1104.2 +023300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1104.2 +023400 01 CCVS-E-3. SQ1104.2 +023500 02 FILLER PICTURE X(22) VALUE SQ1104.2 +023600 " FOR OFFICIAL USE ONLY". SQ1104.2 +023700 02 FILLER PICTURE X(12) VALUE SPACE. SQ1104.2 +023800 02 FILLER PICTURE X(58) VALUE SQ1104.2 +023900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1104.2 +024000 02 FILLER PICTURE X(13) VALUE SPACE. SQ1104.2 +024100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1104.2 +024200 01 CCVS-E-4. SQ1104.2 +024300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1104.2 +024400 02 FILLER PIC XXXX VALUE " OF ". SQ1104.2 +024500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1104.2 +024600 02 FILLER PIC X(40) VALUE SQ1104.2 +024700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1104.2 +024800 01 XXINFO. SQ1104.2 +024900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1104.2 +025000 02 INFO-TEXT. SQ1104.2 +025100 04 FILLER PIC X(20) VALUE SPACE. SQ1104.2 +025200 04 XXCOMPUTED PIC X(20). SQ1104.2 +025300 04 FILLER PIC X(5) VALUE SPACE. SQ1104.2 +025400 04 XXCORRECT PIC X(20). SQ1104.2 +025500 01 HYPHEN-LINE. SQ1104.2 +025600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1104.2 +025700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1104.2 +025800- "*****************************************". SQ1104.2 +025900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1104.2 +026000- "******************************". SQ1104.2 +026100 01 CCVS-PGM-ID PIC X(6) VALUE SQ1104.2 +026200 "SQ110M". SQ1104.2 +026300 PROCEDURE DIVISION. SQ1104.2 +026400 CCVS1 SECTION. SQ1104.2 +026500 OPEN-FILES. SQ1104.2 +026600*P OPEN I-O RAW-DATA. SQ1104.2 +026700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1104.2 +026800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1104.2 +026900*P MOVE "ABORTED " TO C-ABORT. SQ1104.2 +027000*P ADD 1 TO C-NO-OF-TESTS. SQ1104.2 +027100*P ACCEPT C-DATE FROM DATE. SQ1104.2 +027200*P ACCEPT C-TIME FROM TIME. SQ1104.2 +027300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1104.2 +027400*PND-E-1. SQ1104.2 +027500*P CLOSE RAW-DATA. SQ1104.2 +027600 OPEN OUTPUT PRINT-FILE. SQ1104.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1104.2 +027800 MOVE SPACE TO TEST-RESULTS. SQ1104.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1104.2 +028000 MOVE ZERO TO REC-SKL-SUB. SQ1104.2 +028100 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1104.2 +028200 CCVS-INIT-FILE. SQ1104.2 +028300 ADD 1 TO REC-SKL-SUB. SQ1104.2 +028400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1104.2 +028500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1104.2 +028600 CCVS-INIT-EXIT. SQ1104.2 +028700 GO TO CCVS1-EXIT. SQ1104.2 +028800 CLOSE-FILES. SQ1104.2 +028900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1104.2 +029000*P OPEN I-O RAW-DATA. SQ1104.2 +029100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1104.2 +029200*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1104.2 +029300*P MOVE "OK. " TO C-ABORT. SQ1104.2 +029400*P MOVE PASS-COUNTER TO C-OK. SQ1104.2 +029500*P MOVE ERROR-HOLD TO C-ALL. SQ1104.2 +029600*P MOVE ERROR-COUNTER TO C-FAIL. SQ1104.2 +029700*P MOVE DELETE-CNT TO C-DELETED. SQ1104.2 +029800*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1104.2 +029900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1104.2 +030000*PND-E-2. SQ1104.2 +030100*P CLOSE RAW-DATA. SQ1104.2 +030200 TERMINATE-CCVS. SQ1104.2 +030300*S EXIT PROGRAM. SQ1104.2 +030400*SERMINATE-CALL. SQ1104.2 +030500 STOP RUN. SQ1104.2 +030600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1104.2 +030700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1104.2 +030800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1104.2 +030900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1104.2 +031000 MOVE "****TEST DELETED****" TO RE-MARK. SQ1104.2 +031100 PRINT-DETAIL. SQ1104.2 +031200 IF REC-CT NOT EQUAL TO ZERO SQ1104.2 +031300 MOVE "." TO PARDOT-X SQ1104.2 +031400 MOVE REC-CT TO DOTVALUE. SQ1104.2 +031500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1104.2 +031600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1104.2 +031700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1104.2 +031800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1104.2 +031900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1104.2 +032000 MOVE SPACE TO CORRECT-X. SQ1104.2 +032100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1104.2 +032200 MOVE SPACE TO RE-MARK. SQ1104.2 +032300 HEAD-ROUTINE. SQ1104.2 +032400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +032500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1104.2 +032600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1104.2 +032700 COLUMN-NAMES-ROUTINE. SQ1104.2 +032800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +032900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +033000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +033100 END-ROUTINE. SQ1104.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1104.2 +033300 END-RTN-EXIT. SQ1104.2 +033400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +033500 END-ROUTINE-1. SQ1104.2 +033600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1104.2 +033700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1104.2 +033800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1104.2 +033900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1104.2 +034000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1104.2 +034100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1104.2 +034200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1104.2 +034300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1104.2 +034400 END-ROUTINE-12. SQ1104.2 +034500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1104.2 +034600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1104.2 +034700 MOVE "NO " TO ERROR-TOTAL SQ1104.2 +034800 ELSE SQ1104.2 +034900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1104.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1104.2 +035100 PERFORM WRITE-LINE. SQ1104.2 +035200 END-ROUTINE-13. SQ1104.2 +035300 IF DELETE-CNT IS EQUAL TO ZERO SQ1104.2 +035400 MOVE "NO " TO ERROR-TOTAL ELSE SQ1104.2 +035500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1104.2 +035600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1104.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +035800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1104.2 +035900 MOVE "NO " TO ERROR-TOTAL SQ1104.2 +036000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1104.2 +036100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1104.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +036300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1104.2 +036400 WRITE-LINE. SQ1104.2 +036500 ADD 1 TO RECORD-COUNT. SQ1104.2 +036600 IF RECORD-COUNT GREATER 50 SQ1104.2 +036700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1104.2 +036800 MOVE SPACE TO DUMMY-RECORD SQ1104.2 +036900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1104.2 +037000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1104.2 +037100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1104.2 +037200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1104.2 +037300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1104.2 +037400 MOVE ZERO TO RECORD-COUNT. SQ1104.2 +037500 PERFORM WRT-LN. SQ1104.2 +037600 WRT-LN. SQ1104.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1104.2 +037800 MOVE SPACE TO DUMMY-RECORD. SQ1104.2 +037900 BLANK-LINE-PRINT. SQ1104.2 +038000 PERFORM WRT-LN. SQ1104.2 +038100 FAIL-ROUTINE. SQ1104.2 +038200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1104.2 +038300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1104.2 +038400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1104.2 +038500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +038600 GO TO FAIL-ROUTINE-EX. SQ1104.2 +038700 FAIL-ROUTINE-WRITE. SQ1104.2 +038800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1104.2 +038900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +039000 FAIL-ROUTINE-EX. EXIT. SQ1104.2 +039100 BAIL-OUT. SQ1104.2 +039200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1104.2 +039300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1104.2 +039400 BAIL-OUT-WRITE. SQ1104.2 +039500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1104.2 +039600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1104.2 +039700 BAIL-OUT-EX. EXIT. SQ1104.2 +039800 CCVS1-EXIT. SQ1104.2 +039900 EXIT. SQ1104.2 +040000 SECT-SQ110M-0001 SECTION. SQ1104.2 +040100 SEQ-INIT-007. SQ1104.2 +040200 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ1104.2 +040300 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1104.2 +040400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1104.2 +040500 MOVE 120 TO XRECORD-LENGTH (1). SQ1104.2 +040600 MOVE "CH" TO CHARS-OR-RECORDS (1). SQ1104.2 +040700 MOVE 120 TO XBLOCK-SIZE (1). SQ1104.2 +040800 MOVE 000649 TO RECORDS-IN-FILE (1). SQ1104.2 +040900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1104.2 +041000 MOVE "S" TO XLABEL-TYPE (1). SQ1104.2 +041100 MOVE 000001 TO XRECORD-NUMBER (1). SQ1104.2 +041200 OPEN OUTPUT SQ-FS3. SQ1104.2 +041300 SEQ-TEST-007. SQ1104.2 +041400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ1104.2 +041500 WRITE SQ-FS3R1-F-G-120. SQ1104.2 +041600 IF XRECORD-NUMBER (1) EQUAL TO 196 SQ1104.2 +041700 ADD 1 TO REELUNIT-NUMBER (1) SQ1104.2 +041800 CLOSE SQ-FS3 UNIT. SQ1104.2 +041900*F MOVE "CLOSE UNIT DELETED" TO RE-MARK. SQ1104.2 +042000 IF XRECORD-NUMBER (1) EQUAL TO 649 SQ1104.2 +042100 GO TO SEQ-WRITE-007. SQ1104.2 +042200 ADD 1 TO XRECORD-NUMBER (1). SQ1104.2 +042300 GO TO SEQ-TEST-007. SQ1104.2 +042400 SEQ-WRITE-007. SQ1104.2 +042500 MOVE "CREATE FILE SQ-FS3" TO FEATURE. SQ1104.2 +042600 MOVE "SEQ-TEST-007" TO PAR-NAME. SQ1104.2 +042700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1104.2 +042800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1104.2 +042900 PERFORM PRINT-DETAIL. SQ1104.2 +043000 CLOSE SQ-FS3. SQ1104.2 +043100* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTER SQ1104.2 +043200* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. SQ1104.2 +043300 SEQ-INIT-008. SQ1104.2 +043400 MOVE ZERO TO WRK-CS-09V00. SQ1104.2 +043500* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1104.2 +043600* SEQ-TEST-007. SQ1104.2 +043700 OPEN INPUT SQ-FS3. SQ1104.2 +043800 SEQ-TEST-008. SQ1104.2 +043900 READ SQ-FS3 RECORD SQ1104.2 +044000 AT END GO TO SEQ-TEST-008-1. SQ1104.2 +044100 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1104.2 +044200 ADD 1 TO WRK-CS-09V00. SQ1104.2 +044300 IF WRK-CS-09V00 GREATER THAN 649 SQ1104.2 +044400 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1104.2 +044500 GO TO SEQ-FAIL-008. SQ1104.2 +044600 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1104.2 +044700 ADD 1 TO RECORDS-IN-ERROR SQ1104.2 +044800 GO TO SEQ-TEST-008. SQ1104.2 +044900 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" SQ1104.2 +045000 ADD 1 TO RECORDS-IN-ERROR SQ1104.2 +045100 GO TO SEQ-TEST-008. SQ1104.2 +045200 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1104.2 +045300 ADD 1 TO RECORDS-IN-ERROR. SQ1104.2 +045400 GO TO SEQ-TEST-008. SQ1104.2 +045500 SEQ-TEST-008-1. SQ1104.2 +045600 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1104.2 +045700 GO TO SEQ-PASS-008. SQ1104.2 +045800 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. SQ1104.2 +045900 SEQ-FAIL-008. SQ1104.2 +046000 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1104.2 +046100 PERFORM FAIL. SQ1104.2 +046200 GO TO SEQ-WRITE-008. SQ1104.2 +046300 SEQ-PASS-008. SQ1104.2 +046400 PERFORM PASS. SQ1104.2 +046500 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1104.2 +046600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1104.2 +046700 SEQ-WRITE-008. SQ1104.2 +046800 MOVE "SEQ-TEST-008" TO PAR-NAME. SQ1104.2 +046900 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. SQ1104.2 +047000 PERFORM PRINT-DETAIL. SQ1104.2 +047100 SEQ-CLOSE-008. SQ1104.2 +047200 CLOSE SQ-FS3. SQ1104.2 +047300 READ-INIT-GF-01. SQ1104.2 +047400 MOVE ZERO TO WRK-CS-09V00. SQ1104.2 +047500 MOVE ZERO TO RECORDS-IN-ERROR. SQ1104.2 +047600 OPEN INPUT SQ-FS3. SQ1104.2 +047700* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1104.2 +047800* IN THIS SERIES OF TESTS. SQ1104.2 +047900 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1104.2 +048000 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1104.2 +048100 MOVE ZERO TO ERROR-FLAG. SQ1104.2 +048200 READ-TEST-GF-01. SQ1104.2 +048300 READ SQ-FS3 RECORD SQ1104.2 +048400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1104.2 +048500 MOVE 1 TO EOF-FLAG SQ1104.2 +048600 GO TO READ-FAIL-GF-01. SQ1104.2 +048700 PERFORM RECORD-CHECK. SQ1104.2 +048800 IF WRK-CS-09V00 EQUAL TO 50 SQ1104.2 +048900 GO TO READ-TEST-GF-01-1. SQ1104.2 +049000 GO TO READ-TEST-GF-01. SQ1104.2 +049100 RECORD-CHECK. SQ1104.2 +049200 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1104.2 +049300 ADD 1 TO WRK-CS-09V00. SQ1104.2 +049400 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1104.2 +049500 ADD 1 TO RECORDS-IN-ERROR SQ1104.2 +049600 MOVE 1 TO ERROR-FLAG. SQ1104.2 +049700 READ-TEST-GF-01-1. SQ1104.2 +049800 IF ERROR-FLAG EQUAL TO ZERO SQ1104.2 +049900 GO TO READ-PASS-GF-01. SQ1104.2 +050000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1104.2 +050100 READ-FAIL-GF-01. SQ1104.2 +050200 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1104.2 +050300 PERFORM FAIL. SQ1104.2 +050400 GO TO READ-WRITE-GF-01. SQ1104.2 +050500 READ-PASS-GF-01. SQ1104.2 +050600 PERFORM PASS. SQ1104.2 +050700 READ-WRITE-GF-01. SQ1104.2 +050800 PERFORM PRINT-DETAIL. SQ1104.2 +050900 READ-INIT-GF-02. SQ1104.2 +051000 IF EOF-FLAG EQUAL TO 1 SQ1104.2 +051100 GO TO SEQ-EOF-009. SQ1104.2 +051200 MOVE ZERO TO ERROR-FLAG. SQ1104.2 +051300 MOVE "READ...AT END..." TO FEATURE. SQ1104.2 +051400 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1104.2 +051500 READ-TEST-GF-02. SQ1104.2 +051600 READ SQ-FS3 AT END SQ1104.2 +051700 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1104.2 +051800 MOVE 1 TO EOF-FLAG SQ1104.2 +051900 GO TO READ-FAIL-GF-02. SQ1104.2 +052000 PERFORM RECORD-CHECK. SQ1104.2 +052100 IF WRK-CS-09V00 EQUAL TO 200 SQ1104.2 +052200 GO TO READ-TEST-GF-02-1. SQ1104.2 +052300 GO TO READ-TEST-GF-02. SQ1104.2 +052400 READ-TEST-GF-02-1. SQ1104.2 +052500 IF ERROR-FLAG EQUAL TO ZERO SQ1104.2 +052600 GO TO READ-PASS-GF-02. SQ1104.2 +052700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1104.2 +052800 READ-FAIL-GF-02. SQ1104.2 +052900 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1104.2 +053000 PERFORM FAIL. SQ1104.2 +053100 GO TO READ-WRITE-GF-02. SQ1104.2 +053200 READ-PASS-GF-02. SQ1104.2 +053300 PERFORM PASS. SQ1104.2 +053400 READ-WRITE-GF-02. SQ1104.2 +053500 PERFORM PRINT-DETAIL. SQ1104.2 +053600 READ-INIT-GF-03. SQ1104.2 +053700 IF EOF-FLAG EQUAL TO 1 SQ1104.2 +053800 GO TO SEQ-EOF-009. SQ1104.2 +053900 MOVE ZERO TO ERROR-FLAG. SQ1104.2 +054000 MOVE "READ...RECORD END..." TO FEATURE. SQ1104.2 +054100 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1104.2 +054200 READ-TEST-GF-03. SQ1104.2 +054300 READ SQ-FS3 RECORD END SQ1104.2 +054400 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1104.2 +054500 MOVE 1 TO EOF-FLAG SQ1104.2 +054600 GO TO READ-FAIL-GF-03. SQ1104.2 +054700 PERFORM RECORD-CHECK. SQ1104.2 +054800 IF WRK-CS-09V00 EQUAL TO 499 SQ1104.2 +054900 GO TO READ-TEST-GF-03-1. SQ1104.2 +055000 GO TO READ-TEST-GF-03. SQ1104.2 +055100 READ-TEST-GF-03-1. SQ1104.2 +055200 IF ERROR-FLAG EQUAL TO ZERO SQ1104.2 +055300 GO TO READ-PASS-GF-03. SQ1104.2 +055400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1104.2 +055500 READ-FAIL-GF-03. SQ1104.2 +055600 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1104.2 +055700 PERFORM FAIL. SQ1104.2 +055800 GO TO READ-WRITE-GF-03. SQ1104.2 +055900 READ-PASS-GF-03. SQ1104.2 +056000 PERFORM PASS. SQ1104.2 +056100 READ-WRITE-GF-03. SQ1104.2 +056200 PERFORM PRINT-DETAIL. SQ1104.2 +056300 READ-INIT-GF-04. SQ1104.2 +056400 IF EOF-FLAG EQUAL TO 1 SQ1104.2 +056500 GO TO SEQ-EOF-009. SQ1104.2 +056600 MOVE ZERO TO ERROR-FLAG. SQ1104.2 +056700 MOVE "READ...END..." TO FEATURE. SQ1104.2 +056800 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1104.2 +056900 READ-TEST-GF-04. SQ1104.2 +057000 READ SQ-FS3 END SQ1104.2 +057100 GO TO READ-TEST-GF-04-1. SQ1104.2 +057200 PERFORM RECORD-CHECK. SQ1104.2 +057300 IF WRK-CS-09V00 GREATER THAN 649 SQ1104.2 +057400 GO TO READ-TEST-GF-04-1. SQ1104.2 +057500 GO TO READ-TEST-GF-04. SQ1104.2 +057600 READ-TEST-GF-04-1. SQ1104.2 +057700 IF ERROR-FLAG EQUAL TO ZERO SQ1104.2 +057800 GO TO READ-PASS-GF-04. SQ1104.2 +057900 READ-FAIL-GF-04. SQ1104.2 +058000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1104.2 +058100 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1104.2 +058200 PERFORM FAIL. SQ1104.2 +058300 GO TO READ-WRITE-GF-04. SQ1104.2 +058400 READ-PASS-GF-04. SQ1104.2 +058500 PERFORM PASS. SQ1104.2 +058600 READ-WRITE-GF-04. SQ1104.2 +058700 PERFORM PRINT-DETAIL. SQ1104.2 +058800 SEQ-TEST-009. SQ1104.2 +058900 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1104.2 +059000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1104.2 +059100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1104.2 +059200 GO TO SEQ-FAIL-009. SQ1104.2 +059300 IF WRK-CS-09V00 GREATER THAN 649 SQ1104.2 +059400 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1104.2 +059500 GO TO SEQ-FAIL-009. SQ1104.2 +059600 SEQ-PASS-009. SQ1104.2 +059700 PERFORM PASS SQ1104.2 +059800 GO TO SEQ-WRITE-009. SQ1104.2 +059900 SEQ-EOF-009. SQ1104.2 +060000 MOVE "LESS THAN 649 RECORDS" TO RE-MARK. SQ1104.2 +060100 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1104.2 +060200 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1104.2 +060300 SEQ-FAIL-009. SQ1104.2 +060400 PERFORM FAIL. SQ1104.2 +060500 SEQ-WRITE-009. SQ1104.2 +060600 MOVE "SEQ-TEST-009" TO PAR-NAME. SQ1104.2 +060700 MOVE "READ FILE SQ-FS3" TO FEATURE. SQ1104.2 +060800 PERFORM PRINT-DETAIL. SQ1104.2 +060900 SEQ-CLOSE-009. SQ1104.2 +061000 CLOSE SQ-FS3. SQ1104.2 +061100 TERMINATE-ROUTINE. SQ1104.2 +061200 EXIT. SQ1104.2 +061300 CCVS-EXIT SECTION. SQ1104.2 +061400 CCVS-999999. SQ1104.2 +061500 GO TO CLOSE-FILES. SQ1104.2 diff --git a/tests/cobol85/SQ/SQ111A.CBL b/tests/cobol85/SQ/SQ111A.CBL new file mode 100755 index 00000000..fa880000 --- /dev/null +++ b/tests/cobol85/SQ/SQ111A.CBL @@ -0,0 +1,491 @@ +000100 IDENTIFICATION DIVISION. SQ1114.2 +000200 PROGRAM-ID. SQ1114.2 +000300 SQ111A. SQ1114.2 +000400**************************************************************** SQ1114.2 +000500* * SQ1114.2 +000600* VALIDATION FOR:- * SQ1114.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1114.2 +000800* * SQ1114.2 +000900* CREATION DATE / VALIDATION DATE * SQ1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1114.2 +001100* * SQ1114.2 +001200**************************************************************** SQ1114.2 +001300 SQ1114.2 +001400* THIS ROUTINE CREATES A SEQUENTIAL TAPE FILE CONTAINING SQ1114.2 +001500* 595 RECORDS, EACH RECORD CONTAINING 155 CHARACTERS. THE SQ1114.2 +001600* CODE-SET CLAUSE IS INCLUDED IN THE FILE DESCRIPTION ENTRY SQ1114.2 +001700* FOR THE FILE. THE RECORD DESCRIPTION FOR THE FILE CONTAINS SQ1114.2 +001800* AN ITEM WITH THE SIGN IS SEPARATE CHARACTER CLAUSE. SQ1114.2 +001900* A SEQUENTIAL TAPE FILE WITH 595 RECORDS HAS BEEN SQ1114.2 +002000* CREATED. THE FD FOR THE FILE CONTAINS A CODE-SET CLAUSE. SQ1114.2 +002100* THERE ARE 155 CHARACTERS PER RECORD INCLUDING A NUMERIC SQ1114.2 +002200* ITEM WITH THE SIGN IS SEPARATE CLAUSE. SQ1114.2 +002300* SQ1114.2 +002400* USED X-CARDS: SQ1114.2 +002500* XXXXX001 SQ1114.2 +002600* XXXXX055 SQ1114.2 +002700* P XXXXX062 SQ1114.2 +002800* XXXXX082 SQ1114.2 +002900* XXXXX083 SQ1114.2 +003000* C XXXXX084 SQ1114.2 +003100* SQ1114.2 +003200* SQ1114.2 +003300 ENVIRONMENT DIVISION. SQ1114.2 +003400 CONFIGURATION SECTION. SQ1114.2 +003500 SOURCE-COMPUTER. SQ1114.2 +003600 Linux. SQ1114.2 +003700 OBJECT-COMPUTER. SQ1114.2 +003800 Linux. SQ1114.2 +003900 SPECIAL-NAMES. SQ1114.2 +004000 ALPHABET TAPE-CHARACTER-SET IS STANDARD-1. SQ1114.2 +004100 INPUT-OUTPUT SECTION. SQ1114.2 +004200 FILE-CONTROL. SQ1114.2 +004300*P SELECT RAW-DATA ASSIGN TO SQ1114.2 +004400*P "XXXXX062" SQ1114.2 +004500*P ORGANIZATION IS INDEXED SQ1114.2 +004600*P ACCESS MODE IS RANDOM SQ1114.2 +004700*P RECORD KEY IS RAW-DATA-KEY. SQ1114.2 +004800 SELECT PRINT-FILE ASSIGN TO SQ1114.2 +004900 "report.log". SQ1114.2 +005000 SELECT SQ-FS1 ASSIGN TO SQ1114.2 +005100 "XXXXX001" SQ1114.2 +005200 ORGANIZATION IS SEQUENTIAL. SQ1114.2 +005300 DATA DIVISION. SQ1114.2 +005400 FILE SECTION. SQ1114.2 +005500*P SQ1114.2 +005600*PD RAW-DATA. SQ1114.2 +005700*P SQ1114.2 +005800*P1 RAW-DATA-SATZ. SQ1114.2 +005900*P 05 RAW-DATA-KEY PIC X(6). SQ1114.2 +006000*P 05 C-DATE PIC 9(6). SQ1114.2 +006100*P 05 C-TIME PIC 9(8). SQ1114.2 +006200*P 05 C-NO-OF-TESTS PIC 99. SQ1114.2 +006300*P 05 C-OK PIC 999. SQ1114.2 +006400*P 05 C-ALL PIC 999. SQ1114.2 +006500*P 05 C-FAIL PIC 999. SQ1114.2 +006600*P 05 C-DELETED PIC 999. SQ1114.2 +006700*P 05 C-INSPECT PIC 999. SQ1114.2 +006800*P 05 C-NOTE PIC X(13). SQ1114.2 +006900*P 05 C-INDENT PIC X. SQ1114.2 +007000*P 05 C-ABORT PIC X(8). SQ1114.2 +007100 FD PRINT-FILE SQ1114.2 +007200*C LABEL RECORDS SQ1114.2 +007300*C OMITTED SQ1114.2 +007400*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1114.2 +007500 . SQ1114.2 +007600 01 PRINT-REC PICTURE X(120). SQ1114.2 +007700 01 DUMMY-RECORD PICTURE X(120). SQ1114.2 +007800 FD SQ-FS1 SQ1114.2 +007900*C LABEL RECORD STANDARD SQ1114.2 +008000 CODE-SET IS TAPE-CHARACTER-SET . SQ1114.2 +008100 01 SQ-FS1R1-F-G-155. SQ1114.2 +008200 02 SQ-FS1-FIRST PICTURE X(120). SQ1114.2 +008300 02 SQ-FS1-RECNO PIC S9(5) SIGN IS LEADING SQ1114.2 +008400 SEPARATE CHARACTER. SQ1114.2 +008500 02 SQ-FS1-FILLER PICTURE X(30). SQ1114.2 +008600 WORKING-STORAGE SECTION. SQ1114.2 +008700 01 COUNT-OF-RECS PIC S9(5) VALUE ZERO. SQ1114.2 +008800 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1114.2 +008900 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1114.2 +009000 01 EOF-FLAG PIC 9 VALUE ZERO. SQ1114.2 +009100 01 COMPARE-ITEM. SQ1114.2 +009200 02 FILLER PICTURE X. SQ1114.2 +009300 02 COMPARE-REC-NO PICTURE 9(5). SQ1114.2 +009400 01 TEMP-STORE-FOR-PRINT. SQ1114.2 +009500 02 TEMP-FIRST PIC X(120). SQ1114.2 +009600 02 TEMP-SECOND. SQ1114.2 +009700 03 TEMP-RECNO PIC X(6). SQ1114.2 +009800 03 TEMP-FILLER PIC X(30). SQ1114.2 +009900 01 FILE-RECORD-INFORMATION-REC. SQ1114.2 +010000 03 FILE-RECORD-INFO-SKELETON. SQ1114.2 +010100 05 FILLER PICTURE X(48) VALUE SQ1114.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1114.2 +010300 05 FILLER PICTURE X(46) VALUE SQ1114.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1114.2 +010500 05 FILLER PICTURE X(26) VALUE SQ1114.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". SQ1114.2 +010700 05 FILLER PICTURE X(37) VALUE SQ1114.2 +010800 ",RECKEY= ". SQ1114.2 +010900 05 FILLER PICTURE X(38) VALUE SQ1114.2 +011000 ",ALTKEY1= ". SQ1114.2 +011100 05 FILLER PICTURE X(38) VALUE SQ1114.2 +011200 ",ALTKEY2= ". SQ1114.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1114.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1114.2 +011500 05 FILE-RECORD-INFO-P1-120. SQ1114.2 +011600 07 FILLER PIC X(5). SQ1114.2 +011700 07 XFILE-NAME PIC X(6). SQ1114.2 +011800 07 FILLER PIC X(8). SQ1114.2 +011900 07 XRECORD-NAME PIC X(6). SQ1114.2 +012000 07 FILLER PIC X(1). SQ1114.2 +012100 07 REELUNIT-NUMBER PIC 9(1). SQ1114.2 +012200 07 FILLER PIC X(7). SQ1114.2 +012300 07 XRECORD-NUMBER PIC 9(6). SQ1114.2 +012400 07 FILLER PIC X(6). SQ1114.2 +012500 07 UPDATE-NUMBER PIC 9(2). SQ1114.2 +012600 07 FILLER PIC X(5). SQ1114.2 +012700 07 ODO-NUMBER PIC 9(4). SQ1114.2 +012800 07 FILLER PIC X(5). SQ1114.2 +012900 07 XPROGRAM-NAME PIC X(5). SQ1114.2 +013000 07 FILLER PIC X(7). SQ1114.2 +013100 07 XRECORD-LENGTH PIC 9(6). SQ1114.2 +013200 07 FILLER PIC X(7). SQ1114.2 +013300 07 CHARS-OR-RECORDS PIC X(2). SQ1114.2 +013400 07 FILLER PIC X(1). SQ1114.2 +013500 07 XBLOCK-SIZE PIC 9(4). SQ1114.2 +013600 07 FILLER PIC X(6). SQ1114.2 +013700 07 RECORDS-IN-FILE PIC 9(6). SQ1114.2 +013800 07 FILLER PIC X(5). SQ1114.2 +013900 07 XFILE-ORGANIZATION PIC X(2). SQ1114.2 +014000 07 FILLER PIC X(6). SQ1114.2 +014100 07 XLABEL-TYPE PIC X(1). SQ1114.2 +014200 05 FILE-RECORD-INFO-P121-240. SQ1114.2 +014300 07 FILLER PIC X(8). SQ1114.2 +014400 07 XRECORD-KEY PIC X(29). SQ1114.2 +014500 07 FILLER PIC X(9). SQ1114.2 +014600 07 ALTERNATE-KEY1 PIC X(29). SQ1114.2 +014700 07 FILLER PIC X(9). SQ1114.2 +014800 07 ALTERNATE-KEY2 PIC X(29). SQ1114.2 +014900 07 FILLER PIC X(7). SQ1114.2 +015000 01 TEST-RESULTS. SQ1114.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ1114.2 +015200 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1114.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ1114.2 +015400 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1114.2 +015500 02 FILLER PICTURE X VALUE SPACE. SQ1114.2 +015600 02 PAR-NAME. SQ1114.2 +015700 03 FILLER PICTURE X(12) VALUE SPACE. SQ1114.2 +015800 03 PARDOT-X PICTURE X VALUE SPACE. SQ1114.2 +015900 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1114.2 +016000 03 FILLER PIC X(5) VALUE SPACE. SQ1114.2 +016100 02 FILLER PIC X(10) VALUE SPACE. SQ1114.2 +016200 02 RE-MARK PIC X(61). SQ1114.2 +016300 01 TEST-COMPUTED. SQ1114.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1114.2 +016500 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1114.2 +016600 02 COMPUTED-X. SQ1114.2 +016700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1114.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1114.2 +016900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1114.2 +017000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1114.2 +017100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1114.2 +017200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1114.2 +017300 04 COMPUTED-18V0 PICTURE -9(18). SQ1114.2 +017400 04 FILLER PICTURE X. SQ1114.2 +017500 03 FILLER PIC X(50) VALUE SPACE. SQ1114.2 +017600 01 TEST-CORRECT. SQ1114.2 +017700 02 FILLER PIC X(30) VALUE SPACE. SQ1114.2 +017800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1114.2 +017900 02 CORRECT-X. SQ1114.2 +018000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1114.2 +018100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1114.2 +018200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1114.2 +018300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1114.2 +018400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1114.2 +018500 03 CR-18V0 REDEFINES CORRECT-A. SQ1114.2 +018600 04 CORRECT-18V0 PICTURE -9(18). SQ1114.2 +018700 04 FILLER PICTURE X. SQ1114.2 +018800 03 FILLER PIC X(50) VALUE SPACE. SQ1114.2 +018900 01 CCVS-C-1. SQ1114.2 +019000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1114.2 +019100- "SS PARAGRAPH-NAME SQ1114.2 +019200- " REMARKS". SQ1114.2 +019300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1114.2 +019400 01 CCVS-C-2. SQ1114.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1114.2 +019600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1114.2 +019700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1114.2 +019800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1114.2 +019900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1114.2 +020000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1114.2 +020100 01 REC-CT PICTURE 99 VALUE ZERO. SQ1114.2 +020200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1114.2 +020300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1114.2 +020400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1114.2 +020500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1114.2 +020600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1114.2 +020700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1114.2 +020800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1114.2 +020900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1114.2 +021000 01 CCVS-H-1. SQ1114.2 +021100 02 FILLER PICTURE X(27) VALUE SPACE. SQ1114.2 +021200 02 FILLER PICTURE X(67) VALUE SQ1114.2 +021300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1114.2 +021400- " SYSTEM". SQ1114.2 +021500 02 FILLER PICTURE X(26) VALUE SPACE. SQ1114.2 +021600 01 CCVS-H-2. SQ1114.2 +021700 02 FILLER PICTURE X(52) VALUE IS SQ1114.2 +021800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1114.2 +021900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1114.2 +022000 02 TEST-ID PICTURE IS X(9). SQ1114.2 +022100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1114.2 +022200 01 CCVS-H-3. SQ1114.2 +022300 02 FILLER PICTURE X(34) VALUE SQ1114.2 +022400 " FOR OFFICIAL USE ONLY ". SQ1114.2 +022500 02 FILLER PICTURE X(58) VALUE SQ1114.2 +022600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1114.2 +022700 02 FILLER PICTURE X(28) VALUE SQ1114.2 +022800 " COPYRIGHT 1985 ". SQ1114.2 +022900 01 CCVS-E-1. SQ1114.2 +023000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1114.2 +023100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1114.2 +023200 02 ID-AGAIN PICTURE IS X(9). SQ1114.2 +023300 02 FILLER PICTURE X(45) VALUE IS SQ1114.2 +023400 " NTIS DISTRIBUTION COBOL 85". SQ1114.2 +023500 01 CCVS-E-2. SQ1114.2 +023600 02 FILLER PICTURE X(31) VALUE SQ1114.2 +023700 SPACE. SQ1114.2 +023800 02 FILLER PICTURE X(21) VALUE SPACE. SQ1114.2 +023900 02 CCVS-E-2-2. SQ1114.2 +024000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1114.2 +024100 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1114.2 +024200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1114.2 +024300 01 CCVS-E-3. SQ1114.2 +024400 02 FILLER PICTURE X(22) VALUE SQ1114.2 +024500 " FOR OFFICIAL USE ONLY". SQ1114.2 +024600 02 FILLER PICTURE X(12) VALUE SPACE. SQ1114.2 +024700 02 FILLER PICTURE X(58) VALUE SQ1114.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1114.2 +024900 02 FILLER PICTURE X(13) VALUE SPACE. SQ1114.2 +025000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1114.2 +025100 01 CCVS-E-4. SQ1114.2 +025200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1114.2 +025300 02 FILLER PIC XXXX VALUE " OF ". SQ1114.2 +025400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1114.2 +025500 02 FILLER PIC X(40) VALUE SQ1114.2 +025600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1114.2 +025700 01 XXINFO. SQ1114.2 +025800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1114.2 +025900 02 INFO-TEXT. SQ1114.2 +026000 04 FILLER PIC X(20) VALUE SPACE. SQ1114.2 +026100 04 XXCOMPUTED PIC X(20). SQ1114.2 +026200 04 FILLER PIC X(5) VALUE SPACE. SQ1114.2 +026300 04 XXCORRECT PIC X(20). SQ1114.2 +026400 01 HYPHEN-LINE. SQ1114.2 +026500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1114.2 +026600 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1114.2 +026700- "*****************************************". SQ1114.2 +026800 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1114.2 +026900- "******************************". SQ1114.2 +027000 01 CCVS-PGM-ID PIC X(6) VALUE SQ1114.2 +027100 "SQ111A". SQ1114.2 +027200 PROCEDURE DIVISION. SQ1114.2 +027300 CCVS1 SECTION. SQ1114.2 +027400 OPEN-FILES. SQ1114.2 +027500*P OPEN I-O RAW-DATA. SQ1114.2 +027600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1114.2 +027700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1114.2 +027800*P MOVE "ABORTED " TO C-ABORT. SQ1114.2 +027900*P ADD 1 TO C-NO-OF-TESTS. SQ1114.2 +028000*P ACCEPT C-DATE FROM DATE. SQ1114.2 +028100*P ACCEPT C-TIME FROM TIME. SQ1114.2 +028200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1114.2 +028300*PND-E-1. SQ1114.2 +028400*P CLOSE RAW-DATA. SQ1114.2 +028500 OPEN OUTPUT PRINT-FILE. SQ1114.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1114.2 +028700 MOVE SPACE TO TEST-RESULTS. SQ1114.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1114.2 +028900 MOVE ZERO TO REC-SKL-SUB. SQ1114.2 +029000 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1114.2 +029100 CCVS-INIT-FILE. SQ1114.2 +029200 ADD 1 TO REC-SKL-SUB. SQ1114.2 +029300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1114.2 +029400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1114.2 +029500 CCVS-INIT-EXIT. SQ1114.2 +029600 GO TO CCVS1-EXIT. SQ1114.2 +029700 CLOSE-FILES. SQ1114.2 +029800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1114.2 +029900*P OPEN I-O RAW-DATA. SQ1114.2 +030000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1114.2 +030100*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1114.2 +030200*P MOVE "OK. " TO C-ABORT. SQ1114.2 +030300*P MOVE PASS-COUNTER TO C-OK. SQ1114.2 +030400*P MOVE ERROR-HOLD TO C-ALL. SQ1114.2 +030500*P MOVE ERROR-COUNTER TO C-FAIL. SQ1114.2 +030600*P MOVE DELETE-CNT TO C-DELETED. SQ1114.2 +030700*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1114.2 +030800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1114.2 +030900*PND-E-2. SQ1114.2 +031000*P CLOSE RAW-DATA. SQ1114.2 +031100 TERMINATE-CCVS. SQ1114.2 +031200*S EXIT PROGRAM. SQ1114.2 +031300*SERMINATE-CALL. SQ1114.2 +031400 STOP RUN. SQ1114.2 +031500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1114.2 +031600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1114.2 +031700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1114.2 +031800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1114.2 +031900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1114.2 +032000 PRINT-DETAIL. SQ1114.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ1114.2 +032200 MOVE "." TO PARDOT-X SQ1114.2 +032300 MOVE REC-CT TO DOTVALUE. SQ1114.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1114.2 +032500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1114.2 +032600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1114.2 +032700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1114.2 +032800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1114.2 +032900 MOVE SPACE TO CORRECT-X. SQ1114.2 +033000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1114.2 +033100 MOVE SPACE TO RE-MARK. SQ1114.2 +033200 HEAD-ROUTINE. SQ1114.2 +033300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +033400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1114.2 +033500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1114.2 +033600 COLUMN-NAMES-ROUTINE. SQ1114.2 +033700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +033800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +034000 END-ROUTINE. SQ1114.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1114.2 +034200 END-RTN-EXIT. SQ1114.2 +034300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +034400 END-ROUTINE-1. SQ1114.2 +034500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1114.2 +034600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1114.2 +034700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1114.2 +034800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1114.2 +034900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1114.2 +035000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1114.2 +035100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1114.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1114.2 +035300 END-ROUTINE-12. SQ1114.2 +035400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1114.2 +035500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1114.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ1114.2 +035700 ELSE SQ1114.2 +035800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1114.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1114.2 +036000 PERFORM WRITE-LINE. SQ1114.2 +036100 END-ROUTINE-13. SQ1114.2 +036200 IF DELETE-CNT IS EQUAL TO ZERO SQ1114.2 +036300 MOVE "NO " TO ERROR-TOTAL ELSE SQ1114.2 +036400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1114.2 +036500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1114.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +036700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1114.2 +036800 MOVE "NO " TO ERROR-TOTAL SQ1114.2 +036900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1114.2 +037000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1114.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +037200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1114.2 +037300 WRITE-LINE. SQ1114.2 +037400 ADD 1 TO RECORD-COUNT. SQ1114.2 +037500 IF RECORD-COUNT GREATER 50 SQ1114.2 +037600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1114.2 +037700 MOVE SPACE TO DUMMY-RECORD SQ1114.2 +037800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1114.2 +037900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1114.2 +038000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1114.2 +038100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1114.2 +038200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1114.2 +038300 MOVE ZERO TO RECORD-COUNT. SQ1114.2 +038400 PERFORM WRT-LN. SQ1114.2 +038500 WRT-LN. SQ1114.2 +038600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1114.2 +038700 MOVE SPACE TO DUMMY-RECORD. SQ1114.2 +038800 BLANK-LINE-PRINT. SQ1114.2 +038900 PERFORM WRT-LN. SQ1114.2 +039000 FAIL-ROUTINE. SQ1114.2 +039100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1114.2 +039200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1114.2 +039300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1114.2 +039400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +039500 GO TO FAIL-ROUTINE-EX. SQ1114.2 +039600 FAIL-ROUTINE-WRITE. SQ1114.2 +039700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1114.2 +039800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +039900 FAIL-ROUTINE-EX. EXIT. SQ1114.2 +040000 BAIL-OUT. SQ1114.2 +040100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1114.2 +040200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1114.2 +040300 BAIL-OUT-WRITE. SQ1114.2 +040400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1114.2 +040500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1114.2 +040600 BAIL-OUT-EX. EXIT. SQ1114.2 +040700 CCVS1-EXIT. SQ1114.2 +040800 EXIT. SQ1114.2 +040900 SECT-SQ111A-0001 SECTION. SQ1114.2 +041000 WRITE-INIT-GF-01. SQ1114.2 +041100 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1114.2 +041200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1114.2 +041300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1114.2 +041400 MOVE 000155 TO XRECORD-LENGTH (1). SQ1114.2 +041500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1114.2 +041600 MOVE 0001 TO XBLOCK-SIZE (1). SQ1114.2 +041700 MOVE 000595 TO RECORDS-IN-FILE (1). SQ1114.2 +041800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1114.2 +041900 MOVE "S" TO XLABEL-TYPE (1). SQ1114.2 +042000 MOVE 000001 TO XRECORD-NUMBER (1). SQ1114.2 +042100 OPEN OUTPUT SQ-FS1. SQ1114.2 +042200 WRITE-TEST-GF-01. SQ1114.2 +042300 ADD 1 TO COUNT-OF-RECS. SQ1114.2 +042400 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1114.2 +042500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1-FIRST. SQ1114.2 +042600 MOVE COUNT-OF-RECS TO SQ-FS1-RECNO. SQ1114.2 +042700 MOVE "WRITE-SET USED IN CREATING FILE" TO SQ-FS1-FILLER. SQ1114.2 +042800 WRITE SQ-FS1R1-F-G-155. SQ1114.2 +042900 IF COUNT-OF-RECS EQUAL TO 595 SQ1114.2 +043000 GO TO WRITE-WRITE-GF-01. SQ1114.2 +043100 GO TO WRITE-TEST-GF-01. SQ1114.2 +043200 WRITE-WRITE-GF-01. SQ1114.2 +043300 MOVE "WRITE FILE SQ-FS1" TO FEATURE. SQ1114.2 +043400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ1114.2 +043500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1114.2 +043600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1114.2 +043700 MOVE "CODE-SET CLAUSE IN FD" TO RE-MARK. SQ1114.2 +043800 PERFORM PRINT-DETAIL. SQ1114.2 +043900 CLOSE SQ-FS1. SQ1114.2 +044000 READ-INIT-GF-01. SQ1114.2 +044100 MOVE ZERO TO COUNT-OF-RECS. SQ1114.2 +044200* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1114.2 +044300* READ-TEST-GF-01. SQ1114.2 +044400 OPEN INPUT SQ-FS1. SQ1114.2 +044500 READ-TEST-GF-01. SQ1114.2 +044600 READ SQ-FS1 RECORD SQ1114.2 +044700 AT END GO TO READ-TEST-GF-01-1. SQ1114.2 +044800 ADD 1 TO COUNT-OF-RECS. SQ1114.2 +044900 IF COUNT-OF-RECS EQUAL TO 596 SQ1114.2 +045000 MOVE "MORE THAN 595 RECORDS" TO RE-MARK SQ1114.2 +045100 GO TO READ-FAIL-GF-01-1. SQ1114.2 +045200 MOVE SQ-FS1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ1114.2 +045300 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1114.2 +045400 ADD 1 TO RECORDS-IN-ERROR SQ1114.2 +045500 GO TO READ-TEST-GF-01. SQ1114.2 +045600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1114.2 +045700 ADD 1 TO RECORDS-IN-ERROR SQ1114.2 +045800 GO TO READ-TEST-GF-01. SQ1114.2 +045900 MOVE SQ-FS1-RECNO TO COMPARE-ITEM. SQ1114.2 +046000 IF COMPARE-REC-NO EQUAL TO COUNT-OF-RECS SQ1114.2 +046100 GO TO READ-TEST-GF-01. SQ1114.2 +046200 ADD 1 TO RECORDS-IN-ERROR. SQ1114.2 +046300 GO TO READ-TEST-GF-01. SQ1114.2 +046400 READ-TEST-GF-01-1. SQ1114.2 +046500 IF COUNT-OF-RECS NOT EQUAL TO 595 SQ1114.2 +046600 MOVE "UNEXPECTED EOF" TO RE-MARK SQ1114.2 +046700 MOVE "RECORDS READ =" TO COMPUTED-A SQ1114.2 +046800 MOVE COUNT-OF-RECS TO CORRECT-18V0 SQ1114.2 +046900 GO TO READ-FAIL-GF-01. SQ1114.2 +047000 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1114.2 +047100 GO TO READ-PASS-GF-01. SQ1114.2 +047200 MOVE "VII-44; 4.4.2; ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1114.2 +047300 READ-FAIL-GF-01-1. SQ1114.2 +047400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1114.2 +047500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1114.2 +047600 READ-FAIL-GF-01. SQ1114.2 +047700 PERFORM FAIL. SQ1114.2 +047800 GO TO READ-WRITE-GF-01. SQ1114.2 +047900 READ-PASS-GF-01. SQ1114.2 +048000 PERFORM PASS. SQ1114.2 +048100 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1114.2 +048200 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1114.2 +048300 READ-WRITE-GF-01. SQ1114.2 +048400 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1114.2 +048500 MOVE "READ TO VERIFY " TO FEATURE. SQ1114.2 +048600 PERFORM PRINT-DETAIL. SQ1114.2 +048700 READ-CLOSE-GF-01. SQ1114.2 +048800 CLOSE SQ-FS1. SQ1114.2 +048900 CCVS-EXIT SECTION. SQ1114.2 +049000 CCVS-999999. SQ1114.2 +049100 GO TO CLOSE-FILES. SQ1114.2 diff --git a/tests/cobol85/SQ/SQ112A.CBL b/tests/cobol85/SQ/SQ112A.CBL new file mode 100755 index 00000000..eab44166 --- /dev/null +++ b/tests/cobol85/SQ/SQ112A.CBL @@ -0,0 +1,686 @@ +000100 IDENTIFICATION DIVISION. SQ1124.2 +000200 PROGRAM-ID. SQ1124.2 +000300 SQ112A. SQ1124.2 +000400**************************************************************** SQ1124.2 +000500* * SQ1124.2 +000600* VALIDATION FOR:- * SQ1124.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1124.2 +000800* * SQ1124.2 +000900* CREATION DATE / VALIDATION DATE * SQ1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1124.2 +001100* * SQ1124.2 +001200**************************************************************** SQ1124.2 +001300 SQ1124.2 +001400* THE ROUTINE SQ112A CREATES A FILE WHICH HAS FIXED LENGTH SQ1124.2 +001500* RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN INPUT FILESQ1124.2 +001600* AND THE FILE IS READ AND FIELDS IN THE INPUT RECORDS ARE SQ1124.2 +001700* COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDS SQ1124.2 +001800* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED SQ1124.2 +001900* AGAIN FOR OUTPUT. THE DATA WRITTEN TO THE FILE PREVIOUSLY SQ1124.2 +002000* SHOULD BE ELIMINATED. ADDITIONAL RECORDS ARE WRITTEN TO SQ1124.2 +002100* THE FILE. THE FILE IS CLOSED AND OPENED AS AN INPUT FILE. SQ1124.2 +002200* THE CONTENT OF THE FILE IS VERIFIED TO ASCERTAIN THAT ONLY SQ1124.2 +002300* DATA WRITTEN AFTER THE FILE HAD BEEN OPENED OUTPUT THE SQ1124.2 +002400* SQ1124.2 +002500* SECOND TIME IS PRESENT. SQ1124.2 +002600* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR SQ1124.2 +002700* LEVEL ONE FEATURES. SQ1124.2 +002800* SQ1124.2 +002900* USED X-CARDS: SQ1124.2 +003000* XXXXX001 SQ1124.2 +003100* XXXXX055 SQ1124.2 +003200* P XXXXX062 SQ1124.2 +003300* XXXXX082 SQ1124.2 +003400* XXXXX083 SQ1124.2 +003500* C XXXXX084 SQ1124.2 +003600* SQ1124.2 +003700* SQ1124.2 +003800 ENVIRONMENT DIVISION. SQ1124.2 +003900 CONFIGURATION SECTION. SQ1124.2 +004000 SOURCE-COMPUTER. SQ1124.2 +004100 Linux. SQ1124.2 +004200 OBJECT-COMPUTER. SQ1124.2 +004300 Linux. SQ1124.2 +004400 INPUT-OUTPUT SECTION. SQ1124.2 +004500 FILE-CONTROL. SQ1124.2 +004600*P SELECT RAW-DATA ASSIGN TO SQ1124.2 +004700*P "XXXXX062" SQ1124.2 +004800*P ORGANIZATION IS INDEXED SQ1124.2 +004900*P ACCESS MODE IS RANDOM SQ1124.2 +005000*P RECORD KEY IS RAW-DATA-KEY. SQ1124.2 +005100 SELECT PRINT-FILE ASSIGN TO SQ1124.2 +005200 "report.log". SQ1124.2 +005300 SELECT SQ-FS1 ASSIGN TO SQ1124.2 +005400 "XXXXX001" SQ1124.2 +005500 ORGANIZATION IS SEQUENTIAL SQ1124.2 +005600 ACCESS MODE IS SEQUENTIAL. SQ1124.2 +005700 DATA DIVISION. SQ1124.2 +005800 FILE SECTION. SQ1124.2 +005900*P SQ1124.2 +006000*PD RAW-DATA. SQ1124.2 +006100*P SQ1124.2 +006200*P1 RAW-DATA-SATZ. SQ1124.2 +006300*P 05 RAW-DATA-KEY PIC X(6). SQ1124.2 +006400*P 05 C-DATE PIC 9(6). SQ1124.2 +006500*P 05 C-TIME PIC 9(8). SQ1124.2 +006600*P 05 C-NO-OF-TESTS PIC 99. SQ1124.2 +006700*P 05 C-OK PIC 999. SQ1124.2 +006800*P 05 C-ALL PIC 999. SQ1124.2 +006900*P 05 C-FAIL PIC 999. SQ1124.2 +007000*P 05 C-DELETED PIC 999. SQ1124.2 +007100*P 05 C-INSPECT PIC 999. SQ1124.2 +007200*P 05 C-NOTE PIC X(13). SQ1124.2 +007300*P 05 C-INDENT PIC X. SQ1124.2 +007400*P 05 C-ABORT PIC X(8). SQ1124.2 +007500 FD PRINT-FILE SQ1124.2 +007600*C LABEL RECORDS SQ1124.2 +007700*C OMITTED SQ1124.2 +007800*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1124.2 +007900 . SQ1124.2 +008000 01 PRINT-REC PICTURE X(120). SQ1124.2 +008100 01 DUMMY-RECORD PICTURE X(120). SQ1124.2 +008200 FD SQ-FS1 SQ1124.2 +008300*C LABEL RECORD STANDARD SQ1124.2 +008400 . SQ1124.2 +008500 01 SQ-FS1R1-F-G-120. SQ1124.2 +008600 02 FILLER PIC X(120). SQ1124.2 +008700 WORKING-STORAGE SECTION. SQ1124.2 +008800 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ1124.2 +008900 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1124.2 +009000 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1124.2 +009100 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1124.2 +009200 01 FILE-RECORD-INFORMATION-REC. SQ1124.2 +009300 03 FILE-RECORD-INFO-SKELETON. SQ1124.2 +009400 05 FILLER PICTURE X(48) VALUE SQ1124.2 +009500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1124.2 +009600 05 FILLER PICTURE X(46) VALUE SQ1124.2 +009700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1124.2 +009800 05 FILLER PICTURE X(26) VALUE SQ1124.2 +009900 ",LFIL=000000,ORG= ,LBLR= ". SQ1124.2 +010000 05 FILLER PICTURE X(37) VALUE SQ1124.2 +010100 ",RECKEY= ". SQ1124.2 +010200 05 FILLER PICTURE X(38) VALUE SQ1124.2 +010300 ",ALTKEY1= ". SQ1124.2 +010400 05 FILLER PICTURE X(38) VALUE SQ1124.2 +010500 ",ALTKEY2= ". SQ1124.2 +010600 05 FILLER PICTURE X(7) VALUE SPACE.SQ1124.2 +010700 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1124.2 +010800 05 FILE-RECORD-INFO-P1-120. SQ1124.2 +010900 07 FILLER PIC X(5). SQ1124.2 +011000 07 XFILE-NAME PIC X(6). SQ1124.2 +011100 07 FILLER PIC X(8). SQ1124.2 +011200 07 XRECORD-NAME PIC X(6). SQ1124.2 +011300 07 FILLER PIC X(1). SQ1124.2 +011400 07 REELUNIT-NUMBER PIC 9(1). SQ1124.2 +011500 07 FILLER PIC X(7). SQ1124.2 +011600 07 XRECORD-NUMBER PIC 9(6). SQ1124.2 +011700 07 FILLER PIC X(6). SQ1124.2 +011800 07 UPDATE-NUMBER PIC 9(2). SQ1124.2 +011900 07 FILLER PIC X(5). SQ1124.2 +012000 07 ODO-NUMBER PIC 9(4). SQ1124.2 +012100 07 FILLER PIC X(5). SQ1124.2 +012200 07 XPROGRAM-NAME PIC X(5). SQ1124.2 +012300 07 FILLER PIC X(7). SQ1124.2 +012400 07 XRECORD-LENGTH PIC 9(6). SQ1124.2 +012500 07 FILLER PIC X(7). SQ1124.2 +012600 07 CHARS-OR-RECORDS PIC X(2). SQ1124.2 +012700 07 FILLER PIC X(1). SQ1124.2 +012800 07 XBLOCK-SIZE PIC 9(4). SQ1124.2 +012900 07 FILLER PIC X(6). SQ1124.2 +013000 07 RECORDS-IN-FILE PIC 9(6). SQ1124.2 +013100 07 FILLER PIC X(5). SQ1124.2 +013200 07 XFILE-ORGANIZATION PIC X(2). SQ1124.2 +013300 07 FILLER PIC X(6). SQ1124.2 +013400 07 XLABEL-TYPE PIC X(1). SQ1124.2 +013500 05 FILE-RECORD-INFO-P121-240. SQ1124.2 +013600 07 FILLER PIC X(8). SQ1124.2 +013700 07 XRECORD-KEY PIC X(29). SQ1124.2 +013800 07 FILLER PIC X(9). SQ1124.2 +013900 07 ALTERNATE-KEY1 PIC X(29). SQ1124.2 +014000 07 FILLER PIC X(9). SQ1124.2 +014100 07 ALTERNATE-KEY2 PIC X(29). SQ1124.2 +014200 07 FILLER PIC X(7). SQ1124.2 +014300 01 TEST-RESULTS. SQ1124.2 +014400 02 FILLER PICTURE X VALUE SPACE. SQ1124.2 +014500 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1124.2 +014600 02 FILLER PICTURE X VALUE SPACE. SQ1124.2 +014700 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1124.2 +014800 02 FILLER PICTURE X VALUE SPACE. SQ1124.2 +014900 02 PAR-NAME. SQ1124.2 +015000 03 FILLER PICTURE X(12) VALUE SPACE. SQ1124.2 +015100 03 PARDOT-X PICTURE X VALUE SPACE. SQ1124.2 +015200 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1124.2 +015300 03 FILLER PIC X(5) VALUE SPACE. SQ1124.2 +015400 02 FILLER PIC X(10) VALUE SPACE. SQ1124.2 +015500 02 RE-MARK PIC X(61). SQ1124.2 +015600 01 TEST-COMPUTED. SQ1124.2 +015700 02 FILLER PIC X(30) VALUE SPACE. SQ1124.2 +015800 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1124.2 +015900 02 COMPUTED-X. SQ1124.2 +016000 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1124.2 +016100 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1124.2 +016200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1124.2 +016300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1124.2 +016400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1124.2 +016500 03 CM-18V0 REDEFINES COMPUTED-A. SQ1124.2 +016600 04 COMPUTED-18V0 PICTURE -9(18). SQ1124.2 +016700 04 FILLER PICTURE X. SQ1124.2 +016800 03 FILLER PIC X(50) VALUE SPACE. SQ1124.2 +016900 01 TEST-CORRECT. SQ1124.2 +017000 02 FILLER PIC X(30) VALUE SPACE. SQ1124.2 +017100 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1124.2 +017200 02 CORRECT-X. SQ1124.2 +017300 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1124.2 +017400 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1124.2 +017500 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1124.2 +017600 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1124.2 +017700 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1124.2 +017800 03 CR-18V0 REDEFINES CORRECT-A. SQ1124.2 +017900 04 CORRECT-18V0 PICTURE -9(18). SQ1124.2 +018000 04 FILLER PICTURE X. SQ1124.2 +018100 03 FILLER PIC X(50) VALUE SPACE. SQ1124.2 +018200 01 CCVS-C-1. SQ1124.2 +018300 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1124.2 +018400- "SS PARAGRAPH-NAME SQ1124.2 +018500- " REMARKS". SQ1124.2 +018600 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1124.2 +018700 01 CCVS-C-2. SQ1124.2 +018800 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1124.2 +018900 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1124.2 +019000 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1124.2 +019100 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1124.2 +019200 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1124.2 +019300 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1124.2 +019400 01 REC-CT PICTURE 99 VALUE ZERO. SQ1124.2 +019500 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1124.2 +019600 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1124.2 +019700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1124.2 +019800 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1124.2 +019900 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1124.2 +020000 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1124.2 +020100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1124.2 +020200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1124.2 +020300 01 CCVS-H-1. SQ1124.2 +020400 02 FILLER PICTURE X(27) VALUE SPACE. SQ1124.2 +020500 02 FILLER PICTURE X(67) VALUE SQ1124.2 +020600 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1124.2 +020700- " SYSTEM". SQ1124.2 +020800 02 FILLER PICTURE X(26) VALUE SPACE. SQ1124.2 +020900 01 CCVS-H-2. SQ1124.2 +021000 02 FILLER PICTURE X(52) VALUE IS SQ1124.2 +021100 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1124.2 +021200 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1124.2 +021300 02 TEST-ID PICTURE IS X(9). SQ1124.2 +021400 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1124.2 +021500 01 CCVS-H-3. SQ1124.2 +021600 02 FILLER PICTURE X(34) VALUE SQ1124.2 +021700 " FOR OFFICIAL USE ONLY ". SQ1124.2 +021800 02 FILLER PICTURE X(58) VALUE SQ1124.2 +021900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1124.2 +022000 02 FILLER PICTURE X(28) VALUE SQ1124.2 +022100 " COPYRIGHT 1985 ". SQ1124.2 +022200 01 CCVS-E-1. SQ1124.2 +022300 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1124.2 +022400 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1124.2 +022500 02 ID-AGAIN PICTURE IS X(9). SQ1124.2 +022600 02 FILLER PICTURE X(45) VALUE IS SQ1124.2 +022700 " NTIS DISTRIBUTION COBOL 85". SQ1124.2 +022800 01 CCVS-E-2. SQ1124.2 +022900 02 FILLER PICTURE X(31) VALUE SQ1124.2 +023000 SPACE. SQ1124.2 +023100 02 FILLER PICTURE X(21) VALUE SPACE. SQ1124.2 +023200 02 CCVS-E-2-2. SQ1124.2 +023300 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1124.2 +023400 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1124.2 +023500 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1124.2 +023600 01 CCVS-E-3. SQ1124.2 +023700 02 FILLER PICTURE X(22) VALUE SQ1124.2 +023800 " FOR OFFICIAL USE ONLY". SQ1124.2 +023900 02 FILLER PICTURE X(12) VALUE SPACE. SQ1124.2 +024000 02 FILLER PICTURE X(58) VALUE SQ1124.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1124.2 +024200 02 FILLER PICTURE X(13) VALUE SPACE. SQ1124.2 +024300 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1124.2 +024400 01 CCVS-E-4. SQ1124.2 +024500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1124.2 +024600 02 FILLER PIC XXXX VALUE " OF ". SQ1124.2 +024700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1124.2 +024800 02 FILLER PIC X(40) VALUE SQ1124.2 +024900 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1124.2 +025000 01 XXINFO. SQ1124.2 +025100 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1124.2 +025200 02 INFO-TEXT. SQ1124.2 +025300 04 FILLER PIC X(20) VALUE SPACE. SQ1124.2 +025400 04 XXCOMPUTED PIC X(20). SQ1124.2 +025500 04 FILLER PIC X(5) VALUE SPACE. SQ1124.2 +025600 04 XXCORRECT PIC X(20). SQ1124.2 +025700 01 HYPHEN-LINE. SQ1124.2 +025800 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1124.2 +025900 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1124.2 +026000- "*****************************************". SQ1124.2 +026100 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1124.2 +026200- "******************************". SQ1124.2 +026300 01 CCVS-PGM-ID PIC X(6) VALUE SQ1124.2 +026400 "SQ112A". SQ1124.2 +026500 PROCEDURE DIVISION. SQ1124.2 +026600 CCVS1 SECTION. SQ1124.2 +026700 OPEN-FILES. SQ1124.2 +026800*P OPEN I-O RAW-DATA. SQ1124.2 +026900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1124.2 +027000*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1124.2 +027100*P MOVE "ABORTED " TO C-ABORT. SQ1124.2 +027200*P ADD 1 TO C-NO-OF-TESTS. SQ1124.2 +027300*P ACCEPT C-DATE FROM DATE. SQ1124.2 +027400*P ACCEPT C-TIME FROM TIME. SQ1124.2 +027500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1124.2 +027600*PND-E-1. SQ1124.2 +027700*P CLOSE RAW-DATA. SQ1124.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1124.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1124.2 +028000 MOVE SPACE TO TEST-RESULTS. SQ1124.2 +028100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1124.2 +028200 MOVE ZERO TO REC-SKL-SUB. SQ1124.2 +028300 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1124.2 +028400 CCVS-INIT-FILE. SQ1124.2 +028500 ADD 1 TO REC-SKL-SUB. SQ1124.2 +028600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1124.2 +028700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1124.2 +028800 CCVS-INIT-EXIT. SQ1124.2 +028900 GO TO CCVS1-EXIT. SQ1124.2 +029000 CLOSE-FILES. SQ1124.2 +029100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1124.2 +029200*P OPEN I-O RAW-DATA. SQ1124.2 +029300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1124.2 +029400*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1124.2 +029500*P MOVE "OK. " TO C-ABORT. SQ1124.2 +029600*P MOVE PASS-COUNTER TO C-OK. SQ1124.2 +029700*P MOVE ERROR-HOLD TO C-ALL. SQ1124.2 +029800*P MOVE ERROR-COUNTER TO C-FAIL. SQ1124.2 +029900*P MOVE DELETE-CNT TO C-DELETED. SQ1124.2 +030000*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1124.2 +030100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1124.2 +030200*PND-E-2. SQ1124.2 +030300*P CLOSE RAW-DATA. SQ1124.2 +030400 TERMINATE-CCVS. SQ1124.2 +030500*S EXIT PROGRAM. SQ1124.2 +030600*SERMINATE-CALL. SQ1124.2 +030700 STOP RUN. SQ1124.2 +030800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1124.2 +030900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1124.2 +031000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1124.2 +031100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1124.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1124.2 +031300 PRINT-DETAIL. SQ1124.2 +031400 IF REC-CT NOT EQUAL TO ZERO SQ1124.2 +031500 MOVE "." TO PARDOT-X SQ1124.2 +031600 MOVE REC-CT TO DOTVALUE. SQ1124.2 +031700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1124.2 +031800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1124.2 +031900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1124.2 +032000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1124.2 +032100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1124.2 +032200 MOVE SPACE TO CORRECT-X. SQ1124.2 +032300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1124.2 +032400 MOVE SPACE TO RE-MARK. SQ1124.2 +032500 HEAD-ROUTINE. SQ1124.2 +032600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +032700 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1124.2 +032800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1124.2 +032900 COLUMN-NAMES-ROUTINE. SQ1124.2 +033000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +033100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +033300 END-ROUTINE. SQ1124.2 +033400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1124.2 +033500 END-RTN-EXIT. SQ1124.2 +033600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +033700 END-ROUTINE-1. SQ1124.2 +033800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1124.2 +033900 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1124.2 +034000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1124.2 +034100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1124.2 +034200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1124.2 +034300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1124.2 +034400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1124.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1124.2 +034600 END-ROUTINE-12. SQ1124.2 +034700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1124.2 +034800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1124.2 +034900 MOVE "NO " TO ERROR-TOTAL SQ1124.2 +035000 ELSE SQ1124.2 +035100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1124.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1124.2 +035300 PERFORM WRITE-LINE. SQ1124.2 +035400 END-ROUTINE-13. SQ1124.2 +035500 IF DELETE-CNT IS EQUAL TO ZERO SQ1124.2 +035600 MOVE "NO " TO ERROR-TOTAL ELSE SQ1124.2 +035700 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1124.2 +035800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1124.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +036000 IF INSPECT-COUNTER EQUAL TO ZERO SQ1124.2 +036100 MOVE "NO " TO ERROR-TOTAL SQ1124.2 +036200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1124.2 +036300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1124.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +036500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1124.2 +036600 WRITE-LINE. SQ1124.2 +036700 ADD 1 TO RECORD-COUNT. SQ1124.2 +036800 IF RECORD-COUNT GREATER 50 SQ1124.2 +036900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1124.2 +037000 MOVE SPACE TO DUMMY-RECORD SQ1124.2 +037100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1124.2 +037200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1124.2 +037300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1124.2 +037400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1124.2 +037500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1124.2 +037600 MOVE ZERO TO RECORD-COUNT. SQ1124.2 +037700 PERFORM WRT-LN. SQ1124.2 +037800 WRT-LN. SQ1124.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1124.2 +038000 MOVE SPACE TO DUMMY-RECORD. SQ1124.2 +038100 BLANK-LINE-PRINT. SQ1124.2 +038200 PERFORM WRT-LN. SQ1124.2 +038300 FAIL-ROUTINE. SQ1124.2 +038400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1124.2 +038500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1124.2 +038600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1124.2 +038700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +038800 GO TO FAIL-ROUTINE-EX. SQ1124.2 +038900 FAIL-ROUTINE-WRITE. SQ1124.2 +039000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1124.2 +039100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +039200 FAIL-ROUTINE-EX. EXIT. SQ1124.2 +039300 BAIL-OUT. SQ1124.2 +039400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1124.2 +039500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1124.2 +039600 BAIL-OUT-WRITE. SQ1124.2 +039700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1124.2 +039800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1124.2 +039900 BAIL-OUT-EX. EXIT. SQ1124.2 +040000 CCVS1-EXIT. SQ1124.2 +040100 EXIT. SQ1124.2 +040200 SECT-SQ112A-0001 SECTION. SQ1124.2 +040300 WRITE-INIT-GF-01. SQ1124.2 +040400 MOVE "SQ112X" TO XFILE-NAME (1). SQ1124.2 +040500 MOVE "OUTPUT" TO XRECORD-NAME (1). SQ1124.2 +040600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1124.2 +040700 MOVE 000120 TO XRECORD-LENGTH (1). SQ1124.2 +040800 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1124.2 +040900 MOVE 0001 TO XBLOCK-SIZE (1). SQ1124.2 +041000 MOVE 000150 TO RECORDS-IN-FILE (1). SQ1124.2 +041100 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1124.2 +041200 MOVE "S" TO XLABEL-TYPE (1). SQ1124.2 +041300 MOVE 000001 TO XRECORD-NUMBER (1). SQ1124.2 +041400 OPEN OUTPUT SQ-FS1. SQ1124.2 +041500 WRITE-TEST-GF-01. SQ1124.2 +041600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1124.2 +041700 WRITE SQ-FS1R1-F-G-120. SQ1124.2 +041800 IF XRECORD-NUMBER (1) EQUAL TO 150 SQ1124.2 +041900 GO TO WRITE-WRITE-GF-01. SQ1124.2 +042000 ADD 1 TO XRECORD-NUMBER (1). SQ1124.2 +042100 GO TO WRITE-TEST-GF-01. SQ1124.2 +042200 WRITE-WRITE-GF-01. SQ1124.2 +042300 MOVE "WRITE 150 RECORDS " TO FEATURE. SQ1124.2 +042400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ1124.2 +042500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1124.2 +042600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1124.2 +042700 PERFORM PRINT-DETAIL. SQ1124.2 +042800 CLOSE SQ-FS1. SQ1124.2 +042900* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1124.2 +043000* HAS BEEN CREATED. THE FILE CONTAINS 150 RECORDS. SQ1124.2 +043100 READ-INIT-GF-01. SQ1124.2 +043200 MOVE ZERO TO WRK-CS-09V00. SQ1124.2 +043300* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1124.2 +043400* READ-TEST-001. SQ1124.2 +043500 OPEN INPUT SQ-FS1. SQ1124.2 +043600 READ-TEST-GF-01. SQ1124.2 +043700 READ SQ-FS1 SQ1124.2 +043800 AT END GO TO READ-TEST-GF-01-1. SQ1124.2 +043900 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1124.2 +044000 ADD 1 TO WRK-CS-09V00. SQ1124.2 +044100 IF WRK-CS-09V00 GREATER THAN 150 SQ1124.2 +044200 MOVE "MORE THAN 150 RECORDS" TO RE-MARK SQ1124.2 +044300 GO TO READ-FAIL-GF-01. SQ1124.2 +044400 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1124.2 +044500 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +044600 GO TO READ-TEST-GF-01. SQ1124.2 +044700 IF XFILE-NAME (1) NOT EQUAL TO "SQ112X" SQ1124.2 +044800 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +044900 GO TO READ-TEST-GF-01. SQ1124.2 +045000 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1124.2 +045100 ADD 1 TO RECORDS-IN-ERROR. SQ1124.2 +045200 GO TO READ-TEST-GF-01. SQ1124.2 +045300 READ-TEST-GF-01-1. SQ1124.2 +045400 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1124.2 +045500 GO TO READ-PASS-GF-01. SQ1124.2 +045600 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1124.2 +045700 READ-FAIL-GF-01. SQ1124.2 +045800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1124.2 +045900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1124.2 +046000 PERFORM FAIL. SQ1124.2 +046100 GO TO READ-READ-GF-01. SQ1124.2 +046200 READ-PASS-GF-01. SQ1124.2 +046300 PERFORM PASS. SQ1124.2 +046400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1124.2 +046500 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1124.2 +046600 READ-READ-GF-01. SQ1124.2 +046700 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1124.2 +046800 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1124.2 +046900 PERFORM PRINT-DETAIL. SQ1124.2 +047000 READ-CLOSE-GF-01. SQ1124.2 +047100 CLOSE SQ-FS1. SQ1124.2 +047200 SECT-SQ112A-0002 SECTION. SQ1124.2 +047300 WRITE-INIT-GF-02. SQ1124.2 +047400 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1124.2 +047500 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1124.2 +047600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1124.2 +047700 MOVE 000120 TO XRECORD-LENGTH (1). SQ1124.2 +047800 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1124.2 +047900 MOVE 0001 TO XBLOCK-SIZE (1). SQ1124.2 +048000 MOVE 000150 TO RECORDS-IN-FILE (1). SQ1124.2 +048100 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1124.2 +048200 MOVE "S" TO XLABEL-TYPE (1). SQ1124.2 +048300 MOVE 000001 TO XRECORD-NUMBER (1). SQ1124.2 +048400 OPEN OUTPUT SQ-FS1. SQ1124.2 +048500 WRITE-TEST-GF-02. SQ1124.2 +048600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1124.2 +048700 WRITE SQ-FS1R1-F-G-120. SQ1124.2 +048800 IF XRECORD-NUMBER (1) EQUAL TO 150 SQ1124.2 +048900 GO TO WRITE-WRITE-GF-02. SQ1124.2 +049000 ADD 1 TO XRECORD-NUMBER (1). SQ1124.2 +049100 GO TO WRITE-TEST-GF-02. SQ1124.2 +049200 WRITE-WRITE-GF-02. SQ1124.2 +049300 MOVE "WRITE 150 RECS 2ND" TO FEATURE. SQ1124.2 +049400 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ1124.2 +049500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1124.2 +049600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1124.2 +049700 PERFORM PRINT-DETAIL. SQ1124.2 +049800 CLOSE SQ-FS1. SQ1124.2 +049900* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1124.2 +050000* HAS BEEN CREATED. THE FILE CONTAINS 150 RECORDS. SQ1124.2 +050100 READ-INIT-GF-02. SQ1124.2 +050200 MOVE ZERO TO WRK-CS-09V00. SQ1124.2 +050300* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1124.2 +050400* READ-TEST-001. SQ1124.2 +050500 OPEN INPUT SQ-FS1. SQ1124.2 +050600 READ-TEST-GF-02. SQ1124.2 +050700 READ SQ-FS1 SQ1124.2 +050800 AT END GO TO READ-TEST-GF-02-1. SQ1124.2 +050900 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1124.2 +051000 ADD 1 TO WRK-CS-09V00. SQ1124.2 +051100* IF WRK-CS-09V00 GREATER THAN 150 SQ1124.2 +051200* MOVE "MORE THAN 150 RECORDS" TO RE-MARK SQ1124.2 +051300* GO TO READ-FAIL-GF-02. SQ1124.2 +051400 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1124.2 +051500 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +051600 GO TO READ-TEST-GF-02. SQ1124.2 +051700 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1124.2 +051800 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +051900 GO TO READ-TEST-GF-02. SQ1124.2 +052000 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1124.2 +052100 ADD 1 TO RECORDS-IN-ERROR. SQ1124.2 +052200 GO TO READ-TEST-GF-02. SQ1124.2 +052300 READ-TEST-GF-02-1. SQ1124.2 +052400 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1124.2 +052500 GO TO READ-PASS-GF-02. SQ1124.2 +052600 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1124.2 +052700 READ-FAIL-GF-02. SQ1124.2 +052800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1124.2 +052900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1124.2 +053000 MOVE "VII-43;4.3.4 (21) " TO RE-MARK.SQ1124.2 +053100 PERFORM FAIL. SQ1124.2 +053200 GO TO READ-WRITE-GF-02. SQ1124.2 +053300 READ-PASS-GF-02. SQ1124.2 +053400 PERFORM PASS. SQ1124.2 +053500 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1124.2 +053600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1124.2 +053700 READ-WRITE-GF-02. SQ1124.2 +053800 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1124.2 +053900 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1124.2 +054000 PERFORM PRINT-DETAIL. SQ1124.2 +054100 READ-CLOSE-GF-02. SQ1124.2 +054200 CLOSE SQ-FS1. SQ1124.2 +054300 SECT-SQ112A-0003 SECTION. SQ1124.2 +054400 READ-INIT-GF-03. SQ1124.2 +054500 MOVE ZERO TO WRK-CS-09V00. SQ1124.2 +054600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1124.2 +054700 OPEN INPUT SQ-FS1. SQ1124.2 +054800* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1124.2 +054900* IN THIS SERIES OF TESTS. SQ1124.2 +055000 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1124.2 +055100 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1124.2 +055200 MOVE ZERO TO ERROR-FLAG. SQ1124.2 +055300 READ-TEST-GF-03. SQ1124.2 +055400 READ SQ-FS1 RECORD AT END SQ1124.2 +055500 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1124.2 +055600 MOVE 1 TO EOF-FLAG SQ1124.2 +055700 GO TO READ-FAIL-GF-03. SQ1124.2 +055800 PERFORM RECORD-CHECK. SQ1124.2 +055900 IF WRK-CS-09V00 EQUAL TO 40 SQ1124.2 +056000 GO TO READ-TEST-GF-03-1. SQ1124.2 +056100 GO TO READ-TEST-GF-03. SQ1124.2 +056200 RECORD-CHECK. SQ1124.2 +056300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1124.2 +056400 ADD 1 TO WRK-CS-09V00. SQ1124.2 +056500 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1124.2 +056600 ADD 1 TO RECORDS-IN-ERROR SQ1124.2 +056700 MOVE 1 TO ERROR-FLAG. SQ1124.2 +056800 READ-TEST-GF-03-1. SQ1124.2 +056900 IF ERROR-FLAG EQUAL TO ZERO SQ1124.2 +057000 GO TO READ-PASS-GF-03. SQ1124.2 +057100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1124.2 +057200 READ-FAIL-GF-03. SQ1124.2 +057300 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1124.2 +057400 PERFORM FAIL. SQ1124.2 +057500 GO TO READ-WRITE-GF-03. SQ1124.2 +057600 READ-PASS-GF-03. SQ1124.2 +057700 PERFORM PASS. SQ1124.2 +057800 READ-WRITE-GF-03. SQ1124.2 +057900 PERFORM PRINT-DETAIL. SQ1124.2 +058000 READ-INIT-GF-04. SQ1124.2 +058100 IF EOF-FLAG EQUAL TO 1 SQ1124.2 +058200 GO TO SEQ-EOF-005. SQ1124.2 +058300 MOVE ZERO TO ERROR-FLAG. SQ1124.2 +058400 MOVE "READ...AT END..." TO FEATURE. SQ1124.2 +058500 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1124.2 +058600 READ-TEST-GF-04. SQ1124.2 +058700 READ SQ-FS1 AT END SQ1124.2 +058800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1124.2 +058900 MOVE 1 TO EOF-FLAG SQ1124.2 +059000 GO TO READ-FAIL-GF-04. SQ1124.2 +059100 PERFORM RECORD-CHECK. SQ1124.2 +059200 IF WRK-CS-09V00 EQUAL TO 80 SQ1124.2 +059300 GO TO READ-TEST-GF-04-1. SQ1124.2 +059400 GO TO READ-TEST-GF-04. SQ1124.2 +059500 READ-TEST-GF-04-1. SQ1124.2 +059600 IF ERROR-FLAG EQUAL TO ZERO SQ1124.2 +059700 GO TO READ-PASS-GF-04. SQ1124.2 +059800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1124.2 +059900 READ-FAIL-GF-04. SQ1124.2 +060000 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1124.2 +060100 PERFORM FAIL. SQ1124.2 +060200 GO TO READ-WRITE-GF-04. SQ1124.2 +060300 READ-PASS-GF-04. SQ1124.2 +060400 PERFORM PASS. SQ1124.2 +060500 READ-WRITE-GF-04. SQ1124.2 +060600 PERFORM PRINT-DETAIL. SQ1124.2 +060700 READ-INIT-GF-05. SQ1124.2 +060800 IF EOF-FLAG EQUAL TO 1 SQ1124.2 +060900 GO TO SEQ-EOF-005. SQ1124.2 +061000 MOVE ZERO TO ERROR-FLAG. SQ1124.2 +061100 MOVE "READ...RECORD END..." TO FEATURE. SQ1124.2 +061200 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1124.2 +061300 READ-TEST-GF-05. SQ1124.2 +061400 READ SQ-FS1 RECORD END SQ1124.2 +061500 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1124.2 +061600 MOVE 1 TO EOF-FLAG SQ1124.2 +061700 GO TO READ-FAIL-GF-05. SQ1124.2 +061800 PERFORM RECORD-CHECK. SQ1124.2 +061900 IF WRK-CS-09V00 EQUAL TO 120 SQ1124.2 +062000 GO TO READ-TEST-GF-05-1. SQ1124.2 +062100 GO TO READ-TEST-GF-05. SQ1124.2 +062200 READ-TEST-GF-05-1. SQ1124.2 +062300 IF ERROR-FLAG EQUAL TO ZERO SQ1124.2 +062400 GO TO READ-PASS-GF-05. SQ1124.2 +062500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1124.2 +062600 READ-FAIL-GF-05. SQ1124.2 +062700 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1124.2 +062800 PERFORM FAIL. SQ1124.2 +062900 GO TO READ-WRITE-GF-05. SQ1124.2 +063000 READ-PASS-GF-05. SQ1124.2 +063100 PERFORM PASS. SQ1124.2 +063200 READ-WRITE-GF-05. SQ1124.2 +063300 PERFORM PRINT-DETAIL. SQ1124.2 +063400 READ-INIT-GF-06. SQ1124.2 +063500 IF EOF-FLAG EQUAL TO 1 SQ1124.2 +063600 GO TO SEQ-EOF-005. SQ1124.2 +063700 MOVE ZERO TO ERROR-FLAG. SQ1124.2 +063800 MOVE "READ...END..." TO FEATURE. SQ1124.2 +063900 MOVE "READ-TEST-GF-06" TO PAR-NAME. SQ1124.2 +064000 READ-TEST-GF-06. SQ1124.2 +064100 READ SQ-FS1 END GO TO READ-TEST-GF-06-1. SQ1124.2 +064200 PERFORM RECORD-CHECK. SQ1124.2 +064300 IF WRK-CS-09V00 GREATER THAN 150 SQ1124.2 +064400 GO TO READ-TEST-GF-06-1. SQ1124.2 +064500 GO TO READ-TEST-GF-06. SQ1124.2 +064600 READ-TEST-GF-06-1. SQ1124.2 +064700 IF ERROR-FLAG EQUAL TO ZERO SQ1124.2 +064800 GO TO READ-PASS-GF-06. SQ1124.2 +064900 READ-FAIL-GF-06. SQ1124.2 +065000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1124.2 +065100 MOVE "VII-44; 4.4.2 " TO RE-MARK.SQ1124.2 +065200 PERFORM FAIL. SQ1124.2 +065300 GO TO READ-WRITE-GF-06. SQ1124.2 +065400 READ-PASS-GF-06. SQ1124.2 +065500 PERFORM PASS. SQ1124.2 +065600 READ-WRITE-GF-06. SQ1124.2 +065700 PERFORM PRINT-DETAIL. SQ1124.2 +065800 SEQ-TEST-005. SQ1124.2 +065900 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1124.2 +066000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1124.2 +066100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1124.2 +066200 GO TO SEQ-FAIL-005. SQ1124.2 +066300 IF WRK-CS-09V00 GREATER THAN 150 SQ1124.2 +066400 MOVE "MORE THAN 150 RECORDS" TO RE-MARK SQ1124.2 +066500 GO TO SEQ-FAIL-005. SQ1124.2 +066600 SEQ-PASS-005. SQ1124.2 +066700 PERFORM PASS. SQ1124.2 +066800 GO TO SEQ-WRITE-005. SQ1124.2 +066900 SEQ-EOF-005. SQ1124.2 +067000 MOVE "LESS THAN 150 RECORDS" TO RE-MARK. SQ1124.2 +067100 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1124.2 +067200 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1124.2 +067300 SEQ-FAIL-005. SQ1124.2 +067400 MOVE "VII-43;4.3.4 (21) " TO RE-MARK.SQ1124.2 +067500 PERFORM FAIL. SQ1124.2 +067600 SEQ-WRITE-005. SQ1124.2 +067700 MOVE "SEQ-TEST-005" TO PAR-NAME. SQ1124.2 +067800 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ1124.2 +067900 PERFORM PRINT-DETAIL. SQ1124.2 +068000 SEQ-CLOSE-005. SQ1124.2 +068100 CLOSE SQ-FS1. SQ1124.2 +068200 TERMINATE-ROUTINE. SQ1124.2 +068300 EXIT. SQ1124.2 +068400 CCVS-EXIT SECTION. SQ1124.2 +068500 CCVS-999999. SQ1124.2 +068600 GO TO CLOSE-FILES. SQ1124.2 diff --git a/tests/cobol85/SQ/SQ113A.CBL b/tests/cobol85/SQ/SQ113A.CBL new file mode 100755 index 00000000..927f989b --- /dev/null +++ b/tests/cobol85/SQ/SQ113A.CBL @@ -0,0 +1,1022 @@ +000100 IDENTIFICATION DIVISION. SQ1134.2 +000200 PROGRAM-ID. SQ1134.2 +000300 SQ113A. SQ1134.2 +000400**************************************************************** SQ1134.2 +000500* * SQ1134.2 +000600* VALIDATION FOR:- * SQ1134.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1134.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1134.2 +000900* REVISED 1986, AUGUST * SQ1134.2 +001000* * SQ1134.2 +001100* CREATION DATE / VALIDATION DATE * SQ1134.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1134.2 +001300* * SQ1134.2 +001400**************************************************************** SQ1134.2 +001500* * SQ1134.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1134.2 +001700* * SQ1134.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE * SQ1134.2 +001900* X-55 SYSTEM PRINTER * SQ1134.2 +002000* X-82 SOURCE-COMPUTER * SQ1134.2 +002100* X-83 OBJECT-COMPUTER. * SQ1134.2 +002200* * SQ1134.2 +002300**************************************************************** SQ1134.2 +002400* * SQ1134.2 +002500* SQ113A CREATES A MAGNETIC TAPE FILE CONTAINING 750 FIXED * SQ1134.2 +002600* LENGTH RECORDS, EACH 120 CHARACTERS LONG. THE FILE IS * SQ1134.2 +002700* READ TWICE. THE FIRST PASS CHECKS THAT ALL THE EXPECTED * SQ1134.2 +002800* RECORDS ARE PRESENT. THE SECOND PASS PERFORMS SIMILAR * SQ1134.2 +002900* CHECKS, BUT USES ALL FOUR VARIANTS OF THE READ STATEMENT * SQ1134.2 +003000* WITH THE END PHRASE THAT CAN BE PRODUCED BY INCLUDING OR * SQ1134.2 +003100* OMITTING THE OPTIONAL WORDS "RECORD" AND "AT". * SQ1134.2 +003200* * SQ1134.2 +003300* THE PROGRAM IS ALMOST IDENTICAL TO SQ102A, AND IS DERIVED * SQ1134.2 +003400* FROM THAT PROGRAM BY INCLUDING A FILE STATUS CLAUSE IN * SQ1134.2 +003500* THE FILE-CONTROL ENTRY FOR THE TEST FILE, AND INCLUDING * SQ1134.2 +003600* TESTS ON THE I-O STATUS RETURNED AFTER EACH OPERATION ON * SQ1134.2 +003700* THE FILE * SQ1134.2 +003800* * SQ1134.2 +003900* THE PROGRAM OMITS THE OPTIONAL WORDS "ORGANIZATION IS" * SQ1134.2 +004000* FROM THE "ORGANIZATION IS SEQUENTIAL" CLAUSE OF THE * SQ1134.2 +004100* FILE-CONTROL ENTRY, AND PLACES THE ASSIGN CLAUSE IN A * SQ1134.2 +004200* POSITION OTHER THAN FIRST IN THE SAME ENTRY. * SQ1134.2 +004300* * SQ1134.2 +004400**************************************************************** SQ1134.2 +004500* SQ1134.2 +004600* SQ1134.2 +004700 ENVIRONMENT DIVISION. SQ1134.2 +004800 CONFIGURATION SECTION. SQ1134.2 +004900 SOURCE-COMPUTER. SQ1134.2 +005000 Linux. SQ1134.2 +005100 OBJECT-COMPUTER. SQ1134.2 +005200 Linux. SQ1134.2 +005300* SQ1134.2 +005400 INPUT-OUTPUT SECTION. SQ1134.2 +005500 FILE-CONTROL. SQ1134.2 +005600 SELECT PRINT-FILE ASSIGN TO SQ1134.2 +005700 "report.log". SQ1134.2 +005800* SQ1134.2 +005900*P SELECT RAW-DATA ASSIGN TO SQ1134.2 +006000*P "XXXXX062" SQ1134.2 +006100*P ORGANIZATION IS INDEXED SQ1134.2 +006200*P ACCESS MODE IS RANDOM SQ1134.2 +006300*P RECORD-KEY IS RAW-DATA-KEY. SQ1134.2 +006400*P SQ1134.2 +006500 SELECT SQ-FS1 SQ1134.2 +006600 ACCESS MODE IS SEQUENTIAL SQ1134.2 +006700 SEQUENTIAL SQ1134.2 +006800 ASSIGN TO SQ1134.2 +006900 "XXXXX001" SQ1134.2 +007000 FILE STATUS IS SQ-FS1-STATUS. SQ1134.2 +007100* SQ1134.2 +007200* SQ1134.2 +007300 DATA DIVISION. SQ1134.2 +007400 FILE SECTION. SQ1134.2 +007500 FD PRINT-FILE SQ1134.2 +007600*C LABEL RECORDS SQ1134.2 +007700*C OMITTED SQ1134.2 +007800*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1134.2 +007900 . SQ1134.2 +008000 01 PRINT-REC PICTURE X(120). SQ1134.2 +008100 01 DUMMY-RECORD PICTURE X(120). SQ1134.2 +008200*P SQ1134.2 +008300*PD RAW-DATA. SQ1134.2 +008400*P1 RAW-DATA-SATZ. SQ1134.2 +008500*P 05 RAW-DATA-KEY PIC X(6). SQ1134.2 +008600*P 05 C-DATE PIC 9(6). SQ1134.2 +008700*P 05 C-TIME PIC 9(8). SQ1134.2 +008800*P 05 NO-OF-TESTS PIC 99. SQ1134.2 +008900*P 05 C-OK PIC 999. SQ1134.2 +009000*P 05 C-ALL PIC 999. SQ1134.2 +009100*P 05 C-FAIL PIC 999. SQ1134.2 +009200*P 05 C-DELETED PIC 999. SQ1134.2 +009300*P 05 C-INSPECT PIC 999. SQ1134.2 +009400*P 05 C-NOTE PIC X(13). SQ1134.2 +009500*P 05 C-INDENT PIC X. SQ1134.2 +009600*P 05 C-ABORT PIC X(8). SQ1134.2 +009700* SQ1134.2 +009800 FD SQ-FS1 SQ1134.2 +009900*C LABEL RECORD IS STANDARD SQ1134.2 +010000 . SQ1134.2 +010100 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1134.2 +010200* SQ1134.2 +010300 WORKING-STORAGE SECTION. SQ1134.2 +010400* SQ1134.2 +010500*************************************************************** SQ1134.2 +010600* * SQ1134.2 +010700* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1134.2 +010800* * SQ1134.2 +010900*************************************************************** SQ1134.2 +011000* SQ1134.2 +011100 01 SQ-FS1-STATUS. SQ1134.2 +011200 03 SQ-FS1-KEY-1 PIC X. SQ1134.2 +011300 03 SQ-FS1-KEY-2 PIC X. SQ1134.2 +011400* SQ1134.2 +011500 01 SQ-FS1-STATUS-COPY PIC XX. SQ1134.2 +011600* SQ1134.2 +011700 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ1134.2 +011800 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1134.2 +011900 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1134.2 +012000 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1134.2 +012100* SQ1134.2 +012200*************************************************************** SQ1134.2 +012300* * SQ1134.2 +012400* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1134.2 +012500* * SQ1134.2 +012600*************************************************************** SQ1134.2 +012700* SQ1134.2 +012800 01 REC-SKEL-SUB PIC 99. SQ1134.2 +012900* SQ1134.2 +013000 01 FILE-RECORD-INFORMATION-REC. SQ1134.2 +013100 03 FILE-RECORD-INFO-SKELETON. SQ1134.2 +013200 05 FILLER PICTURE X(48) VALUE SQ1134.2 +013300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1134.2 +013400 05 FILLER PICTURE X(46) VALUE SQ1134.2 +013500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1134.2 +013600 05 FILLER PICTURE X(26) VALUE SQ1134.2 +013700 ",LFIL=000000,ORG= ,LBLR= ". SQ1134.2 +013800 05 FILLER PICTURE X(37) VALUE SQ1134.2 +013900 ",RECKEY= ". SQ1134.2 +014000 05 FILLER PICTURE X(38) VALUE SQ1134.2 +014100 ",ALTKEY1= ". SQ1134.2 +014200 05 FILLER PICTURE X(38) VALUE SQ1134.2 +014300 ",ALTKEY2= ". SQ1134.2 +014400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1134.2 +014500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1134.2 +014600 05 FILE-RECORD-INFO-P1-120. SQ1134.2 +014700 07 FILLER PIC X(5). SQ1134.2 +014800 07 XFILE-NAME PIC X(6). SQ1134.2 +014900 07 FILLER PIC X(8). SQ1134.2 +015000 07 XRECORD-NAME PIC X(6). SQ1134.2 +015100 07 FILLER PIC X(1). SQ1134.2 +015200 07 REELUNIT-NUMBER PIC 9(1). SQ1134.2 +015300 07 FILLER PIC X(7). SQ1134.2 +015400 07 XRECORD-NUMBER PIC 9(6). SQ1134.2 +015500 07 FILLER PIC X(6). SQ1134.2 +015600 07 UPDATE-NUMBER PIC 9(2). SQ1134.2 +015700 07 FILLER PIC X(5). SQ1134.2 +015800 07 ODO-NUMBER PIC 9(4). SQ1134.2 +015900 07 FILLER PIC X(5). SQ1134.2 +016000 07 XPROGRAM-NAME PIC X(5). SQ1134.2 +016100 07 FILLER PIC X(7). SQ1134.2 +016200 07 XRECORD-LENGTH PIC 9(6). SQ1134.2 +016300 07 FILLER PIC X(7). SQ1134.2 +016400 07 CHARS-OR-RECORDS PIC X(2). SQ1134.2 +016500 07 FILLER PIC X(1). SQ1134.2 +016600 07 XBLOCK-SIZE PIC 9(4). SQ1134.2 +016700 07 FILLER PIC X(6). SQ1134.2 +016800 07 RECORDS-IN-FILE PIC 9(6). SQ1134.2 +016900 07 FILLER PIC X(5). SQ1134.2 +017000 07 XFILE-ORGANIZATION PIC X(2). SQ1134.2 +017100 07 FILLER PIC X(6). SQ1134.2 +017200 07 XLABEL-TYPE PIC X(1). SQ1134.2 +017300 05 FILE-RECORD-INFO-P121-240. SQ1134.2 +017400 07 FILLER PIC X(8). SQ1134.2 +017500 07 XRECORD-KEY PIC X(29). SQ1134.2 +017600 07 FILLER PIC X(9). SQ1134.2 +017700 07 ALTERNATE-KEY1 PIC X(29). SQ1134.2 +017800 07 FILLER PIC X(9). SQ1134.2 +017900 07 ALTERNATE-KEY2 PIC X(29). SQ1134.2 +018000 07 FILLER PIC X(7). SQ1134.2 +018100* SQ1134.2 +018200 01 TEST-RESULTS. SQ1134.2 +018300 02 FILLER PIC X VALUE SPACE. SQ1134.2 +018400 02 PAR-NAME. SQ1134.2 +018500 03 FILLER PIC X(14) VALUE SPACE. SQ1134.2 +018600 03 PARDOT-X PIC X VALUE SPACE. SQ1134.2 +018700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1134.2 +018800 02 FILLER PIC X VALUE SPACE. SQ1134.2 +018900 02 FEATURE PIC X(24) VALUE SPACE. SQ1134.2 +019000 02 FILLER PIC X VALUE SPACE. SQ1134.2 +019100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1134.2 +019200 02 FILLER PIC X(9) VALUE SPACE. SQ1134.2 +019300 02 RE-MARK PIC X(61). SQ1134.2 +019400 01 TEST-COMPUTED. SQ1134.2 +019500 02 FILLER PIC X(30) VALUE SPACE. SQ1134.2 +019600 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1134.2 +019700 02 COMPUTED-X. SQ1134.2 +019800 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1134.2 +019900 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1134.2 +020000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1134.2 +020100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1134.2 +020200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1134.2 +020300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1134.2 +020400 04 COMPUTED-18V0 PIC -9(18). SQ1134.2 +020500 04 FILLER PIC X. SQ1134.2 +020600 03 FILLER PIC X(50) VALUE SPACE. SQ1134.2 +020700 01 TEST-CORRECT. SQ1134.2 +020800 02 FILLER PIC X(30) VALUE SPACE. SQ1134.2 +020900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1134.2 +021000 02 CORRECT-X. SQ1134.2 +021100 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1134.2 +021200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1134.2 +021300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1134.2 +021400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1134.2 +021500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1134.2 +021600 03 CR-18V0 REDEFINES CORRECT-A. SQ1134.2 +021700 04 CORRECT-18V0 PIC -9(18). SQ1134.2 +021800 04 FILLER PIC X. SQ1134.2 +021900 03 FILLER PIC X(2) VALUE SPACE. SQ1134.2 +022000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1134.2 +022100* SQ1134.2 +022200 01 CCVS-C-1. SQ1134.2 +022300 02 FILLER PIC IS X VALUE SPACE. SQ1134.2 +022400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1134.2 +022500 02 FILLER PIC IS X VALUE SPACE. SQ1134.2 +022600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1134.2 +022700 02 FILLER PIC IS X VALUE SPACE. SQ1134.2 +022800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1134.2 +022900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1134.2 +023000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1134.2 +023100 01 CCVS-C-2. SQ1134.2 +023200 02 FILLER PIC X(19) VALUE SPACE. SQ1134.2 +023300 02 FILLER PIC X(6) VALUE "TESTED". SQ1134.2 +023400 02 FILLER PIC X(19) VALUE SPACE. SQ1134.2 +023500 02 FILLER PIC X(4) VALUE "FAIL". SQ1134.2 +023600 02 FILLER PIC X(72) VALUE SPACE. SQ1134.2 +023700* SQ1134.2 +023800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1134.2 +023900 01 REC-CT PIC 99 VALUE ZERO. SQ1134.2 +024000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1134.2 +024100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1134.2 +024200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1134.2 +024300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1134.2 +024400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1134.2 +024500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1134.2 +024600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1134.2 +024700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1134.2 +024800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1134.2 +024900 01 CCVS-H-1. SQ1134.2 +025000 02 FILLER PIC X(39) VALUE SPACES. SQ1134.2 +025100 02 FILLER PIC X(42) VALUE SQ1134.2 +025200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1134.2 +025300 02 FILLER PIC X(39) VALUE SPACES. SQ1134.2 +025400 01 CCVS-H-2A. SQ1134.2 +025500 02 FILLER PIC X(40) VALUE SPACE. SQ1134.2 +025600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1134.2 +025700 02 FILLER PIC XXXX VALUE SQ1134.2 +025800 "4.2 ". SQ1134.2 +025900 02 FILLER PIC X(28) VALUE SQ1134.2 +026000 " COPY - NOT FOR DISTRIBUTION". SQ1134.2 +026100 02 FILLER PIC X(41) VALUE SPACE. SQ1134.2 +026200* SQ1134.2 +026300 01 CCVS-H-2B. SQ1134.2 +026400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1134.2 +026500 02 TEST-ID PIC X(9). SQ1134.2 +026600 02 FILLER PIC X(4) VALUE " IN ". SQ1134.2 +026700 02 FILLER PIC X(12) VALUE SQ1134.2 +026800 " HIGH ". SQ1134.2 +026900 02 FILLER PIC X(22) VALUE SQ1134.2 +027000 " LEVEL VALIDATION FOR ". SQ1134.2 +027100 02 FILLER PIC X(58) VALUE SQ1134.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1134.2 +027300 01 CCVS-H-3. SQ1134.2 +027400 02 FILLER PIC X(34) VALUE SQ1134.2 +027500 " FOR OFFICIAL USE ONLY ". SQ1134.2 +027600 02 FILLER PIC X(58) VALUE SQ1134.2 +027700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1134.2 +027800 02 FILLER PIC X(28) VALUE SQ1134.2 +027900 " COPYRIGHT 1985,1986 ". SQ1134.2 +028000 01 CCVS-E-1. SQ1134.2 +028100 02 FILLER PIC X(52) VALUE SPACE. SQ1134.2 +028200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1134.2 +028300 02 ID-AGAIN PIC X(9). SQ1134.2 +028400 02 FILLER PIC X(45) VALUE SPACES. SQ1134.2 +028500 01 CCVS-E-2. SQ1134.2 +028600 02 FILLER PIC X(31) VALUE SPACE. SQ1134.2 +028700 02 FILLER PIC X(21) VALUE SPACE. SQ1134.2 +028800 02 CCVS-E-2-2. SQ1134.2 +028900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1134.2 +029000 03 FILLER PIC X VALUE SPACE. SQ1134.2 +029100 03 ENDER-DESC PIC X(44) VALUE SQ1134.2 +029200 "ERRORS ENCOUNTERED". SQ1134.2 +029300 01 CCVS-E-3. SQ1134.2 +029400 02 FILLER PIC X(22) VALUE SQ1134.2 +029500 " FOR OFFICIAL USE ONLY". SQ1134.2 +029600 02 FILLER PIC X(12) VALUE SPACE. SQ1134.2 +029700 02 FILLER PIC X(58) VALUE SQ1134.2 +029800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1134.2 +029900 02 FILLER PIC X(8) VALUE SPACE. SQ1134.2 +030000 02 FILLER PIC X(20) VALUE SQ1134.2 +030100 " COPYRIGHT 1985,1986". SQ1134.2 +030200 01 CCVS-E-4. SQ1134.2 +030300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1134.2 +030400 02 FILLER PIC X(4) VALUE " OF ". SQ1134.2 +030500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1134.2 +030600 02 FILLER PIC X(40) VALUE SQ1134.2 +030700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1134.2 +030800 01 XXINFO. SQ1134.2 +030900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1134.2 +031000 02 INFO-TEXT. SQ1134.2 +031100 04 FILLER PIC X(8) VALUE SPACE. SQ1134.2 +031200 04 XXCOMPUTED PIC X(20). SQ1134.2 +031300 04 FILLER PIC X(5) VALUE SPACE. SQ1134.2 +031400 04 XXCORRECT PIC X(20). SQ1134.2 +031500 02 INF-ANSI-REFERENCE PIC X(48). SQ1134.2 +031600 01 HYPHEN-LINE. SQ1134.2 +031700 02 FILLER PIC IS X VALUE IS SPACE. SQ1134.2 +031800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1134.2 +031900- "*****************************************". SQ1134.2 +032000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1134.2 +032100- "******************************". SQ1134.2 +032200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1134.2 +032300 "SQ113A". SQ1134.2 +032400* SQ1134.2 +032500* SQ1134.2 +032600 PROCEDURE DIVISION. SQ1134.2 +032700* SQ1134.2 +032800 CCVS1 SECTION. SQ1134.2 +032900 OPEN-FILES. SQ1134.2 +033000*P OPEN I-O RAW-DATA. SQ1134.2 +033100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1134.2 +033200*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1134.2 +033300*P MOVE "ABORTED " TO C-ABORT. SQ1134.2 +033400*P ADD 1 TO C-NO-OF-TESTS. SQ1134.2 +033500*P ACCEPT C-DATE FROM DATE. SQ1134.2 +033600*P ACCEPT C-TIME FROM TIME. SQ1134.2 +033700*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1134.2 +033800*PND-E-1. SQ1134.2 +033900*P CLOSE RAW-DATA. SQ1134.2 +034000 OPEN OUTPUT PRINT-FILE. SQ1134.2 +034100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1134.2 +034200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1134.2 +034300 MOVE SPACE TO TEST-RESULTS. SQ1134.2 +034400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1134.2 +034500 MOVE ZERO TO REC-SKEL-SUB. SQ1134.2 +034600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1134.2 +034700 GO TO CCVS1-EXIT. SQ1134.2 +034800* SQ1134.2 +034900 CCVS-INIT-FILE. SQ1134.2 +035000 ADD 1 TO REC-SKL-SUB. SQ1134.2 +035100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1134.2 +035200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1134.2 +035300* SQ1134.2 +035400 CLOSE-FILES. SQ1134.2 +035500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1134.2 +035600 CLOSE PRINT-FILE. SQ1134.2 +035700*P OPEN I-O RAW-DATA. SQ1134.2 +035800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1134.2 +035900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1134.2 +036000*P MOVE "OK. " TO C-ABORT. SQ1134.2 +036100*P MOVE PASS-COUNTER TO C-OK. SQ1134.2 +036200*P MOVE ERROR-HOLD TO C-ALL. SQ1134.2 +036300*P MOVE ERROR-COUNTER TO C-FAIL. SQ1134.2 +036400*P MOVE DELETE-CNT TO C-DELETED. SQ1134.2 +036500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1134.2 +036600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1134.2 +036700*PND-E-2. SQ1134.2 +036800*P CLOSE RAW-DATA. SQ1134.2 +036900 TERMINATE-CCVS. SQ1134.2 +037000*S EXIT PROGRAM. SQ1134.2 +037100 STOP RUN. SQ1134.2 +037200* SQ1134.2 +037300 INSPT. SQ1134.2 +037400 MOVE "INSPT" TO P-OR-F. SQ1134.2 +037500 ADD 1 TO INSPECT-COUNTER. SQ1134.2 +037600 PERFORM PRINT-DETAIL. SQ1134.2 +037700* SQ1134.2 +037800 PASS. SQ1134.2 +037900 MOVE "PASS " TO P-OR-F. SQ1134.2 +038000 ADD 1 TO PASS-COUNTER. SQ1134.2 +038100 PERFORM PRINT-DETAIL. SQ1134.2 +038200* SQ1134.2 +038300 FAIL. SQ1134.2 +038400 MOVE "FAIL*" TO P-OR-F. SQ1134.2 +038500 ADD 1 TO ERROR-COUNTER. SQ1134.2 +038600 PERFORM PRINT-DETAIL. SQ1134.2 +038700* SQ1134.2 +038800 DE-LETE. SQ1134.2 +038900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1134.2 +039000 MOVE "*****" TO P-OR-F. SQ1134.2 +039100 ADD 1 TO DELETE-COUNTER. SQ1134.2 +039200 PERFORM PRINT-DETAIL. SQ1134.2 +039300* SQ1134.2 +039400 PRINT-DETAIL. SQ1134.2 +039500 IF REC-CT NOT EQUAL TO ZERO SQ1134.2 +039600 MOVE "." TO PARDOT-X SQ1134.2 +039700 MOVE REC-CT TO DOTVALUE. SQ1134.2 +039800 MOVE TEST-RESULTS TO PRINT-REC. SQ1134.2 +039900 PERFORM WRITE-LINE. SQ1134.2 +040000 IF P-OR-F EQUAL TO "FAIL*" SQ1134.2 +040100 PERFORM WRITE-LINE SQ1134.2 +040200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1134.2 +040300 ELSE SQ1134.2 +040400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1134.2 +040500 MOVE SPACE TO P-OR-F. SQ1134.2 +040600 MOVE SPACE TO COMPUTED-X. SQ1134.2 +040700 MOVE SPACE TO CORRECT-X. SQ1134.2 +040800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1134.2 +040900 MOVE SPACE TO RE-MARK. SQ1134.2 +041000* SQ1134.2 +041100 HEAD-ROUTINE. SQ1134.2 +041200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +041300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +041400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1134.2 +041500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1134.2 +041600 COLUMN-NAMES-ROUTINE. SQ1134.2 +041700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1134.2 +041800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +041900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1134.2 +042000 END-ROUTINE. SQ1134.2 +042100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1134.2 +042200 PERFORM WRITE-LINE 5 TIMES. SQ1134.2 +042300 END-RTN-EXIT. SQ1134.2 +042400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1134.2 +042500 PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +042600* SQ1134.2 +042700 END-ROUTINE-1. SQ1134.2 +042800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1134.2 +042900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1134.2 +043000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1134.2 +043100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1134.2 +043200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1134.2 +043300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1134.2 +043400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1134.2 +043500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1134.2 +043600 PERFORM WRITE-LINE. SQ1134.2 +043700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1134.2 +043800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1134.2 +043900 MOVE "NO " TO ERROR-TOTAL SQ1134.2 +044000 ELSE SQ1134.2 +044100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1134.2 +044200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1134.2 +044300 PERFORM WRITE-LINE. SQ1134.2 +044400 END-ROUTINE-13. SQ1134.2 +044500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1134.2 +044600 MOVE "NO " TO ERROR-TOTAL SQ1134.2 +044700 ELSE SQ1134.2 +044800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1134.2 +044900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1134.2 +045000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1134.2 +045100 PERFORM WRITE-LINE. SQ1134.2 +045200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1134.2 +045300 MOVE "NO " TO ERROR-TOTAL SQ1134.2 +045400 ELSE SQ1134.2 +045500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1134.2 +045600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1134.2 +045700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1134.2 +045800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1134.2 +045900* SQ1134.2 +046000 WRITE-LINE. SQ1134.2 +046100 ADD 1 TO RECORD-COUNT. SQ1134.2 +046200 IF RECORD-COUNT GREATER 50 SQ1134.2 +046300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1134.2 +046400 MOVE SPACE TO DUMMY-RECORD SQ1134.2 +046500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1134.2 +046600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1134.2 +046700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1134.2 +046800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1134.2 +046900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1134.2 +047000 MOVE ZERO TO RECORD-COUNT. SQ1134.2 +047100 PERFORM WRT-LN. SQ1134.2 +047200* SQ1134.2 +047300 WRT-LN. SQ1134.2 +047400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1134.2 +047500 MOVE SPACE TO DUMMY-RECORD. SQ1134.2 +047600 BLANK-LINE-PRINT. SQ1134.2 +047700 PERFORM WRT-LN. SQ1134.2 +047800 FAIL-ROUTINE. SQ1134.2 +047900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1134.2 +048000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1134.2 +048100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1134.2 +048200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1134.2 +048300 MOVE XXINFO TO DUMMY-RECORD. SQ1134.2 +048400 PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +048500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1134.2 +048600 GO TO FAIL-ROUTINE-EX. SQ1134.2 +048700 FAIL-ROUTINE-WRITE. SQ1134.2 +048800 MOVE TEST-COMPUTED TO PRINT-REC SQ1134.2 +048900 PERFORM WRITE-LINE SQ1134.2 +049000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1134.2 +049100 MOVE TEST-CORRECT TO PRINT-REC SQ1134.2 +049200 PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +049300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1134.2 +049400 FAIL-ROUTINE-EX. SQ1134.2 +049500 EXIT. SQ1134.2 +049600 BAIL-OUT. SQ1134.2 +049700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1134.2 +049800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1134.2 +049900 BAIL-OUT-WRITE. SQ1134.2 +050000 MOVE CORRECT-A TO XXCORRECT. SQ1134.2 +050100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1134.2 +050200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1134.2 +050300 MOVE XXINFO TO DUMMY-RECORD. SQ1134.2 +050400 PERFORM WRITE-LINE 2 TIMES. SQ1134.2 +050500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1134.2 +050600 BAIL-OUT-EX. SQ1134.2 +050700 EXIT. SQ1134.2 +050800 CCVS1-EXIT. SQ1134.2 +050900 EXIT. SQ1134.2 +051000* SQ1134.2 +051100**************************************************************** SQ1134.2 +051200* * SQ1134.2 +051300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1134.2 +051400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1134.2 +051500* * SQ1134.2 +051600**************************************************************** SQ1134.2 +051700* SQ1134.2 +051800 SECT-SQ113-0001 SECTION. SQ1134.2 +051900 SEQ-INIT-WR-01. SQ1134.2 +052000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1134.2 +052100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1134.2 +052200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1134.2 +052300 MOVE 000120 TO XRECORD-LENGTH (1). SQ1134.2 +052400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1134.2 +052500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1134.2 +052600 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1134.2 +052700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1134.2 +052800 MOVE "S" TO XLABEL-TYPE (1). SQ1134.2 +052900 MOVE ZERO TO XRECORD-NUMBER (1). SQ1134.2 +053000 MOVE "CREATE 750 RECORD FILE" TO FEATURE. SQ1134.2 +053100 MOVE "SEQ-TEST-WR-01" TO PAR-NAME. SQ1134.2 +053200 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +053300 MOVE "00" TO SQ-FS1-STATUS-COPY. SQ1134.2 +053400* SQ1134.2 +053500 SEQ-TEST-WR-01. SQ1134.2 +053600 OPEN OUTPUT SQ-FS1. SQ1134.2 +053700 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +053800 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +053900 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +054000* SQ1134.2 +054100 SEQ-TEST-WR-01-LOOP. SQ1134.2 +054200 ADD 1 TO XRECORD-NUMBER (1). SQ1134.2 +054300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1134.2 +054400 WRITE SQ-FS1R1-F-G-120. SQ1134.2 +054500 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +054600 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +054700 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +054800 IF XRECORD-NUMBER (1) LESS THAN 750 SQ1134.2 +054900 GO TO SEQ-TEST-WR-01-LOOP. SQ1134.2 +055000* SQ1134.2 +055100 CLOSE SQ-FS1. SQ1134.2 +055200 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +055300 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +055400 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +055500* SQ1134.2 +055600 IF SQ-FS1-STATUS-COPY EQUAL "00" SQ1134.2 +055700 PERFORM PASS SQ1134.2 +055800 ELSE SQ1134.2 +055900 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +056000 MOVE "00" TO CORRECT-A SQ1134.2 +056100 MOVE "ERROR DURING FILE CREATION" TO RE-MARK SQ1134.2 +056200 PERFORM FAIL. SQ1134.2 +056300* SQ1134.2 +056400* A SEQUENTIAL TAPE FILE HAS BEEN CREATED. IT CONTAINS 750 SQ1134.2 +056500* RECORDS, EACH 120 CHARACTERS LONG. THE FILE WILL NOW BE SQ1134.2 +056600* READ AND THE RECORDS VERIFIED. SQ1134.2 +056700* SQ1134.2 +056800 SEQ-INIT-GF-02. SQ1134.2 +056900 MOVE "SEQ-TEST-GF-02" TO PAR-NAME. SQ1134.2 +057000 MOVE "VERIFY NEW FILE" TO FEATURE. SQ1134.2 +057100 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +057200 MOVE 1 TO REC-CT. SQ1134.2 +057300 GO TO SEQ-TEST-GF-02-01. SQ1134.2 +057400 SEQ-DELETE-02-01. SQ1134.2 +057500 PERFORM DE-LETE. SQ1134.2 +057600 GO TO SEQ-DELETE-02-02. SQ1134.2 +057700 SEQ-TEST-GF-02-01. SQ1134.2 +057800 OPEN INPUT SQ-FS1. SQ1134.2 +057900 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +058000 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +058100 MOVE "00" TO CORRECT-A SQ1134.2 +058200 MOVE "FAILURE FILE STATUS FROM OPEN" TO RE-MARK SQ1134.2 +058300 PERFORM FAIL SQ1134.2 +058400 GO TO SEQ-DELETE-02-02 SQ1134.2 +058500 ELSE SQ1134.2 +058600 PERFORM PASS. SQ1134.2 +058700* SQ1134.2 +058800 SEQ-INIT-GF-02-02. SQ1134.2 +058900 MOVE FILE-RECORD-INFO-P1-120 (1) SQ1134.2 +059000 TO FILE-RECORD-INFO-P1-120 (2). SQ1134.2 +059100 MOVE ZERO TO XRECORD-NUMBER (2). SQ1134.2 +059200 MOVE "00" TO SQ-FS1-STATUS-COPY. SQ1134.2 +059300 GO TO SEQ-TEST-GF-02-02. SQ1134.2 +059400 SEQ-DELETE-02-02. SQ1134.2 +059500 ADD 1 TO REC-CT. SQ1134.2 +059600 PERFORM DE-LETE. SQ1134.2 +059700 ADD 1 TO REC-CT. SQ1134.2 +059800 PERFORM DE-LETE. SQ1134.2 +059900 ADD 1 TO REC-CT. SQ1134.2 +060000 PERFORM DE-LETE. SQ1134.2 +060100 GO TO SEQ-DELETE-GF-02-05. SQ1134.2 +060200 SEQ-TEST-GF-02-02. SQ1134.2 +060300 ADD 1 TO REC-CT. SQ1134.2 +060400 SEQ-TEST-GF-02-02-LOOP. SQ1134.2 +060500 READ SQ-FS1 SQ1134.2 +060600 AT END GO TO SEQ-TEST-GF-02-02-1. SQ1134.2 +060700 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +060800 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +060900 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +061000 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +061100 ADD 1 TO XRECORD-NUMBER (2). SQ1134.2 +061200 IF XRECORD-NUMBER (2) GREATER THAN 750 SQ1134.2 +061300 GO TO SEQ-TEST-GF-02-02-1. SQ1134.2 +061400 IF FILE-RECORD-INFO-P1-120 (1) SQ1134.2 +061500 NOT EQUAL TO FILE-RECORD-INFO-P1-120 (2) SQ1134.2 +061600 ADD 1 TO RECORDS-IN-ERROR. SQ1134.2 +061700 GO TO SEQ-TEST-GF-02-02-LOOP. SQ1134.2 +061800* SQ1134.2 +061900 SEQ-TEST-GF-02-02-1. SQ1134.2 +062000 IF XRECORD-NUMBER (2) = 750 SQ1134.2 +062100 PERFORM PASS SQ1134.2 +062200 ELSE SQ1134.2 +062300 MOVE "RECORD COUNTING ERROR" TO RE-MARK SQ1134.2 +062400 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +062500 MOVE 750 TO CORRECT-18V0 SQ1134.2 +062600 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +062700 PERFORM FAIL. SQ1134.2 +062800* SQ1134.2 +062900 ADD 1 TO REC-CT. SQ1134.2 +063000 IF SQ-FS1-STATUS-COPY NOT EQUAL "00" SQ1134.2 +063100 MOVE "AT LEAST ONE UNSUCCESSFUL READ" TO RE-MARK SQ1134.2 +063200 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +063300 MOVE "00" TO CORRECT-A SQ1134.2 +063400 PERFORM FAIL SQ1134.2 +063500 ELSE SQ1134.2 +063600 PERFORM PASS. SQ1134.2 +063700* SQ1134.2 +063800 ADD 1 TO REC-CT. SQ1134.2 +063900 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1134.2 +064000 PERFORM PASS SQ1134.2 +064100 ELSE SQ1134.2 +064200 MOVE "RECORD CONTENT ERRORS" TO RE-MARK SQ1134.2 +064300 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +064400 MOVE RECORDS-IN-ERROR TO COMPUTED-18V0 SQ1134.2 +064500 MOVE "VII-44; 4.4.2" TO ANSI-REFERENCE SQ1134.2 +064600 PERFORM FAIL. SQ1134.2 +064700* SQ1134.2 +064800 SEQ-INIT-GF-02-05. SQ1134.2 +064900 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +065000 GO TO SEQ-TEST-GF-02-05. SQ1134.2 +065100 SEQ-DELETE-GF-02-05. SQ1134.2 +065200 ADD 1 TO REC-CT. SQ1134.2 +065300 PERFORM DE-LETE. SQ1134.2 +065400 GO TO SEQ-TEST-GF-02-END. SQ1134.2 +065500 SEQ-TEST-GF-02-05. SQ1134.2 +065600 ADD 1 TO REC-CT. SQ1134.2 +065700 CLOSE SQ-FS1. SQ1134.2 +065800 IF SQ-FS1-STATUS EQUAL "00" SQ1134.2 +065900 PERFORM PASS SQ1134.2 +066000 ELSE SQ1134.2 +066100 MOVE "UNEXPECTED FILE STATUS ON CLOSE" TO RE-MARK SQ1134.2 +066200 MOVE "00" TO CORRECT-A SQ1134.2 +066300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +066400 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1134.2 +066500 PERFORM FAIL. SQ1134.2 +066600* SQ1134.2 +066700 SEQ-TEST-GF-02-END. SQ1134.2 +066800* SQ1134.2 +066900* SQ1134.2 +067000 SEQ-INIT-GF-03. SQ1134.2 +067100 MOVE "SEQ-TEST-GF-03" TO PAR-NAME. SQ1134.2 +067200 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ1134.2 +067300 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +067400 MOVE 1 TO REC-CT. SQ1134.2 +067500 GO TO SEQ-TEST-GF-03. SQ1134.2 +067600 SEQ-DELETE-03. SQ1134.2 +067700 PERFORM DE-LETE. SQ1134.2 +067800 GO TO SEQ-TEST-03-END. SQ1134.2 +067900 SEQ-TEST-GF-03. SQ1134.2 +068000 OPEN INPUT SQ-FS1. SQ1134.2 +068100 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +068200 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +068300 MOVE "00" TO CORRECT-A SQ1134.2 +068400 MOVE "FAILURE FILE STATUS FROM OPEN" TO RE-MARK SQ1134.2 +068500 PERFORM FAIL SQ1134.2 +068600 ELSE SQ1134.2 +068700 PERFORM PASS. SQ1134.2 +068800 SEQ-TEST-03-END. SQ1134.2 +068900* SQ1134.2 +069000* SQ1134.2 +069100* THIS SERIES OF TESTS CHECKS FOUR LEVEL 1 VARIANTS OF SQ1134.2 +069200* THE READ STATEMENT SQ1134.2 +069300* SQ1134.2 +069400 SEQ-INIT-GF-04. SQ1134.2 +069500 MOVE ZERO TO XRECORD-NUMBER (2). SQ1134.2 +069600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1134.2 +069700 MOVE "READ...RECORD AT END" TO FEATURE. SQ1134.2 +069800 MOVE "SEQ-TEST-GF-O4" TO PAR-NAME. SQ1134.2 +069900 MOVE ZERO TO ERROR-FLAG. SQ1134.2 +070000 MOVE "**" TO SQ-FS1-STATUS-COPY. SQ1134.2 +070100 MOVE 1 TO REC-CT. SQ1134.2 +070200 GO TO SEQ-TEST-GF-04. SQ1134.2 +070300 SEQ-DELETE-04. SQ1134.2 +070400 PERFORM DE-LETE. SQ1134.2 +070500 ADD 1 TO REC-CT. SQ1134.2 +070600 PERFORM DE-LETE. SQ1134.2 +070700 ADD 1 TO REC-CT. SQ1134.2 +070800 PERFORM DE-LETE. SQ1134.2 +070900 GO TO SEQ-TEST-04-END. SQ1134.2 +071000 SEQ-TEST-GF-04. SQ1134.2 +071100 READ SQ-FS1 RECORD AT END SQ1134.2 +071200 MOVE 1 TO EOF-FLAG SQ1134.2 +071300 GO TO SEQ-TEST-GF-04-01. SQ1134.2 +071400 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +071500 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +071600 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +071700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +071800 ADD 1 TO XRECORD-NUMBER (2) SQ1134.2 +071900 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1134.2 +072000 ADD 1 TO RECORDS-IN-ERROR SQ1134.2 +072100 MOVE 1 TO ERROR-FLAG. SQ1134.2 +072200 IF XRECORD-NUMBER (2) LESS THAN 200 SQ1134.2 +072300 GO TO SEQ-TEST-GF-04. SQ1134.2 +072400* SQ1134.2 +072500 SEQ-TEST-GF-04-01. SQ1134.2 +072600 IF EOF-FLAG NOT EQUAL TO ZERO SQ1134.2 +072700 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1134.2 +072800 MOVE 750 TO CORRECT-18V0 SQ1134.2 +072900 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +073000 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +073100 PERFORM FAIL SQ1134.2 +073200 ELSE SQ1134.2 +073300 PERFORM PASS. SQ1134.2 +073400* SQ1134.2 +073500 SEQ-TEST-GF-04-02. SQ1134.2 +073600 ADD 1 TO REC-CT. SQ1134.2 +073700 IF SQ-FS1-STATUS-COPY = "**" SQ1134.2 +073800 PERFORM PASS SQ1134.2 +073900 ELSE SQ1134.2 +074000 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +074100 MOVE "**" TO CORRECT-A SQ1134.2 +074200 MOVE "UNEXPECTED FILE STATUS FOR AT LEAST ONE READ" SQ1134.2 +074300 TO RE-MARK SQ1134.2 +074400 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +074500 PERFORM FAIL. SQ1134.2 +074600* SQ1134.2 +074700 SEQ-TEST-GF-04-03. SQ1134.2 +074800 ADD 1 TO REC-CT. SQ1134.2 +074900 IF ERROR-FLAG EQUAL TO ZERO SQ1134.2 +075000 PERFORM PASS SQ1134.2 +075100 ELSE SQ1134.2 +075200 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1134.2 +075300 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +075400 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1134.2 +075500 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +075600 PERFORM FAIL. SQ1134.2 +075700 SEQ-TEST-04-END. SQ1134.2 +075800* SQ1134.2 +075900* SQ1134.2 +076000 SEQ-INIT-GF-O5. SQ1134.2 +076100 IF EOF-FLAG EQUAL TO 1 SQ1134.2 +076200 GO TO SEQ-DELETE-05. SQ1134.2 +076300 MOVE ZERO TO ERROR-FLAG. SQ1134.2 +076400 MOVE "READ...AT END..." TO FEATURE SQ1134.2 +076500 MOVE "SEQ-TEST-GF-O5" TO PAR-NAME. SQ1134.2 +076600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1134.2 +076700 MOVE "**" TO SQ-FS1-STATUS-COPY. SQ1134.2 +076800 MOVE 1 TO REC-CT. SQ1134.2 +076900 GO TO SEQ-TEST-GF-05. SQ1134.2 +077000 SEQ-DELETE-05. SQ1134.2 +077100 PERFORM DE-LETE. SQ1134.2 +077200 ADD 1 TO REC-CT. SQ1134.2 +077300 PERFORM DE-LETE. SQ1134.2 +077400 ADD 1 TO REC-CT. SQ1134.2 +077500 PERFORM DE-LETE. SQ1134.2 +077600 GO TO SEQ-TEST-05-END. SQ1134.2 +077700 SEQ-TEST-GF-05. SQ1134.2 +077800 READ SQ-FS1 AT END SQ1134.2 +077900 MOVE 1 TO EOF-FLAG SQ1134.2 +078000 GO TO SEQ-TEST-GF-05-01. SQ1134.2 +078100 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +078200 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +078300 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +078400 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +078500 ADD 1 TO XRECORD-NUMBER (2) SQ1134.2 +078600 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1134.2 +078700 ADD 1 TO RECORDS-IN-ERROR SQ1134.2 +078800 MOVE 1 TO ERROR-FLAG. SQ1134.2 +078900 IF XRECORD-NUMBER (2) LESS THAN 400 SQ1134.2 +079000 GO TO SEQ-TEST-GF-05. SQ1134.2 +079100* SQ1134.2 +079200 SEQ-TEST-GF-05-01. SQ1134.2 +079300 IF EOF-FLAG NOT EQUAL TO ZERO SQ1134.2 +079400 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1134.2 +079500 MOVE 750 TO CORRECT-18V0 SQ1134.2 +079600 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +079700 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +079800 PERFORM FAIL SQ1134.2 +079900 ELSE SQ1134.2 +080000 PERFORM PASS. SQ1134.2 +080100* SQ1134.2 +080200 SEQ-TEST-GF-05-02. SQ1134.2 +080300 ADD 1 TO REC-CT. SQ1134.2 +080400 IF SQ-FS1-STATUS-COPY = "**" SQ1134.2 +080500 PERFORM PASS SQ1134.2 +080600 ELSE SQ1134.2 +080700 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +080800 MOVE "**" TO CORRECT-A SQ1134.2 +080900 MOVE "UNEXPECTED FILE STATUS FOR AT LEAST ONE READ" SQ1134.2 +081000 TO RE-MARK SQ1134.2 +081100 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +081200 PERFORM FAIL. SQ1134.2 +081300* SQ1134.2 +081400 SEQ-TEST-GF-05-03. SQ1134.2 +081500 ADD 1 TO REC-CT. SQ1134.2 +081600 IF ERROR-FLAG EQUAL TO ZERO SQ1134.2 +081700 PERFORM PASS SQ1134.2 +081800 ELSE SQ1134.2 +081900 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1134.2 +082000 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +082100 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1134.2 +082200 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +082300 PERFORM FAIL. SQ1134.2 +082400 SEQ-TEST-05-END. SQ1134.2 +082500* SQ1134.2 +082600* SQ1134.2 +082700 SEQ-INIT-GF-O6. SQ1134.2 +082800 IF EOF-FLAG EQUAL TO 1 SQ1134.2 +082900 GO TO SEQ-DELETE-06. SQ1134.2 +083000 MOVE ZERO TO ERROR-FLAG. SQ1134.2 +083100 MOVE "READ...RECORD END..." TO FEATURE SQ1134.2 +083200 MOVE "SEQ-TEST-GF-O6" TO PAR-NAME. SQ1134.2 +083300 MOVE ZERO TO RECORDS-IN-ERROR. SQ1134.2 +083400 MOVE "**" TO SQ-FS1-STATUS-COPY. SQ1134.2 +083500 MOVE 1 TO REC-CT. SQ1134.2 +083600 GO TO SEQ-TEST-GF-06. SQ1134.2 +083700 SEQ-DELETE-06. SQ1134.2 +083800 PERFORM DE-LETE. SQ1134.2 +083900 ADD 1 TO REC-CT. SQ1134.2 +084000 PERFORM DE-LETE. SQ1134.2 +084100 ADD 1 TO REC-CT. SQ1134.2 +084200 PERFORM DE-LETE. SQ1134.2 +084300 GO TO SEQ-TEST-06-END. SQ1134.2 +084400 SEQ-TEST-GF-06. SQ1134.2 +084500 READ SQ-FS1 RECORD END SQ1134.2 +084600 MOVE 1 TO EOF-FLAG SQ1134.2 +084700 GO TO SEQ-TEST-GF-06-01. SQ1134.2 +084800 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +084900 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +085000 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +085100 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +085200 ADD 1 TO XRECORD-NUMBER (2) SQ1134.2 +085300 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1134.2 +085400 ADD 1 TO RECORDS-IN-ERROR SQ1134.2 +085500 MOVE 1 TO ERROR-FLAG. SQ1134.2 +085600 IF XRECORD-NUMBER (2) LESS THAN 600 SQ1134.2 +085700 GO TO SEQ-TEST-GF-06. SQ1134.2 +085800* SQ1134.2 +085900 SEQ-TEST-GF-06-01. SQ1134.2 +086000 IF EOF-FLAG NOT EQUAL TO ZERO SQ1134.2 +086100 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1134.2 +086200 MOVE 750 TO CORRECT-18V0 SQ1134.2 +086300 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +086400 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +086500 PERFORM FAIL SQ1134.2 +086600 ELSE SQ1134.2 +086700 PERFORM PASS. SQ1134.2 +086800* SQ1134.2 +086900 SEQ-TEST-GF-06-02. SQ1134.2 +087000 ADD 1 TO REC-CT. SQ1134.2 +087100 IF SQ-FS1-STATUS-COPY = "**" SQ1134.2 +087200 PERFORM PASS SQ1134.2 +087300 ELSE SQ1134.2 +087400 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +087500 MOVE "**" TO CORRECT-A SQ1134.2 +087600 MOVE "UNEXPECTED FILE STATUS FOR AT LEAST ONE READ" SQ1134.2 +087700 TO RE-MARK SQ1134.2 +087800 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +087900 PERFORM FAIL. SQ1134.2 +088000* SQ1134.2 +088100 SEQ-TEST-GF-06-03. SQ1134.2 +088200 ADD 1 TO REC-CT. SQ1134.2 +088300 IF ERROR-FLAG EQUAL TO ZERO SQ1134.2 +088400 PERFORM PASS SQ1134.2 +088500 ELSE SQ1134.2 +088600 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1134.2 +088700 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +088800 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1134.2 +088900 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +089000 PERFORM FAIL. SQ1134.2 +089100 SEQ-TEST-06-END. SQ1134.2 +089200* SQ1134.2 +089300* SQ1134.2 +089400 SEQ-INIT-GF-O7. SQ1134.2 +089500 IF EOF-FLAG EQUAL TO 1 SQ1134.2 +089600 GO TO SEQ-DELETE-07. SQ1134.2 +089700 MOVE ZERO TO ERROR-FLAG. SQ1134.2 +089800 MOVE "READ... END..." TO FEATURE SQ1134.2 +089900 MOVE "SEQ-TEST-GF-O7" TO PAR-NAME. SQ1134.2 +090000 MOVE ZERO TO RECORDS-IN-ERROR. SQ1134.2 +090100 MOVE "**" TO SQ-FS1-STATUS-COPY. SQ1134.2 +090200 MOVE 1 TO REC-CT. SQ1134.2 +090300 GO TO SEQ-TEST-GF-07. SQ1134.2 +090400 SEQ-DELETE-07. SQ1134.2 +090500 PERFORM DE-LETE. SQ1134.2 +090600 ADD 1 TO REC-CT. SQ1134.2 +090700 PERFORM DE-LETE. SQ1134.2 +090800 ADD 1 TO REC-CT. SQ1134.2 +090900 PERFORM DE-LETE. SQ1134.2 +091000 GO TO SEQ-TEST-07-END. SQ1134.2 +091100 SEQ-TEST-GF-07. SQ1134.2 +091200 READ SQ-FS1 END SQ1134.2 +091300 MOVE 1 TO EOF-FLAG SQ1134.2 +091400 GO TO SEQ-TEST-GF-07-01. SQ1134.2 +091500 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +091600 MOVE SQ-FS1-STATUS TO SQ-FS1-STATUS-COPY SQ1134.2 +091700 MOVE "00" TO SQ-FS1-STATUS. SQ1134.2 +091800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1134.2 +091900 ADD 1 TO XRECORD-NUMBER (2) SQ1134.2 +092000 IF XRECORD-NUMBER (2) NOT EQUAL TO XRECORD-NUMBER (1) SQ1134.2 +092100 ADD 1 TO RECORDS-IN-ERROR SQ1134.2 +092200 MOVE 1 TO ERROR-FLAG. SQ1134.2 +092300 IF XRECORD-NUMBER (2) LESS THAN 750 SQ1134.2 +092400 GO TO SEQ-TEST-GF-07. SQ1134.2 +092500* SQ1134.2 +092600 SEQ-TEST-GF-07-01. SQ1134.2 +092700 IF EOF-FLAG NOT EQUAL TO ZERO SQ1134.2 +092800 MOVE "PREMATURE END OF FILE" TO RE-MARK SQ1134.2 +092900 MOVE 750 TO CORRECT-18V0 SQ1134.2 +093000 MOVE XRECORD-NUMBER (2) TO COMPUTED-18V0 SQ1134.2 +093100 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +093200 PERFORM FAIL SQ1134.2 +093300 ELSE SQ1134.2 +093400 PERFORM PASS. SQ1134.2 +093500* SQ1134.2 +093600 SEQ-TEST-GF-07-02. SQ1134.2 +093700 ADD 1 TO REC-CT. SQ1134.2 +093800 IF SQ-FS1-STATUS-COPY = "**" SQ1134.2 +093900 PERFORM PASS SQ1134.2 +094000 ELSE SQ1134.2 +094100 MOVE SQ-FS1-STATUS-COPY TO COMPUTED-A SQ1134.2 +094200 MOVE "**" TO CORRECT-A SQ1134.2 +094300 MOVE "UNEXPECTED FILE STATUS FOR AT LEAST ONE READ" SQ1134.2 +094400 TO RE-MARK SQ1134.2 +094500 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +094600 PERFORM FAIL. SQ1134.2 +094700* SQ1134.2 +094800 SEQ-TEST-GF-07-03. SQ1134.2 +094900 ADD 1 TO REC-CT. SQ1134.2 +095000 IF ERROR-FLAG EQUAL TO ZERO SQ1134.2 +095100 PERFORM PASS SQ1134.2 +095200 ELSE SQ1134.2 +095300 MOVE ERROR-FLAG TO COMPUTED-18V0 SQ1134.2 +095400 MOVE ZERO TO CORRECT-18V0 SQ1134.2 +095500 MOVE "ERROR IN ONE OR MORE RECORDS" TO RE-MARK SQ1134.2 +095600 MOVE "VII-44" TO ANSI-REFERENCE SQ1134.2 +095700 PERFORM FAIL. SQ1134.2 +095800 SEQ-TEST-07-END. SQ1134.2 +095900* SQ1134.2 +096000* SQ1134.2 +096100 SEQ-INIT-GF-O8. SQ1134.2 +096200 IF EOF-FLAG EQUAL TO 1 SQ1134.2 +096300 GO TO SEQ-DELETE-08. SQ1134.2 +096400 MOVE "READ... END... AT EOF" TO FEATURE SQ1134.2 +096500 MOVE "SEQ-TEST-GF-O8" TO PAR-NAME. SQ1134.2 +096600 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +096700 MOVE 1 TO REC-CT. SQ1134.2 +096800 GO TO SEQ-TEST-GF-08. SQ1134.2 +096900 SEQ-DELETE-08. SQ1134.2 +097000 PERFORM DE-LETE. SQ1134.2 +097100 GO TO SEQ-TEST-08-END. SQ1134.2 +097200 SEQ-TEST-GF-08. SQ1134.2 +097300 READ SQ-FS1 END SQ1134.2 +097400 MOVE 1 TO EOF-FLAG. SQ1134.2 +097500 IF SQ-FS1-STATUS NOT EQUAL TO "10" SQ1134.2 +097600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +097700 MOVE "00" TO CORRECT-A SQ1134.2 +097800 MOVE "EXPECTED EOF STATUS CODE NOT RETURNED" SQ1134.2 +097900 TO RE-MARK SQ1134.2 +098000 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1134.2 +098100 PERFORM FAIL SQ1134.2 +098200 ELSE SQ1134.2 +098300 PERFORM PASS. SQ1134.2 +098400* SQ1134.2 +098500 SEQ-TEST-GF-08-02. SQ1134.2 +098600 ADD 1 TO REC-CT. SQ1134.2 +098700 IF EOF-FLAG NOT EQUAL TO 1 SQ1134.2 +098800 MOVE EOF-FLAG TO COMPUTED-18V0 SQ1134.2 +098900 MOVE 1 TO CORRECT-18V0 SQ1134.2 +099000 MOVE "EOF NOT FOUND AFTER 750 RECORDS" TO RE-MARK SQ1134.2 +099100 PERFORM FAIL SQ1134.2 +099200 ELSE SQ1134.2 +099300 PERFORM PASS. SQ1134.2 +099400 SEQ-TEST-08-END. SQ1134.2 +099500* SQ1134.2 +099600* SQ1134.2 +099700 SEQ-INIT-GF-O9. SQ1134.2 +099800 MOVE "CLOSE FILE " TO FEATURE SQ1134.2 +099900 MOVE "SEQ-TEST-GF-O9" TO PAR-NAME. SQ1134.2 +100000 MOVE "**" TO SQ-FS1-STATUS. SQ1134.2 +100100 MOVE 1 TO REC-CT. SQ1134.2 +100200 GO TO SEQ-TEST-GF-09. SQ1134.2 +100300 SEQ-DELETE-09. SQ1134.2 +100400 PERFORM DE-LETE. SQ1134.2 +100500 GO TO SEQ-TEST-09-END. SQ1134.2 +100600 SEQ-TEST-GF-09. SQ1134.2 +100700 CLOSE SQ-FS1. SQ1134.2 +100800 IF SQ-FS1-STATUS NOT EQUAL TO "00" SQ1134.2 +100900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1134.2 +101000 MOVE "00" TO CORRECT-A SQ1134.2 +101100 MOVE "UNEXPECTED FILE STATUS FROM CLOSE" TO RE-MARK SQ1134.2 +101200 PERFORM FAIL SQ1134.2 +101300 ELSE SQ1134.2 +101400 PERFORM PASS. SQ1134.2 +101500 SEQ-TEST-09-END. SQ1134.2 +101600* SQ1134.2 +101700* SQ1134.2 +101800 TERMINATE-ROUTINE. SQ1134.2 +101900 EXIT. SQ1134.2 +102000 CCVS-EXIT SECTION. SQ1134.2 +102100 CCVS-999999. SQ1134.2 +102200 GO TO CLOSE-FILES. SQ1134.2 diff --git a/tests/cobol85/SQ/SQ114A.CBL b/tests/cobol85/SQ/SQ114A.CBL new file mode 100755 index 00000000..67da1585 --- /dev/null +++ b/tests/cobol85/SQ/SQ114A.CBL @@ -0,0 +1,962 @@ +000100 IDENTIFICATION DIVISION. SQ1144.2 +000200 PROGRAM-ID. SQ1144.2 +000300 SQ114A. SQ1144.2 +000400**************************************************************** SQ1144.2 +000500* * SQ1144.2 +000600* VALIDATION FOR:- * SQ1144.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1144.2 +000800* * SQ1144.2 +000900* CREATION DATE / VALIDATION DATE * SQ1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1144.2 +001100* * SQ1144.2 +001200**************************************************************** SQ1144.2 +001300 SQ1144.2 +001400* SQ1144.2 +001500* SQ1144.2 +001600* NEW TEST: SQ1144.2 +001700* OPEN OUTPUT FILE-1, FILE-2. SQ1144.2 +001800* OPEN INPUT FILE-1, FILE-2. SQ1144.2 +001900* CLOSE FILE-1, FILE-2. SQ1144.2 +002000* SQ1144.2 +002100* THE ROUTINE SQ114A TESTS THE USE OF THE SAME AREA SQ1144.2 +002200* CLAUSE FOR TWO FILES, ONE A TAPE FILE AND THE OTHER A SQ1144.2 +002300* MASS STORAGE FILE. THIS ROUTINE IS A COMBINATION OF THE SQ1144.2 +002400* ROUTINES SQ102 AND SQ104. SQ1144.2 +002500* SQ1144.2 +002600* USED X-CARDS: SQ1144.2 +002700* XXXXX001 SQ1144.2 +002800* XXXXX014 SQ1144.2 +002900* XXXXX055 SQ1144.2 +003000* P XXXXX062 SQ1144.2 +003100* XXXXX082 SQ1144.2 +003200* XXXXX083 SQ1144.2 +003300* C XXXXX084 SQ1144.2 +003400* SQ1144.2 +003500* SQ1144.2 +003600 ENVIRONMENT DIVISION. SQ1144.2 +003700 CONFIGURATION SECTION. SQ1144.2 +003800 SOURCE-COMPUTER. SQ1144.2 +003900 Linux. SQ1144.2 +004000 OBJECT-COMPUTER. SQ1144.2 +004100 Linux. SQ1144.2 +004200 INPUT-OUTPUT SECTION. SQ1144.2 +004300 FILE-CONTROL. SQ1144.2 +004400*P SELECT RAW-DATA ASSIGN TO SQ1144.2 +004500*P "XXXXX062" SQ1144.2 +004600*P ORGANIZATION IS INDEXED SQ1144.2 +004700*P ACCESS MODE IS RANDOM SQ1144.2 +004800*P RECORD KEY IS RAW-DATA-KEY. SQ1144.2 +004900 SELECT PRINT-FILE ASSIGN TO SQ1144.2 +005000 "report.log". SQ1144.2 +005100 SELECT SQ-FS1 ASSIGN TO SQ1144.2 +005200 "XXXXX001" SQ1144.2 +005300 ORGANIZATION IS SEQUENTIAL SQ1144.2 +005400 ACCESS MODE IS SEQUENTIAL SQ1144.2 +005500 FILE STATUS IS FILE-STATUS-SQ-FS1. SQ1144.2 +005600 SELECT SQ-FS2 ASSIGN TO SQ1144.2 +005700 "XXXXX014" SQ1144.2 +005800 ORGANIZATION IS SEQUENTIAL SQ1144.2 +005900 ACCESS MODE IS SEQUENTIAL SQ1144.2 +006000 FILE STATUS IS FILE-STATUS-SQ-FS2. SQ1144.2 +006100 SELECT SQ-FS3 ASSIGN TO SQ1144.2 +006200 "XXXXX014" SQ1144.2 +006300 ORGANIZATION IS SEQUENTIAL SQ1144.2 +006400 ACCESS MODE IS SEQUENTIAL SQ1144.2 +006500 FILE STATUS IS FILE-STATUS-SQ-FS3. SQ1144.2 +006600 I-O-CONTROL. SQ1144.2 +006700 SAME AREA SQ-FS1 SQ-FS3. SQ1144.2 +006800 DATA DIVISION. SQ1144.2 +006900 FILE SECTION. SQ1144.2 +007000*P SQ1144.2 +007100*PD RAW-DATA. SQ1144.2 +007200*P SQ1144.2 +007300*P1 RAW-DATA-SATZ. SQ1144.2 +007400*P 05 RAW-DATA-KEY PIC X(6). SQ1144.2 +007500*P 05 C-DATE PIC 9(6). SQ1144.2 +007600*P 05 C-TIME PIC 9(8). SQ1144.2 +007700*P 05 C-NO-OF-TESTS PIC 99. SQ1144.2 +007800*P 05 C-OK PIC 999. SQ1144.2 +007900*P 05 C-ALL PIC 999. SQ1144.2 +008000*P 05 C-FAIL PIC 999. SQ1144.2 +008100*P 05 C-DELETED PIC 999. SQ1144.2 +008200*P 05 C-INSPECT PIC 999. SQ1144.2 +008300*P 05 C-NOTE PIC X(13). SQ1144.2 +008400*P 05 C-INDENT PIC X. SQ1144.2 +008500*P 05 C-ABORT PIC X(8). SQ1144.2 +008600 FD PRINT-FILE SQ1144.2 +008700*C LABEL RECORDS SQ1144.2 +008800*C OMITTED SQ1144.2 +008900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1144.2 +009000 . SQ1144.2 +009100 01 PRINT-REC PICTURE X(120). SQ1144.2 +009200 01 DUMMY-RECORD PICTURE X(120). SQ1144.2 +009300 FD SQ-FS1 SQ1144.2 +009400*C LABEL RECORD STANDARD SQ1144.2 +009500 . SQ1144.2 +009600 01 SQ-FS1R1-F-G-120. SQ1144.2 +009700 02 FILLER PIC X(120). SQ1144.2 +009800 FD SQ-FS2 SQ1144.2 +009900*C LABEL RECORDS ARE STANDARD SQ1144.2 +010000*C DATA RECORD SQ-FS2R1-F-G-120 SQ1144.2 +010100 BLOCK CONTAINS 120 CHARACTERS SQ1144.2 +010200 RECORD CONTAINS 120 CHARACTERS. SQ1144.2 +010300 01 SQ-FS2R1-F-G-120. SQ1144.2 +010400 02 FILLER PIC X(120). SQ1144.2 +010500 FD SQ-FS3 SQ1144.2 +010600*C LABEL RECORDS ARE STANDARD SQ1144.2 +010700*C DATA RECORD SQ-FS3R1-F-G-120 SQ1144.2 +010800 BLOCK CONTAINS 120 CHARACTERS SQ1144.2 +010900 RECORD CONTAINS 120 CHARACTERS. SQ1144.2 +011000 01 SQ-FS3R1-F-G-120. SQ1144.2 +011100 02 FILLER PIC X(120). SQ1144.2 +011200 WORKING-STORAGE SECTION. SQ1144.2 +011300 01 FILE-STATUS-SQ-FS1 PIC XX VALUE SPACE. SQ1144.2 +011400 01 FILE-STATUS-SQ-FS3 PIC XX VALUE SPACE. SQ1144.2 +011500 01 FILE-STATUS-SQ-FS2 PIC XX VALUE SPACE. SQ1144.2 +011600 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ1144.2 +011700 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ1144.2 +011800 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1144.2 +011900 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ1144.2 +012000 01 FILE-RECORD-INFORMATION-REC. SQ1144.2 +012100 03 FILE-RECORD-INFO-SKELETON. SQ1144.2 +012200 05 FILLER PICTURE X(48) VALUE SQ1144.2 +012300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1144.2 +012400 05 FILLER PICTURE X(46) VALUE SQ1144.2 +012500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1144.2 +012600 05 FILLER PICTURE X(26) VALUE SQ1144.2 +012700 ",LFIL=000000,ORG= ,LBLR= ". SQ1144.2 +012800 05 FILLER PICTURE X(37) VALUE SQ1144.2 +012900 ",RECKEY= ". SQ1144.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1144.2 +013100 ",ALTKEY1= ". SQ1144.2 +013200 05 FILLER PICTURE X(38) VALUE SQ1144.2 +013300 ",ALTKEY2= ". SQ1144.2 +013400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1144.2 +013500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1144.2 +013600 05 FILE-RECORD-INFO-P1-120. SQ1144.2 +013700 07 FILLER PIC X(5). SQ1144.2 +013800 07 XFILE-NAME PIC X(6). SQ1144.2 +013900 07 FILLER PIC X(8). SQ1144.2 +014000 07 XRECORD-NAME PIC X(6). SQ1144.2 +014100 07 FILLER PIC X(1). SQ1144.2 +014200 07 REELUNIT-NUMBER PIC 9(1). SQ1144.2 +014300 07 FILLER PIC X(7). SQ1144.2 +014400 07 XRECORD-NUMBER PIC 9(6). SQ1144.2 +014500 07 FILLER PIC X(6). SQ1144.2 +014600 07 UPDATE-NUMBER PIC 9(2). SQ1144.2 +014700 07 FILLER PIC X(5). SQ1144.2 +014800 07 ODO-NUMBER PIC 9(4). SQ1144.2 +014900 07 FILLER PIC X(5). SQ1144.2 +015000 07 XPROGRAM-NAME PIC X(5). SQ1144.2 +015100 07 FILLER PIC X(7). SQ1144.2 +015200 07 XRECORD-LENGTH PIC 9(6). SQ1144.2 +015300 07 FILLER PIC X(7). SQ1144.2 +015400 07 CHARS-OR-RECORDS PIC X(2). SQ1144.2 +015500 07 FILLER PIC X(1). SQ1144.2 +015600 07 XBLOCK-SIZE PIC 9(4). SQ1144.2 +015700 07 FILLER PIC X(6). SQ1144.2 +015800 07 RECORDS-IN-FILE PIC 9(6). SQ1144.2 +015900 07 FILLER PIC X(5). SQ1144.2 +016000 07 XFILE-ORGANIZATION PIC X(2). SQ1144.2 +016100 07 FILLER PIC X(6). SQ1144.2 +016200 07 XLABEL-TYPE PIC X(1). SQ1144.2 +016300 05 FILE-RECORD-INFO-P121-240. SQ1144.2 +016400 07 FILLER PIC X(8). SQ1144.2 +016500 07 XRECORD-KEY PIC X(29). SQ1144.2 +016600 07 FILLER PIC X(9). SQ1144.2 +016700 07 ALTERNATE-KEY1 PIC X(29). SQ1144.2 +016800 07 FILLER PIC X(9). SQ1144.2 +016900 07 ALTERNATE-KEY2 PIC X(29). SQ1144.2 +017000 07 FILLER PIC X(7). SQ1144.2 +017100 01 TEST-RESULTS. SQ1144.2 +017200 02 FILLER PICTURE X VALUE SPACE. SQ1144.2 +017300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1144.2 +017400 02 FILLER PICTURE X VALUE SPACE. SQ1144.2 +017500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1144.2 +017600 02 FILLER PICTURE X VALUE SPACE. SQ1144.2 +017700 02 PAR-NAME. SQ1144.2 +017800 03 FILLER PICTURE X(12) VALUE SPACE. SQ1144.2 +017900 03 PARDOT-X PICTURE X VALUE SPACE. SQ1144.2 +018000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1144.2 +018100 03 FILLER PIC X(5) VALUE SPACE. SQ1144.2 +018200 02 FILLER PIC X(10) VALUE SPACE. SQ1144.2 +018300 02 RE-MARK PIC X(61). SQ1144.2 +018400 01 TEST-COMPUTED. SQ1144.2 +018500 02 FILLER PIC X(30) VALUE SPACE. SQ1144.2 +018600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1144.2 +018700 02 COMPUTED-X. SQ1144.2 +018800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1144.2 +018900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1144.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1144.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1144.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1144.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1144.2 +019400 04 COMPUTED-18V0 PICTURE -9(18). SQ1144.2 +019500 04 FILLER PICTURE X. SQ1144.2 +019600 03 FILLER PIC X(50) VALUE SPACE. SQ1144.2 +019700 01 TEST-CORRECT. SQ1144.2 +019800 02 FILLER PIC X(30) VALUE SPACE. SQ1144.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1144.2 +020000 02 CORRECT-X. SQ1144.2 +020100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1144.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1144.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1144.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1144.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1144.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. SQ1144.2 +020700 04 CORRECT-18V0 PICTURE -9(18). SQ1144.2 +020800 04 FILLER PICTURE X. SQ1144.2 +020900 03 FILLER PIC X(50) VALUE SPACE. SQ1144.2 +021000 01 CCVS-C-1. SQ1144.2 +021100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1144.2 +021200- "SS PARAGRAPH-NAME SQ1144.2 +021300- " REMARKS". SQ1144.2 +021400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1144.2 +021500 01 CCVS-C-2. SQ1144.2 +021600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1144.2 +021700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1144.2 +021800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1144.2 +021900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1144.2 +022000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1144.2 +022100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1144.2 +022200 01 REC-CT PICTURE 99 VALUE ZERO. SQ1144.2 +022300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1144.2 +022400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1144.2 +022500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1144.2 +022600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1144.2 +022700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1144.2 +022800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1144.2 +022900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1144.2 +023000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1144.2 +023100 01 CCVS-H-1. SQ1144.2 +023200 02 FILLER PICTURE X(27) VALUE SPACE. SQ1144.2 +023300 02 FILLER PICTURE X(67) VALUE SQ1144.2 +023400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1144.2 +023500- " SYSTEM". SQ1144.2 +023600 02 FILLER PICTURE X(26) VALUE SPACE. SQ1144.2 +023700 01 CCVS-H-2. SQ1144.2 +023800 02 FILLER PICTURE X(52) VALUE IS SQ1144.2 +023900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1144.2 +024000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1144.2 +024100 02 TEST-ID PICTURE IS X(9). SQ1144.2 +024200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1144.2 +024300 01 CCVS-H-3. SQ1144.2 +024400 02 FILLER PICTURE X(34) VALUE SQ1144.2 +024500 " FOR OFFICIAL USE ONLY ". SQ1144.2 +024600 02 FILLER PICTURE X(58) VALUE SQ1144.2 +024700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1144.2 +024800 02 FILLER PICTURE X(28) VALUE SQ1144.2 +024900 " COPYRIGHT 1985 ". SQ1144.2 +025000 01 CCVS-E-1. SQ1144.2 +025100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1144.2 +025200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1144.2 +025300 02 ID-AGAIN PICTURE IS X(9). SQ1144.2 +025400 02 FILLER PICTURE X(45) VALUE IS SQ1144.2 +025500 " NTIS DISTRIBUTION COBOL 85". SQ1144.2 +025600 01 CCVS-E-2. SQ1144.2 +025700 02 FILLER PICTURE X(31) VALUE SQ1144.2 +025800 SPACE. SQ1144.2 +025900 02 FILLER PICTURE X(21) VALUE SPACE. SQ1144.2 +026000 02 CCVS-E-2-2. SQ1144.2 +026100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1144.2 +026200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1144.2 +026300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1144.2 +026400 01 CCVS-E-3. SQ1144.2 +026500 02 FILLER PICTURE X(22) VALUE SQ1144.2 +026600 " FOR OFFICIAL USE ONLY". SQ1144.2 +026700 02 FILLER PICTURE X(12) VALUE SPACE. SQ1144.2 +026800 02 FILLER PICTURE X(58) VALUE SQ1144.2 +026900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1144.2 +027000 02 FILLER PICTURE X(13) VALUE SPACE. SQ1144.2 +027100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1144.2 +027200 01 CCVS-E-4. SQ1144.2 +027300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1144.2 +027400 02 FILLER PIC XXXX VALUE " OF ". SQ1144.2 +027500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1144.2 +027600 02 FILLER PIC X(40) VALUE SQ1144.2 +027700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1144.2 +027800 01 XXINFO. SQ1144.2 +027900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1144.2 +028000 02 INFO-TEXT. SQ1144.2 +028100 04 FILLER PIC X(20) VALUE SPACE. SQ1144.2 +028200 04 XXCOMPUTED PIC X(20). SQ1144.2 +028300 04 FILLER PIC X(5) VALUE SPACE. SQ1144.2 +028400 04 XXCORRECT PIC X(20). SQ1144.2 +028500 01 HYPHEN-LINE. SQ1144.2 +028600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1144.2 +028700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1144.2 +028800- "*****************************************". SQ1144.2 +028900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1144.2 +029000- "******************************". SQ1144.2 +029100 01 CCVS-PGM-ID PIC X(6) VALUE SQ1144.2 +029200 "SQ114A". SQ1144.2 +029300 PROCEDURE DIVISION. SQ1144.2 +029400 CCVS1 SECTION. SQ1144.2 +029500 OPEN-FILES. SQ1144.2 +029600*P OPEN I-O RAW-DATA. SQ1144.2 +029700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1144.2 +029800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1144.2 +029900*P MOVE "ABORTED " TO C-ABORT. SQ1144.2 +030000*P ADD 1 TO C-NO-OF-TESTS. SQ1144.2 +030100*P ACCEPT C-DATE FROM DATE. SQ1144.2 +030200*P ACCEPT C-TIME FROM TIME. SQ1144.2 +030300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1144.2 +030400*PND-E-1. SQ1144.2 +030500*P CLOSE RAW-DATA. SQ1144.2 +030600 OPEN OUTPUT PRINT-FILE. SQ1144.2 +030700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1144.2 +030800 MOVE SPACE TO TEST-RESULTS. SQ1144.2 +030900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1144.2 +031000 MOVE ZERO TO REC-SKL-SUB. SQ1144.2 +031100 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1144.2 +031200 CCVS-INIT-FILE. SQ1144.2 +031300 ADD 1 TO REC-SKL-SUB. SQ1144.2 +031400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1144.2 +031500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1144.2 +031600 CCVS-INIT-EXIT. SQ1144.2 +031700 GO TO CCVS1-EXIT. SQ1144.2 +031800 CLOSE-FILES. SQ1144.2 +031900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1144.2 +032000*P OPEN I-O RAW-DATA. SQ1144.2 +032100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1144.2 +032200*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1144.2 +032300*P MOVE "OK. " TO C-ABORT. SQ1144.2 +032400*P MOVE PASS-COUNTER TO C-OK. SQ1144.2 +032500*P MOVE ERROR-HOLD TO C-ALL. SQ1144.2 +032600*P MOVE ERROR-COUNTER TO C-FAIL. SQ1144.2 +032700*P MOVE DELETE-CNT TO C-DELETED. SQ1144.2 +032800*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1144.2 +032900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1144.2 +033000*PND-E-2. SQ1144.2 +033100*P CLOSE RAW-DATA. SQ1144.2 +033200 TERMINATE-CCVS. SQ1144.2 +033300*S EXIT PROGRAM. SQ1144.2 +033400*SERMINATE-CALL. SQ1144.2 +033500 STOP RUN. SQ1144.2 +033600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1144.2 +033700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1144.2 +033800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1144.2 +033900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1144.2 +034000 MOVE "****TEST DELETED****" TO RE-MARK. SQ1144.2 +034100 PRINT-DETAIL. SQ1144.2 +034200 IF REC-CT NOT EQUAL TO ZERO SQ1144.2 +034300 MOVE "." TO PARDOT-X SQ1144.2 +034400 MOVE REC-CT TO DOTVALUE. SQ1144.2 +034500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1144.2 +034600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1144.2 +034700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1144.2 +034800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1144.2 +034900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1144.2 +035000 MOVE SPACE TO CORRECT-X. SQ1144.2 +035100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1144.2 +035200 MOVE SPACE TO RE-MARK. SQ1144.2 +035300 HEAD-ROUTINE. SQ1144.2 +035400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +035500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1144.2 +035600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1144.2 +035700 COLUMN-NAMES-ROUTINE. SQ1144.2 +035800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +035900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +036000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +036100 END-ROUTINE. SQ1144.2 +036200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1144.2 +036300 END-RTN-EXIT. SQ1144.2 +036400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +036500 END-ROUTINE-1. SQ1144.2 +036600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1144.2 +036700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1144.2 +036800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1144.2 +036900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1144.2 +037000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1144.2 +037100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1144.2 +037200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1144.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1144.2 +037400 END-ROUTINE-12. SQ1144.2 +037500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1144.2 +037600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1144.2 +037700 MOVE "NO " TO ERROR-TOTAL SQ1144.2 +037800 ELSE SQ1144.2 +037900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1144.2 +038000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1144.2 +038100 PERFORM WRITE-LINE. SQ1144.2 +038200 END-ROUTINE-13. SQ1144.2 +038300 IF DELETE-CNT IS EQUAL TO ZERO SQ1144.2 +038400 MOVE "NO " TO ERROR-TOTAL ELSE SQ1144.2 +038500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1144.2 +038600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1144.2 +038700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +038800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1144.2 +038900 MOVE "NO " TO ERROR-TOTAL SQ1144.2 +039000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1144.2 +039100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1144.2 +039200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +039300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1144.2 +039400 WRITE-LINE. SQ1144.2 +039500 ADD 1 TO RECORD-COUNT. SQ1144.2 +039600 IF RECORD-COUNT GREATER 50 SQ1144.2 +039700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1144.2 +039800 MOVE SPACE TO DUMMY-RECORD SQ1144.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1144.2 +040000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1144.2 +040100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1144.2 +040200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1144.2 +040300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1144.2 +040400 MOVE ZERO TO RECORD-COUNT. SQ1144.2 +040500 PERFORM WRT-LN. SQ1144.2 +040600 WRT-LN. SQ1144.2 +040700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1144.2 +040800 MOVE SPACE TO DUMMY-RECORD. SQ1144.2 +040900 BLANK-LINE-PRINT. SQ1144.2 +041000 PERFORM WRT-LN. SQ1144.2 +041100 FAIL-ROUTINE. SQ1144.2 +041200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1144.2 +041300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1144.2 +041400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1144.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +041600 GO TO FAIL-ROUTINE-EX. SQ1144.2 +041700 FAIL-ROUTINE-WRITE. SQ1144.2 +041800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1144.2 +041900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +042000 FAIL-ROUTINE-EX. EXIT. SQ1144.2 +042100 BAIL-OUT. SQ1144.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1144.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1144.2 +042400 BAIL-OUT-WRITE. SQ1144.2 +042500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1144.2 +042600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1144.2 +042700 BAIL-OUT-EX. EXIT. SQ1144.2 +042800 CCVS1-EXIT. SQ1144.2 +042900 EXIT. SQ1144.2 +043000 SECT-SQ102-0001 SECTION. SQ1144.2 +043100 SEQ-INIT-001. SQ1144.2 +043200 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1144.2 +043300 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1144.2 +043400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1144.2 +043500 MOVE 000120 TO XRECORD-LENGTH (1). SQ1144.2 +043600 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1144.2 +043700 MOVE 0001 TO XBLOCK-SIZE (1). SQ1144.2 +043800 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1144.2 +043900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1144.2 +044000 MOVE "S" TO XLABEL-TYPE (1). SQ1144.2 +044100 MOVE 000001 TO XRECORD-NUMBER (1). SQ1144.2 +044200 OPEN-TEST-GF-01. SQ1144.2 +044300************************************************************** SQ1144.2 +044400* OPEN OUTPUT FILE-1, FILE-2. WILL BE TESTED IN THIS TEST.* SQ1144.2 +044500* VII; 4.3.2 (PAGE VII-39) * SQ1144.2 +044600************************************************************** SQ1144.2 +044700 SQ1144.2 +044800 MOVE SPACE TO FILE-STATUS-SQ-FS1. SQ1144.2 +044900 MOVE SPACE TO FILE-STATUS-SQ-FS2. SQ1144.2 +045000 OPEN OUTPUT SQ-FS1 SQ-FS2. SQ1144.2 +045100 IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +045200 OR FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +045300 GO TO OPEN-FAIL-GF-01. SQ1144.2 +045400 OPEN-PASS-GF-01. SQ1144.2 +045500 PERFORM PASS SQ1144.2 +045600 GO TO OPEN-WRITE-GF-01. SQ1144.2 +045700 OPEN-FAIL-GF-01. SQ1144.2 +045800 IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +045900 MOVE "STATUS 1: 00" TO CORRECT-A SQ1144.2 +046000 MOVE FILE-STATUS-SQ-FS1 TO COMPUTED-A SQ1144.2 +046100 MOVE "VII-39; 4.3.2 " TO RE-MARK SQ1144.2 +046200 PERFORM FAIL SQ1144.2 +046300 PERFORM OPEN-WRITE-GF-01. SQ1144.2 +046400 IF FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +046500 MOVE "STATUS 2: 00" TO CORRECT-A SQ1144.2 +046600 MOVE FILE-STATUS-SQ-FS2 TO COMPUTED-A SQ1144.2 +046700 MOVE "VII-39; 4.3.2 " TO RE-MARK SQ1144.2 +046800 PERFORM FAIL. SQ1144.2 +046900 OPEN-WRITE-GF-01. SQ1144.2 +047000 MOVE "OPEN-TEST-GF-01" TO PAR-NAME. SQ1144.2 +047100 MOVE "OPEN OUTPUT FIL1 FIL2" TO FEATURE. SQ1144.2 +047200 PERFORM PRINT-DETAIL. SQ1144.2 +047300 WRITE-TEST-GF-01. SQ1144.2 +047400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1144.2 +047500 WRITE SQ-FS1R1-F-G-120. SQ1144.2 +047600 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ1144.2 +047700 GO TO WRITE-WRITE-GF-01. SQ1144.2 +047800 ADD 1 TO XRECORD-NUMBER (1). SQ1144.2 +047900 GO TO WRITE-TEST-GF-01. SQ1144.2 +048000 WRITE-WRITE-GF-01. SQ1144.2 +048100 MOVE "WRITE FILE SQ-FS1" TO FEATURE. SQ1144.2 +048200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ1144.2 +048300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1144.2 +048400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1144.2 +048500 PERFORM PRINT-DETAIL. SQ1144.2 +048600 CLOSE SQ-FS1. SQ1144.2 +048700* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1144.2 +048800* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ1144.2 +048900 SEQ-INIT-002. SQ1144.2 +049000 MOVE ZERO TO WRK-CS-09V00. SQ1144.2 +049100* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1144.2 +049200* SEQ-TEST-001. SQ1144.2 +049300 OPEN INPUT SQ-FS1. SQ1144.2 +049400 SEQ-TEST-002. SQ1144.2 +049500 READ SQ-FS1 SQ1144.2 +049600 AT END GO TO SEQ-TEST-002-1. SQ1144.2 +049700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1144.2 +049800 ADD 1 TO WRK-CS-09V00. SQ1144.2 +049900 IF WRK-CS-09V00 GREATER THAN 750 SQ1144.2 +050000 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1144.2 +050100 GO TO SEQ-FAIL-002. SQ1144.2 +050200 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1144.2 +050300 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +050400 GO TO SEQ-TEST-002. SQ1144.2 +050500 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1144.2 +050600 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +050700 GO TO SEQ-TEST-002. SQ1144.2 +050800 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1144.2 +050900 ADD 1 TO RECORDS-IN-ERROR. SQ1144.2 +051000 GO TO SEQ-TEST-002. SQ1144.2 +051100 SEQ-TEST-002-1. SQ1144.2 +051200 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1144.2 +051300 GO TO SEQ-PASS-002. SQ1144.2 +051400 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1144.2 +051500 SEQ-FAIL-002. SQ1144.2 +051600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1144.2 +051700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1144.2 +051800 PERFORM FAIL. SQ1144.2 +051900 GO TO SEQ-WRITE-002. SQ1144.2 +052000 SEQ-PASS-002. SQ1144.2 +052100 PERFORM PASS. SQ1144.2 +052200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1144.2 +052300 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1144.2 +052400 SEQ-WRITE-002. SQ1144.2 +052500 MOVE "SEQ-TEST-002" TO PAR-NAME. SQ1144.2 +052600 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1144.2 +052700 PERFORM PRINT-DETAIL. SQ1144.2 +052800 SEQ-CLOSE-002. SQ1144.2 +052900 CLOSE SQ-FS1. SQ1144.2 +053000 READ-INIT-GF-01. SQ1144.2 +053100 MOVE ZERO TO WRK-CS-09V00. SQ1144.2 +053200 MOVE ZERO TO RECORDS-IN-ERROR. SQ1144.2 +053300 OPEN INPUT SQ-FS1. SQ1144.2 +053400* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1144.2 +053500* IN THIS SERIES OF TESTS. SQ1144.2 +053600 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1144.2 +053700 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1144.2 +053800 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +053900 READ-TEST-GF-01. SQ1144.2 +054000 READ SQ-FS1 RECORD AT END SQ1144.2 +054100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +054200 MOVE 1 TO EOF-FLAG SQ1144.2 +054300 GO TO READ-FAIL-GF-01. SQ1144.2 +054400 PERFORM RECORD-CHECK. SQ1144.2 +054500 IF WRK-CS-09V00 EQUAL TO 200 SQ1144.2 +054600 GO TO READ-TEST-GF-01-1. SQ1144.2 +054700 GO TO READ-TEST-GF-01. SQ1144.2 +054800 RECORD-CHECK. SQ1144.2 +054900 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1144.2 +055000 ADD 1 TO WRK-CS-09V00. SQ1144.2 +055100 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1144.2 +055200 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +055300 MOVE 1 TO ERROR-FLAG. SQ1144.2 +055400 READ-TEST-GF-01-1. SQ1144.2 +055500 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +055600 GO TO READ-PASS-GF-01. SQ1144.2 +055700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +055800 READ-FAIL-GF-01. SQ1144.2 +055900 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +056000 PERFORM FAIL. SQ1144.2 +056100 GO TO READ-WRITE-GF-01. SQ1144.2 +056200 READ-PASS-GF-01. SQ1144.2 +056300 PERFORM PASS. SQ1144.2 +056400 READ-WRITE-GF-01. SQ1144.2 +056500 PERFORM PRINT-DETAIL. SQ1144.2 +056600 READ-INIT-GF-02. SQ1144.2 +056700 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +056800 GO TO READ-EOF-GF-05. SQ1144.2 +056900 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +057000 MOVE "READ...AT END..." TO FEATURE. SQ1144.2 +057100 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1144.2 +057200 READ-TEST-GF-02. SQ1144.2 +057300 READ SQ-FS1 AT END SQ1144.2 +057400 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +057500 MOVE 1 TO EOF-FLAG SQ1144.2 +057600 GO TO READ-FAIL-GF-02. SQ1144.2 +057700 PERFORM RECORD-CHECK. SQ1144.2 +057800 IF WRK-CS-09V00 EQUAL TO 400 SQ1144.2 +057900 GO TO READ-TEST-GF-02-1. SQ1144.2 +058000 GO TO READ-TEST-GF-02. SQ1144.2 +058100 READ-TEST-GF-02-1. SQ1144.2 +058200 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +058300 GO TO READ-PASS-GF-02. SQ1144.2 +058400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +058500 READ-FAIL-GF-02. SQ1144.2 +058600 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +058700 PERFORM FAIL. SQ1144.2 +058800 GO TO READ-WRITE-GF-02. SQ1144.2 +058900 READ-PASS-GF-02. SQ1144.2 +059000 PERFORM PASS. SQ1144.2 +059100 READ-WRITE-GF-02. SQ1144.2 +059200 PERFORM PRINT-DETAIL. SQ1144.2 +059300 READ-INIT-GF-03. SQ1144.2 +059400 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +059500 GO TO READ-EOF-GF-05. SQ1144.2 +059600 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +059700 MOVE "READ...RECORD END..." TO RE-MARK. SQ1144.2 +059800 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1144.2 +059900 READ-TEST-GF-03. SQ1144.2 +060000 READ SQ-FS1 RECORD END SQ1144.2 +060100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +060200 MOVE 1 TO EOF-FLAG SQ1144.2 +060300 GO TO READ-FAIL-GF-03. SQ1144.2 +060400 PERFORM RECORD-CHECK. SQ1144.2 +060500 IF WRK-CS-09V00 EQUAL TO 600 SQ1144.2 +060600 GO TO READ-TEST-GF-03-1. SQ1144.2 +060700 GO TO READ-TEST-GF-03. SQ1144.2 +060800 READ-TEST-GF-03-1. SQ1144.2 +060900 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +061000 GO TO READ-PASS-GF-03. SQ1144.2 +061100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +061200 READ-FAIL-GF-03. SQ1144.2 +061300 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +061400 PERFORM FAIL. SQ1144.2 +061500 GO TO READ-WRITE-GF-03. SQ1144.2 +061600 READ-PASS-GF-03. SQ1144.2 +061700 PERFORM PASS. SQ1144.2 +061800 READ-WRITE-GF-03. SQ1144.2 +061900 PERFORM PRINT-DETAIL. SQ1144.2 +062000 READ-INIT-GF-04. SQ1144.2 +062100 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +062200 GO TO READ-EOF-GF-05. SQ1144.2 +062300 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +062400 MOVE "READ...END..." TO FEATURE. SQ1144.2 +062500 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1144.2 +062600 READ-TEST-GF-04. SQ1144.2 +062700 READ SQ-FS1 END GO TO READ-TEST-GF-04-1. SQ1144.2 +062800 PERFORM RECORD-CHECK. SQ1144.2 +062900 IF WRK-CS-09V00 GREATER THAN 750 SQ1144.2 +063000 GO TO READ-TEST-GF-04-1. SQ1144.2 +063100 GO TO READ-TEST-GF-04. SQ1144.2 +063200 READ-TEST-GF-04-1. SQ1144.2 +063300 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +063400 GO TO READ-PASS-GF-04. SQ1144.2 +063500 READ-FAIL-GF-04. SQ1144.2 +063600 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +063700 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +063800 PERFORM FAIL. SQ1144.2 +063900 GO TO READ-WRITE-GF-04. SQ1144.2 +064000 READ-PASS-GF-04. SQ1144.2 +064100 PERFORM PASS. SQ1144.2 +064200 READ-WRITE-GF-04. SQ1144.2 +064300 PERFORM PRINT-DETAIL. SQ1144.2 +064400 READ-TEST-GF-05. SQ1144.2 +064500 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1144.2 +064600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1144.2 +064700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1144.2 +064800 GO TO READ-FAIL-GF-05. SQ1144.2 +064900 IF WRK-CS-09V00 GREATER THAN 750 SQ1144.2 +065000 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1144.2 +065100 GO TO READ-FAIL-GF-05. SQ1144.2 +065200 READ-PASS-GF-05. SQ1144.2 +065300 PERFORM PASS. SQ1144.2 +065400 GO TO READ-WRITE-GF-05. SQ1144.2 +065500 READ-EOF-GF-05. SQ1144.2 +065600 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. SQ1144.2 +065700 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1144.2 +065800 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1144.2 +065900 READ-FAIL-GF-05. SQ1144.2 +066000 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +066100 PERFORM FAIL. SQ1144.2 +066200 READ-WRITE-GF-05. SQ1144.2 +066300 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1144.2 +066400 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ1144.2 +066500 PERFORM PRINT-DETAIL. SQ1144.2 +066600 READ-CLOSE-GF-05. SQ1144.2 +066700 CLOSE SQ-FS1. SQ1144.2 +066800 CLOSE SQ-FS2. SQ1144.2 +066900 SECT-SQ104-0001 SECTION. SQ1144.2 +067000 OPEN-TEST-GF-02. SQ1144.2 +067100 OPEN OUTPUT SQ-FS3. SQ1144.2 +067200 IF FILE-STATUS-SQ-FS3 NOT = "00" SQ1144.2 +067300 GO TO OPEN-FAIL-GF-03. SQ1144.2 +067400 OPEN-PASS-GF-01. SQ1144.2 +067500 PERFORM PASS SQ1144.2 +067600 GO TO OPEN-WRITE-GF-02. SQ1144.2 +067700 OPEN-FAIL-GF-02. SQ1144.2 +067800 IF FILE-STATUS-SQ-FS3 NOT = "00" SQ1144.2 +067900 MOVE "STATUS 3: 00" TO CORRECT-A SQ1144.2 +068000 MOVE FILE-STATUS-SQ-FS3 TO COMPUTED-A SQ1144.2 +068100 MOVE "VII-39; 4.3.2 " TO RE-MARK SQ1144.2 +068200 PERFORM FAIL. SQ1144.2 +068300 OPEN-WRITE-GF-02. SQ1144.2 +068400 MOVE "OPEN-TEST-GF-02" TO PAR-NAME. SQ1144.2 +068500 MOVE "OPEN OUTPUT FIL3" TO FEATURE. SQ1144.2 +068600 PERFORM PRINT-DETAIL. SQ1144.2 +068700 WRITE-INIT-GF-02. SQ1144.2 +068800 MOVE "SQ-FS3" TO XFILE-NAME (2). SQ1144.2 +068900 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ1144.2 +069000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (2). SQ1144.2 +069100 MOVE 120 TO XRECORD-LENGTH (2). SQ1144.2 +069200 MOVE "CH" TO CHARS-OR-RECORDS (2). SQ1144.2 +069300 MOVE 120 TO XBLOCK-SIZE (2). SQ1144.2 +069400 MOVE 000649 TO RECORDS-IN-FILE (2). SQ1144.2 +069500 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ1144.2 +069600 MOVE "S" TO XLABEL-TYPE (2). SQ1144.2 +069700 MOVE 000001 TO XRECORD-NUMBER (2). SQ1144.2 +069800 WRITE-TEST-GF-02. SQ1144.2 +069900 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS3R1-F-G-120. SQ1144.2 +070000 WRITE SQ-FS3R1-F-G-120. SQ1144.2 +070100 IF XRECORD-NUMBER (2) EQUAL TO 649 SQ1144.2 +070200 GO TO WRITE-WRITE-GF-02. SQ1144.2 +070300 ADD 1 TO XRECORD-NUMBER (2). SQ1144.2 +070400 GO TO WRITE-TEST-GF-02. SQ1144.2 +070500 WRITE-WRITE-GF-02. SQ1144.2 +070600 MOVE "WRITE SQ-FS3 649RE" TO FEATURE. SQ1144.2 +070700 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ1144.2 +070800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1144.2 +070900 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ1144.2 +071000 PERFORM PRINT-DETAIL. SQ1144.2 +071100 CLOSE SQ-FS3. SQ1144.2 +071200* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTER SQ1144.2 +071300* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. SQ1144.2 +071400 READ-INIT-GF-06. SQ1144.2 +071500 MOVE ZERO TO WRK-CS-09V00. SQ1144.2 +071600 MOVE ZERO TO RECORDS-IN-ERROR. SQ1144.2 +071700* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1144.2 +071800* READ-TEST-007. SQ1144.2 +071900 OPEN INPUT SQ-FS3. SQ1144.2 +072000 READ-TEST-GF-06. SQ1144.2 +072100 READ SQ-FS3 RECORD SQ1144.2 +072200 AT END GO TO READ-TEST-GF-06-1. SQ1144.2 +072300 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1144.2 +072400 ADD 1 TO WRK-CS-09V00. SQ1144.2 +072500 IF WRK-CS-09V00 GREATER THAN 649 SQ1144.2 +072600 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1144.2 +072700 GO TO READ-FAIL-GF-06. SQ1144.2 +072800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (2) SQ1144.2 +072900 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +073000 GO TO READ-TEST-GF-06. SQ1144.2 +073100 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS3" SQ1144.2 +073200 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +073300 GO TO READ-TEST-GF-06. SQ1144.2 +073400 IF XLABEL-TYPE (2) NOT EQUAL TO "S" SQ1144.2 +073500 ADD 1 TO RECORDS-IN-ERROR. SQ1144.2 +073600 GO TO READ-TEST-GF-06. SQ1144.2 +073700 READ-TEST-GF-06-1. SQ1144.2 +073800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1144.2 +073900 GO TO READ-PASS-GF-06. SQ1144.2 +074000 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. SQ1144.2 +074100 READ-FAIL-GF-06. SQ1144.2 +074200 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1144.2 +074300 PERFORM FAIL. SQ1144.2 +074400 GO TO READ-WRITE-GF-06. SQ1144.2 +074500 READ-PASS-GF-06. SQ1144.2 +074600 PERFORM PASS. SQ1144.2 +074700 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1144.2 +074800 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1144.2 +074900 READ-WRITE-GF-06. SQ1144.2 +075000 MOVE "READ-TEST-GF-06" TO PAR-NAME. SQ1144.2 +075100 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. SQ1144.2 +075200 PERFORM PRINT-DETAIL. SQ1144.2 +075300 READ-CLOSE-GF-06. SQ1144.2 +075400 CLOSE SQ-FS3. SQ1144.2 +075500 READ-INIT-GF-07. SQ1144.2 +075600 MOVE ZERO TO WRK-CS-09V00. SQ1144.2 +075700 MOVE ZERO TO RECORDS-IN-ERROR. SQ1144.2 +075800 OPEN INPUT SQ-FS3. SQ1144.2 +075900* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1144.2 +076000* IN THIS SERIES OF TESTS. SQ1144.2 +076100 MOVE "LEV 1 READ STATEMENT" TO FEATURE. SQ1144.2 +076200 MOVE ZERO TO EOF-FLAG. SQ1144.2 +076300 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1144.2 +076400 MOVE "READ-TEST-GF-07" TO PAR-NAME. SQ1144.2 +076500 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +076600 READ-TEST-GF-07. SQ1144.2 +076700 READ SQ-FS3 RECORD SQ1144.2 +076800 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +076900 MOVE 1 TO EOF-FLAG SQ1144.2 +077000 GO TO READ-FAIL-GF-07. SQ1144.2 +077100 PERFORM RECORD-CHECK-1. SQ1144.2 +077200 IF WRK-CS-09V00 EQUAL TO 50 SQ1144.2 +077300 GO TO READ-TEST-GF-07-1. SQ1144.2 +077400 GO TO READ-TEST-GF-07. SQ1144.2 +077500 RECORD-CHECK-1. SQ1144.2 +077600 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1144.2 +077700 ADD 1 TO WRK-CS-09V00. SQ1144.2 +077800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (2) SQ1144.2 +077900 ADD 1 TO RECORDS-IN-ERROR SQ1144.2 +078000 MOVE 1 TO ERROR-FLAG. SQ1144.2 +078100 READ-TEST-GF-07-1. SQ1144.2 +078200 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +078300 GO TO READ-PASS-GF-07. SQ1144.2 +078400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +078500 READ-FAIL-GF-07. SQ1144.2 +078600 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +078700 PERFORM FAIL. SQ1144.2 +078800 GO TO READ-WRITE-GF-07. SQ1144.2 +078900 READ-PASS-GF-07. SQ1144.2 +079000 PERFORM PASS. SQ1144.2 +079100 READ-WRITE-GF-07. SQ1144.2 +079200 PERFORM PRINT-DETAIL. SQ1144.2 +079300 READ-INIT-GF-08. SQ1144.2 +079400 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +079500 GO TO READ-EOF-GF-11. SQ1144.2 +079600 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +079700 MOVE "READ...AT END..." TO FEATURE. SQ1144.2 +079800 MOVE "READ-TEST-GF-08" TO PAR-NAME. SQ1144.2 +079900 READ-TEST-GF-08. SQ1144.2 +080000 READ SQ-FS3 AT END SQ1144.2 +080100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +080200 MOVE 1 TO EOF-FLAG SQ1144.2 +080300 GO TO READ-FAIL-GF-08. SQ1144.2 +080400 PERFORM RECORD-CHECK-1. SQ1144.2 +080500 IF WRK-CS-09V00 EQUAL TO 200 SQ1144.2 +080600 GO TO READ-TEST-GF-08-1. SQ1144.2 +080700 GO TO READ-TEST-GF-08. SQ1144.2 +080800 READ-TEST-GF-08-1. SQ1144.2 +080900 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +081000 GO TO READ-PASS-GF-08. SQ1144.2 +081100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +081200 READ-FAIL-GF-08. SQ1144.2 +081300 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +081400 PERFORM FAIL. SQ1144.2 +081500 GO TO READ-WRITE-GF-08. SQ1144.2 +081600 READ-PASS-GF-08. SQ1144.2 +081700 PERFORM PASS. SQ1144.2 +081800 READ-WRITE-GF-08. SQ1144.2 +081900 PERFORM PRINT-DETAIL. SQ1144.2 +082000 READ-INIT-GF-09. SQ1144.2 +082100 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +082200 GO TO READ-EOF-GF-11. SQ1144.2 +082300 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +082400 MOVE "READ...RECORD END..." TO FEATURE. SQ1144.2 +082500 MOVE "READ-TEST-GF-09" TO PAR-NAME. SQ1144.2 +082600 READ-TEST-GF-09. SQ1144.2 +082700 READ SQ-FS3 RECORD END SQ1144.2 +082800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1144.2 +082900 MOVE 1 TO EOF-FLAG SQ1144.2 +083000 GO TO READ-FAIL-GF-09. SQ1144.2 +083100 PERFORM RECORD-CHECK-1. SQ1144.2 +083200 IF WRK-CS-09V00 EQUAL TO 499 SQ1144.2 +083300 GO TO READ-TEST-GF-09-1. SQ1144.2 +083400 GO TO READ-TEST-GF-09. SQ1144.2 +083500 READ-TEST-GF-09-1. SQ1144.2 +083600 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +083700 GO TO READ-PASS-GF-09. SQ1144.2 +083800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +083900 READ-FAIL-GF-09. SQ1144.2 +084000 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +084100 PERFORM FAIL. SQ1144.2 +084200 GO TO READ-WRITE-GF-09. SQ1144.2 +084300 READ-PASS-GF-09. SQ1144.2 +084400 PERFORM PASS. SQ1144.2 +084500 READ-WRITE-GF-09. SQ1144.2 +084600 PERFORM PRINT-DETAIL. SQ1144.2 +084700 READ-INIT-GF-10. SQ1144.2 +084800 IF EOF-FLAG EQUAL TO 1 SQ1144.2 +084900 GO TO READ-EOF-GF-11. SQ1144.2 +085000 MOVE ZERO TO ERROR-FLAG. SQ1144.2 +085100 MOVE "READ...END..." TO FEATURE. SQ1144.2 +085200 MOVE "READ-TEST-GF-10" TO PAR-NAME. SQ1144.2 +085300 READ-TEST-GF-10. SQ1144.2 +085400 READ SQ-FS3 END SQ1144.2 +085500 GO TO READ-TEST-GF-10-1. SQ1144.2 +085600 PERFORM RECORD-CHECK-1. SQ1144.2 +085700 IF WRK-CS-09V00 GREATER THAN 649 SQ1144.2 +085800 GO TO READ-TEST-GF-10-1. SQ1144.2 +085900 GO TO READ-TEST-GF-10. SQ1144.2 +086000 READ-TEST-GF-10-1. SQ1144.2 +086100 IF ERROR-FLAG EQUAL TO ZERO SQ1144.2 +086200 GO TO READ-PASS-GF-10. SQ1144.2 +086300 READ-FAIL-GF-10. SQ1144.2 +086400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1144.2 +086500 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK.SQ1144.2 +086600 PERFORM FAIL. SQ1144.2 +086700 GO TO READ-WRITE-GF-10. SQ1144.2 +086800 READ-PASS-GF-10. SQ1144.2 +086900 PERFORM PASS. SQ1144.2 +087000 READ-WRITE-GF-10. SQ1144.2 +087100 PERFORM PRINT-DETAIL. SQ1144.2 +087200 READ-TEST-GF-11. SQ1144.2 +087300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1144.2 +087400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1144.2 +087500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1144.2 +087600 GO TO READ-FAIL-GF-11. SQ1144.2 +087700 IF WRK-CS-09V00 GREATER THAN 649 SQ1144.2 +087800 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1144.2 +087900 GO TO READ-FAIL-GF-11. SQ1144.2 +088000 READ-PASS-GF-11. SQ1144.2 +088100 PERFORM PASS SQ1144.2 +088200 GO TO READ-WRITE-GF-11. SQ1144.2 +088300 READ-EOF-GF-11. SQ1144.2 +088400 MOVE "LESS THAN 649 RECORDS" TO RE-MARK. SQ1144.2 +088500 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1144.2 +088600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1144.2 +088700 READ-FAIL-GF-11. SQ1144.2 +088800 PERFORM FAIL. SQ1144.2 +088900 READ-WRITE-GF-11. SQ1144.2 +089000 MOVE "READ-TEST-GF-11" TO PAR-NAME. SQ1144.2 +089100 MOVE "READ FILE SQ-FS3" TO FEATURE. SQ1144.2 +089200 PERFORM PRINT-DETAIL. SQ1144.2 +089300 READ-CLOSE-GF-11. SQ1144.2 +089400 CLOSE SQ-FS3. SQ1144.2 +089500 OPEN-TEST-GF-03. SQ1144.2 +089600************************************************************** SQ1144.2 +089700* OPEN OUTPUT FILE-1, FILE-2. WILL BE TESTED IN THIS TEST.* SQ1144.2 +089800* VII; 4.3.2 (PAGE VII-39) * SQ1144.2 +089900************************************************************** SQ1144.2 +090000 SQ1144.2 +090100 MOVE SPACE TO FILE-STATUS-SQ-FS1. SQ1144.2 +090200 MOVE SPACE TO FILE-STATUS-SQ-FS2. SQ1144.2 +090300 OPEN INPUT SQ-FS1 SQ-FS2. SQ1144.2 +090400 IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +090500 OR FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +090600 GO TO OPEN-FAIL-GF-02. SQ1144.2 +090700 OPEN-PASS-GF-03. SQ1144.2 +090800 PERFORM PASS SQ1144.2 +090900 GO TO OPEN-WRITE-GF-03. SQ1144.2 +091000 OPEN-FAIL-GF-03. SQ1144.2 +091100 IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +091200 MOVE "STATUS 1: 00" TO CORRECT-A SQ1144.2 +091300 MOVE FILE-STATUS-SQ-FS1 TO COMPUTED-A SQ1144.2 +091400 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK SQ1144.2 +091500 PERFORM FAIL SQ1144.2 +091600 PERFORM OPEN-WRITE-GF-03. SQ1144.2 +091700 IF FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +091800 MOVE "STATUS 2: 00" TO CORRECT-A SQ1144.2 +091900 MOVE FILE-STATUS-SQ-FS2 TO COMPUTED-A SQ1144.2 +092000 MOVE "VII-15; 2.10.2; VII-44; 4.4.2 " TO RE-MARK SQ1144.2 +092100 PERFORM FAIL. SQ1144.2 +092200 OPEN-WRITE-GF-03. SQ1144.2 +092300 MOVE "OPEN-TEST-GF-03" TO PAR-NAME. SQ1144.2 +092400 MOVE "OPEN INPUT FILE1, FILE2" TO FEATURE. SQ1144.2 +092500 PERFORM PRINT-DETAIL. SQ1144.2 +092600 SQ1144.2 +092700*CLOSE-TEST-GF-01. SQ1144.2 +092800******************************************************************SQ1144.2 +092900* CLOSE FILE-1, FILE-2 WITH LOCK. WILL BE TESTED IN THIS TEST. *SQ1144.2 +093000* VII; 4.2 (PAGE VII-35) *SQ1144.2 +093100******************************************************************SQ1144.2 +093200 SQ1144.2 +093300* MOVE SPACE TO FILE-STATUS-SQ-FS1. SQ1144.2 +093400* MOVE SPACE TO FILE-STATUS-SQ-FS2. SQ1144.2 +093500* CLOSE SQ-FS1 WITH LOCK, SQ-FS2 WITH LOCK. SQ1144.2 +093600* IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +093700* OR FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +093800* GO TO CLOSE-FAIL-GF-01. SQ1144.2 +093900*CLOSE-PASS-GF-01. SQ1144.2 +094000* PERFORM PASS SQ1144.2 +094100* GO TO CLOSE-WRITE-GF-01. SQ1144.2 +094200*CLOSE-FAIL-GF-01. SQ1144.2 +094300* IF FILE-STATUS-SQ-FS1 NOT = "00" SQ1144.2 +094400* MOVE "STATUS 1: 00" TO CORRECT-A SQ1144.2 +094500* MOVE FILE-STATUS-SQ-FS1 TO COMPUTED-A SQ1144.2 +094600* MOVE "VII-35; 4.2.2 " TO RE-MARK SQ1144.2 +094700* PERFORM FAIL SQ1144.2 +094800* PERFORM CLOSE-WRITE-GF-01. SQ1144.2 +094900* IF FILE-STATUS-SQ-FS2 NOT = "00" SQ1144.2 +095000* MOVE "STATUS 2: 00" TO CORRECT-A SQ1144.2 +095100* MOVE FILE-STATUS-SQ-FS2 TO COMPUTED-A SQ1144.2 +095200* MOVE "VII-35; 4.2.2 " TO RE-MARK SQ1144.2 +095300* PERFORM FAIL. SQ1144.2 +095400*CLOSE-WRITE-GF-01. SQ1144.2 +095500* MOVE "CLOSE-TEST-GF-01" TO PAR-NAME. SQ1144.2 +095600* MOVE "CLOSE FILE1, FILE2" TO FEATURE. SQ1144.2 +095700* PERFORM PRINT-DETAIL. SQ1144.2 +095800 TERMINATE-ROUTINE. SQ1144.2 +095900 EXIT. SQ1144.2 +096000 CCVS-EXIT SECTION. SQ1144.2 +096100 CCVS-999999. SQ1144.2 +096200 GO TO CLOSE-FILES. SQ1144.2 diff --git a/tests/cobol85/SQ/SQ115A.CBL b/tests/cobol85/SQ/SQ115A.CBL new file mode 100755 index 00000000..d53487e5 --- /dev/null +++ b/tests/cobol85/SQ/SQ115A.CBL @@ -0,0 +1,584 @@ +000100 IDENTIFICATION DIVISION. SQ1154.2 +000200 PROGRAM-ID. SQ1154.2 +000300 SQ115A. SQ1154.2 +000400**************************************************************** SQ1154.2 +000500* * SQ1154.2 +000600* VALIDATION FOR:- * SQ1154.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1154.2 +000800* * SQ1154.2 +000900* CREATION DATE / VALIDATION DATE * SQ1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1154.2 +001100* * SQ1154.2 +001200**************************************************************** SQ1154.2 +001300 SQ1154.2 +001400* THIS ROUTINE CREATES A MASS STORAGE FILE CONTAINING SQ1154.2 +001500* 550 RECORDS. EACH RECORD CONTAINS 126 CHARACTERS. THE SQ1154.2 +001600* FILE IS CLOSED AND OPENED AS AN INPUT-OUTPUT FILE. EVERY SQ1154.2 +001700* TENTH RECORD IS REWRITTEN. THE FILE IS CLOSED AND OPENED SQ1154.2 +001800* AGAIN AS AN INPUT FILE. FIELDS IN EACH RECORD ARE CHECKED SQ1154.2 +001900* TO ENSURE THAT THE RECORDS REWRITTEN ARE CORRECT AND THAT SQ1154.2 +002000* THE RECORDS WHICH WERE NOT UPDATED WERE NOT CHANGED. SQ1154.2 +002100* SQ1154.2 +002200* USED X-CARDS: SQ1154.2 +002300* XXXXX014 SQ1154.2 +002400* XXXXX055 SQ1154.2 +002500* P XXXXX062 SQ1154.2 +002600* XXXXX082 SQ1154.2 +002700* XXXXX083 SQ1154.2 +002800* C XXXXX084 SQ1154.2 +002900* SQ1154.2 +003000* SQ1154.2 +003100 ENVIRONMENT DIVISION. SQ1154.2 +003200 CONFIGURATION SECTION. SQ1154.2 +003300 SOURCE-COMPUTER. SQ1154.2 +003400 Linux. SQ1154.2 +003500 OBJECT-COMPUTER. SQ1154.2 +003600 Linux. SQ1154.2 +003700 INPUT-OUTPUT SECTION. SQ1154.2 +003800 FILE-CONTROL. SQ1154.2 +003900*P SELECT RAW-DATA ASSIGN TO SQ1154.2 +004000*P "XXXXX062" SQ1154.2 +004100*P ORGANIZATION IS INDEXED SQ1154.2 +004200*P ACCESS MODE IS RANDOM SQ1154.2 +004300*P RECORD KEY IS RAW-DATA-KEY. SQ1154.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1154.2 +004500 "report.log". SQ1154.2 +004600 SELECT SQ-FS5 ASSIGN SQ1154.2 +004700 "XXXXX014" SQ1154.2 +004800 ORGANIZATION SEQUENTIAL SQ1154.2 +004900 ACCESS MODE SEQUENTIAL. SQ1154.2 +005000 DATA DIVISION. SQ1154.2 +005100 FILE SECTION. SQ1154.2 +005200*P SQ1154.2 +005300*PD RAW-DATA. SQ1154.2 +005400*P SQ1154.2 +005500*P1 RAW-DATA-SATZ. SQ1154.2 +005600*P 05 RAW-DATA-KEY PIC X(6). SQ1154.2 +005700*P 05 C-DATE PIC 9(6). SQ1154.2 +005800*P 05 C-TIME PIC 9(8). SQ1154.2 +005900*P 05 C-NO-OF-TESTS PIC 99. SQ1154.2 +006000*P 05 C-OK PIC 999. SQ1154.2 +006100*P 05 C-ALL PIC 999. SQ1154.2 +006200*P 05 C-FAIL PIC 999. SQ1154.2 +006300*P 05 C-DELETED PIC 999. SQ1154.2 +006400*P 05 C-INSPECT PIC 999. SQ1154.2 +006500*P 05 C-NOTE PIC X(13). SQ1154.2 +006600*P 05 C-INDENT PIC X. SQ1154.2 +006700*P 05 C-ABORT PIC X(8). SQ1154.2 +006800 FD PRINT-FILE SQ1154.2 +006900*C LABEL RECORDS SQ1154.2 +007000*C OMITTED SQ1154.2 +007100*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1154.2 +007200 . SQ1154.2 +007300 01 PRINT-REC PICTURE X(120). SQ1154.2 +007400 01 DUMMY-RECORD PICTURE X(120). SQ1154.2 +007500 FD SQ-FS5 SQ1154.2 +007600*C LABEL RECORD STANDARD SQ1154.2 +007700 . SQ1154.2 +007800 01 SQ-FS5R1-F-G-126. SQ1154.2 +007900 02 SQ-FS5-120 PICTURE X(120). SQ1154.2 +008000 02 SQ-FS5-UPDATE PICTURE X(6). SQ1154.2 +008100 WORKING-STORAGE SECTION. SQ1154.2 +008200 01 COUNT-OF-RECORDS PIC S9(5) COMPUTATIONAL. SQ1154.2 +008300 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. SQ1154.2 +008400 01 ERROR-FLAG PIC 9. SQ1154.2 +008500 01 EOF-FLAG PIC 9. SQ1154.2 +008600 01 LOOP-COUNT PIC 99. SQ1154.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1154.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1154.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1154.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1154.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1154.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1154.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1154.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1154.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1154.2 +009600 ",RECKEY= ". SQ1154.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1154.2 +009800 ",ALTKEY1= ". SQ1154.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1154.2 +010000 ",ALTKEY2= ". SQ1154.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1154.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1154.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1154.2 +010400 07 FILLER PIC X(5). SQ1154.2 +010500 07 XFILE-NAME PIC X(6). SQ1154.2 +010600 07 FILLER PIC X(8). SQ1154.2 +010700 07 XRECORD-NAME PIC X(6). SQ1154.2 +010800 07 FILLER PIC X(1). SQ1154.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1154.2 +011000 07 FILLER PIC X(7). SQ1154.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1154.2 +011200 07 FILLER PIC X(6). SQ1154.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1154.2 +011400 07 FILLER PIC X(5). SQ1154.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1154.2 +011600 07 FILLER PIC X(5). SQ1154.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1154.2 +011800 07 FILLER PIC X(7). SQ1154.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1154.2 +012000 07 FILLER PIC X(7). SQ1154.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1154.2 +012200 07 FILLER PIC X(1). SQ1154.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1154.2 +012400 07 FILLER PIC X(6). SQ1154.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1154.2 +012600 07 FILLER PIC X(5). SQ1154.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1154.2 +012800 07 FILLER PIC X(6). SQ1154.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1154.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1154.2 +013100 07 FILLER PIC X(8). SQ1154.2 +013200 07 XRECORD-KEY PIC X(29). SQ1154.2 +013300 07 FILLER PIC X(9). SQ1154.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1154.2 +013500 07 FILLER PIC X(9). SQ1154.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1154.2 +013700 07 FILLER PIC X(7). SQ1154.2 +013800 01 TEST-RESULTS. SQ1154.2 +013900 02 FILLER PICTURE X VALUE SPACE. SQ1154.2 +014000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1154.2 +014100 02 FILLER PICTURE X VALUE SPACE. SQ1154.2 +014200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1154.2 +014300 02 FILLER PICTURE X VALUE SPACE. SQ1154.2 +014400 02 PAR-NAME. SQ1154.2 +014500 03 FILLER PICTURE X(12) VALUE SPACE. SQ1154.2 +014600 03 PARDOT-X PICTURE X VALUE SPACE. SQ1154.2 +014700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1154.2 +014800 03 FILLER PIC X(5) VALUE SPACE. SQ1154.2 +014900 02 FILLER PIC X(10) VALUE SPACE. SQ1154.2 +015000 02 RE-MARK PIC X(61). SQ1154.2 +015100 01 TEST-COMPUTED. SQ1154.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1154.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1154.2 +015400 02 COMPUTED-X. SQ1154.2 +015500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1154.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1154.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1154.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1154.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1154.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1154.2 +016100 04 COMPUTED-18V0 PICTURE -9(18). SQ1154.2 +016200 04 FILLER PICTURE X. SQ1154.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1154.2 +016400 01 TEST-CORRECT. SQ1154.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1154.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1154.2 +016700 02 CORRECT-X. SQ1154.2 +016800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1154.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1154.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1154.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1154.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1154.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1154.2 +017400 04 CORRECT-18V0 PICTURE -9(18). SQ1154.2 +017500 04 FILLER PICTURE X. SQ1154.2 +017600 03 FILLER PIC X(50) VALUE SPACE. SQ1154.2 +017700 01 CCVS-C-1. SQ1154.2 +017800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1154.2 +017900- "SS PARAGRAPH-NAME SQ1154.2 +018000- " REMARKS". SQ1154.2 +018100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1154.2 +018200 01 CCVS-C-2. SQ1154.2 +018300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1154.2 +018400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1154.2 +018500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1154.2 +018600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1154.2 +018700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1154.2 +018800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1154.2 +018900 01 REC-CT PICTURE 99 VALUE ZERO. SQ1154.2 +019000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1154.2 +019100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1154.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1154.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1154.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1154.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1154.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1154.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1154.2 +019800 01 CCVS-H-1. SQ1154.2 +019900 02 FILLER PICTURE X(27) VALUE SPACE. SQ1154.2 +020000 02 FILLER PICTURE X(67) VALUE SQ1154.2 +020100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1154.2 +020200- " SYSTEM". SQ1154.2 +020300 02 FILLER PICTURE X(26) VALUE SPACE. SQ1154.2 +020400 01 CCVS-H-2. SQ1154.2 +020500 02 FILLER PICTURE X(52) VALUE IS SQ1154.2 +020600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1154.2 +020700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1154.2 +020800 02 TEST-ID PICTURE IS X(9). SQ1154.2 +020900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1154.2 +021000 01 CCVS-H-3. SQ1154.2 +021100 02 FILLER PICTURE X(34) VALUE SQ1154.2 +021200 " FOR OFFICIAL USE ONLY ". SQ1154.2 +021300 02 FILLER PICTURE X(58) VALUE SQ1154.2 +021400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1154.2 +021500 02 FILLER PICTURE X(28) VALUE SQ1154.2 +021600 " COPYRIGHT 1985 ". SQ1154.2 +021700 01 CCVS-E-1. SQ1154.2 +021800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1154.2 +021900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1154.2 +022000 02 ID-AGAIN PICTURE IS X(9). SQ1154.2 +022100 02 FILLER PICTURE X(45) VALUE IS SQ1154.2 +022200 " NTIS DISTRIBUTION COBOL 85". SQ1154.2 +022300 01 CCVS-E-2. SQ1154.2 +022400 02 FILLER PICTURE X(31) VALUE SQ1154.2 +022500 SPACE. SQ1154.2 +022600 02 FILLER PICTURE X(21) VALUE SPACE. SQ1154.2 +022700 02 CCVS-E-2-2. SQ1154.2 +022800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1154.2 +022900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1154.2 +023000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1154.2 +023100 01 CCVS-E-3. SQ1154.2 +023200 02 FILLER PICTURE X(22) VALUE SQ1154.2 +023300 " FOR OFFICIAL USE ONLY". SQ1154.2 +023400 02 FILLER PICTURE X(12) VALUE SPACE. SQ1154.2 +023500 02 FILLER PICTURE X(58) VALUE SQ1154.2 +023600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1154.2 +023700 02 FILLER PICTURE X(13) VALUE SPACE. SQ1154.2 +023800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1154.2 +023900 01 CCVS-E-4. SQ1154.2 +024000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1154.2 +024100 02 FILLER PIC XXXX VALUE " OF ". SQ1154.2 +024200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1154.2 +024300 02 FILLER PIC X(40) VALUE SQ1154.2 +024400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1154.2 +024500 01 XXINFO. SQ1154.2 +024600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1154.2 +024700 02 INFO-TEXT. SQ1154.2 +024800 04 FILLER PIC X(20) VALUE SPACE. SQ1154.2 +024900 04 XXCOMPUTED PIC X(20). SQ1154.2 +025000 04 FILLER PIC X(5) VALUE SPACE. SQ1154.2 +025100 04 XXCORRECT PIC X(20). SQ1154.2 +025200 01 HYPHEN-LINE. SQ1154.2 +025300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1154.2 +025400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1154.2 +025500- "*****************************************". SQ1154.2 +025600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1154.2 +025700- "******************************". SQ1154.2 +025800 01 CCVS-PGM-ID PIC X(6) VALUE SQ1154.2 +025900 "SQ115A". SQ1154.2 +026000 PROCEDURE DIVISION. SQ1154.2 +026100 CCVS1 SECTION. SQ1154.2 +026200 OPEN-FILES. SQ1154.2 +026300*P OPEN I-O RAW-DATA. SQ1154.2 +026400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1154.2 +026500*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1154.2 +026600*P MOVE "ABORTED " TO C-ABORT. SQ1154.2 +026700*P ADD 1 TO C-NO-OF-TESTS. SQ1154.2 +026800*P ACCEPT C-DATE FROM DATE. SQ1154.2 +026900*P ACCEPT C-TIME FROM TIME. SQ1154.2 +027000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1154.2 +027100*PND-E-1. SQ1154.2 +027200*P CLOSE RAW-DATA. SQ1154.2 +027300 OPEN OUTPUT PRINT-FILE. SQ1154.2 +027400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1154.2 +027500 MOVE SPACE TO TEST-RESULTS. SQ1154.2 +027600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1154.2 +027700 MOVE ZERO TO REC-SKL-SUB. SQ1154.2 +027800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1154.2 +027900 CCVS-INIT-FILE. SQ1154.2 +028000 ADD 1 TO REC-SKL-SUB. SQ1154.2 +028100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1154.2 +028200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1154.2 +028300 CCVS-INIT-EXIT. SQ1154.2 +028400 GO TO CCVS1-EXIT. SQ1154.2 +028500 CLOSE-FILES. SQ1154.2 +028600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1154.2 +028700*P OPEN I-O RAW-DATA. SQ1154.2 +028800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1154.2 +028900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1154.2 +029000*P MOVE "OK. " TO C-ABORT. SQ1154.2 +029100*P MOVE PASS-COUNTER TO C-OK. SQ1154.2 +029200*P MOVE ERROR-HOLD TO C-ALL. SQ1154.2 +029300*P MOVE ERROR-COUNTER TO C-FAIL. SQ1154.2 +029400*P MOVE DELETE-CNT TO C-DELETED. SQ1154.2 +029500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1154.2 +029600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1154.2 +029700*PND-E-2. SQ1154.2 +029800*P CLOSE RAW-DATA. SQ1154.2 +029900 TERMINATE-CCVS. SQ1154.2 +030000*S EXIT PROGRAM. SQ1154.2 +030100*SERMINATE-CALL. SQ1154.2 +030200 STOP RUN. SQ1154.2 +030300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1154.2 +030400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1154.2 +030500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1154.2 +030600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1154.2 +030700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1154.2 +030800 PRINT-DETAIL. SQ1154.2 +030900 IF REC-CT NOT EQUAL TO ZERO SQ1154.2 +031000 MOVE "." TO PARDOT-X SQ1154.2 +031100 MOVE REC-CT TO DOTVALUE. SQ1154.2 +031200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1154.2 +031300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1154.2 +031400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1154.2 +031500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1154.2 +031600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1154.2 +031700 MOVE SPACE TO CORRECT-X. SQ1154.2 +031800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1154.2 +031900 MOVE SPACE TO RE-MARK. SQ1154.2 +032000 HEAD-ROUTINE. SQ1154.2 +032100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +032200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1154.2 +032300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1154.2 +032400 COLUMN-NAMES-ROUTINE. SQ1154.2 +032500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +032600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +032800 END-ROUTINE. SQ1154.2 +032900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1154.2 +033000 END-RTN-EXIT. SQ1154.2 +033100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +033200 END-ROUTINE-1. SQ1154.2 +033300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1154.2 +033400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1154.2 +033500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1154.2 +033600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1154.2 +033700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1154.2 +033800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1154.2 +033900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1154.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1154.2 +034100 END-ROUTINE-12. SQ1154.2 +034200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1154.2 +034300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1154.2 +034400 MOVE "NO " TO ERROR-TOTAL SQ1154.2 +034500 ELSE SQ1154.2 +034600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1154.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1154.2 +034800 PERFORM WRITE-LINE. SQ1154.2 +034900 END-ROUTINE-13. SQ1154.2 +035000 IF DELETE-CNT IS EQUAL TO ZERO SQ1154.2 +035100 MOVE "NO " TO ERROR-TOTAL ELSE SQ1154.2 +035200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1154.2 +035300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1154.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +035500 IF INSPECT-COUNTER EQUAL TO ZERO SQ1154.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ1154.2 +035700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1154.2 +035800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1154.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +036000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1154.2 +036100 WRITE-LINE. SQ1154.2 +036200 ADD 1 TO RECORD-COUNT. SQ1154.2 +036300 IF RECORD-COUNT GREATER 50 SQ1154.2 +036400 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1154.2 +036500 MOVE SPACE TO DUMMY-RECORD SQ1154.2 +036600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1154.2 +036700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1154.2 +036800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1154.2 +036900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1154.2 +037000 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1154.2 +037100 MOVE ZERO TO RECORD-COUNT. SQ1154.2 +037200 PERFORM WRT-LN. SQ1154.2 +037300 WRT-LN. SQ1154.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1154.2 +037500 MOVE SPACE TO DUMMY-RECORD. SQ1154.2 +037600 BLANK-LINE-PRINT. SQ1154.2 +037700 PERFORM WRT-LN. SQ1154.2 +037800 FAIL-ROUTINE. SQ1154.2 +037900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1154.2 +038000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1154.2 +038100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1154.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +038300 GO TO FAIL-ROUTINE-EX. SQ1154.2 +038400 FAIL-ROUTINE-WRITE. SQ1154.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1154.2 +038600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +038700 FAIL-ROUTINE-EX. EXIT. SQ1154.2 +038800 BAIL-OUT. SQ1154.2 +038900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1154.2 +039000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1154.2 +039100 BAIL-OUT-WRITE. SQ1154.2 +039200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1154.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1154.2 +039400 BAIL-OUT-EX. EXIT. SQ1154.2 +039500 CCVS1-EXIT. SQ1154.2 +039600 EXIT. SQ1154.2 +039700 SECT-SQ-115-0001 SECTION. SQ1154.2 +039800 SEQ-INIT-013. SQ1154.2 +039900 MOVE "SQ-FS5" TO XFILE-NAME (1). SQ1154.2 +040000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1154.2 +040100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1154.2 +040200 MOVE 000126 TO XRECORD-LENGTH (1). SQ1154.2 +040300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1154.2 +040400 MOVE 0001 TO XBLOCK-SIZE (1). SQ1154.2 +040500 MOVE 000550 TO RECORDS-IN-FILE (1). SQ1154.2 +040600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1154.2 +040700 MOVE "S" TO XLABEL-TYPE (1). SQ1154.2 +040800 MOVE 000001 TO XRECORD-NUMBER (1). SQ1154.2 +040900 OPEN OUTPUT SQ-FS5. SQ1154.2 +041000 MOVE ZERO TO COUNT-OF-RECORDS. SQ1154.2 +041100 SEQ-TEST-013. SQ1154.2 +041200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5-120. SQ1154.2 +041300 MOVE "FIRST " TO SQ-FS5-UPDATE. SQ1154.2 +041400 WRITE SQ-FS5R1-F-G-126. SQ1154.2 +041500 ADD 1 TO COUNT-OF-RECORDS. SQ1154.2 +041600 IF COUNT-OF-RECORDS EQUAL TO 550 SQ1154.2 +041700 GO TO SEQ-WRITE-013. SQ1154.2 +041800 ADD 1 TO XRECORD-NUMBER (1). SQ1154.2 +041900 GO TO SEQ-TEST-013. SQ1154.2 +042000 SEQ-WRITE-013. SQ1154.2 +042100 MOVE "CREATE SQ-FS5 550R" TO FEATURE. SQ1154.2 +042200 MOVE "SEQ-TEST-013" TO PAR-NAME. SQ1154.2 +042300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1154.2 +042400 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1154.2 +042500 PERFORM PRINT-DETAIL. SQ1154.2 +042600 CLOSE SQ-FS5. SQ1154.2 +042700* A SEQUENTIAL MASS STORAGE FILE WITH 126 CHARACTER SQ1154.2 +042800* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 550 RECORDS. SQ1154.2 +042900 SEQ-INIT-014. SQ1154.2 +043000 MOVE ZERO TO COUNT-OF-RECORDS. SQ1154.2 +043100* THIS TEST READS AND CHECKS THE FILE CREATED SQ1154.2 +043200* IN SEQ-TEST-013. SQ1154.2 +043300 OPEN INPUT SQ-FS5. SQ1154.2 +043400 SEQ-TEST-014. SQ1154.2 +043500 READ SQ-FS5 AT END SQ1154.2 +043600 GO TO SEQ-TEST-014-1. SQ1154.2 +043700 ADD 1 TO COUNT-OF-RECORDS. SQ1154.2 +043800 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1154.2 +043900 IF COUNT-OF-RECORDS GREATER THAN 550 SQ1154.2 +044000 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1154.2 +044100 GO TO SEQ-FAIL-014. SQ1154.2 +044200 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER (1) SQ1154.2 +044300 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +044400 GO TO SEQ-TEST-014. SQ1154.2 +044500 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" SQ1154.2 +044600 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +044700 GO TO SEQ-TEST-014. SQ1154.2 +044800 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1154.2 +044900 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +045000 GO TO SEQ-TEST-014. SQ1154.2 +045100 IF SQ-FS5-UPDATE EQUAL TO "FIRST " SQ1154.2 +045200 GO TO SEQ-TEST-014. SQ1154.2 +045300 ADD 1 TO RECORDS-IN-ERROR. SQ1154.2 +045400 GO TO SEQ-TEST-014. SQ1154.2 +045500 SEQ-TEST-014-1. SQ1154.2 +045600 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1154.2 +045700 GO TO SEQ-PASS-014. SQ1154.2 +045800 MOVE "ERRORS IN READING SQ-FS5" TO RE-MARK. SQ1154.2 +045900 SEQ-FAIL-014. SQ1154.2 +046000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1154.2 +046100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1154.2 +046200 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1154.2 +046300 PERFORM FAIL. SQ1154.2 +046400 GO TO SEQ-WRITE-014. SQ1154.2 +046500 SEQ-PASS-014. SQ1154.2 +046600 PERFORM PASS. SQ1154.2 +046700 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1154.2 +046800 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1154.2 +046900 SEQ-WRITE-014. SQ1154.2 +047000 MOVE "SEQ-TEST-014" TO PAR-NAME. SQ1154.2 +047100 MOVE "VERIFY FILE SQ-FS5" TO FEATURE. SQ1154.2 +047200 PERFORM PRINT-DETAIL. SQ1154.2 +047300 SEQ-CLOSE-014. SQ1154.2 +047400 CLOSE SQ-FS5. SQ1154.2 +047500 REWRITE-INIT-GF-01. SQ1154.2 +047600 OPEN I-O SQ-FS5. SQ1154.2 +047700 MOVE ZERO TO COUNT-OF-RECORDS. SQ1154.2 +047800 MOVE ZERO TO EOF-FLAG. SQ1154.2 +047900* THIS TEST REWRITES EVERY TENTH RECORD SQ1154.2 +048000* OF THE FILE SQ-FS5. SQ1154.2 +048100 REWRITE-TEST-GF-01. SQ1154.2 +048200 PERFORM READ-SQ-FS5 THRU READ-SQ-FS5-EXIT 10 TIMES. SQ1154.2 +048300 IF EOF-FLAG EQUAL TO 1 SQ1154.2 +048400 GO TO REWRITE-TEST-GF-01-1. SQ1154.2 +048500 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1154.2 +048600 ADD 1 TO UPDATE-NUMBER (1). SQ1154.2 +048700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5-120. SQ1154.2 +048800 MOVE "SECOND" TO SQ-FS5-UPDATE. SQ1154.2 +048900 REWRITE SQ-FS5R1-F-G-126. SQ1154.2 +049000 GO TO REWRITE-TEST-GF-01. SQ1154.2 +049100 READ-SQ-FS5. SQ1154.2 +049200 IF EOF-FLAG EQUAL TO 1 SQ1154.2 +049300 GO TO READ-SQ-FS5-EXIT. SQ1154.2 +049400 READ SQ-FS5 RECORD SQ1154.2 +049500 AT END MOVE 1 TO EOF-FLAG SQ1154.2 +049600 GO TO READ-SQ-FS5-EXIT. SQ1154.2 +049700 ADD 1 TO COUNT-OF-RECORDS. SQ1154.2 +049800 READ-SQ-FS5-EXIT. SQ1154.2 +049900 EXIT. SQ1154.2 +050000 REWRITE-TEST-GF-01-1. SQ1154.2 +050100 IF COUNT-OF-RECORDS EQUAL TO 550 SQ1154.2 +050200 GO TO REWRITE-PASS-GF-01. SQ1154.2 +050300 REWRITE-FAIL-GF-01. SQ1154.2 +050400 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1154.2 +050500 PERFORM FAIL. SQ1154.2 +050600 MOVE "550 RECORDS SHOULD BE READ" TO RE-MARK. SQ1154.2 +050700 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1154.2 +050800 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1154.2 +050900 GO TO REWRITE-WRITE-GF-01. SQ1154.2 +051000 REWRITE-PASS-GF-01. SQ1154.2 +051100 PERFORM PASS. SQ1154.2 +051200 REWRITE-WRITE-GF-01. SQ1154.2 +051300 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. SQ1154.2 +051400 MOVE "REWRITE FILE SQ-FS5" TO FEATURE. SQ1154.2 +051500 PERFORM PRINT-DETAIL. SQ1154.2 +051600 REWRITE-CLOSE-GF-01. SQ1154.2 +051700 CLOSE SQ-FS5. SQ1154.2 +051800 REWRITE-INIT-GF-02. SQ1154.2 +051900 MOVE ZERO TO COUNT-OF-RECORDS. SQ1154.2 +052000 MOVE ZERO TO EOF-FLAG. SQ1154.2 +052100 OPEN INPUT SQ-FS5. SQ1154.2 +052200* THIS TEST READS AND CHECKS THE FILE WHICH WAS SQ1154.2 +052300* REWRITTEN IN REWRITE-TEST-01. SQ1154.2 +052400 MOVE ZERO TO RECORDS-IN-ERROR. SQ1154.2 +052500 MOVE ZERO TO LOOP-COUNT. SQ1154.2 +052600 REWRITE-TEST-GF-02. SQ1154.2 +052700 READ SQ-FS5 END SQ1154.2 +052800 MOVE 1 TO EOF-FLAG SQ1154.2 +052900 GO TO REWRITE-TEST-GF-02-2. SQ1154.2 +053000 ADD 1 TO COUNT-OF-RECORDS. SQ1154.2 +053100 IF COUNT-OF-RECORDS GREATER THAN 550 SQ1154.2 +053200 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1154.2 +053300 GO TO REWRITE-FAIL-GF-02. SQ1154.2 +053400 ADD 1 TO LOOP-COUNT. SQ1154.2 +053500 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1154.2 +053600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" SQ1154.2 +053700 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +053800 GO TO REWRITE-TEST-GF-02. SQ1154.2 +053900 IF LOOP-COUNT EQUAL TO 10 SQ1154.2 +054000 MOVE ZERO TO LOOP-COUNT SQ1154.2 +054100 GO TO REWRITE-TEST-GF-02-1. SQ1154.2 +054200 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1154.2 +054300 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +054400 GO TO REWRITE-TEST-GF-02. SQ1154.2 +054500 IF SQ-FS5-UPDATE EQUAL TO "FIRST " SQ1154.2 +054600 GO TO REWRITE-TEST-GF-02. SQ1154.2 +054700 ADD 1 TO RECORDS-IN-ERROR. SQ1154.2 +054800 GO TO REWRITE-TEST-GF-02. SQ1154.2 +054900 REWRITE-TEST-GF-02-1. SQ1154.2 +055000 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1154.2 +055100 ADD 1 TO RECORDS-IN-ERROR SQ1154.2 +055200 GO TO REWRITE-TEST-GF-02. SQ1154.2 +055300 IF SQ-FS5-UPDATE EQUAL TO "SECOND" SQ1154.2 +055400 GO TO REWRITE-TEST-GF-02. SQ1154.2 +055500 ADD 1 TO RECORDS-IN-ERROR. SQ1154.2 +055600 GO TO REWRITE-TEST-GF-02. SQ1154.2 +055700 REWRITE-TEST-GF-02-2. SQ1154.2 +055800 IF COUNT-OF-RECORDS NOT EQUAL TO 550 SQ1154.2 +055900 MOVE "LESS THAN 550 RECORDS" TO RE-MARK SQ1154.2 +056000 MOVE "RECORDS READ =" TO COMPUTED-A SQ1154.2 +056100 MOVE COUNT-OF-RECORDS TO CORRECT-18V0 SQ1154.2 +056200 GO TO REWRITE-FAIL-GF-02. SQ1154.2 +056300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1154.2 +056400 MOVE "ERRORS IN READING SQ-FS5" TO RE-MARK SQ1154.2 +056500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1154.2 +056600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1154.2 +056700 GO TO REWRITE-FAIL-GF-02. SQ1154.2 +056800 REWRITE-PASS-GF-02. SQ1154.2 +056900 PERFORM PASS. SQ1154.2 +057000 GO TO REWRITE-WRITE-GF-02. SQ1154.2 +057100 REWRITE-FAIL-GF-02. SQ1154.2 +057200 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1154.2 +057300 PERFORM FAIL. SQ1154.2 +057400 REWRITE-WRITE-GF-02. SQ1154.2 +057500 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. SQ1154.2 +057600 MOVE "VERIFY FILE SQ-FS5" TO FEATURE. SQ1154.2 +057700 PERFORM PRINT-DETAIL. SQ1154.2 +057800 REWRITE-CLOSE-GF-02. SQ1154.2 +057900 CLOSE SQ-FS5. SQ1154.2 +058000 TERMINATE-ROUTINE. SQ1154.2 +058100 EXIT. SQ1154.2 +058200 CCVS-EXIT SECTION. SQ1154.2 +058300 CCVS-999999. SQ1154.2 +058400 GO TO CLOSE-FILES. SQ1154.2 diff --git a/tests/cobol85/SQ/SQ116A.CBL b/tests/cobol85/SQ/SQ116A.CBL new file mode 100755 index 00000000..f5c2f273 --- /dev/null +++ b/tests/cobol85/SQ/SQ116A.CBL @@ -0,0 +1,957 @@ +000100 IDENTIFICATION DIVISION. SQ1164.2 +000200 PROGRAM-ID. SQ1164.2 +000300 SQ116A. SQ1164.2 +000400**************************************************************** SQ1164.2 +000500* * SQ1164.2 +000600* VALIDATION FOR:- * SQ1164.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1164.2 +000800* * SQ1164.2 +000900* CREATION DATE / VALIDATION DATE * SQ1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1164.2 +001100* * SQ1164.2 +001200**************************************************************** SQ1164.2 +001300 SQ1164.2 +001400* THIS PROGRAM CREATES A SEQUENTIAL MASS STORAGE FILE SQ1164.2 +001500* OF 550 RECORDS. THE FILE IS THEN OPENED IN THE I-O MODE AND SQ1164.2 +001600* RECORDS ARE UPDATED USING REWRITE...FROM STATEMENTS. THE SQ1164.2 +001700* FILE IS THEN READ AGAIN CHECKING EACH RECORD TO ENSURE SQ1164.2 +001800* THE REWRITES WERE EXECUTED CORRECTLY. SQ1164.2 +001900* SQ1164.2 +002000* USED X-CARDS: SQ1164.2 +002100* XXXXX014 SQ1164.2 +002200* XXXXX055 SQ1164.2 +002300* P XXXXX062 SQ1164.2 +002400* XXXXX082 SQ1164.2 +002500* XXXXX083 SQ1164.2 +002600* C XXXXX084 SQ1164.2 +002700* SQ1164.2 +002800* SQ1164.2 +002900 ENVIRONMENT DIVISION. SQ1164.2 +003000 CONFIGURATION SECTION. SQ1164.2 +003100 SOURCE-COMPUTER. SQ1164.2 +003200 Linux. SQ1164.2 +003300 OBJECT-COMPUTER. SQ1164.2 +003400 Linux. SQ1164.2 +003500 INPUT-OUTPUT SECTION. SQ1164.2 +003600 FILE-CONTROL. SQ1164.2 +003700*P SELECT RAW-DATA ASSIGN TO SQ1164.2 +003800*P "XXXXX062" SQ1164.2 +003900*P ORGANIZATION IS INDEXED SQ1164.2 +004000*P ACCESS MODE IS RANDOM SQ1164.2 +004100*P RECORD KEY IS RAW-DATA-KEY. SQ1164.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1164.2 +004300 "report.log". SQ1164.2 +004400 SELECT SQ-FS6 ASSIGN SQ1164.2 +004500 "XXXXX014" SQ1164.2 +004600 ORGANIZATION SEQUENTIAL SQ1164.2 +004700 ACCESS MODE SEQUENTIAL. SQ1164.2 +004800 DATA DIVISION. SQ1164.2 +004900 FILE SECTION. SQ1164.2 +005000*P SQ1164.2 +005100*PD RAW-DATA. SQ1164.2 +005200*P SQ1164.2 +005300*P1 RAW-DATA-SATZ. SQ1164.2 +005400*P 05 RAW-DATA-KEY PIC X(6). SQ1164.2 +005500*P 05 C-DATE PIC 9(6). SQ1164.2 +005600*P 05 C-TIME PIC 9(8). SQ1164.2 +005700*P 05 C-NO-OF-TESTS PIC 99. SQ1164.2 +005800*P 05 C-OK PIC 999. SQ1164.2 +005900*P 05 C-ALL PIC 999. SQ1164.2 +006000*P 05 C-FAIL PIC 999. SQ1164.2 +006100*P 05 C-DELETED PIC 999. SQ1164.2 +006200*P 05 C-INSPECT PIC 999. SQ1164.2 +006300*P 05 C-NOTE PIC X(13). SQ1164.2 +006400*P 05 C-INDENT PIC X. SQ1164.2 +006500*P 05 C-ABORT PIC X(8). SQ1164.2 +006600 FD PRINT-FILE SQ1164.2 +006700*C LABEL RECORDS SQ1164.2 +006800*C OMITTED SQ1164.2 +006900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1164.2 +007000 . SQ1164.2 +007100 01 PRINT-REC PICTURE X(120). SQ1164.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ1164.2 +007300 FD SQ-FS6 SQ1164.2 +007400*C LABEL RECORD STANDARD SQ1164.2 +007500 . SQ1164.2 +007600 01 SQ-FS6R1-F-G-130. SQ1164.2 +007700 02 SQ-FS6R1-PART1 PICTURE X(120). SQ1164.2 +007800 02 SQ-FS6R1-PART2 PICTURE X(10). SQ1164.2 +007900 WORKING-STORAGE SECTION. SQ1164.2 +008000 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ1164.2 +008100 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. SQ1164.2 +008200 01 ERROR-FLAG PIC 9. SQ1164.2 +008300 01 EOF-FLAG PIC 9. SQ1164.2 +008400 01 END-OF-RECORD-AREA. SQ1164.2 +008500 02 UPDATE-AREA-ONLY PIC X(6). SQ1164.2 +008600 02 NUMBER-AREA PIC 9999. SQ1164.2 +008700 01 REWRT-FROM-AREA1. SQ1164.2 +008800 02 AREA1-1 PICTURE X(120). SQ1164.2 +008900 02 AREA1-2. SQ1164.2 +009000 03 AREA1-21 PIC X(6). SQ1164.2 +009100 03 AREA1-22 PIC 9999. SQ1164.2 +009200 01 REWRT-FROM-AREA2. SQ1164.2 +009300 02 AREA2-1. SQ1164.2 +009400 03 AREA2-11 PIC X(120). SQ1164.2 +009500 03 AREA2-12 PIC X(6). SQ1164.2 +009600 03 AREA2-13 PIC 9999. SQ1164.2 +009700 02 AREA2-2 PIC X(9). SQ1164.2 +009800 01 RWRT-FROM-AREA3. SQ1164.2 +009900 02 AREA3-1 PICTURE X(87). SQ1164.2 +010000 01 FOLLOWS-AREA3 PICTURE X(9). SQ1164.2 +010100 01 FILE-RECORD-INFORMATION-REC. SQ1164.2 +010200 03 FILE-RECORD-INFO-SKELETON. SQ1164.2 +010300 05 FILLER PICTURE X(48) VALUE SQ1164.2 +010400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1164.2 +010500 05 FILLER PICTURE X(46) VALUE SQ1164.2 +010600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1164.2 +010700 05 FILLER PICTURE X(26) VALUE SQ1164.2 +010800 ",LFIL=000000,ORG= ,LBLR= ". SQ1164.2 +010900 05 FILLER PICTURE X(37) VALUE SQ1164.2 +011000 ",RECKEY= ". SQ1164.2 +011100 05 FILLER PICTURE X(38) VALUE SQ1164.2 +011200 ",ALTKEY1= ". SQ1164.2 +011300 05 FILLER PICTURE X(38) VALUE SQ1164.2 +011400 ",ALTKEY2= ". SQ1164.2 +011500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1164.2 +011600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1164.2 +011700 05 FILE-RECORD-INFO-P1-120. SQ1164.2 +011800 07 FILLER PIC X(5). SQ1164.2 +011900 07 XFILE-NAME PIC X(6). SQ1164.2 +012000 07 FILLER PIC X(8). SQ1164.2 +012100 07 XRECORD-NAME PIC X(6). SQ1164.2 +012200 07 FILLER PIC X(1). SQ1164.2 +012300 07 REELUNIT-NUMBER PIC 9(1). SQ1164.2 +012400 07 FILLER PIC X(7). SQ1164.2 +012500 07 XRECORD-NUMBER PIC 9(6). SQ1164.2 +012600 07 FILLER PIC X(6). SQ1164.2 +012700 07 UPDATE-NUMBER PIC 9(2). SQ1164.2 +012800 07 FILLER PIC X(5). SQ1164.2 +012900 07 ODO-NUMBER PIC 9(4). SQ1164.2 +013000 07 FILLER PIC X(5). SQ1164.2 +013100 07 XPROGRAM-NAME PIC X(5). SQ1164.2 +013200 07 FILLER PIC X(7). SQ1164.2 +013300 07 XRECORD-LENGTH PIC 9(6). SQ1164.2 +013400 07 FILLER PIC X(7). SQ1164.2 +013500 07 CHARS-OR-RECORDS PIC X(2). SQ1164.2 +013600 07 FILLER PIC X(1). SQ1164.2 +013700 07 XBLOCK-SIZE PIC 9(4). SQ1164.2 +013800 07 FILLER PIC X(6). SQ1164.2 +013900 07 RECORDS-IN-FILE PIC 9(6). SQ1164.2 +014000 07 FILLER PIC X(5). SQ1164.2 +014100 07 XFILE-ORGANIZATION PIC X(2). SQ1164.2 +014200 07 FILLER PIC X(6). SQ1164.2 +014300 07 XLABEL-TYPE PIC X(1). SQ1164.2 +014400 05 FILE-RECORD-INFO-P121-240. SQ1164.2 +014500 07 FILLER PIC X(8). SQ1164.2 +014600 07 XRECORD-KEY PIC X(29). SQ1164.2 +014700 07 FILLER PIC X(9). SQ1164.2 +014800 07 ALTERNATE-KEY1 PIC X(29). SQ1164.2 +014900 07 FILLER PIC X(9). SQ1164.2 +015000 07 ALTERNATE-KEY2 PIC X(29). SQ1164.2 +015100 07 FILLER PIC X(7). SQ1164.2 +015200 01 TEST-RESULTS. SQ1164.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ1164.2 +015400 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1164.2 +015500 02 FILLER PICTURE X VALUE SPACE. SQ1164.2 +015600 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1164.2 +015700 02 FILLER PICTURE X VALUE SPACE. SQ1164.2 +015800 02 PAR-NAME. SQ1164.2 +015900 03 FILLER PICTURE X(12) VALUE SPACE. SQ1164.2 +016000 03 PARDOT-X PICTURE X VALUE SPACE. SQ1164.2 +016100 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1164.2 +016200 03 FILLER PIC X(5) VALUE SPACE. SQ1164.2 +016300 02 FILLER PIC X(10) VALUE SPACE. SQ1164.2 +016400 02 RE-MARK PIC X(61). SQ1164.2 +016500 01 TEST-COMPUTED. SQ1164.2 +016600 02 FILLER PIC X(30) VALUE SPACE. SQ1164.2 +016700 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1164.2 +016800 02 COMPUTED-X. SQ1164.2 +016900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1164.2 +017000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1164.2 +017100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1164.2 +017200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1164.2 +017300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1164.2 +017400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1164.2 +017500 04 COMPUTED-18V0 PICTURE -9(18). SQ1164.2 +017600 04 FILLER PICTURE X. SQ1164.2 +017700 03 FILLER PIC X(50) VALUE SPACE. SQ1164.2 +017800 01 TEST-CORRECT. SQ1164.2 +017900 02 FILLER PIC X(30) VALUE SPACE. SQ1164.2 +018000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1164.2 +018100 02 CORRECT-X. SQ1164.2 +018200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1164.2 +018300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1164.2 +018400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1164.2 +018500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1164.2 +018600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1164.2 +018700 03 CR-18V0 REDEFINES CORRECT-A. SQ1164.2 +018800 04 CORRECT-18V0 PICTURE -9(18). SQ1164.2 +018900 04 FILLER PICTURE X. SQ1164.2 +019000 03 FILLER PIC X(50) VALUE SPACE. SQ1164.2 +019100 01 CCVS-C-1. SQ1164.2 +019200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1164.2 +019300- "SS PARAGRAPH-NAME SQ1164.2 +019400- " REMARKS". SQ1164.2 +019500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1164.2 +019600 01 CCVS-C-2. SQ1164.2 +019700 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1164.2 +019800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1164.2 +019900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1164.2 +020000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1164.2 +020100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1164.2 +020200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1164.2 +020300 01 REC-CT PICTURE 99 VALUE ZERO. SQ1164.2 +020400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1164.2 +020500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1164.2 +020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1164.2 +020700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1164.2 +020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1164.2 +020900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1164.2 +021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1164.2 +021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1164.2 +021200 01 CCVS-H-1. SQ1164.2 +021300 02 FILLER PICTURE X(27) VALUE SPACE. SQ1164.2 +021400 02 FILLER PICTURE X(67) VALUE SQ1164.2 +021500 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1164.2 +021600- " SYSTEM". SQ1164.2 +021700 02 FILLER PICTURE X(26) VALUE SPACE. SQ1164.2 +021800 01 CCVS-H-2. SQ1164.2 +021900 02 FILLER PICTURE X(52) VALUE IS SQ1164.2 +022000 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1164.2 +022100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1164.2 +022200 02 TEST-ID PICTURE IS X(9). SQ1164.2 +022300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1164.2 +022400 01 CCVS-H-3. SQ1164.2 +022500 02 FILLER PICTURE X(34) VALUE SQ1164.2 +022600 " FOR OFFICIAL USE ONLY ". SQ1164.2 +022700 02 FILLER PICTURE X(58) VALUE SQ1164.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1164.2 +022900 02 FILLER PICTURE X(28) VALUE SQ1164.2 +023000 " COPYRIGHT 1985 ". SQ1164.2 +023100 01 CCVS-E-1. SQ1164.2 +023200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1164.2 +023300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1164.2 +023400 02 ID-AGAIN PICTURE IS X(9). SQ1164.2 +023500 02 FILLER PICTURE X(45) VALUE IS SQ1164.2 +023600 " NTIS DISTRIBUTION COBOL 85". SQ1164.2 +023700 01 CCVS-E-2. SQ1164.2 +023800 02 FILLER PICTURE X(31) VALUE SQ1164.2 +023900 SPACE. SQ1164.2 +024000 02 FILLER PICTURE X(21) VALUE SPACE. SQ1164.2 +024100 02 CCVS-E-2-2. SQ1164.2 +024200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1164.2 +024300 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1164.2 +024400 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1164.2 +024500 01 CCVS-E-3. SQ1164.2 +024600 02 FILLER PICTURE X(22) VALUE SQ1164.2 +024700 " FOR OFFICIAL USE ONLY". SQ1164.2 +024800 02 FILLER PICTURE X(12) VALUE SPACE. SQ1164.2 +024900 02 FILLER PICTURE X(58) VALUE SQ1164.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1164.2 +025100 02 FILLER PICTURE X(13) VALUE SPACE. SQ1164.2 +025200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1164.2 +025300 01 CCVS-E-4. SQ1164.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1164.2 +025500 02 FILLER PIC XXXX VALUE " OF ". SQ1164.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1164.2 +025700 02 FILLER PIC X(40) VALUE SQ1164.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1164.2 +025900 01 XXINFO. SQ1164.2 +026000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1164.2 +026100 02 INFO-TEXT. SQ1164.2 +026200 04 FILLER PIC X(20) VALUE SPACE. SQ1164.2 +026300 04 XXCOMPUTED PIC X(20). SQ1164.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ1164.2 +026500 04 XXCORRECT PIC X(20). SQ1164.2 +026600 01 HYPHEN-LINE. SQ1164.2 +026700 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1164.2 +026800 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1164.2 +026900- "*****************************************". SQ1164.2 +027000 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1164.2 +027100- "******************************". SQ1164.2 +027200 01 CCVS-PGM-ID PIC X(6) VALUE SQ1164.2 +027300 "SQ116A". SQ1164.2 +027400 PROCEDURE DIVISION. SQ1164.2 +027500 CCVS1 SECTION. SQ1164.2 +027600 OPEN-FILES. SQ1164.2 +027700*P OPEN I-O RAW-DATA. SQ1164.2 +027800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1164.2 +027900*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1164.2 +028000*P MOVE "ABORTED " TO C-ABORT. SQ1164.2 +028100*P ADD 1 TO C-NO-OF-TESTS. SQ1164.2 +028200*P ACCEPT C-DATE FROM DATE. SQ1164.2 +028300*P ACCEPT C-TIME FROM TIME. SQ1164.2 +028400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1164.2 +028500*PND-E-1. SQ1164.2 +028600*P CLOSE RAW-DATA. SQ1164.2 +028700 OPEN OUTPUT PRINT-FILE. SQ1164.2 +028800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1164.2 +028900 MOVE SPACE TO TEST-RESULTS. SQ1164.2 +029000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1164.2 +029100 MOVE ZERO TO REC-SKL-SUB. SQ1164.2 +029200 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1164.2 +029300 CCVS-INIT-FILE. SQ1164.2 +029400 ADD 1 TO REC-SKL-SUB. SQ1164.2 +029500 MOVE FILE-RECORD-INFO-SKELETON TO SQ1164.2 +029600 FILE-RECORD-INFO (REC-SKL-SUB). SQ1164.2 +029700 CCVS-INIT-EXIT. SQ1164.2 +029800 GO TO CCVS1-EXIT. SQ1164.2 +029900 CLOSE-FILES. SQ1164.2 +030000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1164.2 +030100*P OPEN I-O RAW-DATA. SQ1164.2 +030200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1164.2 +030300*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1164.2 +030400*P MOVE "OK. " TO C-ABORT. SQ1164.2 +030500*P MOVE PASS-COUNTER TO C-OK. SQ1164.2 +030600*P MOVE ERROR-HOLD TO C-ALL. SQ1164.2 +030700*P MOVE ERROR-COUNTER TO C-FAIL. SQ1164.2 +030800*P MOVE DELETE-CNT TO C-DELETED. SQ1164.2 +030900*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1164.2 +031000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1164.2 +031100*PND-E-2. SQ1164.2 +031200*P CLOSE RAW-DATA. SQ1164.2 +031300 TERMINATE-CCVS. SQ1164.2 +031400*S EXIT PROGRAM. SQ1164.2 +031500*SERMINATE-CALL. SQ1164.2 +031600 STOP RUN. SQ1164.2 +031700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1164.2 +031800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1164.2 +031900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1164.2 +032000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1164.2 +032100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1164.2 +032200 PRINT-DETAIL. SQ1164.2 +032300 IF REC-CT NOT EQUAL TO ZERO SQ1164.2 +032400 MOVE "." TO PARDOT-X SQ1164.2 +032500 MOVE REC-CT TO DOTVALUE. SQ1164.2 +032600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1164.2 +032700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1164.2 +032800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1164.2 +032900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1164.2 +033000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1164.2 +033100 MOVE SPACE TO CORRECT-X. SQ1164.2 +033200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1164.2 +033300 MOVE SPACE TO RE-MARK. SQ1164.2 +033400 HEAD-ROUTINE. SQ1164.2 +033500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +033600 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1164.2 +033700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1164.2 +033800 COLUMN-NAMES-ROUTINE. SQ1164.2 +033900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +034000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +034200 END-ROUTINE. SQ1164.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1164.2 +034400 END-RTN-EXIT. SQ1164.2 +034500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +034600 END-ROUTINE-1. SQ1164.2 +034700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1164.2 +034800 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1164.2 +034900 ADD PASS-COUNTER TO ERROR-HOLD. SQ1164.2 +035000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1164.2 +035100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1164.2 +035200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1164.2 +035300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1164.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1164.2 +035500 END-ROUTINE-12. SQ1164.2 +035600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1164.2 +035700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1164.2 +035800 MOVE "NO " TO ERROR-TOTAL SQ1164.2 +035900 ELSE SQ1164.2 +036000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1164.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1164.2 +036200 PERFORM WRITE-LINE. SQ1164.2 +036300 END-ROUTINE-13. SQ1164.2 +036400 IF DELETE-CNT IS EQUAL TO ZERO SQ1164.2 +036500 MOVE "NO " TO ERROR-TOTAL ELSE SQ1164.2 +036600 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1164.2 +036700 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1164.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +036900 IF INSPECT-COUNTER EQUAL TO ZERO SQ1164.2 +037000 MOVE "NO " TO ERROR-TOTAL SQ1164.2 +037100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1164.2 +037200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1164.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +037400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1164.2 +037500 WRITE-LINE. SQ1164.2 +037600 ADD 1 TO RECORD-COUNT. SQ1164.2 +037700 IF RECORD-COUNT GREATER 50 SQ1164.2 +037800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1164.2 +037900 MOVE SPACE TO DUMMY-RECORD SQ1164.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1164.2 +038100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1164.2 +038200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1164.2 +038300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1164.2 +038400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1164.2 +038500 MOVE ZERO TO RECORD-COUNT. SQ1164.2 +038600 PERFORM WRT-LN. SQ1164.2 +038700 WRT-LN. SQ1164.2 +038800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1164.2 +038900 MOVE SPACE TO DUMMY-RECORD. SQ1164.2 +039000 BLANK-LINE-PRINT. SQ1164.2 +039100 PERFORM WRT-LN. SQ1164.2 +039200 FAIL-ROUTINE. SQ1164.2 +039300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1164.2 +039400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1164.2 +039500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1164.2 +039600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +039700 GO TO FAIL-ROUTINE-EX. SQ1164.2 +039800 FAIL-ROUTINE-WRITE. SQ1164.2 +039900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1164.2 +040000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +040100 FAIL-ROUTINE-EX. EXIT. SQ1164.2 +040200 BAIL-OUT. SQ1164.2 +040300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1164.2 +040400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1164.2 +040500 BAIL-OUT-WRITE. SQ1164.2 +040600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1164.2 +040700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1164.2 +040800 BAIL-OUT-EX. EXIT. SQ1164.2 +040900 CCVS1-EXIT. SQ1164.2 +041000 EXIT. SQ1164.2 +041100 SECT-SQ116A-0001 SECTION. SQ1164.2 +041200 SEQ-INIT-023. SQ1164.2 +041300 MOVE "SQ-FS6" TO XFILE-NAME (1). SQ1164.2 +041400 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1164.2 +041500 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1164.2 +041600 MOVE 130 TO XRECORD-LENGTH (1). SQ1164.2 +041700 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1164.2 +041800 MOVE 0001 TO XBLOCK-SIZE (1). SQ1164.2 +041900 MOVE 000550 TO RECORDS-IN-FILE (1). SQ1164.2 +042000 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1164.2 +042100 MOVE "O" TO XLABEL-TYPE (1). SQ1164.2 +042200 MOVE "FIRST " TO UPDATE-AREA-ONLY. SQ1164.2 +042300 MOVE ZERO TO COUNT-OF-RECS. SQ1164.2 +042400 OPEN OUTPUT SQ-FS6. SQ1164.2 +042500 SEQ-TEST-023. SQ1164.2 +042600 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +042700 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1164.2 +042800 MOVE COUNT-OF-RECS TO NUMBER-AREA. SQ1164.2 +042900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS6R1-PART1. SQ1164.2 +043000 MOVE END-OF-RECORD-AREA TO SQ-FS6R1-PART2. SQ1164.2 +043100 WRITE SQ-FS6R1-F-G-130. SQ1164.2 +043200 IF COUNT-OF-RECS EQUAL TO 550 SQ1164.2 +043300 GO TO SEQ-WRITE-023. SQ1164.2 +043400 GO TO SEQ-TEST-023. SQ1164.2 +043500 SEQ-WRITE-023. SQ1164.2 +043600 MOVE "CREATE FILE SQ-FS6" TO FEATURE. SQ1164.2 +043700 MOVE "SEQ-WRITE-023" TO PAR-NAME. SQ1164.2 +043800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1164.2 +043900 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1164.2 +044000 PERFORM PRINT-DETAIL. SQ1164.2 +044100 CLOSE SQ-FS6. SQ1164.2 +044200* A SEQUENTIAL MASS STORAGE FILE WITH 130 CHARACTER SQ1164.2 +044300* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 550 RECORDS. SQ1164.2 +044400 SEQ-INIT-024. SQ1164.2 +044500 MOVE ZERO TO COUNT-OF-RECS. SQ1164.2 +044600* THIS TEST VERIFIES THE FILE CREATED IN SEQ-TEST-023. SQ1164.2 +044700 OPEN INPUT SQ-FS6. SQ1164.2 +044800 SEQ-TEST-024. SQ1164.2 +044900 READ SQ-FS6 AT END GO TO SEQ-TEST-024-1. SQ1164.2 +045000 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +045100 IF COUNT-OF-RECS GREATER THAN 550 SQ1164.2 +045200 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1164.2 +045300 GO TO SEQ-FAIL-024. SQ1164.2 +045400 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +045500 MOVE SQ-FS6R1-PART2 TO END-OF-RECORD-AREA. SQ1164.2 +045600 IF UPDATE-AREA-ONLY NOT EQUAL TO "FIRST " SQ1164.2 +045700 GO TO SEQ-FAIL-024-1. SQ1164.2 +045800 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1164.2 +045900 GO TO SEQ-FAIL-024-1. SQ1164.2 +046000 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1164.2 +046100 GO TO SEQ-FAIL-024-1. SQ1164.2 +046200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" SQ1164.2 +046300 GO TO SEQ-FAIL-024-1. SQ1164.2 +046400 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1164.2 +046500 GO TO SEQ-FAIL-024-1. SQ1164.2 +046600 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1164.2 +046700 GO TO SEQ-FAIL-024-1. SQ1164.2 +046800 GO TO SEQ-TEST-024. SQ1164.2 +046900 SEQ-FAIL-024-1. SQ1164.2 +047000 ADD 1 TO RECORDS-IN-ERROR. SQ1164.2 +047100 GO TO SEQ-TEST-024. SQ1164.2 +047200 SEQ-TEST-024-1. SQ1164.2 +047300 IF RECORDS-IN-ERROR EQUAL TO 0 SQ1164.2 +047400 GO TO SEQ-PASS-024. SQ1164.2 +047500 MOVE "ERRORS IN READING SQ-FS6" TO RE-MARK. SQ1164.2 +047600 SEQ-FAIL-024. SQ1164.2 +047700 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1164.2 +047800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1164.2 +047900 PERFORM FAIL. SQ1164.2 +048000 GO TO SEQ-WRITE-024. SQ1164.2 +048100 SEQ-PASS-024. SQ1164.2 +048200 PERFORM PASS. SQ1164.2 +048300 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1164.2 +048400 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1164.2 +048500 SEQ-WRITE-024. SQ1164.2 +048600 MOVE "SEQ-TEST-024" TO PAR-NAME. SQ1164.2 +048700 MOVE "VERIFY FILE SQ-FS6" TO FEATURE. SQ1164.2 +048800 PERFORM PRINT-DETAIL. SQ1164.2 +048900 SEQ-CLOSE-024. SQ1164.2 +049000 CLOSE SQ-FS6. SQ1164.2 +049100 REWRITE-INIT-GF-01. SQ1164.2 +049200 OPEN I-O SQ-FS6. SQ1164.2 +049300 MOVE 0 TO COUNT-OF-RECS. SQ1164.2 +049400 MOVE 0 TO EOF-FLAG. SQ1164.2 +049500 MOVE 0 TO ERROR-FLAG. SQ1164.2 +049600* SKIP THE FIRST 30 RECORDS. SQ1164.2 +049700 PERFORM READ-SQ-FS6 THRU READ-SQ-FS6-EXIT 30 TIMES. SQ1164.2 +049800 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +049900 GO TO CANT-TEST. SQ1164.2 +050000 GO TO REWRITE-TEST-GF-01. SQ1164.2 +050100 READ-SQ-FS6. SQ1164.2 +050200 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +050300 GO TO READ-SQ-FS6-EXIT. SQ1164.2 +050400 READ SQ-FS6 AT END SQ1164.2 +050500 MOVE 1 TO EOF-FLAG. SQ1164.2 +050600 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +050700 READ-SQ-FS6-EXIT. SQ1164.2 +050800 EXIT. SQ1164.2 +050900 REWRITE-TEST-GF-01. SQ1164.2 +051000* THIS TEST REWRITES RECORDS FROM A WORKING-STORAGE AREA SQ1164.2 +051100* THE SAME SIZE AS THE FD 01 RECORD AREA. A CHECK IS MADE TO SQ1164.2 +051200* ENSURE THAT THE FROM AREA WAS NOT DESTROYED BY THE REWRITE...SQ1164.2 +051300* FROM STATEMENT. SQ1164.2 +051400 IF COUNT-OF-RECS EQUAL TO 80 SQ1164.2 +051500 GO TO REWRITE-TEST-GF-01-1. SQ1164.2 +051600 READ SQ-FS6 RECORD SQ1164.2 +051700 AT END GO TO CANT-TEST. SQ1164.2 +051800 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +051900 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +052000 ADD 1 TO UPDATE-NUMBER (1). SQ1164.2 +052100 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA1-1. SQ1164.2 +052200 MOVE SQ-FS6R1-PART2 TO AREA1-2. SQ1164.2 +052300 MOVE "SECOND" TO AREA1-21. SQ1164.2 +052400 REWRITE SQ-FS6R1-F-G-130 FROM REWRT-FROM-AREA1. SQ1164.2 +052500 IF AREA1-1 NOT EQUAL TO FILE-RECORD-INFO-P1-120 (1) SQ1164.2 +052600 GO TO REWRITE-FAIL-GF-01-1. SQ1164.2 +052700 IF AREA1-21 NOT EQUAL TO "SECOND" SQ1164.2 +052800 GO TO REWRITE-FAIL-GF-01-1. SQ1164.2 +052900 IF AREA1-22 EQUAL TO COUNT-OF-RECS SQ1164.2 +053000 GO TO REWRITE-TEST-GF-01. SQ1164.2 +053100 REWRITE-FAIL-GF-01-1. SQ1164.2 +053200 MOVE 1 TO ERROR-FLAG. SQ1164.2 +053300 GO TO REWRITE-TEST-GF-01. SQ1164.2 +053400 REWRITE-TEST-GF-01-1. SQ1164.2 +053500 IF ERROR-FLAG EQUAL TO ZERO SQ1164.2 +053600 GO TO REWRITE-PASS-GF-01. SQ1164.2 +053700 REWRITE-FAIL-GF-01. SQ1164.2 +053800 MOVE "FROM AREA CLOBBERED" TO COMPUTED-A. SQ1164.2 +053900 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1164.2 +054000 PERFORM FAIL. SQ1164.2 +054100 GO TO REWRITE-WRITE-GF-01. SQ1164.2 +054200 REWRITE-PASS-GF-01. SQ1164.2 +054300 PERFORM PASS. SQ1164.2 +054400 REWRITE-WRITE-GF-01. SQ1164.2 +054500 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. SQ1164.2 +054600 MOVE "REWRITE...FROM 01 L" TO FEATURE. SQ1164.2 +054700 PERFORM PRINT-DETAIL. SQ1164.2 +054800 REWRITE-INIT-GF-02-A. SQ1164.2 +054900* THIS TEST REWRITES A RECORD FROM A WORKING-STORAGE AREA SQ1164.2 +055000* LARGER THAN THE FD 01 RECORD AREA. TRUNCATION SHOULD SQ1164.2 +055100* OCCUR ON THE RIGHTMOST CHARACTERS. SQ1164.2 +055200 READ SQ-FS6 RECORD SQ1164.2 +055300 AT END GO TO CANT-TEST. SQ1164.2 +055400 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +055500 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +055600 ADD 1 TO UPDATE-NUMBER (1). SQ1164.2 +055700 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA2-11. SQ1164.2 +055800 MOVE "SECOND" TO AREA2-12. SQ1164.2 +055900 MOVE COUNT-OF-RECS TO AREA2-13. SQ1164.2 +056000 MOVE "JUNK-AREA" TO AREA2-2. SQ1164.2 +056100 REWRITE SQ-FS6R1-F-G-130 FROM REWRT-FROM-AREA2. SQ1164.2 +056200 IF COUNT-OF-RECS EQUAL TO 120 SQ1164.2 +056300 GO TO REWRITE-INIT-GF-03-A. SQ1164.2 +056400 GO TO REWRITE-INIT-GF-02-A. SQ1164.2 +056500 REWRITE-INIT-GF-03-A. SQ1164.2 +056600* THIS TEST REWRITES A RECORD FROM AN 87 CHARACTER SQ1164.2 +056700* WORKING-STORAGE ITEM. THE REST OF THE 130 CHARACTERS SQ1164.2 +056800* SHOULD BE SPACE FILLED DURING THE REWRITE STATEMENT. SQ1164.2 +056900 READ SQ-FS6 RECORD SQ1164.2 +057000 AT END GO TO CANT-TEST. SQ1164.2 +057100 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +057200 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +057300 ADD 1 TO UPDATE-NUMBER (1). SQ1164.2 +057400 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA3-1. SQ1164.2 +057500 MOVE "JUNK-AREA" TO FOLLOWS-AREA3. SQ1164.2 +057600 REWRITE SQ-FS6R1-F-G-130 FROM RWRT-FROM-AREA3. SQ1164.2 +057700 IF COUNT-OF-RECS EQUAL TO 160 SQ1164.2 +057800 GO TO REWRITE-INIT-GF-04-A. SQ1164.2 +057900 GO TO REWRITE-INIT-GF-03-A. SQ1164.2 +058000 REWRITE-INIT-GF-04-A. SQ1164.2 +058100* THIS TEST REWRITES A RECORD FROM AN 02 LEVEL DATA ITEM. SQ1164.2 +058200 READ SQ-FS6 RECORD SQ1164.2 +058300 AT END GO TO CANT-TEST. SQ1164.2 +058400 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +058500 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +058600 ADD 1 TO UPDATE-NUMBER (1). SQ1164.2 +058700 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA2-11. SQ1164.2 +058800 MOVE "SECOND" TO AREA2-12. SQ1164.2 +058900 MOVE COUNT-OF-RECS TO AREA2-13. SQ1164.2 +059000 MOVE "JUNK-AREA" TO AREA2-2. SQ1164.2 +059100 REWRITE SQ-FS6R1-F-G-130 FROM AREA2-1. SQ1164.2 +059200 IF COUNT-OF-RECS EQUAL TO 200 SQ1164.2 +059300 GO TO REWRITE-INIT-GF-05-A. SQ1164.2 +059400 GO TO REWRITE-INIT-GF-04-A. SQ1164.2 +059500 REWRITE-INIT-GF-05-A. SQ1164.2 +059600* THIS TEST REWRITES A RECORD FROM A SUBSCRIPTED DATA SQ1164.2 +059700* ITEM OF 120 CHARACTERS. THE DATA ITEM IS LEVEL 05. SQ1164.2 +059800 READ SQ-FS6 RECORD SQ1164.2 +059900 AT END GO TO CANT-TEST. SQ1164.2 +060000 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +060100 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (2). SQ1164.2 +060200 ADD 1 TO UPDATE-NUMBER (2). SQ1164.2 +060300 MOVE SPACE TO SQ-FS6R1-PART2. SQ1164.2 +060400 REWRITE SQ-FS6R1-F-G-130 FROM FILE-RECORD-INFO-P1-120 (2). SQ1164.2 +060500 IF COUNT-OF-RECS EQUAL TO 240 SQ1164.2 +060600 GO TO REWRITE-CLOSE-SQ-FS6. SQ1164.2 +060700 GO TO REWRITE-INIT-GF-05-A. SQ1164.2 +060800 REWRITE-CLOSE-SQ-FS6. SQ1164.2 +060900 CLOSE SQ-FS6. SQ1164.2 +061000 GO TO REWRITE-READ-INIT-GF-02. SQ1164.2 +061100 CANT-TEST. SQ1164.2 +061200* THIS PARAGRAPH IS EXECUTED ONLY WHEN AN AT END SQ1164.2 +061300* CONDITION OCCURRED WHEN TRYING TO READ AND REWRITE SQ1164.2 +061400* THE FILE SQ-FS6. SQ1164.2 +061500 MOVE "UNEXPECTED EOF" TO COMPUTED-A. SQ1164.2 +061600 MOVE "UNABLE TO UPDATE FILE" TO RE-MARK. SQ1164.2 +061700 PERFORM PRINT-DETAIL. SQ1164.2 +061800 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ1164.2 +061900 MOVE "**** REWRITE TESTS DELETED ****" TO DUMMY-RECORD. SQ1164.2 +062000 PERFORM WRITE-LINE. SQ1164.2 +062100 GO TO SEQ-CLOSE-025. SQ1164.2 +062200 REWRITE-READ-INIT-GF-02. SQ1164.2 +062300 MOVE 0 TO COUNT-OF-RECS. SQ1164.2 +062400 MOVE 0 TO EOF-FLAG. SQ1164.2 +062500 MOVE 0 TO ERROR-FLAG. SQ1164.2 +062600 MOVE 0 TO RECORDS-IN-ERROR. SQ1164.2 +062700 OPEN INPUT SQ-FS6. SQ1164.2 +062800 REWRITE-TEST-GF-02. SQ1164.2 +062900* CHECK THE FIRST 30 RECORDS OF THE FILE. SQ1164.2 +063000* THESE RECORDS WERE NOT REWRITTEN. SQ1164.2 +063100 IF COUNT-OF-RECS EQUAL TO 30 SQ1164.2 +063200 GO TO REWRITE-TEST-GF-02-1. SQ1164.2 +063300 READ SQ-FS6 RECORD SQ1164.2 +063400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +063500 MOVE 1 TO EOF-FLAG SQ1164.2 +063600 GO TO REWRITE-FAIL-GF-02. SQ1164.2 +063700 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +063800 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +063900 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +064000 GO TO REWRITE-TEST-GF-02. SQ1164.2 +064100 IF UPDATE-NUMBER (1) NOT EQUAL TO 0 SQ1164.2 +064200 PERFORM CHECK-RECORD-FAIL SQ1164.2 +064300 GO TO REWRITE-TEST-GF-02. SQ1164.2 +064400 IF UPDATE-AREA-ONLY NOT EQUAL TO "FIRST " SQ1164.2 +064500 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +064600 GO TO REWRITE-TEST-GF-02. SQ1164.2 +064700 REWRITE-TEST-GF-02-1. SQ1164.2 +064800 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +064900 GO TO REWRITE-PASS-GF-02. SQ1164.2 +065000 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +065100 REWRITE-FAIL-GF-02. SQ1164.2 +065200 MOVE "VII-48; 4.5.2 RWRT LARGER RECORDS: TRUNC." TO RE-MARK.SQ1164.2 +065300 PERFORM FAIL. SQ1164.2 +065400 MOVE "CHECK RECORDS NOT REWRITTEN" TO RE-MARK. SQ1164.2 +065500 GO TO REWRITE-WRITE-GF-02. SQ1164.2 +065600 REWRITE-PASS-GF-02. SQ1164.2 +065700 PERFORM PASS. SQ1164.2 +065800 REWRITE-WRITE-GF-02. SQ1164.2 +065900 MOVE "RWRT; LARGER RECORDS " TO FEATURE. SQ1164.2 +066000 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. SQ1164.2 +066100 PERFORM PRINT-DETAIL. SQ1164.2 +066200 GO TO REWRITE-INIT-GF-03. SQ1164.2 +066300 CHECK-RECORD. SQ1164.2 +066400 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +066500 MOVE SQ-FS6R1-PART2 TO END-OF-RECORD-AREA. SQ1164.2 +066600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" SQ1164.2 +066700 GO TO CHECK-RECORD-FAIL. SQ1164.2 +066800 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1164.2 +066900 GO TO CHECK-RECORD-FAIL. SQ1164.2 +067000 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1164.2 +067100 GO TO CHECK-RECORD-FAIL. SQ1164.2 +067200 IF NUMBER-AREA EQUAL TO COUNT-OF-RECS SQ1164.2 +067300 GO TO CHECK-RECORD-EXIT. SQ1164.2 +067400 CHECK-RECORD-FAIL. SQ1164.2 +067500 ADD 1 TO RECORDS-IN-ERROR. SQ1164.2 +067600 MOVE 1 TO ERROR-FLAG. SQ1164.2 +067700 CHECK-RECORD-EXIT. SQ1164.2 +067800 EXIT. SQ1164.2 +067900 REWRITE-INIT-GF-03. SQ1164.2 +068000 MOVE 0 TO ERROR-FLAG. SQ1164.2 +068100 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +068200 GO TO SEQ-EOF-025. SQ1164.2 +068300* THIS TEST CHECKS RECORDS 31 THRU 80 WHICH WERE REWRITTEN. SQ1164.2 +068400 REWRITE-TEST-GF-03. SQ1164.2 +068500 IF COUNT-OF-RECS EQUAL TO 80 SQ1164.2 +068600 GO TO REWRITE-TEST-GF-03-1. SQ1164.2 +068700 READ SQ-FS6 RECORD SQ1164.2 +068800 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +068900 MOVE 1 TO EOF-FLAG SQ1164.2 +069000 GO TO REWRITE-FAIL-GF-03. SQ1164.2 +069100 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +069200 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +069300 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +069400 GO TO REWRITE-TEST-GF-03. SQ1164.2 +069500 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +069600 PERFORM CHECK-RECORD-FAIL SQ1164.2 +069700 GO TO REWRITE-TEST-GF-03. SQ1164.2 +069800 IF UPDATE-AREA-ONLY NOT EQUAL TO "SECOND" SQ1164.2 +069900 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +070000 GO TO REWRITE-TEST-GF-03. SQ1164.2 +070100 REWRITE-TEST-GF-03-1. SQ1164.2 +070200 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +070300 GO TO REWRITE-PASS-GF-03. SQ1164.2 +070400 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +070500 REWRITE-FAIL-GF-03. SQ1164.2 +070600 MOVE "VII-48; 4.5.2 REWRITE OF 130 CHAR RECS " TO RE-MARK.SQ1164.2 +070700 PERFORM FAIL. SQ1164.2 +070800 GO TO REWRITE-WRITE-GF-03. SQ1164.2 +070900 REWRITE-PASS-GF-03. SQ1164.2 +071000 PERFORM PASS. SQ1164.2 +071100 REWRITE-WRITE-GF-03. SQ1164.2 +071200 MOVE "RWRT; SHORTER RECORDS " TO FEATURE. SQ1164.2 +071300 MOVE "RWRT-TEST-GF-03" TO PAR-NAME. SQ1164.2 +071400 PERFORM PRINT-DETAIL. SQ1164.2 +071500 REWRITE-INIT-GF-04. SQ1164.2 +071600 MOVE 0 TO REC-CT. SQ1164.2 +071700 MOVE 0 TO ERROR-FLAG. SQ1164.2 +071800 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +071900 GO TO SEQ-EOF-025. SQ1164.2 +072000* THIS TEST CHECKS THE RECORDS WHICH WERE REWRITTEN SQ1164.2 +072100* FROM AN 139 CHARACTER RECORD. SQ1164.2 +072200 REWRITE-TEST-GF-04. SQ1164.2 +072300 IF COUNT-OF-RECS EQUAL TO 120 SQ1164.2 +072400 GO TO REWRITE-TEST-GF-04-1. SQ1164.2 +072500 READ SQ-FS6 RECORD SQ1164.2 +072600 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +072700 MOVE 1 TO EOF-FLAG SQ1164.2 +072800 GO TO REWRITE-FAIL-GF-04. SQ1164.2 +072900 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +073000 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +073100 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +073200 GO TO REWRITE-TEST-GF-04. SQ1164.2 +073300 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +073400 PERFORM CHECK-RECORD-FAIL SQ1164.2 +073500 GO TO REWRITE-TEST-GF-04. SQ1164.2 +073600 IF UPDATE-AREA-ONLY NOT EQUAL TO "SECOND" SQ1164.2 +073700 PERFORM CHECK-RECORD-FAIL SQ1164.2 +073800 GO TO REWRITE-TEST-GF-04. SQ1164.2 +073900 MOVE SPACE TO AREA2-2. SQ1164.2 +074000 MOVE SQ-FS6R1-F-G-130 TO REWRT-FROM-AREA2. SQ1164.2 +074100 IF AREA2-2 NOT EQUAL TO SPACE SQ1164.2 +074200 MOVE "NO RECORD TRUNCATION" TO RE-MARK SQ1164.2 +074300 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +074400 GO TO REWRITE-TEST-GF-04. SQ1164.2 +074500 REWRITE-TEST-GF-04-1. SQ1164.2 +074600 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +074700 GO TO REWRITE-PASS-GF-04. SQ1164.2 +074800 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +074900 REWRITE-FAIL-GF-04. SQ1164.2 +075000 MOVE "VII-48; 4.5.2 RWRT FROM 139 CHAR REC " TO RE-MARK.SQ1164.2 +075100 PERFORM FAIL. SQ1164.2 +075200 GO TO REWRITE-WRITE-GF-04. SQ1164.2 +075300 REWRITE-PASS-GF-04. SQ1164.2 +075400 PERFORM PASS. SQ1164.2 +075500 REWRITE-WRITE-GF-04. SQ1164.2 +075600 MOVE "RWRT FROM 139" TO FEATURE. SQ1164.2 +075700 MOVE "RWRT-TEST-GF-04" TO PAR-NAME. SQ1164.2 +075800 PERFORM PRINT-DETAIL. SQ1164.2 +075900 REWRITE-INIT-GF-05. SQ1164.2 +076000 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +076100 GO TO SEQ-EOF-025. SQ1164.2 +076200 MOVE 0 TO ERROR-FLAG. SQ1164.2 +076300* THIS TEST CHECKS THE 87 CHARACTER RECORDS WHICH SQ1164.2 +076400* WERE REWRITTEN. CHARACTERS 88 THRU 130 SHOULD BE SPACES. SQ1164.2 +076500 REWRITE-TEST-GF-05. SQ1164.2 +076600 IF COUNT-OF-RECS EQUAL TO 160 SQ1164.2 +076700 GO TO REWRITE-TEST-GF-05-1. SQ1164.2 +076800 READ SQ-FS6 RECORD SQ1164.2 +076900 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +077000 MOVE 1 TO EOF-FLAG SQ1164.2 +077100 GO TO REWRITE-FAIL-GF-05. SQ1164.2 +077200 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +077300 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +077400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" SQ1164.2 +077500 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +077600 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ1164.2 +077700 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +077800 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +077900 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +078000 IF CHARS-OR-RECORDS (1) NOT EQUAL TO SPACE SQ1164.2 +078100 MOVE "NO SPACE FILL" TO RE-MARK SQ1164.2 +078200 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +078300 IF SQ-FS6R1-PART2 NOT EQUAL TO SPACE SQ1164.2 +078400 MOVE "NO SPACE FILL" TO RE-MARK SQ1164.2 +078500 GO TO REWRITE-FAIL-GF-05-1. SQ1164.2 +078600 GO TO REWRITE-TEST-GF-05. SQ1164.2 +078700 REWRITE-FAIL-GF-05-1. SQ1164.2 +078800 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +078900 GO TO REWRITE-TEST-GF-05. SQ1164.2 +079000 REWRITE-TEST-GF-05-1. SQ1164.2 +079100 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +079200 GO TO REWRITE-PASS-GF-05. SQ1164.2 +079300 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +079400 REWRITE-FAIL-GF-05. SQ1164.2 +079500 MOVE "VII-48; 4.5.2 CHARS 88 THRU 139: SPACE} " TO RE-MARK.SQ1164.2 +079600 PERFORM FAIL. SQ1164.2 +079700 GO TO REWRITE-WRITE-GF-05. SQ1164.2 +079800 REWRITE-PASS-GF-05. SQ1164.2 +079900 PERFORM PASS. SQ1164.2 +080000 REWRITE-WRITE-GF-05. SQ1164.2 +080100 MOVE "RWRT SHORTER RECORDS" TO FEATURE. SQ1164.2 +080200 MOVE "RWRT-TEST-GF-05" TO PAR-NAME. SQ1164.2 +080300 PERFORM PRINT-DETAIL. SQ1164.2 +080400 REWRITE-INIT-GF-06. SQ1164.2 +080500 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +080600 GO TO SEQ-EOF-025. SQ1164.2 +080700 MOVE 0 TO ERROR-FLAG. SQ1164.2 +080800* THIS TEST CHECKS THE RECORDS REWRITTEN FROM AN 02 SQ1164.2 +080900* LEVEL ITEM OF 130 CHARACTERS. SQ1164.2 +081000 REWRITE-TEST-GF-06. SQ1164.2 +081100 IF COUNT-OF-RECS EQUAL TO 200 SQ1164.2 +081200 GO TO REWRITE-TEST-GF-06-1. SQ1164.2 +081300 READ SQ-FS6 RECORD SQ1164.2 +081400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +081500 MOVE 1 TO EOF-FLAG SQ1164.2 +081600 GO TO REWRITE-FAIL-GF-06. SQ1164.2 +081700 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +081800 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +081900 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +082000 GO TO REWRITE-TEST-GF-06. SQ1164.2 +082100 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +082200 PERFORM CHECK-RECORD-FAIL SQ1164.2 +082300 GO TO REWRITE-TEST-GF-06. SQ1164.2 +082400 IF UPDATE-AREA-ONLY NOT EQUAL TO "SECOND" SQ1164.2 +082500 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +082600 GO TO REWRITE-TEST-GF-06. SQ1164.2 +082700 REWRITE-TEST-GF-06-1. SQ1164.2 +082800 IF ERROR-FLAG EQUAL TO ZERO SQ1164.2 +082900 GO TO REWRITE-PASS-GF-06. SQ1164.2 +083000 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +083100 REWRITE-FAIL-GF-06. SQ1164.2 +083200 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1164.2 +083300 PERFORM FAIL. SQ1164.2 +083400 GO TO REWRITE-WRITE-GF-06. SQ1164.2 +083500 REWRITE-PASS-GF-06. SQ1164.2 +083600 PERFORM PASS. SQ1164.2 +083700 REWRITE-WRITE-GF-06. SQ1164.2 +083800 MOVE "RWRT FROM 02 LEVEL" TO FEATURE. SQ1164.2 +083900 MOVE "RWRT-TEST-GF-06" TO PAR-NAME. SQ1164.2 +084000 PERFORM PRINT-DETAIL. SQ1164.2 +084100 REWRITE-INIT-GF-07. SQ1164.2 +084200 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +084300 GO TO SEQ-EOF-025. SQ1164.2 +084400 MOVE 0 TO ERROR-FLAG. SQ1164.2 +084500* THIS TEST CHECKS THE RECORDS REWRITTEN FROM AN 05 LEVEL SQ1164.2 +084600* SUBSCRIPTED ITEM. SQ1164.2 +084700 REWRITE-TEST-GF-07. SQ1164.2 +084800 IF COUNT-OF-RECS EQUAL TO 240 SQ1164.2 +084900 GO TO REWRITE-TEST-GF-07-1. SQ1164.2 +085000 READ SQ-FS6 RECORD SQ1164.2 +085100 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +085200 MOVE 1 TO EOF-FLAG SQ1164.2 +085300 GO TO REWRITE-FAIL-GF-07. SQ1164.2 +085400 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +085500 MOVE SQ-FS6R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1164.2 +085600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS6" SQ1164.2 +085700 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +085800 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1164.2 +085900 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +086000 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1164.2 +086100 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +086200 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1164.2 +086300 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +086400 IF SQ-FS6R1-PART2 NOT EQUAL TO SPACE SQ1164.2 +086500 MOVE "NO SPACE FILL" TO RE-MARK SQ1164.2 +086600 GO TO REWRITE-FAIL-GF-07-1. SQ1164.2 +086700 GO TO REWRITE-TEST-GF-07. SQ1164.2 +086800 REWRITE-FAIL-GF-07-1. SQ1164.2 +086900 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +087000 GO TO REWRITE-TEST-GF-07. SQ1164.2 +087100 REWRITE-TEST-GF-07-1. SQ1164.2 +087200 IF ERROR-FLAG EQUAL TO ZERO SQ1164.2 +087300 GO TO REWRITE-PASS-GF-07. SQ1164.2 +087400 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +087500 REWRITE-FAIL-GF-07. SQ1164.2 +087600 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1164.2 +087700 PERFORM FAIL. SQ1164.2 +087800 GO TO REWRITE-WRITE-GF-07. SQ1164.2 +087900 REWRITE-PASS-GF-07. SQ1164.2 +088000 PERFORM PASS. SQ1164.2 +088100 REWRITE-WRITE-GF-07. SQ1164.2 +088200 MOVE "RWRT FROM 05 LEVEL" TO FEATURE. SQ1164.2 +088300 MOVE "RWRT-TEST-GF-07" TO PAR-NAME. SQ1164.2 +088400 PERFORM PRINT-DETAIL. SQ1164.2 +088500 REWRITE-INIT-GF-08. SQ1164.2 +088600 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +088700 GO TO SEQ-EOF-025. SQ1164.2 +088800 MOVE 0 TO ERROR-FLAG. SQ1164.2 +088900* THIS TEST CHECKS RECORDS 241 THRU 550 WHICH WERE NOT SQ1164.2 +089000* REWRITTEN. SQ1164.2 +089100 REWRITE-TEST-GF-08. SQ1164.2 +089200 IF COUNT-OF-RECS EQUAL TO 550 SQ1164.2 +089300 GO TO REWRITE-TEST-GF-08-1. SQ1164.2 +089400 READ SQ-FS6 RECORD SQ1164.2 +089500 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1164.2 +089600 MOVE 1 TO EOF-FLAG SQ1164.2 +089700 GO TO REWRITE-FAIL-GF-08. SQ1164.2 +089800 ADD 1 TO COUNT-OF-RECS. SQ1164.2 +089900 PERFORM CHECK-RECORD THRU CHECK-RECORD-EXIT. SQ1164.2 +090000 IF ERROR-FLAG EQUAL TO 1 SQ1164.2 +090100 GO TO REWRITE-TEST-GF-08. SQ1164.2 +090200 IF UPDATE-NUMBER (1) NOT EQUAL TO 0 SQ1164.2 +090300 PERFORM CHECK-RECORD-FAIL SQ1164.2 +090400 GO TO REWRITE-TEST-GF-08. SQ1164.2 +090500 IF UPDATE-AREA-ONLY NOT EQUAL TO "FIRST " SQ1164.2 +090600 PERFORM CHECK-RECORD-FAIL. SQ1164.2 +090700 GO TO REWRITE-TEST-GF-08. SQ1164.2 +090800 REWRITE-TEST-GF-08-1. SQ1164.2 +090900 IF ERROR-FLAG EQUAL TO 0 SQ1164.2 +091000 GO TO REWRITE-PASS-GF-08. SQ1164.2 +091100 MOVE "ERRORS IN RECORD(S)" TO COMPUTED-A. SQ1164.2 +091200 REWRITE-FAIL-GF-08. SQ1164.2 +091300 MOVE "VII-48; 4.5.2 " TO RE-MARK.SQ1164.2 +091400 PERFORM FAIL. SQ1164.2 +091500 GO TO REWRITE-WRITE-GF-08. SQ1164.2 +091600 REWRITE-PASS-GF-08. SQ1164.2 +091700 PERFORM PASS. SQ1164.2 +091800 REWRITE-WRITE-GF-08. SQ1164.2 +091900 MOVE "RWRT-TEST-GF-08" TO PAR-NAME. SQ1164.2 +092000 MOVE "RECORD NOT REWRITTEN" TO FEATURE. SQ1164.2 +092100 PERFORM PRINT-DETAIL. SQ1164.2 +092200 SEQ-INIT-025. SQ1164.2 +092300* THIS TEST CHECKS IF THERE WERE ANY ERRORS IN THE SQ1164.2 +092400* UPDATED FILE AND READS THE FILE ONCE MORE EXPECTING SQ1164.2 +092500* THE AT END CONDITION TO OCCUR. SQ1164.2 +092600 IF EOF-FLAG EQUAL TO 1 SQ1164.2 +092700 GO TO SEQ-EOF-025. SQ1164.2 +092800 SEQ-TEST-025. SQ1164.2 +092900 READ SQ-FS6 RECORD SQ1164.2 +093000 AT END GO TO SEQ-TEST-25-1. SQ1164.2 +093100 MOVE "MORE THAN 550 RECORDS" TO RE-MARK. SQ1164.2 +093200 GO TO SEQ-FAIL-025. SQ1164.2 +093300 SEQ-TEST-25-1. SQ1164.2 +093400 IF RECORDS-IN-ERROR NOT EQUAL TO 0 SQ1164.2 +093500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1164.2 +093600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1164.2 +093700 GO TO SEQ-FAIL-025. SQ1164.2 +093800 SEQ-PASS-025. SQ1164.2 +093900 PERFORM PASS. SQ1164.2 +094000 GO TO SEQ-WRITE-025. SQ1164.2 +094100 SEQ-EOF-025. SQ1164.2 +094200 MOVE "LESS THAN 550 RECORDS" TO RE-MARK. SQ1164.2 +094300 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1164.2 +094400 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1164.2 +094500 SEQ-FAIL-025. SQ1164.2 +094600 PERFORM FAIL. SQ1164.2 +094700 SEQ-WRITE-025. SQ1164.2 +094800 MOVE "SEQ-TEST-025" TO PAR-NAME. SQ1164.2 +094900 MOVE "READ LAST RECORD" TO FEATURE. SQ1164.2 +095000 PERFORM PRINT-DETAIL. SQ1164.2 +095100 SEQ-CLOSE-025. SQ1164.2 +095200 CLOSE SQ-FS6. SQ1164.2 +095300 TERMINATE-ROUTINE. SQ1164.2 +095400 EXIT. SQ1164.2 +095500 CCVS-EXIT SECTION. SQ1164.2 +095600 CCVS-999999. SQ1164.2 +095700 GO TO CLOSE-FILES. SQ1164.2 diff --git a/tests/cobol85/SQ/SQ117A.CBL b/tests/cobol85/SQ/SQ117A.CBL new file mode 100755 index 00000000..16e23098 --- /dev/null +++ b/tests/cobol85/SQ/SQ117A.CBL @@ -0,0 +1,817 @@ +000100 IDENTIFICATION DIVISION. SQ1174.2 +000200 PROGRAM-ID. SQ1174.2 +000300 SQ117A. SQ1174.2 +000400**************************************************************** SQ1174.2 +000500* * SQ1174.2 +000600* VALIDATION FOR:- * SQ1174.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1174.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1174.2 +000900* * SQ1174.2 +001000* CREATION DATE / VALIDATION DATE * SQ1174.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1174.2 +001200* * SQ1174.2 +001300**************************************************************** SQ1174.2 +001400 SQ1174.2 +001500* THIS ROUTINE CREATES A SEQUENTIAL MASS STORAGE FILE SQ1174.2 +001600* USING WRITE...FROM STATEMENTS. THE FILE IS READ AND FIELDS SQ1174.2 +001700* IN THE RECORDS ARE CHECKED TO ENSURE THAT TRUNCATION AND SQ1174.2 +001800* BLANK FILLING OF THE RECORD OCCURS WHEN REQUIRED. SQ1174.2 +001900* SQ1174.2 +002000* USED X-CARDS: SQ1174.2 +002100* XXXXX014 SQ1174.2 +002200* XXXXX055 SQ1174.2 +002300* P XXXXX062 SQ1174.2 +002400* XXXXX082 SQ1174.2 +002500* XXXXX083 SQ1174.2 +002600* C XXXXX084 SQ1174.2 +002700* SQ1174.2 +002800* SQ1174.2 +002900 ENVIRONMENT DIVISION. SQ1174.2 +003000 CONFIGURATION SECTION. SQ1174.2 +003100 SOURCE-COMPUTER. SQ1174.2 +003200 Linux. SQ1174.2 +003300 OBJECT-COMPUTER. SQ1174.2 +003400 Linux. SQ1174.2 +003500 INPUT-OUTPUT SECTION. SQ1174.2 +003600 FILE-CONTROL. SQ1174.2 +003700*P SELECT RAW-DATA ASSIGN TO SQ1174.2 +003800*P "XXXXX062" SQ1174.2 +003900*P ORGANIZATION IS INDEXED SQ1174.2 +004000*P ACCESS MODE IS RANDOM SQ1174.2 +004100*P RECORD KEY IS RAW-DATA-KEY. SQ1174.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1174.2 +004300 "report.log". SQ1174.2 +004400 SELECT SQ-FS9 ASSIGN TO SQ1174.2 +004500 "XXXXX014" SQ1174.2 +004600 ORGANIZATION IS SEQUENTIAL SQ1174.2 +004700 ACCESS MODE IS SEQUENTIAL. SQ1174.2 +004800 DATA DIVISION. SQ1174.2 +004900 FILE SECTION. SQ1174.2 +005000*P SQ1174.2 +005100*PD RAW-DATA. SQ1174.2 +005200*P SQ1174.2 +005300*P1 RAW-DATA-SATZ. SQ1174.2 +005400*P 05 RAW-DATA-KEY PIC X(6). SQ1174.2 +005500*P 05 C-DATE PIC 9(6). SQ1174.2 +005600*P 05 C-TIME PIC 9(8). SQ1174.2 +005700*P 05 C-NO-OF-TESTS PIC 99. SQ1174.2 +005800*P 05 C-OK PIC 999. SQ1174.2 +005900*P 05 C-ALL PIC 999. SQ1174.2 +006000*P 05 C-FAIL PIC 999. SQ1174.2 +006100*P 05 C-DELETED PIC 999. SQ1174.2 +006200*P 05 C-INSPECT PIC 999. SQ1174.2 +006300*P 05 C-NOTE PIC X(13). SQ1174.2 +006400*P 05 C-INDENT PIC X. SQ1174.2 +006500*P 05 C-ABORT PIC X(8). SQ1174.2 +006600 FD PRINT-FILE SQ1174.2 +006700*C LABEL RECORDS SQ1174.2 +006800*C OMITTED SQ1174.2 +006900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1174.2 +007000 . SQ1174.2 +007100 01 PRINT-REC PICTURE X(120). SQ1174.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ1174.2 +007300 FD SQ-FS9 SQ1174.2 +007400*C LABEL RECORD STANDARD SQ1174.2 +007500 BLOCK CONTAINS 1 RECORDS. SQ1174.2 +007600 01 SQ-FS9R1-F-G-141. SQ1174.2 +007700 02 SQ-FS9R1-PART1 PICTURE X(120). SQ1174.2 +007800 02 SQ-FS9R1-PART2 PICTURE X(21). SQ1174.2 +007900 WORKING-STORAGE SECTION. SQ1174.2 +008000 01 COUNT-OF-RECS PICTURE 9(5) VALUE 0. SQ1174.2 +008100 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. SQ1174.2 +008200 01 ERROR-FLAG PICTURE 9 VALUE 0. SQ1174.2 +008300 01 EOF-FLAG PIC 9 VALUE 0. SQ1174.2 +008400 01 WRITE-FROM-AREA1. SQ1174.2 +008500 02 AREA1-1 PIC X(87). SQ1174.2 +008600 01 FOLLOWS-AREA1 PIC X(10). SQ1174.2 +008700 01 WRITE-FROM-AREA2. SQ1174.2 +008800 02 AREA2-1 PIC X(120). SQ1174.2 +008900 01 WRITE-FROM-AREA3. SQ1174.2 +009000 02 AREA3-1 PIC X(141). SQ1174.2 +009100 02 AREA3-2 PIC X(7). SQ1174.2 +009200 01 WRITE-FROM-AREA4. SQ1174.2 +009300 02 AREA4-1 PIC X(120). SQ1174.2 +009400 02 AREA4-2 PIC X(21). SQ1174.2 +009500 01 END-OF-RECORD-AREA. SQ1174.2 +009600 02 ALPHA-AREA PIC X(17). SQ1174.2 +009700 02 NUMBER-AREA PIC 9999. SQ1174.2 +009800 01 FILE-RECORD-INFORMATION-REC. SQ1174.2 +009900 03 FILE-RECORD-INFO-SKELETON. SQ1174.2 +010000 05 FILLER PICTURE X(48) VALUE SQ1174.2 +010100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1174.2 +010200 05 FILLER PICTURE X(46) VALUE SQ1174.2 +010300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1174.2 +010400 05 FILLER PICTURE X(26) VALUE SQ1174.2 +010500 ",LFIL=000000,ORG= ,LBLR= ". SQ1174.2 +010600 05 FILLER PICTURE X(37) VALUE SQ1174.2 +010700 ",RECKEY= ". SQ1174.2 +010800 05 FILLER PICTURE X(38) VALUE SQ1174.2 +010900 ",ALTKEY1= ". SQ1174.2 +011000 05 FILLER PICTURE X(38) VALUE SQ1174.2 +011100 ",ALTKEY2= ". SQ1174.2 +011200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1174.2 +011300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1174.2 +011400 05 FILE-RECORD-INFO-P1-120. SQ1174.2 +011500 07 FILLER PIC X(5). SQ1174.2 +011600 07 XFILE-NAME PIC X(6). SQ1174.2 +011700 07 FILLER PIC X(8). SQ1174.2 +011800 07 XRECORD-NAME PIC X(6). SQ1174.2 +011900 07 FILLER PIC X(1). SQ1174.2 +012000 07 REELUNIT-NUMBER PIC 9(1). SQ1174.2 +012100 07 FILLER PIC X(7). SQ1174.2 +012200 07 XRECORD-NUMBER PIC 9(6). SQ1174.2 +012300 07 FILLER PIC X(6). SQ1174.2 +012400 07 UPDATE-NUMBER PIC 9(2). SQ1174.2 +012500 07 FILLER PIC X(5). SQ1174.2 +012600 07 ODO-NUMBER PIC 9(4). SQ1174.2 +012700 07 FILLER PIC X(5). SQ1174.2 +012800 07 XPROGRAM-NAME PIC X(5). SQ1174.2 +012900 07 FILLER PIC X(7). SQ1174.2 +013000 07 XRECORD-LENGTH PIC 9(6). SQ1174.2 +013100 07 FILLER PIC X(7). SQ1174.2 +013200 07 CHARS-OR-RECORDS PIC X(2). SQ1174.2 +013300 07 FILLER PIC X(1). SQ1174.2 +013400 07 XBLOCK-SIZE PIC 9(4). SQ1174.2 +013500 07 FILLER PIC X(6). SQ1174.2 +013600 07 RECORDS-IN-FILE PIC 9(6). SQ1174.2 +013700 07 FILLER PIC X(5). SQ1174.2 +013800 07 XFILE-ORGANIZATION PIC X(2). SQ1174.2 +013900 07 FILLER PIC X(6). SQ1174.2 +014000 07 XLABEL-TYPE PIC X(1). SQ1174.2 +014100 05 FILE-RECORD-INFO-P121-240. SQ1174.2 +014200 07 FILLER PIC X(8). SQ1174.2 +014300 07 XRECORD-KEY PIC X(29). SQ1174.2 +014400 07 FILLER PIC X(9). SQ1174.2 +014500 07 ALTERNATE-KEY1 PIC X(29). SQ1174.2 +014600 07 FILLER PIC X(9). SQ1174.2 +014700 07 ALTERNATE-KEY2 PIC X(29). SQ1174.2 +014800 07 FILLER PIC X(7). SQ1174.2 +014900 01 TEST-RESULTS. SQ1174.2 +015000 02 FILLER PICTURE X VALUE SPACE. SQ1174.2 +015100 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1174.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ1174.2 +015300 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1174.2 +015400 02 FILLER PICTURE X VALUE SPACE. SQ1174.2 +015500 02 PAR-NAME. SQ1174.2 +015600 03 FILLER PICTURE X(12) VALUE SPACE. SQ1174.2 +015700 03 PARDOT-X PICTURE X VALUE SPACE. SQ1174.2 +015800 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1174.2 +015900 03 FILLER PIC X(5) VALUE SPACE. SQ1174.2 +016000 02 FILLER PIC X(10) VALUE SPACE. SQ1174.2 +016100 02 RE-MARK PIC X(61). SQ1174.2 +016200 01 TEST-COMPUTED. SQ1174.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1174.2 +016400 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1174.2 +016500 02 COMPUTED-X. SQ1174.2 +016600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1174.2 +016700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1174.2 +016800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1174.2 +016900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1174.2 +017000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1174.2 +017100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1174.2 +017200 04 COMPUTED-18V0 PICTURE -9(18). SQ1174.2 +017300 04 FILLER PICTURE X. SQ1174.2 +017400 03 FILLER PIC X(50) VALUE SPACE. SQ1174.2 +017500 01 TEST-CORRECT. SQ1174.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SQ1174.2 +017700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1174.2 +017800 02 CORRECT-X. SQ1174.2 +017900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1174.2 +018000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1174.2 +018100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1174.2 +018200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1174.2 +018300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1174.2 +018400 03 CR-18V0 REDEFINES CORRECT-A. SQ1174.2 +018500 04 CORRECT-18V0 PICTURE -9(18). SQ1174.2 +018600 04 FILLER PICTURE X. SQ1174.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SQ1174.2 +018800 01 CCVS-C-1. SQ1174.2 +018900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1174.2 +019000- "SS PARAGRAPH-NAME SQ1174.2 +019100- " REMARKS". SQ1174.2 +019200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1174.2 +019300 01 CCVS-C-2. SQ1174.2 +019400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1174.2 +019500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1174.2 +019600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1174.2 +019700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1174.2 +019800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1174.2 +019900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1174.2 +020000 01 REC-CT PICTURE 99 VALUE ZERO. SQ1174.2 +020100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1174.2 +020200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1174.2 +020300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1174.2 +020400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1174.2 +020500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1174.2 +020600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1174.2 +020700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1174.2 +020800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1174.2 +020900 01 CCVS-H-1. SQ1174.2 +021000 02 FILLER PICTURE X(27) VALUE SPACE. SQ1174.2 +021100 02 FILLER PICTURE X(67) VALUE SQ1174.2 +021200 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1174.2 +021300- " SYSTEM". SQ1174.2 +021400 02 FILLER PICTURE X(26) VALUE SPACE. SQ1174.2 +021500 01 CCVS-H-2. SQ1174.2 +021600 02 FILLER PICTURE X(52) VALUE IS SQ1174.2 +021700 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1174.2 +021800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1174.2 +021900 02 TEST-ID PICTURE IS X(9). SQ1174.2 +022000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1174.2 +022100 01 CCVS-H-3. SQ1174.2 +022200 02 FILLER PICTURE X(34) VALUE SQ1174.2 +022300 " FOR OFFICIAL USE ONLY ". SQ1174.2 +022400 02 FILLER PICTURE X(58) VALUE SQ1174.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1174.2 +022600 02 FILLER PICTURE X(28) VALUE SQ1174.2 +022700 " COPYRIGHT 1985 ". SQ1174.2 +022800 01 CCVS-E-1. SQ1174.2 +022900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1174.2 +023000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1174.2 +023100 02 ID-AGAIN PICTURE IS X(9). SQ1174.2 +023200 02 FILLER PICTURE X(45) VALUE IS SQ1174.2 +023300 " NTIS DISTRIBUTION COBOL 85". SQ1174.2 +023400 01 CCVS-E-2. SQ1174.2 +023500 02 FILLER PICTURE X(31) VALUE SQ1174.2 +023600 SPACE. SQ1174.2 +023700 02 FILLER PICTURE X(21) VALUE SPACE. SQ1174.2 +023800 02 CCVS-E-2-2. SQ1174.2 +023900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1174.2 +024000 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1174.2 +024100 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1174.2 +024200 01 CCVS-E-3. SQ1174.2 +024300 02 FILLER PICTURE X(22) VALUE SQ1174.2 +024400 " FOR OFFICIAL USE ONLY". SQ1174.2 +024500 02 FILLER PICTURE X(12) VALUE SPACE. SQ1174.2 +024600 02 FILLER PICTURE X(58) VALUE SQ1174.2 +024700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1174.2 +024800 02 FILLER PICTURE X(13) VALUE SPACE. SQ1174.2 +024900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1174.2 +025000 01 CCVS-E-4. SQ1174.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1174.2 +025200 02 FILLER PIC XXXX VALUE " OF ". SQ1174.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1174.2 +025400 02 FILLER PIC X(40) VALUE SQ1174.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1174.2 +025600 01 XXINFO. SQ1174.2 +025700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1174.2 +025800 02 INFO-TEXT. SQ1174.2 +025900 04 FILLER PIC X(20) VALUE SPACE. SQ1174.2 +026000 04 XXCOMPUTED PIC X(20). SQ1174.2 +026100 04 FILLER PIC X(5) VALUE SPACE. SQ1174.2 +026200 04 XXCORRECT PIC X(20). SQ1174.2 +026300 01 HYPHEN-LINE. SQ1174.2 +026400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1174.2 +026500 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1174.2 +026600- "*****************************************". SQ1174.2 +026700 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1174.2 +026800- "******************************". SQ1174.2 +026900 01 CCVS-PGM-ID PIC X(6) VALUE SQ1174.2 +027000 "SQ117A". SQ1174.2 +027100 PROCEDURE DIVISION. SQ1174.2 +027200 CCVS1 SECTION. SQ1174.2 +027300 OPEN-FILES. SQ1174.2 +027400*P OPEN I-O RAW-DATA. SQ1174.2 +027500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1174.2 +027600*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1174.2 +027700*P MOVE "ABORTED " TO C-ABORT. SQ1174.2 +027800*P ADD 1 TO C-NO-OF-TESTS. SQ1174.2 +027900*P ACCEPT C-DATE FROM DATE. SQ1174.2 +028000*P ACCEPT C-TIME FROM TIME. SQ1174.2 +028100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1174.2 +028200*PND-E-1. SQ1174.2 +028300*P CLOSE RAW-DATA. SQ1174.2 +028400 OPEN OUTPUT PRINT-FILE. SQ1174.2 +028500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1174.2 +028600 MOVE SPACE TO TEST-RESULTS. SQ1174.2 +028700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1174.2 +028800 MOVE ZERO TO REC-SKL-SUB. SQ1174.2 +028900 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1174.2 +029000 CCVS-INIT-FILE. SQ1174.2 +029100 ADD 1 TO REC-SKL-SUB. SQ1174.2 +029200 MOVE FILE-RECORD-INFO-SKELETON TO SQ1174.2 +029300 FILE-RECORD-INFO (REC-SKL-SUB). SQ1174.2 +029400 CCVS-INIT-EXIT. SQ1174.2 +029500 GO TO CCVS1-EXIT. SQ1174.2 +029600 CLOSE-FILES. SQ1174.2 +029700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1174.2 +029800*P OPEN I-O RAW-DATA. SQ1174.2 +029900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1174.2 +030000*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1174.2 +030100*P MOVE "OK. " TO C-ABORT. SQ1174.2 +030200*P MOVE PASS-COUNTER TO C-OK. SQ1174.2 +030300*P MOVE ERROR-HOLD TO C-ALL. SQ1174.2 +030400*P MOVE ERROR-COUNTER TO C-FAIL. SQ1174.2 +030500*P MOVE DELETE-CNT TO C-DELETED. SQ1174.2 +030600*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1174.2 +030700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1174.2 +030800*PND-E-2. SQ1174.2 +030900*P CLOSE RAW-DATA. SQ1174.2 +031000 TERMINATE-CCVS. SQ1174.2 +031100*S EXIT PROGRAM. SQ1174.2 +031200*SERMINATE-CALL. SQ1174.2 +031300 STOP RUN. SQ1174.2 +031400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1174.2 +031500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1174.2 +031600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1174.2 +031700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1174.2 +031800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1174.2 +031900 PRINT-DETAIL. SQ1174.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1174.2 +032100 MOVE "." TO PARDOT-X SQ1174.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1174.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1174.2 +032400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1174.2 +032500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1174.2 +032600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1174.2 +032700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1174.2 +032800 MOVE SPACE TO CORRECT-X. SQ1174.2 +032900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1174.2 +033000 MOVE SPACE TO RE-MARK. SQ1174.2 +033100 HEAD-ROUTINE. SQ1174.2 +033200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +033300 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1174.2 +033400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1174.2 +033500 COLUMN-NAMES-ROUTINE. SQ1174.2 +033600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +033700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +033800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +033900 END-ROUTINE. SQ1174.2 +034000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1174.2 +034100 END-RTN-EXIT. SQ1174.2 +034200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +034300 END-ROUTINE-1. SQ1174.2 +034400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1174.2 +034500 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1174.2 +034600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1174.2 +034700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1174.2 +034800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1174.2 +034900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1174.2 +035000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1174.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1174.2 +035200 END-ROUTINE-12. SQ1174.2 +035300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1174.2 +035400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1174.2 +035500 MOVE "NO " TO ERROR-TOTAL SQ1174.2 +035600 ELSE SQ1174.2 +035700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1174.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1174.2 +035900 PERFORM WRITE-LINE. SQ1174.2 +036000 END-ROUTINE-13. SQ1174.2 +036100 IF DELETE-CNT IS EQUAL TO ZERO SQ1174.2 +036200 MOVE "NO " TO ERROR-TOTAL ELSE SQ1174.2 +036300 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1174.2 +036400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1174.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +036600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1174.2 +036700 MOVE "NO " TO ERROR-TOTAL SQ1174.2 +036800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1174.2 +036900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1174.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +037100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1174.2 +037200 WRITE-LINE. SQ1174.2 +037300 ADD 1 TO RECORD-COUNT. SQ1174.2 +037400 IF RECORD-COUNT GREATER 50 SQ1174.2 +037500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1174.2 +037600 MOVE SPACE TO DUMMY-RECORD SQ1174.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1174.2 +037800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1174.2 +037900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1174.2 +038000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1174.2 +038100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1174.2 +038200 MOVE ZERO TO RECORD-COUNT. SQ1174.2 +038300 PERFORM WRT-LN. SQ1174.2 +038400 WRT-LN. SQ1174.2 +038500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1174.2 +038600 MOVE SPACE TO DUMMY-RECORD. SQ1174.2 +038700 BLANK-LINE-PRINT. SQ1174.2 +038800 PERFORM WRT-LN. SQ1174.2 +038900 FAIL-ROUTINE. SQ1174.2 +039000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1174.2 +039100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1174.2 +039200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1174.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +039400 GO TO FAIL-ROUTINE-EX. SQ1174.2 +039500 FAIL-ROUTINE-WRITE. SQ1174.2 +039600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1174.2 +039700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +039800 FAIL-ROUTINE-EX. EXIT. SQ1174.2 +039900 BAIL-OUT. SQ1174.2 +040000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1174.2 +040100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1174.2 +040200 BAIL-OUT-WRITE. SQ1174.2 +040300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1174.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1174.2 +040500 BAIL-OUT-EX. EXIT. SQ1174.2 +040600 CCVS1-EXIT. SQ1174.2 +040700 EXIT. SQ1174.2 +040800 SECT-SQ117A-0001 SECTION. SQ1174.2 +040900 WRITE-INIT-GF-01. SQ1174.2 +041000 MOVE "SQ-FS9" TO XFILE-NAME (1). SQ1174.2 +041100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1174.2 +041200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1174.2 +041300 MOVE 141 TO XRECORD-LENGTH (1). SQ1174.2 +041400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1174.2 +041500 MOVE 1 TO XBLOCK-SIZE (1). SQ1174.2 +041600 MOVE 493 TO RECORDS-IN-FILE (1). SQ1174.2 +041700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1174.2 +041800 MOVE "O" TO XLABEL-TYPE (1). SQ1174.2 +041900 OPEN OUTPUT SQ-FS9. SQ1174.2 +042000 MOVE "WRITE...FROM FILE" TO ALPHA-AREA. SQ1174.2 +042100 WRITE-TEST-GF-01. SQ1174.2 +042200 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +042300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +042400 MOVE COUNT-OF-RECS TO NUMBER-AREA. SQ1174.2 +042500 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA4-1. SQ1174.2 +042600 MOVE END-OF-RECORD-AREA TO AREA4-2. SQ1174.2 +042700 WRITE SQ-FS9R1-F-G-141 FROM WRITE-FROM-AREA4. SQ1174.2 +042800* THIS TEST CONTAINS A WRITE RECORD FROM IDENTIFIER SQ1174.2 +042900* STATEMENT WITH THE SIZE OF THE IDENTIFIER EQUAL TO THE SIZE SQ1174.2 +043000* OF FILE RECORD. THE IDENTIFIER AREA IS CHECKED AFTER THE SQ1174.2 +043100* WRITE TO ENSURE THIS AREA WAS LEFT INTACT BY THE WRITE SQ1174.2 +043200* STATEMENT. SQ1174.2 +043300 IF FILE-RECORD-INFO-P1-120 (1) NOT EQUAL TO AREA4-1 SQ1174.2 +043400 MOVE 1 TO ERROR-FLAG. SQ1174.2 +043500 IF END-OF-RECORD-AREA NOT EQUAL TO AREA4-2 SQ1174.2 +043600 MOVE 1 TO ERROR-FLAG. SQ1174.2 +043700 IF COUNT-OF-RECS EQUAL TO 50 SQ1174.2 +043800 GO TO WRITE-TEST-GF-01-1. SQ1174.2 +043900 GO TO WRITE-TEST-GF-01. SQ1174.2 +044000 WRITE-TEST-GF-01-1. SQ1174.2 +044100 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +044200 GO TO WRITE-PASS-GF-01. SQ1174.2 +044300 WRITE-FAIL-GF-01. SQ1174.2 +044400 MOVE "VII-53; 4.7.3 (4); FROM AREA DESTROYED BY WRITE" SQ1174.2 +044500 TO RE-MARK. SQ1174.2 +044600 GO TO WRITE-WRITE-GF-01. SQ1174.2 +044700 WRITE-PASS-GF-01. SQ1174.2 +044800 PERFORM PASS. SQ1174.2 +044900 WRITE-WRITE-GF-01. SQ1174.2 +045000 MOVE "WRTE-TEST-GF-01" TO PAR-NAME. SQ1174.2 +045100 MOVE "WRITE...FROM EQUAL" TO FEATURE. SQ1174.2 +045200 PERFORM PRINT-DETAIL. SQ1174.2 +045300 WRITE-INIT-GF-02-A. SQ1174.2 +045400* THIS TEST WRITES A RECORD FROM AN IDENTIFIER WHICH IS SQ1174.2 +045500* LARGER THAN THE SIZE OF THE FILE RECORD. THE RIGHTMOST 7 SQ1174.2 +045600* CHARACTERS SHOULD BE TRUNCATED IN THE OUTPUT RECORD. SQ1174.2 +045700 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +045800 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +045900 MOVE COUNT-OF-RECS TO NUMBER-AREA. SQ1174.2 +046000 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA4-1. SQ1174.2 +046100 MOVE END-OF-RECORD-AREA TO AREA4-2. SQ1174.2 +046200 MOVE WRITE-FROM-AREA4 TO AREA3-1. SQ1174.2 +046300 MOVE "ABCDEFG" TO AREA3-2. SQ1174.2 +046400 WRITE SQ-FS9R1-F-G-141 FROM WRITE-FROM-AREA3. SQ1174.2 +046500 IF COUNT-OF-RECS EQUAL TO 100 SQ1174.2 +046600 GO TO WRITE-INIT-GF-03-A. SQ1174.2 +046700 GO TO WRITE-INIT-GF-02-A. SQ1174.2 +046800 WRITE-INIT-GF-03-A. SQ1174.2 +046900* THIS TEST WRITES A RECORD FROM AN IDENTIFIER OF 87 SQ1174.2 +047000* CHARACTERS LENGTH. IN THE OUTPUT RECORD CHARACTERS 88 SQ1174.2 +047100* THROUGH 141 SHOULD BE BLANK. ONLY THE NUMBER OF CHARACTERS SQ1174.2 +047200* IN THE FROM IDENTIFIER SHOULD BE MOVED TO THE OUTPUT RECORD. SQ1174.2 +047300* THE CHARACTERS IN THE AREA FOLLOWING IDENTIFIER SQ1174.2 +047400* ARE NOT MOVED INTO THE OUTPUT AREA. SQ1174.2 +047500 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +047600 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +047700 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA1-1. SQ1174.2 +047800 MOVE "ZXYUVST" TO FOLLOWS-AREA1. SQ1174.2 +047900 WRITE SQ-FS9R1-F-G-141 FROM WRITE-FROM-AREA1. SQ1174.2 +048000 IF COUNT-OF-RECS EQUAL TO 150 SQ1174.2 +048100 GO TO WRITE-INIT-GF-04-A. SQ1174.2 +048200 GO TO WRITE-INIT-GF-03-A. SQ1174.2 +048300 WRITE-INIT-GF-04-A. SQ1174.2 +048400* THIS TEST WRITES A RECORD FROM AN IDENTIFIER OF 120 SQ1174.2 +048500* CHARACTERS. THE LAST 21 CHARACTERS IN THE FD RECORD AREA SQ1174.2 +048600* ARE SET TO JUNK WHICH SHOULD BE REPLACED WITH BLANKS DURING SQ1174.2 +048700* THE WRITE...FROM STATEMENT. THE IDENTIFIER IS LEVEL 02. SQ1174.2 +048800 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +048900 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +049000 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA2-1. SQ1174.2 +049100 MOVE "AREA SHOULD BE BLANK" TO SQ-FS9R1-PART2. SQ1174.2 +049200 WRITE SQ-FS9R1-F-G-141 FROM AREA2-1. SQ1174.2 +049300 IF COUNT-OF-RECS EQUAL TO 200 SQ1174.2 +049400 GO TO WRITE-INIT-GF-05-A. SQ1174.2 +049500 GO TO WRITE-INIT-GF-04-A. SQ1174.2 +049600 WRITE-INIT-GF-05-A. SQ1174.2 +049700* THIS TEST WRITES A RECORD OF 121 CHARACTERS FROM A SQ1174.2 +049800* SUBSCRIPTED DATA ITEM. THE LAST 21 CHARACTERS IN THE FD SQ1174.2 +049900* RECORD AREA ARE SET TO JUNK WHICH SHOULD BE REPLACED WITH SQ1174.2 +050000* BLANKS DURING THE WRITE...FROM STATEMENT. IDENT IS LEVEL 05. SQ1174.2 +050100 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +050200 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +050300 MOVE "AREA SHOULD BE BLANK" TO SQ-FS9R1-PART2. SQ1174.2 +050400 WRITE SQ-FS9R1-F-G-141 FROM FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +050500 IF COUNT-OF-RECS EQUAL TO 250 SQ1174.2 +050600 GO TO WRITE-INIT-GF-06-A. SQ1174.2 +050700 GO TO WRITE-INIT-GF-05-A. SQ1174.2 +050800 WRITE-INIT-GF-06-A. SQ1174.2 +050900* THIS TEST WRITES RECORDS FROM AN IDENTIFIER THE SAME SQ1174.2 +051000* SIZE AS THE OUTPUT RECORD AREA. SQ1174.2 +051100 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +051200 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ1174.2 +051300 MOVE COUNT-OF-RECS TO NUMBER-AREA. SQ1174.2 +051400 MOVE FILE-RECORD-INFO-P1-120 (1) TO AREA4-1. SQ1174.2 +051500 MOVE END-OF-RECORD-AREA TO AREA4-2. SQ1174.2 +051600 WRITE SQ-FS9R1-F-G-141 FROM WRITE-FROM-AREA4. SQ1174.2 +051700 IF COUNT-OF-RECS EQUAL TO 493 SQ1174.2 +051800 GO TO WRITE-FROM-CLOSE. SQ1174.2 +051900 GO TO WRITE-INIT-GF-06-A. SQ1174.2 +052000 WRITE-FROM-CLOSE. SQ1174.2 +052100 CLOSE SQ-FS9. SQ1174.2 +052200 MOVE 0 TO ERROR-FLAG. SQ1174.2 +052300 MOVE 0 TO COUNT-OF-RECS. SQ1174.2 +052400 WRITE-INIT-GF-02. SQ1174.2 +052500 OPEN INPUT SQ-FS9. SQ1174.2 +052600 WRITE-TEST-GF-02. SQ1174.2 +052700 IF COUNT-OF-RECS EQUAL TO 50 SQ1174.2 +052800 GO TO WRITE-TEST-GF-02-1. SQ1174.2 +052900 READ SQ-FS9 RECORD SQ1174.2 +053000 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +053100 MOVE 1 TO EOF-FLAG SQ1174.2 +053200 GO TO WRITE-FAIL-GF-02. SQ1174.2 +053300 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +053400 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +053500 MOVE SQ-FS9R1-PART2 TO END-OF-RECORD-AREA. SQ1174.2 +053600 IF ALPHA-AREA NOT EQUAL TO "WRITE...FROM FILE" SQ1174.2 +053700 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +053800 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +053900 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +054000 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +054100 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +054200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +054300 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +054400 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +054500 GO TO WRITE-FAIL-GF-02-1. SQ1174.2 +054600 GO TO WRITE-TEST-GF-02. SQ1174.2 +054700 WRITE-FAIL-GF-02-1. SQ1174.2 +054800 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +054900 MOVE 1 TO ERROR-FLAG. SQ1174.2 +055000 GO TO WRITE-TEST-GF-02. SQ1174.2 +055100 WRITE-TEST-GF-02-1. SQ1174.2 +055200 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +055300 GO TO WRITE-PASS-GF-02. SQ1174.2 +055400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +055500 WRITE-FAIL-GF-02. SQ1174.2 +055600 MOVE "VII-53; 4.7.3 (3) LARGER RECORDS:TRUNCATED "SQ1174.2 +055700 TO RE-MARK. SQ1174.2 +055800 PERFORM FAIL. SQ1174.2 +055900 GO TO WRITE-WRITE-GF-02. SQ1174.2 +056000 WRITE-PASS-GF-02. SQ1174.2 +056100 PERFORM PASS. SQ1174.2 +056200 WRITE-WRITE-GF-02. SQ1174.2 +056300 MOVE "WRITE .. FROM LARGER" TO FEATURE. SQ1174.2 +056400 MOVE "WRTE-TEST-GF-02" TO PAR-NAME. SQ1174.2 +056500 PERFORM PRINT-DETAIL. SQ1174.2 +056600 WRITE-INIT-GF-03. SQ1174.2 +056700 MOVE 0 TO ERROR-FLAG. SQ1174.2 +056800 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +056900 GO TO SEQ-EOF-22. SQ1174.2 +057000 MOVE "WRTE-TEST-GF-03" TO PAR-NAME. SQ1174.2 +057100 MOVE "WRITE ... FROP SHORTER" TO FEATURE. SQ1174.2 +057200 WRITE-TEST-GF-03. SQ1174.2 +057300 IF COUNT-OF-RECS EQUAL TO 100 SQ1174.2 +057400 GO TO WRITE-TEST-GF-03-1. SQ1174.2 +057500 READ SQ-FS9 RECORD SQ1174.2 +057600 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +057700 MOVE 1 TO EOF-FLAG SQ1174.2 +057800 GO TO WRITE-FAIL-GF-03. SQ1174.2 +057900 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +058000 MOVE SPACE TO AREA3-2. SQ1174.2 +058100 MOVE SQ-FS9R1-F-G-141 TO WRITE-FROM-AREA3. SQ1174.2 +058200 IF AREA3-2 NOT EQUAL TO SPACE SQ1174.2 +058300 MOVE "NO TRUNCATION" TO RE-MARK SQ1174.2 +058400 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +058500 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +058600 MOVE SQ-FS9R1-PART2 TO END-OF-RECORD-AREA. SQ1174.2 +058700 IF ALPHA-AREA NOT EQUAL TO "WRITE...FROM FILE" SQ1174.2 +058800 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +058900 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +059000 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +059100 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +059200 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +059300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +059400 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +059500 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +059600 GO TO WRITE-FAIL-GF-03-1. SQ1174.2 +059700 GO TO WRITE-TEST-GF-03. SQ1174.2 +059800 WRITE-FAIL-GF-03-1. SQ1174.2 +059900 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +060000 MOVE 1 TO ERROR-FLAG. SQ1174.2 +060100 GO TO WRITE-TEST-GF-03. SQ1174.2 +060200 WRITE-TEST-GF-03-1. SQ1174.2 +060300 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +060400 GO TO WRITE-PASS-GF-03. SQ1174.2 +060500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +060600 WRITE-FAIL-GF-03. SQ1174.2 +060700 MOVE "VII-53; 4.7.3 (3) SHORTER RECORDS: NOT SPACE FILLED "SQ1174.2 +060800 TO RE-MARK. SQ1174.2 +060900 PERFORM FAIL. SQ1174.2 +061000 GO TO WRITE-WRITE-GF-03. SQ1174.2 +061100 WRITE-PASS-GF-03. SQ1174.2 +061200 PERFORM PASS. SQ1174.2 +061300 WRITE-WRITE-GF-03. SQ1174.2 +061400 PERFORM PRINT-DETAIL. SQ1174.2 +061500 WRITE-INIT-GF-04. SQ1174.2 +061600 MOVE 0 TO ERROR-FLAG. SQ1174.2 +061700 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +061800 GO TO SEQ-EOF-22. SQ1174.2 +061900 MOVE "WRTE-TEST-GF-04" TO PAR-NAME. SQ1174.2 +062000 WRITE-TEST-GF-04. SQ1174.2 +062100 IF COUNT-OF-RECS EQUAL TO 150 SQ1174.2 +062200 GO TO WRITE-TEST-GF-04-1. SQ1174.2 +062300 READ SQ-FS9 RECORD SQ1174.2 +062400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +062500 MOVE 1 TO EOF-FLAG SQ1174.2 +062600 GO TO WRITE-FAIL-GF-04. SQ1174.2 +062700 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +062800 IF SQ-FS9R1-PART2 NOT EQUAL TO SPACE SQ1174.2 +062900 MOVE "NO SPACE FILLING" TO RE-MARK SQ1174.2 +063000 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +063100 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +063200 IF CHARS-OR-RECORDS (1) NOT EQUAL TO SPACE SQ1174.2 +063300 MOVE "NO SPACE FILLING" TO RE-MARK SQ1174.2 +063400 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +063500 IF XLABEL-TYPE (1) NOT EQUAL TO SPACE SQ1174.2 +063600 MOVE "NO SPACE FILLING" TO RE-MARK SQ1174.2 +063700 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +063800 IF XFILE-NAME (1) NOT EQUAL "SQ-FS9" SQ1174.2 +063900 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +064000 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +064100 GO TO WRITE-FAIL-GF-04-1. SQ1174.2 +064200 GO TO WRITE-TEST-GF-04. SQ1174.2 +064300 WRITE-FAIL-GF-04-1. SQ1174.2 +064400 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +064500 MOVE 1 TO ERROR-FLAG. SQ1174.2 +064600 GO TO WRITE-TEST-GF-04. SQ1174.2 +064700 WRITE-TEST-GF-04-1. SQ1174.2 +064800 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +064900 GO TO WRITE-PASS-GF-04. SQ1174.2 +065000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +065100 WRITE-FAIL-GF-04. SQ1174.2 +065200 MOVE "VII-53; 4.7.3 (3) SHORTER RECORDS: NOT SPACE FILLED "SQ1174.2 +065300 TO RE-MARK. SQ1174.2 +065400 PERFORM FAIL. SQ1174.2 +065500 GO TO WRITE-WRITE-GF-04. SQ1174.2 +065600 WRITE-PASS-GF-04. SQ1174.2 +065700 PERFORM PASS. SQ1174.2 +065800 WRITE-WRITE-GF-04. SQ1174.2 +065900 MOVE "WRITE ... FROM 02 SHORT RECS" TO FEATURE. SQ1174.2 +066000 PERFORM PRINT-DETAIL. SQ1174.2 +066100 WRITE-INIT-GF-05. SQ1174.2 +066200 MOVE 0 TO ERROR-FLAG. SQ1174.2 +066300 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +066400 GO TO SEQ-EOF-22. SQ1174.2 +066500 MOVE "WRTE-TEST-GF-05" TO PAR-NAME. SQ1174.2 +066600 WRITE-TEST-GF-05. SQ1174.2 +066700 IF COUNT-OF-RECS EQUAL TO 200 SQ1174.2 +066800 GO TO WRITE-TEST-GF-05-1. SQ1174.2 +066900 READ SQ-FS9 RECORD SQ1174.2 +067000 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +067100 MOVE 1 TO EOF-FLAG SQ1174.2 +067200 GO TO WRITE-FAIL-GF-05. SQ1174.2 +067300 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +067400 IF SQ-FS9R1-PART2 NOT EQUAL TO SPACE SQ1174.2 +067500 MOVE "NOT BLANK FILLED" TO RE-MARK SQ1174.2 +067600 GO TO WRITE-FAIL-GF-05-1. SQ1174.2 +067700 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +067800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +067900 GO TO WRITE-FAIL-GF-05-1. SQ1174.2 +068000 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +068100 GO TO WRITE-FAIL-GF-05-1. SQ1174.2 +068200 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +068300 GO TO WRITE-FAIL-GF-05-1. SQ1174.2 +068400 GO TO WRITE-TEST-GF-05. SQ1174.2 +068500 WRITE-FAIL-GF-05-1. SQ1174.2 +068600 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +068700 MOVE 1 TO ERROR-FLAG. SQ1174.2 +068800 GO TO WRITE-TEST-GF-05. SQ1174.2 +068900 WRITE-TEST-GF-05-1. SQ1174.2 +069000 IF ERROR-FLAG EQUAL TO 0 SQ1174.2 +069100 GO TO WRITE-PASS-GF-05. SQ1174.2 +069200 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +069300 WRITE-FAIL-GF-05. SQ1174.2 +069400 MOVE "VII-53; 4.7.3 (3) SHORTER RECORDS: NOT SPACE FILLED "SQ1174.2 +069500 TO RE-MARK. SQ1174.2 +069600 PERFORM FAIL. SQ1174.2 +069700 GO TO WRITE-WRITE-GF-05. SQ1174.2 +069800 WRITE-PASS-GF-05. SQ1174.2 +069900 PERFORM PASS. SQ1174.2 +070000 WRITE-WRITE-GF-05. SQ1174.2 +070100 MOVE "WRITE .. FROM SHORT SUBSC 02" TO FEATURE. SQ1174.2 +070200 PERFORM PRINT-DETAIL. SQ1174.2 +070300 WRITE-INIT-GF-06. SQ1174.2 +070400 MOVE 0 TO ERROR-FLAG. SQ1174.2 +070500 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +070600 GO TO SEQ-EOF-22. SQ1174.2 +070700 MOVE "WRTE-TEST-GF-06" TO PAR-NAME. SQ1174.2 +070800 WRITE-TEST-GF-06. SQ1174.2 +070900 IF COUNT-OF-RECS EQUAL TO 250 SQ1174.2 +071000 GO TO WRITE-TEST-GF-06-1. SQ1174.2 +071100 READ SQ-FS9 RECORD SQ1174.2 +071200 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +071300 MOVE 1 TO EOF-FLAG SQ1174.2 +071400 GO TO WRITE-FAIL-GF-06. SQ1174.2 +071500 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +071600 IF SQ-FS9R1-PART2 NOT EQUAL TO SPACE SQ1174.2 +071700 MOVE "NOT BLANK FILLED" TO RE-MARK SQ1174.2 +071800 GO TO WRITE-FAIL-GF-06-1. SQ1174.2 +071900 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +072000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +072100 GO TO WRITE-FAIL-GF-06-1. SQ1174.2 +072200 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +072300 GO TO WRITE-FAIL-GF-06-1. SQ1174.2 +072400 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +072500 GO TO WRITE-FAIL-GF-06-1. SQ1174.2 +072600 GO TO WRITE-TEST-GF-06. SQ1174.2 +072700 WRITE-FAIL-GF-06-1. SQ1174.2 +072800 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +072900 MOVE 1 TO ERROR-FLAG. SQ1174.2 +073000 GO TO WRITE-TEST-GF-06. SQ1174.2 +073100 WRITE-TEST-GF-06-1. SQ1174.2 +073200 IF ERROR-FLAG EQUAL TO 0 SQ1174.2 +073300 GO TO WRITE-PASS-GF-06. SQ1174.2 +073400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +073500 WRITE-FAIL-GF-06. SQ1174.2 +073600 MOVE "VII-53; 4.7.3 (3) SHORTER RECORDS: NOT SPACE FILLED "SQ1174.2 +073700 TO RE-MARK. SQ1174.2 +073800 PERFORM FAIL. SQ1174.2 +073900 GO TO WRITE-WRITE-GF-06. SQ1174.2 +074000 WRITE-PASS-GF-06. SQ1174.2 +074100 PERFORM PASS. SQ1174.2 +074200 WRITE-WRITE-GF-06. SQ1174.2 +074300 MOVE "WRITE .. FROM SHORT SUBSC 05 " TO FEATURE. SQ1174.2 +074400 PERFORM PRINT-DETAIL. SQ1174.2 +074500 WRITE-INIT-GF-07. SQ1174.2 +074600 MOVE 0 TO ERROR-FLAG. SQ1174.2 +074700 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +074800 GO TO SEQ-EOF-22. SQ1174.2 +074900 MOVE "WRTE-TEST-GF-07" TO PAR-NAME. SQ1174.2 +075000 WRITE-TEST-GF-07. SQ1174.2 +075100 IF COUNT-OF-RECS EQUAL TO 493 SQ1174.2 +075200 GO TO WRITE-TEST-GF-07-1. SQ1174.2 +075300 READ SQ-FS9 RECORD SQ1174.2 +075400 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1174.2 +075500 MOVE 1 TO EOF-FLAG SQ1174.2 +075600 GO TO WRITE-FAIL-GF-07. SQ1174.2 +075700 ADD 1 TO COUNT-OF-RECS. SQ1174.2 +075800 MOVE SQ-FS9R1-PART1 TO FILE-RECORD-INFO-P1-120 (1). SQ1174.2 +075900 MOVE SQ-FS9R1-PART2 TO END-OF-RECORD-AREA. SQ1174.2 +076000 IF ALPHA-AREA NOT EQUAL TO "WRITE...FROM FILE" SQ1174.2 +076100 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +076200 IF NUMBER-AREA NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +076300 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +076400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS9" SQ1174.2 +076500 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +076600 IF XRECORD-NUMBER (1) NOT EQUAL TO COUNT-OF-RECS SQ1174.2 +076700 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +076800 IF XLABEL-TYPE (1) NOT EQUAL TO "O" SQ1174.2 +076900 GO TO WRITE-FAIL-GF-07-1. SQ1174.2 +077000 GO TO WRITE-TEST-GF-07. SQ1174.2 +077100 WRITE-FAIL-GF-07-1. SQ1174.2 +077200 ADD 1 TO RECORDS-IN-ERROR. SQ1174.2 +077300 MOVE 1 TO ERROR-FLAG. SQ1174.2 +077400 GO TO WRITE-TEST-GF-07. SQ1174.2 +077500 WRITE-TEST-GF-07-1. SQ1174.2 +077600 IF ERROR-FLAG EQUAL TO ZERO SQ1174.2 +077700 GO TO WRITE-PASS-GF-07. SQ1174.2 +077800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1174.2 +077900 WRITE-FAIL-GF-07. SQ1174.2 +078000 MOVE "VII-53; 4.7.3 (3) SAME SIZE" TO RE-MARK. SQ1174.2 +078100 PERFORM FAIL. SQ1174.2 +078200 GO TO WRITE-WRITE-GF-07. SQ1174.2 +078300 WRITE-PASS-GF-07. SQ1174.2 +078400 PERFORM PASS. SQ1174.2 +078500 WRITE-WRITE-GF-07. SQ1174.2 +078600 MOVE "WRITE .. FROM SAME SIZE" TO FEATURE. SQ1174.2 +078700 PERFORM PRINT-DETAIL. SQ1174.2 +078800 SEQ-TEST-022. SQ1174.2 +078900 IF EOF-FLAG EQUAL TO 1 SQ1174.2 +079000 GO TO SEQ-EOF-22. SQ1174.2 +079100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1174.2 +079200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1174.2 +079300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1174.2 +079400 GO TO SEQ-FAIL-22. SQ1174.2 +079500 READ SQ-FS9 RECORD SQ1174.2 +079600 AT END PERFORM PASS SQ1174.2 +079700 GO TO SEQ-WRITE-22. SQ1174.2 +079800 MOVE "MORE THAN 493 RECORDS" TO RE-MARK. SQ1174.2 +079900 GO TO SEQ-FAIL-22. SQ1174.2 +080000 SEQ-EOF-22. SQ1174.2 +080100 MOVE "LESS THAN 493 RECORDS" TO RE-MARK. SQ1174.2 +080200 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1174.2 +080300 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ1174.2 +080400 SEQ-FAIL-22. SQ1174.2 +080500 MOVE "VII-52; 4.7.2 (3) " TO RE-MARK.SQ1174.2 +080600 PERFORM FAIL. SQ1174.2 +080700 SEQ-WRITE-22. SQ1174.2 +080800 MOVE "READ FILE SQ-FS9" TO FEATURE. SQ1174.2 +080900 MOVE "SEQ-TEST-022" TO PAR-NAME. SQ1174.2 +081000 PERFORM PRINT-DETAIL. SQ1174.2 +081100 SEQ-CLOSE-22. SQ1174.2 +081200 CLOSE SQ-FS9. SQ1174.2 +081300 TERMINATE-ROUTINE. SQ1174.2 +081400 EXIT. SQ1174.2 +081500 CCVS-EXIT SECTION. SQ1174.2 +081600 CCVS-999999. SQ1174.2 +081700 GO TO CLOSE-FILES. SQ1174.2 diff --git a/tests/cobol85/SQ/SQ121A.CBL b/tests/cobol85/SQ/SQ121A.CBL new file mode 100755 index 00000000..d90c53cb --- /dev/null +++ b/tests/cobol85/SQ/SQ121A.CBL @@ -0,0 +1,608 @@ +000100 IDENTIFICATION DIVISION. SQ1214.2 +000200 PROGRAM-ID. SQ1214.2 +000300 SQ121A. SQ1214.2 +000400**************************************************************** SQ1214.2 +000500* * SQ1214.2 +000600* VALIDATION FOR:- * SQ1214.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1214.2 +000800* * SQ1214.2 +000900* CREATION DATE / VALIDATION DATE * SQ1214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1214.2 +001100* * SQ1214.2 +001200**************************************************************** SQ1214.2 +001300 SQ1214.2 +001400* THE ROUTINE SQ121A TESTS THE USE OF THE USE AFTER ERROR SQ1214.2 +001500* PROCEDURE ON I-O. SQ121A IS BASICALLY A REWRITE OF SQ115A SQ1214.2 +001600* WITH THE ADDITION OF THE USE PROCEDURE. SQ1214.2 +001700* THIS ROUTINE CREATES A MASS STORAGE FILE CONTAINING SQ1214.2 +001800* 550 RECORDS. EACH RECORD CONTAINS 126 CHARACTERS. THE SQ1214.2 +001900* FILE IS CLOSED AND OPENED AS AN INPUT-OUTPUT FILE. EVERY SQ1214.2 +002000* TENTH RECORD IS REWRITTEN. THE FILE IS CLOSED AND OPENED SQ1214.2 +002100* AGAIN AS AN INPUT FILE. FIELDS IN EACH RECORD ARE CHECKED SQ1214.2 +002200* TO ENSURE THAT THE RECORDS REWRITTEN ARE CORRECT AND THAT SQ1214.2 +002300* THE RECORDS WHICH WERE NOT UPDATED WERE NOT CHANGED. SQ1214.2 +002400* THE READ STATEMENT WITHIN THE REWRITE SECTION OF SQ121A DOES SQ1214.2 +002500* NOT HAVE AN AT END CLAUSE. EOF PROCESSING IS HANDLED BY SQ1214.2 +002600* SETTING AN EOF-FLAG IN THE DECLARATIVE SECTION. ANY SQ1214.2 +002700* PERMANENT ERRORS ENCOUNTERED DURING THE REWRITE OF SQ-FS5 SQ1214.2 +002800* ARE TREATED AS INFORMATION ITEMS. SQ1214.2 +002900* SQ1214.2 +003000* USED X-CARDS: SQ1214.2 +003100* XXXXX014 SQ1214.2 +003200* XXXXX055 SQ1214.2 +003300* P XXXXX062 SQ1214.2 +003400* XXXXX082 SQ1214.2 +003500* XXXXX083 SQ1214.2 +003600* C XXXXX084 SQ1214.2 +003700* SQ1214.2 +003800* SQ1214.2 +003900 ENVIRONMENT DIVISION. SQ1214.2 +004000 CONFIGURATION SECTION. SQ1214.2 +004100 SOURCE-COMPUTER. SQ1214.2 +004200 Linux. SQ1214.2 +004300 OBJECT-COMPUTER. SQ1214.2 +004400 Linux. SQ1214.2 +004500 INPUT-OUTPUT SECTION. SQ1214.2 +004600 FILE-CONTROL. SQ1214.2 +004700*P SELECT RAW-DATA ASSIGN TO SQ1214.2 +004800*P "XXXXX062" SQ1214.2 +004900*P ORGANIZATION IS INDEXED SQ1214.2 +005000*P ACCESS MODE IS RANDOM SQ1214.2 +005100*P RECORD KEY IS RAW-DATA-KEY. SQ1214.2 +005200 SELECT PRINT-FILE ASSIGN TO SQ1214.2 +005300 "report.log". SQ1214.2 +005400 SELECT SQ-FS5 ASSIGN SQ1214.2 +005500 "XXXXX014" SQ1214.2 +005600 ORGANIZATION SEQUENTIAL SQ1214.2 +005700 ACCESS MODE SEQUENTIAL SQ1214.2 +005800 FILE STATUS IS STAT-GROUP. SQ1214.2 +005900 DATA DIVISION. SQ1214.2 +006000 FILE SECTION. SQ1214.2 +006100*P SQ1214.2 +006200*PD RAW-DATA. SQ1214.2 +006300*P SQ1214.2 +006400*P1 RAW-DATA-SATZ. SQ1214.2 +006500*P 05 RAW-DATA-KEY PIC X(6). SQ1214.2 +006600*P 05 C-DATE PIC 9(6). SQ1214.2 +006700*P 05 C-TIME PIC 9(8). SQ1214.2 +006800*P 05 C-NO-OF-TESTS PIC 99. SQ1214.2 +006900*P 05 C-OK PIC 999. SQ1214.2 +007000*P 05 C-ALL PIC 999. SQ1214.2 +007100*P 05 C-FAIL PIC 999. SQ1214.2 +007200*P 05 C-DELETED PIC 999. SQ1214.2 +007300*P 05 C-INSPECT PIC 999. SQ1214.2 +007400*P 05 C-NOTE PIC X(13). SQ1214.2 +007500*P 05 C-INDENT PIC X. SQ1214.2 +007600*P 05 C-ABORT PIC X(8). SQ1214.2 +007700 FD PRINT-FILE SQ1214.2 +007800*C LABEL RECORDS SQ1214.2 +007900*C OMITTED SQ1214.2 +008000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1214.2 +008100 . SQ1214.2 +008200 01 PRINT-REC PICTURE X(120). SQ1214.2 +008300 01 DUMMY-RECORD PICTURE X(120). SQ1214.2 +008400 FD SQ-FS5 SQ1214.2 +008500*C LABEL RECORD STANDARD SQ1214.2 +008600 . SQ1214.2 +008700 01 SQ-FS5R1-F-G-126. SQ1214.2 +008800 02 SQ-FS5-120 PICTURE X(120). SQ1214.2 +008900 02 SQ-FS5-UPDATE PICTURE X(6). SQ1214.2 +009000 WORKING-STORAGE SECTION. SQ1214.2 +009100 01 COUNT-OF-RECORDS PIC S9(5) COMPUTATIONAL. SQ1214.2 +009200 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. SQ1214.2 +009300 01 ERROR-FLAG PIC 9. SQ1214.2 +009400 01 STAT-GROUP. SQ1214.2 +009500 02 INPUT-STAT1 PIC X. SQ1214.2 +009600 02 INPUT-STAT2 PIC X. SQ1214.2 +009700 01 EOF-FLAG PIC 9 VALUE 0. SQ1214.2 +009800 01 PERM-ERRORS PIC 9 VALUE 0. SQ1214.2 +009900 01 LOOP-COUNT PIC 99. SQ1214.2 +010000 01 FILE-RECORD-INFORMATION-REC. SQ1214.2 +010100 03 FILE-RECORD-INFO-SKELETON. SQ1214.2 +010200 05 FILLER PICTURE X(48) VALUE SQ1214.2 +010300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1214.2 +010400 05 FILLER PICTURE X(46) VALUE SQ1214.2 +010500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1214.2 +010600 05 FILLER PICTURE X(26) VALUE SQ1214.2 +010700 ",LFIL=000000,ORG= ,LBLR= ". SQ1214.2 +010800 05 FILLER PICTURE X(37) VALUE SQ1214.2 +010900 ",RECKEY= ". SQ1214.2 +011000 05 FILLER PICTURE X(38) VALUE SQ1214.2 +011100 ",ALTKEY1= ". SQ1214.2 +011200 05 FILLER PICTURE X(38) VALUE SQ1214.2 +011300 ",ALTKEY2= ". SQ1214.2 +011400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1214.2 +011500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1214.2 +011600 05 FILE-RECORD-INFO-P1-120. SQ1214.2 +011700 07 FILLER PIC X(5). SQ1214.2 +011800 07 XFILE-NAME PIC X(6). SQ1214.2 +011900 07 FILLER PIC X(8). SQ1214.2 +012000 07 XRECORD-NAME PIC X(6). SQ1214.2 +012100 07 FILLER PIC X(1). SQ1214.2 +012200 07 REELUNIT-NUMBER PIC 9(1). SQ1214.2 +012300 07 FILLER PIC X(7). SQ1214.2 +012400 07 XRECORD-NUMBER PIC 9(6). SQ1214.2 +012500 07 FILLER PIC X(6). SQ1214.2 +012600 07 UPDATE-NUMBER PIC 9(2). SQ1214.2 +012700 07 FILLER PIC X(5). SQ1214.2 +012800 07 ODO-NUMBER PIC 9(4). SQ1214.2 +012900 07 FILLER PIC X(5). SQ1214.2 +013000 07 XPROGRAM-NAME PIC X(5). SQ1214.2 +013100 07 FILLER PIC X(7). SQ1214.2 +013200 07 XRECORD-LENGTH PIC 9(6). SQ1214.2 +013300 07 FILLER PIC X(7). SQ1214.2 +013400 07 CHARS-OR-RECORDS PIC X(2). SQ1214.2 +013500 07 FILLER PIC X(1). SQ1214.2 +013600 07 XBLOCK-SIZE PIC 9(4). SQ1214.2 +013700 07 FILLER PIC X(6). SQ1214.2 +013800 07 RECORDS-IN-FILE PIC 9(6). SQ1214.2 +013900 07 FILLER PIC X(5). SQ1214.2 +014000 07 XFILE-ORGANIZATION PIC X(2). SQ1214.2 +014100 07 FILLER PIC X(6). SQ1214.2 +014200 07 XLABEL-TYPE PIC X(1). SQ1214.2 +014300 05 FILE-RECORD-INFO-P121-240. SQ1214.2 +014400 07 FILLER PIC X(8). SQ1214.2 +014500 07 XRECORD-KEY PIC X(29). SQ1214.2 +014600 07 FILLER PIC X(9). SQ1214.2 +014700 07 ALTERNATE-KEY1 PIC X(29). SQ1214.2 +014800 07 FILLER PIC X(9). SQ1214.2 +014900 07 ALTERNATE-KEY2 PIC X(29). SQ1214.2 +015000 07 FILLER PIC X(7). SQ1214.2 +015100 01 TEST-RESULTS. SQ1214.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ1214.2 +015300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1214.2 +015400 02 FILLER PICTURE X VALUE SPACE. SQ1214.2 +015500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1214.2 +015600 02 FILLER PICTURE X VALUE SPACE. SQ1214.2 +015700 02 PAR-NAME. SQ1214.2 +015800 03 FILLER PICTURE X(12) VALUE SPACE. SQ1214.2 +015900 03 PARDOT-X PICTURE X VALUE SPACE. SQ1214.2 +016000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1214.2 +016100 03 FILLER PIC X(5) VALUE SPACE. SQ1214.2 +016200 02 FILLER PIC X(10) VALUE SPACE. SQ1214.2 +016300 02 RE-MARK PIC X(61). SQ1214.2 +016400 01 TEST-COMPUTED. SQ1214.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1214.2 +016600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1214.2 +016700 02 COMPUTED-X. SQ1214.2 +016800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1214.2 +016900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1214.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1214.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1214.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1214.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1214.2 +017400 04 COMPUTED-18V0 PICTURE -9(18). SQ1214.2 +017500 04 FILLER PICTURE X. SQ1214.2 +017600 03 FILLER PIC X(50) VALUE SPACE. SQ1214.2 +017700 01 TEST-CORRECT. SQ1214.2 +017800 02 FILLER PIC X(30) VALUE SPACE. SQ1214.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1214.2 +018000 02 CORRECT-X. SQ1214.2 +018100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1214.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1214.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1214.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1214.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1214.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. SQ1214.2 +018700 04 CORRECT-18V0 PICTURE -9(18). SQ1214.2 +018800 04 FILLER PICTURE X. SQ1214.2 +018900 03 FILLER PIC X(50) VALUE SPACE. SQ1214.2 +019000 01 CCVS-C-1. SQ1214.2 +019100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1214.2 +019200- "SS PARAGRAPH-NAME SQ1214.2 +019300- " REMARKS". SQ1214.2 +019400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1214.2 +019500 01 CCVS-C-2. SQ1214.2 +019600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1214.2 +019700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1214.2 +019800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1214.2 +019900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1214.2 +020000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1214.2 +020100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1214.2 +020200 01 REC-CT PICTURE 99 VALUE ZERO. SQ1214.2 +020300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1214.2 +020400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1214.2 +020500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1214.2 +020600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1214.2 +020700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1214.2 +020800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1214.2 +020900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1214.2 +021000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1214.2 +021100 01 CCVS-H-1. SQ1214.2 +021200 02 FILLER PICTURE X(27) VALUE SPACE. SQ1214.2 +021300 02 FILLER PICTURE X(67) VALUE SQ1214.2 +021400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1214.2 +021500- " SYSTEM". SQ1214.2 +021600 02 FILLER PICTURE X(26) VALUE SPACE. SQ1214.2 +021700 01 CCVS-H-2. SQ1214.2 +021800 02 FILLER PICTURE X(52) VALUE IS SQ1214.2 +021900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1214.2 +022000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1214.2 +022100 02 TEST-ID PICTURE IS X(9). SQ1214.2 +022200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1214.2 +022300 01 CCVS-H-3. SQ1214.2 +022400 02 FILLER PICTURE X(34) VALUE SQ1214.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1214.2 +022600 02 FILLER PICTURE X(58) VALUE SQ1214.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1214.2 +022800 02 FILLER PICTURE X(28) VALUE SQ1214.2 +022900 " COPYRIGHT 1985 ". SQ1214.2 +023000 01 CCVS-E-1. SQ1214.2 +023100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1214.2 +023200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1214.2 +023300 02 ID-AGAIN PICTURE IS X(9). SQ1214.2 +023400 02 FILLER PICTURE X(45) VALUE IS SQ1214.2 +023500 " NTIS DISTRIBUTION COBOL 85". SQ1214.2 +023600 01 CCVS-E-2. SQ1214.2 +023700 02 FILLER PICTURE X(31) VALUE SQ1214.2 +023800 SPACE. SQ1214.2 +023900 02 FILLER PICTURE X(21) VALUE SPACE. SQ1214.2 +024000 02 CCVS-E-2-2. SQ1214.2 +024100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1214.2 +024200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1214.2 +024300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1214.2 +024400 01 CCVS-E-3. SQ1214.2 +024500 02 FILLER PICTURE X(22) VALUE SQ1214.2 +024600 " FOR OFFICIAL USE ONLY". SQ1214.2 +024700 02 FILLER PICTURE X(12) VALUE SPACE. SQ1214.2 +024800 02 FILLER PICTURE X(58) VALUE SQ1214.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1214.2 +025000 02 FILLER PICTURE X(13) VALUE SPACE. SQ1214.2 +025100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1214.2 +025200 01 CCVS-E-4. SQ1214.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1214.2 +025400 02 FILLER PIC XXXX VALUE " OF ". SQ1214.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1214.2 +025600 02 FILLER PIC X(40) VALUE SQ1214.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1214.2 +025800 01 XXINFO. SQ1214.2 +025900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1214.2 +026000 02 INFO-TEXT. SQ1214.2 +026100 04 FILLER PIC X(20) VALUE SPACE. SQ1214.2 +026200 04 XXCOMPUTED PIC X(20). SQ1214.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1214.2 +026400 04 XXCORRECT PIC X(20). SQ1214.2 +026500 01 HYPHEN-LINE. SQ1214.2 +026600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1214.2 +026700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1214.2 +026800- "*****************************************". SQ1214.2 +026900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1214.2 +027000- "******************************". SQ1214.2 +027100 01 CCVS-PGM-ID PIC X(6) VALUE SQ1214.2 +027200 "SQ121A". SQ1214.2 +027300 PROCEDURE DIVISION. SQ1214.2 +027400 DECLARATIVES. SQ1214.2 +027500 SECT-SQ121A-0001 SECTION. SQ1214.2 +027600 USE AFTER STANDARD ERROR PROCEDURE ON I-O. SQ1214.2 +027700 I-O-ERROR-PROCESS. SQ1214.2 +027800 IF INPUT-STAT1 EQUAL TO "1" SQ1214.2 +027900 MOVE 1 TO EOF-FLAG. SQ1214.2 +028000 IF INPUT-STAT1 GREATER THAN "1" SQ1214.2 +028100 MOVE 1 TO PERM-ERRORS. SQ1214.2 +028200 END DECLARATIVES. SQ1214.2 +028300 CCVS1 SECTION. SQ1214.2 +028400 OPEN-FILES. SQ1214.2 +028500*P OPEN I-O RAW-DATA. SQ1214.2 +028600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1214.2 +028700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1214.2 +028800*P MOVE "ABORTED " TO C-ABORT. SQ1214.2 +028900*P ADD 1 TO C-NO-OF-TESTS. SQ1214.2 +029000*P ACCEPT C-DATE FROM DATE. SQ1214.2 +029100*P ACCEPT C-TIME FROM TIME. SQ1214.2 +029200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1214.2 +029300*PND-E-1. SQ1214.2 +029400*P CLOSE RAW-DATA. SQ1214.2 +029500 OPEN OUTPUT PRINT-FILE. SQ1214.2 +029600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1214.2 +029700 MOVE SPACE TO TEST-RESULTS. SQ1214.2 +029800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1214.2 +029900 MOVE ZERO TO REC-SKL-SUB. SQ1214.2 +030000 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1214.2 +030100 CCVS-INIT-FILE. SQ1214.2 +030200 ADD 1 TO REC-SKL-SUB. SQ1214.2 +030300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1214.2 +030400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1214.2 +030500 CCVS-INIT-EXIT. SQ1214.2 +030600 GO TO CCVS1-EXIT. SQ1214.2 +030700 CLOSE-FILES. SQ1214.2 +030800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1214.2 +030900*P OPEN I-O RAW-DATA. SQ1214.2 +031000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1214.2 +031100*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1214.2 +031200*P MOVE "OK. " TO C-ABORT. SQ1214.2 +031300*P MOVE PASS-COUNTER TO C-OK. SQ1214.2 +031400*P MOVE ERROR-HOLD TO C-ALL. SQ1214.2 +031500*P MOVE ERROR-COUNTER TO C-FAIL. SQ1214.2 +031600*P MOVE DELETE-CNT TO C-DELETED. SQ1214.2 +031700*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1214.2 +031800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1214.2 +031900*PND-E-2. SQ1214.2 +032000*P CLOSE RAW-DATA. SQ1214.2 +032100 TERMINATE-CCVS. SQ1214.2 +032200*S EXIT PROGRAM. SQ1214.2 +032300*SERMINATE-CALL. SQ1214.2 +032400 STOP RUN. SQ1214.2 +032500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1214.2 +032600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1214.2 +032700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1214.2 +032800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1214.2 +032900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1214.2 +033000 PRINT-DETAIL. SQ1214.2 +033100 IF REC-CT NOT EQUAL TO ZERO SQ1214.2 +033200 MOVE "." TO PARDOT-X SQ1214.2 +033300 MOVE REC-CT TO DOTVALUE. SQ1214.2 +033400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1214.2 +033500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1214.2 +033600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1214.2 +033700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1214.2 +033800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1214.2 +033900 MOVE SPACE TO CORRECT-X. SQ1214.2 +034000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1214.2 +034100 MOVE SPACE TO RE-MARK. SQ1214.2 +034200 HEAD-ROUTINE. SQ1214.2 +034300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +034400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1214.2 +034500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1214.2 +034600 COLUMN-NAMES-ROUTINE. SQ1214.2 +034700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +034800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +035000 END-ROUTINE. SQ1214.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1214.2 +035200 END-RTN-EXIT. SQ1214.2 +035300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +035400 END-ROUTINE-1. SQ1214.2 +035500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1214.2 +035600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1214.2 +035700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1214.2 +035800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1214.2 +035900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1214.2 +036000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1214.2 +036100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1214.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1214.2 +036300 END-ROUTINE-12. SQ1214.2 +036400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1214.2 +036500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1214.2 +036600 MOVE "NO " TO ERROR-TOTAL SQ1214.2 +036700 ELSE SQ1214.2 +036800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1214.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1214.2 +037000 PERFORM WRITE-LINE. SQ1214.2 +037100 END-ROUTINE-13. SQ1214.2 +037200 IF DELETE-CNT IS EQUAL TO ZERO SQ1214.2 +037300 MOVE "NO " TO ERROR-TOTAL ELSE SQ1214.2 +037400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1214.2 +037500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1214.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1214.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1214.2 +037900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1214.2 +038000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1214.2 +038100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +038200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1214.2 +038300 WRITE-LINE. SQ1214.2 +038400 ADD 1 TO RECORD-COUNT. SQ1214.2 +038500 IF RECORD-COUNT GREATER 50 SQ1214.2 +038600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1214.2 +038700 MOVE SPACE TO DUMMY-RECORD SQ1214.2 +038800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1214.2 +038900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1214.2 +039000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1214.2 +039100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1214.2 +039200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1214.2 +039300 MOVE ZERO TO RECORD-COUNT. SQ1214.2 +039400 PERFORM WRT-LN. SQ1214.2 +039500 WRT-LN. SQ1214.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1214.2 +039700 MOVE SPACE TO DUMMY-RECORD. SQ1214.2 +039800 BLANK-LINE-PRINT. SQ1214.2 +039900 PERFORM WRT-LN. SQ1214.2 +040000 FAIL-ROUTINE. SQ1214.2 +040100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1214.2 +040200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1214.2 +040300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1214.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +040500 GO TO FAIL-ROUTINE-EX. SQ1214.2 +040600 FAIL-ROUTINE-WRITE. SQ1214.2 +040700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1214.2 +040800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +040900 FAIL-ROUTINE-EX. EXIT. SQ1214.2 +041000 BAIL-OUT. SQ1214.2 +041100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1214.2 +041200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1214.2 +041300 BAIL-OUT-WRITE. SQ1214.2 +041400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1214.2 +041500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1214.2 +041600 BAIL-OUT-EX. EXIT. SQ1214.2 +041700 CCVS1-EXIT. SQ1214.2 +041800 EXIT. SQ1214.2 +041900 SECT-SQ-115-0001 SECTION. SQ1214.2 +042000 SEQ-INIT-013. SQ1214.2 +042100 MOVE "SQ-FS5" TO XFILE-NAME (1). SQ1214.2 +042200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1214.2 +042300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1214.2 +042400 MOVE 000126 TO XRECORD-LENGTH (1). SQ1214.2 +042500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1214.2 +042600 MOVE 0001 TO XBLOCK-SIZE (1). SQ1214.2 +042700 MOVE 000550 TO RECORDS-IN-FILE (1). SQ1214.2 +042800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1214.2 +042900 MOVE "S" TO XLABEL-TYPE (1). SQ1214.2 +043000 MOVE 000001 TO XRECORD-NUMBER (1). SQ1214.2 +043100 OPEN OUTPUT SQ-FS5. SQ1214.2 +043200 MOVE ZERO TO COUNT-OF-RECORDS. SQ1214.2 +043300 SEQ-TEST-013. SQ1214.2 +043400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5-120. SQ1214.2 +043500 MOVE "FIRST " TO SQ-FS5-UPDATE. SQ1214.2 +043600 WRITE SQ-FS5R1-F-G-126. SQ1214.2 +043700 ADD 1 TO COUNT-OF-RECORDS. SQ1214.2 +043800 IF COUNT-OF-RECORDS EQUAL TO 550 SQ1214.2 +043900 GO TO SEQ-WRITE-013. SQ1214.2 +044000 ADD 1 TO XRECORD-NUMBER (1). SQ1214.2 +044100 GO TO SEQ-TEST-013. SQ1214.2 +044200 SEQ-WRITE-013. SQ1214.2 +044300 MOVE "CREATE FILE SQ-FS5" TO FEATURE. SQ1214.2 +044400 MOVE "SEQ-TEST-013" TO PAR-NAME. SQ1214.2 +044500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1214.2 +044600 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1214.2 +044700 PERFORM PRINT-DETAIL. SQ1214.2 +044800 CLOSE SQ-FS5. SQ1214.2 +044900* A SEQUENTIAL MASS STORAGE FILE WITH 126 CHARACTER SQ1214.2 +045000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 550 RECORDS. SQ1214.2 +045100 SEQ-INIT-014. SQ1214.2 +045200 MOVE ZERO TO COUNT-OF-RECORDS. SQ1214.2 +045300* THIS TEST READS AND CHECKS THE FILE CREATED SQ1214.2 +045400* IN SEQ-TEST-013. SQ1214.2 +045500 OPEN INPUT SQ-FS5. SQ1214.2 +045600 SEQ-TEST-014. SQ1214.2 +045700 READ SQ-FS5 AT END SQ1214.2 +045800 GO TO SEQ-TEST-014-1. SQ1214.2 +045900 ADD 1 TO COUNT-OF-RECORDS. SQ1214.2 +046000 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1214.2 +046100 IF COUNT-OF-RECORDS GREATER THAN 550 SQ1214.2 +046200 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1214.2 +046300 GO TO SEQ-FAIL-014. SQ1214.2 +046400 IF COUNT-OF-RECORDS NOT EQUAL TO XRECORD-NUMBER (1) SQ1214.2 +046500 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +046600 GO TO SEQ-TEST-014. SQ1214.2 +046700 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" SQ1214.2 +046800 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +046900 GO TO SEQ-TEST-014. SQ1214.2 +047000 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1214.2 +047100 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +047200 GO TO SEQ-TEST-014. SQ1214.2 +047300 IF SQ-FS5-UPDATE EQUAL TO "FIRST " SQ1214.2 +047400 GO TO SEQ-TEST-014. SQ1214.2 +047500 ADD 1 TO RECORDS-IN-ERROR. SQ1214.2 +047600 GO TO SEQ-TEST-014. SQ1214.2 +047700 SEQ-TEST-014-1. SQ1214.2 +047800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1214.2 +047900 GO TO SEQ-PASS-014. SQ1214.2 +048000 MOVE "ERRORS IN READING SQ-FS5" TO RE-MARK. SQ1214.2 +048100 SEQ-FAIL-014. SQ1214.2 +048200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1214.2 +048300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1214.2 +048400 PERFORM FAIL. SQ1214.2 +048500 GO TO SEQ-WRITE-014. SQ1214.2 +048600 SEQ-PASS-014. SQ1214.2 +048700 PERFORM PASS. SQ1214.2 +048800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1214.2 +048900 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1214.2 +049000 SEQ-WRITE-014. SQ1214.2 +049100 MOVE "SEQ-TEST-014" TO PAR-NAME. SQ1214.2 +049200 MOVE "VERIFY FILE SQ-FS5" TO FEATURE. SQ1214.2 +049300 PERFORM PRINT-DETAIL. SQ1214.2 +049400 SEQ-CLOSE-014. SQ1214.2 +049500 CLOSE SQ-FS5. SQ1214.2 +049600 REWRITE-INIT-GF-01. SQ1214.2 +049700 OPEN I-O SQ-FS5. SQ1214.2 +049800 MOVE ZERO TO COUNT-OF-RECORDS. SQ1214.2 +049900 MOVE ZERO TO EOF-FLAG. SQ1214.2 +050000* THIS TEST REWRITES EVERY TENTH RECORD SQ1214.2 +050100* OF THE FILE SQ-FS5. SQ1214.2 +050200 REWRITE-TEST-GF-01. SQ1214.2 +050300 PERFORM READ-SQ-FS5 THRU READ-SQ-FS5-EXIT 10 TIMES. SQ1214.2 +050400 IF EOF-FLAG EQUAL TO 1 SQ1214.2 +050500 GO TO REWRITE-TEST-GF-01-1. SQ1214.2 +050600 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1214.2 +050700 ADD 1 TO UPDATE-NUMBER (1). SQ1214.2 +050800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS5-120. SQ1214.2 +050900 MOVE "SECOND" TO SQ-FS5-UPDATE. SQ1214.2 +051000 REWRITE SQ-FS5R1-F-G-126. SQ1214.2 +051100 GO TO REWRITE-TEST-GF-01. SQ1214.2 +051200 READ-SQ-FS5. SQ1214.2 +051300 IF EOF-FLAG EQUAL TO 1 SQ1214.2 +051400 GO TO READ-SQ-FS5-EXIT. SQ1214.2 +051500 READ SQ-FS5 RECORD. SQ1214.2 +051600 IF EOF-FLAG EQUAL TO 1 SQ1214.2 +051700 GO TO READ-SQ-FS5-EXIT. SQ1214.2 +051800 ADD 1 TO COUNT-OF-RECORDS. SQ1214.2 +051900 READ-SQ-FS5-EXIT. SQ1214.2 +052000 EXIT. SQ1214.2 +052100 REWRITE-TEST-GF-01-1. SQ1214.2 +052200 IF COUNT-OF-RECORDS EQUAL TO 550 SQ1214.2 +052300 GO TO REWRITE-PASS-GF-01. SQ1214.2 +052400 REWRITE-FAIL-GF-01. SQ1214.2 +052500 MOVE "VII-48 4.5.2 " TO RE-MARK.SQ1214.2 +052600 PERFORM FAIL. SQ1214.2 +052700 MOVE "550 RECORDS SHOULD BE READ" TO RE-MARK. SQ1214.2 +052800 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1214.2 +052900 MOVE COUNT-OF-RECORDS TO CORRECT-18V0. SQ1214.2 +053000 GO TO REWRITE-WRITE-GF-01. SQ1214.2 +053100 REWRITE-PASS-GF-01. SQ1214.2 +053200 PERFORM PASS. SQ1214.2 +053300 REWRITE-WRITE-GF-01. SQ1214.2 +053400 MOVE "RWRT-TEST-GF-01" TO PAR-NAME. SQ1214.2 +053500 MOVE "REWRITE FILE SQ-FS5" TO FEATURE. SQ1214.2 +053600 PERFORM PRINT-DETAIL. SQ1214.2 +053700 IF PERM-ERRORS EQUAL TO 1 SQ1214.2 +053800 MOVE "PERMANENT ERRORS ENCOUNTERED ON PREVIOUS I-O OPERATION"SQ1214.2 +053900 TO PRINT-REC SQ1214.2 +054000 PERFORM WRITE-LINE. SQ1214.2 +054100 REWRITE-CLOSE-GF-01. SQ1214.2 +054200 CLOSE SQ-FS5. SQ1214.2 +054300 REWRITE-INIT-GF-02. SQ1214.2 +054400 MOVE ZERO TO COUNT-OF-RECORDS. SQ1214.2 +054500 MOVE ZERO TO EOF-FLAG. SQ1214.2 +054600 OPEN INPUT SQ-FS5. SQ1214.2 +054700* THIS TEST READS AND CHECKS THE FILE WHICH WAS SQ1214.2 +054800* REWRITTEN IN REWRITE-TEST-01. SQ1214.2 +054900 MOVE ZERO TO RECORDS-IN-ERROR. SQ1214.2 +055000 MOVE ZERO TO LOOP-COUNT. SQ1214.2 +055100 REWRITE-TEST-GF-02. SQ1214.2 +055200 READ SQ-FS5 END SQ1214.2 +055300 MOVE 1 TO EOF-FLAG SQ1214.2 +055400 GO TO REWRITE-TEST-GF-02-2. SQ1214.2 +055500 ADD 1 TO COUNT-OF-RECORDS. SQ1214.2 +055600 IF COUNT-OF-RECORDS GREATER THAN 550 SQ1214.2 +055700 MOVE "MORE THAN 550 RECORDS" TO RE-MARK SQ1214.2 +055800 GO TO REWRITE-FAIL-GF-02. SQ1214.2 +055900 ADD 1 TO LOOP-COUNT. SQ1214.2 +056000 MOVE SQ-FS5-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1214.2 +056100 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS5" SQ1214.2 +056200 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +056300 GO TO REWRITE-TEST-GF-02. SQ1214.2 +056400 IF LOOP-COUNT EQUAL TO 10 SQ1214.2 +056500 MOVE ZERO TO LOOP-COUNT SQ1214.2 +056600 GO TO REWRITE-TEST-GF-02-1. SQ1214.2 +056700 IF UPDATE-NUMBER (1) NOT EQUAL TO ZERO SQ1214.2 +056800 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +056900 GO TO REWRITE-TEST-GF-02. SQ1214.2 +057000 IF SQ-FS5-UPDATE EQUAL TO "FIRST " SQ1214.2 +057100 GO TO REWRITE-TEST-GF-02. SQ1214.2 +057200 ADD 1 TO RECORDS-IN-ERROR. SQ1214.2 +057300 GO TO REWRITE-TEST-GF-02. SQ1214.2 +057400 REWRITE-TEST-GF-02-1. SQ1214.2 +057500 IF UPDATE-NUMBER (1) NOT EQUAL TO 1 SQ1214.2 +057600 ADD 1 TO RECORDS-IN-ERROR SQ1214.2 +057700 GO TO REWRITE-TEST-GF-02. SQ1214.2 +057800 IF SQ-FS5-UPDATE EQUAL TO "SECOND" SQ1214.2 +057900 GO TO REWRITE-TEST-GF-02. SQ1214.2 +058000 ADD 1 TO RECORDS-IN-ERROR. SQ1214.2 +058100 GO TO REWRITE-TEST-GF-02. SQ1214.2 +058200 REWRITE-TEST-GF-02-2. SQ1214.2 +058300 IF COUNT-OF-RECORDS NOT EQUAL TO 550 SQ1214.2 +058400 MOVE "LESS THAN 550 RECORDS" TO RE-MARK SQ1214.2 +058500 MOVE "RECORDS READ =" TO COMPUTED-A SQ1214.2 +058600 MOVE COUNT-OF-RECORDS TO CORRECT-18V0 SQ1214.2 +058700 GO TO REWRITE-FAIL-GF-02. SQ1214.2 +058800 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1214.2 +058900 MOVE "ERRORS IN READING SQ-FS5" TO RE-MARK SQ1214.2 +059000 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1214.2 +059100 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1214.2 +059200 GO TO REWRITE-FAIL-GF-02. SQ1214.2 +059300 REWRITE-PASS-GF-02. SQ1214.2 +059400 PERFORM PASS. SQ1214.2 +059500 GO TO REWRITE-WRITE-GF-02. SQ1214.2 +059600 REWRITE-FAIL-GF-02. SQ1214.2 +059700 PERFORM FAIL. SQ1214.2 +059800 REWRITE-WRITE-GF-02. SQ1214.2 +059900 MOVE "RWRT-TEST-GF-02" TO PAR-NAME. SQ1214.2 +060000 MOVE "VERIFY FILE SQ-FS5" TO FEATURE. SQ1214.2 +060100 PERFORM PRINT-DETAIL. SQ1214.2 +060200 REWRITE-CLOSE-GF-02. SQ1214.2 +060300 CLOSE SQ-FS5. SQ1214.2 +060400 TERMINATE-ROUTINE. SQ1214.2 +060500 EXIT. SQ1214.2 +060600 CCVS-EXIT SECTION. SQ1214.2 +060700 CCVS-999999. SQ1214.2 +060800 GO TO CLOSE-FILES. SQ1214.2 diff --git a/tests/cobol85/SQ/SQ122A.CBL b/tests/cobol85/SQ/SQ122A.CBL new file mode 100755 index 00000000..fba12e3a --- /dev/null +++ b/tests/cobol85/SQ/SQ122A.CBL @@ -0,0 +1,756 @@ +000100 IDENTIFICATION DIVISION. SQ1224.2 +000200 PROGRAM-ID. SQ1224.2 +000300 SQ122A. SQ1224.2 +000400**************************************************************** SQ1224.2 +000500* * SQ1224.2 +000600* VALIDATION FOR:- * SQ1224.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1224.2 +000800* USING CCVS85 VERSION 3.1 * SQ1224.2 +000900* * SQ1224.2 +001000* CREATION DATE / VALIDATION DATE * SQ1224.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1224.2 +001200* * SQ1224.2 +001300**************************************************************** SQ1224.2 +001400* * SQ1224.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1224.2 +001600* * SQ1224.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1224.2 +001800* X-55 SYSTEM PRINTER * SQ1224.2 +001900* X-82 SOURCE-COMPUTER * SQ1224.2 +002000* X-83 OBJECT-COMPUTER * SQ1224.2 +002100* X-84 LABEL RECORDS OPTION * SQ1224.2 +002200* * SQ1224.2 +002300**************************************************************** SQ1224.2 +002400* * SQ1224.2 +002500* A ONE RECORD FILE WITH TWO CHARACTERS PER BLOCK IS CREATED* SQ1224.2 +002600* WITH THE INTENTION THAT IT SHOULD END PART-WAY THROUGH A * SQ1224.2 +002700* BLOCK. THE FILE IS RE-OPENED AND * SQ1224.2 +002800* THREE READ STATEMENTS EXECUTED. THE FIRST SHOULD BE * SQ1224.2 +002900* EXECUTED SUCCESSFULLY, THE SECOND RAISE THE AT END * SQ1224.2 +003000* CONDITION, AND THE THIRD, WHICH IS A READ AFTER END OF * SQ1224.2 +003100* FILE, SHOULD CAUSE THE I-O STATUS CODE 46. * SQ1224.2 +003200* * SQ1224.2 +003300**************************************************************** SQ1224.2 +003400* SQ1224.2 +003500 ENVIRONMENT DIVISION. SQ1224.2 +003600 CONFIGURATION SECTION. SQ1224.2 +003700 SOURCE-COMPUTER. SQ1224.2 +003800 Linux. SQ1224.2 +003900 OBJECT-COMPUTER. SQ1224.2 +004000 Linux. SQ1224.2 +004100* SQ1224.2 +004200 INPUT-OUTPUT SECTION. SQ1224.2 +004300 FILE-CONTROL. SQ1224.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1224.2 +004500 "report.log". SQ1224.2 +004600* SQ1224.2 +004700 SELECT SQ-FS4 ASSIGN SQ1224.2 +004800 "XXXXX014" SQ1224.2 +004900 FILE STATUS IS SQ-FS4-STATUS. SQ1224.2 +005000* SQ1224.2 +005100* SQ1224.2 +005200 DATA DIVISION. SQ1224.2 +005300 FILE SECTION. SQ1224.2 +005400 FD PRINT-FILE SQ1224.2 +005500*C LABEL RECORDS SQ1224.2 +005600*C OMITTED SQ1224.2 +005700*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1224.2 +005800 . SQ1224.2 +005900 01 PRINT-REC PICTURE X(120). SQ1224.2 +006000 01 DUMMY-RECORD PICTURE X(120). SQ1224.2 +006100* SQ1224.2 +006200 FD SQ-FS4 SQ1224.2 +006300*C LABEL RECORD IS STANDARD SQ1224.2 +006400 BLOCK 2 RECORDS SQ1224.2 +006500 RECORD 125 SQ1224.2 +006600 . SQ1224.2 +006700 01 SQ-FS4R1-F-G-125. SQ1224.2 +006800 05 SQ-FS4-FIRST PIC X(120). SQ1224.2 +006900 05 SQ-FS4-REC-NO PIC 99999. SQ1224.2 +007000* SQ1224.2 +007100 WORKING-STORAGE SECTION. SQ1224.2 +007200* SQ1224.2 +007300*************************************************************** SQ1224.2 +007400* * SQ1224.2 +007500* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1224.2 +007600* * SQ1224.2 +007700*************************************************************** SQ1224.2 +007800* SQ1224.2 +007900 01 SQ-FS4-STATUS. SQ1224.2 +008000 03 SQ-FS4-KEY-1 PIC X. SQ1224.2 +008100 03 SQ-FS4-KEY-2 PIC X. SQ1224.2 +008200* SQ1224.2 +008300*************************************************************** SQ1224.2 +008400* * SQ1224.2 +008500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1224.2 +008600* * SQ1224.2 +008700*************************************************************** SQ1224.2 +008800* SQ1224.2 +008900 01 REC-SKEL-SUB PIC 99. SQ1224.2 +009000* SQ1224.2 +009100 01 FILE-RECORD-INFORMATION-REC. SQ1224.2 +009200 03 FILE-RECORD-INFO-SKELETON. SQ1224.2 +009300 05 FILLER PICTURE X(48) VALUE SQ1224.2 +009400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1224.2 +009500 05 FILLER PICTURE X(46) VALUE SQ1224.2 +009600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1224.2 +009700 05 FILLER PICTURE X(26) VALUE SQ1224.2 +009800 ",LFIL=000000,ORG= ,LBLR= ". SQ1224.2 +009900 05 FILLER PICTURE X(37) VALUE SQ1224.2 +010000 ",RECKEY= ". SQ1224.2 +010100 05 FILLER PICTURE X(38) VALUE SQ1224.2 +010200 ",ALTKEY1= ". SQ1224.2 +010300 05 FILLER PICTURE X(38) VALUE SQ1224.2 +010400 ",ALTKEY2= ". SQ1224.2 +010500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1224.2 +010600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1224.2 +010700 05 FILE-RECORD-INFO-P1-120. SQ1224.2 +010800 07 FILLER PIC X(5). SQ1224.2 +010900 07 XFILE-NAME PIC X(6). SQ1224.2 +011000 07 FILLER PIC X(8). SQ1224.2 +011100 07 XRECORD-NAME PIC X(6). SQ1224.2 +011200 07 FILLER PIC X(1). SQ1224.2 +011300 07 REELUNIT-NUMBER PIC 9(1). SQ1224.2 +011400 07 FILLER PIC X(7). SQ1224.2 +011500 07 XRECORD-NUMBER PIC 9(6). SQ1224.2 +011600 07 FILLER PIC X(6). SQ1224.2 +011700 07 UPDATE-NUMBER PIC 9(2). SQ1224.2 +011800 07 FILLER PIC X(5). SQ1224.2 +011900 07 ODO-NUMBER PIC 9(4). SQ1224.2 +012000 07 FILLER PIC X(5). SQ1224.2 +012100 07 XPROGRAM-NAME PIC X(5). SQ1224.2 +012200 07 FILLER PIC X(7). SQ1224.2 +012300 07 XRECORD-LENGTH PIC 9(6). SQ1224.2 +012400 07 FILLER PIC X(7). SQ1224.2 +012500 07 CHARS-OR-RECORDS PIC X(2). SQ1224.2 +012600 07 FILLER PIC X(1). SQ1224.2 +012700 07 XBLOCK-SIZE PIC 9(4). SQ1224.2 +012800 07 FILLER PIC X(6). SQ1224.2 +012900 07 RECORDS-IN-FILE PIC 9(6). SQ1224.2 +013000 07 FILLER PIC X(5). SQ1224.2 +013100 07 XFILE-ORGANIZATION PIC X(2). SQ1224.2 +013200 07 FILLER PIC X(6). SQ1224.2 +013300 07 XLABEL-TYPE PIC X(1). SQ1224.2 +013400 05 FILE-RECORD-INFO-P121-240. SQ1224.2 +013500 07 FILLER PIC X(8). SQ1224.2 +013600 07 XRECORD-KEY PIC X(29). SQ1224.2 +013700 07 FILLER PIC X(9). SQ1224.2 +013800 07 ALTERNATE-KEY1 PIC X(29). SQ1224.2 +013900 07 FILLER PIC X(9). SQ1224.2 +014000 07 ALTERNATE-KEY2 PIC X(29). SQ1224.2 +014100 07 FILLER PIC X(7). SQ1224.2 +014200* SQ1224.2 +014300 01 TEST-RESULTS. SQ1224.2 +014400 02 FILLER PIC X VALUE SPACE. SQ1224.2 +014500 02 PAR-NAME. SQ1224.2 +014600 03 FILLER PIC X(14) VALUE SPACE. SQ1224.2 +014700 03 PARDOT-X PIC X VALUE SPACE. SQ1224.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1224.2 +014900 02 FILLER PIC X VALUE SPACE. SQ1224.2 +015000 02 FEATURE PIC X(24) VALUE SPACE. SQ1224.2 +015100 02 FILLER PIC X VALUE SPACE. SQ1224.2 +015200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1224.2 +015300 02 FILLER PIC X(9) VALUE SPACE. SQ1224.2 +015400 02 RE-MARK PIC X(61). SQ1224.2 +015500 01 TEST-COMPUTED. SQ1224.2 +015600 02 FILLER PIC X(30) VALUE SPACE. SQ1224.2 +015700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1224.2 +015800 02 COMPUTED-X. SQ1224.2 +015900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1224.2 +016000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1224.2 +016100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1224.2 +016200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1224.2 +016300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1224.2 +016400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1224.2 +016500 04 COMPUTED-18V0 PIC -9(18). SQ1224.2 +016600 04 FILLER PIC X. SQ1224.2 +016700 03 FILLER PIC X(50) VALUE SPACE. SQ1224.2 +016800 01 TEST-CORRECT. SQ1224.2 +016900 02 FILLER PIC X(30) VALUE SPACE. SQ1224.2 +017000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1224.2 +017100 02 CORRECT-X. SQ1224.2 +017200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1224.2 +017300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1224.2 +017400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1224.2 +017500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1224.2 +017600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1224.2 +017700 03 CR-18V0 REDEFINES CORRECT-A. SQ1224.2 +017800 04 CORRECT-18V0 PIC -9(18). SQ1224.2 +017900 04 FILLER PIC X. SQ1224.2 +018000 03 FILLER PIC X(2) VALUE SPACE. SQ1224.2 +018100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1224.2 +018200* SQ1224.2 +018300 01 CCVS-C-1. SQ1224.2 +018400 02 FILLER PIC IS X VALUE SPACE. SQ1224.2 +018500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1224.2 +018600 02 FILLER PIC IS X VALUE SPACE. SQ1224.2 +018700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1224.2 +018800 02 FILLER PIC IS X VALUE SPACE. SQ1224.2 +018900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1224.2 +019000 02 FILLER PIC IS X(9) VALUE SPACE. SQ1224.2 +019100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1224.2 +019200 01 CCVS-C-2. SQ1224.2 +019300 02 FILLER PIC X(19) VALUE SPACE. SQ1224.2 +019400 02 FILLER PIC X(6) VALUE "TESTED". SQ1224.2 +019500 02 FILLER PIC X(19) VALUE SPACE. SQ1224.2 +019600 02 FILLER PIC X(4) VALUE "FAIL". SQ1224.2 +019700 02 FILLER PIC X(72) VALUE SPACE. SQ1224.2 +019800* SQ1224.2 +019900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1224.2 +020000 01 REC-CT PIC 99 VALUE ZERO. SQ1224.2 +020100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1224.2 +020200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1224.2 +020300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1224.2 +020400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1224.2 +020500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1224.2 +020600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1224.2 +020700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1224.2 +020800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1224.2 +020900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1224.2 +021000 01 CCVS-H-1. SQ1224.2 +021100 02 FILLER PIC X(39) VALUE SPACES. SQ1224.2 +021200 02 FILLER PIC X(42) VALUE SQ1224.2 +021300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1224.2 +021400 02 FILLER PIC X(39) VALUE SPACES. SQ1224.2 +021500 01 CCVS-H-2A. SQ1224.2 +021600 02 FILLER PIC X(40) VALUE SPACE. SQ1224.2 +021700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1224.2 +021800 02 FILLER PIC XXXX VALUE SQ1224.2 +021900 "4.2 ". SQ1224.2 +022000 02 FILLER PIC X(28) VALUE SQ1224.2 +022100 " COPY - NOT FOR DISTRIBUTION". SQ1224.2 +022200 02 FILLER PIC X(41) VALUE SPACE. SQ1224.2 +022300* SQ1224.2 +022400 01 CCVS-H-2B. SQ1224.2 +022500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1224.2 +022600 02 TEST-ID PIC X(9). SQ1224.2 +022700 02 FILLER PIC X(4) VALUE " IN ". SQ1224.2 +022800 02 FILLER PIC X(12) VALUE SQ1224.2 +022900 " HIGH ". SQ1224.2 +023000 02 FILLER PIC X(22) VALUE SQ1224.2 +023100 " LEVEL VALIDATION FOR ". SQ1224.2 +023200 02 FILLER PIC X(58) VALUE SQ1224.2 +023300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1224.2 +023400 01 CCVS-H-3. SQ1224.2 +023500 02 FILLER PIC X(34) VALUE SQ1224.2 +023600 " FOR OFFICIAL USE ONLY ". SQ1224.2 +023700 02 FILLER PIC X(58) VALUE SQ1224.2 +023800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1224.2 +023900 02 FILLER PIC X(28) VALUE SQ1224.2 +024000 " COPYRIGHT 1985,1986 ". SQ1224.2 +024100 01 CCVS-E-1. SQ1224.2 +024200 02 FILLER PIC X(52) VALUE SPACE. SQ1224.2 +024300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1224.2 +024400 02 ID-AGAIN PIC X(9). SQ1224.2 +024500 02 FILLER PIC X(45) VALUE SPACES. SQ1224.2 +024600 01 CCVS-E-2. SQ1224.2 +024700 02 FILLER PIC X(31) VALUE SPACE. SQ1224.2 +024800 02 FILLER PIC X(21) VALUE SPACE. SQ1224.2 +024900 02 CCVS-E-2-2. SQ1224.2 +025000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1224.2 +025100 03 FILLER PIC X VALUE SPACE. SQ1224.2 +025200 03 ENDER-DESC PIC X(44) VALUE SQ1224.2 +025300 "ERRORS ENCOUNTERED". SQ1224.2 +025400 01 CCVS-E-3. SQ1224.2 +025500 02 FILLER PIC X(22) VALUE SQ1224.2 +025600 " FOR OFFICIAL USE ONLY". SQ1224.2 +025700 02 FILLER PIC X(12) VALUE SPACE. SQ1224.2 +025800 02 FILLER PIC X(58) VALUE SQ1224.2 +025900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1224.2 +026000 02 FILLER PIC X(8) VALUE SPACE. SQ1224.2 +026100 02 FILLER PIC X(20) VALUE SQ1224.2 +026200 " COPYRIGHT 1985,1986". SQ1224.2 +026300 01 CCVS-E-4. SQ1224.2 +026400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1224.2 +026500 02 FILLER PIC X(4) VALUE " OF ". SQ1224.2 +026600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1224.2 +026700 02 FILLER PIC X(40) VALUE SQ1224.2 +026800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1224.2 +026900 01 XXINFO. SQ1224.2 +027000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1224.2 +027100 02 INFO-TEXT. SQ1224.2 +027200 04 FILLER PIC X(8) VALUE SPACE. SQ1224.2 +027300 04 XXCOMPUTED PIC X(20). SQ1224.2 +027400 04 FILLER PIC X(5) VALUE SPACE. SQ1224.2 +027500 04 XXCORRECT PIC X(20). SQ1224.2 +027600 02 INF-ANSI-REFERENCE PIC X(48). SQ1224.2 +027700 01 HYPHEN-LINE. SQ1224.2 +027800 02 FILLER PIC IS X VALUE IS SPACE. SQ1224.2 +027900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1224.2 +028000- "*****************************************". SQ1224.2 +028100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1224.2 +028200- "******************************". SQ1224.2 +028300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1224.2 +028400 "SQ122A". SQ1224.2 +028500* SQ1224.2 +028600* SQ1224.2 +028700 PROCEDURE DIVISION. SQ1224.2 +028800 DECLARATIVES. SQ1224.2 +028900 SECT-SQ122A-0002 SECTION. SQ1224.2 +029000 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1224.2 +029100 INPUT-ERROR-PROCESS. SQ1224.2 +029200 IF SQ-FS4-STATUS = "10" SQ1224.2 +029300 GO TO END-DECLS. SQ1224.2 +029400 IF SQ-FS4-STATUS = "46" SQ1224.2 +029500 PERFORM DECL-PASS SQ1224.2 +029600 GO TO ABNORMAL-TERM-DECL SQ1224.2 +029700 ELSE SQ1224.2 +029800 MOVE "46" TO CORRECT-A SQ1224.2 +029900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +030000 MOVE "STATUS OF READ AFTER EOF READ INCORRECT" SQ1224.2 +030100 TO RE-MARK SQ1224.2 +030200 MOVE "VII-4, 1.3.5(4)E, FILE STATUS" SQ1224.2 +030300 TO ANSI-REFERENCE SQ1224.2 +030400 PERFORM DECL-FAIL SQ1224.2 +030500 GO TO ABNORMAL-TERM-DECL SQ1224.2 +030600 END-IF. SQ1224.2 +030700* SQ1224.2 +030800 DECL-PASS. SQ1224.2 +030900 MOVE "PASS " TO P-OR-F. SQ1224.2 +031000 ADD 1 TO PASS-COUNTER. SQ1224.2 +031100 PERFORM DECL-PRINT-DETAIL. SQ1224.2 +031200* SQ1224.2 +031300 DECL-FAIL. SQ1224.2 +031400 MOVE "FAIL*" TO P-OR-F. SQ1224.2 +031500 ADD 1 TO ERROR-COUNTER. SQ1224.2 +031600 PERFORM DECL-PRINT-DETAIL. SQ1224.2 +031700* SQ1224.2 +031800 DECL-PRINT-DETAIL. SQ1224.2 +031900 IF REC-CT NOT EQUAL TO ZERO SQ1224.2 +032000 MOVE "." TO PARDOT-X SQ1224.2 +032100 MOVE REC-CT TO DOTVALUE. SQ1224.2 +032200 MOVE TEST-RESULTS TO PRINT-REC. SQ1224.2 +032300 PERFORM DECL-WRITE-LINE. SQ1224.2 +032400 IF P-OR-F EQUAL TO "FAIL*" SQ1224.2 +032500 PERFORM DECL-WRITE-LINE SQ1224.2 +032600 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1224.2 +032700 ELSE SQ1224.2 +032800 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1224.2 +032900 MOVE SPACE TO P-OR-F. SQ1224.2 +033000 MOVE SPACE TO COMPUTED-X. SQ1224.2 +033100 MOVE SPACE TO CORRECT-X. SQ1224.2 +033200 IF REC-CT EQUAL TO ZERO SQ1224.2 +033300 MOVE SPACE TO PAR-NAME. SQ1224.2 +033400 MOVE SPACE TO RE-MARK. SQ1224.2 +033500* SQ1224.2 +033600 DECL-WRITE-LINE. SQ1224.2 +033700 ADD 1 TO RECORD-COUNT. SQ1224.2 +033800 IF RECORD-COUNT GREATER 50 SQ1224.2 +033900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1224.2 +034000 MOVE SPACE TO DUMMY-RECORD SQ1224.2 +034100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1224.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1224.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1224.2 +034400 PERFORM DECL-WRT-LN 2 TIMES SQ1224.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1224.2 +034600 PERFORM DECL-WRT-LN SQ1224.2 +034700 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1224.2 +034800 MOVE ZERO TO RECORD-COUNT. SQ1224.2 +034900 PERFORM DECL-WRT-LN. SQ1224.2 +035000* SQ1224.2 +035100 DECL-WRT-LN. SQ1224.2 +035200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1224.2 +035300 MOVE SPACE TO DUMMY-RECORD. SQ1224.2 +035400* SQ1224.2 +035500 DECL-FAIL-ROUTINE. SQ1224.2 +035600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1224.2 +035700 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1224.2 +035800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1224.2 +035900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1224.2 +036000 MOVE XXINFO TO DUMMY-RECORD. SQ1224.2 +036100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1224.2 +036200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1224.2 +036300 GO TO DECL-FAIL-EX. SQ1224.2 +036400 DECL-FAIL-WRITE. SQ1224.2 +036500 MOVE TEST-COMPUTED TO PRINT-REC SQ1224.2 +036600 PERFORM DECL-WRITE-LINE SQ1224.2 +036700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1224.2 +036800 MOVE TEST-CORRECT TO PRINT-REC SQ1224.2 +036900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1224.2 +037000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1224.2 +037100 DECL-FAIL-EX. SQ1224.2 +037200 EXIT. SQ1224.2 +037300* SQ1224.2 +037400 DECL-BAIL. SQ1224.2 +037500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1224.2 +037600 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1224.2 +037700 DECL-BAIL-WRITE. SQ1224.2 +037800 MOVE CORRECT-A TO XXCORRECT. SQ1224.2 +037900 MOVE COMPUTED-A TO XXCOMPUTED. SQ1224.2 +038000 MOVE XXINFO TO DUMMY-RECORD. SQ1224.2 +038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1224.2 +038200 DECL-BAIL-EX. SQ1224.2 +038300 EXIT. SQ1224.2 +038400* SQ1224.2 +038500 ABNORMAL-TERM-DECL. SQ1224.2 +038600 MOVE SPACE TO DUMMY-RECORD. SQ1224.2 +038700 PERFORM DECL-WRITE-LINE. SQ1224.2 +038800 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1224.2 +038900 TO DUMMY-RECORD. SQ1224.2 +039000 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1224.2 +039100* SQ1224.2 +039200 END-DECLS. SQ1224.2 +039300 END DECLARATIVES. SQ1224.2 +039400* SQ1224.2 +039500* SQ1224.2 +039600 CCVS1 SECTION. SQ1224.2 +039700 OPEN-FILES. SQ1224.2 +039800 OPEN OUTPUT PRINT-FILE. SQ1224.2 +039900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1224.2 +040000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1224.2 +040100 MOVE SPACE TO TEST-RESULTS. SQ1224.2 +040200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1224.2 +040300 MOVE ZERO TO REC-SKEL-SUB. SQ1224.2 +040400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1224.2 +040500 GO TO CCVS1-EXIT. SQ1224.2 +040600* SQ1224.2 +040700 CCVS-INIT-FILE. SQ1224.2 +040800 ADD 1 TO REC-SKL-SUB. SQ1224.2 +040900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1224.2 +041000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1224.2 +041100* SQ1224.2 +041200 CLOSE-FILES. SQ1224.2 +041300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1224.2 +041400 CLOSE PRINT-FILE. SQ1224.2 +041500 TERMINATE-CCVS. SQ1224.2 +041600 STOP RUN. SQ1224.2 +041700* SQ1224.2 +041800 INSPT. SQ1224.2 +041900 MOVE "INSPT" TO P-OR-F. SQ1224.2 +042000 ADD 1 TO INSPECT-COUNTER. SQ1224.2 +042100 PERFORM PRINT-DETAIL. SQ1224.2 +042200* SQ1224.2 +042300 PASS. SQ1224.2 +042400 MOVE "PASS " TO P-OR-F. SQ1224.2 +042500 ADD 1 TO PASS-COUNTER. SQ1224.2 +042600 PERFORM PRINT-DETAIL. SQ1224.2 +042700* SQ1224.2 +042800 FAIL. SQ1224.2 +042900 MOVE "FAIL*" TO P-OR-F. SQ1224.2 +043000 ADD 1 TO ERROR-COUNTER. SQ1224.2 +043100 PERFORM PRINT-DETAIL. SQ1224.2 +043200* SQ1224.2 +043300 DE-LETE. SQ1224.2 +043400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1224.2 +043500 MOVE "*****" TO P-OR-F. SQ1224.2 +043600 ADD 1 TO DELETE-COUNTER. SQ1224.2 +043700 PERFORM PRINT-DETAIL. SQ1224.2 +043800* SQ1224.2 +043900 PRINT-DETAIL. SQ1224.2 +044000 IF REC-CT NOT EQUAL TO ZERO SQ1224.2 +044100 MOVE "." TO PARDOT-X SQ1224.2 +044200 MOVE REC-CT TO DOTVALUE. SQ1224.2 +044300 MOVE TEST-RESULTS TO PRINT-REC. SQ1224.2 +044400 PERFORM WRITE-LINE. SQ1224.2 +044500 IF P-OR-F EQUAL TO "FAIL*" SQ1224.2 +044600 PERFORM WRITE-LINE SQ1224.2 +044700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1224.2 +044800 ELSE SQ1224.2 +044900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1224.2 +045000 MOVE SPACE TO P-OR-F. SQ1224.2 +045100 MOVE SPACE TO COMPUTED-X. SQ1224.2 +045200 MOVE SPACE TO CORRECT-X. SQ1224.2 +045300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1224.2 +045400 MOVE SPACE TO RE-MARK. SQ1224.2 +045500* SQ1224.2 +045600 HEAD-ROUTINE. SQ1224.2 +045700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +045800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +045900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1224.2 +046000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1224.2 +046100 COLUMN-NAMES-ROUTINE. SQ1224.2 +046200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1224.2 +046300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +046400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1224.2 +046500 END-ROUTINE. SQ1224.2 +046600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1224.2 +046700 PERFORM WRITE-LINE 5 TIMES. SQ1224.2 +046800 END-RTN-EXIT. SQ1224.2 +046900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1224.2 +047000 PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +047100* SQ1224.2 +047200 END-ROUTINE-1. SQ1224.2 +047300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1224.2 +047400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1224.2 +047500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1224.2 +047600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1224.2 +047700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1224.2 +047800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1224.2 +047900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1224.2 +048000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1224.2 +048100 PERFORM WRITE-LINE. SQ1224.2 +048200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1224.2 +048300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1224.2 +048400 MOVE "NO " TO ERROR-TOTAL SQ1224.2 +048500 ELSE SQ1224.2 +048600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1224.2 +048700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1224.2 +048800 PERFORM WRITE-LINE. SQ1224.2 +048900 END-ROUTINE-13. SQ1224.2 +049000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1224.2 +049100 MOVE "NO " TO ERROR-TOTAL SQ1224.2 +049200 ELSE SQ1224.2 +049300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1224.2 +049400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1224.2 +049500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1224.2 +049600 PERFORM WRITE-LINE. SQ1224.2 +049700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1224.2 +049800 MOVE "NO " TO ERROR-TOTAL SQ1224.2 +049900 ELSE SQ1224.2 +050000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1224.2 +050100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1224.2 +050200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1224.2 +050300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1224.2 +050400* SQ1224.2 +050500 WRITE-LINE. SQ1224.2 +050600 ADD 1 TO RECORD-COUNT. SQ1224.2 +050700 IF RECORD-COUNT GREATER 50 SQ1224.2 +050800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1224.2 +050900 MOVE SPACE TO DUMMY-RECORD SQ1224.2 +051000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1224.2 +051100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1224.2 +051200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1224.2 +051300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1224.2 +051400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1224.2 +051500 MOVE ZERO TO RECORD-COUNT. SQ1224.2 +051600 PERFORM WRT-LN. SQ1224.2 +051700* SQ1224.2 +051800 WRT-LN. SQ1224.2 +051900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1224.2 +052000 MOVE SPACE TO DUMMY-RECORD. SQ1224.2 +052100 BLANK-LINE-PRINT. SQ1224.2 +052200 PERFORM WRT-LN. SQ1224.2 +052300 FAIL-ROUTINE. SQ1224.2 +052400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1224.2 +052500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1224.2 +052600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1224.2 +052700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1224.2 +052800 MOVE XXINFO TO DUMMY-RECORD. SQ1224.2 +052900 PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +053000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1224.2 +053100 GO TO FAIL-ROUTINE-EX. SQ1224.2 +053200 FAIL-ROUTINE-WRITE. SQ1224.2 +053300 MOVE TEST-COMPUTED TO PRINT-REC SQ1224.2 +053400 PERFORM WRITE-LINE SQ1224.2 +053500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1224.2 +053600 MOVE TEST-CORRECT TO PRINT-REC SQ1224.2 +053700 PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +053800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1224.2 +053900 FAIL-ROUTINE-EX. SQ1224.2 +054000 EXIT. SQ1224.2 +054100 BAIL-OUT. SQ1224.2 +054200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1224.2 +054300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1224.2 +054400 BAIL-OUT-WRITE. SQ1224.2 +054500 MOVE CORRECT-A TO XXCORRECT. SQ1224.2 +054600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1224.2 +054700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1224.2 +054800 MOVE XXINFO TO DUMMY-RECORD. SQ1224.2 +054900 PERFORM WRITE-LINE 2 TIMES. SQ1224.2 +055000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1224.2 +055100 BAIL-OUT-EX. SQ1224.2 +055200 EXIT. SQ1224.2 +055300 CCVS1-EXIT. SQ1224.2 +055400 EXIT. SQ1224.2 +055500* SQ1224.2 +055600**************************************************************** SQ1224.2 +055700* * SQ1224.2 +055800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1224.2 +055900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1224.2 +056000* * SQ1224.2 +056100**************************************************************** SQ1224.2 +056200* SQ1224.2 +056300 SECT-SQ122A-0004 SECTION. SQ1224.2 +056400 STA-INIT. SQ1224.2 +056500* SQ1224.2 +056600 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1224.2 +056700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1224.2 +056800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1224.2 +056900 MOVE 125 TO XRECORD-LENGTH (1). SQ1224.2 +057000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1224.2 +057100 MOVE 2 TO XBLOCK-SIZE (1). SQ1224.2 +057200 MOVE 1 TO RECORDS-IN-FILE (1). SQ1224.2 +057300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1224.2 +057400 MOVE "S" TO XLABEL-TYPE (1). SQ1224.2 +057500 MOVE ZERO TO XRECORD-NUMBER (1). SQ1224.2 +057600* SQ1224.2 +057700* OPEN THE FILE IN THE OUTPUT MODE SQ1224.2 +057800* SQ1224.2 +057900 SEQ-INIT-01. SQ1224.2 +058000 MOVE 0 TO REC-CT. SQ1224.2 +058100 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +058200 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1224.2 +058300 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1224.2 +058400 SEQ-TEST-OP-01. SQ1224.2 +058500 OPEN OUTPUT SQ-FS4. SQ1224.2 +058600* SQ1224.2 +058700* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1224.2 +058800* SQ1224.2 +058900 ADD 1 TO REC-CT. SQ1224.2 +059000 SEQ-TEST-OP-01-01. SQ1224.2 +059100 IF SQ-FS4-STATUS = "00" SQ1224.2 +059200 PERFORM PASS SQ1224.2 +059300 ELSE SQ1224.2 +059400 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +059500 MOVE "00" TO CORRECT-A SQ1224.2 +059600 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1224.2 +059700 TO RE-MARK SQ1224.2 +059800 MOVE "VII-3, VII-23" TO ANSI-REFERENCE SQ1224.2 +059900 PERFORM FAIL. SQ1224.2 +060000 SEQ-TEST-01-01-END. SQ1224.2 +060100* SQ1224.2 +060200* SQ1224.2 +060300* THE FILE HAS BEEN CREATED. WE NOW WRITE ONE RECORD TO IT. SQ1224.2 +060400* SQ1224.2 +060500 SEQ-INIT-02. SQ1224.2 +060600 MOVE 0 TO REC-CT. SQ1224.2 +060700 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +060800 ADD 1 TO XRECORD-NUMBER (1). SQ1224.2 +060900 MOVE "WRITE ONE RECORD" TO FEATURE. SQ1224.2 +061000 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1224.2 +061100 SEQ-TEST-WR-02. SQ1224.2 +061200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1224.2 +061300 MOVE XRECORD-NUMBER (1) TO SQ-FS4-REC-NO. SQ1224.2 +061400 WRITE SQ-FS4R1-F-G-125. SQ1224.2 +061500* SQ1224.2 +061600* CHECK I-O STATUS RETURNED FROM WRITE SQ1224.2 +061700* SQ1224.2 +061800 ADD 1 TO REC-CT. SQ1224.2 +061900 SEQ-TEST-WR-02-01. SQ1224.2 +062000 IF SQ-FS4-STATUS = "00" SQ1224.2 +062100 PERFORM PASS SQ1224.2 +062200 ELSE SQ1224.2 +062300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +062400 MOVE "00" TO CORRECT-A SQ1224.2 +062500 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ1224.2 +062600 TO RE-MARK SQ1224.2 +062700 MOVE "VII-3, VII-53,4.7.4(6)" TO ANSI-REFERENCE SQ1224.2 +062800 PERFORM FAIL. SQ1224.2 +062900 SEQ-TEST-02-01-END. SQ1224.2 +063000* SQ1224.2 +063100* SQ1224.2 +063200* HAVING WRITTEN ONE RECORD, CLOSE THE FILE. SQ1224.2 +063300* SQ1224.2 +063400 SEQ-INIT-03. SQ1224.2 +063500 MOVE 0 TO REC-CT. SQ1224.2 +063600 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +063700 MOVE "CLOSE AFTER CREATE" TO FEATURE. SQ1224.2 +063800 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1224.2 +063900 SEQ-TEST-CL-03. SQ1224.2 +064000 CLOSE SQ-FS4. SQ1224.2 +064100* SQ1224.2 +064200* CHECK I-O STATUS RETURNED FROM CLOSE SQ1224.2 +064300* SQ1224.2 +064400 ADD 1 TO REC-CT. SQ1224.2 +064500 SEQ-TEST-CL-03-01. SQ1224.2 +064600 IF SQ-FS4-STATUS = "00" SQ1224.2 +064700 PERFORM PASS SQ1224.2 +064800 ELSE SQ1224.2 +064900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +065000 MOVE "00" TO CORRECT-A SQ1224.2 +065100 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1224.2 +065200 TO RE-MARK SQ1224.2 +065300 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1224.2 +065400 PERFORM FAIL. SQ1224.2 +065500 SEQ-TEST-03-01-END. SQ1224.2 +065600* SQ1224.2 +065700* SQ1224.2 +065800* CREATION OF THE FILE IS NOW COMPLETE. THE NEXT ACTION SQ1224.2 +065900* IS TO OPEN THE FILE IN THE INPUT MODE SQ1224.2 +066000* SQ1224.2 +066100 SEQ-INIT-04. SQ1224.2 +066200 MOVE 0 TO REC-CT. SQ1224.2 +066300 MOVE ZERO TO XRECORD-NUMBER (1). SQ1224.2 +066400 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +066500 MOVE "OPEN, TO READ FILE" TO FEATURE. SQ1224.2 +066600 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1224.2 +066700 SEQ-TEST-OP-04. SQ1224.2 +066800* SQ1224.2 +066900* OPEN THE TEST FILE AND CLEAR THE RECORD AREA, JUST IN SQ1224.2 +067000* CASE THERE IS A SINGLE BUFFER WHICH STILL HAS A COPY OF SQ1224.2 +067100* THE LAST RECORD WRITTEN IN IT. SQ1224.2 +067200* SQ1224.2 +067300 OPEN INPUT SQ-FS4. SQ1224.2 +067400 MOVE SPACE TO SQ-FS4R1-F-G-125. SQ1224.2 +067500* SQ1224.2 +067600* CHECK I-O STATUS RETURNED FROM OPEN INPUT SQ1224.2 +067700* SQ1224.2 +067800 ADD 1 TO REC-CT. SQ1224.2 +067900 SEQ-TEST-OP-04-01. SQ1224.2 +068000 IF SQ-FS4-STATUS = "00" SQ1224.2 +068100 PERFORM PASS SQ1224.2 +068200 ELSE SQ1224.2 +068300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +068400 MOVE "00" TO CORRECT-A SQ1224.2 +068500 MOVE "UNEXPECTED ERROR CODE FROM OPEN INPUT" SQ1224.2 +068600 TO RE-MARK SQ1224.2 +068700 MOVE "VII-3, VII-23" TO ANSI-REFERENCE SQ1224.2 +068800 PERFORM FAIL. SQ1224.2 +068900 SEQ-TEST-04-01-END. SQ1224.2 +069000* SQ1224.2 +069100* SQ1224.2 +069200* READ THE FIRST (AND ONLY) RECORD FROM THE FILE SQ1224.2 +069300* SQ1224.2 +069400 SEQ-INIT-05. SQ1224.2 +069500 MOVE 0 TO REC-CT. SQ1224.2 +069600 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +069700 MOVE "READ FIRST RECORD" TO FEATURE. SQ1224.2 +069800 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1224.2 +069900 SEQ-TEST-RD-05. SQ1224.2 +070000 READ SQ-FS4. SQ1224.2 +070100 MOVE SQ-FS4R1-F-G-125 TO FILE-RECORD-INFO (2). SQ1224.2 +070200* SQ1224.2 +070300* CHECK I-O STATUS RETURNED FROM READ SQ1224.2 +070400* SQ1224.2 +070500 ADD 1 TO REC-CT. SQ1224.2 +070600 SEQ-TEST-RD-05-01. SQ1224.2 +070700 IF SQ-FS4-STATUS = "00" SQ1224.2 +070800 PERFORM PASS SQ1224.2 +070900 ELSE SQ1224.2 +071000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +071100 MOVE "00" TO CORRECT-A SQ1224.2 +071200 MOVE "UNEXPECTED I-O STATUS FROM READ" SQ1224.2 +071300 TO RE-MARK SQ1224.2 +071400 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1224.2 +071500 PERFORM FAIL. SQ1224.2 +071600 SEQ-TEST-05-01-END. SQ1224.2 +071700* SQ1224.2 +071800* SQ1224.2 +071900* READ AGAIN, TO RAISE THE AT END CONDITION SQ1224.2 +072000* SQ1224.2 +072100 SEQ-INIT-06. SQ1224.2 +072200 MOVE 0 TO REC-CT. SQ1224.2 +072300 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +072400 MOVE "READ, GIVING AT END" TO FEATURE. SQ1224.2 +072500 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1224.2 +072600 SEQ-TEST-RD-06. SQ1224.2 +072700 READ SQ-FS4. SQ1224.2 +072800* SQ1224.2 +072900* CHECK I-O STATUS RETURNED FROM READ SQ1224.2 +073000* SQ1224.2 +073100 ADD 1 TO REC-CT. SQ1224.2 +073200 SEQ-TEST-RD-06-01. SQ1224.2 +073300 IF SQ-FS4-STATUS = "10" SQ1224.2 +073400 PERFORM PASS SQ1224.2 +073500 ELSE SQ1224.2 +073600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1224.2 +073700 MOVE "10" TO CORRECT-A SQ1224.2 +073800 MOVE "UNEXPECTED I-O STATUS AT END OF FILE" SQ1224.2 +073900 TO RE-MARK SQ1224.2 +074000 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1224.2 +074100 PERFORM FAIL. SQ1224.2 +074200 SEQ-TEST-06-01-END. SQ1224.2 +074300* SQ1224.2 +074400* SQ1224.2 +074500* READ AGAIN, AFTER AT END, TO RAISE I-O STATUS 46 SQ1224.2 +074600* SQ1224.2 +074700 SEQ-INIT-07. SQ1224.2 +074800 MOVE 0 TO REC-CT. SQ1224.2 +074900 MOVE "**" TO SQ-FS4-STATUS. SQ1224.2 +075000 MOVE "READ AFTER AT END" TO FEATURE. SQ1224.2 +075100 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1224.2 +075200 SEQ-TEST-RD-07. SQ1224.2 +075300 READ SQ-FS4. SQ1224.2 +075400 CCVS-EXIT SECTION. SQ1224.2 +075500 CCVS-999999. SQ1224.2 +075600 GO TO CLOSE-FILES. SQ1224.2 diff --git a/tests/cobol85/SQ/SQ123A.CBL b/tests/cobol85/SQ/SQ123A.CBL new file mode 100755 index 00000000..e4895021 --- /dev/null +++ b/tests/cobol85/SQ/SQ123A.CBL @@ -0,0 +1,904 @@ +000100 IDENTIFICATION DIVISION. SQ1234.2 +000200 PROGRAM-ID. SQ1234.2 +000300 SQ123A. SQ1234.2 +000400**************************************************************** SQ1234.2 +000500* * SQ1234.2 +000600* VALIDATION FOR:- * SQ1234.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1234.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1234.2 +000900* REVISED 1986, AUGUST * SQ1234.2 +001000* * SQ1234.2 +001100* CREATION DATE / VALIDATION DATE * SQ1234.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1234.2 +001300* * SQ1234.2 +001400**************************************************************** SQ1234.2 +001500* * SQ1234.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1234.2 +001700* * SQ1234.2 +001800* X-14 SEQUENTIAL NON-UNIT MASS STORAGE FILE * SQ1234.2 +001900* X-55 SYSTEM PRINTER * SQ1234.2 +002000* X-82 SOURCE-COMPUTER * SQ1234.2 +002100* X-83 OBJECT-COMPUTER. * SQ1234.2 +002200* * SQ1234.2 +002300**************************************************************** SQ1234.2 +002400* * SQ1234.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ1234.2 +002600* TO A MEDIUM WHICH IS NOT A REEL/UNIT MEDIUM. A CLOSE * SQ1234.2 +002700* REEL STATEMENT IS EXECUTED. THIS SHOULD HAVE NO EFFECT * SQ1234.2 +002800* ON THE FILE, EXCEPT TO CAUSE I-O STATUS 07. THE FILE * SQ1234.2 +002900* SHOULD REMAIN OPEN. A NORMAL, UNQUALIFIED, CLOSE * SQ1234.2 +003000* STATEMENT IS THEN EXECUTED, WHICH SHOULD BE SUCCESSFUL * SQ1234.2 +003100* AND CLOSE THE FILE. THERE IS AN ERROR DECLARATIVE FOR * SQ1234.2 +003200* THE FILE, WHICH SHOULD NOT BE ENTERED. * SQ1234.2 +003300* * SQ1234.2 +003400**************************************************************** SQ1234.2 +003500* SQ1234.2 +003600 ENVIRONMENT DIVISION. SQ1234.2 +003700 CONFIGURATION SECTION. SQ1234.2 +003800 SOURCE-COMPUTER. SQ1234.2 +003900 Linux. SQ1234.2 +004000 OBJECT-COMPUTER. SQ1234.2 +004100 Linux. SQ1234.2 +004200* SQ1234.2 +004300 INPUT-OUTPUT SECTION. SQ1234.2 +004400 FILE-CONTROL. SQ1234.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ1234.2 +004600 "report.log". SQ1234.2 +004700* SQ1234.2 +004800*P SELECT RAW-DATA ASSIGN TO SQ1234.2 +004900*P "XXXXX062" SQ1234.2 +005000*P ORGANIZATION IS INDEXED SQ1234.2 +005100*P ACCESS MODE IS RANDOM SQ1234.2 +005200*P RECORD-KEY IS RAW-DATA-KEY. SQ1234.2 +005300*P SQ1234.2 +005400 SELECT SQ-FS4 ASSIGN SQ1234.2 +005500 "XXXXX014" SQ1234.2 +005600 SEQUENTIAL SQ1234.2 +005700 ACCESS IS SEQUENTIAL SQ1234.2 +005800 STATUS IS SQ-FS4-STATUS. SQ1234.2 +005900* SQ1234.2 +006000* SQ1234.2 +006100 DATA DIVISION. SQ1234.2 +006200 FILE SECTION. SQ1234.2 +006300 FD PRINT-FILE SQ1234.2 +006400*C LABEL RECORDS SQ1234.2 +006500*C OMITTED SQ1234.2 +006600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1234.2 +006700 . SQ1234.2 +006800 01 PRINT-REC PICTURE X(120). SQ1234.2 +006900 01 DUMMY-RECORD PICTURE X(120). SQ1234.2 +007000*P SQ1234.2 +007100*PD RAW-DATA. SQ1234.2 +007200*P1 RAW-DATA-SATZ. SQ1234.2 +007300*P 05 RAW-DATA-KEY PIC X(6). SQ1234.2 +007400*P 05 C-DATE PIC 9(6). SQ1234.2 +007500*P 05 C-TIME PIC 9(8). SQ1234.2 +007600*P 05 NO-OF-TESTS PIC 99. SQ1234.2 +007700*P 05 C-OK PIC 999. SQ1234.2 +007800*P 05 C-ALL PIC 999. SQ1234.2 +007900*P 05 C-FAIL PIC 999. SQ1234.2 +008000*P 05 C-DELETED PIC 999. SQ1234.2 +008100*P 05 C-INSPECT PIC 999. SQ1234.2 +008200*P 05 C-NOTE PIC X(13). SQ1234.2 +008300*P 05 C-INDENT PIC X. SQ1234.2 +008400*P 05 C-ABORT PIC X(8). SQ1234.2 +008500* SQ1234.2 +008600 FD SQ-FS4 SQ1234.2 +008700*C LABEL RECORD IS STANDARD SQ1234.2 +008800 . SQ1234.2 +008900 01 SQ-FS4R1-F-G-120 PIC X(120). SQ1234.2 +009000* SQ1234.2 +009100 WORKING-STORAGE SECTION. SQ1234.2 +009200* SQ1234.2 +009300*************************************************************** SQ1234.2 +009400* * SQ1234.2 +009500* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1234.2 +009600* * SQ1234.2 +009700*************************************************************** SQ1234.2 +009800* SQ1234.2 +009900 01 SQ-FS4-STATUS. SQ1234.2 +010000 03 SQ-FS4-KEY-1 PIC X. SQ1234.2 +010100 03 SQ-FS4-KEY-2 PIC X. SQ1234.2 +010200* SQ1234.2 +010300 01 DELETE-SW. SQ1234.2 +010400 03 DELETE-SW-1 PIC X. SQ1234.2 +010500 03 DELETE-SW-1-GROUP. SQ1234.2 +010600 05 DELETE-SW-2 PIC X. SQ1234.2 +010700* SQ1234.2 +010800 01 DECL-EXEC-I PIC X(12). SQ1234.2 +010900 01 DECL-EXEC-O PIC X(12). SQ1234.2 +011000 01 DECL-EXEC-SW PIC X. SQ1234.2 +011100* SQ1234.2 +011200*************************************************************** SQ1234.2 +011300* * SQ1234.2 +011400* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1234.2 +011500* * SQ1234.2 +011600*************************************************************** SQ1234.2 +011700* SQ1234.2 +011800 01 REC-SKEL-SUB PIC 99. SQ1234.2 +011900* SQ1234.2 +012000 01 FILE-RECORD-INFORMATION-REC. SQ1234.2 +012100 03 FILE-RECORD-INFO-SKELETON. SQ1234.2 +012200 05 FILLER PICTURE X(48) VALUE SQ1234.2 +012300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1234.2 +012400 05 FILLER PICTURE X(46) VALUE SQ1234.2 +012500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1234.2 +012600 05 FILLER PICTURE X(26) VALUE SQ1234.2 +012700 ",LFIL=000000,ORG= ,LBLR= ". SQ1234.2 +012800 05 FILLER PICTURE X(37) VALUE SQ1234.2 +012900 ",RECKEY= ". SQ1234.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1234.2 +013100 ",ALTKEY1= ". SQ1234.2 +013200 05 FILLER PICTURE X(38) VALUE SQ1234.2 +013300 ",ALTKEY2= ". SQ1234.2 +013400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1234.2 +013500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1234.2 +013600 05 FILE-RECORD-INFO-P1-120. SQ1234.2 +013700 07 FILLER PIC X(5). SQ1234.2 +013800 07 XFILE-NAME PIC X(6). SQ1234.2 +013900 07 FILLER PIC X(8). SQ1234.2 +014000 07 XRECORD-NAME PIC X(6). SQ1234.2 +014100 07 FILLER PIC X(1). SQ1234.2 +014200 07 REELUNIT-NUMBER PIC 9(1). SQ1234.2 +014300 07 FILLER PIC X(7). SQ1234.2 +014400 07 XRECORD-NUMBER PIC 9(6). SQ1234.2 +014500 07 FILLER PIC X(6). SQ1234.2 +014600 07 UPDATE-NUMBER PIC 9(2). SQ1234.2 +014700 07 FILLER PIC X(5). SQ1234.2 +014800 07 ODO-NUMBER PIC 9(4). SQ1234.2 +014900 07 FILLER PIC X(5). SQ1234.2 +015000 07 XPROGRAM-NAME PIC X(5). SQ1234.2 +015100 07 FILLER PIC X(7). SQ1234.2 +015200 07 XRECORD-LENGTH PIC 9(6). SQ1234.2 +015300 07 FILLER PIC X(7). SQ1234.2 +015400 07 CHARS-OR-RECORDS PIC X(2). SQ1234.2 +015500 07 FILLER PIC X(1). SQ1234.2 +015600 07 XBLOCK-SIZE PIC 9(4). SQ1234.2 +015700 07 FILLER PIC X(6). SQ1234.2 +015800 07 RECORDS-IN-FILE PIC 9(6). SQ1234.2 +015900 07 FILLER PIC X(5). SQ1234.2 +016000 07 XFILE-ORGANIZATION PIC X(2). SQ1234.2 +016100 07 FILLER PIC X(6). SQ1234.2 +016200 07 XLABEL-TYPE PIC X(1). SQ1234.2 +016300 05 FILE-RECORD-INFO-P121-240. SQ1234.2 +016400 07 FILLER PIC X(8). SQ1234.2 +016500 07 XRECORD-KEY PIC X(29). SQ1234.2 +016600 07 FILLER PIC X(9). SQ1234.2 +016700 07 ALTERNATE-KEY1 PIC X(29). SQ1234.2 +016800 07 FILLER PIC X(9). SQ1234.2 +016900 07 ALTERNATE-KEY2 PIC X(29). SQ1234.2 +017000 07 FILLER PIC X(7). SQ1234.2 +017100* SQ1234.2 +017200 01 TEST-RESULTS. SQ1234.2 +017300 02 FILLER PIC X VALUE SPACE. SQ1234.2 +017400 02 PAR-NAME. SQ1234.2 +017500 03 FILLER PIC X(14) VALUE SPACE. SQ1234.2 +017600 03 PARDOT-X PIC X VALUE SPACE. SQ1234.2 +017700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1234.2 +017800 02 FILLER PIC X VALUE SPACE. SQ1234.2 +017900 02 FEATURE PIC X(24) VALUE SPACE. SQ1234.2 +018000 02 FILLER PIC X VALUE SPACE. SQ1234.2 +018100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1234.2 +018200 02 FILLER PIC X(9) VALUE SPACE. SQ1234.2 +018300 02 RE-MARK PIC X(61). SQ1234.2 +018400 01 TEST-COMPUTED. SQ1234.2 +018500 02 FILLER PIC X(30) VALUE SPACE. SQ1234.2 +018600 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1234.2 +018700 02 COMPUTED-X. SQ1234.2 +018800 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1234.2 +018900 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1234.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1234.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1234.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1234.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1234.2 +019400 04 COMPUTED-18V0 PIC -9(18). SQ1234.2 +019500 04 FILLER PIC X. SQ1234.2 +019600 03 FILLER PIC X(50) VALUE SPACE. SQ1234.2 +019700 01 TEST-CORRECT. SQ1234.2 +019800 02 FILLER PIC X(30) VALUE SPACE. SQ1234.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1234.2 +020000 02 CORRECT-X. SQ1234.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1234.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1234.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1234.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1234.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1234.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. SQ1234.2 +020700 04 CORRECT-18V0 PIC -9(18). SQ1234.2 +020800 04 FILLER PIC X. SQ1234.2 +020900 03 FILLER PIC X(2) VALUE SPACE. SQ1234.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1234.2 +021100* SQ1234.2 +021200 01 CCVS-C-1. SQ1234.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1234.2 +021400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1234.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1234.2 +021600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1234.2 +021700 02 FILLER PIC IS X VALUE SPACE. SQ1234.2 +021800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1234.2 +021900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1234.2 +022000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1234.2 +022100 01 CCVS-C-2. SQ1234.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1234.2 +022300 02 FILLER PIC X(6) VALUE "TESTED". SQ1234.2 +022400 02 FILLER PIC X(19) VALUE SPACE. SQ1234.2 +022500 02 FILLER PIC X(4) VALUE "FAIL". SQ1234.2 +022600 02 FILLER PIC X(72) VALUE SPACE. SQ1234.2 +022700* SQ1234.2 +022800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1234.2 +022900 01 REC-CT PIC 99 VALUE ZERO. SQ1234.2 +023000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1234.2 +023100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1234.2 +023200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1234.2 +023300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1234.2 +023400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1234.2 +023500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1234.2 +023600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1234.2 +023700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1234.2 +023800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1234.2 +023900 01 CCVS-H-1. SQ1234.2 +024000 02 FILLER PIC X(39) VALUE SPACES. SQ1234.2 +024100 02 FILLER PIC X(42) VALUE SQ1234.2 +024200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1234.2 +024300 02 FILLER PIC X(39) VALUE SPACES. SQ1234.2 +024400 01 CCVS-H-2A. SQ1234.2 +024500 02 FILLER PIC X(40) VALUE SPACE. SQ1234.2 +024600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1234.2 +024700 02 FILLER PIC XXXX VALUE SQ1234.2 +024800 "4.2 ". SQ1234.2 +024900 02 FILLER PIC X(28) VALUE SQ1234.2 +025000 " COPY - NOT FOR DISTRIBUTION". SQ1234.2 +025100 02 FILLER PIC X(41) VALUE SPACE. SQ1234.2 +025200* SQ1234.2 +025300 01 CCVS-H-2B. SQ1234.2 +025400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1234.2 +025500 02 TEST-ID PIC X(9). SQ1234.2 +025600 02 FILLER PIC X(4) VALUE " IN ". SQ1234.2 +025700 02 FILLER PIC X(12) VALUE SQ1234.2 +025800 " HIGH ". SQ1234.2 +025900 02 FILLER PIC X(22) VALUE SQ1234.2 +026000 " LEVEL VALIDATION FOR ". SQ1234.2 +026100 02 FILLER PIC X(58) VALUE SQ1234.2 +026200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1234.2 +026300 01 CCVS-H-3. SQ1234.2 +026400 02 FILLER PIC X(34) VALUE SQ1234.2 +026500 " FOR OFFICIAL USE ONLY ". SQ1234.2 +026600 02 FILLER PIC X(58) VALUE SQ1234.2 +026700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1234.2 +026800 02 FILLER PIC X(28) VALUE SQ1234.2 +026900 " COPYRIGHT 1985,1986 ". SQ1234.2 +027000 01 CCVS-E-1. SQ1234.2 +027100 02 FILLER PIC X(52) VALUE SPACE. SQ1234.2 +027200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1234.2 +027300 02 ID-AGAIN PIC X(9). SQ1234.2 +027400 02 FILLER PIC X(45) VALUE SPACES. SQ1234.2 +027500 01 CCVS-E-2. SQ1234.2 +027600 02 FILLER PIC X(31) VALUE SPACE. SQ1234.2 +027700 02 FILLER PIC X(21) VALUE SPACE. SQ1234.2 +027800 02 CCVS-E-2-2. SQ1234.2 +027900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1234.2 +028000 03 FILLER PIC X VALUE SPACE. SQ1234.2 +028100 03 ENDER-DESC PIC X(44) VALUE SQ1234.2 +028200 "ERRORS ENCOUNTERED". SQ1234.2 +028300 01 CCVS-E-3. SQ1234.2 +028400 02 FILLER PIC X(22) VALUE SQ1234.2 +028500 " FOR OFFICIAL USE ONLY". SQ1234.2 +028600 02 FILLER PIC X(12) VALUE SPACE. SQ1234.2 +028700 02 FILLER PIC X(58) VALUE SQ1234.2 +028800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1234.2 +028900 02 FILLER PIC X(8) VALUE SPACE. SQ1234.2 +029000 02 FILLER PIC X(20) VALUE SQ1234.2 +029100 " COPYRIGHT 1985,1986". SQ1234.2 +029200 01 CCVS-E-4. SQ1234.2 +029300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1234.2 +029400 02 FILLER PIC X(4) VALUE " OF ". SQ1234.2 +029500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1234.2 +029600 02 FILLER PIC X(40) VALUE SQ1234.2 +029700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1234.2 +029800 01 XXINFO. SQ1234.2 +029900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1234.2 +030000 02 INFO-TEXT. SQ1234.2 +030100 04 FILLER PIC X(8) VALUE SPACE. SQ1234.2 +030200 04 XXCOMPUTED PIC X(20). SQ1234.2 +030300 04 FILLER PIC X(5) VALUE SPACE. SQ1234.2 +030400 04 XXCORRECT PIC X(20). SQ1234.2 +030500 02 INF-ANSI-REFERENCE PIC X(48). SQ1234.2 +030600 01 HYPHEN-LINE. SQ1234.2 +030700 02 FILLER PIC IS X VALUE IS SPACE. SQ1234.2 +030800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1234.2 +030900- "*****************************************". SQ1234.2 +031000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1234.2 +031100- "******************************". SQ1234.2 +031200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1234.2 +031300 "SQ123A". SQ1234.2 +031400* SQ1234.2 +031500* SQ1234.2 +031600 PROCEDURE DIVISION. SQ1234.2 +031700 DECLARATIVES. SQ1234.2 +031800* SQ1234.2 +031900* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ1234.2 +032000* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ1234.2 +032100* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ1234.2 +032200* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ1234.2 +032300* SQ1234.2 +032400 SECT-SQ123A-0000 SECTION. SQ1234.2 +032500 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ1234.2 +032600 PRINT-FILE-ERROR-PROCESS. SQ1234.2 +032700 EXIT. SQ1234.2 +032800* SQ1234.2 +032900 SECT-SQ123A-0001 SECTION. SQ1234.2 +033000 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1234.2 +033100 INPUT-ERROR-PROCESS. SQ1234.2 +033200 MOVE "EXECUTED" TO DECL-EXEC-I. SQ1234.2 +033300* SQ1234.2 +033400 SECT-SQ123A-0002 SECTION. SQ1234.2 +033500 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1234.2 +033600 OUTPUT-ERROR-PROCESS. SQ1234.2 +033700 MOVE "EXECUTED" TO DECL-EXEC-O. SQ1234.2 +033800* SQ1234.2 +033900 IF DECL-EXEC-SW NOT = SPACE SQ1234.2 +034000 GO TO END-DECLS. SQ1234.2 +034100* SQ1234.2 +034200 MOVE 1 TO REC-CT. SQ1234.2 +034300 MOVE "CLOSE AFTER CLOSE REEL" TO FEATURE. SQ1234.2 +034400 MOVE "DECL-CLOSE-02" TO PAR-NAME. SQ1234.2 +034500 GO TO DECL-CLOSE-02. SQ1234.2 +034600 DECL-DELETE-02. SQ1234.2 +034700 PERFORM DECL-DE-LETE. SQ1234.2 +034800 GO TO DECL-TEST-01-END. SQ1234.2 +034900 DECL-CLOSE-02. SQ1234.2 +035000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1234.2 +035100 MOVE "00" TO CORRECT-A SQ1234.2 +035200 MOVE "DECLARATIVE ENTERED ON CLOSE OF FILE WHICH IS OPEN" SQ1234.2 +035300 TO RE-MARK SQ1234.2 +035400 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ1234.2 +035500 PERFORM DECL-FAIL. SQ1234.2 +035600 DECL-TEST-01-END. SQ1234.2 +035700* SQ1234.2 +035800 GO TO END-DECLS. SQ1234.2 +035900* SQ1234.2 +036000* SQ1234.2 +036100 DECL-PASS. SQ1234.2 +036200 MOVE "PASS " TO P-OR-F. SQ1234.2 +036300 ADD 1 TO PASS-COUNTER. SQ1234.2 +036400 PERFORM DECL-PRINT-DETAIL. SQ1234.2 +036500* SQ1234.2 +036600 DECL-FAIL. SQ1234.2 +036700 MOVE "FAIL*" TO P-OR-F. SQ1234.2 +036800 ADD 1 TO ERROR-COUNTER. SQ1234.2 +036900 PERFORM DECL-PRINT-DETAIL. SQ1234.2 +037000* SQ1234.2 +037100 DECL-DE-LETE. SQ1234.2 +037200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1234.2 +037300 MOVE "*****" TO P-OR-F. SQ1234.2 +037400 ADD 1 TO DELETE-COUNTER. SQ1234.2 +037500 PERFORM DECL-PRINT-DETAIL. SQ1234.2 +037600* SQ1234.2 +037700 DECL-PRINT-DETAIL. SQ1234.2 +037800 IF REC-CT NOT EQUAL TO ZERO SQ1234.2 +037900 MOVE "." TO PARDOT-X SQ1234.2 +038000 MOVE REC-CT TO DOTVALUE. SQ1234.2 +038100 MOVE TEST-RESULTS TO PRINT-REC. SQ1234.2 +038200 PERFORM DECL-WRITE-LINE. SQ1234.2 +038300 IF P-OR-F EQUAL TO "FAIL*" SQ1234.2 +038400 PERFORM DECL-WRITE-LINE SQ1234.2 +038500 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1234.2 +038600 ELSE SQ1234.2 +038700 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1234.2 +038800 MOVE SPACE TO P-OR-F. SQ1234.2 +038900 MOVE SPACE TO COMPUTED-X. SQ1234.2 +039000 MOVE SPACE TO CORRECT-X. SQ1234.2 +039100 IF REC-CT EQUAL TO ZERO SQ1234.2 +039200 MOVE SPACE TO PAR-NAME. SQ1234.2 +039300 MOVE SPACE TO RE-MARK. SQ1234.2 +039400* SQ1234.2 +039500 DECL-WRITE-LINE. SQ1234.2 +039600 ADD 1 TO RECORD-COUNT. SQ1234.2 +039700 IF RECORD-COUNT GREATER 50 SQ1234.2 +039800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1234.2 +039900 MOVE SPACE TO DUMMY-RECORD SQ1234.2 +040000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1234.2 +040100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1234.2 +040200 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1234.2 +040300 PERFORM DECL-WRT-LN 2 TIMES SQ1234.2 +040400 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1234.2 +040500 PERFORM DECL-WRT-LN SQ1234.2 +040600 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1234.2 +040700 MOVE ZERO TO RECORD-COUNT. SQ1234.2 +040800 PERFORM DECL-WRT-LN. SQ1234.2 +040900* SQ1234.2 +041000 DECL-WRT-LN. SQ1234.2 +041100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1234.2 +041200 MOVE SPACE TO DUMMY-RECORD. SQ1234.2 +041300* SQ1234.2 +041400 DECL-FAIL-ROUTINE. SQ1234.2 +041500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1234.2 +041600 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1234.2 +041700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1234.2 +041800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1234.2 +041900 MOVE XXINFO TO DUMMY-RECORD. SQ1234.2 +042000 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1234.2 +042100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1234.2 +042200 GO TO DECL-FAIL-EX. SQ1234.2 +042300 DECL-FAIL-WRITE. SQ1234.2 +042400 MOVE TEST-COMPUTED TO PRINT-REC SQ1234.2 +042500 PERFORM DECL-WRITE-LINE SQ1234.2 +042600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1234.2 +042700 MOVE TEST-CORRECT TO PRINT-REC SQ1234.2 +042800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1234.2 +042900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1234.2 +043000 DECL-FAIL-EX. SQ1234.2 +043100 EXIT. SQ1234.2 +043200* SQ1234.2 +043300 DECL-BAIL. SQ1234.2 +043400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1234.2 +043500 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1234.2 +043600 DECL-BAIL-WRITE. SQ1234.2 +043700 MOVE CORRECT-A TO XXCORRECT. SQ1234.2 +043800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1234.2 +043900 MOVE XXINFO TO DUMMY-RECORD. SQ1234.2 +044000 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1234.2 +044100 DECL-BAIL-EX. SQ1234.2 +044200 EXIT. SQ1234.2 +044300* SQ1234.2 +044400 END-DECLS. SQ1234.2 +044500 END DECLARATIVES. SQ1234.2 +044600* SQ1234.2 +044700* SQ1234.2 +044800 CCVS1 SECTION. SQ1234.2 +044900 OPEN-FILES. SQ1234.2 +045000*P OPEN I-O RAW-DATA. SQ1234.2 +045100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1234.2 +045200*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1234.2 +045300*P MOVE "ABORTED " TO C-ABORT. SQ1234.2 +045400*P ADD 1 TO C-NO-OF-TESTS. SQ1234.2 +045500*P ACCEPT C-DATE FROM DATE. SQ1234.2 +045600*P ACCEPT C-TIME FROM TIME. SQ1234.2 +045700*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1234.2 +045800*PND-E-1. SQ1234.2 +045900*P CLOSE RAW-DATA. SQ1234.2 +046000 OPEN OUTPUT PRINT-FILE. SQ1234.2 +046100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1234.2 +046200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1234.2 +046300 MOVE SPACE TO TEST-RESULTS. SQ1234.2 +046400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1234.2 +046500 MOVE ZERO TO REC-SKEL-SUB. SQ1234.2 +046600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1234.2 +046700 GO TO CCVS1-EXIT. SQ1234.2 +046800* SQ1234.2 +046900 CCVS-INIT-FILE. SQ1234.2 +047000 ADD 1 TO REC-SKL-SUB. SQ1234.2 +047100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1234.2 +047200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1234.2 +047300* SQ1234.2 +047400 CLOSE-FILES. SQ1234.2 +047500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1234.2 +047600 CLOSE PRINT-FILE. SQ1234.2 +047700*P OPEN I-O RAW-DATA. SQ1234.2 +047800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1234.2 +047900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1234.2 +048000*P MOVE "OK. " TO C-ABORT. SQ1234.2 +048100*P MOVE PASS-COUNTER TO C-OK. SQ1234.2 +048200*P MOVE ERROR-HOLD TO C-ALL. SQ1234.2 +048300*P MOVE ERROR-COUNTER TO C-FAIL. SQ1234.2 +048400*P MOVE DELETE-CNT TO C-DELETED. SQ1234.2 +048500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1234.2 +048600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1234.2 +048700*PND-E-2. SQ1234.2 +048800*P CLOSE RAW-DATA. SQ1234.2 +048900 TERMINATE-CCVS. SQ1234.2 +049000*S EXIT PROGRAM. SQ1234.2 +049100 STOP RUN. SQ1234.2 +049200* SQ1234.2 +049300 INSPT. SQ1234.2 +049400 MOVE "INSPT" TO P-OR-F. SQ1234.2 +049500 ADD 1 TO INSPECT-COUNTER. SQ1234.2 +049600 PERFORM PRINT-DETAIL. SQ1234.2 +049700* SQ1234.2 +049800 PASS. SQ1234.2 +049900 MOVE "PASS " TO P-OR-F. SQ1234.2 +050000 ADD 1 TO PASS-COUNTER. SQ1234.2 +050100 PERFORM PRINT-DETAIL. SQ1234.2 +050200* SQ1234.2 +050300 FAIL. SQ1234.2 +050400 MOVE "FAIL*" TO P-OR-F. SQ1234.2 +050500 ADD 1 TO ERROR-COUNTER. SQ1234.2 +050600 PERFORM PRINT-DETAIL. SQ1234.2 +050700* SQ1234.2 +050800 DE-LETE. SQ1234.2 +050900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1234.2 +051000 MOVE "*****" TO P-OR-F. SQ1234.2 +051100 ADD 1 TO DELETE-COUNTER. SQ1234.2 +051200 PERFORM PRINT-DETAIL. SQ1234.2 +051300* SQ1234.2 +051400 PRINT-DETAIL. SQ1234.2 +051500 IF REC-CT NOT EQUAL TO ZERO SQ1234.2 +051600 MOVE "." TO PARDOT-X SQ1234.2 +051700 MOVE REC-CT TO DOTVALUE. SQ1234.2 +051800 MOVE TEST-RESULTS TO PRINT-REC. SQ1234.2 +051900 PERFORM WRITE-LINE. SQ1234.2 +052000 IF P-OR-F EQUAL TO "FAIL*" SQ1234.2 +052100 PERFORM WRITE-LINE SQ1234.2 +052200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1234.2 +052300 ELSE SQ1234.2 +052400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1234.2 +052500 MOVE SPACE TO P-OR-F. SQ1234.2 +052600 MOVE SPACE TO COMPUTED-X. SQ1234.2 +052700 MOVE SPACE TO CORRECT-X. SQ1234.2 +052800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1234.2 +052900 MOVE SPACE TO RE-MARK. SQ1234.2 +053000* SQ1234.2 +053100 HEAD-ROUTINE. SQ1234.2 +053200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +053300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +053400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1234.2 +053500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1234.2 +053600 COLUMN-NAMES-ROUTINE. SQ1234.2 +053700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1234.2 +053800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +053900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1234.2 +054000 END-ROUTINE. SQ1234.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1234.2 +054200 PERFORM WRITE-LINE 5 TIMES. SQ1234.2 +054300 END-RTN-EXIT. SQ1234.2 +054400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1234.2 +054500 PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +054600* SQ1234.2 +054700 END-ROUTINE-1. SQ1234.2 +054800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1234.2 +054900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1234.2 +055000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1234.2 +055100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1234.2 +055200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1234.2 +055300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1234.2 +055400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1234.2 +055500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1234.2 +055600 PERFORM WRITE-LINE. SQ1234.2 +055700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1234.2 +055800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1234.2 +055900 MOVE "NO " TO ERROR-TOTAL SQ1234.2 +056000 ELSE SQ1234.2 +056100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1234.2 +056200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1234.2 +056300 PERFORM WRITE-LINE. SQ1234.2 +056400 END-ROUTINE-13. SQ1234.2 +056500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1234.2 +056600 MOVE "NO " TO ERROR-TOTAL SQ1234.2 +056700 ELSE SQ1234.2 +056800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1234.2 +056900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1234.2 +057000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1234.2 +057100 PERFORM WRITE-LINE. SQ1234.2 +057200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1234.2 +057300 MOVE "NO " TO ERROR-TOTAL SQ1234.2 +057400 ELSE SQ1234.2 +057500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1234.2 +057600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1234.2 +057700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1234.2 +057800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1234.2 +057900* SQ1234.2 +058000 WRITE-LINE. SQ1234.2 +058100 ADD 1 TO RECORD-COUNT. SQ1234.2 +058200 IF RECORD-COUNT GREATER 50 SQ1234.2 +058300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1234.2 +058400 MOVE SPACE TO DUMMY-RECORD SQ1234.2 +058500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1234.2 +058600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1234.2 +058700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1234.2 +058800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1234.2 +058900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1234.2 +059000 MOVE ZERO TO RECORD-COUNT. SQ1234.2 +059100 PERFORM WRT-LN. SQ1234.2 +059200* SQ1234.2 +059300 WRT-LN. SQ1234.2 +059400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1234.2 +059500 MOVE SPACE TO DUMMY-RECORD. SQ1234.2 +059600 BLANK-LINE-PRINT. SQ1234.2 +059700 PERFORM WRT-LN. SQ1234.2 +059800 FAIL-ROUTINE. SQ1234.2 +059900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1234.2 +060000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1234.2 +060100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1234.2 +060200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1234.2 +060300 MOVE XXINFO TO DUMMY-RECORD. SQ1234.2 +060400 PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +060500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1234.2 +060600 GO TO FAIL-ROUTINE-EX. SQ1234.2 +060700 FAIL-ROUTINE-WRITE. SQ1234.2 +060800 MOVE TEST-COMPUTED TO PRINT-REC SQ1234.2 +060900 PERFORM WRITE-LINE SQ1234.2 +061000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1234.2 +061100 MOVE TEST-CORRECT TO PRINT-REC SQ1234.2 +061200 PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +061300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1234.2 +061400 FAIL-ROUTINE-EX. SQ1234.2 +061500 EXIT. SQ1234.2 +061600 BAIL-OUT. SQ1234.2 +061700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1234.2 +061800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1234.2 +061900 BAIL-OUT-WRITE. SQ1234.2 +062000 MOVE CORRECT-A TO XXCORRECT. SQ1234.2 +062100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1234.2 +062200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1234.2 +062300 MOVE XXINFO TO DUMMY-RECORD. SQ1234.2 +062400 PERFORM WRITE-LINE 2 TIMES. SQ1234.2 +062500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1234.2 +062600 BAIL-OUT-EX. SQ1234.2 +062700 EXIT. SQ1234.2 +062800 CCVS1-EXIT. SQ1234.2 +062900 EXIT. SQ1234.2 +063000* SQ1234.2 +063100**************************************************************** SQ1234.2 +063200* * SQ1234.2 +063300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1234.2 +063400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1234.2 +063500* * SQ1234.2 +063600**************************************************************** SQ1234.2 +063700* SQ1234.2 +063800 SECT-SQ123A-0004 SECTION. SQ1234.2 +063900 STA-INIT. SQ1234.2 +064000 MOVE SPACE TO DELETE-SW. SQ1234.2 +064100* SQ1234.2 +064200 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1234.2 +064300 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1234.2 +064400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1234.2 +064500 MOVE 125 TO XRECORD-LENGTH (1). SQ1234.2 +064600 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1234.2 +064700 MOVE 1 TO XBLOCK-SIZE (1). SQ1234.2 +064800 MOVE 0 TO RECORDS-IN-FILE (1). SQ1234.2 +064900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1234.2 +065000 MOVE "S" TO XLABEL-TYPE (1). SQ1234.2 +065100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1234.2 +065200* SQ1234.2 +065300* OPEN THE FILE IN THE OUTPUT MODE SQ1234.2 +065400* SQ1234.2 +065500 SEQ-INIT-01. SQ1234.2 +065600 MOVE 0 TO REC-CT. SQ1234.2 +065700 MOVE "*" TO DECL-EXEC-SW. SQ1234.2 +065800 MOVE "**" TO SQ-FS4-STATUS. SQ1234.2 +065900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1234.2 +066000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1234.2 +066100 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1234.2 +066200 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1234.2 +066300 GO TO SEQ-TEST-OP-01. SQ1234.2 +066400 SEQ-DELETE-01. SQ1234.2 +066500 MOVE "*" TO DELETE-SW-1. SQ1234.2 +066600 GO TO SEQ-DELETE-01-01. SQ1234.2 +066700 SEQ-TEST-OP-01. SQ1234.2 +066800 OPEN OUTPUT SQ-FS4. SQ1234.2 +066900* SQ1234.2 +067000* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1234.2 +067100* SQ1234.2 +067200 ADD 1 TO REC-CT. SQ1234.2 +067300 IF DELETE-SW NOT = SPACE SQ1234.2 +067400 GO TO SEQ-DELETE-01-01. SQ1234.2 +067500 GO TO SEQ-TEST-OP-01-01. SQ1234.2 +067600 SEQ-DELETE-01-01. SQ1234.2 +067700 PERFORM DE-LETE. SQ1234.2 +067800 GO TO SEQ-TEST-01-01-END. SQ1234.2 +067900 SEQ-TEST-OP-01-01. SQ1234.2 +068000 IF SQ-FS4-STATUS = "00" SQ1234.2 +068100 PERFORM PASS SQ1234.2 +068200 ELSE SQ1234.2 +068300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1234.2 +068400 MOVE "00" TO CORRECT-A SQ1234.2 +068500 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1234.2 +068600 TO RE-MARK SQ1234.2 +068700 MOVE "VII-3, VII-23" TO ANSI-REFERENCE SQ1234.2 +068800 PERFORM FAIL. SQ1234.2 +068900 SEQ-TEST-01-01-END. SQ1234.2 +069000* SQ1234.2 +069100* CHECK EXECUTION OF INPUT DECLARATIVE SQ1234.2 +069200* SQ1234.2 +069300 ADD 1 TO REC-CT. SQ1234.2 +069400 IF DELETE-SW NOT = SPACE SQ1234.2 +069500 GO TO SEQ-DELETE-01-02. SQ1234.2 +069600 GO TO SEQ-TEST-OP-01-02. SQ1234.2 +069700 SEQ-DELETE-01-02. SQ1234.2 +069800 PERFORM DE-LETE. SQ1234.2 +069900 GO TO SEQ-TEST-01-02-END. SQ1234.2 +070000 SEQ-TEST-OP-01-02. SQ1234.2 +070100 IF DECL-EXEC-I = "NOT EXECUTED" SQ1234.2 +070200 PERFORM PASS SQ1234.2 +070300 ELSE SQ1234.2 +070400 MOVE DECL-EXEC-I TO COMPUTED-A SQ1234.2 +070500 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +070600 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ1234.2 +070700 TO RE-MARK SQ1234.2 +070800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +070900 PERFORM FAIL. SQ1234.2 +071000 SEQ-TEST-01-02-END. SQ1234.2 +071100* SQ1234.2 +071200* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ1234.2 +071300* SQ1234.2 +071400 ADD 1 TO REC-CT. SQ1234.2 +071500 IF DELETE-SW NOT = SPACE SQ1234.2 +071600 GO TO SEQ-DELETE-01-03. SQ1234.2 +071700 GO TO SEQ-TEST-OP-01-03. SQ1234.2 +071800 SEQ-DELETE-01-03. SQ1234.2 +071900 PERFORM DE-LETE. SQ1234.2 +072000 GO TO SEQ-TEST-01-03-END. SQ1234.2 +072100 SEQ-TEST-OP-01-03. SQ1234.2 +072200 IF DECL-EXEC-O = "NOT EXECUTED" SQ1234.2 +072300 PERFORM PASS SQ1234.2 +072400 ELSE SQ1234.2 +072500 MOVE DECL-EXEC-O TO COMPUTED-A SQ1234.2 +072600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +072700 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ1234.2 +072800 TO RE-MARK SQ1234.2 +072900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +073000 PERFORM FAIL. SQ1234.2 +073100 SEQ-TEST-01-03-END. SQ1234.2 +073200* SQ1234.2 +073300* SQ1234.2 +073400* THE FILE HAS BEEN CREATED. WE NOW EXECUTE CLOSE REEL SQ1234.2 +073500* SQ1234.2 +073600 SEQ-INIT-02. SQ1234.2 +073700 MOVE 0 TO REC-CT. SQ1234.2 +073800 MOVE "*" TO DECL-EXEC-SW. SQ1234.2 +073900 MOVE "**" TO SQ-FS4-STATUS. SQ1234.2 +074000 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1234.2 +074100 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1234.2 +074200 MOVE "CLOSE REEL, NON-REEL" TO FEATURE. SQ1234.2 +074300 MOVE "SEQ-TEST-CR-02" TO PAR-NAME. SQ1234.2 +074400 IF DELETE-SW NOT EQUAL TO SPACE SQ1234.2 +074500 GO TO SEQ-DELETE-02. SQ1234.2 +074600 GO TO SEQ-TEST-CR-02. SQ1234.2 +074700 SEQ-DELETE-02. SQ1234.2 +074800 MOVE "*" TO DELETE-SW-2. SQ1234.2 +074900 GO TO SEQ-DELETE-02-01. SQ1234.2 +075000 SEQ-TEST-CR-02. SQ1234.2 +075100 CLOSE SQ-FS4 REEL. SQ1234.2 +075200* SQ1234.2 +075300* CHECK I-O STATUS RETURNED FROM CLOSE REEL SQ1234.2 +075400* SQ1234.2 +075500 ADD 1 TO REC-CT. SQ1234.2 +075600 IF DELETE-SW NOT = SPACE SQ1234.2 +075700 GO TO SEQ-DELETE-02-01. SQ1234.2 +075800 GO TO SEQ-TEST-CR-02-01. SQ1234.2 +075900 SEQ-DELETE-02-01. SQ1234.2 +076000 PERFORM DE-LETE. SQ1234.2 +076100 GO TO SEQ-TEST-02-01-END. SQ1234.2 +076200 SEQ-TEST-CR-02-01. SQ1234.2 +076300 IF SQ-FS4-STATUS = "07" SQ1234.2 +076400 PERFORM PASS SQ1234.2 +076500 ELSE SQ1234.2 +076600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1234.2 +076700 MOVE "07" TO CORRECT-A SQ1234.2 +076800 MOVE "UNEXPECTED I-O STATUS FROM CLOSE REEL" SQ1234.2 +076900 TO RE-MARK SQ1234.2 +077000 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ1234.2 +077100 PERFORM FAIL. SQ1234.2 +077200 SEQ-TEST-02-01-END. SQ1234.2 +077300* SQ1234.2 +077400* CHECK EXECUTION OF INPUT DECLARATIVE SQ1234.2 +077500* SQ1234.2 +077600 ADD 1 TO REC-CT. SQ1234.2 +077700 IF DELETE-SW NOT = SPACE SQ1234.2 +077800 GO TO SEQ-DELETE-02-02. SQ1234.2 +077900 GO TO SEQ-TEST-CR-02-02. SQ1234.2 +078000 SEQ-DELETE-02-02. SQ1234.2 +078100 PERFORM DE-LETE. SQ1234.2 +078200 GO TO SEQ-TEST-02-02-END. SQ1234.2 +078300 SEQ-TEST-CR-02-02. SQ1234.2 +078400 IF DECL-EXEC-I = "NOT EXECUTED" SQ1234.2 +078500 PERFORM PASS SQ1234.2 +078600 ELSE SQ1234.2 +078700 MOVE DECL-EXEC-I TO COMPUTED-A SQ1234.2 +078800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +078900 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ1234.2 +079000 TO RE-MARK SQ1234.2 +079100 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +079200 PERFORM FAIL. SQ1234.2 +079300 SEQ-TEST-02-02-END. SQ1234.2 +079400* SQ1234.2 +079500* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ1234.2 +079600* SQ1234.2 +079700 ADD 1 TO REC-CT. SQ1234.2 +079800 IF DELETE-SW NOT = SPACE SQ1234.2 +079900 GO TO SEQ-DELETE-02-03. SQ1234.2 +080000 GO TO SEQ-TEST-CR-02-03. SQ1234.2 +080100 SEQ-DELETE-02-03. SQ1234.2 +080200 PERFORM DE-LETE. SQ1234.2 +080300 GO TO SEQ-TEST-02-03-END. SQ1234.2 +080400 SEQ-TEST-CR-02-03. SQ1234.2 +080500 IF DECL-EXEC-O = "NOT EXECUTED" SQ1234.2 +080600 PERFORM PASS SQ1234.2 +080700 ELSE SQ1234.2 +080800 MOVE DECL-EXEC-O TO COMPUTED-A SQ1234.2 +080900 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +081000 MOVE "UNEXPECTED EXECUTION OF OUTPUT DECLARATIVE" SQ1234.2 +081100 TO RE-MARK SQ1234.2 +081200 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +081300 PERFORM FAIL. SQ1234.2 +081400 SEQ-TEST-02-03-END. SQ1234.2 +081500 MOVE SPACE TO DELETE-SW-2. SQ1234.2 +081600* SQ1234.2 +081700* SQ1234.2 +081800* NOW EXECUTE A NORMAL CLOSE ON THE EMPTY FILE. SQ1234.2 +081900* SQ1234.2 +082000 SEQ-INIT-03. SQ1234.2 +082100 MOVE 0 TO REC-CT. SQ1234.2 +082200 MOVE SPACE TO DECL-EXEC-SW. SQ1234.2 +082300 MOVE "**" TO SQ-FS4-STATUS. SQ1234.2 +082400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1234.2 +082500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1234.2 +082600 MOVE "CLOSE AFTER CLOSE REEL" TO FEATURE. SQ1234.2 +082700 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1234.2 +082800 IF DELETE-SW NOT EQUAL TO SPACE SQ1234.2 +082900 GO TO SEQ-DELETE-03. SQ1234.2 +083000 GO TO SEQ-TEST-CL-03. SQ1234.2 +083100 SEQ-DELETE-03. SQ1234.2 +083200 MOVE "*" TO DELETE-SW-2. SQ1234.2 +083300 GO TO SEQ-DELETE-03-01. SQ1234.2 +083400 SEQ-TEST-CL-03. SQ1234.2 +083500 CLOSE SQ-FS4. SQ1234.2 +083600* SQ1234.2 +083700* CHECK I-O STATUS RETURNED FROM CLOSE SQ1234.2 +083800* SQ1234.2 +083900 ADD 1 TO REC-CT. SQ1234.2 +084000 IF DELETE-SW NOT = SPACE SQ1234.2 +084100 GO TO SEQ-DELETE-03-01. SQ1234.2 +084200 GO TO SEQ-TEST-CL-03-01. SQ1234.2 +084300 SEQ-DELETE-03-01. SQ1234.2 +084400 PERFORM DE-LETE. SQ1234.2 +084500 GO TO SEQ-TEST-03-01-END. SQ1234.2 +084600 SEQ-TEST-CL-03-01. SQ1234.2 +084700 IF SQ-FS4-STATUS = "00" SQ1234.2 +084800 PERFORM PASS SQ1234.2 +084900 ELSE SQ1234.2 +085000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1234.2 +085100 MOVE "00" TO CORRECT-A SQ1234.2 +085200 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1234.2 +085300 TO RE-MARK SQ1234.2 +085400 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1234.2 +085500 PERFORM FAIL. SQ1234.2 +085600 SEQ-TEST-03-01-END. SQ1234.2 +085700* SQ1234.2 +085800* CHECK EXECUTION OF INPUT DECLARATIVE SQ1234.2 +085900* SQ1234.2 +086000 ADD 1 TO REC-CT. SQ1234.2 +086100 IF DELETE-SW NOT = SPACE SQ1234.2 +086200 GO TO SEQ-DELETE-03-02. SQ1234.2 +086300 GO TO SEQ-TEST-CL-03-02. SQ1234.2 +086400 SEQ-DELETE-03-02. SQ1234.2 +086500 PERFORM DE-LETE. SQ1234.2 +086600 GO TO SEQ-TEST-03-02-END. SQ1234.2 +086700 SEQ-TEST-CL-03-02. SQ1234.2 +086800 IF DECL-EXEC-I = "NOT EXECUTED" SQ1234.2 +086900 PERFORM PASS SQ1234.2 +087000 ELSE SQ1234.2 +087100 MOVE DECL-EXEC-I TO COMPUTED-A SQ1234.2 +087200 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +087300 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ1234.2 +087400 TO RE-MARK SQ1234.2 +087500 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +087600 PERFORM FAIL. SQ1234.2 +087700 SEQ-TEST-03-02-END. SQ1234.2 +087800* SQ1234.2 +087900* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ1234.2 +088000* SQ1234.2 +088100 ADD 1 TO REC-CT. SQ1234.2 +088200 IF DELETE-SW NOT = SPACE SQ1234.2 +088300 GO TO SEQ-DELETE-03-03. SQ1234.2 +088400 GO TO SEQ-TEST-CL-03-03. SQ1234.2 +088500 SEQ-DELETE-03-03. SQ1234.2 +088600 PERFORM DE-LETE. SQ1234.2 +088700 GO TO SEQ-TEST-03-03-END. SQ1234.2 +088800 SEQ-TEST-CL-03-03. SQ1234.2 +088900 IF DECL-EXEC-O = "NOT EXECUTED" SQ1234.2 +089000 PERFORM PASS SQ1234.2 +089100 ELSE SQ1234.2 +089200 MOVE DECL-EXEC-O TO COMPUTED-A SQ1234.2 +089300 MOVE "NOT EXECUTED" TO CORRECT-A SQ1234.2 +089400 MOVE "UNEXPECTED EXECUTION OF OUTPUT DECLARATIVE" SQ1234.2 +089500 TO RE-MARK SQ1234.2 +089600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1234.2 +089700 PERFORM FAIL. SQ1234.2 +089800 SEQ-TEST-03-03-END. SQ1234.2 +089900 MOVE SPACE TO DELETE-SW-2. SQ1234.2 +090000* SQ1234.2 +090100* SQ1234.2 +090200 CCVS-EXIT SECTION. SQ1234.2 +090300 CCVS-999999. SQ1234.2 +090400 GO TO CLOSE-FILES. SQ1234.2 diff --git a/tests/cobol85/SQ/SQ124A.CBL b/tests/cobol85/SQ/SQ124A.CBL new file mode 100755 index 00000000..a3b6822d --- /dev/null +++ b/tests/cobol85/SQ/SQ124A.CBL @@ -0,0 +1,1192 @@ +000100 IDENTIFICATION DIVISION. SQ1244.2 +000200 PROGRAM-ID. SQ1244.2 +000300 SQ124A. SQ1244.2 +000400**************************************************************** SQ1244.2 +000500* * SQ1244.2 +000600* VALIDATION FOR:- * SQ1244.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1244.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1244.2 +000900* REVISED 1986, AUGUST * SQ1244.2 +001000* * SQ1244.2 +001100* CREATION DATE / VALIDATION DATE * SQ1244.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1244.2 +001300* * SQ1244.2 +001400**************************************************************** SQ1244.2 +001500* * SQ1244.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1244.2 +001700* * SQ1244.2 +001800* X-14 SEQUENTIAL NON-UNIT MASS STORAGE FILE * SQ1244.2 +001900* X-55 SYSTEM PRINTER * SQ1244.2 +002000* X-82 SOURCE-COMPUTER * SQ1244.2 +002100* X-83 OBJECT-COMPUTER. * SQ1244.2 +002200* * SQ1244.2 +002300**************************************************************** SQ1244.2 +002400* * SQ1244.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ1244.2 +002600* TO A MEDIUM WHICH IS NOT A REEL/UNIT MEDIUM. ONE RECORD * SQ1244.2 +002700* IS WRITTEN TO THE FILE AND A CLOSE UNIT STATEMENT IS * SQ1244.2 +002800* EXECUTED. THIS SHOULD HAVE NO EFFECT ON THE FILE, EXCEPT * SQ1244.2 +002900* TO CAUSE I-O STATUS 07. THE FILE SHOULD REMAIN OPEN. A * SQ1244.2 +003000* SECOND RECORD IS THEN WRITTEN AND A NORMAL, UNQUALIFIED, * SQ1244.2 +003100* CLOSE STATEMENT IS EXECUTED. THIS SHOULD BE SUCCESSFUL * SQ1244.2 +003200* AND CLOSE THE FILE. THE FILE IS THEN REOPENED FOR INPUT * SQ1244.2 +003300* AND THE TWO RECORDS CHECKED. A CLOSE UNIT STATEMENT IS * SQ1244.2 +003400* EXECUTED BEFORE THE FIRST RECORD IS READ, AND AGAIN THIS * SQ1244.2 +003500* SHOULD HAVE NO EFFECT ON SUBSEQUENT OPERATIONS ON THE * SQ1244.2 +003600* FILE. AFTER THE TWO RECORDS HAVE BEEN READ, A FURTHER * SQ1244.2 +003700* READ STATEMENT IS EXECUTED TO RAISE THE AT END CONDITION, * SQ1244.2 +003800* WHICH IS CHECKED, AND THE FILE IS CLOSED. * SQ1244.2 +003900* * SQ1244.2 +004000**************************************************************** SQ1244.2 +004100* SQ1244.2 +004200 ENVIRONMENT DIVISION. SQ1244.2 +004300 CONFIGURATION SECTION. SQ1244.2 +004400 SOURCE-COMPUTER. SQ1244.2 +004500 Linux. SQ1244.2 +004600 OBJECT-COMPUTER. SQ1244.2 +004700 Linux. SQ1244.2 +004800* SQ1244.2 +004900 INPUT-OUTPUT SECTION. SQ1244.2 +005000 FILE-CONTROL. SQ1244.2 +005100 SELECT PRINT-FILE ASSIGN TO SQ1244.2 +005200 "report.log". SQ1244.2 +005300* SQ1244.2 +005400*P SELECT RAW-DATA ASSIGN TO SQ1244.2 +005500*P "XXXXX062" SQ1244.2 +005600*P ORGANIZATION IS INDEXED SQ1244.2 +005700*P ACCESS MODE IS RANDOM SQ1244.2 +005800*P RECORD-KEY IS RAW-DATA-KEY. SQ1244.2 +005900*P SQ1244.2 +006000 SELECT SQ-FS4 ASSIGN SQ1244.2 +006100 "XXXXX014" SQ1244.2 +006200 ORGANIZATION IS SEQUENTIAL SQ1244.2 +006300 ACCESS SEQUENTIAL SQ1244.2 +006400 FILE STATUS SQ-FS4-STATUS SQ1244.2 +006500 IN STATUS-GROUP SQ1244.2 +006600 . SQ1244.2 +006700* SQ1244.2 +006800* SQ1244.2 +006900 DATA DIVISION. SQ1244.2 +007000 FILE SECTION. SQ1244.2 +007100 FD PRINT-FILE SQ1244.2 +007200*C LABEL RECORDS SQ1244.2 +007300*C OMITTED SQ1244.2 +007400*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1244.2 +007500 . SQ1244.2 +007600 01 PRINT-REC PICTURE X(120). SQ1244.2 +007700 01 DUMMY-RECORD PICTURE X(120). SQ1244.2 +007800*P SQ1244.2 +007900*PD RAW-DATA. SQ1244.2 +008000*P1 RAW-DATA-SATZ. SQ1244.2 +008100*P 05 RAW-DATA-KEY PIC X(6). SQ1244.2 +008200*P 05 C-DATE PIC 9(6). SQ1244.2 +008300*P 05 C-TIME PIC 9(8). SQ1244.2 +008400*P 05 NO-OF-TESTS PIC 99. SQ1244.2 +008500*P 05 C-OK PIC 999. SQ1244.2 +008600*P 05 C-ALL PIC 999. SQ1244.2 +008700*P 05 C-FAIL PIC 999. SQ1244.2 +008800*P 05 C-DELETED PIC 999. SQ1244.2 +008900*P 05 C-INSPECT PIC 999. SQ1244.2 +009000*P 05 C-NOTE PIC X(13). SQ1244.2 +009100*P 05 C-INDENT PIC X. SQ1244.2 +009200*P 05 C-ABORT PIC X(8). SQ1244.2 +009300* SQ1244.2 +009400 FD SQ-FS4 SQ1244.2 +009500*C LABEL RECORD IS STANDARD SQ1244.2 +009600 . SQ1244.2 +009700 01 SQ-FS4R1-F-G-120. SQ1244.2 +009800 05 SQ-FS4R1-RECORD-INFO-P1-120. SQ1244.2 +009900 07 FILLER PIC X(5). SQ1244.2 +010000 07 FFILE-NAME PIC X(6). SQ1244.2 +010100 07 FILLER PIC X(8). SQ1244.2 +010200 07 FRECORD-NAME PIC X(6). SQ1244.2 +010300 07 FILLER PIC X(1). SQ1244.2 +010400 07 FREELUNIT-NUMBER PIC 9(1). SQ1244.2 +010500 07 FILLER PIC X(7). SQ1244.2 +010600 07 FRECORD-NUMBER PIC 9(6). SQ1244.2 +010700 07 FILLER PIC X(6). SQ1244.2 +010800 07 FUPDATE-NUMBER PIC 9(2). SQ1244.2 +010900 07 FILLER PIC X(5). SQ1244.2 +011000 07 FODO-NUMBER PIC 9(4). SQ1244.2 +011100 07 FILLER PIC X(5). SQ1244.2 +011200 07 FPROGRAM-NAME PIC X(5). SQ1244.2 +011300 07 FILLER PIC X(7). SQ1244.2 +011400 07 FRECORD-LENGTH PIC 9(6). SQ1244.2 +011500 07 FILLER PIC X(7). SQ1244.2 +011600 07 FCHARS-OR-RECORDS PIC X(2). SQ1244.2 +011700 07 FILLER PIC X(1). SQ1244.2 +011800 07 FBLOCK-SIZE PIC 9(4). SQ1244.2 +011900 07 FILLER PIC X(6). SQ1244.2 +012000 07 FRECORDS-IN-FILE PIC 9(6). SQ1244.2 +012100 07 FILLER PIC X(5). SQ1244.2 +012200 07 FFILE-ORGANIZATION PIC X(2). SQ1244.2 +012300 07 FILLER PIC X(6). SQ1244.2 +012400 07 FLABEL-TYPE PIC X(1). SQ1244.2 +012500* SQ1244.2 +012600 WORKING-STORAGE SECTION. SQ1244.2 +012700* SQ1244.2 +012800*************************************************************** SQ1244.2 +012900* * SQ1244.2 +013000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1244.2 +013100* * SQ1244.2 +013200*************************************************************** SQ1244.2 +013300* SQ1244.2 +013400 01 STATUS-GROUP. SQ1244.2 +013500 03 SQ-FS4-STATUS. SQ1244.2 +013600 05 SQ-FS4-KEY-1 PIC X. SQ1244.2 +013700 05 SQ-FS4-KEY-2 PIC X. SQ1244.2 +013800* SQ1244.2 +013900 01 DELETE-SW. SQ1244.2 +014000 03 DELETE-SW-1 PIC X. SQ1244.2 +014100 03 DELETE-SW-1-GROUP. SQ1244.2 +014200 05 DELETE-SW-2 PIC X. SQ1244.2 +014300 05 DELETE-SW-2-GROUP. SQ1244.2 +014400 07 DELETE-SW-3 PIC X. SQ1244.2 +014500* SQ1244.2 +014600 01 AT-END-SW PIC X(12). SQ1244.2 +014700 01 NOT-END-SW PIC X(12). SQ1244.2 +014800* SQ1244.2 +014900*************************************************************** SQ1244.2 +015000* * SQ1244.2 +015100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1244.2 +015200* * SQ1244.2 +015300*************************************************************** SQ1244.2 +015400* SQ1244.2 +015500 01 REC-SKEL-SUB PIC 99. SQ1244.2 +015600* SQ1244.2 +015700 01 FILE-RECORD-INFORMATION-REC. SQ1244.2 +015800 03 FILE-RECORD-INFO-SKELETON. SQ1244.2 +015900 05 FILLER PICTURE X(48) VALUE SQ1244.2 +016000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1244.2 +016100 05 FILLER PICTURE X(46) VALUE SQ1244.2 +016200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1244.2 +016300 05 FILLER PICTURE X(26) VALUE SQ1244.2 +016400 ",LFIL=000000,ORG= ,LBLR= ". SQ1244.2 +016500 05 FILLER PICTURE X(37) VALUE SQ1244.2 +016600 ",RECKEY= ". SQ1244.2 +016700 05 FILLER PICTURE X(38) VALUE SQ1244.2 +016800 ",ALTKEY1= ". SQ1244.2 +016900 05 FILLER PICTURE X(38) VALUE SQ1244.2 +017000 ",ALTKEY2= ". SQ1244.2 +017100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1244.2 +017200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1244.2 +017300 05 FILE-RECORD-INFO-P1-120. SQ1244.2 +017400 07 FILLER PIC X(5). SQ1244.2 +017500 07 XFILE-NAME PIC X(6). SQ1244.2 +017600 07 FILLER PIC X(8). SQ1244.2 +017700 07 XRECORD-NAME PIC X(6). SQ1244.2 +017800 07 FILLER PIC X(1). SQ1244.2 +017900 07 REELUNIT-NUMBER PIC 9(1). SQ1244.2 +018000 07 FILLER PIC X(7). SQ1244.2 +018100 07 XRECORD-NUMBER PIC 9(6). SQ1244.2 +018200 07 FILLER PIC X(6). SQ1244.2 +018300 07 UPDATE-NUMBER PIC 9(2). SQ1244.2 +018400 07 FILLER PIC X(5). SQ1244.2 +018500 07 ODO-NUMBER PIC 9(4). SQ1244.2 +018600 07 FILLER PIC X(5). SQ1244.2 +018700 07 XPROGRAM-NAME PIC X(5). SQ1244.2 +018800 07 FILLER PIC X(7). SQ1244.2 +018900 07 XRECORD-LENGTH PIC 9(6). SQ1244.2 +019000 07 FILLER PIC X(7). SQ1244.2 +019100 07 CHARS-OR-RECORDS PIC X(2). SQ1244.2 +019200 07 FILLER PIC X(1). SQ1244.2 +019300 07 XBLOCK-SIZE PIC 9(4). SQ1244.2 +019400 07 FILLER PIC X(6). SQ1244.2 +019500 07 RECORDS-IN-FILE PIC 9(6). SQ1244.2 +019600 07 FILLER PIC X(5). SQ1244.2 +019700 07 XFILE-ORGANIZATION PIC X(2). SQ1244.2 +019800 07 FILLER PIC X(6). SQ1244.2 +019900 07 XLABEL-TYPE PIC X(1). SQ1244.2 +020000 05 FILE-RECORD-INFO-P121-240. SQ1244.2 +020100 07 FILLER PIC X(8). SQ1244.2 +020200 07 XRECORD-KEY PIC X(29). SQ1244.2 +020300 07 FILLER PIC X(9). SQ1244.2 +020400 07 ALTERNATE-KEY1 PIC X(29). SQ1244.2 +020500 07 FILLER PIC X(9). SQ1244.2 +020600 07 ALTERNATE-KEY2 PIC X(29). SQ1244.2 +020700 07 FILLER PIC X(7). SQ1244.2 +020800* SQ1244.2 +020900 01 TEST-RESULTS. SQ1244.2 +021000 02 FILLER PIC X VALUE SPACE. SQ1244.2 +021100 02 PAR-NAME. SQ1244.2 +021200 03 FILLER PIC X(14) VALUE SPACE. SQ1244.2 +021300 03 PARDOT-X PIC X VALUE SPACE. SQ1244.2 +021400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1244.2 +021500 02 FILLER PIC X VALUE SPACE. SQ1244.2 +021600 02 FEATURE PIC X(24) VALUE SPACE. SQ1244.2 +021700 02 FILLER PIC X VALUE SPACE. SQ1244.2 +021800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1244.2 +021900 02 FILLER PIC X(9) VALUE SPACE. SQ1244.2 +022000 02 RE-MARK PIC X(61). SQ1244.2 +022100 01 TEST-COMPUTED. SQ1244.2 +022200 02 FILLER PIC X(30) VALUE SPACE. SQ1244.2 +022300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1244.2 +022400 02 COMPUTED-X. SQ1244.2 +022500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1244.2 +022600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1244.2 +022700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1244.2 +022800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1244.2 +022900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1244.2 +023000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1244.2 +023100 04 COMPUTED-18V0 PIC -9(18). SQ1244.2 +023200 04 FILLER PIC X. SQ1244.2 +023300 03 FILLER PIC X(50) VALUE SPACE. SQ1244.2 +023400 01 TEST-CORRECT. SQ1244.2 +023500 02 FILLER PIC X(30) VALUE SPACE. SQ1244.2 +023600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1244.2 +023700 02 CORRECT-X. SQ1244.2 +023800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1244.2 +023900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1244.2 +024000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1244.2 +024100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1244.2 +024200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1244.2 +024300 03 CR-18V0 REDEFINES CORRECT-A. SQ1244.2 +024400 04 CORRECT-18V0 PIC -9(18). SQ1244.2 +024500 04 FILLER PIC X. SQ1244.2 +024600 03 FILLER PIC X(2) VALUE SPACE. SQ1244.2 +024700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1244.2 +024800* SQ1244.2 +024900 01 CCVS-C-1. SQ1244.2 +025000 02 FILLER PIC IS X VALUE SPACE. SQ1244.2 +025100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1244.2 +025200 02 FILLER PIC IS X VALUE SPACE. SQ1244.2 +025300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1244.2 +025400 02 FILLER PIC IS X VALUE SPACE. SQ1244.2 +025500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1244.2 +025600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1244.2 +025700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1244.2 +025800 01 CCVS-C-2. SQ1244.2 +025900 02 FILLER PIC X(19) VALUE SPACE. SQ1244.2 +026000 02 FILLER PIC X(6) VALUE "TESTED". SQ1244.2 +026100 02 FILLER PIC X(19) VALUE SPACE. SQ1244.2 +026200 02 FILLER PIC X(4) VALUE "FAIL". SQ1244.2 +026300 02 FILLER PIC X(72) VALUE SPACE. SQ1244.2 +026400* SQ1244.2 +026500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1244.2 +026600 01 REC-CT PIC 99 VALUE ZERO. SQ1244.2 +026700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1244.2 +026800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1244.2 +026900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1244.2 +027000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1244.2 +027100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1244.2 +027200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1244.2 +027300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1244.2 +027400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1244.2 +027500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1244.2 +027600 01 CCVS-H-1. SQ1244.2 +027700 02 FILLER PIC X(39) VALUE SPACES. SQ1244.2 +027800 02 FILLER PIC X(42) VALUE SQ1244.2 +027900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1244.2 +028000 02 FILLER PIC X(39) VALUE SPACES. SQ1244.2 +028100 01 CCVS-H-2A. SQ1244.2 +028200 02 FILLER PIC X(40) VALUE SPACE. SQ1244.2 +028300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1244.2 +028400 02 FILLER PIC XXXX VALUE SQ1244.2 +028500 "4.2 ". SQ1244.2 +028600 02 FILLER PIC X(28) VALUE SQ1244.2 +028700 " COPY - NOT FOR DISTRIBUTION". SQ1244.2 +028800 02 FILLER PIC X(41) VALUE SPACE. SQ1244.2 +028900* SQ1244.2 +029000 01 CCVS-H-2B. SQ1244.2 +029100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1244.2 +029200 02 TEST-ID PIC X(9). SQ1244.2 +029300 02 FILLER PIC X(4) VALUE " IN ". SQ1244.2 +029400 02 FILLER PIC X(12) VALUE SQ1244.2 +029500 " HIGH ". SQ1244.2 +029600 02 FILLER PIC X(22) VALUE SQ1244.2 +029700 " LEVEL VALIDATION FOR ". SQ1244.2 +029800 02 FILLER PIC X(58) VALUE SQ1244.2 +029900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1244.2 +030000 01 CCVS-H-3. SQ1244.2 +030100 02 FILLER PIC X(34) VALUE SQ1244.2 +030200 " FOR OFFICIAL USE ONLY ". SQ1244.2 +030300 02 FILLER PIC X(58) VALUE SQ1244.2 +030400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1244.2 +030500 02 FILLER PIC X(28) VALUE SQ1244.2 +030600 " COPYRIGHT 1985,1986 ". SQ1244.2 +030700 01 CCVS-E-1. SQ1244.2 +030800 02 FILLER PIC X(52) VALUE SPACE. SQ1244.2 +030900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1244.2 +031000 02 ID-AGAIN PIC X(9). SQ1244.2 +031100 02 FILLER PIC X(45) VALUE SPACES. SQ1244.2 +031200 01 CCVS-E-2. SQ1244.2 +031300 02 FILLER PIC X(31) VALUE SPACE. SQ1244.2 +031400 02 FILLER PIC X(21) VALUE SPACE. SQ1244.2 +031500 02 CCVS-E-2-2. SQ1244.2 +031600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1244.2 +031700 03 FILLER PIC X VALUE SPACE. SQ1244.2 +031800 03 ENDER-DESC PIC X(44) VALUE SQ1244.2 +031900 "ERRORS ENCOUNTERED". SQ1244.2 +032000 01 CCVS-E-3. SQ1244.2 +032100 02 FILLER PIC X(22) VALUE SQ1244.2 +032200 " FOR OFFICIAL USE ONLY". SQ1244.2 +032300 02 FILLER PIC X(12) VALUE SPACE. SQ1244.2 +032400 02 FILLER PIC X(58) VALUE SQ1244.2 +032500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1244.2 +032600 02 FILLER PIC X(8) VALUE SPACE. SQ1244.2 +032700 02 FILLER PIC X(20) VALUE SQ1244.2 +032800 " COPYRIGHT 1985,1986". SQ1244.2 +032900 01 CCVS-E-4. SQ1244.2 +033000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1244.2 +033100 02 FILLER PIC X(4) VALUE " OF ". SQ1244.2 +033200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1244.2 +033300 02 FILLER PIC X(40) VALUE SQ1244.2 +033400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1244.2 +033500 01 XXINFO. SQ1244.2 +033600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1244.2 +033700 02 INFO-TEXT. SQ1244.2 +033800 04 FILLER PIC X(8) VALUE SPACE. SQ1244.2 +033900 04 XXCOMPUTED PIC X(20). SQ1244.2 +034000 04 FILLER PIC X(5) VALUE SPACE. SQ1244.2 +034100 04 XXCORRECT PIC X(20). SQ1244.2 +034200 02 INF-ANSI-REFERENCE PIC X(48). SQ1244.2 +034300 01 HYPHEN-LINE. SQ1244.2 +034400 02 FILLER PIC IS X VALUE IS SPACE. SQ1244.2 +034500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1244.2 +034600- "*****************************************". SQ1244.2 +034700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1244.2 +034800- "******************************". SQ1244.2 +034900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1244.2 +035000 "SQ124A". SQ1244.2 +035100* SQ1244.2 +035200* SQ1244.2 +035300 PROCEDURE DIVISION. SQ1244.2 +035400 CCVS1 SECTION. SQ1244.2 +035500 OPEN-FILES. SQ1244.2 +035600*P OPEN I-O RAW-DATA. SQ1244.2 +035700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1244.2 +035800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1244.2 +035900*P MOVE "ABORTED " TO C-ABORT. SQ1244.2 +036000*P ADD 1 TO C-NO-OF-TESTS. SQ1244.2 +036100*P ACCEPT C-DATE FROM DATE. SQ1244.2 +036200*P ACCEPT C-TIME FROM TIME. SQ1244.2 +036300*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1244.2 +036400*PND-E-1. SQ1244.2 +036500*P CLOSE RAW-DATA. SQ1244.2 +036600 OPEN OUTPUT PRINT-FILE. SQ1244.2 +036700 MOVE CCVS-PGM-ID TO TEST-ID. SQ1244.2 +036800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1244.2 +036900 MOVE SPACE TO TEST-RESULTS. SQ1244.2 +037000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1244.2 +037100 MOVE ZERO TO REC-SKEL-SUB. SQ1244.2 +037200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1244.2 +037300 GO TO CCVS1-EXIT. SQ1244.2 +037400* SQ1244.2 +037500 CCVS-INIT-FILE. SQ1244.2 +037600 ADD 1 TO REC-SKL-SUB. SQ1244.2 +037700 MOVE FILE-RECORD-INFO-SKELETON TO SQ1244.2 +037800 FILE-RECORD-INFO (REC-SKL-SUB). SQ1244.2 +037900* SQ1244.2 +038000 CLOSE-FILES. SQ1244.2 +038100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1244.2 +038200 CLOSE PRINT-FILE. SQ1244.2 +038300*P OPEN I-O RAW-DATA. SQ1244.2 +038400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1244.2 +038500*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1244.2 +038600*P MOVE "OK. " TO C-ABORT. SQ1244.2 +038700*P MOVE PASS-COUNTER TO C-OK. SQ1244.2 +038800*P MOVE ERROR-HOLD TO C-ALL. SQ1244.2 +038900*P MOVE ERROR-COUNTER TO C-FAIL. SQ1244.2 +039000*P MOVE DELETE-CNT TO C-DELETED. SQ1244.2 +039100*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1244.2 +039200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1244.2 +039300*PND-E-2. SQ1244.2 +039400*P CLOSE RAW-DATA. SQ1244.2 +039500 TERMINATE-CCVS. SQ1244.2 +039600*S EXIT PROGRAM. SQ1244.2 +039700 STOP RUN. SQ1244.2 +039800* SQ1244.2 +039900 INSPT. SQ1244.2 +040000 MOVE "INSPT" TO P-OR-F. SQ1244.2 +040100 ADD 1 TO INSPECT-COUNTER. SQ1244.2 +040200 PERFORM PRINT-DETAIL. SQ1244.2 +040300* SQ1244.2 +040400 PASS. SQ1244.2 +040500 MOVE "PASS " TO P-OR-F. SQ1244.2 +040600 ADD 1 TO PASS-COUNTER. SQ1244.2 +040700 PERFORM PRINT-DETAIL. SQ1244.2 +040800* SQ1244.2 +040900 FAIL. SQ1244.2 +041000 MOVE "FAIL*" TO P-OR-F. SQ1244.2 +041100 ADD 1 TO ERROR-COUNTER. SQ1244.2 +041200 PERFORM PRINT-DETAIL. SQ1244.2 +041300* SQ1244.2 +041400 DE-LETE. SQ1244.2 +041500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1244.2 +041600 MOVE "*****" TO P-OR-F. SQ1244.2 +041700 ADD 1 TO DELETE-COUNTER. SQ1244.2 +041800 PERFORM PRINT-DETAIL. SQ1244.2 +041900* SQ1244.2 +042000 PRINT-DETAIL. SQ1244.2 +042100 IF REC-CT NOT EQUAL TO ZERO SQ1244.2 +042200 MOVE "." TO PARDOT-X SQ1244.2 +042300 MOVE REC-CT TO DOTVALUE. SQ1244.2 +042400 MOVE TEST-RESULTS TO PRINT-REC. SQ1244.2 +042500 PERFORM WRITE-LINE. SQ1244.2 +042600 IF P-OR-F EQUAL TO "FAIL*" SQ1244.2 +042700 PERFORM WRITE-LINE SQ1244.2 +042800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1244.2 +042900 ELSE SQ1244.2 +043000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1244.2 +043100 MOVE SPACE TO P-OR-F. SQ1244.2 +043200 MOVE SPACE TO COMPUTED-X. SQ1244.2 +043300 MOVE SPACE TO CORRECT-X. SQ1244.2 +043400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1244.2 +043500 MOVE SPACE TO RE-MARK. SQ1244.2 +043600* SQ1244.2 +043700 HEAD-ROUTINE. SQ1244.2 +043800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +043900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +044000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1244.2 +044100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1244.2 +044200 COLUMN-NAMES-ROUTINE. SQ1244.2 +044300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1244.2 +044400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +044500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1244.2 +044600 END-ROUTINE. SQ1244.2 +044700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1244.2 +044800 PERFORM WRITE-LINE 5 TIMES. SQ1244.2 +044900 END-RTN-EXIT. SQ1244.2 +045000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1244.2 +045100 PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +045200* SQ1244.2 +045300 END-ROUTINE-1. SQ1244.2 +045400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1244.2 +045500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1244.2 +045600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1244.2 +045700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1244.2 +045800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1244.2 +045900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1244.2 +046000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1244.2 +046100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1244.2 +046200 PERFORM WRITE-LINE. SQ1244.2 +046300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1244.2 +046400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1244.2 +046500 MOVE "NO " TO ERROR-TOTAL SQ1244.2 +046600 ELSE SQ1244.2 +046700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1244.2 +046800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1244.2 +046900 PERFORM WRITE-LINE. SQ1244.2 +047000 END-ROUTINE-13. SQ1244.2 +047100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1244.2 +047200 MOVE "NO " TO ERROR-TOTAL SQ1244.2 +047300 ELSE SQ1244.2 +047400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1244.2 +047500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1244.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1244.2 +047700 PERFORM WRITE-LINE. SQ1244.2 +047800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1244.2 +047900 MOVE "NO " TO ERROR-TOTAL SQ1244.2 +048000 ELSE SQ1244.2 +048100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1244.2 +048200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1244.2 +048300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1244.2 +048400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1244.2 +048500* SQ1244.2 +048600 WRITE-LINE. SQ1244.2 +048700 ADD 1 TO RECORD-COUNT. SQ1244.2 +048800 IF RECORD-COUNT GREATER 50 SQ1244.2 +048900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1244.2 +049000 MOVE SPACE TO DUMMY-RECORD SQ1244.2 +049100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1244.2 +049200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1244.2 +049300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1244.2 +049400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1244.2 +049500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1244.2 +049600 MOVE ZERO TO RECORD-COUNT. SQ1244.2 +049700 PERFORM WRT-LN. SQ1244.2 +049800* SQ1244.2 +049900 WRT-LN. SQ1244.2 +050000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1244.2 +050100 MOVE SPACE TO DUMMY-RECORD. SQ1244.2 +050200 BLANK-LINE-PRINT. SQ1244.2 +050300 PERFORM WRT-LN. SQ1244.2 +050400 FAIL-ROUTINE. SQ1244.2 +050500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1244.2 +050600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1244.2 +050700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1244.2 +050800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1244.2 +050900 MOVE XXINFO TO DUMMY-RECORD. SQ1244.2 +051000 PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +051100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1244.2 +051200 GO TO FAIL-ROUTINE-EX. SQ1244.2 +051300 FAIL-ROUTINE-WRITE. SQ1244.2 +051400 MOVE TEST-COMPUTED TO PRINT-REC SQ1244.2 +051500 PERFORM WRITE-LINE SQ1244.2 +051600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1244.2 +051700 MOVE TEST-CORRECT TO PRINT-REC SQ1244.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +051900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1244.2 +052000 FAIL-ROUTINE-EX. SQ1244.2 +052100 EXIT. SQ1244.2 +052200 BAIL-OUT. SQ1244.2 +052300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1244.2 +052400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1244.2 +052500 BAIL-OUT-WRITE. SQ1244.2 +052600 MOVE CORRECT-A TO XXCORRECT. SQ1244.2 +052700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1244.2 +052800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1244.2 +052900 MOVE XXINFO TO DUMMY-RECORD. SQ1244.2 +053000 PERFORM WRITE-LINE 2 TIMES. SQ1244.2 +053100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1244.2 +053200 BAIL-OUT-EX. SQ1244.2 +053300 EXIT. SQ1244.2 +053400 CCVS1-EXIT. SQ1244.2 +053500 EXIT. SQ1244.2 +053600* SQ1244.2 +053700**************************************************************** SQ1244.2 +053800* * SQ1244.2 +053900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1244.2 +054000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1244.2 +054100* * SQ1244.2 +054200**************************************************************** SQ1244.2 +054300* SQ1244.2 +054400 SECT-SQ124A-0004 SECTION. SQ1244.2 +054500 STA-INIT. SQ1244.2 +054600 MOVE SPACE TO DELETE-SW. SQ1244.2 +054700* SQ1244.2 +054800 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1244.2 +054900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1244.2 +055000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1244.2 +055100 MOVE 125 TO XRECORD-LENGTH (1). SQ1244.2 +055200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1244.2 +055300 MOVE 1 TO XBLOCK-SIZE (1). SQ1244.2 +055400 MOVE 2 TO RECORDS-IN-FILE (1). SQ1244.2 +055500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1244.2 +055600 MOVE "S" TO XLABEL-TYPE (1). SQ1244.2 +055700 MOVE ZERO TO XRECORD-NUMBER (1). SQ1244.2 +055800* SQ1244.2 +055900* OPEN THE FILE IN THE OUTPUT MODE SQ1244.2 +056000* DELETION OF THE OPEN OPERATION DELETES EVERY TEST SQ1244.2 +056100* IN THE PROGRAM SQ1244.2 +056200* SQ1244.2 +056300 SEQ-INIT-01. SQ1244.2 +056400 MOVE 0 TO REC-CT. SQ1244.2 +056500 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +056600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1244.2 +056700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1244.2 +056800 GO TO SEQ-TEST-OP-01. SQ1244.2 +056900 SEQ-DELETE-01. SQ1244.2 +057000 MOVE "*" TO DELETE-SW-1. SQ1244.2 +057100 GO TO SEQ-DELETE-01-01. SQ1244.2 +057200 SEQ-TEST-OP-01. SQ1244.2 +057300 OPEN OUTPUT SQ-FS4. SQ1244.2 +057400* SQ1244.2 +057500* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1244.2 +057600* SQ1244.2 +057700 ADD 1 TO REC-CT. SQ1244.2 +057800 IF DELETE-SW NOT = SPACE SQ1244.2 +057900 GO TO SEQ-DELETE-01-01. SQ1244.2 +058000 GO TO SEQ-TEST-OP-01-01. SQ1244.2 +058100 SEQ-DELETE-01-01. SQ1244.2 +058200 PERFORM DE-LETE. SQ1244.2 +058300 GO TO SEQ-TEST-01-01-END. SQ1244.2 +058400 SEQ-TEST-OP-01-01. SQ1244.2 +058500 IF SQ-FS4-STATUS = "00" SQ1244.2 +058600 PERFORM PASS SQ1244.2 +058700 ELSE SQ1244.2 +058800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +058900 MOVE "00" TO CORRECT-A SQ1244.2 +059000 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1244.2 +059100 TO RE-MARK SQ1244.2 +059200 MOVE "VII-3, VII-23" TO ANSI-REFERENCE SQ1244.2 +059300 PERFORM FAIL. SQ1244.2 +059400 SEQ-TEST-01-01-END. SQ1244.2 +059500* SQ1244.2 +059600* SQ1244.2 +059700* THE FILE HAS BEEN CREATED. WE NOW WRITE ONE RECORD SQ1244.2 +059800* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +059900* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +060000* SQ1244.2 +060100 SEQ-INIT-02. SQ1244.2 +060200 MOVE 0 TO REC-CT. SQ1244.2 +060300 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +060400 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +060500 MOVE "WRITE FIRST RECORD" TO FEATURE. SQ1244.2 +060600 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1244.2 +060700 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +060800 GO TO SEQ-DELETE-02. SQ1244.2 +060900 GO TO SEQ-TEST-WR-02. SQ1244.2 +061000 SEQ-DELETE-02. SQ1244.2 +061100 MOVE "*" TO DELETE-SW-2. SQ1244.2 +061200 GO TO SEQ-DELETE-02-01. SQ1244.2 +061300 SEQ-TEST-WR-02. SQ1244.2 +061400 MOVE FILE-RECORD-INFO (1) TO SQ-FS4R1-F-G-120. SQ1244.2 +061500 WRITE SQ-FS4R1-F-G-120. SQ1244.2 +061600* SQ1244.2 +061700* CHECK I-O STATUS RETURNED FROM WRITE SQ1244.2 +061800* SQ1244.2 +061900 ADD 1 TO REC-CT. SQ1244.2 +062000 IF DELETE-SW NOT = SPACE SQ1244.2 +062100 GO TO SEQ-DELETE-02-01. SQ1244.2 +062200 GO TO SEQ-TEST-WR-02-01. SQ1244.2 +062300 SEQ-DELETE-02-01. SQ1244.2 +062400 PERFORM DE-LETE. SQ1244.2 +062500 GO TO SEQ-TEST-02-01-END. SQ1244.2 +062600 SEQ-TEST-WR-02-01. SQ1244.2 +062700 IF SQ-FS4-STATUS = "00" SQ1244.2 +062800 PERFORM PASS SQ1244.2 +062900 ELSE SQ1244.2 +063000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +063100 MOVE "00" TO CORRECT-A SQ1244.2 +063200 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1244.2 +063300 MOVE "VII-3, VII-53,4.7.4(5)" TO ANSI-REFERENCE SQ1244.2 +063400 PERFORM FAIL. SQ1244.2 +063500 SEQ-TEST-02-01-END. SQ1244.2 +063600 MOVE SPACE TO DELETE-SW-2. SQ1244.2 +063700* SQ1244.2 +063800* SQ1244.2 +063900* ONE RECORD HAS BEEN WRITTEN. WE NOW EXECUTE CLOSE REEL SQ1244.2 +064000* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +064100* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +064200* SQ1244.2 +064300 SEQ-INIT-03. SQ1244.2 +064400 MOVE 0 TO REC-CT. SQ1244.2 +064500 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +064600 MOVE "CLOSE UNIT, NON-UNIT" TO FEATURE. SQ1244.2 +064700 MOVE "SEQ-TEST-CR-03" TO PAR-NAME. SQ1244.2 +064800 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +064900 GO TO SEQ-DELETE-03. SQ1244.2 +065000 GO TO SEQ-TEST-CR-03. SQ1244.2 +065100 SEQ-DELETE-03. SQ1244.2 +065200 MOVE "*" TO DELETE-SW-2. SQ1244.2 +065300 GO TO SEQ-DELETE-03-01. SQ1244.2 +065400 SEQ-TEST-CR-03. SQ1244.2 +065500 CLOSE SQ-FS4 UNIT. SQ1244.2 +065600* SQ1244.2 +065700* CHECK I-O STATUS RETURNED FROM CLOSE REEL SQ1244.2 +065800* SQ1244.2 +065900 ADD 1 TO REC-CT. SQ1244.2 +066000 IF DELETE-SW NOT = SPACE SQ1244.2 +066100 GO TO SEQ-DELETE-03-01. SQ1244.2 +066200 GO TO SEQ-TEST-CR-03-01. SQ1244.2 +066300 SEQ-DELETE-03-01. SQ1244.2 +066400 PERFORM DE-LETE. SQ1244.2 +066500 GO TO SEQ-TEST-03-01-END. SQ1244.2 +066600 SEQ-TEST-CR-03-01. SQ1244.2 +066700 IF SQ-FS4-STATUS = "07" SQ1244.2 +066800 PERFORM PASS SQ1244.2 +066900 ELSE SQ1244.2 +067000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +067100 MOVE "07" TO CORRECT-A SQ1244.2 +067200 MOVE "UNEXPECTED I-O STATUS FROM CLOSE REEL" SQ1244.2 +067300 TO RE-MARK SQ1244.2 +067400 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ1244.2 +067500 PERFORM FAIL. SQ1244.2 +067600 SEQ-TEST-03-01-END. SQ1244.2 +067700 MOVE SPACE TO DELETE-SW-2. SQ1244.2 +067800* SQ1244.2 +067900* THE FILE SHOULD STILL BE OPEN. WE NOW WRITE ONE MORE RECORD SQ1244.2 +068000* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +068100* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +068200* SQ1244.2 +068300 SEQ-INIT-04. SQ1244.2 +068400 MOVE 0 TO REC-CT. SQ1244.2 +068500 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +068600 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +068700 MOVE "WRITE SECOND RECORD" TO FEATURE. SQ1244.2 +068800 MOVE "SEQ-TEST-WR-04" TO PAR-NAME. SQ1244.2 +068900 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +069000 GO TO SEQ-DELETE-04. SQ1244.2 +069100 GO TO SEQ-TEST-WR-04. SQ1244.2 +069200 SEQ-DELETE-04. SQ1244.2 +069300 MOVE "*" TO DELETE-SW-2. SQ1244.2 +069400 GO TO SEQ-DELETE-04-01. SQ1244.2 +069500 SEQ-TEST-WR-04. SQ1244.2 +069600 MOVE FILE-RECORD-INFO (1) TO SQ-FS4R1-F-G-120. SQ1244.2 +069700 WRITE SQ-FS4R1-F-G-120. SQ1244.2 +069800* SQ1244.2 +069900* CHECK I-O STATUS RETURNED FROM WRITE SQ1244.2 +070000* SQ1244.2 +070100 ADD 1 TO REC-CT. SQ1244.2 +070200 IF DELETE-SW NOT = SPACE SQ1244.2 +070300 GO TO SEQ-DELETE-04-01. SQ1244.2 +070400 GO TO SEQ-TEST-WR-04-01. SQ1244.2 +070500 SEQ-DELETE-04-01. SQ1244.2 +070600 PERFORM DE-LETE. SQ1244.2 +070700 GO TO SEQ-TEST-04-01-END. SQ1244.2 +070800 SEQ-TEST-WR-04-01. SQ1244.2 +070900 IF SQ-FS4-STATUS = "00" SQ1244.2 +071000 PERFORM PASS SQ1244.2 +071100 ELSE SQ1244.2 +071200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +071300 MOVE "00" TO CORRECT-A SQ1244.2 +071400 MOVE "UNEXPECTED I-O STATUS FROM WRITE" TO RE-MARK SQ1244.2 +071500 MOVE "VII-3, VII-53,4.7.4(5)" TO ANSI-REFERENCE SQ1244.2 +071600 PERFORM FAIL. SQ1244.2 +071700 SEQ-TEST-04-01-END. SQ1244.2 +071800 MOVE SPACE TO DELETE-SW-2. SQ1244.2 +071900* SQ1244.2 +072000* SQ1244.2 +072100* NOW EXECUTE A NORMAL CLOSE ON THE FILE. SQ1244.2 +072200* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +072300* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +072400* SQ1244.2 +072500 SEQ-INIT-05. SQ1244.2 +072600 MOVE 0 TO REC-CT. SQ1244.2 +072700 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +072800 MOVE "CLOSE AFTER CLOSE REEL" TO FEATURE. SQ1244.2 +072900 MOVE "SEQ-TEST-CL-05" TO PAR-NAME. SQ1244.2 +073000 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +073100 GO TO SEQ-DELETE-05. SQ1244.2 +073200 GO TO SEQ-TEST-CL-05. SQ1244.2 +073300 SEQ-DELETE-05. SQ1244.2 +073400 MOVE "*" TO DELETE-SW-2. SQ1244.2 +073500 GO TO SEQ-DELETE-05-01. SQ1244.2 +073600 SEQ-TEST-CL-05. SQ1244.2 +073700 CLOSE SQ-FS4. SQ1244.2 +073800* SQ1244.2 +073900* CHECK I-O STATUS RETURNED FROM CLOSE SQ1244.2 +074000* SQ1244.2 +074100 ADD 1 TO REC-CT. SQ1244.2 +074200 IF DELETE-SW NOT = SPACE SQ1244.2 +074300 GO TO SEQ-DELETE-05-01. SQ1244.2 +074400 GO TO SEQ-TEST-CL-05-01. SQ1244.2 +074500 SEQ-DELETE-05-01. SQ1244.2 +074600 PERFORM DE-LETE. SQ1244.2 +074700 GO TO SEQ-TEST-05-01-END. SQ1244.2 +074800 SEQ-TEST-CL-05-01. SQ1244.2 +074900 IF SQ-FS4-STATUS = "00" SQ1244.2 +075000 PERFORM PASS SQ1244.2 +075100 ELSE SQ1244.2 +075200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +075300 MOVE "00" TO CORRECT-A SQ1244.2 +075400 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1244.2 +075500 TO RE-MARK SQ1244.2 +075600 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1244.2 +075700 PERFORM FAIL. SQ1244.2 +075800 SEQ-TEST-05-01-END. SQ1244.2 +075900 MOVE SPACE TO DELETE-SW-2. SQ1244.2 +076000* SQ1244.2 +076100* SQ1244.2 +076200* NOW OPEN THE FILE FOR INPUT. SQ1244.2 +076300* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +076400* AND ALSO DELETES THE SUBSEQUENT OPERATIONS. SQ1244.2 +076500* SQ1244.2 +076600 SEQ-INIT-06. SQ1244.2 +076700 MOVE 0 TO REC-CT. SQ1244.2 +076800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1244.2 +076900 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +077000 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ1244.2 +077100 MOVE "SEQ-TEST-OP-06" TO PAR-NAME. SQ1244.2 +077200 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +077300 GO TO SEQ-DELETE-06. SQ1244.2 +077400 GO TO SEQ-TEST-OP-06. SQ1244.2 +077500 SEQ-DELETE-06. SQ1244.2 +077600 MOVE "*" TO DELETE-SW-2. SQ1244.2 +077700 GO TO SEQ-DELETE-06-01. SQ1244.2 +077800 SEQ-TEST-OP-06. SQ1244.2 +077900 OPEN INPUT SQ-FS4. SQ1244.2 +078000 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1244.2 +078100* SQ1244.2 +078200* CHECK I-O STATUS RETURNED FROM OPEN SQ1244.2 +078300* SQ1244.2 +078400 ADD 1 TO REC-CT. SQ1244.2 +078500 IF DELETE-SW NOT = SPACE SQ1244.2 +078600 GO TO SEQ-DELETE-06-01. SQ1244.2 +078700 GO TO SEQ-TEST-OP-06-01. SQ1244.2 +078800 SEQ-DELETE-06-01. SQ1244.2 +078900 PERFORM DE-LETE. SQ1244.2 +079000 GO TO SEQ-TEST-06-01-END. SQ1244.2 +079100 SEQ-TEST-OP-06-01. SQ1244.2 +079200 IF SQ-FS4-STATUS = "00" SQ1244.2 +079300 PERFORM PASS SQ1244.2 +079400 ELSE SQ1244.2 +079500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +079600 MOVE "00" TO CORRECT-A SQ1244.2 +079700 MOVE "UNEXPECTED ERROR CODE FROM OPEN INPUT" SQ1244.2 +079800 TO RE-MARK SQ1244.2 +079900 MOVE "VII-3, VII-43,4.3.4(23)" TO ANSI-REFERENCE SQ1244.2 +080000 PERFORM FAIL. SQ1244.2 +080100 SEQ-TEST-06-01-END. SQ1244.2 +080200* SQ1244.2 +080300* SQ1244.2 +080400* WE NOW EXECUTE CLOSE REEL BEFORE ANY RECORD HAS BEEN READ. SQ1244.2 +080500* APART FROM SETTING I-O STATUS 07 THIS SHOULD HAVE NO EFFECT SQ1244.2 +080600* ON THE FILE OR THE SUBSEQUENT RETRIEVAL OF RECORDS. SQ1244.2 +080700* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +080800* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +080900* SQ1244.2 +081000 SEQ-INIT-07. SQ1244.2 +081100 MOVE 0 TO REC-CT. SQ1244.2 +081200 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +081300 MOVE "CLOSE UNIT, NON-UNIT" TO FEATURE. SQ1244.2 +081400 MOVE "SEQ-TEST-CU-07" TO PAR-NAME. SQ1244.2 +081500 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +081600 GO TO SEQ-DELETE-07. SQ1244.2 +081700 GO TO SEQ-TEST-CU-07. SQ1244.2 +081800 SEQ-DELETE-07. SQ1244.2 +081900 MOVE "*" TO DELETE-SW-3. SQ1244.2 +082000 GO TO SEQ-DELETE-07-01. SQ1244.2 +082100 SEQ-TEST-CU-07. SQ1244.2 +082200 CLOSE SQ-FS4 UNIT. SQ1244.2 +082300* SQ1244.2 +082400* CHECK I-O STATUS RETURNED FROM CLOSE REEL SQ1244.2 +082500* SQ1244.2 +082600 ADD 1 TO REC-CT. SQ1244.2 +082700 IF DELETE-SW NOT = SPACE SQ1244.2 +082800 GO TO SEQ-DELETE-07-01. SQ1244.2 +082900 GO TO SEQ-TEST-CU-07-01. SQ1244.2 +083000 SEQ-DELETE-07-01. SQ1244.2 +083100 PERFORM DE-LETE. SQ1244.2 +083200 GO TO SEQ-TEST-07-01-END. SQ1244.2 +083300 SEQ-TEST-CU-07-01. SQ1244.2 +083400 IF SQ-FS4-STATUS = "07" SQ1244.2 +083500 PERFORM PASS SQ1244.2 +083600 ELSE SQ1244.2 +083700 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +083800 MOVE "07" TO CORRECT-A SQ1244.2 +083900 MOVE "UNEXPECTED I-O STATUS FROM CLOSE UNIT" SQ1244.2 +084000 TO RE-MARK SQ1244.2 +084100 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ1244.2 +084200 PERFORM FAIL. SQ1244.2 +084300 SEQ-TEST-07-01-END. SQ1244.2 +084400 MOVE SPACE TO DELETE-SW-3. SQ1244.2 +084500* SQ1244.2 +084600* THE FILE SHOULD STILL BE OPEN. WE NOW READ A RECORD. SQ1244.2 +084700* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +084800* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +084900* SQ1244.2 +085000 SEQ-INIT-08. SQ1244.2 +085100 MOVE 0 TO REC-CT. SQ1244.2 +085200 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +085300 MOVE "NOT EXECUTED" TO AT-END-SW. SQ1244.2 +085400 MOVE "NOT EXECUTED" TO NOT-END-SW. SQ1244.2 +085500 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +085600 MOVE "READ FIRST RECORD" TO FEATURE. SQ1244.2 +085700 MOVE "SEQ-TEST-RD-08" TO PAR-NAME. SQ1244.2 +085800 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +085900 GO TO SEQ-DELETE-08. SQ1244.2 +086000 GO TO SEQ-TEST-RD-08. SQ1244.2 +086100 SEQ-DELETE-08. SQ1244.2 +086200 MOVE "*" TO DELETE-SW-3. SQ1244.2 +086300 GO TO SEQ-DELETE-08-01. SQ1244.2 +086400 SEQ-TEST-RD-08. SQ1244.2 +086500 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1244.2 +086600 READ SQ-FS4 SQ1244.2 +086700 AT END SQ1244.2 +086800 MOVE "EXECUTED" TO AT-END-SW SQ1244.2 +086900 NOT END SQ1244.2 +087000 MOVE "EXECUTED" TO NOT-END-SW. SQ1244.2 +087100* SQ1244.2 +087200* CHECK I-O STATUS RETURNED FROM READ SQ1244.2 +087300* SQ1244.2 +087400 ADD 1 TO REC-CT. SQ1244.2 +087500 IF DELETE-SW NOT = SPACE SQ1244.2 +087600 GO TO SEQ-DELETE-08-01. SQ1244.2 +087700 GO TO SEQ-TEST-RD-08-01. SQ1244.2 +087800 SEQ-DELETE-08-01. SQ1244.2 +087900 PERFORM DE-LETE. SQ1244.2 +088000 GO TO SEQ-TEST-08-01-END. SQ1244.2 +088100 SEQ-TEST-RD-08-01. SQ1244.2 +088200 IF SQ-FS4-STATUS = "00" SQ1244.2 +088300 PERFORM PASS SQ1244.2 +088400 ELSE SQ1244.2 +088500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +088600 MOVE "00" TO CORRECT-A SQ1244.2 +088700 MOVE "UNEXPECTED I-O STATUS FROM READ" TO RE-MARK SQ1244.2 +088800 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1244.2 +088900 PERFORM FAIL. SQ1244.2 +089000 SEQ-TEST-08-01-END. SQ1244.2 +089100* SQ1244.2 +089200* CHECK EXECUTION OF THE AT END PATH SQ1244.2 +089300* SQ1244.2 +089400 ADD 1 TO REC-CT. SQ1244.2 +089500 IF DELETE-SW NOT = SPACE SQ1244.2 +089600 GO TO SEQ-DELETE-08-02. SQ1244.2 +089700 GO TO SEQ-TEST-RD-08-02. SQ1244.2 +089800 SEQ-DELETE-08-02. SQ1244.2 +089900 PERFORM DE-LETE. SQ1244.2 +090000 GO TO SEQ-TEST-08-02-END. SQ1244.2 +090100 SEQ-TEST-RD-08-02. SQ1244.2 +090200 IF AT-END-SW = "NOT EXECUTED" SQ1244.2 +090300 PERFORM PASS SQ1244.2 +090400 ELSE SQ1244.2 +090500 MOVE AT-END-SW TO COMPUTED-A SQ1244.2 +090600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1244.2 +090700 MOVE "UNEXPECTED EXECUTION OF AT END PATH" TO RE-MARK SQ1244.2 +090800 MOVE "VII-46, 4.4.4(11)" TO ANSI-REFERENCE SQ1244.2 +090900 PERFORM FAIL. SQ1244.2 +091000 SEQ-TEST-08-02-END. SQ1244.2 +091100* SQ1244.2 +091200* CHECK EXECUTION OF THE NOT AT END PATH SQ1244.2 +091300* SQ1244.2 +091400 ADD 1 TO REC-CT. SQ1244.2 +091500 IF DELETE-SW NOT = SPACE SQ1244.2 +091600 GO TO SEQ-DELETE-08-03. SQ1244.2 +091700 GO TO SEQ-TEST-RD-08-03. SQ1244.2 +091800 SEQ-DELETE-08-03. SQ1244.2 +091900 PERFORM DE-LETE. SQ1244.2 +092000 GO TO SEQ-TEST-08-03-END. SQ1244.2 +092100 SEQ-TEST-RD-08-03. SQ1244.2 +092200 IF NOT-END-SW = "EXECUTED" SQ1244.2 +092300 PERFORM PASS SQ1244.2 +092400 ELSE SQ1244.2 +092500 MOVE NOT-END-SW TO COMPUTED-A SQ1244.2 +092600 MOVE "EXECUTED" TO CORRECT-A SQ1244.2 +092700 MOVE "UNEXPECTED NON-EXECUTION OF AT END PATH" SQ1244.2 +092800 TO RE-MARK SQ1244.2 +092900 MOVE "VII-46, 4.4.4(11)" TO ANSI-REFERENCE SQ1244.2 +093000 PERFORM FAIL. SQ1244.2 +093100 SEQ-TEST-08-03-END. SQ1244.2 +093200* SQ1244.2 +093300* CHECK THE RECORD NUMBER OF THE RECORD JUST READ. SQ1244.2 +093400* SQ1244.2 +093500 ADD 1 TO REC-CT. SQ1244.2 +093600 IF DELETE-SW NOT = SPACE SQ1244.2 +093700 GO TO SEQ-DELETE-08-04. SQ1244.2 +093800 GO TO SEQ-TEST-RD-08-04. SQ1244.2 +093900 SEQ-DELETE-08-04. SQ1244.2 +094000 PERFORM DE-LETE. SQ1244.2 +094100 GO TO SEQ-TEST-08-04-END. SQ1244.2 +094200 SEQ-TEST-RD-08-04. SQ1244.2 +094300 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ1244.2 +094400 PERFORM PASS SQ1244.2 +094500 ELSE SQ1244.2 +094600 MOVE FRECORD-NUMBER TO COMPUTED-A SQ1244.2 +094700 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1244.2 +094800 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ1244.2 +094900 PERFORM FAIL. SQ1244.2 +095000 SEQ-TEST-08-04-END. SQ1244.2 +095100 MOVE SPACE TO DELETE-SW-3. SQ1244.2 +095200* SQ1244.2 +095300* SQ1244.2 +095400* WE NOW READ THE SECOND AND FINAL RECORD. SQ1244.2 +095500* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +095600* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +095700* SQ1244.2 +095800 SEQ-INIT-09. SQ1244.2 +095900 MOVE 0 TO REC-CT. SQ1244.2 +096000 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +096100 MOVE "NOT EXECUTED" TO AT-END-SW. SQ1244.2 +096200 MOVE "NOT EXECUTED" TO NOT-END-SW. SQ1244.2 +096300 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +096400 MOVE "READ SECOND RECORD" TO FEATURE. SQ1244.2 +096500 MOVE "SEQ-TEST-RD-09" TO PAR-NAME. SQ1244.2 +096600 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +096700 GO TO SEQ-DELETE-09. SQ1244.2 +096800 GO TO SEQ-TEST-RD-09. SQ1244.2 +096900 SEQ-DELETE-09. SQ1244.2 +097000 MOVE "*" TO DELETE-SW-3. SQ1244.2 +097100 GO TO SEQ-DELETE-09-01. SQ1244.2 +097200 SEQ-TEST-RD-09. SQ1244.2 +097300 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1244.2 +097400 READ SQ-FS4 SQ1244.2 +097500 END SQ1244.2 +097600 MOVE "EXECUTED" TO AT-END-SW SQ1244.2 +097700 NOT AT END SQ1244.2 +097800 MOVE "EXECUTED" TO NOT-END-SW. SQ1244.2 +097900* SQ1244.2 +098000* CHECK I-O STATUS RETURNED FROM READ SQ1244.2 +098100* SQ1244.2 +098200 ADD 1 TO REC-CT. SQ1244.2 +098300 IF DELETE-SW NOT = SPACE SQ1244.2 +098400 GO TO SEQ-DELETE-09-01. SQ1244.2 +098500 GO TO SEQ-TEST-RD-09-01. SQ1244.2 +098600 SEQ-DELETE-09-01. SQ1244.2 +098700 PERFORM DE-LETE. SQ1244.2 +098800 GO TO SEQ-TEST-09-01-END. SQ1244.2 +098900 SEQ-TEST-RD-09-01. SQ1244.2 +099000 IF SQ-FS4-STATUS = "00" SQ1244.2 +099100 PERFORM PASS SQ1244.2 +099200 ELSE SQ1244.2 +099300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +099400 MOVE "00" TO CORRECT-A SQ1244.2 +099500 MOVE "UNEXPECTED I-O STATUS FROM READ" TO RE-MARK SQ1244.2 +099600 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1244.2 +099700 PERFORM FAIL. SQ1244.2 +099800 SEQ-TEST-09-01-END. SQ1244.2 +099900* SQ1244.2 +100000* CHECK EXECUTION OF THE AT END PATH SQ1244.2 +100100* SQ1244.2 +100200 ADD 1 TO REC-CT. SQ1244.2 +100300 IF DELETE-SW NOT = SPACE SQ1244.2 +100400 GO TO SEQ-DELETE-09-02. SQ1244.2 +100500 GO TO SEQ-TEST-RD-09-02. SQ1244.2 +100600 SEQ-DELETE-09-02. SQ1244.2 +100700 PERFORM DE-LETE. SQ1244.2 +100800 GO TO SEQ-TEST-09-02-END. SQ1244.2 +100900 SEQ-TEST-RD-09-02. SQ1244.2 +101000 IF AT-END-SW = "NOT EXECUTED" SQ1244.2 +101100 PERFORM PASS SQ1244.2 +101200 ELSE SQ1244.2 +101300 MOVE AT-END-SW TO COMPUTED-A SQ1244.2 +101400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1244.2 +101500 MOVE "UNEXPECTED EXECUTION OF AT END PATH" TO RE-MARK SQ1244.2 +101600 MOVE "VII-46, 4.4.4(11)" TO ANSI-REFERENCE SQ1244.2 +101700 PERFORM FAIL. SQ1244.2 +101800 SEQ-TEST-09-02-END. SQ1244.2 +101900* SQ1244.2 +102000* CHECK EXECUTION OF THE NOT AT END PATH SQ1244.2 +102100* SQ1244.2 +102200 ADD 1 TO REC-CT. SQ1244.2 +102300 IF DELETE-SW NOT = SPACE SQ1244.2 +102400 GO TO SEQ-DELETE-09-03. SQ1244.2 +102500 GO TO SEQ-TEST-RD-09-03. SQ1244.2 +102600 SEQ-DELETE-09-03. SQ1244.2 +102700 PERFORM DE-LETE. SQ1244.2 +102800 GO TO SEQ-TEST-09-03-END. SQ1244.2 +102900 SEQ-TEST-RD-09-03. SQ1244.2 +103000 IF NOT-END-SW = "EXECUTED" SQ1244.2 +103100 PERFORM PASS SQ1244.2 +103200 ELSE SQ1244.2 +103300 MOVE NOT-END-SW TO COMPUTED-A SQ1244.2 +103400 MOVE "EXECUTED" TO CORRECT-A SQ1244.2 +103500 MOVE "UNEXPECTED NON-EXECUTION OF AT END PATH" SQ1244.2 +103600 TO RE-MARK SQ1244.2 +103700 MOVE "VII-46, 4.4.4(11)" TO ANSI-REFERENCE SQ1244.2 +103800 PERFORM FAIL. SQ1244.2 +103900 SEQ-TEST-09-03-END. SQ1244.2 +104000* SQ1244.2 +104100* CHECK THE RECORD NUMBER OF THE RECORD JUST READ. SQ1244.2 +104200* SQ1244.2 +104300 ADD 1 TO REC-CT. SQ1244.2 +104400 IF DELETE-SW NOT = SPACE SQ1244.2 +104500 GO TO SEQ-DELETE-09-04. SQ1244.2 +104600 GO TO SEQ-TEST-RD-09-04. SQ1244.2 +104700 SEQ-DELETE-09-04. SQ1244.2 +104800 PERFORM DE-LETE. SQ1244.2 +104900 GO TO SEQ-TEST-09-04-END. SQ1244.2 +105000 SEQ-TEST-RD-09-04. SQ1244.2 +105100 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ1244.2 +105200 PERFORM PASS SQ1244.2 +105300 ELSE SQ1244.2 +105400 MOVE FRECORD-NUMBER TO COMPUTED-A SQ1244.2 +105500 MOVE XRECORD-NUMBER (1) TO CORRECT-A SQ1244.2 +105600 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ1244.2 +105700 PERFORM FAIL. SQ1244.2 +105800 SEQ-TEST-09-04-END. SQ1244.2 +105900 MOVE SPACE TO DELETE-SW-3. SQ1244.2 +106000* SQ1244.2 +106100* SQ1244.2 +106200* WE NOW ATTEMPT ANOTHER READ, WHICH SHOULD RAISE AT END. SQ1244.2 +106300* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS SQ1244.2 +106400* BUT DOES NOT AFFECT SUBSEQUENT OPERATIONS. SQ1244.2 +106500* SQ1244.2 +106600 SEQ-INIT-10. SQ1244.2 +106700 MOVE 0 TO REC-CT. SQ1244.2 +106800 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +106900 MOVE "NOT EXECUTED" TO AT-END-SW. SQ1244.2 +107000 MOVE "NOT EXECUTED" TO NOT-END-SW. SQ1244.2 +107100 ADD 1 TO XRECORD-NUMBER (1). SQ1244.2 +107200 MOVE "READ TO GIVE AT END" TO FEATURE. SQ1244.2 +107300 MOVE "SEQ-TEST-RD-10" TO PAR-NAME. SQ1244.2 +107400 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +107500 GO TO SEQ-DELETE-10. SQ1244.2 +107600 GO TO SEQ-TEST-RD-10. SQ1244.2 +107700 SEQ-DELETE-10. SQ1244.2 +107800 MOVE "*" TO DELETE-SW-3. SQ1244.2 +107900 GO TO SEQ-DELETE-10-01. SQ1244.2 +108000 SEQ-TEST-RD-10. SQ1244.2 +108100 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1244.2 +108200 READ SQ-FS4 SQ1244.2 +108300 END SQ1244.2 +108400 MOVE "EXECUTED" TO AT-END-SW SQ1244.2 +108500 NOT AT END SQ1244.2 +108600 MOVE "EXECUTED" TO NOT-END-SW. SQ1244.2 +108700* SQ1244.2 +108800* CHECK I-O STATUS RETURNED FROM READ SQ1244.2 +108900* SQ1244.2 +109000 ADD 1 TO REC-CT. SQ1244.2 +109100 IF DELETE-SW NOT = SPACE SQ1244.2 +109200 GO TO SEQ-DELETE-10-01. SQ1244.2 +109300 GO TO SEQ-TEST-RD-10-01. SQ1244.2 +109400 SEQ-DELETE-10-01. SQ1244.2 +109500 PERFORM DE-LETE. SQ1244.2 +109600 GO TO SEQ-TEST-10-01-END. SQ1244.2 +109700 SEQ-TEST-RD-10-01. SQ1244.2 +109800 IF SQ-FS4-STATUS = "10" SQ1244.2 +109900 PERFORM PASS SQ1244.2 +110000 ELSE SQ1244.2 +110100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +110200 MOVE "10" TO CORRECT-A SQ1244.2 +110300 MOVE "UNEXPECTED I-O STATUS AFTER LAST RECORD" SQ1244.2 +110400 TO RE-MARK SQ1244.2 +110500 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1244.2 +110600 PERFORM FAIL. SQ1244.2 +110700 SEQ-TEST-10-01-END. SQ1244.2 +110800* SQ1244.2 +110900* CHECK EXECUTION OF THE AT END PATH SQ1244.2 +111000* SQ1244.2 +111100 ADD 1 TO REC-CT. SQ1244.2 +111200 IF DELETE-SW NOT = SPACE SQ1244.2 +111300 GO TO SEQ-DELETE-10-02. SQ1244.2 +111400 GO TO SEQ-TEST-RD-10-02. SQ1244.2 +111500 SEQ-DELETE-10-02. SQ1244.2 +111600 PERFORM DE-LETE. SQ1244.2 +111700 GO TO SEQ-TEST-10-02-END. SQ1244.2 +111800 SEQ-TEST-RD-10-02. SQ1244.2 +111900 IF AT-END-SW = "EXECUTED" SQ1244.2 +112000 PERFORM PASS SQ1244.2 +112100 ELSE SQ1244.2 +112200 MOVE AT-END-SW TO COMPUTED-A SQ1244.2 +112300 MOVE "EXECUTED" TO CORRECT-A SQ1244.2 +112400 MOVE "UNEXPECTED NON-EXECUTION OF AT END PATH" SQ1244.2 +112500 TO RE-MARK SQ1244.2 +112600 MOVE "VII-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1244.2 +112700 PERFORM FAIL. SQ1244.2 +112800 SEQ-TEST-10-02-END. SQ1244.2 +112900* SQ1244.2 +113000* CHECK EXECUTION OF THE NOT AT END PATH SQ1244.2 +113100* SQ1244.2 +113200 ADD 1 TO REC-CT. SQ1244.2 +113300 IF DELETE-SW NOT = SPACE SQ1244.2 +113400 GO TO SEQ-DELETE-10-03. SQ1244.2 +113500 GO TO SEQ-TEST-RD-10-03. SQ1244.2 +113600 SEQ-DELETE-10-03. SQ1244.2 +113700 PERFORM DE-LETE. SQ1244.2 +113800 GO TO SEQ-TEST-10-03-END. SQ1244.2 +113900 SEQ-TEST-RD-10-03. SQ1244.2 +114000 IF NOT-END-SW = "NOT EXECUTED" SQ1244.2 +114100 PERFORM PASS SQ1244.2 +114200 ELSE SQ1244.2 +114300 MOVE NOT-END-SW TO COMPUTED-A SQ1244.2 +114400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1244.2 +114500 MOVE "UNEXPECTED EXECUTION OF AT END PATH" TO RE-MARK SQ1244.2 +114600 MOVE "VII-46, 4.4.4(10)" TO ANSI-REFERENCE SQ1244.2 +114700 PERFORM FAIL. SQ1244.2 +114800 SEQ-TEST-10-03-END. SQ1244.2 +114900 MOVE SPACE TO DELETE-SW-3. SQ1244.2 +115000* SQ1244.2 +115100* SQ1244.2 +115200* NOW EXECUTE A NORMAL CLOSE ON THE FILE. SQ1244.2 +115300* DELETION OF THE OPERATION DELETES ITS SUBORDINATE TESTS. SQ1244.2 +115400* SQ1244.2 +115500 SEQ-INIT-11. SQ1244.2 +115600 MOVE 0 TO REC-CT. SQ1244.2 +115700 MOVE "**" TO SQ-FS4-STATUS. SQ1244.2 +115800 MOVE "CLOSE AFTER READING" TO FEATURE. SQ1244.2 +115900 MOVE "SEQ-TEST-CL-11" TO PAR-NAME. SQ1244.2 +116000 IF DELETE-SW NOT EQUAL TO SPACE SQ1244.2 +116100 GO TO SEQ-DELETE-11. SQ1244.2 +116200 GO TO SEQ-TEST-CL-11. SQ1244.2 +116300 SEQ-DELETE-11. SQ1244.2 +116400 MOVE "*" TO DELETE-SW-3. SQ1244.2 +116500 GO TO SEQ-DELETE-11-01. SQ1244.2 +116600 SEQ-TEST-CL-11. SQ1244.2 +116700 CLOSE SQ-FS4. SQ1244.2 +116800* SQ1244.2 +116900* CHECK I-O STATUS RETURNED FROM CLOSE SQ1244.2 +117000* SQ1244.2 +117100 ADD 1 TO REC-CT. SQ1244.2 +117200 IF DELETE-SW NOT = SPACE SQ1244.2 +117300 GO TO SEQ-DELETE-11-01. SQ1244.2 +117400 GO TO SEQ-TEST-CL-11-01. SQ1244.2 +117500 SEQ-DELETE-11-01. SQ1244.2 +117600 PERFORM DE-LETE. SQ1244.2 +117700 GO TO SEQ-TEST-11-01-END. SQ1244.2 +117800 SEQ-TEST-CL-11-01. SQ1244.2 +117900 IF SQ-FS4-STATUS = "00" SQ1244.2 +118000 PERFORM PASS SQ1244.2 +118100 ELSE SQ1244.2 +118200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1244.2 +118300 MOVE "00" TO CORRECT-A SQ1244.2 +118400 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1244.2 +118500 TO RE-MARK SQ1244.2 +118600 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1244.2 +118700 PERFORM FAIL. SQ1244.2 +118800 SEQ-TEST-11-01-END. SQ1244.2 +118900* SQ1244.2 +119000 CCVS-EXIT SECTION. SQ1244.2 +119100 CCVS-999999. SQ1244.2 +119200 GO TO CLOSE-FILES. SQ1244.2 diff --git a/tests/cobol85/SQ/SQ125A.CBL b/tests/cobol85/SQ/SQ125A.CBL new file mode 100755 index 00000000..291750d0 --- /dev/null +++ b/tests/cobol85/SQ/SQ125A.CBL @@ -0,0 +1,600 @@ +000100 IDENTIFICATION DIVISION. SQ1254.2 +000200 PROGRAM-ID. SQ1254.2 +000300 SQ125A. SQ1254.2 +000400**************************************************************** SQ1254.2 +000500* * SQ1254.2 +000600* VALIDATION FOR:- * SQ1254.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1254.2 +000800* USING CCVS85 VERSION 3.0 * SQ1254.2 +000900* REVISED 1986, AUGUST * SQ1254.2 +001000* * SQ1254.2 +001100* CREATION DATE / VALIDATION DATE * SQ1254.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1254.2 +001300* * SQ1254.2 +001400**************************************************************** SQ1254.2 +001500* * SQ1254.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1254.2 +001700* * SQ1254.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1254.2 +001900* X-55 SYSTEM PRINTER * SQ1254.2 +002000* X-82 SOURCE-COMPUTER * SQ1254.2 +002100* X-83 OBJECT-COMPUTER * SQ1254.2 +002200* X-84 LABEL RECORDS OPTION * SQ1254.2 +002300* * SQ1254.2 +002400* * SQ1254.2 +002500**************************************************************** SQ1254.2 +002600* * SQ1254.2 +002700* SQ125A ATTEMPTS TO OPEN FOR OUTPUT A MAGNETIC TAPE FILE * SQ1254.2 +002800* WHICH IS ALREADY OPEN IN THE OUTPUT MODE. THIS SHOULD * SQ1254.2 +002900* RESULT IN A RECOGNITION OF A LOGIC ERROR CONDITION AND AN * SQ1254.2 +003000* I-O STATUS OF "41". THE PROGRAM CONTAINS AN APPLICABLE * SQ1254.2 +003100* DECLARATIVE PROCEDURE, WHICH SHOULD BE IMPLEMENTED. * SQ1254.2 +003200* * SQ1254.2 +003300**************************************************************** SQ1254.2 +003400* SQ1254.2 +003500 ENVIRONMENT DIVISION. SQ1254.2 +003600 CONFIGURATION SECTION. SQ1254.2 +003700 SOURCE-COMPUTER. SQ1254.2 +003800 Linux. SQ1254.2 +003900 OBJECT-COMPUTER. SQ1254.2 +004000 Linux. SQ1254.2 +004100* SQ1254.2 +004200 INPUT-OUTPUT SECTION. SQ1254.2 +004300 FILE-CONTROL. SQ1254.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1254.2 +004500 "report.log". SQ1254.2 +004600* SQ1254.2 +004700 SELECT SQ-FS1 ASSIGN TO SQ1254.2 +004800 "XXXXX001" SQ1254.2 +004900 FILE STATUS IS SQ-FS1-STATUS. SQ1254.2 +005000* SQ1254.2 +005100* SQ1254.2 +005200 DATA DIVISION. SQ1254.2 +005300 FILE SECTION. SQ1254.2 +005400 FD PRINT-FILE SQ1254.2 +005500*C LABEL RECORDS SQ1254.2 +005600*C OMITTED SQ1254.2 +005700*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1254.2 +005800 . SQ1254.2 +005900 01 PRINT-REC PICTURE X(120). SQ1254.2 +006000 01 DUMMY-RECORD PICTURE X(120). SQ1254.2 +006100* SQ1254.2 +006200 FD SQ-FS1 SQ1254.2 +006300*C LABEL RECORD IS STANDARD SQ1254.2 +006400 . SQ1254.2 +006500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1254.2 +006600* SQ1254.2 +006700 WORKING-STORAGE SECTION. SQ1254.2 +006800* SQ1254.2 +006900*************************************************************** SQ1254.2 +007000* * SQ1254.2 +007100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1254.2 +007200* * SQ1254.2 +007300*************************************************************** SQ1254.2 +007400* SQ1254.2 +007500 01 SQ-FS1-STATUS. SQ1254.2 +007600 03 SQ-FS1-KEY-1 PIC X. SQ1254.2 +007700 03 SQ-FS1-KEY-2 PIC X. SQ1254.2 +007800* SQ1254.2 +007900*************************************************************** SQ1254.2 +008000* * SQ1254.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1254.2 +008200* * SQ1254.2 +008300*************************************************************** SQ1254.2 +008400* SQ1254.2 +008500 01 REC-SKEL-SUB PIC 99. SQ1254.2 +008600* SQ1254.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1254.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1254.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1254.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1254.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1254.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1254.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1254.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1254.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1254.2 +009600 ",RECKEY= ". SQ1254.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1254.2 +009800 ",ALTKEY1= ". SQ1254.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1254.2 +010000 ",ALTKEY2= ". SQ1254.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1254.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1254.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1254.2 +010400 07 FILLER PIC X(5). SQ1254.2 +010500 07 XFILE-NAME PIC X(6). SQ1254.2 +010600 07 FILLER PIC X(8). SQ1254.2 +010700 07 XRECORD-NAME PIC X(6). SQ1254.2 +010800 07 FILLER PIC X(1). SQ1254.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1254.2 +011000 07 FILLER PIC X(7). SQ1254.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1254.2 +011200 07 FILLER PIC X(6). SQ1254.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1254.2 +011400 07 FILLER PIC X(5). SQ1254.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1254.2 +011600 07 FILLER PIC X(5). SQ1254.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1254.2 +011800 07 FILLER PIC X(7). SQ1254.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1254.2 +012000 07 FILLER PIC X(7). SQ1254.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1254.2 +012200 07 FILLER PIC X(1). SQ1254.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1254.2 +012400 07 FILLER PIC X(6). SQ1254.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1254.2 +012600 07 FILLER PIC X(5). SQ1254.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1254.2 +012800 07 FILLER PIC X(6). SQ1254.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1254.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1254.2 +013100 07 FILLER PIC X(8). SQ1254.2 +013200 07 XRECORD-KEY PIC X(29). SQ1254.2 +013300 07 FILLER PIC X(9). SQ1254.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1254.2 +013500 07 FILLER PIC X(9). SQ1254.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1254.2 +013700 07 FILLER PIC X(7). SQ1254.2 +013800* SQ1254.2 +013900 01 TEST-RESULTS. SQ1254.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1254.2 +014100 02 PAR-NAME. SQ1254.2 +014200 03 FILLER PIC X(14) VALUE SPACE. SQ1254.2 +014300 03 PARDOT-X PIC X VALUE SPACE. SQ1254.2 +014400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1254.2 +014500 02 FILLER PIC X VALUE SPACE. SQ1254.2 +014600 02 FEATURE PIC X(24) VALUE SPACE. SQ1254.2 +014700 02 FILLER PIC X VALUE SPACE. SQ1254.2 +014800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1254.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ1254.2 +015000 02 RE-MARK PIC X(61). SQ1254.2 +015100 01 TEST-COMPUTED. SQ1254.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1254.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1254.2 +015400 02 COMPUTED-X. SQ1254.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1254.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1254.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1254.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1254.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1254.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1254.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ1254.2 +016200 04 FILLER PIC X. SQ1254.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1254.2 +016400 01 TEST-CORRECT. SQ1254.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1254.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1254.2 +016700 02 CORRECT-X. SQ1254.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1254.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1254.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1254.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1254.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1254.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1254.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ1254.2 +017500 04 FILLER PIC X. SQ1254.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ1254.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1254.2 +017800* SQ1254.2 +017900 01 CCVS-C-1. SQ1254.2 +018000 02 FILLER PIC IS X VALUE SPACE. SQ1254.2 +018100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1254.2 +018200 02 FILLER PIC IS X VALUE SPACE. SQ1254.2 +018300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1254.2 +018400 02 FILLER PIC IS X VALUE SPACE. SQ1254.2 +018500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1254.2 +018600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1254.2 +018700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1254.2 +018800 01 CCVS-C-2. SQ1254.2 +018900 02 FILLER PIC X(19) VALUE SPACE. SQ1254.2 +019000 02 FILLER PIC X(6) VALUE "TESTED". SQ1254.2 +019100 02 FILLER PIC X(19) VALUE SPACE. SQ1254.2 +019200 02 FILLER PIC X(4) VALUE "FAIL". SQ1254.2 +019300 02 FILLER PIC X(72) VALUE SPACE. SQ1254.2 +019400* SQ1254.2 +019500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1254.2 +019600 01 REC-CT PIC 99 VALUE ZERO. SQ1254.2 +019700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1254.2 +019800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1254.2 +019900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1254.2 +020000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1254.2 +020100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1254.2 +020200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1254.2 +020300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1254.2 +020400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1254.2 +020500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1254.2 +020600 01 CCVS-H-1. SQ1254.2 +020700 02 FILLER PIC X(39) VALUE SPACES. SQ1254.2 +020800 02 FILLER PIC X(42) VALUE SQ1254.2 +020900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1254.2 +021000 02 FILLER PIC X(39) VALUE SPACES. SQ1254.2 +021100 01 CCVS-H-2A. SQ1254.2 +021200 02 FILLER PIC X(40) VALUE SPACE. SQ1254.2 +021300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1254.2 +021400 02 FILLER PIC XXXX VALUE SQ1254.2 +021500 "4.2 ". SQ1254.2 +021600 02 FILLER PIC X(28) VALUE SQ1254.2 +021700 " COPY - NOT FOR DISTRIBUTION". SQ1254.2 +021800 02 FILLER PIC X(41) VALUE SPACE. SQ1254.2 +021900* SQ1254.2 +022000 01 CCVS-H-2B. SQ1254.2 +022100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1254.2 +022200 02 TEST-ID PIC X(9). SQ1254.2 +022300 02 FILLER PIC X(4) VALUE " IN ". SQ1254.2 +022400 02 FILLER PIC X(12) VALUE SQ1254.2 +022500 " HIGH ". SQ1254.2 +022600 02 FILLER PIC X(22) VALUE SQ1254.2 +022700 " LEVEL VALIDATION FOR ". SQ1254.2 +022800 02 FILLER PIC X(58) VALUE SQ1254.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1254.2 +023000 01 CCVS-H-3. SQ1254.2 +023100 02 FILLER PIC X(34) VALUE SQ1254.2 +023200 " FOR OFFICIAL USE ONLY ". SQ1254.2 +023300 02 FILLER PIC X(58) VALUE SQ1254.2 +023400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1254.2 +023500 02 FILLER PIC X(28) VALUE SQ1254.2 +023600 " COPYRIGHT 1985,1986 ". SQ1254.2 +023700 01 CCVS-E-1. SQ1254.2 +023800 02 FILLER PIC X(52) VALUE SPACE. SQ1254.2 +023900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1254.2 +024000 02 ID-AGAIN PIC X(9). SQ1254.2 +024100 02 FILLER PIC X(45) VALUE SPACES. SQ1254.2 +024200 01 CCVS-E-2. SQ1254.2 +024300 02 FILLER PIC X(31) VALUE SPACE. SQ1254.2 +024400 02 FILLER PIC X(21) VALUE SPACE. SQ1254.2 +024500 02 CCVS-E-2-2. SQ1254.2 +024600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1254.2 +024700 03 FILLER PIC X VALUE SPACE. SQ1254.2 +024800 03 ENDER-DESC PIC X(44) VALUE SQ1254.2 +024900 "ERRORS ENCOUNTERED". SQ1254.2 +025000 01 CCVS-E-3. SQ1254.2 +025100 02 FILLER PIC X(22) VALUE SQ1254.2 +025200 " FOR OFFICIAL USE ONLY". SQ1254.2 +025300 02 FILLER PIC X(12) VALUE SPACE. SQ1254.2 +025400 02 FILLER PIC X(58) VALUE SQ1254.2 +025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1254.2 +025600 02 FILLER PIC X(8) VALUE SPACE. SQ1254.2 +025700 02 FILLER PIC X(20) VALUE SQ1254.2 +025800 " COPYRIGHT 1985,1986". SQ1254.2 +025900 01 CCVS-E-4. SQ1254.2 +026000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1254.2 +026100 02 FILLER PIC X(4) VALUE " OF ". SQ1254.2 +026200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1254.2 +026300 02 FILLER PIC X(40) VALUE SQ1254.2 +026400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1254.2 +026500 01 XXINFO. SQ1254.2 +026600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1254.2 +026700 02 INFO-TEXT. SQ1254.2 +026800 04 FILLER PIC X(8) VALUE SPACE. SQ1254.2 +026900 04 XXCOMPUTED PIC X(20). SQ1254.2 +027000 04 FILLER PIC X(5) VALUE SPACE. SQ1254.2 +027100 04 XXCORRECT PIC X(20). SQ1254.2 +027200 02 INF-ANSI-REFERENCE PIC X(48). SQ1254.2 +027300 01 HYPHEN-LINE. SQ1254.2 +027400 02 FILLER PIC IS X VALUE IS SPACE. SQ1254.2 +027500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1254.2 +027600- "*****************************************". SQ1254.2 +027700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1254.2 +027800- "******************************". SQ1254.2 +027900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1254.2 +028000 "SQ125A". SQ1254.2 +028100* SQ1254.2 +028200* SQ1254.2 +028300 PROCEDURE DIVISION. SQ1254.2 +028400 DECLARATIVES. SQ1254.2 +028500 SQ125A-DECLARATIVE-001-SECT SECTION. SQ1254.2 +028600 USE AFTER STANDARD EXCEPTION PROCEDURE SQ-FS1. SQ1254.2 +028700 INPUT-ERROR-PROCEDURE. SQ1254.2 +028800 IF SQ-FS1-STATUS = "41" SQ1254.2 +028900 PERFORM DECL-PASS SQ1254.2 +029000 GO TO ABNORMAL-TERM-DECL SQ1254.2 +029100 ELSE SQ1254.2 +029200 MOVE "41" TO CORRECT-A SQ1254.2 +029300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1254.2 +029400 MOVE "INCORRECT I-O STATUS FOR SECOND OPEN" SQ1254.2 +029500 TO RE-MARK SQ1254.2 +029600 PERFORM DECL-FAIL SQ1254.2 +029700 GO TO ABNORMAL-TERM-DECL SQ1254.2 +029800 END-IF. SQ1254.2 +029900* SQ1254.2 +030000* SQ1254.2 +030100 DECL-PASS. SQ1254.2 +030200 MOVE "PASS " TO P-OR-F. SQ1254.2 +030300 ADD 1 TO PASS-COUNTER. SQ1254.2 +030400 PERFORM DECL-PRINT-DETAIL. SQ1254.2 +030500* SQ1254.2 +030600 DECL-FAIL. SQ1254.2 +030700 MOVE "FAIL*" TO P-OR-F. SQ1254.2 +030800 ADD 1 TO ERROR-COUNTER. SQ1254.2 +030900 PERFORM DECL-PRINT-DETAIL. SQ1254.2 +031000* SQ1254.2 +031100 DECL-PRINT-DETAIL. SQ1254.2 +031200 IF REC-CT NOT EQUAL TO ZERO SQ1254.2 +031300 MOVE "." TO PARDOT-X SQ1254.2 +031400 MOVE REC-CT TO DOTVALUE. SQ1254.2 +031500 MOVE TEST-RESULTS TO PRINT-REC. SQ1254.2 +031600 PERFORM DECL-WRITE-LINE. SQ1254.2 +031700 IF P-OR-F EQUAL TO "FAIL*" SQ1254.2 +031800 PERFORM DECL-WRITE-LINE SQ1254.2 +031900 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1254.2 +032000 ELSE SQ1254.2 +032100 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1254.2 +032200 MOVE SPACE TO P-OR-F. SQ1254.2 +032300 MOVE SPACE TO COMPUTED-X. SQ1254.2 +032400 MOVE SPACE TO CORRECT-X. SQ1254.2 +032500 IF REC-CT EQUAL TO ZERO SQ1254.2 +032600 MOVE SPACE TO PAR-NAME. SQ1254.2 +032700 MOVE SPACE TO RE-MARK. SQ1254.2 +032800* SQ1254.2 +032900 DECL-WRITE-LINE. SQ1254.2 +033000 ADD 1 TO RECORD-COUNT. SQ1254.2 +033100 IF RECORD-COUNT GREATER 50 SQ1254.2 +033200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1254.2 +033300 MOVE SPACE TO DUMMY-RECORD SQ1254.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1254.2 +033500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1254.2 +033600 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1254.2 +033700 PERFORM DECL-WRT-LN 2 TIMES SQ1254.2 +033800 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1254.2 +033900 PERFORM DECL-WRT-LN SQ1254.2 +034000 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1254.2 +034100 MOVE ZERO TO RECORD-COUNT. SQ1254.2 +034200 PERFORM DECL-WRT-LN. SQ1254.2 +034300* SQ1254.2 +034400 DECL-WRT-LN. SQ1254.2 +034500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1254.2 +034600 MOVE SPACE TO DUMMY-RECORD. SQ1254.2 +034700* SQ1254.2 +034800 DECL-FAIL-ROUTINE. SQ1254.2 +034900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1254.2 +035000 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1254.2 +035100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1254.2 +035200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1254.2 +035300 MOVE XXINFO TO DUMMY-RECORD. SQ1254.2 +035400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1254.2 +035500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1254.2 +035600 GO TO DECL-FAIL-EX. SQ1254.2 +035700 DECL-FAIL-WRITE. SQ1254.2 +035800 MOVE TEST-COMPUTED TO PRINT-REC SQ1254.2 +035900 PERFORM DECL-WRITE-LINE SQ1254.2 +036000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1254.2 +036100 MOVE TEST-CORRECT TO PRINT-REC SQ1254.2 +036200 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1254.2 +036300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1254.2 +036400 DECL-FAIL-EX. SQ1254.2 +036500 EXIT. SQ1254.2 +036600* SQ1254.2 +036700 DECL-BAIL. SQ1254.2 +036800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1254.2 +036900 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1254.2 +037000 DECL-BAIL-WRITE. SQ1254.2 +037100 MOVE CORRECT-A TO XXCORRECT. SQ1254.2 +037200 MOVE COMPUTED-A TO XXCOMPUTED. SQ1254.2 +037300 MOVE XXINFO TO DUMMY-RECORD. SQ1254.2 +037400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1254.2 +037500 DECL-BAIL-EX. SQ1254.2 +037600 EXIT. SQ1254.2 +037700* SQ1254.2 +037800 ABNORMAL-TERM-DECL. SQ1254.2 +037900 MOVE SPACE TO DUMMY-RECORD. SQ1254.2 +038000 PERFORM DECL-WRITE-LINE. SQ1254.2 +038100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1254.2 +038200 TO DUMMY-RECORD. SQ1254.2 +038300 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1254.2 +038400* SQ1254.2 +038500* SQ1254.2 +038600 END-DECLS. SQ1254.2 +038700 END DECLARATIVES. SQ1254.2 +038800* SQ1254.2 +038900* SQ1254.2 +039000 CCVS1 SECTION. SQ1254.2 +039100 OPEN-FILES. SQ1254.2 +039200 OPEN OUTPUT PRINT-FILE. SQ1254.2 +039300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1254.2 +039400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1254.2 +039500 MOVE SPACE TO TEST-RESULTS. SQ1254.2 +039600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1254.2 +039700 MOVE ZERO TO REC-SKEL-SUB. SQ1254.2 +039800 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1254.2 +039900 GO TO CCVS1-EXIT. SQ1254.2 +040000* SQ1254.2 +040100 CCVS-INIT-FILE. SQ1254.2 +040200 ADD 1 TO REC-SKL-SUB. SQ1254.2 +040300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1254.2 +040400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1254.2 +040500* SQ1254.2 +040600 CLOSE-FILES. SQ1254.2 +040700 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1254.2 +040800 CLOSE PRINT-FILE. SQ1254.2 +040900 TERMINATE-CCVS. SQ1254.2 +041000 STOP RUN. SQ1254.2 +041100* SQ1254.2 +041200 INSPT. SQ1254.2 +041300 MOVE "INSPT" TO P-OR-F. SQ1254.2 +041400 ADD 1 TO INSPECT-COUNTER. SQ1254.2 +041500 PERFORM PRINT-DETAIL. SQ1254.2 +041600 SQ1254.2 +041700 PASS. SQ1254.2 +041800 MOVE "PASS " TO P-OR-F. SQ1254.2 +041900 ADD 1 TO PASS-COUNTER. SQ1254.2 +042000 PERFORM PRINT-DETAIL. SQ1254.2 +042100* SQ1254.2 +042200 FAIL. SQ1254.2 +042300 MOVE "FAIL*" TO P-OR-F. SQ1254.2 +042400 ADD 1 TO ERROR-COUNTER. SQ1254.2 +042500 PERFORM PRINT-DETAIL. SQ1254.2 +042600* SQ1254.2 +042700 DE-LETE. SQ1254.2 +042800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1254.2 +042900 MOVE "*****" TO P-OR-F. SQ1254.2 +043000 ADD 1 TO DELETE-COUNTER. SQ1254.2 +043100 PERFORM PRINT-DETAIL. SQ1254.2 +043200* SQ1254.2 +043300 PRINT-DETAIL. SQ1254.2 +043400 IF REC-CT NOT EQUAL TO ZERO SQ1254.2 +043500 MOVE "." TO PARDOT-X SQ1254.2 +043600 MOVE REC-CT TO DOTVALUE. SQ1254.2 +043700 MOVE TEST-RESULTS TO PRINT-REC. SQ1254.2 +043800 PERFORM WRITE-LINE. SQ1254.2 +043900 IF P-OR-F EQUAL TO "FAIL*" SQ1254.2 +044000 PERFORM WRITE-LINE SQ1254.2 +044100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1254.2 +044200 ELSE SQ1254.2 +044300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1254.2 +044400 MOVE SPACE TO P-OR-F. SQ1254.2 +044500 MOVE SPACE TO COMPUTED-X. SQ1254.2 +044600 MOVE SPACE TO CORRECT-X. SQ1254.2 +044700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1254.2 +044800 MOVE SPACE TO RE-MARK. SQ1254.2 +044900* SQ1254.2 +045000 HEAD-ROUTINE. SQ1254.2 +045100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +045200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +045300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1254.2 +045400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1254.2 +045500 COLUMN-NAMES-ROUTINE. SQ1254.2 +045600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1254.2 +045700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +045800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1254.2 +045900 END-ROUTINE. SQ1254.2 +046000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1254.2 +046100 PERFORM WRITE-LINE 5 TIMES. SQ1254.2 +046200 END-RTN-EXIT. SQ1254.2 +046300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1254.2 +046400 PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +046500* SQ1254.2 +046600 END-ROUTINE-1. SQ1254.2 +046700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1254.2 +046800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1254.2 +046900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1254.2 +047000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1254.2 +047100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1254.2 +047200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1254.2 +047300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1254.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1254.2 +047500 PERFORM WRITE-LINE. SQ1254.2 +047600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1254.2 +047700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1254.2 +047800 MOVE "NO " TO ERROR-TOTAL SQ1254.2 +047900 ELSE SQ1254.2 +048000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1254.2 +048100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1254.2 +048200 PERFORM WRITE-LINE. SQ1254.2 +048300 END-ROUTINE-13. SQ1254.2 +048400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1254.2 +048500 MOVE "NO " TO ERROR-TOTAL SQ1254.2 +048600 ELSE SQ1254.2 +048700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1254.2 +048800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1254.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1254.2 +049000 PERFORM WRITE-LINE. SQ1254.2 +049100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1254.2 +049200 MOVE "NO " TO ERROR-TOTAL SQ1254.2 +049300 ELSE SQ1254.2 +049400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1254.2 +049500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1254.2 +049600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1254.2 +049700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1254.2 +049800* SQ1254.2 +049900 WRITE-LINE. SQ1254.2 +050000 ADD 1 TO RECORD-COUNT. SQ1254.2 +050100 IF RECORD-COUNT GREATER 50 SQ1254.2 +050200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1254.2 +050300 MOVE SPACE TO DUMMY-RECORD SQ1254.2 +050400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1254.2 +050500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1254.2 +050600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1254.2 +050700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1254.2 +050800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1254.2 +050900 MOVE ZERO TO RECORD-COUNT. SQ1254.2 +051000 PERFORM WRT-LN. SQ1254.2 +051100* SQ1254.2 +051200 WRT-LN. SQ1254.2 +051300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1254.2 +051400 MOVE SPACE TO DUMMY-RECORD. SQ1254.2 +051500 BLANK-LINE-PRINT. SQ1254.2 +051600 PERFORM WRT-LN. SQ1254.2 +051700 FAIL-ROUTINE. SQ1254.2 +051800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1254.2 +051900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1254.2 +052000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1254.2 +052100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1254.2 +052200 MOVE XXINFO TO DUMMY-RECORD. SQ1254.2 +052300 PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +052400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1254.2 +052500 GO TO FAIL-ROUTINE-EX. SQ1254.2 +052600 FAIL-ROUTINE-WRITE. SQ1254.2 +052700 MOVE TEST-COMPUTED TO PRINT-REC SQ1254.2 +052800 PERFORM WRITE-LINE SQ1254.2 +052900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1254.2 +053000 MOVE TEST-CORRECT TO PRINT-REC SQ1254.2 +053100 PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +053200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1254.2 +053300 FAIL-ROUTINE-EX. SQ1254.2 +053400 EXIT. SQ1254.2 +053500 BAIL-OUT. SQ1254.2 +053600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1254.2 +053700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1254.2 +053800 BAIL-OUT-WRITE. SQ1254.2 +053900 MOVE CORRECT-A TO XXCORRECT. SQ1254.2 +054000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1254.2 +054100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1254.2 +054200 MOVE XXINFO TO DUMMY-RECORD. SQ1254.2 +054300 PERFORM WRITE-LINE 2 TIMES. SQ1254.2 +054400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1254.2 +054500 BAIL-OUT-EX. SQ1254.2 +054600 EXIT. SQ1254.2 +054700 CCVS1-EXIT. SQ1254.2 +054800 EXIT. SQ1254.2 +054900* SQ1254.2 +055000**************************************************************** SQ1254.2 +055100* * SQ1254.2 +055200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1254.2 +055300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1254.2 +055400* * SQ1254.2 +055500**************************************************************** SQ1254.2 +055600* SQ1254.2 +055700 SECT-SQ125A-MAIN SECTION. SQ1254.2 +055800* SQ1254.2 +055900* THE FIRST ACTION IS TO CREATE THE FILE BY MEANS OF AN SQ1254.2 +056000* OPEN OUTPUT STATEMENT. SQ1254.2 +056100* SQ1254.2 +056200 SEQ-INIT-01. SQ1254.2 +056300* SQ1254.2 +056400 MOVE 1 TO REC-CT SQ1254.2 +056500 MOVE "CREATE FILE, OPEN OUTPUT" TO FEATURE SQ1254.2 +056600 MOVE "SEQ-TEST-OP-01" TO PAR-NAME SQ1254.2 +056700 MOVE "**" TO SQ-FS1-STATUS. SQ1254.2 +056800 SEQ-TEST-OP-01. SQ1254.2 +056900 OPEN OUTPUT SQ-FS1. SQ1254.2 +057000 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1254.2 +057100 MOVE 1 TO REC-CT. SQ1254.2 +057200 SEQ-TEST-OP-01-01. SQ1254.2 +057300* SQ1254.2 +057400* CHECK THE I-O STATUS VALUE RETURNED BY THE FIRST OPEN. SQ1254.2 +057500* SQ1254.2 +057600 IF SQ-FS1-STATUS = "00" SQ1254.2 +057700 PERFORM PASS SQ1254.2 +057800 ELSE SQ1254.2 +057900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1254.2 +058000 MOVE "00" TO CORRECT-A SQ1254.2 +058100 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN OUTPUT" SQ1254.2 +058200 TO RE-MARK SQ1254.2 +058300 MOVE "VII-3, 1.5.3(1)A" TO ANSI-REFERENCE SQ1254.2 +058400 PERFORM FAIL. SQ1254.2 +058500 SEQ-TEST-01-01-END. SQ1254.2 +058600* SQ1254.2 +058700* SQ1254.2 +058800* HAVING OPENED THE FILE, THE NEXT ACTION IS TO ATTEMPT SQ1254.2 +058900* TO OPEN IT FOR OUTPUT AGAIN. SQ1254.2 +059000* SQ1254.2 +059100 SEQ-INIT-02. SQ1254.2 +059200 MOVE 1 TO REC-CT SQ1254.2 +059300 MOVE "OPEN OUTPUT ON OPEN FILE" TO FEATURE SQ1254.2 +059400 MOVE "SEQ-TEST-OP-02" TO PAR-NAME SQ1254.2 +059500 MOVE "**" TO SQ-FS1-STATUS. SQ1254.2 +059600 SEQ-TEST-OP-02. SQ1254.2 +059700 OPEN OUTPUT SQ-FS1. SQ1254.2 +059800 CCVS-EXIT SECTION. SQ1254.2 +059900 CCVS-999999. SQ1254.2 +060000 GO TO CLOSE-FILES. SQ1254.2 diff --git a/tests/cobol85/SQ/SQ126A.CBL b/tests/cobol85/SQ/SQ126A.CBL new file mode 100755 index 00000000..451c3133 --- /dev/null +++ b/tests/cobol85/SQ/SQ126A.CBL @@ -0,0 +1,735 @@ +000100 IDENTIFICATION DIVISION. SQ1264.2 +000200 PROGRAM-ID. SQ1264.2 +000300 SQ126A. SQ1264.2 +000400**************************************************************** SQ1264.2 +000500* * SQ1264.2 +000600* VALIDATION FOR:- * SQ1264.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1264.2 +000800* * SQ1264.2 +000900* CREATION DATE / VALIDATION DATE * SQ1264.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1264.2 +001100* * SQ1264.2 +001200**************************************************************** SQ1264.2 +001300 SQ1264.2 +001400* SQ1264.2 +001500* SQ1264.2 +001600******************************************************************SQ1264.2 +001700* *SQ1264.2 +001800* NEW TESTS: *SQ1264.2 +001900* *SQ1264.2 +002000* READ ... AT END ... NOT AT END ... *SQ1264.2 +002100* *SQ1264.2 +002200* READ ... RECORD AT END ... NOT END *SQ1264.2 +002300* *SQ1264.2 +002400* IF ... READ ... AT END ... NOT AT END ... END-READ *SQ1264.2 +002500* *SQ1264.2 +002600* IF ... READ ... RECORD END ... NOT END ... END-READ ... *SQ1264.2 +002700* *SQ1264.2 +002800******************************************************************SQ1264.2 +002900* SQ1264.2 +003000* THE ROUTINE SQ126A TESTS THE USE OF THE NOT AT END SQ1264.2 +003100* PHRASE FOR THE READ STATEMENT AND ALSO THE END-READ PHRASE. SQ1264.2 +003200* SQ1264.2 +003300* SQ1264.2 +003400* USED X-CARDS: SQ1264.2 +003500* XXXXX001 SQ1264.2 +003600* XXXXX055 SQ1264.2 +003700* P XXXXX062 SQ1264.2 +003800* XXXXX082 SQ1264.2 +003900* XXXXX083 SQ1264.2 +004000* C XXXXX084 SQ1264.2 +004100* SQ1264.2 +004200* SQ1264.2 +004300 ENVIRONMENT DIVISION. SQ1264.2 +004400 CONFIGURATION SECTION. SQ1264.2 +004500 SOURCE-COMPUTER. SQ1264.2 +004600 Linux. SQ1264.2 +004700 OBJECT-COMPUTER. SQ1264.2 +004800 Linux. SQ1264.2 +004900 INPUT-OUTPUT SECTION. SQ1264.2 +005000 FILE-CONTROL. SQ1264.2 +005100*P SELECT RAW-DATA ASSIGN TO SQ1264.2 +005200*P "XXXXX062" SQ1264.2 +005300*P ORGANIZATION IS INDEXED SQ1264.2 +005400*P ACCESS MODE IS RANDOM SQ1264.2 +005500*P RECORD KEY IS RAW-DATA-KEY. SQ1264.2 +005600 SELECT PRINT-FILE ASSIGN TO SQ1264.2 +005700 "report.log". SQ1264.2 +005800 SELECT SQ-FS1 ASSIGN TO SQ1264.2 +005900 "XXXXX001" SQ1264.2 +006000 ORGANIZATION IS SEQUENTIAL SQ1264.2 +006100 ACCESS MODE IS SEQUENTIAL. SQ1264.2 +006200 SQ1264.2 +006300 DATA DIVISION. SQ1264.2 +006400 SQ1264.2 +006500 FILE SECTION. SQ1264.2 +006600*P SQ1264.2 +006700*PD RAW-DATA. SQ1264.2 +006800*P SQ1264.2 +006900*P1 RAW-DATA-SATZ. SQ1264.2 +007000*P 05 RAW-DATA-KEY PIC X(6). SQ1264.2 +007100*P 05 C-DATE PIC 9(6). SQ1264.2 +007200*P 05 C-TIME PIC 9(8). SQ1264.2 +007300*P 05 C-NO-OF-TESTS PIC 99. SQ1264.2 +007400*P 05 C-OK PIC 999. SQ1264.2 +007500*P 05 C-ALL PIC 999. SQ1264.2 +007600*P 05 C-FAIL PIC 999. SQ1264.2 +007700*P 05 C-DELETED PIC 999. SQ1264.2 +007800*P 05 C-INSPECT PIC 999. SQ1264.2 +007900*P 05 C-NOTE PIC X(13). SQ1264.2 +008000*P 05 C-INDENT PIC X. SQ1264.2 +008100*P 05 C-ABORT PIC X(8). SQ1264.2 +008200 SQ1264.2 +008300 FD PRINT-FILE SQ1264.2 +008400*C LABEL RECORDS SQ1264.2 +008500*C OMITTED SQ1264.2 +008600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1264.2 +008700 . SQ1264.2 +008800 SQ1264.2 +008900 01 PRINT-REC PIC X(120). SQ1264.2 +009000 SQ1264.2 +009100 01 DUMMY-RECORD PIC X(120). SQ1264.2 +009200 SQ1264.2 +009300 FD SQ-FS1 SQ1264.2 +009400*C LABEL RECORD STANDARD SQ1264.2 +009500 . SQ1264.2 +009600 SQ1264.2 +009700 01 SQ-FS1R1-F-G-120. SQ1264.2 +009800 05 FILLER PIC X(120). SQ1264.2 +009900 SQ1264.2 +010000 WORKING-STORAGE SECTION. SQ1264.2 +010100 SQ1264.2 +010200 01 SWITCH-READ1 PIC 9 VALUE ZERO. SQ1264.2 +010300 01 SWITCH-READ2 PIC 9 VALUE ZERO. SQ1264.2 +010400 01 SWITCH-READ3 PIC 9 VALUE ZERO. SQ1264.2 +010500 01 FILE-STATUS-SQ-FS1 PIC XX VALUE SPACE. SQ1264.2 +010600 01 WRK-CS-09V00 PIC S9(9) COMP VALUE ZERO. SQ1264.2 +010700 01 RECORDS-IN-ERROR PIC S9(5) COMP VALUE ZERO. SQ1264.2 +010800 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ1264.2 +010900 01 EOF-FLAG PIC 9 VALUE ZERO. SQ1264.2 +011000 SQ1264.2 +011100 01 FILE-RECORD-INFORMATION-REC. SQ1264.2 +011200 05 FILE-RECORD-INFO-SKELETON. SQ1264.2 +011300 10 FILLER PIC X(48) VALUE SQ1264.2 +011400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1264.2 +011500 10 FILLER PIC X(46) VALUE SQ1264.2 +011600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1264.2 +011700 10 FILLER PIC X(26) VALUE SQ1264.2 +011800 ",LFIL=000000,ORG= ,LBLR= ". SQ1264.2 +011900 10 FILLER PIC X(37) VALUE SQ1264.2 +012000 ",RECKEY= ". SQ1264.2 +012100 10 FILLER PIC X(38) VALUE SQ1264.2 +012200 ",ALTKEY1= ". SQ1264.2 +012300 10 FILLER PIC X(38) VALUE SQ1264.2 +012400 ",ALTKEY2= ". SQ1264.2 +012500 10 FILLER PIC X(7) VALUE SPACE. SQ1264.2 +012600 05 FILE-RECORD-INFO OCCURS 10. SQ1264.2 +012700 10 FILE-RECORD-INFO-P1-120. SQ1264.2 +012800 15 FILLER PIC X(5). SQ1264.2 +012900 15 XFILE-NAME PIC X(6). SQ1264.2 +013000 15 FILLER PIC X(8). SQ1264.2 +013100 15 XRECORD-NAME PIC X(6). SQ1264.2 +013200 15 FILLER PIC X(1). SQ1264.2 +013300 15 REELUNIT-NUMBER PIC 9(1). SQ1264.2 +013400 15 FILLER PIC X(7). SQ1264.2 +013500 15 XRECORD-NUMBER PIC 9(6). SQ1264.2 +013600 15 FILLER PIC X(6). SQ1264.2 +013700 15 UPDATE-NUMBER PIC 9(2). SQ1264.2 +013800 15 FILLER PIC X(5). SQ1264.2 +013900 15 ODO-NUMBER PIC 9(4). SQ1264.2 +014000 15 FILLER PIC X(5). SQ1264.2 +014100 15 XPROGRAM-NAME PIC X(5). SQ1264.2 +014200 15 FILLER PIC X(7). SQ1264.2 +014300 15 XRECORD-LENGTH PIC 9(6). SQ1264.2 +014400 15 FILLER PIC X(7). SQ1264.2 +014500 15 CHARS-OR-RECORDS PIC X(2). SQ1264.2 +014600 15 FILLER PIC X(1). SQ1264.2 +014700 15 XBLOCK-SIZE PIC 9(4). SQ1264.2 +014800 15 FILLER PIC X(6). SQ1264.2 +014900 15 RECORDS-IN-FILE PIC 9(6). SQ1264.2 +015000 15 FILLER PIC X(5). SQ1264.2 +015100 15 XFILE-ORGANIZATION PIC X(2). SQ1264.2 +015200 15 FILLER PIC X(6). SQ1264.2 +015300 15 XLABEL-TYPE PIC X(1). SQ1264.2 +015400 10 FILE-RECORD-INFO-P121-240. SQ1264.2 +015500 15 FILLER PIC X(8). SQ1264.2 +015600 15 XRECORD-KEY PIC X(29). SQ1264.2 +015700 15 FILLER PIC X(9). SQ1264.2 +015800 15 ALTERNATE-KEY1 PIC X(29). SQ1264.2 +015900 15 FILLER PIC X(9). SQ1264.2 +016000 15 ALTERNATE-KEY2 PIC X(29). SQ1264.2 +016100 15 FILLER PIC X(7). SQ1264.2 +016200 SQ1264.2 +016300 01 TEST-RESULTS. SQ1264.2 +016400 05 FILLER PIC X VALUE SPACE. SQ1264.2 +016500 05 FEATURE PIC X(20) VALUE SPACE. SQ1264.2 +016600 05 FILLER PIC X VALUE SPACE. SQ1264.2 +016700 05 P-OR-F PIC X(5) VALUE SPACE. SQ1264.2 +016800 05 FILLER PIC X VALUE SPACE. SQ1264.2 +016900 05 PAR-NAME. SQ1264.2 +017000 10 FILLER PIC X(12) VALUE SPACE. SQ1264.2 +017100 10 PARDOT-X PIC X VALUE SPACE. SQ1264.2 +017200 10 DOTVALUE PIC 99 VALUE ZERO. SQ1264.2 +017300 10 FILLER PIC X(5) VALUE SPACE. SQ1264.2 +017400 05 FILLER PIC X(10) VALUE SPACE. SQ1264.2 +017500 05 RE-MARK PIC X(61). SQ1264.2 +017600 SQ1264.2 +017700 01 TEST-COMPUTED. SQ1264.2 +017800 05 FILLER PIC X(30) VALUE SPACE. SQ1264.2 +017900 05 FILLER PIC X(17) VALUE " COMPUTED=". SQ1264.2 +018000 05 COMPUTED-X. SQ1264.2 +018100 10 COMPUTED-A PIC X(20) VALUE SPACE. SQ1264.2 +018200 10 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1264.2 +018300 10 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1264.2 +018400 10 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1264.2 +018500 10 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1264.2 +018600 10 CM-18V0 REDEFINES COMPUTED-A. SQ1264.2 +018700 15 COMPUTED-18V0 PIC -9(18). SQ1264.2 +018800 15 FILLER PIC X. SQ1264.2 +018900 10 FILLER PIC X(50) SQ1264.2 +019000 VALUE SPACE. SQ1264.2 +019100 SQ1264.2 +019200 01 TEST-CORRECT. SQ1264.2 +019300 05 FILLER PIC X(30) VALUE SPACE. SQ1264.2 +019400 05 FILLER PIC X(17) VALUE " CORRECT =". SQ1264.2 +019500 05 CORRECT-X. SQ1264.2 +019600 10 CORRECT-A PIC X(20) VALUE SPACE. SQ1264.2 +019700 10 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1264.2 +019800 10 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1264.2 +019900 10 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1264.2 +020000 10 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1264.2 +020100 10 CR-18V0 REDEFINES CORRECT-A. SQ1264.2 +020200 15 CORRECT-18V0 PIC -9(18). SQ1264.2 +020300 15 FILLER PIC X. SQ1264.2 +020400 10 FILLER PIC X(50) SQ1264.2 +020500 VALUE SPACE. SQ1264.2 +020600 SQ1264.2 +020700 01 CCVS-C-1. SQ1264.2 +020800 05 FILLER PIC X(99) VALUE SQ1264.2 +020900 " FEATURE PASS PARAGRAPH-NAME SQ1264.2 +021000- " REMARKS". SQ1264.2 +021100 05 FILLER PIC X(20) VALUE SPACE. SQ1264.2 +021200 SQ1264.2 +021300 01 CCVS-C-2. SQ1264.2 +021400 05 FILLER PIC X VALUE SPACE. SQ1264.2 +021500 05 FILLER PIC X(6) VALUE "TESTED". SQ1264.2 +021600 05 FILLER PIC X(15) VALUE SPACE. SQ1264.2 +021700 05 FILLER PIC X(4) VALUE "FAIL". SQ1264.2 +021800 05 FILLER PIC X(94) VALUE SPACE. SQ1264.2 +021900 SQ1264.2 +022000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1264.2 +022100 01 REC-CT PIC 99 VALUE ZERO. SQ1264.2 +022200 01 DELETE-CNT PIC 999 VALUE ZERO. SQ1264.2 +022300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1264.2 +022400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1264.2 +022500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1264.2 +022600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1264.2 +022700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1264.2 +022800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1264.2 +022900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1264.2 +023000 SQ1264.2 +023100 01 CCVS-H-1. SQ1264.2 +023200 05 FILLER PIC X(27) VALUE SPACE. SQ1264.2 +023300 05 FILLER PIC X(67) VALUE SQ1264.2 +023400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1264.2 +023500- " SYSTEM". SQ1264.2 +023600 05 FILLER PIC X(26) VALUE SPACE. SQ1264.2 +023700 SQ1264.2 +023800 01 CCVS-H-2. SQ1264.2 +023900 05 FILLER PIC X(52) VALUE SQ1264.2 +024000 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1264.2 +024100 05 FILLER PIC X(19) VALUE SQ1264.2 +024200 "TEST RESULTS SET- ". SQ1264.2 +024300 05 TEST-ID PIC X(9). SQ1264.2 +024400 05 FILLER PIC X(40) VALUE SPACE. SQ1264.2 +024500 SQ1264.2 +024600 01 CCVS-H-3. SQ1264.2 +024700 05 FILLER PIC X(34) VALUE SQ1264.2 +024800 " FOR OFFICIAL USE ONLY ". SQ1264.2 +024900 05 FILLER PIC X(58) VALUE SQ1264.2 +025000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1264.2 +025100 SQ1264.2 +025200 05 FILLER PIC X(28) VALUE SQ1264.2 +025300 " COPYRIGHT 1985 ". SQ1264.2 +025400 SQ1264.2 +025500 01 CCVS-E-1. SQ1264.2 +025600 05 FILLER PIC X(52) VALUE SPACE. SQ1264.2 +025700 05 FILLER PIC X(14) VALUE "END OF TEST- ". SQ1264.2 +025800 05 ID-AGAIN PIC X(9). SQ1264.2 +025900 05 FILLER PIC X(45) VALUE SQ1264.2 +026000 " NTIS DISTRIBUTION COBOL 85". SQ1264.2 +026100 SQ1264.2 +026200 01 CCVS-E-2. SQ1264.2 +026300 05 FILLER PIC X(31) VALUE SPACE. SQ1264.2 +026400 05 FILLER PIC X(21) VALUE SPACE. SQ1264.2 +026500 05 CCVS-E-2-2. SQ1264.2 +026600 10 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1264.2 +026700 10 FILLER PIC X VALUE SPACE. SQ1264.2 +026800 10 ENDER-DESC PIC X(44) VALUE SQ1264.2 +026900 "ERRORS ENCOUNTERED". SQ1264.2 +027000 SQ1264.2 +027100 01 CCVS-E-3. SQ1264.2 +027200 05 FILLER PIC X(22) VALUE SQ1264.2 +027300 " FOR OFFICIAL USE ONLY". SQ1264.2 +027400 05 FILLER PIC X(12) VALUE SPACE. SQ1264.2 +027500 05 FILLER PIC X(58) VALUE SQ1264.2 +027600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1264.2 +027700 SQ1264.2 +027800 05 FILLER PIC X(13) VALUE SPACE. SQ1264.2 +027900 05 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1264.2 +028000 SQ1264.2 +028100 01 CCVS-E-4. SQ1264.2 +028200 05 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1264.2 +028300 05 FILLER PIC X(4) VALUE " OF ". SQ1264.2 +028400 05 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1264.2 +028500 05 FILLER PIC X(40) VALUE SQ1264.2 +028600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1264.2 +028700 SQ1264.2 +028800 01 XXINFO. SQ1264.2 +028900 05 FILLER PIC X(30) VALUE SQ1264.2 +029000 " *** INFORMATION ***". SQ1264.2 +029100 05 INFO-TEXT. SQ1264.2 +029200 10 FILLER PIC X(20) VALUE SPACE. SQ1264.2 +029300 10 XXCOMPUTED PIC X(20). SQ1264.2 +029400 10 FILLER PIC X(5) VALUE SPACE. SQ1264.2 +029500 10 XXCORRECT PIC X(20). SQ1264.2 +029600 SQ1264.2 +029700 01 HYPHEN-LINE. SQ1264.2 +029800 05 FILLER PIC X VALUE SPACE. SQ1264.2 +029900 05 FILLER PIC X(65) VALUE SQ1264.2 +030000 "************************************************************SQ1264.2 +030100- "*****". SQ1264.2 +030200 05 FILLER PIC X(54) VALUE SQ1264.2 +030300 "******************************************************". SQ1264.2 +030400 SQ1264.2 +030500 01 CCVS-PGM-ID PIC X(6) VALUE "SQ126A". SQ1264.2 +030600 SQ1264.2 +030700 PROCEDURE DIVISION. SQ1264.2 +030800 SQ1264.2 +030900 CCVS1 SECTION. SQ1264.2 +031000 OPEN-FILES. SQ1264.2 +031100*P OPEN I-O RAW-DATA. SQ1264.2 +031200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1264.2 +031300*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1264.2 +031400*P MOVE "ABORTED " TO C-ABORT. SQ1264.2 +031500*P ADD 1 TO C-NO-OF-TESTS. SQ1264.2 +031600*P ACCEPT C-DATE FROM DATE. SQ1264.2 +031700*P ACCEPT C-TIME FROM TIME. SQ1264.2 +031800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1264.2 +031900*PND-E-1. SQ1264.2 +032000*P CLOSE RAW-DATA. SQ1264.2 +032100 OPEN SQ1264.2 +032200 OUTPUT PRINT-FILE. SQ1264.2 +032300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1264.2 +032400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1264.2 +032500 MOVE SPACE TO TEST-RESULTS. SQ1264.2 +032600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1264.2 +032700 MOVE ZERO TO REC-SKL-SUB. SQ1264.2 +032800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1264.2 +032900 CCVS-INIT-FILE. SQ1264.2 +033000 ADD 1 TO REC-SKL-SUB. SQ1264.2 +033100 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO SQ1264.2 +033200 (REC-SKL-SUB). SQ1264.2 +033300 CCVS-INIT-EXIT. SQ1264.2 +033400 GO TO CCVS1-EXIT. SQ1264.2 +033500 CLOSE-FILES. SQ1264.2 +033600 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1264.2 +033700 CLOSE PRINT-FILE. SQ1264.2 +033800*P OPEN I-O RAW-DATA. SQ1264.2 +033900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1264.2 +034000*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1264.2 +034100*P MOVE "OK. " TO C-ABORT. SQ1264.2 +034200*P MOVE PASS-COUNTER TO C-OK. SQ1264.2 +034300*P MOVE ERROR-HOLD TO C-ALL. SQ1264.2 +034400*P MOVE ERROR-COUNTER TO C-FAIL. SQ1264.2 +034500*P MOVE DELETE-CNT TO C-DELETED. SQ1264.2 +034600*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1264.2 +034700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1264.2 +034800*PND-E-2. SQ1264.2 +034900*P CLOSE RAW-DATA. SQ1264.2 +035000 TERMINATE-CCVS. SQ1264.2 +035100*S EXIT PROGRAM. SQ1264.2 +035200*SERMINATE-CALL. SQ1264.2 +035300 STOP RUN. SQ1264.2 +035400 INSPT. SQ1264.2 +035500 MOVE "INSPT" TO P-OR-F. SQ1264.2 +035600 ADD 1 TO INSPECT-COUNTER. SQ1264.2 +035700 PASS. SQ1264.2 +035800 MOVE "PASS " TO P-OR-F. SQ1264.2 +035900 ADD 1 TO PASS-COUNTER. SQ1264.2 +036000 FAIL. SQ1264.2 +036100 MOVE "FAIL*" TO P-OR-F. SQ1264.2 +036200 ADD 1 TO ERROR-COUNTER. SQ1264.2 +036300 DE-LETE. SQ1264.2 +036400 MOVE "*****" TO P-OR-F. SQ1264.2 +036500 ADD 1 TO DELETE-CNT. SQ1264.2 +036600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1264.2 +036700 PRINT-DETAIL. SQ1264.2 +036800 IF REC-CT NOT EQUAL TO ZERO SQ1264.2 +036900 MOVE "." TO PARDOT-X SQ1264.2 +037000 MOVE REC-CT TO DOTVALUE. SQ1264.2 +037100 MOVE TEST-RESULTS TO PRINT-REC. SQ1264.2 +037200 PERFORM WRITE-LINE. SQ1264.2 +037300 IF P-OR-F EQUAL TO "FAIL*" SQ1264.2 +037400 PERFORM WRITE-LINE SQ1264.2 +037500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1264.2 +037600 ELSE SQ1264.2 +037700 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1264.2 +037800 MOVE SPACE TO P-OR-F. SQ1264.2 +037900 MOVE SPACE TO COMPUTED-X. SQ1264.2 +038000 MOVE SPACE TO CORRECT-X. SQ1264.2 +038100 IF REC-CT EQUAL TO ZERO SQ1264.2 +038200 MOVE SPACE TO PAR-NAME. SQ1264.2 +038300 MOVE SPACE TO RE-MARK. SQ1264.2 +038400 HEAD-ROUTINE. SQ1264.2 +038500 MOVE CCVS-H-1 TO DUMMY-RECORD. SQ1264.2 +038600 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +038700 MOVE CCVS-H-2 TO DUMMY-RECORD. SQ1264.2 +038800 PERFORM WRITE-LINE 5 TIMES. SQ1264.2 +038900 MOVE CCVS-H-3 TO DUMMY-RECORD. SQ1264.2 +039000 PERFORM WRITE-LINE 3 TIMES. SQ1264.2 +039100 COLUMN-NAMES-ROUTINE. SQ1264.2 +039200 MOVE CCVS-C-1 TO DUMMY-RECORD. SQ1264.2 +039300 PERFORM WRITE-LINE. SQ1264.2 +039400 MOVE CCVS-C-2 TO DUMMY-RECORD. SQ1264.2 +039500 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1264.2 +039700 PERFORM WRITE-LINE. SQ1264.2 +039800 END-ROUTINE. SQ1264.2 +039900 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1264.2 +040000 PERFORM WRITE-LINE 5 TIMES. SQ1264.2 +040100 END-RTN-EXIT. SQ1264.2 +040200 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1264.2 +040300 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +040400 END-ROUTINE-1. SQ1264.2 +040500 ADD ERROR-COUNTER TO ERROR-HOLD SQ1264.2 +040600 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1264.2 +040700 ADD DELETE-CNT TO ERROR-HOLD. SQ1264.2 +040800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1264.2 +040900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1264.2 +041000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1264.2 +041100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1264.2 +041200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1264.2 +041300 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1264.2 +041400 PERFORM WRITE-LINE. SQ1264.2 +041500 END-ROUTINE-12. SQ1264.2 +041600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1264.2 +041700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1264.2 +041800 MOVE "NO " TO ERROR-TOTAL SQ1264.2 +041900 ELSE SQ1264.2 +042000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1264.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1264.2 +042200 PERFORM WRITE-LINE. SQ1264.2 +042300 END-ROUTINE-13. SQ1264.2 +042400 IF DELETE-CNT IS EQUAL TO ZERO SQ1264.2 +042500 MOVE "NO " TO ERROR-TOTAL SQ1264.2 +042600 ELSE SQ1264.2 +042700 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1264.2 +042800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1264.2 +042900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1264.2 +043000 PERFORM WRITE-LINE. SQ1264.2 +043100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1264.2 +043200 MOVE "NO " TO ERROR-TOTAL SQ1264.2 +043300 ELSE SQ1264.2 +043400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1264.2 +043500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1264.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1264.2 +043700 PERFORM WRITE-LINE. SQ1264.2 +043800 MOVE CCVS-E-3 TO DUMMY-RECORD. SQ1264.2 +043900 PERFORM WRITE-LINE. SQ1264.2 +044000 WRITE-LINE. SQ1264.2 +044100 ADD 1 TO RECORD-COUNT. SQ1264.2 +044200 IF RECORD-COUNT GREATER 50 SQ1264.2 +044300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1264.2 +044400 MOVE SPACE TO DUMMY-RECORD SQ1264.2 +044500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1264.2 +044600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1264.2 +044700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1264.2 +044800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1264.2 +044900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1264.2 +045000 MOVE ZERO TO RECORD-COUNT. SQ1264.2 +045100 PERFORM WRT-LN. SQ1264.2 +045200 WRT-LN. SQ1264.2 +045300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1264.2 +045400 MOVE SPACE TO DUMMY-RECORD. SQ1264.2 +045500 BLANK-LINE-PRINT. SQ1264.2 +045600 PERFORM WRT-LN. SQ1264.2 +045700 FAIL-ROUTINE. SQ1264.2 +045800 IF COMPUTED-X NOT EQUAL TO SPACE SQ1264.2 +045900 GO TO FAIL-ROUTINE-WRITE. SQ1264.2 +046000 IF CORRECT-X NOT EQUAL TO SPACE SQ1264.2 +046100 GO TO FAIL-ROUTINE-WRITE. SQ1264.2 +046200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1264.2 +046300 MOVE XXINFO TO DUMMY-RECORD. SQ1264.2 +046400 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +046500 GO TO FAIL-ROUTINE-EX. SQ1264.2 +046600 FAIL-ROUTINE-WRITE. SQ1264.2 +046700 MOVE TEST-COMPUTED TO PRINT-REC SQ1264.2 +046800 PERFORM WRITE-LINE SQ1264.2 +046900 MOVE TEST-CORRECT TO PRINT-REC SQ1264.2 +047000 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +047100 FAIL-ROUTINE-EX. SQ1264.2 +047200 EXIT. SQ1264.2 +047300 BAIL-OUT. SQ1264.2 +047400 IF COMPUTED-A NOT EQUAL TO SPACE SQ1264.2 +047500 GO TO BAIL-OUT-WRITE. SQ1264.2 +047600 IF CORRECT-A EQUAL TO SPACE SQ1264.2 +047700 GO TO BAIL-OUT-EX. SQ1264.2 +047800 BAIL-OUT-WRITE. SQ1264.2 +047900 MOVE CORRECT-A TO XXCORRECT. SQ1264.2 +048000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1264.2 +048100 MOVE XXINFO TO DUMMY-RECORD. SQ1264.2 +048200 PERFORM WRITE-LINE 2 TIMES. SQ1264.2 +048300 BAIL-OUT-EX. SQ1264.2 +048400 EXIT. SQ1264.2 +048500 CCVS1-EXIT. SQ1264.2 +048600 EXIT. SQ1264.2 +048700 SQ1264.2 +048800 SECT-SQ126-0001 SECTION. SQ1264.2 +048900 SEQ-INIT-001. SQ1264.2 +049000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1264.2 +049100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1264.2 +049200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1264.2 +049300 MOVE 000120 TO XRECORD-LENGTH (1). SQ1264.2 +049400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1264.2 +049500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1264.2 +049600 MOVE 000750 TO RECORDS-IN-FILE (1). SQ1264.2 +049700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1264.2 +049800 MOVE "S" TO XLABEL-TYPE (1). SQ1264.2 +049900 MOVE 000001 TO XRECORD-NUMBER (1). SQ1264.2 +050000 OPEN SQ1264.2 +050100 OUTPUT SQ-FS1. SQ1264.2 +050200 SEQ-TEST-001. SQ1264.2 +050300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1264.2 +050400 WRITE SQ-FS1R1-F-G-120. SQ1264.2 +050500 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ1264.2 +050600 GO TO SEQ-WRITE-001. SQ1264.2 +050700 ADD 1 TO XRECORD-NUMBER (1). SQ1264.2 +050800 GO TO SEQ-TEST-001. SQ1264.2 +050900 SEQ-WRITE-001. SQ1264.2 +051000 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ1264.2 +051100 MOVE "SEQ-TEST-001" TO PAR-NAME. SQ1264.2 +051200 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1264.2 +051300 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1264.2 +051400 PERFORM PRINT-DETAIL. SQ1264.2 +051500 CLOSE SQ-FS1. SQ1264.2 +051600* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ1264.2 +051700* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ1264.2 +051800 READ-INIT-GF-01. SQ1264.2 +051900 MOVE ZERO TO WRK-CS-09V00. SQ1264.2 +052000 MOVE ZERO TO SWITCH-READ1. SQ1264.2 +052100* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1264.2 +052200* READ-TEST-001 AND CHECKS THE NOT AT END CONDITION. SQ1264.2 +052300 OPEN SQ1264.2 +052400 INPUT SQ-FS1. SQ1264.2 +052500 READ-TEST-GF-01. SQ1264.2 +052600******************************************************************SQ1264.2 +052700* *SQ1264.2 +052800* READ ... AT END --- NOT AT END ... *SQ1264.2 +052900* *SQ1264.2 +053000******************************************************************SQ1264.2 +053100 READ SQ-FS1 AT END SQ1264.2 +053200 GO TO READ-TEST-GF-01-1 SQ1264.2 +053300 NOT AT END SQ1264.2 +053400 MOVE 1 TO SWITCH-READ1. SQ1264.2 +053500 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1264.2 +053600 ADD 1 TO WRK-CS-09V00. SQ1264.2 +053700 IF WRK-CS-09V00 GREATER THAN 750 SQ1264.2 +053800 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ1264.2 +053900 GO TO READ-FAIL-GF-01. SQ1264.2 +054000 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1264.2 +054100 ADD 1 TO RECORDS-IN-ERROR SQ1264.2 +054200 GO TO READ-TEST-GF-01. SQ1264.2 +054300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1264.2 +054400 ADD 1 TO RECORDS-IN-ERROR SQ1264.2 +054500 GO TO READ-TEST-GF-01. SQ1264.2 +054600 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1264.2 +054700 ADD 1 TO RECORDS-IN-ERROR. SQ1264.2 +054800 GO TO READ-TEST-GF-01. SQ1264.2 +054900 READ-TEST-GF-01-1. SQ1264.2 +055000 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1264.2 +055100 GO TO READ-PASS-GF-01. SQ1264.2 +055200 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ1264.2 +055300 READ-FAIL-GF-01. SQ1264.2 +055400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ1264.2 +055500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1264.2 +055600 PERFORM FAIL. SQ1264.2 +055700 GO TO READ-WRITE-GF-01. SQ1264.2 +055800 READ-PASS-GF-01. SQ1264.2 +055900 PERFORM PASS. SQ1264.2 +056000 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1264.2 +056100 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1264.2 +056200 READ-WRITE-GF-01. SQ1264.2 +056300 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1264.2 +056400 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1264.2 +056500 PERFORM PRINT-DETAIL. SQ1264.2 +056600 READ-TEST-GF-01-2. SQ1264.2 +056700 MOVE "READ...AT END...NOT AT END" TO RE-MARK. SQ1264.2 +056800 MOVE "NOT AT END" TO FEATURE. SQ1264.2 +056900 IF SWITCH-READ1 = 1 SQ1264.2 +057000 GO TO READ-PASS-GF-01-2. SQ1264.2 +057100 READ-FAIL-GF-01-2. SQ1264.2 +057200 MOVE "VII-44 4.4.2, VII-46 4.4.4 (11) C " TO RE-MARK. SQ1264.2 +057300 PERFORM FAIL. SQ1264.2 +057400 GO TO READ-WRITE-GF-01-2. SQ1264.2 +057500 READ-PASS-GF-01-2. SQ1264.2 +057600 PERFORM PASS. SQ1264.2 +057700 READ-WRITE-GF-01-2. SQ1264.2 +057800 MOVE "READ-TEST-GF-01-2" TO PAR-NAME. SQ1264.2 +057900 PERFORM PRINT-DETAIL. SQ1264.2 +058000 SEQ-CLOSE-GF-01. SQ1264.2 +058100 CLOSE SQ-FS1. SQ1264.2 +058200 READ-INIT-GF-02. SQ1264.2 +058300 MOVE ZERO TO SWITCH-READ1. SQ1264.2 +058400 MOVE ZERO TO WRK-CS-09V00. SQ1264.2 +058500 MOVE ZERO TO RECORDS-IN-ERROR. SQ1264.2 +058600 OPEN SQ1264.2 +058700 INPUT SQ-FS1. SQ1264.2 +058800 MOVE "NOT END " TO FEATURE. SQ1264.2 +058900 MOVE "READ...RECORD AT END ... NOT END " TO RE-MARK. SQ1264.2 +059000 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1264.2 +059100 MOVE ZERO TO ERROR-FLAG. SQ1264.2 +059200 READ-TEST-GF-02. SQ1264.2 +059300******************************************************************SQ1264.2 +059400* *SQ1264.2 +059500* READ ... RECORD AT END ... NOT END *SQ1264.2 +059600* *SQ1264.2 +059700******************************************************************SQ1264.2 +059800 READ SQ-FS1 RECORD AT END SQ1264.2 +059900 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1264.2 +060000 MOVE 1 TO EOF-FLAG SQ1264.2 +060100 GO TO READ-FAIL-GF-02 SQ1264.2 +060200 NOT END SQ1264.2 +060300 MOVE 1 TO SWITCH-READ1. SQ1264.2 +060400 PERFORM RECORD-CHECK. SQ1264.2 +060500 IF WRK-CS-09V00 EQUAL TO 200 SQ1264.2 +060600 GO TO READ-TEST-GF-02-1. SQ1264.2 +060700 GO TO READ-TEST-GF-02. SQ1264.2 +060800 RECORD-CHECK. SQ1264.2 +060900 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1264.2 +061000 ADD 1 TO WRK-CS-09V00. SQ1264.2 +061100 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1264.2 +061200 ADD 1 TO RECORDS-IN-ERROR SQ1264.2 +061300 MOVE 1 TO ERROR-FLAG. SQ1264.2 +061400 READ-TEST-GF-02-1. SQ1264.2 +061500 IF SWITCH-READ1 = 1 SQ1264.2 +061600 GO TO READ-PASS-GF-02. SQ1264.2 +061700 MOVE "NOT PASSED" TO COMPUTED-A. SQ1264.2 +061800 READ-FAIL-GF-02. SQ1264.2 +061900 MOVE "VII-44 4.4.2, VII-46 4.4.4 (11) C " TO RE-MARK. SQ1264.2 +062000 PERFORM FAIL. SQ1264.2 +062100 GO TO READ-WRITE-GF-02. SQ1264.2 +062200 READ-PASS-GF-02. SQ1264.2 +062300 PERFORM PASS. SQ1264.2 +062400 READ-WRITE-GF-02. SQ1264.2 +062500 PERFORM PRINT-DETAIL. SQ1264.2 +062600 PERFORM PRINT-DETAIL. SQ1264.2 +062700 READ-INIT-GF-03. SQ1264.2 +062800 MOVE ZERO TO ERROR-FLAG. SQ1264.2 +062900 MOVE ZERO TO SWITCH-READ1. SQ1264.2 +063000 MOVE 1 TO SWITCH-READ2. SQ1264.2 +063100 MOVE ZERO TO SWITCH-READ3. SQ1264.2 +063200 MOVE "IF...READ...AT END...NOT AT END..." TO RE-MARK. SQ1264.2 +063300 MOVE "READ-TEST-GF-03-1" TO PAR-NAME. SQ1264.2 +063400 MOVE "NOT AT END;END-READ" TO FEATURE. SQ1264.2 +063500 READ-TEST-GF-03. SQ1264.2 +063600******************************************************************SQ1264.2 +063700* *SQ1264.2 +063800* IF ... READ ... AT END ... NOT AT END ... END-READ *SQ1264.2 +063900* *SQ1264.2 +064000******************************************************************SQ1264.2 +064100 IF SWITCH-READ2 = 1 SQ1264.2 +064200 READ SQ-FS1 AT END SQ1264.2 +064300 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1264.2 +064400 MOVE 1 TO EOF-FLAG SQ1264.2 +064500 GO TO READ-FAIL-GF-03 SQ1264.2 +064600 NOT AT END SQ1264.2 +064700 MOVE 1 TO SWITCH-READ1 SQ1264.2 +064800 END-READ SQ1264.2 +064900 MOVE 1 TO SWITCH-READ3. SQ1264.2 +065000 PERFORM RECORD-CHECK. SQ1264.2 +065100 IF WRK-CS-09V00 EQUAL TO 400 SQ1264.2 +065200 GO TO READ-TEST-GF-03-1. SQ1264.2 +065300 GO TO READ-TEST-GF-03. SQ1264.2 +065400 READ-TEST-GF-03-1. SQ1264.2 +065500 IF SWITCH-READ1 = 1 SQ1264.2 +065600 GO TO READ-PASS-GF-03. SQ1264.2 +065700 READ-FAIL-GF-03. SQ1264.2 +065800 MOVE "VII-44 4.4.2, VII-46 4.4.4 (11) C " TO RE-MARK. SQ1264.2 +065900 PERFORM FAIL. SQ1264.2 +066000 GO TO READ-WRITE-GF-03. SQ1264.2 +066100 READ-PASS-GF-03. SQ1264.2 +066200 PERFORM PASS. SQ1264.2 +066300 READ-WRITE-GF-03. SQ1264.2 +066400 PERFORM PRINT-DETAIL. SQ1264.2 +066500 READ-TEST-GF-03-2. SQ1264.2 +066600 IF SWITCH-READ3 = 1 SQ1264.2 +066700 GO TO READ-PASS-GF-03-2. SQ1264.2 +066800 READ-FAIL-GF-03-2. SQ1264.2 +066900 MOVE "VII-47 4.4.4 (14) " TO RE-MARK. SQ1264.2 +067000 PERFORM FAIL. SQ1264.2 +067100 GO TO READ-WRITE-GF-03-2. SQ1264.2 +067200 READ-PASS-GF-03-2. SQ1264.2 +067300 PERFORM PASS. SQ1264.2 +067400 READ-WRITE-GF-03-2. SQ1264.2 +067500 MOVE "READ-TEST-GF-03-2" TO PAR-NAME. SQ1264.2 +067600 PERFORM PRINT-DETAIL. SQ1264.2 +067700 READ-INIT-GF-04. SQ1264.2 +067800 MOVE ZERO TO ERROR-FLAG. SQ1264.2 +067900 MOVE ZERO TO SWITCH-READ1. SQ1264.2 +068000 MOVE ZERO TO SWITCH-READ2. SQ1264.2 +068100 MOVE 1 TO SWITCH-READ3. SQ1264.2 +068200 MOVE "READ...RECORD END...NOT END;END-READ" TO RE-MARK. SQ1264.2 +068300 MOVE "READ-TEST-GF-04-1" TO PAR-NAME. SQ1264.2 +068400 READ-TEST-GF-04. SQ1264.2 +068500******************************************************************SQ1264.2 +068600* *SQ1264.2 +068700* IF ... READ ... RECORD END ... NOT END ... END-READ ... *SQ1264.2 +068800* *SQ1264.2 +068900******************************************************************SQ1264.2 +069000 IF SWITCH-READ3 = 1 SQ1264.2 +069100 READ SQ-FS1 RECORD END SQ1264.2 +069200 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1264.2 +069300 MOVE 1 TO EOF-FLAG SQ1264.2 +069400 GO TO READ-FAIL-GF-04-1 SQ1264.2 +069500 NOT END SQ1264.2 +069600 MOVE 1 TO SWITCH-READ1 SQ1264.2 +069700 END-READ SQ1264.2 +069800 MOVE 1 TO SWITCH-READ2. SQ1264.2 +069900 PERFORM RECORD-CHECK. SQ1264.2 +070000 IF WRK-CS-09V00 EQUAL TO 600 SQ1264.2 +070100 GO TO READ-TEST-GF-04-1. SQ1264.2 +070200 GO TO READ-TEST-GF-04. SQ1264.2 +070300 READ-TEST-GF-04-1. SQ1264.2 +070400 IF SWITCH-READ1 EQUAL TO 1 SQ1264.2 +070500 GO TO READ-PASS-GF-04-1. SQ1264.2 +070600 MOVE "NOT PASSED" TO COMPUTED-A. SQ1264.2 +070700 READ-FAIL-GF-04-1. SQ1264.2 +070800 MOVE "VII-44 4.4.2, VII-46 4.4.4 (11) C " TO RE-MARK. SQ1264.2 +070900 PERFORM FAIL. SQ1264.2 +071000 GO TO READ-WRITE-GF-04-1. SQ1264.2 +071100 READ-PASS-GF-04-1. SQ1264.2 +071200 PERFORM PASS. SQ1264.2 +071300 READ-WRITE-GF-04-1. SQ1264.2 +071400 PERFORM PRINT-DETAIL. SQ1264.2 +071500 READ-TEST-GF-04-2. SQ1264.2 +071600 IF SWITCH-READ2 EQUAL TO 1 SQ1264.2 +071700 GO TO READ-PASS-GF-04-2. SQ1264.2 +071800 MOVE "END-READ: NOT PASSED" TO COMPUTED-A. SQ1264.2 +071900 MOVE "READ-TEST-GF-04-2" TO PAR-NAME. SQ1264.2 +072000 READ-FAIL-GF-04-2. SQ1264.2 +072100 MOVE "VII-47 4.4.4 (14) " TO RE-MARK. SQ1264.2 +072200 PERFORM FAIL. SQ1264.2 +072300 GO TO READ-WRITE-GF-04-2. SQ1264.2 +072400 READ-PASS-GF-04-2. SQ1264.2 +072500 PERFORM PASS. SQ1264.2 +072600 READ-WRITE-GF-04-2. SQ1264.2 +072700 PERFORM PRINT-DETAIL. SQ1264.2 +072800 SEQ-CLOSE-003. SQ1264.2 +072900 CLOSE SQ-FS1. SQ1264.2 +073000 TERMINATE-ROUTINE. SQ1264.2 +073100 EXIT. SQ1264.2 +073200 SQ1264.2 +073300 CCVS-EXIT SECTION. SQ1264.2 +073400 CCVS-999999. SQ1264.2 +073500 GO TO CLOSE-FILES. SQ1264.2 diff --git a/tests/cobol85/SQ/SQ127A.CBL b/tests/cobol85/SQ/SQ127A.CBL new file mode 100755 index 00000000..1d5fccfa --- /dev/null +++ b/tests/cobol85/SQ/SQ127A.CBL @@ -0,0 +1,619 @@ +000100 IDENTIFICATION DIVISION. SQ1274.2 +000200 PROGRAM-ID. SQ1274.2 +000300 SQ127A. SQ1274.2 +000400**************************************************************** SQ1274.2 +000500* * SQ1274.2 +000600* VALIDATION FOR:- * SQ1274.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1274.2 +000800* * SQ1274.2 +000900* CREATION DATE / VALIDATION DATE * SQ1274.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1274.2 +001100* * SQ1274.2 +001200**************************************************************** SQ1274.2 +001300 SQ1274.2 +001400* THIS ROUTINE CHECKS THE SAME AS SQ104 IN COMBINATION SQ1274.2 +001500* WITH SQ1274.2 +001600* SQ1274.2 +001700* SELECT ... ASSIGN TO "LITERAL-1" SQ1274.2 +001800* ----------- SQ1274.2 +001900* (X-CARD X-60 IS UESD FOR LITERAL-1) SQ1274.2 +002000* SQ1274.2 +002100* SQ1274.2 +002200* THE ROUTINE SQ127A CREATES A SEQUENTIAL MASS STORAGE SQ1274.2 +002300* FILE WHICH HAS FIXED LENGTH RECORDS. THE FILE IS THEN SQ1274.2 +002400* CLOSED AND OPENED AS AN INPUT FILE. THE FILE IS READ AND SQ1274.2 +002500* FIELDS IN THE INPUT RECORDS ARE COMPARED TO THE VALUES SQ1274.2 +002600* WRITTEN TO ENSURE THAT THE RECORDS WERE PROCESSED CORRECTLY. SQ1274.2 +002700* THE FILE IS CLOSED AND OPENED AGAIN AS AN INPUT FILE. FOUR SQ1274.2 +002800* READ FORMAT OPTIONS ARE USED TO READ THE FILE AND FIELDS IN SQ1274.2 +002900* THE RECORDS ARE VERIFIED. THE OPEN, CLOSE, READ, AND WRITE SQ1274.2 +003000* STATEMENTS ARE TESTED FOR LEVEL ONE FEATURES. SQ1274.2 +003100* SQ1274.2 +003200* USED X-CARDS: SQ1274.2 +003300* XXXXX055 SQ1274.2 +003400* XXXXX060 FOR "SQ-FS3" SQ1274.2 +003500* P XXXXX062 SQ1274.2 +003600* XXXXX082 SQ1274.2 +003700* XXXXX083 SQ1274.2 +003800* C XXXXX084 SQ1274.2 +003900* SQ1274.2 +004000* SQ1274.2 +004100 ENVIRONMENT DIVISION. SQ1274.2 +004200 CONFIGURATION SECTION. SQ1274.2 +004300 SOURCE-COMPUTER. SQ1274.2 +004400 Linux. SQ1274.2 +004500 OBJECT-COMPUTER. SQ1274.2 +004600 Linux. SQ1274.2 +004700 INPUT-OUTPUT SECTION. SQ1274.2 +004800 FILE-CONTROL. SQ1274.2 +004900*P SELECT RAW-DATA ASSIGN TO SQ1274.2 +005000*P "XXXXX062" SQ1274.2 +005100*P ORGANIZATION IS INDEXED SQ1274.2 +005200*P ACCESS MODE IS RANDOM SQ1274.2 +005300*P RECORD KEY IS RAW-DATA-KEY. SQ1274.2 +005400 SELECT PRINT-FILE ASSIGN TO SQ1274.2 +005500 "report.log". SQ1274.2 +005600 SELECT SQ-FS3 ASSIGN TO SQ1274.2 +005700 "XXXXX060" SQ1274.2 +005800 ORGANIZATION IS SEQUENTIAL SQ1274.2 +005900 ACCESS MODE IS SEQUENTIAL. SQ1274.2 +006000 DATA DIVISION. SQ1274.2 +006100 FILE SECTION. SQ1274.2 +006200*P SQ1274.2 +006300*PD RAW-DATA. SQ1274.2 +006400*P SQ1274.2 +006500*P1 RAW-DATA-SATZ. SQ1274.2 +006600*P 05 RAW-DATA-KEY PIC X(6). SQ1274.2 +006700*P 05 C-DATE PIC 9(6). SQ1274.2 +006800*P 05 C-TIME PIC 9(8). SQ1274.2 +006900*P 05 C-NO-OF-TESTS PIC 99. SQ1274.2 +007000*P 05 C-OK PIC 999. SQ1274.2 +007100*P 05 C-ALL PIC 999. SQ1274.2 +007200*P 05 C-FAIL PIC 999. SQ1274.2 +007300*P 05 C-DELETED PIC 999. SQ1274.2 +007400*P 05 C-INSPECT PIC 999. SQ1274.2 +007500*P 05 C-NOTE PIC X(13). SQ1274.2 +007600*P 05 C-INDENT PIC X. SQ1274.2 +007700*P 05 C-ABORT PIC X(8). SQ1274.2 +007800 FD PRINT-FILE SQ1274.2 +007900*C LABEL RECORDS SQ1274.2 +008000*C OMITTED SQ1274.2 +008100*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1274.2 +008200 . SQ1274.2 +008300 01 PRINT-REC PICTURE X(120). SQ1274.2 +008400 01 DUMMY-RECORD PICTURE X(120). SQ1274.2 +008500 FD SQ-FS3 SQ1274.2 +008600*C LABEL RECORDS ARE STANDARD SQ1274.2 +008700*C DATA RECORD SQ-FS3R1-F-G-120 SQ1274.2 +008800 BLOCK CONTAINS 120 CHARACTERS SQ1274.2 +008900 RECORD CONTAINS 120 CHARACTERS. SQ1274.2 +009000 01 SQ-FS3R1-F-G-120. SQ1274.2 +009100 02 FILLER PIC X(120). SQ1274.2 +009200 WORKING-STORAGE SECTION. SQ1274.2 +009300 01 WRK-CS-09V00 PICTURE S9(9) USAGE COMP VALUE ZERO. SQ1274.2 +009400 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE 0. SQ1274.2 +009500 01 ERROR-FLAG PICTURE 9 VALUE 0. SQ1274.2 +009600 01 EOF-FLAG PICTURE 9 VALUE 0. SQ1274.2 +009700 01 FILE-RECORD-INFORMATION-REC. SQ1274.2 +009800 03 FILE-RECORD-INFO-SKELETON. SQ1274.2 +009900 05 FILLER PICTURE X(48) VALUE SQ1274.2 +010000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1274.2 +010100 05 FILLER PICTURE X(46) VALUE SQ1274.2 +010200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1274.2 +010300 05 FILLER PICTURE X(26) VALUE SQ1274.2 +010400 ",LFIL=000000,ORG= ,LBLR= ". SQ1274.2 +010500 05 FILLER PICTURE X(37) VALUE SQ1274.2 +010600 ",RECKEY= ". SQ1274.2 +010700 05 FILLER PICTURE X(38) VALUE SQ1274.2 +010800 ",ALTKEY1= ". SQ1274.2 +010900 05 FILLER PICTURE X(38) VALUE SQ1274.2 +011000 ",ALTKEY2= ". SQ1274.2 +011100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1274.2 +011200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1274.2 +011300 05 FILE-RECORD-INFO-P1-120. SQ1274.2 +011400 07 FILLER PIC X(5). SQ1274.2 +011500 07 XFILE-NAME PIC X(6). SQ1274.2 +011600 07 FILLER PIC X(8). SQ1274.2 +011700 07 XRECORD-NAME PIC X(6). SQ1274.2 +011800 07 FILLER PIC X(1). SQ1274.2 +011900 07 REELUNIT-NUMBER PIC 9(1). SQ1274.2 +012000 07 FILLER PIC X(7). SQ1274.2 +012100 07 XRECORD-NUMBER PIC 9(6). SQ1274.2 +012200 07 FILLER PIC X(6). SQ1274.2 +012300 07 UPDATE-NUMBER PIC 9(2). SQ1274.2 +012400 07 FILLER PIC X(5). SQ1274.2 +012500 07 ODO-NUMBER PIC 9(4). SQ1274.2 +012600 07 FILLER PIC X(5). SQ1274.2 +012700 07 XPROGRAM-NAME PIC X(5). SQ1274.2 +012800 07 FILLER PIC X(7). SQ1274.2 +012900 07 XRECORD-LENGTH PIC 9(6). SQ1274.2 +013000 07 FILLER PIC X(7). SQ1274.2 +013100 07 CHARS-OR-RECORDS PIC X(2). SQ1274.2 +013200 07 FILLER PIC X(1). SQ1274.2 +013300 07 XBLOCK-SIZE PIC 9(4). SQ1274.2 +013400 07 FILLER PIC X(6). SQ1274.2 +013500 07 RECORDS-IN-FILE PIC 9(6). SQ1274.2 +013600 07 FILLER PIC X(5). SQ1274.2 +013700 07 XFILE-ORGANIZATION PIC X(2). SQ1274.2 +013800 07 FILLER PIC X(6). SQ1274.2 +013900 07 XLABEL-TYPE PIC X(1). SQ1274.2 +014000 05 FILE-RECORD-INFO-P121-240. SQ1274.2 +014100 07 FILLER PIC X(8). SQ1274.2 +014200 07 XRECORD-KEY PIC X(29). SQ1274.2 +014300 07 FILLER PIC X(9). SQ1274.2 +014400 07 ALTERNATE-KEY1 PIC X(29). SQ1274.2 +014500 07 FILLER PIC X(9). SQ1274.2 +014600 07 ALTERNATE-KEY2 PIC X(29). SQ1274.2 +014700 07 FILLER PIC X(7). SQ1274.2 +014800 01 TEST-RESULTS. SQ1274.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ1274.2 +015000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1274.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ1274.2 +015200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1274.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ1274.2 +015400 02 PAR-NAME. SQ1274.2 +015500 03 FILLER PICTURE X(12) VALUE SPACE. SQ1274.2 +015600 03 PARDOT-X PICTURE X VALUE SPACE. SQ1274.2 +015700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1274.2 +015800 03 FILLER PIC X(5) VALUE SPACE. SQ1274.2 +015900 02 FILLER PIC X(10) VALUE SPACE. SQ1274.2 +016000 02 RE-MARK PIC X(61). SQ1274.2 +016100 01 TEST-COMPUTED. SQ1274.2 +016200 02 FILLER PIC X(30) VALUE SPACE. SQ1274.2 +016300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1274.2 +016400 02 COMPUTED-X. SQ1274.2 +016500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1274.2 +016600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1274.2 +016700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1274.2 +016800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1274.2 +016900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1274.2 +017000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1274.2 +017100 04 COMPUTED-18V0 PICTURE -9(18). SQ1274.2 +017200 04 FILLER PICTURE X. SQ1274.2 +017300 03 FILLER PIC X(50) VALUE SPACE. SQ1274.2 +017400 01 TEST-CORRECT. SQ1274.2 +017500 02 FILLER PIC X(30) VALUE SPACE. SQ1274.2 +017600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1274.2 +017700 02 CORRECT-X. SQ1274.2 +017800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1274.2 +017900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1274.2 +018000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1274.2 +018100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1274.2 +018200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1274.2 +018300 03 CR-18V0 REDEFINES CORRECT-A. SQ1274.2 +018400 04 CORRECT-18V0 PICTURE -9(18). SQ1274.2 +018500 04 FILLER PICTURE X. SQ1274.2 +018600 03 FILLER PIC X(50) VALUE SPACE. SQ1274.2 +018700 01 CCVS-C-1. SQ1274.2 +018800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1274.2 +018900- "SS PARAGRAPH-NAME SQ1274.2 +019000- " REMARKS". SQ1274.2 +019100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1274.2 +019200 01 CCVS-C-2. SQ1274.2 +019300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1274.2 +019400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1274.2 +019500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1274.2 +019600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1274.2 +019700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1274.2 +019800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1274.2 +019900 01 REC-CT PICTURE 99 VALUE ZERO. SQ1274.2 +020000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1274.2 +020100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1274.2 +020200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1274.2 +020300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1274.2 +020400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1274.2 +020500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1274.2 +020600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1274.2 +020700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1274.2 +020800 01 CCVS-H-1. SQ1274.2 +020900 02 FILLER PICTURE X(27) VALUE SPACE. SQ1274.2 +021000 02 FILLER PICTURE X(67) VALUE SQ1274.2 +021100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1274.2 +021200- " SYSTEM". SQ1274.2 +021300 02 FILLER PICTURE X(26) VALUE SPACE. SQ1274.2 +021400 01 CCVS-H-2. SQ1274.2 +021500 02 FILLER PICTURE X(52) VALUE IS SQ1274.2 +021600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1274.2 +021700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1274.2 +021800 02 TEST-ID PICTURE IS X(9). SQ1274.2 +021900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1274.2 +022000 01 CCVS-H-3. SQ1274.2 +022100 02 FILLER PICTURE X(34) VALUE SQ1274.2 +022200 " FOR OFFICIAL USE ONLY ". SQ1274.2 +022300 02 FILLER PICTURE X(58) VALUE SQ1274.2 +022400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1274.2 +022500 02 FILLER PICTURE X(28) VALUE SQ1274.2 +022600 " COPYRIGHT 1985 ". SQ1274.2 +022700 01 CCVS-E-1. SQ1274.2 +022800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1274.2 +022900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1274.2 +023000 02 ID-AGAIN PICTURE IS X(9). SQ1274.2 +023100 02 FILLER PICTURE X(45) VALUE IS SQ1274.2 +023200 " NTIS DISTRIBUTION COBOL 85". SQ1274.2 +023300 01 CCVS-E-2. SQ1274.2 +023400 02 FILLER PICTURE X(31) VALUE SQ1274.2 +023500 SPACE. SQ1274.2 +023600 02 FILLER PICTURE X(21) VALUE SPACE. SQ1274.2 +023700 02 CCVS-E-2-2. SQ1274.2 +023800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1274.2 +023900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1274.2 +024000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1274.2 +024100 01 CCVS-E-3. SQ1274.2 +024200 02 FILLER PICTURE X(22) VALUE SQ1274.2 +024300 " FOR OFFICIAL USE ONLY". SQ1274.2 +024400 02 FILLER PICTURE X(12) VALUE SPACE. SQ1274.2 +024500 02 FILLER PICTURE X(58) VALUE SQ1274.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1274.2 +024700 02 FILLER PICTURE X(13) VALUE SPACE. SQ1274.2 +024800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1274.2 +024900 01 CCVS-E-4. SQ1274.2 +025000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1274.2 +025100 02 FILLER PIC XXXX VALUE " OF ". SQ1274.2 +025200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1274.2 +025300 02 FILLER PIC X(40) VALUE SQ1274.2 +025400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1274.2 +025500 01 XXINFO. SQ1274.2 +025600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1274.2 +025700 02 INFO-TEXT. SQ1274.2 +025800 04 FILLER PIC X(20) VALUE SPACE. SQ1274.2 +025900 04 XXCOMPUTED PIC X(20). SQ1274.2 +026000 04 FILLER PIC X(5) VALUE SPACE. SQ1274.2 +026100 04 XXCORRECT PIC X(20). SQ1274.2 +026200 01 HYPHEN-LINE. SQ1274.2 +026300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1274.2 +026400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1274.2 +026500- "*****************************************". SQ1274.2 +026600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1274.2 +026700- "******************************". SQ1274.2 +026800 01 CCVS-PGM-ID PIC X(6) VALUE SQ1274.2 +026900 "SQ127A". SQ1274.2 +027000 PROCEDURE DIVISION. SQ1274.2 +027100 CCVS1 SECTION. SQ1274.2 +027200 OPEN-FILES. SQ1274.2 +027300*P OPEN I-O RAW-DATA. SQ1274.2 +027400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1274.2 +027500*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1274.2 +027600*P MOVE "ABORTED " TO C-ABORT. SQ1274.2 +027700*P ADD 1 TO C-NO-OF-TESTS. SQ1274.2 +027800*P ACCEPT C-DATE FROM DATE. SQ1274.2 +027900*P ACCEPT C-TIME FROM TIME. SQ1274.2 +028000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1274.2 +028100*PND-E-1. SQ1274.2 +028200*P CLOSE RAW-DATA. SQ1274.2 +028300 OPEN OUTPUT PRINT-FILE. SQ1274.2 +028400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1274.2 +028500 MOVE SPACE TO TEST-RESULTS. SQ1274.2 +028600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1274.2 +028700 MOVE ZERO TO REC-SKL-SUB. SQ1274.2 +028800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1274.2 +028900 CCVS-INIT-FILE. SQ1274.2 +029000 ADD 1 TO REC-SKL-SUB. SQ1274.2 +029100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1274.2 +029200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1274.2 +029300 CCVS-INIT-EXIT. SQ1274.2 +029400 GO TO CCVS1-EXIT. SQ1274.2 +029500 CLOSE-FILES. SQ1274.2 +029600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1274.2 +029700*P OPEN I-O RAW-DATA. SQ1274.2 +029800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1274.2 +029900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1274.2 +030000*P MOVE "OK. " TO C-ABORT. SQ1274.2 +030100*P MOVE PASS-COUNTER TO C-OK. SQ1274.2 +030200*P MOVE ERROR-HOLD TO C-ALL. SQ1274.2 +030300*P MOVE ERROR-COUNTER TO C-FAIL. SQ1274.2 +030400*P MOVE DELETE-CNT TO C-DELETED. SQ1274.2 +030500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1274.2 +030600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1274.2 +030700*PND-E-2. SQ1274.2 +030800*P CLOSE RAW-DATA. SQ1274.2 +030900 TERMINATE-CCVS. SQ1274.2 +031000*S EXIT PROGRAM. SQ1274.2 +031100*SERMINATE-CALL. SQ1274.2 +031200 STOP RUN. SQ1274.2 +031300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1274.2 +031400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1274.2 +031500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1274.2 +031600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1274.2 +031700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1274.2 +031800 PRINT-DETAIL. SQ1274.2 +031900 IF REC-CT NOT EQUAL TO ZERO SQ1274.2 +032000 MOVE "." TO PARDOT-X SQ1274.2 +032100 MOVE REC-CT TO DOTVALUE. SQ1274.2 +032200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1274.2 +032300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1274.2 +032400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1274.2 +032500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1274.2 +032600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1274.2 +032700 MOVE SPACE TO CORRECT-X. SQ1274.2 +032800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1274.2 +032900 MOVE SPACE TO RE-MARK. SQ1274.2 +033000 HEAD-ROUTINE. SQ1274.2 +033100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +033200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1274.2 +033300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1274.2 +033400 COLUMN-NAMES-ROUTINE. SQ1274.2 +033500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +033600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +033800 END-ROUTINE. SQ1274.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1274.2 +034000 END-RTN-EXIT. SQ1274.2 +034100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +034200 END-ROUTINE-1. SQ1274.2 +034300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1274.2 +034400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1274.2 +034500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1274.2 +034600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1274.2 +034700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1274.2 +034800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1274.2 +034900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1274.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1274.2 +035100 END-ROUTINE-12. SQ1274.2 +035200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1274.2 +035300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1274.2 +035400 MOVE "NO " TO ERROR-TOTAL SQ1274.2 +035500 ELSE SQ1274.2 +035600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1274.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1274.2 +035800 PERFORM WRITE-LINE. SQ1274.2 +035900 END-ROUTINE-13. SQ1274.2 +036000 IF DELETE-CNT IS EQUAL TO ZERO SQ1274.2 +036100 MOVE "NO " TO ERROR-TOTAL ELSE SQ1274.2 +036200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1274.2 +036300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1274.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +036500 IF INSPECT-COUNTER EQUAL TO ZERO SQ1274.2 +036600 MOVE "NO " TO ERROR-TOTAL SQ1274.2 +036700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1274.2 +036800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1274.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +037000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1274.2 +037100 WRITE-LINE. SQ1274.2 +037200 ADD 1 TO RECORD-COUNT. SQ1274.2 +037300 IF RECORD-COUNT GREATER 50 SQ1274.2 +037400 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1274.2 +037500 MOVE SPACE TO DUMMY-RECORD SQ1274.2 +037600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1274.2 +037700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1274.2 +037800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1274.2 +037900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1274.2 +038000 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1274.2 +038100 MOVE ZERO TO RECORD-COUNT. SQ1274.2 +038200 PERFORM WRT-LN. SQ1274.2 +038300 WRT-LN. SQ1274.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1274.2 +038500 MOVE SPACE TO DUMMY-RECORD. SQ1274.2 +038600 BLANK-LINE-PRINT. SQ1274.2 +038700 PERFORM WRT-LN. SQ1274.2 +038800 FAIL-ROUTINE. SQ1274.2 +038900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1274.2 +039000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1274.2 +039100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1274.2 +039200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +039300 GO TO FAIL-ROUTINE-EX. SQ1274.2 +039400 FAIL-ROUTINE-WRITE. SQ1274.2 +039500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1274.2 +039600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +039700 FAIL-ROUTINE-EX. EXIT. SQ1274.2 +039800 BAIL-OUT. SQ1274.2 +039900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1274.2 +040000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1274.2 +040100 BAIL-OUT-WRITE. SQ1274.2 +040200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1274.2 +040300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1274.2 +040400 BAIL-OUT-EX. EXIT. SQ1274.2 +040500 CCVS1-EXIT. SQ1274.2 +040600 EXIT. SQ1274.2 +040700 SECT-SQ127A-0001 SECTION. SQ1274.2 +040800 SEQ-INIT-007. SQ1274.2 +040900 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ1274.2 +041000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1274.2 +041100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1274.2 +041200 MOVE 120 TO XRECORD-LENGTH (1). SQ1274.2 +041300 MOVE "CH" TO CHARS-OR-RECORDS (1). SQ1274.2 +041400 MOVE 120 TO XBLOCK-SIZE (1). SQ1274.2 +041500 MOVE 000649 TO RECORDS-IN-FILE (1). SQ1274.2 +041600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1274.2 +041700 MOVE "S" TO XLABEL-TYPE (1). SQ1274.2 +041800 MOVE 000001 TO XRECORD-NUMBER (1). SQ1274.2 +041900 OPEN OUTPUT SQ-FS3. SQ1274.2 +042000 SEQ-TEST-007. SQ1274.2 +042100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ1274.2 +042200 WRITE SQ-FS3R1-F-G-120. SQ1274.2 +042300 IF XRECORD-NUMBER (1) EQUAL TO 649 SQ1274.2 +042400 GO TO SEQ-WRITE-007. SQ1274.2 +042500 ADD 1 TO XRECORD-NUMBER (1). SQ1274.2 +042600 GO TO SEQ-TEST-007. SQ1274.2 +042700 SEQ-WRITE-007. SQ1274.2 +042800 MOVE "CREATE FILE SQ-FS3" TO FEATURE. SQ1274.2 +042900 MOVE "SEQ-TEST-007" TO PAR-NAME. SQ1274.2 +043000 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1274.2 +043100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1274.2 +043200 PERFORM PRINT-DETAIL. SQ1274.2 +043300 CLOSE SQ-FS3. SQ1274.2 +043400* A MASS STORAGE SEQUENTIAL FILE WITH 120 CHARACTER SQ1274.2 +043500* RECORDS HAS BEEN CREATED. THE FILE CONTAINS 649 RECORDS. SQ1274.2 +043600 READ-INIT-GF-01. SQ1274.2 +043700 MOVE ZERO TO WRK-CS-09V00. SQ1274.2 +043800* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ1274.2 +043900* SEQ-TEST-007. SQ1274.2 +044000 OPEN INPUT SQ-FS3. SQ1274.2 +044100 READ-TEST-GF-01. SQ1274.2 +044200 READ SQ-FS3 RECORD SQ1274.2 +044300 AT END GO TO READ-TEST-GF-01-1. SQ1274.2 +044400 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1274.2 +044500 ADD 1 TO WRK-CS-09V00. SQ1274.2 +044600 IF WRK-CS-09V00 GREATER THAN 649 SQ1274.2 +044700 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1274.2 +044800 GO TO READ-FAIL-GF-01. SQ1274.2 +044900 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1274.2 +045000 ADD 1 TO RECORDS-IN-ERROR SQ1274.2 +045100 GO TO READ-TEST-GF-01. SQ1274.2 +045200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS3" SQ1274.2 +045300 ADD 1 TO RECORDS-IN-ERROR SQ1274.2 +045400 GO TO READ-TEST-GF-01. SQ1274.2 +045500 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ1274.2 +045600 ADD 1 TO RECORDS-IN-ERROR. SQ1274.2 +045700 GO TO READ-TEST-GF-01. SQ1274.2 +045800 READ-TEST-GF-01-1. SQ1274.2 +045900 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ1274.2 +046000 GO TO READ-PASS-GF-01. SQ1274.2 +046100 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. SQ1274.2 +046200 READ-FAIL-GF-01. SQ1274.2 +046300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ1274.2 +046400 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +046500 PERFORM FAIL. SQ1274.2 +046600 GO TO READ-WRITE-GF-01. SQ1274.2 +046700 READ-PASS-GF-01. SQ1274.2 +046800 PERFORM PASS. SQ1274.2 +046900 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ1274.2 +047000 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1274.2 +047100 READ-WRITE-GF-01. SQ1274.2 +047200 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ1274.2 +047300 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. SQ1274.2 +047400 PERFORM PRINT-DETAIL. SQ1274.2 +047500 SEQ-CLOSE-008. SQ1274.2 +047600 CLOSE SQ-FS3. SQ1274.2 +047700 READ-INIT-GF-02. SQ1274.2 +047800 MOVE ZERO TO WRK-CS-09V00. SQ1274.2 +047900 MOVE ZERO TO RECORDS-IN-ERROR. SQ1274.2 +048000 OPEN INPUT SQ-FS3. SQ1274.2 +048100* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ1274.2 +048200* IN THIS SERIES OF TESTS. SQ1274.2 +048300 MOVE "READ...RECORD AT END ..." TO FEATURE. SQ1274.2 +048400 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ1274.2 +048500 MOVE ZERO TO ERROR-FLAG. SQ1274.2 +048600 READ-TEST-GF-02. SQ1274.2 +048700 READ SQ-FS3 RECORD SQ1274.2 +048800 AT END MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1274.2 +048900 MOVE 1 TO EOF-FLAG SQ1274.2 +049000 GO TO READ-FAIL-GF-02. SQ1274.2 +049100 PERFORM RECORD-CHECK. SQ1274.2 +049200 IF WRK-CS-09V00 EQUAL TO 50 SQ1274.2 +049300 GO TO READ-TEST-GF-02-1. SQ1274.2 +049400 GO TO READ-TEST-GF-02. SQ1274.2 +049500 RECORD-CHECK. SQ1274.2 +049600 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1274.2 +049700 ADD 1 TO WRK-CS-09V00. SQ1274.2 +049800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ1274.2 +049900 ADD 1 TO RECORDS-IN-ERROR SQ1274.2 +050000 MOVE 1 TO ERROR-FLAG. SQ1274.2 +050100 READ-TEST-GF-02-1. SQ1274.2 +050200 IF ERROR-FLAG EQUAL TO ZERO SQ1274.2 +050300 GO TO READ-PASS-GF-02. SQ1274.2 +050400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1274.2 +050500 READ-FAIL-GF-02. SQ1274.2 +050600 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +050700 PERFORM FAIL. SQ1274.2 +050800 GO TO READ-WRITE-GF-02. SQ1274.2 +050900 READ-PASS-GF-02. SQ1274.2 +051000 PERFORM PASS. SQ1274.2 +051100 READ-WRITE-GF-02. SQ1274.2 +051200 PERFORM PRINT-DETAIL. SQ1274.2 +051300 READ-INIT-GF-03. SQ1274.2 +051400 IF EOF-FLAG EQUAL TO 1 SQ1274.2 +051500 GO TO READ-EOF-GF-06. SQ1274.2 +051600 MOVE ZERO TO ERROR-FLAG. SQ1274.2 +051700 MOVE "READ...AT END..." TO FEATURE. SQ1274.2 +051800 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ1274.2 +051900 READ-TEST-GF-03. SQ1274.2 +052000 READ SQ-FS3 AT END SQ1274.2 +052100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1274.2 +052200 MOVE 1 TO EOF-FLAG SQ1274.2 +052300 GO TO READ-FAIL-GF-03. SQ1274.2 +052400 PERFORM RECORD-CHECK. SQ1274.2 +052500 IF WRK-CS-09V00 EQUAL TO 200 SQ1274.2 +052600 GO TO READ-TEST-GF-03-1. SQ1274.2 +052700 GO TO READ-TEST-GF-03. SQ1274.2 +052800 READ-TEST-GF-03-1. SQ1274.2 +052900 IF ERROR-FLAG EQUAL TO ZERO SQ1274.2 +053000 GO TO READ-PASS-GF-03. SQ1274.2 +053100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1274.2 +053200 READ-FAIL-GF-03. SQ1274.2 +053300 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +053400 PERFORM FAIL. SQ1274.2 +053500 GO TO READ-WRITE-GF-03. SQ1274.2 +053600 READ-PASS-GF-03. SQ1274.2 +053700 PERFORM PASS. SQ1274.2 +053800 READ-WRITE-GF-03. SQ1274.2 +053900 PERFORM PRINT-DETAIL. SQ1274.2 +054000 READ-INIT-GF-04. SQ1274.2 +054100 IF EOF-FLAG EQUAL TO 1 SQ1274.2 +054200 GO TO READ-EOF-GF-06. SQ1274.2 +054300 MOVE ZERO TO ERROR-FLAG. SQ1274.2 +054400 MOVE "READ...RECORD END..." TO FEATURE. SQ1274.2 +054500 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ1274.2 +054600 READ-TEST-GF-04. SQ1274.2 +054700 READ SQ-FS3 RECORD END SQ1274.2 +054800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ1274.2 +054900 MOVE 1 TO EOF-FLAG SQ1274.2 +055000 GO TO READ-FAIL-GF-04. SQ1274.2 +055100 PERFORM RECORD-CHECK. SQ1274.2 +055200 IF WRK-CS-09V00 EQUAL TO 499 SQ1274.2 +055300 GO TO READ-TEST-GF-04-1. SQ1274.2 +055400 GO TO READ-TEST-GF-04. SQ1274.2 +055500 READ-TEST-GF-04-1. SQ1274.2 +055600 IF ERROR-FLAG EQUAL TO ZERO SQ1274.2 +055700 GO TO READ-PASS-GF-04. SQ1274.2 +055800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1274.2 +055900 READ-FAIL-GF-04. SQ1274.2 +056000 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +056100 PERFORM FAIL. SQ1274.2 +056200 GO TO READ-WRITE-GF-04. SQ1274.2 +056300 READ-PASS-GF-04. SQ1274.2 +056400 PERFORM PASS. SQ1274.2 +056500 READ-WRITE-GF-04. SQ1274.2 +056600 PERFORM PRINT-DETAIL. SQ1274.2 +056700 READ-INIT-GF-05. SQ1274.2 +056800 IF EOF-FLAG EQUAL TO 1 SQ1274.2 +056900 GO TO READ-EOF-GF-06. SQ1274.2 +057000 MOVE ZERO TO ERROR-FLAG. SQ1274.2 +057100 MOVE "READ...END..." TO FEATURE. SQ1274.2 +057200 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ1274.2 +057300 READ-TEST-GF-05. SQ1274.2 +057400 READ SQ-FS3 END SQ1274.2 +057500 GO TO READ-TEST-GF-05-1. SQ1274.2 +057600 PERFORM RECORD-CHECK. SQ1274.2 +057700 IF WRK-CS-09V00 GREATER THAN 649 SQ1274.2 +057800 GO TO READ-TEST-GF-05-1. SQ1274.2 +057900 GO TO READ-TEST-GF-05. SQ1274.2 +058000 READ-TEST-GF-05-1. SQ1274.2 +058100 IF ERROR-FLAG EQUAL TO ZERO SQ1274.2 +058200 GO TO READ-PASS-GF-05. SQ1274.2 +058300 READ-FAIL-GF-05. SQ1274.2 +058400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ1274.2 +058500 MOVE "VII-44 4.4.2, " TO RE-MARK. SQ1274.2 +058600 PERFORM FAIL. SQ1274.2 +058700 GO TO READ-WRITE-GF-05. SQ1274.2 +058800 READ-PASS-GF-05. SQ1274.2 +058900 PERFORM PASS. SQ1274.2 +059000 READ-WRITE-GF-05. SQ1274.2 +059100 PERFORM PRINT-DETAIL. SQ1274.2 +059200 READ-TEST-GF-06. SQ1274.2 +059300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ1274.2 +059400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ1274.2 +059500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ1274.2 +059600 GO TO READ-FAIL-GF-06. SQ1274.2 +059700 IF WRK-CS-09V00 GREATER THAN 649 SQ1274.2 +059800 MOVE "MORE THAN 649 RECORDS" TO RE-MARK SQ1274.2 +059900 GO TO READ-FAIL-GF-06. SQ1274.2 +060000 READ-PASS-GF-06. SQ1274.2 +060100 PERFORM PASS SQ1274.2 +060200 GO TO READ-WRITE-GF-06. SQ1274.2 +060300 READ-EOF-GF-06. SQ1274.2 +060400 MOVE "LESS THAN 649 RECORDS" TO RE-MARK. SQ1274.2 +060500 MOVE "RECORDS READ =" TO COMPUTED-A. SQ1274.2 +060600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ1274.2 +060700 READ-FAIL-GF-06. SQ1274.2 +060800 PERFORM FAIL. SQ1274.2 +060900 READ-WRITE-GF-06. SQ1274.2 +061000 MOVE "READ-TEST-GF-06" TO PAR-NAME. SQ1274.2 +061100 MOVE "READ FILE SQ-FS3" TO FEATURE. SQ1274.2 +061200 PERFORM PRINT-DETAIL. SQ1274.2 +061300 READ-CLOSE-GF-06. SQ1274.2 +061400 CLOSE SQ-FS3. SQ1274.2 +061500 TERMINATE-ROUTINE. SQ1274.2 +061600 EXIT. SQ1274.2 +061700 CCVS-EXIT SECTION. SQ1274.2 +061800 CCVS-999999. SQ1274.2 +061900 GO TO CLOSE-FILES. SQ1274.2 diff --git a/tests/cobol85/SQ/SQ128A.CBL b/tests/cobol85/SQ/SQ128A.CBL new file mode 100755 index 00000000..fcdd740b --- /dev/null +++ b/tests/cobol85/SQ/SQ128A.CBL @@ -0,0 +1,552 @@ +000100 IDENTIFICATION DIVISION. SQ1284.2 +000200 PROGRAM-ID. SQ1284.2 +000300 SQ128A. SQ1284.2 +000400**************************************************************** SQ1284.2 +000500* * SQ1284.2 +000600* VALIDATION FOR:- * SQ1284.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1284.2 +000800* * SQ1284.2 +000900* CREATION DATE / VALIDATION DATE * SQ1284.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1284.2 +001100* * SQ1284.2 +001200* THE ROUTINE SQ128A TESTS THE USE OF THE LEVEL 1 OPEN SQ1284.2 +001300* SERIES AND CLOSE SERIES STATEMENTS. INPUT AND OUTPUT CLAUSESSQ1284.2 +001400* ARE USED IN SERIES TOGETHER AND SEPARATELY. SEVERAL FILES SQ1284.2 +001500* ARE CREATED AND PROCESSED ON BOTH TAPE AND MASS STORAGE. SQ1284.2 +001600 ENVIRONMENT DIVISION. SQ1284.2 +001700 CONFIGURATION SECTION. SQ1284.2 +001800 SOURCE-COMPUTER. SQ1284.2 +001900 Linux. SQ1284.2 +002000 OBJECT-COMPUTER. SQ1284.2 +002100 Linux. SQ1284.2 +002200 INPUT-OUTPUT SECTION. SQ1284.2 +002300 FILE-CONTROL. SQ1284.2 +002400*P SELECT RAW-DATA ASSIGN TO SQ1284.2 +002500*P "XXXXX062" SQ1284.2 +002600*P ORGANIZATION IS INDEXED SQ1284.2 +002700*P ACCESS MODE IS RANDOM SQ1284.2 +002800*P RECORD KEY IS RAW-DATA-KEY. SQ1284.2 +002900 SELECT PRINT-FILE ASSIGN TO SQ1284.2 +003000 "report.log". SQ1284.2 +003100 SELECT SQ-FS1 ASSIGN TO SQ1284.2 +003200 "XXXXX001". SQ1284.2 +003300 SELECT SQ-FS2 ASSIGN TO SQ1284.2 +003400 "XXXXX014". SQ1284.2 +003500 SELECT SQ-FS3 ASSIGN TO SQ1284.2 +003600 "XXXXX015". SQ1284.2 +003700 DATA DIVISION. SQ1284.2 +003800 FILE SECTION. SQ1284.2 +003900*P SQ1284.2 +004000*PD RAW-DATA. SQ1284.2 +004100*P SQ1284.2 +004200*P1 RAW-DATA-SATZ. SQ1284.2 +004300*P 05 RAW-DATA-KEY PIC X(6). SQ1284.2 +004400*P 05 C-DATE PIC 9(6). SQ1284.2 +004500*P 05 C-TIME PIC 9(8). SQ1284.2 +004600*P 05 C-NO-OF-TESTS PIC 99. SQ1284.2 +004700*P 05 C-OK PIC 999. SQ1284.2 +004800*P 05 C-ALL PIC 999. SQ1284.2 +004900*P 05 C-FAIL PIC 999. SQ1284.2 +005000*P 05 C-DELETED PIC 999. SQ1284.2 +005100*P 05 C-INSPECT PIC 999. SQ1284.2 +005200*P 05 C-NOTE PIC X(13). SQ1284.2 +005300*P 05 C-INDENT PIC X. SQ1284.2 +005400*P 05 C-ABORT PIC X(8). SQ1284.2 +005500 FD PRINT-FILE SQ1284.2 +005600*C LABEL RECORDS SQ1284.2 +005700*C OMITTED SQ1284.2 +005800*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1284.2 +005900 . SQ1284.2 +006000 01 PRINT-REC PICTURE X(120). SQ1284.2 +006100 01 DUMMY-RECORD PICTURE X(120). SQ1284.2 +006200 FD SQ-FS1 SQ1284.2 +006300*C LABEL RECORD STANDARD SQ1284.2 +006400 DATA RECORD IS SQ-FS1R1-F-G-120. SQ1284.2 +006500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1284.2 +006600 FD SQ-FS2 SQ1284.2 +006700*C LABEL RECORD STANDARD SQ1284.2 +006800 BLOCK CONTAINS 10 RECORDS SQ1284.2 +006900 DATA RECORD IS SQ-FS2R1-F-G-120. SQ1284.2 +007000 01 SQ-FS2R1-F-G-120 PIC X(120). SQ1284.2 +007100 FD SQ-FS3 SQ1284.2 +007200 LABEL RECORD STANDARD SQ1284.2 +007300 BLOCK 120 CHARACTERS SQ1284.2 +007400 DATA RECORD IS SQ-FS3R1-F-G-120. SQ1284.2 +007500 01 SQ-FS3R1-F-G-120 PIC X(120). SQ1284.2 +007600 WORKING-STORAGE SECTION. SQ1284.2 +007700 01 COUNT-OF-RECS PIC 9999. SQ1284.2 +007800 01 FILE-RECORD-INFORMATION-REC. SQ1284.2 +007900 03 FILE-RECORD-INFO-SKELETON. SQ1284.2 +008000 05 FILLER PICTURE X(48) VALUE SQ1284.2 +008100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1284.2 +008200 05 FILLER PICTURE X(46) VALUE SQ1284.2 +008300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1284.2 +008400 05 FILLER PICTURE X(26) VALUE SQ1284.2 +008500 ",LFIL=000000,ORG= ,LBLR= ". SQ1284.2 +008600 05 FILLER PICTURE X(37) VALUE SQ1284.2 +008700 ",RECKEY= ". SQ1284.2 +008800 05 FILLER PICTURE X(38) VALUE SQ1284.2 +008900 ",ALTKEY1= ". SQ1284.2 +009000 05 FILLER PICTURE X(38) VALUE SQ1284.2 +009100 ",ALTKEY2= ". SQ1284.2 +009200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1284.2 +009300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1284.2 +009400 05 FILE-RECORD-INFO-P1-120. SQ1284.2 +009500 07 FILLER PIC X(5). SQ1284.2 +009600 07 XFILE-NAME PIC X(6). SQ1284.2 +009700 07 FILLER PIC X(8). SQ1284.2 +009800 07 XRECORD-NAME PIC X(6). SQ1284.2 +009900 07 FILLER PIC X(1). SQ1284.2 +010000 07 REELUNIT-NUMBER PIC 9(1). SQ1284.2 +010100 07 FILLER PIC X(7). SQ1284.2 +010200 07 XRECORD-NUMBER PIC 9(6). SQ1284.2 +010300 07 FILLER PIC X(6). SQ1284.2 +010400 07 UPDATE-NUMBER PIC 9(2). SQ1284.2 +010500 07 FILLER PIC X(5). SQ1284.2 +010600 07 ODO-NUMBER PIC 9(4). SQ1284.2 +010700 07 FILLER PIC X(5). SQ1284.2 +010800 07 XPROGRAM-NAME PIC X(5). SQ1284.2 +010900 07 FILLER PIC X(7). SQ1284.2 +011000 07 XRECORD-LENGTH PIC 9(6). SQ1284.2 +011100 07 FILLER PIC X(7). SQ1284.2 +011200 07 CHARS-OR-RECORDS PIC X(2). SQ1284.2 +011300 07 FILLER PIC X(1). SQ1284.2 +011400 07 XBLOCK-SIZE PIC 9(4). SQ1284.2 +011500 07 FILLER PIC X(6). SQ1284.2 +011600 07 RECORDS-IN-FILE PIC 9(6). SQ1284.2 +011700 07 FILLER PIC X(5). SQ1284.2 +011800 07 XFILE-ORGANIZATION PIC X(2). SQ1284.2 +011900 07 FILLER PIC X(6). SQ1284.2 +012000 07 XLABEL-TYPE PIC X(1). SQ1284.2 +012100 05 FILE-RECORD-INFO-P121-240. SQ1284.2 +012200 07 FILLER PIC X(8). SQ1284.2 +012300 07 XRECORD-KEY PIC X(29). SQ1284.2 +012400 07 FILLER PIC X(9). SQ1284.2 +012500 07 ALTERNATE-KEY1 PIC X(29). SQ1284.2 +012600 07 FILLER PIC X(9). SQ1284.2 +012700 07 ALTERNATE-KEY2 PIC X(29). SQ1284.2 +012800 07 FILLER PIC X(7). SQ1284.2 +012900 01 TEST-RESULTS. SQ1284.2 +013000 02 FILLER PICTURE X VALUE SPACE. SQ1284.2 +013100 02 FEATURE PICTURE X(20) VALUE SPACE. SQ1284.2 +013200 02 FILLER PICTURE X VALUE SPACE. SQ1284.2 +013300 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ1284.2 +013400 02 FILLER PICTURE X VALUE SPACE. SQ1284.2 +013500 02 PAR-NAME. SQ1284.2 +013600 03 FILLER PICTURE X(12) VALUE SPACE. SQ1284.2 +013700 03 PARDOT-X PICTURE X VALUE SPACE. SQ1284.2 +013800 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ1284.2 +013900 03 FILLER PIC X(5) VALUE SPACE. SQ1284.2 +014000 02 FILLER PIC X(10) VALUE SPACE. SQ1284.2 +014100 02 RE-MARK PIC X(61). SQ1284.2 +014200 01 TEST-COMPUTED. SQ1284.2 +014300 02 FILLER PIC X(30) VALUE SPACE. SQ1284.2 +014400 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ1284.2 +014500 02 COMPUTED-X. SQ1284.2 +014600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ1284.2 +014700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ1284.2 +014800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ1284.2 +014900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ1284.2 +015000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ1284.2 +015100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1284.2 +015200 04 COMPUTED-18V0 PICTURE -9(18). SQ1284.2 +015300 04 FILLER PICTURE X. SQ1284.2 +015400 03 FILLER PIC X(50) VALUE SPACE. SQ1284.2 +015500 01 TEST-CORRECT. SQ1284.2 +015600 02 FILLER PIC X(30) VALUE SPACE. SQ1284.2 +015700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1284.2 +015800 02 CORRECT-X. SQ1284.2 +015900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ1284.2 +016000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ1284.2 +016100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ1284.2 +016200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ1284.2 +016300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ1284.2 +016400 03 CR-18V0 REDEFINES CORRECT-A. SQ1284.2 +016500 04 CORRECT-18V0 PICTURE -9(18). SQ1284.2 +016600 04 FILLER PICTURE X. SQ1284.2 +016700 03 FILLER PIC X(50) VALUE SPACE. SQ1284.2 +016800 01 CCVS-C-1. SQ1284.2 +016900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ1284.2 +017000- "SS PARAGRAPH-NAME SQ1284.2 +017100- " REMARKS". SQ1284.2 +017200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ1284.2 +017300 01 CCVS-C-2. SQ1284.2 +017400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1284.2 +017500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ1284.2 +017600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ1284.2 +017700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ1284.2 +017800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ1284.2 +017900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ1284.2 +018000 01 REC-CT PICTURE 99 VALUE ZERO. SQ1284.2 +018100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ1284.2 +018200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ1284.2 +018300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1284.2 +018400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1284.2 +018500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1284.2 +018600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1284.2 +018700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1284.2 +018800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1284.2 +018900 01 CCVS-H-1. SQ1284.2 +019000 02 FILLER PICTURE X(27) VALUE SPACE. SQ1284.2 +019100 02 FILLER PICTURE X(67) VALUE SQ1284.2 +019200 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ1284.2 +019300- " SYSTEM". SQ1284.2 +019400 02 FILLER PICTURE X(26) VALUE SPACE. SQ1284.2 +019500 01 CCVS-H-2. SQ1284.2 +019600 02 FILLER PICTURE X(52) VALUE IS SQ1284.2 +019700 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ1284.2 +019800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ1284.2 +019900 02 TEST-ID PICTURE IS X(9). SQ1284.2 +020000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ1284.2 +020100 01 CCVS-H-3. SQ1284.2 +020200 02 FILLER PICTURE X(34) VALUE SQ1284.2 +020300 " FOR OFFICIAL USE ONLY ". SQ1284.2 +020400 02 FILLER PICTURE X(58) VALUE SQ1284.2 +020500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1284.2 +020600 02 FILLER PICTURE X(28) VALUE SQ1284.2 +020700 " COPYRIGHT 1985 ". SQ1284.2 +020800 01 CCVS-E-1. SQ1284.2 +020900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ1284.2 +021000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ1284.2 +021100 02 ID-AGAIN PICTURE IS X(9). SQ1284.2 +021200 02 FILLER PICTURE X(45) VALUE IS SQ1284.2 +021300 " NTIS DISTRIBUTION COBOL 85". SQ1284.2 +021400 01 CCVS-E-2. SQ1284.2 +021500 02 FILLER PICTURE X(31) VALUE SQ1284.2 +021600 SPACE. SQ1284.2 +021700 02 FILLER PICTURE X(21) VALUE SPACE. SQ1284.2 +021800 02 CCVS-E-2-2. SQ1284.2 +021900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ1284.2 +022000 03 FILLER PICTURE IS X VALUE IS SPACE. SQ1284.2 +022100 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ1284.2 +022200 01 CCVS-E-3. SQ1284.2 +022300 02 FILLER PICTURE X(22) VALUE SQ1284.2 +022400 " FOR OFFICIAL USE ONLY". SQ1284.2 +022500 02 FILLER PICTURE X(12) VALUE SPACE. SQ1284.2 +022600 02 FILLER PICTURE X(58) VALUE SQ1284.2 +022700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1284.2 +022800 02 FILLER PICTURE X(13) VALUE SPACE. SQ1284.2 +022900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ1284.2 +023000 01 CCVS-E-4. SQ1284.2 +023100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1284.2 +023200 02 FILLER PIC XXXX VALUE " OF ". SQ1284.2 +023300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1284.2 +023400 02 FILLER PIC X(40) VALUE SQ1284.2 +023500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1284.2 +023600 01 XXINFO. SQ1284.2 +023700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ1284.2 +023800 02 INFO-TEXT. SQ1284.2 +023900 04 FILLER PIC X(20) VALUE SPACE. SQ1284.2 +024000 04 XXCOMPUTED PIC X(20). SQ1284.2 +024100 04 FILLER PIC X(5) VALUE SPACE. SQ1284.2 +024200 04 XXCORRECT PIC X(20). SQ1284.2 +024300 01 HYPHEN-LINE. SQ1284.2 +024400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ1284.2 +024500 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ1284.2 +024600- "*****************************************". SQ1284.2 +024700 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ1284.2 +024800- "******************************". SQ1284.2 +024900 01 CCVS-PGM-ID PIC X(6) VALUE SQ1284.2 +025000 "SQ128A". SQ1284.2 +025100 PROCEDURE DIVISION. SQ1284.2 +025200 CCVS1 SECTION. SQ1284.2 +025300 OPEN-FILES. SQ1284.2 +025400*P OPEN I-O RAW-DATA. SQ1284.2 +025500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1284.2 +025600*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1284.2 +025700*P MOVE "ABORTED " TO C-ABORT. SQ1284.2 +025800*P ADD 1 TO C-NO-OF-TESTS. SQ1284.2 +025900*P ACCEPT C-DATE FROM DATE. SQ1284.2 +026000*P ACCEPT C-TIME FROM TIME. SQ1284.2 +026100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ1284.2 +026200*PND-E-1. SQ1284.2 +026300*P CLOSE RAW-DATA. SQ1284.2 +026400 OPEN OUTPUT PRINT-FILE. SQ1284.2 +026500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1284.2 +026600 MOVE SPACE TO TEST-RESULTS. SQ1284.2 +026700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1284.2 +026800 MOVE ZERO TO REC-SKL-SUB. SQ1284.2 +026900 PERFORM CCVS-INIT-FILE 9 TIMES. SQ1284.2 +027000 CCVS-INIT-FILE. SQ1284.2 +027100 ADD 1 TO REC-SKL-SUB. SQ1284.2 +027200 MOVE FILE-RECORD-INFO-SKELETON TO SQ1284.2 +027300 FILE-RECORD-INFO (REC-SKL-SUB). SQ1284.2 +027400 CCVS-INIT-EXIT. SQ1284.2 +027500 GO TO CCVS1-EXIT. SQ1284.2 +027600 CLOSE-FILES. SQ1284.2 +027700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ1284.2 +027800*P OPEN I-O RAW-DATA. SQ1284.2 +027900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1284.2 +028000*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1284.2 +028100*P MOVE "OK. " TO C-ABORT. SQ1284.2 +028200*P MOVE PASS-COUNTER TO C-OK. SQ1284.2 +028300*P MOVE ERROR-HOLD TO C-ALL. SQ1284.2 +028400*P MOVE ERROR-COUNTER TO C-FAIL. SQ1284.2 +028500*P MOVE DELETE-CNT TO C-DELETED. SQ1284.2 +028600*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1284.2 +028700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ1284.2 +028800*PND-E-2. SQ1284.2 +028900*P CLOSE RAW-DATA. SQ1284.2 +029000 TERMINATE-CCVS. SQ1284.2 +029100*S EXIT PROGRAM. SQ1284.2 +029200*SERMINATE-CALL. SQ1284.2 +029300 STOP RUN. SQ1284.2 +029400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ1284.2 +029500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ1284.2 +029600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ1284.2 +029700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ1284.2 +029800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1284.2 +029900 PRINT-DETAIL. SQ1284.2 +030000 IF REC-CT NOT EQUAL TO ZERO SQ1284.2 +030100 MOVE "." TO PARDOT-X SQ1284.2 +030200 MOVE REC-CT TO DOTVALUE. SQ1284.2 +030300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ1284.2 +030400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ1284.2 +030500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1284.2 +030600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1284.2 +030700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ1284.2 +030800 MOVE SPACE TO CORRECT-X. SQ1284.2 +030900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1284.2 +031000 MOVE SPACE TO RE-MARK. SQ1284.2 +031100 HEAD-ROUTINE. SQ1284.2 +031200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +031300 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ1284.2 +031400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1284.2 +031500 COLUMN-NAMES-ROUTINE. SQ1284.2 +031600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +031700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +031800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +031900 END-ROUTINE. SQ1284.2 +032000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ1284.2 +032100 END-RTN-EXIT. SQ1284.2 +032200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +032300 END-ROUTINE-1. SQ1284.2 +032400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ1284.2 +032500 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ1284.2 +032600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1284.2 +032700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ1284.2 +032800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1284.2 +032900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1284.2 +033000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1284.2 +033100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ1284.2 +033200 END-ROUTINE-12. SQ1284.2 +033300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1284.2 +033400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1284.2 +033500 MOVE "NO " TO ERROR-TOTAL SQ1284.2 +033600 ELSE SQ1284.2 +033700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1284.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1284.2 +033900 PERFORM WRITE-LINE. SQ1284.2 +034000 END-ROUTINE-13. SQ1284.2 +034100 IF DELETE-CNT IS EQUAL TO ZERO SQ1284.2 +034200 MOVE "NO " TO ERROR-TOTAL ELSE SQ1284.2 +034300 MOVE DELETE-CNT TO ERROR-TOTAL. SQ1284.2 +034400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1284.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +034600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1284.2 +034700 MOVE "NO " TO ERROR-TOTAL SQ1284.2 +034800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1284.2 +034900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1284.2 +035000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +035100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1284.2 +035200 WRITE-LINE. SQ1284.2 +035300 ADD 1 TO RECORD-COUNT. SQ1284.2 +035400 IF RECORD-COUNT GREATER 50 SQ1284.2 +035500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1284.2 +035600 MOVE SPACE TO DUMMY-RECORD SQ1284.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1284.2 +035800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1284.2 +035900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1284.2 +036000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1284.2 +036100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1284.2 +036200 MOVE ZERO TO RECORD-COUNT. SQ1284.2 +036300 PERFORM WRT-LN. SQ1284.2 +036400 WRT-LN. SQ1284.2 +036500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1284.2 +036600 MOVE SPACE TO DUMMY-RECORD. SQ1284.2 +036700 BLANK-LINE-PRINT. SQ1284.2 +036800 PERFORM WRT-LN. SQ1284.2 +036900 FAIL-ROUTINE. SQ1284.2 +037000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1284.2 +037100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1284.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1284.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +037400 GO TO FAIL-ROUTINE-EX. SQ1284.2 +037500 FAIL-ROUTINE-WRITE. SQ1284.2 +037600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ1284.2 +037700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +037800 FAIL-ROUTINE-EX. EXIT. SQ1284.2 +037900 BAIL-OUT. SQ1284.2 +038000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1284.2 +038100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1284.2 +038200 BAIL-OUT-WRITE. SQ1284.2 +038300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ1284.2 +038400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1284.2 +038500 BAIL-OUT-EX. EXIT. SQ1284.2 +038600 CCVS1-EXIT. SQ1284.2 +038700 EXIT. SQ1284.2 +038800 SECT-SQ128A-0001 SECTION. SQ1284.2 +038900 OPEN-INIT-GF-01. SQ1284.2 +039000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1284.2 +039100 MOVE "SQ-FS2" TO XFILE-NAME (2). SQ1284.2 +039200 MOVE "SQ-FS3" TO XFILE-NAME (3). SQ1284.2 +039300 MOVE "R1-F-G" TO XRECORD-NAME (1) SQ1284.2 +039400 XRECORD-NAME (2) SQ1284.2 +039500 XRECORD-NAME (3). SQ1284.2 +039600 MOVE "SQ128A" TO XPROGRAM-NAME (1) SQ1284.2 +039700 XPROGRAM-NAME (2) SQ1284.2 +039800 XPROGRAM-NAME (3). SQ1284.2 +039900 MOVE 000120 TO XRECORD-LENGTH (1) SQ1284.2 +040000 XRECORD-LENGTH (2) SQ1284.2 +040100 XRECORD-LENGTH (3). SQ1284.2 +040200 MOVE "RC" TO CHARS-OR-RECORDS (1) SQ1284.2 +040300 CHARS-OR-RECORDS (2). SQ1284.2 +040400 MOVE "CH" TO CHARS-OR-RECORDS (3). SQ1284.2 +040500 MOVE 0001 TO XBLOCK-SIZE (1). SQ1284.2 +040600 MOVE 0010 TO XBLOCK-SIZE (2). SQ1284.2 +040700 MOVE 0120 TO XBLOCK-SIZE (3). SQ1284.2 +040800 MOVE 0750 TO RECORDS-IN-FILE (1) SQ1284.2 +040900 RECORDS-IN-FILE (2) SQ1284.2 +041000 RECORDS-IN-FILE (3). SQ1284.2 +041100 MOVE "SQ" TO XFILE-ORGANIZATION (1) SQ1284.2 +041200 XFILE-ORGANIZATION (2) SQ1284.2 +041300 XFILE-ORGANIZATION (3). SQ1284.2 +041400 MOVE "S" TO XLABEL-TYPE (1) SQ1284.2 +041500 XLABEL-TYPE (2) SQ1284.2 +041600 XLABEL-TYPE (3). SQ1284.2 +041700 OPN-TEST-GF-01. SQ1284.2 +041800 OPEN OUTPUT SQ-FS1 SQ1284.2 +041900 SQ-FS2. SQ1284.2 +042000 MOVE 00001 TO XRECORD-NUMBER (1) SQ1284.2 +042100 XRECORD-NUMBER (2). SQ1284.2 +042200 OPN-TEST-GF-01-1. SQ1284.2 +042300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1284.2 +042400 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ1284.2 +042500 WRITE SQ-FS1R1-F-G-120. SQ1284.2 +042600 WRITE SQ-FS2R1-F-G-120. SQ1284.2 +042700 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ1284.2 +042800 GO TO OPN-WRITE-GF-01. SQ1284.2 +042900 ADD 1 TO XRECORD-NUMBER (1). SQ1284.2 +043000 ADD 1 TO XRECORD-NUMBER (2). SQ1284.2 +043100 GO TO OPN-TEST-GF-01-1. SQ1284.2 +043200 OPN-WRITE-GF-01. SQ1284.2 +043300 MOVE "OPEN OUT 1 & 2 " TO FEATURE. SQ1284.2 +043400 MOVE "OPN-TEST-GF-01" TO PAR-NAME. SQ1284.2 +043500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1284.2 +043600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ1284.2 +043700 PERFORM PRINT-DETAIL. SQ1284.2 +043800 PERFORM PASS. SQ1284.2 +043900 MOVE "OPN-TEST-GF-02" TO PAR-NAME. SQ1284.2 +044000 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1284.2 +044100 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ1284.2 +044200 PERFORM PRINT-DETAIL. SQ1284.2 +044300 CLOSE-INIT-GF-01. SQ1284.2 +044400* THIS TEST CLOSES THE TWO OUTPUT FILES FROM SQ1284.2 +044500* SEQ-TEST-001 WITH ONE CLOSE STATEMENT. SQ1284.2 +044600 CLOSE SQ-FS1, SQ1284.2 +044700 SQ-FS2. SQ1284.2 +044800 CLOSE-WRITE-GF-01. SQ1284.2 +044900 MOVE "CLOSE FILE 1 & 2 " TO FEATURE. SQ1284.2 +045000 MOVE "CLOSE-TEST-GF-01" TO PAR-NAME. SQ1284.2 +045100 MOVE SPACES TO CORRECT-A. SQ1284.2 +045200 PERFORM PASS. SQ1284.2 +045300 PERFORM PRINT-DETAIL. SQ1284.2 +045400 OPEN-TEST-GF-02. SQ1284.2 +045500* THIS TEST OPENS FOR INPUT THE TWO FILES CREATED IN SQ1284.2 +045600* SEQ-TEST-001. SQ1284.2 +045700 OPEN INPUT SQ-FS1, SQ1284.2 +045800 SQ-FS2. SQ1284.2 +045900 MOVE "OPEN INPUT 1 & 2" TO FEATURE. SQ1284.2 +046000 MOVE "OPEN-TEST-GF-02" TO PAR-NAME. SQ1284.2 +046100 PERFORM PASS. SQ1284.2 +046200 PERFORM PRINT-DETAIL. SQ1284.2 +046300 READ-TEST-F1-01. SQ1284.2 +046400* THIS PART OF THE TEST READS AND VALIDATES ONE SQ1284.2 +046500* RECORD FROM FILES SQ-FS1 AND SQ-FS2. SQ1284.2 +046600 READ SQ-FS1 AT END GO TO READ-FAIL-F1-01. SQ1284.2 +046700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ1284.2 +046800 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ1284.2 +046900 GO TO READ-FAIL-F1-01. SQ1284.2 +047000 IF XRECORD-NUMBER (1) NOT EQUAL TO 1 SQ1284.2 +047100 GO TO READ-FAIL-F1-01. SQ1284.2 +047200 GO TO READ-PASS-F1-01. SQ1284.2 +047300 READ-FAIL-F1-01. SQ1284.2 +047400 MOVE "ERRORS IN READING SQ-FS1; VII-44, 4.4.2 " TO RE-MARK.SQ1284.2 +047500 PERFORM FAIL. SQ1284.2 +047600 GO TO READ-WRITE-F1-01. SQ1284.2 +047700 READ-PASS-F1-01. SQ1284.2 +047800 PERFORM PASS. SQ1284.2 +047900 MOVE "FIRST RECORD IS VALID" TO RE-MARK. SQ1284.2 +048000 READ-WRITE-F1-01. SQ1284.2 +048100 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ1284.2 +048200 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ1284.2 +048300 PERFORM PRINT-DETAIL. SQ1284.2 +048400 READ-TEST-F1-02. SQ1284.2 +048500 READ SQ-FS2 AT END GO TO READ-FAIL-F1-02. SQ1284.2 +048600 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ1284.2 +048700 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ1284.2 +048800 GO TO READ-FAIL-F1-02. SQ1284.2 +048900 IF XRECORD-NUMBER (2) NOT EQUAL TO 1 SQ1284.2 +049000 GO TO READ-FAIL-F1-02. SQ1284.2 +049100 GO TO READ-PASS-F1-02. SQ1284.2 +049200 READ-FAIL-F1-02. SQ1284.2 +049300 MOVE "ERRORS IN READING SQ-FS2; VII-44, 4.4.2 " TO RE-MARK.SQ1284.2 +049400 PERFORM FAIL. SQ1284.2 +049500 GO TO READ-WRITE-F1-02. SQ1284.2 +049600 READ-PASS-F1-02. SQ1284.2 +049700 PERFORM PASS. SQ1284.2 +049800 MOVE "FIRST RECORD IS VALID" TO RE-MARK. SQ1284.2 +049900 READ-WRITE-F1-02. SQ1284.2 +050000 MOVE "READ-TEST-F1" TO PAR-NAME. SQ1284.2 +050100 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. SQ1284.2 +050200 PERFORM PRINT-DETAIL. SQ1284.2 +050300 OPEN-INIT-03. SQ1284.2 +050400 CLOSE SQ-FS1. SQ1284.2 +050500 OPEN-TEST-GF-03. SQ1284.2 +050600* THIS TEST OPENS A FILE FOR INPUT AND A FILE FOR SQ1284.2 +050700* OUTPUT WITH THE SAME OPEN STATEMENT. SQ1284.2 +050800 OPEN INPUT SQ-FS1 SQ1284.2 +050900 OUTPUT SQ-FS3. SQ1284.2 +051000 MOVE 00001 TO XRECORD-NUMBER (3). SQ1284.2 +051100 OPEN-TEST-GF-03-1. SQ1284.2 +051200 MOVE FILE-RECORD-INFO-P1-120 (3) TO SQ-FS3R1-F-G-120. SQ1284.2 +051300 WRITE SQ-FS3R1-F-G-120. SQ1284.2 +051400 IF XRECORD-NUMBER (3) EQUAL TO 750 SQ1284.2 +051500 GO TO OPEN-WRITE-GF-03. SQ1284.2 +051600 ADD 1 TO XRECORD-NUMBER (3). SQ1284.2 +051700 GO TO OPEN-TEST-GF-03-1. SQ1284.2 +051800 OPEN-WRITE-GF-03. SQ1284.2 +051900 MOVE "OPEN FILE SQ-FS3" TO FEATURE. SQ1284.2 +052000 MOVE "OPEN-TEST-GF-03" TO PAR-NAME. SQ1284.2 +052100 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ1284.2 +052200 MOVE XRECORD-NUMBER (3) TO CORRECT-18V0. SQ1284.2 +052300 PERFORM PASS. SQ1284.2 +052400 PERFORM PRINT-DETAIL. SQ1284.2 +052500 CLOSE-TEST-02. SQ1284.2 +052600* THIS TEST CLOSES ONE OUTPUT FILE AND TWO INPUT FILESSQ1284.2 +052700* WITH ONE CLOSE STATEMENT. SQ1284.2 +052800 CLOSE SQ-FS1, SQ1284.2 +052900 SQ-FS2, SQ1284.2 +053000 SQ-FS3. SQ1284.2 +053100 CLOSE-WRITE-02. SQ1284.2 +053200 MOVE "CLOSE FILE SQ-FS1" TO FEATURE. SQ1284.2 +053300 MOVE "CLOSE-TEST-02 " TO PAR-NAME. SQ1284.2 +053400 MOVE SPACES TO CORRECT-A. SQ1284.2 +053500 PERFORM PASS. SQ1284.2 +053600 PERFORM PRINT-DETAIL. SQ1284.2 +053700 MOVE "CLOSE FILE SQ-FS2" TO FEATURE. SQ1284.2 +053800 MOVE "CLOSE-TEST-02 " TO PAR-NAME. SQ1284.2 +053900 PERFORM PASS. SQ1284.2 +054000 PERFORM PRINT-DETAIL. SQ1284.2 +054100 MOVE "CLOSE FILE SQ-FS3" TO FEATURE. SQ1284.2 +054200 MOVE "CLOSE-TEST-02 " TO PAR-NAME. SQ1284.2 +054300 PERFORM PASS. SQ1284.2 +054400 PERFORM PRINT-DETAIL. SQ1284.2 +054500 SQ128A-END-ROUTINE. SQ1284.2 +054600 MOVE " END OF SQ128A VALIDATION TESTS" TO PRINT-REC. SQ1284.2 +054700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ1284.2 +054800 TERMINATE-SQ128A. SQ1284.2 +054900 EXIT. SQ1284.2 +055000 CCVS-EXIT SECTION. SQ1284.2 +055100 CCVS-999999. SQ1284.2 +055200 GO TO CLOSE-FILES. SQ1284.2 diff --git a/tests/cobol85/SQ/SQ129A.CBL b/tests/cobol85/SQ/SQ129A.CBL new file mode 100755 index 00000000..92901342 --- /dev/null +++ b/tests/cobol85/SQ/SQ129A.CBL @@ -0,0 +1,625 @@ +000100 IDENTIFICATION DIVISION. SQ1294.2 +000200 PROGRAM-ID. SQ1294.2 +000300 SQ129A. SQ1294.2 +000400**************************************************************** SQ1294.2 +000500* * SQ1294.2 +000600* VALIDATION FOR:- * SQ1294.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1294.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1294.2 +000900* REVISED 1986, AUGUST * SQ1294.2 +001000* * SQ1294.2 +001100* CREATION DATE / VALIDATION DATE * SQ1294.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1294.2 +001300* * SQ1294.2 +001400**************************************************************** SQ1294.2 +001500* * SQ1294.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1294.2 +001700* * SQ1294.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1294.2 +001900* X-55 SYSTEM PRINTER * SQ1294.2 +002000* X-82 SOURCE-COMPUTER * SQ1294.2 +002100* X-83 OBJECT-COMPUTER. * SQ1294.2 +002200* * SQ1294.2 +002300* * SQ1294.2 +002400**************************************************************** SQ1294.2 +002500* * SQ1294.2 +002600* SQ129A ATTEMPTS TO OPEN FOR INPUT A MAGNETIC TAPE FILE * SQ1294.2 +002700* WHICH IS NOT PRESENT. THIS SHOULD RESULT IN A PERMANENT * SQ1294.2 +002800* ERROR AND AN I-O STATUS OF "35". * SQ1294.2 +002900* * SQ1294.2 +003000* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ1294.2 +003100* THE NEW PROGRAMS ARE SQ141A AND SQ142A. * SQ1294.2 +003200* * SQ1294.2 +003300* * SQ1294.2 +003400**************************************************************** SQ1294.2 +003500* SQ1294.2 +003600 ENVIRONMENT DIVISION. SQ1294.2 +003700 CONFIGURATION SECTION. SQ1294.2 +003800 SOURCE-COMPUTER. SQ1294.2 +003900 Linux. SQ1294.2 +004000 OBJECT-COMPUTER. SQ1294.2 +004100 Linux. SQ1294.2 +004200* SQ1294.2 +004300 INPUT-OUTPUT SECTION. SQ1294.2 +004400 FILE-CONTROL. SQ1294.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ1294.2 +004600 "report.log". SQ1294.2 +004700* SQ1294.2 +004800*P SELECT RAW-DATA ASSIGN TO SQ1294.2 +004900*P "XXXXX062" SQ1294.2 +005000*P ORGANIZATION IS INDEXED SQ1294.2 +005100*P ACCESS MODE IS RANDOM SQ1294.2 +005200*P RECORD-KEY IS RAW-DATA-KEY. SQ1294.2 +005300*P SQ1294.2 +005400 SELECT SQ-FS1 ASSIGN TO SQ1294.2 +005500 "XXXXX001" SQ1294.2 +005600 FILE STATUS IS SQ-FS1-STATUS. SQ1294.2 +005700* SQ1294.2 +005800* SQ1294.2 +005900 DATA DIVISION. SQ1294.2 +006000 FILE SECTION. SQ1294.2 +006100 FD PRINT-FILE SQ1294.2 +006200*C LABEL RECORDS SQ1294.2 +006300*C OMITTED SQ1294.2 +006400*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1294.2 +006500 . SQ1294.2 +006600 01 PRINT-REC PICTURE X(120). SQ1294.2 +006700 01 DUMMY-RECORD PICTURE X(120). SQ1294.2 +006800*P SQ1294.2 +006900*PD RAW-DATA. SQ1294.2 +007000*P1 RAW-DATA-SATZ. SQ1294.2 +007100*P 05 RAW-DATA-KEY PIC X(6). SQ1294.2 +007200*P 05 C-DATE PIC 9(6). SQ1294.2 +007300*P 05 C-TIME PIC 9(8). SQ1294.2 +007400*P 05 NO-OF-TESTS PIC 99. SQ1294.2 +007500*P 05 C-OK PIC 999. SQ1294.2 +007600*P 05 C-ALL PIC 999. SQ1294.2 +007700*P 05 C-FAIL PIC 999. SQ1294.2 +007800*P 05 C-DELETED PIC 999. SQ1294.2 +007900*P 05 C-INSPECT PIC 999. SQ1294.2 +008000*P 05 C-NOTE PIC X(13). SQ1294.2 +008100*P 05 C-INDENT PIC X. SQ1294.2 +008200*P 05 C-ABORT PIC X(8). SQ1294.2 +008300* SQ1294.2 +008400 FD SQ-FS1 SQ1294.2 +008500*C LABEL RECORD IS STANDARD SQ1294.2 +008600 . SQ1294.2 +008700 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1294.2 +008800* SQ1294.2 +008900 WORKING-STORAGE SECTION. SQ1294.2 +009000* SQ1294.2 +009100*************************************************************** SQ1294.2 +009200* * SQ1294.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1294.2 +009400* * SQ1294.2 +009500*************************************************************** SQ1294.2 +009600* SQ1294.2 +009700 01 SQ-FS1-STATUS. SQ1294.2 +009800 03 SQ-FS1-KEY-1 PIC X. SQ1294.2 +009900 03 SQ-FS1-KEY-2 PIC X. SQ1294.2 +010000* SQ1294.2 +010100 01 DECL-EXEC-SW PIC 9. SQ1294.2 +010200* SQ1294.2 +010300*************************************************************** SQ1294.2 +010400* * SQ1294.2 +010500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1294.2 +010600* * SQ1294.2 +010700*************************************************************** SQ1294.2 +010800* SQ1294.2 +010900 01 REC-SKEL-SUB PIC 99. SQ1294.2 +011000* SQ1294.2 +011100 01 FILE-RECORD-INFORMATION-REC. SQ1294.2 +011200 03 FILE-RECORD-INFO-SKELETON. SQ1294.2 +011300 05 FILLER PICTURE X(48) VALUE SQ1294.2 +011400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1294.2 +011500 05 FILLER PICTURE X(46) VALUE SQ1294.2 +011600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1294.2 +011700 05 FILLER PICTURE X(26) VALUE SQ1294.2 +011800 ",LFIL=000000,ORG= ,LBLR= ". SQ1294.2 +011900 05 FILLER PICTURE X(37) VALUE SQ1294.2 +012000 ",RECKEY= ". SQ1294.2 +012100 05 FILLER PICTURE X(38) VALUE SQ1294.2 +012200 ",ALTKEY1= ". SQ1294.2 +012300 05 FILLER PICTURE X(38) VALUE SQ1294.2 +012400 ",ALTKEY2= ". SQ1294.2 +012500 05 FILLER PICTURE X(7) VALUE SPACE.SQ1294.2 +012600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1294.2 +012700 05 FILE-RECORD-INFO-P1-120. SQ1294.2 +012800 07 FILLER PIC X(5). SQ1294.2 +012900 07 XFILE-NAME PIC X(6). SQ1294.2 +013000 07 FILLER PIC X(8). SQ1294.2 +013100 07 XRECORD-NAME PIC X(6). SQ1294.2 +013200 07 FILLER PIC X(1). SQ1294.2 +013300 07 REELUNIT-NUMBER PIC 9(1). SQ1294.2 +013400 07 FILLER PIC X(7). SQ1294.2 +013500 07 XRECORD-NUMBER PIC 9(6). SQ1294.2 +013600 07 FILLER PIC X(6). SQ1294.2 +013700 07 UPDATE-NUMBER PIC 9(2). SQ1294.2 +013800 07 FILLER PIC X(5). SQ1294.2 +013900 07 ODO-NUMBER PIC 9(4). SQ1294.2 +014000 07 FILLER PIC X(5). SQ1294.2 +014100 07 XPROGRAM-NAME PIC X(5). SQ1294.2 +014200 07 FILLER PIC X(7). SQ1294.2 +014300 07 XRECORD-LENGTH PIC 9(6). SQ1294.2 +014400 07 FILLER PIC X(7). SQ1294.2 +014500 07 CHARS-OR-RECORDS PIC X(2). SQ1294.2 +014600 07 FILLER PIC X(1). SQ1294.2 +014700 07 XBLOCK-SIZE PIC 9(4). SQ1294.2 +014800 07 FILLER PIC X(6). SQ1294.2 +014900 07 RECORDS-IN-FILE PIC 9(6). SQ1294.2 +015000 07 FILLER PIC X(5). SQ1294.2 +015100 07 XFILE-ORGANIZATION PIC X(2). SQ1294.2 +015200 07 FILLER PIC X(6). SQ1294.2 +015300 07 XLABEL-TYPE PIC X(1). SQ1294.2 +015400 05 FILE-RECORD-INFO-P121-240. SQ1294.2 +015500 07 FILLER PIC X(8). SQ1294.2 +015600 07 XRECORD-KEY PIC X(29). SQ1294.2 +015700 07 FILLER PIC X(9). SQ1294.2 +015800 07 ALTERNATE-KEY1 PIC X(29). SQ1294.2 +015900 07 FILLER PIC X(9). SQ1294.2 +016000 07 ALTERNATE-KEY2 PIC X(29). SQ1294.2 +016100 07 FILLER PIC X(7). SQ1294.2 +016200* SQ1294.2 +016300 01 TEST-RESULTS. SQ1294.2 +016400 02 FILLER PIC X VALUE SPACE. SQ1294.2 +016500 02 FEATURE PIC X(24) VALUE SPACE. SQ1294.2 +016600 02 FILLER PIC X VALUE SPACE. SQ1294.2 +016700 02 P-OR-F PIC X(5) VALUE SPACE. SQ1294.2 +016800 02 FILLER PIC X VALUE SPACE. SQ1294.2 +016900 02 PAR-NAME. SQ1294.2 +017000 03 FILLER PIC X(14) VALUE SPACE. SQ1294.2 +017100 03 PARDOT-X PIC X VALUE SPACE. SQ1294.2 +017200 03 DOTVALUE PIC 99 VALUE ZERO. SQ1294.2 +017300 02 FILLER PIC X(9) VALUE SPACE. SQ1294.2 +017400 02 RE-MARK PIC X(61). SQ1294.2 +017500 01 TEST-COMPUTED. SQ1294.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SQ1294.2 +017700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1294.2 +017800 02 COMPUTED-X. SQ1294.2 +017900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1294.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1294.2 +018100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1294.2 +018200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1294.2 +018300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1294.2 +018400 03 CM-18V0 REDEFINES COMPUTED-A. SQ1294.2 +018500 04 COMPUTED-18V0 PIC -9(18). SQ1294.2 +018600 04 FILLER PIC X. SQ1294.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SQ1294.2 +018800 01 TEST-CORRECT. SQ1294.2 +018900 02 FILLER PIC X(30) VALUE SPACE. SQ1294.2 +019000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1294.2 +019100 02 CORRECT-X. SQ1294.2 +019200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1294.2 +019300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1294.2 +019400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1294.2 +019500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1294.2 +019600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1294.2 +019700 03 CR-18V0 REDEFINES CORRECT-A. SQ1294.2 +019800 04 CORRECT-18V0 PIC -9(18). SQ1294.2 +019900 04 FILLER PIC X. SQ1294.2 +020000 03 FILLER PIC X(2) VALUE SPACE. SQ1294.2 +020100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1294.2 +020200 01 CCVS-C-1. SQ1294.2 +020300 02 FILLER PIC IS X(4) VALUE SPACE. SQ1294.2 +020400 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1294.2 +020500- "SS PARAGRAPH-NAME SQ1294.2 +020600- " REMARKS". SQ1294.2 +020700 02 FILLER PIC X(17) VALUE SPACE. SQ1294.2 +020800 01 CCVS-C-2. SQ1294.2 +020900 02 FILLER PIC XXXX VALUE SPACE. SQ1294.2 +021000 02 FILLER PIC X(6) VALUE "TESTED". SQ1294.2 +021100 02 FILLER PIC X(16) VALUE SPACE. SQ1294.2 +021200 02 FILLER PIC X(4) VALUE "FAIL". SQ1294.2 +021300 02 FILLER PIC X(90) VALUE SPACE. SQ1294.2 +021400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1294.2 +021500 01 REC-CT PIC 99 VALUE ZERO. SQ1294.2 +021600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1294.2 +021700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1294.2 +021800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1294.2 +021900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1294.2 +022000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1294.2 +022100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1294.2 +022200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1294.2 +022300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1294.2 +022400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1294.2 +022500 01 CCVS-H-1. SQ1294.2 +022600 02 FILLER PIC X(39) VALUE SPACES. SQ1294.2 +022700 02 FILLER PIC X(42) VALUE SQ1294.2 +022800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1294.2 +022900 02 FILLER PIC X(39) VALUE SPACES. SQ1294.2 +023000 01 CCVS-H-2A. SQ1294.2 +023100 02 FILLER PIC X(40) VALUE SPACE. SQ1294.2 +023200 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1294.2 +023300 02 FILLER PIC XXXX VALUE SQ1294.2 +023400 "4.2 ". SQ1294.2 +023500 02 FILLER PIC X(28) VALUE SQ1294.2 +023600 " COPY - NOT FOR DISTRIBUTION". SQ1294.2 +023700 02 FILLER PIC X(41) VALUE SPACE. SQ1294.2 +023800* SQ1294.2 +023900 01 CCVS-H-2B. SQ1294.2 +024000 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1294.2 +024100 02 TEST-ID PIC X(9). SQ1294.2 +024200 02 FILLER PIC X(4) VALUE " IN ". SQ1294.2 +024300 02 FILLER PIC X(12) VALUE SQ1294.2 +024400 " HIGH ". SQ1294.2 +024500 02 FILLER PIC X(22) VALUE SQ1294.2 +024600 " LEVEL VALIDATION FOR ". SQ1294.2 +024700 02 FILLER PIC X(58) VALUE SQ1294.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1294.2 +024900 01 CCVS-H-3. SQ1294.2 +025000 02 FILLER PIC X(34) VALUE SQ1294.2 +025100 " FOR OFFICIAL USE ONLY ". SQ1294.2 +025200 02 FILLER PIC X(58) VALUE SQ1294.2 +025300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1294.2 +025400 02 FILLER PIC X(28) VALUE SQ1294.2 +025500 " COPYRIGHT 1985,1986 ". SQ1294.2 +025600 01 CCVS-E-1. SQ1294.2 +025700 02 FILLER PIC X(52) VALUE SPACE. SQ1294.2 +025800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1294.2 +025900 02 ID-AGAIN PIC X(9). SQ1294.2 +026000 02 FILLER PIC X(45) VALUE SPACES. SQ1294.2 +026100 01 CCVS-E-2. SQ1294.2 +026200 02 FILLER PIC X(31) VALUE SPACE. SQ1294.2 +026300 02 FILLER PIC X(21) VALUE SPACE. SQ1294.2 +026400 02 CCVS-E-2-2. SQ1294.2 +026500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1294.2 +026600 03 FILLER PIC X VALUE SPACE. SQ1294.2 +026700 03 ENDER-DESC PIC X(44) VALUE SQ1294.2 +026800 "ERRORS ENCOUNTERED". SQ1294.2 +026900 01 CCVS-E-3. SQ1294.2 +027000 02 FILLER PIC X(22) VALUE SQ1294.2 +027100 " FOR OFFICIAL USE ONLY". SQ1294.2 +027200 02 FILLER PIC X(12) VALUE SPACE. SQ1294.2 +027300 02 FILLER PIC X(58) VALUE SQ1294.2 +027400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1294.2 +027500 02 FILLER PIC X(8) VALUE SPACE. SQ1294.2 +027600 02 FILLER PIC X(20) VALUE SQ1294.2 +027700 " COPYRIGHT 1985,1986". SQ1294.2 +027800 01 CCVS-E-4. SQ1294.2 +027900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1294.2 +028000 02 FILLER PIC X(4) VALUE " OF ". SQ1294.2 +028100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1294.2 +028200 02 FILLER PIC X(40) VALUE SQ1294.2 +028300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1294.2 +028400 01 XXINFO. SQ1294.2 +028500 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1294.2 +028600 02 INFO-TEXT. SQ1294.2 +028700 04 FILLER PIC X(8) VALUE SPACE. SQ1294.2 +028800 04 XXCOMPUTED PIC X(20). SQ1294.2 +028900 04 FILLER PIC X(5) VALUE SPACE. SQ1294.2 +029000 04 XXCORRECT PIC X(20). SQ1294.2 +029100 02 INF-ANSI-REFERENCE PIC X(48). SQ1294.2 +029200 01 HYPHEN-LINE. SQ1294.2 +029300 02 FILLER PIC IS X VALUE IS SPACE. SQ1294.2 +029400 02 FILLER PIC IS X(65) VALUE IS "************************SQ1294.2 +029500- "*****************************************". SQ1294.2 +029600 02 FILLER PIC IS X(54) VALUE IS "************************SQ1294.2 +029700- "******************************". SQ1294.2 +029800 01 CCVS-PGM-ID PIC X(9) VALUE SQ1294.2 +029900 "SQ129A". SQ1294.2 +030000* SQ1294.2 +030100* SQ1294.2 +030200 PROCEDURE DIVISION. SQ1294.2 +030300 DECLARATIVES. SQ1294.2 +030400 SQ129A-DECLARATIVE-001-SECT SECTION. SQ1294.2 +030500 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. SQ1294.2 +030600 INPUT-ERROR-PROCEDURE. SQ1294.2 +030700 IF DECL-EXEC-SW NOT = 9 SQ1294.2 +030800 GO TO NOT-DECL-9. SQ1294.2 +030900* SQ1294.2 +031000* DECLARATIVE PROCEDURE ENTERED FROM OPEN INPUT SQ1294.2 +031100* SQ1294.2 +031200 DECL-OPEN-TEST. SQ1294.2 +031300 MOVE "DECL-OPEN-TEST" TO PAR-NAME. SQ1294.2 +031400 MOVE 1 TO REC-CT. SQ1294.2 +031500 IF SQ-FS1-STATUS = "35" SQ1294.2 +031600 PERFORM DECL-PASS SQ1294.2 +031700 ELSE SQ1294.2 +031800 MOVE "35" TO CORRECT-A SQ1294.2 +031900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1294.2 +032000 MOVE "INCORRECT FILE STATUS FOR NON-AVAILABLE FILE" SQ1294.2 +032100 TO RE-MARK SQ1294.2 +032200 PERFORM DECL-FAIL. SQ1294.2 +032300 MOVE SPACE TO DUMMY-RECORD SQ1294.2 +032400 PERFORM DECL-WRITE-LINE SQ1294.2 +032500 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1294.2 +032600 GO TO END-DECLS. SQ1294.2 +032700* SQ1294.2 +032800* SQ1294.2 +032900 NOT-DECL-9. SQ1294.2 +033000 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1294.2 +033100 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1294.2 +033200 MOVE 9 TO CORRECT-18V0. SQ1294.2 +033300 PERFORM DECL-FAIL. SQ1294.2 +033400 GO TO END-DECLS. SQ1294.2 +033500* SQ1294.2 +033600* SQ1294.2 +033700* SQ1294.2 +033800 DECL-PASS. SQ1294.2 +033900 MOVE "PASS " TO P-OR-F. SQ1294.2 +034000 ADD 1 TO PASS-COUNTER. SQ1294.2 +034100 PERFORM DECL-PRINT-DETAIL. SQ1294.2 +034200* SQ1294.2 +034300 DECL-FAIL. SQ1294.2 +034400 MOVE "FAIL*" TO P-OR-F. SQ1294.2 +034500 ADD 1 TO ERROR-COUNTER. SQ1294.2 +034600 PERFORM DECL-PRINT-DETAIL. SQ1294.2 +034700* SQ1294.2 +034800 DECL-PRINT-DETAIL. SQ1294.2 +034900 IF REC-CT NOT EQUAL TO ZERO SQ1294.2 +035000 MOVE "." TO PARDOT-X SQ1294.2 +035100 MOVE REC-CT TO DOTVALUE. SQ1294.2 +035200 MOVE TEST-RESULTS TO PRINT-REC. SQ1294.2 +035300 PERFORM DECL-WRITE-LINE. SQ1294.2 +035400 IF P-OR-F EQUAL TO "FAIL*" SQ1294.2 +035500 PERFORM DECL-WRITE-LINE SQ1294.2 +035600 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1294.2 +035700 ELSE SQ1294.2 +035800 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1294.2 +035900 MOVE SPACE TO P-OR-F. SQ1294.2 +036000 MOVE SPACE TO COMPUTED-X. SQ1294.2 +036100 MOVE SPACE TO CORRECT-X. SQ1294.2 +036200 IF REC-CT EQUAL TO ZERO SQ1294.2 +036300 MOVE SPACE TO PAR-NAME. SQ1294.2 +036400 MOVE SPACE TO RE-MARK. SQ1294.2 +036500* SQ1294.2 +036600 DECL-WRITE-LINE. SQ1294.2 +036700 ADD 1 TO RECORD-COUNT. SQ1294.2 +036800 IF RECORD-COUNT GREATER 50 SQ1294.2 +036900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1294.2 +037000 MOVE SPACE TO DUMMY-RECORD SQ1294.2 +037100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1294.2 +037200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1294.2 +037300 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1294.2 +037400 PERFORM DECL-WRT-LN 2 TIMES SQ1294.2 +037500 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1294.2 +037600 PERFORM DECL-WRT-LN SQ1294.2 +037700 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1294.2 +037800 MOVE ZERO TO RECORD-COUNT. SQ1294.2 +037900 PERFORM DECL-WRT-LN. SQ1294.2 +038000* SQ1294.2 +038100 DECL-WRT-LN. SQ1294.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1294.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ1294.2 +038400* SQ1294.2 +038500 DECL-FAIL-ROUTINE. SQ1294.2 +038600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1294.2 +038700 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1294.2 +038800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1294.2 +038900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1294.2 +039000 MOVE XXINFO TO DUMMY-RECORD. SQ1294.2 +039100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1294.2 +039200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1294.2 +039300 GO TO DECL-FAIL-EX. SQ1294.2 +039400 DECL-FAIL-WRITE. SQ1294.2 +039500 MOVE TEST-COMPUTED TO PRINT-REC SQ1294.2 +039600 PERFORM DECL-WRITE-LINE SQ1294.2 +039700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1294.2 +039800 MOVE TEST-CORRECT TO PRINT-REC SQ1294.2 +039900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1294.2 +040000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1294.2 +040100 DECL-FAIL-EX. SQ1294.2 +040200 EXIT. SQ1294.2 +040300* SQ1294.2 +040400 DECL-BAIL. SQ1294.2 +040500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1294.2 +040600 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1294.2 +040700 DECL-BAIL-WRITE. SQ1294.2 +040800 MOVE CORRECT-A TO XXCORRECT. SQ1294.2 +040900 MOVE COMPUTED-A TO XXCOMPUTED. SQ1294.2 +041000 MOVE XXINFO TO DUMMY-RECORD. SQ1294.2 +041100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1294.2 +041200 DECL-BAIL-EX. SQ1294.2 +041300 EXIT. SQ1294.2 +041400* SQ1294.2 +041500 END-DECLS. SQ1294.2 +041600 MOVE ZERO TO DECL-EXEC-SW. SQ1294.2 +041700 END DECLARATIVES. SQ1294.2 +041800* SQ1294.2 +041900* SQ1294.2 +042000 CCVS1 SECTION. SQ1294.2 +042100 OPEN-FILES. SQ1294.2 +042200*P OPEN I-O RAW-DATA. SQ1294.2 +042300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1294.2 +042400*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1294.2 +042500*P MOVE "ABORTED " TO C-ABORT. SQ1294.2 +042600*P ADD 1 TO C-NO-OF-TESTS. SQ1294.2 +042700*P ACCEPT C-DATE FROM DATE. SQ1294.2 +042800*P ACCEPT C-TIME FROM TIME. SQ1294.2 +042900*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1294.2 +043000*PND-E-1. SQ1294.2 +043100*P CLOSE RAW-DATA. SQ1294.2 +043200 OPEN OUTPUT PRINT-FILE. SQ1294.2 +043300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1294.2 +043400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1294.2 +043500 MOVE SPACE TO TEST-RESULTS. SQ1294.2 +043600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1294.2 +043700 MOVE ZERO TO REC-SKEL-SUB. SQ1294.2 +043800 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1294.2 +043900 GO TO CCVS1-EXIT. SQ1294.2 +044000* SQ1294.2 +044100 CCVS-INIT-FILE. SQ1294.2 +044200 ADD 1 TO REC-SKL-SUB. SQ1294.2 +044300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1294.2 +044400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1294.2 +044500* SQ1294.2 +044600 CLOSE-FILES. SQ1294.2 +044700 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1294.2 +044800 CLOSE PRINT-FILE. SQ1294.2 +044900*P OPEN I-O RAW-DATA. SQ1294.2 +045000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1294.2 +045100*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1294.2 +045200*P MOVE "OK. " TO C-ABORT. SQ1294.2 +045300*P MOVE PASS-COUNTER TO C-OK. SQ1294.2 +045400*P MOVE ERROR-HOLD TO C-ALL. SQ1294.2 +045500*P MOVE ERROR-COUNTER TO C-FAIL. SQ1294.2 +045600*P MOVE DELETE-CNT TO C-DELETED. SQ1294.2 +045700*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1294.2 +045800*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1294.2 +045900*PND-E-2. SQ1294.2 +046000*P CLOSE RAW-DATA. SQ1294.2 +046100 TERMINATE-CCVS. SQ1294.2 +046200*S EXIT PROGRAM. SQ1294.2 +046300 STOP RUN. SQ1294.2 +046400* SQ1294.2 +046500 INSPT. SQ1294.2 +046600 MOVE "INSPT" TO P-OR-F. SQ1294.2 +046700 ADD 1 TO INSPECT-COUNTER. SQ1294.2 +046800 PERFORM PRINT-DETAIL. SQ1294.2 +046900 SQ1294.2 +047000 PASS. SQ1294.2 +047100 MOVE "PASS " TO P-OR-F. SQ1294.2 +047200 ADD 1 TO PASS-COUNTER. SQ1294.2 +047300 PERFORM PRINT-DETAIL. SQ1294.2 +047400* SQ1294.2 +047500 FAIL. SQ1294.2 +047600 MOVE "FAIL*" TO P-OR-F. SQ1294.2 +047700 ADD 1 TO ERROR-COUNTER. SQ1294.2 +047800 PERFORM PRINT-DETAIL. SQ1294.2 +047900* SQ1294.2 +048000 DE-LETE. SQ1294.2 +048100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1294.2 +048200 MOVE "*****" TO P-OR-F. SQ1294.2 +048300 ADD 1 TO DELETE-COUNTER. SQ1294.2 +048400 PERFORM PRINT-DETAIL. SQ1294.2 +048500* SQ1294.2 +048600 PRINT-DETAIL. SQ1294.2 +048700 IF REC-CT NOT EQUAL TO ZERO SQ1294.2 +048800 MOVE "." TO PARDOT-X SQ1294.2 +048900 MOVE REC-CT TO DOTVALUE. SQ1294.2 +049000 MOVE TEST-RESULTS TO PRINT-REC. SQ1294.2 +049100 PERFORM WRITE-LINE. SQ1294.2 +049200 IF P-OR-F EQUAL TO "FAIL*" SQ1294.2 +049300 PERFORM WRITE-LINE SQ1294.2 +049400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1294.2 +049500 ELSE SQ1294.2 +049600 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1294.2 +049700 MOVE SPACE TO P-OR-F. SQ1294.2 +049800 MOVE SPACE TO COMPUTED-X. SQ1294.2 +049900 MOVE SPACE TO CORRECT-X. SQ1294.2 +050000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1294.2 +050100 MOVE SPACE TO RE-MARK. SQ1294.2 +050200* SQ1294.2 +050300 HEAD-ROUTINE. SQ1294.2 +050400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +050500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +050600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1294.2 +050700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1294.2 +050800 COLUMN-NAMES-ROUTINE. SQ1294.2 +050900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1294.2 +051000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +051100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1294.2 +051200 END-ROUTINE. SQ1294.2 +051300 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1294.2 +051400 PERFORM WRITE-LINE 5 TIMES. SQ1294.2 +051500 END-RTN-EXIT. SQ1294.2 +051600 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1294.2 +051700 PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +051800* SQ1294.2 +051900 END-ROUTINE-1. SQ1294.2 +052000 ADD ERROR-COUNTER TO ERROR-HOLD SQ1294.2 +052100 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1294.2 +052200 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1294.2 +052300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1294.2 +052400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1294.2 +052500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1294.2 +052600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1294.2 +052700 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1294.2 +052800 PERFORM WRITE-LINE. SQ1294.2 +052900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1294.2 +053000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1294.2 +053100 MOVE "NO " TO ERROR-TOTAL SQ1294.2 +053200 ELSE SQ1294.2 +053300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1294.2 +053400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1294.2 +053500 PERFORM WRITE-LINE. SQ1294.2 +053600 END-ROUTINE-13. SQ1294.2 +053700 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1294.2 +053800 MOVE "NO " TO ERROR-TOTAL SQ1294.2 +053900 ELSE SQ1294.2 +054000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1294.2 +054100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1294.2 +054200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1294.2 +054300 PERFORM WRITE-LINE. SQ1294.2 +054400 IF INSPECT-COUNTER EQUAL TO ZERO SQ1294.2 +054500 MOVE "NO " TO ERROR-TOTAL SQ1294.2 +054600 ELSE SQ1294.2 +054700 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1294.2 +054800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1294.2 +054900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1294.2 +055000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1294.2 +055100* SQ1294.2 +055200 WRITE-LINE. SQ1294.2 +055300 ADD 1 TO RECORD-COUNT. SQ1294.2 +055400 IF RECORD-COUNT GREATER 50 SQ1294.2 +055500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1294.2 +055600 MOVE SPACE TO DUMMY-RECORD SQ1294.2 +055700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1294.2 +055800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1294.2 +055900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1294.2 +056000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1294.2 +056100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1294.2 +056200 MOVE ZERO TO RECORD-COUNT. SQ1294.2 +056300 PERFORM WRT-LN. SQ1294.2 +056400* SQ1294.2 +056500 WRT-LN. SQ1294.2 +056600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1294.2 +056700 MOVE SPACE TO DUMMY-RECORD. SQ1294.2 +056800 BLANK-LINE-PRINT. SQ1294.2 +056900 PERFORM WRT-LN. SQ1294.2 +057000 FAIL-ROUTINE. SQ1294.2 +057100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1294.2 +057200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1294.2 +057300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1294.2 +057400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1294.2 +057500 MOVE XXINFO TO DUMMY-RECORD. SQ1294.2 +057600 PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +057700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1294.2 +057800 GO TO FAIL-ROUTINE-EX. SQ1294.2 +057900 FAIL-ROUTINE-WRITE. SQ1294.2 +058000 MOVE TEST-COMPUTED TO PRINT-REC SQ1294.2 +058100 PERFORM WRITE-LINE SQ1294.2 +058200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1294.2 +058300 MOVE TEST-CORRECT TO PRINT-REC SQ1294.2 +058400 PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +058500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1294.2 +058600 FAIL-ROUTINE-EX. SQ1294.2 +058700 EXIT. SQ1294.2 +058800 BAIL-OUT. SQ1294.2 +058900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1294.2 +059000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1294.2 +059100 BAIL-OUT-WRITE. SQ1294.2 +059200 MOVE CORRECT-A TO XXCORRECT. SQ1294.2 +059300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1294.2 +059400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1294.2 +059500 MOVE XXINFO TO DUMMY-RECORD. SQ1294.2 +059600 PERFORM WRITE-LINE 2 TIMES. SQ1294.2 +059700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1294.2 +059800 BAIL-OUT-EX. SQ1294.2 +059900 EXIT. SQ1294.2 +060000 CCVS1-EXIT. SQ1294.2 +060100 EXIT. SQ1294.2 +060200* SQ1294.2 +060300**************************************************************** SQ1294.2 +060400* * SQ1294.2 +060500* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1294.2 +060600* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1294.2 +060700* * SQ1294.2 +060800**************************************************************** SQ1294.2 +060900* SQ1294.2 +061000 SECT-SQ129A-MAIN SECTION. SQ1294.2 +061100 OPEN-INIT-01. SQ1294.2 +061200* SQ1294.2 +061300* THIS PROGRAM ATTEMPTS TO OPEN A FILE WHICH IS NOT SQ1294.2 +061400* PRESENT AND AVAILABLE TO IT. SQ1294.2 +061500* SQ1294.2 +061600 MOVE 1 TO REC-CT SQ1294.2 +061700 MOVE "OPEN ABSENT FILE INPUT" TO FEATURE SQ1294.2 +061800 MOVE "OPEN-TEST-01" TO PAR-NAME SQ1294.2 +061900 MOVE 9 TO DECL-EXEC-SW SQ1294.2 +062000 MOVE "**" TO SQ-FS1-STATUS. SQ1294.2 +062100 OPEN-TEST-01. SQ1294.2 +062200 OPEN INPUT SQ-FS1. SQ1294.2 +062300 CCVS-EXIT SECTION. SQ1294.2 +062400 CCVS-999999. SQ1294.2 +062500 GO TO CLOSE-FILES. SQ1294.2 diff --git a/tests/cobol85/SQ/SQ130A.CBL b/tests/cobol85/SQ/SQ130A.CBL new file mode 100755 index 00000000..c95eb175 --- /dev/null +++ b/tests/cobol85/SQ/SQ130A.CBL @@ -0,0 +1,524 @@ +000100 IDENTIFICATION DIVISION. SQ1304.2 +000200 PROGRAM-ID. SQ1304.2 +000300 SQ130A. SQ1304.2 +000400**************************************************************** SQ1304.2 +000500* * SQ1304.2 +000600* VALIDATION FOR:- * SQ1304.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1304.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1304.2 +000900* REVISED 1986, AUGUST * SQ1304.2 +001000* * SQ1304.2 +001100* CREATION DATE / VALIDATION DATE * SQ1304.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1304.2 +001300* * SQ1304.2 +001400**************************************************************** SQ1304.2 +001500* * SQ1304.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1304.2 +001700* * SQ1304.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1304.2 +001900* X-55 SYSTEM PRINTER * SQ1304.2 +002000* X-82 SOURCE-COMPUTER * SQ1304.2 +002100* X-83 OBJECT-COMPUTER. * SQ1304.2 +002200* * SQ1304.2 +002300* * SQ1304.2 +002400**************************************************************** SQ1304.2 +002500* * SQ1304.2 +002600* SQ130A ATTEMPTS TO OPEN FOR INPUT-OUTPUT A MASS STORAGE * SQ1304.2 +002700* FILE WHICH IS NOT PRESENT. THIS SHOULD RESULT IN A * SQ1304.2 +002800* PERMANENT ERROR AND AN I-O STATUS OF "35". THE PROGRAM * SQ1304.2 +002900* DOES NOT CONTAIN AN APPLICABLE DECLARATIVE PROCEDURE. IN * SQ1304.2 +003000* THESE CIRCUMSTANCES THE STANDARD ALLOWS THE IMPLEMENTOR * SQ1304.2 +003100* TO TERMINATE EXECUTION OF THE PROGRAM OR TO CONTINUE. * SQ1304.2 +003200* * SQ1304.2 +003300**************************************************************** SQ1304.2 +003400* SQ1304.2 +003500 ENVIRONMENT DIVISION. SQ1304.2 +003600 CONFIGURATION SECTION. SQ1304.2 +003700 SOURCE-COMPUTER. SQ1304.2 +003800 Linux. SQ1304.2 +003900 OBJECT-COMPUTER. SQ1304.2 +004000 Linux. SQ1304.2 +004100* SQ1304.2 +004200 INPUT-OUTPUT SECTION. SQ1304.2 +004300 FILE-CONTROL. SQ1304.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1304.2 +004500 "report.log". SQ1304.2 +004600* SQ1304.2 +004700*P SELECT RAW-DATA ASSIGN TO SQ1304.2 +004800*P "XXXXX062" SQ1304.2 +004900*P ORGANIZATION IS INDEXED SQ1304.2 +005000*P ACCESS MODE IS RANDOM SQ1304.2 +005100*P RECORD-KEY IS RAW-DATA-KEY. SQ1304.2 +005200*P SQ1304.2 +005300 SELECT SQ-FS1 ASSIGN TO SQ1304.2 +005400 "XXXXX014" SQ1304.2 +005500 FILE STATUS IS SQ-FS1-STATUS. SQ1304.2 +005600* SQ1304.2 +005700* SQ1304.2 +005800 DATA DIVISION. SQ1304.2 +005900 FILE SECTION. SQ1304.2 +006000 FD PRINT-FILE SQ1304.2 +006100*C LABEL RECORDS SQ1304.2 +006200*C OMITTED SQ1304.2 +006300*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1304.2 +006400 . SQ1304.2 +006500 01 PRINT-REC PICTURE X(120). SQ1304.2 +006600 01 DUMMY-RECORD PICTURE X(120). SQ1304.2 +006700*P SQ1304.2 +006800*PD RAW-DATA. SQ1304.2 +006900*P1 RAW-DATA-SATZ. SQ1304.2 +007000*P 05 RAW-DATA-KEY PIC X(6). SQ1304.2 +007100*P 05 C-DATE PIC 9(6). SQ1304.2 +007200*P 05 C-TIME PIC 9(8). SQ1304.2 +007300*P 05 NO-OF-TESTS PIC 99. SQ1304.2 +007400*P 05 C-OK PIC 999. SQ1304.2 +007500*P 05 C-ALL PIC 999. SQ1304.2 +007600*P 05 C-FAIL PIC 999. SQ1304.2 +007700*P 05 C-DELETED PIC 999. SQ1304.2 +007800*P 05 C-INSPECT PIC 999. SQ1304.2 +007900*P 05 C-NOTE PIC X(13). SQ1304.2 +008000*P 05 C-INDENT PIC X. SQ1304.2 +008100*P 05 C-ABORT PIC X(8). SQ1304.2 +008200* SQ1304.2 +008300 FD SQ-FS1 SQ1304.2 +008400*C LABEL RECORD IS STANDARD SQ1304.2 +008500 . SQ1304.2 +008600 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1304.2 +008700* SQ1304.2 +008800 WORKING-STORAGE SECTION. SQ1304.2 +008900* SQ1304.2 +009000*************************************************************** SQ1304.2 +009100* * SQ1304.2 +009200* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1304.2 +009300* * SQ1304.2 +009400*************************************************************** SQ1304.2 +009500* SQ1304.2 +009600 01 SQ-FS1-STATUS. SQ1304.2 +009700 03 SQ-FS1-KEY-1 PIC X. SQ1304.2 +009800 03 SQ-FS1-KEY-2 PIC X. SQ1304.2 +009900* SQ1304.2 +010000* SQ1304.2 +010100*************************************************************** SQ1304.2 +010200* * SQ1304.2 +010300* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1304.2 +010400* * SQ1304.2 +010500*************************************************************** SQ1304.2 +010600* SQ1304.2 +010700 01 REC-SKEL-SUB PIC 99. SQ1304.2 +010800* SQ1304.2 +010900 01 FILE-RECORD-INFORMATION-REC. SQ1304.2 +011000 03 FILE-RECORD-INFO-SKELETON. SQ1304.2 +011100 05 FILLER PICTURE X(48) VALUE SQ1304.2 +011200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1304.2 +011300 05 FILLER PICTURE X(46) VALUE SQ1304.2 +011400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1304.2 +011500 05 FILLER PICTURE X(26) VALUE SQ1304.2 +011600 ",LFIL=000000,ORG= ,LBLR= ". SQ1304.2 +011700 05 FILLER PICTURE X(37) VALUE SQ1304.2 +011800 ",RECKEY= ". SQ1304.2 +011900 05 FILLER PICTURE X(38) VALUE SQ1304.2 +012000 ",ALTKEY1= ". SQ1304.2 +012100 05 FILLER PICTURE X(38) VALUE SQ1304.2 +012200 ",ALTKEY2= ". SQ1304.2 +012300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1304.2 +012400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1304.2 +012500 05 FILE-RECORD-INFO-P1-120. SQ1304.2 +012600 07 FILLER PIC X(5). SQ1304.2 +012700 07 XFILE-NAME PIC X(6). SQ1304.2 +012800 07 FILLER PIC X(8). SQ1304.2 +012900 07 XRECORD-NAME PIC X(6). SQ1304.2 +013000 07 FILLER PIC X(1). SQ1304.2 +013100 07 REELUNIT-NUMBER PIC 9(1). SQ1304.2 +013200 07 FILLER PIC X(7). SQ1304.2 +013300 07 XRECORD-NUMBER PIC 9(6). SQ1304.2 +013400 07 FILLER PIC X(6). SQ1304.2 +013500 07 UPDATE-NUMBER PIC 9(2). SQ1304.2 +013600 07 FILLER PIC X(5). SQ1304.2 +013700 07 ODO-NUMBER PIC 9(4). SQ1304.2 +013800 07 FILLER PIC X(5). SQ1304.2 +013900 07 XPROGRAM-NAME PIC X(5). SQ1304.2 +014000 07 FILLER PIC X(7). SQ1304.2 +014100 07 XRECORD-LENGTH PIC 9(6). SQ1304.2 +014200 07 FILLER PIC X(7). SQ1304.2 +014300 07 CHARS-OR-RECORDS PIC X(2). SQ1304.2 +014400 07 FILLER PIC X(1). SQ1304.2 +014500 07 XBLOCK-SIZE PIC 9(4). SQ1304.2 +014600 07 FILLER PIC X(6). SQ1304.2 +014700 07 RECORDS-IN-FILE PIC 9(6). SQ1304.2 +014800 07 FILLER PIC X(5). SQ1304.2 +014900 07 XFILE-ORGANIZATION PIC X(2). SQ1304.2 +015000 07 FILLER PIC X(6). SQ1304.2 +015100 07 XLABEL-TYPE PIC X(1). SQ1304.2 +015200 05 FILE-RECORD-INFO-P121-240. SQ1304.2 +015300 07 FILLER PIC X(8). SQ1304.2 +015400 07 XRECORD-KEY PIC X(29). SQ1304.2 +015500 07 FILLER PIC X(9). SQ1304.2 +015600 07 ALTERNATE-KEY1 PIC X(29). SQ1304.2 +015700 07 FILLER PIC X(9). SQ1304.2 +015800 07 ALTERNATE-KEY2 PIC X(29). SQ1304.2 +015900 07 FILLER PIC X(7). SQ1304.2 +016000* SQ1304.2 +016100 01 TEST-RESULTS. SQ1304.2 +016200 02 FILLER PIC X VALUE SPACE. SQ1304.2 +016300 02 FEATURE PIC X(24) VALUE SPACE. SQ1304.2 +016400 02 FILLER PIC X VALUE SPACE. SQ1304.2 +016500 02 P-OR-F PIC X(5) VALUE SPACE. SQ1304.2 +016600 02 FILLER PIC X VALUE SPACE. SQ1304.2 +016700 02 PAR-NAME. SQ1304.2 +016800 03 FILLER PIC X(14) VALUE SPACE. SQ1304.2 +016900 03 PARDOT-X PIC X VALUE SPACE. SQ1304.2 +017000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1304.2 +017100 02 FILLER PIC X(9) VALUE SPACE. SQ1304.2 +017200 02 RE-MARK PIC X(61). SQ1304.2 +017300 01 TEST-COMPUTED. SQ1304.2 +017400 02 FILLER PIC X(30) VALUE SPACE. SQ1304.2 +017500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1304.2 +017600 02 COMPUTED-X. SQ1304.2 +017700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1304.2 +017800 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1304.2 +017900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1304.2 +018000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1304.2 +018100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1304.2 +018200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1304.2 +018300 04 COMPUTED-18V0 PIC -9(18). SQ1304.2 +018400 04 FILLER PIC X. SQ1304.2 +018500 03 FILLER PIC X(50) VALUE SPACE. SQ1304.2 +018600 01 TEST-CORRECT. SQ1304.2 +018700 02 FILLER PIC X(30) VALUE SPACE. SQ1304.2 +018800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1304.2 +018900 02 CORRECT-X. SQ1304.2 +019000 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1304.2 +019100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1304.2 +019200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1304.2 +019300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1304.2 +019400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1304.2 +019500 03 CR-18V0 REDEFINES CORRECT-A. SQ1304.2 +019600 04 CORRECT-18V0 PIC -9(18). SQ1304.2 +019700 04 FILLER PIC X. SQ1304.2 +019800 03 FILLER PIC X(2) VALUE SPACE. SQ1304.2 +019900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1304.2 +020000 01 CCVS-C-1. SQ1304.2 +020100 02 FILLER PIC IS X(4) VALUE SPACE. SQ1304.2 +020200 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1304.2 +020300- "SS PARAGRAPH-NAME SQ1304.2 +020400- " REMARKS". SQ1304.2 +020500 02 FILLER PIC X(17) VALUE SPACE. SQ1304.2 +020600 01 CCVS-C-2. SQ1304.2 +020700 02 FILLER PIC XXXX VALUE SPACE. SQ1304.2 +020800 02 FILLER PIC X(6) VALUE "TESTED". SQ1304.2 +020900 02 FILLER PIC X(16) VALUE SPACE. SQ1304.2 +021000 02 FILLER PIC X(4) VALUE "FAIL". SQ1304.2 +021100 02 FILLER PIC X(90) VALUE SPACE. SQ1304.2 +021200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1304.2 +021300 01 REC-CT PIC 99 VALUE ZERO. SQ1304.2 +021400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1304.2 +021500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1304.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1304.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1304.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1304.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1304.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1304.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1304.2 +022200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1304.2 +022300 01 CCVS-H-1. SQ1304.2 +022400 02 FILLER PIC X(39) VALUE SPACES. SQ1304.2 +022500 02 FILLER PIC X(42) VALUE SQ1304.2 +022600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1304.2 +022700 02 FILLER PIC X(39) VALUE SPACES. SQ1304.2 +022800 01 CCVS-H-2A. SQ1304.2 +022900 02 FILLER PIC X(40) VALUE SPACE. SQ1304.2 +023000 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1304.2 +023100 02 FILLER PIC XXXX VALUE SQ1304.2 +023200 "4.2 ". SQ1304.2 +023300 02 FILLER PIC X(28) VALUE SQ1304.2 +023400 " COPY - NOT FOR DISTRIBUTION". SQ1304.2 +023500 02 FILLER PIC X(41) VALUE SPACE. SQ1304.2 +023600* SQ1304.2 +023700 01 CCVS-H-2B. SQ1304.2 +023800 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1304.2 +023900 02 TEST-ID PIC X(9). SQ1304.2 +024000 02 FILLER PIC X(4) VALUE " IN ". SQ1304.2 +024100 02 FILLER PIC X(12) VALUE SQ1304.2 +024200 " HIGH ". SQ1304.2 +024300 02 FILLER PIC X(22) VALUE SQ1304.2 +024400 " LEVEL VALIDATION FOR ". SQ1304.2 +024500 02 FILLER PIC X(58) VALUE SQ1304.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1304.2 +024700 01 CCVS-H-3. SQ1304.2 +024800 02 FILLER PIC X(34) VALUE SQ1304.2 +024900 " FOR OFFICIAL USE ONLY ". SQ1304.2 +025000 02 FILLER PIC X(58) VALUE SQ1304.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1304.2 +025200 02 FILLER PIC X(28) VALUE SQ1304.2 +025300 " COPYRIGHT 1985,1986 ". SQ1304.2 +025400 01 CCVS-E-1. SQ1304.2 +025500 02 FILLER PIC X(52) VALUE SPACE. SQ1304.2 +025600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1304.2 +025700 02 ID-AGAIN PIC X(9). SQ1304.2 +025800 02 FILLER PIC X(45) VALUE SPACES. SQ1304.2 +025900 01 CCVS-E-2. SQ1304.2 +026000 02 FILLER PIC X(31) VALUE SPACE. SQ1304.2 +026100 02 FILLER PIC X(21) VALUE SPACE. SQ1304.2 +026200 02 CCVS-E-2-2. SQ1304.2 +026300 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1304.2 +026400 03 FILLER PIC X VALUE SPACE. SQ1304.2 +026500 03 ENDER-DESC PIC X(44) VALUE SQ1304.2 +026600 "ERRORS ENCOUNTERED". SQ1304.2 +026700 01 CCVS-E-3. SQ1304.2 +026800 02 FILLER PIC X(22) VALUE SQ1304.2 +026900 " FOR OFFICIAL USE ONLY". SQ1304.2 +027000 02 FILLER PIC X(12) VALUE SPACE. SQ1304.2 +027100 02 FILLER PIC X(58) VALUE SQ1304.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1304.2 +027300 02 FILLER PIC X(8) VALUE SPACE. SQ1304.2 +027400 02 FILLER PIC X(20) VALUE SQ1304.2 +027500 " COPYRIGHT 1985,1986". SQ1304.2 +027600 01 CCVS-E-4. SQ1304.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1304.2 +027800 02 FILLER PIC X(4) VALUE " OF ". SQ1304.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1304.2 +028000 02 FILLER PIC X(40) VALUE SQ1304.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1304.2 +028200 01 XXINFO. SQ1304.2 +028300 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1304.2 +028400 02 INFO-TEXT. SQ1304.2 +028500 04 FILLER PIC X(8) VALUE SPACE. SQ1304.2 +028600 04 XXCOMPUTED PIC X(20). SQ1304.2 +028700 04 FILLER PIC X(5) VALUE SPACE. SQ1304.2 +028800 04 XXCORRECT PIC X(20). SQ1304.2 +028900 02 INF-ANSI-REFERENCE PIC X(48). SQ1304.2 +029000 01 HYPHEN-LINE. SQ1304.2 +029100 02 FILLER PIC IS X VALUE IS SPACE. SQ1304.2 +029200 02 FILLER PIC IS X(65) VALUE IS "************************SQ1304.2 +029300- "*****************************************". SQ1304.2 +029400 02 FILLER PIC IS X(54) VALUE IS "************************SQ1304.2 +029500- "******************************". SQ1304.2 +029600 01 CCVS-PGM-ID PIC X(9) VALUE SQ1304.2 +029700 "SQ130A". SQ1304.2 +029800* SQ1304.2 +029900* SQ1304.2 +030000 PROCEDURE DIVISION. SQ1304.2 +030100 CCVS1 SECTION. SQ1304.2 +030200 OPEN-FILES. SQ1304.2 +030300*P OPEN I-O RAW-DATA. SQ1304.2 +030400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1304.2 +030500*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1304.2 +030600*P MOVE "ABORTED " TO C-ABORT. SQ1304.2 +030700*P ADD 1 TO C-NO-OF-TESTS. SQ1304.2 +030800*P ACCEPT C-DATE FROM DATE. SQ1304.2 +030900*P ACCEPT C-TIME FROM TIME. SQ1304.2 +031000*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1304.2 +031100*PND-E-1. SQ1304.2 +031200*P CLOSE RAW-DATA. SQ1304.2 +031300 OPEN OUTPUT PRINT-FILE. SQ1304.2 +031400 MOVE CCVS-PGM-ID TO TEST-ID. SQ1304.2 +031500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1304.2 +031600 MOVE SPACE TO TEST-RESULTS. SQ1304.2 +031700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1304.2 +031800 MOVE ZERO TO REC-SKEL-SUB. SQ1304.2 +031900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1304.2 +032000 GO TO CCVS1-EXIT. SQ1304.2 +032100* SQ1304.2 +032200 CCVS-INIT-FILE. SQ1304.2 +032300 ADD 1 TO REC-SKL-SUB. SQ1304.2 +032400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1304.2 +032500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1304.2 +032600* SQ1304.2 +032700 CLOSE-FILES. SQ1304.2 +032800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1304.2 +032900 CLOSE PRINT-FILE. SQ1304.2 +033000*P OPEN I-O RAW-DATA. SQ1304.2 +033100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1304.2 +033200*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1304.2 +033300*P MOVE "OK. " TO C-ABORT. SQ1304.2 +033400*P MOVE PASS-COUNTER TO C-OK. SQ1304.2 +033500*P MOVE ERROR-HOLD TO C-ALL. SQ1304.2 +033600*P MOVE ERROR-COUNTER TO C-FAIL. SQ1304.2 +033700*P MOVE DELETE-CNT TO C-DELETED. SQ1304.2 +033800*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1304.2 +033900*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1304.2 +034000*PND-E-2. SQ1304.2 +034100*P CLOSE RAW-DATA. SQ1304.2 +034200 TERMINATE-CCVS. SQ1304.2 +034300*S EXIT PROGRAM. SQ1304.2 +034400 STOP RUN. SQ1304.2 +034500* SQ1304.2 +034600 INSPT. SQ1304.2 +034700 MOVE "INSPT" TO P-OR-F. SQ1304.2 +034800 ADD 1 TO INSPECT-COUNTER. SQ1304.2 +034900 PERFORM PRINT-DETAIL. SQ1304.2 +035000* SQ1304.2 +035100 PASS. SQ1304.2 +035200 MOVE "PASS " TO P-OR-F. SQ1304.2 +035300 ADD 1 TO PASS-COUNTER. SQ1304.2 +035400 PERFORM PRINT-DETAIL. SQ1304.2 +035500* SQ1304.2 +035600 FAIL. SQ1304.2 +035700 MOVE "FAIL*" TO P-OR-F. SQ1304.2 +035800 ADD 1 TO ERROR-COUNTER. SQ1304.2 +035900 PERFORM PRINT-DETAIL. SQ1304.2 +036000* SQ1304.2 +036100 DE-LETE. SQ1304.2 +036200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1304.2 +036300 MOVE "*****" TO P-OR-F. SQ1304.2 +036400 ADD 1 TO DELETE-COUNTER. SQ1304.2 +036500 PERFORM PRINT-DETAIL. SQ1304.2 +036600* SQ1304.2 +036700 PRINT-DETAIL. SQ1304.2 +036800 IF REC-CT NOT EQUAL TO ZERO SQ1304.2 +036900 MOVE "." TO PARDOT-X SQ1304.2 +037000 MOVE REC-CT TO DOTVALUE. SQ1304.2 +037100 MOVE TEST-RESULTS TO PRINT-REC. SQ1304.2 +037200 PERFORM WRITE-LINE. SQ1304.2 +037300 IF P-OR-F EQUAL TO "FAIL*" SQ1304.2 +037400 PERFORM WRITE-LINE SQ1304.2 +037500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1304.2 +037600 ELSE SQ1304.2 +037700 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1304.2 +037800 MOVE SPACE TO P-OR-F. SQ1304.2 +037900 MOVE SPACE TO COMPUTED-X. SQ1304.2 +038000 MOVE SPACE TO CORRECT-X. SQ1304.2 +038100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1304.2 +038200 MOVE SPACE TO RE-MARK. SQ1304.2 +038300* SQ1304.2 +038400 HEAD-ROUTINE. SQ1304.2 +038500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +038600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +038700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1304.2 +038800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1304.2 +038900 COLUMN-NAMES-ROUTINE. SQ1304.2 +039000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1304.2 +039100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +039200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1304.2 +039300 END-ROUTINE. SQ1304.2 +039400 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1304.2 +039500 PERFORM WRITE-LINE 5 TIMES. SQ1304.2 +039600 END-RTN-EXIT. SQ1304.2 +039700 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1304.2 +039800 PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +039900* SQ1304.2 +040000 END-ROUTINE-1. SQ1304.2 +040100 ADD ERROR-COUNTER TO ERROR-HOLD SQ1304.2 +040200 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1304.2 +040300 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1304.2 +040400 ADD PASS-COUNTER TO ERROR-HOLD. SQ1304.2 +040500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1304.2 +040600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1304.2 +040700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1304.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1304.2 +040900 PERFORM WRITE-LINE. SQ1304.2 +041000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1304.2 +041100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1304.2 +041200 MOVE "NO " TO ERROR-TOTAL SQ1304.2 +041300 ELSE SQ1304.2 +041400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1304.2 +041500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1304.2 +041600 PERFORM WRITE-LINE. SQ1304.2 +041700 END-ROUTINE-13. SQ1304.2 +041800 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1304.2 +041900 MOVE "NO " TO ERROR-TOTAL SQ1304.2 +042000 ELSE SQ1304.2 +042100 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1304.2 +042200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1304.2 +042300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1304.2 +042400 PERFORM WRITE-LINE. SQ1304.2 +042500 IF INSPECT-COUNTER EQUAL TO ZERO SQ1304.2 +042600 MOVE "NO " TO ERROR-TOTAL SQ1304.2 +042700 ELSE SQ1304.2 +042800 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1304.2 +042900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1304.2 +043000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1304.2 +043100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1304.2 +043200* SQ1304.2 +043300 WRITE-LINE. SQ1304.2 +043400 ADD 1 TO RECORD-COUNT. SQ1304.2 +043500 IF RECORD-COUNT GREATER 50 SQ1304.2 +043600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1304.2 +043700 MOVE SPACE TO DUMMY-RECORD SQ1304.2 +043800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1304.2 +043900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1304.2 +044000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1304.2 +044100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1304.2 +044200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1304.2 +044300 MOVE ZERO TO RECORD-COUNT. SQ1304.2 +044400 PERFORM WRT-LN. SQ1304.2 +044500* SQ1304.2 +044600 WRT-LN. SQ1304.2 +044700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1304.2 +044800 MOVE SPACE TO DUMMY-RECORD. SQ1304.2 +044900 BLANK-LINE-PRINT. SQ1304.2 +045000 PERFORM WRT-LN. SQ1304.2 +045100 FAIL-ROUTINE. SQ1304.2 +045200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1304.2 +045300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1304.2 +045400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1304.2 +045500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1304.2 +045600 MOVE XXINFO TO DUMMY-RECORD. SQ1304.2 +045700 PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +045800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1304.2 +045900 GO TO FAIL-ROUTINE-EX. SQ1304.2 +046000 FAIL-ROUTINE-WRITE. SQ1304.2 +046100 MOVE TEST-COMPUTED TO PRINT-REC SQ1304.2 +046200 PERFORM WRITE-LINE SQ1304.2 +046300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1304.2 +046400 MOVE TEST-CORRECT TO PRINT-REC SQ1304.2 +046500 PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +046600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1304.2 +046700 FAIL-ROUTINE-EX. SQ1304.2 +046800 EXIT. SQ1304.2 +046900 BAIL-OUT. SQ1304.2 +047000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1304.2 +047100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1304.2 +047200 BAIL-OUT-WRITE. SQ1304.2 +047300 MOVE CORRECT-A TO XXCORRECT. SQ1304.2 +047400 MOVE COMPUTED-A TO XXCOMPUTED. SQ1304.2 +047500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1304.2 +047600 MOVE XXINFO TO DUMMY-RECORD. SQ1304.2 +047700 PERFORM WRITE-LINE 2 TIMES. SQ1304.2 +047800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1304.2 +047900 BAIL-OUT-EX. SQ1304.2 +048000 EXIT. SQ1304.2 +048100 CCVS1-EXIT. SQ1304.2 +048200 EXIT. SQ1304.2 +048300* SQ1304.2 +048400**************************************************************** SQ1304.2 +048500* * SQ1304.2 +048600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1304.2 +048700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1304.2 +048800* * SQ1304.2 +048900**************************************************************** SQ1304.2 +049000* SQ1304.2 +049100 SECT-SQ130A-MAIN SECTION. SQ1304.2 +049200 OPEN-INIT-01. SQ1304.2 +049300* SQ1304.2 +049400* THIS PROGRAM ATTEMPTS TO OPEN IN THE INPUT-OUTPUT MODE SQ1304.2 +049500* A FILE WHICH IS NOT PRESENT AND AVAILABLE TO IT. SQ1304.2 +049600* SQ1304.2 +049700 MOVE 1 TO REC-CT SQ1304.2 +049800 MOVE "OPEN ABSENT FILE I-O" TO FEATURE SQ1304.2 +049900 MOVE "OPEN-TEST-01" TO PAR-NAME SQ1304.2 +050000 MOVE "**" TO SQ-FS1-STATUS. SQ1304.2 +050100* SQ1304.2 +050200 MOVE SPACE TO DUMMY-RECORD. SQ1304.2 +050300 PERFORM WRITE-LINE. SQ1304.2 +050400 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1304.2 +050500 TO DUMMY-RECORD. SQ1304.2 +050600 PERFORM WRITE-LINE. SQ1304.2 +050700 MOVE SPACE TO DUMMY-RECORD. SQ1304.2 +050800 PERFORM WRITE-LINE 3 TIMES. SQ1304.2 +050900* SQ1304.2 +051000 OPEN-TEST-01. SQ1304.2 +051100 OPEN I-O SQ-FS1. SQ1304.2 +051200 IF SQ-FS1-STATUS NOT = "35" SQ1304.2 +051300 MOVE "INCORRECT STATUS CODE RETURNED" TO RE-MARK SQ1304.2 +051400 MOVE "VII-4, 1.5.3(3)C" TO ANSI-REFERENCE SQ1304.2 +051500 MOVE "35" TO CORRECT-A SQ1304.2 +051600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1304.2 +051700 PERFORM FAIL SQ1304.2 +051800 ELSE SQ1304.2 +051900 PERFORM PASS. SQ1304.2 +052000* SQ1304.2 +052100* SQ1304.2 +052200 CCVS-EXIT SECTION. SQ1304.2 +052300 CCVS-999999. SQ1304.2 +052400 GO TO CLOSE-FILES. SQ1304.2 diff --git a/tests/cobol85/SQ/SQ131A.CBL b/tests/cobol85/SQ/SQ131A.CBL new file mode 100755 index 00000000..6d34f290 --- /dev/null +++ b/tests/cobol85/SQ/SQ131A.CBL @@ -0,0 +1,583 @@ +000100 IDENTIFICATION DIVISION. SQ1314.2 +000200 PROGRAM-ID. SQ1314.2 +000300 SQ131A. SQ1314.2 +000400**************************************************************** SQ1314.2 +000500* * SQ1314.2 +000600* VALIDATION FOR:- * SQ1314.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1314.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1314.2 +000900* REVISED 1986, AUGUST * SQ1314.2 +001000* * SQ1314.2 +001100* CREATION DATE / VALIDATION DATE * SQ1314.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1314.2 +001300* * SQ1314.2 +001400**************************************************************** SQ1314.2 +001500* * SQ1314.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1314.2 +001700* * SQ1314.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ1314.2 +001900* X-55 SYSTEM PRINTER * SQ1314.2 +002000* X-82 SOURCE-COMPUTER * SQ1314.2 +002100* X-83 OBJECT-COMPUTER. * SQ1314.2 +002200* * SQ1314.2 +002300* * SQ1314.2 +002400**************************************************************** SQ1314.2 +002500* * SQ1314.2 +002600* SQ131A ATTEMPTS TO OPEN IN THE I-O MODE A MASS STORAGE * SQ1314.2 +002700* FILE WHICH IS ALREADY OPEN IN THE OUTPUT MODE. THIS * SQ1314.2 +002800* SHOULD RESULT IN RECOGNITION OF A LOGIC ERROR CONDITION * SQ1314.2 +002900* AND RETURN OF I-O STATUS OF "41". THE PROGRAM DOES NOT * SQ1314.2 +003000* CONTAIN DECLARATIVE PROCEDURES, AND IN THIS CASE THE * SQ1314.2 +003100* STANDARD ALLOWS THE IMPLEMENTOR TO TERMINATE EXECUTION OF * SQ1314.2 +003200* THE PROGRAM AS PART OF THE EXECUTION OF THE OPEN * SQ1314.2 +003300* STATEMENT. HOWEVER, THE STANDARD ALSO ALLOWS EXECUTION * SQ1314.2 +003400* OF THE PROGRAM TO CONTINUE, AND THERE ARE TESTS TO COVER * SQ1314.2 +003500* THIS CASE. * SQ1314.2 +003600* * SQ1314.2 +003700* THE PROGRAM CONTAINS NO PROVISION FOR DELETION OF * SQ1314.2 +003800* OPERATIONS ON THE FILES, BUT INDIVIDUAL SUBORDINATE TESTS * SQ1314.2 +003900* MAY BE DELETED. * SQ1314.2 +004000* * SQ1314.2 +004100**************************************************************** SQ1314.2 +004200* SQ1314.2 +004300 ENVIRONMENT DIVISION. SQ1314.2 +004400 CONFIGURATION SECTION. SQ1314.2 +004500 SOURCE-COMPUTER. SQ1314.2 +004600 Linux. SQ1314.2 +004700 OBJECT-COMPUTER. SQ1314.2 +004800 Linux. SQ1314.2 +004900* SQ1314.2 +005000 INPUT-OUTPUT SECTION. SQ1314.2 +005100 FILE-CONTROL. SQ1314.2 +005200 SELECT PRINT-FILE ASSIGN TO SQ1314.2 +005300 "report.log". SQ1314.2 +005400* SQ1314.2 +005500*P SELECT RAW-DATA ASSIGN TO SQ1314.2 +005600*P "XXXXX062" SQ1314.2 +005700*P ORGANIZATION IS INDEXED SQ1314.2 +005800*P ACCESS MODE IS RANDOM SQ1314.2 +005900*P RECORD-KEY IS RAW-DATA-KEY. SQ1314.2 +006000*P SQ1314.2 +006100 SELECT SQ-FS1 ASSIGN TO SQ1314.2 +006200 "XXXXX014" SQ1314.2 +006300 FILE STATUS IS SQ-FS1-STATUS. SQ1314.2 +006400* SQ1314.2 +006500* SQ1314.2 +006600 DATA DIVISION. SQ1314.2 +006700 FILE SECTION. SQ1314.2 +006800 FD PRINT-FILE SQ1314.2 +006900*C LABEL RECORDS SQ1314.2 +007000*C OMITTED SQ1314.2 +007100*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1314.2 +007200 . SQ1314.2 +007300 01 PRINT-REC PICTURE X(120). SQ1314.2 +007400 01 DUMMY-RECORD PICTURE X(120). SQ1314.2 +007500*P SQ1314.2 +007600*PD RAW-DATA. SQ1314.2 +007700*P1 RAW-DATA-SATZ. SQ1314.2 +007800*P 05 RAW-DATA-KEY PIC X(6). SQ1314.2 +007900*P 05 C-DATE PIC 9(6). SQ1314.2 +008000*P 05 C-TIME PIC 9(8). SQ1314.2 +008100*P 05 NO-OF-TESTS PIC 99. SQ1314.2 +008200*P 05 C-OK PIC 999. SQ1314.2 +008300*P 05 C-ALL PIC 999. SQ1314.2 +008400*P 05 C-FAIL PIC 999. SQ1314.2 +008500*P 05 C-DELETED PIC 999. SQ1314.2 +008600*P 05 C-INSPECT PIC 999. SQ1314.2 +008700*P 05 C-NOTE PIC X(13). SQ1314.2 +008800*P 05 C-INDENT PIC X. SQ1314.2 +008900*P 05 C-ABORT PIC X(8). SQ1314.2 +009000* SQ1314.2 +009100 FD SQ-FS1 SQ1314.2 +009200*C LABEL RECORD IS STANDARD SQ1314.2 +009300 . SQ1314.2 +009400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1314.2 +009500* SQ1314.2 +009600 WORKING-STORAGE SECTION. SQ1314.2 +009700* SQ1314.2 +009800*************************************************************** SQ1314.2 +009900* * SQ1314.2 +010000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1314.2 +010100* * SQ1314.2 +010200*************************************************************** SQ1314.2 +010300* SQ1314.2 +010400 01 SQ-FS1-STATUS. SQ1314.2 +010500 03 SQ-FS1-KEY-1 PIC X. SQ1314.2 +010600 03 SQ-FS1-KEY-2 PIC X. SQ1314.2 +010700* SQ1314.2 +010800* SQ1314.2 +010900*************************************************************** SQ1314.2 +011000* * SQ1314.2 +011100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1314.2 +011200* * SQ1314.2 +011300*************************************************************** SQ1314.2 +011400* SQ1314.2 +011500 01 REC-SKEL-SUB PIC 99. SQ1314.2 +011600* SQ1314.2 +011700 01 FILE-RECORD-INFORMATION-REC. SQ1314.2 +011800 03 FILE-RECORD-INFO-SKELETON. SQ1314.2 +011900 05 FILLER PICTURE X(48) VALUE SQ1314.2 +012000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1314.2 +012100 05 FILLER PICTURE X(46) VALUE SQ1314.2 +012200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1314.2 +012300 05 FILLER PICTURE X(26) VALUE SQ1314.2 +012400 ",LFIL=000000,ORG= ,LBLR= ". SQ1314.2 +012500 05 FILLER PICTURE X(37) VALUE SQ1314.2 +012600 ",RECKEY= ". SQ1314.2 +012700 05 FILLER PICTURE X(38) VALUE SQ1314.2 +012800 ",ALTKEY1= ". SQ1314.2 +012900 05 FILLER PICTURE X(38) VALUE SQ1314.2 +013000 ",ALTKEY2= ". SQ1314.2 +013100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1314.2 +013200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1314.2 +013300 05 FILE-RECORD-INFO-P1-120. SQ1314.2 +013400 07 FILLER PIC X(5). SQ1314.2 +013500 07 XFILE-NAME PIC X(6). SQ1314.2 +013600 07 FILLER PIC X(8). SQ1314.2 +013700 07 XRECORD-NAME PIC X(6). SQ1314.2 +013800 07 FILLER PIC X(1). SQ1314.2 +013900 07 REELUNIT-NUMBER PIC 9(1). SQ1314.2 +014000 07 FILLER PIC X(7). SQ1314.2 +014100 07 XRECORD-NUMBER PIC 9(6). SQ1314.2 +014200 07 FILLER PIC X(6). SQ1314.2 +014300 07 UPDATE-NUMBER PIC 9(2). SQ1314.2 +014400 07 FILLER PIC X(5). SQ1314.2 +014500 07 ODO-NUMBER PIC 9(4). SQ1314.2 +014600 07 FILLER PIC X(5). SQ1314.2 +014700 07 XPROGRAM-NAME PIC X(5). SQ1314.2 +014800 07 FILLER PIC X(7). SQ1314.2 +014900 07 XRECORD-LENGTH PIC 9(6). SQ1314.2 +015000 07 FILLER PIC X(7). SQ1314.2 +015100 07 CHARS-OR-RECORDS PIC X(2). SQ1314.2 +015200 07 FILLER PIC X(1). SQ1314.2 +015300 07 XBLOCK-SIZE PIC 9(4). SQ1314.2 +015400 07 FILLER PIC X(6). SQ1314.2 +015500 07 RECORDS-IN-FILE PIC 9(6). SQ1314.2 +015600 07 FILLER PIC X(5). SQ1314.2 +015700 07 XFILE-ORGANIZATION PIC X(2). SQ1314.2 +015800 07 FILLER PIC X(6). SQ1314.2 +015900 07 XLABEL-TYPE PIC X(1). SQ1314.2 +016000 05 FILE-RECORD-INFO-P121-240. SQ1314.2 +016100 07 FILLER PIC X(8). SQ1314.2 +016200 07 XRECORD-KEY PIC X(29). SQ1314.2 +016300 07 FILLER PIC X(9). SQ1314.2 +016400 07 ALTERNATE-KEY1 PIC X(29). SQ1314.2 +016500 07 FILLER PIC X(9). SQ1314.2 +016600 07 ALTERNATE-KEY2 PIC X(29). SQ1314.2 +016700 07 FILLER PIC X(7). SQ1314.2 +016800* SQ1314.2 +016900 01 TEST-RESULTS. SQ1314.2 +017000 02 FILLER PIC X VALUE SPACE. SQ1314.2 +017100 02 PAR-NAME. SQ1314.2 +017200 03 FILLER PIC X(14) VALUE SPACE. SQ1314.2 +017300 03 PARDOT-X PIC X VALUE SPACE. SQ1314.2 +017400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1314.2 +017500 02 FILLER PIC X VALUE SPACE. SQ1314.2 +017600 02 FEATURE PIC X(24) VALUE SPACE. SQ1314.2 +017700 02 FILLER PIC X VALUE SPACE. SQ1314.2 +017800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1314.2 +017900 02 FILLER PIC X(9) VALUE SPACE. SQ1314.2 +018000 02 RE-MARK PIC X(61). SQ1314.2 +018100 01 TEST-COMPUTED. SQ1314.2 +018200 02 FILLER PIC X(30) VALUE SPACE. SQ1314.2 +018300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1314.2 +018400 02 COMPUTED-X. SQ1314.2 +018500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1314.2 +018600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1314.2 +018700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1314.2 +018800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1314.2 +018900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1314.2 +019000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1314.2 +019100 04 COMPUTED-18V0 PIC -9(18). SQ1314.2 +019200 04 FILLER PIC X. SQ1314.2 +019300 03 FILLER PIC X(50) VALUE SPACE. SQ1314.2 +019400 01 TEST-CORRECT. SQ1314.2 +019500 02 FILLER PIC X(30) VALUE SPACE. SQ1314.2 +019600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1314.2 +019700 02 CORRECT-X. SQ1314.2 +019800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1314.2 +019900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1314.2 +020000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1314.2 +020100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1314.2 +020200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1314.2 +020300 03 CR-18V0 REDEFINES CORRECT-A. SQ1314.2 +020400 04 CORRECT-18V0 PIC -9(18). SQ1314.2 +020500 04 FILLER PIC X. SQ1314.2 +020600 03 FILLER PIC X(2) VALUE SPACE. SQ1314.2 +020700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1314.2 +020800* SQ1314.2 +020900 01 CCVS-C-1. SQ1314.2 +021000 02 FILLER PIC IS X VALUE SPACE. SQ1314.2 +021100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1314.2 +021200 02 FILLER PIC IS X VALUE SPACE. SQ1314.2 +021300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1314.2 +021400 02 FILLER PIC IS X VALUE SPACE. SQ1314.2 +021500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1314.2 +021600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1314.2 +021700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1314.2 +021800 01 CCVS-C-2. SQ1314.2 +021900 02 FILLER PIC X(19) VALUE SPACE. SQ1314.2 +022000 02 FILLER PIC X(6) VALUE "TESTED". SQ1314.2 +022100 02 FILLER PIC X(19) VALUE SPACE. SQ1314.2 +022200 02 FILLER PIC X(4) VALUE "FAIL". SQ1314.2 +022300 02 FILLER PIC X(72) VALUE SPACE. SQ1314.2 +022400* SQ1314.2 +022500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1314.2 +022600 01 REC-CT PIC 99 VALUE ZERO. SQ1314.2 +022700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1314.2 +022800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1314.2 +022900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1314.2 +023000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1314.2 +023100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1314.2 +023200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1314.2 +023300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1314.2 +023400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1314.2 +023500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1314.2 +023600 01 CCVS-H-1. SQ1314.2 +023700 02 FILLER PIC X(39) VALUE SPACES. SQ1314.2 +023800 02 FILLER PIC X(42) VALUE SQ1314.2 +023900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1314.2 +024000 02 FILLER PIC X(39) VALUE SPACES. SQ1314.2 +024100 01 CCVS-H-2A. SQ1314.2 +024200 02 FILLER PIC X(40) VALUE SPACE. SQ1314.2 +024300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1314.2 +024400 02 FILLER PIC XXXX VALUE SQ1314.2 +024500 "4.2 ". SQ1314.2 +024600 02 FILLER PIC X(28) VALUE SQ1314.2 +024700 " COPY - NOT FOR DISTRIBUTION". SQ1314.2 +024800 02 FILLER PIC X(41) VALUE SPACE. SQ1314.2 +024900* SQ1314.2 +025000 01 CCVS-H-2B. SQ1314.2 +025100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1314.2 +025200 02 TEST-ID PIC X(9). SQ1314.2 +025300 02 FILLER PIC X(4) VALUE " IN ". SQ1314.2 +025400 02 FILLER PIC X(12) VALUE SQ1314.2 +025500 " HIGH ". SQ1314.2 +025600 02 FILLER PIC X(22) VALUE SQ1314.2 +025700 " LEVEL VALIDATION FOR ". SQ1314.2 +025800 02 FILLER PIC X(58) VALUE SQ1314.2 +025900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1314.2 +026000 01 CCVS-H-3. SQ1314.2 +026100 02 FILLER PIC X(34) VALUE SQ1314.2 +026200 " FOR OFFICIAL USE ONLY ". SQ1314.2 +026300 02 FILLER PIC X(58) VALUE SQ1314.2 +026400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1314.2 +026500 02 FILLER PIC X(28) VALUE SQ1314.2 +026600 " COPYRIGHT 1985,1986 ". SQ1314.2 +026700 01 CCVS-E-1. SQ1314.2 +026800 02 FILLER PIC X(52) VALUE SPACE. SQ1314.2 +026900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1314.2 +027000 02 ID-AGAIN PIC X(9). SQ1314.2 +027100 02 FILLER PIC X(45) VALUE SPACES. SQ1314.2 +027200 01 CCVS-E-2. SQ1314.2 +027300 02 FILLER PIC X(31) VALUE SPACE. SQ1314.2 +027400 02 FILLER PIC X(21) VALUE SPACE. SQ1314.2 +027500 02 CCVS-E-2-2. SQ1314.2 +027600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1314.2 +027700 03 FILLER PIC X VALUE SPACE. SQ1314.2 +027800 03 ENDER-DESC PIC X(44) VALUE SQ1314.2 +027900 "ERRORS ENCOUNTERED". SQ1314.2 +028000 01 CCVS-E-3. SQ1314.2 +028100 02 FILLER PIC X(22) VALUE SQ1314.2 +028200 " FOR OFFICIAL USE ONLY". SQ1314.2 +028300 02 FILLER PIC X(12) VALUE SPACE. SQ1314.2 +028400 02 FILLER PIC X(58) VALUE SQ1314.2 +028500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1314.2 +028600 02 FILLER PIC X(8) VALUE SPACE. SQ1314.2 +028700 02 FILLER PIC X(20) VALUE SQ1314.2 +028800 " COPYRIGHT 1985,1986". SQ1314.2 +028900 01 CCVS-E-4. SQ1314.2 +029000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1314.2 +029100 02 FILLER PIC X(4) VALUE " OF ". SQ1314.2 +029200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1314.2 +029300 02 FILLER PIC X(40) VALUE SQ1314.2 +029400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1314.2 +029500 01 XXINFO. SQ1314.2 +029600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1314.2 +029700 02 INFO-TEXT. SQ1314.2 +029800 04 FILLER PIC X(8) VALUE SPACE. SQ1314.2 +029900 04 XXCOMPUTED PIC X(20). SQ1314.2 +030000 04 FILLER PIC X(5) VALUE SPACE. SQ1314.2 +030100 04 XXCORRECT PIC X(20). SQ1314.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). SQ1314.2 +030300 01 HYPHEN-LINE. SQ1314.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. SQ1314.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1314.2 +030600- "*****************************************". SQ1314.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1314.2 +030800- "******************************". SQ1314.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1314.2 +031000 "SQ131A". SQ1314.2 +031100* SQ1314.2 +031200* SQ1314.2 +031300 PROCEDURE DIVISION. SQ1314.2 +031400 CCVS1 SECTION. SQ1314.2 +031500 OPEN-FILES. SQ1314.2 +031600*P OPEN I-O RAW-DATA. SQ1314.2 +031700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1314.2 +031800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1314.2 +031900*P MOVE "ABORTED " TO C-ABORT. SQ1314.2 +032000*P ADD 1 TO C-NO-OF-TESTS. SQ1314.2 +032100*P ACCEPT C-DATE FROM DATE. SQ1314.2 +032200*P ACCEPT C-TIME FROM TIME. SQ1314.2 +032300*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1314.2 +032400*PND-E-1. SQ1314.2 +032500*P CLOSE RAW-DATA. SQ1314.2 +032600 OPEN OUTPUT PRINT-FILE. SQ1314.2 +032700 MOVE CCVS-PGM-ID TO TEST-ID. SQ1314.2 +032800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1314.2 +032900 MOVE SPACE TO TEST-RESULTS. SQ1314.2 +033000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1314.2 +033100 MOVE ZERO TO REC-SKEL-SUB. SQ1314.2 +033200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1314.2 +033300 GO TO CCVS1-EXIT. SQ1314.2 +033400* SQ1314.2 +033500 CCVS-INIT-FILE. SQ1314.2 +033600 ADD 1 TO REC-SKL-SUB. SQ1314.2 +033700 MOVE FILE-RECORD-INFO-SKELETON TO SQ1314.2 +033800 FILE-RECORD-INFO (REC-SKL-SUB). SQ1314.2 +033900* SQ1314.2 +034000 CLOSE-FILES. SQ1314.2 +034100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1314.2 +034200 CLOSE PRINT-FILE. SQ1314.2 +034300*P OPEN I-O RAW-DATA. SQ1314.2 +034400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1314.2 +034500*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1314.2 +034600*P MOVE "OK. " TO C-ABORT. SQ1314.2 +034700*P MOVE PASS-COUNTER TO C-OK. SQ1314.2 +034800*P MOVE ERROR-HOLD TO C-ALL. SQ1314.2 +034900*P MOVE ERROR-COUNTER TO C-FAIL. SQ1314.2 +035000*P MOVE DELETE-CNT TO C-DELETED. SQ1314.2 +035100*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1314.2 +035200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1314.2 +035300*PND-E-2. SQ1314.2 +035400*P CLOSE RAW-DATA. SQ1314.2 +035500 TERMINATE-CCVS. SQ1314.2 +035600*S EXIT PROGRAM. SQ1314.2 +035700 STOP RUN. SQ1314.2 +035800* SQ1314.2 +035900 INSPT. SQ1314.2 +036000 MOVE "INSPT" TO P-OR-F. SQ1314.2 +036100 ADD 1 TO INSPECT-COUNTER. SQ1314.2 +036200 PERFORM PRINT-DETAIL. SQ1314.2 +036300 SQ1314.2 +036400 PASS. SQ1314.2 +036500 MOVE "PASS " TO P-OR-F. SQ1314.2 +036600 ADD 1 TO PASS-COUNTER. SQ1314.2 +036700 PERFORM PRINT-DETAIL. SQ1314.2 +036800* SQ1314.2 +036900 FAIL. SQ1314.2 +037000 MOVE "FAIL*" TO P-OR-F. SQ1314.2 +037100 ADD 1 TO ERROR-COUNTER. SQ1314.2 +037200 PERFORM PRINT-DETAIL. SQ1314.2 +037300* SQ1314.2 +037400 DE-LETE. SQ1314.2 +037500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1314.2 +037600 MOVE "*****" TO P-OR-F. SQ1314.2 +037700 ADD 1 TO DELETE-COUNTER. SQ1314.2 +037800 PERFORM PRINT-DETAIL. SQ1314.2 +037900* SQ1314.2 +038000 PRINT-DETAIL. SQ1314.2 +038100 IF REC-CT NOT EQUAL TO ZERO SQ1314.2 +038200 MOVE "." TO PARDOT-X SQ1314.2 +038300 MOVE REC-CT TO DOTVALUE. SQ1314.2 +038400 MOVE TEST-RESULTS TO PRINT-REC. SQ1314.2 +038500 PERFORM WRITE-LINE. SQ1314.2 +038600 IF P-OR-F EQUAL TO "FAIL*" SQ1314.2 +038700 PERFORM WRITE-LINE SQ1314.2 +038800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1314.2 +038900 ELSE SQ1314.2 +039000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1314.2 +039100 MOVE SPACE TO P-OR-F. SQ1314.2 +039200 MOVE SPACE TO COMPUTED-X. SQ1314.2 +039300 MOVE SPACE TO CORRECT-X. SQ1314.2 +039400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1314.2 +039500 MOVE SPACE TO RE-MARK. SQ1314.2 +039600* SQ1314.2 +039700 HEAD-ROUTINE. SQ1314.2 +039800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +039900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +040000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1314.2 +040100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1314.2 +040200 COLUMN-NAMES-ROUTINE. SQ1314.2 +040300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1314.2 +040400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +040500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1314.2 +040600 END-ROUTINE. SQ1314.2 +040700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1314.2 +040800 PERFORM WRITE-LINE 5 TIMES. SQ1314.2 +040900 END-RTN-EXIT. SQ1314.2 +041000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1314.2 +041100 PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +041200* SQ1314.2 +041300 END-ROUTINE-1. SQ1314.2 +041400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1314.2 +041500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1314.2 +041600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1314.2 +041700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1314.2 +041800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1314.2 +041900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1314.2 +042000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1314.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1314.2 +042200 PERFORM WRITE-LINE. SQ1314.2 +042300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1314.2 +042400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1314.2 +042500 MOVE "NO " TO ERROR-TOTAL SQ1314.2 +042600 ELSE SQ1314.2 +042700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1314.2 +042800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1314.2 +042900 PERFORM WRITE-LINE. SQ1314.2 +043000 END-ROUTINE-13. SQ1314.2 +043100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1314.2 +043200 MOVE "NO " TO ERROR-TOTAL SQ1314.2 +043300 ELSE SQ1314.2 +043400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1314.2 +043500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1314.2 +043600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1314.2 +043700 PERFORM WRITE-LINE. SQ1314.2 +043800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1314.2 +043900 MOVE "NO " TO ERROR-TOTAL SQ1314.2 +044000 ELSE SQ1314.2 +044100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1314.2 +044200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1314.2 +044300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1314.2 +044400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1314.2 +044500* SQ1314.2 +044600 WRITE-LINE. SQ1314.2 +044700 ADD 1 TO RECORD-COUNT. SQ1314.2 +044800 IF RECORD-COUNT GREATER 50 SQ1314.2 +044900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1314.2 +045000 MOVE SPACE TO DUMMY-RECORD SQ1314.2 +045100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1314.2 +045200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1314.2 +045300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1314.2 +045400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1314.2 +045500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1314.2 +045600 MOVE ZERO TO RECORD-COUNT. SQ1314.2 +045700 PERFORM WRT-LN. SQ1314.2 +045800* SQ1314.2 +045900 WRT-LN. SQ1314.2 +046000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1314.2 +046100 MOVE SPACE TO DUMMY-RECORD. SQ1314.2 +046200 BLANK-LINE-PRINT. SQ1314.2 +046300 PERFORM WRT-LN. SQ1314.2 +046400 FAIL-ROUTINE. SQ1314.2 +046500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1314.2 +046600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1314.2 +046700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1314.2 +046800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1314.2 +046900 MOVE XXINFO TO DUMMY-RECORD. SQ1314.2 +047000 PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +047100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1314.2 +047200 GO TO FAIL-ROUTINE-EX. SQ1314.2 +047300 FAIL-ROUTINE-WRITE. SQ1314.2 +047400 MOVE TEST-COMPUTED TO PRINT-REC SQ1314.2 +047500 PERFORM WRITE-LINE SQ1314.2 +047600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1314.2 +047700 MOVE TEST-CORRECT TO PRINT-REC SQ1314.2 +047800 PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +047900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1314.2 +048000 FAIL-ROUTINE-EX. SQ1314.2 +048100 EXIT. SQ1314.2 +048200 BAIL-OUT. SQ1314.2 +048300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1314.2 +048400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1314.2 +048500 BAIL-OUT-WRITE. SQ1314.2 +048600 MOVE CORRECT-A TO XXCORRECT. SQ1314.2 +048700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1314.2 +048800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1314.2 +048900 MOVE XXINFO TO DUMMY-RECORD. SQ1314.2 +049000 PERFORM WRITE-LINE 2 TIMES. SQ1314.2 +049100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1314.2 +049200 BAIL-OUT-EX. SQ1314.2 +049300 EXIT. SQ1314.2 +049400 CCVS1-EXIT. SQ1314.2 +049500 EXIT. SQ1314.2 +049600* SQ1314.2 +049700**************************************************************** SQ1314.2 +049800* * SQ1314.2 +049900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1314.2 +050000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1314.2 +050100* * SQ1314.2 +050200**************************************************************** SQ1314.2 +050300* SQ1314.2 +050400 SECT-SQ131A-MAIN SECTION. SQ1314.2 +050500* SQ1314.2 +050600* THE FIRST ACTION IS TO CREATE THE FILE BY MEANS OF AN SQ1314.2 +050700* OPEN OUTPUT STATEMENT. SQ1314.2 +050800* SQ1314.2 +050900 SEQ-INIT-01. SQ1314.2 +051000* SQ1314.2 +051100 MOVE 0 TO REC-CT SQ1314.2 +051200 MOVE "CREATE FILE, OPEN OUTPUT" TO FEATURE SQ1314.2 +051300 MOVE "SEQ-TEST-OP-01" TO PAR-NAME SQ1314.2 +051400 MOVE "**" TO SQ-FS1-STATUS. SQ1314.2 +051500 SEQ-TEST-OP-01. SQ1314.2 +051600 OPEN OUTPUT SQ-FS1. SQ1314.2 +051700* SQ1314.2 +051800* CHECK THE I-O STATUS VALUE RETURNED BY THE FIRST OPEN. SQ1314.2 +051900* SQ1314.2 +052000 ADD 1 TO REC-CT. SQ1314.2 +052100 GO TO SEQ-TEST-OP-01-01. SQ1314.2 +052200 SEQ-DELETE-01-01. SQ1314.2 +052300 PERFORM DE-LETE. SQ1314.2 +052400 GO TO SEQ-TEST-01-01-END. SQ1314.2 +052500 SEQ-TEST-OP-01-01. SQ1314.2 +052600 IF SQ-FS1-STATUS = "00" SQ1314.2 +052700 PERFORM PASS SQ1314.2 +052800 ELSE SQ1314.2 +052900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1314.2 +053000 MOVE "00" TO CORRECT-A SQ1314.2 +053100 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN OUTPUT" SQ1314.2 +053200 TO RE-MARK SQ1314.2 +053300 MOVE "VII-3, 1.5.3(1)A" TO ANSI-REFERENCE SQ1314.2 +053400 PERFORM FAIL. SQ1314.2 +053500 SEQ-TEST-01-01-END. SQ1314.2 +053600* SQ1314.2 +053700* SQ1314.2 +053800* HAVING OPENED THE FILE FOR OUTPUT, THE NEXT ACTION IS TO SQ1314.2 +053900* ATTEMPT TO OPEN IT FOR I-O. THE STANDARD PERMITS THE SQ1314.2 +054000* TERMINATION OF PROGRAM EXECUTION ON SUCH AN ATTEMPT TO SQ1314.2 +054100* OPEN A FILE WHICH IS ALREADY OPEN, BUT ALSO ALLOWS SQ1314.2 +054200* EXECUTION TO CONTINUE. SQ1314.2 +054300* SQ1314.2 +054400 MOVE SPACE TO DUMMY-RECORD SQ1314.2 +054500 PERFORM WRITE-LINE. SQ1314.2 +054600 MOVE "ABOUT TO ATTEMPT TO OPEN AN OPEN FILE" SQ1314.2 +054700 TO DUMMY-RECORD SQ1314.2 +054800 PERFORM WRITE-LINE. SQ1314.2 +054900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1314.2 +055000 TO DUMMY-RECORD SQ1314.2 +055100 PERFORM WRITE-LINE 3 TIMES. SQ1314.2 +055200* SQ1314.2 +055300 SEQ-INIT-02. SQ1314.2 +055400 MOVE 0 TO REC-CT SQ1314.2 +055500 MOVE "OPEN I-O ON AN OPEN FILE" TO FEATURE SQ1314.2 +055600 MOVE "SEQ-TEST-OP-02" TO PAR-NAME SQ1314.2 +055700 MOVE "**" TO SQ-FS1-STATUS. SQ1314.2 +055800 SEQ-TEST-OP-02. SQ1314.2 +055900 OPEN I-O SQ-FS1. SQ1314.2 +056000* SQ1314.2 +056100* CHECK THE I-O STATUS VALUE RETURNED BY THE SECOND OPEN. SQ1314.2 +056200* SQ1314.2 +056300 ADD 1 TO REC-CT. SQ1314.2 +056400 GO TO SEQ-TEST-OP-02-01. SQ1314.2 +056500 SEQ-DELETE-02-01. SQ1314.2 +056600 PERFORM DE-LETE. SQ1314.2 +056700 GO TO SEQ-TEST-02-01-END. SQ1314.2 +056800 SEQ-TEST-OP-02-01. SQ1314.2 +056900 IF SQ-FS1-STATUS = "41" SQ1314.2 +057000 PERFORM PASS SQ1314.2 +057100 ELSE SQ1314.2 +057200 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1314.2 +057300 MOVE "41" TO CORRECT-A SQ1314.2 +057400 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN I-O" SQ1314.2 +057500 TO RE-MARK SQ1314.2 +057600 MOVE "VII-4, 1.5.3(4)A" TO ANSI-REFERENCE SQ1314.2 +057700 PERFORM FAIL. SQ1314.2 +057800 SEQ-TEST-02-01-END. SQ1314.2 +057900* SQ1314.2 +058000* SQ1314.2 +058100 CCVS-EXIT SECTION. SQ1314.2 +058200 CCVS-999999. SQ1314.2 +058300 GO TO CLOSE-FILES. SQ1314.2 diff --git a/tests/cobol85/SQ/SQ132A.CBL b/tests/cobol85/SQ/SQ132A.CBL new file mode 100755 index 00000000..64542e5a --- /dev/null +++ b/tests/cobol85/SQ/SQ132A.CBL @@ -0,0 +1,582 @@ +000100 IDENTIFICATION DIVISION. SQ1324.2 +000200 PROGRAM-ID. SQ1324.2 +000300 SQ132A. SQ1324.2 +000400*************************************************************** SQ1324.2 +000500* * SQ1324.2 +000600* VALIDATION FOR:- * SQ1324.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1324.2 +000800* USING CCVS85 VERSION 4.2. * SQ1324.2 +000900* * SQ1324.2 +001000* CREATION DATE / VALIDATION DATE * SQ1324.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1324.2 +001200* * SQ1324.2 +001300*************************************************************** SQ1324.2 +001400* * SQ1324.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1324.2 +001600* * SQ1324.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ1324.2 +001800* X-55 SYSTEM PRINTER * SQ1324.2 +001900* X-82 SOURCE-COMPUTER * SQ1324.2 +002000* X-83 OBJECT-COMPUTER * SQ1324.2 +002100* X-84 LABEL RECORDS OPTION * SQ1324.2 +002200* * SQ1324.2 +002300*************************************************************** SQ1324.2 +002400* * SQ1324.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TOCLOSING * SQ1324.2 +002600* AN UNOPENED FILE. THE TEST FOR CORRECT I-O STATUS CODE * SQ1324.2 +002700* 42 IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION IS * SQ1324.2 +002800* POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1324.2 +002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1324.2 +003000* LINE CODE. * SQ1324.2 +003100* * SQ1324.2 +003200*************************************************************** SQ1324.2 +003300* SQ1324.2 +003400 ENVIRONMENT DIVISION. SQ1324.2 +003500 CONFIGURATION SECTION. SQ1324.2 +003600 SOURCE-COMPUTER. SQ1324.2 +003700 Linux. SQ1324.2 +003800 OBJECT-COMPUTER. SQ1324.2 +003900 Linux. SQ1324.2 +004000* SQ1324.2 +004100 INPUT-OUTPUT SECTION. SQ1324.2 +004200 FILE-CONTROL. SQ1324.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1324.2 +004400 "report.log". SQ1324.2 +004500* SQ1324.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1324.2 +004700 "XXXXX014" SQ1324.2 +004800 FILE STATUS SQ-FS1-STATUS. SQ1324.2 +004900* SQ1324.2 +005000* SQ1324.2 +005100 DATA DIVISION. SQ1324.2 +005200 FILE SECTION. SQ1324.2 +005300 FD PRINT-FILE SQ1324.2 +005400*C LABEL RECORDS SQ1324.2 +005500*C OMITTED SQ1324.2 +005600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1324.2 +005700 . SQ1324.2 +005800 01 PRINT-REC PICTURE X(120). SQ1324.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1324.2 +006000* SQ1324.2 +006100 FD SQ-FS1 SQ1324.2 +006200*C LABEL RECORD IS STANDARD SQ1324.2 +006300 . SQ1324.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1324.2 +006500* SQ1324.2 +006600 WORKING-STORAGE SECTION. SQ1324.2 +006700* SQ1324.2 +006800************************************************************** SQ1324.2 +006900* * SQ1324.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1324.2 +007100* * SQ1324.2 +007200************************************************************** SQ1324.2 +007300* SQ1324.2 +007400 01 SQ-FS1-STATUS. SQ1324.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1324.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1324.2 +007700* SQ1324.2 +007800************************************************************** SQ1324.2 +007900* * SQ1324.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1324.2 +008100* * SQ1324.2 +008200************************************************************** SQ1324.2 +008300* SQ1324.2 +008400 01 REC-SKEL-SUB PIC 99. SQ1324.2 +008500* SQ1324.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ1324.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ1324.2 +008800 05 FILLER PICTURE X(48) VALUE SQ1324.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1324.2 +009000 05 FILLER PICTURE X(46) VALUE SQ1324.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1324.2 +009200 05 FILLER PICTURE X(26) VALUE SQ1324.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ1324.2 +009400 05 FILLER PICTURE X(37) VALUE SQ1324.2 +009500 ",RECKEY= ". SQ1324.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1324.2 +009700 ",ALTKEY1= ". SQ1324.2 +009800 05 FILLER PICTURE X(38) VALUE SQ1324.2 +009900 ",ALTKEY2= ". SQ1324.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE. SQ1324.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1324.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ1324.2 +010300 07 FILLER PIC X(5). SQ1324.2 +010400 07 XFILE-NAME PIC X(6). SQ1324.2 +010500 07 FILLER PIC X(8). SQ1324.2 +010600 07 XRECORD-NAME PIC X(6). SQ1324.2 +010700 07 FILLER PIC X(1). SQ1324.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ1324.2 +010900 07 FILLER PIC X(7). SQ1324.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ1324.2 +011100 07 FILLER PIC X(6). SQ1324.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ1324.2 +011300 07 FILLER PIC X(5). SQ1324.2 +011400 07 ODO-NUMBER PIC 9(4). SQ1324.2 +011500 07 FILLER PIC X(5). SQ1324.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ1324.2 +011700 07 FILLER PIC X(7). SQ1324.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ1324.2 +011900 07 FILLER PIC X(7). SQ1324.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ1324.2 +012100 07 FILLER PIC X(1). SQ1324.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ1324.2 +012300 07 FILLER PIC X(6). SQ1324.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ1324.2 +012500 07 FILLER PIC X(5). SQ1324.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ1324.2 +012700 07 FILLER PIC X(6). SQ1324.2 +012800 07 XLABEL-TYPE PIC X(1). SQ1324.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ1324.2 +013000 07 FILLER PIC X(8). SQ1324.2 +013100 07 XRECORD-KEY PIC X(29). SQ1324.2 +013200 07 FILLER PIC X(9). SQ1324.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ1324.2 +013400 07 FILLER PIC X(9). SQ1324.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ1324.2 +013600 07 FILLER PIC X(7). SQ1324.2 +013700* SQ1324.2 +013800 01 TEST-RESULTS. SQ1324.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1324.2 +014000 02 PAR-NAME. SQ1324.2 +014100 03 FILLER PIC X(14) VALUE SPACE. SQ1324.2 +014200 03 PARDOT-X PIC X VALUE SPACE. SQ1324.2 +014300 03 DOTVALUE PIC 99 VALUE ZERO. SQ1324.2 +014400 02 FILLER PIC X VALUE SPACE. SQ1324.2 +014500 02 FEATURE PIC X(24) VALUE SPACE. SQ1324.2 +014600 02 FILLER PIC X VALUE SPACE. SQ1324.2 +014700 02 P-OR-F PIC X(5) VALUE SPACE. SQ1324.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ1324.2 +014900 02 RE-MARK PIC X(61). SQ1324.2 +015000 01 TEST-COMPUTED. SQ1324.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ1324.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1324.2 +015300 02 COMPUTED-X. SQ1324.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1324.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1324.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1324.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1324.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1324.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1324.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ1324.2 +016100 04 FILLER PIC X. SQ1324.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ1324.2 +016300 01 TEST-CORRECT. SQ1324.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1324.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1324.2 +016600 02 CORRECT-X. SQ1324.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1324.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1324.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1324.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1324.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1324.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ1324.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ1324.2 +017400 04 FILLER PIC X. SQ1324.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ1324.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1324.2 +017700* SQ1324.2 +017800 01 CCVS-C-1. SQ1324.2 +017900 02 FILLER PIC IS X VALUE SPACE. SQ1324.2 +018000 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1324.2 +018100 02 FILLER PIC IS X VALUE SPACE. SQ1324.2 +018200 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1324.2 +018300 02 FILLER PIC IS X VALUE SPACE. SQ1324.2 +018400 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1324.2 +018500 02 FILLER PIC IS X(9) VALUE SPACE. SQ1324.2 +018600 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1324.2 +018700 01 CCVS-C-2. SQ1324.2 +018800 02 FILLER PIC X(19) VALUE SPACE. SQ1324.2 +018900 02 FILLER PIC X(6) VALUE "TESTED". SQ1324.2 +019000 02 FILLER PIC X(19) VALUE SPACE. SQ1324.2 +019100 02 FILLER PIC X(4) VALUE "FAIL". SQ1324.2 +019200 02 FILLER PIC X(72) VALUE SPACE. SQ1324.2 +019300* SQ1324.2 +019400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1324.2 +019500 01 REC-CT PIC 99 VALUE ZERO. SQ1324.2 +019600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1324.2 +019700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1324.2 +019800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1324.2 +019900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1324.2 +020000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1324.2 +020100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1324.2 +020200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1324.2 +020300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1324.2 +020400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1324.2 +020500 01 CCVS-H-1. SQ1324.2 +020600 02 FILLER PIC X(39) VALUE SPACES. SQ1324.2 +020700 02 FILLER PIC X(42) VALUE SQ1324.2 +020800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1324.2 +020900 02 FILLER PIC X(39) VALUE SPACES. SQ1324.2 +021000 01 CCVS-H-2A. SQ1324.2 +021100 02 FILLER PIC X(40) VALUE SPACE. SQ1324.2 +021200 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1324.2 +021300 02 FILLER PIC XXXX VALUE SQ1324.2 +021400 "4.2 ". SQ1324.2 +021500 02 FILLER PIC X(28) VALUE SQ1324.2 +021600 " COPY - NOT FOR DISTRIBUTION". SQ1324.2 +021700 02 FILLER PIC X(41) VALUE SPACE. SQ1324.2 +021800* SQ1324.2 +021900 01 CCVS-H-2B. SQ1324.2 +022000 02 FILLER PIC X(15) VALUE "TEST RESULT OF". SQ1324.2 +022100 02 TEST-ID PIC X(9). SQ1324.2 +022200 02 FILLER PIC X(4) VALUE " IN ". SQ1324.2 +022300 02 FILLER PIC X(12) VALUE SQ1324.2 +022400 " HIGH ". SQ1324.2 +022500 02 FILLER PIC X(22) VALUE SQ1324.2 +022600 " LEVEL VALIDATION FOR ". SQ1324.2 +022700 02 FILLER PIC X(58) VALUE SQ1324.2 +022800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1324.2 +022900 01 CCVS-H-3. SQ1324.2 +023000 02 FILLER PIC X(34) VALUE SQ1324.2 +023100 " FOR OFFICIAL USE ONLY ". SQ1324.2 +023200 02 FILLER PIC X(58) VALUE SQ1324.2 +023300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1324.2 +023400 02 FILLER PIC X(28) VALUE SQ1324.2 +023500 " COPYRIGHT 1985,1986 ". SQ1324.2 +023600 01 CCVS-E-1. SQ1324.2 +023700 02 FILLER PIC X(52) VALUE SPACE. SQ1324.2 +023800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1324.2 +023900 02 ID-AGAIN PIC X(9). SQ1324.2 +024000 02 FILLER PIC X(45) VALUE SPACES. SQ1324.2 +024100 01 CCVS-E-2. SQ1324.2 +024200 02 FILLER PIC X(31) VALUE SPACE. SQ1324.2 +024300 02 FILLER PIC X(21) VALUE SPACE. SQ1324.2 +024400 02 CCVS-E-2-2. SQ1324.2 +024500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1324.2 +024600 03 FILLER PIC X VALUE SPACE. SQ1324.2 +024700 03 ENDER-DESC PIC X(44) VALUE SQ1324.2 +024800 "ERRORS ENCOUNTERED". SQ1324.2 +024900 01 CCVS-E-3. SQ1324.2 +025000 02 FILLER PIC X(22) VALUE SQ1324.2 +025100 " FOR OFFICIAL USE ONLY". SQ1324.2 +025200 02 FILLER PIC X(12) VALUE SPACE. SQ1324.2 +025300 02 FILLER PIC X(58) VALUE SQ1324.2 +025400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1324.2 +025500 02 FILLER PIC X(8) VALUE SPACE. SQ1324.2 +025600 02 FILLER PIC X(20) VALUE SQ1324.2 +025700 " COPYRIGHT 1985,1986". SQ1324.2 +025800 01 CCVS-E-4. SQ1324.2 +025900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1324.2 +026000 02 FILLER PIC X(4) VALUE " OF ". SQ1324.2 +026100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1324.2 +026200 02 FILLER PIC X(40) VALUE SQ1324.2 +026300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1324.2 +026400 01 XXINFO. SQ1324.2 +026500 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1324.2 +026600 02 INFO-TEXT. SQ1324.2 +026700 04 FILLER PIC X(8) VALUE SPACE. SQ1324.2 +026800 04 XXCOMPUTED PIC X(20). SQ1324.2 +026900 04 FILLER PIC X(5) VALUE SPACE. SQ1324.2 +027000 04 XXCORRECT PIC X(20). SQ1324.2 +027100 02 INF-ANSI-REFERENCE PIC X(48). SQ1324.2 +027200 01 HYPHEN-LINE. SQ1324.2 +027300 02 FILLER PIC IS X VALUE IS SPACE. SQ1324.2 +027400 02 FILLER PIC IS X(65) VALUE IS "************************SQ1324.2 +027500- "*****************************************". SQ1324.2 +027600 02 FILLER PIC IS X(54) VALUE IS "************************SQ1324.2 +027700- "******************************". SQ1324.2 +027800 01 CCVS-PGM-ID PIC X(9) VALUE SQ1324.2 +027900 "SQ132A". SQ1324.2 +028000* SQ1324.2 +028100* SQ1324.2 +028200 PROCEDURE DIVISION. SQ1324.2 +028300 DECLARATIVES. SQ1324.2 +028400 SQ132A-DECLARATIVE-001-SECT SECTION. SQ1324.2 +028500 USE AFTER STANDARD ERROR PROCEDURE SQ-FS1. SQ1324.2 +028600 SQ-FS1-ERROR-PROCEDURE. SQ1324.2 +028700 DECL-CLOSE-01. SQ1324.2 +028800 IF SQ-FS1-STATUS = "42" SQ1324.2 +028900 PERFORM DECL-PASS SQ1324.2 +029000 GO TO DECL-ABNORMAL-TERM SQ1324.2 +029100 ELSE SQ1324.2 +029200 MOVE "42" TO CORRECT-A SQ1324.2 +029300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1324.2 +029400 MOVE "STATUS FOR CLOSE OF UNOPENED FILE INCORRECT" SQ1324.2 +029500 TO RE-MARK SQ1324.2 +029600 PERFORM DECL-FAIL SQ1324.2 +029700 GO TO DECL-ABNORMAL-TERM SQ1324.2 +029800 END-IF. SQ1324.2 +029900* SQ1324.2 +030000 DECL-PASS. SQ1324.2 +030100 MOVE "PASS " TO P-OR-F. SQ1324.2 +030200 ADD 1 TO PASS-COUNTER. SQ1324.2 +030300 PERFORM DECL-PRINT-DETAIL. SQ1324.2 +030400* SQ1324.2 +030500 DECL-FAIL. SQ1324.2 +030600 MOVE "FAIL*" TO P-OR-F. SQ1324.2 +030700 ADD 1 TO ERROR-COUNTER. SQ1324.2 +030800 PERFORM DECL-PRINT-DETAIL. SQ1324.2 +030900* SQ1324.2 +031000 DECL-PRINT-DETAIL. SQ1324.2 +031100 IF REC-CT NOT EQUAL TO ZERO SQ1324.2 +031200 MOVE "." TO PARDOT-X SQ1324.2 +031300 MOVE REC-CT TO DOTVALUE. SQ1324.2 +031400 MOVE TEST-RESULTS TO PRINT-REC. SQ1324.2 +031500 PERFORM DECL-WRITE-LINE. SQ1324.2 +031600 IF P-OR-F EQUAL TO "FAIL*" SQ1324.2 +031700 PERFORM DECL-WRITE-LINE SQ1324.2 +031800 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1324.2 +031900 ELSE SQ1324.2 +032000 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1324.2 +032100 MOVE SPACE TO P-OR-F. SQ1324.2 +032200 MOVE SPACE TO COMPUTED-X. SQ1324.2 +032300 MOVE SPACE TO CORRECT-X. SQ1324.2 +032400 IF REC-CT EQUAL TO ZERO SQ1324.2 +032500 MOVE SPACE TO PAR-NAME. SQ1324.2 +032600 MOVE SPACE TO RE-MARK. SQ1324.2 +032700* SQ1324.2 +032800 DECL-WRITE-LINE. SQ1324.2 +032900 ADD 1 TO RECORD-COUNT. SQ1324.2 +033000 IF RECORD-COUNT GREATER 50 SQ1324.2 +033100 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1324.2 +033200 MOVE SPACE TO DUMMY-RECORD SQ1324.2 +033300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1324.2 +033400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1324.2 +033500 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1324.2 +033600 PERFORM DECL-WRT-LN 2 TIMES SQ1324.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1324.2 +033800 PERFORM DECL-WRT-LN SQ1324.2 +033900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1324.2 +034000 MOVE ZERO TO RECORD-COUNT. SQ1324.2 +034100 PERFORM DECL-WRT-LN. SQ1324.2 +034200* SQ1324.2 +034300 DECL-WRT-LN. SQ1324.2 +034400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1324.2 +034500 MOVE SPACE TO DUMMY-RECORD. SQ1324.2 +034600* SQ1324.2 +034700 DECL-FAIL-ROUTINE. SQ1324.2 +034800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1324.2 +034900 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1324.2 +035000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1324.2 +035100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1324.2 +035200 MOVE XXINFO TO DUMMY-RECORD. SQ1324.2 +035300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1324.2 +035400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1324.2 +035500 GO TO DECL-FAIL-EX. SQ1324.2 +035600 DECL-FAIL-WRITE. SQ1324.2 +035700 MOVE TEST-COMPUTED TO PRINT-REC SQ1324.2 +035800 PERFORM DECL-WRITE-LINE SQ1324.2 +035900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1324.2 +036000 MOVE TEST-CORRECT TO PRINT-REC SQ1324.2 +036100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1324.2 +036200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1324.2 +036300 DECL-FAIL-EX. SQ1324.2 +036400 EXIT. SQ1324.2 +036500* SQ1324.2 +036600 DECL-BAIL. SQ1324.2 +036700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1324.2 +036800 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1324.2 +036900 DECL-BAIL-WRITE. SQ1324.2 +037000 MOVE CORRECT-A TO XXCORRECT. SQ1324.2 +037100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1324.2 +037200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1324.2 +037300 MOVE XXINFO TO DUMMY-RECORD. SQ1324.2 +037400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1324.2 +037500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1324.2 +037600 DECL-BAIL-EX. SQ1324.2 +037700 EXIT. SQ1324.2 +037800* SQ1324.2 +037900 DECL-ABNORMAL-TERM. SQ1324.2 +038000 MOVE SPACE TO DUMMY-RECORD. SQ1324.2 +038100 PERFORM DECL-WRITE-LINE. SQ1324.2 +038200 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1324.2 +038300 TO DUMMY-RECORD. SQ1324.2 +038400 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1324.2 +038500* SQ1324.2 +038600 END-DECLS. SQ1324.2 +038700 EXIT. SQ1324.2 +038800 END DECLARATIVES. SQ1324.2 +038900* SQ1324.2 +039000* SQ1324.2 +039100 CCVS1 SECTION. SQ1324.2 +039200 OPEN-FILES. SQ1324.2 +039300 OPEN OUTPUT PRINT-FILE. SQ1324.2 +039400 MOVE CCVS-PGM-ID TO TEST-ID. SQ1324.2 +039500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1324.2 +039600 MOVE SPACE TO TEST-RESULTS. SQ1324.2 +039700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1324.2 +039800 MOVE ZERO TO REC-SKEL-SUB. SQ1324.2 +039900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1324.2 +040000 GO TO CCVS1-EXIT. SQ1324.2 +040100* SQ1324.2 +040200 CCVS-INIT-FILE. SQ1324.2 +040300 ADD 1 TO REC-SKL-SUB. SQ1324.2 +040400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1324.2 +040500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1324.2 +040600* SQ1324.2 +040700 CLOSE-FILES. SQ1324.2 +040800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1324.2 +040900 CLOSE PRINT-FILE. SQ1324.2 +041000 TERMINATE-CCVS. SQ1324.2 +041100 STOP RUN. SQ1324.2 +041200* SQ1324.2 +041300 INSPT. SQ1324.2 +041400 MOVE "INSPT" TO P-OR-F. SQ1324.2 +041500 ADD 1 TO INSPECT-COUNTER. SQ1324.2 +041600 PERFORM PRINT-DETAIL. SQ1324.2 +041700 SQ1324.2 +041800 PASS. SQ1324.2 +041900 MOVE "PASS " TO P-OR-F. SQ1324.2 +042000 ADD 1 TO PASS-COUNTER. SQ1324.2 +042100 PERFORM PRINT-DETAIL. SQ1324.2 +042200* SQ1324.2 +042300 FAIL. SQ1324.2 +042400 MOVE "FAIL*" TO P-OR-F. SQ1324.2 +042500 ADD 1 TO ERROR-COUNTER. SQ1324.2 +042600 PERFORM PRINT-DETAIL. SQ1324.2 +042700* SQ1324.2 +042800 DE-LETE. SQ1324.2 +042900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1324.2 +043000 MOVE "*****" TO P-OR-F. SQ1324.2 +043100 ADD 1 TO DELETE-COUNTER. SQ1324.2 +043200 PERFORM PRINT-DETAIL. SQ1324.2 +043300* SQ1324.2 +043400 PRINT-DETAIL. SQ1324.2 +043500 IF REC-CT NOT EQUAL TO ZERO SQ1324.2 +043600 MOVE "." TO PARDOT-X SQ1324.2 +043700 MOVE REC-CT TO DOTVALUE. SQ1324.2 +043800 MOVE TEST-RESULTS TO PRINT-REC. SQ1324.2 +043900 PERFORM WRITE-LINE. SQ1324.2 +044000 IF P-OR-F EQUAL TO "FAIL*" SQ1324.2 +044100 PERFORM WRITE-LINE SQ1324.2 +044200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1324.2 +044300 ELSE SQ1324.2 +044400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1324.2 +044500 MOVE SPACE TO P-OR-F. SQ1324.2 +044600 MOVE SPACE TO COMPUTED-X. SQ1324.2 +044700 MOVE SPACE TO CORRECT-X. SQ1324.2 +044800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1324.2 +044900 MOVE SPACE TO RE-MARK. SQ1324.2 +045000* SQ1324.2 +045100 HEAD-ROUTINE. SQ1324.2 +045200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +045300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +045400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1324.2 +045500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1324.2 +045600 COLUMN-NAMES-ROUTINE. SQ1324.2 +045700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1324.2 +045800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +045900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1324.2 +046000 END-ROUTINE. SQ1324.2 +046100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1324.2 +046200 PERFORM WRITE-LINE 5 TIMES. SQ1324.2 +046300 END-RTN-EXIT. SQ1324.2 +046400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1324.2 +046500 PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +046600* SQ1324.2 +046700 END-ROUTINE-1. SQ1324.2 +046800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1324.2 +046900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1324.2 +047000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1324.2 +047100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1324.2 +047200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1324.2 +047300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1324.2 +047400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1324.2 +047500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1324.2 +047600 PERFORM WRITE-LINE. SQ1324.2 +047700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1324.2 +047800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1324.2 +047900 MOVE "NO " TO ERROR-TOTAL SQ1324.2 +048000 ELSE SQ1324.2 +048100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1324.2 +048200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1324.2 +048300 PERFORM WRITE-LINE. SQ1324.2 +048400 END-ROUTINE-13. SQ1324.2 +048500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1324.2 +048600 MOVE "NO " TO ERROR-TOTAL SQ1324.2 +048700 ELSE SQ1324.2 +048800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1324.2 +048900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1324.2 +049000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1324.2 +049100 PERFORM WRITE-LINE. SQ1324.2 +049200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1324.2 +049300 MOVE "NO " TO ERROR-TOTAL SQ1324.2 +049400 ELSE SQ1324.2 +049500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1324.2 +049600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1324.2 +049700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1324.2 +049800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1324.2 +049900* SQ1324.2 +050000 WRITE-LINE. SQ1324.2 +050100 ADD 1 TO RECORD-COUNT. SQ1324.2 +050200 IF RECORD-COUNT GREATER 50 SQ1324.2 +050300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1324.2 +050400 MOVE SPACE TO DUMMY-RECORD SQ1324.2 +050500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1324.2 +050600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1324.2 +050700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1324.2 +050800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1324.2 +050900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1324.2 +051000 MOVE ZERO TO RECORD-COUNT. SQ1324.2 +051100 PERFORM WRT-LN. SQ1324.2 +051200* SQ1324.2 +051300 WRT-LN. SQ1324.2 +051400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1324.2 +051500 MOVE SPACE TO DUMMY-RECORD. SQ1324.2 +051600 BLANK-LINE-PRINT. SQ1324.2 +051700 PERFORM WRT-LN. SQ1324.2 +051800 FAIL-ROUTINE. SQ1324.2 +051900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1324.2 +052000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1324.2 +052100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1324.2 +052200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1324.2 +052300 MOVE XXINFO TO DUMMY-RECORD. SQ1324.2 +052400 PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +052500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1324.2 +052600 GO TO FAIL-ROUTINE-EX. SQ1324.2 +052700 FAIL-ROUTINE-WRITE. SQ1324.2 +052800 MOVE TEST-COMPUTED TO PRINT-REC SQ1324.2 +052900 PERFORM WRITE-LINE SQ1324.2 +053000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1324.2 +053100 MOVE TEST-CORRECT TO PRINT-REC SQ1324.2 +053200 PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +053300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1324.2 +053400 FAIL-ROUTINE-EX. SQ1324.2 +053500 EXIT. SQ1324.2 +053600 BAIL-OUT. SQ1324.2 +053700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1324.2 +053800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1324.2 +053900 BAIL-OUT-WRITE. SQ1324.2 +054000 MOVE CORRECT-A TO XXCORRECT. SQ1324.2 +054100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1324.2 +054200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1324.2 +054300 MOVE XXINFO TO DUMMY-RECORD. SQ1324.2 +054400 PERFORM WRITE-LINE 2 TIMES. SQ1324.2 +054500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1324.2 +054600 BAIL-OUT-EX. SQ1324.2 +054700 EXIT. SQ1324.2 +054800 CCVS1-EXIT. SQ1324.2 +054900 EXIT. SQ1324.2 +055000* SQ1324.2 +055100*************************************************************** SQ1324.2 +055200* * SQ1324.2 +055300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND* SQ1324.2 +055400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1324.2 +055500* * SQ1324.2 +055600*************************************************************** SQ1324.2 +055700* SQ1324.2 +055800 SECT-SQ132A-0001 SECTION. SQ1324.2 +055900* SQ1324.2 +056000* THIS TEST CLOSES A FILE THAT HAS NEVER BEEN OPENED. SQ1324.2 +056100* I-O STATUS CODE 42 SHOULD BE GENERATED. SQ1324.2 +056200* SQ1324.2 +056300 CLOSE-INIT-O1. SQ1324.2 +056400 MOVE "CLOSED UNOPENED FILE" TO FEATURE. SQ1324.2 +056500 MOVE "**" TO SQ-FS1-STATUS. SQ1324.2 +056600 MOVE "CLOS-TEST-01" TO PAR-NAME. SQ1324.2 +056700 MOVE 1 TO REC-CT. SQ1324.2 +056800* SQ1324.2 +056900 CLOSE-TEST-01. SQ1324.2 +057000 IF REC-CT = 0 SQ1324.2 +057100 OPEN INPUT SQ-FS1. SQ1324.2 +057200* THIS IF STATEMENT SHOULD NEVER BE TRUE. IT IS INCLUDED IN SQ1324.2 +057300* AN ATTEMPT TO AVOID A COMPILER DETECTING THE CLOSE OF AN SQ1324.2 +057400* UNOPENED FILE WITHOUT EXECUTING THE PROGRAM. HOWEVER, IF SQ1324.2 +057500* THE DETECTION IS MADE AT COMPILE TIME, THE TEST SHOULD BE SQ1324.2 +057600* CONSIDERED PASSED. SQ1324.2 +057700* SQ1324.2 +057800 CLOSE SQ-FS1. SQ1324.2 +057900* SQ1324.2 +058000 CCVS-EXIT SECTION. SQ1324.2 +058100 CCVS-999999. SQ1324.2 +058200 GO TO CLOSE-FILES. SQ1324.2 diff --git a/tests/cobol85/SQ/SQ133A.CBL b/tests/cobol85/SQ/SQ133A.CBL new file mode 100755 index 00000000..992e9602 --- /dev/null +++ b/tests/cobol85/SQ/SQ133A.CBL @@ -0,0 +1,1113 @@ +000100 IDENTIFICATION DIVISION. SQ1334.2 +000200 PROGRAM-ID. SQ1334.2 +000300 SQ133A. SQ1334.2 +000400**************************************************************** SQ1334.2 +000500* * SQ1334.2 +000600* VALIDATION FOR:- * SQ1334.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1334.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1334.2 +000900* REVISED 1986, AUGUST * SQ1334.2 +001000* * SQ1334.2 +001100* CREATION DATE / VALIDATION DATE * SQ1334.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1334.2 +001300* * SQ1334.2 +001400**************************************************************** SQ1334.2 +001500* * SQ1334.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1334.2 +001700* * SQ1334.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1334.2 +001900* X-55 SYSTEM PRINTER * SQ1334.2 +002000* X-82 SOURCE-COMPUTER * SQ1334.2 +002100* X-83 OBJECT-COMPUTER. * SQ1334.2 +002200* * SQ1334.2 +002300**************************************************************** SQ1334.2 +002400* * SQ1334.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ1334.2 +002600* TO A MASS STORAGE MEDIUM, WRITES ONE RECORD AND CLOSES * SQ1334.2 +002700* THE FILE. THE FILE IS THEN OPENED FOR I-O, AND TWO READ * SQ1334.2 +002800* STATEMENTS EXECUTED. THE SECOND SHOULD CAUSE AN AT END * SQ1334.2 +002900* CONDITION, AND THUS BE UNSUCCESSFUL. A REWRITE STATEMENT * SQ1334.2 +003000* IS THEN EXECUTED. THIS SHOULD CAUSE AN EXCEPTION * SQ1334.2 +003100* CONDITION, WITH I-O STATUS "43" AND ENTRY TO THE * SQ1334.2 +003200* APPLICABLE ERROR DECLARATIVE. * SQ1334.2 +003300* * SQ1334.2 +003400* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ1334.2 +003500* THE NEW PROGRAM IS SQ144A. * SQ1334.2 +003600**************************************************************** SQ1334.2 +003700* SQ1334.2 +003800 ENVIRONMENT DIVISION. SQ1334.2 +003900 CONFIGURATION SECTION. SQ1334.2 +004000 SOURCE-COMPUTER. SQ1334.2 +004100 Linux. SQ1334.2 +004200 OBJECT-COMPUTER. SQ1334.2 +004300 Linux. SQ1334.2 +004400* SQ1334.2 +004500 INPUT-OUTPUT SECTION. SQ1334.2 +004600 FILE-CONTROL. SQ1334.2 +004700 SELECT PRINT-FILE ASSIGN TO SQ1334.2 +004800 "report.log". SQ1334.2 +004900* SQ1334.2 +005000*P SELECT RAW-DATA ASSIGN TO SQ1334.2 +005100*P "XXXXX062" SQ1334.2 +005200*P ORGANIZATION IS INDEXED SQ1334.2 +005300*P ACCESS MODE IS RANDOM SQ1334.2 +005400*P RECORD-KEY IS RAW-DATA-KEY. SQ1334.2 +005500*P SQ1334.2 +005600 SELECT SQ-FS4 SQ1334.2 +005700 ASSIGN SQ1334.2 +005800 "XXXXX014" SQ1334.2 +005900 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ1334.2 +006000 SEQUENTIAL SQ1334.2 +006100 . SQ1334.2 +006200* SQ1334.2 +006300* SQ1334.2 +006400 DATA DIVISION. SQ1334.2 +006500 FILE SECTION. SQ1334.2 +006600 FD PRINT-FILE SQ1334.2 +006700*C LABEL RECORDS SQ1334.2 +006800*C OMITTED SQ1334.2 +006900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1334.2 +007000 . SQ1334.2 +007100 01 PRINT-REC PICTURE X(120). SQ1334.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ1334.2 +007300*P SQ1334.2 +007400*PD RAW-DATA. SQ1334.2 +007500*P1 RAW-DATA-SATZ. SQ1334.2 +007600*P 05 RAW-DATA-KEY PIC X(6). SQ1334.2 +007700*P 05 C-DATE PIC 9(6). SQ1334.2 +007800*P 05 C-TIME PIC 9(8). SQ1334.2 +007900*P 05 NO-OF-TESTS PIC 99. SQ1334.2 +008000*P 05 C-OK PIC 999. SQ1334.2 +008100*P 05 C-ALL PIC 999. SQ1334.2 +008200*P 05 C-FAIL PIC 999. SQ1334.2 +008300*P 05 C-DELETED PIC 999. SQ1334.2 +008400*P 05 C-INSPECT PIC 999. SQ1334.2 +008500*P 05 C-NOTE PIC X(13). SQ1334.2 +008600*P 05 C-INDENT PIC X. SQ1334.2 +008700*P 05 C-ABORT PIC X(8). SQ1334.2 +008800* SQ1334.2 +008900 FD SQ-FS4 SQ1334.2 +009000*C LABEL RECORD IS STANDARD SQ1334.2 +009100 BLOCK 120 CHARACTERS SQ1334.2 +009200 RECORD CONTAINS 120 CHARACTERS SQ1334.2 +009300 . SQ1334.2 +009400 01 SQ-FS4R1-F-G-120. SQ1334.2 +009500 05 FFILE-RECORD-INFO-P1-120. SQ1334.2 +009600 07 FILLER PIC X(5). SQ1334.2 +009700 07 FFILE-NAME PIC X(6). SQ1334.2 +009800 07 FILLER PIC X(8). SQ1334.2 +009900 07 FRECORD-NAME PIC X(6). SQ1334.2 +010000 07 FILLER PIC X(1). SQ1334.2 +010100 07 FREELUNIT-NUMBER PIC 9(1). SQ1334.2 +010200 07 FILLER PIC X(7). SQ1334.2 +010300 07 FRECORD-NUMBER PIC 9(6). SQ1334.2 +010400 07 FILLER PIC X(6). SQ1334.2 +010500 07 FUPDATE-NUMBER PIC 9(2). SQ1334.2 +010600 07 FILLER PIC X(5). SQ1334.2 +010700 07 FODO-NUMBER PIC 9(4). SQ1334.2 +010800 07 FILLER PIC X(5). SQ1334.2 +010900 07 FPROGRAM-NAME PIC X(5). SQ1334.2 +011000 07 FILLER PIC X(7). SQ1334.2 +011100 07 FRECORD-LENGTH PIC 9(6). SQ1334.2 +011200 07 FILLER PIC X(7). SQ1334.2 +011300 07 FCHARS-OR-RECORDS PIC X(2). SQ1334.2 +011400 07 FILLER PIC X(1). SQ1334.2 +011500 07 FBLOCK-SIZE PIC 9(4). SQ1334.2 +011600 07 FILLER PIC X(6). SQ1334.2 +011700 07 FRECORDS-IN-FILE PIC 9(6). SQ1334.2 +011800 07 FILLER PIC X(5). SQ1334.2 +011900 07 FFILE-ORGANIZATION PIC X(2). SQ1334.2 +012000 07 FILLER PIC X(6). SQ1334.2 +012100 07 FLABEL-TYPE PIC X(1). SQ1334.2 +012200* SQ1334.2 +012300 WORKING-STORAGE SECTION. SQ1334.2 +012400* SQ1334.2 +012500*************************************************************** SQ1334.2 +012600* * SQ1334.2 +012700* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1334.2 +012800* * SQ1334.2 +012900*************************************************************** SQ1334.2 +013000* SQ1334.2 +013100 01 STATUS-GROUP. SQ1334.2 +013200 04 SQ-FS4-STATUS. SQ1334.2 +013300 07 SQ-FS4-KEY-1 PIC X. SQ1334.2 +013400 07 SQ-FS4-KEY-2 PIC X. SQ1334.2 +013500* SQ1334.2 +013600 01 DELETE-SW. SQ1334.2 +013700 03 DELETE-SW-1 PIC X. SQ1334.2 +013800 03 DELETE-SW-1-GROUP. SQ1334.2 +013900 05 DELETE-SW-2 PIC X. SQ1334.2 +014000* SQ1334.2 +014100 01 DECL-EXEC-I-O PIC X(12). SQ1334.2 +014200* SQ1334.2 +014300 01 DECL-EXEC-SW PIC X. SQ1334.2 +014400* SQ1334.2 +014500*************************************************************** SQ1334.2 +014600* * SQ1334.2 +014700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1334.2 +014800* * SQ1334.2 +014900*************************************************************** SQ1334.2 +015000* SQ1334.2 +015100 01 REC-SKEL-SUB PIC 99. SQ1334.2 +015200* SQ1334.2 +015300 01 FILE-RECORD-INFORMATION-REC. SQ1334.2 +015400 03 FILE-RECORD-INFO-SKELETON. SQ1334.2 +015500 05 FILLER PICTURE X(48) VALUE SQ1334.2 +015600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1334.2 +015700 05 FILLER PICTURE X(46) VALUE SQ1334.2 +015800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1334.2 +015900 05 FILLER PICTURE X(26) VALUE SQ1334.2 +016000 ",LFIL=000000,ORG= ,LBLR= ". SQ1334.2 +016100 05 FILLER PICTURE X(37) VALUE SQ1334.2 +016200 ",RECKEY= ". SQ1334.2 +016300 05 FILLER PICTURE X(38) VALUE SQ1334.2 +016400 ",ALTKEY1= ". SQ1334.2 +016500 05 FILLER PICTURE X(38) VALUE SQ1334.2 +016600 ",ALTKEY2= ". SQ1334.2 +016700 05 FILLER PICTURE X(7) VALUE SPACE.SQ1334.2 +016800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1334.2 +016900 05 FILE-RECORD-INFO-P1-120. SQ1334.2 +017000 07 FILLER PIC X(5). SQ1334.2 +017100 07 XFILE-NAME PIC X(6). SQ1334.2 +017200 07 FILLER PIC X(8). SQ1334.2 +017300 07 XRECORD-NAME PIC X(6). SQ1334.2 +017400 07 FILLER PIC X(1). SQ1334.2 +017500 07 REELUNIT-NUMBER PIC 9(1). SQ1334.2 +017600 07 FILLER PIC X(7). SQ1334.2 +017700 07 XRECORD-NUMBER PIC 9(6). SQ1334.2 +017800 07 FILLER PIC X(6). SQ1334.2 +017900 07 UPDATE-NUMBER PIC 9(2). SQ1334.2 +018000 07 FILLER PIC X(5). SQ1334.2 +018100 07 ODO-NUMBER PIC 9(4). SQ1334.2 +018200 07 FILLER PIC X(5). SQ1334.2 +018300 07 XPROGRAM-NAME PIC X(5). SQ1334.2 +018400 07 FILLER PIC X(7). SQ1334.2 +018500 07 XRECORD-LENGTH PIC 9(6). SQ1334.2 +018600 07 FILLER PIC X(7). SQ1334.2 +018700 07 CHARS-OR-RECORDS PIC X(2). SQ1334.2 +018800 07 FILLER PIC X(1). SQ1334.2 +018900 07 XBLOCK-SIZE PIC 9(4). SQ1334.2 +019000 07 FILLER PIC X(6). SQ1334.2 +019100 07 RECORDS-IN-FILE PIC 9(6). SQ1334.2 +019200 07 FILLER PIC X(5). SQ1334.2 +019300 07 XFILE-ORGANIZATION PIC X(2). SQ1334.2 +019400 07 FILLER PIC X(6). SQ1334.2 +019500 07 XLABEL-TYPE PIC X(1). SQ1334.2 +019600 05 FILE-RECORD-INFO-P121-240. SQ1334.2 +019700 07 FILLER PIC X(8). SQ1334.2 +019800 07 XRECORD-KEY PIC X(29). SQ1334.2 +019900 07 FILLER PIC X(9). SQ1334.2 +020000 07 ALTERNATE-KEY1 PIC X(29). SQ1334.2 +020100 07 FILLER PIC X(9). SQ1334.2 +020200 07 ALTERNATE-KEY2 PIC X(29). SQ1334.2 +020300 07 FILLER PIC X(7). SQ1334.2 +020400* SQ1334.2 +020500 01 TEST-RESULTS. SQ1334.2 +020600 02 FILLER PIC X VALUE SPACE. SQ1334.2 +020700 02 PAR-NAME. SQ1334.2 +020800 03 FILLER PIC X(14) VALUE SPACE. SQ1334.2 +020900 03 PARDOT-X PIC X VALUE SPACE. SQ1334.2 +021000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1334.2 +021100 02 FILLER PIC X VALUE SPACE. SQ1334.2 +021200 02 FEATURE PIC X(24) VALUE SPACE. SQ1334.2 +021300 02 FILLER PIC X VALUE SPACE. SQ1334.2 +021400 02 P-OR-F PIC X(5) VALUE SPACE. SQ1334.2 +021500 02 FILLER PIC X(9) VALUE SPACE. SQ1334.2 +021600 02 RE-MARK PIC X(61). SQ1334.2 +021700 01 TEST-COMPUTED. SQ1334.2 +021800 02 FILLER PIC X(30) VALUE SPACE. SQ1334.2 +021900 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1334.2 +022000 02 COMPUTED-X. SQ1334.2 +022100 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1334.2 +022200 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1334.2 +022300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1334.2 +022400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1334.2 +022500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1334.2 +022600 03 CM-18V0 REDEFINES COMPUTED-A. SQ1334.2 +022700 04 COMPUTED-18V0 PIC -9(18). SQ1334.2 +022800 04 FILLER PIC X. SQ1334.2 +022900 03 FILLER PIC X(50) VALUE SPACE. SQ1334.2 +023000 01 TEST-CORRECT. SQ1334.2 +023100 02 FILLER PIC X(30) VALUE SPACE. SQ1334.2 +023200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1334.2 +023300 02 CORRECT-X. SQ1334.2 +023400 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1334.2 +023500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1334.2 +023600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1334.2 +023700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1334.2 +023800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1334.2 +023900 03 CR-18V0 REDEFINES CORRECT-A. SQ1334.2 +024000 04 CORRECT-18V0 PIC -9(18). SQ1334.2 +024100 04 FILLER PIC X. SQ1334.2 +024200 03 FILLER PIC X(2) VALUE SPACE. SQ1334.2 +024300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1334.2 +024400* SQ1334.2 +024500 01 CCVS-C-1. SQ1334.2 +024600 02 FILLER PIC IS X VALUE SPACE. SQ1334.2 +024700 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1334.2 +024800 02 FILLER PIC IS X VALUE SPACE. SQ1334.2 +024900 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1334.2 +025000 02 FILLER PIC IS X VALUE SPACE. SQ1334.2 +025100 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1334.2 +025200 02 FILLER PIC IS X(9) VALUE SPACE. SQ1334.2 +025300 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1334.2 +025400 01 CCVS-C-2. SQ1334.2 +025500 02 FILLER PIC X(19) VALUE SPACE. SQ1334.2 +025600 02 FILLER PIC X(6) VALUE "TESTED". SQ1334.2 +025700 02 FILLER PIC X(19) VALUE SPACE. SQ1334.2 +025800 02 FILLER PIC X(4) VALUE "FAIL". SQ1334.2 +025900 02 FILLER PIC X(72) VALUE SPACE. SQ1334.2 +026000* SQ1334.2 +026100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1334.2 +026200 01 REC-CT PIC 99 VALUE ZERO. SQ1334.2 +026300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1334.2 +026400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1334.2 +026500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1334.2 +026600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1334.2 +026700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1334.2 +026800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1334.2 +026900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1334.2 +027000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1334.2 +027100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1334.2 +027200 01 CCVS-H-1. SQ1334.2 +027300 02 FILLER PIC X(39) VALUE SPACES. SQ1334.2 +027400 02 FILLER PIC X(42) VALUE SQ1334.2 +027500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1334.2 +027600 02 FILLER PIC X(39) VALUE SPACES. SQ1334.2 +027700 01 CCVS-H-2A. SQ1334.2 +027800 02 FILLER PIC X(40) VALUE SPACE. SQ1334.2 +027900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1334.2 +028000 02 FILLER PIC XXXX VALUE SQ1334.2 +028100 "4.2 ". SQ1334.2 +028200 02 FILLER PIC X(28) VALUE SQ1334.2 +028300 " COPY - NOT FOR DISTRIBUTION". SQ1334.2 +028400 02 FILLER PIC X(41) VALUE SPACE. SQ1334.2 +028500* SQ1334.2 +028600 01 CCVS-H-2B. SQ1334.2 +028700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1334.2 +028800 02 TEST-ID PIC X(9). SQ1334.2 +028900 02 FILLER PIC X(4) VALUE " IN ". SQ1334.2 +029000 02 FILLER PIC X(12) VALUE SQ1334.2 +029100 " HIGH ". SQ1334.2 +029200 02 FILLER PIC X(22) VALUE SQ1334.2 +029300 " LEVEL VALIDATION FOR ". SQ1334.2 +029400 02 FILLER PIC X(58) VALUE SQ1334.2 +029500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1334.2 +029600 01 CCVS-H-3. SQ1334.2 +029700 02 FILLER PIC X(34) VALUE SQ1334.2 +029800 " FOR OFFICIAL USE ONLY ". SQ1334.2 +029900 02 FILLER PIC X(58) VALUE SQ1334.2 +030000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1334.2 +030100 02 FILLER PIC X(28) VALUE SQ1334.2 +030200 " COPYRIGHT 1985,1986 ". SQ1334.2 +030300 01 CCVS-E-1. SQ1334.2 +030400 02 FILLER PIC X(52) VALUE SPACE. SQ1334.2 +030500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1334.2 +030600 02 ID-AGAIN PIC X(9). SQ1334.2 +030700 02 FILLER PIC X(45) VALUE SPACES. SQ1334.2 +030800 01 CCVS-E-2. SQ1334.2 +030900 02 FILLER PIC X(31) VALUE SPACE. SQ1334.2 +031000 02 FILLER PIC X(21) VALUE SPACE. SQ1334.2 +031100 02 CCVS-E-2-2. SQ1334.2 +031200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1334.2 +031300 03 FILLER PIC X VALUE SPACE. SQ1334.2 +031400 03 ENDER-DESC PIC X(44) VALUE SQ1334.2 +031500 "ERRORS ENCOUNTERED". SQ1334.2 +031600 01 CCVS-E-3. SQ1334.2 +031700 02 FILLER PIC X(22) VALUE SQ1334.2 +031800 " FOR OFFICIAL USE ONLY". SQ1334.2 +031900 02 FILLER PIC X(12) VALUE SPACE. SQ1334.2 +032000 02 FILLER PIC X(58) VALUE SQ1334.2 +032100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1334.2 +032200 02 FILLER PIC X(8) VALUE SPACE. SQ1334.2 +032300 02 FILLER PIC X(20) VALUE SQ1334.2 +032400 " COPYRIGHT 1985,1986". SQ1334.2 +032500 01 CCVS-E-4. SQ1334.2 +032600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1334.2 +032700 02 FILLER PIC X(4) VALUE " OF ". SQ1334.2 +032800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1334.2 +032900 02 FILLER PIC X(40) VALUE SQ1334.2 +033000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1334.2 +033100 01 XXINFO. SQ1334.2 +033200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1334.2 +033300 02 INFO-TEXT. SQ1334.2 +033400 04 FILLER PIC X(8) VALUE SPACE. SQ1334.2 +033500 04 XXCOMPUTED PIC X(20). SQ1334.2 +033600 04 FILLER PIC X(5) VALUE SPACE. SQ1334.2 +033700 04 XXCORRECT PIC X(20). SQ1334.2 +033800 02 INF-ANSI-REFERENCE PIC X(48). SQ1334.2 +033900 01 HYPHEN-LINE. SQ1334.2 +034000 02 FILLER PIC IS X VALUE IS SPACE. SQ1334.2 +034100 02 FILLER PIC IS X(65) VALUE IS "************************SQ1334.2 +034200- "*****************************************". SQ1334.2 +034300 02 FILLER PIC IS X(54) VALUE IS "************************SQ1334.2 +034400- "******************************". SQ1334.2 +034500 01 CCVS-PGM-ID PIC X(9) VALUE SQ1334.2 +034600 "SQ133A". SQ1334.2 +034700* SQ1334.2 +034800* SQ1334.2 +034900 PROCEDURE DIVISION. SQ1334.2 +035000 DECLARATIVES. SQ1334.2 +035100* SQ1334.2 +035200 SECT-SQ133A-0001 SECTION. SQ1334.2 +035300 USE AFTER EXCEPTION PROCEDURE I-O. SQ1334.2 +035400 I-O-ERROR-PROCESS. SQ1334.2 +035500 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +035600 IF DECL-EXEC-SW NOT = SPACE SQ1334.2 +035700 GO TO END-DECLS. SQ1334.2 +035800* SQ1334.2 +035900 MOVE 1 TO REC-CT. SQ1334.2 +036000 MOVE "REWRITE AFTER FAILED RD" TO FEATURE. SQ1334.2 +036100 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ1334.2 +036200 GO TO DCL-REWRITE-01. SQ1334.2 +036300 DECL-DELETE-01. SQ1334.2 +036400 PERFORM DECL-DE-LETE. SQ1334.2 +036500 GO TO DECL-TEST-01-END. SQ1334.2 +036600 DCL-REWRITE-01. SQ1334.2 +036700 IF SQ-FS4-STATUS = "43" SQ1334.2 +036800 PERFORM DECL-PASS SQ1334.2 +036900 ELSE SQ1334.2 +037000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +037100 MOVE "43" TO CORRECT-A SQ1334.2 +037200 MOVE "UNEXPECTED I-O STATUS ON FAILED REWRITE" SQ1334.2 +037300 TO RE-MARK SQ1334.2 +037400 MOVE "VII-4, VII-48,4.5.4(2)" TO ANSI-REFERENCE SQ1334.2 +037500 PERFORM DECL-FAIL. SQ1334.2 +037600 DECL-TEST-01-END. SQ1334.2 +037700* SQ1334.2 +037800 PERFORM DECL-WRITE-LINE. SQ1334.2 +037900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1334.2 +038000 TO DUMMY-RECORD. SQ1334.2 +038100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1334.2 +038200 GO TO END-DECLS. SQ1334.2 +038300* SQ1334.2 +038400* SQ1334.2 +038500 DECL-PASS. SQ1334.2 +038600 MOVE "PASS " TO P-OR-F. SQ1334.2 +038700 ADD 1 TO PASS-COUNTER. SQ1334.2 +038800 PERFORM DECL-PRINT-DETAIL. SQ1334.2 +038900* SQ1334.2 +039000 DECL-FAIL. SQ1334.2 +039100 MOVE "FAIL*" TO P-OR-F. SQ1334.2 +039200 ADD 1 TO ERROR-COUNTER. SQ1334.2 +039300 PERFORM DECL-PRINT-DETAIL. SQ1334.2 +039400* SQ1334.2 +039500 DECL-DE-LETE. SQ1334.2 +039600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1334.2 +039700 MOVE "*****" TO P-OR-F. SQ1334.2 +039800 ADD 1 TO DELETE-COUNTER. SQ1334.2 +039900 PERFORM DECL-PRINT-DETAIL. SQ1334.2 +040000* SQ1334.2 +040100 DECL-PRINT-DETAIL. SQ1334.2 +040200 IF REC-CT NOT EQUAL TO ZERO SQ1334.2 +040300 MOVE "." TO PARDOT-X SQ1334.2 +040400 MOVE REC-CT TO DOTVALUE. SQ1334.2 +040500 MOVE TEST-RESULTS TO PRINT-REC. SQ1334.2 +040600 PERFORM DECL-WRITE-LINE. SQ1334.2 +040700 IF P-OR-F EQUAL TO "FAIL*" SQ1334.2 +040800 PERFORM DECL-WRITE-LINE SQ1334.2 +040900 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1334.2 +041000 ELSE SQ1334.2 +041100 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1334.2 +041200 MOVE SPACE TO P-OR-F. SQ1334.2 +041300 MOVE SPACE TO COMPUTED-X. SQ1334.2 +041400 MOVE SPACE TO CORRECT-X. SQ1334.2 +041500 IF REC-CT EQUAL TO ZERO SQ1334.2 +041600 MOVE SPACE TO PAR-NAME. SQ1334.2 +041700 MOVE SPACE TO RE-MARK. SQ1334.2 +041800* SQ1334.2 +041900 DECL-WRITE-LINE. SQ1334.2 +042000 ADD 1 TO RECORD-COUNT. SQ1334.2 +042100 IF RECORD-COUNT GREATER 50 SQ1334.2 +042200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1334.2 +042300 MOVE SPACE TO DUMMY-RECORD SQ1334.2 +042400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1334.2 +042500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1334.2 +042600 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1334.2 +042700 PERFORM DECL-WRT-LN 2 TIMES SQ1334.2 +042800 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1334.2 +042900 PERFORM DECL-WRT-LN SQ1334.2 +043000 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1334.2 +043100 MOVE ZERO TO RECORD-COUNT. SQ1334.2 +043200 PERFORM DECL-WRT-LN. SQ1334.2 +043300* SQ1334.2 +043400 DECL-WRT-LN. SQ1334.2 +043500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1334.2 +043600 MOVE SPACE TO DUMMY-RECORD. SQ1334.2 +043700* SQ1334.2 +043800 DECL-FAIL-ROUTINE. SQ1334.2 +043900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1334.2 +044000 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1334.2 +044100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1334.2 +044200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1334.2 +044300 MOVE XXINFO TO DUMMY-RECORD. SQ1334.2 +044400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1334.2 +044500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1334.2 +044600 GO TO DECL-FAIL-EX. SQ1334.2 +044700 DECL-FAIL-WRITE. SQ1334.2 +044800 MOVE TEST-COMPUTED TO PRINT-REC SQ1334.2 +044900 PERFORM DECL-WRITE-LINE SQ1334.2 +045000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1334.2 +045100 MOVE TEST-CORRECT TO PRINT-REC SQ1334.2 +045200 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1334.2 +045300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1334.2 +045400 DECL-FAIL-EX. SQ1334.2 +045500 EXIT. SQ1334.2 +045600* SQ1334.2 +045700 DECL-BAIL. SQ1334.2 +045800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1334.2 +045900 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1334.2 +046000 DECL-BAIL-WRITE. SQ1334.2 +046100 MOVE CORRECT-A TO XXCORRECT. SQ1334.2 +046200 MOVE COMPUTED-A TO XXCOMPUTED. SQ1334.2 +046300 MOVE XXINFO TO DUMMY-RECORD. SQ1334.2 +046400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1334.2 +046500 DECL-BAIL-EX. SQ1334.2 +046600 EXIT. SQ1334.2 +046700* SQ1334.2 +046800 END-DECLS. SQ1334.2 +046900 END DECLARATIVES. SQ1334.2 +047000* SQ1334.2 +047100* SQ1334.2 +047200 CCVS1 SECTION. SQ1334.2 +047300 OPEN-FILES. SQ1334.2 +047400*P OPEN I-O RAW-DATA. SQ1334.2 +047500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1334.2 +047600*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1334.2 +047700*P MOVE "ABORTED " TO C-ABORT. SQ1334.2 +047800*P ADD 1 TO C-NO-OF-TESTS. SQ1334.2 +047900*P ACCEPT C-DATE FROM DATE. SQ1334.2 +048000*P ACCEPT C-TIME FROM TIME. SQ1334.2 +048100*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1334.2 +048200*PND-E-1. SQ1334.2 +048300*P CLOSE RAW-DATA. SQ1334.2 +048400 OPEN OUTPUT PRINT-FILE. SQ1334.2 +048500 MOVE CCVS-PGM-ID TO TEST-ID. SQ1334.2 +048600 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1334.2 +048700 MOVE SPACE TO TEST-RESULTS. SQ1334.2 +048800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1334.2 +048900 MOVE ZERO TO REC-SKEL-SUB. SQ1334.2 +049000 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1334.2 +049100 GO TO CCVS1-EXIT. SQ1334.2 +049200* SQ1334.2 +049300 CCVS-INIT-FILE. SQ1334.2 +049400 ADD 1 TO REC-SKL-SUB. SQ1334.2 +049500 MOVE FILE-RECORD-INFO-SKELETON TO SQ1334.2 +049600 FILE-RECORD-INFO (REC-SKL-SUB). SQ1334.2 +049700* SQ1334.2 +049800 CLOSE-FILES. SQ1334.2 +049900 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1334.2 +050000 CLOSE PRINT-FILE. SQ1334.2 +050100*P OPEN I-O RAW-DATA. SQ1334.2 +050200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1334.2 +050300*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1334.2 +050400*P MOVE "OK. " TO C-ABORT. SQ1334.2 +050500*P MOVE PASS-COUNTER TO C-OK. SQ1334.2 +050600*P MOVE ERROR-HOLD TO C-ALL. SQ1334.2 +050700*P MOVE ERROR-COUNTER TO C-FAIL. SQ1334.2 +050800*P MOVE DELETE-CNT TO C-DELETED. SQ1334.2 +050900*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1334.2 +051000*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1334.2 +051100*PND-E-2. SQ1334.2 +051200*P CLOSE RAW-DATA. SQ1334.2 +051300 TERMINATE-CCVS. SQ1334.2 +051400*S EXIT PROGRAM. SQ1334.2 +051500 STOP RUN. SQ1334.2 +051600* SQ1334.2 +051700 INSPT. SQ1334.2 +051800 MOVE "INSPT" TO P-OR-F. SQ1334.2 +051900 ADD 1 TO INSPECT-COUNTER. SQ1334.2 +052000 PERFORM PRINT-DETAIL. SQ1334.2 +052100* SQ1334.2 +052200 PASS. SQ1334.2 +052300 MOVE "PASS " TO P-OR-F. SQ1334.2 +052400 ADD 1 TO PASS-COUNTER. SQ1334.2 +052500 PERFORM PRINT-DETAIL. SQ1334.2 +052600* SQ1334.2 +052700 FAIL. SQ1334.2 +052800 MOVE "FAIL*" TO P-OR-F. SQ1334.2 +052900 ADD 1 TO ERROR-COUNTER. SQ1334.2 +053000 PERFORM PRINT-DETAIL. SQ1334.2 +053100* SQ1334.2 +053200 DE-LETE. SQ1334.2 +053300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1334.2 +053400 MOVE "*****" TO P-OR-F. SQ1334.2 +053500 ADD 1 TO DELETE-COUNTER. SQ1334.2 +053600 PERFORM PRINT-DETAIL. SQ1334.2 +053700* SQ1334.2 +053800 PRINT-DETAIL. SQ1334.2 +053900 IF REC-CT NOT EQUAL TO ZERO SQ1334.2 +054000 MOVE "." TO PARDOT-X SQ1334.2 +054100 MOVE REC-CT TO DOTVALUE. SQ1334.2 +054200 MOVE TEST-RESULTS TO PRINT-REC. SQ1334.2 +054300 PERFORM WRITE-LINE. SQ1334.2 +054400 IF P-OR-F EQUAL TO "FAIL*" SQ1334.2 +054500 PERFORM WRITE-LINE SQ1334.2 +054600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1334.2 +054700 ELSE SQ1334.2 +054800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1334.2 +054900 MOVE SPACE TO P-OR-F. SQ1334.2 +055000 MOVE SPACE TO COMPUTED-X. SQ1334.2 +055100 MOVE SPACE TO CORRECT-X. SQ1334.2 +055200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1334.2 +055300 MOVE SPACE TO RE-MARK. SQ1334.2 +055400* SQ1334.2 +055500 HEAD-ROUTINE. SQ1334.2 +055600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +055700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +055800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1334.2 +055900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1334.2 +056000 COLUMN-NAMES-ROUTINE. SQ1334.2 +056100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1334.2 +056200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +056300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1334.2 +056400 END-ROUTINE. SQ1334.2 +056500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1334.2 +056600 PERFORM WRITE-LINE 5 TIMES. SQ1334.2 +056700 END-RTN-EXIT. SQ1334.2 +056800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1334.2 +056900 PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +057000* SQ1334.2 +057100 END-ROUTINE-1. SQ1334.2 +057200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1334.2 +057300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1334.2 +057400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1334.2 +057500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1334.2 +057600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1334.2 +057700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1334.2 +057800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1334.2 +057900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1334.2 +058000 PERFORM WRITE-LINE. SQ1334.2 +058100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1334.2 +058200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1334.2 +058300 MOVE "NO " TO ERROR-TOTAL SQ1334.2 +058400 ELSE SQ1334.2 +058500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1334.2 +058600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1334.2 +058700 PERFORM WRITE-LINE. SQ1334.2 +058800 END-ROUTINE-13. SQ1334.2 +058900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1334.2 +059000 MOVE "NO " TO ERROR-TOTAL SQ1334.2 +059100 ELSE SQ1334.2 +059200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1334.2 +059300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1334.2 +059400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1334.2 +059500 PERFORM WRITE-LINE. SQ1334.2 +059600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1334.2 +059700 MOVE "NO " TO ERROR-TOTAL SQ1334.2 +059800 ELSE SQ1334.2 +059900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1334.2 +060000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1334.2 +060100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1334.2 +060200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1334.2 +060300* SQ1334.2 +060400 WRITE-LINE. SQ1334.2 +060500 ADD 1 TO RECORD-COUNT. SQ1334.2 +060600 IF RECORD-COUNT GREATER 50 SQ1334.2 +060700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1334.2 +060800 MOVE SPACE TO DUMMY-RECORD SQ1334.2 +060900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1334.2 +061000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1334.2 +061100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1334.2 +061200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1334.2 +061300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1334.2 +061400 MOVE ZERO TO RECORD-COUNT. SQ1334.2 +061500 PERFORM WRT-LN. SQ1334.2 +061600* SQ1334.2 +061700 WRT-LN. SQ1334.2 +061800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1334.2 +061900 MOVE SPACE TO DUMMY-RECORD. SQ1334.2 +062000 BLANK-LINE-PRINT. SQ1334.2 +062100 PERFORM WRT-LN. SQ1334.2 +062200 FAIL-ROUTINE. SQ1334.2 +062300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1334.2 +062400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1334.2 +062500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1334.2 +062600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1334.2 +062700 MOVE XXINFO TO DUMMY-RECORD. SQ1334.2 +062800 PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +062900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1334.2 +063000 GO TO FAIL-ROUTINE-EX. SQ1334.2 +063100 FAIL-ROUTINE-WRITE. SQ1334.2 +063200 MOVE TEST-COMPUTED TO PRINT-REC SQ1334.2 +063300 PERFORM WRITE-LINE SQ1334.2 +063400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1334.2 +063500 MOVE TEST-CORRECT TO PRINT-REC SQ1334.2 +063600 PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +063700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1334.2 +063800 FAIL-ROUTINE-EX. SQ1334.2 +063900 EXIT. SQ1334.2 +064000 BAIL-OUT. SQ1334.2 +064100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1334.2 +064200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1334.2 +064300 BAIL-OUT-WRITE. SQ1334.2 +064400 MOVE CORRECT-A TO XXCORRECT. SQ1334.2 +064500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1334.2 +064600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1334.2 +064700 MOVE XXINFO TO DUMMY-RECORD. SQ1334.2 +064800 PERFORM WRITE-LINE 2 TIMES. SQ1334.2 +064900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1334.2 +065000 BAIL-OUT-EX. SQ1334.2 +065100 EXIT. SQ1334.2 +065200 CCVS1-EXIT. SQ1334.2 +065300 EXIT. SQ1334.2 +065400* SQ1334.2 +065500**************************************************************** SQ1334.2 +065600* * SQ1334.2 +065700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1334.2 +065800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1334.2 +065900* * SQ1334.2 +066000**************************************************************** SQ1334.2 +066100* SQ1334.2 +066200 SECT-SQ133A-0002 SECTION. SQ1334.2 +066300 STA-INIT. SQ1334.2 +066400 MOVE SPACE TO DELETE-SW. SQ1334.2 +066500* SQ1334.2 +066600 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1334.2 +066700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1334.2 +066800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1334.2 +066900 MOVE 120 TO XRECORD-LENGTH (1). SQ1334.2 +067000 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ1334.2 +067100 MOVE 1 TO XBLOCK-SIZE (1). SQ1334.2 +067200 MOVE 1 TO RECORDS-IN-FILE (1). SQ1334.2 +067300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1334.2 +067400 MOVE "S" TO XLABEL-TYPE (1). SQ1334.2 +067500* SQ1334.2 +067600* OPEN THE FILE IN THE OUTPUT MODE SQ1334.2 +067700* SQ1334.2 +067800 SEQ-INIT-01. SQ1334.2 +067900 MOVE 0 TO REC-CT. SQ1334.2 +068000 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +068100 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +068200 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +068300 MOVE ZERO TO XRECORD-NUMBER (1). SQ1334.2 +068400 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1334.2 +068500 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1334.2 +068600 GO TO SEQ-TEST-OP-01. SQ1334.2 +068700 SEQ-DELETE-01. SQ1334.2 +068800 MOVE "*" TO DELETE-SW-1. SQ1334.2 +068900 GO TO SEQ-DELETE-01-01. SQ1334.2 +069000 SEQ-TEST-OP-01. SQ1334.2 +069100 OPEN OUTPUT SQ-FS4. SQ1334.2 +069200* SQ1334.2 +069300* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1334.2 +069400* SQ1334.2 +069500 ADD 1 TO REC-CT. SQ1334.2 +069600 IF DELETE-SW NOT = SPACE SQ1334.2 +069700 GO TO SEQ-DELETE-01-01. SQ1334.2 +069800 GO TO SEQ-TEST-OP-01-01. SQ1334.2 +069900 SEQ-DELETE-01-01. SQ1334.2 +070000 PERFORM DE-LETE. SQ1334.2 +070100 GO TO SEQ-TEST-01-01-END. SQ1334.2 +070200 SEQ-TEST-OP-01-01. SQ1334.2 +070300 IF SQ-FS4-STATUS = "00" SQ1334.2 +070400 PERFORM PASS SQ1334.2 +070500 ELSE SQ1334.2 +070600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +070700 MOVE "00" TO CORRECT-A SQ1334.2 +070800 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1334.2 +070900 TO RE-MARK SQ1334.2 +071000 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ1334.2 +071100 PERFORM FAIL. SQ1334.2 +071200 SEQ-TEST-01-01-END. SQ1334.2 +071300* SQ1334.2 +071400* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +071500* SQ1334.2 +071600 ADD 1 TO REC-CT. SQ1334.2 +071700 IF DELETE-SW NOT = SPACE SQ1334.2 +071800 GO TO SEQ-DELETE-01-02. SQ1334.2 +071900 GO TO SEQ-TEST-OP-01-02. SQ1334.2 +072000 SEQ-DELETE-01-02. SQ1334.2 +072100 PERFORM DE-LETE. SQ1334.2 +072200 GO TO SEQ-TEST-01-02-END. SQ1334.2 +072300 SEQ-TEST-OP-01-02. SQ1334.2 +072400 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +072500 PERFORM PASS SQ1334.2 +072600 ELSE SQ1334.2 +072700 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +072800 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +072900 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +073000 TO RE-MARK SQ1334.2 +073100 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +073200 PERFORM FAIL. SQ1334.2 +073300 SEQ-TEST-01-02-END. SQ1334.2 +073400* SQ1334.2 +073500* SQ1334.2 +073600* A NEW FILE IS OPEN. WE NOW WRITE ONE RECORD. SQ1334.2 +073700* SQ1334.2 +073800 SEQ-INIT-02. SQ1334.2 +073900 MOVE 0 TO REC-CT. SQ1334.2 +074000 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +074100 ADD 1 TO XRECORD-NUMBER (1). SQ1334.2 +074200 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +074300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +074400 MOVE "WRITE A RECORD" TO FEATURE. SQ1334.2 +074500 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1334.2 +074600 IF DELETE-SW NOT EQUAL TO SPACE SQ1334.2 +074700 GO TO SEQ-DELETE-02. SQ1334.2 +074800 GO TO SEQ-TEST-WR-02. SQ1334.2 +074900 SEQ-DELETE-02. SQ1334.2 +075000 MOVE "*" TO DELETE-SW-2. SQ1334.2 +075100 GO TO SEQ-DELETE-02-01. SQ1334.2 +075200 SEQ-TEST-WR-02. SQ1334.2 +075300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1334.2 +075400 WRITE SQ-FS4R1-F-G-120. SQ1334.2 +075500* SQ1334.2 +075600* CHECK I-O STATUS RETURNED FROM WRITE SQ1334.2 +075700* SQ1334.2 +075800 ADD 1 TO REC-CT. SQ1334.2 +075900 IF DELETE-SW NOT = SPACE SQ1334.2 +076000 GO TO SEQ-DELETE-02-01. SQ1334.2 +076100 GO TO SEQ-TEST-WR-02-01. SQ1334.2 +076200 SEQ-DELETE-02-01. SQ1334.2 +076300 PERFORM DE-LETE. SQ1334.2 +076400 GO TO SEQ-TEST-02-01-END. SQ1334.2 +076500 SEQ-TEST-WR-02-01. SQ1334.2 +076600 IF SQ-FS4-STATUS = "00" SQ1334.2 +076700 PERFORM PASS SQ1334.2 +076800 ELSE SQ1334.2 +076900 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +077000 MOVE "00" TO CORRECT-A SQ1334.2 +077100 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ1334.2 +077200 TO RE-MARK SQ1334.2 +077300 MOVE "VII-3, VII-53" TO ANSI-REFERENCE SQ1334.2 +077400 PERFORM FAIL. SQ1334.2 +077500 SEQ-TEST-02-01-END. SQ1334.2 +077600* SQ1334.2 +077700* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +077800* SQ1334.2 +077900 ADD 1 TO REC-CT. SQ1334.2 +078000 IF DELETE-SW NOT = SPACE SQ1334.2 +078100 GO TO SEQ-DELETE-02-02. SQ1334.2 +078200 GO TO SEQ-TEST-WR-02-02. SQ1334.2 +078300 SEQ-DELETE-02-02. SQ1334.2 +078400 PERFORM DE-LETE. SQ1334.2 +078500 GO TO SEQ-TEST-02-02-END. SQ1334.2 +078600 SEQ-TEST-WR-02-02. SQ1334.2 +078700 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +078800 PERFORM PASS SQ1334.2 +078900 ELSE SQ1334.2 +079000 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +079100 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +079200 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +079300 TO RE-MARK SQ1334.2 +079400 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +079500 PERFORM FAIL. SQ1334.2 +079600 SEQ-TEST-02-02-END. SQ1334.2 +079700* SQ1334.2 +079800* SQ1334.2 +079900* NOW CLOSE THE FILE. SQ1334.2 +080000* SQ1334.2 +080100 SEQ-INIT-03. SQ1334.2 +080200 MOVE 0 TO REC-CT. SQ1334.2 +080300 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +080400 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +080500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +080600 MOVE "CLOSE FILE" TO FEATURE. SQ1334.2 +080700 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1334.2 +080800 IF DELETE-SW NOT EQUAL TO SPACE SQ1334.2 +080900 GO TO SEQ-DELETE-03. SQ1334.2 +081000 GO TO SEQ-TEST-CL-03. SQ1334.2 +081100 SEQ-DELETE-03. SQ1334.2 +081200 MOVE "*" TO DELETE-SW-2. SQ1334.2 +081300 GO TO SEQ-DELETE-03-01. SQ1334.2 +081400 SEQ-TEST-CL-03. SQ1334.2 +081500 CLOSE SQ-FS4. SQ1334.2 +081600* SQ1334.2 +081700* CHECK I-O STATUS RETURNED FROM CLOSE SQ1334.2 +081800* SQ1334.2 +081900 ADD 1 TO REC-CT. SQ1334.2 +082000 IF DELETE-SW NOT = SPACE SQ1334.2 +082100 GO TO SEQ-DELETE-03-01. SQ1334.2 +082200 GO TO SEQ-TEST-CL-03-01. SQ1334.2 +082300 SEQ-DELETE-03-01. SQ1334.2 +082400 PERFORM DE-LETE. SQ1334.2 +082500 GO TO SEQ-TEST-03-01-END. SQ1334.2 +082600 SEQ-TEST-CL-03-01. SQ1334.2 +082700 IF SQ-FS4-STATUS = "00" SQ1334.2 +082800 PERFORM PASS SQ1334.2 +082900 ELSE SQ1334.2 +083000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +083100 MOVE "00" TO CORRECT-A SQ1334.2 +083200 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1334.2 +083300 TO RE-MARK SQ1334.2 +083400 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1334.2 +083500 PERFORM FAIL. SQ1334.2 +083600 SEQ-TEST-03-01-END. SQ1334.2 +083700* SQ1334.2 +083800* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +083900* SQ1334.2 +084000 ADD 1 TO REC-CT. SQ1334.2 +084100 IF DELETE-SW NOT = SPACE SQ1334.2 +084200 GO TO SEQ-DELETE-03-02. SQ1334.2 +084300 GO TO SEQ-TEST-CL-03-02. SQ1334.2 +084400 SEQ-DELETE-03-02. SQ1334.2 +084500 PERFORM DE-LETE. SQ1334.2 +084600 GO TO SEQ-TEST-03-02-END. SQ1334.2 +084700 SEQ-TEST-CL-03-02. SQ1334.2 +084800 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +084900 PERFORM PASS SQ1334.2 +085000 ELSE SQ1334.2 +085100 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +085200 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +085300 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +085400 TO RE-MARK SQ1334.2 +085500 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +085600 PERFORM FAIL. SQ1334.2 +085700 SEQ-TEST-03-02-END. SQ1334.2 +085800 MOVE SPACE TO DELETE-SW-2. SQ1334.2 +085900* SQ1334.2 +086000* SQ1334.2 +086100* OPEN THE FILE IN THE I-O MODE SQ1334.2 +086200* SQ1334.2 +086300 SEQ-INIT-04. SQ1334.2 +086400 MOVE 0 TO REC-CT. SQ1334.2 +086500 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +086600 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +086700 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +086800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1334.2 +086900 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ1334.2 +087000 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1334.2 +087100 IF DELETE-SW NOT = SPACE SQ1334.2 +087200 GO TO SEQ-DELETE-04-01. SQ1334.2 +087300 GO TO SEQ-TEST-OP-04. SQ1334.2 +087400 SEQ-DELETE-04. SQ1334.2 +087500 MOVE "*" TO DELETE-SW-2. SQ1334.2 +087600 GO TO SEQ-DELETE-04-01. SQ1334.2 +087700 SEQ-TEST-OP-04. SQ1334.2 +087800 OPEN I-O SQ-FS4. SQ1334.2 +087900* SQ1334.2 +088000* CHECK I-O STATUS RETURNED FROM OPEN I-O SQ1334.2 +088100* SQ1334.2 +088200 ADD 1 TO REC-CT. SQ1334.2 +088300 IF DELETE-SW NOT = SPACE SQ1334.2 +088400 GO TO SEQ-DELETE-04-01. SQ1334.2 +088500 GO TO SEQ-TEST-OP-04-01. SQ1334.2 +088600 SEQ-DELETE-04-01. SQ1334.2 +088700 PERFORM DE-LETE. SQ1334.2 +088800 GO TO SEQ-TEST-04-01-END. SQ1334.2 +088900 SEQ-TEST-OP-04-01. SQ1334.2 +089000 IF SQ-FS4-STATUS = "00" SQ1334.2 +089100 PERFORM PASS SQ1334.2 +089200 ELSE SQ1334.2 +089300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +089400 MOVE "00" TO CORRECT-A SQ1334.2 +089500 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN I-O" SQ1334.2 +089600 TO RE-MARK SQ1334.2 +089700 MOVE "VII-3, VII-40" TO ANSI-REFERENCE SQ1334.2 +089800 PERFORM FAIL. SQ1334.2 +089900 SEQ-TEST-04-01-END. SQ1334.2 +090000* SQ1334.2 +090100* SQ1334.2 +090200 ADD 1 TO REC-CT. SQ1334.2 +090300 IF DELETE-SW NOT = SPACE SQ1334.2 +090400 GO TO SEQ-DELETE-04-02. SQ1334.2 +090500 GO TO SEQ-TEST-OP-04-02. SQ1334.2 +090600 SEQ-DELETE-04-02. SQ1334.2 +090700 PERFORM DE-LETE. SQ1334.2 +090800 GO TO SEQ-TEST-04-02-END. SQ1334.2 +090900 SEQ-TEST-OP-04-02. SQ1334.2 +091000 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +091100 PERFORM PASS SQ1334.2 +091200 ELSE SQ1334.2 +091300 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +091400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +091500 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +091600 TO RE-MARK SQ1334.2 +091700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +091800 PERFORM FAIL. SQ1334.2 +091900 SEQ-TEST-04-02-END. SQ1334.2 +092000* SQ1334.2 +092100* SQ1334.2 +092200* THE FILE IS OPEN FOR I-O. WE READ THE ONLY RECORD. SQ1334.2 +092300* SQ1334.2 +092400 SEQ-INIT-05. SQ1334.2 +092500 MOVE 0 TO REC-CT. SQ1334.2 +092600 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +092700 ADD 1 TO XRECORD-NUMBER (1). SQ1334.2 +092800 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +092900 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +093000 MOVE "READ FIRST RECORD" TO FEATURE. SQ1334.2 +093100 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1334.2 +093200 IF DELETE-SW NOT EQUAL TO SPACE SQ1334.2 +093300 GO TO SEQ-DELETE-05. SQ1334.2 +093400 GO TO SEQ-TEST-RD-05. SQ1334.2 +093500 SEQ-DELETE-05. SQ1334.2 +093600 MOVE "*" TO DELETE-SW-2. SQ1334.2 +093700 GO TO SEQ-DELETE-05-01. SQ1334.2 +093800 SEQ-TEST-RD-05. SQ1334.2 +093900 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1334.2 +094000 READ SQ-FS4. SQ1334.2 +094100* SQ1334.2 +094200* CHECK I-O STATUS RETURNED FROM READ SQ1334.2 +094300* SQ1334.2 +094400 ADD 1 TO REC-CT. SQ1334.2 +094500 IF DELETE-SW NOT = SPACE SQ1334.2 +094600 GO TO SEQ-DELETE-05-01. SQ1334.2 +094700 GO TO SEQ-TEST-RD-05-01. SQ1334.2 +094800 SEQ-DELETE-05-01. SQ1334.2 +094900 PERFORM DE-LETE. SQ1334.2 +095000 GO TO SEQ-TEST-05-01-END. SQ1334.2 +095100 SEQ-TEST-RD-05-01. SQ1334.2 +095200 IF SQ-FS4-STATUS = "00" SQ1334.2 +095300 PERFORM PASS SQ1334.2 +095400 ELSE SQ1334.2 +095500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +095600 MOVE "00" TO CORRECT-A SQ1334.2 +095700 MOVE "UNEXPECTED STATUS CODE FROM READ" SQ1334.2 +095800 TO RE-MARK SQ1334.2 +095900 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1334.2 +096000 PERFORM FAIL. SQ1334.2 +096100 SEQ-TEST-05-01-END. SQ1334.2 +096200* SQ1334.2 +096300* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +096400* SQ1334.2 +096500 ADD 1 TO REC-CT. SQ1334.2 +096600 IF DELETE-SW NOT = SPACE SQ1334.2 +096700 GO TO SEQ-DELETE-05-02. SQ1334.2 +096800 GO TO SEQ-TEST-RD-05-02. SQ1334.2 +096900 SEQ-DELETE-05-02. SQ1334.2 +097000 PERFORM DE-LETE. SQ1334.2 +097100 GO TO SEQ-TEST-05-02-END. SQ1334.2 +097200 SEQ-TEST-RD-05-02. SQ1334.2 +097300 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1334.2 +097400 PERFORM PASS SQ1334.2 +097500 ELSE SQ1334.2 +097600 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +097700 MOVE "NOT EXECUTED" TO CORRECT-A SQ1334.2 +097800 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1334.2 +097900 TO RE-MARK SQ1334.2 +098000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +098100 PERFORM FAIL. SQ1334.2 +098200 SEQ-TEST-05-02-END. SQ1334.2 +098300* SQ1334.2 +098400* CHECK THAT THE CORRECT RECORD HAS BEEN RETURNED, BY SQ1334.2 +098500* CHECKING THE RECORD-NUMBER FIELD. SQ1334.2 +098600* SQ1334.2 +098700 ADD 1 TO REC-CT. SQ1334.2 +098800 IF DELETE-SW NOT = SPACE SQ1334.2 +098900 GO TO SEQ-DELETE-05-03. SQ1334.2 +099000 GO TO SEQ-TEST-RD-05-03. SQ1334.2 +099100 SEQ-DELETE-05-03. SQ1334.2 +099200 PERFORM DE-LETE. SQ1334.2 +099300 GO TO SEQ-TEST-05-03-END. SQ1334.2 +099400 SEQ-TEST-RD-05-03. SQ1334.2 +099500 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ1334.2 +099600 PERFORM PASS SQ1334.2 +099700 ELSE SQ1334.2 +099800 MOVE FRECORD-NUMBER TO COMPUTED-18V0 SQ1334.2 +099900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0 SQ1334.2 +100000 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ1334.2 +100100 PERFORM FAIL. SQ1334.2 +100200 SEQ-TEST-05-03-END. SQ1334.2 +100300 MOVE SPACE TO DELETE-SW-2. SQ1334.2 +100400* SQ1334.2 +100500* SQ1334.2 +100600* ANOTHER READ SHOULD CAUSE THE AT END CONDITION. SQ1334.2 +100700* SQ1334.2 +100800 SEQ-INIT-06. SQ1334.2 +100900 MOVE 0 TO REC-CT. SQ1334.2 +101000 MOVE "*" TO DECL-EXEC-SW. SQ1334.2 +101100 ADD 1 TO XRECORD-NUMBER (1). SQ1334.2 +101200 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +101300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +101400 MOVE "READ GIVING AT END" TO FEATURE. SQ1334.2 +101500 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1334.2 +101600 IF DELETE-SW NOT EQUAL TO SPACE SQ1334.2 +101700 GO TO SEQ-DELETE-06. SQ1334.2 +101800 GO TO SEQ-TEST-RD-06. SQ1334.2 +101900 SEQ-DELETE-06. SQ1334.2 +102000 MOVE "*" TO DELETE-SW-2. SQ1334.2 +102100 GO TO SEQ-DELETE-06-01. SQ1334.2 +102200 SEQ-TEST-RD-06. SQ1334.2 +102300 READ SQ-FS4 RECORD. SQ1334.2 +102400* SQ1334.2 +102500* CHECK I-O STATUS RETURNED FROM READ SQ1334.2 +102600* SQ1334.2 +102700 ADD 1 TO REC-CT. SQ1334.2 +102800 IF DELETE-SW NOT = SPACE SQ1334.2 +102900 GO TO SEQ-DELETE-06-01. SQ1334.2 +103000 GO TO SEQ-TEST-RD-06-01. SQ1334.2 +103100 SEQ-DELETE-06-01. SQ1334.2 +103200 PERFORM DE-LETE. SQ1334.2 +103300 GO TO SEQ-TEST-06-01-END. SQ1334.2 +103400 SEQ-TEST-RD-06-01. SQ1334.2 +103500 IF SQ-FS4-STATUS = "10" SQ1334.2 +103600 PERFORM PASS SQ1334.2 +103700 ELSE SQ1334.2 +103800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +103900 MOVE "10" TO CORRECT-A SQ1334.2 +104000 MOVE "AT END STATUS NOT RETURNED FROM READ" SQ1334.2 +104100 TO RE-MARK SQ1334.2 +104200 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1334.2 +104300 PERFORM FAIL. SQ1334.2 +104400 SEQ-TEST-06-01-END. SQ1334.2 +104500* SQ1334.2 +104600* CHECK EXECUTION OF I-O DECLARATIVE SQ1334.2 +104700* SQ1334.2 +104800 ADD 1 TO REC-CT. SQ1334.2 +104900 IF DELETE-SW NOT = SPACE SQ1334.2 +105000 GO TO SEQ-DELETE-06-02. SQ1334.2 +105100 GO TO SEQ-TEST-RD-06-02. SQ1334.2 +105200 SEQ-DELETE-06-02. SQ1334.2 +105300 PERFORM DE-LETE. SQ1334.2 +105400 GO TO SEQ-TEST-06-02-END. SQ1334.2 +105500 SEQ-TEST-RD-06-02. SQ1334.2 +105600 IF DECL-EXEC-I-O = "EXECUTED" SQ1334.2 +105700 PERFORM PASS SQ1334.2 +105800 ELSE SQ1334.2 +105900 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1334.2 +106000 MOVE "EXECUTED" TO CORRECT-A SQ1334.2 +106100 MOVE "I-O DECLARATIVE NOT EXECUTED AT END OF FILE" SQ1334.2 +106200 TO RE-MARK SQ1334.2 +106300 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1334.2 +106400 PERFORM FAIL. SQ1334.2 +106500 SEQ-TEST-06-02-END. SQ1334.2 +106600* SQ1334.2 +106700* SQ1334.2 +106800* FINALLY, TRY TO EXECUTE A REWRITE AFTER THE FAILED READ SQ1334.2 +106900* SQ1334.2 +107000 SEQ-INIT-07. SQ1334.2 +107100 MOVE 0 TO REC-CT. SQ1334.2 +107200 MOVE SPACE TO DECL-EXEC-SW. SQ1334.2 +107300 MOVE "**" TO SQ-FS4-STATUS. SQ1334.2 +107400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1334.2 +107500 MOVE "REWRITE AFTER AT END" TO FEATURE. SQ1334.2 +107600 MOVE "SEQ-TEST-RW-07" TO PAR-NAME. SQ1334.2 +107700 IF DELETE-SW NOT = SPACE SQ1334.2 +107800 GO TO SEQ-DELETE-07-01. SQ1334.2 +107900 GO TO SEQ-TEST-RW-07. SQ1334.2 +108000 SEQ-DELETE-07. SQ1334.2 +108100 MOVE "*" TO DELETE-SW-2. SQ1334.2 +108200 GO TO SEQ-DELETE-07-01. SQ1334.2 +108300 SEQ-TEST-RW-07. SQ1334.2 +108400 REWRITE SQ-FS4R1-F-G-120. SQ1334.2 +108500 MOVE 0 TO REC-CT. SQ1334.2 +108600 MOVE "REWRITE AFTER AT END" TO FEATURE. SQ1334.2 +108700 MOVE "SEQ-TEST-RW-07" TO PAR-NAME. SQ1334.2 +108800* SQ1334.2 +108900* CHECK I-O STATUS RETURNED FROM REWRITE SQ1334.2 +109000* SQ1334.2 +109100 ADD 1 TO REC-CT. SQ1334.2 +109200 IF DELETE-SW NOT = SPACE SQ1334.2 +109300 GO TO SEQ-DELETE-07-01. SQ1334.2 +109400 GO TO SEQ-TEST-RW-07-01. SQ1334.2 +109500 SEQ-DELETE-07-01. SQ1334.2 +109600 PERFORM DE-LETE. SQ1334.2 +109700 GO TO SEQ-TEST-07-01-END. SQ1334.2 +109800 SEQ-TEST-RW-07-01. SQ1334.2 +109900 IF SQ-FS4-STATUS = "43" SQ1334.2 +110000 PERFORM PASS SQ1334.2 +110100 ELSE SQ1334.2 +110200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1334.2 +110300 MOVE "43" TO CORRECT-A SQ1334.2 +110400 MOVE "UNEXPECTED STATUS CODE FROM FAILED REWRITE" SQ1334.2 +110500 TO RE-MARK SQ1334.2 +110600 MOVE "VII-4,1.5.3(4)C, VII-48" TO ANSI-REFERENCE SQ1334.2 +110700 PERFORM FAIL. SQ1334.2 +110800 SEQ-TEST-07-01-END. SQ1334.2 +110900* SQ1334.2 +111000* SQ1334.2 +111100 CCVS-EXIT SECTION. SQ1334.2 +111200 CCVS-999999. SQ1334.2 +111300 GO TO CLOSE-FILES. SQ1334.2 diff --git a/tests/cobol85/SQ/SQ134A.CBL b/tests/cobol85/SQ/SQ134A.CBL new file mode 100755 index 00000000..46e8396c --- /dev/null +++ b/tests/cobol85/SQ/SQ134A.CBL @@ -0,0 +1,1090 @@ +000100 IDENTIFICATION DIVISION. SQ1344.2 +000200 PROGRAM-ID. SQ1344.2 +000300 SQ134A. SQ1344.2 +000400**************************************************************** SQ1344.2 +000500* * SQ1344.2 +000600* VALIDATION FOR:- * SQ1344.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1344.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1344.2 +000900* REVISED 1986, AUGUST * SQ1344.2 +001000* * SQ1344.2 +001100* CREATION DATE / VALIDATION DATE * SQ1344.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1344.2 +001300* * SQ1344.2 +001400**************************************************************** SQ1344.2 +001500* * SQ1344.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1344.2 +001700* * SQ1344.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1344.2 +001900* X-55 SYSTEM PRINTER * SQ1344.2 +002000* X-82 SOURCE-COMPUTER * SQ1344.2 +002100* X-83 OBJECT-COMPUTER. * SQ1344.2 +002200* * SQ1344.2 +002300**************************************************************** SQ1344.2 +002400* * SQ1344.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ1344.2 +002600* TO A MASS STORAGE MEDIUM, WRITES ONE RECORD AND CLOSES * SQ1344.2 +002700* THE FILE. TWO RECORD SIZES ARE DEFINED FOR THE FILE, BY * SQ1344.2 +002800* MEANS OF THE RECORD CONTAINS CLAUSE. THE FILE IS THEN * SQ1344.2 +002900* OPENED FOR I-O, AND A READ STATEMENT AND A REWRITE * SQ1344.2 +003000* STATEMENT ARE EXECUTED. THE REWRITE STATEMENT REFERENCES * SQ1344.2 +003100* A RECORD OF A DIFFERENT SIZE TO THAT REFERENCED IN THE * SQ1344.2 +003200* WRITE STATEMENT, AND SHOULD CAUSE AN EXCEPTION CONDITION * SQ1344.2 +003300* WITH I-O STATUS "44". THIS LOGIC ERROR SHOULD CAUSE * SQ1344.2 +003400* ENTRY TO THE APPLICABLE ERROR DECLARATIVE. * SQ1344.2 +003500* * SQ1344.2 +003600* THIS PROGRAM SHOULD BE RUN ONLY WHEN AN IMPLEMENTATION * SQ1344.2 +003700* PROVIDES VARIABLE LENGTH RECORDS FOR THE RECORDS CONTAINS * SQ1344.2 +003800* INTEGER TO INTEGER CLAUSE * SQ1344.2 +003900* * SQ1344.2 +004000* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ1344.2 +004100* THE NEW PROGRAM IS SQ145A. * SQ1344.2 +004200**************************************************************** SQ1344.2 +004300* SQ1344.2 +004400 ENVIRONMENT DIVISION. SQ1344.2 +004500 CONFIGURATION SECTION. SQ1344.2 +004600 SOURCE-COMPUTER. SQ1344.2 +004700 Linux. SQ1344.2 +004800 OBJECT-COMPUTER. SQ1344.2 +004900 Linux. SQ1344.2 +005000* SQ1344.2 +005100 INPUT-OUTPUT SECTION. SQ1344.2 +005200 FILE-CONTROL. SQ1344.2 +005300 SELECT PRINT-FILE ASSIGN TO SQ1344.2 +005400 "report.log". SQ1344.2 +005500* SQ1344.2 +005600*P SELECT RAW-DATA ASSIGN TO SQ1344.2 +005700*P "XXXXX062" SQ1344.2 +005800*P ORGANIZATION IS INDEXED SQ1344.2 +005900*P ACCESS MODE IS RANDOM SQ1344.2 +006000*P RECORD-KEY IS RAW-DATA-KEY. SQ1344.2 +006100*P SQ1344.2 +006200 SELECT SQ-FS4 SQ1344.2 +006300 ASSIGN SQ1344.2 +006400 "XXXXX014" SQ1344.2 +006500 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ1344.2 +006600 SEQUENTIAL SQ1344.2 +006700 . SQ1344.2 +006800* SQ1344.2 +006900* SQ1344.2 +007000 DATA DIVISION. SQ1344.2 +007100 FILE SECTION. SQ1344.2 +007200 FD PRINT-FILE SQ1344.2 +007300*C LABEL RECORDS SQ1344.2 +007400*C OMITTED SQ1344.2 +007500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1344.2 +007600 . SQ1344.2 +007700 01 PRINT-REC PICTURE X(120). SQ1344.2 +007800 01 DUMMY-RECORD PICTURE X(120). SQ1344.2 +007900*P SQ1344.2 +008000*PD RAW-DATA. SQ1344.2 +008100*P1 RAW-DATA-SATZ. SQ1344.2 +008200*P 05 RAW-DATA-KEY PIC X(6). SQ1344.2 +008300*P 05 C-DATE PIC 9(6). SQ1344.2 +008400*P 05 C-TIME PIC 9(8). SQ1344.2 +008500*P 05 NO-OF-TESTS PIC 99. SQ1344.2 +008600*P 05 C-OK PIC 999. SQ1344.2 +008700*P 05 C-ALL PIC 999. SQ1344.2 +008800*P 05 C-FAIL PIC 999. SQ1344.2 +008900*P 05 C-DELETED PIC 999. SQ1344.2 +009000*P 05 C-INSPECT PIC 999. SQ1344.2 +009100*P 05 C-NOTE PIC X(13). SQ1344.2 +009200*P 05 C-INDENT PIC X. SQ1344.2 +009300*P 05 C-ABORT PIC X(8). SQ1344.2 +009400* SQ1344.2 +009500 FD SQ-FS4 SQ1344.2 +009600*C LABEL RECORD IS STANDARD SQ1344.2 +009700 BLOCK 120 CHARACTERS SQ1344.2 +009800 RECORD CONTAINS 120 TO 138 CHARACTERS SQ1344.2 +009900 . SQ1344.2 +010000 01 SQ-FS4R1-F-G-120. SQ1344.2 +010100 05 FFILE-RECORD-INFO-P1-120. SQ1344.2 +010200 07 FILLER PIC X(5). SQ1344.2 +010300 07 FFILE-NAME PIC X(6). SQ1344.2 +010400 07 FILLER PIC X(8). SQ1344.2 +010500 07 FRECORD-NAME PIC X(6). SQ1344.2 +010600 07 FILLER PIC X(1). SQ1344.2 +010700 07 FREELUNIT-NUMBER PIC 9(1). SQ1344.2 +010800 07 FILLER PIC X(7). SQ1344.2 +010900 07 FRECORD-NUMBER PIC 9(6). SQ1344.2 +011000 07 FILLER PIC X(6). SQ1344.2 +011100 07 FUPDATE-NUMBER PIC 9(2). SQ1344.2 +011200 07 FILLER PIC X(5). SQ1344.2 +011300 07 FODO-NUMBER PIC 9(4). SQ1344.2 +011400 07 FILLER PIC X(5). SQ1344.2 +011500 07 FPROGRAM-NAME PIC X(5). SQ1344.2 +011600 07 FILLER PIC X(7). SQ1344.2 +011700 07 FRECORD-LENGTH PIC 9(6). SQ1344.2 +011800 07 FILLER PIC X(7). SQ1344.2 +011900 07 FCHARS-OR-RECORDS PIC X(2). SQ1344.2 +012000 07 FILLER PIC X(1). SQ1344.2 +012100 07 FBLOCK-SIZE PIC 9(4). SQ1344.2 +012200 07 FILLER PIC X(6). SQ1344.2 +012300 07 FRECORDS-IN-FILE PIC 9(6). SQ1344.2 +012400 07 FILLER PIC X(5). SQ1344.2 +012500 07 FFILE-ORGANIZATION PIC X(2). SQ1344.2 +012600 07 FILLER PIC X(6). SQ1344.2 +012700 07 FLABEL-TYPE PIC X(1). SQ1344.2 +012800* SQ1344.2 +012900 01 SQ-FS4R2-F-G-138. SQ1344.2 +013000 03 FILLER PIC X(120). SQ1344.2 +013100 03 EXT-18 PIC X(18). SQ1344.2 +013200* SQ1344.2 +013300 WORKING-STORAGE SECTION. SQ1344.2 +013400* SQ1344.2 +013500*************************************************************** SQ1344.2 +013600* * SQ1344.2 +013700* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1344.2 +013800* * SQ1344.2 +013900*************************************************************** SQ1344.2 +014000* SQ1344.2 +014100 01 STATUS-GROUP. SQ1344.2 +014200 04 SQ-FS4-STATUS. SQ1344.2 +014300 07 SQ-FS4-KEY-1 PIC X. SQ1344.2 +014400 07 SQ-FS4-KEY-2 PIC X. SQ1344.2 +014500* SQ1344.2 +014600 01 DELETE-SW. SQ1344.2 +014700 03 DELETE-SW-1 PIC X. SQ1344.2 +014800 03 DELETE-SW-1-GROUP. SQ1344.2 +014900 05 DELETE-SW-2 PIC X. SQ1344.2 +015000* SQ1344.2 +015100 01 DECL-EXEC-I-O PIC X(12). SQ1344.2 +015200* SQ1344.2 +015300 01 DECL-EXEC-SW PIC X. SQ1344.2 +015400* SQ1344.2 +015500*************************************************************** SQ1344.2 +015600* * SQ1344.2 +015700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1344.2 +015800* * SQ1344.2 +015900*************************************************************** SQ1344.2 +016000* SQ1344.2 +016100 01 REC-SKEL-SUB PIC 99. SQ1344.2 +016200* SQ1344.2 +016300 01 FILE-RECORD-INFORMATION-REC. SQ1344.2 +016400 03 FILE-RECORD-INFO-SKELETON. SQ1344.2 +016500 05 FILLER PICTURE X(48) VALUE SQ1344.2 +016600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1344.2 +016700 05 FILLER PICTURE X(46) VALUE SQ1344.2 +016800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1344.2 +016900 05 FILLER PICTURE X(26) VALUE SQ1344.2 +017000 ",LFIL=000000,ORG= ,LBLR= ". SQ1344.2 +017100 05 FILLER PICTURE X(37) VALUE SQ1344.2 +017200 ",RECKEY= ". SQ1344.2 +017300 05 FILLER PICTURE X(38) VALUE SQ1344.2 +017400 ",ALTKEY1= ". SQ1344.2 +017500 05 FILLER PICTURE X(38) VALUE SQ1344.2 +017600 ",ALTKEY2= ". SQ1344.2 +017700 05 FILLER PICTURE X(7) VALUE SPACE.SQ1344.2 +017800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1344.2 +017900 05 FILE-RECORD-INFO-P1-120. SQ1344.2 +018000 07 FILLER PIC X(5). SQ1344.2 +018100 07 XFILE-NAME PIC X(6). SQ1344.2 +018200 07 FILLER PIC X(8). SQ1344.2 +018300 07 XRECORD-NAME PIC X(6). SQ1344.2 +018400 07 FILLER PIC X(1). SQ1344.2 +018500 07 REELUNIT-NUMBER PIC 9(1). SQ1344.2 +018600 07 FILLER PIC X(7). SQ1344.2 +018700 07 XRECORD-NUMBER PIC 9(6). SQ1344.2 +018800 07 FILLER PIC X(6). SQ1344.2 +018900 07 UPDATE-NUMBER PIC 9(2). SQ1344.2 +019000 07 FILLER PIC X(5). SQ1344.2 +019100 07 ODO-NUMBER PIC 9(4). SQ1344.2 +019200 07 FILLER PIC X(5). SQ1344.2 +019300 07 XPROGRAM-NAME PIC X(5). SQ1344.2 +019400 07 FILLER PIC X(7). SQ1344.2 +019500 07 XRECORD-LENGTH PIC 9(6). SQ1344.2 +019600 07 FILLER PIC X(7). SQ1344.2 +019700 07 CHARS-OR-RECORDS PIC X(2). SQ1344.2 +019800 07 FILLER PIC X(1). SQ1344.2 +019900 07 XBLOCK-SIZE PIC 9(4). SQ1344.2 +020000 07 FILLER PIC X(6). SQ1344.2 +020100 07 RECORDS-IN-FILE PIC 9(6). SQ1344.2 +020200 07 FILLER PIC X(5). SQ1344.2 +020300 07 XFILE-ORGANIZATION PIC X(2). SQ1344.2 +020400 07 FILLER PIC X(6). SQ1344.2 +020500 07 XLABEL-TYPE PIC X(1). SQ1344.2 +020600 05 FILE-RECORD-INFO-P121-240. SQ1344.2 +020700 07 FILLER PIC X(8). SQ1344.2 +020800 07 XRECORD-KEY PIC X(29). SQ1344.2 +020900 07 FILLER PIC X(9). SQ1344.2 +021000 07 ALTERNATE-KEY1 PIC X(29). SQ1344.2 +021100 07 FILLER PIC X(9). SQ1344.2 +021200 07 ALTERNATE-KEY2 PIC X(29). SQ1344.2 +021300 07 FILLER PIC X(7). SQ1344.2 +021400* SQ1344.2 +021500 01 TEST-RESULTS. SQ1344.2 +021600 02 FILLER PIC X VALUE SPACE. SQ1344.2 +021700 02 PAR-NAME. SQ1344.2 +021800 03 FILLER PIC X(14) VALUE SPACE. SQ1344.2 +021900 03 PARDOT-X PIC X VALUE SPACE. SQ1344.2 +022000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1344.2 +022100 02 FILLER PIC X VALUE SPACE. SQ1344.2 +022200 02 FEATURE PIC X(24) VALUE SPACE. SQ1344.2 +022300 02 FILLER PIC X VALUE SPACE. SQ1344.2 +022400 02 P-OR-F PIC X(5) VALUE SPACE. SQ1344.2 +022500 02 FILLER PIC X(9) VALUE SPACE. SQ1344.2 +022600 02 RE-MARK PIC X(61). SQ1344.2 +022700 01 TEST-COMPUTED. SQ1344.2 +022800 02 FILLER PIC X(30) VALUE SPACE. SQ1344.2 +022900 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1344.2 +023000 02 COMPUTED-X. SQ1344.2 +023100 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1344.2 +023200 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1344.2 +023300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1344.2 +023400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1344.2 +023500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1344.2 +023600 03 CM-18V0 REDEFINES COMPUTED-A. SQ1344.2 +023700 04 COMPUTED-18V0 PIC -9(18). SQ1344.2 +023800 04 FILLER PIC X. SQ1344.2 +023900 03 FILLER PIC X(50) VALUE SPACE. SQ1344.2 +024000 01 TEST-CORRECT. SQ1344.2 +024100 02 FILLER PIC X(30) VALUE SPACE. SQ1344.2 +024200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1344.2 +024300 02 CORRECT-X. SQ1344.2 +024400 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1344.2 +024500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1344.2 +024600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1344.2 +024700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1344.2 +024800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1344.2 +024900 03 CR-18V0 REDEFINES CORRECT-A. SQ1344.2 +025000 04 CORRECT-18V0 PIC -9(18). SQ1344.2 +025100 04 FILLER PIC X. SQ1344.2 +025200 03 FILLER PIC X(2) VALUE SPACE. SQ1344.2 +025300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1344.2 +025400* SQ1344.2 +025500 01 CCVS-C-1. SQ1344.2 +025600 02 FILLER PIC IS X VALUE SPACE. SQ1344.2 +025700 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1344.2 +025800 02 FILLER PIC IS X VALUE SPACE. SQ1344.2 +025900 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1344.2 +026000 02 FILLER PIC IS X VALUE SPACE. SQ1344.2 +026100 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1344.2 +026200 02 FILLER PIC IS X(9) VALUE SPACE. SQ1344.2 +026300 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1344.2 +026400 01 CCVS-C-2. SQ1344.2 +026500 02 FILLER PIC X(19) VALUE SPACE. SQ1344.2 +026600 02 FILLER PIC X(6) VALUE "TESTED". SQ1344.2 +026700 02 FILLER PIC X(19) VALUE SPACE. SQ1344.2 +026800 02 FILLER PIC X(4) VALUE "FAIL". SQ1344.2 +026900 02 FILLER PIC X(72) VALUE SPACE. SQ1344.2 +027000* SQ1344.2 +027100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1344.2 +027200 01 REC-CT PIC 99 VALUE ZERO. SQ1344.2 +027300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1344.2 +027400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1344.2 +027500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1344.2 +027600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1344.2 +027700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1344.2 +027800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1344.2 +027900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1344.2 +028000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1344.2 +028100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1344.2 +028200 01 CCVS-H-1. SQ1344.2 +028300 02 FILLER PIC X(39) VALUE SPACES. SQ1344.2 +028400 02 FILLER PIC X(42) VALUE SQ1344.2 +028500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1344.2 +028600 02 FILLER PIC X(39) VALUE SPACES. SQ1344.2 +028700 01 CCVS-H-2A. SQ1344.2 +028800 02 FILLER PIC X(40) VALUE SPACE. SQ1344.2 +028900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1344.2 +029000 02 FILLER PIC XXXX VALUE SQ1344.2 +029100 "4.2 ". SQ1344.2 +029200 02 FILLER PIC X(28) VALUE SQ1344.2 +029300 " COPY - NOT FOR DISTRIBUTION". SQ1344.2 +029400 02 FILLER PIC X(41) VALUE SPACE. SQ1344.2 +029500* SQ1344.2 +029600 01 CCVS-H-2B. SQ1344.2 +029700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1344.2 +029800 02 TEST-ID PIC X(9). SQ1344.2 +029900 02 FILLER PIC X(4) VALUE " IN ". SQ1344.2 +030000 02 FILLER PIC X(12) VALUE SQ1344.2 +030100 " HIGH ". SQ1344.2 +030200 02 FILLER PIC X(22) VALUE SQ1344.2 +030300 " LEVEL VALIDATION FOR ". SQ1344.2 +030400 02 FILLER PIC X(58) VALUE SQ1344.2 +030500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1344.2 +030600 01 CCVS-H-3. SQ1344.2 +030700 02 FILLER PIC X(34) VALUE SQ1344.2 +030800 " FOR OFFICIAL USE ONLY ". SQ1344.2 +030900 02 FILLER PIC X(58) VALUE SQ1344.2 +031000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1344.2 +031100 02 FILLER PIC X(28) VALUE SQ1344.2 +031200 " COPYRIGHT 1985,1986 ". SQ1344.2 +031300 01 CCVS-E-1. SQ1344.2 +031400 02 FILLER PIC X(52) VALUE SPACE. SQ1344.2 +031500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1344.2 +031600 02 ID-AGAIN PIC X(9). SQ1344.2 +031700 02 FILLER PIC X(45) VALUE SPACES. SQ1344.2 +031800 01 CCVS-E-2. SQ1344.2 +031900 02 FILLER PIC X(31) VALUE SPACE. SQ1344.2 +032000 02 FILLER PIC X(21) VALUE SPACE. SQ1344.2 +032100 02 CCVS-E-2-2. SQ1344.2 +032200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1344.2 +032300 03 FILLER PIC X VALUE SPACE. SQ1344.2 +032400 03 ENDER-DESC PIC X(44) VALUE SQ1344.2 +032500 "ERRORS ENCOUNTERED". SQ1344.2 +032600 01 CCVS-E-3. SQ1344.2 +032700 02 FILLER PIC X(22) VALUE SQ1344.2 +032800 " FOR OFFICIAL USE ONLY". SQ1344.2 +032900 02 FILLER PIC X(12) VALUE SPACE. SQ1344.2 +033000 02 FILLER PIC X(58) VALUE SQ1344.2 +033100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1344.2 +033200 02 FILLER PIC X(8) VALUE SPACE. SQ1344.2 +033300 02 FILLER PIC X(20) VALUE SQ1344.2 +033400 " COPYRIGHT 1985,1986". SQ1344.2 +033500 01 CCVS-E-4. SQ1344.2 +033600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1344.2 +033700 02 FILLER PIC X(4) VALUE " OF ". SQ1344.2 +033800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1344.2 +033900 02 FILLER PIC X(40) VALUE SQ1344.2 +034000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1344.2 +034100 01 XXINFO. SQ1344.2 +034200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1344.2 +034300 02 INFO-TEXT. SQ1344.2 +034400 04 FILLER PIC X(8) VALUE SPACE. SQ1344.2 +034500 04 XXCOMPUTED PIC X(20). SQ1344.2 +034600 04 FILLER PIC X(5) VALUE SPACE. SQ1344.2 +034700 04 XXCORRECT PIC X(20). SQ1344.2 +034800 02 INF-ANSI-REFERENCE PIC X(48). SQ1344.2 +034900 01 HYPHEN-LINE. SQ1344.2 +035000 02 FILLER PIC IS X VALUE IS SPACE. SQ1344.2 +035100 02 FILLER PIC IS X(65) VALUE IS "************************SQ1344.2 +035200- "*****************************************". SQ1344.2 +035300 02 FILLER PIC IS X(54) VALUE IS "************************SQ1344.2 +035400- "******************************". SQ1344.2 +035500 01 CCVS-PGM-ID PIC X(9) VALUE SQ1344.2 +035600 "SQ134A". SQ1344.2 +035700* SQ1344.2 +035800* SQ1344.2 +035900 PROCEDURE DIVISION. SQ1344.2 +036000 DECLARATIVES. SQ1344.2 +036100* SQ1344.2 +036200 SECT-SQ134A-0001 SECTION. SQ1344.2 +036300 USE AFTER EXCEPTION PROCEDURE I-O. SQ1344.2 +036400 I-O-ERROR-PROCESS. SQ1344.2 +036500 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +036600 IF DECL-EXEC-SW NOT = SPACE SQ1344.2 +036700 GO TO END-DECLS. SQ1344.2 +036800* SQ1344.2 +036900 MOVE 1 TO REC-CT. SQ1344.2 +037000 MOVE "REWRITE SHORTER RECORD" TO FEATURE. SQ1344.2 +037100 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ1344.2 +037200 GO TO DCL-REWRITE-01-01. SQ1344.2 +037300 DECL-DELETE-01-01. SQ1344.2 +037400 PERFORM DECL-DE-LETE. SQ1344.2 +037500 GO TO DECL-TEST-01-01-END. SQ1344.2 +037600 DCL-REWRITE-01-01. SQ1344.2 +037700 IF SQ-FS4-STATUS = "44" SQ1344.2 +037800 PERFORM DECL-PASS SQ1344.2 +037900 ELSE SQ1344.2 +038000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +038100 MOVE "44" TO CORRECT-A SQ1344.2 +038200 MOVE "UNEXPECTED I-O STATUS ON FAILED REWRITE" SQ1344.2 +038300 TO RE-MARK SQ1344.2 +038400 MOVE "VII-4, VII-48,4.5.4(2)" TO ANSI-REFERENCE SQ1344.2 +038500 PERFORM DECL-FAIL. SQ1344.2 +038600 DECL-TEST-01-01-END. SQ1344.2 +038700* SQ1344.2 +038800 ADD 1 TO REC-CT. SQ1344.2 +038900 GO TO DCL-REWRITE-01-02. SQ1344.2 +039000 DECL-DELETE-01-02. SQ1344.2 +039100 PERFORM DECL-DE-LETE. SQ1344.2 +039200 GO TO DECL-TEST-01-02-END. SQ1344.2 +039300 DCL-REWRITE-01-02. SQ1344.2 +039400 IF SQ-FS4R1-F-G-120 = FILE-RECORD-INFO-P1-120 (1) SQ1344.2 +039500 PERFORM DECL-PASS SQ1344.2 +039600 ELSE SQ1344.2 +039700 MOVE "FIRST 120 CHARACTERS OF RECORD AREA CHANGED" SQ1344.2 +039800 TO RE-MARK SQ1344.2 +039900 MOVE "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE SQ1344.2 +040000 PERFORM DECL-FAIL. SQ1344.2 +040100 DECL-TEST-01-02-END. SQ1344.2 +040200* SQ1344.2 +040300 ADD 1 TO REC-CT. SQ1344.2 +040400 GO TO DCL-REWRITE-01-03. SQ1344.2 +040500 DECL-DELETE-01-03. SQ1344.2 +040600 PERFORM DECL-DE-LETE. SQ1344.2 +040700 GO TO DECL-TEST-01-03-END. SQ1344.2 +040800 DCL-REWRITE-01-03. SQ1344.2 +040900 IF EXT-18 = "ABCDEFGHIJKLMNOPQR" SQ1344.2 +041000 PERFORM DECL-PASS SQ1344.2 +041100 ELSE SQ1344.2 +041200 MOVE EXT-18 TO COMPUTED-A SQ1344.2 +041300 MOVE "ABCDEFGHIJKLMNOPQR" TO CORRECT-A SQ1344.2 +041400 MOVE "LAST 18 CHARACTERS OF RECORD CHANGED" SQ1344.2 +041500 TO RE-MARK SQ1344.2 +041600 MOVE "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE SQ1344.2 +041700 PERFORM DECL-FAIL. SQ1344.2 +041800 DECL-TEST-01-03-END. SQ1344.2 +041900* SQ1344.2 +042000 PERFORM DECL-WRITE-LINE. SQ1344.2 +042100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1344.2 +042200 TO DUMMY-RECORD. SQ1344.2 +042300 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1344.2 +042400 GO TO END-DECLS. SQ1344.2 +042500* SQ1344.2 +042600* SQ1344.2 +042700 DECL-PASS. SQ1344.2 +042800 MOVE "PASS " TO P-OR-F. SQ1344.2 +042900 ADD 1 TO PASS-COUNTER. SQ1344.2 +043000 PERFORM DECL-PRINT-DETAIL. SQ1344.2 +043100* SQ1344.2 +043200 DECL-FAIL. SQ1344.2 +043300 MOVE "FAIL*" TO P-OR-F. SQ1344.2 +043400 ADD 1 TO ERROR-COUNTER. SQ1344.2 +043500 PERFORM DECL-PRINT-DETAIL. SQ1344.2 +043600* SQ1344.2 +043700 DECL-DE-LETE. SQ1344.2 +043800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1344.2 +043900 MOVE "*****" TO P-OR-F. SQ1344.2 +044000 ADD 1 TO DELETE-COUNTER. SQ1344.2 +044100 PERFORM DECL-PRINT-DETAIL. SQ1344.2 +044200* SQ1344.2 +044300 DECL-PRINT-DETAIL. SQ1344.2 +044400 IF REC-CT NOT EQUAL TO ZERO SQ1344.2 +044500 MOVE "." TO PARDOT-X SQ1344.2 +044600 MOVE REC-CT TO DOTVALUE. SQ1344.2 +044700 MOVE TEST-RESULTS TO PRINT-REC. SQ1344.2 +044800 PERFORM DECL-WRITE-LINE. SQ1344.2 +044900 IF P-OR-F EQUAL TO "FAIL*" SQ1344.2 +045000 PERFORM DECL-WRITE-LINE SQ1344.2 +045100 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1344.2 +045200 ELSE SQ1344.2 +045300 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1344.2 +045400 MOVE SPACE TO P-OR-F. SQ1344.2 +045500 MOVE SPACE TO COMPUTED-X. SQ1344.2 +045600 MOVE SPACE TO CORRECT-X. SQ1344.2 +045700 IF REC-CT EQUAL TO ZERO SQ1344.2 +045800 MOVE SPACE TO PAR-NAME. SQ1344.2 +045900 MOVE SPACE TO RE-MARK. SQ1344.2 +046000* SQ1344.2 +046100 DECL-WRITE-LINE. SQ1344.2 +046200 ADD 1 TO RECORD-COUNT. SQ1344.2 +046300 IF RECORD-COUNT GREATER 50 SQ1344.2 +046400 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1344.2 +046500 MOVE SPACE TO DUMMY-RECORD SQ1344.2 +046600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1344.2 +046700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1344.2 +046800 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1344.2 +046900 PERFORM DECL-WRT-LN 2 TIMES SQ1344.2 +047000 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1344.2 +047100 PERFORM DECL-WRT-LN SQ1344.2 +047200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1344.2 +047300 MOVE ZERO TO RECORD-COUNT. SQ1344.2 +047400 PERFORM DECL-WRT-LN. SQ1344.2 +047500* SQ1344.2 +047600 DECL-WRT-LN. SQ1344.2 +047700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1344.2 +047800 MOVE SPACE TO DUMMY-RECORD. SQ1344.2 +047900* SQ1344.2 +048000 DECL-FAIL-ROUTINE. SQ1344.2 +048100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1344.2 +048200 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1344.2 +048300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1344.2 +048400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1344.2 +048500 MOVE XXINFO TO DUMMY-RECORD. SQ1344.2 +048600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1344.2 +048700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1344.2 +048800 GO TO DECL-FAIL-EX. SQ1344.2 +048900 DECL-FAIL-WRITE. SQ1344.2 +049000 MOVE TEST-COMPUTED TO PRINT-REC SQ1344.2 +049100 PERFORM DECL-WRITE-LINE SQ1344.2 +049200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1344.2 +049300 MOVE TEST-CORRECT TO PRINT-REC SQ1344.2 +049400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1344.2 +049500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1344.2 +049600 DECL-FAIL-EX. SQ1344.2 +049700 EXIT. SQ1344.2 +049800* SQ1344.2 +049900 DECL-BAIL. SQ1344.2 +050000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1344.2 +050100 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1344.2 +050200 DECL-BAIL-WRITE. SQ1344.2 +050300 MOVE CORRECT-A TO XXCORRECT. SQ1344.2 +050400 MOVE COMPUTED-A TO XXCOMPUTED. SQ1344.2 +050500 MOVE XXINFO TO DUMMY-RECORD. SQ1344.2 +050600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1344.2 +050700 DECL-BAIL-EX. SQ1344.2 +050800 EXIT. SQ1344.2 +050900* SQ1344.2 +051000 END-DECLS. SQ1344.2 +051100 END DECLARATIVES. SQ1344.2 +051200* SQ1344.2 +051300* SQ1344.2 +051400 CCVS1 SECTION. SQ1344.2 +051500 OPEN-FILES. SQ1344.2 +051600*P OPEN I-O RAW-DATA. SQ1344.2 +051700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1344.2 +051800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1344.2 +051900*P MOVE "ABORTED " TO C-ABORT. SQ1344.2 +052000*P ADD 1 TO C-NO-OF-TESTS. SQ1344.2 +052100*P ACCEPT C-DATE FROM DATE. SQ1344.2 +052200*P ACCEPT C-TIME FROM TIME. SQ1344.2 +052300*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1344.2 +052400*PND-E-1. SQ1344.2 +052500*P CLOSE RAW-DATA. SQ1344.2 +052600 OPEN OUTPUT PRINT-FILE. SQ1344.2 +052700 MOVE CCVS-PGM-ID TO TEST-ID. SQ1344.2 +052800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1344.2 +052900 MOVE SPACE TO TEST-RESULTS. SQ1344.2 +053000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1344.2 +053100 MOVE ZERO TO REC-SKEL-SUB. SQ1344.2 +053200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1344.2 +053300 GO TO CCVS1-EXIT. SQ1344.2 +053400* SQ1344.2 +053500 CCVS-INIT-FILE. SQ1344.2 +053600 ADD 1 TO REC-SKL-SUB. SQ1344.2 +053700 MOVE FILE-RECORD-INFO-SKELETON TO SQ1344.2 +053800 FILE-RECORD-INFO (REC-SKL-SUB). SQ1344.2 +053900* SQ1344.2 +054000 CLOSE-FILES. SQ1344.2 +054100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1344.2 +054200 CLOSE PRINT-FILE. SQ1344.2 +054300*P OPEN I-O RAW-DATA. SQ1344.2 +054400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1344.2 +054500*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1344.2 +054600*P MOVE "OK. " TO C-ABORT. SQ1344.2 +054700*P MOVE PASS-COUNTER TO C-OK. SQ1344.2 +054800*P MOVE ERROR-HOLD TO C-ALL. SQ1344.2 +054900*P MOVE ERROR-COUNTER TO C-FAIL. SQ1344.2 +055000*P MOVE DELETE-CNT TO C-DELETED. SQ1344.2 +055100*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1344.2 +055200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1344.2 +055300*PND-E-2. SQ1344.2 +055400*P CLOSE RAW-DATA. SQ1344.2 +055500 TERMINATE-CCVS. SQ1344.2 +055600*S EXIT PROGRAM. SQ1344.2 +055700 STOP RUN. SQ1344.2 +055800* SQ1344.2 +055900 INSPT. SQ1344.2 +056000 MOVE "INSPT" TO P-OR-F. SQ1344.2 +056100 ADD 1 TO INSPECT-COUNTER. SQ1344.2 +056200 PERFORM PRINT-DETAIL. SQ1344.2 +056300* SQ1344.2 +056400 PASS. SQ1344.2 +056500 MOVE "PASS " TO P-OR-F. SQ1344.2 +056600 ADD 1 TO PASS-COUNTER. SQ1344.2 +056700 PERFORM PRINT-DETAIL. SQ1344.2 +056800* SQ1344.2 +056900 FAIL. SQ1344.2 +057000 MOVE "FAIL*" TO P-OR-F. SQ1344.2 +057100 ADD 1 TO ERROR-COUNTER. SQ1344.2 +057200 PERFORM PRINT-DETAIL. SQ1344.2 +057300* SQ1344.2 +057400 DE-LETE. SQ1344.2 +057500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1344.2 +057600 MOVE "*****" TO P-OR-F. SQ1344.2 +057700 ADD 1 TO DELETE-COUNTER. SQ1344.2 +057800 PERFORM PRINT-DETAIL. SQ1344.2 +057900* SQ1344.2 +058000 PRINT-DETAIL. SQ1344.2 +058100 IF REC-CT NOT EQUAL TO ZERO SQ1344.2 +058200 MOVE "." TO PARDOT-X SQ1344.2 +058300 MOVE REC-CT TO DOTVALUE. SQ1344.2 +058400 MOVE TEST-RESULTS TO PRINT-REC. SQ1344.2 +058500 PERFORM WRITE-LINE. SQ1344.2 +058600 IF P-OR-F EQUAL TO "FAIL*" SQ1344.2 +058700 PERFORM WRITE-LINE SQ1344.2 +058800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1344.2 +058900 ELSE SQ1344.2 +059000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1344.2 +059100 MOVE SPACE TO P-OR-F. SQ1344.2 +059200 MOVE SPACE TO COMPUTED-X. SQ1344.2 +059300 MOVE SPACE TO CORRECT-X. SQ1344.2 +059400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1344.2 +059500 MOVE SPACE TO RE-MARK. SQ1344.2 +059600* SQ1344.2 +059700 HEAD-ROUTINE. SQ1344.2 +059800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +059900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +060000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1344.2 +060100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1344.2 +060200 COLUMN-NAMES-ROUTINE. SQ1344.2 +060300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1344.2 +060400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +060500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1344.2 +060600 END-ROUTINE. SQ1344.2 +060700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1344.2 +060800 PERFORM WRITE-LINE 5 TIMES. SQ1344.2 +060900 END-RTN-EXIT. SQ1344.2 +061000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1344.2 +061100 PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +061200* SQ1344.2 +061300 END-ROUTINE-1. SQ1344.2 +061400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1344.2 +061500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1344.2 +061600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1344.2 +061700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1344.2 +061800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1344.2 +061900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1344.2 +062000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1344.2 +062100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1344.2 +062200 PERFORM WRITE-LINE. SQ1344.2 +062300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1344.2 +062400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1344.2 +062500 MOVE "NO " TO ERROR-TOTAL SQ1344.2 +062600 ELSE SQ1344.2 +062700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1344.2 +062800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1344.2 +062900 PERFORM WRITE-LINE. SQ1344.2 +063000 END-ROUTINE-13. SQ1344.2 +063100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1344.2 +063200 MOVE "NO " TO ERROR-TOTAL SQ1344.2 +063300 ELSE SQ1344.2 +063400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1344.2 +063500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1344.2 +063600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1344.2 +063700 PERFORM WRITE-LINE. SQ1344.2 +063800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1344.2 +063900 MOVE "NO " TO ERROR-TOTAL SQ1344.2 +064000 ELSE SQ1344.2 +064100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1344.2 +064200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1344.2 +064300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1344.2 +064400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1344.2 +064500* SQ1344.2 +064600 WRITE-LINE. SQ1344.2 +064700 ADD 1 TO RECORD-COUNT. SQ1344.2 +064800 IF RECORD-COUNT GREATER 50 SQ1344.2 +064900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1344.2 +065000 MOVE SPACE TO DUMMY-RECORD SQ1344.2 +065100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1344.2 +065200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1344.2 +065300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1344.2 +065400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1344.2 +065500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1344.2 +065600 MOVE ZERO TO RECORD-COUNT. SQ1344.2 +065700 PERFORM WRT-LN. SQ1344.2 +065800* SQ1344.2 +065900 WRT-LN. SQ1344.2 +066000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1344.2 +066100 MOVE SPACE TO DUMMY-RECORD. SQ1344.2 +066200 BLANK-LINE-PRINT. SQ1344.2 +066300 PERFORM WRT-LN. SQ1344.2 +066400 FAIL-ROUTINE. SQ1344.2 +066500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1344.2 +066600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1344.2 +066700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1344.2 +066800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1344.2 +066900 MOVE XXINFO TO DUMMY-RECORD. SQ1344.2 +067000 PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +067100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1344.2 +067200 GO TO FAIL-ROUTINE-EX. SQ1344.2 +067300 FAIL-ROUTINE-WRITE. SQ1344.2 +067400 MOVE TEST-COMPUTED TO PRINT-REC SQ1344.2 +067500 PERFORM WRITE-LINE SQ1344.2 +067600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1344.2 +067700 MOVE TEST-CORRECT TO PRINT-REC SQ1344.2 +067800 PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +067900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1344.2 +068000 FAIL-ROUTINE-EX. SQ1344.2 +068100 EXIT. SQ1344.2 +068200 BAIL-OUT. SQ1344.2 +068300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1344.2 +068400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1344.2 +068500 BAIL-OUT-WRITE. SQ1344.2 +068600 MOVE CORRECT-A TO XXCORRECT. SQ1344.2 +068700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1344.2 +068800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1344.2 +068900 MOVE XXINFO TO DUMMY-RECORD. SQ1344.2 +069000 PERFORM WRITE-LINE 2 TIMES. SQ1344.2 +069100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1344.2 +069200 BAIL-OUT-EX. SQ1344.2 +069300 EXIT. SQ1344.2 +069400 CCVS1-EXIT. SQ1344.2 +069500 EXIT. SQ1344.2 +069600* SQ1344.2 +069700**************************************************************** SQ1344.2 +069800* * SQ1344.2 +069900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1344.2 +070000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1344.2 +070100* * SQ1344.2 +070200**************************************************************** SQ1344.2 +070300* SQ1344.2 +070400 SECT-SQ134A-0002 SECTION. SQ1344.2 +070500 STA-INIT. SQ1344.2 +070600 MOVE SPACE TO DELETE-SW. SQ1344.2 +070700* SQ1344.2 +070800 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1344.2 +070900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1344.2 +071000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1344.2 +071100 MOVE 120 TO XRECORD-LENGTH (1). SQ1344.2 +071200 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ1344.2 +071300 MOVE 1 TO XBLOCK-SIZE (1). SQ1344.2 +071400 MOVE 1 TO RECORDS-IN-FILE (1). SQ1344.2 +071500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1344.2 +071600 MOVE "S" TO XLABEL-TYPE (1). SQ1344.2 +071700* SQ1344.2 +071800* OPEN THE FILE IN THE OUTPUT MODE SQ1344.2 +071900* SQ1344.2 +072000 SEQ-INIT-01. SQ1344.2 +072100 MOVE 0 TO REC-CT. SQ1344.2 +072200 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +072300 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +072400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +072500 MOVE ZERO TO XRECORD-NUMBER (1). SQ1344.2 +072600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1344.2 +072700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1344.2 +072800 GO TO SEQ-TEST-OP-01. SQ1344.2 +072900 SEQ-DELETE-01. SQ1344.2 +073000 MOVE "*" TO DELETE-SW-1. SQ1344.2 +073100 GO TO SEQ-DELETE-01-01. SQ1344.2 +073200 SEQ-TEST-OP-01. SQ1344.2 +073300 OPEN OUTPUT SQ-FS4. SQ1344.2 +073400* SQ1344.2 +073500* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1344.2 +073600* SQ1344.2 +073700 ADD 1 TO REC-CT. SQ1344.2 +073800 IF DELETE-SW NOT = SPACE SQ1344.2 +073900 GO TO SEQ-DELETE-01-01. SQ1344.2 +074000 GO TO SEQ-TEST-OP-01-01. SQ1344.2 +074100 SEQ-DELETE-01-01. SQ1344.2 +074200 PERFORM DE-LETE. SQ1344.2 +074300 GO TO SEQ-TEST-01-01-END. SQ1344.2 +074400 SEQ-TEST-OP-01-01. SQ1344.2 +074500 IF SQ-FS4-STATUS = "00" SQ1344.2 +074600 PERFORM PASS SQ1344.2 +074700 ELSE SQ1344.2 +074800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +074900 MOVE "00" TO CORRECT-A SQ1344.2 +075000 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1344.2 +075100 TO RE-MARK SQ1344.2 +075200 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ1344.2 +075300 PERFORM FAIL. SQ1344.2 +075400 SEQ-TEST-01-01-END. SQ1344.2 +075500* SQ1344.2 +075600* CHECK EXECUTION OF I-O DECLARATIVE SQ1344.2 +075700* SQ1344.2 +075800 ADD 1 TO REC-CT. SQ1344.2 +075900 IF DELETE-SW NOT = SPACE SQ1344.2 +076000 GO TO SEQ-DELETE-01-02. SQ1344.2 +076100 GO TO SEQ-TEST-OP-01-02. SQ1344.2 +076200 SEQ-DELETE-01-02. SQ1344.2 +076300 PERFORM DE-LETE. SQ1344.2 +076400 GO TO SEQ-TEST-01-02-END. SQ1344.2 +076500 SEQ-TEST-OP-01-02. SQ1344.2 +076600 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +076700 PERFORM PASS SQ1344.2 +076800 ELSE SQ1344.2 +076900 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +077000 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +077100 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1344.2 +077200 TO RE-MARK SQ1344.2 +077300 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +077400 PERFORM FAIL. SQ1344.2 +077500 SEQ-TEST-01-02-END. SQ1344.2 +077600* SQ1344.2 +077700* SQ1344.2 +077800* A NEW FILE IS OPEN. WE NOW WRITE ONE RECORD OF 138 CHARS. SQ1344.2 +077900* SQ1344.2 +078000 SEQ-INIT-02. SQ1344.2 +078100 MOVE 0 TO REC-CT. SQ1344.2 +078200 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +078300 ADD 1 TO XRECORD-NUMBER (1). SQ1344.2 +078400 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +078500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +078600 MOVE "WRITE A RECORD" TO FEATURE. SQ1344.2 +078700 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1344.2 +078800 IF DELETE-SW NOT EQUAL TO SPACE SQ1344.2 +078900 GO TO SEQ-DELETE-02. SQ1344.2 +079000 GO TO SEQ-TEST-WR-02. SQ1344.2 +079100 SEQ-DELETE-02. SQ1344.2 +079200 MOVE "*" TO DELETE-SW-2. SQ1344.2 +079300 GO TO SEQ-DELETE-02-01. SQ1344.2 +079400 SEQ-TEST-WR-02. SQ1344.2 +079500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1344.2 +079600 MOVE "987654321123456789" TO EXT-18. SQ1344.2 +079700 WRITE SQ-FS4R2-F-G-138. SQ1344.2 +079800* SQ1344.2 +079900* CHECK I-O STATUS RETURNED FROM WRITE SQ1344.2 +080000* SQ1344.2 +080100 ADD 1 TO REC-CT. SQ1344.2 +080200 IF DELETE-SW NOT = SPACE SQ1344.2 +080300 GO TO SEQ-DELETE-02-01. SQ1344.2 +080400 GO TO SEQ-TEST-WR-02-01. SQ1344.2 +080500 SEQ-DELETE-02-01. SQ1344.2 +080600 PERFORM DE-LETE. SQ1344.2 +080700 GO TO SEQ-TEST-02-01-END. SQ1344.2 +080800 SEQ-TEST-WR-02-01. SQ1344.2 +080900 IF SQ-FS4-STATUS = "00" SQ1344.2 +081000 PERFORM PASS SQ1344.2 +081100 ELSE SQ1344.2 +081200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +081300 MOVE "00" TO CORRECT-A SQ1344.2 +081400 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ1344.2 +081500 TO RE-MARK SQ1344.2 +081600 MOVE "VII-3, VII-53" TO ANSI-REFERENCE SQ1344.2 +081700 PERFORM FAIL. SQ1344.2 +081800 SEQ-TEST-02-01-END. SQ1344.2 +081900* SQ1344.2 +082000* CHECK EXECUTION OF I-O DECLARATIVE SQ1344.2 +082100* SQ1344.2 +082200 ADD 1 TO REC-CT. SQ1344.2 +082300 IF DELETE-SW NOT = SPACE SQ1344.2 +082400 GO TO SEQ-DELETE-02-02. SQ1344.2 +082500 GO TO SEQ-TEST-WR-02-02. SQ1344.2 +082600 SEQ-DELETE-02-02. SQ1344.2 +082700 PERFORM DE-LETE. SQ1344.2 +082800 GO TO SEQ-TEST-02-02-END. SQ1344.2 +082900 SEQ-TEST-WR-02-02. SQ1344.2 +083000 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +083100 PERFORM PASS SQ1344.2 +083200 ELSE SQ1344.2 +083300 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +083400 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +083500 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1344.2 +083600 TO RE-MARK SQ1344.2 +083700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +083800 PERFORM FAIL. SQ1344.2 +083900 SEQ-TEST-02-02-END. SQ1344.2 +084000* SQ1344.2 +084100* SQ1344.2 +084200* NOW CLOSE THE FILE. SQ1344.2 +084300* SQ1344.2 +084400 SEQ-INIT-03. SQ1344.2 +084500 MOVE 0 TO REC-CT. SQ1344.2 +084600 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +084700 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +084800 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +084900 MOVE "CLOSE FILE" TO FEATURE. SQ1344.2 +085000 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1344.2 +085100 IF DELETE-SW NOT EQUAL TO SPACE SQ1344.2 +085200 GO TO SEQ-DELETE-03. SQ1344.2 +085300 GO TO SEQ-TEST-CL-03. SQ1344.2 +085400 SEQ-DELETE-03. SQ1344.2 +085500 MOVE "*" TO DELETE-SW-2. SQ1344.2 +085600 GO TO SEQ-DELETE-03-01. SQ1344.2 +085700 SEQ-TEST-CL-03. SQ1344.2 +085800 CLOSE SQ-FS4. SQ1344.2 +085900* SQ1344.2 +086000* CHECK I-O STATUS RETURNED FROM CLOSE SQ1344.2 +086100* SQ1344.2 +086200 ADD 1 TO REC-CT. SQ1344.2 +086300 IF DELETE-SW NOT = SPACE SQ1344.2 +086400 GO TO SEQ-DELETE-03-01. SQ1344.2 +086500 GO TO SEQ-TEST-CL-03-01. SQ1344.2 +086600 SEQ-DELETE-03-01. SQ1344.2 +086700 PERFORM DE-LETE. SQ1344.2 +086800 GO TO SEQ-TEST-03-01-END. SQ1344.2 +086900 SEQ-TEST-CL-03-01. SQ1344.2 +087000 IF SQ-FS4-STATUS = "00" SQ1344.2 +087100 PERFORM PASS SQ1344.2 +087200 ELSE SQ1344.2 +087300 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +087400 MOVE "00" TO CORRECT-A SQ1344.2 +087500 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ1344.2 +087600 TO RE-MARK SQ1344.2 +087700 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ1344.2 +087800 PERFORM FAIL. SQ1344.2 +087900 SEQ-TEST-03-01-END. SQ1344.2 +088000* SQ1344.2 +088100* CHECK EXECUTION OF I-O DECLARATIVE SQ1344.2 +088200* SQ1344.2 +088300 ADD 1 TO REC-CT. SQ1344.2 +088400 IF DELETE-SW NOT = SPACE SQ1344.2 +088500 GO TO SEQ-DELETE-03-02. SQ1344.2 +088600 GO TO SEQ-TEST-CL-03-02. SQ1344.2 +088700 SEQ-DELETE-03-02. SQ1344.2 +088800 PERFORM DE-LETE. SQ1344.2 +088900 GO TO SEQ-TEST-03-02-END. SQ1344.2 +089000 SEQ-TEST-CL-03-02. SQ1344.2 +089100 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +089200 PERFORM PASS SQ1344.2 +089300 ELSE SQ1344.2 +089400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +089500 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +089600 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1344.2 +089700 TO RE-MARK SQ1344.2 +089800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +089900 PERFORM FAIL. SQ1344.2 +090000 SEQ-TEST-03-02-END. SQ1344.2 +090100 MOVE SPACE TO DELETE-SW-2. SQ1344.2 +090200* SQ1344.2 +090300* SQ1344.2 +090400* OPEN THE FILE IN THE I-O MODE SQ1344.2 +090500* SQ1344.2 +090600 SEQ-INIT-04. SQ1344.2 +090700 MOVE 0 TO REC-CT. SQ1344.2 +090800 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +090900 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +091000 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +091100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1344.2 +091200 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ1344.2 +091300 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1344.2 +091400 IF DELETE-SW NOT = SPACE SQ1344.2 +091500 GO TO SEQ-DELETE-04-01. SQ1344.2 +091600 GO TO SEQ-TEST-OP-04. SQ1344.2 +091700 SEQ-DELETE-04. SQ1344.2 +091800 MOVE "*" TO DELETE-SW-2. SQ1344.2 +091900 GO TO SEQ-DELETE-04-01. SQ1344.2 +092000 SEQ-TEST-OP-04. SQ1344.2 +092100 OPEN I-O SQ-FS4. SQ1344.2 +092200* SQ1344.2 +092300* CHECK I-O STATUS RETURNED FROM OPEN I-O SQ1344.2 +092400* SQ1344.2 +092500 ADD 1 TO REC-CT. SQ1344.2 +092600 IF DELETE-SW NOT = SPACE SQ1344.2 +092700 GO TO SEQ-DELETE-04-01. SQ1344.2 +092800 GO TO SEQ-TEST-OP-04-01. SQ1344.2 +092900 SEQ-DELETE-04-01. SQ1344.2 +093000 PERFORM DE-LETE. SQ1344.2 +093100 GO TO SEQ-TEST-04-01-END. SQ1344.2 +093200 SEQ-TEST-OP-04-01. SQ1344.2 +093300 IF SQ-FS4-STATUS = "00" SQ1344.2 +093400 PERFORM PASS SQ1344.2 +093500 ELSE SQ1344.2 +093600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +093700 MOVE "00" TO CORRECT-A SQ1344.2 +093800 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN I-O" SQ1344.2 +093900 TO RE-MARK SQ1344.2 +094000 MOVE "VII-3, VII-40" TO ANSI-REFERENCE SQ1344.2 +094100 PERFORM FAIL. SQ1344.2 +094200 SEQ-TEST-04-01-END. SQ1344.2 +094300* SQ1344.2 +094400 ADD 1 TO REC-CT. SQ1344.2 +094500 IF DELETE-SW NOT = SPACE SQ1344.2 +094600 GO TO SEQ-DELETE-04-02. SQ1344.2 +094700 GO TO SEQ-TEST-OP-04-02. SQ1344.2 +094800 SEQ-DELETE-04-02. SQ1344.2 +094900 PERFORM DE-LETE. SQ1344.2 +095000 GO TO SEQ-TEST-04-02-END. SQ1344.2 +095100 SEQ-TEST-OP-04-02. SQ1344.2 +095200 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +095300 PERFORM PASS SQ1344.2 +095400 ELSE SQ1344.2 +095500 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +095600 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +095700 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE ON OPEN" SQ1344.2 +095800 TO RE-MARK SQ1344.2 +095900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +096000 PERFORM FAIL. SQ1344.2 +096100 SEQ-TEST-04-02-END. SQ1344.2 +096200* SQ1344.2 +096300* SQ1344.2 +096400* THE FILE IS OPEN FOR I-O. WE READ THE ONLY RECORD. SQ1344.2 +096500* SQ1344.2 +096600 SEQ-INIT-05. SQ1344.2 +096700 MOVE 0 TO REC-CT. SQ1344.2 +096800 MOVE "*" TO DECL-EXEC-SW. SQ1344.2 +096900 ADD 1 TO XRECORD-NUMBER (1). SQ1344.2 +097000 MOVE SPACE TO SQ-FS4R2-F-G-138. SQ1344.2 +097100 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +097200 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +097300 MOVE "READ FIRST RECORD" TO FEATURE. SQ1344.2 +097400 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1344.2 +097500 IF DELETE-SW NOT EQUAL TO SPACE SQ1344.2 +097600 GO TO SEQ-DELETE-05. SQ1344.2 +097700 GO TO SEQ-TEST-RD-05. SQ1344.2 +097800 SEQ-DELETE-05. SQ1344.2 +097900 MOVE "*" TO DELETE-SW-2. SQ1344.2 +098000 GO TO SEQ-DELETE-05-01. SQ1344.2 +098100 SEQ-TEST-RD-05. SQ1344.2 +098200 READ SQ-FS4. SQ1344.2 +098300* SQ1344.2 +098400* CHECK I-O STATUS RETURNED FROM READ SQ1344.2 +098500* SQ1344.2 +098600 ADD 1 TO REC-CT. SQ1344.2 +098700 IF DELETE-SW NOT = SPACE SQ1344.2 +098800 GO TO SEQ-DELETE-05-01. SQ1344.2 +098900 GO TO SEQ-TEST-RD-05-01. SQ1344.2 +099000 SEQ-DELETE-05-01. SQ1344.2 +099100 PERFORM DE-LETE. SQ1344.2 +099200 GO TO SEQ-TEST-05-01-END. SQ1344.2 +099300 SEQ-TEST-RD-05-01. SQ1344.2 +099400 IF SQ-FS4-STATUS = "00" SQ1344.2 +099500 PERFORM PASS SQ1344.2 +099600 ELSE SQ1344.2 +099700 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +099800 MOVE "00" TO CORRECT-A SQ1344.2 +099900 MOVE "UNEXPECTED STATUS CODE FROM READ" SQ1344.2 +100000 TO RE-MARK SQ1344.2 +100100 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ1344.2 +100200 PERFORM FAIL. SQ1344.2 +100300 SEQ-TEST-05-01-END. SQ1344.2 +100400* SQ1344.2 +100500* CHECK EXECUTION OF I-O DECLARATIVE SQ1344.2 +100600* SQ1344.2 +100700 ADD 1 TO REC-CT. SQ1344.2 +100800 IF DELETE-SW NOT = SPACE SQ1344.2 +100900 GO TO SEQ-DELETE-05-02. SQ1344.2 +101000 GO TO SEQ-TEST-RD-05-02. SQ1344.2 +101100 SEQ-DELETE-05-02. SQ1344.2 +101200 PERFORM DE-LETE. SQ1344.2 +101300 GO TO SEQ-TEST-05-02-END. SQ1344.2 +101400 SEQ-TEST-RD-05-02. SQ1344.2 +101500 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ1344.2 +101600 PERFORM PASS SQ1344.2 +101700 ELSE SQ1344.2 +101800 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1344.2 +101900 MOVE "NOT EXECUTED" TO CORRECT-A SQ1344.2 +102000 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ1344.2 +102100 TO RE-MARK SQ1344.2 +102200 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1344.2 +102300 PERFORM FAIL. SQ1344.2 +102400 SEQ-TEST-05-02-END. SQ1344.2 +102500* SQ1344.2 +102600* CHECK THAT THE CORRECT RECORD HAS BEEN RETURNED, BY SQ1344.2 +102700* CHECKING THE RECORD-NUMBER FIELD. SQ1344.2 +102800* SQ1344.2 +102900 ADD 1 TO REC-CT. SQ1344.2 +103000 IF DELETE-SW NOT = SPACE SQ1344.2 +103100 GO TO SEQ-DELETE-05-03. SQ1344.2 +103200 GO TO SEQ-TEST-RD-05-03. SQ1344.2 +103300 SEQ-DELETE-05-03. SQ1344.2 +103400 PERFORM DE-LETE. SQ1344.2 +103500 GO TO SEQ-TEST-05-03-END. SQ1344.2 +103600 SEQ-TEST-RD-05-03. SQ1344.2 +103700 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ1344.2 +103800 PERFORM PASS SQ1344.2 +103900 ELSE SQ1344.2 +104000 MOVE FRECORD-NUMBER TO COMPUTED-18V0 SQ1344.2 +104100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0 SQ1344.2 +104200 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ1344.2 +104300 PERFORM FAIL. SQ1344.2 +104400 SEQ-TEST-05-03-END. SQ1344.2 +104500 MOVE SPACE TO DELETE-SW-2. SQ1344.2 +104600* SQ1344.2 +104700* FINALLY, TRY TO REWRITE A SMALLER RECORD SQ1344.2 +104800* SQ1344.2 +104900 SEQ-INIT-06. SQ1344.2 +105000 MOVE 0 TO REC-CT. SQ1344.2 +105100 MOVE SPACE TO DECL-EXEC-SW. SQ1344.2 +105200 MOVE "**" TO SQ-FS4-STATUS. SQ1344.2 +105300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1344.2 +105400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1344.2 +105500 MOVE "ABCDEFGHIJKLMNOPQR" TO EXT-18. SQ1344.2 +105600 MOVE "REWRITE SMALLER RECORD" TO FEATURE. SQ1344.2 +105700 MOVE "SEQ-TEST-RW-06" TO PAR-NAME. SQ1344.2 +105800 IF DELETE-SW NOT = SPACE SQ1344.2 +105900 GO TO SEQ-DELETE-06-01. SQ1344.2 +106000 GO TO SEQ-TEST-RW-06. SQ1344.2 +106100 SEQ-DELETE-06. SQ1344.2 +106200 MOVE "*" TO DELETE-SW-2. SQ1344.2 +106300 GO TO SEQ-DELETE-06-01. SQ1344.2 +106400 SEQ-TEST-RW-06. SQ1344.2 +106500 REWRITE SQ-FS4R1-F-G-120. SQ1344.2 +106600 MOVE 0 TO REC-CT. SQ1344.2 +106700 MOVE "REWRITE SMALLER RECORD" TO FEATURE. SQ1344.2 +106800 MOVE "SEQ-TEST-RW-06" TO PAR-NAME. SQ1344.2 +106900* SQ1344.2 +107000* CHECK I-O STATUS RETURNED FROM REWRITE SQ1344.2 +107100* SQ1344.2 +107200 ADD 1 TO REC-CT. SQ1344.2 +107300 IF DELETE-SW NOT = SPACE SQ1344.2 +107400 GO TO SEQ-DELETE-06-01. SQ1344.2 +107500 GO TO SEQ-TEST-RW-06-01. SQ1344.2 +107600 SEQ-DELETE-06-01. SQ1344.2 +107700 PERFORM DE-LETE. SQ1344.2 +107800 SEQ-TEST-RW-06-01. SQ1344.2 +107900 IF SQ-FS4-STATUS = "44" SQ1344.2 +108000 PERFORM PASS SQ1344.2 +108100 ELSE SQ1344.2 +108200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1344.2 +108300 MOVE "44" TO CORRECT-A SQ1344.2 +108400 MOVE "UNEXPECTED STATUS CODE FROM REWRITE SHORTER" SQ1344.2 +108500 TO RE-MARK SQ1344.2 +108600 MOVE "VII-4,1.5.3(4)D, VII-48" TO ANSI-REFERENCE SQ1344.2 +108700 PERFORM FAIL. SQ1344.2 +108800 CCVS-EXIT SECTION. SQ1344.2 +108900 CCVS-999999. SQ1344.2 +109000 GO TO CLOSE-FILES. SQ1344.2 diff --git a/tests/cobol85/SQ/SQ135A.CBL b/tests/cobol85/SQ/SQ135A.CBL new file mode 100755 index 00000000..62a2b1ff --- /dev/null +++ b/tests/cobol85/SQ/SQ135A.CBL @@ -0,0 +1,596 @@ +000100 IDENTIFICATION DIVISION. SQ1354.2 +000200 PROGRAM-ID. SQ1354.2 +000300 SQ135A. SQ1354.2 +000400**************************************************************** SQ1354.2 +000500* * SQ1354.2 +000600* VALIDATION FOR:- * SQ1354.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1354.2 +000800* USING CCVS85 VERSION 3.0. * SQ1354.2 +000900* * SQ1354.2 +001000* CREATION DATE / VALIDATION DATE * SQ1354.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1354.2 +001200* * SQ1354.2 +001300**************************************************************** SQ1354.2 +001400* * SQ1354.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1354.2 +001600* * SQ1354.2 +001700* X-14 SEQUENTIAL MASS STORAGE * SQ1354.2 +001800* X-55 SYSTEM PRINTER * SQ1354.2 +001900* X-82 SOURCE-COMPUTER * SQ1354.2 +002000* X-83 OBJECT-COMPUTER. * SQ1354.2 +002100* X-84 LABEL RECORDS OPTION SQ1354.2 +002200* * SQ1354.2 +002300**************************************************************** SQ1354.2 +002400* * SQ1354.2 +002500* SPLIT FROM SQ215A, THE PROGRAM REPEATS THE SEQUENCE OF * SQ1354.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1354.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO CLOSE * SQ1354.2 +002800* AN ALREADY CLOSED FILE. I-O STATUS 42 IS EXPECTED AND * SQ1354.2 +002900* TESTED IN THE DECLARATIVES. * SQ1354.2 +003000**************************************************************** SQ1354.2 +003100* SQ1354.2 +003200 ENVIRONMENT DIVISION. SQ1354.2 +003300 CONFIGURATION SECTION. SQ1354.2 +003400 SOURCE-COMPUTER. SQ1354.2 +003500 Linux. SQ1354.2 +003600 OBJECT-COMPUTER. SQ1354.2 +003700 Linux. SQ1354.2 +003800* SQ1354.2 +003900 INPUT-OUTPUT SECTION. SQ1354.2 +004000 FILE-CONTROL. SQ1354.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1354.2 +004200 "report.log". SQ1354.2 +004300* SQ1354.2 +004400 SELECT SQ-FS1 ASSIGN TO SQ1354.2 +004500 "XXXXX014" SQ1354.2 +004600 FILE STATUS IS SQ-FS1-STATUS. SQ1354.2 +004700* SQ1354.2 +004800* SQ1354.2 +004900 DATA DIVISION. SQ1354.2 +005000 FILE SECTION. SQ1354.2 +005100 FD PRINT-FILE SQ1354.2 +005200*C LABEL RECORDS SQ1354.2 +005300*C OMITTED SQ1354.2 +005400*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1354.2 +005500 . SQ1354.2 +005600 01 PRINT-REC PICTURE X(120). SQ1354.2 +005700 01 DUMMY-RECORD PICTURE X(120). SQ1354.2 +005800* SQ1354.2 +005900 FD SQ-FS1 SQ1354.2 +006000*C LABEL RECORD IS STANDARD SQ1354.2 +006100 . SQ1354.2 +006200 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1354.2 +006300* SQ1354.2 +006400 WORKING-STORAGE SECTION. SQ1354.2 +006500* SQ1354.2 +006600*************************************************************** SQ1354.2 +006700* * SQ1354.2 +006800* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1354.2 +006900* * SQ1354.2 +007000*************************************************************** SQ1354.2 +007100* SQ1354.2 +007200 01 SQ-FS1-STATUS. SQ1354.2 +007300 03 SQ-FS1-KEY-1 PIC X. SQ1354.2 +007400 03 SQ-FS1-KEY-2 PIC X. SQ1354.2 +007500* SQ1354.2 +007600*************************************************************** SQ1354.2 +007700* * SQ1354.2 +007800* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1354.2 +007900* * SQ1354.2 +008000*************************************************************** SQ1354.2 +008100* SQ1354.2 +008200 01 REC-SKEL-SUB PIC 99. SQ1354.2 +008300* SQ1354.2 +008400 01 FILE-RECORD-INFORMATION-REC. SQ1354.2 +008500 03 FILE-RECORD-INFO-SKELETON. SQ1354.2 +008600 05 FILLER PICTURE X(48) VALUE SQ1354.2 +008700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1354.2 +008800 05 FILLER PICTURE X(46) VALUE SQ1354.2 +008900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1354.2 +009000 05 FILLER PICTURE X(26) VALUE SQ1354.2 +009100 ",LFIL=000000,ORG= ,LBLR= ". SQ1354.2 +009200 05 FILLER PICTURE X(37) VALUE SQ1354.2 +009300 ",RECKEY= ". SQ1354.2 +009400 05 FILLER PICTURE X(38) VALUE SQ1354.2 +009500 ",ALTKEY1= ". SQ1354.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1354.2 +009700 ",ALTKEY2= ". SQ1354.2 +009800 05 FILLER PICTURE X(7) VALUE SPACE.SQ1354.2 +009900 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1354.2 +010000 05 FILE-RECORD-INFO-P1-120. SQ1354.2 +010100 07 FILLER PIC X(5). SQ1354.2 +010200 07 XFILE-NAME PIC X(6). SQ1354.2 +010300 07 FILLER PIC X(8). SQ1354.2 +010400 07 XRECORD-NAME PIC X(6). SQ1354.2 +010500 07 FILLER PIC X(1). SQ1354.2 +010600 07 REELUNIT-NUMBER PIC 9(1). SQ1354.2 +010700 07 FILLER PIC X(7). SQ1354.2 +010800 07 XRECORD-NUMBER PIC 9(6). SQ1354.2 +010900 07 FILLER PIC X(6). SQ1354.2 +011000 07 UPDATE-NUMBER PIC 9(2). SQ1354.2 +011100 07 FILLER PIC X(5). SQ1354.2 +011200 07 ODO-NUMBER PIC 9(4). SQ1354.2 +011300 07 FILLER PIC X(5). SQ1354.2 +011400 07 XPROGRAM-NAME PIC X(5). SQ1354.2 +011500 07 FILLER PIC X(7). SQ1354.2 +011600 07 XRECORD-LENGTH PIC 9(6). SQ1354.2 +011700 07 FILLER PIC X(7). SQ1354.2 +011800 07 CHARS-OR-RECORDS PIC X(2). SQ1354.2 +011900 07 FILLER PIC X(1). SQ1354.2 +012000 07 XBLOCK-SIZE PIC 9(4). SQ1354.2 +012100 07 FILLER PIC X(6). SQ1354.2 +012200 07 RECORDS-IN-FILE PIC 9(6). SQ1354.2 +012300 07 FILLER PIC X(5). SQ1354.2 +012400 07 XFILE-ORGANIZATION PIC X(2). SQ1354.2 +012500 07 FILLER PIC X(6). SQ1354.2 +012600 07 XLABEL-TYPE PIC X(1). SQ1354.2 +012700 05 FILE-RECORD-INFO-P121-240. SQ1354.2 +012800 07 FILLER PIC X(8). SQ1354.2 +012900 07 XRECORD-KEY PIC X(29). SQ1354.2 +013000 07 FILLER PIC X(9). SQ1354.2 +013100 07 ALTERNATE-KEY1 PIC X(29). SQ1354.2 +013200 07 FILLER PIC X(9). SQ1354.2 +013300 07 ALTERNATE-KEY2 PIC X(29). SQ1354.2 +013400 07 FILLER PIC X(7). SQ1354.2 +013500* SQ1354.2 +013600 01 TEST-RESULTS. SQ1354.2 +013700 02 FILLER PIC X VALUE SPACE. SQ1354.2 +013800 02 FEATURE PIC X(24) VALUE SPACE. SQ1354.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1354.2 +014000 02 P-OR-F PIC X(5) VALUE SPACE. SQ1354.2 +014100 02 FILLER PIC X VALUE SPACE. SQ1354.2 +014200 02 PAR-NAME. SQ1354.2 +014300 03 FILLER PIC X(14) VALUE SPACE. SQ1354.2 +014400 03 PARDOT-X PIC X VALUE SPACE. SQ1354.2 +014500 03 DOTVALUE PIC 99 VALUE ZERO. SQ1354.2 +014600 02 FILLER PIC X(9) VALUE SPACE. SQ1354.2 +014700 02 RE-MARK PIC X(61). SQ1354.2 +014800 01 TEST-COMPUTED. SQ1354.2 +014900 02 FILLER PIC X(30) VALUE SPACE. SQ1354.2 +015000 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1354.2 +015100 02 COMPUTED-X. SQ1354.2 +015200 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1354.2 +015300 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1354.2 +015400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1354.2 +015500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1354.2 +015600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1354.2 +015700 03 CM-18V0 REDEFINES COMPUTED-A. SQ1354.2 +015800 04 COMPUTED-18V0 PIC -9(18). SQ1354.2 +015900 04 FILLER PIC X. SQ1354.2 +016000 03 FILLER PIC X(50) VALUE SPACE. SQ1354.2 +016100 01 TEST-CORRECT. SQ1354.2 +016200 02 FILLER PIC X(30) VALUE SPACE. SQ1354.2 +016300 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1354.2 +016400 02 CORRECT-X. SQ1354.2 +016500 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1354.2 +016600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1354.2 +016700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1354.2 +016800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1354.2 +016900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1354.2 +017000 03 CR-18V0 REDEFINES CORRECT-A. SQ1354.2 +017100 04 CORRECT-18V0 PIC -9(18). SQ1354.2 +017200 04 FILLER PIC X. SQ1354.2 +017300 03 FILLER PIC X(2) VALUE SPACE. SQ1354.2 +017400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1354.2 +017500 01 CCVS-C-1. SQ1354.2 +017600 02 FILLER PIC IS X(4) VALUE SPACE. SQ1354.2 +017700 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1354.2 +017800- "SS PARAGRAPH-NAME SQ1354.2 +017900- " REMARKS". SQ1354.2 +018000 02 FILLER PIC X(17) VALUE SPACE. SQ1354.2 +018100 01 CCVS-C-2. SQ1354.2 +018200 02 FILLER PIC XXXX VALUE SPACE. SQ1354.2 +018300 02 FILLER PIC X(6) VALUE "TESTED". SQ1354.2 +018400 02 FILLER PIC X(16) VALUE SPACE. SQ1354.2 +018500 02 FILLER PIC X(4) VALUE "FAIL". SQ1354.2 +018600 02 FILLER PIC X(90) VALUE SPACE. SQ1354.2 +018700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1354.2 +018800 01 REC-CT PIC 99 VALUE ZERO. SQ1354.2 +018900 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1354.2 +019000 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1354.2 +019100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1354.2 +019200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1354.2 +019300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1354.2 +019400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1354.2 +019500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1354.2 +019600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1354.2 +019700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1354.2 +019800 01 CCVS-H-1. SQ1354.2 +019900 02 FILLER PIC X(39) VALUE SPACES. SQ1354.2 +020000 02 FILLER PIC X(42) VALUE SQ1354.2 +020100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1354.2 +020200 02 FILLER PIC X(39) VALUE SPACES. SQ1354.2 +020300 01 CCVS-H-2A. SQ1354.2 +020400 02 FILLER PIC X(40) VALUE SPACE. SQ1354.2 +020500 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1354.2 +020600 02 FILLER PIC XXXX VALUE SQ1354.2 +020700 "4.2 ". SQ1354.2 +020800 02 FILLER PIC X(28) VALUE SQ1354.2 +020900 " COPY - NOT FOR DISTRIBUTION". SQ1354.2 +021000 02 FILLER PIC X(41) VALUE SPACE. SQ1354.2 +021100* SQ1354.2 +021200 01 CCVS-H-2B. SQ1354.2 +021300 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1354.2 +021400 02 TEST-ID PIC X(9). SQ1354.2 +021500 02 FILLER PIC X(4) VALUE " IN ". SQ1354.2 +021600 02 FILLER PIC X(12) VALUE SQ1354.2 +021700 " HIGH ". SQ1354.2 +021800 02 FILLER PIC X(22) VALUE SQ1354.2 +021900 " LEVEL VALIDATION FOR ". SQ1354.2 +022000 02 FILLER PIC X(58) VALUE SQ1354.2 +022100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1354.2 +022200 01 CCVS-H-3. SQ1354.2 +022300 02 FILLER PIC X(34) VALUE SQ1354.2 +022400 " FOR OFFICIAL USE ONLY ". SQ1354.2 +022500 02 FILLER PIC X(58) VALUE SQ1354.2 +022600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1354.2 +022700 02 FILLER PIC X(28) VALUE SQ1354.2 +022800 " COPYRIGHT 1985,1986 ". SQ1354.2 +022900 01 CCVS-E-1. SQ1354.2 +023000 02 FILLER PIC X(52) VALUE SPACE. SQ1354.2 +023100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1354.2 +023200 02 ID-AGAIN PIC X(9). SQ1354.2 +023300 02 FILLER PIC X(45) VALUE SPACES. SQ1354.2 +023400 01 CCVS-E-2. SQ1354.2 +023500 02 FILLER PIC X(31) VALUE SPACE. SQ1354.2 +023600 02 FILLER PIC X(21) VALUE SPACE. SQ1354.2 +023700 02 CCVS-E-2-2. SQ1354.2 +023800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1354.2 +023900 03 FILLER PIC X VALUE SPACE. SQ1354.2 +024000 03 ENDER-DESC PIC X(44) VALUE SQ1354.2 +024100 "ERRORS ENCOUNTERED". SQ1354.2 +024200 01 CCVS-E-3. SQ1354.2 +024300 02 FILLER PIC X(22) VALUE SQ1354.2 +024400 " FOR OFFICIAL USE ONLY". SQ1354.2 +024500 02 FILLER PIC X(12) VALUE SPACE. SQ1354.2 +024600 02 FILLER PIC X(58) VALUE SQ1354.2 +024700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1354.2 +024800 02 FILLER PIC X(8) VALUE SPACE. SQ1354.2 +024900 02 FILLER PIC X(20) VALUE SQ1354.2 +025000 " COPYRIGHT 1985,1986". SQ1354.2 +025100 01 CCVS-E-4. SQ1354.2 +025200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1354.2 +025300 02 FILLER PIC X(4) VALUE " OF ". SQ1354.2 +025400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1354.2 +025500 02 FILLER PIC X(40) VALUE SQ1354.2 +025600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1354.2 +025700 01 XXINFO. SQ1354.2 +025800 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1354.2 +025900 02 INFO-TEXT. SQ1354.2 +026000 04 FILLER PIC X(8) VALUE SPACE. SQ1354.2 +026100 04 XXCOMPUTED PIC X(20). SQ1354.2 +026200 04 FILLER PIC X(5) VALUE SPACE. SQ1354.2 +026300 04 XXCORRECT PIC X(20). SQ1354.2 +026400 02 INF-ANSI-REFERENCE PIC X(48). SQ1354.2 +026500 01 HYPHEN-LINE. SQ1354.2 +026600 02 FILLER PIC IS X VALUE IS SPACE. SQ1354.2 +026700 02 FILLER PIC IS X(65) VALUE IS "************************SQ1354.2 +026800- "*****************************************". SQ1354.2 +026900 02 FILLER PIC IS X(54) VALUE IS "************************SQ1354.2 +027000- "******************************". SQ1354.2 +027100 01 CCVS-PGM-ID PIC X(9) VALUE SQ1354.2 +027200 "SQ135A". SQ1354.2 +027300* SQ1354.2 +027400 PROCEDURE DIVISION. SQ1354.2 +027500 DECLARATIVES. SQ1354.2 +027600 SQ-FS1-DECLARATIVE SECTION. SQ1354.2 +027700 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-FS1. SQ1354.2 +027800 OUTPUT-ERROR-PROCESS. SQ1354.2 +027900 IF SQ-FS1-STATUS = "42" SQ1354.2 +028000 PERFORM PASS-DECL SQ1354.2 +028100 GO TO ABNORMAL-TERM-DECL SQ1354.2 +028200 ELSE SQ1354.2 +028300 MOVE "42" TO CORRECT-A SQ1354.2 +028400 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1354.2 +028500 MOVE "STATUS AFTER OPEN OF A CLOSED FILE INCORRECT" SQ1354.2 +028600 TO RE-MARK SQ1354.2 +028700 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1354.2 +028800 PERFORM FAIL-DECL SQ1354.2 +028900 GO TO ABNORMAL-TERM-DECL SQ1354.2 +029000 END-IF. SQ1354.2 +029100* SQ1354.2 +029200 PASS-DECL. SQ1354.2 +029300 MOVE "PASS " TO P-OR-F. SQ1354.2 +029400 ADD 1 TO PASS-COUNTER. SQ1354.2 +029500 PERFORM PRINT-DETAIL-DECL. SQ1354.2 +029600* SQ1354.2 +029700 FAIL-DECL. SQ1354.2 +029800 MOVE "FAIL*" TO P-OR-F. SQ1354.2 +029900 ADD 1 TO ERROR-COUNTER. SQ1354.2 +030000 PERFORM PRINT-DETAIL-DECL. SQ1354.2 +030100* SQ1354.2 +030200 PRINT-DETAIL-DECL. SQ1354.2 +030300 IF REC-CT NOT EQUAL TO ZERO SQ1354.2 +030400 MOVE "." TO PARDOT-X SQ1354.2 +030500 MOVE REC-CT TO DOTVALUE. SQ1354.2 +030600 MOVE TEST-RESULTS TO PRINT-REC. SQ1354.2 +030700 PERFORM WRITE-LINE-DECL. SQ1354.2 +030800 IF P-OR-F EQUAL TO "FAIL*" SQ1354.2 +030900 PERFORM WRITE-LINE-DECL SQ1354.2 +031000 PERFORM FAIL-ROUTINE-DECL THRU FAIL-ROUTINE-EX-DECL SQ1354.2 +031100 ELSE SQ1354.2 +031200 PERFORM BAIL-OUT-DECL THRU BAIL-OUT-EX-DECL. SQ1354.2 +031300 MOVE SPACE TO P-OR-F. SQ1354.2 +031400 MOVE SPACE TO COMPUTED-X. SQ1354.2 +031500 MOVE SPACE TO CORRECT-X. SQ1354.2 +031600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1354.2 +031700 MOVE SPACE TO RE-MARK. SQ1354.2 +031800* SQ1354.2 +031900 WRITE-LINE-DECL. SQ1354.2 +032000 ADD 1 TO RECORD-COUNT. SQ1354.2 +032100 IF RECORD-COUNT GREATER 50 SQ1354.2 +032200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1354.2 +032300 MOVE SPACE TO DUMMY-RECORD SQ1354.2 +032400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1354.2 +032500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ1354.2 +032600 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1354.2 +032700 PERFORM WRT-LN-DECL 2 TIMES SQ1354.2 +032800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ1354.2 +032900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1354.2 +033000 MOVE ZERO TO RECORD-COUNT. SQ1354.2 +033100 PERFORM WRT-LN-DECL. SQ1354.2 +033200* SQ1354.2 +033300 WRT-LN-DECL. SQ1354.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1354.2 +033500 MOVE SPACE TO DUMMY-RECORD. SQ1354.2 +033600 BLANK-LINE-PRINT-DECL. SQ1354.2 +033700 PERFORM WRT-LN-DECL. SQ1354.2 +033800 FAIL-ROUTINE-DECL. SQ1354.2 +033900 IF COMPUTED-X NOT EQUAL TO SPACE SQ1354.2 +034000 GO TO FAIL-ROUTINE-WRITE-DECL. SQ1354.2 +034100 IF CORRECT-X NOT EQUAL TO SPACE SQ1354.2 +034200 GO TO FAIL-ROUTINE-WRITE-DECL. SQ1354.2 +034300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1354.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1354.2 +034500 MOVE XXINFO TO DUMMY-RECORD. SQ1354.2 +034600 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1354.2 +034700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1354.2 +034800 GO TO FAIL-ROUTINE-EX-DECL. SQ1354.2 +034900 FAIL-ROUTINE-WRITE-DECL. SQ1354.2 +035000 MOVE TEST-COMPUTED TO PRINT-REC SQ1354.2 +035100 PERFORM WRITE-LINE-DECL SQ1354.2 +035200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1354.2 +035300 MOVE TEST-CORRECT TO PRINT-REC SQ1354.2 +035400 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1354.2 +035500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1354.2 +035600 FAIL-ROUTINE-EX-DECL. SQ1354.2 +035700 EXIT. SQ1354.2 +035800 BAIL-OUT-DECL. SQ1354.2 +035900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-DECL. SQ1354.2 +036000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-DECL. SQ1354.2 +036100 BAIL-OUT-WRITE-DECL. SQ1354.2 +036200 MOVE CORRECT-A TO XXCORRECT. SQ1354.2 +036300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1354.2 +036400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1354.2 +036500 MOVE XXINFO TO DUMMY-RECORD. SQ1354.2 +036600 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1354.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1354.2 +036800 BAIL-OUT-EX-DECL. SQ1354.2 +036900 EXIT. SQ1354.2 +037000* SQ1354.2 +037100 ABNORMAL-TERM-DECL. SQ1354.2 +037200 MOVE SPACE TO DUMMY-RECORD. SQ1354.2 +037300 PERFORM WRITE-LINE-DECL. SQ1354.2 +037400 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1354.2 +037500 TO DUMMY-RECORD. SQ1354.2 +037600 PERFORM WRITE-LINE-DECL 3 TIMES. SQ1354.2 +037700* SQ1354.2 +037800 EXIT-DECL. SQ1354.2 +037900 EXIT. SQ1354.2 +038000 END DECLARATIVES. SQ1354.2 +038100* SQ1354.2 +038200 CCVS1 SECTION. SQ1354.2 +038300 OPEN-FILES. SQ1354.2 +038400 OPEN OUTPUT PRINT-FILE. SQ1354.2 +038500 MOVE CCVS-PGM-ID TO TEST-ID. SQ1354.2 +038600 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1354.2 +038700 MOVE SPACE TO TEST-RESULTS. SQ1354.2 +038800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1354.2 +038900 MOVE ZERO TO REC-SKEL-SUB. SQ1354.2 +039000 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1354.2 +039100 GO TO CCVS1-EXIT. SQ1354.2 +039200* SQ1354.2 +039300 CCVS-INIT-FILE. SQ1354.2 +039400 ADD 1 TO REC-SKL-SUB. SQ1354.2 +039500 MOVE FILE-RECORD-INFO-SKELETON TO SQ1354.2 +039600 FILE-RECORD-INFO (REC-SKL-SUB). SQ1354.2 +039700* SQ1354.2 +039800 CLOSE-FILES. SQ1354.2 +039900 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1354.2 +040000 CLOSE PRINT-FILE. SQ1354.2 +040100 TERMINATE-CCVS. SQ1354.2 +040200*S EXIT PROGRAM. SQ1354.2 +040300 STOP RUN. SQ1354.2 +040400* SQ1354.2 +040500 INSPT. SQ1354.2 +040600 MOVE "INSPT" TO P-OR-F. SQ1354.2 +040700 ADD 1 TO INSPECT-COUNTER. SQ1354.2 +040800 PERFORM PRINT-DETAIL. SQ1354.2 +040900 SQ1354.2 +041000 PASS. SQ1354.2 +041100 MOVE "PASS " TO P-OR-F. SQ1354.2 +041200 ADD 1 TO PASS-COUNTER. SQ1354.2 +041300 PERFORM PRINT-DETAIL. SQ1354.2 +041400* SQ1354.2 +041500 FAIL. SQ1354.2 +041600 MOVE "FAIL*" TO P-OR-F. SQ1354.2 +041700 ADD 1 TO ERROR-COUNTER. SQ1354.2 +041800 PERFORM PRINT-DETAIL. SQ1354.2 +041900* SQ1354.2 +042000 DE-LETE. SQ1354.2 +042100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1354.2 +042200 MOVE "*****" TO P-OR-F. SQ1354.2 +042300 ADD 1 TO DELETE-COUNTER. SQ1354.2 +042400 PERFORM PRINT-DETAIL. SQ1354.2 +042500* SQ1354.2 +042600 PRINT-DETAIL. SQ1354.2 +042700 IF REC-CT NOT EQUAL TO ZERO SQ1354.2 +042800 MOVE "." TO PARDOT-X SQ1354.2 +042900 MOVE REC-CT TO DOTVALUE. SQ1354.2 +043000 MOVE TEST-RESULTS TO PRINT-REC. SQ1354.2 +043100 PERFORM WRITE-LINE. SQ1354.2 +043200 IF P-OR-F EQUAL TO "FAIL*" SQ1354.2 +043300 PERFORM WRITE-LINE SQ1354.2 +043400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1354.2 +043500 ELSE SQ1354.2 +043600 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1354.2 +043700 MOVE SPACE TO P-OR-F. SQ1354.2 +043800 MOVE SPACE TO COMPUTED-X. SQ1354.2 +043900 MOVE SPACE TO CORRECT-X. SQ1354.2 +044000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1354.2 +044100 MOVE SPACE TO RE-MARK. SQ1354.2 +044200* SQ1354.2 +044300 HEAD-ROUTINE. SQ1354.2 +044400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +044500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +044600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1354.2 +044700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1354.2 +044800 COLUMN-NAMES-ROUTINE. SQ1354.2 +044900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1354.2 +045000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +045100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1354.2 +045200 END-ROUTINE. SQ1354.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1354.2 +045400 PERFORM WRITE-LINE 5 TIMES. SQ1354.2 +045500 END-RTN-EXIT. SQ1354.2 +045600 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1354.2 +045700 PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +045800* SQ1354.2 +045900 END-ROUTINE-1. SQ1354.2 +046000 ADD ERROR-COUNTER TO ERROR-HOLD SQ1354.2 +046100 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1354.2 +046200 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1354.2 +046300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1354.2 +046400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1354.2 +046500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1354.2 +046600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1354.2 +046700 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1354.2 +046800 PERFORM WRITE-LINE. SQ1354.2 +046900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1354.2 +047000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1354.2 +047100 MOVE "NO " TO ERROR-TOTAL SQ1354.2 +047200 ELSE SQ1354.2 +047300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1354.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1354.2 +047500 PERFORM WRITE-LINE. SQ1354.2 +047600 END-ROUTINE-13. SQ1354.2 +047700 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1354.2 +047800 MOVE "NO " TO ERROR-TOTAL SQ1354.2 +047900 ELSE SQ1354.2 +048000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1354.2 +048100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1354.2 +048200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1354.2 +048300 PERFORM WRITE-LINE. SQ1354.2 +048400 IF INSPECT-COUNTER EQUAL TO ZERO SQ1354.2 +048500 MOVE "NO " TO ERROR-TOTAL SQ1354.2 +048600 ELSE SQ1354.2 +048700 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1354.2 +048800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1354.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1354.2 +049000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1354.2 +049100* SQ1354.2 +049200 WRITE-LINE. SQ1354.2 +049300 ADD 1 TO RECORD-COUNT. SQ1354.2 +049400 IF RECORD-COUNT GREATER 50 SQ1354.2 +049500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1354.2 +049600 MOVE SPACE TO DUMMY-RECORD SQ1354.2 +049700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1354.2 +049800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1354.2 +049900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1354.2 +050000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1354.2 +050100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1354.2 +050200 MOVE ZERO TO RECORD-COUNT. SQ1354.2 +050300 PERFORM WRT-LN. SQ1354.2 +050400* SQ1354.2 +050500 WRT-LN. SQ1354.2 +050600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1354.2 +050700 MOVE SPACE TO DUMMY-RECORD. SQ1354.2 +050800 BLANK-LINE-PRINT. SQ1354.2 +050900 PERFORM WRT-LN. SQ1354.2 +051000 FAIL-ROUTINE. SQ1354.2 +051100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1354.2 +051200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1354.2 +051300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1354.2 +051400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1354.2 +051500 MOVE XXINFO TO DUMMY-RECORD. SQ1354.2 +051600 PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +051700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1354.2 +051800 GO TO FAIL-ROUTINE-EX. SQ1354.2 +051900 FAIL-ROUTINE-WRITE. SQ1354.2 +052000 MOVE TEST-COMPUTED TO PRINT-REC SQ1354.2 +052100 PERFORM WRITE-LINE SQ1354.2 +052200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1354.2 +052300 MOVE TEST-CORRECT TO PRINT-REC SQ1354.2 +052400 PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +052500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1354.2 +052600 FAIL-ROUTINE-EX. SQ1354.2 +052700 EXIT. SQ1354.2 +052800 BAIL-OUT. SQ1354.2 +052900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1354.2 +053000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1354.2 +053100 BAIL-OUT-WRITE. SQ1354.2 +053200 MOVE CORRECT-A TO XXCORRECT. SQ1354.2 +053300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1354.2 +053400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1354.2 +053500 MOVE XXINFO TO DUMMY-RECORD. SQ1354.2 +053600 PERFORM WRITE-LINE 2 TIMES. SQ1354.2 +053700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1354.2 +053800 BAIL-OUT-EX. SQ1354.2 +053900 EXIT. SQ1354.2 +054000 CCVS1-EXIT. SQ1354.2 +054100 EXIT. SQ1354.2 +054200* SQ1354.2 +054300**************************************************************** SQ1354.2 +054400* * SQ1354.2 +054500* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1354.2 +054600* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1354.2 +054700* * SQ1354.2 +054800**************************************************************** SQ1354.2 +054900* SQ1354.2 +055000 SECT-SQ135A-0001 SECTION. SQ1354.2 +055100 WRITE-INIT-GF-01. SQ1354.2 +055200* SQ1354.2 +055300* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1354.2 +055400* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1354.2 +055500* SQ1354.2 +055600 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1354.2 +055700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1354.2 +055800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1354.2 +055900 MOVE 120 TO XRECORD-LENGTH (1). SQ1354.2 +056000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1354.2 +056100 MOVE 1 TO XBLOCK-SIZE (1). SQ1354.2 +056200 MOVE 1 TO RECORDS-IN-FILE (1). SQ1354.2 +056300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1354.2 +056400 MOVE "S" TO XLABEL-TYPE (1). SQ1354.2 +056500 MOVE 1 TO XRECORD-NUMBER (1). SQ1354.2 +056600* SQ1354.2 +056700 WRITE-OPEN-01. SQ1354.2 +056800 OPEN OUTPUT SQ-FS1. SQ1354.2 +056900* SQ1354.2 +057000* WRITE A SINGLE RECORD TO THE FILE SQ1354.2 +057100* SQ1354.2 +057200 WRITE-INIT-01. SQ1354.2 +057300 WRITE-TEST-01-01. SQ1354.2 +057400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1354.2 +057500 WRITE SQ-FS1R1-F-G-120. SQ1354.2 +057600* SQ1354.2 +057700 CLOSE-INIT-01. SQ1354.2 +057800 CLOSE-TEST-01. SQ1354.2 +057900 CLOSE SQ-FS1. SQ1354.2 +058000* SQ1354.2 +058100* HAVING CLOSED THE FILE, WE NOW TRY TO CLOSE IT AGAIN. SQ1354.2 +058200* THE TEST PASSES IF THE FILE CANNOT BE RECLOSED AND SQ1354.2 +058300* THE APPROPRIATE I-O STATUS VALUE IS RETURNED. SQ1354.2 +058400* AN IMPLEMENTATION MAY TERMINATE EXECUTION OF A SQ1354.2 +058500* PROGRAM WHICH ATTEMPTS TO RECLOSE AN ALREADY CLOSED FILE.SQ1354.2 +058600 CLOSE-INIT-02. SQ1354.2 +058700* SQ1354.2 +058800 MOVE 1 TO REC-CT. SQ1354.2 +058900 MOVE "CLOSE-TEST-02" TO PAR-NAME SQ1354.2 +059000 MOVE "CLOSE OF CLOSED FILE" TO FEATURE. SQ1354.2 +059100 CLOSE-TEST-02. SQ1354.2 +059200 CLOSE SQ-FS1. SQ1354.2 +059300* SQ1354.2 +059400 CCVS-EXIT SECTION. SQ1354.2 +059500 CCVS-999999. SQ1354.2 +059600 GO TO CLOSE-FILES. SQ1354.2 diff --git a/tests/cobol85/SQ/SQ136A.CBL b/tests/cobol85/SQ/SQ136A.CBL new file mode 100755 index 00000000..5808fc97 --- /dev/null +++ b/tests/cobol85/SQ/SQ136A.CBL @@ -0,0 +1,813 @@ +000100 IDENTIFICATION DIVISION. SQ1364.2 +000200 PROGRAM-ID. SQ1364.2 +000300 SQ136A. SQ1364.2 +000400**************************************************************** SQ1364.2 +000500* * SQ1364.2 +000600* VALIDATION FOR:- * SQ1364.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1364.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1364.2 +000900* REVISED 1986, AUGUST * SQ1364.2 +001000* * SQ1364.2 +001100* CREATION DATE / VALIDATION DATE * SQ1364.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1364.2 +001300* * SQ1364.2 +001400**************************************************************** SQ1364.2 +001500* * SQ1364.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1364.2 +001700* * SQ1364.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1364.2 +001900* X-55 SYSTEM PRINTER * SQ1364.2 +002000* X-82 SOURCE-COMPUTER * SQ1364.2 +002100* X-83 OBJECT-COMPUTER. * SQ1364.2 +002200* * SQ1364.2 +002300**************************************************************** SQ1364.2 +002400* * SQ1364.2 +002500* SPLIT FROM SQ122A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1364.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1364.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO READING* SQ1364.2 +002800* PAST THE END OF A FILE. (SEE SQ122A). * SQ1364.2 +002900* * SQ1364.2 +003000**************************************************************** SQ1364.2 +003100* SQ1364.2 +003200 ENVIRONMENT DIVISION. SQ1364.2 +003300 CONFIGURATION SECTION. SQ1364.2 +003400 SOURCE-COMPUTER. SQ1364.2 +003500 Linux. SQ1364.2 +003600 OBJECT-COMPUTER. SQ1364.2 +003700 Linux. SQ1364.2 +003800* SQ1364.2 +003900 INPUT-OUTPUT SECTION. SQ1364.2 +004000 FILE-CONTROL. SQ1364.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1364.2 +004200 "report.log". SQ1364.2 +004300* SQ1364.2 +004400*P SELECT RAW-DATA ASSIGN TO SQ1364.2 +004500*P "XXXXX062" SQ1364.2 +004600*P ORGANIZATION IS INDEXED SQ1364.2 +004700*P ACCESS MODE IS RANDOM SQ1364.2 +004800*P RECORD-KEY IS RAW-DATA-KEY. SQ1364.2 +004900*P SQ1364.2 +005000 SELECT SQ-FS4 ASSIGN SQ1364.2 +005100 "XXXXX014" SQ1364.2 +005200 FILE STATUS IS SQ-FS4-STATUS. SQ1364.2 +005300* SQ1364.2 +005400* SQ1364.2 +005500 DATA DIVISION. SQ1364.2 +005600 FILE SECTION. SQ1364.2 +005700 FD PRINT-FILE SQ1364.2 +005800*C LABEL RECORDS SQ1364.2 +005900*C OMITTED SQ1364.2 +006000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1364.2 +006100 . SQ1364.2 +006200 01 PRINT-REC PICTURE X(120). SQ1364.2 +006300 01 DUMMY-RECORD PICTURE X(120). SQ1364.2 +006400*P SQ1364.2 +006500*PD RAW-DATA. SQ1364.2 +006600*P1 RAW-DATA-SATZ. SQ1364.2 +006700*P 05 RAW-DATA-KEY PIC X(6). SQ1364.2 +006800*P 05 C-DATE PIC 9(6). SQ1364.2 +006900*P 05 C-TIME PIC 9(8). SQ1364.2 +007000*P 05 NO-OF-TESTS PIC 99. SQ1364.2 +007100*P 05 C-OK PIC 999. SQ1364.2 +007200*P 05 C-ALL PIC 999. SQ1364.2 +007300*P 05 C-FAIL PIC 999. SQ1364.2 +007400*P 05 C-DELETED PIC 999. SQ1364.2 +007500*P 05 C-INSPECT PIC 999. SQ1364.2 +007600*P 05 C-NOTE PIC X(13). SQ1364.2 +007700*P 05 C-INDENT PIC X. SQ1364.2 +007800*P 05 C-ABORT PIC X(8). SQ1364.2 +007900* SQ1364.2 +008000 FD SQ-FS4 SQ1364.2 +008100*C LABEL RECORD IS STANDARD SQ1364.2 +008200 BLOCK 2 RECORDS SQ1364.2 +008300 RECORD 125 SQ1364.2 +008400 . SQ1364.2 +008500 01 SQ-FS4R1-F-G-125. SQ1364.2 +008600 05 SQ-FS4-FIRST PIC X(120). SQ1364.2 +008700 05 SQ-FS4-REC-NO PIC 99999. SQ1364.2 +008800* SQ1364.2 +008900 WORKING-STORAGE SECTION. SQ1364.2 +009000* SQ1364.2 +009100*************************************************************** SQ1364.2 +009200* * SQ1364.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1364.2 +009400* * SQ1364.2 +009500*************************************************************** SQ1364.2 +009600* SQ1364.2 +009700 01 SQ-FS4-STATUS. SQ1364.2 +009800 03 SQ-FS4-KEY-1 PIC X. SQ1364.2 +009900 03 SQ-FS4-KEY-2 PIC X. SQ1364.2 +010000* SQ1364.2 +010100 01 DELETE-SW. SQ1364.2 +010200 03 DELETE-SW-1 PIC X. SQ1364.2 +010300 03 DELETE-SW-1-GROUP. SQ1364.2 +010400 05 DELETE-SW-2 PIC X. SQ1364.2 +010500* SQ1364.2 +010600 01 DECL-EXEC-I PIC X(12). SQ1364.2 +010700 01 DECL-EXEC-O PIC X(12). SQ1364.2 +010800 01 DECL-EXEC-SW PIC X. SQ1364.2 +010900* SQ1364.2 +011000*************************************************************** SQ1364.2 +011100* * SQ1364.2 +011200* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1364.2 +011300* * SQ1364.2 +011400*************************************************************** SQ1364.2 +011500* SQ1364.2 +011600 01 REC-SKEL-SUB PIC 99. SQ1364.2 +011700* SQ1364.2 +011800 01 FILE-RECORD-INFORMATION-REC. SQ1364.2 +011900 03 FILE-RECORD-INFO-SKELETON. SQ1364.2 +012000 05 FILLER PICTURE X(48) VALUE SQ1364.2 +012100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1364.2 +012200 05 FILLER PICTURE X(46) VALUE SQ1364.2 +012300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1364.2 +012400 05 FILLER PICTURE X(26) VALUE SQ1364.2 +012500 ",LFIL=000000,ORG= ,LBLR= ". SQ1364.2 +012600 05 FILLER PICTURE X(37) VALUE SQ1364.2 +012700 ",RECKEY= ". SQ1364.2 +012800 05 FILLER PICTURE X(38) VALUE SQ1364.2 +012900 ",ALTKEY1= ". SQ1364.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1364.2 +013100 ",ALTKEY2= ". SQ1364.2 +013200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1364.2 +013300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1364.2 +013400 05 FILE-RECORD-INFO-P1-120. SQ1364.2 +013500 07 FILLER PIC X(5). SQ1364.2 +013600 07 XFILE-NAME PIC X(6). SQ1364.2 +013700 07 FILLER PIC X(8). SQ1364.2 +013800 07 XRECORD-NAME PIC X(6). SQ1364.2 +013900 07 FILLER PIC X(1). SQ1364.2 +014000 07 REELUNIT-NUMBER PIC 9(1). SQ1364.2 +014100 07 FILLER PIC X(7). SQ1364.2 +014200 07 XRECORD-NUMBER PIC 9(6). SQ1364.2 +014300 07 FILLER PIC X(6). SQ1364.2 +014400 07 UPDATE-NUMBER PIC 9(2). SQ1364.2 +014500 07 FILLER PIC X(5). SQ1364.2 +014600 07 ODO-NUMBER PIC 9(4). SQ1364.2 +014700 07 FILLER PIC X(5). SQ1364.2 +014800 07 XPROGRAM-NAME PIC X(5). SQ1364.2 +014900 07 FILLER PIC X(7). SQ1364.2 +015000 07 XRECORD-LENGTH PIC 9(6). SQ1364.2 +015100 07 FILLER PIC X(7). SQ1364.2 +015200 07 CHARS-OR-RECORDS PIC X(2). SQ1364.2 +015300 07 FILLER PIC X(1). SQ1364.2 +015400 07 XBLOCK-SIZE PIC 9(4). SQ1364.2 +015500 07 FILLER PIC X(6). SQ1364.2 +015600 07 RECORDS-IN-FILE PIC 9(6). SQ1364.2 +015700 07 FILLER PIC X(5). SQ1364.2 +015800 07 XFILE-ORGANIZATION PIC X(2). SQ1364.2 +015900 07 FILLER PIC X(6). SQ1364.2 +016000 07 XLABEL-TYPE PIC X(1). SQ1364.2 +016100 05 FILE-RECORD-INFO-P121-240. SQ1364.2 +016200 07 FILLER PIC X(8). SQ1364.2 +016300 07 XRECORD-KEY PIC X(29). SQ1364.2 +016400 07 FILLER PIC X(9). SQ1364.2 +016500 07 ALTERNATE-KEY1 PIC X(29). SQ1364.2 +016600 07 FILLER PIC X(9). SQ1364.2 +016700 07 ALTERNATE-KEY2 PIC X(29). SQ1364.2 +016800 07 FILLER PIC X(7). SQ1364.2 +016900* SQ1364.2 +017000 01 TEST-RESULTS. SQ1364.2 +017100 02 FILLER PIC X VALUE SPACE. SQ1364.2 +017200 02 PAR-NAME. SQ1364.2 +017300 03 FILLER PIC X(14) VALUE SPACE. SQ1364.2 +017400 03 PARDOT-X PIC X VALUE SPACE. SQ1364.2 +017500 03 DOTVALUE PIC 99 VALUE ZERO. SQ1364.2 +017600 02 FILLER PIC X VALUE SPACE. SQ1364.2 +017700 02 FEATURE PIC X(24) VALUE SPACE. SQ1364.2 +017800 02 FILLER PIC X VALUE SPACE. SQ1364.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. SQ1364.2 +018000 02 FILLER PIC X(9) VALUE SPACE. SQ1364.2 +018100 02 RE-MARK PIC X(61). SQ1364.2 +018200 01 TEST-COMPUTED. SQ1364.2 +018300 02 FILLER PIC X(30) VALUE SPACE. SQ1364.2 +018400 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1364.2 +018500 02 COMPUTED-X. SQ1364.2 +018600 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1364.2 +018700 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1364.2 +018800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1364.2 +018900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1364.2 +019000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1364.2 +019100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1364.2 +019200 04 COMPUTED-18V0 PIC -9(18). SQ1364.2 +019300 04 FILLER PIC X. SQ1364.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SQ1364.2 +019500 01 TEST-CORRECT. SQ1364.2 +019600 02 FILLER PIC X(30) VALUE SPACE. SQ1364.2 +019700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1364.2 +019800 02 CORRECT-X. SQ1364.2 +019900 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1364.2 +020000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1364.2 +020100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1364.2 +020200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1364.2 +020300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1364.2 +020400 03 CR-18V0 REDEFINES CORRECT-A. SQ1364.2 +020500 04 CORRECT-18V0 PIC -9(18). SQ1364.2 +020600 04 FILLER PIC X. SQ1364.2 +020700 03 FILLER PIC X(2) VALUE SPACE. SQ1364.2 +020800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1364.2 +020900* SQ1364.2 +021000 01 CCVS-C-1. SQ1364.2 +021100 02 FILLER PIC IS X VALUE SPACE. SQ1364.2 +021200 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1364.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1364.2 +021400 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1364.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1364.2 +021600 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1364.2 +021700 02 FILLER PIC IS X(9) VALUE SPACE. SQ1364.2 +021800 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1364.2 +021900 01 CCVS-C-2. SQ1364.2 +022000 02 FILLER PIC X(19) VALUE SPACE. SQ1364.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". SQ1364.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1364.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". SQ1364.2 +022400 02 FILLER PIC X(72) VALUE SPACE. SQ1364.2 +022500* SQ1364.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1364.2 +022700 01 REC-CT PIC 99 VALUE ZERO. SQ1364.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1364.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1364.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1364.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1364.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1364.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1364.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1364.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1364.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1364.2 +023700 01 CCVS-H-1. SQ1364.2 +023800 02 FILLER PIC X(39) VALUE SPACES. SQ1364.2 +023900 02 FILLER PIC X(42) VALUE SQ1364.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1364.2 +024100 02 FILLER PIC X(39) VALUE SPACES. SQ1364.2 +024200 01 CCVS-H-2A. SQ1364.2 +024300 02 FILLER PIC X(40) VALUE SPACE. SQ1364.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1364.2 +024500 02 FILLER PIC XXXX VALUE SQ1364.2 +024600 "4.2 ". SQ1364.2 +024700 02 FILLER PIC X(28) VALUE SQ1364.2 +024800 " COPY - NOT FOR DISTRIBUTION". SQ1364.2 +024900 02 FILLER PIC X(41) VALUE SPACE. SQ1364.2 +025000* SQ1364.2 +025100 01 CCVS-H-2B. SQ1364.2 +025200 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1364.2 +025300 02 TEST-ID PIC X(9). SQ1364.2 +025400 02 FILLER PIC X(4) VALUE " IN ". SQ1364.2 +025500 02 FILLER PIC X(12) VALUE SQ1364.2 +025600 " HIGH ". SQ1364.2 +025700 02 FILLER PIC X(22) VALUE SQ1364.2 +025800 " LEVEL VALIDATION FOR ". SQ1364.2 +025900 02 FILLER PIC X(58) VALUE SQ1364.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1364.2 +026100 01 CCVS-H-3. SQ1364.2 +026200 02 FILLER PIC X(34) VALUE SQ1364.2 +026300 " FOR OFFICIAL USE ONLY ". SQ1364.2 +026400 02 FILLER PIC X(58) VALUE SQ1364.2 +026500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1364.2 +026600 02 FILLER PIC X(28) VALUE SQ1364.2 +026700 " COPYRIGHT 1985,1986 ". SQ1364.2 +026800 01 CCVS-E-1. SQ1364.2 +026900 02 FILLER PIC X(52) VALUE SPACE. SQ1364.2 +027000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1364.2 +027100 02 ID-AGAIN PIC X(9). SQ1364.2 +027200 02 FILLER PIC X(45) VALUE SPACES. SQ1364.2 +027300 01 CCVS-E-2. SQ1364.2 +027400 02 FILLER PIC X(31) VALUE SPACE. SQ1364.2 +027500 02 FILLER PIC X(21) VALUE SPACE. SQ1364.2 +027600 02 CCVS-E-2-2. SQ1364.2 +027700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1364.2 +027800 03 FILLER PIC X VALUE SPACE. SQ1364.2 +027900 03 ENDER-DESC PIC X(44) VALUE SQ1364.2 +028000 "ERRORS ENCOUNTERED". SQ1364.2 +028100 01 CCVS-E-3. SQ1364.2 +028200 02 FILLER PIC X(22) VALUE SQ1364.2 +028300 " FOR OFFICIAL USE ONLY". SQ1364.2 +028400 02 FILLER PIC X(12) VALUE SPACE. SQ1364.2 +028500 02 FILLER PIC X(58) VALUE SQ1364.2 +028600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1364.2 +028700 02 FILLER PIC X(8) VALUE SPACE. SQ1364.2 +028800 02 FILLER PIC X(20) VALUE SQ1364.2 +028900 " COPYRIGHT 1985,1986". SQ1364.2 +029000 01 CCVS-E-4. SQ1364.2 +029100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1364.2 +029200 02 FILLER PIC X(4) VALUE " OF ". SQ1364.2 +029300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1364.2 +029400 02 FILLER PIC X(40) VALUE SQ1364.2 +029500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1364.2 +029600 01 XXINFO. SQ1364.2 +029700 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1364.2 +029800 02 INFO-TEXT. SQ1364.2 +029900 04 FILLER PIC X(8) VALUE SPACE. SQ1364.2 +030000 04 XXCOMPUTED PIC X(20). SQ1364.2 +030100 04 FILLER PIC X(5) VALUE SPACE. SQ1364.2 +030200 04 XXCORRECT PIC X(20). SQ1364.2 +030300 02 INF-ANSI-REFERENCE PIC X(48). SQ1364.2 +030400 01 HYPHEN-LINE. SQ1364.2 +030500 02 FILLER PIC IS X VALUE IS SPACE. SQ1364.2 +030600 02 FILLER PIC IS X(65) VALUE IS "************************SQ1364.2 +030700- "*****************************************". SQ1364.2 +030800 02 FILLER PIC IS X(54) VALUE IS "************************SQ1364.2 +030900- "******************************". SQ1364.2 +031000 01 CCVS-PGM-ID PIC X(9) VALUE SQ1364.2 +031100 "SQ136A". SQ1364.2 +031200* SQ1364.2 +031300* SQ1364.2 +031400 PROCEDURE DIVISION. SQ1364.2 +031500 DECLARATIVES. SQ1364.2 +031600* SQ1364.2 +031700* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ1364.2 +031800* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ1364.2 +031900* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ1364.2 +032000* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ1364.2 +032100* SQ1364.2 +032200 SECT-SQ136A-0000 SECTION. SQ1364.2 +032300 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ1364.2 +032400 PRINT-FILE-ERROR-PROCESS. SQ1364.2 +032500 EXIT. SQ1364.2 +032600* SQ1364.2 +032700 SECT-SQ136A-0001 SECTION. SQ1364.2 +032800 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1364.2 +032900 OUTPUT-ERROR-PROCESS. SQ1364.2 +033000 MOVE "EXECUTED" TO DECL-EXEC-O. SQ1364.2 +033100* SQ1364.2 +033200 SECT-SQ136A-0002 SECTION. SQ1364.2 +033300 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1364.2 +033400 INPUT-ERROR-PROCESS. SQ1364.2 +033500 MOVE "EXECUTED" TO DECL-EXEC-I. SQ1364.2 +033600* SQ1364.2 +033700 IF DECL-EXEC-SW NOT = SPACE SQ1364.2 +033800 GO TO END-DECLS. SQ1364.2 +033900* SQ1364.2 +034000 MOVE 1 TO REC-CT. SQ1364.2 +034100 MOVE "READ AFTER EOF READ" TO FEATURE. SQ1364.2 +034200 MOVE "DECL-EOF-READ" TO PAR-NAME. SQ1364.2 +034300 GO TO DECL-EOF-READ-01. SQ1364.2 +034400 DECL-DELETE-01. SQ1364.2 +034500 PERFORM DECL-DE-LETE. SQ1364.2 +034600 GO TO DECL-TEST-01-END. SQ1364.2 +034700 DECL-EOF-READ-01. SQ1364.2 +034800 DECL-TEST-01-END. SQ1364.2 +034900* SQ1364.2 +035000 ADD 1 TO REC-CT. SQ1364.2 +035100 GO TO DECL-EOF-READ-02. SQ1364.2 +035200 DECL-DELETE-02. SQ1364.2 +035300 PERFORM DECL-DE-LETE. SQ1364.2 +035400 GO TO DECL-TEST-02-END. SQ1364.2 +035500 DECL-EOF-READ-02. SQ1364.2 +035600 DECL-TEST-02-END. SQ1364.2 +035700* SQ1364.2 +035800 MOVE SPACE TO DUMMY-RECORD. SQ1364.2 +035900 PERFORM DECL-WRITE-LINE. SQ1364.2 +036000 MOVE "ABNORMAL TERMINATION OF PROGRAM HERE IS ACCEPTABLE" SQ1364.2 +036100 TO DUMMY-RECORD. SQ1364.2 +036200 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1364.2 +036300 GO TO END-DECLS. SQ1364.2 +036400* SQ1364.2 +036500* SQ1364.2 +036600 DECL-PASS. SQ1364.2 +036700 MOVE "PASS " TO P-OR-F. SQ1364.2 +036800 ADD 1 TO PASS-COUNTER. SQ1364.2 +036900 PERFORM DECL-PRINT-DETAIL. SQ1364.2 +037000* SQ1364.2 +037100 DECL-FAIL. SQ1364.2 +037200 MOVE "FAIL*" TO P-OR-F. SQ1364.2 +037300 ADD 1 TO ERROR-COUNTER. SQ1364.2 +037400 PERFORM DECL-PRINT-DETAIL. SQ1364.2 +037500* SQ1364.2 +037600 DECL-DE-LETE. SQ1364.2 +037700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1364.2 +037800 MOVE "*****" TO P-OR-F. SQ1364.2 +037900 ADD 1 TO DELETE-COUNTER. SQ1364.2 +038000 PERFORM DECL-PRINT-DETAIL. SQ1364.2 +038100* SQ1364.2 +038200 DECL-PRINT-DETAIL. SQ1364.2 +038300 IF REC-CT NOT EQUAL TO ZERO SQ1364.2 +038400 MOVE "." TO PARDOT-X SQ1364.2 +038500 MOVE REC-CT TO DOTVALUE. SQ1364.2 +038600 MOVE TEST-RESULTS TO PRINT-REC. SQ1364.2 +038700 PERFORM DECL-WRITE-LINE. SQ1364.2 +038800 IF P-OR-F EQUAL TO "FAIL*" SQ1364.2 +038900 PERFORM DECL-WRITE-LINE SQ1364.2 +039000 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1364.2 +039100 ELSE SQ1364.2 +039200 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1364.2 +039300 MOVE SPACE TO P-OR-F. SQ1364.2 +039400 MOVE SPACE TO COMPUTED-X. SQ1364.2 +039500 MOVE SPACE TO CORRECT-X. SQ1364.2 +039600 IF REC-CT EQUAL TO ZERO SQ1364.2 +039700 MOVE SPACE TO PAR-NAME. SQ1364.2 +039800 MOVE SPACE TO RE-MARK. SQ1364.2 +039900* SQ1364.2 +040000 DECL-WRITE-LINE. SQ1364.2 +040100 ADD 1 TO RECORD-COUNT. SQ1364.2 +040200 IF RECORD-COUNT GREATER 50 SQ1364.2 +040300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1364.2 +040400 MOVE SPACE TO DUMMY-RECORD SQ1364.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1364.2 +040600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1364.2 +040700 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1364.2 +040800 PERFORM DECL-WRT-LN 2 TIMES SQ1364.2 +040900 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1364.2 +041000 PERFORM DECL-WRT-LN SQ1364.2 +041100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1364.2 +041200 MOVE ZERO TO RECORD-COUNT. SQ1364.2 +041300 PERFORM DECL-WRT-LN. SQ1364.2 +041400* SQ1364.2 +041500 DECL-WRT-LN. SQ1364.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1364.2 +041700 MOVE SPACE TO DUMMY-RECORD. SQ1364.2 +041800* SQ1364.2 +041900 DECL-FAIL-ROUTINE. SQ1364.2 +042000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1364.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1364.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1364.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1364.2 +042400 MOVE XXINFO TO DUMMY-RECORD. SQ1364.2 +042500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1364.2 +042600 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1364.2 +042700 GO TO DECL-FAIL-EX. SQ1364.2 +042800 DECL-FAIL-WRITE. SQ1364.2 +042900 MOVE TEST-COMPUTED TO PRINT-REC SQ1364.2 +043000 PERFORM DECL-WRITE-LINE SQ1364.2 +043100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1364.2 +043200 MOVE TEST-CORRECT TO PRINT-REC SQ1364.2 +043300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1364.2 +043400 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1364.2 +043500 DECL-FAIL-EX. SQ1364.2 +043600 EXIT. SQ1364.2 +043700* SQ1364.2 +043800 DECL-BAIL. SQ1364.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1364.2 +044000 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1364.2 +044100 DECL-BAIL-WRITE. SQ1364.2 +044200 MOVE CORRECT-A TO XXCORRECT. SQ1364.2 +044300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1364.2 +044400 MOVE XXINFO TO DUMMY-RECORD. SQ1364.2 +044500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1364.2 +044600 DECL-BAIL-EX. SQ1364.2 +044700 EXIT. SQ1364.2 +044800* SQ1364.2 +044900 END-DECLS. SQ1364.2 +045000 END DECLARATIVES. SQ1364.2 +045100* SQ1364.2 +045200* SQ1364.2 +045300 CCVS1 SECTION. SQ1364.2 +045400 OPEN-FILES. SQ1364.2 +045500*P OPEN I-O RAW-DATA. SQ1364.2 +045600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1364.2 +045700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1364.2 +045800*P MOVE "ABORTED " TO C-ABORT. SQ1364.2 +045900*P ADD 1 TO C-NO-OF-TESTS. SQ1364.2 +046000*P ACCEPT C-DATE FROM DATE. SQ1364.2 +046100*P ACCEPT C-TIME FROM TIME. SQ1364.2 +046200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1364.2 +046300*PND-E-1. SQ1364.2 +046400*P CLOSE RAW-DATA. SQ1364.2 +046500 OPEN OUTPUT PRINT-FILE. SQ1364.2 +046600 MOVE CCVS-PGM-ID TO TEST-ID. SQ1364.2 +046700 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1364.2 +046800 MOVE SPACE TO TEST-RESULTS. SQ1364.2 +046900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1364.2 +047000 MOVE ZERO TO REC-SKEL-SUB. SQ1364.2 +047100 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1364.2 +047200 GO TO CCVS1-EXIT. SQ1364.2 +047300* SQ1364.2 +047400 CCVS-INIT-FILE. SQ1364.2 +047500 ADD 1 TO REC-SKL-SUB. SQ1364.2 +047600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1364.2 +047700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1364.2 +047800* SQ1364.2 +047900 CLOSE-FILES. SQ1364.2 +048000 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1364.2 +048100 CLOSE PRINT-FILE. SQ1364.2 +048200*P OPEN I-O RAW-DATA. SQ1364.2 +048300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1364.2 +048400*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1364.2 +048500*P MOVE "OK. " TO C-ABORT. SQ1364.2 +048600*P MOVE PASS-COUNTER TO C-OK. SQ1364.2 +048700*P MOVE ERROR-HOLD TO C-ALL. SQ1364.2 +048800*P MOVE ERROR-COUNTER TO C-FAIL. SQ1364.2 +048900*P MOVE DELETE-CNT TO C-DELETED. SQ1364.2 +049000*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1364.2 +049100*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1364.2 +049200*PND-E-2. SQ1364.2 +049300*P CLOSE RAW-DATA. SQ1364.2 +049400 TERMINATE-CCVS. SQ1364.2 +049500*S EXIT PROGRAM. SQ1364.2 +049600 STOP RUN. SQ1364.2 +049700* SQ1364.2 +049800 INSPT. SQ1364.2 +049900 MOVE "INSPT" TO P-OR-F. SQ1364.2 +050000 ADD 1 TO INSPECT-COUNTER. SQ1364.2 +050100 PERFORM PRINT-DETAIL. SQ1364.2 +050200* SQ1364.2 +050300 PASS. SQ1364.2 +050400 MOVE "PASS " TO P-OR-F. SQ1364.2 +050500 ADD 1 TO PASS-COUNTER. SQ1364.2 +050600 PERFORM PRINT-DETAIL. SQ1364.2 +050700* SQ1364.2 +050800 FAIL. SQ1364.2 +050900 MOVE "FAIL*" TO P-OR-F. SQ1364.2 +051000 ADD 1 TO ERROR-COUNTER. SQ1364.2 +051100 PERFORM PRINT-DETAIL. SQ1364.2 +051200* SQ1364.2 +051300 DE-LETE. SQ1364.2 +051400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1364.2 +051500 MOVE "*****" TO P-OR-F. SQ1364.2 +051600 ADD 1 TO DELETE-COUNTER. SQ1364.2 +051700 PERFORM PRINT-DETAIL. SQ1364.2 +051800* SQ1364.2 +051900 PRINT-DETAIL. SQ1364.2 +052000 IF REC-CT NOT EQUAL TO ZERO SQ1364.2 +052100 MOVE "." TO PARDOT-X SQ1364.2 +052200 MOVE REC-CT TO DOTVALUE. SQ1364.2 +052300 MOVE TEST-RESULTS TO PRINT-REC. SQ1364.2 +052400 PERFORM WRITE-LINE. SQ1364.2 +052500 IF P-OR-F EQUAL TO "FAIL*" SQ1364.2 +052600 PERFORM WRITE-LINE SQ1364.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1364.2 +052800 ELSE SQ1364.2 +052900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1364.2 +053000 MOVE SPACE TO P-OR-F. SQ1364.2 +053100 MOVE SPACE TO COMPUTED-X. SQ1364.2 +053200 MOVE SPACE TO CORRECT-X. SQ1364.2 +053300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1364.2 +053400 MOVE SPACE TO RE-MARK. SQ1364.2 +053500* SQ1364.2 +053600 HEAD-ROUTINE. SQ1364.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1364.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1364.2 +054100 COLUMN-NAMES-ROUTINE. SQ1364.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1364.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1364.2 +054500 END-ROUTINE. SQ1364.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1364.2 +054700 PERFORM WRITE-LINE 5 TIMES. SQ1364.2 +054800 END-RTN-EXIT. SQ1364.2 +054900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1364.2 +055000 PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +055100* SQ1364.2 +055200 END-ROUTINE-1. SQ1364.2 +055300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1364.2 +055400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1364.2 +055500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1364.2 +055600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1364.2 +055700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1364.2 +055800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1364.2 +055900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1364.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1364.2 +056100 PERFORM WRITE-LINE. SQ1364.2 +056200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1364.2 +056300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1364.2 +056400 MOVE "NO " TO ERROR-TOTAL SQ1364.2 +056500 ELSE SQ1364.2 +056600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1364.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1364.2 +056800 PERFORM WRITE-LINE. SQ1364.2 +056900 END-ROUTINE-13. SQ1364.2 +057000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1364.2 +057100 MOVE "NO " TO ERROR-TOTAL SQ1364.2 +057200 ELSE SQ1364.2 +057300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1364.2 +057400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1364.2 +057500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1364.2 +057600 PERFORM WRITE-LINE. SQ1364.2 +057700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1364.2 +057800 MOVE "NO " TO ERROR-TOTAL SQ1364.2 +057900 ELSE SQ1364.2 +058000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1364.2 +058100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1364.2 +058200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1364.2 +058300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1364.2 +058400* SQ1364.2 +058500 WRITE-LINE. SQ1364.2 +058600 ADD 1 TO RECORD-COUNT. SQ1364.2 +058700 IF RECORD-COUNT GREATER 50 SQ1364.2 +058800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1364.2 +058900 MOVE SPACE TO DUMMY-RECORD SQ1364.2 +059000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1364.2 +059100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1364.2 +059200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1364.2 +059300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1364.2 +059400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1364.2 +059500 MOVE ZERO TO RECORD-COUNT. SQ1364.2 +059600 PERFORM WRT-LN. SQ1364.2 +059700* SQ1364.2 +059800 WRT-LN. SQ1364.2 +059900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1364.2 +060000 MOVE SPACE TO DUMMY-RECORD. SQ1364.2 +060100 BLANK-LINE-PRINT. SQ1364.2 +060200 PERFORM WRT-LN. SQ1364.2 +060300 FAIL-ROUTINE. SQ1364.2 +060400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1364.2 +060500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1364.2 +060600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1364.2 +060700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1364.2 +060800 MOVE XXINFO TO DUMMY-RECORD. SQ1364.2 +060900 PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +061000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1364.2 +061100 GO TO FAIL-ROUTINE-EX. SQ1364.2 +061200 FAIL-ROUTINE-WRITE. SQ1364.2 +061300 MOVE TEST-COMPUTED TO PRINT-REC SQ1364.2 +061400 PERFORM WRITE-LINE SQ1364.2 +061500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1364.2 +061600 MOVE TEST-CORRECT TO PRINT-REC SQ1364.2 +061700 PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +061800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1364.2 +061900 FAIL-ROUTINE-EX. SQ1364.2 +062000 EXIT. SQ1364.2 +062100 BAIL-OUT. SQ1364.2 +062200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1364.2 +062300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1364.2 +062400 BAIL-OUT-WRITE. SQ1364.2 +062500 MOVE CORRECT-A TO XXCORRECT. SQ1364.2 +062600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1364.2 +062700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1364.2 +062800 MOVE XXINFO TO DUMMY-RECORD. SQ1364.2 +062900 PERFORM WRITE-LINE 2 TIMES. SQ1364.2 +063000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1364.2 +063100 BAIL-OUT-EX. SQ1364.2 +063200 EXIT. SQ1364.2 +063300 CCVS1-EXIT. SQ1364.2 +063400 EXIT. SQ1364.2 +063500* SQ1364.2 +063600**************************************************************** SQ1364.2 +063700* * SQ1364.2 +063800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1364.2 +063900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1364.2 +064000* * SQ1364.2 +064100**************************************************************** SQ1364.2 +064200* SQ1364.2 +064300 SECT-SQ136A-0004 SECTION. SQ1364.2 +064400 STA-INIT. SQ1364.2 +064500 MOVE SPACE TO DELETE-SW. SQ1364.2 +064600* SQ1364.2 +064700 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1364.2 +064800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1364.2 +064900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1364.2 +065000 MOVE 125 TO XRECORD-LENGTH (1). SQ1364.2 +065100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1364.2 +065200 MOVE 2 TO XBLOCK-SIZE (1). SQ1364.2 +065300 MOVE 1 TO RECORDS-IN-FILE (1). SQ1364.2 +065400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1364.2 +065500 MOVE "S" TO XLABEL-TYPE (1). SQ1364.2 +065600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1364.2 +065700* SQ1364.2 +065800* OPEN THE FILE IN THE OUTPUT MODE SQ1364.2 +065900* SQ1364.2 +066000 SEQ-INIT-01. SQ1364.2 +066100 MOVE 0 TO REC-CT. SQ1364.2 +066200 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +066300 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +066400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +066500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +066600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1364.2 +066700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1364.2 +066800 GO TO SEQ-TEST-OP-01. SQ1364.2 +066900 SEQ-DELETE-01. SQ1364.2 +067000 MOVE "*" TO DELETE-SW-1. SQ1364.2 +067100 SEQ-TEST-OP-01. SQ1364.2 +067200 OPEN OUTPUT SQ-FS4. SQ1364.2 +067300 SEQ-INIT-02. SQ1364.2 +067400 MOVE 0 TO REC-CT. SQ1364.2 +067500 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +067600 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +067700 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +067800 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +067900 ADD 1 TO XRECORD-NUMBER (1). SQ1364.2 +068000 MOVE "WRITE ONE RECORD" TO FEATURE. SQ1364.2 +068100 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1364.2 +068200 IF DELETE-SW NOT EQUAL TO SPACE SQ1364.2 +068300 GO TO SEQ-DELETE-02. SQ1364.2 +068400 GO TO SEQ-TEST-WR-02. SQ1364.2 +068500 SEQ-DELETE-02. SQ1364.2 +068600 MOVE "*" TO DELETE-SW-2. SQ1364.2 +068700 SEQ-TEST-WR-02. SQ1364.2 +068800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1364.2 +068900 MOVE XRECORD-NUMBER (1) TO SQ-FS4-REC-NO. SQ1364.2 +069000 WRITE SQ-FS4R1-F-G-125. SQ1364.2 +069100 SEQ-INIT-03. SQ1364.2 +069200 MOVE 0 TO REC-CT. SQ1364.2 +069300 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +069400 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +069500 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +069600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +069700 MOVE "CLOSE AFTER CREATE" TO FEATURE. SQ1364.2 +069800 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1364.2 +069900 IF DELETE-SW NOT EQUAL TO SPACE SQ1364.2 +070000 GO TO SEQ-DELETE-03. SQ1364.2 +070100 GO TO SEQ-TEST-CL-03. SQ1364.2 +070200 SEQ-DELETE-03. SQ1364.2 +070300 MOVE "*" TO DELETE-SW-2. SQ1364.2 +070400 SEQ-TEST-CL-03. SQ1364.2 +070500 CLOSE SQ-FS4. SQ1364.2 +070600 SEQ-INIT-04. SQ1364.2 +070700 MOVE 0 TO REC-CT. SQ1364.2 +070800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1364.2 +070900 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +071000 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +071100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +071200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +071300 MOVE "OPEN, TO READ FILE" TO FEATURE. SQ1364.2 +071400 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1364.2 +071500 IF DELETE-SW NOT = SPACE SQ1364.2 +071600 GO TO SEQ-DELETE-04. SQ1364.2 +071700 GO TO SEQ-TEST-OP-04. SQ1364.2 +071800 SEQ-DELETE-04. SQ1364.2 +071900 MOVE "*" TO DELETE-SW-2. SQ1364.2 +072000 SEQ-TEST-OP-04. SQ1364.2 +072100 OPEN INPUT SQ-FS4. SQ1364.2 +072200 MOVE SPACE TO SQ-FS4R1-F-G-125. SQ1364.2 +072300* SQ1364.2 +072400* SQ1364.2 +072500* READ THE FIRST (AND ONLY) RECORD FROM THE FILE SQ1364.2 +072600* SQ1364.2 +072700 SEQ-INIT-05. SQ1364.2 +072800 MOVE 0 TO REC-CT. SQ1364.2 +072900 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +073000 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +073100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +073200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +073300 MOVE "READ FIRST RECORD" TO FEATURE. SQ1364.2 +073400 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1364.2 +073500 IF DELETE-SW NOT = SPACE SQ1364.2 +073600 GO TO SEQ-DELETE-05. SQ1364.2 +073700 GO TO SEQ-TEST-RD-05. SQ1364.2 +073800 SEQ-DELETE-05. SQ1364.2 +073900 MOVE "*" TO DELETE-SW-2. SQ1364.2 +074000 SEQ-TEST-RD-05. SQ1364.2 +074100 READ SQ-FS4. SQ1364.2 +074200 MOVE SQ-FS4R1-F-G-125 TO FILE-RECORD-INFO (2). SQ1364.2 +074300* SQ1364.2 +074400* SQ1364.2 +074500* READ AGAIN, TO RAISE THE AT END CONDITION SQ1364.2 +074600* SQ1364.2 +074700 SEQ-INIT-06. SQ1364.2 +074800 MOVE 0 TO REC-CT. SQ1364.2 +074900 MOVE "*" TO DECL-EXEC-SW. SQ1364.2 +075000 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +075100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +075200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +075300 MOVE "READ, GIVING AT END" TO FEATURE. SQ1364.2 +075400 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1364.2 +075500 IF DELETE-SW NOT = SPACE SQ1364.2 +075600 GO TO SEQ-DELETE-06. SQ1364.2 +075700 GO TO SEQ-TEST-RD-06. SQ1364.2 +075800 SEQ-DELETE-06. SQ1364.2 +075900 MOVE "*" TO DELETE-SW-2. SQ1364.2 +076000 SEQ-TEST-RD-06. SQ1364.2 +076100 READ SQ-FS4. SQ1364.2 +076200* SQ1364.2 +076300* SQ1364.2 +076400* READ AGAIN, AFTER AT END, TO RAISE I-O STATUS 46 SQ1364.2 +076500* SQ1364.2 +076600 SEQ-INIT-07. SQ1364.2 +076700 MOVE 0 TO REC-CT. SQ1364.2 +076800 MOVE SPACE TO DECL-EXEC-SW. SQ1364.2 +076900 MOVE "**" TO SQ-FS4-STATUS. SQ1364.2 +077000 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1364.2 +077100 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1364.2 +077200 MOVE "READ AFTER AT END" TO FEATURE. SQ1364.2 +077300 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1364.2 +077400 IF DELETE-SW NOT = SPACE SQ1364.2 +077500 GO TO SEQ-DELETE-07. SQ1364.2 +077600 GO TO SEQ-TEST-RD-07. SQ1364.2 +077700 SEQ-DELETE-07. SQ1364.2 +077800 MOVE "*" TO DELETE-SW-2. SQ1364.2 +077900 GO TO SEQ-DELETE-07-01. SQ1364.2 +078000 SEQ-TEST-RD-07. SQ1364.2 +078100 READ SQ-FS4. SQ1364.2 +078200* SQ1364.2 +078300* THE TESTS FOLLOWING THIS READ STATEMENT MAY NOT BE SQ1364.2 +078400* EXECUTED. THE IMPLEMENTOR MAY LEGITIMATELY TERMINATE SQ1364.2 +078500* EXECUTION ON EXIT FROM THE DECLARATIVE. SQ1364.2 +078600* SQ1364.2 +078700 MOVE ZERO TO REC-CT. SQ1364.2 +078800 MOVE "READ AFTER AT END" TO FEATURE. SQ1364.2 +078900 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1364.2 +079000* SQ1364.2 +079100* CHECK I-O STATUS RETURNED FROM READ AFTER AT END SQ1364.2 +079200* SQ1364.2 +079300 ADD 1 TO REC-CT. SQ1364.2 +079400 IF DELETE-SW NOT = SPACE SQ1364.2 +079500 GO TO SEQ-DELETE-07-01. SQ1364.2 +079600 GO TO SEQ-TEST-RD-07-01. SQ1364.2 +079700 SEQ-DELETE-07-01. SQ1364.2 +079800 PERFORM DE-LETE. SQ1364.2 +079900 GO TO SEQ-TEST-07-01-END. SQ1364.2 +080000 SEQ-TEST-RD-07-01. SQ1364.2 +080100 IF SQ-FS4-STATUS = "46" SQ1364.2 +080200 PERFORM PASS SQ1364.2 +080300 ELSE SQ1364.2 +080400 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1364.2 +080500 MOVE "46" TO CORRECT-A SQ1364.2 +080600 MOVE "UNEXPECTED I-O STATUS BEYOND END OF FILE" SQ1364.2 +080700 TO RE-MARK SQ1364.2 +080800 MOVE "VII-3, VII-44,4.4.4(3)" TO ANSI-REFERENCE SQ1364.2 +080900 PERFORM FAIL. SQ1364.2 +081000 SEQ-TEST-07-01-END. SQ1364.2 +081100 CCVS-EXIT SECTION. SQ1364.2 +081200 CCVS-999999. SQ1364.2 +081300 GO TO CLOSE-FILES. SQ1364.2 diff --git a/tests/cobol85/SQ/SQ137A.CBL b/tests/cobol85/SQ/SQ137A.CBL new file mode 100755 index 00000000..ce97c900 --- /dev/null +++ b/tests/cobol85/SQ/SQ137A.CBL @@ -0,0 +1,835 @@ +000100 IDENTIFICATION DIVISION. SQ1374.2 +000200 PROGRAM-ID. SQ1374.2 +000300 SQ137A. SQ1374.2 +000400**************************************************************** SQ1374.2 +000500* * SQ1374.2 +000600* VALIDATION FOR:- * SQ1374.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1374.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1374.2 +000900* REVISED 1986, AUGUST * SQ1374.2 +001000* * SQ1374.2 +001100* CREATION DATE / VALIDATION DATE * SQ1374.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1374.2 +001300* * SQ1374.2 +001400**************************************************************** SQ1374.2 +001500* * SQ1374.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1374.2 +001700* * SQ1374.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1374.2 +001900* X-55 SYSTEM PRINTER * SQ1374.2 +002000* X-82 SOURCE-COMPUTER * SQ1374.2 +002100* X-83 OBJECT-COMPUTER. * SQ1374.2 +002200* * SQ1374.2 +002300**************************************************************** SQ1374.2 +002400* * SQ1374.2 +002500* SPLIT FROM SQ122A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1374.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1374.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO READING* SQ1374.2 +002800* PAST THE END OF A FILE. (SEE SQ122A). * SQ1374.2 +002900* * SQ1374.2 +003000**************************************************************** SQ1374.2 +003100* SQ1374.2 +003200 ENVIRONMENT DIVISION. SQ1374.2 +003300 CONFIGURATION SECTION. SQ1374.2 +003400 SOURCE-COMPUTER. SQ1374.2 +003500 Linux. SQ1374.2 +003600 OBJECT-COMPUTER. SQ1374.2 +003700 Linux. SQ1374.2 +003800* SQ1374.2 +003900 INPUT-OUTPUT SECTION. SQ1374.2 +004000 FILE-CONTROL. SQ1374.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1374.2 +004200 "report.log". SQ1374.2 +004300* SQ1374.2 +004400*P SELECT RAW-DATA ASSIGN TO SQ1374.2 +004500*P "XXXXX062" SQ1374.2 +004600*P ORGANIZATION IS INDEXED SQ1374.2 +004700*P ACCESS MODE IS RANDOM SQ1374.2 +004800*P RECORD-KEY IS RAW-DATA-KEY. SQ1374.2 +004900*P SQ1374.2 +005000 SELECT SQ-FS4 ASSIGN SQ1374.2 +005100 "XXXXX014" SQ1374.2 +005200 FILE STATUS IS SQ-FS4-STATUS. SQ1374.2 +005300* SQ1374.2 +005400* SQ1374.2 +005500 DATA DIVISION. SQ1374.2 +005600 FILE SECTION. SQ1374.2 +005700 FD PRINT-FILE SQ1374.2 +005800*C LABEL RECORDS SQ1374.2 +005900*C OMITTED SQ1374.2 +006000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1374.2 +006100 . SQ1374.2 +006200 01 PRINT-REC PICTURE X(120). SQ1374.2 +006300 01 DUMMY-RECORD PICTURE X(120). SQ1374.2 +006400*P SQ1374.2 +006500*PD RAW-DATA. SQ1374.2 +006600*P1 RAW-DATA-SATZ. SQ1374.2 +006700*P 05 RAW-DATA-KEY PIC X(6). SQ1374.2 +006800*P 05 C-DATE PIC 9(6). SQ1374.2 +006900*P 05 C-TIME PIC 9(8). SQ1374.2 +007000*P 05 NO-OF-TESTS PIC 99. SQ1374.2 +007100*P 05 C-OK PIC 999. SQ1374.2 +007200*P 05 C-ALL PIC 999. SQ1374.2 +007300*P 05 C-FAIL PIC 999. SQ1374.2 +007400*P 05 C-DELETED PIC 999. SQ1374.2 +007500*P 05 C-INSPECT PIC 999. SQ1374.2 +007600*P 05 C-NOTE PIC X(13). SQ1374.2 +007700*P 05 C-INDENT PIC X. SQ1374.2 +007800*P 05 C-ABORT PIC X(8). SQ1374.2 +007900* SQ1374.2 +008000 FD SQ-FS4 SQ1374.2 +008100*C LABEL RECORD IS STANDARD SQ1374.2 +008200 BLOCK 2 RECORDS SQ1374.2 +008300 RECORD 125 SQ1374.2 +008400 . SQ1374.2 +008500 01 SQ-FS4R1-F-G-125. SQ1374.2 +008600 05 SQ-FS4-FIRST PIC X(120). SQ1374.2 +008700 05 SQ-FS4-REC-NO PIC 99999. SQ1374.2 +008800* SQ1374.2 +008900 WORKING-STORAGE SECTION. SQ1374.2 +009000* SQ1374.2 +009100*************************************************************** SQ1374.2 +009200* * SQ1374.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1374.2 +009400* * SQ1374.2 +009500*************************************************************** SQ1374.2 +009600* SQ1374.2 +009700 01 SQ-FS4-STATUS. SQ1374.2 +009800 03 SQ-FS4-KEY-1 PIC X. SQ1374.2 +009900 03 SQ-FS4-KEY-2 PIC X. SQ1374.2 +010000* SQ1374.2 +010100 01 DELETE-SW. SQ1374.2 +010200 03 DELETE-SW-1 PIC X. SQ1374.2 +010300 03 DELETE-SW-1-GROUP. SQ1374.2 +010400 05 DELETE-SW-2 PIC X. SQ1374.2 +010500* SQ1374.2 +010600 01 DECL-EXEC-I PIC X(12). SQ1374.2 +010700 01 DECL-EXEC-O PIC X(12). SQ1374.2 +010800 01 DECL-EXEC-SW PIC X. SQ1374.2 +010900* SQ1374.2 +011000*************************************************************** SQ1374.2 +011100* * SQ1374.2 +011200* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1374.2 +011300* * SQ1374.2 +011400*************************************************************** SQ1374.2 +011500* SQ1374.2 +011600 01 REC-SKEL-SUB PIC 99. SQ1374.2 +011700* SQ1374.2 +011800 01 FILE-RECORD-INFORMATION-REC. SQ1374.2 +011900 03 FILE-RECORD-INFO-SKELETON. SQ1374.2 +012000 05 FILLER PICTURE X(48) VALUE SQ1374.2 +012100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1374.2 +012200 05 FILLER PICTURE X(46) VALUE SQ1374.2 +012300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1374.2 +012400 05 FILLER PICTURE X(26) VALUE SQ1374.2 +012500 ",LFIL=000000,ORG= ,LBLR= ". SQ1374.2 +012600 05 FILLER PICTURE X(37) VALUE SQ1374.2 +012700 ",RECKEY= ". SQ1374.2 +012800 05 FILLER PICTURE X(38) VALUE SQ1374.2 +012900 ",ALTKEY1= ". SQ1374.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1374.2 +013100 ",ALTKEY2= ". SQ1374.2 +013200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1374.2 +013300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1374.2 +013400 05 FILE-RECORD-INFO-P1-120. SQ1374.2 +013500 07 FILLER PIC X(5). SQ1374.2 +013600 07 XFILE-NAME PIC X(6). SQ1374.2 +013700 07 FILLER PIC X(8). SQ1374.2 +013800 07 XRECORD-NAME PIC X(6). SQ1374.2 +013900 07 FILLER PIC X(1). SQ1374.2 +014000 07 REELUNIT-NUMBER PIC 9(1). SQ1374.2 +014100 07 FILLER PIC X(7). SQ1374.2 +014200 07 XRECORD-NUMBER PIC 9(6). SQ1374.2 +014300 07 FILLER PIC X(6). SQ1374.2 +014400 07 UPDATE-NUMBER PIC 9(2). SQ1374.2 +014500 07 FILLER PIC X(5). SQ1374.2 +014600 07 ODO-NUMBER PIC 9(4). SQ1374.2 +014700 07 FILLER PIC X(5). SQ1374.2 +014800 07 XPROGRAM-NAME PIC X(5). SQ1374.2 +014900 07 FILLER PIC X(7). SQ1374.2 +015000 07 XRECORD-LENGTH PIC 9(6). SQ1374.2 +015100 07 FILLER PIC X(7). SQ1374.2 +015200 07 CHARS-OR-RECORDS PIC X(2). SQ1374.2 +015300 07 FILLER PIC X(1). SQ1374.2 +015400 07 XBLOCK-SIZE PIC 9(4). SQ1374.2 +015500 07 FILLER PIC X(6). SQ1374.2 +015600 07 RECORDS-IN-FILE PIC 9(6). SQ1374.2 +015700 07 FILLER PIC X(5). SQ1374.2 +015800 07 XFILE-ORGANIZATION PIC X(2). SQ1374.2 +015900 07 FILLER PIC X(6). SQ1374.2 +016000 07 XLABEL-TYPE PIC X(1). SQ1374.2 +016100 05 FILE-RECORD-INFO-P121-240. SQ1374.2 +016200 07 FILLER PIC X(8). SQ1374.2 +016300 07 XRECORD-KEY PIC X(29). SQ1374.2 +016400 07 FILLER PIC X(9). SQ1374.2 +016500 07 ALTERNATE-KEY1 PIC X(29). SQ1374.2 +016600 07 FILLER PIC X(9). SQ1374.2 +016700 07 ALTERNATE-KEY2 PIC X(29). SQ1374.2 +016800 07 FILLER PIC X(7). SQ1374.2 +016900* SQ1374.2 +017000 01 TEST-RESULTS. SQ1374.2 +017100 02 FILLER PIC X VALUE SPACE. SQ1374.2 +017200 02 PAR-NAME. SQ1374.2 +017300 03 FILLER PIC X(14) VALUE SPACE. SQ1374.2 +017400 03 PARDOT-X PIC X VALUE SPACE. SQ1374.2 +017500 03 DOTVALUE PIC 99 VALUE ZERO. SQ1374.2 +017600 02 FILLER PIC X VALUE SPACE. SQ1374.2 +017700 02 FEATURE PIC X(24) VALUE SPACE. SQ1374.2 +017800 02 FILLER PIC X VALUE SPACE. SQ1374.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. SQ1374.2 +018000 02 FILLER PIC X(9) VALUE SPACE. SQ1374.2 +018100 02 RE-MARK PIC X(61). SQ1374.2 +018200 01 TEST-COMPUTED. SQ1374.2 +018300 02 FILLER PIC X(30) VALUE SPACE. SQ1374.2 +018400 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1374.2 +018500 02 COMPUTED-X. SQ1374.2 +018600 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1374.2 +018700 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1374.2 +018800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1374.2 +018900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1374.2 +019000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1374.2 +019100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1374.2 +019200 04 COMPUTED-18V0 PIC -9(18). SQ1374.2 +019300 04 FILLER PIC X. SQ1374.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SQ1374.2 +019500 01 TEST-CORRECT. SQ1374.2 +019600 02 FILLER PIC X(30) VALUE SPACE. SQ1374.2 +019700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1374.2 +019800 02 CORRECT-X. SQ1374.2 +019900 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1374.2 +020000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1374.2 +020100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1374.2 +020200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1374.2 +020300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1374.2 +020400 03 CR-18V0 REDEFINES CORRECT-A. SQ1374.2 +020500 04 CORRECT-18V0 PIC -9(18). SQ1374.2 +020600 04 FILLER PIC X. SQ1374.2 +020700 03 FILLER PIC X(2) VALUE SPACE. SQ1374.2 +020800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1374.2 +020900* SQ1374.2 +021000 01 CCVS-C-1. SQ1374.2 +021100 02 FILLER PIC IS X VALUE SPACE. SQ1374.2 +021200 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1374.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1374.2 +021400 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1374.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1374.2 +021600 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1374.2 +021700 02 FILLER PIC IS X(9) VALUE SPACE. SQ1374.2 +021800 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1374.2 +021900 01 CCVS-C-2. SQ1374.2 +022000 02 FILLER PIC X(19) VALUE SPACE. SQ1374.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". SQ1374.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1374.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". SQ1374.2 +022400 02 FILLER PIC X(72) VALUE SPACE. SQ1374.2 +022500* SQ1374.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1374.2 +022700 01 REC-CT PIC 99 VALUE ZERO. SQ1374.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1374.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1374.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1374.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1374.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1374.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1374.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1374.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1374.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1374.2 +023700 01 CCVS-H-1. SQ1374.2 +023800 02 FILLER PIC X(39) VALUE SPACES. SQ1374.2 +023900 02 FILLER PIC X(42) VALUE SQ1374.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1374.2 +024100 02 FILLER PIC X(39) VALUE SPACES. SQ1374.2 +024200 01 CCVS-H-2A. SQ1374.2 +024300 02 FILLER PIC X(40) VALUE SPACE. SQ1374.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1374.2 +024500 02 FILLER PIC XXXX VALUE SQ1374.2 +024600 "4.2 ". SQ1374.2 +024700 02 FILLER PIC X(28) VALUE SQ1374.2 +024800 " COPY - NOT FOR DISTRIBUTION". SQ1374.2 +024900 02 FILLER PIC X(41) VALUE SPACE. SQ1374.2 +025000* SQ1374.2 +025100 01 CCVS-H-2B. SQ1374.2 +025200 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1374.2 +025300 02 TEST-ID PIC X(9). SQ1374.2 +025400 02 FILLER PIC X(4) VALUE " IN ". SQ1374.2 +025500 02 FILLER PIC X(12) VALUE SQ1374.2 +025600 " HIGH ". SQ1374.2 +025700 02 FILLER PIC X(22) VALUE SQ1374.2 +025800 " LEVEL VALIDATION FOR ". SQ1374.2 +025900 02 FILLER PIC X(58) VALUE SQ1374.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1374.2 +026100 01 CCVS-H-3. SQ1374.2 +026200 02 FILLER PIC X(34) VALUE SQ1374.2 +026300 " FOR OFFICIAL USE ONLY ". SQ1374.2 +026400 02 FILLER PIC X(58) VALUE SQ1374.2 +026500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1374.2 +026600 02 FILLER PIC X(28) VALUE SQ1374.2 +026700 " COPYRIGHT 1985,1986 ". SQ1374.2 +026800 01 CCVS-E-1. SQ1374.2 +026900 02 FILLER PIC X(52) VALUE SPACE. SQ1374.2 +027000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1374.2 +027100 02 ID-AGAIN PIC X(9). SQ1374.2 +027200 02 FILLER PIC X(45) VALUE SPACES. SQ1374.2 +027300 01 CCVS-E-2. SQ1374.2 +027400 02 FILLER PIC X(31) VALUE SPACE. SQ1374.2 +027500 02 FILLER PIC X(21) VALUE SPACE. SQ1374.2 +027600 02 CCVS-E-2-2. SQ1374.2 +027700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1374.2 +027800 03 FILLER PIC X VALUE SPACE. SQ1374.2 +027900 03 ENDER-DESC PIC X(44) VALUE SQ1374.2 +028000 "ERRORS ENCOUNTERED". SQ1374.2 +028100 01 CCVS-E-3. SQ1374.2 +028200 02 FILLER PIC X(22) VALUE SQ1374.2 +028300 " FOR OFFICIAL USE ONLY". SQ1374.2 +028400 02 FILLER PIC X(12) VALUE SPACE. SQ1374.2 +028500 02 FILLER PIC X(58) VALUE SQ1374.2 +028600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1374.2 +028700 02 FILLER PIC X(8) VALUE SPACE. SQ1374.2 +028800 02 FILLER PIC X(20) VALUE SQ1374.2 +028900 " COPYRIGHT 1985,1986". SQ1374.2 +029000 01 CCVS-E-4. SQ1374.2 +029100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1374.2 +029200 02 FILLER PIC X(4) VALUE " OF ". SQ1374.2 +029300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1374.2 +029400 02 FILLER PIC X(40) VALUE SQ1374.2 +029500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1374.2 +029600 01 XXINFO. SQ1374.2 +029700 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1374.2 +029800 02 INFO-TEXT. SQ1374.2 +029900 04 FILLER PIC X(8) VALUE SPACE. SQ1374.2 +030000 04 XXCOMPUTED PIC X(20). SQ1374.2 +030100 04 FILLER PIC X(5) VALUE SPACE. SQ1374.2 +030200 04 XXCORRECT PIC X(20). SQ1374.2 +030300 02 INF-ANSI-REFERENCE PIC X(48). SQ1374.2 +030400 01 HYPHEN-LINE. SQ1374.2 +030500 02 FILLER PIC IS X VALUE IS SPACE. SQ1374.2 +030600 02 FILLER PIC IS X(65) VALUE IS "************************SQ1374.2 +030700- "*****************************************". SQ1374.2 +030800 02 FILLER PIC IS X(54) VALUE IS "************************SQ1374.2 +030900- "******************************". SQ1374.2 +031000 01 CCVS-PGM-ID PIC X(9) VALUE SQ1374.2 +031100 "SQ137A". SQ1374.2 +031200* SQ1374.2 +031300* SQ1374.2 +031400 PROCEDURE DIVISION. SQ1374.2 +031500 DECLARATIVES. SQ1374.2 +031600* SQ1374.2 +031700* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ1374.2 +031800* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ1374.2 +031900* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ1374.2 +032000* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ1374.2 +032100* SQ1374.2 +032200 SECT-SQ137A-0000 SECTION. SQ1374.2 +032300 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ1374.2 +032400 PRINT-FILE-ERROR-PROCESS. SQ1374.2 +032500 EXIT. SQ1374.2 +032600* SQ1374.2 +032700 SECT-SQ137A-0001 SECTION. SQ1374.2 +032800 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1374.2 +032900 OUTPUT-ERROR-PROCESS. SQ1374.2 +033000 MOVE "EXECUTED" TO DECL-EXEC-O. SQ1374.2 +033100* SQ1374.2 +033200 SECT-SQ137A-0002 SECTION. SQ1374.2 +033300 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1374.2 +033400 INPUT-ERROR-PROCESS. SQ1374.2 +033500 MOVE "EXECUTED" TO DECL-EXEC-I. SQ1374.2 +033600* SQ1374.2 +033700 IF DECL-EXEC-SW NOT = SPACE SQ1374.2 +033800 GO TO END-DECLS. SQ1374.2 +033900* SQ1374.2 +034000 MOVE 1 TO REC-CT. SQ1374.2 +034100 MOVE "READ AFTER EOF READ" TO FEATURE. SQ1374.2 +034200 MOVE "DECL-EOF-READ" TO PAR-NAME. SQ1374.2 +034300 GO TO DECL-EOF-READ-01. SQ1374.2 +034400 DECL-DELETE-01. SQ1374.2 +034500 PERFORM DECL-DE-LETE. SQ1374.2 +034600 GO TO DECL-TEST-01-END. SQ1374.2 +034700 DECL-EOF-READ-01. SQ1374.2 +034800 DECL-TEST-01-END. SQ1374.2 +034900* SQ1374.2 +035000 ADD 1 TO REC-CT. SQ1374.2 +035100 GO TO DECL-EOF-READ-02. SQ1374.2 +035200 DECL-DELETE-02. SQ1374.2 +035300 PERFORM DECL-DE-LETE. SQ1374.2 +035400 GO TO DECL-TEST-02-END. SQ1374.2 +035500 DECL-EOF-READ-02. SQ1374.2 +035600 DECL-TEST-02-END. SQ1374.2 +035700* SQ1374.2 +035800 MOVE SPACE TO DUMMY-RECORD. SQ1374.2 +035900 PERFORM DECL-WRITE-LINE. SQ1374.2 +036000 MOVE "ABNORMAL TERMINATION OF PROGRAM HERE IS ACCEPTABLE" SQ1374.2 +036100 TO DUMMY-RECORD. SQ1374.2 +036200 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1374.2 +036300 GO TO END-DECLS. SQ1374.2 +036400* SQ1374.2 +036500* SQ1374.2 +036600 DECL-PASS. SQ1374.2 +036700 MOVE "PASS " TO P-OR-F. SQ1374.2 +036800 ADD 1 TO PASS-COUNTER. SQ1374.2 +036900 PERFORM DECL-PRINT-DETAIL. SQ1374.2 +037000* SQ1374.2 +037100 DECL-FAIL. SQ1374.2 +037200 MOVE "FAIL*" TO P-OR-F. SQ1374.2 +037300 ADD 1 TO ERROR-COUNTER. SQ1374.2 +037400 PERFORM DECL-PRINT-DETAIL. SQ1374.2 +037500* SQ1374.2 +037600 DECL-DE-LETE. SQ1374.2 +037700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1374.2 +037800 MOVE "*****" TO P-OR-F. SQ1374.2 +037900 ADD 1 TO DELETE-COUNTER. SQ1374.2 +038000 PERFORM DECL-PRINT-DETAIL. SQ1374.2 +038100* SQ1374.2 +038200 DECL-PRINT-DETAIL. SQ1374.2 +038300 IF REC-CT NOT EQUAL TO ZERO SQ1374.2 +038400 MOVE "." TO PARDOT-X SQ1374.2 +038500 MOVE REC-CT TO DOTVALUE. SQ1374.2 +038600 MOVE TEST-RESULTS TO PRINT-REC. SQ1374.2 +038700 PERFORM DECL-WRITE-LINE. SQ1374.2 +038800 IF P-OR-F EQUAL TO "FAIL*" SQ1374.2 +038900 PERFORM DECL-WRITE-LINE SQ1374.2 +039000 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1374.2 +039100 ELSE SQ1374.2 +039200 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1374.2 +039300 MOVE SPACE TO P-OR-F. SQ1374.2 +039400 MOVE SPACE TO COMPUTED-X. SQ1374.2 +039500 MOVE SPACE TO CORRECT-X. SQ1374.2 +039600 IF REC-CT EQUAL TO ZERO SQ1374.2 +039700 MOVE SPACE TO PAR-NAME. SQ1374.2 +039800 MOVE SPACE TO RE-MARK. SQ1374.2 +039900* SQ1374.2 +040000 DECL-WRITE-LINE. SQ1374.2 +040100 ADD 1 TO RECORD-COUNT. SQ1374.2 +040200 IF RECORD-COUNT GREATER 50 SQ1374.2 +040300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1374.2 +040400 MOVE SPACE TO DUMMY-RECORD SQ1374.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1374.2 +040600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1374.2 +040700 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1374.2 +040800 PERFORM DECL-WRT-LN 2 TIMES SQ1374.2 +040900 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1374.2 +041000 PERFORM DECL-WRT-LN SQ1374.2 +041100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1374.2 +041200 MOVE ZERO TO RECORD-COUNT. SQ1374.2 +041300 PERFORM DECL-WRT-LN. SQ1374.2 +041400* SQ1374.2 +041500 DECL-WRT-LN. SQ1374.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1374.2 +041700 MOVE SPACE TO DUMMY-RECORD. SQ1374.2 +041800* SQ1374.2 +041900 DECL-FAIL-ROUTINE. SQ1374.2 +042000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1374.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1374.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1374.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1374.2 +042400 MOVE XXINFO TO DUMMY-RECORD. SQ1374.2 +042500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1374.2 +042600 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1374.2 +042700 GO TO DECL-FAIL-EX. SQ1374.2 +042800 DECL-FAIL-WRITE. SQ1374.2 +042900 MOVE TEST-COMPUTED TO PRINT-REC SQ1374.2 +043000 PERFORM DECL-WRITE-LINE SQ1374.2 +043100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1374.2 +043200 MOVE TEST-CORRECT TO PRINT-REC SQ1374.2 +043300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1374.2 +043400 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1374.2 +043500 DECL-FAIL-EX. SQ1374.2 +043600 EXIT. SQ1374.2 +043700* SQ1374.2 +043800 DECL-BAIL. SQ1374.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1374.2 +044000 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1374.2 +044100 DECL-BAIL-WRITE. SQ1374.2 +044200 MOVE CORRECT-A TO XXCORRECT. SQ1374.2 +044300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1374.2 +044400 MOVE XXINFO TO DUMMY-RECORD. SQ1374.2 +044500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1374.2 +044600 DECL-BAIL-EX. SQ1374.2 +044700 EXIT. SQ1374.2 +044800* SQ1374.2 +044900 END-DECLS. SQ1374.2 +045000 END DECLARATIVES. SQ1374.2 +045100* SQ1374.2 +045200* SQ1374.2 +045300 CCVS1 SECTION. SQ1374.2 +045400 OPEN-FILES. SQ1374.2 +045500*P OPEN I-O RAW-DATA. SQ1374.2 +045600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1374.2 +045700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1374.2 +045800*P MOVE "ABORTED " TO C-ABORT. SQ1374.2 +045900*P ADD 1 TO C-NO-OF-TESTS. SQ1374.2 +046000*P ACCEPT C-DATE FROM DATE. SQ1374.2 +046100*P ACCEPT C-TIME FROM TIME. SQ1374.2 +046200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1374.2 +046300*PND-E-1. SQ1374.2 +046400*P CLOSE RAW-DATA. SQ1374.2 +046500 OPEN OUTPUT PRINT-FILE. SQ1374.2 +046600 MOVE CCVS-PGM-ID TO TEST-ID. SQ1374.2 +046700 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1374.2 +046800 MOVE SPACE TO TEST-RESULTS. SQ1374.2 +046900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1374.2 +047000 MOVE ZERO TO REC-SKEL-SUB. SQ1374.2 +047100 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1374.2 +047200 GO TO CCVS1-EXIT. SQ1374.2 +047300* SQ1374.2 +047400 CCVS-INIT-FILE. SQ1374.2 +047500 ADD 1 TO REC-SKL-SUB. SQ1374.2 +047600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1374.2 +047700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1374.2 +047800* SQ1374.2 +047900 CLOSE-FILES. SQ1374.2 +048000 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1374.2 +048100 CLOSE PRINT-FILE. SQ1374.2 +048200*P OPEN I-O RAW-DATA. SQ1374.2 +048300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1374.2 +048400*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1374.2 +048500*P MOVE "OK. " TO C-ABORT. SQ1374.2 +048600*P MOVE PASS-COUNTER TO C-OK. SQ1374.2 +048700*P MOVE ERROR-HOLD TO C-ALL. SQ1374.2 +048800*P MOVE ERROR-COUNTER TO C-FAIL. SQ1374.2 +048900*P MOVE DELETE-CNT TO C-DELETED. SQ1374.2 +049000*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1374.2 +049100*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1374.2 +049200*PND-E-2. SQ1374.2 +049300*P CLOSE RAW-DATA. SQ1374.2 +049400 TERMINATE-CCVS. SQ1374.2 +049500*S EXIT PROGRAM. SQ1374.2 +049600 STOP RUN. SQ1374.2 +049700* SQ1374.2 +049800 INSPT. SQ1374.2 +049900 MOVE "INSPT" TO P-OR-F. SQ1374.2 +050000 ADD 1 TO INSPECT-COUNTER. SQ1374.2 +050100 PERFORM PRINT-DETAIL. SQ1374.2 +050200* SQ1374.2 +050300 PASS. SQ1374.2 +050400 MOVE "PASS " TO P-OR-F. SQ1374.2 +050500 ADD 1 TO PASS-COUNTER. SQ1374.2 +050600 PERFORM PRINT-DETAIL. SQ1374.2 +050700* SQ1374.2 +050800 FAIL. SQ1374.2 +050900 MOVE "FAIL*" TO P-OR-F. SQ1374.2 +051000 ADD 1 TO ERROR-COUNTER. SQ1374.2 +051100 PERFORM PRINT-DETAIL. SQ1374.2 +051200* SQ1374.2 +051300 DE-LETE. SQ1374.2 +051400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1374.2 +051500 MOVE "*****" TO P-OR-F. SQ1374.2 +051600 ADD 1 TO DELETE-COUNTER. SQ1374.2 +051700 PERFORM PRINT-DETAIL. SQ1374.2 +051800* SQ1374.2 +051900 PRINT-DETAIL. SQ1374.2 +052000 IF REC-CT NOT EQUAL TO ZERO SQ1374.2 +052100 MOVE "." TO PARDOT-X SQ1374.2 +052200 MOVE REC-CT TO DOTVALUE. SQ1374.2 +052300 MOVE TEST-RESULTS TO PRINT-REC. SQ1374.2 +052400 PERFORM WRITE-LINE. SQ1374.2 +052500 IF P-OR-F EQUAL TO "FAIL*" SQ1374.2 +052600 PERFORM WRITE-LINE SQ1374.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1374.2 +052800 ELSE SQ1374.2 +052900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1374.2 +053000 MOVE SPACE TO P-OR-F. SQ1374.2 +053100 MOVE SPACE TO COMPUTED-X. SQ1374.2 +053200 MOVE SPACE TO CORRECT-X. SQ1374.2 +053300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1374.2 +053400 MOVE SPACE TO RE-MARK. SQ1374.2 +053500* SQ1374.2 +053600 HEAD-ROUTINE. SQ1374.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1374.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1374.2 +054100 COLUMN-NAMES-ROUTINE. SQ1374.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1374.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1374.2 +054500 END-ROUTINE. SQ1374.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1374.2 +054700 PERFORM WRITE-LINE 5 TIMES. SQ1374.2 +054800 END-RTN-EXIT. SQ1374.2 +054900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1374.2 +055000 PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +055100* SQ1374.2 +055200 END-ROUTINE-1. SQ1374.2 +055300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1374.2 +055400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1374.2 +055500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1374.2 +055600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1374.2 +055700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1374.2 +055800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1374.2 +055900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1374.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1374.2 +056100 PERFORM WRITE-LINE. SQ1374.2 +056200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1374.2 +056300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1374.2 +056400 MOVE "NO " TO ERROR-TOTAL SQ1374.2 +056500 ELSE SQ1374.2 +056600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1374.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1374.2 +056800 PERFORM WRITE-LINE. SQ1374.2 +056900 END-ROUTINE-13. SQ1374.2 +057000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1374.2 +057100 MOVE "NO " TO ERROR-TOTAL SQ1374.2 +057200 ELSE SQ1374.2 +057300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1374.2 +057400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1374.2 +057500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1374.2 +057600 PERFORM WRITE-LINE. SQ1374.2 +057700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1374.2 +057800 MOVE "NO " TO ERROR-TOTAL SQ1374.2 +057900 ELSE SQ1374.2 +058000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1374.2 +058100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1374.2 +058200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1374.2 +058300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1374.2 +058400* SQ1374.2 +058500 WRITE-LINE. SQ1374.2 +058600 ADD 1 TO RECORD-COUNT. SQ1374.2 +058700 IF RECORD-COUNT GREATER 50 SQ1374.2 +058800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1374.2 +058900 MOVE SPACE TO DUMMY-RECORD SQ1374.2 +059000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1374.2 +059100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1374.2 +059200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1374.2 +059300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1374.2 +059400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1374.2 +059500 MOVE ZERO TO RECORD-COUNT. SQ1374.2 +059600 PERFORM WRT-LN. SQ1374.2 +059700* SQ1374.2 +059800 WRT-LN. SQ1374.2 +059900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1374.2 +060000 MOVE SPACE TO DUMMY-RECORD. SQ1374.2 +060100 BLANK-LINE-PRINT. SQ1374.2 +060200 PERFORM WRT-LN. SQ1374.2 +060300 FAIL-ROUTINE. SQ1374.2 +060400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1374.2 +060500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1374.2 +060600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1374.2 +060700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1374.2 +060800 MOVE XXINFO TO DUMMY-RECORD. SQ1374.2 +060900 PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +061000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1374.2 +061100 GO TO FAIL-ROUTINE-EX. SQ1374.2 +061200 FAIL-ROUTINE-WRITE. SQ1374.2 +061300 MOVE TEST-COMPUTED TO PRINT-REC SQ1374.2 +061400 PERFORM WRITE-LINE SQ1374.2 +061500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1374.2 +061600 MOVE TEST-CORRECT TO PRINT-REC SQ1374.2 +061700 PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +061800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1374.2 +061900 FAIL-ROUTINE-EX. SQ1374.2 +062000 EXIT. SQ1374.2 +062100 BAIL-OUT. SQ1374.2 +062200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1374.2 +062300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1374.2 +062400 BAIL-OUT-WRITE. SQ1374.2 +062500 MOVE CORRECT-A TO XXCORRECT. SQ1374.2 +062600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1374.2 +062700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1374.2 +062800 MOVE XXINFO TO DUMMY-RECORD. SQ1374.2 +062900 PERFORM WRITE-LINE 2 TIMES. SQ1374.2 +063000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1374.2 +063100 BAIL-OUT-EX. SQ1374.2 +063200 EXIT. SQ1374.2 +063300 CCVS1-EXIT. SQ1374.2 +063400 EXIT. SQ1374.2 +063500* SQ1374.2 +063600**************************************************************** SQ1374.2 +063700* * SQ1374.2 +063800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1374.2 +063900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1374.2 +064000* * SQ1374.2 +064100**************************************************************** SQ1374.2 +064200* SQ1374.2 +064300 SECT-SQ137A-0004 SECTION. SQ1374.2 +064400 STA-INIT. SQ1374.2 +064500 MOVE SPACE TO DELETE-SW. SQ1374.2 +064600* SQ1374.2 +064700 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1374.2 +064800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1374.2 +064900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1374.2 +065000 MOVE 125 TO XRECORD-LENGTH (1). SQ1374.2 +065100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1374.2 +065200 MOVE 2 TO XBLOCK-SIZE (1). SQ1374.2 +065300 MOVE 1 TO RECORDS-IN-FILE (1). SQ1374.2 +065400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1374.2 +065500 MOVE "S" TO XLABEL-TYPE (1). SQ1374.2 +065600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1374.2 +065700* SQ1374.2 +065800* OPEN THE FILE IN THE OUTPUT MODE SQ1374.2 +065900* SQ1374.2 +066000 SEQ-INIT-01. SQ1374.2 +066100 MOVE 0 TO REC-CT. SQ1374.2 +066200 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +066300 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +066400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +066500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +066600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1374.2 +066700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1374.2 +066800 GO TO SEQ-TEST-OP-01. SQ1374.2 +066900 SEQ-DELETE-01. SQ1374.2 +067000 MOVE "*" TO DELETE-SW-1. SQ1374.2 +067100 SEQ-TEST-OP-01. SQ1374.2 +067200 OPEN OUTPUT SQ-FS4. SQ1374.2 +067300* SQ1374.2 +067400* SQ1374.2 +067500* THE FILE HAS BEEN CREATED. WE NOW WRITE ONE RECORD TO IT. SQ1374.2 +067600* SQ1374.2 +067700 SEQ-INIT-02. SQ1374.2 +067800 MOVE 0 TO REC-CT. SQ1374.2 +067900 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +068000 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +068100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +068200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +068300 ADD 1 TO XRECORD-NUMBER (1). SQ1374.2 +068400 MOVE "WRITE ONE RECORD" TO FEATURE. SQ1374.2 +068500 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1374.2 +068600 IF DELETE-SW NOT EQUAL TO SPACE SQ1374.2 +068700 GO TO SEQ-DELETE-02. SQ1374.2 +068800 GO TO SEQ-TEST-WR-02. SQ1374.2 +068900 SEQ-DELETE-02. SQ1374.2 +069000 MOVE "*" TO DELETE-SW-2. SQ1374.2 +069100 SEQ-TEST-WR-02. SQ1374.2 +069200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1374.2 +069300 MOVE XRECORD-NUMBER (1) TO SQ-FS4-REC-NO. SQ1374.2 +069400 WRITE SQ-FS4R1-F-G-125. SQ1374.2 +069500* SQ1374.2 +069600* SQ1374.2 +069700* HAVING WRITTEN ONE RECORD, CLOSE THE FILE. SQ1374.2 +069800* SQ1374.2 +069900 SEQ-INIT-03. SQ1374.2 +070000 MOVE 0 TO REC-CT. SQ1374.2 +070100 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +070200 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +070300 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +070400 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +070500 MOVE "CLOSE AFTER CREATE" TO FEATURE. SQ1374.2 +070600 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1374.2 +070700 IF DELETE-SW NOT EQUAL TO SPACE SQ1374.2 +070800 GO TO SEQ-DELETE-03. SQ1374.2 +070900 GO TO SEQ-TEST-CL-03. SQ1374.2 +071000 SEQ-DELETE-03. SQ1374.2 +071100 MOVE "*" TO DELETE-SW-2. SQ1374.2 +071200 SEQ-TEST-CL-03. SQ1374.2 +071300 CLOSE SQ-FS4. SQ1374.2 +071400* SQ1374.2 +071500* SQ1374.2 +071600* CREATION OF THE FILE IS NOW COMPLETE. THE NEXT ACTION SQ1374.2 +071700* IS TO OPEN THE FILE IN THE OUTPUT MODE SQ1374.2 +071800* SQ1374.2 +071900 SEQ-INIT-04. SQ1374.2 +072000 MOVE 0 TO REC-CT. SQ1374.2 +072100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1374.2 +072200 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +072300 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +072400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +072500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +072600 MOVE "OPEN, TO READ FILE" TO FEATURE. SQ1374.2 +072700 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1374.2 +072800 IF DELETE-SW NOT = SPACE SQ1374.2 +072900 GO TO SEQ-DELETE-04. SQ1374.2 +073000 GO TO SEQ-TEST-OP-04. SQ1374.2 +073100 SEQ-DELETE-04. SQ1374.2 +073200 MOVE "*" TO DELETE-SW-2. SQ1374.2 +073300 SEQ-TEST-OP-04. SQ1374.2 +073400* SQ1374.2 +073500* OPEN THE TEST FILE AND CLEAR THE RECORD AREA, JUST IN SQ1374.2 +073600* CASE THERE IS A SINGLE BUFFER WHICH STILL HAS A COPY OF SQ1374.2 +073700* THE LAST RECORD WRITTEN IN IT. SQ1374.2 +073800* SQ1374.2 +073900 OPEN INPUT SQ-FS4. SQ1374.2 +074000 MOVE SPACE TO SQ-FS4R1-F-G-125. SQ1374.2 +074100* SQ1374.2 +074200* SQ1374.2 +074300* READ THE FIRST (AND ONLY) RECORD FROM THE FILE SQ1374.2 +074400* SQ1374.2 +074500 SEQ-INIT-05. SQ1374.2 +074600 MOVE 0 TO REC-CT. SQ1374.2 +074700 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +074800 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +074900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +075000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +075100 MOVE "READ FIRST RECORD" TO FEATURE. SQ1374.2 +075200 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1374.2 +075300 IF DELETE-SW NOT = SPACE SQ1374.2 +075400 GO TO SEQ-DELETE-05. SQ1374.2 +075500 GO TO SEQ-TEST-RD-05. SQ1374.2 +075600 SEQ-DELETE-05. SQ1374.2 +075700 MOVE "*" TO DELETE-SW-2. SQ1374.2 +075800 SEQ-TEST-RD-05. SQ1374.2 +075900 READ SQ-FS4. SQ1374.2 +076000 MOVE SQ-FS4R1-F-G-125 TO FILE-RECORD-INFO (2). SQ1374.2 +076100* SQ1374.2 +076200* SQ1374.2 +076300* READ AGAIN, TO RAISE THE AT END CONDITION SQ1374.2 +076400* SQ1374.2 +076500 SEQ-INIT-06. SQ1374.2 +076600 MOVE 0 TO REC-CT. SQ1374.2 +076700 MOVE "*" TO DECL-EXEC-SW. SQ1374.2 +076800 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +076900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +077000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +077100 MOVE "READ, GIVING AT END" TO FEATURE. SQ1374.2 +077200 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1374.2 +077300 IF DELETE-SW NOT = SPACE SQ1374.2 +077400 GO TO SEQ-DELETE-06. SQ1374.2 +077500 GO TO SEQ-TEST-RD-06. SQ1374.2 +077600 SEQ-DELETE-06. SQ1374.2 +077700 MOVE "*" TO DELETE-SW-2. SQ1374.2 +077800 SEQ-TEST-RD-06. SQ1374.2 +077900 READ SQ-FS4. SQ1374.2 +078000* SQ1374.2 +078100* SQ1374.2 +078200* READ AGAIN, AFTER AT END, TO RAISE I-O STATUS 46 SQ1374.2 +078300* SQ1374.2 +078400 SEQ-INIT-07. SQ1374.2 +078500 MOVE 0 TO REC-CT. SQ1374.2 +078600 MOVE SPACE TO DECL-EXEC-SW. SQ1374.2 +078700 MOVE "**" TO SQ-FS4-STATUS. SQ1374.2 +078800 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1374.2 +078900 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1374.2 +079000 MOVE "READ AFTER AT END" TO FEATURE. SQ1374.2 +079100 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1374.2 +079200 IF DELETE-SW NOT = SPACE SQ1374.2 +079300 GO TO SEQ-DELETE-07. SQ1374.2 +079400 GO TO SEQ-TEST-RD-07. SQ1374.2 +079500 SEQ-DELETE-07. SQ1374.2 +079600 MOVE "*" TO DELETE-SW-2. SQ1374.2 +079700 SEQ-TEST-RD-07. SQ1374.2 +079800 READ SQ-FS4. SQ1374.2 +079900* SQ1374.2 +080000* THE TESTS FOLLOWING THIS READ STATEMENT MAY NOT BE SQ1374.2 +080100* EXECUTED. THE IMPLEMENTOR MAY LEGITIMATELY TERMINATE SQ1374.2 +080200* EXECUTION ON EXIT FROM THE DECLARATIVE. SQ1374.2 +080300* SQ1374.2 +080400 MOVE ZERO TO REC-CT. SQ1374.2 +080500 MOVE "READ AFTER AT END" TO FEATURE. SQ1374.2 +080600 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1374.2 +080700* SQ1374.2 +080800* CHECK I-O STATUS RETURNED FROM READ AFTER AT END SQ1374.2 +080900* SQ1374.2 +081000 ADD 1 TO REC-CT. SQ1374.2 +081100 SEQ-TEST-07-01-END. SQ1374.2 +081200* SQ1374.2 +081300* CHECK EXECUTION OF INPUT DECLARATIVE SQ1374.2 +081400* SQ1374.2 +081500 ADD 1 TO REC-CT. SQ1374.2 +081600 IF DELETE-SW NOT = SPACE SQ1374.2 +081700 GO TO SEQ-DELETE-07-02. SQ1374.2 +081800 GO TO SEQ-TEST-RD-07-02. SQ1374.2 +081900 SEQ-DELETE-07-02. SQ1374.2 +082000 PERFORM DE-LETE. SQ1374.2 +082100 GO TO SEQ-TEST-07-02-END. SQ1374.2 +082200 SEQ-TEST-RD-07-02. SQ1374.2 +082300 IF DECL-EXEC-I = "EXECUTED" SQ1374.2 +082400 PERFORM PASS SQ1374.2 +082500 ELSE SQ1374.2 +082600 MOVE DECL-EXEC-I TO COMPUTED-A SQ1374.2 +082700 MOVE "EXECUTED" TO CORRECT-A SQ1374.2 +082800 MOVE "INPUT DECLARATIVE NOT EXECUTED" SQ1374.2 +082900 TO RE-MARK SQ1374.2 +083000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1374.2 +083100 PERFORM FAIL. SQ1374.2 +083200 SEQ-TEST-07-02-END. SQ1374.2 +083300 CCVS-EXIT SECTION. SQ1374.2 +083400 CCVS-999999. SQ1374.2 +083500 GO TO CLOSE-FILES. SQ1374.2 diff --git a/tests/cobol85/SQ/SQ138A.CBL b/tests/cobol85/SQ/SQ138A.CBL new file mode 100755 index 00000000..899b77ed --- /dev/null +++ b/tests/cobol85/SQ/SQ138A.CBL @@ -0,0 +1,831 @@ +000100 IDENTIFICATION DIVISION. SQ1384.2 +000200 PROGRAM-ID. SQ1384.2 +000300 SQ138A. SQ1384.2 +000400**************************************************************** SQ1384.2 +000500* * SQ1384.2 +000600* VALIDATION FOR:- * SQ1384.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1384.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1384.2 +000900* REVISED 1986, AUGUST * SQ1384.2 +001000* * SQ1384.2 +001100* CREATION DATE / VALIDATION DATE * SQ1384.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1384.2 +001300* * SQ1384.2 +001400**************************************************************** SQ1384.2 +001500* * SQ1384.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1384.2 +001700* * SQ1384.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1384.2 +001900* X-55 SYSTEM PRINTER * SQ1384.2 +002000* X-82 SOURCE-COMPUTER * SQ1384.2 +002100* X-83 OBJECT-COMPUTER. * SQ1384.2 +002200* * SQ1384.2 +002300**************************************************************** SQ1384.2 +002400* * SQ1384.2 +002500* SPLIT FROM SQ122A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1384.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1384.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO READING* SQ1384.2 +002800* PAST THE END OF A FILE. (SEE SQ122A). * SQ1384.2 +002900* * SQ1384.2 +003000**************************************************************** SQ1384.2 +003100* SQ1384.2 +003200 ENVIRONMENT DIVISION. SQ1384.2 +003300 CONFIGURATION SECTION. SQ1384.2 +003400 SOURCE-COMPUTER. SQ1384.2 +003500 Linux. SQ1384.2 +003600 OBJECT-COMPUTER. SQ1384.2 +003700 Linux. SQ1384.2 +003800* SQ1384.2 +003900 INPUT-OUTPUT SECTION. SQ1384.2 +004000 FILE-CONTROL. SQ1384.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1384.2 +004200 "report.log". SQ1384.2 +004300* SQ1384.2 +004400*P SELECT RAW-DATA ASSIGN TO SQ1384.2 +004500*P "XXXXX062" SQ1384.2 +004600*P ORGANIZATION IS INDEXED SQ1384.2 +004700*P ACCESS MODE IS RANDOM SQ1384.2 +004800*P RECORD-KEY IS RAW-DATA-KEY. SQ1384.2 +004900*P SQ1384.2 +005000 SELECT SQ-FS4 ASSIGN SQ1384.2 +005100 "XXXXX014" SQ1384.2 +005200 FILE STATUS IS SQ-FS4-STATUS. SQ1384.2 +005300* SQ1384.2 +005400* SQ1384.2 +005500 DATA DIVISION. SQ1384.2 +005600 FILE SECTION. SQ1384.2 +005700 FD PRINT-FILE SQ1384.2 +005800*C LABEL RECORDS SQ1384.2 +005900*C OMITTED SQ1384.2 +006000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1384.2 +006100 . SQ1384.2 +006200 01 PRINT-REC PICTURE X(120). SQ1384.2 +006300 01 DUMMY-RECORD PICTURE X(120). SQ1384.2 +006400*P SQ1384.2 +006500*PD RAW-DATA. SQ1384.2 +006600*P1 RAW-DATA-SATZ. SQ1384.2 +006700*P 05 RAW-DATA-KEY PIC X(6). SQ1384.2 +006800*P 05 C-DATE PIC 9(6). SQ1384.2 +006900*P 05 C-TIME PIC 9(8). SQ1384.2 +007000*P 05 NO-OF-TESTS PIC 99. SQ1384.2 +007100*P 05 C-OK PIC 999. SQ1384.2 +007200*P 05 C-ALL PIC 999. SQ1384.2 +007300*P 05 C-FAIL PIC 999. SQ1384.2 +007400*P 05 C-DELETED PIC 999. SQ1384.2 +007500*P 05 C-INSPECT PIC 999. SQ1384.2 +007600*P 05 C-NOTE PIC X(13). SQ1384.2 +007700*P 05 C-INDENT PIC X. SQ1384.2 +007800*P 05 C-ABORT PIC X(8). SQ1384.2 +007900* SQ1384.2 +008000 FD SQ-FS4 SQ1384.2 +008100*C LABEL RECORD IS STANDARD SQ1384.2 +008200 BLOCK 2 RECORDS SQ1384.2 +008300 RECORD 125 SQ1384.2 +008400 . SQ1384.2 +008500 01 SQ-FS4R1-F-G-125. SQ1384.2 +008600 05 SQ-FS4-FIRST PIC X(120). SQ1384.2 +008700 05 SQ-FS4-REC-NO PIC 99999. SQ1384.2 +008800* SQ1384.2 +008900 WORKING-STORAGE SECTION. SQ1384.2 +009000* SQ1384.2 +009100*************************************************************** SQ1384.2 +009200* * SQ1384.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1384.2 +009400* * SQ1384.2 +009500*************************************************************** SQ1384.2 +009600* SQ1384.2 +009700 01 SQ-FS4-STATUS. SQ1384.2 +009800 03 SQ-FS4-KEY-1 PIC X. SQ1384.2 +009900 03 SQ-FS4-KEY-2 PIC X. SQ1384.2 +010000* SQ1384.2 +010100 01 DELETE-SW. SQ1384.2 +010200 03 DELETE-SW-1 PIC X. SQ1384.2 +010300 03 DELETE-SW-1-GROUP. SQ1384.2 +010400 05 DELETE-SW-2 PIC X. SQ1384.2 +010500* SQ1384.2 +010600 01 DECL-EXEC-I PIC X(12). SQ1384.2 +010700 01 DECL-EXEC-O PIC X(12). SQ1384.2 +010800 01 DECL-EXEC-SW PIC X. SQ1384.2 +010900* SQ1384.2 +011000*************************************************************** SQ1384.2 +011100* * SQ1384.2 +011200* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1384.2 +011300* * SQ1384.2 +011400*************************************************************** SQ1384.2 +011500* SQ1384.2 +011600 01 REC-SKEL-SUB PIC 99. SQ1384.2 +011700* SQ1384.2 +011800 01 FILE-RECORD-INFORMATION-REC. SQ1384.2 +011900 03 FILE-RECORD-INFO-SKELETON. SQ1384.2 +012000 05 FILLER PICTURE X(48) VALUE SQ1384.2 +012100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1384.2 +012200 05 FILLER PICTURE X(46) VALUE SQ1384.2 +012300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1384.2 +012400 05 FILLER PICTURE X(26) VALUE SQ1384.2 +012500 ",LFIL=000000,ORG= ,LBLR= ". SQ1384.2 +012600 05 FILLER PICTURE X(37) VALUE SQ1384.2 +012700 ",RECKEY= ". SQ1384.2 +012800 05 FILLER PICTURE X(38) VALUE SQ1384.2 +012900 ",ALTKEY1= ". SQ1384.2 +013000 05 FILLER PICTURE X(38) VALUE SQ1384.2 +013100 ",ALTKEY2= ". SQ1384.2 +013200 05 FILLER PICTURE X(7) VALUE SPACE.SQ1384.2 +013300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1384.2 +013400 05 FILE-RECORD-INFO-P1-120. SQ1384.2 +013500 07 FILLER PIC X(5). SQ1384.2 +013600 07 XFILE-NAME PIC X(6). SQ1384.2 +013700 07 FILLER PIC X(8). SQ1384.2 +013800 07 XRECORD-NAME PIC X(6). SQ1384.2 +013900 07 FILLER PIC X(1). SQ1384.2 +014000 07 REELUNIT-NUMBER PIC 9(1). SQ1384.2 +014100 07 FILLER PIC X(7). SQ1384.2 +014200 07 XRECORD-NUMBER PIC 9(6). SQ1384.2 +014300 07 FILLER PIC X(6). SQ1384.2 +014400 07 UPDATE-NUMBER PIC 9(2). SQ1384.2 +014500 07 FILLER PIC X(5). SQ1384.2 +014600 07 ODO-NUMBER PIC 9(4). SQ1384.2 +014700 07 FILLER PIC X(5). SQ1384.2 +014800 07 XPROGRAM-NAME PIC X(5). SQ1384.2 +014900 07 FILLER PIC X(7). SQ1384.2 +015000 07 XRECORD-LENGTH PIC 9(6). SQ1384.2 +015100 07 FILLER PIC X(7). SQ1384.2 +015200 07 CHARS-OR-RECORDS PIC X(2). SQ1384.2 +015300 07 FILLER PIC X(1). SQ1384.2 +015400 07 XBLOCK-SIZE PIC 9(4). SQ1384.2 +015500 07 FILLER PIC X(6). SQ1384.2 +015600 07 RECORDS-IN-FILE PIC 9(6). SQ1384.2 +015700 07 FILLER PIC X(5). SQ1384.2 +015800 07 XFILE-ORGANIZATION PIC X(2). SQ1384.2 +015900 07 FILLER PIC X(6). SQ1384.2 +016000 07 XLABEL-TYPE PIC X(1). SQ1384.2 +016100 05 FILE-RECORD-INFO-P121-240. SQ1384.2 +016200 07 FILLER PIC X(8). SQ1384.2 +016300 07 XRECORD-KEY PIC X(29). SQ1384.2 +016400 07 FILLER PIC X(9). SQ1384.2 +016500 07 ALTERNATE-KEY1 PIC X(29). SQ1384.2 +016600 07 FILLER PIC X(9). SQ1384.2 +016700 07 ALTERNATE-KEY2 PIC X(29). SQ1384.2 +016800 07 FILLER PIC X(7). SQ1384.2 +016900* SQ1384.2 +017000 01 TEST-RESULTS. SQ1384.2 +017100 02 FILLER PIC X VALUE SPACE. SQ1384.2 +017200 02 PAR-NAME. SQ1384.2 +017300 03 FILLER PIC X(14) VALUE SPACE. SQ1384.2 +017400 03 PARDOT-X PIC X VALUE SPACE. SQ1384.2 +017500 03 DOTVALUE PIC 99 VALUE ZERO. SQ1384.2 +017600 02 FILLER PIC X VALUE SPACE. SQ1384.2 +017700 02 FEATURE PIC X(24) VALUE SPACE. SQ1384.2 +017800 02 FILLER PIC X VALUE SPACE. SQ1384.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. SQ1384.2 +018000 02 FILLER PIC X(9) VALUE SPACE. SQ1384.2 +018100 02 RE-MARK PIC X(61). SQ1384.2 +018200 01 TEST-COMPUTED. SQ1384.2 +018300 02 FILLER PIC X(30) VALUE SPACE. SQ1384.2 +018400 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1384.2 +018500 02 COMPUTED-X. SQ1384.2 +018600 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1384.2 +018700 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1384.2 +018800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1384.2 +018900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1384.2 +019000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1384.2 +019100 03 CM-18V0 REDEFINES COMPUTED-A. SQ1384.2 +019200 04 COMPUTED-18V0 PIC -9(18). SQ1384.2 +019300 04 FILLER PIC X. SQ1384.2 +019400 03 FILLER PIC X(50) VALUE SPACE. SQ1384.2 +019500 01 TEST-CORRECT. SQ1384.2 +019600 02 FILLER PIC X(30) VALUE SPACE. SQ1384.2 +019700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1384.2 +019800 02 CORRECT-X. SQ1384.2 +019900 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1384.2 +020000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1384.2 +020100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1384.2 +020200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1384.2 +020300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1384.2 +020400 03 CR-18V0 REDEFINES CORRECT-A. SQ1384.2 +020500 04 CORRECT-18V0 PIC -9(18). SQ1384.2 +020600 04 FILLER PIC X. SQ1384.2 +020700 03 FILLER PIC X(2) VALUE SPACE. SQ1384.2 +020800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1384.2 +020900* SQ1384.2 +021000 01 CCVS-C-1. SQ1384.2 +021100 02 FILLER PIC IS X VALUE SPACE. SQ1384.2 +021200 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1384.2 +021300 02 FILLER PIC IS X VALUE SPACE. SQ1384.2 +021400 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1384.2 +021500 02 FILLER PIC IS X VALUE SPACE. SQ1384.2 +021600 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1384.2 +021700 02 FILLER PIC IS X(9) VALUE SPACE. SQ1384.2 +021800 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1384.2 +021900 01 CCVS-C-2. SQ1384.2 +022000 02 FILLER PIC X(19) VALUE SPACE. SQ1384.2 +022100 02 FILLER PIC X(6) VALUE "TESTED". SQ1384.2 +022200 02 FILLER PIC X(19) VALUE SPACE. SQ1384.2 +022300 02 FILLER PIC X(4) VALUE "FAIL". SQ1384.2 +022400 02 FILLER PIC X(72) VALUE SPACE. SQ1384.2 +022500* SQ1384.2 +022600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1384.2 +022700 01 REC-CT PIC 99 VALUE ZERO. SQ1384.2 +022800 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1384.2 +022900 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1384.2 +023000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1384.2 +023100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1384.2 +023200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1384.2 +023300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1384.2 +023400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1384.2 +023500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1384.2 +023600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1384.2 +023700 01 CCVS-H-1. SQ1384.2 +023800 02 FILLER PIC X(39) VALUE SPACES. SQ1384.2 +023900 02 FILLER PIC X(42) VALUE SQ1384.2 +024000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1384.2 +024100 02 FILLER PIC X(39) VALUE SPACES. SQ1384.2 +024200 01 CCVS-H-2A. SQ1384.2 +024300 02 FILLER PIC X(40) VALUE SPACE. SQ1384.2 +024400 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1384.2 +024500 02 FILLER PIC XXXX VALUE SQ1384.2 +024600 "4.2 ". SQ1384.2 +024700 02 FILLER PIC X(28) VALUE SQ1384.2 +024800 " COPY - NOT FOR DISTRIBUTION". SQ1384.2 +024900 02 FILLER PIC X(41) VALUE SPACE. SQ1384.2 +025000* SQ1384.2 +025100 01 CCVS-H-2B. SQ1384.2 +025200 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1384.2 +025300 02 TEST-ID PIC X(9). SQ1384.2 +025400 02 FILLER PIC X(4) VALUE " IN ". SQ1384.2 +025500 02 FILLER PIC X(12) VALUE SQ1384.2 +025600 " HIGH ". SQ1384.2 +025700 02 FILLER PIC X(22) VALUE SQ1384.2 +025800 " LEVEL VALIDATION FOR ". SQ1384.2 +025900 02 FILLER PIC X(58) VALUE SQ1384.2 +026000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1384.2 +026100 01 CCVS-H-3. SQ1384.2 +026200 02 FILLER PIC X(34) VALUE SQ1384.2 +026300 " FOR OFFICIAL USE ONLY ". SQ1384.2 +026400 02 FILLER PIC X(58) VALUE SQ1384.2 +026500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1384.2 +026600 02 FILLER PIC X(28) VALUE SQ1384.2 +026700 " COPYRIGHT 1985,1986 ". SQ1384.2 +026800 01 CCVS-E-1. SQ1384.2 +026900 02 FILLER PIC X(52) VALUE SPACE. SQ1384.2 +027000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1384.2 +027100 02 ID-AGAIN PIC X(9). SQ1384.2 +027200 02 FILLER PIC X(45) VALUE SPACES. SQ1384.2 +027300 01 CCVS-E-2. SQ1384.2 +027400 02 FILLER PIC X(31) VALUE SPACE. SQ1384.2 +027500 02 FILLER PIC X(21) VALUE SPACE. SQ1384.2 +027600 02 CCVS-E-2-2. SQ1384.2 +027700 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1384.2 +027800 03 FILLER PIC X VALUE SPACE. SQ1384.2 +027900 03 ENDER-DESC PIC X(44) VALUE SQ1384.2 +028000 "ERRORS ENCOUNTERED". SQ1384.2 +028100 01 CCVS-E-3. SQ1384.2 +028200 02 FILLER PIC X(22) VALUE SQ1384.2 +028300 " FOR OFFICIAL USE ONLY". SQ1384.2 +028400 02 FILLER PIC X(12) VALUE SPACE. SQ1384.2 +028500 02 FILLER PIC X(58) VALUE SQ1384.2 +028600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1384.2 +028700 02 FILLER PIC X(8) VALUE SPACE. SQ1384.2 +028800 02 FILLER PIC X(20) VALUE SQ1384.2 +028900 " COPYRIGHT 1985,1986". SQ1384.2 +029000 01 CCVS-E-4. SQ1384.2 +029100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1384.2 +029200 02 FILLER PIC X(4) VALUE " OF ". SQ1384.2 +029300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1384.2 +029400 02 FILLER PIC X(40) VALUE SQ1384.2 +029500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1384.2 +029600 01 XXINFO. SQ1384.2 +029700 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1384.2 +029800 02 INFO-TEXT. SQ1384.2 +029900 04 FILLER PIC X(8) VALUE SPACE. SQ1384.2 +030000 04 XXCOMPUTED PIC X(20). SQ1384.2 +030100 04 FILLER PIC X(5) VALUE SPACE. SQ1384.2 +030200 04 XXCORRECT PIC X(20). SQ1384.2 +030300 02 INF-ANSI-REFERENCE PIC X(48). SQ1384.2 +030400 01 HYPHEN-LINE. SQ1384.2 +030500 02 FILLER PIC IS X VALUE IS SPACE. SQ1384.2 +030600 02 FILLER PIC IS X(65) VALUE IS "************************SQ1384.2 +030700- "*****************************************". SQ1384.2 +030800 02 FILLER PIC IS X(54) VALUE IS "************************SQ1384.2 +030900- "******************************". SQ1384.2 +031000 01 CCVS-PGM-ID PIC X(9) VALUE SQ1384.2 +031100 "SQ138A". SQ1384.2 +031200* SQ1384.2 +031300* SQ1384.2 +031400 PROCEDURE DIVISION. SQ1384.2 +031500 DECLARATIVES. SQ1384.2 +031600* SQ1384.2 +031700* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ1384.2 +031800* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ1384.2 +031900* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ1384.2 +032000* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ1384.2 +032100* SQ1384.2 +032200 SECT-SQ138A-0000 SECTION. SQ1384.2 +032300 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ1384.2 +032400 PRINT-FILE-ERROR-PROCESS. SQ1384.2 +032500 EXIT. SQ1384.2 +032600* SQ1384.2 +032700 SECT-SQ138A-0001 SECTION. SQ1384.2 +032800 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1384.2 +032900 OUTPUT-ERROR-PROCESS. SQ1384.2 +033000 MOVE "EXECUTED" TO DECL-EXEC-O. SQ1384.2 +033100* SQ1384.2 +033200 SECT-SQ138A-0002 SECTION. SQ1384.2 +033300 USE AFTER EXCEPTION PROCEDURE INPUT. SQ1384.2 +033400 INPUT-ERROR-PROCESS. SQ1384.2 +033500 MOVE "EXECUTED" TO DECL-EXEC-I. SQ1384.2 +033600* SQ1384.2 +033700 IF DECL-EXEC-SW NOT = SPACE SQ1384.2 +033800 GO TO END-DECLS. SQ1384.2 +033900* SQ1384.2 +034000 MOVE 1 TO REC-CT. SQ1384.2 +034100 MOVE "READ AFTER EOF READ" TO FEATURE. SQ1384.2 +034200 MOVE "DECL-EOF-READ" TO PAR-NAME. SQ1384.2 +034300 GO TO DECL-EOF-READ-01. SQ1384.2 +034400 DECL-DELETE-01. SQ1384.2 +034500 PERFORM DECL-DE-LETE. SQ1384.2 +034600 GO TO DECL-TEST-01-END. SQ1384.2 +034700 DECL-EOF-READ-01. SQ1384.2 +034800 DECL-TEST-01-END. SQ1384.2 +034900* SQ1384.2 +035000 ADD 1 TO REC-CT. SQ1384.2 +035100 GO TO DECL-EOF-READ-02. SQ1384.2 +035200 DECL-DELETE-02. SQ1384.2 +035300 PERFORM DECL-DE-LETE. SQ1384.2 +035400 GO TO DECL-TEST-02-END. SQ1384.2 +035500 DECL-EOF-READ-02. SQ1384.2 +035600 DECL-TEST-02-END. SQ1384.2 +035700* SQ1384.2 +035800 MOVE SPACE TO DUMMY-RECORD. SQ1384.2 +035900 PERFORM DECL-WRITE-LINE. SQ1384.2 +036000 MOVE "ABNORMAL TERMINATION OF PROGRAM HERE IS ACCEPTABLE" SQ1384.2 +036100 TO DUMMY-RECORD. SQ1384.2 +036200 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1384.2 +036300 GO TO END-DECLS. SQ1384.2 +036400* SQ1384.2 +036500* SQ1384.2 +036600 DECL-PASS. SQ1384.2 +036700 MOVE "PASS " TO P-OR-F. SQ1384.2 +036800 ADD 1 TO PASS-COUNTER. SQ1384.2 +036900 PERFORM DECL-PRINT-DETAIL. SQ1384.2 +037000* SQ1384.2 +037100 DECL-FAIL. SQ1384.2 +037200 MOVE "FAIL*" TO P-OR-F. SQ1384.2 +037300 ADD 1 TO ERROR-COUNTER. SQ1384.2 +037400 PERFORM DECL-PRINT-DETAIL. SQ1384.2 +037500* SQ1384.2 +037600 DECL-DE-LETE. SQ1384.2 +037700 MOVE "****TEST DELETED****" TO RE-MARK. SQ1384.2 +037800 MOVE "*****" TO P-OR-F. SQ1384.2 +037900 ADD 1 TO DELETE-COUNTER. SQ1384.2 +038000 PERFORM DECL-PRINT-DETAIL. SQ1384.2 +038100* SQ1384.2 +038200 DECL-PRINT-DETAIL. SQ1384.2 +038300 IF REC-CT NOT EQUAL TO ZERO SQ1384.2 +038400 MOVE "." TO PARDOT-X SQ1384.2 +038500 MOVE REC-CT TO DOTVALUE. SQ1384.2 +038600 MOVE TEST-RESULTS TO PRINT-REC. SQ1384.2 +038700 PERFORM DECL-WRITE-LINE. SQ1384.2 +038800 IF P-OR-F EQUAL TO "FAIL*" SQ1384.2 +038900 PERFORM DECL-WRITE-LINE SQ1384.2 +039000 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1384.2 +039100 ELSE SQ1384.2 +039200 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1384.2 +039300 MOVE SPACE TO P-OR-F. SQ1384.2 +039400 MOVE SPACE TO COMPUTED-X. SQ1384.2 +039500 MOVE SPACE TO CORRECT-X. SQ1384.2 +039600 IF REC-CT EQUAL TO ZERO SQ1384.2 +039700 MOVE SPACE TO PAR-NAME. SQ1384.2 +039800 MOVE SPACE TO RE-MARK. SQ1384.2 +039900* SQ1384.2 +040000 DECL-WRITE-LINE. SQ1384.2 +040100 ADD 1 TO RECORD-COUNT. SQ1384.2 +040200 IF RECORD-COUNT GREATER 50 SQ1384.2 +040300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1384.2 +040400 MOVE SPACE TO DUMMY-RECORD SQ1384.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1384.2 +040600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1384.2 +040700 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1384.2 +040800 PERFORM DECL-WRT-LN 2 TIMES SQ1384.2 +040900 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1384.2 +041000 PERFORM DECL-WRT-LN SQ1384.2 +041100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1384.2 +041200 MOVE ZERO TO RECORD-COUNT. SQ1384.2 +041300 PERFORM DECL-WRT-LN. SQ1384.2 +041400* SQ1384.2 +041500 DECL-WRT-LN. SQ1384.2 +041600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1384.2 +041700 MOVE SPACE TO DUMMY-RECORD. SQ1384.2 +041800* SQ1384.2 +041900 DECL-FAIL-ROUTINE. SQ1384.2 +042000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1384.2 +042100 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1384.2 +042200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1384.2 +042300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1384.2 +042400 MOVE XXINFO TO DUMMY-RECORD. SQ1384.2 +042500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1384.2 +042600 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1384.2 +042700 GO TO DECL-FAIL-EX. SQ1384.2 +042800 DECL-FAIL-WRITE. SQ1384.2 +042900 MOVE TEST-COMPUTED TO PRINT-REC SQ1384.2 +043000 PERFORM DECL-WRITE-LINE SQ1384.2 +043100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1384.2 +043200 MOVE TEST-CORRECT TO PRINT-REC SQ1384.2 +043300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1384.2 +043400 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1384.2 +043500 DECL-FAIL-EX. SQ1384.2 +043600 EXIT. SQ1384.2 +043700* SQ1384.2 +043800 DECL-BAIL. SQ1384.2 +043900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1384.2 +044000 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1384.2 +044100 DECL-BAIL-WRITE. SQ1384.2 +044200 MOVE CORRECT-A TO XXCORRECT. SQ1384.2 +044300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1384.2 +044400 MOVE XXINFO TO DUMMY-RECORD. SQ1384.2 +044500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1384.2 +044600 DECL-BAIL-EX. SQ1384.2 +044700 EXIT. SQ1384.2 +044800* SQ1384.2 +044900 END-DECLS. SQ1384.2 +045000 END DECLARATIVES. SQ1384.2 +045100* SQ1384.2 +045200* SQ1384.2 +045300 CCVS1 SECTION. SQ1384.2 +045400 OPEN-FILES. SQ1384.2 +045500*P OPEN I-O RAW-DATA. SQ1384.2 +045600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1384.2 +045700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1384.2 +045800*P MOVE "ABORTED " TO C-ABORT. SQ1384.2 +045900*P ADD 1 TO C-NO-OF-TESTS. SQ1384.2 +046000*P ACCEPT C-DATE FROM DATE. SQ1384.2 +046100*P ACCEPT C-TIME FROM TIME. SQ1384.2 +046200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1384.2 +046300*PND-E-1. SQ1384.2 +046400*P CLOSE RAW-DATA. SQ1384.2 +046500 OPEN OUTPUT PRINT-FILE. SQ1384.2 +046600 MOVE CCVS-PGM-ID TO TEST-ID. SQ1384.2 +046700 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1384.2 +046800 MOVE SPACE TO TEST-RESULTS. SQ1384.2 +046900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1384.2 +047000 MOVE ZERO TO REC-SKEL-SUB. SQ1384.2 +047100 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1384.2 +047200 GO TO CCVS1-EXIT. SQ1384.2 +047300* SQ1384.2 +047400 CCVS-INIT-FILE. SQ1384.2 +047500 ADD 1 TO REC-SKL-SUB. SQ1384.2 +047600 MOVE FILE-RECORD-INFO-SKELETON TO SQ1384.2 +047700 FILE-RECORD-INFO (REC-SKL-SUB). SQ1384.2 +047800* SQ1384.2 +047900 CLOSE-FILES. SQ1384.2 +048000 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1384.2 +048100 CLOSE PRINT-FILE. SQ1384.2 +048200*P OPEN I-O RAW-DATA. SQ1384.2 +048300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1384.2 +048400*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1384.2 +048500*P MOVE "OK. " TO C-ABORT. SQ1384.2 +048600*P MOVE PASS-COUNTER TO C-OK. SQ1384.2 +048700*P MOVE ERROR-HOLD TO C-ALL. SQ1384.2 +048800*P MOVE ERROR-COUNTER TO C-FAIL. SQ1384.2 +048900*P MOVE DELETE-CNT TO C-DELETED. SQ1384.2 +049000*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1384.2 +049100*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1384.2 +049200*PND-E-2. SQ1384.2 +049300*P CLOSE RAW-DATA. SQ1384.2 +049400 TERMINATE-CCVS. SQ1384.2 +049500*S EXIT PROGRAM. SQ1384.2 +049600 STOP RUN. SQ1384.2 +049700* SQ1384.2 +049800 INSPT. SQ1384.2 +049900 MOVE "INSPT" TO P-OR-F. SQ1384.2 +050000 ADD 1 TO INSPECT-COUNTER. SQ1384.2 +050100 PERFORM PRINT-DETAIL. SQ1384.2 +050200* SQ1384.2 +050300 PASS. SQ1384.2 +050400 MOVE "PASS " TO P-OR-F. SQ1384.2 +050500 ADD 1 TO PASS-COUNTER. SQ1384.2 +050600 PERFORM PRINT-DETAIL. SQ1384.2 +050700* SQ1384.2 +050800 FAIL. SQ1384.2 +050900 MOVE "FAIL*" TO P-OR-F. SQ1384.2 +051000 ADD 1 TO ERROR-COUNTER. SQ1384.2 +051100 PERFORM PRINT-DETAIL. SQ1384.2 +051200* SQ1384.2 +051300 DE-LETE. SQ1384.2 +051400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1384.2 +051500 MOVE "*****" TO P-OR-F. SQ1384.2 +051600 ADD 1 TO DELETE-COUNTER. SQ1384.2 +051700 PERFORM PRINT-DETAIL. SQ1384.2 +051800* SQ1384.2 +051900 PRINT-DETAIL. SQ1384.2 +052000 IF REC-CT NOT EQUAL TO ZERO SQ1384.2 +052100 MOVE "." TO PARDOT-X SQ1384.2 +052200 MOVE REC-CT TO DOTVALUE. SQ1384.2 +052300 MOVE TEST-RESULTS TO PRINT-REC. SQ1384.2 +052400 PERFORM WRITE-LINE. SQ1384.2 +052500 IF P-OR-F EQUAL TO "FAIL*" SQ1384.2 +052600 PERFORM WRITE-LINE SQ1384.2 +052700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1384.2 +052800 ELSE SQ1384.2 +052900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1384.2 +053000 MOVE SPACE TO P-OR-F. SQ1384.2 +053100 MOVE SPACE TO COMPUTED-X. SQ1384.2 +053200 MOVE SPACE TO CORRECT-X. SQ1384.2 +053300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1384.2 +053400 MOVE SPACE TO RE-MARK. SQ1384.2 +053500* SQ1384.2 +053600 HEAD-ROUTINE. SQ1384.2 +053700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +053800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +053900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1384.2 +054000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1384.2 +054100 COLUMN-NAMES-ROUTINE. SQ1384.2 +054200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1384.2 +054300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +054400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1384.2 +054500 END-ROUTINE. SQ1384.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1384.2 +054700 PERFORM WRITE-LINE 5 TIMES. SQ1384.2 +054800 END-RTN-EXIT. SQ1384.2 +054900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1384.2 +055000 PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +055100* SQ1384.2 +055200 END-ROUTINE-1. SQ1384.2 +055300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1384.2 +055400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1384.2 +055500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1384.2 +055600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1384.2 +055700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1384.2 +055800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1384.2 +055900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1384.2 +056000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1384.2 +056100 PERFORM WRITE-LINE. SQ1384.2 +056200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1384.2 +056300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1384.2 +056400 MOVE "NO " TO ERROR-TOTAL SQ1384.2 +056500 ELSE SQ1384.2 +056600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1384.2 +056700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1384.2 +056800 PERFORM WRITE-LINE. SQ1384.2 +056900 END-ROUTINE-13. SQ1384.2 +057000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1384.2 +057100 MOVE "NO " TO ERROR-TOTAL SQ1384.2 +057200 ELSE SQ1384.2 +057300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1384.2 +057400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1384.2 +057500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1384.2 +057600 PERFORM WRITE-LINE. SQ1384.2 +057700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1384.2 +057800 MOVE "NO " TO ERROR-TOTAL SQ1384.2 +057900 ELSE SQ1384.2 +058000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1384.2 +058100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1384.2 +058200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1384.2 +058300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1384.2 +058400* SQ1384.2 +058500 WRITE-LINE. SQ1384.2 +058600 ADD 1 TO RECORD-COUNT. SQ1384.2 +058700 IF RECORD-COUNT GREATER 50 SQ1384.2 +058800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1384.2 +058900 MOVE SPACE TO DUMMY-RECORD SQ1384.2 +059000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1384.2 +059100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1384.2 +059200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1384.2 +059300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1384.2 +059400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1384.2 +059500 MOVE ZERO TO RECORD-COUNT. SQ1384.2 +059600 PERFORM WRT-LN. SQ1384.2 +059700* SQ1384.2 +059800 WRT-LN. SQ1384.2 +059900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1384.2 +060000 MOVE SPACE TO DUMMY-RECORD. SQ1384.2 +060100 BLANK-LINE-PRINT. SQ1384.2 +060200 PERFORM WRT-LN. SQ1384.2 +060300 FAIL-ROUTINE. SQ1384.2 +060400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1384.2 +060500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1384.2 +060600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1384.2 +060700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1384.2 +060800 MOVE XXINFO TO DUMMY-RECORD. SQ1384.2 +060900 PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +061000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1384.2 +061100 GO TO FAIL-ROUTINE-EX. SQ1384.2 +061200 FAIL-ROUTINE-WRITE. SQ1384.2 +061300 MOVE TEST-COMPUTED TO PRINT-REC SQ1384.2 +061400 PERFORM WRITE-LINE SQ1384.2 +061500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1384.2 +061600 MOVE TEST-CORRECT TO PRINT-REC SQ1384.2 +061700 PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +061800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1384.2 +061900 FAIL-ROUTINE-EX. SQ1384.2 +062000 EXIT. SQ1384.2 +062100 BAIL-OUT. SQ1384.2 +062200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1384.2 +062300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1384.2 +062400 BAIL-OUT-WRITE. SQ1384.2 +062500 MOVE CORRECT-A TO XXCORRECT. SQ1384.2 +062600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1384.2 +062700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1384.2 +062800 MOVE XXINFO TO DUMMY-RECORD. SQ1384.2 +062900 PERFORM WRITE-LINE 2 TIMES. SQ1384.2 +063000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1384.2 +063100 BAIL-OUT-EX. SQ1384.2 +063200 EXIT. SQ1384.2 +063300 CCVS1-EXIT. SQ1384.2 +063400 EXIT. SQ1384.2 +063500* SQ1384.2 +063600**************************************************************** SQ1384.2 +063700* * SQ1384.2 +063800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1384.2 +063900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1384.2 +064000* * SQ1384.2 +064100**************************************************************** SQ1384.2 +064200* SQ1384.2 +064300 SECT-SQ138A-0004 SECTION. SQ1384.2 +064400 STA-INIT. SQ1384.2 +064500 MOVE SPACE TO DELETE-SW. SQ1384.2 +064600* SQ1384.2 +064700 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1384.2 +064800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1384.2 +064900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1384.2 +065000 MOVE 125 TO XRECORD-LENGTH (1). SQ1384.2 +065100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1384.2 +065200 MOVE 2 TO XBLOCK-SIZE (1). SQ1384.2 +065300 MOVE 1 TO RECORDS-IN-FILE (1). SQ1384.2 +065400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1384.2 +065500 MOVE "S" TO XLABEL-TYPE (1). SQ1384.2 +065600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1384.2 +065700* SQ1384.2 +065800* OPEN THE FILE IN THE OUTPUT MODE SQ1384.2 +065900* SQ1384.2 +066000 SEQ-INIT-01. SQ1384.2 +066100 MOVE 0 TO REC-CT. SQ1384.2 +066200 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +066300 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +066400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +066500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +066600 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1384.2 +066700 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1384.2 +066800 GO TO SEQ-TEST-OP-01. SQ1384.2 +066900 SEQ-DELETE-01. SQ1384.2 +067000 MOVE "*" TO DELETE-SW-1. SQ1384.2 +067100 SEQ-TEST-OP-01. SQ1384.2 +067200 OPEN OUTPUT SQ-FS4. SQ1384.2 +067300* SQ1384.2 +067400* SQ1384.2 +067500* THE FILE HAS BEEN CREATED. WE NOW WRITE ONE RECORD TO IT. SQ1384.2 +067600* SQ1384.2 +067700 SEQ-INIT-02. SQ1384.2 +067800 MOVE 0 TO REC-CT. SQ1384.2 +067900 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +068000 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +068100 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +068200 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +068300 ADD 1 TO XRECORD-NUMBER (1). SQ1384.2 +068400 MOVE "WRITE ONE RECORD" TO FEATURE. SQ1384.2 +068500 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1384.2 +068600 IF DELETE-SW NOT EQUAL TO SPACE SQ1384.2 +068700 GO TO SEQ-DELETE-02. SQ1384.2 +068800 GO TO SEQ-TEST-WR-02. SQ1384.2 +068900 SEQ-DELETE-02. SQ1384.2 +069000 MOVE "*" TO DELETE-SW-2. SQ1384.2 +069100 SEQ-TEST-WR-02. SQ1384.2 +069200 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4-FIRST. SQ1384.2 +069300 MOVE XRECORD-NUMBER (1) TO SQ-FS4-REC-NO. SQ1384.2 +069400 WRITE SQ-FS4R1-F-G-125. SQ1384.2 +069500* SQ1384.2 +069600* SQ1384.2 +069700* HAVING WRITTEN ONE RECORD, CLOSE THE FILE. SQ1384.2 +069800* SQ1384.2 +069900 SEQ-INIT-03. SQ1384.2 +070000 MOVE 0 TO REC-CT. SQ1384.2 +070100 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +070200 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +070300 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +070400 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +070500 MOVE "CLOSE AFTER CREATE" TO FEATURE. SQ1384.2 +070600 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1384.2 +070700 IF DELETE-SW NOT EQUAL TO SPACE SQ1384.2 +070800 GO TO SEQ-DELETE-03. SQ1384.2 +070900 GO TO SEQ-TEST-CL-03. SQ1384.2 +071000 SEQ-DELETE-03. SQ1384.2 +071100 MOVE "*" TO DELETE-SW-2. SQ1384.2 +071200 SEQ-TEST-CL-03. SQ1384.2 +071300 CLOSE SQ-FS4. SQ1384.2 +071400 SEQ-INIT-04. SQ1384.2 +071500 MOVE 0 TO REC-CT. SQ1384.2 +071600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1384.2 +071700 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +071800 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +071900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +072000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +072100 MOVE "OPEN, TO READ FILE" TO FEATURE. SQ1384.2 +072200 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1384.2 +072300 IF DELETE-SW NOT = SPACE SQ1384.2 +072400 GO TO SEQ-DELETE-04. SQ1384.2 +072500 GO TO SEQ-TEST-OP-04. SQ1384.2 +072600 SEQ-DELETE-04. SQ1384.2 +072700 MOVE "*" TO DELETE-SW-2. SQ1384.2 +072800 SEQ-TEST-OP-04. SQ1384.2 +072900* SQ1384.2 +073000* OPEN THE TEST FILE AND CLEAR THE RECORD AREA, JUST IN SQ1384.2 +073100* CASE THERE IS A SINGLE BUFFER WHICH STILL HAS A COPY OF SQ1384.2 +073200* THE LAST RECORD WRITTEN IN IT. SQ1384.2 +073300* SQ1384.2 +073400 OPEN INPUT SQ-FS4. SQ1384.2 +073500 MOVE SPACE TO SQ-FS4R1-F-G-125. SQ1384.2 +073600* SQ1384.2 +073700* SQ1384.2 +073800* READ THE FIRST (AND ONLY) RECORD FROM THE FILE SQ1384.2 +073900* SQ1384.2 +074000 SEQ-INIT-05. SQ1384.2 +074100 MOVE 0 TO REC-CT. SQ1384.2 +074200 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +074300 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +074400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +074500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +074600 MOVE "READ FIRST RECORD" TO FEATURE. SQ1384.2 +074700 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1384.2 +074800 IF DELETE-SW NOT = SPACE SQ1384.2 +074900 GO TO SEQ-DELETE-05. SQ1384.2 +075000 GO TO SEQ-TEST-RD-05. SQ1384.2 +075100 SEQ-DELETE-05. SQ1384.2 +075200 MOVE "*" TO DELETE-SW-2. SQ1384.2 +075300 SEQ-TEST-RD-05. SQ1384.2 +075400 READ SQ-FS4. SQ1384.2 +075500 MOVE SQ-FS4R1-F-G-125 TO FILE-RECORD-INFO (2). SQ1384.2 +075600 SEQ-INIT-06. SQ1384.2 +075700 MOVE 0 TO REC-CT. SQ1384.2 +075800 MOVE "*" TO DECL-EXEC-SW. SQ1384.2 +075900 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +076000 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +076100 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +076200 MOVE "READ, GIVING AT END" TO FEATURE. SQ1384.2 +076300 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1384.2 +076400 IF DELETE-SW NOT = SPACE SQ1384.2 +076500 GO TO SEQ-DELETE-06. SQ1384.2 +076600 GO TO SEQ-TEST-RD-06. SQ1384.2 +076700 SEQ-DELETE-06. SQ1384.2 +076800 MOVE "*" TO DELETE-SW-2. SQ1384.2 +076900 SEQ-TEST-RD-06. SQ1384.2 +077000 READ SQ-FS4. SQ1384.2 +077100* SQ1384.2 +077200* SQ1384.2 +077300* READ AGAIN, AFTER AT END, TO RAISE I-O STATUS 46 SQ1384.2 +077400* SQ1384.2 +077500 SEQ-INIT-07. SQ1384.2 +077600 MOVE 0 TO REC-CT. SQ1384.2 +077700 MOVE SPACE TO DECL-EXEC-SW. SQ1384.2 +077800 MOVE "**" TO SQ-FS4-STATUS. SQ1384.2 +077900 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ1384.2 +078000 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ1384.2 +078100 MOVE "READ AFTER AT END" TO FEATURE. SQ1384.2 +078200 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1384.2 +078300 IF DELETE-SW NOT = SPACE SQ1384.2 +078400 GO TO SEQ-DELETE-07. SQ1384.2 +078500 GO TO SEQ-TEST-RD-07. SQ1384.2 +078600 SEQ-DELETE-07. SQ1384.2 +078700 MOVE "*" TO DELETE-SW-2. SQ1384.2 +078800 SEQ-TEST-RD-07. SQ1384.2 +078900 READ SQ-FS4. SQ1384.2 +079000* SQ1384.2 +079100* THE TESTS FOLLOWING THIS READ STATEMENT MAY NOT BE SQ1384.2 +079200* EXECUTED. THE IMPLEMENTOR MAY LEGITIMATELY TERMINATE SQ1384.2 +079300* EXECUTION ON EXIT FROM THE DECLARATIVE. SQ1384.2 +079400* SQ1384.2 +079500 MOVE ZERO TO REC-CT. SQ1384.2 +079600 MOVE "READ AFTER AT END" TO FEATURE. SQ1384.2 +079700 MOVE "SEQ-TEST-RD-07" TO PAR-NAME. SQ1384.2 +079800* SQ1384.2 +079900* CHECK I-O STATUS RETURNED FROM READ AFTER AT END SQ1384.2 +080000* SQ1384.2 +080100 ADD 1 TO REC-CT. SQ1384.2 +080200 SEQ-TEST-07-01-END. SQ1384.2 +080300 ADD 1 TO REC-CT. SQ1384.2 +080400 SEQ-TEST-07-02-END. SQ1384.2 +080500* SQ1384.2 +080600* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ1384.2 +080700* SQ1384.2 +080800 ADD 1 TO REC-CT. SQ1384.2 +080900 IF DELETE-SW NOT = SPACE SQ1384.2 +081000 GO TO SEQ-DELETE-07-03. SQ1384.2 +081100 GO TO SEQ-TEST-RD-07-03. SQ1384.2 +081200 SEQ-DELETE-07-03. SQ1384.2 +081300 PERFORM DE-LETE. SQ1384.2 +081400 GO TO SEQ-TEST-07-03-END. SQ1384.2 +081500 SEQ-TEST-RD-07-03. SQ1384.2 +081600 IF DECL-EXEC-O = "NOT EXECUTED" SQ1384.2 +081700 PERFORM PASS SQ1384.2 +081800 ELSE SQ1384.2 +081900 MOVE DECL-EXEC-O TO COMPUTED-A SQ1384.2 +082000 MOVE "NOT EXECUTED" TO CORRECT-A SQ1384.2 +082100 MOVE "UNEXPECTED EXECUTION OF OUTPUT DECLARATIVE" SQ1384.2 +082200 TO RE-MARK SQ1384.2 +082300 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1384.2 +082400 PERFORM FAIL. SQ1384.2 +082500 SEQ-TEST-07-03-END. SQ1384.2 +082600 MOVE SPACE TO DELETE-SW-2. SQ1384.2 +082700* SQ1384.2 +082800* SQ1384.2 +082900 CCVS-EXIT SECTION. SQ1384.2 +083000 CCVS-999999. SQ1384.2 +083100 GO TO CLOSE-FILES. SQ1384.2 diff --git a/tests/cobol85/SQ/SQ139A.CBL b/tests/cobol85/SQ/SQ139A.CBL new file mode 100755 index 00000000..4dc9c3f4 --- /dev/null +++ b/tests/cobol85/SQ/SQ139A.CBL @@ -0,0 +1,650 @@ +000100 IDENTIFICATION DIVISION. SQ1394.2 +000200 PROGRAM-ID. SQ1394.2 +000300 SQ139A. SQ1394.2 +000400**************************************************************** SQ1394.2 +000500* * SQ1394.2 +000600* VALIDATION FOR:- * SQ1394.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1394.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1394.2 +000900* REVISED 1986, AUGUST * SQ1394.2 +001000* * SQ1394.2 +001100* CREATION DATE / VALIDATION DATE * SQ1394.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1394.2 +001300* * SQ1394.2 +001400**************************************************************** SQ1394.2 +001500* * SQ1394.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1394.2 +001700* * SQ1394.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1394.2 +001900* X-55 SYSTEM PRINTER * SQ1394.2 +002000* X-82 SOURCE-COMPUTER * SQ1394.2 +002100* X-83 OBJECT-COMPUTER. * SQ1394.2 +002200* * SQ1394.2 +002300* * SQ1394.2 +002400**************************************************************** SQ1394.2 +002500* * SQ1394.2 +002600* SPLIT FROM SQ125A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1394.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1394.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1394.2 +002900* OPEN FOR OUTPUT FOR A MAGNETIC TAPE FILE WHICH IS ALREADY * SQ1394.2 +003000* OPEN IN THE OUTPUT MODE. (SEE SQ125A). * SQ1394.2 +003100* * SQ1394.2 +003200**************************************************************** SQ1394.2 +003300* SQ1394.2 +003400 ENVIRONMENT DIVISION. SQ1394.2 +003500 CONFIGURATION SECTION. SQ1394.2 +003600 SOURCE-COMPUTER. SQ1394.2 +003700 Linux. SQ1394.2 +003800 OBJECT-COMPUTER. SQ1394.2 +003900 Linux. SQ1394.2 +004000* SQ1394.2 +004100 INPUT-OUTPUT SECTION. SQ1394.2 +004200 FILE-CONTROL. SQ1394.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1394.2 +004400 "report.log". SQ1394.2 +004500* SQ1394.2 +004600*P SELECT RAW-DATA ASSIGN TO SQ1394.2 +004700*P "XXXXX062" SQ1394.2 +004800*P ORGANIZATION IS INDEXED SQ1394.2 +004900*P ACCESS MODE IS RANDOM SQ1394.2 +005000*P RECORD-KEY IS RAW-DATA-KEY. SQ1394.2 +005100*P SQ1394.2 +005200 SELECT SQ-FS1 ASSIGN TO SQ1394.2 +005300 "XXXXX001" SQ1394.2 +005400 FILE STATUS IS SQ-FS1-STATUS. SQ1394.2 +005500* SQ1394.2 +005600* SQ1394.2 +005700 DATA DIVISION. SQ1394.2 +005800 FILE SECTION. SQ1394.2 +005900 FD PRINT-FILE SQ1394.2 +006000*C LABEL RECORDS SQ1394.2 +006100*C OMITTED SQ1394.2 +006200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1394.2 +006300 . SQ1394.2 +006400 01 PRINT-REC PICTURE X(120). SQ1394.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ1394.2 +006600*P SQ1394.2 +006700*PD RAW-DATA. SQ1394.2 +006800*P1 RAW-DATA-SATZ. SQ1394.2 +006900*P 05 RAW-DATA-KEY PIC X(6). SQ1394.2 +007000*P 05 C-DATE PIC 9(6). SQ1394.2 +007100*P 05 C-TIME PIC 9(8). SQ1394.2 +007200*P 05 NO-OF-TESTS PIC 99. SQ1394.2 +007300*P 05 C-OK PIC 999. SQ1394.2 +007400*P 05 C-ALL PIC 999. SQ1394.2 +007500*P 05 C-FAIL PIC 999. SQ1394.2 +007600*P 05 C-DELETED PIC 999. SQ1394.2 +007700*P 05 C-INSPECT PIC 999. SQ1394.2 +007800*P 05 C-NOTE PIC X(13). SQ1394.2 +007900*P 05 C-INDENT PIC X. SQ1394.2 +008000*P 05 C-ABORT PIC X(8). SQ1394.2 +008100* SQ1394.2 +008200 FD SQ-FS1 SQ1394.2 +008300*C LABEL RECORD IS STANDARD SQ1394.2 +008400 . SQ1394.2 +008500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1394.2 +008600* SQ1394.2 +008700 WORKING-STORAGE SECTION. SQ1394.2 +008800* SQ1394.2 +008900*************************************************************** SQ1394.2 +009000* * SQ1394.2 +009100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1394.2 +009200* * SQ1394.2 +009300*************************************************************** SQ1394.2 +009400* SQ1394.2 +009500 01 SQ-FS1-STATUS. SQ1394.2 +009600 03 SQ-FS1-KEY-1 PIC X. SQ1394.2 +009700 03 SQ-FS1-KEY-2 PIC X. SQ1394.2 +009800* SQ1394.2 +009900 01 DECL-EXEC-SW PIC 9. SQ1394.2 +010000* SQ1394.2 +010100* SQ1394.2 +010200*************************************************************** SQ1394.2 +010300* * SQ1394.2 +010400* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1394.2 +010500* * SQ1394.2 +010600*************************************************************** SQ1394.2 +010700* SQ1394.2 +010800 01 REC-SKEL-SUB PIC 99. SQ1394.2 +010900* SQ1394.2 +011000 01 FILE-RECORD-INFORMATION-REC. SQ1394.2 +011100 03 FILE-RECORD-INFO-SKELETON. SQ1394.2 +011200 05 FILLER PICTURE X(48) VALUE SQ1394.2 +011300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1394.2 +011400 05 FILLER PICTURE X(46) VALUE SQ1394.2 +011500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1394.2 +011600 05 FILLER PICTURE X(26) VALUE SQ1394.2 +011700 ",LFIL=000000,ORG= ,LBLR= ". SQ1394.2 +011800 05 FILLER PICTURE X(37) VALUE SQ1394.2 +011900 ",RECKEY= ". SQ1394.2 +012000 05 FILLER PICTURE X(38) VALUE SQ1394.2 +012100 ",ALTKEY1= ". SQ1394.2 +012200 05 FILLER PICTURE X(38) VALUE SQ1394.2 +012300 ",ALTKEY2= ". SQ1394.2 +012400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1394.2 +012500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1394.2 +012600 05 FILE-RECORD-INFO-P1-120. SQ1394.2 +012700 07 FILLER PIC X(5). SQ1394.2 +012800 07 XFILE-NAME PIC X(6). SQ1394.2 +012900 07 FILLER PIC X(8). SQ1394.2 +013000 07 XRECORD-NAME PIC X(6). SQ1394.2 +013100 07 FILLER PIC X(1). SQ1394.2 +013200 07 REELUNIT-NUMBER PIC 9(1). SQ1394.2 +013300 07 FILLER PIC X(7). SQ1394.2 +013400 07 XRECORD-NUMBER PIC 9(6). SQ1394.2 +013500 07 FILLER PIC X(6). SQ1394.2 +013600 07 UPDATE-NUMBER PIC 9(2). SQ1394.2 +013700 07 FILLER PIC X(5). SQ1394.2 +013800 07 ODO-NUMBER PIC 9(4). SQ1394.2 +013900 07 FILLER PIC X(5). SQ1394.2 +014000 07 XPROGRAM-NAME PIC X(5). SQ1394.2 +014100 07 FILLER PIC X(7). SQ1394.2 +014200 07 XRECORD-LENGTH PIC 9(6). SQ1394.2 +014300 07 FILLER PIC X(7). SQ1394.2 +014400 07 CHARS-OR-RECORDS PIC X(2). SQ1394.2 +014500 07 FILLER PIC X(1). SQ1394.2 +014600 07 XBLOCK-SIZE PIC 9(4). SQ1394.2 +014700 07 FILLER PIC X(6). SQ1394.2 +014800 07 RECORDS-IN-FILE PIC 9(6). SQ1394.2 +014900 07 FILLER PIC X(5). SQ1394.2 +015000 07 XFILE-ORGANIZATION PIC X(2). SQ1394.2 +015100 07 FILLER PIC X(6). SQ1394.2 +015200 07 XLABEL-TYPE PIC X(1). SQ1394.2 +015300 05 FILE-RECORD-INFO-P121-240. SQ1394.2 +015400 07 FILLER PIC X(8). SQ1394.2 +015500 07 XRECORD-KEY PIC X(29). SQ1394.2 +015600 07 FILLER PIC X(9). SQ1394.2 +015700 07 ALTERNATE-KEY1 PIC X(29). SQ1394.2 +015800 07 FILLER PIC X(9). SQ1394.2 +015900 07 ALTERNATE-KEY2 PIC X(29). SQ1394.2 +016000 07 FILLER PIC X(7). SQ1394.2 +016100* SQ1394.2 +016200 01 TEST-RESULTS. SQ1394.2 +016300 02 FILLER PIC X VALUE SPACE. SQ1394.2 +016400 02 PAR-NAME. SQ1394.2 +016500 03 FILLER PIC X(14) VALUE SPACE. SQ1394.2 +016600 03 PARDOT-X PIC X VALUE SPACE. SQ1394.2 +016700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1394.2 +016800 02 FILLER PIC X VALUE SPACE. SQ1394.2 +016900 02 FEATURE PIC X(24) VALUE SPACE. SQ1394.2 +017000 02 FILLER PIC X VALUE SPACE. SQ1394.2 +017100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1394.2 +017200 02 FILLER PIC X(9) VALUE SPACE. SQ1394.2 +017300 02 RE-MARK PIC X(61). SQ1394.2 +017400 01 TEST-COMPUTED. SQ1394.2 +017500 02 FILLER PIC X(30) VALUE SPACE. SQ1394.2 +017600 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1394.2 +017700 02 COMPUTED-X. SQ1394.2 +017800 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1394.2 +017900 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1394.2 +018000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1394.2 +018100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1394.2 +018200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1394.2 +018300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1394.2 +018400 04 COMPUTED-18V0 PIC -9(18). SQ1394.2 +018500 04 FILLER PIC X. SQ1394.2 +018600 03 FILLER PIC X(50) VALUE SPACE. SQ1394.2 +018700 01 TEST-CORRECT. SQ1394.2 +018800 02 FILLER PIC X(30) VALUE SPACE. SQ1394.2 +018900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1394.2 +019000 02 CORRECT-X. SQ1394.2 +019100 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1394.2 +019200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1394.2 +019300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1394.2 +019400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1394.2 +019500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1394.2 +019600 03 CR-18V0 REDEFINES CORRECT-A. SQ1394.2 +019700 04 CORRECT-18V0 PIC -9(18). SQ1394.2 +019800 04 FILLER PIC X. SQ1394.2 +019900 03 FILLER PIC X(2) VALUE SPACE. SQ1394.2 +020000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1394.2 +020100* SQ1394.2 +020200 01 CCVS-C-1. SQ1394.2 +020300 02 FILLER PIC IS X VALUE SPACE. SQ1394.2 +020400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1394.2 +020500 02 FILLER PIC IS X VALUE SPACE. SQ1394.2 +020600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1394.2 +020700 02 FILLER PIC IS X VALUE SPACE. SQ1394.2 +020800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1394.2 +020900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1394.2 +021000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1394.2 +021100 01 CCVS-C-2. SQ1394.2 +021200 02 FILLER PIC X(19) VALUE SPACE. SQ1394.2 +021300 02 FILLER PIC X(6) VALUE "TESTED". SQ1394.2 +021400 02 FILLER PIC X(19) VALUE SPACE. SQ1394.2 +021500 02 FILLER PIC X(4) VALUE "FAIL". SQ1394.2 +021600 02 FILLER PIC X(72) VALUE SPACE. SQ1394.2 +021700* SQ1394.2 +021800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1394.2 +021900 01 REC-CT PIC 99 VALUE ZERO. SQ1394.2 +022000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1394.2 +022100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1394.2 +022200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1394.2 +022300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1394.2 +022400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1394.2 +022500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1394.2 +022600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1394.2 +022700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1394.2 +022800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1394.2 +022900 01 CCVS-H-1. SQ1394.2 +023000 02 FILLER PIC X(39) VALUE SPACES. SQ1394.2 +023100 02 FILLER PIC X(42) VALUE SQ1394.2 +023200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1394.2 +023300 02 FILLER PIC X(39) VALUE SPACES. SQ1394.2 +023400 01 CCVS-H-2A. SQ1394.2 +023500 02 FILLER PIC X(40) VALUE SPACE. SQ1394.2 +023600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1394.2 +023700 02 FILLER PIC XXXX VALUE SQ1394.2 +023800 "4.2 ". SQ1394.2 +023900 02 FILLER PIC X(28) VALUE SQ1394.2 +024000 " COPY - NOT FOR DISTRIBUTION". SQ1394.2 +024100 02 FILLER PIC X(41) VALUE SPACE. SQ1394.2 +024200* SQ1394.2 +024300 01 CCVS-H-2B. SQ1394.2 +024400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1394.2 +024500 02 TEST-ID PIC X(9). SQ1394.2 +024600 02 FILLER PIC X(4) VALUE " IN ". SQ1394.2 +024700 02 FILLER PIC X(12) VALUE SQ1394.2 +024800 " HIGH ". SQ1394.2 +024900 02 FILLER PIC X(22) VALUE SQ1394.2 +025000 " LEVEL VALIDATION FOR ". SQ1394.2 +025100 02 FILLER PIC X(58) VALUE SQ1394.2 +025200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1394.2 +025300 01 CCVS-H-3. SQ1394.2 +025400 02 FILLER PIC X(34) VALUE SQ1394.2 +025500 " FOR OFFICIAL USE ONLY ". SQ1394.2 +025600 02 FILLER PIC X(58) VALUE SQ1394.2 +025700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1394.2 +025800 02 FILLER PIC X(28) VALUE SQ1394.2 +025900 " COPYRIGHT 1985,1986 ". SQ1394.2 +026000 01 CCVS-E-1. SQ1394.2 +026100 02 FILLER PIC X(52) VALUE SPACE. SQ1394.2 +026200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1394.2 +026300 02 ID-AGAIN PIC X(9). SQ1394.2 +026400 02 FILLER PIC X(45) VALUE SPACES. SQ1394.2 +026500 01 CCVS-E-2. SQ1394.2 +026600 02 FILLER PIC X(31) VALUE SPACE. SQ1394.2 +026700 02 FILLER PIC X(21) VALUE SPACE. SQ1394.2 +026800 02 CCVS-E-2-2. SQ1394.2 +026900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1394.2 +027000 03 FILLER PIC X VALUE SPACE. SQ1394.2 +027100 03 ENDER-DESC PIC X(44) VALUE SQ1394.2 +027200 "ERRORS ENCOUNTERED". SQ1394.2 +027300 01 CCVS-E-3. SQ1394.2 +027400 02 FILLER PIC X(22) VALUE SQ1394.2 +027500 " FOR OFFICIAL USE ONLY". SQ1394.2 +027600 02 FILLER PIC X(12) VALUE SPACE. SQ1394.2 +027700 02 FILLER PIC X(58) VALUE SQ1394.2 +027800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1394.2 +027900 02 FILLER PIC X(8) VALUE SPACE. SQ1394.2 +028000 02 FILLER PIC X(20) VALUE SQ1394.2 +028100 " COPYRIGHT 1985,1986". SQ1394.2 +028200 01 CCVS-E-4. SQ1394.2 +028300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1394.2 +028400 02 FILLER PIC X(4) VALUE " OF ". SQ1394.2 +028500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1394.2 +028600 02 FILLER PIC X(40) VALUE SQ1394.2 +028700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1394.2 +028800 01 XXINFO. SQ1394.2 +028900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1394.2 +029000 02 INFO-TEXT. SQ1394.2 +029100 04 FILLER PIC X(8) VALUE SPACE. SQ1394.2 +029200 04 XXCOMPUTED PIC X(20). SQ1394.2 +029300 04 FILLER PIC X(5) VALUE SPACE. SQ1394.2 +029400 04 XXCORRECT PIC X(20). SQ1394.2 +029500 02 INF-ANSI-REFERENCE PIC X(48). SQ1394.2 +029600 01 HYPHEN-LINE. SQ1394.2 +029700 02 FILLER PIC IS X VALUE IS SPACE. SQ1394.2 +029800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1394.2 +029900- "*****************************************". SQ1394.2 +030000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1394.2 +030100- "******************************". SQ1394.2 +030200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1394.2 +030300 "SQ139A". SQ1394.2 +030400* SQ1394.2 +030500* SQ1394.2 +030600 PROCEDURE DIVISION. SQ1394.2 +030700 DECLARATIVES. SQ1394.2 +030800 SQ139A-DECLARATIVE-001-SECT SECTION. SQ1394.2 +030900 USE AFTER STANDARD EXCEPTION PROCEDURE SQ-FS1. SQ1394.2 +031000 INPUT-ERROR-PROCEDURE. SQ1394.2 +031100 IF DECL-EXEC-SW NOT = 9 SQ1394.2 +031200 GO TO NOT-DECL-9. SQ1394.2 +031300* SQ1394.2 +031400* DECLARATIVE PROCEDURE ENTERED FROM SECOND OPEN OUTPUT SQ1394.2 +031500* SQ1394.2 +031600 DECL-OPEN-TEST. SQ1394.2 +031700 MOVE SPACE TO DUMMY-RECORD SQ1394.2 +031800 PERFORM DECL-WRITE-LINE SQ1394.2 +031900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1394.2 +032000 TO DUMMY-RECORD SQ1394.2 +032100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1394.2 +032200 GO TO END-DECLS. SQ1394.2 +032300* SQ1394.2 +032400* SQ1394.2 +032500 NOT-DECL-9. SQ1394.2 +032600 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1394.2 +032700 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1394.2 +032800 MOVE 9 TO CORRECT-18V0. SQ1394.2 +032900 MOVE "UNEXPECTED ENTRY TO DECLARATIVES" TO RE-MARK. SQ1394.2 +033000 PERFORM DECL-FAIL. SQ1394.2 +033100 GO TO END-DECLS. SQ1394.2 +033200* SQ1394.2 +033300* SQ1394.2 +033400* SQ1394.2 +033500 DECL-PASS. SQ1394.2 +033600 MOVE "PASS " TO P-OR-F. SQ1394.2 +033700 ADD 1 TO PASS-COUNTER. SQ1394.2 +033800 PERFORM DECL-PRINT-DETAIL. SQ1394.2 +033900* SQ1394.2 +034000 DECL-FAIL. SQ1394.2 +034100 MOVE "FAIL*" TO P-OR-F. SQ1394.2 +034200 ADD 1 TO ERROR-COUNTER. SQ1394.2 +034300 PERFORM DECL-PRINT-DETAIL. SQ1394.2 +034400* SQ1394.2 +034500 DECL-PRINT-DETAIL. SQ1394.2 +034600 IF REC-CT NOT EQUAL TO ZERO SQ1394.2 +034700 MOVE "." TO PARDOT-X SQ1394.2 +034800 MOVE REC-CT TO DOTVALUE. SQ1394.2 +034900 MOVE TEST-RESULTS TO PRINT-REC. SQ1394.2 +035000 PERFORM DECL-WRITE-LINE. SQ1394.2 +035100 IF P-OR-F EQUAL TO "FAIL*" SQ1394.2 +035200 PERFORM DECL-WRITE-LINE SQ1394.2 +035300 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1394.2 +035400 ELSE SQ1394.2 +035500 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1394.2 +035600 MOVE SPACE TO P-OR-F. SQ1394.2 +035700 MOVE SPACE TO COMPUTED-X. SQ1394.2 +035800 MOVE SPACE TO CORRECT-X. SQ1394.2 +035900 IF REC-CT EQUAL TO ZERO SQ1394.2 +036000 MOVE SPACE TO PAR-NAME. SQ1394.2 +036100 MOVE SPACE TO RE-MARK. SQ1394.2 +036200* SQ1394.2 +036300 DECL-WRITE-LINE. SQ1394.2 +036400 ADD 1 TO RECORD-COUNT. SQ1394.2 +036500 IF RECORD-COUNT GREATER 50 SQ1394.2 +036600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1394.2 +036700 MOVE SPACE TO DUMMY-RECORD SQ1394.2 +036800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1394.2 +036900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1394.2 +037000 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1394.2 +037100 PERFORM DECL-WRT-LN 2 TIMES SQ1394.2 +037200 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1394.2 +037300 PERFORM DECL-WRT-LN SQ1394.2 +037400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1394.2 +037500 MOVE ZERO TO RECORD-COUNT. SQ1394.2 +037600 PERFORM DECL-WRT-LN. SQ1394.2 +037700* SQ1394.2 +037800 DECL-WRT-LN. SQ1394.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1394.2 +038000 MOVE SPACE TO DUMMY-RECORD. SQ1394.2 +038100* SQ1394.2 +038200 DECL-FAIL-ROUTINE. SQ1394.2 +038300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1394.2 +038400 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1394.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1394.2 +038600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1394.2 +038700 MOVE XXINFO TO DUMMY-RECORD. SQ1394.2 +038800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1394.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1394.2 +039000 GO TO DECL-FAIL-EX. SQ1394.2 +039100 DECL-FAIL-WRITE. SQ1394.2 +039200 MOVE TEST-COMPUTED TO PRINT-REC SQ1394.2 +039300 PERFORM DECL-WRITE-LINE SQ1394.2 +039400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1394.2 +039500 MOVE TEST-CORRECT TO PRINT-REC SQ1394.2 +039600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1394.2 +039700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1394.2 +039800 DECL-FAIL-EX. SQ1394.2 +039900 EXIT. SQ1394.2 +040000* SQ1394.2 +040100 DECL-BAIL. SQ1394.2 +040200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1394.2 +040300 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1394.2 +040400 DECL-BAIL-WRITE. SQ1394.2 +040500 MOVE CORRECT-A TO XXCORRECT. SQ1394.2 +040600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1394.2 +040700 MOVE XXINFO TO DUMMY-RECORD. SQ1394.2 +040800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1394.2 +040900 DECL-BAIL-EX. SQ1394.2 +041000 EXIT. SQ1394.2 +041100* SQ1394.2 +041200 END-DECLS. SQ1394.2 +041300 MOVE ZERO TO DECL-EXEC-SW. SQ1394.2 +041400 END DECLARATIVES. SQ1394.2 +041500* SQ1394.2 +041600* SQ1394.2 +041700 CCVS1 SECTION. SQ1394.2 +041800 OPEN-FILES. SQ1394.2 +041900*P OPEN I-O RAW-DATA. SQ1394.2 +042000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1394.2 +042100*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1394.2 +042200*P MOVE "ABORTED " TO C-ABORT. SQ1394.2 +042300*P ADD 1 TO C-NO-OF-TESTS. SQ1394.2 +042400*P ACCEPT C-DATE FROM DATE. SQ1394.2 +042500*P ACCEPT C-TIME FROM TIME. SQ1394.2 +042600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1394.2 +042700*PND-E-1. SQ1394.2 +042800*P CLOSE RAW-DATA. SQ1394.2 +042900 OPEN OUTPUT PRINT-FILE. SQ1394.2 +043000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1394.2 +043100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1394.2 +043200 MOVE SPACE TO TEST-RESULTS. SQ1394.2 +043300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1394.2 +043400 MOVE ZERO TO REC-SKEL-SUB. SQ1394.2 +043500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1394.2 +043600 GO TO CCVS1-EXIT. SQ1394.2 +043700* SQ1394.2 +043800 CCVS-INIT-FILE. SQ1394.2 +043900 ADD 1 TO REC-SKL-SUB. SQ1394.2 +044000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1394.2 +044100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1394.2 +044200* SQ1394.2 +044300 CLOSE-FILES. SQ1394.2 +044400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1394.2 +044500 CLOSE PRINT-FILE. SQ1394.2 +044600*P OPEN I-O RAW-DATA. SQ1394.2 +044700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1394.2 +044800*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1394.2 +044900*P MOVE "OK. " TO C-ABORT. SQ1394.2 +045000*P MOVE PASS-COUNTER TO C-OK. SQ1394.2 +045100*P MOVE ERROR-HOLD TO C-ALL. SQ1394.2 +045200*P MOVE ERROR-COUNTER TO C-FAIL. SQ1394.2 +045300*P MOVE DELETE-CNT TO C-DELETED. SQ1394.2 +045400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1394.2 +045500*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1394.2 +045600*PND-E-2. SQ1394.2 +045700*P CLOSE RAW-DATA. SQ1394.2 +045800 TERMINATE-CCVS. SQ1394.2 +045900*S EXIT PROGRAM. SQ1394.2 +046000 STOP RUN. SQ1394.2 +046100* SQ1394.2 +046200 INSPT. SQ1394.2 +046300 MOVE "INSPT" TO P-OR-F. SQ1394.2 +046400 ADD 1 TO INSPECT-COUNTER. SQ1394.2 +046500 PERFORM PRINT-DETAIL. SQ1394.2 +046600 SQ1394.2 +046700 PASS. SQ1394.2 +046800 MOVE "PASS " TO P-OR-F. SQ1394.2 +046900 ADD 1 TO PASS-COUNTER. SQ1394.2 +047000 PERFORM PRINT-DETAIL. SQ1394.2 +047100* SQ1394.2 +047200 FAIL. SQ1394.2 +047300 MOVE "FAIL*" TO P-OR-F. SQ1394.2 +047400 ADD 1 TO ERROR-COUNTER. SQ1394.2 +047500 PERFORM PRINT-DETAIL. SQ1394.2 +047600* SQ1394.2 +047700 DE-LETE. SQ1394.2 +047800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1394.2 +047900 MOVE "*****" TO P-OR-F. SQ1394.2 +048000 ADD 1 TO DELETE-COUNTER. SQ1394.2 +048100 PERFORM PRINT-DETAIL. SQ1394.2 +048200* SQ1394.2 +048300 PRINT-DETAIL. SQ1394.2 +048400 IF REC-CT NOT EQUAL TO ZERO SQ1394.2 +048500 MOVE "." TO PARDOT-X SQ1394.2 +048600 MOVE REC-CT TO DOTVALUE. SQ1394.2 +048700 MOVE TEST-RESULTS TO PRINT-REC. SQ1394.2 +048800 PERFORM WRITE-LINE. SQ1394.2 +048900 IF P-OR-F EQUAL TO "FAIL*" SQ1394.2 +049000 PERFORM WRITE-LINE SQ1394.2 +049100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1394.2 +049200 ELSE SQ1394.2 +049300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1394.2 +049400 MOVE SPACE TO P-OR-F. SQ1394.2 +049500 MOVE SPACE TO COMPUTED-X. SQ1394.2 +049600 MOVE SPACE TO CORRECT-X. SQ1394.2 +049700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1394.2 +049800 MOVE SPACE TO RE-MARK. SQ1394.2 +049900* SQ1394.2 +050000 HEAD-ROUTINE. SQ1394.2 +050100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +050200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +050300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1394.2 +050400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1394.2 +050500 COLUMN-NAMES-ROUTINE. SQ1394.2 +050600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1394.2 +050700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +050800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1394.2 +050900 END-ROUTINE. SQ1394.2 +051000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1394.2 +051100 PERFORM WRITE-LINE 5 TIMES. SQ1394.2 +051200 END-RTN-EXIT. SQ1394.2 +051300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1394.2 +051400 PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +051500* SQ1394.2 +051600 END-ROUTINE-1. SQ1394.2 +051700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1394.2 +051800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1394.2 +051900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1394.2 +052000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1394.2 +052100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1394.2 +052200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1394.2 +052300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1394.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1394.2 +052500 PERFORM WRITE-LINE. SQ1394.2 +052600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1394.2 +052700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1394.2 +052800 MOVE "NO " TO ERROR-TOTAL SQ1394.2 +052900 ELSE SQ1394.2 +053000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1394.2 +053100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1394.2 +053200 PERFORM WRITE-LINE. SQ1394.2 +053300 END-ROUTINE-13. SQ1394.2 +053400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1394.2 +053500 MOVE "NO " TO ERROR-TOTAL SQ1394.2 +053600 ELSE SQ1394.2 +053700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1394.2 +053800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1394.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1394.2 +054000 PERFORM WRITE-LINE. SQ1394.2 +054100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1394.2 +054200 MOVE "NO " TO ERROR-TOTAL SQ1394.2 +054300 ELSE SQ1394.2 +054400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1394.2 +054500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1394.2 +054600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1394.2 +054700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1394.2 +054800* SQ1394.2 +054900 WRITE-LINE. SQ1394.2 +055000 ADD 1 TO RECORD-COUNT. SQ1394.2 +055100 IF RECORD-COUNT GREATER 50 SQ1394.2 +055200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1394.2 +055300 MOVE SPACE TO DUMMY-RECORD SQ1394.2 +055400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1394.2 +055500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1394.2 +055600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1394.2 +055700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1394.2 +055800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1394.2 +055900 MOVE ZERO TO RECORD-COUNT. SQ1394.2 +056000 PERFORM WRT-LN. SQ1394.2 +056100* SQ1394.2 +056200 WRT-LN. SQ1394.2 +056300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1394.2 +056400 MOVE SPACE TO DUMMY-RECORD. SQ1394.2 +056500 BLANK-LINE-PRINT. SQ1394.2 +056600 PERFORM WRT-LN. SQ1394.2 +056700 FAIL-ROUTINE. SQ1394.2 +056800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1394.2 +056900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1394.2 +057000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1394.2 +057100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1394.2 +057200 MOVE XXINFO TO DUMMY-RECORD. SQ1394.2 +057300 PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +057400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1394.2 +057500 GO TO FAIL-ROUTINE-EX. SQ1394.2 +057600 FAIL-ROUTINE-WRITE. SQ1394.2 +057700 MOVE TEST-COMPUTED TO PRINT-REC SQ1394.2 +057800 PERFORM WRITE-LINE SQ1394.2 +057900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1394.2 +058000 MOVE TEST-CORRECT TO PRINT-REC SQ1394.2 +058100 PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +058200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1394.2 +058300 FAIL-ROUTINE-EX. SQ1394.2 +058400 EXIT. SQ1394.2 +058500 BAIL-OUT. SQ1394.2 +058600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1394.2 +058700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1394.2 +058800 BAIL-OUT-WRITE. SQ1394.2 +058900 MOVE CORRECT-A TO XXCORRECT. SQ1394.2 +059000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1394.2 +059100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1394.2 +059200 MOVE XXINFO TO DUMMY-RECORD. SQ1394.2 +059300 PERFORM WRITE-LINE 2 TIMES. SQ1394.2 +059400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1394.2 +059500 BAIL-OUT-EX. SQ1394.2 +059600 EXIT. SQ1394.2 +059700 CCVS1-EXIT. SQ1394.2 +059800 EXIT. SQ1394.2 +059900* SQ1394.2 +060000**************************************************************** SQ1394.2 +060100* * SQ1394.2 +060200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1394.2 +060300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1394.2 +060400* * SQ1394.2 +060500**************************************************************** SQ1394.2 +060600* SQ1394.2 +060700 SECT-SQ139A-MAIN SECTION. SQ1394.2 +060800* SQ1394.2 +060900* THE FIRST ACTION IS TO CREATE THE FILE BY MEANS OF AN SQ1394.2 +061000* OPEN OUTPUT STATEMENT. SQ1394.2 +061100* SQ1394.2 +061200 SEQ-INIT-01. SQ1394.2 +061300* SQ1394.2 +061400 MOVE 1 TO REC-CT SQ1394.2 +061500 MOVE "CREATE FILE, OPEN OUTPUT" TO FEATURE SQ1394.2 +061600 MOVE "SEQ-TEST-OP-01" TO PAR-NAME SQ1394.2 +061700 MOVE 1 TO DECL-EXEC-SW SQ1394.2 +061800 MOVE "**" TO SQ-FS1-STATUS. SQ1394.2 +061900 SEQ-TEST-OP-01. SQ1394.2 +062000 OPEN OUTPUT SQ-FS1. SQ1394.2 +062100 SEQ-INIT-02. SQ1394.2 +062200 MOVE 1 TO REC-CT SQ1394.2 +062300 MOVE "OPEN OUTPUT ON OPEN FILE" TO FEATURE SQ1394.2 +062400 MOVE "SEQ-TEST-OP-02" TO PAR-NAME SQ1394.2 +062500 MOVE 9 TO DECL-EXEC-SW SQ1394.2 +062600 MOVE "**" TO SQ-FS1-STATUS. SQ1394.2 +062700 SEQ-TEST-OP-02. SQ1394.2 +062800 OPEN OUTPUT SQ-FS1. SQ1394.2 +062900* SQ1394.2 +063000* CHECK EXECUTION OF DECLARATIVE. SQ1394.2 +063100* SQ1394.2 +063200 MOVE "SEQ-TEST-OP-02" TO PAR-NAME. SQ1394.2 +063300 MOVE 1 TO REC-CT. SQ1394.2 +063400 GO TO SEQ-TEST-OP-02-01. SQ1394.2 +063500 SEQ-DELETE-02-01. SQ1394.2 +063600 PERFORM DE-LETE. SQ1394.2 +063700 GO TO SEQ-TEST-02-01-END. SQ1394.2 +063800 SEQ-TEST-OP-02-01. SQ1394.2 +063900 IF DECL-EXEC-SW = 0 SQ1394.2 +064000 PERFORM PASS SQ1394.2 +064100 ELSE SQ1394.2 +064200 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1394.2 +064300 MOVE 0 TO CORRECT-18V0 SQ1394.2 +064400 MOVE "DECLARATIVE NOT EXECUTED" TO RE-MARK SQ1394.2 +064500 MOVE "V11-2, 1.3.5" TO ANSI-REFERENCE SQ1394.2 +064600 PERFORM FAIL. SQ1394.2 +064700 SEQ-TEST-02-01-END. SQ1394.2 +064800 CCVS-EXIT SECTION. SQ1394.2 +064900 CCVS-999999. SQ1394.2 +065000 GO TO CLOSE-FILES. SQ1394.2 diff --git a/tests/cobol85/SQ/SQ140A.CBL b/tests/cobol85/SQ/SQ140A.CBL new file mode 100755 index 00000000..4c443b1a --- /dev/null +++ b/tests/cobol85/SQ/SQ140A.CBL @@ -0,0 +1,658 @@ +000100 IDENTIFICATION DIVISION. SQ1404.2 +000200 PROGRAM-ID. SQ1404.2 +000300 SQ140A. SQ1404.2 +000400**************************************************************** SQ1404.2 +000500* * SQ1404.2 +000600* VALIDATION FOR:- * SQ1404.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1404.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1404.2 +000900* REVISED 1986, AUGUST * SQ1404.2 +001000* * SQ1404.2 +001100* CREATION DATE / VALIDATION DATE * SQ1404.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1404.2 +001300* * SQ1404.2 +001400**************************************************************** SQ1404.2 +001500* * SQ1404.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1404.2 +001700* * SQ1404.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1404.2 +001900* X-55 SYSTEM PRINTER * SQ1404.2 +002000* X-82 SOURCE-COMPUTER * SQ1404.2 +002100* X-83 OBJECT-COMPUTER. * SQ1404.2 +002200* * SQ1404.2 +002300* * SQ1404.2 +002400**************************************************************** SQ1404.2 +002500* * SQ1404.2 +002600* SPLIT FROM SQ125A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1404.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1404.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1404.2 +002900* OPEN FOR OUTPUT FOR A MAGNETIC TAPE FILE WHICH IS ALREADY * SQ1404.2 +003000* OPEN IN THE OUTPUT MODE. (SEE SQ125A). * SQ1404.2 +003100* * SQ1404.2 +003200**************************************************************** SQ1404.2 +003300* SQ1404.2 +003400 ENVIRONMENT DIVISION. SQ1404.2 +003500 CONFIGURATION SECTION. SQ1404.2 +003600 SOURCE-COMPUTER. SQ1404.2 +003700 Linux. SQ1404.2 +003800 OBJECT-COMPUTER. SQ1404.2 +003900 Linux. SQ1404.2 +004000* SQ1404.2 +004100 INPUT-OUTPUT SECTION. SQ1404.2 +004200 FILE-CONTROL. SQ1404.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1404.2 +004400 "report.log". SQ1404.2 +004500* SQ1404.2 +004600*P SELECT RAW-DATA ASSIGN TO SQ1404.2 +004700*P "XXXXX062" SQ1404.2 +004800*P ORGANIZATION IS INDEXED SQ1404.2 +004900*P ACCESS MODE IS RANDOM SQ1404.2 +005000*P RECORD-KEY IS RAW-DATA-KEY. SQ1404.2 +005100*P SQ1404.2 +005200 SELECT SQ-FS1 ASSIGN TO SQ1404.2 +005300 "XXXXX001" SQ1404.2 +005400 FILE STATUS IS SQ-FS1-STATUS. SQ1404.2 +005500* SQ1404.2 +005600* SQ1404.2 +005700 DATA DIVISION. SQ1404.2 +005800 FILE SECTION. SQ1404.2 +005900 FD PRINT-FILE SQ1404.2 +006000*C LABEL RECORDS SQ1404.2 +006100*C OMITTED SQ1404.2 +006200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1404.2 +006300 . SQ1404.2 +006400 01 PRINT-REC PICTURE X(120). SQ1404.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ1404.2 +006600*P SQ1404.2 +006700*PD RAW-DATA. SQ1404.2 +006800*P1 RAW-DATA-SATZ. SQ1404.2 +006900*P 05 RAW-DATA-KEY PIC X(6). SQ1404.2 +007000*P 05 C-DATE PIC 9(6). SQ1404.2 +007100*P 05 C-TIME PIC 9(8). SQ1404.2 +007200*P 05 NO-OF-TESTS PIC 99. SQ1404.2 +007300*P 05 C-OK PIC 999. SQ1404.2 +007400*P 05 C-ALL PIC 999. SQ1404.2 +007500*P 05 C-FAIL PIC 999. SQ1404.2 +007600*P 05 C-DELETED PIC 999. SQ1404.2 +007700*P 05 C-INSPECT PIC 999. SQ1404.2 +007800*P 05 C-NOTE PIC X(13). SQ1404.2 +007900*P 05 C-INDENT PIC X. SQ1404.2 +008000*P 05 C-ABORT PIC X(8). SQ1404.2 +008100* SQ1404.2 +008200 FD SQ-FS1 SQ1404.2 +008300*C LABEL RECORD IS STANDARD SQ1404.2 +008400 . SQ1404.2 +008500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1404.2 +008600* SQ1404.2 +008700 WORKING-STORAGE SECTION. SQ1404.2 +008800* SQ1404.2 +008900*************************************************************** SQ1404.2 +009000* * SQ1404.2 +009100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1404.2 +009200* * SQ1404.2 +009300*************************************************************** SQ1404.2 +009400* SQ1404.2 +009500 01 SQ-FS1-STATUS. SQ1404.2 +009600 03 SQ-FS1-KEY-1 PIC X. SQ1404.2 +009700 03 SQ-FS1-KEY-2 PIC X. SQ1404.2 +009800* SQ1404.2 +009900 01 DECL-EXEC-SW PIC 9. SQ1404.2 +010000* SQ1404.2 +010100* SQ1404.2 +010200*************************************************************** SQ1404.2 +010300* * SQ1404.2 +010400* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1404.2 +010500* * SQ1404.2 +010600*************************************************************** SQ1404.2 +010700* SQ1404.2 +010800 01 REC-SKEL-SUB PIC 99. SQ1404.2 +010900* SQ1404.2 +011000 01 FILE-RECORD-INFORMATION-REC. SQ1404.2 +011100 03 FILE-RECORD-INFO-SKELETON. SQ1404.2 +011200 05 FILLER PICTURE X(48) VALUE SQ1404.2 +011300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1404.2 +011400 05 FILLER PICTURE X(46) VALUE SQ1404.2 +011500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1404.2 +011600 05 FILLER PICTURE X(26) VALUE SQ1404.2 +011700 ",LFIL=000000,ORG= ,LBLR= ". SQ1404.2 +011800 05 FILLER PICTURE X(37) VALUE SQ1404.2 +011900 ",RECKEY= ". SQ1404.2 +012000 05 FILLER PICTURE X(38) VALUE SQ1404.2 +012100 ",ALTKEY1= ". SQ1404.2 +012200 05 FILLER PICTURE X(38) VALUE SQ1404.2 +012300 ",ALTKEY2= ". SQ1404.2 +012400 05 FILLER PICTURE X(7) VALUE SPACE.SQ1404.2 +012500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1404.2 +012600 05 FILE-RECORD-INFO-P1-120. SQ1404.2 +012700 07 FILLER PIC X(5). SQ1404.2 +012800 07 XFILE-NAME PIC X(6). SQ1404.2 +012900 07 FILLER PIC X(8). SQ1404.2 +013000 07 XRECORD-NAME PIC X(6). SQ1404.2 +013100 07 FILLER PIC X(1). SQ1404.2 +013200 07 REELUNIT-NUMBER PIC 9(1). SQ1404.2 +013300 07 FILLER PIC X(7). SQ1404.2 +013400 07 XRECORD-NUMBER PIC 9(6). SQ1404.2 +013500 07 FILLER PIC X(6). SQ1404.2 +013600 07 UPDATE-NUMBER PIC 9(2). SQ1404.2 +013700 07 FILLER PIC X(5). SQ1404.2 +013800 07 ODO-NUMBER PIC 9(4). SQ1404.2 +013900 07 FILLER PIC X(5). SQ1404.2 +014000 07 XPROGRAM-NAME PIC X(5). SQ1404.2 +014100 07 FILLER PIC X(7). SQ1404.2 +014200 07 XRECORD-LENGTH PIC 9(6). SQ1404.2 +014300 07 FILLER PIC X(7). SQ1404.2 +014400 07 CHARS-OR-RECORDS PIC X(2). SQ1404.2 +014500 07 FILLER PIC X(1). SQ1404.2 +014600 07 XBLOCK-SIZE PIC 9(4). SQ1404.2 +014700 07 FILLER PIC X(6). SQ1404.2 +014800 07 RECORDS-IN-FILE PIC 9(6). SQ1404.2 +014900 07 FILLER PIC X(5). SQ1404.2 +015000 07 XFILE-ORGANIZATION PIC X(2). SQ1404.2 +015100 07 FILLER PIC X(6). SQ1404.2 +015200 07 XLABEL-TYPE PIC X(1). SQ1404.2 +015300 05 FILE-RECORD-INFO-P121-240. SQ1404.2 +015400 07 FILLER PIC X(8). SQ1404.2 +015500 07 XRECORD-KEY PIC X(29). SQ1404.2 +015600 07 FILLER PIC X(9). SQ1404.2 +015700 07 ALTERNATE-KEY1 PIC X(29). SQ1404.2 +015800 07 FILLER PIC X(9). SQ1404.2 +015900 07 ALTERNATE-KEY2 PIC X(29). SQ1404.2 +016000 07 FILLER PIC X(7). SQ1404.2 +016100* SQ1404.2 +016200 01 TEST-RESULTS. SQ1404.2 +016300 02 FILLER PIC X VALUE SPACE. SQ1404.2 +016400 02 PAR-NAME. SQ1404.2 +016500 03 FILLER PIC X(14) VALUE SPACE. SQ1404.2 +016600 03 PARDOT-X PIC X VALUE SPACE. SQ1404.2 +016700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1404.2 +016800 02 FILLER PIC X VALUE SPACE. SQ1404.2 +016900 02 FEATURE PIC X(24) VALUE SPACE. SQ1404.2 +017000 02 FILLER PIC X VALUE SPACE. SQ1404.2 +017100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1404.2 +017200 02 FILLER PIC X(9) VALUE SPACE. SQ1404.2 +017300 02 RE-MARK PIC X(61). SQ1404.2 +017400 01 TEST-COMPUTED. SQ1404.2 +017500 02 FILLER PIC X(30) VALUE SPACE. SQ1404.2 +017600 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1404.2 +017700 02 COMPUTED-X. SQ1404.2 +017800 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1404.2 +017900 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1404.2 +018000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1404.2 +018100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1404.2 +018200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1404.2 +018300 03 CM-18V0 REDEFINES COMPUTED-A. SQ1404.2 +018400 04 COMPUTED-18V0 PIC -9(18). SQ1404.2 +018500 04 FILLER PIC X. SQ1404.2 +018600 03 FILLER PIC X(50) VALUE SPACE. SQ1404.2 +018700 01 TEST-CORRECT. SQ1404.2 +018800 02 FILLER PIC X(30) VALUE SPACE. SQ1404.2 +018900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1404.2 +019000 02 CORRECT-X. SQ1404.2 +019100 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1404.2 +019200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1404.2 +019300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1404.2 +019400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1404.2 +019500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1404.2 +019600 03 CR-18V0 REDEFINES CORRECT-A. SQ1404.2 +019700 04 CORRECT-18V0 PIC -9(18). SQ1404.2 +019800 04 FILLER PIC X. SQ1404.2 +019900 03 FILLER PIC X(2) VALUE SPACE. SQ1404.2 +020000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1404.2 +020100* SQ1404.2 +020200 01 CCVS-C-1. SQ1404.2 +020300 02 FILLER PIC IS X VALUE SPACE. SQ1404.2 +020400 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1404.2 +020500 02 FILLER PIC IS X VALUE SPACE. SQ1404.2 +020600 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1404.2 +020700 02 FILLER PIC IS X VALUE SPACE. SQ1404.2 +020800 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1404.2 +020900 02 FILLER PIC IS X(9) VALUE SPACE. SQ1404.2 +021000 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1404.2 +021100 01 CCVS-C-2. SQ1404.2 +021200 02 FILLER PIC X(19) VALUE SPACE. SQ1404.2 +021300 02 FILLER PIC X(6) VALUE "TESTED". SQ1404.2 +021400 02 FILLER PIC X(19) VALUE SPACE. SQ1404.2 +021500 02 FILLER PIC X(4) VALUE "FAIL". SQ1404.2 +021600 02 FILLER PIC X(72) VALUE SPACE. SQ1404.2 +021700* SQ1404.2 +021800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1404.2 +021900 01 REC-CT PIC 99 VALUE ZERO. SQ1404.2 +022000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1404.2 +022100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1404.2 +022200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1404.2 +022300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1404.2 +022400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1404.2 +022500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1404.2 +022600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1404.2 +022700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1404.2 +022800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1404.2 +022900 01 CCVS-H-1. SQ1404.2 +023000 02 FILLER PIC X(39) VALUE SPACES. SQ1404.2 +023100 02 FILLER PIC X(42) VALUE SQ1404.2 +023200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1404.2 +023300 02 FILLER PIC X(39) VALUE SPACES. SQ1404.2 +023400 01 CCVS-H-2A. SQ1404.2 +023500 02 FILLER PIC X(40) VALUE SPACE. SQ1404.2 +023600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1404.2 +023700 02 FILLER PIC XXXX VALUE SQ1404.2 +023800 "4.2 ". SQ1404.2 +023900 02 FILLER PIC X(28) VALUE SQ1404.2 +024000 " COPY - NOT FOR DISTRIBUTION". SQ1404.2 +024100 02 FILLER PIC X(41) VALUE SPACE. SQ1404.2 +024200* SQ1404.2 +024300 01 CCVS-H-2B. SQ1404.2 +024400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1404.2 +024500 02 TEST-ID PIC X(9). SQ1404.2 +024600 02 FILLER PIC X(4) VALUE " IN ". SQ1404.2 +024700 02 FILLER PIC X(12) VALUE SQ1404.2 +024800 " HIGH ". SQ1404.2 +024900 02 FILLER PIC X(22) VALUE SQ1404.2 +025000 " LEVEL VALIDATION FOR ". SQ1404.2 +025100 02 FILLER PIC X(58) VALUE SQ1404.2 +025200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1404.2 +025300 01 CCVS-H-3. SQ1404.2 +025400 02 FILLER PIC X(34) VALUE SQ1404.2 +025500 " FOR OFFICIAL USE ONLY ". SQ1404.2 +025600 02 FILLER PIC X(58) VALUE SQ1404.2 +025700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1404.2 +025800 02 FILLER PIC X(28) VALUE SQ1404.2 +025900 " COPYRIGHT 1985,1986 ". SQ1404.2 +026000 01 CCVS-E-1. SQ1404.2 +026100 02 FILLER PIC X(52) VALUE SPACE. SQ1404.2 +026200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1404.2 +026300 02 ID-AGAIN PIC X(9). SQ1404.2 +026400 02 FILLER PIC X(45) VALUE SPACES. SQ1404.2 +026500 01 CCVS-E-2. SQ1404.2 +026600 02 FILLER PIC X(31) VALUE SPACE. SQ1404.2 +026700 02 FILLER PIC X(21) VALUE SPACE. SQ1404.2 +026800 02 CCVS-E-2-2. SQ1404.2 +026900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1404.2 +027000 03 FILLER PIC X VALUE SPACE. SQ1404.2 +027100 03 ENDER-DESC PIC X(44) VALUE SQ1404.2 +027200 "ERRORS ENCOUNTERED". SQ1404.2 +027300 01 CCVS-E-3. SQ1404.2 +027400 02 FILLER PIC X(22) VALUE SQ1404.2 +027500 " FOR OFFICIAL USE ONLY". SQ1404.2 +027600 02 FILLER PIC X(12) VALUE SPACE. SQ1404.2 +027700 02 FILLER PIC X(58) VALUE SQ1404.2 +027800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1404.2 +027900 02 FILLER PIC X(8) VALUE SPACE. SQ1404.2 +028000 02 FILLER PIC X(20) VALUE SQ1404.2 +028100 " COPYRIGHT 1985,1986". SQ1404.2 +028200 01 CCVS-E-4. SQ1404.2 +028300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1404.2 +028400 02 FILLER PIC X(4) VALUE " OF ". SQ1404.2 +028500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1404.2 +028600 02 FILLER PIC X(40) VALUE SQ1404.2 +028700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1404.2 +028800 01 XXINFO. SQ1404.2 +028900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1404.2 +029000 02 INFO-TEXT. SQ1404.2 +029100 04 FILLER PIC X(8) VALUE SPACE. SQ1404.2 +029200 04 XXCOMPUTED PIC X(20). SQ1404.2 +029300 04 FILLER PIC X(5) VALUE SPACE. SQ1404.2 +029400 04 XXCORRECT PIC X(20). SQ1404.2 +029500 02 INF-ANSI-REFERENCE PIC X(48). SQ1404.2 +029600 01 HYPHEN-LINE. SQ1404.2 +029700 02 FILLER PIC IS X VALUE IS SPACE. SQ1404.2 +029800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1404.2 +029900- "*****************************************". SQ1404.2 +030000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1404.2 +030100- "******************************". SQ1404.2 +030200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1404.2 +030300 "SQ140A". SQ1404.2 +030400* SQ1404.2 +030500* SQ1404.2 +030600 PROCEDURE DIVISION. SQ1404.2 +030700 DECLARATIVES. SQ1404.2 +030800 SQ140A-DECLARATIVE-001-SECT SECTION. SQ1404.2 +030900 USE AFTER STANDARD EXCEPTION PROCEDURE SQ-FS1. SQ1404.2 +031000 INPUT-ERROR-PROCEDURE. SQ1404.2 +031100 IF DECL-EXEC-SW NOT = 9 SQ1404.2 +031200 GO TO NOT-DECL-9. SQ1404.2 +031300* SQ1404.2 +031400* DECLARATIVE PROCEDURE ENTERED FROM SECOND OPEN OUTPUT SQ1404.2 +031500* SQ1404.2 +031600 DECL-OPEN-TEST. SQ1404.2 +031700 MOVE SPACE TO DUMMY-RECORD SQ1404.2 +031800 PERFORM DECL-WRITE-LINE SQ1404.2 +031900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1404.2 +032000 TO DUMMY-RECORD SQ1404.2 +032100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1404.2 +032200 GO TO END-DECLS. SQ1404.2 +032300* SQ1404.2 +032400* SQ1404.2 +032500 NOT-DECL-9. SQ1404.2 +032600 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1404.2 +032700 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1404.2 +032800 MOVE 9 TO CORRECT-18V0. SQ1404.2 +032900 MOVE "UNEXPECTED ENTRY TO DECLARATIVES" TO RE-MARK. SQ1404.2 +033000 PERFORM DECL-FAIL. SQ1404.2 +033100 GO TO END-DECLS. SQ1404.2 +033200* SQ1404.2 +033300* SQ1404.2 +033400* SQ1404.2 +033500 DECL-PASS. SQ1404.2 +033600 MOVE "PASS " TO P-OR-F. SQ1404.2 +033700 ADD 1 TO PASS-COUNTER. SQ1404.2 +033800 PERFORM DECL-PRINT-DETAIL. SQ1404.2 +033900* SQ1404.2 +034000 DECL-FAIL. SQ1404.2 +034100 MOVE "FAIL*" TO P-OR-F. SQ1404.2 +034200 ADD 1 TO ERROR-COUNTER. SQ1404.2 +034300 PERFORM DECL-PRINT-DETAIL. SQ1404.2 +034400* SQ1404.2 +034500 DECL-PRINT-DETAIL. SQ1404.2 +034600 IF REC-CT NOT EQUAL TO ZERO SQ1404.2 +034700 MOVE "." TO PARDOT-X SQ1404.2 +034800 MOVE REC-CT TO DOTVALUE. SQ1404.2 +034900 MOVE TEST-RESULTS TO PRINT-REC. SQ1404.2 +035000 PERFORM DECL-WRITE-LINE. SQ1404.2 +035100 IF P-OR-F EQUAL TO "FAIL*" SQ1404.2 +035200 PERFORM DECL-WRITE-LINE SQ1404.2 +035300 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1404.2 +035400 ELSE SQ1404.2 +035500 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1404.2 +035600 MOVE SPACE TO P-OR-F. SQ1404.2 +035700 MOVE SPACE TO COMPUTED-X. SQ1404.2 +035800 MOVE SPACE TO CORRECT-X. SQ1404.2 +035900 IF REC-CT EQUAL TO ZERO SQ1404.2 +036000 MOVE SPACE TO PAR-NAME. SQ1404.2 +036100 MOVE SPACE TO RE-MARK. SQ1404.2 +036200* SQ1404.2 +036300 DECL-WRITE-LINE. SQ1404.2 +036400 ADD 1 TO RECORD-COUNT. SQ1404.2 +036500 IF RECORD-COUNT GREATER 50 SQ1404.2 +036600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1404.2 +036700 MOVE SPACE TO DUMMY-RECORD SQ1404.2 +036800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1404.2 +036900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1404.2 +037000 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1404.2 +037100 PERFORM DECL-WRT-LN 2 TIMES SQ1404.2 +037200 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1404.2 +037300 PERFORM DECL-WRT-LN SQ1404.2 +037400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1404.2 +037500 MOVE ZERO TO RECORD-COUNT. SQ1404.2 +037600 PERFORM DECL-WRT-LN. SQ1404.2 +037700* SQ1404.2 +037800 DECL-WRT-LN. SQ1404.2 +037900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1404.2 +038000 MOVE SPACE TO DUMMY-RECORD. SQ1404.2 +038100* SQ1404.2 +038200 DECL-FAIL-ROUTINE. SQ1404.2 +038300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1404.2 +038400 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1404.2 +038500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1404.2 +038600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1404.2 +038700 MOVE XXINFO TO DUMMY-RECORD. SQ1404.2 +038800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1404.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1404.2 +039000 GO TO DECL-FAIL-EX. SQ1404.2 +039100 DECL-FAIL-WRITE. SQ1404.2 +039200 MOVE TEST-COMPUTED TO PRINT-REC SQ1404.2 +039300 PERFORM DECL-WRITE-LINE SQ1404.2 +039400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1404.2 +039500 MOVE TEST-CORRECT TO PRINT-REC SQ1404.2 +039600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1404.2 +039700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1404.2 +039800 DECL-FAIL-EX. SQ1404.2 +039900 EXIT. SQ1404.2 +040000* SQ1404.2 +040100 DECL-BAIL. SQ1404.2 +040200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1404.2 +040300 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1404.2 +040400 DECL-BAIL-WRITE. SQ1404.2 +040500 MOVE CORRECT-A TO XXCORRECT. SQ1404.2 +040600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1404.2 +040700 MOVE XXINFO TO DUMMY-RECORD. SQ1404.2 +040800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1404.2 +040900 DECL-BAIL-EX. SQ1404.2 +041000 EXIT. SQ1404.2 +041100* SQ1404.2 +041200 END-DECLS. SQ1404.2 +041300 MOVE ZERO TO DECL-EXEC-SW. SQ1404.2 +041400 END DECLARATIVES. SQ1404.2 +041500* SQ1404.2 +041600* SQ1404.2 +041700 CCVS1 SECTION. SQ1404.2 +041800 OPEN-FILES. SQ1404.2 +041900*P OPEN I-O RAW-DATA. SQ1404.2 +042000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1404.2 +042100*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1404.2 +042200*P MOVE "ABORTED " TO C-ABORT. SQ1404.2 +042300*P ADD 1 TO C-NO-OF-TESTS. SQ1404.2 +042400*P ACCEPT C-DATE FROM DATE. SQ1404.2 +042500*P ACCEPT C-TIME FROM TIME. SQ1404.2 +042600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1404.2 +042700*PND-E-1. SQ1404.2 +042800*P CLOSE RAW-DATA. SQ1404.2 +042900 OPEN OUTPUT PRINT-FILE. SQ1404.2 +043000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1404.2 +043100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1404.2 +043200 MOVE SPACE TO TEST-RESULTS. SQ1404.2 +043300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1404.2 +043400 MOVE ZERO TO REC-SKEL-SUB. SQ1404.2 +043500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1404.2 +043600 GO TO CCVS1-EXIT. SQ1404.2 +043700* SQ1404.2 +043800 CCVS-INIT-FILE. SQ1404.2 +043900 ADD 1 TO REC-SKL-SUB. SQ1404.2 +044000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1404.2 +044100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1404.2 +044200* SQ1404.2 +044300 CLOSE-FILES. SQ1404.2 +044400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1404.2 +044500 CLOSE PRINT-FILE. SQ1404.2 +044600*P OPEN I-O RAW-DATA. SQ1404.2 +044700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1404.2 +044800*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1404.2 +044900*P MOVE "OK. " TO C-ABORT. SQ1404.2 +045000*P MOVE PASS-COUNTER TO C-OK. SQ1404.2 +045100*P MOVE ERROR-HOLD TO C-ALL. SQ1404.2 +045200*P MOVE ERROR-COUNTER TO C-FAIL. SQ1404.2 +045300*P MOVE DELETE-CNT TO C-DELETED. SQ1404.2 +045400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1404.2 +045500*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1404.2 +045600*PND-E-2. SQ1404.2 +045700*P CLOSE RAW-DATA. SQ1404.2 +045800 TERMINATE-CCVS. SQ1404.2 +045900*S EXIT PROGRAM. SQ1404.2 +046000 STOP RUN. SQ1404.2 +046100* SQ1404.2 +046200 INSPT. SQ1404.2 +046300 MOVE "INSPT" TO P-OR-F. SQ1404.2 +046400 ADD 1 TO INSPECT-COUNTER. SQ1404.2 +046500 PERFORM PRINT-DETAIL. SQ1404.2 +046600 SQ1404.2 +046700 PASS. SQ1404.2 +046800 MOVE "PASS " TO P-OR-F. SQ1404.2 +046900 ADD 1 TO PASS-COUNTER. SQ1404.2 +047000 PERFORM PRINT-DETAIL. SQ1404.2 +047100* SQ1404.2 +047200 FAIL. SQ1404.2 +047300 MOVE "FAIL*" TO P-OR-F. SQ1404.2 +047400 ADD 1 TO ERROR-COUNTER. SQ1404.2 +047500 PERFORM PRINT-DETAIL. SQ1404.2 +047600* SQ1404.2 +047700 DE-LETE. SQ1404.2 +047800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1404.2 +047900 MOVE "*****" TO P-OR-F. SQ1404.2 +048000 ADD 1 TO DELETE-COUNTER. SQ1404.2 +048100 PERFORM PRINT-DETAIL. SQ1404.2 +048200* SQ1404.2 +048300 PRINT-DETAIL. SQ1404.2 +048400 IF REC-CT NOT EQUAL TO ZERO SQ1404.2 +048500 MOVE "." TO PARDOT-X SQ1404.2 +048600 MOVE REC-CT TO DOTVALUE. SQ1404.2 +048700 MOVE TEST-RESULTS TO PRINT-REC. SQ1404.2 +048800 PERFORM WRITE-LINE. SQ1404.2 +048900 IF P-OR-F EQUAL TO "FAIL*" SQ1404.2 +049000 PERFORM WRITE-LINE SQ1404.2 +049100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1404.2 +049200 ELSE SQ1404.2 +049300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1404.2 +049400 MOVE SPACE TO P-OR-F. SQ1404.2 +049500 MOVE SPACE TO COMPUTED-X. SQ1404.2 +049600 MOVE SPACE TO CORRECT-X. SQ1404.2 +049700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1404.2 +049800 MOVE SPACE TO RE-MARK. SQ1404.2 +049900* SQ1404.2 +050000 HEAD-ROUTINE. SQ1404.2 +050100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +050200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +050300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1404.2 +050400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1404.2 +050500 COLUMN-NAMES-ROUTINE. SQ1404.2 +050600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1404.2 +050700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +050800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1404.2 +050900 END-ROUTINE. SQ1404.2 +051000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1404.2 +051100 PERFORM WRITE-LINE 5 TIMES. SQ1404.2 +051200 END-RTN-EXIT. SQ1404.2 +051300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1404.2 +051400 PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +051500* SQ1404.2 +051600 END-ROUTINE-1. SQ1404.2 +051700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1404.2 +051800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1404.2 +051900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1404.2 +052000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1404.2 +052100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1404.2 +052200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1404.2 +052300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1404.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1404.2 +052500 PERFORM WRITE-LINE. SQ1404.2 +052600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1404.2 +052700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1404.2 +052800 MOVE "NO " TO ERROR-TOTAL SQ1404.2 +052900 ELSE SQ1404.2 +053000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1404.2 +053100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1404.2 +053200 PERFORM WRITE-LINE. SQ1404.2 +053300 END-ROUTINE-13. SQ1404.2 +053400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1404.2 +053500 MOVE "NO " TO ERROR-TOTAL SQ1404.2 +053600 ELSE SQ1404.2 +053700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1404.2 +053800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1404.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1404.2 +054000 PERFORM WRITE-LINE. SQ1404.2 +054100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1404.2 +054200 MOVE "NO " TO ERROR-TOTAL SQ1404.2 +054300 ELSE SQ1404.2 +054400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1404.2 +054500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1404.2 +054600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1404.2 +054700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1404.2 +054800* SQ1404.2 +054900 WRITE-LINE. SQ1404.2 +055000 ADD 1 TO RECORD-COUNT. SQ1404.2 +055100 IF RECORD-COUNT GREATER 50 SQ1404.2 +055200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1404.2 +055300 MOVE SPACE TO DUMMY-RECORD SQ1404.2 +055400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1404.2 +055500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1404.2 +055600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1404.2 +055700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1404.2 +055800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1404.2 +055900 MOVE ZERO TO RECORD-COUNT. SQ1404.2 +056000 PERFORM WRT-LN. SQ1404.2 +056100* SQ1404.2 +056200 WRT-LN. SQ1404.2 +056300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1404.2 +056400 MOVE SPACE TO DUMMY-RECORD. SQ1404.2 +056500 BLANK-LINE-PRINT. SQ1404.2 +056600 PERFORM WRT-LN. SQ1404.2 +056700 FAIL-ROUTINE. SQ1404.2 +056800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1404.2 +056900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1404.2 +057000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1404.2 +057100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1404.2 +057200 MOVE XXINFO TO DUMMY-RECORD. SQ1404.2 +057300 PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +057400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1404.2 +057500 GO TO FAIL-ROUTINE-EX. SQ1404.2 +057600 FAIL-ROUTINE-WRITE. SQ1404.2 +057700 MOVE TEST-COMPUTED TO PRINT-REC SQ1404.2 +057800 PERFORM WRITE-LINE SQ1404.2 +057900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1404.2 +058000 MOVE TEST-CORRECT TO PRINT-REC SQ1404.2 +058100 PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +058200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1404.2 +058300 FAIL-ROUTINE-EX. SQ1404.2 +058400 EXIT. SQ1404.2 +058500 BAIL-OUT. SQ1404.2 +058600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1404.2 +058700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1404.2 +058800 BAIL-OUT-WRITE. SQ1404.2 +058900 MOVE CORRECT-A TO XXCORRECT. SQ1404.2 +059000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1404.2 +059100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1404.2 +059200 MOVE XXINFO TO DUMMY-RECORD. SQ1404.2 +059300 PERFORM WRITE-LINE 2 TIMES. SQ1404.2 +059400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1404.2 +059500 BAIL-OUT-EX. SQ1404.2 +059600 EXIT. SQ1404.2 +059700 CCVS1-EXIT. SQ1404.2 +059800 EXIT. SQ1404.2 +059900* SQ1404.2 +060000**************************************************************** SQ1404.2 +060100* * SQ1404.2 +060200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1404.2 +060300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1404.2 +060400* * SQ1404.2 +060500**************************************************************** SQ1404.2 +060600* SQ1404.2 +060700 SECT-SQ140A-MAIN SECTION. SQ1404.2 +060800* SQ1404.2 +060900* THE FIRST ACTION IS TO CREATE THE FILE BY MEANS OF AN SQ1404.2 +061000* OPEN OUTPUT STATEMENT. SQ1404.2 +061100* SQ1404.2 +061200 SEQ-INIT-01. SQ1404.2 +061300* SQ1404.2 +061400 MOVE 1 TO REC-CT SQ1404.2 +061500 MOVE "CREATE FILE, OPEN OUTPUT" TO FEATURE SQ1404.2 +061600 MOVE "SEQ-TEST-OP-01" TO PAR-NAME SQ1404.2 +061700 MOVE 1 TO DECL-EXEC-SW SQ1404.2 +061800 MOVE "**" TO SQ-FS1-STATUS. SQ1404.2 +061900 SEQ-TEST-OP-01. SQ1404.2 +062000 OPEN OUTPUT SQ-FS1. SQ1404.2 +062100 SEQ-INIT-02. SQ1404.2 +062200 MOVE 1 TO REC-CT SQ1404.2 +062300 MOVE "OPEN OUTPUT ON OPEN FILE" TO FEATURE SQ1404.2 +062400 MOVE "SEQ-TEST-OP-02" TO PAR-NAME SQ1404.2 +062500 MOVE 9 TO DECL-EXEC-SW SQ1404.2 +062600 MOVE "**" TO SQ-FS1-STATUS. SQ1404.2 +062700 SEQ-TEST-OP-02. SQ1404.2 +062800 OPEN OUTPUT SQ-FS1. SQ1404.2 +062900* SQ1404.2 +063000* CHECK EXECUTION OF DECLARATIVE. SQ1404.2 +063100* SQ1404.2 +063200 MOVE "SEQ-TEST-OP-02" TO PAR-NAME. SQ1404.2 +063300 MOVE 1 TO REC-CT. SQ1404.2 +063400 SEQ-TEST-02-01-END. SQ1404.2 +063500* SQ1404.2 +063600* CHECK THE I-O STATUS VALUE RETURNED BY THE SECOND OPEN. SQ1404.2 +063700* SQ1404.2 +063800 ADD 1 TO REC-CT. SQ1404.2 +063900 GO TO SEQ-TEST-OP-02-02. SQ1404.2 +064000 SEQ-DELETE-02-02. SQ1404.2 +064100 PERFORM DE-LETE. SQ1404.2 +064200 GO TO SEQ-TEST-02-02-END. SQ1404.2 +064300 SEQ-TEST-OP-02-02. SQ1404.2 +064400 IF SQ-FS1-STATUS = "41" SQ1404.2 +064500 PERFORM PASS SQ1404.2 +064600 ELSE SQ1404.2 +064700 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1404.2 +064800 MOVE "41" TO CORRECT-A SQ1404.2 +064900 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN OUTPUT" SQ1404.2 +065000 TO RE-MARK SQ1404.2 +065100 MOVE "VII-4, 1.5.3(4)A" TO ANSI-REFERENCE SQ1404.2 +065200 PERFORM FAIL. SQ1404.2 +065300 SEQ-TEST-02-02-END. SQ1404.2 +065400* SQ1404.2 +065500* SQ1404.2 +065600 CCVS-EXIT SECTION. SQ1404.2 +065700 CCVS-999999. SQ1404.2 +065800 GO TO CLOSE-FILES. SQ1404.2 diff --git a/tests/cobol85/SQ/SQ141A.CBL b/tests/cobol85/SQ/SQ141A.CBL new file mode 100755 index 00000000..b7e85e3c --- /dev/null +++ b/tests/cobol85/SQ/SQ141A.CBL @@ -0,0 +1,625 @@ +000100 IDENTIFICATION DIVISION. SQ1414.2 +000200 PROGRAM-ID. SQ1414.2 +000300 SQ141A. SQ1414.2 +000400**************************************************************** SQ1414.2 +000500* * SQ1414.2 +000600* VALIDATION FOR:- * SQ1414.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1414.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1414.2 +000900* REVISED 1986, AUGUST * SQ1414.2 +001000* * SQ1414.2 +001100* CREATION DATE / VALIDATION DATE * SQ1414.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1414.2 +001300* * SQ1414.2 +001400**************************************************************** SQ1414.2 +001500* * SQ1414.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1414.2 +001700* * SQ1414.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1414.2 +001900* X-55 SYSTEM PRINTER * SQ1414.2 +002000* X-82 SOURCE-COMPUTER * SQ1414.2 +002100* X-83 OBJECT-COMPUTER. * SQ1414.2 +002200* * SQ1414.2 +002300* * SQ1414.2 +002400**************************************************************** SQ1414.2 +002500* * SQ1414.2 +002600* SPLIT FROM SQ129A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1414.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1414.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1414.2 +002900* OPEN FOR INPUT ON A TAPE FILE WHICH IS NOT PRESENT. * SQ1414.2 +003000* (SEE SQ129A). * SQ1414.2 +003100* * SQ1414.2 +003200**************************************************************** SQ1414.2 +003300* SQ1414.2 +003400 ENVIRONMENT DIVISION. SQ1414.2 +003500 CONFIGURATION SECTION. SQ1414.2 +003600 SOURCE-COMPUTER. SQ1414.2 +003700 Linux. SQ1414.2 +003800 OBJECT-COMPUTER. SQ1414.2 +003900 Linux. SQ1414.2 +004000* SQ1414.2 +004100 INPUT-OUTPUT SECTION. SQ1414.2 +004200 FILE-CONTROL. SQ1414.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1414.2 +004400 "report.log". SQ1414.2 +004500* SQ1414.2 +004600*P SELECT RAW-DATA ASSIGN TO SQ1414.2 +004700*P "XXXXX062" SQ1414.2 +004800*P ORGANIZATION IS INDEXED SQ1414.2 +004900*P ACCESS MODE IS RANDOM SQ1414.2 +005000*P RECORD-KEY IS RAW-DATA-KEY. SQ1414.2 +005100*P SQ1414.2 +005200 SELECT SQ-FS1 ASSIGN TO SQ1414.2 +005300 "XXXXX001" SQ1414.2 +005400 FILE STATUS IS SQ-FS1-STATUS. SQ1414.2 +005500* SQ1414.2 +005600* SQ1414.2 +005700 DATA DIVISION. SQ1414.2 +005800 FILE SECTION. SQ1414.2 +005900 FD PRINT-FILE SQ1414.2 +006000*C LABEL RECORDS SQ1414.2 +006100*C OMITTED SQ1414.2 +006200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1414.2 +006300 . SQ1414.2 +006400 01 PRINT-REC PICTURE X(120). SQ1414.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ1414.2 +006600*P SQ1414.2 +006700*PD RAW-DATA. SQ1414.2 +006800*P1 RAW-DATA-SATZ. SQ1414.2 +006900*P 05 RAW-DATA-KEY PIC X(6). SQ1414.2 +007000*P 05 C-DATE PIC 9(6). SQ1414.2 +007100*P 05 C-TIME PIC 9(8). SQ1414.2 +007200*P 05 NO-OF-TESTS PIC 99. SQ1414.2 +007300*P 05 C-OK PIC 999. SQ1414.2 +007400*P 05 C-ALL PIC 999. SQ1414.2 +007500*P 05 C-FAIL PIC 999. SQ1414.2 +007600*P 05 C-DELETED PIC 999. SQ1414.2 +007700*P 05 C-INSPECT PIC 999. SQ1414.2 +007800*P 05 C-NOTE PIC X(13). SQ1414.2 +007900*P 05 C-INDENT PIC X. SQ1414.2 +008000*P 05 C-ABORT PIC X(8). SQ1414.2 +008100* SQ1414.2 +008200 FD SQ-FS1 SQ1414.2 +008300*C LABEL RECORD IS STANDARD SQ1414.2 +008400 . SQ1414.2 +008500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1414.2 +008600* SQ1414.2 +008700 WORKING-STORAGE SECTION. SQ1414.2 +008800* SQ1414.2 +008900*************************************************************** SQ1414.2 +009000* * SQ1414.2 +009100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1414.2 +009200* * SQ1414.2 +009300*************************************************************** SQ1414.2 +009400* SQ1414.2 +009500 01 SQ-FS1-STATUS. SQ1414.2 +009600 03 SQ-FS1-KEY-1 PIC X. SQ1414.2 +009700 03 SQ-FS1-KEY-2 PIC X. SQ1414.2 +009800* SQ1414.2 +009900 01 DECL-EXEC-SW PIC 9. SQ1414.2 +010000* SQ1414.2 +010100*************************************************************** SQ1414.2 +010200* * SQ1414.2 +010300* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1414.2 +010400* * SQ1414.2 +010500*************************************************************** SQ1414.2 +010600* SQ1414.2 +010700 01 REC-SKEL-SUB PIC 99. SQ1414.2 +010800* SQ1414.2 +010900 01 FILE-RECORD-INFORMATION-REC. SQ1414.2 +011000 03 FILE-RECORD-INFO-SKELETON. SQ1414.2 +011100 05 FILLER PICTURE X(48) VALUE SQ1414.2 +011200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1414.2 +011300 05 FILLER PICTURE X(46) VALUE SQ1414.2 +011400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1414.2 +011500 05 FILLER PICTURE X(26) VALUE SQ1414.2 +011600 ",LFIL=000000,ORG= ,LBLR= ". SQ1414.2 +011700 05 FILLER PICTURE X(37) VALUE SQ1414.2 +011800 ",RECKEY= ". SQ1414.2 +011900 05 FILLER PICTURE X(38) VALUE SQ1414.2 +012000 ",ALTKEY1= ". SQ1414.2 +012100 05 FILLER PICTURE X(38) VALUE SQ1414.2 +012200 ",ALTKEY2= ". SQ1414.2 +012300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1414.2 +012400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1414.2 +012500 05 FILE-RECORD-INFO-P1-120. SQ1414.2 +012600 07 FILLER PIC X(5). SQ1414.2 +012700 07 XFILE-NAME PIC X(6). SQ1414.2 +012800 07 FILLER PIC X(8). SQ1414.2 +012900 07 XRECORD-NAME PIC X(6). SQ1414.2 +013000 07 FILLER PIC X(1). SQ1414.2 +013100 07 REELUNIT-NUMBER PIC 9(1). SQ1414.2 +013200 07 FILLER PIC X(7). SQ1414.2 +013300 07 XRECORD-NUMBER PIC 9(6). SQ1414.2 +013400 07 FILLER PIC X(6). SQ1414.2 +013500 07 UPDATE-NUMBER PIC 9(2). SQ1414.2 +013600 07 FILLER PIC X(5). SQ1414.2 +013700 07 ODO-NUMBER PIC 9(4). SQ1414.2 +013800 07 FILLER PIC X(5). SQ1414.2 +013900 07 XPROGRAM-NAME PIC X(5). SQ1414.2 +014000 07 FILLER PIC X(7). SQ1414.2 +014100 07 XRECORD-LENGTH PIC 9(6). SQ1414.2 +014200 07 FILLER PIC X(7). SQ1414.2 +014300 07 CHARS-OR-RECORDS PIC X(2). SQ1414.2 +014400 07 FILLER PIC X(1). SQ1414.2 +014500 07 XBLOCK-SIZE PIC 9(4). SQ1414.2 +014600 07 FILLER PIC X(6). SQ1414.2 +014700 07 RECORDS-IN-FILE PIC 9(6). SQ1414.2 +014800 07 FILLER PIC X(5). SQ1414.2 +014900 07 XFILE-ORGANIZATION PIC X(2). SQ1414.2 +015000 07 FILLER PIC X(6). SQ1414.2 +015100 07 XLABEL-TYPE PIC X(1). SQ1414.2 +015200 05 FILE-RECORD-INFO-P121-240. SQ1414.2 +015300 07 FILLER PIC X(8). SQ1414.2 +015400 07 XRECORD-KEY PIC X(29). SQ1414.2 +015500 07 FILLER PIC X(9). SQ1414.2 +015600 07 ALTERNATE-KEY1 PIC X(29). SQ1414.2 +015700 07 FILLER PIC X(9). SQ1414.2 +015800 07 ALTERNATE-KEY2 PIC X(29). SQ1414.2 +015900 07 FILLER PIC X(7). SQ1414.2 +016000* SQ1414.2 +016100 01 TEST-RESULTS. SQ1414.2 +016200 02 FILLER PIC X VALUE SPACE. SQ1414.2 +016300 02 FEATURE PIC X(24) VALUE SPACE. SQ1414.2 +016400 02 FILLER PIC X VALUE SPACE. SQ1414.2 +016500 02 P-OR-F PIC X(5) VALUE SPACE. SQ1414.2 +016600 02 FILLER PIC X VALUE SPACE. SQ1414.2 +016700 02 PAR-NAME. SQ1414.2 +016800 03 FILLER PIC X(14) VALUE SPACE. SQ1414.2 +016900 03 PARDOT-X PIC X VALUE SPACE. SQ1414.2 +017000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1414.2 +017100 02 FILLER PIC X(9) VALUE SPACE. SQ1414.2 +017200 02 RE-MARK PIC X(61). SQ1414.2 +017300 01 TEST-COMPUTED. SQ1414.2 +017400 02 FILLER PIC X(30) VALUE SPACE. SQ1414.2 +017500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1414.2 +017600 02 COMPUTED-X. SQ1414.2 +017700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1414.2 +017800 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1414.2 +017900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1414.2 +018000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1414.2 +018100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1414.2 +018200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1414.2 +018300 04 COMPUTED-18V0 PIC -9(18). SQ1414.2 +018400 04 FILLER PIC X. SQ1414.2 +018500 03 FILLER PIC X(50) VALUE SPACE. SQ1414.2 +018600 01 TEST-CORRECT. SQ1414.2 +018700 02 FILLER PIC X(30) VALUE SPACE. SQ1414.2 +018800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1414.2 +018900 02 CORRECT-X. SQ1414.2 +019000 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1414.2 +019100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1414.2 +019200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1414.2 +019300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1414.2 +019400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1414.2 +019500 03 CR-18V0 REDEFINES CORRECT-A. SQ1414.2 +019600 04 CORRECT-18V0 PIC -9(18). SQ1414.2 +019700 04 FILLER PIC X. SQ1414.2 +019800 03 FILLER PIC X(2) VALUE SPACE. SQ1414.2 +019900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1414.2 +020000 01 CCVS-C-1. SQ1414.2 +020100 02 FILLER PIC IS X(4) VALUE SPACE. SQ1414.2 +020200 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1414.2 +020300- "SS PARAGRAPH-NAME SQ1414.2 +020400- " REMARKS". SQ1414.2 +020500 02 FILLER PIC X(17) VALUE SPACE. SQ1414.2 +020600 01 CCVS-C-2. SQ1414.2 +020700 02 FILLER PIC XXXX VALUE SPACE. SQ1414.2 +020800 02 FILLER PIC X(6) VALUE "TESTED". SQ1414.2 +020900 02 FILLER PIC X(16) VALUE SPACE. SQ1414.2 +021000 02 FILLER PIC X(4) VALUE "FAIL". SQ1414.2 +021100 02 FILLER PIC X(90) VALUE SPACE. SQ1414.2 +021200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1414.2 +021300 01 REC-CT PIC 99 VALUE ZERO. SQ1414.2 +021400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1414.2 +021500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1414.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1414.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1414.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1414.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1414.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1414.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1414.2 +022200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1414.2 +022300 01 CCVS-H-1. SQ1414.2 +022400 02 FILLER PIC X(39) VALUE SPACES. SQ1414.2 +022500 02 FILLER PIC X(42) VALUE SQ1414.2 +022600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1414.2 +022700 02 FILLER PIC X(39) VALUE SPACES. SQ1414.2 +022800 01 CCVS-H-2A. SQ1414.2 +022900 02 FILLER PIC X(40) VALUE SPACE. SQ1414.2 +023000 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1414.2 +023100 02 FILLER PIC XXXX VALUE SQ1414.2 +023200 "4.2 ". SQ1414.2 +023300 02 FILLER PIC X(28) VALUE SQ1414.2 +023400 " COPY - NOT FOR DISTRIBUTION". SQ1414.2 +023500 02 FILLER PIC X(41) VALUE SPACE. SQ1414.2 +023600* SQ1414.2 +023700 01 CCVS-H-2B. SQ1414.2 +023800 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1414.2 +023900 02 TEST-ID PIC X(9). SQ1414.2 +024000 02 FILLER PIC X(4) VALUE " IN ". SQ1414.2 +024100 02 FILLER PIC X(12) VALUE SQ1414.2 +024200 " HIGH ". SQ1414.2 +024300 02 FILLER PIC X(22) VALUE SQ1414.2 +024400 " LEVEL VALIDATION FOR ". SQ1414.2 +024500 02 FILLER PIC X(58) VALUE SQ1414.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1414.2 +024700 01 CCVS-H-3. SQ1414.2 +024800 02 FILLER PIC X(34) VALUE SQ1414.2 +024900 " FOR OFFICIAL USE ONLY ". SQ1414.2 +025000 02 FILLER PIC X(58) VALUE SQ1414.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1414.2 +025200 02 FILLER PIC X(28) VALUE SQ1414.2 +025300 " COPYRIGHT 1985,1986 ". SQ1414.2 +025400 01 CCVS-E-1. SQ1414.2 +025500 02 FILLER PIC X(52) VALUE SPACE. SQ1414.2 +025600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1414.2 +025700 02 ID-AGAIN PIC X(9). SQ1414.2 +025800 02 FILLER PIC X(45) VALUE SPACES. SQ1414.2 +025900 01 CCVS-E-2. SQ1414.2 +026000 02 FILLER PIC X(31) VALUE SPACE. SQ1414.2 +026100 02 FILLER PIC X(21) VALUE SPACE. SQ1414.2 +026200 02 CCVS-E-2-2. SQ1414.2 +026300 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1414.2 +026400 03 FILLER PIC X VALUE SPACE. SQ1414.2 +026500 03 ENDER-DESC PIC X(44) VALUE SQ1414.2 +026600 "ERRORS ENCOUNTERED". SQ1414.2 +026700 01 CCVS-E-3. SQ1414.2 +026800 02 FILLER PIC X(22) VALUE SQ1414.2 +026900 " FOR OFFICIAL USE ONLY". SQ1414.2 +027000 02 FILLER PIC X(12) VALUE SPACE. SQ1414.2 +027100 02 FILLER PIC X(58) VALUE SQ1414.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1414.2 +027300 02 FILLER PIC X(8) VALUE SPACE. SQ1414.2 +027400 02 FILLER PIC X(20) VALUE SQ1414.2 +027500 " COPYRIGHT 1985,1986". SQ1414.2 +027600 01 CCVS-E-4. SQ1414.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1414.2 +027800 02 FILLER PIC X(4) VALUE " OF ". SQ1414.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1414.2 +028000 02 FILLER PIC X(40) VALUE SQ1414.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1414.2 +028200 01 XXINFO. SQ1414.2 +028300 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1414.2 +028400 02 INFO-TEXT. SQ1414.2 +028500 04 FILLER PIC X(8) VALUE SPACE. SQ1414.2 +028600 04 XXCOMPUTED PIC X(20). SQ1414.2 +028700 04 FILLER PIC X(5) VALUE SPACE. SQ1414.2 +028800 04 XXCORRECT PIC X(20). SQ1414.2 +028900 02 INF-ANSI-REFERENCE PIC X(48). SQ1414.2 +029000 01 HYPHEN-LINE. SQ1414.2 +029100 02 FILLER PIC IS X VALUE IS SPACE. SQ1414.2 +029200 02 FILLER PIC IS X(65) VALUE IS "************************SQ1414.2 +029300- "*****************************************". SQ1414.2 +029400 02 FILLER PIC IS X(54) VALUE IS "************************SQ1414.2 +029500- "******************************". SQ1414.2 +029600 01 CCVS-PGM-ID PIC X(9) VALUE SQ1414.2 +029700 "SQ141A". SQ1414.2 +029800* SQ1414.2 +029900* SQ1414.2 +030000 PROCEDURE DIVISION. SQ1414.2 +030100 DECLARATIVES. SQ1414.2 +030200 SQ141A-DECLARATIVE-001-SECT SECTION. SQ1414.2 +030300 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. SQ1414.2 +030400 INPUT-ERROR-PROCEDURE. SQ1414.2 +030500 IF DECL-EXEC-SW NOT = 9 SQ1414.2 +030600 GO TO NOT-DECL-9. SQ1414.2 +030700* SQ1414.2 +030800* DECLARATIVE PROCEDURE ENTERED FROM OPEN INPUT SQ1414.2 +030900* SQ1414.2 +031000 DECL-OPEN-TEST. SQ1414.2 +031100 MOVE SPACE TO DUMMY-RECORD SQ1414.2 +031200 PERFORM DECL-WRITE-LINE SQ1414.2 +031300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1414.2 +031400 TO DUMMY-RECORD SQ1414.2 +031500 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1414.2 +031600 GO TO END-DECLS. SQ1414.2 +031700* SQ1414.2 +031800* SQ1414.2 +031900 NOT-DECL-9. SQ1414.2 +032000 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1414.2 +032100 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1414.2 +032200 MOVE 9 TO CORRECT-18V0. SQ1414.2 +032300 PERFORM DECL-FAIL. SQ1414.2 +032400 GO TO END-DECLS. SQ1414.2 +032500* SQ1414.2 +032600* SQ1414.2 +032700* SQ1414.2 +032800 DECL-PASS. SQ1414.2 +032900 MOVE "PASS " TO P-OR-F. SQ1414.2 +033000 ADD 1 TO PASS-COUNTER. SQ1414.2 +033100 PERFORM DECL-PRINT-DETAIL. SQ1414.2 +033200* SQ1414.2 +033300 DECL-FAIL. SQ1414.2 +033400 MOVE "FAIL*" TO P-OR-F. SQ1414.2 +033500 ADD 1 TO ERROR-COUNTER. SQ1414.2 +033600 PERFORM DECL-PRINT-DETAIL. SQ1414.2 +033700* SQ1414.2 +033800 DECL-PRINT-DETAIL. SQ1414.2 +033900 IF REC-CT NOT EQUAL TO ZERO SQ1414.2 +034000 MOVE "." TO PARDOT-X SQ1414.2 +034100 MOVE REC-CT TO DOTVALUE. SQ1414.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. SQ1414.2 +034300 PERFORM DECL-WRITE-LINE. SQ1414.2 +034400 IF P-OR-F EQUAL TO "FAIL*" SQ1414.2 +034500 PERFORM DECL-WRITE-LINE SQ1414.2 +034600 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1414.2 +034700 ELSE SQ1414.2 +034800 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1414.2 +034900 MOVE SPACE TO P-OR-F. SQ1414.2 +035000 MOVE SPACE TO COMPUTED-X. SQ1414.2 +035100 MOVE SPACE TO CORRECT-X. SQ1414.2 +035200 IF REC-CT EQUAL TO ZERO SQ1414.2 +035300 MOVE SPACE TO PAR-NAME. SQ1414.2 +035400 MOVE SPACE TO RE-MARK. SQ1414.2 +035500* SQ1414.2 +035600 DECL-WRITE-LINE. SQ1414.2 +035700 ADD 1 TO RECORD-COUNT. SQ1414.2 +035800 IF RECORD-COUNT GREATER 50 SQ1414.2 +035900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1414.2 +036000 MOVE SPACE TO DUMMY-RECORD SQ1414.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1414.2 +036200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1414.2 +036300 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1414.2 +036400 PERFORM DECL-WRT-LN 2 TIMES SQ1414.2 +036500 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1414.2 +036600 PERFORM DECL-WRT-LN SQ1414.2 +036700 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1414.2 +036800 MOVE ZERO TO RECORD-COUNT. SQ1414.2 +036900 PERFORM DECL-WRT-LN. SQ1414.2 +037000* SQ1414.2 +037100 DECL-WRT-LN. SQ1414.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1414.2 +037300 MOVE SPACE TO DUMMY-RECORD. SQ1414.2 +037400* SQ1414.2 +037500 DECL-FAIL-ROUTINE. SQ1414.2 +037600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1414.2 +037700 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1414.2 +037800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1414.2 +037900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1414.2 +038000 MOVE XXINFO TO DUMMY-RECORD. SQ1414.2 +038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1414.2 +038200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1414.2 +038300 GO TO DECL-FAIL-EX. SQ1414.2 +038400 DECL-FAIL-WRITE. SQ1414.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC SQ1414.2 +038600 PERFORM DECL-WRITE-LINE SQ1414.2 +038700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1414.2 +038800 MOVE TEST-CORRECT TO PRINT-REC SQ1414.2 +038900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1414.2 +039000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1414.2 +039100 DECL-FAIL-EX. SQ1414.2 +039200 EXIT. SQ1414.2 +039300* SQ1414.2 +039400 DECL-BAIL. SQ1414.2 +039500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1414.2 +039600 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1414.2 +039700 DECL-BAIL-WRITE. SQ1414.2 +039800 MOVE CORRECT-A TO XXCORRECT. SQ1414.2 +039900 MOVE COMPUTED-A TO XXCOMPUTED. SQ1414.2 +040000 MOVE XXINFO TO DUMMY-RECORD. SQ1414.2 +040100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1414.2 +040200 DECL-BAIL-EX. SQ1414.2 +040300 EXIT. SQ1414.2 +040400* SQ1414.2 +040500 END-DECLS. SQ1414.2 +040600 MOVE ZERO TO DECL-EXEC-SW. SQ1414.2 +040700 END DECLARATIVES. SQ1414.2 +040800* SQ1414.2 +040900* SQ1414.2 +041000 CCVS1 SECTION. SQ1414.2 +041100 OPEN-FILES. SQ1414.2 +041200*P OPEN I-O RAW-DATA. SQ1414.2 +041300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1414.2 +041400*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1414.2 +041500*P MOVE "ABORTED " TO C-ABORT. SQ1414.2 +041600*P ADD 1 TO C-NO-OF-TESTS. SQ1414.2 +041700*P ACCEPT C-DATE FROM DATE. SQ1414.2 +041800*P ACCEPT C-TIME FROM TIME. SQ1414.2 +041900*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1414.2 +042000*PND-E-1. SQ1414.2 +042100*P CLOSE RAW-DATA. SQ1414.2 +042200 OPEN OUTPUT PRINT-FILE. SQ1414.2 +042300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1414.2 +042400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1414.2 +042500 MOVE SPACE TO TEST-RESULTS. SQ1414.2 +042600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1414.2 +042700 MOVE ZERO TO REC-SKEL-SUB. SQ1414.2 +042800 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1414.2 +042900 GO TO CCVS1-EXIT. SQ1414.2 +043000* SQ1414.2 +043100 CCVS-INIT-FILE. SQ1414.2 +043200 ADD 1 TO REC-SKL-SUB. SQ1414.2 +043300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1414.2 +043400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1414.2 +043500* SQ1414.2 +043600 CLOSE-FILES. SQ1414.2 +043700 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1414.2 +043800 CLOSE PRINT-FILE. SQ1414.2 +043900*P OPEN I-O RAW-DATA. SQ1414.2 +044000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1414.2 +044100*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1414.2 +044200*P MOVE "OK. " TO C-ABORT. SQ1414.2 +044300*P MOVE PASS-COUNTER TO C-OK. SQ1414.2 +044400*P MOVE ERROR-HOLD TO C-ALL. SQ1414.2 +044500*P MOVE ERROR-COUNTER TO C-FAIL. SQ1414.2 +044600*P MOVE DELETE-CNT TO C-DELETED. SQ1414.2 +044700*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1414.2 +044800*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1414.2 +044900*PND-E-2. SQ1414.2 +045000*P CLOSE RAW-DATA. SQ1414.2 +045100 TERMINATE-CCVS. SQ1414.2 +045200*S EXIT PROGRAM. SQ1414.2 +045300 STOP RUN. SQ1414.2 +045400* SQ1414.2 +045500 INSPT. SQ1414.2 +045600 MOVE "INSPT" TO P-OR-F. SQ1414.2 +045700 ADD 1 TO INSPECT-COUNTER. SQ1414.2 +045800 PERFORM PRINT-DETAIL. SQ1414.2 +045900 SQ1414.2 +046000 PASS. SQ1414.2 +046100 MOVE "PASS " TO P-OR-F. SQ1414.2 +046200 ADD 1 TO PASS-COUNTER. SQ1414.2 +046300 PERFORM PRINT-DETAIL. SQ1414.2 +046400* SQ1414.2 +046500 FAIL. SQ1414.2 +046600 MOVE "FAIL*" TO P-OR-F. SQ1414.2 +046700 ADD 1 TO ERROR-COUNTER. SQ1414.2 +046800 PERFORM PRINT-DETAIL. SQ1414.2 +046900* SQ1414.2 +047000 DE-LETE. SQ1414.2 +047100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1414.2 +047200 MOVE "*****" TO P-OR-F. SQ1414.2 +047300 ADD 1 TO DELETE-COUNTER. SQ1414.2 +047400 PERFORM PRINT-DETAIL. SQ1414.2 +047500* SQ1414.2 +047600 PRINT-DETAIL. SQ1414.2 +047700 IF REC-CT NOT EQUAL TO ZERO SQ1414.2 +047800 MOVE "." TO PARDOT-X SQ1414.2 +047900 MOVE REC-CT TO DOTVALUE. SQ1414.2 +048000 MOVE TEST-RESULTS TO PRINT-REC. SQ1414.2 +048100 PERFORM WRITE-LINE. SQ1414.2 +048200 IF P-OR-F EQUAL TO "FAIL*" SQ1414.2 +048300 PERFORM WRITE-LINE SQ1414.2 +048400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1414.2 +048500 ELSE SQ1414.2 +048600 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1414.2 +048700 MOVE SPACE TO P-OR-F. SQ1414.2 +048800 MOVE SPACE TO COMPUTED-X. SQ1414.2 +048900 MOVE SPACE TO CORRECT-X. SQ1414.2 +049000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1414.2 +049100 MOVE SPACE TO RE-MARK. SQ1414.2 +049200* SQ1414.2 +049300 HEAD-ROUTINE. SQ1414.2 +049400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +049500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +049600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1414.2 +049700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1414.2 +049800 COLUMN-NAMES-ROUTINE. SQ1414.2 +049900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1414.2 +050000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +050100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1414.2 +050200 END-ROUTINE. SQ1414.2 +050300 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1414.2 +050400 PERFORM WRITE-LINE 5 TIMES. SQ1414.2 +050500 END-RTN-EXIT. SQ1414.2 +050600 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1414.2 +050700 PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +050800* SQ1414.2 +050900 END-ROUTINE-1. SQ1414.2 +051000 ADD ERROR-COUNTER TO ERROR-HOLD SQ1414.2 +051100 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1414.2 +051200 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1414.2 +051300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1414.2 +051400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1414.2 +051500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1414.2 +051600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1414.2 +051700 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1414.2 +051800 PERFORM WRITE-LINE. SQ1414.2 +051900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1414.2 +052000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1414.2 +052100 MOVE "NO " TO ERROR-TOTAL SQ1414.2 +052200 ELSE SQ1414.2 +052300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1414.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1414.2 +052500 PERFORM WRITE-LINE. SQ1414.2 +052600 END-ROUTINE-13. SQ1414.2 +052700 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1414.2 +052800 MOVE "NO " TO ERROR-TOTAL SQ1414.2 +052900 ELSE SQ1414.2 +053000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1414.2 +053100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1414.2 +053200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1414.2 +053300 PERFORM WRITE-LINE. SQ1414.2 +053400 IF INSPECT-COUNTER EQUAL TO ZERO SQ1414.2 +053500 MOVE "NO " TO ERROR-TOTAL SQ1414.2 +053600 ELSE SQ1414.2 +053700 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1414.2 +053800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1414.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1414.2 +054000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1414.2 +054100* SQ1414.2 +054200 WRITE-LINE. SQ1414.2 +054300 ADD 1 TO RECORD-COUNT. SQ1414.2 +054400 IF RECORD-COUNT GREATER 50 SQ1414.2 +054500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1414.2 +054600 MOVE SPACE TO DUMMY-RECORD SQ1414.2 +054700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1414.2 +054800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1414.2 +054900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1414.2 +055000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1414.2 +055100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1414.2 +055200 MOVE ZERO TO RECORD-COUNT. SQ1414.2 +055300 PERFORM WRT-LN. SQ1414.2 +055400* SQ1414.2 +055500 WRT-LN. SQ1414.2 +055600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1414.2 +055700 MOVE SPACE TO DUMMY-RECORD. SQ1414.2 +055800 BLANK-LINE-PRINT. SQ1414.2 +055900 PERFORM WRT-LN. SQ1414.2 +056000 FAIL-ROUTINE. SQ1414.2 +056100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1414.2 +056200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1414.2 +056300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1414.2 +056400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1414.2 +056500 MOVE XXINFO TO DUMMY-RECORD. SQ1414.2 +056600 PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +056700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1414.2 +056800 GO TO FAIL-ROUTINE-EX. SQ1414.2 +056900 FAIL-ROUTINE-WRITE. SQ1414.2 +057000 MOVE TEST-COMPUTED TO PRINT-REC SQ1414.2 +057100 PERFORM WRITE-LINE SQ1414.2 +057200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1414.2 +057300 MOVE TEST-CORRECT TO PRINT-REC SQ1414.2 +057400 PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +057500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1414.2 +057600 FAIL-ROUTINE-EX. SQ1414.2 +057700 EXIT. SQ1414.2 +057800 BAIL-OUT. SQ1414.2 +057900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1414.2 +058000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1414.2 +058100 BAIL-OUT-WRITE. SQ1414.2 +058200 MOVE CORRECT-A TO XXCORRECT. SQ1414.2 +058300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1414.2 +058400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1414.2 +058500 MOVE XXINFO TO DUMMY-RECORD. SQ1414.2 +058600 PERFORM WRITE-LINE 2 TIMES. SQ1414.2 +058700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1414.2 +058800 BAIL-OUT-EX. SQ1414.2 +058900 EXIT. SQ1414.2 +059000 CCVS1-EXIT. SQ1414.2 +059100 EXIT. SQ1414.2 +059200* SQ1414.2 +059300**************************************************************** SQ1414.2 +059400* * SQ1414.2 +059500* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1414.2 +059600* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1414.2 +059700* * SQ1414.2 +059800**************************************************************** SQ1414.2 +059900* SQ1414.2 +060000 SECT-SQ141A-MAIN SECTION. SQ1414.2 +060100 OPEN-INIT-01. SQ1414.2 +060200* SQ1414.2 +060300* THIS PROGRAM ATTEMPTS TO OPEN A FILE WHICH IS NOT SQ1414.2 +060400* PRESENT AND AVAILABLE TO IT. SQ1414.2 +060500* SQ1414.2 +060600 MOVE 1 TO REC-CT SQ1414.2 +060700 MOVE "OPEN ABSENT FILE INPUT" TO FEATURE SQ1414.2 +060800 MOVE "OPEN-TEST-01" TO PAR-NAME SQ1414.2 +060900 MOVE 9 TO DECL-EXEC-SW SQ1414.2 +061000 MOVE "**" TO SQ-FS1-STATUS. SQ1414.2 +061100 OPEN-TEST-01. SQ1414.2 +061200 OPEN INPUT SQ-FS1. SQ1414.2 +061300 MOVE "OPEN-TEST-01" TO PAR-NAME. SQ1414.2 +061400 MOVE 1 TO REC-CT. SQ1414.2 +061500 IF DECL-EXEC-SW = 0 SQ1414.2 +061600 PERFORM PASS SQ1414.2 +061700 ELSE SQ1414.2 +061800 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ1414.2 +061900 MOVE ZERO TO CORRECT-18V0 SQ1414.2 +062000 MOVE "DECLARATIVE NOT EXECUTED" TO RE-MARK SQ1414.2 +062100 MOVE "V11-2, 1.3.5" TO ANSI-REFERENCE SQ1414.2 +062200 PERFORM FAIL. SQ1414.2 +062300 CCVS-EXIT SECTION. SQ1414.2 +062400 CCVS-999999. SQ1414.2 +062500 GO TO CLOSE-FILES. SQ1414.2 diff --git a/tests/cobol85/SQ/SQ142A.CBL b/tests/cobol85/SQ/SQ142A.CBL new file mode 100755 index 00000000..d9bc1dd1 --- /dev/null +++ b/tests/cobol85/SQ/SQ142A.CBL @@ -0,0 +1,628 @@ +000100 IDENTIFICATION DIVISION. SQ1424.2 +000200 PROGRAM-ID. SQ1424.2 +000300 SQ142A. SQ1424.2 +000400**************************************************************** SQ1424.2 +000500* * SQ1424.2 +000600* VALIDATION FOR:- * SQ1424.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1424.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1424.2 +000900* REVISED 1986, AUGUST * SQ1424.2 +001000* * SQ1424.2 +001100* CREATION DATE / VALIDATION DATE * SQ1424.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1424.2 +001300* * SQ1424.2 +001400**************************************************************** SQ1424.2 +001500* * SQ1424.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1424.2 +001700* * SQ1424.2 +001800* X-01 SEQUENTIAL MAGNETIC TAPE FILE. * SQ1424.2 +001900* X-55 SYSTEM PRINTER * SQ1424.2 +002000* X-82 SOURCE-COMPUTER * SQ1424.2 +002100* X-83 OBJECT-COMPUTER. * SQ1424.2 +002200* * SQ1424.2 +002300* * SQ1424.2 +002400**************************************************************** SQ1424.2 +002500* * SQ1424.2 +002600* SPLIT FROM SQ129A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1424.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1424.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1424.2 +002900* OPEN FOR INPUT ON A TAPE FILE WHICH IS NOT PRESENT. * SQ1424.2 +003000* (SEE SQ129A). * SQ1424.2 +003100* * SQ1424.2 +003200**************************************************************** SQ1424.2 +003300* SQ1424.2 +003400 ENVIRONMENT DIVISION. SQ1424.2 +003500 CONFIGURATION SECTION. SQ1424.2 +003600 SOURCE-COMPUTER. SQ1424.2 +003700 Linux. SQ1424.2 +003800 OBJECT-COMPUTER. SQ1424.2 +003900 Linux. SQ1424.2 +004000* SQ1424.2 +004100 INPUT-OUTPUT SECTION. SQ1424.2 +004200 FILE-CONTROL. SQ1424.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1424.2 +004400 "report.log". SQ1424.2 +004500* SQ1424.2 +004600*P SELECT RAW-DATA ASSIGN TO SQ1424.2 +004700*P "XXXXX062" SQ1424.2 +004800*P ORGANIZATION IS INDEXED SQ1424.2 +004900*P ACCESS MODE IS RANDOM SQ1424.2 +005000*P RECORD-KEY IS RAW-DATA-KEY. SQ1424.2 +005100*P SQ1424.2 +005200 SELECT SQ-FS1 ASSIGN TO SQ1424.2 +005300 "XXXXX001" SQ1424.2 +005400 FILE STATUS IS SQ-FS1-STATUS. SQ1424.2 +005500* SQ1424.2 +005600* SQ1424.2 +005700 DATA DIVISION. SQ1424.2 +005800 FILE SECTION. SQ1424.2 +005900 FD PRINT-FILE SQ1424.2 +006000*C LABEL RECORDS SQ1424.2 +006100*C OMITTED SQ1424.2 +006200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1424.2 +006300 . SQ1424.2 +006400 01 PRINT-REC PICTURE X(120). SQ1424.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ1424.2 +006600*P SQ1424.2 +006700*PD RAW-DATA. SQ1424.2 +006800*P1 RAW-DATA-SATZ. SQ1424.2 +006900*P 05 RAW-DATA-KEY PIC X(6). SQ1424.2 +007000*P 05 C-DATE PIC 9(6). SQ1424.2 +007100*P 05 C-TIME PIC 9(8). SQ1424.2 +007200*P 05 NO-OF-TESTS PIC 99. SQ1424.2 +007300*P 05 C-OK PIC 999. SQ1424.2 +007400*P 05 C-ALL PIC 999. SQ1424.2 +007500*P 05 C-FAIL PIC 999. SQ1424.2 +007600*P 05 C-DELETED PIC 999. SQ1424.2 +007700*P 05 C-INSPECT PIC 999. SQ1424.2 +007800*P 05 C-NOTE PIC X(13). SQ1424.2 +007900*P 05 C-INDENT PIC X. SQ1424.2 +008000*P 05 C-ABORT PIC X(8). SQ1424.2 +008100* SQ1424.2 +008200 FD SQ-FS1 SQ1424.2 +008300*C LABEL RECORD IS STANDARD SQ1424.2 +008400 . SQ1424.2 +008500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1424.2 +008600* SQ1424.2 +008700 WORKING-STORAGE SECTION. SQ1424.2 +008800* SQ1424.2 +008900*************************************************************** SQ1424.2 +009000* * SQ1424.2 +009100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1424.2 +009200* * SQ1424.2 +009300*************************************************************** SQ1424.2 +009400* SQ1424.2 +009500 01 SQ-FS1-STATUS. SQ1424.2 +009600 03 SQ-FS1-KEY-1 PIC X. SQ1424.2 +009700 03 SQ-FS1-KEY-2 PIC X. SQ1424.2 +009800* SQ1424.2 +009900 01 DECL-EXEC-SW PIC 9. SQ1424.2 +010000* SQ1424.2 +010100*************************************************************** SQ1424.2 +010200* * SQ1424.2 +010300* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1424.2 +010400* * SQ1424.2 +010500*************************************************************** SQ1424.2 +010600* SQ1424.2 +010700 01 REC-SKEL-SUB PIC 99. SQ1424.2 +010800* SQ1424.2 +010900 01 FILE-RECORD-INFORMATION-REC. SQ1424.2 +011000 03 FILE-RECORD-INFO-SKELETON. SQ1424.2 +011100 05 FILLER PICTURE X(48) VALUE SQ1424.2 +011200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1424.2 +011300 05 FILLER PICTURE X(46) VALUE SQ1424.2 +011400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1424.2 +011500 05 FILLER PICTURE X(26) VALUE SQ1424.2 +011600 ",LFIL=000000,ORG= ,LBLR= ". SQ1424.2 +011700 05 FILLER PICTURE X(37) VALUE SQ1424.2 +011800 ",RECKEY= ". SQ1424.2 +011900 05 FILLER PICTURE X(38) VALUE SQ1424.2 +012000 ",ALTKEY1= ". SQ1424.2 +012100 05 FILLER PICTURE X(38) VALUE SQ1424.2 +012200 ",ALTKEY2= ". SQ1424.2 +012300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1424.2 +012400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1424.2 +012500 05 FILE-RECORD-INFO-P1-120. SQ1424.2 +012600 07 FILLER PIC X(5). SQ1424.2 +012700 07 XFILE-NAME PIC X(6). SQ1424.2 +012800 07 FILLER PIC X(8). SQ1424.2 +012900 07 XRECORD-NAME PIC X(6). SQ1424.2 +013000 07 FILLER PIC X(1). SQ1424.2 +013100 07 REELUNIT-NUMBER PIC 9(1). SQ1424.2 +013200 07 FILLER PIC X(7). SQ1424.2 +013300 07 XRECORD-NUMBER PIC 9(6). SQ1424.2 +013400 07 FILLER PIC X(6). SQ1424.2 +013500 07 UPDATE-NUMBER PIC 9(2). SQ1424.2 +013600 07 FILLER PIC X(5). SQ1424.2 +013700 07 ODO-NUMBER PIC 9(4). SQ1424.2 +013800 07 FILLER PIC X(5). SQ1424.2 +013900 07 XPROGRAM-NAME PIC X(5). SQ1424.2 +014000 07 FILLER PIC X(7). SQ1424.2 +014100 07 XRECORD-LENGTH PIC 9(6). SQ1424.2 +014200 07 FILLER PIC X(7). SQ1424.2 +014300 07 CHARS-OR-RECORDS PIC X(2). SQ1424.2 +014400 07 FILLER PIC X(1). SQ1424.2 +014500 07 XBLOCK-SIZE PIC 9(4). SQ1424.2 +014600 07 FILLER PIC X(6). SQ1424.2 +014700 07 RECORDS-IN-FILE PIC 9(6). SQ1424.2 +014800 07 FILLER PIC X(5). SQ1424.2 +014900 07 XFILE-ORGANIZATION PIC X(2). SQ1424.2 +015000 07 FILLER PIC X(6). SQ1424.2 +015100 07 XLABEL-TYPE PIC X(1). SQ1424.2 +015200 05 FILE-RECORD-INFO-P121-240. SQ1424.2 +015300 07 FILLER PIC X(8). SQ1424.2 +015400 07 XRECORD-KEY PIC X(29). SQ1424.2 +015500 07 FILLER PIC X(9). SQ1424.2 +015600 07 ALTERNATE-KEY1 PIC X(29). SQ1424.2 +015700 07 FILLER PIC X(9). SQ1424.2 +015800 07 ALTERNATE-KEY2 PIC X(29). SQ1424.2 +015900 07 FILLER PIC X(7). SQ1424.2 +016000* SQ1424.2 +016100 01 TEST-RESULTS. SQ1424.2 +016200 02 FILLER PIC X VALUE SPACE. SQ1424.2 +016300 02 FEATURE PIC X(24) VALUE SPACE. SQ1424.2 +016400 02 FILLER PIC X VALUE SPACE. SQ1424.2 +016500 02 P-OR-F PIC X(5) VALUE SPACE. SQ1424.2 +016600 02 FILLER PIC X VALUE SPACE. SQ1424.2 +016700 02 PAR-NAME. SQ1424.2 +016800 03 FILLER PIC X(14) VALUE SPACE. SQ1424.2 +016900 03 PARDOT-X PIC X VALUE SPACE. SQ1424.2 +017000 03 DOTVALUE PIC 99 VALUE ZERO. SQ1424.2 +017100 02 FILLER PIC X(9) VALUE SPACE. SQ1424.2 +017200 02 RE-MARK PIC X(61). SQ1424.2 +017300 01 TEST-COMPUTED. SQ1424.2 +017400 02 FILLER PIC X(30) VALUE SPACE. SQ1424.2 +017500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1424.2 +017600 02 COMPUTED-X. SQ1424.2 +017700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1424.2 +017800 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1424.2 +017900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1424.2 +018000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1424.2 +018100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1424.2 +018200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1424.2 +018300 04 COMPUTED-18V0 PIC -9(18). SQ1424.2 +018400 04 FILLER PIC X. SQ1424.2 +018500 03 FILLER PIC X(50) VALUE SPACE. SQ1424.2 +018600 01 TEST-CORRECT. SQ1424.2 +018700 02 FILLER PIC X(30) VALUE SPACE. SQ1424.2 +018800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1424.2 +018900 02 CORRECT-X. SQ1424.2 +019000 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1424.2 +019100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1424.2 +019200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1424.2 +019300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1424.2 +019400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1424.2 +019500 03 CR-18V0 REDEFINES CORRECT-A. SQ1424.2 +019600 04 CORRECT-18V0 PIC -9(18). SQ1424.2 +019700 04 FILLER PIC X. SQ1424.2 +019800 03 FILLER PIC X(2) VALUE SPACE. SQ1424.2 +019900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1424.2 +020000 01 CCVS-C-1. SQ1424.2 +020100 02 FILLER PIC IS X(4) VALUE SPACE. SQ1424.2 +020200 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1424.2 +020300- "SS PARAGRAPH-NAME SQ1424.2 +020400- " REMARKS". SQ1424.2 +020500 02 FILLER PIC X(17) VALUE SPACE. SQ1424.2 +020600 01 CCVS-C-2. SQ1424.2 +020700 02 FILLER PIC XXXX VALUE SPACE. SQ1424.2 +020800 02 FILLER PIC X(6) VALUE "TESTED". SQ1424.2 +020900 02 FILLER PIC X(16) VALUE SPACE. SQ1424.2 +021000 02 FILLER PIC X(4) VALUE "FAIL". SQ1424.2 +021100 02 FILLER PIC X(90) VALUE SPACE. SQ1424.2 +021200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1424.2 +021300 01 REC-CT PIC 99 VALUE ZERO. SQ1424.2 +021400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1424.2 +021500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1424.2 +021600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1424.2 +021700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1424.2 +021800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1424.2 +021900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1424.2 +022000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1424.2 +022100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1424.2 +022200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1424.2 +022300 01 CCVS-H-1. SQ1424.2 +022400 02 FILLER PIC X(39) VALUE SPACES. SQ1424.2 +022500 02 FILLER PIC X(42) VALUE SQ1424.2 +022600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1424.2 +022700 02 FILLER PIC X(39) VALUE SPACES. SQ1424.2 +022800 01 CCVS-H-2A. SQ1424.2 +022900 02 FILLER PIC X(40) VALUE SPACE. SQ1424.2 +023000 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1424.2 +023100 02 FILLER PIC XXXX VALUE SQ1424.2 +023200 "4.2 ". SQ1424.2 +023300 02 FILLER PIC X(28) VALUE SQ1424.2 +023400 " COPY - NOT FOR DISTRIBUTION". SQ1424.2 +023500 02 FILLER PIC X(41) VALUE SPACE. SQ1424.2 +023600* SQ1424.2 +023700 01 CCVS-H-2B. SQ1424.2 +023800 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1424.2 +023900 02 TEST-ID PIC X(9). SQ1424.2 +024000 02 FILLER PIC X(4) VALUE " IN ". SQ1424.2 +024100 02 FILLER PIC X(12) VALUE SQ1424.2 +024200 " HIGH ". SQ1424.2 +024300 02 FILLER PIC X(22) VALUE SQ1424.2 +024400 " LEVEL VALIDATION FOR ". SQ1424.2 +024500 02 FILLER PIC X(58) VALUE SQ1424.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1424.2 +024700 01 CCVS-H-3. SQ1424.2 +024800 02 FILLER PIC X(34) VALUE SQ1424.2 +024900 " FOR OFFICIAL USE ONLY ". SQ1424.2 +025000 02 FILLER PIC X(58) VALUE SQ1424.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1424.2 +025200 02 FILLER PIC X(28) VALUE SQ1424.2 +025300 " COPYRIGHT 1985,1986 ". SQ1424.2 +025400 01 CCVS-E-1. SQ1424.2 +025500 02 FILLER PIC X(52) VALUE SPACE. SQ1424.2 +025600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1424.2 +025700 02 ID-AGAIN PIC X(9). SQ1424.2 +025800 02 FILLER PIC X(45) VALUE SPACES. SQ1424.2 +025900 01 CCVS-E-2. SQ1424.2 +026000 02 FILLER PIC X(31) VALUE SPACE. SQ1424.2 +026100 02 FILLER PIC X(21) VALUE SPACE. SQ1424.2 +026200 02 CCVS-E-2-2. SQ1424.2 +026300 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1424.2 +026400 03 FILLER PIC X VALUE SPACE. SQ1424.2 +026500 03 ENDER-DESC PIC X(44) VALUE SQ1424.2 +026600 "ERRORS ENCOUNTERED". SQ1424.2 +026700 01 CCVS-E-3. SQ1424.2 +026800 02 FILLER PIC X(22) VALUE SQ1424.2 +026900 " FOR OFFICIAL USE ONLY". SQ1424.2 +027000 02 FILLER PIC X(12) VALUE SPACE. SQ1424.2 +027100 02 FILLER PIC X(58) VALUE SQ1424.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1424.2 +027300 02 FILLER PIC X(8) VALUE SPACE. SQ1424.2 +027400 02 FILLER PIC X(20) VALUE SQ1424.2 +027500 " COPYRIGHT 1985,1986". SQ1424.2 +027600 01 CCVS-E-4. SQ1424.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1424.2 +027800 02 FILLER PIC X(4) VALUE " OF ". SQ1424.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1424.2 +028000 02 FILLER PIC X(40) VALUE SQ1424.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1424.2 +028200 01 XXINFO. SQ1424.2 +028300 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1424.2 +028400 02 INFO-TEXT. SQ1424.2 +028500 04 FILLER PIC X(8) VALUE SPACE. SQ1424.2 +028600 04 XXCOMPUTED PIC X(20). SQ1424.2 +028700 04 FILLER PIC X(5) VALUE SPACE. SQ1424.2 +028800 04 XXCORRECT PIC X(20). SQ1424.2 +028900 02 INF-ANSI-REFERENCE PIC X(48). SQ1424.2 +029000 01 HYPHEN-LINE. SQ1424.2 +029100 02 FILLER PIC IS X VALUE IS SPACE. SQ1424.2 +029200 02 FILLER PIC IS X(65) VALUE IS "************************SQ1424.2 +029300- "*****************************************". SQ1424.2 +029400 02 FILLER PIC IS X(54) VALUE IS "************************SQ1424.2 +029500- "******************************". SQ1424.2 +029600 01 CCVS-PGM-ID PIC X(9) VALUE SQ1424.2 +029700 "SQ142A". SQ1424.2 +029800* SQ1424.2 +029900* SQ1424.2 +030000 PROCEDURE DIVISION. SQ1424.2 +030100 DECLARATIVES. SQ1424.2 +030200 SQ142A-DECLARATIVE-001-SECT SECTION. SQ1424.2 +030300 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. SQ1424.2 +030400 INPUT-ERROR-PROCEDURE. SQ1424.2 +030500 IF DECL-EXEC-SW NOT = 9 SQ1424.2 +030600 GO TO NOT-DECL-9. SQ1424.2 +030700* SQ1424.2 +030800* DECLARATIVE PROCEDURE ENTERED FROM OPEN INPUT SQ1424.2 +030900* SQ1424.2 +031000 DECL-OPEN-TEST. SQ1424.2 +031100 MOVE SPACE TO DUMMY-RECORD SQ1424.2 +031200 PERFORM DECL-WRITE-LINE SQ1424.2 +031300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1424.2 +031400 TO DUMMY-RECORD SQ1424.2 +031500 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1424.2 +031600 GO TO END-DECLS. SQ1424.2 +031700* SQ1424.2 +031800* SQ1424.2 +031900 NOT-DECL-9. SQ1424.2 +032000 MOVE "NOT-DECL-9" TO PAR-NAME. SQ1424.2 +032100 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ1424.2 +032200 MOVE 9 TO CORRECT-18V0. SQ1424.2 +032300 PERFORM DECL-FAIL. SQ1424.2 +032400 GO TO END-DECLS. SQ1424.2 +032500* SQ1424.2 +032600* SQ1424.2 +032700* SQ1424.2 +032800 DECL-PASS. SQ1424.2 +032900 MOVE "PASS " TO P-OR-F. SQ1424.2 +033000 ADD 1 TO PASS-COUNTER. SQ1424.2 +033100 PERFORM DECL-PRINT-DETAIL. SQ1424.2 +033200* SQ1424.2 +033300 DECL-FAIL. SQ1424.2 +033400 MOVE "FAIL*" TO P-OR-F. SQ1424.2 +033500 ADD 1 TO ERROR-COUNTER. SQ1424.2 +033600 PERFORM DECL-PRINT-DETAIL. SQ1424.2 +033700* SQ1424.2 +033800 DECL-PRINT-DETAIL. SQ1424.2 +033900 IF REC-CT NOT EQUAL TO ZERO SQ1424.2 +034000 MOVE "." TO PARDOT-X SQ1424.2 +034100 MOVE REC-CT TO DOTVALUE. SQ1424.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. SQ1424.2 +034300 PERFORM DECL-WRITE-LINE. SQ1424.2 +034400 IF P-OR-F EQUAL TO "FAIL*" SQ1424.2 +034500 PERFORM DECL-WRITE-LINE SQ1424.2 +034600 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1424.2 +034700 ELSE SQ1424.2 +034800 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1424.2 +034900 MOVE SPACE TO P-OR-F. SQ1424.2 +035000 MOVE SPACE TO COMPUTED-X. SQ1424.2 +035100 MOVE SPACE TO CORRECT-X. SQ1424.2 +035200 IF REC-CT EQUAL TO ZERO SQ1424.2 +035300 MOVE SPACE TO PAR-NAME. SQ1424.2 +035400 MOVE SPACE TO RE-MARK. SQ1424.2 +035500* SQ1424.2 +035600 DECL-WRITE-LINE. SQ1424.2 +035700 ADD 1 TO RECORD-COUNT. SQ1424.2 +035800 IF RECORD-COUNT GREATER 50 SQ1424.2 +035900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1424.2 +036000 MOVE SPACE TO DUMMY-RECORD SQ1424.2 +036100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1424.2 +036200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1424.2 +036300 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1424.2 +036400 PERFORM DECL-WRT-LN 2 TIMES SQ1424.2 +036500 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1424.2 +036600 PERFORM DECL-WRT-LN SQ1424.2 +036700 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1424.2 +036800 MOVE ZERO TO RECORD-COUNT. SQ1424.2 +036900 PERFORM DECL-WRT-LN. SQ1424.2 +037000* SQ1424.2 +037100 DECL-WRT-LN. SQ1424.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1424.2 +037300 MOVE SPACE TO DUMMY-RECORD. SQ1424.2 +037400* SQ1424.2 +037500 DECL-FAIL-ROUTINE. SQ1424.2 +037600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1424.2 +037700 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1424.2 +037800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1424.2 +037900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1424.2 +038000 MOVE XXINFO TO DUMMY-RECORD. SQ1424.2 +038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1424.2 +038200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1424.2 +038300 GO TO DECL-FAIL-EX. SQ1424.2 +038400 DECL-FAIL-WRITE. SQ1424.2 +038500 MOVE TEST-COMPUTED TO PRINT-REC SQ1424.2 +038600 PERFORM DECL-WRITE-LINE SQ1424.2 +038700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1424.2 +038800 MOVE TEST-CORRECT TO PRINT-REC SQ1424.2 +038900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1424.2 +039000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1424.2 +039100 DECL-FAIL-EX. SQ1424.2 +039200 EXIT. SQ1424.2 +039300* SQ1424.2 +039400 DECL-BAIL. SQ1424.2 +039500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1424.2 +039600 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1424.2 +039700 DECL-BAIL-WRITE. SQ1424.2 +039800 MOVE CORRECT-A TO XXCORRECT. SQ1424.2 +039900 MOVE COMPUTED-A TO XXCOMPUTED. SQ1424.2 +040000 MOVE XXINFO TO DUMMY-RECORD. SQ1424.2 +040100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1424.2 +040200 DECL-BAIL-EX. SQ1424.2 +040300 EXIT. SQ1424.2 +040400* SQ1424.2 +040500 END-DECLS. SQ1424.2 +040600 MOVE ZERO TO DECL-EXEC-SW. SQ1424.2 +040700 END DECLARATIVES. SQ1424.2 +040800* SQ1424.2 +040900* SQ1424.2 +041000 CCVS1 SECTION. SQ1424.2 +041100 OPEN-FILES. SQ1424.2 +041200*P OPEN I-O RAW-DATA. SQ1424.2 +041300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1424.2 +041400*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1424.2 +041500*P MOVE "ABORTED " TO C-ABORT. SQ1424.2 +041600*P ADD 1 TO C-NO-OF-TESTS. SQ1424.2 +041700*P ACCEPT C-DATE FROM DATE. SQ1424.2 +041800*P ACCEPT C-TIME FROM TIME. SQ1424.2 +041900*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1424.2 +042000*PND-E-1. SQ1424.2 +042100*P CLOSE RAW-DATA. SQ1424.2 +042200 OPEN OUTPUT PRINT-FILE. SQ1424.2 +042300 MOVE CCVS-PGM-ID TO TEST-ID. SQ1424.2 +042400 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1424.2 +042500 MOVE SPACE TO TEST-RESULTS. SQ1424.2 +042600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1424.2 +042700 MOVE ZERO TO REC-SKEL-SUB. SQ1424.2 +042800 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1424.2 +042900 GO TO CCVS1-EXIT. SQ1424.2 +043000* SQ1424.2 +043100 CCVS-INIT-FILE. SQ1424.2 +043200 ADD 1 TO REC-SKL-SUB. SQ1424.2 +043300 MOVE FILE-RECORD-INFO-SKELETON TO SQ1424.2 +043400 FILE-RECORD-INFO (REC-SKL-SUB). SQ1424.2 +043500* SQ1424.2 +043600 CLOSE-FILES. SQ1424.2 +043700 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1424.2 +043800 CLOSE PRINT-FILE. SQ1424.2 +043900*P OPEN I-O RAW-DATA. SQ1424.2 +044000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1424.2 +044100*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1424.2 +044200*P MOVE "OK. " TO C-ABORT. SQ1424.2 +044300*P MOVE PASS-COUNTER TO C-OK. SQ1424.2 +044400*P MOVE ERROR-HOLD TO C-ALL. SQ1424.2 +044500*P MOVE ERROR-COUNTER TO C-FAIL. SQ1424.2 +044600*P MOVE DELETE-CNT TO C-DELETED. SQ1424.2 +044700*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1424.2 +044800*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1424.2 +044900*PND-E-2. SQ1424.2 +045000*P CLOSE RAW-DATA. SQ1424.2 +045100 TERMINATE-CCVS. SQ1424.2 +045200*S EXIT PROGRAM. SQ1424.2 +045300 STOP RUN. SQ1424.2 +045400* SQ1424.2 +045500 INSPT. SQ1424.2 +045600 MOVE "INSPT" TO P-OR-F. SQ1424.2 +045700 ADD 1 TO INSPECT-COUNTER. SQ1424.2 +045800 PERFORM PRINT-DETAIL. SQ1424.2 +045900 SQ1424.2 +046000 PASS. SQ1424.2 +046100 MOVE "PASS " TO P-OR-F. SQ1424.2 +046200 ADD 1 TO PASS-COUNTER. SQ1424.2 +046300 PERFORM PRINT-DETAIL. SQ1424.2 +046400* SQ1424.2 +046500 FAIL. SQ1424.2 +046600 MOVE "FAIL*" TO P-OR-F. SQ1424.2 +046700 ADD 1 TO ERROR-COUNTER. SQ1424.2 +046800 PERFORM PRINT-DETAIL. SQ1424.2 +046900* SQ1424.2 +047000 DE-LETE. SQ1424.2 +047100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1424.2 +047200 MOVE "*****" TO P-OR-F. SQ1424.2 +047300 ADD 1 TO DELETE-COUNTER. SQ1424.2 +047400 PERFORM PRINT-DETAIL. SQ1424.2 +047500* SQ1424.2 +047600 PRINT-DETAIL. SQ1424.2 +047700 IF REC-CT NOT EQUAL TO ZERO SQ1424.2 +047800 MOVE "." TO PARDOT-X SQ1424.2 +047900 MOVE REC-CT TO DOTVALUE. SQ1424.2 +048000 MOVE TEST-RESULTS TO PRINT-REC. SQ1424.2 +048100 PERFORM WRITE-LINE. SQ1424.2 +048200 IF P-OR-F EQUAL TO "FAIL*" SQ1424.2 +048300 PERFORM WRITE-LINE SQ1424.2 +048400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1424.2 +048500 ELSE SQ1424.2 +048600 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1424.2 +048700 MOVE SPACE TO P-OR-F. SQ1424.2 +048800 MOVE SPACE TO COMPUTED-X. SQ1424.2 +048900 MOVE SPACE TO CORRECT-X. SQ1424.2 +049000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1424.2 +049100 MOVE SPACE TO RE-MARK. SQ1424.2 +049200* SQ1424.2 +049300 HEAD-ROUTINE. SQ1424.2 +049400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +049500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +049600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1424.2 +049700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1424.2 +049800 COLUMN-NAMES-ROUTINE. SQ1424.2 +049900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1424.2 +050000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +050100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1424.2 +050200 END-ROUTINE. SQ1424.2 +050300 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1424.2 +050400 PERFORM WRITE-LINE 5 TIMES. SQ1424.2 +050500 END-RTN-EXIT. SQ1424.2 +050600 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1424.2 +050700 PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +050800* SQ1424.2 +050900 END-ROUTINE-1. SQ1424.2 +051000 ADD ERROR-COUNTER TO ERROR-HOLD SQ1424.2 +051100 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1424.2 +051200 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1424.2 +051300 ADD PASS-COUNTER TO ERROR-HOLD. SQ1424.2 +051400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1424.2 +051500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1424.2 +051600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1424.2 +051700 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1424.2 +051800 PERFORM WRITE-LINE. SQ1424.2 +051900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1424.2 +052000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1424.2 +052100 MOVE "NO " TO ERROR-TOTAL SQ1424.2 +052200 ELSE SQ1424.2 +052300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1424.2 +052400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1424.2 +052500 PERFORM WRITE-LINE. SQ1424.2 +052600 END-ROUTINE-13. SQ1424.2 +052700 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1424.2 +052800 MOVE "NO " TO ERROR-TOTAL SQ1424.2 +052900 ELSE SQ1424.2 +053000 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1424.2 +053100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1424.2 +053200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1424.2 +053300 PERFORM WRITE-LINE. SQ1424.2 +053400 IF INSPECT-COUNTER EQUAL TO ZERO SQ1424.2 +053500 MOVE "NO " TO ERROR-TOTAL SQ1424.2 +053600 ELSE SQ1424.2 +053700 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1424.2 +053800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1424.2 +053900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1424.2 +054000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1424.2 +054100* SQ1424.2 +054200 WRITE-LINE. SQ1424.2 +054300 ADD 1 TO RECORD-COUNT. SQ1424.2 +054400 IF RECORD-COUNT GREATER 50 SQ1424.2 +054500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1424.2 +054600 MOVE SPACE TO DUMMY-RECORD SQ1424.2 +054700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1424.2 +054800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1424.2 +054900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1424.2 +055000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1424.2 +055100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1424.2 +055200 MOVE ZERO TO RECORD-COUNT. SQ1424.2 +055300 PERFORM WRT-LN. SQ1424.2 +055400* SQ1424.2 +055500 WRT-LN. SQ1424.2 +055600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1424.2 +055700 MOVE SPACE TO DUMMY-RECORD. SQ1424.2 +055800 BLANK-LINE-PRINT. SQ1424.2 +055900 PERFORM WRT-LN. SQ1424.2 +056000 FAIL-ROUTINE. SQ1424.2 +056100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1424.2 +056200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1424.2 +056300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1424.2 +056400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1424.2 +056500 MOVE XXINFO TO DUMMY-RECORD. SQ1424.2 +056600 PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +056700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1424.2 +056800 GO TO FAIL-ROUTINE-EX. SQ1424.2 +056900 FAIL-ROUTINE-WRITE. SQ1424.2 +057000 MOVE TEST-COMPUTED TO PRINT-REC SQ1424.2 +057100 PERFORM WRITE-LINE SQ1424.2 +057200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1424.2 +057300 MOVE TEST-CORRECT TO PRINT-REC SQ1424.2 +057400 PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +057500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1424.2 +057600 FAIL-ROUTINE-EX. SQ1424.2 +057700 EXIT. SQ1424.2 +057800 BAIL-OUT. SQ1424.2 +057900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1424.2 +058000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1424.2 +058100 BAIL-OUT-WRITE. SQ1424.2 +058200 MOVE CORRECT-A TO XXCORRECT. SQ1424.2 +058300 MOVE COMPUTED-A TO XXCOMPUTED. SQ1424.2 +058400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1424.2 +058500 MOVE XXINFO TO DUMMY-RECORD. SQ1424.2 +058600 PERFORM WRITE-LINE 2 TIMES. SQ1424.2 +058700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1424.2 +058800 BAIL-OUT-EX. SQ1424.2 +058900 EXIT. SQ1424.2 +059000 CCVS1-EXIT. SQ1424.2 +059100 EXIT. SQ1424.2 +059200* SQ1424.2 +059300**************************************************************** SQ1424.2 +059400* * SQ1424.2 +059500* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1424.2 +059600* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1424.2 +059700* * SQ1424.2 +059800**************************************************************** SQ1424.2 +059900* SQ1424.2 +060000 SECT-SQ142A-MAIN SECTION. SQ1424.2 +060100 OPEN-INIT-01. SQ1424.2 +060200* SQ1424.2 +060300* THIS PROGRAM ATTEMPTS TO OPEN A FILE WHICH IS NOT SQ1424.2 +060400* PRESENT AND AVAILABLE TO IT. SQ1424.2 +060500* SQ1424.2 +060600 MOVE 1 TO REC-CT SQ1424.2 +060700 MOVE "OPEN ABSENT FILE INPUT" TO FEATURE SQ1424.2 +060800 MOVE "OPEN-TEST-01" TO PAR-NAME SQ1424.2 +060900 MOVE 9 TO DECL-EXEC-SW SQ1424.2 +061000 MOVE "**" TO SQ-FS1-STATUS. SQ1424.2 +061100 OPEN-TEST-01. SQ1424.2 +061200 OPEN INPUT SQ-FS1. SQ1424.2 +061300 MOVE "OPEN-TEST-01" TO PAR-NAME. SQ1424.2 +061400 MOVE 1 TO REC-CT. SQ1424.2 +061500 ADD 1 TO REC-CT. SQ1424.2 +061600 IF SQ-FS1-STATUS NOT = "35" SQ1424.2 +061700 MOVE "INCORRECT STATUS CODE RETURNED" TO RE-MARK SQ1424.2 +061800 MOVE "VII-4, 1.5.3(3)C" TO ANSI-REFERENCE SQ1424.2 +061900 MOVE "35" TO CORRECT-A SQ1424.2 +062000 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1424.2 +062100 PERFORM FAIL SQ1424.2 +062200 ELSE SQ1424.2 +062300 PERFORM PASS. SQ1424.2 +062400* SQ1424.2 +062500* SQ1424.2 +062600 CCVS-EXIT SECTION. SQ1424.2 +062700 CCVS-999999. SQ1424.2 +062800 GO TO CLOSE-FILES. SQ1424.2 diff --git a/tests/cobol85/SQ/SQ143A.CBL b/tests/cobol85/SQ/SQ143A.CBL new file mode 100755 index 00000000..5f6c64aa --- /dev/null +++ b/tests/cobol85/SQ/SQ143A.CBL @@ -0,0 +1,479 @@ +000100 IDENTIFICATION DIVISION. SQ1434.2 +000200 PROGRAM-ID. SQ1434.2 +000300 SQ143A. SQ1434.2 +000400**************************************************************** SQ1434.2 +000500* * SQ1434.2 +000600* VALIDATION FOR:- * SQ1434.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1434.2 +000800* USING CCVS85 VERSION 3.0. * SQ1434.2 +000900* * SQ1434.2 +001000* CREATION DATE / VALIDATION DATE * SQ1434.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1434.2 +001200* * SQ1434.2 +001300**************************************************************** SQ1434.2 +001400* * SQ1434.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1434.2 +001600* * SQ1434.2 +001700* X-01 SEQUENTIAL TAPE * SQ1434.2 +001800* X-55 SYSTEM PRINTER * SQ1434.2 +001900* X-82 SOURCE-COMPUTER * SQ1434.2 +002000* X-83 OBJECT-COMPUTER. * SQ1434.2 +002100* X-84 LABEL RECORDS OPTION * SQ1434.2 +002200* * SQ1434.2 +002300**************************************************************** SQ1434.2 +002400* * SQ1434.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO CLOSING * SQ1434.2 +002600* AN UNOPENED FILE. THE TEST FOR CORRECT I-O STATUS CODE * SQ1434.2 +002700* 42 IS IN THE MAIN LINE CODE, THEREFORE AN ABNORMAL * SQ1434.2 +002800* TERMINATION IS POSSIBLE BEFORE THE TEST OF THE I-O STATUS * SQ1434.2 +002900* CODE IS ACCOMPLISHED. * SQ1434.2 +003000* * SQ1434.2 +003100**************************************************************** SQ1434.2 +003200* SQ1434.2 +003300 ENVIRONMENT DIVISION. SQ1434.2 +003400 CONFIGURATION SECTION. SQ1434.2 +003500 SOURCE-COMPUTER. SQ1434.2 +003600 Linux. SQ1434.2 +003700 OBJECT-COMPUTER. SQ1434.2 +003800 Linux. SQ1434.2 +003900* SQ1434.2 +004000 INPUT-OUTPUT SECTION. SQ1434.2 +004100 FILE-CONTROL. SQ1434.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1434.2 +004300 "report.log". SQ1434.2 +004400* SQ1434.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1434.2 +004600 "XXXXX001" SQ1434.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1434.2 +004800* SQ1434.2 +004900* SQ1434.2 +005000 DATA DIVISION. SQ1434.2 +005100 FILE SECTION. SQ1434.2 +005200 FD PRINT-FILE SQ1434.2 +005300*C LABEL RECORDS SQ1434.2 +005400*C OMITTED SQ1434.2 +005500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1434.2 +005600 . SQ1434.2 +005700 01 PRINT-REC PICTURE X(120). SQ1434.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1434.2 +005900* SQ1434.2 +006000 FD SQ-FS1 SQ1434.2 +006100*C LABEL RECORD IS STANDARD SQ1434.2 +006200 . SQ1434.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1434.2 +006400* SQ1434.2 +006500 WORKING-STORAGE SECTION. SQ1434.2 +006600* SQ1434.2 +006700*************************************************************** SQ1434.2 +006800* * SQ1434.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1434.2 +007000* * SQ1434.2 +007100*************************************************************** SQ1434.2 +007200* SQ1434.2 +007300 01 SQ-FS1-STATUS. SQ1434.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1434.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1434.2 +007600* SQ1434.2 +007700*************************************************************** SQ1434.2 +007800* * SQ1434.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1434.2 +008000* * SQ1434.2 +008100*************************************************************** SQ1434.2 +008200* SQ1434.2 +008300 01 REC-SKEL-SUB PIC 99. SQ1434.2 +008400* SQ1434.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ1434.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ1434.2 +008700 05 FILLER PICTURE X(48) VALUE SQ1434.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1434.2 +008900 05 FILLER PICTURE X(46) VALUE SQ1434.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1434.2 +009100 05 FILLER PICTURE X(26) VALUE SQ1434.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ1434.2 +009300 05 FILLER PICTURE X(37) VALUE SQ1434.2 +009400 ",RECKEY= ". SQ1434.2 +009500 05 FILLER PICTURE X(38) VALUE SQ1434.2 +009600 ",ALTKEY1= ". SQ1434.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1434.2 +009800 ",ALTKEY2= ". SQ1434.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1434.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1434.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ1434.2 +010200 07 FILLER PIC X(5). SQ1434.2 +010300 07 XFILE-NAME PIC X(6). SQ1434.2 +010400 07 FILLER PIC X(8). SQ1434.2 +010500 07 XRECORD-NAME PIC X(6). SQ1434.2 +010600 07 FILLER PIC X(1). SQ1434.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ1434.2 +010800 07 FILLER PIC X(7). SQ1434.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ1434.2 +011000 07 FILLER PIC X(6). SQ1434.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ1434.2 +011200 07 FILLER PIC X(5). SQ1434.2 +011300 07 ODO-NUMBER PIC 9(4). SQ1434.2 +011400 07 FILLER PIC X(5). SQ1434.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ1434.2 +011600 07 FILLER PIC X(7). SQ1434.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ1434.2 +011800 07 FILLER PIC X(7). SQ1434.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ1434.2 +012000 07 FILLER PIC X(1). SQ1434.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ1434.2 +012200 07 FILLER PIC X(6). SQ1434.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ1434.2 +012400 07 FILLER PIC X(5). SQ1434.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ1434.2 +012600 07 FILLER PIC X(6). SQ1434.2 +012700 07 XLABEL-TYPE PIC X(1). SQ1434.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ1434.2 +012900 07 FILLER PIC X(8). SQ1434.2 +013000 07 XRECORD-KEY PIC X(29). SQ1434.2 +013100 07 FILLER PIC X(9). SQ1434.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ1434.2 +013300 07 FILLER PIC X(9). SQ1434.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ1434.2 +013500 07 FILLER PIC X(7). SQ1434.2 +013600* SQ1434.2 +013700 01 TEST-RESULTS. SQ1434.2 +013800 02 FILLER PIC X VALUE SPACE. SQ1434.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ1434.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1434.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1434.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1434.2 +014300 02 PAR-NAME. SQ1434.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1434.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1434.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1434.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ1434.2 +014800 02 RE-MARK PIC X(61). SQ1434.2 +014900 01 TEST-COMPUTED. SQ1434.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ1434.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1434.2 +015200 02 COMPUTED-X. SQ1434.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1434.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1434.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1434.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1434.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1434.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1434.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ1434.2 +016000 04 FILLER PIC X. SQ1434.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ1434.2 +016200 01 TEST-CORRECT. SQ1434.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1434.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1434.2 +016500 02 CORRECT-X. SQ1434.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1434.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1434.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1434.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1434.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1434.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ1434.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ1434.2 +017300 04 FILLER PIC X. SQ1434.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ1434.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1434.2 +017600 01 CCVS-C-1. SQ1434.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1434.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1434.2 +017900- "SS PARAGRAPH-NAME SQ1434.2 +018000- " REMARKS". SQ1434.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ1434.2 +018200 01 CCVS-C-2. SQ1434.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ1434.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ1434.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ1434.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ1434.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ1434.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1434.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ1434.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1434.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1434.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1434.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1434.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1434.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1434.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1434.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1434.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1434.2 +019900 01 CCVS-H-1. SQ1434.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ1434.2 +020100 02 FILLER PIC X(42) VALUE SQ1434.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1434.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ1434.2 +020400 01 CCVS-H-2A. SQ1434.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ1434.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1434.2 +020700 02 FILLER PIC XXXX VALUE SQ1434.2 +020800 "4.2 ". SQ1434.2 +020900 02 FILLER PIC X(28) VALUE SQ1434.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ1434.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ1434.2 +021200* SQ1434.2 +021300 01 CCVS-H-2B. SQ1434.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1434.2 +021500 02 TEST-ID PIC X(9). SQ1434.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ1434.2 +021700 02 FILLER PIC X(12) VALUE SQ1434.2 +021800 " HIGH ". SQ1434.2 +021900 02 FILLER PIC X(22) VALUE SQ1434.2 +022000 " LEVEL VALIDATION FOR ". SQ1434.2 +022100 02 FILLER PIC X(58) VALUE SQ1434.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1434.2 +022300 01 CCVS-H-3. SQ1434.2 +022400 02 FILLER PIC X(34) VALUE SQ1434.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1434.2 +022600 02 FILLER PIC X(58) VALUE SQ1434.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1434.2 +022800 02 FILLER PIC X(28) VALUE SQ1434.2 +022900 " COPYRIGHT 1985,1986 ". SQ1434.2 +023000 01 CCVS-E-1. SQ1434.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ1434.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1434.2 +023300 02 ID-AGAIN PIC X(9). SQ1434.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ1434.2 +023500 01 CCVS-E-2. SQ1434.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ1434.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ1434.2 +023800 02 CCVS-E-2-2. SQ1434.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1434.2 +024000 03 FILLER PIC X VALUE SPACE. SQ1434.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ1434.2 +024200 "ERRORS ENCOUNTERED". SQ1434.2 +024300 01 CCVS-E-3. SQ1434.2 +024400 02 FILLER PIC X(22) VALUE SQ1434.2 +024500 " FOR OFFICIAL USE ONLY". SQ1434.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ1434.2 +024700 02 FILLER PIC X(58) VALUE SQ1434.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1434.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ1434.2 +025000 02 FILLER PIC X(20) VALUE SQ1434.2 +025100 " COPYRIGHT 1985,1986". SQ1434.2 +025200 01 CCVS-E-4. SQ1434.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1434.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ1434.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1434.2 +025600 02 FILLER PIC X(40) VALUE SQ1434.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1434.2 +025800 01 XXINFO. SQ1434.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1434.2 +026000 02 INFO-TEXT. SQ1434.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ1434.2 +026200 04 XXCOMPUTED PIC X(20). SQ1434.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1434.2 +026400 04 XXCORRECT PIC X(20). SQ1434.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ1434.2 +026600 01 HYPHEN-LINE. SQ1434.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ1434.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1434.2 +026900- "*****************************************". SQ1434.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1434.2 +027100- "******************************". SQ1434.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1434.2 +027300 "SQ143A". SQ1434.2 +027400* SQ1434.2 +027500 PROCEDURE DIVISION. SQ1434.2 +027600 CCVS1 SECTION. SQ1434.2 +027700 OPEN-FILES. SQ1434.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1434.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1434.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1434.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ1434.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1434.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ1434.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1434.2 +028500 GO TO CCVS1-EXIT. SQ1434.2 +028600* SQ1434.2 +028700 CCVS-INIT-FILE. SQ1434.2 +028800 ADD 1 TO REC-SKL-SUB. SQ1434.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1434.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1434.2 +029100* SQ1434.2 +029200 CLOSE-FILES. SQ1434.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1434.2 +029400 CLOSE PRINT-FILE. SQ1434.2 +029500 TERMINATE-CCVS. SQ1434.2 +029600 STOP RUN. SQ1434.2 +029700* SQ1434.2 +029800 INSPT. SQ1434.2 +029900 MOVE "INSPT" TO P-OR-F. SQ1434.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ1434.2 +030100 PERFORM PRINT-DETAIL. SQ1434.2 +030200 SQ1434.2 +030300 PASS. SQ1434.2 +030400 MOVE "PASS " TO P-OR-F. SQ1434.2 +030500 ADD 1 TO PASS-COUNTER. SQ1434.2 +030600 PERFORM PRINT-DETAIL. SQ1434.2 +030700* SQ1434.2 +030800 FAIL. SQ1434.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ1434.2 +031000 ADD 1 TO ERROR-COUNTER. SQ1434.2 +031100 PERFORM PRINT-DETAIL. SQ1434.2 +031200* SQ1434.2 +031300 DE-LETE. SQ1434.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1434.2 +031500 MOVE "*****" TO P-OR-F. SQ1434.2 +031600 ADD 1 TO DELETE-COUNTER. SQ1434.2 +031700 PERFORM PRINT-DETAIL. SQ1434.2 +031800* SQ1434.2 +031900 PRINT-DETAIL. SQ1434.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1434.2 +032100 MOVE "." TO PARDOT-X SQ1434.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1434.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ1434.2 +032400 PERFORM WRITE-LINE. SQ1434.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ1434.2 +032600 PERFORM WRITE-LINE SQ1434.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1434.2 +032800 ELSE SQ1434.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1434.2 +033000 MOVE SPACE TO P-OR-F. SQ1434.2 +033100 MOVE SPACE TO COMPUTED-X. SQ1434.2 +033200 MOVE SPACE TO CORRECT-X. SQ1434.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1434.2 +033400 MOVE SPACE TO RE-MARK. SQ1434.2 +033500* SQ1434.2 +033600 HEAD-ROUTINE. SQ1434.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1434.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1434.2 +034100 COLUMN-NAMES-ROUTINE. SQ1434.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1434.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1434.2 +034500 END-ROUTINE. SQ1434.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1434.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ1434.2 +034800 END-RTN-EXIT. SQ1434.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1434.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +035100* SQ1434.2 +035200 END-ROUTINE-1. SQ1434.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1434.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1434.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1434.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1434.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1434.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1434.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1434.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1434.2 +036100 PERFORM WRITE-LINE. SQ1434.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1434.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1434.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ1434.2 +036500 ELSE SQ1434.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1434.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1434.2 +036800 PERFORM WRITE-LINE. SQ1434.2 +036900 END-ROUTINE-13. SQ1434.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1434.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ1434.2 +037200 ELSE SQ1434.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1434.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1434.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1434.2 +037600 PERFORM WRITE-LINE. SQ1434.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1434.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1434.2 +037900 ELSE SQ1434.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1434.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1434.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1434.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1434.2 +038400* SQ1434.2 +038500 WRITE-LINE. SQ1434.2 +038600 ADD 1 TO RECORD-COUNT. SQ1434.2 +038700 IF RECORD-COUNT GREATER 50 SQ1434.2 +038800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1434.2 +038900 MOVE SPACE TO DUMMY-RECORD SQ1434.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1434.2 +039100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1434.2 +039200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1434.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1434.2 +039400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1434.2 +039500 MOVE ZERO TO RECORD-COUNT. SQ1434.2 +039600 PERFORM WRT-LN. SQ1434.2 +039700* SQ1434.2 +039800 WRT-LN. SQ1434.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1434.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ1434.2 +040100 BLANK-LINE-PRINT. SQ1434.2 +040200 PERFORM WRT-LN. SQ1434.2 +040300 FAIL-ROUTINE. SQ1434.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1434.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1434.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1434.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1434.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ1434.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1434.2 +041100 GO TO FAIL-ROUTINE-EX. SQ1434.2 +041200 FAIL-ROUTINE-WRITE. SQ1434.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ1434.2 +041400 PERFORM WRITE-LINE SQ1434.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1434.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ1434.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1434.2 +041900 FAIL-ROUTINE-EX. SQ1434.2 +042000 EXIT. SQ1434.2 +042100 BAIL-OUT. SQ1434.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1434.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1434.2 +042400 BAIL-OUT-WRITE. SQ1434.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ1434.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1434.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1434.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1434.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ1434.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1434.2 +043100 BAIL-OUT-EX. SQ1434.2 +043200 EXIT. SQ1434.2 +043300 CCVS1-EXIT. SQ1434.2 +043400 EXIT. SQ1434.2 +043500* SQ1434.2 +043600**************************************************************** SQ1434.2 +043700* * SQ1434.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1434.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1434.2 +044000* * SQ1434.2 +044100**************************************************************** SQ1434.2 +044200* SQ1434.2 +044300 SECT-SQ143A-0001 SECTION. SQ1434.2 +044400 CLOSE-INIT-01. SQ1434.2 +044500* SQ1434.2 +044600* THIS TEST CLOSES A FILE THAT HAS NEVER BEEN OPENED. SQ1434.2 +044700* I-O STATUS CODE 42 SHOULD BE GENERATED. SQ1434.2 +044800* SQ1434.2 +044900 MOVE "CLOSE UNOPENED FILE" TO FEATURE. SQ1434.2 +045000 MOVE "**" TO SQ-FS1-STATUS. SQ1434.2 +045100 MOVE "CLOSE-TEST-01" TO PAR-NAME. SQ1434.2 +045200 MOVE 1 TO REC-CT. SQ1434.2 +045300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1434.2 +045400 TO DUMMY-RECORD. SQ1434.2 +045500 PERFORM WRITE-LINE 3 TIMES. SQ1434.2 +045600 CLOSE-TEST-01. SQ1434.2 +045700 IF REC-CT = 0 SQ1434.2 +045800 OPEN INPUT SQ-FS1. SQ1434.2 +045900* THIS IF STATEMENT SHOULD NEVER BE TRUE. IT IS INCLUDED IN SQ1434.2 +046000* AN ATTEMPT TO AVOID A COMPILER DETECTING THE CLOSE OF AN SQ1434.2 +046100* UNOPENED FILE WITHOUT EXECUTING THE PROGRAM. HOWEVER, IF SQ1434.2 +046200* THE DETECTION IS MADE AT COMPILE TIME, THE TEST SHOULD BE SQ1434.2 +046300* CONSIDERED PASSED. SQ1434.2 +046400* SQ1434.2 +046500 CLOSE SQ-FS1. SQ1434.2 +046600 IF SQ-FS1-STATUS = "42" SQ1434.2 +046700 PERFORM PASS SQ1434.2 +046800 ELSE SQ1434.2 +046900 MOVE "42" TO CORRECT-A SQ1434.2 +047000 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1434.2 +047100 MOVE "STATUS FOR CLOSE OF UNOPENED FILE INCORRECT" SQ1434.2 +047200 TO RE-MARK SQ1434.2 +047300 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1434.2 +047400 PERFORM FAIL SQ1434.2 +047500 END-IF. SQ1434.2 +047600* SQ1434.2 +047700 CCVS-EXIT SECTION. SQ1434.2 +047800 CCVS-999999. SQ1434.2 +047900 GO TO CLOSE-FILES. SQ1434.2 diff --git a/tests/cobol85/SQ/SQ144A.CBL b/tests/cobol85/SQ/SQ144A.CBL new file mode 100755 index 00000000..bf9e24cc --- /dev/null +++ b/tests/cobol85/SQ/SQ144A.CBL @@ -0,0 +1,769 @@ +000100 IDENTIFICATION DIVISION. SQ1444.2 +000200 PROGRAM-ID. SQ1444.2 +000300 SQ144A. SQ1444.2 +000400**************************************************************** SQ1444.2 +000500* * SQ1444.2 +000600* VALIDATION FOR:- * SQ1444.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1444.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ1444.2 +000900* REVISED 1986, AUGUST * SQ1444.2 +001000* * SQ1444.2 +001100* CREATION DATE / VALIDATION DATE * SQ1444.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1444.2 +001300* * SQ1444.2 +001400**************************************************************** SQ1444.2 +001500* * SQ1444.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1444.2 +001700* * SQ1444.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1444.2 +001900* X-55 SYSTEM PRINTER * SQ1444.2 +002000* X-82 SOURCE-COMPUTER * SQ1444.2 +002100* X-83 OBJECT-COMPUTER. * SQ1444.2 +002200* * SQ1444.2 +002300**************************************************************** SQ1444.2 +002400* * SQ1444.2 +002500* SPLIT FROM SQ133A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1444.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1444.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE WHEN AN * SQ1444.2 +002800* ATTEMPT IS MADE TO REWRITE AFTER AT END. (SEE SQ133A). * SQ1444.2 +002900* * SQ1444.2 +003000**************************************************************** SQ1444.2 +003100* SQ1444.2 +003200 ENVIRONMENT DIVISION. SQ1444.2 +003300 CONFIGURATION SECTION. SQ1444.2 +003400 SOURCE-COMPUTER. SQ1444.2 +003500 Linux. SQ1444.2 +003600 OBJECT-COMPUTER. SQ1444.2 +003700 Linux. SQ1444.2 +003800* SQ1444.2 +003900 INPUT-OUTPUT SECTION. SQ1444.2 +004000 FILE-CONTROL. SQ1444.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ1444.2 +004200 "report.log". SQ1444.2 +004300* SQ1444.2 +004400*P SELECT RAW-DATA ASSIGN TO SQ1444.2 +004500*P "XXXXX062" SQ1444.2 +004600*P ORGANIZATION IS INDEXED SQ1444.2 +004700*P ACCESS MODE IS RANDOM SQ1444.2 +004800*P RECORD-KEY IS RAW-DATA-KEY. SQ1444.2 +004900*P SQ1444.2 +005000 SELECT SQ-FS4 SQ1444.2 +005100 ASSIGN SQ1444.2 +005200 "XXXXX014" SQ1444.2 +005300 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ1444.2 +005400 SEQUENTIAL SQ1444.2 +005500 . SQ1444.2 +005600* SQ1444.2 +005700* SQ1444.2 +005800 DATA DIVISION. SQ1444.2 +005900 FILE SECTION. SQ1444.2 +006000 FD PRINT-FILE SQ1444.2 +006100*C LABEL RECORDS SQ1444.2 +006200*C OMITTED SQ1444.2 +006300*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1444.2 +006400 . SQ1444.2 +006500 01 PRINT-REC PICTURE X(120). SQ1444.2 +006600 01 DUMMY-RECORD PICTURE X(120). SQ1444.2 +006700*P SQ1444.2 +006800*PD RAW-DATA. SQ1444.2 +006900*P1 RAW-DATA-SATZ. SQ1444.2 +007000*P 05 RAW-DATA-KEY PIC X(6). SQ1444.2 +007100*P 05 C-DATE PIC 9(6). SQ1444.2 +007200*P 05 C-TIME PIC 9(8). SQ1444.2 +007300*P 05 NO-OF-TESTS PIC 99. SQ1444.2 +007400*P 05 C-OK PIC 999. SQ1444.2 +007500*P 05 C-ALL PIC 999. SQ1444.2 +007600*P 05 C-FAIL PIC 999. SQ1444.2 +007700*P 05 C-DELETED PIC 999. SQ1444.2 +007800*P 05 C-INSPECT PIC 999. SQ1444.2 +007900*P 05 C-NOTE PIC X(13). SQ1444.2 +008000*P 05 C-INDENT PIC X. SQ1444.2 +008100*P 05 C-ABORT PIC X(8). SQ1444.2 +008200* SQ1444.2 +008300 FD SQ-FS4 SQ1444.2 +008400*C LABEL RECORD IS STANDARD SQ1444.2 +008500 BLOCK 120 CHARACTERS SQ1444.2 +008600 RECORD CONTAINS 120 CHARACTERS SQ1444.2 +008700 . SQ1444.2 +008800 01 SQ-FS4R1-F-G-120. SQ1444.2 +008900 05 FFILE-RECORD-INFO-P1-120. SQ1444.2 +009000 07 FILLER PIC X(5). SQ1444.2 +009100 07 FFILE-NAME PIC X(6). SQ1444.2 +009200 07 FILLER PIC X(8). SQ1444.2 +009300 07 FRECORD-NAME PIC X(6). SQ1444.2 +009400 07 FILLER PIC X(1). SQ1444.2 +009500 07 FREELUNIT-NUMBER PIC 9(1). SQ1444.2 +009600 07 FILLER PIC X(7). SQ1444.2 +009700 07 FRECORD-NUMBER PIC 9(6). SQ1444.2 +009800 07 FILLER PIC X(6). SQ1444.2 +009900 07 FUPDATE-NUMBER PIC 9(2). SQ1444.2 +010000 07 FILLER PIC X(5). SQ1444.2 +010100 07 FODO-NUMBER PIC 9(4). SQ1444.2 +010200 07 FILLER PIC X(5). SQ1444.2 +010300 07 FPROGRAM-NAME PIC X(5). SQ1444.2 +010400 07 FILLER PIC X(7). SQ1444.2 +010500 07 FRECORD-LENGTH PIC 9(6). SQ1444.2 +010600 07 FILLER PIC X(7). SQ1444.2 +010700 07 FCHARS-OR-RECORDS PIC X(2). SQ1444.2 +010800 07 FILLER PIC X(1). SQ1444.2 +010900 07 FBLOCK-SIZE PIC 9(4). SQ1444.2 +011000 07 FILLER PIC X(6). SQ1444.2 +011100 07 FRECORDS-IN-FILE PIC 9(6). SQ1444.2 +011200 07 FILLER PIC X(5). SQ1444.2 +011300 07 FFILE-ORGANIZATION PIC X(2). SQ1444.2 +011400 07 FILLER PIC X(6). SQ1444.2 +011500 07 FLABEL-TYPE PIC X(1). SQ1444.2 +011600* SQ1444.2 +011700 WORKING-STORAGE SECTION. SQ1444.2 +011800* SQ1444.2 +011900*************************************************************** SQ1444.2 +012000* * SQ1444.2 +012100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1444.2 +012200* * SQ1444.2 +012300*************************************************************** SQ1444.2 +012400* SQ1444.2 +012500 01 STATUS-GROUP. SQ1444.2 +012600 04 SQ-FS4-STATUS. SQ1444.2 +012700 07 SQ-FS4-KEY-1 PIC X. SQ1444.2 +012800 07 SQ-FS4-KEY-2 PIC X. SQ1444.2 +012900* SQ1444.2 +013000 01 DELETE-SW. SQ1444.2 +013100 03 DELETE-SW-1 PIC X. SQ1444.2 +013200 03 DELETE-SW-1-GROUP. SQ1444.2 +013300 05 DELETE-SW-2 PIC X. SQ1444.2 +013400* SQ1444.2 +013500 01 DECL-EXEC-I-O PIC X(12). SQ1444.2 +013600* SQ1444.2 +013700 01 DECL-EXEC-SW PIC X. SQ1444.2 +013800* SQ1444.2 +013900*************************************************************** SQ1444.2 +014000* * SQ1444.2 +014100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1444.2 +014200* * SQ1444.2 +014300*************************************************************** SQ1444.2 +014400* SQ1444.2 +014500 01 REC-SKEL-SUB PIC 99. SQ1444.2 +014600* SQ1444.2 +014700 01 FILE-RECORD-INFORMATION-REC. SQ1444.2 +014800 03 FILE-RECORD-INFO-SKELETON. SQ1444.2 +014900 05 FILLER PICTURE X(48) VALUE SQ1444.2 +015000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1444.2 +015100 05 FILLER PICTURE X(46) VALUE SQ1444.2 +015200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1444.2 +015300 05 FILLER PICTURE X(26) VALUE SQ1444.2 +015400 ",LFIL=000000,ORG= ,LBLR= ". SQ1444.2 +015500 05 FILLER PICTURE X(37) VALUE SQ1444.2 +015600 ",RECKEY= ". SQ1444.2 +015700 05 FILLER PICTURE X(38) VALUE SQ1444.2 +015800 ",ALTKEY1= ". SQ1444.2 +015900 05 FILLER PICTURE X(38) VALUE SQ1444.2 +016000 ",ALTKEY2= ". SQ1444.2 +016100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1444.2 +016200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1444.2 +016300 05 FILE-RECORD-INFO-P1-120. SQ1444.2 +016400 07 FILLER PIC X(5). SQ1444.2 +016500 07 XFILE-NAME PIC X(6). SQ1444.2 +016600 07 FILLER PIC X(8). SQ1444.2 +016700 07 XRECORD-NAME PIC X(6). SQ1444.2 +016800 07 FILLER PIC X(1). SQ1444.2 +016900 07 REELUNIT-NUMBER PIC 9(1). SQ1444.2 +017000 07 FILLER PIC X(7). SQ1444.2 +017100 07 XRECORD-NUMBER PIC 9(6). SQ1444.2 +017200 07 FILLER PIC X(6). SQ1444.2 +017300 07 UPDATE-NUMBER PIC 9(2). SQ1444.2 +017400 07 FILLER PIC X(5). SQ1444.2 +017500 07 ODO-NUMBER PIC 9(4). SQ1444.2 +017600 07 FILLER PIC X(5). SQ1444.2 +017700 07 XPROGRAM-NAME PIC X(5). SQ1444.2 +017800 07 FILLER PIC X(7). SQ1444.2 +017900 07 XRECORD-LENGTH PIC 9(6). SQ1444.2 +018000 07 FILLER PIC X(7). SQ1444.2 +018100 07 CHARS-OR-RECORDS PIC X(2). SQ1444.2 +018200 07 FILLER PIC X(1). SQ1444.2 +018300 07 XBLOCK-SIZE PIC 9(4). SQ1444.2 +018400 07 FILLER PIC X(6). SQ1444.2 +018500 07 RECORDS-IN-FILE PIC 9(6). SQ1444.2 +018600 07 FILLER PIC X(5). SQ1444.2 +018700 07 XFILE-ORGANIZATION PIC X(2). SQ1444.2 +018800 07 FILLER PIC X(6). SQ1444.2 +018900 07 XLABEL-TYPE PIC X(1). SQ1444.2 +019000 05 FILE-RECORD-INFO-P121-240. SQ1444.2 +019100 07 FILLER PIC X(8). SQ1444.2 +019200 07 XRECORD-KEY PIC X(29). SQ1444.2 +019300 07 FILLER PIC X(9). SQ1444.2 +019400 07 ALTERNATE-KEY1 PIC X(29). SQ1444.2 +019500 07 FILLER PIC X(9). SQ1444.2 +019600 07 ALTERNATE-KEY2 PIC X(29). SQ1444.2 +019700 07 FILLER PIC X(7). SQ1444.2 +019800* SQ1444.2 +019900 01 TEST-RESULTS. SQ1444.2 +020000 02 FILLER PIC X VALUE SPACE. SQ1444.2 +020100 02 PAR-NAME. SQ1444.2 +020200 03 FILLER PIC X(14) VALUE SPACE. SQ1444.2 +020300 03 PARDOT-X PIC X VALUE SPACE. SQ1444.2 +020400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1444.2 +020500 02 FILLER PIC X VALUE SPACE. SQ1444.2 +020600 02 FEATURE PIC X(24) VALUE SPACE. SQ1444.2 +020700 02 FILLER PIC X VALUE SPACE. SQ1444.2 +020800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1444.2 +020900 02 FILLER PIC X(9) VALUE SPACE. SQ1444.2 +021000 02 RE-MARK PIC X(61). SQ1444.2 +021100 01 TEST-COMPUTED. SQ1444.2 +021200 02 FILLER PIC X(30) VALUE SPACE. SQ1444.2 +021300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1444.2 +021400 02 COMPUTED-X. SQ1444.2 +021500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1444.2 +021600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1444.2 +021700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1444.2 +021800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1444.2 +021900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1444.2 +022000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1444.2 +022100 04 COMPUTED-18V0 PIC -9(18). SQ1444.2 +022200 04 FILLER PIC X. SQ1444.2 +022300 03 FILLER PIC X(50) VALUE SPACE. SQ1444.2 +022400 01 TEST-CORRECT. SQ1444.2 +022500 02 FILLER PIC X(30) VALUE SPACE. SQ1444.2 +022600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1444.2 +022700 02 CORRECT-X. SQ1444.2 +022800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1444.2 +022900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1444.2 +023000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1444.2 +023100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1444.2 +023200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1444.2 +023300 03 CR-18V0 REDEFINES CORRECT-A. SQ1444.2 +023400 04 CORRECT-18V0 PIC -9(18). SQ1444.2 +023500 04 FILLER PIC X. SQ1444.2 +023600 03 FILLER PIC X(2) VALUE SPACE. SQ1444.2 +023700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1444.2 +023800* SQ1444.2 +023900 01 CCVS-C-1. SQ1444.2 +024000 02 FILLER PIC IS X VALUE SPACE. SQ1444.2 +024100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1444.2 +024200 02 FILLER PIC IS X VALUE SPACE. SQ1444.2 +024300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1444.2 +024400 02 FILLER PIC IS X VALUE SPACE. SQ1444.2 +024500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1444.2 +024600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1444.2 +024700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1444.2 +024800 01 CCVS-C-2. SQ1444.2 +024900 02 FILLER PIC X(19) VALUE SPACE. SQ1444.2 +025000 02 FILLER PIC X(6) VALUE "TESTED". SQ1444.2 +025100 02 FILLER PIC X(19) VALUE SPACE. SQ1444.2 +025200 02 FILLER PIC X(4) VALUE "FAIL". SQ1444.2 +025300 02 FILLER PIC X(72) VALUE SPACE. SQ1444.2 +025400* SQ1444.2 +025500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1444.2 +025600 01 REC-CT PIC 99 VALUE ZERO. SQ1444.2 +025700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1444.2 +025800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1444.2 +025900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1444.2 +026000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1444.2 +026100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1444.2 +026200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1444.2 +026300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1444.2 +026400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1444.2 +026500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1444.2 +026600 01 CCVS-H-1. SQ1444.2 +026700 02 FILLER PIC X(39) VALUE SPACES. SQ1444.2 +026800 02 FILLER PIC X(42) VALUE SQ1444.2 +026900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1444.2 +027000 02 FILLER PIC X(39) VALUE SPACES. SQ1444.2 +027100 01 CCVS-H-2A. SQ1444.2 +027200 02 FILLER PIC X(40) VALUE SPACE. SQ1444.2 +027300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1444.2 +027400 02 FILLER PIC XXXX VALUE SQ1444.2 +027500 "4.2 ". SQ1444.2 +027600 02 FILLER PIC X(28) VALUE SQ1444.2 +027700 " COPY - NOT FOR DISTRIBUTION". SQ1444.2 +027800 02 FILLER PIC X(41) VALUE SPACE. SQ1444.2 +027900* SQ1444.2 +028000 01 CCVS-H-2B. SQ1444.2 +028100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1444.2 +028200 02 TEST-ID PIC X(9). SQ1444.2 +028300 02 FILLER PIC X(4) VALUE " IN ". SQ1444.2 +028400 02 FILLER PIC X(12) VALUE SQ1444.2 +028500 " HIGH ". SQ1444.2 +028600 02 FILLER PIC X(22) VALUE SQ1444.2 +028700 " LEVEL VALIDATION FOR ". SQ1444.2 +028800 02 FILLER PIC X(58) VALUE SQ1444.2 +028900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1444.2 +029000 01 CCVS-H-3. SQ1444.2 +029100 02 FILLER PIC X(34) VALUE SQ1444.2 +029200 " FOR OFFICIAL USE ONLY ". SQ1444.2 +029300 02 FILLER PIC X(58) VALUE SQ1444.2 +029400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1444.2 +029500 02 FILLER PIC X(28) VALUE SQ1444.2 +029600 " COPYRIGHT 1985,1986 ". SQ1444.2 +029700 01 CCVS-E-1. SQ1444.2 +029800 02 FILLER PIC X(52) VALUE SPACE. SQ1444.2 +029900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1444.2 +030000 02 ID-AGAIN PIC X(9). SQ1444.2 +030100 02 FILLER PIC X(45) VALUE SPACES. SQ1444.2 +030200 01 CCVS-E-2. SQ1444.2 +030300 02 FILLER PIC X(31) VALUE SPACE. SQ1444.2 +030400 02 FILLER PIC X(21) VALUE SPACE. SQ1444.2 +030500 02 CCVS-E-2-2. SQ1444.2 +030600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1444.2 +030700 03 FILLER PIC X VALUE SPACE. SQ1444.2 +030800 03 ENDER-DESC PIC X(44) VALUE SQ1444.2 +030900 "ERRORS ENCOUNTERED". SQ1444.2 +031000 01 CCVS-E-3. SQ1444.2 +031100 02 FILLER PIC X(22) VALUE SQ1444.2 +031200 " FOR OFFICIAL USE ONLY". SQ1444.2 +031300 02 FILLER PIC X(12) VALUE SPACE. SQ1444.2 +031400 02 FILLER PIC X(58) VALUE SQ1444.2 +031500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1444.2 +031600 02 FILLER PIC X(8) VALUE SPACE. SQ1444.2 +031700 02 FILLER PIC X(20) VALUE SQ1444.2 +031800 " COPYRIGHT 1985,1986". SQ1444.2 +031900 01 CCVS-E-4. SQ1444.2 +032000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1444.2 +032100 02 FILLER PIC X(4) VALUE " OF ". SQ1444.2 +032200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1444.2 +032300 02 FILLER PIC X(40) VALUE SQ1444.2 +032400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1444.2 +032500 01 XXINFO. SQ1444.2 +032600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1444.2 +032700 02 INFO-TEXT. SQ1444.2 +032800 04 FILLER PIC X(8) VALUE SPACE. SQ1444.2 +032900 04 XXCOMPUTED PIC X(20). SQ1444.2 +033000 04 FILLER PIC X(5) VALUE SPACE. SQ1444.2 +033100 04 XXCORRECT PIC X(20). SQ1444.2 +033200 02 INF-ANSI-REFERENCE PIC X(48). SQ1444.2 +033300 01 HYPHEN-LINE. SQ1444.2 +033400 02 FILLER PIC IS X VALUE IS SPACE. SQ1444.2 +033500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1444.2 +033600- "*****************************************". SQ1444.2 +033700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1444.2 +033800- "******************************". SQ1444.2 +033900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1444.2 +034000 "SQ144A". SQ1444.2 +034100* SQ1444.2 +034200* SQ1444.2 +034300 PROCEDURE DIVISION. SQ1444.2 +034400 DECLARATIVES. SQ1444.2 +034500* SQ1444.2 +034600 SECT-SQ144A-0001 SECTION. SQ1444.2 +034700 USE AFTER EXCEPTION PROCEDURE I-O. SQ1444.2 +034800 I-O-ERROR-PROCESS. SQ1444.2 +034900 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +035000 IF DECL-EXEC-SW NOT = SPACE SQ1444.2 +035100 GO TO END-DECLS. SQ1444.2 +035200* SQ1444.2 +035300 MOVE 1 TO REC-CT. SQ1444.2 +035400 MOVE "REWRITE AFTER FAILED RD" TO FEATURE. SQ1444.2 +035500 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ1444.2 +035600 GO TO DCL-REWRITE-01. SQ1444.2 +035700 DECL-DELETE-01. SQ1444.2 +035800 PERFORM DECL-DE-LETE. SQ1444.2 +035900 GO TO DECL-TEST-01-END. SQ1444.2 +036000 DCL-REWRITE-01. SQ1444.2 +036100 DECL-TEST-01-END. SQ1444.2 +036200* SQ1444.2 +036300 PERFORM DECL-WRITE-LINE. SQ1444.2 +036400 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1444.2 +036500 TO DUMMY-RECORD. SQ1444.2 +036600 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1444.2 +036700 GO TO END-DECLS. SQ1444.2 +036800* SQ1444.2 +036900* SQ1444.2 +037000 DECL-PASS. SQ1444.2 +037100 MOVE "PASS " TO P-OR-F. SQ1444.2 +037200 ADD 1 TO PASS-COUNTER. SQ1444.2 +037300 PERFORM DECL-PRINT-DETAIL. SQ1444.2 +037400* SQ1444.2 +037500 DECL-FAIL. SQ1444.2 +037600 MOVE "FAIL*" TO P-OR-F. SQ1444.2 +037700 ADD 1 TO ERROR-COUNTER. SQ1444.2 +037800 PERFORM DECL-PRINT-DETAIL. SQ1444.2 +037900* SQ1444.2 +038000 DECL-DE-LETE. SQ1444.2 +038100 MOVE "****TEST DELETED****" TO RE-MARK. SQ1444.2 +038200 MOVE "*****" TO P-OR-F. SQ1444.2 +038300 ADD 1 TO DELETE-COUNTER. SQ1444.2 +038400 PERFORM DECL-PRINT-DETAIL. SQ1444.2 +038500* SQ1444.2 +038600 DECL-PRINT-DETAIL. SQ1444.2 +038700 IF REC-CT NOT EQUAL TO ZERO SQ1444.2 +038800 MOVE "." TO PARDOT-X SQ1444.2 +038900 MOVE REC-CT TO DOTVALUE. SQ1444.2 +039000 MOVE TEST-RESULTS TO PRINT-REC. SQ1444.2 +039100 PERFORM DECL-WRITE-LINE. SQ1444.2 +039200 IF P-OR-F EQUAL TO "FAIL*" SQ1444.2 +039300 PERFORM DECL-WRITE-LINE SQ1444.2 +039400 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1444.2 +039500 ELSE SQ1444.2 +039600 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1444.2 +039700 MOVE SPACE TO P-OR-F. SQ1444.2 +039800 MOVE SPACE TO COMPUTED-X. SQ1444.2 +039900 MOVE SPACE TO CORRECT-X. SQ1444.2 +040000 IF REC-CT EQUAL TO ZERO SQ1444.2 +040100 MOVE SPACE TO PAR-NAME. SQ1444.2 +040200 MOVE SPACE TO RE-MARK. SQ1444.2 +040300* SQ1444.2 +040400 DECL-WRITE-LINE. SQ1444.2 +040500 ADD 1 TO RECORD-COUNT. SQ1444.2 +040600 IF RECORD-COUNT GREATER 50 SQ1444.2 +040700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1444.2 +040800 MOVE SPACE TO DUMMY-RECORD SQ1444.2 +040900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1444.2 +041000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1444.2 +041100 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1444.2 +041200 PERFORM DECL-WRT-LN 2 TIMES SQ1444.2 +041300 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1444.2 +041400 PERFORM DECL-WRT-LN SQ1444.2 +041500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1444.2 +041600 MOVE ZERO TO RECORD-COUNT. SQ1444.2 +041700 PERFORM DECL-WRT-LN. SQ1444.2 +041800* SQ1444.2 +041900 DECL-WRT-LN. SQ1444.2 +042000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1444.2 +042100 MOVE SPACE TO DUMMY-RECORD. SQ1444.2 +042200* SQ1444.2 +042300 DECL-FAIL-ROUTINE. SQ1444.2 +042400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1444.2 +042500 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1444.2 +042600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1444.2 +042700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1444.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1444.2 +042900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1444.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1444.2 +043100 GO TO DECL-FAIL-EX. SQ1444.2 +043200 DECL-FAIL-WRITE. SQ1444.2 +043300 MOVE TEST-COMPUTED TO PRINT-REC SQ1444.2 +043400 PERFORM DECL-WRITE-LINE SQ1444.2 +043500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1444.2 +043600 MOVE TEST-CORRECT TO PRINT-REC SQ1444.2 +043700 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1444.2 +043800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1444.2 +043900 DECL-FAIL-EX. SQ1444.2 +044000 EXIT. SQ1444.2 +044100* SQ1444.2 +044200 DECL-BAIL. SQ1444.2 +044300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1444.2 +044400 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1444.2 +044500 DECL-BAIL-WRITE. SQ1444.2 +044600 MOVE CORRECT-A TO XXCORRECT. SQ1444.2 +044700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1444.2 +044800 MOVE XXINFO TO DUMMY-RECORD. SQ1444.2 +044900 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1444.2 +045000 DECL-BAIL-EX. SQ1444.2 +045100 EXIT. SQ1444.2 +045200* SQ1444.2 +045300 END-DECLS. SQ1444.2 +045400 END DECLARATIVES. SQ1444.2 +045500* SQ1444.2 +045600* SQ1444.2 +045700 CCVS1 SECTION. SQ1444.2 +045800 OPEN-FILES. SQ1444.2 +045900*P OPEN I-O RAW-DATA. SQ1444.2 +046000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1444.2 +046100*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ1444.2 +046200*P MOVE "ABORTED " TO C-ABORT. SQ1444.2 +046300*P ADD 1 TO C-NO-OF-TESTS. SQ1444.2 +046400*P ACCEPT C-DATE FROM DATE. SQ1444.2 +046500*P ACCEPT C-TIME FROM TIME. SQ1444.2 +046600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1444.2 +046700*PND-E-1. SQ1444.2 +046800*P CLOSE RAW-DATA. SQ1444.2 +046900 OPEN OUTPUT PRINT-FILE. SQ1444.2 +047000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1444.2 +047100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1444.2 +047200 MOVE SPACE TO TEST-RESULTS. SQ1444.2 +047300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1444.2 +047400 MOVE ZERO TO REC-SKEL-SUB. SQ1444.2 +047500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1444.2 +047600 GO TO CCVS1-EXIT. SQ1444.2 +047700* SQ1444.2 +047800 CCVS-INIT-FILE. SQ1444.2 +047900 ADD 1 TO REC-SKL-SUB. SQ1444.2 +048000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1444.2 +048100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1444.2 +048200* SQ1444.2 +048300 CLOSE-FILES. SQ1444.2 +048400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1444.2 +048500 CLOSE PRINT-FILE. SQ1444.2 +048600*P OPEN I-O RAW-DATA. SQ1444.2 +048700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ1444.2 +048800*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ1444.2 +048900*P MOVE "OK. " TO C-ABORT. SQ1444.2 +049000*P MOVE PASS-COUNTER TO C-OK. SQ1444.2 +049100*P MOVE ERROR-HOLD TO C-ALL. SQ1444.2 +049200*P MOVE ERROR-COUNTER TO C-FAIL. SQ1444.2 +049300*P MOVE DELETE-CNT TO C-DELETED. SQ1444.2 +049400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ1444.2 +049500*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ1444.2 +049600*PND-E-2. SQ1444.2 +049700*P CLOSE RAW-DATA. SQ1444.2 +049800 TERMINATE-CCVS. SQ1444.2 +049900*S EXIT PROGRAM. SQ1444.2 +050000 STOP RUN. SQ1444.2 +050100* SQ1444.2 +050200 INSPT. SQ1444.2 +050300 MOVE "INSPT" TO P-OR-F. SQ1444.2 +050400 ADD 1 TO INSPECT-COUNTER. SQ1444.2 +050500 PERFORM PRINT-DETAIL. SQ1444.2 +050600* SQ1444.2 +050700 PASS. SQ1444.2 +050800 MOVE "PASS " TO P-OR-F. SQ1444.2 +050900 ADD 1 TO PASS-COUNTER. SQ1444.2 +051000 PERFORM PRINT-DETAIL. SQ1444.2 +051100* SQ1444.2 +051200 FAIL. SQ1444.2 +051300 MOVE "FAIL*" TO P-OR-F. SQ1444.2 +051400 ADD 1 TO ERROR-COUNTER. SQ1444.2 +051500 PERFORM PRINT-DETAIL. SQ1444.2 +051600* SQ1444.2 +051700 DE-LETE. SQ1444.2 +051800 MOVE "****TEST DELETED****" TO RE-MARK. SQ1444.2 +051900 MOVE "*****" TO P-OR-F. SQ1444.2 +052000 ADD 1 TO DELETE-COUNTER. SQ1444.2 +052100 PERFORM PRINT-DETAIL. SQ1444.2 +052200* SQ1444.2 +052300 PRINT-DETAIL. SQ1444.2 +052400 IF REC-CT NOT EQUAL TO ZERO SQ1444.2 +052500 MOVE "." TO PARDOT-X SQ1444.2 +052600 MOVE REC-CT TO DOTVALUE. SQ1444.2 +052700 MOVE TEST-RESULTS TO PRINT-REC. SQ1444.2 +052800 PERFORM WRITE-LINE. SQ1444.2 +052900 IF P-OR-F EQUAL TO "FAIL*" SQ1444.2 +053000 PERFORM WRITE-LINE SQ1444.2 +053100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1444.2 +053200 ELSE SQ1444.2 +053300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1444.2 +053400 MOVE SPACE TO P-OR-F. SQ1444.2 +053500 MOVE SPACE TO COMPUTED-X. SQ1444.2 +053600 MOVE SPACE TO CORRECT-X. SQ1444.2 +053700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1444.2 +053800 MOVE SPACE TO RE-MARK. SQ1444.2 +053900* SQ1444.2 +054000 HEAD-ROUTINE. SQ1444.2 +054100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +054200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +054300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1444.2 +054400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1444.2 +054500 COLUMN-NAMES-ROUTINE. SQ1444.2 +054600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1444.2 +054700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +054800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1444.2 +054900 END-ROUTINE. SQ1444.2 +055000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1444.2 +055100 PERFORM WRITE-LINE 5 TIMES. SQ1444.2 +055200 END-RTN-EXIT. SQ1444.2 +055300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1444.2 +055400 PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +055500* SQ1444.2 +055600 END-ROUTINE-1. SQ1444.2 +055700 ADD ERROR-COUNTER TO ERROR-HOLD SQ1444.2 +055800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1444.2 +055900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1444.2 +056000 ADD PASS-COUNTER TO ERROR-HOLD. SQ1444.2 +056100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1444.2 +056200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1444.2 +056300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1444.2 +056400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1444.2 +056500 PERFORM WRITE-LINE. SQ1444.2 +056600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1444.2 +056700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1444.2 +056800 MOVE "NO " TO ERROR-TOTAL SQ1444.2 +056900 ELSE SQ1444.2 +057000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1444.2 +057100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1444.2 +057200 PERFORM WRITE-LINE. SQ1444.2 +057300 END-ROUTINE-13. SQ1444.2 +057400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1444.2 +057500 MOVE "NO " TO ERROR-TOTAL SQ1444.2 +057600 ELSE SQ1444.2 +057700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1444.2 +057800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1444.2 +057900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1444.2 +058000 PERFORM WRITE-LINE. SQ1444.2 +058100 IF INSPECT-COUNTER EQUAL TO ZERO SQ1444.2 +058200 MOVE "NO " TO ERROR-TOTAL SQ1444.2 +058300 ELSE SQ1444.2 +058400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1444.2 +058500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1444.2 +058600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1444.2 +058700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1444.2 +058800* SQ1444.2 +058900 WRITE-LINE. SQ1444.2 +059000 ADD 1 TO RECORD-COUNT. SQ1444.2 +059100 IF RECORD-COUNT GREATER 50 SQ1444.2 +059200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1444.2 +059300 MOVE SPACE TO DUMMY-RECORD SQ1444.2 +059400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1444.2 +059500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1444.2 +059600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1444.2 +059700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1444.2 +059800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1444.2 +059900 MOVE ZERO TO RECORD-COUNT. SQ1444.2 +060000 PERFORM WRT-LN. SQ1444.2 +060100* SQ1444.2 +060200 WRT-LN. SQ1444.2 +060300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1444.2 +060400 MOVE SPACE TO DUMMY-RECORD. SQ1444.2 +060500 BLANK-LINE-PRINT. SQ1444.2 +060600 PERFORM WRT-LN. SQ1444.2 +060700 FAIL-ROUTINE. SQ1444.2 +060800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1444.2 +060900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1444.2 +061000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1444.2 +061100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1444.2 +061200 MOVE XXINFO TO DUMMY-RECORD. SQ1444.2 +061300 PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +061400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1444.2 +061500 GO TO FAIL-ROUTINE-EX. SQ1444.2 +061600 FAIL-ROUTINE-WRITE. SQ1444.2 +061700 MOVE TEST-COMPUTED TO PRINT-REC SQ1444.2 +061800 PERFORM WRITE-LINE SQ1444.2 +061900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1444.2 +062000 MOVE TEST-CORRECT TO PRINT-REC SQ1444.2 +062100 PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +062200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1444.2 +062300 FAIL-ROUTINE-EX. SQ1444.2 +062400 EXIT. SQ1444.2 +062500 BAIL-OUT. SQ1444.2 +062600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1444.2 +062700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1444.2 +062800 BAIL-OUT-WRITE. SQ1444.2 +062900 MOVE CORRECT-A TO XXCORRECT. SQ1444.2 +063000 MOVE COMPUTED-A TO XXCOMPUTED. SQ1444.2 +063100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1444.2 +063200 MOVE XXINFO TO DUMMY-RECORD. SQ1444.2 +063300 PERFORM WRITE-LINE 2 TIMES. SQ1444.2 +063400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1444.2 +063500 BAIL-OUT-EX. SQ1444.2 +063600 EXIT. SQ1444.2 +063700 CCVS1-EXIT. SQ1444.2 +063800 EXIT. SQ1444.2 +063900* SQ1444.2 +064000**************************************************************** SQ1444.2 +064100* * SQ1444.2 +064200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1444.2 +064300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1444.2 +064400* * SQ1444.2 +064500**************************************************************** SQ1444.2 +064600* SQ1444.2 +064700 SECT-SQ144A-0002 SECTION. SQ1444.2 +064800 STA-INIT. SQ1444.2 +064900 MOVE SPACE TO DELETE-SW. SQ1444.2 +065000* SQ1444.2 +065100 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1444.2 +065200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1444.2 +065300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1444.2 +065400 MOVE 120 TO XRECORD-LENGTH (1). SQ1444.2 +065500 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ1444.2 +065600 MOVE 1 TO XBLOCK-SIZE (1). SQ1444.2 +065700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1444.2 +065800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1444.2 +065900 MOVE "S" TO XLABEL-TYPE (1). SQ1444.2 +066000* SQ1444.2 +066100* OPEN THE FILE IN THE OUTPUT MODE SQ1444.2 +066200* SQ1444.2 +066300 SEQ-INIT-01. SQ1444.2 +066400 MOVE 0 TO REC-CT. SQ1444.2 +066500 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +066600 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +066700 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +066800 MOVE ZERO TO XRECORD-NUMBER (1). SQ1444.2 +066900 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1444.2 +067000 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1444.2 +067100 GO TO SEQ-TEST-OP-01. SQ1444.2 +067200 SEQ-DELETE-01. SQ1444.2 +067300 MOVE "*" TO DELETE-SW-1. SQ1444.2 +067400 SEQ-TEST-OP-01. SQ1444.2 +067500 OPEN OUTPUT SQ-FS4. SQ1444.2 +067600 SEQ-INIT-02. SQ1444.2 +067700 MOVE 0 TO REC-CT. SQ1444.2 +067800 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +067900 ADD 1 TO XRECORD-NUMBER (1). SQ1444.2 +068000 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +068100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +068200 MOVE "WRITE A RECORD" TO FEATURE. SQ1444.2 +068300 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ1444.2 +068400 SEQ-TEST-WR-02. SQ1444.2 +068500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1444.2 +068600 WRITE SQ-FS4R1-F-G-120. SQ1444.2 +068700 SEQ-INIT-03. SQ1444.2 +068800 MOVE 0 TO REC-CT. SQ1444.2 +068900 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +069000 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +069100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +069200 MOVE "CLOSE FILE" TO FEATURE. SQ1444.2 +069300 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ1444.2 +069400 SEQ-TEST-CL-03. SQ1444.2 +069500 CLOSE SQ-FS4. SQ1444.2 +069600 SEQ-INIT-04. SQ1444.2 +069700 MOVE 0 TO REC-CT. SQ1444.2 +069800 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +069900 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +070000 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +070100 MOVE ZERO TO XRECORD-NUMBER (1). SQ1444.2 +070200 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ1444.2 +070300 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ1444.2 +070400 SEQ-TEST-OP-04. SQ1444.2 +070500 OPEN I-O SQ-FS4. SQ1444.2 +070600 SEQ-INIT-05. SQ1444.2 +070700 MOVE 0 TO REC-CT. SQ1444.2 +070800 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +070900 ADD 1 TO XRECORD-NUMBER (1). SQ1444.2 +071000 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +071100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +071200 MOVE "READ FIRST RECORD" TO FEATURE. SQ1444.2 +071300 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ1444.2 +071400 SEQ-TEST-RD-05. SQ1444.2 +071500 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ1444.2 +071600 READ SQ-FS4. SQ1444.2 +071700 SEQ-INIT-06. SQ1444.2 +071800 MOVE 0 TO REC-CT. SQ1444.2 +071900 MOVE "*" TO DECL-EXEC-SW. SQ1444.2 +072000 ADD 1 TO XRECORD-NUMBER (1). SQ1444.2 +072100 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +072200 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +072300 MOVE "READ GIVING AT END" TO FEATURE. SQ1444.2 +072400 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ1444.2 +072500 SEQ-TEST-RD-06. SQ1444.2 +072600 READ SQ-FS4 RECORD. SQ1444.2 +072700 SEQ-INIT-07. SQ1444.2 +072800 MOVE 0 TO REC-CT. SQ1444.2 +072900 MOVE SPACE TO DECL-EXEC-SW. SQ1444.2 +073000 MOVE "**" TO SQ-FS4-STATUS. SQ1444.2 +073100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ1444.2 +073200 MOVE "REWRITE AFTER AT END" TO FEATURE. SQ1444.2 +073300 MOVE "SEQ-TEST-RW-07" TO PAR-NAME. SQ1444.2 +073400 SEQ-TEST-RW-07. SQ1444.2 +073500 REWRITE SQ-FS4R1-F-G-120. SQ1444.2 +073600 MOVE 0 TO REC-CT. SQ1444.2 +073700 MOVE "REWRITE AFTER AT END" TO FEATURE. SQ1444.2 +073800 MOVE "SEQ-TEST-RW-07" TO PAR-NAME. SQ1444.2 +073900* SQ1444.2 +074000* CHECK I-O STATUS RETURNED FROM REWRITE SQ1444.2 +074100* SQ1444.2 +074200 ADD 1 TO REC-CT. SQ1444.2 +074300 SEQ-TEST-07-01-END. SQ1444.2 +074400* SQ1444.2 +074500* CHECK EXECUTION OF I-O DECLARATIVE SQ1444.2 +074600* SQ1444.2 +074700 ADD 1 TO REC-CT. SQ1444.2 +074800 IF DELETE-SW NOT = SPACE SQ1444.2 +074900 GO TO SEQ-DELETE-07-02. SQ1444.2 +075000 GO TO SEQ-TEST-RW-07-02. SQ1444.2 +075100 SEQ-DELETE-07-02. SQ1444.2 +075200 PERFORM DE-LETE. SQ1444.2 +075300 GO TO SEQ-TEST-07-02-END. SQ1444.2 +075400 SEQ-TEST-RW-07-02. SQ1444.2 +075500 IF DECL-EXEC-I-O = "EXECUTED" SQ1444.2 +075600 PERFORM PASS SQ1444.2 +075700 ELSE SQ1444.2 +075800 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ1444.2 +075900 MOVE "EXECUTED" TO CORRECT-A SQ1444.2 +076000 MOVE "I-O DECLARATIVE NOT EXECUTED" SQ1444.2 +076100 TO RE-MARK SQ1444.2 +076200 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ1444.2 +076300 PERFORM FAIL. SQ1444.2 +076400 SEQ-TEST-07-02-END. SQ1444.2 +076500* SQ1444.2 +076600* SQ1444.2 +076700 CCVS-EXIT SECTION. SQ1444.2 +076800 CCVS-999999. SQ1444.2 +076900 GO TO CLOSE-FILES. SQ1444.2 diff --git a/tests/cobol85/SQ/SQ146A.CBL b/tests/cobol85/SQ/SQ146A.CBL new file mode 100755 index 00000000..b50c3574 --- /dev/null +++ b/tests/cobol85/SQ/SQ146A.CBL @@ -0,0 +1,510 @@ +000100 IDENTIFICATION DIVISION. SQ1464.2 +000200 PROGRAM-ID. SQ1464.2 +000300 SQ146A. SQ1464.2 +000400**************************************************************** SQ1464.2 +000500* * SQ1464.2 +000600* VALIDATION FOR:- * SQ1464.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1464.2 +000800* USING CCVS85 VERSION 3.0. * SQ1464.2 +000900* * SQ1464.2 +001000* CREATION DATE / VALIDATION DATE * SQ1464.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1464.2 +001200* * SQ1464.2 +001300**************************************************************** SQ1464.2 +001400* * SQ1464.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1464.2 +001600* * SQ1464.2 +001700* X-01 SEQUENTIAL TAPE * SQ1464.2 +001800* X-55 SYSTEM PRINTER * SQ1464.2 +001900* X-82 SOURCE-COMPUTER * SQ1464.2 +002000* X-83 OBJECT-COMPUTER. * SQ1464.2 +002100* X-84 LABEL RECORDS OPTION * SQ1464.2 +002200* * SQ1464.2 +002300**************************************************************** SQ1464.2 +002400* * SQ1464.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO CLOSE OF * SQ1464.2 +002600* AN ALREADY CLOSED FILE. THE TEST FOR CORRECT I-O STATUS * SQ1464.2 +002700* CODE 42 IS IN THE MAIN LINE CODE, THEREFORE AN ABNORMAL * SQ1464.2 +002800* TERMINATION IS POSSIBLE BEFORE THE TEST OF THE I-O STATUS * SQ1464.2 +002900* CODE IS ACCOMPLISHED. * SQ1464.2 +003000* * SQ1464.2 +003100**************************************************************** SQ1464.2 +003200* SQ1464.2 +003300 ENVIRONMENT DIVISION. SQ1464.2 +003400 CONFIGURATION SECTION. SQ1464.2 +003500 SOURCE-COMPUTER. SQ1464.2 +003600 Linux. SQ1464.2 +003700 OBJECT-COMPUTER. SQ1464.2 +003800 Linux. SQ1464.2 +003900* SQ1464.2 +004000 INPUT-OUTPUT SECTION. SQ1464.2 +004100 FILE-CONTROL. SQ1464.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1464.2 +004300 "report.log". SQ1464.2 +004400* SQ1464.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1464.2 +004600 "XXXXX001" SQ1464.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1464.2 +004800* SQ1464.2 +004900* SQ1464.2 +005000 DATA DIVISION. SQ1464.2 +005100 FILE SECTION. SQ1464.2 +005200 FD PRINT-FILE SQ1464.2 +005300*C LABEL RECORDS SQ1464.2 +005400*C OMITTED SQ1464.2 +005500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1464.2 +005600 . SQ1464.2 +005700 01 PRINT-REC PICTURE X(120). SQ1464.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1464.2 +005900* SQ1464.2 +006000 FD SQ-FS1 SQ1464.2 +006100*C LABEL RECORD IS STANDARD SQ1464.2 +006200 . SQ1464.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1464.2 +006400* SQ1464.2 +006500 WORKING-STORAGE SECTION. SQ1464.2 +006600* SQ1464.2 +006700*************************************************************** SQ1464.2 +006800* * SQ1464.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1464.2 +007000* * SQ1464.2 +007100*************************************************************** SQ1464.2 +007200* SQ1464.2 +007300 01 SQ-FS1-STATUS. SQ1464.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1464.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1464.2 +007600* SQ1464.2 +007700 01 DECL-EXEC-SW PIC 9. SQ1464.2 +007800* SQ1464.2 +007900*************************************************************** SQ1464.2 +008000* * SQ1464.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1464.2 +008200* * SQ1464.2 +008300*************************************************************** SQ1464.2 +008400* SQ1464.2 +008500 01 REC-SKEL-SUB PIC 99. SQ1464.2 +008600* SQ1464.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1464.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1464.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1464.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1464.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1464.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1464.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1464.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1464.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1464.2 +009600 ",RECKEY= ". SQ1464.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1464.2 +009800 ",ALTKEY1= ". SQ1464.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1464.2 +010000 ",ALTKEY2= ". SQ1464.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1464.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1464.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1464.2 +010400 07 FILLER PIC X(5). SQ1464.2 +010500 07 XFILE-NAME PIC X(6). SQ1464.2 +010600 07 FILLER PIC X(8). SQ1464.2 +010700 07 XRECORD-NAME PIC X(6). SQ1464.2 +010800 07 FILLER PIC X(1). SQ1464.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1464.2 +011000 07 FILLER PIC X(7). SQ1464.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1464.2 +011200 07 FILLER PIC X(6). SQ1464.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1464.2 +011400 07 FILLER PIC X(5). SQ1464.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1464.2 +011600 07 FILLER PIC X(5). SQ1464.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1464.2 +011800 07 FILLER PIC X(7). SQ1464.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1464.2 +012000 07 FILLER PIC X(7). SQ1464.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1464.2 +012200 07 FILLER PIC X(1). SQ1464.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1464.2 +012400 07 FILLER PIC X(6). SQ1464.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1464.2 +012600 07 FILLER PIC X(5). SQ1464.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1464.2 +012800 07 FILLER PIC X(6). SQ1464.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1464.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1464.2 +013100 07 FILLER PIC X(8). SQ1464.2 +013200 07 XRECORD-KEY PIC X(29). SQ1464.2 +013300 07 FILLER PIC X(9). SQ1464.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1464.2 +013500 07 FILLER PIC X(9). SQ1464.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1464.2 +013700 07 FILLER PIC X(7). SQ1464.2 +013800* SQ1464.2 +013900 01 TEST-RESULTS. SQ1464.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1464.2 +014100 02 FEATURE PIC X(24) VALUE SPACE. SQ1464.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1464.2 +014300 02 P-OR-F PIC X(5) VALUE SPACE. SQ1464.2 +014400 02 FILLER PIC X VALUE SPACE. SQ1464.2 +014500 02 PAR-NAME. SQ1464.2 +014600 03 FILLER PIC X(14) VALUE SPACE. SQ1464.2 +014700 03 PARDOT-X PIC X VALUE SPACE. SQ1464.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1464.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ1464.2 +015000 02 RE-MARK PIC X(61). SQ1464.2 +015100 01 TEST-COMPUTED. SQ1464.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1464.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1464.2 +015400 02 COMPUTED-X. SQ1464.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1464.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1464.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1464.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1464.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1464.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1464.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ1464.2 +016200 04 FILLER PIC X. SQ1464.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1464.2 +016400 01 TEST-CORRECT. SQ1464.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1464.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1464.2 +016700 02 CORRECT-X. SQ1464.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1464.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1464.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1464.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1464.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1464.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1464.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ1464.2 +017500 04 FILLER PIC X. SQ1464.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ1464.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1464.2 +017800 01 CCVS-C-1. SQ1464.2 +017900 02 FILLER PIC IS X(4) VALUE SPACE. SQ1464.2 +018000 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1464.2 +018100- "SS PARAGRAPH-NAME SQ1464.2 +018200- " REMARKS". SQ1464.2 +018300 02 FILLER PIC X(17) VALUE SPACE. SQ1464.2 +018400 01 CCVS-C-2. SQ1464.2 +018500 02 FILLER PIC XXXX VALUE SPACE. SQ1464.2 +018600 02 FILLER PIC X(6) VALUE "TESTED". SQ1464.2 +018700 02 FILLER PIC X(16) VALUE SPACE. SQ1464.2 +018800 02 FILLER PIC X(4) VALUE "FAIL". SQ1464.2 +018900 02 FILLER PIC X(90) VALUE SPACE. SQ1464.2 +019000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1464.2 +019100 01 REC-CT PIC 99 VALUE ZERO. SQ1464.2 +019200 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1464.2 +019300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1464.2 +019400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1464.2 +019500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1464.2 +019600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1464.2 +019700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1464.2 +019800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1464.2 +019900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1464.2 +020000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1464.2 +020100 01 CCVS-H-1. SQ1464.2 +020200 02 FILLER PIC X(39) VALUE SPACES. SQ1464.2 +020300 02 FILLER PIC X(42) VALUE SQ1464.2 +020400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1464.2 +020500 02 FILLER PIC X(39) VALUE SPACES. SQ1464.2 +020600 01 CCVS-H-2A. SQ1464.2 +020700 02 FILLER PIC X(40) VALUE SPACE. SQ1464.2 +020800 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1464.2 +020900 02 FILLER PIC XXXX VALUE SQ1464.2 +021000 "4.2 ". SQ1464.2 +021100 02 FILLER PIC X(28) VALUE SQ1464.2 +021200 " COPY - NOT FOR DISTRIBUTION". SQ1464.2 +021300 02 FILLER PIC X(41) VALUE SPACE. SQ1464.2 +021400* SQ1464.2 +021500 01 CCVS-H-2B. SQ1464.2 +021600 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1464.2 +021700 02 TEST-ID PIC X(9). SQ1464.2 +021800 02 FILLER PIC X(4) VALUE " IN ". SQ1464.2 +021900 02 FILLER PIC X(12) VALUE SQ1464.2 +022000 " HIGH ". SQ1464.2 +022100 02 FILLER PIC X(22) VALUE SQ1464.2 +022200 " LEVEL VALIDATION FOR ". SQ1464.2 +022300 02 FILLER PIC X(58) VALUE SQ1464.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1464.2 +022500 01 CCVS-H-3. SQ1464.2 +022600 02 FILLER PIC X(34) VALUE SQ1464.2 +022700 " FOR OFFICIAL USE ONLY ". SQ1464.2 +022800 02 FILLER PIC X(58) VALUE SQ1464.2 +022900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1464.2 +023000 02 FILLER PIC X(28) VALUE SQ1464.2 +023100 " COPYRIGHT 1985,1986 ". SQ1464.2 +023200 01 CCVS-E-1. SQ1464.2 +023300 02 FILLER PIC X(52) VALUE SPACE. SQ1464.2 +023400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1464.2 +023500 02 ID-AGAIN PIC X(9). SQ1464.2 +023600 02 FILLER PIC X(45) VALUE SPACES. SQ1464.2 +023700 01 CCVS-E-2. SQ1464.2 +023800 02 FILLER PIC X(31) VALUE SPACE. SQ1464.2 +023900 02 FILLER PIC X(21) VALUE SPACE. SQ1464.2 +024000 02 CCVS-E-2-2. SQ1464.2 +024100 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1464.2 +024200 03 FILLER PIC X VALUE SPACE. SQ1464.2 +024300 03 ENDER-DESC PIC X(44) VALUE SQ1464.2 +024400 "ERRORS ENCOUNTERED". SQ1464.2 +024500 01 CCVS-E-3. SQ1464.2 +024600 02 FILLER PIC X(22) VALUE SQ1464.2 +024700 " FOR OFFICIAL USE ONLY". SQ1464.2 +024800 02 FILLER PIC X(12) VALUE SPACE. SQ1464.2 +024900 02 FILLER PIC X(58) VALUE SQ1464.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1464.2 +025100 02 FILLER PIC X(8) VALUE SPACE. SQ1464.2 +025200 02 FILLER PIC X(20) VALUE SQ1464.2 +025300 " COPYRIGHT 1985,1986". SQ1464.2 +025400 01 CCVS-E-4. SQ1464.2 +025500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1464.2 +025600 02 FILLER PIC X(4) VALUE " OF ". SQ1464.2 +025700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1464.2 +025800 02 FILLER PIC X(40) VALUE SQ1464.2 +025900 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1464.2 +026000 01 XXINFO. SQ1464.2 +026100 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1464.2 +026200 02 INFO-TEXT. SQ1464.2 +026300 04 FILLER PIC X(8) VALUE SPACE. SQ1464.2 +026400 04 XXCOMPUTED PIC X(20). SQ1464.2 +026500 04 FILLER PIC X(5) VALUE SPACE. SQ1464.2 +026600 04 XXCORRECT PIC X(20). SQ1464.2 +026700 02 INF-ANSI-REFERENCE PIC X(48). SQ1464.2 +026800 01 HYPHEN-LINE. SQ1464.2 +026900 02 FILLER PIC IS X VALUE IS SPACE. SQ1464.2 +027000 02 FILLER PIC IS X(65) VALUE IS "************************SQ1464.2 +027100- "*****************************************". SQ1464.2 +027200 02 FILLER PIC IS X(54) VALUE IS "************************SQ1464.2 +027300- "******************************". SQ1464.2 +027400 01 CCVS-PGM-ID PIC X(9) VALUE SQ1464.2 +027500 "SQ146A". SQ1464.2 +027600* SQ1464.2 +027700 PROCEDURE DIVISION. SQ1464.2 +027800 CCVS1 SECTION. SQ1464.2 +027900 OPEN-FILES. SQ1464.2 +028000 OPEN OUTPUT PRINT-FILE. SQ1464.2 +028100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1464.2 +028200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1464.2 +028300 MOVE SPACE TO TEST-RESULTS. SQ1464.2 +028400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1464.2 +028500 MOVE ZERO TO REC-SKEL-SUB. SQ1464.2 +028600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1464.2 +028700 GO TO CCVS1-EXIT. SQ1464.2 +028800* SQ1464.2 +028900 CCVS-INIT-FILE. SQ1464.2 +029000 ADD 1 TO REC-SKL-SUB. SQ1464.2 +029100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1464.2 +029200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1464.2 +029300* SQ1464.2 +029400 CLOSE-FILES. SQ1464.2 +029500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1464.2 +029600 CLOSE PRINT-FILE. SQ1464.2 +029700 TERMINATE-CCVS. SQ1464.2 +029800 STOP RUN. SQ1464.2 +029900* SQ1464.2 +030000 INSPT. SQ1464.2 +030100 MOVE "INSPT" TO P-OR-F. SQ1464.2 +030200 ADD 1 TO INSPECT-COUNTER. SQ1464.2 +030300 PERFORM PRINT-DETAIL. SQ1464.2 +030400 SQ1464.2 +030500 PASS. SQ1464.2 +030600 MOVE "PASS " TO P-OR-F. SQ1464.2 +030700 ADD 1 TO PASS-COUNTER. SQ1464.2 +030800 PERFORM PRINT-DETAIL. SQ1464.2 +030900* SQ1464.2 +031000 FAIL. SQ1464.2 +031100 MOVE "FAIL*" TO P-OR-F. SQ1464.2 +031200 ADD 1 TO ERROR-COUNTER. SQ1464.2 +031300 PERFORM PRINT-DETAIL. SQ1464.2 +031400* SQ1464.2 +031500 DE-LETE. SQ1464.2 +031600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1464.2 +031700 MOVE "*****" TO P-OR-F. SQ1464.2 +031800 ADD 1 TO DELETE-COUNTER. SQ1464.2 +031900 PERFORM PRINT-DETAIL. SQ1464.2 +032000* SQ1464.2 +032100 PRINT-DETAIL. SQ1464.2 +032200 IF REC-CT NOT EQUAL TO ZERO SQ1464.2 +032300 MOVE "." TO PARDOT-X SQ1464.2 +032400 MOVE REC-CT TO DOTVALUE. SQ1464.2 +032500 MOVE TEST-RESULTS TO PRINT-REC. SQ1464.2 +032600 PERFORM WRITE-LINE. SQ1464.2 +032700 IF P-OR-F EQUAL TO "FAIL*" SQ1464.2 +032800 PERFORM WRITE-LINE SQ1464.2 +032900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1464.2 +033000 ELSE SQ1464.2 +033100 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1464.2 +033200 MOVE SPACE TO P-OR-F. SQ1464.2 +033300 MOVE SPACE TO COMPUTED-X. SQ1464.2 +033400 MOVE SPACE TO CORRECT-X. SQ1464.2 +033500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1464.2 +033600 MOVE SPACE TO RE-MARK. SQ1464.2 +033700* SQ1464.2 +033800 HEAD-ROUTINE. SQ1464.2 +033900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +034000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +034100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1464.2 +034200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1464.2 +034300 COLUMN-NAMES-ROUTINE. SQ1464.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1464.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1464.2 +034700 END-ROUTINE. SQ1464.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1464.2 +034900 PERFORM WRITE-LINE 5 TIMES. SQ1464.2 +035000 END-RTN-EXIT. SQ1464.2 +035100 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1464.2 +035200 PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +035300* SQ1464.2 +035400 END-ROUTINE-1. SQ1464.2 +035500 ADD ERROR-COUNTER TO ERROR-HOLD SQ1464.2 +035600 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1464.2 +035700 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1464.2 +035800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1464.2 +035900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1464.2 +036000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1464.2 +036100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1464.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1464.2 +036300 PERFORM WRITE-LINE. SQ1464.2 +036400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1464.2 +036500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1464.2 +036600 MOVE "NO " TO ERROR-TOTAL SQ1464.2 +036700 ELSE SQ1464.2 +036800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1464.2 +036900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1464.2 +037000 PERFORM WRITE-LINE. SQ1464.2 +037100 END-ROUTINE-13. SQ1464.2 +037200 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1464.2 +037300 MOVE "NO " TO ERROR-TOTAL SQ1464.2 +037400 ELSE SQ1464.2 +037500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1464.2 +037600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1464.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1464.2 +037800 PERFORM WRITE-LINE. SQ1464.2 +037900 IF INSPECT-COUNTER EQUAL TO ZERO SQ1464.2 +038000 MOVE "NO " TO ERROR-TOTAL SQ1464.2 +038100 ELSE SQ1464.2 +038200 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1464.2 +038300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1464.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1464.2 +038500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1464.2 +038600* SQ1464.2 +038700 WRITE-LINE. SQ1464.2 +038800 ADD 1 TO RECORD-COUNT. SQ1464.2 +038900 IF RECORD-COUNT GREATER 50 SQ1464.2 +039000 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1464.2 +039100 MOVE SPACE TO DUMMY-RECORD SQ1464.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1464.2 +039300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1464.2 +039400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1464.2 +039500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1464.2 +039600 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1464.2 +039700 MOVE ZERO TO RECORD-COUNT. SQ1464.2 +039800 PERFORM WRT-LN. SQ1464.2 +039900* SQ1464.2 +040000 WRT-LN. SQ1464.2 +040100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1464.2 +040200 MOVE SPACE TO DUMMY-RECORD. SQ1464.2 +040300 BLANK-LINE-PRINT. SQ1464.2 +040400 PERFORM WRT-LN. SQ1464.2 +040500 FAIL-ROUTINE. SQ1464.2 +040600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1464.2 +040700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1464.2 +040800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1464.2 +040900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1464.2 +041000 MOVE XXINFO TO DUMMY-RECORD. SQ1464.2 +041100 PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +041200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1464.2 +041300 GO TO FAIL-ROUTINE-EX. SQ1464.2 +041400 FAIL-ROUTINE-WRITE. SQ1464.2 +041500 MOVE TEST-COMPUTED TO PRINT-REC SQ1464.2 +041600 PERFORM WRITE-LINE SQ1464.2 +041700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1464.2 +041800 MOVE TEST-CORRECT TO PRINT-REC SQ1464.2 +041900 PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +042000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1464.2 +042100 FAIL-ROUTINE-EX. SQ1464.2 +042200 EXIT. SQ1464.2 +042300 BAIL-OUT. SQ1464.2 +042400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1464.2 +042500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1464.2 +042600 BAIL-OUT-WRITE. SQ1464.2 +042700 MOVE CORRECT-A TO XXCORRECT. SQ1464.2 +042800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1464.2 +042900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1464.2 +043000 MOVE XXINFO TO DUMMY-RECORD. SQ1464.2 +043100 PERFORM WRITE-LINE 2 TIMES. SQ1464.2 +043200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1464.2 +043300 BAIL-OUT-EX. SQ1464.2 +043400 EXIT. SQ1464.2 +043500 CCVS1-EXIT. SQ1464.2 +043600 EXIT. SQ1464.2 +043700* SQ1464.2 +043800**************************************************************** SQ1464.2 +043900* * SQ1464.2 +044000* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1464.2 +044100* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1464.2 +044200* * SQ1464.2 +044300**************************************************************** SQ1464.2 +044400* SQ1464.2 +044500 SECT-SQ146A-0001 SECTION. SQ1464.2 +044600 WRITE-INIT-GF-01. SQ1464.2 +044700* SQ1464.2 +044800* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1464.2 +044900* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1464.2 +045000* SQ1464.2 +045100 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1464.2 +045200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1464.2 +045300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1464.2 +045400 MOVE 120 TO XRECORD-LENGTH (1). SQ1464.2 +045500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1464.2 +045600 MOVE 1 TO XBLOCK-SIZE (1). SQ1464.2 +045700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1464.2 +045800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1464.2 +045900 MOVE "S" TO XLABEL-TYPE (1). SQ1464.2 +046000 MOVE 1 TO XRECORD-NUMBER (1). SQ1464.2 +046100* SQ1464.2 +046200 WRITE-OPEN-01. SQ1464.2 +046300 OPEN OUTPUT SQ-FS1. SQ1464.2 +046400* SQ1464.2 +046500* WRITE A SINGLE RECORD TO THE FILE SQ1464.2 +046600* SQ1464.2 +046700 WRITE-INIT-01. SQ1464.2 +046800 WRITE-TEST-01-01. SQ1464.2 +046900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1464.2 +047000 WRITE SQ-FS1R1-F-G-120. SQ1464.2 +047100* SQ1464.2 +047200* CLOSE THE FILE. SQ1464.2 +047300* SQ1464.2 +047400 CLOSE-INIT-01. SQ1464.2 +047500 CLOSE-TEST-01. SQ1464.2 +047600 CLOSE SQ-FS1. SQ1464.2 +047700* SQ1464.2 +047800* HAVING CLOSED THE FILE, WE NOW TRY TO CLOSE IT AGAIN. SQ1464.2 +047900* THE TEST PASSES IF THE FILE CANNOT BE RECLOSED AND SQ1464.2 +048000* THE APPROPRIATE I-O STATUS VALUE IS RETURNED. SQ1464.2 +048100* AN IMPLEMENTATION MAY TERMINATE EXECUTION OF THE SQ1464.2 +048200* PROGRAM ON EXECUTION OF THE CLOSE OR MAY RETURN CONTROL SQ1464.2 +048300* TO THE STATEMENT FOLLOWING THE CLOSE STATEMENT. SQ1464.2 +048400* SQ1464.2 +048500 CLOSE-INIT-02. SQ1464.2 +048600* SQ1464.2 +048700 MOVE "CLOSE A CLOSED FILE" TO FEATURE. SQ1464.2 +048800 MOVE "**" TO SQ-FS1-STATUS. SQ1464.2 +048900 MOVE 1 TO REC-CT. SQ1464.2 +049000 MOVE "CLOSE-TEST-02" TO PAR-NAME. SQ1464.2 +049100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1464.2 +049200 TO DUMMY-RECORD. SQ1464.2 +049300 PERFORM WRITE-LINE 3 TIMES. SQ1464.2 +049400* SQ1464.2 +049500 CLOSE-TEST-02. SQ1464.2 +049600 CLOSE SQ-FS1. SQ1464.2 +049700 IF SQ-FS1-STATUS = "42" SQ1464.2 +049800 PERFORM PASS SQ1464.2 +049900 ELSE SQ1464.2 +050000 MOVE "42" TO CORRECT-A SQ1464.2 +050100 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1464.2 +050200 MOVE "STATUS OF CLOSE OF CLOSED FILE INCORRECT" SQ1464.2 +050300 TO RE-MARK SQ1464.2 +050400 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1464.2 +050500 PERFORM FAIL SQ1464.2 +050600 END-IF. SQ1464.2 +050700* SQ1464.2 +050800 CCVS-EXIT SECTION. SQ1464.2 +050900 CCVS-999999. SQ1464.2 +051000 GO TO CLOSE-FILES. SQ1464.2 diff --git a/tests/cobol85/SQ/SQ147A.CBL b/tests/cobol85/SQ/SQ147A.CBL new file mode 100755 index 00000000..0ea6c8a2 --- /dev/null +++ b/tests/cobol85/SQ/SQ147A.CBL @@ -0,0 +1,613 @@ +000100 IDENTIFICATION DIVISION. SQ1474.2 +000200 PROGRAM-ID. SQ1474.2 +000300 SQ147A. SQ1474.2 +000400**************************************************************** SQ1474.2 +000500* * SQ1474.2 +000600* VALIDATION FOR:- * SQ1474.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 +000800* USING CCVS85 VERSION 3.0. * SQ1474.2 +000900* * SQ1474.2 +001000* CREATION DATE / VALIDATION DATE * SQ1474.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1474.2 +001200* * SQ1474.2 +001300**************************************************************** SQ1474.2 +001400* * SQ1474.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1474.2 +001600* * SQ1474.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ1474.2 +001800* X-55 SYSTEM PRINTER * SQ1474.2 +001900* X-82 SOURCE-COMPUTER * SQ1474.2 +002000* X-83 OBJECT-COMPUTER * SQ1474.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1474.2 +002200* * SQ1474.2 +002300**************************************************************** SQ1474.2 +002400* * SQ1474.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1474.2 +002600* A CLOSED FILE. THE TEST FOR CORRECT I-O STATUS CODE 47 * SQ1474.2 +002700* IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION IS * SQ1474.2 +002800* POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1474.2 +002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1474.2 +003000* LINE CODE. * SQ1474.2 +003100* * SQ1474.2 +003200**************************************************************** SQ1474.2 +003300* SQ1474.2 +003400 ENVIRONMENT DIVISION. SQ1474.2 +003500 CONFIGURATION SECTION. SQ1474.2 +003600 SOURCE-COMPUTER. SQ1474.2 +003700 Linux. SQ1474.2 +003800 OBJECT-COMPUTER. SQ1474.2 +003900 Linux. SQ1474.2 +004000* SQ1474.2 +004100 INPUT-OUTPUT SECTION. SQ1474.2 +004200 FILE-CONTROL. SQ1474.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1474.2 +004400 "report.log". SQ1474.2 +004500* SQ1474.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1474.2 +004700 "XXXXX014" SQ1474.2 +004800 FILE STATUS SQ-FS1-STATUS. SQ1474.2 +004900* SQ1474.2 +005000* SQ1474.2 +005100 DATA DIVISION. SQ1474.2 +005200 FILE SECTION. SQ1474.2 +005300 FD PRINT-FILE SQ1474.2 +005400*C LABEL RECORDS SQ1474.2 +005500*C OMITTED SQ1474.2 +005600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1474.2 +005700 . SQ1474.2 +005800 01 PRINT-REC PICTURE X(120). SQ1474.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1474.2 +006000* SQ1474.2 +006100 FD SQ-FS1 SQ1474.2 +006200*C LABEL RECORD IS STANDARD SQ1474.2 +006300 . SQ1474.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1474.2 +006500* SQ1474.2 +006600 WORKING-STORAGE SECTION. SQ1474.2 +006700* SQ1474.2 +006800*************************************************************** SQ1474.2 +006900* * SQ1474.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1474.2 +007100* * SQ1474.2 +007200*************************************************************** SQ1474.2 +007300* SQ1474.2 +007400 01 SQ-FS1-STATUS. SQ1474.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1474.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1474.2 +007700* SQ1474.2 +007800* SQ1474.2 +007900*************************************************************** SQ1474.2 +008000* * SQ1474.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1474.2 +008200* * SQ1474.2 +008300*************************************************************** SQ1474.2 +008400* SQ1474.2 +008500 01 REC-SKEL-SUB PIC 99. SQ1474.2 +008600* SQ1474.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1474.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1474.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1474.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1474.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1474.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1474.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1474.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1474.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1474.2 +009600 ",RECKEY= ". SQ1474.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1474.2 +009800 ",ALTKEY1= ". SQ1474.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1474.2 +010000 ",ALTKEY2= ". SQ1474.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1474.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1474.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1474.2 +010400 07 FILLER PIC X(5). SQ1474.2 +010500 07 XFILE-NAME PIC X(6). SQ1474.2 +010600 07 FILLER PIC X(8). SQ1474.2 +010700 07 XRECORD-NAME PIC X(6). SQ1474.2 +010800 07 FILLER PIC X(1). SQ1474.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1474.2 +011000 07 FILLER PIC X(7). SQ1474.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1474.2 +011200 07 FILLER PIC X(6). SQ1474.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1474.2 +011400 07 FILLER PIC X(5). SQ1474.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1474.2 +011600 07 FILLER PIC X(5). SQ1474.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1474.2 +011800 07 FILLER PIC X(7). SQ1474.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1474.2 +012000 07 FILLER PIC X(7). SQ1474.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1474.2 +012200 07 FILLER PIC X(1). SQ1474.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1474.2 +012400 07 FILLER PIC X(6). SQ1474.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1474.2 +012600 07 FILLER PIC X(5). SQ1474.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1474.2 +012800 07 FILLER PIC X(6). SQ1474.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1474.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1474.2 +013100 07 FILLER PIC X(8). SQ1474.2 +013200 07 XRECORD-KEY PIC X(29). SQ1474.2 +013300 07 FILLER PIC X(9). SQ1474.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1474.2 +013500 07 FILLER PIC X(9). SQ1474.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1474.2 +013700 07 FILLER PIC X(7). SQ1474.2 +013800* SQ1474.2 +013900 01 TEST-RESULTS. SQ1474.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1474.2 +014100 02 PAR-NAME. SQ1474.2 +014200 03 FILLER PIC X(14) VALUE SPACE. SQ1474.2 +014300 03 PARDOT-X PIC X VALUE SPACE. SQ1474.2 +014400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1474.2 +014500 02 FILLER PIC X VALUE SPACE. SQ1474.2 +014600 02 FEATURE PIC X(24) VALUE SPACE. SQ1474.2 +014700 02 FILLER PIC X VALUE SPACE. SQ1474.2 +014800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1474.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ1474.2 +015000 02 RE-MARK PIC X(61). SQ1474.2 +015100 01 TEST-COMPUTED. SQ1474.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1474.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1474.2 +015400 02 COMPUTED-X. SQ1474.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1474.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1474.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1474.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1474.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1474.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1474.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ1474.2 +016200 04 FILLER PIC X. SQ1474.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1474.2 +016400 01 TEST-CORRECT. SQ1474.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1474.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1474.2 +016700 02 CORRECT-X. SQ1474.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1474.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1474.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1474.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1474.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1474.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1474.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ1474.2 +017500 04 FILLER PIC X. SQ1474.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ1474.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1474.2 +017800* SQ1474.2 +017900 01 CCVS-C-1. SQ1474.2 +018000 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 +018100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1474.2 +018200 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 +018300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1474.2 +018400 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 +018500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1474.2 +018600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1474.2 +018700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1474.2 +018800 01 CCVS-C-2. SQ1474.2 +018900 02 FILLER PIC X(19) VALUE SPACE. SQ1474.2 +019000 02 FILLER PIC X(6) VALUE "TESTED". SQ1474.2 +019100 02 FILLER PIC X(19) VALUE SPACE. SQ1474.2 +019200 02 FILLER PIC X(4) VALUE "FAIL". SQ1474.2 +019300 02 FILLER PIC X(72) VALUE SPACE. SQ1474.2 +019400* SQ1474.2 +019500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1474.2 +019600 01 REC-CT PIC 99 VALUE ZERO. SQ1474.2 +019700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1474.2 +019800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1474.2 +019900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1474.2 +020000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1474.2 +020100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1474.2 +020200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1474.2 +020300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1474.2 +020400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1474.2 +020500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1474.2 +020600 01 CCVS-H-1. SQ1474.2 +020700 02 FILLER PIC X(39) VALUE SPACES. SQ1474.2 +020800 02 FILLER PIC X(42) VALUE SQ1474.2 +020900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1474.2 +021000 02 FILLER PIC X(39) VALUE SPACES. SQ1474.2 +021100 01 CCVS-H-2A. SQ1474.2 +021200 02 FILLER PIC X(40) VALUE SPACE. SQ1474.2 +021300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1474.2 +021400 02 FILLER PIC XXXX VALUE SQ1474.2 +021500 "4.2 ". SQ1474.2 +021600 02 FILLER PIC X(28) VALUE SQ1474.2 +021700 " COPY - NOT FOR DISTRIBUTION". SQ1474.2 +021800 02 FILLER PIC X(41) VALUE SPACE. SQ1474.2 +021900* SQ1474.2 +022000 01 CCVS-H-2B. SQ1474.2 +022100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1474.2 +022200 02 TEST-ID PIC X(9). SQ1474.2 +022300 02 FILLER PIC X(4) VALUE " IN ". SQ1474.2 +022400 02 FILLER PIC X(12) VALUE SQ1474.2 +022500 " HIGH ". SQ1474.2 +022600 02 FILLER PIC X(22) VALUE SQ1474.2 +022700 " LEVEL VALIDATION FOR ". SQ1474.2 +022800 02 FILLER PIC X(58) VALUE SQ1474.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 +023000 01 CCVS-H-3. SQ1474.2 +023100 02 FILLER PIC X(34) VALUE SQ1474.2 +023200 " FOR OFFICIAL USE ONLY ". SQ1474.2 +023300 02 FILLER PIC X(58) VALUE SQ1474.2 +023400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1474.2 +023500 02 FILLER PIC X(28) VALUE SQ1474.2 +023600 " COPYRIGHT 1985,1986 ". SQ1474.2 +023700 01 CCVS-E-1. SQ1474.2 +023800 02 FILLER PIC X(52) VALUE SPACE. SQ1474.2 +023900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1474.2 +024000 02 ID-AGAIN PIC X(9). SQ1474.2 +024100 02 FILLER PIC X(45) VALUE SPACES. SQ1474.2 +024200 01 CCVS-E-2. SQ1474.2 +024300 02 FILLER PIC X(31) VALUE SPACE. SQ1474.2 +024400 02 FILLER PIC X(21) VALUE SPACE. SQ1474.2 +024500 02 CCVS-E-2-2. SQ1474.2 +024600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1474.2 +024700 03 FILLER PIC X VALUE SPACE. SQ1474.2 +024800 03 ENDER-DESC PIC X(44) VALUE SQ1474.2 +024900 "ERRORS ENCOUNTERED". SQ1474.2 +025000 01 CCVS-E-3. SQ1474.2 +025100 02 FILLER PIC X(22) VALUE SQ1474.2 +025200 " FOR OFFICIAL USE ONLY". SQ1474.2 +025300 02 FILLER PIC X(12) VALUE SPACE. SQ1474.2 +025400 02 FILLER PIC X(58) VALUE SQ1474.2 +025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 +025600 02 FILLER PIC X(8) VALUE SPACE. SQ1474.2 +025700 02 FILLER PIC X(20) VALUE SQ1474.2 +025800 " COPYRIGHT 1985,1986". SQ1474.2 +025900 01 CCVS-E-4. SQ1474.2 +026000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1474.2 +026100 02 FILLER PIC X(4) VALUE " OF ". SQ1474.2 +026200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1474.2 +026300 02 FILLER PIC X(40) VALUE SQ1474.2 +026400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1474.2 +026500 01 XXINFO. SQ1474.2 +026600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1474.2 +026700 02 INFO-TEXT. SQ1474.2 +026800 04 FILLER PIC X(8) VALUE SPACE. SQ1474.2 +026900 04 XXCOMPUTED PIC X(20). SQ1474.2 +027000 04 FILLER PIC X(5) VALUE SPACE. SQ1474.2 +027100 04 XXCORRECT PIC X(20). SQ1474.2 +027200 02 INF-ANSI-REFERENCE PIC X(48). SQ1474.2 +027300 01 HYPHEN-LINE. SQ1474.2 +027400 02 FILLER PIC IS X VALUE IS SPACE. SQ1474.2 +027500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1474.2 +027600- "*****************************************". SQ1474.2 +027700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1474.2 +027800- "******************************". SQ1474.2 +027900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1474.2 +028000 "SQ147A". SQ1474.2 +028100* SQ1474.2 +028200* SQ1474.2 +028300 PROCEDURE DIVISION. SQ1474.2 +028400 DECLARATIVES. SQ1474.2 +028500 SQ147A-DECLARATIVE-001-SECT SECTION. SQ1474.2 +028600 USE AFTER STANDARD ERROR PROCEDURE SQ-FS1. SQ1474.2 +028700 SQ-FS1-ERROR-PROCEDURE. SQ1474.2 +028800 IF SQ-FS1-STATUS = "47" SQ1474.2 +028900 PERFORM DECL-PASS SQ1474.2 +029000 GO TO DECL-ABNORMAL-TERM SQ1474.2 +029100 ELSE SQ1474.2 +029200 MOVE "47" TO CORRECT-A SQ1474.2 +029300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1474.2 +029400 MOVE "STATUS FOR READ OF CLOSED FILE INCORRECT" SQ1474.2 +029500 TO RE-MARK SQ1474.2 +029600 MOVE "VII-5, 1.3.5(4)F" TO ANSI-REFERENCE SQ1474.2 +029700 PERFORM DECL-FAIL SQ1474.2 +029800 GO TO DECL-ABNORMAL-TERM SQ1474.2 +029900 END-IF. SQ1474.2 +030000* SQ1474.2 +030100 DECL-PASS. SQ1474.2 +030200 MOVE "PASS " TO P-OR-F. SQ1474.2 +030300 ADD 1 TO PASS-COUNTER. SQ1474.2 +030400 PERFORM DECL-PRINT-DETAIL. SQ1474.2 +030500* SQ1474.2 +030600 DECL-FAIL. SQ1474.2 +030700 MOVE "FAIL*" TO P-OR-F. SQ1474.2 +030800 ADD 1 TO ERROR-COUNTER. SQ1474.2 +030900 PERFORM DECL-PRINT-DETAIL. SQ1474.2 +031000* SQ1474.2 +031100 DECL-DE-LETE. SQ1474.2 +031200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1474.2 +031300 MOVE "*****" TO P-OR-F. SQ1474.2 +031400 ADD 1 TO DELETE-COUNTER. SQ1474.2 +031500 PERFORM DECL-PRINT-DETAIL. SQ1474.2 +031600* SQ1474.2 +031700 DECL-PRINT-DETAIL. SQ1474.2 +031800 IF REC-CT NOT EQUAL TO ZERO SQ1474.2 +031900 MOVE "." TO PARDOT-X SQ1474.2 +032000 MOVE REC-CT TO DOTVALUE. SQ1474.2 +032100 MOVE TEST-RESULTS TO PRINT-REC. SQ1474.2 +032200 PERFORM DECL-WRITE-LINE. SQ1474.2 +032300 IF P-OR-F EQUAL TO "FAIL*" SQ1474.2 +032400 PERFORM DECL-WRITE-LINE SQ1474.2 +032500 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1474.2 +032600 ELSE SQ1474.2 +032700 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1474.2 +032800 MOVE SPACE TO P-OR-F. SQ1474.2 +032900 MOVE SPACE TO COMPUTED-X. SQ1474.2 +033000 MOVE SPACE TO CORRECT-X. SQ1474.2 +033100 IF REC-CT EQUAL TO ZERO SQ1474.2 +033200 MOVE SPACE TO PAR-NAME. SQ1474.2 +033300 MOVE SPACE TO RE-MARK. SQ1474.2 +033400* SQ1474.2 +033500 DECL-WRITE-LINE. SQ1474.2 +033600 ADD 1 TO RECORD-COUNT. SQ1474.2 +033700 IF RECORD-COUNT GREATER 50 SQ1474.2 +033800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1474.2 +033900 MOVE SPACE TO DUMMY-RECORD SQ1474.2 +034000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1474.2 +034100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1474.2 +034200 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1474.2 +034300 PERFORM DECL-WRT-LN 2 TIMES SQ1474.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1474.2 +034500 PERFORM DECL-WRT-LN SQ1474.2 +034600 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1474.2 +034700 MOVE ZERO TO RECORD-COUNT. SQ1474.2 +034800 PERFORM DECL-WRT-LN. SQ1474.2 +034900* SQ1474.2 +035000 DECL-WRT-LN. SQ1474.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1474.2 +035200 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 +035300* SQ1474.2 +035400 DECL-FAIL-ROUTINE. SQ1474.2 +035500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1474.2 +035600 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1474.2 +035700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 +035800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1474.2 +035900 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 +036000 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 +036100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 +036200 GO TO DECL-FAIL-EX. SQ1474.2 +036300 DECL-FAIL-WRITE. SQ1474.2 +036400 MOVE TEST-COMPUTED TO PRINT-REC SQ1474.2 +036500 PERFORM DECL-WRITE-LINE SQ1474.2 +036600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1474.2 +036700 MOVE TEST-CORRECT TO PRINT-REC SQ1474.2 +036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 +036900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1474.2 +037000 DECL-FAIL-EX. SQ1474.2 +037100 EXIT. SQ1474.2 +037200* SQ1474.2 +037300 DECL-BAIL. SQ1474.2 +037400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1474.2 +037500 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1474.2 +037600 DECL-BAIL-WRITE. SQ1474.2 +037700 MOVE CORRECT-A TO XXCORRECT. SQ1474.2 +037800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1474.2 +037900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 +038000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 +038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 +038200 MOVE SPACE TO INF-ANSI-REFERENCE. SQ1474.2 +038300 DECL-BAIL-EX. SQ1474.2 +038400 EXIT. SQ1474.2 +038500* SQ1474.2 +038600 DECL-ABNORMAL-TERM. SQ1474.2 +038700 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 +038800 PERFORM DECL-WRITE-LINE. SQ1474.2 +038900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1474.2 +039000 TO DUMMY-RECORD. SQ1474.2 +039100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1474.2 +039200* SQ1474.2 +039300 END-DECLS. SQ1474.2 +039400 EXIT. SQ1474.2 +039500 END DECLARATIVES. SQ1474.2 +039600* SQ1474.2 +039700* SQ1474.2 +039800 CCVS1 SECTION. SQ1474.2 +039900 OPEN-FILES. SQ1474.2 +040000 OPEN OUTPUT PRINT-FILE. SQ1474.2 +040100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1474.2 +040200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1474.2 +040300 MOVE SPACE TO TEST-RESULTS. SQ1474.2 +040400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1474.2 +040500 MOVE ZERO TO REC-SKEL-SUB. SQ1474.2 +040600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1474.2 +040700 GO TO CCVS1-EXIT. SQ1474.2 +040800* SQ1474.2 +040900 CCVS-INIT-FILE. SQ1474.2 +041000 ADD 1 TO REC-SKL-SUB. SQ1474.2 +041100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1474.2 +041200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1474.2 +041300* SQ1474.2 +041400 CLOSE-FILES. SQ1474.2 +041500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1474.2 +041600 CLOSE PRINT-FILE. SQ1474.2 +041700 TERMINATE-CCVS. SQ1474.2 +041800 STOP RUN. SQ1474.2 +041900* SQ1474.2 +042000 INSPT. SQ1474.2 +042100 MOVE "INSPT" TO P-OR-F. SQ1474.2 +042200 ADD 1 TO INSPECT-COUNTER. SQ1474.2 +042300 PERFORM PRINT-DETAIL. SQ1474.2 +042400 SQ1474.2 +042500 PASS. SQ1474.2 +042600 MOVE "PASS " TO P-OR-F. SQ1474.2 +042700 ADD 1 TO PASS-COUNTER. SQ1474.2 +042800 PERFORM PRINT-DETAIL. SQ1474.2 +042900* SQ1474.2 +043000 FAIL. SQ1474.2 +043100 MOVE "FAIL*" TO P-OR-F. SQ1474.2 +043200 ADD 1 TO ERROR-COUNTER. SQ1474.2 +043300 PERFORM PRINT-DETAIL. SQ1474.2 +043400* SQ1474.2 +043500 DE-LETE. SQ1474.2 +043600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1474.2 +043700 MOVE "*****" TO P-OR-F. SQ1474.2 +043800 ADD 1 TO DELETE-COUNTER. SQ1474.2 +043900 PERFORM PRINT-DETAIL. SQ1474.2 +044000* SQ1474.2 +044100 PRINT-DETAIL. SQ1474.2 +044200 IF REC-CT NOT EQUAL TO ZERO SQ1474.2 +044300 MOVE "." TO PARDOT-X SQ1474.2 +044400 MOVE REC-CT TO DOTVALUE. SQ1474.2 +044500 MOVE TEST-RESULTS TO PRINT-REC. SQ1474.2 +044600 PERFORM WRITE-LINE. SQ1474.2 +044700 IF P-OR-F EQUAL TO "FAIL*" SQ1474.2 +044800 PERFORM WRITE-LINE SQ1474.2 +044900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1474.2 +045000 ELSE SQ1474.2 +045100 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1474.2 +045200 MOVE SPACE TO P-OR-F. SQ1474.2 +045300 MOVE SPACE TO COMPUTED-X. SQ1474.2 +045400 MOVE SPACE TO CORRECT-X. SQ1474.2 +045500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1474.2 +045600 MOVE SPACE TO RE-MARK. SQ1474.2 +045700* SQ1474.2 +045800 HEAD-ROUTINE. SQ1474.2 +045900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +046000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +046100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1474.2 +046200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1474.2 +046300 COLUMN-NAMES-ROUTINE. SQ1474.2 +046400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 +046500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +046600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 +046700 END-ROUTINE. SQ1474.2 +046800 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1474.2 +046900 PERFORM WRITE-LINE 5 TIMES. SQ1474.2 +047000 END-RTN-EXIT. SQ1474.2 +047100 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1474.2 +047200 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +047300* SQ1474.2 +047400 END-ROUTINE-1. SQ1474.2 +047500 ADD ERROR-COUNTER TO ERROR-HOLD SQ1474.2 +047600 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1474.2 +047700 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1474.2 +047800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1474.2 +047900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1474.2 +048000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1474.2 +048100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1474.2 +048200 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1474.2 +048300 PERFORM WRITE-LINE. SQ1474.2 +048400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1474.2 +048500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1474.2 +048600 MOVE "NO " TO ERROR-TOTAL SQ1474.2 +048700 ELSE SQ1474.2 +048800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1474.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1474.2 +049000 PERFORM WRITE-LINE. SQ1474.2 +049100 END-ROUTINE-13. SQ1474.2 +049200 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1474.2 +049300 MOVE "NO " TO ERROR-TOTAL SQ1474.2 +049400 ELSE SQ1474.2 +049500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1474.2 +049600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1474.2 +049700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1474.2 +049800 PERFORM WRITE-LINE. SQ1474.2 +049900 IF INSPECT-COUNTER EQUAL TO ZERO SQ1474.2 +050000 MOVE "NO " TO ERROR-TOTAL SQ1474.2 +050100 ELSE SQ1474.2 +050200 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1474.2 +050300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1474.2 +050400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 +050500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 +050600* SQ1474.2 +050700 WRITE-LINE. SQ1474.2 +050800 ADD 1 TO RECORD-COUNT. SQ1474.2 +050900 IF RECORD-COUNT GREATER 50 SQ1474.2 +051000 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1474.2 +051100 MOVE SPACE TO DUMMY-RECORD SQ1474.2 +051200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1474.2 +051300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1474.2 +051400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1474.2 +051500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1474.2 +051600 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1474.2 +051700 MOVE ZERO TO RECORD-COUNT. SQ1474.2 +051800 PERFORM WRT-LN. SQ1474.2 +051900* SQ1474.2 +052000 WRT-LN. SQ1474.2 +052100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1474.2 +052200 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 +052300 BLANK-LINE-PRINT. SQ1474.2 +052400 PERFORM WRT-LN. SQ1474.2 +052500 FAIL-ROUTINE. SQ1474.2 +052600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1474.2 +052700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1474.2 +052800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 +052900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1474.2 +053000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 +053100 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +053200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 +053300 GO TO FAIL-ROUTINE-EX. SQ1474.2 +053400 FAIL-ROUTINE-WRITE. SQ1474.2 +053500 MOVE TEST-COMPUTED TO PRINT-REC SQ1474.2 +053600 PERFORM WRITE-LINE SQ1474.2 +053700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1474.2 +053800 MOVE TEST-CORRECT TO PRINT-REC SQ1474.2 +053900 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +054000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1474.2 +054100 FAIL-ROUTINE-EX. SQ1474.2 +054200 EXIT. SQ1474.2 +054300 BAIL-OUT. SQ1474.2 +054400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1474.2 +054500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1474.2 +054600 BAIL-OUT-WRITE. SQ1474.2 +054700 MOVE CORRECT-A TO XXCORRECT. SQ1474.2 +054800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1474.2 +054900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 +055000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 +055100 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 +055200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 +055300 BAIL-OUT-EX. SQ1474.2 +055400 EXIT. SQ1474.2 +055500 CCVS1-EXIT. SQ1474.2 +055600 EXIT. SQ1474.2 +055700* SQ1474.2 +055800**************************************************************** SQ1474.2 +055900* * SQ1474.2 +056000* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1474.2 +056100* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1474.2 +056200* * SQ1474.2 +056300**************************************************************** SQ1474.2 +056400* SQ1474.2 +056500 SECT-SQ147A-0001 SECTION. SQ1474.2 +056600 WRITE-INIT-FG-01. SQ1474.2 +056700* SQ1474.2 +056800* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1474.2 +056900* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1474.2 +057000* SQ1474.2 +057100 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1474.2 +057200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1474.2 +057300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1474.2 +057400 MOVE 120 TO XRECORD-LENGTH (1). SQ1474.2 +057500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1474.2 +057600 MOVE 1 TO XBLOCK-SIZE (1). SQ1474.2 +057700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1474.2 +057800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1474.2 +057900 MOVE "S" TO XLABEL-TYPE (1). SQ1474.2 +058000 MOVE 1 TO XRECORD-NUMBER (1). SQ1474.2 +058100* SQ1474.2 +058200 WRITE-OPEN-01. SQ1474.2 +058300 OPEN OUTPUT SQ-FS1. SQ1474.2 +058400* SQ1474.2 +058500* WRITE A SINGLE RECORD TO THE FILE SQ1474.2 +058600* SQ1474.2 +058700 WRITE-INIT-01. SQ1474.2 +058800 WRITE-TEST-01-01. SQ1474.2 +058900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1474.2 +059000 WRITE SQ-FS1R1-F-G-120. SQ1474.2 +059100* SQ1474.2 +059200* CLOSE THE FILE. SQ1474.2 +059300* SQ1474.2 +059400 CLOSE-INIT-01. SQ1474.2 +059500 CLOSE-TEST-01. SQ1474.2 +059600 CLOSE SQ-FS1. SQ1474.2 +059700* SQ1474.2 +059800 READ-INIT-01. SQ1474.2 +059900* SQ1474.2 +060000* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE SQ1474.2 +060100* CLOSED FILE. I-O STATUS 47 SHOULD BE GENERATED. SQ1474.2 +060200* SQ1474.2 +060300 MOVE "READ CLOSED FILE" TO FEATURE. SQ1474.2 +060400 MOVE "**" TO SQ-FS1-STATUS. SQ1474.2 +060500 MOVE "READ-TEST-01" TO PAR-NAME. SQ1474.2 +060600 MOVE 1 TO REC-CT. SQ1474.2 +060700* SQ1474.2 +060800 READ-TEST-01. SQ1474.2 +060900 READ SQ-FS1. SQ1474.2 +061000* SQ1474.2 +061100 CCVS-EXIT SECTION. SQ1474.2 +061200 CCVS-999999. SQ1474.2 +061300 GO TO CLOSE-FILES. SQ1474.2 diff --git a/tests/cobol85/SQ/SQ148A.CBL b/tests/cobol85/SQ/SQ148A.CBL new file mode 100755 index 00000000..72e72f0f --- /dev/null +++ b/tests/cobol85/SQ/SQ148A.CBL @@ -0,0 +1,652 @@ +000100 IDENTIFICATION DIVISION. SQ1484.2 +000200 PROGRAM-ID. SQ1484.2 +000300 SQ148A. SQ1484.2 +000400**************************************************************** SQ1484.2 +000500* * SQ1484.2 +000600* VALIDATION FOR:- * SQ1484.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1484.2 +000800* USING CCVS85 VERSION 3.0. * SQ1484.2 +000900* * SQ1484.2 +001000* CREATION DATE / VALIDATION DATE * SQ1484.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1484.2 +001200* * SQ1484.2 +001300**************************************************************** SQ1484.2 +001400* * SQ1484.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1484.2 +001600* * SQ1484.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1484.2 +001800* X-55 SYSTEM PRINTER * SQ1484.2 +001900* X-82 SOURCE-COMPUTER * SQ1484.2 +002000* X-83 OBJECT-COMPUTER * SQ1484.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1484.2 +002200* * SQ1484.2 +002300**************************************************************** SQ1484.2 +002400* * SQ1484.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1484.2 +002600* A FILE OPEN IN THE OUTPUT MODE. THE TEST FOR CORRECT * SQ1484.2 +002700* I-O STATUS CODE 47 IS IN THE DECLARATIVES. AN ABNORMAL * SQ1484.2 +002800* TERMINATION IS POSSIBLE AFTER THE TEST OF THE I-O STATUS * SQ1484.2 +002900* CODE IS ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO * SQ1484.2 +003000* THE MAIN LINE CODE. * SQ1484.2 +003100* * SQ1484.2 +003200**************************************************************** SQ1484.2 +003300* SQ1484.2 +003400 ENVIRONMENT DIVISION. SQ1484.2 +003500 CONFIGURATION SECTION. SQ1484.2 +003600 SOURCE-COMPUTER. SQ1484.2 +003700 Linux. SQ1484.2 +003800 OBJECT-COMPUTER. SQ1484.2 +003900 Linux. SQ1484.2 +004000* SQ1484.2 +004100 INPUT-OUTPUT SECTION. SQ1484.2 +004200 FILE-CONTROL. SQ1484.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1484.2 +004400 "report.log". SQ1484.2 +004500* SQ1484.2 +004600 SELECT SQ-FS4 SQ1484.2 +004700 ASSIGN SQ1484.2 +004800 "XXXXX014" SQ1484.2 +004900 FILE STATUS SQ-FS4-STATUS SQ1484.2 +005000 ORGANIZATION IS SEQUENTIAL SQ1484.2 +005100 . SQ1484.2 +005200* SQ1484.2 +005300* SQ1484.2 +005400 DATA DIVISION. SQ1484.2 +005500 FILE SECTION. SQ1484.2 +005600 FD PRINT-FILE SQ1484.2 +005700*C LABEL RECORDS SQ1484.2 +005800*C OMITTED SQ1484.2 +005900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1484.2 +006000 . SQ1484.2 +006100 01 PRINT-REC PICTURE X(120). SQ1484.2 +006200 01 DUMMY-RECORD PICTURE X(120). SQ1484.2 +006300* SQ1484.2 +006400 FD SQ-FS4 SQ1484.2 +006500*C LABEL RECORD IS STANDARD SQ1484.2 +006600 BLOCK CONTAINS 120 CHARACTERS SQ1484.2 +006700 RECORD CONTAINS 120 CHARACTERS SQ1484.2 +006800 . SQ1484.2 +006900 01 SQ-FS4R1-F-G-120. SQ1484.2 +007000 05 FFILE-RECORD-INFO-P1-120. SQ1484.2 +007100 07 FILLER PIC X(5). SQ1484.2 +007200 07 FFILE-NAME PIC X(6). SQ1484.2 +007300 07 FILLER PIC X(8). SQ1484.2 +007400 07 FRECORD-NAME PIC X(6). SQ1484.2 +007500 07 FILLER PIC X(1). SQ1484.2 +007600 07 FREELUNIT-NUMBER PIC 9(1). SQ1484.2 +007700 07 FILLER PIC X(7). SQ1484.2 +007800 07 FRECORD-NUMBER PIC 9(6). SQ1484.2 +007900 07 FILLER PIC X(6). SQ1484.2 +008000 07 FUPDATE-NUMBER PIC 9(2). SQ1484.2 +008100 07 FILLER PIC X(5). SQ1484.2 +008200 07 FODO-NUMBER PIC 9(4). SQ1484.2 +008300 07 FILLER PIC X(5). SQ1484.2 +008400 07 FPROGRAM-NAME PIC X(5). SQ1484.2 +008500 07 FILLER PIC X(7). SQ1484.2 +008600 07 FRECORD-LENGTH PIC 9(6). SQ1484.2 +008700 07 FILLER PIC X(7). SQ1484.2 +008800 07 FCHARS-OR-RECORDS PIC X(2). SQ1484.2 +008900 07 FILLER PIC X(1). SQ1484.2 +009000 07 FBLOCK-SIZE PIC 9(4). SQ1484.2 +009100 07 FILLER PIC X(6). SQ1484.2 +009200 07 FRECORDS-IN-FILE PIC 9(6). SQ1484.2 +009300 07 FILLER PIC X(5). SQ1484.2 +009400 07 FFILE-ORGANIZATION PIC X(2). SQ1484.2 +009500 07 FILLER PIC X(6). SQ1484.2 +009600 07 FLABEL-TYPE PIC X(1). SQ1484.2 +009700* SQ1484.2 +009800 WORKING-STORAGE SECTION. SQ1484.2 +009900* SQ1484.2 +010000*************************************************************** SQ1484.2 +010100* * SQ1484.2 +010200* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1484.2 +010300* * SQ1484.2 +010400*************************************************************** SQ1484.2 +010500* SQ1484.2 +010600 01 STATUS-GROUP. SQ1484.2 +010700 04 SQ-FS4-STATUS. SQ1484.2 +010800 07 SQ-FS4-KEY-1 PIC X. SQ1484.2 +010900 07 SQ-FS4-KEY-2 PIC X. SQ1484.2 +011000* SQ1484.2 +011100*************************************************************** SQ1484.2 +011200* * SQ1484.2 +011300* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1484.2 +011400* * SQ1484.2 +011500*************************************************************** SQ1484.2 +011600* SQ1484.2 +011700 01 REC-SKEL-SUB PIC 99. SQ1484.2 +011800* SQ1484.2 +011900 01 FILE-RECORD-INFORMATION-REC. SQ1484.2 +012000 03 FILE-RECORD-INFO-SKELETON. SQ1484.2 +012100 05 FILLER PICTURE X(48) VALUE SQ1484.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1484.2 +012300 05 FILLER PICTURE X(46) VALUE SQ1484.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1484.2 +012500 05 FILLER PICTURE X(26) VALUE SQ1484.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". SQ1484.2 +012700 05 FILLER PICTURE X(37) VALUE SQ1484.2 +012800 ",RECKEY= ". SQ1484.2 +012900 05 FILLER PICTURE X(38) VALUE SQ1484.2 +013000 ",ALTKEY1= ". SQ1484.2 +013100 05 FILLER PICTURE X(38) VALUE SQ1484.2 +013200 ",ALTKEY2= ". SQ1484.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1484.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1484.2 +013500 05 FILE-RECORD-INFO-P1-120. SQ1484.2 +013600 07 FILLER PIC X(5). SQ1484.2 +013700 07 XFILE-NAME PIC X(6). SQ1484.2 +013800 07 FILLER PIC X(8). SQ1484.2 +013900 07 XRECORD-NAME PIC X(6). SQ1484.2 +014000 07 FILLER PIC X(1). SQ1484.2 +014100 07 REELUNIT-NUMBER PIC 9(1). SQ1484.2 +014200 07 FILLER PIC X(7). SQ1484.2 +014300 07 XRECORD-NUMBER PIC 9(6). SQ1484.2 +014400 07 FILLER PIC X(6). SQ1484.2 +014500 07 UPDATE-NUMBER PIC 9(2). SQ1484.2 +014600 07 FILLER PIC X(5). SQ1484.2 +014700 07 ODO-NUMBER PIC 9(4). SQ1484.2 +014800 07 FILLER PIC X(5). SQ1484.2 +014900 07 XPROGRAM-NAME PIC X(5). SQ1484.2 +015000 07 FILLER PIC X(7). SQ1484.2 +015100 07 XRECORD-LENGTH PIC 9(6). SQ1484.2 +015200 07 FILLER PIC X(7). SQ1484.2 +015300 07 CHARS-OR-RECORDS PIC X(2). SQ1484.2 +015400 07 FILLER PIC X(1). SQ1484.2 +015500 07 XBLOCK-SIZE PIC 9(4). SQ1484.2 +015600 07 FILLER PIC X(6). SQ1484.2 +015700 07 RECORDS-IN-FILE PIC 9(6). SQ1484.2 +015800 07 FILLER PIC X(5). SQ1484.2 +015900 07 XFILE-ORGANIZATION PIC X(2). SQ1484.2 +016000 07 FILLER PIC X(6). SQ1484.2 +016100 07 XLABEL-TYPE PIC X(1). SQ1484.2 +016200 05 FILE-RECORD-INFO-P121-240. SQ1484.2 +016300 07 FILLER PIC X(8). SQ1484.2 +016400 07 XRECORD-KEY PIC X(29). SQ1484.2 +016500 07 FILLER PIC X(9). SQ1484.2 +016600 07 ALTERNATE-KEY1 PIC X(29). SQ1484.2 +016700 07 FILLER PIC X(9). SQ1484.2 +016800 07 ALTERNATE-KEY2 PIC X(29). SQ1484.2 +016900 07 FILLER PIC X(7). SQ1484.2 +017000* SQ1484.2 +017100 01 TEST-RESULTS. SQ1484.2 +017200 02 FILLER PIC X VALUE SPACE. SQ1484.2 +017300 02 PAR-NAME. SQ1484.2 +017400 03 FILLER PIC X(14) VALUE SPACE. SQ1484.2 +017500 03 PARDOT-X PIC X VALUE SPACE. SQ1484.2 +017600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1484.2 +017700 02 FILLER PIC X VALUE SPACE. SQ1484.2 +017800 02 FEATURE PIC X(24) VALUE SPACE. SQ1484.2 +017900 02 FILLER PIC X VALUE SPACE. SQ1484.2 +018000 02 P-OR-F PIC X(5) VALUE SPACE. SQ1484.2 +018100 02 FILLER PIC X(9) VALUE SPACE. SQ1484.2 +018200 02 RE-MARK PIC X(61). SQ1484.2 +018300 01 TEST-COMPUTED. SQ1484.2 +018400 02 FILLER PIC X(30) VALUE SPACE. SQ1484.2 +018500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1484.2 +018600 02 COMPUTED-X. SQ1484.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1484.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1484.2 +018900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1484.2 +019000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1484.2 +019100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1484.2 +019200 03 CM-18V0 REDEFINES COMPUTED-A. SQ1484.2 +019300 04 COMPUTED-18V0 PIC -9(18). SQ1484.2 +019400 04 FILLER PIC X. SQ1484.2 +019500 03 FILLER PIC X(50) VALUE SPACE. SQ1484.2 +019600 01 TEST-CORRECT. SQ1484.2 +019700 02 FILLER PIC X(30) VALUE SPACE. SQ1484.2 +019800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1484.2 +019900 02 CORRECT-X. SQ1484.2 +020000 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1484.2 +020100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1484.2 +020200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1484.2 +020300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1484.2 +020400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1484.2 +020500 03 CR-18V0 REDEFINES CORRECT-A. SQ1484.2 +020600 04 CORRECT-18V0 PIC -9(18). SQ1484.2 +020700 04 FILLER PIC X. SQ1484.2 +020800 03 FILLER PIC X(2) VALUE SPACE. SQ1484.2 +020900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1484.2 +021000* SQ1484.2 +021100 01 CCVS-C-1. SQ1484.2 +021200 02 FILLER PIC IS X VALUE SPACE. SQ1484.2 +021300 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1484.2 +021400 02 FILLER PIC IS X VALUE SPACE. SQ1484.2 +021500 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1484.2 +021600 02 FILLER PIC IS X VALUE SPACE. SQ1484.2 +021700 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1484.2 +021800 02 FILLER PIC IS X(9) VALUE SPACE. SQ1484.2 +021900 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1484.2 +022000 01 CCVS-C-2. SQ1484.2 +022100 02 FILLER PIC X(19) VALUE SPACE. SQ1484.2 +022200 02 FILLER PIC X(6) VALUE "TESTED". SQ1484.2 +022300 02 FILLER PIC X(19) VALUE SPACE. SQ1484.2 +022400 02 FILLER PIC X(4) VALUE "FAIL". SQ1484.2 +022500 02 FILLER PIC X(72) VALUE SPACE. SQ1484.2 +022600* SQ1484.2 +022700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1484.2 +022800 01 REC-CT PIC 99 VALUE ZERO. SQ1484.2 +022900 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1484.2 +023000 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1484.2 +023100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1484.2 +023200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1484.2 +023300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1484.2 +023400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1484.2 +023500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1484.2 +023600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1484.2 +023700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1484.2 +023800 01 CCVS-H-1. SQ1484.2 +023900 02 FILLER PIC X(39) VALUE SPACES. SQ1484.2 +024000 02 FILLER PIC X(42) VALUE SQ1484.2 +024100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1484.2 +024200 02 FILLER PIC X(39) VALUE SPACES. SQ1484.2 +024300 01 CCVS-H-2A. SQ1484.2 +024400 02 FILLER PIC X(40) VALUE SPACE. SQ1484.2 +024500 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1484.2 +024600 02 FILLER PIC XXXX VALUE SQ1484.2 +024700 "4.2 ". SQ1484.2 +024800 02 FILLER PIC X(28) VALUE SQ1484.2 +024900 " COPY - NOT FOR DISTRIBUTION". SQ1484.2 +025000 02 FILLER PIC X(41) VALUE SPACE. SQ1484.2 +025100* SQ1484.2 +025200 01 CCVS-H-2B. SQ1484.2 +025300 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1484.2 +025400 02 TEST-ID PIC X(9). SQ1484.2 +025500 02 FILLER PIC X(4) VALUE " IN ". SQ1484.2 +025600 02 FILLER PIC X(12) VALUE SQ1484.2 +025700 " HIGH ". SQ1484.2 +025800 02 FILLER PIC X(22) VALUE SQ1484.2 +025900 " LEVEL VALIDATION FOR ". SQ1484.2 +026000 02 FILLER PIC X(58) VALUE SQ1484.2 +026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1484.2 +026200 01 CCVS-H-3. SQ1484.2 +026300 02 FILLER PIC X(34) VALUE SQ1484.2 +026400 " FOR OFFICIAL USE ONLY ". SQ1484.2 +026500 02 FILLER PIC X(58) VALUE SQ1484.2 +026600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1484.2 +026700 02 FILLER PIC X(28) VALUE SQ1484.2 +026800 " COPYRIGHT 1985,1986 ". SQ1484.2 +026900 01 CCVS-E-1. SQ1484.2 +027000 02 FILLER PIC X(52) VALUE SPACE. SQ1484.2 +027100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1484.2 +027200 02 ID-AGAIN PIC X(9). SQ1484.2 +027300 02 FILLER PIC X(45) VALUE SPACES. SQ1484.2 +027400 01 CCVS-E-2. SQ1484.2 +027500 02 FILLER PIC X(31) VALUE SPACE. SQ1484.2 +027600 02 FILLER PIC X(21) VALUE SPACE. SQ1484.2 +027700 02 CCVS-E-2-2. SQ1484.2 +027800 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1484.2 +027900 03 FILLER PIC X VALUE SPACE. SQ1484.2 +028000 03 ENDER-DESC PIC X(44) VALUE SQ1484.2 +028100 "ERRORS ENCOUNTERED". SQ1484.2 +028200 01 CCVS-E-3. SQ1484.2 +028300 02 FILLER PIC X(22) VALUE SQ1484.2 +028400 " FOR OFFICIAL USE ONLY". SQ1484.2 +028500 02 FILLER PIC X(12) VALUE SPACE. SQ1484.2 +028600 02 FILLER PIC X(58) VALUE SQ1484.2 +028700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1484.2 +028800 02 FILLER PIC X(8) VALUE SPACE. SQ1484.2 +028900 02 FILLER PIC X(20) VALUE SQ1484.2 +029000 " COPYRIGHT 1985,1986". SQ1484.2 +029100 01 CCVS-E-4. SQ1484.2 +029200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1484.2 +029300 02 FILLER PIC X(4) VALUE " OF ". SQ1484.2 +029400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1484.2 +029500 02 FILLER PIC X(40) VALUE SQ1484.2 +029600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1484.2 +029700 01 XXINFO. SQ1484.2 +029800 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1484.2 +029900 02 INFO-TEXT. SQ1484.2 +030000 04 FILLER PIC X(8) VALUE SPACE. SQ1484.2 +030100 04 XXCOMPUTED PIC X(20). SQ1484.2 +030200 04 FILLER PIC X(5) VALUE SPACE. SQ1484.2 +030300 04 XXCORRECT PIC X(20). SQ1484.2 +030400 02 INF-ANSI-REFERENCE PIC X(48). SQ1484.2 +030500 01 HYPHEN-LINE. SQ1484.2 +030600 02 FILLER PIC IS X VALUE IS SPACE. SQ1484.2 +030700 02 FILLER PIC IS X(65) VALUE IS "************************SQ1484.2 +030800- "*****************************************". SQ1484.2 +030900 02 FILLER PIC IS X(54) VALUE IS "************************SQ1484.2 +031000- "******************************". SQ1484.2 +031100 01 CCVS-PGM-ID PIC X(9) VALUE SQ1484.2 +031200 "SQ148A". SQ1484.2 +031300* SQ1484.2 +031400* SQ1484.2 +031500 PROCEDURE DIVISION. SQ1484.2 +031600 DECLARATIVES. SQ1484.2 +031700* SQ1484.2 +031800 SQ148A-DECLARATIVE-001-SECT SECTION. SQ1484.2 +031900 USE AFTER STANDARD EXCEPTION PROCEDURE OUTPUT. SQ1484.2 +032000 READ-ERROR-PROCESS. SQ1484.2 +032100 IF SQ-FS4-STATUS = "47" SQ1484.2 +032200 PERFORM DECL-PASS SQ1484.2 +032300 GO TO DECL-ABNORMAL-TERM SQ1484.2 +032400 ELSE SQ1484.2 +032500 MOVE "47" TO CORRECT-A SQ1484.2 +032600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1484.2 +032700 MOVE "STATUS FOR READ OF FILE OPEN OUTPUT INCORRECT" SQ1484.2 +032800 TO RE-MARK SQ1484.2 +032900 MOVE "VII-5, 1.3.5(4)F" TO ANSI-REFERENCE SQ1484.2 +033000 PERFORM DECL-FAIL SQ1484.2 +033100 GO TO DECL-ABNORMAL-TERM SQ1484.2 +033200 END-IF. SQ1484.2 +033300* SQ1484.2 +033400 DECL-PASS. SQ1484.2 +033500 MOVE "PASS " TO P-OR-F. SQ1484.2 +033600 ADD 1 TO PASS-COUNTER. SQ1484.2 +033700 PERFORM DECL-PRINT-DETAIL. SQ1484.2 +033800* SQ1484.2 +033900 DECL-FAIL. SQ1484.2 +034000 MOVE "FAIL*" TO P-OR-F. SQ1484.2 +034100 ADD 1 TO ERROR-COUNTER. SQ1484.2 +034200 PERFORM DECL-PRINT-DETAIL. SQ1484.2 +034300* SQ1484.2 +034400 DECL-DE-LETE. SQ1484.2 +034500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1484.2 +034600 MOVE "*****" TO P-OR-F. SQ1484.2 +034700 ADD 1 TO DELETE-COUNTER. SQ1484.2 +034800 PERFORM DECL-PRINT-DETAIL. SQ1484.2 +034900* SQ1484.2 +035000 DECL-PRINT-DETAIL. SQ1484.2 +035100 IF REC-CT NOT EQUAL TO ZERO SQ1484.2 +035200 MOVE "." TO PARDOT-X SQ1484.2 +035300 MOVE REC-CT TO DOTVALUE. SQ1484.2 +035400 MOVE TEST-RESULTS TO PRINT-REC. SQ1484.2 +035500 PERFORM DECL-WRITE-LINE. SQ1484.2 +035600 IF P-OR-F EQUAL TO "FAIL*" SQ1484.2 +035700 PERFORM DECL-WRITE-LINE SQ1484.2 +035800 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1484.2 +035900 ELSE SQ1484.2 +036000 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1484.2 +036100 MOVE SPACE TO P-OR-F. SQ1484.2 +036200 MOVE SPACE TO COMPUTED-X. SQ1484.2 +036300 MOVE SPACE TO CORRECT-X. SQ1484.2 +036400 IF REC-CT EQUAL TO ZERO SQ1484.2 +036500 MOVE SPACE TO PAR-NAME. SQ1484.2 +036600 MOVE SPACE TO RE-MARK. SQ1484.2 +036700* SQ1484.2 +036800 DECL-WRITE-LINE. SQ1484.2 +036900 ADD 1 TO RECORD-COUNT. SQ1484.2 +037000 IF RECORD-COUNT GREATER 50 SQ1484.2 +037100 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1484.2 +037200 MOVE SPACE TO DUMMY-RECORD SQ1484.2 +037300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1484.2 +037400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1484.2 +037500 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1484.2 +037600 PERFORM DECL-WRT-LN 2 TIMES SQ1484.2 +037700 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1484.2 +037800 PERFORM DECL-WRT-LN SQ1484.2 +037900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1484.2 +038000 MOVE ZERO TO RECORD-COUNT. SQ1484.2 +038100 PERFORM DECL-WRT-LN. SQ1484.2 +038200* SQ1484.2 +038300 DECL-WRT-LN. SQ1484.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1484.2 +038500 MOVE SPACE TO DUMMY-RECORD. SQ1484.2 +038600* SQ1484.2 +038700 DECL-FAIL-ROUTINE. SQ1484.2 +038800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1484.2 +038900 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1484.2 +039000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1484.2 +039100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1484.2 +039200 MOVE XXINFO TO DUMMY-RECORD. SQ1484.2 +039300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1484.2 +039400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1484.2 +039500 GO TO DECL-FAIL-EX. SQ1484.2 +039600 DECL-FAIL-WRITE. SQ1484.2 +039700 MOVE TEST-COMPUTED TO PRINT-REC SQ1484.2 +039800 PERFORM DECL-WRITE-LINE SQ1484.2 +039900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1484.2 +040000 MOVE TEST-CORRECT TO PRINT-REC SQ1484.2 +040100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1484.2 +040200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1484.2 +040300 DECL-FAIL-EX. SQ1484.2 +040400 EXIT. SQ1484.2 +040500* SQ1484.2 +040600 DECL-BAIL. SQ1484.2 +040700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1484.2 +040800 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1484.2 +040900 DECL-BAIL-WRITE. SQ1484.2 +041000 MOVE CORRECT-A TO XXCORRECT. SQ1484.2 +041100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1484.2 +041200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1484.2 +041300 MOVE XXINFO TO DUMMY-RECORD. SQ1484.2 +041400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1484.2 +041500 MOVE SPACE TO INF-ANSI-REFERENCE. SQ1484.2 +041600 DECL-BAIL-EX. SQ1484.2 +041700 EXIT. SQ1484.2 +041800* SQ1484.2 +041900 DECL-ABNORMAL-TERM. SQ1484.2 +042000 MOVE SPACE TO DUMMY-RECORD. SQ1484.2 +042100 PERFORM DECL-WRITE-LINE. SQ1484.2 +042200 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1484.2 +042300 TO DUMMY-RECORD. SQ1484.2 +042400 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1484.2 +042500* SQ1484.2 +042600 END-DECLS. SQ1484.2 +042700 EXIT. SQ1484.2 +042800 END DECLARATIVES. SQ1484.2 +042900* SQ1484.2 +043000* SQ1484.2 +043100 CCVS1 SECTION. SQ1484.2 +043200 OPEN-FILES. SQ1484.2 +043300 OPEN OUTPUT PRINT-FILE. SQ1484.2 +043400 MOVE CCVS-PGM-ID TO TEST-ID. SQ1484.2 +043500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1484.2 +043600 MOVE SPACE TO TEST-RESULTS. SQ1484.2 +043700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1484.2 +043800 MOVE ZERO TO REC-SKEL-SUB. SQ1484.2 +043900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1484.2 +044000 GO TO CCVS1-EXIT. SQ1484.2 +044100* SQ1484.2 +044200 CCVS-INIT-FILE. SQ1484.2 +044300 ADD 1 TO REC-SKL-SUB. SQ1484.2 +044400 MOVE FILE-RECORD-INFO-SKELETON TO SQ1484.2 +044500 FILE-RECORD-INFO (REC-SKL-SUB). SQ1484.2 +044600* SQ1484.2 +044700 CLOSE-FILES. SQ1484.2 +044800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1484.2 +044900 CLOSE PRINT-FILE. SQ1484.2 +045000 TERMINATE-CCVS. SQ1484.2 +045100 STOP RUN. SQ1484.2 +045200* SQ1484.2 +045300 INSPT. SQ1484.2 +045400 MOVE "INSPT" TO P-OR-F. SQ1484.2 +045500 ADD 1 TO INSPECT-COUNTER. SQ1484.2 +045600 PERFORM PRINT-DETAIL. SQ1484.2 +045700* SQ1484.2 +045800 PASS. SQ1484.2 +045900 MOVE "PASS " TO P-OR-F. SQ1484.2 +046000 ADD 1 TO PASS-COUNTER. SQ1484.2 +046100 PERFORM PRINT-DETAIL. SQ1484.2 +046200* SQ1484.2 +046300 FAIL. SQ1484.2 +046400 MOVE "FAIL*" TO P-OR-F. SQ1484.2 +046500 ADD 1 TO ERROR-COUNTER. SQ1484.2 +046600 PERFORM PRINT-DETAIL. SQ1484.2 +046700* SQ1484.2 +046800 DE-LETE. SQ1484.2 +046900 MOVE "****TEST DELETED****" TO RE-MARK. SQ1484.2 +047000 MOVE "*****" TO P-OR-F. SQ1484.2 +047100 ADD 1 TO DELETE-COUNTER. SQ1484.2 +047200 PERFORM PRINT-DETAIL. SQ1484.2 +047300* SQ1484.2 +047400 PRINT-DETAIL. SQ1484.2 +047500 IF REC-CT NOT EQUAL TO ZERO SQ1484.2 +047600 MOVE "." TO PARDOT-X SQ1484.2 +047700 MOVE REC-CT TO DOTVALUE. SQ1484.2 +047800 MOVE TEST-RESULTS TO PRINT-REC. SQ1484.2 +047900 PERFORM WRITE-LINE. SQ1484.2 +048000 IF P-OR-F EQUAL TO "FAIL*" SQ1484.2 +048100 PERFORM WRITE-LINE SQ1484.2 +048200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1484.2 +048300 ELSE SQ1484.2 +048400 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1484.2 +048500 MOVE SPACE TO P-OR-F. SQ1484.2 +048600 MOVE SPACE TO COMPUTED-X. SQ1484.2 +048700 MOVE SPACE TO CORRECT-X. SQ1484.2 +048800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1484.2 +048900 MOVE SPACE TO RE-MARK. SQ1484.2 +049000* SQ1484.2 +049100 HEAD-ROUTINE. SQ1484.2 +049200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +049300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +049400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1484.2 +049500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1484.2 +049600 COLUMN-NAMES-ROUTINE. SQ1484.2 +049700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1484.2 +049800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +049900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1484.2 +050000 END-ROUTINE. SQ1484.2 +050100 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1484.2 +050200 PERFORM WRITE-LINE 5 TIMES. SQ1484.2 +050300 END-RTN-EXIT. SQ1484.2 +050400 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1484.2 +050500 PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +050600* SQ1484.2 +050700 END-ROUTINE-1. SQ1484.2 +050800 ADD ERROR-COUNTER TO ERROR-HOLD SQ1484.2 +050900 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1484.2 +051000 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1484.2 +051100 ADD PASS-COUNTER TO ERROR-HOLD. SQ1484.2 +051200 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1484.2 +051300 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1484.2 +051400 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1484.2 +051500 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1484.2 +051600 PERFORM WRITE-LINE. SQ1484.2 +051700 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1484.2 +051800 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1484.2 +051900 MOVE "NO " TO ERROR-TOTAL SQ1484.2 +052000 ELSE SQ1484.2 +052100 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1484.2 +052200 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1484.2 +052300 PERFORM WRITE-LINE. SQ1484.2 +052400 END-ROUTINE-13. SQ1484.2 +052500 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1484.2 +052600 MOVE "NO " TO ERROR-TOTAL SQ1484.2 +052700 ELSE SQ1484.2 +052800 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1484.2 +052900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1484.2 +053000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1484.2 +053100 PERFORM WRITE-LINE. SQ1484.2 +053200 IF INSPECT-COUNTER EQUAL TO ZERO SQ1484.2 +053300 MOVE "NO " TO ERROR-TOTAL SQ1484.2 +053400 ELSE SQ1484.2 +053500 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1484.2 +053600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1484.2 +053700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1484.2 +053800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1484.2 +053900* SQ1484.2 +054000 WRITE-LINE. SQ1484.2 +054100 ADD 1 TO RECORD-COUNT. SQ1484.2 +054200 IF RECORD-COUNT GREATER 50 SQ1484.2 +054300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1484.2 +054400 MOVE SPACE TO DUMMY-RECORD SQ1484.2 +054500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1484.2 +054600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1484.2 +054700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1484.2 +054800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1484.2 +054900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1484.2 +055000 MOVE ZERO TO RECORD-COUNT. SQ1484.2 +055100 PERFORM WRT-LN. SQ1484.2 +055200* SQ1484.2 +055300 WRT-LN. SQ1484.2 +055400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1484.2 +055500 MOVE SPACE TO DUMMY-RECORD. SQ1484.2 +055600 BLANK-LINE-PRINT. SQ1484.2 +055700 PERFORM WRT-LN. SQ1484.2 +055800 FAIL-ROUTINE. SQ1484.2 +055900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1484.2 +056000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1484.2 +056100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1484.2 +056200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1484.2 +056300 MOVE XXINFO TO DUMMY-RECORD. SQ1484.2 +056400 PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +056500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1484.2 +056600 GO TO FAIL-ROUTINE-EX. SQ1484.2 +056700 FAIL-ROUTINE-WRITE. SQ1484.2 +056800 MOVE TEST-COMPUTED TO PRINT-REC SQ1484.2 +056900 PERFORM WRITE-LINE SQ1484.2 +057000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1484.2 +057100 MOVE TEST-CORRECT TO PRINT-REC SQ1484.2 +057200 PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +057300 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1484.2 +057400 FAIL-ROUTINE-EX. SQ1484.2 +057500 EXIT. SQ1484.2 +057600 BAIL-OUT. SQ1484.2 +057700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1484.2 +057800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1484.2 +057900 BAIL-OUT-WRITE. SQ1484.2 +058000 MOVE CORRECT-A TO XXCORRECT. SQ1484.2 +058100 MOVE COMPUTED-A TO XXCOMPUTED. SQ1484.2 +058200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1484.2 +058300 MOVE XXINFO TO DUMMY-RECORD. SQ1484.2 +058400 PERFORM WRITE-LINE 2 TIMES. SQ1484.2 +058500 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1484.2 +058600 BAIL-OUT-EX. SQ1484.2 +058700 EXIT. SQ1484.2 +058800 CCVS1-EXIT. SQ1484.2 +058900 EXIT. SQ1484.2 +059000* SQ1484.2 +059100**************************************************************** SQ1484.2 +059200* * SQ1484.2 +059300* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1484.2 +059400* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1484.2 +059500* * SQ1484.2 +059600**************************************************************** SQ1484.2 +059700* SQ1484.2 +059800 SECT-SQ148A-0002 SECTION. SQ1484.2 +059900 STA-INIT. SQ1484.2 +060000* SQ1484.2 +060100 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1484.2 +060200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1484.2 +060300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1484.2 +060400 MOVE 120 TO XRECORD-LENGTH (1). SQ1484.2 +060500 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ1484.2 +060600 MOVE 1 TO XBLOCK-SIZE (1). SQ1484.2 +060700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1484.2 +060800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1484.2 +060900 MOVE "S" TO XLABEL-TYPE (1). SQ1484.2 +061000* SQ1484.2 +061100* OPEN THE FILE IN THE OUTPUT MODE SQ1484.2 +061200* SQ1484.2 +061300 SEQ-INIT-01. SQ1484.2 +061400 MOVE 1 TO REC-CT. SQ1484.2 +061500 MOVE "**" TO SQ-FS4-STATUS. SQ1484.2 +061600 MOVE ZERO TO XRECORD-NUMBER (1). SQ1484.2 +061700 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ1484.2 +061800 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ1484.2 +061900 SEQ-TEST-OP-01. SQ1484.2 +062000 OPEN OUTPUT SQ-FS4. SQ1484.2 +062100* SQ1484.2 +062200* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ1484.2 +062300* SQ1484.2 +062400 SEQ-TEST-OP-01-01. SQ1484.2 +062500 IF SQ-FS4-STATUS = "00" SQ1484.2 +062600 PERFORM PASS SQ1484.2 +062700 ELSE SQ1484.2 +062800 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1484.2 +062900 MOVE "00" TO CORRECT-A SQ1484.2 +063000 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ1484.2 +063100 TO RE-MARK SQ1484.2 +063200 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ1484.2 +063300 PERFORM FAIL. SQ1484.2 +063400 SEQ-TEST-01-01-END. SQ1484.2 +063500* SQ1484.2 +063600* SQ1484.2 +063700* A NEW FILE IS OPEN. WE NOW ATTEMPT TO READ A RECORD. SQ1484.2 +063800* SQ1484.2 +063900 SEQ-INIT-02. SQ1484.2 +064000 MOVE 1 TO REC-CT. SQ1484.2 +064100 MOVE "**" TO SQ-FS4-STATUS. SQ1484.2 +064200 MOVE "READ IN OUTPUT MODE" TO FEATURE. SQ1484.2 +064300 MOVE "SEQ-TEST-RD-02" TO PAR-NAME. SQ1484.2 +064400 SEQ-TEST-RD-02. SQ1484.2 +064500 READ SQ-FS4. SQ1484.2 +064600* SQ1484.2 +064700 CLOSE-TEST-03. SQ1484.2 +064800 CLOSE SQ-FS4. SQ1484.2 +064900* SQ1484.2 +065000 CCVS-EXIT SECTION. SQ1484.2 +065100 CCVS-999999. SQ1484.2 +065200 GO TO CLOSE-FILES. SQ1484.2 diff --git a/tests/cobol85/SQ/SQ149A.CBL b/tests/cobol85/SQ/SQ149A.CBL new file mode 100755 index 00000000..fcc93f51 --- /dev/null +++ b/tests/cobol85/SQ/SQ149A.CBL @@ -0,0 +1,505 @@ +000100 IDENTIFICATION DIVISION. SQ1494.2 +000200 PROGRAM-ID. SQ1494.2 +000300 SQ149A. SQ1494.2 +000400**************************************************************** SQ1494.2 +000500* * SQ1494.2 +000600* VALIDATION FOR:- * SQ1494.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1494.2 +000800* USING CCVS85 VERSION 3.0. * SQ1494.2 +000900* * SQ1494.2 +001000* CREATION DATE / VALIDATION DATE * SQ1494.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1494.2 +001200* * SQ1494.2 +001300**************************************************************** SQ1494.2 +001400* * SQ1494.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1494.2 +001600* * SQ1494.2 +001700* X-01 SEQUENTIAL TAPE * SQ1494.2 +001800* X-55 SYSTEM PRINTER * SQ1494.2 +001900* X-82 SOURCE-COMPUTER * SQ1494.2 +002000* X-83 OBJECT-COMPUTER. * SQ1494.2 +002100* X-84 LABEL RECORDS OPTION * SQ1494.2 +002200* * SQ1494.2 +002300**************************************************************** SQ1494.2 +002400* * SQ1494.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1494.2 +002600* A FILE THAT IS NOT OPEN (NOT OPEN IN THE INPUT OR I-O * SQ1494.2 +002700* MODE). THE TEST FOR CORRECT I-O STATUS CODE 47 IS IN THE * SQ1494.2 +002800* MAIN LINE CODE, THEREFORE AN ABNORMAL TERMINATION IS * SQ1494.2 +002900* POSSIBLE BEFORE THE TEST OF THE I-O STATUS CODE IS * SQ1494.2 +003000* ACCOMPLISHED. * SQ1494.2 +003100* * SQ1494.2 +003200**************************************************************** SQ1494.2 +003300* SQ1494.2 +003400 ENVIRONMENT DIVISION. SQ1494.2 +003500 CONFIGURATION SECTION. SQ1494.2 +003600 SOURCE-COMPUTER. SQ1494.2 +003700 Linux. SQ1494.2 +003800 OBJECT-COMPUTER. SQ1494.2 +003900 Linux. SQ1494.2 +004000* SQ1494.2 +004100 INPUT-OUTPUT SECTION. SQ1494.2 +004200 FILE-CONTROL. SQ1494.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1494.2 +004400 "report.log". SQ1494.2 +004500* SQ1494.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1494.2 +004700 "XXXXX001" SQ1494.2 +004800 FILE STATUS IS SQ-FS1-STATUS. SQ1494.2 +004900* SQ1494.2 +005000* SQ1494.2 +005100 DATA DIVISION. SQ1494.2 +005200 FILE SECTION. SQ1494.2 +005300 FD PRINT-FILE SQ1494.2 +005400*C LABEL RECORDS SQ1494.2 +005500*C OMITTED SQ1494.2 +005600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1494.2 +005700 . SQ1494.2 +005800 01 PRINT-REC PICTURE X(120). SQ1494.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1494.2 +006000* SQ1494.2 +006100 FD SQ-FS1 SQ1494.2 +006200*C LABEL RECORD IS STANDARD SQ1494.2 +006300 . SQ1494.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1494.2 +006500* SQ1494.2 +006600 WORKING-STORAGE SECTION. SQ1494.2 +006700* SQ1494.2 +006800*************************************************************** SQ1494.2 +006900* * SQ1494.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1494.2 +007100* * SQ1494.2 +007200*************************************************************** SQ1494.2 +007300* SQ1494.2 +007400 01 SQ-FS1-STATUS. SQ1494.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1494.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1494.2 +007700* SQ1494.2 +007800*************************************************************** SQ1494.2 +007900* * SQ1494.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1494.2 +008100* * SQ1494.2 +008200*************************************************************** SQ1494.2 +008300* SQ1494.2 +008400 01 REC-SKEL-SUB PIC 99. SQ1494.2 +008500* SQ1494.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ1494.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ1494.2 +008800 05 FILLER PICTURE X(48) VALUE SQ1494.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1494.2 +009000 05 FILLER PICTURE X(46) VALUE SQ1494.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1494.2 +009200 05 FILLER PICTURE X(26) VALUE SQ1494.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ1494.2 +009400 05 FILLER PICTURE X(37) VALUE SQ1494.2 +009500 ",RECKEY= ". SQ1494.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1494.2 +009700 ",ALTKEY1= ". SQ1494.2 +009800 05 FILLER PICTURE X(38) VALUE SQ1494.2 +009900 ",ALTKEY2= ". SQ1494.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE.SQ1494.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1494.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ1494.2 +010300 07 FILLER PIC X(5). SQ1494.2 +010400 07 XFILE-NAME PIC X(6). SQ1494.2 +010500 07 FILLER PIC X(8). SQ1494.2 +010600 07 XRECORD-NAME PIC X(6). SQ1494.2 +010700 07 FILLER PIC X(1). SQ1494.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ1494.2 +010900 07 FILLER PIC X(7). SQ1494.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ1494.2 +011100 07 FILLER PIC X(6). SQ1494.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ1494.2 +011300 07 FILLER PIC X(5). SQ1494.2 +011400 07 ODO-NUMBER PIC 9(4). SQ1494.2 +011500 07 FILLER PIC X(5). SQ1494.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ1494.2 +011700 07 FILLER PIC X(7). SQ1494.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ1494.2 +011900 07 FILLER PIC X(7). SQ1494.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ1494.2 +012100 07 FILLER PIC X(1). SQ1494.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ1494.2 +012300 07 FILLER PIC X(6). SQ1494.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ1494.2 +012500 07 FILLER PIC X(5). SQ1494.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ1494.2 +012700 07 FILLER PIC X(6). SQ1494.2 +012800 07 XLABEL-TYPE PIC X(1). SQ1494.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ1494.2 +013000 07 FILLER PIC X(8). SQ1494.2 +013100 07 XRECORD-KEY PIC X(29). SQ1494.2 +013200 07 FILLER PIC X(9). SQ1494.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ1494.2 +013400 07 FILLER PIC X(9). SQ1494.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ1494.2 +013600 07 FILLER PIC X(7). SQ1494.2 +013700* SQ1494.2 +013800 01 TEST-RESULTS. SQ1494.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1494.2 +014000 02 FEATURE PIC X(24) VALUE SPACE. SQ1494.2 +014100 02 FILLER PIC X VALUE SPACE. SQ1494.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1494.2 +014300 02 FILLER PIC X VALUE SPACE. SQ1494.2 +014400 02 PAR-NAME. SQ1494.2 +014500 03 FILLER PIC X(14) VALUE SPACE. SQ1494.2 +014600 03 PARDOT-X PIC X VALUE SPACE. SQ1494.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1494.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ1494.2 +014900 02 RE-MARK PIC X(61). SQ1494.2 +015000 01 TEST-COMPUTED. SQ1494.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ1494.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1494.2 +015300 02 COMPUTED-X. SQ1494.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1494.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1494.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1494.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1494.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1494.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1494.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ1494.2 +016100 04 FILLER PIC X. SQ1494.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ1494.2 +016300 01 TEST-CORRECT. SQ1494.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1494.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1494.2 +016600 02 CORRECT-X. SQ1494.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1494.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1494.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1494.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1494.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1494.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ1494.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ1494.2 +017400 04 FILLER PIC X. SQ1494.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ1494.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1494.2 +017700 01 CCVS-C-1. SQ1494.2 +017800 02 FILLER PIC IS X(4) VALUE SPACE. SQ1494.2 +017900 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1494.2 +018000- "SS PARAGRAPH-NAME SQ1494.2 +018100- " REMARKS". SQ1494.2 +018200 02 FILLER PIC X(17) VALUE SPACE. SQ1494.2 +018300 01 CCVS-C-2. SQ1494.2 +018400 02 FILLER PIC XXXX VALUE SPACE. SQ1494.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". SQ1494.2 +018600 02 FILLER PIC X(16) VALUE SPACE. SQ1494.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". SQ1494.2 +018800 02 FILLER PIC X(90) VALUE SPACE. SQ1494.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1494.2 +019000 01 REC-CT PIC 99 VALUE ZERO. SQ1494.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1494.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1494.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1494.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1494.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1494.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1494.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1494.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1494.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1494.2 +020000 01 CCVS-H-1. SQ1494.2 +020100 02 FILLER PIC X(39) VALUE SPACES. SQ1494.2 +020200 02 FILLER PIC X(42) VALUE SQ1494.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1494.2 +020400 02 FILLER PIC X(39) VALUE SPACES. SQ1494.2 +020500 01 CCVS-H-2A. SQ1494.2 +020600 02 FILLER PIC X(40) VALUE SPACE. SQ1494.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1494.2 +020800 02 FILLER PIC XXXX VALUE SQ1494.2 +020900 "4.2 ". SQ1494.2 +021000 02 FILLER PIC X(28) VALUE SQ1494.2 +021100 " COPY - NOT FOR DISTRIBUTION". SQ1494.2 +021200 02 FILLER PIC X(41) VALUE SPACE. SQ1494.2 +021300* SQ1494.2 +021400 01 CCVS-H-2B. SQ1494.2 +021500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1494.2 +021600 02 TEST-ID PIC X(9). SQ1494.2 +021700 02 FILLER PIC X(4) VALUE " IN ". SQ1494.2 +021800 02 FILLER PIC X(12) VALUE SQ1494.2 +021900 " HIGH ". SQ1494.2 +022000 02 FILLER PIC X(22) VALUE SQ1494.2 +022100 " LEVEL VALIDATION FOR ". SQ1494.2 +022200 02 FILLER PIC X(58) VALUE SQ1494.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1494.2 +022400 01 CCVS-H-3. SQ1494.2 +022500 02 FILLER PIC X(34) VALUE SQ1494.2 +022600 " FOR OFFICIAL USE ONLY ". SQ1494.2 +022700 02 FILLER PIC X(58) VALUE SQ1494.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1494.2 +022900 02 FILLER PIC X(28) VALUE SQ1494.2 +023000 " COPYRIGHT 1985,1986 ". SQ1494.2 +023100 01 CCVS-E-1. SQ1494.2 +023200 02 FILLER PIC X(52) VALUE SPACE. SQ1494.2 +023300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1494.2 +023400 02 ID-AGAIN PIC X(9). SQ1494.2 +023500 02 FILLER PIC X(45) VALUE SPACES. SQ1494.2 +023600 01 CCVS-E-2. SQ1494.2 +023700 02 FILLER PIC X(31) VALUE SPACE. SQ1494.2 +023800 02 FILLER PIC X(21) VALUE SPACE. SQ1494.2 +023900 02 CCVS-E-2-2. SQ1494.2 +024000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1494.2 +024100 03 FILLER PIC X VALUE SPACE. SQ1494.2 +024200 03 ENDER-DESC PIC X(44) VALUE SQ1494.2 +024300 "ERRORS ENCOUNTERED". SQ1494.2 +024400 01 CCVS-E-3. SQ1494.2 +024500 02 FILLER PIC X(22) VALUE SQ1494.2 +024600 " FOR OFFICIAL USE ONLY". SQ1494.2 +024700 02 FILLER PIC X(12) VALUE SPACE. SQ1494.2 +024800 02 FILLER PIC X(58) VALUE SQ1494.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1494.2 +025000 02 FILLER PIC X(8) VALUE SPACE. SQ1494.2 +025100 02 FILLER PIC X(20) VALUE SQ1494.2 +025200 " COPYRIGHT 1985,1986". SQ1494.2 +025300 01 CCVS-E-4. SQ1494.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1494.2 +025500 02 FILLER PIC X(4) VALUE " OF ". SQ1494.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1494.2 +025700 02 FILLER PIC X(40) VALUE SQ1494.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1494.2 +025900 01 XXINFO. SQ1494.2 +026000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1494.2 +026100 02 INFO-TEXT. SQ1494.2 +026200 04 FILLER PIC X(8) VALUE SPACE. SQ1494.2 +026300 04 XXCOMPUTED PIC X(20). SQ1494.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ1494.2 +026500 04 XXCORRECT PIC X(20). SQ1494.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). SQ1494.2 +026700 01 HYPHEN-LINE. SQ1494.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. SQ1494.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1494.2 +027000- "*****************************************". SQ1494.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1494.2 +027200- "******************************". SQ1494.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1494.2 +027400 "SQ149A". SQ1494.2 +027500* SQ1494.2 +027600 PROCEDURE DIVISION. SQ1494.2 +027700 CCVS1 SECTION. SQ1494.2 +027800 OPEN-FILES. SQ1494.2 +027900 OPEN OUTPUT PRINT-FILE. SQ1494.2 +028000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1494.2 +028100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1494.2 +028200 MOVE SPACE TO TEST-RESULTS. SQ1494.2 +028300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1494.2 +028400 MOVE ZERO TO REC-SKEL-SUB. SQ1494.2 +028500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1494.2 +028600 GO TO CCVS1-EXIT. SQ1494.2 +028700* SQ1494.2 +028800 CCVS-INIT-FILE. SQ1494.2 +028900 ADD 1 TO REC-SKL-SUB. SQ1494.2 +029000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1494.2 +029100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1494.2 +029200* SQ1494.2 +029300 CLOSE-FILES. SQ1494.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1494.2 +029500 CLOSE PRINT-FILE. SQ1494.2 +029600 TERMINATE-CCVS. SQ1494.2 +029700 STOP RUN. SQ1494.2 +029800* SQ1494.2 +029900 INSPT. SQ1494.2 +030000 MOVE "INSPT" TO P-OR-F. SQ1494.2 +030100 ADD 1 TO INSPECT-COUNTER. SQ1494.2 +030200 PERFORM PRINT-DETAIL. SQ1494.2 +030300 SQ1494.2 +030400 PASS. SQ1494.2 +030500 MOVE "PASS " TO P-OR-F. SQ1494.2 +030600 ADD 1 TO PASS-COUNTER. SQ1494.2 +030700 PERFORM PRINT-DETAIL. SQ1494.2 +030800* SQ1494.2 +030900 FAIL. SQ1494.2 +031000 MOVE "FAIL*" TO P-OR-F. SQ1494.2 +031100 ADD 1 TO ERROR-COUNTER. SQ1494.2 +031200 PERFORM PRINT-DETAIL. SQ1494.2 +031300* SQ1494.2 +031400 DE-LETE. SQ1494.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1494.2 +031600 MOVE "*****" TO P-OR-F. SQ1494.2 +031700 ADD 1 TO DELETE-COUNTER. SQ1494.2 +031800 PERFORM PRINT-DETAIL. SQ1494.2 +031900* SQ1494.2 +032000 PRINT-DETAIL. SQ1494.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ1494.2 +032200 MOVE "." TO PARDOT-X SQ1494.2 +032300 MOVE REC-CT TO DOTVALUE. SQ1494.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. SQ1494.2 +032500 PERFORM WRITE-LINE. SQ1494.2 +032600 IF P-OR-F EQUAL TO "FAIL*" SQ1494.2 +032700 PERFORM WRITE-LINE SQ1494.2 +032800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1494.2 +032900 ELSE SQ1494.2 +033000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1494.2 +033100 MOVE SPACE TO P-OR-F. SQ1494.2 +033200 MOVE SPACE TO COMPUTED-X. SQ1494.2 +033300 MOVE SPACE TO CORRECT-X. SQ1494.2 +033400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1494.2 +033500 MOVE SPACE TO RE-MARK. SQ1494.2 +033600* SQ1494.2 +033700 HEAD-ROUTINE. SQ1494.2 +033800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +033900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +034000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1494.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1494.2 +034200 COLUMN-NAMES-ROUTINE. SQ1494.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1494.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1494.2 +034600 END-ROUTINE. SQ1494.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1494.2 +034800 PERFORM WRITE-LINE 5 TIMES. SQ1494.2 +034900 END-RTN-EXIT. SQ1494.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1494.2 +035100 PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +035200* SQ1494.2 +035300 END-ROUTINE-1. SQ1494.2 +035400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1494.2 +035500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1494.2 +035600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1494.2 +035700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1494.2 +035800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1494.2 +035900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1494.2 +036000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1494.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1494.2 +036200 PERFORM WRITE-LINE. SQ1494.2 +036300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1494.2 +036400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1494.2 +036500 MOVE "NO " TO ERROR-TOTAL SQ1494.2 +036600 ELSE SQ1494.2 +036700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1494.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1494.2 +036900 PERFORM WRITE-LINE. SQ1494.2 +037000 END-ROUTINE-13. SQ1494.2 +037100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1494.2 +037200 MOVE "NO " TO ERROR-TOTAL SQ1494.2 +037300 ELSE SQ1494.2 +037400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1494.2 +037500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1494.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1494.2 +037700 PERFORM WRITE-LINE. SQ1494.2 +037800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1494.2 +037900 MOVE "NO " TO ERROR-TOTAL SQ1494.2 +038000 ELSE SQ1494.2 +038100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1494.2 +038200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1494.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1494.2 +038400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1494.2 +038500* SQ1494.2 +038600 WRITE-LINE. SQ1494.2 +038700 ADD 1 TO RECORD-COUNT. SQ1494.2 +038800 IF RECORD-COUNT GREATER 50 SQ1494.2 +038900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1494.2 +039000 MOVE SPACE TO DUMMY-RECORD SQ1494.2 +039100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1494.2 +039200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1494.2 +039300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1494.2 +039400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1494.2 +039500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1494.2 +039600 MOVE ZERO TO RECORD-COUNT. SQ1494.2 +039700 PERFORM WRT-LN. SQ1494.2 +039800* SQ1494.2 +039900 WRT-LN. SQ1494.2 +040000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1494.2 +040100 MOVE SPACE TO DUMMY-RECORD. SQ1494.2 +040200 BLANK-LINE-PRINT. SQ1494.2 +040300 PERFORM WRT-LN. SQ1494.2 +040400 FAIL-ROUTINE. SQ1494.2 +040500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1494.2 +040600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1494.2 +040700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1494.2 +040800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1494.2 +040900 MOVE XXINFO TO DUMMY-RECORD. SQ1494.2 +041000 PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +041100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1494.2 +041200 GO TO FAIL-ROUTINE-EX. SQ1494.2 +041300 FAIL-ROUTINE-WRITE. SQ1494.2 +041400 MOVE TEST-COMPUTED TO PRINT-REC SQ1494.2 +041500 PERFORM WRITE-LINE SQ1494.2 +041600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1494.2 +041700 MOVE TEST-CORRECT TO PRINT-REC SQ1494.2 +041800 PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +041900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1494.2 +042000 FAIL-ROUTINE-EX. SQ1494.2 +042100 EXIT. SQ1494.2 +042200 BAIL-OUT. SQ1494.2 +042300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1494.2 +042400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1494.2 +042500 BAIL-OUT-WRITE. SQ1494.2 +042600 MOVE CORRECT-A TO XXCORRECT. SQ1494.2 +042700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1494.2 +042800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1494.2 +042900 MOVE XXINFO TO DUMMY-RECORD. SQ1494.2 +043000 PERFORM WRITE-LINE 2 TIMES. SQ1494.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1494.2 +043200 BAIL-OUT-EX. SQ1494.2 +043300 EXIT. SQ1494.2 +043400 CCVS1-EXIT. SQ1494.2 +043500 EXIT. SQ1494.2 +043600* SQ1494.2 +043700**************************************************************** SQ1494.2 +043800* * SQ1494.2 +043900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1494.2 +044000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1494.2 +044100* * SQ1494.2 +044200**************************************************************** SQ1494.2 +044300* SQ1494.2 +044400 SECT-SQ149A-0001 SECTION. SQ1494.2 +044500 WRITE-INIT-GF-01. SQ1494.2 +044600* SQ1494.2 +044700* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1494.2 +044800* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1494.2 +044900* SQ1494.2 +045000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1494.2 +045100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1494.2 +045200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1494.2 +045300 MOVE 120 TO XRECORD-LENGTH (1). SQ1494.2 +045400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1494.2 +045500 MOVE 1 TO XBLOCK-SIZE (1). SQ1494.2 +045600 MOVE 1 TO RECORDS-IN-FILE (1). SQ1494.2 +045700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1494.2 +045800 MOVE "S" TO XLABEL-TYPE (1). SQ1494.2 +045900 MOVE 1 TO XRECORD-NUMBER (1). SQ1494.2 +046000* SQ1494.2 +046100 WRITE-OPEN-01. SQ1494.2 +046200 OPEN OUTPUT SQ-FS1. SQ1494.2 +046300* SQ1494.2 +046400* WRITE A SINGLE RECORD TO THE FILE SQ1494.2 +046500* SQ1494.2 +046600 WRITE-INIT-01. SQ1494.2 +046700 WRITE-TEST-01-01. SQ1494.2 +046800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1494.2 +046900 WRITE SQ-FS1R1-F-G-120. SQ1494.2 +047000* SQ1494.2 +047100* CLOSE THE FILE. SQ1494.2 +047200* SQ1494.2 +047300 CLOSE-INIT-01. SQ1494.2 +047400 CLOSE-TEST-01. SQ1494.2 +047500 CLOSE SQ-FS1. SQ1494.2 +047600* SQ1494.2 +047700 READ-INIT-01. SQ1494.2 +047800* SQ1494.2 +047900* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE SQ1494.2 +048000* CLOSED FILE. I-O STATUS 47 SHOULD BE GENERATED. SQ1494.2 +048100* SQ1494.2 +048200 MOVE "READ CLOSED FILE" TO FEATURE. SQ1494.2 +048300 MOVE "**" TO SQ-FS1-STATUS. SQ1494.2 +048400 MOVE "READ-TEST-01" TO PAR-NAME. SQ1494.2 +048500 MOVE 1 TO REC-CT. SQ1494.2 +048600 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1494.2 +048700 TO DUMMY-RECORD. SQ1494.2 +048800 PERFORM WRITE-LINE 3 TIMES. SQ1494.2 +048900* SQ1494.2 +049000 READ-TEST-01. SQ1494.2 +049100 READ SQ-FS1 AT END CONTINUE. SQ1494.2 +049200 IF SQ-FS1-STATUS = "47" SQ1494.2 +049300 PERFORM PASS SQ1494.2 +049400 ELSE SQ1494.2 +049500 MOVE "47" TO CORRECT-A SQ1494.2 +049600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1494.2 +049700 MOVE "STATUS FOR READ OF CLOSED FILE INCORRECT" SQ1494.2 +049800 TO RE-MARK SQ1494.2 +049900 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1494.2 +050000 PERFORM FAIL SQ1494.2 +050100 END-IF. SQ1494.2 +050200* SQ1494.2 +050300 CCVS-EXIT SECTION. SQ1494.2 +050400 CCVS-999999. SQ1494.2 +050500 GO TO CLOSE-FILES. SQ1494.2 diff --git a/tests/cobol85/SQ/SQ150A.CBL b/tests/cobol85/SQ/SQ150A.CBL new file mode 100755 index 00000000..073d1655 --- /dev/null +++ b/tests/cobol85/SQ/SQ150A.CBL @@ -0,0 +1,512 @@ +000100 IDENTIFICATION DIVISION. SQ1504.2 +000200 PROGRAM-ID. SQ1504.2 +000300 SQ150A. SQ1504.2 +000400**************************************************************** SQ1504.2 +000500* * SQ1504.2 +000600* VALIDATION FOR:- * SQ1504.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1504.2 +000800* USING CCVS85 VERSION 3.0. * SQ1504.2 +000900* * SQ1504.2 +001000* CREATION DATE / VALIDATION DATE * SQ1504.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1504.2 +001200* * SQ1504.2 +001300**************************************************************** SQ1504.2 +001400* * SQ1504.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1504.2 +001600* * SQ1504.2 +001700* X-01 SEQUENTIAL TAPE * SQ1504.2 +001800* X-55 SYSTEM PRINTER * SQ1504.2 +001900* X-82 SOURCE-COMPUTER * SQ1504.2 +002000* X-83 OBJECT-COMPUTER. * SQ1504.2 +002100* X-84 LABEL RECORDS OPTION * SQ1504.2 +002200* * SQ1504.2 +002300**************************************************************** SQ1504.2 +002400* * SQ1504.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1504.2 +002600* A FILE OPEN IN THE OUTPUT MODE. THE TEST FOR CORRECT I-O * SQ1504.2 +002700* STATUS CODE 47 IS IN THE MAIN LINE CODE, THEREFORE AN * SQ1504.2 +002800* ABNORMAL TERMINATION IS POSSIBLE BEFORE THE TEST OF THE * SQ1504.2 +002900* I-O STATUS CODE IS ACCOMPLISHED. * SQ1504.2 +003000* * SQ1504.2 +003100**************************************************************** SQ1504.2 +003200* SQ1504.2 +003300 ENVIRONMENT DIVISION. SQ1504.2 +003400 CONFIGURATION SECTION. SQ1504.2 +003500 SOURCE-COMPUTER. SQ1504.2 +003600 Linux. SQ1504.2 +003700 OBJECT-COMPUTER. SQ1504.2 +003800 Linux. SQ1504.2 +003900* SQ1504.2 +004000 INPUT-OUTPUT SECTION. SQ1504.2 +004100 FILE-CONTROL. SQ1504.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1504.2 +004300 "report.log". SQ1504.2 +004400* SQ1504.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1504.2 +004600 "XXXXX001" SQ1504.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1504.2 +004800* SQ1504.2 +004900* SQ1504.2 +005000 DATA DIVISION. SQ1504.2 +005100 FILE SECTION. SQ1504.2 +005200 FD PRINT-FILE SQ1504.2 +005300*C LABEL RECORDS SQ1504.2 +005400*C OMITTED SQ1504.2 +005500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1504.2 +005600 . SQ1504.2 +005700 01 PRINT-REC PICTURE X(120). SQ1504.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1504.2 +005900* SQ1504.2 +006000 FD SQ-FS1 SQ1504.2 +006100*C LABEL RECORD IS STANDARD SQ1504.2 +006200 . SQ1504.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1504.2 +006400* SQ1504.2 +006500 WORKING-STORAGE SECTION. SQ1504.2 +006600* SQ1504.2 +006700*************************************************************** SQ1504.2 +006800* * SQ1504.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1504.2 +007000* * SQ1504.2 +007100*************************************************************** SQ1504.2 +007200* SQ1504.2 +007300 01 SQ-FS1-STATUS. SQ1504.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1504.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1504.2 +007600* SQ1504.2 +007700*************************************************************** SQ1504.2 +007800* * SQ1504.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1504.2 +008000* * SQ1504.2 +008100*************************************************************** SQ1504.2 +008200* SQ1504.2 +008300 01 REC-SKEL-SUB PIC 99. SQ1504.2 +008400* SQ1504.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ1504.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ1504.2 +008700 05 FILLER PICTURE X(48) VALUE SQ1504.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1504.2 +008900 05 FILLER PICTURE X(46) VALUE SQ1504.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1504.2 +009100 05 FILLER PICTURE X(26) VALUE SQ1504.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ1504.2 +009300 05 FILLER PICTURE X(37) VALUE SQ1504.2 +009400 ",RECKEY= ". SQ1504.2 +009500 05 FILLER PICTURE X(38) VALUE SQ1504.2 +009600 ",ALTKEY1= ". SQ1504.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1504.2 +009800 ",ALTKEY2= ". SQ1504.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1504.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1504.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ1504.2 +010200 07 FILLER PIC X(5). SQ1504.2 +010300 07 XFILE-NAME PIC X(6). SQ1504.2 +010400 07 FILLER PIC X(8). SQ1504.2 +010500 07 XRECORD-NAME PIC X(6). SQ1504.2 +010600 07 FILLER PIC X(1). SQ1504.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ1504.2 +010800 07 FILLER PIC X(7). SQ1504.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ1504.2 +011000 07 FILLER PIC X(6). SQ1504.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ1504.2 +011200 07 FILLER PIC X(5). SQ1504.2 +011300 07 ODO-NUMBER PIC 9(4). SQ1504.2 +011400 07 FILLER PIC X(5). SQ1504.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ1504.2 +011600 07 FILLER PIC X(7). SQ1504.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ1504.2 +011800 07 FILLER PIC X(7). SQ1504.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ1504.2 +012000 07 FILLER PIC X(1). SQ1504.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ1504.2 +012200 07 FILLER PIC X(6). SQ1504.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ1504.2 +012400 07 FILLER PIC X(5). SQ1504.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ1504.2 +012600 07 FILLER PIC X(6). SQ1504.2 +012700 07 XLABEL-TYPE PIC X(1). SQ1504.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ1504.2 +012900 07 FILLER PIC X(8). SQ1504.2 +013000 07 XRECORD-KEY PIC X(29). SQ1504.2 +013100 07 FILLER PIC X(9). SQ1504.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ1504.2 +013300 07 FILLER PIC X(9). SQ1504.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ1504.2 +013500 07 FILLER PIC X(7). SQ1504.2 +013600* SQ1504.2 +013700 01 TEST-RESULTS. SQ1504.2 +013800 02 FILLER PIC X VALUE SPACE. SQ1504.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ1504.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1504.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1504.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1504.2 +014300 02 PAR-NAME. SQ1504.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1504.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1504.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1504.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ1504.2 +014800 02 RE-MARK PIC X(61). SQ1504.2 +014900 01 TEST-COMPUTED. SQ1504.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ1504.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1504.2 +015200 02 COMPUTED-X. SQ1504.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1504.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1504.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1504.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1504.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1504.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1504.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ1504.2 +016000 04 FILLER PIC X. SQ1504.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ1504.2 +016200 01 TEST-CORRECT. SQ1504.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1504.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1504.2 +016500 02 CORRECT-X. SQ1504.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1504.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1504.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1504.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1504.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1504.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ1504.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ1504.2 +017300 04 FILLER PIC X. SQ1504.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ1504.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1504.2 +017600 01 CCVS-C-1. SQ1504.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1504.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1504.2 +017900- "SS PARAGRAPH-NAME SQ1504.2 +018000- " REMARKS". SQ1504.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ1504.2 +018200 01 CCVS-C-2. SQ1504.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ1504.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ1504.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ1504.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ1504.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ1504.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1504.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ1504.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1504.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1504.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1504.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1504.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1504.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1504.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1504.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1504.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1504.2 +019900 01 CCVS-H-1. SQ1504.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ1504.2 +020100 02 FILLER PIC X(42) VALUE SQ1504.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1504.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ1504.2 +020400 01 CCVS-H-2A. SQ1504.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ1504.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1504.2 +020700 02 FILLER PIC XXXX VALUE SQ1504.2 +020800 "4.2 ". SQ1504.2 +020900 02 FILLER PIC X(28) VALUE SQ1504.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ1504.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ1504.2 +021200* SQ1504.2 +021300 01 CCVS-H-2B. SQ1504.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1504.2 +021500 02 TEST-ID PIC X(9). SQ1504.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ1504.2 +021700 02 FILLER PIC X(12) VALUE SQ1504.2 +021800 " HIGH ". SQ1504.2 +021900 02 FILLER PIC X(22) VALUE SQ1504.2 +022000 " LEVEL VALIDATION FOR ". SQ1504.2 +022100 02 FILLER PIC X(58) VALUE SQ1504.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1504.2 +022300 01 CCVS-H-3. SQ1504.2 +022400 02 FILLER PIC X(34) VALUE SQ1504.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1504.2 +022600 02 FILLER PIC X(58) VALUE SQ1504.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1504.2 +022800 02 FILLER PIC X(28) VALUE SQ1504.2 +022900 " COPYRIGHT 1985,1986 ". SQ1504.2 +023000 01 CCVS-E-1. SQ1504.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ1504.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1504.2 +023300 02 ID-AGAIN PIC X(9). SQ1504.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ1504.2 +023500 01 CCVS-E-2. SQ1504.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ1504.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ1504.2 +023800 02 CCVS-E-2-2. SQ1504.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1504.2 +024000 03 FILLER PIC X VALUE SPACE. SQ1504.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ1504.2 +024200 "ERRORS ENCOUNTERED". SQ1504.2 +024300 01 CCVS-E-3. SQ1504.2 +024400 02 FILLER PIC X(22) VALUE SQ1504.2 +024500 " FOR OFFICIAL USE ONLY". SQ1504.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ1504.2 +024700 02 FILLER PIC X(58) VALUE SQ1504.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1504.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ1504.2 +025000 02 FILLER PIC X(20) VALUE SQ1504.2 +025100 " COPYRIGHT 1985,1986". SQ1504.2 +025200 01 CCVS-E-4. SQ1504.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1504.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ1504.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1504.2 +025600 02 FILLER PIC X(40) VALUE SQ1504.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1504.2 +025800 01 XXINFO. SQ1504.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1504.2 +026000 02 INFO-TEXT. SQ1504.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ1504.2 +026200 04 XXCOMPUTED PIC X(20). SQ1504.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1504.2 +026400 04 XXCORRECT PIC X(20). SQ1504.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ1504.2 +026600 01 HYPHEN-LINE. SQ1504.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ1504.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1504.2 +026900- "*****************************************". SQ1504.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1504.2 +027100- "******************************". SQ1504.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1504.2 +027300 "SQ150A". SQ1504.2 +027400* SQ1504.2 +027500 PROCEDURE DIVISION. SQ1504.2 +027600 CCVS1 SECTION. SQ1504.2 +027700 OPEN-FILES. SQ1504.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1504.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1504.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1504.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ1504.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1504.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ1504.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1504.2 +028500 GO TO CCVS1-EXIT. SQ1504.2 +028600* SQ1504.2 +028700 CCVS-INIT-FILE. SQ1504.2 +028800 ADD 1 TO REC-SKL-SUB. SQ1504.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1504.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1504.2 +029100* SQ1504.2 +029200 CLOSE-FILES. SQ1504.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1504.2 +029400 CLOSE PRINT-FILE. SQ1504.2 +029500 TERMINATE-CCVS. SQ1504.2 +029600 STOP RUN. SQ1504.2 +029700* SQ1504.2 +029800 INSPT. SQ1504.2 +029900 MOVE "INSPT" TO P-OR-F. SQ1504.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ1504.2 +030100 PERFORM PRINT-DETAIL. SQ1504.2 +030200 SQ1504.2 +030300 PASS. SQ1504.2 +030400 MOVE "PASS " TO P-OR-F. SQ1504.2 +030500 ADD 1 TO PASS-COUNTER. SQ1504.2 +030600 PERFORM PRINT-DETAIL. SQ1504.2 +030700* SQ1504.2 +030800 FAIL. SQ1504.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ1504.2 +031000 ADD 1 TO ERROR-COUNTER. SQ1504.2 +031100 PERFORM PRINT-DETAIL. SQ1504.2 +031200* SQ1504.2 +031300 DE-LETE. SQ1504.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1504.2 +031500 MOVE "*****" TO P-OR-F. SQ1504.2 +031600 ADD 1 TO DELETE-COUNTER. SQ1504.2 +031700 PERFORM PRINT-DETAIL. SQ1504.2 +031800* SQ1504.2 +031900 PRINT-DETAIL. SQ1504.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1504.2 +032100 MOVE "." TO PARDOT-X SQ1504.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1504.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ1504.2 +032400 PERFORM WRITE-LINE. SQ1504.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ1504.2 +032600 PERFORM WRITE-LINE SQ1504.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1504.2 +032800 ELSE SQ1504.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1504.2 +033000 MOVE SPACE TO P-OR-F. SQ1504.2 +033100 MOVE SPACE TO COMPUTED-X. SQ1504.2 +033200 MOVE SPACE TO CORRECT-X. SQ1504.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1504.2 +033400 MOVE SPACE TO RE-MARK. SQ1504.2 +033500* SQ1504.2 +033600 HEAD-ROUTINE. SQ1504.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1504.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1504.2 +034100 COLUMN-NAMES-ROUTINE. SQ1504.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1504.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1504.2 +034500 END-ROUTINE. SQ1504.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1504.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ1504.2 +034800 END-RTN-EXIT. SQ1504.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1504.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +035100* SQ1504.2 +035200 END-ROUTINE-1. SQ1504.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1504.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1504.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1504.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1504.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1504.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1504.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1504.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1504.2 +036100 PERFORM WRITE-LINE. SQ1504.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1504.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1504.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ1504.2 +036500 ELSE SQ1504.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1504.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1504.2 +036800 PERFORM WRITE-LINE. SQ1504.2 +036900 END-ROUTINE-13. SQ1504.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1504.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ1504.2 +037200 ELSE SQ1504.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1504.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1504.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1504.2 +037600 PERFORM WRITE-LINE. SQ1504.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1504.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1504.2 +037900 ELSE SQ1504.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1504.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1504.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1504.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1504.2 +038400* SQ1504.2 +038500 WRITE-LINE. SQ1504.2 +038600 ADD 1 TO RECORD-COUNT. SQ1504.2 +038700 IF RECORD-COUNT GREATER 50 SQ1504.2 +038800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1504.2 +038900 MOVE SPACE TO DUMMY-RECORD SQ1504.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1504.2 +039100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1504.2 +039200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1504.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1504.2 +039400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1504.2 +039500 MOVE ZERO TO RECORD-COUNT. SQ1504.2 +039600 PERFORM WRT-LN. SQ1504.2 +039700* SQ1504.2 +039800 WRT-LN. SQ1504.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1504.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ1504.2 +040100 BLANK-LINE-PRINT. SQ1504.2 +040200 PERFORM WRT-LN. SQ1504.2 +040300 FAIL-ROUTINE. SQ1504.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1504.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1504.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1504.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1504.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ1504.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1504.2 +041100 GO TO FAIL-ROUTINE-EX. SQ1504.2 +041200 FAIL-ROUTINE-WRITE. SQ1504.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ1504.2 +041400 PERFORM WRITE-LINE SQ1504.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1504.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ1504.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1504.2 +041900 FAIL-ROUTINE-EX. SQ1504.2 +042000 EXIT. SQ1504.2 +042100 BAIL-OUT. SQ1504.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1504.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1504.2 +042400 BAIL-OUT-WRITE. SQ1504.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ1504.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1504.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1504.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1504.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ1504.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1504.2 +043100 BAIL-OUT-EX. SQ1504.2 +043200 EXIT. SQ1504.2 +043300 CCVS1-EXIT. SQ1504.2 +043400 EXIT. SQ1504.2 +043500* SQ1504.2 +043600**************************************************************** SQ1504.2 +043700* * SQ1504.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1504.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1504.2 +044000* * SQ1504.2 +044100**************************************************************** SQ1504.2 +044200* SQ1504.2 +044300 SECT-SQ150A-0001 SECTION. SQ1504.2 +044400 WRITE-INIT-GF-01. SQ1504.2 +044500* SQ1504.2 +044600* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1504.2 +044700* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1504.2 +044800* SQ1504.2 +044900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1504.2 +045000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1504.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1504.2 +045200 MOVE 120 TO XRECORD-LENGTH (1). SQ1504.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1504.2 +045400 MOVE 1 TO XBLOCK-SIZE (1). SQ1504.2 +045500 MOVE 1 TO RECORDS-IN-FILE (1). SQ1504.2 +045600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1504.2 +045700 MOVE "S" TO XLABEL-TYPE (1). SQ1504.2 +045800 MOVE 1 TO XRECORD-NUMBER (1). SQ1504.2 +045900* SQ1504.2 +046000 WRITE-OPEN-01. SQ1504.2 +046100 OPEN OUTPUT SQ-FS1. SQ1504.2 +046200* SQ1504.2 +046300* WRITE A SINGLE RECORD TO THE FILE SQ1504.2 +046400* SQ1504.2 +046500 WRITE-INIT-01. SQ1504.2 +046600 WRITE-TEST-01-01. SQ1504.2 +046700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1504.2 +046800 WRITE SQ-FS1R1-F-G-120. SQ1504.2 +046900* SQ1504.2 +047000* CLOSE THE FILE. SQ1504.2 +047100* SQ1504.2 +047200 CLOSE-INIT-01. SQ1504.2 +047300 CLOSE-TEST-01. SQ1504.2 +047400 CLOSE SQ-FS1. SQ1504.2 +047500* SQ1504.2 +047600* HAVING CLOSED THE FILE, WE NOW TRY TO REOPEN IT IN THE SQ1504.2 +047700* OUTPUT MODE. SQ1504.2 +047800* SQ1504.2 +047900 OPEN-INIT-01. SQ1504.2 +048000* SQ1504.2 +048100 OPEN-TEST-01. SQ1504.2 +048200 OPEN OUTPUT SQ-FS1. SQ1504.2 +048300* SQ1504.2 +048400 READ-INIT-01. SQ1504.2 +048500* SQ1504.2 +048600* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE FILE. SQ1504.2 +048700* I-O STATUS CODE 47 SHOULD BE GENERATED. SQ1504.2 +048800* SQ1504.2 +048900 MOVE "READ FILE OPENED OUTPUT" TO FEATURE. SQ1504.2 +049000 MOVE "**" TO SQ-FS1-STATUS. SQ1504.2 +049100 MOVE "READ-TEST-01" TO PAR-NAME. SQ1504.2 +049200 MOVE 1 TO REC-CT. SQ1504.2 +049300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1504.2 +049400 TO DUMMY-RECORD. SQ1504.2 +049500 PERFORM WRITE-LINE 3 TIMES. SQ1504.2 +049600* SQ1504.2 +049700 READ-TEST-01. SQ1504.2 +049800 READ SQ-FS1 AT END CONTINUE. SQ1504.2 +049900 IF SQ-FS1-STATUS = "47" SQ1504.2 +050000 PERFORM PASS SQ1504.2 +050100 ELSE SQ1504.2 +050200 MOVE "47" TO CORRECT-A SQ1504.2 +050300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1504.2 +050400 MOVE "STATUS FOR READ OF FILE OPEN OUTPUT INCORRECT" SQ1504.2 +050500 TO RE-MARK SQ1504.2 +050600 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1504.2 +050700 PERFORM FAIL SQ1504.2 +050800 END-IF. SQ1504.2 +050900* SQ1504.2 +051000 CCVS-EXIT SECTION. SQ1504.2 +051100 CCVS-999999. SQ1504.2 +051200 GO TO CLOSE-FILES. SQ1504.2 diff --git a/tests/cobol85/SQ/SQ151A.CBL b/tests/cobol85/SQ/SQ151A.CBL new file mode 100755 index 00000000..1151abd7 --- /dev/null +++ b/tests/cobol85/SQ/SQ151A.CBL @@ -0,0 +1,598 @@ +000100 IDENTIFICATION DIVISION. SQ1514.2 +000200 PROGRAM-ID. SQ1514.2 +000300 SQ151A. SQ1514.2 +000400**************************************************************** SQ1514.2 +000500* * SQ1514.2 +000600* VALIDATION FOR:- * SQ1514.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1514.2 +000800* USING CCVS85 VERSION 3.0. * SQ1514.2 +000900* * SQ1514.2 +001000* CREATION DATE / VALIDATION DATE * SQ1514.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1514.2 +001200* * SQ1514.2 +001300**************************************************************** SQ1514.2 +001400* * SQ1514.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1514.2 +001600* * SQ1514.2 +001700* X-01 SEQUENTIAL TAPE * SQ1514.2 +001800* X-55 SYSTEM PRINTER * SQ1514.2 +001900* X-82 SOURCE-COMPUTER * SQ1514.2 +002000* X-83 OBJECT-COMPUTER * SQ1514.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1514.2 +002200* * SQ1514.2 +002300**************************************************************** SQ1514.2 +002400* * SQ1514.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING * SQ1514.2 +002600* A CLOSED FILE. THE TEST FOR CORRECT I-O STATUS CODE 48 * SQ1514.2 +002700* IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION IS * SQ1514.2 +002800* POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1514.2 +002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1514.2 +003000* LINE CODE. * SQ1514.2 +003100* * SQ1514.2 +003200**************************************************************** SQ1514.2 +003300* SQ1514.2 +003400 ENVIRONMENT DIVISION. SQ1514.2 +003500 CONFIGURATION SECTION. SQ1514.2 +003600 SOURCE-COMPUTER. SQ1514.2 +003700 Linux. SQ1514.2 +003800 OBJECT-COMPUTER. SQ1514.2 +003900 Linux. SQ1514.2 +004000* SQ1514.2 +004100 INPUT-OUTPUT SECTION. SQ1514.2 +004200 FILE-CONTROL. SQ1514.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1514.2 +004400 "report.log". SQ1514.2 +004500* SQ1514.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1514.2 +004700 "XXXXX001" SQ1514.2 +004800 FILE STATUS IS SQ-FS1-STATUS. SQ1514.2 +004900* SQ1514.2 +005000* SQ1514.2 +005100 DATA DIVISION. SQ1514.2 +005200 FILE SECTION. SQ1514.2 +005300 FD PRINT-FILE SQ1514.2 +005400*C LABEL RECORDS SQ1514.2 +005500*C OMITTED SQ1514.2 +005600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1514.2 +005700 . SQ1514.2 +005800 01 PRINT-REC PICTURE X(120). SQ1514.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1514.2 +006000* SQ1514.2 +006100 FD SQ-FS1 SQ1514.2 +006200*C LABEL RECORD IS STANDARD SQ1514.2 +006300 . SQ1514.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1514.2 +006500* SQ1514.2 +006600 WORKING-STORAGE SECTION. SQ1514.2 +006700* SQ1514.2 +006800*************************************************************** SQ1514.2 +006900* * SQ1514.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1514.2 +007100* * SQ1514.2 +007200*************************************************************** SQ1514.2 +007300* SQ1514.2 +007400 01 SQ-FS1-STATUS. SQ1514.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1514.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1514.2 +007700* SQ1514.2 +007800*************************************************************** SQ1514.2 +007900* * SQ1514.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1514.2 +008100* * SQ1514.2 +008200*************************************************************** SQ1514.2 +008300* SQ1514.2 +008400 01 REC-SKEL-SUB PIC 99. SQ1514.2 +008500* SQ1514.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ1514.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ1514.2 +008800 05 FILLER PICTURE X(48) VALUE SQ1514.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1514.2 +009000 05 FILLER PICTURE X(46) VALUE SQ1514.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1514.2 +009200 05 FILLER PICTURE X(26) VALUE SQ1514.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ1514.2 +009400 05 FILLER PICTURE X(37) VALUE SQ1514.2 +009500 ",RECKEY= ". SQ1514.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1514.2 +009700 ",ALTKEY1= ". SQ1514.2 +009800 05 FILLER PICTURE X(38) VALUE SQ1514.2 +009900 ",ALTKEY2= ". SQ1514.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE.SQ1514.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1514.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ1514.2 +010300 07 FILLER PIC X(5). SQ1514.2 +010400 07 XFILE-NAME PIC X(6). SQ1514.2 +010500 07 FILLER PIC X(8). SQ1514.2 +010600 07 XRECORD-NAME PIC X(6). SQ1514.2 +010700 07 FILLER PIC X(1). SQ1514.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ1514.2 +010900 07 FILLER PIC X(7). SQ1514.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ1514.2 +011100 07 FILLER PIC X(6). SQ1514.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ1514.2 +011300 07 FILLER PIC X(5). SQ1514.2 +011400 07 ODO-NUMBER PIC 9(4). SQ1514.2 +011500 07 FILLER PIC X(5). SQ1514.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ1514.2 +011700 07 FILLER PIC X(7). SQ1514.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ1514.2 +011900 07 FILLER PIC X(7). SQ1514.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ1514.2 +012100 07 FILLER PIC X(1). SQ1514.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ1514.2 +012300 07 FILLER PIC X(6). SQ1514.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ1514.2 +012500 07 FILLER PIC X(5). SQ1514.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ1514.2 +012700 07 FILLER PIC X(6). SQ1514.2 +012800 07 XLABEL-TYPE PIC X(1). SQ1514.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ1514.2 +013000 07 FILLER PIC X(8). SQ1514.2 +013100 07 XRECORD-KEY PIC X(29). SQ1514.2 +013200 07 FILLER PIC X(9). SQ1514.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ1514.2 +013400 07 FILLER PIC X(9). SQ1514.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ1514.2 +013600 07 FILLER PIC X(7). SQ1514.2 +013700* SQ1514.2 +013800 01 TEST-RESULTS. SQ1514.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1514.2 +014000 02 FEATURE PIC X(24) VALUE SPACE. SQ1514.2 +014100 02 FILLER PIC X VALUE SPACE. SQ1514.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1514.2 +014300 02 FILLER PIC X VALUE SPACE. SQ1514.2 +014400 02 PAR-NAME. SQ1514.2 +014500 03 FILLER PIC X(14) VALUE SPACE. SQ1514.2 +014600 03 PARDOT-X PIC X VALUE SPACE. SQ1514.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1514.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ1514.2 +014900 02 RE-MARK PIC X(61). SQ1514.2 +015000 01 TEST-COMPUTED. SQ1514.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ1514.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1514.2 +015300 02 COMPUTED-X. SQ1514.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1514.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1514.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1514.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1514.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1514.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1514.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ1514.2 +016100 04 FILLER PIC X. SQ1514.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ1514.2 +016300 01 TEST-CORRECT. SQ1514.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1514.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1514.2 +016600 02 CORRECT-X. SQ1514.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1514.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1514.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1514.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1514.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1514.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ1514.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ1514.2 +017400 04 FILLER PIC X. SQ1514.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ1514.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1514.2 +017700 01 CCVS-C-1. SQ1514.2 +017800 02 FILLER PIC IS X(4) VALUE SPACE. SQ1514.2 +017900 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1514.2 +018000- "SS PARAGRAPH-NAME SQ1514.2 +018100- " REMARKS". SQ1514.2 +018200 02 FILLER PIC X(17) VALUE SPACE. SQ1514.2 +018300 01 CCVS-C-2. SQ1514.2 +018400 02 FILLER PIC XXXX VALUE SPACE. SQ1514.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". SQ1514.2 +018600 02 FILLER PIC X(16) VALUE SPACE. SQ1514.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". SQ1514.2 +018800 02 FILLER PIC X(90) VALUE SPACE. SQ1514.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1514.2 +019000 01 REC-CT PIC 99 VALUE ZERO. SQ1514.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1514.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1514.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1514.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1514.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1514.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1514.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1514.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1514.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1514.2 +020000 01 CCVS-H-1. SQ1514.2 +020100 02 FILLER PIC X(39) VALUE SPACES. SQ1514.2 +020200 02 FILLER PIC X(42) VALUE SQ1514.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1514.2 +020400 02 FILLER PIC X(39) VALUE SPACES. SQ1514.2 +020500 01 CCVS-H-2A. SQ1514.2 +020600 02 FILLER PIC X(40) VALUE SPACE. SQ1514.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1514.2 +020800 02 FILLER PIC XXXX VALUE SQ1514.2 +020900 "4.2 ". SQ1514.2 +021000 02 FILLER PIC X(28) VALUE SQ1514.2 +021100 " COPY - NOT FOR DISTRIBUTION". SQ1514.2 +021200 02 FILLER PIC X(41) VALUE SPACE. SQ1514.2 +021300* SQ1514.2 +021400 01 CCVS-H-2B. SQ1514.2 +021500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1514.2 +021600 02 TEST-ID PIC X(9). SQ1514.2 +021700 02 FILLER PIC X(4) VALUE " IN ". SQ1514.2 +021800 02 FILLER PIC X(12) VALUE SQ1514.2 +021900 " HIGH ". SQ1514.2 +022000 02 FILLER PIC X(22) VALUE SQ1514.2 +022100 " LEVEL VALIDATION FOR ". SQ1514.2 +022200 02 FILLER PIC X(58) VALUE SQ1514.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1514.2 +022400 01 CCVS-H-3. SQ1514.2 +022500 02 FILLER PIC X(34) VALUE SQ1514.2 +022600 " FOR OFFICIAL USE ONLY ". SQ1514.2 +022700 02 FILLER PIC X(58) VALUE SQ1514.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1514.2 +022900 02 FILLER PIC X(28) VALUE SQ1514.2 +023000 " COPYRIGHT 1985,1986 ". SQ1514.2 +023100 01 CCVS-E-1. SQ1514.2 +023200 02 FILLER PIC X(52) VALUE SPACE. SQ1514.2 +023300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1514.2 +023400 02 ID-AGAIN PIC X(9). SQ1514.2 +023500 02 FILLER PIC X(45) VALUE SPACES. SQ1514.2 +023600 01 CCVS-E-2. SQ1514.2 +023700 02 FILLER PIC X(31) VALUE SPACE. SQ1514.2 +023800 02 FILLER PIC X(21) VALUE SPACE. SQ1514.2 +023900 02 CCVS-E-2-2. SQ1514.2 +024000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1514.2 +024100 03 FILLER PIC X VALUE SPACE. SQ1514.2 +024200 03 ENDER-DESC PIC X(44) VALUE SQ1514.2 +024300 "ERRORS ENCOUNTERED". SQ1514.2 +024400 01 CCVS-E-3. SQ1514.2 +024500 02 FILLER PIC X(22) VALUE SQ1514.2 +024600 " FOR OFFICIAL USE ONLY". SQ1514.2 +024700 02 FILLER PIC X(12) VALUE SPACE. SQ1514.2 +024800 02 FILLER PIC X(58) VALUE SQ1514.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1514.2 +025000 02 FILLER PIC X(8) VALUE SPACE. SQ1514.2 +025100 02 FILLER PIC X(20) VALUE SQ1514.2 +025200 " COPYRIGHT 1985,1986". SQ1514.2 +025300 01 CCVS-E-4. SQ1514.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1514.2 +025500 02 FILLER PIC X(4) VALUE " OF ". SQ1514.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1514.2 +025700 02 FILLER PIC X(40) VALUE SQ1514.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1514.2 +025900 01 XXINFO. SQ1514.2 +026000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1514.2 +026100 02 INFO-TEXT. SQ1514.2 +026200 04 FILLER PIC X(8) VALUE SPACE. SQ1514.2 +026300 04 XXCOMPUTED PIC X(20). SQ1514.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ1514.2 +026500 04 XXCORRECT PIC X(20). SQ1514.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). SQ1514.2 +026700 01 HYPHEN-LINE. SQ1514.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. SQ1514.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1514.2 +027000- "*****************************************". SQ1514.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1514.2 +027200- "******************************". SQ1514.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1514.2 +027400 "SQ151A". SQ1514.2 +027500* SQ1514.2 +027600 PROCEDURE DIVISION. SQ1514.2 +027700 DECLARATIVES. SQ1514.2 +027800 SQ-FS1-DECLARATIVE SECTION. SQ1514.2 +027900 USE AFTER EXCEPTION PROCEDURE ON SQ-FS1. SQ1514.2 +028000 OUTPUT-ERROR-PROCESS. SQ1514.2 +028100 IF SQ-FS1-STATUS = "48" SQ1514.2 +028200 PERFORM DECL-PASS SQ1514.2 +028300 GO TO DECL-ABNORMAL-TERM SQ1514.2 +028400 ELSE SQ1514.2 +028500 MOVE "48" TO CORRECT-A SQ1514.2 +028600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1514.2 +028700 MOVE "STATUS FOR WRITE TO CLOSED FILE INCORRECT" SQ1514.2 +028800 TO RE-MARK SQ1514.2 +028900 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1514.2 +029000 PERFORM DECL-FAIL SQ1514.2 +029100 GO TO DECL-ABNORMAL-TERM SQ1514.2 +029200 END-IF. SQ1514.2 +029300* SQ1514.2 +029400 DECL-PASS. SQ1514.2 +029500 MOVE "PASS " TO P-OR-F. SQ1514.2 +029600 ADD 1 TO PASS-COUNTER. SQ1514.2 +029700 PERFORM DECL-PRINT-DETAIL. SQ1514.2 +029800* SQ1514.2 +029900 DECL-FAIL. SQ1514.2 +030000 MOVE "FAIL*" TO P-OR-F. SQ1514.2 +030100 ADD 1 TO ERROR-COUNTER. SQ1514.2 +030200 PERFORM DECL-PRINT-DETAIL. SQ1514.2 +030300* SQ1514.2 +030400 DECL-PRINT-DETAIL. SQ1514.2 +030500 IF REC-CT NOT EQUAL TO ZERO SQ1514.2 +030600 MOVE "." TO PARDOT-X SQ1514.2 +030700 MOVE REC-CT TO DOTVALUE. SQ1514.2 +030800 MOVE TEST-RESULTS TO PRINT-REC. SQ1514.2 +030900 PERFORM DECL-WRITE-LINE. SQ1514.2 +031000 IF P-OR-F EQUAL TO "FAIL*" SQ1514.2 +031100 PERFORM DECL-WRITE-LINE SQ1514.2 +031200 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1514.2 +031300 ELSE SQ1514.2 +031400 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1514.2 +031500 MOVE SPACE TO P-OR-F. SQ1514.2 +031600 MOVE SPACE TO COMPUTED-X. SQ1514.2 +031700 MOVE SPACE TO CORRECT-X. SQ1514.2 +031800 IF REC-CT EQUAL TO ZERO SQ1514.2 +031900 MOVE SPACE TO PAR-NAME. SQ1514.2 +032000 MOVE SPACE TO RE-MARK. SQ1514.2 +032100* SQ1514.2 +032200 DECL-WRITE-LINE. SQ1514.2 +032300 ADD 1 TO RECORD-COUNT. SQ1514.2 +032400 IF RECORD-COUNT GREATER 50 SQ1514.2 +032500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1514.2 +032600 MOVE SPACE TO DUMMY-RECORD SQ1514.2 +032700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1514.2 +032800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1514.2 +032900 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1514.2 +033000 PERFORM DECL-WRT-LN 2 TIMES SQ1514.2 +033100 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1514.2 +033200 PERFORM DECL-WRT-LN SQ1514.2 +033300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1514.2 +033400 MOVE ZERO TO RECORD-COUNT. SQ1514.2 +033500 PERFORM DECL-WRT-LN. SQ1514.2 +033600* SQ1514.2 +033700 DECL-WRT-LN. SQ1514.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1514.2 +033900 MOVE SPACE TO DUMMY-RECORD. SQ1514.2 +034000* SQ1514.2 +034100 DECL-FAIL-ROUTINE. SQ1514.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1514.2 +034300 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1514.2 +034400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1514.2 +034500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1514.2 +034600 MOVE XXINFO TO DUMMY-RECORD. SQ1514.2 +034700 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1514.2 +034800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1514.2 +034900 GO TO DECL-FAIL-EX. SQ1514.2 +035000 DECL-FAIL-WRITE. SQ1514.2 +035100 MOVE TEST-COMPUTED TO PRINT-REC SQ1514.2 +035200 PERFORM DECL-WRITE-LINE SQ1514.2 +035300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1514.2 +035400 MOVE TEST-CORRECT TO PRINT-REC SQ1514.2 +035500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1514.2 +035600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1514.2 +035700 DECL-FAIL-EX. SQ1514.2 +035800 EXIT. SQ1514.2 +035900* SQ1514.2 +036000 DECL-BAIL. SQ1514.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1514.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1514.2 +036300 DECL-BAIL-WRITE. SQ1514.2 +036400 MOVE CORRECT-A TO XXCORRECT. SQ1514.2 +036500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1514.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1514.2 +036700 MOVE XXINFO TO DUMMY-RECORD. SQ1514.2 +036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1514.2 +036900 MOVE SPACE TO INF-ANSI-REFERENCE. SQ1514.2 +037000 DECL-BAIL-EX. SQ1514.2 +037100 EXIT. SQ1514.2 +037200* SQ1514.2 +037300 DECL-ABNORMAL-TERM. SQ1514.2 +037400 MOVE SPACE TO DUMMY-RECORD. SQ1514.2 +037500 PERFORM DECL-WRITE-LINE. SQ1514.2 +037600 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1514.2 +037700 TO DUMMY-RECORD. SQ1514.2 +037800 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1514.2 +037900* SQ1514.2 +038000 END-DECLS. SQ1514.2 +038100 EXIT. SQ1514.2 +038200 END DECLARATIVES. SQ1514.2 +038300* SQ1514.2 +038400* SQ1514.2 +038500 CCVS1 SECTION. SQ1514.2 +038600 OPEN-FILES. SQ1514.2 +038700 OPEN OUTPUT PRINT-FILE. SQ1514.2 +038800 MOVE CCVS-PGM-ID TO TEST-ID. SQ1514.2 +038900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1514.2 +039000 MOVE SPACE TO TEST-RESULTS. SQ1514.2 +039100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1514.2 +039200 MOVE ZERO TO REC-SKEL-SUB. SQ1514.2 +039300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1514.2 +039400 GO TO CCVS1-EXIT. SQ1514.2 +039500* SQ1514.2 +039600 CCVS-INIT-FILE. SQ1514.2 +039700 ADD 1 TO REC-SKL-SUB. SQ1514.2 +039800 MOVE FILE-RECORD-INFO-SKELETON TO SQ1514.2 +039900 FILE-RECORD-INFO (REC-SKL-SUB). SQ1514.2 +040000* SQ1514.2 +040100 CLOSE-FILES. SQ1514.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1514.2 +040300 CLOSE PRINT-FILE. SQ1514.2 +040400 TERMINATE-CCVS. SQ1514.2 +040500 STOP RUN. SQ1514.2 +040600* SQ1514.2 +040700 INSPT. SQ1514.2 +040800 MOVE "INSPT" TO P-OR-F. SQ1514.2 +040900 ADD 1 TO INSPECT-COUNTER. SQ1514.2 +041000 PERFORM PRINT-DETAIL. SQ1514.2 +041100 SQ1514.2 +041200 PASS. SQ1514.2 +041300 MOVE "PASS " TO P-OR-F. SQ1514.2 +041400 ADD 1 TO PASS-COUNTER. SQ1514.2 +041500 PERFORM PRINT-DETAIL. SQ1514.2 +041600* SQ1514.2 +041700 FAIL. SQ1514.2 +041800 MOVE "FAIL*" TO P-OR-F. SQ1514.2 +041900 ADD 1 TO ERROR-COUNTER. SQ1514.2 +042000 PERFORM PRINT-DETAIL. SQ1514.2 +042100* SQ1514.2 +042200 DE-LETE. SQ1514.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1514.2 +042400 MOVE "*****" TO P-OR-F. SQ1514.2 +042500 ADD 1 TO DELETE-COUNTER. SQ1514.2 +042600 PERFORM PRINT-DETAIL. SQ1514.2 +042700* SQ1514.2 +042800 PRINT-DETAIL. SQ1514.2 +042900 IF REC-CT NOT EQUAL TO ZERO SQ1514.2 +043000 MOVE "." TO PARDOT-X SQ1514.2 +043100 MOVE REC-CT TO DOTVALUE. SQ1514.2 +043200 MOVE TEST-RESULTS TO PRINT-REC. SQ1514.2 +043300 PERFORM WRITE-LINE. SQ1514.2 +043400 IF P-OR-F EQUAL TO "FAIL*" SQ1514.2 +043500 PERFORM WRITE-LINE SQ1514.2 +043600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1514.2 +043700 ELSE SQ1514.2 +043800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1514.2 +043900 MOVE SPACE TO P-OR-F. SQ1514.2 +044000 MOVE SPACE TO COMPUTED-X. SQ1514.2 +044100 MOVE SPACE TO CORRECT-X. SQ1514.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1514.2 +044300 MOVE SPACE TO RE-MARK. SQ1514.2 +044400* SQ1514.2 +044500 HEAD-ROUTINE. SQ1514.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1514.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1514.2 +045000 COLUMN-NAMES-ROUTINE. SQ1514.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1514.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1514.2 +045400 END-ROUTINE. SQ1514.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1514.2 +045600 PERFORM WRITE-LINE 5 TIMES. SQ1514.2 +045700 END-RTN-EXIT. SQ1514.2 +045800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1514.2 +045900 PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +046000* SQ1514.2 +046100 END-ROUTINE-1. SQ1514.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1514.2 +046300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1514.2 +046400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1514.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1514.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1514.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1514.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1514.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1514.2 +047000 PERFORM WRITE-LINE. SQ1514.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1514.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1514.2 +047300 MOVE "NO " TO ERROR-TOTAL SQ1514.2 +047400 ELSE SQ1514.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1514.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1514.2 +047700 PERFORM WRITE-LINE. SQ1514.2 +047800 END-ROUTINE-13. SQ1514.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1514.2 +048000 MOVE "NO " TO ERROR-TOTAL SQ1514.2 +048100 ELSE SQ1514.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1514.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1514.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1514.2 +048500 PERFORM WRITE-LINE. SQ1514.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1514.2 +048700 MOVE "NO " TO ERROR-TOTAL SQ1514.2 +048800 ELSE SQ1514.2 +048900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1514.2 +049000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1514.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1514.2 +049200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1514.2 +049300* SQ1514.2 +049400 WRITE-LINE. SQ1514.2 +049500 ADD 1 TO RECORD-COUNT. SQ1514.2 +049600 IF RECORD-COUNT GREATER 50 SQ1514.2 +049700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1514.2 +049800 MOVE SPACE TO DUMMY-RECORD SQ1514.2 +049900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1514.2 +050000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1514.2 +050100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1514.2 +050200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1514.2 +050300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1514.2 +050400 MOVE ZERO TO RECORD-COUNT. SQ1514.2 +050500 PERFORM WRT-LN. SQ1514.2 +050600* SQ1514.2 +050700 WRT-LN. SQ1514.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1514.2 +050900 MOVE SPACE TO DUMMY-RECORD. SQ1514.2 +051000 BLANK-LINE-PRINT. SQ1514.2 +051100 PERFORM WRT-LN. SQ1514.2 +051200 FAIL-ROUTINE. SQ1514.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1514.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1514.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1514.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1514.2 +051700 MOVE XXINFO TO DUMMY-RECORD. SQ1514.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1514.2 +052000 GO TO FAIL-ROUTINE-EX. SQ1514.2 +052100 FAIL-ROUTINE-WRITE. SQ1514.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC SQ1514.2 +052300 PERFORM WRITE-LINE SQ1514.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1514.2 +052500 MOVE TEST-CORRECT TO PRINT-REC SQ1514.2 +052600 PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +052700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1514.2 +052800 FAIL-ROUTINE-EX. SQ1514.2 +052900 EXIT. SQ1514.2 +053000 BAIL-OUT. SQ1514.2 +053100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1514.2 +053200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1514.2 +053300 BAIL-OUT-WRITE. SQ1514.2 +053400 MOVE CORRECT-A TO XXCORRECT. SQ1514.2 +053500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1514.2 +053600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1514.2 +053700 MOVE XXINFO TO DUMMY-RECORD. SQ1514.2 +053800 PERFORM WRITE-LINE 2 TIMES. SQ1514.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1514.2 +054000 BAIL-OUT-EX. SQ1514.2 +054100 EXIT. SQ1514.2 +054200 CCVS1-EXIT. SQ1514.2 +054300 EXIT. SQ1514.2 +054400* SQ1514.2 +054500**************************************************************** SQ1514.2 +054600* * SQ1514.2 +054700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1514.2 +054800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1514.2 +054900* * SQ1514.2 +055000**************************************************************** SQ1514.2 +055100* SQ1514.2 +055200 SECT-SQ151A-0001 SECTION. SQ1514.2 +055300 WRITE-INIT-GF-01. SQ1514.2 +055400* SQ1514.2 +055500* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT WITH LOCK. SQ1514.2 +055600* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1514.2 +055700* SQ1514.2 +055800 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1514.2 +055900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1514.2 +056000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1514.2 +056100 MOVE 120 TO XRECORD-LENGTH (1). SQ1514.2 +056200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1514.2 +056300 MOVE 1 TO XBLOCK-SIZE (1). SQ1514.2 +056400 MOVE 1 TO RECORDS-IN-FILE (1). SQ1514.2 +056500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1514.2 +056600 MOVE "S" TO XLABEL-TYPE (1). SQ1514.2 +056700 MOVE 1 TO XRECORD-NUMBER (1). SQ1514.2 +056800* SQ1514.2 +056900 WRITE-OPEN-01. SQ1514.2 +057000 OPEN OUTPUT SQ-FS1. SQ1514.2 +057100* SQ1514.2 +057200* WRITE A SINGLE RECORD TO THE FILE SQ1514.2 +057300* SQ1514.2 +057400 WRITE-TEST-01-01. SQ1514.2 +057500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1514.2 +057600 WRITE SQ-FS1R1-F-G-120. SQ1514.2 +057700* SQ1514.2 +057800* CLOSE THE FILE. SQ1514.2 +057900* SQ1514.2 +058000 CLOSE-INIT-01. SQ1514.2 +058100 CLOSE-TEST-01. SQ1514.2 +058200 CLOSE SQ-FS1. SQ1514.2 +058300* SQ1514.2 +058400* WE WILL NOW ATTEMPT TO WRITE A RECORD TO THE CLOSED SQ1514.2 +058500* FILE. I-O STATUS 48 SHOULD BE GENERATED. SQ1514.2 +058600* SQ1514.2 +058700 WRITE-INIT-01. SQ1514.2 +058800* SQ1514.2 +058900 MOVE "WRITE CLOSED FILE" TO FEATURE. SQ1514.2 +059000 MOVE "**" TO SQ-FS1-STATUS. SQ1514.2 +059100 MOVE "WRITE-TEST-01" TO PAR-NAME. SQ1514.2 +059200 MOVE 1 TO REC-CT. SQ1514.2 +059300 WRITE-TEST-01. SQ1514.2 +059400 WRITE SQ-FS1R1-F-G-120. SQ1514.2 +059500* SQ1514.2 +059600 CCVS-EXIT SECTION. SQ1514.2 +059700 CCVS-999999. SQ1514.2 +059800 GO TO CLOSE-FILES. SQ1514.2 diff --git a/tests/cobol85/SQ/SQ152A.CBL b/tests/cobol85/SQ/SQ152A.CBL new file mode 100755 index 00000000..0b170033 --- /dev/null +++ b/tests/cobol85/SQ/SQ152A.CBL @@ -0,0 +1,607 @@ +000100 IDENTIFICATION DIVISION. SQ1524.2 +000200 PROGRAM-ID. SQ1524.2 +000300 SQ152A. SQ1524.2 +000400**************************************************************** SQ1524.2 +000500* * SQ1524.2 +000600* VALIDATION FOR:- * SQ1524.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1524.2 +000800* USING CCVS85 VERSION 3.0. * SQ1524.2 +000900* * SQ1524.2 +001000* CREATION DATE / VALIDATION DATE * SQ1524.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1524.2 +001200* * SQ1524.2 +001300**************************************************************** SQ1524.2 +001400* * SQ1524.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1524.2 +001600* * SQ1524.2 +001700* X-14 SEQUENTIAL MASS STORAGE * SQ1524.2 +001800* X-55 SYSTEM PRINTER * SQ1524.2 +001900* X-82 SOURCE-COMPUTER * SQ1524.2 +002000* X-83 OBJECT-COMPUTER. * SQ1524.2 +002100* X-84 LABEL RECORDS OPTION SQ1524.2 +002200* * SQ1524.2 +002300**************************************************************** SQ1524.2 +002400* * SQ1524.2 +002500* * SQ1524.2 +002600* SPLIT FROM SQ215A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ1524.2 +002700* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ1524.2 +002800* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO AN * SQ1524.2 +002900* ATTEMPT TO WRITE TO A FILE NOT OPEN IN THE OUTPUT OR * SQ1524.2 +003000* EXTEND MODE. I-O STATUS 48 IS EXPECTED AND TESTED IN * SQ1524.2 +003100* THE DECLARATIVES. * SQ1524.2 +003200* * SQ1524.2 +003300**************************************************************** SQ1524.2 +003400* SQ1524.2 +003500 ENVIRONMENT DIVISION. SQ1524.2 +003600 CONFIGURATION SECTION. SQ1524.2 +003700 SOURCE-COMPUTER. SQ1524.2 +003800 Linux. SQ1524.2 +003900 OBJECT-COMPUTER. SQ1524.2 +004000 Linux. SQ1524.2 +004100* SQ1524.2 +004200 INPUT-OUTPUT SECTION. SQ1524.2 +004300 FILE-CONTROL. SQ1524.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ1524.2 +004500 "report.log". SQ1524.2 +004600* SQ1524.2 +004700 SELECT SQ-FS1 ASSIGN TO SQ1524.2 +004800 "XXXXX014" SQ1524.2 +004900 FILE STATUS IS SQ-FS1-STATUS. SQ1524.2 +005000* SQ1524.2 +005100* SQ1524.2 +005200 DATA DIVISION. SQ1524.2 +005300 FILE SECTION. SQ1524.2 +005400 FD PRINT-FILE SQ1524.2 +005500*C LABEL RECORDS SQ1524.2 +005600*C OMITTED SQ1524.2 +005700*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1524.2 +005800 . SQ1524.2 +005900 01 PRINT-REC PICTURE X(120). SQ1524.2 +006000 01 DUMMY-RECORD PICTURE X(120). SQ1524.2 +006100* SQ1524.2 +006200 FD SQ-FS1 SQ1524.2 +006300*C LABEL RECORD IS STANDARD SQ1524.2 +006400 . SQ1524.2 +006500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1524.2 +006600* SQ1524.2 +006700 WORKING-STORAGE SECTION. SQ1524.2 +006800* SQ1524.2 +006900*************************************************************** SQ1524.2 +007000* * SQ1524.2 +007100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1524.2 +007200* * SQ1524.2 +007300*************************************************************** SQ1524.2 +007400* SQ1524.2 +007500 01 SQ-FS1-STATUS. SQ1524.2 +007600 03 SQ-FS1-KEY-1 PIC X. SQ1524.2 +007700 03 SQ-FS1-KEY-2 PIC X. SQ1524.2 +007800* SQ1524.2 +007900*************************************************************** SQ1524.2 +008000* * SQ1524.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1524.2 +008200* * SQ1524.2 +008300*************************************************************** SQ1524.2 +008400* SQ1524.2 +008500 01 REC-SKEL-SUB PIC 99. SQ1524.2 +008600* SQ1524.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ1524.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ1524.2 +008900 05 FILLER PICTURE X(48) VALUE SQ1524.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1524.2 +009100 05 FILLER PICTURE X(46) VALUE SQ1524.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1524.2 +009300 05 FILLER PICTURE X(26) VALUE SQ1524.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1524.2 +009500 05 FILLER PICTURE X(37) VALUE SQ1524.2 +009600 ",RECKEY= ". SQ1524.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1524.2 +009800 ",ALTKEY1= ". SQ1524.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1524.2 +010000 ",ALTKEY2= ". SQ1524.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1524.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1524.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ1524.2 +010400 07 FILLER PIC X(5). SQ1524.2 +010500 07 XFILE-NAME PIC X(6). SQ1524.2 +010600 07 FILLER PIC X(8). SQ1524.2 +010700 07 XRECORD-NAME PIC X(6). SQ1524.2 +010800 07 FILLER PIC X(1). SQ1524.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ1524.2 +011000 07 FILLER PIC X(7). SQ1524.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ1524.2 +011200 07 FILLER PIC X(6). SQ1524.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ1524.2 +011400 07 FILLER PIC X(5). SQ1524.2 +011500 07 ODO-NUMBER PIC 9(4). SQ1524.2 +011600 07 FILLER PIC X(5). SQ1524.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ1524.2 +011800 07 FILLER PIC X(7). SQ1524.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ1524.2 +012000 07 FILLER PIC X(7). SQ1524.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ1524.2 +012200 07 FILLER PIC X(1). SQ1524.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ1524.2 +012400 07 FILLER PIC X(6). SQ1524.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ1524.2 +012600 07 FILLER PIC X(5). SQ1524.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ1524.2 +012800 07 FILLER PIC X(6). SQ1524.2 +012900 07 XLABEL-TYPE PIC X(1). SQ1524.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ1524.2 +013100 07 FILLER PIC X(8). SQ1524.2 +013200 07 XRECORD-KEY PIC X(29). SQ1524.2 +013300 07 FILLER PIC X(9). SQ1524.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ1524.2 +013500 07 FILLER PIC X(9). SQ1524.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ1524.2 +013700 07 FILLER PIC X(7). SQ1524.2 +013800* SQ1524.2 +013900 01 TEST-RESULTS. SQ1524.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1524.2 +014100 02 FEATURE PIC X(24) VALUE SPACE. SQ1524.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1524.2 +014300 02 P-OR-F PIC X(5) VALUE SPACE. SQ1524.2 +014400 02 FILLER PIC X VALUE SPACE. SQ1524.2 +014500 02 PAR-NAME. SQ1524.2 +014600 03 FILLER PIC X(14) VALUE SPACE. SQ1524.2 +014700 03 PARDOT-X PIC X VALUE SPACE. SQ1524.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. SQ1524.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ1524.2 +015000 02 RE-MARK PIC X(61). SQ1524.2 +015100 01 TEST-COMPUTED. SQ1524.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ1524.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1524.2 +015400 02 COMPUTED-X. SQ1524.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1524.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1524.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1524.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1524.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1524.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1524.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ1524.2 +016200 04 FILLER PIC X. SQ1524.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ1524.2 +016400 01 TEST-CORRECT. SQ1524.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ1524.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1524.2 +016700 02 CORRECT-X. SQ1524.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1524.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1524.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1524.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1524.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1524.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1524.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ1524.2 +017500 04 FILLER PIC X. SQ1524.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ1524.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1524.2 +017800 01 CCVS-C-1. SQ1524.2 +017900 02 FILLER PIC IS X(4) VALUE SPACE. SQ1524.2 +018000 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1524.2 +018100- "SS PARAGRAPH-NAME SQ1524.2 +018200- " REMARKS". SQ1524.2 +018300 02 FILLER PIC X(17) VALUE SPACE. SQ1524.2 +018400 01 CCVS-C-2. SQ1524.2 +018500 02 FILLER PIC XXXX VALUE SPACE. SQ1524.2 +018600 02 FILLER PIC X(6) VALUE "TESTED". SQ1524.2 +018700 02 FILLER PIC X(16) VALUE SPACE. SQ1524.2 +018800 02 FILLER PIC X(4) VALUE "FAIL". SQ1524.2 +018900 02 FILLER PIC X(90) VALUE SPACE. SQ1524.2 +019000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1524.2 +019100 01 REC-CT PIC 99 VALUE ZERO. SQ1524.2 +019200 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1524.2 +019300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1524.2 +019400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1524.2 +019500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1524.2 +019600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1524.2 +019700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1524.2 +019800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1524.2 +019900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1524.2 +020000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1524.2 +020100 01 CCVS-H-1. SQ1524.2 +020200 02 FILLER PIC X(39) VALUE SPACES. SQ1524.2 +020300 02 FILLER PIC X(42) VALUE SQ1524.2 +020400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1524.2 +020500 02 FILLER PIC X(39) VALUE SPACES. SQ1524.2 +020600 01 CCVS-H-2A. SQ1524.2 +020700 02 FILLER PIC X(40) VALUE SPACE. SQ1524.2 +020800 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1524.2 +020900 02 FILLER PIC XXXX VALUE SQ1524.2 +021000 "4.2 ". SQ1524.2 +021100 02 FILLER PIC X(28) VALUE SQ1524.2 +021200 " COPY - NOT FOR DISTRIBUTION". SQ1524.2 +021300 02 FILLER PIC X(41) VALUE SPACE. SQ1524.2 +021400* SQ1524.2 +021500 01 CCVS-H-2B. SQ1524.2 +021600 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1524.2 +021700 02 TEST-ID PIC X(9). SQ1524.2 +021800 02 FILLER PIC X(4) VALUE " IN ". SQ1524.2 +021900 02 FILLER PIC X(12) VALUE SQ1524.2 +022000 " HIGH ". SQ1524.2 +022100 02 FILLER PIC X(22) VALUE SQ1524.2 +022200 " LEVEL VALIDATION FOR ". SQ1524.2 +022300 02 FILLER PIC X(58) VALUE SQ1524.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1524.2 +022500 01 CCVS-H-3. SQ1524.2 +022600 02 FILLER PIC X(34) VALUE SQ1524.2 +022700 " FOR OFFICIAL USE ONLY ". SQ1524.2 +022800 02 FILLER PIC X(58) VALUE SQ1524.2 +022900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1524.2 +023000 02 FILLER PIC X(28) VALUE SQ1524.2 +023100 " COPYRIGHT 1985,1986 ". SQ1524.2 +023200 01 CCVS-E-1. SQ1524.2 +023300 02 FILLER PIC X(52) VALUE SPACE. SQ1524.2 +023400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1524.2 +023500 02 ID-AGAIN PIC X(9). SQ1524.2 +023600 02 FILLER PIC X(45) VALUE SPACES. SQ1524.2 +023700 01 CCVS-E-2. SQ1524.2 +023800 02 FILLER PIC X(31) VALUE SPACE. SQ1524.2 +023900 02 FILLER PIC X(21) VALUE SPACE. SQ1524.2 +024000 02 CCVS-E-2-2. SQ1524.2 +024100 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1524.2 +024200 03 FILLER PIC X VALUE SPACE. SQ1524.2 +024300 03 ENDER-DESC PIC X(44) VALUE SQ1524.2 +024400 "ERRORS ENCOUNTERED". SQ1524.2 +024500 01 CCVS-E-3. SQ1524.2 +024600 02 FILLER PIC X(22) VALUE SQ1524.2 +024700 " FOR OFFICIAL USE ONLY". SQ1524.2 +024800 02 FILLER PIC X(12) VALUE SPACE. SQ1524.2 +024900 02 FILLER PIC X(58) VALUE SQ1524.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1524.2 +025100 02 FILLER PIC X(8) VALUE SPACE. SQ1524.2 +025200 02 FILLER PIC X(20) VALUE SQ1524.2 +025300 " COPYRIGHT 1985,1986". SQ1524.2 +025400 01 CCVS-E-4. SQ1524.2 +025500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1524.2 +025600 02 FILLER PIC X(4) VALUE " OF ". SQ1524.2 +025700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1524.2 +025800 02 FILLER PIC X(40) VALUE SQ1524.2 +025900 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1524.2 +026000 01 XXINFO. SQ1524.2 +026100 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1524.2 +026200 02 INFO-TEXT. SQ1524.2 +026300 04 FILLER PIC X(8) VALUE SPACE. SQ1524.2 +026400 04 XXCOMPUTED PIC X(20). SQ1524.2 +026500 04 FILLER PIC X(5) VALUE SPACE. SQ1524.2 +026600 04 XXCORRECT PIC X(20). SQ1524.2 +026700 02 INF-ANSI-REFERENCE PIC X(48). SQ1524.2 +026800 01 HYPHEN-LINE. SQ1524.2 +026900 02 FILLER PIC IS X VALUE IS SPACE. SQ1524.2 +027000 02 FILLER PIC IS X(65) VALUE IS "************************SQ1524.2 +027100- "*****************************************". SQ1524.2 +027200 02 FILLER PIC IS X(54) VALUE IS "************************SQ1524.2 +027300- "******************************". SQ1524.2 +027400 01 CCVS-PGM-ID PIC X(9) VALUE SQ1524.2 +027500 "SQ152A". SQ1524.2 +027600* SQ1524.2 +027700 PROCEDURE DIVISION. SQ1524.2 +027800 DECLARATIVES. SQ1524.2 +027900 SQ-FS1-DECLARATIVE SECTION. SQ1524.2 +028000 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-FS1. SQ1524.2 +028100 OUTPUT-ERROR-PROCESS. SQ1524.2 +028200 IF SQ-FS1-STATUS = "48" SQ1524.2 +028300 PERFORM PASS-DECL SQ1524.2 +028400 GO TO ABNORMAL-TERM-DECL SQ1524.2 +028500 ELSE SQ1524.2 +028600 MOVE "48" TO CORRECT-A SQ1524.2 +028700 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1524.2 +028800 MOVE "STATUS AFTER OPEN AFTER LOCK INCORRECT" SQ1524.2 +028900 TO RE-MARK SQ1524.2 +029000 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ1524.2 +029100 PERFORM FAIL-DECL SQ1524.2 +029200 GO TO ABNORMAL-TERM-DECL SQ1524.2 +029300 END-IF. SQ1524.2 +029400* SQ1524.2 +029500 PASS-DECL. SQ1524.2 +029600 MOVE "PASS " TO P-OR-F. SQ1524.2 +029700 ADD 1 TO PASS-COUNTER. SQ1524.2 +029800 PERFORM PRINT-DETAIL-DECL. SQ1524.2 +029900* SQ1524.2 +030000 FAIL-DECL. SQ1524.2 +030100 MOVE "FAIL*" TO P-OR-F. SQ1524.2 +030200 ADD 1 TO ERROR-COUNTER. SQ1524.2 +030300 PERFORM PRINT-DETAIL-DECL. SQ1524.2 +030400* SQ1524.2 +030500 PRINT-DETAIL-DECL. SQ1524.2 +030600 IF REC-CT NOT EQUAL TO ZERO SQ1524.2 +030700 MOVE "." TO PARDOT-X SQ1524.2 +030800 MOVE REC-CT TO DOTVALUE. SQ1524.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. SQ1524.2 +031000 PERFORM WRITE-LINE-DECL. SQ1524.2 +031100 IF P-OR-F EQUAL TO "FAIL*" SQ1524.2 +031200 PERFORM WRITE-LINE-DECL SQ1524.2 +031300 PERFORM FAIL-ROUTINE-DECL THRU FAIL-ROUTINE-EX-DECL SQ1524.2 +031400 ELSE SQ1524.2 +031500 PERFORM BAIL-OUT-DECL THRU BAIL-OUT-EX-DECL. SQ1524.2 +031600 MOVE SPACE TO P-OR-F. SQ1524.2 +031700 MOVE SPACE TO COMPUTED-X. SQ1524.2 +031800 MOVE SPACE TO CORRECT-X. SQ1524.2 +031900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1524.2 +032000 MOVE SPACE TO RE-MARK. SQ1524.2 +032100* SQ1524.2 +032200 WRITE-LINE-DECL. SQ1524.2 +032300 ADD 1 TO RECORD-COUNT. SQ1524.2 +032400 IF RECORD-COUNT GREATER 50 SQ1524.2 +032500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1524.2 +032600 MOVE SPACE TO DUMMY-RECORD SQ1524.2 +032700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1524.2 +032800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ1524.2 +032900 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1524.2 +033000 PERFORM WRT-LN-DECL 2 TIMES SQ1524.2 +033100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ1524.2 +033200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1524.2 +033300 MOVE ZERO TO RECORD-COUNT. SQ1524.2 +033400 PERFORM WRT-LN-DECL. SQ1524.2 +033500* SQ1524.2 +033600 WRT-LN-DECL. SQ1524.2 +033700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1524.2 +033800 MOVE SPACE TO DUMMY-RECORD. SQ1524.2 +033900 BLANK-LINE-PRINT-DECL. SQ1524.2 +034000 PERFORM WRT-LN-DECL. SQ1524.2 +034100 FAIL-ROUTINE-DECL. SQ1524.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE SQ1524.2 +034300 GO TO FAIL-ROUTINE-WRITE-DECL. SQ1524.2 +034400 IF CORRECT-X NOT EQUAL TO SPACE SQ1524.2 +034500 GO TO FAIL-ROUTINE-WRITE-DECL. SQ1524.2 +034600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1524.2 +034700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1524.2 +034800 MOVE XXINFO TO DUMMY-RECORD. SQ1524.2 +034900 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1524.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1524.2 +035100 GO TO FAIL-ROUTINE-EX-DECL. SQ1524.2 +035200 FAIL-ROUTINE-WRITE-DECL. SQ1524.2 +035300 MOVE TEST-COMPUTED TO PRINT-REC SQ1524.2 +035400 PERFORM WRITE-LINE-DECL SQ1524.2 +035500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1524.2 +035600 MOVE TEST-CORRECT TO PRINT-REC SQ1524.2 +035700 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1524.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1524.2 +035900 FAIL-ROUTINE-EX-DECL. SQ1524.2 +036000 EXIT. SQ1524.2 +036100 BAIL-OUT-DECL. SQ1524.2 +036200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-DECL. SQ1524.2 +036300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-DECL. SQ1524.2 +036400 BAIL-OUT-WRITE-DECL. SQ1524.2 +036500 MOVE CORRECT-A TO XXCORRECT. SQ1524.2 +036600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1524.2 +036700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1524.2 +036800 MOVE XXINFO TO DUMMY-RECORD. SQ1524.2 +036900 PERFORM WRITE-LINE-DECL 2 TIMES. SQ1524.2 +037000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1524.2 +037100 BAIL-OUT-EX-DECL. SQ1524.2 +037200 EXIT. SQ1524.2 +037300* SQ1524.2 +037400 ABNORMAL-TERM-DECL. SQ1524.2 +037500 MOVE SPACE TO DUMMY-RECORD. SQ1524.2 +037600 PERFORM WRITE-LINE-DECL. SQ1524.2 +037700 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1524.2 +037800 TO DUMMY-RECORD. SQ1524.2 +037900 PERFORM WRITE-LINE-DECL 3 TIMES. SQ1524.2 +038000* SQ1524.2 +038100 EXIT-DECL. SQ1524.2 +038200 EXIT. SQ1524.2 +038300 END DECLARATIVES. SQ1524.2 +038400* SQ1524.2 +038500 CCVS1 SECTION. SQ1524.2 +038600 OPEN-FILES. SQ1524.2 +038700 OPEN OUTPUT PRINT-FILE. SQ1524.2 +038800 MOVE CCVS-PGM-ID TO TEST-ID. SQ1524.2 +038900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1524.2 +039000 MOVE SPACE TO TEST-RESULTS. SQ1524.2 +039100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1524.2 +039200 MOVE ZERO TO REC-SKEL-SUB. SQ1524.2 +039300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1524.2 +039400 GO TO CCVS1-EXIT. SQ1524.2 +039500* SQ1524.2 +039600 CCVS-INIT-FILE. SQ1524.2 +039700 ADD 1 TO REC-SKL-SUB. SQ1524.2 +039800 MOVE FILE-RECORD-INFO-SKELETON TO SQ1524.2 +039900 FILE-RECORD-INFO (REC-SKL-SUB). SQ1524.2 +040000* SQ1524.2 +040100 CLOSE-FILES. SQ1524.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1524.2 +040300 CLOSE PRINT-FILE. SQ1524.2 +040400 TERMINATE-CCVS. SQ1524.2 +040500 STOP RUN. SQ1524.2 +040600* SQ1524.2 +040700 INSPT. SQ1524.2 +040800 MOVE "INSPT" TO P-OR-F. SQ1524.2 +040900 ADD 1 TO INSPECT-COUNTER. SQ1524.2 +041000 PERFORM PRINT-DETAIL. SQ1524.2 +041100 SQ1524.2 +041200 PASS. SQ1524.2 +041300 MOVE "PASS " TO P-OR-F. SQ1524.2 +041400 ADD 1 TO PASS-COUNTER. SQ1524.2 +041500 PERFORM PRINT-DETAIL. SQ1524.2 +041600* SQ1524.2 +041700 FAIL. SQ1524.2 +041800 MOVE "FAIL*" TO P-OR-F. SQ1524.2 +041900 ADD 1 TO ERROR-COUNTER. SQ1524.2 +042000 PERFORM PRINT-DETAIL. SQ1524.2 +042100* SQ1524.2 +042200 DE-LETE. SQ1524.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1524.2 +042400 MOVE "*****" TO P-OR-F. SQ1524.2 +042500 ADD 1 TO DELETE-COUNTER. SQ1524.2 +042600 PERFORM PRINT-DETAIL. SQ1524.2 +042700* SQ1524.2 +042800 PRINT-DETAIL. SQ1524.2 +042900 IF REC-CT NOT EQUAL TO ZERO SQ1524.2 +043000 MOVE "." TO PARDOT-X SQ1524.2 +043100 MOVE REC-CT TO DOTVALUE. SQ1524.2 +043200 MOVE TEST-RESULTS TO PRINT-REC. SQ1524.2 +043300 PERFORM WRITE-LINE. SQ1524.2 +043400 IF P-OR-F EQUAL TO "FAIL*" SQ1524.2 +043500 PERFORM WRITE-LINE SQ1524.2 +043600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1524.2 +043700 ELSE SQ1524.2 +043800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1524.2 +043900 MOVE SPACE TO P-OR-F. SQ1524.2 +044000 MOVE SPACE TO COMPUTED-X. SQ1524.2 +044100 MOVE SPACE TO CORRECT-X. SQ1524.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1524.2 +044300 MOVE SPACE TO RE-MARK. SQ1524.2 +044400* SQ1524.2 +044500 HEAD-ROUTINE. SQ1524.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1524.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1524.2 +045000 COLUMN-NAMES-ROUTINE. SQ1524.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1524.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1524.2 +045400 END-ROUTINE. SQ1524.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1524.2 +045600 PERFORM WRITE-LINE 5 TIMES. SQ1524.2 +045700 END-RTN-EXIT. SQ1524.2 +045800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1524.2 +045900 PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +046000* SQ1524.2 +046100 END-ROUTINE-1. SQ1524.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1524.2 +046300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1524.2 +046400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1524.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1524.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1524.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1524.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1524.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1524.2 +047000 PERFORM WRITE-LINE. SQ1524.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1524.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1524.2 +047300 MOVE "NO " TO ERROR-TOTAL SQ1524.2 +047400 ELSE SQ1524.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1524.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1524.2 +047700 PERFORM WRITE-LINE. SQ1524.2 +047800 END-ROUTINE-13. SQ1524.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1524.2 +048000 MOVE "NO " TO ERROR-TOTAL SQ1524.2 +048100 ELSE SQ1524.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1524.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1524.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1524.2 +048500 PERFORM WRITE-LINE. SQ1524.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1524.2 +048700 MOVE "NO " TO ERROR-TOTAL SQ1524.2 +048800 ELSE SQ1524.2 +048900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1524.2 +049000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1524.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1524.2 +049200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1524.2 +049300* SQ1524.2 +049400 WRITE-LINE. SQ1524.2 +049500 ADD 1 TO RECORD-COUNT. SQ1524.2 +049600 IF RECORD-COUNT GREATER 50 SQ1524.2 +049700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1524.2 +049800 MOVE SPACE TO DUMMY-RECORD SQ1524.2 +049900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1524.2 +050000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1524.2 +050100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1524.2 +050200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1524.2 +050300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1524.2 +050400 MOVE ZERO TO RECORD-COUNT. SQ1524.2 +050500 PERFORM WRT-LN. SQ1524.2 +050600* SQ1524.2 +050700 WRT-LN. SQ1524.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1524.2 +050900 MOVE SPACE TO DUMMY-RECORD. SQ1524.2 +051000 BLANK-LINE-PRINT. SQ1524.2 +051100 PERFORM WRT-LN. SQ1524.2 +051200 FAIL-ROUTINE. SQ1524.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1524.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1524.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1524.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1524.2 +051700 MOVE XXINFO TO DUMMY-RECORD. SQ1524.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1524.2 +052000 GO TO FAIL-ROUTINE-EX. SQ1524.2 +052100 FAIL-ROUTINE-WRITE. SQ1524.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC SQ1524.2 +052300 PERFORM WRITE-LINE SQ1524.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1524.2 +052500 MOVE TEST-CORRECT TO PRINT-REC SQ1524.2 +052600 PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +052700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1524.2 +052800 FAIL-ROUTINE-EX. SQ1524.2 +052900 EXIT. SQ1524.2 +053000 BAIL-OUT. SQ1524.2 +053100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1524.2 +053200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1524.2 +053300 BAIL-OUT-WRITE. SQ1524.2 +053400 MOVE CORRECT-A TO XXCORRECT. SQ1524.2 +053500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1524.2 +053600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1524.2 +053700 MOVE XXINFO TO DUMMY-RECORD. SQ1524.2 +053800 PERFORM WRITE-LINE 2 TIMES. SQ1524.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1524.2 +054000 BAIL-OUT-EX. SQ1524.2 +054100 EXIT. SQ1524.2 +054200 CCVS1-EXIT. SQ1524.2 +054300 EXIT. SQ1524.2 +054400* SQ1524.2 +054500**************************************************************** SQ1524.2 +054600* * SQ1524.2 +054700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1524.2 +054800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1524.2 +054900* * SQ1524.2 +055000**************************************************************** SQ1524.2 +055100* SQ1524.2 +055200 SECT-SQ152A-0001 SECTION. SQ1524.2 +055300 WRITE-INIT-GF-01. SQ1524.2 +055400* SQ1524.2 +055500* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1524.2 +055600* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1524.2 +055700* SQ1524.2 +055800 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1524.2 +055900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1524.2 +056000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1524.2 +056100 MOVE 120 TO XRECORD-LENGTH (1). SQ1524.2 +056200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1524.2 +056300 MOVE 1 TO XBLOCK-SIZE (1). SQ1524.2 +056400 MOVE 1 TO RECORDS-IN-FILE (1). SQ1524.2 +056500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1524.2 +056600 MOVE "S" TO XLABEL-TYPE (1). SQ1524.2 +056700 MOVE 1 TO XRECORD-NUMBER (1). SQ1524.2 +056800* SQ1524.2 +056900 WRITE-OPEN-01. SQ1524.2 +057000 OPEN OUTPUT SQ-FS1. SQ1524.2 +057100 WRITE-INIT-01. SQ1524.2 +057200 WRITE-TEST-01-01. SQ1524.2 +057300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1524.2 +057400 WRITE SQ-FS1R1-F-G-120. SQ1524.2 +057500 CLOSE-INIT-01. SQ1524.2 +057600 CLOSE-TEST-01. SQ1524.2 +057700 CLOSE SQ-FS1. SQ1524.2 +057800 OPEN-INIT-01. SQ1524.2 +057900* SQ1524.2 +058000 OPEN-TEST-01. SQ1524.2 +058100 OPEN INPUT SQ-FS1. SQ1524.2 +058200* SQ1524.2 +058300* THIS TEST OPENS THE FILE JUST CREATED IN THE INPUT SQ1524.2 +058400* MODE. WE ATTEMPT TO WRITE ANOTHER RECORD AND EXAMINE SQ1524.2 +058500* IN A DECLARACTIVE THE I-O STATUS RETURNED. IT IS SQ1524.2 +058600* POSSIBLE THAT THE SYSTEM ACTION MAY BE ABNORMAL PROGRAM SQ1524.2 +058700* TERMINATION AFTER THE DECLARATIVE IS EXECUTED. SQ1524.2 +058800* THE RECORD NUMBER FIELD IN THE RECORD TO BE WRITTEN IS SQ1524.2 +058900* CHANGED FROM THAT IN THE RECORD ORIGINALLY WRITTEN, TO SQ1524.2 +059000* AID IN ESTABLISHING THE ORIGIN OF THE RECORD IN ANY SQ1524.2 +059100* SUBSEQUENT EXAMINATION OF THE FILE. SQ1524.2 +059200* SQ1524.2 +059300 WRITE-INIT-02. SQ1524.2 +059400 MOVE 1 TO REC-CT. SQ1524.2 +059500 MOVE "WRITE-TEST-02" TO PAR-NAME SQ1524.2 +059600 MOVE "WRITE TO INPUT FILE" TO FEATURE. SQ1524.2 +059700 MOVE 2 TO XRECORD-NUMBER (1). SQ1524.2 +059800 WRITE-TEST-02-01. SQ1524.2 +059900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1524.2 +060000 WRITE SQ-FS1R1-F-G-120. SQ1524.2 +060100 CLOSE-INIT-02. SQ1524.2 +060200 CLOSE-TEST-02. SQ1524.2 +060300 CLOSE SQ-FS1. SQ1524.2 +060400* SQ1524.2 +060500 CCVS-EXIT SECTION. SQ1524.2 +060600 CCVS-999999. SQ1524.2 +060700 GO TO CLOSE-FILES. SQ1524.2 diff --git a/tests/cobol85/SQ/SQ153A.CBL b/tests/cobol85/SQ/SQ153A.CBL new file mode 100755 index 00000000..2a813a7f --- /dev/null +++ b/tests/cobol85/SQ/SQ153A.CBL @@ -0,0 +1,596 @@ +000100 IDENTIFICATION DIVISION. SQ1534.2 +000200 PROGRAM-ID. SQ1534.2 +000300 SQ153A. SQ1534.2 +000400**************************************************************** SQ1534.2 +000500* * SQ1534.2 +000600* VALIDATION FOR:- * SQ1534.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1534.2 +000800* USING CCVS85 VERSION 3.0. * SQ1534.2 +000900* * SQ1534.2 +001000* CREATION DATE / VALIDATION DATE * SQ1534.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1534.2 +001200* * SQ1534.2 +001300**************************************************************** SQ1534.2 +001400* * SQ1534.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1534.2 +001600* * SQ1534.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1534.2 +001800* X-55 SYSTEM PRINTER * SQ1534.2 +001900* X-82 SOURCE-COMPUTER * SQ1534.2 +002000* X-83 OBJECT-COMPUTER * SQ1534.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1534.2 +002200* * SQ1534.2 +002300**************************************************************** SQ1534.2 +002400* * SQ1534.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING TO* SQ1534.2 +002600* A FILE OPEN IN THE I-O MODE. THE TEST FOR CORRECT I-O * SQ1534.2 +002700* STATUS 48 IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION* SQ1534.2 +002800* IS POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1534.2 +002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1534.2 +003000* LINE CODE. * SQ1534.2 +003100* * SQ1534.2 +003200**************************************************************** SQ1534.2 +003300* SQ1534.2 +003400 ENVIRONMENT DIVISION. SQ1534.2 +003500 CONFIGURATION SECTION. SQ1534.2 +003600 SOURCE-COMPUTER. SQ1534.2 +003700 Linux. SQ1534.2 +003800 OBJECT-COMPUTER. SQ1534.2 +003900 Linux. SQ1534.2 +004000* SQ1534.2 +004100 INPUT-OUTPUT SECTION. SQ1534.2 +004200 FILE-CONTROL. SQ1534.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1534.2 +004400 "report.log". SQ1534.2 +004500* SQ1534.2 +004600 SELECT SQ-FS4 SQ1534.2 +004700 ASSIGN SQ1534.2 +004800 "XXXXX014" SQ1534.2 +004900 FILE STATUS SQ-FS4-STATUS SQ1534.2 +005000 ORGANIZATION IS SEQUENTIAL SQ1534.2 +005100 . SQ1534.2 +005200* SQ1534.2 +005300* SQ1534.2 +005400 DATA DIVISION. SQ1534.2 +005500 FILE SECTION. SQ1534.2 +005600 FD PRINT-FILE SQ1534.2 +005700*C LABEL RECORDS SQ1534.2 +005800*C OMITTED SQ1534.2 +005900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1534.2 +006000 . SQ1534.2 +006100 01 PRINT-REC PICTURE X(120). SQ1534.2 +006200 01 DUMMY-RECORD PICTURE X(120). SQ1534.2 +006300* SQ1534.2 +006400 FD SQ-FS4 SQ1534.2 +006500*C LABEL RECORD IS STANDARD SQ1534.2 +006600 BLOCK CONTAINS 120 CHARACTERS SQ1534.2 +006700 RECORD CONTAINS 120 CHARACTERS SQ1534.2 +006800 . SQ1534.2 +006900 01 SQ-FS4R1-F-G-120. SQ1534.2 +007000 05 FFILE-RECORD-INFO-P1-120 PICTURE X(120). SQ1534.2 +007100* SQ1534.2 +007200 WORKING-STORAGE SECTION. SQ1534.2 +007300* SQ1534.2 +007400*************************************************************** SQ1534.2 +007500* * SQ1534.2 +007600* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1534.2 +007700* * SQ1534.2 +007800*************************************************************** SQ1534.2 +007900* SQ1534.2 +008000 01 STATUS-GROUP. SQ1534.2 +008100 04 SQ-FS4-STATUS PICTURE XX. SQ1534.2 +008200* SQ1534.2 +008300*************************************************************** SQ1534.2 +008400* * SQ1534.2 +008500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1534.2 +008600* * SQ1534.2 +008700*************************************************************** SQ1534.2 +008800* SQ1534.2 +008900 01 FILE-RECORD-INFORMATION-REC. SQ1534.2 +009000 03 FILE-RECORD-INFO-SKELETON. SQ1534.2 +009100 05 FILLER PICTURE X(48) VALUE SQ1534.2 +009200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1534.2 +009300 05 FILLER PICTURE X(46) VALUE SQ1534.2 +009400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1534.2 +009500 05 FILLER PICTURE X(26) VALUE SQ1534.2 +009600 ",LFIL=000000,ORG= ,LBLR= ". SQ1534.2 +009700 05 FILLER PICTURE X(37) VALUE SQ1534.2 +009800 ",RECKEY= ". SQ1534.2 +009900 05 FILLER PICTURE X(38) VALUE SQ1534.2 +010000 ",ALTKEY1= ". SQ1534.2 +010100 05 FILLER PICTURE X(38) VALUE SQ1534.2 +010200 ",ALTKEY2= ". SQ1534.2 +010300 05 FILLER PICTURE X(7) VALUE SPACE.SQ1534.2 +010400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1534.2 +010500 05 FILE-RECORD-INFO-P1-120. SQ1534.2 +010600 07 FILLER PIC X(5). SQ1534.2 +010700 07 XFILE-NAME PIC X(6). SQ1534.2 +010800 07 FILLER PIC X(8). SQ1534.2 +010900 07 XRECORD-NAME PIC X(6). SQ1534.2 +011000 07 FILLER PIC X(1). SQ1534.2 +011100 07 REELUNIT-NUMBER PIC 9(1). SQ1534.2 +011200 07 FILLER PIC X(7). SQ1534.2 +011300 07 XRECORD-NUMBER PIC 9(6). SQ1534.2 +011400 07 FILLER PIC X(6). SQ1534.2 +011500 07 UPDATE-NUMBER PIC 9(2). SQ1534.2 +011600 07 FILLER PIC X(5). SQ1534.2 +011700 07 ODO-NUMBER PIC 9(4). SQ1534.2 +011800 07 FILLER PIC X(5). SQ1534.2 +011900 07 XPROGRAM-NAME PIC X(5). SQ1534.2 +012000 07 FILLER PIC X(7). SQ1534.2 +012100 07 XRECORD-LENGTH PIC 9(6). SQ1534.2 +012200 07 FILLER PIC X(7). SQ1534.2 +012300 07 CHARS-OR-RECORDS PIC X(2). SQ1534.2 +012400 07 FILLER PIC X(1). SQ1534.2 +012500 07 XBLOCK-SIZE PIC 9(4). SQ1534.2 +012600 07 FILLER PIC X(6). SQ1534.2 +012700 07 RECORDS-IN-FILE PIC 9(6). SQ1534.2 +012800 07 FILLER PIC X(5). SQ1534.2 +012900 07 XFILE-ORGANIZATION PIC X(2). SQ1534.2 +013000 07 FILLER PIC X(6). SQ1534.2 +013100 07 XLABEL-TYPE PIC X(1). SQ1534.2 +013200 05 FILE-RECORD-INFO-P121-240. SQ1534.2 +013300 07 FILLER PIC X(8). SQ1534.2 +013400 07 XRECORD-KEY PIC X(29). SQ1534.2 +013500 07 FILLER PIC X(9). SQ1534.2 +013600 07 ALTERNATE-KEY1 PIC X(29). SQ1534.2 +013700 07 FILLER PIC X(9). SQ1534.2 +013800 07 ALTERNATE-KEY2 PIC X(29). SQ1534.2 +013900 07 FILLER PIC X(7). SQ1534.2 +014000* SQ1534.2 +014100 01 TEST-RESULTS. SQ1534.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1534.2 +014300 02 PAR-NAME. SQ1534.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1534.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1534.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1534.2 +014700 02 FILLER PIC X VALUE SPACE. SQ1534.2 +014800 02 FEATURE PIC X(24) VALUE SPACE. SQ1534.2 +014900 02 FILLER PIC X VALUE SPACE. SQ1534.2 +015000 02 P-OR-F PIC X(5) VALUE SPACE. SQ1534.2 +015100 02 FILLER PIC X(9) VALUE SPACE. SQ1534.2 +015200 02 RE-MARK PIC X(61). SQ1534.2 +015300 01 TEST-COMPUTED. SQ1534.2 +015400 02 FILLER PIC X(30) VALUE SPACE. SQ1534.2 +015500 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1534.2 +015600 02 COMPUTED-X. SQ1534.2 +015700 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1534.2 +015800 03 FILLER PIC X(50) VALUE SPACE. SQ1534.2 +015900 01 TEST-CORRECT. SQ1534.2 +016000 02 FILLER PIC X(30) VALUE SPACE. SQ1534.2 +016100 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1534.2 +016200 02 CORRECT-X. SQ1534.2 +016300 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1534.2 +016400 03 FILLER PIC X(2) VALUE SPACE. SQ1534.2 +016500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1534.2 +016600* SQ1534.2 +016700 01 CCVS-C-1. SQ1534.2 +016800 02 FILLER PIC IS X VALUE SPACE. SQ1534.2 +016900 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1534.2 +017000 02 FILLER PIC IS X VALUE SPACE. SQ1534.2 +017100 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1534.2 +017200 02 FILLER PIC IS X VALUE SPACE. SQ1534.2 +017300 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1534.2 +017400 02 FILLER PIC IS X(9) VALUE SPACE. SQ1534.2 +017500 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1534.2 +017600 01 CCVS-C-2. SQ1534.2 +017700 02 FILLER PIC X(19) VALUE SPACE. SQ1534.2 +017800 02 FILLER PIC X(6) VALUE "TESTED". SQ1534.2 +017900 02 FILLER PIC X(19) VALUE SPACE. SQ1534.2 +018000 02 FILLER PIC X(4) VALUE "FAIL". SQ1534.2 +018100 02 FILLER PIC X(72) VALUE SPACE. SQ1534.2 +018200* SQ1534.2 +018300 01 REC-CT PIC 99 VALUE ZERO. SQ1534.2 +018400 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1534.2 +018500 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1534.2 +018600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1534.2 +018700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1534.2 +018800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1534.2 +018900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1534.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1534.2 +019100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1534.2 +019200 01 CCVS-H-1. SQ1534.2 +019300 02 FILLER PIC X(39) VALUE SPACES. SQ1534.2 +019400 02 FILLER PIC X(42) VALUE SQ1534.2 +019500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1534.2 +019600 02 FILLER PIC X(39) VALUE SPACES. SQ1534.2 +019700 01 CCVS-H-2A. SQ1534.2 +019800 02 FILLER PIC X(40) VALUE SPACE. SQ1534.2 +019900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1534.2 +020000 02 FILLER PIC XXXX VALUE SQ1534.2 +020100 "4.2 ". SQ1534.2 +020200 02 FILLER PIC X(28) VALUE SQ1534.2 +020300 " COPY - NOT FOR DISTRIBUTION". SQ1534.2 +020400 02 FILLER PIC X(41) VALUE SPACE. SQ1534.2 +020500* SQ1534.2 +020600 01 CCVS-H-2B. SQ1534.2 +020700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1534.2 +020800 02 TEST-ID PIC X(9). SQ1534.2 +020900 02 FILLER PIC X(4) VALUE " IN ". SQ1534.2 +021000 02 FILLER PIC X(12) VALUE SQ1534.2 +021100 " HIGH ". SQ1534.2 +021200 02 FILLER PIC X(22) VALUE SQ1534.2 +021300 " LEVEL VALIDATION FOR ". SQ1534.2 +021400 02 FILLER PIC X(58) VALUE SQ1534.2 +021500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1534.2 +021600 01 CCVS-H-3. SQ1534.2 +021700 02 FILLER PIC X(34) VALUE SQ1534.2 +021800 " FOR OFFICIAL USE ONLY ". SQ1534.2 +021900 02 FILLER PIC X(58) VALUE SQ1534.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1534.2 +022100 02 FILLER PIC X(28) VALUE SQ1534.2 +022200 " COPYRIGHT 1985,1986 ". SQ1534.2 +022300 01 CCVS-E-1. SQ1534.2 +022400 02 FILLER PIC X(52) VALUE SPACE. SQ1534.2 +022500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1534.2 +022600 02 ID-AGAIN PIC X(9). SQ1534.2 +022700 02 FILLER PIC X(45) VALUE SPACES. SQ1534.2 +022800 01 CCVS-E-2. SQ1534.2 +022900 02 FILLER PIC X(31) VALUE SPACE. SQ1534.2 +023000 02 FILLER PIC X(21) VALUE SPACE. SQ1534.2 +023100 02 CCVS-E-2-2. SQ1534.2 +023200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1534.2 +023300 03 FILLER PIC X VALUE SPACE. SQ1534.2 +023400 03 ENDER-DESC PIC X(44) VALUE SQ1534.2 +023500 "ERRORS ENCOUNTERED". SQ1534.2 +023600 01 CCVS-E-3. SQ1534.2 +023700 02 FILLER PIC X(22) VALUE SQ1534.2 +023800 " FOR OFFICIAL USE ONLY". SQ1534.2 +023900 02 FILLER PIC X(12) VALUE SPACE. SQ1534.2 +024000 02 FILLER PIC X(58) VALUE SQ1534.2 +024100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1534.2 +024200 02 FILLER PIC X(8) VALUE SPACE. SQ1534.2 +024300 02 FILLER PIC X(20) VALUE SQ1534.2 +024400 " COPYRIGHT 1985,1986". SQ1534.2 +024500 01 CCVS-E-4. SQ1534.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1534.2 +024700 02 FILLER PIC X(4) VALUE " OF ". SQ1534.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1534.2 +024900 02 FILLER PIC X(40) VALUE SQ1534.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1534.2 +025100 01 XXINFO. SQ1534.2 +025200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1534.2 +025300 02 INFO-TEXT. SQ1534.2 +025400 04 FILLER PIC X(8) VALUE SPACE. SQ1534.2 +025500 04 XXCOMPUTED PIC X(20). SQ1534.2 +025600 04 FILLER PIC X(5) VALUE SPACE. SQ1534.2 +025700 04 XXCORRECT PIC X(20). SQ1534.2 +025800 02 INF-ANSI-REFERENCE PIC X(48). SQ1534.2 +025900 01 HYPHEN-LINE. SQ1534.2 +026000 02 FILLER PIC IS X VALUE IS SPACE. SQ1534.2 +026100 02 FILLER PIC IS X(65) VALUE IS "************************SQ1534.2 +026200- "*****************************************". SQ1534.2 +026300 02 FILLER PIC IS X(54) VALUE IS "************************SQ1534.2 +026400- "******************************". SQ1534.2 +026500 01 CCVS-PGM-ID PIC X(9) VALUE SQ1534.2 +026600 "SQ153A". SQ1534.2 +026700* SQ1534.2 +026800* SQ1534.2 +026900 PROCEDURE DIVISION. SQ1534.2 +027000 DECLARATIVES. SQ1534.2 +027100* SQ1534.2 +027200 SECT-SQ153A-0001 SECTION. SQ1534.2 +027300 USE AFTER STANDARD EXCEPTION PROCEDURE I-O. SQ1534.2 +027400 O-ERROR-PROCESS. SQ1534.2 +027500 IF SQ-FS4-STATUS = "48" SQ1534.2 +027600 PERFORM DECL-PASS SQ1534.2 +027700 GO TO ABNORMAL-TERM-DECL SQ1534.2 +027800 ELSE SQ1534.2 +027900 MOVE "48" TO CORRECT-A SQ1534.2 +028000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ1534.2 +028100 MOVE "STATUS FOR WRITE OF FILE OPEN I-O INCORRECT" SQ1534.2 +028200 TO RE-MARK SQ1534.2 +028300 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1534.2 +028400 PERFORM DECL-FAIL SQ1534.2 +028500 GO TO ABNORMAL-TERM-DECL SQ1534.2 +028600 END-IF. SQ1534.2 +028700* SQ1534.2 +028800* SQ1534.2 +028900 DECL-PASS. SQ1534.2 +029000 MOVE "PASS " TO P-OR-F. SQ1534.2 +029100 ADD 1 TO PASS-COUNTER. SQ1534.2 +029200 PERFORM DECL-PRINT-DETAIL. SQ1534.2 +029300* SQ1534.2 +029400 DECL-FAIL. SQ1534.2 +029500 MOVE "FAIL*" TO P-OR-F. SQ1534.2 +029600 ADD 1 TO ERROR-COUNTER. SQ1534.2 +029700 PERFORM DECL-PRINT-DETAIL. SQ1534.2 +029800* SQ1534.2 +029900 DECL-DE-LETE. SQ1534.2 +030000 MOVE "****TEST DELETED****" TO RE-MARK. SQ1534.2 +030100 MOVE "*****" TO P-OR-F. SQ1534.2 +030200 ADD 1 TO DELETE-COUNTER. SQ1534.2 +030300 PERFORM DECL-PRINT-DETAIL. SQ1534.2 +030400* SQ1534.2 +030500 DECL-PRINT-DETAIL. SQ1534.2 +030600 IF REC-CT NOT EQUAL TO ZERO SQ1534.2 +030700 MOVE "." TO PARDOT-X SQ1534.2 +030800 MOVE REC-CT TO DOTVALUE. SQ1534.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. SQ1534.2 +031000 PERFORM DECL-WRITE-LINE. SQ1534.2 +031100 IF P-OR-F EQUAL TO "FAIL*" SQ1534.2 +031200 PERFORM DECL-WRITE-LINE SQ1534.2 +031300 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1534.2 +031400 ELSE SQ1534.2 +031500 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1534.2 +031600 MOVE SPACE TO P-OR-F. SQ1534.2 +031700 MOVE SPACE TO COMPUTED-X. SQ1534.2 +031800 MOVE SPACE TO CORRECT-X. SQ1534.2 +031900 IF REC-CT EQUAL TO ZERO SQ1534.2 +032000 MOVE SPACE TO PAR-NAME. SQ1534.2 +032100 MOVE SPACE TO RE-MARK. SQ1534.2 +032200* SQ1534.2 +032300 DECL-WRITE-LINE. SQ1534.2 +032400 ADD 1 TO RECORD-COUNT. SQ1534.2 +032500 IF RECORD-COUNT GREATER 50 SQ1534.2 +032600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1534.2 +032700 MOVE SPACE TO DUMMY-RECORD SQ1534.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1534.2 +032900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1534.2 +033000 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1534.2 +033100 PERFORM DECL-WRT-LN 2 TIMES SQ1534.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1534.2 +033300 PERFORM DECL-WRT-LN SQ1534.2 +033400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1534.2 +033500 MOVE ZERO TO RECORD-COUNT. SQ1534.2 +033600 PERFORM DECL-WRT-LN. SQ1534.2 +033700* SQ1534.2 +033800 DECL-WRT-LN. SQ1534.2 +033900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1534.2 +034000 MOVE SPACE TO DUMMY-RECORD. SQ1534.2 +034100* SQ1534.2 +034200 DECL-FAIL-ROUTINE. SQ1534.2 +034300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1534.2 +034400 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1534.2 +034500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1534.2 +034600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1534.2 +034700 MOVE XXINFO TO DUMMY-RECORD. SQ1534.2 +034800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1534.2 +034900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1534.2 +035000 GO TO DECL-FAIL-EX. SQ1534.2 +035100 DECL-FAIL-WRITE. SQ1534.2 +035200 MOVE TEST-COMPUTED TO PRINT-REC SQ1534.2 +035300 PERFORM DECL-WRITE-LINE SQ1534.2 +035400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1534.2 +035500 MOVE TEST-CORRECT TO PRINT-REC SQ1534.2 +035600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1534.2 +035700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1534.2 +035800 DECL-FAIL-EX. SQ1534.2 +035900 EXIT. SQ1534.2 +036000* SQ1534.2 +036100 DECL-BAIL. SQ1534.2 +036200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1534.2 +036300 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1534.2 +036400 DECL-BAIL-WRITE. SQ1534.2 +036500 MOVE CORRECT-A TO XXCORRECT. SQ1534.2 +036600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1534.2 +036700 MOVE XXINFO TO DUMMY-RECORD. SQ1534.2 +036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1534.2 +036900 DECL-BAIL-EX. SQ1534.2 +037000 EXIT. SQ1534.2 +037100* SQ1534.2 +037200 ABNORMAL-TERM-DECL. SQ1534.2 +037300 MOVE SPACE TO DUMMY-RECORD. SQ1534.2 +037400 PERFORM DECL-WRITE-LINE. SQ1534.2 +037500 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1534.2 +037600 TO DUMMY-RECORD. SQ1534.2 +037700 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1534.2 +037800* SQ1534.2 +037900 END DECLARATIVES. SQ1534.2 +038000* SQ1534.2 +038100* SQ1534.2 +038200 CCVS1 SECTION. SQ1534.2 +038300 OPEN-FILES. SQ1534.2 +038400 OPEN OUTPUT PRINT-FILE. SQ1534.2 +038500 MOVE CCVS-PGM-ID TO TEST-ID. SQ1534.2 +038600 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1534.2 +038700 MOVE SPACE TO TEST-RESULTS. SQ1534.2 +038800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1534.2 +038900 GO TO CCVS1-EXIT. SQ1534.2 +039000* SQ1534.2 +039100 CLOSE-FILES. SQ1534.2 +039200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1534.2 +039300 CLOSE PRINT-FILE. SQ1534.2 +039400 TERMINATE-CCVS. SQ1534.2 +039500 STOP RUN. SQ1534.2 +039600* SQ1534.2 +039700 INSPT. SQ1534.2 +039800 MOVE "INSPT" TO P-OR-F. SQ1534.2 +039900 ADD 1 TO INSPECT-COUNTER. SQ1534.2 +040000 PERFORM PRINT-DETAIL. SQ1534.2 +040100* SQ1534.2 +040200 PASS. SQ1534.2 +040300 MOVE "PASS " TO P-OR-F. SQ1534.2 +040400 ADD 1 TO PASS-COUNTER. SQ1534.2 +040500 PERFORM PRINT-DETAIL. SQ1534.2 +040600* SQ1534.2 +040700 FAIL. SQ1534.2 +040800 MOVE "FAIL*" TO P-OR-F. SQ1534.2 +040900 ADD 1 TO ERROR-COUNTER. SQ1534.2 +041000 PERFORM PRINT-DETAIL. SQ1534.2 +041100* SQ1534.2 +041200 DE-LETE. SQ1534.2 +041300 MOVE "****TEST DELETED****" TO RE-MARK. SQ1534.2 +041400 MOVE "*****" TO P-OR-F. SQ1534.2 +041500 ADD 1 TO DELETE-COUNTER. SQ1534.2 +041600 PERFORM PRINT-DETAIL. SQ1534.2 +041700* SQ1534.2 +041800 PRINT-DETAIL. SQ1534.2 +041900 IF REC-CT NOT EQUAL TO ZERO SQ1534.2 +042000 MOVE "." TO PARDOT-X SQ1534.2 +042100 MOVE REC-CT TO DOTVALUE. SQ1534.2 +042200 MOVE TEST-RESULTS TO PRINT-REC. SQ1534.2 +042300 PERFORM WRITE-LINE. SQ1534.2 +042400 IF P-OR-F EQUAL TO "FAIL*" SQ1534.2 +042500 PERFORM WRITE-LINE SQ1534.2 +042600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1534.2 +042700 ELSE SQ1534.2 +042800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1534.2 +042900 MOVE SPACE TO P-OR-F. SQ1534.2 +043000 MOVE SPACE TO COMPUTED-X. SQ1534.2 +043100 MOVE SPACE TO CORRECT-X. SQ1534.2 +043200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1534.2 +043300 MOVE SPACE TO RE-MARK. SQ1534.2 +043400* SQ1534.2 +043500 HEAD-ROUTINE. SQ1534.2 +043600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +043700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +043800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1534.2 +043900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1534.2 +044000 COLUMN-NAMES-ROUTINE. SQ1534.2 +044100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1534.2 +044200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +044300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1534.2 +044400 END-ROUTINE. SQ1534.2 +044500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1534.2 +044600 PERFORM WRITE-LINE 5 TIMES. SQ1534.2 +044700 END-RTN-EXIT. SQ1534.2 +044800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1534.2 +044900 PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +045000* SQ1534.2 +045100 END-ROUTINE-1. SQ1534.2 +045200 ADD ERROR-COUNTER TO ERROR-HOLD SQ1534.2 +045300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1534.2 +045400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1534.2 +045500 ADD PASS-COUNTER TO ERROR-HOLD. SQ1534.2 +045600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1534.2 +045700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1534.2 +045800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1534.2 +045900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1534.2 +046000 PERFORM WRITE-LINE. SQ1534.2 +046100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1534.2 +046200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1534.2 +046300 MOVE "NO " TO ERROR-TOTAL SQ1534.2 +046400 ELSE SQ1534.2 +046500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1534.2 +046600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1534.2 +046700 PERFORM WRITE-LINE. SQ1534.2 +046800 END-ROUTINE-13. SQ1534.2 +046900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1534.2 +047000 MOVE "NO " TO ERROR-TOTAL SQ1534.2 +047100 ELSE SQ1534.2 +047200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1534.2 +047300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1534.2 +047400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1534.2 +047500 PERFORM WRITE-LINE. SQ1534.2 +047600 IF INSPECT-COUNTER EQUAL TO ZERO SQ1534.2 +047700 MOVE "NO " TO ERROR-TOTAL SQ1534.2 +047800 ELSE SQ1534.2 +047900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1534.2 +048000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1534.2 +048100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1534.2 +048200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1534.2 +048300* SQ1534.2 +048400 WRITE-LINE. SQ1534.2 +048500 ADD 1 TO RECORD-COUNT. SQ1534.2 +048600 IF RECORD-COUNT GREATER 50 SQ1534.2 +048700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1534.2 +048800 MOVE SPACE TO DUMMY-RECORD SQ1534.2 +048900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1534.2 +049000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1534.2 +049100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1534.2 +049200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1534.2 +049300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1534.2 +049400 MOVE ZERO TO RECORD-COUNT. SQ1534.2 +049500 PERFORM WRT-LN. SQ1534.2 +049600* SQ1534.2 +049700 WRT-LN. SQ1534.2 +049800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1534.2 +049900 MOVE SPACE TO DUMMY-RECORD. SQ1534.2 +050000 BLANK-LINE-PRINT. SQ1534.2 +050100 PERFORM WRT-LN. SQ1534.2 +050200 FAIL-ROUTINE. SQ1534.2 +050300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1534.2 +050400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1534.2 +050500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1534.2 +050600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1534.2 +050700 MOVE XXINFO TO DUMMY-RECORD. SQ1534.2 +050800 PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +050900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1534.2 +051000 GO TO FAIL-ROUTINE-EX. SQ1534.2 +051100 FAIL-ROUTINE-WRITE. SQ1534.2 +051200 MOVE TEST-COMPUTED TO PRINT-REC SQ1534.2 +051300 PERFORM WRITE-LINE SQ1534.2 +051400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1534.2 +051500 MOVE TEST-CORRECT TO PRINT-REC SQ1534.2 +051600 PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +051700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1534.2 +051800 FAIL-ROUTINE-EX. SQ1534.2 +051900 EXIT. SQ1534.2 +052000 BAIL-OUT. SQ1534.2 +052100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1534.2 +052200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1534.2 +052300 BAIL-OUT-WRITE. SQ1534.2 +052400 MOVE CORRECT-A TO XXCORRECT. SQ1534.2 +052500 MOVE COMPUTED-A TO XXCOMPUTED. SQ1534.2 +052600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1534.2 +052700 MOVE XXINFO TO DUMMY-RECORD. SQ1534.2 +052800 PERFORM WRITE-LINE 2 TIMES. SQ1534.2 +052900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1534.2 +053000 BAIL-OUT-EX. SQ1534.2 +053100 EXIT. SQ1534.2 +053200 CCVS1-EXIT. SQ1534.2 +053300 EXIT. SQ1534.2 +053400* SQ1534.2 +053500**************************************************************** SQ1534.2 +053600* * SQ1534.2 +053700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1534.2 +053800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1534.2 +053900* * SQ1534.2 +054000**************************************************************** SQ1534.2 +054100* SQ1534.2 +054200 SECT-SQ153A-0002 SECTION. SQ1534.2 +054300* SQ1534.2 +054400* THIS TEST CREATES FILE SQ-FS4 AND CLOSES IT. SQ1534.2 +054500* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1534.2 +054600* SQ1534.2 +054700 WRITE-INIT-GF-01. SQ1534.2 +054800 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ1534.2 +054900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1534.2 +055000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1534.2 +055100 MOVE 120 TO XRECORD-LENGTH (1). SQ1534.2 +055200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1534.2 +055300 MOVE 1 TO XBLOCK-SIZE (1). SQ1534.2 +055400 MOVE 1 TO RECORDS-IN-FILE (1). SQ1534.2 +055500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1534.2 +055600 MOVE "S" TO XLABEL-TYPE (1). SQ1534.2 +055700 MOVE 1 TO XRECORD-NUMBER (1). SQ1534.2 +055800* SQ1534.2 +055900 WRITE-OPEN-01. SQ1534.2 +056000 OPEN OUTPUT SQ-FS4. SQ1534.2 +056100* SQ1534.2 +056200 WRITE-TEST-01-01. SQ1534.2 +056300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1534.2 +056400 WRITE SQ-FS4R1-F-G-120. SQ1534.2 +056500* SQ1534.2 +056600 CLOSE-TEST-01. SQ1534.2 +056700 CLOSE SQ-FS4. SQ1534.2 +056800* SQ1534.2 +056900 OPEN-TEST-02. SQ1534.2 +057000 OPEN I-O SQ-FS4. SQ1534.2 +057100* SQ1534.2 +057200* THIS TEST OPENS THE FILE JUST CREATED IN THE I-O MODE. SQ1534.2 +057300* WE ATTEMPT TO WRITE ANOTHER RECORD AND EXAMINE IN A SQ1534.2 +057400* DECLARATIVE THE I-O STATUS RETURNED. IT IS POSSIBLE SQ1534.2 +057500* THAT THE SYSTEM ACTION MAY BE ABNORMAL PROGRAM SQ1534.2 +057600* TERMINATION AFTER THE DECLARATIVE IS EXECUTED. THE SQ1534.2 +057700* RECORD NUMBER FIELD IN THE RECORD TO BE WRITTEN IS SQ1534.2 +057800* CHANGED FROM THAT IN THE RECORD ORIGINALLY WRITTEN TO SQ1534.2 +057900* AID IN ESTABLISHING THE ORIGIN OF THE RECORD IN ANY SQ1534.2 +058000* SUBSEQUENT EXAMINATION OF THE FILE. SQ1534.2 +058100* SQ1534.2 +058200 WRITE-INIT-02. SQ1534.2 +058300 MOVE 1 TO REC-CT. SQ1534.2 +058400 MOVE "WRITE-TEST-02" TO PAR-NAME. SQ1534.2 +058500 MOVE "WRITE TO I-O FILE" TO FEATURE. SQ1534.2 +058600 MOVE 2 TO XRECORD-NUMBER (1). SQ1534.2 +058700 WRITE-TEST-02. SQ1534.2 +058800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ1534.2 +058900 WRITE SQ-FS4R1-F-G-120. SQ1534.2 +059000* SQ1534.2 +059100 CLOSE-TEST-02. SQ1534.2 +059200 CLOSE SQ-FS4. SQ1534.2 +059300* SQ1534.2 +059400 CCVS-EXIT SECTION. SQ1534.2 +059500 CCVS-999999. SQ1534.2 +059600 GO TO CLOSE-FILES. SQ1534.2 diff --git a/tests/cobol85/SQ/SQ154A.CBL b/tests/cobol85/SQ/SQ154A.CBL new file mode 100755 index 00000000..92e3106e --- /dev/null +++ b/tests/cobol85/SQ/SQ154A.CBL @@ -0,0 +1,503 @@ +000100 IDENTIFICATION DIVISION. SQ1544.2 +000200 PROGRAM-ID. SQ1544.2 +000300 SQ154A. SQ1544.2 +000400**************************************************************** SQ1544.2 +000500* * SQ1544.2 +000600* VALIDATION FOR:- * SQ1544.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1544.2 +000800* USING CCVS85 VERSION 3.0. * SQ1544.2 +000900* * SQ1544.2 +001000* CREATION DATE / VALIDATION DATE * SQ1544.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1544.2 +001200* * SQ1544.2 +001300**************************************************************** SQ1544.2 +001400* * SQ1544.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1544.2 +001600* * SQ1544.2 +001700* X-01 SEQUENTIAL TAPE * SQ1544.2 +001800* X-55 SYSTEM PRINTER * SQ1544.2 +001900* X-82 SOURCE-COMPUTER * SQ1544.2 +002000* X-83 OBJECT-COMPUTER * SQ1544.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1544.2 +002200* * SQ1544.2 +002300**************************************************************** SQ1544.2 +002400* * SQ1544.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING TO* SQ1544.2 +002600* A FILE THAT IS NOT OPEN (NOT OPEN IN THE OUTPUT OR EXTEND * SQ1544.2 +002700* MODE). THE TEST FOR CORRECT I-O STATUS CODE 48 IS IN THE * SQ1544.2 +002800* MAIN LINE CODE, THEREFORE AN ABNORMAL TERMINATION IS * SQ1544.2 +002900* POSSIBLE BEFORE THE TEST OF THE I-O STATUS CODE IS * SQ1544.2 +003000* ACCOMPLISHED. * SQ1544.2 +003100* * SQ1544.2 +003200**************************************************************** SQ1544.2 +003300* SQ1544.2 +003400 ENVIRONMENT DIVISION. SQ1544.2 +003500 CONFIGURATION SECTION. SQ1544.2 +003600 SOURCE-COMPUTER. SQ1544.2 +003700 Linux. SQ1544.2 +003800 OBJECT-COMPUTER. SQ1544.2 +003900 Linux. SQ1544.2 +004000* SQ1544.2 +004100 INPUT-OUTPUT SECTION. SQ1544.2 +004200 FILE-CONTROL. SQ1544.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ1544.2 +004400 "report.log". SQ1544.2 +004500* SQ1544.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ1544.2 +004700 "XXXXX001" SQ1544.2 +004800 FILE STATUS IS SQ-FS1-STATUS. SQ1544.2 +004900* SQ1544.2 +005000* SQ1544.2 +005100 DATA DIVISION. SQ1544.2 +005200 FILE SECTION. SQ1544.2 +005300 FD PRINT-FILE SQ1544.2 +005400*C LABEL RECORDS SQ1544.2 +005500*C OMITTED SQ1544.2 +005600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1544.2 +005700 . SQ1544.2 +005800 01 PRINT-REC PICTURE X(120). SQ1544.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ1544.2 +006000* SQ1544.2 +006100 FD SQ-FS1 SQ1544.2 +006200*C LABEL RECORD IS STANDARD SQ1544.2 +006300 . SQ1544.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1544.2 +006500* SQ1544.2 +006600 WORKING-STORAGE SECTION. SQ1544.2 +006700* SQ1544.2 +006800*************************************************************** SQ1544.2 +006900* * SQ1544.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1544.2 +007100* * SQ1544.2 +007200*************************************************************** SQ1544.2 +007300* SQ1544.2 +007400 01 SQ-FS1-STATUS. SQ1544.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ1544.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ1544.2 +007700* SQ1544.2 +007800*************************************************************** SQ1544.2 +007900* * SQ1544.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1544.2 +008100* * SQ1544.2 +008200*************************************************************** SQ1544.2 +008300* SQ1544.2 +008400 01 REC-SKEL-SUB PIC 99. SQ1544.2 +008500* SQ1544.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ1544.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ1544.2 +008800 05 FILLER PICTURE X(48) VALUE SQ1544.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1544.2 +009000 05 FILLER PICTURE X(46) VALUE SQ1544.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1544.2 +009200 05 FILLER PICTURE X(26) VALUE SQ1544.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ1544.2 +009400 05 FILLER PICTURE X(37) VALUE SQ1544.2 +009500 ",RECKEY= ". SQ1544.2 +009600 05 FILLER PICTURE X(38) VALUE SQ1544.2 +009700 ",ALTKEY1= ". SQ1544.2 +009800 05 FILLER PICTURE X(38) VALUE SQ1544.2 +009900 ",ALTKEY2= ". SQ1544.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE.SQ1544.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1544.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ1544.2 +010300 07 FILLER PIC X(5). SQ1544.2 +010400 07 XFILE-NAME PIC X(6). SQ1544.2 +010500 07 FILLER PIC X(8). SQ1544.2 +010600 07 XRECORD-NAME PIC X(6). SQ1544.2 +010700 07 FILLER PIC X(1). SQ1544.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ1544.2 +010900 07 FILLER PIC X(7). SQ1544.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ1544.2 +011100 07 FILLER PIC X(6). SQ1544.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ1544.2 +011300 07 FILLER PIC X(5). SQ1544.2 +011400 07 ODO-NUMBER PIC 9(4). SQ1544.2 +011500 07 FILLER PIC X(5). SQ1544.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ1544.2 +011700 07 FILLER PIC X(7). SQ1544.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ1544.2 +011900 07 FILLER PIC X(7). SQ1544.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ1544.2 +012100 07 FILLER PIC X(1). SQ1544.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ1544.2 +012300 07 FILLER PIC X(6). SQ1544.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ1544.2 +012500 07 FILLER PIC X(5). SQ1544.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ1544.2 +012700 07 FILLER PIC X(6). SQ1544.2 +012800 07 XLABEL-TYPE PIC X(1). SQ1544.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ1544.2 +013000 07 FILLER PIC X(8). SQ1544.2 +013100 07 XRECORD-KEY PIC X(29). SQ1544.2 +013200 07 FILLER PIC X(9). SQ1544.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ1544.2 +013400 07 FILLER PIC X(9). SQ1544.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ1544.2 +013600 07 FILLER PIC X(7). SQ1544.2 +013700* SQ1544.2 +013800 01 TEST-RESULTS. SQ1544.2 +013900 02 FILLER PIC X VALUE SPACE. SQ1544.2 +014000 02 FEATURE PIC X(24) VALUE SPACE. SQ1544.2 +014100 02 FILLER PIC X VALUE SPACE. SQ1544.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. SQ1544.2 +014300 02 FILLER PIC X VALUE SPACE. SQ1544.2 +014400 02 PAR-NAME. SQ1544.2 +014500 03 FILLER PIC X(14) VALUE SPACE. SQ1544.2 +014600 03 PARDOT-X PIC X VALUE SPACE. SQ1544.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. SQ1544.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ1544.2 +014900 02 RE-MARK PIC X(61). SQ1544.2 +015000 01 TEST-COMPUTED. SQ1544.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ1544.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1544.2 +015300 02 COMPUTED-X. SQ1544.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1544.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1544.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1544.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1544.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1544.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ1544.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ1544.2 +016100 04 FILLER PIC X. SQ1544.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ1544.2 +016300 01 TEST-CORRECT. SQ1544.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ1544.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1544.2 +016600 02 CORRECT-X. SQ1544.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1544.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1544.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1544.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1544.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1544.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ1544.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ1544.2 +017400 04 FILLER PIC X. SQ1544.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ1544.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1544.2 +017700 01 CCVS-C-1. SQ1544.2 +017800 02 FILLER PIC IS X(4) VALUE SPACE. SQ1544.2 +017900 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1544.2 +018000- "SS PARAGRAPH-NAME SQ1544.2 +018100- " REMARKS". SQ1544.2 +018200 02 FILLER PIC X(17) VALUE SPACE. SQ1544.2 +018300 01 CCVS-C-2. SQ1544.2 +018400 02 FILLER PIC XXXX VALUE SPACE. SQ1544.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". SQ1544.2 +018600 02 FILLER PIC X(16) VALUE SPACE. SQ1544.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". SQ1544.2 +018800 02 FILLER PIC X(90) VALUE SPACE. SQ1544.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1544.2 +019000 01 REC-CT PIC 99 VALUE ZERO. SQ1544.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1544.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1544.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1544.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1544.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1544.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1544.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1544.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1544.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1544.2 +020000 01 CCVS-H-1. SQ1544.2 +020100 02 FILLER PIC X(39) VALUE SPACES. SQ1544.2 +020200 02 FILLER PIC X(42) VALUE SQ1544.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1544.2 +020400 02 FILLER PIC X(39) VALUE SPACES. SQ1544.2 +020500 01 CCVS-H-2A. SQ1544.2 +020600 02 FILLER PIC X(40) VALUE SPACE. SQ1544.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1544.2 +020800 02 FILLER PIC XXXX VALUE SQ1544.2 +020900 "4.2 ". SQ1544.2 +021000 02 FILLER PIC X(28) VALUE SQ1544.2 +021100 " COPY - NOT FOR DISTRIBUTION". SQ1544.2 +021200 02 FILLER PIC X(41) VALUE SPACE. SQ1544.2 +021300* SQ1544.2 +021400 01 CCVS-H-2B. SQ1544.2 +021500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1544.2 +021600 02 TEST-ID PIC X(9). SQ1544.2 +021700 02 FILLER PIC X(4) VALUE " IN ". SQ1544.2 +021800 02 FILLER PIC X(12) VALUE SQ1544.2 +021900 " HIGH ". SQ1544.2 +022000 02 FILLER PIC X(22) VALUE SQ1544.2 +022100 " LEVEL VALIDATION FOR ". SQ1544.2 +022200 02 FILLER PIC X(58) VALUE SQ1544.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1544.2 +022400 01 CCVS-H-3. SQ1544.2 +022500 02 FILLER PIC X(34) VALUE SQ1544.2 +022600 " FOR OFFICIAL USE ONLY ". SQ1544.2 +022700 02 FILLER PIC X(58) VALUE SQ1544.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1544.2 +022900 02 FILLER PIC X(28) VALUE SQ1544.2 +023000 " COPYRIGHT 1985,1986 ". SQ1544.2 +023100 01 CCVS-E-1. SQ1544.2 +023200 02 FILLER PIC X(52) VALUE SPACE. SQ1544.2 +023300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1544.2 +023400 02 ID-AGAIN PIC X(9). SQ1544.2 +023500 02 FILLER PIC X(45) VALUE SPACES. SQ1544.2 +023600 01 CCVS-E-2. SQ1544.2 +023700 02 FILLER PIC X(31) VALUE SPACE. SQ1544.2 +023800 02 FILLER PIC X(21) VALUE SPACE. SQ1544.2 +023900 02 CCVS-E-2-2. SQ1544.2 +024000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1544.2 +024100 03 FILLER PIC X VALUE SPACE. SQ1544.2 +024200 03 ENDER-DESC PIC X(44) VALUE SQ1544.2 +024300 "ERRORS ENCOUNTERED". SQ1544.2 +024400 01 CCVS-E-3. SQ1544.2 +024500 02 FILLER PIC X(22) VALUE SQ1544.2 +024600 " FOR OFFICIAL USE ONLY". SQ1544.2 +024700 02 FILLER PIC X(12) VALUE SPACE. SQ1544.2 +024800 02 FILLER PIC X(58) VALUE SQ1544.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1544.2 +025000 02 FILLER PIC X(8) VALUE SPACE. SQ1544.2 +025100 02 FILLER PIC X(20) VALUE SQ1544.2 +025200 " COPYRIGHT 1985,1986". SQ1544.2 +025300 01 CCVS-E-4. SQ1544.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1544.2 +025500 02 FILLER PIC X(4) VALUE " OF ". SQ1544.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1544.2 +025700 02 FILLER PIC X(40) VALUE SQ1544.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1544.2 +025900 01 XXINFO. SQ1544.2 +026000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1544.2 +026100 02 INFO-TEXT. SQ1544.2 +026200 04 FILLER PIC X(8) VALUE SPACE. SQ1544.2 +026300 04 XXCOMPUTED PIC X(20). SQ1544.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ1544.2 +026500 04 XXCORRECT PIC X(20). SQ1544.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). SQ1544.2 +026700 01 HYPHEN-LINE. SQ1544.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. SQ1544.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************SQ1544.2 +027000- "*****************************************". SQ1544.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************SQ1544.2 +027200- "******************************". SQ1544.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE SQ1544.2 +027400 "SQ154A". SQ1544.2 +027500* SQ1544.2 +027600 PROCEDURE DIVISION. SQ1544.2 +027700 CCVS1 SECTION. SQ1544.2 +027800 OPEN-FILES. SQ1544.2 +027900 OPEN OUTPUT PRINT-FILE. SQ1544.2 +028000 MOVE CCVS-PGM-ID TO TEST-ID. SQ1544.2 +028100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1544.2 +028200 MOVE SPACE TO TEST-RESULTS. SQ1544.2 +028300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1544.2 +028400 MOVE ZERO TO REC-SKEL-SUB. SQ1544.2 +028500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1544.2 +028600 GO TO CCVS1-EXIT. SQ1544.2 +028700* SQ1544.2 +028800 CCVS-INIT-FILE. SQ1544.2 +028900 ADD 1 TO REC-SKL-SUB. SQ1544.2 +029000 MOVE FILE-RECORD-INFO-SKELETON TO SQ1544.2 +029100 FILE-RECORD-INFO (REC-SKL-SUB). SQ1544.2 +029200* SQ1544.2 +029300 CLOSE-FILES. SQ1544.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1544.2 +029500 CLOSE PRINT-FILE. SQ1544.2 +029600 TERMINATE-CCVS. SQ1544.2 +029700 STOP RUN. SQ1544.2 +029800* SQ1544.2 +029900 INSPT. SQ1544.2 +030000 MOVE "INSPT" TO P-OR-F. SQ1544.2 +030100 ADD 1 TO INSPECT-COUNTER. SQ1544.2 +030200 PERFORM PRINT-DETAIL. SQ1544.2 +030300 SQ1544.2 +030400 PASS. SQ1544.2 +030500 MOVE "PASS " TO P-OR-F. SQ1544.2 +030600 ADD 1 TO PASS-COUNTER. SQ1544.2 +030700 PERFORM PRINT-DETAIL. SQ1544.2 +030800* SQ1544.2 +030900 FAIL. SQ1544.2 +031000 MOVE "FAIL*" TO P-OR-F. SQ1544.2 +031100 ADD 1 TO ERROR-COUNTER. SQ1544.2 +031200 PERFORM PRINT-DETAIL. SQ1544.2 +031300* SQ1544.2 +031400 DE-LETE. SQ1544.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ1544.2 +031600 MOVE "*****" TO P-OR-F. SQ1544.2 +031700 ADD 1 TO DELETE-COUNTER. SQ1544.2 +031800 PERFORM PRINT-DETAIL. SQ1544.2 +031900* SQ1544.2 +032000 PRINT-DETAIL. SQ1544.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ1544.2 +032200 MOVE "." TO PARDOT-X SQ1544.2 +032300 MOVE REC-CT TO DOTVALUE. SQ1544.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. SQ1544.2 +032500 PERFORM WRITE-LINE. SQ1544.2 +032600 IF P-OR-F EQUAL TO "FAIL*" SQ1544.2 +032700 PERFORM WRITE-LINE SQ1544.2 +032800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1544.2 +032900 ELSE SQ1544.2 +033000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1544.2 +033100 MOVE SPACE TO P-OR-F. SQ1544.2 +033200 MOVE SPACE TO COMPUTED-X. SQ1544.2 +033300 MOVE SPACE TO CORRECT-X. SQ1544.2 +033400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1544.2 +033500 MOVE SPACE TO RE-MARK. SQ1544.2 +033600* SQ1544.2 +033700 HEAD-ROUTINE. SQ1544.2 +033800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +033900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +034000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1544.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1544.2 +034200 COLUMN-NAMES-ROUTINE. SQ1544.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1544.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1544.2 +034600 END-ROUTINE. SQ1544.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1544.2 +034800 PERFORM WRITE-LINE 5 TIMES. SQ1544.2 +034900 END-RTN-EXIT. SQ1544.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1544.2 +035100 PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +035200* SQ1544.2 +035300 END-ROUTINE-1. SQ1544.2 +035400 ADD ERROR-COUNTER TO ERROR-HOLD SQ1544.2 +035500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1544.2 +035600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1544.2 +035700 ADD PASS-COUNTER TO ERROR-HOLD. SQ1544.2 +035800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1544.2 +035900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1544.2 +036000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1544.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1544.2 +036200 PERFORM WRITE-LINE. SQ1544.2 +036300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1544.2 +036400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1544.2 +036500 MOVE "NO " TO ERROR-TOTAL SQ1544.2 +036600 ELSE SQ1544.2 +036700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1544.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1544.2 +036900 PERFORM WRITE-LINE. SQ1544.2 +037000 END-ROUTINE-13. SQ1544.2 +037100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1544.2 +037200 MOVE "NO " TO ERROR-TOTAL SQ1544.2 +037300 ELSE SQ1544.2 +037400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1544.2 +037500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1544.2 +037600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1544.2 +037700 PERFORM WRITE-LINE. SQ1544.2 +037800 IF INSPECT-COUNTER EQUAL TO ZERO SQ1544.2 +037900 MOVE "NO " TO ERROR-TOTAL SQ1544.2 +038000 ELSE SQ1544.2 +038100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1544.2 +038200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1544.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1544.2 +038400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1544.2 +038500* SQ1544.2 +038600 WRITE-LINE. SQ1544.2 +038700 ADD 1 TO RECORD-COUNT. SQ1544.2 +038800 IF RECORD-COUNT GREATER 50 SQ1544.2 +038900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1544.2 +039000 MOVE SPACE TO DUMMY-RECORD SQ1544.2 +039100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1544.2 +039200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1544.2 +039300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1544.2 +039400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1544.2 +039500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1544.2 +039600 MOVE ZERO TO RECORD-COUNT. SQ1544.2 +039700 PERFORM WRT-LN. SQ1544.2 +039800* SQ1544.2 +039900 WRT-LN. SQ1544.2 +040000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1544.2 +040100 MOVE SPACE TO DUMMY-RECORD. SQ1544.2 +040200 BLANK-LINE-PRINT. SQ1544.2 +040300 PERFORM WRT-LN. SQ1544.2 +040400 FAIL-ROUTINE. SQ1544.2 +040500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1544.2 +040600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1544.2 +040700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1544.2 +040800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1544.2 +040900 MOVE XXINFO TO DUMMY-RECORD. SQ1544.2 +041000 PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +041100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1544.2 +041200 GO TO FAIL-ROUTINE-EX. SQ1544.2 +041300 FAIL-ROUTINE-WRITE. SQ1544.2 +041400 MOVE TEST-COMPUTED TO PRINT-REC SQ1544.2 +041500 PERFORM WRITE-LINE SQ1544.2 +041600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1544.2 +041700 MOVE TEST-CORRECT TO PRINT-REC SQ1544.2 +041800 PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +041900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1544.2 +042000 FAIL-ROUTINE-EX. SQ1544.2 +042100 EXIT. SQ1544.2 +042200 BAIL-OUT. SQ1544.2 +042300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1544.2 +042400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1544.2 +042500 BAIL-OUT-WRITE. SQ1544.2 +042600 MOVE CORRECT-A TO XXCORRECT. SQ1544.2 +042700 MOVE COMPUTED-A TO XXCOMPUTED. SQ1544.2 +042800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1544.2 +042900 MOVE XXINFO TO DUMMY-RECORD. SQ1544.2 +043000 PERFORM WRITE-LINE 2 TIMES. SQ1544.2 +043100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1544.2 +043200 BAIL-OUT-EX. SQ1544.2 +043300 EXIT. SQ1544.2 +043400 CCVS1-EXIT. SQ1544.2 +043500 EXIT. SQ1544.2 +043600* SQ1544.2 +043700**************************************************************** SQ1544.2 +043800* * SQ1544.2 +043900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1544.2 +044000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1544.2 +044100* * SQ1544.2 +044200**************************************************************** SQ1544.2 +044300* SQ1544.2 +044400 SECT-SQ154A-0001 SECTION. SQ1544.2 +044500 WRITE-INIT-GF-01. SQ1544.2 +044600* SQ1544.2 +044700* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1544.2 +044800* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1544.2 +044900* SQ1544.2 +045000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1544.2 +045100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1544.2 +045200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1544.2 +045300 MOVE 120 TO XRECORD-LENGTH (1). SQ1544.2 +045400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1544.2 +045500 MOVE 1 TO XBLOCK-SIZE (1). SQ1544.2 +045600 MOVE 1 TO RECORDS-IN-FILE (1). SQ1544.2 +045700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1544.2 +045800 MOVE "S" TO XLABEL-TYPE (1). SQ1544.2 +045900 MOVE 1 TO XRECORD-NUMBER (1). SQ1544.2 +046000* SQ1544.2 +046100 WRITE-OPEN-01. SQ1544.2 +046200 OPEN OUTPUT SQ-FS1. SQ1544.2 +046300* SQ1544.2 +046400* WRITE A SINGLE RECORD TO THE FILE SQ1544.2 +046500* SQ1544.2 +046600 WRITE-TEST-01-01. SQ1544.2 +046700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1544.2 +046800 WRITE SQ-FS1R1-F-G-120. SQ1544.2 +046900* SQ1544.2 +047000* CLOSE THE FILE. SQ1544.2 +047100* SQ1544.2 +047200 CLOSE-INIT-01. SQ1544.2 +047300 CLOSE-TEST-01. SQ1544.2 +047400 CLOSE SQ-FS1. SQ1544.2 +047500* SQ1544.2 +047600 WRITE-INIT-01. SQ1544.2 +047700* WE WILL NOW ATTEMPT TO WRITE A RECORD TO THE SQ1544.2 +047800* CLOSED FILE. I-O STATUS 48 SHOULD BE GENERATED. SQ1544.2 +047900* SQ1544.2 +048000 MOVE "WRITE TO CLOSED FILE" TO FEATURE. SQ1544.2 +048100 MOVE "**" TO SQ-FS1-STATUS. SQ1544.2 +048200 MOVE "WRITE-TEST-01" TO PAR-NAME. SQ1544.2 +048300 MOVE 1 TO REC-CT. SQ1544.2 +048400 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1544.2 +048500 TO DUMMY-RECORD SQ1544.2 +048600 PERFORM WRITE-LINE 3 TIMES. SQ1544.2 +048700* SQ1544.2 +048800 WRITE-TEST-01. SQ1544.2 +048900 WRITE SQ-FS1R1-F-G-120. SQ1544.2 +049000 IF SQ-FS1-STATUS = "48" SQ1544.2 +049100 PERFORM PASS SQ1544.2 +049200 ELSE SQ1544.2 +049300 MOVE "48" TO CORRECT-A SQ1544.2 +049400 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1544.2 +049500 MOVE "STATUS FOR WRITE TO CLOSED FILE INCORRECT" SQ1544.2 +049600 TO RE-MARK SQ1544.2 +049700 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1544.2 +049800 PERFORM FAIL SQ1544.2 +049900 END-IF. SQ1544.2 +050000* SQ1544.2 +050100 CCVS-EXIT SECTION. SQ1544.2 +050200 CCVS-999999. SQ1544.2 +050300 GO TO CLOSE-FILES. SQ1544.2 diff --git a/tests/cobol85/SQ/SQ155A.CBL b/tests/cobol85/SQ/SQ155A.CBL new file mode 100755 index 00000000..7a58b9f2 --- /dev/null +++ b/tests/cobol85/SQ/SQ155A.CBL @@ -0,0 +1,516 @@ +000100 IDENTIFICATION DIVISION. SQ1554.2 +000200 PROGRAM-ID. SQ1554.2 +000300 SQ155A. SQ1554.2 +000400**************************************************************** SQ1554.2 +000500* * SQ1554.2 +000600* VALIDATION FOR:- * SQ1554.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1554.2 +000800* USING CCVS85 VERSION 3.0. * SQ1554.2 +000900* * SQ1554.2 +001000* CREATION DATE / VALIDATION DATE * SQ1554.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1554.2 +001200* * SQ1554.2 +001300**************************************************************** SQ1554.2 +001400* * SQ1554.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1554.2 +001600* * SQ1554.2 +001700* X-01 SEQUENTIAL TAPE * SQ1554.2 +001800* X-55 SYSTEM PRINTER * SQ1554.2 +001900* X-82 SOURCE-COMPUTER * SQ1554.2 +002000* X-83 OBJECT-COMPUTER * SQ1554.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1554.2 +002200* * SQ1554.2 +002300**************************************************************** SQ1554.2 +002400* * SQ1554.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING TO* SQ1554.2 +002600* A FILE OPEN IN THE INPUT MODE. THE TEST FOR CORRECT I-O * SQ1554.2 +002700* STATUS 48 IS IN THE MAIN LINE CODE, THEREFORE AN ABNORMAL * SQ1554.2 +002800* TERMINATION IS POSSIBLE BEFORE THE TEST OF THE I-O STATUS * SQ1554.2 +002900* CODE IS ACCOMPLISHED. * SQ1554.2 +003000* * SQ1554.2 +003100**************************************************************** SQ1554.2 +003200* SQ1554.2 +003300 ENVIRONMENT DIVISION. SQ1554.2 +003400 CONFIGURATION SECTION. SQ1554.2 +003500 SOURCE-COMPUTER. SQ1554.2 +003600 Linux. SQ1554.2 +003700 OBJECT-COMPUTER. SQ1554.2 +003800 Linux. SQ1554.2 +003900* SQ1554.2 +004000 INPUT-OUTPUT SECTION. SQ1554.2 +004100 FILE-CONTROL. SQ1554.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1554.2 +004300 "report.log". SQ1554.2 +004400* SQ1554.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1554.2 +004600 "XXXXX001" SQ1554.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1554.2 +004800* SQ1554.2 +004900* SQ1554.2 +005000 DATA DIVISION. SQ1554.2 +005100 FILE SECTION. SQ1554.2 +005200 FD PRINT-FILE SQ1554.2 +005300*C LABEL RECORDS SQ1554.2 +005400*C OMITTED SQ1554.2 +005500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1554.2 +005600 . SQ1554.2 +005700 01 PRINT-REC PICTURE X(120). SQ1554.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1554.2 +005900* SQ1554.2 +006000 FD SQ-FS1 SQ1554.2 +006100*C LABEL RECORD IS STANDARD SQ1554.2 +006200 . SQ1554.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1554.2 +006400* SQ1554.2 +006500 WORKING-STORAGE SECTION. SQ1554.2 +006600* SQ1554.2 +006700*************************************************************** SQ1554.2 +006800* * SQ1554.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1554.2 +007000* * SQ1554.2 +007100*************************************************************** SQ1554.2 +007200* SQ1554.2 +007300 01 SQ-FS1-STATUS. SQ1554.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1554.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1554.2 +007600* SQ1554.2 +007700*************************************************************** SQ1554.2 +007800* * SQ1554.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1554.2 +008000* * SQ1554.2 +008100*************************************************************** SQ1554.2 +008200* SQ1554.2 +008300 01 REC-SKEL-SUB PIC 99. SQ1554.2 +008400* SQ1554.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ1554.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ1554.2 +008700 05 FILLER PICTURE X(48) VALUE SQ1554.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1554.2 +008900 05 FILLER PICTURE X(46) VALUE SQ1554.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1554.2 +009100 05 FILLER PICTURE X(26) VALUE SQ1554.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ1554.2 +009300 05 FILLER PICTURE X(37) VALUE SQ1554.2 +009400 ",RECKEY= ". SQ1554.2 +009500 05 FILLER PICTURE X(38) VALUE SQ1554.2 +009600 ",ALTKEY1= ". SQ1554.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1554.2 +009800 ",ALTKEY2= ". SQ1554.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1554.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1554.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ1554.2 +010200 07 FILLER PIC X(5). SQ1554.2 +010300 07 XFILE-NAME PIC X(6). SQ1554.2 +010400 07 FILLER PIC X(8). SQ1554.2 +010500 07 XRECORD-NAME PIC X(6). SQ1554.2 +010600 07 FILLER PIC X(1). SQ1554.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ1554.2 +010800 07 FILLER PIC X(7). SQ1554.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ1554.2 +011000 07 FILLER PIC X(6). SQ1554.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ1554.2 +011200 07 FILLER PIC X(5). SQ1554.2 +011300 07 ODO-NUMBER PIC 9(4). SQ1554.2 +011400 07 FILLER PIC X(5). SQ1554.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ1554.2 +011600 07 FILLER PIC X(7). SQ1554.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ1554.2 +011800 07 FILLER PIC X(7). SQ1554.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ1554.2 +012000 07 FILLER PIC X(1). SQ1554.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ1554.2 +012200 07 FILLER PIC X(6). SQ1554.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ1554.2 +012400 07 FILLER PIC X(5). SQ1554.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ1554.2 +012600 07 FILLER PIC X(6). SQ1554.2 +012700 07 XLABEL-TYPE PIC X(1). SQ1554.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ1554.2 +012900 07 FILLER PIC X(8). SQ1554.2 +013000 07 XRECORD-KEY PIC X(29). SQ1554.2 +013100 07 FILLER PIC X(9). SQ1554.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ1554.2 +013300 07 FILLER PIC X(9). SQ1554.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ1554.2 +013500 07 FILLER PIC X(7). SQ1554.2 +013600* SQ1554.2 +013700 01 TEST-RESULTS. SQ1554.2 +013800 02 FILLER PIC X VALUE SPACE. SQ1554.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ1554.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1554.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1554.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1554.2 +014300 02 PAR-NAME. SQ1554.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1554.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1554.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1554.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ1554.2 +014800 02 RE-MARK PIC X(61). SQ1554.2 +014900 01 TEST-COMPUTED. SQ1554.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ1554.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1554.2 +015200 02 COMPUTED-X. SQ1554.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1554.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1554.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1554.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1554.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1554.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1554.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ1554.2 +016000 04 FILLER PIC X. SQ1554.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ1554.2 +016200 01 TEST-CORRECT. SQ1554.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1554.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1554.2 +016500 02 CORRECT-X. SQ1554.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1554.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1554.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1554.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1554.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1554.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ1554.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ1554.2 +017300 04 FILLER PIC X. SQ1554.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ1554.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1554.2 +017600 01 CCVS-C-1. SQ1554.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1554.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1554.2 +017900- "SS PARAGRAPH-NAME SQ1554.2 +018000- " REMARKS". SQ1554.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ1554.2 +018200 01 CCVS-C-2. SQ1554.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ1554.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ1554.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ1554.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ1554.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ1554.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1554.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ1554.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1554.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1554.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1554.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1554.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1554.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1554.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1554.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1554.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1554.2 +019900 01 CCVS-H-1. SQ1554.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ1554.2 +020100 02 FILLER PIC X(42) VALUE SQ1554.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1554.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ1554.2 +020400 01 CCVS-H-2A. SQ1554.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ1554.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1554.2 +020700 02 FILLER PIC XXXX VALUE SQ1554.2 +020800 "4.2 ". SQ1554.2 +020900 02 FILLER PIC X(28) VALUE SQ1554.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ1554.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ1554.2 +021200* SQ1554.2 +021300 01 CCVS-H-2B. SQ1554.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1554.2 +021500 02 TEST-ID PIC X(9). SQ1554.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ1554.2 +021700 02 FILLER PIC X(12) VALUE SQ1554.2 +021800 " HIGH ". SQ1554.2 +021900 02 FILLER PIC X(22) VALUE SQ1554.2 +022000 " LEVEL VALIDATION FOR ". SQ1554.2 +022100 02 FILLER PIC X(58) VALUE SQ1554.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1554.2 +022300 01 CCVS-H-3. SQ1554.2 +022400 02 FILLER PIC X(34) VALUE SQ1554.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1554.2 +022600 02 FILLER PIC X(58) VALUE SQ1554.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1554.2 +022800 02 FILLER PIC X(28) VALUE SQ1554.2 +022900 " COPYRIGHT 1985,1986 ". SQ1554.2 +023000 01 CCVS-E-1. SQ1554.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ1554.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1554.2 +023300 02 ID-AGAIN PIC X(9). SQ1554.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ1554.2 +023500 01 CCVS-E-2. SQ1554.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ1554.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ1554.2 +023800 02 CCVS-E-2-2. SQ1554.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1554.2 +024000 03 FILLER PIC X VALUE SPACE. SQ1554.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ1554.2 +024200 "ERRORS ENCOUNTERED". SQ1554.2 +024300 01 CCVS-E-3. SQ1554.2 +024400 02 FILLER PIC X(22) VALUE SQ1554.2 +024500 " FOR OFFICIAL USE ONLY". SQ1554.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ1554.2 +024700 02 FILLER PIC X(58) VALUE SQ1554.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1554.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ1554.2 +025000 02 FILLER PIC X(20) VALUE SQ1554.2 +025100 " COPYRIGHT 1985,1986". SQ1554.2 +025200 01 CCVS-E-4. SQ1554.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1554.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ1554.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1554.2 +025600 02 FILLER PIC X(40) VALUE SQ1554.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1554.2 +025800 01 XXINFO. SQ1554.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1554.2 +026000 02 INFO-TEXT. SQ1554.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ1554.2 +026200 04 XXCOMPUTED PIC X(20). SQ1554.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1554.2 +026400 04 XXCORRECT PIC X(20). SQ1554.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ1554.2 +026600 01 HYPHEN-LINE. SQ1554.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ1554.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1554.2 +026900- "*****************************************". SQ1554.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1554.2 +027100- "******************************". SQ1554.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1554.2 +027300 "SQ155A". SQ1554.2 +027400* SQ1554.2 +027500 PROCEDURE DIVISION. SQ1554.2 +027600 CCVS1 SECTION. SQ1554.2 +027700 OPEN-FILES. SQ1554.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1554.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1554.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1554.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ1554.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1554.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ1554.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1554.2 +028500 GO TO CCVS1-EXIT. SQ1554.2 +028600* SQ1554.2 +028700 CCVS-INIT-FILE. SQ1554.2 +028800 ADD 1 TO REC-SKL-SUB. SQ1554.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1554.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1554.2 +029100* SQ1554.2 +029200 CLOSE-FILES. SQ1554.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1554.2 +029400 CLOSE PRINT-FILE. SQ1554.2 +029500 TERMINATE-CCVS. SQ1554.2 +029600 STOP RUN. SQ1554.2 +029700* SQ1554.2 +029800 INSPT. SQ1554.2 +029900 MOVE "INSPT" TO P-OR-F. SQ1554.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ1554.2 +030100 PERFORM PRINT-DETAIL. SQ1554.2 +030200 SQ1554.2 +030300 PASS. SQ1554.2 +030400 MOVE "PASS " TO P-OR-F. SQ1554.2 +030500 ADD 1 TO PASS-COUNTER. SQ1554.2 +030600 PERFORM PRINT-DETAIL. SQ1554.2 +030700* SQ1554.2 +030800 FAIL. SQ1554.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ1554.2 +031000 ADD 1 TO ERROR-COUNTER. SQ1554.2 +031100 PERFORM PRINT-DETAIL. SQ1554.2 +031200* SQ1554.2 +031300 DE-LETE. SQ1554.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1554.2 +031500 MOVE "*****" TO P-OR-F. SQ1554.2 +031600 ADD 1 TO DELETE-COUNTER. SQ1554.2 +031700 PERFORM PRINT-DETAIL. SQ1554.2 +031800* SQ1554.2 +031900 PRINT-DETAIL. SQ1554.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1554.2 +032100 MOVE "." TO PARDOT-X SQ1554.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1554.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ1554.2 +032400 PERFORM WRITE-LINE. SQ1554.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ1554.2 +032600 PERFORM WRITE-LINE SQ1554.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1554.2 +032800 ELSE SQ1554.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1554.2 +033000 MOVE SPACE TO P-OR-F. SQ1554.2 +033100 MOVE SPACE TO COMPUTED-X. SQ1554.2 +033200 MOVE SPACE TO CORRECT-X. SQ1554.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1554.2 +033400 MOVE SPACE TO RE-MARK. SQ1554.2 +033500* SQ1554.2 +033600 HEAD-ROUTINE. SQ1554.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1554.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1554.2 +034100 COLUMN-NAMES-ROUTINE. SQ1554.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1554.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1554.2 +034500 END-ROUTINE. SQ1554.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1554.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ1554.2 +034800 END-RTN-EXIT. SQ1554.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1554.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +035100* SQ1554.2 +035200 END-ROUTINE-1. SQ1554.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1554.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1554.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1554.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1554.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1554.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1554.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1554.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1554.2 +036100 PERFORM WRITE-LINE. SQ1554.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1554.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1554.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ1554.2 +036500 ELSE SQ1554.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1554.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1554.2 +036800 PERFORM WRITE-LINE. SQ1554.2 +036900 END-ROUTINE-13. SQ1554.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1554.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ1554.2 +037200 ELSE SQ1554.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1554.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1554.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1554.2 +037600 PERFORM WRITE-LINE. SQ1554.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1554.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1554.2 +037900 ELSE SQ1554.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1554.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1554.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1554.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1554.2 +038400* SQ1554.2 +038500 WRITE-LINE. SQ1554.2 +038600 ADD 1 TO RECORD-COUNT. SQ1554.2 +038700 IF RECORD-COUNT GREATER 50 SQ1554.2 +038800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1554.2 +038900 MOVE SPACE TO DUMMY-RECORD SQ1554.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1554.2 +039100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1554.2 +039200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1554.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1554.2 +039400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1554.2 +039500 MOVE ZERO TO RECORD-COUNT. SQ1554.2 +039600 PERFORM WRT-LN. SQ1554.2 +039700* SQ1554.2 +039800 WRT-LN. SQ1554.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1554.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ1554.2 +040100 BLANK-LINE-PRINT. SQ1554.2 +040200 PERFORM WRT-LN. SQ1554.2 +040300 FAIL-ROUTINE. SQ1554.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1554.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1554.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1554.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1554.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ1554.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1554.2 +041100 GO TO FAIL-ROUTINE-EX. SQ1554.2 +041200 FAIL-ROUTINE-WRITE. SQ1554.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ1554.2 +041400 PERFORM WRITE-LINE SQ1554.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1554.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ1554.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1554.2 +041900 FAIL-ROUTINE-EX. SQ1554.2 +042000 EXIT. SQ1554.2 +042100 BAIL-OUT. SQ1554.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1554.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1554.2 +042400 BAIL-OUT-WRITE. SQ1554.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ1554.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1554.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1554.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1554.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ1554.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1554.2 +043100 BAIL-OUT-EX. SQ1554.2 +043200 EXIT. SQ1554.2 +043300 CCVS1-EXIT. SQ1554.2 +043400 EXIT. SQ1554.2 +043500* SQ1554.2 +043600**************************************************************** SQ1554.2 +043700* * SQ1554.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1554.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1554.2 +044000* * SQ1554.2 +044100**************************************************************** SQ1554.2 +044200* SQ1554.2 +044300 SECT-SQ155A-0001 SECTION. SQ1554.2 +044400 WRITE-INIT-GF-01. SQ1554.2 +044500* SQ1554.2 +044600* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1554.2 +044700* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1554.2 +044800* SQ1554.2 +044900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1554.2 +045000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1554.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1554.2 +045200 MOVE 120 TO XRECORD-LENGTH (1). SQ1554.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1554.2 +045400 MOVE 1 TO XBLOCK-SIZE (1). SQ1554.2 +045500 MOVE 1 TO RECORDS-IN-FILE (1). SQ1554.2 +045600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1554.2 +045700 MOVE "S" TO XLABEL-TYPE (1). SQ1554.2 +045800 MOVE 1 TO XRECORD-NUMBER (1). SQ1554.2 +045900* SQ1554.2 +046000 WRITE-OPEN-01. SQ1554.2 +046100 OPEN OUTPUT SQ-FS1. SQ1554.2 +046200* SQ1554.2 +046300* WRITE A SINGLE RECORD TO THE FILE SQ1554.2 +046400* SQ1554.2 +046500 WRITE-TEST-01-01. SQ1554.2 +046600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1554.2 +046700 WRITE SQ-FS1R1-F-G-120. SQ1554.2 +046800* SQ1554.2 +046900* CLOSE THE FILE. SQ1554.2 +047000* SQ1554.2 +047100 CLOSE-INIT-01. SQ1554.2 +047200 CLOSE-TEST-01. SQ1554.2 +047300 CLOSE SQ-FS1. SQ1554.2 +047400* SQ1554.2 +047500 OPEN-INIT-01. SQ1554.2 +047600* SQ1554.2 +047700 OPEN-TEST-01. SQ1554.2 +047800 OPEN INPUT SQ-FS1. SQ1554.2 +047900* SQ1554.2 +048000 WRITE-INIT-01. SQ1554.2 +048100* SQ1554.2 +048200* HAVING REOPENED THE FILE JUST CREATED IN THE INPUT MODE, SQ1554.2 +048300* WE WILL NOW ATTEMPT TO WRITE ANOTHER RECORD TO THE FILE. SQ1554.2 +048400* I-O STATUS CODE 48 SHOULD BE GENERATED. SQ1554.2 +048500* SQ1554.2 +048600 MOVE "WRITE TO INPUT FILE" TO FEATURE. SQ1554.2 +048700 MOVE "**" TO SQ-FS1-STATUS. SQ1554.2 +048800 MOVE "WRITE-TEST-01" TO PAR-NAME. SQ1554.2 +048900 MOVE 1 TO REC-CT. SQ1554.2 +049000 MOVE 2 TO XRECORD-NUMBER (1). SQ1554.2 +049100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1554.2 +049200 TO DUMMY-RECORD. SQ1554.2 +049300 PERFORM WRITE-LINE 3 TIMES. SQ1554.2 +049400* SQ1554.2 +049500 WRITE-TEST-01. SQ1554.2 +049600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1554.2 +049700 WRITE SQ-FS1R1-F-G-120. SQ1554.2 +049800 IF SQ-FS1-STATUS = "48" SQ1554.2 +049900 PERFORM PASS SQ1554.2 +050000 ELSE SQ1554.2 +050100 MOVE "48" TO CORRECT-A SQ1554.2 +050200 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1554.2 +050300 MOVE "STATUS FOR WRITE TO INPUT FILE INCORRECT" SQ1554.2 +050400 TO RE-MARK SQ1554.2 +050500 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1554.2 +050600 PERFORM FAIL SQ1554.2 +050700 END-IF. SQ1554.2 +050800* SQ1554.2 +050900 CLOSE-INIT-02. SQ1554.2 +051000* SQ1554.2 +051100 CLOSE-TEST-02. SQ1554.2 +051200 CLOSE SQ-FS1. SQ1554.2 +051300* SQ1554.2 +051400 CCVS-EXIT SECTION. SQ1554.2 +051500 CCVS-999999. SQ1554.2 +051600 GO TO CLOSE-FILES. SQ1554.2 diff --git a/tests/cobol85/SQ/SQ156A.CBL b/tests/cobol85/SQ/SQ156A.CBL new file mode 100755 index 00000000..51be7690 --- /dev/null +++ b/tests/cobol85/SQ/SQ156A.CBL @@ -0,0 +1,516 @@ +000100 IDENTIFICATION DIVISION. SQ1564.2 +000200 PROGRAM-ID. SQ1564.2 +000300 SQ156A. SQ1564.2 +000400**************************************************************** SQ1564.2 +000500* * SQ1564.2 +000600* VALIDATION FOR:- * SQ1564.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1564.2 +000800* USING CCVS85 VERSION 3.0. * SQ1564.2 +000900* * SQ1564.2 +001000* CREATION DATE / VALIDATION DATE * SQ1564.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1564.2 +001200* * SQ1564.2 +001300**************************************************************** SQ1564.2 +001400* * SQ1564.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1564.2 +001600* * SQ1564.2 +001700* X-14 SEQUENTIAL MASS STORAGE FILE * SQ1564.2 +001800* X-55 SYSTEM PRINTER * SQ1564.2 +001900* X-82 SOURCE-COMPUTER * SQ1564.2 +002000* X-83 OBJECT-COMPUTER * SQ1564.2 +002100* X-84 LABEL RECORDS OPTION. * SQ1564.2 +002200* * SQ1564.2 +002300**************************************************************** SQ1564.2 +002400* * SQ1564.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO WRITING TO* SQ1564.2 +002600* A FILE OPEN IN THE I-O MODE. THE TEST FOR CORRECT I-O * SQ1564.2 +002700* STATUS 48 IS IN THE MAIN LINE CODE, THEREFORE AN ABNORMAL * SQ1564.2 +002800* TERMINATION IS POSSIBLE BEFORE THE TEST OF THE I-O STATUS * SQ1564.2 +002900* CODE IS ACCOMPLISHED. * SQ1564.2 +003000* * SQ1564.2 +003100**************************************************************** SQ1564.2 +003200* SQ1564.2 +003300 ENVIRONMENT DIVISION. SQ1564.2 +003400 CONFIGURATION SECTION. SQ1564.2 +003500 SOURCE-COMPUTER. SQ1564.2 +003600 Linux. SQ1564.2 +003700 OBJECT-COMPUTER. SQ1564.2 +003800 Linux. SQ1564.2 +003900* SQ1564.2 +004000 INPUT-OUTPUT SECTION. SQ1564.2 +004100 FILE-CONTROL. SQ1564.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ1564.2 +004300 "report.log". SQ1564.2 +004400* SQ1564.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ1564.2 +004600 "XXXXX014" SQ1564.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ1564.2 +004800* SQ1564.2 +004900* SQ1564.2 +005000 DATA DIVISION. SQ1564.2 +005100 FILE SECTION. SQ1564.2 +005200 FD PRINT-FILE SQ1564.2 +005300*C LABEL RECORDS SQ1564.2 +005400*C OMITTED SQ1564.2 +005500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1564.2 +005600 . SQ1564.2 +005700 01 PRINT-REC PICTURE X(120). SQ1564.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ1564.2 +005900* SQ1564.2 +006000 FD SQ-FS1 SQ1564.2 +006100*C LABEL RECORD IS STANDARD SQ1564.2 +006200 . SQ1564.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1564.2 +006400* SQ1564.2 +006500 WORKING-STORAGE SECTION. SQ1564.2 +006600* SQ1564.2 +006700*************************************************************** SQ1564.2 +006800* * SQ1564.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1564.2 +007000* * SQ1564.2 +007100*************************************************************** SQ1564.2 +007200* SQ1564.2 +007300 01 SQ-FS1-STATUS. SQ1564.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ1564.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ1564.2 +007600* SQ1564.2 +007700*************************************************************** SQ1564.2 +007800* * SQ1564.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1564.2 +008000* * SQ1564.2 +008100*************************************************************** SQ1564.2 +008200* SQ1564.2 +008300 01 REC-SKEL-SUB PIC 99. SQ1564.2 +008400* SQ1564.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ1564.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ1564.2 +008700 05 FILLER PICTURE X(48) VALUE SQ1564.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1564.2 +008900 05 FILLER PICTURE X(46) VALUE SQ1564.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1564.2 +009100 05 FILLER PICTURE X(26) VALUE SQ1564.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ1564.2 +009300 05 FILLER PICTURE X(37) VALUE SQ1564.2 +009400 ",RECKEY= ". SQ1564.2 +009500 05 FILLER PICTURE X(38) VALUE SQ1564.2 +009600 ",ALTKEY1= ". SQ1564.2 +009700 05 FILLER PICTURE X(38) VALUE SQ1564.2 +009800 ",ALTKEY2= ". SQ1564.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ1564.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1564.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ1564.2 +010200 07 FILLER PIC X(5). SQ1564.2 +010300 07 XFILE-NAME PIC X(6). SQ1564.2 +010400 07 FILLER PIC X(8). SQ1564.2 +010500 07 XRECORD-NAME PIC X(6). SQ1564.2 +010600 07 FILLER PIC X(1). SQ1564.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ1564.2 +010800 07 FILLER PIC X(7). SQ1564.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ1564.2 +011000 07 FILLER PIC X(6). SQ1564.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ1564.2 +011200 07 FILLER PIC X(5). SQ1564.2 +011300 07 ODO-NUMBER PIC 9(4). SQ1564.2 +011400 07 FILLER PIC X(5). SQ1564.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ1564.2 +011600 07 FILLER PIC X(7). SQ1564.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ1564.2 +011800 07 FILLER PIC X(7). SQ1564.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ1564.2 +012000 07 FILLER PIC X(1). SQ1564.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ1564.2 +012200 07 FILLER PIC X(6). SQ1564.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ1564.2 +012400 07 FILLER PIC X(5). SQ1564.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ1564.2 +012600 07 FILLER PIC X(6). SQ1564.2 +012700 07 XLABEL-TYPE PIC X(1). SQ1564.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ1564.2 +012900 07 FILLER PIC X(8). SQ1564.2 +013000 07 XRECORD-KEY PIC X(29). SQ1564.2 +013100 07 FILLER PIC X(9). SQ1564.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ1564.2 +013300 07 FILLER PIC X(9). SQ1564.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ1564.2 +013500 07 FILLER PIC X(7). SQ1564.2 +013600* SQ1564.2 +013700 01 TEST-RESULTS. SQ1564.2 +013800 02 FILLER PIC X VALUE SPACE. SQ1564.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ1564.2 +014000 02 FILLER PIC X VALUE SPACE. SQ1564.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ1564.2 +014200 02 FILLER PIC X VALUE SPACE. SQ1564.2 +014300 02 PAR-NAME. SQ1564.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ1564.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ1564.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ1564.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ1564.2 +014800 02 RE-MARK PIC X(61). SQ1564.2 +014900 01 TEST-COMPUTED. SQ1564.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ1564.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1564.2 +015200 02 COMPUTED-X. SQ1564.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1564.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1564.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1564.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1564.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1564.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ1564.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ1564.2 +016000 04 FILLER PIC X. SQ1564.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ1564.2 +016200 01 TEST-CORRECT. SQ1564.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ1564.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1564.2 +016500 02 CORRECT-X. SQ1564.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1564.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1564.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1564.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1564.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1564.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ1564.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ1564.2 +017300 04 FILLER PIC X. SQ1564.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ1564.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1564.2 +017600 01 CCVS-C-1. SQ1564.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ1564.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ1564.2 +017900- "SS PARAGRAPH-NAME SQ1564.2 +018000- " REMARKS". SQ1564.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ1564.2 +018200 01 CCVS-C-2. SQ1564.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ1564.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ1564.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ1564.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ1564.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ1564.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1564.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ1564.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1564.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1564.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1564.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1564.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1564.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1564.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1564.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1564.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1564.2 +019900 01 CCVS-H-1. SQ1564.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ1564.2 +020100 02 FILLER PIC X(42) VALUE SQ1564.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1564.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ1564.2 +020400 01 CCVS-H-2A. SQ1564.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ1564.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1564.2 +020700 02 FILLER PIC XXXX VALUE SQ1564.2 +020800 "4.2 ". SQ1564.2 +020900 02 FILLER PIC X(28) VALUE SQ1564.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ1564.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ1564.2 +021200* SQ1564.2 +021300 01 CCVS-H-2B. SQ1564.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1564.2 +021500 02 TEST-ID PIC X(9). SQ1564.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ1564.2 +021700 02 FILLER PIC X(12) VALUE SQ1564.2 +021800 " HIGH ". SQ1564.2 +021900 02 FILLER PIC X(22) VALUE SQ1564.2 +022000 " LEVEL VALIDATION FOR ". SQ1564.2 +022100 02 FILLER PIC X(58) VALUE SQ1564.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1564.2 +022300 01 CCVS-H-3. SQ1564.2 +022400 02 FILLER PIC X(34) VALUE SQ1564.2 +022500 " FOR OFFICIAL USE ONLY ". SQ1564.2 +022600 02 FILLER PIC X(58) VALUE SQ1564.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1564.2 +022800 02 FILLER PIC X(28) VALUE SQ1564.2 +022900 " COPYRIGHT 1985,1986 ". SQ1564.2 +023000 01 CCVS-E-1. SQ1564.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ1564.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1564.2 +023300 02 ID-AGAIN PIC X(9). SQ1564.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ1564.2 +023500 01 CCVS-E-2. SQ1564.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ1564.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ1564.2 +023800 02 CCVS-E-2-2. SQ1564.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1564.2 +024000 03 FILLER PIC X VALUE SPACE. SQ1564.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ1564.2 +024200 "ERRORS ENCOUNTERED". SQ1564.2 +024300 01 CCVS-E-3. SQ1564.2 +024400 02 FILLER PIC X(22) VALUE SQ1564.2 +024500 " FOR OFFICIAL USE ONLY". SQ1564.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ1564.2 +024700 02 FILLER PIC X(58) VALUE SQ1564.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1564.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ1564.2 +025000 02 FILLER PIC X(20) VALUE SQ1564.2 +025100 " COPYRIGHT 1985,1986". SQ1564.2 +025200 01 CCVS-E-4. SQ1564.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1564.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ1564.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1564.2 +025600 02 FILLER PIC X(40) VALUE SQ1564.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1564.2 +025800 01 XXINFO. SQ1564.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1564.2 +026000 02 INFO-TEXT. SQ1564.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ1564.2 +026200 04 XXCOMPUTED PIC X(20). SQ1564.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ1564.2 +026400 04 XXCORRECT PIC X(20). SQ1564.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ1564.2 +026600 01 HYPHEN-LINE. SQ1564.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ1564.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ1564.2 +026900- "*****************************************". SQ1564.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ1564.2 +027100- "******************************". SQ1564.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ1564.2 +027300 "SQ156A". SQ1564.2 +027400* SQ1564.2 +027500 PROCEDURE DIVISION. SQ1564.2 +027600 CCVS1 SECTION. SQ1564.2 +027700 OPEN-FILES. SQ1564.2 +027800 OPEN OUTPUT PRINT-FILE. SQ1564.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ1564.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1564.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ1564.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1564.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ1564.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1564.2 +028500 GO TO CCVS1-EXIT. SQ1564.2 +028600* SQ1564.2 +028700 CCVS-INIT-FILE. SQ1564.2 +028800 ADD 1 TO REC-SKL-SUB. SQ1564.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ1564.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ1564.2 +029100* SQ1564.2 +029200 CLOSE-FILES. SQ1564.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1564.2 +029400 CLOSE PRINT-FILE. SQ1564.2 +029500 TERMINATE-CCVS. SQ1564.2 +029600 STOP RUN. SQ1564.2 +029700* SQ1564.2 +029800 INSPT. SQ1564.2 +029900 MOVE "INSPT" TO P-OR-F. SQ1564.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ1564.2 +030100 PERFORM PRINT-DETAIL. SQ1564.2 +030200 SQ1564.2 +030300 PASS. SQ1564.2 +030400 MOVE "PASS " TO P-OR-F. SQ1564.2 +030500 ADD 1 TO PASS-COUNTER. SQ1564.2 +030600 PERFORM PRINT-DETAIL. SQ1564.2 +030700* SQ1564.2 +030800 FAIL. SQ1564.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ1564.2 +031000 ADD 1 TO ERROR-COUNTER. SQ1564.2 +031100 PERFORM PRINT-DETAIL. SQ1564.2 +031200* SQ1564.2 +031300 DE-LETE. SQ1564.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ1564.2 +031500 MOVE "*****" TO P-OR-F. SQ1564.2 +031600 ADD 1 TO DELETE-COUNTER. SQ1564.2 +031700 PERFORM PRINT-DETAIL. SQ1564.2 +031800* SQ1564.2 +031900 PRINT-DETAIL. SQ1564.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ1564.2 +032100 MOVE "." TO PARDOT-X SQ1564.2 +032200 MOVE REC-CT TO DOTVALUE. SQ1564.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ1564.2 +032400 PERFORM WRITE-LINE. SQ1564.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ1564.2 +032600 PERFORM WRITE-LINE SQ1564.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1564.2 +032800 ELSE SQ1564.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1564.2 +033000 MOVE SPACE TO P-OR-F. SQ1564.2 +033100 MOVE SPACE TO COMPUTED-X. SQ1564.2 +033200 MOVE SPACE TO CORRECT-X. SQ1564.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1564.2 +033400 MOVE SPACE TO RE-MARK. SQ1564.2 +033500* SQ1564.2 +033600 HEAD-ROUTINE. SQ1564.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1564.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1564.2 +034100 COLUMN-NAMES-ROUTINE. SQ1564.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1564.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1564.2 +034500 END-ROUTINE. SQ1564.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1564.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ1564.2 +034800 END-RTN-EXIT. SQ1564.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1564.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +035100* SQ1564.2 +035200 END-ROUTINE-1. SQ1564.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ1564.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1564.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1564.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ1564.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1564.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1564.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1564.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1564.2 +036100 PERFORM WRITE-LINE. SQ1564.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1564.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1564.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ1564.2 +036500 ELSE SQ1564.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1564.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1564.2 +036800 PERFORM WRITE-LINE. SQ1564.2 +036900 END-ROUTINE-13. SQ1564.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1564.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ1564.2 +037200 ELSE SQ1564.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1564.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1564.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1564.2 +037600 PERFORM WRITE-LINE. SQ1564.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ1564.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ1564.2 +037900 ELSE SQ1564.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1564.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1564.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1564.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1564.2 +038400* SQ1564.2 +038500 WRITE-LINE. SQ1564.2 +038600 ADD 1 TO RECORD-COUNT. SQ1564.2 +038700 IF RECORD-COUNT GREATER 50 SQ1564.2 +038800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1564.2 +038900 MOVE SPACE TO DUMMY-RECORD SQ1564.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1564.2 +039100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1564.2 +039200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1564.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1564.2 +039400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1564.2 +039500 MOVE ZERO TO RECORD-COUNT. SQ1564.2 +039600 PERFORM WRT-LN. SQ1564.2 +039700* SQ1564.2 +039800 WRT-LN. SQ1564.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1564.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ1564.2 +040100 BLANK-LINE-PRINT. SQ1564.2 +040200 PERFORM WRT-LN. SQ1564.2 +040300 FAIL-ROUTINE. SQ1564.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1564.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1564.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1564.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1564.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ1564.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1564.2 +041100 GO TO FAIL-ROUTINE-EX. SQ1564.2 +041200 FAIL-ROUTINE-WRITE. SQ1564.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ1564.2 +041400 PERFORM WRITE-LINE SQ1564.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1564.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ1564.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1564.2 +041900 FAIL-ROUTINE-EX. SQ1564.2 +042000 EXIT. SQ1564.2 +042100 BAIL-OUT. SQ1564.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1564.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1564.2 +042400 BAIL-OUT-WRITE. SQ1564.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ1564.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ1564.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1564.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ1564.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ1564.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1564.2 +043100 BAIL-OUT-EX. SQ1564.2 +043200 EXIT. SQ1564.2 +043300 CCVS1-EXIT. SQ1564.2 +043400 EXIT. SQ1564.2 +043500* SQ1564.2 +043600**************************************************************** SQ1564.2 +043700* * SQ1564.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1564.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1564.2 +044000* * SQ1564.2 +044100**************************************************************** SQ1564.2 +044200* SQ1564.2 +044300 SECT-SQ156A-0001 SECTION. SQ1564.2 +044400 WRITE-INIT-GF-01. SQ1564.2 +044500* SQ1564.2 +044600* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1564.2 +044700* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1564.2 +044800* SQ1564.2 +044900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1564.2 +045000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1564.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1564.2 +045200 MOVE 120 TO XRECORD-LENGTH (1). SQ1564.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1564.2 +045400 MOVE 1 TO XBLOCK-SIZE (1). SQ1564.2 +045500 MOVE 1 TO RECORDS-IN-FILE (1). SQ1564.2 +045600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1564.2 +045700 MOVE "S" TO XLABEL-TYPE (1). SQ1564.2 +045800 MOVE 1 TO XRECORD-NUMBER (1). SQ1564.2 +045900* SQ1564.2 +046000 WRITE-OPEN-01. SQ1564.2 +046100 OPEN OUTPUT SQ-FS1. SQ1564.2 +046200* SQ1564.2 +046300* WRITE A SINGLE RECORD TO THE FILE SQ1564.2 +046400* SQ1564.2 +046500 WRITE-TEST-01-01. SQ1564.2 +046600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1564.2 +046700 WRITE SQ-FS1R1-F-G-120. SQ1564.2 +046800* SQ1564.2 +046900* CLOSE THE FILE. SQ1564.2 +047000* SQ1564.2 +047100 CLOSE-INIT-01. SQ1564.2 +047200 CLOSE-TEST-01. SQ1564.2 +047300 CLOSE SQ-FS1. SQ1564.2 +047400* SQ1564.2 +047500 OPEN-INIT-01. SQ1564.2 +047600* SQ1564.2 +047700 OPEN-TEST-01. SQ1564.2 +047800 OPEN I-O SQ-FS1. SQ1564.2 +047900* SQ1564.2 +048000 WRITE-INIT-01. SQ1564.2 +048100* SQ1564.2 +048200* HAVING REOPENED THE FILE JUST CREATED IN THE I-O MODE, SQ1564.2 +048300* WE WILL NOW ATTEMPT TO WRITE ANOTHER RECORD TO THE FILE. SQ1564.2 +048400* I-O STATUS CODE 48 SHOULD BE GENERATED. SQ1564.2 +048500* SQ1564.2 +048600 MOVE "WRITE TO I-O FILE" TO FEATURE. SQ1564.2 +048700 MOVE "**" TO SQ-FS1-STATUS. SQ1564.2 +048800 MOVE "WRITE-TEST-01" TO PAR-NAME. SQ1564.2 +048900 MOVE 1 TO REC-CT. SQ1564.2 +049000 MOVE 2 TO XRECORD-NUMBER (1). SQ1564.2 +049100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1564.2 +049200 TO DUMMY-RECORD. SQ1564.2 +049300 PERFORM WRITE-LINE 3 TIMES. SQ1564.2 +049400* SQ1564.2 +049500 WRITE-TEST-01. SQ1564.2 +049600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1564.2 +049700 WRITE SQ-FS1R1-F-G-120. SQ1564.2 +049800 IF SQ-FS1-STATUS = "48" SQ1564.2 +049900 PERFORM PASS SQ1564.2 +050000 ELSE SQ1564.2 +050100 MOVE "48" TO CORRECT-A SQ1564.2 +050200 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1564.2 +050300 MOVE "STATUS FOR WRITE TO I-O FILE INCORRECT" SQ1564.2 +050400 TO RE-MARK SQ1564.2 +050500 MOVE "VII-5, 1.3.5(4)G" TO ANSI-REFERENCE SQ1564.2 +050600 PERFORM FAIL SQ1564.2 +050700 END-IF. SQ1564.2 +050800* SQ1564.2 +050900 CLOSE-INIT-02. SQ1564.2 +051000* SQ1564.2 +051100 CLOSE-TEST-02. SQ1564.2 +051200 CLOSE SQ-FS1. SQ1564.2 +051300* SQ1564.2 +051400 CCVS-EXIT SECTION. SQ1564.2 +051500 CCVS-999999. SQ1564.2 +051600 GO TO CLOSE-FILES. SQ1564.2 diff --git a/tests/cobol85/SQ/SQ201M.CBL b/tests/cobol85/SQ/SQ201M.CBL new file mode 100755 index 00000000..e5e540a2 --- /dev/null +++ b/tests/cobol85/SQ/SQ201M.CBL @@ -0,0 +1,778 @@ +000100 IDENTIFICATION DIVISION. SQ2014.2 +000200 PROGRAM-ID. SQ2014.2 +000300 SQ201M. SQ2014.2 +000400**************************************************************** SQ2014.2 +000500* * SQ2014.2 +000600* VALIDATION FOR:- * SQ2014.2 +000700* " HIGH ". SQ2014.2 +000800* * SQ2014.2 +000900* CREATION DATE / VALIDATION DATE * SQ2014.2 +001000* "4.2 ". SQ2014.2 +001100* * SQ2014.2 +001200* THIS ROUTINE TESTS THE WRITE ... ADVANCIN STATEMENT IN SQ2014.2 +001300* COMBINATION WITH THE SQ2014.2 +001400* NOT AT END-OF-PAGE SQ2014.2 +001500* AND THE SQ2014.2 +001600* END-WRITE CLAUSES. SQ2014.2 +001700* SQ2014.2 +001800* THE ROUTINE SQ201M TESTS THE USE OF THE LEVEL 2 WRITE SQ2014.2 +001900* STATEMENT AND THE LINAGE CLAUSE FOR A FILE DESIGNATED AS SQ2014.2 +002000* PRINTER OUTPUT. THESE STATEMENTS CONTROL THE VERTICAL SQ2014.2 +002100* POSITIONING OF EACH LINE ON A PRINTED PAGE. THE LINAGE SQ2014.2 +002200* CLAUSE SPECIFICALLY CONTROLS THE VERTICAL FORMAT OF A SQ2014.2 +002300* LOGICAL PRINT PAGE. SQ201M TESTS (1) THE ACCURACY OF THE SQ2014.2 +002400* LINAGE-COUNTER, (2) THE WRITE ADVANCING PAGE, AND (3) THE SQ2014.2 +002500* FOUR COMBINATIONS OF THE END-OF-PAGE PHRASE. IT IS ASSUMED SQ2014.2 +002600* THAT ALL LEVEL 2 NUCLEUS OPTIONS ARE AVAILABLE IN TESTING SQ2014.2 +002700* SQ201M. A LINAGE CLAUSE WITH COMPLETE FOOTING, TOP, AND SQ2014.2 +002800* BOTTOM SECTIONS AND UTILIZING INTEGER ITEMS IS USED WITH SQ2014.2 +002900* THIS TEST. SQ2014.2 +003000 ENVIRONMENT DIVISION. SQ2014.2 +003100 CONFIGURATION SECTION. SQ2014.2 +003200 SOURCE-COMPUTER. SQ2014.2 +003300 Linux. SQ2014.2 +003400 OBJECT-COMPUTER. SQ2014.2 +003500 Linux. SQ2014.2 +003600 INPUT-OUTPUT SECTION. SQ2014.2 +003700 FILE-CONTROL. SQ2014.2 +003800*P SELECT RAW-DATA ASSIGN TO SQ2014.2 +003900*P "XXXXX062" SQ2014.2 +004000*P ORGANIZATION IS INDEXED SQ2014.2 +004100*P ACCESS MODE IS RANDOM SQ2014.2 +004200*P RECORD KEY IS RAW-DATA-KEY. SQ2014.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ2014.2 +004400 "report.log". SQ2014.2 +004500 DATA DIVISION. SQ2014.2 +004600 FILE SECTION. SQ2014.2 +004700*P SQ2014.2 +004800*PD RAW-DATA. SQ2014.2 +004900*P SQ2014.2 +005000*P1 RAW-DATA-SATZ. SQ2014.2 +005100*P 05 RAW-DATA-KEY PIC X(6). SQ2014.2 +005200*P 05 C-DATE PIC 9(6). SQ2014.2 +005300*P 05 C-TIME PIC 9(8). SQ2014.2 +005400*P 05 C-NO-OF-TESTS PIC 99. SQ2014.2 +005500*P 05 C-OK PIC 999. SQ2014.2 +005600*P 05 C-ALL PIC 999. SQ2014.2 +005700*P 05 C-FAIL PIC 999. SQ2014.2 +005800*P 05 C-DELETED PIC 999. SQ2014.2 +005900*P 05 C-INSPECT PIC 999. SQ2014.2 +006000*P 05 C-NOTE PIC X(13). SQ2014.2 +006100*P 05 C-INDENT PIC X. SQ2014.2 +006200*P 05 C-ABORT PIC X(8). SQ2014.2 +006300 FD PRINT-FILE SQ2014.2 +006400*C LABEL RECORDS SQ2014.2 +006500*C OMITTED SQ2014.2 +006600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2014.2 +006700 LINAGE IS 50 LINES SQ2014.2 +006800 WITH FOOTING AT 45 SQ2014.2 +006900 LINES AT TOP 10 SQ2014.2 +007000 LINES AT BOTTOM 6. SQ2014.2 +007100 01 PRINT-REC PICTURE X(120). SQ2014.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2014.2 +007300 WORKING-STORAGE SECTION. SQ2014.2 +007400 01 WRITE-SWITCH PIC 9 VALUE 0. SQ2014.2 +007500 01 END-WRITE-SWITCH PIC 9 VALUE 1. SQ2014.2 +007600 01 LC-HOLD PIC 99. SQ2014.2 +007700 01 IDENTIFIER-2 PIC 99. SQ2014.2 +007800 01 TOP-LINE PIC X(120) VALUE "THIS LINE WAS WRITTEN SQ2014.2 +007900- "BY A WRITE ADVANCING PAGE OPERATION. IT SHOULD APPEAR AS THSQ2014.2 +008000- "E FIRST LINE OF A NEW LOGICAL PAGE.". SQ2014.2 +008100 01 DETAIL-LINE. SQ2014.2 +008200 02 FILLER PIC X(20) VALUE SPACE. SQ2014.2 +008300 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2014.2 +008400 02 DETAIL-LINE-NO PIC 999. SQ2014.2 +008500 02 FILLER PIC X(52) VALUE " OF 132 DETAIL LINES.".SQ2014.2 +008600 02 FILLER PIC X(18) VALUE "LINAGE-COUNTER IS ". SQ2014.2 +008700 02 DETAIL-LC PIC 99. SQ2014.2 +008800 02 FILLER PIC X(12) VALUE ".". SQ2014.2 +008900 01 FOOT-LINE. SQ2014.2 +009000 02 FILLER PIC X(20) VALUE SPACE. SQ2014.2 +009100 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2014.2 +009200 02 FOOT-COUNT PIC 999. SQ2014.2 +009300 02 FILLER PIC X(47) VALUE " OF 6 FOOTING LINES. SQ2014.2 +009400- "LINAGE-COUNTER SHOULD BE ". SQ2014.2 +009500 02 FOOT-LINE-NO PIC 99. SQ2014.2 +009600 02 FILLER PIC X(21) VALUE ". LINAGE-COUNTER IS ".SQ2014.2 +009700 02 FOOT-LC PIC 99. SQ2014.2 +009800 02 FILLER PIC X(12) VALUE ".". SQ2014.2 +009900 01 EOP-MESSAGE-1 PIC X(120) VALUE " THIS IS A TESQ2014.2 +010000- "ST FOR THE EOP PHRASE. 50 LINES SHOULD PRINT IN THE PAGE BOSQ2014.2 +010100- "DY INCLUDING 44 DETAIL LINES AND". SQ2014.2 +010200 01 EOP-MESSAGE-2 PIC X(120) VALUE " 6 FOOTING LISQ2014.2 +010300- "NES. THESE LINES SHOULD BE CONSECUTIVE ON ONE LOGICAL PAGE SQ2014.2 +010400- "AND BE FOLLOWED BY 16 TOP AND BOTTOM". SQ2014.2 +010500 01 EOP-MESSAGE-3 PIC X(120) VALUE " BLANK LINES.SQ2014.2 +010600- " THE CORRECT AND COMPUTED LINAGE-COUNTER VALUES IN THE FOOTSQ2014.2 +010700- "ING LINES SHOULD BE EQUAL.". SQ2014.2 +010800 01 TEST-RESULTS. SQ2014.2 +010900 02 FILLER PICTURE X VALUE SPACE. SQ2014.2 +011000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2014.2 +011100 02 FILLER PICTURE X VALUE SPACE. SQ2014.2 +011200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2014.2 +011300 02 FILLER PICTURE X VALUE SPACE. SQ2014.2 +011400 02 PAR-NAME. SQ2014.2 +011500 03 FILLER PICTURE X(12) VALUE SPACE. SQ2014.2 +011600 03 PARDOT-X PICTURE X VALUE SPACE. SQ2014.2 +011700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2014.2 +011800 03 FILLER PIC X(5) VALUE SPACE. SQ2014.2 +011900 02 FILLER PIC X(10) VALUE SPACE. SQ2014.2 +012000 02 RE-MARK PIC X(61). SQ2014.2 +012100 01 TEST-COMPUTED. SQ2014.2 +012200 02 FILLER PIC X(30) VALUE SPACE. SQ2014.2 +012300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2014.2 +012400 02 COMPUTED-X. SQ2014.2 +012500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2014.2 +012600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2014.2 +012700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2014.2 +012800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2014.2 +012900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2014.2 +013000 03 CM-18V0 REDEFINES COMPUTED-A. SQ2014.2 +013100 04 COMPUTED-18V0 PICTURE -9(18). SQ2014.2 +013200 04 FILLER PICTURE X. SQ2014.2 +013300 03 FILLER PIC X(50) VALUE SPACE. SQ2014.2 +013400 01 TEST-CORRECT. SQ2014.2 +013500 02 FILLER PIC X(30) VALUE SPACE. SQ2014.2 +013600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2014.2 +013700 02 CORRECT-X. SQ2014.2 +013800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2014.2 +013900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2014.2 +014000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2014.2 +014100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2014.2 +014200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2014.2 +014300 03 CR-18V0 REDEFINES CORRECT-A. SQ2014.2 +014400 04 CORRECT-18V0 PICTURE -9(18). SQ2014.2 +014500 04 FILLER PICTURE X. SQ2014.2 +014600 03 FILLER PIC X(50) VALUE SPACE. SQ2014.2 +014700 01 CCVS-C-1. SQ2014.2 +014800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2014.2 +014900- "SS PARAGRAPH-NAME SQ2014.2 +015000- " REMARKS". SQ2014.2 +015100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2014.2 +015200 01 CCVS-C-2. SQ2014.2 +015300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2014.2 +015400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2014.2 +015500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2014.2 +015600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2014.2 +015700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2014.2 +015800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2014.2 +015900 01 REC-CT PICTURE 99 VALUE ZERO. SQ2014.2 +016000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2014.2 +016100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2014.2 +016200 01 INSPECT-COUNTER PIC 999 VALUE 11. SQ2014.2 +016300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2014.2 +016400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2014.2 +016500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2014.2 +016600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2014.2 +016700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2014.2 +016800 01 CCVS-H-1. SQ2014.2 +016900 02 FILLER PICTURE X(27) VALUE SPACE. SQ2014.2 +017000 02 FILLER PICTURE X(67) VALUE SQ2014.2 +017100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2014.2 +017200- " SYSTEM". SQ2014.2 +017300 02 FILLER PICTURE X(26) VALUE SPACE. SQ2014.2 +017400 01 CCVS-H-2. SQ2014.2 +017500 02 FILLER PICTURE X(52) VALUE IS SQ2014.2 +017600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2014.2 +017700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2014.2 +017800 02 TEST-ID PICTURE IS X(9). SQ2014.2 +017900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2014.2 +018000 01 CCVS-H-3. SQ2014.2 +018100 02 FILLER PICTURE X(34) VALUE SQ2014.2 +018200 " FOR OFFICIAL USE ONLY ". SQ2014.2 +018300 02 FILLER PICTURE X(58) VALUE SQ2014.2 +018400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2014.2 +018500 02 FILLER PICTURE X(28) VALUE SQ2014.2 +018600 " COPYRIGHT 1985 ". SQ2014.2 +018700 01 CCVS-E-1. SQ2014.2 +018800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2014.2 +018900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2014.2 +019000 02 ID-AGAIN PICTURE IS X(9). SQ2014.2 +019100 02 FILLER PICTURE X(45) VALUE IS SQ2014.2 +019200 " NTIS DISTRIBUTION COBOL 85". SQ2014.2 +019300 01 CCVS-E-2. SQ2014.2 +019400 02 FILLER PICTURE X(31) VALUE SQ2014.2 +019500 SPACE. SQ2014.2 +019600 02 FILLER PICTURE X(21) VALUE SPACE. SQ2014.2 +019700 02 CCVS-E-2-2. SQ2014.2 +019800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2014.2 +019900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2014.2 +020000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2014.2 +020100 01 CCVS-E-3. SQ2014.2 +020200 02 FILLER PICTURE X(22) VALUE SQ2014.2 +020300 " FOR OFFICIAL USE ONLY". SQ2014.2 +020400 02 FILLER PICTURE X(12) VALUE SPACE. SQ2014.2 +020500 02 FILLER PICTURE X(58) VALUE SQ2014.2 +020600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2014.2 +020700 02 FILLER PICTURE X(13) VALUE SPACE. SQ2014.2 +020800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2014.2 +020900 01 CCVS-E-4. SQ2014.2 +021000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2014.2 +021100 02 FILLER PIC XXXX VALUE " OF ". SQ2014.2 +021200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2014.2 +021300 02 FILLER PIC X(40) VALUE SQ2014.2 +021400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2014.2 +021500 01 XXINFO. SQ2014.2 +021600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2014.2 +021700 02 INFO-TEXT. SQ2014.2 +021800 04 FILLER PIC X(20) VALUE SPACE. SQ2014.2 +021900 04 XXCOMPUTED PIC X(20). SQ2014.2 +022000 04 FILLER PIC X(5) VALUE SPACE. SQ2014.2 +022100 04 XXCORRECT PIC X(20). SQ2014.2 +022200 01 HYPHEN-LINE. SQ2014.2 +022300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2014.2 +022400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2014.2 +022500- "*****************************************". SQ2014.2 +022600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2014.2 +022700- "******************************". SQ2014.2 +022800 01 CCVS-PGM-ID PIC X(6) VALUE SQ2014.2 +022900 "SQ201M". SQ2014.2 +023000 PROCEDURE DIVISION. SQ2014.2 +023100 CCVS1 SECTION. SQ2014.2 +023200 OPEN-FILES. SQ2014.2 +023300*P OPEN I-O RAW-DATA. SQ2014.2 +023400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2014.2 +023500*P MOVE "ABORTED " TO C-ABORT. SQ2014.2 +023600*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2014.2 +023700*P MOVE "ABORTED " TO C-ABORT. SQ2014.2 +023800*P ADD 1 TO C-NO-OF-TESTS. SQ2014.2 +023900*P ACCEPT C-DATE FROM DATE. SQ2014.2 +024000*P ACCEPT C-TIME FROM TIME. SQ2014.2 +024100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2014.2 +024200*PND-E-1. SQ2014.2 +024300*P CLOSE RAW-DATA. SQ2014.2 +024400 OPEN OUTPUT PRINT-FILE. SQ2014.2 +024500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2014.2 +024600 MOVE SPACE TO TEST-RESULTS. SQ2014.2 +024700 GO TO CCVS1-EXIT. SQ2014.2 +024800 CLOSE-FILES. SQ2014.2 +024900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2014.2 +025000*P OPEN I-O RAW-DATA. SQ2014.2 +025100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2014.2 +025200*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2014.2 +025300*P MOVE "OK. " TO C-ABORT. SQ2014.2 +025400*P MOVE PASS-COUNTER TO C-OK. SQ2014.2 +025500*P MOVE ERROR-HOLD TO C-ALL. SQ2014.2 +025600*P MOVE ERROR-COUNTER TO C-FAIL. SQ2014.2 +025700*P MOVE DELETE-CNT TO C-DELETED. SQ2014.2 +025800*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2014.2 +025900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2014.2 +026000*PND-E-2. SQ2014.2 +026100*P CLOSE RAW-DATA. SQ2014.2 +026200 TERMINATE-CCVS. SQ2014.2 +026300*S EXIT PROGRAM. SQ2014.2 +026400*SERMINATE-CALL. SQ2014.2 +026500 STOP RUN. SQ2014.2 +026600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2014.2 +026700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2014.2 +026800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2014.2 +026900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2014.2 +027000 MOVE "****TEST DELETED****" TO RE-MARK. SQ2014.2 +027100 PRINT-DETAIL. SQ2014.2 +027200 IF REC-CT NOT EQUAL TO ZERO SQ2014.2 +027300 MOVE "." TO PARDOT-X SQ2014.2 +027400 MOVE REC-CT TO DOTVALUE. SQ2014.2 +027500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2014.2 +027600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2014.2 +027700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2014.2 +027800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2014.2 +027900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2014.2 +028000 MOVE SPACE TO CORRECT-X. SQ2014.2 +028100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2014.2 +028200 MOVE SPACE TO RE-MARK. SQ2014.2 +028300 HEAD-ROUTINE. SQ2014.2 +028400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +028500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2014.2 +028600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2014.2 +028700 COLUMN-NAMES-ROUTINE. SQ2014.2 +028800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +028900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +029000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +029100 END-ROUTINE. SQ2014.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2014.2 +029300 END-RTN-EXIT. SQ2014.2 +029400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +029500 END-ROUTINE-1. SQ2014.2 +029600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2014.2 +029700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2014.2 +029800 ADD PASS-COUNTER TO ERROR-HOLD. SQ2014.2 +029900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2014.2 +030000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2014.2 +030100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2014.2 +030200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2014.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2014.2 +030400 END-ROUTINE-12. SQ2014.2 +030500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2014.2 +030600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2014.2 +030700 MOVE "NO " TO ERROR-TOTAL SQ2014.2 +030800 ELSE SQ2014.2 +030900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2014.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2014.2 +031100 PERFORM WRITE-LINE. SQ2014.2 +031200 END-ROUTINE-13. SQ2014.2 +031300 IF DELETE-CNT IS EQUAL TO ZERO SQ2014.2 +031400 MOVE "NO " TO ERROR-TOTAL ELSE SQ2014.2 +031500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2014.2 +031600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2014.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +031800 IF INSPECT-COUNTER EQUAL TO ZERO SQ2014.2 +031900 MOVE "NO " TO ERROR-TOTAL SQ2014.2 +032000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2014.2 +032100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2014.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +032300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2014.2 +032400 WRITE-LINE. SQ2014.2 +032500 ADD 1 TO RECORD-COUNT. SQ2014.2 +032600 IF RECORD-COUNT GREATER 50 SQ2014.2 +032700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2014.2 +032800 MOVE SPACE TO DUMMY-RECORD SQ2014.2 +032900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2014.2 +033000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2014.2 +033100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2014.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2014.2 +033300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2014.2 +033400 MOVE ZERO TO RECORD-COUNT. SQ2014.2 +033500 PERFORM WRT-LN. SQ2014.2 +033600 WRT-LN. SQ2014.2 +033700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2014.2 +033800 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +033900 BLANK-LINE-PRINT. SQ2014.2 +034000 PERFORM WRT-LN. SQ2014.2 +034100 FAIL-ROUTINE. SQ2014.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2014.2 +034300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2014.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2014.2 +034500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +034600 GO TO FAIL-ROUTINE-EX. SQ2014.2 +034700 FAIL-ROUTINE-WRITE. SQ2014.2 +034800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2014.2 +034900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +035000 FAIL-ROUTINE-EX. EXIT. SQ2014.2 +035100 BAIL-OUT. SQ2014.2 +035200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2014.2 +035300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2014.2 +035400 BAIL-OUT-WRITE. SQ2014.2 +035500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2014.2 +035600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2014.2 +035700 BAIL-OUT-EX. EXIT. SQ2014.2 +035800 CCVS1-EXIT. SQ2014.2 +035900 EXIT. SQ2014.2 +036000 SECT-SQ201M-0001 SECTION. SQ2014.2 +036100 WRT-TEST-001. SQ2014.2 +036200* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +036300* OF AN OPEN COMMAND. IT SHOULD BE EQUAL TO 1. SQ2014.2 +036400 CLOSE PRINT-FILE. SQ2014.2 +036500 OPEN OUTPUT PRINT-FILE. SQ2014.2 +036600 IF LINAGE-COUNTER EQUAL TO 1 SQ2014.2 +036700 PERFORM PASS SQ2014.2 +036800 GO TO WRT-WRITE-001. SQ2014.2 +036900 GO TO WRT-FAIL-001. SQ2014.2 +037000 WRT-DELETE-001. SQ2014.2 +037100 PERFORM DE-LETE. SQ2014.2 +037200 GO TO WRT-WRITE-001. SQ2014.2 +037300 WRT-FAIL-001. SQ2014.2 +037400 MOVE "VII-5 1.3.8; VII-29 D." TO RE-MARK. SQ2014.2 +037500 PERFORM FAIL. SQ2014.2 +037600 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +037700 MOVE 1 TO CORRECT-18V0. SQ2014.2 +037800 WRT-WRITE-001. SQ2014.2 +037900 MOVE "LINAGE-CT AFTER OPEN" TO FEATURE. SQ2014.2 +038000 MOVE "WRT-TEST-01" TO PAR-NAME. SQ2014.2 +038100 MOVE "FILE IS CLOSED, THEN OPENED" TO RE-MARK. SQ2014.2 +038200 PERFORM PRINT-DETAIL. SQ2014.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +038400 WRITE PRINT-REC AFTER ADVANCING 4 LINES. SQ2014.2 +038500 WRT-INIT-GF-001. SQ2014.2 +038600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2014.2 +038700 MOVE "TEST WRT-TEST-01 MUST BE PRINTED BEFORE THE HEADER OF TSQ2014.2 +038800- "HIS LIST" TO PRINT-REC. SQ2014.2 +038900 WRITE PRINT-REC AFTER ADVANCING 4 LINES. SQ2014.2 +039000 MOVE "THIS PROGRAM TESTS THE STATEMENT:" TO PRINT-REC. SQ2014.2 +039100 WRITE PRINT-REC AFTER ADVANCING 4 LINES. SQ2014.2 +039200 MOVE " WRITE ... ADVANCING ... " TO PRINT-REC. SQ2014.2 +039300 WRITE PRINT-REC AFTER ADVANCING 2 LINE. SQ2014.2 +039400 MOVE "THE RULES ARE DESCRIBED ON PAGE VII-52 THROUGH VII-56."SQ2014.2 +039500 TO PRINT-REC. SQ2014.2 +039600 WRITE PRINT-REC AFTER ADVANCING 2 LINE. SQ2014.2 +039700 MOVE "THE LOGICAL PAGE SIZE IS EQUAL TO 66" SQ2014.2 +039800 TO PRINT-REC. SQ2014.2 +039900 WRITE PRINT-REC AFTER ADVANCING 4 LINE. SQ2014.2 +040000 WRT-TEST-002. SQ2014.2 +040100* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +040200* OF A WRITE ADVANCING PAGE OPERATION. SQ2014.2 +040300* IT SHOULD BE EQUAL TO 1. SQ2014.2 +040400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +040500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE. SQ2014.2 +040600 IF LINAGE-COUNTER EQUAL TO 1 SQ2014.2 +040700 PERFORM PASS SQ2014.2 +040800 GO TO WRT-WRITE-002. SQ2014.2 +040900 GO TO WRT-FAIL-002. SQ2014.2 +041000 WRT-DELETE-002. SQ2014.2 +041100 PERFORM DE-LETE. SQ2014.2 +041200 GO TO WRT-WRITE-002. SQ2014.2 +041300 WRT-FAIL-002. SQ2014.2 +041400 MOVE "VII-5 1.3.8; VII-28 C (1)" TO RE-MARK. SQ2014.2 +041500 PERFORM FAIL. SQ2014.2 +041600 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +041700 MOVE 1 TO CORRECT-18V0. SQ2014.2 +041800 WRT-WRITE-002. SQ2014.2 +041900 MOVE "L-C AFTER WRITE PAGE" TO FEATURE. SQ2014.2 +042000 MOVE "WRT-TEST-02" TO PAR-NAME. SQ2014.2 +042100 PERFORM PRINT-DETAIL. SQ2014.2 +042200 WRT-TEST-003. SQ2014.2 +042300* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +042400* OF A WRITE AFTER ADVANCING 1 LINE OPERATION ON WHICHSQ2014.2 +042500* LOGICAL PAGE OVERFLOW OCCURS. IT SHOULD EQUAL 1. SQ2014.2 +042600 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +042700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE. SQ2014.2 +042800 PERFORM BLANK-LINE-PRINT 50 TIMES. SQ2014.2 +042900 IF LINAGE-COUNTER EQUAL TO 1 SQ2014.2 +043000 PERFORM PASS SQ2014.2 +043100 GO TO WRT-WRITE-003. SQ2014.2 +043200 GO TO WRT-FAIL-003. SQ2014.2 +043300 WRT-DELETE-003. SQ2014.2 +043400 PERFORM DE-LETE. SQ2014.2 +043500 GO TO WRT-WRITE-003. SQ2014.2 +043600 WRT-FAIL-003. SQ2014.2 +043700 MOVE "VII-5 1.3.8; VII-29 C 4)" TO RE-MARK. SQ2014.2 +043800 PERFORM FAIL. SQ2014.2 +043900 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +044000 MOVE 1 TO CORRECT-18V0. SQ2014.2 +044100 WRT-WRITE-003. SQ2014.2 +044200 MOVE "L-C AFT PAGE OVERFLW" TO FEATURE. SQ2014.2 +044300 MOVE "WRT-TEST-03" TO PAR-NAME. SQ2014.2 +044400 PERFORM PRINT-DETAIL. SQ2014.2 +044500 WRT-TEST-004. SQ2014.2 +044600* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +044700* OF A WRITE OPERATION WITHOUT AN ADVANCING PHRASE. SQ2014.2 +044800* IT SHOULD BE INCREMENTED BY 1. SQ2014.2 +044900 MOVE LINAGE-COUNTER TO LC-HOLD. SQ2014.2 +045000 ADD 1 TO LC-HOLD. SQ2014.2 +045100 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +045200 WRITE DUMMY-RECORD. SQ2014.2 +045300 IF LC-HOLD EQUAL TO LINAGE-COUNTER SQ2014.2 +045400 PERFORM PASS SQ2014.2 +045500 GO TO WRT-WRITE-004. SQ2014.2 +045600 GO TO WRT-FAIL-004. SQ2014.2 +045700 WRT-DELETE-004. SQ2014.2 +045800 PERFORM DE-LETE. SQ2014.2 +045900 GO TO WRT-WRITE-004. SQ2014.2 +046000 WRT-FAIL-004. SQ2014.2 +046100 MOVE "VII-5 1.3.8; VII-29 C 3)" TO RE-MARK. SQ2014.2 +046200 PERFORM FAIL. SQ2014.2 +046300 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +046400 MOVE LC-HOLD TO CORRECT-18V0. SQ2014.2 +046500 WRT-WRITE-004. SQ2014.2 +046600 MOVE "L-C AFT WRT W/O ADV" TO FEATURE. SQ2014.2 +046700 MOVE "WRT-TEST-04" TO PAR-NAME. SQ2014.2 +046800 PERFORM PRINT-DETAIL. SQ2014.2 +046900 WRT-TEST-005. SQ2014.2 +047000* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +047100* OF A WRITE ADVANCING INTEGER LINE OPERATION. SQ2014.2 +047200 MOVE LINAGE-COUNTER TO LC-HOLD. SQ2014.2 +047300 ADD 5 TO LC-HOLD. SQ2014.2 +047400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +047500 WRITE DUMMY-RECORD BEFORE ADVANCING 5 LINE. SQ2014.2 +047600 IF LINAGE-COUNTER EQUAL TO LC-HOLD SQ2014.2 +047700 PERFORM PASS SQ2014.2 +047800 GO TO WRT-WRITE-005. SQ2014.2 +047900 GO TO WRT-FAIL-005. SQ2014.2 +048000 WRT-DELETE-005. SQ2014.2 +048100 PERFORM DE-LETE. SQ2014.2 +048200 GO TO WRT-WRITE-005. SQ2014.2 +048300 WRT-FAIL-005. SQ2014.2 +048400 MOVE "VII-5 1.3.8; VII-28 (9) C 1) INTEGER" TO RE-MARK. SQ2014.2 +048500 PERFORM FAIL. SQ2014.2 +048600 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +048700 MOVE LC-HOLD TO CORRECT-18V0. SQ2014.2 +048800 WRT-WRITE-005. SQ2014.2 +048900 MOVE "L-C AFT WRT ADV INT" TO FEATURE. SQ2014.2 +049000 MOVE "WRT-TEST-05" TO PAR-NAME. SQ2014.2 +049100 PERFORM PRINT-DETAIL. SQ2014.2 +049200 WRT-TEST-006. SQ2014.2 +049300* THIS TEST CHECKS THE LINAGE-COUNTER UPON COMPLETION SQ2014.2 +049400* OF A WRITE IDENTIFIER-2 LINES OPERATION. SQ2014.2 +049500 MOVE 4 TO IDENTIFIER-2. SQ2014.2 +049600 MOVE LINAGE-COUNTER TO LC-HOLD. SQ2014.2 +049700 ADD 4 TO LC-HOLD. SQ2014.2 +049800 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +049900 WRITE DUMMY-RECORD BEFORE ADVANCING IDENTIFIER-2 LINES. SQ2014.2 +050000 IF LINAGE-COUNTER EQUAL TO LC-HOLD SQ2014.2 +050100 PERFORM PASS SQ2014.2 +050200 GO TO WRT-WRITE-006. SQ2014.2 +050300 GO TO WRT-FAIL-006. SQ2014.2 +050400 WRT-DELETE-006. SQ2014.2 +050500 PERFORM DE-LETE. SQ2014.2 +050600 GO TO WRT-WRITE-006. SQ2014.2 +050700 WRT-FAIL-006. SQ2014.2 +050800 MOVE "VII-5 1.3.8; VII-29 (9) C 2) IDENTIFIER-2" TO RE-MARK.SQ2014.2 +050900 PERFORM FAIL. SQ2014.2 +051000 MOVE LINAGE-COUNTER TO COMPUTED-18V0. SQ2014.2 +051100 MOVE LC-HOLD TO CORRECT-18V0. SQ2014.2 +051200 WRT-WRITE-006. SQ2014.2 +051300 MOVE "L-C AFT WRT ADV ID-2" TO FEATURE. SQ2014.2 +051400 MOVE "WRT-TEST-06" TO PAR-NAME. SQ2014.2 +051500 PERFORM PRINT-DETAIL. SQ2014.2 +051600 WRT-INIT-007. SQ2014.2 +051700 PERFORM BLANK-LINE-PRINT 10 TIMES. SQ2014.2 +051800 MOVE "THE FOLLOWING SQ201M TESTS CANNOT BE TESTED USING THE NSQ2014.2 +051900- "ORMAL PASS/FAIL METHODS. A VISUAL CHECK WILL HAVE TO TO BE SQ2014.2 +052000- "MADE" TO PRINT-REC. SQ2014.2 +052100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2014.2 +052200 MOVE "TO DETERMINE THE ACCURACY OF EACH TEST" TO PRINT-REC. SQ2014.2 +052300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2014.2 +052400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +052500 PERFORM BLANK-LINE-PRINT 10 TIMES. SQ2014.2 +052600 WRT-TEST-007. SQ2014.2 +052700* THIS IS A TEST FOR WRITE AFTER ADVANCING PAGE. SQ2014.2 +052800* THE RECORD SHOULD PRINT ON THE FIRST LINE OF THE SQ2014.2 +052900* NEXT LOGICAL PAGE. SQ2014.2 +053000 MOVE "WRT AFT ADV PAGE" TO FEATURE. SQ2014.2 +053100 MOVE "WRT-TEST-07" TO PAR-NAME. SQ2014.2 +053200 PERFORM PRINT-DETAIL. SQ2014.2 +053300 MOVE TOP-LINE TO PRINT-REC. SQ2014.2 +053400 WRITE PRINT-REC AFTER ADVANCING PAGE. SQ2014.2 +053500 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +053600 WRT-TEST-008. SQ2014.2 +053700******************************************************************SQ2014.2 +053800* *SQ2014.2 +053900* THIS IS A TEST FOR WRITE ... NOT AT END-OF-PAGE... *SQ2014.2 +054000* --- *SQ2014.2 +054100******************************************************************SQ2014.2 +054200 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +054300 PERFORM WRITE-EOP-MESSAGE. SQ2014.2 +054400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +054500 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2014.2 +054600 MOVE 1 TO DETAIL-LINE-NO. SQ2014.2 +054700 PERFORM EOP-TEST-1 132 TIMES. SQ2014.2 +054800 VAR-TEST-008. SQ2014.2 +054900 IF WRITE-SWITCH NOT = 1 SQ2014.2 +055000 GO TO VAR-FAIL-008. SQ2014.2 +055100 VAR-PASS-008. SQ2014.2 +055200 PERFORM PASS. SQ2014.2 +055300 GO TO VAR-WRITE-008. SQ2014.2 +055400 VAR-FAIL-008. SQ2014.2 +055500 MOVE " NOT ENCOUNTERED; VII-53 GR (9)" SQ2014.2 +055600 TO RE-MARK. SQ2014.2 +055700 PERFORM FAIL. SQ2014.2 +055800 VAR-WRITE-008. SQ2014.2 +055900 MOVE "NOT END-OF-PAGE" TO FEATURE. SQ2014.2 +056000 MOVE "VAR-TEST-008" TO PAR-NAME. SQ2014.2 +056100 PERFORM PRINT-DETAIL. SQ2014.2 +056200 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +056300 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +056400 WRT-TEST-009. SQ2014.2 +056500* THIS IS A TEST FOR WRITE ...; AT EOP ... SQ2014.2 +056600******************************************************************SQ2014.2 +056700* *SQ2014.2 +056800* THIS IS A TEST FOR WRITE ... NOT AT EOP ... *SQ2014.2 +056900* --- *SQ2014.2 +057000******************************************************************SQ2014.2 +057100 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +057200 PERFORM WRITE-EOP-MESSAGE. SQ2014.2 +057300 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +057400 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2014.2 +057500 MOVE 1 TO DETAIL-LINE-NO. SQ2014.2 +057600 PERFORM EOP-TEST-2 132 TIMES. SQ2014.2 +057700 VAR-TEST-009. SQ2014.2 +057800 IF WRITE-SWITCH NOT = 1 SQ2014.2 +057900 GO TO VAR-FAIL-009. SQ2014.2 +058000 VAR-PASS-009. SQ2014.2 +058100 PERFORM PASS. SQ2014.2 +058200 GO TO VAR-WRITE-009. SQ2014.2 +058300 VAR-FAIL-009. SQ2014.2 +058400 MOVE " NOT ENCOUNTERED; VII-53 GR (9)" TO RE-MARKSQ2014.2 +058500 PERFORM FAIL. SQ2014.2 +058600 VAR-WRITE-009. SQ2014.2 +058700 MOVE "NOT AT EOP" TO FEATURE. SQ2014.2 +058800 MOVE "VAR-TEST-009" TO PAR-NAME. SQ2014.2 +058900 PERFORM PRINT-DETAIL. SQ2014.2 +059000 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +059100 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +059200 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +059300 WRT-TEST-010. SQ2014.2 +059400* THIS IS A TEST FOR WRITE... ; END-OF-PAGE ... SQ2014.2 +059500******************************************************************SQ2014.2 +059600* *SQ2014.2 +059700* THIS IS A TEST FOR WRITE ... NOT END-OF-PAGE ... *SQ2014.2 +059800* --- *SQ2014.2 +059900* AND END-WRITE *SQ2014.2 +060000******************************************************************SQ2014.2 +060100 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +060200 MOVE 0 TO END-WRITE-SWITCH. SQ2014.2 +060300 PERFORM WRITE-EOP-MESSAGE. SQ2014.2 +060400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +060500 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2014.2 +060600 MOVE 1 TO DETAIL-LINE-NO. SQ2014.2 +060700 PERFORM EOP-TEST-3 132 TIMES. SQ2014.2 +060800 VAR-TEST-010. SQ2014.2 +060900 IF WRITE-SWITCH NOT = 1 SQ2014.2 +061000 GO TO VAR-FAIL-010. SQ2014.2 +061100 VAR-PASS-010. SQ2014.2 +061200 PERFORM PASS. SQ2014.2 +061300 GO TO VAR-WRITE-010. SQ2014.2 +061400 VAR-FAIL-010. SQ2014.2 +061500 MOVE " NOT ENCOUNTERED; VII-53 GR (9)" SQ2014.2 +061600 TO RE-MARK. SQ2014.2 +061700 PERFORM FAIL. SQ2014.2 +061800 VAR-WRITE-010. SQ2014.2 +061900 MOVE "NOT END-OF-PAGE" TO FEATURE. SQ2014.2 +062000 MOVE "VAR-TEST-010" TO PAR-NAME. SQ2014.2 +062100 PERFORM PRINT-DETAIL. SQ2014.2 +062200 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +062300 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +062400 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +062500 VAR-TEST-010-1. SQ2014.2 +062600 IF END-WRITE-SWITCH NOT EQUAL TO 1 SQ2014.2 +062700 GO TO VAR-FAIL-010-1. SQ2014.2 +062800 VAR-PASS-010-1. SQ2014.2 +062900 PERFORM PASS. SQ2014.2 +063000 GO TO VAR-WRITE-010-1. SQ2014.2 +063100 VAR-FAIL-010-1. SQ2014.2 +063200 MOVE " NOT CORRECT; IV-27 4.4.4" TO RE-MARK. SQ2014.2 +063300 PERFORM FAIL. SQ2014.2 +063400 VAR-WRITE-010-1. SQ2014.2 +063500 MOVE "END-WRITE;NOT END-OF" TO FEATURE. SQ2014.2 +063600 MOVE "VAR-TEST-010-1" TO PAR-NAME. SQ2014.2 +063700 PERFORM PRINT-DETAIL. SQ2014.2 +063800 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +063900 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +064000 WRT-TEST-011. SQ2014.2 +064100* THIS IS A TEST FOR WRITE ...EOP... SQ2014.2 +064200******************************************************************SQ2014.2 +064300* *SQ2014.2 +064400* THIS IS A TEST FOR WRITE ... NOT EOP ... *SQ2014.2 +064500* --- *SQ2014.2 +064600******************************************************************SQ2014.2 +064700 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +064800 MOVE 0 TO END-WRITE-SWITCH. SQ2014.2 +064900* MOVE "EOP" TO FEATURE. SQ2014.2 +065000* MOVE "WRT-TEST-11" TO PAR-NAME. SQ2014.2 +065100* PERFORM PRINT-DETAIL. SQ2014.2 +065200 PERFORM WRITE-EOP-MESSAGE. SQ2014.2 +065300 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +065400 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2014.2 +065500 MOVE 1 TO DETAIL-LINE-NO. SQ2014.2 +065600 PERFORM EOP-TEST-4 132 TIMES. SQ2014.2 +065700 VAR-TEST-011. SQ2014.2 +065800 IF WRITE-SWITCH NOT = 1 SQ2014.2 +065900 GO TO VAR-FAIL-011. SQ2014.2 +066000 VAR-PASS-011. SQ2014.2 +066100 PERFORM PASS. SQ2014.2 +066200 GO TO VAR-WRITE-011. SQ2014.2 +066300 VAR-FAIL-011. SQ2014.2 +066400 MOVE " NOT ENCOUNTERED; VII-53 GR (9)" TO RE-MARK. SQ2014.2 +066500 PERFORM FAIL. SQ2014.2 +066600 VAR-WRITE-011. SQ2014.2 +066700 MOVE "NOT EOP" TO FEATURE. SQ2014.2 +066800 MOVE "VAR-TEST-011" TO PAR-NAME. SQ2014.2 +066900 PERFORM PRINT-DETAIL. SQ2014.2 +067000 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +067100 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +067200 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +067300 VAR-TEST-011-1. SQ2014.2 +067400 IF END-WRITE-SWITCH NOT EQUAL TO 1 SQ2014.2 +067500 GO TO VAR-FAIL-011-1. SQ2014.2 +067600 VAR-PASS-011-1. SQ2014.2 +067700 PERFORM PASS. SQ2014.2 +067800 GO TO VAR-WRITE-011-1. SQ2014.2 +067900 VAR-FAIL-011-1. SQ2014.2 +068000 MOVE " NOT CORRECT; IV-27 4.4.4" TO RE-MARK. SQ2014.2 +068100 PERFORM FAIL. SQ2014.2 +068200 VAR-WRITE-011-1. SQ2014.2 +068300 MOVE "END-WRITE; NOT EOP" TO FEATURE. SQ2014.2 +068400 MOVE "VAR-TEST-011-1" TO PAR-NAME. SQ2014.2 +068500 PERFORM PRINT-DETAIL. SQ2014.2 +068600 MOVE 0 TO WRITE-SWITCH. SQ2014.2 +068700 MOVE 0 TO END-WRITE-SWITCH. SQ2014.2 +068800 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +068900 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +069000 SQ201M-END-ROUTINE. SQ2014.2 +069100 MOVE "END OF SQ201M VALIDATION TESTS" TO PRINT-REC. SQ2014.2 +069200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2014.2 +069300 GO TO CCVS-EXIT. SQ2014.2 +069400 EOP-TEST-1. SQ2014.2 +069500 MOVE LINAGE-COUNTER TO DETAIL-LC. SQ2014.2 +069600 MOVE DETAIL-LINE TO PRINT-REC. SQ2014.2 +069700 WRITE PRINT-REC BEFORE ADVANCING 1 LINE AT END-OF-PAGE SQ2014.2 +069800 MOVE 1 TO FOOT-COUNT SQ2014.2 +069900 MOVE 45 TO FOOT-LINE-NO SQ2014.2 +070000 PERFORM PRINT-FOOTING 6 TIMES SQ2014.2 +070100******************************************************************SQ2014.2 +070200* *SQ2014.2 +070300* NEW: NOT AT END-OF-PAGE *SQ2014.2 +070400* --- *SQ2014.2 +070500******************************************************************SQ2014.2 +070600 NOT AT END-OF-PAGE SQ2014.2 +070700 MOVE 1 TO WRITE-SWITCH. SQ2014.2 +070800 ADD 1 TO DETAIL-LINE-NO. SQ2014.2 +070900 EOP-TEST-2. SQ2014.2 +071000 MOVE LINAGE-COUNTER TO DETAIL-LC. SQ2014.2 +071100 MOVE DETAIL-LINE TO PRINT-REC. SQ2014.2 +071200 WRITE PRINT-REC BEFORE ADVANCING 1 LINE ; AT EOP SQ2014.2 +071300 MOVE 1 TO FOOT-COUNT SQ2014.2 +071400 MOVE 45 TO FOOT-LINE-NO SQ2014.2 +071500 PERFORM PRINT-FOOTING 6 TIMES SQ2014.2 +071600******************************************************************SQ2014.2 +071700* *SQ2014.2 +071800* NEW: NOT AT EOP *SQ2014.2 +071900* *SQ2014.2 +072000******************************************************************SQ2014.2 +072100 NOT AT EOP SQ2014.2 +072200 MOVE 1 TO WRITE-SWITCH. SQ2014.2 +072300 ADD 1 TO DETAIL-LINE-NO. SQ2014.2 +072400 EOP-TEST-3. SQ2014.2 +072500 MOVE LINAGE-COUNTER TO DETAIL-LC. SQ2014.2 +072600 MOVE DETAIL-LINE TO PRINT-REC. SQ2014.2 +072700 IF END-WRITE-SWITCH EQUAL TO 1 OR END-WRITE-SWITCH EQUAL TO 0SQ2014.2 +072800 WRITE PRINT-REC BEFORE ADVANCING 1 LINE ; END-OF-PAGE SQ2014.2 +072900 MOVE 1 TO FOOT-COUNT SQ2014.2 +073000 MOVE 45 TO FOOT-LINE-NO SQ2014.2 +073100 PERFORM PRINT-FOOTING 6 TIMES SQ2014.2 +073200******************************************************************SQ2014.2 +073300* *SQ2014.2 +073400* NEW: NOT END-OF-PAGE *SQ2014.2 +073500* --- *SQ2014.2 +073600******************************************************************SQ2014.2 +073700 NOT END-OF-PAGE SQ2014.2 +073800 MOVE 1 TO WRITE-SWITCH SQ2014.2 +073900 END-WRITE SQ2014.2 +074000 MOVE 1 TO END-WRITE-SWITCH. SQ2014.2 +074100 ADD 1 TO DETAIL-LINE-NO. SQ2014.2 +074200 EOP-TEST-4. SQ2014.2 +074300 MOVE LINAGE-COUNTER TO DETAIL-LC. SQ2014.2 +074400 MOVE DETAIL-LINE TO PRINT-REC. SQ2014.2 +074500 IF END-WRITE-SWITCH EQUAL TO 1 OR END-WRITE-SWITCH EQUAL TO 0SQ2014.2 +074600 WRITE PRINT-REC BEFORE ADVANCING 1 LINE EOP SQ2014.2 +074700 MOVE 1 TO FOOT-COUNT SQ2014.2 +074800 MOVE 45 TO FOOT-LINE-NO SQ2014.2 +074900 PERFORM PRINT-FOOTING 6 TIMES SQ2014.2 +075000******************************************************************SQ2014.2 +075100* *SQ2014.2 +075200* NEW: NOT EOP *SQ2014.2 +075300* --- *SQ2014.2 +075400******************************************************************SQ2014.2 +075500 NOT EOP SQ2014.2 +075600 MOVE 1 TO WRITE-SWITCH SQ2014.2 +075700 END-WRITE SQ2014.2 +075800 MOVE 1 TO END-WRITE-SWITCH. SQ2014.2 +075900 ADD 1 TO DETAIL-LINE-NO. SQ2014.2 +076000 PRINT-FOOTING. SQ2014.2 +076100 MOVE LINAGE-COUNTER TO FOOT-LC. SQ2014.2 +076200 MOVE FOOT-LINE TO PRINT-REC. SQ2014.2 +076300 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2014.2 +076400 ADD 1 TO FOOT-COUNT. SQ2014.2 +076500 ADD 1 TO FOOT-LINE-NO. SQ2014.2 +076600 WRITE-EOP-MESSAGE. SQ2014.2 +076700 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +076800 MOVE EOP-MESSAGE-1 TO PRINT-REC. SQ2014.2 +076900 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2014.2 +077000 MOVE EOP-MESSAGE-2 TO PRINT-REC. SQ2014.2 +077100 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2014.2 +077200 MOVE EOP-MESSAGE-3 TO PRINT-REC. SQ2014.2 +077300 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2014.2 +077400 MOVE SPACE TO DUMMY-RECORD. SQ2014.2 +077500 PERFORM BLANK-LINE-PRINT 5 TIMES. SQ2014.2 +077600 CCVS-EXIT SECTION. SQ2014.2 +077700 CCVS-999999. SQ2014.2 +077800 GO TO CLOSE-FILES. SQ2014.2 diff --git a/tests/cobol85/SQ/SQ202A.CBL b/tests/cobol85/SQ/SQ202A.CBL new file mode 100755 index 00000000..040ef386 --- /dev/null +++ b/tests/cobol85/SQ/SQ202A.CBL @@ -0,0 +1,448 @@ +000100 IDENTIFICATION DIVISION. SQ2024.2 +000200 PROGRAM-ID. SQ2024.2 +000300 SQ202A. SQ2024.2 +000400**************************************************************** SQ2024.2 +000500* * SQ2024.2 +000600* VALIDATION FOR:- * SQ2024.2 +000700* " HIGH ". SQ2024.2 +000800* * SQ2024.2 +000900* CREATION DATE / VALIDATION DATE * SQ2024.2 +001000* "4.2 ". SQ2024.2 +001100* * SQ2024.2 +001200* THE ROUTINE SQ202A (OLD SQ203) CREATES A MAGNETIC TAPE FILE ANDSQ2024.2 +001300* PASSES IT ON TO SQ203A TO BE OPENED AS INPUT UNDER A SELECT SQ2024.2 +001400* OPTIONAL CLAUSE. SQ2024.2 +001500 ENVIRONMENT DIVISION. SQ2024.2 +001600 CONFIGURATION SECTION. SQ2024.2 +001700 SOURCE-COMPUTER. SQ2024.2 +001800 Linux. SQ2024.2 +001900 OBJECT-COMPUTER. SQ2024.2 +002000 Linux. SQ2024.2 +002100 INPUT-OUTPUT SECTION. SQ2024.2 +002200 FILE-CONTROL. SQ2024.2 +002300*P SELECT RAW-DATA ASSIGN TO SQ2024.2 +002400*P "XXXXX062" SQ2024.2 +002500*P ORGANIZATION IS INDEXED SQ2024.2 +002600*P ACCESS MODE IS RANDOM SQ2024.2 +002700*P RECORD KEY IS RAW-DATA-KEY. SQ2024.2 +002800 SELECT PRINT-FILE ASSIGN TO SQ2024.2 +002900 "report.log". SQ2024.2 +003000 SELECT SQ-FS1 ASSIGN TO SQ2024.2 +003100 "XXXXX001". SQ2024.2 +003200 DATA DIVISION. SQ2024.2 +003300 FILE SECTION. SQ2024.2 +003400*P SQ2024.2 +003500*PD RAW-DATA. SQ2024.2 +003600*P SQ2024.2 +003700*P1 RAW-DATA-SATZ. SQ2024.2 +003800*P 05 RAW-DATA-KEY PIC X(6). SQ2024.2 +003900*P 05 C-DATE PIC 9(6). SQ2024.2 +004000*P 05 C-TIME PIC 9(8). SQ2024.2 +004100*P 05 C-NO-OF-TESTS PIC 99. SQ2024.2 +004200*P 05 C-OK PIC 999. SQ2024.2 +004300*P 05 C-ALL PIC 999. SQ2024.2 +004400*P 05 C-FAIL PIC 999. SQ2024.2 +004500*P 05 C-DELETED PIC 999. SQ2024.2 +004600*P 05 C-INSPECT PIC 999. SQ2024.2 +004700*P 05 C-NOTE PIC X(13). SQ2024.2 +004800*P 05 C-INDENT PIC X. SQ2024.2 +004900*P 05 C-ABORT PIC X(8). SQ2024.2 +005000 FD PRINT-FILE SQ2024.2 +005100*C LABEL RECORDS SQ2024.2 +005200*C OMITTED SQ2024.2 +005300*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2024.2 +005400 . SQ2024.2 +005500 01 PRINT-REC PICTURE X(120). SQ2024.2 +005600 01 DUMMY-RECORD PICTURE X(120). SQ2024.2 +005700 FD SQ-FS1 SQ2024.2 +005800*C LABEL RECORD STANDARD SQ2024.2 +005900 BLOCK CONTAINS 120 CHARACTERS. SQ2024.2 +006000 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2024.2 +006100 WORKING-STORAGE SECTION. SQ2024.2 +006200 77 RECORD-OUT-COUNT PIC 999. SQ2024.2 +006300 77 RECORDS-IN-ERROR PIC 999. SQ2024.2 +006400 01 COUNT-OF-RECS PIC 9999. SQ2024.2 +006500 01 FILE-RECORD-INFORMATION-REC. SQ2024.2 +006600 03 FILE-RECORD-INFO-SKELETON. SQ2024.2 +006700 05 FILLER PICTURE X(48) VALUE SQ2024.2 +006800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2024.2 +006900 05 FILLER PICTURE X(46) VALUE SQ2024.2 +007000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2024.2 +007100 05 FILLER PICTURE X(26) VALUE SQ2024.2 +007200 ",LFIL=000000,ORG= ,LBLR= ". SQ2024.2 +007300 05 FILLER PICTURE X(37) VALUE SQ2024.2 +007400 ",RECKEY= ". SQ2024.2 +007500 05 FILLER PICTURE X(38) VALUE SQ2024.2 +007600 ",ALTKEY1= ". SQ2024.2 +007700 05 FILLER PICTURE X(38) VALUE SQ2024.2 +007800 ",ALTKEY2= ". SQ2024.2 +007900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2024.2 +008000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2024.2 +008100 05 FILE-RECORD-INFO-P1-120. SQ2024.2 +008200 07 FILLER PIC X(5). SQ2024.2 +008300 07 XFILE-NAME PIC X(6). SQ2024.2 +008400 07 FILLER PIC X(8). SQ2024.2 +008500 07 XRECORD-NAME PIC X(6). SQ2024.2 +008600 07 FILLER PIC X(1). SQ2024.2 +008700 07 REELUNIT-NUMBER PIC 9(1). SQ2024.2 +008800 07 FILLER PIC X(7). SQ2024.2 +008900 07 XRECORD-NUMBER PIC 9(6). SQ2024.2 +009000 07 FILLER PIC X(6). SQ2024.2 +009100 07 UPDATE-NUMBER PIC 9(2). SQ2024.2 +009200 07 FILLER PIC X(5). SQ2024.2 +009300 07 ODO-NUMBER PIC 9(4). SQ2024.2 +009400 07 FILLER PIC X(5). SQ2024.2 +009500 07 XPROGRAM-NAME PIC X(5). SQ2024.2 +009600 07 FILLER PIC X(7). SQ2024.2 +009700 07 XRECORD-LENGTH PIC 9(6). SQ2024.2 +009800 07 FILLER PIC X(7). SQ2024.2 +009900 07 CHARS-OR-RECORDS PIC X(2). SQ2024.2 +010000 07 FILLER PIC X(1). SQ2024.2 +010100 07 XBLOCK-SIZE PIC 9(4). SQ2024.2 +010200 07 FILLER PIC X(6). SQ2024.2 +010300 07 RECORDS-IN-FILE PIC 9(6). SQ2024.2 +010400 07 FILLER PIC X(5). SQ2024.2 +010500 07 XFILE-ORGANIZATION PIC X(2). SQ2024.2 +010600 07 FILLER PIC X(6). SQ2024.2 +010700 07 XLABEL-TYPE PIC X(1). SQ2024.2 +010800 05 FILE-RECORD-INFO-P121-240. SQ2024.2 +010900 07 FILLER PIC X(8). SQ2024.2 +011000 07 XRECORD-KEY PIC X(29). SQ2024.2 +011100 07 FILLER PIC X(9). SQ2024.2 +011200 07 ALTERNATE-KEY1 PIC X(29). SQ2024.2 +011300 07 FILLER PIC X(9). SQ2024.2 +011400 07 ALTERNATE-KEY2 PIC X(29). SQ2024.2 +011500 07 FILLER PIC X(7). SQ2024.2 +011600 01 TEST-RESULTS. SQ2024.2 +011700 02 FILLER PICTURE X VALUE SPACE. SQ2024.2 +011800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2024.2 +011900 02 FILLER PICTURE X VALUE SPACE. SQ2024.2 +012000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2024.2 +012100 02 FILLER PICTURE X VALUE SPACE. SQ2024.2 +012200 02 PAR-NAME. SQ2024.2 +012300 03 FILLER PICTURE X(12) VALUE SPACE. SQ2024.2 +012400 03 PARDOT-X PICTURE X VALUE SPACE. SQ2024.2 +012500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2024.2 +012600 03 FILLER PIC X(5) VALUE SPACE. SQ2024.2 +012700 02 FILLER PIC X(10) VALUE SPACE. SQ2024.2 +012800 02 RE-MARK PIC X(61). SQ2024.2 +012900 01 TEST-COMPUTED. SQ2024.2 +013000 02 FILLER PIC X(30) VALUE SPACE. SQ2024.2 +013100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2024.2 +013200 02 COMPUTED-X. SQ2024.2 +013300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2024.2 +013400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2024.2 +013500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2024.2 +013600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2024.2 +013700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2024.2 +013800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2024.2 +013900 04 COMPUTED-18V0 PICTURE -9(18). SQ2024.2 +014000 04 FILLER PICTURE X. SQ2024.2 +014100 03 FILLER PIC X(50) VALUE SPACE. SQ2024.2 +014200 01 TEST-CORRECT. SQ2024.2 +014300 02 FILLER PIC X(30) VALUE SPACE. SQ2024.2 +014400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2024.2 +014500 02 CORRECT-X. SQ2024.2 +014600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2024.2 +014700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2024.2 +014800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2024.2 +014900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2024.2 +015000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2024.2 +015100 03 CR-18V0 REDEFINES CORRECT-A. SQ2024.2 +015200 04 CORRECT-18V0 PICTURE -9(18). SQ2024.2 +015300 04 FILLER PICTURE X. SQ2024.2 +015400 03 FILLER PIC X(50) VALUE SPACE. SQ2024.2 +015500 01 CCVS-C-1. SQ2024.2 +015600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2024.2 +015700- "SS PARAGRAPH-NAME SQ2024.2 +015800- " REMARKS". SQ2024.2 +015900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2024.2 +016000 01 CCVS-C-2. SQ2024.2 +016100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2024.2 +016200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2024.2 +016300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2024.2 +016400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2024.2 +016500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2024.2 +016600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2024.2 +016700 01 REC-CT PICTURE 99 VALUE ZERO. SQ2024.2 +016800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2024.2 +016900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2024.2 +017000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2024.2 +017100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2024.2 +017200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2024.2 +017300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2024.2 +017400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2024.2 +017500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2024.2 +017600 01 CCVS-H-1. SQ2024.2 +017700 02 FILLER PICTURE X(27) VALUE SPACE. SQ2024.2 +017800 02 FILLER PICTURE X(67) VALUE SQ2024.2 +017900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2024.2 +018000- " SYSTEM". SQ2024.2 +018100 02 FILLER PICTURE X(26) VALUE SPACE. SQ2024.2 +018200 01 CCVS-H-2. SQ2024.2 +018300 02 FILLER PICTURE X(52) VALUE IS SQ2024.2 +018400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2024.2 +018500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2024.2 +018600 02 TEST-ID PICTURE IS X(9). SQ2024.2 +018700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2024.2 +018800 01 CCVS-H-3. SQ2024.2 +018900 02 FILLER PICTURE X(34) VALUE SQ2024.2 +019000 " FOR OFFICIAL USE ONLY ". SQ2024.2 +019100 02 FILLER PICTURE X(58) VALUE SQ2024.2 +019200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2024.2 +019300 02 FILLER PICTURE X(28) VALUE SQ2024.2 +019400 " COPYRIGHT 1985 ". SQ2024.2 +019500 01 CCVS-E-1. SQ2024.2 +019600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2024.2 +019700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2024.2 +019800 02 ID-AGAIN PICTURE IS X(9). SQ2024.2 +019900 02 FILLER PICTURE X(45) VALUE IS SQ2024.2 +020000 " NTIS DISTRIBUTION COBOL 85". SQ2024.2 +020100 01 CCVS-E-2. SQ2024.2 +020200 02 FILLER PICTURE X(31) VALUE SQ2024.2 +020300 SPACE. SQ2024.2 +020400 02 FILLER PICTURE X(21) VALUE SPACE. SQ2024.2 +020500 02 CCVS-E-2-2. SQ2024.2 +020600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2024.2 +020700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2024.2 +020800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2024.2 +020900 01 CCVS-E-3. SQ2024.2 +021000 02 FILLER PICTURE X(22) VALUE SQ2024.2 +021100 " FOR OFFICIAL USE ONLY". SQ2024.2 +021200 02 FILLER PICTURE X(12) VALUE SPACE. SQ2024.2 +021300 02 FILLER PICTURE X(58) VALUE SQ2024.2 +021400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2024.2 +021500 02 FILLER PICTURE X(13) VALUE SPACE. SQ2024.2 +021600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2024.2 +021700 01 CCVS-E-4. SQ2024.2 +021800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2024.2 +021900 02 FILLER PIC XXXX VALUE " OF ". SQ2024.2 +022000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2024.2 +022100 02 FILLER PIC X(40) VALUE SQ2024.2 +022200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2024.2 +022300 01 XXINFO. SQ2024.2 +022400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2024.2 +022500 02 INFO-TEXT. SQ2024.2 +022600 04 FILLER PIC X(20) VALUE SPACE. SQ2024.2 +022700 04 XXCOMPUTED PIC X(20). SQ2024.2 +022800 04 FILLER PIC X(5) VALUE SPACE. SQ2024.2 +022900 04 XXCORRECT PIC X(20). SQ2024.2 +023000 01 HYPHEN-LINE. SQ2024.2 +023100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2024.2 +023200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2024.2 +023300- "*****************************************". SQ2024.2 +023400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2024.2 +023500- "******************************". SQ2024.2 +023600 01 CCVS-PGM-ID PIC X(6) VALUE SQ2024.2 +023700 "SQ202A". SQ2024.2 +023800 PROCEDURE DIVISION. SQ2024.2 +023900 CCVS1 SECTION. SQ2024.2 +024000 OPEN-FILES. SQ2024.2 +024100*P OPEN I-O RAW-DATA. SQ2024.2 +024200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2024.2 +024300*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2024.2 +024400*P MOVE "ABORTED " TO C-ABORT. SQ2024.2 +024500*P ADD 1 TO C-NO-OF-TESTS. SQ2024.2 +024600*P ACCEPT C-DATE FROM DATE. SQ2024.2 +024700*P ACCEPT C-TIME FROM TIME. SQ2024.2 +024800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2024.2 +024900*PND-E-1. SQ2024.2 +025000*P CLOSE RAW-DATA. SQ2024.2 +025100 OPEN OUTPUT PRINT-FILE. SQ2024.2 +025200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2024.2 +025300 MOVE SPACE TO TEST-RESULTS. SQ2024.2 +025400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2024.2 +025500 MOVE ZERO TO REC-SKL-SUB. SQ2024.2 +025600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2024.2 +025700 CCVS-INIT-FILE. SQ2024.2 +025800 ADD 1 TO REC-SKL-SUB. SQ2024.2 +025900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2024.2 +026000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2024.2 +026100 CCVS-INIT-EXIT. SQ2024.2 +026200 GO TO CCVS1-EXIT. SQ2024.2 +026300 CLOSE-FILES. SQ2024.2 +026400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2024.2 +026500*P OPEN I-O RAW-DATA. SQ2024.2 +026600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2024.2 +026700*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2024.2 +026800*P MOVE "OK. " TO C-ABORT. SQ2024.2 +026900*P MOVE PASS-COUNTER TO C-OK. SQ2024.2 +027000*P MOVE ERROR-HOLD TO C-ALL. SQ2024.2 +027100*P MOVE ERROR-COUNTER TO C-FAIL. SQ2024.2 +027200*P MOVE DELETE-CNT TO C-DELETED. SQ2024.2 +027300*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2024.2 +027400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2024.2 +027500*PND-E-2. SQ2024.2 +027600*P CLOSE RAW-DATA. SQ2024.2 +027700 TERMINATE-CCVS. SQ2024.2 +027800*S EXIT PROGRAM. SQ2024.2 +027900*SERMINATE-CALL. SQ2024.2 +028000 STOP RUN. SQ2024.2 +028100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2024.2 +028200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2024.2 +028300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2024.2 +028400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2024.2 +028500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2024.2 +028600 PRINT-DETAIL. SQ2024.2 +028700 IF REC-CT NOT EQUAL TO ZERO SQ2024.2 +028800 MOVE "." TO PARDOT-X SQ2024.2 +028900 MOVE REC-CT TO DOTVALUE. SQ2024.2 +029000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2024.2 +029100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2024.2 +029200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2024.2 +029300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2024.2 +029400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2024.2 +029500 MOVE SPACE TO CORRECT-X. SQ2024.2 +029600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2024.2 +029700 MOVE SPACE TO RE-MARK. SQ2024.2 +029800 HEAD-ROUTINE. SQ2024.2 +029900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +030000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2024.2 +030100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2024.2 +030200 COLUMN-NAMES-ROUTINE. SQ2024.2 +030300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +030400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +030500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +030600 END-ROUTINE. SQ2024.2 +030700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2024.2 +030800 END-RTN-EXIT. SQ2024.2 +030900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +031000 END-ROUTINE-1. SQ2024.2 +031100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2024.2 +031200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2024.2 +031300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2024.2 +031400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2024.2 +031500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2024.2 +031600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2024.2 +031700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2024.2 +031800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2024.2 +031900 END-ROUTINE-12. SQ2024.2 +032000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2024.2 +032100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2024.2 +032200 MOVE "NO " TO ERROR-TOTAL SQ2024.2 +032300 ELSE SQ2024.2 +032400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2024.2 +032500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2024.2 +032600 PERFORM WRITE-LINE. SQ2024.2 +032700 END-ROUTINE-13. SQ2024.2 +032800 IF DELETE-CNT IS EQUAL TO ZERO SQ2024.2 +032900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2024.2 +033000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2024.2 +033100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2024.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +033300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2024.2 +033400 MOVE "NO " TO ERROR-TOTAL SQ2024.2 +033500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2024.2 +033600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2024.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +033800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2024.2 +033900 WRITE-LINE. SQ2024.2 +034000 ADD 1 TO RECORD-COUNT. SQ2024.2 +034100 IF RECORD-COUNT GREATER 50 SQ2024.2 +034200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2024.2 +034300 MOVE SPACE TO DUMMY-RECORD SQ2024.2 +034400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2024.2 +034500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2024.2 +034600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2024.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2024.2 +034800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2024.2 +034900 MOVE ZERO TO RECORD-COUNT. SQ2024.2 +035000 PERFORM WRT-LN. SQ2024.2 +035100 WRT-LN. SQ2024.2 +035200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2024.2 +035300 MOVE SPACE TO DUMMY-RECORD. SQ2024.2 +035400 BLANK-LINE-PRINT. SQ2024.2 +035500 PERFORM WRT-LN. SQ2024.2 +035600 FAIL-ROUTINE. SQ2024.2 +035700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2024.2 +035800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2024.2 +035900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2024.2 +036000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +036100 GO TO FAIL-ROUTINE-EX. SQ2024.2 +036200 FAIL-ROUTINE-WRITE. SQ2024.2 +036300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2024.2 +036400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +036500 FAIL-ROUTINE-EX. EXIT. SQ2024.2 +036600 BAIL-OUT. SQ2024.2 +036700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2024.2 +036800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2024.2 +036900 BAIL-OUT-WRITE. SQ2024.2 +037000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2024.2 +037100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2024.2 +037200 BAIL-OUT-EX. EXIT. SQ2024.2 +037300 CCVS1-EXIT. SQ2024.2 +037400 EXIT. SQ2024.2 +037500 SECTION-SQ202A-0001 SECTION. SQ2024.2 +037600 WRI-INIT-001. SQ2024.2 +037700 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2024.2 +037800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2024.2 +037900 MOVE "SQ202A" TO XPROGRAM-NAME (1). SQ2024.2 +038000 MOVE 120 TO XRECORD-LENGTH (1). SQ2024.2 +038100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2024.2 +038200 MOVE 1 TO XBLOCK-SIZE (1). SQ2024.2 +038300 MOVE 750 TO RECORDS-IN-FILE (1). SQ2024.2 +038400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2024.2 +038500 MOVE "S" TO XLABEL-TYPE (1). SQ2024.2 +038600 MOVE 1 TO XRECORD-NUMBER (1). SQ2024.2 +038700 OPEN OUTPUT SQ-FS1. SQ2024.2 +038800 WRI-TEST-001. SQ2024.2 +038900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2024.2 +039000 WRITE SQ-FS1R1-F-G-120. SQ2024.2 +039100 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2024.2 +039200 GO TO WRI-WRITE-001. SQ2024.2 +039300 ADD 1 TO XRECORD-NUMBER (1). SQ2024.2 +039400 GO TO WRI-TEST-001. SQ2024.2 +039500 WRI-WRITE-001. SQ2024.2 +039600 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2024.2 +039700 MOVE "WRI-TEST-001" TO PAR-NAME. SQ2024.2 +039800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2024.2 +039900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2024.2 +040000 PERFORM PRINT-DETAIL. SQ2024.2 +040100 WRI-CLOSE-001. SQ2024.2 +040200 CLOSE SQ-FS1. SQ2024.2 +040300 READ-INIT-001. SQ2024.2 +040400 MOVE 0 TO RECORD-OUT-COUNT, RECORDS-IN-ERROR. SQ2024.2 +040500 OPEN INPUT SQ-FS1. SQ2024.2 +040600 READ-TEST-001. SQ2024.2 +040700 READ SQ-FS1 AT END GO TO READ-TEST-001-01. SQ2024.2 +040800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2024.2 +040900 ADD 1 TO RECORD-OUT-COUNT SQ2024.2 +041000 IF RECORD-OUT-COUNT GREATER THAN 750 SQ2024.2 +041100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2024.2 +041200 GO TO READ-FAIL-001. SQ2024.2 +041300 IF RECORD-OUT-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2024.2 +041400 ADD 1 TO RECORDS-IN-ERROR SQ2024.2 +041500 GO TO READ-TEST-001. SQ2024.2 +041600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2024.2 +041700 ADD 1 TO RECORDS-IN-ERROR SQ2024.2 +041800 GO TO READ-TEST-001. SQ2024.2 +041900 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2024.2 +042000 ADD 1 TO RECORDS-IN-ERROR. SQ2024.2 +042100 GO TO READ-TEST-001. SQ2024.2 +042200 READ-TEST-001-01. SQ2024.2 +042300 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2024.2 +042400 GO TO READ-PASS-001. SQ2024.2 +042500 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ2024.2 +042600 READ-FAIL-001. SQ2024.2 +042700 MOVE "RECORDS IN ERROR" TO COMPUTED-A. SQ2024.2 +042800 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2024.2 +042900 PERFORM FAIL. SQ2024.2 +043000 GO TO READ-WRITE-001. SQ2024.2 +043100 READ-PASS-001. SQ2024.2 +043200 PERFORM PASS. SQ2024.2 +043300 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2024.2 +043400 MOVE RECORD-OUT-COUNT TO CORRECT-18V0. SQ2024.2 +043500 READ-WRITE-001. SQ2024.2 +043600 MOVE "READ-TEST-001" TO PAR-NAME. SQ2024.2 +043700 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2024.2 +043800 PERFORM PRINT-DETAIL. SQ2024.2 +043900 READ-CLOSE-001. SQ2024.2 +044000 CLOSE SQ-FS1. SQ2024.2 +044100 SQ202A-END-ROUTINE. SQ2024.2 +044200 MOVE "END OF SQ202A VALIDATION TESTS" TO PRINT-REC. SQ2024.2 +044300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2024.2 +044400 TERMINATE-SQ202A. SQ2024.2 +044500 EXIT. SQ2024.2 +044600 CCVS-EXIT SECTION. SQ2024.2 +044700 CCVS-999999. SQ2024.2 +044800 GO TO CLOSE-FILES. SQ2024.2 diff --git a/tests/cobol85/SQ/SQ203A.SUB b/tests/cobol85/SQ/SQ203A.SUB new file mode 100755 index 00000000..2932dded --- /dev/null +++ b/tests/cobol85/SQ/SQ203A.SUB @@ -0,0 +1,553 @@ +000100 IDENTIFICATION DIVISION. SQ2034.2 +000200 PROGRAM-ID. SQ2034.2 +000300 SQ203A. SQ2034.2 +000400**************************************************************** SQ2034.2 +000500* * SQ2034.2 +000600* VALIDATION FOR:- * SQ2034.2 +000700* " HIGH ". SQ2034.2 +000800* * SQ2034.2 +000900* CREATION DATE / VALIDATION DATE * SQ2034.2 +001000* "4.2 ". SQ2034.2 +001100* * SQ2034.2 +001200* THE ROUTINE SQ203A TESTS THE USE OF THE OPTIONAL CLAUSE SQ2034.2 +001300* IN THE SELECT CLAUSE OF A FILE CONTROL ENTRY. THE TEST IS SQ2034.2 +001400* MADE WHEN THE OPTIONAL FILE IS BOTH PRESENT AND ABSENT. SQ2034.2 +001500* THE RESERVE INTEGER AREA CLAUSE IS ALSO INCLUDE IN THIS TEST.SQ2034.2 +001600 ENVIRONMENT DIVISION. SQ2034.2 +001700 CONFIGURATION SECTION. SQ2034.2 +001800 SOURCE-COMPUTER. SQ2034.2 +001900 Linux. SQ2034.2 +002000 OBJECT-COMPUTER. SQ2034.2 +002100 Linux. SQ2034.2 +002200 INPUT-OUTPUT SECTION. SQ2034.2 +002300 FILE-CONTROL. SQ2034.2 +002400*P SELECT RAW-DATA ASSIGN TO SQ2034.2 +002500*P "XXXXX062" SQ2034.2 +002600*P ORGANIZATION IS INDEXED SQ2034.2 +002700*P ACCESS MODE IS RANDOM SQ2034.2 +002800*P RECORD KEY IS RAW-DATA-KEY. SQ2034.2 +002900 SELECT PRINT-FILE ASSIGN TO SQ2034.2 +003000 "report.log". SQ2034.2 +003100 SELECT OPTIONAL SQ-FS1 SQ2034.2 +003200 ASSIGN TO SQ2034.2 +003300 "XXXXX001" SQ2034.2 +003400 RESERVE 8 AREAS SQ2034.2 +003500 ORGANIZATION IS SEQUENTIAL SQ2034.2 +003600 ACCESS MODE IS SEQUENTIAL SQ2034.2 +003700 FILE STATUS GRP-STATUS-KEY-1. SQ2034.2 +003800 SELECT OPTIONAL SQ-FS2 SQ2034.2 +003900 ASSIGN TO SQ2034.2 +004000 "XXXXX018" SQ2034.2 +004100 STATUS GRP-STATUS-KEY-2. SQ2034.2 +004200 SELECT SQ-FS3 ASSIGN TO SQ2034.2 +004300 "XXXXX003" SQ2034.2 +004400 RESERVE 7 AREA SQ2034.2 +004500 ORGANIZATION SEQUENTIAL SQ2034.2 +004600 ACCESS SEQUENTIAL SQ2034.2 +004700 FILE STATUS IS GRP-STATUS-KEY-3. SQ2034.2 +004800 SELECT OPTIONAL SQ-FS4 ASSIGN TO SQ2034.2 +004900 "XXXXX017" SQ2034.2 +005000 ORGANIZATION IS SEQUENTIAL. SQ2034.2 +005100 DATA DIVISION. SQ2034.2 +005200 FILE SECTION. SQ2034.2 +005300*P SQ2034.2 +005400*PD RAW-DATA. SQ2034.2 +005500*P SQ2034.2 +005600*P1 RAW-DATA-SATZ. SQ2034.2 +005700*P 05 RAW-DATA-KEY PIC X(6). SQ2034.2 +005800*P 05 C-DATE PIC 9(6). SQ2034.2 +005900*P 05 C-TIME PIC 9(8). SQ2034.2 +006000*P 05 C-NO-OF-TESTS PIC 99. SQ2034.2 +006100*P 05 C-OK PIC 999. SQ2034.2 +006200*P 05 C-ALL PIC 999. SQ2034.2 +006300*P 05 C-FAIL PIC 999. SQ2034.2 +006400*P 05 C-DELETED PIC 999. SQ2034.2 +006500*P 05 C-INSPECT PIC 999. SQ2034.2 +006600*P 05 C-NOTE PIC X(13). SQ2034.2 +006700*P 05 C-INDENT PIC X. SQ2034.2 +006800*P 05 C-ABORT PIC X(8). SQ2034.2 +006900 FD PRINT-FILE SQ2034.2 +007000*C LABEL RECORDS SQ2034.2 +007100*C OMITTED SQ2034.2 +007200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2034.2 +007300 . SQ2034.2 +007400 01 PRINT-REC PICTURE X(120). SQ2034.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ2034.2 +007600 FD SQ-FS1 SQ2034.2 +007700*C LABEL RECORDS ARE STANDARD SQ2034.2 +007800 BLOCK CONTAINS 120 CHARACTERS. SQ2034.2 +007900 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2034.2 +008000 FD SQ-FS2 SQ2034.2 +008100*C LABEL RECORDS ARE STANDARD SQ2034.2 +008200 BLOCK CONTAINS 120 CHARACTERS. SQ2034.2 +008300 01 SQ-FS2R1-F-G-120 PIC X(120). SQ2034.2 +008400 FD SQ-FS3 SQ2034.2 +008500*C LABEL RECORDS ARE STANDARD SQ2034.2 +008600 BLOCK CONTAINS 120 CHARACTERS. SQ2034.2 +008700 01 SQ-FS3R1-F-G-120 PIC X(120). SQ2034.2 +008800 FD SQ-FS4 SQ2034.2 +008900*C LABEL RECORDS ARE STANDARD SQ2034.2 +009000 BLOCK CONTAINS 120 CHARACTERS. SQ2034.2 +009100 01 SQ-FS4R1-F-G-120 PIC X(120). SQ2034.2 +009200 WORKING-STORAGE SECTION. SQ2034.2 +009300 01 COUNT-OF-RECS PIC 9999. SQ2034.2 +009400 01 EOF-FLAG PIC 99 VALUE 0. SQ2034.2 +009500 01 GRP-STATUS-KEY-1. SQ2034.2 +009600 02 WRK-XN-00001-KEY-1 PIC X. SQ2034.2 +009700 02 FILLER PIC X. SQ2034.2 +009800 01 GRP-STATUS-KEY-2. SQ2034.2 +009900 02 WRK-XN-00001-KEY-2 PIC X. SQ2034.2 +010000 02 FILLER PIC X. SQ2034.2 +010100 01 GRP-STATUS-KEY-3. SQ2034.2 +010200 02 WRK-XN-00001-KEY-3 PIC X. SQ2034.2 +010300 02 FILLER PIC X. SQ2034.2 +010400 01 FILE-RECORD-INFORMATION-REC. SQ2034.2 +010500 03 FILE-RECORD-INFO-SKELETON. SQ2034.2 +010600 05 FILLER PICTURE X(48) VALUE SQ2034.2 +010700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2034.2 +010800 05 FILLER PICTURE X(46) VALUE SQ2034.2 +010900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2034.2 +011000 05 FILLER PICTURE X(26) VALUE SQ2034.2 +011100 ",LFIL=000000,ORG= ,LBLR= ". SQ2034.2 +011200 05 FILLER PICTURE X(37) VALUE SQ2034.2 +011300 ",RECKEY= ". SQ2034.2 +011400 05 FILLER PICTURE X(38) VALUE SQ2034.2 +011500 ",ALTKEY1= ". SQ2034.2 +011600 05 FILLER PICTURE X(38) VALUE SQ2034.2 +011700 ",ALTKEY2= ". SQ2034.2 +011800 05 FILLER PICTURE X(7) VALUE SPACE.SQ2034.2 +011900 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2034.2 +012000 05 FILE-RECORD-INFO-P1-120. SQ2034.2 +012100 07 FILLER PIC X(5). SQ2034.2 +012200 07 XFILE-NAME PIC X(6). SQ2034.2 +012300 07 FILLER PIC X(8). SQ2034.2 +012400 07 XRECORD-NAME PIC X(6). SQ2034.2 +012500 07 FILLER PIC X(1). SQ2034.2 +012600 07 REELUNIT-NUMBER PIC 9(1). SQ2034.2 +012700 07 FILLER PIC X(7). SQ2034.2 +012800 07 XRECORD-NUMBER PIC 9(6). SQ2034.2 +012900 07 FILLER PIC X(6). SQ2034.2 +013000 07 UPDATE-NUMBER PIC 9(2). SQ2034.2 +013100 07 FILLER PIC X(5). SQ2034.2 +013200 07 ODO-NUMBER PIC 9(4). SQ2034.2 +013300 07 FILLER PIC X(5). SQ2034.2 +013400 07 XPROGRAM-NAME PIC X(5). SQ2034.2 +013500 07 FILLER PIC X(7). SQ2034.2 +013600 07 XRECORD-LENGTH PIC 9(6). SQ2034.2 +013700 07 FILLER PIC X(7). SQ2034.2 +013800 07 CHARS-OR-RECORDS PIC X(2). SQ2034.2 +013900 07 FILLER PIC X(1). SQ2034.2 +014000 07 XBLOCK-SIZE PIC 9(4). SQ2034.2 +014100 07 FILLER PIC X(6). SQ2034.2 +014200 07 RECORDS-IN-FILE PIC 9(6). SQ2034.2 +014300 07 FILLER PIC X(5). SQ2034.2 +014400 07 XFILE-ORGANIZATION PIC X(2). SQ2034.2 +014500 07 FILLER PIC X(6). SQ2034.2 +014600 07 XLABEL-TYPE PIC X(1). SQ2034.2 +014700 05 FILE-RECORD-INFO-P121-240. SQ2034.2 +014800 07 FILLER PIC X(8). SQ2034.2 +014900 07 XRECORD-KEY PIC X(29). SQ2034.2 +015000 07 FILLER PIC X(9). SQ2034.2 +015100 07 ALTERNATE-KEY1 PIC X(29). SQ2034.2 +015200 07 FILLER PIC X(9). SQ2034.2 +015300 07 ALTERNATE-KEY2 PIC X(29). SQ2034.2 +015400 07 FILLER PIC X(7). SQ2034.2 +015500 01 TEST-RESULTS. SQ2034.2 +015600 02 FILLER PICTURE X VALUE SPACE. SQ2034.2 +015700 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2034.2 +015800 02 FILLER PICTURE X VALUE SPACE. SQ2034.2 +015900 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2034.2 +016000 02 FILLER PICTURE X VALUE SPACE. SQ2034.2 +016100 02 PAR-NAME. SQ2034.2 +016200 03 FILLER PICTURE X(12) VALUE SPACE. SQ2034.2 +016300 03 PARDOT-X PICTURE X VALUE SPACE. SQ2034.2 +016400 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2034.2 +016500 03 FILLER PIC X(5) VALUE SPACE. SQ2034.2 +016600 02 FILLER PIC X(10) VALUE SPACE. SQ2034.2 +016700 02 RE-MARK PIC X(61). SQ2034.2 +016800 01 TEST-COMPUTED. SQ2034.2 +016900 02 FILLER PIC X(30) VALUE SPACE. SQ2034.2 +017000 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2034.2 +017100 02 COMPUTED-X. SQ2034.2 +017200 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2034.2 +017300 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2034.2 +017400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2034.2 +017500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2034.2 +017600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2034.2 +017700 03 CM-18V0 REDEFINES COMPUTED-A. SQ2034.2 +017800 04 COMPUTED-18V0 PICTURE -9(18). SQ2034.2 +017900 04 FILLER PICTURE X. SQ2034.2 +018000 03 FILLER PIC X(50) VALUE SPACE. SQ2034.2 +018100 01 TEST-CORRECT. SQ2034.2 +018200 02 FILLER PIC X(30) VALUE SPACE. SQ2034.2 +018300 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2034.2 +018400 02 CORRECT-X. SQ2034.2 +018500 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2034.2 +018600 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2034.2 +018700 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2034.2 +018800 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2034.2 +018900 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2034.2 +019000 03 CR-18V0 REDEFINES CORRECT-A. SQ2034.2 +019100 04 CORRECT-18V0 PICTURE -9(18). SQ2034.2 +019200 04 FILLER PICTURE X. SQ2034.2 +019300 03 FILLER PIC X(50) VALUE SPACE. SQ2034.2 +019400 01 CCVS-C-1. SQ2034.2 +019500 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2034.2 +019600- "SS PARAGRAPH-NAME SQ2034.2 +019700- " REMARKS". SQ2034.2 +019800 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2034.2 +019900 01 CCVS-C-2. SQ2034.2 +020000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2034.2 +020100 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2034.2 +020200 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2034.2 +020300 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2034.2 +020400 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2034.2 +020500 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2034.2 +020600 01 REC-CT PICTURE 99 VALUE ZERO. SQ2034.2 +020700 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2034.2 +020800 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2034.2 +020900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2034.2 +021000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2034.2 +021100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2034.2 +021200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2034.2 +021300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2034.2 +021400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2034.2 +021500 01 CCVS-H-1. SQ2034.2 +021600 02 FILLER PICTURE X(27) VALUE SPACE. SQ2034.2 +021700 02 FILLER PICTURE X(67) VALUE SQ2034.2 +021800 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2034.2 +021900- " SYSTEM". SQ2034.2 +022000 02 FILLER PICTURE X(26) VALUE SPACE. SQ2034.2 +022100 01 CCVS-H-2. SQ2034.2 +022200 02 FILLER PICTURE X(52) VALUE IS SQ2034.2 +022300 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2034.2 +022400 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2034.2 +022500 02 TEST-ID PICTURE IS X(9). SQ2034.2 +022600 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2034.2 +022700 01 CCVS-H-3. SQ2034.2 +022800 02 FILLER PICTURE X(34) VALUE SQ2034.2 +022900 " FOR OFFICIAL USE ONLY ". SQ2034.2 +023000 02 FILLER PICTURE X(58) VALUE SQ2034.2 +023100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2034.2 +023200 02 FILLER PICTURE X(28) VALUE SQ2034.2 +023300 " COPYRIGHT 1985 ". SQ2034.2 +023400 01 CCVS-E-1. SQ2034.2 +023500 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2034.2 +023600 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2034.2 +023700 02 ID-AGAIN PICTURE IS X(9). SQ2034.2 +023800 02 FILLER PICTURE X(45) VALUE IS SQ2034.2 +023900 " NTIS DISTRIBUTION COBOL 85". SQ2034.2 +024000 01 CCVS-E-2. SQ2034.2 +024100 02 FILLER PICTURE X(31) VALUE SQ2034.2 +024200 SPACE. SQ2034.2 +024300 02 FILLER PICTURE X(21) VALUE SPACE. SQ2034.2 +024400 02 CCVS-E-2-2. SQ2034.2 +024500 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2034.2 +024600 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2034.2 +024700 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2034.2 +024800 01 CCVS-E-3. SQ2034.2 +024900 02 FILLER PICTURE X(22) VALUE SQ2034.2 +025000 " FOR OFFICIAL USE ONLY". SQ2034.2 +025100 02 FILLER PICTURE X(12) VALUE SPACE. SQ2034.2 +025200 02 FILLER PICTURE X(58) VALUE SQ2034.2 +025300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2034.2 +025400 02 FILLER PICTURE X(13) VALUE SPACE. SQ2034.2 +025500 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2034.2 +025600 01 CCVS-E-4. SQ2034.2 +025700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2034.2 +025800 02 FILLER PIC XXXX VALUE " OF ". SQ2034.2 +025900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2034.2 +026000 02 FILLER PIC X(40) VALUE SQ2034.2 +026100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2034.2 +026200 01 XXINFO. SQ2034.2 +026300 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2034.2 +026400 02 INFO-TEXT. SQ2034.2 +026500 04 FILLER PIC X(20) VALUE SPACE. SQ2034.2 +026600 04 XXCOMPUTED PIC X(20). SQ2034.2 +026700 04 FILLER PIC X(5) VALUE SPACE. SQ2034.2 +026800 04 XXCORRECT PIC X(20). SQ2034.2 +026900 01 HYPHEN-LINE. SQ2034.2 +027000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2034.2 +027100 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2034.2 +027200- "*****************************************". SQ2034.2 +027300 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2034.2 +027400- "******************************". SQ2034.2 +027500 01 CCVS-PGM-ID PIC X(6) VALUE SQ2034.2 +027600 "SQ203A". SQ2034.2 +027700 PROCEDURE DIVISION. SQ2034.2 +027800 DECLARATIVES. SQ2034.2 +027900 USE-1 SECTION. SQ2034.2 +028000 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. SQ2034.2 +028100 USE-1-PROCEDURE. SQ2034.2 +028200 IF WRK-XN-00001-KEY-2 EQUAL TO "1" SQ2034.2 +028300 MOVE 1 TO EOF-FLAG. SQ2034.2 +028400 END DECLARATIVES. SQ2034.2 +028500 CCVS1 SECTION. SQ2034.2 +028600 OPEN-FILES. SQ2034.2 +028700*P OPEN I-O RAW-DATA. SQ2034.2 +028800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2034.2 +028900*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2034.2 +029000*P MOVE "ABORTED " TO C-ABORT. SQ2034.2 +029100*P ADD 1 TO C-NO-OF-TESTS. SQ2034.2 +029200*P ACCEPT C-DATE FROM DATE. SQ2034.2 +029300*P ACCEPT C-TIME FROM TIME. SQ2034.2 +029400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2034.2 +029500*PND-E-1. SQ2034.2 +029600*P CLOSE RAW-DATA. SQ2034.2 +029700 OPEN OUTPUT PRINT-FILE. SQ2034.2 +029800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2034.2 +029900 MOVE SPACE TO TEST-RESULTS. SQ2034.2 +030000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2034.2 +030100 MOVE ZERO TO REC-SKL-SUB. SQ2034.2 +030200 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2034.2 +030300 CCVS-INIT-FILE. SQ2034.2 +030400 ADD 1 TO REC-SKL-SUB. SQ2034.2 +030500 MOVE FILE-RECORD-INFO-SKELETON TO SQ2034.2 +030600 FILE-RECORD-INFO (REC-SKL-SUB). SQ2034.2 +030700 CCVS-INIT-EXIT. SQ2034.2 +030800 GO TO CCVS1-EXIT. SQ2034.2 +030900 CLOSE-FILES. SQ2034.2 +031000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2034.2 +031100*P OPEN I-O RAW-DATA. SQ2034.2 +031200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2034.2 +031300*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2034.2 +031400*P MOVE "OK. " TO C-ABORT. SQ2034.2 +031500*P MOVE PASS-COUNTER TO C-OK. SQ2034.2 +031600*P MOVE ERROR-HOLD TO C-ALL. SQ2034.2 +031700*P MOVE ERROR-COUNTER TO C-FAIL. SQ2034.2 +031800*P MOVE DELETE-CNT TO C-DELETED. SQ2034.2 +031900*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2034.2 +032000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2034.2 +032100*PND-E-2. SQ2034.2 +032200*P CLOSE RAW-DATA. SQ2034.2 +032300 TERMINATE-CCVS. SQ2034.2 +032400*S EXIT PROGRAM. SQ2034.2 +032500*SERMINATE-CALL. SQ2034.2 +032600 STOP RUN. SQ2034.2 +032700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2034.2 +032800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2034.2 +032900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2034.2 +033000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2034.2 +033100 MOVE "****TEST DELETED****" TO RE-MARK. SQ2034.2 +033200 PRINT-DETAIL. SQ2034.2 +033300 IF REC-CT NOT EQUAL TO ZERO SQ2034.2 +033400 MOVE "." TO PARDOT-X SQ2034.2 +033500 MOVE REC-CT TO DOTVALUE. SQ2034.2 +033600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2034.2 +033700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2034.2 +033800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2034.2 +033900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2034.2 +034000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2034.2 +034100 MOVE SPACE TO CORRECT-X. SQ2034.2 +034200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2034.2 +034300 MOVE SPACE TO RE-MARK. SQ2034.2 +034400 HEAD-ROUTINE. SQ2034.2 +034500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +034600 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2034.2 +034700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2034.2 +034800 COLUMN-NAMES-ROUTINE. SQ2034.2 +034900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +035000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +035100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +035200 END-ROUTINE. SQ2034.2 +035300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2034.2 +035400 END-RTN-EXIT. SQ2034.2 +035500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +035600 END-ROUTINE-1. SQ2034.2 +035700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2034.2 +035800 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2034.2 +035900 ADD PASS-COUNTER TO ERROR-HOLD. SQ2034.2 +036000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2034.2 +036100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2034.2 +036200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2034.2 +036300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2034.2 +036400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2034.2 +036500 END-ROUTINE-12. SQ2034.2 +036600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2034.2 +036700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2034.2 +036800 MOVE "NO " TO ERROR-TOTAL SQ2034.2 +036900 ELSE SQ2034.2 +037000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2034.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2034.2 +037200 PERFORM WRITE-LINE. SQ2034.2 +037300 END-ROUTINE-13. SQ2034.2 +037400 IF DELETE-CNT IS EQUAL TO ZERO SQ2034.2 +037500 MOVE "NO " TO ERROR-TOTAL ELSE SQ2034.2 +037600 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2034.2 +037700 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2034.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +037900 IF INSPECT-COUNTER EQUAL TO ZERO SQ2034.2 +038000 MOVE "NO " TO ERROR-TOTAL SQ2034.2 +038100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2034.2 +038200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2034.2 +038300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +038400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2034.2 +038500 WRITE-LINE. SQ2034.2 +038600 ADD 1 TO RECORD-COUNT. SQ2034.2 +038700 IF RECORD-COUNT GREATER 50 SQ2034.2 +038800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2034.2 +038900 MOVE SPACE TO DUMMY-RECORD SQ2034.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2034.2 +039100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2034.2 +039200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2034.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2034.2 +039400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2034.2 +039500 MOVE ZERO TO RECORD-COUNT. SQ2034.2 +039600 PERFORM WRT-LN. SQ2034.2 +039700 WRT-LN. SQ2034.2 +039800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2034.2 +039900 MOVE SPACE TO DUMMY-RECORD. SQ2034.2 +040000 BLANK-LINE-PRINT. SQ2034.2 +040100 PERFORM WRT-LN. SQ2034.2 +040200 FAIL-ROUTINE. SQ2034.2 +040300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2034.2 +040400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2034.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2034.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +040700 GO TO FAIL-ROUTINE-EX. SQ2034.2 +040800 FAIL-ROUTINE-WRITE. SQ2034.2 +040900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2034.2 +041000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +041100 FAIL-ROUTINE-EX. EXIT. SQ2034.2 +041200 BAIL-OUT. SQ2034.2 +041300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2034.2 +041400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2034.2 +041500 BAIL-OUT-WRITE. SQ2034.2 +041600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2034.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2034.2 +041800 BAIL-OUT-EX. EXIT. SQ2034.2 +041900 CCVS1-EXIT. SQ2034.2 +042000 EXIT. SQ2034.2 +042100 SECT-SQ203A-0001 SECTION. SQ2034.2 +042200 READ-INIT-GF-01. SQ2034.2 +042300* THIS IS A TEST FOR SELECT OPTIONAL SQ-FS1. IN SQ2034.2 +042400* THIS TEST THE FILE IS PRESENT THEREFORE IT SHOULD SQ2034.2 +042500* OPEN AND HAVE THE FIRST RECORD READ CORRECTLY SQ2034.2 +042600* WITHOUT TRANSFERING CONTROL TO THE AT END CONDITION.SQ2034.2 +042700 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2034.2 +042800 MOVE "SELECT OPTIONAL F-N" TO FEATURE. SQ2034.2 +042900 MOVE "FILE PRESENT" TO RE-MARK. SQ2034.2 +043000 READ-TEST-GF-01. SQ2034.2 +043100 OPEN INPUT SQ-FS1. SQ2034.2 +043200 READ SQ-FS1 ; AT END GO TO READ-FAIL-GF-01. SQ2034.2 +043300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2034.2 +043400 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2034.2 +043500 MOVE "INVALID XFILE-NAME" TO RE-MARK SQ2034.2 +043600 GO TO READ-FAIL-GF-01. SQ2034.2 +043700 IF XRECORD-NUMBER (1) NOT EQUAL TO 1 SQ2034.2 +043800 MOVE "INVALID RECORD NUMBER" TO RE-MARK SQ2034.2 +043900 GO TO READ-FAIL-GF-01. SQ2034.2 +044000 GO TO READ-PASS-GF-01. SQ2034.2 +044100 READ-DELETE-GF-01. SQ2034.2 +044200 PERFORM DE-LETE. SQ2034.2 +044300 GO TO READ-WRITE-GF-01. SQ2034.2 +044400 READ-FAIL-GF-01. SQ2034.2 +044500 MOVE "VII-7 2.3.2; VII-8 2.3.4 (2); GR (4) B, (10)" SQ2034.2 +044600 TO RE-MARK. SQ2034.2 +044700 PERFORM FAIL. SQ2034.2 +044800 CLOSE SQ-FS1. SQ2034.2 +044900 GO TO READ-WRITE-GF-01. SQ2034.2 +045000 READ-PASS-GF-01. SQ2034.2 +045100 PERFORM PASS. SQ2034.2 +045200 CLOSE SQ-FS1. SQ2034.2 +045300 READ-WRITE-GF-01. SQ2034.2 +045400 PERFORM PRINT-DETAIL. SQ2034.2 +045500 READ-INIT-GF-02. SQ2034.2 +045600* THIS IS A TEST FOR SELECT OPTIONAL SQ-FS4 IN SQ2034.2 +045700* WHICH THE FIRST READ STATEMENT HAS AN AT END PHRASE.SQ2034.2 +045800* IN THIS TEST THE SELECTED FILE IS NOT PRESENT. SQ2034.2 +045900 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2034.2 +046000 MOVE "SELECT OPTIONAL F-N" TO FEATURE. SQ2034.2 +046100 MOVE "FILE NOT PRESENT" TO RE-MARK. SQ2034.2 +046200 READ-TEST-GF-02. SQ2034.2 +046300 OPEN INPUT SQ-FS4. SQ2034.2 +046400 READ SQ-FS4 ; AT END GO TO READ-PASS-GF-02. SQ2034.2 +046500 GO TO READ-FAIL-GF-02. SQ2034.2 +046600 READ-DELETE-GF-02. SQ2034.2 +046700 PERFORM DE-LETE. SQ2034.2 +046800 GO TO READ-WRITE-GF-02. SQ2034.2 +046900 READ-FAIL-GF-02. SQ2034.2 +047000 MOVE "VII-7 2.3.2; VII-8 2.3.4 (2); GR (4) B, (10)" SQ2034.2 +047100 TO RE-MARK. SQ2034.2 +047200 PERFORM FAIL. SQ2034.2 +047300 CLOSE SQ-FS4. SQ2034.2 +047400 GO TO READ-WRITE-GF-02. SQ2034.2 +047500 READ-PASS-GF-02. SQ2034.2 +047600 PERFORM PASS. SQ2034.2 +047700 CLOSE SQ-FS4. SQ2034.2 +047800 READ-WRITE-GF-02. SQ2034.2 +047900 PERFORM PRINT-DETAIL. SQ2034.2 +048000 READ-INIT-GF-03. SQ2034.2 +048100* THIS IS A TEST FOR SELECT OPTIONAL SQ-FS2 IN SQ2034.2 +048200* WHICH THE FIRST READ STATEMENT DOES NOT HAVE AN AT SQ2034.2 +048300* END PHRASE. INSTEAD A USE STATEMENT IS SPECIFIED. SQ2034.2 +048400* IN THIS TEST THE SELECTED FILE IS NOT PRESENT. SQ2034.2 +048500 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ2034.2 +048600 MOVE "SELECT OPTIONAL F-N" TO FEATURE. SQ2034.2 +048700 MOVE "FILE NOT PRESENT" TO RE-MARK. SQ2034.2 +048800 READ-TEST-GF-03. SQ2034.2 +048900 OPEN INPUT SQ-FS2. SQ2034.2 +049000 READ SQ-FS2. SQ2034.2 +049100 IF EOF-FLAG EQUAL TO 1 SQ2034.2 +049200 GO TO READ-PASS-GF-03. SQ2034.2 +049300 GO TO READ-FAIL-GF-03. SQ2034.2 +049400 READ-DELETE-GF-03. SQ2034.2 +049500 PERFORM DE-LETE. SQ2034.2 +049600 GO TO READ-WRITE-GF-03. SQ2034.2 +049700 READ-FAIL-GF-03. SQ2034.2 +049800 MOVE "VII-7 2.3.2; VII-8 2.3.4 (2); GR (4) B, (10)" SQ2034.2 +049900 TO RE-MARK. SQ2034.2 +050000 PERFORM FAIL. SQ2034.2 +050100 MOVE WRK-XN-00001-KEY-2 TO COMPUTED-A. SQ2034.2 +050200 MOVE "1" TO CORRECT-A. SQ2034.2 +050300 CLOSE SQ-FS2. SQ2034.2 +050400 GO TO READ-WRITE-GF-03. SQ2034.2 +050500 READ-PASS-GF-03. SQ2034.2 +050600 PERFORM PASS. SQ2034.2 +050700 MOVE WRK-XN-00001-KEY-2 TO COMPUTED-A. SQ2034.2 +050800 MOVE "1" TO CORRECT-A. SQ2034.2 +050900 CLOSE SQ-FS2. SQ2034.2 +051000 READ-WRITE-GF-03. SQ2034.2 +051100 PERFORM PRINT-DETAIL. SQ2034.2 +051200 READ-INIT-GF-04. SQ2034.2 +051300* THIS TEST IS USED TO CHECK OUT THE RESERVE INTEGER SQ2034.2 +051400* AREA CLAUSE IN THE FILE-CONTROL ENTRY. SQ2034.2 +051500 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ2034.2 +051600 MOVE "RESERVE INTEGER AREA" TO FEATURE. SQ2034.2 +051700 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ2034.2 +051800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2034.2 +051900 MOVE "SQ203A" TO XPROGRAM-NAME (1). SQ2034.2 +052000 MOVE 000120 TO XRECORD-LENGTH (1). SQ2034.2 +052100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2034.2 +052200 MOVE 0001 TO XBLOCK-SIZE (1). SQ2034.2 +052300 MOVE 000750 TO RECORDS-IN-FILE (1). SQ2034.2 +052400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2034.2 +052500 MOVE "S" TO XLABEL-TYPE (1). SQ2034.2 +052600 MOVE 000001 TO XRECORD-NUMBER (1). SQ2034.2 +052700 READ-TEST-GF-04-01. SQ2034.2 +052800 OPEN OUTPUT SQ-FS3. SQ2034.2 +052900 READ-TEST-GF-04-02. SQ2034.2 +053000 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ2034.2 +053100 WRITE SQ-FS3R1-F-G-120. SQ2034.2 +053200 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2034.2 +053300 GO TO READ-TEST-GF-04-03. SQ2034.2 +053400 ADD 1 TO XRECORD-NUMBER (1). SQ2034.2 +053500 GO TO READ-TEST-GF-04-02. SQ2034.2 +053600 READ-TEST-GF-04-03. SQ2034.2 +053700 CLOSE SQ-FS3. SQ2034.2 +053800 PERFORM PASS. SQ2034.2 +053900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2034.2 +054000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2034.2 +054100 GO TO READ-WRITE-GF-04. SQ2034.2 +054200 READ-DELETE-GF-04. SQ2034.2 +054300 PERFORM DE-LETE. SQ2034.2 +054400 READ-WRITE-GF-04. SQ2034.2 +054500 PERFORM PRINT-DETAIL. SQ2034.2 +054600 SQ203A-END-ROUTINE. SQ2034.2 +054700 MOVE "END OF SQ203A VALIDATION TESTS" TO PRINT-REC. SQ2034.2 +054800 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2034.2 +054900 TERMINATE-SQ203A. SQ2034.2 +055000 EXIT. SQ2034.2 +055100 CCVS-EXIT SECTION. SQ2034.2 +055200 CCVS-999999. SQ2034.2 +055300 GO TO CLOSE-FILES. SQ2034.2 diff --git a/tests/cobol85/SQ/SQ204A.CBL b/tests/cobol85/SQ/SQ204A.CBL new file mode 100755 index 00000000..9cf23345 --- /dev/null +++ b/tests/cobol85/SQ/SQ204A.CBL @@ -0,0 +1,617 @@ +000100 IDENTIFICATION DIVISION. SQ2044.2 +000200 PROGRAM-ID. SQ2044.2 +000300 SQ204A. SQ2044.2 +000400**************************************************************** SQ2044.2 +000500* * SQ2044.2 +000600* VALIDATION FOR:- * SQ2044.2 +000700* " HIGH ". SQ2044.2 +000800* * SQ2044.2 +000900* CREATION DATE / VALIDATION DATE * SQ2044.2 +001000* "4.2 ". SQ2044.2 +001100* * SQ2044.2 +001200* THIS ROUTINE TESTS THE USE OF THE OPEN EXTEND SQ2044.2 +001300* STATEMENT FOR BOTH MAGNETIC TAPE AND MASS STORAGE. FILES SQ2044.2 +001400* ARE FIRST CREATED USING THE NORMAL OPEN OUTPUT STATEMENT SQ2044.2 +001500* SQ2044.2 +001600 ENVIRONMENT DIVISION. SQ2044.2 +001700 CONFIGURATION SECTION. SQ2044.2 +001800 SOURCE-COMPUTER. SQ2044.2 +001900 Linux. SQ2044.2 +002000 OBJECT-COMPUTER. SQ2044.2 +002100 Linux. SQ2044.2 +002200 INPUT-OUTPUT SECTION. SQ2044.2 +002300 FILE-CONTROL. SQ2044.2 +002400*P SELECT RAW-DATA ASSIGN TO SQ2044.2 +002500*P "XXXXX062" SQ2044.2 +002600*P ORGANIZATION IS INDEXED SQ2044.2 +002700*P ACCESS MODE IS RANDOM SQ2044.2 +002800*P RECORD KEY IS RAW-DATA-KEY. SQ2044.2 +002900 SELECT PRINT-FILE ASSIGN TO SQ2044.2 +003000 "report.log". SQ2044.2 +003100 SELECT SQ-FS1 ASSIGN TO SQ2044.2 +003200 "XXXXX001" SQ2044.2 +003300 ORGANIZATION IS SEQUENTIAL SQ2044.2 +003400 ACCESS MODE IS SEQUENTIAL. SQ2044.2 +003500 SELECT SQ-FS2 ASSIGN TO SQ2044.2 +003600 "XXXXX014" SQ2044.2 +003700 ORGANIZATION IS SEQUENTIAL SQ2044.2 +003800 ACCESS MODE IS SEQUENTIAL. SQ2044.2 +003900 DATA DIVISION. SQ2044.2 +004000 FILE SECTION. SQ2044.2 +004100*P SQ2044.2 +004200*PD RAW-DATA. SQ2044.2 +004300*P SQ2044.2 +004400*P1 RAW-DATA-SATZ. SQ2044.2 +004500*P 05 RAW-DATA-KEY PIC X(6). SQ2044.2 +004600*P 05 C-DATE PIC 9(6). SQ2044.2 +004700*P 05 C-TIME PIC 9(8). SQ2044.2 +004800*P 05 C-NO-OF-TESTS PIC 99. SQ2044.2 +004900*P 05 C-OK PIC 999. SQ2044.2 +005000*P 05 C-ALL PIC 999. SQ2044.2 +005100*P 05 C-FAIL PIC 999. SQ2044.2 +005200*P 05 C-DELETED PIC 999. SQ2044.2 +005300*P 05 C-INSPECT PIC 999. SQ2044.2 +005400*P 05 C-NOTE PIC X(13). SQ2044.2 +005500*P 05 C-INDENT PIC X. SQ2044.2 +005600*P 05 C-ABORT PIC X(8). SQ2044.2 +005700 FD PRINT-FILE SQ2044.2 +005800*C LABEL RECORDS SQ2044.2 +005900*C OMITTED SQ2044.2 +006000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2044.2 +006100 . SQ2044.2 +006200 01 PRINT-REC PICTURE X(120). SQ2044.2 +006300 01 DUMMY-RECORD PICTURE X(120). SQ2044.2 +006400 FD SQ-FS1 SQ2044.2 +006500*C LABEL RECORDS ARE STANDARD SQ2044.2 +006600 BLOCK CONTAINS 126 CHARACTERS. SQ2044.2 +006700 01 SQ-FS1R1-F-G-126. SQ2044.2 +006800 02 SQ-FS1R1-F-G-120 PIC X(120). SQ2044.2 +006900 02 SQ-FS1R1-F-G-006 PIC X(6). SQ2044.2 +007000 FD SQ-FS2 SQ2044.2 +007100*C LABEL RECORDS ARE STANDARD SQ2044.2 +007200 BLOCK CONTAINS 126 CHARACTERS. SQ2044.2 +007300 01 SQ-FS2R1-F-G-126. SQ2044.2 +007400 02 SQ-FS2R1-F-G-120 PIC X(120). SQ2044.2 +007500 02 SQ-FS2R1-F-G-006 PIC X(6). SQ2044.2 +007600 WORKING-STORAGE SECTION. SQ2044.2 +007700 77 RECORDS-IN-ERROR PIC 9(4) VALUE 0. SQ2044.2 +007800 77 WRK-RECORD-COUNT PIC 9(4) VALUE 0. SQ2044.2 +007900 01 COUNT-OF-RECS PIC 9999. SQ2044.2 +008000 01 FILE-RECORD-INFORMATION-REC. SQ2044.2 +008100 03 FILE-RECORD-INFO-SKELETON. SQ2044.2 +008200 05 FILLER PICTURE X(48) VALUE SQ2044.2 +008300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2044.2 +008400 05 FILLER PICTURE X(46) VALUE SQ2044.2 +008500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2044.2 +008600 05 FILLER PICTURE X(26) VALUE SQ2044.2 +008700 ",LFIL=000000,ORG= ,LBLR= ". SQ2044.2 +008800 05 FILLER PICTURE X(37) VALUE SQ2044.2 +008900 ",RECKEY= ". SQ2044.2 +009000 05 FILLER PICTURE X(38) VALUE SQ2044.2 +009100 ",ALTKEY1= ". SQ2044.2 +009200 05 FILLER PICTURE X(38) VALUE SQ2044.2 +009300 ",ALTKEY2= ". SQ2044.2 +009400 05 FILLER PICTURE X(7) VALUE SPACE.SQ2044.2 +009500 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2044.2 +009600 05 FILE-RECORD-INFO-P1-120. SQ2044.2 +009700 07 FILLER PIC X(5). SQ2044.2 +009800 07 XFILE-NAME PIC X(6). SQ2044.2 +009900 07 FILLER PIC X(8). SQ2044.2 +010000 07 XRECORD-NAME PIC X(6). SQ2044.2 +010100 07 FILLER PIC X(1). SQ2044.2 +010200 07 REELUNIT-NUMBER PIC 9(1). SQ2044.2 +010300 07 FILLER PIC X(7). SQ2044.2 +010400 07 XRECORD-NUMBER PIC 9(6). SQ2044.2 +010500 07 FILLER PIC X(6). SQ2044.2 +010600 07 UPDATE-NUMBER PIC 9(2). SQ2044.2 +010700 07 FILLER PIC X(5). SQ2044.2 +010800 07 ODO-NUMBER PIC 9(4). SQ2044.2 +010900 07 FILLER PIC X(5). SQ2044.2 +011000 07 XPROGRAM-NAME PIC X(5). SQ2044.2 +011100 07 FILLER PIC X(7). SQ2044.2 +011200 07 XRECORD-LENGTH PIC 9(6). SQ2044.2 +011300 07 FILLER PIC X(7). SQ2044.2 +011400 07 CHARS-OR-RECORDS PIC X(2). SQ2044.2 +011500 07 FILLER PIC X(1). SQ2044.2 +011600 07 XBLOCK-SIZE PIC 9(4). SQ2044.2 +011700 07 FILLER PIC X(6). SQ2044.2 +011800 07 RECORDS-IN-FILE PIC 9(6). SQ2044.2 +011900 07 FILLER PIC X(5). SQ2044.2 +012000 07 XFILE-ORGANIZATION PIC X(2). SQ2044.2 +012100 07 FILLER PIC X(6). SQ2044.2 +012200 07 XLABEL-TYPE PIC X(1). SQ2044.2 +012300 05 FILE-RECORD-INFO-P121-240. SQ2044.2 +012400 07 FILLER PIC X(8). SQ2044.2 +012500 07 XRECORD-KEY PIC X(29). SQ2044.2 +012600 07 FILLER PIC X(9). SQ2044.2 +012700 07 ALTERNATE-KEY1 PIC X(29). SQ2044.2 +012800 07 FILLER PIC X(9). SQ2044.2 +012900 07 ALTERNATE-KEY2 PIC X(29). SQ2044.2 +013000 07 FILLER PIC X(7). SQ2044.2 +013100 01 TEST-RESULTS. SQ2044.2 +013200 02 FILLER PICTURE X VALUE SPACE. SQ2044.2 +013300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2044.2 +013400 02 FILLER PICTURE X VALUE SPACE. SQ2044.2 +013500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2044.2 +013600 02 FILLER PICTURE X VALUE SPACE. SQ2044.2 +013700 02 PAR-NAME. SQ2044.2 +013800 03 FILLER PICTURE X(12) VALUE SPACE. SQ2044.2 +013900 03 PARDOT-X PICTURE X VALUE SPACE. SQ2044.2 +014000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2044.2 +014100 03 FILLER PIC X(5) VALUE SPACE. SQ2044.2 +014200 02 FILLER PIC X(10) VALUE SPACE. SQ2044.2 +014300 02 RE-MARK PIC X(61). SQ2044.2 +014400 01 TEST-COMPUTED. SQ2044.2 +014500 02 FILLER PIC X(30) VALUE SPACE. SQ2044.2 +014600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2044.2 +014700 02 COMPUTED-X. SQ2044.2 +014800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2044.2 +014900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2044.2 +015000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2044.2 +015100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2044.2 +015200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2044.2 +015300 03 CM-18V0 REDEFINES COMPUTED-A. SQ2044.2 +015400 04 COMPUTED-18V0 PICTURE -9(18). SQ2044.2 +015500 04 FILLER PICTURE X. SQ2044.2 +015600 03 FILLER PIC X(50) VALUE SPACE. SQ2044.2 +015700 01 TEST-CORRECT. SQ2044.2 +015800 02 FILLER PIC X(30) VALUE SPACE. SQ2044.2 +015900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2044.2 +016000 02 CORRECT-X. SQ2044.2 +016100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2044.2 +016200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2044.2 +016300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2044.2 +016400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2044.2 +016500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2044.2 +016600 03 CR-18V0 REDEFINES CORRECT-A. SQ2044.2 +016700 04 CORRECT-18V0 PICTURE -9(18). SQ2044.2 +016800 04 FILLER PICTURE X. SQ2044.2 +016900 03 FILLER PIC X(50) VALUE SPACE. SQ2044.2 +017000 01 CCVS-C-1. SQ2044.2 +017100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2044.2 +017200- "SS PARAGRAPH-NAME SQ2044.2 +017300- " REMARKS". SQ2044.2 +017400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2044.2 +017500 01 CCVS-C-2. SQ2044.2 +017600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2044.2 +017700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2044.2 +017800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2044.2 +017900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2044.2 +018000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2044.2 +018100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2044.2 +018200 01 REC-CT PICTURE 99 VALUE ZERO. SQ2044.2 +018300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2044.2 +018400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2044.2 +018500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2044.2 +018600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2044.2 +018700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2044.2 +018800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2044.2 +018900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2044.2 +019000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2044.2 +019100 01 CCVS-H-1. SQ2044.2 +019200 02 FILLER PICTURE X(27) VALUE SPACE. SQ2044.2 +019300 02 FILLER PICTURE X(67) VALUE SQ2044.2 +019400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2044.2 +019500- " SYSTEM". SQ2044.2 +019600 02 FILLER PICTURE X(26) VALUE SPACE. SQ2044.2 +019700 01 CCVS-H-2. SQ2044.2 +019800 02 FILLER PICTURE X(52) VALUE IS SQ2044.2 +019900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2044.2 +020000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2044.2 +020100 02 TEST-ID PICTURE IS X(9). SQ2044.2 +020200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2044.2 +020300 01 CCVS-H-3. SQ2044.2 +020400 02 FILLER PICTURE X(34) VALUE SQ2044.2 +020500 " FOR OFFICIAL USE ONLY ". SQ2044.2 +020600 02 FILLER PICTURE X(58) VALUE SQ2044.2 +020700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2044.2 +020800 02 FILLER PICTURE X(28) VALUE SQ2044.2 +020900 " COPYRIGHT 1985 ". SQ2044.2 +021000 01 CCVS-E-1. SQ2044.2 +021100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2044.2 +021200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2044.2 +021300 02 ID-AGAIN PICTURE IS X(9). SQ2044.2 +021400 02 FILLER PICTURE X(45) VALUE IS SQ2044.2 +021500 " NTIS DISTRIBUTION COBOL 85". SQ2044.2 +021600 01 CCVS-E-2. SQ2044.2 +021700 02 FILLER PICTURE X(31) VALUE SQ2044.2 +021800 SPACE. SQ2044.2 +021900 02 FILLER PICTURE X(21) VALUE SPACE. SQ2044.2 +022000 02 CCVS-E-2-2. SQ2044.2 +022100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2044.2 +022200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2044.2 +022300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2044.2 +022400 01 CCVS-E-3. SQ2044.2 +022500 02 FILLER PICTURE X(22) VALUE SQ2044.2 +022600 " FOR OFFICIAL USE ONLY". SQ2044.2 +022700 02 FILLER PICTURE X(12) VALUE SPACE. SQ2044.2 +022800 02 FILLER PICTURE X(58) VALUE SQ2044.2 +022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2044.2 +023000 02 FILLER PICTURE X(13) VALUE SPACE. SQ2044.2 +023100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2044.2 +023200 01 CCVS-E-4. SQ2044.2 +023300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2044.2 +023400 02 FILLER PIC XXXX VALUE " OF ". SQ2044.2 +023500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2044.2 +023600 02 FILLER PIC X(40) VALUE SQ2044.2 +023700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2044.2 +023800 01 XXINFO. SQ2044.2 +023900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2044.2 +024000 02 INFO-TEXT. SQ2044.2 +024100 04 FILLER PIC X(20) VALUE SPACE. SQ2044.2 +024200 04 XXCOMPUTED PIC X(20). SQ2044.2 +024300 04 FILLER PIC X(5) VALUE SPACE. SQ2044.2 +024400 04 XXCORRECT PIC X(20). SQ2044.2 +024500 01 HYPHEN-LINE. SQ2044.2 +024600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2044.2 +024700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2044.2 +024800- "*****************************************". SQ2044.2 +024900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2044.2 +025000- "******************************". SQ2044.2 +025100 01 CCVS-PGM-ID PIC X(6) VALUE SQ2044.2 +025200 "SQ204A". SQ2044.2 +025300 PROCEDURE DIVISION. SQ2044.2 +025400 CCVS1 SECTION. SQ2044.2 +025500 OPEN-FILES. SQ2044.2 +025600*P OPEN I-O RAW-DATA. SQ2044.2 +025700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2044.2 +025800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2044.2 +025900*P MOVE "ABORTED " TO C-ABORT. SQ2044.2 +026000*P ADD 1 TO C-NO-OF-TESTS. SQ2044.2 +026100*P ACCEPT C-DATE FROM DATE. SQ2044.2 +026200*P ACCEPT C-TIME FROM TIME. SQ2044.2 +026300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2044.2 +026400*PND-E-1. SQ2044.2 +026500*P CLOSE RAW-DATA. SQ2044.2 +026600 OPEN OUTPUT PRINT-FILE. SQ2044.2 +026700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2044.2 +026800 MOVE SPACE TO TEST-RESULTS. SQ2044.2 +026900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2044.2 +027000 MOVE ZERO TO REC-SKL-SUB. SQ2044.2 +027100 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2044.2 +027200 CCVS-INIT-FILE. SQ2044.2 +027300 ADD 1 TO REC-SKL-SUB. SQ2044.2 +027400 MOVE FILE-RECORD-INFO-SKELETON TO SQ2044.2 +027500 FILE-RECORD-INFO (REC-SKL-SUB). SQ2044.2 +027600 CCVS-INIT-EXIT. SQ2044.2 +027700 GO TO CCVS1-EXIT. SQ2044.2 +027800 CLOSE-FILES. SQ2044.2 +027900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2044.2 +028000*P OPEN I-O RAW-DATA. SQ2044.2 +028100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2044.2 +028200*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2044.2 +028300*P MOVE "OK. " TO C-ABORT. SQ2044.2 +028400*P MOVE PASS-COUNTER TO C-OK. SQ2044.2 +028500*P MOVE ERROR-HOLD TO C-ALL. SQ2044.2 +028600*P MOVE ERROR-COUNTER TO C-FAIL. SQ2044.2 +028700*P MOVE DELETE-CNT TO C-DELETED. SQ2044.2 +028800*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2044.2 +028900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2044.2 +029000*PND-E-2. SQ2044.2 +029100*P CLOSE RAW-DATA. SQ2044.2 +029200 TERMINATE-CCVS. SQ2044.2 +029300*S EXIT PROGRAM. SQ2044.2 +029400*SERMINATE-CALL. SQ2044.2 +029500 STOP RUN. SQ2044.2 +029600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2044.2 +029700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2044.2 +029800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2044.2 +029900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2044.2 +030000 MOVE "****TEST DELETED****" TO RE-MARK. SQ2044.2 +030100 PRINT-DETAIL. SQ2044.2 +030200 IF REC-CT NOT EQUAL TO ZERO SQ2044.2 +030300 MOVE "." TO PARDOT-X SQ2044.2 +030400 MOVE REC-CT TO DOTVALUE. SQ2044.2 +030500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2044.2 +030600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2044.2 +030700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2044.2 +030800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2044.2 +030900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2044.2 +031000 MOVE SPACE TO CORRECT-X. SQ2044.2 +031100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2044.2 +031200 MOVE SPACE TO RE-MARK. SQ2044.2 +031300 HEAD-ROUTINE. SQ2044.2 +031400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +031500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2044.2 +031600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2044.2 +031700 COLUMN-NAMES-ROUTINE. SQ2044.2 +031800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +031900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +032000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +032100 END-ROUTINE. SQ2044.2 +032200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2044.2 +032300 END-RTN-EXIT. SQ2044.2 +032400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +032500 END-ROUTINE-1. SQ2044.2 +032600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2044.2 +032700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2044.2 +032800 ADD PASS-COUNTER TO ERROR-HOLD. SQ2044.2 +032900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2044.2 +033000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2044.2 +033100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2044.2 +033200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2044.2 +033300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2044.2 +033400 END-ROUTINE-12. SQ2044.2 +033500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2044.2 +033600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2044.2 +033700 MOVE "NO " TO ERROR-TOTAL SQ2044.2 +033800 ELSE SQ2044.2 +033900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2044.2 +034000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2044.2 +034100 PERFORM WRITE-LINE. SQ2044.2 +034200 END-ROUTINE-13. SQ2044.2 +034300 IF DELETE-CNT IS EQUAL TO ZERO SQ2044.2 +034400 MOVE "NO " TO ERROR-TOTAL ELSE SQ2044.2 +034500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2044.2 +034600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2044.2 +034700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +034800 IF INSPECT-COUNTER EQUAL TO ZERO SQ2044.2 +034900 MOVE "NO " TO ERROR-TOTAL SQ2044.2 +035000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2044.2 +035100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2044.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +035300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2044.2 +035400 WRITE-LINE. SQ2044.2 +035500 ADD 1 TO RECORD-COUNT. SQ2044.2 +035600 IF RECORD-COUNT GREATER 50 SQ2044.2 +035700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2044.2 +035800 MOVE SPACE TO DUMMY-RECORD SQ2044.2 +035900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2044.2 +036000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2044.2 +036100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2044.2 +036200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2044.2 +036300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2044.2 +036400 MOVE ZERO TO RECORD-COUNT. SQ2044.2 +036500 PERFORM WRT-LN. SQ2044.2 +036600 WRT-LN. SQ2044.2 +036700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2044.2 +036800 MOVE SPACE TO DUMMY-RECORD. SQ2044.2 +036900 BLANK-LINE-PRINT. SQ2044.2 +037000 PERFORM WRT-LN. SQ2044.2 +037100 FAIL-ROUTINE. SQ2044.2 +037200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2044.2 +037300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2044.2 +037400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2044.2 +037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +037600 GO TO FAIL-ROUTINE-EX. SQ2044.2 +037700 FAIL-ROUTINE-WRITE. SQ2044.2 +037800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2044.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +038000 FAIL-ROUTINE-EX. EXIT. SQ2044.2 +038100 BAIL-OUT. SQ2044.2 +038200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2044.2 +038300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2044.2 +038400 BAIL-OUT-WRITE. SQ2044.2 +038500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2044.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2044.2 +038700 BAIL-OUT-EX. EXIT. SQ2044.2 +038800 CCVS1-EXIT. SQ2044.2 +038900 EXIT. SQ2044.2 +039000 SECT-SQ204A-0001 SECTION. SQ2044.2 +039100 WRITE-INIT-GF-01. SQ2044.2 +039200* THIS IS A TEST FOR OPEN EXTEND FOR MAGNETIC TAPE. SQ2044.2 +039300* A FILE OF 750 RECORDS IS CREATED THEN RE-OPENED SQ2044.2 +039400* WITH EXTEND. 250 RECORDS ARE ADDED TO THE FILE. SQ2044.2 +039500* THE FILE IS THEN READ AND VALIDATED. SQ2044.2 +039600 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2044.2 +039700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2044.2 +039800 MOVE "SQ204A" TO XPROGRAM-NAME (1). SQ2044.2 +039900 MOVE 000126 TO XRECORD-LENGTH (1). SQ2044.2 +040000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2044.2 +040100 MOVE 0001 TO XBLOCK-SIZE (1). SQ2044.2 +040200 MOVE 001000 TO RECORDS-IN-FILE (1). SQ2044.2 +040300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2044.2 +040400 MOVE "S" TO XLABEL-TYPE (1). SQ2044.2 +040500 MOVE 000001 TO XRECORD-NUMBER (1). SQ2044.2 +040600 OPEN OUTPUT SQ-FS1. SQ2044.2 +040700 WRITE-TEST-001-01. SQ2044.2 +040800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2044.2 +040900 MOVE SPACES TO SQ-FS1R1-F-G-006. SQ2044.2 +041000 WRITE SQ-FS1R1-F-G-126. SQ2044.2 +041100 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2044.2 +041200 GO TO WRITE-TEST-GF-01-1. SQ2044.2 +041300 ADD 1 TO XRECORD-NUMBER (1). SQ2044.2 +041400 GO TO WRITE-TEST-001-01. SQ2044.2 +041500 WRITE-TEST-GF-01-1. SQ2044.2 +041600 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2044.2 +041700 MOVE "WRITE-TEST-GF-01-1" TO PAR-NAME. SQ2044.2 +041800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2044.2 +041900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2044.2 +042000 PERFORM PRINT-DETAIL. SQ2044.2 +042100 CLOSE SQ-FS1. SQ2044.2 +042200 WRITE-TEST-001-03. SQ2044.2 +042300 OPEN EXTEND SQ-FS1. SQ2044.2 +042400 ADD 1 TO XRECORD-NUMBER (1). SQ2044.2 +042500 WRITE-TEST-001-04. SQ2044.2 +042600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2044.2 +042700 MOVE "EXTEND" TO SQ-FS1R1-F-G-006. SQ2044.2 +042800 WRITE SQ-FS1R1-F-G-126. SQ2044.2 +042900 IF XRECORD-NUMBER (1) EQUAL 1000 SQ2044.2 +043000 GO TO WRITE-TEST-GF-01-2. SQ2044.2 +043100 ADD 1 TO XRECORD-NUMBER (1). SQ2044.2 +043200 GO TO WRITE-TEST-001-04. SQ2044.2 +043300 WRITE-TEST-GF-01-2. SQ2044.2 +043400 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2044.2 +043500 MOVE "WRITE-TEST-GF-01-2" TO PAR-NAME. SQ2044.2 +043600 MOVE "FILE EXTENDED, RECS =" TO COMPUTED-A. SQ2044.2 +043700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2044.2 +043800 PERFORM PRINT-DETAIL. SQ2044.2 +043900 CLOSE SQ-FS1. SQ2044.2 +044000 READ-TEST-001-06. SQ2044.2 +044100 OPEN INPUT SQ-FS1. SQ2044.2 +044200 MOVE ZERO TO WRK-RECORD-COUNT. SQ2044.2 +044300 READ-TEST-GF-01-07. SQ2044.2 +044400 READ SQ-FS1 SQ2044.2 +044500 ; AT END MOVE "PREMATURE EOF" TO RE-MARK SQ2044.2 +044600 PERFORM FAIL SQ2044.2 +044700 GO TO READ-WRITE-GF-01. SQ2044.2 +044800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2044.2 +044900 ADD 1 TO WRK-RECORD-COUNT. SQ2044.2 +045000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2044.2 +045100 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +045200 GO TO READ-TEST-GF-01-08. SQ2044.2 +045300 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2044.2 +045400 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +045500 GO TO READ-TEST-GF-01-08. SQ2044.2 +045600 IF SQ-FS1R1-F-G-006 NOT EQUAL TO SPACES SQ2044.2 +045700 ADD 1 TO RECORDS-IN-ERROR. SQ2044.2 +045800 READ-TEST-GF-01-08. SQ2044.2 +045900 IF WRK-RECORD-COUNT NOT EQUAL TO 750 SQ2044.2 +046000 GO TO READ-TEST-GF-01-07. SQ2044.2 +046100 READ-TEST-GF-01-09. SQ2044.2 +046200 READ SQ-FS1 RECORD SQ2044.2 +046300 ; END GO TO READ-TEST-GF-01. SQ2044.2 +046400 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2044.2 +046500 ADD 1 TO WRK-RECORD-COUNT. SQ2044.2 +046600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2044.2 +046700 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +046800 GO TO READ-TEST-GF-01-09. SQ2044.2 +046900 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2044.2 +047000 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +047100 GO TO READ-TEST-GF-01-09. SQ2044.2 +047200 IF SQ-FS1R1-F-G-006 NOT EQUAL TO "EXTEND" SQ2044.2 +047300 ADD 1 TO RECORDS-IN-ERROR. SQ2044.2 +047400 GO TO READ-TEST-GF-01-09. SQ2044.2 +047500 READ-TEST-GF-01. SQ2044.2 +047600 IF RECORDS-IN-ERROR EQUAL ZERO SQ2044.2 +047700 GO TO READ-PASS-GF-01. SQ2044.2 +047800 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ2044.2 +047900 GO TO READ-FAIL-GF-01. SQ2044.2 +048000 READ-DELETE-GF-01. SQ2044.2 +048100 PERFORM DE-LETE. SQ2044.2 +048200 GO TO READ-WRITE-GF-01. SQ2044.2 +048300 READ-FAIL-GF-01. SQ2044.2 +048400 MOVE "VII-44 READ OR VII-52 WRITE INCORRECTLY EXECUTED" SQ2044.2 +048500 TO RE-MARK. SQ2044.2 +048600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2044.2 +048700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2044.2 +048800 PERFORM FAIL. SQ2044.2 +048900 GO TO READ-WRITE-GF-01. SQ2044.2 +049000 READ-PASS-GF-01. SQ2044.2 +049100 PERFORM PASS. SQ2044.2 +049200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2044.2 +049300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2044.2 +049400 READ-WRITE-GF-01. SQ2044.2 +049500 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2044.2 +049600 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2044.2 +049700 PERFORM PRINT-DETAIL. SQ2044.2 +049800 READ-CLOSE-GF-01. SQ2044.2 +049900 CLOSE SQ-FS1. SQ2044.2 +050000 WRITE-INIT-GF-02. SQ2044.2 +050100* THIS IS A TEST FOR OPEN EXTEND FOR MASS STORAGE. SQ2044.2 +050200* A FILE OF 750 RECORDS IS CREATED THEN RE-OPENED SQ2044.2 +050300* WITH EXTEND. 250 RECORDS ARE ADDED TO THE FILE. SQ2044.2 +050400* THE FILE IS THEN READ AND VALIDATED. SQ2044.2 +050500 MOVE "SQ-FS2" TO XFILE-NAME (2). SQ2044.2 +050600 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ2044.2 +050700 MOVE "SQ204A" TO XPROGRAM-NAME (2). SQ2044.2 +050800 MOVE 000126 TO XRECORD-LENGTH (2). SQ2044.2 +050900 MOVE "RC" TO CHARS-OR-RECORDS (2). SQ2044.2 +051000 MOVE 0001 TO XBLOCK-SIZE (2). SQ2044.2 +051100 MOVE 001000 TO RECORDS-IN-FILE (2). SQ2044.2 +051200 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ2044.2 +051300 MOVE "S" TO XLABEL-TYPE (2). SQ2044.2 +051400 MOVE 000001 TO XRECORD-NUMBER (2). SQ2044.2 +051500 OPEN OUTPUT SQ-FS2. SQ2044.2 +051600 WRITE-TEST-GF-02-01. SQ2044.2 +051700 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ2044.2 +051800 MOVE SPACES TO SQ-FS2R1-F-G-006. SQ2044.2 +051900 WRITE SQ-FS2R1-F-G-126. SQ2044.2 +052000 IF XRECORD-NUMBER (2) EQUAL TO 750 SQ2044.2 +052100 GO TO WRITE-TEST-GF-02-1. SQ2044.2 +052200 ADD 1 TO XRECORD-NUMBER (2). SQ2044.2 +052300 GO TO WRITE-TEST-GF-02-01. SQ2044.2 +052400 WRITE-TEST-GF-02-1. SQ2044.2 +052500 MOVE "CREATE FILE SQ-FS2" TO FEATURE. SQ2044.2 +052600 MOVE "WRITE-TEST-GF-02-1" TO PAR-NAME. SQ2044.2 +052700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2044.2 +052800 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2044.2 +052900 PERFORM PRINT-DETAIL. SQ2044.2 +053000 CLOSE SQ-FS2. SQ2044.2 +053100 WRITE-TEST-GF-02-03. SQ2044.2 +053200 OPEN EXTEND SQ-FS2. SQ2044.2 +053300 ADD 1 TO XRECORD-NUMBER (2). SQ2044.2 +053400 WRITE-TEST-GF-02-04. SQ2044.2 +053500 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ2044.2 +053600 MOVE "EXTEND" TO SQ-FS2R1-F-G-006. SQ2044.2 +053700 WRITE SQ-FS2R1-F-G-126. SQ2044.2 +053800 IF XRECORD-NUMBER (2) EQUAL 1000 SQ2044.2 +053900 GO TO WRITE-TEST-GF-02-2. SQ2044.2 +054000 ADD 1 TO XRECORD-NUMBER (2). SQ2044.2 +054100 GO TO WRITE-TEST-GF-02-04. SQ2044.2 +054200 WRITE-TEST-GF-02-2. SQ2044.2 +054300 MOVE "CREATE FILE SQ-FS2" TO FEATURE. SQ2044.2 +054400 MOVE "WRITE-TEST-GF-02-2" TO PAR-NAME. SQ2044.2 +054500 MOVE "FILE EXTENDED, RECS =" TO COMPUTED-A. SQ2044.2 +054600 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2044.2 +054700 PERFORM PRINT-DETAIL. SQ2044.2 +054800 CLOSE SQ-FS2. SQ2044.2 +054900 READ-TEST-GF-02-06. SQ2044.2 +055000 OPEN INPUT SQ-FS2. SQ2044.2 +055100 MOVE ZERO TO WRK-RECORD-COUNT. SQ2044.2 +055200 MOVE ZERO TO RECORDS-IN-ERROR. SQ2044.2 +055300 READ-TEST-GF-02-07. SQ2044.2 +055400 READ SQ-FS2 SQ2044.2 +055500 AT END MOVE "PREMATURE EOF" TO RE-MARK SQ2044.2 +055600 PERFORM FAIL SQ2044.2 +055700 GO TO READ-WRITE-GF-02. SQ2044.2 +055800 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ2044.2 +055900 ADD 1 TO WRK-RECORD-COUNT. SQ2044.2 +056000 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ2044.2 +056100 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +056200 GO TO READ-TEST-GF-02-08. SQ2044.2 +056300 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (2) SQ2044.2 +056400 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +056500 GO TO READ-TEST-GF-02-08. SQ2044.2 +056600 IF SQ-FS2R1-F-G-006 NOT EQUAL TO SPACES SQ2044.2 +056700 ADD 1 TO RECORDS-IN-ERROR. SQ2044.2 +056800 READ-TEST-GF-02-08. SQ2044.2 +056900 IF WRK-RECORD-COUNT NOT EQUAL TO 750 SQ2044.2 +057000 GO TO READ-TEST-GF-02-07. SQ2044.2 +057100 READ-TEST-GF-02-09. SQ2044.2 +057200 READ SQ-FS2 RECORD SQ2044.2 +057300 AT END GO TO READ-TEST-GF-02. SQ2044.2 +057400 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2) SQ2044.2 +057500 ADD 1 TO WRK-RECORD-COUNT. SQ2044.2 +057600 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ2044.2 +057700 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +057800 GO TO READ-TEST-GF-02-09. SQ2044.2 +057900 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (2) SQ2044.2 +058000 ADD 1 TO RECORDS-IN-ERROR SQ2044.2 +058100 GO TO READ-TEST-GF-02-09. SQ2044.2 +058200 IF SQ-FS2R1-F-G-006 NOT EQUAL TO "EXTEND" SQ2044.2 +058300 ADD 1 TO RECORDS-IN-ERROR. SQ2044.2 +058400 GO TO READ-TEST-GF-02-09. SQ2044.2 +058500 READ-TEST-GF-02. SQ2044.2 +058600 IF RECORDS-IN-ERROR EQUAL ZERO SQ2044.2 +058700 GO TO READ-PASS-GF-02. SQ2044.2 +058800 MOVE "ERRORS IN READING SQ-FS2" TO RE-MARK. SQ2044.2 +058900 GO TO READ-FAIL-GF-02. SQ2044.2 +059000 READ-DELETE-GF-02. SQ2044.2 +059100 PERFORM DE-LETE. SQ2044.2 +059200 GO TO READ-WRITE-GF-02. SQ2044.2 +059300 READ-FAIL-GF-02. SQ2044.2 +059400 MOVE "VII-44 READ OR VII-52 WRITE INCORRECTLY EXECUTED" SQ2044.2 +059500 TO RE-MARK. SQ2044.2 +059600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2044.2 +059700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2044.2 +059800 PERFORM FAIL. SQ2044.2 +059900 GO TO READ-WRITE-GF-02. SQ2044.2 +060000 READ-PASS-GF-02. SQ2044.2 +060100 PERFORM PASS. SQ2044.2 +060200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2044.2 +060300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2044.2 +060400 READ-WRITE-GF-02. SQ2044.2 +060500 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2044.2 +060600 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. SQ2044.2 +060700 PERFORM PRINT-DETAIL. SQ2044.2 +060800 READ-CLOSE-GF-02. SQ2044.2 +060900 CLOSE SQ-FS2. SQ2044.2 +061000 SQ204A-END-ROUTINE. SQ2044.2 +061100 MOVE "END OF SQ204A VALIDATION TESTS" TO PRINT-REC. SQ2044.2 +061200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2044.2 +061300 TERMINATE-SQ204A. SQ2044.2 +061400 EXIT. SQ2044.2 +061500 CCVS-EXIT SECTION. SQ2044.2 +061600 CCVS-999999. SQ2044.2 +061700 GO TO CLOSE-FILES. SQ2044.2 diff --git a/tests/cobol85/SQ/SQ205A.CBL b/tests/cobol85/SQ/SQ205A.CBL new file mode 100755 index 00000000..dfe49645 --- /dev/null +++ b/tests/cobol85/SQ/SQ205A.CBL @@ -0,0 +1,571 @@ +000100 IDENTIFICATION DIVISION. SQ2054.2 +000200 PROGRAM-ID. SQ2054.2 +000300 SQ205A. SQ2054.2 +000400**************************************************************** SQ2054.2 +000500* * SQ2054.2 +000600* VALIDATION FOR:- * SQ2054.2 +000700* " HIGH ". SQ2054.2 +000800* * SQ2054.2 +000900* CREATION DATE / VALIDATION DATE * SQ2054.2 +001000* "4.2 ". SQ2054.2 +001100* * SQ2054.2 +001200* THIS ROUTINE (OLD: SQ210) TESTS THE USE STATEMENT WITH XFILE-NASQ2054.2 +001300* SERIES. A MASS STORAGE AND TAPE FILE ARE CREATED AND THEN SQ2054.2 +001400* READ. AN AT END CONDITION IS USED TO CAUSE THE USE PROCEDURESQ2054.2 +001500* TO BE EXECUTED. BOTH FILES HAVE A FILE STATUS CLAUSE IN THE SQ2054.2 +001600* SELECT CLAUSE IN THE FILE-CONTROL PARAGRAPH. SQ2054.2 +001700 ENVIRONMENT DIVISION. SQ2054.2 +001800 CONFIGURATION SECTION. SQ2054.2 +001900 SOURCE-COMPUTER. SQ2054.2 +002000 Linux. SQ2054.2 +002100 OBJECT-COMPUTER. SQ2054.2 +002200 Linux. SQ2054.2 +002300 INPUT-OUTPUT SECTION. SQ2054.2 +002400 FILE-CONTROL. SQ2054.2 +002500*P SELECT RAW-DATA ASSIGN TO SQ2054.2 +002600*P "XXXXX062" SQ2054.2 +002700*P ORGANIZATION IS INDEXED SQ2054.2 +002800*P ACCESS MODE IS RANDOM SQ2054.2 +002900*P RECORD KEY IS RAW-DATA-KEY. SQ2054.2 +003000 SELECT PRINT-FILE ASSIGN TO SQ2054.2 +003100 "report.log". SQ2054.2 +003200 SELECT SQ-FS1 ASSIGN TO SQ2054.2 +003300 "XXXXX001" SQ2054.2 +003400 ORGANIZATION SEQUENTIAL SQ2054.2 +003500 ACCESS SEQUENTIAL SQ2054.2 +003600 STATUS GRP-STATUS-KEY-1. SQ2054.2 +003700 SELECT SQ-FS2 ASSIGN TO SQ2054.2 +003800 "XXXXX014" SQ2054.2 +003900 ORGANIZATION IS SEQUENTIAL SQ2054.2 +004000 FILE STATUS GRP-STATUS-KEY-2. SQ2054.2 +004100 DATA DIVISION. SQ2054.2 +004200 FILE SECTION. SQ2054.2 +004300*P SQ2054.2 +004400*PD RAW-DATA. SQ2054.2 +004500*P SQ2054.2 +004600*P1 RAW-DATA-SATZ. SQ2054.2 +004700*P 05 RAW-DATA-KEY PIC X(6). SQ2054.2 +004800*P 05 C-DATE PIC 9(6). SQ2054.2 +004900*P 05 C-TIME PIC 9(8). SQ2054.2 +005000*P 05 C-NO-OF-TESTS PIC 99. SQ2054.2 +005100*P 05 C-OK PIC 999. SQ2054.2 +005200*P 05 C-ALL PIC 999. SQ2054.2 +005300*P 05 C-FAIL PIC 999. SQ2054.2 +005400*P 05 C-DELETED PIC 999. SQ2054.2 +005500*P 05 C-INSPECT PIC 999. SQ2054.2 +005600*P 05 C-NOTE PIC X(13). SQ2054.2 +005700*P 05 C-INDENT PIC X. SQ2054.2 +005800*P 05 C-ABORT PIC X(8). SQ2054.2 +005900 FD PRINT-FILE SQ2054.2 +006000*C LABEL RECORDS SQ2054.2 +006100*C OMITTED SQ2054.2 +006200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2054.2 +006300 . SQ2054.2 +006400 01 PRINT-REC PICTURE X(120). SQ2054.2 +006500 01 DUMMY-RECORD PICTURE X(120). SQ2054.2 +006600 FD SQ-FS1 SQ2054.2 +006700*C LABEL RECORD IS STANDARD SQ2054.2 +006800 BLOCK CONTAINS 5 RECORDS. SQ2054.2 +006900 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2054.2 +007000 FD SQ-FS2 SQ2054.2 +007100*C LABEL RECORD IS STANDARD SQ2054.2 +007200 BLOCK CONTAINS 5 RECORDS. SQ2054.2 +007300 01 SQ-FS2R1-F-G-120 PIC X(120). SQ2054.2 +007400 WORKING-STORAGE SECTION. SQ2054.2 +007500 77 SQ-FS1-ERRORS PIC 999 VALUE ZERO. SQ2054.2 +007600 77 SQ-FS2-ERRORS PIC 999 VALUE ZERO. SQ2054.2 +007700 77 SQ-FS1-EOF-STATUS PIC 9 VALUE ZERO. SQ2054.2 +007800 77 SQ-FS2-EOF-STATUS PIC 9 VALUE ZERO. SQ2054.2 +007900 77 WRK-RECORD-COUNT PIC 999 VALUE ZERO. SQ2054.2 +008000 77 RECORDS-IN-ERROR PIC 999 VALUE ZERO. SQ2054.2 +008100 01 COUNT-OF-RECS PIC 9999 VALUE 0. SQ2054.2 +008200 01 GRP-STATUS-KEY-1. SQ2054.2 +008300 02 WRK-XN-00001-KEY-1 PIC XX. SQ2054.2 +008400* 02 FILLER PIC X. SQ2054.2 +008500 01 GRP-STATUS-KEY-2. SQ2054.2 +008600 02 WRK-XN-00001-KEY-2 PIC XX. SQ2054.2 +008700* 02 FILLER PIC X. SQ2054.2 +008800 01 FILE-RECORD-INFORMATION-REC. SQ2054.2 +008900 03 FILE-RECORD-INFO-SKELETON. SQ2054.2 +009000 05 FILLER PICTURE X(48) VALUE SQ2054.2 +009100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2054.2 +009200 05 FILLER PICTURE X(46) VALUE SQ2054.2 +009300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2054.2 +009400 05 FILLER PICTURE X(26) VALUE SQ2054.2 +009500 ",LFIL=000000,ORG= ,LBLR= ". SQ2054.2 +009600 05 FILLER PICTURE X(37) VALUE SQ2054.2 +009700 ",RECKEY= ". SQ2054.2 +009800 05 FILLER PICTURE X(38) VALUE SQ2054.2 +009900 ",ALTKEY1= ". SQ2054.2 +010000 05 FILLER PICTURE X(38) VALUE SQ2054.2 +010100 ",ALTKEY2= ". SQ2054.2 +010200 05 FILLER PICTURE X(7) VALUE SPACE.SQ2054.2 +010300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2054.2 +010400 05 FILE-RECORD-INFO-P1-120. SQ2054.2 +010500 07 FILLER PIC X(5). SQ2054.2 +010600 07 XFILE-NAME PIC X(6). SQ2054.2 +010700 07 FILLER PIC X(8). SQ2054.2 +010800 07 XRECORD-NAME PIC X(6). SQ2054.2 +010900 07 FILLER PIC X(1). SQ2054.2 +011000 07 REELUNIT-NUMBER PIC 9(1). SQ2054.2 +011100 07 FILLER PIC X(7). SQ2054.2 +011200 07 XRECORD-NUMBER PIC 9(6). SQ2054.2 +011300 07 FILLER PIC X(6). SQ2054.2 +011400 07 UPDATE-NUMBER PIC 9(2). SQ2054.2 +011500 07 FILLER PIC X(5). SQ2054.2 +011600 07 ODO-NUMBER PIC 9(4). SQ2054.2 +011700 07 FILLER PIC X(5). SQ2054.2 +011800 07 XPROGRAM-NAME PIC X(5). SQ2054.2 +011900 07 FILLER PIC X(7). SQ2054.2 +012000 07 XRECORD-LENGTH PIC 9(6). SQ2054.2 +012100 07 FILLER PIC X(7). SQ2054.2 +012200 07 CHARS-OR-RECORDS PIC X(2). SQ2054.2 +012300 07 FILLER PIC X(1). SQ2054.2 +012400 07 XBLOCK-SIZE PIC 9(4). SQ2054.2 +012500 07 FILLER PIC X(6). SQ2054.2 +012600 07 RECORDS-IN-FILE PIC 9(6). SQ2054.2 +012700 07 FILLER PIC X(5). SQ2054.2 +012800 07 XFILE-ORGANIZATION PIC X(2). SQ2054.2 +012900 07 FILLER PIC X(6). SQ2054.2 +013000 07 XLABEL-TYPE PIC X(1). SQ2054.2 +013100 05 FILE-RECORD-INFO-P121-240. SQ2054.2 +013200 07 FILLER PIC X(8). SQ2054.2 +013300 07 XRECORD-KEY PIC X(29). SQ2054.2 +013400 07 FILLER PIC X(9). SQ2054.2 +013500 07 ALTERNATE-KEY1 PIC X(29). SQ2054.2 +013600 07 FILLER PIC X(9). SQ2054.2 +013700 07 ALTERNATE-KEY2 PIC X(29). SQ2054.2 +013800 07 FILLER PIC X(7). SQ2054.2 +013900 01 TEST-RESULTS. SQ2054.2 +014000 02 FILLER PICTURE X VALUE SPACE. SQ2054.2 +014100 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2054.2 +014200 02 FILLER PICTURE X VALUE SPACE. SQ2054.2 +014300 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2054.2 +014400 02 FILLER PICTURE X VALUE SPACE. SQ2054.2 +014500 02 PAR-NAME. SQ2054.2 +014600 03 FILLER PICTURE X(12) VALUE SPACE. SQ2054.2 +014700 03 PARDOT-X PICTURE X VALUE SPACE. SQ2054.2 +014800 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2054.2 +014900 03 FILLER PIC X(5) VALUE SPACE. SQ2054.2 +015000 02 FILLER PIC X(10) VALUE SPACE. SQ2054.2 +015100 02 RE-MARK PIC X(61). SQ2054.2 +015200 01 TEST-COMPUTED. SQ2054.2 +015300 02 FILLER PIC X(30) VALUE SPACE. SQ2054.2 +015400 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2054.2 +015500 02 COMPUTED-X. SQ2054.2 +015600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2054.2 +015700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2054.2 +015800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2054.2 +015900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2054.2 +016000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2054.2 +016100 03 CM-18V0 REDEFINES COMPUTED-A. SQ2054.2 +016200 04 COMPUTED-18V0 PICTURE -9(18). SQ2054.2 +016300 04 FILLER PICTURE X. SQ2054.2 +016400 03 FILLER PIC X(50) VALUE SPACE. SQ2054.2 +016500 01 TEST-CORRECT. SQ2054.2 +016600 02 FILLER PIC X(30) VALUE SPACE. SQ2054.2 +016700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2054.2 +016800 02 CORRECT-X. SQ2054.2 +016900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2054.2 +017000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2054.2 +017100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2054.2 +017200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2054.2 +017300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2054.2 +017400 03 CR-18V0 REDEFINES CORRECT-A. SQ2054.2 +017500 04 CORRECT-18V0 PICTURE -9(18). SQ2054.2 +017600 04 FILLER PICTURE X. SQ2054.2 +017700 03 FILLER PIC X(50) VALUE SPACE. SQ2054.2 +017800 01 CCVS-C-1. SQ2054.2 +017900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2054.2 +018000- "SS PARAGRAPH-NAME SQ2054.2 +018100- " REMARKS". SQ2054.2 +018200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2054.2 +018300 01 CCVS-C-2. SQ2054.2 +018400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2054.2 +018500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2054.2 +018600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2054.2 +018700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2054.2 +018800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2054.2 +018900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2054.2 +019000 01 REC-CT PICTURE 99 VALUE ZERO. SQ2054.2 +019100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2054.2 +019200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2054.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2054.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2054.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2054.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2054.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2054.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2054.2 +019900 01 CCVS-H-1. SQ2054.2 +020000 02 FILLER PICTURE X(27) VALUE SPACE. SQ2054.2 +020100 02 FILLER PICTURE X(67) VALUE SQ2054.2 +020200 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2054.2 +020300- " SYSTEM". SQ2054.2 +020400 02 FILLER PICTURE X(26) VALUE SPACE. SQ2054.2 +020500 01 CCVS-H-2. SQ2054.2 +020600 02 FILLER PICTURE X(52) VALUE IS SQ2054.2 +020700 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2054.2 +020800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2054.2 +020900 02 TEST-ID PICTURE IS X(9). SQ2054.2 +021000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2054.2 +021100 01 CCVS-H-3. SQ2054.2 +021200 02 FILLER PICTURE X(34) VALUE SQ2054.2 +021300 " FOR OFFICIAL USE ONLY ". SQ2054.2 +021400 02 FILLER PICTURE X(58) VALUE SQ2054.2 +021500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2054.2 +021600 02 FILLER PICTURE X(28) VALUE SQ2054.2 +021700 " COPYRIGHT 1985 ". SQ2054.2 +021800 01 CCVS-E-1. SQ2054.2 +021900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2054.2 +022000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2054.2 +022100 02 ID-AGAIN PICTURE IS X(9). SQ2054.2 +022200 02 FILLER PICTURE X(45) VALUE IS SQ2054.2 +022300 " NTIS DISTRIBUTION COBOL 85". SQ2054.2 +022400 01 CCVS-E-2. SQ2054.2 +022500 02 FILLER PICTURE X(31) VALUE SQ2054.2 +022600 SPACE. SQ2054.2 +022700 02 FILLER PICTURE X(21) VALUE SPACE. SQ2054.2 +022800 02 CCVS-E-2-2. SQ2054.2 +022900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2054.2 +023000 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2054.2 +023100 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2054.2 +023200 01 CCVS-E-3. SQ2054.2 +023300 02 FILLER PICTURE X(22) VALUE SQ2054.2 +023400 " FOR OFFICIAL USE ONLY". SQ2054.2 +023500 02 FILLER PICTURE X(12) VALUE SPACE. SQ2054.2 +023600 02 FILLER PICTURE X(58) VALUE SQ2054.2 +023700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2054.2 +023800 02 FILLER PICTURE X(13) VALUE SPACE. SQ2054.2 +023900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2054.2 +024000 01 CCVS-E-4. SQ2054.2 +024100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2054.2 +024200 02 FILLER PIC XXXX VALUE " OF ". SQ2054.2 +024300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2054.2 +024400 02 FILLER PIC X(40) VALUE SQ2054.2 +024500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2054.2 +024600 01 XXINFO. SQ2054.2 +024700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2054.2 +024800 02 INFO-TEXT. SQ2054.2 +024900 04 FILLER PIC X(20) VALUE SPACE. SQ2054.2 +025000 04 XXCOMPUTED PIC X(20). SQ2054.2 +025100 04 FILLER PIC X(5) VALUE SPACE. SQ2054.2 +025200 04 XXCORRECT PIC X(20). SQ2054.2 +025300 01 HYPHEN-LINE. SQ2054.2 +025400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2054.2 +025500 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2054.2 +025600- "*****************************************". SQ2054.2 +025700 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2054.2 +025800- "******************************". SQ2054.2 +025900 01 CCVS-PGM-ID PIC X(6) VALUE SQ2054.2 +026000 "SQ205A". SQ2054.2 +026100 PROCEDURE DIVISION. SQ2054.2 +026200 DECLARATIVES. SQ2054.2 +026300 SEQ-USE SECTION. SQ2054.2 +026400 USE AFTER EXCEPTION PROCEDURE ON SQ-FS1, SQ-FS2. SQ2054.2 +026500 SEQ-USE-001. SQ2054.2 +026600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" GO TO SEQ-USE-002. SQ2054.2 +026700 IF WRK-XN-00001-KEY-1 EQUAL TO "10" SQ2054.2 +026800 MOVE 1 TO SQ-FS1-EOF-STATUS SQ2054.2 +026900 GO TO SEQ-USE-EXIT. SQ2054.2 +027000 ADD 1 TO SQ-FS1-ERRORS. SQ2054.2 +027100 GO TO SEQ-USE-EXIT. SQ2054.2 +027200 SEQ-USE-002. SQ2054.2 +027300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS2" GO TO SEQ-USE-EXIT. SQ2054.2 +027400 IF WRK-XN-00001-KEY-2 EQUAL TO "10" SQ2054.2 +027500 MOVE 1 TO SQ-FS2-EOF-STATUS SQ2054.2 +027600 GO TO SEQ-USE-EXIT. SQ2054.2 +027700 ADD 1 TO SQ-FS2-ERRORS. SQ2054.2 +027800 SEQ-USE-EXIT. SQ2054.2 +027900 EXIT. SQ2054.2 +028000 END DECLARATIVES. SQ2054.2 +028100 CCVS1 SECTION. SQ2054.2 +028200 OPEN-FILES. SQ2054.2 +028300*P OPEN I-O RAW-DATA. SQ2054.2 +028400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2054.2 +028500*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2054.2 +028600*P MOVE "ABORTED " TO C-ABORT. SQ2054.2 +028700*P ADD 1 TO C-NO-OF-TESTS. SQ2054.2 +028800*P ACCEPT C-DATE FROM DATE. SQ2054.2 +028900*P ACCEPT C-TIME FROM TIME. SQ2054.2 +029000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2054.2 +029100*PND-E-1. SQ2054.2 +029200*P CLOSE RAW-DATA. SQ2054.2 +029300 OPEN OUTPUT PRINT-FILE. SQ2054.2 +029400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2054.2 +029500 MOVE SPACE TO TEST-RESULTS. SQ2054.2 +029600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2054.2 +029700 MOVE ZERO TO REC-SKL-SUB. SQ2054.2 +029800 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2054.2 +029900 CCVS-INIT-FILE. SQ2054.2 +030000 ADD 1 TO REC-SKL-SUB. SQ2054.2 +030100 MOVE FILE-RECORD-INFO-SKELETON TO SQ2054.2 +030200 FILE-RECORD-INFO (REC-SKL-SUB). SQ2054.2 +030300 CCVS-INIT-EXIT. SQ2054.2 +030400 GO TO CCVS1-EXIT. SQ2054.2 +030500 CLOSE-FILES. SQ2054.2 +030600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2054.2 +030700*P OPEN I-O RAW-DATA. SQ2054.2 +030800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2054.2 +030900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2054.2 +031000*P MOVE "OK. " TO C-ABORT. SQ2054.2 +031100*P MOVE PASS-COUNTER TO C-OK. SQ2054.2 +031200*P MOVE ERROR-HOLD TO C-ALL. SQ2054.2 +031300*P MOVE ERROR-COUNTER TO C-FAIL. SQ2054.2 +031400*P MOVE DELETE-CNT TO C-DELETED. SQ2054.2 +031500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2054.2 +031600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2054.2 +031700*PND-E-2. SQ2054.2 +031800*P CLOSE RAW-DATA. SQ2054.2 +031900 TERMINATE-CCVS. SQ2054.2 +032000*S EXIT PROGRAM. SQ2054.2 +032100*SERMINATE-CALL. SQ2054.2 +032200 STOP RUN. SQ2054.2 +032300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2054.2 +032400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2054.2 +032500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2054.2 +032600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2054.2 +032700 MOVE "****TEST DELETED****" TO RE-MARK. SQ2054.2 +032800 PRINT-DETAIL. SQ2054.2 +032900 IF REC-CT NOT EQUAL TO ZERO SQ2054.2 +033000 MOVE "." TO PARDOT-X SQ2054.2 +033100 MOVE REC-CT TO DOTVALUE. SQ2054.2 +033200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2054.2 +033300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2054.2 +033400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2054.2 +033500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2054.2 +033600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2054.2 +033700 MOVE SPACE TO CORRECT-X. SQ2054.2 +033800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2054.2 +033900 MOVE SPACE TO RE-MARK. SQ2054.2 +034000 HEAD-ROUTINE. SQ2054.2 +034100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +034200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2054.2 +034300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2054.2 +034400 COLUMN-NAMES-ROUTINE. SQ2054.2 +034500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +034600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +034800 END-ROUTINE. SQ2054.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2054.2 +035000 END-RTN-EXIT. SQ2054.2 +035100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +035200 END-ROUTINE-1. SQ2054.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2054.2 +035400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2054.2 +035500 ADD PASS-COUNTER TO ERROR-HOLD. SQ2054.2 +035600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2054.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2054.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2054.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2054.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2054.2 +036100 END-ROUTINE-12. SQ2054.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2054.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2054.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2054.2 +036500 ELSE SQ2054.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2054.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2054.2 +036800 PERFORM WRITE-LINE. SQ2054.2 +036900 END-ROUTINE-13. SQ2054.2 +037000 IF DELETE-CNT IS EQUAL TO ZERO SQ2054.2 +037100 MOVE "NO " TO ERROR-TOTAL ELSE SQ2054.2 +037200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2054.2 +037300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2054.2 +037400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +037500 IF INSPECT-COUNTER EQUAL TO ZERO SQ2054.2 +037600 MOVE "NO " TO ERROR-TOTAL SQ2054.2 +037700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2054.2 +037800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2054.2 +037900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +038000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2054.2 +038100 WRITE-LINE. SQ2054.2 +038200 ADD 1 TO RECORD-COUNT. SQ2054.2 +038300 IF RECORD-COUNT GREATER 50 SQ2054.2 +038400 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2054.2 +038500 MOVE SPACE TO DUMMY-RECORD SQ2054.2 +038600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2054.2 +038700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2054.2 +038800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2054.2 +038900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2054.2 +039000 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2054.2 +039100 MOVE ZERO TO RECORD-COUNT. SQ2054.2 +039200 PERFORM WRT-LN. SQ2054.2 +039300 WRT-LN. SQ2054.2 +039400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2054.2 +039500 MOVE SPACE TO DUMMY-RECORD. SQ2054.2 +039600 BLANK-LINE-PRINT. SQ2054.2 +039700 PERFORM WRT-LN. SQ2054.2 +039800 FAIL-ROUTINE. SQ2054.2 +039900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2054.2 +040000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2054.2 +040100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2054.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +040300 GO TO FAIL-ROUTINE-EX. SQ2054.2 +040400 FAIL-ROUTINE-WRITE. SQ2054.2 +040500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2054.2 +040600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +040700 FAIL-ROUTINE-EX. EXIT. SQ2054.2 +040800 BAIL-OUT. SQ2054.2 +040900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2054.2 +041000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2054.2 +041100 BAIL-OUT-WRITE. SQ2054.2 +041200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2054.2 +041300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2054.2 +041400 BAIL-OUT-EX. EXIT. SQ2054.2 +041500 CCVS1-EXIT. SQ2054.2 +041600 EXIT. SQ2054.2 +041700 SECT-SQ205A-0001 SECTION. SQ2054.2 +041800 WRITE-INIT-GF-01. SQ2054.2 +041900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2054.2 +042000 MOVE "SQ205" TO XPROGRAM-NAME (1). SQ2054.2 +042100 MOVE 0120 TO XRECORD-LENGTH (1). SQ2054.2 +042200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2054.2 +042300 MOVE 5 TO XBLOCK-SIZE (1). SQ2054.2 +042400 MOVE 500 TO RECORDS-IN-FILE (1). SQ2054.2 +042500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2054.2 +042600 MOVE "S" TO XLABEL-TYPE (1). SQ2054.2 +042700 MOVE 1 TO XRECORD-NUMBER (1). SQ2054.2 +042800 OPEN OUTPUT SQ-FS1 , SQ-FS2. SQ2054.2 +042900 WRITE-TEST-GF-01-01. SQ2054.2 +043000 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2054.2 +043100 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2054.2 +043200 WRITE SQ-FS1R1-F-G-120. SQ2054.2 +043300 MOVE "SQ-FS2" TO XFILE-NAME (1). SQ2054.2 +043400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS2R1-F-G-120. SQ2054.2 +043500 WRITE SQ-FS2R1-F-G-120. SQ2054.2 +043600 IF XRECORD-NUMBER (1) EQUAL TO 500 SQ2054.2 +043700 GO TO WRITE-TEST-GF-01-02. SQ2054.2 +043800 ADD 1 TO XRECORD-NUMBER (1). SQ2054.2 +043900 GO TO WRITE-TEST-GF-01-01. SQ2054.2 +044000 WRITE-TEST-GF-01-02. SQ2054.2 +044100 MOVE "CREATE FILE SQ-FS1,2" TO FEATURE. SQ2054.2 +044200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2054.2 +044300 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2054.2 +044400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2054.2 +044500 PERFORM PRINT-DETAIL. SQ2054.2 +044600 CLOSE SQ-FS1 , SQ-FS2. SQ2054.2 +044700 READ-INIT-GF-01. SQ2054.2 +044800 OPEN INPUT SQ-FS1. SQ2054.2 +044900 READ-TEST-GF-01-01. SQ2054.2 +045000 READ SQ-FS1. SQ2054.2 +045100 IF SQ-FS1-EOF-STATUS EQUAL TO 1 SQ2054.2 +045200 GO TO READ-TEST-GF-01-02. SQ2054.2 +045300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2054.2 +045400 ADD 1 TO WRK-RECORD-COUNT. SQ2054.2 +045500 IF WRK-RECORD-COUNT GREATER THAN 500 SQ2054.2 +045600 MOVE "MORE THAN 500 RECORDS" TO RE-MARK SQ2054.2 +045700 MOVE "RECORDS READ=" TO COMPUTED-A SQ2054.2 +045800 MOVE WRK-RECORD-COUNT TO CORRECT-18V0 SQ2054.2 +045900 GO TO READ-FAIL-GF-01. SQ2054.2 +046000 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2054.2 +046100 ADD 1 TO RECORDS-IN-ERROR SQ2054.2 +046200 GO TO READ-TEST-GF-01-01. SQ2054.2 +046300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2054.2 +046400 ADD 1 TO RECORDS-IN-ERROR SQ2054.2 +046500 GO TO READ-TEST-GF-01-01. SQ2054.2 +046600 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2054.2 +046700 ADD 1 TO RECORDS-IN-ERROR. SQ2054.2 +046800 GO TO READ-TEST-GF-01-01. SQ2054.2 +046900 READ-TEST-GF-01-02. SQ2054.2 +047000 IF WRK-RECORD-COUNT LESS THAN 500 SQ2054.2 +047100 MOVE "LESS THAN 500 RECORDS;VII-52 OR VII-44" SQ2054.2 +047200 TO RE-MARK SQ2054.2 +047300 MOVE "RECORDS READ=" TO COMPUTED-A SQ2054.2 +047400 MOVE WRK-RECORD-COUNT TO CORRECT-18V0 SQ2054.2 +047500 GO TO READ-FAIL-GF-01. SQ2054.2 +047600 IF SQ-FS1-ERRORS NOT EQUAL TO ZERO SQ2054.2 +047700 MOVE "PERM/IMPL ERRORS ENCOUNTERED;VII-44 OR VII-52"SQ2054.2 +047800 TO RE-MARK SQ2054.2 +047900 MOVE "RECORDS IN ERROR=" TO COMPUTED-A SQ2054.2 +048000 MOVE SQ-FS1-ERRORS TO CORRECT-18V0 SQ2054.2 +048100 GO TO READ-FAIL-GF-01. SQ2054.2 +048200 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2054.2 +048300 MOVE "ERRORS IN READING SQ-FS1; VII-44 OR VII-52" SQ2054.2 +048400 TO RE-MARK SQ2054.2 +048500 MOVE "RECORDS IN ERROR=" TO COMPUTED-A SQ2054.2 +048600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2054.2 +048700 GO TO READ-FAIL-GF-01. SQ2054.2 +048800 GO TO READ-PASS-GF-01. SQ2054.2 +048900 READ-DELETE-GF-01. SQ2054.2 +049000 PERFORM DE-LETE. SQ2054.2 +049100 GO TO READ-WRITE-GF-01. SQ2054.2 +049200 READ-FAIL-GF-01. SQ2054.2 +049300 PERFORM FAIL. SQ2054.2 +049400 GO TO READ-WRITE-GF-01. SQ2054.2 +049500 READ-PASS-GF-01. SQ2054.2 +049600 PERFORM PASS. SQ2054.2 +049700 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2054.2 +049800 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2054.2 +049900 READ-WRITE-GF-01. SQ2054.2 +050000 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2054.2 +050100 MOVE "VERIFY SQ-FS1;F-S:10" TO FEATURE. SQ2054.2 +050200 PERFORM PRINT-DETAIL. SQ2054.2 +050300 READ-CLOSE-GF-01. SQ2054.2 +050400 CLOSE SQ-FS1. SQ2054.2 +050500 READ-INIT-GF-02. SQ2054.2 +050600 MOVE ZERO TO WRK-RECORD-COUNT. SQ2054.2 +050700 OPEN INPUT SQ-FS2. SQ2054.2 +050800 READ-TEST-GF-02-01. SQ2054.2 +050900 READ SQ-FS2 RECORD. SQ2054.2 +051000 IF SQ-FS2-EOF-STATUS EQUAL 1 SQ2054.2 +051100 GO TO READ-TEST-GF-02-02. SQ2054.2 +051200 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2054.2 +051300 ADD 1 TO WRK-RECORD-COUNT. SQ2054.2 +051400 IF WRK-RECORD-COUNT GREATER THAN 500 SQ2054.2 +051500 MOVE "MORE THAN 500 RECORDS" TO RE-MARK SQ2054.2 +051600 MOVE "RECORDS READ =" TO COMPUTED-A SQ2054.2 +051700 MOVE WRK-RECORD-COUNT TO CORRECT-18V0 SQ2054.2 +051800 GO TO READ-FAIL-GF-02. SQ2054.2 +051900 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2054.2 +052000 ADD 1 TO RECORDS-IN-ERROR SQ2054.2 +052100 GO TO READ-TEST-GF-02-01. SQ2054.2 +052200 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS2" SQ2054.2 +052300 ADD 1 TO RECORDS-IN-ERROR SQ2054.2 +052400 GO TO READ-TEST-GF-02-01. SQ2054.2 +052500 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2054.2 +052600 ADD 1 TO RECORDS-IN-ERROR. SQ2054.2 +052700 GO TO READ-TEST-GF-02-01. SQ2054.2 +052800 READ-TEST-GF-02-02. SQ2054.2 +052900 IF WRK-RECORD-COUNT LESS THAN 500 SQ2054.2 +053000 MOVE "LESS THAN 500 RECORDS; VII-44 OR VII-52" SQ2054.2 +053100 TO RE-MARK SQ2054.2 +053200 MOVE "RECORDS READ =" TO COMPUTED-A SQ2054.2 +053300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0 SQ2054.2 +053400 GO TO READ-FAIL-GF-02. SQ2054.2 +053500 IF SQ-FS2-ERRORS NOT EQUAL TO ZERO SQ2054.2 +053600 MOVE "PERM/IMPL ERRORS ENCOUNTERED;VII-44 OR -52" SQ2054.2 +053700 TO RE-MARK SQ2054.2 +053800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2054.2 +053900 MOVE SQ-FS2-ERRORS TO CORRECT-18V0 SQ2054.2 +054000 GO TO READ-FAIL-GF-02. SQ2054.2 +054100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2054.2 +054200 MOVE "ERRORS IN READING SQ-FS2; VII-44 OR VII-52" SQ2054.2 +054300 TO RE-MARK SQ2054.2 +054400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2054.2 +054500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2054.2 +054600 GO TO READ-FAIL-GF-02. SQ2054.2 +054700 GO TO READ-PASS-GF-02. SQ2054.2 +054800 READ-DELETE-GF-02. SQ2054.2 +054900 PERFORM DE-LETE. SQ2054.2 +055000 GO TO READ-WRITE-GF-02. SQ2054.2 +055100 READ-FAIL-GF-02. SQ2054.2 +055200 PERFORM FAIL. SQ2054.2 +055300 GO TO READ-WRITE-GF-02. SQ2054.2 +055400 READ-PASS-GF-02. SQ2054.2 +055500 PERFORM PASS. SQ2054.2 +055600 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2054.2 +055700 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2054.2 +055800 READ-WRITE-GF-02. SQ2054.2 +055900 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2054.2 +056000 MOVE "VERIFY SQ-FS2;F-S:10" TO FEATURE. SQ2054.2 +056100 PERFORM PRINT-DETAIL. SQ2054.2 +056200 READ-CLOSE-GF-02. SQ2054.2 +056300 CLOSE SQ-FS2. SQ2054.2 +056400 SQ205A-END-ROUTINE. SQ2054.2 +056500 MOVE "END OF SQ205A VALIDATION TESTS" TO PRINT-REC. SQ2054.2 +056600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2054.2 +056700 TERMINATE-SQ205A. SQ2054.2 +056800 EXIT. SQ2054.2 +056900 CCVS-EXIT SECTION. SQ2054.2 +057000 CCVS-999999. SQ2054.2 +057100 GO TO CLOSE-FILES. SQ2054.2 diff --git a/tests/cobol85/SQ/SQ206A.CBL b/tests/cobol85/SQ/SQ206A.CBL new file mode 100755 index 00000000..e2ac36fe --- /dev/null +++ b/tests/cobol85/SQ/SQ206A.CBL @@ -0,0 +1,689 @@ +000100 IDENTIFICATION DIVISION. SQ2064.2 +000200 PROGRAM-ID. SQ2064.2 +000300 SQ206A. SQ2064.2 +000400**************************************************************** SQ2064.2 +000500* * SQ2064.2 +000600* VALIDATION FOR:- * SQ2064.2 +000700* " HIGH ". SQ2064.2 +000800* * SQ2064.2 +000900* CREATION DATE / VALIDATION DATE * SQ2064.2 +001000* "4.2 ". SQ2064.2 +001100* * SQ2064.2 +001200* THE ROUTINE SQ206A TESTS THE USE OF THE CLAUSES SAME SQ2064.2 +001300* RECORD AREA AND SAME AREA OF THE I-O-CONTROL PARAGRAPH. SQ2064.2 +001400* TAPE FILES AND MASS-STORAGE FILES ARE CREATED WHICH SQ2064.2 +001500* REFERENCE THE SAME RECORD AREA OR ARE NAMED IN A SAME AREA SQ2064.2 +001600* CLAUSE. THE FILES ARE PROCESSED AND THE CONTENTS OF THE SQ2064.2 +001700* RECORDS VERIFIED AGAINST THE EXPECTED RESULTS. SQ2064.2 +001800 ENVIRONMENT DIVISION. SQ2064.2 +001900 CONFIGURATION SECTION. SQ2064.2 +002000 SOURCE-COMPUTER. SQ2064.2 +002100 Linux. SQ2064.2 +002200 OBJECT-COMPUTER. SQ2064.2 +002300 Linux. SQ2064.2 +002400 INPUT-OUTPUT SECTION. SQ2064.2 +002500 FILE-CONTROL. SQ2064.2 +002600*P SELECT RAW-DATA ASSIGN TO SQ2064.2 +002700*P "XXXXX062" SQ2064.2 +002800*P ORGANIZATION IS INDEXED SQ2064.2 +002900*P ACCESS MODE IS RANDOM SQ2064.2 +003000*P RECORD KEY IS RAW-DATA-KEY. SQ2064.2 +003100 SELECT PRINT-FILE ASSIGN TO SQ2064.2 +003200 "report.log". SQ2064.2 +003300 SELECT SQ-FS1 ASSIGN TO SQ2064.2 +003400 "XXXXX001" SQ2064.2 +003500 ORGANIZATION SEQUENTIAL. SQ2064.2 +003600 SELECT SQ-FS2 ASSIGN SQ2064.2 +003700 "XXXXX014" SQ2064.2 +003800 ACCESS IS SEQUENTIAL. SQ2064.2 +003900 SELECT SQ-FS3 ASSIGN TO SQ2064.2 +004000 "XXXXX015" SQ2064.2 +004100 ORGANIZATION IS SEQUENTIAL SQ2064.2 +004200 ACCESS MODE SEQUENTIAL. SQ2064.2 +004300 SELECT SQ-FS4 ASSIGN SQ2064.2 +004400 "XXXXX002" SQ2064.2 +004500 ORGANIZATION SEQUENTIAL SQ2064.2 +004600 ACCESS SEQUENTIAL. SQ2064.2 +004700 I-O-CONTROL. SQ2064.2 +004800 SAME SQ-FS1, SQ-FS2 SQ2064.2 +004900 SAME RECORD AREA FOR SQ-FS1, SQ-FS2, SQ-FS3, SQ-FS4. SQ2064.2 +005000 DATA DIVISION. SQ2064.2 +005100 FILE SECTION. SQ2064.2 +005200*P SQ2064.2 +005300*PD RAW-DATA. SQ2064.2 +005400*P SQ2064.2 +005500*P1 RAW-DATA-SATZ. SQ2064.2 +005600*P 05 RAW-DATA-KEY PIC X(6). SQ2064.2 +005700*P 05 C-DATE PIC 9(6). SQ2064.2 +005800*P 05 C-TIME PIC 9(8). SQ2064.2 +005900*P 05 C-NO-OF-TESTS PIC 99. SQ2064.2 +006000*P 05 C-OK PIC 999. SQ2064.2 +006100*P 05 C-ALL PIC 999. SQ2064.2 +006200*P 05 C-FAIL PIC 999. SQ2064.2 +006300*P 05 C-DELETED PIC 999. SQ2064.2 +006400*P 05 C-INSPECT PIC 999. SQ2064.2 +006500*P 05 C-NOTE PIC X(13). SQ2064.2 +006600*P 05 C-INDENT PIC X. SQ2064.2 +006700*P 05 C-ABORT PIC X(8). SQ2064.2 +006800 FD PRINT-FILE SQ2064.2 +006900*C LABEL RECORDS SQ2064.2 +007000*C OMITTED SQ2064.2 +007100*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2064.2 +007200 . SQ2064.2 +007300 01 PRINT-REC PICTURE X(120). SQ2064.2 +007400 01 DUMMY-RECORD PICTURE X(120). SQ2064.2 +007500 FD SQ-FS1 SQ2064.2 +007600*C LABEL RECORDS ARE STANDARD SQ2064.2 +007700 BLOCK CONTAINS 120 CHARACTERS. SQ2064.2 +007800 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2064.2 +007900 FD SQ-FS2 SQ2064.2 +008000*C LABEL RECORD IS STANDARD SQ2064.2 +008100 . SQ2064.2 +008200 01 SQ-FS2R1-F-G-120 PIC X(120). SQ2064.2 +008300 FD SQ-FS3 SQ2064.2 +008400*C LABEL RECORD STANDARD SQ2064.2 +008500 . SQ2064.2 +008600 01 SQ-FS3R1-F-G-120 PIC X(120). SQ2064.2 +008700 FD SQ-FS4 SQ2064.2 +008800*C LABEL RECORDS STANDARD SQ2064.2 +008900 . SQ2064.2 +009000 01 SQ-FS4R1-F-G-120 PIC X(120). SQ2064.2 +009100 WORKING-STORAGE SECTION. SQ2064.2 +009200 77 WRK-RECORD-COUNT PIC 9(4) VALUE 0. SQ2064.2 +009300 77 RECORDS-IN-ERROR PIC 9(4) VALUE 0. SQ2064.2 +009400 01 COUNT-OF-RECS PIC 9999. SQ2064.2 +009500 01 FILE-RECORD-INFORMATION-REC. SQ2064.2 +009600 03 FILE-RECORD-INFO-SKELETON. SQ2064.2 +009700 05 FILLER PICTURE X(48) VALUE SQ2064.2 +009800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2064.2 +009900 05 FILLER PICTURE X(46) VALUE SQ2064.2 +010000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2064.2 +010100 05 FILLER PICTURE X(26) VALUE SQ2064.2 +010200 ",LFIL=000000,ORG= ,LBLR= ". SQ2064.2 +010300 05 FILLER PICTURE X(37) VALUE SQ2064.2 +010400 ",RECKEY= ". SQ2064.2 +010500 05 FILLER PICTURE X(38) VALUE SQ2064.2 +010600 ",ALTKEY1= ". SQ2064.2 +010700 05 FILLER PICTURE X(38) VALUE SQ2064.2 +010800 ",ALTKEY2= ". SQ2064.2 +010900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2064.2 +011000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2064.2 +011100 05 FILE-RECORD-INFO-P1-120. SQ2064.2 +011200 07 FILLER PIC X(5). SQ2064.2 +011300 07 XFILE-NAME PIC X(6). SQ2064.2 +011400 07 FILLER PIC X(8). SQ2064.2 +011500 07 XRECORD-NAME PIC X(6). SQ2064.2 +011600 07 FILLER PIC X(1). SQ2064.2 +011700 07 REELUNIT-NUMBER PIC 9(1). SQ2064.2 +011800 07 FILLER PIC X(7). SQ2064.2 +011900 07 XRECORD-NUMBER PIC 9(6). SQ2064.2 +012000 07 FILLER PIC X(6). SQ2064.2 +012100 07 UPDATE-NUMBER PIC 9(2). SQ2064.2 +012200 07 FILLER PIC X(5). SQ2064.2 +012300 07 ODO-NUMBER PIC 9(4). SQ2064.2 +012400 07 FILLER PIC X(5). SQ2064.2 +012500 07 XPROGRAM-NAME PIC X(5). SQ2064.2 +012600 07 FILLER PIC X(7). SQ2064.2 +012700 07 XRECORD-LENGTH PIC 9(6). SQ2064.2 +012800 07 FILLER PIC X(7). SQ2064.2 +012900 07 CHARS-OR-RECORDS PIC X(2). SQ2064.2 +013000 07 FILLER PIC X(1). SQ2064.2 +013100 07 XBLOCK-SIZE PIC 9(4). SQ2064.2 +013200 07 FILLER PIC X(6). SQ2064.2 +013300 07 RECORDS-IN-FILE PIC 9(6). SQ2064.2 +013400 07 FILLER PIC X(5). SQ2064.2 +013500 07 XFILE-ORGANIZATION PIC X(2). SQ2064.2 +013600 07 FILLER PIC X(6). SQ2064.2 +013700 07 XLABEL-TYPE PIC X(1). SQ2064.2 +013800 05 FILE-RECORD-INFO-P121-240. SQ2064.2 +013900 07 FILLER PIC X(8). SQ2064.2 +014000 07 XRECORD-KEY PIC X(29). SQ2064.2 +014100 07 FILLER PIC X(9). SQ2064.2 +014200 07 ALTERNATE-KEY1 PIC X(29). SQ2064.2 +014300 07 FILLER PIC X(9). SQ2064.2 +014400 07 ALTERNATE-KEY2 PIC X(29). SQ2064.2 +014500 07 FILLER PIC X(7). SQ2064.2 +014600 01 TEST-RESULTS. SQ2064.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2064.2 +014800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2064.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ2064.2 +015000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2064.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ2064.2 +015200 02 PAR-NAME. SQ2064.2 +015300 03 FILLER PICTURE X(12) VALUE SPACE. SQ2064.2 +015400 03 PARDOT-X PICTURE X VALUE SPACE. SQ2064.2 +015500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2064.2 +015600 03 FILLER PIC X(5) VALUE SPACE. SQ2064.2 +015700 02 FILLER PIC X(10) VALUE SPACE. SQ2064.2 +015800 02 RE-MARK PIC X(61). SQ2064.2 +015900 01 TEST-COMPUTED. SQ2064.2 +016000 02 FILLER PIC X(30) VALUE SPACE. SQ2064.2 +016100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2064.2 +016200 02 COMPUTED-X. SQ2064.2 +016300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2064.2 +016400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2064.2 +016500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2064.2 +016600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2064.2 +016700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2064.2 +016800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2064.2 +016900 04 COMPUTED-18V0 PICTURE -9(18). SQ2064.2 +017000 04 FILLER PICTURE X. SQ2064.2 +017100 03 FILLER PIC X(50) VALUE SPACE. SQ2064.2 +017200 01 TEST-CORRECT. SQ2064.2 +017300 02 FILLER PIC X(30) VALUE SPACE. SQ2064.2 +017400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2064.2 +017500 02 CORRECT-X. SQ2064.2 +017600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2064.2 +017700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2064.2 +017800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2064.2 +017900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2064.2 +018000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2064.2 +018100 03 CR-18V0 REDEFINES CORRECT-A. SQ2064.2 +018200 04 CORRECT-18V0 PICTURE -9(18). SQ2064.2 +018300 04 FILLER PICTURE X. SQ2064.2 +018400 03 FILLER PIC X(50) VALUE SPACE. SQ2064.2 +018500 01 CCVS-C-1. SQ2064.2 +018600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2064.2 +018700- "SS PARAGRAPH-NAME SQ2064.2 +018800- " REMARKS". SQ2064.2 +018900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2064.2 +019000 01 CCVS-C-2. SQ2064.2 +019100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2064.2 +019200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2064.2 +019300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2064.2 +019400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2064.2 +019500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2064.2 +019600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2064.2 +019700 01 REC-CT PICTURE 99 VALUE ZERO. SQ2064.2 +019800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2064.2 +019900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2064.2 +020000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2064.2 +020100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2064.2 +020200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2064.2 +020300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2064.2 +020400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2064.2 +020500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2064.2 +020600 01 CCVS-H-1. SQ2064.2 +020700 02 FILLER PICTURE X(27) VALUE SPACE. SQ2064.2 +020800 02 FILLER PICTURE X(67) VALUE SQ2064.2 +020900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2064.2 +021000- " SYSTEM". SQ2064.2 +021100 02 FILLER PICTURE X(26) VALUE SPACE. SQ2064.2 +021200 01 CCVS-H-2. SQ2064.2 +021300 02 FILLER PICTURE X(52) VALUE IS SQ2064.2 +021400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2064.2 +021500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2064.2 +021600 02 TEST-ID PICTURE IS X(9). SQ2064.2 +021700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2064.2 +021800 01 CCVS-H-3. SQ2064.2 +021900 02 FILLER PICTURE X(34) VALUE SQ2064.2 +022000 " FOR OFFICIAL USE ONLY ". SQ2064.2 +022100 02 FILLER PICTURE X(58) VALUE SQ2064.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2064.2 +022300 02 FILLER PICTURE X(28) VALUE SQ2064.2 +022400 " COPYRIGHT 1985 ". SQ2064.2 +022500 01 CCVS-E-1. SQ2064.2 +022600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2064.2 +022700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2064.2 +022800 02 ID-AGAIN PICTURE IS X(9). SQ2064.2 +022900 02 FILLER PICTURE X(45) VALUE IS SQ2064.2 +023000 " NTIS DISTRIBUTION COBOL 85". SQ2064.2 +023100 01 CCVS-E-2. SQ2064.2 +023200 02 FILLER PICTURE X(31) VALUE SQ2064.2 +023300 SPACE. SQ2064.2 +023400 02 FILLER PICTURE X(21) VALUE SPACE. SQ2064.2 +023500 02 CCVS-E-2-2. SQ2064.2 +023600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2064.2 +023700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2064.2 +023800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2064.2 +023900 01 CCVS-E-3. SQ2064.2 +024000 02 FILLER PICTURE X(22) VALUE SQ2064.2 +024100 " FOR OFFICIAL USE ONLY". SQ2064.2 +024200 02 FILLER PICTURE X(12) VALUE SPACE. SQ2064.2 +024300 02 FILLER PICTURE X(58) VALUE SQ2064.2 +024400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2064.2 +024500 02 FILLER PICTURE X(13) VALUE SPACE. SQ2064.2 +024600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2064.2 +024700 01 CCVS-E-4. SQ2064.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2064.2 +024900 02 FILLER PIC XXXX VALUE " OF ". SQ2064.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2064.2 +025100 02 FILLER PIC X(40) VALUE SQ2064.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2064.2 +025300 01 XXINFO. SQ2064.2 +025400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2064.2 +025500 02 INFO-TEXT. SQ2064.2 +025600 04 FILLER PIC X(20) VALUE SPACE. SQ2064.2 +025700 04 XXCOMPUTED PIC X(20). SQ2064.2 +025800 04 FILLER PIC X(5) VALUE SPACE. SQ2064.2 +025900 04 XXCORRECT PIC X(20). SQ2064.2 +026000 01 HYPHEN-LINE. SQ2064.2 +026100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2064.2 +026200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2064.2 +026300- "*****************************************". SQ2064.2 +026400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2064.2 +026500- "******************************". SQ2064.2 +026600 01 CCVS-PGM-ID PIC X(6) VALUE SQ2064.2 +026700 "SQ206A". SQ2064.2 +026800 PROCEDURE DIVISION. SQ2064.2 +026900 CCVS1 SECTION. SQ2064.2 +027000 OPEN-FILES. SQ2064.2 +027100*P OPEN I-O RAW-DATA. SQ2064.2 +027200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2064.2 +027300*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2064.2 +027400*P MOVE "ABORTED " TO C-ABORT. SQ2064.2 +027500*P ADD 1 TO C-NO-OF-TESTS. SQ2064.2 +027600*P ACCEPT C-DATE FROM DATE. SQ2064.2 +027700*P ACCEPT C-TIME FROM TIME. SQ2064.2 +027800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2064.2 +027900*PND-E-1. SQ2064.2 +028000*P CLOSE RAW-DATA. SQ2064.2 +028100 OPEN OUTPUT PRINT-FILE. SQ2064.2 +028200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2064.2 +028300 MOVE SPACE TO TEST-RESULTS. SQ2064.2 +028400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2064.2 +028500 MOVE ZERO TO REC-SKL-SUB. SQ2064.2 +028600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2064.2 +028700 CCVS-INIT-FILE. SQ2064.2 +028800 ADD 1 TO REC-SKL-SUB. SQ2064.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2064.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2064.2 +029100 CCVS-INIT-EXIT. SQ2064.2 +029200 GO TO CCVS1-EXIT. SQ2064.2 +029300 CLOSE-FILES. SQ2064.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2064.2 +029500*P OPEN I-O RAW-DATA. SQ2064.2 +029600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2064.2 +029700*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2064.2 +029800*P MOVE "OK. " TO C-ABORT. SQ2064.2 +029900*P MOVE PASS-COUNTER TO C-OK. SQ2064.2 +030000*P MOVE ERROR-HOLD TO C-ALL. SQ2064.2 +030100*P MOVE ERROR-COUNTER TO C-FAIL. SQ2064.2 +030200*P MOVE DELETE-CNT TO C-DELETED. SQ2064.2 +030300*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2064.2 +030400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2064.2 +030500*PND-E-2. SQ2064.2 +030600*P CLOSE RAW-DATA. SQ2064.2 +030700 TERMINATE-CCVS. SQ2064.2 +030800*S EXIT PROGRAM. SQ2064.2 +030900*SERMINATE-CALL. SQ2064.2 +031000 STOP RUN. SQ2064.2 +031100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2064.2 +031200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2064.2 +031300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2064.2 +031400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2064.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2064.2 +031600 PRINT-DETAIL. SQ2064.2 +031700 IF REC-CT NOT EQUAL TO ZERO SQ2064.2 +031800 MOVE "." TO PARDOT-X SQ2064.2 +031900 MOVE REC-CT TO DOTVALUE. SQ2064.2 +032000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2064.2 +032100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2064.2 +032200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2064.2 +032300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2064.2 +032400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2064.2 +032500 MOVE SPACE TO CORRECT-X. SQ2064.2 +032600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2064.2 +032700 MOVE SPACE TO RE-MARK. SQ2064.2 +032800 HEAD-ROUTINE. SQ2064.2 +032900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +033000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2064.2 +033100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2064.2 +033200 COLUMN-NAMES-ROUTINE. SQ2064.2 +033300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +033400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +033600 END-ROUTINE. SQ2064.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2064.2 +033800 END-RTN-EXIT. SQ2064.2 +033900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +034000 END-ROUTINE-1. SQ2064.2 +034100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2064.2 +034200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2064.2 +034300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2064.2 +034400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2064.2 +034500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2064.2 +034600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2064.2 +034700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2064.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2064.2 +034900 END-ROUTINE-12. SQ2064.2 +035000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2064.2 +035100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2064.2 +035200 MOVE "NO " TO ERROR-TOTAL SQ2064.2 +035300 ELSE SQ2064.2 +035400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2064.2 +035500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2064.2 +035600 PERFORM WRITE-LINE. SQ2064.2 +035700 END-ROUTINE-13. SQ2064.2 +035800 IF DELETE-CNT IS EQUAL TO ZERO SQ2064.2 +035900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2064.2 +036000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2064.2 +036100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2064.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +036300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2064.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2064.2 +036500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2064.2 +036600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2064.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +036800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2064.2 +036900 WRITE-LINE. SQ2064.2 +037000 ADD 1 TO RECORD-COUNT. SQ2064.2 +037100 IF RECORD-COUNT GREATER 50 SQ2064.2 +037200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2064.2 +037300 MOVE SPACE TO DUMMY-RECORD SQ2064.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2064.2 +037500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2064.2 +037600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2064.2 +037700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2064.2 +037800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2064.2 +037900 MOVE ZERO TO RECORD-COUNT. SQ2064.2 +038000 PERFORM WRT-LN. SQ2064.2 +038100 WRT-LN. SQ2064.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2064.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ2064.2 +038400 BLANK-LINE-PRINT. SQ2064.2 +038500 PERFORM WRT-LN. SQ2064.2 +038600 FAIL-ROUTINE. SQ2064.2 +038700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2064.2 +038800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2064.2 +038900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2064.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +039100 GO TO FAIL-ROUTINE-EX. SQ2064.2 +039200 FAIL-ROUTINE-WRITE. SQ2064.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2064.2 +039400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +039500 FAIL-ROUTINE-EX. EXIT. SQ2064.2 +039600 BAIL-OUT. SQ2064.2 +039700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2064.2 +039800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2064.2 +039900 BAIL-OUT-WRITE. SQ2064.2 +040000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2064.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2064.2 +040200 BAIL-OUT-EX. EXIT. SQ2064.2 +040300 CCVS1-EXIT. SQ2064.2 +040400 EXIT. SQ2064.2 +040500 SECT-SQ206A-0001 SECTION. SQ2064.2 +040600 WRITE-INIT-GF-01. SQ2064.2 +040700* IN THIS TEST TWO FILES ARE CREATED USING THE SAME SQ2064.2 +040800* RECORD AREA. THE LOGICAL RECORD WRITTEN ON SQ-FS1 SQ2064.2 +040900* REMAINS IN THE RECORD AREA TO BE WRITTEN ON SQ-FS3. SQ2064.2 +041000* ONLY THE FILE NAMES CHANGE. SQ2064.2 +041100 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2064.2 +041200 MOVE "SQ206" TO XPROGRAM-NAME (1). SQ2064.2 +041300 MOVE 120 TO XRECORD-LENGTH (1). SQ2064.2 +041400 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2064.2 +041500 MOVE 1 TO XBLOCK-SIZE (1). SQ2064.2 +041600 MOVE 750 TO RECORDS-IN-FILE (1). SQ2064.2 +041700 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2064.2 +041800 MOVE "S" TO XLABEL-TYPE (1). SQ2064.2 +041900 MOVE 1 TO XRECORD-NUMBER (1). SQ2064.2 +042000 OPEN OUTPUT SQ-FS1, SQ-FS3. SQ2064.2 +042100 WRITE-TEST-GF-01. SQ2064.2 +042200 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2064.2 +042300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2064.2 +042400 WRITE SQ-FS1R1-F-G-120. SQ2064.2 +042500 MOVE "SQ-FS3" TO XFILE-NAME (1). SQ2064.2 +042600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS3R1-F-G-120. SQ2064.2 +042700 WRITE SQ-FS3R1-F-G-120. SQ2064.2 +042800 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2064.2 +042900 GO TO WRITE-WRITE-GF-01. SQ2064.2 +043000 ADD 1 TO XRECORD-NUMBER (1). SQ2064.2 +043100 GO TO WRITE-TEST-GF-01. SQ2064.2 +043200 WRITE-DELETE-GF-01. SQ2064.2 +043300 PERFORM DE-LETE. SQ2064.2 +043400 WRITE-WRITE-GF-01. SQ2064.2 +043500 MOVE "CREATE SQ-FS1,SQ-FS3" TO FEATURE. SQ2064.2 +043600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2064.2 +043700 MOVE "FILES CREATED RECS =" TO COMPUTED-A. SQ2064.2 +043800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2064.2 +043900 PERFORM PRINT-DETAIL. SQ2064.2 +044000 CLOSE SQ-FS1, SQ-FS3. SQ2064.2 +044100 WRITE-INIT-GF-02. SQ2064.2 +044200 MOVE "SQ-FS4" TO XFILE-NAME (2). SQ2064.2 +044300 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ2064.2 +044400 MOVE "SQ206" TO XPROGRAM-NAME (2). SQ2064.2 +044500 MOVE 120 TO XRECORD-LENGTH (2). SQ2064.2 +044600 MOVE "RC" TO CHARS-OR-RECORDS (2). SQ2064.2 +044700 MOVE 1 TO XBLOCK-SIZE (2). SQ2064.2 +044800 MOVE 750 TO RECORDS-IN-FILE (2). SQ2064.2 +044900 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ2064.2 +045000 MOVE "S" TO XLABEL-TYPE (2). SQ2064.2 +045100 MOVE 1 TO XRECORD-NUMBER (2). SQ2064.2 +045200 OPEN INPUT SQ-FS1, SQ-FS3 SQ2064.2 +045300 OUTPUT SQ-FS4. SQ2064.2 +045400 WRITE-TEST-GF-02. SQ2064.2 +045500 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS4R1-F-G-120. SQ2064.2 +045600 WRITE SQ-FS4R1-F-G-120. SQ2064.2 +045700 IF XRECORD-NUMBER (2) EQUAL TO 750 SQ2064.2 +045800 GO TO WRITE-WRITE-GF-02. SQ2064.2 +045900 ADD 1 TO XRECORD-NUMBER (2). SQ2064.2 +046000 GO TO WRITE-TEST-GF-02. SQ2064.2 +046100 WRITE-DELETE-GF-02. SQ2064.2 +046200 PERFORM DE-LETE. SQ2064.2 +046300 WRITE-WRITE-GF-02. SQ2064.2 +046400 MOVE "CREATE FILE SQ-FS4" TO FEATURE. SQ2064.2 +046500 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2064.2 +046600 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2064.2 +046700 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2064.2 +046800 PERFORM PRINT-DETAIL. SQ2064.2 +046900 CLOSE SQ-FS4. SQ2064.2 +047000 READ-INIT-GF-01. SQ2064.2 +047100* THIS TEST READS AND VALIDATES SQ-FS1 WHICH WAS SQ2064.2 +047200* CREATED IN WRITE-TEST-GF-01. SQ-FS1 IS OPENED FOR SQ2064.2 +047300* INPUT IN WRITE-INIT-GF-02. SQ2064.2 +047400 MOVE 0 TO WRK-RECORD-COUNT, RECORDS-IN-ERROR. SQ2064.2 +047500 READ-TEST-GF-01. SQ2064.2 +047600 READ SQ-FS1 SQ2064.2 +047700 AT END GO TO READ-TEST-GF-01-01. SQ2064.2 +047800 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2064.2 +047900 ADD 1 TO WRK-RECORD-COUNT. SQ2064.2 +048000 IF WRK-RECORD-COUNT GREATER THAN 750 SQ2064.2 +048100 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2064.2 +048200 GO TO READ-FAIL-GF-01. SQ2064.2 +048300 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2064.2 +048400 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +048500 GO TO READ-TEST-GF-01. SQ2064.2 +048600 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2064.2 +048700 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +048800 GO TO READ-TEST-GF-01. SQ2064.2 +048900 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2064.2 +049000 ADD 1 TO RECORDS-IN-ERROR. SQ2064.2 +049100 GO TO READ-TEST-GF-01. SQ2064.2 +049200 READ-TEST-GF-01-01. SQ2064.2 +049300 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2064.2 +049400 GO TO READ-PASS-GF-01. SQ2064.2 +049500 MOVE "ERRORS IN READING-SQ-FS1" TO RE-MARK. SQ2064.2 +049600 GO TO READ-FAIL-GF-01. SQ2064.2 +049700 READ-DELETE-GF-01. SQ2064.2 +049800 PERFORM DE-LETE. SQ2064.2 +049900 GO TO READ-WRITE-GF-01. SQ2064.2 +050000 READ-FAIL-GF-01. SQ2064.2 +050100 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2064.2 +050200 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2064.2 +050300 PERFORM FAIL. SQ2064.2 +050400 GO TO READ-WRITE-GF-01. SQ2064.2 +050500 READ-PASS-GF-01. SQ2064.2 +050600 PERFORM PASS. SQ2064.2 +050700 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2064.2 +050800 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2064.2 +050900 READ-WRITE-GF-01. SQ2064.2 +051000 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2064.2 +051100 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2064.2 +051200 PERFORM PRINT-DETAIL. SQ2064.2 +051300 READ-CLOSE-GF-01. SQ2064.2 +051400 CLOSE SQ-FS1. SQ2064.2 +051500 READ-INIT-GF-02. SQ2064.2 +051600* THIS TEST READS AND VALIDATES SQ-FS3 WHICH WAS SQ2064.2 +051700* CREATED IN WRITE-TEST-GF-01. SQ-FS3 IS OPENED FOR SQ2064.2 +051800* INPUT IN WRITE-INIT-GF-02. SQ2064.2 +051900 MOVE 0 TO WRK-RECORD-COUNT, RECORDS-IN-ERROR. SQ2064.2 +052000 READ-TEST-GF-02. SQ2064.2 +052100 READ SQ-FS3 SQ2064.2 +052200 AT END GO TO READ-TEST-GF-02-01. SQ2064.2 +052300 MOVE SQ-FS3R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (3). SQ2064.2 +052400 ADD 1 TO WRK-RECORD-COUNT. SQ2064.2 +052500 IF WRK-RECORD-COUNT GREATER THAN 750 SQ2064.2 +052600 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2064.2 +052700 GO TO READ-FAIL-GF-02. SQ2064.2 +052800 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (3) SQ2064.2 +052900 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +053000 GO TO READ-TEST-GF-02. SQ2064.2 +053100 IF XFILE-NAME (3) NOT EQUAL TO "SQ-FS3" SQ2064.2 +053200 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +053300 GO TO READ-TEST-GF-02. SQ2064.2 +053400 IF XLABEL-TYPE (3) NOT EQUAL TO "S" SQ2064.2 +053500 ADD 1 TO RECORDS-IN-ERROR. SQ2064.2 +053600 GO TO READ-TEST-GF-02. SQ2064.2 +053700 READ-TEST-GF-02-01. SQ2064.2 +053800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2064.2 +053900 GO TO READ-PASS-GF-02. SQ2064.2 +054000 MOVE "ERRORS IN READING SQ-FS3" TO RE-MARK. SQ2064.2 +054100 GO TO READ-FAIL-GF-02. SQ2064.2 +054200 READ-DELETE-GF-02. SQ2064.2 +054300 PERFORM DE-LETE. SQ2064.2 +054400 GO TO READ-WRITE-GF-02. SQ2064.2 +054500 READ-FAIL-GF-02. SQ2064.2 +054600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2064.2 +054700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2064.2 +054800 PERFORM FAIL. SQ2064.2 +054900 GO TO READ-WRITE-GF-02. SQ2064.2 +055000 READ-PASS-GF-02. SQ2064.2 +055100 PERFORM PASS. SQ2064.2 +055200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2064.2 +055300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2064.2 +055400 READ-WRITE-GF-02. SQ2064.2 +055500 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2064.2 +055600 MOVE "VERIFY FILE SQ-FS3" TO FEATURE. SQ2064.2 +055700 PERFORM PRINT-DETAIL. SQ2064.2 +055800 READ-CLOSE-GF-02. SQ2064.2 +055900 CLOSE SQ-FS3. SQ2064.2 +056000 READ-INIT-GF-03. SQ2064.2 +056100* IN THIS TEST SQ-FS2 IS CREATED AND SQ-FS4 IS READ SQ2064.2 +056200* AND VALIDATED USING SAME RECORD AREA. SQ-FS4 WAS SQ2064.2 +056300* CREATED IN WRITE-TEST-GF-02. SQ2064.2 +056400 MOVE "SQ-FS2" TO XFILE-NAME (2). SQ2064.2 +056500 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ2064.2 +056600 MOVE "SQ206" TO XPROGRAM-NAME (2). SQ2064.2 +056700 MOVE 120 TO XRECORD-LENGTH (2). SQ2064.2 +056800 MOVE "RC" TO CHARS-OR-RECORDS (2). SQ2064.2 +056900 MOVE 1 TO XBLOCK-SIZE (2). SQ2064.2 +057000 MOVE 750 TO RECORDS-IN-FILE (2). SQ2064.2 +057100 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ2064.2 +057200 MOVE "S" TO XLABEL-TYPE (2). SQ2064.2 +057300 MOVE 1 TO XRECORD-NUMBER (2). SQ2064.2 +057400 OPEN INPUT SQ-FS4 SQ2064.2 +057500 OUTPUT SQ-FS2. SQ2064.2 +057600 READ-TEST-GF-03. SQ2064.2 +057700 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ2064.2 +057800 WRITE SQ-FS2R1-F-G-120. SQ2064.2 +057900 IF XRECORD-NUMBER (2) EQUAL TO 750 SQ2064.2 +058000 GO TO READ-WRITE-GF-03. SQ2064.2 +058100 ADD 1 TO XRECORD-NUMBER (2). SQ2064.2 +058200 GO TO READ-TEST-GF-03. SQ2064.2 +058300 READ-DELETE-GF-03. SQ2064.2 +058400 PERFORM DE-LETE. SQ2064.2 +058500 READ-WRITE-GF-03. SQ2064.2 +058600 MOVE "CREATE FILE SQ-FS2" TO FEATURE. SQ2064.2 +058700 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ2064.2 +058800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2064.2 +058900 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2064.2 +059000 PERFORM PRINT-DETAIL. SQ2064.2 +059100 CLOSE SQ-FS2. SQ2064.2 +059200 READ-INIT-GF-04. SQ2064.2 +059300* THIS TEST READS AND VALIDATES SQ-FS4 WHICH WAS SQ2064.2 +059400* CREATED IN WRITE-TEST-GF-02. SQ-FS4 IS OPENED FOR SQ2064.2 +059500* INPUT IN WRITE-INIT-GF-03. SQ2064.2 +059600 MOVE 0 TO WRK-RECORD-COUNT, RECORDS-IN-ERROR. SQ2064.2 +059700 READ-TEST-GF-04. SQ2064.2 +059800 READ SQ-FS4 SQ2064.2 +059900 AT END GO TO READ-TEST-GF-04-01. SQ2064.2 +060000 MOVE SQ-FS4R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (4). SQ2064.2 +060100 ADD 1 TO WRK-RECORD-COUNT. SQ2064.2 +060200 IF WRK-RECORD-COUNT GREATER THAN 750 SQ2064.2 +060300 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2064.2 +060400 GO TO READ-FAIL-GF-04. SQ2064.2 +060500 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (4) SQ2064.2 +060600 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +060700 GO TO READ-TEST-GF-04. SQ2064.2 +060800 IF XFILE-NAME (4) NOT EQUAL TO "SQ-FS4" SQ2064.2 +060900 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +061000 GO TO READ-TEST-GF-04. SQ2064.2 +061100 IF XLABEL-TYPE (4) NOT EQUAL TO "S" SQ2064.2 +061200 ADD 1 TO RECORDS-IN-ERROR. SQ2064.2 +061300 GO TO READ-TEST-GF-04. SQ2064.2 +061400 READ-TEST-GF-04-01. SQ2064.2 +061500 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2064.2 +061600 GO TO READ-PASS-GF-04. SQ2064.2 +061700 MOVE "ERRORS IN READING SQ-FS4" TO RE-MARK. SQ2064.2 +061800 GO TO READ-FAIL-GF-04. SQ2064.2 +061900 READ-DELETE-GF-04. SQ2064.2 +062000 PERFORM DE-LETE. SQ2064.2 +062100 GO TO READ-WRITE-GF-04. SQ2064.2 +062200 READ-FAIL-GF-04. SQ2064.2 +062300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2064.2 +062400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2064.2 +062500 PERFORM FAIL. SQ2064.2 +062600 GO TO READ-WRITE-GF-04. SQ2064.2 +062700 READ-PASS-GF-04. SQ2064.2 +062800 PERFORM PASS. SQ2064.2 +062900 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2064.2 +063000 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2064.2 +063100 READ-WRITE-GF-04. SQ2064.2 +063200 MOVE "READ-TEST-GF-04" TO PAR-NAME. SQ2064.2 +063300 MOVE "VERIFY FILE SQ-FS4" TO FEATURE. SQ2064.2 +063400 PERFORM PRINT-DETAIL. SQ2064.2 +063500 READ-CLOSE-GF-04. SQ2064.2 +063600 CLOSE SQ-FS4. SQ2064.2 +063700 READ-INIT-GF-05. SQ2064.2 +063800* THIS TEST READS AND VALIDATE SQ-FS2 WHICH WAS SQ2064.2 +063900* CREATED IN WRITE-TEST-GF-02. SQ2064.2 +064000 MOVE 0 TO WRK-RECORD-COUNT, RECORDS-IN-ERROR. SQ2064.2 +064100 OPEN INPUT SQ-FS2. SQ2064.2 +064200 READ-TEST-GF-05. SQ2064.2 +064300 READ SQ-FS2 SQ2064.2 +064400 AT END GO TO READ-TEST-GF-05-01. SQ2064.2 +064500 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2). SQ2064.2 +064600 ADD 1 TO WRK-RECORD-COUNT. SQ2064.2 +064700 IF WRK-RECORD-COUNT GREATER THAN 750 SQ2064.2 +064800 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2064.2 +064900 GO TO READ-FAIL-GF-05. SQ2064.2 +065000 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (2) SQ2064.2 +065100 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +065200 GO TO READ-TEST-GF-05. SQ2064.2 +065300 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ2064.2 +065400 ADD 1 TO RECORDS-IN-ERROR SQ2064.2 +065500 GO TO READ-TEST-GF-05. SQ2064.2 +065600 IF XLABEL-TYPE (2) NOT EQUAL TO "S" SQ2064.2 +065700 ADD 1 TO RECORDS-IN-ERROR. SQ2064.2 +065800 GO TO READ-TEST-GF-05. SQ2064.2 +065900 READ-TEST-GF-05-01. SQ2064.2 +066000 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2064.2 +066100 GO TO READ-PASS-GF-05. SQ2064.2 +066200 MOVE "ERRORS IN READING SQ-FS2" TO RE-MARK. SQ2064.2 +066300 GO TO READ-FAIL-GF-05. SQ2064.2 +066400 READ-DELETE-GF-05. SQ2064.2 +066500 PERFORM DE-LETE. SQ2064.2 +066600 GO TO READ-WRITE-GF-05. SQ2064.2 +066700 READ-FAIL-GF-05. SQ2064.2 +066800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2064.2 +066900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2064.2 +067000 PERFORM FAIL. SQ2064.2 +067100 GO TO READ-WRITE-GF-05. SQ2064.2 +067200 READ-PASS-GF-05. SQ2064.2 +067300 PERFORM PASS. SQ2064.2 +067400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2064.2 +067500 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2064.2 +067600 READ-WRITE-GF-05. SQ2064.2 +067700 MOVE "READ-TEST-GF-05" TO PAR-NAME. SQ2064.2 +067800 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. SQ2064.2 +067900 PERFORM PRINT-DETAIL. SQ2064.2 +068000 READ-CLOSE-GF-05. SQ2064.2 +068100 CLOSE SQ-FS2. SQ2064.2 +068200 SQ206A-END-ROUTINE. SQ2064.2 +068300 MOVE "END OF SQ206A VALIDATION TESTS" TO PRINT-REC. SQ2064.2 +068400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2064.2 +068500 TERMINATE-SQ206A. SQ2064.2 +068600 EXIT. SQ2064.2 +068700 CCVS-EXIT SECTION. SQ2064.2 +068800 CCVS-999999. SQ2064.2 +068900 GO TO CLOSE-FILES. SQ2064.2 diff --git a/tests/cobol85/SQ/SQ207M.CBL b/tests/cobol85/SQ/SQ207M.CBL new file mode 100755 index 00000000..d52000a7 --- /dev/null +++ b/tests/cobol85/SQ/SQ207M.CBL @@ -0,0 +1,440 @@ +000100 IDENTIFICATION DIVISION. SQ2074.2 +000200 PROGRAM-ID. SQ2074.2 +000300 SQ207M. SQ2074.2 +000400**************************************************************** SQ2074.2 +000500* * SQ2074.2 +000600* VALIDATION FOR:- * SQ2074.2 +000700* " HIGH ". SQ2074.2 +000800* * SQ2074.2 +000900* CREATION DATE / VALIDATION DATE * SQ2074.2 +001000* "4.2 ". SQ2074.2 +001100* * SQ2074.2 +001200* THE ROUTINE SQ207M TESTS THE USE OF THE LEVEL 2 WRITE SQ2074.2 +001300* STATEMENT FOR A FILE DESIGNATED AS PRINTER OUTPUT. THESE SQ2074.2 +001400* WRITE STATEMENTS CONTROL THE VERTICAL POSITIONING OF EACH SQ2074.2 +001500* LINE ON A PRINTED PAGE. SQ207M TESTS ALL POSSIBLE LEVEL 2 SQ2074.2 +001600* COMBINATIONS OF THE FROM AND ADVANCING PHRASES USING MNEMONICSQ2074.2 +001700* NAME. IT IS ASSUMED THAT ALL LEVEL 2 NUCLEUS OPTIONS ARE SQ2074.2 +001800* AVAILABLE IN TESTING SQ207M. THE VARIABLES IN THE TESTS ARE SQ2074.2 +001900* IDENTIFIER-1 AND MNEMONIC-NAME. HOWEVER, BECAUSE ONLY ONE SQ2074.2 +002000* MNEMONIC-NAME IS DEFINED IN THE SPECIAL-NAMES PARAGRAPH, SQ2074.2 +002100* SEPARATE RUNS MUST BE MADE FOR EACH MNEMONIC-NAME TESTED. SQ2074.2 +002200* IDENTIFIER-1 IS A 77, 01, OR SUBGROUP IDENTIFIER IN THE SQ2074.2 +002300* WORKING-STORAGE SECTION. THIS TEST MAY BE DELETED IF NO SQ2074.2 +002400* MNEMONIC-NAMES EXIST FOR THE SYSTEM BEING VALIDATED. SQ2074.2 +002500* BECAUSE OF THE NATURE OF THESE TESTS A "PASS" OR "FAIL" SQ2074.2 +002600* CANNOT BE DETERMINED WITHIN THE PROGRAM. THE USER MUST SQ2074.2 +002700* VISUALLY CHECK THE POSITION OF EACH LINE TO DETERMINE THE SQ2074.2 +002800* ACCURACY OF THE VARIOUS WRITE OPTIONS. SQ2074.2 +002900 ENVIRONMENT DIVISION. SQ2074.2 +003000 CONFIGURATION SECTION. SQ2074.2 +003100 SOURCE-COMPUTER. SQ2074.2 +003200 Linux. SQ2074.2 +003300 OBJECT-COMPUTER. SQ2074.2 +003400 Linux. SQ2074.2 +003500 SPECIAL-NAMES. SQ2074.2 +003600 SYSOUT SQ2074.2 +003700 IS MNEMONIC-NAME. SQ2074.2 +003800 INPUT-OUTPUT SECTION. SQ2074.2 +003900 FILE-CONTROL. SQ2074.2 +004000*P SELECT RAW-DATA ASSIGN TO SQ2074.2 +004100*P "XXXXX062" SQ2074.2 +004200*P ORGANIZATION IS INDEXED SQ2074.2 +004300*P ACCESS MODE IS RANDOM SQ2074.2 +004400*P RECORD KEY IS RAW-DATA-KEY. SQ2074.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2074.2 +004600 "report.log". SQ2074.2 +004700 DATA DIVISION. SQ2074.2 +004800 FILE SECTION. SQ2074.2 +004900*P SQ2074.2 +005000*PD RAW-DATA. SQ2074.2 +005100*P SQ2074.2 +005200*P1 RAW-DATA-SATZ. SQ2074.2 +005300*P 05 RAW-DATA-KEY PIC X(6). SQ2074.2 +005400*P 05 C-DATE PIC 9(6). SQ2074.2 +005500*P 05 C-TIME PIC 9(8). SQ2074.2 +005600*P 05 C-NO-OF-TESTS PIC 99. SQ2074.2 +005700*P 05 C-OK PIC 999. SQ2074.2 +005800*P 05 C-ALL PIC 999. SQ2074.2 +005900*P 05 C-FAIL PIC 999. SQ2074.2 +006000*P 05 C-DELETED PIC 999. SQ2074.2 +006100*P 05 C-INSPECT PIC 999. SQ2074.2 +006200*P 05 C-NOTE PIC X(13). SQ2074.2 +006300*P 05 C-INDENT PIC X. SQ2074.2 +006400*P 05 C-ABORT PIC X(8). SQ2074.2 +006500 FD PRINT-FILE SQ2074.2 +006600*C LABEL RECORDS SQ2074.2 +006700*C OMITTED SQ2074.2 +006800*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2074.2 +006900 . SQ2074.2 +007000 01 PRINT-REC PICTURE X(120). SQ2074.2 +007100 01 DUMMY-RECORD PICTURE X(120). SQ2074.2 +007200 WORKING-STORAGE SECTION. SQ2074.2 +007300 77 BEFORE-MSG-1 PIC X(120) VALUE " THIS LINE SQ2074.2 +007400- "IS PRINTED BEFORE ADVANCING THE MNEMONIC-NAME SPACING. IT SSQ2074.2 +007500- "HOULD BE 1 LINE BELOW THE WRT-TEST LINE.". SQ2074.2 +007600 01 BEFORE-MSG-2 PIC X(120) VALUE " THIS LINE SQ2074.2 +007700- "IS PRINTED BEFORE ADVANCING THE MNEMONIC-NAME SPACING. IT SSQ2074.2 +007800- "HOULD BE 1 LINE BELOW THE WRT-TEST LINE.". SQ2074.2 +007900 01 BEFORE-MSG-3 PIC X(120) VALUE " THIS LINE SQ2074.2 +008000- "SHOULD BE WRITTEN ON THE LINE POSITIONED TO BY THE WRITE MNESQ2074.2 +008100- "MONIC-NAME OPTION BEING TESTED.". SQ2074.2 +008200 01 LEVEL-ONE. SQ2074.2 +008300 02 LEVEL-TWO. SQ2074.2 +008400 03 AFTER-MSG-1. SQ2074.2 +008500 04 FILLER PIC X(10) VALUE SPACES. SQ2074.2 +008600 04 FILLER PIC X(110) VALUE "THIS LINE IS PRINTED ASQ2074.2 +008700- "FTER ADVANCING THE MNEMONIC-NAME SPACING. IT SHOULSQ2074.2 +008800- "D BE WRITTEN ON THE LINE POSITIONED". SQ2074.2 +008900 03 AFTER-MSG-2. SQ2074.2 +009000 04 FILLER PIC X(10) VALUE SPACE. SQ2074.2 +009100 04 FILLER PIC X(110) VALUE "TO BY THE WRITE MNEMONSQ2074.2 +009200- "IC-NAME OPTION BEING TESTED.". SQ2074.2 +009300 01 NOTE-1. SQ2074.2 +009400 02 FILLER PIC X(40) VALUE "BECAUSE OF THE NATURE SQ2074.2 +009500- "OF THESE TESTS A ". SQ2074.2 +009600 02 FILLER PIC X VALUE QUOTE. SQ2074.2 +009700 02 FILLER PIC X(4) VALUE "PASS". SQ2074.2 +009800 02 FILLER PIC X VALUE QUOTE. SQ2074.2 +009900 02 FILLER PIC X(4) VALUE " OR ". SQ2074.2 +010000 02 FILLER PIC X VALUE QUOTE. SQ2074.2 +010100 02 FILLER PIC X(4) VALUE "FAIL". SQ2074.2 +010200 02 FILLER PIC X VALUE QUOTE. SQ2074.2 +010300 02 FILLER PIC X(64) VALUE " CANNOT BE DETERMINED SQ2074.2 +010400- "WITHIN THE PROGRAM. THE USER MUST VISUALLY". SQ2074.2 +010500 01 NOTE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ2074.2 +010600- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ2074.2 +010700- "IONS. VII-52 4.7.3 (3, 6, 7, 8, 9)". SQ2074.2 +010800 01 TEST-RESULTS. SQ2074.2 +010900 02 FILLER PICTURE X VALUE SPACE. SQ2074.2 +011000 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2074.2 +011100 02 FILLER PICTURE X VALUE SPACE. SQ2074.2 +011200 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2074.2 +011300 02 FILLER PICTURE X VALUE SPACE. SQ2074.2 +011400 02 PAR-NAME. SQ2074.2 +011500 03 FILLER PICTURE X(12) VALUE SPACE. SQ2074.2 +011600 03 PARDOT-X PICTURE X VALUE SPACE. SQ2074.2 +011700 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2074.2 +011800 03 FILLER PIC X(5) VALUE SPACE. SQ2074.2 +011900 02 FILLER PIC X(10) VALUE SPACE. SQ2074.2 +012000 02 RE-MARK PIC X(61). SQ2074.2 +012100 01 TEST-COMPUTED. SQ2074.2 +012200 02 FILLER PIC X(30) VALUE SPACE. SQ2074.2 +012300 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2074.2 +012400 02 COMPUTED-X. SQ2074.2 +012500 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2074.2 +012600 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2074.2 +012700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2074.2 +012800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2074.2 +012900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2074.2 +013000 03 CM-18V0 REDEFINES COMPUTED-A. SQ2074.2 +013100 04 COMPUTED-18V0 PICTURE -9(18). SQ2074.2 +013200 04 FILLER PICTURE X. SQ2074.2 +013300 03 FILLER PIC X(50) VALUE SPACE. SQ2074.2 +013400 01 TEST-CORRECT. SQ2074.2 +013500 02 FILLER PIC X(30) VALUE SPACE. SQ2074.2 +013600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2074.2 +013700 02 CORRECT-X. SQ2074.2 +013800 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2074.2 +013900 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2074.2 +014000 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2074.2 +014100 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2074.2 +014200 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2074.2 +014300 03 CR-18V0 REDEFINES CORRECT-A. SQ2074.2 +014400 04 CORRECT-18V0 PICTURE -9(18). SQ2074.2 +014500 04 FILLER PICTURE X. SQ2074.2 +014600 03 FILLER PIC X(50) VALUE SPACE. SQ2074.2 +014700 01 CCVS-C-1. SQ2074.2 +014800 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2074.2 +014900- "SS PARAGRAPH-NAME SQ2074.2 +015000- " REMARKS". SQ2074.2 +015100 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2074.2 +015200 01 CCVS-C-2. SQ2074.2 +015300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2074.2 +015400 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2074.2 +015500 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2074.2 +015600 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2074.2 +015700 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2074.2 +015800 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2074.2 +015900 01 REC-CT PICTURE 99 VALUE ZERO. SQ2074.2 +016000 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2074.2 +016100 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2074.2 +016200 01 INSPECT-COUNTER PIC 999 VALUE 8. SQ2074.2 +016300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2074.2 +016400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2074.2 +016500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2074.2 +016600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2074.2 +016700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2074.2 +016800 01 CCVS-H-1. SQ2074.2 +016900 02 FILLER PICTURE X(27) VALUE SPACE. SQ2074.2 +017000 02 FILLER PICTURE X(67) VALUE SQ2074.2 +017100 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2074.2 +017200- " SYSTEM". SQ2074.2 +017300 02 FILLER PICTURE X(26) VALUE SPACE. SQ2074.2 +017400 01 CCVS-H-2. SQ2074.2 +017500 02 FILLER PICTURE X(52) VALUE IS SQ2074.2 +017600 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2074.2 +017700 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2074.2 +017800 02 TEST-ID PICTURE IS X(9). SQ2074.2 +017900 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2074.2 +018000 01 CCVS-H-3. SQ2074.2 +018100 02 FILLER PICTURE X(34) VALUE SQ2074.2 +018200 " FOR OFFICIAL USE ONLY ". SQ2074.2 +018300 02 FILLER PICTURE X(58) VALUE SQ2074.2 +018400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2074.2 +018500 02 FILLER PICTURE X(28) VALUE SQ2074.2 +018600 " COPYRIGHT 1985 ". SQ2074.2 +018700 01 CCVS-E-1. SQ2074.2 +018800 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2074.2 +018900 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2074.2 +019000 02 ID-AGAIN PICTURE IS X(9). SQ2074.2 +019100 02 FILLER PICTURE X(45) VALUE IS SQ2074.2 +019200 " NTIS DISTRIBUTION COBOL 85". SQ2074.2 +019300 01 CCVS-E-2. SQ2074.2 +019400 02 FILLER PICTURE X(31) VALUE SQ2074.2 +019500 SPACE. SQ2074.2 +019600 02 FILLER PICTURE X(21) VALUE SPACE. SQ2074.2 +019700 02 CCVS-E-2-2. SQ2074.2 +019800 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2074.2 +019900 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2074.2 +020000 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2074.2 +020100 01 CCVS-E-3. SQ2074.2 +020200 02 FILLER PICTURE X(22) VALUE SQ2074.2 +020300 " FOR OFFICIAL USE ONLY". SQ2074.2 +020400 02 FILLER PICTURE X(12) VALUE SPACE. SQ2074.2 +020500 02 FILLER PICTURE X(58) VALUE SQ2074.2 +020600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2074.2 +020700 02 FILLER PICTURE X(13) VALUE SPACE. SQ2074.2 +020800 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2074.2 +020900 01 CCVS-E-4. SQ2074.2 +021000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2074.2 +021100 02 FILLER PIC XXXX VALUE " OF ". SQ2074.2 +021200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2074.2 +021300 02 FILLER PIC X(40) VALUE SQ2074.2 +021400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2074.2 +021500 01 XXINFO. SQ2074.2 +021600 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2074.2 +021700 02 INFO-TEXT. SQ2074.2 +021800 04 FILLER PIC X(20) VALUE SPACE. SQ2074.2 +021900 04 XXCOMPUTED PIC X(20). SQ2074.2 +022000 04 FILLER PIC X(5) VALUE SPACE. SQ2074.2 +022100 04 XXCORRECT PIC X(20). SQ2074.2 +022200 01 HYPHEN-LINE. SQ2074.2 +022300 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2074.2 +022400 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2074.2 +022500- "*****************************************". SQ2074.2 +022600 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2074.2 +022700- "******************************". SQ2074.2 +022800 01 CCVS-PGM-ID PIC X(6) VALUE SQ2074.2 +022900 "SQ207M". SQ2074.2 +023000 PROCEDURE DIVISION. SQ2074.2 +023100 CCVS1 SECTION. SQ2074.2 +023200 OPEN-FILES. SQ2074.2 +023300*P OPEN I-O RAW-DATA. SQ2074.2 +023400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2074.2 +023500*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2074.2 +023600*P MOVE "ABORTED " TO C-ABORT. SQ2074.2 +023700*P ADD 1 TO C-NO-OF-TESTS. SQ2074.2 +023800*P ACCEPT C-DATE FROM DATE. SQ2074.2 +023900*P ACCEPT C-TIME FROM TIME. SQ2074.2 +024000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2074.2 +024100*PND-E-1. SQ2074.2 +024200*P CLOSE RAW-DATA. SQ2074.2 +024300 OPEN OUTPUT PRINT-FILE. SQ2074.2 +024400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2074.2 +024500 MOVE SPACE TO TEST-RESULTS. SQ2074.2 +024600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2074.2 +024700 GO TO CCVS1-EXIT. SQ2074.2 +024800 CLOSE-FILES. SQ2074.2 +024900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2074.2 +025000*P OPEN I-O RAW-DATA. SQ2074.2 +025100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2074.2 +025200*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2074.2 +025300*P MOVE "OK. " TO C-ABORT. SQ2074.2 +025400*P MOVE PASS-COUNTER TO C-OK. SQ2074.2 +025500*P MOVE ERROR-HOLD TO C-ALL. SQ2074.2 +025600*P MOVE ERROR-COUNTER TO C-FAIL. SQ2074.2 +025700*P MOVE DELETE-CNT TO C-DELETED. SQ2074.2 +025800*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2074.2 +025900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2074.2 +026000*PND-E-2. SQ2074.2 +026100*P CLOSE RAW-DATA. SQ2074.2 +026200 TERMINATE-CCVS. SQ2074.2 +026300*S EXIT PROGRAM. SQ2074.2 +026400*SERMINATE-CALL. SQ2074.2 +026500 STOP RUN. SQ2074.2 +026600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2074.2 +026700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2074.2 +026800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2074.2 +026900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2074.2 +027000 MOVE "****TEST DELETED****" TO RE-MARK. SQ2074.2 +027100 PRINT-DETAIL. SQ2074.2 +027200 IF REC-CT NOT EQUAL TO ZERO SQ2074.2 +027300 MOVE "." TO PARDOT-X SQ2074.2 +027400 MOVE REC-CT TO DOTVALUE. SQ2074.2 +027500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2074.2 +027600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2074.2 +027700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2074.2 +027800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2074.2 +027900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2074.2 +028000 MOVE SPACE TO CORRECT-X. SQ2074.2 +028100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2074.2 +028200 MOVE SPACE TO RE-MARK. SQ2074.2 +028300 HEAD-ROUTINE. SQ2074.2 +028400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +028500 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2074.2 +028600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2074.2 +028700 COLUMN-NAMES-ROUTINE. SQ2074.2 +028800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +028900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +029000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +029100 END-ROUTINE. SQ2074.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2074.2 +029300 END-RTN-EXIT. SQ2074.2 +029400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +029500 END-ROUTINE-1. SQ2074.2 +029600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2074.2 +029700 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2074.2 +029800 ADD PASS-COUNTER TO ERROR-HOLD. SQ2074.2 +029900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2074.2 +030000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2074.2 +030100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2074.2 +030200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2074.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2074.2 +030400 END-ROUTINE-12. SQ2074.2 +030500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2074.2 +030600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2074.2 +030700 MOVE "NO " TO ERROR-TOTAL SQ2074.2 +030800 ELSE SQ2074.2 +030900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2074.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2074.2 +031100 PERFORM WRITE-LINE. SQ2074.2 +031200 END-ROUTINE-13. SQ2074.2 +031300 IF DELETE-CNT IS EQUAL TO ZERO SQ2074.2 +031400 MOVE "NO " TO ERROR-TOTAL ELSE SQ2074.2 +031500 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2074.2 +031600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2074.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +031800 IF INSPECT-COUNTER EQUAL TO ZERO SQ2074.2 +031900 MOVE "NO " TO ERROR-TOTAL SQ2074.2 +032000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2074.2 +032100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2074.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +032300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2074.2 +032400 WRITE-LINE. SQ2074.2 +032500 ADD 1 TO RECORD-COUNT. SQ2074.2 +032600 IF RECORD-COUNT GREATER 50 SQ2074.2 +032700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2074.2 +032800 MOVE SPACE TO DUMMY-RECORD SQ2074.2 +032900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2074.2 +033000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2074.2 +033100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2074.2 +033200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2074.2 +033300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2074.2 +033400 MOVE ZERO TO RECORD-COUNT. SQ2074.2 +033500 PERFORM WRT-LN. SQ2074.2 +033600 WRT-LN. SQ2074.2 +033700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2074.2 +033800 MOVE SPACE TO DUMMY-RECORD. SQ2074.2 +033900 BLANK-LINE-PRINT. SQ2074.2 +034000 PERFORM WRT-LN. SQ2074.2 +034100 FAIL-ROUTINE. SQ2074.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2074.2 +034300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2074.2 +034400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2074.2 +034500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +034600 GO TO FAIL-ROUTINE-EX. SQ2074.2 +034700 FAIL-ROUTINE-WRITE. SQ2074.2 +034800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2074.2 +034900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +035000 FAIL-ROUTINE-EX. EXIT. SQ2074.2 +035100 BAIL-OUT. SQ2074.2 +035200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2074.2 +035300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2074.2 +035400 BAIL-OUT-WRITE. SQ2074.2 +035500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2074.2 +035600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2074.2 +035700 BAIL-OUT-EX. EXIT. SQ2074.2 +035800 CCVS1-EXIT. SQ2074.2 +035900 EXIT. SQ2074.2 +036000 SECT-SQ207M-0001 SECTION. SQ2074.2 +036100 WRITE-INIT-GF-01. SQ2074.2 +036200 MOVE NOTE-1 TO PRINT-REC. SQ2074.2 +036300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +036400 MOVE NOTE-2 TO PRINT-REC. SQ2074.2 +036500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +036600 MOVE SPACE TO DUMMY-RECORD. SQ2074.2 +036700 PERFORM BLANK-LINE-PRINT. SQ2074.2 +036800 WRITE-TEST-GF-01. SQ2074.2 +036900 MOVE "WRT FRM BFR ADV MNC" TO FEATURE. SQ2074.2 +037000 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2074.2 +037100 MOVE "FROM 77 LEVEL" TO RE-MARK. SQ2074.2 +037200 PERFORM WRITE-TEST-LINE. SQ2074.2 +037300 WRITE PRINT-REC FROM BEFORE-MSG-1 BEFORE ADVANCING SQ2074.2 +037400 MNEMONIC-NAME. SQ2074.2 +037500 WRITE PRINT-REC FROM BEFORE-MSG-3 BEFORE ADVANCING 0 LINE. SQ2074.2 +037600 WRITE-TEST-GF-02. SQ2074.2 +037700 MOVE "WRT FRM BFR MNC" TO FEATURE. SQ2074.2 +037800 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2074.2 +037900 MOVE "FROM 01 LEVEL" TO RE-MARK. SQ2074.2 +038000 PERFORM WRITE-TEST-LINE. SQ2074.2 +038100 WRITE PRINT-REC FROM BEFORE-MSG-2 BEFORE MNEMONIC-NAME. SQ2074.2 +038200 WRITE PRINT-REC FROM BEFORE-MSG-3 BEFORE ADVANCING 0 LINE. SQ2074.2 +038300 WRITE-TEST-GF-03. SQ2074.2 +038400 MOVE "WRT FRM AFT ADV MNC" TO FEATURE. SQ2074.2 +038500 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. SQ2074.2 +038600 MOVE "FROM 03 LEVEL" TO RE-MARK. SQ2074.2 +038700 PERFORM WRITE-TEST-LINE. SQ2074.2 +038800 WRITE PRINT-REC FROM AFTER-MSG-1 AFTER ADVANCING SQ2074.2 +038900 MNEMONIC-NAME. SQ2074.2 +039000 WRITE PRINT-REC FROM AFTER-MSG-2 AFTER ADVANCING 1 LINE. SQ2074.2 +039100 WRITE-TEST-GF-04. SQ2074.2 +039200 MOVE "WRT FRM AFT MNC" TO FEATURE. SQ2074.2 +039300 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. SQ2074.2 +039400 PERFORM WRITE-TEST-LINE. SQ2074.2 +039500 WRITE PRINT-REC FROM AFTER-MSG-1 AFTER MNEMONIC-NAME. SQ2074.2 +039600 WRITE PRINT-REC FROM AFTER-MSG-2 AFTER ADVANCING 1 LINE. SQ2074.2 +039700 WRITE-TEST-GF-05. SQ2074.2 +039800 MOVE "WRT BFR ADV MNC" TO FEATURE. SQ2074.2 +039900 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. SQ2074.2 +040000 PERFORM WRITE-TEST-LINE. SQ2074.2 +040100 MOVE BEFORE-MSG-1 TO PRINT-REC. SQ2074.2 +040200 WRITE PRINT-REC BEFORE ADVANCING MNEMONIC-NAME. SQ2074.2 +040300 MOVE BEFORE-MSG-3 TO PRINT-REC. SQ2074.2 +040400 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ2074.2 +040500 WRITE-TEST-GF-06. SQ2074.2 +040600 MOVE "WRT BFR MNC" TO FEATURE. SQ2074.2 +040700 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. SQ2074.2 +040800 PERFORM WRITE-TEST-LINE. SQ2074.2 +040900 MOVE BEFORE-MSG-2 TO PRINT-REC. SQ2074.2 +041000 WRITE PRINT-REC BEFORE MNEMONIC-NAME. SQ2074.2 +041100 MOVE BEFORE-MSG-3 TO PRINT-REC. SQ2074.2 +041200 WRITE PRINT-REC BEFORE ADVANCING 0 LINE. SQ2074.2 +041300 WRITE-TEST-GF-07. SQ2074.2 +041400 MOVE "WRT AFT ADV MNC" TO FEATURE. SQ2074.2 +041500 MOVE "WRITE-TEST-GF-07" TO PAR-NAME. SQ2074.2 +041600 MOVE "RECORD-NAME IS QUALIFIED (IN)" TO RE-MARK. SQ2074.2 +041700 PERFORM WRITE-TEST-LINE. SQ2074.2 +041800 MOVE AFTER-MSG-1 TO PRINT-REC. SQ2074.2 +041900 WRITE PRINT-REC IN PRINT-FILE AFTER ADVANCING MNEMONIC-NAME. SQ2074.2 +042000 MOVE AFTER-MSG-2 TO PRINT-REC. SQ2074.2 +042100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +042200 WRITE-TEST-GF-08. SQ2074.2 +042300 MOVE "WRT AFT MNC" TO FEATURE. SQ2074.2 +042400 MOVE "WRITE-TEST-GF-08" TO PAR-NAME. SQ2074.2 +042500 MOVE "RECORD-NAME IS QUALIFIED (OF)" TO RE-MARK. SQ2074.2 +042600 PERFORM WRITE-TEST-LINE. SQ2074.2 +042700 MOVE AFTER-MSG-1 TO PRINT-REC. SQ2074.2 +042800 WRITE PRINT-REC OF PRINT-FILE AFTER MNEMONIC-NAME. SQ2074.2 +042900 MOVE AFTER-MSG-2 TO PRINT-REC. SQ2074.2 +043000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +043100 SQ207M-END-ROUTINE. SQ2074.2 +043200 MOVE "END OF SQ207M VALIDATION TESTS" TO PRINT-REC. SQ2074.2 +043300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2074.2 +043400 GO TO CCVS-EXIT. SQ2074.2 +043500 WRITE-TEST-LINE. SQ2074.2 +043600 PERFORM PRINT-DETAIL. SQ2074.2 +043700 PERFORM BLANK-LINE-PRINT. SQ2074.2 +043800 CCVS-EXIT SECTION. SQ2074.2 +043900 CCVS-999999. SQ2074.2 +044000 GO TO CLOSE-FILES. SQ2074.2 diff --git a/tests/cobol85/SQ/SQ208M.CBL b/tests/cobol85/SQ/SQ208M.CBL new file mode 100755 index 00000000..93a1897a --- /dev/null +++ b/tests/cobol85/SQ/SQ208M.CBL @@ -0,0 +1,664 @@ +000100 IDENTIFICATION DIVISION. SQ2084.2 +000200 PROGRAM-ID. SQ2084.2 +000300 SQ208M. SQ2084.2 +000400**************************************************************** SQ2084.2 +000500* * SQ2084.2 +000600* VALIDATION FOR:- * SQ2084.2 +000700* " HIGH ". SQ2084.2 +000800* * SQ2084.2 +000900* CREATION DATE / VALIDATION DATE * SQ2084.2 +001000* "4.2 ". SQ2084.2 +001100* * SQ2084.2 +001200* THE ROUTINE SQ208M TESTS THE USE OF THE LEVEL 2 WRITE SQ2084.2 +001300* STATEMENT AND THE LINAGE CLAUSE FOR A FILE DESIGNATED AS SQ2084.2 +001400* PRINTER OUTPUT. THESE STATEMENTS CONTROL THE VERTICAL SQ2084.2 +001500* POSITIONING OF EACH LINE ON A PRINTED PAGE. THE LINAGE SQ2084.2 +001600* CLAUSE SPECIFICALLY CONTROLS THE VERTICAL FORMAT OF A LOGICALSQ2084.2 +001700* PRINT PAGE. SQ208M TESTS THE USE OF DATA-NAMES IN THE LINAGE,SQ2084.2 +001800* FOOTING, TOP, AND BOTTOM PHRASES. VALUES OF DATA-NAMES ARE SQ2084.2 +001900* CHANGED IN ORDER TO CHECK REDEFINITION OF LOGICAL PAGE SQ2084.2 +002000* FORMATS AFTER OVERFLOW OR WRITE ADVANCING PAGE OPERATIONS. SQ2084.2 +002100* IT IS ASSUMED THAT ALL LEVEL 2 NUCLEUS OPTIONS ARE AVAILABLE SQ2084.2 +002200* IN TESTING SQ208M. SQ2084.2 +002300* BECAUSE OF THE NATURE OF THESE TESTS A "PASS" OR "FAIL" SQ2084.2 +002400* CANNOT BE DETERMINED WITHIN THE PROGRAM. THE USER MUST SQ2084.2 +002500* VISUALLY CHECK THE POSITION OF EACH LINE TO DETERMINE THE SQ2084.2 +002600* ACCURACY OF THE VARIOUS WRITE AND LINAGE OPTIONS. SQ2084.2 +002700 ENVIRONMENT DIVISION. SQ2084.2 +002800 CONFIGURATION SECTION. SQ2084.2 +002900 SOURCE-COMPUTER. SQ2084.2 +003000 Linux. SQ2084.2 +003100 OBJECT-COMPUTER. SQ2084.2 +003200 Linux. SQ2084.2 +003300 INPUT-OUTPUT SECTION. SQ2084.2 +003400 FILE-CONTROL. SQ2084.2 +003500*P SELECT RAW-DATA ASSIGN TO SQ2084.2 +003600*P "XXXXX062" SQ2084.2 +003700*P ORGANIZATION IS INDEXED SQ2084.2 +003800*P ACCESS MODE IS RANDOM SQ2084.2 +003900*P RECORD KEY IS RAW-DATA-KEY. SQ2084.2 +004000 SELECT PRINT-FILE ASSIGN TO SQ2084.2 +004100 "report.log". SQ2084.2 +004200 DATA DIVISION. SQ2084.2 +004300 FILE SECTION. SQ2084.2 +004400*P SQ2084.2 +004500*PD RAW-DATA. SQ2084.2 +004600*P SQ2084.2 +004700*P1 RAW-DATA-SATZ. SQ2084.2 +004800*P 05 RAW-DATA-KEY PIC X(6). SQ2084.2 +004900*P 05 C-DATE PIC 9(6). SQ2084.2 +005000*P 05 C-TIME PIC 9(8). SQ2084.2 +005100*P 05 C-NO-OF-TESTS PIC 99. SQ2084.2 +005200*P 05 C-OK PIC 999. SQ2084.2 +005300*P 05 C-ALL PIC 999. SQ2084.2 +005400*P 05 C-FAIL PIC 999. SQ2084.2 +005500*P 05 C-DELETED PIC 999. SQ2084.2 +005600*P 05 C-INSPECT PIC 999. SQ2084.2 +005700*P 05 C-NOTE PIC X(13). SQ2084.2 +005800*P 05 C-INDENT PIC X. SQ2084.2 +005900*P 05 C-ABORT PIC X(8). SQ2084.2 +006000 FD PRINT-FILE SQ2084.2 +006100*C LABEL RECORDS SQ2084.2 +006200*C OMITTED SQ2084.2 +006300*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2084.2 +006400 LINAGE LINAGE-CTR SQ2084.2 +006500 FOOTING FOOT-CTR SQ2084.2 +006600 TOP TOP-CTR SQ2084.2 +006700 BOTTOM BOTTOM-CTR. SQ2084.2 +006800 01 PRINT-REC PICTURE X(120). SQ2084.2 +006900 01 DUMMY-RECORD PICTURE X(120). SQ2084.2 +007000 WORKING-STORAGE SECTION. SQ2084.2 +007100 77 LINAGE-CTR PIC 999 VALUE 66. SQ2084.2 +007200 01 FOOT-CTR PIC 999 VALUE 66. SQ2084.2 +007300 01 SPACING-CTR. SQ2084.2 +007400 02 TOP-CTR PIC 999 VALUE 0. SQ2084.2 +007500 02 BOTTOM-CTR PIC 999 VALUE 0. SQ2084.2 +007600 01 DETAIL-LINE-1. SQ2084.2 +007700 02 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +007800 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2084.2 +007900 02 DL1-LINE-NO PIC 999. SQ2084.2 +008000 02 FILLER PIC X(4) VALUE " OF ". SQ2084.2 +008100 02 DL1-TOTAL-LINES PIC 999. SQ2084.2 +008200 02 FILLER PIC X(34) VALUE " DETAIL LINES. LINAGESQ2084.2 +008300- "-COUNTER IS ". SQ2084.2 +008400 02 DL1-LC PIC 999. SQ2084.2 +008500 02 FILLER PIC X(40) VALUE ".". SQ2084.2 +008600 01 DETAIL-LINE-2. SQ2084.2 +008700 02 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +008800 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2084.2 +008900 02 DL2-LINE-NO PIC 999. SQ2084.2 +009000 02 FILLER PIC X(41) VALUE " OF 010 DETAIL LINES. SQ2084.2 +009100- " LINAGE-COUNTER IS ". SQ2084.2 +009200 02 DL2-LC PIC 999. SQ2084.2 +009300 02 FILLER PIC X(40) VALUE ".". SQ2084.2 +009400 01 DETAIL-LINE-3. SQ2084.2 +009500 02 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +009600 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2084.2 +009700 02 DL3-LINE-NO PIC 99. SQ2084.2 +009800 02 FILLER PIC X(40) VALUE " OF 60 DETAIL LINES. SQ2084.2 +009900- "LINAGE-COUNTER IS ". SQ2084.2 +010000 02 DL3-LC PIC 999. SQ2084.2 +010100 02 FILLER PIC X(42) VALUE ".". SQ2084.2 +010200 01 FOOT-LINE-1. SQ2084.2 +010300 02 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +010400 02 FILLER PIC X(57) VALUE "THIS IS LINE 001 OF 00SQ2084.2 +010500- "1 FOOTING LINES. LINAGE-COUNTER IS ". SQ2084.2 +010600 02 FL1-LC PIC 999. SQ2084.2 +010700 02 FILLER PIC X(40) VALUE ".". SQ2084.2 +010800 01 FOOT-LINE-3. SQ2084.2 +010900 02 FILLER PIC X(103) VALUE "THIS LINE WAS PRINTED SQ2084.2 +011000- "FROM AN EOP CLAUSE. THE VALUE OF THE LINAGE-COUNTER PRIOR TSQ2084.2 +011100- "O THIS EXECUTION IS ". SQ2084.2 +011200 02 FL3-LC PIC 999. SQ2084.2 +011300 02 FILLER PIC X(14) VALUE ".". SQ2084.2 +011400 01 INFO-LINE-1 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2084.2 +011500- "TO TEST THE OVERFLOW RESULTS OF A WRITE BEFORE ADVANCING OPESQ2084.2 +011600- "RATION CONTAINING AN EOP PHRASE.". SQ2084.2 +011700 01 INFO-LINE-2 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2084.2 +011800- "TO TEST THE OVERFLOW RESULTS OF A WRITE AFTER ADVANCING OPERSQ2084.2 +011900- "ATION CONTAINING AN EOP PHRASE.". SQ2084.2 +012000 01 INFO-LINE-3 PIC X(120) VALUE "FOR THIS TEST LINAGE ASQ2084.2 +012100- "ND FOOTING VALUES ARE 40.". SQ2084.2 +012200 01 INFO-LINE-4 PIC X(120) VALUE "39 DETAIL LINES SHOULDSQ2084.2 +012300- " PRINT ON THE 1ST LOGICAL PAGE AND THE REMAINING 21 DETAIL LSQ2084.2 +012400- "INES ON THE 2ND LOGICAL PAGE.". SQ2084.2 +012500 01 INFO-LINE-6 PIC X(120) VALUE "THE EOP LINE SHOULD FOSQ2084.2 +012600- "LLOW DETAIL LINE 39 AND BE THE LAST LINE ON THE 1ST LOGICAL SQ2084.2 +012700- "PAGE.". SQ2084.2 +012800 01 INFO-LINE-7 PIC X(120) VALUE "THE EOP LINE SHOULD FOSQ2084.2 +012900- "LLOW DETAIL LINE 39 AND BE THE FIRST LINE ON THE 2ND LOGICALSQ2084.2 +013000- " PAGE.". SQ2084.2 +013100 01 INFO-LINE-8 PIC X(120) VALUE "ALL LINAGE-COUNTER VALSQ2084.2 +013200- "UES REPRESENT VALUES PRIOR TO EXECUTION OF THE WRITE OPERATISQ2084.2 +013300- "ON. NO MODIFICATIONS HAVE BEEN MADE.". SQ2084.2 +013400 01 COMMENT-LINE-1 PIC X(120) VALUE "BECAUSE OF THE NATURE SQ2084.2 +013500- "OF THESE TESTS A PASS OR FAIL CANNOT BE DETERMINED WITHIN THSQ2084.2 +013600- "E PROGRAM. THE USER MUST VISUALLY". SQ2084.2 +013700 01 COMMENT-LINE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ2084.2 +013800- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ2084.2 +013900- "IONS. VII-22, 3.2.2 LINAGE, VII-27-29". SQ2084.2 +014000 01 COMMENT-LINE-3 PIC X(120) VALUE "IN THIS TEST THE FIRSTSQ2084.2 +014100- " LOGICAL PAGE SHOULD CONTAIN 65 DETAIL LINES.". SQ2084.2 +014200 01 COMMENT-LINE-4 PIC X(120) VALUE "1 FOOTING LINE AND BE SQ2084.2 +014300- "FOLLOWED BY 1 BLANK LINE. ALL SUCCEEDING LOGICAL PAGES SHOUSQ2084.2 +014400- "LD CONTAIN 29 DETAIL LINES, 1 FOOTING". SQ2084.2 +014500 01 COMMENT-LINE-5 PIC X(120) VALUE "LINE AND BE SEPARATED SQ2084.2 +014600- "BY 3 BLANK LINES". SQ2084.2 +014700 01 COMMENT-LINE-6 PIC X(120) VALUE "IN THIS TEST THE FIRSTSQ2084.2 +014800- " LOGICAL PAGE SHOULD CONTAIN 19 DETAIL LINES, 1 FOOTING LINESQ2084.2 +014900- ", BE PRECEDED BY 2 BLANK LINES, AND". SQ2084.2 +015000 01 COMMENT-LINE-7 PIC X(120) VALUE "BE FOLLOWED BY 4 BLANKSQ2084.2 +015100- " LINES. ALL SUCCEEDING LOGICAL PAGES SHOULD CONTAIN 39 DETASQ2084.2 +015200- "IL LINES, 1 FOOTING LINE, AND BE". SQ2084.2 +015300 01 COMMENT-LINE-8 PIC X(120) VALUE "SEPARATED BY 3 BLANK LSQ2084.2 +015400- "INES.". SQ2084.2 +015500 01 COMMENT-LINE-9 PIC X(120) VALUE "IN THIS TEST THE FIRSTSQ2084.2 +015600- " LOGICAL PAGE SHOULD CONTAIN 15 DETAIL LINES, BE PRECEDED BYSQ2084.2 +015700- " 2 BLANK LINES, AND BE FOLLOWED BY". SQ2084.2 +015800 01 COMMENT-LINE-10 PIC X(120) VALUE "9 BLANK LINES. ALL SUSQ2084.2 +015900- "CCEEDING LOGICAL PAGES SHOULD CONTAIN 40 DETAIL LINES AND BESQ2084.2 +016000- " SEPARATED BY 3 BLANK LINES.". SQ2084.2 +016100 01 COMMENT-LINE-11 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2084.2 +016200- "TO TEST THE MINIMUM LINAGE VALUE OF 1 AND THE MINIMUM TOP VASQ2084.2 +016300- "LUE OF ZERO. EACH LOGICAL PAGE SHOULD". SQ2084.2 +016400 01 COMMENT-LINE-12 PIC X(120) VALUE "CONTAIN 1 DETAIL LINE SQ2084.2 +016500- "AND BE SEPARATED BY 2 BLANK LINES. THE FIRST PAGE SHOULD NOSQ2084.2 +016600- "T BE PRECEDED BY ANY BLANK LINES.". SQ2084.2 +016700 01 COMMENT-LINE-13 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2084.2 +016800- "TO TEST THE MINIMUM FOOTING LINE VALUE OF 1 AND MINIMUM BOTTSQ2084.2 +016900- "OM VALUE OF ZERO. EACH LOGICAL PAGE". SQ2084.2 +017000 01 COMMENT-LINE-14 PIC X(120) VALUE "SHOULD CONTAIN 1 DETAISQ2084.2 +017100- "L LINE, 1 FOOTING LINE, AND BE SEPARATED BY 1 BLANK LINE.". SQ2084.2 +017200 01 LAST-LINE PIC X(120) VALUE "THIS IS THE LAST LINE SQ2084.2 +017300- "IN THE PAGE BODY OF THIS LOGICAL PAGE. USE IT AS A REFERENCSQ2084.2 +017400- "E POINT FOR THE FOLLOWING TEST PAGES.". SQ2084.2 +017500 01 TEST-RESULTS. SQ2084.2 +017600 02 FILLER PICTURE X VALUE SPACE. SQ2084.2 +017700 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2084.2 +017800 02 FILLER PICTURE X VALUE SPACE. SQ2084.2 +017900 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2084.2 +018000 02 FILLER PICTURE X VALUE SPACE. SQ2084.2 +018100 02 PAR-NAME. SQ2084.2 +018200 03 FILLER PICTURE X(12) VALUE SPACE. SQ2084.2 +018300 03 PARDOT-X PICTURE X VALUE SPACE. SQ2084.2 +018400 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2084.2 +018500 03 FILLER PIC X(5) VALUE SPACE. SQ2084.2 +018600 02 FILLER PIC X(10) VALUE SPACE. SQ2084.2 +018700 02 RE-MARK PIC X(61). SQ2084.2 +018800 01 TEST-COMPUTED. SQ2084.2 +018900 02 FILLER PIC X(30) VALUE SPACE. SQ2084.2 +019000 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2084.2 +019100 02 COMPUTED-X. SQ2084.2 +019200 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2084.2 +019300 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2084.2 +019400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2084.2 +019500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2084.2 +019600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2084.2 +019700 03 CM-18V0 REDEFINES COMPUTED-A. SQ2084.2 +019800 04 COMPUTED-18V0 PICTURE -9(18). SQ2084.2 +019900 04 FILLER PICTURE X. SQ2084.2 +020000 03 FILLER PIC X(50) VALUE SPACE. SQ2084.2 +020100 01 TEST-CORRECT. SQ2084.2 +020200 02 FILLER PIC X(30) VALUE SPACE. SQ2084.2 +020300 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2084.2 +020400 02 CORRECT-X. SQ2084.2 +020500 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2084.2 +020600 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2084.2 +020700 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2084.2 +020800 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2084.2 +020900 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2084.2 +021000 03 CR-18V0 REDEFINES CORRECT-A. SQ2084.2 +021100 04 CORRECT-18V0 PICTURE -9(18). SQ2084.2 +021200 04 FILLER PICTURE X. SQ2084.2 +021300 03 FILLER PIC X(50) VALUE SPACE. SQ2084.2 +021400 01 CCVS-C-1. SQ2084.2 +021500 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2084.2 +021600- "SS PARAGRAPH-NAME SQ2084.2 +021700- " REMARKS". SQ2084.2 +021800 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2084.2 +021900 01 CCVS-C-2. SQ2084.2 +022000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2084.2 +022100 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2084.2 +022200 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2084.2 +022300 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2084.2 +022400 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2084.2 +022500 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2084.2 +022600 01 REC-CT PICTURE 99 VALUE ZERO. SQ2084.2 +022700 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2084.2 +022800 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2084.2 +022900 01 INSPECT-COUNTER PIC 999 VALUE 7. SQ2084.2 +023000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2084.2 +023100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2084.2 +023200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2084.2 +023300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2084.2 +023400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2084.2 +023500 01 CCVS-H-1. SQ2084.2 +023600 02 FILLER PICTURE X(27) VALUE SPACE. SQ2084.2 +023700 02 FILLER PICTURE X(67) VALUE SQ2084.2 +023800 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2084.2 +023900- " SYSTEM". SQ2084.2 +024000 02 FILLER PICTURE X(26) VALUE SPACE. SQ2084.2 +024100 01 CCVS-H-2. SQ2084.2 +024200 02 FILLER PICTURE X(52) VALUE IS SQ2084.2 +024300 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2084.2 +024400 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2084.2 +024500 02 TEST-ID PICTURE IS X(9). SQ2084.2 +024600 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2084.2 +024700 01 CCVS-H-3. SQ2084.2 +024800 02 FILLER PICTURE X(34) VALUE SQ2084.2 +024900 " FOR OFFICIAL USE ONLY ". SQ2084.2 +025000 02 FILLER PICTURE X(58) VALUE SQ2084.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2084.2 +025200 02 FILLER PICTURE X(28) VALUE SQ2084.2 +025300 " COPYRIGHT 1985 ". SQ2084.2 +025400 01 CCVS-E-1. SQ2084.2 +025500 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2084.2 +025600 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2084.2 +025700 02 ID-AGAIN PICTURE IS X(9). SQ2084.2 +025800 02 FILLER PICTURE X(45) VALUE IS SQ2084.2 +025900 " NTIS DISTRIBUTION COBOL 85". SQ2084.2 +026000 01 CCVS-E-2. SQ2084.2 +026100 02 FILLER PICTURE X(31) VALUE SQ2084.2 +026200 SPACE. SQ2084.2 +026300 02 FILLER PICTURE X(21) VALUE SPACE. SQ2084.2 +026400 02 CCVS-E-2-2. SQ2084.2 +026500 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2084.2 +026600 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2084.2 +026700 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2084.2 +026800 01 CCVS-E-3. SQ2084.2 +026900 02 FILLER PICTURE X(22) VALUE SQ2084.2 +027000 " FOR OFFICIAL USE ONLY". SQ2084.2 +027100 02 FILLER PICTURE X(12) VALUE SPACE. SQ2084.2 +027200 02 FILLER PICTURE X(58) VALUE SQ2084.2 +027300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2084.2 +027400 02 FILLER PICTURE X(13) VALUE SPACE. SQ2084.2 +027500 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2084.2 +027600 01 CCVS-E-4. SQ2084.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2084.2 +027800 02 FILLER PIC XXXX VALUE " OF ". SQ2084.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2084.2 +028000 02 FILLER PIC X(40) VALUE SQ2084.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2084.2 +028200 01 XXINFO. SQ2084.2 +028300 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2084.2 +028400 02 INFO-TEXT. SQ2084.2 +028500 04 FILLER PIC X(20) VALUE SPACE. SQ2084.2 +028600 04 XXCOMPUTED PIC X(20). SQ2084.2 +028700 04 FILLER PIC X(5) VALUE SPACE. SQ2084.2 +028800 04 XXCORRECT PIC X(20). SQ2084.2 +028900 01 HYPHEN-LINE. SQ2084.2 +029000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2084.2 +029100 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2084.2 +029200- "*****************************************". SQ2084.2 +029300 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2084.2 +029400- "******************************". SQ2084.2 +029500 01 CCVS-PGM-ID PIC X(6) VALUE SQ2084.2 +029600 "SQ208M". SQ2084.2 +029700 PROCEDURE DIVISION. SQ2084.2 +029800 CCVS1 SECTION. SQ2084.2 +029900 OPEN-FILES. SQ2084.2 +030000*P OPEN I-O RAW-DATA. SQ2084.2 +030100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2084.2 +030200*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2084.2 +030300*P MOVE "ABORTED " TO C-ABORT. SQ2084.2 +030400*P ADD 1 TO C-NO-OF-TESTS. SQ2084.2 +030500*P ACCEPT C-DATE FROM DATE. SQ2084.2 +030600*P ACCEPT C-TIME FROM TIME. SQ2084.2 +030700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2084.2 +030800*PND-E-1. SQ2084.2 +030900*P CLOSE RAW-DATA. SQ2084.2 +031000 OPEN OUTPUT PRINT-FILE. SQ2084.2 +031100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2084.2 +031200 MOVE SPACE TO TEST-RESULTS. SQ2084.2 +031300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2084.2 +031400 GO TO CCVS1-EXIT. SQ2084.2 +031500 CLOSE-FILES. SQ2084.2 +031600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2084.2 +031700*P OPEN I-O RAW-DATA. SQ2084.2 +031800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2084.2 +031900*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2084.2 +032000*P MOVE "OK. " TO C-ABORT. SQ2084.2 +032100*P MOVE PASS-COUNTER TO C-OK. SQ2084.2 +032200*P MOVE ERROR-HOLD TO C-ALL. SQ2084.2 +032300*P MOVE ERROR-COUNTER TO C-FAIL. SQ2084.2 +032400*P MOVE DELETE-CNT TO C-DELETED. SQ2084.2 +032500*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2084.2 +032600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2084.2 +032700*PND-E-2. SQ2084.2 +032800*P CLOSE RAW-DATA. SQ2084.2 +032900 TERMINATE-CCVS. SQ2084.2 +033000*S EXIT PROGRAM. SQ2084.2 +033100*SERMINATE-CALL. SQ2084.2 +033200 STOP RUN. SQ2084.2 +033300 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2084.2 +033400 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2084.2 +033500 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2084.2 +033600 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2084.2 +033700 MOVE "****TEST DELETED****" TO RE-MARK. SQ2084.2 +033800 PRINT-DETAIL. SQ2084.2 +033900 IF REC-CT NOT EQUAL TO ZERO SQ2084.2 +034000 MOVE "." TO PARDOT-X SQ2084.2 +034100 MOVE REC-CT TO DOTVALUE. SQ2084.2 +034200 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2084.2 +034300 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2084.2 +034400 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2084.2 +034500 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2084.2 +034600 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2084.2 +034700 MOVE SPACE TO CORRECT-X. SQ2084.2 +034800 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2084.2 +034900 MOVE SPACE TO RE-MARK. SQ2084.2 +035000 HEAD-ROUTINE. SQ2084.2 +035100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +035200 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2084.2 +035300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2084.2 +035400 COLUMN-NAMES-ROUTINE. SQ2084.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +035800 END-ROUTINE. SQ2084.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2084.2 +036000 END-RTN-EXIT. SQ2084.2 +036100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +036200 END-ROUTINE-1. SQ2084.2 +036300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2084.2 +036400 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2084.2 +036500 ADD PASS-COUNTER TO ERROR-HOLD. SQ2084.2 +036600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2084.2 +036700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2084.2 +036800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2084.2 +036900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2084.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2084.2 +037100 END-ROUTINE-12. SQ2084.2 +037200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2084.2 +037300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2084.2 +037400 MOVE "NO " TO ERROR-TOTAL SQ2084.2 +037500 ELSE SQ2084.2 +037600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2084.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2084.2 +037800 PERFORM WRITE-LINE. SQ2084.2 +037900 END-ROUTINE-13. SQ2084.2 +038000 IF DELETE-CNT IS EQUAL TO ZERO SQ2084.2 +038100 MOVE "NO " TO ERROR-TOTAL ELSE SQ2084.2 +038200 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2084.2 +038300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2084.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +038500 IF INSPECT-COUNTER EQUAL TO ZERO SQ2084.2 +038600 MOVE "NO " TO ERROR-TOTAL SQ2084.2 +038700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2084.2 +038800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2084.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +039000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2084.2 +039100 WRITE-LINE. SQ2084.2 +039200 ADD 1 TO RECORD-COUNT. SQ2084.2 +039300 IF RECORD-COUNT GREATER 50 SQ2084.2 +039400 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2084.2 +039500 MOVE SPACE TO DUMMY-RECORD SQ2084.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2084.2 +039700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2084.2 +039800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2084.2 +039900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2084.2 +040000 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2084.2 +040100 MOVE ZERO TO RECORD-COUNT. SQ2084.2 +040200 PERFORM WRT-LN. SQ2084.2 +040300 WRT-LN. SQ2084.2 +040400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2084.2 +040500 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +040600 BLANK-LINE-PRINT. SQ2084.2 +040700 PERFORM WRT-LN. SQ2084.2 +040800 FAIL-ROUTINE. SQ2084.2 +040900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2084.2 +041000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2084.2 +041100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2084.2 +041200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +041300 GO TO FAIL-ROUTINE-EX. SQ2084.2 +041400 FAIL-ROUTINE-WRITE. SQ2084.2 +041500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2084.2 +041600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +041700 FAIL-ROUTINE-EX. EXIT. SQ2084.2 +041800 BAIL-OUT. SQ2084.2 +041900 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2084.2 +042000 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2084.2 +042100 BAIL-OUT-WRITE. SQ2084.2 +042200 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2084.2 +042300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2084.2 +042400 BAIL-OUT-EX. EXIT. SQ2084.2 +042500 CCVS1-EXIT. SQ2084.2 +042600 EXIT. SQ2084.2 +042700 SECT-SQ208M-0001 SECTION. SQ2084.2 +042800 WRITE-INIT-GF-01. SQ2084.2 +042900 MOVE COMMENT-LINE-1 TO PRINT-REC. SQ2084.2 +043000 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +043100 MOVE COMMENT-LINE-2 TO PRINT-REC. SQ2084.2 +043200 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +043300 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +043400 PERFORM BLANK-LINE-PRINT. SQ2084.2 +043500 WRITE-TEST-GF-01. SQ2084.2 +043600* THIS TEST CHECKS THE RESULTS OF CHANGING THE VALUES SQ2084.2 +043700* OF THE DATA-NAMES IN THE LINAGE CLAUSE AFTER AN SQ2084.2 +043800* OPEN OUTPUT PRINT-FILE. SQ2084.2 +043900 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +044000 PERFORM INITIALIZE-PAGE. SQ2084.2 +044100 MOVE "LINAGE AFTER OPEN" TO FEATURE. SQ2084.2 +044200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2084.2 +044300 PERFORM PRINT-DETAIL. SQ2084.2 +044400 MOVE COMMENT-LINE-3 TO PRINT-REC. SQ2084.2 +044500 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +044600 MOVE COMMENT-LINE-4 TO PRINT-REC. SQ2084.2 +044700 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +044800 MOVE COMMENT-LINE-5 TO PRINT-REC. SQ2084.2 +044900 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +045000 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +045100 PERFORM PRINT-LAST-LINE. SQ2084.2 +045200 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +045300 PERFORM BLANK-LINE-PRINT. SQ2084.2 +045400 MOVE 30 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +045500 MOVE 1 TO TOP-CTR. SQ2084.2 +045600 MOVE 2 TO BOTTOM-CTR. SQ2084.2 +045700 MOVE 1 TO DL1-LINE-NO. SQ2084.2 +045800 MOVE 123 TO DL1-TOTAL-LINES. SQ2084.2 +045900 PERFORM PRINT-DETAIL-1 123 TIMES. SQ2084.2 +046000 WRITE-TEST-GF-02. SQ2084.2 +046100* THIS TEST CHECKS THE RESULTS OF CHANGING THE VALUES SQ2084.2 +046200* OF THE DATA-NAMES IN THE LINAGE CLAUSE PRIOR TO A SQ2084.2 +046300* PAGE OVERFLOW. SQ2084.2 +046400 PERFORM INITIALIZE-PAGE. SQ2084.2 +046500 MOVE "LINAGE AFT OVERFLOW" TO FEATURE. SQ2084.2 +046600 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2084.2 +046700 PERFORM PRINT-DETAIL. SQ2084.2 +046800 MOVE COMMENT-LINE-6 TO PRINT-REC. SQ2084.2 +046900 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +047000 MOVE COMMENT-LINE-7 TO PRINT-REC. SQ2084.2 +047100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +047200 MOVE COMMENT-LINE-8 TO PRINT-REC. SQ2084.2 +047300 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +047400 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +047500 PERFORM PRINT-LAST-LINE. SQ2084.2 +047600 MOVE 20 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +047700 MOVE 2 TO TOP-CTR. SQ2084.2 +047800 MOVE 3 TO BOTTOM-CTR. SQ2084.2 +047900 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +048000 PERFORM BLANK-LINE-PRINT. SQ2084.2 +048100 MOVE 40 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +048200 MOVE 1 TO TOP-CTR. SQ2084.2 +048300 MOVE 2 TO BOTTOM-CTR. SQ2084.2 +048400 MOVE 1 TO DL1-LINE-NO. SQ2084.2 +048500 MOVE 136 TO DL1-TOTAL-LINES. SQ2084.2 +048600 PERFORM PRINT-DETAIL-1 136 TIMES. SQ2084.2 +048700 WRITE-TEST-GF-03. SQ2084.2 +048800* THIS TEST CHECKS THE RESULTS OF CHANGING THE VALUES SQ2084.2 +048900* OF THE DATA-NAMES IN THE LINAGE-CLAUSE PRIOR TO A SQ2084.2 +049000* WRITE ADVANCING PAGE OPERATION. SQ2084.2 +049100 PERFORM INITIALIZE-PAGE. SQ2084.2 +049200 MOVE "LINAGE AFT WRT PAGE" TO FEATURE. SQ2084.2 +049300 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. SQ2084.2 +049400 PERFORM PRINT-DETAIL. SQ2084.2 +049500 MOVE COMMENT-LINE-9 TO PRINT-REC. SQ2084.2 +049600 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +049700 MOVE COMMENT-LINE-10 TO PRINT-REC. SQ2084.2 +049800 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +049900 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +050000 PERFORM PRINT-LAST-LINE. SQ2084.2 +050100 MOVE 20 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +050200 MOVE 2 TO TOP-CTR. SQ2084.2 +050300 MOVE 3 TO BOTTOM-CTR. SQ2084.2 +050400 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +050500 PERFORM BLANK-LINE-PRINT. SQ2084.2 +050600 MOVE 1 TO DL1-LINE-NO. SQ2084.2 +050700 MOVE 135 TO DL1-TOTAL-LINES. SQ2084.2 +050800 PERFORM PRINT-DETAIL-2 15 TIMES. SQ2084.2 +050900 MOVE 40 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +051000 MOVE 1 TO TOP-CTR. SQ2084.2 +051100 MOVE 2 TO BOTTOM-CTR. SQ2084.2 +051200 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +051300 WRITE PRINT-REC BEFORE ADVANCING PAGE. SQ2084.2 +051400 MOVE 16 TO DL1-LINE-NO. SQ2084.2 +051500 PERFORM PRINT-DETAIL-2 120 TIMES. SQ2084.2 +051600 WRITE-TEST-GF-04. SQ2084.2 +051700* THIS TEST CHECKS THE MINIMUM LINAGE VALUE OF 1 SQ2084.2 +051800* AND THE MINIMUM TOP VALUE OF ZERO. SQ2084.2 +051900 PERFORM INITIALIZE-PAGE. SQ2084.2 +052000 MOVE "MIN LINAGE / 0 TOP" TO FEATURE. SQ2084.2 +052100 MOVE "WRITE-TEST-GF-04" TO PAR-NAME. SQ2084.2 +052200 PERFORM PRINT-DETAIL. SQ2084.2 +052300 MOVE COMMENT-LINE-11 TO PRINT-REC. SQ2084.2 +052400 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +052500 MOVE COMMENT-LINE-12 TO PRINT-REC. SQ2084.2 +052600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +052700 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +052800 PERFORM PRINT-LAST-LINE. SQ2084.2 +052900 MOVE 1 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +053000 MOVE 0 TO TOP-CTR. SQ2084.2 +053100 MOVE 2 TO BOTTOM-CTR. SQ2084.2 +053200 MOVE 1 TO DL2-LINE-NO. SQ2084.2 +053300 PERFORM PRINT-DETAIL-3 10 TIMES. SQ2084.2 +053400 WRITE-TEST-GF-05. SQ2084.2 +053500* THIS TEST CHECKS THE MINIMUM FOOTING VALUE OF 1 SQ2084.2 +053600* AND THE MINIMUM BOTTOM VALUE OF ZERO. SQ2084.2 +053700 PERFORM INITIALIZE-PAGE. SQ2084.2 +053800 MOVE "MIN FOOTING / 0 BOTM" TO FEATURE. SQ2084.2 +053900 MOVE "WRITE-TEST-GF-05" TO PAR-NAME. SQ2084.2 +054000 PERFORM PRINT-DETAIL. SQ2084.2 +054100 MOVE COMMENT-LINE-13 TO PRINT-REC. SQ2084.2 +054200 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +054300 MOVE COMMENT-LINE-14 TO PRINT-REC. SQ2084.2 +054400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +054500 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +054600 PERFORM PRINT-LAST-LINE. SQ2084.2 +054700 MOVE 2 TO LINAGE-CTR. SQ2084.2 +054800 MOVE 1 TO FOOT-CTR, TOP-CTR. SQ2084.2 +054900 MOVE 0 TO BOTTOM-CTR. SQ2084.2 +055000 MOVE 1 TO DL2-LINE-NO. SQ2084.2 +055100 PERFORM PRINT-DETAIL-4 10 TIMES. SQ2084.2 +055200 WRITE-TEST-GF-06. SQ2084.2 +055300* THIS TEST SHOWS THE RESULTS OF A WRITE BEFORE SQ2084.2 +055400* OPERATION WITH AN EOP PHRASE. LINAGE AND FOOTING SQ2084.2 +055500* VALUES ARE SPECIFIED AND EQUAL. SQ2084.2 +055600 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +055700 PERFORM INITIALIZE-PAGE. SQ2084.2 +055800 MOVE "WRITE BEFORE" TO FEATURE. SQ2084.2 +055900 MOVE "WRITE-TEST-GF-06" TO PAR-NAME. SQ2084.2 +056000 PERFORM PRINT-DETAIL. SQ2084.2 +056100 MOVE INFO-LINE-1 TO PRINT-REC. SQ2084.2 +056200 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +056300 MOVE INFO-LINE-3 TO PRINT-REC. SQ2084.2 +056400 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +056500 MOVE INFO-LINE-4 TO PRINT-REC. SQ2084.2 +056600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +056700 MOVE INFO-LINE-6 TO PRINT-REC. SQ2084.2 +056800 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +056900 MOVE INFO-LINE-8 TO PRINT-REC. SQ2084.2 +057000 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +057100 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +057200 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 66. SQ2084.2 +057300 MOVE 40 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +057400 MOVE 1 TO TOP-CTR, BOTTOM-CTR. SQ2084.2 +057500 MOVE LAST-LINE TO PRINT-REC. SQ2084.2 +057600 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2084.2 +057700 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +057800 MOVE 1 TO DL3-LINE-NO. SQ2084.2 +057900 PERFORM WRITE-BEFORE 60 TIMES. SQ2084.2 +058000 WRITE-TEST-GF-07. SQ2084.2 +058100* THIS TEST SHOWS THE RESULTS OF A WRITE AFTER SQ2084.2 +058200* OPERATION WITH AN EOP PHRASE. LINAGE AND FOOTING SQ2084.2 +058300* VALUES ARE SPECIFIED AND EQUAL. SQ2084.2 +058400 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +058500 PERFORM INITIALIZE-PAGE. SQ2084.2 +058600 MOVE "WRITE AFTER" TO FEATURE. SQ2084.2 +058700 MOVE "WRITE-TEST-GF-07" TO PAR-NAME. SQ2084.2 +058800 PERFORM PRINT-DETAIL. SQ2084.2 +058900 MOVE INFO-LINE-2 TO PRINT-REC. SQ2084.2 +059000 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2084.2 +059100 MOVE INFO-LINE-3 TO PRINT-REC. SQ2084.2 +059200 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +059300 MOVE INFO-LINE-4 TO PRINT-REC. SQ2084.2 +059400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +059500 MOVE INFO-LINE-7 TO PRINT-REC. SQ2084.2 +059600 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2084.2 +059700 MOVE INFO-LINE-8 TO PRINT-REC. SQ2084.2 +059800 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +059900 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +060000 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 66. SQ2084.2 +060100 MOVE 40 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +060200 MOVE 1 TO TOP-CTR, BOTTOM-CTR. SQ2084.2 +060300 MOVE LAST-LINE TO PRINT-REC. SQ2084.2 +060400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +060500 MOVE SPACE TO DUMMY-RECORD. SQ2084.2 +060600 MOVE 1 TO DL3-LINE-NO. SQ2084.2 +060700 PERFORM WRITE-AFTER 60 TIMES. SQ2084.2 +060800 SQ208M-END-ROUTINE. SQ2084.2 +060900 MOVE "END OF SQ208M VALIDATION TESTS" TO PRINT-REC. SQ2084.2 +061000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +061100 GO TO CCVS-EXIT. SQ2084.2 +061200 INITIALIZE-PAGE. SQ2084.2 +061300 MOVE 0 TO TOP-CTR, BOTTOM-CTR. SQ2084.2 +061400 MOVE 66 TO LINAGE-CTR, FOOT-CTR. SQ2084.2 +061500 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 1. SQ2084.2 +061600 PRINT-LAST-LINE. SQ2084.2 +061700 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 65. SQ2084.2 +061800 MOVE LAST-LINE TO PRINT-REC. SQ2084.2 +061900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +062000 PRINT-DETAIL-1. SQ2084.2 +062100 MOVE LINAGE-COUNTER TO DL1-LC. SQ2084.2 +062200 MOVE DETAIL-LINE-1 TO PRINT-REC. SQ2084.2 +062300 WRITE PRINT-REC BEFORE ADVANCING 1 LINE AT END-OF-PAGE SQ2084.2 +062400 MOVE LINAGE-COUNTER TO FL1-LC SQ2084.2 +062500 MOVE FOOT-LINE-1 TO PRINT-REC SQ2084.2 +062600 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2084.2 +062700 ADD 1 TO DL1-LINE-NO. SQ2084.2 +062800 PRINT-DETAIL-2. SQ2084.2 +062900 MOVE LINAGE-COUNTER TO DL1-LC. SQ2084.2 +063000 MOVE DETAIL-LINE-1 TO PRINT-REC. SQ2084.2 +063100 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2084.2 +063200 ADD 1 TO DL1-LINE-NO. SQ2084.2 +063300 PRINT-DETAIL-3. SQ2084.2 +063400 MOVE LINAGE-COUNTER TO DL2-LC. SQ2084.2 +063500 MOVE DETAIL-LINE-2 TO PRINT-REC. SQ2084.2 +063600 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +063700 ADD 1 TO DL2-LINE-NO. SQ2084.2 +063800 PRINT-DETAIL-4. SQ2084.2 +063900 MOVE LINAGE-COUNTER TO DL2-LC. SQ2084.2 +064000 MOVE DETAIL-LINE-2 TO PRINT-REC. SQ2084.2 +064100 WRITE PRINT-REC AFTER ADVANCING 1 LINE AT EOP SQ2084.2 +064200 MOVE LINAGE-COUNTER TO FL1-LC SQ2084.2 +064300 MOVE FOOT-LINE-1 TO PRINT-REC SQ2084.2 +064400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +064500 ADD 1 TO DL2-LINE-NO. SQ2084.2 +064600 WRITE-BEFORE. SQ2084.2 +064700 MOVE LINAGE-COUNTER TO DL3-LC. SQ2084.2 +064800 MOVE DETAIL-LINE-3 TO PRINT-REC. SQ2084.2 +064900 WRITE PRINT-REC BEFORE ADVANCING 1 LINE AT EOP SQ2084.2 +065000 MOVE LINAGE-COUNTER TO FL3-LC SQ2084.2 +065100 MOVE FOOT-LINE-3 TO PRINT-REC SQ2084.2 +065200 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2084.2 +065300 ADD 1 TO DL3-LINE-NO. SQ2084.2 +065400 WRITE-AFTER. SQ2084.2 +065500 MOVE LINAGE-COUNTER TO DL3-LC. SQ2084.2 +065600 MOVE DETAIL-LINE-3 TO PRINT-REC. SQ2084.2 +065700 WRITE PRINT-REC AFTER ADVANCING 1 LINE AT EOP SQ2084.2 +065800 MOVE LINAGE-COUNTER TO FL3-LC SQ2084.2 +065900 MOVE FOOT-LINE-3 TO PRINT-REC SQ2084.2 +066000 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2084.2 +066100 ADD 1 TO DL3-LINE-NO. SQ2084.2 +066200 CCVS-EXIT SECTION. SQ2084.2 +066300 CCVS-999999. SQ2084.2 +066400 GO TO CLOSE-FILES. SQ2084.2 diff --git a/tests/cobol85/SQ/SQ209M.CBL b/tests/cobol85/SQ/SQ209M.CBL new file mode 100755 index 00000000..d2e62491 --- /dev/null +++ b/tests/cobol85/SQ/SQ209M.CBL @@ -0,0 +1,459 @@ +000100 IDENTIFICATION DIVISION. SQ2094.2 +000200 PROGRAM-ID. SQ2094.2 +000300 SQ209M. SQ2094.2 +000400**************************************************************** SQ2094.2 +000500* * SQ2094.2 +000600* VALIDATION FOR:- * SQ2094.2 +000700* " HIGH ". SQ2094.2 +000800* * SQ2094.2 +000900* CREATION DATE / VALIDATION DATE * SQ2094.2 +001000* "4.2 ". SQ2094.2 +001100* * SQ2094.2 +001200* THE ROUTINE SQ209M TESTS THE USE OF THE LEVEL 2 WRITE SQ2094.2 +001300* STATEMENT AND THE LINAGE CLAUSE FOR A FILE DESIGNATED AS SQ2094.2 +001400* PRINTER OUTPUT. THESE STATEMENTS CONTROL THE VERTICAL SQ2094.2 +001500* POSITONING OF EACH LINE ON A PRINTED PAGE. THE LINAGE SQ2094.2 +001600* CLAUSE SPECIFICALLY CONTROLS THE VERTICAL FORMAT OF A LOGICALSQ2094.2 +001700* PRINT PAGE. SQ209M IS DESIGNED TO TEST THE MINIMUM SQ2094.2 +001800* CONFIGURATION OF THE LINAGE CLAUSE. IT IS ASSUMED THAT ALL SQ2094.2 +001900* LEVEL 2 NUCLEUS OPTIONS ARE AVAILABLE IN TESTING SQ210. SQ2094.2 +002000* BECAUSE OF THE NATURE OF THESE TESTS A "PASS" OR "FAIL" SQ2094.2 +002100* CANNOT BE DETERMINED WITHIN THE PROGRAM. THE USER MUST SQ2094.2 +002200* VISUALLY CHECK THE POSITION OF EACH LINE TO DETERMINE THE SQ2094.2 +002300* ACCURACY OF THE VARIOUS WRITE OPTIONS. SQ2094.2 +002400 ENVIRONMENT DIVISION. SQ2094.2 +002500 CONFIGURATION SECTION. SQ2094.2 +002600 SOURCE-COMPUTER. SQ2094.2 +002700 Linux. SQ2094.2 +002800 OBJECT-COMPUTER. SQ2094.2 +002900 Linux. SQ2094.2 +003000 INPUT-OUTPUT SECTION. SQ2094.2 +003100 FILE-CONTROL. SQ2094.2 +003200*P SELECT RAW-DATA ASSIGN TO SQ2094.2 +003300*P "XXXXX062" SQ2094.2 +003400*P ORGANIZATION IS INDEXED SQ2094.2 +003500*P ACCESS MODE IS RANDOM SQ2094.2 +003600*P RECORD KEY IS RAW-DATA-KEY. SQ2094.2 +003700 SELECT PRINT-FILE ASSIGN TO SQ2094.2 +003800 "report.log". SQ2094.2 +003900 DATA DIVISION. SQ2094.2 +004000 FILE SECTION. SQ2094.2 +004100*P SQ2094.2 +004200*PD RAW-DATA. SQ2094.2 +004300*P SQ2094.2 +004400*P1 RAW-DATA-SATZ. SQ2094.2 +004500*P 05 RAW-DATA-KEY PIC X(6). SQ2094.2 +004600*P 05 C-DATE PIC 9(6). SQ2094.2 +004700*P 05 C-TIME PIC 9(8). SQ2094.2 +004800*P 05 C-NO-OF-TESTS PIC 99. SQ2094.2 +004900*P 05 C-OK PIC 999. SQ2094.2 +005000*P 05 C-ALL PIC 999. SQ2094.2 +005100*P 05 C-FAIL PIC 999. SQ2094.2 +005200*P 05 C-DELETED PIC 999. SQ2094.2 +005300*P 05 C-INSPECT PIC 999. SQ2094.2 +005400*P 05 C-NOTE PIC X(13). SQ2094.2 +005500*P 05 C-INDENT PIC X. SQ2094.2 +005600*P 05 C-ABORT PIC X(8). SQ2094.2 +005700 FD PRINT-FILE SQ2094.2 +005800*C LABEL RECORDS SQ2094.2 +005900*C OMITTED SQ2094.2 +006000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2094.2 +006100 LINAGE 40 SQ2094.2 +006200 TOP 2. SQ2094.2 +006300 01 PRINT-REC PICTURE X(120). SQ2094.2 +006400 01 DUMMY-RECORD PICTURE X(120). SQ2094.2 +006500 WORKING-STORAGE SECTION. SQ2094.2 +006600 77 ONE PIC 9 VALUE 1. SQ2094.2 +006700 01 NOTE-1. SQ2094.2 +006800 02 FILLER PIC X(39) VALUE "BECAUSE OF THE NATURE SQ2094.2 +006900- "OF THESE TESTS A ". SQ2094.2 +007000 02 FILLER PIC X VALUE QUOTE. SQ2094.2 +007100 02 FILLER PIC X(4) VALUE "PASS". SQ2094.2 +007200 02 FILLER PIC X VALUE QUOTE. SQ2094.2 +007300 02 FILLER PIC X(4) VALUE " OR ". SQ2094.2 +007400 02 FILLER PIC X VALUE QUOTE. SQ2094.2 +007500 02 FILLER PIC X(4) VALUE "FAIL". SQ2094.2 +007600 02 FILLER PIC X VALUE QUOTE. SQ2094.2 +007700 02 FILLER PIC X(65) VALUE " CANNOT BE DETERMINED SQ2094.2 +007800- "WITHIN THE PROGRAM. THE USER MUST VISUALLY". SQ2094.2 +007900 01 NOTE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ2094.2 +008000- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ2094.2 +008100- "IONS. VII-27 TO 29 LINAGE ". SQ2094.2 +008200 01 LAST-LINE-1 PIC X(120) VALUE "THIS LINE SHOULD PRINTSQ2094.2 +008300- " AS THE LAST LINE ON THIS LOGICAL PAGE. TWO BLANK LINES SHOUSQ2094.2 +008400- "LD FOLLOW.". SQ2094.2 +008500 01 FIRST-LINE-1 PIC X(120) VALUE "THIS LINE SHOULD PRINTSQ2094.2 +008600- " AS THE FIRST LINE ON A NEW LOGICAL PAGE. IT SHOULD BE THREESQ2094.2 +008700- " LINES BELOW THE PREVIOUS LINE.". SQ2094.2 +008800 01 DETAIL-LINE-3. SQ2094.2 +008900 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2094.2 +009000 02 DL3-LINE-NO PIC 99. SQ2094.2 +009100 02 FILLER PIC X(40) VALUE " OF 60 DETAIL LINES. SQ2094.2 +009200- "LINAGE-COUNTER IS ". SQ2094.2 +009300 02 DL3-LC PIC 99. SQ2094.2 +009400 02 FILLER PIC X(63) VALUE ".". SQ2094.2 +009500 01 FOOT-LINE-3. SQ2094.2 +009600 02 FILLER PIC X(103) VALUE "THIS LINE WAS PRINTED SQ2094.2 +009700- "FROM AN EOP CLAUSE. THE VALUE OF THE LINAGE-COUNTER PRIOR TSQ2094.2 +009800- "O THIS EXECUTION IS ". SQ2094.2 +009900 02 FL3-LC PIC 99. SQ2094.2 +010000 02 FILLER PIC X(15) VALUE ".". SQ2094.2 +010100 01 INFO-LINE-1 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2094.2 +010200- "TO TEST THE OVERFLOW RESULTS OF A WRITE BEFORE ADVANCING OPESQ2094.2 +010300- "RATION CONTAINING AN EOP PHRASE.". SQ2094.2 +010400 01 INFO-LINE-2 PIC X(120) VALUE "THIS TEST IS DESIGNED SQ2094.2 +010500- "TO TEST THE OVERFLOW RESULTS OF A WRITE AFTER ADVANCING OPERSQ2094.2 +010600- "ATION CONTAINING AN EOP PHRASE.". SQ2094.2 +010700 01 INFO-LINE-3 PIC X(120) VALUE "FOR THIS TEST LINAGE VSQ2094.2 +010800- "ALUE IS 40. NO FOOTING PHRASE IS SPECIFIED.". SQ2094.2 +010900 01 INFO-LINE-4 PIC X(120) VALUE "39 DETAIL LINES SHOULDSQ2094.2 +011000- " PRINT ON THE 1ST LOGICAL PAGE AND THE REMAINING 21 DETAIL LSQ2094.2 +011100- "INES ON THE 2ND LOGICAL PAGE.". SQ2094.2 +011200 01 INFO-LINE-5 PIC X(120) VALUE "40 DETAIL LINES SHOULDSQ2094.2 +011300- " PRINT ON THE 1ST LOGICAL PAGE AND THE REMAINING 20 DETAIL LSQ2094.2 +011400- "INES ON THE 2ND LOGICAL PAGE.". SQ2094.2 +011500 01 INFO-LINE-6 PIC X(120) VALUE "THE EOP LINE SHOULD FOSQ2094.2 +011600- "LLOW DETAIL LINE 40 AND BE THE FIRST LINE ON THE 2ND LOGICALSQ2094.2 +011700- " PAGE.". SQ2094.2 +011800 01 INFO-LINE-7 PIC X(120) VALUE "THE EOP LINE SHOULD FOSQ2094.2 +011900- "LLOW DETAIL LINE 40 AND BE THE 2ND LINE ON THE 2ND LOGICAL PSQ2094.2 +012000- "AGE.". SQ2094.2 +012100 01 INFO-LINE-8 PIC X(120) VALUE "ALL LINAGE-COUNTER VALSQ2094.2 +012200- "UES REPRESENT VALUES PRIOR TO EXECUTION OF THE WRITE OPERATISQ2094.2 +012300- "ON. NO MODIFICATIONS HAVE BEEN MADE.". SQ2094.2 +012400 01 TEST-RESULTS. SQ2094.2 +012500 02 FILLER PICTURE X VALUE SPACE. SQ2094.2 +012600 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2094.2 +012700 02 FILLER PICTURE X VALUE SPACE. SQ2094.2 +012800 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2094.2 +012900 02 FILLER PICTURE X VALUE SPACE. SQ2094.2 +013000 02 PAR-NAME. SQ2094.2 +013100 03 FILLER PICTURE X(12) VALUE SPACE. SQ2094.2 +013200 03 PARDOT-X PICTURE X VALUE SPACE. SQ2094.2 +013300 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2094.2 +013400 03 FILLER PIC X(5) VALUE SPACE. SQ2094.2 +013500 02 FILLER PIC X(10) VALUE SPACE. SQ2094.2 +013600 02 RE-MARK PIC X(61). SQ2094.2 +013700 01 TEST-COMPUTED. SQ2094.2 +013800 02 FILLER PIC X(30) VALUE SPACE. SQ2094.2 +013900 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2094.2 +014000 02 COMPUTED-X. SQ2094.2 +014100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2094.2 +014200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2094.2 +014300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2094.2 +014400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2094.2 +014500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2094.2 +014600 03 CM-18V0 REDEFINES COMPUTED-A. SQ2094.2 +014700 04 COMPUTED-18V0 PICTURE -9(18). SQ2094.2 +014800 04 FILLER PICTURE X. SQ2094.2 +014900 03 FILLER PIC X(50) VALUE SPACE. SQ2094.2 +015000 01 TEST-CORRECT. SQ2094.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ2094.2 +015200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2094.2 +015300 02 CORRECT-X. SQ2094.2 +015400 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2094.2 +015500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2094.2 +015600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2094.2 +015700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2094.2 +015800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2094.2 +015900 03 CR-18V0 REDEFINES CORRECT-A. SQ2094.2 +016000 04 CORRECT-18V0 PICTURE -9(18). SQ2094.2 +016100 04 FILLER PICTURE X. SQ2094.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ2094.2 +016300 01 CCVS-C-1. SQ2094.2 +016400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2094.2 +016500- "SS PARAGRAPH-NAME SQ2094.2 +016600- " REMARKS". SQ2094.2 +016700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2094.2 +016800 01 CCVS-C-2. SQ2094.2 +016900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2094.2 +017000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2094.2 +017100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2094.2 +017200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2094.2 +017300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2094.2 +017400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2094.2 +017500 01 REC-CT PICTURE 99 VALUE ZERO. SQ2094.2 +017600 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2094.2 +017700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2094.2 +017800 01 INSPECT-COUNTER PIC 999 VALUE 3. SQ2094.2 +017900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2094.2 +018000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2094.2 +018100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2094.2 +018200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2094.2 +018300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2094.2 +018400 01 CCVS-H-1. SQ2094.2 +018500 02 FILLER PICTURE X(27) VALUE SPACE. SQ2094.2 +018600 02 FILLER PICTURE X(67) VALUE SQ2094.2 +018700 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2094.2 +018800- " SYSTEM". SQ2094.2 +018900 02 FILLER PICTURE X(26) VALUE SPACE. SQ2094.2 +019000 01 CCVS-H-2. SQ2094.2 +019100 02 FILLER PICTURE X(52) VALUE IS SQ2094.2 +019200 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2094.2 +019300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2094.2 +019400 02 TEST-ID PICTURE IS X(9). SQ2094.2 +019500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2094.2 +019600 01 CCVS-H-3. SQ2094.2 +019700 02 FILLER PICTURE X(34) VALUE SQ2094.2 +019800 " FOR OFFICIAL USE ONLY ". SQ2094.2 +019900 02 FILLER PICTURE X(58) VALUE SQ2094.2 +020000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2094.2 +020100 02 FILLER PICTURE X(28) VALUE SQ2094.2 +020200 " COPYRIGHT 1985 ". SQ2094.2 +020300 01 CCVS-E-1. SQ2094.2 +020400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2094.2 +020500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2094.2 +020600 02 ID-AGAIN PICTURE IS X(9). SQ2094.2 +020700 02 FILLER PICTURE X(45) VALUE IS SQ2094.2 +020800 " NTIS DISTRIBUTION COBOL 85". SQ2094.2 +020900 01 CCVS-E-2. SQ2094.2 +021000 02 FILLER PICTURE X(31) VALUE SQ2094.2 +021100 SPACE. SQ2094.2 +021200 02 FILLER PICTURE X(21) VALUE SPACE. SQ2094.2 +021300 02 CCVS-E-2-2. SQ2094.2 +021400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2094.2 +021500 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2094.2 +021600 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2094.2 +021700 01 CCVS-E-3. SQ2094.2 +021800 02 FILLER PICTURE X(22) VALUE SQ2094.2 +021900 " FOR OFFICIAL USE ONLY". SQ2094.2 +022000 02 FILLER PICTURE X(12) VALUE SPACE. SQ2094.2 +022100 02 FILLER PICTURE X(58) VALUE SQ2094.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2094.2 +022300 02 FILLER PICTURE X(13) VALUE SPACE. SQ2094.2 +022400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2094.2 +022500 01 CCVS-E-4. SQ2094.2 +022600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2094.2 +022700 02 FILLER PIC XXXX VALUE " OF ". SQ2094.2 +022800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2094.2 +022900 02 FILLER PIC X(40) VALUE SQ2094.2 +023000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2094.2 +023100 01 XXINFO. SQ2094.2 +023200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2094.2 +023300 02 INFO-TEXT. SQ2094.2 +023400 04 FILLER PIC X(20) VALUE SPACE. SQ2094.2 +023500 04 XXCOMPUTED PIC X(20). SQ2094.2 +023600 04 FILLER PIC X(5) VALUE SPACE. SQ2094.2 +023700 04 XXCORRECT PIC X(20). SQ2094.2 +023800 01 HYPHEN-LINE. SQ2094.2 +023900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2094.2 +024000 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2094.2 +024100- "*****************************************". SQ2094.2 +024200 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2094.2 +024300- "******************************". SQ2094.2 +024400 01 CCVS-PGM-ID PIC X(6) VALUE SQ2094.2 +024500 "SQ209M". SQ2094.2 +024600 PROCEDURE DIVISION. SQ2094.2 +024700 CCVS1 SECTION. SQ2094.2 +024800 OPEN-FILES. SQ2094.2 +024900*P OPEN I-O RAW-DATA. SQ2094.2 +025000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2094.2 +025100*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2094.2 +025200*P MOVE "ABORTED " TO C-ABORT. SQ2094.2 +025300*P ADD 1 TO C-NO-OF-TESTS. SQ2094.2 +025400*P ACCEPT C-DATE FROM DATE. SQ2094.2 +025500*P ACCEPT C-TIME FROM TIME. SQ2094.2 +025600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2094.2 +025700*PND-E-1. SQ2094.2 +025800*P CLOSE RAW-DATA. SQ2094.2 +025900 OPEN OUTPUT PRINT-FILE. SQ2094.2 +026000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2094.2 +026100 MOVE SPACE TO TEST-RESULTS. SQ2094.2 +026200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2094.2 +026300 GO TO CCVS1-EXIT. SQ2094.2 +026400 CLOSE-FILES. SQ2094.2 +026500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2094.2 +026600*P OPEN I-O RAW-DATA. SQ2094.2 +026700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2094.2 +026800*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2094.2 +026900*P MOVE "OK. " TO C-ABORT. SQ2094.2 +027000*P MOVE PASS-COUNTER TO C-OK. SQ2094.2 +027100*P MOVE ERROR-HOLD TO C-ALL. SQ2094.2 +027200*P MOVE ERROR-COUNTER TO C-FAIL. SQ2094.2 +027300*P MOVE DELETE-CNT TO C-DELETED. SQ2094.2 +027400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2094.2 +027500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2094.2 +027600*PND-E-2. SQ2094.2 +027700*P CLOSE RAW-DATA. SQ2094.2 +027800 TERMINATE-CCVS. SQ2094.2 +027900*S EXIT PROGRAM. SQ2094.2 +028000*SERMINATE-CALL. SQ2094.2 +028100 STOP RUN. SQ2094.2 +028200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2094.2 +028300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2094.2 +028400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2094.2 +028500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2094.2 +028600 MOVE "****TEST DELETED****" TO RE-MARK. SQ2094.2 +028700 PRINT-DETAIL. SQ2094.2 +028800 IF REC-CT NOT EQUAL TO ZERO SQ2094.2 +028900 MOVE "." TO PARDOT-X SQ2094.2 +029000 MOVE REC-CT TO DOTVALUE. SQ2094.2 +029100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2094.2 +029200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2094.2 +029300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2094.2 +029400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2094.2 +029500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2094.2 +029600 MOVE SPACE TO CORRECT-X. SQ2094.2 +029700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2094.2 +029800 MOVE SPACE TO RE-MARK. SQ2094.2 +029900 HEAD-ROUTINE. SQ2094.2 +030000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +030100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2094.2 +030200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2094.2 +030300 COLUMN-NAMES-ROUTINE. SQ2094.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +030700 END-ROUTINE. SQ2094.2 +030800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2094.2 +030900 END-RTN-EXIT. SQ2094.2 +031000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +031100 END-ROUTINE-1. SQ2094.2 +031200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2094.2 +031300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2094.2 +031400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2094.2 +031500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2094.2 +031600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2094.2 +031700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2094.2 +031800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2094.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2094.2 +032000 END-ROUTINE-12. SQ2094.2 +032100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2094.2 +032200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2094.2 +032300 MOVE "NO " TO ERROR-TOTAL SQ2094.2 +032400 ELSE SQ2094.2 +032500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2094.2 +032600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2094.2 +032700 PERFORM WRITE-LINE. SQ2094.2 +032800 END-ROUTINE-13. SQ2094.2 +032900 IF DELETE-CNT IS EQUAL TO ZERO SQ2094.2 +033000 MOVE "NO " TO ERROR-TOTAL ELSE SQ2094.2 +033100 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2094.2 +033200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2094.2 +033300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +033400 IF INSPECT-COUNTER EQUAL TO ZERO SQ2094.2 +033500 MOVE "NO " TO ERROR-TOTAL SQ2094.2 +033600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2094.2 +033700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2094.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +033900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2094.2 +034000 WRITE-LINE. SQ2094.2 +034100 ADD 1 TO RECORD-COUNT. SQ2094.2 +034200 IF RECORD-COUNT GREATER 50 SQ2094.2 +034300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2094.2 +034400 MOVE SPACE TO DUMMY-RECORD SQ2094.2 +034500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2094.2 +034600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2094.2 +034700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2094.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2094.2 +034900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2094.2 +035000 MOVE ZERO TO RECORD-COUNT. SQ2094.2 +035100 PERFORM WRT-LN. SQ2094.2 +035200 WRT-LN. SQ2094.2 +035300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2094.2 +035400 MOVE SPACE TO DUMMY-RECORD. SQ2094.2 +035500 BLANK-LINE-PRINT. SQ2094.2 +035600 PERFORM WRT-LN. SQ2094.2 +035700 FAIL-ROUTINE. SQ2094.2 +035800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2094.2 +035900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2094.2 +036000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2094.2 +036100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +036200 GO TO FAIL-ROUTINE-EX. SQ2094.2 +036300 FAIL-ROUTINE-WRITE. SQ2094.2 +036400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2094.2 +036500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +036600 FAIL-ROUTINE-EX. EXIT. SQ2094.2 +036700 BAIL-OUT. SQ2094.2 +036800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2094.2 +036900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2094.2 +037000 BAIL-OUT-WRITE. SQ2094.2 +037100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2094.2 +037200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2094.2 +037300 BAIL-OUT-EX. EXIT. SQ2094.2 +037400 CCVS1-EXIT. SQ2094.2 +037500 EXIT. SQ2094.2 +037600 SECT-SQ209M-0001 SECTION. SQ2094.2 +037700 WRITE-INIT-001. SQ2094.2 +037800 MOVE NOTE-1 TO PRINT-REC. SQ2094.2 +037900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +038000 MOVE NOTE-2 TO PRINT-REC. SQ2094.2 +038100 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +038200 MOVE SPACE TO DUMMY-RECORD. SQ2094.2 +038300 PERFORM BLANK-LINE-PRINT. SQ2094.2 +038400 WRITE-TEST-GF-01. SQ2094.2 +038500* THIS TEST CHECKS THE VERTICAL SPACING BETWEEN SQ2094.2 +038600* LOGICAL PAGES. BECAUSE ONLY THE TOP PHRASE IS SQ2094.2 +038700* SPECIFIED THERE SHOULD BE TWO SPACES BETWEEN PAGES. SQ2094.2 +038800 MOVE "SPACE BTWN LOG PAGES" TO FEATURE. SQ2094.2 +038900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2094.2 +039000 PERFORM PRINT-DETAIL. SQ2094.2 +039100 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 39. SQ2094.2 +039200 MOVE LAST-LINE-1 TO PRINT-REC. SQ2094.2 +039300 WRITE PRINT-REC AFTER ONE LINE. SQ2094.2 +039400 WRITE PRINT-REC FROM FIRST-LINE-1 AFTER ADVANCING PAGE. SQ2094.2 +039500 WRITE-TEST-GF-02. SQ2094.2 +039600* THIS TEST SHOWS THE RESULTS OF A WRITE BEFORE SQ2094.2 +039700* OPERATION WITH AN EOP PHRASE. ONLY LINAGE IS SQ2094.2 +039800* SPECIFIED. SQ2094.2 +039900 MOVE "WRITE BEFORE" TO FEATURE. SQ2094.2 +040000 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2094.2 +040100 PERFORM PRINT-DETAIL. SQ2094.2 +040200 MOVE INFO-LINE-1 TO PRINT-REC. SQ2094.2 +040300 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2094.2 +040400 MOVE INFO-LINE-3 TO PRINT-REC. SQ2094.2 +040500 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +040600 MOVE INFO-LINE-5 TO PRINT-REC. SQ2094.2 +040700 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +040800 MOVE INFO-LINE-6 TO PRINT-REC. SQ2094.2 +040900 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +041000 MOVE INFO-LINE-8 TO PRINT-REC. SQ2094.2 +041100 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +041200 MOVE SPACES TO PRINT-REC. SQ2094.2 +041300 WRITE PRINT-REC BEFORE ADVANCING PAGE. SQ2094.2 +041400 MOVE 1 TO DL3-LINE-NO. SQ2094.2 +041500 PERFORM WRITE-BEFORE 60 TIMES. SQ2094.2 +041600 WRITE-TEST-GF-03. SQ2094.2 +041700* THIS TEST SHOWS THE RESULTS OF A WRITE AFTER SQ2094.2 +041800* OPERATION WITH AN EOP PHRASE. ONLY LINAGE IS SQ2094.2 +041900* SPECIFIED. SQ2094.2 +042000 MOVE "WRITE AFTER" TO FEATURE. SQ2094.2 +042100 MOVE "WRITE-TEST-GF-03" TO PAR-NAME. SQ2094.2 +042200 PERFORM PRINT-DETAIL. SQ2094.2 +042300 MOVE INFO-LINE-2 TO PRINT-REC. SQ2094.2 +042400 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2094.2 +042500 MOVE INFO-LINE-3 TO PRINT-REC. SQ2094.2 +042600 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +042700 MOVE INFO-LINE-4 TO PRINT-REC. SQ2094.2 +042800 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +042900 MOVE INFO-LINE-7 TO PRINT-REC. SQ2094.2 +043000 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +043100 MOVE INFO-LINE-8 TO PRINT-REC. SQ2094.2 +043200 WRITE PRINT-REC AFTER ADVANCING 1 LINES. SQ2094.2 +043300 MOVE SPACES TO PRINT-REC. SQ2094.2 +043400 WRITE PRINT-REC BEFORE ADVANCING PAGE. SQ2094.2 +043500 MOVE 1 TO DL3-LINE-NO. SQ2094.2 +043600 PERFORM WRITE-AFTER 60 TIMES. SQ2094.2 +043700 SQ209M-END-ROUTINE. SQ2094.2 +043800 MOVE "END OF SQ209M VALIDATION TESTS" TO PRINT-REC. SQ2094.2 +043900 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +044000 GO TO CCVS-EXIT. SQ2094.2 +044100 WRITE-BEFORE. SQ2094.2 +044200 MOVE LINAGE-COUNTER TO DL3-LC. SQ2094.2 +044300 MOVE DETAIL-LINE-3 TO PRINT-REC. SQ2094.2 +044400 WRITE PRINT-REC BEFORE ADVANCING 1 LINE AT EOP SQ2094.2 +044500 MOVE LINAGE-COUNTER TO FL3-LC SQ2094.2 +044600 MOVE FOOT-LINE-3 TO PRINT-REC SQ2094.2 +044700 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2094.2 +044800 ADD 1 TO DL3-LINE-NO. SQ2094.2 +044900 WRITE-AFTER. SQ2094.2 +045000 MOVE LINAGE-COUNTER TO DL3-LC. SQ2094.2 +045100 MOVE DETAIL-LINE-3 TO PRINT-REC. SQ2094.2 +045200 WRITE PRINT-REC AFTER ADVANCING 1 LINE AT EOP SQ2094.2 +045300 MOVE LINAGE-COUNTER TO FL3-LC SQ2094.2 +045400 MOVE FOOT-LINE-3 TO PRINT-REC SQ2094.2 +045500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2094.2 +045600 ADD 1 TO DL3-LINE-NO. SQ2094.2 +045700 CCVS-EXIT SECTION. SQ2094.2 +045800 CCVS-999999. SQ2094.2 +045900 GO TO CLOSE-FILES. SQ2094.2 diff --git a/tests/cobol85/SQ/SQ210M.CBL b/tests/cobol85/SQ/SQ210M.CBL new file mode 100755 index 00000000..2c2dedf6 --- /dev/null +++ b/tests/cobol85/SQ/SQ210M.CBL @@ -0,0 +1,374 @@ +000100 IDENTIFICATION DIVISION. SQ2104.2 +000200 PROGRAM-ID. SQ2104.2 +000300 SQ210M. SQ2104.2 +000400**************************************************************** SQ2104.2 +000500* * SQ2104.2 +000600* VALIDATION FOR:- * SQ2104.2 +000700* " HIGH ". SQ2104.2 +000800* * SQ2104.2 +000900* CREATION DATE / VALIDATION DATE * SQ2104.2 +001000* "4.2 ". SQ2104.2 +001100* * SQ2104.2 +001200* THE ROUTINE SQ210M TESTS THE USE OF THE LEVEL 2 WRITE SQ2104.2 +001300* STATEMENT AND THE LINAGE CLAUSE FOR A FILE DESIGNATED AS SQ2104.2 +001400* PRINTER OUTPUT. THESE STATEMENTS CONTROL THE VERTICAL SQ2104.2 +001500* POSITIONING OF EACH LINE ON A PRINTED PAGE. THE LINAGE SQ2104.2 +001600* CLAUSE SPECIFICALLY CONTROLS THE VERTICAL FORMAT OF LOGICAL SQ2104.2 +001700* PRINT PAGE. SQ210M TESTS THE USE OF A MIXTURE OF INTEGER ANDSQ2104.2 +001800* DATA-NAME ITEMS IN THE LINAGE CLAUSE. VALUES OF DATA-NAMES SQ2104.2 +001900* ARE CHANGED IN ORDER TO CHECK REDEFINITION OF LOGICAL PAGE SQ2104.2 +002000* FORMATS. IT IS ASSUMED THAT ALL LEVEL 2 NUCLEUS OPTIONS SQ2104.2 +002100* ARE AVAILABLE IN TESTING SQ210M. SQ2104.2 +002200 ENVIRONMENT DIVISION. SQ2104.2 +002300 CONFIGURATION SECTION. SQ2104.2 +002400 SOURCE-COMPUTER. SQ2104.2 +002500 Linux. SQ2104.2 +002600 OBJECT-COMPUTER. SQ2104.2 +002700 Linux. SQ2104.2 +002800 INPUT-OUTPUT SECTION. SQ2104.2 +002900 FILE-CONTROL. SQ2104.2 +003000*P SELECT RAW-DATA ASSIGN TO SQ2104.2 +003100*P "XXXXX062" SQ2104.2 +003200*P ORGANIZATION IS INDEXED SQ2104.2 +003300*P ACCESS MODE IS RANDOM SQ2104.2 +003400*P RECORD KEY IS RAW-DATA-KEY. SQ2104.2 +003500 SELECT PRINT-FILE ASSIGN TO SQ2104.2 +003600 "report.log". SQ2104.2 +003700 DATA DIVISION. SQ2104.2 +003800 FILE SECTION. SQ2104.2 +003900*P SQ2104.2 +004000*PD RAW-DATA. SQ2104.2 +004100*P SQ2104.2 +004200*P1 RAW-DATA-SATZ. SQ2104.2 +004300*P 05 RAW-DATA-KEY PIC X(6). SQ2104.2 +004400*P 05 C-DATE PIC 9(6). SQ2104.2 +004500*P 05 C-TIME PIC 9(8). SQ2104.2 +004600*P 05 C-NO-OF-TESTS PIC 99. SQ2104.2 +004700*P 05 C-OK PIC 999. SQ2104.2 +004800*P 05 C-ALL PIC 999. SQ2104.2 +004900*P 05 C-FAIL PIC 999. SQ2104.2 +005000*P 05 C-DELETED PIC 999. SQ2104.2 +005100*P 05 C-INSPECT PIC 999. SQ2104.2 +005200*P 05 C-NOTE PIC X(13). SQ2104.2 +005300*P 05 C-INDENT PIC X. SQ2104.2 +005400*P 05 C-ABORT PIC X(8). SQ2104.2 +005500 FD PRINT-FILE SQ2104.2 +005600*C LABEL RECORDS SQ2104.2 +005700*C OMITTED SQ2104.2 +005800*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2104.2 +005900 LINAGE IS LINAGE-CTR LINES SQ2104.2 +006000 TOP 5. SQ2104.2 +006100 01 PRINT-REC PICTURE X(120). SQ2104.2 +006200 01 DUMMY-RECORD PICTURE X(120). SQ2104.2 +006300 WORKING-STORAGE SECTION. SQ2104.2 +006400 77 LINAGE-CTR PIC 99 VALUE 66. SQ2104.2 +006500 01 DETAIL-LINE-1. SQ2104.2 +006600 02 FILLER PIC X(20) VALUE SPACE. SQ2104.2 +006700 02 FILLER PIC X(13) VALUE "THIS IS LINE ". SQ2104.2 +006800 02 DL1-LINE-NO PIC 99. SQ2104.2 +006900 02 FILLER PIC X(40) VALUE " OF 80 DETAIL LINES. SQ2104.2 +007000- "LINAGE-COUNTER IS ". SQ2104.2 +007100 02 DL1-LC PIC 99. SQ2104.2 +007200 02 FILLER PIC X(43) VALUE ".". SQ2104.2 +007300 01 COMMENT-LINE-1 PIC X(120) VALUE "BECAUSE OF THE NATURE SQ2104.2 +007400- "OF THESE TESTS A PASS OR FAIL CANNOT BE DETERMINED WITHIN THSQ2104.2 +007500- "E PROGRAM. THE USER MUST VISUALLY". SQ2104.2 +007600 01 COMMENT-LINE-2 PIC X(120) VALUE "CHECK THE POSITION OF SQ2104.2 +007700- "EACH LINE TO DETERMINE THE ACCURACY OF THE VARIOUS WRITE OPTSQ2104.2 +007800- "IONS. VII-27 TO 29". SQ2104.2 +007900 01 COMMENT-LINE-3 PIC X(120) VALUE "IN THIS TEST THE FIRSTSQ2104.2 +008000- " LOGICAL PAGE SHOULD CONTAIN 20 DETAIL LINES. ALL SUCCEEDINSQ2104.2 +008100- "G LOGICAL PAGES SHOULD CONTAIN 30". SQ2104.2 +008200 01 COMMENT-LINE-4 PIC X(120) VALUE "DETAIL LINES. ALL LOGSQ2104.2 +008300- "ICAL PAGES SHOULD BE SEPARATED BY 5 BLANK LINES.". SQ2104.2 +008400 01 LAST-LINE PIC X(120) VALUE "THIS IS THE LAST LINE SQ2104.2 +008500- "IN THE PAGE BODY OF THIS LOGICAL PAGE. USE IT AS A REFERENCSQ2104.2 +008600- "E POINT FOR THE FOLLOWING TEST PAGES.". SQ2104.2 +008700 01 TEST-RESULTS. SQ2104.2 +008800 02 FILLER PICTURE X VALUE SPACE. SQ2104.2 +008900 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2104.2 +009000 02 FILLER PICTURE X VALUE SPACE. SQ2104.2 +009100 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2104.2 +009200 02 FILLER PICTURE X VALUE SPACE. SQ2104.2 +009300 02 PAR-NAME. SQ2104.2 +009400 03 FILLER PICTURE X(12) VALUE SPACE. SQ2104.2 +009500 03 PARDOT-X PICTURE X VALUE SPACE. SQ2104.2 +009600 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2104.2 +009700 03 FILLER PIC X(5) VALUE SPACE. SQ2104.2 +009800 02 FILLER PIC X(10) VALUE SPACE. SQ2104.2 +009900 02 RE-MARK PIC X(61). SQ2104.2 +010000 01 TEST-COMPUTED. SQ2104.2 +010100 02 FILLER PIC X(30) VALUE SPACE. SQ2104.2 +010200 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2104.2 +010300 02 COMPUTED-X. SQ2104.2 +010400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2104.2 +010500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2104.2 +010600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2104.2 +010700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2104.2 +010800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2104.2 +010900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2104.2 +011000 04 COMPUTED-18V0 PICTURE -9(18). SQ2104.2 +011100 04 FILLER PICTURE X. SQ2104.2 +011200 03 FILLER PIC X(50) VALUE SPACE. SQ2104.2 +011300 01 TEST-CORRECT. SQ2104.2 +011400 02 FILLER PIC X(30) VALUE SPACE. SQ2104.2 +011500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2104.2 +011600 02 CORRECT-X. SQ2104.2 +011700 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2104.2 +011800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2104.2 +011900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2104.2 +012000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2104.2 +012100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2104.2 +012200 03 CR-18V0 REDEFINES CORRECT-A. SQ2104.2 +012300 04 CORRECT-18V0 PICTURE -9(18). SQ2104.2 +012400 04 FILLER PICTURE X. SQ2104.2 +012500 03 FILLER PIC X(50) VALUE SPACE. SQ2104.2 +012600 01 CCVS-C-1. SQ2104.2 +012700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2104.2 +012800- "SS PARAGRAPH-NAME SQ2104.2 +012900- " REMARKS". SQ2104.2 +013000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2104.2 +013100 01 CCVS-C-2. SQ2104.2 +013200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2104.2 +013300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2104.2 +013400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2104.2 +013500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2104.2 +013600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2104.2 +013700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2104.2 +013800 01 REC-CT PICTURE 99 VALUE ZERO. SQ2104.2 +013900 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2104.2 +014000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2104.2 +014100 01 INSPECT-COUNTER PIC 999 VALUE 3. SQ2104.2 +014200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2104.2 +014300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2104.2 +014400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2104.2 +014500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2104.2 +014600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2104.2 +014700 01 CCVS-H-1. SQ2104.2 +014800 02 FILLER PICTURE X(27) VALUE SPACE. SQ2104.2 +014900 02 FILLER PICTURE X(67) VALUE SQ2104.2 +015000 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2104.2 +015100- " SYSTEM". SQ2104.2 +015200 02 FILLER PICTURE X(26) VALUE SPACE. SQ2104.2 +015300 01 CCVS-H-2. SQ2104.2 +015400 02 FILLER PICTURE X(52) VALUE IS SQ2104.2 +015500 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2104.2 +015600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2104.2 +015700 02 TEST-ID PICTURE IS X(9). SQ2104.2 +015800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2104.2 +015900 01 CCVS-H-3. SQ2104.2 +016000 02 FILLER PICTURE X(34) VALUE SQ2104.2 +016100 " FOR OFFICIAL USE ONLY ". SQ2104.2 +016200 02 FILLER PICTURE X(58) VALUE SQ2104.2 +016300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2104.2 +016400 02 FILLER PICTURE X(28) VALUE SQ2104.2 +016500 " COPYRIGHT 1985 ". SQ2104.2 +016600 01 CCVS-E-1. SQ2104.2 +016700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2104.2 +016800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2104.2 +016900 02 ID-AGAIN PICTURE IS X(9). SQ2104.2 +017000 02 FILLER PICTURE X(45) VALUE IS SQ2104.2 +017100 " NTIS DISTRIBUTION COBOL 85". SQ2104.2 +017200 01 CCVS-E-2. SQ2104.2 +017300 02 FILLER PICTURE X(31) VALUE SQ2104.2 +017400 SPACE. SQ2104.2 +017500 02 FILLER PICTURE X(21) VALUE SPACE. SQ2104.2 +017600 02 CCVS-E-2-2. SQ2104.2 +017700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2104.2 +017800 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2104.2 +017900 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2104.2 +018000 01 CCVS-E-3. SQ2104.2 +018100 02 FILLER PICTURE X(22) VALUE SQ2104.2 +018200 " FOR OFFICIAL USE ONLY". SQ2104.2 +018300 02 FILLER PICTURE X(12) VALUE SPACE. SQ2104.2 +018400 02 FILLER PICTURE X(58) VALUE SQ2104.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2104.2 +018600 02 FILLER PICTURE X(13) VALUE SPACE. SQ2104.2 +018700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2104.2 +018800 01 CCVS-E-4. SQ2104.2 +018900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2104.2 +019000 02 FILLER PIC XXXX VALUE " OF ". SQ2104.2 +019100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2104.2 +019200 02 FILLER PIC X(40) VALUE SQ2104.2 +019300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2104.2 +019400 01 XXINFO. SQ2104.2 +019500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2104.2 +019600 02 INFO-TEXT. SQ2104.2 +019700 04 FILLER PIC X(20) VALUE SPACE. SQ2104.2 +019800 04 XXCOMPUTED PIC X(20). SQ2104.2 +019900 04 FILLER PIC X(5) VALUE SPACE. SQ2104.2 +020000 04 XXCORRECT PIC X(20). SQ2104.2 +020100 01 HYPHEN-LINE. SQ2104.2 +020200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2104.2 +020300 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2104.2 +020400- "*****************************************". SQ2104.2 +020500 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2104.2 +020600- "******************************". SQ2104.2 +020700 01 CCVS-PGM-ID PIC X(6) VALUE SQ2104.2 +020800 "SQ210M". SQ2104.2 +020900 PROCEDURE DIVISION. SQ2104.2 +021000 CCVS1 SECTION. SQ2104.2 +021100 OPEN-FILES. SQ2104.2 +021200*P OPEN I-O RAW-DATA. SQ2104.2 +021300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2104.2 +021400*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2104.2 +021500*P MOVE "ABORTED " TO C-ABORT. SQ2104.2 +021600*P ADD 1 TO C-NO-OF-TESTS. SQ2104.2 +021700*P ACCEPT C-DATE FROM DATE. SQ2104.2 +021800*P ACCEPT C-TIME FROM TIME. SQ2104.2 +021900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2104.2 +022000*PND-E-1. SQ2104.2 +022100*P CLOSE RAW-DATA. SQ2104.2 +022200 OPEN OUTPUT PRINT-FILE. SQ2104.2 +022300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2104.2 +022400 MOVE SPACE TO TEST-RESULTS. SQ2104.2 +022500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2104.2 +022600 GO TO CCVS1-EXIT. SQ2104.2 +022700 CLOSE-FILES. SQ2104.2 +022800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2104.2 +022900*P OPEN I-O RAW-DATA. SQ2104.2 +023000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2104.2 +023100*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2104.2 +023200*P MOVE "OK. " TO C-ABORT. SQ2104.2 +023300*P MOVE PASS-COUNTER TO C-OK. SQ2104.2 +023400*P MOVE ERROR-HOLD TO C-ALL. SQ2104.2 +023500*P MOVE ERROR-COUNTER TO C-FAIL. SQ2104.2 +023600*P MOVE DELETE-CNT TO C-DELETED. SQ2104.2 +023700*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2104.2 +023800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2104.2 +023900*PND-E-2. SQ2104.2 +024000*P CLOSE RAW-DATA. SQ2104.2 +024100 TERMINATE-CCVS. SQ2104.2 +024200*S EXIT PROGRAM. SQ2104.2 +024300*SERMINATE-CALL. SQ2104.2 +024400 STOP RUN. SQ2104.2 +024500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2104.2 +024600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2104.2 +024700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2104.2 +024800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2104.2 +024900 MOVE "****TEST DELETED****" TO RE-MARK. SQ2104.2 +025000 PRINT-DETAIL. SQ2104.2 +025100 IF REC-CT NOT EQUAL TO ZERO SQ2104.2 +025200 MOVE "." TO PARDOT-X SQ2104.2 +025300 MOVE REC-CT TO DOTVALUE. SQ2104.2 +025400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2104.2 +025500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2104.2 +025600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2104.2 +025700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2104.2 +025800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2104.2 +025900 MOVE SPACE TO CORRECT-X. SQ2104.2 +026000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2104.2 +026100 MOVE SPACE TO RE-MARK. SQ2104.2 +026200 HEAD-ROUTINE. SQ2104.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +026400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2104.2 +026500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2104.2 +026600 COLUMN-NAMES-ROUTINE. SQ2104.2 +026700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +026800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +026900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +027000 END-ROUTINE. SQ2104.2 +027100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2104.2 +027200 END-RTN-EXIT. SQ2104.2 +027300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +027400 END-ROUTINE-1. SQ2104.2 +027500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2104.2 +027600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2104.2 +027700 ADD PASS-COUNTER TO ERROR-HOLD. SQ2104.2 +027800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2104.2 +027900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2104.2 +028000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2104.2 +028100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2104.2 +028200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2104.2 +028300 END-ROUTINE-12. SQ2104.2 +028400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2104.2 +028500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2104.2 +028600 MOVE "NO " TO ERROR-TOTAL SQ2104.2 +028700 ELSE SQ2104.2 +028800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2104.2 +028900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2104.2 +029000 PERFORM WRITE-LINE. SQ2104.2 +029100 END-ROUTINE-13. SQ2104.2 +029200 IF DELETE-CNT IS EQUAL TO ZERO SQ2104.2 +029300 MOVE "NO " TO ERROR-TOTAL ELSE SQ2104.2 +029400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2104.2 +029500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2104.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +029700 IF INSPECT-COUNTER EQUAL TO ZERO SQ2104.2 +029800 MOVE "NO " TO ERROR-TOTAL SQ2104.2 +029900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2104.2 +030000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2104.2 +030100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +030200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2104.2 +030300 WRITE-LINE. SQ2104.2 +030400 ADD 1 TO RECORD-COUNT. SQ2104.2 +030500 IF RECORD-COUNT GREATER 50 SQ2104.2 +030600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2104.2 +030700 MOVE SPACE TO DUMMY-RECORD SQ2104.2 +030800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2104.2 +030900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2104.2 +031000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2104.2 +031100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2104.2 +031200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2104.2 +031300 MOVE ZERO TO RECORD-COUNT. SQ2104.2 +031400 PERFORM WRT-LN. SQ2104.2 +031500 WRT-LN. SQ2104.2 +031600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2104.2 +031700 MOVE SPACE TO DUMMY-RECORD. SQ2104.2 +031800 BLANK-LINE-PRINT. SQ2104.2 +031900 PERFORM WRT-LN. SQ2104.2 +032000 FAIL-ROUTINE. SQ2104.2 +032100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2104.2 +032200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2104.2 +032300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2104.2 +032400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +032500 GO TO FAIL-ROUTINE-EX. SQ2104.2 +032600 FAIL-ROUTINE-WRITE. SQ2104.2 +032700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2104.2 +032800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +032900 FAIL-ROUTINE-EX. EXIT. SQ2104.2 +033000 BAIL-OUT. SQ2104.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2104.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2104.2 +033300 BAIL-OUT-WRITE. SQ2104.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2104.2 +033500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2104.2 +033600 BAIL-OUT-EX. EXIT. SQ2104.2 +033700 CCVS1-EXIT. SQ2104.2 +033800 EXIT. SQ2104.2 +033900 SECT-SQ210M-0001 SECTION. SQ2104.2 +034000 WRITE-INIT-GF-01. SQ2104.2 +034100 MOVE COMMENT-LINE-1 TO PRINT-REC. SQ2104.2 +034200 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2104.2 +034300 MOVE COMMENT-LINE-2 TO PRINT-REC. SQ2104.2 +034400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2104.2 +034500 WRITE-TEST-GF-01. SQ2104.2 +034600* THIS TEST CHECKS A LINAGE CLAUSE WHICH CONTAINS SQ2104.2 +034700* PHRASES WITH BOTH INTEGER AND DATA NAME ITEMS. SQ2104.2 +034800 MOVE "LINAGE INT / D-N MIX" TO FEATURE. SQ2104.2 +034900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2104.2 +035000 PERFORM PRINT-DETAIL. SQ2104.2 +035100 MOVE COMMENT-LINE-3 TO PRINT-REC. SQ2104.2 +035200 WRITE PRINT-REC AFTER ADVANCING 5 LINES. SQ2104.2 +035300 MOVE COMMENT-LINE-4 TO PRINT-REC. SQ2104.2 +035400 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2104.2 +035500 MOVE SPACE TO DUMMY-RECORD. SQ2104.2 +035600 PERFORM BLANK-LINE-PRINT UNTIL LINAGE-COUNTER EQUAL 66. SQ2104.2 +035700 MOVE 20 TO LINAGE-CTR. SQ2104.2 +035800 MOVE LAST-LINE TO PRINT-REC. SQ2104.2 +035900 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2104.2 +036000 MOVE 30 TO LINAGE-CTR. SQ2104.2 +036100 MOVE 1 TO DL1-LINE-NO. SQ2104.2 +036200 PERFORM PRINT-DETAIL-1 80 TIMES. SQ2104.2 +036300 SQ210M-END-ROUTINE. SQ2104.2 +036400 MOVE "END OF SQ210M VALIDATION TESTS" TO PRINT-REC. SQ2104.2 +036500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2104.2 +036600 GO TO CCVS-EXIT. SQ2104.2 +036700 PRINT-DETAIL-1. SQ2104.2 +036800 MOVE LINAGE-COUNTER TO DL1-LC. SQ2104.2 +036900 MOVE DETAIL-LINE-1 TO PRINT-REC. SQ2104.2 +037000 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. SQ2104.2 +037100 ADD 1 TO DL1-LINE-NO. SQ2104.2 +037200 CCVS-EXIT SECTION. SQ2104.2 +037300 CCVS-999999. SQ2104.2 +037400 GO TO CLOSE-FILES. SQ2104.2 diff --git a/tests/cobol85/SQ/SQ211A.CBL b/tests/cobol85/SQ/SQ211A.CBL new file mode 100755 index 00000000..24aa7c3b --- /dev/null +++ b/tests/cobol85/SQ/SQ211A.CBL @@ -0,0 +1,554 @@ +000100 IDENTIFICATION DIVISION. SQ2114.2 +000200 PROGRAM-ID. SQ2114.2 +000300 SQ211A. SQ2114.2 +000400**************************************************************** SQ2114.2 +000500* * SQ2114.2 +000600* VALIDATION FOR:- * SQ2114.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2114.2 +000800* USING CCVS85 VERSION 3.0. * SQ2114.2 +000900* * SQ2114.2 +001000* CREATION DATE / VALIDATION DATE * SQ2114.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2114.2 +001200* * SQ2114.2 +001300**************************************************************** SQ2114.2 +001400* * SQ2114.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2114.2 +001600* * SQ2114.2 +001700* X-01 SEQUENTIAL TAPE * SQ2114.2 +001800* X-55 SYSTEM PRINTER * SQ2114.2 +001900* X-82 SOURCE-COMPUTER * SQ2114.2 +002000* X-83 OBJECT-COMPUTER. * SQ2114.2 +002100* X-84 LABEL RECORDS OPTION * SQ2114.2 +002200* * SQ2114.2 +002300**************************************************************** SQ2114.2 +002400* * SQ2114.2 +002500* SQ211A TESTS THE CLOSE STATEMENT WITH THE WITH LOCK PHRASE* SQ2114.2 +002600* A MAGNETIC TAPE FILE WITH ONE RECORD IS CREATED AND IS * SQ2114.2 +002700* CLOSED WITH LOCK. THE FILE IS THEN RE-OPENED AFTER IT HAS* SQ2114.2 +002800* BEEN CLOSED WITH LOCK. THERE ARE NO DECLARATIVE * SQ2114.2 +002900* PROCEDURES. THE TEST FOR CORRECT I-O STATUS CODE IS IN * SQ2114.2 +003000* THE MAIN LINE CODE, THEREFORE AN ABNORMAL TERMINATION IS * SQ2114.2 +003100* POSSIBLE BEFORE THE TEST OF THE I-O STATUS CODE IS * SQ2114.2 +003200* ACCOMPLISHED. * SQ2114.2 +003300* * SQ2114.2 +003400**************************************************************** SQ2114.2 +003500* SQ2114.2 +003600 ENVIRONMENT DIVISION. SQ2114.2 +003700 CONFIGURATION SECTION. SQ2114.2 +003800 SOURCE-COMPUTER. SQ2114.2 +003900 Linux. SQ2114.2 +004000 OBJECT-COMPUTER. SQ2114.2 +004100 Linux. SQ2114.2 +004200* SQ2114.2 +004300 INPUT-OUTPUT SECTION. SQ2114.2 +004400 FILE-CONTROL. SQ2114.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2114.2 +004600 "report.log". SQ2114.2 +004700* SQ2114.2 +004800 SELECT SQ-FS1 ASSIGN TO SQ2114.2 +004900 "XXXXX001" SQ2114.2 +005000 FILE STATUS IS SQ-FS1-STATUS. SQ2114.2 +005100* SQ2114.2 +005200* SQ2114.2 +005300 DATA DIVISION. SQ2114.2 +005400 FILE SECTION. SQ2114.2 +005500 FD PRINT-FILE SQ2114.2 +005600*C LABEL RECORDS SQ2114.2 +005700*C OMITTED SQ2114.2 +005800*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2114.2 +005900 . SQ2114.2 +006000 01 PRINT-REC PICTURE X(120). SQ2114.2 +006100 01 DUMMY-RECORD PICTURE X(120). SQ2114.2 +006200* SQ2114.2 +006300 FD SQ-FS1 SQ2114.2 +006400*C LABEL RECORD IS STANDARD SQ2114.2 +006500 . SQ2114.2 +006600 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2114.2 +006700* SQ2114.2 +006800 WORKING-STORAGE SECTION. SQ2114.2 +006900* SQ2114.2 +007000*************************************************************** SQ2114.2 +007100* * SQ2114.2 +007200* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2114.2 +007300* * SQ2114.2 +007400*************************************************************** SQ2114.2 +007500* SQ2114.2 +007600 01 SQ-FS1-STATUS. SQ2114.2 +007700 03 SQ-FS1-KEY-1 PIC X. SQ2114.2 +007800 03 SQ-FS1-KEY-2 PIC X. SQ2114.2 +007900* SQ2114.2 +008000*************************************************************** SQ2114.2 +008100* * SQ2114.2 +008200* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2114.2 +008300* * SQ2114.2 +008400*************************************************************** SQ2114.2 +008500* SQ2114.2 +008600 01 REC-SKEL-SUB PIC 99. SQ2114.2 +008700* SQ2114.2 +008800 01 FILE-RECORD-INFORMATION-REC. SQ2114.2 +008900 03 FILE-RECORD-INFO-SKELETON. SQ2114.2 +009000 05 FILLER PICTURE X(48) VALUE SQ2114.2 +009100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2114.2 +009200 05 FILLER PICTURE X(46) VALUE SQ2114.2 +009300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2114.2 +009400 05 FILLER PICTURE X(26) VALUE SQ2114.2 +009500 ",LFIL=000000,ORG= ,LBLR= ". SQ2114.2 +009600 05 FILLER PICTURE X(37) VALUE SQ2114.2 +009700 ",RECKEY= ". SQ2114.2 +009800 05 FILLER PICTURE X(38) VALUE SQ2114.2 +009900 ",ALTKEY1= ". SQ2114.2 +010000 05 FILLER PICTURE X(38) VALUE SQ2114.2 +010100 ",ALTKEY2= ". SQ2114.2 +010200 05 FILLER PICTURE X(7) VALUE SPACE.SQ2114.2 +010300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2114.2 +010400 05 FILE-RECORD-INFO-P1-120. SQ2114.2 +010500 07 FILLER PIC X(5). SQ2114.2 +010600 07 XFILE-NAME PIC X(6). SQ2114.2 +010700 07 FILLER PIC X(8). SQ2114.2 +010800 07 XRECORD-NAME PIC X(6). SQ2114.2 +010900 07 FILLER PIC X(1). SQ2114.2 +011000 07 REELUNIT-NUMBER PIC 9(1). SQ2114.2 +011100 07 FILLER PIC X(7). SQ2114.2 +011200 07 XRECORD-NUMBER PIC 9(6). SQ2114.2 +011300 07 FILLER PIC X(6). SQ2114.2 +011400 07 UPDATE-NUMBER PIC 9(2). SQ2114.2 +011500 07 FILLER PIC X(5). SQ2114.2 +011600 07 ODO-NUMBER PIC 9(4). SQ2114.2 +011700 07 FILLER PIC X(5). SQ2114.2 +011800 07 XPROGRAM-NAME PIC X(5). SQ2114.2 +011900 07 FILLER PIC X(7). SQ2114.2 +012000 07 XRECORD-LENGTH PIC 9(6). SQ2114.2 +012100 07 FILLER PIC X(7). SQ2114.2 +012200 07 CHARS-OR-RECORDS PIC X(2). SQ2114.2 +012300 07 FILLER PIC X(1). SQ2114.2 +012400 07 XBLOCK-SIZE PIC 9(4). SQ2114.2 +012500 07 FILLER PIC X(6). SQ2114.2 +012600 07 RECORDS-IN-FILE PIC 9(6). SQ2114.2 +012700 07 FILLER PIC X(5). SQ2114.2 +012800 07 XFILE-ORGANIZATION PIC X(2). SQ2114.2 +012900 07 FILLER PIC X(6). SQ2114.2 +013000 07 XLABEL-TYPE PIC X(1). SQ2114.2 +013100 05 FILE-RECORD-INFO-P121-240. SQ2114.2 +013200 07 FILLER PIC X(8). SQ2114.2 +013300 07 XRECORD-KEY PIC X(29). SQ2114.2 +013400 07 FILLER PIC X(9). SQ2114.2 +013500 07 ALTERNATE-KEY1 PIC X(29). SQ2114.2 +013600 07 FILLER PIC X(9). SQ2114.2 +013700 07 ALTERNATE-KEY2 PIC X(29). SQ2114.2 +013800 07 FILLER PIC X(7). SQ2114.2 +013900* SQ2114.2 +014000 01 TEST-RESULTS. SQ2114.2 +014100 02 FILLER PIC X VALUE SPACE. SQ2114.2 +014200 02 FEATURE PIC X(24) VALUE SPACE. SQ2114.2 +014300 02 FILLER PIC X VALUE SPACE. SQ2114.2 +014400 02 P-OR-F PIC X(5) VALUE SPACE. SQ2114.2 +014500 02 FILLER PIC X VALUE SPACE. SQ2114.2 +014600 02 PAR-NAME. SQ2114.2 +014700 03 FILLER PIC X(14) VALUE SPACE. SQ2114.2 +014800 03 PARDOT-X PIC X VALUE SPACE. SQ2114.2 +014900 03 DOTVALUE PIC 99 VALUE ZERO. SQ2114.2 +015000 02 FILLER PIC X(9) VALUE SPACE. SQ2114.2 +015100 02 RE-MARK PIC X(61). SQ2114.2 +015200 01 TEST-COMPUTED. SQ2114.2 +015300 02 FILLER PIC X(30) VALUE SPACE. SQ2114.2 +015400 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2114.2 +015500 02 COMPUTED-X. SQ2114.2 +015600 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2114.2 +015700 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2114.2 +015800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2114.2 +015900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2114.2 +016000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2114.2 +016100 03 CM-18V0 REDEFINES COMPUTED-A. SQ2114.2 +016200 04 COMPUTED-18V0 PIC -9(18). SQ2114.2 +016300 04 FILLER PIC X. SQ2114.2 +016400 03 FILLER PIC X(50) VALUE SPACE. SQ2114.2 +016500 01 TEST-CORRECT. SQ2114.2 +016600 02 FILLER PIC X(30) VALUE SPACE. SQ2114.2 +016700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2114.2 +016800 02 CORRECT-X. SQ2114.2 +016900 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2114.2 +017000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2114.2 +017100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2114.2 +017200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2114.2 +017300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2114.2 +017400 03 CR-18V0 REDEFINES CORRECT-A. SQ2114.2 +017500 04 CORRECT-18V0 PIC -9(18). SQ2114.2 +017600 04 FILLER PIC X. SQ2114.2 +017700 03 FILLER PIC X(2) VALUE SPACE. SQ2114.2 +017800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2114.2 +017900 01 CCVS-C-1. SQ2114.2 +018000 02 FILLER PIC IS X(4) VALUE SPACE. SQ2114.2 +018100 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ2114.2 +018200- "SS PARAGRAPH-NAME SQ2114.2 +018300- " REMARKS". SQ2114.2 +018400 02 FILLER PIC X(17) VALUE SPACE. SQ2114.2 +018500 01 CCVS-C-2. SQ2114.2 +018600 02 FILLER PIC XXXX VALUE SPACE. SQ2114.2 +018700 02 FILLER PIC X(6) VALUE "TESTED". SQ2114.2 +018800 02 FILLER PIC X(16) VALUE SPACE. SQ2114.2 +018900 02 FILLER PIC X(4) VALUE "FAIL". SQ2114.2 +019000 02 FILLER PIC X(90) VALUE SPACE. SQ2114.2 +019100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2114.2 +019200 01 REC-CT PIC 99 VALUE ZERO. SQ2114.2 +019300 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2114.2 +019400 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2114.2 +019500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2114.2 +019600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2114.2 +019700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2114.2 +019800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2114.2 +019900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2114.2 +020000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2114.2 +020100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2114.2 +020200 01 CCVS-H-1. SQ2114.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ2114.2 +020400 02 FILLER PIC X(42) VALUE SQ2114.2 +020500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2114.2 +020600 02 FILLER PIC X(39) VALUE SPACES. SQ2114.2 +020700 01 CCVS-H-2A. SQ2114.2 +020800 02 FILLER PIC X(40) VALUE SPACE. SQ2114.2 +020900 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2114.2 +021000 02 FILLER PIC XXXX VALUE SQ2114.2 +021100 "4.2 ". SQ2114.2 +021200 02 FILLER PIC X(28) VALUE SQ2114.2 +021300 " COPY - NOT FOR DISTRIBUTION". SQ2114.2 +021400 02 FILLER PIC X(41) VALUE SPACE. SQ2114.2 +021500* SQ2114.2 +021600 01 CCVS-H-2B. SQ2114.2 +021700 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2114.2 +021800 02 TEST-ID PIC X(9). SQ2114.2 +021900 02 FILLER PIC X(4) VALUE " IN ". SQ2114.2 +022000 02 FILLER PIC X(12) VALUE SQ2114.2 +022100 " HIGH ". SQ2114.2 +022200 02 FILLER PIC X(22) VALUE SQ2114.2 +022300 " LEVEL VALIDATION FOR ". SQ2114.2 +022400 02 FILLER PIC X(58) VALUE SQ2114.2 +022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2114.2 +022600 01 CCVS-H-3. SQ2114.2 +022700 02 FILLER PIC X(34) VALUE SQ2114.2 +022800 " FOR OFFICIAL USE ONLY ". SQ2114.2 +022900 02 FILLER PIC X(58) VALUE SQ2114.2 +023000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2114.2 +023100 02 FILLER PIC X(28) VALUE SQ2114.2 +023200 " COPYRIGHT 1985,1986 ". SQ2114.2 +023300 01 CCVS-E-1. SQ2114.2 +023400 02 FILLER PIC X(52) VALUE SPACE. SQ2114.2 +023500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2114.2 +023600 02 ID-AGAIN PIC X(9). SQ2114.2 +023700 02 FILLER PIC X(45) VALUE SPACES. SQ2114.2 +023800 01 CCVS-E-2. SQ2114.2 +023900 02 FILLER PIC X(31) VALUE SPACE. SQ2114.2 +024000 02 FILLER PIC X(21) VALUE SPACE. SQ2114.2 +024100 02 CCVS-E-2-2. SQ2114.2 +024200 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2114.2 +024300 03 FILLER PIC X VALUE SPACE. SQ2114.2 +024400 03 ENDER-DESC PIC X(44) VALUE SQ2114.2 +024500 "ERRORS ENCOUNTERED". SQ2114.2 +024600 01 CCVS-E-3. SQ2114.2 +024700 02 FILLER PIC X(22) VALUE SQ2114.2 +024800 " FOR OFFICIAL USE ONLY". SQ2114.2 +024900 02 FILLER PIC X(12) VALUE SPACE. SQ2114.2 +025000 02 FILLER PIC X(58) VALUE SQ2114.2 +025100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2114.2 +025200 02 FILLER PIC X(8) VALUE SPACE. SQ2114.2 +025300 02 FILLER PIC X(20) VALUE SQ2114.2 +025400 " COPYRIGHT 1985,1986". SQ2114.2 +025500 01 CCVS-E-4. SQ2114.2 +025600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2114.2 +025700 02 FILLER PIC X(4) VALUE " OF ". SQ2114.2 +025800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2114.2 +025900 02 FILLER PIC X(40) VALUE SQ2114.2 +026000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2114.2 +026100 01 XXINFO. SQ2114.2 +026200 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2114.2 +026300 02 INFO-TEXT. SQ2114.2 +026400 04 FILLER PIC X(8) VALUE SPACE. SQ2114.2 +026500 04 XXCOMPUTED PIC X(20). SQ2114.2 +026600 04 FILLER PIC X(5) VALUE SPACE. SQ2114.2 +026700 04 XXCORRECT PIC X(20). SQ2114.2 +026800 02 INF-ANSI-REFERENCE PIC X(48). SQ2114.2 +026900 01 HYPHEN-LINE. SQ2114.2 +027000 02 FILLER PIC IS X VALUE IS SPACE. SQ2114.2 +027100 02 FILLER PIC IS X(65) VALUE IS "************************SQ2114.2 +027200- "*****************************************". SQ2114.2 +027300 02 FILLER PIC IS X(54) VALUE IS "************************SQ2114.2 +027400- "******************************". SQ2114.2 +027500 01 CCVS-PGM-ID PIC X(9) VALUE SQ2114.2 +027600 "SQ211A". SQ2114.2 +027700* SQ2114.2 +027800 PROCEDURE DIVISION. SQ2114.2 +027900 CCVS1 SECTION. SQ2114.2 +028000 OPEN-FILES. SQ2114.2 +028100 OPEN OUTPUT PRINT-FILE. SQ2114.2 +028200 MOVE CCVS-PGM-ID TO TEST-ID. SQ2114.2 +028300 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2114.2 +028400 MOVE SPACE TO TEST-RESULTS. SQ2114.2 +028500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2114.2 +028600 MOVE ZERO TO REC-SKEL-SUB. SQ2114.2 +028700 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2114.2 +028800 GO TO CCVS1-EXIT. SQ2114.2 +028900* SQ2114.2 +029000 CCVS-INIT-FILE. SQ2114.2 +029100 ADD 1 TO REC-SKL-SUB. SQ2114.2 +029200 MOVE FILE-RECORD-INFO-SKELETON TO SQ2114.2 +029300 FILE-RECORD-INFO (REC-SKL-SUB). SQ2114.2 +029400* SQ2114.2 +029500 CLOSE-FILES. SQ2114.2 +029600 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2114.2 +029700 CLOSE PRINT-FILE. SQ2114.2 +029800 TERMINATE-CCVS. SQ2114.2 +029900 STOP RUN. SQ2114.2 +030000* SQ2114.2 +030100 INSPT. SQ2114.2 +030200 MOVE "INSPT" TO P-OR-F. SQ2114.2 +030300 ADD 1 TO INSPECT-COUNTER. SQ2114.2 +030400 PERFORM PRINT-DETAIL. SQ2114.2 +030500 SQ2114.2 +030600 PASS. SQ2114.2 +030700 MOVE "PASS " TO P-OR-F. SQ2114.2 +030800 ADD 1 TO PASS-COUNTER. SQ2114.2 +030900 PERFORM PRINT-DETAIL. SQ2114.2 +031000* SQ2114.2 +031100 FAIL. SQ2114.2 +031200 MOVE "FAIL*" TO P-OR-F. SQ2114.2 +031300 ADD 1 TO ERROR-COUNTER. SQ2114.2 +031400 PERFORM PRINT-DETAIL. SQ2114.2 +031500* SQ2114.2 +031600 DE-LETE. SQ2114.2 +031700 MOVE "****TEST DELETED****" TO RE-MARK. SQ2114.2 +031800 MOVE "*****" TO P-OR-F. SQ2114.2 +031900 ADD 1 TO DELETE-COUNTER. SQ2114.2 +032000 PERFORM PRINT-DETAIL. SQ2114.2 +032100* SQ2114.2 +032200 PRINT-DETAIL. SQ2114.2 +032300 IF REC-CT NOT EQUAL TO ZERO SQ2114.2 +032400 MOVE "." TO PARDOT-X SQ2114.2 +032500 MOVE REC-CT TO DOTVALUE. SQ2114.2 +032600 MOVE TEST-RESULTS TO PRINT-REC. SQ2114.2 +032700 PERFORM WRITE-LINE. SQ2114.2 +032800 IF P-OR-F EQUAL TO "FAIL*" SQ2114.2 +032900 PERFORM WRITE-LINE SQ2114.2 +033000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2114.2 +033100 ELSE SQ2114.2 +033200 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2114.2 +033300 MOVE SPACE TO P-OR-F. SQ2114.2 +033400 MOVE SPACE TO COMPUTED-X. SQ2114.2 +033500 MOVE SPACE TO CORRECT-X. SQ2114.2 +033600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2114.2 +033700 MOVE SPACE TO RE-MARK. SQ2114.2 +033800* SQ2114.2 +033900 HEAD-ROUTINE. SQ2114.2 +034000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +034100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +034200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2114.2 +034300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2114.2 +034400 COLUMN-NAMES-ROUTINE. SQ2114.2 +034500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2114.2 +034600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2114.2 +034800 END-ROUTINE. SQ2114.2 +034900 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2114.2 +035000 PERFORM WRITE-LINE 5 TIMES. SQ2114.2 +035100 END-RTN-EXIT. SQ2114.2 +035200 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2114.2 +035300 PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +035400* SQ2114.2 +035500 END-ROUTINE-1. SQ2114.2 +035600 ADD ERROR-COUNTER TO ERROR-HOLD SQ2114.2 +035700 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2114.2 +035800 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2114.2 +035900 ADD PASS-COUNTER TO ERROR-HOLD. SQ2114.2 +036000 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2114.2 +036100 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2114.2 +036200 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2114.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2114.2 +036400 PERFORM WRITE-LINE. SQ2114.2 +036500 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2114.2 +036600 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2114.2 +036700 MOVE "NO " TO ERROR-TOTAL SQ2114.2 +036800 ELSE SQ2114.2 +036900 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2114.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2114.2 +037100 PERFORM WRITE-LINE. SQ2114.2 +037200 END-ROUTINE-13. SQ2114.2 +037300 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2114.2 +037400 MOVE "NO " TO ERROR-TOTAL SQ2114.2 +037500 ELSE SQ2114.2 +037600 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2114.2 +037700 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2114.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2114.2 +037900 PERFORM WRITE-LINE. SQ2114.2 +038000 IF INSPECT-COUNTER EQUAL TO ZERO SQ2114.2 +038100 MOVE "NO " TO ERROR-TOTAL SQ2114.2 +038200 ELSE SQ2114.2 +038300 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2114.2 +038400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2114.2 +038500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2114.2 +038600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2114.2 +038700* SQ2114.2 +038800 WRITE-LINE. SQ2114.2 +038900 ADD 1 TO RECORD-COUNT. SQ2114.2 +039000 IF RECORD-COUNT GREATER 50 SQ2114.2 +039100 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2114.2 +039200 MOVE SPACE TO DUMMY-RECORD SQ2114.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2114.2 +039400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2114.2 +039500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2114.2 +039600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2114.2 +039700 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2114.2 +039800 MOVE ZERO TO RECORD-COUNT. SQ2114.2 +039900 PERFORM WRT-LN. SQ2114.2 +040000* SQ2114.2 +040100 WRT-LN. SQ2114.2 +040200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2114.2 +040300 MOVE SPACE TO DUMMY-RECORD. SQ2114.2 +040400 BLANK-LINE-PRINT. SQ2114.2 +040500 PERFORM WRT-LN. SQ2114.2 +040600 FAIL-ROUTINE. SQ2114.2 +040700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2114.2 +040800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2114.2 +040900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2114.2 +041000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2114.2 +041100 MOVE XXINFO TO DUMMY-RECORD. SQ2114.2 +041200 PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +041300 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2114.2 +041400 GO TO FAIL-ROUTINE-EX. SQ2114.2 +041500 FAIL-ROUTINE-WRITE. SQ2114.2 +041600 MOVE TEST-COMPUTED TO PRINT-REC SQ2114.2 +041700 PERFORM WRITE-LINE SQ2114.2 +041800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2114.2 +041900 MOVE TEST-CORRECT TO PRINT-REC SQ2114.2 +042000 PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +042100 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2114.2 +042200 FAIL-ROUTINE-EX. SQ2114.2 +042300 EXIT. SQ2114.2 +042400 BAIL-OUT. SQ2114.2 +042500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2114.2 +042600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2114.2 +042700 BAIL-OUT-WRITE. SQ2114.2 +042800 MOVE CORRECT-A TO XXCORRECT. SQ2114.2 +042900 MOVE COMPUTED-A TO XXCOMPUTED. SQ2114.2 +043000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2114.2 +043100 MOVE XXINFO TO DUMMY-RECORD. SQ2114.2 +043200 PERFORM WRITE-LINE 2 TIMES. SQ2114.2 +043300 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2114.2 +043400 BAIL-OUT-EX. SQ2114.2 +043500 EXIT. SQ2114.2 +043600 CCVS1-EXIT. SQ2114.2 +043700 EXIT. SQ2114.2 +043800* SQ2114.2 +043900**************************************************************** SQ2114.2 +044000* * SQ2114.2 +044100* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2114.2 +044200* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2114.2 +044300* * SQ2114.2 +044400**************************************************************** SQ2114.2 +044500* SQ2114.2 +044600 SECT-SQ211A-0001 SECTION. SQ2114.2 +044700 WRITE-INIT-GF-01. SQ2114.2 +044800* SQ2114.2 +044900* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT WITH LOCK. SQ2114.2 +045000* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ2114.2 +045100* SQ2114.2 +045200 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2114.2 +045300 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2114.2 +045400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2114.2 +045500 MOVE 120 TO XRECORD-LENGTH (1). SQ2114.2 +045600 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2114.2 +045700 MOVE 1 TO XBLOCK-SIZE (1). SQ2114.2 +045800 MOVE 1 TO RECORDS-IN-FILE (1). SQ2114.2 +045900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2114.2 +046000 MOVE "S" TO XLABEL-TYPE (1). SQ2114.2 +046100 MOVE 1 TO XRECORD-NUMBER (1). SQ2114.2 +046200* SQ2114.2 +046300 WRITE-OPEN-01. SQ2114.2 +046400 MOVE 1 TO REC-CT. SQ2114.2 +046500 MOVE "WRITE-OPEN-01" TO PAR-NAME. SQ2114.2 +046600 MOVE "OPEN OUTPUT - NEW FILE" TO FEATURE. SQ2114.2 +046700 MOVE "**" TO SQ-FS1-STATUS. SQ2114.2 +046800 OPEN OUTPUT SQ-FS1. SQ2114.2 +046900 IF SQ-FS1-STATUS = "00" SQ2114.2 +047000 PERFORM PASS SQ2114.2 +047100 ELSE SQ2114.2 +047200 MOVE "00" TO CORRECT-A SQ2114.2 +047300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2114.2 +047400 MOVE "FILE OPEN FAILED, FURTHER TESTS ABANDONED" SQ2114.2 +047500 TO RE-MARK SQ2114.2 +047600 MOVE "VII-3, VII-40, FILE STATUS" TO ANSI-REFERENCE SQ2114.2 +047700 PERFORM FAIL SQ2114.2 +047800 GO TO CCVS-EXIT SQ2114.2 +047900 END-IF. SQ2114.2 +048000* SQ2114.2 +048100* WRITE A SINGLE RECORD TO THE FILE SQ2114.2 +048200* SQ2114.2 +048300 WRITE-INIT-01. SQ2114.2 +048400 MOVE 1 TO REC-CT. SQ2114.2 +048500 MOVE "WRITE-TEST-01" TO PAR-NAME SQ2114.2 +048600 MOVE "SEQUENTIAL WRITE" TO FEATURE. SQ2114.2 +048700 WRITE-TEST-01-01. SQ2114.2 +048800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2114.2 +048900 WRITE SQ-FS1R1-F-G-120. SQ2114.2 +049000 IF SQ-FS1-STATUS = "00" SQ2114.2 +049100 PERFORM PASS SQ2114.2 +049200 ELSE SQ2114.2 +049300 MOVE "00" TO CORRECT-A SQ2114.2 +049400 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2114.2 +049500 MOVE "WRITING FAILED, FURTHER TESTS ABANDONED" SQ2114.2 +049600 TO RE-MARK SQ2114.2 +049700 MOVE "VII-3, VII-53, FILE STATUS" TO ANSI-REFERENCE SQ2114.2 +049800 PERFORM FAIL SQ2114.2 +049900 GO TO CCVS-EXIT SQ2114.2 +050000 END-IF. SQ2114.2 +050100* SQ2114.2 +050200* CLOSE THE FILE WITH LOCK, SO IT SHOULD NOT REOPEN SQ2114.2 +050300* SQ2114.2 +050400 CLOSE-INIT-01. SQ2114.2 +050500 MOVE 1 TO REC-CT. SQ2114.2 +050600 MOVE "CLOSE-TEST-01" TO PAR-NAME. SQ2114.2 +050700 MOVE "CLOSE WITH LOCK" TO FEATURE. SQ2114.2 +050800 MOVE "**" TO SQ-FS1-STATUS. SQ2114.2 +050900 CLOSE-TEST-01. SQ2114.2 +051000 CLOSE SQ-FS1 WITH LOCK. SQ2114.2 +051100 IF SQ-FS1-STATUS = "00" SQ2114.2 +051200 PERFORM PASS SQ2114.2 +051300 ELSE SQ2114.2 +051400 MOVE "00" TO CORRECT-A SQ2114.2 +051500 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2114.2 +051600 MOVE "CLOSE WITH LOCK FAILED, FURTHER TESTS ABANDONED" SQ2114.2 +051700 TO RE-MARK SQ2114.2 +051800 MOVE "VII-3, VII-38, FILE STATUS" TO ANSI-REFERENCE SQ2114.2 +051900 PERFORM FAIL SQ2114.2 +052000 GO TO CCVS-EXIT SQ2114.2 +052100 END-IF. SQ2114.2 +052200* SQ2114.2 +052300* HAVING LOCKED THE FILE, WE NOW TRY TO REOPEN IT. SQ2114.2 +052400* THE TEST PASSES IF THE FILE CANNOT BE OPENED AND SQ2114.2 +052500* THE APPROPRIATE I-O STATUS VALUE IS RETURNED. SQ2114.2 +052600* AN IMPLEMENTATION MAY TERMINATE EXECUTION OF THE SQ2114.2 +052700* PROGRAM ON EXIT FROM THE DECLARATIVE ASSOCIATED SQ2114.2 +052800* WITH THE FILE, OR MAY RETURN CONTROL TO THE SQ2114.2 +052900* STATEMENT FOLLOWING THE OPEN STATEMENT. SQ2114.2 +053000* SQ2114.2 +053100 OPEN-INIT-01. SQ2114.2 +053200* SQ2114.2 +053300 MOVE "OPEN AFTER LOCK" TO FEATURE. SQ2114.2 +053400 MOVE "**" TO SQ-FS1-STATUS. SQ2114.2 +053500 OPEN-TEST-01. SQ2114.2 +053600 MOVE 1 TO REC-CT. SQ2114.2 +053700 MOVE "OPEN-TEST-01" TO PAR-NAME. SQ2114.2 +053800 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2114.2 +053900 TO DUMMY-RECORD. SQ2114.2 +054000 PERFORM WRITE-LINE 3 TIMES. SQ2114.2 +054100 OPEN INPUT SQ-FS1. SQ2114.2 +054200 IF SQ-FS1-STATUS = "38" SQ2114.2 +054300 PERFORM PASS SQ2114.2 +054400 ELSE SQ2114.2 +054500 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2114.2 +054600 MOVE "38" TO CORRECT-A SQ2114.2 +054700 MOVE "STATUS OF OPEN AFTER CLOSE WITH LOCK INCORRECT" SQ2114.2 +054800 TO RE-MARK SQ2114.2 +054900 PERFORM FAIL SQ2114.2 +055000 END-IF. SQ2114.2 +055100* SQ2114.2 +055200 CCVS-EXIT SECTION. SQ2114.2 +055300 CCVS-999999. SQ2114.2 +055400 GO TO CLOSE-FILES. SQ2114.2 diff --git a/tests/cobol85/SQ/SQ212A.CBL b/tests/cobol85/SQ/SQ212A.CBL new file mode 100755 index 00000000..6b2ef4cb --- /dev/null +++ b/tests/cobol85/SQ/SQ212A.CBL @@ -0,0 +1,767 @@ +000100 IDENTIFICATION DIVISION. SQ2124.2 +000200 PROGRAM-ID. SQ2124.2 +000300 SQ212A. SQ2124.2 +000400**************************************************************** SQ2124.2 +000500* * SQ2124.2 +000600* VALIDATION FOR:- * SQ2124.2 +000700* " HIGH ". SQ2124.2 +000800* * SQ2124.2 +000900* CREATION DATE / VALIDATION DATE * SQ2124.2 +001000* "4.2 ". SQ2124.2 +001100* * SQ2124.2 +001200* THIS ROUTINE CHECKS THE SQ2124.2 +001300* FILE STATUS VALUE 44 (BOUNDARY VIOLATION) SQ2124.2 +001400* SQ2124.2 +001500* FOR: WRITE SMALLER OR LAGER RECORDS SQ2124.2 +001600* AND: REWRITE SMALLER OR LAGER RECORDS SQ2124.2 +001700* SQ2124.2 +001800* FOR A FILE WITH VARIABLE LENGTH RECORDS FOLLOWING: SQ2124.2 +001900* SQ2124.2 +002000* RECORD IS VARYING IN SIZE FROM 18 TO 2048 CHARACTERS SQ2124.2 +002100* DEPENDING ON DATA-NAME-1. SQ2124.2 +002200* SQ2124.2 +002300* AN ATTEMPT IS MADE TO WRITE 3 SMALLER RECORDS. THEN 2031 SQ2124.2 +002400* RECORDS SHOULD BE WRITTEN AND THEN FUTHER 9 LARGER RECORDS SQ2124.2 +002500* SHOULD CAUSE A BOUNDARY VIOLATION WITH STATUS CODE 44. SQ2124.2 +002600* THEN THE FILE IS CLOSED AND OPENED AGAIN FOR INPUT. SQ2124.2 +002700* 2031 RECORDS WILL BE READ. THEN THE RECORD NO 2031 IS TRIED SQ2124.2 +002800* BE READ. THIS READ STATEMENT MUST CAUSE THE AT END SQ2124.2 +002900* CONDITION. IF THERE IS ANOTHER RECORD, IT DOES MEAN THAT SQ2124.2 +003000* EITHER A SMALLER OR A LARGER RECORD HAVE BEEN WRITTEN. SQ2124.2 +003100* (SEE VII-5; 1.3.7 AND VII-54; GR (13) ). SQ2124.2 +003200* SQ2124.2 +003300* SQ2124.2 +003400* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE WHICH SQ2124.2 +003500* CONTAINS 2031 RECORDS OF A LENGTH OF 18 TO 2048 CHARACTERS. SQ2124.2 +003600* THE MASS STORAGE FILE IS READ AND FIELDS IN THE RECORDS ARE SQ2124.2 +003700* CHECKED AGAINST THE EXPECTED VALUES. SQ2124.2 +003800* SQ2124.2 +003900 ENVIRONMENT DIVISION. SQ2124.2 +004000 CONFIGURATION SECTION. SQ2124.2 +004100 SOURCE-COMPUTER. SQ2124.2 +004200 Linux. SQ2124.2 +004300 OBJECT-COMPUTER. SQ2124.2 +004400 Linux. SQ2124.2 +004500 INPUT-OUTPUT SECTION. SQ2124.2 +004600 FILE-CONTROL. SQ2124.2 +004700*P SELECT RAW-DATA ASSIGN TO SQ2124.2 +004800*P "XXXXX062" SQ2124.2 +004900*P ORGANIZATION IS INDEXED SQ2124.2 +005000*P ACCESS MODE IS RANDOM SQ2124.2 +005100*P RECORD KEY IS RAW-DATA-KEY. SQ2124.2 +005200 SELECT PRINT-FILE ASSIGN TO SQ2124.2 +005300 "report.log". SQ2124.2 +005400 SELECT SQ-VS7 ASSIGN TO SQ2124.2 +005500 "XXXXX014" SQ2124.2 +005600 ORGANIZATION SEQUENTIAL SQ2124.2 +005700 ACCESS SEQUENTIAL SQ2124.2 +005800 STATUS IS SQ-VS7-STATUS. SQ2124.2 +005900 DATA DIVISION. SQ2124.2 +006000 FILE SECTION. SQ2124.2 +006100*P SQ2124.2 +006200*PD RAW-DATA. SQ2124.2 +006300*P SQ2124.2 +006400*P1 RAW-DATA-SATZ. SQ2124.2 +006500*P 05 RAW-DATA-KEY PIC X(6). SQ2124.2 +006600*P 05 C-DATE PIC 9(6). SQ2124.2 +006700*P 05 C-TIME PIC 9(8). SQ2124.2 +006800*P 05 C-NO-OF-TESTS PIC 99. SQ2124.2 +006900*P 05 C-OK PIC 999. SQ2124.2 +007000*P 05 C-ALL PIC 999. SQ2124.2 +007100*P 05 C-FAIL PIC 999. SQ2124.2 +007200*P 05 C-DELETED PIC 999. SQ2124.2 +007300*P 05 C-INSPECT PIC 999. SQ2124.2 +007400*P 05 C-NOTE PIC X(13). SQ2124.2 +007500*P 05 C-INDENT PIC X. SQ2124.2 +007600*P 05 C-ABORT PIC X(8). SQ2124.2 +007700 FD PRINT-FILE SQ2124.2 +007800*C LABEL RECORDS SQ2124.2 +007900*C OMITTED SQ2124.2 +008000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2124.2 +008100 . SQ2124.2 +008200 01 PRINT-REC PICTURE X(120). SQ2124.2 +008300 01 DUMMY-RECORD PICTURE X(120). SQ2124.2 +008400 FD SQ-VS7 SQ2124.2 +008500*C LABEL RECORDS ARE STANDARD SQ2124.2 +008600 RECORD IS VARYING IN SIZE FROM 18 TO 2048 CHARACTERS SQ2124.2 +008700 DEPENDING ON RECORD-LENGTH. SQ2124.2 +008800 01 SQ-VSR7R1-M-G-2048. SQ2124.2 +008900 02 SQ-VS7R1-FIRST PICTURE X(2048). SQ2124.2 +009000 WORKING-STORAGE SECTION. SQ2124.2 +009100 01 SWITCH-WRITE-REWRITE PICTURE 9 VALUE ZERO. SQ2124.2 +009200 01 RECORD-LENGTH PICTURE 9999 VALUE ZERO. SQ2124.2 +009300 01 SQ-VS7-STATUS PICTURE XX VALUE SPACES. SQ2124.2 +009400 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2124.2 +009500 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2124.2 +009600 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL SQ2124.2 +009700 VALUE ZERO. SQ2124.2 +009800 01 ERROR-FLAG PICTURE 9. SQ2124.2 +009900 01 EOF-FLAG PICTURE 9. SQ2124.2 +010000 01 DUMP-AREA. SQ2124.2 +010100 02 TYPE-OF-REC PICTURE X(5). SQ2124.2 +010200 02 RECNO PICTURE 9(5). SQ2124.2 +010300 02 FILLER PICTURE X(21). SQ2124.2 +010400 02 FILLER PICTURE X(21). SQ2124.2 +010500 01 VAR-RECORD-18-2048. SQ2124.2 +010600 05 FILLER PIC X(13) VALUE "SQ-VS7LENGTH=". SQ2124.2 +010700 05 RECORD-NUMBER PIC 9999 VALUE ZERO. SQ2124.2 +010800 05 FILLER PIC X(100) VALUE SQ2124.2 +010900 "........10........20........30........40........50........60SQ2124.2 +011000- "........70........80........90.......100". SQ2124.2 +011100 05 FILLER PIC X(100) VALUE SQ2124.2 +011200 ".......110.......120.......130.......140.......150.......160SQ2124.2 +011300- ".......170.......180.......190.......200". SQ2124.2 +011400 05 FILLER PIC X(100) VALUE SQ2124.2 +011500 ".......210.......220.......230.......240.......250.......260SQ2124.2 +011600- ".......270.......280.......290.......300". SQ2124.2 +011700 05 FILLER PIC X(100) VALUE SQ2124.2 +011800 ".......310.......320.......330.......340.......350.......360SQ2124.2 +011900- ".......370.......380.......390.......400". SQ2124.2 +012000 05 FILLER PIC X(100) VALUE SQ2124.2 +012100 ".......410.......420.......430.......440.......450.......460SQ2124.2 +012200- ".......470.......480.......490.......500". SQ2124.2 +012300 05 FILLER PIC X(100) VALUE SQ2124.2 +012400 ".......510.......520.......530.......540.......550.......560SQ2124.2 +012500- ".......570.......580.......590.......600". SQ2124.2 +012600 05 FILLER PIC X(100) VALUE SQ2124.2 +012700 ".......610.......620.......630.......640.......650.......660SQ2124.2 +012800- ".......670.......680.......690.......700". SQ2124.2 +012900 05 FILLER PIC X(100) VALUE SQ2124.2 +013000 ".......710.......720.......730.......740.......750.......760SQ2124.2 +013100- ".......770.......780.......790.......800". SQ2124.2 +013200 05 FILLER PIC X(100) VALUE SQ2124.2 +013300 ".......810.......820.......830.......840.......850.......860SQ2124.2 +013400- ".......870.......880.......890.......900". SQ2124.2 +013500 05 FILLER PIC X(100) VALUE SQ2124.2 +013600 ".......910.......920.......930.......940.......950.......960SQ2124.2 +013700- ".......970.......980.......990......1000". SQ2124.2 +013800 05 FILLER PIC X(100) VALUE SQ2124.2 +013900 "......1010......1020......1030......1040......1050......1060SQ2124.2 +014000- "......1070......1080......1090......1100". SQ2124.2 +014100 05 FILLER PIC X(100) VALUE SQ2124.2 +014200 "......1110......1120......1130......1140......1150......1160SQ2124.2 +014300- "......1170......1180......1190......1200". SQ2124.2 +014400 05 FILLER PIC X(100) VALUE SQ2124.2 +014500 "......1210......1220......1230......1240......1250......1260SQ2124.2 +014600- ".......270.......280.......290.......300". SQ2124.2 +014700 05 FILLER PIC X(100) VALUE SQ2124.2 +014800 "......1310......1320......1330......1340......1350......1360SQ2124.2 +014900- "......1370......1380......1390......1400". SQ2124.2 +015000 05 FILLER PIC X(100) VALUE SQ2124.2 +015100 "......1410......1420......1430......1440......1450......1460SQ2124.2 +015200- "......1470......1480......1490......1500". SQ2124.2 +015300 05 FILLER PIC X(100) VALUE SQ2124.2 +015400 "......1510......1520......1530......1540......1550......1560SQ2124.2 +015500- "......1570......1580......1590......1600". SQ2124.2 +015600 05 FILLER PIC X(100) VALUE SQ2124.2 +015700 "......1610......1620......1630......1640......1650......1660SQ2124.2 +015800- "......1670......1680......1690......1700". SQ2124.2 +015900 05 FILLER PIC X(100) VALUE SQ2124.2 +016000 "......1710......1720......1730......1740......1750......1760SQ2124.2 +016100- "......1770......1780......1790......1800". SQ2124.2 +016200 05 FILLER PIC X(100) VALUE SQ2124.2 +016300 "......1810......1820......1830......1840......1850......1860SQ2124.2 +016400- "......1870......1880......1890......1900". SQ2124.2 +016500 05 FILLER PIC X(100) VALUE SQ2124.2 +016600 "......1910......1920......1930......1940......1950......1960SQ2124.2 +016700- "......1970......1980......1990......2000". SQ2124.2 +016800 05 FILLER PIC X(100) VALUE SQ2124.2 +016900 "......2010......2020......2030......2040....,...". SQ2124.2 +017000 01 TEST-RESULTS. SQ2124.2 +017100 02 FILLER PICTURE X VALUE SPACE. SQ2124.2 +017200 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2124.2 +017300 02 FILLER PICTURE X VALUE SPACE. SQ2124.2 +017400 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2124.2 +017500 02 FILLER PICTURE X VALUE SPACE. SQ2124.2 +017600 02 PAR-NAME. SQ2124.2 +017700 03 FILLER PICTURE X(12) VALUE SPACE. SQ2124.2 +017800 03 PARDOT-X PICTURE X VALUE SPACE. SQ2124.2 +017900 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2124.2 +018000 03 FILLER PIC X(5) VALUE SPACE. SQ2124.2 +018100 02 FILLER PIC X(10) VALUE SPACE. SQ2124.2 +018200 02 RE-MARK PIC X(61). SQ2124.2 +018300 01 TEST-COMPUTED. SQ2124.2 +018400 02 FILLER PIC X(30) VALUE SPACE. SQ2124.2 +018500 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2124.2 +018600 02 COMPUTED-X. SQ2124.2 +018700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2124.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2124.2 +018900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2124.2 +019000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2124.2 +019100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2124.2 +019200 03 CM-18V0 REDEFINES COMPUTED-A. SQ2124.2 +019300 04 COMPUTED-18V0 PICTURE -9(18). SQ2124.2 +019400 04 FILLER PICTURE X. SQ2124.2 +019500 03 FILLER PIC X(50) VALUE SPACE. SQ2124.2 +019600 01 TEST-CORRECT. SQ2124.2 +019700 02 FILLER PIC X(30) VALUE SPACE. SQ2124.2 +019800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2124.2 +019900 02 CORRECT-X. SQ2124.2 +020000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2124.2 +020100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2124.2 +020200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2124.2 +020300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2124.2 +020400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2124.2 +020500 03 CR-18V0 REDEFINES CORRECT-A. SQ2124.2 +020600 04 CORRECT-18V0 PICTURE -9(18). SQ2124.2 +020700 04 FILLER PICTURE X. SQ2124.2 +020800 03 FILLER PIC X(50) VALUE SPACE. SQ2124.2 +020900 01 CCVS-C-1. SQ2124.2 +021000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2124.2 +021100- "SS PARAGRAPH-NAME SQ2124.2 +021200- " REMARKS". SQ2124.2 +021300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2124.2 +021400 01 CCVS-C-2. SQ2124.2 +021500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2124.2 +021600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2124.2 +021700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2124.2 +021800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2124.2 +021900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2124.2 +022000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2124.2 +022100 01 REC-CT PICTURE 99 VALUE ZERO. SQ2124.2 +022200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2124.2 +022300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2124.2 +022400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2124.2 +022500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2124.2 +022600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2124.2 +022700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2124.2 +022800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2124.2 +022900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2124.2 +023000 01 CCVS-H-1. SQ2124.2 +023100 02 FILLER PICTURE X(27) VALUE SPACE. SQ2124.2 +023200 02 FILLER PICTURE X(67) VALUE SQ2124.2 +023300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2124.2 +023400- " SYSTEM". SQ2124.2 +023500 02 FILLER PICTURE X(26) VALUE SPACE. SQ2124.2 +023600 01 CCVS-H-2. SQ2124.2 +023700 02 FILLER PICTURE X(52) VALUE IS SQ2124.2 +023800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2124.2 +023900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2124.2 +024000 02 TEST-ID PICTURE IS X(9). SQ2124.2 +024100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2124.2 +024200 01 CCVS-H-3. SQ2124.2 +024300 02 FILLER PICTURE X(34) VALUE SQ2124.2 +024400 " FOR OFFICIAL USE ONLY ". SQ2124.2 +024500 02 FILLER PICTURE X(58) VALUE SQ2124.2 +024600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2124.2 +024700 02 FILLER PICTURE X(28) VALUE SQ2124.2 +024800 " COPYRIGHT 1985 ". SQ2124.2 +024900 01 CCVS-E-1. SQ2124.2 +025000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2124.2 +025100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2124.2 +025200 02 ID-AGAIN PICTURE IS X(9). SQ2124.2 +025300 02 FILLER PICTURE X(45) VALUE IS SQ2124.2 +025400 " NTIS DISTRIBUTION COBOL 85". SQ2124.2 +025500 01 CCVS-E-2. SQ2124.2 +025600 02 FILLER PICTURE X(31) VALUE SQ2124.2 +025700 SPACE. SQ2124.2 +025800 02 FILLER PICTURE X(21) VALUE SPACE. SQ2124.2 +025900 02 CCVS-E-2-2. SQ2124.2 +026000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2124.2 +026100 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2124.2 +026200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2124.2 +026300 01 CCVS-E-3. SQ2124.2 +026400 02 FILLER PICTURE X(22) VALUE SQ2124.2 +026500 " FOR OFFICIAL USE ONLY". SQ2124.2 +026600 02 FILLER PICTURE X(12) VALUE SPACE. SQ2124.2 +026700 02 FILLER PICTURE X(58) VALUE SQ2124.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2124.2 +026900 02 FILLER PICTURE X(13) VALUE SPACE. SQ2124.2 +027000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2124.2 +027100 01 CCVS-E-4. SQ2124.2 +027200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2124.2 +027300 02 FILLER PIC XXXX VALUE " OF ". SQ2124.2 +027400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2124.2 +027500 02 FILLER PIC X(40) VALUE SQ2124.2 +027600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2124.2 +027700 01 XXINFO. SQ2124.2 +027800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2124.2 +027900 02 INFO-TEXT. SQ2124.2 +028000 04 FILLER PIC X(20) VALUE SPACE. SQ2124.2 +028100 04 XXCOMPUTED PIC X(20). SQ2124.2 +028200 04 FILLER PIC X(5) VALUE SPACE. SQ2124.2 +028300 04 XXCORRECT PIC X(20). SQ2124.2 +028400 01 HYPHEN-LINE. SQ2124.2 +028500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2124.2 +028600 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2124.2 +028700- "*****************************************". SQ2124.2 +028800 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2124.2 +028900- "******************************". SQ2124.2 +029000 01 CCVS-PGM-ID PIC X(6) VALUE SQ2124.2 +029100 "SQ212A". SQ2124.2 +029200 PROCEDURE DIVISION. SQ2124.2 +029300 DECLARATIVES. SQ2124.2 +029400 SECT-SQ212A-0001 SECTION. SQ2124.2 +029500 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-VS7. SQ2124.2 +029600 TEST-STATUS-44-00. SQ2124.2 +029700 IF SWITCH-WRITE-REWRITE = 1 SQ2124.2 +029800 GO TO TEST-STATUS-44-0. SQ2124.2 +029900 GO TO TEST-STATUS-44-1-0. SQ2124.2 +030000 TEST-STATUS-44-0. SQ2124.2 +030100 IF SQ-VS7-STATUS = "44" SQ2124.2 +030200 GO TO TEST-STATUS-44-PASS. SQ2124.2 +030300 TEST-STATUS-44-FAIL. SQ2124.2 +030400 MOVE "VII-4 (3) D. 1)" TO RE-MARK. SQ2124.2 +030500 PERFORM FAIL1. SQ2124.2 +030600 MOVE SQ-VS7-STATUS TO COMPUTED-A. SQ2124.2 +030700 MOVE "44" TO CORRECT-A. SQ2124.2 +030800 GO TO TEST-STATUS-44-WRITE. SQ2124.2 +030900 TEST-STATUS-44-PASS. SQ2124.2 +031000 PERFORM PASS1. SQ2124.2 +031100 TEST-STATUS-44-WRITE. SQ2124.2 +031200 MOVE "DECL-STATUS-44-0" TO PAR-NAME. SQ2124.2 +031300 PERFORM PRINT-DETAIL1. SQ2124.2 +031400 ADD 1 TO RECORDS-IN-ERROR. SQ2124.2 +031500 GO TO EXIT-PARA. SQ2124.2 +031600 TEST-STATUS-44-1-0. SQ2124.2 +031700 IF SQ-VS7-STATUS = "44" SQ2124.2 +031800 GO TO TEST-STATUS-44-1-PASS. SQ2124.2 +031900 TEST-STATUS-44-1-FAIL. SQ2124.2 +032000 MOVE "VII-4 (3) D. 1)" TO RE-MARK. SQ2124.2 +032100 PERFORM FAIL1. SQ2124.2 +032200 MOVE SQ-VS7-STATUS TO COMPUTED-A. SQ2124.2 +032300 MOVE "44" TO CORRECT-A. SQ2124.2 +032400 GO TO TEST-STATUS-44-1-WRITE. SQ2124.2 +032500 TEST-STATUS-44-1-PASS. SQ2124.2 +032600 PERFORM PASS1. SQ2124.2 +032700 TEST-STATUS-44-1-WRITE. SQ2124.2 +032800* RWRT SHORTER & LONGER SQ2124.2 +032900 PERFORM PRINT-DETAIL1. SQ2124.2 +033000 ADD 1 TO RECORDS-IN-ERROR. SQ2124.2 +033100 GO TO EXIT-PARA. SQ2124.2 +033200 PASS1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2124.2 +033300 FAIL1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2124.2 +033400 PRINT-DETAIL1. SQ2124.2 +033500 IF REC-CT NOT EQUAL TO ZERO SQ2124.2 +033600 MOVE "." TO PARDOT-X SQ2124.2 +033700 MOVE REC-CT TO DOTVALUE. SQ2124.2 +033800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE1. SQ2124.2 +033900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE1 SQ2124.2 +034000 PERFORM FAIL-ROUTINE1 THRU FAIL-ROUTINE-EX1 SQ2124.2 +034100 ELSE PERFORM BAIL-OUT1 THRU BAIL-OUT-EX1. SQ2124.2 +034200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2124.2 +034300 MOVE SPACE TO CORRECT-X. SQ2124.2 +034400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2124.2 +034500 MOVE SPACE TO RE-MARK. SQ2124.2 +034600 END-ROUTINE1. SQ2124.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2124.2 +034800 PERFORM WRITE-LINE1 5 TIMES. SQ2124.2 +034900 END-RTN1-EXIT. SQ2124.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE1 2 TIMES. SQ2124.2 +035100 END-ROUTINE1-1. SQ2124.2 +035200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2124.2 +035300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2124.2 +035400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2124.2 +035500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE1-12. SQ2124.2 +035600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2124.2 +035700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2124.2 +035800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2124.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE1. SQ2124.2 +036000 END-ROUTINE1-12. SQ2124.2 +036100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2124.2 +036200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2124.2 +036300 MOVE "NO " TO ERROR-TOTAL SQ2124.2 +036400 ELSE SQ2124.2 +036500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2124.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2124.2 +036700 PERFORM WRITE-LINE1. SQ2124.2 +036800 END-ROUTINE1-13. SQ2124.2 +036900 IF DELETE-CNT IS EQUAL TO ZERO SQ2124.2 +037000 MOVE "NO " TO ERROR-TOTAL ELSE SQ2124.2 +037100 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2124.2 +037200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2124.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE1. SQ2124.2 +037400 IF INSPECT-COUNTER EQUAL TO ZERO SQ2124.2 +037500 MOVE "NO " TO ERROR-TOTAL SQ2124.2 +037600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2124.2 +037700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2124.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE1. SQ2124.2 +037900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE1. SQ2124.2 +038000 WRITE-LINE1. SQ2124.2 +038100 ADD 1 TO RECORD-COUNT. SQ2124.2 +038200 IF RECORD-COUNT GREATER 50 SQ2124.2 +038300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2124.2 +038400 MOVE SPACE TO DUMMY-RECORD SQ2124.2 +038500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2124.2 +038600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN1 SQ2124.2 +038700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN1 2 TIMES SQ2124.2 +038800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN1 SQ2124.2 +038900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2124.2 +039000 MOVE ZERO TO RECORD-COUNT. SQ2124.2 +039100 PERFORM WRT-LN1. SQ2124.2 +039200 WRT-LN1. SQ2124.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2124.2 +039400 MOVE SPACE TO DUMMY-RECORD. SQ2124.2 +039500 FAIL-ROUTINE1. SQ2124.2 +039600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE1. SQ2124.2 +039700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE1. SQ2124.2 +039800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2124.2 +039900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE1 2 TIMES. SQ2124.2 +040000 GO TO FAIL-ROUTINE-EX1. SQ2124.2 +040100 FAIL-ROUTINE-WRITE1. SQ2124.2 +040200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE1 SQ2124.2 +040300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE1 2 TIMES. SQ2124.2 +040400 FAIL-ROUTINE-EX1. EXIT. SQ2124.2 +040500 BAIL-OUT1. SQ2124.2 +040600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE1. SQ2124.2 +040700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX1. SQ2124.2 +040800 BAIL-OUT-WRITE1. SQ2124.2 +040900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2124.2 +041000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE1 2 TIMES. SQ2124.2 +041100 BAIL-OUT-EX1. EXIT. SQ2124.2 +041200 EXIT-PARA. SQ2124.2 +041300 EXIT. SQ2124.2 +041400 CLOSE-FILES1. SQ2124.2 +041500 PERFORM END-ROUTINE1 THRU END-ROUTINE1-13. CLOSE PRINT-FILE. SQ2124.2 +041600*P OPEN I-O RAW-DATA. SQ2124.2 +041700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2124.2 +041800*P READ RAW-DATA INVALID KEY GO TO END1-E-2. SQ2124.2 +041900*P MOVE "OK. " TO C-ABORT. SQ2124.2 +042000*P MOVE PASS-COUNTER TO C-OK. SQ2124.2 +042100*P MOVE ERROR-HOLD TO C-ALL. SQ2124.2 +042200*P MOVE ERROR-COUNTER TO C-FAIL. SQ2124.2 +042300*P MOVE DELETE-CNT TO C-DELETED. SQ2124.2 +042400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2124.2 +042500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END1-E-2. SQ2124.2 +042600*PND1-E-2. SQ2124.2 +042700*P CLOSE RAW-DATA. SQ2124.2 +042800 TERMINATE1-CCVS. SQ2124.2 +042900*S EXIT PROGRAM. SQ2124.2 +043000*SERMINATE1-CALL. SQ2124.2 +043100 STOP RUN. SQ2124.2 +043200 END DECLARATIVES. SQ2124.2 +043300 CCVS1 SECTION. SQ2124.2 +043400 OPEN-FILES. SQ2124.2 +043500*P OPEN I-O RAW-DATA. SQ2124.2 +043600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2124.2 +043700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2124.2 +043800*P MOVE "ABORTED " TO C-ABORT. SQ2124.2 +043900*P ADD 1 TO C-NO-OF-TESTS. SQ2124.2 +044000*P ACCEPT C-DATE FROM DATE. SQ2124.2 +044100*P ACCEPT C-TIME FROM TIME. SQ2124.2 +044200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2124.2 +044300*PND-E-1. SQ2124.2 +044400*P CLOSE RAW-DATA. SQ2124.2 +044500 OPEN OUTPUT PRINT-FILE. SQ2124.2 +044600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2124.2 +044700 MOVE SPACE TO TEST-RESULTS. SQ2124.2 +044800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2124.2 +044900 MOVE ZERO TO REC-SKL-SUB. SQ2124.2 +045000 CCVS-INIT-EXIT. SQ2124.2 +045100 GO TO CCVS1-EXIT. SQ2124.2 +045200 CLOSE-FILES. SQ2124.2 +045300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2124.2 +045400*P OPEN I-O RAW-DATA. SQ2124.2 +045500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2124.2 +045600*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2124.2 +045700*P MOVE "OK. " TO C-ABORT. SQ2124.2 +045800*P MOVE PASS-COUNTER TO C-OK. SQ2124.2 +045900*P MOVE ERROR-HOLD TO C-ALL. SQ2124.2 +046000*P MOVE ERROR-COUNTER TO C-FAIL. SQ2124.2 +046100*P MOVE DELETE-CNT TO C-DELETED. SQ2124.2 +046200*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2124.2 +046300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2124.2 +046400*PND-E-2. SQ2124.2 +046500*P CLOSE RAW-DATA. SQ2124.2 +046600 TERMINATE-CCVS. SQ2124.2 +046700*S EXIT PROGRAM. SQ2124.2 +046800*SERMINATE-CALL. SQ2124.2 +046900 STOP RUN. SQ2124.2 +047000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2124.2 +047100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2124.2 +047200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2124.2 +047300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2124.2 +047400 MOVE "****TEST DELETED****" TO RE-MARK. SQ2124.2 +047500 PRINT-DETAIL. SQ2124.2 +047600 IF REC-CT NOT EQUAL TO ZERO SQ2124.2 +047700 MOVE "." TO PARDOT-X SQ2124.2 +047800 MOVE REC-CT TO DOTVALUE. SQ2124.2 +047900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2124.2 +048000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2124.2 +048100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2124.2 +048200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2124.2 +048300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2124.2 +048400 MOVE SPACE TO CORRECT-X. SQ2124.2 +048500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2124.2 +048600 MOVE SPACE TO RE-MARK. SQ2124.2 +048700 HEAD-ROUTINE. SQ2124.2 +048800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +048900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2124.2 +049000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2124.2 +049100 COLUMN-NAMES-ROUTINE. SQ2124.2 +049200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +049300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +049400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +049500 END-ROUTINE. SQ2124.2 +049600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2124.2 +049700 END-RTN-EXIT. SQ2124.2 +049800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +049900 END-ROUTINE-1. SQ2124.2 +050000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2124.2 +050100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2124.2 +050200 ADD PASS-COUNTER TO ERROR-HOLD. SQ2124.2 +050300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2124.2 +050400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2124.2 +050500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2124.2 +050600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2124.2 +050700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2124.2 +050800 END-ROUTINE-12. SQ2124.2 +050900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2124.2 +051000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2124.2 +051100 MOVE "NO " TO ERROR-TOTAL SQ2124.2 +051200 ELSE SQ2124.2 +051300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2124.2 +051400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2124.2 +051500 PERFORM WRITE-LINE. SQ2124.2 +051600 END-ROUTINE-13. SQ2124.2 +051700 IF DELETE-CNT IS EQUAL TO ZERO SQ2124.2 +051800 MOVE "NO " TO ERROR-TOTAL ELSE SQ2124.2 +051900 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2124.2 +052000 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2124.2 +052100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +052200 IF INSPECT-COUNTER EQUAL TO ZERO SQ2124.2 +052300 MOVE "NO " TO ERROR-TOTAL SQ2124.2 +052400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2124.2 +052500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2124.2 +052600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +052700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2124.2 +052800 WRITE-LINE. SQ2124.2 +052900 ADD 1 TO RECORD-COUNT. SQ2124.2 +053000 IF RECORD-COUNT GREATER 50 SQ2124.2 +053100 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2124.2 +053200 MOVE SPACE TO DUMMY-RECORD SQ2124.2 +053300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2124.2 +053400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2124.2 +053500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2124.2 +053600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2124.2 +053700 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2124.2 +053800 MOVE ZERO TO RECORD-COUNT. SQ2124.2 +053900 PERFORM WRT-LN. SQ2124.2 +054000 WRT-LN. SQ2124.2 +054100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2124.2 +054200 MOVE SPACE TO DUMMY-RECORD. SQ2124.2 +054300 BLANK-LINE-PRINT. SQ2124.2 +054400 PERFORM WRT-LN. SQ2124.2 +054500 FAIL-ROUTINE. SQ2124.2 +054600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2124.2 +054700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2124.2 +054800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2124.2 +054900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +055000 GO TO FAIL-ROUTINE-EX. SQ2124.2 +055100 FAIL-ROUTINE-WRITE. SQ2124.2 +055200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2124.2 +055300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +055400 FAIL-ROUTINE-EX. EXIT. SQ2124.2 +055500 BAIL-OUT. SQ2124.2 +055600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2124.2 +055700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2124.2 +055800 BAIL-OUT-WRITE. SQ2124.2 +055900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2124.2 +056000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2124.2 +056100 BAIL-OUT-EX. EXIT. SQ2124.2 +056200 CCVS1-EXIT. SQ2124.2 +056300 EXIT. SQ2124.2 +056400 SECT-SQ212A-0002 SECTION. SQ2124.2 +056500 WRITE-INIT-GF-01. SQ2124.2 +056600 MOVE ZERO TO COUNT-OF-RECS. SQ2124.2 +056700******************************************************************SQ2124.2 +056800* *SQ2124.2 +056900* ATTEMPT IS MADE TO WRITE 3 SHORTER RECORDS. *SQ2124.2 +057000* *SQ2124.2 +057100******************************************************************SQ2124.2 +057200 MOVE "3 SHORTER RECORDS" TO RE-MARK. SQ2124.2 +057300 MOVE 14 TO RECORD-LENGTH. SQ2124.2 +057400 MOVE 1 TO SWITCH-WRITE-REWRITE. SQ2124.2 +057500 OPEN OUTPUT SQ-VS7. SQ2124.2 +057600 MOVE "WRITE SHORTER RECORDS" TO FEATURE. SQ2124.2 +057700 PERFORM WRITE-RECORDS-1 3 TIMES. SQ2124.2 +057800 MOVE 0 TO COUNT-OF-RECS. SQ2124.2 +057900 WRITE-TEST-GF-01. SQ2124.2 +058000 PERFORM WRITE-RECORDS-1 1030 TIMES. SQ2124.2 +058100 PERFORM WRITE-RECORDS-2 1001 TIMES. SQ2124.2 +058200 WRITE-WRITE-GF-01. SQ2124.2 +058300 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2124.2 +058400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2124.2 +058500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2124.2 +058600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2124.2 +058700 MOVE "FILE CONTAINS 18 THRU 2048 CHAR RECS" TO RE-MARK. SQ2124.2 +058800 PERFORM PRINT-DETAIL. SQ2124.2 +058900* A SEQUENTIAL MASS STORAGE FILE CONTAINING 2031 SQ2124.2 +059000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2124.2 +059100* OF 18 THROUGH 2048 CHARACTERS BEGINNING WITH THE 18 CHAR RECSQ2124.2 +059200* AND ENDING WITH THE 2048 CHAR REC. SQ2124.2 +059300* SQ2124.2 +059400******************************************************************SQ2124.2 +059500* *SQ2124.2 +059600* RECORD NO. 2031 TO 2080 SHOULD NOT BE WRITTEN *SQ2124.2 +059700* *SQ2124.2 +059800******************************************************************SQ2124.2 +059900 TEST-STATUS-44. SQ2124.2 +060000 MOVE "9 LONGER RECORDS" TO RE-MARK. SQ2124.2 +060100 MOVE "WRITE LONGER RECORDS" TO FEATURE. SQ2124.2 +060200 PERFORM WRITE-RECORDS-1 9 TIMES. SQ2124.2 +060300 WRITE-CLOSE-GF-01. SQ2124.2 +060400 CLOSE SQ-VS7. SQ2124.2 +060500 GO TO READ-INIT-F1-01. SQ2124.2 +060600 WRITE-RECORDS-1. SQ2124.2 +060700******************************************************************SQ2124.2 +060800* MOVE ... TO OUTPUT-RECORD 1030 RECORDS *SQ2124.2 +060900* WRITE OUTPUT-RECORD. *SQ2124.2 +061000******************************************************************SQ2124.2 +061100 ADD 1 TO COUNT-OF-RECS. SQ2124.2 +061200 ADD 1 TO RECORD-LENGTH. SQ2124.2 +061300 MOVE COUNT-OF-RECS TO RECORD-NUMBER. SQ2124.2 +061400 MOVE VAR-RECORD-18-2048 TO SQ-VS7R1-FIRST. SQ2124.2 +061500 MOVE SPACE TO SQ-VS7-STATUS. SQ2124.2 +061600 WRITE SQ-VSR7R1-M-G-2048. SQ2124.2 +061700 WRITE-RECORDS-2. SQ2124.2 +061800******************************************************************SQ2124.2 +061900*WRITE ... FROM .... . 1000 RECORDS *SQ2124.2 +062000******************************************************************SQ2124.2 +062100 ADD 1 TO COUNT-OF-RECS. SQ2124.2 +062200 ADD 1 TO RECORD-LENGTH. SQ2124.2 +062300 MOVE COUNT-OF-RECS TO RECORD-NUMBER. SQ2124.2 +062400 WRITE SQ-VSR7R1-M-G-2048 FROM VAR-RECORD-18-2048. SQ2124.2 +062500 READ-INIT-F1-01. SQ2124.2 +062600 MOVE 17 TO RECORD-LENGTH. SQ2124.2 +062700 MOVE ZERO TO COUNT-OF-RECS. SQ2124.2 +062800 MOVE ZERO TO EOF-FLAG. SQ2124.2 +062900 MOVE ZERO TO RECORDS-IN-ERROR. SQ2124.2 +063000 MOVE ZERO TO ERROR-FLAG. SQ2124.2 +063100 OPEN INPUT SQ-VS7. SQ2124.2 +063200 READ-TEST-F1-01. SQ2124.2 +063300 PERFORM READ-REC-1 THRU READ-REC-1-EXIT 1030 TIMES. SQ2124.2 +063400 IF EOF-FLAG EQUAL TO 1 SQ2124.2 +063500 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2124.2 +063600 GO TO READ-EOF-F1-03. SQ2124.2 +063700 IF ERROR-FLAG EQUAL TO 1 SQ2124.2 +063800 GO TO READ-FAIL-F1-01. SQ2124.2 +063900 READ-PASS-F1-01. SQ2124.2 +064000 PERFORM PASS. SQ2124.2 +064100 GO TO READ-WRITE-F1-01. SQ2124.2 +064200 READ-FAIL-F1-01. SQ2124.2 +064300 MOVE "VII-30 FORMAT 2" TO RE-MARK. SQ2124.2 +064400 PERFORM FAIL. SQ2124.2 +064500 READ-WRITE-F1-01. SQ2124.2 +064600 MOVE "READ 1030 RECORDS" TO FEATURE. SQ2124.2 +064700 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2124.2 +064800 PERFORM PRINT-DETAIL. SQ2124.2 +064900 GO TO READ-INIT-F1-02. SQ2124.2 +065000 READ-REC-1. SQ2124.2 +065100******************************************************************SQ2124.2 +065200* READ AT END ... *SQ2124.2 +065300******************************************************************SQ2124.2 +065400 IF EOF-FLAG EQUAL TO 1 SQ2124.2 +065500 GO TO READ-REC-1-EXIT. SQ2124.2 +065600 READ SQ-VS7 AT END SQ2124.2 +065700 MOVE 1 TO EOF-FLAG SQ2124.2 +065800 GO TO READ-REC-1-EXIT. SQ2124.2 +065900 ADD 1 TO COUNT-OF-RECS. SQ2124.2 +066000 MOVE SQ-VS7R1-FIRST TO VAR-RECORD-18-2048. SQ2124.2 +066100 ADD 17 TO COUNT-OF-RECS. SQ2124.2 +066200 IF RECORD-LENGTH NOT EQUAL TO COUNT-OF-RECS SQ2124.2 +066300 GO TO READ-REC-1-ERROR. SQ2124.2 +066400 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +066500 GO TO READ-REC-1-EXIT. SQ2124.2 +066600 READ-REC-1-ERROR. SQ2124.2 +066700 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +066800 ADD 1 TO RECORDS-IN-ERROR. SQ2124.2 +066900 MOVE 1 TO ERROR-FLAG. SQ2124.2 +067000 READ-REC-1-EXIT. SQ2124.2 +067100 EXIT. SQ2124.2 +067200 READ-REC-2. SQ2124.2 +067300******************************************************************SQ2124.2 +067400* READ INTO .... AT END *SQ2124.2 +067500******************************************************************SQ2124.2 +067600 READ SQ-VS7 INTO VAR-RECORD-18-2048 AT END SQ2124.2 +067700 MOVE 1 TO EOF-FLAG SQ2124.2 +067800 GO TO READ-REC-2-EXIT. SQ2124.2 +067900 ADD 1 TO COUNT-OF-RECS. SQ2124.2 +068000 ADD 17 TO COUNT-OF-RECS. SQ2124.2 +068100 IF RECORD-LENGTH NOT EQUAL TO COUNT-OF-RECS SQ2124.2 +068200 GO TO READ-REC-2-ERROR. SQ2124.2 +068300 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +068400 GO TO READ-REC-2-EXIT. SQ2124.2 +068500 READ-REC-2-ERROR. SQ2124.2 +068600 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +068700 MOVE 1 TO ERROR-FLAG. SQ2124.2 +068800 READ-REC-2-EXIT. SQ2124.2 +068900 EXIT. SQ2124.2 +069000 READ-INIT-F1-02. SQ2124.2 +069100 MOVE ZERO TO ERROR-FLAG. SQ2124.2 +069200 READ-TEST-F1-02. SQ2124.2 +069300 PERFORM READ-REC-2 THRU READ-REC-2-EXIT 1001 TIMES. SQ2124.2 +069400 IF EOF-FLAG EQUAL TO 1 SQ2124.2 +069500 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2124.2 +069600 GO TO READ-EOF-F1-03. SQ2124.2 +069700 IF ERROR-FLAG EQUAL TO 1 SQ2124.2 +069800 GO TO READ-FAIL-F1-02. SQ2124.2 +069900 READ-PASS-F1-02. SQ2124.2 +070000 PERFORM PASS. SQ2124.2 +070100 GO TO READ-WRITE-F1-02. SQ2124.2 +070200 READ-FAIL-F1-02. SQ2124.2 +070300 MOVE "VII-30 FORMAT 2" TO RE-MARK. SQ2124.2 +070400 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2124.2 +070500 ADD 17 TO COUNT-OF-RECS. SQ2124.2 +070600 MOVE COUNT-OF-RECS TO CORRECT-N. SQ2124.2 +070700 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2124.2 +070800 PERFORM FAIL. SQ2124.2 +070900 READ-WRITE-F1-02. SQ2124.2 +071000 MOVE "READ 1001 RECORDS" TO FEATURE. SQ2124.2 +071100 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2124.2 +071200 PERFORM PRINT-DETAIL. SQ2124.2 +071300 READ-INIT-F1-03. SQ2124.2 +071400 READ SQ-VS7 RECORD END SQ2124.2 +071500 GO TO READ-TEST-F1-03. SQ2124.2 +071600 MOVE "MORE THAN 2031 RECORDS" TO RE-MARK. SQ2124.2 +071700 READ-EOF-F1-03. SQ2124.2 +071800 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2124.2 +071900 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2124.2 +072000 GO TO READ-FAIL-F1-03. SQ2124.2 +072100 READ-TEST-F1-03. SQ2124.2 +072200 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2124.2 +072300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2124.2 +072400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2124.2 +072500 GO TO READ-FAIL-F1-03. SQ2124.2 +072600 READ-PASS-F1-03. SQ2124.2 +072700 PERFORM PASS. SQ2124.2 +072800 GO TO READ-WRITE-F1-03. SQ2124.2 +072900 READ-FAIL-F1-03. SQ2124.2 +073000 MOVE "VII-30 FORMAT 2; TOO MUCH RECORDS" TO RE-MARK. SQ2124.2 +073100 PERFORM FAIL. SQ2124.2 +073200 READ-WRITE-F1-03. SQ2124.2 +073300 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2124.2 +073400 MOVE "AT END " TO FEATURE. SQ2124.2 +073500 PERFORM PRINT-DETAIL. SQ2124.2 +073600 READ-CLOSE-F1-03. SQ2124.2 +073700 CLOSE SQ-VS7. SQ2124.2 +073800 REWRITE-44-1. SQ2124.2 +073900 OPEN I-O SQ-VS7. SQ2124.2 +074000******************************************************************SQ2124.2 +074100* *SQ2124.2 +074200* READ 1ST RECORD; REWRITE SMALLER RECORD. *SQ2124.2 +074300* *SQ2124.2 +074400******************************************************************SQ2124.2 +074500 READ SQ-VS7 SQ2124.2 +074600 MOVE 15 TO RECORD-LENGTH. SQ2124.2 +074700 MOVE 2 TO SWITCH-WRITE-REWRITE. SQ2124.2 +074800 MOVE "REWRITE-44-1" TO PAR-NAME. SQ2124.2 +074900 MOVE "RWRT SMALLER RECORD" TO FEATURE. SQ2124.2 +075000 REWRITE SQ-VSR7R1-M-G-2048. SQ2124.2 +075100 REWRITE-44-2. SQ2124.2 +075200******************************************************************SQ2124.2 +075300* *SQ2124.2 +075400* READ 2ND RECORD; REWRITE LARGER RECORD. *SQ2124.2 +075500* *SQ2124.2 +075600******************************************************************SQ2124.2 +075700 READ SQ-VS7. SQ2124.2 +075800 MOVE 2500 TO RECORD-LENGTH. SQ2124.2 +075900 MOVE "REWRITE-44-2" TO PAR-NAME. SQ2124.2 +076000 MOVE "RWRT LARGER RECORD" TO FEATURE. SQ2124.2 +076100 REWRITE SQ-VSR7R1-M-G-2048. SQ2124.2 +076200 CLOSE SQ-VS7. SQ2124.2 +076300 TERMINATE-ROUTINE. SQ2124.2 +076400 EXIT. SQ2124.2 +076500 CCVS-EXIT SECTION. SQ2124.2 +076600 CCVS-999999. SQ2124.2 +076700 GO TO CLOSE-FILES. SQ2124.2 diff --git a/tests/cobol85/SQ/SQ213A.CBL b/tests/cobol85/SQ/SQ213A.CBL new file mode 100755 index 00000000..918bae60 --- /dev/null +++ b/tests/cobol85/SQ/SQ213A.CBL @@ -0,0 +1,640 @@ +000100 IDENTIFICATION DIVISION. SQ2134.2 +000200 PROGRAM-ID. SQ2134.2 +000300 SQ213A. SQ2134.2 +000400**************************************************************** SQ2134.2 +000500* * SQ2134.2 +000600* VALIDATION FOR:- * SQ2134.2 +000700* " HIGH ". SQ2134.2 +000800* * SQ2134.2 +000900* CREATION DATE / VALIDATION DATE * SQ2134.2 +001000* "4.2 ". SQ2134.2 +001100* * SQ2134.2 +001200* THE ROUTINE SQ213A TESTS THE USE OF THE USE AFTER ERROR SQ2134.2 +001300* PROCEDURE FOR EXTEND AND FILE-NAME SERIES. SQ213A IS SQ2134.2 +001400* BASICALLY A REWRITE OF SQ205 WITH THE ADDITION OF THE USE SQ2134.2 +001500* PROCEDURES. MAGNETIC TAPE FILE SQ-FS1 IS FIRST CREATED WITH SQ2134.2 +001600* 750 RECORDS. THEN IT IS REOPENED WITH EXTEND AND AN SQ2134.2 +001700* ADDITIONAL 250 RECORDS ARE WRITTEN. FINALLY IT IS READ AND SQ2134.2 +001800* VALIDATED FOR CORRECTNESS. MASS-STORAGE FILE SQ-FS2 IS SQ2134.2 +001900* CREATED AS A SINGLE OUTPUT FILE WITH 1000 RECORDS, AFTERWHICHSQ2134.2 +002000* IT IS READ AND VALIDATED FOR CORRECTNESS. THE TEST FOR THE SQ2134.2 +002100* USE PROCEDURE MERELY INDICATES WHETHER OR NOT THE USE SQ2134.2 +002200* PROCEDURES WERE REFERENCED. SQ2134.2 +002300 ENVIRONMENT DIVISION. SQ2134.2 +002400 CONFIGURATION SECTION. SQ2134.2 +002500 SOURCE-COMPUTER. SQ2134.2 +002600 Linux. SQ2134.2 +002700 OBJECT-COMPUTER. SQ2134.2 +002800 Linux. SQ2134.2 +002900 INPUT-OUTPUT SECTION. SQ2134.2 +003000 FILE-CONTROL. SQ2134.2 +003100*P SELECT RAW-DATA ASSIGN TO SQ2134.2 +003200*P "XXXXX062" SQ2134.2 +003300*P ORGANIZATION IS INDEXED SQ2134.2 +003400*P ACCESS MODE IS RANDOM SQ2134.2 +003500*P RECORD KEY IS RAW-DATA-KEY. SQ2134.2 +003600 SELECT PRINT-FILE ASSIGN TO SQ2134.2 +003700 "report.log". SQ2134.2 +003800 SELECT SQ-FS1 ASSIGN TO SQ2134.2 +003900 "XXXXX001" SQ2134.2 +004000 ORGANIZATION IS SEQUENTIAL SQ2134.2 +004100 ACCESS MODE IS SEQUENTIAL. SQ2134.2 +004200 SELECT SQ-FS2 ASSIGN TO SQ2134.2 +004300 "XXXXX014" SQ2134.2 +004400 ORGANIZATION IS SEQUENTIAL SQ2134.2 +004500 ACCESS MODE IS SEQUENTIAL. SQ2134.2 +004600 DATA DIVISION. SQ2134.2 +004700 FILE SECTION. SQ2134.2 +004800*P SQ2134.2 +004900*PD RAW-DATA. SQ2134.2 +005000*P SQ2134.2 +005100*P1 RAW-DATA-SATZ. SQ2134.2 +005200*P 05 RAW-DATA-KEY PIC X(6). SQ2134.2 +005300*P 05 C-DATE PIC 9(6). SQ2134.2 +005400*P 05 C-TIME PIC 9(8). SQ2134.2 +005500*P 05 C-NO-OF-TESTS PIC 99. SQ2134.2 +005600*P 05 C-OK PIC 999. SQ2134.2 +005700*P 05 C-ALL PIC 999. SQ2134.2 +005800*P 05 C-FAIL PIC 999. SQ2134.2 +005900*P 05 C-DELETED PIC 999. SQ2134.2 +006000*P 05 C-INSPECT PIC 999. SQ2134.2 +006100*P 05 C-NOTE PIC X(13). SQ2134.2 +006200*P 05 C-INDENT PIC X. SQ2134.2 +006300*P 05 C-ABORT PIC X(8). SQ2134.2 +006400 FD PRINT-FILE SQ2134.2 +006500*C LABEL RECORDS SQ2134.2 +006600*C OMITTED SQ2134.2 +006700*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2134.2 +006800 . SQ2134.2 +006900 01 PRINT-REC PICTURE X(120). SQ2134.2 +007000 01 DUMMY-RECORD PICTURE X(120). SQ2134.2 +007100 FD SQ-FS1 SQ2134.2 +007200*C LABEL RECORDS ARE STANDARD SQ2134.2 +007300 RECORD CONTAINS 126 CHARACTERS SQ2134.2 +007400 BLOCK CONTAINS 126 CHARACTERS. SQ2134.2 +007500 01 SQ-FS1R1-F-G-126. SQ2134.2 +007600 02 SQ-FS1R1-F-G-120 PIC X(120). SQ2134.2 +007700 02 SQ-FS1R1-F-G-006 PIC X(6). SQ2134.2 +007800 FD SQ-FS2 SQ2134.2 +007900*C LABEL RECORDS ARE STANDARD SQ2134.2 +008000 RECORD 126 SQ2134.2 +008100 BLOCK CONTAINS 126 CHARACTERS. SQ2134.2 +008200 01 SQ-FS2R1-F-G-126. SQ2134.2 +008300 02 SQ-FS2R1-F-G-120 PIC X(120). SQ2134.2 +008400 02 SQ-FS2R1-F-G-006 PIC X(6). SQ2134.2 +008500 WORKING-STORAGE SECTION. SQ2134.2 +008600 77 RECORDS-IN-ERROR PIC 9(4) VALUE 0. SQ2134.2 +008700 77 WRK-RECORD-COUNT PIC 9(4) VALUE 0. SQ2134.2 +008800 01 COUNT-OF-RECS PIC 9999. SQ2134.2 +008900 01 EXTEND-ERROR PIC 9999 VALUE 0. SQ2134.2 +009000 01 FN-SERIES-ERROR PIC 9999 VALUE 0. SQ2134.2 +009100 01 FILE-RECORD-INFORMATION-REC. SQ2134.2 +009200 03 FILE-RECORD-INFO-SKELETON. SQ2134.2 +009300 05 FILLER PICTURE X(48) VALUE SQ2134.2 +009400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2134.2 +009500 05 FILLER PICTURE X(46) VALUE SQ2134.2 +009600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2134.2 +009700 05 FILLER PICTURE X(26) VALUE SQ2134.2 +009800 ",LFIL=000000,ORG= ,LBLR= ". SQ2134.2 +009900 05 FILLER PICTURE X(37) VALUE SQ2134.2 +010000 ",RECKEY= ". SQ2134.2 +010100 05 FILLER PICTURE X(38) VALUE SQ2134.2 +010200 ",ALTKEY1= ". SQ2134.2 +010300 05 FILLER PICTURE X(38) VALUE SQ2134.2 +010400 ",ALTKEY2= ". SQ2134.2 +010500 05 FILLER PICTURE X(7) VALUE SPACE.SQ2134.2 +010600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2134.2 +010700 05 FILE-RECORD-INFO-P1-120. SQ2134.2 +010800 07 FILLER PIC X(5). SQ2134.2 +010900 07 XFILE-NAME PIC X(6). SQ2134.2 +011000 07 FILLER PIC X(8). SQ2134.2 +011100 07 XRECORD-NAME PIC X(6). SQ2134.2 +011200 07 FILLER PIC X(1). SQ2134.2 +011300 07 REELUNIT-NUMBER PIC 9(1). SQ2134.2 +011400 07 FILLER PIC X(7). SQ2134.2 +011500 07 XRECORD-NUMBER PIC 9(6). SQ2134.2 +011600 07 FILLER PIC X(6). SQ2134.2 +011700 07 UPDATE-NUMBER PIC 9(2). SQ2134.2 +011800 07 FILLER PIC X(5). SQ2134.2 +011900 07 ODO-NUMBER PIC 9(4). SQ2134.2 +012000 07 FILLER PIC X(5). SQ2134.2 +012100 07 XPROGRAM-NAME PIC X(5). SQ2134.2 +012200 07 FILLER PIC X(7). SQ2134.2 +012300 07 XRECORD-LENGTH PIC 9(6). SQ2134.2 +012400 07 FILLER PIC X(7). SQ2134.2 +012500 07 CHARS-OR-RECORDS PIC X(2). SQ2134.2 +012600 07 FILLER PIC X(1). SQ2134.2 +012700 07 XBLOCK-SIZE PIC 9(4). SQ2134.2 +012800 07 FILLER PIC X(6). SQ2134.2 +012900 07 RECORDS-IN-FILE PIC 9(6). SQ2134.2 +013000 07 FILLER PIC X(5). SQ2134.2 +013100 07 XFILE-ORGANIZATION PIC X(2). SQ2134.2 +013200 07 FILLER PIC X(6). SQ2134.2 +013300 07 XLABEL-TYPE PIC X(1). SQ2134.2 +013400 05 FILE-RECORD-INFO-P121-240. SQ2134.2 +013500 07 FILLER PIC X(8). SQ2134.2 +013600 07 XRECORD-KEY PIC X(29). SQ2134.2 +013700 07 FILLER PIC X(9). SQ2134.2 +013800 07 ALTERNATE-KEY1 PIC X(29). SQ2134.2 +013900 07 FILLER PIC X(9). SQ2134.2 +014000 07 ALTERNATE-KEY2 PIC X(29). SQ2134.2 +014100 07 FILLER PIC X(7). SQ2134.2 +014200 01 TEST-RESULTS. SQ2134.2 +014300 02 FILLER PICTURE X VALUE SPACE. SQ2134.2 +014400 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2134.2 +014500 02 FILLER PICTURE X VALUE SPACE. SQ2134.2 +014600 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2134.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2134.2 +014800 02 PAR-NAME. SQ2134.2 +014900 03 FILLER PICTURE X(12) VALUE SPACE. SQ2134.2 +015000 03 PARDOT-X PICTURE X VALUE SPACE. SQ2134.2 +015100 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2134.2 +015200 03 FILLER PIC X(5) VALUE SPACE. SQ2134.2 +015300 02 FILLER PIC X(10) VALUE SPACE. SQ2134.2 +015400 02 RE-MARK PIC X(61). SQ2134.2 +015500 01 TEST-COMPUTED. SQ2134.2 +015600 02 FILLER PIC X(30) VALUE SPACE. SQ2134.2 +015700 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2134.2 +015800 02 COMPUTED-X. SQ2134.2 +015900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2134.2 +016000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2134.2 +016100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2134.2 +016200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2134.2 +016300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2134.2 +016400 03 CM-18V0 REDEFINES COMPUTED-A. SQ2134.2 +016500 04 COMPUTED-18V0 PICTURE -9(18). SQ2134.2 +016600 04 FILLER PICTURE X. SQ2134.2 +016700 03 FILLER PIC X(50) VALUE SPACE. SQ2134.2 +016800 01 TEST-CORRECT. SQ2134.2 +016900 02 FILLER PIC X(30) VALUE SPACE. SQ2134.2 +017000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2134.2 +017100 02 CORRECT-X. SQ2134.2 +017200 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2134.2 +017300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2134.2 +017400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2134.2 +017500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2134.2 +017600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2134.2 +017700 03 CR-18V0 REDEFINES CORRECT-A. SQ2134.2 +017800 04 CORRECT-18V0 PICTURE -9(18). SQ2134.2 +017900 04 FILLER PICTURE X. SQ2134.2 +018000 03 FILLER PIC X(50) VALUE SPACE. SQ2134.2 +018100 01 CCVS-C-1. SQ2134.2 +018200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2134.2 +018300- "SS PARAGRAPH-NAME SQ2134.2 +018400- " REMARKS". SQ2134.2 +018500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2134.2 +018600 01 CCVS-C-2. SQ2134.2 +018700 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2134.2 +018800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2134.2 +018900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2134.2 +019000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2134.2 +019100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2134.2 +019200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2134.2 +019300 01 REC-CT PICTURE 99 VALUE ZERO. SQ2134.2 +019400 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2134.2 +019500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2134.2 +019600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2134.2 +019700 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2134.2 +019800 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2134.2 +019900 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2134.2 +020000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2134.2 +020100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2134.2 +020200 01 CCVS-H-1. SQ2134.2 +020300 02 FILLER PICTURE X(27) VALUE SPACE. SQ2134.2 +020400 02 FILLER PICTURE X(67) VALUE SQ2134.2 +020500 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2134.2 +020600- " SYSTEM". SQ2134.2 +020700 02 FILLER PICTURE X(26) VALUE SPACE. SQ2134.2 +020800 01 CCVS-H-2. SQ2134.2 +020900 02 FILLER PICTURE X(52) VALUE IS SQ2134.2 +021000 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2134.2 +021100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2134.2 +021200 02 TEST-ID PICTURE IS X(9). SQ2134.2 +021300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2134.2 +021400 01 CCVS-H-3. SQ2134.2 +021500 02 FILLER PICTURE X(34) VALUE SQ2134.2 +021600 " FOR OFFICIAL USE ONLY ". SQ2134.2 +021700 02 FILLER PICTURE X(58) VALUE SQ2134.2 +021800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2134.2 +021900 02 FILLER PICTURE X(28) VALUE SQ2134.2 +022000 " COPYRIGHT 1985 ". SQ2134.2 +022100 01 CCVS-E-1. SQ2134.2 +022200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2134.2 +022300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2134.2 +022400 02 ID-AGAIN PICTURE IS X(9). SQ2134.2 +022500 02 FILLER PICTURE X(45) VALUE IS SQ2134.2 +022600 " NTIS DISTRIBUTION COBOL 85". SQ2134.2 +022700 01 CCVS-E-2. SQ2134.2 +022800 02 FILLER PICTURE X(31) VALUE SQ2134.2 +022900 SPACE. SQ2134.2 +023000 02 FILLER PICTURE X(21) VALUE SPACE. SQ2134.2 +023100 02 CCVS-E-2-2. SQ2134.2 +023200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2134.2 +023300 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2134.2 +023400 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2134.2 +023500 01 CCVS-E-3. SQ2134.2 +023600 02 FILLER PICTURE X(22) VALUE SQ2134.2 +023700 " FOR OFFICIAL USE ONLY". SQ2134.2 +023800 02 FILLER PICTURE X(12) VALUE SPACE. SQ2134.2 +023900 02 FILLER PICTURE X(58) VALUE SQ2134.2 +024000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2134.2 +024100 02 FILLER PICTURE X(13) VALUE SPACE. SQ2134.2 +024200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2134.2 +024300 01 CCVS-E-4. SQ2134.2 +024400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2134.2 +024500 02 FILLER PIC XXXX VALUE " OF ". SQ2134.2 +024600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2134.2 +024700 02 FILLER PIC X(40) VALUE SQ2134.2 +024800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2134.2 +024900 01 XXINFO. SQ2134.2 +025000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2134.2 +025100 02 INFO-TEXT. SQ2134.2 +025200 04 FILLER PIC X(20) VALUE SPACE. SQ2134.2 +025300 04 XXCOMPUTED PIC X(20). SQ2134.2 +025400 04 FILLER PIC X(5) VALUE SPACE. SQ2134.2 +025500 04 XXCORRECT PIC X(20). SQ2134.2 +025600 01 HYPHEN-LINE. SQ2134.2 +025700 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2134.2 +025800 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2134.2 +025900- "*****************************************". SQ2134.2 +026000 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2134.2 +026100- "******************************". SQ2134.2 +026200 01 CCVS-PGM-ID PIC X(6) VALUE SQ2134.2 +026300 "SQ213A". SQ2134.2 +026400 PROCEDURE DIVISION. SQ2134.2 +026500 DECLARATIVES. SQ2134.2 +026600 SECT-SQ213A-0001 SECTION. SQ2134.2 +026700 USE AFTER ERROR PROCEDURE EXTEND. SQ2134.2 +026800 EXTEND-ERROR-PROCESS. SQ2134.2 +026900 MOVE 1 TO EXTEND-ERROR. SQ2134.2 +027000 SECT-SQ213A-0002 SECTION. SQ2134.2 +027100 USE AFTER EXCEPTION PROCEDURE ON SQ-FS2, PRINT-FILE. SQ2134.2 +027200 FN-SERIES-ERROR-PROCESS. SQ2134.2 +027300 MOVE 1 TO FN-SERIES-ERROR. SQ2134.2 +027400 END DECLARATIVES. SQ2134.2 +027500 CCVS1 SECTION. SQ2134.2 +027600 OPEN-FILES. SQ2134.2 +027700*P OPEN I-O RAW-DATA. SQ2134.2 +027800*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2134.2 +027900*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2134.2 +028000*P MOVE "ABORTED " TO C-ABORT. SQ2134.2 +028100*P ADD 1 TO C-NO-OF-TESTS. SQ2134.2 +028200*P ACCEPT C-DATE FROM DATE. SQ2134.2 +028300*P ACCEPT C-TIME FROM TIME. SQ2134.2 +028400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2134.2 +028500*PND-E-1. SQ2134.2 +028600*P CLOSE RAW-DATA. SQ2134.2 +028700 OPEN OUTPUT PRINT-FILE. SQ2134.2 +028800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2134.2 +028900 MOVE SPACE TO TEST-RESULTS. SQ2134.2 +029000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2134.2 +029100 MOVE ZERO TO REC-SKL-SUB. SQ2134.2 +029200 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2134.2 +029300 CCVS-INIT-FILE. SQ2134.2 +029400 ADD 1 TO REC-SKL-SUB. SQ2134.2 +029500 MOVE FILE-RECORD-INFO-SKELETON TO SQ2134.2 +029600 FILE-RECORD-INFO (REC-SKL-SUB). SQ2134.2 +029700 CCVS-INIT-EXIT. SQ2134.2 +029800 GO TO CCVS1-EXIT. SQ2134.2 +029900 CLOSE-FILES. SQ2134.2 +030000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2134.2 +030100*P OPEN I-O RAW-DATA. SQ2134.2 +030200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2134.2 +030300*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2134.2 +030400*P MOVE "OK. " TO C-ABORT. SQ2134.2 +030500*P MOVE PASS-COUNTER TO C-OK. SQ2134.2 +030600*P MOVE ERROR-HOLD TO C-ALL. SQ2134.2 +030700*P MOVE ERROR-COUNTER TO C-FAIL. SQ2134.2 +030800*P MOVE DELETE-CNT TO C-DELETED. SQ2134.2 +030900*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2134.2 +031000*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2134.2 +031100*PND-E-2. SQ2134.2 +031200*P CLOSE RAW-DATA. SQ2134.2 +031300 TERMINATE-CCVS. SQ2134.2 +031400*S EXIT PROGRAM. SQ2134.2 +031500*SERMINATE-CALL. SQ2134.2 +031600 STOP RUN. SQ2134.2 +031700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2134.2 +031800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2134.2 +031900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2134.2 +032000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2134.2 +032100 MOVE "****TEST DELETED****" TO RE-MARK. SQ2134.2 +032200 PRINT-DETAIL. SQ2134.2 +032300 IF REC-CT NOT EQUAL TO ZERO SQ2134.2 +032400 MOVE "." TO PARDOT-X SQ2134.2 +032500 MOVE REC-CT TO DOTVALUE. SQ2134.2 +032600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2134.2 +032700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2134.2 +032800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2134.2 +032900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2134.2 +033000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2134.2 +033100 MOVE SPACE TO CORRECT-X. SQ2134.2 +033200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2134.2 +033300 MOVE SPACE TO RE-MARK. SQ2134.2 +033400 HEAD-ROUTINE. SQ2134.2 +033500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +033600 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2134.2 +033700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2134.2 +033800 COLUMN-NAMES-ROUTINE. SQ2134.2 +033900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +034000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +034200 END-ROUTINE. SQ2134.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2134.2 +034400 END-RTN-EXIT. SQ2134.2 +034500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +034600 END-ROUTINE-1. SQ2134.2 +034700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2134.2 +034800 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2134.2 +034900 ADD PASS-COUNTER TO ERROR-HOLD. SQ2134.2 +035000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2134.2 +035100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2134.2 +035200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2134.2 +035300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2134.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2134.2 +035500 END-ROUTINE-12. SQ2134.2 +035600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2134.2 +035700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2134.2 +035800 MOVE "NO " TO ERROR-TOTAL SQ2134.2 +035900 ELSE SQ2134.2 +036000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2134.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2134.2 +036200 PERFORM WRITE-LINE. SQ2134.2 +036300 END-ROUTINE-13. SQ2134.2 +036400 IF DELETE-CNT IS EQUAL TO ZERO SQ2134.2 +036500 MOVE "NO " TO ERROR-TOTAL ELSE SQ2134.2 +036600 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2134.2 +036700 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2134.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +036900 IF INSPECT-COUNTER EQUAL TO ZERO SQ2134.2 +037000 MOVE "NO " TO ERROR-TOTAL SQ2134.2 +037100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2134.2 +037200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2134.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +037400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2134.2 +037500 WRITE-LINE. SQ2134.2 +037600 ADD 1 TO RECORD-COUNT. SQ2134.2 +037700 IF RECORD-COUNT GREATER 50 SQ2134.2 +037800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2134.2 +037900 MOVE SPACE TO DUMMY-RECORD SQ2134.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2134.2 +038100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2134.2 +038200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2134.2 +038300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2134.2 +038400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2134.2 +038500 MOVE ZERO TO RECORD-COUNT. SQ2134.2 +038600 PERFORM WRT-LN. SQ2134.2 +038700 WRT-LN. SQ2134.2 +038800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2134.2 +038900 MOVE SPACE TO DUMMY-RECORD. SQ2134.2 +039000 BLANK-LINE-PRINT. SQ2134.2 +039100 PERFORM WRT-LN. SQ2134.2 +039200 FAIL-ROUTINE. SQ2134.2 +039300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2134.2 +039400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2134.2 +039500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2134.2 +039600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +039700 GO TO FAIL-ROUTINE-EX. SQ2134.2 +039800 FAIL-ROUTINE-WRITE. SQ2134.2 +039900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2134.2 +040000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +040100 FAIL-ROUTINE-EX. EXIT. SQ2134.2 +040200 BAIL-OUT. SQ2134.2 +040300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2134.2 +040400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2134.2 +040500 BAIL-OUT-WRITE. SQ2134.2 +040600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2134.2 +040700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2134.2 +040800 BAIL-OUT-EX. EXIT. SQ2134.2 +040900 CCVS1-EXIT. SQ2134.2 +041000 EXIT. SQ2134.2 +041100 SECT-SQ213A-0003 SECTION. SQ2134.2 +041200 OPEN-INIT-GF-01. SQ2134.2 +041300* THIS IS A TEST FOR OPEN EXTEND FOR MAGNETIC TAPE. SQ2134.2 +041400* A FILE OF 750 RECORDS IS CREATED THEN RE-OPENED SQ2134.2 +041500* WITH EXTEND. 250 RECORDS ARE ADDED TO THE FILE. SQ2134.2 +041600* THE FILE IS THEN READ AND VALIDATED. SQ2134.2 +041700 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2134.2 +041800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2134.2 +041900 MOVE "SQ213" TO XPROGRAM-NAME (1). SQ2134.2 +042000 MOVE 000126 TO XRECORD-LENGTH (1). SQ2134.2 +042100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2134.2 +042200 MOVE 0001 TO XBLOCK-SIZE (1). SQ2134.2 +042300 MOVE 001000 TO RECORDS-IN-FILE (1). SQ2134.2 +042400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2134.2 +042500 MOVE "S" TO XLABEL-TYPE (1). SQ2134.2 +042600 MOVE 000001 TO XRECORD-NUMBER (1). SQ2134.2 +042700 OPEN OUTPUT SQ-FS1. SQ2134.2 +042800 OPEN-TEST-01-01. SQ2134.2 +042900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2134.2 +043000 MOVE SPACES TO SQ-FS1R1-F-G-006. SQ2134.2 +043100 WRITE SQ-FS1R1-F-G-126. SQ2134.2 +043200 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2134.2 +043300 GO TO OPEN-TEST-01-02. SQ2134.2 +043400 ADD 1 TO XRECORD-NUMBER (1). SQ2134.2 +043500 GO TO OPEN-TEST-01-01. SQ2134.2 +043600 OPEN-TEST-01-02. SQ2134.2 +043700 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2134.2 +043800 MOVE "OPEN-TEST-GF-01-02" TO PAR-NAME. SQ2134.2 +043900 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2134.2 +044000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2134.2 +044100 PERFORM PASS. SQ2134.2 +044200 PERFORM PRINT-DETAIL. SQ2134.2 +044300 CLOSE SQ-FS1. SQ2134.2 +044400 OPEN-TEST-01-03. SQ2134.2 +044500 OPEN EXTEND SQ-FS1. SQ2134.2 +044600 ADD 1 TO XRECORD-NUMBER (1). SQ2134.2 +044700 OPEN-TEST-01-04. SQ2134.2 +044800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2134.2 +044900 MOVE "EXTEND" TO SQ-FS1R1-F-G-006. SQ2134.2 +045000 WRITE SQ-FS1R1-F-G-126. SQ2134.2 +045100 IF XRECORD-NUMBER (1) EQUAL 1000 SQ2134.2 +045200 GO TO OPEN-TEST-GF-01-05. SQ2134.2 +045300 ADD 1 TO XRECORD-NUMBER (1). SQ2134.2 +045400 GO TO OPEN-TEST-01-04. SQ2134.2 +045500 OPEN-TEST-GF-01-05. SQ2134.2 +045600 MOVE "OPEN O SQ-FS1 EXTEND" TO FEATURE. SQ2134.2 +045700 MOVE "OPEN-TEST-GF-01-03" TO PAR-NAME. SQ2134.2 +045800 MOVE "FILE EXTENDED RECS=" TO COMPUTED-A. SQ2134.2 +045900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2134.2 +046000 PERFORM PASS. SQ2134.2 +046100 PERFORM PRINT-DETAIL. SQ2134.2 +046200 CLOSE SQ-FS1. SQ2134.2 +046300 READ-TEST-F1-01. SQ2134.2 +046400 OPEN INPUT SQ-FS1. SQ2134.2 +046500 MOVE ZERO TO WRK-RECORD-COUNT. SQ2134.2 +046600 READ-TEST-F1-01-07. SQ2134.2 +046700 READ SQ-FS1 SQ2134.2 +046800 ; AT END MOVE "PREMATURE EOF" TO RE-MARK SQ2134.2 +046900 PERFORM FAIL SQ2134.2 +047000 GO TO READ-WRITE-F1-01. SQ2134.2 +047100 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2134.2 +047200 ADD 1 TO WRK-RECORD-COUNT. SQ2134.2 +047300 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2134.2 +047400 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +047500 GO TO READ-TEST-F1-01-08. SQ2134.2 +047600 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2134.2 +047700 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +047800 GO TO READ-TEST-F1-01-08. SQ2134.2 +047900 IF SQ-FS1R1-F-G-006 NOT EQUAL TO SPACES SQ2134.2 +048000 ADD 1 TO RECORDS-IN-ERROR. SQ2134.2 +048100 READ-TEST-F1-01-08. SQ2134.2 +048200 IF WRK-RECORD-COUNT NOT EQUAL TO 750 SQ2134.2 +048300 GO TO READ-TEST-F1-01-07. SQ2134.2 +048400 READ-TEST-F1-01-09. SQ2134.2 +048500 READ SQ-FS1 RECORD SQ2134.2 +048600 ; END GO TO READ-TEST-F1-01-10. SQ2134.2 +048700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2134.2 +048800 ADD 1 TO WRK-RECORD-COUNT. SQ2134.2 +048900 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2134.2 +049000 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +049100 GO TO READ-TEST-F1-01-09. SQ2134.2 +049200 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (1) SQ2134.2 +049300 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +049400 GO TO READ-TEST-F1-01-09. SQ2134.2 +049500 IF SQ-FS1R1-F-G-006 NOT EQUAL TO "EXTEND" SQ2134.2 +049600 ADD 1 TO RECORDS-IN-ERROR. SQ2134.2 +049700 GO TO READ-TEST-F1-01-09. SQ2134.2 +049800 READ-TEST-F1-01-10. SQ2134.2 +049900 IF RECORDS-IN-ERROR EQUAL ZERO SQ2134.2 +050000 GO TO READ-PASS-F1-01. SQ2134.2 +050100 GO TO READ-FAIL-F1-01. SQ2134.2 +050200 READ-DELETE-F1-01. SQ2134.2 +050300 PERFORM DE-LETE. SQ2134.2 +050400 GO TO READ-WRITE-F1-01. SQ2134.2 +050500 READ-FAIL-F1-01. SQ2134.2 +050600 MOVE "ERRORS IN READING SQ-FS1; VII-39; OPEN .. EXTEND" SQ2134.2 +050700 TO RE-MARK. SQ2134.2 +050800 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2134.2 +050900 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2134.2 +051000 PERFORM FAIL. SQ2134.2 +051100 GO TO READ-WRITE-F1-01. SQ2134.2 +051200 READ-PASS-F1-01. SQ2134.2 +051300 PERFORM PASS. SQ2134.2 +051400 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2134.2 +051500 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2134.2 +051600 READ-WRITE-F1-01. SQ2134.2 +051700 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2134.2 +051800 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2134.2 +051900 PERFORM PRINT-DETAIL. SQ2134.2 +052000 READ-CLOSE-F1-01. SQ2134.2 +052100 CLOSE SQ-FS1. SQ2134.2 +052200 WRITE-INIT-002. SQ2134.2 +052300* THIS TEST CREATES A MASS-STORAGE FILE OF 1000 RECORDS. SQ2134.2 +052400* THEN IT IS READ AND VALIDATED FOR CORRECTNESS. SQ2134.2 +052500 MOVE "SQ-FS2" TO XFILE-NAME (2). SQ2134.2 +052600 MOVE "R1-F-G" TO XRECORD-NAME (2). SQ2134.2 +052700 MOVE "SQ213" TO XPROGRAM-NAME (2). SQ2134.2 +052800 MOVE 000126 TO XRECORD-LENGTH (2). SQ2134.2 +052900 MOVE "RC" TO CHARS-OR-RECORDS (2). SQ2134.2 +053000 MOVE 0001 TO XBLOCK-SIZE (2). SQ2134.2 +053100 MOVE 001000 TO RECORDS-IN-FILE (2). SQ2134.2 +053200 MOVE "SQ" TO XFILE-ORGANIZATION (2). SQ2134.2 +053300 MOVE "S" TO XLABEL-TYPE (2). SQ2134.2 +053400 MOVE 000001 TO XRECORD-NUMBER (2). SQ2134.2 +053500 OPEN OUTPUT SQ-FS2. SQ2134.2 +053600 WRITE-TEST-GF-01-1. SQ2134.2 +053700 MOVE FILE-RECORD-INFO-P1-120 (2) TO SQ-FS2R1-F-G-120. SQ2134.2 +053800 MOVE SPACES TO SQ-FS2R1-F-G-006. SQ2134.2 +053900 WRITE SQ-FS2R1-F-G-126. SQ2134.2 +054000 IF XRECORD-NUMBER (2) EQUAL TO 1000 SQ2134.2 +054100 GO TO WRITE-TEST-GF-01-2. SQ2134.2 +054200 ADD 1 TO XRECORD-NUMBER (2). SQ2134.2 +054300 GO TO WRITE-TEST-GF-01-1. SQ2134.2 +054400 WRITE-TEST-GF-01-2. SQ2134.2 +054500 MOVE "CREATE FILE SQ-FS2" TO FEATURE. SQ2134.2 +054600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2134.2 +054700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2134.2 +054800 MOVE XRECORD-NUMBER (2) TO CORRECT-18V0. SQ2134.2 +054900 PERFORM PASS. PERFORM PRINT-DETAIL. SQ2134.2 +055000 CLOSE SQ-FS2. SQ2134.2 +055100 READ-INIT-F1-02. SQ2134.2 +055200 OPEN INPUT SQ-FS2. SQ2134.2 +055300 MOVE ZERO TO WRK-RECORD-COUNT. SQ2134.2 +055400 MOVE ZERO TO RECORDS-IN-ERROR. SQ2134.2 +055500 READ-TEST-F1-02-09. SQ2134.2 +055600 READ SQ-FS2 RECORD SQ2134.2 +055700 AT END GO TO READ-TEST-F1-02-10. SQ2134.2 +055800 MOVE SQ-FS2R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (2) SQ2134.2 +055900 ADD 1 TO WRK-RECORD-COUNT. SQ2134.2 +056000 IF XFILE-NAME (2) NOT EQUAL TO "SQ-FS2" SQ2134.2 +056100 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +056200 GO TO READ-TEST-F1-02-09. SQ2134.2 +056300 IF WRK-RECORD-COUNT NOT EQUAL TO XRECORD-NUMBER (2) SQ2134.2 +056400 ADD 1 TO RECORDS-IN-ERROR SQ2134.2 +056500 GO TO READ-TEST-F1-02-09. SQ2134.2 +056600 GO TO READ-TEST-F1-02-09. SQ2134.2 +056700 READ-TEST-F1-02-10. SQ2134.2 +056800 IF RECORDS-IN-ERROR EQUAL ZERO SQ2134.2 +056900 GO TO READ-PASS-F1-02. SQ2134.2 +057000 GO TO READ-FAIL-F1-02. SQ2134.2 +057100 READ-DELETE-F1-02. SQ2134.2 +057200 PERFORM DE-LETE. SQ2134.2 +057300 GO TO READ-WRITE-F1-02. SQ2134.2 +057400 READ-FAIL-F1-02. SQ2134.2 +057500 MOVE "ERRORS IN READING SQ-FS2; VII-39, -52, -44" TO RE-MARK.SQ2134.2 +057600 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2134.2 +057700 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2134.2 +057800 PERFORM FAIL. SQ2134.2 +057900 GO TO READ-WRITE-F1-02. SQ2134.2 +058000 READ-PASS-F1-02. SQ2134.2 +058100 PERFORM PASS. SQ2134.2 +058200 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2134.2 +058300 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2134.2 +058400 READ-WRITE-F1-02. SQ2134.2 +058500 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2134.2 +058600 MOVE "VERIFY FILE SQ-FS2" TO FEATURE. SQ2134.2 +058700 PERFORM PRINT-DETAIL. SQ2134.2 +058800 READ-CLOSE-F1-02. SQ2134.2 +058900 CLOSE SQ-FS2. SQ2134.2 +059000 USE-INIT-GF-01. SQ2134.2 +059100 MOVE "USE PROCEDURE TESTS" TO FEATURE. SQ2134.2 +059200 MOVE "USE-TEST-GF-01" TO PAR-NAME. SQ2134.2 +059300 USE-TEST-GF-01-01. SQ2134.2 +059400 IF EXTEND-ERROR EQUAL ZERO SQ2134.2 +059500 GO TO USE-PASS-GF-01. SQ2134.2 +059600 GO TO USE-FAIL-GF-01. SQ2134.2 +059700 USE-DELETE-GF-01. SQ2134.2 +059800 PERFORM DE-LETE. SQ2134.2 +059900 GO TO USE-WRITE-GF-01. SQ2134.2 +060000 USE-FAIL-GF-01. SQ2134.2 +060100 MOVE "VII-50 -51; UNEXSPECTED USE PERFORMED" TO RE-MARK. SQ2134.2 +060200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2134.2 +060300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2134.2 +060400 PERFORM FAIL. SQ2134.2 +060500 GO TO USE-WRITE-GF-01. SQ2134.2 +060600 USE-PASS-GF-01. SQ2134.2 +060700 PERFORM PASS. SQ2134.2 +060800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2134.2 +060900 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2134.2 +061000 USE-WRITE-GF-01. SQ2134.2 +061100 MOVE "USE-TEST-GF-01" TO PAR-NAME. SQ2134.2 +061200 PERFORM PRINT-DETAIL. SQ2134.2 +061300 USE-TEST-GF-02. SQ2134.2 +061400 IF FN-SERIES-ERROR EQUAL ZERO SQ2134.2 +061500 GO TO USE-PASS-GF-02. SQ2134.2 +061600 GO TO USE-FAIL-GF-02. SQ2134.2 +061700 USE-DELETE-GF-02. SQ2134.2 +061800 PERFORM DE-LETE. SQ2134.2 +061900 GO TO USE-WRITE-GF-02. SQ2134.2 +062000 USE-FAIL-GF-02. SQ2134.2 +062100 MOVE "VII-50 -51; UNEXSPECTED USE PERFORMED" TO RE-MARK. SQ2134.2 +062200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2134.2 +062300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2134.2 +062400 PERFORM FAIL. SQ2134.2 +062500 GO TO USE-WRITE-GF-02. SQ2134.2 +062600 USE-PASS-GF-02. SQ2134.2 +062700 PERFORM PASS. SQ2134.2 +062800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2134.2 +062900 MOVE WRK-RECORD-COUNT TO CORRECT-18V0. SQ2134.2 +063000 USE-WRITE-GF-02. SQ2134.2 +063100 MOVE "USE-TEST-GF-02" TO PAR-NAME. SQ2134.2 +063200 PERFORM PRINT-DETAIL. SQ2134.2 +063300 SQ213A-END-ROUTINE. SQ2134.2 +063400 MOVE "END OF SQ213A VALIDATION TESTS" TO PRINT-REC. SQ2134.2 +063500 WRITE PRINT-REC AFTER ADVANCING 1 LINE. SQ2134.2 +063600 TERMINATE-SQ213A. SQ2134.2 +063700 EXIT. SQ2134.2 +063800 CCVS-EXIT SECTION. SQ2134.2 +063900 CCVS-999999. SQ2134.2 +064000 GO TO CLOSE-FILES. SQ2134.2 diff --git a/tests/cobol85/SQ/SQ214A.CBL b/tests/cobol85/SQ/SQ214A.CBL new file mode 100755 index 00000000..a66cb8c1 --- /dev/null +++ b/tests/cobol85/SQ/SQ214A.CBL @@ -0,0 +1,570 @@ +000100 IDENTIFICATION DIVISION. SQ2144.2 +000200 PROGRAM-ID. SQ2144.2 +000300 SQ214A. SQ2144.2 +000400**************************************************************** SQ2144.2 +000500* * SQ2144.2 +000600* VALIDATION FOR:- * SQ2144.2 +000700* " HIGH ". SQ2144.2 +000800* * SQ2144.2 +000900* CREATION DATE / VALIDATION DATE * SQ2144.2 +001000* "4.2 ". SQ2144.2 +001100* * SQ2144.2 +001200* SQ2144.2 +001300* SQ2144.2 +001400* SQ214A TESTS OPERATIONS INVOLVING FORMAT 2 OCCURS CLAUSES, SQ2144.2 +001500* I.E. ...OCCURS INTEGER-1 TO INTEGER-2 TIMES DEPENDING ON SQ2144.2 +001600* DATA-NAME-1 .... SQ2144.2 +001700* X3.23-1976, PAGE III-4, 2.1.4(3) STATES, IN PART, THAT SQ2144.2 +001800* INTEGER-2 REPRESENTS THE MAXIMUM NUMBER OF OCCURRENCES AND SQ2144.2 +001900* THAT ONLY THE NUMBER OF OCCURRENCES, AND NOT THE ITEM LENGTH,SQ2144.2 +002000* IS VARIABLE. WHENEVER THE PARENT GROUP ITEM IS REFERENCED, SQ2144.2 +002100* ONLY THE PORTION OF THE TABLE SPECIFIED BY THE CURRENT VALUE SQ2144.2 +002200* OF DATA-NAME-1 WILL BE USED IN THE OPERATION. SQ2144.2 +002300* SQ2144.2 +002400* THE FOLLOWING VERBS ARE EXERCIZED, SQ2144.2 +002500* READ SQ2144.2 +002600* WRITE SQ2144.2 +002700* SQ2144.2 +002800* SQ2144.2 +002900 ENVIRONMENT DIVISION. SQ2144.2 +003000 CONFIGURATION SECTION. SQ2144.2 +003100 SOURCE-COMPUTER. SQ2144.2 +003200 Linux. SQ2144.2 +003300 OBJECT-COMPUTER. SQ2144.2 +003400 Linux. SQ2144.2 +003500 INPUT-OUTPUT SECTION. SQ2144.2 +003600 FILE-CONTROL. SQ2144.2 +003700*P SELECT RAW-DATA ASSIGN TO SQ2144.2 +003800*P "XXXXX062" SQ2144.2 +003900*P ORGANIZATION IS INDEXED SQ2144.2 +004000*P ACCESS MODE IS RANDOM SQ2144.2 +004100*P RECORD KEY IS RAW-DATA-KEY. SQ2144.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2144.2 +004300 "report.log". SQ2144.2 +004400 SELECT SQ-FS1 ASSIGN TO SQ2144.2 +004500 "XXXXX014". SQ2144.2 +004600 DATA DIVISION. SQ2144.2 +004700 FILE SECTION. SQ2144.2 +004800*P SQ2144.2 +004900*PD RAW-DATA. SQ2144.2 +005000*P SQ2144.2 +005100*P1 RAW-DATA-SATZ. SQ2144.2 +005200*P 05 RAW-DATA-KEY PIC X(6). SQ2144.2 +005300*P 05 C-DATE PIC 9(6). SQ2144.2 +005400*P 05 C-TIME PIC 9(8). SQ2144.2 +005500*P 05 C-NO-OF-TESTS PIC 99. SQ2144.2 +005600*P 05 C-OK PIC 999. SQ2144.2 +005700*P 05 C-ALL PIC 999. SQ2144.2 +005800*P 05 C-FAIL PIC 999. SQ2144.2 +005900*P 05 C-DELETED PIC 999. SQ2144.2 +006000*P 05 C-INSPECT PIC 999. SQ2144.2 +006100*P 05 C-NOTE PIC X(13). SQ2144.2 +006200*P 05 C-INDENT PIC X. SQ2144.2 +006300*P 05 C-ABORT PIC X(8). SQ2144.2 +006400 FD PRINT-FILE SQ2144.2 +006500*C LABEL RECORDS SQ2144.2 +006600*C OMITTED SQ2144.2 +006700*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2144.2 +006800 . SQ2144.2 +006900 01 PRINT-REC PICTURE X(120). SQ2144.2 +007000 01 DUMMY-RECORD PICTURE X(120). SQ2144.2 +007100 FD SQ-FS1 SQ2144.2 +007200*C LABEL RECORD IS STANDARD SQ2144.2 +007300 . SQ2144.2 +007400 01 SQ-FS1R1-F-G-140. SQ2144.2 +007500 02 FS1R1-XN-120 PIC X(120). SQ2144.2 +007600 02 FS1R1-XN-20. SQ2144.2 +007700 03 FS1R1-XN-13 PIC X(13). SQ2144.2 +007800 03 FS1R1-XN-6 PIC X(6). SQ2144.2 +007900 03 FILLER PIC X. SQ2144.2 +008000 WORKING-STORAGE SECTION. SQ2144.2 +008100 01 ODO-RECORD. SQ2144.2 +008200 02 FILLER PIC X(120). SQ2144.2 +008300 02 GRP-ODO. SQ2144.2 +008400 03 DOI-DU-01V00 PIC 9. SQ2144.2 +008500 03 ODO-XN-00009 PIC X(9). SQ2144.2 +008600 03 ODO-GRP-00009. SQ2144.2 +008700 04 ODO-XN-00001-O009D OCCURS 1 TO 9 TIMES DEPENDING ON SQ2144.2 +008800 DOI-DU-01V00 ASCENDING KEY ODO-XN-00001-O009D SQ2144.2 +008900 INDEXED BY ODO-IX PIC X. SQ2144.2 +009000 01 STATIC-VALUE. SQ2144.2 +009100 02 FILLER PIC 9 VALUE 9. SQ2144.2 +009200 02 FILLER PIC X(18) VALUE " ACTIVE: 123456789". SQ2144.2 +009300 01 WRK-GRP-00019. SQ2144.2 +009400 02 WRK-DU-01V00 PIC 9. SQ2144.2 +009500 02 WRK-XN-00009-1 PIC X(9). SQ2144.2 +009600 02 WRK-XN-00009-2 PIC X(9). SQ2144.2 +009700 01 WRK-GRP-00009. SQ2144.2 +009800 02 ODO-XN-00007 PIC X(7). SQ2144.2 +009900 02 ODO-XN-00002 PIC XX. SQ2144.2 +010000 01 WRK-GRP-00009A REDEFINES WRK-GRP-00009. SQ2144.2 +010100 02 ODO-XN-00005 PIC X(5). SQ2144.2 +010200 02 ODO-XN-00004 PIC X(4). SQ2144.2 +010300 01 WRK-DU-05V00 PIC 9(5). SQ2144.2 +010400 01 WRK-XN-00020 PIC X(20). SQ2144.2 +010500 01 WRK-XN-00010 PIC X(10). SQ2144.2 +010600 01 FILE-RECORD-INFORMATION-REC. SQ2144.2 +010700 03 FILE-RECORD-INFO-SKELETON. SQ2144.2 +010800 05 FILLER PICTURE X(48) VALUE SQ2144.2 +010900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2144.2 +011000 05 FILLER PICTURE X(46) VALUE SQ2144.2 +011100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2144.2 +011200 05 FILLER PICTURE X(26) VALUE SQ2144.2 +011300 ",LFIL=000000,ORG= ,LBLR= ". SQ2144.2 +011400 05 FILLER PICTURE X(37) VALUE SQ2144.2 +011500 ",RECKEY= ". SQ2144.2 +011600 05 FILLER PICTURE X(38) VALUE SQ2144.2 +011700 ",ALTKEY1= ". SQ2144.2 +011800 05 FILLER PICTURE X(38) VALUE SQ2144.2 +011900 ",ALTKEY2= ". SQ2144.2 +012000 05 FILLER PICTURE X(7) VALUE SPACE.SQ2144.2 +012100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2144.2 +012200 05 FILE-RECORD-INFO-P1-120. SQ2144.2 +012300 07 FILLER PIC X(5). SQ2144.2 +012400 07 XFILE-NAME PIC X(6). SQ2144.2 +012500 07 FILLER PIC X(8). SQ2144.2 +012600 07 XRECORD-NAME PIC X(6). SQ2144.2 +012700 07 FILLER PIC X(1). SQ2144.2 +012800 07 REELUNIT-NUMBER PIC 9(1). SQ2144.2 +012900 07 FILLER PIC X(7). SQ2144.2 +013000 07 XRECORD-NUMBER PIC 9(6). SQ2144.2 +013100 07 FILLER PIC X(6). SQ2144.2 +013200 07 UPDATE-NUMBER PIC 9(2). SQ2144.2 +013300 07 FILLER PIC X(5). SQ2144.2 +013400 07 ODO-NUMBER PIC 9(4). SQ2144.2 +013500 07 FILLER PIC X(5). SQ2144.2 +013600 07 XPROGRAM-NAME PIC X(5). SQ2144.2 +013700 07 FILLER PIC X(7). SQ2144.2 +013800 07 XRECORD-LENGTH PIC 9(6). SQ2144.2 +013900 07 FILLER PIC X(7). SQ2144.2 +014000 07 CHARS-OR-RECORDS PIC X(2). SQ2144.2 +014100 07 FILLER PIC X(1). SQ2144.2 +014200 07 XBLOCK-SIZE PIC 9(4). SQ2144.2 +014300 07 FILLER PIC X(6). SQ2144.2 +014400 07 RECORDS-IN-FILE PIC 9(6). SQ2144.2 +014500 07 FILLER PIC X(5). SQ2144.2 +014600 07 XFILE-ORGANIZATION PIC X(2). SQ2144.2 +014700 07 FILLER PIC X(6). SQ2144.2 +014800 07 XLABEL-TYPE PIC X(1). SQ2144.2 +014900 05 FILE-RECORD-INFO-P121-240. SQ2144.2 +015000 07 FILLER PIC X(8). SQ2144.2 +015100 07 XRECORD-KEY PIC X(29). SQ2144.2 +015200 07 FILLER PIC X(9). SQ2144.2 +015300 07 ALTERNATE-KEY1 PIC X(29). SQ2144.2 +015400 07 FILLER PIC X(9). SQ2144.2 +015500 07 ALTERNATE-KEY2 PIC X(29). SQ2144.2 +015600 07 FILLER PIC X(7). SQ2144.2 +015700 01 TEST-RESULTS. SQ2144.2 +015800 02 FILLER PICTURE X VALUE SPACE. SQ2144.2 +015900 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2144.2 +016000 02 FILLER PICTURE X VALUE SPACE. SQ2144.2 +016100 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2144.2 +016200 02 FILLER PICTURE X VALUE SPACE. SQ2144.2 +016300 02 PAR-NAME. SQ2144.2 +016400 03 FILLER PICTURE X(12) VALUE SPACE. SQ2144.2 +016500 03 PARDOT-X PICTURE X VALUE SPACE. SQ2144.2 +016600 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2144.2 +016700 03 FILLER PIC X(5) VALUE SPACE. SQ2144.2 +016800 02 FILLER PIC X(10) VALUE SPACE. SQ2144.2 +016900 02 RE-MARK PIC X(61). SQ2144.2 +017000 01 TEST-COMPUTED. SQ2144.2 +017100 02 FILLER PIC X(30) VALUE SPACE. SQ2144.2 +017200 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2144.2 +017300 02 COMPUTED-X. SQ2144.2 +017400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2144.2 +017500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2144.2 +017600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2144.2 +017700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2144.2 +017800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2144.2 +017900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2144.2 +018000 04 COMPUTED-18V0 PICTURE -9(18). SQ2144.2 +018100 04 FILLER PICTURE X. SQ2144.2 +018200 03 FILLER PIC X(50) VALUE SPACE. SQ2144.2 +018300 01 TEST-CORRECT. SQ2144.2 +018400 02 FILLER PIC X(30) VALUE SPACE. SQ2144.2 +018500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2144.2 +018600 02 CORRECT-X. SQ2144.2 +018700 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2144.2 +018800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2144.2 +018900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2144.2 +019000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2144.2 +019100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2144.2 +019200 03 CR-18V0 REDEFINES CORRECT-A. SQ2144.2 +019300 04 CORRECT-18V0 PICTURE -9(18). SQ2144.2 +019400 04 FILLER PICTURE X. SQ2144.2 +019500 03 FILLER PIC X(50) VALUE SPACE. SQ2144.2 +019600 01 CCVS-C-1. SQ2144.2 +019700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2144.2 +019800- "SS PARAGRAPH-NAME SQ2144.2 +019900- " REMARKS". SQ2144.2 +020000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2144.2 +020100 01 CCVS-C-2. SQ2144.2 +020200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2144.2 +020300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2144.2 +020400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2144.2 +020500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2144.2 +020600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2144.2 +020700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2144.2 +020800 01 REC-CT PICTURE 99 VALUE ZERO. SQ2144.2 +020900 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2144.2 +021000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2144.2 +021100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2144.2 +021200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2144.2 +021300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2144.2 +021400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2144.2 +021500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2144.2 +021600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2144.2 +021700 01 CCVS-H-1. SQ2144.2 +021800 02 FILLER PICTURE X(27) VALUE SPACE. SQ2144.2 +021900 02 FILLER PICTURE X(67) VALUE SQ2144.2 +022000 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2144.2 +022100- " SYSTEM". SQ2144.2 +022200 02 FILLER PICTURE X(26) VALUE SPACE. SQ2144.2 +022300 01 CCVS-H-2. SQ2144.2 +022400 02 FILLER PICTURE X(52) VALUE IS SQ2144.2 +022500 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2144.2 +022600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2144.2 +022700 02 TEST-ID PICTURE IS X(9). SQ2144.2 +022800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2144.2 +022900 01 CCVS-H-3. SQ2144.2 +023000 02 FILLER PICTURE X(34) VALUE SQ2144.2 +023100 " FOR OFFICIAL USE ONLY ". SQ2144.2 +023200 02 FILLER PICTURE X(58) VALUE SQ2144.2 +023300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2144.2 +023400 02 FILLER PICTURE X(28) VALUE SQ2144.2 +023500 " COPYRIGHT 1985 ". SQ2144.2 +023600 01 CCVS-E-1. SQ2144.2 +023700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2144.2 +023800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2144.2 +023900 02 ID-AGAIN PICTURE IS X(9). SQ2144.2 +024000 02 FILLER PICTURE X(45) VALUE IS SQ2144.2 +024100 " NTIS DISTRIBUTION COBOL 85". SQ2144.2 +024200 01 CCVS-E-2. SQ2144.2 +024300 02 FILLER PICTURE X(31) VALUE SQ2144.2 +024400 SPACE. SQ2144.2 +024500 02 FILLER PICTURE X(21) VALUE SPACE. SQ2144.2 +024600 02 CCVS-E-2-2. SQ2144.2 +024700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2144.2 +024800 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2144.2 +024900 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2144.2 +025000 01 CCVS-E-3. SQ2144.2 +025100 02 FILLER PICTURE X(22) VALUE SQ2144.2 +025200 " FOR OFFICIAL USE ONLY". SQ2144.2 +025300 02 FILLER PICTURE X(12) VALUE SPACE. SQ2144.2 +025400 02 FILLER PICTURE X(58) VALUE SQ2144.2 +025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2144.2 +025600 02 FILLER PICTURE X(13) VALUE SPACE. SQ2144.2 +025700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2144.2 +025800 01 CCVS-E-4. SQ2144.2 +025900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2144.2 +026000 02 FILLER PIC XXXX VALUE " OF ". SQ2144.2 +026100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2144.2 +026200 02 FILLER PIC X(40) VALUE SQ2144.2 +026300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2144.2 +026400 01 XXINFO. SQ2144.2 +026500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2144.2 +026600 02 INFO-TEXT. SQ2144.2 +026700 04 FILLER PIC X(20) VALUE SPACE. SQ2144.2 +026800 04 XXCOMPUTED PIC X(20). SQ2144.2 +026900 04 FILLER PIC X(5) VALUE SPACE. SQ2144.2 +027000 04 XXCORRECT PIC X(20). SQ2144.2 +027100 01 HYPHEN-LINE. SQ2144.2 +027200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2144.2 +027300 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2144.2 +027400- "*****************************************". SQ2144.2 +027500 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2144.2 +027600- "******************************". SQ2144.2 +027700 01 CCVS-PGM-ID PIC X(6) VALUE SQ2144.2 +027800 "SQ214A". SQ2144.2 +027900 PROCEDURE DIVISION. SQ2144.2 +028000 CCVS1 SECTION. SQ2144.2 +028100 OPEN-FILES. SQ2144.2 +028200*P OPEN I-O RAW-DATA. SQ2144.2 +028300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2144.2 +028400*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2144.2 +028500*P MOVE "ABORTED " TO C-ABORT. SQ2144.2 +028600*P ADD 1 TO C-NO-OF-TESTS. SQ2144.2 +028700*P ACCEPT C-DATE FROM DATE. SQ2144.2 +028800*P ACCEPT C-TIME FROM TIME. SQ2144.2 +028900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2144.2 +029000*PND-E-1. SQ2144.2 +029100*P CLOSE RAW-DATA. SQ2144.2 +029200 OPEN OUTPUT PRINT-FILE. SQ2144.2 +029300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2144.2 +029400 MOVE SPACE TO TEST-RESULTS. SQ2144.2 +029500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2144.2 +029600 MOVE ZERO TO REC-SKL-SUB. SQ2144.2 +029700 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2144.2 +029800 CCVS-INIT-FILE. SQ2144.2 +029900 ADD 1 TO REC-SKL-SUB. SQ2144.2 +030000 MOVE FILE-RECORD-INFO-SKELETON TO SQ2144.2 +030100 FILE-RECORD-INFO (REC-SKL-SUB). SQ2144.2 +030200 CCVS-INIT-EXIT. SQ2144.2 +030300 GO TO CCVS1-EXIT. SQ2144.2 +030400 CLOSE-FILES. SQ2144.2 +030500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2144.2 +030600*P OPEN I-O RAW-DATA. SQ2144.2 +030700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2144.2 +030800*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2144.2 +030900*P MOVE "OK. " TO C-ABORT. SQ2144.2 +031000*P MOVE PASS-COUNTER TO C-OK. SQ2144.2 +031100*P MOVE ERROR-HOLD TO C-ALL. SQ2144.2 +031200*P MOVE ERROR-COUNTER TO C-FAIL. SQ2144.2 +031300*P MOVE DELETE-CNT TO C-DELETED. SQ2144.2 +031400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2144.2 +031500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2144.2 +031600*PND-E-2. SQ2144.2 +031700*P CLOSE RAW-DATA. SQ2144.2 +031800 TERMINATE-CCVS. SQ2144.2 +031900*S EXIT PROGRAM. SQ2144.2 +032000*SERMINATE-CALL. SQ2144.2 +032100 STOP RUN. SQ2144.2 +032200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2144.2 +032300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2144.2 +032400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2144.2 +032500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2144.2 +032600 MOVE "****TEST DELETED****" TO RE-MARK. SQ2144.2 +032700 PRINT-DETAIL. SQ2144.2 +032800 IF REC-CT NOT EQUAL TO ZERO SQ2144.2 +032900 MOVE "." TO PARDOT-X SQ2144.2 +033000 MOVE REC-CT TO DOTVALUE. SQ2144.2 +033100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2144.2 +033200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2144.2 +033300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2144.2 +033400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2144.2 +033500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2144.2 +033600 MOVE SPACE TO CORRECT-X. SQ2144.2 +033700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2144.2 +033800 MOVE SPACE TO RE-MARK. SQ2144.2 +033900 HEAD-ROUTINE. SQ2144.2 +034000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +034100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2144.2 +034200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2144.2 +034300 COLUMN-NAMES-ROUTINE. SQ2144.2 +034400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +034500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +034700 END-ROUTINE. SQ2144.2 +034800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2144.2 +034900 END-RTN-EXIT. SQ2144.2 +035000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +035100 END-ROUTINE-1. SQ2144.2 +035200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2144.2 +035300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2144.2 +035400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2144.2 +035500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2144.2 +035600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2144.2 +035700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2144.2 +035800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2144.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2144.2 +036000 END-ROUTINE-12. SQ2144.2 +036100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2144.2 +036200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2144.2 +036300 MOVE "NO " TO ERROR-TOTAL SQ2144.2 +036400 ELSE SQ2144.2 +036500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2144.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2144.2 +036700 PERFORM WRITE-LINE. SQ2144.2 +036800 END-ROUTINE-13. SQ2144.2 +036900 IF DELETE-CNT IS EQUAL TO ZERO SQ2144.2 +037000 MOVE "NO " TO ERROR-TOTAL ELSE SQ2144.2 +037100 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2144.2 +037200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2144.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +037400 IF INSPECT-COUNTER EQUAL TO ZERO SQ2144.2 +037500 MOVE "NO " TO ERROR-TOTAL SQ2144.2 +037600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2144.2 +037700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2144.2 +037800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +037900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2144.2 +038000 WRITE-LINE. SQ2144.2 +038100 ADD 1 TO RECORD-COUNT. SQ2144.2 +038200 IF RECORD-COUNT GREATER 50 SQ2144.2 +038300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2144.2 +038400 MOVE SPACE TO DUMMY-RECORD SQ2144.2 +038500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2144.2 +038600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2144.2 +038700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2144.2 +038800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2144.2 +038900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2144.2 +039000 MOVE ZERO TO RECORD-COUNT. SQ2144.2 +039100 PERFORM WRT-LN. SQ2144.2 +039200 WRT-LN. SQ2144.2 +039300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2144.2 +039400 MOVE SPACE TO DUMMY-RECORD. SQ2144.2 +039500 BLANK-LINE-PRINT. SQ2144.2 +039600 PERFORM WRT-LN. SQ2144.2 +039700 FAIL-ROUTINE. SQ2144.2 +039800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2144.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2144.2 +040000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2144.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +040200 GO TO FAIL-ROUTINE-EX. SQ2144.2 +040300 FAIL-ROUTINE-WRITE. SQ2144.2 +040400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2144.2 +040500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +040600 FAIL-ROUTINE-EX. EXIT. SQ2144.2 +040700 BAIL-OUT. SQ2144.2 +040800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2144.2 +040900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2144.2 +041000 BAIL-OUT-WRITE. SQ2144.2 +041100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2144.2 +041200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2144.2 +041300 BAIL-OUT-EX. EXIT. SQ2144.2 +041400 CCVS1-EXIT. SQ2144.2 +041500 EXIT. SQ2144.2 +041600 BEGIN-SQ214A-TESTS SECTION. SQ2144.2 +041700 WRITE-INIT-GF-01. SQ2144.2 +041800 MOVE STATIC-VALUE TO WRK-GRP-00019. SQ2144.2 +041900 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +042000 MOVE " ACTIVE: " TO ODO-XN-00009. SQ2144.2 +042100 MOVE "1" TO ODO-XN-00001-O009D (1). SQ2144.2 +042200 MOVE "2" TO ODO-XN-00001-O009D (2). SQ2144.2 +042300 MOVE "3" TO ODO-XN-00001-O009D (3). SQ2144.2 +042400 MOVE "4" TO ODO-XN-00001-O009D (4). SQ2144.2 +042500 MOVE "5" TO ODO-XN-00001-O009D (5). SQ2144.2 +042600 MOVE "6" TO ODO-XN-00001-O009D (6). SQ2144.2 +042700 MOVE "7" TO ODO-XN-00001-O009D (7). SQ2144.2 +042800 MOVE "8" TO ODO-XN-00001-O009D (8). SQ2144.2 +042900 MOVE "9" TO ODO-XN-00001-O009D (9). SQ2144.2 +043000 WRITE-SQ-FS1 SECTION. SQ2144.2 +043100 WRITE-SQ-FS1-PARA1. SQ2144.2 +043200 OPEN OUTPUT SQ-FS1. SQ2144.2 +043300 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2144.2 +043400 MOVE "FS1R1 " TO XRECORD-NAME (1). SQ2144.2 +043500 MOVE "SQ214" TO XPROGRAM-NAME (1). SQ2144.2 +043600 MOVE 140 TO XRECORD-LENGTH (1). SQ2144.2 +043700 MOVE "1R" TO CHARS-OR-RECORDS (1). SQ2144.2 +043800 MOVE 4000 TO RECORDS-IN-FILE (1). SQ2144.2 +043900 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2144.2 +044000 MOVE "S" TO XLABEL-TYPE (1). SQ2144.2 +044100 MOVE 1 TO XRECORD-NUMBER (1). SQ2144.2 +044200 MOVE 3 TO ODO-NUMBER (1). SQ2144.2 +044300 MOVE FILE-RECORD-INFO-P1-120 (1) TO ODO-RECORD. SQ2144.2 +044400 PERFORM WRITE-INIT-GF-01. SQ2144.2 +044500 MOVE 3 TO DOI-DU-01V00. SQ2144.2 +044600 WRITE SQ-FS1R1-F-G-140 FROM ODO-RECORD. SQ2144.2 +044700 MOVE 2 TO XRECORD-NUMBER (1). SQ2144.2 +044800 MOVE 7 TO ODO-NUMBER (1). SQ2144.2 +044900 MOVE FILE-RECORD-INFO-P1-120 (1) TO ODO-RECORD. SQ2144.2 +045000 PERFORM WRITE-INIT-GF-01. SQ2144.2 +045100 MOVE 7 TO DOI-DU-01V00. SQ2144.2 +045200 WRITE SQ-FS1R1-F-G-140 FROM ODO-RECORD. SQ2144.2 +045300 PERFORM WRITE-SQ-FS1-PARA2 VARYING ODO-IX FROM 3 BY 1 SQ2144.2 +045400 UNTIL ODO-IX IS GREATER THAN 4000. SQ2144.2 +045500 GO TO WRITE-SQ-FS1-PARA3. SQ2144.2 +045600 WRITE-SQ-FS1-PARA2. SQ2144.2 +045700 SET XRECORD-NUMBER (1) TO ODO-IX. SQ2144.2 +045800 MOVE 9 TO ODO-NUMBER (1). SQ2144.2 +045900 MOVE FILE-RECORD-INFO-P1-120 (1) TO ODO-RECORD. SQ2144.2 +046000 PERFORM WRITE-INIT-GF-01. SQ2144.2 +046100 WRITE SQ-FS1R1-F-G-140 FROM ODO-RECORD. SQ2144.2 +046200 WRITE-SQ-FS1-PARA3. SQ2144.2 +046300 CLOSE SQ-FS1. SQ2144.2 +046400 OPEN INPUT SQ-FS1. SQ2144.2 +046500 MOVE "OCCURS DEPENDING ON" TO FEATURE. SQ2144.2 +046600 END-OF-WRITE-SQ-FS1 SECTION. SQ2144.2 +046700 WRITE-TEST-GF-01. SQ2144.2 +046800 MOVE SPACES TO SQ-FS1R1-F-G-140. SQ2144.2 +046900 READ SQ-FS1 AT END GO TO WRITE-DELETE-GF-01. SQ2144.2 +047000 IF FS1R1-XN-13 IS EQUAL TO "3 ACTIVE: 123" AND SQ2144.2 +047100 FS1R1-XN-6 IS NOT EQUAL TO "456789" SQ2144.2 +047200 PERFORM PASS SQ2144.2 +047300 ELSE SQ2144.2 +047400 PERFORM FAIL SQ2144.2 +047500 MOVE "VI-26 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +047600 MOVE "3 ACTIVE: 123" TO CORRECT-A SQ2144.2 +047700 MOVE FS1R1-XN-20 TO COMPUTED-A. SQ2144.2 +047800 GO TO WRITE-WRITE-GF-01. SQ2144.2 +047900 WRITE-DELETE-GF-01. SQ2144.2 +048000 PERFORM DE-LETE. SQ2144.2 +048100 WRITE-WRITE-GF-01. SQ2144.2 +048200 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2144.2 +048300 MOVE "WRITE FROM PARTIAL ODO" TO RE-MARK. SQ2144.2 +048400 PERFORM PRINT-DETAIL. SQ2144.2 +048500 READ-TEST-GF-01. SQ2144.2 +048600 MOVE SPACES TO SQ-FS1R1-F-G-140. SQ2144.2 +048700 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +048800 MOVE SPACES TO ODO-RECORD. SQ2144.2 +048900 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +049000 READ SQ-FS1 INTO ODO-RECORD AT END GO TO READ-DELETE-GF-01. SQ2144.2 +049100 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +049200 MOVE ODO-GRP-00009 TO WRK-GRP-00009. SQ2144.2 +049300 IF ODO-XN-00007 IS EQUAL TO "1234567" AND SQ2144.2 +049400 ODO-XN-00002 IS NOT EQUAL TO "89" SQ2144.2 +049500 PERFORM PASS SQ2144.2 +049600 ELSE SQ2144.2 +049700 MOVE "VI-26 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +049800 PERFORM FAIL SQ2144.2 +049900 MOVE "1234567" TO CORRECT-A SQ2144.2 +050000 MOVE ODO-GRP-00009 TO COMPUTED-A. SQ2144.2 +050100 GO TO READ-WRITE-GF-01. SQ2144.2 +050200 READ-DELETE-GF-01. SQ2144.2 +050300 PERFORM DE-LETE. SQ2144.2 +050400 READ-WRITE-GF-01. SQ2144.2 +050500 MOVE "READ-TEST-GF-01" TO PAR-NAME. SQ2144.2 +050600 MOVE "READ PARTIAL ODO INTO FULL ODO" TO RE-MARK. SQ2144.2 +050700 PERFORM PRINT-DETAIL. SQ2144.2 +050800 WRITE-TEST-GF-02. SQ2144.2 +050900 MOVE SPACES TO SQ-FS1R1-F-G-140. SQ2144.2 +051000 READ SQ-FS1 AT END GO TO WRITE-DELETE-GF-02. SQ2144.2 +051100 IF FS1R1-XN-20 IS EQUAL TO "9 ACTIVE: 123456789" SQ2144.2 +051200 PERFORM PASS SQ2144.2 +051300 ELSE SQ2144.2 +051400 MOVE "VI-26 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +051500 PERFORM FAIL SQ2144.2 +051600 MOVE "9 ACTIVE: 123456789" TO CORRECT-A SQ2144.2 +051700 MOVE FS1R1-XN-20 TO COMPUTED-A. SQ2144.2 +051800 GO TO WRITE-WRITE-GF-02. SQ2144.2 +051900 WRITE-DELETE-GF-02. SQ2144.2 +052000 PERFORM DE-LETE. SQ2144.2 +052100 WRITE-WRITE-GF-02. SQ2144.2 +052200 MOVE "WRITE-TEST-GF-02" TO PAR-NAME. SQ2144.2 +052300 MOVE "WRITE FROM FULL ODO" TO RE-MARK. SQ2144.2 +052400 PERFORM PRINT-DETAIL. SQ2144.2 +052500 READ-TEST-GF-02. SQ2144.2 +052600 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +052700 MOVE SPACES TO SQ-FS1R1-F-G-140 ODO-RECORD. SQ2144.2 +052800 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +052900 READ SQ-FS1 INTO ODO-RECORD AT END GO TO READ-DELETE-GF-02. SQ2144.2 +053000 IF GRP-ODO IS EQUAL TO "9 ACTIVE: 123456789" SQ2144.2 +053100 PERFORM PASS SQ2144.2 +053200 ELSE SQ2144.2 +053300 MOVE "VI-26 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +053400 PERFORM FAIL SQ2144.2 +053500 MOVE "9 ACTIVE: 123456789" TO CORRECT-A SQ2144.2 +053600 MOVE GRP-ODO TO COMPUTED-A. SQ2144.2 +053700 GO TO READ-WRITE-GF-02. SQ2144.2 +053800 READ-DELETE-GF-02. SQ2144.2 +053900 PERFORM DE-LETE. SQ2144.2 +054000 READ-WRITE-GF-02. SQ2144.2 +054100 MOVE "READ-TEST-GF-02" TO PAR-NAME. SQ2144.2 +054200 MOVE "READ FULL ODO INTO FULL ODO" TO RE-MARK. SQ2144.2 +054300 PERFORM PRINT-DETAIL. SQ2144.2 +054400 READ-TEST-GF-03. SQ2144.2 +054500 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +054600 MOVE SPACES TO SQ-FS1R1-F-G-140 ODO-RECORD. SQ2144.2 +054700 MOVE 5 TO DOI-DU-01V00. SQ2144.2 +054800 READ SQ-FS1 INTO ODO-RECORD AT END GO TO READ-DELETE-GF-03. SQ2144.2 +054900 MOVE 9 TO DOI-DU-01V00. SQ2144.2 +055000 MOVE ODO-GRP-00009 TO WRK-GRP-00009. SQ2144.2 +055100 IF ODO-XN-00005 IS EQUAL TO "12345" AND SQ2144.2 +055200 ODO-XN-00004 IS EQUAL TO "6789" SQ2144.2 +055300 PERFORM PASS SQ2144.2 +055400 ELSE SQ2144.2 +055500 MOVE "VI-28 OCCURS & VII-44 READ / VII-52 WRITE" TO RE-MARKSQ2144.2 +055600 PERFORM FAIL SQ2144.2 +055700 MOVE "123456789" TO CORRECT-A SQ2144.2 +055800 MOVE ODO-GRP-00009 TO COMPUTED-A. SQ2144.2 +055900 GO TO READ-WRITE-GF-03. SQ2144.2 +056000 READ-DELETE-GF-03. SQ2144.2 +056100 PERFORM DE-LETE. SQ2144.2 +056200 READ-WRITE-GF-03. SQ2144.2 +056300 MOVE "READ-TEST-GF-03" TO PAR-NAME. SQ2144.2 +056400 MOVE "READ FULL ODO INTO PARTIAL ODO" TO RE-MARK. SQ2144.2 +056500 PERFORM PRINT-DETAIL. SQ2144.2 +056600 END-OF-SQ214A-TESTS. SQ2144.2 +056700 CLOSE SQ-FS1. SQ2144.2 +056800 CCVS-EXIT SECTION. SQ2144.2 +056900 CCVS-999999. SQ2144.2 +057000 GO TO CLOSE-FILES. SQ2144.2 diff --git a/tests/cobol85/SQ/SQ215A.CBL b/tests/cobol85/SQ/SQ215A.CBL new file mode 100755 index 00000000..2a2f0dd2 --- /dev/null +++ b/tests/cobol85/SQ/SQ215A.CBL @@ -0,0 +1,648 @@ +000100 IDENTIFICATION DIVISION. SQ2154.2 +000200 PROGRAM-ID. SQ2154.2 +000300 SQ215A. SQ2154.2 +000400**************************************************************** SQ2154.2 +000500* * SQ2154.2 +000600* VALIDATION FOR:- * SQ2154.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2154.2 +000800* USING CCVS85 VERSION 3.0. * SQ2154.2 +000900* * SQ2154.2 +001000* CREATION DATE / VALIDATION DATE * SQ2154.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2154.2 +001200* * SQ2154.2 +001300**************************************************************** SQ2154.2 +001400* * SQ2154.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2154.2 +001600* * SQ2154.2 +001700* X-14 SEQUENTIAL MASS STORAGE * SQ2154.2 +001800* X-55 SYSTEM PRINTER * SQ2154.2 +001900* X-82 SOURCE-COMPUTER * SQ2154.2 +002000* X-83 OBJECT-COMPUTER * SQ2154.2 +002100* X-84 LABEL RECORDS OPTION * SQ2154.2 +002200* * SQ2154.2 +002300**************************************************************** SQ2154.2 +002400* * SQ2154.2 +002500* SQ215A TESTS THE CLOSE STATEMENT WITH THE WITH LOCK PHRASE* SQ2154.2 +002600* A MASS STORAGE FILE IS CREATED, ONE RECORD IS WRITTEN * SQ2154.2 +002700* TO IT, AND IT IS CLOSED WITH LOCK. AN ATTEMPT IS THEN * SQ2154.2 +002800* MADE TO REOPEN THE FILE. I-O STATUS 38 IS EXPECTED AND * SQ2154.2 +002900* TESTED IN THE DECLARATIVES. * SQ2154.2 +003000* * SQ2154.2 +003100* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ2154.2 +003200* THE NEW PROGRAMS ARE SQ229A AND SQ230A. * SQ2154.2 +003300**************************************************************** SQ2154.2 +003400* * SQ2154.2 +003500* SQ2154.2 +003600 ENVIRONMENT DIVISION. SQ2154.2 +003700 CONFIGURATION SECTION. SQ2154.2 +003800 SOURCE-COMPUTER. SQ2154.2 +003900 Linux. SQ2154.2 +004000 OBJECT-COMPUTER. SQ2154.2 +004100 Linux. SQ2154.2 +004200* SQ2154.2 +004300 INPUT-OUTPUT SECTION. SQ2154.2 +004400 FILE-CONTROL. SQ2154.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2154.2 +004600 "report.log". SQ2154.2 +004700 SELECT SQ-FS1 ASSIGN TO SQ2154.2 +004800 "XXXXX014" SQ2154.2 +004900 FILE STATUS IS SQ-FS1-STATUS. SQ2154.2 +005000* SQ2154.2 +005100* SQ2154.2 +005200 DATA DIVISION. SQ2154.2 +005300 FILE SECTION. SQ2154.2 +005400 FD PRINT-FILE SQ2154.2 +005500*C LABEL RECORDS SQ2154.2 +005600*C OMITTED SQ2154.2 +005700*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2154.2 +005800 . SQ2154.2 +005900 01 PRINT-REC PICTURE X(120). SQ2154.2 +006000 01 DUMMY-RECORD PICTURE X(120). SQ2154.2 +006100* SQ2154.2 +006200 FD SQ-FS1 SQ2154.2 +006300*C LABEL RECORD IS STANDARD SQ2154.2 +006400 . SQ2154.2 +006500 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2154.2 +006600* SQ2154.2 +006700 WORKING-STORAGE SECTION. SQ2154.2 +006800* SQ2154.2 +006900*************************************************************** SQ2154.2 +007000* * SQ2154.2 +007100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2154.2 +007200* * SQ2154.2 +007300*************************************************************** SQ2154.2 +007400* SQ2154.2 +007500 01 SQ-FS1-STATUS. SQ2154.2 +007600 03 SQ-FS1-KEY-1 PIC X. SQ2154.2 +007700 03 SQ-FS1-KEY-2 PIC X. SQ2154.2 +007800* SQ2154.2 +007900*************************************************************** SQ2154.2 +008000* * SQ2154.2 +008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2154.2 +008200* * SQ2154.2 +008300*************************************************************** SQ2154.2 +008400* SQ2154.2 +008500 01 REC-SKEL-SUB PIC 99. SQ2154.2 +008600* SQ2154.2 +008700 01 FILE-RECORD-INFORMATION-REC. SQ2154.2 +008800 03 FILE-RECORD-INFO-SKELETON. SQ2154.2 +008900 05 FILLER PICTURE X(48) VALUE SQ2154.2 +009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2154.2 +009100 05 FILLER PICTURE X(46) VALUE SQ2154.2 +009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2154.2 +009300 05 FILLER PICTURE X(26) VALUE SQ2154.2 +009400 ",LFIL=000000,ORG= ,LBLR= ". SQ2154.2 +009500 05 FILLER PICTURE X(37) VALUE SQ2154.2 +009600 ",RECKEY= ". SQ2154.2 +009700 05 FILLER PICTURE X(38) VALUE SQ2154.2 +009800 ",ALTKEY1= ". SQ2154.2 +009900 05 FILLER PICTURE X(38) VALUE SQ2154.2 +010000 ",ALTKEY2= ". SQ2154.2 +010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ2154.2 +010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2154.2 +010300 05 FILE-RECORD-INFO-P1-120. SQ2154.2 +010400 07 FILLER PIC X(5). SQ2154.2 +010500 07 XFILE-NAME PIC X(6). SQ2154.2 +010600 07 FILLER PIC X(8). SQ2154.2 +010700 07 XRECORD-NAME PIC X(6). SQ2154.2 +010800 07 FILLER PIC X(1). SQ2154.2 +010900 07 REELUNIT-NUMBER PIC 9(1). SQ2154.2 +011000 07 FILLER PIC X(7). SQ2154.2 +011100 07 XRECORD-NUMBER PIC 9(6). SQ2154.2 +011200 07 FILLER PIC X(6). SQ2154.2 +011300 07 UPDATE-NUMBER PIC 9(2). SQ2154.2 +011400 07 FILLER PIC X(5). SQ2154.2 +011500 07 ODO-NUMBER PIC 9(4). SQ2154.2 +011600 07 FILLER PIC X(5). SQ2154.2 +011700 07 XPROGRAM-NAME PIC X(5). SQ2154.2 +011800 07 FILLER PIC X(7). SQ2154.2 +011900 07 XRECORD-LENGTH PIC 9(6). SQ2154.2 +012000 07 FILLER PIC X(7). SQ2154.2 +012100 07 CHARS-OR-RECORDS PIC X(2). SQ2154.2 +012200 07 FILLER PIC X(1). SQ2154.2 +012300 07 XBLOCK-SIZE PIC 9(4). SQ2154.2 +012400 07 FILLER PIC X(6). SQ2154.2 +012500 07 RECORDS-IN-FILE PIC 9(6). SQ2154.2 +012600 07 FILLER PIC X(5). SQ2154.2 +012700 07 XFILE-ORGANIZATION PIC X(2). SQ2154.2 +012800 07 FILLER PIC X(6). SQ2154.2 +012900 07 XLABEL-TYPE PIC X(1). SQ2154.2 +013000 05 FILE-RECORD-INFO-P121-240. SQ2154.2 +013100 07 FILLER PIC X(8). SQ2154.2 +013200 07 XRECORD-KEY PIC X(29). SQ2154.2 +013300 07 FILLER PIC X(9). SQ2154.2 +013400 07 ALTERNATE-KEY1 PIC X(29). SQ2154.2 +013500 07 FILLER PIC X(9). SQ2154.2 +013600 07 ALTERNATE-KEY2 PIC X(29). SQ2154.2 +013700 07 FILLER PIC X(7). SQ2154.2 +013800* SQ2154.2 +013900 01 TEST-RESULTS. SQ2154.2 +014000 02 FILLER PIC X VALUE SPACE. SQ2154.2 +014100 02 FEATURE PIC X(24) VALUE SPACE. SQ2154.2 +014200 02 FILLER PIC X VALUE SPACE. SQ2154.2 +014300 02 P-OR-F PIC X(5) VALUE SPACE. SQ2154.2 +014400 02 FILLER PIC X VALUE SPACE. SQ2154.2 +014500 02 PAR-NAME. SQ2154.2 +014600 03 FILLER PIC X(14) VALUE SPACE. SQ2154.2 +014700 03 PARDOT-X PIC X VALUE SPACE. SQ2154.2 +014800 03 DOTVALUE PIC 99 VALUE ZERO. SQ2154.2 +014900 02 FILLER PIC X(9) VALUE SPACE. SQ2154.2 +015000 02 RE-MARK PIC X(61). SQ2154.2 +015100 01 TEST-COMPUTED. SQ2154.2 +015200 02 FILLER PIC X(30) VALUE SPACE. SQ2154.2 +015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2154.2 +015400 02 COMPUTED-X. SQ2154.2 +015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2154.2 +015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2154.2 +015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2154.2 +015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2154.2 +015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2154.2 +016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ2154.2 +016100 04 COMPUTED-18V0 PIC -9(18). SQ2154.2 +016200 04 FILLER PIC X. SQ2154.2 +016300 03 FILLER PIC X(50) VALUE SPACE. SQ2154.2 +016400 01 TEST-CORRECT. SQ2154.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ2154.2 +016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2154.2 +016700 02 CORRECT-X. SQ2154.2 +016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2154.2 +016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2154.2 +017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2154.2 +017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2154.2 +017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2154.2 +017300 03 CR-18V0 REDEFINES CORRECT-A. SQ2154.2 +017400 04 CORRECT-18V0 PIC -9(18). SQ2154.2 +017500 04 FILLER PIC X. SQ2154.2 +017600 03 FILLER PIC X(2) VALUE SPACE. SQ2154.2 +017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2154.2 +017800 01 CCVS-C-1. SQ2154.2 +017900 02 FILLER PIC IS X(4) VALUE SPACE. SQ2154.2 +018000 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ2154.2 +018100- "SS PARAGRAPH-NAME SQ2154.2 +018200- " REMARKS". SQ2154.2 +018300 02 FILLER PIC X(17) VALUE SPACE. SQ2154.2 +018400 01 CCVS-C-2. SQ2154.2 +018500 02 FILLER PIC XXXX VALUE SPACE. SQ2154.2 +018600 02 FILLER PIC X(6) VALUE "TESTED". SQ2154.2 +018700 02 FILLER PIC X(16) VALUE SPACE. SQ2154.2 +018800 02 FILLER PIC X(4) VALUE "FAIL". SQ2154.2 +018900 02 FILLER PIC X(90) VALUE SPACE. SQ2154.2 +019000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2154.2 +019100 01 REC-CT PIC 99 VALUE ZERO. SQ2154.2 +019200 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2154.2 +019300 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2154.2 +019400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2154.2 +019500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2154.2 +019600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2154.2 +019700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2154.2 +019800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2154.2 +019900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2154.2 +020000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2154.2 +020100 01 CCVS-H-1. SQ2154.2 +020200 02 FILLER PIC X(39) VALUE SPACES. SQ2154.2 +020300 02 FILLER PIC X(42) VALUE SQ2154.2 +020400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2154.2 +020500 02 FILLER PIC X(39) VALUE SPACES. SQ2154.2 +020600 01 CCVS-H-2A. SQ2154.2 +020700 02 FILLER PIC X(40) VALUE SPACE. SQ2154.2 +020800 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2154.2 +020900 02 FILLER PIC XXXX VALUE SQ2154.2 +021000 "4.2 ". SQ2154.2 +021100 02 FILLER PIC X(28) VALUE SQ2154.2 +021200 " COPY - NOT FOR DISTRIBUTION". SQ2154.2 +021300 02 FILLER PIC X(41) VALUE SPACE. SQ2154.2 +021400* SQ2154.2 +021500 01 CCVS-H-2B. SQ2154.2 +021600 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2154.2 +021700 02 TEST-ID PIC X(9). SQ2154.2 +021800 02 FILLER PIC X(4) VALUE " IN ". SQ2154.2 +021900 02 FILLER PIC X(12) VALUE SQ2154.2 +022000 " HIGH ". SQ2154.2 +022100 02 FILLER PIC X(22) VALUE SQ2154.2 +022200 " LEVEL VALIDATION FOR ". SQ2154.2 +022300 02 FILLER PIC X(58) VALUE SQ2154.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2154.2 +022500 01 CCVS-H-3. SQ2154.2 +022600 02 FILLER PIC X(34) VALUE SQ2154.2 +022700 " FOR OFFICIAL USE ONLY ". SQ2154.2 +022800 02 FILLER PIC X(58) VALUE SQ2154.2 +022900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2154.2 +023000 02 FILLER PIC X(28) VALUE SQ2154.2 +023100 " COPYRIGHT 1985,1986 ". SQ2154.2 +023200 01 CCVS-E-1. SQ2154.2 +023300 02 FILLER PIC X(52) VALUE SPACE. SQ2154.2 +023400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2154.2 +023500 02 ID-AGAIN PIC X(9). SQ2154.2 +023600 02 FILLER PIC X(45) VALUE SPACES. SQ2154.2 +023700 01 CCVS-E-2. SQ2154.2 +023800 02 FILLER PIC X(31) VALUE SPACE. SQ2154.2 +023900 02 FILLER PIC X(21) VALUE SPACE. SQ2154.2 +024000 02 CCVS-E-2-2. SQ2154.2 +024100 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2154.2 +024200 03 FILLER PIC X VALUE SPACE. SQ2154.2 +024300 03 ENDER-DESC PIC X(44) VALUE SQ2154.2 +024400 "ERRORS ENCOUNTERED". SQ2154.2 +024500 01 CCVS-E-3. SQ2154.2 +024600 02 FILLER PIC X(22) VALUE SQ2154.2 +024700 " FOR OFFICIAL USE ONLY". SQ2154.2 +024800 02 FILLER PIC X(12) VALUE SPACE. SQ2154.2 +024900 02 FILLER PIC X(58) VALUE SQ2154.2 +025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2154.2 +025100 02 FILLER PIC X(8) VALUE SPACE. SQ2154.2 +025200 02 FILLER PIC X(20) VALUE SQ2154.2 +025300 " COPYRIGHT 1985,1986". SQ2154.2 +025400 01 CCVS-E-4. SQ2154.2 +025500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2154.2 +025600 02 FILLER PIC X(4) VALUE " OF ". SQ2154.2 +025700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2154.2 +025800 02 FILLER PIC X(40) VALUE SQ2154.2 +025900 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2154.2 +026000 01 XXINFO. SQ2154.2 +026100 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2154.2 +026200 02 INFO-TEXT. SQ2154.2 +026300 04 FILLER PIC X(8) VALUE SPACE. SQ2154.2 +026400 04 XXCOMPUTED PIC X(20). SQ2154.2 +026500 04 FILLER PIC X(5) VALUE SPACE. SQ2154.2 +026600 04 XXCORRECT PIC X(20). SQ2154.2 +026700 02 INF-ANSI-REFERENCE PIC X(48). SQ2154.2 +026800 01 HYPHEN-LINE. SQ2154.2 +026900 02 FILLER PIC IS X VALUE IS SPACE. SQ2154.2 +027000 02 FILLER PIC IS X(65) VALUE IS "************************SQ2154.2 +027100- "*****************************************". SQ2154.2 +027200 02 FILLER PIC IS X(54) VALUE IS "************************SQ2154.2 +027300- "******************************". SQ2154.2 +027400 01 CCVS-PGM-ID PIC X(9) VALUE SQ2154.2 +027500 "SQ215A". SQ2154.2 +027600* SQ2154.2 +027700 PROCEDURE DIVISION. SQ2154.2 +027800 DECLARATIVES. SQ2154.2 +027900 SQ-FS1-DECLARATIVE SECTION. SQ2154.2 +028000 USE AFTER STANDARD EXCEPTION PROCEDURE ON SQ-FS1. SQ2154.2 +028100 OUTPUT-ERROR-PROCESS. SQ2154.2 +028200 IF SQ-FS1-STATUS = "38" SQ2154.2 +028300 PERFORM PASS-DECL SQ2154.2 +028400 GO TO ABNORMAL-TERM-DECL SQ2154.2 +028500 ELSE SQ2154.2 +028600 MOVE "38" TO CORRECT-A SQ2154.2 +028700 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2154.2 +028800 MOVE "STATUS AFTER OPEN AFTER LOCK INCORRECT" SQ2154.2 +028900 TO RE-MARK SQ2154.2 +029000 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ2154.2 +029100 PERFORM FAIL-DECL SQ2154.2 +029200 GO TO ABNORMAL-TERM-DECL SQ2154.2 +029300 END-IF. SQ2154.2 +029400* SQ2154.2 +029500 PASS-DECL. SQ2154.2 +029600 MOVE "PASS " TO P-OR-F. SQ2154.2 +029700 ADD 1 TO PASS-COUNTER. SQ2154.2 +029800 PERFORM PRINT-DETAIL-DECL. SQ2154.2 +029900* SQ2154.2 +030000 FAIL-DECL. SQ2154.2 +030100 MOVE "FAIL*" TO P-OR-F. SQ2154.2 +030200 ADD 1 TO ERROR-COUNTER. SQ2154.2 +030300 PERFORM PRINT-DETAIL-DECL. SQ2154.2 +030400* SQ2154.2 +030500 PRINT-DETAIL-DECL. SQ2154.2 +030600 IF REC-CT NOT EQUAL TO ZERO SQ2154.2 +030700 MOVE "." TO PARDOT-X SQ2154.2 +030800 MOVE REC-CT TO DOTVALUE. SQ2154.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. SQ2154.2 +031000 PERFORM WRITE-LINE-DECL. SQ2154.2 +031100 IF P-OR-F EQUAL TO "FAIL*" SQ2154.2 +031200 PERFORM WRITE-LINE-DECL SQ2154.2 +031300 PERFORM FAIL-ROUTINE-DECL THRU FAIL-ROUTINE-EX-DECL SQ2154.2 +031400 ELSE SQ2154.2 +031500 PERFORM BAIL-OUT-DECL THRU BAIL-OUT-EX-DECL. SQ2154.2 +031600 MOVE SPACE TO P-OR-F. SQ2154.2 +031700 MOVE SPACE TO COMPUTED-X. SQ2154.2 +031800 MOVE SPACE TO CORRECT-X. SQ2154.2 +031900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2154.2 +032000 MOVE SPACE TO RE-MARK. SQ2154.2 +032100* SQ2154.2 +032200 WRITE-LINE-DECL. SQ2154.2 +032300 ADD 1 TO RECORD-COUNT. SQ2154.2 +032400 IF RECORD-COUNT GREATER 50 SQ2154.2 +032500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2154.2 +032600 MOVE SPACE TO DUMMY-RECORD SQ2154.2 +032700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2154.2 +032800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ2154.2 +032900 MOVE CCVS-C-2 TO DUMMY-RECORD SQ2154.2 +033000 PERFORM WRT-LN-DECL 2 TIMES SQ2154.2 +033100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-DECL SQ2154.2 +033200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2154.2 +033300 MOVE ZERO TO RECORD-COUNT. SQ2154.2 +033400 PERFORM WRT-LN-DECL. SQ2154.2 +033500* SQ2154.2 +033600 WRT-LN-DECL. SQ2154.2 +033700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2154.2 +033800 MOVE SPACE TO DUMMY-RECORD. SQ2154.2 +033900 BLANK-LINE-PRINT-DECL. SQ2154.2 +034000 PERFORM WRT-LN-DECL. SQ2154.2 +034100 FAIL-ROUTINE-DECL. SQ2154.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE SQ2154.2 +034300 GO TO FAIL-ROUTINE-WRITE-DECL. SQ2154.2 +034400 IF CORRECT-X NOT EQUAL TO SPACE SQ2154.2 +034500 GO TO FAIL-ROUTINE-WRITE-DECL. SQ2154.2 +034600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2154.2 +034700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2154.2 +034800 MOVE XXINFO TO DUMMY-RECORD. SQ2154.2 +034900 PERFORM WRITE-LINE-DECL 2 TIMES. SQ2154.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2154.2 +035100 GO TO FAIL-ROUTINE-EX-DECL. SQ2154.2 +035200 FAIL-ROUTINE-WRITE-DECL. SQ2154.2 +035300 MOVE TEST-COMPUTED TO PRINT-REC SQ2154.2 +035400 PERFORM WRITE-LINE-DECL SQ2154.2 +035500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2154.2 +035600 MOVE TEST-CORRECT TO PRINT-REC SQ2154.2 +035700 PERFORM WRITE-LINE-DECL 2 TIMES. SQ2154.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2154.2 +035900 FAIL-ROUTINE-EX-DECL. SQ2154.2 +036000 EXIT. SQ2154.2 +036100 BAIL-OUT-DECL. SQ2154.2 +036200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-DECL. SQ2154.2 +036300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-DECL. SQ2154.2 +036400 BAIL-OUT-WRITE-DECL. SQ2154.2 +036500 MOVE CORRECT-A TO XXCORRECT. SQ2154.2 +036600 MOVE COMPUTED-A TO XXCOMPUTED. SQ2154.2 +036700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2154.2 +036800 MOVE XXINFO TO DUMMY-RECORD. SQ2154.2 +036900 PERFORM WRITE-LINE-DECL 2 TIMES. SQ2154.2 +037000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2154.2 +037100 BAIL-OUT-EX-DECL. SQ2154.2 +037200 EXIT. SQ2154.2 +037300* SQ2154.2 +037400 ABNORMAL-TERM-DECL. SQ2154.2 +037500 MOVE SPACE TO DUMMY-RECORD SQ2154.2 +037600 PERFORM WRITE-LINE-DECL SQ2154.2 +037700 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2154.2 +037800 TO DUMMY-RECORD SQ2154.2 +037900 PERFORM WRITE-LINE-DECL 3 TIMES. SQ2154.2 +038000* SQ2154.2 +038100 EXIT-DECL. SQ2154.2 +038200 EXIT. SQ2154.2 +038300 END DECLARATIVES. SQ2154.2 +038400* SQ2154.2 +038500 CCVS1 SECTION. SQ2154.2 +038600 OPEN-FILES. SQ2154.2 +038700 OPEN OUTPUT PRINT-FILE. SQ2154.2 +038800 MOVE CCVS-PGM-ID TO TEST-ID. SQ2154.2 +038900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2154.2 +039000 MOVE SPACE TO TEST-RESULTS. SQ2154.2 +039100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2154.2 +039200 MOVE ZERO TO REC-SKEL-SUB. SQ2154.2 +039300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2154.2 +039400 GO TO CCVS1-EXIT. SQ2154.2 +039500* SQ2154.2 +039600 CCVS-INIT-FILE. SQ2154.2 +039700 ADD 1 TO REC-SKL-SUB. SQ2154.2 +039800 MOVE FILE-RECORD-INFO-SKELETON TO SQ2154.2 +039900 FILE-RECORD-INFO (REC-SKL-SUB). SQ2154.2 +040000* SQ2154.2 +040100 CLOSE-FILES. SQ2154.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2154.2 +040300 CLOSE PRINT-FILE. SQ2154.2 +040400 TERMINATE-CCVS. SQ2154.2 +040500 STOP RUN. SQ2154.2 +040600* SQ2154.2 +040700 INSPT. SQ2154.2 +040800 MOVE "INSPT" TO P-OR-F. SQ2154.2 +040900 ADD 1 TO INSPECT-COUNTER. SQ2154.2 +041000 PERFORM PRINT-DETAIL. SQ2154.2 +041100 SQ2154.2 +041200 PASS. SQ2154.2 +041300 MOVE "PASS " TO P-OR-F. SQ2154.2 +041400 ADD 1 TO PASS-COUNTER. SQ2154.2 +041500 PERFORM PRINT-DETAIL. SQ2154.2 +041600* SQ2154.2 +041700 FAIL. SQ2154.2 +041800 MOVE "FAIL*" TO P-OR-F. SQ2154.2 +041900 ADD 1 TO ERROR-COUNTER. SQ2154.2 +042000 PERFORM PRINT-DETAIL. SQ2154.2 +042100* SQ2154.2 +042200 DE-LETE. SQ2154.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. SQ2154.2 +042400 MOVE "*****" TO P-OR-F. SQ2154.2 +042500 ADD 1 TO DELETE-COUNTER. SQ2154.2 +042600 PERFORM PRINT-DETAIL. SQ2154.2 +042700* SQ2154.2 +042800 PRINT-DETAIL. SQ2154.2 +042900 IF REC-CT NOT EQUAL TO ZERO SQ2154.2 +043000 MOVE "." TO PARDOT-X SQ2154.2 +043100 MOVE REC-CT TO DOTVALUE. SQ2154.2 +043200 MOVE TEST-RESULTS TO PRINT-REC. SQ2154.2 +043300 PERFORM WRITE-LINE. SQ2154.2 +043400 IF P-OR-F EQUAL TO "FAIL*" SQ2154.2 +043500 PERFORM WRITE-LINE SQ2154.2 +043600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2154.2 +043700 ELSE SQ2154.2 +043800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2154.2 +043900 MOVE SPACE TO P-OR-F. SQ2154.2 +044000 MOVE SPACE TO COMPUTED-X. SQ2154.2 +044100 MOVE SPACE TO CORRECT-X. SQ2154.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2154.2 +044300 MOVE SPACE TO RE-MARK. SQ2154.2 +044400* SQ2154.2 +044500 HEAD-ROUTINE. SQ2154.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2154.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2154.2 +045000 COLUMN-NAMES-ROUTINE. SQ2154.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2154.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2154.2 +045400 END-ROUTINE. SQ2154.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2154.2 +045600 PERFORM WRITE-LINE 5 TIMES. SQ2154.2 +045700 END-RTN-EXIT. SQ2154.2 +045800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2154.2 +045900 PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +046000* SQ2154.2 +046100 END-ROUTINE-1. SQ2154.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD SQ2154.2 +046300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2154.2 +046400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2154.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. SQ2154.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2154.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2154.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2154.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2154.2 +047000 PERFORM WRITE-LINE. SQ2154.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2154.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2154.2 +047300 MOVE "NO " TO ERROR-TOTAL SQ2154.2 +047400 ELSE SQ2154.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2154.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2154.2 +047700 PERFORM WRITE-LINE. SQ2154.2 +047800 END-ROUTINE-13. SQ2154.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2154.2 +048000 MOVE "NO " TO ERROR-TOTAL SQ2154.2 +048100 ELSE SQ2154.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2154.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2154.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2154.2 +048500 PERFORM WRITE-LINE. SQ2154.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO SQ2154.2 +048700 MOVE "NO " TO ERROR-TOTAL SQ2154.2 +048800 ELSE SQ2154.2 +048900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2154.2 +049000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2154.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2154.2 +049200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2154.2 +049300* SQ2154.2 +049400 WRITE-LINE. SQ2154.2 +049500 ADD 1 TO RECORD-COUNT. SQ2154.2 +049600* IF RECORD-COUNT GREATER 50 SQ2154.2 +049700* MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2154.2 +049800* MOVE SPACE TO DUMMY-RECORD SQ2154.2 +049900* WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2154.2 +050000* MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2154.2 +050100* MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2154.2 +050200* MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2154.2 +050300* MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2154.2 +050400* MOVE ZERO TO RECORD-COUNT. SQ2154.2 +050500 PERFORM WRT-LN. SQ2154.2 +050600* SQ2154.2 +050700 WRT-LN. SQ2154.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2154.2 +050900 MOVE SPACE TO DUMMY-RECORD. SQ2154.2 +051000 BLANK-LINE-PRINT. SQ2154.2 +051100 PERFORM WRT-LN. SQ2154.2 +051200 FAIL-ROUTINE. SQ2154.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2154.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2154.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2154.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2154.2 +051700 MOVE XXINFO TO DUMMY-RECORD. SQ2154.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2154.2 +052000 GO TO FAIL-ROUTINE-EX. SQ2154.2 +052100 FAIL-ROUTINE-WRITE. SQ2154.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC SQ2154.2 +052300 PERFORM WRITE-LINE SQ2154.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2154.2 +052500 MOVE TEST-CORRECT TO PRINT-REC SQ2154.2 +052600 PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +052700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2154.2 +052800 FAIL-ROUTINE-EX. SQ2154.2 +052900 EXIT. SQ2154.2 +053000 BAIL-OUT. SQ2154.2 +053100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2154.2 +053200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2154.2 +053300 BAIL-OUT-WRITE. SQ2154.2 +053400 MOVE CORRECT-A TO XXCORRECT. SQ2154.2 +053500 MOVE COMPUTED-A TO XXCOMPUTED. SQ2154.2 +053600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2154.2 +053700 MOVE XXINFO TO DUMMY-RECORD. SQ2154.2 +053800 PERFORM WRITE-LINE 2 TIMES. SQ2154.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2154.2 +054000 BAIL-OUT-EX. SQ2154.2 +054100 EXIT. SQ2154.2 +054200 CCVS1-EXIT. SQ2154.2 +054300 EXIT. SQ2154.2 +054400* SQ2154.2 +054500**************************************************************** SQ2154.2 +054600* * SQ2154.2 +054700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2154.2 +054800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2154.2 +054900* * SQ2154.2 +055000**************************************************************** SQ2154.2 +055100* SQ2154.2 +055200 SECT-SQ215A-0001 SECTION. SQ2154.2 +055300 WRITE-INIT-GF-01. SQ2154.2 +055400* SQ2154.2 +055500* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT WITH LOCK. SQ2154.2 +055600* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ2154.2 +055700* SQ2154.2 +055800 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2154.2 +055900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2154.2 +056000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2154.2 +056100 MOVE 120 TO XRECORD-LENGTH (1). SQ2154.2 +056200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2154.2 +056300 MOVE 1 TO XBLOCK-SIZE (1). SQ2154.2 +056400 MOVE 1 TO RECORDS-IN-FILE (1). SQ2154.2 +056500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2154.2 +056600 MOVE "S" TO XLABEL-TYPE (1). SQ2154.2 +056700 MOVE 1 TO XRECORD-NUMBER (1). SQ2154.2 +056800* SQ2154.2 +056900 WRITE-OPEN-01. SQ2154.2 +057000 MOVE 1 TO REC-CT. SQ2154.2 +057100 MOVE "WRITE-OPEN-01" TO PAR-NAME. SQ2154.2 +057200 MOVE "OPEN OUTPUT - NEW FILE" TO FEATURE. SQ2154.2 +057300 MOVE "**" TO SQ-FS1-STATUS. SQ2154.2 +057400 OPEN OUTPUT SQ-FS1. SQ2154.2 +057500 IF SQ-FS1-STATUS = "00" SQ2154.2 +057600 PERFORM PASS SQ2154.2 +057700 ELSE SQ2154.2 +057800 MOVE "00" TO CORRECT-A SQ2154.2 +057900 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2154.2 +058000 MOVE "FILE OPEN FAILED, FURTHER TESTS ABANDONED" SQ2154.2 +058100 TO RE-MARK SQ2154.2 +058200 MOVE "VII-3, VII-40, FILE STATUS" TO ANSI-REFERENCE SQ2154.2 +058300 PERFORM FAIL SQ2154.2 +058400 GO TO CCVS-EXIT SQ2154.2 +058500 END-IF. SQ2154.2 +058600* SQ2154.2 +058700* WRITE A SINGLE RECORD TO THE FILE SQ2154.2 +058800* SQ2154.2 +058900 WRITE-INIT-01. SQ2154.2 +059000 MOVE 1 TO REC-CT. SQ2154.2 +059100 MOVE "WRITE-TEST-01" TO PAR-NAME SQ2154.2 +059200 MOVE "SEQUENTIAL WRITE" TO FEATURE. SQ2154.2 +059300 WRITE-TEST-01-01. SQ2154.2 +059400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2154.2 +059500 WRITE SQ-FS1R1-F-G-120. SQ2154.2 +059600 IF SQ-FS1-STATUS = "00" SQ2154.2 +059700 PERFORM PASS SQ2154.2 +059800 ELSE SQ2154.2 +059900 MOVE "00" TO CORRECT-A SQ2154.2 +060000 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2154.2 +060100 MOVE "WRITING FAILED, FURTHER TESTS ABANDONED" SQ2154.2 +060200 TO RE-MARK SQ2154.2 +060300 MOVE "VII-3, VII-53, FILE STATUS" TO ANSI-REFERENCE SQ2154.2 +060400 PERFORM FAIL SQ2154.2 +060500 GO TO CCVS-EXIT SQ2154.2 +060600 END-IF. SQ2154.2 +060700* SQ2154.2 +060800* CLOSE THE FILE WITH LOCK, SO IT SHOULD NOT REOPEN SQ2154.2 +060900* SQ2154.2 +061000 CLOSE-INIT-01. SQ2154.2 +061100 MOVE 1 TO REC-CT. SQ2154.2 +061200 MOVE "CLOSE-TEST-01" TO PAR-NAME. SQ2154.2 +061300 MOVE "CLOSE WITH LOCK" TO FEATURE. SQ2154.2 +061400 MOVE "**" TO SQ-FS1-STATUS. SQ2154.2 +061500 CLOSE-TEST-01. SQ2154.2 +061600 CLOSE SQ-FS1 WITH LOCK. SQ2154.2 +061700 IF SQ-FS1-STATUS = "00" SQ2154.2 +061800 PERFORM PASS SQ2154.2 +061900 ELSE SQ2154.2 +062000 MOVE "00" TO CORRECT-A SQ2154.2 +062100 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2154.2 +062200 MOVE "CLOSE WITH LOCK FAILED, FURTHER TESTS ABANDONED" SQ2154.2 +062300 TO RE-MARK SQ2154.2 +062400 MOVE "VII-3, VII-38, FILE STATUS" TO ANSI-REFERENCE SQ2154.2 +062500 PERFORM FAIL SQ2154.2 +062600 GO TO CCVS-EXIT SQ2154.2 +062700 END-IF. SQ2154.2 +062800* SQ2154.2 +062900* HAVING LOCKED THE FILE, WE NOW TRY TO REOPEN IT. SQ2154.2 +063000* THE TEST PASSES IF THE FILE CANNOT BE OPENED AND SQ2154.2 +063100* THE APPROPRIATE I-O STATUS VALUE IS RETURNED. SQ2154.2 +063200* AN IMPLEMENTATION MAY TERMINATE EXECUTION OF A SQ2154.2 +063300* PROGRAM WHICH ATTEMPTS TO REOPEN A LOCKED FILE, SQ2154.2 +063400* OR MAY RETURN CONTROL TO THE STATEMENT FOLLOWING SQ2154.2 +063500* THE OPEN STATEMENT. SQ2154.2 +063600* SQ2154.2 +063700 OPEN-INIT-01. SQ2154.2 +063800* SQ2154.2 +063900 MOVE 1 TO REC-CT. SQ2154.2 +064000 MOVE "OPEN-TEST-01" TO PAR-NAME. SQ2154.2 +064100 MOVE "OPEN AFTER LOCK" TO FEATURE. SQ2154.2 +064200 MOVE "**" TO SQ-FS1-STATUS. SQ2154.2 +064300 OPEN-TEST-01. SQ2154.2 +064400 OPEN OUTPUT SQ-FS1. SQ2154.2 +064500* SQ2154.2 +064600 CCVS-EXIT SECTION. SQ2154.2 +064700 CCVS-999999. SQ2154.2 +064800 GO TO CLOSE-FILES. SQ2154.2 diff --git a/tests/cobol85/SQ/SQ216A.CBL b/tests/cobol85/SQ/SQ216A.CBL new file mode 100755 index 00000000..9e5a7e81 --- /dev/null +++ b/tests/cobol85/SQ/SQ216A.CBL @@ -0,0 +1,608 @@ +000100 IDENTIFICATION DIVISION. SQ2164.2 +000200 PROGRAM-ID. SQ2164.2 +000300 SQ216A. SQ2164.2 +000400**************************************************************** SQ2164.2 +000500* * SQ2164.2 +000600* VALIDATION FOR:- * SQ2164.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2164.2 +000800* * SQ2164.2 +000900* CREATION DATE / VALIDATION DATE * SQ2164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2164.2 +001100* * SQ2164.2 +001200* THIS ROUTINE TESTS THE CLAUSE: SQ2164.2 +001300* PADDING CHARACTER IS "9" (LITERAL). SQ2164.2 +001400* SQ2164.2 +001500* THE ROUTINE SQ216A CREATES A TAPE FILE WHICH HAS 750 FIXESQ2164.2 +001600* LENGTH RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN SQ2164.2 +001700* INPUT FILE. THE FILE IS READ AND FIELDS IN THE INPUT RECORDSSQ2164.2 +001800* ARE COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDSSQ2164.2 +001900* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED SQ2164.2 +002000* AGAIN AS AN INPUT FILE. FOUR READ FORMAT OPTIONS ARE USED SQ2164.2 +002100* TO READ THE FILE AND FIELDS IN THE RECORDS ARE VERIFIED. SQ2164.2 +002200* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR SQ2164.2 +002300* LEVEL TWO PADDING CHARCTER IS "9". SQ2164.2 +002400* SQ2164.2 +002500* THE LAST 9 RECORDS MUST BE FILLED WITH THE PADDING CHARACTER SQ2164.2 +002600* "9". SQ2164.2 +002700* SQ2164.2 +002800 ENVIRONMENT DIVISION. SQ2164.2 +002900 CONFIGURATION SECTION. SQ2164.2 +003000 SOURCE-COMPUTER. SQ2164.2 +003100 Linux. SQ2164.2 +003200 OBJECT-COMPUTER. SQ2164.2 +003300 Linux. SQ2164.2 +003400 INPUT-OUTPUT SECTION. SQ2164.2 +003500 FILE-CONTROL. SQ2164.2 +003600*P SELECT RAW-DATA ASSIGN TO SQ2164.2 +003700*P "XXXXX062" SQ2164.2 +003800*P ORGANIZATION IS INDEXED SQ2164.2 +003900*P ACCESS MODE IS RANDOM SQ2164.2 +004000*P RECORD KEY IS RAW-DATA-KEY. SQ2164.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ2164.2 +004200 "report.log". SQ2164.2 +004300 SELECT SQ-FS1 ASSIGN TO SQ2164.2 +004400 "XXXXX001" SQ2164.2 +004500 ORGANIZATION IS SEQUENTIAL SQ2164.2 +004600 PADDING CHARACTER IS "9" SQ2164.2 +004700 ACCESS MODE IS SEQUENTIAL. SQ2164.2 +004800 DATA DIVISION. SQ2164.2 +004900 FILE SECTION. SQ2164.2 +005000*P SQ2164.2 +005100*PD RAW-DATA. SQ2164.2 +005200*P SQ2164.2 +005300*P1 RAW-DATA-SATZ. SQ2164.2 +005400*P 05 RAW-DATA-KEY PIC X(6). SQ2164.2 +005500*P 05 C-DATE PIC 9(6). SQ2164.2 +005600*P 05 C-TIME PIC 9(8). SQ2164.2 +005700*P 05 C-NO-OF-TESTS PIC 99. SQ2164.2 +005800*P 05 C-OK PIC 999. SQ2164.2 +005900*P 05 C-ALL PIC 999. SQ2164.2 +006000*P 05 C-FAIL PIC 999. SQ2164.2 +006100*P 05 C-DELETED PIC 999. SQ2164.2 +006200*P 05 C-INSPECT PIC 999. SQ2164.2 +006300*P 05 C-NOTE PIC X(13). SQ2164.2 +006400*P 05 C-INDENT PIC X. SQ2164.2 +006500*P 05 C-ABORT PIC X(8). SQ2164.2 +006600 FD PRINT-FILE SQ2164.2 +006700*C LABEL RECORDS SQ2164.2 +006800*C OMITTED SQ2164.2 +006900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2164.2 +007000 . SQ2164.2 +007100 01 PRINT-REC PICTURE X(120). SQ2164.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2164.2 +007300 FD SQ-FS1 SQ2164.2 +007400*C LABEL RECORD STANDARD SQ2164.2 +007500 RECORD CONTAINS 120 CHARACTERS SQ2164.2 +007600 BLOCK CONTAINS 13 RECORDS. SQ2164.2 +007700 01 SQ-FS1R1-F-G-120. SQ2164.2 +007800 02 FILLER PIC X(120). SQ2164.2 +007900 WORKING-STORAGE SECTION. SQ2164.2 +008000 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ2164.2 +008100 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ2164.2 +008200 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ2164.2 +008300 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ2164.2 +008400 01 FILE-RECORD-INFORMATION-REC. SQ2164.2 +008500 03 FILE-RECORD-INFO-SKELETON. SQ2164.2 +008600 05 FILLER PICTURE X(48) VALUE SQ2164.2 +008700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2164.2 +008800 05 FILLER PICTURE X(46) VALUE SQ2164.2 +008900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2164.2 +009000 05 FILLER PICTURE X(26) VALUE SQ2164.2 +009100 ",LFIL=000000,ORG= ,LBLR= ". SQ2164.2 +009200 05 FILLER PICTURE X(37) VALUE SQ2164.2 +009300 ",RECKEY= ". SQ2164.2 +009400 05 FILLER PICTURE X(38) VALUE SQ2164.2 +009500 ",ALTKEY1= ". SQ2164.2 +009600 05 FILLER PICTURE X(38) VALUE SQ2164.2 +009700 ",ALTKEY2= ". SQ2164.2 +009800 05 FILLER PICTURE X(7) VALUE SPACE.SQ2164.2 +009900 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2164.2 +010000 05 FILE-RECORD-INFO-P1-120. SQ2164.2 +010100 07 FILLER PIC X(5). SQ2164.2 +010200 07 XFILE-NAME PIC X(6). SQ2164.2 +010300 07 FILLER PIC X(8). SQ2164.2 +010400 07 XRECORD-NAME PIC X(6). SQ2164.2 +010500 07 FILLER PIC X(1). SQ2164.2 +010600 07 REELUNIT-NUMBER PIC 9(1). SQ2164.2 +010700 07 FILLER PIC X(7). SQ2164.2 +010800 07 XRECORD-NUMBER PIC 9(6). SQ2164.2 +010900 07 FILLER PIC X(6). SQ2164.2 +011000 07 UPDATE-NUMBER PIC 9(2). SQ2164.2 +011100 07 FILLER PIC X(5). SQ2164.2 +011200 07 ODO-NUMBER PIC 9(4). SQ2164.2 +011300 07 FILLER PIC X(5). SQ2164.2 +011400 07 XPROGRAM-NAME PIC X(5). SQ2164.2 +011500 07 FILLER PIC X(7). SQ2164.2 +011600 07 XRECORD-LENGTH PIC 9(6). SQ2164.2 +011700 07 FILLER PIC X(7). SQ2164.2 +011800 07 CHARS-OR-RECORDS PIC X(2). SQ2164.2 +011900 07 FILLER PIC X(1). SQ2164.2 +012000 07 XBLOCK-SIZE PIC 9(4). SQ2164.2 +012100 07 FILLER PIC X(6). SQ2164.2 +012200 07 RECORDS-IN-FILE PIC 9(6). SQ2164.2 +012300 07 FILLER PIC X(5). SQ2164.2 +012400 07 XFILE-ORGANIZATION PIC X(2). SQ2164.2 +012500 07 FILLER PIC X(6). SQ2164.2 +012600 07 XLABEL-TYPE PIC X(1). SQ2164.2 +012700 05 FILE-RECORD-INFO-P121-240. SQ2164.2 +012800 07 FILLER PIC X(8). SQ2164.2 +012900 07 XRECORD-KEY PIC X(29). SQ2164.2 +013000 07 FILLER PIC X(9). SQ2164.2 +013100 07 ALTERNATE-KEY1 PIC X(29). SQ2164.2 +013200 07 FILLER PIC X(9). SQ2164.2 +013300 07 ALTERNATE-KEY2 PIC X(29). SQ2164.2 +013400 07 FILLER PIC X(7). SQ2164.2 +013500 01 TEST-RESULTS. SQ2164.2 +013600 02 FILLER PICTURE X VALUE SPACE. SQ2164.2 +013700 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2164.2 +013800 02 FILLER PICTURE X VALUE SPACE. SQ2164.2 +013900 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2164.2 +014000 02 FILLER PICTURE X VALUE SPACE. SQ2164.2 +014100 02 PAR-NAME. SQ2164.2 +014200 03 FILLER PICTURE X(12) VALUE SPACE. SQ2164.2 +014300 03 PARDOT-X PICTURE X VALUE SPACE. SQ2164.2 +014400 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2164.2 +014500 03 FILLER PIC X(5) VALUE SPACE. SQ2164.2 +014600 02 FILLER PIC X(10) VALUE SPACE. SQ2164.2 +014700 02 RE-MARK PIC X(61). SQ2164.2 +014800 01 TEST-COMPUTED. SQ2164.2 +014900 02 FILLER PIC X(30) VALUE SPACE. SQ2164.2 +015000 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2164.2 +015100 02 COMPUTED-X. SQ2164.2 +015200 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2164.2 +015300 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2164.2 +015400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2164.2 +015500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2164.2 +015600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2164.2 +015700 03 CM-18V0 REDEFINES COMPUTED-A. SQ2164.2 +015800 04 COMPUTED-18V0 PICTURE -9(18). SQ2164.2 +015900 04 FILLER PICTURE X. SQ2164.2 +016000 03 FILLER PIC X(50) VALUE SPACE. SQ2164.2 +016100 01 TEST-CORRECT. SQ2164.2 +016200 02 FILLER PIC X(30) VALUE SPACE. SQ2164.2 +016300 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2164.2 +016400 02 CORRECT-X. SQ2164.2 +016500 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2164.2 +016600 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2164.2 +016700 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2164.2 +016800 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2164.2 +016900 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2164.2 +017000 03 CR-18V0 REDEFINES CORRECT-A. SQ2164.2 +017100 04 CORRECT-18V0 PICTURE -9(18). SQ2164.2 +017200 04 FILLER PICTURE X. SQ2164.2 +017300 03 FILLER PIC X(50) VALUE SPACE. SQ2164.2 +017400 01 CCVS-C-1. SQ2164.2 +017500 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2164.2 +017600- "SS PARAGRAPH-NAME SQ2164.2 +017700- " REMARKS". SQ2164.2 +017800 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2164.2 +017900 01 CCVS-C-2. SQ2164.2 +018000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2164.2 +018100 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2164.2 +018200 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2164.2 +018300 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2164.2 +018400 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2164.2 +018500 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2164.2 +018600 01 REC-CT PICTURE 99 VALUE ZERO. SQ2164.2 +018700 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2164.2 +018800 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2164.2 +018900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2164.2 +019000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2164.2 +019100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2164.2 +019200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2164.2 +019300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2164.2 +019400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2164.2 +019500 01 CCVS-H-1. SQ2164.2 +019600 02 FILLER PICTURE X(27) VALUE SPACE. SQ2164.2 +019700 02 FILLER PICTURE X(67) VALUE SQ2164.2 +019800 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2164.2 +019900- " SYSTEM". SQ2164.2 +020000 02 FILLER PICTURE X(26) VALUE SPACE. SQ2164.2 +020100 01 CCVS-H-2. SQ2164.2 +020200 02 FILLER PICTURE X(52) VALUE IS SQ2164.2 +020300 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2164.2 +020400 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2164.2 +020500 02 TEST-ID PICTURE IS X(9). SQ2164.2 +020600 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2164.2 +020700 01 CCVS-H-3. SQ2164.2 +020800 02 FILLER PICTURE X(34) VALUE SQ2164.2 +020900 " FOR OFFICIAL USE ONLY ". SQ2164.2 +021000 02 FILLER PICTURE X(58) VALUE SQ2164.2 +021100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2164.2 +021200 02 FILLER PICTURE X(28) VALUE SQ2164.2 +021300 " COPYRIGHT 1985 ". SQ2164.2 +021400 01 CCVS-E-1. SQ2164.2 +021500 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2164.2 +021600 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2164.2 +021700 02 ID-AGAIN PICTURE IS X(9). SQ2164.2 +021800 02 FILLER PICTURE X(45) VALUE IS SQ2164.2 +021900 " NTIS DISTRIBUTION COBOL 85". SQ2164.2 +022000 01 CCVS-E-2. SQ2164.2 +022100 02 FILLER PICTURE X(31) VALUE SQ2164.2 +022200 SPACE. SQ2164.2 +022300 02 FILLER PICTURE X(21) VALUE SPACE. SQ2164.2 +022400 02 CCVS-E-2-2. SQ2164.2 +022500 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2164.2 +022600 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2164.2 +022700 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2164.2 +022800 01 CCVS-E-3. SQ2164.2 +022900 02 FILLER PICTURE X(22) VALUE SQ2164.2 +023000 " FOR OFFICIAL USE ONLY". SQ2164.2 +023100 02 FILLER PICTURE X(12) VALUE SPACE. SQ2164.2 +023200 02 FILLER PICTURE X(58) VALUE SQ2164.2 +023300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2164.2 +023400 02 FILLER PICTURE X(13) VALUE SPACE. SQ2164.2 +023500 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2164.2 +023600 01 CCVS-E-4. SQ2164.2 +023700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2164.2 +023800 02 FILLER PIC XXXX VALUE " OF ". SQ2164.2 +023900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2164.2 +024000 02 FILLER PIC X(40) VALUE SQ2164.2 +024100 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2164.2 +024200 01 XXINFO. SQ2164.2 +024300 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2164.2 +024400 02 INFO-TEXT. SQ2164.2 +024500 04 FILLER PIC X(20) VALUE SPACE. SQ2164.2 +024600 04 XXCOMPUTED PIC X(20). SQ2164.2 +024700 04 FILLER PIC X(5) VALUE SPACE. SQ2164.2 +024800 04 XXCORRECT PIC X(20). SQ2164.2 +024900 01 HYPHEN-LINE. SQ2164.2 +025000 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2164.2 +025100 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2164.2 +025200- "*****************************************". SQ2164.2 +025300 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2164.2 +025400- "******************************". SQ2164.2 +025500 01 CCVS-PGM-ID PIC X(6) VALUE SQ2164.2 +025600 "SQ216A". SQ2164.2 +025700 PROCEDURE DIVISION. SQ2164.2 +025800 CCVS1 SECTION. SQ2164.2 +025900 OPEN-FILES. SQ2164.2 +026000*P OPEN I-O RAW-DATA. SQ2164.2 +026100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2164.2 +026200*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2164.2 +026300*P MOVE "ABORTED " TO C-ABORT. SQ2164.2 +026400*P ADD 1 TO C-NO-OF-TESTS. SQ2164.2 +026500*P ACCEPT C-DATE FROM DATE. SQ2164.2 +026600*P ACCEPT C-TIME FROM TIME. SQ2164.2 +026700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2164.2 +026800*PND-E-1. SQ2164.2 +026900*P CLOSE RAW-DATA. SQ2164.2 +027000 OPEN OUTPUT PRINT-FILE. SQ2164.2 +027100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2164.2 +027200 MOVE SPACE TO TEST-RESULTS. SQ2164.2 +027300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2164.2 +027400 MOVE ZERO TO REC-SKL-SUB. SQ2164.2 +027500 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2164.2 +027600 CCVS-INIT-FILE. SQ2164.2 +027700 ADD 1 TO REC-SKL-SUB. SQ2164.2 +027800 MOVE FILE-RECORD-INFO-SKELETON TO SQ2164.2 +027900 FILE-RECORD-INFO (REC-SKL-SUB). SQ2164.2 +028000 CCVS-INIT-EXIT. SQ2164.2 +028100 GO TO CCVS1-EXIT. SQ2164.2 +028200 CLOSE-FILES. SQ2164.2 +028300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2164.2 +028400*P OPEN I-O RAW-DATA. SQ2164.2 +028500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2164.2 +028600*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2164.2 +028700*P MOVE "OK. " TO C-ABORT. SQ2164.2 +028800*P MOVE PASS-COUNTER TO C-OK. SQ2164.2 +028900*P MOVE ERROR-HOLD TO C-ALL. SQ2164.2 +029000*P MOVE ERROR-COUNTER TO C-FAIL. SQ2164.2 +029100*P MOVE DELETE-CNT TO C-DELETED. SQ2164.2 +029200*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2164.2 +029300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2164.2 +029400*PND-E-2. SQ2164.2 +029500*P CLOSE RAW-DATA. SQ2164.2 +029600 TERMINATE-CCVS. SQ2164.2 +029700*S EXIT PROGRAM. SQ2164.2 +029800*SERMINATE-CALL. SQ2164.2 +029900 STOP RUN. SQ2164.2 +030000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2164.2 +030100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2164.2 +030200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2164.2 +030300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2164.2 +030400 MOVE "****TEST DELETED****" TO RE-MARK. SQ2164.2 +030500 PRINT-DETAIL. SQ2164.2 +030600 IF REC-CT NOT EQUAL TO ZERO SQ2164.2 +030700 MOVE "." TO PARDOT-X SQ2164.2 +030800 MOVE REC-CT TO DOTVALUE. SQ2164.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2164.2 +031000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2164.2 +031100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2164.2 +031200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2164.2 +031300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2164.2 +031400 MOVE SPACE TO CORRECT-X. SQ2164.2 +031500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2164.2 +031600 MOVE SPACE TO RE-MARK. SQ2164.2 +031700 HEAD-ROUTINE. SQ2164.2 +031800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +031900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2164.2 +032000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2164.2 +032100 COLUMN-NAMES-ROUTINE. SQ2164.2 +032200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +032300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +032400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +032500 END-ROUTINE. SQ2164.2 +032600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2164.2 +032700 END-RTN-EXIT. SQ2164.2 +032800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +032900 END-ROUTINE-1. SQ2164.2 +033000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2164.2 +033100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2164.2 +033200 ADD PASS-COUNTER TO ERROR-HOLD. SQ2164.2 +033300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2164.2 +033400 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2164.2 +033500 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2164.2 +033600 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2164.2 +033700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2164.2 +033800 END-ROUTINE-12. SQ2164.2 +033900 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2164.2 +034000 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2164.2 +034100 MOVE "NO " TO ERROR-TOTAL SQ2164.2 +034200 ELSE SQ2164.2 +034300 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2164.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2164.2 +034500 PERFORM WRITE-LINE. SQ2164.2 +034600 END-ROUTINE-13. SQ2164.2 +034700 IF DELETE-CNT IS EQUAL TO ZERO SQ2164.2 +034800 MOVE "NO " TO ERROR-TOTAL ELSE SQ2164.2 +034900 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2164.2 +035000 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2164.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +035200 IF INSPECT-COUNTER EQUAL TO ZERO SQ2164.2 +035300 MOVE "NO " TO ERROR-TOTAL SQ2164.2 +035400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2164.2 +035500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2164.2 +035600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +035700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2164.2 +035800 WRITE-LINE. SQ2164.2 +035900 ADD 1 TO RECORD-COUNT. SQ2164.2 +036000 IF RECORD-COUNT GREATER 50 SQ2164.2 +036100 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2164.2 +036200 MOVE SPACE TO DUMMY-RECORD SQ2164.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2164.2 +036400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2164.2 +036500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2164.2 +036600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2164.2 +036700 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2164.2 +036800 MOVE ZERO TO RECORD-COUNT. SQ2164.2 +036900 PERFORM WRT-LN. SQ2164.2 +037000 WRT-LN. SQ2164.2 +037100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2164.2 +037200 MOVE SPACE TO DUMMY-RECORD. SQ2164.2 +037300 BLANK-LINE-PRINT. SQ2164.2 +037400 PERFORM WRT-LN. SQ2164.2 +037500 FAIL-ROUTINE. SQ2164.2 +037600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2164.2 +037700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2164.2 +037800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2164.2 +037900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +038000 GO TO FAIL-ROUTINE-EX. SQ2164.2 +038100 FAIL-ROUTINE-WRITE. SQ2164.2 +038200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2164.2 +038300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +038400 FAIL-ROUTINE-EX. EXIT. SQ2164.2 +038500 BAIL-OUT. SQ2164.2 +038600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2164.2 +038700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2164.2 +038800 BAIL-OUT-WRITE. SQ2164.2 +038900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2164.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2164.2 +039100 BAIL-OUT-EX. EXIT. SQ2164.2 +039200 CCVS1-EXIT. SQ2164.2 +039300 EXIT. SQ2164.2 +039400 SECT-SQ216A-0001 SECTION. SQ2164.2 +039500 WRITE-INIT-GF-01. SQ2164.2 +039600 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2164.2 +039700 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2164.2 +039800 MOVE "SQ216" TO XPROGRAM-NAME (1). SQ2164.2 +039900 MOVE 000120 TO XRECORD-LENGTH (1). SQ2164.2 +040000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2164.2 +040100 MOVE 0001 TO XBLOCK-SIZE (1). SQ2164.2 +040200 MOVE 000750 TO RECORDS-IN-FILE (1). SQ2164.2 +040300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2164.2 +040400 MOVE "S" TO XLABEL-TYPE (1). SQ2164.2 +040500 MOVE 000001 TO XRECORD-NUMBER (1). SQ2164.2 +040600 OPEN OUTPUT SQ-FS1. SQ2164.2 +040700 WRITE-TEST-GF-01. SQ2164.2 +040800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2164.2 +040900 WRITE SQ-FS1R1-F-G-120. SQ2164.2 +041000 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2164.2 +041100 GO TO WRITE-WRITE-GF-01. SQ2164.2 +041200 ADD 1 TO XRECORD-NUMBER (1). SQ2164.2 +041300 GO TO WRITE-TEST-GF-01. SQ2164.2 +041400 WRITE-WRITE-GF-01. SQ2164.2 +041500 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2164.2 +041600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2164.2 +041700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2164.2 +041800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2164.2 +041900 PERFORM PASS. SQ2164.2 +042000 PERFORM PRINT-DETAIL. SQ2164.2 +042100 CLOSE SQ-FS1. SQ2164.2 +042200* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ2164.2 +042300* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ2164.2 +042400 READ-INIT-F1-01. SQ2164.2 +042500 MOVE ZERO TO WRK-CS-09V00. SQ2164.2 +042600* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ2164.2 +042700* WRITE-TEST-GF-01. SQ2164.2 +042800 OPEN INPUT SQ-FS1. SQ2164.2 +042900 READ-TEST-F1-01. SQ2164.2 +043000 READ SQ-FS1 SQ2164.2 +043100 AT END GO TO READ-TEST-F1-01-1. SQ2164.2 +043200 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2164.2 +043300 ADD 1 TO WRK-CS-09V00. SQ2164.2 +043400 IF WRK-CS-09V00 GREATER THAN 750 SQ2164.2 +043500 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2164.2 +043600 GO TO READ-FAIL-F1-01. SQ2164.2 +043700 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ2164.2 +043800 ADD 1 TO RECORDS-IN-ERROR SQ2164.2 +043900 GO TO READ-TEST-F1-01. SQ2164.2 +044000 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2164.2 +044100 ADD 1 TO RECORDS-IN-ERROR SQ2164.2 +044200 GO TO READ-TEST-F1-01. SQ2164.2 +044300 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2164.2 +044400 ADD 1 TO RECORDS-IN-ERROR. SQ2164.2 +044500 GO TO READ-TEST-F1-01. SQ2164.2 +044600 READ-TEST-F1-01-1. SQ2164.2 +044700 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2164.2 +044800 GO TO READ-PASS-F1-01. SQ2164.2 +044900 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ2164.2 +045000 READ-FAIL-F1-01. SQ2164.2 +045100 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2164.2 +045200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2164.2 +045300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2164.2 +045400 PERFORM FAIL. SQ2164.2 +045500 GO TO READ-WRITE-F1-01. SQ2164.2 +045600 READ-PASS-F1-01. SQ2164.2 +045700 PERFORM PASS. SQ2164.2 +045800 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2164.2 +045900 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ2164.2 +046000 READ-WRITE-F1-01. SQ2164.2 +046100 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2164.2 +046200 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2164.2 +046300 PERFORM PRINT-DETAIL. SQ2164.2 +046400 READ-CLOSE-F1-01. SQ2164.2 +046500 CLOSE SQ-FS1. SQ2164.2 +046600 READ-INIT-F1-02. SQ2164.2 +046700 MOVE ZERO TO WRK-CS-09V00. SQ2164.2 +046800 MOVE ZERO TO RECORDS-IN-ERROR. SQ2164.2 +046900 OPEN INPUT SQ-FS1. SQ2164.2 +047000* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ2164.2 +047100* IN THIS SERIES OF TESTS. SQ2164.2 +047200 MOVE "LEV 2 PADDING CHARS " TO FEATURE. SQ2164.2 +047300 MOVE "READ...RECORD AT END ..." TO RE-MARK. SQ2164.2 +047400 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2164.2 +047500 MOVE ZERO TO ERROR-FLAG. SQ2164.2 +047600 READ-TEST-F1-02. SQ2164.2 +047700 READ SQ-FS1 RECORD AT END SQ2164.2 +047800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2164.2 +047900 MOVE 1 TO EOF-FLAG SQ2164.2 +048000 GO TO READ-FAIL-F1-02. SQ2164.2 +048100 PERFORM RECORD-CHECK. SQ2164.2 +048200 IF WRK-CS-09V00 EQUAL TO 200 SQ2164.2 +048300 GO TO READ-TEST-F1-02-1. SQ2164.2 +048400 GO TO READ-TEST-F1-02. SQ2164.2 +048500 RECORD-CHECK. SQ2164.2 +048600 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2164.2 +048700 ADD 1 TO WRK-CS-09V00. SQ2164.2 +048800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ2164.2 +048900 ADD 1 TO RECORDS-IN-ERROR SQ2164.2 +049000 MOVE 1 TO ERROR-FLAG. SQ2164.2 +049100 READ-TEST-F1-02-1. SQ2164.2 +049200 IF ERROR-FLAG EQUAL TO ZERO SQ2164.2 +049300 GO TO READ-PASS-F1-02. SQ2164.2 +049400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2164.2 +049500 READ-FAIL-F1-02. SQ2164.2 +049600 PERFORM FAIL. SQ2164.2 +049700 GO TO READ-WRITE-F1-02. SQ2164.2 +049800 READ-PASS-F1-02. SQ2164.2 +049900 PERFORM PASS. SQ2164.2 +050000 READ-WRITE-F1-02. SQ2164.2 +050100 PERFORM PRINT-DETAIL. SQ2164.2 +050200 READ-INIT-F1-F1-03. SQ2164.2 +050300 IF EOF-FLAG EQUAL TO 1 SQ2164.2 +050400 GO TO READ-EOF-06. SQ2164.2 +050500 MOVE ZERO TO ERROR-FLAG. SQ2164.2 +050600 MOVE "READ...AT END..." TO RE-MARK. SQ2164.2 +050700 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2164.2 +050800 READ-TEST-F1-03. SQ2164.2 +050900 READ SQ-FS1 AT END SQ2164.2 +051000 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2164.2 +051100 MOVE 1 TO EOF-FLAG SQ2164.2 +051200 GO TO READ-FAIL-F1-03. SQ2164.2 +051300 PERFORM RECORD-CHECK. SQ2164.2 +051400 IF WRK-CS-09V00 EQUAL TO 400 SQ2164.2 +051500 GO TO READ-TEST-F1-03-1. SQ2164.2 +051600 GO TO READ-TEST-F1-03. SQ2164.2 +051700 READ-TEST-F1-03-1. SQ2164.2 +051800 IF ERROR-FLAG EQUAL TO ZERO SQ2164.2 +051900 GO TO READ-PASS-F1-03. SQ2164.2 +052000 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2164.2 +052100 READ-FAIL-F1-03. SQ2164.2 +052200 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2164.2 +052300 PERFORM FAIL. SQ2164.2 +052400 GO TO READ-WRITE-F1-03. SQ2164.2 +052500 READ-PASS-F1-03. SQ2164.2 +052600 PERFORM PASS. SQ2164.2 +052700 READ-WRITE-F1-03. SQ2164.2 +052800 PERFORM PRINT-DETAIL. SQ2164.2 +052900 READ-INIT-F1-04. SQ2164.2 +053000 IF EOF-FLAG EQUAL TO 1 SQ2164.2 +053100 GO TO READ-EOF-06. SQ2164.2 +053200 MOVE ZERO TO ERROR-FLAG. SQ2164.2 +053300 MOVE "READ...RECORD END..." TO RE-MARK. SQ2164.2 +053400 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2164.2 +053500 READ-TEST-F1-04. SQ2164.2 +053600 READ SQ-FS1 RECORD END SQ2164.2 +053700 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2164.2 +053800 MOVE 1 TO EOF-FLAG SQ2164.2 +053900 GO TO READ-FAIL-F1-04. SQ2164.2 +054000 PERFORM RECORD-CHECK. SQ2164.2 +054100 IF WRK-CS-09V00 EQUAL TO 600 SQ2164.2 +054200 GO TO READ-TEST-F1-04-1. SQ2164.2 +054300 GO TO READ-TEST-F1-04. SQ2164.2 +054400 READ-TEST-F1-04-1. SQ2164.2 +054500 IF ERROR-FLAG EQUAL TO ZERO SQ2164.2 +054600 GO TO READ-PASS-F1-04. SQ2164.2 +054700 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2164.2 +054800 READ-FAIL-F1-04. SQ2164.2 +054900 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2164.2 +055000 PERFORM FAIL. SQ2164.2 +055100 GO TO READ-WRITE-F1-04. SQ2164.2 +055200 READ-PASS-F1-04. SQ2164.2 +055300 PERFORM PASS. SQ2164.2 +055400 READ-WRITE-F1-04. SQ2164.2 +055500 PERFORM PRINT-DETAIL. SQ2164.2 +055600 READ-INIT-F1-05. SQ2164.2 +055700 IF EOF-FLAG EQUAL TO 1 SQ2164.2 +055800 GO TO READ-EOF-06. SQ2164.2 +055900 MOVE ZERO TO ERROR-FLAG. SQ2164.2 +056000 MOVE "READ...END..." TO RE-MARK. SQ2164.2 +056100 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2164.2 +056200 READ-TEST-F1-05. SQ2164.2 +056300 READ SQ-FS1 END GO TO READ-TEST-F1-05-1. SQ2164.2 +056400 PERFORM RECORD-CHECK. SQ2164.2 +056500 IF WRK-CS-09V00 GREATER THAN 750 SQ2164.2 +056600 GO TO READ-TEST-F1-05-1. SQ2164.2 +056700 GO TO READ-TEST-F1-05. SQ2164.2 +056800 READ-TEST-F1-05-1. SQ2164.2 +056900 IF ERROR-FLAG EQUAL TO ZERO SQ2164.2 +057000 GO TO READ-PASS-F1-05. SQ2164.2 +057100 READ-FAIL-F1-05. SQ2164.2 +057200 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2164.2 +057300 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2164.2 +057400 PERFORM FAIL. SQ2164.2 +057500 GO TO READ-WRITE-F1-05. SQ2164.2 +057600 READ-PASS-F1-05. SQ2164.2 +057700 PERFORM PASS. SQ2164.2 +057800 READ-WRITE-F1-05. SQ2164.2 +057900 PERFORM PRINT-DETAIL. SQ2164.2 +058000 READ-TEST-06. SQ2164.2 +058100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2164.2 +058200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2164.2 +058300 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK SQ2164.2 +058400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2164.2 +058500 GO TO READ-FAIL-06. SQ2164.2 +058600 IF WRK-CS-09V00 GREATER THAN 750 SQ2164.2 +058700 MOVE "MORE THAN 750 RECORDS; VII-12 PADDING CHARS" TO RE-MARKSQ2164.2 +058800 GO TO READ-FAIL-06. SQ2164.2 +058900 READ-PASS-06. SQ2164.2 +059000 PERFORM PASS. SQ2164.2 +059100 GO TO READ-WRITE-06. SQ2164.2 +059200 READ-EOF-06. SQ2164.2 +059300 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. SQ2164.2 +059400 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2164.2 +059500 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ2164.2 +059600 READ-FAIL-06. SQ2164.2 +059700 PERFORM FAIL. SQ2164.2 +059800 READ-WRITE-06. SQ2164.2 +059900 MOVE "READ-TEST-06 " TO PAR-NAME. SQ2164.2 +060000 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ2164.2 +060100 PERFORM PRINT-DETAIL. SQ2164.2 +060200 READ-CLOSE-003. SQ2164.2 +060300 CLOSE SQ-FS1. SQ2164.2 +060400 TERMINATE-ROUTINE. SQ2164.2 +060500 EXIT. SQ2164.2 +060600 CCVS-EXIT SECTION. SQ2164.2 +060700 CCVS-999999. SQ2164.2 +060800 GO TO CLOSE-FILES. SQ2164.2 diff --git a/tests/cobol85/SQ/SQ217A.CBL b/tests/cobol85/SQ/SQ217A.CBL new file mode 100755 index 00000000..e697ddb0 --- /dev/null +++ b/tests/cobol85/SQ/SQ217A.CBL @@ -0,0 +1,609 @@ +000100 IDENTIFICATION DIVISION. SQ2174.2 +000200 PROGRAM-ID. SQ2174.2 +000300 SQ217A. SQ2174.2 +000400**************************************************************** SQ2174.2 +000500* * SQ2174.2 +000600* VALIDATION FOR:- * SQ2174.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2174.2 +000800* * SQ2174.2 +000900* CREATION DATE / VALIDATION DATE * SQ2174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2174.2 +001100* * SQ2174.2 +001200* THIS ROUTINE TESTS THE CLAUSE: SQ2174.2 +001300* PADDING CHARACTER IS DATA-NAME-1 (VALUE "Z"). SQ2174.2 +001400* SQ2174.2 +001500* THE ROUTINE SQ217A CREATES A TAPE FILE WHICH HAS 750 FIXESQ2174.2 +001600* LENGTH RECORDS. THE FILE IS THEN CLOSED AND OPENED AS AN SQ2174.2 +001700* INPUT FILE. THE FILE IS READ AND FIELDS IN THE INPUT RECORDSSQ2174.2 +001800* ARE COMPARED TO THE VALUES WRITTEN TO ENSURE THAT THE RECORDSSQ2174.2 +001900* WERE PROCESSED CORRECTLY. THE FILE IS CLOSED AND OPENED SQ2174.2 +002000* AGAIN AS AN INPUT FILE. FOUR READ FORMAT OPTIONS ARE USED SQ2174.2 +002100* TO READ THE FILE AND FIELDS IN THE RECORDS ARE VERIFIED. SQ2174.2 +002200* THE OPEN, CLOSE, READ, AND WRITE STATEMENTS ARE TESTED FOR SQ2174.2 +002300* LEVEL TWO PADDING CHARCTER IS "Z". SQ2174.2 +002400* SQ2174.2 +002500* THE LAST 9 RECORDS MUST BE FILLED WITH THE PADDING CHARACTER SQ2174.2 +002600* PADDING-CHARACTER PIC X VALUE "Z". SQ2174.2 +002700* SQ2174.2 +002800 ENVIRONMENT DIVISION. SQ2174.2 +002900 CONFIGURATION SECTION. SQ2174.2 +003000 SOURCE-COMPUTER. SQ2174.2 +003100 Linux. SQ2174.2 +003200 OBJECT-COMPUTER. SQ2174.2 +003300 Linux. SQ2174.2 +003400 INPUT-OUTPUT SECTION. SQ2174.2 +003500 FILE-CONTROL. SQ2174.2 +003600*P SELECT RAW-DATA ASSIGN TO SQ2174.2 +003700*P "XXXXX062" SQ2174.2 +003800*P ORGANIZATION IS INDEXED SQ2174.2 +003900*P ACCESS MODE IS RANDOM SQ2174.2 +004000*P RECORD KEY IS RAW-DATA-KEY. SQ2174.2 +004100 SELECT PRINT-FILE ASSIGN TO SQ2174.2 +004200 "report.log". SQ2174.2 +004300 SELECT SQ-FS1 ASSIGN TO SQ2174.2 +004400 "XXXXX001" SQ2174.2 +004500 ORGANIZATION IS SEQUENTIAL SQ2174.2 +004600 PADDING PADDING-CHARACTER SQ2174.2 +004700 ACCESS MODE IS SEQUENTIAL. SQ2174.2 +004800 DATA DIVISION. SQ2174.2 +004900 FILE SECTION. SQ2174.2 +005000*P SQ2174.2 +005100*PD RAW-DATA. SQ2174.2 +005200*P SQ2174.2 +005300*P1 RAW-DATA-SATZ. SQ2174.2 +005400*P 05 RAW-DATA-KEY PIC X(6). SQ2174.2 +005500*P 05 C-DATE PIC 9(6). SQ2174.2 +005600*P 05 C-TIME PIC 9(8). SQ2174.2 +005700*P 05 C-NO-OF-TESTS PIC 99. SQ2174.2 +005800*P 05 C-OK PIC 999. SQ2174.2 +005900*P 05 C-ALL PIC 999. SQ2174.2 +006000*P 05 C-FAIL PIC 999. SQ2174.2 +006100*P 05 C-DELETED PIC 999. SQ2174.2 +006200*P 05 C-INSPECT PIC 999. SQ2174.2 +006300*P 05 C-NOTE PIC X(13). SQ2174.2 +006400*P 05 C-INDENT PIC X. SQ2174.2 +006500*P 05 C-ABORT PIC X(8). SQ2174.2 +006600 FD PRINT-FILE SQ2174.2 +006700*C LABEL RECORDS SQ2174.2 +006800*C OMITTED SQ2174.2 +006900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2174.2 +007000 . SQ2174.2 +007100 01 PRINT-REC PICTURE X(120). SQ2174.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2174.2 +007300 FD SQ-FS1 SQ2174.2 +007400*C LABEL RECORD STANDARD SQ2174.2 +007500 RECORD CONTAINS 120 CHARACTERS SQ2174.2 +007600 BLOCK CONTAINS 13 RECORDS. SQ2174.2 +007700 01 SQ-FS1R1-F-G-120. SQ2174.2 +007800 02 FILLER PIC X(120). SQ2174.2 +007900 WORKING-STORAGE SECTION. SQ2174.2 +008000 01 PADDING-CHARACTER PIC X VALUE "Z". SQ2174.2 +008100 01 WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO. SQ2174.2 +008200 01 RECORDS-IN-ERROR PIC S9(5) USAGE COMP VALUE ZERO. SQ2174.2 +008300 01 ERROR-FLAG PIC 9 VALUE ZERO. SQ2174.2 +008400 01 EOF-FLAG PICTURE 9 VALUE ZERO. SQ2174.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ2174.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ2174.2 +008700 05 FILLER PICTURE X(48) VALUE SQ2174.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2174.2 +008900 05 FILLER PICTURE X(46) VALUE SQ2174.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2174.2 +009100 05 FILLER PICTURE X(26) VALUE SQ2174.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ2174.2 +009300 05 FILLER PICTURE X(37) VALUE SQ2174.2 +009400 ",RECKEY= ". SQ2174.2 +009500 05 FILLER PICTURE X(38) VALUE SQ2174.2 +009600 ",ALTKEY1= ". SQ2174.2 +009700 05 FILLER PICTURE X(38) VALUE SQ2174.2 +009800 ",ALTKEY2= ". SQ2174.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2174.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2174.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ2174.2 +010200 07 FILLER PIC X(5). SQ2174.2 +010300 07 XFILE-NAME PIC X(6). SQ2174.2 +010400 07 FILLER PIC X(8). SQ2174.2 +010500 07 XRECORD-NAME PIC X(6). SQ2174.2 +010600 07 FILLER PIC X(1). SQ2174.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ2174.2 +010800 07 FILLER PIC X(7). SQ2174.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ2174.2 +011000 07 FILLER PIC X(6). SQ2174.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ2174.2 +011200 07 FILLER PIC X(5). SQ2174.2 +011300 07 ODO-NUMBER PIC 9(4). SQ2174.2 +011400 07 FILLER PIC X(5). SQ2174.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ2174.2 +011600 07 FILLER PIC X(7). SQ2174.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ2174.2 +011800 07 FILLER PIC X(7). SQ2174.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ2174.2 +012000 07 FILLER PIC X(1). SQ2174.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ2174.2 +012200 07 FILLER PIC X(6). SQ2174.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ2174.2 +012400 07 FILLER PIC X(5). SQ2174.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ2174.2 +012600 07 FILLER PIC X(6). SQ2174.2 +012700 07 XLABEL-TYPE PIC X(1). SQ2174.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ2174.2 +012900 07 FILLER PIC X(8). SQ2174.2 +013000 07 XRECORD-KEY PIC X(29). SQ2174.2 +013100 07 FILLER PIC X(9). SQ2174.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ2174.2 +013300 07 FILLER PIC X(9). SQ2174.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ2174.2 +013500 07 FILLER PIC X(7). SQ2174.2 +013600 01 TEST-RESULTS. SQ2174.2 +013700 02 FILLER PICTURE X VALUE SPACE. SQ2174.2 +013800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2174.2 +013900 02 FILLER PICTURE X VALUE SPACE. SQ2174.2 +014000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2174.2 +014100 02 FILLER PICTURE X VALUE SPACE. SQ2174.2 +014200 02 PAR-NAME. SQ2174.2 +014300 03 FILLER PICTURE X(12) VALUE SPACE. SQ2174.2 +014400 03 PARDOT-X PICTURE X VALUE SPACE. SQ2174.2 +014500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2174.2 +014600 03 FILLER PIC X(5) VALUE SPACE. SQ2174.2 +014700 02 FILLER PIC X(10) VALUE SPACE. SQ2174.2 +014800 02 RE-MARK PIC X(61). SQ2174.2 +014900 01 TEST-COMPUTED. SQ2174.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ2174.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2174.2 +015200 02 COMPUTED-X. SQ2174.2 +015300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2174.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2174.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2174.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2174.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2174.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2174.2 +015900 04 COMPUTED-18V0 PICTURE -9(18). SQ2174.2 +016000 04 FILLER PICTURE X. SQ2174.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ2174.2 +016200 01 TEST-CORRECT. SQ2174.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ2174.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2174.2 +016500 02 CORRECT-X. SQ2174.2 +016600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2174.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2174.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2174.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2174.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2174.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ2174.2 +017200 04 CORRECT-18V0 PICTURE -9(18). SQ2174.2 +017300 04 FILLER PICTURE X. SQ2174.2 +017400 03 FILLER PIC X(50) VALUE SPACE. SQ2174.2 +017500 01 CCVS-C-1. SQ2174.2 +017600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2174.2 +017700- "SS PARAGRAPH-NAME SQ2174.2 +017800- " REMARKS". SQ2174.2 +017900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2174.2 +018000 01 CCVS-C-2. SQ2174.2 +018100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2174.2 +018200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2174.2 +018300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2174.2 +018400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2174.2 +018500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2174.2 +018600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2174.2 +018700 01 REC-CT PICTURE 99 VALUE ZERO. SQ2174.2 +018800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2174.2 +018900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2174.2 +019000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2174.2 +019100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2174.2 +019200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2174.2 +019300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2174.2 +019400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2174.2 +019500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2174.2 +019600 01 CCVS-H-1. SQ2174.2 +019700 02 FILLER PICTURE X(27) VALUE SPACE. SQ2174.2 +019800 02 FILLER PICTURE X(67) VALUE SQ2174.2 +019900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2174.2 +020000- " SYSTEM". SQ2174.2 +020100 02 FILLER PICTURE X(26) VALUE SPACE. SQ2174.2 +020200 01 CCVS-H-2. SQ2174.2 +020300 02 FILLER PICTURE X(52) VALUE IS SQ2174.2 +020400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2174.2 +020500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2174.2 +020600 02 TEST-ID PICTURE IS X(9). SQ2174.2 +020700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2174.2 +020800 01 CCVS-H-3. SQ2174.2 +020900 02 FILLER PICTURE X(34) VALUE SQ2174.2 +021000 " FOR OFFICIAL USE ONLY ". SQ2174.2 +021100 02 FILLER PICTURE X(58) VALUE SQ2174.2 +021200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2174.2 +021300 02 FILLER PICTURE X(28) VALUE SQ2174.2 +021400 " COPYRIGHT 1985 ". SQ2174.2 +021500 01 CCVS-E-1. SQ2174.2 +021600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2174.2 +021700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2174.2 +021800 02 ID-AGAIN PICTURE IS X(9). SQ2174.2 +021900 02 FILLER PICTURE X(45) VALUE IS SQ2174.2 +022000 " NTIS DISTRIBUTION COBOL 85". SQ2174.2 +022100 01 CCVS-E-2. SQ2174.2 +022200 02 FILLER PICTURE X(31) VALUE SQ2174.2 +022300 SPACE. SQ2174.2 +022400 02 FILLER PICTURE X(21) VALUE SPACE. SQ2174.2 +022500 02 CCVS-E-2-2. SQ2174.2 +022600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2174.2 +022700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2174.2 +022800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2174.2 +022900 01 CCVS-E-3. SQ2174.2 +023000 02 FILLER PICTURE X(22) VALUE SQ2174.2 +023100 " FOR OFFICIAL USE ONLY". SQ2174.2 +023200 02 FILLER PICTURE X(12) VALUE SPACE. SQ2174.2 +023300 02 FILLER PICTURE X(58) VALUE SQ2174.2 +023400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2174.2 +023500 02 FILLER PICTURE X(13) VALUE SPACE. SQ2174.2 +023600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2174.2 +023700 01 CCVS-E-4. SQ2174.2 +023800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2174.2 +023900 02 FILLER PIC XXXX VALUE " OF ". SQ2174.2 +024000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2174.2 +024100 02 FILLER PIC X(40) VALUE SQ2174.2 +024200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2174.2 +024300 01 XXINFO. SQ2174.2 +024400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2174.2 +024500 02 INFO-TEXT. SQ2174.2 +024600 04 FILLER PIC X(20) VALUE SPACE. SQ2174.2 +024700 04 XXCOMPUTED PIC X(20). SQ2174.2 +024800 04 FILLER PIC X(5) VALUE SPACE. SQ2174.2 +024900 04 XXCORRECT PIC X(20). SQ2174.2 +025000 01 HYPHEN-LINE. SQ2174.2 +025100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2174.2 +025200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2174.2 +025300- "*****************************************". SQ2174.2 +025400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2174.2 +025500- "******************************". SQ2174.2 +025600 01 CCVS-PGM-ID PIC X(6) VALUE SQ2174.2 +025700 "SQ217A". SQ2174.2 +025800 PROCEDURE DIVISION. SQ2174.2 +025900 CCVS1 SECTION. SQ2174.2 +026000 OPEN-FILES. SQ2174.2 +026100*P OPEN I-O RAW-DATA. SQ2174.2 +026200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2174.2 +026300*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2174.2 +026400*P MOVE "ABORTED " TO C-ABORT. SQ2174.2 +026500*P ADD 1 TO C-NO-OF-TESTS. SQ2174.2 +026600*P ACCEPT C-DATE FROM DATE. SQ2174.2 +026700*P ACCEPT C-TIME FROM TIME. SQ2174.2 +026800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2174.2 +026900*PND-E-1. SQ2174.2 +027000*P CLOSE RAW-DATA. SQ2174.2 +027100 OPEN OUTPUT PRINT-FILE. SQ2174.2 +027200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2174.2 +027300 MOVE SPACE TO TEST-RESULTS. SQ2174.2 +027400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2174.2 +027500 MOVE ZERO TO REC-SKL-SUB. SQ2174.2 +027600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2174.2 +027700 CCVS-INIT-FILE. SQ2174.2 +027800 ADD 1 TO REC-SKL-SUB. SQ2174.2 +027900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2174.2 +028000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2174.2 +028100 CCVS-INIT-EXIT. SQ2174.2 +028200 GO TO CCVS1-EXIT. SQ2174.2 +028300 CLOSE-FILES. SQ2174.2 +028400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2174.2 +028500*P OPEN I-O RAW-DATA. SQ2174.2 +028600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2174.2 +028700*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2174.2 +028800*P MOVE "OK. " TO C-ABORT. SQ2174.2 +028900*P MOVE PASS-COUNTER TO C-OK. SQ2174.2 +029000*P MOVE ERROR-HOLD TO C-ALL. SQ2174.2 +029100*P MOVE ERROR-COUNTER TO C-FAIL. SQ2174.2 +029200*P MOVE DELETE-CNT TO C-DELETED. SQ2174.2 +029300*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2174.2 +029400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2174.2 +029500*PND-E-2. SQ2174.2 +029600*P CLOSE RAW-DATA. SQ2174.2 +029700 TERMINATE-CCVS. SQ2174.2 +029800*S EXIT PROGRAM. SQ2174.2 +029900*SERMINATE-CALL. SQ2174.2 +030000 STOP RUN. SQ2174.2 +030100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2174.2 +030200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2174.2 +030300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2174.2 +030400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2174.2 +030500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2174.2 +030600 PRINT-DETAIL. SQ2174.2 +030700 IF REC-CT NOT EQUAL TO ZERO SQ2174.2 +030800 MOVE "." TO PARDOT-X SQ2174.2 +030900 MOVE REC-CT TO DOTVALUE. SQ2174.2 +031000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2174.2 +031100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2174.2 +031200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2174.2 +031300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2174.2 +031400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2174.2 +031500 MOVE SPACE TO CORRECT-X. SQ2174.2 +031600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2174.2 +031700 MOVE SPACE TO RE-MARK. SQ2174.2 +031800 HEAD-ROUTINE. SQ2174.2 +031900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +032000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2174.2 +032100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2174.2 +032200 COLUMN-NAMES-ROUTINE. SQ2174.2 +032300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +032400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +032500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +032600 END-ROUTINE. SQ2174.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2174.2 +032800 END-RTN-EXIT. SQ2174.2 +032900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +033000 END-ROUTINE-1. SQ2174.2 +033100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2174.2 +033200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2174.2 +033300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2174.2 +033400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2174.2 +033500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2174.2 +033600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2174.2 +033700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2174.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2174.2 +033900 END-ROUTINE-12. SQ2174.2 +034000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2174.2 +034100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2174.2 +034200 MOVE "NO " TO ERROR-TOTAL SQ2174.2 +034300 ELSE SQ2174.2 +034400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2174.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2174.2 +034600 PERFORM WRITE-LINE. SQ2174.2 +034700 END-ROUTINE-13. SQ2174.2 +034800 IF DELETE-CNT IS EQUAL TO ZERO SQ2174.2 +034900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2174.2 +035000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2174.2 +035100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2174.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +035300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2174.2 +035400 MOVE "NO " TO ERROR-TOTAL SQ2174.2 +035500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2174.2 +035600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2174.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +035800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2174.2 +035900 WRITE-LINE. SQ2174.2 +036000 ADD 1 TO RECORD-COUNT. SQ2174.2 +036100 IF RECORD-COUNT GREATER 50 SQ2174.2 +036200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2174.2 +036300 MOVE SPACE TO DUMMY-RECORD SQ2174.2 +036400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2174.2 +036500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2174.2 +036600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2174.2 +036700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2174.2 +036800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2174.2 +036900 MOVE ZERO TO RECORD-COUNT. SQ2174.2 +037000 PERFORM WRT-LN. SQ2174.2 +037100 WRT-LN. SQ2174.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2174.2 +037300 MOVE SPACE TO DUMMY-RECORD. SQ2174.2 +037400 BLANK-LINE-PRINT. SQ2174.2 +037500 PERFORM WRT-LN. SQ2174.2 +037600 FAIL-ROUTINE. SQ2174.2 +037700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2174.2 +037800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2174.2 +037900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2174.2 +038000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +038100 GO TO FAIL-ROUTINE-EX. SQ2174.2 +038200 FAIL-ROUTINE-WRITE. SQ2174.2 +038300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2174.2 +038400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +038500 FAIL-ROUTINE-EX. EXIT. SQ2174.2 +038600 BAIL-OUT. SQ2174.2 +038700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2174.2 +038800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2174.2 +038900 BAIL-OUT-WRITE. SQ2174.2 +039000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2174.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2174.2 +039200 BAIL-OUT-EX. EXIT. SQ2174.2 +039300 CCVS1-EXIT. SQ2174.2 +039400 EXIT. SQ2174.2 +039500 SECT-SQ217A-0001 SECTION. SQ2174.2 +039600 WRITE-INIT-GF-01. SQ2174.2 +039700 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2174.2 +039800 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2174.2 +039900 MOVE "SQ217" TO XPROGRAM-NAME (1). SQ2174.2 +040000 MOVE 000120 TO XRECORD-LENGTH (1). SQ2174.2 +040100 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2174.2 +040200 MOVE 0001 TO XBLOCK-SIZE (1). SQ2174.2 +040300 MOVE 000750 TO RECORDS-IN-FILE (1). SQ2174.2 +040400 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2174.2 +040500 MOVE "S" TO XLABEL-TYPE (1). SQ2174.2 +040600 MOVE 000001 TO XRECORD-NUMBER (1). SQ2174.2 +040700 OPEN OUTPUT SQ-FS1. SQ2174.2 +040800 WRITE-TEST-GF-01. SQ2174.2 +040900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2174.2 +041000 WRITE SQ-FS1R1-F-G-120. SQ2174.2 +041100 IF XRECORD-NUMBER (1) EQUAL TO 750 SQ2174.2 +041200 GO TO WRITE-WRITE-GF-01. SQ2174.2 +041300 ADD 1 TO XRECORD-NUMBER (1). SQ2174.2 +041400 GO TO WRITE-TEST-GF-01. SQ2174.2 +041500 WRITE-WRITE-GF-01. SQ2174.2 +041600 MOVE "CREATE FILE SQ-FS1" TO FEATURE. SQ2174.2 +041700 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2174.2 +041800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2174.2 +041900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. SQ2174.2 +042000 PERFORM PASS. SQ2174.2 +042100 PERFORM PRINT-DETAIL. SQ2174.2 +042200 CLOSE SQ-FS1. SQ2174.2 +042300* A SEQUENTIAL TAPE FILE WITH 120 CHARACTER RECORDS SQ2174.2 +042400* HAS BEEN CREATED. THE FILE CONTAINS 750 RECORDS. SQ2174.2 +042500 READ-INIT-F1-01. SQ2174.2 +042600 MOVE ZERO TO WRK-CS-09V00. SQ2174.2 +042700* THIS TEST READS AND CHECKS THE FILE CREATED IN SQ2174.2 +042800* WRITE-TEST-GF-01. SQ2174.2 +042900 OPEN INPUT SQ-FS1. SQ2174.2 +043000 READ-TEST-F1-01. SQ2174.2 +043100 READ SQ-FS1 SQ2174.2 +043200 AT END GO TO READ-TEST-F1-01-1. SQ2174.2 +043300 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2174.2 +043400 ADD 1 TO WRK-CS-09V00. SQ2174.2 +043500 IF WRK-CS-09V00 GREATER THAN 750 SQ2174.2 +043600 MOVE "MORE THAN 750 RECORDS" TO RE-MARK SQ2174.2 +043700 GO TO READ-FAIL-F1-01. SQ2174.2 +043800 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ2174.2 +043900 ADD 1 TO RECORDS-IN-ERROR SQ2174.2 +044000 GO TO READ-TEST-F1-01. SQ2174.2 +044100 IF XFILE-NAME (1) NOT EQUAL TO "SQ-FS1" SQ2174.2 +044200 ADD 1 TO RECORDS-IN-ERROR SQ2174.2 +044300 GO TO READ-TEST-F1-01. SQ2174.2 +044400 IF XLABEL-TYPE (1) NOT EQUAL TO "S" SQ2174.2 +044500 ADD 1 TO RECORDS-IN-ERROR. SQ2174.2 +044600 GO TO READ-TEST-F1-01. SQ2174.2 +044700 READ-TEST-F1-01-1. SQ2174.2 +044800 IF RECORDS-IN-ERROR EQUAL TO ZERO SQ2174.2 +044900 GO TO READ-PASS-F1-01. SQ2174.2 +045000 MOVE "ERRORS IN READING SQ-FS1" TO RE-MARK. SQ2174.2 +045100 READ-FAIL-F1-01. SQ2174.2 +045200 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2174.2 +045300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A. SQ2174.2 +045400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0. SQ2174.2 +045500 PERFORM FAIL. SQ2174.2 +045600 GO TO READ-WRITE-F1-01. SQ2174.2 +045700 READ-PASS-F1-01. SQ2174.2 +045800 PERFORM PASS. SQ2174.2 +045900 MOVE "FILE VERIFIED RECS =" TO COMPUTED-A. SQ2174.2 +046000 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ2174.2 +046100 READ-WRITE-F1-01. SQ2174.2 +046200 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2174.2 +046300 MOVE "VERIFY FILE SQ-FS1" TO FEATURE. SQ2174.2 +046400 PERFORM PRINT-DETAIL. SQ2174.2 +046500 READ-CLOSE-F1-01. SQ2174.2 +046600 CLOSE SQ-FS1. SQ2174.2 +046700 READ-INIT-F1-02. SQ2174.2 +046800 MOVE ZERO TO WRK-CS-09V00. SQ2174.2 +046900 MOVE ZERO TO RECORDS-IN-ERROR. SQ2174.2 +047000 OPEN INPUT SQ-FS1. SQ2174.2 +047100* FOUR OPTIONS FOR THE READ STATEMENT ARE CHECKED SQ2174.2 +047200* IN THIS SERIES OF TESTS. SQ2174.2 +047300 MOVE "LEV 2 PADDING CHARS " TO FEATURE. SQ2174.2 +047400 MOVE "READ...RECORD AT END ..." TO RE-MARK. SQ2174.2 +047500 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2174.2 +047600 MOVE ZERO TO ERROR-FLAG. SQ2174.2 +047700 READ-TEST-F1-02. SQ2174.2 +047800 READ SQ-FS1 RECORD AT END SQ2174.2 +047900 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2174.2 +048000 MOVE 1 TO EOF-FLAG SQ2174.2 +048100 GO TO READ-FAIL-F1-02. SQ2174.2 +048200 PERFORM RECORD-CHECK. SQ2174.2 +048300 IF WRK-CS-09V00 EQUAL TO 200 SQ2174.2 +048400 GO TO READ-TEST-F1-02-1. SQ2174.2 +048500 GO TO READ-TEST-F1-02. SQ2174.2 +048600 RECORD-CHECK. SQ2174.2 +048700 MOVE SQ-FS1R1-F-G-120 TO FILE-RECORD-INFO-P1-120 (1). SQ2174.2 +048800 ADD 1 TO WRK-CS-09V00. SQ2174.2 +048900 IF WRK-CS-09V00 NOT EQUAL TO XRECORD-NUMBER (1) SQ2174.2 +049000 ADD 1 TO RECORDS-IN-ERROR SQ2174.2 +049100 MOVE 1 TO ERROR-FLAG. SQ2174.2 +049200 READ-TEST-F1-02-1. SQ2174.2 +049300 IF ERROR-FLAG EQUAL TO ZERO SQ2174.2 +049400 GO TO READ-PASS-F1-02. SQ2174.2 +049500 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2174.2 +049600 READ-FAIL-F1-02. SQ2174.2 +049700 PERFORM FAIL. SQ2174.2 +049800 GO TO READ-WRITE-F1-02. SQ2174.2 +049900 READ-PASS-F1-02. SQ2174.2 +050000 PERFORM PASS. SQ2174.2 +050100 READ-WRITE-F1-02. SQ2174.2 +050200 PERFORM PRINT-DETAIL. SQ2174.2 +050300 READ-INIT-F1-F1-03. SQ2174.2 +050400 IF EOF-FLAG EQUAL TO 1 SQ2174.2 +050500 GO TO READ-EOF-06. SQ2174.2 +050600 MOVE ZERO TO ERROR-FLAG. SQ2174.2 +050700 MOVE "READ...AT END..." TO RE-MARK. SQ2174.2 +050800 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2174.2 +050900 READ-TEST-F1-03. SQ2174.2 +051000 READ SQ-FS1 AT END SQ2174.2 +051100 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2174.2 +051200 MOVE 1 TO EOF-FLAG SQ2174.2 +051300 GO TO READ-FAIL-F1-03. SQ2174.2 +051400 PERFORM RECORD-CHECK. SQ2174.2 +051500 IF WRK-CS-09V00 EQUAL TO 400 SQ2174.2 +051600 GO TO READ-TEST-F1-03-1. SQ2174.2 +051700 GO TO READ-TEST-F1-03. SQ2174.2 +051800 READ-TEST-F1-03-1. SQ2174.2 +051900 IF ERROR-FLAG EQUAL TO ZERO SQ2174.2 +052000 GO TO READ-PASS-F1-03. SQ2174.2 +052100 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2174.2 +052200 READ-FAIL-F1-03. SQ2174.2 +052300 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2174.2 +052400 PERFORM FAIL. SQ2174.2 +052500 GO TO READ-WRITE-F1-03. SQ2174.2 +052600 READ-PASS-F1-03. SQ2174.2 +052700 PERFORM PASS. SQ2174.2 +052800 READ-WRITE-F1-03. SQ2174.2 +052900 PERFORM PRINT-DETAIL. SQ2174.2 +053000 READ-INIT-F1-04. SQ2174.2 +053100 IF EOF-FLAG EQUAL TO 1 SQ2174.2 +053200 GO TO READ-EOF-06. SQ2174.2 +053300 MOVE ZERO TO ERROR-FLAG. SQ2174.2 +053400 MOVE "READ...RECORD END..." TO RE-MARK. SQ2174.2 +053500 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2174.2 +053600 READ-TEST-F1-04. SQ2174.2 +053700 READ SQ-FS1 RECORD END SQ2174.2 +053800 MOVE "UNEXPECTED EOF" TO COMPUTED-A SQ2174.2 +053900 MOVE 1 TO EOF-FLAG SQ2174.2 +054000 GO TO READ-FAIL-F1-04. SQ2174.2 +054100 PERFORM RECORD-CHECK. SQ2174.2 +054200 IF WRK-CS-09V00 EQUAL TO 600 SQ2174.2 +054300 GO TO READ-TEST-F1-04-1. SQ2174.2 +054400 GO TO READ-TEST-F1-04. SQ2174.2 +054500 READ-TEST-F1-04-1. SQ2174.2 +054600 IF ERROR-FLAG EQUAL TO ZERO SQ2174.2 +054700 GO TO READ-PASS-F1-04. SQ2174.2 +054800 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2174.2 +054900 READ-FAIL-F1-04. SQ2174.2 +055000 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2174.2 +055100 PERFORM FAIL. SQ2174.2 +055200 GO TO READ-WRITE-F1-04. SQ2174.2 +055300 READ-PASS-F1-04. SQ2174.2 +055400 PERFORM PASS. SQ2174.2 +055500 READ-WRITE-F1-04. SQ2174.2 +055600 PERFORM PRINT-DETAIL. SQ2174.2 +055700 READ-INIT-F1-05. SQ2174.2 +055800 IF EOF-FLAG EQUAL TO 1 SQ2174.2 +055900 GO TO READ-EOF-06. SQ2174.2 +056000 MOVE ZERO TO ERROR-FLAG. SQ2174.2 +056100 MOVE "READ...END..." TO RE-MARK. SQ2174.2 +056200 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2174.2 +056300 READ-TEST-F1-05. SQ2174.2 +056400 READ SQ-FS1 END GO TO READ-TEST-F1-05-1. SQ2174.2 +056500 PERFORM RECORD-CHECK. SQ2174.2 +056600 IF WRK-CS-09V00 GREATER THAN 750 SQ2174.2 +056700 GO TO READ-TEST-F1-05-1. SQ2174.2 +056800 GO TO READ-TEST-F1-05. SQ2174.2 +056900 READ-TEST-F1-05-1. SQ2174.2 +057000 IF ERROR-FLAG EQUAL TO ZERO SQ2174.2 +057100 GO TO READ-PASS-F1-05. SQ2174.2 +057200 READ-FAIL-F1-05. SQ2174.2 +057300 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK. SQ2174.2 +057400 MOVE "ERROR IN RECORD(S)" TO COMPUTED-A. SQ2174.2 +057500 PERFORM FAIL. SQ2174.2 +057600 GO TO READ-WRITE-F1-05. SQ2174.2 +057700 READ-PASS-F1-05. SQ2174.2 +057800 PERFORM PASS. SQ2174.2 +057900 READ-WRITE-F1-05. SQ2174.2 +058000 PERFORM PRINT-DETAIL. SQ2174.2 +058100 READ-TEST-06. SQ2174.2 +058200 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2174.2 +058300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2174.2 +058400 MOVE "VII-12; PADDING CHARACTER" TO RE-MARK SQ2174.2 +058500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2174.2 +058600 GO TO READ-FAIL-06. SQ2174.2 +058700 IF WRK-CS-09V00 GREATER THAN 750 SQ2174.2 +058800 MOVE "MORE THAN 750 RECORDS; VII-12 PADDING CHARS" TO RE-MARKSQ2174.2 +058900 GO TO READ-FAIL-06. SQ2174.2 +059000 READ-PASS-06. SQ2174.2 +059100 PERFORM PASS. SQ2174.2 +059200 GO TO READ-WRITE-06. SQ2174.2 +059300 READ-EOF-06. SQ2174.2 +059400 MOVE "LESS THAN 750 RECORDS" TO RE-MARK. SQ2174.2 +059500 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2174.2 +059600 MOVE WRK-CS-09V00 TO CORRECT-18V0. SQ2174.2 +059700 READ-FAIL-06. SQ2174.2 +059800 PERFORM FAIL. SQ2174.2 +059900 READ-WRITE-06. SQ2174.2 +060000 MOVE "READ-TEST-06 " TO PAR-NAME. SQ2174.2 +060100 MOVE "READ FILE SQ-FS1" TO FEATURE. SQ2174.2 +060200 PERFORM PRINT-DETAIL. SQ2174.2 +060300 READ-CLOSE-003. SQ2174.2 +060400 CLOSE SQ-FS1. SQ2174.2 +060500 TERMINATE-ROUTINE. SQ2174.2 +060600 EXIT. SQ2174.2 +060700 CCVS-EXIT SECTION. SQ2174.2 +060800 CCVS-999999. SQ2174.2 +060900 GO TO CLOSE-FILES. SQ2174.2 diff --git a/tests/cobol85/SQ/SQ218A.CBL b/tests/cobol85/SQ/SQ218A.CBL new file mode 100755 index 00000000..77436eed --- /dev/null +++ b/tests/cobol85/SQ/SQ218A.CBL @@ -0,0 +1,699 @@ +000100 IDENTIFICATION DIVISION. SQ2184.2 +000200 PROGRAM-ID. SQ2184.2 +000300 SQ218A. SQ2184.2 +000400**************************************************************** SQ2184.2 +000500* * SQ2184.2 +000600* VALIDATION FOR:- * SQ2184.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2184.2 +000800* * SQ2184.2 +000900* CREATION DATE / VALIDATION DATE * SQ2184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2184.2 +001100* * SQ2184.2 +001200* THIS ROUTINE CHECKS THE SQ2184.2 +001300* RECORD DELIMITER IS STANDARD-1 CLAUSE. SQ2184.2 +001400* SQ2184.2 +001500* SEE VII-13. SQ2184.2 +001600* SQ2184.2 +001700* SQ2184.2 +001800* THIS ROUTINE BUILDS A SEQUENTIAL TAPE FILE WHICH CONTAINS SQ2184.2 +001900* BOTH 120 CHARACTER AND 151 CHARACTER RECORDS. THE TAPE SQ2184.2 +002000* CONSISTS OF 1 SHORT, 1 LONG, 10 SHORT, 100 LONG, AND 338 SQ2184.2 +002100* SHORT RECORDS FOR A TOTAL OF 450 RECORDS IN THE FILE. SQ2184.2 +002200* THE TAPE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2184.2 +002300* AGAINST THE EXPECTED VALUES. SQ2184.2 +002400* SQ2184.2 +002500* AN INFORMATION SECTION AT THE END OF THE ROUTINE CHECKS SQ2184.2 +002600* THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. THIS FIELD IS SQ2184.2 +002700* PART OF A LONG RECORD ONLY. IF THE XRECORD-NUMBER IS THERE SQ2184.2 +002800* FOR A SHORT RECORD, IT MEANS THE MAXIMUM SIZE RECORD IS SQ2184.2 +002900* ALWAYS WRITTEN. SQ2184.2 +003000 ENVIRONMENT DIVISION. SQ2184.2 +003100 CONFIGURATION SECTION. SQ2184.2 +003200 SOURCE-COMPUTER. SQ2184.2 +003300 Linux. SQ2184.2 +003400 OBJECT-COMPUTER. SQ2184.2 +003500 Linux. SQ2184.2 +003600 INPUT-OUTPUT SECTION. SQ2184.2 +003700 FILE-CONTROL. SQ2184.2 +003800*P SELECT RAW-DATA ASSIGN TO SQ2184.2 +003900*P "XXXXX062" SQ2184.2 +004000*P ORGANIZATION IS INDEXED SQ2184.2 +004100*P ACCESS MODE IS RANDOM SQ2184.2 +004200*P RECORD KEY IS RAW-DATA-KEY. SQ2184.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ2184.2 +004400 "report.log". SQ2184.2 +004500 SELECT SQ-VS6 ASSIGN SQ2184.2 +004600 "XXXXX001" SQ2184.2 +004700 ORGANIZATION IS SEQUENTIAL SQ2184.2 +004800 RECORD DELIMITER IS STANDARD-1. SQ2184.2 +004900 DATA DIVISION. SQ2184.2 +005000 FILE SECTION. SQ2184.2 +005100*P SQ2184.2 +005200*PD RAW-DATA. SQ2184.2 +005300*P SQ2184.2 +005400*P1 RAW-DATA-SATZ. SQ2184.2 +005500*P 05 RAW-DATA-KEY PIC X(6). SQ2184.2 +005600*P 05 C-DATE PIC 9(6). SQ2184.2 +005700*P 05 C-TIME PIC 9(8). SQ2184.2 +005800*P 05 C-NO-OF-TESTS PIC 99. SQ2184.2 +005900*P 05 C-OK PIC 999. SQ2184.2 +006000*P 05 C-ALL PIC 999. SQ2184.2 +006100*P 05 C-FAIL PIC 999. SQ2184.2 +006200*P 05 C-DELETED PIC 999. SQ2184.2 +006300*P 05 C-INSPECT PIC 999. SQ2184.2 +006400*P 05 C-NOTE PIC X(13). SQ2184.2 +006500*P 05 C-INDENT PIC X. SQ2184.2 +006600*P 05 C-ABORT PIC X(8). SQ2184.2 +006700 FD PRINT-FILE SQ2184.2 +006800*C LABEL RECORDS SQ2184.2 +006900*C OMITTED SQ2184.2 +007000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2184.2 +007100 . SQ2184.2 +007200 01 PRINT-REC PICTURE X(120). SQ2184.2 +007300 01 DUMMY-RECORD PICTURE X(120). SQ2184.2 +007400 FD SQ-VS6 SQ2184.2 +007500 RECORD CONTAINS 120 TO 151 CHARACTERS SQ2184.2 +007600*C LABEL RECORDS ARE STANDARD SQ2184.2 +007700*C DATA RECORDS ARE SQ-VS6R1-M-G-120 SQ-VS6R2-M-G-151 SQ2184.2 +007800 . SQ2184.2 +007900 01 SQ-VS6R1-M-G-120. SQ2184.2 +008000 02 SQ-VS6R1-FIRST PIC X(120). SQ2184.2 +008100 01 SQ-VS6R2-M-G-151. SQ2184.2 +008200 02 SQ-VS6R2-FIRST PIC X(120). SQ2184.2 +008300 02 LONG-OR-SHORT PIC X(5). SQ2184.2 +008400 02 SQ-VS6-RECNO PIC X(5). SQ2184.2 +008500 02 SQ-VS6-FILLER PIC X(21). SQ2184.2 +008600 WORKING-STORAGE SECTION. SQ2184.2 +008700 01 SAVE-COUNT-OF-RECS PIC X(5). SQ2184.2 +008800 01 COUNT-OF-RECS PIC S9(5) COMP. SQ2184.2 +008900 01 RECORDS-IN-ERROR PIC S9(5) COMP. SQ2184.2 +009000 01 ERROR-FLAG PIC 9. SQ2184.2 +009100 01 EOF-FLAG PIC 9. SQ2184.2 +009200 01 DUMP-AREA. SQ2184.2 +009300 02 TYPE-OF-REC PICTURE X(5). SQ2184.2 +009400 02 RECNO PIC 9(5). SQ2184.2 +009500 02 FILLER PIC X(21). SQ2184.2 +009600 01 FILE-RECORD-INFORMATION-REC. SQ2184.2 +009700 03 FILE-RECORD-INFO-SKELETON. SQ2184.2 +009800 05 FILLER PICTURE X(48) VALUE SQ2184.2 +009900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2184.2 +010000 05 FILLER PICTURE X(46) VALUE SQ2184.2 +010100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2184.2 +010200 05 FILLER PICTURE X(26) VALUE SQ2184.2 +010300 ",LFIL=000000,ORG= ,LBLR= ". SQ2184.2 +010400 05 FILLER PICTURE X(37) VALUE SQ2184.2 +010500 ",RECKEY= ". SQ2184.2 +010600 05 FILLER PICTURE X(38) VALUE SQ2184.2 +010700 ",ALTKEY1= ". SQ2184.2 +010800 05 FILLER PICTURE X(38) VALUE SQ2184.2 +010900 ",ALTKEY2= ". SQ2184.2 +011000 05 FILLER PICTURE X(7) VALUE SPACE.SQ2184.2 +011100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2184.2 +011200 05 FILE-RECORD-INFO-P1-120. SQ2184.2 +011300 07 FILLER PIC X(5). SQ2184.2 +011400 07 XFILE-NAME PIC X(6). SQ2184.2 +011500 07 FILLER PIC X(8). SQ2184.2 +011600 07 XRECORD-NAME PIC X(6). SQ2184.2 +011700 07 FILLER PIC X(1). SQ2184.2 +011800 07 REELUNIT-NUMBER PIC 9(1). SQ2184.2 +011900 07 FILLER PIC X(7). SQ2184.2 +012000 07 XRECORD-NUMBER PIC 9(6). SQ2184.2 +012100 07 FILLER PIC X(6). SQ2184.2 +012200 07 UPDATE-NUMBER PIC 9(2). SQ2184.2 +012300 07 FILLER PIC X(5). SQ2184.2 +012400 07 ODO-NUMBER PIC 9(4). SQ2184.2 +012500 07 FILLER PIC X(5). SQ2184.2 +012600 07 XPROGRAM-NAME PIC X(5). SQ2184.2 +012700 07 FILLER PIC X(7). SQ2184.2 +012800 07 XRECORD-LENGTH PIC 9(6). SQ2184.2 +012900 07 FILLER PIC X(7). SQ2184.2 +013000 07 CHARS-OR-RECORDS PIC X(2). SQ2184.2 +013100 07 FILLER PIC X(1). SQ2184.2 +013200 07 XBLOCK-SIZE PIC 9(4). SQ2184.2 +013300 07 FILLER PIC X(6). SQ2184.2 +013400 07 RECORDS-IN-FILE PIC 9(6). SQ2184.2 +013500 07 FILLER PIC X(5). SQ2184.2 +013600 07 XFILE-ORGANIZATION PIC X(2). SQ2184.2 +013700 07 FILLER PIC X(6). SQ2184.2 +013800 07 XLABEL-TYPE PIC X(1). SQ2184.2 +013900 05 FILE-RECORD-INFO-P121-240. SQ2184.2 +014000 07 FILLER PIC X(8). SQ2184.2 +014100 07 XRECORD-KEY PIC X(29). SQ2184.2 +014200 07 FILLER PIC X(9). SQ2184.2 +014300 07 ALTERNATE-KEY1 PIC X(29). SQ2184.2 +014400 07 FILLER PIC X(9). SQ2184.2 +014500 07 ALTERNATE-KEY2 PIC X(29). SQ2184.2 +014600 07 FILLER PIC X(7). SQ2184.2 +014700 01 TEST-RESULTS. SQ2184.2 +014800 02 FILLER PICTURE X VALUE SPACE. SQ2184.2 +014900 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2184.2 +015000 02 FILLER PICTURE X VALUE SPACE. SQ2184.2 +015100 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2184.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ2184.2 +015300 02 PAR-NAME. SQ2184.2 +015400 03 FILLER PICTURE X(12) VALUE SPACE. SQ2184.2 +015500 03 PARDOT-X PICTURE X VALUE SPACE. SQ2184.2 +015600 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2184.2 +015700 03 FILLER PIC X(5) VALUE SPACE. SQ2184.2 +015800 02 FILLER PIC X(10) VALUE SPACE. SQ2184.2 +015900 02 RE-MARK PIC X(61). SQ2184.2 +016000 01 TEST-COMPUTED. SQ2184.2 +016100 02 FILLER PIC X(30) VALUE SPACE. SQ2184.2 +016200 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2184.2 +016300 02 COMPUTED-X. SQ2184.2 +016400 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2184.2 +016500 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2184.2 +016600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2184.2 +016700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2184.2 +016800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2184.2 +016900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2184.2 +017000 04 COMPUTED-18V0 PICTURE -9(18). SQ2184.2 +017100 04 FILLER PICTURE X. SQ2184.2 +017200 03 FILLER PIC X(50) VALUE SPACE. SQ2184.2 +017300 01 TEST-CORRECT. SQ2184.2 +017400 02 FILLER PIC X(30) VALUE SPACE. SQ2184.2 +017500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2184.2 +017600 02 CORRECT-X. SQ2184.2 +017700 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2184.2 +017800 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2184.2 +017900 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2184.2 +018000 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2184.2 +018100 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2184.2 +018200 03 CR-18V0 REDEFINES CORRECT-A. SQ2184.2 +018300 04 CORRECT-18V0 PICTURE -9(18). SQ2184.2 +018400 04 FILLER PICTURE X. SQ2184.2 +018500 03 FILLER PIC X(50) VALUE SPACE. SQ2184.2 +018600 01 CCVS-C-1. SQ2184.2 +018700 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2184.2 +018800- "SS PARAGRAPH-NAME SQ2184.2 +018900- " REMARKS". SQ2184.2 +019000 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2184.2 +019100 01 CCVS-C-2. SQ2184.2 +019200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2184.2 +019300 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2184.2 +019400 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2184.2 +019500 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2184.2 +019600 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2184.2 +019700 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2184.2 +019800 01 REC-CT PICTURE 99 VALUE ZERO. SQ2184.2 +019900 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2184.2 +020000 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2184.2 +020100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2184.2 +020200 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2184.2 +020300 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2184.2 +020400 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2184.2 +020500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2184.2 +020600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2184.2 +020700 01 CCVS-H-1. SQ2184.2 +020800 02 FILLER PICTURE X(27) VALUE SPACE. SQ2184.2 +020900 02 FILLER PICTURE X(67) VALUE SQ2184.2 +021000 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2184.2 +021100- " SYSTEM". SQ2184.2 +021200 02 FILLER PICTURE X(26) VALUE SPACE. SQ2184.2 +021300 01 CCVS-H-2. SQ2184.2 +021400 02 FILLER PICTURE X(52) VALUE IS SQ2184.2 +021500 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2184.2 +021600 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2184.2 +021700 02 TEST-ID PICTURE IS X(9). SQ2184.2 +021800 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2184.2 +021900 01 CCVS-H-3. SQ2184.2 +022000 02 FILLER PICTURE X(34) VALUE SQ2184.2 +022100 " FOR OFFICIAL USE ONLY ". SQ2184.2 +022200 02 FILLER PICTURE X(58) VALUE SQ2184.2 +022300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2184.2 +022400 02 FILLER PICTURE X(28) VALUE SQ2184.2 +022500 " COPYRIGHT 1985 ". SQ2184.2 +022600 01 CCVS-E-1. SQ2184.2 +022700 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2184.2 +022800 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2184.2 +022900 02 ID-AGAIN PICTURE IS X(9). SQ2184.2 +023000 02 FILLER PICTURE X(45) VALUE IS SQ2184.2 +023100 " NTIS DISTRIBUTION COBOL 85". SQ2184.2 +023200 01 CCVS-E-2. SQ2184.2 +023300 02 FILLER PICTURE X(31) VALUE SQ2184.2 +023400 SPACE. SQ2184.2 +023500 02 FILLER PICTURE X(21) VALUE SPACE. SQ2184.2 +023600 02 CCVS-E-2-2. SQ2184.2 +023700 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2184.2 +023800 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2184.2 +023900 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2184.2 +024000 01 CCVS-E-3. SQ2184.2 +024100 02 FILLER PICTURE X(22) VALUE SQ2184.2 +024200 " FOR OFFICIAL USE ONLY". SQ2184.2 +024300 02 FILLER PICTURE X(12) VALUE SPACE. SQ2184.2 +024400 02 FILLER PICTURE X(58) VALUE SQ2184.2 +024500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2184.2 +024600 02 FILLER PICTURE X(13) VALUE SPACE. SQ2184.2 +024700 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2184.2 +024800 01 CCVS-E-4. SQ2184.2 +024900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2184.2 +025000 02 FILLER PIC XXXX VALUE " OF ". SQ2184.2 +025100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2184.2 +025200 02 FILLER PIC X(40) VALUE SQ2184.2 +025300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2184.2 +025400 01 XXINFO. SQ2184.2 +025500 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2184.2 +025600 02 INFO-TEXT. SQ2184.2 +025700 04 FILLER PIC X(20) VALUE SPACE. SQ2184.2 +025800 04 XXCOMPUTED PIC X(20). SQ2184.2 +025900 04 FILLER PIC X(5) VALUE SPACE. SQ2184.2 +026000 04 XXCORRECT PIC X(20). SQ2184.2 +026100 01 HYPHEN-LINE. SQ2184.2 +026200 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2184.2 +026300 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2184.2 +026400- "*****************************************". SQ2184.2 +026500 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2184.2 +026600- "******************************". SQ2184.2 +026700 01 CCVS-PGM-ID PIC X(6) VALUE SQ2184.2 +026800 "SQ218A". SQ2184.2 +026900 PROCEDURE DIVISION. SQ2184.2 +027000 CCVS1 SECTION. SQ2184.2 +027100 OPEN-FILES. SQ2184.2 +027200*P OPEN I-O RAW-DATA. SQ2184.2 +027300*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2184.2 +027400*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2184.2 +027500*P MOVE "ABORTED " TO C-ABORT. SQ2184.2 +027600*P ADD 1 TO C-NO-OF-TESTS. SQ2184.2 +027700*P ACCEPT C-DATE FROM DATE. SQ2184.2 +027800*P ACCEPT C-TIME FROM TIME. SQ2184.2 +027900*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2184.2 +028000*PND-E-1. SQ2184.2 +028100*P CLOSE RAW-DATA. SQ2184.2 +028200 OPEN OUTPUT PRINT-FILE. SQ2184.2 +028300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2184.2 +028400 MOVE SPACE TO TEST-RESULTS. SQ2184.2 +028500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2184.2 +028600 MOVE ZERO TO REC-SKL-SUB. SQ2184.2 +028700 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2184.2 +028800 CCVS-INIT-FILE. SQ2184.2 +028900 ADD 1 TO REC-SKL-SUB. SQ2184.2 +029000 MOVE FILE-RECORD-INFO-SKELETON TO SQ2184.2 +029100 FILE-RECORD-INFO (REC-SKL-SUB). SQ2184.2 +029200 CCVS-INIT-EXIT. SQ2184.2 +029300 GO TO CCVS1-EXIT. SQ2184.2 +029400 CLOSE-FILES. SQ2184.2 +029500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2184.2 +029600*P OPEN I-O RAW-DATA. SQ2184.2 +029700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2184.2 +029800*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2184.2 +029900*P MOVE "OK. " TO C-ABORT. SQ2184.2 +030000*P MOVE PASS-COUNTER TO C-OK. SQ2184.2 +030100*P MOVE ERROR-HOLD TO C-ALL. SQ2184.2 +030200*P MOVE ERROR-COUNTER TO C-FAIL. SQ2184.2 +030300*P MOVE DELETE-CNT TO C-DELETED. SQ2184.2 +030400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2184.2 +030500*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2184.2 +030600*PND-E-2. SQ2184.2 +030700*P CLOSE RAW-DATA. SQ2184.2 +030800 TERMINATE-CCVS. SQ2184.2 +030900*S EXIT PROGRAM. SQ2184.2 +031000*SERMINATE-CALL. SQ2184.2 +031100 STOP RUN. SQ2184.2 +031200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2184.2 +031300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2184.2 +031400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2184.2 +031500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2184.2 +031600 MOVE "****TEST DELETED****" TO RE-MARK. SQ2184.2 +031700 PRINT-DETAIL. SQ2184.2 +031800 IF REC-CT NOT EQUAL TO ZERO SQ2184.2 +031900 MOVE "." TO PARDOT-X SQ2184.2 +032000 MOVE REC-CT TO DOTVALUE. SQ2184.2 +032100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2184.2 +032200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2184.2 +032300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2184.2 +032400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2184.2 +032500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2184.2 +032600 MOVE SPACE TO CORRECT-X. SQ2184.2 +032700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2184.2 +032800 MOVE SPACE TO RE-MARK. SQ2184.2 +032900 HEAD-ROUTINE. SQ2184.2 +033000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +033100 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2184.2 +033200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2184.2 +033300 COLUMN-NAMES-ROUTINE. SQ2184.2 +033400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +033500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +033600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +033700 END-ROUTINE. SQ2184.2 +033800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2184.2 +033900 END-RTN-EXIT. SQ2184.2 +034000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +034100 END-ROUTINE-1. SQ2184.2 +034200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2184.2 +034300 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2184.2 +034400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2184.2 +034500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2184.2 +034600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2184.2 +034700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2184.2 +034800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2184.2 +034900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2184.2 +035000 END-ROUTINE-12. SQ2184.2 +035100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2184.2 +035200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2184.2 +035300 MOVE "NO " TO ERROR-TOTAL SQ2184.2 +035400 ELSE SQ2184.2 +035500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2184.2 +035600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2184.2 +035700 PERFORM WRITE-LINE. SQ2184.2 +035800 END-ROUTINE-13. SQ2184.2 +035900 IF DELETE-CNT IS EQUAL TO ZERO SQ2184.2 +036000 MOVE "NO " TO ERROR-TOTAL ELSE SQ2184.2 +036100 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2184.2 +036200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2184.2 +036300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +036400 IF INSPECT-COUNTER EQUAL TO ZERO SQ2184.2 +036500 MOVE "NO " TO ERROR-TOTAL SQ2184.2 +036600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2184.2 +036700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2184.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +036900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2184.2 +037000 WRITE-LINE. SQ2184.2 +037100 ADD 1 TO RECORD-COUNT. SQ2184.2 +037200 IF RECORD-COUNT GREATER 50 SQ2184.2 +037300 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2184.2 +037400 MOVE SPACE TO DUMMY-RECORD SQ2184.2 +037500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2184.2 +037600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2184.2 +037700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2184.2 +037800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2184.2 +037900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2184.2 +038000 MOVE ZERO TO RECORD-COUNT. SQ2184.2 +038100 PERFORM WRT-LN. SQ2184.2 +038200 WRT-LN. SQ2184.2 +038300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2184.2 +038400 MOVE SPACE TO DUMMY-RECORD. SQ2184.2 +038500 BLANK-LINE-PRINT. SQ2184.2 +038600 PERFORM WRT-LN. SQ2184.2 +038700 FAIL-ROUTINE. SQ2184.2 +038800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2184.2 +038900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2184.2 +039000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2184.2 +039100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +039200 GO TO FAIL-ROUTINE-EX. SQ2184.2 +039300 FAIL-ROUTINE-WRITE. SQ2184.2 +039400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2184.2 +039500 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +039600 FAIL-ROUTINE-EX. EXIT. SQ2184.2 +039700 BAIL-OUT. SQ2184.2 +039800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2184.2 +039900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2184.2 +040000 BAIL-OUT-WRITE. SQ2184.2 +040100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2184.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2184.2 +040300 BAIL-OUT-EX. EXIT. SQ2184.2 +040400 CCVS1-EXIT. SQ2184.2 +040500 EXIT. SQ2184.2 +040600 SECT-SQ218A-0001 SECTION. SQ2184.2 +040700 WRITE-INIT-GF-01. SQ2184.2 +040800 MOVE "SQ-VS6" TO XFILE-NAME (1). SQ2184.2 +040900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2184.2 +041000 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2184.2 +041100 MOVE 0001 TO XBLOCK-SIZE (1). SQ2184.2 +041200 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2184.2 +041300 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2184.2 +041400 MOVE "S" TO XLABEL-TYPE (1). SQ2184.2 +041500 MOVE 000000 TO XRECORD-NUMBER (1). SQ2184.2 +041600 MOVE ZERO TO COUNT-OF-RECS. SQ2184.2 +041700 OPEN OUTPUT SQ-VS6. SQ2184.2 +041800 MOVE "MULTIPLE LENGTH RECS " TO SQ-VS6-FILLER. SQ2184.2 +041900 WRITE-TEST-GF-01. SQ2184.2 +042000 PERFORM WRITE-SHORT-REC. SQ2184.2 +042100 PERFORM WRITE-LONG-REC. SQ2184.2 +042200 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2184.2 +042300 PERFORM WRITE-LONG-REC 100 TIMES. SQ2184.2 +042400 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2184.2 +042500 WRITE-WRITE-GF-01. SQ2184.2 +042600 MOVE "CREATE FILE SQ-VS6" TO FEATURE. SQ2184.2 +042700 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2184.2 +042800 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2184.2 +042900 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2184.2 +043000 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2184.2 +043100 PERFORM PRINT-DETAIL. SQ2184.2 +043200* A SEQUENTIAL TAPE FILE CONTAINING 450 RECORDS HAS SQ2184.2 +043300* BEEN CREATED. THE FILE CONTAINS RECORDS OF 120 CHARACTERS SQ2184.2 +043400* AND RECORDS OF 151 CHARACTERS. THE SEQUENCE IN WHICH THE SQ2184.2 +043500* RECORDS WERE WRITTEN IS S-L-10S-100L-338S. SQ2184.2 +043600 WRITE-CLOSE-GF-01. SQ2184.2 +043700 CLOSE SQ-VS6. SQ2184.2 +043800 GO TO READ-INIT-F1-01. SQ2184.2 +043900 WRITE-SHORT-REC. SQ2184.2 +044000 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2184.2 +044100 MOVE 000120 TO XRECORD-LENGTH (1). SQ2184.2 +044200 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +044300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2184.2 +044400 MOVE "SHORT" TO LONG-OR-SHORT. SQ2184.2 +044500 MOVE COUNT-OF-RECS TO SQ-VS6-RECNO. SQ2184.2 +044600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R1-FIRST. SQ2184.2 +044700 WRITE SQ-VS6R1-M-G-120. SQ2184.2 +044800 WRITE-LONG-REC. SQ2184.2 +044900 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2184.2 +045000 MOVE 000151 TO XRECORD-LENGTH (1). SQ2184.2 +045100 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +045200 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2184.2 +045300 MOVE "LONG" TO LONG-OR-SHORT. SQ2184.2 +045400 MOVE COUNT-OF-RECS TO SQ-VS6-RECNO. SQ2184.2 +045500 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ2184.2 +045600 WRITE SQ-VS6R2-M-G-151. SQ2184.2 +045700 READ-INIT-F1-01. SQ2184.2 +045800 MOVE ZERO TO COUNT-OF-RECS. SQ2184.2 +045900 MOVE ZERO TO EOF-FLAG. SQ2184.2 +046000 MOVE ZERO TO RECORDS-IN-ERROR. SQ2184.2 +046100 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +046200 OPEN INPUT SQ-VS6. SQ2184.2 +046300 READ-TEST-F1-01. SQ2184.2 +046400 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2184.2 +046500 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +046600 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2184.2 +046700 GO TO READ-EOF-F1-06. SQ2184.2 +046800 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +046900 GO TO READ-FAIL-F1-01. SQ2184.2 +047000 READ-PASS-F1-01. SQ2184.2 +047100 PERFORM PASS. SQ2184.2 +047200 GO TO READ-WRITE-F1-01. SQ2184.2 +047300 READ-FAIL-F1-01. SQ2184.2 +047400 MOVE "ERROR ON FIRST READ;VII-13 SR (2), GR (1,2)" TO RE-MARKSQ2184.2 +047500 PERFORM FAIL. SQ2184.2 +047600 READ-WRITE-F1-01. SQ2184.2 +047700 MOVE "READ SHORT RECORD" TO FEATURE. SQ2184.2 +047800 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2184.2 +047900 PERFORM PRINT-DETAIL. SQ2184.2 +048000 GO TO READ-INIT-F1-02. SQ2184.2 +048100 READ-SHORT-REC. SQ2184.2 +048200 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +048300 GO TO READ-SHORT-REC-EXIT. SQ2184.2 +048400 READ SQ-VS6 AT END SQ2184.2 +048500 MOVE 1 TO EOF-FLAG SQ2184.2 +048600 GO TO READ-SHORT-REC-EXIT. SQ2184.2 +048700 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +048800 MOVE SQ-VS6R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2184.2 +048900 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2184.2 +049000 GO TO READ-SHORT-REC-ERROR. SQ2184.2 +049100 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ2184.2 +049200 GO TO READ-SHORT-REC-ERROR. SQ2184.2 +049300 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2184.2 +049400 GO TO READ-SHORT-REC-ERROR. SQ2184.2 +049500 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2184.2 +049600 GO TO READ-SHORT-REC-EXIT. SQ2184.2 +049700 READ-SHORT-REC-ERROR. SQ2184.2 +049800 ADD 1 TO RECORDS-IN-ERROR. SQ2184.2 +049900 MOVE 1 TO ERROR-FLAG. SQ2184.2 +050000 READ-SHORT-REC-EXIT. SQ2184.2 +050100 EXIT. SQ2184.2 +050200 READ-INIT-F1-02. SQ2184.2 +050300 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +050400 READ-TEST-F1-02. SQ2184.2 +050500 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2184.2 +050600 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +050700 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2184.2 +050800 GO TO READ-EOF-F1-06. SQ2184.2 +050900 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +051000 GO TO READ-FAIL-F1-02. SQ2184.2 +051100 READ-PASS-F1-02. SQ2184.2 +051200 PERFORM PASS. SQ2184.2 +051300 GO TO READ-WRITE-F1-02. SQ2184.2 +051400 READ-FAIL-F1-02. SQ2184.2 +051500 MOVE "ERROR ON SEC READ; VII-13 SR (2), GR (1,2)" TO RE-MARK SQ2184.2 +051600 PERFORM FAIL. SQ2184.2 +051700 READ-WRITE-F1-02. SQ2184.2 +051800 MOVE "READ LONG RECORD" TO FEATURE. SQ2184.2 +051900 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2184.2 +052000 PERFORM PRINT-DETAIL. SQ2184.2 +052100 GO TO READ-INIT-F1-03. SQ2184.2 +052200 READ-LONG-REC. SQ2184.2 +052300 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +052400 GO TO READ-LONG-REC-EXIT. SQ2184.2 +052500 READ SQ-VS6 END SQ2184.2 +052600 MOVE 1 TO EOF-FLAG SQ2184.2 +052700 GO TO READ-LONG-REC-EXIT. SQ2184.2 +052800 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +052900 MOVE SQ-VS6R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2184.2 +053000 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2184.2 +053100 GO TO READ-LONG-REC-ERROR. SQ2184.2 +053200 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ2184.2 +053300 GO TO READ-LONG-REC-ERROR. SQ2184.2 +053400 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2184.2 +053500 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS6-RECNO SQ2184.2 +053600 GO TO READ-LONG-REC-ERROR. SQ2184.2 +053700 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2184.2 +053800 GO TO READ-LONG-REC-EXIT. SQ2184.2 +053900 READ-LONG-REC-ERROR. SQ2184.2 +054000 ADD 1 TO RECORDS-IN-ERROR. SQ2184.2 +054100 MOVE 1 TO ERROR-FLAG. SQ2184.2 +054200 READ-LONG-REC-EXIT. SQ2184.2 +054300 EXIT. SQ2184.2 +054400 READ-INIT-F1-03. SQ2184.2 +054500 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +054600 READ-TEST-F1-03. SQ2184.2 +054700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2184.2 +054800 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +054900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2184.2 +055000 GO TO READ-EOF-F1-06. SQ2184.2 +055100 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +055200 GO TO READ-FAIL-F1-03. SQ2184.2 +055300 READ-PASS-F1-03. SQ2184.2 +055400 PERFORM PASS. SQ2184.2 +055500 GO TO READ-WRITE-F1-03. SQ2184.2 +055600 READ-FAIL-F1-03. SQ2184.2 +055700 MOVE "ERROR REA SHORT REC;VII-13 SR (2), GR (1,2)" TO RE-MARKSQ2184.2 +055800 PERFORM FAIL. SQ2184.2 +055900 READ-WRITE-F1-03. SQ2184.2 +056000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2184.2 +056100 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2184.2 +056200 PERFORM PRINT-DETAIL. SQ2184.2 +056300 READ-INIT-F1-04. SQ2184.2 +056400 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +056500 READ-TEST-F1-04. SQ2184.2 +056600 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2184.2 +056700 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +056800 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2184.2 +056900 GO TO READ-EOF-F1-06. SQ2184.2 +057000 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +057100 GO TO READ-FAIL-F1-04. SQ2184.2 +057200 READ-PASS-F1-04. SQ2184.2 +057300 PERFORM PASS. SQ2184.2 +057400 GO TO READ-WRITE-F1-04. SQ2184.2 +057500 READ-FAIL-F1-04. SQ2184.2 +057600 PERFORM FAIL. SQ2184.2 +057700 MOVE "ERROR READING LONG RECORD" TO RE-MARK. SQ2184.2 +057800 READ-WRITE-F1-04. SQ2184.2 +057900 MOVE "READ LONG RECORDS" TO FEATURE. SQ2184.2 +058000 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2184.2 +058100 PERFORM PRINT-DETAIL. SQ2184.2 +058200 READ-INIT-F1-05. SQ2184.2 +058300 MOVE ZERO TO ERROR-FLAG. SQ2184.2 +058400 READ-TEST-F1-05. SQ2184.2 +058500 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2184.2 +058600 IF EOF-FLAG EQUAL TO 1 SQ2184.2 +058700 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2184.2 +058800 GO TO READ-EOF-F1-06. SQ2184.2 +058900 IF ERROR-FLAG EQUAL TO 1 SQ2184.2 +059000 GO TO READ-FAIL-F1-05. SQ2184.2 +059100 READ-PASS-F1-05. SQ2184.2 +059200 PERFORM PASS. SQ2184.2 +059300 GO TO READ-WRITE-F1-05. SQ2184.2 +059400 READ-FAIL-F1-05. SQ2184.2 +059500 MOVE "ERROR READING SHORT;VII-13 SR (2), GR (1,2)" TO RE-MARKSQ2184.2 +059600 PERFORM FAIL. SQ2184.2 +059700 READ-WRITE-F1-05. SQ2184.2 +059800 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2184.2 +059900 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2184.2 +060000 PERFORM PRINT-DETAIL. SQ2184.2 +060100 READ-INIT-F1-06. SQ2184.2 +060200 READ SQ-VS6 RECORD END SQ2184.2 +060300 GO TO READ-TEST-F1-06. SQ2184.2 +060400 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2184.2 +060500 GO TO READ-FAIL-F1-06. SQ2184.2 +060600 READ-EOF-F1-06. SQ2184.2 +060700 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2184.2 +060800 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2184.2 +060900 GO TO READ-FAIL-F1-06. SQ2184.2 +061000 READ-TEST-F1-06. SQ2184.2 +061100 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2184.2 +061200 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2184.2 +061300 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2184.2 +061400 GO TO READ-FAIL-F1-06. SQ2184.2 +061500 READ-PASS-F1-06. SQ2184.2 +061600 PERFORM PASS. SQ2184.2 +061700 GO TO READ-WRITE-F1-06. SQ2184.2 +061800 READ-FAIL-F1-06. SQ2184.2 +061900 MOVE "VII-13 SR (2), GR (1,2)" TO RE-MARK. SQ2184.2 +062000 PERFORM FAIL. SQ2184.2 +062100 READ-WRITE-F1-06. SQ2184.2 +062200 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2184.2 +062300 MOVE "VERIFY FILE SQ-VS6" TO FEATURE. SQ2184.2 +062400 PERFORM PRINT-DETAIL. SQ2184.2 +062500 READ-CLOSE-F1-06. SQ2184.2 +062600 CLOSE SQ-VS6. SQ2184.2 +062700 SECT-SQ218A-0002 SECTION. SQ2184.2 +062800* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS WRITTEN SQ2184.2 +062900* ON THE OUTPUT DEVICE WHEN A SHORT RECORD IS WRITTEN. THE SQ2184.2 +063000* RECORD NUMBER IN CHARACTERS 126 THROUGH 130 IS UNIQUE SQ2184.2 +063100* FOR EACH RECORD. SQ2184.2 +063200 INFO-INIT-001. SQ2184.2 +063300 OPEN INPUT SQ-VS6. SQ2184.2 +063400 MOVE ZERO TO COUNT-OF-RECS. SQ2184.2 +063500 INFO-TEST-001. SQ2184.2 +063600 READ SQ-VS6 AT END SQ2184.2 +063700 GO TO INFO-END. SQ2184.2 +063800 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +063900 IF SQ-VS6-RECNO NOT EQUAL TO "00001" SQ2184.2 +064000 GO TO NO-INFO-001. SQ2184.2 +064100 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2184.2 +064200 MOVE "RECORD READ =" TO COMPUTED-A. SQ2184.2 +064300 MOVE 0001 TO CORRECT-18V0. SQ2184.2 +064400 GO TO INFO-WRITE-001. SQ2184.2 +064500 NO-INFO-001. SQ2184.2 +064600 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2184.2 +064700 INFO-WRITE-001. SQ2184.2 +064800 MOVE "READ SHORT RECORD" TO FEATURE. SQ2184.2 +064900 MOVE "INFO-TEST-001" TO PAR-NAME. SQ2184.2 +065000 PERFORM PRINT-DETAIL. SQ2184.2 +065100 INFO-INIT-002. SQ2184.2 +065200 READ SQ-VS6 RECORD AT END SQ2184.2 +065300 GO TO INFO-END. SQ2184.2 +065400 READ SQ-VS6 END SQ2184.2 +065500 GO TO INFO-END. SQ2184.2 +065600 INFO-TEST-002. SQ2184.2 +065700 READ SQ-VS6 AT END SQ2184.2 +065800 GO TO INFO-END. SQ2184.2 +065900 IF SQ-VS6-RECNO NOT EQUAL TO "00004" SQ2184.2 +066000 GO TO NO-INFO-002. SQ2184.2 +066100 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2184.2 +066200 MOVE "RECORD READ =" TO COMPUTED-A. SQ2184.2 +066300 MOVE 0004 TO CORRECT-18V0. SQ2184.2 +066400 GO TO INFO-WRITE-002. SQ2184.2 +066500 NO-INFO-002. SQ2184.2 +066600 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2184.2 +066700 INFO-WRITE-002. SQ2184.2 +066800 MOVE "READ SHORT RECORD" TO FEATURE. SQ2184.2 +066900 MOVE "INFO-TEST-002" TO PAR-NAME. SQ2184.2 +067000 PERFORM PRINT-DETAIL. SQ2184.2 +067100 INFO-INIT-003. SQ2184.2 +067200 ADD 3 TO COUNT-OF-RECS. SQ2184.2 +067300 INFO-INIT-003-1. SQ2184.2 +067400 READ SQ-VS6 RECORD SQ2184.2 +067500 END GO TO INFO-END. SQ2184.2 +067600 ADD 1 TO COUNT-OF-RECS. SQ2184.2 +067700 IF COUNT-OF-RECS EQUAL TO 450 SQ2184.2 +067800 GO TO INFO-TEST-003. SQ2184.2 +067900 GO TO INFO-INIT-003-1. SQ2184.2 +068000 INFO-TEST-003. SQ2184.2 +068100 IF SQ-VS6-RECNO NOT EQUAL TO "00450" SQ2184.2 +068200 GO TO NO-INFO-003. SQ2184.2 +068300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2184.2 +068400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2184.2 +068500 MOVE 0450 TO CORRECT-18V0. SQ2184.2 +068600 GO TO INFO-WRITE-003. SQ2184.2 +068700 NO-INFO-003. SQ2184.2 +068800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2184.2 +068900 INFO-WRITE-003. SQ2184.2 +069000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2184.2 +069100 MOVE "INFO-TEST-003" TO PAR-NAME. SQ2184.2 +069200 PERFORM PRINT-DETAIL. SQ2184.2 +069300 INFO-END. SQ2184.2 +069400 CLOSE SQ-VS6. SQ2184.2 +069500 TERMINATE-ROUTINE. SQ2184.2 +069600 EXIT. SQ2184.2 +069700 CCVS-EXIT SECTION. SQ2184.2 +069800 CCVS-999999. SQ2184.2 +069900 GO TO CLOSE-FILES. SQ2184.2 diff --git a/tests/cobol85/SQ/SQ219A.CBL b/tests/cobol85/SQ/SQ219A.CBL new file mode 100755 index 00000000..6616a7a7 --- /dev/null +++ b/tests/cobol85/SQ/SQ219A.CBL @@ -0,0 +1,702 @@ +000100 IDENTIFICATION DIVISION. SQ2194.2 +000200 PROGRAM-ID. SQ2194.2 +000300 SQ219A. SQ2194.2 +000400**************************************************************** SQ2194.2 +000500* * SQ2194.2 +000600* VALIDATION FOR:- * SQ2194.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2194.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2194.2 +000900* * SQ2194.2 +001000* CREATION DATE / VALIDATION DATE * SQ2194.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2194.2 +001200* * SQ2194.2 +001300* THIS ROUTINE CHECKS THE SQ2194.2 +001400* RECORD DELIMITER IS IMPLEMENTOR-NAME LAUSE. SQ2194.2 +001500* SQ2194.2 +001600* SEE VII-13. SQ2194.2 +001700* SQ2194.2 +001800* SQ2194.2 +001900* THIS ROUTINE BUILDS A SEQUENTIAL TAPE FILE WHICH CONTAINS SQ2194.2 +002000* BOTH 120 CHARACTER AND 151 CHARACTER RECORDS. THE TAPE SQ2194.2 +002100* CONSISTS OF 1 SHORT, 1 LONG, 10 SHORT, 100 LONG, AND 338 SQ2194.2 +002200* SHORT RECORDS FOR A TOTAL OF 450 RECORDS IN THE FILE. SQ2194.2 +002300* THE TAPE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2194.2 +002400* AGAINST THE EXPECTED VALUES. SQ2194.2 +002500* SQ2194.2 +002600* AN INFORMATION SECTION AT THE END OF THE ROUTINE CHECKS SQ2194.2 +002700* THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. THIS FIELD IS SQ2194.2 +002800* PART OF A LONG RECORD ONLY. IF THE XRECORD-NUMBER IS THERE SQ2194.2 +002900* FOR A SHORT RECORD, IT MEANS THE MAXIMUM SIZE RECORD IS SQ2194.2 +003000* ALWAYS WRITTEN. SQ2194.2 +003100 ENVIRONMENT DIVISION. SQ2194.2 +003200 CONFIGURATION SECTION. SQ2194.2 +003300 SOURCE-COMPUTER. SQ2194.2 +003400 Linux. SQ2194.2 +003500 OBJECT-COMPUTER. SQ2194.2 +003600 Linux. SQ2194.2 +003700 INPUT-OUTPUT SECTION. SQ2194.2 +003800 FILE-CONTROL. SQ2194.2 +003900*P SELECT RAW-DATA ASSIGN TO SQ2194.2 +004000*P "XXXXX062" SQ2194.2 +004100*P ORGANIZATION IS INDEXED SQ2194.2 +004200*P ACCESS MODE IS RANDOM SQ2194.2 +004300*P RECORD KEY IS RAW-DATA-KEY. SQ2194.2 +004400 SELECT PRINT-FILE ASSIGN TO SQ2194.2 +004500 "report.log". SQ2194.2 +004600 SELECT SQ-VS6 ASSIGN SQ2194.2 +004700 "XXXXX001" SQ2194.2 +004800 RECORD DELIMITER SQ2194.2 +004900 STANDARD-1 SQ2194.2 +005000 ORGANIZATION IS SEQUENTIAL. SQ2194.2 +005100 DATA DIVISION. SQ2194.2 +005200 FILE SECTION. SQ2194.2 +005300*P SQ2194.2 +005400*PD RAW-DATA. SQ2194.2 +005500*P SQ2194.2 +005600*P1 RAW-DATA-SATZ. SQ2194.2 +005700*P 05 RAW-DATA-KEY PIC X(6). SQ2194.2 +005800*P 05 C-DATE PIC 9(6). SQ2194.2 +005900*P 05 C-TIME PIC 9(8). SQ2194.2 +006000*P 05 C-NO-OF-TESTS PIC 99. SQ2194.2 +006100*P 05 C-OK PIC 999. SQ2194.2 +006200*P 05 C-ALL PIC 999. SQ2194.2 +006300*P 05 C-FAIL PIC 999. SQ2194.2 +006400*P 05 C-DELETED PIC 999. SQ2194.2 +006500*P 05 C-INSPECT PIC 999. SQ2194.2 +006600*P 05 C-NOTE PIC X(13). SQ2194.2 +006700*P 05 C-INDENT PIC X. SQ2194.2 +006800*P 05 C-ABORT PIC X(8). SQ2194.2 +006900 FD PRINT-FILE SQ2194.2 +007000*C LABEL RECORDS SQ2194.2 +007100*C OMITTED SQ2194.2 +007200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2194.2 +007300 . SQ2194.2 +007400 01 PRINT-REC PICTURE X(120). SQ2194.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ2194.2 +007600 SQ2194.2 +007700 FD SQ-VS6 SQ2194.2 +007800 RECORD CONTAINS 120 TO 151 CHARACTERS SQ2194.2 +007900*C LABEL RECORDS ARE STANDARD SQ2194.2 +008000*C DATA RECORDS ARE SQ-VS6R1-M-G-120 SQ-VS6R2-M-G-151 SQ2194.2 +008100 . SQ2194.2 +008200 01 SQ-VS6R1-M-G-120. SQ2194.2 +008300 02 SQ-VS6R1-FIRST PIC X(120). SQ2194.2 +008400 01 SQ-VS6R2-M-G-151. SQ2194.2 +008500 02 SQ-VS6R2-FIRST PIC X(120). SQ2194.2 +008600 02 LONG-OR-SHORT PIC X(5). SQ2194.2 +008700 02 SQ-VS6-RECNO PIC X(5). SQ2194.2 +008800 02 SQ-VS6-FILLER PIC X(21). SQ2194.2 +008900 WORKING-STORAGE SECTION. SQ2194.2 +009000 01 SAVE-COUNT-OF-RECS PIC X(5). SQ2194.2 +009100 01 COUNT-OF-RECS PIC S9(5) COMP. SQ2194.2 +009200 01 RECORDS-IN-ERROR PIC S9(5) COMP. SQ2194.2 +009300 01 ERROR-FLAG PIC 9. SQ2194.2 +009400 01 EOF-FLAG PIC 9. SQ2194.2 +009500 01 DUMP-AREA. SQ2194.2 +009600 02 TYPE-OF-REC PICTURE X(5). SQ2194.2 +009700 02 RECNO PIC 9(5). SQ2194.2 +009800 02 FILLER PIC X(21). SQ2194.2 +009900 01 FILE-RECORD-INFORMATION-REC. SQ2194.2 +010000 03 FILE-RECORD-INFO-SKELETON. SQ2194.2 +010100 05 FILLER PICTURE X(48) VALUE SQ2194.2 +010200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2194.2 +010300 05 FILLER PICTURE X(46) VALUE SQ2194.2 +010400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2194.2 +010500 05 FILLER PICTURE X(26) VALUE SQ2194.2 +010600 ",LFIL=000000,ORG= ,LBLR= ". SQ2194.2 +010700 05 FILLER PICTURE X(37) VALUE SQ2194.2 +010800 ",RECKEY= ". SQ2194.2 +010900 05 FILLER PICTURE X(38) VALUE SQ2194.2 +011000 ",ALTKEY1= ". SQ2194.2 +011100 05 FILLER PICTURE X(38) VALUE SQ2194.2 +011200 ",ALTKEY2= ". SQ2194.2 +011300 05 FILLER PICTURE X(7) VALUE SPACE.SQ2194.2 +011400 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2194.2 +011500 05 FILE-RECORD-INFO-P1-120. SQ2194.2 +011600 07 FILLER PIC X(5). SQ2194.2 +011700 07 XFILE-NAME PIC X(6). SQ2194.2 +011800 07 FILLER PIC X(8). SQ2194.2 +011900 07 XRECORD-NAME PIC X(6). SQ2194.2 +012000 07 FILLER PIC X(1). SQ2194.2 +012100 07 REELUNIT-NUMBER PIC 9(1). SQ2194.2 +012200 07 FILLER PIC X(7). SQ2194.2 +012300 07 XRECORD-NUMBER PIC 9(6). SQ2194.2 +012400 07 FILLER PIC X(6). SQ2194.2 +012500 07 UPDATE-NUMBER PIC 9(2). SQ2194.2 +012600 07 FILLER PIC X(5). SQ2194.2 +012700 07 ODO-NUMBER PIC 9(4). SQ2194.2 +012800 07 FILLER PIC X(5). SQ2194.2 +012900 07 XPROGRAM-NAME PIC X(5). SQ2194.2 +013000 07 FILLER PIC X(7). SQ2194.2 +013100 07 XRECORD-LENGTH PIC 9(6). SQ2194.2 +013200 07 FILLER PIC X(7). SQ2194.2 +013300 07 CHARS-OR-RECORDS PIC X(2). SQ2194.2 +013400 07 FILLER PIC X(1). SQ2194.2 +013500 07 XBLOCK-SIZE PIC 9(4). SQ2194.2 +013600 07 FILLER PIC X(6). SQ2194.2 +013700 07 RECORDS-IN-FILE PIC 9(6). SQ2194.2 +013800 07 FILLER PIC X(5). SQ2194.2 +013900 07 XFILE-ORGANIZATION PIC X(2). SQ2194.2 +014000 07 FILLER PIC X(6). SQ2194.2 +014100 07 XLABEL-TYPE PIC X(1). SQ2194.2 +014200 05 FILE-RECORD-INFO-P121-240. SQ2194.2 +014300 07 FILLER PIC X(8). SQ2194.2 +014400 07 XRECORD-KEY PIC X(29). SQ2194.2 +014500 07 FILLER PIC X(9). SQ2194.2 +014600 07 ALTERNATE-KEY1 PIC X(29). SQ2194.2 +014700 07 FILLER PIC X(9). SQ2194.2 +014800 07 ALTERNATE-KEY2 PIC X(29). SQ2194.2 +014900 07 FILLER PIC X(7). SQ2194.2 +015000 01 TEST-RESULTS. SQ2194.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ2194.2 +015200 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2194.2 +015300 02 FILLER PICTURE X VALUE SPACE. SQ2194.2 +015400 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2194.2 +015500 02 FILLER PICTURE X VALUE SPACE. SQ2194.2 +015600 02 PAR-NAME. SQ2194.2 +015700 03 FILLER PICTURE X(12) VALUE SPACE. SQ2194.2 +015800 03 PARDOT-X PICTURE X VALUE SPACE. SQ2194.2 +015900 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2194.2 +016000 03 FILLER PIC X(5) VALUE SPACE. SQ2194.2 +016100 02 FILLER PIC X(10) VALUE SPACE. SQ2194.2 +016200 02 RE-MARK PIC X(61). SQ2194.2 +016300 01 TEST-COMPUTED. SQ2194.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ2194.2 +016500 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2194.2 +016600 02 COMPUTED-X. SQ2194.2 +016700 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2194.2 +016800 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2194.2 +016900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2194.2 +017000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2194.2 +017100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2194.2 +017200 03 CM-18V0 REDEFINES COMPUTED-A. SQ2194.2 +017300 04 COMPUTED-18V0 PICTURE -9(18). SQ2194.2 +017400 04 FILLER PICTURE X. SQ2194.2 +017500 03 FILLER PIC X(50) VALUE SPACE. SQ2194.2 +017600 01 TEST-CORRECT. SQ2194.2 +017700 02 FILLER PIC X(30) VALUE SPACE. SQ2194.2 +017800 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2194.2 +017900 02 CORRECT-X. SQ2194.2 +018000 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2194.2 +018100 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2194.2 +018200 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2194.2 +018300 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2194.2 +018400 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2194.2 +018500 03 CR-18V0 REDEFINES CORRECT-A. SQ2194.2 +018600 04 CORRECT-18V0 PICTURE -9(18). SQ2194.2 +018700 04 FILLER PICTURE X. SQ2194.2 +018800 03 FILLER PIC X(50) VALUE SPACE. SQ2194.2 +018900 01 CCVS-C-1. SQ2194.2 +019000 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2194.2 +019100- "SS PARAGRAPH-NAME SQ2194.2 +019200- " REMARKS". SQ2194.2 +019300 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2194.2 +019400 01 CCVS-C-2. SQ2194.2 +019500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2194.2 +019600 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2194.2 +019700 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2194.2 +019800 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2194.2 +019900 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2194.2 +020000 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2194.2 +020100 01 REC-CT PICTURE 99 VALUE ZERO. SQ2194.2 +020200 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2194.2 +020300 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2194.2 +020400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2194.2 +020500 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2194.2 +020600 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2194.2 +020700 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2194.2 +020800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2194.2 +020900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2194.2 +021000 01 CCVS-H-1. SQ2194.2 +021100 02 FILLER PICTURE X(27) VALUE SPACE. SQ2194.2 +021200 02 FILLER PICTURE X(67) VALUE SQ2194.2 +021300 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2194.2 +021400- " SYSTEM". SQ2194.2 +021500 02 FILLER PICTURE X(26) VALUE SPACE. SQ2194.2 +021600 01 CCVS-H-2. SQ2194.2 +021700 02 FILLER PICTURE X(52) VALUE IS SQ2194.2 +021800 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2194.2 +021900 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2194.2 +022000 02 TEST-ID PICTURE IS X(9). SQ2194.2 +022100 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2194.2 +022200 01 CCVS-H-3. SQ2194.2 +022300 02 FILLER PICTURE X(34) VALUE SQ2194.2 +022400 " FOR OFFICIAL USE ONLY ". SQ2194.2 +022500 02 FILLER PICTURE X(58) VALUE SQ2194.2 +022600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2194.2 +022700 02 FILLER PICTURE X(28) VALUE SQ2194.2 +022800 " COPYRIGHT 1985 ". SQ2194.2 +022900 01 CCVS-E-1. SQ2194.2 +023000 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2194.2 +023100 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2194.2 +023200 02 ID-AGAIN PICTURE IS X(9). SQ2194.2 +023300 02 FILLER PICTURE X(45) VALUE IS SQ2194.2 +023400 " NTIS DISTRIBUTION COBOL 85". SQ2194.2 +023500 01 CCVS-E-2. SQ2194.2 +023600 02 FILLER PICTURE X(31) VALUE SQ2194.2 +023700 SPACE. SQ2194.2 +023800 02 FILLER PICTURE X(21) VALUE SPACE. SQ2194.2 +023900 02 CCVS-E-2-2. SQ2194.2 +024000 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2194.2 +024100 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2194.2 +024200 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2194.2 +024300 01 CCVS-E-3. SQ2194.2 +024400 02 FILLER PICTURE X(22) VALUE SQ2194.2 +024500 " FOR OFFICIAL USE ONLY". SQ2194.2 +024600 02 FILLER PICTURE X(12) VALUE SPACE. SQ2194.2 +024700 02 FILLER PICTURE X(58) VALUE SQ2194.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2194.2 +024900 02 FILLER PICTURE X(13) VALUE SPACE. SQ2194.2 +025000 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2194.2 +025100 01 CCVS-E-4. SQ2194.2 +025200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2194.2 +025300 02 FILLER PIC XXXX VALUE " OF ". SQ2194.2 +025400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2194.2 +025500 02 FILLER PIC X(40) VALUE SQ2194.2 +025600 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2194.2 +025700 01 XXINFO. SQ2194.2 +025800 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2194.2 +025900 02 INFO-TEXT. SQ2194.2 +026000 04 FILLER PIC X(20) VALUE SPACE. SQ2194.2 +026100 04 XXCOMPUTED PIC X(20). SQ2194.2 +026200 04 FILLER PIC X(5) VALUE SPACE. SQ2194.2 +026300 04 XXCORRECT PIC X(20). SQ2194.2 +026400 01 HYPHEN-LINE. SQ2194.2 +026500 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2194.2 +026600 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2194.2 +026700- "*****************************************". SQ2194.2 +026800 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2194.2 +026900- "******************************". SQ2194.2 +027000 01 CCVS-PGM-ID PIC X(6) VALUE SQ2194.2 +027100 "SQ219A". SQ2194.2 +027200 PROCEDURE DIVISION. SQ2194.2 +027300 CCVS1 SECTION. SQ2194.2 +027400 OPEN-FILES. SQ2194.2 +027500*P OPEN I-O RAW-DATA. SQ2194.2 +027600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2194.2 +027700*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2194.2 +027800*P MOVE "ABORTED " TO C-ABORT. SQ2194.2 +027900*P ADD 1 TO C-NO-OF-TESTS. SQ2194.2 +028000*P ACCEPT C-DATE FROM DATE. SQ2194.2 +028100*P ACCEPT C-TIME FROM TIME. SQ2194.2 +028200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2194.2 +028300*PND-E-1. SQ2194.2 +028400*P CLOSE RAW-DATA. SQ2194.2 +028500 OPEN OUTPUT PRINT-FILE. SQ2194.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2194.2 +028700 MOVE SPACE TO TEST-RESULTS. SQ2194.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2194.2 +028900 MOVE ZERO TO REC-SKL-SUB. SQ2194.2 +029000 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2194.2 +029100 CCVS-INIT-FILE. SQ2194.2 +029200 ADD 1 TO REC-SKL-SUB. SQ2194.2 +029300 MOVE FILE-RECORD-INFO-SKELETON TO SQ2194.2 +029400 FILE-RECORD-INFO (REC-SKL-SUB). SQ2194.2 +029500 CCVS-INIT-EXIT. SQ2194.2 +029600 GO TO CCVS1-EXIT. SQ2194.2 +029700 CLOSE-FILES. SQ2194.2 +029800 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2194.2 +029900*P OPEN I-O RAW-DATA. SQ2194.2 +030000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2194.2 +030100*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2194.2 +030200*P MOVE "OK. " TO C-ABORT. SQ2194.2 +030300*P MOVE PASS-COUNTER TO C-OK. SQ2194.2 +030400*P MOVE ERROR-HOLD TO C-ALL. SQ2194.2 +030500*P MOVE ERROR-COUNTER TO C-FAIL. SQ2194.2 +030600*P MOVE DELETE-CNT TO C-DELETED. SQ2194.2 +030700*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2194.2 +030800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2194.2 +030900*PND-E-2. SQ2194.2 +031000*P CLOSE RAW-DATA. SQ2194.2 +031100 TERMINATE-CCVS. SQ2194.2 +031200*S EXIT PROGRAM. SQ2194.2 +031300*SERMINATE-CALL. SQ2194.2 +031400 STOP RUN. SQ2194.2 +031500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2194.2 +031600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2194.2 +031700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2194.2 +031800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2194.2 +031900 MOVE "****TEST DELETED****" TO RE-MARK. SQ2194.2 +032000 PRINT-DETAIL. SQ2194.2 +032100 IF REC-CT NOT EQUAL TO ZERO SQ2194.2 +032200 MOVE "." TO PARDOT-X SQ2194.2 +032300 MOVE REC-CT TO DOTVALUE. SQ2194.2 +032400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2194.2 +032500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2194.2 +032600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2194.2 +032700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2194.2 +032800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2194.2 +032900 MOVE SPACE TO CORRECT-X. SQ2194.2 +033000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2194.2 +033100 MOVE SPACE TO RE-MARK. SQ2194.2 +033200 HEAD-ROUTINE. SQ2194.2 +033300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +033400 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2194.2 +033500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2194.2 +033600 COLUMN-NAMES-ROUTINE. SQ2194.2 +033700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +033800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +033900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +034000 END-ROUTINE. SQ2194.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2194.2 +034200 END-RTN-EXIT. SQ2194.2 +034300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +034400 END-ROUTINE-1. SQ2194.2 +034500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2194.2 +034600 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2194.2 +034700 ADD PASS-COUNTER TO ERROR-HOLD. SQ2194.2 +034800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2194.2 +034900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2194.2 +035000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2194.2 +035100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2194.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2194.2 +035300 END-ROUTINE-12. SQ2194.2 +035400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2194.2 +035500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2194.2 +035600 MOVE "NO " TO ERROR-TOTAL SQ2194.2 +035700 ELSE SQ2194.2 +035800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2194.2 +035900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2194.2 +036000 PERFORM WRITE-LINE. SQ2194.2 +036100 END-ROUTINE-13. SQ2194.2 +036200 IF DELETE-CNT IS EQUAL TO ZERO SQ2194.2 +036300 MOVE "NO " TO ERROR-TOTAL ELSE SQ2194.2 +036400 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2194.2 +036500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2194.2 +036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +036700 IF INSPECT-COUNTER EQUAL TO ZERO SQ2194.2 +036800 MOVE "NO " TO ERROR-TOTAL SQ2194.2 +036900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2194.2 +037000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2194.2 +037100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +037200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2194.2 +037300 WRITE-LINE. SQ2194.2 +037400 ADD 1 TO RECORD-COUNT. SQ2194.2 +037500 IF RECORD-COUNT GREATER 50 SQ2194.2 +037600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2194.2 +037700 MOVE SPACE TO DUMMY-RECORD SQ2194.2 +037800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2194.2 +037900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2194.2 +038000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2194.2 +038100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2194.2 +038200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2194.2 +038300 MOVE ZERO TO RECORD-COUNT. SQ2194.2 +038400 PERFORM WRT-LN. SQ2194.2 +038500 WRT-LN. SQ2194.2 +038600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2194.2 +038700 MOVE SPACE TO DUMMY-RECORD. SQ2194.2 +038800 BLANK-LINE-PRINT. SQ2194.2 +038900 PERFORM WRT-LN. SQ2194.2 +039000 FAIL-ROUTINE. SQ2194.2 +039100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2194.2 +039200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2194.2 +039300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2194.2 +039400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +039500 GO TO FAIL-ROUTINE-EX. SQ2194.2 +039600 FAIL-ROUTINE-WRITE. SQ2194.2 +039700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2194.2 +039800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +039900 FAIL-ROUTINE-EX. EXIT. SQ2194.2 +040000 BAIL-OUT. SQ2194.2 +040100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2194.2 +040200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2194.2 +040300 BAIL-OUT-WRITE. SQ2194.2 +040400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2194.2 +040500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2194.2 +040600 BAIL-OUT-EX. EXIT. SQ2194.2 +040700 CCVS1-EXIT. SQ2194.2 +040800 EXIT. SQ2194.2 +040900 SECT-SQ219A-0001 SECTION. SQ2194.2 +041000 WRITE-INIT-GF-01. SQ2194.2 +041100 MOVE "SQ-VS6" TO XFILE-NAME (1). SQ2194.2 +041200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2194.2 +041300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2194.2 +041400 MOVE 0001 TO XBLOCK-SIZE (1). SQ2194.2 +041500 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2194.2 +041600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2194.2 +041700 MOVE "S" TO XLABEL-TYPE (1). SQ2194.2 +041800 MOVE 000000 TO XRECORD-NUMBER (1). SQ2194.2 +041900 MOVE ZERO TO COUNT-OF-RECS. SQ2194.2 +042000 OPEN OUTPUT SQ-VS6. SQ2194.2 +042100 MOVE "MULTIPLE LENGTH RECS " TO SQ-VS6-FILLER. SQ2194.2 +042200 WRITE-TEST-GF-01. SQ2194.2 +042300 PERFORM WRITE-SHORT-REC. SQ2194.2 +042400 PERFORM WRITE-LONG-REC. SQ2194.2 +042500 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2194.2 +042600 PERFORM WRITE-LONG-REC 100 TIMES. SQ2194.2 +042700 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2194.2 +042800 WRITE-WRITE-GF-01. SQ2194.2 +042900 MOVE "CREATE FILE SQ-VS6" TO FEATURE. SQ2194.2 +043000 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2194.2 +043100 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2194.2 +043200 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2194.2 +043300 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2194.2 +043400 PERFORM PRINT-DETAIL. SQ2194.2 +043500* A SEQUENTIAL TAPE FILE CONTAINING 450 RECORDS HAS SQ2194.2 +043600* BEEN CREATED. THE FILE CONTAINS RECORDS OF 120 CHARACTERS SQ2194.2 +043700* AND RECORDS OF 151 CHARACTERS. THE SEQUENCE IN WHICH THE SQ2194.2 +043800* RECORDS WERE WRITTEN IS S-L-10S-100L-338S. SQ2194.2 +043900 WRITE-CLOSE-GF-01. SQ2194.2 +044000 CLOSE SQ-VS6. SQ2194.2 +044100 GO TO READ-INIT-F1-01. SQ2194.2 +044200 WRITE-SHORT-REC. SQ2194.2 +044300 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2194.2 +044400 MOVE 000120 TO XRECORD-LENGTH (1). SQ2194.2 +044500 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +044600 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2194.2 +044700 MOVE "SHORT" TO LONG-OR-SHORT. SQ2194.2 +044800 MOVE COUNT-OF-RECS TO SQ-VS6-RECNO. SQ2194.2 +044900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R1-FIRST. SQ2194.2 +045000 WRITE SQ-VS6R1-M-G-120. SQ2194.2 +045100 WRITE-LONG-REC. SQ2194.2 +045200 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2194.2 +045300 MOVE 000151 TO XRECORD-LENGTH (1). SQ2194.2 +045400 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +045500 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2194.2 +045600 MOVE "LONG" TO LONG-OR-SHORT. SQ2194.2 +045700 MOVE COUNT-OF-RECS TO SQ-VS6-RECNO. SQ2194.2 +045800 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS6R2-FIRST. SQ2194.2 +045900 WRITE SQ-VS6R2-M-G-151. SQ2194.2 +046000 READ-INIT-F1-01. SQ2194.2 +046100 MOVE ZERO TO COUNT-OF-RECS. SQ2194.2 +046200 MOVE ZERO TO EOF-FLAG. SQ2194.2 +046300 MOVE ZERO TO RECORDS-IN-ERROR. SQ2194.2 +046400 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +046500 OPEN INPUT SQ-VS6. SQ2194.2 +046600 READ-TEST-F1-01. SQ2194.2 +046700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2194.2 +046800 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +046900 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2194.2 +047000 GO TO READ-EOF-F1-06. SQ2194.2 +047100 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +047200 GO TO READ-FAIL-F1-01. SQ2194.2 +047300 READ-PASS-F1-01. SQ2194.2 +047400 PERFORM PASS. SQ2194.2 +047500 GO TO READ-WRITE-F1-01. SQ2194.2 +047600 READ-FAIL-F1-01. SQ2194.2 +047700 MOVE "ERROR ON FIRST READ;VII-13 GR (3) " TO RE-MARKSQ2194.2 +047800 PERFORM FAIL. SQ2194.2 +047900 READ-WRITE-F1-01. SQ2194.2 +048000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2194.2 +048100 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2194.2 +048200 PERFORM PRINT-DETAIL. SQ2194.2 +048300 GO TO READ-INIT-F1-02. SQ2194.2 +048400 READ-SHORT-REC. SQ2194.2 +048500 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +048600 GO TO READ-SHORT-REC-EXIT. SQ2194.2 +048700 READ SQ-VS6 AT END SQ2194.2 +048800 MOVE 1 TO EOF-FLAG SQ2194.2 +048900 GO TO READ-SHORT-REC-EXIT. SQ2194.2 +049000 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +049100 MOVE SQ-VS6R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2194.2 +049200 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2194.2 +049300 GO TO READ-SHORT-REC-ERROR. SQ2194.2 +049400 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ2194.2 +049500 GO TO READ-SHORT-REC-ERROR. SQ2194.2 +049600 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2194.2 +049700 GO TO READ-SHORT-REC-ERROR. SQ2194.2 +049800 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2194.2 +049900 GO TO READ-SHORT-REC-EXIT. SQ2194.2 +050000 READ-SHORT-REC-ERROR. SQ2194.2 +050100 ADD 1 TO RECORDS-IN-ERROR. SQ2194.2 +050200 MOVE 1 TO ERROR-FLAG. SQ2194.2 +050300 READ-SHORT-REC-EXIT. SQ2194.2 +050400 EXIT. SQ2194.2 +050500 READ-INIT-F1-02. SQ2194.2 +050600 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +050700 READ-TEST-F1-02. SQ2194.2 +050800 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2194.2 +050900 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +051000 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2194.2 +051100 GO TO READ-EOF-F1-06. SQ2194.2 +051200 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +051300 GO TO READ-FAIL-F1-02. SQ2194.2 +051400 READ-PASS-F1-02. SQ2194.2 +051500 PERFORM PASS. SQ2194.2 +051600 GO TO READ-WRITE-F1-02. SQ2194.2 +051700 READ-FAIL-F1-02. SQ2194.2 +051800 MOVE "ERROR ON SEC READ; VII-13 GR (3 " TO RE-MARK SQ2194.2 +051900 PERFORM FAIL. SQ2194.2 +052000 READ-WRITE-F1-02. SQ2194.2 +052100 MOVE "READ LONG RECORD" TO FEATURE. SQ2194.2 +052200 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2194.2 +052300 PERFORM PRINT-DETAIL. SQ2194.2 +052400 GO TO READ-INIT-F1-03. SQ2194.2 +052500 READ-LONG-REC. SQ2194.2 +052600 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +052700 GO TO READ-LONG-REC-EXIT. SQ2194.2 +052800 READ SQ-VS6 END SQ2194.2 +052900 MOVE 1 TO EOF-FLAG SQ2194.2 +053000 GO TO READ-LONG-REC-EXIT. SQ2194.2 +053100 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +053200 MOVE SQ-VS6R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2194.2 +053300 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2194.2 +053400 GO TO READ-LONG-REC-ERROR. SQ2194.2 +053500 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ2194.2 +053600 GO TO READ-LONG-REC-ERROR. SQ2194.2 +053700 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2194.2 +053800 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS6-RECNO SQ2194.2 +053900 GO TO READ-LONG-REC-ERROR. SQ2194.2 +054000 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2194.2 +054100 GO TO READ-LONG-REC-EXIT. SQ2194.2 +054200 READ-LONG-REC-ERROR. SQ2194.2 +054300 ADD 1 TO RECORDS-IN-ERROR. SQ2194.2 +054400 MOVE 1 TO ERROR-FLAG. SQ2194.2 +054500 READ-LONG-REC-EXIT. SQ2194.2 +054600 EXIT. SQ2194.2 +054700 READ-INIT-F1-03. SQ2194.2 +054800 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +054900 READ-TEST-F1-03. SQ2194.2 +055000 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2194.2 +055100 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +055200 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2194.2 +055300 GO TO READ-EOF-F1-06. SQ2194.2 +055400 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +055500 GO TO READ-FAIL-F1-03. SQ2194.2 +055600 READ-PASS-F1-03. SQ2194.2 +055700 PERFORM PASS. SQ2194.2 +055800 GO TO READ-WRITE-F1-03. SQ2194.2 +055900 READ-FAIL-F1-03. SQ2194.2 +056000 MOVE "ERROR REA SHORT REC; VII-13 SR (3) " TO RE-MARKSQ2194.2 +056100 PERFORM FAIL. SQ2194.2 +056200 READ-WRITE-F1-03. SQ2194.2 +056300 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2194.2 +056400 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2194.2 +056500 PERFORM PRINT-DETAIL. SQ2194.2 +056600 READ-INIT-F1-04. SQ2194.2 +056700 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +056800 READ-TEST-F1-04. SQ2194.2 +056900 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2194.2 +057000 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +057100 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2194.2 +057200 GO TO READ-EOF-F1-06. SQ2194.2 +057300 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +057400 GO TO READ-FAIL-F1-04. SQ2194.2 +057500 READ-PASS-F1-04. SQ2194.2 +057600 PERFORM PASS. SQ2194.2 +057700 GO TO READ-WRITE-F1-04. SQ2194.2 +057800 READ-FAIL-F1-04. SQ2194.2 +057900 PERFORM FAIL. SQ2194.2 +058000 MOVE "ERROR READING LONG RECORD" TO RE-MARK. SQ2194.2 +058100 READ-WRITE-F1-04. SQ2194.2 +058200 MOVE "READ LONG RECORDS" TO FEATURE. SQ2194.2 +058300 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2194.2 +058400 PERFORM PRINT-DETAIL. SQ2194.2 +058500 READ-INIT-F1-05. SQ2194.2 +058600 MOVE ZERO TO ERROR-FLAG. SQ2194.2 +058700 READ-TEST-F1-05. SQ2194.2 +058800 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2194.2 +058900 IF EOF-FLAG EQUAL TO 1 SQ2194.2 +059000 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2194.2 +059100 GO TO READ-EOF-F1-06. SQ2194.2 +059200 IF ERROR-FLAG EQUAL TO 1 SQ2194.2 +059300 GO TO READ-FAIL-F1-05. SQ2194.2 +059400 READ-PASS-F1-05. SQ2194.2 +059500 PERFORM PASS. SQ2194.2 +059600 GO TO READ-WRITE-F1-05. SQ2194.2 +059700 READ-FAIL-F1-05. SQ2194.2 +059800 MOVE "ERROR READING SHORT;VII-13 GR (3) " TO RE-MARKSQ2194.2 +059900 PERFORM FAIL. SQ2194.2 +060000 READ-WRITE-F1-05. SQ2194.2 +060100 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2194.2 +060200 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2194.2 +060300 PERFORM PRINT-DETAIL. SQ2194.2 +060400 READ-INIT-F1-06. SQ2194.2 +060500 READ SQ-VS6 RECORD END SQ2194.2 +060600 GO TO READ-TEST-F1-06. SQ2194.2 +060700 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2194.2 +060800 GO TO READ-FAIL-F1-06. SQ2194.2 +060900 READ-EOF-F1-06. SQ2194.2 +061000 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2194.2 +061100 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2194.2 +061200 GO TO READ-FAIL-F1-06. SQ2194.2 +061300 READ-TEST-F1-06. SQ2194.2 +061400 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2194.2 +061500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2194.2 +061600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2194.2 +061700 GO TO READ-FAIL-F1-06. SQ2194.2 +061800 READ-PASS-F1-06. SQ2194.2 +061900 PERFORM PASS. SQ2194.2 +062000 GO TO READ-WRITE-F1-06. SQ2194.2 +062100 READ-FAIL-F1-06. SQ2194.2 +062200 MOVE "VII-13 GR (3) " TO RE-MARK. SQ2194.2 +062300 PERFORM FAIL. SQ2194.2 +062400 READ-WRITE-F1-06. SQ2194.2 +062500 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2194.2 +062600 MOVE "VERIFY FILE SQ-VS6" TO FEATURE. SQ2194.2 +062700 PERFORM PRINT-DETAIL. SQ2194.2 +062800 READ-CLOSE-F1-06. SQ2194.2 +062900 CLOSE SQ-VS6. SQ2194.2 +063000 SECT-SQ219A-0002 SECTION. SQ2194.2 +063100* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS WRITTEN SQ2194.2 +063200* ON THE OUTPUT DEVICE WHEN A SHORT RECORD IS WRITTEN. THE SQ2194.2 +063300* RECORD NUMBER IN CHARACTERS 126 THROUGH 130 IS UNIQUE SQ2194.2 +063400* FOR EACH RECORD. SQ2194.2 +063500 INFO-INIT-001. SQ2194.2 +063600 OPEN INPUT SQ-VS6. SQ2194.2 +063700 MOVE ZERO TO COUNT-OF-RECS. SQ2194.2 +063800 INFO-TEST-001. SQ2194.2 +063900 READ SQ-VS6 AT END SQ2194.2 +064000 GO TO INFO-END. SQ2194.2 +064100 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +064200 IF SQ-VS6-RECNO NOT EQUAL TO "00001" SQ2194.2 +064300 GO TO NO-INFO-001. SQ2194.2 +064400 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2194.2 +064500 MOVE "RECORD READ =" TO COMPUTED-A. SQ2194.2 +064600 MOVE 0001 TO CORRECT-18V0. SQ2194.2 +064700 GO TO INFO-WRITE-001. SQ2194.2 +064800 NO-INFO-001. SQ2194.2 +064900 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2194.2 +065000 INFO-WRITE-001. SQ2194.2 +065100 MOVE "READ SHORT RECORD" TO FEATURE. SQ2194.2 +065200 MOVE "INFO-TEST-001" TO PAR-NAME. SQ2194.2 +065300 PERFORM PRINT-DETAIL. SQ2194.2 +065400 INFO-INIT-002. SQ2194.2 +065500 READ SQ-VS6 RECORD AT END SQ2194.2 +065600 GO TO INFO-END. SQ2194.2 +065700 READ SQ-VS6 END SQ2194.2 +065800 GO TO INFO-END. SQ2194.2 +065900 INFO-TEST-002. SQ2194.2 +066000 READ SQ-VS6 AT END SQ2194.2 +066100 GO TO INFO-END. SQ2194.2 +066200 IF SQ-VS6-RECNO NOT EQUAL TO "00004" SQ2194.2 +066300 GO TO NO-INFO-002. SQ2194.2 +066400 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2194.2 +066500 MOVE "RECORD READ =" TO COMPUTED-A. SQ2194.2 +066600 MOVE 0004 TO CORRECT-18V0. SQ2194.2 +066700 GO TO INFO-WRITE-002. SQ2194.2 +066800 NO-INFO-002. SQ2194.2 +066900 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2194.2 +067000 INFO-WRITE-002. SQ2194.2 +067100 MOVE "READ SHORT RECORD" TO FEATURE. SQ2194.2 +067200 MOVE "INFO-TEST-002" TO PAR-NAME. SQ2194.2 +067300 PERFORM PRINT-DETAIL. SQ2194.2 +067400 INFO-INIT-003. SQ2194.2 +067500 ADD 3 TO COUNT-OF-RECS. SQ2194.2 +067600 INFO-INIT-003-1. SQ2194.2 +067700 READ SQ-VS6 RECORD SQ2194.2 +067800 END GO TO INFO-END. SQ2194.2 +067900 ADD 1 TO COUNT-OF-RECS. SQ2194.2 +068000 IF COUNT-OF-RECS EQUAL TO 450 SQ2194.2 +068100 GO TO INFO-TEST-003. SQ2194.2 +068200 GO TO INFO-INIT-003-1. SQ2194.2 +068300 INFO-TEST-003. SQ2194.2 +068400 IF SQ-VS6-RECNO NOT EQUAL TO "00450" SQ2194.2 +068500 GO TO NO-INFO-003. SQ2194.2 +068600 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2194.2 +068700 MOVE "RECORD READ =" TO COMPUTED-A. SQ2194.2 +068800 MOVE 0450 TO CORRECT-18V0. SQ2194.2 +068900 GO TO INFO-WRITE-003. SQ2194.2 +069000 NO-INFO-003. SQ2194.2 +069100 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2194.2 +069200 INFO-WRITE-003. SQ2194.2 +069300 MOVE "READ SHORT RECORD" TO FEATURE. SQ2194.2 +069400 MOVE "INFO-TEST-003" TO PAR-NAME. SQ2194.2 +069500 PERFORM PRINT-DETAIL. SQ2194.2 +069600 INFO-END. SQ2194.2 +069700 CLOSE SQ-VS6. SQ2194.2 +069800 TERMINATE-ROUTINE. SQ2194.2 +069900 EXIT. SQ2194.2 +070000 CCVS-EXIT SECTION. SQ2194.2 +070100 CCVS-999999. SQ2194.2 +070200 GO TO CLOSE-FILES. SQ2194.2 diff --git a/tests/cobol85/SQ/SQ220A.CBL b/tests/cobol85/SQ/SQ220A.CBL new file mode 100755 index 00000000..fc721ae2 --- /dev/null +++ b/tests/cobol85/SQ/SQ220A.CBL @@ -0,0 +1,720 @@ +000100 IDENTIFICATION DIVISION. SQ2204.2 +000200 PROGRAM-ID. SQ2204.2 +000300 SQ220A. SQ2204.2 +000400**************************************************************** SQ2204.2 +000500* * SQ2204.2 +000600* VALIDATION FOR:- * SQ2204.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2204.2 +000800* * SQ2204.2 +000900* CREATION DATE / VALIDATION DATE * SQ2204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2204.2 +001100* * SQ2204.2 +001200* THIS ROUTINE CHECKS THE SQ2204.2 +001300* SQ2204.2 +001400* RECORD IS VARYING IN SIZE FROM 120 TO 151 CHARACTERS SQ2204.2 +001500* DEPENDING ON DATA-NAME-1 SQ2204.2 +001600* AND THE SQ2204.2 +001700* NEXT RECORD CLAUSE. SQ2204.2 +001800* SQ2204.2 +001900* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ2204.2 +002000* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ2204.2 +002100* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ2204.2 +002200* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ2204.2 +002300* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ2204.2 +002400* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2204.2 +002500* AGAINST THE EXPECTED VALUES. SQ2204.2 +002600* SQ2204.2 +002700* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ2204.2 +002800* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ2204.2 +002900* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ2204.2 +003000* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ2204.2 +003100* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ2204.2 +003200 ENVIRONMENT DIVISION. SQ2204.2 +003300 CONFIGURATION SECTION. SQ2204.2 +003400 SOURCE-COMPUTER. SQ2204.2 +003500 Linux. SQ2204.2 +003600 OBJECT-COMPUTER. SQ2204.2 +003700 Linux. SQ2204.2 +003800 INPUT-OUTPUT SECTION. SQ2204.2 +003900 FILE-CONTROL. SQ2204.2 +004000*P SELECT RAW-DATA ASSIGN TO SQ2204.2 +004100*P "XXXXX062" SQ2204.2 +004200*P ORGANIZATION IS INDEXED SQ2204.2 +004300*P ACCESS MODE IS RANDOM SQ2204.2 +004400*P RECORD KEY IS RAW-DATA-KEY. SQ2204.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2204.2 +004600 "report.log". SQ2204.2 +004700 SELECT SQ-VS7 ASSIGN TO SQ2204.2 +004800 "XXXXX014" SQ2204.2 +004900 ORGANIZATION SEQUENTIAL SQ2204.2 +005000 ACCESS SEQUENTIAL. SQ2204.2 +005100 DATA DIVISION. SQ2204.2 +005200 FILE SECTION. SQ2204.2 +005300*P SQ2204.2 +005400*PD RAW-DATA. SQ2204.2 +005500*P SQ2204.2 +005600*P1 RAW-DATA-SATZ. SQ2204.2 +005700*P 05 RAW-DATA-KEY PIC X(6). SQ2204.2 +005800*P 05 C-DATE PIC 9(6). SQ2204.2 +005900*P 05 C-TIME PIC 9(8). SQ2204.2 +006000*P 05 C-NO-OF-TESTS PIC 99. SQ2204.2 +006100*P 05 C-OK PIC 999. SQ2204.2 +006200*P 05 C-ALL PIC 999. SQ2204.2 +006300*P 05 C-FAIL PIC 999. SQ2204.2 +006400*P 05 C-DELETED PIC 999. SQ2204.2 +006500*P 05 C-INSPECT PIC 999. SQ2204.2 +006600*P 05 C-NOTE PIC X(13). SQ2204.2 +006700*P 05 C-INDENT PIC X. SQ2204.2 +006800*P 05 C-ABORT PIC X(8). SQ2204.2 +006900 FD PRINT-FILE SQ2204.2 +007000*C LABEL RECORDS SQ2204.2 +007100*C OMITTED SQ2204.2 +007200*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2204.2 +007300 . SQ2204.2 +007400 01 PRINT-REC PICTURE X(120). SQ2204.2 +007500 01 DUMMY-RECORD PICTURE X(120). SQ2204.2 +007600 FD SQ-VS7 SQ2204.2 +007700*C LABEL RECORDS ARE STANDARD SQ2204.2 +007800 RECORD IS VARYING IN SIZE FROM 120 TO 151 CHARACTERS SQ2204.2 +007900 DEPENDING ON RECORD-LENGTH. SQ2204.2 +008000 01 SQ-VS7R1-M-G-120. SQ2204.2 +008100 02 SQ-VS7R1-FIRST PICTURE X(120). SQ2204.2 +008200 01 SQ-VS7R2-M-G-151. SQ2204.2 +008300 02 SQ-VS7R2-FIRST PICTURE X(120). SQ2204.2 +008400 02 LONG-OR-SHORT PICTURE X(5). SQ2204.2 +008500 02 SQ-VS7-RECNO PICTURE X(5). SQ2204.2 +008600 02 SQ-VS7-FILLER PICTURE X(21). SQ2204.2 +008700 WORKING-STORAGE SECTION. SQ2204.2 +008800 01 RECORD-LENGTH PICTURE 999 VALUE ZERO. SQ2204.2 +008900 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2204.2 +009000 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2204.2 +009100 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ2204.2 +009200 01 ERROR-FLAG PICTURE 9. SQ2204.2 +009300 01 EOF-FLAG PICTURE 9. SQ2204.2 +009400 01 DUMP-AREA. SQ2204.2 +009500 02 TYPE-OF-REC PICTURE X(5). SQ2204.2 +009600 02 RECNO PICTURE 9(5). SQ2204.2 +009700 02 FILLER PICTURE X(21). SQ2204.2 +009800 01 FILE-RECORD-INFORMATION-REC. SQ2204.2 +009900 03 FILE-RECORD-INFO-SKELETON. SQ2204.2 +010000 05 FILLER PICTURE X(48) VALUE SQ2204.2 +010100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2204.2 +010200 05 FILLER PICTURE X(46) VALUE SQ2204.2 +010300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2204.2 +010400 05 FILLER PICTURE X(26) VALUE SQ2204.2 +010500 ",LFIL=000000,ORG= ,LBLR= ". SQ2204.2 +010600 05 FILLER PICTURE X(37) VALUE SQ2204.2 +010700 ",RECKEY= ". SQ2204.2 +010800 05 FILLER PICTURE X(38) VALUE SQ2204.2 +010900 ",ALTKEY1= ". SQ2204.2 +011000 05 FILLER PICTURE X(38) VALUE SQ2204.2 +011100 ",ALTKEY2= ". SQ2204.2 +011200 05 FILLER PICTURE X(7) VALUE SPACE.SQ2204.2 +011300 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2204.2 +011400 05 FILE-RECORD-INFO-P1-120. SQ2204.2 +011500 07 FILLER PIC X(5). SQ2204.2 +011600 07 XFILE-NAME PIC X(6). SQ2204.2 +011700 07 FILLER PIC X(8). SQ2204.2 +011800 07 XRECORD-NAME PIC X(6). SQ2204.2 +011900 07 FILLER PIC X(1). SQ2204.2 +012000 07 REELUNIT-NUMBER PIC 9(1). SQ2204.2 +012100 07 FILLER PIC X(7). SQ2204.2 +012200 07 XRECORD-NUMBER PIC 9(6). SQ2204.2 +012300 07 FILLER PIC X(6). SQ2204.2 +012400 07 UPDATE-NUMBER PIC 9(2). SQ2204.2 +012500 07 FILLER PIC X(5). SQ2204.2 +012600 07 ODO-NUMBER PIC 9(4). SQ2204.2 +012700 07 FILLER PIC X(5). SQ2204.2 +012800 07 XPROGRAM-NAME PIC X(5). SQ2204.2 +012900 07 FILLER PIC X(7). SQ2204.2 +013000 07 XRECORD-LENGTH PIC 9(6). SQ2204.2 +013100 07 FILLER PIC X(7). SQ2204.2 +013200 07 CHARS-OR-RECORDS PIC X(2). SQ2204.2 +013300 07 FILLER PIC X(1). SQ2204.2 +013400 07 XBLOCK-SIZE PIC 9(4). SQ2204.2 +013500 07 FILLER PIC X(6). SQ2204.2 +013600 07 RECORDS-IN-FILE PIC 9(6). SQ2204.2 +013700 07 FILLER PIC X(5). SQ2204.2 +013800 07 XFILE-ORGANIZATION PIC X(2). SQ2204.2 +013900 07 FILLER PIC X(6). SQ2204.2 +014000 07 XLABEL-TYPE PIC X(1). SQ2204.2 +014100 05 FILE-RECORD-INFO-P121-240. SQ2204.2 +014200 07 FILLER PIC X(8). SQ2204.2 +014300 07 XRECORD-KEY PIC X(29). SQ2204.2 +014400 07 FILLER PIC X(9). SQ2204.2 +014500 07 ALTERNATE-KEY1 PIC X(29). SQ2204.2 +014600 07 FILLER PIC X(9). SQ2204.2 +014700 07 ALTERNATE-KEY2 PIC X(29). SQ2204.2 +014800 07 FILLER PIC X(7). SQ2204.2 +014900 01 TEST-RESULTS. SQ2204.2 +015000 02 FILLER PICTURE X VALUE SPACE. SQ2204.2 +015100 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2204.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ2204.2 +015300 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2204.2 +015400 02 FILLER PICTURE X VALUE SPACE. SQ2204.2 +015500 02 PAR-NAME. SQ2204.2 +015600 03 FILLER PICTURE X(12) VALUE SPACE. SQ2204.2 +015700 03 PARDOT-X PICTURE X VALUE SPACE. SQ2204.2 +015800 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2204.2 +015900 03 FILLER PIC X(5) VALUE SPACE. SQ2204.2 +016000 02 FILLER PIC X(10) VALUE SPACE. SQ2204.2 +016100 02 RE-MARK PIC X(61). SQ2204.2 +016200 01 TEST-COMPUTED. SQ2204.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ2204.2 +016400 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2204.2 +016500 02 COMPUTED-X. SQ2204.2 +016600 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2204.2 +016700 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2204.2 +016800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2204.2 +016900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2204.2 +017000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2204.2 +017100 03 CM-18V0 REDEFINES COMPUTED-A. SQ2204.2 +017200 04 COMPUTED-18V0 PICTURE -9(18). SQ2204.2 +017300 04 FILLER PICTURE X. SQ2204.2 +017400 03 FILLER PIC X(50) VALUE SPACE. SQ2204.2 +017500 01 TEST-CORRECT. SQ2204.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SQ2204.2 +017700 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2204.2 +017800 02 CORRECT-X. SQ2204.2 +017900 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2204.2 +018000 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2204.2 +018100 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2204.2 +018200 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2204.2 +018300 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2204.2 +018400 03 CR-18V0 REDEFINES CORRECT-A. SQ2204.2 +018500 04 CORRECT-18V0 PICTURE -9(18). SQ2204.2 +018600 04 FILLER PICTURE X. SQ2204.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SQ2204.2 +018800 01 CCVS-C-1. SQ2204.2 +018900 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2204.2 +019000- "SS PARAGRAPH-NAME SQ2204.2 +019100- " REMARKS". SQ2204.2 +019200 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2204.2 +019300 01 CCVS-C-2. SQ2204.2 +019400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2204.2 +019500 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2204.2 +019600 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2204.2 +019700 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2204.2 +019800 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2204.2 +019900 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2204.2 +020000 01 REC-CT PICTURE 99 VALUE ZERO. SQ2204.2 +020100 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2204.2 +020200 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2204.2 +020300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2204.2 +020400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2204.2 +020500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2204.2 +020600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2204.2 +020700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2204.2 +020800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2204.2 +020900 01 CCVS-H-1. SQ2204.2 +021000 02 FILLER PICTURE X(27) VALUE SPACE. SQ2204.2 +021100 02 FILLER PICTURE X(67) VALUE SQ2204.2 +021200 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2204.2 +021300- " SYSTEM". SQ2204.2 +021400 02 FILLER PICTURE X(26) VALUE SPACE. SQ2204.2 +021500 01 CCVS-H-2. SQ2204.2 +021600 02 FILLER PICTURE X(52) VALUE IS SQ2204.2 +021700 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2204.2 +021800 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2204.2 +021900 02 TEST-ID PICTURE IS X(9). SQ2204.2 +022000 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2204.2 +022100 01 CCVS-H-3. SQ2204.2 +022200 02 FILLER PICTURE X(34) VALUE SQ2204.2 +022300 " FOR OFFICIAL USE ONLY ". SQ2204.2 +022400 02 FILLER PICTURE X(58) VALUE SQ2204.2 +022500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2204.2 +022600 02 FILLER PICTURE X(28) VALUE SQ2204.2 +022700 " COPYRIGHT 1985 ". SQ2204.2 +022800 01 CCVS-E-1. SQ2204.2 +022900 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2204.2 +023000 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2204.2 +023100 02 ID-AGAIN PICTURE IS X(9). SQ2204.2 +023200 02 FILLER PICTURE X(45) VALUE IS SQ2204.2 +023300 " NTIS DISTRIBUTION COBOL 85". SQ2204.2 +023400 01 CCVS-E-2. SQ2204.2 +023500 02 FILLER PICTURE X(31) VALUE SQ2204.2 +023600 SPACE. SQ2204.2 +023700 02 FILLER PICTURE X(21) VALUE SPACE. SQ2204.2 +023800 02 CCVS-E-2-2. SQ2204.2 +023900 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2204.2 +024000 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2204.2 +024100 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2204.2 +024200 01 CCVS-E-3. SQ2204.2 +024300 02 FILLER PICTURE X(22) VALUE SQ2204.2 +024400 " FOR OFFICIAL USE ONLY". SQ2204.2 +024500 02 FILLER PICTURE X(12) VALUE SPACE. SQ2204.2 +024600 02 FILLER PICTURE X(58) VALUE SQ2204.2 +024700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2204.2 +024800 02 FILLER PICTURE X(13) VALUE SPACE. SQ2204.2 +024900 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2204.2 +025000 01 CCVS-E-4. SQ2204.2 +025100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2204.2 +025200 02 FILLER PIC XXXX VALUE " OF ". SQ2204.2 +025300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2204.2 +025400 02 FILLER PIC X(40) VALUE SQ2204.2 +025500 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2204.2 +025600 01 XXINFO. SQ2204.2 +025700 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2204.2 +025800 02 INFO-TEXT. SQ2204.2 +025900 04 FILLER PIC X(20) VALUE SPACE. SQ2204.2 +026000 04 XXCOMPUTED PIC X(20). SQ2204.2 +026100 04 FILLER PIC X(5) VALUE SPACE. SQ2204.2 +026200 04 XXCORRECT PIC X(20). SQ2204.2 +026300 01 HYPHEN-LINE. SQ2204.2 +026400 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2204.2 +026500 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2204.2 +026600- "*****************************************". SQ2204.2 +026700 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2204.2 +026800- "******************************". SQ2204.2 +026900 01 CCVS-PGM-ID PIC X(6) VALUE SQ2204.2 +027000 "SQ220A". SQ2204.2 +027100 PROCEDURE DIVISION. SQ2204.2 +027200 CCVS1 SECTION. SQ2204.2 +027300 OPEN-FILES. SQ2204.2 +027400*P OPEN I-O RAW-DATA. SQ2204.2 +027500*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2204.2 +027600*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2204.2 +027700*P MOVE "ABORTED " TO C-ABORT. SQ2204.2 +027800*P ADD 1 TO C-NO-OF-TESTS. SQ2204.2 +027900*P ACCEPT C-DATE FROM DATE. SQ2204.2 +028000*P ACCEPT C-TIME FROM TIME. SQ2204.2 +028100*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2204.2 +028200*PND-E-1. SQ2204.2 +028300*P CLOSE RAW-DATA. SQ2204.2 +028400 OPEN OUTPUT PRINT-FILE. SQ2204.2 +028500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2204.2 +028600 MOVE SPACE TO TEST-RESULTS. SQ2204.2 +028700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2204.2 +028800 MOVE ZERO TO REC-SKL-SUB. SQ2204.2 +028900 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2204.2 +029000 CCVS-INIT-FILE. SQ2204.2 +029100 ADD 1 TO REC-SKL-SUB. SQ2204.2 +029200 MOVE FILE-RECORD-INFO-SKELETON TO SQ2204.2 +029300 FILE-RECORD-INFO (REC-SKL-SUB). SQ2204.2 +029400 CCVS-INIT-EXIT. SQ2204.2 +029500 GO TO CCVS1-EXIT. SQ2204.2 +029600 CLOSE-FILES. SQ2204.2 +029700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2204.2 +029800*P OPEN I-O RAW-DATA. SQ2204.2 +029900*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2204.2 +030000*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2204.2 +030100*P MOVE "OK. " TO C-ABORT. SQ2204.2 +030200*P MOVE PASS-COUNTER TO C-OK. SQ2204.2 +030300*P MOVE ERROR-HOLD TO C-ALL. SQ2204.2 +030400*P MOVE ERROR-COUNTER TO C-FAIL. SQ2204.2 +030500*P MOVE DELETE-CNT TO C-DELETED. SQ2204.2 +030600*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2204.2 +030700*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2204.2 +030800*PND-E-2. SQ2204.2 +030900*P CLOSE RAW-DATA. SQ2204.2 +031000 TERMINATE-CCVS. SQ2204.2 +031100*S EXIT PROGRAM. SQ2204.2 +031200*SERMINATE-CALL. SQ2204.2 +031300 STOP RUN. SQ2204.2 +031400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2204.2 +031500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2204.2 +031600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2204.2 +031700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2204.2 +031800 MOVE "****TEST DELETED****" TO RE-MARK. SQ2204.2 +031900 PRINT-DETAIL. SQ2204.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ2204.2 +032100 MOVE "." TO PARDOT-X SQ2204.2 +032200 MOVE REC-CT TO DOTVALUE. SQ2204.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2204.2 +032400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2204.2 +032500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2204.2 +032600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2204.2 +032700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2204.2 +032800 MOVE SPACE TO CORRECT-X. SQ2204.2 +032900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2204.2 +033000 MOVE SPACE TO RE-MARK. SQ2204.2 +033100 HEAD-ROUTINE. SQ2204.2 +033200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +033300 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2204.2 +033400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2204.2 +033500 COLUMN-NAMES-ROUTINE. SQ2204.2 +033600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +033700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +033800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +033900 END-ROUTINE. SQ2204.2 +034000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2204.2 +034100 END-RTN-EXIT. SQ2204.2 +034200 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +034300 END-ROUTINE-1. SQ2204.2 +034400 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2204.2 +034500 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2204.2 +034600 ADD PASS-COUNTER TO ERROR-HOLD. SQ2204.2 +034700* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2204.2 +034800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2204.2 +034900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2204.2 +035000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2204.2 +035100 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2204.2 +035200 END-ROUTINE-12. SQ2204.2 +035300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2204.2 +035400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2204.2 +035500 MOVE "NO " TO ERROR-TOTAL SQ2204.2 +035600 ELSE SQ2204.2 +035700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2204.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2204.2 +035900 PERFORM WRITE-LINE. SQ2204.2 +036000 END-ROUTINE-13. SQ2204.2 +036100 IF DELETE-CNT IS EQUAL TO ZERO SQ2204.2 +036200 MOVE "NO " TO ERROR-TOTAL ELSE SQ2204.2 +036300 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2204.2 +036400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2204.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +036600 IF INSPECT-COUNTER EQUAL TO ZERO SQ2204.2 +036700 MOVE "NO " TO ERROR-TOTAL SQ2204.2 +036800 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2204.2 +036900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2204.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +037100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2204.2 +037200 WRITE-LINE. SQ2204.2 +037300 ADD 1 TO RECORD-COUNT. SQ2204.2 +037400 IF RECORD-COUNT GREATER 50 SQ2204.2 +037500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2204.2 +037600 MOVE SPACE TO DUMMY-RECORD SQ2204.2 +037700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2204.2 +037800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2204.2 +037900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2204.2 +038000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2204.2 +038100 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2204.2 +038200 MOVE ZERO TO RECORD-COUNT. SQ2204.2 +038300 PERFORM WRT-LN. SQ2204.2 +038400 WRT-LN. SQ2204.2 +038500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2204.2 +038600 MOVE SPACE TO DUMMY-RECORD. SQ2204.2 +038700 BLANK-LINE-PRINT. SQ2204.2 +038800 PERFORM WRT-LN. SQ2204.2 +038900 FAIL-ROUTINE. SQ2204.2 +039000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2204.2 +039100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2204.2 +039200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2204.2 +039300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +039400 GO TO FAIL-ROUTINE-EX. SQ2204.2 +039500 FAIL-ROUTINE-WRITE. SQ2204.2 +039600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2204.2 +039700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +039800 FAIL-ROUTINE-EX. EXIT. SQ2204.2 +039900 BAIL-OUT. SQ2204.2 +040000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2204.2 +040100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2204.2 +040200 BAIL-OUT-WRITE. SQ2204.2 +040300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2204.2 +040400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2204.2 +040500 BAIL-OUT-EX. EXIT. SQ2204.2 +040600 CCVS1-EXIT. SQ2204.2 +040700 EXIT. SQ2204.2 +040800 SECT-SQ220A-0001 SECTION. SQ2204.2 +040900 WRITE-INIT-GF-01. SQ2204.2 +041000 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ2204.2 +041100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2204.2 +041200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2204.2 +041300 MOVE 0001 TO XBLOCK-SIZE (1). SQ2204.2 +041400 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2204.2 +041500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2204.2 +041600 MOVE "S" TO XLABEL-TYPE (1). SQ2204.2 +041700 MOVE 000000 TO XRECORD-NUMBER (1). SQ2204.2 +041800 MOVE ZERO TO COUNT-OF-RECS. SQ2204.2 +041900 OPEN OUTPUT SQ-VS7. SQ2204.2 +042000 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ2204.2 +042100 WRITE-TEST-GF-01. SQ2204.2 +042200 PERFORM WRITE-SHORT-REC. SQ2204.2 +042300 PERFORM WRITE-LONG-REC. SQ2204.2 +042400 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2204.2 +042500 PERFORM WRITE-LONG-REC 100 TIMES. SQ2204.2 +042600 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2204.2 +042700 WRITE-WRITE-GF-01. SQ2204.2 +042800 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2204.2 +042900 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2204.2 +043000 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2204.2 +043100 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2204.2 +043200 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2204.2 +043300 PERFORM PRINT-DETAIL. SQ2204.2 +043400* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ2204.2 +043500* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2204.2 +043600* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ2204.2 +043700* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ2204.2 +043800* 100L-338S. SQ2204.2 +043900 WRITE-CLOSE-GF-01. SQ2204.2 +044000 CLOSE SQ-VS7. SQ2204.2 +044100 GO TO READ-INIT-F1-01. SQ2204.2 +044200 WRITE-SHORT-REC. SQ2204.2 +044300 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2204.2 +044400 MOVE 000120 TO XRECORD-LENGTH (1). SQ2204.2 +044500 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +044600 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2204.2 +044700 MOVE "SHORT" TO LONG-OR-SHORT. SQ2204.2 +044800 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2204.2 +044900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ2204.2 +045000 MOVE 120 TO RECORD-LENGTH. SQ2204.2 +045100 WRITE SQ-VS7R1-M-G-120. SQ2204.2 +045200 WRITE-LONG-REC. SQ2204.2 +045300 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2204.2 +045400 MOVE 000151 TO XRECORD-LENGTH (1). SQ2204.2 +045500 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +045600 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2204.2 +045700 MOVE "LONG" TO LONG-OR-SHORT. SQ2204.2 +045800 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2204.2 +045900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ2204.2 +046000 MOVE 151 TO RECORD-LENGTH. SQ2204.2 +046100 WRITE SQ-VS7R2-M-G-151. SQ2204.2 +046200 READ-INIT-F1-01. SQ2204.2 +046300 MOVE ZERO TO RECORD-LENGTH. SQ2204.2 +046400 MOVE ZERO TO COUNT-OF-RECS. SQ2204.2 +046500 MOVE ZERO TO EOF-FLAG. SQ2204.2 +046600 MOVE ZERO TO RECORDS-IN-ERROR. SQ2204.2 +046700 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +046800 OPEN INPUT SQ-VS7. SQ2204.2 +046900 READ-TEST-F1-01. SQ2204.2 +047000 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2204.2 +047100 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +047200 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2204.2 +047300 GO TO READ-EOF-F1-06. SQ2204.2 +047400 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +047500 GO TO READ-FAIL-F1-01. SQ2204.2 +047600 READ-PASS-F1-01. SQ2204.2 +047700 PERFORM PASS. SQ2204.2 +047800 GO TO READ-WRITE-F1-01. SQ2204.2 +047900 READ-FAIL-F1-01. SQ2204.2 +048000 MOVE " FILE NOT OK. SEE PROGRAM & VII-52 OR -44" TO RE-MARK. SQ2204.2 +048100 PERFORM FAIL. SQ2204.2 +048200 READ-WRITE-F1-01. SQ2204.2 +048300 MOVE "READ SHORT RECORD" TO FEATURE. SQ2204.2 +048400 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2204.2 +048500 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2204.2 +048600 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +048700 MOVE 120 TO CORRECT-N. SQ2204.2 +048800 PERFORM PRINT-DETAIL. SQ2204.2 +048900 GO TO READ-INIT-F1-02. SQ2204.2 +049000 READ-SHORT-REC. SQ2204.2 +049100* READ NEXT RECORD AT END *SQ2204.2 +049200******************************************************************SQ2204.2 +049300 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +049400 GO TO READ-SHORT-REC-EXIT. SQ2204.2 +049500 READ SQ-VS7 NEXT RECORD AT END SQ2204.2 +049600 MOVE 1 TO EOF-FLAG SQ2204.2 +049700 GO TO READ-SHORT-REC-EXIT. SQ2204.2 +049800 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +049900 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2204.2 +050000 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2204.2 +050100 GO TO READ-SHORT-REC-ERROR. SQ2204.2 +050200 IF RECORD-LENGTH NOT EQUAL TO 120 SQ2204.2 +050300 GO TO READ-SHORT-REC-ERROR. SQ2204.2 +050400 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2204.2 +050500 GO TO READ-SHORT-REC-ERROR. SQ2204.2 +050600 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2204.2 +050700 GO TO READ-SHORT-REC-EXIT. SQ2204.2 +050800 READ-SHORT-REC-ERROR. SQ2204.2 +050900 ADD 1 TO RECORDS-IN-ERROR. SQ2204.2 +051000 MOVE 1 TO ERROR-FLAG. SQ2204.2 +051100 READ-SHORT-REC-EXIT. SQ2204.2 +051200 EXIT. SQ2204.2 +051300 READ-INIT-F1-02. SQ2204.2 +051400 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +051500 READ-TEST-F1-02. SQ2204.2 +051600 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2204.2 +051700 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +051800 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2204.2 +051900 GO TO READ-EOF-F1-06. SQ2204.2 +052000 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +052100 GO TO READ-FAIL-F1-02. SQ2204.2 +052200 READ-PASS-F1-02. SQ2204.2 +052300 PERFORM PASS. SQ2204.2 +052400 GO TO READ-WRITE-F1-02. SQ2204.2 +052500 READ-FAIL-F1-02. SQ2204.2 +052600 MOVE "SEE VII-52 WRITE LONG RECORD OR VII-44 READ" TO RE-MARKSQ2204.2 +052700 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +052800 MOVE 151 TO CORRECT-N. SQ2204.2 +052900 PERFORM FAIL. SQ2204.2 +053000 READ-WRITE-F1-02. SQ2204.2 +053100 MOVE "READ LONG RECORD" TO FEATURE. SQ2204.2 +053200 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2204.2 +053300 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2204.2 +053400 PERFORM PRINT-DETAIL. SQ2204.2 +053500 GO TO READ-INIT-F1-03. SQ2204.2 +053600 READ-LONG-REC. SQ2204.2 +053700 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +053800 GO TO READ-LONG-REC-EXIT. SQ2204.2 +053900 READ SQ-VS7 END SQ2204.2 +054000 MOVE 1 TO EOF-FLAG SQ2204.2 +054100 GO TO READ-LONG-REC-EXIT. SQ2204.2 +054200 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +054300 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2204.2 +054400 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2204.2 +054500 GO TO READ-LONG-REC-ERROR. SQ2204.2 +054600 IF RECORD-LENGTH NOT EQUAL TO 151 SQ2204.2 +054700 GO TO READ-LONG-REC-ERROR. SQ2204.2 +054800 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2204.2 +054900 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ2204.2 +055000 GO TO READ-LONG-REC-ERROR. SQ2204.2 +055100 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2204.2 +055200 GO TO READ-LONG-REC-EXIT. SQ2204.2 +055300 READ-LONG-REC-ERROR. SQ2204.2 +055400 ADD 1 TO RECORDS-IN-ERROR. SQ2204.2 +055500 MOVE 1 TO ERROR-FLAG. SQ2204.2 +055600 READ-LONG-REC-EXIT. SQ2204.2 +055700 EXIT. SQ2204.2 +055800 READ-INIT-F1-03. SQ2204.2 +055900 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +056000 READ-TEST-F1-03. SQ2204.2 +056100 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2204.2 +056200 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +056300 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2204.2 +056400 GO TO READ-EOF-F1-06. SQ2204.2 +056500 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +056600 GO TO READ-FAIL-F1-03. SQ2204.2 +056700 READ-PASS-F1-03. SQ2204.2 +056800 PERFORM PASS. SQ2204.2 +056900 GO TO READ-WRITE-F1-03. SQ2204.2 +057000 READ-FAIL-F1-03. SQ2204.2 +057100 MOVE "SEE VII-52 WRITE SHORT REC OR VII-44 READ" TO RE-MARKSQ2204.2 +057200 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +057300 MOVE 120 TO CORRECT-N. SQ2204.2 +057400 PERFORM FAIL. SQ2204.2 +057500 READ-WRITE-F1-03. SQ2204.2 +057600 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2204.2 +057700 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2204.2 +057800 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2204.2 +057900 PERFORM PRINT-DETAIL. SQ2204.2 +058000 READ-INIT-F1-04. SQ2204.2 +058100 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +058200 READ-TEST-F1-04. SQ2204.2 +058300 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2204.2 +058400 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +058500 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2204.2 +058600 GO TO READ-EOF-F1-06. SQ2204.2 +058700 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +058800 GO TO READ-FAIL-F1-04. SQ2204.2 +058900 READ-PASS-F1-04. SQ2204.2 +059000 PERFORM PASS. SQ2204.2 +059100 GO TO READ-WRITE-F1-04. SQ2204.2 +059200 READ-FAIL-F1-04. SQ2204.2 +059300 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +059400 MOVE 151 TO CORRECT-N. SQ2204.2 +059500 PERFORM FAIL. SQ2204.2 +059600 READ-WRITE-F1-04. SQ2204.2 +059700 MOVE "READ LONG RECORDS" TO FEATURE. SQ2204.2 +059800 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2204.2 +059900 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2204.2 +060000 PERFORM PRINT-DETAIL. SQ2204.2 +060100 READ-INIT-F1-05. SQ2204.2 +060200 MOVE ZERO TO ERROR-FLAG. SQ2204.2 +060300 READ-TEST-F1-05. SQ2204.2 +060400 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2204.2 +060500 IF EOF-FLAG EQUAL TO 1 SQ2204.2 +060600 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2204.2 +060700 GO TO READ-EOF-F1-06. SQ2204.2 +060800 IF ERROR-FLAG EQUAL TO 1 SQ2204.2 +060900 GO TO READ-FAIL-F1-05. SQ2204.2 +061000 READ-PASS-F1-05. SQ2204.2 +061100 PERFORM PASS. SQ2204.2 +061200 GO TO READ-WRITE-F1-05. SQ2204.2 +061300 READ-FAIL-F1-05. SQ2204.2 +061400 MOVE "SEE VII-52 WRITE LONG RECORD OR VII-44 READ" TO RE-MARKSQ2204.2 +061500 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2204.2 +061600 MOVE 120 TO CORRECT-N. SQ2204.2 +061700 PERFORM FAIL. SQ2204.2 +061800 READ-WRITE-F1-05. SQ2204.2 +061900 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2204.2 +062000 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2204.2 +062100 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2204.2 +062200 PERFORM PRINT-DETAIL. SQ2204.2 +062300 READ-INIT-F1-06. SQ2204.2 +062400 READ SQ-VS7 RECORD END SQ2204.2 +062500 GO TO READ-TEST-F1-06. SQ2204.2 +062600 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2204.2 +062700 GO TO READ-FAIL-F1-06. SQ2204.2 +062800 READ-EOF-F1-06. SQ2204.2 +062900 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2204.2 +063000 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2204.2 +063100 GO TO READ-FAIL-F1-06. SQ2204.2 +063200 READ-TEST-F1-06. SQ2204.2 +063300 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2204.2 +063400 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2204.2 +063500 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2204.2 +063600 GO TO READ-FAIL-F1-06. SQ2204.2 +063700 READ-PASS-F1-06. SQ2204.2 +063800 PERFORM PASS. SQ2204.2 +063900 GO TO READ-WRITE-F1-06. SQ2204.2 +064000 READ-FAIL-F1-06. SQ2204.2 +064100 PERFORM FAIL. SQ2204.2 +064200 READ-WRITE-F1-06. SQ2204.2 +064300 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2204.2 +064400 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2204.2 +064500 PERFORM PRINT-DETAIL. SQ2204.2 +064600 READ-CLOSE-F1-06. SQ2204.2 +064700 CLOSE SQ-VS7. SQ2204.2 +064800 SECT-SQ220A-0002 SECTION. SQ2204.2 +064900* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ2204.2 +065000* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ2204.2 +065100* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ2204.2 +065200* 130 IS UNIQUE FOR EACH RECORD. SQ2204.2 +065300 INFO-INIT-01. SQ2204.2 +065400 OPEN INPUT SQ-VS7. SQ2204.2 +065500 MOVE ZERO TO COUNT-OF-RECS. SQ2204.2 +065600 INFO-TEST-01. SQ2204.2 +065700 READ SQ-VS7 AT END SQ2204.2 +065800 GO TO INFO-END. SQ2204.2 +065900 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +066000 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ2204.2 +066100 GO TO NO-INFO-01. SQ2204.2 +066200 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2204.2 +066300 MOVE "RECORD READ =" TO COMPUTED-A. SQ2204.2 +066400 MOVE 0001 TO CORRECT-18V0. SQ2204.2 +066500 GO TO INFO-WRITE-01. SQ2204.2 +066600 NO-INFO-01. SQ2204.2 +066700 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2204.2 +066800 INFO-WRITE-01. SQ2204.2 +066900 MOVE "READ SHORT RECORD" TO FEATURE. SQ2204.2 +067000 MOVE "INFO-TEST-01" TO PAR-NAME. SQ2204.2 +067100 PERFORM PRINT-DETAIL. SQ2204.2 +067200 INFO-INIT-02. SQ2204.2 +067300 READ SQ-VS7 RECORD AT END SQ2204.2 +067400 GO TO INFO-END. SQ2204.2 +067500 READ SQ-VS7 END SQ2204.2 +067600 GO TO INFO-END. SQ2204.2 +067700 INFO-TEST-02. SQ2204.2 +067800 READ SQ-VS7 AT END SQ2204.2 +067900 GO TO INFO-END. SQ2204.2 +068000 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ2204.2 +068100 GO TO NO-INFO-02. SQ2204.2 +068200 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2204.2 +068300 MOVE "RECORD READ =" TO COMPUTED-A. SQ2204.2 +068400 MOVE 0004 TO CORRECT-18V0. SQ2204.2 +068500 GO TO INFO-WRITE-02. SQ2204.2 +068600 NO-INFO-02. SQ2204.2 +068700 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2204.2 +068800 INFO-WRITE-02. SQ2204.2 +068900 MOVE "READ SHORT RECORD" TO FEATURE. SQ2204.2 +069000 MOVE "INFO-TEST-02" TO PAR-NAME. SQ2204.2 +069100 PERFORM PRINT-DETAIL. SQ2204.2 +069200 INFO-INIT-03. SQ2204.2 +069300 ADD 3 TO COUNT-OF-RECS. SQ2204.2 +069400 INFO-INIT-03-1. SQ2204.2 +069500 READ SQ-VS7 RECORD SQ2204.2 +069600 END GO TO INFO-END. SQ2204.2 +069700 ADD 1 TO COUNT-OF-RECS. SQ2204.2 +069800 IF COUNT-OF-RECS EQUAL TO 450 SQ2204.2 +069900 GO TO INFO-TEST-03. SQ2204.2 +070000 GO TO INFO-INIT-03-1. SQ2204.2 +070100 INFO-TEST-03. SQ2204.2 +070200 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ2204.2 +070300 GO TO NO-INFO-03. SQ2204.2 +070400 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2204.2 +070500 MOVE "RECORD READ =" TO COMPUTED-A. SQ2204.2 +070600 MOVE 0450 TO CORRECT-18V0. SQ2204.2 +070700 GO TO INFO-WRITE-03. SQ2204.2 +070800 NO-INFO-03. SQ2204.2 +070900 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2204.2 +071000 INFO-WRITE-03. SQ2204.2 +071100 MOVE "READ SHORT RECORD" TO FEATURE. SQ2204.2 +071200 MOVE "INFO-TEST-03" TO PAR-NAME. SQ2204.2 +071300 PERFORM PRINT-DETAIL. SQ2204.2 +071400 INFO-END. SQ2204.2 +071500 CLOSE SQ-VS7. SQ2204.2 +071600 TERMINATE-ROUTINE. SQ2204.2 +071700 EXIT. SQ2204.2 +071800 CCVS-EXIT SECTION. SQ2204.2 +071900 CCVS-999999. SQ2204.2 +072000 GO TO CLOSE-FILES. SQ2204.2 diff --git a/tests/cobol85/SQ/SQ221A.CBL b/tests/cobol85/SQ/SQ221A.CBL new file mode 100755 index 00000000..6125f171 --- /dev/null +++ b/tests/cobol85/SQ/SQ221A.CBL @@ -0,0 +1,717 @@ +000100 IDENTIFICATION DIVISION. SQ2214.2 +000200 PROGRAM-ID. SQ2214.2 +000300 SQ221A. SQ2214.2 +000400**************************************************************** SQ2214.2 +000500* * SQ2214.2 +000600* VALIDATION FOR:- * SQ2214.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2214.2 +000800* * SQ2214.2 +000900* CREATION DATE / VALIDATION DATE * SQ2214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2214.2 +001100* * SQ2214.2 +001200* THIS ROUTINE CHECKS: SQ2214.2 +001300* SQ2214.2 +001400* RECORD VARYING DEPENDING RECORD-LENGTH SQ2214.2 +001500* SQ2214.2 +001600* SQ2214.2 +001700* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ2214.2 +001800* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ2214.2 +001900* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ2214.2 +002000* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ2214.2 +002100* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ2214.2 +002200* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2214.2 +002300* AGAINST THE EXPECTED VALUES. SQ2214.2 +002400* SQ2214.2 +002500* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ2214.2 +002600* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ2214.2 +002700* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ2214.2 +002800* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ2214.2 +002900* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ2214.2 +003000 ENVIRONMENT DIVISION. SQ2214.2 +003100 CONFIGURATION SECTION. SQ2214.2 +003200 SOURCE-COMPUTER. SQ2214.2 +003300 Linux. SQ2214.2 +003400 OBJECT-COMPUTER. SQ2214.2 +003500 Linux. SQ2214.2 +003600 INPUT-OUTPUT SECTION. SQ2214.2 +003700 FILE-CONTROL. SQ2214.2 +003800*P SELECT RAW-DATA ASSIGN TO SQ2214.2 +003900*P "XXXXX062" SQ2214.2 +004000*P ORGANIZATION IS INDEXED SQ2214.2 +004100*P ACCESS MODE IS RANDOM SQ2214.2 +004200*P RECORD KEY IS RAW-DATA-KEY. SQ2214.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ2214.2 +004400 "report.log". SQ2214.2 +004500 SELECT SQ-VS7 ASSIGN TO SQ2214.2 +004600 "XXXXX014" SQ2214.2 +004700 ORGANIZATION SEQUENTIAL SQ2214.2 +004800 ACCESS SEQUENTIAL. SQ2214.2 +004900 DATA DIVISION. SQ2214.2 +005000 FILE SECTION. SQ2214.2 +005100*P SQ2214.2 +005200*PD RAW-DATA. SQ2214.2 +005300*P SQ2214.2 +005400*P1 RAW-DATA-SATZ. SQ2214.2 +005500*P 05 RAW-DATA-KEY PIC X(6). SQ2214.2 +005600*P 05 C-DATE PIC 9(6). SQ2214.2 +005700*P 05 C-TIME PIC 9(8). SQ2214.2 +005800*P 05 C-NO-OF-TESTS PIC 99. SQ2214.2 +005900*P 05 C-OK PIC 999. SQ2214.2 +006000*P 05 C-ALL PIC 999. SQ2214.2 +006100*P 05 C-FAIL PIC 999. SQ2214.2 +006200*P 05 C-DELETED PIC 999. SQ2214.2 +006300*P 05 C-INSPECT PIC 999. SQ2214.2 +006400*P 05 C-NOTE PIC X(13). SQ2214.2 +006500*P 05 C-INDENT PIC X. SQ2214.2 +006600*P 05 C-ABORT PIC X(8). SQ2214.2 +006700 FD PRINT-FILE SQ2214.2 +006800*C LABEL RECORDS SQ2214.2 +006900*C OMITTED SQ2214.2 +007000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2214.2 +007100 . SQ2214.2 +007200 01 PRINT-REC PICTURE X(120). SQ2214.2 +007300 01 DUMMY-RECORD PICTURE X(120). SQ2214.2 +007400 FD SQ-VS7 SQ2214.2 +007500*C LABEL RECORDS ARE STANDARD SQ2214.2 +007600 RECORD VARYING DEPENDING RECORD-LENGTH. SQ2214.2 +007700 01 SQ-VS7R1-M-G-120. SQ2214.2 +007800 02 SQ-VS7R1-FIRST PICTURE X(120). SQ2214.2 +007900 01 SQ-VS7R2-M-G-151. SQ2214.2 +008000 02 SQ-VS7R2-FIRST PICTURE X(120). SQ2214.2 +008100 02 LONG-OR-SHORT PICTURE X(5). SQ2214.2 +008200 02 SQ-VS7-RECNO PICTURE X(5). SQ2214.2 +008300 02 SQ-VS7-FILLER PICTURE X(21). SQ2214.2 +008400 WORKING-STORAGE SECTION. SQ2214.2 +008500 01 RECORD-LENGTH PICTURE 999 VALUE ZERO. SQ2214.2 +008600 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2214.2 +008700 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2214.2 +008800 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ2214.2 +008900 01 ERROR-FLAG PICTURE 9. SQ2214.2 +009000 01 EOF-FLAG PICTURE 9. SQ2214.2 +009100 01 DUMP-AREA. SQ2214.2 +009200 02 TYPE-OF-REC PICTURE X(5). SQ2214.2 +009300 02 RECNO PICTURE 9(5). SQ2214.2 +009400 02 FILLER PICTURE X(21). SQ2214.2 +009500 01 FILE-RECORD-INFORMATION-REC. SQ2214.2 +009600 03 FILE-RECORD-INFO-SKELETON. SQ2214.2 +009700 05 FILLER PICTURE X(48) VALUE SQ2214.2 +009800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2214.2 +009900 05 FILLER PICTURE X(46) VALUE SQ2214.2 +010000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2214.2 +010100 05 FILLER PICTURE X(26) VALUE SQ2214.2 +010200 ",LFIL=000000,ORG= ,LBLR= ". SQ2214.2 +010300 05 FILLER PICTURE X(37) VALUE SQ2214.2 +010400 ",RECKEY= ". SQ2214.2 +010500 05 FILLER PICTURE X(38) VALUE SQ2214.2 +010600 ",ALTKEY1= ". SQ2214.2 +010700 05 FILLER PICTURE X(38) VALUE SQ2214.2 +010800 ",ALTKEY2= ". SQ2214.2 +010900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2214.2 +011000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2214.2 +011100 05 FILE-RECORD-INFO-P1-120. SQ2214.2 +011200 07 FILLER PIC X(5). SQ2214.2 +011300 07 XFILE-NAME PIC X(6). SQ2214.2 +011400 07 FILLER PIC X(8). SQ2214.2 +011500 07 XRECORD-NAME PIC X(6). SQ2214.2 +011600 07 FILLER PIC X(1). SQ2214.2 +011700 07 REELUNIT-NUMBER PIC 9(1). SQ2214.2 +011800 07 FILLER PIC X(7). SQ2214.2 +011900 07 XRECORD-NUMBER PIC 9(6). SQ2214.2 +012000 07 FILLER PIC X(6). SQ2214.2 +012100 07 UPDATE-NUMBER PIC 9(2). SQ2214.2 +012200 07 FILLER PIC X(5). SQ2214.2 +012300 07 ODO-NUMBER PIC 9(4). SQ2214.2 +012400 07 FILLER PIC X(5). SQ2214.2 +012500 07 XPROGRAM-NAME PIC X(5). SQ2214.2 +012600 07 FILLER PIC X(7). SQ2214.2 +012700 07 XRECORD-LENGTH PIC 9(6). SQ2214.2 +012800 07 FILLER PIC X(7). SQ2214.2 +012900 07 CHARS-OR-RECORDS PIC X(2). SQ2214.2 +013000 07 FILLER PIC X(1). SQ2214.2 +013100 07 XBLOCK-SIZE PIC 9(4). SQ2214.2 +013200 07 FILLER PIC X(6). SQ2214.2 +013300 07 RECORDS-IN-FILE PIC 9(6). SQ2214.2 +013400 07 FILLER PIC X(5). SQ2214.2 +013500 07 XFILE-ORGANIZATION PIC X(2). SQ2214.2 +013600 07 FILLER PIC X(6). SQ2214.2 +013700 07 XLABEL-TYPE PIC X(1). SQ2214.2 +013800 05 FILE-RECORD-INFO-P121-240. SQ2214.2 +013900 07 FILLER PIC X(8). SQ2214.2 +014000 07 XRECORD-KEY PIC X(29). SQ2214.2 +014100 07 FILLER PIC X(9). SQ2214.2 +014200 07 ALTERNATE-KEY1 PIC X(29). SQ2214.2 +014300 07 FILLER PIC X(9). SQ2214.2 +014400 07 ALTERNATE-KEY2 PIC X(29). SQ2214.2 +014500 07 FILLER PIC X(7). SQ2214.2 +014600 01 TEST-RESULTS. SQ2214.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2214.2 +014800 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2214.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ2214.2 +015000 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2214.2 +015100 02 FILLER PICTURE X VALUE SPACE. SQ2214.2 +015200 02 PAR-NAME. SQ2214.2 +015300 03 FILLER PICTURE X(12) VALUE SPACE. SQ2214.2 +015400 03 PARDOT-X PICTURE X VALUE SPACE. SQ2214.2 +015500 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2214.2 +015600 03 FILLER PIC X(5) VALUE SPACE. SQ2214.2 +015700 02 FILLER PIC X(10) VALUE SPACE. SQ2214.2 +015800 02 RE-MARK PIC X(61). SQ2214.2 +015900 01 TEST-COMPUTED. SQ2214.2 +016000 02 FILLER PIC X(30) VALUE SPACE. SQ2214.2 +016100 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2214.2 +016200 02 COMPUTED-X. SQ2214.2 +016300 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2214.2 +016400 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2214.2 +016500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2214.2 +016600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2214.2 +016700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2214.2 +016800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2214.2 +016900 04 COMPUTED-18V0 PICTURE -9(18). SQ2214.2 +017000 04 FILLER PICTURE X. SQ2214.2 +017100 03 FILLER PIC X(50) VALUE SPACE. SQ2214.2 +017200 01 TEST-CORRECT. SQ2214.2 +017300 02 FILLER PIC X(30) VALUE SPACE. SQ2214.2 +017400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2214.2 +017500 02 CORRECT-X. SQ2214.2 +017600 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2214.2 +017700 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2214.2 +017800 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2214.2 +017900 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2214.2 +018000 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2214.2 +018100 03 CR-18V0 REDEFINES CORRECT-A. SQ2214.2 +018200 04 CORRECT-18V0 PICTURE -9(18). SQ2214.2 +018300 04 FILLER PICTURE X. SQ2214.2 +018400 03 FILLER PIC X(50) VALUE SPACE. SQ2214.2 +018500 01 CCVS-C-1. SQ2214.2 +018600 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2214.2 +018700- "SS PARAGRAPH-NAME SQ2214.2 +018800- " REMARKS". SQ2214.2 +018900 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2214.2 +019000 01 CCVS-C-2. SQ2214.2 +019100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2214.2 +019200 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2214.2 +019300 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2214.2 +019400 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2214.2 +019500 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2214.2 +019600 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2214.2 +019700 01 REC-CT PICTURE 99 VALUE ZERO. SQ2214.2 +019800 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2214.2 +019900 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2214.2 +020000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2214.2 +020100 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2214.2 +020200 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2214.2 +020300 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2214.2 +020400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2214.2 +020500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2214.2 +020600 01 CCVS-H-1. SQ2214.2 +020700 02 FILLER PICTURE X(27) VALUE SPACE. SQ2214.2 +020800 02 FILLER PICTURE X(67) VALUE SQ2214.2 +020900 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2214.2 +021000- " SYSTEM". SQ2214.2 +021100 02 FILLER PICTURE X(26) VALUE SPACE. SQ2214.2 +021200 01 CCVS-H-2. SQ2214.2 +021300 02 FILLER PICTURE X(52) VALUE IS SQ2214.2 +021400 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2214.2 +021500 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2214.2 +021600 02 TEST-ID PICTURE IS X(9). SQ2214.2 +021700 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2214.2 +021800 01 CCVS-H-3. SQ2214.2 +021900 02 FILLER PICTURE X(34) VALUE SQ2214.2 +022000 " FOR OFFICIAL USE ONLY ". SQ2214.2 +022100 02 FILLER PICTURE X(58) VALUE SQ2214.2 +022200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2214.2 +022300 02 FILLER PICTURE X(28) VALUE SQ2214.2 +022400 " COPYRIGHT 1985 ". SQ2214.2 +022500 01 CCVS-E-1. SQ2214.2 +022600 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2214.2 +022700 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2214.2 +022800 02 ID-AGAIN PICTURE IS X(9). SQ2214.2 +022900 02 FILLER PICTURE X(45) VALUE IS SQ2214.2 +023000 " NTIS DISTRIBUTION COBOL 85". SQ2214.2 +023100 01 CCVS-E-2. SQ2214.2 +023200 02 FILLER PICTURE X(31) VALUE SQ2214.2 +023300 SPACE. SQ2214.2 +023400 02 FILLER PICTURE X(21) VALUE SPACE. SQ2214.2 +023500 02 CCVS-E-2-2. SQ2214.2 +023600 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2214.2 +023700 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2214.2 +023800 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2214.2 +023900 01 CCVS-E-3. SQ2214.2 +024000 02 FILLER PICTURE X(22) VALUE SQ2214.2 +024100 " FOR OFFICIAL USE ONLY". SQ2214.2 +024200 02 FILLER PICTURE X(12) VALUE SPACE. SQ2214.2 +024300 02 FILLER PICTURE X(58) VALUE SQ2214.2 +024400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2214.2 +024500 02 FILLER PICTURE X(13) VALUE SPACE. SQ2214.2 +024600 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2214.2 +024700 01 CCVS-E-4. SQ2214.2 +024800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2214.2 +024900 02 FILLER PIC XXXX VALUE " OF ". SQ2214.2 +025000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2214.2 +025100 02 FILLER PIC X(40) VALUE SQ2214.2 +025200 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2214.2 +025300 01 XXINFO. SQ2214.2 +025400 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2214.2 +025500 02 INFO-TEXT. SQ2214.2 +025600 04 FILLER PIC X(20) VALUE SPACE. SQ2214.2 +025700 04 XXCOMPUTED PIC X(20). SQ2214.2 +025800 04 FILLER PIC X(5) VALUE SPACE. SQ2214.2 +025900 04 XXCORRECT PIC X(20). SQ2214.2 +026000 01 HYPHEN-LINE. SQ2214.2 +026100 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2214.2 +026200 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2214.2 +026300- "*****************************************". SQ2214.2 +026400 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2214.2 +026500- "******************************". SQ2214.2 +026600 01 CCVS-PGM-ID PIC X(6) VALUE SQ2214.2 +026700 "SQ221A". SQ2214.2 +026800 PROCEDURE DIVISION. SQ2214.2 +026900 CCVS1 SECTION. SQ2214.2 +027000 OPEN-FILES. SQ2214.2 +027100*P OPEN I-O RAW-DATA. SQ2214.2 +027200*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2214.2 +027300*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2214.2 +027400*P MOVE "ABORTED " TO C-ABORT. SQ2214.2 +027500*P ADD 1 TO C-NO-OF-TESTS. SQ2214.2 +027600*P ACCEPT C-DATE FROM DATE. SQ2214.2 +027700*P ACCEPT C-TIME FROM TIME. SQ2214.2 +027800*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2214.2 +027900*PND-E-1. SQ2214.2 +028000*P CLOSE RAW-DATA. SQ2214.2 +028100 OPEN OUTPUT PRINT-FILE. SQ2214.2 +028200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2214.2 +028300 MOVE SPACE TO TEST-RESULTS. SQ2214.2 +028400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2214.2 +028500 MOVE ZERO TO REC-SKL-SUB. SQ2214.2 +028600 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2214.2 +028700 CCVS-INIT-FILE. SQ2214.2 +028800 ADD 1 TO REC-SKL-SUB. SQ2214.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2214.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2214.2 +029100 CCVS-INIT-EXIT. SQ2214.2 +029200 GO TO CCVS1-EXIT. SQ2214.2 +029300 CLOSE-FILES. SQ2214.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2214.2 +029500*P OPEN I-O RAW-DATA. SQ2214.2 +029600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2214.2 +029700*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2214.2 +029800*P MOVE "OK. " TO C-ABORT. SQ2214.2 +029900*P MOVE PASS-COUNTER TO C-OK. SQ2214.2 +030000*P MOVE ERROR-HOLD TO C-ALL. SQ2214.2 +030100*P MOVE ERROR-COUNTER TO C-FAIL. SQ2214.2 +030200*P MOVE DELETE-CNT TO C-DELETED. SQ2214.2 +030300*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2214.2 +030400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2214.2 +030500*PND-E-2. SQ2214.2 +030600*P CLOSE RAW-DATA. SQ2214.2 +030700 TERMINATE-CCVS. SQ2214.2 +030800*S EXIT PROGRAM. SQ2214.2 +030900*SERMINATE-CALL. SQ2214.2 +031000 STOP RUN. SQ2214.2 +031100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2214.2 +031200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2214.2 +031300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2214.2 +031400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2214.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2214.2 +031600 PRINT-DETAIL. SQ2214.2 +031700 IF REC-CT NOT EQUAL TO ZERO SQ2214.2 +031800 MOVE "." TO PARDOT-X SQ2214.2 +031900 MOVE REC-CT TO DOTVALUE. SQ2214.2 +032000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2214.2 +032100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2214.2 +032200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2214.2 +032300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2214.2 +032400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2214.2 +032500 MOVE SPACE TO CORRECT-X. SQ2214.2 +032600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2214.2 +032700 MOVE SPACE TO RE-MARK. SQ2214.2 +032800 HEAD-ROUTINE. SQ2214.2 +032900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +033000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2214.2 +033100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2214.2 +033200 COLUMN-NAMES-ROUTINE. SQ2214.2 +033300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +033400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +033600 END-ROUTINE. SQ2214.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2214.2 +033800 END-RTN-EXIT. SQ2214.2 +033900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +034000 END-ROUTINE-1. SQ2214.2 +034100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2214.2 +034200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2214.2 +034300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2214.2 +034400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2214.2 +034500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2214.2 +034600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2214.2 +034700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2214.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2214.2 +034900 END-ROUTINE-12. SQ2214.2 +035000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2214.2 +035100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2214.2 +035200 MOVE "NO " TO ERROR-TOTAL SQ2214.2 +035300 ELSE SQ2214.2 +035400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2214.2 +035500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2214.2 +035600 PERFORM WRITE-LINE. SQ2214.2 +035700 END-ROUTINE-13. SQ2214.2 +035800 IF DELETE-CNT IS EQUAL TO ZERO SQ2214.2 +035900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2214.2 +036000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2214.2 +036100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2214.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +036300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2214.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2214.2 +036500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2214.2 +036600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2214.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +036800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2214.2 +036900 WRITE-LINE. SQ2214.2 +037000 ADD 1 TO RECORD-COUNT. SQ2214.2 +037100 IF RECORD-COUNT GREATER 50 SQ2214.2 +037200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2214.2 +037300 MOVE SPACE TO DUMMY-RECORD SQ2214.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2214.2 +037500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2214.2 +037600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2214.2 +037700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2214.2 +037800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2214.2 +037900 MOVE ZERO TO RECORD-COUNT. SQ2214.2 +038000 PERFORM WRT-LN. SQ2214.2 +038100 WRT-LN. SQ2214.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2214.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ2214.2 +038400 BLANK-LINE-PRINT. SQ2214.2 +038500 PERFORM WRT-LN. SQ2214.2 +038600 FAIL-ROUTINE. SQ2214.2 +038700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2214.2 +038800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2214.2 +038900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2214.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +039100 GO TO FAIL-ROUTINE-EX. SQ2214.2 +039200 FAIL-ROUTINE-WRITE. SQ2214.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2214.2 +039400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +039500 FAIL-ROUTINE-EX. EXIT. SQ2214.2 +039600 BAIL-OUT. SQ2214.2 +039700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2214.2 +039800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2214.2 +039900 BAIL-OUT-WRITE. SQ2214.2 +040000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2214.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2214.2 +040200 BAIL-OUT-EX. EXIT. SQ2214.2 +040300 CCVS1-EXIT. SQ2214.2 +040400 EXIT. SQ2214.2 +040500 SECT-SQ221A-0001 SECTION. SQ2214.2 +040600 WRITE-INIT-GF-01. SQ2214.2 +040700 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ2214.2 +040800 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2214.2 +040900 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2214.2 +041000 MOVE 0001 TO XBLOCK-SIZE (1). SQ2214.2 +041100 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2214.2 +041200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2214.2 +041300 MOVE "S" TO XLABEL-TYPE (1). SQ2214.2 +041400 MOVE 000000 TO XRECORD-NUMBER (1). SQ2214.2 +041500 MOVE ZERO TO COUNT-OF-RECS. SQ2214.2 +041600 OPEN OUTPUT SQ-VS7. SQ2214.2 +041700 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ2214.2 +041800 WRITE-TEST-GF-01. SQ2214.2 +041900 PERFORM WRITE-SHORT-REC. SQ2214.2 +042000 PERFORM WRITE-LONG-REC. SQ2214.2 +042100 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2214.2 +042200 PERFORM WRITE-LONG-REC 100 TIMES. SQ2214.2 +042300 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2214.2 +042400 WRITE-WRITE-GF-01. SQ2214.2 +042500 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2214.2 +042600 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2214.2 +042700 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2214.2 +042800 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2214.2 +042900 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2214.2 +043000 PERFORM PRINT-DETAIL. SQ2214.2 +043100* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ2214.2 +043200* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2214.2 +043300* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ2214.2 +043400* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ2214.2 +043500* 100L-338S. SQ2214.2 +043600 WRITE-CLOSE-GF-01. SQ2214.2 +043700 CLOSE SQ-VS7. SQ2214.2 +043800 GO TO READ-INIT-F1-01. SQ2214.2 +043900 WRITE-SHORT-REC. SQ2214.2 +044000 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2214.2 +044100 MOVE 000120 TO XRECORD-LENGTH (1). SQ2214.2 +044200 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +044300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2214.2 +044400 MOVE "SHORT" TO LONG-OR-SHORT. SQ2214.2 +044500 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2214.2 +044600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ2214.2 +044700 MOVE 120 TO RECORD-LENGTH. SQ2214.2 +044800 WRITE SQ-VS7R1-M-G-120. SQ2214.2 +044900 WRITE-LONG-REC. SQ2214.2 +045000 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2214.2 +045100 MOVE 000151 TO XRECORD-LENGTH (1). SQ2214.2 +045200 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +045300 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2214.2 +045400 MOVE "LONG" TO LONG-OR-SHORT. SQ2214.2 +045500 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2214.2 +045600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ2214.2 +045700 MOVE 151 TO RECORD-LENGTH. SQ2214.2 +045800 WRITE SQ-VS7R2-M-G-151. SQ2214.2 +045900 READ-INIT-F1-01. SQ2214.2 +046000 MOVE ZERO TO RECORD-LENGTH. SQ2214.2 +046100 MOVE ZERO TO COUNT-OF-RECS. SQ2214.2 +046200 MOVE ZERO TO EOF-FLAG. SQ2214.2 +046300 MOVE ZERO TO RECORDS-IN-ERROR. SQ2214.2 +046400 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +046500 OPEN INPUT SQ-VS7. SQ2214.2 +046600 READ-TEST-F1-01. SQ2214.2 +046700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2214.2 +046800 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +046900 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2214.2 +047000 GO TO READ-EOF-F1-06. SQ2214.2 +047100 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +047200 GO TO READ-FAIL-F1-01. SQ2214.2 +047300 READ-PASS-F1-01. SQ2214.2 +047400 PERFORM PASS. SQ2214.2 +047500 GO TO READ-WRITE-F1-01. SQ2214.2 +047600 READ-FAIL-F1-01. SQ2214.2 +047700 MOVE " FILE NOT OK. SEE PROGRAM & VII-52 OR -44" TO RE-MARK. SQ2214.2 +047800 PERFORM FAIL. SQ2214.2 +047900 READ-WRITE-F1-01. SQ2214.2 +048000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2214.2 +048100 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2214.2 +048200 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2214.2 +048300 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +048400 MOVE 120 TO CORRECT-N. SQ2214.2 +048500 PERFORM PRINT-DETAIL. SQ2214.2 +048600 GO TO READ-INIT-F1-02. SQ2214.2 +048700 READ-SHORT-REC. SQ2214.2 +048800* READ NEXT RECORD AT END *SQ2214.2 +048900******************************************************************SQ2214.2 +049000 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +049100 GO TO READ-SHORT-REC-EXIT. SQ2214.2 +049200 READ SQ-VS7 NEXT RECORD AT END SQ2214.2 +049300 MOVE 1 TO EOF-FLAG SQ2214.2 +049400 GO TO READ-SHORT-REC-EXIT. SQ2214.2 +049500 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +049600 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2214.2 +049700 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2214.2 +049800 GO TO READ-SHORT-REC-ERROR. SQ2214.2 +049900 IF RECORD-LENGTH NOT EQUAL TO 120 SQ2214.2 +050000 GO TO READ-SHORT-REC-ERROR. SQ2214.2 +050100 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2214.2 +050200 GO TO READ-SHORT-REC-ERROR. SQ2214.2 +050300 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2214.2 +050400 GO TO READ-SHORT-REC-EXIT. SQ2214.2 +050500 READ-SHORT-REC-ERROR. SQ2214.2 +050600 ADD 1 TO RECORDS-IN-ERROR. SQ2214.2 +050700 MOVE 1 TO ERROR-FLAG. SQ2214.2 +050800 READ-SHORT-REC-EXIT. SQ2214.2 +050900 EXIT. SQ2214.2 +051000 READ-INIT-F1-02. SQ2214.2 +051100 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +051200 READ-TEST-F1-02. SQ2214.2 +051300 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2214.2 +051400 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +051500 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2214.2 +051600 GO TO READ-EOF-F1-06. SQ2214.2 +051700 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +051800 GO TO READ-FAIL-F1-02. SQ2214.2 +051900 READ-PASS-F1-02. SQ2214.2 +052000 PERFORM PASS. SQ2214.2 +052100 GO TO READ-WRITE-F1-02. SQ2214.2 +052200 READ-FAIL-F1-02. SQ2214.2 +052300 MOVE "SEE VII-52 WRITE LONG RECORD OR VII-44 READ" TO RE-MARKSQ2214.2 +052400 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +052500 MOVE 151 TO CORRECT-N. SQ2214.2 +052600 PERFORM FAIL. SQ2214.2 +052700 READ-WRITE-F1-02. SQ2214.2 +052800 MOVE "READ LONG RECORD" TO FEATURE. SQ2214.2 +052900 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2214.2 +053000 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2214.2 +053100 PERFORM PRINT-DETAIL. SQ2214.2 +053200 GO TO READ-INIT-F1-03. SQ2214.2 +053300 READ-LONG-REC. SQ2214.2 +053400 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +053500 GO TO READ-LONG-REC-EXIT. SQ2214.2 +053600 READ SQ-VS7 END SQ2214.2 +053700 MOVE 1 TO EOF-FLAG SQ2214.2 +053800 GO TO READ-LONG-REC-EXIT. SQ2214.2 +053900 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +054000 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2214.2 +054100 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2214.2 +054200 GO TO READ-LONG-REC-ERROR. SQ2214.2 +054300 IF RECORD-LENGTH NOT EQUAL TO 151 SQ2214.2 +054400 GO TO READ-LONG-REC-ERROR. SQ2214.2 +054500 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2214.2 +054600 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ2214.2 +054700 GO TO READ-LONG-REC-ERROR. SQ2214.2 +054800 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2214.2 +054900 GO TO READ-LONG-REC-EXIT. SQ2214.2 +055000 READ-LONG-REC-ERROR. SQ2214.2 +055100 ADD 1 TO RECORDS-IN-ERROR. SQ2214.2 +055200 MOVE 1 TO ERROR-FLAG. SQ2214.2 +055300 READ-LONG-REC-EXIT. SQ2214.2 +055400 EXIT. SQ2214.2 +055500 READ-INIT-F1-03. SQ2214.2 +055600 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +055700 READ-TEST-F1-03. SQ2214.2 +055800 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2214.2 +055900 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +056000 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2214.2 +056100 GO TO READ-EOF-F1-06. SQ2214.2 +056200 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +056300 GO TO READ-FAIL-F1-03. SQ2214.2 +056400 READ-PASS-F1-03. SQ2214.2 +056500 PERFORM PASS. SQ2214.2 +056600 GO TO READ-WRITE-F1-03. SQ2214.2 +056700 READ-FAIL-F1-03. SQ2214.2 +056800 MOVE "SEE VII-52 WRITE SHORT REC OR VII-44 READ" TO RE-MARKSQ2214.2 +056900 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +057000 MOVE 120 TO CORRECT-N. SQ2214.2 +057100 PERFORM FAIL. SQ2214.2 +057200 READ-WRITE-F1-03. SQ2214.2 +057300 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2214.2 +057400 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2214.2 +057500 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2214.2 +057600 PERFORM PRINT-DETAIL. SQ2214.2 +057700 READ-INIT-F1-04. SQ2214.2 +057800 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +057900 READ-TEST-F1-04. SQ2214.2 +058000 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2214.2 +058100 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +058200 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2214.2 +058300 GO TO READ-EOF-F1-06. SQ2214.2 +058400 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +058500 GO TO READ-FAIL-F1-04. SQ2214.2 +058600 READ-PASS-F1-04. SQ2214.2 +058700 PERFORM PASS. SQ2214.2 +058800 GO TO READ-WRITE-F1-04. SQ2214.2 +058900 READ-FAIL-F1-04. SQ2214.2 +059000 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +059100 MOVE 151 TO CORRECT-N. SQ2214.2 +059200 PERFORM FAIL. SQ2214.2 +059300 READ-WRITE-F1-04. SQ2214.2 +059400 MOVE "READ LONG RECORDS" TO FEATURE. SQ2214.2 +059500 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2214.2 +059600 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2214.2 +059700 PERFORM PRINT-DETAIL. SQ2214.2 +059800 READ-INIT-F1-05. SQ2214.2 +059900 MOVE ZERO TO ERROR-FLAG. SQ2214.2 +060000 READ-TEST-F1-05. SQ2214.2 +060100 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2214.2 +060200 IF EOF-FLAG EQUAL TO 1 SQ2214.2 +060300 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2214.2 +060400 GO TO READ-EOF-F1-06. SQ2214.2 +060500 IF ERROR-FLAG EQUAL TO 1 SQ2214.2 +060600 GO TO READ-FAIL-F1-05. SQ2214.2 +060700 READ-PASS-F1-05. SQ2214.2 +060800 PERFORM PASS. SQ2214.2 +060900 GO TO READ-WRITE-F1-05. SQ2214.2 +061000 READ-FAIL-F1-05. SQ2214.2 +061100 MOVE "SEE VII-52 WRITE LONG RECORD OR VII-44 READ" TO RE-MARKSQ2214.2 +061200 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2214.2 +061300 MOVE 120 TO CORRECT-N. SQ2214.2 +061400 PERFORM FAIL. SQ2214.2 +061500 READ-WRITE-F1-05. SQ2214.2 +061600 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2214.2 +061700 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2214.2 +061800 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2214.2 +061900 PERFORM PRINT-DETAIL. SQ2214.2 +062000 READ-INIT-F1-06. SQ2214.2 +062100 READ SQ-VS7 RECORD END SQ2214.2 +062200 GO TO READ-TEST-F1-06. SQ2214.2 +062300 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2214.2 +062400 GO TO READ-FAIL-F1-06. SQ2214.2 +062500 READ-EOF-F1-06. SQ2214.2 +062600 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2214.2 +062700 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2214.2 +062800 GO TO READ-FAIL-F1-06. SQ2214.2 +062900 READ-TEST-F1-06. SQ2214.2 +063000 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2214.2 +063100 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2214.2 +063200 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2214.2 +063300 GO TO READ-FAIL-F1-06. SQ2214.2 +063400 READ-PASS-F1-06. SQ2214.2 +063500 PERFORM PASS. SQ2214.2 +063600 GO TO READ-WRITE-F1-06. SQ2214.2 +063700 READ-FAIL-F1-06. SQ2214.2 +063800 PERFORM FAIL. SQ2214.2 +063900 READ-WRITE-F1-06. SQ2214.2 +064000 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2214.2 +064100 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2214.2 +064200 PERFORM PRINT-DETAIL. SQ2214.2 +064300 READ-CLOSE-F1-06. SQ2214.2 +064400 CLOSE SQ-VS7. SQ2214.2 +064500 SECT-SQ221A-0002 SECTION. SQ2214.2 +064600* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ2214.2 +064700* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ2214.2 +064800* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ2214.2 +064900* 130 IS UNIQUE FOR EACH RECORD. SQ2214.2 +065000 INFO-INIT-01. SQ2214.2 +065100 OPEN INPUT SQ-VS7. SQ2214.2 +065200 MOVE ZERO TO COUNT-OF-RECS. SQ2214.2 +065300 INFO-TEST-01. SQ2214.2 +065400 READ SQ-VS7 AT END SQ2214.2 +065500 GO TO INFO-END. SQ2214.2 +065600 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +065700 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ2214.2 +065800 GO TO NO-INFO-01. SQ2214.2 +065900 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2214.2 +066000 MOVE "RECORD READ =" TO COMPUTED-A. SQ2214.2 +066100 MOVE 0001 TO CORRECT-18V0. SQ2214.2 +066200 GO TO INFO-WRITE-01. SQ2214.2 +066300 NO-INFO-01. SQ2214.2 +066400 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2214.2 +066500 INFO-WRITE-01. SQ2214.2 +066600 MOVE "READ SHORT RECORD" TO FEATURE. SQ2214.2 +066700 MOVE "INFO-TEST-01" TO PAR-NAME. SQ2214.2 +066800 PERFORM PRINT-DETAIL. SQ2214.2 +066900 INFO-INIT-02. SQ2214.2 +067000 READ SQ-VS7 RECORD AT END SQ2214.2 +067100 GO TO INFO-END. SQ2214.2 +067200 READ SQ-VS7 END SQ2214.2 +067300 GO TO INFO-END. SQ2214.2 +067400 INFO-TEST-02. SQ2214.2 +067500 READ SQ-VS7 AT END SQ2214.2 +067600 GO TO INFO-END. SQ2214.2 +067700 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ2214.2 +067800 GO TO NO-INFO-02. SQ2214.2 +067900 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2214.2 +068000 MOVE "RECORD READ =" TO COMPUTED-A. SQ2214.2 +068100 MOVE 0004 TO CORRECT-18V0. SQ2214.2 +068200 GO TO INFO-WRITE-02. SQ2214.2 +068300 NO-INFO-02. SQ2214.2 +068400 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2214.2 +068500 INFO-WRITE-02. SQ2214.2 +068600 MOVE "READ SHORT RECORD" TO FEATURE. SQ2214.2 +068700 MOVE "INFO-TEST-02" TO PAR-NAME. SQ2214.2 +068800 PERFORM PRINT-DETAIL. SQ2214.2 +068900 INFO-INIT-03. SQ2214.2 +069000 ADD 3 TO COUNT-OF-RECS. SQ2214.2 +069100 INFO-INIT-03-1. SQ2214.2 +069200 READ SQ-VS7 RECORD SQ2214.2 +069300 END GO TO INFO-END. SQ2214.2 +069400 ADD 1 TO COUNT-OF-RECS. SQ2214.2 +069500 IF COUNT-OF-RECS EQUAL TO 450 SQ2214.2 +069600 GO TO INFO-TEST-03. SQ2214.2 +069700 GO TO INFO-INIT-03-1. SQ2214.2 +069800 INFO-TEST-03. SQ2214.2 +069900 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ2214.2 +070000 GO TO NO-INFO-03. SQ2214.2 +070100 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2214.2 +070200 MOVE "RECORD READ =" TO COMPUTED-A. SQ2214.2 +070300 MOVE 0450 TO CORRECT-18V0. SQ2214.2 +070400 GO TO INFO-WRITE-03. SQ2214.2 +070500 NO-INFO-03. SQ2214.2 +070600 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2214.2 +070700 INFO-WRITE-03. SQ2214.2 +070800 MOVE "READ SHORT RECORD" TO FEATURE. SQ2214.2 +070900 MOVE "INFO-TEST-03" TO PAR-NAME. SQ2214.2 +071000 PERFORM PRINT-DETAIL. SQ2214.2 +071100 INFO-END. SQ2214.2 +071200 CLOSE SQ-VS7. SQ2214.2 +071300 TERMINATE-ROUTINE. SQ2214.2 +071400 EXIT. SQ2214.2 +071500 CCVS-EXIT SECTION. SQ2214.2 +071600 CCVS-999999. SQ2214.2 +071700 GO TO CLOSE-FILES. SQ2214.2 diff --git a/tests/cobol85/SQ/SQ222A.CBL b/tests/cobol85/SQ/SQ222A.CBL new file mode 100755 index 00000000..d715e25b --- /dev/null +++ b/tests/cobol85/SQ/SQ222A.CBL @@ -0,0 +1,701 @@ +000100 IDENTIFICATION DIVISION. SQ2224.2 +000200 PROGRAM-ID. SQ2224.2 +000300 SQ222A. SQ2224.2 +000400**************************************************************** SQ2224.2 +000500* * SQ2224.2 +000600* VALIDATION FOR:- * SQ2224.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2224.2 +000800* * SQ2224.2 +000900* CREATION DATE / VALIDATION DATE * SQ2224.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2224.2 +001100* * SQ2224.2 +001200* THIS ROUTINE CHECKS: SQ2224.2 +001300* SQ2224.2 +001400* RECORD VARYING. SQ2224.2 +001500* SQ2224.2 +001600* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ2224.2 +001700* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ2224.2 +001800* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ2224.2 +001900* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ2224.2 +002000* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ2224.2 +002100* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2224.2 +002200* AGAINST THE EXPECTED VALUES. SQ2224.2 +002300* SQ2224.2 +002400* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ2224.2 +002500* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ2224.2 +002600* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ2224.2 +002700* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ2224.2 +002800* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ2224.2 +002900 ENVIRONMENT DIVISION. SQ2224.2 +003000 CONFIGURATION SECTION. SQ2224.2 +003100 SOURCE-COMPUTER. SQ2224.2 +003200 Linux. SQ2224.2 +003300 OBJECT-COMPUTER. SQ2224.2 +003400 Linux. SQ2224.2 +003500 INPUT-OUTPUT SECTION. SQ2224.2 +003600 FILE-CONTROL. SQ2224.2 +003700*P SELECT RAW-DATA ASSIGN TO SQ2224.2 +003800*P "XXXXX062" SQ2224.2 +003900*P ORGANIZATION IS INDEXED SQ2224.2 +004000*P ACCESS MODE IS RANDOM SQ2224.2 +004100*P RECORD KEY IS RAW-DATA-KEY. SQ2224.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2224.2 +004300 "report.log". SQ2224.2 +004400 SELECT SQ-VS7 ASSIGN TO SQ2224.2 +004500 "XXXXX014" SQ2224.2 +004600 ORGANIZATION SEQUENTIAL SQ2224.2 +004700 ACCESS SEQUENTIAL. SQ2224.2 +004800 DATA DIVISION. SQ2224.2 +004900 FILE SECTION. SQ2224.2 +005000*P SQ2224.2 +005100*PD RAW-DATA. SQ2224.2 +005200*P SQ2224.2 +005300*P1 RAW-DATA-SATZ. SQ2224.2 +005400*P 05 RAW-DATA-KEY PIC X(6). SQ2224.2 +005500*P 05 C-DATE PIC 9(6). SQ2224.2 +005600*P 05 C-TIME PIC 9(8). SQ2224.2 +005700*P 05 C-NO-OF-TESTS PIC 99. SQ2224.2 +005800*P 05 C-OK PIC 999. SQ2224.2 +005900*P 05 C-ALL PIC 999. SQ2224.2 +006000*P 05 C-FAIL PIC 999. SQ2224.2 +006100*P 05 C-DELETED PIC 999. SQ2224.2 +006200*P 05 C-INSPECT PIC 999. SQ2224.2 +006300*P 05 C-NOTE PIC X(13). SQ2224.2 +006400*P 05 C-INDENT PIC X. SQ2224.2 +006500*P 05 C-ABORT PIC X(8). SQ2224.2 +006600 FD PRINT-FILE SQ2224.2 +006700*C LABEL RECORDS SQ2224.2 +006800*C OMITTED SQ2224.2 +006900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2224.2 +007000 . SQ2224.2 +007100 01 PRINT-REC PICTURE X(120). SQ2224.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2224.2 +007300 FD SQ-VS7 SQ2224.2 +007400*C LABEL RECORDS ARE STANDARD SQ2224.2 +007500 RECORD VARYING. SQ2224.2 +007600 01 SQ-VS7R1-M-G-120. SQ2224.2 +007700 02 SQ-VS7R1-FIRST PICTURE X(120). SQ2224.2 +007800 01 SQ-VS7R2-M-G-151. SQ2224.2 +007900 02 SQ-VS7R2-FIRST PICTURE X(120). SQ2224.2 +008000 02 LONG-OR-SHORT PICTURE X(5). SQ2224.2 +008100 02 SQ-VS7-RECNO PICTURE X(5). SQ2224.2 +008200 02 SQ-VS7-FILLER PICTURE X(21). SQ2224.2 +008300 WORKING-STORAGE SECTION. SQ2224.2 +008400 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2224.2 +008500 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2224.2 +008600 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ2224.2 +008700 01 ERROR-FLAG PICTURE 9. SQ2224.2 +008800 01 EOF-FLAG PICTURE 9. SQ2224.2 +008900 01 DUMP-AREA. SQ2224.2 +009000 02 TYPE-OF-REC PICTURE X(5). SQ2224.2 +009100 02 RECNO PICTURE 9(5). SQ2224.2 +009200 02 FILLER PICTURE X(21). SQ2224.2 +009300 01 FILE-RECORD-INFORMATION-REC. SQ2224.2 +009400 03 FILE-RECORD-INFO-SKELETON. SQ2224.2 +009500 05 FILLER PICTURE X(48) VALUE SQ2224.2 +009600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2224.2 +009700 05 FILLER PICTURE X(46) VALUE SQ2224.2 +009800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2224.2 +009900 05 FILLER PICTURE X(26) VALUE SQ2224.2 +010000 ",LFIL=000000,ORG= ,LBLR= ". SQ2224.2 +010100 05 FILLER PICTURE X(37) VALUE SQ2224.2 +010200 ",RECKEY= ". SQ2224.2 +010300 05 FILLER PICTURE X(38) VALUE SQ2224.2 +010400 ",ALTKEY1= ". SQ2224.2 +010500 05 FILLER PICTURE X(38) VALUE SQ2224.2 +010600 ",ALTKEY2= ". SQ2224.2 +010700 05 FILLER PICTURE X(7) VALUE SPACE.SQ2224.2 +010800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2224.2 +010900 05 FILE-RECORD-INFO-P1-120. SQ2224.2 +011000 07 FILLER PIC X(5). SQ2224.2 +011100 07 XFILE-NAME PIC X(6). SQ2224.2 +011200 07 FILLER PIC X(8). SQ2224.2 +011300 07 XRECORD-NAME PIC X(6). SQ2224.2 +011400 07 FILLER PIC X(1). SQ2224.2 +011500 07 REELUNIT-NUMBER PIC 9(1). SQ2224.2 +011600 07 FILLER PIC X(7). SQ2224.2 +011700 07 XRECORD-NUMBER PIC 9(6). SQ2224.2 +011800 07 FILLER PIC X(6). SQ2224.2 +011900 07 UPDATE-NUMBER PIC 9(2). SQ2224.2 +012000 07 FILLER PIC X(5). SQ2224.2 +012100 07 ODO-NUMBER PIC 9(4). SQ2224.2 +012200 07 FILLER PIC X(5). SQ2224.2 +012300 07 XPROGRAM-NAME PIC X(5). SQ2224.2 +012400 07 FILLER PIC X(7). SQ2224.2 +012500 07 XRECORD-LENGTH PIC 9(6). SQ2224.2 +012600 07 FILLER PIC X(7). SQ2224.2 +012700 07 CHARS-OR-RECORDS PIC X(2). SQ2224.2 +012800 07 FILLER PIC X(1). SQ2224.2 +012900 07 XBLOCK-SIZE PIC 9(4). SQ2224.2 +013000 07 FILLER PIC X(6). SQ2224.2 +013100 07 RECORDS-IN-FILE PIC 9(6). SQ2224.2 +013200 07 FILLER PIC X(5). SQ2224.2 +013300 07 XFILE-ORGANIZATION PIC X(2). SQ2224.2 +013400 07 FILLER PIC X(6). SQ2224.2 +013500 07 XLABEL-TYPE PIC X(1). SQ2224.2 +013600 05 FILE-RECORD-INFO-P121-240. SQ2224.2 +013700 07 FILLER PIC X(8). SQ2224.2 +013800 07 XRECORD-KEY PIC X(29). SQ2224.2 +013900 07 FILLER PIC X(9). SQ2224.2 +014000 07 ALTERNATE-KEY1 PIC X(29). SQ2224.2 +014100 07 FILLER PIC X(9). SQ2224.2 +014200 07 ALTERNATE-KEY2 PIC X(29). SQ2224.2 +014300 07 FILLER PIC X(7). SQ2224.2 +014400 01 TEST-RESULTS. SQ2224.2 +014500 02 FILLER PICTURE X VALUE SPACE. SQ2224.2 +014600 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2224.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2224.2 +014800 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2224.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ2224.2 +015000 02 PAR-NAME. SQ2224.2 +015100 03 FILLER PICTURE X(12) VALUE SPACE. SQ2224.2 +015200 03 PARDOT-X PICTURE X VALUE SPACE. SQ2224.2 +015300 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2224.2 +015400 03 FILLER PIC X(5) VALUE SPACE. SQ2224.2 +015500 02 FILLER PIC X(10) VALUE SPACE. SQ2224.2 +015600 02 RE-MARK PIC X(61). SQ2224.2 +015700 01 TEST-COMPUTED. SQ2224.2 +015800 02 FILLER PIC X(30) VALUE SPACE. SQ2224.2 +015900 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2224.2 +016000 02 COMPUTED-X. SQ2224.2 +016100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2224.2 +016200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2224.2 +016300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2224.2 +016400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2224.2 +016500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2224.2 +016600 03 CM-18V0 REDEFINES COMPUTED-A. SQ2224.2 +016700 04 COMPUTED-18V0 PICTURE -9(18). SQ2224.2 +016800 04 FILLER PICTURE X. SQ2224.2 +016900 03 FILLER PIC X(50) VALUE SPACE. SQ2224.2 +017000 01 TEST-CORRECT. SQ2224.2 +017100 02 FILLER PIC X(30) VALUE SPACE. SQ2224.2 +017200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2224.2 +017300 02 CORRECT-X. SQ2224.2 +017400 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2224.2 +017500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2224.2 +017600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2224.2 +017700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2224.2 +017800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2224.2 +017900 03 CR-18V0 REDEFINES CORRECT-A. SQ2224.2 +018000 04 CORRECT-18V0 PICTURE -9(18). SQ2224.2 +018100 04 FILLER PICTURE X. SQ2224.2 +018200 03 FILLER PIC X(50) VALUE SPACE. SQ2224.2 +018300 01 CCVS-C-1. SQ2224.2 +018400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2224.2 +018500- "SS PARAGRAPH-NAME SQ2224.2 +018600- " REMARKS". SQ2224.2 +018700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2224.2 +018800 01 CCVS-C-2. SQ2224.2 +018900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2224.2 +019000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2224.2 +019100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2224.2 +019200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2224.2 +019300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2224.2 +019400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2224.2 +019500 01 REC-CT PICTURE 99 VALUE ZERO. SQ2224.2 +019600 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2224.2 +019700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2224.2 +019800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2224.2 +019900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2224.2 +020000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2224.2 +020100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2224.2 +020200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2224.2 +020300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2224.2 +020400 01 CCVS-H-1. SQ2224.2 +020500 02 FILLER PICTURE X(27) VALUE SPACE. SQ2224.2 +020600 02 FILLER PICTURE X(67) VALUE SQ2224.2 +020700 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2224.2 +020800- " SYSTEM". SQ2224.2 +020900 02 FILLER PICTURE X(26) VALUE SPACE. SQ2224.2 +021000 01 CCVS-H-2. SQ2224.2 +021100 02 FILLER PICTURE X(52) VALUE IS SQ2224.2 +021200 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2224.2 +021300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2224.2 +021400 02 TEST-ID PICTURE IS X(9). SQ2224.2 +021500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2224.2 +021600 01 CCVS-H-3. SQ2224.2 +021700 02 FILLER PICTURE X(34) VALUE SQ2224.2 +021800 " FOR OFFICIAL USE ONLY ". SQ2224.2 +021900 02 FILLER PICTURE X(58) VALUE SQ2224.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2224.2 +022100 02 FILLER PICTURE X(28) VALUE SQ2224.2 +022200 " COPYRIGHT 1985 ". SQ2224.2 +022300 01 CCVS-E-1. SQ2224.2 +022400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2224.2 +022500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2224.2 +022600 02 ID-AGAIN PICTURE IS X(9). SQ2224.2 +022700 02 FILLER PICTURE X(45) VALUE IS SQ2224.2 +022800 " NTIS DISTRIBUTION COBOL 85". SQ2224.2 +022900 01 CCVS-E-2. SQ2224.2 +023000 02 FILLER PICTURE X(31) VALUE SQ2224.2 +023100 SPACE. SQ2224.2 +023200 02 FILLER PICTURE X(21) VALUE SPACE. SQ2224.2 +023300 02 CCVS-E-2-2. SQ2224.2 +023400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2224.2 +023500 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2224.2 +023600 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2224.2 +023700 01 CCVS-E-3. SQ2224.2 +023800 02 FILLER PICTURE X(22) VALUE SQ2224.2 +023900 " FOR OFFICIAL USE ONLY". SQ2224.2 +024000 02 FILLER PICTURE X(12) VALUE SPACE. SQ2224.2 +024100 02 FILLER PICTURE X(58) VALUE SQ2224.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2224.2 +024300 02 FILLER PICTURE X(13) VALUE SPACE. SQ2224.2 +024400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2224.2 +024500 01 CCVS-E-4. SQ2224.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2224.2 +024700 02 FILLER PIC XXXX VALUE " OF ". SQ2224.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2224.2 +024900 02 FILLER PIC X(40) VALUE SQ2224.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2224.2 +025100 01 XXINFO. SQ2224.2 +025200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2224.2 +025300 02 INFO-TEXT. SQ2224.2 +025400 04 FILLER PIC X(20) VALUE SPACE. SQ2224.2 +025500 04 XXCOMPUTED PIC X(20). SQ2224.2 +025600 04 FILLER PIC X(5) VALUE SPACE. SQ2224.2 +025700 04 XXCORRECT PIC X(20). SQ2224.2 +025800 01 HYPHEN-LINE. SQ2224.2 +025900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2224.2 +026000 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2224.2 +026100- "*****************************************". SQ2224.2 +026200 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2224.2 +026300- "******************************". SQ2224.2 +026400 01 CCVS-PGM-ID PIC X(6) VALUE SQ2224.2 +026500 "SQ222A". SQ2224.2 +026600 PROCEDURE DIVISION. SQ2224.2 +026700 CCVS1 SECTION. SQ2224.2 +026800 OPEN-FILES. SQ2224.2 +026900*P OPEN I-O RAW-DATA. SQ2224.2 +027000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2224.2 +027100*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2224.2 +027200*P MOVE "ABORTED " TO C-ABORT. SQ2224.2 +027300*P ADD 1 TO C-NO-OF-TESTS. SQ2224.2 +027400*P ACCEPT C-DATE FROM DATE. SQ2224.2 +027500*P ACCEPT C-TIME FROM TIME. SQ2224.2 +027600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2224.2 +027700*PND-E-1. SQ2224.2 +027800*P CLOSE RAW-DATA. SQ2224.2 +027900 OPEN OUTPUT PRINT-FILE. SQ2224.2 +028000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2224.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ2224.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2224.2 +028300 MOVE ZERO TO REC-SKL-SUB. SQ2224.2 +028400 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2224.2 +028500 CCVS-INIT-FILE. SQ2224.2 +028600 ADD 1 TO REC-SKL-SUB. SQ2224.2 +028700 MOVE FILE-RECORD-INFO-SKELETON TO SQ2224.2 +028800 FILE-RECORD-INFO (REC-SKL-SUB). SQ2224.2 +028900 CCVS-INIT-EXIT. SQ2224.2 +029000 GO TO CCVS1-EXIT. SQ2224.2 +029100 CLOSE-FILES. SQ2224.2 +029200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2224.2 +029300*P OPEN I-O RAW-DATA. SQ2224.2 +029400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2224.2 +029500*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2224.2 +029600*P MOVE "OK. " TO C-ABORT. SQ2224.2 +029700*P MOVE PASS-COUNTER TO C-OK. SQ2224.2 +029800*P MOVE ERROR-HOLD TO C-ALL. SQ2224.2 +029900*P MOVE ERROR-COUNTER TO C-FAIL. SQ2224.2 +030000*P MOVE DELETE-CNT TO C-DELETED. SQ2224.2 +030100*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2224.2 +030200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2224.2 +030300*PND-E-2. SQ2224.2 +030400*P CLOSE RAW-DATA. SQ2224.2 +030500 TERMINATE-CCVS. SQ2224.2 +030600*S EXIT PROGRAM. SQ2224.2 +030700*SERMINATE-CALL. SQ2224.2 +030800 STOP RUN. SQ2224.2 +030900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2224.2 +031000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2224.2 +031100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2224.2 +031200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2224.2 +031300 MOVE "****TEST DELETED****" TO RE-MARK. SQ2224.2 +031400 PRINT-DETAIL. SQ2224.2 +031500 IF REC-CT NOT EQUAL TO ZERO SQ2224.2 +031600 MOVE "." TO PARDOT-X SQ2224.2 +031700 MOVE REC-CT TO DOTVALUE. SQ2224.2 +031800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2224.2 +031900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2224.2 +032000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2224.2 +032100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2224.2 +032200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2224.2 +032300 MOVE SPACE TO CORRECT-X. SQ2224.2 +032400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2224.2 +032500 MOVE SPACE TO RE-MARK. SQ2224.2 +032600 HEAD-ROUTINE. SQ2224.2 +032700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +032800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2224.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2224.2 +033000 COLUMN-NAMES-ROUTINE. SQ2224.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +033400 END-ROUTINE. SQ2224.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2224.2 +033600 END-RTN-EXIT. SQ2224.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +033800 END-ROUTINE-1. SQ2224.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2224.2 +034000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2224.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. SQ2224.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2224.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2224.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2224.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2224.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2224.2 +034700 END-ROUTINE-12. SQ2224.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2224.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2224.2 +035000 MOVE "NO " TO ERROR-TOTAL SQ2224.2 +035100 ELSE SQ2224.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2224.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2224.2 +035400 PERFORM WRITE-LINE. SQ2224.2 +035500 END-ROUTINE-13. SQ2224.2 +035600 IF DELETE-CNT IS EQUAL TO ZERO SQ2224.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE SQ2224.2 +035800 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2224.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2224.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO SQ2224.2 +036200 MOVE "NO " TO ERROR-TOTAL SQ2224.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2224.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2224.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2224.2 +036700 WRITE-LINE. SQ2224.2 +036800 ADD 1 TO RECORD-COUNT. SQ2224.2 +036900 IF RECORD-COUNT GREATER 50 SQ2224.2 +037000 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2224.2 +037100 MOVE SPACE TO DUMMY-RECORD SQ2224.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2224.2 +037300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2224.2 +037400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2224.2 +037500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2224.2 +037600 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2224.2 +037700 MOVE ZERO TO RECORD-COUNT. SQ2224.2 +037800 PERFORM WRT-LN. SQ2224.2 +037900 WRT-LN. SQ2224.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2224.2 +038100 MOVE SPACE TO DUMMY-RECORD. SQ2224.2 +038200 BLANK-LINE-PRINT. SQ2224.2 +038300 PERFORM WRT-LN. SQ2224.2 +038400 FAIL-ROUTINE. SQ2224.2 +038500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2224.2 +038600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2224.2 +038700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2224.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +038900 GO TO FAIL-ROUTINE-EX. SQ2224.2 +039000 FAIL-ROUTINE-WRITE. SQ2224.2 +039100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2224.2 +039200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +039300 FAIL-ROUTINE-EX. EXIT. SQ2224.2 +039400 BAIL-OUT. SQ2224.2 +039500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2224.2 +039600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2224.2 +039700 BAIL-OUT-WRITE. SQ2224.2 +039800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2224.2 +039900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2224.2 +040000 BAIL-OUT-EX. EXIT. SQ2224.2 +040100 CCVS1-EXIT. SQ2224.2 +040200 EXIT. SQ2224.2 +040300 SECT-SQ222A-0001 SECTION. SQ2224.2 +040400 WRITE-INIT-GF-01. SQ2224.2 +040500 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ2224.2 +040600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2224.2 +040700 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2224.2 +040800 MOVE 0001 TO XBLOCK-SIZE (1). SQ2224.2 +040900 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2224.2 +041000 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2224.2 +041100 MOVE "S" TO XLABEL-TYPE (1). SQ2224.2 +041200 MOVE 000000 TO XRECORD-NUMBER (1). SQ2224.2 +041300 MOVE ZERO TO COUNT-OF-RECS. SQ2224.2 +041400 OPEN OUTPUT SQ-VS7. SQ2224.2 +041500 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ2224.2 +041600 WRITE-TEST-GF-01. SQ2224.2 +041700 PERFORM WRITE-SHORT-REC. SQ2224.2 +041800 PERFORM WRITE-LONG-REC. SQ2224.2 +041900 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2224.2 +042000 PERFORM WRITE-LONG-REC 100 TIMES. SQ2224.2 +042100 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2224.2 +042200 WRITE-WRITE-GF-01. SQ2224.2 +042300 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2224.2 +042400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2224.2 +042500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2224.2 +042600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2224.2 +042700 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2224.2 +042800 PERFORM PRINT-DETAIL. SQ2224.2 +042900* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ2224.2 +043000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2224.2 +043100* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ2224.2 +043200* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ2224.2 +043300* 100L-338S. SQ2224.2 +043400 WRITE-CLOSE-GF-01. SQ2224.2 +043500 CLOSE SQ-VS7. SQ2224.2 +043600 GO TO READ-INIT-F1-01. SQ2224.2 +043700 WRITE-SHORT-REC. SQ2224.2 +043800 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2224.2 +043900 MOVE 000120 TO XRECORD-LENGTH (1). SQ2224.2 +044000 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +044100 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2224.2 +044200 MOVE "SHORT" TO LONG-OR-SHORT. SQ2224.2 +044300 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2224.2 +044400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ2224.2 +044500 WRITE SQ-VS7R1-M-G-120. SQ2224.2 +044600 WRITE-LONG-REC. SQ2224.2 +044700 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2224.2 +044800 MOVE 000151 TO XRECORD-LENGTH (1). SQ2224.2 +044900 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +045000 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2224.2 +045100 MOVE "LONG" TO LONG-OR-SHORT. SQ2224.2 +045200 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2224.2 +045300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ2224.2 +045400 WRITE SQ-VS7R2-M-G-151. SQ2224.2 +045500 READ-INIT-F1-01. SQ2224.2 +045600 MOVE ZERO TO COUNT-OF-RECS. SQ2224.2 +045700 MOVE ZERO TO EOF-FLAG. SQ2224.2 +045800 MOVE ZERO TO RECORDS-IN-ERROR. SQ2224.2 +045900 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +046000 OPEN INPUT SQ-VS7. SQ2224.2 +046100 READ-TEST-F1-01. SQ2224.2 +046200 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2224.2 +046300 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +046400 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2224.2 +046500 GO TO READ-EOF-F1-06. SQ2224.2 +046600 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +046700 GO TO READ-FAIL-F1-01. SQ2224.2 +046800 READ-PASS-F1-01. SQ2224.2 +046900 PERFORM PASS. SQ2224.2 +047000 GO TO READ-WRITE-F1-01. SQ2224.2 +047100 READ-FAIL-F1-01. SQ2224.2 +047200 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +047300 PERFORM FAIL. SQ2224.2 +047400 READ-WRITE-F1-01. SQ2224.2 +047500 MOVE "READ SHORT RECORD" TO FEATURE. SQ2224.2 +047600 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2224.2 +047700 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2224.2 +047800 PERFORM PRINT-DETAIL. SQ2224.2 +047900 GO TO READ-INIT-F1-02. SQ2224.2 +048000 READ-SHORT-REC. SQ2224.2 +048100 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +048200 GO TO READ-SHORT-REC-EXIT. SQ2224.2 +048300 READ SQ-VS7 AT END SQ2224.2 +048400 MOVE 1 TO EOF-FLAG SQ2224.2 +048500 GO TO READ-SHORT-REC-EXIT. SQ2224.2 +048600 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +048700 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2224.2 +048800 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2224.2 +048900 GO TO READ-SHORT-REC-ERROR. SQ2224.2 +049000 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ2224.2 +049100 GO TO READ-SHORT-REC-ERROR. SQ2224.2 +049200 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2224.2 +049300 GO TO READ-SHORT-REC-ERROR. SQ2224.2 +049400 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2224.2 +049500 GO TO READ-SHORT-REC-EXIT. SQ2224.2 +049600 READ-SHORT-REC-ERROR. SQ2224.2 +049700 ADD 1 TO RECORDS-IN-ERROR. SQ2224.2 +049800 MOVE 1 TO ERROR-FLAG. SQ2224.2 +049900 READ-SHORT-REC-EXIT. SQ2224.2 +050000 EXIT. SQ2224.2 +050100 READ-INIT-F1-02. SQ2224.2 +050200 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +050300 READ-TEST-F1-02. SQ2224.2 +050400 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2224.2 +050500 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +050600 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2224.2 +050700 GO TO READ-EOF-F1-06. SQ2224.2 +050800 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +050900 GO TO READ-FAIL-F1-02. SQ2224.2 +051000 READ-PASS-F1-02. SQ2224.2 +051100 PERFORM PASS. SQ2224.2 +051200 GO TO READ-WRITE-F1-02. SQ2224.2 +051300 READ-FAIL-F1-02. SQ2224.2 +051400 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +051500 PERFORM FAIL. SQ2224.2 +051600 READ-WRITE-F1-02. SQ2224.2 +051700 MOVE "READ LONG RECORD" TO FEATURE. SQ2224.2 +051800 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2224.2 +051900 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2224.2 +052000 PERFORM PRINT-DETAIL. SQ2224.2 +052100 GO TO READ-INIT-F1-03. SQ2224.2 +052200 READ-LONG-REC. SQ2224.2 +052300 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +052400 GO TO READ-LONG-REC-EXIT. SQ2224.2 +052500 READ SQ-VS7 END SQ2224.2 +052600 MOVE 1 TO EOF-FLAG SQ2224.2 +052700 GO TO READ-LONG-REC-EXIT. SQ2224.2 +052800 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +052900 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2224.2 +053000 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2224.2 +053100 GO TO READ-LONG-REC-ERROR. SQ2224.2 +053200 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ2224.2 +053300 GO TO READ-LONG-REC-ERROR. SQ2224.2 +053400 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2224.2 +053500 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ2224.2 +053600 GO TO READ-LONG-REC-ERROR. SQ2224.2 +053700 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2224.2 +053800 GO TO READ-LONG-REC-EXIT. SQ2224.2 +053900 READ-LONG-REC-ERROR. SQ2224.2 +054000 ADD 1 TO RECORDS-IN-ERROR. SQ2224.2 +054100 MOVE 1 TO ERROR-FLAG. SQ2224.2 +054200 READ-LONG-REC-EXIT. SQ2224.2 +054300 EXIT. SQ2224.2 +054400 READ-INIT-F1-03. SQ2224.2 +054500 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +054600 READ-TEST-F1-03. SQ2224.2 +054700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2224.2 +054800 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +054900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2224.2 +055000 GO TO READ-EOF-F1-06. SQ2224.2 +055100 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +055200 GO TO READ-FAIL-F1-03. SQ2224.2 +055300 READ-PASS-F1-03. SQ2224.2 +055400 PERFORM PASS. SQ2224.2 +055500 GO TO READ-WRITE-F1-03. SQ2224.2 +055600 READ-FAIL-F1-03. SQ2224.2 +055700 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +055800 PERFORM FAIL. SQ2224.2 +055900 READ-WRITE-F1-03. SQ2224.2 +056000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2224.2 +056100 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2224.2 +056200 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2224.2 +056300 PERFORM PRINT-DETAIL. SQ2224.2 +056400 READ-INIT-F1-04. SQ2224.2 +056500 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +056600 READ-TEST-F1-04. SQ2224.2 +056700 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2224.2 +056800 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +056900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2224.2 +057000 GO TO READ-EOF-F1-06. SQ2224.2 +057100 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +057200 GO TO READ-FAIL-F1-04. SQ2224.2 +057300 READ-PASS-F1-04. SQ2224.2 +057400 PERFORM PASS. SQ2224.2 +057500 GO TO READ-WRITE-F1-04. SQ2224.2 +057600 READ-FAIL-F1-04. SQ2224.2 +057700 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +057800 PERFORM FAIL. SQ2224.2 +057900 READ-WRITE-F1-04. SQ2224.2 +058000 MOVE "READ LONG RECORDS" TO FEATURE. SQ2224.2 +058100 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2224.2 +058200 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2224.2 +058300 PERFORM PRINT-DETAIL. SQ2224.2 +058400 READ-INIT-F1-05. SQ2224.2 +058500 MOVE ZERO TO ERROR-FLAG. SQ2224.2 +058600 READ-TEST-F1-05. SQ2224.2 +058700 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2224.2 +058800 IF EOF-FLAG EQUAL TO 1 SQ2224.2 +058900 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2224.2 +059000 GO TO READ-EOF-F1-06. SQ2224.2 +059100 IF ERROR-FLAG EQUAL TO 1 SQ2224.2 +059200 GO TO READ-FAIL-F1-05. SQ2224.2 +059300 READ-PASS-F1-05. SQ2224.2 +059400 PERFORM PASS. SQ2224.2 +059500 GO TO READ-WRITE-F1-05. SQ2224.2 +059600 READ-FAIL-F1-05. SQ2224.2 +059700 MOVE "ERROR: SEE VII-52 WRITE OR VII-44 READ" TO RE-MARK. SQ2224.2 +059800 PERFORM FAIL. SQ2224.2 +059900 READ-WRITE-F1-05. SQ2224.2 +060000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2224.2 +060100 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2224.2 +060200 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2224.2 +060300 PERFORM PRINT-DETAIL. SQ2224.2 +060400 READ-INIT-F1-06. SQ2224.2 +060500 READ SQ-VS7 RECORD END SQ2224.2 +060600 GO TO READ-TEST-F1-06. SQ2224.2 +060700 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2224.2 +060800 GO TO READ-FAIL-F1-06. SQ2224.2 +060900 READ-EOF-F1-06. SQ2224.2 +061000 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2224.2 +061100 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2224.2 +061200 GO TO READ-FAIL-F1-06. SQ2224.2 +061300 READ-TEST-F1-06. SQ2224.2 +061400 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2224.2 +061500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2224.2 +061600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2224.2 +061700 GO TO READ-FAIL-F1-06. SQ2224.2 +061800 READ-PASS-F1-06. SQ2224.2 +061900 PERFORM PASS. SQ2224.2 +062000 GO TO READ-WRITE-F1-06. SQ2224.2 +062100 READ-FAIL-F1-06. SQ2224.2 +062200 PERFORM FAIL. SQ2224.2 +062300 READ-WRITE-F1-06. SQ2224.2 +062400 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2224.2 +062500 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2224.2 +062600 PERFORM PRINT-DETAIL. SQ2224.2 +062700 READ-CLOSE-F1-06. SQ2224.2 +062800 CLOSE SQ-VS7. SQ2224.2 +062900 SECT-SQ222A-0002 SECTION. SQ2224.2 +063000* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ2224.2 +063100* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ2224.2 +063200* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ2224.2 +063300* 130 IS UNIQUE FOR EACH RECORD. SQ2224.2 +063400 INFO-INIT-01. SQ2224.2 +063500 OPEN INPUT SQ-VS7. SQ2224.2 +063600 MOVE ZERO TO COUNT-OF-RECS. SQ2224.2 +063700 INFO-TEST-01. SQ2224.2 +063800 READ SQ-VS7 AT END SQ2224.2 +063900 GO TO INFO-END. SQ2224.2 +064000 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +064100 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ2224.2 +064200 GO TO NO-INFO-01. SQ2224.2 +064300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2224.2 +064400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2224.2 +064500 MOVE 0001 TO CORRECT-18V0. SQ2224.2 +064600 GO TO INFO-WRITE-01. SQ2224.2 +064700 NO-INFO-01. SQ2224.2 +064800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2224.2 +064900 INFO-WRITE-01. SQ2224.2 +065000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2224.2 +065100 MOVE "SEQ-INFO-01 " TO PAR-NAME. SQ2224.2 +065200 PERFORM PRINT-DETAIL. SQ2224.2 +065300 INFO-INIT-02. SQ2224.2 +065400 READ SQ-VS7 RECORD AT END SQ2224.2 +065500 GO TO INFO-END. SQ2224.2 +065600 READ SQ-VS7 END SQ2224.2 +065700 GO TO INFO-END. SQ2224.2 +065800 INFO-TEST-02. SQ2224.2 +065900 READ SQ-VS7 AT END SQ2224.2 +066000 GO TO INFO-END. SQ2224.2 +066100 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ2224.2 +066200 GO TO NO-INFO-02. SQ2224.2 +066300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2224.2 +066400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2224.2 +066500 MOVE 0004 TO CORRECT-18V0. SQ2224.2 +066600 GO TO INFO-WRITE-02. SQ2224.2 +066700 NO-INFO-02. SQ2224.2 +066800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2224.2 +066900 INFO-WRITE-02. SQ2224.2 +067000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2224.2 +067100 MOVE "SEQ-INFO-02 " TO PAR-NAME. SQ2224.2 +067200 PERFORM PRINT-DETAIL. SQ2224.2 +067300 INFO-INIT-03. SQ2224.2 +067400 ADD 3 TO COUNT-OF-RECS. SQ2224.2 +067500 INFO-INIT-03-1. SQ2224.2 +067600 READ SQ-VS7 RECORD SQ2224.2 +067700 END GO TO INFO-END. SQ2224.2 +067800 ADD 1 TO COUNT-OF-RECS. SQ2224.2 +067900 IF COUNT-OF-RECS EQUAL TO 450 SQ2224.2 +068000 GO TO INFO-TEST-03. SQ2224.2 +068100 GO TO INFO-INIT-03-1. SQ2224.2 +068200 INFO-TEST-03. SQ2224.2 +068300 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ2224.2 +068400 GO TO NO-INFO-03. SQ2224.2 +068500 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2224.2 +068600 MOVE "RECORD READ =" TO COMPUTED-A. SQ2224.2 +068700 MOVE 0450 TO CORRECT-18V0. SQ2224.2 +068800 GO TO INFO-WRITE-03. SQ2224.2 +068900 NO-INFO-03. SQ2224.2 +069000 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2224.2 +069100 INFO-WRITE-03. SQ2224.2 +069200 MOVE "READ SHORT RECORD" TO FEATURE. SQ2224.2 +069300 MOVE "SEQ-INFO-03 " TO PAR-NAME. SQ2224.2 +069400 PERFORM PRINT-DETAIL. SQ2224.2 +069500 INFO-END. SQ2224.2 +069600 CLOSE SQ-VS7. SQ2224.2 +069700 TERMINATE-ROUTINE. SQ2224.2 +069800 EXIT. SQ2224.2 +069900 CCVS-EXIT SECTION. SQ2224.2 +070000 CCVS-999999. SQ2224.2 +070100 GO TO CLOSE-FILES. SQ2224.2 diff --git a/tests/cobol85/SQ/SQ223A.CBL b/tests/cobol85/SQ/SQ223A.CBL new file mode 100755 index 00000000..7a1187bb --- /dev/null +++ b/tests/cobol85/SQ/SQ223A.CBL @@ -0,0 +1,711 @@ +000100 IDENTIFICATION DIVISION. SQ2234.2 +000200 PROGRAM-ID. SQ2234.2 +000300 SQ223A. SQ2234.2 +000400**************************************************************** SQ2234.2 +000500* * SQ2234.2 +000600* VALIDATION FOR:- * SQ2234.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2234.2 +000800* * SQ2234.2 +000900* CREATION DATE / VALIDATION DATE * SQ2234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2234.2 +001100* * SQ2234.2 +001200* THIS ROUTINE CHECKS: SQ2234.2 +001300* SQ2234.2 +001400* RECORD IS VARYING IN SIZE FROM 120 TO 151 CHARACTERS. SQ2234.2 +001500* SQ2234.2 +001600* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE SQ2234.2 +001700* WHICH CONTAINS BOTH 120 CHARACTER AND 151 CHARACTER SQ2234.2 +001800* RECORDS. THE MASS STORAGE FILE CONSISTS OF 1 SHORT, SQ2234.2 +001900* 1 LONG, 10 SHORT, 100 LONG, AND 338 SHORT RECORDS FOR SQ2234.2 +002000* A TOTAL OF 450 RECORDS IN THE FILE. THE MASS STORAGE SQ2234.2 +002100* FILE IS READ AND FIELDS IN THE RECORDS ARE CHECKED SQ2234.2 +002200* AGAINST THE EXPECTED VALUES. SQ2234.2 +002300* SQ2234.2 +002400* AN INFORMATION SECTION AT THE END OF THE ROUTINE SQ2234.2 +002500* CHECKS THE FIELD WHICH CONTAINS THE XRECORD-NUMBER. SQ2234.2 +002600* THIS FIELD IS PART OF A LONG RECORD ONLY. IF THE SQ2234.2 +002700* XRECORD-NUMBER IS THERE FOR A SHORT RECORD, IT MEANS SQ2234.2 +002800* THE MAXIMUM SIZE RECORD IS ALWAYS WRITTEN. SQ2234.2 +002900 ENVIRONMENT DIVISION. SQ2234.2 +003000 CONFIGURATION SECTION. SQ2234.2 +003100 SOURCE-COMPUTER. SQ2234.2 +003200 Linux. SQ2234.2 +003300 OBJECT-COMPUTER. SQ2234.2 +003400 Linux. SQ2234.2 +003500 INPUT-OUTPUT SECTION. SQ2234.2 +003600 FILE-CONTROL. SQ2234.2 +003700*P SELECT RAW-DATA ASSIGN TO SQ2234.2 +003800*P "XXXXX062" SQ2234.2 +003900*P ORGANIZATION IS INDEXED SQ2234.2 +004000*P ACCESS MODE IS RANDOM SQ2234.2 +004100*P RECORD KEY IS RAW-DATA-KEY. SQ2234.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2234.2 +004300 "report.log". SQ2234.2 +004400 SELECT SQ-VS7 ASSIGN TO SQ2234.2 +004500 "XXXXX014" SQ2234.2 +004600 ORGANIZATION SEQUENTIAL SQ2234.2 +004700 ACCESS SEQUENTIAL. SQ2234.2 +004800 DATA DIVISION. SQ2234.2 +004900 FILE SECTION. SQ2234.2 +005000*P SQ2234.2 +005100*PD RAW-DATA. SQ2234.2 +005200*P SQ2234.2 +005300*P1 RAW-DATA-SATZ. SQ2234.2 +005400*P 05 RAW-DATA-KEY PIC X(6). SQ2234.2 +005500*P 05 C-DATE PIC 9(6). SQ2234.2 +005600*P 05 C-TIME PIC 9(8). SQ2234.2 +005700*P 05 C-NO-OF-TESTS PIC 99. SQ2234.2 +005800*P 05 C-OK PIC 999. SQ2234.2 +005900*P 05 C-ALL PIC 999. SQ2234.2 +006000*P 05 C-FAIL PIC 999. SQ2234.2 +006100*P 05 C-DELETED PIC 999. SQ2234.2 +006200*P 05 C-INSPECT PIC 999. SQ2234.2 +006300*P 05 C-NOTE PIC X(13). SQ2234.2 +006400*P 05 C-INDENT PIC X. SQ2234.2 +006500*P 05 C-ABORT PIC X(8). SQ2234.2 +006600 FD PRINT-FILE SQ2234.2 +006700*C LABEL RECORDS SQ2234.2 +006800*C OMITTED SQ2234.2 +006900*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2234.2 +007000 . SQ2234.2 +007100 01 PRINT-REC PICTURE X(120). SQ2234.2 +007200 01 DUMMY-RECORD PICTURE X(120). SQ2234.2 +007300 FD SQ-VS7 SQ2234.2 +007400*C LABEL RECORDS ARE STANDARD SQ2234.2 +007500 RECORD IS VARYING IN SIZE FROM 120 TO 151 CHARACTERS. SQ2234.2 +007600 01 SQ-VS7R1-M-G-120. SQ2234.2 +007700 02 SQ-VS7R1-FIRST PICTURE X(120). SQ2234.2 +007800 01 SQ-VS7R2-M-G-151. SQ2234.2 +007900 02 SQ-VS7R2-FIRST PICTURE X(120). SQ2234.2 +008000 02 LONG-OR-SHORT PICTURE X(5). SQ2234.2 +008100 02 SQ-VS7-RECNO PICTURE X(5). SQ2234.2 +008200 02 SQ-VS7-FILLER PICTURE X(21). SQ2234.2 +008300 WORKING-STORAGE SECTION. SQ2234.2 +008400 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2234.2 +008500 01 COUNT-OF-RECS PICTURE S9(5) COMPUTATIONAL. SQ2234.2 +008600 01 RECORDS-IN-ERROR PICTURE S9(5) COMPUTATIONAL. SQ2234.2 +008700 01 ERROR-FLAG PICTURE 9. SQ2234.2 +008800 01 EOF-FLAG PICTURE 9. SQ2234.2 +008900 01 DUMP-AREA. SQ2234.2 +009000 02 TYPE-OF-REC PICTURE X(5). SQ2234.2 +009100 02 RECNO PICTURE 9(5). SQ2234.2 +009200 02 FILLER PICTURE X(21). SQ2234.2 +009300 01 FILE-RECORD-INFORMATION-REC. SQ2234.2 +009400 03 FILE-RECORD-INFO-SKELETON. SQ2234.2 +009500 05 FILLER PICTURE X(48) VALUE SQ2234.2 +009600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2234.2 +009700 05 FILLER PICTURE X(46) VALUE SQ2234.2 +009800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2234.2 +009900 05 FILLER PICTURE X(26) VALUE SQ2234.2 +010000 ",LFIL=000000,ORG= ,LBLR= ". SQ2234.2 +010100 05 FILLER PICTURE X(37) VALUE SQ2234.2 +010200 ",RECKEY= ". SQ2234.2 +010300 05 FILLER PICTURE X(38) VALUE SQ2234.2 +010400 ",ALTKEY1= ". SQ2234.2 +010500 05 FILLER PICTURE X(38) VALUE SQ2234.2 +010600 ",ALTKEY2= ". SQ2234.2 +010700 05 FILLER PICTURE X(7) VALUE SPACE.SQ2234.2 +010800 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2234.2 +010900 05 FILE-RECORD-INFO-P1-120. SQ2234.2 +011000 07 FILLER PIC X(5). SQ2234.2 +011100 07 XFILE-NAME PIC X(6). SQ2234.2 +011200 07 FILLER PIC X(8). SQ2234.2 +011300 07 XRECORD-NAME PIC X(6). SQ2234.2 +011400 07 FILLER PIC X(1). SQ2234.2 +011500 07 REELUNIT-NUMBER PIC 9(1). SQ2234.2 +011600 07 FILLER PIC X(7). SQ2234.2 +011700 07 XRECORD-NUMBER PIC 9(6). SQ2234.2 +011800 07 FILLER PIC X(6). SQ2234.2 +011900 07 UPDATE-NUMBER PIC 9(2). SQ2234.2 +012000 07 FILLER PIC X(5). SQ2234.2 +012100 07 ODO-NUMBER PIC 9(4). SQ2234.2 +012200 07 FILLER PIC X(5). SQ2234.2 +012300 07 XPROGRAM-NAME PIC X(5). SQ2234.2 +012400 07 FILLER PIC X(7). SQ2234.2 +012500 07 XRECORD-LENGTH PIC 9(6). SQ2234.2 +012600 07 FILLER PIC X(7). SQ2234.2 +012700 07 CHARS-OR-RECORDS PIC X(2). SQ2234.2 +012800 07 FILLER PIC X(1). SQ2234.2 +012900 07 XBLOCK-SIZE PIC 9(4). SQ2234.2 +013000 07 FILLER PIC X(6). SQ2234.2 +013100 07 RECORDS-IN-FILE PIC 9(6). SQ2234.2 +013200 07 FILLER PIC X(5). SQ2234.2 +013300 07 XFILE-ORGANIZATION PIC X(2). SQ2234.2 +013400 07 FILLER PIC X(6). SQ2234.2 +013500 07 XLABEL-TYPE PIC X(1). SQ2234.2 +013600 05 FILE-RECORD-INFO-P121-240. SQ2234.2 +013700 07 FILLER PIC X(8). SQ2234.2 +013800 07 XRECORD-KEY PIC X(29). SQ2234.2 +013900 07 FILLER PIC X(9). SQ2234.2 +014000 07 ALTERNATE-KEY1 PIC X(29). SQ2234.2 +014100 07 FILLER PIC X(9). SQ2234.2 +014200 07 ALTERNATE-KEY2 PIC X(29). SQ2234.2 +014300 07 FILLER PIC X(7). SQ2234.2 +014400 01 TEST-RESULTS. SQ2234.2 +014500 02 FILLER PICTURE X VALUE SPACE. SQ2234.2 +014600 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2234.2 +014700 02 FILLER PICTURE X VALUE SPACE. SQ2234.2 +014800 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2234.2 +014900 02 FILLER PICTURE X VALUE SPACE. SQ2234.2 +015000 02 PAR-NAME. SQ2234.2 +015100 03 FILLER PICTURE X(12) VALUE SPACE. SQ2234.2 +015200 03 PARDOT-X PICTURE X VALUE SPACE. SQ2234.2 +015300 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2234.2 +015400 03 FILLER PIC X(5) VALUE SPACE. SQ2234.2 +015500 02 FILLER PIC X(10) VALUE SPACE. SQ2234.2 +015600 02 RE-MARK PIC X(61). SQ2234.2 +015700 01 TEST-COMPUTED. SQ2234.2 +015800 02 FILLER PIC X(30) VALUE SPACE. SQ2234.2 +015900 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2234.2 +016000 02 COMPUTED-X. SQ2234.2 +016100 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2234.2 +016200 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2234.2 +016300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2234.2 +016400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2234.2 +016500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2234.2 +016600 03 CM-18V0 REDEFINES COMPUTED-A. SQ2234.2 +016700 04 COMPUTED-18V0 PICTURE -9(18). SQ2234.2 +016800 04 FILLER PICTURE X. SQ2234.2 +016900 03 FILLER PIC X(50) VALUE SPACE. SQ2234.2 +017000 01 TEST-CORRECT. SQ2234.2 +017100 02 FILLER PIC X(30) VALUE SPACE. SQ2234.2 +017200 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2234.2 +017300 02 CORRECT-X. SQ2234.2 +017400 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2234.2 +017500 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2234.2 +017600 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2234.2 +017700 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2234.2 +017800 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2234.2 +017900 03 CR-18V0 REDEFINES CORRECT-A. SQ2234.2 +018000 04 CORRECT-18V0 PICTURE -9(18). SQ2234.2 +018100 04 FILLER PICTURE X. SQ2234.2 +018200 03 FILLER PIC X(50) VALUE SPACE. SQ2234.2 +018300 01 CCVS-C-1. SQ2234.2 +018400 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2234.2 +018500- "SS PARAGRAPH-NAME SQ2234.2 +018600- " REMARKS". SQ2234.2 +018700 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2234.2 +018800 01 CCVS-C-2. SQ2234.2 +018900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2234.2 +019000 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2234.2 +019100 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2234.2 +019200 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2234.2 +019300 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2234.2 +019400 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2234.2 +019500 01 REC-CT PICTURE 99 VALUE ZERO. SQ2234.2 +019600 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2234.2 +019700 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2234.2 +019800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2234.2 +019900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2234.2 +020000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2234.2 +020100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2234.2 +020200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2234.2 +020300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2234.2 +020400 01 CCVS-H-1. SQ2234.2 +020500 02 FILLER PICTURE X(27) VALUE SPACE. SQ2234.2 +020600 02 FILLER PICTURE X(67) VALUE SQ2234.2 +020700 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2234.2 +020800- " SYSTEM". SQ2234.2 +020900 02 FILLER PICTURE X(26) VALUE SPACE. SQ2234.2 +021000 01 CCVS-H-2. SQ2234.2 +021100 02 FILLER PICTURE X(52) VALUE IS SQ2234.2 +021200 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2234.2 +021300 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2234.2 +021400 02 TEST-ID PICTURE IS X(9). SQ2234.2 +021500 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2234.2 +021600 01 CCVS-H-3. SQ2234.2 +021700 02 FILLER PICTURE X(34) VALUE SQ2234.2 +021800 " FOR OFFICIAL USE ONLY ". SQ2234.2 +021900 02 FILLER PICTURE X(58) VALUE SQ2234.2 +022000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2234.2 +022100 02 FILLER PICTURE X(28) VALUE SQ2234.2 +022200 " COPYRIGHT 1985 ". SQ2234.2 +022300 01 CCVS-E-1. SQ2234.2 +022400 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2234.2 +022500 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2234.2 +022600 02 ID-AGAIN PICTURE IS X(9). SQ2234.2 +022700 02 FILLER PICTURE X(45) VALUE IS SQ2234.2 +022800 " NTIS DISTRIBUTION COBOL 85". SQ2234.2 +022900 01 CCVS-E-2. SQ2234.2 +023000 02 FILLER PICTURE X(31) VALUE SQ2234.2 +023100 SPACE. SQ2234.2 +023200 02 FILLER PICTURE X(21) VALUE SPACE. SQ2234.2 +023300 02 CCVS-E-2-2. SQ2234.2 +023400 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2234.2 +023500 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2234.2 +023600 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2234.2 +023700 01 CCVS-E-3. SQ2234.2 +023800 02 FILLER PICTURE X(22) VALUE SQ2234.2 +023900 " FOR OFFICIAL USE ONLY". SQ2234.2 +024000 02 FILLER PICTURE X(12) VALUE SPACE. SQ2234.2 +024100 02 FILLER PICTURE X(58) VALUE SQ2234.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2234.2 +024300 02 FILLER PICTURE X(13) VALUE SPACE. SQ2234.2 +024400 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2234.2 +024500 01 CCVS-E-4. SQ2234.2 +024600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2234.2 +024700 02 FILLER PIC XXXX VALUE " OF ". SQ2234.2 +024800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2234.2 +024900 02 FILLER PIC X(40) VALUE SQ2234.2 +025000 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2234.2 +025100 01 XXINFO. SQ2234.2 +025200 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2234.2 +025300 02 INFO-TEXT. SQ2234.2 +025400 04 FILLER PIC X(20) VALUE SPACE. SQ2234.2 +025500 04 XXCOMPUTED PIC X(20). SQ2234.2 +025600 04 FILLER PIC X(5) VALUE SPACE. SQ2234.2 +025700 04 XXCORRECT PIC X(20). SQ2234.2 +025800 01 HYPHEN-LINE. SQ2234.2 +025900 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2234.2 +026000 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2234.2 +026100- "*****************************************". SQ2234.2 +026200 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2234.2 +026300- "******************************". SQ2234.2 +026400 01 CCVS-PGM-ID PIC X(6) VALUE SQ2234.2 +026500 "SQ223A". SQ2234.2 +026600 PROCEDURE DIVISION. SQ2234.2 +026700 CCVS1 SECTION. SQ2234.2 +026800 OPEN-FILES. SQ2234.2 +026900*P OPEN I-O RAW-DATA. SQ2234.2 +027000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2234.2 +027100*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2234.2 +027200*P MOVE "ABORTED " TO C-ABORT. SQ2234.2 +027300*P ADD 1 TO C-NO-OF-TESTS. SQ2234.2 +027400*P ACCEPT C-DATE FROM DATE. SQ2234.2 +027500*P ACCEPT C-TIME FROM TIME. SQ2234.2 +027600*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2234.2 +027700*PND-E-1. SQ2234.2 +027800*P CLOSE RAW-DATA. SQ2234.2 +027900 OPEN OUTPUT PRINT-FILE. SQ2234.2 +028000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2234.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ2234.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2234.2 +028300 MOVE ZERO TO REC-SKL-SUB. SQ2234.2 +028400 PERFORM CCVS-INIT-FILE 9 TIMES. SQ2234.2 +028500 CCVS-INIT-FILE. SQ2234.2 +028600 ADD 1 TO REC-SKL-SUB. SQ2234.2 +028700 MOVE FILE-RECORD-INFO-SKELETON TO SQ2234.2 +028800 FILE-RECORD-INFO (REC-SKL-SUB). SQ2234.2 +028900 CCVS-INIT-EXIT. SQ2234.2 +029000 GO TO CCVS1-EXIT. SQ2234.2 +029100 CLOSE-FILES. SQ2234.2 +029200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2234.2 +029300*P OPEN I-O RAW-DATA. SQ2234.2 +029400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2234.2 +029500*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2234.2 +029600*P MOVE "OK. " TO C-ABORT. SQ2234.2 +029700*P MOVE PASS-COUNTER TO C-OK. SQ2234.2 +029800*P MOVE ERROR-HOLD TO C-ALL. SQ2234.2 +029900*P MOVE ERROR-COUNTER TO C-FAIL. SQ2234.2 +030000*P MOVE DELETE-CNT TO C-DELETED. SQ2234.2 +030100*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2234.2 +030200*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2234.2 +030300*PND-E-2. SQ2234.2 +030400*P CLOSE RAW-DATA. SQ2234.2 +030500 TERMINATE-CCVS. SQ2234.2 +030600*S EXIT PROGRAM. SQ2234.2 +030700*SERMINATE-CALL. SQ2234.2 +030800 STOP RUN. SQ2234.2 +030900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2234.2 +031000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2234.2 +031100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2234.2 +031200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2234.2 +031300 MOVE "****TEST DELETED****" TO RE-MARK. SQ2234.2 +031400 PRINT-DETAIL. SQ2234.2 +031500 IF REC-CT NOT EQUAL TO ZERO SQ2234.2 +031600 MOVE "." TO PARDOT-X SQ2234.2 +031700 MOVE REC-CT TO DOTVALUE. SQ2234.2 +031800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2234.2 +031900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2234.2 +032000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2234.2 +032100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2234.2 +032200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2234.2 +032300 MOVE SPACE TO CORRECT-X. SQ2234.2 +032400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2234.2 +032500 MOVE SPACE TO RE-MARK. SQ2234.2 +032600 HEAD-ROUTINE. SQ2234.2 +032700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +032800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2234.2 +032900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2234.2 +033000 COLUMN-NAMES-ROUTINE. SQ2234.2 +033100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +033200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +033300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +033400 END-ROUTINE. SQ2234.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2234.2 +033600 END-RTN-EXIT. SQ2234.2 +033700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +033800 END-ROUTINE-1. SQ2234.2 +033900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2234.2 +034000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2234.2 +034100 ADD PASS-COUNTER TO ERROR-HOLD. SQ2234.2 +034200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2234.2 +034300 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2234.2 +034400 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2234.2 +034500 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2234.2 +034600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2234.2 +034700 END-ROUTINE-12. SQ2234.2 +034800 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2234.2 +034900 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2234.2 +035000 MOVE "NO " TO ERROR-TOTAL SQ2234.2 +035100 ELSE SQ2234.2 +035200 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2234.2 +035300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2234.2 +035400 PERFORM WRITE-LINE. SQ2234.2 +035500 END-ROUTINE-13. SQ2234.2 +035600 IF DELETE-CNT IS EQUAL TO ZERO SQ2234.2 +035700 MOVE "NO " TO ERROR-TOTAL ELSE SQ2234.2 +035800 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2234.2 +035900 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2234.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +036100 IF INSPECT-COUNTER EQUAL TO ZERO SQ2234.2 +036200 MOVE "NO " TO ERROR-TOTAL SQ2234.2 +036300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2234.2 +036400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2234.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +036600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2234.2 +036700 WRITE-LINE. SQ2234.2 +036800 ADD 1 TO RECORD-COUNT. SQ2234.2 +036900 IF RECORD-COUNT GREATER 50 SQ2234.2 +037000 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2234.2 +037100 MOVE SPACE TO DUMMY-RECORD SQ2234.2 +037200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2234.2 +037300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2234.2 +037400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2234.2 +037500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2234.2 +037600 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2234.2 +037700 MOVE ZERO TO RECORD-COUNT. SQ2234.2 +037800 PERFORM WRT-LN. SQ2234.2 +037900 WRT-LN. SQ2234.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2234.2 +038100 MOVE SPACE TO DUMMY-RECORD. SQ2234.2 +038200 BLANK-LINE-PRINT. SQ2234.2 +038300 PERFORM WRT-LN. SQ2234.2 +038400 FAIL-ROUTINE. SQ2234.2 +038500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2234.2 +038600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2234.2 +038700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2234.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +038900 GO TO FAIL-ROUTINE-EX. SQ2234.2 +039000 FAIL-ROUTINE-WRITE. SQ2234.2 +039100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2234.2 +039200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +039300 FAIL-ROUTINE-EX. EXIT. SQ2234.2 +039400 BAIL-OUT. SQ2234.2 +039500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2234.2 +039600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2234.2 +039700 BAIL-OUT-WRITE. SQ2234.2 +039800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2234.2 +039900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2234.2 +040000 BAIL-OUT-EX. EXIT. SQ2234.2 +040100 CCVS1-EXIT. SQ2234.2 +040200 EXIT. SQ2234.2 +040300 SECT-SQ223A-0001 SECTION. SQ2234.2 +040400 WRITE-INIT-GF-01. SQ2234.2 +040500 MOVE "SQ-VS7" TO XFILE-NAME (1). SQ2234.2 +040600 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2234.2 +040700 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2234.2 +040800 MOVE 0001 TO XBLOCK-SIZE (1). SQ2234.2 +040900 MOVE 000450 TO RECORDS-IN-FILE (1). SQ2234.2 +041000 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2234.2 +041100 MOVE "S" TO XLABEL-TYPE (1). SQ2234.2 +041200 MOVE 000000 TO XRECORD-NUMBER (1). SQ2234.2 +041300 MOVE ZERO TO COUNT-OF-RECS. SQ2234.2 +041400 OPEN OUTPUT SQ-VS7. SQ2234.2 +041500 MOVE "MULTIPLE LENGTH RECS" TO SQ-VS7-FILLER. SQ2234.2 +041600 WRITE-TEST-GF-01. SQ2234.2 +041700 PERFORM WRITE-SHORT-REC. SQ2234.2 +041800 PERFORM WRITE-LONG-REC. SQ2234.2 +041900 PERFORM WRITE-SHORT-REC 10 TIMES. SQ2234.2 +042000 PERFORM WRITE-LONG-REC 100 TIMES. SQ2234.2 +042100 PERFORM WRITE-SHORT-REC 338 TIMES. SQ2234.2 +042200 WRITE-WRITE-GF-01. SQ2234.2 +042300 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2234.2 +042400 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2234.2 +042500 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2234.2 +042600 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2234.2 +042700 MOVE "FILE HAS 120 AND 151 CHAR RECS" TO RE-MARK. SQ2234.2 +042800 PERFORM PRINT-DETAIL. SQ2234.2 +042900* A SEQUENTIAL MASS STORAGE FILE CONTAINING 450 SQ2234.2 +043000* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2234.2 +043100* OF 120 CHARACTERS AND RECORDS OF 151 CHARACTERS. THE SQ2234.2 +043200* SEQUENCE IN WHICH THE RECORDS WERE WRITTEN IS S-L-10S- SQ2234.2 +043300* 100L-338S. SQ2234.2 +043400 WRITE-CLOSE-GF-01. SQ2234.2 +043500 CLOSE SQ-VS7. SQ2234.2 +043600 GO TO READ-INIT-F1-01. SQ2234.2 +043700 WRITE-SHORT-REC. SQ2234.2 +043800 MOVE "R1-M-G" TO XRECORD-NAME (1). SQ2234.2 +043900 MOVE 000120 TO XRECORD-LENGTH (1). SQ2234.2 +044000 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +044100 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2234.2 +044200 MOVE "SHORT" TO LONG-OR-SHORT. SQ2234.2 +044300 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2234.2 +044400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R1-FIRST. SQ2234.2 +044500 WRITE SQ-VS7R1-M-G-120. SQ2234.2 +044600 WRITE-LONG-REC. SQ2234.2 +044700 MOVE "R2-M-G" TO XRECORD-NAME (1). SQ2234.2 +044800 MOVE 000151 TO XRECORD-LENGTH (1). SQ2234.2 +044900 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +045000 MOVE COUNT-OF-RECS TO XRECORD-NUMBER (1). SQ2234.2 +045100 MOVE "LONG" TO LONG-OR-SHORT. SQ2234.2 +045200 MOVE COUNT-OF-RECS TO SQ-VS7-RECNO. SQ2234.2 +045300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-VS7R2-FIRST. SQ2234.2 +045400 WRITE SQ-VS7R2-M-G-151. SQ2234.2 +045500 READ-INIT-F1-01. SQ2234.2 +045600 MOVE ZERO TO COUNT-OF-RECS. SQ2234.2 +045700 MOVE ZERO TO EOF-FLAG. SQ2234.2 +045800 MOVE ZERO TO RECORDS-IN-ERROR. SQ2234.2 +045900 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +046000 OPEN INPUT SQ-VS7. SQ2234.2 +046100 READ-TEST-F1-01. SQ2234.2 +046200 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT. SQ2234.2 +046300 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +046400 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2234.2 +046500 GO TO READ-EOF-F1-06. SQ2234.2 +046600 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +046700 GO TO READ-FAIL-F1-01. SQ2234.2 +046800 READ-PASS-F1-01. SQ2234.2 +046900 PERFORM PASS. SQ2234.2 +047000 GO TO READ-WRITE-F1-01. SQ2234.2 +047100 READ-FAIL-F1-01. SQ2234.2 +047200 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +047300- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +047400 PERFORM FAIL. SQ2234.2 +047500 READ-WRITE-F1-01. SQ2234.2 +047600 MOVE "READ SHORT RECORD" TO FEATURE. SQ2234.2 +047700 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2234.2 +047800 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2234.2 +047900 MOVE 120 TO CORRECT-N. SQ2234.2 +048000 PERFORM PRINT-DETAIL. SQ2234.2 +048100 GO TO READ-INIT-F1-02. SQ2234.2 +048200 READ-SHORT-REC. SQ2234.2 +048300 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +048400 GO TO READ-SHORT-REC-EXIT. SQ2234.2 +048500 READ SQ-VS7 AT END SQ2234.2 +048600 MOVE 1 TO EOF-FLAG SQ2234.2 +048700 GO TO READ-SHORT-REC-EXIT. SQ2234.2 +048800 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +048900 MOVE SQ-VS7R1-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2234.2 +049000 IF XRECORD-NAME (1) NOT EQUAL TO "R1-M-G" SQ2234.2 +049100 GO TO READ-SHORT-REC-ERROR. SQ2234.2 +049200 IF XRECORD-LENGTH (1) NOT EQUAL TO 120 SQ2234.2 +049300 GO TO READ-SHORT-REC-ERROR. SQ2234.2 +049400 IF COUNT-OF-RECS NOT EQUAL TO XRECORD-NUMBER (1) SQ2234.2 +049500 GO TO READ-SHORT-REC-ERROR. SQ2234.2 +049600 IF XLABEL-TYPE (1) EQUAL TO "S" SQ2234.2 +049700 GO TO READ-SHORT-REC-EXIT. SQ2234.2 +049800 READ-SHORT-REC-ERROR. SQ2234.2 +049900 ADD 1 TO RECORDS-IN-ERROR. SQ2234.2 +050000 MOVE 1 TO ERROR-FLAG. SQ2234.2 +050100 READ-SHORT-REC-EXIT. SQ2234.2 +050200 EXIT. SQ2234.2 +050300 READ-INIT-F1-02. SQ2234.2 +050400 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +050500 READ-TEST-F1-02. SQ2234.2 +050600 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT. SQ2234.2 +050700 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +050800 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2234.2 +050900 GO TO READ-EOF-F1-06. SQ2234.2 +051000 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +051100 GO TO READ-FAIL-F1-02. SQ2234.2 +051200 READ-PASS-F1-02. SQ2234.2 +051300 PERFORM PASS. SQ2234.2 +051400 GO TO READ-WRITE-F1-02. SQ2234.2 +051500 READ-FAIL-F1-02. SQ2234.2 +051600 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +051700- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +051800 MOVE 151 TO CORRECT-N. SQ2234.2 +051900 PERFORM FAIL. SQ2234.2 +052000 READ-WRITE-F1-02. SQ2234.2 +052100 MOVE "READ LONG RECORD" TO FEATURE. SQ2234.2 +052200 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2234.2 +052300 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2234.2 +052400 PERFORM PRINT-DETAIL. SQ2234.2 +052500 GO TO READ-INIT-F1-03. SQ2234.2 +052600 READ-LONG-REC. SQ2234.2 +052700 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +052800 GO TO READ-LONG-REC-EXIT. SQ2234.2 +052900 READ SQ-VS7 END SQ2234.2 +053000 MOVE 1 TO EOF-FLAG SQ2234.2 +053100 GO TO READ-LONG-REC-EXIT. SQ2234.2 +053200 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +053300 MOVE SQ-VS7R2-FIRST TO FILE-RECORD-INFO-P1-120 (1). SQ2234.2 +053400 IF XRECORD-NAME (1) NOT EQUAL TO "R2-M-G" SQ2234.2 +053500 GO TO READ-LONG-REC-ERROR. SQ2234.2 +053600 IF XRECORD-LENGTH (1) NOT EQUAL TO 151 SQ2234.2 +053700 GO TO READ-LONG-REC-ERROR. SQ2234.2 +053800 MOVE COUNT-OF-RECS TO SAVE-COUNT-OF-RECS. SQ2234.2 +053900 IF SAVE-COUNT-OF-RECS NOT EQUAL TO SQ-VS7-RECNO SQ2234.2 +054000 GO TO READ-LONG-REC-ERROR. SQ2234.2 +054100 IF LONG-OR-SHORT EQUAL TO "LONG " SQ2234.2 +054200 GO TO READ-LONG-REC-EXIT. SQ2234.2 +054300 READ-LONG-REC-ERROR. SQ2234.2 +054400 ADD 1 TO RECORDS-IN-ERROR. SQ2234.2 +054500 MOVE 1 TO ERROR-FLAG. SQ2234.2 +054600 READ-LONG-REC-EXIT. SQ2234.2 +054700 EXIT. SQ2234.2 +054800 READ-INIT-F1-03. SQ2234.2 +054900 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +055000 READ-TEST-F1-03. SQ2234.2 +055100 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 10 TIMES. SQ2234.2 +055200 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +055300 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2234.2 +055400 GO TO READ-EOF-F1-06. SQ2234.2 +055500 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +055600 GO TO READ-FAIL-F1-03. SQ2234.2 +055700 READ-PASS-F1-03. SQ2234.2 +055800 PERFORM PASS. SQ2234.2 +055900 GO TO READ-WRITE-F1-03. SQ2234.2 +056000 READ-FAIL-F1-03. SQ2234.2 +056100 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +056200- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +056300 MOVE 120 TO CORRECT-N. SQ2234.2 +056400 PERFORM FAIL. SQ2234.2 +056500 READ-WRITE-F1-03. SQ2234.2 +056600 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2234.2 +056700 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2234.2 +056800 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2234.2 +056900 PERFORM PRINT-DETAIL. SQ2234.2 +057000 READ-INIT-F1-04. SQ2234.2 +057100 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +057200 READ-TEST-F1-04. SQ2234.2 +057300 PERFORM READ-LONG-REC THRU READ-LONG-REC-EXIT 100 TIMES. SQ2234.2 +057400 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +057500 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2234.2 +057600 GO TO READ-EOF-F1-06. SQ2234.2 +057700 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +057800 GO TO READ-FAIL-F1-04. SQ2234.2 +057900 READ-PASS-F1-04. SQ2234.2 +058000 PERFORM PASS. SQ2234.2 +058100 GO TO READ-WRITE-F1-04. SQ2234.2 +058200 READ-FAIL-F1-04. SQ2234.2 +058300 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +058400- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +058500 MOVE 151 TO CORRECT-N. SQ2234.2 +058600 PERFORM FAIL. SQ2234.2 +058700 READ-WRITE-F1-04. SQ2234.2 +058800 MOVE "READ LONG RECORDS" TO FEATURE. SQ2234.2 +058900 MOVE "READ-TEST-F1-04" TO PAR-NAME. SQ2234.2 +059000 MOVE "EXPECTED RECORD LENGTH: 151" TO RE-MARK. SQ2234.2 +059100 PERFORM PRINT-DETAIL. SQ2234.2 +059200 READ-INIT-F1-05. SQ2234.2 +059300 MOVE ZERO TO ERROR-FLAG. SQ2234.2 +059400 READ-TEST-F1-05. SQ2234.2 +059500 PERFORM READ-SHORT-REC THRU READ-SHORT-REC-EXIT 338 TIMES. SQ2234.2 +059600 IF EOF-FLAG EQUAL TO 1 SQ2234.2 +059700 MOVE "UNEXPECTED EOF" TO RE-MARK SQ2234.2 +059800 GO TO READ-EOF-F1-06. SQ2234.2 +059900 IF ERROR-FLAG EQUAL TO 1 SQ2234.2 +060000 GO TO READ-FAIL-F1-05. SQ2234.2 +060100 READ-PASS-F1-05. SQ2234.2 +060200 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2234.2 +060300- "RECORD IS VARYING IN SIZE ..." TO RE-MARK.SQ2234.2 +060400 PERFORM PASS. SQ2234.2 +060500 GO TO READ-WRITE-F1-05. SQ2234.2 +060600 READ-FAIL-F1-05. SQ2234.2 +060700 MOVE 120 TO CORRECT-N. SQ2234.2 +060800 PERFORM FAIL. SQ2234.2 +060900 READ-WRITE-F1-05. SQ2234.2 +061000 MOVE "READ SHORT RECORDS" TO FEATURE. SQ2234.2 +061100 MOVE "READ-TEST-F1-05" TO PAR-NAME. SQ2234.2 +061200 MOVE "EXPECTED RECORD LENGTH: 120" TO RE-MARK. SQ2234.2 +061300 PERFORM PRINT-DETAIL. SQ2234.2 +061400 READ-INIT-F1-06. SQ2234.2 +061500 READ SQ-VS7 RECORD END SQ2234.2 +061600 GO TO READ-TEST-F1-06. SQ2234.2 +061700 MOVE "MORE THAN 450 RECORDS" TO RE-MARK. SQ2234.2 +061800 GO TO READ-FAIL-F1-06. SQ2234.2 +061900 READ-EOF-F1-06. SQ2234.2 +062000 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2234.2 +062100 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2234.2 +062200 GO TO READ-FAIL-F1-06. SQ2234.2 +062300 READ-TEST-F1-06. SQ2234.2 +062400 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2234.2 +062500 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2234.2 +062600 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2234.2 +062700 GO TO READ-FAIL-F1-06. SQ2234.2 +062800 READ-PASS-F1-06. SQ2234.2 +062900 PERFORM PASS. SQ2234.2 +063000 GO TO READ-WRITE-F1-06. SQ2234.2 +063100 READ-FAIL-F1-06. SQ2234.2 +063200 PERFORM FAIL. SQ2234.2 +063300 READ-WRITE-F1-06. SQ2234.2 +063400 MOVE "READ-TEST-F1-06" TO PAR-NAME. SQ2234.2 +063500 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2234.2 +063600 PERFORM PRINT-DETAIL. SQ2234.2 +063700 READ-CLOSE-F1-06. SQ2234.2 +063800 CLOSE SQ-VS7. SQ2234.2 +063900 SECT-SQ223A-0002 SECTION. SQ2234.2 +064000* THIS SECTION CHECKS IF THE ENTIRE RECORD AREA IS SQ2234.2 +064100* WRITTEN ON THE MASS STORAGE DEVICE WHEN A SHORT RECORD SQ2234.2 +064200* IS WRITTEN. THE RECORD NUMBER IN CHARACTERS 126 THROUGH SQ2234.2 +064300* 130 IS UNIQUE FOR EACH RECORD. SQ2234.2 +064400 INFO-INIT-01. SQ2234.2 +064500 OPEN INPUT SQ-VS7. SQ2234.2 +064600 MOVE ZERO TO COUNT-OF-RECS. SQ2234.2 +064700 INFO-TEST-01. SQ2234.2 +064800 READ SQ-VS7 AT END SQ2234.2 +064900 GO TO INFO-END. SQ2234.2 +065000 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +065100 IF SQ-VS7-RECNO NOT EQUAL TO "00001" SQ2234.2 +065200 GO TO NO-INFO-01. SQ2234.2 +065300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2234.2 +065400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2234.2 +065500 MOVE 0001 TO CORRECT-18V0. SQ2234.2 +065600 GO TO INFO-WRITE-01. SQ2234.2 +065700 NO-INFO-01. SQ2234.2 +065800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2234.2 +065900 INFO-WRITE-01. SQ2234.2 +066000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2234.2 +066100 MOVE "SEQ-INFO-01 " TO PAR-NAME. SQ2234.2 +066200 PERFORM PRINT-DETAIL. SQ2234.2 +066300 INFO-INIT-02. SQ2234.2 +066400 READ SQ-VS7 RECORD AT END SQ2234.2 +066500 GO TO INFO-END. SQ2234.2 +066600 READ SQ-VS7 END SQ2234.2 +066700 GO TO INFO-END. SQ2234.2 +066800 INFO-TEST-02. SQ2234.2 +066900 READ SQ-VS7 AT END SQ2234.2 +067000 GO TO INFO-END. SQ2234.2 +067100 IF SQ-VS7-RECNO NOT EQUAL TO "00004" SQ2234.2 +067200 GO TO NO-INFO-02. SQ2234.2 +067300 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2234.2 +067400 MOVE "RECORD READ =" TO COMPUTED-A. SQ2234.2 +067500 MOVE 0004 TO CORRECT-18V0. SQ2234.2 +067600 GO TO INFO-WRITE-02. SQ2234.2 +067700 NO-INFO-02. SQ2234.2 +067800 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2234.2 +067900 INFO-WRITE-02. SQ2234.2 +068000 MOVE "READ SHORT RECORD" TO FEATURE. SQ2234.2 +068100 MOVE "SEQ-INFO-02 " TO PAR-NAME. SQ2234.2 +068200 PERFORM PRINT-DETAIL. SQ2234.2 +068300 INFO-INIT-03. SQ2234.2 +068400 ADD 3 TO COUNT-OF-RECS. SQ2234.2 +068500 INFO-INIT-03-1. SQ2234.2 +068600 READ SQ-VS7 RECORD SQ2234.2 +068700 END GO TO INFO-END. SQ2234.2 +068800 ADD 1 TO COUNT-OF-RECS. SQ2234.2 +068900 IF COUNT-OF-RECS EQUAL TO 450 SQ2234.2 +069000 GO TO INFO-TEST-03. SQ2234.2 +069100 GO TO INFO-INIT-03-1. SQ2234.2 +069200 INFO-TEST-03. SQ2234.2 +069300 IF SQ-VS7-RECNO NOT EQUAL TO "00450" SQ2234.2 +069400 GO TO NO-INFO-03. SQ2234.2 +069500 MOVE "MAXIMUM RECORD SIZE WRITTEN" TO RE-MARK. SQ2234.2 +069600 MOVE "RECORD READ =" TO COMPUTED-A. SQ2234.2 +069700 MOVE 0450 TO CORRECT-18V0. SQ2234.2 +069800 GO TO INFO-WRITE-03. SQ2234.2 +069900 NO-INFO-03. SQ2234.2 +070000 MOVE "NO DEFINITE CONCLUSION POSSIBLE" TO RE-MARK. SQ2234.2 +070100 INFO-WRITE-03. SQ2234.2 +070200 MOVE "READ SHORT RECORD" TO FEATURE. SQ2234.2 +070300 MOVE "SEQ-INFO-03 " TO PAR-NAME. SQ2234.2 +070400 PERFORM PRINT-DETAIL. SQ2234.2 +070500 INFO-END. SQ2234.2 +070600 CLOSE SQ-VS7. SQ2234.2 +070700 TERMINATE-ROUTINE. SQ2234.2 +070800 EXIT. SQ2234.2 +070900 CCVS-EXIT SECTION. SQ2234.2 +071000 CCVS-999999. SQ2234.2 +071100 GO TO CLOSE-FILES. SQ2234.2 diff --git a/tests/cobol85/SQ/SQ224A.CBL b/tests/cobol85/SQ/SQ224A.CBL new file mode 100755 index 00000000..5a83cdfd --- /dev/null +++ b/tests/cobol85/SQ/SQ224A.CBL @@ -0,0 +1,571 @@ +000100 IDENTIFICATION DIVISION. SQ2244.2 +000200 PROGRAM-ID. SQ2244.2 +000300 SQ224A. SQ2244.2 +000400**************************************************************** SQ2244.2 +000500* * SQ2244.2 +000600* VALIDATION FOR:- * SQ2244.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2244.2 +000800* * SQ2244.2 +000900* CREATION DATE / VALIDATION DATE * SQ2244.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2244.2 +001100* * SQ2244.2 +001200* THIS ROUTINE CHECKS: SQ2244.2 +001300* SQ2244.2 +001400* RECORD IS VARYING IN SIZE FROM 18 TO 2048 CHARACTERS SQ2244.2 +001500* DEPENDING ON DATA-NAME-1. SQ2244.2 +001600* SQ2244.2 +001700* THE WRITE STATEMENT IS USED WITH AND WITHOUT THE INTO CLAUSE.SQ2244.2 +001800* SQ2244.2 +001900* THE READ STATEMENT IS USED WITH AND WITHOUT THE INTO CLAUSE. SQ2244.2 +002000* SQ2244.2 +002100* THIS ROUTINE BUILDS A SEQUENTIAL MASS STORAGE FILE WHICH SQ2244.2 +002200* CONTAINS 2031 RECORDS OF A LENGTH OF 18 TO 2048 CHARACTERS. SQ2244.2 +002300* THE MASS STORAGE FILE IS READ AND FIELDS IN THE RECORDS ARE SQ2244.2 +002400* CHECKED AGAINST THE EXPECTED VALUES. SQ2244.2 +002500* SQ2244.2 +002600 ENVIRONMENT DIVISION. SQ2244.2 +002700 CONFIGURATION SECTION. SQ2244.2 +002800 SOURCE-COMPUTER. SQ2244.2 +002900 Linux. SQ2244.2 +003000 OBJECT-COMPUTER. SQ2244.2 +003100 Linux. SQ2244.2 +003200 INPUT-OUTPUT SECTION. SQ2244.2 +003300 FILE-CONTROL. SQ2244.2 +003400*P SELECT RAW-DATA ASSIGN TO SQ2244.2 +003500*P "XXXXX062" SQ2244.2 +003600*P ORGANIZATION IS INDEXED SQ2244.2 +003700*P ACCESS MODE IS RANDOM SQ2244.2 +003800*P RECORD KEY IS RAW-DATA-KEY. SQ2244.2 +003900 SELECT PRINT-FILE ASSIGN TO SQ2244.2 +004000 "report.log". SQ2244.2 +004100 SELECT SQ-VS7 ASSIGN TO SQ2244.2 +004200 "XXXXX014" SQ2244.2 +004300 ORGANIZATION SEQUENTIAL SQ2244.2 +004400 ACCESS SEQUENTIAL. SQ2244.2 +004500 DATA DIVISION. SQ2244.2 +004600 FILE SECTION. SQ2244.2 +004700*PD RAW-DATA. SQ2244.2 +004800*P SQ2244.2 +004900*P1 RAW-DATA-SATZ. SQ2244.2 +005000*P 05 RAW-DATA-KEY PIC X(6). SQ2244.2 +005100*P 05 C-DATE PIC 9(6). SQ2244.2 +005200*P 05 C-TIME PIC 9(8). SQ2244.2 +005300*P 05 C-NO-OF-TESTS PIC 99. SQ2244.2 +005400*P 05 C-OK PIC 999. SQ2244.2 +005500*P 05 C-ALL PIC 999. SQ2244.2 +005600*P 05 C-FAIL PIC 999. SQ2244.2 +005700*P 05 C-DELETED PIC 999. SQ2244.2 +005800*P 05 C-INSPECT PIC 999. SQ2244.2 +005900*P 05 C-NOTE PIC X(13). SQ2244.2 +006000*P 05 C-INDENT PIC X. SQ2244.2 +006100*P 05 C-ABORT PIC X(8). SQ2244.2 +006200 FD PRINT-FILE SQ2244.2 +006300*C LABEL RECORDS SQ2244.2 +006400*C OMITTED SQ2244.2 +006500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2244.2 +006600 . SQ2244.2 +006700 01 PRINT-REC PICTURE X(120). SQ2244.2 +006800 01 DUMMY-RECORD PICTURE X(120). SQ2244.2 +006900 FD SQ-VS7 SQ2244.2 +007000*C LABEL RECORDS ARE STANDARD SQ2244.2 +007100 RECORD IS VARYING IN SIZE FROM 18 TO 2048 CHARACTERS SQ2244.2 +007200 DEPENDING ON RECORD-LENGTH. SQ2244.2 +007300 01 SQ-VSR7R1-M-G-2048. SQ2244.2 +007400 02 SQ-VS7R1-FIRST PICTURE X(2048). SQ2244.2 +007500 WORKING-STORAGE SECTION. SQ2244.2 +007600 01 RECORD-LENGTH PICTURE 9999 VALUE ZERO. SQ2244.2 +007700 01 SAVE-COUNT-OF-RECS PICTURE X(5) VALUE SPACE. SQ2244.2 +007800 01 COUNT-OF-RECS PICTURE S9(4) COMPUTATIONAL. SQ2244.2 +007900 01 RECORDS-IN-ERROR PICTURE S9(4) COMPUTATIONAL. SQ2244.2 +008000 01 ERROR-FLAG PICTURE 9. SQ2244.2 +008100 01 EOF-FLAG PICTURE 9. SQ2244.2 +008200 01 DUMP-AREA. SQ2244.2 +008300 02 TYPE-OF-REC PICTURE X(5). SQ2244.2 +008400 02 RECNO PICTURE 9(5). SQ2244.2 +008500 02 FILLER PICTURE X(21). SQ2244.2 +008600 01 VAR-RECORD-18-2048. SQ2244.2 +008700 05 FILLER PIC X(13) VALUE "SQ-VS7LENGTH=". SQ2244.2 +008800 05 RECORD-NUMBER PIC 9999 VALUE ZERO. SQ2244.2 +008900 05 FILLER PIC X(100) VALUE SQ2244.2 +009000 "........10........20........30........40........50........60SQ2244.2 +009100- "........70........80........90.......100". SQ2244.2 +009200 05 FILLER PIC X(100) VALUE SQ2244.2 +009300 ".......110.......120.......130.......140.......150.......160SQ2244.2 +009400- ".......170.......180.......190.......200". SQ2244.2 +009500 05 FILLER PIC X(100) VALUE SQ2244.2 +009600 ".......210.......220.......230.......240.......250.......260SQ2244.2 +009700- ".......270.......280.......290.......300". SQ2244.2 +009800 05 FILLER PIC X(100) VALUE SQ2244.2 +009900 ".......310.......320.......330.......340.......350.......360SQ2244.2 +010000- ".......370.......380.......390.......400". SQ2244.2 +010100 05 FILLER PIC X(100) VALUE SQ2244.2 +010200 ".......410.......420.......430.......440.......450.......460SQ2244.2 +010300- ".......470.......480.......490.......500". SQ2244.2 +010400 05 FILLER PIC X(100) VALUE SQ2244.2 +010500 ".......510.......520.......530.......540.......550.......560SQ2244.2 +010600- ".......570.......580.......590.......600". SQ2244.2 +010700 05 FILLER PIC X(100) VALUE SQ2244.2 +010800 ".......610.......620.......630.......640.......650.......660SQ2244.2 +010900- ".......670.......680.......690.......700". SQ2244.2 +011000 05 FILLER PIC X(100) VALUE SQ2244.2 +011100 ".......710.......720.......730.......740.......750.......760SQ2244.2 +011200- ".......770.......780.......790.......800". SQ2244.2 +011300 05 FILLER PIC X(100) VALUE SQ2244.2 +011400 ".......810.......820.......830.......840.......850.......860SQ2244.2 +011500- ".......870.......880.......890.......900". SQ2244.2 +011600 05 FILLER PIC X(100) VALUE SQ2244.2 +011700 ".......910.......920.......930.......940.......950.......960SQ2244.2 +011800- ".......970.......980.......990......1000". SQ2244.2 +011900 05 FILLER PIC X(100) VALUE SQ2244.2 +012000 "......1010......1020......1030......1040......1050......1060SQ2244.2 +012100- "......1070......1080......1090......1100". SQ2244.2 +012200 05 FILLER PIC X(100) VALUE SQ2244.2 +012300 "......1110......1120......1130......1140......1150......1160SQ2244.2 +012400- "......1170......1180......1190......1200". SQ2244.2 +012500 05 FILLER PIC X(100) VALUE SQ2244.2 +012600 "......1210......1220......1230......1240......1250......1260SQ2244.2 +012700- ".......270.......280.......290.......300". SQ2244.2 +012800 05 FILLER PIC X(100) VALUE SQ2244.2 +012900 "......1310......1320......1330......1340......1350......1360SQ2244.2 +013000- "......1370......1380......1390......1400". SQ2244.2 +013100 05 FILLER PIC X(100) VALUE SQ2244.2 +013200 "......1410......1420......1430......1440......1450......1460SQ2244.2 +013300- "......1470......1480......1490......1500". SQ2244.2 +013400 05 FILLER PIC X(100) VALUE SQ2244.2 +013500 "......1510......1520......1530......1540......1550......1560SQ2244.2 +013600- "......1570......1580......1590......1600". SQ2244.2 +013700 05 FILLER PIC X(100) VALUE SQ2244.2 +013800 "......1610......1620......1630......1640......1650......1660SQ2244.2 +013900- "......1670......1680......1690......1700". SQ2244.2 +014000 05 FILLER PIC X(100) VALUE SQ2244.2 +014100 "......1710......1720......1730......1740......1750......1760SQ2244.2 +014200- "......1770......1780......1790......1800". SQ2244.2 +014300 05 FILLER PIC X(100) VALUE SQ2244.2 +014400 "......1810......1820......1830......1840......1850......1860SQ2244.2 +014500- "......1870......1880......1890......1900". SQ2244.2 +014600 05 FILLER PIC X(100) VALUE SQ2244.2 +014700 "......1910......1920......1930......1940......1950......1960SQ2244.2 +014800- "......1970......1980......1990......2000". SQ2244.2 +014900 05 FILLER PIC X(048) VALUE SQ2244.2 +015000 "......2010......2020......2030......2040....,...". SQ2244.2 +015100 01 TEST-RESULTS. SQ2244.2 +015200 02 FILLER PICTURE X VALUE SPACE. SQ2244.2 +015300 02 FEATURE PICTURE X(20) VALUE SPACE. SQ2244.2 +015400 02 FILLER PICTURE X VALUE SPACE. SQ2244.2 +015500 02 P-OR-F PICTURE X(5) VALUE SPACE. SQ2244.2 +015600 02 FILLER PICTURE X VALUE SPACE. SQ2244.2 +015700 02 PAR-NAME. SQ2244.2 +015800 03 FILLER PICTURE X(12) VALUE SPACE. SQ2244.2 +015900 03 PARDOT-X PICTURE X VALUE SPACE. SQ2244.2 +016000 03 DOTVALUE PICTURE 99 VALUE ZERO. SQ2244.2 +016100 03 FILLER PIC X(5) VALUE SPACE. SQ2244.2 +016200 02 FILLER PIC X(10) VALUE SPACE. SQ2244.2 +016300 02 RE-MARK PIC X(61). SQ2244.2 +016400 01 TEST-COMPUTED. SQ2244.2 +016500 02 FILLER PIC X(30) VALUE SPACE. SQ2244.2 +016600 02 FILLER PIC X(17) VALUE " COMPUTED=". SQ2244.2 +016700 02 COMPUTED-X. SQ2244.2 +016800 03 COMPUTED-A PICTURE X(20) VALUE SPACE. SQ2244.2 +016900 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). SQ2244.2 +017000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). SQ2244.2 +017100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). SQ2244.2 +017200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). SQ2244.2 +017300 03 CM-18V0 REDEFINES COMPUTED-A. SQ2244.2 +017400 04 COMPUTED-18V0 PICTURE -9(18). SQ2244.2 +017500 04 FILLER PICTURE X. SQ2244.2 +017600 03 FILLER PIC X(50) VALUE SPACE. SQ2244.2 +017700 01 TEST-CORRECT. SQ2244.2 +017800 02 FILLER PIC X(30) VALUE SPACE. SQ2244.2 +017900 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2244.2 +018000 02 CORRECT-X. SQ2244.2 +018100 03 CORRECT-A PICTURE X(20) VALUE SPACE. SQ2244.2 +018200 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). SQ2244.2 +018300 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). SQ2244.2 +018400 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). SQ2244.2 +018500 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). SQ2244.2 +018600 03 CR-18V0 REDEFINES CORRECT-A. SQ2244.2 +018700 04 CORRECT-18V0 PICTURE -9(18). SQ2244.2 +018800 04 FILLER PICTURE X. SQ2244.2 +018900 03 FILLER PIC X(50) VALUE SPACE. SQ2244.2 +019000 01 CCVS-C-1. SQ2244.2 +019100 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PASQ2244.2 +019200- "SS PARAGRAPH-NAME SQ2244.2 +019300- " REMARKS". SQ2244.2 +019400 02 FILLER PICTURE IS X(20) VALUE IS SPACE. SQ2244.2 +019500 01 CCVS-C-2. SQ2244.2 +019600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2244.2 +019700 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". SQ2244.2 +019800 02 FILLER PICTURE IS X(15) VALUE IS SPACE. SQ2244.2 +019900 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". SQ2244.2 +020000 02 FILLER PICTURE IS X(94) VALUE IS SPACE. SQ2244.2 +020100 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. SQ2244.2 +020200 01 REC-CT PICTURE 99 VALUE ZERO. SQ2244.2 +020300 01 DELETE-CNT PICTURE 999 VALUE ZERO. SQ2244.2 +020400 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. SQ2244.2 +020500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2244.2 +020600 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2244.2 +020700 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2244.2 +020800 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2244.2 +020900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2244.2 +021000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2244.2 +021100 01 CCVS-H-1. SQ2244.2 +021200 02 FILLER PICTURE X(27) VALUE SPACE. SQ2244.2 +021300 02 FILLER PICTURE X(67) VALUE SQ2244.2 +021400 " FEDERAL SOFTWARE TESTING CENTER COBOL COMPILER VALIDATION SQ2244.2 +021500- " SYSTEM". SQ2244.2 +021600 02 FILLER PICTURE X(26) VALUE SPACE. SQ2244.2 +021700 01 CCVS-H-2. SQ2244.2 +021800 02 FILLER PICTURE X(52) VALUE IS SQ2244.2 +021900 "CCVS85 FSTC COPY, NOT FOR DISTRIBUTION.". SQ2244.2 +022000 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". SQ2244.2 +022100 02 TEST-ID PICTURE IS X(9). SQ2244.2 +022200 02 FILLER PICTURE IS X(40) VALUE IS SPACE. SQ2244.2 +022300 01 CCVS-H-3. SQ2244.2 +022400 02 FILLER PICTURE X(34) VALUE SQ2244.2 +022500 " FOR OFFICIAL USE ONLY ". SQ2244.2 +022600 02 FILLER PICTURE X(58) VALUE SQ2244.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2244.2 +022800 02 FILLER PICTURE X(28) VALUE SQ2244.2 +022900 " COPYRIGHT 1985 ". SQ2244.2 +023000 01 CCVS-E-1. SQ2244.2 +023100 02 FILLER PICTURE IS X(52) VALUE IS SPACE. SQ2244.2 +023200 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". SQ2244.2 +023300 02 ID-AGAIN PICTURE IS X(9). SQ2244.2 +023400 02 FILLER PICTURE X(45) VALUE IS SQ2244.2 +023500 " NTIS DISTRIBUTION COBOL 85". SQ2244.2 +023600 01 CCVS-E-2. SQ2244.2 +023700 02 FILLER PICTURE X(31) VALUE SQ2244.2 +023800 SPACE. SQ2244.2 +023900 02 FILLER PICTURE X(21) VALUE SPACE. SQ2244.2 +024000 02 CCVS-E-2-2. SQ2244.2 +024100 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. SQ2244.2 +024200 03 FILLER PICTURE IS X VALUE IS SPACE. SQ2244.2 +024300 03 ENDER-DESC PIC X(46) VALUE "ERRORS ENCOUNTERED". SQ2244.2 +024400 01 CCVS-E-3. SQ2244.2 +024500 02 FILLER PICTURE X(22) VALUE SQ2244.2 +024600 " FOR OFFICIAL USE ONLY". SQ2244.2 +024700 02 FILLER PICTURE X(12) VALUE SPACE. SQ2244.2 +024800 02 FILLER PICTURE X(58) VALUE SQ2244.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2244.2 +025000 02 FILLER PICTURE X(13) VALUE SPACE. SQ2244.2 +025100 02 FILLER PIC X(15) VALUE " COPYRIGHT 1985". SQ2244.2 +025200 01 CCVS-E-4. SQ2244.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2244.2 +025400 02 FILLER PIC XXXX VALUE " OF ". SQ2244.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2244.2 +025600 02 FILLER PIC X(40) VALUE SQ2244.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2244.2 +025800 01 XXINFO. SQ2244.2 +025900 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". SQ2244.2 +026000 02 INFO-TEXT. SQ2244.2 +026100 04 FILLER PIC X(20) VALUE SPACE. SQ2244.2 +026200 04 XXCOMPUTED PIC X(20). SQ2244.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ2244.2 +026400 04 XXCORRECT PIC X(20). SQ2244.2 +026500 01 HYPHEN-LINE. SQ2244.2 +026600 02 FILLER PICTURE IS X VALUE IS SPACE. SQ2244.2 +026700 02 FILLER PICTURE IS X(65) VALUE IS "************************SQ2244.2 +026800- "*****************************************". SQ2244.2 +026900 02 FILLER PICTURE IS X(54) VALUE IS "************************SQ2244.2 +027000- "******************************". SQ2244.2 +027100 01 CCVS-PGM-ID PIC X(6) VALUE SQ2244.2 +027200 "SQ224A". SQ2244.2 +027300 PROCEDURE DIVISION. SQ2244.2 +027400 CCVS1 SECTION. SQ2244.2 +027500 OPEN-FILES. SQ2244.2 +027600*P OPEN I-O RAW-DATA. SQ2244.2 +027700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2244.2 +027800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2244.2 +027900*P MOVE "ABORTED " TO C-ABORT. SQ2244.2 +028000*P ADD 1 TO C-NO-OF-TESTS. SQ2244.2 +028100*P ACCEPT C-DATE FROM DATE. SQ2244.2 +028200*P ACCEPT C-TIME FROM TIME. SQ2244.2 +028300*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-1. SQ2244.2 +028400*PND-E-1. SQ2244.2 +028500*P CLOSE RAW-DATA. SQ2244.2 +028600 OPEN OUTPUT PRINT-FILE. SQ2244.2 +028700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2244.2 +028800 MOVE SPACE TO TEST-RESULTS. SQ2244.2 +028900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2244.2 +029000 MOVE ZERO TO REC-SKL-SUB. SQ2244.2 +029100 CCVS-INIT-EXIT. SQ2244.2 +029200 GO TO CCVS1-EXIT. SQ2244.2 +029300 CLOSE-FILES. SQ2244.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. SQ2244.2 +029500*P OPEN I-O RAW-DATA. SQ2244.2 +029600*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2244.2 +029700*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2244.2 +029800*P MOVE "OK. " TO C-ABORT. SQ2244.2 +029900*P MOVE PASS-COUNTER TO C-OK. SQ2244.2 +030000*P MOVE ERROR-HOLD TO C-ALL. SQ2244.2 +030100*P MOVE ERROR-COUNTER TO C-FAIL. SQ2244.2 +030200*P MOVE DELETE-CNT TO C-DELETED. SQ2244.2 +030300*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2244.2 +030400*P REWRITE RAW-DATA-SATZ INVALID KEY GO TO END-E-2. SQ2244.2 +030500*PND-E-2. SQ2244.2 +030600*P CLOSE RAW-DATA. SQ2244.2 +030700 TERMINATE-CCVS. SQ2244.2 +030800*S EXIT PROGRAM. SQ2244.2 +030900*SERMINATE-CALL. SQ2244.2 +031000 STOP RUN. SQ2244.2 +031100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. SQ2244.2 +031200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. SQ2244.2 +031300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. SQ2244.2 +031400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. SQ2244.2 +031500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2244.2 +031600 PRINT-DETAIL. SQ2244.2 +031700 IF REC-CT NOT EQUAL TO ZERO SQ2244.2 +031800 MOVE "." TO PARDOT-X SQ2244.2 +031900 MOVE REC-CT TO DOTVALUE. SQ2244.2 +032000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. SQ2244.2 +032100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE SQ2244.2 +032200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2244.2 +032300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2244.2 +032400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. SQ2244.2 +032500 MOVE SPACE TO CORRECT-X. SQ2244.2 +032600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2244.2 +032700 MOVE SPACE TO RE-MARK. SQ2244.2 +032800 HEAD-ROUTINE. SQ2244.2 +032900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +033000 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. SQ2244.2 +033100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2244.2 +033200 COLUMN-NAMES-ROUTINE. SQ2244.2 +033300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +033400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +033500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +033600 END-ROUTINE. SQ2244.2 +033700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.SQ2244.2 +033800 END-RTN-EXIT. SQ2244.2 +033900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +034000 END-ROUTINE-1. SQ2244.2 +034100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO SQ2244.2 +034200 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. SQ2244.2 +034300 ADD PASS-COUNTER TO ERROR-HOLD. SQ2244.2 +034400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. SQ2244.2 +034500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2244.2 +034600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2244.2 +034700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2244.2 +034800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. SQ2244.2 +034900 END-ROUTINE-12. SQ2244.2 +035000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2244.2 +035100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2244.2 +035200 MOVE "NO " TO ERROR-TOTAL SQ2244.2 +035300 ELSE SQ2244.2 +035400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2244.2 +035500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2244.2 +035600 PERFORM WRITE-LINE. SQ2244.2 +035700 END-ROUTINE-13. SQ2244.2 +035800 IF DELETE-CNT IS EQUAL TO ZERO SQ2244.2 +035900 MOVE "NO " TO ERROR-TOTAL ELSE SQ2244.2 +036000 MOVE DELETE-CNT TO ERROR-TOTAL. SQ2244.2 +036100 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2244.2 +036200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +036300 IF INSPECT-COUNTER EQUAL TO ZERO SQ2244.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2244.2 +036500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2244.2 +036600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2244.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +036800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2244.2 +036900 WRITE-LINE. SQ2244.2 +037000 ADD 1 TO RECORD-COUNT. SQ2244.2 +037100 IF RECORD-COUNT GREATER 50 SQ2244.2 +037200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2244.2 +037300 MOVE SPACE TO DUMMY-RECORD SQ2244.2 +037400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2244.2 +037500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2244.2 +037600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2244.2 +037700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2244.2 +037800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2244.2 +037900 MOVE ZERO TO RECORD-COUNT. SQ2244.2 +038000 PERFORM WRT-LN. SQ2244.2 +038100 WRT-LN. SQ2244.2 +038200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2244.2 +038300 MOVE SPACE TO DUMMY-RECORD. SQ2244.2 +038400 BLANK-LINE-PRINT. SQ2244.2 +038500 PERFORM WRT-LN. SQ2244.2 +038600 FAIL-ROUTINE. SQ2244.2 +038700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2244.2 +038800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2244.2 +038900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2244.2 +039000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +039100 GO TO FAIL-ROUTINE-EX. SQ2244.2 +039200 FAIL-ROUTINE-WRITE. SQ2244.2 +039300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE SQ2244.2 +039400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +039500 FAIL-ROUTINE-EX. EXIT. SQ2244.2 +039600 BAIL-OUT. SQ2244.2 +039700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2244.2 +039800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2244.2 +039900 BAIL-OUT-WRITE. SQ2244.2 +040000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. SQ2244.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2244.2 +040200 BAIL-OUT-EX. EXIT. SQ2244.2 +040300 CCVS1-EXIT. SQ2244.2 +040400 EXIT. SQ2244.2 +040500 SECT-SQ224A-0001 SECTION. SQ2244.2 +040600 WRITE-INIT-GF-01. SQ2244.2 +040700 MOVE ZERO TO COUNT-OF-RECS. SQ2244.2 +040800 MOVE 17 TO RECORD-LENGTH. SQ2244.2 +040900 OPEN OUTPUT SQ-VS7. SQ2244.2 +041000 WRITE-TEST-GF-01. SQ2244.2 +041100 PERFORM WRITE-RECORDS-1 1030 TIMES. SQ2244.2 +041200 PERFORM WRITE-RECORDS-2 1001 TIMES. SQ2244.2 +041300 WRITE-WRITE-GF-01. SQ2244.2 +041400 MOVE "CREATE FILE SQ-VS7" TO FEATURE. SQ2244.2 +041500 MOVE "WRITE-TEST-GF-01" TO PAR-NAME. SQ2244.2 +041600 MOVE "FILE CREATED, RECS =" TO COMPUTED-A. SQ2244.2 +041700 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2244.2 +041800 MOVE "FILE HAS 18 THRU 2048 CHAR RECS" TO RE-MARK. SQ2244.2 +041900 PERFORM PRINT-DETAIL. SQ2244.2 +042000* A SEQUENTIAL MASS STORAGE FILE CONTAINING 2031 SQ2244.2 +042100* RECORDS HAS BEEN CREATED. THE FILE CONTAINS RECORDS SQ2244.2 +042200* OF 18 THROUGH 2048 CHARACTERS BEGINNING WITH THE 18 CHAR RECSQ2244.2 +042300* AND ENDING WITH THE 2048 CHAR REC. SQ2244.2 +042400* SQ2244.2 +042500 WRITE-CLOSE-GF-01. SQ2244.2 +042600 CLOSE SQ-VS7. SQ2244.2 +042700 GO TO READ-INIT-F1-01. SQ2244.2 +042800 WRITE-RECORDS-1. SQ2244.2 +042900******************************************************************SQ2244.2 +043000* MOVE ... TO OUTPUT-RECORD 1030 RECORDS *SQ2244.2 +043100* WRITE OUTPUT-RECORD. *SQ2244.2 +043200******************************************************************SQ2244.2 +043300 ADD 1 TO COUNT-OF-RECS. SQ2244.2 +043400 ADD 1 TO RECORD-LENGTH. SQ2244.2 +043500 MOVE COUNT-OF-RECS TO RECORD-NUMBER. SQ2244.2 +043600 MOVE VAR-RECORD-18-2048 TO SQ-VS7R1-FIRST. SQ2244.2 +043700 WRITE SQ-VSR7R1-M-G-2048. SQ2244.2 +043800 WRITE-RECORDS-2. SQ2244.2 +043900******************************************************************SQ2244.2 +044000*WRITE ... FROM .... . 1001 RECORDS *SQ2244.2 +044100******************************************************************SQ2244.2 +044200 ADD 1 TO COUNT-OF-RECS. SQ2244.2 +044300 ADD 1 TO RECORD-LENGTH. SQ2244.2 +044400 MOVE COUNT-OF-RECS TO RECORD-NUMBER. SQ2244.2 +044500 WRITE SQ-VSR7R1-M-G-2048 FROM VAR-RECORD-18-2048. SQ2244.2 +044600 READ-INIT-F1-01. SQ2244.2 +044700 MOVE 17 TO RECORD-LENGTH. SQ2244.2 +044800 MOVE ZERO TO COUNT-OF-RECS. SQ2244.2 +044900 MOVE ZERO TO EOF-FLAG. SQ2244.2 +045000 MOVE ZERO TO RECORDS-IN-ERROR. SQ2244.2 +045100 MOVE ZERO TO ERROR-FLAG. SQ2244.2 +045200 OPEN INPUT SQ-VS7. SQ2244.2 +045300 READ-TEST-F1-01. SQ2244.2 +045400 PERFORM READ-REC-1 THRU READ-REC-1-EXIT 1030 TIMES. SQ2244.2 +045500 IF EOF-FLAG EQUAL TO 1 SQ2244.2 +045600 MOVE "EOF ON FIRST READ" TO RE-MARK SQ2244.2 +045700 GO TO READ-EOF-F1-03. SQ2244.2 +045800 IF ERROR-FLAG EQUAL TO 1 SQ2244.2 +045900 GO TO READ-FAIL-F1-01. SQ2244.2 +046000 READ-PASS-F1-01. SQ2244.2 +046100 PERFORM PASS. SQ2244.2 +046200 GO TO READ-WRITE-F1-01. SQ2244.2 +046300 READ-FAIL-F1-01. SQ2244.2 +046400 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2244.2 +046500- "RECORD VARYING . DEPENDING " TO RE-MARK. SQ2244.2 +046600 PERFORM FAIL. SQ2244.2 +046700 READ-WRITE-F1-01. SQ2244.2 +046800 MOVE "READ 1030 RECORDS" TO FEATURE. SQ2244.2 +046900 MOVE "READ-TEST-F1-01" TO PAR-NAME. SQ2244.2 +047000 MOVE "EXPECTED RECORD LENGTH: 18 TO 1047" TO RE-MARK. SQ2244.2 +047100 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2244.2 +047200 ADD 17 TO COUNT-OF-RECS. SQ2244.2 +047300 MOVE COUNT-OF-RECS TO CORRECT-N. SQ2244.2 +047400 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +047500 PERFORM PRINT-DETAIL. SQ2244.2 +047600 GO TO READ-INIT-F1-02. SQ2244.2 +047700 READ-REC-1. SQ2244.2 +047800******************************************************************SQ2244.2 +047900* READ AT END ... *SQ2244.2 +048000******************************************************************SQ2244.2 +048100 IF EOF-FLAG EQUAL TO 1 SQ2244.2 +048200 GO TO READ-REC-1-EXIT. SQ2244.2 +048300 READ SQ-VS7 AT END SQ2244.2 +048400 MOVE 1 TO EOF-FLAG SQ2244.2 +048500 GO TO READ-REC-1-EXIT. SQ2244.2 +048600 ADD 1 TO COUNT-OF-RECS. SQ2244.2 +048700 MOVE SQ-VS7R1-FIRST TO VAR-RECORD-18-2048. SQ2244.2 +048800 ADD 17 TO COUNT-OF-RECS. SQ2244.2 +048900 IF RECORD-LENGTH NOT EQUAL TO COUNT-OF-RECS SQ2244.2 +049000 GO TO READ-REC-1-ERROR. SQ2244.2 +049100 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +049200 GO TO READ-REC-1-EXIT. SQ2244.2 +049300 READ-REC-1-ERROR. SQ2244.2 +049400 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +049500 ADD 1 TO RECORDS-IN-ERROR. SQ2244.2 +049600 MOVE 1 TO ERROR-FLAG. SQ2244.2 +049700 READ-REC-1-EXIT. SQ2244.2 +049800 EXIT. SQ2244.2 +049900 READ-REC-2. SQ2244.2 +050000******************************************************************SQ2244.2 +050100* READ INTO .... AT END *SQ2244.2 +050200******************************************************************SQ2244.2 +050300 READ SQ-VS7 INTO VAR-RECORD-18-2048 AT END SQ2244.2 +050400 MOVE 1 TO EOF-FLAG SQ2244.2 +050500 GO TO READ-REC-2-EXIT. SQ2244.2 +050600 ADD 1 TO COUNT-OF-RECS. SQ2244.2 +050700 ADD 17 TO COUNT-OF-RECS. SQ2244.2 +050800 IF RECORD-LENGTH NOT EQUAL TO COUNT-OF-RECS SQ2244.2 +050900 GO TO READ-REC-2-ERROR. SQ2244.2 +051000 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +051100 GO TO READ-REC-2-EXIT. SQ2244.2 +051200 READ-REC-2-ERROR. SQ2244.2 +051300 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +051400 MOVE 1 TO ERROR-FLAG. SQ2244.2 +051500 READ-REC-2-EXIT. SQ2244.2 +051600 EXIT. SQ2244.2 +051700 READ-INIT-F1-02. SQ2244.2 +051800 MOVE ZERO TO ERROR-FLAG. SQ2244.2 +051900 READ-TEST-F1-02. SQ2244.2 +052000 PERFORM READ-REC-2 THRU READ-REC-2-EXIT 1001 TIMES. SQ2244.2 +052100 IF EOF-FLAG EQUAL TO 1 SQ2244.2 +052200 MOVE "EOF ON SECOND READ" TO RE-MARK SQ2244.2 +052300 GO TO READ-EOF-F1-03. SQ2244.2 +052400 IF ERROR-FLAG EQUAL TO 1 SQ2244.2 +052500 GO TO READ-FAIL-F1-02. SQ2244.2 +052600 READ-PASS-F1-02. SQ2244.2 +052700 PERFORM PASS. SQ2244.2 +052800 GO TO READ-WRITE-F1-02. SQ2244.2 +052900 READ-FAIL-F1-02. SQ2244.2 +053000 MOVE "ERROR:SEE VII-52 WRITE OR VII-44 READ; VII-30 FORMAT SQ2244.2 +053100- "RECORD VARYING . DEPENDING " TO RE-MARK. SQ2244.2 +053200 MOVE RECORD-LENGTH TO COMPUTED-N. SQ2244.2 +053300 ADD 17 TO COUNT-OF-RECS. SQ2244.2 +053400 MOVE COUNT-OF-RECS TO CORRECT-N. SQ2244.2 +053500 SUBTRACT 17 FROM COUNT-OF-RECS. SQ2244.2 +053600 PERFORM FAIL. SQ2244.2 +053700 READ-WRITE-F1-02. SQ2244.2 +053800 MOVE "READ 1000 RECORD" TO FEATURE. SQ2244.2 +053900 MOVE "READ-TEST-F1-02" TO PAR-NAME. SQ2244.2 +054000 MOVE "EXPECTED RECORD LENGTH: 1049 TO 2048" TO RE-MARK. SQ2244.2 +054100 PERFORM PRINT-DETAIL. SQ2244.2 +054200 READ-INIT-F1-03. SQ2244.2 +054300 READ SQ-VS7 RECORD END SQ2244.2 +054400 GO TO READ-TEST-F1-03. SQ2244.2 +054500 MOVE "MORE THAN 2031 RECORDS" TO RE-MARK. SQ2244.2 +054600 GO TO READ-FAIL-F1-03. SQ2244.2 +054700 READ-EOF-F1-03. SQ2244.2 +054800 MOVE "RECORDS READ =" TO COMPUTED-A. SQ2244.2 +054900 MOVE COUNT-OF-RECS TO CORRECT-18V0. SQ2244.2 +055000 GO TO READ-FAIL-F1-03. SQ2244.2 +055100 READ-TEST-F1-03. SQ2244.2 +055200 IF RECORDS-IN-ERROR NOT EQUAL TO ZERO SQ2244.2 +055300 MOVE "RECORDS IN ERROR =" TO COMPUTED-A SQ2244.2 +055400 MOVE RECORDS-IN-ERROR TO CORRECT-18V0 SQ2244.2 +055500 GO TO READ-FAIL-F1-03. SQ2244.2 +055600 READ-PASS-F1-03. SQ2244.2 +055700 PERFORM PASS. SQ2244.2 +055800 GO TO READ-WRITE-F1-03. SQ2244.2 +055900 READ-FAIL-F1-03. SQ2244.2 +056000 PERFORM FAIL. SQ2244.2 +056100 READ-WRITE-F1-03. SQ2244.2 +056200 MOVE "READ-TEST-F1-03" TO PAR-NAME. SQ2244.2 +056300 MOVE "VERIFY FILE SQ-VS7" TO FEATURE. SQ2244.2 +056400 PERFORM PRINT-DETAIL. SQ2244.2 +056500 READ-CLOSE-F1-03. SQ2244.2 +056600 CLOSE SQ-VS7. SQ2244.2 +056700 TERMINATE-ROUTINE. SQ2244.2 +056800 EXIT. SQ2244.2 +056900 CCVS-EXIT SECTION. SQ2244.2 +057000 CCVS-999999. SQ2244.2 +057100 GO TO CLOSE-FILES. SQ2244.2 diff --git a/tests/cobol85/SQ/SQ225A.CBL b/tests/cobol85/SQ/SQ225A.CBL new file mode 100755 index 00000000..dbac1528 --- /dev/null +++ b/tests/cobol85/SQ/SQ225A.CBL @@ -0,0 +1,652 @@ +000100 IDENTIFICATION DIVISION. SQ2254.2 +000200 PROGRAM-ID. SQ2254.2 +000300 SQ225A. SQ2254.2 +000400**************************************************************** SQ2254.2 +000500* * SQ2254.2 +000600* VALIDATION FOR:- * SQ2254.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2254.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2254.2 +000900* REVISED 1986, AUGUST * SQ2254.2 +001000* * SQ2254.2 +001100* CREATION DATE / VALIDATION DATE * SQ2254.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2254.2 +001300* * SQ2254.2 +001400**************************************************************** SQ2254.2 +001500* * SQ2254.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2254.2 +001700* * SQ2254.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ2254.2 +001900* X-55 SYSTEM PRINTER * SQ2254.2 +002000* X-82 SOURCE-COMPUTER * SQ2254.2 +002100* X-83 OBJECT-COMPUTER. * SQ2254.2 +002200* * SQ2254.2 +002300* * SQ2254.2 +002400**************************************************************** SQ2254.2 +002500* * SQ2254.2 +002600* SQ225A ATTEMPTS TO OPEN FOR EXTEND A MASS STORAGE FILE * SQ2254.2 +002700* WHICH IS NOT PRESENT. THIS SHOULD RESULT IN A PERMANENT * SQ2254.2 +002800* ERROR AND AN I-O STATUS OF "35". THE PROGRAM CONTAINS AN * SQ2254.2 +002900* APPLICABLE DECLARATIVE PROCEDURE, WHICH SHOULD BE * SQ2254.2 +003000* EXECUTED. THE STANDARD ALLOWS THE IMPLEMENTOR TO * SQ2254.2 +003100* TERMINATE EXECUTION ON EXIT FROM THE DECLARATIVE, OR TO * SQ2254.2 +003200* CONTINUE EXECUTION IN THE MAIN PROGRAM. * SQ2254.2 +003300* * SQ2254.2 +003400**************************************************************** SQ2254.2 +003500* SQ2254.2 +003600 ENVIRONMENT DIVISION. SQ2254.2 +003700 CONFIGURATION SECTION. SQ2254.2 +003800 SOURCE-COMPUTER. SQ2254.2 +003900 Linux. SQ2254.2 +004000 OBJECT-COMPUTER. SQ2254.2 +004100 Linux. SQ2254.2 +004200* SQ2254.2 +004300 INPUT-OUTPUT SECTION. SQ2254.2 +004400 FILE-CONTROL. SQ2254.2 +004500 SELECT PRINT-FILE ASSIGN TO SQ2254.2 +004600 "report.log". SQ2254.2 +004700* SQ2254.2 +004800*P SELECT RAW-DATA ASSIGN TO SQ2254.2 +004900*P "XXXXX062" SQ2254.2 +005000*P ORGANIZATION IS INDEXED SQ2254.2 +005100*P ACCESS MODE IS RANDOM SQ2254.2 +005200*P RECORD-KEY IS RAW-DATA-KEY. SQ2254.2 +005300*P SQ2254.2 +005400 SELECT SQ-FS1 ASSIGN TO SQ2254.2 +005500 "XXXXX014" SQ2254.2 +005600 FILE STATUS IS SQ-FS1-STATUS. SQ2254.2 +005700* SQ2254.2 +005800* SQ2254.2 +005900 DATA DIVISION. SQ2254.2 +006000 FILE SECTION. SQ2254.2 +006100 FD PRINT-FILE SQ2254.2 +006200*C LABEL RECORDS SQ2254.2 +006300*C OMITTED SQ2254.2 +006400*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2254.2 +006500 . SQ2254.2 +006600 01 PRINT-REC PICTURE X(120). SQ2254.2 +006700 01 DUMMY-RECORD PICTURE X(120). SQ2254.2 +006800*P SQ2254.2 +006900*PD RAW-DATA. SQ2254.2 +007000*P1 RAW-DATA-SATZ. SQ2254.2 +007100*P 05 RAW-DATA-KEY PIC X(6). SQ2254.2 +007200*P 05 C-DATE PIC 9(6). SQ2254.2 +007300*P 05 C-TIME PIC 9(8). SQ2254.2 +007400*P 05 NO-OF-TESTS PIC 99. SQ2254.2 +007500*P 05 C-OK PIC 999. SQ2254.2 +007600*P 05 C-ALL PIC 999. SQ2254.2 +007700*P 05 C-FAIL PIC 999. SQ2254.2 +007800*P 05 C-DELETED PIC 999. SQ2254.2 +007900*P 05 C-INSPECT PIC 999. SQ2254.2 +008000*P 05 C-NOTE PIC X(13). SQ2254.2 +008100*P 05 C-INDENT PIC X. SQ2254.2 +008200*P 05 C-ABORT PIC X(8). SQ2254.2 +008300* SQ2254.2 +008400 FD SQ-FS1 SQ2254.2 +008500*C LABEL RECORD IS STANDARD SQ2254.2 +008600 . SQ2254.2 +008700 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2254.2 +008800* SQ2254.2 +008900 WORKING-STORAGE SECTION. SQ2254.2 +009000* SQ2254.2 +009100*************************************************************** SQ2254.2 +009200* * SQ2254.2 +009300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2254.2 +009400* * SQ2254.2 +009500*************************************************************** SQ2254.2 +009600* SQ2254.2 +009700 01 SQ-FS1-STATUS. SQ2254.2 +009800 03 SQ-FS1-KEY-1 PIC X. SQ2254.2 +009900 03 SQ-FS1-KEY-2 PIC X. SQ2254.2 +010000* SQ2254.2 +010100 01 DECL-EXEC-SW PIC 9. SQ2254.2 +010200* SQ2254.2 +010300*************************************************************** SQ2254.2 +010400* * SQ2254.2 +010500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2254.2 +010600* * SQ2254.2 +010700*************************************************************** SQ2254.2 +010800* SQ2254.2 +010900 01 REC-SKEL-SUB PIC 99. SQ2254.2 +011000* SQ2254.2 +011100 01 FILE-RECORD-INFORMATION-REC. SQ2254.2 +011200 03 FILE-RECORD-INFO-SKELETON. SQ2254.2 +011300 05 FILLER PICTURE X(48) VALUE SQ2254.2 +011400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2254.2 +011500 05 FILLER PICTURE X(46) VALUE SQ2254.2 +011600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2254.2 +011700 05 FILLER PICTURE X(26) VALUE SQ2254.2 +011800 ",LFIL=000000,ORG= ,LBLR= ". SQ2254.2 +011900 05 FILLER PICTURE X(37) VALUE SQ2254.2 +012000 ",RECKEY= ". SQ2254.2 +012100 05 FILLER PICTURE X(38) VALUE SQ2254.2 +012200 ",ALTKEY1= ". SQ2254.2 +012300 05 FILLER PICTURE X(38) VALUE SQ2254.2 +012400 ",ALTKEY2= ". SQ2254.2 +012500 05 FILLER PICTURE X(7) VALUE SPACE.SQ2254.2 +012600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2254.2 +012700 05 FILE-RECORD-INFO-P1-120. SQ2254.2 +012800 07 FILLER PIC X(5). SQ2254.2 +012900 07 XFILE-NAME PIC X(6). SQ2254.2 +013000 07 FILLER PIC X(8). SQ2254.2 +013100 07 XRECORD-NAME PIC X(6). SQ2254.2 +013200 07 FILLER PIC X(1). SQ2254.2 +013300 07 REELUNIT-NUMBER PIC 9(1). SQ2254.2 +013400 07 FILLER PIC X(7). SQ2254.2 +013500 07 XRECORD-NUMBER PIC 9(6). SQ2254.2 +013600 07 FILLER PIC X(6). SQ2254.2 +013700 07 UPDATE-NUMBER PIC 9(2). SQ2254.2 +013800 07 FILLER PIC X(5). SQ2254.2 +013900 07 ODO-NUMBER PIC 9(4). SQ2254.2 +014000 07 FILLER PIC X(5). SQ2254.2 +014100 07 XPROGRAM-NAME PIC X(5). SQ2254.2 +014200 07 FILLER PIC X(7). SQ2254.2 +014300 07 XRECORD-LENGTH PIC 9(6). SQ2254.2 +014400 07 FILLER PIC X(7). SQ2254.2 +014500 07 CHARS-OR-RECORDS PIC X(2). SQ2254.2 +014600 07 FILLER PIC X(1). SQ2254.2 +014700 07 XBLOCK-SIZE PIC 9(4). SQ2254.2 +014800 07 FILLER PIC X(6). SQ2254.2 +014900 07 RECORDS-IN-FILE PIC 9(6). SQ2254.2 +015000 07 FILLER PIC X(5). SQ2254.2 +015100 07 XFILE-ORGANIZATION PIC X(2). SQ2254.2 +015200 07 FILLER PIC X(6). SQ2254.2 +015300 07 XLABEL-TYPE PIC X(1). SQ2254.2 +015400 05 FILE-RECORD-INFO-P121-240. SQ2254.2 +015500 07 FILLER PIC X(8). SQ2254.2 +015600 07 XRECORD-KEY PIC X(29). SQ2254.2 +015700 07 FILLER PIC X(9). SQ2254.2 +015800 07 ALTERNATE-KEY1 PIC X(29). SQ2254.2 +015900 07 FILLER PIC X(9). SQ2254.2 +016000 07 ALTERNATE-KEY2 PIC X(29). SQ2254.2 +016100 07 FILLER PIC X(7). SQ2254.2 +016200* SQ2254.2 +016300 01 TEST-RESULTS. SQ2254.2 +016400 02 FILLER PIC X VALUE SPACE. SQ2254.2 +016500 02 PAR-NAME. SQ2254.2 +016600 03 FILLER PIC X(14) VALUE SPACE. SQ2254.2 +016700 03 PARDOT-X PIC X VALUE SPACE. SQ2254.2 +016800 03 DOTVALUE PIC 99 VALUE ZERO. SQ2254.2 +016900 02 FILLER PIC X VALUE SPACE. SQ2254.2 +017000 02 FEATURE PIC X(24) VALUE SPACE. SQ2254.2 +017100 02 FILLER PIC X VALUE SPACE. SQ2254.2 +017200 02 P-OR-F PIC X(5) VALUE SPACE. SQ2254.2 +017300 02 FILLER PIC X(9) VALUE SPACE. SQ2254.2 +017400 02 RE-MARK PIC X(61). SQ2254.2 +017500 01 TEST-COMPUTED. SQ2254.2 +017600 02 FILLER PIC X(30) VALUE SPACE. SQ2254.2 +017700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2254.2 +017800 02 COMPUTED-X. SQ2254.2 +017900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2254.2 +018000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2254.2 +018100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2254.2 +018200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2254.2 +018300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2254.2 +018400 03 CM-18V0 REDEFINES COMPUTED-A. SQ2254.2 +018500 04 COMPUTED-18V0 PIC -9(18). SQ2254.2 +018600 04 FILLER PIC X. SQ2254.2 +018700 03 FILLER PIC X(50) VALUE SPACE. SQ2254.2 +018800 01 TEST-CORRECT. SQ2254.2 +018900 02 FILLER PIC X(30) VALUE SPACE. SQ2254.2 +019000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2254.2 +019100 02 CORRECT-X. SQ2254.2 +019200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2254.2 +019300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2254.2 +019400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2254.2 +019500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2254.2 +019600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2254.2 +019700 03 CR-18V0 REDEFINES CORRECT-A. SQ2254.2 +019800 04 CORRECT-18V0 PIC -9(18). SQ2254.2 +019900 04 FILLER PIC X. SQ2254.2 +020000 03 FILLER PIC X(2) VALUE SPACE. SQ2254.2 +020100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2254.2 +020200* SQ2254.2 +020300 01 CCVS-C-1. SQ2254.2 +020400 02 FILLER PIC IS X VALUE SPACE. SQ2254.2 +020500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ2254.2 +020600 02 FILLER PIC IS X VALUE SPACE. SQ2254.2 +020700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ2254.2 +020800 02 FILLER PIC IS X VALUE SPACE. SQ2254.2 +020900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ2254.2 +021000 02 FILLER PIC IS X(9) VALUE SPACE. SQ2254.2 +021100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ2254.2 +021200 01 CCVS-C-2. SQ2254.2 +021300 02 FILLER PIC X(19) VALUE SPACE. SQ2254.2 +021400 02 FILLER PIC X(6) VALUE "TESTED". SQ2254.2 +021500 02 FILLER PIC X(19) VALUE SPACE. SQ2254.2 +021600 02 FILLER PIC X(4) VALUE "FAIL". SQ2254.2 +021700 02 FILLER PIC X(72) VALUE SPACE. SQ2254.2 +021800* SQ2254.2 +021900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2254.2 +022000 01 REC-CT PIC 99 VALUE ZERO. SQ2254.2 +022100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2254.2 +022200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2254.2 +022300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2254.2 +022400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2254.2 +022500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2254.2 +022600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2254.2 +022700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2254.2 +022800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2254.2 +022900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2254.2 +023000 01 CCVS-H-1. SQ2254.2 +023100 02 FILLER PIC X(39) VALUE SPACES. SQ2254.2 +023200 02 FILLER PIC X(42) VALUE SQ2254.2 +023300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2254.2 +023400 02 FILLER PIC X(39) VALUE SPACES. SQ2254.2 +023500 01 CCVS-H-2A. SQ2254.2 +023600 02 FILLER PIC X(40) VALUE SPACE. SQ2254.2 +023700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2254.2 +023800 02 FILLER PIC XXXX VALUE SQ2254.2 +023900 "4.2 ". SQ2254.2 +024000 02 FILLER PIC X(28) VALUE SQ2254.2 +024100 " COPY - NOT FOR DISTRIBUTION". SQ2254.2 +024200 02 FILLER PIC X(41) VALUE SPACE. SQ2254.2 +024300* SQ2254.2 +024400 01 CCVS-H-2B. SQ2254.2 +024500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2254.2 +024600 02 TEST-ID PIC X(9). SQ2254.2 +024700 02 FILLER PIC X(4) VALUE " IN ". SQ2254.2 +024800 02 FILLER PIC X(12) VALUE SQ2254.2 +024900 " HIGH ". SQ2254.2 +025000 02 FILLER PIC X(22) VALUE SQ2254.2 +025100 " LEVEL VALIDATION FOR ". SQ2254.2 +025200 02 FILLER PIC X(58) VALUE SQ2254.2 +025300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2254.2 +025400 01 CCVS-H-3. SQ2254.2 +025500 02 FILLER PIC X(34) VALUE SQ2254.2 +025600 " FOR OFFICIAL USE ONLY ". SQ2254.2 +025700 02 FILLER PIC X(58) VALUE SQ2254.2 +025800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2254.2 +025900 02 FILLER PIC X(28) VALUE SQ2254.2 +026000 " COPYRIGHT 1985,1986 ". SQ2254.2 +026100 01 CCVS-E-1. SQ2254.2 +026200 02 FILLER PIC X(52) VALUE SPACE. SQ2254.2 +026300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2254.2 +026400 02 ID-AGAIN PIC X(9). SQ2254.2 +026500 02 FILLER PIC X(45) VALUE SPACES. SQ2254.2 +026600 01 CCVS-E-2. SQ2254.2 +026700 02 FILLER PIC X(31) VALUE SPACE. SQ2254.2 +026800 02 FILLER PIC X(21) VALUE SPACE. SQ2254.2 +026900 02 CCVS-E-2-2. SQ2254.2 +027000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2254.2 +027100 03 FILLER PIC X VALUE SPACE. SQ2254.2 +027200 03 ENDER-DESC PIC X(44) VALUE SQ2254.2 +027300 "ERRORS ENCOUNTERED". SQ2254.2 +027400 01 CCVS-E-3. SQ2254.2 +027500 02 FILLER PIC X(22) VALUE SQ2254.2 +027600 " FOR OFFICIAL USE ONLY". SQ2254.2 +027700 02 FILLER PIC X(12) VALUE SPACE. SQ2254.2 +027800 02 FILLER PIC X(58) VALUE SQ2254.2 +027900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2254.2 +028000 02 FILLER PIC X(8) VALUE SPACE. SQ2254.2 +028100 02 FILLER PIC X(20) VALUE SQ2254.2 +028200 " COPYRIGHT 1985,1986". SQ2254.2 +028300 01 CCVS-E-4. SQ2254.2 +028400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2254.2 +028500 02 FILLER PIC X(4) VALUE " OF ". SQ2254.2 +028600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2254.2 +028700 02 FILLER PIC X(40) VALUE SQ2254.2 +028800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2254.2 +028900 01 XXINFO. SQ2254.2 +029000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2254.2 +029100 02 INFO-TEXT. SQ2254.2 +029200 04 FILLER PIC X(8) VALUE SPACE. SQ2254.2 +029300 04 XXCOMPUTED PIC X(20). SQ2254.2 +029400 04 FILLER PIC X(5) VALUE SPACE. SQ2254.2 +029500 04 XXCORRECT PIC X(20). SQ2254.2 +029600 02 INF-ANSI-REFERENCE PIC X(48). SQ2254.2 +029700 01 HYPHEN-LINE. SQ2254.2 +029800 02 FILLER PIC IS X VALUE IS SPACE. SQ2254.2 +029900 02 FILLER PIC IS X(65) VALUE IS "************************SQ2254.2 +030000- "*****************************************". SQ2254.2 +030100 02 FILLER PIC IS X(54) VALUE IS "************************SQ2254.2 +030200- "******************************". SQ2254.2 +030300 01 CCVS-PGM-ID PIC X(9) VALUE SQ2254.2 +030400 "SQ225A". SQ2254.2 +030500* SQ2254.2 +030600* SQ2254.2 +030700 PROCEDURE DIVISION. SQ2254.2 +030800 DECLARATIVES. SQ2254.2 +030900 SQ225A-DECLARATIVE-001-SECT SECTION. SQ2254.2 +031000 USE AFTER ERROR PROCEDURE EXTEND. SQ2254.2 +031100 INPUT-ERROR-PROCEDURE. SQ2254.2 +031200 IF DECL-EXEC-SW NOT = 9 SQ2254.2 +031300 GO TO NOT-DECL-9. SQ2254.2 +031400* SQ2254.2 +031500* DECLARATIVE PROCEDURE ENTERED FROM OPEN INPUT SQ2254.2 +031600* SQ2254.2 +031700 DECL-OPEN-TEST. SQ2254.2 +031800 MOVE "EXEC USE ON OPEN FAILURE" TO FEATURE. SQ2254.2 +031900 MOVE "DECL-OPEN-TEST" TO PAR-NAME. SQ2254.2 +032000 MOVE 1 TO REC-CT. SQ2254.2 +032100 IF SQ-FS1-STATUS = "35" SQ2254.2 +032200 PERFORM DECL-PASS SQ2254.2 +032300 ELSE SQ2254.2 +032400 MOVE "35" TO CORRECT-A SQ2254.2 +032500 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2254.2 +032600 MOVE "INCORRECT FILE STATUS FOR NON-AVAILABLE FILE" SQ2254.2 +032700 TO RE-MARK SQ2254.2 +032800 PERFORM DECL-FAIL. SQ2254.2 +032900 MOVE SPACE TO DUMMY-RECORD SQ2254.2 +033000 PERFORM DECL-WRITE-LINE SQ2254.2 +033100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2254.2 +033200 TO DUMMY-RECORD SQ2254.2 +033300 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2254.2 +033400 GO TO END-DECLS. SQ2254.2 +033500* SQ2254.2 +033600* SQ2254.2 +033700 NOT-DECL-9. SQ2254.2 +033800 MOVE "NOT-DECL-9" TO PAR-NAME. SQ2254.2 +033900 MOVE DECL-EXEC-SW TO COMPUTED-18V0. SQ2254.2 +034000 MOVE 9 TO CORRECT-18V0. SQ2254.2 +034100 PERFORM DECL-FAIL. SQ2254.2 +034200 GO TO END-DECLS. SQ2254.2 +034300* SQ2254.2 +034400* SQ2254.2 +034500 DECL-PASS. SQ2254.2 +034600 MOVE "PASS " TO P-OR-F. SQ2254.2 +034700 ADD 1 TO PASS-COUNTER. SQ2254.2 +034800 PERFORM DECL-PRINT-DETAIL. SQ2254.2 +034900* SQ2254.2 +035000 DECL-FAIL. SQ2254.2 +035100 MOVE "FAIL*" TO P-OR-F. SQ2254.2 +035200 ADD 1 TO ERROR-COUNTER. SQ2254.2 +035300 PERFORM DECL-PRINT-DETAIL. SQ2254.2 +035400* SQ2254.2 +035500 DECL-PRINT-DETAIL. SQ2254.2 +035600 IF REC-CT NOT EQUAL TO ZERO SQ2254.2 +035700 MOVE "." TO PARDOT-X SQ2254.2 +035800 MOVE REC-CT TO DOTVALUE. SQ2254.2 +035900 MOVE TEST-RESULTS TO PRINT-REC. SQ2254.2 +036000 PERFORM DECL-WRITE-LINE. SQ2254.2 +036100 IF P-OR-F EQUAL TO "FAIL*" SQ2254.2 +036200 PERFORM DECL-WRITE-LINE SQ2254.2 +036300 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2254.2 +036400 ELSE SQ2254.2 +036500 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2254.2 +036600 MOVE SPACE TO P-OR-F. SQ2254.2 +036700 MOVE SPACE TO COMPUTED-X. SQ2254.2 +036800 MOVE SPACE TO CORRECT-X. SQ2254.2 +036900 IF REC-CT EQUAL TO ZERO SQ2254.2 +037000 MOVE SPACE TO PAR-NAME. SQ2254.2 +037100 MOVE SPACE TO RE-MARK. SQ2254.2 +037200* SQ2254.2 +037300 DECL-WRITE-LINE. SQ2254.2 +037400 ADD 1 TO RECORD-COUNT. SQ2254.2 +037500 IF RECORD-COUNT GREATER 50 SQ2254.2 +037600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2254.2 +037700 MOVE SPACE TO DUMMY-RECORD SQ2254.2 +037800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2254.2 +037900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2254.2 +038000 MOVE CCVS-C-2 TO DUMMY-RECORD SQ2254.2 +038100 PERFORM DECL-WRT-LN 2 TIMES SQ2254.2 +038200 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2254.2 +038300 PERFORM DECL-WRT-LN SQ2254.2 +038400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2254.2 +038500 MOVE ZERO TO RECORD-COUNT. SQ2254.2 +038600 PERFORM DECL-WRT-LN. SQ2254.2 +038700* SQ2254.2 +038800 DECL-WRT-LN. SQ2254.2 +038900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2254.2 +039000 MOVE SPACE TO DUMMY-RECORD. SQ2254.2 +039100* SQ2254.2 +039200 DECL-FAIL-ROUTINE. SQ2254.2 +039300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2254.2 +039400 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2254.2 +039500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2254.2 +039600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2254.2 +039700 MOVE XXINFO TO DUMMY-RECORD. SQ2254.2 +039800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2254.2 +039900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2254.2 +040000 GO TO DECL-FAIL-EX. SQ2254.2 +040100 DECL-FAIL-WRITE. SQ2254.2 +040200 MOVE TEST-COMPUTED TO PRINT-REC SQ2254.2 +040300 PERFORM DECL-WRITE-LINE SQ2254.2 +040400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2254.2 +040500 MOVE TEST-CORRECT TO PRINT-REC SQ2254.2 +040600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2254.2 +040700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2254.2 +040800 DECL-FAIL-EX. SQ2254.2 +040900 EXIT. SQ2254.2 +041000* SQ2254.2 +041100 DECL-BAIL. SQ2254.2 +041200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2254.2 +041300 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2254.2 +041400 DECL-BAIL-WRITE. SQ2254.2 +041500 MOVE CORRECT-A TO XXCORRECT. SQ2254.2 +041600 MOVE COMPUTED-A TO XXCOMPUTED. SQ2254.2 +041700 MOVE XXINFO TO DUMMY-RECORD. SQ2254.2 +041800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2254.2 +041900 DECL-BAIL-EX. SQ2254.2 +042000 EXIT. SQ2254.2 +042100* SQ2254.2 +042200 END-DECLS. SQ2254.2 +042300 MOVE ZERO TO DECL-EXEC-SW. SQ2254.2 +042400 END DECLARATIVES. SQ2254.2 +042500* SQ2254.2 +042600* SQ2254.2 +042700 CCVS1 SECTION. SQ2254.2 +042800 OPEN-FILES. SQ2254.2 +042900*P OPEN I-O RAW-DATA. SQ2254.2 +043000*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2254.2 +043100*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2254.2 +043200*P MOVE "ABORTED " TO C-ABORT. SQ2254.2 +043300*P ADD 1 TO C-NO-OF-TESTS. SQ2254.2 +043400*P ACCEPT C-DATE FROM DATE. SQ2254.2 +043500*P ACCEPT C-TIME FROM TIME. SQ2254.2 +043600*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2254.2 +043700*PND-E-1. SQ2254.2 +043800*P CLOSE RAW-DATA. SQ2254.2 +043900 OPEN OUTPUT PRINT-FILE. SQ2254.2 +044000 MOVE CCVS-PGM-ID TO TEST-ID. SQ2254.2 +044100 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2254.2 +044200 MOVE SPACE TO TEST-RESULTS. SQ2254.2 +044300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2254.2 +044400 MOVE ZERO TO REC-SKEL-SUB. SQ2254.2 +044500 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2254.2 +044600 GO TO CCVS1-EXIT. SQ2254.2 +044700* SQ2254.2 +044800 CCVS-INIT-FILE. SQ2254.2 +044900 ADD 1 TO REC-SKL-SUB. SQ2254.2 +045000 MOVE FILE-RECORD-INFO-SKELETON TO SQ2254.2 +045100 FILE-RECORD-INFO (REC-SKL-SUB). SQ2254.2 +045200* SQ2254.2 +045300 CLOSE-FILES. SQ2254.2 +045400 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2254.2 +045500 CLOSE PRINT-FILE. SQ2254.2 +045600*P OPEN I-O RAW-DATA. SQ2254.2 +045700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2254.2 +045800*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2254.2 +045900*P MOVE "OK. " TO C-ABORT. SQ2254.2 +046000*P MOVE PASS-COUNTER TO C-OK. SQ2254.2 +046100*P MOVE ERROR-HOLD TO C-ALL. SQ2254.2 +046200*P MOVE ERROR-COUNTER TO C-FAIL. SQ2254.2 +046300*P MOVE DELETE-CNT TO C-DELETED. SQ2254.2 +046400*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2254.2 +046500*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2254.2 +046600*PND-E-2. SQ2254.2 +046700*P CLOSE RAW-DATA. SQ2254.2 +046800 TERMINATE-CCVS. SQ2254.2 +046900*S EXIT PROGRAM. SQ2254.2 +047000 STOP RUN. SQ2254.2 +047100* SQ2254.2 +047200 INSPT. SQ2254.2 +047300 MOVE "INSPT" TO P-OR-F. SQ2254.2 +047400 ADD 1 TO INSPECT-COUNTER. SQ2254.2 +047500 PERFORM PRINT-DETAIL. SQ2254.2 +047600 SQ2254.2 +047700 PASS. SQ2254.2 +047800 MOVE "PASS " TO P-OR-F. SQ2254.2 +047900 ADD 1 TO PASS-COUNTER. SQ2254.2 +048000 PERFORM PRINT-DETAIL. SQ2254.2 +048100* SQ2254.2 +048200 FAIL. SQ2254.2 +048300 MOVE "FAIL*" TO P-OR-F. SQ2254.2 +048400 ADD 1 TO ERROR-COUNTER. SQ2254.2 +048500 PERFORM PRINT-DETAIL. SQ2254.2 +048600* SQ2254.2 +048700 DE-LETE. SQ2254.2 +048800 MOVE "****TEST DELETED****" TO RE-MARK. SQ2254.2 +048900 MOVE "*****" TO P-OR-F. SQ2254.2 +049000 ADD 1 TO DELETE-COUNTER. SQ2254.2 +049100 PERFORM PRINT-DETAIL. SQ2254.2 +049200* SQ2254.2 +049300 PRINT-DETAIL. SQ2254.2 +049400 IF REC-CT NOT EQUAL TO ZERO SQ2254.2 +049500 MOVE "." TO PARDOT-X SQ2254.2 +049600 MOVE REC-CT TO DOTVALUE. SQ2254.2 +049700 MOVE TEST-RESULTS TO PRINT-REC. SQ2254.2 +049800 PERFORM WRITE-LINE. SQ2254.2 +049900 IF P-OR-F EQUAL TO "FAIL*" SQ2254.2 +050000 PERFORM WRITE-LINE SQ2254.2 +050100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2254.2 +050200 ELSE SQ2254.2 +050300 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2254.2 +050400 MOVE SPACE TO P-OR-F. SQ2254.2 +050500 MOVE SPACE TO COMPUTED-X. SQ2254.2 +050600 MOVE SPACE TO CORRECT-X. SQ2254.2 +050700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2254.2 +050800 MOVE SPACE TO RE-MARK. SQ2254.2 +050900* SQ2254.2 +051000 HEAD-ROUTINE. SQ2254.2 +051100 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +051200 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +051300 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2254.2 +051400 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2254.2 +051500 COLUMN-NAMES-ROUTINE. SQ2254.2 +051600 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2254.2 +051700 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +051800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2254.2 +051900 END-ROUTINE. SQ2254.2 +052000 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2254.2 +052100 PERFORM WRITE-LINE 5 TIMES. SQ2254.2 +052200 END-RTN-EXIT. SQ2254.2 +052300 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2254.2 +052400 PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +052500* SQ2254.2 +052600 END-ROUTINE-1. SQ2254.2 +052700 ADD ERROR-COUNTER TO ERROR-HOLD SQ2254.2 +052800 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2254.2 +052900 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2254.2 +053000 ADD PASS-COUNTER TO ERROR-HOLD. SQ2254.2 +053100 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2254.2 +053200 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2254.2 +053300 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2254.2 +053400 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2254.2 +053500 PERFORM WRITE-LINE. SQ2254.2 +053600 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2254.2 +053700 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2254.2 +053800 MOVE "NO " TO ERROR-TOTAL SQ2254.2 +053900 ELSE SQ2254.2 +054000 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2254.2 +054100 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2254.2 +054200 PERFORM WRITE-LINE. SQ2254.2 +054300 END-ROUTINE-13. SQ2254.2 +054400 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2254.2 +054500 MOVE "NO " TO ERROR-TOTAL SQ2254.2 +054600 ELSE SQ2254.2 +054700 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2254.2 +054800 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2254.2 +054900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2254.2 +055000 PERFORM WRITE-LINE. SQ2254.2 +055100 IF INSPECT-COUNTER EQUAL TO ZERO SQ2254.2 +055200 MOVE "NO " TO ERROR-TOTAL SQ2254.2 +055300 ELSE SQ2254.2 +055400 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2254.2 +055500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2254.2 +055600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2254.2 +055700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2254.2 +055800* SQ2254.2 +055900 WRITE-LINE. SQ2254.2 +056000 ADD 1 TO RECORD-COUNT. SQ2254.2 +056100 IF RECORD-COUNT GREATER 50 SQ2254.2 +056200 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2254.2 +056300 MOVE SPACE TO DUMMY-RECORD SQ2254.2 +056400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2254.2 +056500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2254.2 +056600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2254.2 +056700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2254.2 +056800 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2254.2 +056900 MOVE ZERO TO RECORD-COUNT. SQ2254.2 +057000 PERFORM WRT-LN. SQ2254.2 +057100* SQ2254.2 +057200 WRT-LN. SQ2254.2 +057300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2254.2 +057400 MOVE SPACE TO DUMMY-RECORD. SQ2254.2 +057500 BLANK-LINE-PRINT. SQ2254.2 +057600 PERFORM WRT-LN. SQ2254.2 +057700 FAIL-ROUTINE. SQ2254.2 +057800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2254.2 +057900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2254.2 +058000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2254.2 +058100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2254.2 +058200 MOVE XXINFO TO DUMMY-RECORD. SQ2254.2 +058300 PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +058400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2254.2 +058500 GO TO FAIL-ROUTINE-EX. SQ2254.2 +058600 FAIL-ROUTINE-WRITE. SQ2254.2 +058700 MOVE TEST-COMPUTED TO PRINT-REC SQ2254.2 +058800 PERFORM WRITE-LINE SQ2254.2 +058900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2254.2 +059000 MOVE TEST-CORRECT TO PRINT-REC SQ2254.2 +059100 PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +059200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2254.2 +059300 FAIL-ROUTINE-EX. SQ2254.2 +059400 EXIT. SQ2254.2 +059500 BAIL-OUT. SQ2254.2 +059600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2254.2 +059700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2254.2 +059800 BAIL-OUT-WRITE. SQ2254.2 +059900 MOVE CORRECT-A TO XXCORRECT. SQ2254.2 +060000 MOVE COMPUTED-A TO XXCOMPUTED. SQ2254.2 +060100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2254.2 +060200 MOVE XXINFO TO DUMMY-RECORD. SQ2254.2 +060300 PERFORM WRITE-LINE 2 TIMES. SQ2254.2 +060400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2254.2 +060500 BAIL-OUT-EX. SQ2254.2 +060600 EXIT. SQ2254.2 +060700 CCVS1-EXIT. SQ2254.2 +060800 EXIT. SQ2254.2 +060900* SQ2254.2 +061000**************************************************************** SQ2254.2 +061100* * SQ2254.2 +061200* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2254.2 +061300* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2254.2 +061400* * SQ2254.2 +061500**************************************************************** SQ2254.2 +061600* SQ2254.2 +061700 SECT-SQ225A-MAIN SECTION. SQ2254.2 +061800 OPEN-INIT-01. SQ2254.2 +061900* SQ2254.2 +062000* THIS PROGRAM ATTEMPTS TO OPEN A FILE WHICH IS NOT SQ2254.2 +062100* PRESENT AND AVAILABLE TO IT. SQ2254.2 +062200* SQ2254.2 +062300 MOVE 9 TO DECL-EXEC-SW SQ2254.2 +062400 MOVE "**" TO SQ-FS1-STATUS. SQ2254.2 +062500 OPEN-TEST-01. SQ2254.2 +062600 OPEN EXTEND SQ-FS1. SQ2254.2 +062700 MOVE 1 TO REC-CT SQ2254.2 +062800 MOVE "OPEN ABSENT FILE EXTEND" TO FEATURE SQ2254.2 +062900 MOVE "OPEN-TEST-01" TO PAR-NAME SQ2254.2 +063000 IF DECL-EXEC-SW = 0 SQ2254.2 +063100 PERFORM PASS SQ2254.2 +063200 ELSE SQ2254.2 +063300 MOVE DECL-EXEC-SW TO COMPUTED-18V0 SQ2254.2 +063400 MOVE ZERO TO CORRECT-18V0 SQ2254.2 +063500 MOVE "DECLARATIVE NOT EXECUTED" TO RE-MARK SQ2254.2 +063600 MOVE "V11-2, 1.3.5" TO ANSI-REFERENCE SQ2254.2 +063700 PERFORM FAIL. SQ2254.2 +063800* SQ2254.2 +063900 ADD 1 TO REC-CT. SQ2254.2 +064000 IF SQ-FS1-STATUS NOT = "35" SQ2254.2 +064100 MOVE "INCORRECT STATUS CODE RETURNED" TO RE-MARK SQ2254.2 +064200 MOVE "VII-4, 1.5.3(3)C" TO ANSI-REFERENCE SQ2254.2 +064300 MOVE "35" TO CORRECT-A SQ2254.2 +064400 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2254.2 +064500 PERFORM FAIL SQ2254.2 +064600 ELSE SQ2254.2 +064700 PERFORM PASS. SQ2254.2 +064800* SQ2254.2 +064900* SQ2254.2 +065000 CCVS-EXIT SECTION. SQ2254.2 +065100 CCVS-999999. SQ2254.2 +065200 GO TO CLOSE-FILES. SQ2254.2 diff --git a/tests/cobol85/SQ/SQ226A.CBL b/tests/cobol85/SQ/SQ226A.CBL new file mode 100755 index 00000000..b52d88e8 --- /dev/null +++ b/tests/cobol85/SQ/SQ226A.CBL @@ -0,0 +1,1650 @@ +000100 IDENTIFICATION DIVISION. SQ2264.2 +000200 PROGRAM-ID. SQ2264.2 +000300 SQ226A. SQ2264.2 +000400**************************************************************** SQ2264.2 +000500* * SQ2264.2 +000600* VALIDATION FOR:- * SQ2264.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2264.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2264.2 +000900* REVISED 1986, AUGUST * SQ2264.2 +001000* * SQ2264.2 +001100* CREATION DATE / VALIDATION DATE * SQ2264.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2264.2 +001300* * SQ2264.2 +001400**************************************************************** SQ2264.2 +001500* * SQ2264.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2264.2 +001700* * SQ2264.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ2264.2 +001900* X-55 SYSTEM PRINTER * SQ2264.2 +002000* X-82 SOURCE-COMPUTER * SQ2264.2 +002100* X-83 OBJECT-COMPUTER. * SQ2264.2 +002200* * SQ2264.2 +002300**************************************************************** SQ2264.2 +002400* * SQ2264.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ2264.2 +002600* TO A MASS STORAGE MEDIUM, WRITES ONE RECORD AND CLOSES * SQ2264.2 +002700* THE FILE. THE FILE IS THEN OPENED FOR INPUT, AND TWO * SQ2264.2 +002800* READ STATEMENTS EXECUTED. THE SECOND SHOULD CAUSE AN * SQ2264.2 +002900* AT END CONDITION. AN OPEN EXTEND STATEMENT IS THEN * SQ2264.2 +003000* EXECUTED. THIS SHOULD CAUSE AN EXCEPTION CONDITION, * SQ2264.2 +003100* WITH I-O STATUS "41" AND ENTRY TO THE APPLICABLE ERROR * SQ2264.2 +003200* DECLARATIVE. THERE ARE DECLARATIVES FOR ALL FOUR OPEN * SQ2264.2 +003300* MODES, AND EITHER THE "INPUT" OR THE "EXTEND" DECLARATIVE * SQ2264.2 +003400* COULD BE CONSIDERED APPLICABLE. THE STANDARD IS * SQ2264.2 +003500* AMBIGUOUS ON THIS POINT, SEE PAGE VII-51, 4.6.4, GENERAL * SQ2264.2 +003600* RULE (5), SUB-RULES B AND E. THE PROGRAM ACCEPTS * SQ2264.2 +003700* EXECUTION OF EITHER DECLARATIVE AS CORRECT, SO LONG AS * SQ2264.2 +003800* ONLY ONE OF THEM IS EXECUTED. * SQ2264.2 +003900* * SQ2264.2 +004000**************************************************************** SQ2264.2 +004100* SQ2264.2 +004200 ENVIRONMENT DIVISION. SQ2264.2 +004300 CONFIGURATION SECTION. SQ2264.2 +004400 SOURCE-COMPUTER. SQ2264.2 +004500 Linux. SQ2264.2 +004600 OBJECT-COMPUTER. SQ2264.2 +004700 Linux. SQ2264.2 +004800* SQ2264.2 +004900 INPUT-OUTPUT SECTION. SQ2264.2 +005000 FILE-CONTROL. SQ2264.2 +005100 SELECT PRINT-FILE ASSIGN TO SQ2264.2 +005200 "report.log". SQ2264.2 +005300* SQ2264.2 +005400*P SELECT RAW-DATA ASSIGN TO SQ2264.2 +005500*P "XXXXX062" SQ2264.2 +005600*P ORGANIZATION IS INDEXED SQ2264.2 +005700*P ACCESS MODE IS RANDOM SQ2264.2 +005800*P RECORD-KEY IS RAW-DATA-KEY. SQ2264.2 +005900*P SQ2264.2 +006000 SELECT SQ-FS4 SQ2264.2 +006100 RESERVE 1 SQ2264.2 +006200 ASSIGN SQ2264.2 +006300 "XXXXX014" SQ2264.2 +006400 SEQUENTIAL SQ2264.2 +006500 STATUS IS SQ-FS4-STATUS OF STATUS-GROUP. SQ2264.2 +006600* SQ2264.2 +006700* SQ2264.2 +006800 DATA DIVISION. SQ2264.2 +006900 FILE SECTION. SQ2264.2 +007000 FD PRINT-FILE SQ2264.2 +007100*C LABEL RECORDS SQ2264.2 +007200*C OMITTED SQ2264.2 +007300*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2264.2 +007400 . SQ2264.2 +007500 01 PRINT-REC PICTURE X(120). SQ2264.2 +007600 01 DUMMY-RECORD PICTURE X(120). SQ2264.2 +007700*P SQ2264.2 +007800*PD RAW-DATA. SQ2264.2 +007900*P1 RAW-DATA-SATZ. SQ2264.2 +008000*P 05 RAW-DATA-KEY PIC X(6). SQ2264.2 +008100*P 05 C-DATE PIC 9(6). SQ2264.2 +008200*P 05 C-TIME PIC 9(8). SQ2264.2 +008300*P 05 NO-OF-TESTS PIC 99. SQ2264.2 +008400*P 05 C-OK PIC 999. SQ2264.2 +008500*P 05 C-ALL PIC 999. SQ2264.2 +008600*P 05 C-FAIL PIC 999. SQ2264.2 +008700*P 05 C-DELETED PIC 999. SQ2264.2 +008800*P 05 C-INSPECT PIC 999. SQ2264.2 +008900*P 05 C-NOTE PIC X(13). SQ2264.2 +009000*P 05 C-INDENT PIC X. SQ2264.2 +009100*P 05 C-ABORT PIC X(8). SQ2264.2 +009200* SQ2264.2 +009300 FD SQ-FS4 SQ2264.2 +009400*C LABEL RECORD IS STANDARD SQ2264.2 +009500 BLOCK 120 SQ2264.2 +009600 RECORD 120 SQ2264.2 +009700 . SQ2264.2 +009800 01 SQ-FS4R1-F-G-120. SQ2264.2 +009900 05 FFILE-RECORD-INFO-P1-120. SQ2264.2 +010000 07 FILLER PIC X(5). SQ2264.2 +010100 07 FFILE-NAME PIC X(6). SQ2264.2 +010200 07 FILLER PIC X(8). SQ2264.2 +010300 07 FRECORD-NAME PIC X(6). SQ2264.2 +010400 07 FILLER PIC X(1). SQ2264.2 +010500 07 FREELUNIT-NUMBER PIC 9(1). SQ2264.2 +010600 07 FILLER PIC X(7). SQ2264.2 +010700 07 FRECORD-NUMBER PIC 9(6). SQ2264.2 +010800 07 FILLER PIC X(6). SQ2264.2 +010900 07 FUPDATE-NUMBER PIC 9(2). SQ2264.2 +011000 07 FILLER PIC X(5). SQ2264.2 +011100 07 FODO-NUMBER PIC 9(4). SQ2264.2 +011200 07 FILLER PIC X(5). SQ2264.2 +011300 07 FPROGRAM-NAME PIC X(5). SQ2264.2 +011400 07 FILLER PIC X(7). SQ2264.2 +011500 07 FRECORD-LENGTH PIC 9(6). SQ2264.2 +011600 07 FILLER PIC X(7). SQ2264.2 +011700 07 FCHARS-OR-RECORDS PIC X(2). SQ2264.2 +011800 07 FILLER PIC X(1). SQ2264.2 +011900 07 FBLOCK-SIZE PIC 9(4). SQ2264.2 +012000 07 FILLER PIC X(6). SQ2264.2 +012100 07 FRECORDS-IN-FILE PIC 9(6). SQ2264.2 +012200 07 FILLER PIC X(5). SQ2264.2 +012300 07 FFILE-ORGANIZATION PIC X(2). SQ2264.2 +012400 07 FILLER PIC X(6). SQ2264.2 +012500 07 FLABEL-TYPE PIC X(1). SQ2264.2 +012600* SQ2264.2 +012700 WORKING-STORAGE SECTION. SQ2264.2 +012800* SQ2264.2 +012900*************************************************************** SQ2264.2 +013000* * SQ2264.2 +013100* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2264.2 +013200* * SQ2264.2 +013300*************************************************************** SQ2264.2 +013400* SQ2264.2 +013500 01 STATUS-GROUP. SQ2264.2 +013600 04 SQ-FS4-STATUS. SQ2264.2 +013700 07 SQ-FS4-KEY-1 PIC X. SQ2264.2 +013800 07 SQ-FS4-KEY-2 PIC X. SQ2264.2 +013900* SQ2264.2 +014000 01 DELETE-SW. SQ2264.2 +014100 03 DELETE-SW-1 PIC X. SQ2264.2 +014200 03 DELETE-SW-1-GROUP. SQ2264.2 +014300 05 DELETE-SW-2 PIC X. SQ2264.2 +014400* SQ2264.2 +014500 01 DECL-EXEC-E PIC X(12). SQ2264.2 +014600 01 DECL-EXEC-I PIC X(12). SQ2264.2 +014700 01 DECL-EXEC-I-O PIC X(12). SQ2264.2 +014800 01 DECL-EXEC-O PIC X(12). SQ2264.2 +014900* SQ2264.2 +015000 01 DECL-EXEC-SW PIC X. SQ2264.2 +015100 01 DECL-EXEC-CT PIC 9. SQ2264.2 +015200* SQ2264.2 +015300*************************************************************** SQ2264.2 +015400* * SQ2264.2 +015500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2264.2 +015600* * SQ2264.2 +015700*************************************************************** SQ2264.2 +015800* SQ2264.2 +015900 01 REC-SKEL-SUB PIC 99. SQ2264.2 +016000* SQ2264.2 +016100 01 FILE-RECORD-INFORMATION-REC. SQ2264.2 +016200 03 FILE-RECORD-INFO-SKELETON. SQ2264.2 +016300 05 FILLER PICTURE X(48) VALUE SQ2264.2 +016400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2264.2 +016500 05 FILLER PICTURE X(46) VALUE SQ2264.2 +016600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2264.2 +016700 05 FILLER PICTURE X(26) VALUE SQ2264.2 +016800 ",LFIL=000000,ORG= ,LBLR= ". SQ2264.2 +016900 05 FILLER PICTURE X(37) VALUE SQ2264.2 +017000 ",RECKEY= ". SQ2264.2 +017100 05 FILLER PICTURE X(38) VALUE SQ2264.2 +017200 ",ALTKEY1= ". SQ2264.2 +017300 05 FILLER PICTURE X(38) VALUE SQ2264.2 +017400 ",ALTKEY2= ". SQ2264.2 +017500 05 FILLER PICTURE X(7) VALUE SPACE.SQ2264.2 +017600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2264.2 +017700 05 FILE-RECORD-INFO-P1-120. SQ2264.2 +017800 07 FILLER PIC X(5). SQ2264.2 +017900 07 XFILE-NAME PIC X(6). SQ2264.2 +018000 07 FILLER PIC X(8). SQ2264.2 +018100 07 XRECORD-NAME PIC X(6). SQ2264.2 +018200 07 FILLER PIC X(1). SQ2264.2 +018300 07 REELUNIT-NUMBER PIC 9(1). SQ2264.2 +018400 07 FILLER PIC X(7). SQ2264.2 +018500 07 XRECORD-NUMBER PIC 9(6). SQ2264.2 +018600 07 FILLER PIC X(6). SQ2264.2 +018700 07 UPDATE-NUMBER PIC 9(2). SQ2264.2 +018800 07 FILLER PIC X(5). SQ2264.2 +018900 07 ODO-NUMBER PIC 9(4). SQ2264.2 +019000 07 FILLER PIC X(5). SQ2264.2 +019100 07 XPROGRAM-NAME PIC X(5). SQ2264.2 +019200 07 FILLER PIC X(7). SQ2264.2 +019300 07 XRECORD-LENGTH PIC 9(6). SQ2264.2 +019400 07 FILLER PIC X(7). SQ2264.2 +019500 07 CHARS-OR-RECORDS PIC X(2). SQ2264.2 +019600 07 FILLER PIC X(1). SQ2264.2 +019700 07 XBLOCK-SIZE PIC 9(4). SQ2264.2 +019800 07 FILLER PIC X(6). SQ2264.2 +019900 07 RECORDS-IN-FILE PIC 9(6). SQ2264.2 +020000 07 FILLER PIC X(5). SQ2264.2 +020100 07 XFILE-ORGANIZATION PIC X(2). SQ2264.2 +020200 07 FILLER PIC X(6). SQ2264.2 +020300 07 XLABEL-TYPE PIC X(1). SQ2264.2 +020400 05 FILE-RECORD-INFO-P121-240. SQ2264.2 +020500 07 FILLER PIC X(8). SQ2264.2 +020600 07 XRECORD-KEY PIC X(29). SQ2264.2 +020700 07 FILLER PIC X(9). SQ2264.2 +020800 07 ALTERNATE-KEY1 PIC X(29). SQ2264.2 +020900 07 FILLER PIC X(9). SQ2264.2 +021000 07 ALTERNATE-KEY2 PIC X(29). SQ2264.2 +021100 07 FILLER PIC X(7). SQ2264.2 +021200* SQ2264.2 +021300 01 TEST-RESULTS. SQ2264.2 +021400 02 FILLER PIC X VALUE SPACE. SQ2264.2 +021500 02 PAR-NAME. SQ2264.2 +021600 03 FILLER PIC X(14) VALUE SPACE. SQ2264.2 +021700 03 PARDOT-X PIC X VALUE SPACE. SQ2264.2 +021800 03 DOTVALUE PIC 99 VALUE ZERO. SQ2264.2 +021900 02 FILLER PIC X VALUE SPACE. SQ2264.2 +022000 02 FEATURE PIC X(24) VALUE SPACE. SQ2264.2 +022100 02 FILLER PIC X VALUE SPACE. SQ2264.2 +022200 02 P-OR-F PIC X(5) VALUE SPACE. SQ2264.2 +022300 02 FILLER PIC X(9) VALUE SPACE. SQ2264.2 +022400 02 RE-MARK PIC X(61). SQ2264.2 +022500 01 TEST-COMPUTED. SQ2264.2 +022600 02 FILLER PIC X(30) VALUE SPACE. SQ2264.2 +022700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2264.2 +022800 02 COMPUTED-X. SQ2264.2 +022900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2264.2 +023000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2264.2 +023100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2264.2 +023200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2264.2 +023300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2264.2 +023400 03 CM-18V0 REDEFINES COMPUTED-A. SQ2264.2 +023500 04 COMPUTED-18V0 PIC -9(18). SQ2264.2 +023600 04 FILLER PIC X. SQ2264.2 +023700 03 FILLER PIC X(50) VALUE SPACE. SQ2264.2 +023800 01 TEST-CORRECT. SQ2264.2 +023900 02 FILLER PIC X(30) VALUE SPACE. SQ2264.2 +024000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2264.2 +024100 02 CORRECT-X. SQ2264.2 +024200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2264.2 +024300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2264.2 +024400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2264.2 +024500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2264.2 +024600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2264.2 +024700 03 CR-18V0 REDEFINES CORRECT-A. SQ2264.2 +024800 04 CORRECT-18V0 PIC -9(18). SQ2264.2 +024900 04 FILLER PIC X. SQ2264.2 +025000 03 FILLER PIC X(2) VALUE SPACE. SQ2264.2 +025100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2264.2 +025200* SQ2264.2 +025300 01 CCVS-C-1. SQ2264.2 +025400 02 FILLER PIC IS X VALUE SPACE. SQ2264.2 +025500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ2264.2 +025600 02 FILLER PIC IS X VALUE SPACE. SQ2264.2 +025700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ2264.2 +025800 02 FILLER PIC IS X VALUE SPACE. SQ2264.2 +025900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ2264.2 +026000 02 FILLER PIC IS X(9) VALUE SPACE. SQ2264.2 +026100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ2264.2 +026200 01 CCVS-C-2. SQ2264.2 +026300 02 FILLER PIC X(19) VALUE SPACE. SQ2264.2 +026400 02 FILLER PIC X(6) VALUE "TESTED". SQ2264.2 +026500 02 FILLER PIC X(19) VALUE SPACE. SQ2264.2 +026600 02 FILLER PIC X(4) VALUE "FAIL". SQ2264.2 +026700 02 FILLER PIC X(72) VALUE SPACE. SQ2264.2 +026800* SQ2264.2 +026900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2264.2 +027000 01 REC-CT PIC 99 VALUE ZERO. SQ2264.2 +027100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2264.2 +027200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2264.2 +027300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2264.2 +027400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2264.2 +027500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2264.2 +027600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2264.2 +027700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2264.2 +027800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2264.2 +027900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2264.2 +028000 01 CCVS-H-1. SQ2264.2 +028100 02 FILLER PIC X(39) VALUE SPACES. SQ2264.2 +028200 02 FILLER PIC X(42) VALUE SQ2264.2 +028300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2264.2 +028400 02 FILLER PIC X(39) VALUE SPACES. SQ2264.2 +028500 01 CCVS-H-2A. SQ2264.2 +028600 02 FILLER PIC X(40) VALUE SPACE. SQ2264.2 +028700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2264.2 +028800 02 FILLER PIC XXXX VALUE SQ2264.2 +028900 "4.2 ". SQ2264.2 +029000 02 FILLER PIC X(28) VALUE SQ2264.2 +029100 " COPY - NOT FOR DISTRIBUTION". SQ2264.2 +029200 02 FILLER PIC X(41) VALUE SPACE. SQ2264.2 +029300* SQ2264.2 +029400 01 CCVS-H-2B. SQ2264.2 +029500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2264.2 +029600 02 TEST-ID PIC X(9). SQ2264.2 +029700 02 FILLER PIC X(4) VALUE " IN ". SQ2264.2 +029800 02 FILLER PIC X(12) VALUE SQ2264.2 +029900 " HIGH ". SQ2264.2 +030000 02 FILLER PIC X(22) VALUE SQ2264.2 +030100 " LEVEL VALIDATION FOR ". SQ2264.2 +030200 02 FILLER PIC X(58) VALUE SQ2264.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2264.2 +030400 01 CCVS-H-3. SQ2264.2 +030500 02 FILLER PIC X(34) VALUE SQ2264.2 +030600 " FOR OFFICIAL USE ONLY ". SQ2264.2 +030700 02 FILLER PIC X(58) VALUE SQ2264.2 +030800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2264.2 +030900 02 FILLER PIC X(28) VALUE SQ2264.2 +031000 " COPYRIGHT 1985,1986 ". SQ2264.2 +031100 01 CCVS-E-1. SQ2264.2 +031200 02 FILLER PIC X(52) VALUE SPACE. SQ2264.2 +031300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2264.2 +031400 02 ID-AGAIN PIC X(9). SQ2264.2 +031500 02 FILLER PIC X(45) VALUE SPACES. SQ2264.2 +031600 01 CCVS-E-2. SQ2264.2 +031700 02 FILLER PIC X(31) VALUE SPACE. SQ2264.2 +031800 02 FILLER PIC X(21) VALUE SPACE. SQ2264.2 +031900 02 CCVS-E-2-2. SQ2264.2 +032000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2264.2 +032100 03 FILLER PIC X VALUE SPACE. SQ2264.2 +032200 03 ENDER-DESC PIC X(44) VALUE SQ2264.2 +032300 "ERRORS ENCOUNTERED". SQ2264.2 +032400 01 CCVS-E-3. SQ2264.2 +032500 02 FILLER PIC X(22) VALUE SQ2264.2 +032600 " FOR OFFICIAL USE ONLY". SQ2264.2 +032700 02 FILLER PIC X(12) VALUE SPACE. SQ2264.2 +032800 02 FILLER PIC X(58) VALUE SQ2264.2 +032900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2264.2 +033000 02 FILLER PIC X(8) VALUE SPACE. SQ2264.2 +033100 02 FILLER PIC X(20) VALUE SQ2264.2 +033200 " COPYRIGHT 1985,1986". SQ2264.2 +033300 01 CCVS-E-4. SQ2264.2 +033400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2264.2 +033500 02 FILLER PIC X(4) VALUE " OF ". SQ2264.2 +033600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2264.2 +033700 02 FILLER PIC X(40) VALUE SQ2264.2 +033800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2264.2 +033900 01 XXINFO. SQ2264.2 +034000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2264.2 +034100 02 INFO-TEXT. SQ2264.2 +034200 04 FILLER PIC X(8) VALUE SPACE. SQ2264.2 +034300 04 XXCOMPUTED PIC X(20). SQ2264.2 +034400 04 FILLER PIC X(5) VALUE SPACE. SQ2264.2 +034500 04 XXCORRECT PIC X(20). SQ2264.2 +034600 02 INF-ANSI-REFERENCE PIC X(48). SQ2264.2 +034700 01 HYPHEN-LINE. SQ2264.2 +034800 02 FILLER PIC IS X VALUE IS SPACE. SQ2264.2 +034900 02 FILLER PIC IS X(65) VALUE IS "************************SQ2264.2 +035000- "*****************************************". SQ2264.2 +035100 02 FILLER PIC IS X(54) VALUE IS "************************SQ2264.2 +035200- "******************************". SQ2264.2 +035300 01 CCVS-PGM-ID PIC X(9) VALUE SQ2264.2 +035400 "SQ226A". SQ2264.2 +035500* SQ2264.2 +035600* SQ2264.2 +035700 PROCEDURE DIVISION. SQ2264.2 +035800 DECLARATIVES. SQ2264.2 +035900* SQ2264.2 +036000* FIRST, A DECLARATIVE FOR THE PRINT FILE, IN CASE THERE SQ2264.2 +036100* IS AN ERROR ON PRINTING DURING EXECUTION OF THE OUTPUT SQ2264.2 +036200* DECLARATIVE. PAGE VII-51, 4.6.4(7) STATES THAT THE SQ2264.2 +036300* INVOCATION OF THE SAME DECLARATIVE TWICE IS ILLEGAL. SQ2264.2 +036400* SQ2264.2 +036500 SECT-SQ226A-0000 SECTION. SQ2264.2 +036600 USE AFTER STANDARD ERROR PROCEDURE ON PRINT-FILE. SQ2264.2 +036700 PRINT-FILE-ERROR-PROCESS. SQ2264.2 +036800 EXIT. SQ2264.2 +036900* SQ2264.2 +037000 SECT-SQ226A-0001 SECTION. SQ2264.2 +037100 USE AFTER EXCEPTION PROCEDURE EXTEND. SQ2264.2 +037200 EXTEND-ERROR-PROCESS. SQ2264.2 +037300 MOVE "EXECUTED" TO DECL-EXEC-E. SQ2264.2 +037400 ADD 1 TO DECL-EXEC-CT. SQ2264.2 +037500 PERFORM OUTPUT-ERROR-PROCESS THRU END-DECLS. SQ2264.2 +037600* SQ2264.2 +037700 SECT-SQ226A-0002 SECTION. SQ2264.2 +037800 USE AFTER STANDARD ERROR PROCEDURE ON INPUT. SQ2264.2 +037900 INPUT-ERROR-PROCESS. SQ2264.2 +038000 MOVE "EXECUTED" TO DECL-EXEC-I. SQ2264.2 +038100 ADD 1 TO DECL-EXEC-CT. SQ2264.2 +038200 PERFORM OUTPUT-ERROR-PROCESS THRU END-DECLS. SQ2264.2 +038300* SQ2264.2 +038400 SECT-SQ226A-0003 SECTION. SQ2264.2 +038500 USE AFTER EXCEPTION PROCEDURE I-O. SQ2264.2 +038600 I-O-ERROR-PROCESS. SQ2264.2 +038700 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +038800 ADD 1 TO DECL-EXEC-CT. SQ2264.2 +038900 PERFORM OUTPUT-ERROR-PROCESS THRU END-DECLS. SQ2264.2 +039000* SQ2264.2 +039100 SECT-SQ226A-0004 SECTION. SQ2264.2 +039200 USE AFTER ERROR PROCEDURE OUTPUT. SQ2264.2 +039300 OUTPUT-ERROR-PROCESS. SQ2264.2 +039400 IF DECL-EXEC-CT = 0 SQ2264.2 +039500 MOVE "EXECUTED" TO DECL-EXEC-O SQ2264.2 +039600 ADD 1 TO DECL-EXEC-CT. SQ2264.2 +039700* SQ2264.2 +039800 IF DECL-EXEC-SW NOT = SPACE SQ2264.2 +039900 GO TO END-DECLS. SQ2264.2 +040000* SQ2264.2 +040100 MOVE 1 TO REC-CT. SQ2264.2 +040200 MOVE "OPEN EXTEND OPEN FILE" TO FEATURE. SQ2264.2 +040300 MOVE "DECL-OPEN-02" TO PAR-NAME. SQ2264.2 +040400 GO TO DECL-OPEN-02. SQ2264.2 +040500 DECL-DELETE-02. SQ2264.2 +040600 PERFORM DECL-DE-LETE. SQ2264.2 +040700 GO TO DECL-TEST-01-END. SQ2264.2 +040800 DECL-OPEN-02. SQ2264.2 +040900 IF SQ-FS4-STATUS = "41" SQ2264.2 +041000 PERFORM DECL-PASS SQ2264.2 +041100 ELSE SQ2264.2 +041200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +041300 MOVE "41" TO CORRECT-A SQ2264.2 +041400 MOVE "UNEXPECTED I-O STATUS ON OPEN OF OPEN FILE" SQ2264.2 +041500 TO RE-MARK SQ2264.2 +041600 MOVE "VII-3, VII-38,4.2.4(3)F" TO ANSI-REFERENCE SQ2264.2 +041700 PERFORM DECL-FAIL. SQ2264.2 +041800 DECL-TEST-01-END. SQ2264.2 +041900* SQ2264.2 +042000 PERFORM DECL-WRITE-LINE. SQ2264.2 +042100 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2264.2 +042200 TO DUMMY-RECORD. SQ2264.2 +042300 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2264.2 +042400 GO TO END-DECLS. SQ2264.2 +042500* SQ2264.2 +042600* SQ2264.2 +042700 DECL-PASS. SQ2264.2 +042800 MOVE "PASS " TO P-OR-F. SQ2264.2 +042900 ADD 1 TO PASS-COUNTER. SQ2264.2 +043000 PERFORM DECL-PRINT-DETAIL. SQ2264.2 +043100* SQ2264.2 +043200 DECL-FAIL. SQ2264.2 +043300 MOVE "FAIL*" TO P-OR-F. SQ2264.2 +043400 ADD 1 TO ERROR-COUNTER. SQ2264.2 +043500 PERFORM DECL-PRINT-DETAIL. SQ2264.2 +043600* SQ2264.2 +043700 DECL-DE-LETE. SQ2264.2 +043800 MOVE "****TEST DELETED****" TO RE-MARK. SQ2264.2 +043900 MOVE "*****" TO P-OR-F. SQ2264.2 +044000 ADD 1 TO DELETE-COUNTER. SQ2264.2 +044100 PERFORM DECL-PRINT-DETAIL. SQ2264.2 +044200* SQ2264.2 +044300 DECL-PRINT-DETAIL. SQ2264.2 +044400 IF REC-CT NOT EQUAL TO ZERO SQ2264.2 +044500 MOVE "." TO PARDOT-X SQ2264.2 +044600 MOVE REC-CT TO DOTVALUE. SQ2264.2 +044700 MOVE TEST-RESULTS TO PRINT-REC. SQ2264.2 +044800 PERFORM DECL-WRITE-LINE. SQ2264.2 +044900 IF P-OR-F EQUAL TO "FAIL*" SQ2264.2 +045000 PERFORM DECL-WRITE-LINE SQ2264.2 +045100 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2264.2 +045200 ELSE SQ2264.2 +045300 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2264.2 +045400 MOVE SPACE TO P-OR-F. SQ2264.2 +045500 MOVE SPACE TO COMPUTED-X. SQ2264.2 +045600 MOVE SPACE TO CORRECT-X. SQ2264.2 +045700 IF REC-CT EQUAL TO ZERO SQ2264.2 +045800 MOVE SPACE TO PAR-NAME. SQ2264.2 +045900 MOVE SPACE TO RE-MARK. SQ2264.2 +046000* SQ2264.2 +046100 DECL-WRITE-LINE. SQ2264.2 +046200 ADD 1 TO RECORD-COUNT. SQ2264.2 +046300 IF RECORD-COUNT GREATER 50 SQ2264.2 +046400 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2264.2 +046500 MOVE SPACE TO DUMMY-RECORD SQ2264.2 +046600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2264.2 +046700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2264.2 +046800 MOVE CCVS-C-2 TO DUMMY-RECORD SQ2264.2 +046900 PERFORM DECL-WRT-LN 2 TIMES SQ2264.2 +047000 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2264.2 +047100 PERFORM DECL-WRT-LN SQ2264.2 +047200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2264.2 +047300 MOVE ZERO TO RECORD-COUNT. SQ2264.2 +047400 PERFORM DECL-WRT-LN. SQ2264.2 +047500* SQ2264.2 +047600 DECL-WRT-LN. SQ2264.2 +047700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2264.2 +047800 MOVE SPACE TO DUMMY-RECORD. SQ2264.2 +047900* SQ2264.2 +048000 DECL-FAIL-ROUTINE. SQ2264.2 +048100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2264.2 +048200 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2264.2 +048300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2264.2 +048400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2264.2 +048500 MOVE XXINFO TO DUMMY-RECORD. SQ2264.2 +048600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2264.2 +048700 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2264.2 +048800 GO TO DECL-FAIL-EX. SQ2264.2 +048900 DECL-FAIL-WRITE. SQ2264.2 +049000 MOVE TEST-COMPUTED TO PRINT-REC SQ2264.2 +049100 PERFORM DECL-WRITE-LINE SQ2264.2 +049200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2264.2 +049300 MOVE TEST-CORRECT TO PRINT-REC SQ2264.2 +049400 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2264.2 +049500 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2264.2 +049600 DECL-FAIL-EX. SQ2264.2 +049700 EXIT. SQ2264.2 +049800* SQ2264.2 +049900 DECL-BAIL. SQ2264.2 +050000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2264.2 +050100 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2264.2 +050200 DECL-BAIL-WRITE. SQ2264.2 +050300 MOVE CORRECT-A TO XXCORRECT. SQ2264.2 +050400 MOVE COMPUTED-A TO XXCOMPUTED. SQ2264.2 +050500 MOVE XXINFO TO DUMMY-RECORD. SQ2264.2 +050600 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2264.2 +050700 DECL-BAIL-EX. SQ2264.2 +050800 EXIT. SQ2264.2 +050900* SQ2264.2 +051000 END-DECLS. SQ2264.2 +051100 END DECLARATIVES. SQ2264.2 +051200* SQ2264.2 +051300* SQ2264.2 +051400 CCVS1 SECTION. SQ2264.2 +051500 OPEN-FILES. SQ2264.2 +051600*P OPEN I-O RAW-DATA. SQ2264.2 +051700*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2264.2 +051800*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2264.2 +051900*P MOVE "ABORTED " TO C-ABORT. SQ2264.2 +052000*P ADD 1 TO C-NO-OF-TESTS. SQ2264.2 +052100*P ACCEPT C-DATE FROM DATE. SQ2264.2 +052200*P ACCEPT C-TIME FROM TIME. SQ2264.2 +052300*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2264.2 +052400*PND-E-1. SQ2264.2 +052500*P CLOSE RAW-DATA. SQ2264.2 +052600 OPEN OUTPUT PRINT-FILE. SQ2264.2 +052700 MOVE CCVS-PGM-ID TO TEST-ID. SQ2264.2 +052800 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2264.2 +052900 MOVE SPACE TO TEST-RESULTS. SQ2264.2 +053000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2264.2 +053100 MOVE ZERO TO REC-SKEL-SUB. SQ2264.2 +053200 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2264.2 +053300 GO TO CCVS1-EXIT. SQ2264.2 +053400* SQ2264.2 +053500 CCVS-INIT-FILE. SQ2264.2 +053600 ADD 1 TO REC-SKL-SUB. SQ2264.2 +053700 MOVE FILE-RECORD-INFO-SKELETON TO SQ2264.2 +053800 FILE-RECORD-INFO (REC-SKL-SUB). SQ2264.2 +053900* SQ2264.2 +054000 CLOSE-FILES. SQ2264.2 +054100 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2264.2 +054200 CLOSE PRINT-FILE. SQ2264.2 +054300*P OPEN I-O RAW-DATA. SQ2264.2 +054400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2264.2 +054500*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2264.2 +054600*P MOVE "OK. " TO C-ABORT. SQ2264.2 +054700*P MOVE PASS-COUNTER TO C-OK. SQ2264.2 +054800*P MOVE ERROR-HOLD TO C-ALL. SQ2264.2 +054900*P MOVE ERROR-COUNTER TO C-FAIL. SQ2264.2 +055000*P MOVE DELETE-CNT TO C-DELETED. SQ2264.2 +055100*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2264.2 +055200*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2264.2 +055300*PND-E-2. SQ2264.2 +055400*P CLOSE RAW-DATA. SQ2264.2 +055500 TERMINATE-CCVS. SQ2264.2 +055600*S EXIT PROGRAM. SQ2264.2 +055700 STOP RUN. SQ2264.2 +055800* SQ2264.2 +055900 INSPT. SQ2264.2 +056000 MOVE "INSPT" TO P-OR-F. SQ2264.2 +056100 ADD 1 TO INSPECT-COUNTER. SQ2264.2 +056200 PERFORM PRINT-DETAIL. SQ2264.2 +056300* SQ2264.2 +056400 PASS. SQ2264.2 +056500 MOVE "PASS " TO P-OR-F. SQ2264.2 +056600 ADD 1 TO PASS-COUNTER. SQ2264.2 +056700 PERFORM PRINT-DETAIL. SQ2264.2 +056800* SQ2264.2 +056900 FAIL. SQ2264.2 +057000 MOVE "FAIL*" TO P-OR-F. SQ2264.2 +057100 ADD 1 TO ERROR-COUNTER. SQ2264.2 +057200 PERFORM PRINT-DETAIL. SQ2264.2 +057300* SQ2264.2 +057400 DE-LETE. SQ2264.2 +057500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2264.2 +057600 MOVE "*****" TO P-OR-F. SQ2264.2 +057700 ADD 1 TO DELETE-COUNTER. SQ2264.2 +057800 PERFORM PRINT-DETAIL. SQ2264.2 +057900* SQ2264.2 +058000 PRINT-DETAIL. SQ2264.2 +058100 IF REC-CT NOT EQUAL TO ZERO SQ2264.2 +058200 MOVE "." TO PARDOT-X SQ2264.2 +058300 MOVE REC-CT TO DOTVALUE. SQ2264.2 +058400 MOVE TEST-RESULTS TO PRINT-REC. SQ2264.2 +058500 PERFORM WRITE-LINE. SQ2264.2 +058600 IF P-OR-F EQUAL TO "FAIL*" SQ2264.2 +058700 PERFORM WRITE-LINE SQ2264.2 +058800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2264.2 +058900 ELSE SQ2264.2 +059000 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2264.2 +059100 MOVE SPACE TO P-OR-F. SQ2264.2 +059200 MOVE SPACE TO COMPUTED-X. SQ2264.2 +059300 MOVE SPACE TO CORRECT-X. SQ2264.2 +059400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2264.2 +059500 MOVE SPACE TO RE-MARK. SQ2264.2 +059600* SQ2264.2 +059700 HEAD-ROUTINE. SQ2264.2 +059800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +059900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +060000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2264.2 +060100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2264.2 +060200 COLUMN-NAMES-ROUTINE. SQ2264.2 +060300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2264.2 +060400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +060500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2264.2 +060600 END-ROUTINE. SQ2264.2 +060700 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2264.2 +060800 PERFORM WRITE-LINE 5 TIMES. SQ2264.2 +060900 END-RTN-EXIT. SQ2264.2 +061000 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2264.2 +061100 PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +061200* SQ2264.2 +061300 END-ROUTINE-1. SQ2264.2 +061400 ADD ERROR-COUNTER TO ERROR-HOLD SQ2264.2 +061500 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2264.2 +061600 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2264.2 +061700 ADD PASS-COUNTER TO ERROR-HOLD. SQ2264.2 +061800 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2264.2 +061900 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2264.2 +062000 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2264.2 +062100 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2264.2 +062200 PERFORM WRITE-LINE. SQ2264.2 +062300 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2264.2 +062400 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2264.2 +062500 MOVE "NO " TO ERROR-TOTAL SQ2264.2 +062600 ELSE SQ2264.2 +062700 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2264.2 +062800 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2264.2 +062900 PERFORM WRITE-LINE. SQ2264.2 +063000 END-ROUTINE-13. SQ2264.2 +063100 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2264.2 +063200 MOVE "NO " TO ERROR-TOTAL SQ2264.2 +063300 ELSE SQ2264.2 +063400 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2264.2 +063500 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2264.2 +063600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2264.2 +063700 PERFORM WRITE-LINE. SQ2264.2 +063800 IF INSPECT-COUNTER EQUAL TO ZERO SQ2264.2 +063900 MOVE "NO " TO ERROR-TOTAL SQ2264.2 +064000 ELSE SQ2264.2 +064100 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2264.2 +064200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2264.2 +064300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2264.2 +064400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2264.2 +064500* SQ2264.2 +064600 WRITE-LINE. SQ2264.2 +064700 ADD 1 TO RECORD-COUNT. SQ2264.2 +064800 IF RECORD-COUNT GREATER 50 SQ2264.2 +064900 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2264.2 +065000 MOVE SPACE TO DUMMY-RECORD SQ2264.2 +065100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2264.2 +065200 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2264.2 +065300 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2264.2 +065400 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2264.2 +065500 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2264.2 +065600 MOVE ZERO TO RECORD-COUNT. SQ2264.2 +065700 PERFORM WRT-LN. SQ2264.2 +065800* SQ2264.2 +065900 WRT-LN. SQ2264.2 +066000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2264.2 +066100 MOVE SPACE TO DUMMY-RECORD. SQ2264.2 +066200 BLANK-LINE-PRINT. SQ2264.2 +066300 PERFORM WRT-LN. SQ2264.2 +066400 FAIL-ROUTINE. SQ2264.2 +066500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2264.2 +066600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2264.2 +066700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2264.2 +066800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2264.2 +066900 MOVE XXINFO TO DUMMY-RECORD. SQ2264.2 +067000 PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +067100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2264.2 +067200 GO TO FAIL-ROUTINE-EX. SQ2264.2 +067300 FAIL-ROUTINE-WRITE. SQ2264.2 +067400 MOVE TEST-COMPUTED TO PRINT-REC SQ2264.2 +067500 PERFORM WRITE-LINE SQ2264.2 +067600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2264.2 +067700 MOVE TEST-CORRECT TO PRINT-REC SQ2264.2 +067800 PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +067900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2264.2 +068000 FAIL-ROUTINE-EX. SQ2264.2 +068100 EXIT. SQ2264.2 +068200 BAIL-OUT. SQ2264.2 +068300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2264.2 +068400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2264.2 +068500 BAIL-OUT-WRITE. SQ2264.2 +068600 MOVE CORRECT-A TO XXCORRECT. SQ2264.2 +068700 MOVE COMPUTED-A TO XXCOMPUTED. SQ2264.2 +068800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2264.2 +068900 MOVE XXINFO TO DUMMY-RECORD. SQ2264.2 +069000 PERFORM WRITE-LINE 2 TIMES. SQ2264.2 +069100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2264.2 +069200 BAIL-OUT-EX. SQ2264.2 +069300 EXIT. SQ2264.2 +069400 CCVS1-EXIT. SQ2264.2 +069500 EXIT. SQ2264.2 +069600* SQ2264.2 +069700**************************************************************** SQ2264.2 +069800* * SQ2264.2 +069900* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2264.2 +070000* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2264.2 +070100* * SQ2264.2 +070200**************************************************************** SQ2264.2 +070300* SQ2264.2 +070400 SECT-SQ226A-0005 SECTION. SQ2264.2 +070500 STA-INIT. SQ2264.2 +070600 MOVE SPACE TO DELETE-SW. SQ2264.2 +070700* SQ2264.2 +070800 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ2264.2 +070900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2264.2 +071000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2264.2 +071100 MOVE 120 TO XRECORD-LENGTH (1). SQ2264.2 +071200 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ2264.2 +071300 MOVE 1 TO XBLOCK-SIZE (1). SQ2264.2 +071400 MOVE 1 TO RECORDS-IN-FILE (1). SQ2264.2 +071500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2264.2 +071600 MOVE "S" TO XLABEL-TYPE (1). SQ2264.2 +071700* SQ2264.2 +071800* OPEN THE FILE IN THE OUTPUT MODE SQ2264.2 +071900* SQ2264.2 +072000 SEQ-INIT-01. SQ2264.2 +072100 MOVE 0 TO REC-CT. SQ2264.2 +072200 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +072300 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +072400 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +072500 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +072600 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +072700 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +072800 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +072900 MOVE ZERO TO XRECORD-NUMBER (1). SQ2264.2 +073000 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ2264.2 +073100 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ2264.2 +073200 GO TO SEQ-TEST-OP-01. SQ2264.2 +073300 SEQ-DELETE-01. SQ2264.2 +073400 MOVE "*" TO DELETE-SW-1. SQ2264.2 +073500 GO TO SEQ-DELETE-01-01. SQ2264.2 +073600 SEQ-TEST-OP-01. SQ2264.2 +073700 OPEN OUTPUT SQ-FS4. SQ2264.2 +073800* SQ2264.2 +073900* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ2264.2 +074000* SQ2264.2 +074100 ADD 1 TO REC-CT. SQ2264.2 +074200 IF DELETE-SW NOT = SPACE SQ2264.2 +074300 GO TO SEQ-DELETE-01-01. SQ2264.2 +074400 GO TO SEQ-TEST-OP-01-01. SQ2264.2 +074500 SEQ-DELETE-01-01. SQ2264.2 +074600 PERFORM DE-LETE. SQ2264.2 +074700 GO TO SEQ-TEST-01-01-END. SQ2264.2 +074800 SEQ-TEST-OP-01-01. SQ2264.2 +074900 IF SQ-FS4-STATUS = "00" SQ2264.2 +075000 PERFORM PASS SQ2264.2 +075100 ELSE SQ2264.2 +075200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +075300 MOVE "00" TO CORRECT-A SQ2264.2 +075400 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ2264.2 +075500 TO RE-MARK SQ2264.2 +075600 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ2264.2 +075700 PERFORM FAIL. SQ2264.2 +075800 SEQ-TEST-01-01-END. SQ2264.2 +075900* SQ2264.2 +076000* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +076100* SQ2264.2 +076200 ADD 1 TO REC-CT. SQ2264.2 +076300 IF DELETE-SW NOT = SPACE SQ2264.2 +076400 GO TO SEQ-DELETE-01-02. SQ2264.2 +076500 GO TO SEQ-TEST-OP-01-02. SQ2264.2 +076600 SEQ-DELETE-01-02. SQ2264.2 +076700 PERFORM DE-LETE. SQ2264.2 +076800 GO TO SEQ-TEST-01-02-END. SQ2264.2 +076900 SEQ-TEST-OP-01-02. SQ2264.2 +077000 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +077100 PERFORM PASS SQ2264.2 +077200 ELSE SQ2264.2 +077300 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +077400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +077500 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +077600 TO RE-MARK SQ2264.2 +077700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +077800 PERFORM FAIL. SQ2264.2 +077900 SEQ-TEST-01-02-END. SQ2264.2 +078000* SQ2264.2 +078100* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +078200* SQ2264.2 +078300 ADD 1 TO REC-CT. SQ2264.2 +078400 IF DELETE-SW NOT = SPACE SQ2264.2 +078500 GO TO SEQ-DELETE-01-03. SQ2264.2 +078600 GO TO SEQ-TEST-OP-01-03. SQ2264.2 +078700 SEQ-DELETE-01-03. SQ2264.2 +078800 PERFORM DE-LETE. SQ2264.2 +078900 GO TO SEQ-TEST-01-03-END. SQ2264.2 +079000 SEQ-TEST-OP-01-03. SQ2264.2 +079100 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +079200 PERFORM PASS SQ2264.2 +079300 ELSE SQ2264.2 +079400 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +079500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +079600 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +079700 TO RE-MARK SQ2264.2 +079800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +079900 PERFORM FAIL. SQ2264.2 +080000 SEQ-TEST-01-03-END. SQ2264.2 +080100* SQ2264.2 +080200* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +080300* SQ2264.2 +080400 ADD 1 TO REC-CT. SQ2264.2 +080500 IF DELETE-SW NOT = SPACE SQ2264.2 +080600 GO TO SEQ-DELETE-01-04. SQ2264.2 +080700 GO TO SEQ-TEST-OP-01-04. SQ2264.2 +080800 SEQ-DELETE-01-04. SQ2264.2 +080900 PERFORM DE-LETE. SQ2264.2 +081000 GO TO SEQ-TEST-01-04-END. SQ2264.2 +081100 SEQ-TEST-OP-01-04. SQ2264.2 +081200 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +081300 PERFORM PASS SQ2264.2 +081400 ELSE SQ2264.2 +081500 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +081600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +081700 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +081800 TO RE-MARK SQ2264.2 +081900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +082000 PERFORM FAIL. SQ2264.2 +082100 SEQ-TEST-01-04-END. SQ2264.2 +082200* SQ2264.2 +082300* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +082400* SQ2264.2 +082500 ADD 1 TO REC-CT. SQ2264.2 +082600 IF DELETE-SW NOT = SPACE SQ2264.2 +082700 GO TO SEQ-DELETE-01-05. SQ2264.2 +082800 GO TO SEQ-TEST-OP-01-05. SQ2264.2 +082900 SEQ-DELETE-01-05. SQ2264.2 +083000 PERFORM DE-LETE. SQ2264.2 +083100 GO TO SEQ-TEST-01-05-END. SQ2264.2 +083200 SEQ-TEST-OP-01-05. SQ2264.2 +083300 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +083400 PERFORM PASS SQ2264.2 +083500 ELSE SQ2264.2 +083600 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +083700 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +083800 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +083900 TO RE-MARK SQ2264.2 +084000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +084100 PERFORM FAIL. SQ2264.2 +084200 SEQ-TEST-01-05-END. SQ2264.2 +084300* SQ2264.2 +084400* SQ2264.2 +084500* A NEW FILE IS OPEN. WE NOW WRITE ONE RECORD. SQ2264.2 +084600* SQ2264.2 +084700 SEQ-INIT-02. SQ2264.2 +084800 MOVE 0 TO REC-CT. SQ2264.2 +084900 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +085000 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +085100 ADD 1 TO XRECORD-NUMBER (1). SQ2264.2 +085200 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +085300 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +085400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +085500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +085600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +085700 MOVE "WRITE A RECORD" TO FEATURE. SQ2264.2 +085800 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ2264.2 +085900 IF DELETE-SW NOT EQUAL TO SPACE SQ2264.2 +086000 GO TO SEQ-DELETE-02. SQ2264.2 +086100 GO TO SEQ-TEST-WR-02. SQ2264.2 +086200 SEQ-DELETE-02. SQ2264.2 +086300 MOVE "*" TO DELETE-SW-2. SQ2264.2 +086400 GO TO SEQ-DELETE-02-01. SQ2264.2 +086500 SEQ-TEST-WR-02. SQ2264.2 +086600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2264.2 +086700 WRITE SQ-FS4R1-F-G-120. SQ2264.2 +086800* SQ2264.2 +086900* CHECK I-O STATUS RETURNED FROM WRITE SQ2264.2 +087000* SQ2264.2 +087100 ADD 1 TO REC-CT. SQ2264.2 +087200 IF DELETE-SW NOT = SPACE SQ2264.2 +087300 GO TO SEQ-DELETE-02-01. SQ2264.2 +087400 GO TO SEQ-TEST-WR-02-01. SQ2264.2 +087500 SEQ-DELETE-02-01. SQ2264.2 +087600 PERFORM DE-LETE. SQ2264.2 +087700 GO TO SEQ-TEST-02-01-END. SQ2264.2 +087800 SEQ-TEST-WR-02-01. SQ2264.2 +087900 IF SQ-FS4-STATUS = "00" SQ2264.2 +088000 PERFORM PASS SQ2264.2 +088100 ELSE SQ2264.2 +088200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +088300 MOVE "00" TO CORRECT-A SQ2264.2 +088400 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ2264.2 +088500 TO RE-MARK SQ2264.2 +088600 MOVE "VII-3, VII-53" TO ANSI-REFERENCE SQ2264.2 +088700 PERFORM FAIL. SQ2264.2 +088800 SEQ-TEST-02-01-END. SQ2264.2 +088900* SQ2264.2 +089000* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +089100* SQ2264.2 +089200 ADD 1 TO REC-CT. SQ2264.2 +089300 IF DELETE-SW NOT = SPACE SQ2264.2 +089400 GO TO SEQ-DELETE-02-02. SQ2264.2 +089500 GO TO SEQ-TEST-WR-02-02. SQ2264.2 +089600 SEQ-DELETE-02-02. SQ2264.2 +089700 PERFORM DE-LETE. SQ2264.2 +089800 GO TO SEQ-TEST-02-02-END. SQ2264.2 +089900 SEQ-TEST-WR-02-02. SQ2264.2 +090000 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +090100 PERFORM PASS SQ2264.2 +090200 ELSE SQ2264.2 +090300 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +090400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +090500 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +090600 TO RE-MARK SQ2264.2 +090700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +090800 PERFORM FAIL. SQ2264.2 +090900 SEQ-TEST-02-02-END. SQ2264.2 +091000* SQ2264.2 +091100* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +091200* SQ2264.2 +091300 ADD 1 TO REC-CT. SQ2264.2 +091400 IF DELETE-SW NOT = SPACE SQ2264.2 +091500 GO TO SEQ-DELETE-02-03. SQ2264.2 +091600 GO TO SEQ-TEST-WR-02-03. SQ2264.2 +091700 SEQ-DELETE-02-03. SQ2264.2 +091800 PERFORM DE-LETE. SQ2264.2 +091900 GO TO SEQ-TEST-02-03-END. SQ2264.2 +092000 SEQ-TEST-WR-02-03. SQ2264.2 +092100 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +092200 PERFORM PASS SQ2264.2 +092300 ELSE SQ2264.2 +092400 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +092500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +092600 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +092700 TO RE-MARK SQ2264.2 +092800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +092900 PERFORM FAIL. SQ2264.2 +093000 SEQ-TEST-02-03-END. SQ2264.2 +093100* SQ2264.2 +093200* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +093300* SQ2264.2 +093400 ADD 1 TO REC-CT. SQ2264.2 +093500 IF DELETE-SW NOT = SPACE SQ2264.2 +093600 GO TO SEQ-DELETE-02-04. SQ2264.2 +093700 GO TO SEQ-TEST-WR-02-04. SQ2264.2 +093800 SEQ-DELETE-02-04. SQ2264.2 +093900 PERFORM DE-LETE. SQ2264.2 +094000 GO TO SEQ-TEST-02-04-END. SQ2264.2 +094100 SEQ-TEST-WR-02-04. SQ2264.2 +094200 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +094300 PERFORM PASS SQ2264.2 +094400 ELSE SQ2264.2 +094500 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +094600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +094700 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +094800 TO RE-MARK SQ2264.2 +094900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +095000 PERFORM FAIL. SQ2264.2 +095100 SEQ-TEST-02-04-END. SQ2264.2 +095200* SQ2264.2 +095300* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +095400* SQ2264.2 +095500 ADD 1 TO REC-CT. SQ2264.2 +095600 IF DELETE-SW NOT = SPACE SQ2264.2 +095700 GO TO SEQ-DELETE-02-05. SQ2264.2 +095800 GO TO SEQ-TEST-WR-02-05. SQ2264.2 +095900 SEQ-DELETE-02-05. SQ2264.2 +096000 PERFORM DE-LETE. SQ2264.2 +096100 GO TO SEQ-TEST-02-05-END. SQ2264.2 +096200 SEQ-TEST-WR-02-05. SQ2264.2 +096300 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +096400 PERFORM PASS SQ2264.2 +096500 ELSE SQ2264.2 +096600 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +096700 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +096800 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +096900 TO RE-MARK SQ2264.2 +097000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +097100 PERFORM FAIL. SQ2264.2 +097200 SEQ-TEST-02-05-END. SQ2264.2 +097300 MOVE SPACE TO DELETE-SW-2. SQ2264.2 +097400* SQ2264.2 +097500* SQ2264.2 +097600* NOW CLOSE THE FILE. SQ2264.2 +097700* SQ2264.2 +097800 SEQ-INIT-03. SQ2264.2 +097900 MOVE 0 TO REC-CT. SQ2264.2 +098000 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +098100 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +098200 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +098300 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +098400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +098500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +098600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +098700 MOVE "CLOSE FILE" TO FEATURE. SQ2264.2 +098800 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ2264.2 +098900 IF DELETE-SW NOT EQUAL TO SPACE SQ2264.2 +099000 GO TO SEQ-DELETE-03. SQ2264.2 +099100 GO TO SEQ-TEST-CL-03. SQ2264.2 +099200 SEQ-DELETE-03. SQ2264.2 +099300 MOVE "*" TO DELETE-SW-2. SQ2264.2 +099400 GO TO SEQ-DELETE-03-01. SQ2264.2 +099500 SEQ-TEST-CL-03. SQ2264.2 +099600 CLOSE SQ-FS4. SQ2264.2 +099700* SQ2264.2 +099800* CHECK I-O STATUS RETURNED FROM CLOSE SQ2264.2 +099900* SQ2264.2 +100000 ADD 1 TO REC-CT. SQ2264.2 +100100 IF DELETE-SW NOT = SPACE SQ2264.2 +100200 GO TO SEQ-DELETE-03-01. SQ2264.2 +100300 GO TO SEQ-TEST-CL-03-01. SQ2264.2 +100400 SEQ-DELETE-03-01. SQ2264.2 +100500 PERFORM DE-LETE. SQ2264.2 +100600 GO TO SEQ-TEST-03-01-END. SQ2264.2 +100700 SEQ-TEST-CL-03-01. SQ2264.2 +100800 IF SQ-FS4-STATUS = "00" SQ2264.2 +100900 PERFORM PASS SQ2264.2 +101000 ELSE SQ2264.2 +101100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +101200 MOVE "00" TO CORRECT-A SQ2264.2 +101300 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ2264.2 +101400 TO RE-MARK SQ2264.2 +101500 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ2264.2 +101600 PERFORM FAIL. SQ2264.2 +101700 SEQ-TEST-03-01-END. SQ2264.2 +101800* SQ2264.2 +101900* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +102000* SQ2264.2 +102100 ADD 1 TO REC-CT. SQ2264.2 +102200 IF DELETE-SW NOT = SPACE SQ2264.2 +102300 GO TO SEQ-DELETE-03-02. SQ2264.2 +102400 GO TO SEQ-TEST-CL-03-02. SQ2264.2 +102500 SEQ-DELETE-03-02. SQ2264.2 +102600 PERFORM DE-LETE. SQ2264.2 +102700 GO TO SEQ-TEST-03-02-END. SQ2264.2 +102800 SEQ-TEST-CL-03-02. SQ2264.2 +102900 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +103000 PERFORM PASS SQ2264.2 +103100 ELSE SQ2264.2 +103200 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +103300 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +103400 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +103500 TO RE-MARK SQ2264.2 +103600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +103700 PERFORM FAIL. SQ2264.2 +103800 SEQ-TEST-03-02-END. SQ2264.2 +103900* SQ2264.2 +104000* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +104100* SQ2264.2 +104200 ADD 1 TO REC-CT. SQ2264.2 +104300 IF DELETE-SW NOT = SPACE SQ2264.2 +104400 GO TO SEQ-DELETE-03-03. SQ2264.2 +104500 GO TO SEQ-TEST-CL-03-03. SQ2264.2 +104600 SEQ-DELETE-03-03. SQ2264.2 +104700 PERFORM DE-LETE. SQ2264.2 +104800 GO TO SEQ-TEST-03-03-END. SQ2264.2 +104900 SEQ-TEST-CL-03-03. SQ2264.2 +105000 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +105100 PERFORM PASS SQ2264.2 +105200 ELSE SQ2264.2 +105300 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +105400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +105500 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +105600 TO RE-MARK SQ2264.2 +105700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +105800 PERFORM FAIL. SQ2264.2 +105900 SEQ-TEST-03-03-END. SQ2264.2 +106000* SQ2264.2 +106100* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +106200* SQ2264.2 +106300 ADD 1 TO REC-CT. SQ2264.2 +106400 IF DELETE-SW NOT = SPACE SQ2264.2 +106500 GO TO SEQ-DELETE-03-04. SQ2264.2 +106600 GO TO SEQ-TEST-CL-03-04. SQ2264.2 +106700 SEQ-DELETE-03-04. SQ2264.2 +106800 PERFORM DE-LETE. SQ2264.2 +106900 GO TO SEQ-TEST-03-04-END. SQ2264.2 +107000 SEQ-TEST-CL-03-04. SQ2264.2 +107100 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +107200 PERFORM PASS SQ2264.2 +107300 ELSE SQ2264.2 +107400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +107500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +107600 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +107700 TO RE-MARK SQ2264.2 +107800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +107900 PERFORM FAIL. SQ2264.2 +108000 SEQ-TEST-03-04-END. SQ2264.2 +108100* SQ2264.2 +108200* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +108300* SQ2264.2 +108400 ADD 1 TO REC-CT. SQ2264.2 +108500 IF DELETE-SW NOT = SPACE SQ2264.2 +108600 GO TO SEQ-DELETE-03-05. SQ2264.2 +108700 GO TO SEQ-TEST-CL-03-05. SQ2264.2 +108800 SEQ-DELETE-03-05. SQ2264.2 +108900 PERFORM DE-LETE. SQ2264.2 +109000 GO TO SEQ-TEST-03-05-END. SQ2264.2 +109100 SEQ-TEST-CL-03-05. SQ2264.2 +109200 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +109300 PERFORM PASS SQ2264.2 +109400 ELSE SQ2264.2 +109500 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +109600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +109700 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +109800 TO RE-MARK SQ2264.2 +109900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +110000 PERFORM FAIL. SQ2264.2 +110100 SEQ-TEST-03-05-END. SQ2264.2 +110200 MOVE SPACE TO DELETE-SW-2. SQ2264.2 +110300* SQ2264.2 +110400* SQ2264.2 +110500* OPEN THE FILE IN THE INPUT MODE SQ2264.2 +110600* SQ2264.2 +110700 SEQ-INIT-04. SQ2264.2 +110800 MOVE 0 TO REC-CT. SQ2264.2 +110900 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +111000 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +111100 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +111200 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +111300 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +111400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +111500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +111600 MOVE ZERO TO XRECORD-NUMBER (1). SQ2264.2 +111700 MOVE "OPEN FILE FOR INPUT" TO FEATURE. SQ2264.2 +111800 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ2264.2 +111900 IF DELETE-SW NOT = SPACE SQ2264.2 +112000 GO TO SEQ-DELETE-04-01. SQ2264.2 +112100 GO TO SEQ-TEST-OP-04. SQ2264.2 +112200 SEQ-DELETE-04. SQ2264.2 +112300 MOVE "*" TO DELETE-SW-2. SQ2264.2 +112400 GO TO SEQ-DELETE-04-01. SQ2264.2 +112500 SEQ-TEST-OP-04. SQ2264.2 +112600 OPEN INPUT SQ-FS4. SQ2264.2 +112700* SQ2264.2 +112800* CHECK I-O STATUS RETURNED FROM OPEN INPUT SQ2264.2 +112900* SQ2264.2 +113000 ADD 1 TO REC-CT. SQ2264.2 +113100 IF DELETE-SW NOT = SPACE SQ2264.2 +113200 GO TO SEQ-DELETE-04-01. SQ2264.2 +113300 GO TO SEQ-TEST-OP-04-01. SQ2264.2 +113400 SEQ-DELETE-04-01. SQ2264.2 +113500 PERFORM DE-LETE. SQ2264.2 +113600 GO TO SEQ-TEST-04-01-END. SQ2264.2 +113700 SEQ-TEST-OP-04-01. SQ2264.2 +113800 IF SQ-FS4-STATUS = "00" SQ2264.2 +113900 PERFORM PASS SQ2264.2 +114000 ELSE SQ2264.2 +114100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +114200 MOVE "00" TO CORRECT-A SQ2264.2 +114300 MOVE "UNEXPECTED ERROR CODE FROM OPEN INPUT" SQ2264.2 +114400 TO RE-MARK SQ2264.2 +114500 MOVE "VII-3, VII-40" TO ANSI-REFERENCE SQ2264.2 +114600 PERFORM FAIL. SQ2264.2 +114700 SEQ-TEST-04-01-END. SQ2264.2 +114800* SQ2264.2 +114900* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +115000* SQ2264.2 +115100 ADD 1 TO REC-CT. SQ2264.2 +115200 IF DELETE-SW NOT = SPACE SQ2264.2 +115300 GO TO SEQ-DELETE-04-02. SQ2264.2 +115400 GO TO SEQ-TEST-OP-04-02. SQ2264.2 +115500 SEQ-DELETE-04-02. SQ2264.2 +115600 PERFORM DE-LETE. SQ2264.2 +115700 GO TO SEQ-TEST-04-02-END. SQ2264.2 +115800 SEQ-TEST-OP-04-02. SQ2264.2 +115900 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +116000 PERFORM PASS SQ2264.2 +116100 ELSE SQ2264.2 +116200 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +116300 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +116400 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +116500 TO RE-MARK SQ2264.2 +116600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +116700 PERFORM FAIL. SQ2264.2 +116800 SEQ-TEST-04-02-END. SQ2264.2 +116900* SQ2264.2 +117000* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +117100* SQ2264.2 +117200 ADD 1 TO REC-CT. SQ2264.2 +117300 IF DELETE-SW NOT = SPACE SQ2264.2 +117400 GO TO SEQ-DELETE-04-03. SQ2264.2 +117500 GO TO SEQ-TEST-OP-04-03. SQ2264.2 +117600 SEQ-DELETE-04-03. SQ2264.2 +117700 PERFORM DE-LETE. SQ2264.2 +117800 GO TO SEQ-TEST-04-03-END. SQ2264.2 +117900 SEQ-TEST-OP-04-03. SQ2264.2 +118000 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +118100 PERFORM PASS SQ2264.2 +118200 ELSE SQ2264.2 +118300 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +118400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +118500 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +118600 TO RE-MARK SQ2264.2 +118700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +118800 PERFORM FAIL. SQ2264.2 +118900 SEQ-TEST-04-03-END. SQ2264.2 +119000* SQ2264.2 +119100* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +119200* SQ2264.2 +119300 ADD 1 TO REC-CT. SQ2264.2 +119400 IF DELETE-SW NOT = SPACE SQ2264.2 +119500 GO TO SEQ-DELETE-04-04. SQ2264.2 +119600 GO TO SEQ-TEST-OP-04-04. SQ2264.2 +119700 SEQ-DELETE-04-04. SQ2264.2 +119800 PERFORM DE-LETE. SQ2264.2 +119900 GO TO SEQ-TEST-04-04-END. SQ2264.2 +120000 SEQ-TEST-OP-04-04. SQ2264.2 +120100 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +120200 PERFORM PASS SQ2264.2 +120300 ELSE SQ2264.2 +120400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +120500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +120600 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +120700 TO RE-MARK SQ2264.2 +120800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +120900 PERFORM FAIL. SQ2264.2 +121000 SEQ-TEST-04-04-END. SQ2264.2 +121100* SQ2264.2 +121200* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +121300* SQ2264.2 +121400 ADD 1 TO REC-CT. SQ2264.2 +121500 IF DELETE-SW NOT = SPACE SQ2264.2 +121600 GO TO SEQ-DELETE-04-05. SQ2264.2 +121700 GO TO SEQ-TEST-OP-04-05. SQ2264.2 +121800 SEQ-DELETE-04-05. SQ2264.2 +121900 PERFORM DE-LETE. SQ2264.2 +122000 GO TO SEQ-TEST-04-05-END. SQ2264.2 +122100 SEQ-TEST-OP-04-05. SQ2264.2 +122200 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +122300 PERFORM PASS SQ2264.2 +122400 ELSE SQ2264.2 +122500 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +122600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +122700 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +122800 TO RE-MARK SQ2264.2 +122900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +123000 PERFORM FAIL. SQ2264.2 +123100 SEQ-TEST-04-05-END. SQ2264.2 +123200* SQ2264.2 +123300* SQ2264.2 +123400* THE FILE IS OPEN FOR INPUT. WE READ THE ONLY RECORD. SQ2264.2 +123500* SQ2264.2 +123600 SEQ-INIT-05. SQ2264.2 +123700 MOVE 0 TO REC-CT. SQ2264.2 +123800 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +123900 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +124000 ADD 1 TO XRECORD-NUMBER (1). SQ2264.2 +124100 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +124200 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +124300 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +124400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +124500 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +124600 MOVE "READ FIRST RECORD" TO FEATURE. SQ2264.2 +124700 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ2264.2 +124800 IF DELETE-SW NOT EQUAL TO SPACE SQ2264.2 +124900 GO TO SEQ-DELETE-05. SQ2264.2 +125000 GO TO SEQ-TEST-RD-05. SQ2264.2 +125100 SEQ-DELETE-05. SQ2264.2 +125200 MOVE "*" TO DELETE-SW-2. SQ2264.2 +125300 GO TO SEQ-DELETE-05-01. SQ2264.2 +125400 SEQ-TEST-RD-05. SQ2264.2 +125500 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ2264.2 +125600 READ SQ-FS4. SQ2264.2 +125700* SQ2264.2 +125800* CHECK I-O STATUS RETURNED FROM READ SQ2264.2 +125900* SQ2264.2 +126000 ADD 1 TO REC-CT. SQ2264.2 +126100 IF DELETE-SW NOT = SPACE SQ2264.2 +126200 GO TO SEQ-DELETE-05-01. SQ2264.2 +126300 GO TO SEQ-TEST-RD-05-01. SQ2264.2 +126400 SEQ-DELETE-05-01. SQ2264.2 +126500 PERFORM DE-LETE. SQ2264.2 +126600 GO TO SEQ-TEST-05-01-END. SQ2264.2 +126700 SEQ-TEST-RD-05-01. SQ2264.2 +126800 IF SQ-FS4-STATUS = "00" SQ2264.2 +126900 PERFORM PASS SQ2264.2 +127000 ELSE SQ2264.2 +127100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +127200 MOVE "00" TO CORRECT-A SQ2264.2 +127300 MOVE "UNEXPECTED STATUS CODE FROM READ" SQ2264.2 +127400 TO RE-MARK SQ2264.2 +127500 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ2264.2 +127600 PERFORM FAIL. SQ2264.2 +127700 SEQ-TEST-05-01-END. SQ2264.2 +127800* SQ2264.2 +127900* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +128000* SQ2264.2 +128100 ADD 1 TO REC-CT. SQ2264.2 +128200 IF DELETE-SW NOT = SPACE SQ2264.2 +128300 GO TO SEQ-DELETE-05-02. SQ2264.2 +128400 GO TO SEQ-TEST-RD-05-02. SQ2264.2 +128500 SEQ-DELETE-05-02. SQ2264.2 +128600 PERFORM DE-LETE. SQ2264.2 +128700 GO TO SEQ-TEST-05-02-END. SQ2264.2 +128800 SEQ-TEST-RD-05-02. SQ2264.2 +128900 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +129000 PERFORM PASS SQ2264.2 +129100 ELSE SQ2264.2 +129200 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +129300 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +129400 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +129500 TO RE-MARK SQ2264.2 +129600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +129700 PERFORM FAIL. SQ2264.2 +129800 SEQ-TEST-05-02-END. SQ2264.2 +129900* SQ2264.2 +130000* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +130100* SQ2264.2 +130200 ADD 1 TO REC-CT. SQ2264.2 +130300 IF DELETE-SW NOT = SPACE SQ2264.2 +130400 GO TO SEQ-DELETE-05-03. SQ2264.2 +130500 GO TO SEQ-TEST-RD-05-03. SQ2264.2 +130600 SEQ-DELETE-05-03. SQ2264.2 +130700 PERFORM DE-LETE. SQ2264.2 +130800 GO TO SEQ-TEST-05-03-END. SQ2264.2 +130900 SEQ-TEST-RD-05-03. SQ2264.2 +131000 IF DECL-EXEC-I = "NOT EXECUTED" SQ2264.2 +131100 PERFORM PASS SQ2264.2 +131200 ELSE SQ2264.2 +131300 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +131400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +131500 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +131600 TO RE-MARK SQ2264.2 +131700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +131800 PERFORM FAIL. SQ2264.2 +131900 SEQ-TEST-05-03-END. SQ2264.2 +132000* SQ2264.2 +132100* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +132200* SQ2264.2 +132300 ADD 1 TO REC-CT. SQ2264.2 +132400 IF DELETE-SW NOT = SPACE SQ2264.2 +132500 GO TO SEQ-DELETE-05-04. SQ2264.2 +132600 GO TO SEQ-TEST-RD-05-04. SQ2264.2 +132700 SEQ-DELETE-05-04. SQ2264.2 +132800 PERFORM DE-LETE. SQ2264.2 +132900 GO TO SEQ-TEST-05-04-END. SQ2264.2 +133000 SEQ-TEST-RD-05-04. SQ2264.2 +133100 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +133200 PERFORM PASS SQ2264.2 +133300 ELSE SQ2264.2 +133400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +133500 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +133600 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +133700 TO RE-MARK SQ2264.2 +133800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +133900 PERFORM FAIL. SQ2264.2 +134000 SEQ-TEST-05-04-END. SQ2264.2 +134100* SQ2264.2 +134200* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +134300* SQ2264.2 +134400 ADD 1 TO REC-CT. SQ2264.2 +134500 IF DELETE-SW NOT = SPACE SQ2264.2 +134600 GO TO SEQ-DELETE-05-05. SQ2264.2 +134700 GO TO SEQ-TEST-RD-05-05. SQ2264.2 +134800 SEQ-DELETE-05-05. SQ2264.2 +134900 PERFORM DE-LETE. SQ2264.2 +135000 GO TO SEQ-TEST-05-05-END. SQ2264.2 +135100 SEQ-TEST-RD-05-05. SQ2264.2 +135200 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +135300 PERFORM PASS SQ2264.2 +135400 ELSE SQ2264.2 +135500 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +135600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +135700 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +135800 TO RE-MARK SQ2264.2 +135900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +136000 PERFORM FAIL. SQ2264.2 +136100 SEQ-TEST-05-05-END. SQ2264.2 +136200* SQ2264.2 +136300* CHECK THAT THE CORRECT RECORD HAS BEEN RETURNED, BY SQ2264.2 +136400* CHECKING THE RECORD-NUMBER FIELD. SQ2264.2 +136500* SQ2264.2 +136600 ADD 1 TO REC-CT. SQ2264.2 +136700 IF DELETE-SW NOT = SPACE SQ2264.2 +136800 GO TO SEQ-DELETE-05-06. SQ2264.2 +136900 GO TO SEQ-TEST-RD-05-06. SQ2264.2 +137000 SEQ-DELETE-05-06. SQ2264.2 +137100 PERFORM DE-LETE. SQ2264.2 +137200 GO TO SEQ-TEST-05-06-END. SQ2264.2 +137300 SEQ-TEST-RD-05-06. SQ2264.2 +137400 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ2264.2 +137500 PERFORM PASS SQ2264.2 +137600 ELSE SQ2264.2 +137700 MOVE FRECORD-NUMBER TO COMPUTED-18V0 SQ2264.2 +137800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0 SQ2264.2 +137900 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ2264.2 +138000 PERFORM FAIL. SQ2264.2 +138100 SEQ-TEST-05-06-END. SQ2264.2 +138200 MOVE SPACE TO DELETE-SW-2. SQ2264.2 +138300* SQ2264.2 +138400* SQ2264.2 +138500* ANOTHER READ SHOULD CAUSE THE AT END CONDITION. SQ2264.2 +138600* SQ2264.2 +138700 SEQ-INIT-06. SQ2264.2 +138800 MOVE 0 TO REC-CT. SQ2264.2 +138900 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +139000 MOVE "*" TO DECL-EXEC-SW. SQ2264.2 +139100 ADD 1 TO XRECORD-NUMBER (1). SQ2264.2 +139200 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +139300 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +139400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +139500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +139600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +139700 MOVE "READ GIVING AT END" TO FEATURE. SQ2264.2 +139800 MOVE "SEQ-TEST-RD-06" TO PAR-NAME. SQ2264.2 +139900 IF DELETE-SW NOT EQUAL TO SPACE SQ2264.2 +140000 GO TO SEQ-DELETE-06. SQ2264.2 +140100 GO TO SEQ-TEST-RD-06. SQ2264.2 +140200 SEQ-DELETE-06. SQ2264.2 +140300 MOVE "*" TO DELETE-SW-2. SQ2264.2 +140400 GO TO SEQ-DELETE-06-01. SQ2264.2 +140500 SEQ-TEST-RD-06. SQ2264.2 +140600 MOVE SPACE TO SQ-FS4R1-F-G-120. SQ2264.2 +140700 READ SQ-FS4 RECORD. SQ2264.2 +140800* SQ2264.2 +140900* CHECK I-O STATUS RETURNED FROM READ SQ2264.2 +141000* SQ2264.2 +141100 ADD 1 TO REC-CT. SQ2264.2 +141200 IF DELETE-SW NOT = SPACE SQ2264.2 +141300 GO TO SEQ-DELETE-06-01. SQ2264.2 +141400 GO TO SEQ-TEST-RD-06-01. SQ2264.2 +141500 SEQ-DELETE-06-01. SQ2264.2 +141600 PERFORM DE-LETE. SQ2264.2 +141700 GO TO SEQ-TEST-06-01-END. SQ2264.2 +141800 SEQ-TEST-RD-06-01. SQ2264.2 +141900 IF SQ-FS4-STATUS = "10" SQ2264.2 +142000 PERFORM PASS SQ2264.2 +142100 ELSE SQ2264.2 +142200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +142300 MOVE "10" TO CORRECT-A SQ2264.2 +142400 MOVE "AT END STATUS NOT RETURNED FROM READ" SQ2264.2 +142500 TO RE-MARK SQ2264.2 +142600 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ2264.2 +142700 PERFORM FAIL. SQ2264.2 +142800 SEQ-TEST-06-01-END. SQ2264.2 +142900* SQ2264.2 +143000* CHECK EXECUTION OF EXTEND DECLARATIVE SQ2264.2 +143100* SQ2264.2 +143200 ADD 1 TO REC-CT. SQ2264.2 +143300 IF DELETE-SW NOT = SPACE SQ2264.2 +143400 GO TO SEQ-DELETE-06-02. SQ2264.2 +143500 GO TO SEQ-TEST-RD-06-02. SQ2264.2 +143600 SEQ-DELETE-06-02. SQ2264.2 +143700 PERFORM DE-LETE. SQ2264.2 +143800 GO TO SEQ-TEST-06-02-END. SQ2264.2 +143900 SEQ-TEST-RD-06-02. SQ2264.2 +144000 IF DECL-EXEC-E = "NOT EXECUTED" SQ2264.2 +144100 PERFORM PASS SQ2264.2 +144200 ELSE SQ2264.2 +144300 MOVE DECL-EXEC-E TO COMPUTED-A SQ2264.2 +144400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +144500 MOVE "UNEXPECTED EXECUTION OF EXTEND DECLARATIVE" SQ2264.2 +144600 TO RE-MARK SQ2264.2 +144700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +144800 PERFORM FAIL. SQ2264.2 +144900 SEQ-TEST-06-02-END. SQ2264.2 +145000* SQ2264.2 +145100* CHECK EXECUTION OF INPUT DECLARATIVE SQ2264.2 +145200* SQ2264.2 +145300 ADD 1 TO REC-CT. SQ2264.2 +145400 IF DELETE-SW NOT = SPACE SQ2264.2 +145500 GO TO SEQ-DELETE-06-03. SQ2264.2 +145600 GO TO SEQ-TEST-RD-06-03. SQ2264.2 +145700 SEQ-DELETE-06-03. SQ2264.2 +145800 PERFORM DE-LETE. SQ2264.2 +145900 GO TO SEQ-TEST-06-03-END. SQ2264.2 +146000 SEQ-TEST-RD-06-03. SQ2264.2 +146100 IF DECL-EXEC-I = "EXECUTED" SQ2264.2 +146200 PERFORM PASS SQ2264.2 +146300 ELSE SQ2264.2 +146400 MOVE DECL-EXEC-I TO COMPUTED-A SQ2264.2 +146500 MOVE "EXECUTED" TO CORRECT-A SQ2264.2 +146600 MOVE "INPUT DECLARATIVE NOT EXECUTED AT END OF FILE" SQ2264.2 +146700 TO RE-MARK SQ2264.2 +146800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +146900 PERFORM FAIL. SQ2264.2 +147000 SEQ-TEST-06-03-END. SQ2264.2 +147100* SQ2264.2 +147200* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +147300* SQ2264.2 +147400 ADD 1 TO REC-CT. SQ2264.2 +147500 IF DELETE-SW NOT = SPACE SQ2264.2 +147600 GO TO SEQ-DELETE-06-04. SQ2264.2 +147700 GO TO SEQ-TEST-RD-06-04. SQ2264.2 +147800 SEQ-DELETE-06-04. SQ2264.2 +147900 PERFORM DE-LETE. SQ2264.2 +148000 GO TO SEQ-TEST-06-04-END. SQ2264.2 +148100 SEQ-TEST-RD-06-04. SQ2264.2 +148200 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +148300 PERFORM PASS SQ2264.2 +148400 ELSE SQ2264.2 +148500 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +148600 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +148700 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +148800 TO RE-MARK SQ2264.2 +148900 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +149000 PERFORM FAIL. SQ2264.2 +149100 SEQ-TEST-06-04-END. SQ2264.2 +149200* SQ2264.2 +149300* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +149400* SQ2264.2 +149500 ADD 1 TO REC-CT. SQ2264.2 +149600 IF DELETE-SW NOT = SPACE SQ2264.2 +149700 GO TO SEQ-DELETE-06-05. SQ2264.2 +149800 GO TO SEQ-TEST-RD-06-05. SQ2264.2 +149900 SEQ-DELETE-06-05. SQ2264.2 +150000 PERFORM DE-LETE. SQ2264.2 +150100 GO TO SEQ-TEST-06-05-END. SQ2264.2 +150200 SEQ-TEST-RD-06-05. SQ2264.2 +150300 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +150400 PERFORM PASS SQ2264.2 +150500 ELSE SQ2264.2 +150600 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +150700 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +150800 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +150900 TO RE-MARK SQ2264.2 +151000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +151100 PERFORM FAIL. SQ2264.2 +151200 SEQ-TEST-06-05-END. SQ2264.2 +151300 MOVE SPACE TO DELETE-SW-2. SQ2264.2 +151400* SQ2264.2 +151500* SQ2264.2 +151600* FINALLY, TRY TO OPEN THE FILE AGAIN, IN THE EXTEND MODE SQ2264.2 +151700* SQ2264.2 +151800 SEQ-INIT-07. SQ2264.2 +151900 MOVE 0 TO REC-CT. SQ2264.2 +152000 MOVE 0 TO DECL-EXEC-CT. SQ2264.2 +152100 MOVE SPACE TO DECL-EXEC-SW. SQ2264.2 +152200 MOVE "**" TO SQ-FS4-STATUS. SQ2264.2 +152300 MOVE "NOT EXECUTED" TO DECL-EXEC-E. SQ2264.2 +152400 MOVE "NOT EXECUTED" TO DECL-EXEC-I. SQ2264.2 +152500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2264.2 +152600 MOVE "NOT EXECUTED" TO DECL-EXEC-O. SQ2264.2 +152700 MOVE ZERO TO XRECORD-NUMBER (1). SQ2264.2 +152800 MOVE "OPEN FILE SECOND TIME" TO FEATURE. SQ2264.2 +152900 MOVE "SEQ-TEST-OP-07" TO PAR-NAME. SQ2264.2 +153000 IF DELETE-SW NOT = SPACE SQ2264.2 +153100 GO TO SEQ-DELETE-07-01. SQ2264.2 +153200 GO TO SEQ-TEST-OP-07. SQ2264.2 +153300 SEQ-DELETE-07. SQ2264.2 +153400 MOVE "*" TO DELETE-SW-2. SQ2264.2 +153500 GO TO SEQ-DELETE-07-01. SQ2264.2 +153600 SEQ-TEST-OP-07. SQ2264.2 +153700 OPEN EXTEND SQ-FS4. SQ2264.2 +153800 MOVE 0 TO REC-CT. SQ2264.2 +153900 MOVE "OPEN FILE SECOND TIME" TO FEATURE. SQ2264.2 +154000 MOVE "SEQ-TEST-OP-07" TO PAR-NAME. SQ2264.2 +154100* SQ2264.2 +154200* CHECK I-O STATUS RETURNED FROM OPEN EXTEND SQ2264.2 +154300* SQ2264.2 +154400 ADD 1 TO REC-CT. SQ2264.2 +154500 IF DELETE-SW NOT = SPACE SQ2264.2 +154600 GO TO SEQ-DELETE-07-01. SQ2264.2 +154700 GO TO SEQ-TEST-OP-07-01. SQ2264.2 +154800 SEQ-DELETE-07-01. SQ2264.2 +154900 PERFORM DE-LETE. SQ2264.2 +155000 GO TO SEQ-TEST-07-01-END. SQ2264.2 +155100 SEQ-TEST-OP-07-01. SQ2264.2 +155200 IF SQ-FS4-STATUS = "41" SQ2264.2 +155300 PERFORM PASS SQ2264.2 +155400 ELSE SQ2264.2 +155500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2264.2 +155600 MOVE "41" TO CORRECT-A SQ2264.2 +155700 MOVE "UNEXPECTED STATUS CODE FROM SECOND OPEN" SQ2264.2 +155800 TO RE-MARK SQ2264.2 +155900 MOVE "VII-4,1.5.3(4)A, VII-40" TO ANSI-REFERENCE SQ2264.2 +156000 PERFORM FAIL. SQ2264.2 +156100 SEQ-TEST-07-01-END. SQ2264.2 +156200* SQ2264.2 +156300* CHECK EXECUTION OF EXTEND AND INPUT DECLARATIVES SQ2264.2 +156400* SQ2264.2 +156500 ADD 1 TO REC-CT. SQ2264.2 +156600 IF DELETE-SW NOT = SPACE SQ2264.2 +156700 GO TO SEQ-DELETE-07-02. SQ2264.2 +156800 GO TO SEQ-TEST-OP-07-02. SQ2264.2 +156900 SEQ-DELETE-07-02. SQ2264.2 +157000 PERFORM DE-LETE. SQ2264.2 +157100 GO TO SEQ-TEST-07-02-END. SQ2264.2 +157200 SEQ-TEST-OP-07-02. SQ2264.2 +157300 IF DECL-EXEC-E = "EXECUTED" OR DECL-EXEC-I = "EXECUTED" SQ2264.2 +157400 PERFORM PASS SQ2264.2 +157500 ELSE SQ2264.2 +157600 MOVE "DECL NOT EXECUTED" TO COMPUTED-A SQ2264.2 +157700 MOVE "EXECUTED" TO CORRECT-A SQ2264.2 +157800 MOVE "EXECUTION OF ONE DECLARATIVE EXPECTED" SQ2264.2 +157900 TO RE-MARK SQ2264.2 +158000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +158100 PERFORM FAIL. SQ2264.2 +158200 SEQ-TEST-07-02-END. SQ2264.2 +158300* SQ2264.2 +158400* CHECK NUMBER OF DECLARATIVES EXECUTED SQ2264.2 +158500* SQ2264.2 +158600 ADD 1 TO REC-CT. SQ2264.2 +158700 IF DELETE-SW NOT = SPACE SQ2264.2 +158800 GO TO SEQ-DELETE-07-03. SQ2264.2 +158900 GO TO SEQ-TEST-OP-07-03. SQ2264.2 +159000 SEQ-DELETE-07-03. SQ2264.2 +159100 PERFORM DE-LETE. SQ2264.2 +159200 GO TO SEQ-TEST-07-03-END. SQ2264.2 +159300 SEQ-TEST-OP-07-03. SQ2264.2 +159400 IF DECL-EXEC-CT = 1 SQ2264.2 +159500 PERFORM PASS SQ2264.2 +159600 ELSE SQ2264.2 +159700 MOVE DECL-EXEC-CT TO COMPUTED-18V0 SQ2264.2 +159800 MOVE 1 TO CORRECT-18V0 SQ2264.2 +159900 MOVE "ONLY ONE EXECUTION OF A DECLARATIVE EXPECTED" SQ2264.2 +160000 TO RE-MARK SQ2264.2 +160100 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +160200 PERFORM FAIL. SQ2264.2 +160300 SEQ-TEST-07-03-END. SQ2264.2 +160400* SQ2264.2 +160500* CHECK EXECUTION OF I-O DECLARATIVE SQ2264.2 +160600* SQ2264.2 +160700 ADD 1 TO REC-CT. SQ2264.2 +160800 IF DELETE-SW NOT = SPACE SQ2264.2 +160900 GO TO SEQ-DELETE-07-04. SQ2264.2 +161000 GO TO SEQ-TEST-OP-07-04. SQ2264.2 +161100 SEQ-DELETE-07-04. SQ2264.2 +161200 PERFORM DE-LETE. SQ2264.2 +161300 GO TO SEQ-TEST-07-04-END. SQ2264.2 +161400 SEQ-TEST-OP-07-04. SQ2264.2 +161500 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2264.2 +161600 PERFORM PASS SQ2264.2 +161700 ELSE SQ2264.2 +161800 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2264.2 +161900 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +162000 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2264.2 +162100 TO RE-MARK SQ2264.2 +162200 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +162300 PERFORM FAIL. SQ2264.2 +162400 SEQ-TEST-07-04-END. SQ2264.2 +162500* SQ2264.2 +162600* CHECK EXECUTION OF OUTPUT DECLARATIVE SQ2264.2 +162700* SQ2264.2 +162800 ADD 1 TO REC-CT. SQ2264.2 +162900 IF DELETE-SW NOT = SPACE SQ2264.2 +163000 GO TO SEQ-DELETE-07-05. SQ2264.2 +163100 GO TO SEQ-TEST-OP-07-05. SQ2264.2 +163200 SEQ-DELETE-07-05. SQ2264.2 +163300 PERFORM DE-LETE. SQ2264.2 +163400 GO TO SEQ-TEST-07-05-END. SQ2264.2 +163500 SEQ-TEST-OP-07-05. SQ2264.2 +163600 IF DECL-EXEC-O = "NOT EXECUTED" SQ2264.2 +163700 PERFORM PASS SQ2264.2 +163800 ELSE SQ2264.2 +163900 MOVE DECL-EXEC-O TO COMPUTED-A SQ2264.2 +164000 MOVE "NOT EXECUTED" TO CORRECT-A SQ2264.2 +164100 MOVE "UNEXPECTED EXECUTION OF INPUT DECLARATIVE" SQ2264.2 +164200 TO RE-MARK SQ2264.2 +164300 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2264.2 +164400 PERFORM FAIL. SQ2264.2 +164500 SEQ-TEST-07-05-END. SQ2264.2 +164600* SQ2264.2 +164700* SQ2264.2 +164800 CCVS-EXIT SECTION. SQ2264.2 +164900 CCVS-999999. SQ2264.2 +165000 GO TO CLOSE-FILES. SQ2264.2 diff --git a/tests/cobol85/SQ/SQ227A.CBL b/tests/cobol85/SQ/SQ227A.CBL new file mode 100755 index 00000000..4887ac77 --- /dev/null +++ b/tests/cobol85/SQ/SQ227A.CBL @@ -0,0 +1,1112 @@ +000100 IDENTIFICATION DIVISION. SQ2274.2 +000200 PROGRAM-ID. SQ2274.2 +000300 SQ227A. SQ2274.2 +000400**************************************************************** SQ2274.2 +000500* * SQ2274.2 +000600* VALIDATION FOR:- * SQ2274.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2274.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2274.2 +000900* REVISED 1986, AUGUST * SQ2274.2 +001000* * SQ2274.2 +001100* CREATION DATE / VALIDATION DATE * SQ2274.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2274.2 +001300* * SQ2274.2 +001400**************************************************************** SQ2274.2 +001500* * SQ2274.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2274.2 +001700* * SQ2274.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ2274.2 +001900* X-55 SYSTEM PRINTER * SQ2274.2 +002000* X-82 SOURCE-COMPUTER * SQ2274.2 +002100* X-83 OBJECT-COMPUTER. * SQ2274.2 +002200* * SQ2274.2 +002300**************************************************************** SQ2274.2 +002400* * SQ2274.2 +002500* THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED * SQ2274.2 +002600* TO A MASS STORAGE MEDIUM. ONE RECORD IS THEN WRITTEN TO * SQ2274.2 +002700* THIS FILE WHICH IS THEN CLOSED. THE FILE IS THEN OPENED * SQ2274.2 +002800* FOR I-O, AND A READ STATEMENT ON THE FILE IS CARRIED OUT. * SQ2274.2 +002900* A REWRITE ON A RECORD THAT IS TOO LONG FOR THE FILE IS * SQ2274.2 +003000* ATTEMPTED WHICH SHOULD CAUSE AN EXCEPTION CONDITION WITH * SQ2274.2 +003100* I-O STATUS "44". THIS LOGIC ERROR SHOULD CAUSE ENTRY TO * SQ2274.2 +003200* THE APPLICABLE ERROR DECLARATIVE. * SQ2274.2 +003300* * SQ2274.2 +003400* THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS. * SQ2274.2 +003500* THE NEW PROGRAM IS SQ228A. * SQ2274.2 +003600**************************************************************** SQ2274.2 +003700* SQ2274.2 +003800 ENVIRONMENT DIVISION. SQ2274.2 +003900 CONFIGURATION SECTION. SQ2274.2 +004000 SOURCE-COMPUTER. SQ2274.2 +004100 Linux. SQ2274.2 +004200 OBJECT-COMPUTER. SQ2274.2 +004300 Linux. SQ2274.2 +004400* SQ2274.2 +004500 INPUT-OUTPUT SECTION. SQ2274.2 +004600 FILE-CONTROL. SQ2274.2 +004700 SELECT PRINT-FILE ASSIGN TO SQ2274.2 +004800 "report.log". SQ2274.2 +004900* SQ2274.2 +005000*P SELECT RAW-DATA ASSIGN TO SQ2274.2 +005100*P "XXXXX062" SQ2274.2 +005200*P ORGANIZATION IS INDEXED SQ2274.2 +005300*P ACCESS MODE IS RANDOM SQ2274.2 +005400*P RECORD-KEY IS RAW-DATA-KEY. SQ2274.2 +005500*P SQ2274.2 +005600 SELECT SQ-FS4 SQ2274.2 +005700 ASSIGN SQ2274.2 +005800 "XXXXX014" SQ2274.2 +005900 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ2274.2 +006000 ACCESS MODE IS SEQUENTIAL SQ2274.2 +006100 ORGANIZATION IS SEQUENTIAL SQ2274.2 +006200 . SQ2274.2 +006300* SQ2274.2 +006400* SQ2274.2 +006500 DATA DIVISION. SQ2274.2 +006600 FILE SECTION. SQ2274.2 +006700 FD PRINT-FILE SQ2274.2 +006800*C LABEL RECORDS SQ2274.2 +006900*C OMITTED SQ2274.2 +007000*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2274.2 +007100 . SQ2274.2 +007200 01 PRINT-REC PICTURE X(120). SQ2274.2 +007300 01 DUMMY-RECORD PICTURE X(120). SQ2274.2 +007400*P SQ2274.2 +007500*PD RAW-DATA. SQ2274.2 +007600*P1 RAW-DATA-SATZ. SQ2274.2 +007700*P 05 RAW-DATA-KEY PIC X(6). SQ2274.2 +007800*P 05 C-DATE PIC 9(6). SQ2274.2 +007900*P 05 C-TIME PIC 9(8). SQ2274.2 +008000*P 05 NO-OF-TESTS PIC 99. SQ2274.2 +008100*P 05 C-OK PIC 999. SQ2274.2 +008200*P 05 C-ALL PIC 999. SQ2274.2 +008300*P 05 C-FAIL PIC 999. SQ2274.2 +008400*P 05 C-DELETED PIC 999. SQ2274.2 +008500*P 05 C-INSPECT PIC 999. SQ2274.2 +008600*P 05 C-NOTE PIC X(13). SQ2274.2 +008700*P 05 C-INDENT PIC X. SQ2274.2 +008800*P 05 C-ABORT PIC X(8). SQ2274.2 +008900* SQ2274.2 +009000 FD SQ-FS4 SQ2274.2 +009100*C LABEL RECORD IS STANDARD SQ2274.2 +009200 BLOCK CONTAINS 138 CHARACTERS SQ2274.2 +009300 RECORD VARYING SIZE FROM 50 TO 138 CHARACTERS SQ2274.2 +009400 DEPENDING ON SQ-FS4-RECSIZE SQ2274.2 +009500 . SQ2274.2 +009600 01 SQ-FS4R1-F-G-120. SQ2274.2 +009700 05 FFILE-RECORD-INFO-P1-120. SQ2274.2 +009800 07 FILLER PIC X(5). SQ2274.2 +009900 07 FFILE-NAME PIC X(6). SQ2274.2 +010000 07 FILLER PIC X(8). SQ2274.2 +010100 07 FRECORD-NAME PIC X(6). SQ2274.2 +010200 07 FILLER PIC X(1). SQ2274.2 +010300 07 FREELUNIT-NUMBER PIC 9(1). SQ2274.2 +010400 07 FILLER PIC X(7). SQ2274.2 +010500 07 FRECORD-NUMBER PIC 9(6). SQ2274.2 +010600 07 FILLER PIC X(6). SQ2274.2 +010700 07 FUPDATE-NUMBER PIC 9(2). SQ2274.2 +010800 07 FILLER PIC X(5). SQ2274.2 +010900 07 FODO-NUMBER PIC 9(4). SQ2274.2 +011000 07 FILLER PIC X(5). SQ2274.2 +011100 07 FPROGRAM-NAME PIC X(5). SQ2274.2 +011200 07 FILLER PIC X(7). SQ2274.2 +011300 07 FRECORD-LENGTH PIC 9(6). SQ2274.2 +011400 07 FILLER PIC X(7). SQ2274.2 +011500 07 FCHARS-OR-RECORDS PIC X(2). SQ2274.2 +011600 07 FILLER PIC X(1). SQ2274.2 +011700 07 FBLOCK-SIZE PIC 9(4). SQ2274.2 +011800 07 FILLER PIC X(6). SQ2274.2 +011900 07 FRECORDS-IN-FILE PIC 9(6). SQ2274.2 +012000 07 FILLER PIC X(5). SQ2274.2 +012100 07 FFILE-ORGANIZATION PIC X(2). SQ2274.2 +012200 07 FILLER PIC X(6). SQ2274.2 +012300 07 FLABEL-TYPE PIC X(1). SQ2274.2 +012400* SQ2274.2 +012500 01 SQ-FS4R2-F-G-138. SQ2274.2 +012600 03 FILLER PIC X(120). SQ2274.2 +012700 03 EXT-18 PIC X(18). SQ2274.2 +012800* SQ2274.2 +012900 WORKING-STORAGE SECTION. SQ2274.2 +013000* SQ2274.2 +013100*************************************************************** SQ2274.2 +013200* * SQ2274.2 +013300* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2274.2 +013400* * SQ2274.2 +013500*************************************************************** SQ2274.2 +013600* SQ2274.2 +013700 01 STATUS-GROUP. SQ2274.2 +013800 04 SQ-FS4-STATUS. SQ2274.2 +013900 07 SQ-FS4-KEY-1 PIC X. SQ2274.2 +014000 07 SQ-FS4-KEY-2 PIC X. SQ2274.2 +014100* SQ2274.2 +014200 01 DELETE-SW. SQ2274.2 +014300 03 DELETE-SW-1 PIC X. SQ2274.2 +014400 03 DELETE-SW-1-GROUP. SQ2274.2 +014500 05 DELETE-SW-2 PIC X. SQ2274.2 +014600* SQ2274.2 +014700 01 DECL-EXEC-I-O PIC X(12). SQ2274.2 +014800* SQ2274.2 +014900 01 DECL-EXEC-SW PIC X. SQ2274.2 +015000* SQ2274.2 +015100 01 SQ-FS4-RECSIZE PIC 999. SQ2274.2 +015200* SQ2274.2 +015300*************************************************************** SQ2274.2 +015400* * SQ2274.2 +015500* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2274.2 +015600* * SQ2274.2 +015700*************************************************************** SQ2274.2 +015800* SQ2274.2 +015900 01 REC-SKEL-SUB PIC 99. SQ2274.2 +016000* SQ2274.2 +016100 01 FILE-RECORD-INFORMATION-REC. SQ2274.2 +016200 03 FILE-RECORD-INFO-SKELETON. SQ2274.2 +016300 05 FILLER PICTURE X(48) VALUE SQ2274.2 +016400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2274.2 +016500 05 FILLER PICTURE X(46) VALUE SQ2274.2 +016600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2274.2 +016700 05 FILLER PICTURE X(26) VALUE SQ2274.2 +016800 ",LFIL=000000,ORG= ,LBLR= ". SQ2274.2 +016900 05 FILLER PICTURE X(37) VALUE SQ2274.2 +017000 ",RECKEY= ". SQ2274.2 +017100 05 FILLER PICTURE X(38) VALUE SQ2274.2 +017200 ",ALTKEY1= ". SQ2274.2 +017300 05 FILLER PICTURE X(38) VALUE SQ2274.2 +017400 ",ALTKEY2= ". SQ2274.2 +017500 05 FILLER PICTURE X(7) VALUE SPACE.SQ2274.2 +017600 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2274.2 +017700 05 FILE-RECORD-INFO-P1-120. SQ2274.2 +017800 07 FILLER PIC X(5). SQ2274.2 +017900 07 XFILE-NAME PIC X(6). SQ2274.2 +018000 07 FILLER PIC X(8). SQ2274.2 +018100 07 XRECORD-NAME PIC X(6). SQ2274.2 +018200 07 FILLER PIC X(1). SQ2274.2 +018300 07 REELUNIT-NUMBER PIC 9(1). SQ2274.2 +018400 07 FILLER PIC X(7). SQ2274.2 +018500 07 XRECORD-NUMBER PIC 9(6). SQ2274.2 +018600 07 FILLER PIC X(6). SQ2274.2 +018700 07 UPDATE-NUMBER PIC 9(2). SQ2274.2 +018800 07 FILLER PIC X(5). SQ2274.2 +018900 07 ODO-NUMBER PIC 9(4). SQ2274.2 +019000 07 FILLER PIC X(5). SQ2274.2 +019100 07 XPROGRAM-NAME PIC X(5). SQ2274.2 +019200 07 FILLER PIC X(7). SQ2274.2 +019300 07 XRECORD-LENGTH PIC 9(6). SQ2274.2 +019400 07 FILLER PIC X(7). SQ2274.2 +019500 07 CHARS-OR-RECORDS PIC X(2). SQ2274.2 +019600 07 FILLER PIC X(1). SQ2274.2 +019700 07 XBLOCK-SIZE PIC 9(4). SQ2274.2 +019800 07 FILLER PIC X(6). SQ2274.2 +019900 07 RECORDS-IN-FILE PIC 9(6). SQ2274.2 +020000 07 FILLER PIC X(5). SQ2274.2 +020100 07 XFILE-ORGANIZATION PIC X(2). SQ2274.2 +020200 07 FILLER PIC X(6). SQ2274.2 +020300 07 XLABEL-TYPE PIC X(1). SQ2274.2 +020400 05 FILE-RECORD-INFO-P121-240. SQ2274.2 +020500 07 FILLER PIC X(8). SQ2274.2 +020600 07 XRECORD-KEY PIC X(29). SQ2274.2 +020700 07 FILLER PIC X(9). SQ2274.2 +020800 07 ALTERNATE-KEY1 PIC X(29). SQ2274.2 +020900 07 FILLER PIC X(9). SQ2274.2 +021000 07 ALTERNATE-KEY2 PIC X(29). SQ2274.2 +021100 07 FILLER PIC X(7). SQ2274.2 +021200* SQ2274.2 +021300 01 TEST-RESULTS. SQ2274.2 +021400 02 FILLER PIC X VALUE SPACE. SQ2274.2 +021500 02 PAR-NAME. SQ2274.2 +021600 03 FILLER PIC X(14) VALUE SPACE. SQ2274.2 +021700 03 PARDOT-X PIC X VALUE SPACE. SQ2274.2 +021800 03 DOTVALUE PIC 99 VALUE ZERO. SQ2274.2 +021900 02 FILLER PIC X VALUE SPACE. SQ2274.2 +022000 02 FEATURE PIC X(24) VALUE SPACE. SQ2274.2 +022100 02 FILLER PIC X VALUE SPACE. SQ2274.2 +022200 02 P-OR-F PIC X(5) VALUE SPACE. SQ2274.2 +022300 02 FILLER PIC X(9) VALUE SPACE. SQ2274.2 +022400 02 RE-MARK PIC X(61). SQ2274.2 +022500 01 TEST-COMPUTED. SQ2274.2 +022600 02 FILLER PIC X(30) VALUE SPACE. SQ2274.2 +022700 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2274.2 +022800 02 COMPUTED-X. SQ2274.2 +022900 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2274.2 +023000 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2274.2 +023100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2274.2 +023200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2274.2 +023300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2274.2 +023400 03 CM-18V0 REDEFINES COMPUTED-A. SQ2274.2 +023500 04 COMPUTED-18V0 PIC -9(18). SQ2274.2 +023600 04 FILLER PIC X. SQ2274.2 +023700 03 FILLER PIC X(50) VALUE SPACE. SQ2274.2 +023800 01 TEST-CORRECT. SQ2274.2 +023900 02 FILLER PIC X(30) VALUE SPACE. SQ2274.2 +024000 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2274.2 +024100 02 CORRECT-X. SQ2274.2 +024200 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2274.2 +024300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2274.2 +024400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2274.2 +024500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2274.2 +024600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2274.2 +024700 03 CR-18V0 REDEFINES CORRECT-A. SQ2274.2 +024800 04 CORRECT-18V0 PIC -9(18). SQ2274.2 +024900 04 FILLER PIC X. SQ2274.2 +025000 03 FILLER PIC X(2) VALUE SPACE. SQ2274.2 +025100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2274.2 +025200* SQ2274.2 +025300 01 CCVS-C-1. SQ2274.2 +025400 02 FILLER PIC IS X VALUE SPACE. SQ2274.2 +025500 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ2274.2 +025600 02 FILLER PIC IS X VALUE SPACE. SQ2274.2 +025700 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ2274.2 +025800 02 FILLER PIC IS X VALUE SPACE. SQ2274.2 +025900 02 FILLER PIC IS X(5) VALUE "PASS ". SQ2274.2 +026000 02 FILLER PIC IS X(9) VALUE SPACE. SQ2274.2 +026100 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ2274.2 +026200 01 CCVS-C-2. SQ2274.2 +026300 02 FILLER PIC X(19) VALUE SPACE. SQ2274.2 +026400 02 FILLER PIC X(6) VALUE "TESTED". SQ2274.2 +026500 02 FILLER PIC X(19) VALUE SPACE. SQ2274.2 +026600 02 FILLER PIC X(4) VALUE "FAIL". SQ2274.2 +026700 02 FILLER PIC X(72) VALUE SPACE. SQ2274.2 +026800* SQ2274.2 +026900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2274.2 +027000 01 REC-CT PIC 99 VALUE ZERO. SQ2274.2 +027100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2274.2 +027200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2274.2 +027300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2274.2 +027400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2274.2 +027500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2274.2 +027600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2274.2 +027700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2274.2 +027800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2274.2 +027900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2274.2 +028000 01 CCVS-H-1. SQ2274.2 +028100 02 FILLER PIC X(39) VALUE SPACES. SQ2274.2 +028200 02 FILLER PIC X(42) VALUE SQ2274.2 +028300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2274.2 +028400 02 FILLER PIC X(39) VALUE SPACES. SQ2274.2 +028500 01 CCVS-H-2A. SQ2274.2 +028600 02 FILLER PIC X(40) VALUE SPACE. SQ2274.2 +028700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2274.2 +028800 02 FILLER PIC XXXX VALUE SQ2274.2 +028900 "4.2 ". SQ2274.2 +029000 02 FILLER PIC X(28) VALUE SQ2274.2 +029100 " COPY - NOT FOR DISTRIBUTION". SQ2274.2 +029200 02 FILLER PIC X(41) VALUE SPACE. SQ2274.2 +029300* SQ2274.2 +029400 01 CCVS-H-2B. SQ2274.2 +029500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2274.2 +029600 02 TEST-ID PIC X(9). SQ2274.2 +029700 02 FILLER PIC X(4) VALUE " IN ". SQ2274.2 +029800 02 FILLER PIC X(12) VALUE SQ2274.2 +029900 " HIGH ". SQ2274.2 +030000 02 FILLER PIC X(22) VALUE SQ2274.2 +030100 " LEVEL VALIDATION FOR ". SQ2274.2 +030200 02 FILLER PIC X(58) VALUE SQ2274.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2274.2 +030400 01 CCVS-H-3. SQ2274.2 +030500 02 FILLER PIC X(34) VALUE SQ2274.2 +030600 " FOR OFFICIAL USE ONLY ". SQ2274.2 +030700 02 FILLER PIC X(58) VALUE SQ2274.2 +030800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2274.2 +030900 02 FILLER PIC X(28) VALUE SQ2274.2 +031000 " COPYRIGHT 1985,1986 ". SQ2274.2 +031100 01 CCVS-E-1. SQ2274.2 +031200 02 FILLER PIC X(52) VALUE SPACE. SQ2274.2 +031300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2274.2 +031400 02 ID-AGAIN PIC X(9). SQ2274.2 +031500 02 FILLER PIC X(45) VALUE SPACES. SQ2274.2 +031600 01 CCVS-E-2. SQ2274.2 +031700 02 FILLER PIC X(31) VALUE SPACE. SQ2274.2 +031800 02 FILLER PIC X(21) VALUE SPACE. SQ2274.2 +031900 02 CCVS-E-2-2. SQ2274.2 +032000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2274.2 +032100 03 FILLER PIC X VALUE SPACE. SQ2274.2 +032200 03 ENDER-DESC PIC X(44) VALUE SQ2274.2 +032300 "ERRORS ENCOUNTERED". SQ2274.2 +032400 01 CCVS-E-3. SQ2274.2 +032500 02 FILLER PIC X(22) VALUE SQ2274.2 +032600 " FOR OFFICIAL USE ONLY". SQ2274.2 +032700 02 FILLER PIC X(12) VALUE SPACE. SQ2274.2 +032800 02 FILLER PIC X(58) VALUE SQ2274.2 +032900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2274.2 +033000 02 FILLER PIC X(8) VALUE SPACE. SQ2274.2 +033100 02 FILLER PIC X(20) VALUE SQ2274.2 +033200 " COPYRIGHT 1985,1986". SQ2274.2 +033300 01 CCVS-E-4. SQ2274.2 +033400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2274.2 +033500 02 FILLER PIC X(4) VALUE " OF ". SQ2274.2 +033600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2274.2 +033700 02 FILLER PIC X(40) VALUE SQ2274.2 +033800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2274.2 +033900 01 XXINFO. SQ2274.2 +034000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2274.2 +034100 02 INFO-TEXT. SQ2274.2 +034200 04 FILLER PIC X(8) VALUE SPACE. SQ2274.2 +034300 04 XXCOMPUTED PIC X(20). SQ2274.2 +034400 04 FILLER PIC X(5) VALUE SPACE. SQ2274.2 +034500 04 XXCORRECT PIC X(20). SQ2274.2 +034600 02 INF-ANSI-REFERENCE PIC X(48). SQ2274.2 +034700 01 HYPHEN-LINE. SQ2274.2 +034800 02 FILLER PIC IS X VALUE IS SPACE. SQ2274.2 +034900 02 FILLER PIC IS X(65) VALUE IS "************************SQ2274.2 +035000- "*****************************************". SQ2274.2 +035100 02 FILLER PIC IS X(54) VALUE IS "************************SQ2274.2 +035200- "******************************". SQ2274.2 +035300 01 CCVS-PGM-ID PIC X(9) VALUE SQ2274.2 +035400 "SQ227A". SQ2274.2 +035500* SQ2274.2 +035600* SQ2274.2 +035700 PROCEDURE DIVISION. SQ2274.2 +035800 DECLARATIVES. SQ2274.2 +035900* SQ2274.2 +036000 SECT-SQ227A-0001 SECTION. SQ2274.2 +036100 USE AFTER EXCEPTION PROCEDURE I-O. SQ2274.2 +036200 I-O-ERROR-PROCESS. SQ2274.2 +036300 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +036400 IF DECL-EXEC-SW NOT = SPACE SQ2274.2 +036500 GO TO END-DECLS. SQ2274.2 +036600* SQ2274.2 +036700 MOVE 1 TO REC-CT. SQ2274.2 +036800 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ2274.2 +036900 GO TO DCL-REWRITE-01-01. SQ2274.2 +037000 DECL-DELETE-01-01. SQ2274.2 +037100 PERFORM DECL-DE-LETE. SQ2274.2 +037200 GO TO DECL-TEST-01-01-END. SQ2274.2 +037300 DCL-REWRITE-01-01. SQ2274.2 +037400 IF SQ-FS4-STATUS = "44" SQ2274.2 +037500 PERFORM DECL-PASS SQ2274.2 +037600 ELSE SQ2274.2 +037700 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +037800 MOVE "44" TO CORRECT-A SQ2274.2 +037900 MOVE "UNEXPECTED I-O STATUS ON FAILED REWRITE" SQ2274.2 +038000 TO RE-MARK SQ2274.2 +038100 MOVE "VII-4, VII-48,4.5.4(2)" TO ANSI-REFERENCE SQ2274.2 +038200 PERFORM DECL-FAIL. SQ2274.2 +038300 DECL-TEST-01-01-END. SQ2274.2 +038400* SQ2274.2 +038500 ADD 1 TO REC-CT. SQ2274.2 +038600 GO TO DCL-REWRITE-01-02. SQ2274.2 +038700 DECL-DELETE-01-02. SQ2274.2 +038800 PERFORM DECL-DE-LETE. SQ2274.2 +038900 GO TO DECL-TEST-01-02-END. SQ2274.2 +039000 DCL-REWRITE-01-02. SQ2274.2 +039100 IF SQ-FS4R1-F-G-120 = FILE-RECORD-INFO-P1-120 (1) SQ2274.2 +039200 PERFORM DECL-PASS SQ2274.2 +039300 ELSE SQ2274.2 +039400 MOVE "FIRST 120 CHARACTERS OF RECORD AREA CHANGED" SQ2274.2 +039500 TO RE-MARK SQ2274.2 +039600 MOVE "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE SQ2274.2 +039700 PERFORM DECL-FAIL. SQ2274.2 +039800 DECL-TEST-01-02-END. SQ2274.2 +039900* SQ2274.2 +040000 ADD 1 TO REC-CT. SQ2274.2 +040100 GO TO DCL-REWRITE-01-03. SQ2274.2 +040200 DECL-DELETE-01-03. SQ2274.2 +040300 PERFORM DECL-DE-LETE. SQ2274.2 +040400 GO TO DECL-TEST-01-03-END. SQ2274.2 +040500 DCL-REWRITE-01-03. SQ2274.2 +040600 IF EXT-18 = "ABCDEFGHIJKLMNOPQR" SQ2274.2 +040700 PERFORM DECL-PASS SQ2274.2 +040800 ELSE SQ2274.2 +040900 MOVE EXT-18 TO COMPUTED-A SQ2274.2 +041000 MOVE "ABCDEFGHIJKLMNOPQR" TO CORRECT-A SQ2274.2 +041100 MOVE "LAST 18 CHARACTERS OF RECORD CHANGED" SQ2274.2 +041200 TO RE-MARK SQ2274.2 +041300 MOVE "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE SQ2274.2 +041400 PERFORM DECL-FAIL. SQ2274.2 +041500 DECL-TEST-01-03-END. SQ2274.2 +041600* SQ2274.2 +041700 PERFORM DECL-WRITE-LINE. SQ2274.2 +041800 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2274.2 +041900 TO DUMMY-RECORD. SQ2274.2 +042000 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2274.2 +042100 GO TO END-DECLS. SQ2274.2 +042200* SQ2274.2 +042300* SQ2274.2 +042400 DECL-PASS. SQ2274.2 +042500 MOVE "PASS " TO P-OR-F. SQ2274.2 +042600 ADD 1 TO PASS-COUNTER. SQ2274.2 +042700 PERFORM DECL-PRINT-DETAIL. SQ2274.2 +042800* SQ2274.2 +042900 DECL-FAIL. SQ2274.2 +043000 MOVE "FAIL*" TO P-OR-F. SQ2274.2 +043100 ADD 1 TO ERROR-COUNTER. SQ2274.2 +043200 PERFORM DECL-PRINT-DETAIL. SQ2274.2 +043300* SQ2274.2 +043400 DECL-DE-LETE. SQ2274.2 +043500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2274.2 +043600 MOVE "*****" TO P-OR-F. SQ2274.2 +043700 ADD 1 TO DELETE-COUNTER. SQ2274.2 +043800 PERFORM DECL-PRINT-DETAIL. SQ2274.2 +043900* SQ2274.2 +044000 DECL-PRINT-DETAIL. SQ2274.2 +044100 IF REC-CT NOT EQUAL TO ZERO SQ2274.2 +044200 MOVE "." TO PARDOT-X SQ2274.2 +044300 MOVE REC-CT TO DOTVALUE. SQ2274.2 +044400 MOVE TEST-RESULTS TO PRINT-REC. SQ2274.2 +044500 PERFORM DECL-WRITE-LINE. SQ2274.2 +044600 IF P-OR-F EQUAL TO "FAIL*" SQ2274.2 +044700 PERFORM DECL-WRITE-LINE SQ2274.2 +044800 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2274.2 +044900 ELSE SQ2274.2 +045000 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2274.2 +045100 MOVE SPACE TO P-OR-F. SQ2274.2 +045200 MOVE SPACE TO COMPUTED-X. SQ2274.2 +045300 MOVE SPACE TO CORRECT-X. SQ2274.2 +045400 IF REC-CT EQUAL TO ZERO SQ2274.2 +045500 MOVE SPACE TO PAR-NAME. SQ2274.2 +045600 MOVE SPACE TO RE-MARK. SQ2274.2 +045700* SQ2274.2 +045800 DECL-WRITE-LINE. SQ2274.2 +045900 ADD 1 TO RECORD-COUNT. SQ2274.2 +046000 IF RECORD-COUNT GREATER 50 SQ2274.2 +046100 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2274.2 +046200 MOVE SPACE TO DUMMY-RECORD SQ2274.2 +046300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2274.2 +046400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2274.2 +046500 MOVE CCVS-C-2 TO DUMMY-RECORD SQ2274.2 +046600 PERFORM DECL-WRT-LN 2 TIMES SQ2274.2 +046700 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2274.2 +046800 PERFORM DECL-WRT-LN SQ2274.2 +046900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2274.2 +047000 MOVE ZERO TO RECORD-COUNT. SQ2274.2 +047100 PERFORM DECL-WRT-LN. SQ2274.2 +047200* SQ2274.2 +047300 DECL-WRT-LN. SQ2274.2 +047400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2274.2 +047500 MOVE SPACE TO DUMMY-RECORD. SQ2274.2 +047600* SQ2274.2 +047700 DECL-FAIL-ROUTINE. SQ2274.2 +047800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2274.2 +047900 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2274.2 +048000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2274.2 +048100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2274.2 +048200 MOVE XXINFO TO DUMMY-RECORD. SQ2274.2 +048300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2274.2 +048400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2274.2 +048500 GO TO DECL-FAIL-EX. SQ2274.2 +048600 DECL-FAIL-WRITE. SQ2274.2 +048700 MOVE TEST-COMPUTED TO PRINT-REC SQ2274.2 +048800 PERFORM DECL-WRITE-LINE SQ2274.2 +048900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2274.2 +049000 MOVE TEST-CORRECT TO PRINT-REC SQ2274.2 +049100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2274.2 +049200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2274.2 +049300 DECL-FAIL-EX. SQ2274.2 +049400 EXIT. SQ2274.2 +049500* SQ2274.2 +049600 DECL-BAIL. SQ2274.2 +049700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2274.2 +049800 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2274.2 +049900 DECL-BAIL-WRITE. SQ2274.2 +050000 MOVE CORRECT-A TO XXCORRECT. SQ2274.2 +050100 MOVE COMPUTED-A TO XXCOMPUTED. SQ2274.2 +050200 MOVE XXINFO TO DUMMY-RECORD. SQ2274.2 +050300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2274.2 +050400 DECL-BAIL-EX. SQ2274.2 +050500 EXIT. SQ2274.2 +050600* SQ2274.2 +050700 END-DECLS. SQ2274.2 +050800 END DECLARATIVES. SQ2274.2 +050900* SQ2274.2 +051000* SQ2274.2 +051100 CCVS1 SECTION. SQ2274.2 +051200 OPEN-FILES. SQ2274.2 +051300*P OPEN I-O RAW-DATA. SQ2274.2 +051400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2274.2 +051500*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2274.2 +051600*P MOVE "ABORTED " TO C-ABORT. SQ2274.2 +051700*P ADD 1 TO C-NO-OF-TESTS. SQ2274.2 +051800*P ACCEPT C-DATE FROM DATE. SQ2274.2 +051900*P ACCEPT C-TIME FROM TIME. SQ2274.2 +052000*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2274.2 +052100*PND-E-1. SQ2274.2 +052200*P CLOSE RAW-DATA. SQ2274.2 +052300 OPEN OUTPUT PRINT-FILE. SQ2274.2 +052400 MOVE CCVS-PGM-ID TO TEST-ID. SQ2274.2 +052500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2274.2 +052600 MOVE SPACE TO TEST-RESULTS. SQ2274.2 +052700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2274.2 +052800 MOVE ZERO TO REC-SKEL-SUB. SQ2274.2 +052900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2274.2 +053000 GO TO CCVS1-EXIT. SQ2274.2 +053100* SQ2274.2 +053200 CCVS-INIT-FILE. SQ2274.2 +053300 ADD 1 TO REC-SKL-SUB. SQ2274.2 +053400 MOVE FILE-RECORD-INFO-SKELETON TO SQ2274.2 +053500 FILE-RECORD-INFO (REC-SKL-SUB). SQ2274.2 +053600* SQ2274.2 +053700 CLOSE-FILES. SQ2274.2 +053800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2274.2 +053900 CLOSE PRINT-FILE. SQ2274.2 +054000*P OPEN I-O RAW-DATA. SQ2274.2 +054100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2274.2 +054200*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2274.2 +054300*P MOVE "OK. " TO C-ABORT. SQ2274.2 +054400*P MOVE PASS-COUNTER TO C-OK. SQ2274.2 +054500*P MOVE ERROR-HOLD TO C-ALL. SQ2274.2 +054600*P MOVE ERROR-COUNTER TO C-FAIL. SQ2274.2 +054700*P MOVE DELETE-CNT TO C-DELETED. SQ2274.2 +054800*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2274.2 +054900*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2274.2 +055000*PND-E-2. SQ2274.2 +055100*P CLOSE RAW-DATA. SQ2274.2 +055200 TERMINATE-CCVS. SQ2274.2 +055300*S EXIT PROGRAM. SQ2274.2 +055400 STOP RUN. SQ2274.2 +055500* SQ2274.2 +055600 INSPT. SQ2274.2 +055700 MOVE "INSPT" TO P-OR-F. SQ2274.2 +055800 ADD 1 TO INSPECT-COUNTER. SQ2274.2 +055900 PERFORM PRINT-DETAIL. SQ2274.2 +056000* SQ2274.2 +056100 PASS. SQ2274.2 +056200 MOVE "PASS " TO P-OR-F. SQ2274.2 +056300 ADD 1 TO PASS-COUNTER. SQ2274.2 +056400 PERFORM PRINT-DETAIL. SQ2274.2 +056500* SQ2274.2 +056600 FAIL. SQ2274.2 +056700 MOVE "FAIL*" TO P-OR-F. SQ2274.2 +056800 ADD 1 TO ERROR-COUNTER. SQ2274.2 +056900 PERFORM PRINT-DETAIL. SQ2274.2 +057000* SQ2274.2 +057100 DE-LETE. SQ2274.2 +057200 MOVE "****TEST DELETED****" TO RE-MARK. SQ2274.2 +057300 MOVE "*****" TO P-OR-F. SQ2274.2 +057400 ADD 1 TO DELETE-COUNTER. SQ2274.2 +057500 PERFORM PRINT-DETAIL. SQ2274.2 +057600* SQ2274.2 +057700 PRINT-DETAIL. SQ2274.2 +057800 IF REC-CT NOT EQUAL TO ZERO SQ2274.2 +057900 MOVE "." TO PARDOT-X SQ2274.2 +058000 MOVE REC-CT TO DOTVALUE. SQ2274.2 +058100 MOVE TEST-RESULTS TO PRINT-REC. SQ2274.2 +058200 PERFORM WRITE-LINE. SQ2274.2 +058300 IF P-OR-F EQUAL TO "FAIL*" SQ2274.2 +058400 PERFORM WRITE-LINE SQ2274.2 +058500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2274.2 +058600 ELSE SQ2274.2 +058700 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2274.2 +058800 MOVE SPACE TO P-OR-F. SQ2274.2 +058900 MOVE SPACE TO COMPUTED-X. SQ2274.2 +059000 MOVE SPACE TO CORRECT-X. SQ2274.2 +059100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2274.2 +059200 MOVE SPACE TO RE-MARK. SQ2274.2 +059300* SQ2274.2 +059400 HEAD-ROUTINE. SQ2274.2 +059500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +059600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +059700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2274.2 +059800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2274.2 +059900 COLUMN-NAMES-ROUTINE. SQ2274.2 +060000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2274.2 +060100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +060200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2274.2 +060300 END-ROUTINE. SQ2274.2 +060400 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2274.2 +060500 PERFORM WRITE-LINE 5 TIMES. SQ2274.2 +060600 END-RTN-EXIT. SQ2274.2 +060700 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2274.2 +060800 PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +060900* SQ2274.2 +061000 END-ROUTINE-1. SQ2274.2 +061100 ADD ERROR-COUNTER TO ERROR-HOLD SQ2274.2 +061200 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2274.2 +061300 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2274.2 +061400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2274.2 +061500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2274.2 +061600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2274.2 +061700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2274.2 +061800 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2274.2 +061900 PERFORM WRITE-LINE. SQ2274.2 +062000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2274.2 +062100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2274.2 +062200 MOVE "NO " TO ERROR-TOTAL SQ2274.2 +062300 ELSE SQ2274.2 +062400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2274.2 +062500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2274.2 +062600 PERFORM WRITE-LINE. SQ2274.2 +062700 END-ROUTINE-13. SQ2274.2 +062800 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2274.2 +062900 MOVE "NO " TO ERROR-TOTAL SQ2274.2 +063000 ELSE SQ2274.2 +063100 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2274.2 +063200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2274.2 +063300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2274.2 +063400 PERFORM WRITE-LINE. SQ2274.2 +063500 IF INSPECT-COUNTER EQUAL TO ZERO SQ2274.2 +063600 MOVE "NO " TO ERROR-TOTAL SQ2274.2 +063700 ELSE SQ2274.2 +063800 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2274.2 +063900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2274.2 +064000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2274.2 +064100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2274.2 +064200* SQ2274.2 +064300 WRITE-LINE. SQ2274.2 +064400 ADD 1 TO RECORD-COUNT. SQ2274.2 +064500 IF RECORD-COUNT GREATER 50 SQ2274.2 +064600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2274.2 +064700 MOVE SPACE TO DUMMY-RECORD SQ2274.2 +064800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2274.2 +064900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2274.2 +065000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2274.2 +065100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2274.2 +065200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2274.2 +065300 MOVE ZERO TO RECORD-COUNT. SQ2274.2 +065400 PERFORM WRT-LN. SQ2274.2 +065500* SQ2274.2 +065600 WRT-LN. SQ2274.2 +065700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2274.2 +065800 MOVE SPACE TO DUMMY-RECORD. SQ2274.2 +065900 BLANK-LINE-PRINT. SQ2274.2 +066000 PERFORM WRT-LN. SQ2274.2 +066100 FAIL-ROUTINE. SQ2274.2 +066200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2274.2 +066300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2274.2 +066400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2274.2 +066500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2274.2 +066600 MOVE XXINFO TO DUMMY-RECORD. SQ2274.2 +066700 PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +066800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2274.2 +066900 GO TO FAIL-ROUTINE-EX. SQ2274.2 +067000 FAIL-ROUTINE-WRITE. SQ2274.2 +067100 MOVE TEST-COMPUTED TO PRINT-REC SQ2274.2 +067200 PERFORM WRITE-LINE SQ2274.2 +067300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2274.2 +067400 MOVE TEST-CORRECT TO PRINT-REC SQ2274.2 +067500 PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +067600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2274.2 +067700 FAIL-ROUTINE-EX. SQ2274.2 +067800 EXIT. SQ2274.2 +067900 BAIL-OUT. SQ2274.2 +068000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2274.2 +068100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2274.2 +068200 BAIL-OUT-WRITE. SQ2274.2 +068300 MOVE CORRECT-A TO XXCORRECT. SQ2274.2 +068400 MOVE COMPUTED-A TO XXCOMPUTED. SQ2274.2 +068500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2274.2 +068600 MOVE XXINFO TO DUMMY-RECORD. SQ2274.2 +068700 PERFORM WRITE-LINE 2 TIMES. SQ2274.2 +068800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2274.2 +068900 BAIL-OUT-EX. SQ2274.2 +069000 EXIT. SQ2274.2 +069100 CCVS1-EXIT. SQ2274.2 +069200 EXIT. SQ2274.2 +069300* SQ2274.2 +069400**************************************************************** SQ2274.2 +069500* * SQ2274.2 +069600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2274.2 +069700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2274.2 +069800* * SQ2274.2 +069900**************************************************************** SQ2274.2 +070000* SQ2274.2 +070100 SECT-SQ227A-0002 SECTION. SQ2274.2 +070200 STA-INIT. SQ2274.2 +070300 MOVE SPACE TO DELETE-SW. SQ2274.2 +070400* SQ2274.2 +070500 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ2274.2 +070600 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2274.2 +070700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2274.2 +070800 MOVE 120 TO XRECORD-LENGTH (1). SQ2274.2 +070900 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ2274.2 +071000 MOVE 1 TO XBLOCK-SIZE (1). SQ2274.2 +071100 MOVE 1 TO RECORDS-IN-FILE (1). SQ2274.2 +071200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2274.2 +071300 MOVE "S" TO XLABEL-TYPE (1). SQ2274.2 +071400* SQ2274.2 +071500* OPEN THE FILE IN THE OUTPUT MODE SQ2274.2 +071600* SQ2274.2 +071700 SEQ-INIT-01. SQ2274.2 +071800 MOVE 0 TO REC-CT. SQ2274.2 +071900 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +072000 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +072100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +072200 MOVE ZERO TO XRECORD-NUMBER (1). SQ2274.2 +072300 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ2274.2 +072400 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ2274.2 +072500 GO TO SEQ-TEST-OP-01. SQ2274.2 +072600 SEQ-DELETE-01. SQ2274.2 +072700 MOVE "*" TO DELETE-SW-1. SQ2274.2 +072800 GO TO SEQ-DELETE-01-01. SQ2274.2 +072900 SEQ-TEST-OP-01. SQ2274.2 +073000 OPEN OUTPUT SQ-FS4. SQ2274.2 +073100* SQ2274.2 +073200* CHECK I-O STATUS RETURNED FROM OPEN OUTPUT SQ2274.2 +073300* SQ2274.2 +073400 ADD 1 TO REC-CT. SQ2274.2 +073500 IF DELETE-SW NOT = SPACE SQ2274.2 +073600 GO TO SEQ-DELETE-01-01. SQ2274.2 +073700 GO TO SEQ-TEST-OP-01-01. SQ2274.2 +073800 SEQ-DELETE-01-01. SQ2274.2 +073900 PERFORM DE-LETE. SQ2274.2 +074000 GO TO SEQ-TEST-01-01-END. SQ2274.2 +074100 SEQ-TEST-OP-01-01. SQ2274.2 +074200 IF SQ-FS4-STATUS = "00" SQ2274.2 +074300 PERFORM PASS SQ2274.2 +074400 ELSE SQ2274.2 +074500 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +074600 MOVE "00" TO CORRECT-A SQ2274.2 +074700 MOVE "UNEXPECTED ERROR CODE FROM OPEN OUTPUT" SQ2274.2 +074800 TO RE-MARK SQ2274.2 +074900 MOVE "VII-3, VII-43" TO ANSI-REFERENCE SQ2274.2 +075000 PERFORM FAIL. SQ2274.2 +075100 SEQ-TEST-01-01-END. SQ2274.2 +075200* SQ2274.2 +075300* CHECK EXECUTION OF I-O DECLARATIVE SQ2274.2 +075400* SQ2274.2 +075500 ADD 1 TO REC-CT. SQ2274.2 +075600 IF DELETE-SW NOT = SPACE SQ2274.2 +075700 GO TO SEQ-DELETE-01-02. SQ2274.2 +075800 GO TO SEQ-TEST-OP-01-02. SQ2274.2 +075900 SEQ-DELETE-01-02. SQ2274.2 +076000 PERFORM DE-LETE. SQ2274.2 +076100 GO TO SEQ-TEST-01-02-END. SQ2274.2 +076200 SEQ-TEST-OP-01-02. SQ2274.2 +076300 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +076400 PERFORM PASS SQ2274.2 +076500 ELSE SQ2274.2 +076600 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +076700 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +076800 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2274.2 +076900 TO RE-MARK SQ2274.2 +077000 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +077100 PERFORM FAIL. SQ2274.2 +077200 SEQ-TEST-01-02-END. SQ2274.2 +077300* SQ2274.2 +077400* SQ2274.2 +077500* A NEW FILE IS OPEN. WE NOW WRITE ONE RECORD OF 120 CHARS. SQ2274.2 +077600* SQ2274.2 +077700 SEQ-INIT-02. SQ2274.2 +077800 MOVE 0 TO REC-CT. SQ2274.2 +077900 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +078000 ADD 1 TO XRECORD-NUMBER (1). SQ2274.2 +078100 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +078200 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +078300 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2274.2 +078400 MOVE "987654321123456789" TO EXT-18. SQ2274.2 +078500 MOVE 120 TO SQ-FS4-RECSIZE. SQ2274.2 +078600 MOVE "WRITE A RECORD" TO FEATURE. SQ2274.2 +078700 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ2274.2 +078800 IF DELETE-SW NOT EQUAL TO SPACE SQ2274.2 +078900 GO TO SEQ-DELETE-02. SQ2274.2 +079000 GO TO SEQ-TEST-WR-02. SQ2274.2 +079100 SEQ-DELETE-02. SQ2274.2 +079200 MOVE "*" TO DELETE-SW-2. SQ2274.2 +079300 GO TO SEQ-DELETE-02-01. SQ2274.2 +079400 SEQ-TEST-WR-02. SQ2274.2 +079500 WRITE SQ-FS4R2-F-G-138. SQ2274.2 +079600* SQ2274.2 +079700* CHECK I-O STATUS RETURNED FROM WRITE SQ2274.2 +079800* SQ2274.2 +079900 ADD 1 TO REC-CT. SQ2274.2 +080000 IF DELETE-SW NOT = SPACE SQ2274.2 +080100 GO TO SEQ-DELETE-02-01. SQ2274.2 +080200 GO TO SEQ-TEST-WR-02-01. SQ2274.2 +080300 SEQ-DELETE-02-01. SQ2274.2 +080400 PERFORM DE-LETE. SQ2274.2 +080500 GO TO SEQ-TEST-02-01-END. SQ2274.2 +080600 SEQ-TEST-WR-02-01. SQ2274.2 +080700 IF SQ-FS4-STATUS = "00" SQ2274.2 +080800 PERFORM PASS SQ2274.2 +080900 ELSE SQ2274.2 +081000 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +081100 MOVE "00" TO CORRECT-A SQ2274.2 +081200 MOVE "UNEXPECTED ERROR CODE FROM WRITE" SQ2274.2 +081300 TO RE-MARK SQ2274.2 +081400 MOVE "VII-3, VII-53" TO ANSI-REFERENCE SQ2274.2 +081500 PERFORM FAIL. SQ2274.2 +081600 SEQ-TEST-02-01-END. SQ2274.2 +081700* SQ2274.2 +081800* CHECK EXECUTION OF I-O DECLARATIVE SQ2274.2 +081900* SQ2274.2 +082000 ADD 1 TO REC-CT. SQ2274.2 +082100 IF DELETE-SW NOT = SPACE SQ2274.2 +082200 GO TO SEQ-DELETE-02-02. SQ2274.2 +082300 GO TO SEQ-TEST-WR-02-02. SQ2274.2 +082400 SEQ-DELETE-02-02. SQ2274.2 +082500 PERFORM DE-LETE. SQ2274.2 +082600 GO TO SEQ-TEST-02-02-END. SQ2274.2 +082700 SEQ-TEST-WR-02-02. SQ2274.2 +082800 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +082900 PERFORM PASS SQ2274.2 +083000 ELSE SQ2274.2 +083100 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +083200 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +083300 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2274.2 +083400 TO RE-MARK SQ2274.2 +083500 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +083600 PERFORM FAIL. SQ2274.2 +083700 SEQ-TEST-02-02-END. SQ2274.2 +083800* SQ2274.2 +083900* SQ2274.2 +084000* NOW CLOSE THE FILE. SQ2274.2 +084100* SQ2274.2 +084200 SEQ-INIT-03. SQ2274.2 +084300 MOVE 0 TO REC-CT. SQ2274.2 +084400 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +084500 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +084600 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +084700 MOVE "CLOSE FILE" TO FEATURE. SQ2274.2 +084800 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ2274.2 +084900 IF DELETE-SW NOT EQUAL TO SPACE SQ2274.2 +085000 GO TO SEQ-DELETE-03. SQ2274.2 +085100 GO TO SEQ-TEST-CL-03. SQ2274.2 +085200 SEQ-DELETE-03. SQ2274.2 +085300 MOVE "*" TO DELETE-SW-2. SQ2274.2 +085400 GO TO SEQ-DELETE-03-01. SQ2274.2 +085500 SEQ-TEST-CL-03. SQ2274.2 +085600 CLOSE SQ-FS4. SQ2274.2 +085700* SQ2274.2 +085800* CHECK I-O STATUS RETURNED FROM CLOSE SQ2274.2 +085900* SQ2274.2 +086000 ADD 1 TO REC-CT. SQ2274.2 +086100 IF DELETE-SW NOT = SPACE SQ2274.2 +086200 GO TO SEQ-DELETE-03-01. SQ2274.2 +086300 GO TO SEQ-TEST-CL-03-01. SQ2274.2 +086400 SEQ-DELETE-03-01. SQ2274.2 +086500 PERFORM DE-LETE. SQ2274.2 +086600 GO TO SEQ-TEST-03-01-END. SQ2274.2 +086700 SEQ-TEST-CL-03-01. SQ2274.2 +086800 IF SQ-FS4-STATUS = "00" SQ2274.2 +086900 PERFORM PASS SQ2274.2 +087000 ELSE SQ2274.2 +087100 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +087200 MOVE "00" TO CORRECT-A SQ2274.2 +087300 MOVE "UNEXPECTED ERROR CODE FROM CLOSE" SQ2274.2 +087400 TO RE-MARK SQ2274.2 +087500 MOVE "VII-3, VII-38,4.2.4(4)" TO ANSI-REFERENCE SQ2274.2 +087600 PERFORM FAIL. SQ2274.2 +087700 SEQ-TEST-03-01-END. SQ2274.2 +087800* SQ2274.2 +087900* CHECK EXECUTION OF I-O DECLARATIVE SQ2274.2 +088000* SQ2274.2 +088100 ADD 1 TO REC-CT. SQ2274.2 +088200 IF DELETE-SW NOT = SPACE SQ2274.2 +088300 GO TO SEQ-DELETE-03-02. SQ2274.2 +088400 GO TO SEQ-TEST-CL-03-02. SQ2274.2 +088500 SEQ-DELETE-03-02. SQ2274.2 +088600 PERFORM DE-LETE. SQ2274.2 +088700 GO TO SEQ-TEST-03-02-END. SQ2274.2 +088800 SEQ-TEST-CL-03-02. SQ2274.2 +088900 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +089000 PERFORM PASS SQ2274.2 +089100 ELSE SQ2274.2 +089200 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +089300 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +089400 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2274.2 +089500 TO RE-MARK SQ2274.2 +089600 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +089700 PERFORM FAIL. SQ2274.2 +089800 SEQ-TEST-03-02-END. SQ2274.2 +089900 MOVE SPACE TO DELETE-SW-2. SQ2274.2 +090000* SQ2274.2 +090100* SQ2274.2 +090200* OPEN THE FILE IN THE I-O MODE SQ2274.2 +090300* SQ2274.2 +090400 SEQ-INIT-04. SQ2274.2 +090500 MOVE 0 TO REC-CT. SQ2274.2 +090600 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +090700 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +090800 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +090900 MOVE ZERO TO XRECORD-NUMBER (1). SQ2274.2 +091000 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ2274.2 +091100 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ2274.2 +091200 IF DELETE-SW NOT = SPACE SQ2274.2 +091300 GO TO SEQ-DELETE-04-01. SQ2274.2 +091400 GO TO SEQ-TEST-OP-04. SQ2274.2 +091500 SEQ-DELETE-04. SQ2274.2 +091600 MOVE "*" TO DELETE-SW-2. SQ2274.2 +091700 GO TO SEQ-DELETE-04-01. SQ2274.2 +091800 SEQ-TEST-OP-04. SQ2274.2 +091900 OPEN I-O SQ-FS4. SQ2274.2 +092000* SQ2274.2 +092100* CHECK I-O STATUS RETURNED FROM OPEN I-O SQ2274.2 +092200* SQ2274.2 +092300 ADD 1 TO REC-CT. SQ2274.2 +092400 IF DELETE-SW NOT = SPACE SQ2274.2 +092500 GO TO SEQ-DELETE-04-01. SQ2274.2 +092600 GO TO SEQ-TEST-OP-04-01. SQ2274.2 +092700 SEQ-DELETE-04-01. SQ2274.2 +092800 PERFORM DE-LETE. SQ2274.2 +092900 GO TO SEQ-TEST-04-01-END. SQ2274.2 +093000 SEQ-TEST-OP-04-01. SQ2274.2 +093100 IF SQ-FS4-STATUS = "00" SQ2274.2 +093200 PERFORM PASS SQ2274.2 +093300 ELSE SQ2274.2 +093400 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +093500 MOVE "00" TO CORRECT-A SQ2274.2 +093600 MOVE "UNEXPECTED I-O STATUS CODE FROM OPEN I-O" SQ2274.2 +093700 TO RE-MARK SQ2274.2 +093800 MOVE "VII-3, VII-40" TO ANSI-REFERENCE SQ2274.2 +093900 PERFORM FAIL. SQ2274.2 +094000 SEQ-TEST-04-01-END. SQ2274.2 +094100* SQ2274.2 +094200 ADD 1 TO REC-CT. SQ2274.2 +094300 IF DELETE-SW NOT = SPACE SQ2274.2 +094400 GO TO SEQ-DELETE-04-02. SQ2274.2 +094500 GO TO SEQ-TEST-OP-04-02. SQ2274.2 +094600 SEQ-DELETE-04-02. SQ2274.2 +094700 PERFORM DE-LETE. SQ2274.2 +094800 GO TO SEQ-TEST-04-02-END. SQ2274.2 +094900 SEQ-TEST-OP-04-02. SQ2274.2 +095000 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +095100 PERFORM PASS SQ2274.2 +095200 ELSE SQ2274.2 +095300 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +095400 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +095500 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE ON OPEN" SQ2274.2 +095600 TO RE-MARK SQ2274.2 +095700 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +095800 PERFORM FAIL. SQ2274.2 +095900 SEQ-TEST-04-02-END. SQ2274.2 +096000* SQ2274.2 +096100* SQ2274.2 +096200* THE FILE IS OPEN FOR I-O. WE READ THE ONLY RECORD. SQ2274.2 +096300* SQ2274.2 +096400 SEQ-INIT-05. SQ2274.2 +096500 MOVE 0 TO REC-CT. SQ2274.2 +096600 MOVE "*" TO DECL-EXEC-SW. SQ2274.2 +096700 ADD 1 TO XRECORD-NUMBER (1). SQ2274.2 +096800 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +096900 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +097000 MOVE ZERO TO SQ-FS4-RECSIZE. SQ2274.2 +097100 MOVE SPACE TO SQ-FS4R2-F-G-138. SQ2274.2 +097200 MOVE "READ FIRST RECORD" TO FEATURE. SQ2274.2 +097300 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ2274.2 +097400 IF DELETE-SW NOT EQUAL TO SPACE SQ2274.2 +097500 GO TO SEQ-DELETE-05. SQ2274.2 +097600 GO TO SEQ-TEST-RD-05. SQ2274.2 +097700 SEQ-DELETE-05. SQ2274.2 +097800 MOVE "*" TO DELETE-SW-2. SQ2274.2 +097900 GO TO SEQ-DELETE-05-01. SQ2274.2 +098000 SEQ-TEST-RD-05. SQ2274.2 +098100 READ SQ-FS4. SQ2274.2 +098200* SQ2274.2 +098300* CHECK I-O STATUS RETURNED FROM READ SQ2274.2 +098400* SQ2274.2 +098500 ADD 1 TO REC-CT. SQ2274.2 +098600 IF DELETE-SW NOT = SPACE SQ2274.2 +098700 GO TO SEQ-DELETE-05-01. SQ2274.2 +098800 GO TO SEQ-TEST-RD-05-01. SQ2274.2 +098900 SEQ-DELETE-05-01. SQ2274.2 +099000 PERFORM DE-LETE. SQ2274.2 +099100 GO TO SEQ-TEST-05-01-END. SQ2274.2 +099200 SEQ-TEST-RD-05-01. SQ2274.2 +099300 IF SQ-FS4-STATUS = "00" SQ2274.2 +099400 PERFORM PASS SQ2274.2 +099500 ELSE SQ2274.2 +099600 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +099700 MOVE "00" TO CORRECT-A SQ2274.2 +099800 MOVE "UNEXPECTED STATUS CODE FROM READ" SQ2274.2 +099900 TO RE-MARK SQ2274.2 +100000 MOVE "VII-3, VII-44" TO ANSI-REFERENCE SQ2274.2 +100100 PERFORM FAIL. SQ2274.2 +100200 SEQ-TEST-05-01-END. SQ2274.2 +100300* SQ2274.2 +100400* CHECK EXECUTION OF I-O DECLARATIVE SQ2274.2 +100500* SQ2274.2 +100600 ADD 1 TO REC-CT. SQ2274.2 +100700 IF DELETE-SW NOT = SPACE SQ2274.2 +100800 GO TO SEQ-DELETE-05-02. SQ2274.2 +100900 GO TO SEQ-TEST-RD-05-02. SQ2274.2 +101000 SEQ-DELETE-05-02. SQ2274.2 +101100 PERFORM DE-LETE. SQ2274.2 +101200 GO TO SEQ-TEST-05-02-END. SQ2274.2 +101300 SEQ-TEST-RD-05-02. SQ2274.2 +101400 IF DECL-EXEC-I-O = "NOT EXECUTED" SQ2274.2 +101500 PERFORM PASS SQ2274.2 +101600 ELSE SQ2274.2 +101700 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2274.2 +101800 MOVE "NOT EXECUTED" TO CORRECT-A SQ2274.2 +101900 MOVE "UNEXPECTED EXECUTION OF I-O DECLARATIVE" SQ2274.2 +102000 TO RE-MARK SQ2274.2 +102100 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2274.2 +102200 PERFORM FAIL. SQ2274.2 +102300 SEQ-TEST-05-02-END. SQ2274.2 +102400* SQ2274.2 +102500* CHECK THAT THE CORRECT RECORD HAS BEEN RETURNED, BY SQ2274.2 +102600* CHECKING THE RECORD-NUMBER FIELD. SQ2274.2 +102700* SQ2274.2 +102800 ADD 1 TO REC-CT. SQ2274.2 +102900 IF DELETE-SW NOT = SPACE SQ2274.2 +103000 GO TO SEQ-DELETE-05-03. SQ2274.2 +103100 GO TO SEQ-TEST-RD-05-03. SQ2274.2 +103200 SEQ-DELETE-05-03. SQ2274.2 +103300 PERFORM DE-LETE. SQ2274.2 +103400 GO TO SEQ-TEST-05-03-END. SQ2274.2 +103500 SEQ-TEST-RD-05-03. SQ2274.2 +103600 IF FRECORD-NUMBER = XRECORD-NUMBER (1) SQ2274.2 +103700 PERFORM PASS SQ2274.2 +103800 ELSE SQ2274.2 +103900 MOVE FRECORD-NUMBER TO COMPUTED-18V0 SQ2274.2 +104000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0 SQ2274.2 +104100 MOVE "INCORRECT RECORD NUMBER FOUND" TO RE-MARK SQ2274.2 +104200 PERFORM FAIL. SQ2274.2 +104300 SEQ-TEST-05-03-END. SQ2274.2 +104400* SQ2274.2 +104500* CHECK THE LENGTH OF THE RECORD RETURNED SQ2274.2 +104600* SQ2274.2 +104700 ADD 1 TO REC-CT. SQ2274.2 +104800 IF DELETE-SW NOT = SPACE SQ2274.2 +104900 GO TO SEQ-DELETE-05-04. SQ2274.2 +105000 GO TO SEQ-TEST-RD-05-04. SQ2274.2 +105100 SEQ-DELETE-05-04. SQ2274.2 +105200 PERFORM DE-LETE. SQ2274.2 +105300 GO TO SEQ-TEST-05-04-END. SQ2274.2 +105400 SEQ-TEST-RD-05-04. SQ2274.2 +105500 IF SQ-FS4-RECSIZE = 120 SQ2274.2 +105600 PERFORM PASS SQ2274.2 +105700 ELSE SQ2274.2 +105800 MOVE SQ-FS4-RECSIZE TO COMPUTED-18V0 SQ2274.2 +105900 MOVE 120 TO CORRECT-18V0 SQ2274.2 +106000 MOVE "INCORRECT RECORD LENGTH RETURNED" TO RE-MARK SQ2274.2 +106100 MOVE "VII-32, 3.8.4(11)" TO ANSI-REFERENCE SQ2274.2 +106200 PERFORM FAIL. SQ2274.2 +106300 SEQ-TEST-05-04-END. SQ2274.2 +106400 MOVE SPACE TO DELETE-SW-2. SQ2274.2 +106500* SQ2274.2 +106600* SQ2274.2 +106700* TRY TO WRITE A RECORD OF A DIFFERENT SIZE THAN READ SQ2274.2 +106800* SQ2274.2 +106900 SEQ-INIT-06. SQ2274.2 +107000 MOVE 0 TO REC-CT. SQ2274.2 +107100 MOVE SPACE TO DECL-EXEC-SW. SQ2274.2 +107200 MOVE "**" TO SQ-FS4-STATUS. SQ2274.2 +107300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2274.2 +107400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2274.2 +107500 MOVE "ABCDEFGHIJKLMNOPQR" TO EXT-18. SQ2274.2 +107600 MOVE 130 TO SQ-FS4-RECSIZE. SQ2274.2 +107700 MOVE "REWRITE DIFFERENT SIZE REC" TO FEATURE. SQ2274.2 +107800 MOVE "SEQ-TEST-RW-06" TO PAR-NAME. SQ2274.2 +107900 IF DELETE-SW NOT = SPACE SQ2274.2 +108000 GO TO SEQ-DELETE-06-01. SQ2274.2 +108100 GO TO SEQ-TEST-RW-06. SQ2274.2 +108200 SEQ-DELETE-06. SQ2274.2 +108300 MOVE "*" TO DELETE-SW-2. SQ2274.2 +108400 GO TO SEQ-DELETE-06-01. SQ2274.2 +108500 SEQ-TEST-RW-06. SQ2274.2 +108600 REWRITE SQ-FS4R1-F-G-120. SQ2274.2 +108700 MOVE 0 TO REC-CT. SQ2274.2 +108800* SQ2274.2 +108900* CHECK I-O STATUS RETURNED FROM REWRITE SQ2274.2 +109000* SQ2274.2 +109100 ADD 1 TO REC-CT. SQ2274.2 +109200 IF DELETE-SW NOT = SPACE SQ2274.2 +109300 GO TO SEQ-DELETE-06-01. SQ2274.2 +109400 GO TO SEQ-TEST-RW-06-01. SQ2274.2 +109500 SEQ-DELETE-06-01. SQ2274.2 +109600 PERFORM DE-LETE. SQ2274.2 +109700 GO TO SEQ-TEST-06-01-END. SQ2274.2 +109800 SEQ-TEST-RW-06-01. SQ2274.2 +109900 IF SQ-FS4-STATUS = "44" SQ2274.2 +110000 PERFORM PASS SQ2274.2 +110100 ELSE SQ2274.2 +110200 MOVE SQ-FS4-STATUS TO COMPUTED-A SQ2274.2 +110300 MOVE "44" TO CORRECT-A SQ2274.2 +110400 MOVE "UNEXPECTED STATUS CODE FROM REWRITE SQ2274.2 +110500- "OF DIFF SZ REC THAN READ" SQ2274.2 +110600 TO RE-MARK SQ2274.2 +110700 MOVE "VII-41.3.5(4)D, VII-48" TO ANSI-REFERENCE SQ2274.2 +110800 PERFORM FAIL. SQ2274.2 +110900 SEQ-TEST-06-01-END. SQ2274.2 +111000 CCVS-EXIT SECTION. SQ2274.2 +111100 CCVS-999999. SQ2274.2 +111200 GO TO CLOSE-FILES. SQ2274.2 diff --git a/tests/cobol85/SQ/SQ228A.CBL b/tests/cobol85/SQ/SQ228A.CBL new file mode 100755 index 00000000..5d0803f6 --- /dev/null +++ b/tests/cobol85/SQ/SQ228A.CBL @@ -0,0 +1,783 @@ +000100 IDENTIFICATION DIVISION. SQ2284.2 +000200 PROGRAM-ID. SQ2284.2 +000300 SQ228A. SQ2284.2 +000400**************************************************************** SQ2284.2 +000500* * SQ2284.2 +000600* VALIDATION FOR:- * SQ2284.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2284.2 +000800* USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986. * SQ2284.2 +000900* REVISED 1986, AUGUST * SQ2284.2 +001000* * SQ2284.2 +001100* CREATION DATE / VALIDATION DATE * SQ2284.2 +001200* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2284.2 +001300* * SQ2284.2 +001400**************************************************************** SQ2284.2 +001500* * SQ2284.2 +001600* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2284.2 +001700* * SQ2284.2 +001800* X-14 SEQUENTIAL MASS STORAGE FILE * SQ2284.2 +001900* X-55 SYSTEM PRINTER * SQ2284.2 +002000* X-82 SOURCE-COMPUTER * SQ2284.2 +002100* X-83 OBJECT-COMPUTER. * SQ2284.2 +002200* * SQ2284.2 +002300**************************************************************** SQ2284.2 +002400* * SQ2284.2 +002500* SPLIT FROM SQ227A, THIS PROGRAM REPEATS THE SEQUENCE OF * SQ2284.2 +002600* FILE HANDLING ROUTINES IN ORDER TO CARRY OUT THE ISOLATED * SQ2284.2 +002700* SPLIT TEST THAT CHECKS FOR THE CORRECT RESPONSE TO A * SQ2284.2 +002800* RE-WRITE ON A RECORD THAT IS TOO LONG FOR THE FILE. * SQ2284.2 +002900* (SEE SQ227A). * SQ2284.2 +003000* * SQ2284.2 +003100**************************************************************** SQ2284.2 +003200* SQ2284.2 +003300 ENVIRONMENT DIVISION. SQ2284.2 +003400 CONFIGURATION SECTION. SQ2284.2 +003500 SOURCE-COMPUTER. SQ2284.2 +003600 Linux. SQ2284.2 +003700 OBJECT-COMPUTER. SQ2284.2 +003800 Linux. SQ2284.2 +003900* SQ2284.2 +004000 INPUT-OUTPUT SECTION. SQ2284.2 +004100 FILE-CONTROL. SQ2284.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2284.2 +004300 "report.log". SQ2284.2 +004400* SQ2284.2 +004500*P SELECT RAW-DATA ASSIGN TO SQ2284.2 +004600*P "XXXXX062" SQ2284.2 +004700*P ORGANIZATION IS INDEXED SQ2284.2 +004800*P ACCESS MODE IS RANDOM SQ2284.2 +004900*P RECORD-KEY IS RAW-DATA-KEY. SQ2284.2 +005000*P SQ2284.2 +005100 SELECT SQ-FS4 SQ2284.2 +005200 ASSIGN SQ2284.2 +005300 "XXXXX014" SQ2284.2 +005400 STATUS SQ-FS4-STATUS OF STATUS-GROUP SQ2284.2 +005500 ACCESS MODE IS SEQUENTIAL SQ2284.2 +005600 ORGANIZATION IS SEQUENTIAL SQ2284.2 +005700 . SQ2284.2 +005800* SQ2284.2 +005900* SQ2284.2 +006000 DATA DIVISION. SQ2284.2 +006100 FILE SECTION. SQ2284.2 +006200 FD PRINT-FILE SQ2284.2 +006300*C LABEL RECORDS SQ2284.2 +006400*C OMITTED SQ2284.2 +006500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2284.2 +006600 . SQ2284.2 +006700 01 PRINT-REC PICTURE X(120). SQ2284.2 +006800 01 DUMMY-RECORD PICTURE X(120). SQ2284.2 +006900*P SQ2284.2 +007000*PD RAW-DATA. SQ2284.2 +007100*P1 RAW-DATA-SATZ. SQ2284.2 +007200*P 05 RAW-DATA-KEY PIC X(6). SQ2284.2 +007300*P 05 C-DATE PIC 9(6). SQ2284.2 +007400*P 05 C-TIME PIC 9(8). SQ2284.2 +007500*P 05 NO-OF-TESTS PIC 99. SQ2284.2 +007600*P 05 C-OK PIC 999. SQ2284.2 +007700*P 05 C-ALL PIC 999. SQ2284.2 +007800*P 05 C-FAIL PIC 999. SQ2284.2 +007900*P 05 C-DELETED PIC 999. SQ2284.2 +008000*P 05 C-INSPECT PIC 999. SQ2284.2 +008100*P 05 C-NOTE PIC X(13). SQ2284.2 +008200*P 05 C-INDENT PIC X. SQ2284.2 +008300*P 05 C-ABORT PIC X(8). SQ2284.2 +008400* SQ2284.2 +008500 FD SQ-FS4 SQ2284.2 +008600*C LABEL RECORD IS STANDARD SQ2284.2 +008700 BLOCK 138 CHARACTERS SQ2284.2 +008800 RECORD VARYING SIZE FROM 50 TO 138 CHARACTERS SQ2284.2 +008900 DEPENDING ON SQ-FS4-RECSIZE SQ2284.2 +009000 . SQ2284.2 +009100 01 SQ-FS4R1-F-G-120. SQ2284.2 +009200 05 FFILE-RECORD-INFO-P1-120. SQ2284.2 +009300 07 FILLER PIC X(5). SQ2284.2 +009400 07 FFILE-NAME PIC X(6). SQ2284.2 +009500 07 FILLER PIC X(8). SQ2284.2 +009600 07 FRECORD-NAME PIC X(6). SQ2284.2 +009700 07 FILLER PIC X(1). SQ2284.2 +009800 07 FREELUNIT-NUMBER PIC 9(1). SQ2284.2 +009900 07 FILLER PIC X(7). SQ2284.2 +010000 07 FRECORD-NUMBER PIC 9(6). SQ2284.2 +010100 07 FILLER PIC X(6). SQ2284.2 +010200 07 FUPDATE-NUMBER PIC 9(2). SQ2284.2 +010300 07 FILLER PIC X(5). SQ2284.2 +010400 07 FODO-NUMBER PIC 9(4). SQ2284.2 +010500 07 FILLER PIC X(5). SQ2284.2 +010600 07 FPROGRAM-NAME PIC X(5). SQ2284.2 +010700 07 FILLER PIC X(7). SQ2284.2 +010800 07 FRECORD-LENGTH PIC 9(6). SQ2284.2 +010900 07 FILLER PIC X(7). SQ2284.2 +011000 07 FCHARS-OR-RECORDS PIC X(2). SQ2284.2 +011100 07 FILLER PIC X(1). SQ2284.2 +011200 07 FBLOCK-SIZE PIC 9(4). SQ2284.2 +011300 07 FILLER PIC X(6). SQ2284.2 +011400 07 FRECORDS-IN-FILE PIC 9(6). SQ2284.2 +011500 07 FILLER PIC X(5). SQ2284.2 +011600 07 FFILE-ORGANIZATION PIC X(2). SQ2284.2 +011700 07 FILLER PIC X(6). SQ2284.2 +011800 07 FLABEL-TYPE PIC X(1). SQ2284.2 +011900* SQ2284.2 +012000 01 SQ-FS4R2-F-G-138. SQ2284.2 +012100 03 FILLER PIC X(120). SQ2284.2 +012200 03 EXT-18 PIC X(18). SQ2284.2 +012300* SQ2284.2 +012400 WORKING-STORAGE SECTION. SQ2284.2 +012500* SQ2284.2 +012600*************************************************************** SQ2284.2 +012700* * SQ2284.2 +012800* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2284.2 +012900* * SQ2284.2 +013000*************************************************************** SQ2284.2 +013100* SQ2284.2 +013200 01 STATUS-GROUP. SQ2284.2 +013300 04 SQ-FS4-STATUS. SQ2284.2 +013400 07 SQ-FS4-KEY-1 PIC X. SQ2284.2 +013500 07 SQ-FS4-KEY-2 PIC X. SQ2284.2 +013600* SQ2284.2 +013700 01 DELETE-SW. SQ2284.2 +013800 03 DELETE-SW-1 PIC X. SQ2284.2 +013900 03 DELETE-SW-1-GROUP. SQ2284.2 +014000 05 DELETE-SW-2 PIC X. SQ2284.2 +014100* SQ2284.2 +014200 01 DECL-EXEC-I-O PIC X(12). SQ2284.2 +014300* SQ2284.2 +014400 01 DECL-EXEC-SW PIC X. SQ2284.2 +014500* SQ2284.2 +014600 01 SQ-FS4-RECSIZE PIC 999. SQ2284.2 +014700* SQ2284.2 +014800*************************************************************** SQ2284.2 +014900* * SQ2284.2 +015000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2284.2 +015100* * SQ2284.2 +015200*************************************************************** SQ2284.2 +015300* SQ2284.2 +015400 01 REC-SKEL-SUB PIC 99. SQ2284.2 +015500* SQ2284.2 +015600 01 FILE-RECORD-INFORMATION-REC. SQ2284.2 +015700 03 FILE-RECORD-INFO-SKELETON. SQ2284.2 +015800 05 FILLER PICTURE X(48) VALUE SQ2284.2 +015900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2284.2 +016000 05 FILLER PICTURE X(46) VALUE SQ2284.2 +016100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2284.2 +016200 05 FILLER PICTURE X(26) VALUE SQ2284.2 +016300 ",LFIL=000000,ORG= ,LBLR= ". SQ2284.2 +016400 05 FILLER PICTURE X(37) VALUE SQ2284.2 +016500 ",RECKEY= ". SQ2284.2 +016600 05 FILLER PICTURE X(38) VALUE SQ2284.2 +016700 ",ALTKEY1= ". SQ2284.2 +016800 05 FILLER PICTURE X(38) VALUE SQ2284.2 +016900 ",ALTKEY2= ". SQ2284.2 +017000 05 FILLER PICTURE X(7) VALUE SPACE.SQ2284.2 +017100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2284.2 +017200 05 FILE-RECORD-INFO-P1-120. SQ2284.2 +017300 07 FILLER PIC X(5). SQ2284.2 +017400 07 XFILE-NAME PIC X(6). SQ2284.2 +017500 07 FILLER PIC X(8). SQ2284.2 +017600 07 XRECORD-NAME PIC X(6). SQ2284.2 +017700 07 FILLER PIC X(1). SQ2284.2 +017800 07 REELUNIT-NUMBER PIC 9(1). SQ2284.2 +017900 07 FILLER PIC X(7). SQ2284.2 +018000 07 XRECORD-NUMBER PIC 9(6). SQ2284.2 +018100 07 FILLER PIC X(6). SQ2284.2 +018200 07 UPDATE-NUMBER PIC 9(2). SQ2284.2 +018300 07 FILLER PIC X(5). SQ2284.2 +018400 07 ODO-NUMBER PIC 9(4). SQ2284.2 +018500 07 FILLER PIC X(5). SQ2284.2 +018600 07 XPROGRAM-NAME PIC X(5). SQ2284.2 +018700 07 FILLER PIC X(7). SQ2284.2 +018800 07 XRECORD-LENGTH PIC 9(6). SQ2284.2 +018900 07 FILLER PIC X(7). SQ2284.2 +019000 07 CHARS-OR-RECORDS PIC X(2). SQ2284.2 +019100 07 FILLER PIC X(1). SQ2284.2 +019200 07 XBLOCK-SIZE PIC 9(4). SQ2284.2 +019300 07 FILLER PIC X(6). SQ2284.2 +019400 07 RECORDS-IN-FILE PIC 9(6). SQ2284.2 +019500 07 FILLER PIC X(5). SQ2284.2 +019600 07 XFILE-ORGANIZATION PIC X(2). SQ2284.2 +019700 07 FILLER PIC X(6). SQ2284.2 +019800 07 XLABEL-TYPE PIC X(1). SQ2284.2 +019900 05 FILE-RECORD-INFO-P121-240. SQ2284.2 +020000 07 FILLER PIC X(8). SQ2284.2 +020100 07 XRECORD-KEY PIC X(29). SQ2284.2 +020200 07 FILLER PIC X(9). SQ2284.2 +020300 07 ALTERNATE-KEY1 PIC X(29). SQ2284.2 +020400 07 FILLER PIC X(9). SQ2284.2 +020500 07 ALTERNATE-KEY2 PIC X(29). SQ2284.2 +020600 07 FILLER PIC X(7). SQ2284.2 +020700* SQ2284.2 +020800 01 TEST-RESULTS. SQ2284.2 +020900 02 FILLER PIC X VALUE SPACE. SQ2284.2 +021000 02 PAR-NAME. SQ2284.2 +021100 03 FILLER PIC X(14) VALUE SPACE. SQ2284.2 +021200 03 PARDOT-X PIC X VALUE SPACE. SQ2284.2 +021300 03 DOTVALUE PIC 99 VALUE ZERO. SQ2284.2 +021400 02 FILLER PIC X VALUE SPACE. SQ2284.2 +021500 02 FEATURE PIC X(24) VALUE SPACE. SQ2284.2 +021600 02 FILLER PIC X VALUE SPACE. SQ2284.2 +021700 02 P-OR-F PIC X(5) VALUE SPACE. SQ2284.2 +021800 02 FILLER PIC X(9) VALUE SPACE. SQ2284.2 +021900 02 RE-MARK PIC X(61). SQ2284.2 +022000 01 TEST-COMPUTED. SQ2284.2 +022100 02 FILLER PIC X(30) VALUE SPACE. SQ2284.2 +022200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2284.2 +022300 02 COMPUTED-X. SQ2284.2 +022400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2284.2 +022500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2284.2 +022600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2284.2 +022700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2284.2 +022800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2284.2 +022900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2284.2 +023000 04 COMPUTED-18V0 PIC -9(18). SQ2284.2 +023100 04 FILLER PIC X. SQ2284.2 +023200 03 FILLER PIC X(50) VALUE SPACE. SQ2284.2 +023300 01 TEST-CORRECT. SQ2284.2 +023400 02 FILLER PIC X(30) VALUE SPACE. SQ2284.2 +023500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2284.2 +023600 02 CORRECT-X. SQ2284.2 +023700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2284.2 +023800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2284.2 +023900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2284.2 +024000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2284.2 +024100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2284.2 +024200 03 CR-18V0 REDEFINES CORRECT-A. SQ2284.2 +024300 04 CORRECT-18V0 PIC -9(18). SQ2284.2 +024400 04 FILLER PIC X. SQ2284.2 +024500 03 FILLER PIC X(2) VALUE SPACE. SQ2284.2 +024600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2284.2 +024700* SQ2284.2 +024800 01 CCVS-C-1. SQ2284.2 +024900 02 FILLER PIC IS X VALUE SPACE. SQ2284.2 +025000 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ2284.2 +025100 02 FILLER PIC IS X VALUE SPACE. SQ2284.2 +025200 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ2284.2 +025300 02 FILLER PIC IS X VALUE SPACE. SQ2284.2 +025400 02 FILLER PIC IS X(5) VALUE "PASS ". SQ2284.2 +025500 02 FILLER PIC IS X(9) VALUE SPACE. SQ2284.2 +025600 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ2284.2 +025700 01 CCVS-C-2. SQ2284.2 +025800 02 FILLER PIC X(19) VALUE SPACE. SQ2284.2 +025900 02 FILLER PIC X(6) VALUE "TESTED". SQ2284.2 +026000 02 FILLER PIC X(19) VALUE SPACE. SQ2284.2 +026100 02 FILLER PIC X(4) VALUE "FAIL". SQ2284.2 +026200 02 FILLER PIC X(72) VALUE SPACE. SQ2284.2 +026300* SQ2284.2 +026400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2284.2 +026500 01 REC-CT PIC 99 VALUE ZERO. SQ2284.2 +026600 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2284.2 +026700 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2284.2 +026800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2284.2 +026900 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2284.2 +027000 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2284.2 +027100 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2284.2 +027200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2284.2 +027300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2284.2 +027400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2284.2 +027500 01 CCVS-H-1. SQ2284.2 +027600 02 FILLER PIC X(39) VALUE SPACES. SQ2284.2 +027700 02 FILLER PIC X(42) VALUE SQ2284.2 +027800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2284.2 +027900 02 FILLER PIC X(39) VALUE SPACES. SQ2284.2 +028000 01 CCVS-H-2A. SQ2284.2 +028100 02 FILLER PIC X(40) VALUE SPACE. SQ2284.2 +028200 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2284.2 +028300 02 FILLER PIC XXXX VALUE SQ2284.2 +028400 "4.2 ". SQ2284.2 +028500 02 FILLER PIC X(28) VALUE SQ2284.2 +028600 " COPY - NOT FOR DISTRIBUTION". SQ2284.2 +028700 02 FILLER PIC X(41) VALUE SPACE. SQ2284.2 +028800* SQ2284.2 +028900 01 CCVS-H-2B. SQ2284.2 +029000 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2284.2 +029100 02 TEST-ID PIC X(9). SQ2284.2 +029200 02 FILLER PIC X(4) VALUE " IN ". SQ2284.2 +029300 02 FILLER PIC X(12) VALUE SQ2284.2 +029400 " HIGH ". SQ2284.2 +029500 02 FILLER PIC X(22) VALUE SQ2284.2 +029600 " LEVEL VALIDATION FOR ". SQ2284.2 +029700 02 FILLER PIC X(58) VALUE SQ2284.2 +029800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2284.2 +029900 01 CCVS-H-3. SQ2284.2 +030000 02 FILLER PIC X(34) VALUE SQ2284.2 +030100 " FOR OFFICIAL USE ONLY ". SQ2284.2 +030200 02 FILLER PIC X(58) VALUE SQ2284.2 +030300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2284.2 +030400 02 FILLER PIC X(28) VALUE SQ2284.2 +030500 " COPYRIGHT 1985,1986 ". SQ2284.2 +030600 01 CCVS-E-1. SQ2284.2 +030700 02 FILLER PIC X(52) VALUE SPACE. SQ2284.2 +030800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2284.2 +030900 02 ID-AGAIN PIC X(9). SQ2284.2 +031000 02 FILLER PIC X(45) VALUE SPACES. SQ2284.2 +031100 01 CCVS-E-2. SQ2284.2 +031200 02 FILLER PIC X(31) VALUE SPACE. SQ2284.2 +031300 02 FILLER PIC X(21) VALUE SPACE. SQ2284.2 +031400 02 CCVS-E-2-2. SQ2284.2 +031500 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2284.2 +031600 03 FILLER PIC X VALUE SPACE. SQ2284.2 +031700 03 ENDER-DESC PIC X(44) VALUE SQ2284.2 +031800 "ERRORS ENCOUNTERED". SQ2284.2 +031900 01 CCVS-E-3. SQ2284.2 +032000 02 FILLER PIC X(22) VALUE SQ2284.2 +032100 " FOR OFFICIAL USE ONLY". SQ2284.2 +032200 02 FILLER PIC X(12) VALUE SPACE. SQ2284.2 +032300 02 FILLER PIC X(58) VALUE SQ2284.2 +032400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2284.2 +032500 02 FILLER PIC X(8) VALUE SPACE. SQ2284.2 +032600 02 FILLER PIC X(20) VALUE SQ2284.2 +032700 " COPYRIGHT 1985,1986". SQ2284.2 +032800 01 CCVS-E-4. SQ2284.2 +032900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2284.2 +033000 02 FILLER PIC X(4) VALUE " OF ". SQ2284.2 +033100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2284.2 +033200 02 FILLER PIC X(40) VALUE SQ2284.2 +033300 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2284.2 +033400 01 XXINFO. SQ2284.2 +033500 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2284.2 +033600 02 INFO-TEXT. SQ2284.2 +033700 04 FILLER PIC X(8) VALUE SPACE. SQ2284.2 +033800 04 XXCOMPUTED PIC X(20). SQ2284.2 +033900 04 FILLER PIC X(5) VALUE SPACE. SQ2284.2 +034000 04 XXCORRECT PIC X(20). SQ2284.2 +034100 02 INF-ANSI-REFERENCE PIC X(48). SQ2284.2 +034200 01 HYPHEN-LINE. SQ2284.2 +034300 02 FILLER PIC IS X VALUE IS SPACE. SQ2284.2 +034400 02 FILLER PIC IS X(65) VALUE IS "************************SQ2284.2 +034500- "*****************************************". SQ2284.2 +034600 02 FILLER PIC IS X(54) VALUE IS "************************SQ2284.2 +034700- "******************************". SQ2284.2 +034800 01 CCVS-PGM-ID PIC X(9) VALUE SQ2284.2 +034900 "SQ228A". SQ2284.2 +035000* SQ2284.2 +035100* SQ2284.2 +035200 PROCEDURE DIVISION. SQ2284.2 +035300 DECLARATIVES. SQ2284.2 +035400* SQ2284.2 +035500 SECT-SQ228A-0001 SECTION. SQ2284.2 +035600 USE AFTER EXCEPTION PROCEDURE I-O. SQ2284.2 +035700 I-O-ERROR-PROCESS. SQ2284.2 +035800 MOVE "EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +035900 IF DECL-EXEC-SW NOT = SPACE SQ2284.2 +036000 GO TO END-DECLS. SQ2284.2 +036100* SQ2284.2 +036200 MOVE 1 TO REC-CT. SQ2284.2 +036300 MOVE "DCL-REWRITE-01" TO PAR-NAME. SQ2284.2 +036400 GO TO DCL-REWRITE-01-01. SQ2284.2 +036500 DECL-DELETE-01-01. SQ2284.2 +036600 PERFORM DECL-DE-LETE. SQ2284.2 +036700 GO TO DECL-TEST-01-01-END. SQ2284.2 +036800 DCL-REWRITE-01-01. SQ2284.2 +036900 DECL-TEST-01-01-END. SQ2284.2 +037000* SQ2284.2 +037100 ADD 1 TO REC-CT. SQ2284.2 +037200 GO TO DCL-REWRITE-01-02. SQ2284.2 +037300 DECL-DELETE-01-02. SQ2284.2 +037400 PERFORM DECL-DE-LETE. SQ2284.2 +037500 GO TO DECL-TEST-01-02-END. SQ2284.2 +037600 DCL-REWRITE-01-02. SQ2284.2 +037700 DECL-TEST-01-02-END. SQ2284.2 +037800* SQ2284.2 +037900 ADD 1 TO REC-CT. SQ2284.2 +038000 GO TO DCL-REWRITE-01-03. SQ2284.2 +038100 DECL-DELETE-01-03. SQ2284.2 +038200 PERFORM DECL-DE-LETE. SQ2284.2 +038300 GO TO DECL-TEST-01-03-END. SQ2284.2 +038400 DCL-REWRITE-01-03. SQ2284.2 +038500 DECL-TEST-01-03-END. SQ2284.2 +038600* SQ2284.2 +038700 PERFORM DECL-WRITE-LINE. SQ2284.2 +038800 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2284.2 +038900 TO DUMMY-RECORD. SQ2284.2 +039000 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2284.2 +039100 GO TO END-DECLS. SQ2284.2 +039200* SQ2284.2 +039300* SQ2284.2 +039400 DECL-PASS. SQ2284.2 +039500 MOVE "PASS " TO P-OR-F. SQ2284.2 +039600 ADD 1 TO PASS-COUNTER. SQ2284.2 +039700 PERFORM DECL-PRINT-DETAIL. SQ2284.2 +039800* SQ2284.2 +039900 DECL-FAIL. SQ2284.2 +040000 MOVE "FAIL*" TO P-OR-F. SQ2284.2 +040100 ADD 1 TO ERROR-COUNTER. SQ2284.2 +040200 PERFORM DECL-PRINT-DETAIL. SQ2284.2 +040300* SQ2284.2 +040400 DECL-DE-LETE. SQ2284.2 +040500 MOVE "****TEST DELETED****" TO RE-MARK. SQ2284.2 +040600 MOVE "*****" TO P-OR-F. SQ2284.2 +040700 ADD 1 TO DELETE-COUNTER. SQ2284.2 +040800 PERFORM DECL-PRINT-DETAIL. SQ2284.2 +040900* SQ2284.2 +041000 DECL-PRINT-DETAIL. SQ2284.2 +041100 IF REC-CT NOT EQUAL TO ZERO SQ2284.2 +041200 MOVE "." TO PARDOT-X SQ2284.2 +041300 MOVE REC-CT TO DOTVALUE. SQ2284.2 +041400 MOVE TEST-RESULTS TO PRINT-REC. SQ2284.2 +041500 PERFORM DECL-WRITE-LINE. SQ2284.2 +041600 IF P-OR-F EQUAL TO "FAIL*" SQ2284.2 +041700 PERFORM DECL-WRITE-LINE SQ2284.2 +041800 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2284.2 +041900 ELSE SQ2284.2 +042000 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2284.2 +042100 MOVE SPACE TO P-OR-F. SQ2284.2 +042200 MOVE SPACE TO COMPUTED-X. SQ2284.2 +042300 MOVE SPACE TO CORRECT-X. SQ2284.2 +042400 IF REC-CT EQUAL TO ZERO SQ2284.2 +042500 MOVE SPACE TO PAR-NAME. SQ2284.2 +042600 MOVE SPACE TO RE-MARK. SQ2284.2 +042700* SQ2284.2 +042800 DECL-WRITE-LINE. SQ2284.2 +042900 ADD 1 TO RECORD-COUNT. SQ2284.2 +043000 IF RECORD-COUNT GREATER 50 SQ2284.2 +043100 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2284.2 +043200 MOVE SPACE TO DUMMY-RECORD SQ2284.2 +043300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2284.2 +043400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2284.2 +043500 MOVE CCVS-C-2 TO DUMMY-RECORD SQ2284.2 +043600 PERFORM DECL-WRT-LN 2 TIMES SQ2284.2 +043700 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2284.2 +043800 PERFORM DECL-WRT-LN SQ2284.2 +043900 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2284.2 +044000 MOVE ZERO TO RECORD-COUNT. SQ2284.2 +044100 PERFORM DECL-WRT-LN. SQ2284.2 +044200* SQ2284.2 +044300 DECL-WRT-LN. SQ2284.2 +044400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2284.2 +044500 MOVE SPACE TO DUMMY-RECORD. SQ2284.2 +044600* SQ2284.2 +044700 DECL-FAIL-ROUTINE. SQ2284.2 +044800 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2284.2 +044900 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2284.2 +045000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2284.2 +045100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2284.2 +045200 MOVE XXINFO TO DUMMY-RECORD. SQ2284.2 +045300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2284.2 +045400 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2284.2 +045500 GO TO DECL-FAIL-EX. SQ2284.2 +045600 DECL-FAIL-WRITE. SQ2284.2 +045700 MOVE TEST-COMPUTED TO PRINT-REC SQ2284.2 +045800 PERFORM DECL-WRITE-LINE SQ2284.2 +045900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2284.2 +046000 MOVE TEST-CORRECT TO PRINT-REC SQ2284.2 +046100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2284.2 +046200 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2284.2 +046300 DECL-FAIL-EX. SQ2284.2 +046400 EXIT. SQ2284.2 +046500* SQ2284.2 +046600 DECL-BAIL. SQ2284.2 +046700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2284.2 +046800 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2284.2 +046900 DECL-BAIL-WRITE. SQ2284.2 +047000 MOVE CORRECT-A TO XXCORRECT. SQ2284.2 +047100 MOVE COMPUTED-A TO XXCOMPUTED. SQ2284.2 +047200 MOVE XXINFO TO DUMMY-RECORD. SQ2284.2 +047300 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2284.2 +047400 DECL-BAIL-EX. SQ2284.2 +047500 EXIT. SQ2284.2 +047600* SQ2284.2 +047700 END-DECLS. SQ2284.2 +047800 END DECLARATIVES. SQ2284.2 +047900* SQ2284.2 +048000* SQ2284.2 +048100 CCVS1 SECTION. SQ2284.2 +048200 OPEN-FILES. SQ2284.2 +048300*P OPEN I-O RAW-DATA. SQ2284.2 +048400*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2284.2 +048500*P READ RAW-DATA INVALID KEY GO TO END-E-1. SQ2284.2 +048600*P MOVE "ABORTED " TO C-ABORT. SQ2284.2 +048700*P ADD 1 TO C-NO-OF-TESTS. SQ2284.2 +048800*P ACCEPT C-DATE FROM DATE. SQ2284.2 +048900*P ACCEPT C-TIME FROM TIME. SQ2284.2 +049000*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2284.2 +049100*PND-E-1. SQ2284.2 +049200*P CLOSE RAW-DATA. SQ2284.2 +049300 OPEN OUTPUT PRINT-FILE. SQ2284.2 +049400 MOVE CCVS-PGM-ID TO TEST-ID. SQ2284.2 +049500 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2284.2 +049600 MOVE SPACE TO TEST-RESULTS. SQ2284.2 +049700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2284.2 +049800 MOVE ZERO TO REC-SKEL-SUB. SQ2284.2 +049900 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2284.2 +050000 GO TO CCVS1-EXIT. SQ2284.2 +050100* SQ2284.2 +050200 CCVS-INIT-FILE. SQ2284.2 +050300 ADD 1 TO REC-SKL-SUB. SQ2284.2 +050400 MOVE FILE-RECORD-INFO-SKELETON TO SQ2284.2 +050500 FILE-RECORD-INFO (REC-SKL-SUB). SQ2284.2 +050600* SQ2284.2 +050700 CLOSE-FILES. SQ2284.2 +050800 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2284.2 +050900 CLOSE PRINT-FILE. SQ2284.2 +051000*P OPEN I-O RAW-DATA. SQ2284.2 +051100*P MOVE CCVS-PGM-ID TO RAW-DATA-KEY. SQ2284.2 +051200*P READ RAW-DATA INVALID KEY GO TO END-E-2. SQ2284.2 +051300*P MOVE "OK. " TO C-ABORT. SQ2284.2 +051400*P MOVE PASS-COUNTER TO C-OK. SQ2284.2 +051500*P MOVE ERROR-HOLD TO C-ALL. SQ2284.2 +051600*P MOVE ERROR-COUNTER TO C-FAIL. SQ2284.2 +051700*P MOVE DELETE-CNT TO C-DELETED. SQ2284.2 +051800*P MOVE INSPECT-COUNTER TO C-INSPECT. SQ2284.2 +051900*P REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE. SQ2284.2 +052000*PND-E-2. SQ2284.2 +052100*P CLOSE RAW-DATA. SQ2284.2 +052200 TERMINATE-CCVS. SQ2284.2 +052300*S EXIT PROGRAM. SQ2284.2 +052400 STOP RUN. SQ2284.2 +052500* SQ2284.2 +052600 INSPT. SQ2284.2 +052700 MOVE "INSPT" TO P-OR-F. SQ2284.2 +052800 ADD 1 TO INSPECT-COUNTER. SQ2284.2 +052900 PERFORM PRINT-DETAIL. SQ2284.2 +053000* SQ2284.2 +053100 PASS. SQ2284.2 +053200 MOVE "PASS " TO P-OR-F. SQ2284.2 +053300 ADD 1 TO PASS-COUNTER. SQ2284.2 +053400 PERFORM PRINT-DETAIL. SQ2284.2 +053500* SQ2284.2 +053600 FAIL. SQ2284.2 +053700 MOVE "FAIL*" TO P-OR-F. SQ2284.2 +053800 ADD 1 TO ERROR-COUNTER. SQ2284.2 +053900 PERFORM PRINT-DETAIL. SQ2284.2 +054000* SQ2284.2 +054100 DE-LETE. SQ2284.2 +054200 MOVE "****TEST DELETED****" TO RE-MARK. SQ2284.2 +054300 MOVE "*****" TO P-OR-F. SQ2284.2 +054400 ADD 1 TO DELETE-COUNTER. SQ2284.2 +054500 PERFORM PRINT-DETAIL. SQ2284.2 +054600* SQ2284.2 +054700 PRINT-DETAIL. SQ2284.2 +054800 IF REC-CT NOT EQUAL TO ZERO SQ2284.2 +054900 MOVE "." TO PARDOT-X SQ2284.2 +055000 MOVE REC-CT TO DOTVALUE. SQ2284.2 +055100 MOVE TEST-RESULTS TO PRINT-REC. SQ2284.2 +055200 PERFORM WRITE-LINE. SQ2284.2 +055300 IF P-OR-F EQUAL TO "FAIL*" SQ2284.2 +055400 PERFORM WRITE-LINE SQ2284.2 +055500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2284.2 +055600 ELSE SQ2284.2 +055700 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2284.2 +055800 MOVE SPACE TO P-OR-F. SQ2284.2 +055900 MOVE SPACE TO COMPUTED-X. SQ2284.2 +056000 MOVE SPACE TO CORRECT-X. SQ2284.2 +056100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2284.2 +056200 MOVE SPACE TO RE-MARK. SQ2284.2 +056300* SQ2284.2 +056400 HEAD-ROUTINE. SQ2284.2 +056500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +056600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +056700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2284.2 +056800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2284.2 +056900 COLUMN-NAMES-ROUTINE. SQ2284.2 +057000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2284.2 +057100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +057200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2284.2 +057300 END-ROUTINE. SQ2284.2 +057400 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2284.2 +057500 PERFORM WRITE-LINE 5 TIMES. SQ2284.2 +057600 END-RTN-EXIT. SQ2284.2 +057700 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2284.2 +057800 PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +057900* SQ2284.2 +058000 END-ROUTINE-1. SQ2284.2 +058100 ADD ERROR-COUNTER TO ERROR-HOLD SQ2284.2 +058200 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2284.2 +058300 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2284.2 +058400 ADD PASS-COUNTER TO ERROR-HOLD. SQ2284.2 +058500 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2284.2 +058600 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2284.2 +058700 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2284.2 +058800 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2284.2 +058900 PERFORM WRITE-LINE. SQ2284.2 +059000 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2284.2 +059100 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2284.2 +059200 MOVE "NO " TO ERROR-TOTAL SQ2284.2 +059300 ELSE SQ2284.2 +059400 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2284.2 +059500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2284.2 +059600 PERFORM WRITE-LINE. SQ2284.2 +059700 END-ROUTINE-13. SQ2284.2 +059800 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2284.2 +059900 MOVE "NO " TO ERROR-TOTAL SQ2284.2 +060000 ELSE SQ2284.2 +060100 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2284.2 +060200 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2284.2 +060300 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2284.2 +060400 PERFORM WRITE-LINE. SQ2284.2 +060500 IF INSPECT-COUNTER EQUAL TO ZERO SQ2284.2 +060600 MOVE "NO " TO ERROR-TOTAL SQ2284.2 +060700 ELSE SQ2284.2 +060800 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2284.2 +060900 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2284.2 +061000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2284.2 +061100 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2284.2 +061200* SQ2284.2 +061300 WRITE-LINE. SQ2284.2 +061400 ADD 1 TO RECORD-COUNT. SQ2284.2 +061500 IF RECORD-COUNT GREATER 50 SQ2284.2 +061600 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2284.2 +061700 MOVE SPACE TO DUMMY-RECORD SQ2284.2 +061800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2284.2 +061900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2284.2 +062000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2284.2 +062100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2284.2 +062200 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2284.2 +062300 MOVE ZERO TO RECORD-COUNT. SQ2284.2 +062400 PERFORM WRT-LN. SQ2284.2 +062500* SQ2284.2 +062600 WRT-LN. SQ2284.2 +062700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2284.2 +062800 MOVE SPACE TO DUMMY-RECORD. SQ2284.2 +062900 BLANK-LINE-PRINT. SQ2284.2 +063000 PERFORM WRT-LN. SQ2284.2 +063100 FAIL-ROUTINE. SQ2284.2 +063200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2284.2 +063300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2284.2 +063400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2284.2 +063500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2284.2 +063600 MOVE XXINFO TO DUMMY-RECORD. SQ2284.2 +063700 PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +063800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2284.2 +063900 GO TO FAIL-ROUTINE-EX. SQ2284.2 +064000 FAIL-ROUTINE-WRITE. SQ2284.2 +064100 MOVE TEST-COMPUTED TO PRINT-REC SQ2284.2 +064200 PERFORM WRITE-LINE SQ2284.2 +064300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2284.2 +064400 MOVE TEST-CORRECT TO PRINT-REC SQ2284.2 +064500 PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +064600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2284.2 +064700 FAIL-ROUTINE-EX. SQ2284.2 +064800 EXIT. SQ2284.2 +064900 BAIL-OUT. SQ2284.2 +065000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2284.2 +065100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2284.2 +065200 BAIL-OUT-WRITE. SQ2284.2 +065300 MOVE CORRECT-A TO XXCORRECT. SQ2284.2 +065400 MOVE COMPUTED-A TO XXCOMPUTED. SQ2284.2 +065500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2284.2 +065600 MOVE XXINFO TO DUMMY-RECORD. SQ2284.2 +065700 PERFORM WRITE-LINE 2 TIMES. SQ2284.2 +065800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2284.2 +065900 BAIL-OUT-EX. SQ2284.2 +066000 EXIT. SQ2284.2 +066100 CCVS1-EXIT. SQ2284.2 +066200 EXIT. SQ2284.2 +066300* SQ2284.2 +066400**************************************************************** SQ2284.2 +066500* * SQ2284.2 +066600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2284.2 +066700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2284.2 +066800* * SQ2284.2 +066900**************************************************************** SQ2284.2 +067000* SQ2284.2 +067100 SECT-SQ228A-0002 SECTION. SQ2284.2 +067200 STA-INIT. SQ2284.2 +067300 MOVE SPACE TO DELETE-SW. SQ2284.2 +067400* SQ2284.2 +067500 MOVE "SQ-FS4" TO XFILE-NAME (1). SQ2284.2 +067600 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2284.2 +067700 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2284.2 +067800 MOVE 120 TO XRECORD-LENGTH (1). SQ2284.2 +067900 MOVE "CC" TO CHARS-OR-RECORDS (1). SQ2284.2 +068000 MOVE 1 TO XBLOCK-SIZE (1). SQ2284.2 +068100 MOVE 1 TO RECORDS-IN-FILE (1). SQ2284.2 +068200 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2284.2 +068300 MOVE "S" TO XLABEL-TYPE (1). SQ2284.2 +068400* SQ2284.2 +068500* OPEN THE FILE IN THE OUTPUT MODE SQ2284.2 +068600* SQ2284.2 +068700 SEQ-INIT-01. SQ2284.2 +068800 MOVE 0 TO REC-CT. SQ2284.2 +068900 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +069000 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +069100 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +069200 MOVE ZERO TO XRECORD-NUMBER (1). SQ2284.2 +069300 MOVE "OPEN, CREATE FILE" TO FEATURE. SQ2284.2 +069400 MOVE "SEQ-TEST-OP-01" TO PAR-NAME. SQ2284.2 +069500 GO TO SEQ-TEST-OP-01. SQ2284.2 +069600 SEQ-TEST-OP-01. SQ2284.2 +069700 OPEN OUTPUT SQ-FS4. SQ2284.2 +069800 SEQ-INIT-02. SQ2284.2 +069900 MOVE 0 TO REC-CT. SQ2284.2 +070000 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +070100 ADD 1 TO XRECORD-NUMBER (1). SQ2284.2 +070200 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +070300 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +070400 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2284.2 +070500 MOVE "987654321123456789" TO EXT-18. SQ2284.2 +070600 MOVE 120 TO SQ-FS4-RECSIZE. SQ2284.2 +070700 MOVE "WRITE A RECORD" TO FEATURE. SQ2284.2 +070800 MOVE "SEQ-TEST-WR-02" TO PAR-NAME. SQ2284.2 +070900 SEQ-TEST-WR-02. SQ2284.2 +071000 WRITE SQ-FS4R2-F-G-138. SQ2284.2 +071100 SEQ-INIT-03. SQ2284.2 +071200 MOVE 0 TO REC-CT. SQ2284.2 +071300 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +071400 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +071500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +071600 MOVE "CLOSE FILE" TO FEATURE. SQ2284.2 +071700 MOVE "SEQ-TEST-CL-03" TO PAR-NAME. SQ2284.2 +071800 SEQ-TEST-CL-03. SQ2284.2 +071900 CLOSE SQ-FS4. SQ2284.2 +072000 SEQ-INIT-04. SQ2284.2 +072100 MOVE 0 TO REC-CT. SQ2284.2 +072200 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +072300 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +072400 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +072500 MOVE ZERO TO XRECORD-NUMBER (1). SQ2284.2 +072600 MOVE "OPEN FILE FOR I-O" TO FEATURE. SQ2284.2 +072700 MOVE "SEQ-TEST-OP-04" TO PAR-NAME. SQ2284.2 +072800 SEQ-TEST-OP-04. SQ2284.2 +072900 OPEN I-O SQ-FS4. SQ2284.2 +073000 SEQ-INIT-05. SQ2284.2 +073100 MOVE 0 TO REC-CT. SQ2284.2 +073200 MOVE "*" TO DECL-EXEC-SW. SQ2284.2 +073300 ADD 1 TO XRECORD-NUMBER (1). SQ2284.2 +073400 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +073500 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +073600 MOVE ZERO TO SQ-FS4-RECSIZE. SQ2284.2 +073700 MOVE SPACE TO SQ-FS4R2-F-G-138. SQ2284.2 +073800 MOVE "READ FIRST RECORD" TO FEATURE. SQ2284.2 +073900 MOVE "SEQ-TEST-RD-05" TO PAR-NAME. SQ2284.2 +074000 SEQ-TEST-RD-05. SQ2284.2 +074100 READ SQ-FS4. SQ2284.2 +074200 SEQ-INIT-06. SQ2284.2 +074300 MOVE 0 TO REC-CT. SQ2284.2 +074400 MOVE SPACE TO DECL-EXEC-SW. SQ2284.2 +074500 MOVE "**" TO SQ-FS4-STATUS. SQ2284.2 +074600 MOVE "NOT EXECUTED" TO DECL-EXEC-I-O. SQ2284.2 +074700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120. SQ2284.2 +074800 MOVE "ABCDEFGHIJKLMNOPQR" TO EXT-18. SQ2284.2 +074900 MOVE 130 TO SQ-FS4-RECSIZE. SQ2284.2 +075000 MOVE "REWRITE DIFFERENT SIZE REC" TO FEATURE. SQ2284.2 +075100 MOVE "SEQ-TEST-RW-06" TO PAR-NAME. SQ2284.2 +075200 SEQ-TEST-RW-06. SQ2284.2 +075300 REWRITE SQ-FS4R1-F-G-120. SQ2284.2 +075400 MOVE 0 TO REC-CT. SQ2284.2 +075500* SQ2284.2 +075600* CHECK I-O STATUS RETURNED FROM REWRITE SQ2284.2 +075700* SQ2284.2 +075800 ADD 1 TO REC-CT. SQ2284.2 +075900 SEQ-TEST-06-01-END. SQ2284.2 +076000* SQ2284.2 +076100* CHECK EXECUTION OF I-O DECLARATIVE SQ2284.2 +076200* SQ2284.2 +076300 ADD 1 TO REC-CT. SQ2284.2 +076400 IF DELETE-SW NOT = SPACE SQ2284.2 +076500 GO TO SEQ-DELETE-06-02. SQ2284.2 +076600 GO TO SEQ-TEST-RW-06-02. SQ2284.2 +076700 SEQ-DELETE-06-02. SQ2284.2 +076800 PERFORM DE-LETE. SQ2284.2 +076900 GO TO SEQ-TEST-06-02-END. SQ2284.2 +077000 SEQ-TEST-RW-06-02. SQ2284.2 +077100 IF DECL-EXEC-I-O = "EXECUTED" SQ2284.2 +077200 PERFORM PASS SQ2284.2 +077300 ELSE SQ2284.2 +077400 MOVE DECL-EXEC-I-O TO COMPUTED-A SQ2284.2 +077500 MOVE "EXECUTED" TO CORRECT-A SQ2284.2 +077600 MOVE "DECLARATIVE NOT EXECUTED ON REWRITE" SQ2284.2 +077700 TO RE-MARK SQ2284.2 +077800 MOVE "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE SQ2284.2 +077900 PERFORM FAIL. SQ2284.2 +078000 SEQ-TEST-06-02-END. SQ2284.2 +078100 CCVS-EXIT SECTION. SQ2284.2 +078200 CCVS-999999. SQ2284.2 +078300 GO TO CLOSE-FILES. SQ2284.2 diff --git a/tests/cobol85/SQ/SQ229A.CBL b/tests/cobol85/SQ/SQ229A.CBL new file mode 100755 index 00000000..0d839cca --- /dev/null +++ b/tests/cobol85/SQ/SQ229A.CBL @@ -0,0 +1,609 @@ +000100 IDENTIFICATION DIVISION. SQ2294.2 +000200 PROGRAM-ID. SQ2294.2 +000300 SQ229A. SQ2294.2 +000400**************************************************************** SQ2294.2 +000500* * SQ2294.2 +000600* VALIDATION FOR:- * SQ2294.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2294.2 +000800* USING CCVS85 VERSION 3.0. * SQ2294.2 +000900* * SQ2294.2 +001000* CREATION DATE / VALIDATION DATE * SQ2294.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2294.2 +001200* * SQ2294.2 +001300**************************************************************** SQ2294.2 +001400* * SQ2294.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2294.2 +001600* * SQ2294.2 +001700* X-01 SEQUENTIAL TAPE * SQ2294.2 +001800* X-55 SYSTEM PRINTER * SQ2294.2 +001900* X-82 SOURCE-COMPUTER * SQ2294.2 +002000* X-83 OBJECT-COMPUTER * SQ2294.2 +002100* X-84 LABEL RECORDS OPTION. * SQ2294.2 +002200* * SQ2294.2 +002300**************************************************************** SQ2294.2 +002400* * SQ2294.2 +002500* THIS PROGRM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ2294.2 +002600* A FILE OPEN IN THE EXTEND MODE. THE TEST FOR CORRECT * SQ2294.2 +002700* I-O STATUS CODE 47 IS IN THE DECLARATIVES. AN ABNORMAL * SQ2294.2 +002800* TERMINATION IS POSSIBLE AFTER THE TEST OF THE I-O STATUS * SQ2294.2 +002900* CODE IS ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE* SQ2294.2 +003000* MAIN LINE CODE. * SQ2294.2 +003100* * SQ2294.2 +003200**************************************************************** SQ2294.2 +003300* SQ2294.2 +003400 ENVIRONMENT DIVISION. SQ2294.2 +003500 CONFIGURATION SECTION. SQ2294.2 +003600 SOURCE-COMPUTER. SQ2294.2 +003700 Linux. SQ2294.2 +003800 OBJECT-COMPUTER. SQ2294.2 +003900 Linux. SQ2294.2 +004000* SQ2294.2 +004100 INPUT-OUTPUT SECTION. SQ2294.2 +004200 FILE-CONTROL. SQ2294.2 +004300 SELECT PRINT-FILE ASSIGN TO SQ2294.2 +004400 "report.log". SQ2294.2 +004500* SQ2294.2 +004600 SELECT SQ-FS1 ASSIGN TO SQ2294.2 +004700 "XXXXX001" SQ2294.2 +004800 FILE STATUS IS SQ-FS1-STATUS. SQ2294.2 +004900* SQ2294.2 +005000* SQ2294.2 +005100 DATA DIVISION. SQ2294.2 +005200 FILE SECTION. SQ2294.2 +005300 FD PRINT-FILE SQ2294.2 +005400*C LABEL RECORDS SQ2294.2 +005500*C OMITTED SQ2294.2 +005600*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2294.2 +005700 . SQ2294.2 +005800 01 PRINT-REC PICTURE X(120). SQ2294.2 +005900 01 DUMMY-RECORD PICTURE X(120). SQ2294.2 +006000* SQ2294.2 +006100 FD SQ-FS1 SQ2294.2 +006200*C LABEL RECORD IS STANDARD SQ2294.2 +006300 . SQ2294.2 +006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2294.2 +006500* SQ2294.2 +006600 WORKING-STORAGE SECTION. SQ2294.2 +006700* SQ2294.2 +006800*************************************************************** SQ2294.2 +006900* * SQ2294.2 +007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2294.2 +007100* * SQ2294.2 +007200*************************************************************** SQ2294.2 +007300* SQ2294.2 +007400 01 SQ-FS1-STATUS. SQ2294.2 +007500 03 SQ-FS1-KEY-1 PIC X. SQ2294.2 +007600 03 SQ-FS1-KEY-2 PIC X. SQ2294.2 +007700* SQ2294.2 +007800*************************************************************** SQ2294.2 +007900* * SQ2294.2 +008000* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2294.2 +008100* * SQ2294.2 +008200*************************************************************** SQ2294.2 +008300* SQ2294.2 +008400 01 REC-SKEL-SUB PIC 99. SQ2294.2 +008500* SQ2294.2 +008600 01 FILE-RECORD-INFORMATION-REC. SQ2294.2 +008700 03 FILE-RECORD-INFO-SKELETON. SQ2294.2 +008800 05 FILLER PICTURE X(48) VALUE SQ2294.2 +008900 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2294.2 +009000 05 FILLER PICTURE X(46) VALUE SQ2294.2 +009100 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2294.2 +009200 05 FILLER PICTURE X(26) VALUE SQ2294.2 +009300 ",LFIL=000000,ORG= ,LBLR= ". SQ2294.2 +009400 05 FILLER PICTURE X(37) VALUE SQ2294.2 +009500 ",RECKEY= ". SQ2294.2 +009600 05 FILLER PICTURE X(38) VALUE SQ2294.2 +009700 ",ALTKEY1= ". SQ2294.2 +009800 05 FILLER PICTURE X(38) VALUE SQ2294.2 +009900 ",ALTKEY2= ". SQ2294.2 +010000 05 FILLER PICTURE X(7) VALUE SPACE.SQ2294.2 +010100 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2294.2 +010200 05 FILE-RECORD-INFO-P1-120. SQ2294.2 +010300 07 FILLER PIC X(5). SQ2294.2 +010400 07 XFILE-NAME PIC X(6). SQ2294.2 +010500 07 FILLER PIC X(8). SQ2294.2 +010600 07 XRECORD-NAME PIC X(6). SQ2294.2 +010700 07 FILLER PIC X(1). SQ2294.2 +010800 07 REELUNIT-NUMBER PIC 9(1). SQ2294.2 +010900 07 FILLER PIC X(7). SQ2294.2 +011000 07 XRECORD-NUMBER PIC 9(6). SQ2294.2 +011100 07 FILLER PIC X(6). SQ2294.2 +011200 07 UPDATE-NUMBER PIC 9(2). SQ2294.2 +011300 07 FILLER PIC X(5). SQ2294.2 +011400 07 ODO-NUMBER PIC 9(4). SQ2294.2 +011500 07 FILLER PIC X(5). SQ2294.2 +011600 07 XPROGRAM-NAME PIC X(5). SQ2294.2 +011700 07 FILLER PIC X(7). SQ2294.2 +011800 07 XRECORD-LENGTH PIC 9(6). SQ2294.2 +011900 07 FILLER PIC X(7). SQ2294.2 +012000 07 CHARS-OR-RECORDS PIC X(2). SQ2294.2 +012100 07 FILLER PIC X(1). SQ2294.2 +012200 07 XBLOCK-SIZE PIC 9(4). SQ2294.2 +012300 07 FILLER PIC X(6). SQ2294.2 +012400 07 RECORDS-IN-FILE PIC 9(6). SQ2294.2 +012500 07 FILLER PIC X(5). SQ2294.2 +012600 07 XFILE-ORGANIZATION PIC X(2). SQ2294.2 +012700 07 FILLER PIC X(6). SQ2294.2 +012800 07 XLABEL-TYPE PIC X(1). SQ2294.2 +012900 05 FILE-RECORD-INFO-P121-240. SQ2294.2 +013000 07 FILLER PIC X(8). SQ2294.2 +013100 07 XRECORD-KEY PIC X(29). SQ2294.2 +013200 07 FILLER PIC X(9). SQ2294.2 +013300 07 ALTERNATE-KEY1 PIC X(29). SQ2294.2 +013400 07 FILLER PIC X(9). SQ2294.2 +013500 07 ALTERNATE-KEY2 PIC X(29). SQ2294.2 +013600 07 FILLER PIC X(7). SQ2294.2 +013700* SQ2294.2 +013800 01 TEST-RESULTS. SQ2294.2 +013900 02 FILLER PIC X VALUE SPACE. SQ2294.2 +014000 02 FEATURE PIC X(24) VALUE SPACE. SQ2294.2 +014100 02 FILLER PIC X VALUE SPACE. SQ2294.2 +014200 02 P-OR-F PIC X(5) VALUE SPACE. SQ2294.2 +014300 02 FILLER PIC X VALUE SPACE. SQ2294.2 +014400 02 PAR-NAME. SQ2294.2 +014500 03 FILLER PIC X(14) VALUE SPACE. SQ2294.2 +014600 03 PARDOT-X PIC X VALUE SPACE. SQ2294.2 +014700 03 DOTVALUE PIC 99 VALUE ZERO. SQ2294.2 +014800 02 FILLER PIC X(9) VALUE SPACE. SQ2294.2 +014900 02 RE-MARK PIC X(61). SQ2294.2 +015000 01 TEST-COMPUTED. SQ2294.2 +015100 02 FILLER PIC X(30) VALUE SPACE. SQ2294.2 +015200 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2294.2 +015300 02 COMPUTED-X. SQ2294.2 +015400 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2294.2 +015500 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2294.2 +015600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2294.2 +015700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2294.2 +015800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2294.2 +015900 03 CM-18V0 REDEFINES COMPUTED-A. SQ2294.2 +016000 04 COMPUTED-18V0 PIC -9(18). SQ2294.2 +016100 04 FILLER PIC X. SQ2294.2 +016200 03 FILLER PIC X(50) VALUE SPACE. SQ2294.2 +016300 01 TEST-CORRECT. SQ2294.2 +016400 02 FILLER PIC X(30) VALUE SPACE. SQ2294.2 +016500 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2294.2 +016600 02 CORRECT-X. SQ2294.2 +016700 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2294.2 +016800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2294.2 +016900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2294.2 +017000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2294.2 +017100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2294.2 +017200 03 CR-18V0 REDEFINES CORRECT-A. SQ2294.2 +017300 04 CORRECT-18V0 PIC -9(18). SQ2294.2 +017400 04 FILLER PIC X. SQ2294.2 +017500 03 FILLER PIC X(2) VALUE SPACE. SQ2294.2 +017600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2294.2 +017700 01 CCVS-C-1. SQ2294.2 +017800 02 FILLER PIC IS X(4) VALUE SPACE. SQ2294.2 +017900 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ2294.2 +018000- "SS PARAGRAPH-NAME SQ2294.2 +018100- " REMARKS". SQ2294.2 +018200 02 FILLER PIC X(17) VALUE SPACE. SQ2294.2 +018300 01 CCVS-C-2. SQ2294.2 +018400 02 FILLER PIC XXXX VALUE SPACE. SQ2294.2 +018500 02 FILLER PIC X(6) VALUE "TESTED". SQ2294.2 +018600 02 FILLER PIC X(16) VALUE SPACE. SQ2294.2 +018700 02 FILLER PIC X(4) VALUE "FAIL". SQ2294.2 +018800 02 FILLER PIC X(90) VALUE SPACE. SQ2294.2 +018900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2294.2 +019000 01 REC-CT PIC 99 VALUE ZERO. SQ2294.2 +019100 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2294.2 +019200 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2294.2 +019300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2294.2 +019400 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2294.2 +019500 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2294.2 +019600 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2294.2 +019700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2294.2 +019800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2294.2 +019900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2294.2 +020000 01 CCVS-H-1. SQ2294.2 +020100 02 FILLER PIC X(39) VALUE SPACES. SQ2294.2 +020200 02 FILLER PIC X(42) VALUE SQ2294.2 +020300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2294.2 +020400 02 FILLER PIC X(39) VALUE SPACES. SQ2294.2 +020500 01 CCVS-H-2A. SQ2294.2 +020600 02 FILLER PIC X(40) VALUE SPACE. SQ2294.2 +020700 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2294.2 +020800 02 FILLER PIC XXXX VALUE SQ2294.2 +020900 "4.2 ". SQ2294.2 +021000 02 FILLER PIC X(28) VALUE SQ2294.2 +021100 " COPY - NOT FOR DISTRIBUTION". SQ2294.2 +021200 02 FILLER PIC X(41) VALUE SPACE. SQ2294.2 +021300* SQ2294.2 +021400 01 CCVS-H-2B. SQ2294.2 +021500 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2294.2 +021600 02 TEST-ID PIC X(9). SQ2294.2 +021700 02 FILLER PIC X(4) VALUE " IN ". SQ2294.2 +021800 02 FILLER PIC X(12) VALUE SQ2294.2 +021900 " HIGH ". SQ2294.2 +022000 02 FILLER PIC X(22) VALUE SQ2294.2 +022100 " LEVEL VALIDATION FOR ". SQ2294.2 +022200 02 FILLER PIC X(58) VALUE SQ2294.2 +022300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2294.2 +022400 01 CCVS-H-3. SQ2294.2 +022500 02 FILLER PIC X(34) VALUE SQ2294.2 +022600 " FOR OFFICIAL USE ONLY ". SQ2294.2 +022700 02 FILLER PIC X(58) VALUE SQ2294.2 +022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2294.2 +022900 02 FILLER PIC X(28) VALUE SQ2294.2 +023000 " COPYRIGHT 1985,1986 ". SQ2294.2 +023100 01 CCVS-E-1. SQ2294.2 +023200 02 FILLER PIC X(52) VALUE SPACE. SQ2294.2 +023300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2294.2 +023400 02 ID-AGAIN PIC X(9). SQ2294.2 +023500 02 FILLER PIC X(45) VALUE SPACES. SQ2294.2 +023600 01 CCVS-E-2. SQ2294.2 +023700 02 FILLER PIC X(31) VALUE SPACE. SQ2294.2 +023800 02 FILLER PIC X(21) VALUE SPACE. SQ2294.2 +023900 02 CCVS-E-2-2. SQ2294.2 +024000 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2294.2 +024100 03 FILLER PIC X VALUE SPACE. SQ2294.2 +024200 03 ENDER-DESC PIC X(44) VALUE SQ2294.2 +024300 "ERRORS ENCOUNTERED". SQ2294.2 +024400 01 CCVS-E-3. SQ2294.2 +024500 02 FILLER PIC X(22) VALUE SQ2294.2 +024600 " FOR OFFICIAL USE ONLY". SQ2294.2 +024700 02 FILLER PIC X(12) VALUE SPACE. SQ2294.2 +024800 02 FILLER PIC X(58) VALUE SQ2294.2 +024900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2294.2 +025000 02 FILLER PIC X(8) VALUE SPACE. SQ2294.2 +025100 02 FILLER PIC X(20) VALUE SQ2294.2 +025200 " COPYRIGHT 1985,1986". SQ2294.2 +025300 01 CCVS-E-4. SQ2294.2 +025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2294.2 +025500 02 FILLER PIC X(4) VALUE " OF ". SQ2294.2 +025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2294.2 +025700 02 FILLER PIC X(40) VALUE SQ2294.2 +025800 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2294.2 +025900 01 XXINFO. SQ2294.2 +026000 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2294.2 +026100 02 INFO-TEXT. SQ2294.2 +026200 04 FILLER PIC X(8) VALUE SPACE. SQ2294.2 +026300 04 XXCOMPUTED PIC X(20). SQ2294.2 +026400 04 FILLER PIC X(5) VALUE SPACE. SQ2294.2 +026500 04 XXCORRECT PIC X(20). SQ2294.2 +026600 02 INF-ANSI-REFERENCE PIC X(48). SQ2294.2 +026700 01 HYPHEN-LINE. SQ2294.2 +026800 02 FILLER PIC IS X VALUE IS SPACE. SQ2294.2 +026900 02 FILLER PIC IS X(65) VALUE IS "************************SQ2294.2 +027000- "*****************************************". SQ2294.2 +027100 02 FILLER PIC IS X(54) VALUE IS "************************SQ2294.2 +027200- "******************************". SQ2294.2 +027300 01 CCVS-PGM-ID PIC X(9) VALUE SQ2294.2 +027400 "SQ229A". SQ2294.2 +027500* SQ2294.2 +027600 PROCEDURE DIVISION. SQ2294.2 +027700 DECLARATIVES. SQ2294.2 +027800 SQ-FS1-DECLARATIVE SECTION. SQ2294.2 +027900 USE AFTER EXCEPTION PROCEDURE ON SQ-FS1. SQ2294.2 +028000 INPUT-ERROR-PROCESS. SQ2294.2 +028100 IF SQ-FS1-STATUS = "47" SQ2294.2 +028200 PERFORM DECL-PASS SQ2294.2 +028300 GO TO DECL-ABNORMAL-TERM SQ2294.2 +028400 ELSE SQ2294.2 +028500 MOVE "47" TO CORRECT-A SQ2294.2 +028600 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2294.2 +028700 MOVE "STATUS FOR READ OF FILE OPEN EXTEND INCORRECT" SQ2294.2 +028800 TO RE-MARK SQ2294.2 +028900 MOVE "VII-5, 1.3.5(4)F" TO ANSI-REFERENCE SQ2294.2 +029000 PERFORM DECL-FAIL SQ2294.2 +029100 GO TO DECL-ABNORMAL-TERM SQ2294.2 +029200 END-IF. SQ2294.2 +029300* SQ2294.2 +029400 DECL-PASS. SQ2294.2 +029500 MOVE "PASS " TO P-OR-F. SQ2294.2 +029600 ADD 1 TO PASS-COUNTER. SQ2294.2 +029700 PERFORM DECL-PRINT-DETAIL. SQ2294.2 +029800* SQ2294.2 +029900 DECL-FAIL. SQ2294.2 +030000 MOVE "FAIL*" TO P-OR-F. SQ2294.2 +030100 ADD 1 TO ERROR-COUNTER. SQ2294.2 +030200 PERFORM DECL-PRINT-DETAIL. SQ2294.2 +030300* SQ2294.2 +030400 DECL-PRINT-DETAIL. SQ2294.2 +030500 IF REC-CT NOT EQUAL TO ZERO SQ2294.2 +030600 MOVE "." TO PARDOT-X SQ2294.2 +030700 MOVE REC-CT TO DOTVALUE. SQ2294.2 +030800 MOVE TEST-RESULTS TO PRINT-REC. SQ2294.2 +030900 PERFORM DECL-WRITE-LINE. SQ2294.2 +031000 IF P-OR-F EQUAL TO "FAIL*" SQ2294.2 +031100 PERFORM DECL-WRITE-LINE SQ2294.2 +031200 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ2294.2 +031300 ELSE SQ2294.2 +031400 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ2294.2 +031500 MOVE SPACE TO P-OR-F. SQ2294.2 +031600 MOVE SPACE TO COMPUTED-X. SQ2294.2 +031700 MOVE SPACE TO CORRECT-X. SQ2294.2 +031800 IF REC-CT EQUAL TO ZERO SQ2294.2 +031900 MOVE SPACE TO PAR-NAME. SQ2294.2 +032000 MOVE SPACE TO RE-MARK. SQ2294.2 +032100* SQ2294.2 +032200 DECL-WRITE-LINE. SQ2294.2 +032300 ADD 1 TO RECORD-COUNT. SQ2294.2 +032400 IF RECORD-COUNT GREATER 50 SQ2294.2 +032500 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2294.2 +032600 MOVE SPACE TO DUMMY-RECORD SQ2294.2 +032700 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2294.2 +032800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ2294.2 +032900 MOVE CCVS-C-2 TO DUMMY-RECORD SQ2294.2 +033000 PERFORM DECL-WRT-LN 2 TIMES SQ2294.2 +033100 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ2294.2 +033200 PERFORM DECL-WRT-LN SQ2294.2 +033300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2294.2 +033400 MOVE ZERO TO RECORD-COUNT. SQ2294.2 +033500 PERFORM DECL-WRT-LN. SQ2294.2 +033600* SQ2294.2 +033700 DECL-WRT-LN. SQ2294.2 +033800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2294.2 +033900 MOVE SPACE TO DUMMY-RECORD. SQ2294.2 +034000* SQ2294.2 +034100 DECL-FAIL-ROUTINE. SQ2294.2 +034200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2294.2 +034300 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ2294.2 +034400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2294.2 +034500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2294.2 +034600 MOVE XXINFO TO DUMMY-RECORD. SQ2294.2 +034700 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2294.2 +034800 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2294.2 +034900 GO TO DECL-FAIL-EX. SQ2294.2 +035000 DECL-FAIL-WRITE. SQ2294.2 +035100 MOVE TEST-COMPUTED TO PRINT-REC SQ2294.2 +035200 PERFORM DECL-WRITE-LINE SQ2294.2 +035300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2294.2 +035400 MOVE TEST-CORRECT TO PRINT-REC SQ2294.2 +035500 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2294.2 +035600 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2294.2 +035700 DECL-FAIL-EX. SQ2294.2 +035800 EXIT. SQ2294.2 +035900* SQ2294.2 +036000 DECL-BAIL. SQ2294.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ2294.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ2294.2 +036300 DECL-BAIL-WRITE. SQ2294.2 +036400 MOVE CORRECT-A TO XXCORRECT. SQ2294.2 +036500 MOVE COMPUTED-A TO XXCOMPUTED. SQ2294.2 +036600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE SQ2294.2 +036700 MOVE XXINFO TO DUMMY-RECORD. SQ2294.2 +036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ2294.2 +036900 MOVE SPACE TO INF-ANSI-REFERENCE. SQ2294.2 +037000 DECL-BAIL-EX. SQ2294.2 +037100 EXIT. SQ2294.2 +037200* SQ2294.2 +037300 DECL-ABNORMAL-TERM. SQ2294.2 +037400 MOVE SPACE TO DUMMY-RECORD. SQ2294.2 +037500 PERFORM DECL-WRITE-LINE. SQ2294.2 +037600 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2294.2 +037700 TO DUMMY-RECORD. SQ2294.2 +037800 PERFORM DECL-WRITE-LINE 3 TIMES. SQ2294.2 +037900* SQ2294.2 +038000 END-DECLS. SQ2294.2 +038100 EXIT. SQ2294.2 +038200 END DECLARATIVES. SQ2294.2 +038300* SQ2294.2 +038400* SQ2294.2 +038500 CCVS1 SECTION. SQ2294.2 +038600 OPEN-FILES. SQ2294.2 +038700 OPEN OUTPUT PRINT-FILE. SQ2294.2 +038800 MOVE CCVS-PGM-ID TO TEST-ID. SQ2294.2 +038900 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2294.2 +039000 MOVE SPACE TO TEST-RESULTS. SQ2294.2 +039100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2294.2 +039200 MOVE ZERO TO REC-SKEL-SUB. SQ2294.2 +039300 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2294.2 +039400 GO TO CCVS1-EXIT. SQ2294.2 +039500* SQ2294.2 +039600 CCVS-INIT-FILE. SQ2294.2 +039700 ADD 1 TO REC-SKL-SUB. SQ2294.2 +039800 MOVE FILE-RECORD-INFO-SKELETON TO SQ2294.2 +039900 FILE-RECORD-INFO (REC-SKL-SUB). SQ2294.2 +040000* SQ2294.2 +040100 CLOSE-FILES. SQ2294.2 +040200 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2294.2 +040300 CLOSE PRINT-FILE. SQ2294.2 +040400 TERMINATE-CCVS. SQ2294.2 +040500 STOP RUN. SQ2294.2 +040600* SQ2294.2 +040700 INSPT. SQ2294.2 +040800 MOVE "INSPT" TO P-OR-F. SQ2294.2 +040900 ADD 1 TO INSPECT-COUNTER. SQ2294.2 +041000 PERFORM PRINT-DETAIL. SQ2294.2 +041100 SQ2294.2 +041200 PASS. SQ2294.2 +041300 MOVE "PASS " TO P-OR-F. SQ2294.2 +041400 ADD 1 TO PASS-COUNTER. SQ2294.2 +041500 PERFORM PRINT-DETAIL. SQ2294.2 +041600* SQ2294.2 +041700 FAIL. SQ2294.2 +041800 MOVE "FAIL*" TO P-OR-F. SQ2294.2 +041900 ADD 1 TO ERROR-COUNTER. SQ2294.2 +042000 PERFORM PRINT-DETAIL. SQ2294.2 +042100* SQ2294.2 +042200 DE-LETE. SQ2294.2 +042300 MOVE "****TEST DELETED****" TO RE-MARK. SQ2294.2 +042400 MOVE "*****" TO P-OR-F. SQ2294.2 +042500 ADD 1 TO DELETE-COUNTER. SQ2294.2 +042600 PERFORM PRINT-DETAIL. SQ2294.2 +042700* SQ2294.2 +042800 PRINT-DETAIL. SQ2294.2 +042900 IF REC-CT NOT EQUAL TO ZERO SQ2294.2 +043000 MOVE "." TO PARDOT-X SQ2294.2 +043100 MOVE REC-CT TO DOTVALUE. SQ2294.2 +043200 MOVE TEST-RESULTS TO PRINT-REC. SQ2294.2 +043300 PERFORM WRITE-LINE. SQ2294.2 +043400 IF P-OR-F EQUAL TO "FAIL*" SQ2294.2 +043500 PERFORM WRITE-LINE SQ2294.2 +043600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2294.2 +043700 ELSE SQ2294.2 +043800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2294.2 +043900 MOVE SPACE TO P-OR-F. SQ2294.2 +044000 MOVE SPACE TO COMPUTED-X. SQ2294.2 +044100 MOVE SPACE TO CORRECT-X. SQ2294.2 +044200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2294.2 +044300 MOVE SPACE TO RE-MARK. SQ2294.2 +044400* SQ2294.2 +044500 HEAD-ROUTINE. SQ2294.2 +044600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +044700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +044800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2294.2 +044900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2294.2 +045000 COLUMN-NAMES-ROUTINE. SQ2294.2 +045100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2294.2 +045200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +045300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2294.2 +045400 END-ROUTINE. SQ2294.2 +045500 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2294.2 +045600 PERFORM WRITE-LINE 5 TIMES. SQ2294.2 +045700 END-RTN-EXIT. SQ2294.2 +045800 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2294.2 +045900 PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +046000* SQ2294.2 +046100 END-ROUTINE-1. SQ2294.2 +046200 ADD ERROR-COUNTER TO ERROR-HOLD SQ2294.2 +046300 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2294.2 +046400 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2294.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. SQ2294.2 +046600 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2294.2 +046700 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2294.2 +046800 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2294.2 +046900 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2294.2 +047000 PERFORM WRITE-LINE. SQ2294.2 +047100 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2294.2 +047200 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2294.2 +047300 MOVE "NO " TO ERROR-TOTAL SQ2294.2 +047400 ELSE SQ2294.2 +047500 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2294.2 +047600 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2294.2 +047700 PERFORM WRITE-LINE. SQ2294.2 +047800 END-ROUTINE-13. SQ2294.2 +047900 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2294.2 +048000 MOVE "NO " TO ERROR-TOTAL SQ2294.2 +048100 ELSE SQ2294.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2294.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2294.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2294.2 +048500 PERFORM WRITE-LINE. SQ2294.2 +048600 IF INSPECT-COUNTER EQUAL TO ZERO SQ2294.2 +048700 MOVE "NO " TO ERROR-TOTAL SQ2294.2 +048800 ELSE SQ2294.2 +048900 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2294.2 +049000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2294.2 +049100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2294.2 +049200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2294.2 +049300* SQ2294.2 +049400 WRITE-LINE. SQ2294.2 +049500 ADD 1 TO RECORD-COUNT. SQ2294.2 +049600 IF RECORD-COUNT GREATER 50 SQ2294.2 +049700 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2294.2 +049800 MOVE SPACE TO DUMMY-RECORD SQ2294.2 +049900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2294.2 +050000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2294.2 +050100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2294.2 +050200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2294.2 +050300 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2294.2 +050400 MOVE ZERO TO RECORD-COUNT. SQ2294.2 +050500 PERFORM WRT-LN. SQ2294.2 +050600* SQ2294.2 +050700 WRT-LN. SQ2294.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2294.2 +050900 MOVE SPACE TO DUMMY-RECORD. SQ2294.2 +051000 BLANK-LINE-PRINT. SQ2294.2 +051100 PERFORM WRT-LN. SQ2294.2 +051200 FAIL-ROUTINE. SQ2294.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2294.2 +051400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2294.2 +051500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2294.2 +051600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2294.2 +051700 MOVE XXINFO TO DUMMY-RECORD. SQ2294.2 +051800 PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2294.2 +052000 GO TO FAIL-ROUTINE-EX. SQ2294.2 +052100 FAIL-ROUTINE-WRITE. SQ2294.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC SQ2294.2 +052300 PERFORM WRITE-LINE SQ2294.2 +052400 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2294.2 +052500 MOVE TEST-CORRECT TO PRINT-REC SQ2294.2 +052600 PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +052700 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2294.2 +052800 FAIL-ROUTINE-EX. SQ2294.2 +052900 EXIT. SQ2294.2 +053000 BAIL-OUT. SQ2294.2 +053100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2294.2 +053200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2294.2 +053300 BAIL-OUT-WRITE. SQ2294.2 +053400 MOVE CORRECT-A TO XXCORRECT. SQ2294.2 +053500 MOVE COMPUTED-A TO XXCOMPUTED. SQ2294.2 +053600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2294.2 +053700 MOVE XXINFO TO DUMMY-RECORD. SQ2294.2 +053800 PERFORM WRITE-LINE 2 TIMES. SQ2294.2 +053900 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2294.2 +054000 BAIL-OUT-EX. SQ2294.2 +054100 EXIT. SQ2294.2 +054200 CCVS1-EXIT. SQ2294.2 +054300 EXIT. SQ2294.2 +054400* SQ2294.2 +054500**************************************************************** SQ2294.2 +054600* * SQ2294.2 +054700* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2294.2 +054800* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2294.2 +054900* * SQ2294.2 +055000**************************************************************** SQ2294.2 +055100* SQ2294.2 +055200 SECT-SQ229A-0001 SECTION. SQ2294.2 +055300 WRITE-INIT-GF-01. SQ2294.2 +055400* SQ2294.2 +055500* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ2294.2 +055600* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ2294.2 +055700* SQ2294.2 +055800 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2294.2 +055900 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2294.2 +056000 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2294.2 +056100 MOVE 120 TO XRECORD-LENGTH (1). SQ2294.2 +056200 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2294.2 +056300 MOVE 1 TO XBLOCK-SIZE (1). SQ2294.2 +056400 MOVE 1 TO RECORDS-IN-FILE (1). SQ2294.2 +056500 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2294.2 +056600 MOVE "S" TO XLABEL-TYPE (1). SQ2294.2 +056700 MOVE 1 TO XRECORD-NUMBER (1). SQ2294.2 +056800* SQ2294.2 +056900 WRITE-OPEN-01. SQ2294.2 +057000 OPEN OUTPUT SQ-FS1. SQ2294.2 +057100* SQ2294.2 +057200* WRITE A SINGLE RECORD TO THE FILE SQ2294.2 +057300* SQ2294.2 +057400 WRITE-INIT-01. SQ2294.2 +057500 WRITE-TEST-01-01. SQ2294.2 +057600 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2294.2 +057700 WRITE SQ-FS1R1-F-G-120. SQ2294.2 +057800* SQ2294.2 +057900 CLOSE-INIT-01. SQ2294.2 +058000 CLOSE-TEST-01. SQ2294.2 +058100 CLOSE SQ-FS1. SQ2294.2 +058200* SQ2294.2 +058300* THIS TEST OPENS THE FILE JUST CREATED IN THE EXTEND SQ2294.2 +058400* MODE. WE ATTEMPT TO READ A RECORD FROM THE FILE AND SQ2294.2 +058500* EXAMINE IN A DECLARATIVE THE I-O STATUS RETURNED. IT IS SQ2294.2 +058600* POSSIBLE THAT THE SYSTEM ACTION MAY BE ABNORMAL PROGRAM SQ2294.2 +058700* TERMINATION AFTER THE DECLARATIVE IS EXECUTED. SQ2294.2 +058800* SQ2294.2 +058900 OPEN-INIT-01. SQ2294.2 +059000* SQ2294.2 +059100 OPEN-TEST-01. SQ2294.2 +059200 OPEN EXTEND SQ-FS1. SQ2294.2 +059300* SQ2294.2 +059400 READ-INIT-01. SQ2294.2 +059500 MOVE 1 TO REC-CT. SQ2294.2 +059600 MOVE "**" TO SQ-FS1-STATUS. SQ2294.2 +059700 MOVE "READ-TEST-01" TO PAR-NAME. SQ2294.2 +059800 MOVE "READ OF EXTEND FILE" TO FEATURE. SQ2294.2 +059900* SQ2294.2 +060000 READ-TEST-01. SQ2294.2 +060100 READ SQ-FS1. SQ2294.2 +060200* SQ2294.2 +060300 CLOSE-INIT-02. SQ2294.2 +060400 CLOSE-TEST-02. SQ2294.2 +060500 CLOSE SQ-FS1. SQ2294.2 +060600* SQ2294.2 +060700 CCVS-EXIT SECTION. SQ2294.2 +060800 CCVS-999999. SQ2294.2 +060900 GO TO CLOSE-FILES. SQ2294.2 diff --git a/tests/cobol85/SQ/SQ230A.CBL b/tests/cobol85/SQ/SQ230A.CBL new file mode 100755 index 00000000..88971335 --- /dev/null +++ b/tests/cobol85/SQ/SQ230A.CBL @@ -0,0 +1,512 @@ +000100 IDENTIFICATION DIVISION. SQ2304.2 +000200 PROGRAM-ID. SQ2304.2 +000300 SQ230A. SQ2304.2 +000400**************************************************************** SQ2304.2 +000500* * SQ2304.2 +000600* VALIDATION FOR:- * SQ2304.2 +000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2304.2 +000800* USING CCVS85 VERSION 3.0. * SQ2304.2 +000900* * SQ2304.2 +001000* CREATION DATE / VALIDATION DATE * SQ2304.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2304.2 +001200* * SQ2304.2 +001300**************************************************************** SQ2304.2 +001400* * SQ2304.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ2304.2 +001600* * SQ2304.2 +001700* X-01 SEQUENTIAL TAPE * SQ2304.2 +001800* X-55 SYSTEM PRINTER * SQ2304.2 +001900* X-82 SOURCE-COMPUTER * SQ2304.2 +002000* X-83 OBJECT-COMPUTER. * SQ2304.2 +002100* X-84 LABEL RECORDS OPTION * SQ2304.2 +002200* * SQ2304.2 +002300**************************************************************** SQ2304.2 +002400* * SQ2304.2 +002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ2304.2 +002600* A FILE OPEN IN THE EXTEND MODE. THE TEST FOR CORRECT I-O * SQ2304.2 +002700* STATUS CODE 47 IS IN THE MAIN LINE CODE, THEREFORE AN * SQ2304.2 +002800* ABNORMAL TERMINATION IS POSSIBLE BEFORE THE TEST OF THE * SQ2304.2 +002900* I-O STATUS CODE IS ACCOMPLISHED. * SQ2304.2 +003000* * SQ2304.2 +003100**************************************************************** SQ2304.2 +003200* SQ2304.2 +003300 ENVIRONMENT DIVISION. SQ2304.2 +003400 CONFIGURATION SECTION. SQ2304.2 +003500 SOURCE-COMPUTER. SQ2304.2 +003600 Linux. SQ2304.2 +003700 OBJECT-COMPUTER. SQ2304.2 +003800 Linux. SQ2304.2 +003900* SQ2304.2 +004000 INPUT-OUTPUT SECTION. SQ2304.2 +004100 FILE-CONTROL. SQ2304.2 +004200 SELECT PRINT-FILE ASSIGN TO SQ2304.2 +004300 "report.log". SQ2304.2 +004400* SQ2304.2 +004500 SELECT SQ-FS1 ASSIGN TO SQ2304.2 +004600 "XXXXX001" SQ2304.2 +004700 FILE STATUS IS SQ-FS1-STATUS. SQ2304.2 +004800* SQ2304.2 +004900* SQ2304.2 +005000 DATA DIVISION. SQ2304.2 +005100 FILE SECTION. SQ2304.2 +005200 FD PRINT-FILE SQ2304.2 +005300*C LABEL RECORDS SQ2304.2 +005400*C OMITTED SQ2304.2 +005500*C DATA RECORD IS PRINT-REC DUMMY-RECORD SQ2304.2 +005600 . SQ2304.2 +005700 01 PRINT-REC PICTURE X(120). SQ2304.2 +005800 01 DUMMY-RECORD PICTURE X(120). SQ2304.2 +005900* SQ2304.2 +006000 FD SQ-FS1 SQ2304.2 +006100*C LABEL RECORD IS STANDARD SQ2304.2 +006200 . SQ2304.2 +006300 01 SQ-FS1R1-F-G-120 PIC X(120). SQ2304.2 +006400* SQ2304.2 +006500 WORKING-STORAGE SECTION. SQ2304.2 +006600* SQ2304.2 +006700*************************************************************** SQ2304.2 +006800* * SQ2304.2 +006900* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ2304.2 +007000* * SQ2304.2 +007100*************************************************************** SQ2304.2 +007200* SQ2304.2 +007300 01 SQ-FS1-STATUS. SQ2304.2 +007400 03 SQ-FS1-KEY-1 PIC X. SQ2304.2 +007500 03 SQ-FS1-KEY-2 PIC X. SQ2304.2 +007600* SQ2304.2 +007700*************************************************************** SQ2304.2 +007800* * SQ2304.2 +007900* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ2304.2 +008000* * SQ2304.2 +008100*************************************************************** SQ2304.2 +008200* SQ2304.2 +008300 01 REC-SKEL-SUB PIC 99. SQ2304.2 +008400* SQ2304.2 +008500 01 FILE-RECORD-INFORMATION-REC. SQ2304.2 +008600 03 FILE-RECORD-INFO-SKELETON. SQ2304.2 +008700 05 FILLER PICTURE X(48) VALUE SQ2304.2 +008800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ2304.2 +008900 05 FILLER PICTURE X(46) VALUE SQ2304.2 +009000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ2304.2 +009100 05 FILLER PICTURE X(26) VALUE SQ2304.2 +009200 ",LFIL=000000,ORG= ,LBLR= ". SQ2304.2 +009300 05 FILLER PICTURE X(37) VALUE SQ2304.2 +009400 ",RECKEY= ". SQ2304.2 +009500 05 FILLER PICTURE X(38) VALUE SQ2304.2 +009600 ",ALTKEY1= ". SQ2304.2 +009700 05 FILLER PICTURE X(38) VALUE SQ2304.2 +009800 ",ALTKEY2= ". SQ2304.2 +009900 05 FILLER PICTURE X(7) VALUE SPACE.SQ2304.2 +010000 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ2304.2 +010100 05 FILE-RECORD-INFO-P1-120. SQ2304.2 +010200 07 FILLER PIC X(5). SQ2304.2 +010300 07 XFILE-NAME PIC X(6). SQ2304.2 +010400 07 FILLER PIC X(8). SQ2304.2 +010500 07 XRECORD-NAME PIC X(6). SQ2304.2 +010600 07 FILLER PIC X(1). SQ2304.2 +010700 07 REELUNIT-NUMBER PIC 9(1). SQ2304.2 +010800 07 FILLER PIC X(7). SQ2304.2 +010900 07 XRECORD-NUMBER PIC 9(6). SQ2304.2 +011000 07 FILLER PIC X(6). SQ2304.2 +011100 07 UPDATE-NUMBER PIC 9(2). SQ2304.2 +011200 07 FILLER PIC X(5). SQ2304.2 +011300 07 ODO-NUMBER PIC 9(4). SQ2304.2 +011400 07 FILLER PIC X(5). SQ2304.2 +011500 07 XPROGRAM-NAME PIC X(5). SQ2304.2 +011600 07 FILLER PIC X(7). SQ2304.2 +011700 07 XRECORD-LENGTH PIC 9(6). SQ2304.2 +011800 07 FILLER PIC X(7). SQ2304.2 +011900 07 CHARS-OR-RECORDS PIC X(2). SQ2304.2 +012000 07 FILLER PIC X(1). SQ2304.2 +012100 07 XBLOCK-SIZE PIC 9(4). SQ2304.2 +012200 07 FILLER PIC X(6). SQ2304.2 +012300 07 RECORDS-IN-FILE PIC 9(6). SQ2304.2 +012400 07 FILLER PIC X(5). SQ2304.2 +012500 07 XFILE-ORGANIZATION PIC X(2). SQ2304.2 +012600 07 FILLER PIC X(6). SQ2304.2 +012700 07 XLABEL-TYPE PIC X(1). SQ2304.2 +012800 05 FILE-RECORD-INFO-P121-240. SQ2304.2 +012900 07 FILLER PIC X(8). SQ2304.2 +013000 07 XRECORD-KEY PIC X(29). SQ2304.2 +013100 07 FILLER PIC X(9). SQ2304.2 +013200 07 ALTERNATE-KEY1 PIC X(29). SQ2304.2 +013300 07 FILLER PIC X(9). SQ2304.2 +013400 07 ALTERNATE-KEY2 PIC X(29). SQ2304.2 +013500 07 FILLER PIC X(7). SQ2304.2 +013600* SQ2304.2 +013700 01 TEST-RESULTS. SQ2304.2 +013800 02 FILLER PIC X VALUE SPACE. SQ2304.2 +013900 02 FEATURE PIC X(24) VALUE SPACE. SQ2304.2 +014000 02 FILLER PIC X VALUE SPACE. SQ2304.2 +014100 02 P-OR-F PIC X(5) VALUE SPACE. SQ2304.2 +014200 02 FILLER PIC X VALUE SPACE. SQ2304.2 +014300 02 PAR-NAME. SQ2304.2 +014400 03 FILLER PIC X(14) VALUE SPACE. SQ2304.2 +014500 03 PARDOT-X PIC X VALUE SPACE. SQ2304.2 +014600 03 DOTVALUE PIC 99 VALUE ZERO. SQ2304.2 +014700 02 FILLER PIC X(9) VALUE SPACE. SQ2304.2 +014800 02 RE-MARK PIC X(61). SQ2304.2 +014900 01 TEST-COMPUTED. SQ2304.2 +015000 02 FILLER PIC X(30) VALUE SPACE. SQ2304.2 +015100 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ2304.2 +015200 02 COMPUTED-X. SQ2304.2 +015300 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ2304.2 +015400 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ2304.2 +015500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ2304.2 +015600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ2304.2 +015700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ2304.2 +015800 03 CM-18V0 REDEFINES COMPUTED-A. SQ2304.2 +015900 04 COMPUTED-18V0 PIC -9(18). SQ2304.2 +016000 04 FILLER PIC X. SQ2304.2 +016100 03 FILLER PIC X(50) VALUE SPACE. SQ2304.2 +016200 01 TEST-CORRECT. SQ2304.2 +016300 02 FILLER PIC X(30) VALUE SPACE. SQ2304.2 +016400 02 FILLER PIC X(17) VALUE " CORRECT =". SQ2304.2 +016500 02 CORRECT-X. SQ2304.2 +016600 03 CORRECT-A PIC X(20) VALUE SPACE. SQ2304.2 +016700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ2304.2 +016800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ2304.2 +016900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ2304.2 +017000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ2304.2 +017100 03 CR-18V0 REDEFINES CORRECT-A. SQ2304.2 +017200 04 CORRECT-18V0 PIC -9(18). SQ2304.2 +017300 04 FILLER PIC X. SQ2304.2 +017400 03 FILLER PIC X(2) VALUE SPACE. SQ2304.2 +017500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ2304.2 +017600 01 CCVS-C-1. SQ2304.2 +017700 02 FILLER PIC IS X(4) VALUE SPACE. SQ2304.2 +017800 02 FILLER PIC IS X(98) VALUE IS "FEATURE PASQ2304.2 +017900- "SS PARAGRAPH-NAME SQ2304.2 +018000- " REMARKS". SQ2304.2 +018100 02 FILLER PIC X(17) VALUE SPACE. SQ2304.2 +018200 01 CCVS-C-2. SQ2304.2 +018300 02 FILLER PIC XXXX VALUE SPACE. SQ2304.2 +018400 02 FILLER PIC X(6) VALUE "TESTED". SQ2304.2 +018500 02 FILLER PIC X(16) VALUE SPACE. SQ2304.2 +018600 02 FILLER PIC X(4) VALUE "FAIL". SQ2304.2 +018700 02 FILLER PIC X(90) VALUE SPACE. SQ2304.2 +018800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ2304.2 +018900 01 REC-CT PIC 99 VALUE ZERO. SQ2304.2 +019000 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ2304.2 +019100 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ2304.2 +019200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ2304.2 +019300 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ2304.2 +019400 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ2304.2 +019500 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ2304.2 +019600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ2304.2 +019700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ2304.2 +019800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ2304.2 +019900 01 CCVS-H-1. SQ2304.2 +020000 02 FILLER PIC X(39) VALUE SPACES. SQ2304.2 +020100 02 FILLER PIC X(42) VALUE SQ2304.2 +020200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ2304.2 +020300 02 FILLER PIC X(39) VALUE SPACES. SQ2304.2 +020400 01 CCVS-H-2A. SQ2304.2 +020500 02 FILLER PIC X(40) VALUE SPACE. SQ2304.2 +020600 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ2304.2 +020700 02 FILLER PIC XXXX VALUE SQ2304.2 +020800 "4.2 ". SQ2304.2 +020900 02 FILLER PIC X(28) VALUE SQ2304.2 +021000 " COPY - NOT FOR DISTRIBUTION". SQ2304.2 +021100 02 FILLER PIC X(41) VALUE SPACE. SQ2304.2 +021200* SQ2304.2 +021300 01 CCVS-H-2B. SQ2304.2 +021400 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ2304.2 +021500 02 TEST-ID PIC X(9). SQ2304.2 +021600 02 FILLER PIC X(4) VALUE " IN ". SQ2304.2 +021700 02 FILLER PIC X(12) VALUE SQ2304.2 +021800 " HIGH ". SQ2304.2 +021900 02 FILLER PIC X(22) VALUE SQ2304.2 +022000 " LEVEL VALIDATION FOR ". SQ2304.2 +022100 02 FILLER PIC X(58) VALUE SQ2304.2 +022200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2304.2 +022300 01 CCVS-H-3. SQ2304.2 +022400 02 FILLER PIC X(34) VALUE SQ2304.2 +022500 " FOR OFFICIAL USE ONLY ". SQ2304.2 +022600 02 FILLER PIC X(58) VALUE SQ2304.2 +022700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ2304.2 +022800 02 FILLER PIC X(28) VALUE SQ2304.2 +022900 " COPYRIGHT 1985,1986 ". SQ2304.2 +023000 01 CCVS-E-1. SQ2304.2 +023100 02 FILLER PIC X(52) VALUE SPACE. SQ2304.2 +023200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ2304.2 +023300 02 ID-AGAIN PIC X(9). SQ2304.2 +023400 02 FILLER PIC X(45) VALUE SPACES. SQ2304.2 +023500 01 CCVS-E-2. SQ2304.2 +023600 02 FILLER PIC X(31) VALUE SPACE. SQ2304.2 +023700 02 FILLER PIC X(21) VALUE SPACE. SQ2304.2 +023800 02 CCVS-E-2-2. SQ2304.2 +023900 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ2304.2 +024000 03 FILLER PIC X VALUE SPACE. SQ2304.2 +024100 03 ENDER-DESC PIC X(44) VALUE SQ2304.2 +024200 "ERRORS ENCOUNTERED". SQ2304.2 +024300 01 CCVS-E-3. SQ2304.2 +024400 02 FILLER PIC X(22) VALUE SQ2304.2 +024500 " FOR OFFICIAL USE ONLY". SQ2304.2 +024600 02 FILLER PIC X(12) VALUE SPACE. SQ2304.2 +024700 02 FILLER PIC X(58) VALUE SQ2304.2 +024800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ2304.2 +024900 02 FILLER PIC X(8) VALUE SPACE. SQ2304.2 +025000 02 FILLER PIC X(20) VALUE SQ2304.2 +025100 " COPYRIGHT 1985,1986". SQ2304.2 +025200 01 CCVS-E-4. SQ2304.2 +025300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ2304.2 +025400 02 FILLER PIC X(4) VALUE " OF ". SQ2304.2 +025500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ2304.2 +025600 02 FILLER PIC X(40) VALUE SQ2304.2 +025700 " TESTS WERE EXECUTED SUCCESSFULLY". SQ2304.2 +025800 01 XXINFO. SQ2304.2 +025900 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ2304.2 +026000 02 INFO-TEXT. SQ2304.2 +026100 04 FILLER PIC X(8) VALUE SPACE. SQ2304.2 +026200 04 XXCOMPUTED PIC X(20). SQ2304.2 +026300 04 FILLER PIC X(5) VALUE SPACE. SQ2304.2 +026400 04 XXCORRECT PIC X(20). SQ2304.2 +026500 02 INF-ANSI-REFERENCE PIC X(48). SQ2304.2 +026600 01 HYPHEN-LINE. SQ2304.2 +026700 02 FILLER PIC IS X VALUE IS SPACE. SQ2304.2 +026800 02 FILLER PIC IS X(65) VALUE IS "************************SQ2304.2 +026900- "*****************************************". SQ2304.2 +027000 02 FILLER PIC IS X(54) VALUE IS "************************SQ2304.2 +027100- "******************************". SQ2304.2 +027200 01 CCVS-PGM-ID PIC X(9) VALUE SQ2304.2 +027300 "SQ230A". SQ2304.2 +027400* SQ2304.2 +027500 PROCEDURE DIVISION. SQ2304.2 +027600 CCVS1 SECTION. SQ2304.2 +027700 OPEN-FILES. SQ2304.2 +027800 OPEN OUTPUT PRINT-FILE. SQ2304.2 +027900 MOVE CCVS-PGM-ID TO TEST-ID. SQ2304.2 +028000 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ2304.2 +028100 MOVE SPACE TO TEST-RESULTS. SQ2304.2 +028200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ2304.2 +028300 MOVE ZERO TO REC-SKEL-SUB. SQ2304.2 +028400 PERFORM CCVS-INIT-FILE 10 TIMES. SQ2304.2 +028500 GO TO CCVS1-EXIT. SQ2304.2 +028600* SQ2304.2 +028700 CCVS-INIT-FILE. SQ2304.2 +028800 ADD 1 TO REC-SKL-SUB. SQ2304.2 +028900 MOVE FILE-RECORD-INFO-SKELETON TO SQ2304.2 +029000 FILE-RECORD-INFO (REC-SKL-SUB). SQ2304.2 +029100* SQ2304.2 +029200 CLOSE-FILES. SQ2304.2 +029300 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ2304.2 +029400 CLOSE PRINT-FILE. SQ2304.2 +029500 TERMINATE-CCVS. SQ2304.2 +029600 STOP RUN. SQ2304.2 +029700* SQ2304.2 +029800 INSPT. SQ2304.2 +029900 MOVE "INSPT" TO P-OR-F. SQ2304.2 +030000 ADD 1 TO INSPECT-COUNTER. SQ2304.2 +030100 PERFORM PRINT-DETAIL. SQ2304.2 +030200 SQ2304.2 +030300 PASS. SQ2304.2 +030400 MOVE "PASS " TO P-OR-F. SQ2304.2 +030500 ADD 1 TO PASS-COUNTER. SQ2304.2 +030600 PERFORM PRINT-DETAIL. SQ2304.2 +030700* SQ2304.2 +030800 FAIL. SQ2304.2 +030900 MOVE "FAIL*" TO P-OR-F. SQ2304.2 +031000 ADD 1 TO ERROR-COUNTER. SQ2304.2 +031100 PERFORM PRINT-DETAIL. SQ2304.2 +031200* SQ2304.2 +031300 DE-LETE. SQ2304.2 +031400 MOVE "****TEST DELETED****" TO RE-MARK. SQ2304.2 +031500 MOVE "*****" TO P-OR-F. SQ2304.2 +031600 ADD 1 TO DELETE-COUNTER. SQ2304.2 +031700 PERFORM PRINT-DETAIL. SQ2304.2 +031800* SQ2304.2 +031900 PRINT-DETAIL. SQ2304.2 +032000 IF REC-CT NOT EQUAL TO ZERO SQ2304.2 +032100 MOVE "." TO PARDOT-X SQ2304.2 +032200 MOVE REC-CT TO DOTVALUE. SQ2304.2 +032300 MOVE TEST-RESULTS TO PRINT-REC. SQ2304.2 +032400 PERFORM WRITE-LINE. SQ2304.2 +032500 IF P-OR-F EQUAL TO "FAIL*" SQ2304.2 +032600 PERFORM WRITE-LINE SQ2304.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ2304.2 +032800 ELSE SQ2304.2 +032900 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ2304.2 +033000 MOVE SPACE TO P-OR-F. SQ2304.2 +033100 MOVE SPACE TO COMPUTED-X. SQ2304.2 +033200 MOVE SPACE TO CORRECT-X. SQ2304.2 +033300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ2304.2 +033400 MOVE SPACE TO RE-MARK. SQ2304.2 +033500* SQ2304.2 +033600 HEAD-ROUTINE. SQ2304.2 +033700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +033800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +033900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2304.2 +034000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ2304.2 +034100 COLUMN-NAMES-ROUTINE. SQ2304.2 +034200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2304.2 +034300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +034400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2304.2 +034500 END-ROUTINE. SQ2304.2 +034600 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ2304.2 +034700 PERFORM WRITE-LINE 5 TIMES. SQ2304.2 +034800 END-RTN-EXIT. SQ2304.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ2304.2 +035000 PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +035100* SQ2304.2 +035200 END-ROUTINE-1. SQ2304.2 +035300 ADD ERROR-COUNTER TO ERROR-HOLD SQ2304.2 +035400 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ2304.2 +035500 ADD DELETE-COUNTER TO ERROR-HOLD. SQ2304.2 +035600 ADD PASS-COUNTER TO ERROR-HOLD. SQ2304.2 +035700 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ2304.2 +035800 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ2304.2 +035900 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ2304.2 +036000 MOVE CCVS-E-2 TO DUMMY-RECORD SQ2304.2 +036100 PERFORM WRITE-LINE. SQ2304.2 +036200 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ2304.2 +036300 IF ERROR-COUNTER IS EQUAL TO ZERO SQ2304.2 +036400 MOVE "NO " TO ERROR-TOTAL SQ2304.2 +036500 ELSE SQ2304.2 +036600 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ2304.2 +036700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2304.2 +036800 PERFORM WRITE-LINE. SQ2304.2 +036900 END-ROUTINE-13. SQ2304.2 +037000 IF DELETE-COUNTER IS EQUAL TO ZERO SQ2304.2 +037100 MOVE "NO " TO ERROR-TOTAL SQ2304.2 +037200 ELSE SQ2304.2 +037300 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ2304.2 +037400 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ2304.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ2304.2 +037600 PERFORM WRITE-LINE. SQ2304.2 +037700 IF INSPECT-COUNTER EQUAL TO ZERO SQ2304.2 +037800 MOVE "NO " TO ERROR-TOTAL SQ2304.2 +037900 ELSE SQ2304.2 +038000 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ2304.2 +038100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ2304.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2304.2 +038300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ2304.2 +038400* SQ2304.2 +038500 WRITE-LINE. SQ2304.2 +038600 ADD 1 TO RECORD-COUNT. SQ2304.2 +038700 IF RECORD-COUNT GREATER 50 SQ2304.2 +038800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ2304.2 +038900 MOVE SPACE TO DUMMY-RECORD SQ2304.2 +039000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ2304.2 +039100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ2304.2 +039200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ2304.2 +039300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ2304.2 +039400 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ2304.2 +039500 MOVE ZERO TO RECORD-COUNT. SQ2304.2 +039600 PERFORM WRT-LN. SQ2304.2 +039700* SQ2304.2 +039800 WRT-LN. SQ2304.2 +039900 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ2304.2 +040000 MOVE SPACE TO DUMMY-RECORD. SQ2304.2 +040100 BLANK-LINE-PRINT. SQ2304.2 +040200 PERFORM WRT-LN. SQ2304.2 +040300 FAIL-ROUTINE. SQ2304.2 +040400 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2304.2 +040500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ2304.2 +040600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2304.2 +040700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ2304.2 +040800 MOVE XXINFO TO DUMMY-RECORD. SQ2304.2 +040900 PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +041000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2304.2 +041100 GO TO FAIL-ROUTINE-EX. SQ2304.2 +041200 FAIL-ROUTINE-WRITE. SQ2304.2 +041300 MOVE TEST-COMPUTED TO PRINT-REC SQ2304.2 +041400 PERFORM WRITE-LINE SQ2304.2 +041500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ2304.2 +041600 MOVE TEST-CORRECT TO PRINT-REC SQ2304.2 +041700 PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +041800 MOVE SPACES TO COR-ANSI-REFERENCE. SQ2304.2 +041900 FAIL-ROUTINE-EX. SQ2304.2 +042000 EXIT. SQ2304.2 +042100 BAIL-OUT. SQ2304.2 +042200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ2304.2 +042300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ2304.2 +042400 BAIL-OUT-WRITE. SQ2304.2 +042500 MOVE CORRECT-A TO XXCORRECT. SQ2304.2 +042600 MOVE COMPUTED-A TO XXCOMPUTED. SQ2304.2 +042700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ2304.2 +042800 MOVE XXINFO TO DUMMY-RECORD. SQ2304.2 +042900 PERFORM WRITE-LINE 2 TIMES. SQ2304.2 +043000 MOVE SPACES TO INF-ANSI-REFERENCE. SQ2304.2 +043100 BAIL-OUT-EX. SQ2304.2 +043200 EXIT. SQ2304.2 +043300 CCVS1-EXIT. SQ2304.2 +043400 EXIT. SQ2304.2 +043500* SQ2304.2 +043600**************************************************************** SQ2304.2 +043700* * SQ2304.2 +043800* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ2304.2 +043900* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ2304.2 +044000* * SQ2304.2 +044100**************************************************************** SQ2304.2 +044200* SQ2304.2 +044300 SECT-SQ230A-0001 SECTION. SQ2304.2 +044400 WRITE-INIT-GF-01. SQ2304.2 +044500* SQ2304.2 +044600* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ2304.2 +044700* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ2304.2 +044800* SQ2304.2 +044900 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ2304.2 +045000 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ2304.2 +045100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ2304.2 +045200 MOVE 120 TO XRECORD-LENGTH (1). SQ2304.2 +045300 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ2304.2 +045400 MOVE 1 TO XBLOCK-SIZE (1). SQ2304.2 +045500 MOVE 1 TO RECORDS-IN-FILE (1). SQ2304.2 +045600 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ2304.2 +045700 MOVE "S" TO XLABEL-TYPE (1). SQ2304.2 +045800 MOVE 1 TO XRECORD-NUMBER (1). SQ2304.2 +045900* SQ2304.2 +046000 WRITE-OPEN-01. SQ2304.2 +046100 OPEN OUTPUT SQ-FS1. SQ2304.2 +046200* SQ2304.2 +046300* WRITE A SINGLE RECORD TO THE FILE SQ2304.2 +046400* SQ2304.2 +046500 WRITE-INIT-01. SQ2304.2 +046600 WRITE-TEST-01-01. SQ2304.2 +046700 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ2304.2 +046800 WRITE SQ-FS1R1-F-G-120. SQ2304.2 +046900* SQ2304.2 +047000* CLOSE THE FILE. SQ2304.2 +047100* SQ2304.2 +047200 CLOSE-INIT-01. SQ2304.2 +047300 CLOSE-TEST-01. SQ2304.2 +047400 CLOSE SQ-FS1. SQ2304.2 +047500* SQ2304.2 +047600* HAVING CLOSED THE FILE, WE NOW REOPEN IT IN THE SQ2304.2 +047700* EXTEND MODE. SQ2304.2 +047800* SQ2304.2 +047900 OPEN-INIT-01. SQ2304.2 +048000* SQ2304.2 +048100 OPEN-TEST-01. SQ2304.2 +048200 OPEN EXTEND SQ-FS1. SQ2304.2 +048300* SQ2304.2 +048400 READ-INIT-01. SQ2304.2 +048500* SQ2304.2 +048600* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE FILE. SQ2304.2 +048700* I-O STATUS CODE 47 SHOULD BE GENERATED. SQ2304.2 +048800* SQ2304.2 +048900 MOVE "READ FILE OPENED EXTEND" TO FEATURE. SQ2304.2 +049000 MOVE "**" TO SQ-FS1-STATUS. SQ2304.2 +049100 MOVE "READ-TEST-01" TO PAR-NAME. SQ2304.2 +049200 MOVE 1 TO REC-CT. SQ2304.2 +049300 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ2304.2 +049400 TO DUMMY-RECORD. SQ2304.2 +049500 PERFORM WRITE-LINE 3 TIMES. SQ2304.2 +049600* SQ2304.2 +049700 READ-TEST-01. SQ2304.2 +049800 READ SQ-FS1 AT END CONTINUE. SQ2304.2 +049900 IF SQ-FS1-STATUS = "47" SQ2304.2 +050000 PERFORM PASS SQ2304.2 +050100 ELSE SQ2304.2 +050200 MOVE "47" TO CORRECT-A SQ2304.2 +050300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ2304.2 +050400 MOVE "STATUS FOR READ OF FILE OPEN EXTEND INCORRECT" SQ2304.2 +050500 TO RE-MARK SQ2304.2 +050600 MOVE "VII-3, FILE STATUS" TO ANSI-REFERENCE SQ2304.2 +050700 PERFORM FAIL SQ2304.2 +050800 END-IF. SQ2304.2 +050900* SQ2304.2 +051000 CCVS-EXIT SECTION. SQ2304.2 +051100 CCVS-999999. SQ2304.2 +051200 GO TO CLOSE-FILES. SQ2304.2 diff --git a/tests/cobol85/SQ/SQ302M.CBL b/tests/cobol85/SQ/SQ302M.CBL new file mode 100755 index 00000000..6fa22909 --- /dev/null +++ b/tests/cobol85/SQ/SQ302M.CBL @@ -0,0 +1,68 @@ +000100 IDENTIFICATION DIVISION. SQ3024.2 +000200 PROGRAM-ID. SQ3024.2 +000300 SQ302M. SQ3024.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF SQ3024.2 +000500*OBSOLETE FEATURES THAT ARE USED IN MINIMUM SUBSET SQ3024.2 +000600*SEQUENTIAL INPUT-OUTPUT. SQ3024.2 +000700 ENVIRONMENT DIVISION. SQ3024.2 +000800 CONFIGURATION SECTION. SQ3024.2 +000900 SOURCE-COMPUTER. SQ3024.2 +001000 Linux. SQ3024.2 +001100 OBJECT-COMPUTER. SQ3024.2 +001200 Linux. SQ3024.2 +001300 INPUT-OUTPUT SECTION. SQ3024.2 +001400 FILE-CONTROL. SQ3024.2 +001500 SELECT TFIL ASSIGN SQ3024.2 +001600 "XXXXX014" SQ3024.2 +001700 ORGANIZATION IS SEQUENTIAL SQ3024.2 +001800 ACCESS MODE IS SEQUENTIAL. SQ3024.2 +001900 SQ3024.2 +002000 SELECT SQ-FRR ASSIGN SQ3024.2 +002100 "XXXXX013" SQ3024.2 +002200 ORGANIZATION IS SEQUENTIAL. SQ3024.2 +002300 SQ3024.2 +002400 SELECT RR-FS1 ASSIGN SQ3024.2 +002500 "XXXXX014" SQ3024.2 +002600 ORGANIZATION IS SEQUENTIAL. SQ3024.2 +002700 SQ3024.2 +002800 I-O-CONTROL. SQ3024.2 +002900 XXXXX053. SQ3024.2 +003000*Message expected for above statement: OBSOLETE SQ3024.2 +003100 SQ3024.2 +003200 DATA DIVISION. SQ3024.2 +003300 FILE SECTION. SQ3024.2 +003400 FD TFIL SQ3024.2 +003500 LABEL RECORDS STANDARD SQ3024.2 +003600*Message expected for above statement: OBSOLETE SQ3024.2 +003700 VALUE OF SQ3024.2 +003800 OCLABELID SQ3024.2 +003900 IS SQ3024.2 +004000 "OCDUMMY" SQ3024.2 +004100*Message expected for above statement: OBSOLETE SQ3024.2 +004200 DATA RECORDS ARE FREC. SQ3024.2 +004300*Message expected for above statement: OBSOLETE SQ3024.2 +004400 SQ3024.2 +004500 01 FREC. SQ3024.2 +004600 03 RKEY PIC 9(8). SQ3024.2 +004700 SQ3024.2 +004800 FD SQ-FRR. SQ3024.2 +004900 01 SREC. SQ3024.2 +005000 03 SKEY PIC X(8). SQ3024.2 +005100 SQ3024.2 +005200 FD RR-FS1. SQ3024.2 +005300 01 RREC. SQ3024.2 +005400 03 FKEY PIC X(8). SQ3024.2 +005500 SQ3024.2 +005600 WORKING-STORAGE SECTION. SQ3024.2 +005700 SQ3024.2 +005800 01 VARIABLES. SQ3024.2 +005900 03 VKEY PIC 9(8) VALUE ZERO. SQ3024.2 +006000 03 DKEY PIC 9(8) VALUE ZERO. SQ3024.2 +006100 SQ3024.2 +006200 PROCEDURE DIVISION. SQ3024.2 +006300 SQ3024.2 +006400 SQ302M-CONTROL. SQ3024.2 +006500 DISPLAY "THIS IS A DUMMY PARAGRAPH". SQ3024.2 +006600 STOP RUN. SQ3024.2 +006700 SQ3024.2 +006800*TOTAL NUMBER OF FLAGS EXPECTED = 4. SQ3024.2 diff --git a/tests/cobol85/SQ/SQ303M.CBL b/tests/cobol85/SQ/SQ303M.CBL new file mode 100755 index 00000000..e624afa2 --- /dev/null +++ b/tests/cobol85/SQ/SQ303M.CBL @@ -0,0 +1,49 @@ +000100 IDENTIFICATION DIVISION. SQ3034.2 +000200 PROGRAM-ID. SQ3034.2 +000300 SQ303M. SQ3034.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF SQ3034.2 +000500*OBSOLETE FEATURES THAT ARE USED IN HIGH SUBSET SEQUENTIAL SQ3034.2 +000600*INPUT-OUTPUT. SQ3034.2 +000700 ENVIRONMENT DIVISION. SQ3034.2 +000800 CONFIGURATION SECTION. SQ3034.2 +000900 SOURCE-COMPUTER. SQ3034.2 +001000 Linux. SQ3034.2 +001100 OBJECT-COMPUTER. SQ3034.2 +001200 Linux. SQ3034.2 +001300 INPUT-OUTPUT SECTION. SQ3034.2 +001400 FILE-CONTROL. SQ3034.2 +001500 SELECT TFIL ASSIGN SQ3034.2 +001600 "XXXXX014" SQ3034.2 +001700 ORGANIZATION IS SEQUENTIAL SQ3034.2 +001800 ACCESS MODE IS SEQUENTIAL. SQ3034.2 +001900 SQ3034.2 +002000 SELECT TFIL2 ASSIGN SQ3034.2 +002100 "XXXXX008" SQ3034.2 +002200 ORGANIZATION IS SEQUENTIAL SQ3034.2 +002300 ACCESS MODE IS SEQUENTIAL. SQ3034.2 +002400 SQ3034.2 +002500 I-O-CONTROL. SQ3034.2 +002600 MULTIPLE FILE TAPE CONTAINS TFIL2. SQ3034.2 +002700*Message expected for above statement: OBSOLETE SQ3034.2 +002800 SQ3034.2 +002900 DATA DIVISION. SQ3034.2 +003000 FILE SECTION. SQ3034.2 +003100 FD TFIL. SQ3034.2 +003200 01 FREC. SQ3034.2 +003300 03 RKEY PIC 9(8). SQ3034.2 +003400 SQ3034.2 +003500 FD TFIL2. SQ3034.2 +003600 01 FREC2. SQ3034.2 +003700 03 RKEY2 PIC 9(8). SQ3034.2 +003800 SQ3034.2 +003900 PROCEDURE DIVISION. SQ3034.2 +004000 SQ3034.2 +004100 SQ303M-CONTROL. SQ3034.2 +004200 OPEN INPUT TFIL REVERSED. SQ3034.2 +004300*Message expected for above statement: OBSOLETE SQ3034.2 +004400 SQ3034.2 +004500 CLOSE TFIL. SQ3034.2 +004600 STOP RUN. SQ3034.2 +004700 SQ3034.2 +004800 SQ3034.2 +004900*TOTAL NUMBER OF FLAGS EXPECTED = 2. SQ3034.2 diff --git a/tests/cobol85/SQ/SQ401M.CBL b/tests/cobol85/SQ/SQ401M.CBL new file mode 100755 index 00000000..54f72be8 --- /dev/null +++ b/tests/cobol85/SQ/SQ401M.CBL @@ -0,0 +1,137 @@ +000100 IDENTIFICATION DIVISION. SQ4014.2 +000200 PROGRAM-ID. SQ4014.2 +000300 SQ401M. SQ4014.2 +000400*THE FOLLOWING PROGRAM TESTS THE FLAGGING OF HIGH SQ4014.2 +000500*SUBSET FEATURES THAT ARE USED IN SEQUENTIAL SQ4014.2 +000600*INPUT-OUTPUT. SQ4014.2 +000700 ENVIRONMENT DIVISION. SQ4014.2 +000800 CONFIGURATION SECTION. SQ4014.2 +000900 SOURCE-COMPUTER. SQ4014.2 +001000 Linux. SQ4014.2 +001100 OBJECT-COMPUTER. SQ4014.2 +001200 Linux. SQ4014.2 +001300 INPUT-OUTPUT SECTION. SQ4014.2 +001400 FILE-CONTROL. SQ4014.2 +001500 SELECT OPTIONAL TFIL ASSIGN SQ4014.2 +001600*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +001700 SQ4014.2 +001800 "XXXXX002" SQ4014.2 +001900 RESERVE 2 AREAS SQ4014.2 +002000*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +002100 SQ4014.2 +002200 ORGANIZATION IS SEQUENTIAL SQ4014.2 +002300 PADDING CHARACTER IS "P" SQ4014.2 +002400*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +002500 SQ4014.2 +002600 RECORD DELIMITER IS STANDARD-1 SQ4014.2 +002700*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +002800 SQ4014.2 +002900 ACCESS MODE IS SEQUENTIAL. SQ4014.2 +003000 SQ4014.2 +003100 SELECT TFIL2 ASSIGN SQ4014.2 +003200 "XXXXX008" SQ4014.2 +003300 ORGANIZATION IS SEQUENTIAL SQ4014.2 +003400 ACCESS MODE IS SEQUENTIAL. SQ4014.2 +003500 SQ4014.2 +003600 SQ4014.2 +003700 SELECT TFIL3 ASSIGN SQ4014.2 +003800 "XXXXX003". SQ4014.2 +003900 SQ4014.2 +004000 I-O-CONTROL. SQ4014.2 +004100 SAME RECORD AREA FOR TFIL2, TFIL SQ4014.2 +004200*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +004300 SQ4014.2 +004400 MULTIPLE FILE TAPE CONTAINS TFIL2. SQ4014.2 +004500*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +004600 SQ4014.2 +004700 DATA DIVISION. SQ4014.2 +004800 FILE SECTION. SQ4014.2 +004900 FD TFIL SQ4014.2 +005000 BLOCK CONTAINS 1 TO 8 RECORDS SQ4014.2 +005100*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +005200 SQ4014.2 +005300 RECORD VARYING IN SIZE FROM 1 TO 8 CHARACTERS SQ4014.2 +005400*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +005500 SQ4014.2 +005600 LINAGE IS 20 LINES SQ4014.2 +005700*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +005800 SQ4014.2 +005900 LABEL RECORDS ARE STANDARD SQ4014.2 +006000 VALUE OF SQ4014.2 +006100 OCLABELID SQ4014.2 +006200 IS VKEY. SQ4014.2 +006300*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +006400 SQ4014.2 +006500 01 FREC. SQ4014.2 +006600 03 RKEY PIC 9(8). SQ4014.2 +006700 SQ4014.2 +006800 FD TFIL2. SQ4014.2 +006900 01 FREC2. SQ4014.2 +007000 03 RKEY2 PIC 9(8). SQ4014.2 +007100 SQ4014.2 +007200 SQ4014.2 +007300 FD TFIL3. SQ4014.2 +007400 01 FREC3. SQ4014.2 +007500 02 RKEY3 PIC 9(8). SQ4014.2 +007600 SQ4014.2 +007700 WORKING-STORAGE SECTION. SQ4014.2 +007800 SQ4014.2 +007900 01 VARIABLES. SQ4014.2 +008000 SQ4014.2 +008100 03 VKEY SQ4014.2 +008200 **** X-CARD UNDEFINED ****. SQ4014.2 +008300 SQ4014.2 +008400 SQ4014.2 +008500 PROCEDURE DIVISION. SQ4014.2 +008600 SQ4014.2 +008700 SQ401M-CONTROL. SQ4014.2 +008800 OPEN INPUT TFIL. SQ4014.2 +008900 PERFORM SQ401M-CLOSEREMOV THRU SQ401M-WRITEEOP. SQ4014.2 +009000 CLOSE TFIL. SQ4014.2 +009100 CLOSE TFIL2. SQ4014.2 +009200 STOP RUN. SQ4014.2 +009300 SQ4014.2 +009400 SQ401M-CLOSEREMOV. SQ4014.2 +009500 CLOSE TFIL REEL FOR REMOVAL. SQ4014.2 +009600*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +009700 SQ4014.2 +009800 SQ401M-CLOSENRW. SQ4014.2 +009900 OPEN INPUT TFIL. SQ4014.2 +010000 CLOSE TFIL WITH NO REWIND. SQ4014.2 +010100*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +010200 SQ4014.2 +010300 SQ401M-CLOSELOCK. SQ4014.2 +010400 OPEN INPUT TFIL. SQ4014.2 +010500 CLOSE TFIL WITH LOCK. SQ4014.2 +010600*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +010700 SQ4014.2 +010800 SQ401M-OPENREV. SQ4014.2 +010900 OPEN INPUT TFIL REVERSED. SQ4014.2 +011000*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +011100 SQ4014.2 +011200 SQ401M-OPENNOREW. SQ4014.2 +011300 CLOSE TFIL. SQ4014.2 +011400 OPEN INPUT TFIL WITH NO REWIND. SQ4014.2 +011500*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +011600 SQ4014.2 +011700 SQ401M-EXTEND. SQ4014.2 +011800 CLOSE TFIL. SQ4014.2 +011900 OPEN EXTEND TFIL3. SQ4014.2 +012000*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +012100 SQ4014.2 +012200 SQ401M-READNEXT. SQ4014.2 +012300 OPEN INPUT TFIL. SQ4014.2 +012400 READ TFIL NEXT RECORD SQ4014.2 +012500 AT END DISPLAY "AT END". SQ4014.2 +012600*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +012700 SQ4014.2 +012800 CLOSE TFIL. SQ4014.2 +012900 SQ4014.2 +013000 SQ401M-WRITEEOP. SQ4014.2 +013100 OPEN OUTPUT TFIL. SQ4014.2 +013200 WRITE FREC AT END-OF-PAGE DISPLAY "HELLO". SQ4014.2 +013300*Message expected for above statement: NON-CONFORMING STANDARD SQ4014.2 +013400 SQ4014.2 +013500 SQ4014.2 +013600 SQ4014.2 +013700*TOTAL NUMBER OF FLAGS EXPECTED = 18. SQ4014.2 diff --git a/tests/cobol85/ST.txt b/tests/cobol85/ST.txt deleted file mode 100644 index f8a25b50..00000000 --- a/tests/cobol85/ST.txt +++ /dev/null @@ -1,50 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -ST101A.CBL 9 9 0 0 0 OK -ST102A.SUB 0 0 0 0 0 OK -ST103A.SUB 9 9 0 0 0 OK -ST104A.CBL 1 1 0 0 0 OK -ST105A.SUB 2 2 0 0 0 OK -ST106A.CBL 1 1 0 0 0 OK -ST107A.SUB 6 6 0 0 0 OK -ST108A.CBL 9 9 0 0 0 OK -ST109A.CBL 0 0 0 0 0 OK -ST110A.SUB 0 0 0 0 0 OK -ST111A.SUB 7 7 0 0 0 OK -ST112M.CBL 0 0 0 0 0 OK -ST113M.SUB 0 0 0 0 0 OK -ST114M.SUB 10 10 0 0 0 OK -ST115A.CBL 0 0 0 0 0 OK -ST116A.SUB 0 0 0 0 0 OK -ST117A.SUB 1 1 0 0 0 OK -ST118A.CBL 9 9 0 0 0 OK -ST119A.CBL 27 27 0 0 0 OK -ST120A.SUB 0 0 0 0 0 OK -ST121A.SUB 9 9 0 0 0 OK -ST122A.CBL 0 0 0 0 0 OK -ST123A.SUB 0 0 0 0 0 OK -ST124A.SUB 7 7 0 0 0 OK -ST125A.CBL 1 1 0 0 0 OK -ST126A.SUB 18 18 0 0 0 OK -ST127A.CBL 27 27 0 0 0 OK -ST131A.CBL 15 15 0 0 0 OK -ST132A.CBL 6 6 0 0 0 OK -ST133A.CBL 18 18 0 0 0 OK -ST134A.CBL 4 4 0 0 0 OK -ST135A.CBL 9 9 0 0 0 OK -ST136A.CBL 5 5 0 0 0 OK -ST137A.CBL 6 6 0 0 0 OK -ST139A.CBL 10 10 0 0 0 OK -ST140A.CBL 11 11 0 0 0 OK -ST144A.CBL 11 11 0 0 0 OK -ST146A.CBL 4 4 0 0 0 OK -ST147A.CBL 26 26 0 0 0 OK -ST301M.CBL ----- test skipped ----- --------- ----- ---- ---- ------- ------- -Total 278 278 0 0 0 -% 100.0 100.0 0.0 0.0 0.0 - -Number of programs: 39 -Successfully executed: 39 (100.00%) -Compile error: 0 ( 0.00%) -Execute error: 0 ( 0.00%) diff --git a/tests/cobol85/ST/ST101A.CBL b/tests/cobol85/ST/ST101A.CBL new file mode 100755 index 00000000..144019c9 --- /dev/null +++ b/tests/cobol85/ST/ST101A.CBL @@ -0,0 +1,575 @@ +000100 IDENTIFICATION DIVISION. ST1014.2 +000200 PROGRAM-ID. ST1014.2 +000300 ST101A. ST1014.2 +000400**************************************************************** ST1014.2 +000500* * ST1014.2 +000600* VALIDATION FOR:- * ST1014.2 +000700* * ST1014.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1014.2 +000900* * ST1014.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1014.2 +001100* * ST1014.2 +001200**************************************************************** ST1014.2 +001300* * ST1014.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1014.2 +001500* * ST1014.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1014.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1014.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1014.2 +001900* * ST1014.2 +002000**************************************************************** ST1014.2 +002100 ENVIRONMENT DIVISION. ST1014.2 +002200 CONFIGURATION SECTION. ST1014.2 +002300 SOURCE-COMPUTER. ST1014.2 +002400 Linux. ST1014.2 +002500 OBJECT-COMPUTER. ST1014.2 +002600 Linux. ST1014.2 +002700 INPUT-OUTPUT SECTION. ST1014.2 +002800 FILE-CONTROL. ST1014.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1014.2 +003000 "report.log". ST1014.2 +003100 SELECT SORTFILE-1A ASSIGN TO ST1014.2 +003200 "XXXXX027". ST1014.2 +003300 SELECT SORTOUT-1A ASSIGN TO ST1014.2 +003400 "XXXXX001". ST1014.2 +003500 DATA DIVISION. ST1014.2 +003600 FILE SECTION. ST1014.2 +003700 FD PRINT-FILE. ST1014.2 +003800 01 PRINT-REC PICTURE X(120). ST1014.2 +003900 01 DUMMY-RECORD PICTURE X(120). ST1014.2 +004000 SD SORTFILE-1A ST1014.2 +004100 DATA RECORD IS S-RECORD. ST1014.2 +004200 01 S-RECORD. ST1014.2 +004300 02 KEYS-GROUP. ST1014.2 +004400 03 KEY-1 PICTURE 9. ST1014.2 +004500 03 KEY-2 PICTURE 99. ST1014.2 +004600 03 KEY-3 PICTURE 999. ST1014.2 +004700 03 KEY-4 PICTURE 9999. ST1014.2 +004800 03 KEY-5 PICTURE 9(5). ST1014.2 +004900 02 RDF-KEYS REDEFINES KEYS-GROUP PICTURE 9(15). ST1014.2 +005000 02 FILLER PICTURE X(105). ST1014.2 +005100 FD SORTOUT-1A ST1014.2 +005200 BLOCK CONTAINS 10 RECORDS ST1014.2 +005300 LABEL RECORDS ARE STANDARD ST1014.2 +005400*C VALUE OF ST1014.2 +005500*C OCLABELID ST1014.2 +005600*C IS ST1014.2 +005700*C "OCDUMMY" ST1014.2 +005800*G SYSIN ST1014.2 +005900 DATA RECORD IS SORTED. ST1014.2 +006000 01 SORTED PICTURE X(120). ST1014.2 +006100 WORKING-STORAGE SECTION. ST1014.2 +006200 77 C0 PICTURE 9 VALUE 0. ST1014.2 +006300 77 C1 PICTURE 9 VALUE 1. ST1014.2 +006400 77 C2 PICTURE 9 VALUE 2. ST1014.2 +006500 77 C6 PICTURE 9 VALUE 6. ST1014.2 +006600 77 C3 PICTURE 9 VALUE 3. ST1014.2 +006700 77 COMMENT-SENTENCE PIC X(116) VALUE " THE FILE BUILT IN ST101AST1014.2 +006800- " IS USED BY ST102A. ST102A DOES NOT PRODUCE A REPORT- THE R ST1014.2 +006900- "ESULTS ARE CHECKED IN ST103A.". ST1014.2 +007000 01 WKEYS-GROUP. ST1014.2 +007100 02 WKEY-1 PICTURE 9. ST1014.2 +007200 02 WKEY-2 PICTURE 99. ST1014.2 +007300 02 WKEY-3 PICTURE 999. ST1014.2 +007400 02 WKEY-4 PICTURE 9999. ST1014.2 +007500 02 WKEY-5 PICTURE 9(5). ST1014.2 +007600 01 WKEYS-RDF REDEFINES WKEYS-GROUP PICTURE 9(15). ST1014.2 +007700 01 TEST-RESULTS. ST1014.2 +007800 02 FILLER PIC X VALUE SPACE. ST1014.2 +007900 02 FEATURE PIC X(20) VALUE SPACE. ST1014.2 +008000 02 FILLER PIC X VALUE SPACE. ST1014.2 +008100 02 P-OR-F PIC X(5) VALUE SPACE. ST1014.2 +008200 02 FILLER PIC X VALUE SPACE. ST1014.2 +008300 02 PAR-NAME. ST1014.2 +008400 03 FILLER PIC X(19) VALUE SPACE. ST1014.2 +008500 03 PARDOT-X PIC X VALUE SPACE. ST1014.2 +008600 03 DOTVALUE PIC 99 VALUE ZERO. ST1014.2 +008700 02 FILLER PIC X(8) VALUE SPACE. ST1014.2 +008800 02 RE-MARK PIC X(61). ST1014.2 +008900 01 TEST-COMPUTED. ST1014.2 +009000 02 FILLER PIC X(30) VALUE SPACE. ST1014.2 +009100 02 FILLER PIC X(17) VALUE ST1014.2 +009200 " COMPUTED=". ST1014.2 +009300 02 COMPUTED-X. ST1014.2 +009400 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1014.2 +009500 03 COMPUTED-N REDEFINES COMPUTED-A ST1014.2 +009600 PIC -9(9).9(9). ST1014.2 +009700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1014.2 +009800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1014.2 +009900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1014.2 +010000 03 CM-18V0 REDEFINES COMPUTED-A. ST1014.2 +010100 04 COMPUTED-18V0 PIC -9(18). ST1014.2 +010200 04 FILLER PIC X. ST1014.2 +010300 03 FILLER PIC X(50) VALUE SPACE. ST1014.2 +010400 01 TEST-CORRECT. ST1014.2 +010500 02 FILLER PIC X(30) VALUE SPACE. ST1014.2 +010600 02 FILLER PIC X(17) VALUE " CORRECT =". ST1014.2 +010700 02 CORRECT-X. ST1014.2 +010800 03 CORRECT-A PIC X(20) VALUE SPACE. ST1014.2 +010900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1014.2 +011000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1014.2 +011100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1014.2 +011200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1014.2 +011300 03 CR-18V0 REDEFINES CORRECT-A. ST1014.2 +011400 04 CORRECT-18V0 PIC -9(18). ST1014.2 +011500 04 FILLER PIC X. ST1014.2 +011600 03 FILLER PIC X(2) VALUE SPACE. ST1014.2 +011700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1014.2 +011800 01 CCVS-C-1. ST1014.2 +011900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1014.2 +012000- "SS PARAGRAPH-NAME ST1014.2 +012100- " REMARKS". ST1014.2 +012200 02 FILLER PIC X(20) VALUE SPACE. ST1014.2 +012300 01 CCVS-C-2. ST1014.2 +012400 02 FILLER PIC X VALUE SPACE. ST1014.2 +012500 02 FILLER PIC X(6) VALUE "TESTED". ST1014.2 +012600 02 FILLER PIC X(15) VALUE SPACE. ST1014.2 +012700 02 FILLER PIC X(4) VALUE "FAIL". ST1014.2 +012800 02 FILLER PIC X(94) VALUE SPACE. ST1014.2 +012900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1014.2 +013000 01 REC-CT PIC 99 VALUE ZERO. ST1014.2 +013100 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1014.2 +013200 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1014.2 +013300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1014.2 +013400 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1014.2 +013500 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1014.2 +013600 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1014.2 +013700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1014.2 +013800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1014.2 +013900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1014.2 +014000 01 CCVS-H-1. ST1014.2 +014100 02 FILLER PIC X(39) VALUE SPACES. ST1014.2 +014200 02 FILLER PIC X(42) VALUE ST1014.2 +014300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1014.2 +014400 02 FILLER PIC X(39) VALUE SPACES. ST1014.2 +014500 01 CCVS-H-2A. ST1014.2 +014600 02 FILLER PIC X(40) VALUE SPACE. ST1014.2 +014700 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1014.2 +014800 02 FILLER PIC XXXX VALUE ST1014.2 +014900 "4.2 ". ST1014.2 +015000 02 FILLER PIC X(28) VALUE ST1014.2 +015100 " COPY - NOT FOR DISTRIBUTION". ST1014.2 +015200 02 FILLER PIC X(41) VALUE SPACE. ST1014.2 +015300 ST1014.2 +015400 01 CCVS-H-2B. ST1014.2 +015500 02 FILLER PIC X(15) VALUE ST1014.2 +015600 "TEST RESULT OF ". ST1014.2 +015700 02 TEST-ID PIC X(9). ST1014.2 +015800 02 FILLER PIC X(4) VALUE ST1014.2 +015900 " IN ". ST1014.2 +016000 02 FILLER PIC X(12) VALUE ST1014.2 +016100 " HIGH ". ST1014.2 +016200 02 FILLER PIC X(22) VALUE ST1014.2 +016300 " LEVEL VALIDATION FOR ". ST1014.2 +016400 02 FILLER PIC X(58) VALUE ST1014.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1014.2 +016600 01 CCVS-H-3. ST1014.2 +016700 02 FILLER PIC X(34) VALUE ST1014.2 +016800 " FOR OFFICIAL USE ONLY ". ST1014.2 +016900 02 FILLER PIC X(58) VALUE ST1014.2 +017000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1014.2 +017100 02 FILLER PIC X(28) VALUE ST1014.2 +017200 " COPYRIGHT 1985 ". ST1014.2 +017300 01 CCVS-E-1. ST1014.2 +017400 02 FILLER PIC X(52) VALUE SPACE. ST1014.2 +017500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1014.2 +017600 02 ID-AGAIN PIC X(9). ST1014.2 +017700 02 FILLER PIC X(45) VALUE SPACES. ST1014.2 +017800 01 CCVS-E-2. ST1014.2 +017900 02 FILLER PIC X(31) VALUE SPACE. ST1014.2 +018000 02 FILLER PIC X(21) VALUE SPACE. ST1014.2 +018100 02 CCVS-E-2-2. ST1014.2 +018200 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1014.2 +018300 03 FILLER PIC X VALUE SPACE. ST1014.2 +018400 03 ENDER-DESC PIC X(44) VALUE ST1014.2 +018500 "ERRORS ENCOUNTERED". ST1014.2 +018600 01 CCVS-E-3. ST1014.2 +018700 02 FILLER PIC X(22) VALUE ST1014.2 +018800 " FOR OFFICIAL USE ONLY". ST1014.2 +018900 02 FILLER PIC X(12) VALUE SPACE. ST1014.2 +019000 02 FILLER PIC X(58) VALUE ST1014.2 +019100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1014.2 +019200 02 FILLER PIC X(13) VALUE SPACE. ST1014.2 +019300 02 FILLER PIC X(15) VALUE ST1014.2 +019400 " COPYRIGHT 1985". ST1014.2 +019500 01 CCVS-E-4. ST1014.2 +019600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1014.2 +019700 02 FILLER PIC X(4) VALUE " OF ". ST1014.2 +019800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1014.2 +019900 02 FILLER PIC X(40) VALUE ST1014.2 +020000 " TESTS WERE EXECUTED SUCCESSFULLY". ST1014.2 +020100 01 XXINFO. ST1014.2 +020200 02 FILLER PIC X(19) VALUE ST1014.2 +020300 "*** INFORMATION ***". ST1014.2 +020400 02 INFO-TEXT. ST1014.2 +020500 04 FILLER PIC X(8) VALUE SPACE. ST1014.2 +020600 04 XXCOMPUTED PIC X(20). ST1014.2 +020700 04 FILLER PIC X(5) VALUE SPACE. ST1014.2 +020800 04 XXCORRECT PIC X(20). ST1014.2 +020900 02 INF-ANSI-REFERENCE PIC X(48). ST1014.2 +021000 01 HYPHEN-LINE. ST1014.2 +021100 02 FILLER PIC IS X VALUE IS SPACE. ST1014.2 +021200 02 FILLER PIC IS X(65) VALUE IS "************************ST1014.2 +021300- "*****************************************". ST1014.2 +021400 02 FILLER PIC IS X(54) VALUE IS "************************ST1014.2 +021500- "******************************". ST1014.2 +021600 01 CCVS-PGM-ID PIC X(9) VALUE ST1014.2 +021700 "ST101A". ST1014.2 +021800 PROCEDURE DIVISION. ST1014.2 +021900 SORT-INIT SECTION. ST1014.2 +022000 I-1. ST1014.2 +022100 SORT SORTFILE-1A ST1014.2 +022200 ON ASCENDING KEY KEY-1 ST1014.2 +022300 ON DESCENDING KEY KEY-2 ST1014.2 +022400 ON ASCENDING KEY KEY-3 ST1014.2 +022500 DESCENDING KEY-4 KEY-5 ST1014.2 +022600 INPUT PROCEDURE IS INSORT ST1014.2 +022700 OUTPUT PROCEDURE IS OUTP1 THRU OUTP3. ST1014.2 +022800 I-2. ST1014.2 +022900 STOP RUN. ST1014.2 +023000 INSORT SECTION. ST1014.2 +023100 IN-1. ST1014.2 +023200* NOTE. ST1014.2 +023300* KEYS 1 AND 3 THRU 5 WILL VARY IN VALUE BETWEEN 1 AND 2. ST1014.2 +023400* KEY 2 VARIES FROM 1 THRU 6. THUS 96 RECORDS ARE CREATED ST1014.2 +023500* IN REVERSE SEQUENCE OF SORTING ORDER. TWO RECORDS ARE ST1014.2 +023600* ADDED TO EACH END OF THE SORTED STRING FOR HI-LOW CONTROL.ST1014.2 +023700* THE SORT STATEMENT TESTS THE SERIES AND THRU OPTIONS WITH ST1014.2 +023800* INCLUSION AND OMISSION OF OPTIONAL WORDS. THE SORT ST1014.2 +023900* STATEMENT REPRESENTS BASIC SORTING PERMITTED BY LEVEL 1 OFST1014.2 +024000* THE SORT MODULE. ST1014.2 +024100 IN-2. ST1014.2 +024200 MOVE 900009000000000 TO RDF-KEYS. ST1014.2 +024300 RELEASE S-RECORD. ST1014.2 +024400 MOVE 009000000900009 TO RDF-KEYS. ST1014.2 +024500 RELEASE S-RECORD. ST1014.2 +024600 MOVE 900008000000000 TO RDF-KEYS. ST1014.2 +024700 RELEASE S-RECORD. ST1014.2 +024800 MOVE 009000000900008 TO RDF-KEYS. ST1014.2 +024900 RELEASE S-RECORD. ST1014.2 +025000* NOTE HI-LOW CONTROL RECORDS DONE. ST1014.2 +025100 MOVE 300003000000000 TO WKEYS-RDF. ST1014.2 +025200 IN-3. ST1014.2 +025300 PERFORM IN-4 2 TIMES. ST1014.2 +025400 GO TO IN-EXIT. ST1014.2 +025500 IN-4. ST1014.2 +025600 SUBTRACT C1 FROM WKEY-1. ST1014.2 +025700 PERFORM IN-5 6 TIMES. ST1014.2 +025800 IN-5. ST1014.2 +025900 IF WKEY-2 IS EQUAL TO C6 ST1014.2 +026000 MOVE C0 TO WKEY-2. ST1014.2 +026100 ADD C1 TO WKEY-2. ST1014.2 +026200 PERFORM IN-6 2 TIMES. ST1014.2 +026300 IN-6. ST1014.2 +026400 IF WKEY-3 IS EQUAL TO C1 ST1014.2 +026500 MOVE C3 TO WKEY-3. ST1014.2 +026600 SUBTRACT C1 FROM WKEY-3. ST1014.2 +026700 PERFORM IN-7 2 TIMES. ST1014.2 +026800 IN-7. ST1014.2 +026900 IF WKEY-4 IS EQUAL TO C2 ST1014.2 +027000 MOVE C0 TO WKEY-4. ST1014.2 +027100 ADD C1 TO WKEY-4. ST1014.2 +027200 PERFORM IN-8 2 TIMES. ST1014.2 +027300 IN-8. ST1014.2 +027400 IF WKEY-5 IS EQUAL TO C2 ST1014.2 +027500 MOVE C0 TO WKEY-5. ST1014.2 +027600 ADD C1 TO WKEY-5. ST1014.2 +027700 MOVE WKEYS-RDF TO RDF-KEYS. ST1014.2 +027800 RELEASE S-RECORD. ST1014.2 +027900 IN-EXIT. ST1014.2 +028000 EXIT. ST1014.2 +028100 OUTP1 SECTION. ST1014.2 +028200 SORTING-TEST. ST1014.2 +028300 OPEN OUTPUT SORTOUT-1A. ST1014.2 +028400 OPEN-FILES. ST1014.2 +028500 OPEN OUTPUT PRINT-FILE. ST1014.2 +028600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1014.2 +028700 MOVE SPACE TO TEST-RESULTS. ST1014.2 +028800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1014.2 +028900 GO TO CCVS1-EXIT. ST1014.2 +029000 CLOSE-FILES. ST1014.2 +029100 MOVE SPACES TO TEST-RESULTS. ST1014.2 +029200 MOVE COMMENT-SENTENCE TO TEST-RESULTS. ST1014.2 +029300 PERFORM PRINT-DETAIL. ST1014.2 +029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1014.2 +029500 MOVE SPACES TO TEST-RESULTS. ST1014.2 +029600 TERMINATE-CCVS. ST1014.2 +029700*S EXIT PROGRAM. ST1014.2 +029800*SERMINATE-CALL. ST1014.2 +029900 STOP RUN. ST1014.2 +030000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1014.2 +030100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1014.2 +030200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1014.2 +030300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1014.2 +030400 MOVE "****TEST DELETED****" TO RE-MARK. ST1014.2 +030500 PRINT-DETAIL. ST1014.2 +030600 IF REC-CT NOT EQUAL TO ZERO ST1014.2 +030700 MOVE "." TO PARDOT-X ST1014.2 +030800 MOVE REC-CT TO DOTVALUE. ST1014.2 +030900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1014.2 +031000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1014.2 +031100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1014.2 +031200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1014.2 +031300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1014.2 +031400 MOVE SPACE TO CORRECT-X. ST1014.2 +031500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1014.2 +031600 MOVE SPACE TO RE-MARK. ST1014.2 +031700 HEAD-ROUTINE. ST1014.2 +031800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +031900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +032000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1014.2 +032100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1014.2 +032200 COLUMN-NAMES-ROUTINE. ST1014.2 +032300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +032400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +032500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +032600 END-ROUTINE. ST1014.2 +032700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1014.2 +032800 END-RTN-EXIT. ST1014.2 +032900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +033000 END-ROUTINE-1. ST1014.2 +033100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1014.2 +033200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1014.2 +033300 ADD PASS-COUNTER TO ERROR-HOLD. ST1014.2 +033400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1014.2 +033500 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1014.2 +033600 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1014.2 +033700 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1014.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1014.2 +033900 END-ROUTINE-12. ST1014.2 +034000 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1014.2 +034100 IF ERROR-COUNTER IS EQUAL TO ZERO ST1014.2 +034200 MOVE "NO " TO ERROR-TOTAL ST1014.2 +034300 ELSE ST1014.2 +034400 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1014.2 +034500 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1014.2 +034600 PERFORM WRITE-LINE. ST1014.2 +034700 END-ROUTINE-13. ST1014.2 +034800 IF DELETE-COUNTER IS EQUAL TO ZERO ST1014.2 +034900 MOVE "NO " TO ERROR-TOTAL ELSE ST1014.2 +035000 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1014.2 +035100 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1014.2 +035200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +035300 IF INSPECT-COUNTER EQUAL TO ZERO ST1014.2 +035400 MOVE "NO " TO ERROR-TOTAL ST1014.2 +035500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1014.2 +035600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1014.2 +035700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +035800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1014.2 +035900 WRITE-LINE. ST1014.2 +036000 ADD 1 TO RECORD-COUNT. ST1014.2 +036100 IF RECORD-COUNT GREATER 42 ST1014.2 +036200 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1014.2 +036300 MOVE SPACE TO DUMMY-RECORD ST1014.2 +036400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1014.2 +036500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1014.2 +036600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1014.2 +036700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1014.2 +036800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1014.2 +036900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1014.2 +037000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1014.2 +037100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1014.2 +037200 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1014.2 +037300 MOVE ZERO TO RECORD-COUNT. ST1014.2 +037400 PERFORM WRT-LN. ST1014.2 +037500 WRT-LN. ST1014.2 +037600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1014.2 +037700 MOVE SPACE TO DUMMY-RECORD. ST1014.2 +037800 BLANK-LINE-PRINT. ST1014.2 +037900 PERFORM WRT-LN. ST1014.2 +038000 FAIL-ROUTINE. ST1014.2 +038100 IF COMPUTED-X NOT EQUAL TO SPACE ST1014.2 +038200 GO TO FAIL-ROUTINE-WRITE. ST1014.2 +038300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1014.2 +038400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1014.2 +038500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1014.2 +038600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +038700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1014.2 +038800 GO TO FAIL-ROUTINE-EX. ST1014.2 +038900 FAIL-ROUTINE-WRITE. ST1014.2 +039000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1014.2 +039100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1014.2 +039200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1014.2 +039300 MOVE SPACES TO COR-ANSI-REFERENCE. ST1014.2 +039400 FAIL-ROUTINE-EX. EXIT. ST1014.2 +039500 BAIL-OUT. ST1014.2 +039600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1014.2 +039700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1014.2 +039800 BAIL-OUT-WRITE. ST1014.2 +039900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1014.2 +040000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1014.2 +040100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1014.2 +040200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1014.2 +040300 BAIL-OUT-EX. EXIT. ST1014.2 +040400 CCVS1-EXIT. ST1014.2 +040500 EXIT. ST1014.2 +040600 ST101-0001-01. ST1014.2 +040700 MOVE "ST101 GENERATES OUTPUT" TO RE-MARK. ST1014.2 +040800 PERFORM PRINT-DETAIL. ST1014.2 +040900 MOVE "WHICH AFFECTS PROGRAMS" TO RE-MARK. ST1014.2 +041000 PERFORM PRINT-DETAIL. ST1014.2 +041100 MOVE "ST102 AND ST103." TO RE-MARK. ST1014.2 +041200 PERFORM PRINT-DETAIL. ST1014.2 +041300 MOVE "SORT --- FIVE KEYS" TO FEATURE. ST1014.2 +041400 SORT-TEST-1. ST1014.2 +041500 PERFORM RET-1. ST1014.2 +041600 IF RDF-KEYS EQUAL TO 009000000900009 ST1014.2 +041700 PERFORM PASS GO TO SORT-WRITE-1. ST1014.2 +041800 GO TO SORT-FAIL-1. ST1014.2 +041900 SORT-DELETE-1. ST1014.2 +042000 PERFORM DE-LETE. ST1014.2 +042100 GO TO SORT-WRITE-1. ST1014.2 +042200 SORT-FAIL-1. ST1014.2 +042300 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +042400 MOVE 009000000900009 TO CORRECT-18V0. ST1014.2 +042500 PERFORM FAIL. ST1014.2 +042600 SORT-WRITE-1. ST1014.2 +042700 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1014.2 +042800 PERFORM PRINT-DETAIL. ST1014.2 +042900 SORT-TEST-2. ST1014.2 +043000 PERFORM RET-1. ST1014.2 +043100 IF RDF-KEYS EQUAL TO 009000000900008 ST1014.2 +043200 PERFORM PASS GO TO SORT-WRITE-2. ST1014.2 +043300 GO TO SORT-FAIL-2. ST1014.2 +043400 SORT-DELETE-2. ST1014.2 +043500 PERFORM DE-LETE. ST1014.2 +043600 GO TO SORT-WRITE-2. ST1014.2 +043700 SORT-FAIL-2. ST1014.2 +043800 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +043900 MOVE 009000000900009 TO CORRECT-18V0. ST1014.2 +044000 PERFORM FAIL. ST1014.2 +044100 SORT-WRITE-2. ST1014.2 +044200 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1014.2 +044300 PERFORM PRINT-DETAIL. ST1014.2 +044400 SORT-TEST-3. ST1014.2 +044500 PERFORM RET-1. ST1014.2 +044600 IF RDF-KEYS EQUAL TO 106001000200002 ST1014.2 +044700 PERFORM PASS GO TO SORT-WRITE-3. ST1014.2 +044800 GO TO SORT-FAIL-3. ST1014.2 +044900 SORT-DELETE-3. ST1014.2 +045000 PERFORM DE-LETE. ST1014.2 +045100 GO TO SORT-WRITE-3. ST1014.2 +045200 SORT-FAIL-3. ST1014.2 +045300 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +045400 MOVE 106001000200002 TO CORRECT-18V0. ST1014.2 +045500 PERFORM FAIL. ST1014.2 +045600 SORT-WRITE-3. ST1014.2 +045700 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1014.2 +045800 PERFORM PRINT-DETAIL. ST1014.2 +045900 OUTP2 SECTION. ST1014.2 +046000 SORT-TEST-4. ST1014.2 +046100 PERFORM RET-2 48 TIMES. ST1014.2 +046200 IF RDF-KEYS EQUAL TO 206001000200002 ST1014.2 +046300 PERFORM PASS GO TO SORT-WRITE-4. ST1014.2 +046400 GO TO SORT-FAIL-4. ST1014.2 +046500 SORT-DELETE-4. ST1014.2 +046600 PERFORM DE-LETE. ST1014.2 +046700 GO TO SORT-WRITE-4. ST1014.2 +046800 SORT-FAIL-4. ST1014.2 +046900 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +047000 MOVE 206001000200002 TO CORRECT-18V0. ST1014.2 +047100 PERFORM FAIL. ST1014.2 +047200 SORT-WRITE-4. ST1014.2 +047300 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1014.2 +047400 PERFORM PRINT-DETAIL. ST1014.2 +047500 SORT-TEST-5. ST1014.2 +047600 PERFORM RET-2 40 TIMES. ST1014.2 +047700 IF RDF-KEYS EQUAL TO 201001000200002 ST1014.2 +047800 PERFORM PASS GO TO SORT-WRITE-5. ST1014.2 +047900 GO TO SORT-FAIL-5. ST1014.2 +048000 SORT-DELETE-5. ST1014.2 +048100 PERFORM DE-LETE. ST1014.2 +048200 GO TO SORT-WRITE-5. ST1014.2 +048300 SORT-FAIL-5. ST1014.2 +048400 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +048500 MOVE 201001000200002 TO CORRECT-18V0. ST1014.2 +048600 PERFORM FAIL. ST1014.2 +048700 SORT-WRITE-5. ST1014.2 +048800 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1014.2 +048900 PERFORM PRINT-DETAIL. ST1014.2 +049000 SORT-TEST-6. ST1014.2 +049100 PERFORM RET-2 7 TIMES. ST1014.2 +049200 IF RDF-KEYS EQUAL TO 201002000100001 ST1014.2 +049300 PERFORM PASS GO TO SORT-WRITE-6. ST1014.2 +049400 GO TO SORT-FAIL-6. ST1014.2 +049500 SORT-DELETE-6. ST1014.2 +049600 PERFORM DE-LETE. ST1014.2 +049700 GO TO SORT-WRITE-6. ST1014.2 +049800 SORT-FAIL-6. ST1014.2 +049900 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +050000 MOVE 201002000100001 TO CORRECT-18V0. ST1014.2 +050100 PERFORM FAIL. ST1014.2 +050200 SORT-WRITE-6. ST1014.2 +050300 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1014.2 +050400 PERFORM PRINT-DETAIL. ST1014.2 +050500 SORT-TEST-7. ST1014.2 +050600 PERFORM RET-2. ST1014.2 +050700 IF RDF-KEYS EQUAL TO 900008000000000 ST1014.2 +050800 PERFORM PASS GO TO SORT-WRITE-7. ST1014.2 +050900 GO TO SORT-FAIL-7. ST1014.2 +051000 SORT-DELETE-7. ST1014.2 +051100 PERFORM DE-LETE. ST1014.2 +051200 GO TO SORT-WRITE-7. ST1014.2 +051300 SORT-FAIL-7. ST1014.2 +051400 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +051500 MOVE 900008000000000 TO CORRECT-18V0. ST1014.2 +051600 PERFORM FAIL. ST1014.2 +051700 SORT-WRITE-7. ST1014.2 +051800 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1014.2 +051900 PERFORM PRINT-DETAIL. ST1014.2 +052000 SORT-TEST-8. ST1014.2 +052100 PERFORM RET-2. ST1014.2 +052200 IF RDF-KEYS EQUAL TO 900009000000000 ST1014.2 +052300 PERFORM PASS GO TO SORT-WRITE-8. ST1014.2 +052400 GO TO SORT-FAIL-8. ST1014.2 +052500 SORT-DELETE-8. ST1014.2 +052600 PERFORM DE-LETE. ST1014.2 +052700 GO TO SORT-WRITE-8. ST1014.2 +052800 SORT-FAIL-8. ST1014.2 +052900 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +053000 MOVE 900009000000000 TO CORRECT-18V0. ST1014.2 +053100 PERFORM FAIL. ST1014.2 +053200 SORT-WRITE-8. ST1014.2 +053300 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1014.2 +053400 PERFORM PRINT-DETAIL. ST1014.2 +053500 SORT-TEST-9. ST1014.2 +053600 RETURN SORTFILE-1A AT END ST1014.2 +053700 PERFORM PASS GO TO SORT-WRITE-9. ST1014.2 +053800 GO TO SORT-FAIL-9. ST1014.2 +053900 SORT-DELETE-9. ST1014.2 +054000 PERFORM DE-LETE. ST1014.2 +054100 GO TO SORT-WRITE-9. ST1014.2 +054200 SORT-FAIL-9. ST1014.2 +054300 MOVE RDF-KEYS TO COMPUTED-18V0. ST1014.2 +054400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1014.2 +054500 PERFORM FAIL. ST1014.2 +054600 SORT-WRITE-9. ST1014.2 +054700 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1014.2 +054800 PERFORM PRINT-DETAIL. ST1014.2 +054900 OUTP3 SECTION. ST1014.2 +055000 ST101-0002-01. ST1014.2 +055100 CLOSE SORTOUT-1A. ST1014.2 +055200 GO TO OUTP3-EXIT. ST1014.2 +055300 BAD-FILE. ST1014.2 +055400 MOVE "BAD-FILE" TO PAR-NAME. ST1014.2 +055500 PERFORM FAIL. ST1014.2 +055600 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1014.2 +055700 PERFORM PRINT-DETAIL. ST1014.2 +055800 MOVE "REACHED, PREVIOUS TEST WAS" TO RE-MARK. ST1014.2 +055900 PERFORM PRINT-DETAIL. ST1014.2 +056000 MOVE "THE LAST SUCCESSFUL TEST." TO RE-MARK. ST1014.2 +056100 PERFORM PRINT-DETAIL. ST1014.2 +056200 MOVE SPACE TO FEATURE. ST1014.2 +056300 GO TO OUTP3-EXIT. ST1014.2 +056400 RET-1. ST1014.2 +056500 RETURN SORTFILE-1A RECORD AT END GO TO BAD-FILE. ST1014.2 +056600 MOVE S-RECORD TO SORTED. ST1014.2 +056700 WRITE SORTED. ST1014.2 +056800* NOTE THE RETURN VERB WITH ALL OPTIONAL WORDS. ST1014.2 +056900 RET-2. ST1014.2 +057000 RETURN SORTFILE-1A END GO TO BAD-FILE. ST1014.2 +057100 MOVE S-RECORD TO SORTED. ST1014.2 +057200 WRITE SORTED. ST1014.2 +057300* NOTE THE RETURN VERB WITHOUT OPTIONAL WORDS. ST1014.2 +057400 OUTP3-EXIT. ST1014.2 +057500 PERFORM CLOSE-FILES. ST1014.2 diff --git a/tests/cobol85/ST/ST102A.SUB b/tests/cobol85/ST/ST102A.SUB new file mode 100755 index 00000000..d75326ce --- /dev/null +++ b/tests/cobol85/ST/ST102A.SUB @@ -0,0 +1,78 @@ +000100 IDENTIFICATION DIVISION. ST1024.2 +000200 PROGRAM-ID. ST1024.2 +000300 ST102A. ST1024.2 +000400**************************************************************** ST1024.2 +000500* * ST1024.2 +000600* VALIDATION FOR:- * ST1024.2 +000700* * ST1024.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1024.2 +000900* * ST1024.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1024.2 +001100* * ST1024.2 +001200**************************************************************** ST1024.2 +001300* * ST1024.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1024.2 +001500* * ST1024.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1024.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1024.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1024.2 +001900* * ST1024.2 +002000**************************************************************** ST1024.2 +002100 ENVIRONMENT DIVISION. ST1024.2 +002200 CONFIGURATION SECTION. ST1024.2 +002300 SOURCE-COMPUTER. ST1024.2 +002400 Linux. ST1024.2 +002500 OBJECT-COMPUTER. ST1024.2 +002600 Linux. ST1024.2 +002700 INPUT-OUTPUT SECTION. ST1024.2 +002800 FILE-CONTROL. ST1024.2 +002900 SELECT SORTFILE-1B ASSIGN TO ST1024.2 +003000 "XXXXX027". ST1024.2 +003100 SELECT SORTIN-1B ASSIGN TO ST1024.2 +003200 "XXXXX001". ST1024.2 +003300 SELECT SORTOUT-1B ASSIGN TO ST1024.2 +003400 "XXXXX002". ST1024.2 +003500 DATA DIVISION. ST1024.2 +003600 FILE SECTION. ST1024.2 +003700 SD SORTFILE-1B ST1024.2 +003800 RECORD CONTAINS 120 CHARACTERS ST1024.2 +003900 DATA RECORD S-RECORD. ST1024.2 +004000 01 S-RECORD. ST1024.2 +004100 02 KEYS-GROUP. ST1024.2 +004200 03 KEY-1 PICTURE 9. ST1024.2 +004300 03 KEY-2 PICTURE 99. ST1024.2 +004400 03 KEY-3 PICTURE 999. ST1024.2 +004500 03 KEY-4 PICTURE 9999. ST1024.2 +004600 03 KEY-5 PICTURE 9(5). ST1024.2 +004700 02 FILLER PICTURE X(105). ST1024.2 +004800 FD SORTIN-1B ST1024.2 +004900 BLOCK CONTAINS 10 RECORDS ST1024.2 +005000 LABEL RECORDS ARE STANDARD ST1024.2 +005100*C VALUE OF ST1024.2 +005200*C OCLABELID ST1024.2 +005300*C IS ST1024.2 +005400*C "OCDUMMY" ST1024.2 +005500*G SYSIN ST1024.2 +005600 DATA RECORD IS INSORT. ST1024.2 +005700 01 INSORT PICTURE X(120). ST1024.2 +005800 FD SORTOUT-1B ST1024.2 +005900 BLOCK CONTAINS 10 RECORDS ST1024.2 +006000 LABEL RECORD STANDARD ST1024.2 +006100*C VALUE OF ST1024.2 +006200*C OCLABELID ST1024.2 +006300*C IS ST1024.2 +006400*C "OCDUMMY" ST1024.2 +006500*G SYSIN ST1024.2 +006600 DATA RECORD OUTSORT. ST1024.2 +006700 01 OUTSORT PICTURE X(120). ST1024.2 +006800 PROCEDURE DIVISION. ST1024.2 +006900 SORT-STATEMENT. ST1024.2 +007000 SORT SORTFILE-1B ST1024.2 +007100 ON DESCENDING KEY KEY-1 ST1024.2 +007200 ON ASCENDING KEY KEY-2 ST1024.2 +007300 ON DESCENDING KEY KEY-3 ST1024.2 +007400 ASCENDING KEY-4 KEY-5 ST1024.2 +007500 USING SORTIN-1B ST1024.2 +007600 GIVING SORTOUT-1B. ST1024.2 +007700 STOP-RUN-STATEMENT. ST1024.2 +007800 STOP RUN. ST1024.2 diff --git a/tests/cobol85/ST/ST103A.SUB b/tests/cobol85/ST/ST103A.SUB new file mode 100755 index 00000000..3419432b --- /dev/null +++ b/tests/cobol85/ST/ST103A.SUB @@ -0,0 +1,473 @@ +000100 IDENTIFICATION DIVISION. ST1034.2 +000200 PROGRAM-ID. ST1034.2 +000300 ST103A. ST1034.2 +000400**************************************************************** ST1034.2 +000500* * ST1034.2 +000600* VALIDATION FOR:- * ST1034.2 +000700* * ST1034.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1034.2 +000900* * ST1034.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1034.2 +001100* * ST1034.2 +001200**************************************************************** ST1034.2 +001300* * ST1034.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1034.2 +001500* * ST1034.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1034.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1034.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1034.2 +001900* * ST1034.2 +002000**************************************************************** ST1034.2 +002100 ENVIRONMENT DIVISION. ST1034.2 +002200 CONFIGURATION SECTION. ST1034.2 +002300 SOURCE-COMPUTER. ST1034.2 +002400 Linux. ST1034.2 +002500 OBJECT-COMPUTER. ST1034.2 +002600 Linux. ST1034.2 +002700 INPUT-OUTPUT SECTION. ST1034.2 +002800 FILE-CONTROL. ST1034.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1034.2 +003000 "report.log". ST1034.2 +003100 SELECT SORTIN-1C ASSIGN TO ST1034.2 +003200 "XXXXX002". ST1034.2 +003300 DATA DIVISION. ST1034.2 +003400 FILE SECTION. ST1034.2 +003500 FD PRINT-FILE. ST1034.2 +003600 01 PRINT-REC PICTURE X(120). ST1034.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1034.2 +003800 FD SORTIN-1C ST1034.2 +003900 BLOCK CONTAINS 10 RECORDS ST1034.2 +004000 LABEL RECORD STANDARD ST1034.2 +004100*C VALUE OF ST1034.2 +004200*C OCLABELID ST1034.2 +004300*C IS ST1034.2 +004400*C "OCDUMMY" ST1034.2 +004500*G SYSIN ST1034.2 +004600 DATA RECORD IS SORTIN-REC. ST1034.2 +004700 01 SORTIN-REC. ST1034.2 +004800 02 KEYS-GROUP PICTURE 9(15). ST1034.2 +004900 02 FILLER PICTURE X(105). ST1034.2 +005000 WORKING-STORAGE SECTION. ST1034.2 +005100 01 TEST-RESULTS. ST1034.2 +005200 02 FILLER PIC X VALUE SPACE. ST1034.2 +005300 02 FEATURE PIC X(20) VALUE SPACE. ST1034.2 +005400 02 FILLER PIC X VALUE SPACE. ST1034.2 +005500 02 P-OR-F PIC X(5) VALUE SPACE. ST1034.2 +005600 02 FILLER PIC X VALUE SPACE. ST1034.2 +005700 02 PAR-NAME. ST1034.2 +005800 03 FILLER PIC X(19) VALUE SPACE. ST1034.2 +005900 03 PARDOT-X PIC X VALUE SPACE. ST1034.2 +006000 03 DOTVALUE PIC 99 VALUE ZERO. ST1034.2 +006100 02 FILLER PIC X(8) VALUE SPACE. ST1034.2 +006200 02 RE-MARK PIC X(61). ST1034.2 +006300 01 TEST-COMPUTED. ST1034.2 +006400 02 FILLER PIC X(30) VALUE SPACE. ST1034.2 +006500 02 FILLER PIC X(17) VALUE ST1034.2 +006600 " COMPUTED=". ST1034.2 +006700 02 COMPUTED-X. ST1034.2 +006800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1034.2 +006900 03 COMPUTED-N REDEFINES COMPUTED-A ST1034.2 +007000 PIC -9(9).9(9). ST1034.2 +007100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1034.2 +007200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1034.2 +007300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1034.2 +007400 03 CM-18V0 REDEFINES COMPUTED-A. ST1034.2 +007500 04 COMPUTED-18V0 PIC -9(18). ST1034.2 +007600 04 FILLER PIC X. ST1034.2 +007700 03 FILLER PIC X(50) VALUE SPACE. ST1034.2 +007800 01 TEST-CORRECT. ST1034.2 +007900 02 FILLER PIC X(30) VALUE SPACE. ST1034.2 +008000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1034.2 +008100 02 CORRECT-X. ST1034.2 +008200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1034.2 +008300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1034.2 +008400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1034.2 +008500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1034.2 +008600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1034.2 +008700 03 CR-18V0 REDEFINES CORRECT-A. ST1034.2 +008800 04 CORRECT-18V0 PIC -9(18). ST1034.2 +008900 04 FILLER PIC X. ST1034.2 +009000 03 FILLER PIC X(2) VALUE SPACE. ST1034.2 +009100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1034.2 +009200 01 CCVS-C-1. ST1034.2 +009300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1034.2 +009400- "SS PARAGRAPH-NAME ST1034.2 +009500- " REMARKS". ST1034.2 +009600 02 FILLER PIC X(20) VALUE SPACE. ST1034.2 +009700 01 CCVS-C-2. ST1034.2 +009800 02 FILLER PIC X VALUE SPACE. ST1034.2 +009900 02 FILLER PIC X(6) VALUE "TESTED". ST1034.2 +010000 02 FILLER PIC X(15) VALUE SPACE. ST1034.2 +010100 02 FILLER PIC X(4) VALUE "FAIL". ST1034.2 +010200 02 FILLER PIC X(94) VALUE SPACE. ST1034.2 +010300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1034.2 +010400 01 REC-CT PIC 99 VALUE ZERO. ST1034.2 +010500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1034.2 +010600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1034.2 +010700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1034.2 +010800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1034.2 +010900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1034.2 +011000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1034.2 +011100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1034.2 +011200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1034.2 +011300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1034.2 +011400 01 CCVS-H-1. ST1034.2 +011500 02 FILLER PIC X(39) VALUE SPACES. ST1034.2 +011600 02 FILLER PIC X(42) VALUE ST1034.2 +011700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1034.2 +011800 02 FILLER PIC X(39) VALUE SPACES. ST1034.2 +011900 01 CCVS-H-2A. ST1034.2 +012000 02 FILLER PIC X(40) VALUE SPACE. ST1034.2 +012100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1034.2 +012200 02 FILLER PIC XXXX VALUE ST1034.2 +012300 "4.2 ". ST1034.2 +012400 02 FILLER PIC X(28) VALUE ST1034.2 +012500 " COPY - NOT FOR DISTRIBUTION". ST1034.2 +012600 02 FILLER PIC X(41) VALUE SPACE. ST1034.2 +012700 ST1034.2 +012800 01 CCVS-H-2B. ST1034.2 +012900 02 FILLER PIC X(15) VALUE ST1034.2 +013000 "TEST RESULT OF ". ST1034.2 +013100 02 TEST-ID PIC X(9). ST1034.2 +013200 02 FILLER PIC X(4) VALUE ST1034.2 +013300 " IN ". ST1034.2 +013400 02 FILLER PIC X(12) VALUE ST1034.2 +013500 " HIGH ". ST1034.2 +013600 02 FILLER PIC X(22) VALUE ST1034.2 +013700 " LEVEL VALIDATION FOR ". ST1034.2 +013800 02 FILLER PIC X(58) VALUE ST1034.2 +013900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1034.2 +014000 01 CCVS-H-3. ST1034.2 +014100 02 FILLER PIC X(34) VALUE ST1034.2 +014200 " FOR OFFICIAL USE ONLY ". ST1034.2 +014300 02 FILLER PIC X(58) VALUE ST1034.2 +014400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1034.2 +014500 02 FILLER PIC X(28) VALUE ST1034.2 +014600 " COPYRIGHT 1985 ". ST1034.2 +014700 01 CCVS-E-1. ST1034.2 +014800 02 FILLER PIC X(52) VALUE SPACE. ST1034.2 +014900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1034.2 +015000 02 ID-AGAIN PIC X(9). ST1034.2 +015100 02 FILLER PIC X(45) VALUE SPACES. ST1034.2 +015200 01 CCVS-E-2. ST1034.2 +015300 02 FILLER PIC X(31) VALUE SPACE. ST1034.2 +015400 02 FILLER PIC X(21) VALUE SPACE. ST1034.2 +015500 02 CCVS-E-2-2. ST1034.2 +015600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1034.2 +015700 03 FILLER PIC X VALUE SPACE. ST1034.2 +015800 03 ENDER-DESC PIC X(44) VALUE ST1034.2 +015900 "ERRORS ENCOUNTERED". ST1034.2 +016000 01 CCVS-E-3. ST1034.2 +016100 02 FILLER PIC X(22) VALUE ST1034.2 +016200 " FOR OFFICIAL USE ONLY". ST1034.2 +016300 02 FILLER PIC X(12) VALUE SPACE. ST1034.2 +016400 02 FILLER PIC X(58) VALUE ST1034.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1034.2 +016600 02 FILLER PIC X(13) VALUE SPACE. ST1034.2 +016700 02 FILLER PIC X(15) VALUE ST1034.2 +016800 " COPYRIGHT 1985". ST1034.2 +016900 01 CCVS-E-4. ST1034.2 +017000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1034.2 +017100 02 FILLER PIC X(4) VALUE " OF ". ST1034.2 +017200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1034.2 +017300 02 FILLER PIC X(40) VALUE ST1034.2 +017400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1034.2 +017500 01 XXINFO. ST1034.2 +017600 02 FILLER PIC X(19) VALUE ST1034.2 +017700 "*** INFORMATION ***". ST1034.2 +017800 02 INFO-TEXT. ST1034.2 +017900 04 FILLER PIC X(8) VALUE SPACE. ST1034.2 +018000 04 XXCOMPUTED PIC X(20). ST1034.2 +018100 04 FILLER PIC X(5) VALUE SPACE. ST1034.2 +018200 04 XXCORRECT PIC X(20). ST1034.2 +018300 02 INF-ANSI-REFERENCE PIC X(48). ST1034.2 +018400 01 HYPHEN-LINE. ST1034.2 +018500 02 FILLER PIC IS X VALUE IS SPACE. ST1034.2 +018600 02 FILLER PIC IS X(65) VALUE IS "************************ST1034.2 +018700- "*****************************************". ST1034.2 +018800 02 FILLER PIC IS X(54) VALUE IS "************************ST1034.2 +018900- "******************************". ST1034.2 +019000 01 CCVS-PGM-ID PIC X(9) VALUE ST1034.2 +019100 "ST103A". ST1034.2 +019200 PROCEDURE DIVISION. ST1034.2 +019300 CCVS1 SECTION. ST1034.2 +019400 OPEN-FILES. ST1034.2 +019500 OPEN OUTPUT PRINT-FILE. ST1034.2 +019600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1034.2 +019700 MOVE SPACE TO TEST-RESULTS. ST1034.2 +019800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1034.2 +019900 GO TO CCVS1-EXIT. ST1034.2 +020000 CLOSE-FILES. ST1034.2 +020100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1034.2 +020200 TERMINATE-CCVS. ST1034.2 +020300*S EXIT PROGRAM. ST1034.2 +020400*SERMINATE-CALL. ST1034.2 +020500 STOP RUN. ST1034.2 +020600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1034.2 +020700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1034.2 +020800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1034.2 +020900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1034.2 +021000 MOVE "****TEST DELETED****" TO RE-MARK. ST1034.2 +021100 PRINT-DETAIL. ST1034.2 +021200 IF REC-CT NOT EQUAL TO ZERO ST1034.2 +021300 MOVE "." TO PARDOT-X ST1034.2 +021400 MOVE REC-CT TO DOTVALUE. ST1034.2 +021500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1034.2 +021600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1034.2 +021700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1034.2 +021800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1034.2 +021900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1034.2 +022000 MOVE SPACE TO CORRECT-X. ST1034.2 +022100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1034.2 +022200 MOVE SPACE TO RE-MARK. ST1034.2 +022300 HEAD-ROUTINE. ST1034.2 +022400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +022500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +022600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1034.2 +022700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1034.2 +022800 COLUMN-NAMES-ROUTINE. ST1034.2 +022900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +023000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +023100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +023200 END-ROUTINE. ST1034.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1034.2 +023400 END-RTN-EXIT. ST1034.2 +023500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +023600 END-ROUTINE-1. ST1034.2 +023700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1034.2 +023800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1034.2 +023900 ADD PASS-COUNTER TO ERROR-HOLD. ST1034.2 +024000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1034.2 +024100 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1034.2 +024200 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1034.2 +024300 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1034.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1034.2 +024500 END-ROUTINE-12. ST1034.2 +024600 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1034.2 +024700 IF ERROR-COUNTER IS EQUAL TO ZERO ST1034.2 +024800 MOVE "NO " TO ERROR-TOTAL ST1034.2 +024900 ELSE ST1034.2 +025000 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1034.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1034.2 +025200 PERFORM WRITE-LINE. ST1034.2 +025300 END-ROUTINE-13. ST1034.2 +025400 IF DELETE-COUNTER IS EQUAL TO ZERO ST1034.2 +025500 MOVE "NO " TO ERROR-TOTAL ELSE ST1034.2 +025600 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1034.2 +025700 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1034.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +025900 IF INSPECT-COUNTER EQUAL TO ZERO ST1034.2 +026000 MOVE "NO " TO ERROR-TOTAL ST1034.2 +026100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1034.2 +026200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1034.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +026400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1034.2 +026500 WRITE-LINE. ST1034.2 +026600 ADD 1 TO RECORD-COUNT. ST1034.2 +026700 IF RECORD-COUNT GREATER 42 ST1034.2 +026800 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1034.2 +026900 MOVE SPACE TO DUMMY-RECORD ST1034.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1034.2 +027100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1034.2 +027200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1034.2 +027300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1034.2 +027400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1034.2 +027500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1034.2 +027600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1034.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1034.2 +027800 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1034.2 +027900 MOVE ZERO TO RECORD-COUNT. ST1034.2 +028000 PERFORM WRT-LN. ST1034.2 +028100 WRT-LN. ST1034.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1034.2 +028300 MOVE SPACE TO DUMMY-RECORD. ST1034.2 +028400 BLANK-LINE-PRINT. ST1034.2 +028500 PERFORM WRT-LN. ST1034.2 +028600 FAIL-ROUTINE. ST1034.2 +028700 IF COMPUTED-X NOT EQUAL TO SPACE ST1034.2 +028800 GO TO FAIL-ROUTINE-WRITE. ST1034.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1034.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1034.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1034.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1034.2 +029400 GO TO FAIL-ROUTINE-EX. ST1034.2 +029500 FAIL-ROUTINE-WRITE. ST1034.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1034.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1034.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1034.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. ST1034.2 +030000 FAIL-ROUTINE-EX. EXIT. ST1034.2 +030100 BAIL-OUT. ST1034.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1034.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1034.2 +030400 BAIL-OUT-WRITE. ST1034.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1034.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1034.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1034.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1034.2 +030900 BAIL-OUT-EX. EXIT. ST1034.2 +031000 CCVS1-EXIT. ST1034.2 +031100 EXIT. ST1034.2 +031200 SECT-ST103-0001 SECTION. ST1034.2 +031300 ST103-0001-01. ST1034.2 +031400 OPEN INPUT SORTIN-1C. ST1034.2 +031500 MOVE "THIS PROGRAM TESTS THE" TO RE-MARK. ST1034.2 +031600 PERFORM PRINT-DETAIL. ST1034.2 +031700 MOVE "OUTPUT GENERATED BY ST102," TO RE-MARK. ST1034.2 +031800 PERFORM PRINT-DETAIL. ST1034.2 +031900 MOVE "WHICH WAS IN TURN GENERATED" TO RE-MARK. ST1034.2 +032000 PERFORM PRINT-DETAIL. ST1034.2 +032100 MOVE "IN ST101." TO RE-MARK. ST1034.2 +032200 PERFORM PRINT-DETAIL. ST1034.2 +032300 MOVE "SORT - USING, GIVING" TO FEATURE. ST1034.2 +032400 SORT-TEST-1. ST1034.2 +032500 PERFORM READ-SORTED-FILE. ST1034.2 +032600 IF KEYS-GROUP EQUAL TO 900009000000000 ST1034.2 +032700 PERFORM PASS GO TO SORT-WRITE-1. ST1034.2 +032800 GO TO SORT-FAIL-1. ST1034.2 +032900 SORT-DELETE-1. ST1034.2 +033000 PERFORM DE-LETE. ST1034.2 +033100 GO TO SORT-WRITE-1. ST1034.2 +033200 SORT-FAIL-1. ST1034.2 +033300 PERFORM FAIL. ST1034.2 +033400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +033500 MOVE 900009000000000 TO CORRECT-18V0. ST1034.2 +033600 SORT-WRITE-1. ST1034.2 +033700 MOVE "SORT-TEST-1" TO PAR-NAME. ST1034.2 +033800 PERFORM PRINT-DETAIL. ST1034.2 +033900 SORT-TEST-2. ST1034.2 +034000 PERFORM READ-SORTED-FILE. ST1034.2 +034100 IF KEYS-GROUP EQUAL TO 900008000000000 ST1034.2 +034200 PERFORM PASS GO TO SORT-WRITE-2. ST1034.2 +034300 GO TO SORT-FAIL-2. ST1034.2 +034400 SORT-DELETE-2. ST1034.2 +034500 PERFORM DE-LETE. ST1034.2 +034600 GO TO SORT-WRITE-2. ST1034.2 +034700 SORT-FAIL-2. ST1034.2 +034800 PERFORM FAIL. ST1034.2 +034900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +035000 MOVE 900008000000000 TO CORRECT-18V0. ST1034.2 +035100 SORT-WRITE-2. ST1034.2 +035200 MOVE "SORT-TEST-2" TO PAR-NAME. ST1034.2 +035300 PERFORM PRINT-DETAIL. ST1034.2 +035400 SORT-TEST-3. ST1034.2 +035500 PERFORM READ-SORTED-FILE. ST1034.2 +035600 IF KEYS-GROUP EQUAL TO 201002000100001 ST1034.2 +035700 PERFORM PASS GO TO SORT-WRITE-3. ST1034.2 +035800 GO TO SORT-FAIL-3. ST1034.2 +035900 SORT-DELETE-3. ST1034.2 +036000 PERFORM DE-LETE. ST1034.2 +036100 GO TO SORT-WRITE-3. ST1034.2 +036200 SORT-FAIL-3. ST1034.2 +036300 PERFORM FAIL. ST1034.2 +036400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +036500 MOVE 201002000100001 TO CORRECT-18V0. ST1034.2 +036600 SORT-WRITE-3. ST1034.2 +036700 MOVE "SORT-TEST-3" TO PAR-NAME. ST1034.2 +036800 PERFORM PRINT-DETAIL. ST1034.2 +036900 SORT-TEST-4. ST1034.2 +037000 PERFORM READ-SORTED-FILE 48 TIMES. ST1034.2 +037100 IF KEYS-GROUP EQUAL TO 101002000100001 ST1034.2 +037200 PERFORM PASS GO TO SORT-WRITE-4. ST1034.2 +037300 GO TO SORT-FAIL-4. ST1034.2 +037400 SORT-DELETE-4. ST1034.2 +037500 PERFORM DE-LETE. ST1034.2 +037600 GO TO SORT-WRITE-4. ST1034.2 +037700 SORT-FAIL-4. ST1034.2 +037800 PERFORM FAIL. ST1034.2 +037900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +038000 MOVE 101002000100001 TO CORRECT-18V0. ST1034.2 +038100 SORT-WRITE-4. ST1034.2 +038200 MOVE "SORT-TEST-4" TO PAR-NAME. ST1034.2 +038300 PERFORM PRINT-DETAIL. ST1034.2 +038400 SORT-TEST-5. ST1034.2 +038500 PERFORM READ-SORTED-FILE 40 TIMES. ST1034.2 +038600 IF KEYS-GROUP EQUAL TO 106002000100001 ST1034.2 +038700 PERFORM PASS GO TO SORT-WRITE-5. ST1034.2 +038800 GO TO SORT-FAIL-5. ST1034.2 +038900 SORT-DELETE-5. ST1034.2 +039000 PERFORM DE-LETE. ST1034.2 +039100 GO TO SORT-WRITE-5. ST1034.2 +039200 SORT-FAIL-5. ST1034.2 +039300 PERFORM FAIL. ST1034.2 +039400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +039500 MOVE 106002000100001 TO CORRECT-18V0. ST1034.2 +039600 SORT-WRITE-5. ST1034.2 +039700 MOVE "SORT-TEST-5" TO PAR-NAME. ST1034.2 +039800 PERFORM PRINT-DETAIL. ST1034.2 +039900 SORT-TEST-6. ST1034.2 +040000 PERFORM READ-SORTED-FILE 7 TIMES. ST1034.2 +040100 IF KEYS-GROUP EQUAL TO 106001000200002 ST1034.2 +040200 PERFORM PASS GO TO SORT-WRITE-6. ST1034.2 +040300 GO TO SORT-FAIL-6. ST1034.2 +040400 SORT-DELETE-6. ST1034.2 +040500 PERFORM DE-LETE. ST1034.2 +040600 GO TO SORT-WRITE-6. ST1034.2 +040700 SORT-FAIL-6. ST1034.2 +040800 PERFORM FAIL. ST1034.2 +040900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +041000 MOVE 106001000200002 TO CORRECT-18V0. ST1034.2 +041100 SORT-WRITE-6. ST1034.2 +041200 MOVE "SORT-TEST-6" TO PAR-NAME. ST1034.2 +041300 PERFORM PRINT-DETAIL. ST1034.2 +041400 SORT-TEST-7. ST1034.2 +041500 PERFORM READ-SORTED-FILE. ST1034.2 +041600 IF KEYS-GROUP EQUAL TO 009000000900008 ST1034.2 +041700 PERFORM PASS GO TO SORT-WRITE-7. ST1034.2 +041800 GO TO SORT-FAIL-7. ST1034.2 +041900 SORT-DELETE-7. ST1034.2 +042000 PERFORM DE-LETE. ST1034.2 +042100 GO TO SORT-WRITE-7. ST1034.2 +042200 SORT-FAIL-7. ST1034.2 +042300 PERFORM FAIL. ST1034.2 +042400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +042500 MOVE 009000000900008 TO CORRECT-18V0. ST1034.2 +042600 SORT-WRITE-7. ST1034.2 +042700 MOVE "SORT-TEST-7" TO PAR-NAME. ST1034.2 +042800 PERFORM PRINT-DETAIL. ST1034.2 +042900 SORT-TEST-8. ST1034.2 +043000 PERFORM READ-SORTED-FILE. ST1034.2 +043100 IF KEYS-GROUP EQUAL TO 009000000900009 ST1034.2 +043200 PERFORM PASS GO TO SORT-WRITE-8. ST1034.2 +043300 GO TO SORT-FAIL-8. ST1034.2 +043400 SORT-DELETE-8. ST1034.2 +043500 PERFORM DE-LETE. ST1034.2 +043600 GO TO SORT-WRITE-8. ST1034.2 +043700 SORT-FAIL-8. ST1034.2 +043800 PERFORM FAIL. ST1034.2 +043900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +044000 MOVE 009000000900009 TO CORRECT-18V0. ST1034.2 +044100 SORT-WRITE-8. ST1034.2 +044200 MOVE "SORT-TEST-8" TO PAR-NAME. ST1034.2 +044300 PERFORM PRINT-DETAIL. ST1034.2 +044400 SORT-TEST-9. ST1034.2 +044500 READ SORTIN-1C AT END ST1034.2 +044600 PERFORM PASS GO TO SORT-WRITE-9. ST1034.2 +044700* NOTE THE FOLLOWING STATEMENTS SHOULD NOT BE EXECUTED. ST1034.2 +044800 PERFORM FAIL. ST1034.2 +044900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1034.2 +045000 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1034.2 +045100 GO TO SORT-WRITE-9. ST1034.2 +045200 SORT-DELETE-9. ST1034.2 +045300 PERFORM DE-LETE. ST1034.2 +045400 SORT-WRITE-9. ST1034.2 +045500 MOVE "SORT-TEST-9" TO PAR-NAME. ST1034.2 +045600 PERFORM PRINT-DETAIL. ST1034.2 +045700 CLOSE SORTIN-1C. ST1034.2 +045800 GO TO CCVS-EXIT. ST1034.2 +045900 READ-SORTED-FILE. ST1034.2 +046000 READ SORTIN-1C AT END GO TO BAD-FILE. ST1034.2 +046100 BAD-FILE. ST1034.2 +046200 PERFORM FAIL. ST1034.2 +046300 MOVE "BAD-FILE" TO PAR-NAME. ST1034.2 +046400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1034.2 +046500 PERFORM PRINT-DETAIL. ST1034.2 +046600 MOVE SPACE TO FEATURE. ST1034.2 +046700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1034.2 +046800 PERFORM PRINT-DETAIL. ST1034.2 +046900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. ST1034.2 +047000 PERFORM PRINT-DETAIL. ST1034.2 +047100 CCVS-EXIT SECTION. ST1034.2 +047200 CCVS-999999. ST1034.2 +047300 GO TO CLOSE-FILES. ST1034.2 diff --git a/tests/cobol85/ST/ST104A.CBL b/tests/cobol85/ST/ST104A.CBL new file mode 100755 index 00000000..180f66ca --- /dev/null +++ b/tests/cobol85/ST/ST104A.CBL @@ -0,0 +1,352 @@ +000100 IDENTIFICATION DIVISION. ST1044.2 +000200 PROGRAM-ID. ST1044.2 +000300 ST104A. ST1044.2 +000400**************************************************************** ST1044.2 +000500* * ST1044.2 +000600* VALIDATION FOR:- * ST1044.2 +000700* * ST1044.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1044.2 +000900* * ST1044.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1044.2 +001100* * ST1044.2 +001200**************************************************************** ST1044.2 +001300* * ST1044.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1044.2 +001500* * ST1044.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1044.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1044.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1044.2 +001900* * ST1044.2 +002000**************************************************************** ST1044.2 +002100 ENVIRONMENT DIVISION. ST1044.2 +002200 CONFIGURATION SECTION. ST1044.2 +002300 SOURCE-COMPUTER. ST1044.2 +002400 Linux. ST1044.2 +002500 OBJECT-COMPUTER. ST1044.2 +002600 Linux. ST1044.2 +002700 INPUT-OUTPUT SECTION. ST1044.2 +002800 FILE-CONTROL. ST1044.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1044.2 +003000 "report.log". ST1044.2 +003100 SELECT SORTOUT-1D ASSIGN TO ST1044.2 +003200 "XXXXX001". ST1044.2 +003300 DATA DIVISION. ST1044.2 +003400 FILE SECTION. ST1044.2 +003500 FD PRINT-FILE. ST1044.2 +003600 01 PRINT-REC PICTURE X(120). ST1044.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1044.2 +003800 FD SORTOUT-1D ST1044.2 +003900 LABEL RECORDS STANDARD ST1044.2 +004000*C VALUE OF ST1044.2 +004100*C OCLABELID ST1044.2 +004200*C IS ST1044.2 +004300*C "OCDUMMY" ST1044.2 +004400*G SYSIN ST1044.2 +004500 DATA RECORD IS SORTOUT-REC. ST1044.2 +004600 01 SORTOUT-REC. ST1044.2 +004700 02 KEY-ITEM PICTURE S999V999. ST1044.2 +004800 02 NON-KEY-ITEM PICTURE S9(12). ST1044.2 +004900 WORKING-STORAGE SECTION. ST1044.2 +005000 77 U-TILITY PICTURE 999V999 VALUE ZERO. ST1044.2 +005100 77 UTIL-SW PICTURE 9 VALUE ZERO. ST1044.2 +005200 77 WRITE-COUNTER PICTURE 999 VALUE ZERO. ST1044.2 +005300 01 TEST-RESULTS. ST1044.2 +005400 02 FILLER PIC X VALUE SPACE. ST1044.2 +005500 02 FEATURE PIC X(20) VALUE SPACE. ST1044.2 +005600 02 FILLER PIC X VALUE SPACE. ST1044.2 +005700 02 P-OR-F PIC X(5) VALUE SPACE. ST1044.2 +005800 02 FILLER PIC X VALUE SPACE. ST1044.2 +005900 02 PAR-NAME. ST1044.2 +006000 03 FILLER PIC X(19) VALUE SPACE. ST1044.2 +006100 03 PARDOT-X PIC X VALUE SPACE. ST1044.2 +006200 03 DOTVALUE PIC 99 VALUE ZERO. ST1044.2 +006300 02 FILLER PIC X(8) VALUE SPACE. ST1044.2 +006400 02 RE-MARK PIC X(61). ST1044.2 +006500 01 TEST-COMPUTED. ST1044.2 +006600 02 FILLER PIC X(30) VALUE SPACE. ST1044.2 +006700 02 FILLER PIC X(17) VALUE ST1044.2 +006800 " COMPUTED=". ST1044.2 +006900 02 COMPUTED-X. ST1044.2 +007000 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1044.2 +007100 03 COMPUTED-N REDEFINES COMPUTED-A ST1044.2 +007200 PIC -9(9).9(9). ST1044.2 +007300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1044.2 +007400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1044.2 +007500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1044.2 +007600 03 CM-18V0 REDEFINES COMPUTED-A. ST1044.2 +007700 04 COMPUTED-18V0 PIC -9(18). ST1044.2 +007800 04 FILLER PIC X. ST1044.2 +007900 03 FILLER PIC X(50) VALUE SPACE. ST1044.2 +008000 01 TEST-CORRECT. ST1044.2 +008100 02 FILLER PIC X(30) VALUE SPACE. ST1044.2 +008200 02 FILLER PIC X(17) VALUE " CORRECT =". ST1044.2 +008300 02 CORRECT-X. ST1044.2 +008400 03 CORRECT-A PIC X(20) VALUE SPACE. ST1044.2 +008500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1044.2 +008600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1044.2 +008700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1044.2 +008800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1044.2 +008900 03 CR-18V0 REDEFINES CORRECT-A. ST1044.2 +009000 04 CORRECT-18V0 PIC -9(18). ST1044.2 +009100 04 FILLER PIC X. ST1044.2 +009200 03 FILLER PIC X(2) VALUE SPACE. ST1044.2 +009300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1044.2 +009400 01 CCVS-C-1. ST1044.2 +009500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1044.2 +009600- "SS PARAGRAPH-NAME ST1044.2 +009700- " REMARKS". ST1044.2 +009800 02 FILLER PIC X(20) VALUE SPACE. ST1044.2 +009900 01 CCVS-C-2. ST1044.2 +010000 02 FILLER PIC X VALUE SPACE. ST1044.2 +010100 02 FILLER PIC X(6) VALUE "TESTED". ST1044.2 +010200 02 FILLER PIC X(15) VALUE SPACE. ST1044.2 +010300 02 FILLER PIC X(4) VALUE "FAIL". ST1044.2 +010400 02 FILLER PIC X(94) VALUE SPACE. ST1044.2 +010500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1044.2 +010600 01 REC-CT PIC 99 VALUE ZERO. ST1044.2 +010700 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1044.2 +010800 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1044.2 +010900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1044.2 +011000 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1044.2 +011100 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1044.2 +011200 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1044.2 +011300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1044.2 +011400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1044.2 +011500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1044.2 +011600 01 CCVS-H-1. ST1044.2 +011700 02 FILLER PIC X(39) VALUE SPACES. ST1044.2 +011800 02 FILLER PIC X(42) VALUE ST1044.2 +011900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1044.2 +012000 02 FILLER PIC X(39) VALUE SPACES. ST1044.2 +012100 01 CCVS-H-2A. ST1044.2 +012200 02 FILLER PIC X(40) VALUE SPACE. ST1044.2 +012300 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1044.2 +012400 02 FILLER PIC XXXX VALUE ST1044.2 +012500 "4.2 ". ST1044.2 +012600 02 FILLER PIC X(28) VALUE ST1044.2 +012700 " COPY - NOT FOR DISTRIBUTION". ST1044.2 +012800 02 FILLER PIC X(41) VALUE SPACE. ST1044.2 +012900 ST1044.2 +013000 01 CCVS-H-2B. ST1044.2 +013100 02 FILLER PIC X(15) VALUE ST1044.2 +013200 "TEST RESULT OF ". ST1044.2 +013300 02 TEST-ID PIC X(9). ST1044.2 +013400 02 FILLER PIC X(4) VALUE ST1044.2 +013500 " IN ". ST1044.2 +013600 02 FILLER PIC X(12) VALUE ST1044.2 +013700 " HIGH ". ST1044.2 +013800 02 FILLER PIC X(22) VALUE ST1044.2 +013900 " LEVEL VALIDATION FOR ". ST1044.2 +014000 02 FILLER PIC X(58) VALUE ST1044.2 +014100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1044.2 +014200 01 CCVS-H-3. ST1044.2 +014300 02 FILLER PIC X(34) VALUE ST1044.2 +014400 " FOR OFFICIAL USE ONLY ". ST1044.2 +014500 02 FILLER PIC X(58) VALUE ST1044.2 +014600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1044.2 +014700 02 FILLER PIC X(28) VALUE ST1044.2 +014800 " COPYRIGHT 1985 ". ST1044.2 +014900 01 CCVS-E-1. ST1044.2 +015000 02 FILLER PIC X(52) VALUE SPACE. ST1044.2 +015100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1044.2 +015200 02 ID-AGAIN PIC X(9). ST1044.2 +015300 02 FILLER PIC X(45) VALUE SPACES. ST1044.2 +015400 01 CCVS-E-2. ST1044.2 +015500 02 FILLER PIC X(31) VALUE SPACE. ST1044.2 +015600 02 FILLER PIC X(21) VALUE SPACE. ST1044.2 +015700 02 CCVS-E-2-2. ST1044.2 +015800 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1044.2 +015900 03 FILLER PIC X VALUE SPACE. ST1044.2 +016000 03 ENDER-DESC PIC X(44) VALUE ST1044.2 +016100 "ERRORS ENCOUNTERED". ST1044.2 +016200 01 CCVS-E-3. ST1044.2 +016300 02 FILLER PIC X(22) VALUE ST1044.2 +016400 " FOR OFFICIAL USE ONLY". ST1044.2 +016500 02 FILLER PIC X(12) VALUE SPACE. ST1044.2 +016600 02 FILLER PIC X(58) VALUE ST1044.2 +016700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1044.2 +016800 02 FILLER PIC X(13) VALUE SPACE. ST1044.2 +016900 02 FILLER PIC X(15) VALUE ST1044.2 +017000 " COPYRIGHT 1985". ST1044.2 +017100 01 CCVS-E-4. ST1044.2 +017200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1044.2 +017300 02 FILLER PIC X(4) VALUE " OF ". ST1044.2 +017400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1044.2 +017500 02 FILLER PIC X(40) VALUE ST1044.2 +017600 " TESTS WERE EXECUTED SUCCESSFULLY". ST1044.2 +017700 01 XXINFO. ST1044.2 +017800 02 FILLER PIC X(19) VALUE ST1044.2 +017900 "*** INFORMATION ***". ST1044.2 +018000 02 INFO-TEXT. ST1044.2 +018100 04 FILLER PIC X(8) VALUE SPACE. ST1044.2 +018200 04 XXCOMPUTED PIC X(20). ST1044.2 +018300 04 FILLER PIC X(5) VALUE SPACE. ST1044.2 +018400 04 XXCORRECT PIC X(20). ST1044.2 +018500 02 INF-ANSI-REFERENCE PIC X(48). ST1044.2 +018600 01 HYPHEN-LINE. ST1044.2 +018700 02 FILLER PIC IS X VALUE IS SPACE. ST1044.2 +018800 02 FILLER PIC IS X(65) VALUE IS "************************ST1044.2 +018900- "*****************************************". ST1044.2 +019000 02 FILLER PIC IS X(54) VALUE IS "************************ST1044.2 +019100- "******************************". ST1044.2 +019200 01 CCVS-PGM-ID PIC X(9) VALUE ST1044.2 +019300 "ST104A". ST1044.2 +019400 PROCEDURE DIVISION. ST1044.2 +019500 CCVS1 SECTION. ST1044.2 +019600 OPEN-FILES. ST1044.2 +019700 OPEN OUTPUT PRINT-FILE. ST1044.2 +019800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1044.2 +019900 MOVE SPACE TO TEST-RESULTS. ST1044.2 +020000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1044.2 +020100 GO TO CCVS1-EXIT. ST1044.2 +020200 CLOSE-FILES. ST1044.2 +020300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1044.2 +020400 TERMINATE-CCVS. ST1044.2 +020500*S EXIT PROGRAM. ST1044.2 +020600*SERMINATE-CALL. ST1044.2 +020700 STOP RUN. ST1044.2 +020800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1044.2 +020900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1044.2 +021000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1044.2 +021100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1044.2 +021200 MOVE "****TEST DELETED****" TO RE-MARK. ST1044.2 +021300 PRINT-DETAIL. ST1044.2 +021400 IF REC-CT NOT EQUAL TO ZERO ST1044.2 +021500 MOVE "." TO PARDOT-X ST1044.2 +021600 MOVE REC-CT TO DOTVALUE. ST1044.2 +021700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1044.2 +021800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1044.2 +021900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1044.2 +022000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1044.2 +022100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1044.2 +022200 MOVE SPACE TO CORRECT-X. ST1044.2 +022300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1044.2 +022400 MOVE SPACE TO RE-MARK. ST1044.2 +022500 HEAD-ROUTINE. ST1044.2 +022600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +022700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +022800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1044.2 +022900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1044.2 +023000 COLUMN-NAMES-ROUTINE. ST1044.2 +023100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +023200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +023400 END-ROUTINE. ST1044.2 +023500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1044.2 +023600 END-RTN-EXIT. ST1044.2 +023700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +023800 END-ROUTINE-1. ST1044.2 +023900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1044.2 +024000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1044.2 +024100 ADD PASS-COUNTER TO ERROR-HOLD. ST1044.2 +024200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1044.2 +024300 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1044.2 +024400 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1044.2 +024500 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1044.2 +024600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1044.2 +024700 END-ROUTINE-12. ST1044.2 +024800 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1044.2 +024900 IF ERROR-COUNTER IS EQUAL TO ZERO ST1044.2 +025000 MOVE "NO " TO ERROR-TOTAL ST1044.2 +025100 ELSE ST1044.2 +025200 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1044.2 +025300 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1044.2 +025400 PERFORM WRITE-LINE. ST1044.2 +025500 END-ROUTINE-13. ST1044.2 +025600 IF DELETE-COUNTER IS EQUAL TO ZERO ST1044.2 +025700 MOVE "NO " TO ERROR-TOTAL ELSE ST1044.2 +025800 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1044.2 +025900 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1044.2 +026000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +026100 IF INSPECT-COUNTER EQUAL TO ZERO ST1044.2 +026200 MOVE "NO " TO ERROR-TOTAL ST1044.2 +026300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1044.2 +026400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1044.2 +026500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +026600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1044.2 +026700 WRITE-LINE. ST1044.2 +026800 ADD 1 TO RECORD-COUNT. ST1044.2 +026900 IF RECORD-COUNT GREATER 42 ST1044.2 +027000 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1044.2 +027100 MOVE SPACE TO DUMMY-RECORD ST1044.2 +027200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1044.2 +027300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1044.2 +027400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1044.2 +027500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1044.2 +027600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1044.2 +027700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1044.2 +027800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1044.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1044.2 +028000 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1044.2 +028100 MOVE ZERO TO RECORD-COUNT. ST1044.2 +028200 PERFORM WRT-LN. ST1044.2 +028300 WRT-LN. ST1044.2 +028400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1044.2 +028500 MOVE SPACE TO DUMMY-RECORD. ST1044.2 +028600 BLANK-LINE-PRINT. ST1044.2 +028700 PERFORM WRT-LN. ST1044.2 +028800 FAIL-ROUTINE. ST1044.2 +028900 IF COMPUTED-X NOT EQUAL TO SPACE ST1044.2 +029000 GO TO FAIL-ROUTINE-WRITE. ST1044.2 +029100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1044.2 +029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1044.2 +029300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1044.2 +029400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +029500 MOVE SPACES TO INF-ANSI-REFERENCE. ST1044.2 +029600 GO TO FAIL-ROUTINE-EX. ST1044.2 +029700 FAIL-ROUTINE-WRITE. ST1044.2 +029800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1044.2 +029900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1044.2 +030000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1044.2 +030100 MOVE SPACES TO COR-ANSI-REFERENCE. ST1044.2 +030200 FAIL-ROUTINE-EX. EXIT. ST1044.2 +030300 BAIL-OUT. ST1044.2 +030400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1044.2 +030500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1044.2 +030600 BAIL-OUT-WRITE. ST1044.2 +030700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1044.2 +030800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1044.2 +030900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1044.2 +031000 MOVE SPACES TO INF-ANSI-REFERENCE. ST1044.2 +031100 BAIL-OUT-EX. EXIT. ST1044.2 +031200 CCVS1-EXIT. ST1044.2 +031300 EXIT. ST1044.2 +031400 SECT-ST104-0001 SECTION. ST1044.2 +031500 ST104-0001-01. ST1044.2 +031600 OPEN OUTPUT SORTOUT-1D. ST1044.2 +031700 BUILD-FILE. ST1044.2 +031800 MOVE +987654321078 TO NON-KEY-ITEM. ST1044.2 +031900 MOVE U-TILITY TO KEY-ITEM. ST1044.2 +032000 IF U-TILITY GREATER THAN 214.200 ST1044.2 +032100 MOVE 1 TO UTIL-SW. ST1044.2 +032200 WRITE SORTOUT-REC. ST1044.2 +032300 ADD 1 TO WRITE-COUNTER ON SIZE ERROR ST1044.2 +032400 MOVE "SIZE ERROR ENCOUNTERED" TO RE-MARK ST1044.2 +032500 GO TO BUILD-FILE-FAIL. ST1044.2 +032600 IF UTIL-SW EQUAL TO 1 ST1044.2 +032700 SUBTRACT 002.142 FROM U-TILITY ST1044.2 +032800 ELSE ST1044.2 +032900 ADD 002.142 TO U-TILITY. ST1044.2 +033000 IF U-TILITY NOT EQUAL TO ZERO ST1044.2 +033100 GO TO BUILD-FILE. ST1044.2 +033200 MOVE +987654321078 TO NON-KEY-ITEM. ST1044.2 +033300 MOVE U-TILITY TO KEY-ITEM. ST1044.2 +033400 WRITE SORTOUT-REC. ST1044.2 +033500 ADD 1 TO WRITE-COUNTER ON SIZE ERROR ST1044.2 +033600 MOVE "SIZE ERROR FOUND" TO RE-MARK ST1044.2 +033700 GO TO BUILD-FILE-FAIL. ST1044.2 +033800 BUILD-FILE-TEST. ST1044.2 +033900 IF WRITE-COUNTER EQUAL TO 203 ST1044.2 +034000 PERFORM PASS GO TO BUILD-FILE-WRITE. ST1044.2 +034100 BUILD-FILE-FAIL. ST1044.2 +034200 MOVE WRITE-COUNTER TO COMPUTED-N. ST1044.2 +034300 MOVE 203 TO CORRECT-N. ST1044.2 +034400 PERFORM FAIL. ST1044.2 +034500 BUILD-FILE-WRITE. ST1044.2 +034600 MOVE "TAPE BEING BUILT" TO FEATURE. ST1044.2 +034700 MOVE "BUILD-FILE-TEST" TO PAR-NAME. ST1044.2 +034800 PERFORM PRINT-DETAIL. ST1044.2 +034900 CLOSE SORTOUT-1D. ST1044.2 +035000 CCVS-EXIT SECTION. ST1044.2 +035100 CCVS-999999. ST1044.2 +035200 GO TO CLOSE-FILES. ST1044.2 diff --git a/tests/cobol85/ST/ST105A.SUB b/tests/cobol85/ST/ST105A.SUB new file mode 100755 index 00000000..f0c622ea --- /dev/null +++ b/tests/cobol85/ST/ST105A.SUB @@ -0,0 +1,445 @@ +000100 IDENTIFICATION DIVISION. ST1054.2 +000200 PROGRAM-ID. ST1054.2 +000300 ST105A. ST1054.2 +000400**************************************************************** ST1054.2 +000500* * ST1054.2 +000600* VALIDATION FOR:- * ST1054.2 +000700* * ST1054.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1054.2 +000900* * ST1054.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1054.2 +001100* * ST1054.2 +001200**************************************************************** ST1054.2 +001300* * ST1054.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1054.2 +001500* * ST1054.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1054.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1054.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1054.2 +001900* * ST1054.2 +002000**************************************************************** ST1054.2 +002100* THIS PROGRAM TESTS THE SORT WITH USING AND OUTPUT PROCEDURE. ST1054.2 +002200* SORTIN-1E, THE INPUT FILE, WAS CREATED IN ST104 EXPRESSLY FORST1054.2 +002300* USE IN THIS PROGRAM. EACH RECORD PASSED TO SORTOUT-1E, THE ST1054.2 +002400* OUTPUT FILE, IS CHECKED BY THIS PROGRAM. SORTOUT-1E WILL NOT ST1054.2 +002500* BE USED BY ANY FURTHER PROGRAM. ST1054.2 +002600* RECORDS ARE RETURNED USING THE "RETURN INTO" PHRASE. ST1054.2 +002700* SORTIN-1E CONTAINS 203 RECORDS, ARRANGED SO THAT THE KEYS ST1054.2 +002800* START AT 000.000 AND RISE IN INCREMENTS OF 2.142 UNTIL THEY ST1054.2 +002900* REACH 216.342, AND THEN DESCEND TO 000.000 IN THE SAME ST1054.2 +003000* INCREMENTS. ALL RECORDS CONTAIN THE NUMBER +987654321078 ST1054.2 +003100* IN A NON-KEY AREA. ST1054.2 +003200* SORTOUT-1E WILL BE SORTED IN DESCENDING ORDER. ALL RECORDS ST1054.2 +003300* OCCUR IN IDENTICAL PAIRS EXCEPT THE FIRST ONE. ST1054.2 +003400* ST1054.2 +003500* * * * * * * * * * * * * * * * * * * * * *.ST1054.2 +003600 ST1054.2 +003700 ENVIRONMENT DIVISION. ST1054.2 +003800 CONFIGURATION SECTION. ST1054.2 +003900 SOURCE-COMPUTER. ST1054.2 +004000 Linux. ST1054.2 +004100 OBJECT-COMPUTER. ST1054.2 +004200 Linux. ST1054.2 +004300 INPUT-OUTPUT SECTION. ST1054.2 +004400 FILE-CONTROL. ST1054.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1054.2 +004600 "report.log". ST1054.2 +004700 SELECT SORTIN-1E ASSIGN TO ST1054.2 +004800 "XXXXX001". ST1054.2 +004900 SELECT SORTOUT-1E ASSIGN TO ST1054.2 +005000 "XXXXX002". ST1054.2 +005100 SELECT SORTFILE-1E ASSIGN TO ST1054.2 +005200 "XXXXX027". ST1054.2 +005300 DATA DIVISION. ST1054.2 +005400 FILE SECTION. ST1054.2 +005500 FD PRINT-FILE. ST1054.2 +005600 01 PRINT-REC PICTURE X(120). ST1054.2 +005700 01 DUMMY-RECORD PICTURE X(120). ST1054.2 +005800 FD SORTIN-1E ST1054.2 +005900 LABEL RECORDS STANDARD ST1054.2 +006000*C VALUE OF ST1054.2 +006100*C OCLABELID ST1054.2 +006200*C IS ST1054.2 +006300*C "OCDUMMY" ST1054.2 +006400*G SYSIN ST1054.2 +006500 DATA RECORD IS SORTIN-REC. ST1054.2 +006600 01 SORTIN-REC. ST1054.2 +006700 02 FILLER PICTURE X(18). ST1054.2 +006800 FD SORTOUT-1E ST1054.2 +006900 LABEL RECORDS STANDARD ST1054.2 +007000*C VALUE OF ST1054.2 +007100*C OCLABELID ST1054.2 +007200*C IS ST1054.2 +007300*C "OCDUMMY" ST1054.2 +007400*G SYSIN ST1054.2 +007500 DATA RECORD IS SORTOUT-REC. ST1054.2 +007600 01 SORTOUT-REC. ST1054.2 +007700 02 FILLER PICTURE X(18). ST1054.2 +007800 SD SORTFILE-1E ST1054.2 +007900 DATA RECORD IS GRP-RECORD. ST1054.2 +008000 01 GRP-RECORD. ST1054.2 +008100 02 KEY-ITEM PICTURE S999V999. ST1054.2 +008200 02 NON-KEY-ITEM PICTURE S9(12). ST1054.2 +008300 WORKING-STORAGE SECTION. ST1054.2 +008400 77 U-TILITY PICTURE S999V999 VALUE 216.342. ST1054.2 +008500 77 UTIL-SW PICTURE 9 VALUE ZERO. ST1054.2 +008600 77 RECORD-NUMBER PICTURE 999 VALUE 203. ST1054.2 +008700 77 WRITE-COUNTER PICTURE 999 VALUE ZERO. ST1054.2 +008800 01 FEATURE-BUILDER. ST1054.2 +008900 02 NON PICTURE X(4). ST1054.2 +009000 02 FILLER PICTURE X(13) VALUE "KEY-ITEM NO. ". ST1054.2 +009100 02 EDITED-NUMBER PICTURE ZZ9. ST1054.2 +009200 01 TEST-RESULTS. ST1054.2 +009300 02 FILLER PIC X VALUE SPACE. ST1054.2 +009400 02 FEATURE PIC X(20) VALUE SPACE. ST1054.2 +009500 02 FILLER PIC X VALUE SPACE. ST1054.2 +009600 02 P-OR-F PIC X(5) VALUE SPACE. ST1054.2 +009700 02 FILLER PIC X VALUE SPACE. ST1054.2 +009800 02 PAR-NAME. ST1054.2 +009900 03 FILLER PIC X(19) VALUE SPACE. ST1054.2 +010000 03 PARDOT-X PIC X VALUE SPACE. ST1054.2 +010100 03 DOTVALUE PIC 99 VALUE ZERO. ST1054.2 +010200 02 FILLER PIC X(8) VALUE SPACE. ST1054.2 +010300 02 RE-MARK PIC X(61). ST1054.2 +010400 01 TEST-COMPUTED. ST1054.2 +010500 02 FILLER PIC X(30) VALUE SPACE. ST1054.2 +010600 02 FILLER PIC X(17) VALUE ST1054.2 +010700 " COMPUTED=". ST1054.2 +010800 02 COMPUTED-X. ST1054.2 +010900 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1054.2 +011000 03 COMPUTED-N REDEFINES COMPUTED-A ST1054.2 +011100 PIC -9(9).9(9). ST1054.2 +011200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1054.2 +011300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1054.2 +011400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1054.2 +011500 03 CM-18V0 REDEFINES COMPUTED-A. ST1054.2 +011600 04 COMPUTED-18V0 PIC -9(18). ST1054.2 +011700 04 FILLER PIC X. ST1054.2 +011800 03 FILLER PIC X(50) VALUE SPACE. ST1054.2 +011900 01 TEST-CORRECT. ST1054.2 +012000 02 FILLER PIC X(30) VALUE SPACE. ST1054.2 +012100 02 FILLER PIC X(17) VALUE " CORRECT =". ST1054.2 +012200 02 CORRECT-X. ST1054.2 +012300 03 CORRECT-A PIC X(20) VALUE SPACE. ST1054.2 +012400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1054.2 +012500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1054.2 +012600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1054.2 +012700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1054.2 +012800 03 CR-18V0 REDEFINES CORRECT-A. ST1054.2 +012900 04 CORRECT-18V0 PIC -9(18). ST1054.2 +013000 04 FILLER PIC X. ST1054.2 +013100 03 FILLER PIC X(2) VALUE SPACE. ST1054.2 +013200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1054.2 +013300 01 CCVS-C-1. ST1054.2 +013400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1054.2 +013500- "SS PARAGRAPH-NAME ST1054.2 +013600- " REMARKS". ST1054.2 +013700 02 FILLER PIC X(20) VALUE SPACE. ST1054.2 +013800 01 CCVS-C-2. ST1054.2 +013900 02 FILLER PIC X VALUE SPACE. ST1054.2 +014000 02 FILLER PIC X(6) VALUE "TESTED". ST1054.2 +014100 02 FILLER PIC X(15) VALUE SPACE. ST1054.2 +014200 02 FILLER PIC X(4) VALUE "FAIL". ST1054.2 +014300 02 FILLER PIC X(94) VALUE SPACE. ST1054.2 +014400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1054.2 +014500 01 REC-CT PIC 99 VALUE ZERO. ST1054.2 +014600 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1054.2 +014700 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1054.2 +014800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1054.2 +014900 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1054.2 +015000 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1054.2 +015100 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1054.2 +015200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1054.2 +015300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1054.2 +015400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1054.2 +015500 01 CCVS-H-1. ST1054.2 +015600 02 FILLER PIC X(39) VALUE SPACES. ST1054.2 +015700 02 FILLER PIC X(42) VALUE ST1054.2 +015800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1054.2 +015900 02 FILLER PIC X(39) VALUE SPACES. ST1054.2 +016000 01 CCVS-H-2A. ST1054.2 +016100 02 FILLER PIC X(40) VALUE SPACE. ST1054.2 +016200 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1054.2 +016300 02 FILLER PIC XXXX VALUE ST1054.2 +016400 "4.2 ". ST1054.2 +016500 02 FILLER PIC X(28) VALUE ST1054.2 +016600 " COPY - NOT FOR DISTRIBUTION". ST1054.2 +016700 02 FILLER PIC X(41) VALUE SPACE. ST1054.2 +016800 ST1054.2 +016900 01 CCVS-H-2B. ST1054.2 +017000 02 FILLER PIC X(15) VALUE ST1054.2 +017100 "TEST RESULT OF ". ST1054.2 +017200 02 TEST-ID PIC X(9). ST1054.2 +017300 02 FILLER PIC X(4) VALUE ST1054.2 +017400 " IN ". ST1054.2 +017500 02 FILLER PIC X(12) VALUE ST1054.2 +017600 " HIGH ". ST1054.2 +017700 02 FILLER PIC X(22) VALUE ST1054.2 +017800 " LEVEL VALIDATION FOR ". ST1054.2 +017900 02 FILLER PIC X(58) VALUE ST1054.2 +018000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1054.2 +018100 01 CCVS-H-3. ST1054.2 +018200 02 FILLER PIC X(34) VALUE ST1054.2 +018300 " FOR OFFICIAL USE ONLY ". ST1054.2 +018400 02 FILLER PIC X(58) VALUE ST1054.2 +018500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1054.2 +018600 02 FILLER PIC X(28) VALUE ST1054.2 +018700 " COPYRIGHT 1985 ". ST1054.2 +018800 01 CCVS-E-1. ST1054.2 +018900 02 FILLER PIC X(52) VALUE SPACE. ST1054.2 +019000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1054.2 +019100 02 ID-AGAIN PIC X(9). ST1054.2 +019200 02 FILLER PIC X(45) VALUE SPACES. ST1054.2 +019300 01 CCVS-E-2. ST1054.2 +019400 02 FILLER PIC X(31) VALUE SPACE. ST1054.2 +019500 02 FILLER PIC X(21) VALUE SPACE. ST1054.2 +019600 02 CCVS-E-2-2. ST1054.2 +019700 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1054.2 +019800 03 FILLER PIC X VALUE SPACE. ST1054.2 +019900 03 ENDER-DESC PIC X(44) VALUE ST1054.2 +020000 "ERRORS ENCOUNTERED". ST1054.2 +020100 01 CCVS-E-3. ST1054.2 +020200 02 FILLER PIC X(22) VALUE ST1054.2 +020300 " FOR OFFICIAL USE ONLY". ST1054.2 +020400 02 FILLER PIC X(12) VALUE SPACE. ST1054.2 +020500 02 FILLER PIC X(58) VALUE ST1054.2 +020600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1054.2 +020700 02 FILLER PIC X(13) VALUE SPACE. ST1054.2 +020800 02 FILLER PIC X(15) VALUE ST1054.2 +020900 " COPYRIGHT 1985". ST1054.2 +021000 01 CCVS-E-4. ST1054.2 +021100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1054.2 +021200 02 FILLER PIC X(4) VALUE " OF ". ST1054.2 +021300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1054.2 +021400 02 FILLER PIC X(40) VALUE ST1054.2 +021500 " TESTS WERE EXECUTED SUCCESSFULLY". ST1054.2 +021600 01 XXINFO. ST1054.2 +021700 02 FILLER PIC X(19) VALUE ST1054.2 +021800 "*** INFORMATION ***". ST1054.2 +021900 02 INFO-TEXT. ST1054.2 +022000 04 FILLER PIC X(8) VALUE SPACE. ST1054.2 +022100 04 XXCOMPUTED PIC X(20). ST1054.2 +022200 04 FILLER PIC X(5) VALUE SPACE. ST1054.2 +022300 04 XXCORRECT PIC X(20). ST1054.2 +022400 02 INF-ANSI-REFERENCE PIC X(48). ST1054.2 +022500 01 HYPHEN-LINE. ST1054.2 +022600 02 FILLER PIC IS X VALUE IS SPACE. ST1054.2 +022700 02 FILLER PIC IS X(65) VALUE IS "************************ST1054.2 +022800- "*****************************************". ST1054.2 +022900 02 FILLER PIC IS X(54) VALUE IS "************************ST1054.2 +023000- "******************************". ST1054.2 +023100 01 CCVS-PGM-ID PIC X(9) VALUE ST1054.2 +023200 "ST105A". ST1054.2 +023300 PROCEDURE DIVISION. ST1054.2 +023400 SORTPARA SECTION. ST1054.2 +023500 SORT-PARAGRAPH. ST1054.2 +023600 SORT SORTFILE-1E ON ST1054.2 +023700 DESCENDING ST1054.2 +023800 KEY-ITEM ST1054.2 +023900 USING SORTIN-1E ST1054.2 +024000 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. ST1054.2 +024100 STOP RUN. ST1054.2 +024200 OUTPROC SECTION. ST1054.2 +024300 OPEN-FILES. ST1054.2 +024400 OPEN OUTPUT PRINT-FILE. ST1054.2 +024500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1054.2 +024600 MOVE SPACE TO TEST-RESULTS. ST1054.2 +024700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1054.2 +024800 GO TO CCVS1-EXIT. ST1054.2 +024900 CLOSE-FILES. ST1054.2 +025000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1054.2 +025100 TERMINATE-CCVS. ST1054.2 +025200*S EXIT PROGRAM. ST1054.2 +025300*SERMINATE-CALL. ST1054.2 +025400 STOP RUN. ST1054.2 +025500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1054.2 +025600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1054.2 +025700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1054.2 +025800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1054.2 +025900 MOVE "****TEST DELETED****" TO RE-MARK. ST1054.2 +026000 PRINT-DETAIL. ST1054.2 +026100 IF REC-CT NOT EQUAL TO ZERO ST1054.2 +026200 MOVE "." TO PARDOT-X ST1054.2 +026300 MOVE REC-CT TO DOTVALUE. ST1054.2 +026400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1054.2 +026500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1054.2 +026600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1054.2 +026700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1054.2 +026800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1054.2 +026900 MOVE SPACE TO CORRECT-X. ST1054.2 +027000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1054.2 +027100 MOVE SPACE TO RE-MARK. ST1054.2 +027200 HEAD-ROUTINE. ST1054.2 +027300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +027400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +027500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1054.2 +027600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1054.2 +027700 COLUMN-NAMES-ROUTINE. ST1054.2 +027800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +027900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +028000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +028100 END-ROUTINE. ST1054.2 +028200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1054.2 +028300 END-RTN-EXIT. ST1054.2 +028400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +028500 END-ROUTINE-1. ST1054.2 +028600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1054.2 +028700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1054.2 +028800 ADD PASS-COUNTER TO ERROR-HOLD. ST1054.2 +028900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1054.2 +029000 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1054.2 +029100 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1054.2 +029200 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1054.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1054.2 +029400 END-ROUTINE-12. ST1054.2 +029500 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1054.2 +029600 IF ERROR-COUNTER IS EQUAL TO ZERO ST1054.2 +029700 MOVE "NO " TO ERROR-TOTAL ST1054.2 +029800 ELSE ST1054.2 +029900 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1054.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1054.2 +030100 PERFORM WRITE-LINE. ST1054.2 +030200 END-ROUTINE-13. ST1054.2 +030300 IF DELETE-COUNTER IS EQUAL TO ZERO ST1054.2 +030400 MOVE "NO " TO ERROR-TOTAL ELSE ST1054.2 +030500 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1054.2 +030600 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1054.2 +030700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +030800 IF INSPECT-COUNTER EQUAL TO ZERO ST1054.2 +030900 MOVE "NO " TO ERROR-TOTAL ST1054.2 +031000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1054.2 +031100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1054.2 +031200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +031300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1054.2 +031400 WRITE-LINE. ST1054.2 +031500 ADD 1 TO RECORD-COUNT. ST1054.2 +031600 IF RECORD-COUNT GREATER 42 ST1054.2 +031700 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1054.2 +031800 MOVE SPACE TO DUMMY-RECORD ST1054.2 +031900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1054.2 +032000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1054.2 +032100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1054.2 +032200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1054.2 +032300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1054.2 +032400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1054.2 +032500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1054.2 +032600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1054.2 +032700 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1054.2 +032800 MOVE ZERO TO RECORD-COUNT. ST1054.2 +032900 PERFORM WRT-LN. ST1054.2 +033000 WRT-LN. ST1054.2 +033100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1054.2 +033200 MOVE SPACE TO DUMMY-RECORD. ST1054.2 +033300 BLANK-LINE-PRINT. ST1054.2 +033400 PERFORM WRT-LN. ST1054.2 +033500 FAIL-ROUTINE. ST1054.2 +033600 IF COMPUTED-X NOT EQUAL TO SPACE ST1054.2 +033700 GO TO FAIL-ROUTINE-WRITE. ST1054.2 +033800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1054.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1054.2 +034000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1054.2 +034100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +034200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1054.2 +034300 GO TO FAIL-ROUTINE-EX. ST1054.2 +034400 FAIL-ROUTINE-WRITE. ST1054.2 +034500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1054.2 +034600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1054.2 +034700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1054.2 +034800 MOVE SPACES TO COR-ANSI-REFERENCE. ST1054.2 +034900 FAIL-ROUTINE-EX. EXIT. ST1054.2 +035000 BAIL-OUT. ST1054.2 +035100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1054.2 +035200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1054.2 +035300 BAIL-OUT-WRITE. ST1054.2 +035400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1054.2 +035500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1054.2 +035600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1054.2 +035700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1054.2 +035800 BAIL-OUT-EX. EXIT. ST1054.2 +035900 CCVS1-EXIT. ST1054.2 +036000 EXIT. ST1054.2 +036100 ST105-0001-01. ST1054.2 +036200 OPEN OUTPUT SORTOUT-1E. ST1054.2 +036300 MOVE "THIS PROGRAM CHECKS ALL" TO RE-MARK. ST1054.2 +036400 PERFORM PRINT-DETAIL. ST1054.2 +036500 MOVE "203 RECORDS, TWO ITEMS" TO RE-MARK. ST1054.2 +036600 PERFORM PRINT-DETAIL. ST1054.2 +036700 MOVE "PER RECORD." TO RE-MARK. ST1054.2 +036800 PERFORM PRINT-DETAIL. ST1054.2 +036900 MOVE "SORT, USING-OUTPROC" TO FEATURE. ST1054.2 +037000 PERFORM PRINT-DETAIL. ST1054.2 +037100 MOVE "SORT-TEST-1" TO PAR-NAME. ST1054.2 +037200 SORT-TEST-1. ST1054.2 +037300 RETURN SORTFILE-1E INTO SORTOUT-REC ST1054.2 +037400 AT END GO TO OUTPROC-EXIT. ST1054.2 +037500 WRITE SORTOUT-REC. ST1054.2 +037600 IF NON-KEY-ITEM EQUAL TO +987654321078 ST1054.2 +037700 PERFORM PASS-1 ELSE PERFORM FAIL-1. ST1054.2 +037800 IF KEY-ITEM EQUAL TO U-TILITY ST1054.2 +037900 PERFORM PASS-2 ELSE PERFORM FAIL-2. ST1054.2 +038000 SUBTRACT 1 FROM RECORD-NUMBER. ST1054.2 +038100 IF U-TILITY GREATER THAN 214.200 GO TO NEW-PAIR. ST1054.2 +038200 IF UTIL-SW EQUAL TO 1 GO TO NEW-PAIR. ST1054.2 +038300 CONTINUE-PAIR. ST1054.2 +038400 MOVE 1 TO UTIL-SW. ST1054.2 +038500 GO TO SORT-TEST-1. ST1054.2 +038600 NEW-PAIR. ST1054.2 +038700 MOVE 0 TO UTIL-SW. ST1054.2 +038800 SUBTRACT +002.142 FROM U-TILITY. ST1054.2 +038900 GO TO SORT-TEST-1. ST1054.2 +039000 SUP-PORT SECTION. ST1054.2 +039100 PASS-1. ST1054.2 +039200 MOVE "PASS" TO P-OR-F. ST1054.2 +039300 MOVE "NON-" TO NON. ST1054.2 +039400 PERFORM PRINT-FEATURE. ST1054.2 +039500 PERFORM PRINT-DETAIL. ST1054.2 +039600 FAIL-1. ST1054.2 +039700 MOVE "FAIL" TO P-OR-F. ST1054.2 +039800 ADD 1 TO ERROR-COUNTER. ST1054.2 +039900 MOVE "NON-" TO NON. ST1054.2 +040000 MOVE NON-KEY-ITEM TO COMPUTED-18V0. ST1054.2 +040100 MOVE +987654321078 TO CORRECT-18V0. ST1054.2 +040200 PERFORM PRINT-FEATURE. ST1054.2 +040300 PERFORM PRINT-DETAIL. ST1054.2 +040400 PASS-2. ST1054.2 +040500 MOVE SPACE TO NON. ST1054.2 +040600 MOVE "PASS" TO P-OR-F. ST1054.2 +040700 PERFORM PRINT-FEATURE. ST1054.2 +040800 PERFORM PRINT-DETAIL. ST1054.2 +040900 FAIL-2. ST1054.2 +041000 MOVE SPACE TO NON. ST1054.2 +041100 MOVE "FAIL" TO P-OR-F. ST1054.2 +041200 ADD 1 TO ERROR-COUNTER. ST1054.2 +041300 MOVE KEY-ITEM TO COMPUTED-N. ST1054.2 +041400 MOVE U-TILITY TO CORRECT-N. ST1054.2 +041500 PERFORM PRINT-FEATURE. ST1054.2 +041600 PERFORM PRINT-DETAIL. ST1054.2 +041700 PRINT-FEATURE. ST1054.2 +041800 MOVE RECORD-NUMBER TO EDITED-NUMBER. ST1054.2 +041900 MOVE FEATURE-BUILDER TO FEATURE. ST1054.2 +042000 OUTPROC-EXIT SECTION. ST1054.2 +042100 SORT-INIT-A. ST1054.2 +042200 MOVE "LAST SORTED RECORD" TO FEATURE. ST1054.2 +042300 SORT-TEST-2. ST1054.2 +042400 IF U-TILITY EQUAL TO -002.142 ST1054.2 +042500 PERFORM PASS GO TO SORT-WRITE-2. ST1054.2 +042600 SORT-FAIL-2. ST1054.2 +042700 MOVE U-TILITY TO COMPUTED-N. ST1054.2 +042800 MOVE -002.142 TO CORRECT-N. ST1054.2 +042900 PERFORM FAIL. ST1054.2 +043000 SORT-WRITE-2. ST1054.2 +043100 MOVE "SORT-TEST-2" TO PAR-NAME. ST1054.2 +043200 PERFORM PRINT-DETAIL. ST1054.2 +043300 SORT-TEST-3. ST1054.2 +043400 IF UTIL-SW EQUAL TO ZERO ST1054.2 +043500 PERFORM PASS GO TO SORT-WRITE-3. ST1054.2 +043600 SORT-FAIL-3. ST1054.2 +043700 MOVE UTIL-SW TO COMPUTED-N. ST1054.2 +043800 MOVE ZERO TO CORRECT-N. ST1054.2 +043900 MOVE "LAST RECORDS NOT IN PAIRS" TO RE-MARK. ST1054.2 +044000 PERFORM FAIL. ST1054.2 +044100 SORT-WRITE-3. ST1054.2 +044200 MOVE "SORT-TEST-3" TO PAR-NAME. ST1054.2 +044300 PERFORM PRINT-DETAIL. ST1054.2 +044400 CLOSE SORTOUT-1E. ST1054.2 +044500 PERFORM CLOSE-FILES. ST1054.2 diff --git a/tests/cobol85/ST/ST106A.CBL b/tests/cobol85/ST/ST106A.CBL new file mode 100755 index 00000000..124b17a3 --- /dev/null +++ b/tests/cobol85/ST/ST106A.CBL @@ -0,0 +1,400 @@ +000100 IDENTIFICATION DIVISION. ST1064.2 +000200 PROGRAM-ID. ST1064.2 +000300 ST106A. ST1064.2 +000400**************************************************************** ST1064.2 +000500* * ST1064.2 +000600* VALIDATION FOR:- * ST1064.2 +000700* * ST1064.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1064.2 +000900* * ST1064.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1064.2 +001100* * ST1064.2 +001200**************************************************************** ST1064.2 +001300* * ST1064.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1064.2 +001500* * ST1064.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1064.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1064.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1064.2 +001900* * ST1064.2 +002000**************************************************************** ST1064.2 +002100* ) IS RIGHT PARENTHESIS ST1064.2 +002200* ( IS LEFT PARENTHESIS ST1064.2 +002300* " IS QUOTE ST1064.2 +002400* + IS PLUS ST1064.2 +002500* ST1064.2 +002600* THIS PROGRAM BUILDS A FILE OF NINE RECORDS. EACH RECORD HAS ST1064.2 +002700* THREE KEYS, AND THE VALUES OF THE RECORDS ARE SHOWN BELOW- ST1064.2 +002800* S ST1064.2 +002900* O ST1064.2 +003000* R SORT ST1064.2 +003100* T SORT KEY ST1064.2 +003200* K KEY -2 ST1064.2 +003300* E -1 .. ST1064.2 +003400* Y .. . . ST1064.2 +003500* - . . . . ST1064.2 +003600* 3 . . . . ST1064.2 +003700* .. .. . ST1064.2 +003800* 11111112888888888888888888 ST1064.2 +003900* 11111112999999999999999999 ST1064.2 +004000* 11111112999999999999999999 ST1064.2 +004100* 00000001999999999999999999 ST1064.2 +004200* 000000001999999999999999999 ST1064.2 +004300* 000000001999999999999999999 ST1064.2 +004400* 000000001999999999999999999 ST1064.2 +004500* 000000001999999999999999999 ST1064.2 +004600* 000000001999999999999999999 ST1064.2 +004700* THERE IS AN ASSUMED DECIMAL POINT BETWEEN THE FIRST AND ST1064.2 +004800* SECOND COLUMNS OF SORTKEY-1. ST1064.2 +004900* THIS FILE IS BUILT AND SORTED BY THIS PROGRAM AND THE OUTPUT ST1064.2 +005000* IS PASSED ON TO ST107 FOR CHECKING. ST1064.2 +005100 ST1064.2 +005200 ENVIRONMENT DIVISION. ST1064.2 +005300 CONFIGURATION SECTION. ST1064.2 +005400 SOURCE-COMPUTER. ST1064.2 +005500 Linux. ST1064.2 +005600 OBJECT-COMPUTER. ST1064.2 +005700 Linux. ST1064.2 +005800 INPUT-OUTPUT SECTION. ST1064.2 +005900 FILE-CONTROL. ST1064.2 +006000 SELECT PRINT-FILE ASSIGN TO ST1064.2 +006100 "report.log". ST1064.2 +006200 SELECT SORTFILE-1F ASSIGN TO ST1064.2 +006300 "XXXXX027". ST1064.2 +006400 SELECT SORTOUT-1F ASSIGN TO ST1064.2 +006500 "XXXXX001". ST1064.2 +006600 DATA DIVISION. ST1064.2 +006700 FILE SECTION. ST1064.2 +006800 FD PRINT-FILE. ST1064.2 +006900 01 PRINT-REC PICTURE X(120). ST1064.2 +007000 01 DUMMY-RECORD PICTURE X(120). ST1064.2 +007100 FD SORTOUT-1F ST1064.2 +007200 LABEL RECORDS STANDARD ST1064.2 +007300*C VALUE OF ST1064.2 +007400*C OCLABELID ST1064.2 +007500*C IS ST1064.2 +007600*C "OCDUMMY" ST1064.2 +007700*G SYSIN ST1064.2 +007800 RECORD CONTAINS 27 CHARACTERS ST1064.2 +007900 DATA RECORD IS SORTOUT-REC. ST1064.2 +008000 01 SORTOUT-REC. ST1064.2 +008100 02 FILLER PICTURE X(27). ST1064.2 +008200 SD SORTFILE-1F ST1064.2 +008300 RECORD CONTAINS 27 CHARACTERS ST1064.2 +008400 DATA RECORD IS SORT-GROUP. ST1064.2 +008500 01 SORT-GROUP. ST1064.2 +008600 02 SORTKEY-3 PICTURE X. ST1064.2 +008700 02 SORTKEY-1 PICTURE S9V9(7). ST1064.2 +008800 02 SORTKEY-2 PICTURE 9(18). ST1064.2 +008900 WORKING-STORAGE SECTION. ST1064.2 +009000 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1064.2 +009100 77 UTILITY-1 PICTURE S9V9(7) VALUE +1.1111112. ST1064.2 +009200 77 UTILITY-2 PICTURE 9(018) VALUE 888888888888888888. ST1064.2 +009300 77 UTILITY-3 PICTURE X VALUE SPACE. ST1064.2 +009400 01 TEST-RESULTS. ST1064.2 +009500 02 FILLER PIC X VALUE SPACE. ST1064.2 +009600 02 FEATURE PIC X(20) VALUE SPACE. ST1064.2 +009700 02 FILLER PIC X VALUE SPACE. ST1064.2 +009800 02 P-OR-F PIC X(5) VALUE SPACE. ST1064.2 +009900 02 FILLER PIC X VALUE SPACE. ST1064.2 +010000 02 PAR-NAME. ST1064.2 +010100 03 FILLER PIC X(19) VALUE SPACE. ST1064.2 +010200 03 PARDOT-X PIC X VALUE SPACE. ST1064.2 +010300 03 DOTVALUE PIC 99 VALUE ZERO. ST1064.2 +010400 02 FILLER PIC X(8) VALUE SPACE. ST1064.2 +010500 02 RE-MARK PIC X(61). ST1064.2 +010600 01 TEST-COMPUTED. ST1064.2 +010700 02 FILLER PIC X(30) VALUE SPACE. ST1064.2 +010800 02 FILLER PIC X(17) VALUE ST1064.2 +010900 " COMPUTED=". ST1064.2 +011000 02 COMPUTED-X. ST1064.2 +011100 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1064.2 +011200 03 COMPUTED-N REDEFINES COMPUTED-A ST1064.2 +011300 PIC -9(9).9(9). ST1064.2 +011400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1064.2 +011500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1064.2 +011600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1064.2 +011700 03 CM-18V0 REDEFINES COMPUTED-A. ST1064.2 +011800 04 COMPUTED-18V0 PIC -9(18). ST1064.2 +011900 04 FILLER PIC X. ST1064.2 +012000 03 FILLER PIC X(50) VALUE SPACE. ST1064.2 +012100 01 TEST-CORRECT. ST1064.2 +012200 02 FILLER PIC X(30) VALUE SPACE. ST1064.2 +012300 02 FILLER PIC X(17) VALUE " CORRECT =". ST1064.2 +012400 02 CORRECT-X. ST1064.2 +012500 03 CORRECT-A PIC X(20) VALUE SPACE. ST1064.2 +012600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1064.2 +012700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1064.2 +012800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1064.2 +012900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1064.2 +013000 03 CR-18V0 REDEFINES CORRECT-A. ST1064.2 +013100 04 CORRECT-18V0 PIC -9(18). ST1064.2 +013200 04 FILLER PIC X. ST1064.2 +013300 03 FILLER PIC X(2) VALUE SPACE. ST1064.2 +013400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1064.2 +013500 01 CCVS-C-1. ST1064.2 +013600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1064.2 +013700- "SS PARAGRAPH-NAME ST1064.2 +013800- " REMARKS". ST1064.2 +013900 02 FILLER PIC X(20) VALUE SPACE. ST1064.2 +014000 01 CCVS-C-2. ST1064.2 +014100 02 FILLER PIC X VALUE SPACE. ST1064.2 +014200 02 FILLER PIC X(6) VALUE "TESTED". ST1064.2 +014300 02 FILLER PIC X(15) VALUE SPACE. ST1064.2 +014400 02 FILLER PIC X(4) VALUE "FAIL". ST1064.2 +014500 02 FILLER PIC X(94) VALUE SPACE. ST1064.2 +014600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1064.2 +014700 01 REC-CT PIC 99 VALUE ZERO. ST1064.2 +014800 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1064.2 +014900 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1064.2 +015000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1064.2 +015100 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1064.2 +015200 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1064.2 +015300 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1064.2 +015400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1064.2 +015500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1064.2 +015600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1064.2 +015700 01 CCVS-H-1. ST1064.2 +015800 02 FILLER PIC X(39) VALUE SPACES. ST1064.2 +015900 02 FILLER PIC X(42) VALUE ST1064.2 +016000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1064.2 +016100 02 FILLER PIC X(39) VALUE SPACES. ST1064.2 +016200 01 CCVS-H-2A. ST1064.2 +016300 02 FILLER PIC X(40) VALUE SPACE. ST1064.2 +016400 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1064.2 +016500 02 FILLER PIC XXXX VALUE ST1064.2 +016600 "4.2 ". ST1064.2 +016700 02 FILLER PIC X(28) VALUE ST1064.2 +016800 " COPY - NOT FOR DISTRIBUTION". ST1064.2 +016900 02 FILLER PIC X(41) VALUE SPACE. ST1064.2 +017000 ST1064.2 +017100 01 CCVS-H-2B. ST1064.2 +017200 02 FILLER PIC X(15) VALUE ST1064.2 +017300 "TEST RESULT OF ". ST1064.2 +017400 02 TEST-ID PIC X(9). ST1064.2 +017500 02 FILLER PIC X(4) VALUE ST1064.2 +017600 " IN ". ST1064.2 +017700 02 FILLER PIC X(12) VALUE ST1064.2 +017800 " HIGH ". ST1064.2 +017900 02 FILLER PIC X(22) VALUE ST1064.2 +018000 " LEVEL VALIDATION FOR ". ST1064.2 +018100 02 FILLER PIC X(58) VALUE ST1064.2 +018200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1064.2 +018300 01 CCVS-H-3. ST1064.2 +018400 02 FILLER PIC X(34) VALUE ST1064.2 +018500 " FOR OFFICIAL USE ONLY ". ST1064.2 +018600 02 FILLER PIC X(58) VALUE ST1064.2 +018700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1064.2 +018800 02 FILLER PIC X(28) VALUE ST1064.2 +018900 " COPYRIGHT 1985 ". ST1064.2 +019000 01 CCVS-E-1. ST1064.2 +019100 02 FILLER PIC X(52) VALUE SPACE. ST1064.2 +019200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1064.2 +019300 02 ID-AGAIN PIC X(9). ST1064.2 +019400 02 FILLER PIC X(45) VALUE SPACES. ST1064.2 +019500 01 CCVS-E-2. ST1064.2 +019600 02 FILLER PIC X(31) VALUE SPACE. ST1064.2 +019700 02 FILLER PIC X(21) VALUE SPACE. ST1064.2 +019800 02 CCVS-E-2-2. ST1064.2 +019900 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1064.2 +020000 03 FILLER PIC X VALUE SPACE. ST1064.2 +020100 03 ENDER-DESC PIC X(44) VALUE ST1064.2 +020200 "ERRORS ENCOUNTERED". ST1064.2 +020300 01 CCVS-E-3. ST1064.2 +020400 02 FILLER PIC X(22) VALUE ST1064.2 +020500 " FOR OFFICIAL USE ONLY". ST1064.2 +020600 02 FILLER PIC X(12) VALUE SPACE. ST1064.2 +020700 02 FILLER PIC X(58) VALUE ST1064.2 +020800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1064.2 +020900 02 FILLER PIC X(13) VALUE SPACE. ST1064.2 +021000 02 FILLER PIC X(15) VALUE ST1064.2 +021100 " COPYRIGHT 1985". ST1064.2 +021200 01 CCVS-E-4. ST1064.2 +021300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1064.2 +021400 02 FILLER PIC X(4) VALUE " OF ". ST1064.2 +021500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1064.2 +021600 02 FILLER PIC X(40) VALUE ST1064.2 +021700 " TESTS WERE EXECUTED SUCCESSFULLY". ST1064.2 +021800 01 XXINFO. ST1064.2 +021900 02 FILLER PIC X(19) VALUE ST1064.2 +022000 "*** INFORMATION ***". ST1064.2 +022100 02 INFO-TEXT. ST1064.2 +022200 04 FILLER PIC X(8) VALUE SPACE. ST1064.2 +022300 04 XXCOMPUTED PIC X(20). ST1064.2 +022400 04 FILLER PIC X(5) VALUE SPACE. ST1064.2 +022500 04 XXCORRECT PIC X(20). ST1064.2 +022600 02 INF-ANSI-REFERENCE PIC X(48). ST1064.2 +022700 01 HYPHEN-LINE. ST1064.2 +022800 02 FILLER PIC IS X VALUE IS SPACE. ST1064.2 +022900 02 FILLER PIC IS X(65) VALUE IS "************************ST1064.2 +023000- "*****************************************". ST1064.2 +023100 02 FILLER PIC IS X(54) VALUE IS "************************ST1064.2 +023200- "******************************". ST1064.2 +023300 01 CCVS-PGM-ID PIC X(9) VALUE ST1064.2 +023400 "ST106A". ST1064.2 +023500 PROCEDURE DIVISION. ST1064.2 +023600 SORTPARA SECTION. ST1064.2 +023700 SORT-PARAGRAPH. ST1064.2 +023800 SORT SORTFILE-1F ON ST1064.2 +023900 ASCENDING SORTKEY-1 ST1064.2 +024000 DESCENDING SORTKEY-2 ST1064.2 +024100 ASCENDING SORTKEY-3 ST1064.2 +024200 INPUT PROCEDURE INPROC THRU INPROC-EXIT ST1064.2 +024300 GIVING SORTOUT-1F. ST1064.2 +024400 STOP RUN. ST1064.2 +024500 INPROC SECTION. ST1064.2 +024600 OPEN-FILES. ST1064.2 +024700 OPEN OUTPUT PRINT-FILE. ST1064.2 +024800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1064.2 +024900 MOVE SPACE TO TEST-RESULTS. ST1064.2 +025000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1064.2 +025100 GO TO CCVS1-EXIT. ST1064.2 +025200 CLOSE-FILES. ST1064.2 +025300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1064.2 +025400 TERMINATE-CCVS. ST1064.2 +025500*S EXIT PROGRAM. ST1064.2 +025600*SERMINATE-CALL. ST1064.2 +025700 STOP RUN. ST1064.2 +025800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1064.2 +025900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1064.2 +026000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1064.2 +026100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1064.2 +026200 MOVE "****TEST DELETED****" TO RE-MARK. ST1064.2 +026300 PRINT-DETAIL. ST1064.2 +026400 IF REC-CT NOT EQUAL TO ZERO ST1064.2 +026500 MOVE "." TO PARDOT-X ST1064.2 +026600 MOVE REC-CT TO DOTVALUE. ST1064.2 +026700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1064.2 +026800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1064.2 +026900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1064.2 +027000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1064.2 +027100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1064.2 +027200 MOVE SPACE TO CORRECT-X. ST1064.2 +027300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1064.2 +027400 MOVE SPACE TO RE-MARK. ST1064.2 +027500 HEAD-ROUTINE. ST1064.2 +027600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +027700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +027800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1064.2 +027900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1064.2 +028000 COLUMN-NAMES-ROUTINE. ST1064.2 +028100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +028200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +028300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +028400 END-ROUTINE. ST1064.2 +028500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1064.2 +028600 END-RTN-EXIT. ST1064.2 +028700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +028800 END-ROUTINE-1. ST1064.2 +028900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1064.2 +029000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1064.2 +029100 ADD PASS-COUNTER TO ERROR-HOLD. ST1064.2 +029200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1064.2 +029300 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1064.2 +029400 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1064.2 +029500 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1064.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1064.2 +029700 END-ROUTINE-12. ST1064.2 +029800 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1064.2 +029900 IF ERROR-COUNTER IS EQUAL TO ZERO ST1064.2 +030000 MOVE "NO " TO ERROR-TOTAL ST1064.2 +030100 ELSE ST1064.2 +030200 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1064.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1064.2 +030400 PERFORM WRITE-LINE. ST1064.2 +030500 END-ROUTINE-13. ST1064.2 +030600 IF DELETE-COUNTER IS EQUAL TO ZERO ST1064.2 +030700 MOVE "NO " TO ERROR-TOTAL ELSE ST1064.2 +030800 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1064.2 +030900 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1064.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +031100 IF INSPECT-COUNTER EQUAL TO ZERO ST1064.2 +031200 MOVE "NO " TO ERROR-TOTAL ST1064.2 +031300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1064.2 +031400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1064.2 +031500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +031600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1064.2 +031700 WRITE-LINE. ST1064.2 +031800 ADD 1 TO RECORD-COUNT. ST1064.2 +031900 IF RECORD-COUNT GREATER 42 ST1064.2 +032000 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1064.2 +032100 MOVE SPACE TO DUMMY-RECORD ST1064.2 +032200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1064.2 +032300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1064.2 +032400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1064.2 +032500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1064.2 +032600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1064.2 +032700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1064.2 +032800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1064.2 +032900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1064.2 +033000 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1064.2 +033100 MOVE ZERO TO RECORD-COUNT. ST1064.2 +033200 PERFORM WRT-LN. ST1064.2 +033300 WRT-LN. ST1064.2 +033400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1064.2 +033500 MOVE SPACE TO DUMMY-RECORD. ST1064.2 +033600 BLANK-LINE-PRINT. ST1064.2 +033700 PERFORM WRT-LN. ST1064.2 +033800 FAIL-ROUTINE. ST1064.2 +033900 IF COMPUTED-X NOT EQUAL TO SPACE ST1064.2 +034000 GO TO FAIL-ROUTINE-WRITE. ST1064.2 +034100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1064.2 +034200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1064.2 +034300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1064.2 +034400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +034500 MOVE SPACES TO INF-ANSI-REFERENCE. ST1064.2 +034600 GO TO FAIL-ROUTINE-EX. ST1064.2 +034700 FAIL-ROUTINE-WRITE. ST1064.2 +034800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1064.2 +034900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1064.2 +035000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1064.2 +035100 MOVE SPACES TO COR-ANSI-REFERENCE. ST1064.2 +035200 FAIL-ROUTINE-EX. EXIT. ST1064.2 +035300 BAIL-OUT. ST1064.2 +035400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1064.2 +035500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1064.2 +035600 BAIL-OUT-WRITE. ST1064.2 +035700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1064.2 +035800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1064.2 +035900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1064.2 +036000 MOVE SPACES TO INF-ANSI-REFERENCE. ST1064.2 +036100 BAIL-OUT-EX. EXIT. ST1064.2 +036200 CCVS1-EXIT. ST1064.2 +036300 EXIT. ST1064.2 +036400 ST106-0001-01. ST1064.2 +036500 OPEN OUTPUT SORTOUT-1F. ST1064.2 +036600 MOVE "THIS PROGRAM BUILDS AND" TO RE-MARK. ST1064.2 +036700 PERFORM PRINT-DETAIL. ST1064.2 +036800 MOVE "SORTS A FILE AND PASSES" TO RE-MARK. ST1064.2 +036900 PERFORM PRINT-DETAIL. ST1064.2 +037000 MOVE "THE OUTPUT TO ST107." TO RE-MARK. ST1064.2 +037100 PERFORM PRINT-DETAIL. ST1064.2 +037200 BUILD-FILE. ST1064.2 +037300 ADD 1 TO UTIL-CTR ST1064.2 +037400 IF UTIL-CTR EQUAL TO 2 ST1064.2 +037500 MOVE 999999999999999999 TO UTILITY-2. ST1064.2 +037600 IF UTIL-CTR EQUAL TO 4 ST1064.2 +037700 ADD -1.1111111 TO UTILITY-1. ST1064.2 +037800 IF UTIL-CTR EQUAL TO 5 ST1064.2 +037900 MOVE ZERO TO UTILITY-3. ST1064.2 +038000 MOVE UTILITY-1 TO SORTKEY-1. ST1064.2 +038100 MOVE UTILITY-3 TO SORTKEY-3. ST1064.2 +038200 MOVE UTILITY-2 TO SORTKEY-2. ST1064.2 +038300 RELEASE SORT-GROUP. ST1064.2 +038400 IF UTIL-CTR LESS THAN 9 GO TO BUILD-FILE. ST1064.2 +038500 BUILD-FILE-TEST. ST1064.2 +038600 IF UTIL-CTR EQUAL TO 9 ST1064.2 +038700 PERFORM PASS GO TO BUILD-FILE-WRITE. ST1064.2 +038800 BUILD-FILE-FAIL. ST1064.2 +038900 MOVE UTIL-CTR TO COMPUTED-N. ST1064.2 +039000 MOVE 9 TO CORRECT-N. ST1064.2 +039100 PERFORM FAIL. ST1064.2 +039200 BUILD-FILE-WRITE. ST1064.2 +039300 MOVE "CREATE A FILE" TO FEATURE. ST1064.2 +039400 MOVE "BUILD-FILE-TEST" TO PAR-NAME. ST1064.2 +039500 PERFORM PRINT-DETAIL. ST1064.2 +039600 CLOSE SORTOUT-1F. ST1064.2 +039700 GO TO INPROC-EXIT. ST1064.2 +039800 INPROC-EXIT SECTION. ST1064.2 +039900 EXITPARA. ST1064.2 +040000 PERFORM CLOSE-FILES. ST1064.2 diff --git a/tests/cobol85/ST/ST107A.SUB b/tests/cobol85/ST/ST107A.SUB new file mode 100755 index 00000000..512e3a96 --- /dev/null +++ b/tests/cobol85/ST/ST107A.SUB @@ -0,0 +1,522 @@ +000100 IDENTIFICATION DIVISION. ST1074.2 +000200 PROGRAM-ID. ST1074.2 +000300 ST107A. ST1074.2 +000400**************************************************************** ST1074.2 +000500* * ST1074.2 +000600* VALIDATION FOR:- * ST1074.2 +000700* * ST1074.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1074.2 +000900* * ST1074.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1074.2 +001100* * ST1074.2 +001200**************************************************************** ST1074.2 +001300* * ST1074.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1074.2 +001500* * ST1074.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1074.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1074.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1074.2 +001900* * ST1074.2 +002000**************************************************************** ST1074.2 +002100 ENVIRONMENT DIVISION. ST1074.2 +002200 CONFIGURATION SECTION. ST1074.2 +002300 SOURCE-COMPUTER. ST1074.2 +002400 Linux. ST1074.2 +002500 OBJECT-COMPUTER. ST1074.2 +002600 Linux. ST1074.2 +002700 INPUT-OUTPUT SECTION. ST1074.2 +002800 FILE-CONTROL. ST1074.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1074.2 +003000 "report.log". ST1074.2 +003100 SELECT SORTIN-1G ASSIGN TO ST1074.2 +003200 "XXXXX001". ST1074.2 +003300 DATA DIVISION. ST1074.2 +003400 FILE SECTION. ST1074.2 +003500 FD PRINT-FILE. ST1074.2 +003600 01 PRINT-REC PICTURE X(120). ST1074.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1074.2 +003800 FD SORTIN-1G ST1074.2 +003900 LABEL RECORDS STANDARD ST1074.2 +004000*C VALUE OF ST1074.2 +004100*C OCLABELID ST1074.2 +004200*C IS ST1074.2 +004300*C "OCDUMMY" ST1074.2 +004400*G SYSIN ST1074.2 +004500 RECORD CONTAINS 27 CHARACTERS. ST1074.2 +004600 01 SORTIN-REC. ST1074.2 +004700 02 SORTKEY-3 PICTURE X. ST1074.2 +004800 02 SORTKEY-1 PICTURE S9V9(7). ST1074.2 +004900 02 SORTKEY-2 PICTURE 9(18). ST1074.2 +005000 WORKING-STORAGE SECTION. ST1074.2 +005100 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1074.2 +005200 77 ITEM-3 PICTURE X(27) VALUE "FIRST OF 3 ITEMS IN RECORD ". ST1074.2 +005300 77 ITEM-1 PICTURE X(27) VALUE " SECOND OF 3 ITEMS ". ST1074.2 +005400 77 ITEM-2 PICTURE X(27) VALUE " THIRD OF 3 ITEMS ". ST1074.2 +005500 77 DUM-MY PICTURE X(27) VALUE "TEST UNNECESSARY - BYPASSED". ST1074.2 +005600 77 ZER-O PICTURE X VALUE "0". ST1074.2 +005700 77 SPAC-E PICTURE X VALUE " ". ST1074.2 +005800 01 UTILITY-KEYS. ST1074.2 +005900 02 UTILITY-3 PICTURE X. ST1074.2 +006000 02 UTILITY-1 PICTURE S9V9(7). ST1074.2 +006100 02 UTILITY-2 PICTURE 9(018). ST1074.2 +006200 01 TEST-RESULTS. ST1074.2 +006300 02 FILLER PIC X VALUE SPACE. ST1074.2 +006400 02 FEATURE PIC X(20) VALUE SPACE. ST1074.2 +006500 02 FILLER PIC X VALUE SPACE. ST1074.2 +006600 02 P-OR-F PIC X(5) VALUE SPACE. ST1074.2 +006700 02 FILLER PIC X VALUE SPACE. ST1074.2 +006800 02 PAR-NAME. ST1074.2 +006900 03 FILLER PIC X(19) VALUE SPACE. ST1074.2 +007000 03 PARDOT-X PIC X VALUE SPACE. ST1074.2 +007100 03 DOTVALUE PIC 99 VALUE ZERO. ST1074.2 +007200 02 FILLER PIC X(8) VALUE SPACE. ST1074.2 +007300 02 RE-MARK PIC X(61). ST1074.2 +007400 01 TEST-COMPUTED. ST1074.2 +007500 02 FILLER PIC X(30) VALUE SPACE. ST1074.2 +007600 02 FILLER PIC X(17) VALUE ST1074.2 +007700 " COMPUTED=". ST1074.2 +007800 02 COMPUTED-X. ST1074.2 +007900 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1074.2 +008000 03 COMPUTED-N REDEFINES COMPUTED-A ST1074.2 +008100 PIC -9(9).9(9). ST1074.2 +008200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1074.2 +008300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1074.2 +008400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1074.2 +008500 03 CM-18V0 REDEFINES COMPUTED-A. ST1074.2 +008600 04 COMPUTED-18V0 PIC -9(18). ST1074.2 +008700 04 FILLER PIC X. ST1074.2 +008800 03 FILLER PIC X(50) VALUE SPACE. ST1074.2 +008900 01 TEST-CORRECT. ST1074.2 +009000 02 FILLER PIC X(30) VALUE SPACE. ST1074.2 +009100 02 FILLER PIC X(17) VALUE " CORRECT =". ST1074.2 +009200 02 CORRECT-X. ST1074.2 +009300 03 CORRECT-A PIC X(20) VALUE SPACE. ST1074.2 +009400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1074.2 +009500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1074.2 +009600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1074.2 +009700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1074.2 +009800 03 CR-18V0 REDEFINES CORRECT-A. ST1074.2 +009900 04 CORRECT-18V0 PIC -9(18). ST1074.2 +010000 04 FILLER PIC X. ST1074.2 +010100 03 FILLER PIC X(2) VALUE SPACE. ST1074.2 +010200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1074.2 +010300 01 CCVS-C-1. ST1074.2 +010400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1074.2 +010500- "SS PARAGRAPH-NAME ST1074.2 +010600- " REMARKS". ST1074.2 +010700 02 FILLER PIC X(20) VALUE SPACE. ST1074.2 +010800 01 CCVS-C-2. ST1074.2 +010900 02 FILLER PIC X VALUE SPACE. ST1074.2 +011000 02 FILLER PIC X(6) VALUE "TESTED". ST1074.2 +011100 02 FILLER PIC X(15) VALUE SPACE. ST1074.2 +011200 02 FILLER PIC X(4) VALUE "FAIL". ST1074.2 +011300 02 FILLER PIC X(94) VALUE SPACE. ST1074.2 +011400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1074.2 +011500 01 REC-CT PIC 99 VALUE ZERO. ST1074.2 +011600 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1074.2 +011700 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1074.2 +011800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1074.2 +011900 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1074.2 +012000 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1074.2 +012100 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1074.2 +012200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1074.2 +012300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1074.2 +012400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1074.2 +012500 01 CCVS-H-1. ST1074.2 +012600 02 FILLER PIC X(39) VALUE SPACES. ST1074.2 +012700 02 FILLER PIC X(42) VALUE ST1074.2 +012800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1074.2 +012900 02 FILLER PIC X(39) VALUE SPACES. ST1074.2 +013000 01 CCVS-H-2A. ST1074.2 +013100 02 FILLER PIC X(40) VALUE SPACE. ST1074.2 +013200 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1074.2 +013300 02 FILLER PIC XXXX VALUE ST1074.2 +013400 "4.2 ". ST1074.2 +013500 02 FILLER PIC X(28) VALUE ST1074.2 +013600 " COPY - NOT FOR DISTRIBUTION". ST1074.2 +013700 02 FILLER PIC X(41) VALUE SPACE. ST1074.2 +013800 ST1074.2 +013900 01 CCVS-H-2B. ST1074.2 +014000 02 FILLER PIC X(15) VALUE ST1074.2 +014100 "TEST RESULT OF ". ST1074.2 +014200 02 TEST-ID PIC X(9). ST1074.2 +014300 02 FILLER PIC X(4) VALUE ST1074.2 +014400 " IN ". ST1074.2 +014500 02 FILLER PIC X(12) VALUE ST1074.2 +014600 " HIGH ". ST1074.2 +014700 02 FILLER PIC X(22) VALUE ST1074.2 +014800 " LEVEL VALIDATION FOR ". ST1074.2 +014900 02 FILLER PIC X(58) VALUE ST1074.2 +015000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1074.2 +015100 01 CCVS-H-3. ST1074.2 +015200 02 FILLER PIC X(34) VALUE ST1074.2 +015300 " FOR OFFICIAL USE ONLY ". ST1074.2 +015400 02 FILLER PIC X(58) VALUE ST1074.2 +015500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1074.2 +015600 02 FILLER PIC X(28) VALUE ST1074.2 +015700 " COPYRIGHT 1985 ". ST1074.2 +015800 01 CCVS-E-1. ST1074.2 +015900 02 FILLER PIC X(52) VALUE SPACE. ST1074.2 +016000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1074.2 +016100 02 ID-AGAIN PIC X(9). ST1074.2 +016200 02 FILLER PIC X(45) VALUE SPACES. ST1074.2 +016300 01 CCVS-E-2. ST1074.2 +016400 02 FILLER PIC X(31) VALUE SPACE. ST1074.2 +016500 02 FILLER PIC X(21) VALUE SPACE. ST1074.2 +016600 02 CCVS-E-2-2. ST1074.2 +016700 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1074.2 +016800 03 FILLER PIC X VALUE SPACE. ST1074.2 +016900 03 ENDER-DESC PIC X(44) VALUE ST1074.2 +017000 "ERRORS ENCOUNTERED". ST1074.2 +017100 01 CCVS-E-3. ST1074.2 +017200 02 FILLER PIC X(22) VALUE ST1074.2 +017300 " FOR OFFICIAL USE ONLY". ST1074.2 +017400 02 FILLER PIC X(12) VALUE SPACE. ST1074.2 +017500 02 FILLER PIC X(58) VALUE ST1074.2 +017600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1074.2 +017700 02 FILLER PIC X(13) VALUE SPACE. ST1074.2 +017800 02 FILLER PIC X(15) VALUE ST1074.2 +017900 " COPYRIGHT 1985". ST1074.2 +018000 01 CCVS-E-4. ST1074.2 +018100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1074.2 +018200 02 FILLER PIC X(4) VALUE " OF ". ST1074.2 +018300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1074.2 +018400 02 FILLER PIC X(40) VALUE ST1074.2 +018500 " TESTS WERE EXECUTED SUCCESSFULLY". ST1074.2 +018600 01 XXINFO. ST1074.2 +018700 02 FILLER PIC X(19) VALUE ST1074.2 +018800 "*** INFORMATION ***". ST1074.2 +018900 02 INFO-TEXT. ST1074.2 +019000 04 FILLER PIC X(8) VALUE SPACE. ST1074.2 +019100 04 XXCOMPUTED PIC X(20). ST1074.2 +019200 04 FILLER PIC X(5) VALUE SPACE. ST1074.2 +019300 04 XXCORRECT PIC X(20). ST1074.2 +019400 02 INF-ANSI-REFERENCE PIC X(48). ST1074.2 +019500 01 HYPHEN-LINE. ST1074.2 +019600 02 FILLER PIC IS X VALUE IS SPACE. ST1074.2 +019700 02 FILLER PIC IS X(65) VALUE IS "************************ST1074.2 +019800- "*****************************************". ST1074.2 +019900 02 FILLER PIC IS X(54) VALUE IS "************************ST1074.2 +020000- "******************************". ST1074.2 +020100 01 CCVS-PGM-ID PIC X(9) VALUE ST1074.2 +020200 "ST107A". ST1074.2 +020300 PROCEDURE DIVISION. ST1074.2 +020400 CCVS1 SECTION. ST1074.2 +020500 OPEN-FILES. ST1074.2 +020600 OPEN OUTPUT PRINT-FILE. ST1074.2 +020700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1074.2 +020800 MOVE SPACE TO TEST-RESULTS. ST1074.2 +020900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1074.2 +021000 GO TO CCVS1-EXIT. ST1074.2 +021100 CLOSE-FILES. ST1074.2 +021200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1074.2 +021300 TERMINATE-CCVS. ST1074.2 +021400*S EXIT PROGRAM. ST1074.2 +021500*SERMINATE-CALL. ST1074.2 +021600 STOP RUN. ST1074.2 +021700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1074.2 +021800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1074.2 +021900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1074.2 +022000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1074.2 +022100 MOVE "****TEST DELETED****" TO RE-MARK. ST1074.2 +022200 PRINT-DETAIL. ST1074.2 +022300 IF REC-CT NOT EQUAL TO ZERO ST1074.2 +022400 MOVE "." TO PARDOT-X ST1074.2 +022500 MOVE REC-CT TO DOTVALUE. ST1074.2 +022600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1074.2 +022700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1074.2 +022800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1074.2 +022900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1074.2 +023000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1074.2 +023100 MOVE SPACE TO CORRECT-X. ST1074.2 +023200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1074.2 +023300 MOVE SPACE TO RE-MARK. ST1074.2 +023400 HEAD-ROUTINE. ST1074.2 +023500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +023600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +023700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1074.2 +023800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1074.2 +023900 COLUMN-NAMES-ROUTINE. ST1074.2 +024000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +024100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +024200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +024300 END-ROUTINE. ST1074.2 +024400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1074.2 +024500 END-RTN-EXIT. ST1074.2 +024600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +024700 END-ROUTINE-1. ST1074.2 +024800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1074.2 +024900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1074.2 +025000 ADD PASS-COUNTER TO ERROR-HOLD. ST1074.2 +025100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1074.2 +025200 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1074.2 +025300 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1074.2 +025400 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1074.2 +025500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1074.2 +025600 END-ROUTINE-12. ST1074.2 +025700 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1074.2 +025800 IF ERROR-COUNTER IS EQUAL TO ZERO ST1074.2 +025900 MOVE "NO " TO ERROR-TOTAL ST1074.2 +026000 ELSE ST1074.2 +026100 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1074.2 +026200 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1074.2 +026300 PERFORM WRITE-LINE. ST1074.2 +026400 END-ROUTINE-13. ST1074.2 +026500 IF DELETE-COUNTER IS EQUAL TO ZERO ST1074.2 +026600 MOVE "NO " TO ERROR-TOTAL ELSE ST1074.2 +026700 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1074.2 +026800 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1074.2 +026900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +027000 IF INSPECT-COUNTER EQUAL TO ZERO ST1074.2 +027100 MOVE "NO " TO ERROR-TOTAL ST1074.2 +027200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1074.2 +027300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1074.2 +027400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +027500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1074.2 +027600 WRITE-LINE. ST1074.2 +027700 ADD 1 TO RECORD-COUNT. ST1074.2 +027800 IF RECORD-COUNT GREATER 42 ST1074.2 +027900 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1074.2 +028000 MOVE SPACE TO DUMMY-RECORD ST1074.2 +028100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1074.2 +028200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1074.2 +028300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1074.2 +028400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1074.2 +028500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1074.2 +028600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1074.2 +028700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1074.2 +028800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1074.2 +028900 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1074.2 +029000 MOVE ZERO TO RECORD-COUNT. ST1074.2 +029100 PERFORM WRT-LN. ST1074.2 +029200 WRT-LN. ST1074.2 +029300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1074.2 +029400 MOVE SPACE TO DUMMY-RECORD. ST1074.2 +029500 BLANK-LINE-PRINT. ST1074.2 +029600 PERFORM WRT-LN. ST1074.2 +029700 FAIL-ROUTINE. ST1074.2 +029800 IF COMPUTED-X NOT EQUAL TO SPACE ST1074.2 +029900 GO TO FAIL-ROUTINE-WRITE. ST1074.2 +030000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1074.2 +030100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1074.2 +030200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1074.2 +030300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +030400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1074.2 +030500 GO TO FAIL-ROUTINE-EX. ST1074.2 +030600 FAIL-ROUTINE-WRITE. ST1074.2 +030700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1074.2 +030800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1074.2 +030900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1074.2 +031000 MOVE SPACES TO COR-ANSI-REFERENCE. ST1074.2 +031100 FAIL-ROUTINE-EX. EXIT. ST1074.2 +031200 BAIL-OUT. ST1074.2 +031300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1074.2 +031400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1074.2 +031500 BAIL-OUT-WRITE. ST1074.2 +031600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1074.2 +031700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1074.2 +031800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1074.2 +031900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1074.2 +032000 BAIL-OUT-EX. EXIT. ST1074.2 +032100 CCVS1-EXIT. ST1074.2 +032200 EXIT. ST1074.2 +032300 ST107-0001-01. ST1074.2 +032400 OPEN INPUT SORTIN-1G. ST1074.2 +032500 MOVE "SORT, MIXED CLASSES" TO FEATURE. ST1074.2 +032600 IF ZER-O IS LESS THAN SPAC-E ST1074.2 +032700 GO TO ZERO-IS-LESS-THAN-SPACE. ST1074.2 +032800 SPACE-IS-LESS-THAN-ZERO SECTION. ST1074.2 +032900 SORT-INIT-A. ST1074.2 +033000 MOVE +0.0000001 TO UTILITY-1. ST1074.2 +033100 MOVE 999999999999999999 TO UTILITY-2. ST1074.2 +033200 MOVE SPACE TO UTILITY-3. ST1074.2 +033300 SORT-TEST-1. ST1074.2 +033400 PERFORM READ-SORTIN. ST1074.2 +033500 MOVE "SORT-TEST-1" TO PAR-NAME. ST1074.2 +033600 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +033700 PERFORM PASS GO TO SORT-WRITE-1. ST1074.2 +033800 SORT-FAIL-1. ST1074.2 +033900 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +034000 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +034100 MOVE ITEM-3 TO RE-MARK. ST1074.2 +034200 PERFORM PRINT-DETAIL. ST1074.2 +034300 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +034400 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +034500 MOVE ITEM-1 TO RE-MARK. ST1074.2 +034600 PERFORM PRINT-DETAIL. ST1074.2 +034700 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +034800 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +034900 MOVE ITEM-2 TO RE-MARK. ST1074.2 +035000 PERFORM FAIL. ST1074.2 +035100 SORT-WRITE-1. ST1074.2 +035200 PERFORM PRINT-DETAIL. ST1074.2 +035300 SORT-INIT-B. ST1074.2 +035400 MOVE ZERO TO UTILITY-3. ST1074.2 +035500 PERFORM READ-SORTIN 4 TIMES. ST1074.2 +035600* NOTE SORT-TEST-2 CHECKS THE SIXTH RECORD IN THE FILE. ST1074.2 +035700 SORT-TEST-2. ST1074.2 +035800 PERFORM READ-SORTIN. ST1074.2 +035900 MOVE "SORT-TEST-2" TO PAR-NAME. ST1074.2 +036000 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +036100 PERFORM PASS GO TO SORT-WRITE-2. ST1074.2 +036200 SORT-FAIL-2. ST1074.2 +036300 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +036400 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +036500 MOVE ITEM-3 TO RE-MARK. ST1074.2 +036600 PERFORM PRINT-DETAIL. ST1074.2 +036700 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +036800 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +036900 MOVE ITEM-1 TO RE-MARK. ST1074.2 +037000 PERFORM PRINT-DETAIL. ST1074.2 +037100 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +037200 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +037300 MOVE ITEM-2 TO RE-MARK. ST1074.2 +037400 PERFORM FAIL. ST1074.2 +037500 SORT-WRITE-2. ST1074.2 +037600 PERFORM PRINT-DETAIL. ST1074.2 +037700 DUMMY-3-AND-4. ST1074.2 +037800 MOVE "SORT-TEST-3" TO PAR-NAME. ST1074.2 +037900 MOVE DUM-MY TO RE-MARK. ST1074.2 +038000 PERFORM PRINT-DETAIL. ST1074.2 +038100 MOVE "SORT-TEST-4" TO PAR-NAME. ST1074.2 +038200 MOVE DUM-MY TO RE-MARK. ST1074.2 +038300 PERFORM PRINT-DETAIL. ST1074.2 +038400 GO TO CONTINUE-TESTING. ST1074.2 +038500 ZERO-IS-LESS-THAN-SPACE SECTION. ST1074.2 +038600 SORT-INIT-C. ST1074.2 +038700 MOVE +0.0000001 TO UTILITY-1. ST1074.2 +038800 MOVE 999999999999999999 TO UTILITY-2. ST1074.2 +038900 MOVE ZERO TO UTILITY-3. ST1074.2 +039000 DUMMY-1-AND-2. ST1074.2 +039100 MOVE "SORT-TEST-1" TO PAR-NAME. ST1074.2 +039200 MOVE DUM-MY TO RE-MARK. ST1074.2 +039300 PERFORM PRINT-DETAIL. ST1074.2 +039400 MOVE "SORT-TEST-2" TO PAR-NAME. ST1074.2 +039500 MOVE DUM-MY TO RE-MARK. ST1074.2 +039600 PERFORM PRINT-DETAIL. ST1074.2 +039700 SORT-TEST-3. ST1074.2 +039800 PERFORM READ-SORTIN. ST1074.2 +039900 MOVE "SORT-TEST-3" TO PAR-NAME. ST1074.2 +040000 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +040100 PERFORM PASS GO TO SORT-WRITE-3. ST1074.2 +040200 SORT-FAIL-3. ST1074.2 +040300 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +040400 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +040500 MOVE ITEM-3 TO RE-MARK. ST1074.2 +040600 PERFORM PRINT-DETAIL. ST1074.2 +040700 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +040800 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +040900 MOVE ITEM-1 TO RE-MARK. ST1074.2 +041000 PERFORM PRINT-DETAIL. ST1074.2 +041100 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +041200 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +041300 MOVE ITEM-2 TO RE-MARK. ST1074.2 +041400 PERFORM FAIL. ST1074.2 +041500 SORT-WRITE-3. ST1074.2 +041600 PERFORM PRINT-DETAIL. ST1074.2 +041700 SORT-INIT-D. ST1074.2 +041800 PERFORM READ-SORTIN 4 TIMES. ST1074.2 +041900 MOVE SPACE TO UTILITY-3. ST1074.2 +042000* NOTE SORT-TEST-4 CHECKS THE SIXTH RECORD IN THE FILE. ST1074.2 +042100 SORT-TEST-4. ST1074.2 +042200 PERFORM READ-SORTIN. ST1074.2 +042300 MOVE "SORT-TEST-4" TO PAR-NAME. ST1074.2 +042400 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +042500 PERFORM PASS GO TO SORT-WRITE-4. ST1074.2 +042600 SORT-FAIL-4. ST1074.2 +042700 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +042800 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +042900 MOVE ITEM-3 TO RE-MARK. ST1074.2 +043000 PERFORM PRINT-DETAIL. ST1074.2 +043100 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +043200 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +043300 MOVE ITEM-1 TO RE-MARK. ST1074.2 +043400 PERFORM PRINT-DETAIL. ST1074.2 +043500 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +043600 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +043700 MOVE ITEM-2 TO RE-MARK. ST1074.2 +043800 PERFORM FAIL. ST1074.2 +043900 SORT-WRITE-4. ST1074.2 +044000 PERFORM PRINT-DETAIL. ST1074.2 +044100 CONTINUE-TESTING SECTION. ST1074.2 +044200 SORT-INIT-E. ST1074.2 +044300 MOVE +1.1111112 TO UTILITY-1. ST1074.2 +044400 MOVE SPACE TO UTILITY-3. ST1074.2 +044500* NOTE SORT-TEST-5 CHECKS THE SEVENTH RECORD IN THE FILE. ST1074.2 +044600 SORT-TEST-5. ST1074.2 +044700 PERFORM READ-SORTIN. ST1074.2 +044800 MOVE "SORT-TEST-5" TO PAR-NAME. ST1074.2 +044900 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +045000 PERFORM PASS GO TO SORT-WRITE-5. ST1074.2 +045100 SORT-FAIL-5. ST1074.2 +045200 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +045300 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +045400 MOVE ITEM-3 TO RE-MARK. ST1074.2 +045500 PERFORM PRINT-DETAIL. ST1074.2 +045600 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +045700 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +045800 MOVE ITEM-1 TO RE-MARK. ST1074.2 +045900 PERFORM PRINT-DETAIL. ST1074.2 +046000 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +046100 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +046200 MOVE ITEM-2 TO RE-MARK. ST1074.2 +046300 PERFORM FAIL. ST1074.2 +046400 SORT-WRITE-5. ST1074.2 +046500 PERFORM PRINT-DETAIL. ST1074.2 +046600 SORT-INIT-F. ST1074.2 +046700 PERFORM READ-SORTIN. ST1074.2 +046800 MOVE 888888888888888888 TO UTILITY-2. ST1074.2 +046900* NOTE SORT-TEST-6 CHECKS THE NINTH RECORD IN THE FILE. ST1074.2 +047000 SORT-TEST-6. ST1074.2 +047100 PERFORM READ-SORTIN. ST1074.2 +047200 MOVE "SORT-TEST-6" TO PAR-NAME. ST1074.2 +047300 IF SORTIN-REC EQUAL TO UTILITY-KEYS ST1074.2 +047400 PERFORM PASS GO TO SORT-WRITE-6. ST1074.2 +047500 SORT-FAIL-6. ST1074.2 +047600 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +047700 MOVE UTILITY-3 TO CORRECT-A. ST1074.2 +047800 MOVE ITEM-3 TO RE-MARK. ST1074.2 +047900 PERFORM PRINT-DETAIL. ST1074.2 +048000 MOVE SORTKEY-1 TO COMPUTED-4V14. ST1074.2 +048100 MOVE UTILITY-1 TO CORRECT-4V14. ST1074.2 +048200 MOVE ITEM-1 TO RE-MARK. ST1074.2 +048300 PERFORM PRINT-DETAIL. ST1074.2 +048400 MOVE SORTKEY-2 TO COMPUTED-18V0. ST1074.2 +048500 MOVE UTILITY-2 TO CORRECT-18V0. ST1074.2 +048600 MOVE ITEM-2 TO RE-MARK. ST1074.2 +048700 PERFORM FAIL. ST1074.2 +048800 SORT-WRITE-6. ST1074.2 +048900 PERFORM PRINT-DETAIL. ST1074.2 +049000 SORT-TEST-7. ST1074.2 +049100 READ SORTIN-1G AT END ST1074.2 +049200 PERFORM PASS GO TO SORT-WRITE-7. ST1074.2 +049300 SORT-FAIL-7. ST1074.2 +049400 MOVE SORTKEY-3 TO COMPUTED-A. ST1074.2 +049500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1074.2 +049600 PERFORM FAIL. ST1074.2 +049700 SORT-WRITE-7. ST1074.2 +049800 MOVE "SORT-TEST-7" TO PAR-NAME. ST1074.2 +049900 PERFORM PRINT-DETAIL. ST1074.2 +050000 SORT-TEST-8. ST1074.2 +050100 IF UTIL-CTR EQUAL TO 9 ST1074.2 +050200 PERFORM PASS GO TO SORT-WRITE-8. ST1074.2 +050300 SORT-FAIL-8. ST1074.2 +050400 MOVE UTIL-CTR TO COMPUTED-4V14. ST1074.2 +050500 MOVE 9 TO CORRECT-4V14. ST1074.2 +050600 PERFORM FAIL. ST1074.2 +050700 SORT-WRITE-8. ST1074.2 +050800 MOVE "SORT-TEST-8" TO PAR-NAME. ST1074.2 +050900 PERFORM PRINT-DETAIL. ST1074.2 +051000 CLOSE SORTIN-1G. ST1074.2 +051100 GO TO CCVS-EXIT. ST1074.2 +051200 READ-SORTIN. ST1074.2 +051300 READ SORTIN-1G AT END GO TO READ-ERROR. ST1074.2 +051400 ADD 1 TO UTIL-CTR. ST1074.2 +051500 READ-ERROR. ST1074.2 +051600 MOVE "READ-ERROR" TO PAR-NAME. ST1074.2 +051700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1074.2 +051800 PERFORM FAIL. ST1074.2 +051900 PERFORM PRINT-DETAIL. ST1074.2 +052000 CCVS-EXIT SECTION. ST1074.2 +052100 CCVS-999999. ST1074.2 +052200 GO TO CLOSE-FILES. ST1074.2 diff --git a/tests/cobol85/ST/ST108A.CBL b/tests/cobol85/ST/ST108A.CBL new file mode 100755 index 00000000..13585141 --- /dev/null +++ b/tests/cobol85/ST/ST108A.CBL @@ -0,0 +1,619 @@ +000100 IDENTIFICATION DIVISION. ST1084.2 +000200 PROGRAM-ID. ST1084.2 +000300 ST108A. ST1084.2 +000400**************************************************************** ST1084.2 +000500* * ST1084.2 +000600* VALIDATION FOR:- * ST1084.2 +000700* * ST1084.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1084.2 +000900* * ST1084.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1084.2 +001100* * ST1084.2 +001200**************************************************************** ST1084.2 +001300* * ST1084.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1084.2 +001500* * ST1084.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1084.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1084.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1084.2 +001900* * ST1084.2 +002000**************************************************************** ST1084.2 +002100* ST108 IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT ST1084.2 +002200* PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE ST1084.2 +002300* OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE ST1084.2 +002400* REPORT. ST1084.2 +002500* SORT SORT SORT SORT SORT SORT SORT SORT ST1084.2 +002600* KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8ST1084.2 +002700* S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 ST1084.2 +002800* USAGE JUST JUST USAGEST1084.2 +002900* COMP RIGHT RIGHT COMP ST1084.2 +003000* ST1084.2 +003100* +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 ST1084.2 +003200* -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 ST1084.2 +003300* -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 ST1084.2 +003400* -054321 BBB -.1234 X A AAAAAAAA 501 +99 ST1084.2 +003500* -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 ST1084.2 +003600* -054321 BBB -.1234 BBBBBB A Z 501 +99 ST1084.2 +003700* -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 ST1084.2 +003800* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 ST1084.2 +003900* ST1084.2 +004000* THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT ST1084.2 +004100* ASCENDING KEYS IN ONE FILE. ST1084.2 +004200 ST1084.2 +004300 ENVIRONMENT DIVISION. ST1084.2 +004400 CONFIGURATION SECTION. ST1084.2 +004500 SOURCE-COMPUTER. ST1084.2 +004600 Linux. ST1084.2 +004700 OBJECT-COMPUTER. ST1084.2 +004800 Linux. ST1084.2 +004900 INPUT-OUTPUT SECTION. ST1084.2 +005000 FILE-CONTROL. ST1084.2 +005100 SELECT PRINT-FILE ASSIGN TO ST1084.2 +005200 "report.log". ST1084.2 +005300 SELECT SORTFILE-1H ASSIGN TO ST1084.2 +005400 "XXXXX027". ST1084.2 +005500 DATA DIVISION. ST1084.2 +005600 FILE SECTION. ST1084.2 +005700 FD PRINT-FILE. ST1084.2 +005800 01 PRINT-REC PICTURE X(120). ST1084.2 +005900 01 DUMMY-RECORD PICTURE X(120). ST1084.2 +006000 SD SORTFILE-1H ST1084.2 +006100 DATA RECORD IS SORTFILE-REC. ST1084.2 +006200 01 SORTFILE-REC. ST1084.2 +006300 02 SORTKEY-8 PICTURE S99 COMPUTATIONAL. ST1084.2 +006400 02 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. ST1084.2 +006500 02 SORTKEY-7 PICTURE 999. ST1084.2 +006600 02 SORTKEY-3 PICTURE SV9(16). ST1084.2 +006700 02 FILLER PICTURE XX. ST1084.2 +006800 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. ST1084.2 +006900 02 SORTKEY-6 PICTURE X(10). ST1084.2 +007000 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. ST1084.2 +007100 02 SORTKEY-5 PICTURE A(20). ST1084.2 +007200 02 FILLER PICTURE XXX. ST1084.2 +007300 WORKING-STORAGE SECTION. ST1084.2 +007400 77 UTIL-CTR PICTURE S99999. ST1084.2 +007500 77 SPAC-E PICTURE X VALUE " ". ST1084.2 +007600 01 TEST-RESULTS. ST1084.2 +007700 02 FILLER PIC X VALUE SPACE. ST1084.2 +007800 02 FEATURE PIC X(20) VALUE SPACE. ST1084.2 +007900 02 FILLER PIC X VALUE SPACE. ST1084.2 +008000 02 P-OR-F PIC X(5) VALUE SPACE. ST1084.2 +008100 02 FILLER PIC X VALUE SPACE. ST1084.2 +008200 02 PAR-NAME. ST1084.2 +008300 03 FILLER PIC X(19) VALUE SPACE. ST1084.2 +008400 03 PARDOT-X PIC X VALUE SPACE. ST1084.2 +008500 03 DOTVALUE PIC 99 VALUE ZERO. ST1084.2 +008600 02 FILLER PIC X(8) VALUE SPACE. ST1084.2 +008700 02 RE-MARK PIC X(61). ST1084.2 +008800 01 TEST-COMPUTED. ST1084.2 +008900 02 FILLER PIC X(30) VALUE SPACE. ST1084.2 +009000 02 FILLER PIC X(17) VALUE ST1084.2 +009100 " COMPUTED=". ST1084.2 +009200 02 COMPUTED-X. ST1084.2 +009300 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1084.2 +009400 03 COMPUTED-N REDEFINES COMPUTED-A ST1084.2 +009500 PIC -9(9).9(9). ST1084.2 +009600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1084.2 +009700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1084.2 +009800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1084.2 +009900 03 CM-18V0 REDEFINES COMPUTED-A. ST1084.2 +010000 04 COMPUTED-18V0 PIC -9(18). ST1084.2 +010100 04 FILLER PIC X. ST1084.2 +010200 03 FILLER PIC X(50) VALUE SPACE. ST1084.2 +010300 01 TEST-CORRECT. ST1084.2 +010400 02 FILLER PIC X(30) VALUE SPACE. ST1084.2 +010500 02 FILLER PIC X(17) VALUE " CORRECT =". ST1084.2 +010600 02 CORRECT-X. ST1084.2 +010700 03 CORRECT-A PIC X(20) VALUE SPACE. ST1084.2 +010800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1084.2 +010900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1084.2 +011000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1084.2 +011100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1084.2 +011200 03 CR-18V0 REDEFINES CORRECT-A. ST1084.2 +011300 04 CORRECT-18V0 PIC -9(18). ST1084.2 +011400 04 FILLER PIC X. ST1084.2 +011500 03 FILLER PIC X(2) VALUE SPACE. ST1084.2 +011600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1084.2 +011700 01 CCVS-C-1. ST1084.2 +011800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1084.2 +011900- "SS PARAGRAPH-NAME ST1084.2 +012000- " REMARKS". ST1084.2 +012100 02 FILLER PIC X(20) VALUE SPACE. ST1084.2 +012200 01 CCVS-C-2. ST1084.2 +012300 02 FILLER PIC X VALUE SPACE. ST1084.2 +012400 02 FILLER PIC X(6) VALUE "TESTED". ST1084.2 +012500 02 FILLER PIC X(15) VALUE SPACE. ST1084.2 +012600 02 FILLER PIC X(4) VALUE "FAIL". ST1084.2 +012700 02 FILLER PIC X(94) VALUE SPACE. ST1084.2 +012800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1084.2 +012900 01 REC-CT PIC 99 VALUE ZERO. ST1084.2 +013000 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1084.2 +013100 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1084.2 +013200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1084.2 +013300 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1084.2 +013400 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1084.2 +013500 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1084.2 +013600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1084.2 +013700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1084.2 +013800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1084.2 +013900 01 CCVS-H-1. ST1084.2 +014000 02 FILLER PIC X(39) VALUE SPACES. ST1084.2 +014100 02 FILLER PIC X(42) VALUE ST1084.2 +014200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1084.2 +014300 02 FILLER PIC X(39) VALUE SPACES. ST1084.2 +014400 01 CCVS-H-2A. ST1084.2 +014500 02 FILLER PIC X(40) VALUE SPACE. ST1084.2 +014600 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1084.2 +014700 02 FILLER PIC XXXX VALUE ST1084.2 +014800 "4.2 ". ST1084.2 +014900 02 FILLER PIC X(28) VALUE ST1084.2 +015000 " COPY - NOT FOR DISTRIBUTION". ST1084.2 +015100 02 FILLER PIC X(41) VALUE SPACE. ST1084.2 +015200 ST1084.2 +015300 01 CCVS-H-2B. ST1084.2 +015400 02 FILLER PIC X(15) VALUE ST1084.2 +015500 "TEST RESULT OF ". ST1084.2 +015600 02 TEST-ID PIC X(9). ST1084.2 +015700 02 FILLER PIC X(4) VALUE ST1084.2 +015800 " IN ". ST1084.2 +015900 02 FILLER PIC X(12) VALUE ST1084.2 +016000 " HIGH ". ST1084.2 +016100 02 FILLER PIC X(22) VALUE ST1084.2 +016200 " LEVEL VALIDATION FOR ". ST1084.2 +016300 02 FILLER PIC X(58) VALUE ST1084.2 +016400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1084.2 +016500 01 CCVS-H-3. ST1084.2 +016600 02 FILLER PIC X(34) VALUE ST1084.2 +016700 " FOR OFFICIAL USE ONLY ". ST1084.2 +016800 02 FILLER PIC X(58) VALUE ST1084.2 +016900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1084.2 +017000 02 FILLER PIC X(28) VALUE ST1084.2 +017100 " COPYRIGHT 1985 ". ST1084.2 +017200 01 CCVS-E-1. ST1084.2 +017300 02 FILLER PIC X(52) VALUE SPACE. ST1084.2 +017400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1084.2 +017500 02 ID-AGAIN PIC X(9). ST1084.2 +017600 02 FILLER PIC X(45) VALUE SPACES. ST1084.2 +017700 01 CCVS-E-2. ST1084.2 +017800 02 FILLER PIC X(31) VALUE SPACE. ST1084.2 +017900 02 FILLER PIC X(21) VALUE SPACE. ST1084.2 +018000 02 CCVS-E-2-2. ST1084.2 +018100 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1084.2 +018200 03 FILLER PIC X VALUE SPACE. ST1084.2 +018300 03 ENDER-DESC PIC X(44) VALUE ST1084.2 +018400 "ERRORS ENCOUNTERED". ST1084.2 +018500 01 CCVS-E-3. ST1084.2 +018600 02 FILLER PIC X(22) VALUE ST1084.2 +018700 " FOR OFFICIAL USE ONLY". ST1084.2 +018800 02 FILLER PIC X(12) VALUE SPACE. ST1084.2 +018900 02 FILLER PIC X(58) VALUE ST1084.2 +019000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1084.2 +019100 02 FILLER PIC X(13) VALUE SPACE. ST1084.2 +019200 02 FILLER PIC X(15) VALUE ST1084.2 +019300 " COPYRIGHT 1985". ST1084.2 +019400 01 CCVS-E-4. ST1084.2 +019500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1084.2 +019600 02 FILLER PIC X(4) VALUE " OF ". ST1084.2 +019700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1084.2 +019800 02 FILLER PIC X(40) VALUE ST1084.2 +019900 " TESTS WERE EXECUTED SUCCESSFULLY". ST1084.2 +020000 01 XXINFO. ST1084.2 +020100 02 FILLER PIC X(19) VALUE ST1084.2 +020200 "*** INFORMATION ***". ST1084.2 +020300 02 INFO-TEXT. ST1084.2 +020400 04 FILLER PIC X(8) VALUE SPACE. ST1084.2 +020500 04 XXCOMPUTED PIC X(20). ST1084.2 +020600 04 FILLER PIC X(5) VALUE SPACE. ST1084.2 +020700 04 XXCORRECT PIC X(20). ST1084.2 +020800 02 INF-ANSI-REFERENCE PIC X(48). ST1084.2 +020900 01 HYPHEN-LINE. ST1084.2 +021000 02 FILLER PIC IS X VALUE IS SPACE. ST1084.2 +021100 02 FILLER PIC IS X(65) VALUE IS "************************ST1084.2 +021200- "*****************************************". ST1084.2 +021300 02 FILLER PIC IS X(54) VALUE IS "************************ST1084.2 +021400- "******************************". ST1084.2 +021500 01 CCVS-PGM-ID PIC X(9) VALUE ST1084.2 +021600 "ST108A". ST1084.2 +021700 PROCEDURE DIVISION. ST1084.2 +021800 SORT-PARA SECTION. ST1084.2 +021900 SORT-PARAGRAPH. ST1084.2 +022000 SORT SORTFILE-1H ON ST1084.2 +022100 ASCENDING KEY SORTKEY-1 ST1084.2 +022200 ASCENDING SORTKEY-2 ST1084.2 +022300 ASCENDING SORTKEY-3 ST1084.2 +022400 ASCENDING SORTKEY-4 ST1084.2 +022500 ASCENDING SORTKEY-5 ST1084.2 +022600 ASCENDING SORTKEY-6 ST1084.2 +022700 ASCENDING SORTKEY-7 ST1084.2 +022800 ASCENDING SORTKEY-8 ST1084.2 +022900 INPUT PROCEDURE INPROC ST1084.2 +023000 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. ST1084.2 +023100 STOP RUN. ST1084.2 +023200 INPROC SECTION. ST1084.2 +023300 BUILD-FILE. ST1084.2 +023400 PERFORM BUILD-RECORD. ST1084.2 +023500 MOVE +123456 TO SORTKEY-1. ST1084.2 +023600 PERFORM RELEASE-RECORD. ST1084.2 +023700 PERFORM BUILD-RECORD. ST1084.2 +023800 MOVE "X" TO SORTKEY-2. ST1084.2 +023900 PERFORM RELEASE-RECORD. ST1084.2 +024000 PERFORM BUILD-RECORD. ST1084.2 +024100 MOVE +.6 TO SORTKEY-3. ST1084.2 +024200 PERFORM RELEASE-RECORD. ST1084.2 +024300 PERFORM BUILD-RECORD. ST1084.2 +024400 MOVE "X" TO SORTKEY-4. ST1084.2 +024500 PERFORM RELEASE-RECORD. ST1084.2 +024600 PERFORM BUILD-RECORD. ST1084.2 +024700 MOVE "Z" TO SORTKEY-5. ST1084.2 +024800 PERFORM RELEASE-RECORD. ST1084.2 +024900 PERFORM BUILD-RECORD. ST1084.2 +025000 MOVE "Z" TO SORTKEY-6. ST1084.2 +025100 PERFORM RELEASE-RECORD. ST1084.2 +025200 PERFORM BUILD-RECORD. ST1084.2 +025300 MOVE +418 TO SORTKEY-7. ST1084.2 +025400 PERFORM RELEASE-RECORD. ST1084.2 +025500 PERFORM BUILD-RECORD. ST1084.2 +025600 MOVE -14 TO SORTKEY-8. ST1084.2 +025700 PERFORM RELEASE-RECORD. ST1084.2 +025800 GO TO BUILD-EXIT. ST1084.2 +025900 BUILD-RECORD. ST1084.2 +026000 MOVE -054321 TO SORTKEY-1. ST1084.2 +026100 MOVE "BBB" TO SORTKEY-2. ST1084.2 +026200 MOVE -.1234567890123456 TO SORTKEY-3. ST1084.2 +026300 MOVE "BBBBBB" TO SORTKEY-4. ST1084.2 +026400 MOVE "A" TO SORTKEY-5. ST1084.2 +026500 MOVE "AAAAAAAA" TO SORTKEY-6. ST1084.2 +026600 MOVE -501 TO SORTKEY-7. ST1084.2 +026700* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED ST1084.2 +026800* FIELD. ST1084.2 +026900 MOVE +99 TO SORTKEY-8. ST1084.2 +027000 RELEASE-RECORD. ST1084.2 +027100 RELEASE SORTFILE-REC. ST1084.2 +027200 BUILD-EXIT. ST1084.2 +027300 EXIT. ST1084.2 +027400 OUTPROC SECTION. ST1084.2 +027500 OPEN-FILES. ST1084.2 +027600 OPEN OUTPUT PRINT-FILE. ST1084.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1084.2 +027800 MOVE SPACE TO TEST-RESULTS. ST1084.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1084.2 +028000 IF SPAC-E IS LESS THAN "B" ST1084.2 +028100 GO TO SPACE-IS-LESS-THAN-B. ST1084.2 +028200 B-IS-LESS-THAN-SPACE SECTION. ST1084.2 +028300 SORT-INIT-A. ST1084.2 +028400 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1084.2 +028500* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1084.2 +028600* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, ST1084.2 +028700* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, ST1084.2 +028800* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. ST1084.2 +028900 SORT-TEST-1. ST1084.2 +029000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +029100 IF SORTKEY-7 EQUAL TO 418 ST1084.2 +029200 PERFORM PASS GO TO SORT-WRITE-1. ST1084.2 +029300 SORT-FAIL-1. ST1084.2 +029400 PERFORM FAIL. ST1084.2 +029500 MOVE SORTKEY-7 TO COMPUTED-N. ST1084.2 +029600 MOVE 418 TO CORRECT-N. ST1084.2 +029700 SORT-WRITE-1. ST1084.2 +029800 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1084.2 +029900 PERFORM PRINT-DETAIL. ST1084.2 +030000 SORT-TEST-2. ST1084.2 +030100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +030200 IF SORTKEY-8 EQUAL TO -14 ST1084.2 +030300 PERFORM PASS GO TO SORT-WRITE-2. ST1084.2 +030400 SORT-FAIL-2. ST1084.2 +030500 PERFORM FAIL. ST1084.2 +030600 MOVE SORTKEY-8 TO COMPUTED-N. ST1084.2 +030700 MOVE -14 TO CORRECT-N. ST1084.2 +030800 SORT-WRITE-2. ST1084.2 +030900 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1084.2 +031000 PERFORM PRINT-DETAIL. ST1084.2 +031100 SORT-TEST-3. ST1084.2 +031200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +031300 IF SORTKEY-6 EQUAL TO "Z " ST1084.2 +031400 PERFORM PASS GO TO SORT-WRITE-3. ST1084.2 +031500 SORT-FAIL-3. ST1084.2 +031600 PERFORM FAIL. ST1084.2 +031700 MOVE SORTKEY-6 TO COMPUTED-A. ST1084.2 +031800 MOVE "Z " TO CORRECT-A. ST1084.2 +031900 SORT-WRITE-3. ST1084.2 +032000 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1084.2 +032100 PERFORM PRINT-DETAIL. ST1084.2 +032200 SORT-TEST-4. ST1084.2 +032300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +032400 IF SORTKEY-5 EQUAL TO "Z " ST1084.2 +032500 PERFORM PASS GO TO SORT-WRITE-4. ST1084.2 +032600 SORT-FAIL-4. ST1084.2 +032700 PERFORM FAIL. ST1084.2 +032800 MOVE SORTKEY-5 TO COMPUTED-A. ST1084.2 +032900 MOVE "Z " TO CORRECT-A. ST1084.2 +033000 SORT-WRITE-4. ST1084.2 +033100 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1084.2 +033200 PERFORM PRINT-DETAIL. ST1084.2 +033300 SORT-TEST-5. ST1084.2 +033400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +033500 IF SORTKEY-4 EQUAL TO " X" ST1084.2 +033600 PERFORM PASS GO TO SORT-WRITE-5. ST1084.2 +033700 SORT-FAIL-5. ST1084.2 +033800 PERFORM FAIL. ST1084.2 +033900 MOVE SORTKEY-4 TO COMPUTED-A. ST1084.2 +034000 MOVE " X" TO CORRECT-A. ST1084.2 +034100 SORT-WRITE-5. ST1084.2 +034200 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1084.2 +034300 PERFORM PRINT-DETAIL. ST1084.2 +034400 SORT-TEST-6. ST1084.2 +034500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +034600 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1084.2 +034700 PERFORM PASS GO TO SORT-WRITE-6. ST1084.2 +034800 SORT-FAIL-6. ST1084.2 +034900 PERFORM FAIL. ST1084.2 +035000 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1084.2 +035100 MOVE +.6000000000000000 TO CORRECT-0V18. ST1084.2 +035200 SORT-WRITE-6. ST1084.2 +035300 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1084.2 +035400 PERFORM PRINT-DETAIL. ST1084.2 +035500 SORT-TEST-7. ST1084.2 +035600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +035700 IF SORTKEY-2 EQUAL TO " X" ST1084.2 +035800 PERFORM PASS GO TO SORT-WRITE-7. ST1084.2 +035900 SORT-FAIL-7. ST1084.2 +036000 PERFORM FAIL. ST1084.2 +036100 MOVE SORTKEY-2 TO COMPUTED-A. ST1084.2 +036200 MOVE " X" TO CORRECT-A. ST1084.2 +036300 SORT-WRITE-7. ST1084.2 +036400 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1084.2 +036500 PERFORM PRINT-DETAIL. ST1084.2 +036600 SORT-TEST-8. ST1084.2 +036700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +036800 IF SORTKEY-1 EQUAL TO +123456 ST1084.2 +036900 PERFORM PASS GO TO SORT-WRITE-8. ST1084.2 +037000 SORT-FAIL-8. ST1084.2 +037100 PERFORM FAIL. ST1084.2 +037200 MOVE SORTKEY-1 TO COMPUTED-N. ST1084.2 +037300 MOVE +123456 TO CORRECT-N. ST1084.2 +037400 SORT-WRITE-8. ST1084.2 +037500 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1084.2 +037600 PERFORM PRINT-DETAIL. ST1084.2 +037700 SORT-REMARK-A. ST1084.2 +037800 MOVE SPACE TO FEATURE. ST1084.2 +037900 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1084.2 +038000 PERFORM PRINT-DETAIL. ST1084.2 +038100 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. ST1084.2 +038200 PERFORM PRINT-DETAIL. ST1084.2 +038300 MOVE "UNNECESSARY." TO RE-MARK. ST1084.2 +038400 PERFORM PRINT-DETAIL. ST1084.2 +038500 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1084.2 +038600 GO TO CONTINUE-TESTING. ST1084.2 +038700 SPACE-IS-LESS-THAN-B SECTION. ST1084.2 +038800 SORT-REMARK-B. ST1084.2 +038900 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1084.2 +039000 PERFORM PRINT-DETAIL. ST1084.2 +039100 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. ST1084.2 +039200 PERFORM PRINT-DETAIL. ST1084.2 +039300 MOVE "UNNECESSARY." TO RE-MARK. ST1084.2 +039400 PERFORM PRINT-DETAIL. ST1084.2 +039500 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1084.2 +039600* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1084.2 +039700* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, ST1084.2 +039800* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, ST1084.2 +039900* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. ST1084.2 +040000 SORT-TEST-9. ST1084.2 +040100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +040200 IF SORTKEY-2 EQUAL TO " X" ST1084.2 +040300 PERFORM PASS GO TO SORT-WRITE-9. ST1084.2 +040400 SORT-FAIL-9. ST1084.2 +040500 PERFORM FAIL. ST1084.2 +040600 MOVE SORTKEY-2 TO COMPUTED-A. ST1084.2 +040700 MOVE " X" TO CORRECT-A. ST1084.2 +040800 SORT-WRITE-9. ST1084.2 +040900 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1084.2 +041000 PERFORM PRINT-DETAIL. ST1084.2 +041100 SORT-TEST-10. ST1084.2 +041200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +041300 IF SORTKEY-4 EQUAL TO " X" ST1084.2 +041400 PERFORM PASS GO TO SORT-WRITE-10. ST1084.2 +041500 SORT-FAIL-10. ST1084.2 +041600 PERFORM FAIL. ST1084.2 +041700 MOVE SORTKEY-4 TO COMPUTED-A. ST1084.2 +041800 MOVE " X" TO CORRECT-A. ST1084.2 +041900 SORT-WRITE-10. ST1084.2 +042000 MOVE "SORT-TEST-10" TO PAR-NAME. ST1084.2 +042100 PERFORM PRINT-DETAIL. ST1084.2 +042200 SORT-TEST-11. ST1084.2 +042300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +042400 IF SORTKEY-7 EQUAL TO 418 ST1084.2 +042500 PERFORM PASS GO TO SORT-WRITE-11. ST1084.2 +042600 SORT-FAIL-11. ST1084.2 +042700 PERFORM FAIL. ST1084.2 +042800 MOVE SORTKEY-7 TO COMPUTED-N ST1084.2 +042900 MOVE 418 TO CORRECT-N. ST1084.2 +043000 SORT-WRITE-11. ST1084.2 +043100 MOVE "SORT-TEST-11" TO PAR-NAME. ST1084.2 +043200 PERFORM PRINT-DETAIL. ST1084.2 +043300 SORT-TEST-12. ST1084.2 +043400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +043500 IF SORTKEY-8 EQUAL TO -14 ST1084.2 +043600 PERFORM PASS GO TO SORT-WRITE-12. ST1084.2 +043700 SORT-FAIL-12. ST1084.2 +043800 PERFORM FAIL. ST1084.2 +043900 MOVE SORTKEY-8 TO COMPUTED-N. ST1084.2 +044000 MOVE -14 TO CORRECT-N. ST1084.2 +044100 SORT-WRITE-12. ST1084.2 +044200 MOVE "SORT-TEST-12" TO PAR-NAME. ST1084.2 +044300 PERFORM PRINT-DETAIL. ST1084.2 +044400 SORT-TEST-13. ST1084.2 +044500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +044600 IF SORTKEY-6 EQUAL TO "Z " ST1084.2 +044700 PERFORM PASS GO TO SORT-WRITE-13. ST1084.2 +044800 SORT-FAIL-13. ST1084.2 +044900 PERFORM FAIL. ST1084.2 +045000 MOVE SORTKEY-6 TO COMPUTED-A. ST1084.2 +045100 MOVE "Z " TO CORRECT-A. ST1084.2 +045200 SORT-WRITE-13. ST1084.2 +045300 MOVE "SORT-TEST-13" TO PAR-NAME. ST1084.2 +045400 PERFORM PRINT-DETAIL. ST1084.2 +045500 SORT-TEST-14. ST1084.2 +045600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +045700 IF SORTKEY-5 EQUAL TO "Z " ST1084.2 +045800 PERFORM PASS GO TO SORT-WRITE-14. ST1084.2 +045900 SORT-FAIL-14. ST1084.2 +046000 PERFORM FAIL. ST1084.2 +046100 MOVE SORTKEY-5 TO COMPUTED-A. ST1084.2 +046200 MOVE "Z " TO CORRECT-A. ST1084.2 +046300 SORT-WRITE-14. ST1084.2 +046400 MOVE "SORT-TEST-14" TO PAR-NAME. ST1084.2 +046500 PERFORM PRINT-DETAIL. ST1084.2 +046600 SORT-TEST-15. ST1084.2 +046700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +046800 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1084.2 +046900 PERFORM PASS GO TO SORT-WRITE-15. ST1084.2 +047000 SORT-FAIL-15. ST1084.2 +047100 PERFORM FAIL. ST1084.2 +047200 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1084.2 +047300 MOVE +.6000000000000000 TO CORRECT-0V18. ST1084.2 +047400 SORT-WRITE-15. ST1084.2 +047500 MOVE "SORT-TEST-15" TO PAR-NAME. ST1084.2 +047600 PERFORM PRINT-DETAIL. ST1084.2 +047700 SORT-TEST-16. ST1084.2 +047800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1084.2 +047900 IF SORTKEY-1 EQUAL TO +123456 ST1084.2 +048000 PERFORM PASS GO TO SORT-WRITE-16. ST1084.2 +048100 SORT-FAIL-16. ST1084.2 +048200 PERFORM FAIL. ST1084.2 +048300 MOVE SORTKEY-1 TO COMPUTED-N. ST1084.2 +048400 MOVE +123456 TO CORRECT-N. ST1084.2 +048500 SORT-WRITE-16. ST1084.2 +048600 MOVE "SORT-TEST-16" TO PAR-NAME. ST1084.2 +048700 PERFORM PRINT-DETAIL. ST1084.2 +048800 CONTINUE-TESTING SECTION. ST1084.2 +048900 SORT-TEST-17. ST1084.2 +049000 RETURN SORTFILE-1H AT END ST1084.2 +049100 PERFORM PASS GO TO SORT-WRITE-17. ST1084.2 +049200 SORT-FAIL-17. ST1084.2 +049300 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1084.2 +049400 PERFORM FAIL. ST1084.2 +049500 SORT-WRITE-17. ST1084.2 +049600 MOVE "SORT-TEST-17" TO PAR-NAME. ST1084.2 +049700 PERFORM PRINT-DETAIL. ST1084.2 +049800 GO TO OUTPROC-EXIT. ST1084.2 +049900 RETURN-ERROR. ST1084.2 +050000 MOVE "RETURN-ERROR" TO PAR-NAME. ST1084.2 +050100 PERFORM FAIL. ST1084.2 +050200 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1084.2 +050300 PERFORM PRINT-DETAIL. ST1084.2 +050400 GO TO CCVS1-EXIT. ST1084.2 +050500 CLOSE-FILES. ST1084.2 +050600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1084.2 +050700 TERMINATE-CCVS. ST1084.2 +050800*S EXIT PROGRAM. ST1084.2 +050900*SERMINATE-CALL. ST1084.2 +051000 STOP RUN. ST1084.2 +051100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1084.2 +051200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1084.2 +051300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1084.2 +051400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1084.2 +051500 MOVE "****TEST DELETED****" TO RE-MARK. ST1084.2 +051600 PRINT-DETAIL. ST1084.2 +051700 IF REC-CT NOT EQUAL TO ZERO ST1084.2 +051800 MOVE "." TO PARDOT-X ST1084.2 +051900 MOVE REC-CT TO DOTVALUE. ST1084.2 +052000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1084.2 +052100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1084.2 +052200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1084.2 +052300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1084.2 +052400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1084.2 +052500 MOVE SPACE TO CORRECT-X. ST1084.2 +052600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1084.2 +052700 MOVE SPACE TO RE-MARK. ST1084.2 +052800 HEAD-ROUTINE. ST1084.2 +052900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +053000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +053100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1084.2 +053200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1084.2 +053300 COLUMN-NAMES-ROUTINE. ST1084.2 +053400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +053500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +053600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +053700 END-ROUTINE. ST1084.2 +053800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1084.2 +053900 END-RTN-EXIT. ST1084.2 +054000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +054100 END-ROUTINE-1. ST1084.2 +054200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1084.2 +054300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1084.2 +054400 ADD PASS-COUNTER TO ERROR-HOLD. ST1084.2 +054500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1084.2 +054600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1084.2 +054700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1084.2 +054800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1084.2 +054900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1084.2 +055000 END-ROUTINE-12. ST1084.2 +055100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1084.2 +055200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1084.2 +055300 MOVE "NO " TO ERROR-TOTAL ST1084.2 +055400 ELSE ST1084.2 +055500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1084.2 +055600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1084.2 +055700 PERFORM WRITE-LINE. ST1084.2 +055800 END-ROUTINE-13. ST1084.2 +055900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1084.2 +056000 MOVE "NO " TO ERROR-TOTAL ELSE ST1084.2 +056100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1084.2 +056200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1084.2 +056300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +056400 IF INSPECT-COUNTER EQUAL TO ZERO ST1084.2 +056500 MOVE "NO " TO ERROR-TOTAL ST1084.2 +056600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1084.2 +056700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1084.2 +056800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +056900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1084.2 +057000 WRITE-LINE. ST1084.2 +057100 ADD 1 TO RECORD-COUNT. ST1084.2 +057200 IF RECORD-COUNT GREATER 42 ST1084.2 +057300 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1084.2 +057400 MOVE SPACE TO DUMMY-RECORD ST1084.2 +057500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1084.2 +057600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1084.2 +057700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1084.2 +057800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1084.2 +057900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1084.2 +058000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1084.2 +058100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1084.2 +058200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1084.2 +058300 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1084.2 +058400 MOVE ZERO TO RECORD-COUNT. ST1084.2 +058500 PERFORM WRT-LN. ST1084.2 +058600 WRT-LN. ST1084.2 +058700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1084.2 +058800 MOVE SPACE TO DUMMY-RECORD. ST1084.2 +058900 BLANK-LINE-PRINT. ST1084.2 +059000 PERFORM WRT-LN. ST1084.2 +059100 FAIL-ROUTINE. ST1084.2 +059200 IF COMPUTED-X NOT EQUAL TO SPACE ST1084.2 +059300 GO TO FAIL-ROUTINE-WRITE. ST1084.2 +059400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1084.2 +059500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1084.2 +059600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1084.2 +059700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +059800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1084.2 +059900 GO TO FAIL-ROUTINE-EX. ST1084.2 +060000 FAIL-ROUTINE-WRITE. ST1084.2 +060100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1084.2 +060200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1084.2 +060300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1084.2 +060400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1084.2 +060500 FAIL-ROUTINE-EX. EXIT. ST1084.2 +060600 BAIL-OUT. ST1084.2 +060700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1084.2 +060800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1084.2 +060900 BAIL-OUT-WRITE. ST1084.2 +061000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1084.2 +061100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1084.2 +061200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1084.2 +061300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1084.2 +061400 BAIL-OUT-EX. EXIT. ST1084.2 +061500 CCVS1-EXIT. ST1084.2 +061600 EXIT. ST1084.2 +061700 OUTPROC-EXIT SECTION. ST1084.2 +061800 EXIT-ONLY. ST1084.2 +061900 PERFORM CLOSE-FILES. ST1084.2 diff --git a/tests/cobol85/ST/ST109A.CBL b/tests/cobol85/ST/ST109A.CBL new file mode 100755 index 00000000..07a4c491 --- /dev/null +++ b/tests/cobol85/ST/ST109A.CBL @@ -0,0 +1,368 @@ +000100 IDENTIFICATION DIVISION. ST1094.2 +000200 PROGRAM-ID. ST1094.2 +000300 ST109A. ST1094.2 +000400**************************************************************** ST1094.2 +000500* * ST1094.2 +000600* VALIDATION FOR:- * ST1094.2 +000700* * ST1094.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1094.2 +000900* * ST1094.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1094.2 +001100* * ST1094.2 +001200**************************************************************** ST1094.2 +001300* * ST1094.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1094.2 +001500* * ST1094.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1094.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1094.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1094.2 +001900* * ST1094.2 +002000**************************************************************** ST1094.2 +002100* ST109 BUILDS A FILE WHICH IS SORTED IN ST110 AND CHECKED IN ST1094.2 +002200* ST111. THE CREATED FILE CONSISTS OF 40 RECORDS OF VARYING ST1094.2 +002300* LENGTH (50, 75, 100 CHARACTERS). THE THREE RECORDS SHOWN ST1094.2 +002400* BELOW REOCCUR UNTIL 40 IS REACHED. ST1094.2 +002500* NON-KEY KEY-1 KEY-2 FILLER ST1094.2 +002600* X(2) X(10) X(38) ST1094.2 +002700* ST1094.2 +002800* "BB" "LOWEST TWO" "MIDDLE TWO-FIRST" X(25) VALUE ZERO ST1094.2 +002900* "CC" "LOWEST TWO" "MIDDLE TWO-SECOND" X(50) VALUE QUOTE ST1094.2 +003000* "AA" "LOWEST ONE" "MIDDLE ONE-ONLY" (NONE) ST1094.2 +003100* ST1094.2 +003200* * * * * * * * * * * * * * * * * * * * * *.ST1094.2 +003300 ST1094.2 +003400 ENVIRONMENT DIVISION. ST1094.2 +003500 CONFIGURATION SECTION. ST1094.2 +003600 SOURCE-COMPUTER. ST1094.2 +003700 Linux. ST1094.2 +003800 OBJECT-COMPUTER. ST1094.2 +003900 Linux. ST1094.2 +004000 INPUT-OUTPUT SECTION. ST1094.2 +004100 FILE-CONTROL. ST1094.2 +004200 SELECT PRINT-FILE ASSIGN TO ST1094.2 +004300 "report.log". ST1094.2 +004400 SELECT SORTOUT-1I ASSIGN TO ST1094.2 +004500 "XXXXX001". ST1094.2 +004600 DATA DIVISION. ST1094.2 +004700 FILE SECTION. ST1094.2 +004800 FD PRINT-FILE. ST1094.2 +004900 01 PRINT-REC PICTURE X(120). ST1094.2 +005000 01 DUMMY-RECORD PICTURE X(120). ST1094.2 +005100 FD SORTOUT-1I ST1094.2 +005200 LABEL RECORDS STANDARD ST1094.2 +005300*C VALUE OF ST1094.2 +005400*C OCLABELID ST1094.2 +005500*C IS ST1094.2 +005600*C "OCDUMMY" ST1094.2 +005700*G SYSIN ST1094.2 +005800 RECORD CONTAINS 50 TO 100 CHARACTERS ST1094.2 +005900 DATA RECORDS ARE SHORT-RECORD ST1094.2 +006000 MEDIUM-RECORD ST1094.2 +006100 LONG-RECORD. ST1094.2 +006200 01 SHORT-RECORD PICTURE X(50). ST1094.2 +006300 01 MEDIUM-RECORD PICTURE X(75). ST1094.2 +006400 01 LONG-RECORD PICTURE X(100). ST1094.2 +006500 WORKING-STORAGE SECTION. ST1094.2 +006600 77 COMMENT-SENTENCE PICTURE X(116) VALUE " ST109 HAS CREATED A ST1094.2 +006700- "FILE OF 40 VARIABLE-LENGTH-RECORDS. THESE RECORDS WILL BE SOST1094.2 +006800- "RTED IN ST110 AND CHECKED IN ST111.". ST1094.2 +006900 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1094.2 +007000 01 SHORT-WORK. ST1094.2 +007100 02 FILLER PICTURE XX VALUE "AA". ST1094.2 +007200 02 FILLER PICTURE X(10) VALUE "LOWEST ONE". ST1094.2 +007300 02 FILLER PICTURE X(38) VALUE "MIDDLE ONE-ONLY". ST1094.2 +007400 01 MEDIUM-WORK. ST1094.2 +007500 02 FILLER PICTURE XX VALUE "BB". ST1094.2 +007600 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1094.2 +007700 02 FILLER PICTURE X(38) VALUE "MIDDLE TWO-FIRST". ST1094.2 +007800 02 FILLER PICTURE X(25) VALUE ZERO. ST1094.2 +007900 01 LONG-WORK. ST1094.2 +008000 02 FILLER PICTURE XX VALUE "CC". ST1094.2 +008100 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1094.2 +008200 02 FILLER PICTURE X(38) VALUE "MIDDLE TWO-SECOND". ST1094.2 +008300 02 FILLER PICTURE X(50) VALUE QUOTE. ST1094.2 +008400 01 TEST-RESULTS. ST1094.2 +008500 02 FILLER PIC X VALUE SPACE. ST1094.2 +008600 02 FEATURE PIC X(20) VALUE SPACE. ST1094.2 +008700 02 FILLER PIC X VALUE SPACE. ST1094.2 +008800 02 P-OR-F PIC X(5) VALUE SPACE. ST1094.2 +008900 02 FILLER PIC X VALUE SPACE. ST1094.2 +009000 02 PAR-NAME. ST1094.2 +009100 03 FILLER PIC X(19) VALUE SPACE. ST1094.2 +009200 03 PARDOT-X PIC X VALUE SPACE. ST1094.2 +009300 03 DOTVALUE PIC 99 VALUE ZERO. ST1094.2 +009400 02 FILLER PIC X(8) VALUE SPACE. ST1094.2 +009500 02 RE-MARK PIC X(61). ST1094.2 +009600 01 TEST-COMPUTED. ST1094.2 +009700 02 FILLER PIC X(30) VALUE SPACE. ST1094.2 +009800 02 FILLER PIC X(17) VALUE ST1094.2 +009900 " COMPUTED=". ST1094.2 +010000 02 COMPUTED-X. ST1094.2 +010100 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1094.2 +010200 03 COMPUTED-N REDEFINES COMPUTED-A ST1094.2 +010300 PIC -9(9).9(9). ST1094.2 +010400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1094.2 +010500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1094.2 +010600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1094.2 +010700 03 CM-18V0 REDEFINES COMPUTED-A. ST1094.2 +010800 04 COMPUTED-18V0 PIC -9(18). ST1094.2 +010900 04 FILLER PIC X. ST1094.2 +011000 03 FILLER PIC X(50) VALUE SPACE. ST1094.2 +011100 01 TEST-CORRECT. ST1094.2 +011200 02 FILLER PIC X(30) VALUE SPACE. ST1094.2 +011300 02 FILLER PIC X(17) VALUE " CORRECT =". ST1094.2 +011400 02 CORRECT-X. ST1094.2 +011500 03 CORRECT-A PIC X(20) VALUE SPACE. ST1094.2 +011600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1094.2 +011700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1094.2 +011800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1094.2 +011900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1094.2 +012000 03 CR-18V0 REDEFINES CORRECT-A. ST1094.2 +012100 04 CORRECT-18V0 PIC -9(18). ST1094.2 +012200 04 FILLER PIC X. ST1094.2 +012300 03 FILLER PIC X(2) VALUE SPACE. ST1094.2 +012400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1094.2 +012500 01 CCVS-C-1. ST1094.2 +012600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1094.2 +012700- "SS PARAGRAPH-NAME ST1094.2 +012800- " REMARKS". ST1094.2 +012900 02 FILLER PIC X(20) VALUE SPACE. ST1094.2 +013000 01 CCVS-C-2. ST1094.2 +013100 02 FILLER PIC X VALUE SPACE. ST1094.2 +013200 02 FILLER PIC X(6) VALUE "TESTED". ST1094.2 +013300 02 FILLER PIC X(15) VALUE SPACE. ST1094.2 +013400 02 FILLER PIC X(4) VALUE "FAIL". ST1094.2 +013500 02 FILLER PIC X(94) VALUE SPACE. ST1094.2 +013600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1094.2 +013700 01 REC-CT PIC 99 VALUE ZERO. ST1094.2 +013800 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1094.2 +013900 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1094.2 +014000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1094.2 +014100 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1094.2 +014200 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1094.2 +014300 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1094.2 +014400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1094.2 +014500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1094.2 +014600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1094.2 +014700 01 CCVS-H-1. ST1094.2 +014800 02 FILLER PIC X(39) VALUE SPACES. ST1094.2 +014900 02 FILLER PIC X(42) VALUE ST1094.2 +015000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1094.2 +015100 02 FILLER PIC X(39) VALUE SPACES. ST1094.2 +015200 01 CCVS-H-2A. ST1094.2 +015300 02 FILLER PIC X(40) VALUE SPACE. ST1094.2 +015400 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1094.2 +015500 02 FILLER PIC XXXX VALUE ST1094.2 +015600 "4.2 ". ST1094.2 +015700 02 FILLER PIC X(28) VALUE ST1094.2 +015800 " COPY - NOT FOR DISTRIBUTION". ST1094.2 +015900 02 FILLER PIC X(41) VALUE SPACE. ST1094.2 +016000 ST1094.2 +016100 01 CCVS-H-2B. ST1094.2 +016200 02 FILLER PIC X(15) VALUE ST1094.2 +016300 "TEST RESULT OF ". ST1094.2 +016400 02 TEST-ID PIC X(9). ST1094.2 +016500 02 FILLER PIC X(4) VALUE ST1094.2 +016600 " IN ". ST1094.2 +016700 02 FILLER PIC X(12) VALUE ST1094.2 +016800 " HIGH ". ST1094.2 +016900 02 FILLER PIC X(22) VALUE ST1094.2 +017000 " LEVEL VALIDATION FOR ". ST1094.2 +017100 02 FILLER PIC X(58) VALUE ST1094.2 +017200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1094.2 +017300 01 CCVS-H-3. ST1094.2 +017400 02 FILLER PIC X(34) VALUE ST1094.2 +017500 " FOR OFFICIAL USE ONLY ". ST1094.2 +017600 02 FILLER PIC X(58) VALUE ST1094.2 +017700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1094.2 +017800 02 FILLER PIC X(28) VALUE ST1094.2 +017900 " COPYRIGHT 1985 ". ST1094.2 +018000 01 CCVS-E-1. ST1094.2 +018100 02 FILLER PIC X(52) VALUE SPACE. ST1094.2 +018200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1094.2 +018300 02 ID-AGAIN PIC X(9). ST1094.2 +018400 02 FILLER PIC X(45) VALUE SPACES. ST1094.2 +018500 01 CCVS-E-2. ST1094.2 +018600 02 FILLER PIC X(31) VALUE SPACE. ST1094.2 +018700 02 FILLER PIC X(21) VALUE SPACE. ST1094.2 +018800 02 CCVS-E-2-2. ST1094.2 +018900 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1094.2 +019000 03 FILLER PIC X VALUE SPACE. ST1094.2 +019100 03 ENDER-DESC PIC X(44) VALUE ST1094.2 +019200 "ERRORS ENCOUNTERED". ST1094.2 +019300 01 CCVS-E-3. ST1094.2 +019400 02 FILLER PIC X(22) VALUE ST1094.2 +019500 " FOR OFFICIAL USE ONLY". ST1094.2 +019600 02 FILLER PIC X(12) VALUE SPACE. ST1094.2 +019700 02 FILLER PIC X(58) VALUE ST1094.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1094.2 +019900 02 FILLER PIC X(13) VALUE SPACE. ST1094.2 +020000 02 FILLER PIC X(15) VALUE ST1094.2 +020100 " COPYRIGHT 1985". ST1094.2 +020200 01 CCVS-E-4. ST1094.2 +020300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1094.2 +020400 02 FILLER PIC X(4) VALUE " OF ". ST1094.2 +020500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1094.2 +020600 02 FILLER PIC X(40) VALUE ST1094.2 +020700 " TESTS WERE EXECUTED SUCCESSFULLY". ST1094.2 +020800 01 XXINFO. ST1094.2 +020900 02 FILLER PIC X(19) VALUE ST1094.2 +021000 "*** INFORMATION ***". ST1094.2 +021100 02 INFO-TEXT. ST1094.2 +021200 04 FILLER PIC X(8) VALUE SPACE. ST1094.2 +021300 04 XXCOMPUTED PIC X(20). ST1094.2 +021400 04 FILLER PIC X(5) VALUE SPACE. ST1094.2 +021500 04 XXCORRECT PIC X(20). ST1094.2 +021600 02 INF-ANSI-REFERENCE PIC X(48). ST1094.2 +021700 01 HYPHEN-LINE. ST1094.2 +021800 02 FILLER PIC IS X VALUE IS SPACE. ST1094.2 +021900 02 FILLER PIC IS X(65) VALUE IS "************************ST1094.2 +022000- "*****************************************". ST1094.2 +022100 02 FILLER PIC IS X(54) VALUE IS "************************ST1094.2 +022200- "******************************". ST1094.2 +022300 01 CCVS-PGM-ID PIC X(9) VALUE ST1094.2 +022400 "ST109A". ST1094.2 +022500 PROCEDURE DIVISION. ST1094.2 +022600 CCVS1 SECTION. ST1094.2 +022700 OPEN-FILES. ST1094.2 +022800 OPEN OUTPUT PRINT-FILE. ST1094.2 +022900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1094.2 +023000 MOVE SPACE TO TEST-RESULTS. ST1094.2 +023100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1094.2 +023200 GO TO CCVS1-EXIT. ST1094.2 +023300 CLOSE-FILES. ST1094.2 +023400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1094.2 +023500 TERMINATE-CCVS. ST1094.2 +023600*S EXIT PROGRAM. ST1094.2 +023700*SERMINATE-CALL. ST1094.2 +023800 STOP RUN. ST1094.2 +023900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1094.2 +024000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1094.2 +024100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1094.2 +024200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1094.2 +024300 MOVE "****TEST DELETED****" TO RE-MARK. ST1094.2 +024400 PRINT-DETAIL. ST1094.2 +024500 IF REC-CT NOT EQUAL TO ZERO ST1094.2 +024600 MOVE "." TO PARDOT-X ST1094.2 +024700 MOVE REC-CT TO DOTVALUE. ST1094.2 +024800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1094.2 +024900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1094.2 +025000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1094.2 +025100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1094.2 +025200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1094.2 +025300 MOVE SPACE TO CORRECT-X. ST1094.2 +025400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1094.2 +025500 MOVE SPACE TO RE-MARK. ST1094.2 +025600 HEAD-ROUTINE. ST1094.2 +025700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +025800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +025900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1094.2 +026000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1094.2 +026100 COLUMN-NAMES-ROUTINE. ST1094.2 +026200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +026300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +026400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +026500 END-ROUTINE. ST1094.2 +026600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1094.2 +026700 END-RTN-EXIT. ST1094.2 +026800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +026900 END-ROUTINE-1. ST1094.2 +027000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1094.2 +027100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1094.2 +027200 ADD PASS-COUNTER TO ERROR-HOLD. ST1094.2 +027300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1094.2 +027400 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1094.2 +027500 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1094.2 +027600 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1094.2 +027700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1094.2 +027800 END-ROUTINE-12. ST1094.2 +027900 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1094.2 +028000 IF ERROR-COUNTER IS EQUAL TO ZERO ST1094.2 +028100 MOVE "NO " TO ERROR-TOTAL ST1094.2 +028200 ELSE ST1094.2 +028300 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1094.2 +028400 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1094.2 +028500 PERFORM WRITE-LINE. ST1094.2 +028600 END-ROUTINE-13. ST1094.2 +028700 IF DELETE-COUNTER IS EQUAL TO ZERO ST1094.2 +028800 MOVE "NO " TO ERROR-TOTAL ELSE ST1094.2 +028900 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1094.2 +029000 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1094.2 +029100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +029200 IF INSPECT-COUNTER EQUAL TO ZERO ST1094.2 +029300 MOVE "NO " TO ERROR-TOTAL ST1094.2 +029400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1094.2 +029500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1094.2 +029600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +029700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1094.2 +029800 WRITE-LINE. ST1094.2 +029900 ADD 1 TO RECORD-COUNT. ST1094.2 +030000 IF RECORD-COUNT GREATER 42 ST1094.2 +030100 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1094.2 +030200 MOVE SPACE TO DUMMY-RECORD ST1094.2 +030300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1094.2 +030400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1094.2 +030500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1094.2 +030600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1094.2 +030700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1094.2 +030800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1094.2 +030900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1094.2 +031000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1094.2 +031100 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1094.2 +031200 MOVE ZERO TO RECORD-COUNT. ST1094.2 +031300 PERFORM WRT-LN. ST1094.2 +031400 WRT-LN. ST1094.2 +031500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1094.2 +031600 MOVE SPACE TO DUMMY-RECORD. ST1094.2 +031700 BLANK-LINE-PRINT. ST1094.2 +031800 PERFORM WRT-LN. ST1094.2 +031900 FAIL-ROUTINE. ST1094.2 +032000 IF COMPUTED-X NOT EQUAL TO SPACE ST1094.2 +032100 GO TO FAIL-ROUTINE-WRITE. ST1094.2 +032200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1094.2 +032300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1094.2 +032400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1094.2 +032500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +032600 MOVE SPACES TO INF-ANSI-REFERENCE. ST1094.2 +032700 GO TO FAIL-ROUTINE-EX. ST1094.2 +032800 FAIL-ROUTINE-WRITE. ST1094.2 +032900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1094.2 +033000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1094.2 +033100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1094.2 +033200 MOVE SPACES TO COR-ANSI-REFERENCE. ST1094.2 +033300 FAIL-ROUTINE-EX. EXIT. ST1094.2 +033400 BAIL-OUT. ST1094.2 +033500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1094.2 +033600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1094.2 +033700 BAIL-OUT-WRITE. ST1094.2 +033800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1094.2 +033900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1094.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1094.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. ST1094.2 +034200 BAIL-OUT-EX. EXIT. ST1094.2 +034300 CCVS1-EXIT. ST1094.2 +034400 EXIT. ST1094.2 +034500 ST109-0001-01. ST1094.2 +034600 OPEN OUTPUT SORTOUT-1I. ST1094.2 +034700 BUILD-LOOP. ST1094.2 +034800 MOVE MEDIUM-WORK TO MEDIUM-RECORD. ST1094.2 +034900 WRITE MEDIUM-RECORD. ST1094.2 +035000 ADD 1 TO UTIL-CTR. ST1094.2 +035100 IF UTIL-CTR GREATER 39 ST1094.2 +035200 GO TO ST109-0002-01. ST1094.2 +035300 MOVE LONG-WORK TO LONG-RECORD. ST1094.2 +035400 WRITE LONG-RECORD. ST1094.2 +035500 ADD 1 TO UTIL-CTR. ST1094.2 +035600 MOVE SHORT-WORK TO SHORT-RECORD. ST1094.2 +035700 WRITE SHORT-RECORD. ST1094.2 +035800 ADD 1 TO UTIL-CTR. ST1094.2 +035900 GO TO BUILD-LOOP. ST1094.2 +036000 ST109-0002-01. ST1094.2 +036100 MOVE SPACES TO TEST-RESULTS. ST1094.2 +036200 MOVE COMMENT-SENTENCE TO TEST-RESULTS. ST1094.2 +036300 PERFORM PRINT-DETAIL. ST1094.2 +036400 MOVE SPACES TO TEST-RESULTS. ST1094.2 +036500 CLOSE SORTOUT-1I. ST1094.2 +036600 CCVS-EXIT SECTION. ST1094.2 +036700 CCVS-999999. ST1094.2 +036800 GO TO CLOSE-FILES. ST1094.2 diff --git a/tests/cobol85/ST/ST110A.SUB b/tests/cobol85/ST/ST110A.SUB new file mode 100755 index 00000000..aa21f27b --- /dev/null +++ b/tests/cobol85/ST/ST110A.SUB @@ -0,0 +1,105 @@ +000100 IDENTIFICATION DIVISION. ST1104.2 +000200 PROGRAM-ID. ST1104.2 +000300 ST110A. ST1104.2 +000400**************************************************************** ST1104.2 +000500* * ST1104.2 +000600* VALIDATION FOR:- * ST1104.2 +000700* * ST1104.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1104.2 +000900* * ST1104.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1104.2 +001100* * ST1104.2 +001200**************************************************************** ST1104.2 +001300* * ST1104.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1104.2 +001500* * ST1104.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1104.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1104.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1104.2 +001900* * ST1104.2 +002000**************************************************************** ST1104.2 +002100 ENVIRONMENT DIVISION. ST1104.2 +002200 CONFIGURATION SECTION. ST1104.2 +002300 SOURCE-COMPUTER. ST1104.2 +002400 Linux. ST1104.2 +002500 OBJECT-COMPUTER. ST1104.2 +002600 Linux. ST1104.2 +002700 INPUT-OUTPUT SECTION. ST1104.2 +002800 FILE-CONTROL. ST1104.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1104.2 +003000 "report.log". ST1104.2 +003100 SELECT SORTIN-1J ASSIGN TO ST1104.2 +003200 "XXXXX001". ST1104.2 +003300 SELECT SORTOUT-1J ASSIGN TO ST1104.2 +003400 "XXXXX002". ST1104.2 +003500 SELECT SORTFILE-1J ASSIGN TO ST1104.2 +003600 "XXXXX027". ST1104.2 +003700 DATA DIVISION. ST1104.2 +003800 FILE SECTION. ST1104.2 +003900 FD PRINT-FILE. ST1104.2 +004000 01 PRINT-REC PICTURE X(120). ST1104.2 +004100 01 DUMMY-RECORD PICTURE X(120). ST1104.2 +004200 FD SORTIN-1J ST1104.2 +004300 LABEL RECORDS STANDARD ST1104.2 +004400*C VALUE OF ST1104.2 +004500*C OCLABELID ST1104.2 +004600*C IS ST1104.2 +004700*C "OCDUMMY" ST1104.2 +004800*G SYSIN ST1104.2 +004900 RECORD CONTAINS 50 TO 100 CHARACTERS ST1104.2 +005000 DATA RECORDS ARE SHORT-IN ST1104.2 +005100 MEDIUM-IN ST1104.2 +005200 LONG-IN. ST1104.2 +005300 01 SHORT-IN PICTURE X(50). ST1104.2 +005400 01 MEDIUM-IN PICTURE X(75). ST1104.2 +005500 01 LONG-IN. ST1104.2 +005600 02 FALSE-LENGTH-1 PICTURE X(25). ST1104.2 +005700 02 FALSE-LENGTH-2 PICTURE A(20). ST1104.2 +005800 02 FALSE-LENGTH-3 PICTURE 9(15). ST1104.2 +005900 02 FALSE-LENGTH-4 PICTURE X(40). ST1104.2 +006000 FD SORTOUT-1J ST1104.2 +006100 LABEL RECORDS ARE STANDARD ST1104.2 +006200*C VALUE OF ST1104.2 +006300*C OCLABELID ST1104.2 +006400*C IS ST1104.2 +006500*C "OCDUMMY" ST1104.2 +006600*G SYSIN ST1104.2 +006700 RECORD CONTAINS 50 TO 100 CHARACTERS ST1104.2 +006800 DATA RECORD SHORT-OUT ST1104.2 +006900 MEDIUM-OUT ST1104.2 +007000 LONG-OUT. ST1104.2 +007100 01 SHORT-OUT. ST1104.2 +007200 02 FAKE-LENGTH-1 PICTURE X(10). ST1104.2 +007300 02 FAKE-LENGTH-2 PICTURE A(10). ST1104.2 +007400 02 FAKE-LENGTH-3 PICTURE 9(10). ST1104.2 +007500 02 FAKE-LENGTH-4 PICTURE X(20). ST1104.2 +007600 01 MEDIUM-OUT PICTURE X(75). ST1104.2 +007700 01 LONG-OUT PICTURE X(100). ST1104.2 +007800 SD SORTFILE-1J ST1104.2 +007900 RECORD 50 TO 100 ST1104.2 +008000 DATA RECORD SHORT-SORT ST1104.2 +008100 MEDIUM-SORT ST1104.2 +008200 LONG-SORT. ST1104.2 +008300 01 SHORT-SORT. ST1104.2 +008400 02 SHORT-NON-KEY PICTURE XX. ST1104.2 +008500 02 SHORT-KEY-1 PICTURE X(10). ST1104.2 +008600 02 SHORT-KEY-2 PICTURE X(38). ST1104.2 +008700 01 MEDIUM-SORT. ST1104.2 +008800 02 MEDIUM-NON-KEY PICTURE XX. ST1104.2 +008900 02 MEDIUM-KEY-1 PICTURE X(10). ST1104.2 +009000 02 MEDIUM-KEY-2 PICTURE X(38). ST1104.2 +009100 02 MEDIUM-FILLER PICTURE X(25). ST1104.2 +009200 01 LONG-SORT. ST1104.2 +009300 02 LONG-NON-KEY PICTURE XX. ST1104.2 +009400 02 LONG-KEY-1 PICTURE X(10). ST1104.2 +009500 02 LONG-KEY-2 PICTURE X(38). ST1104.2 +009600 02 LONG-FILLER PICTURE X(50). ST1104.2 +009700 PROCEDURE DIVISION. ST1104.2 +009800 SORT-PARAGRAPH. ST1104.2 +009900 SORT SORTFILE-1J ST1104.2 +010000 DESCENDING KEY ST1104.2 +010100 MEDIUM-KEY-1 ST1104.2 +010200 MEDIUM-KEY-2 ST1104.2 +010300 USING SORTIN-1J ST1104.2 +010400 GIVING SORTOUT-1J. ST1104.2 +010500 STOP RUN. ST1104.2 diff --git a/tests/cobol85/ST/ST111A.SUB b/tests/cobol85/ST/ST111A.SUB new file mode 100755 index 00000000..6a4243c5 --- /dev/null +++ b/tests/cobol85/ST/ST111A.SUB @@ -0,0 +1,497 @@ +000100 IDENTIFICATION DIVISION. ST1114.2 +000200 PROGRAM-ID. ST1114.2 +000300 ST111A. ST1114.2 +000400**************************************************************** ST1114.2 +000500* * ST1114.2 +000600* VALIDATION FOR:- * ST1114.2 +000700* * ST1114.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1114.2 +000900* * ST1114.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1114.2 +001100* * ST1114.2 +001200**************************************************************** ST1114.2 +001300* * ST1114.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1114.2 +001500* * ST1114.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1114.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1114.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1114.2 +001900* * ST1114.2 +002000**************************************************************** ST1114.2 +002100* ST111 CHECKS THE OUTPUT FROM ST110. WHICH IN TURN USED INPUT ST1114.2 +002200* FROM ST109. 40 VARIABLE-LENGTH RECORDS HAVE BEEN SORTED AND ST1114.2 +002300* SHOULD APPEAR AS SHOWN ST1114.2 +002400* NON-KEY KEY-1 KEY-2 FILLER ST1114.2 +002500* X(2) X(10) X(38) ST1114.2 +002600* ST1114.2 +002700* FIRST 13 RECORDS --- ST1114.2 +002800* "CC""LOWEST TWO""MIDDLE TWO-SECOND" X(50) VALUE QUOTEST1114.2 +002900* NEXT 14 RECORDS --- ST1114.2 +003000* "BB""LOWEST TWO""MIDDLE TWO-FIRST" X(25) VALUE ZERO ST1114.2 +003100* LAST 13 RECORDS --- ST1114.2 +003200* "AA""LOWEST ONE""MIDDLE ONE-ONLY" (NONE) ST1114.2 +003300 ST1114.2 +003400 ENVIRONMENT DIVISION. ST1114.2 +003500 CONFIGURATION SECTION. ST1114.2 +003600 SOURCE-COMPUTER. ST1114.2 +003700 Linux. ST1114.2 +003800 OBJECT-COMPUTER. ST1114.2 +003900 Linux. ST1114.2 +004000 INPUT-OUTPUT SECTION. ST1114.2 +004100 FILE-CONTROL. ST1114.2 +004200 SELECT PRINT-FILE ASSIGN TO ST1114.2 +004300 "report.log". ST1114.2 +004400 SELECT SORTIN-1K ASSIGN TO ST1114.2 +004500 "XXXXX002". ST1114.2 +004600 DATA DIVISION. ST1114.2 +004700 FILE SECTION. ST1114.2 +004800 FD PRINT-FILE. ST1114.2 +004900 01 PRINT-REC PICTURE X(120). ST1114.2 +005000 01 DUMMY-RECORD PICTURE X(120). ST1114.2 +005100 FD SORTIN-1K ST1114.2 +005200 LABEL RECORDS STANDARD ST1114.2 +005300*C VALUE OF ST1114.2 +005400*C OCLABELID ST1114.2 +005500*C IS ST1114.2 +005600*C "OCDUMMY" ST1114.2 +005700*G SYSIN ST1114.2 +005800 RECORD CONTAINS 50 TO 100 CHARACTERS ST1114.2 +005900 DATA RECORDS ARE SHORT-RECORD ST1114.2 +006000 MEDIUM-RECORD ST1114.2 +006100 LONG-RECORD. ST1114.2 +006200 01 SHORT-RECORD PICTURE X(50). ST1114.2 +006300 01 MEDIUM-RECORD PICTURE X(75). ST1114.2 +006400 01 LONG-RECORD PICTURE X(100). ST1114.2 +006500 WORKING-STORAGE SECTION. ST1114.2 +006600 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1114.2 +006700 01 SHORT-WORK. ST1114.2 +006800 02 FILLER PICTURE XX VALUE "AA". ST1114.2 +006900 02 FILLER PICTURE X(10) VALUE "LOWEST ONE". ST1114.2 +007000 02 FILLER PICTURE X(38) ST1114.2 +007100 VALUE "MIDDLE ONE-ONLY ". ST1114.2 +007200 01 MEDIUM-WORK. ST1114.2 +007300 02 FILLER PICTURE XX VALUE "BB". ST1114.2 +007400 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1114.2 +007500 02 FILLER PICTURE X(38) ST1114.2 +007600 VALUE "MIDDLE TWO-FIRST ". ST1114.2 +007700 02 FILLER PICTURE X(25) VALUE ZERO. ST1114.2 +007800 01 LONG-WORK. ST1114.2 +007900 02 FILLER PICTURE XX VALUE "CC". ST1114.2 +008000 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1114.2 +008100 02 FILLER PICTURE X(38) ST1114.2 +008200 VALUE "MIDDLE TWO-SECOND ". ST1114.2 +008300 02 FILLER PICTURE X(50) VALUE QUOTE. ST1114.2 +008400 01 BREAKDOWN-LIMIT PICTURE 999. ST1114.2 +008500 01 COMPUTED-BREAKDOWN. ST1114.2 +008600 02 FIRST-20-CM PICTURE X(20). ST1114.2 +008700 02 SECOND-20-CM PICTURE X(20). ST1114.2 +008800 02 THIRD-20-CM PICTURE X(20). ST1114.2 +008900 02 FOURTH-20-CM PICTURE X(20). ST1114.2 +009000 02 FIFTH-20-CM PICTURE X(20). ST1114.2 +009100 01 CORRECT-BREAKDOWN. ST1114.2 +009200 02 FIRST-20-CR PICTURE X(20). ST1114.2 +009300 02 SECOND-20-CR PICTURE X(20). ST1114.2 +009400 02 THIRD-20-CR PICTURE X(20). ST1114.2 +009500 02 FOURTH-20-CR PICTURE X(20). ST1114.2 +009600 02 FIFTH-20-CR PICTURE X(20). ST1114.2 +009700 01 TEST-RESULTS. ST1114.2 +009800 02 FILLER PIC X VALUE SPACE. ST1114.2 +009900 02 FEATURE PIC X(20) VALUE SPACE. ST1114.2 +010000 02 FILLER PIC X VALUE SPACE. ST1114.2 +010100 02 P-OR-F PIC X(5) VALUE SPACE. ST1114.2 +010200 02 FILLER PIC X VALUE SPACE. ST1114.2 +010300 02 PAR-NAME. ST1114.2 +010400 03 FILLER PIC X(19) VALUE SPACE. ST1114.2 +010500 03 PARDOT-X PIC X VALUE SPACE. ST1114.2 +010600 03 DOTVALUE PIC 99 VALUE ZERO. ST1114.2 +010700 02 FILLER PIC X(8) VALUE SPACE. ST1114.2 +010800 02 RE-MARK PIC X(61). ST1114.2 +010900 01 TEST-COMPUTED. ST1114.2 +011000 02 FILLER PIC X(30) VALUE SPACE. ST1114.2 +011100 02 FILLER PIC X(17) VALUE ST1114.2 +011200 " COMPUTED=". ST1114.2 +011300 02 COMPUTED-X. ST1114.2 +011400 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1114.2 +011500 03 COMPUTED-N REDEFINES COMPUTED-A ST1114.2 +011600 PIC -9(9).9(9). ST1114.2 +011700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1114.2 +011800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1114.2 +011900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1114.2 +012000 03 CM-18V0 REDEFINES COMPUTED-A. ST1114.2 +012100 04 COMPUTED-18V0 PIC -9(18). ST1114.2 +012200 04 FILLER PIC X. ST1114.2 +012300 03 FILLER PIC X(50) VALUE SPACE. ST1114.2 +012400 01 TEST-CORRECT. ST1114.2 +012500 02 FILLER PIC X(30) VALUE SPACE. ST1114.2 +012600 02 FILLER PIC X(17) VALUE " CORRECT =". ST1114.2 +012700 02 CORRECT-X. ST1114.2 +012800 03 CORRECT-A PIC X(20) VALUE SPACE. ST1114.2 +012900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1114.2 +013000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1114.2 +013100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1114.2 +013200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1114.2 +013300 03 CR-18V0 REDEFINES CORRECT-A. ST1114.2 +013400 04 CORRECT-18V0 PIC -9(18). ST1114.2 +013500 04 FILLER PIC X. ST1114.2 +013600 03 FILLER PIC X(2) VALUE SPACE. ST1114.2 +013700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1114.2 +013800 01 CCVS-C-1. ST1114.2 +013900 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1114.2 +014000- "SS PARAGRAPH-NAME ST1114.2 +014100- " REMARKS". ST1114.2 +014200 02 FILLER PIC X(20) VALUE SPACE. ST1114.2 +014300 01 CCVS-C-2. ST1114.2 +014400 02 FILLER PIC X VALUE SPACE. ST1114.2 +014500 02 FILLER PIC X(6) VALUE "TESTED". ST1114.2 +014600 02 FILLER PIC X(15) VALUE SPACE. ST1114.2 +014700 02 FILLER PIC X(4) VALUE "FAIL". ST1114.2 +014800 02 FILLER PIC X(94) VALUE SPACE. ST1114.2 +014900 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1114.2 +015000 01 REC-CT PIC 99 VALUE ZERO. ST1114.2 +015100 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1114.2 +015200 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1114.2 +015300 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1114.2 +015400 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1114.2 +015500 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1114.2 +015600 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1114.2 +015700 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1114.2 +015800 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1114.2 +015900 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1114.2 +016000 01 CCVS-H-1. ST1114.2 +016100 02 FILLER PIC X(39) VALUE SPACES. ST1114.2 +016200 02 FILLER PIC X(42) VALUE ST1114.2 +016300 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1114.2 +016400 02 FILLER PIC X(39) VALUE SPACES. ST1114.2 +016500 01 CCVS-H-2A. ST1114.2 +016600 02 FILLER PIC X(40) VALUE SPACE. ST1114.2 +016700 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1114.2 +016800 02 FILLER PIC XXXX VALUE ST1114.2 +016900 "4.2 ". ST1114.2 +017000 02 FILLER PIC X(28) VALUE ST1114.2 +017100 " COPY - NOT FOR DISTRIBUTION". ST1114.2 +017200 02 FILLER PIC X(41) VALUE SPACE. ST1114.2 +017300 ST1114.2 +017400 01 CCVS-H-2B. ST1114.2 +017500 02 FILLER PIC X(15) VALUE ST1114.2 +017600 "TEST RESULT OF ". ST1114.2 +017700 02 TEST-ID PIC X(9). ST1114.2 +017800 02 FILLER PIC X(4) VALUE ST1114.2 +017900 " IN ". ST1114.2 +018000 02 FILLER PIC X(12) VALUE ST1114.2 +018100 " HIGH ". ST1114.2 +018200 02 FILLER PIC X(22) VALUE ST1114.2 +018300 " LEVEL VALIDATION FOR ". ST1114.2 +018400 02 FILLER PIC X(58) VALUE ST1114.2 +018500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1114.2 +018600 01 CCVS-H-3. ST1114.2 +018700 02 FILLER PIC X(34) VALUE ST1114.2 +018800 " FOR OFFICIAL USE ONLY ". ST1114.2 +018900 02 FILLER PIC X(58) VALUE ST1114.2 +019000 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1114.2 +019100 02 FILLER PIC X(28) VALUE ST1114.2 +019200 " COPYRIGHT 1985 ". ST1114.2 +019300 01 CCVS-E-1. ST1114.2 +019400 02 FILLER PIC X(52) VALUE SPACE. ST1114.2 +019500 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1114.2 +019600 02 ID-AGAIN PIC X(9). ST1114.2 +019700 02 FILLER PIC X(45) VALUE SPACES. ST1114.2 +019800 01 CCVS-E-2. ST1114.2 +019900 02 FILLER PIC X(31) VALUE SPACE. ST1114.2 +020000 02 FILLER PIC X(21) VALUE SPACE. ST1114.2 +020100 02 CCVS-E-2-2. ST1114.2 +020200 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1114.2 +020300 03 FILLER PIC X VALUE SPACE. ST1114.2 +020400 03 ENDER-DESC PIC X(44) VALUE ST1114.2 +020500 "ERRORS ENCOUNTERED". ST1114.2 +020600 01 CCVS-E-3. ST1114.2 +020700 02 FILLER PIC X(22) VALUE ST1114.2 +020800 " FOR OFFICIAL USE ONLY". ST1114.2 +020900 02 FILLER PIC X(12) VALUE SPACE. ST1114.2 +021000 02 FILLER PIC X(58) VALUE ST1114.2 +021100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1114.2 +021200 02 FILLER PIC X(13) VALUE SPACE. ST1114.2 +021300 02 FILLER PIC X(15) VALUE ST1114.2 +021400 " COPYRIGHT 1985". ST1114.2 +021500 01 CCVS-E-4. ST1114.2 +021600 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1114.2 +021700 02 FILLER PIC X(4) VALUE " OF ". ST1114.2 +021800 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1114.2 +021900 02 FILLER PIC X(40) VALUE ST1114.2 +022000 " TESTS WERE EXECUTED SUCCESSFULLY". ST1114.2 +022100 01 XXINFO. ST1114.2 +022200 02 FILLER PIC X(19) VALUE ST1114.2 +022300 "*** INFORMATION ***". ST1114.2 +022400 02 INFO-TEXT. ST1114.2 +022500 04 FILLER PIC X(8) VALUE SPACE. ST1114.2 +022600 04 XXCOMPUTED PIC X(20). ST1114.2 +022700 04 FILLER PIC X(5) VALUE SPACE. ST1114.2 +022800 04 XXCORRECT PIC X(20). ST1114.2 +022900 02 INF-ANSI-REFERENCE PIC X(48). ST1114.2 +023000 01 HYPHEN-LINE. ST1114.2 +023100 02 FILLER PIC IS X VALUE IS SPACE. ST1114.2 +023200 02 FILLER PIC IS X(65) VALUE IS "************************ST1114.2 +023300- "*****************************************". ST1114.2 +023400 02 FILLER PIC IS X(54) VALUE IS "************************ST1114.2 +023500- "******************************". ST1114.2 +023600 01 CCVS-PGM-ID PIC X(9) VALUE ST1114.2 +023700 "ST111A". ST1114.2 +023800 PROCEDURE DIVISION. ST1114.2 +023900 CCVS1 SECTION. ST1114.2 +024000 OPEN-FILES. ST1114.2 +024100 OPEN OUTPUT PRINT-FILE. ST1114.2 +024200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1114.2 +024300 MOVE SPACE TO TEST-RESULTS. ST1114.2 +024400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1114.2 +024500 GO TO CCVS1-EXIT. ST1114.2 +024600 CLOSE-FILES. ST1114.2 +024700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1114.2 +024800 TERMINATE-CCVS. ST1114.2 +024900*S EXIT PROGRAM. ST1114.2 +025000*SERMINATE-CALL. ST1114.2 +025100 STOP RUN. ST1114.2 +025200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1114.2 +025300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1114.2 +025400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1114.2 +025500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1114.2 +025600 MOVE "****TEST DELETED****" TO RE-MARK. ST1114.2 +025700 PRINT-DETAIL. ST1114.2 +025800 IF REC-CT NOT EQUAL TO ZERO ST1114.2 +025900 MOVE "." TO PARDOT-X ST1114.2 +026000 MOVE REC-CT TO DOTVALUE. ST1114.2 +026100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1114.2 +026200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1114.2 +026300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1114.2 +026400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1114.2 +026500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1114.2 +026600 MOVE SPACE TO CORRECT-X. ST1114.2 +026700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1114.2 +026800 MOVE SPACE TO RE-MARK. ST1114.2 +026900 HEAD-ROUTINE. ST1114.2 +027000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +027100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +027200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1114.2 +027300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1114.2 +027400 COLUMN-NAMES-ROUTINE. ST1114.2 +027500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +027600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +027800 END-ROUTINE. ST1114.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1114.2 +028000 END-RTN-EXIT. ST1114.2 +028100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +028200 END-ROUTINE-1. ST1114.2 +028300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1114.2 +028400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1114.2 +028500 ADD PASS-COUNTER TO ERROR-HOLD. ST1114.2 +028600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1114.2 +028700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1114.2 +028800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1114.2 +028900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1114.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1114.2 +029100 END-ROUTINE-12. ST1114.2 +029200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1114.2 +029300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1114.2 +029400 MOVE "NO " TO ERROR-TOTAL ST1114.2 +029500 ELSE ST1114.2 +029600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1114.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1114.2 +029800 PERFORM WRITE-LINE. ST1114.2 +029900 END-ROUTINE-13. ST1114.2 +030000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1114.2 +030100 MOVE "NO " TO ERROR-TOTAL ELSE ST1114.2 +030200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1114.2 +030300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1114.2 +030400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +030500 IF INSPECT-COUNTER EQUAL TO ZERO ST1114.2 +030600 MOVE "NO " TO ERROR-TOTAL ST1114.2 +030700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1114.2 +030800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1114.2 +030900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +031000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1114.2 +031100 WRITE-LINE. ST1114.2 +031200 ADD 1 TO RECORD-COUNT. ST1114.2 +031300 IF RECORD-COUNT GREATER 42 ST1114.2 +031400 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1114.2 +031500 MOVE SPACE TO DUMMY-RECORD ST1114.2 +031600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1114.2 +031700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1114.2 +031800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1114.2 +031900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1114.2 +032000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1114.2 +032100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1114.2 +032200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1114.2 +032300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1114.2 +032400 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1114.2 +032500 MOVE ZERO TO RECORD-COUNT. ST1114.2 +032600 PERFORM WRT-LN. ST1114.2 +032700 WRT-LN. ST1114.2 +032800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1114.2 +032900 MOVE SPACE TO DUMMY-RECORD. ST1114.2 +033000 BLANK-LINE-PRINT. ST1114.2 +033100 PERFORM WRT-LN. ST1114.2 +033200 FAIL-ROUTINE. ST1114.2 +033300 IF COMPUTED-X NOT EQUAL TO SPACE ST1114.2 +033400 GO TO FAIL-ROUTINE-WRITE. ST1114.2 +033500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1114.2 +033600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1114.2 +033700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1114.2 +033800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +033900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1114.2 +034000 GO TO FAIL-ROUTINE-EX. ST1114.2 +034100 FAIL-ROUTINE-WRITE. ST1114.2 +034200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1114.2 +034300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1114.2 +034400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1114.2 +034500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1114.2 +034600 FAIL-ROUTINE-EX. EXIT. ST1114.2 +034700 BAIL-OUT. ST1114.2 +034800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1114.2 +034900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1114.2 +035000 BAIL-OUT-WRITE. ST1114.2 +035100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1114.2 +035200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1114.2 +035300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1114.2 +035400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1114.2 +035500 BAIL-OUT-EX. EXIT. ST1114.2 +035600 CCVS1-EXIT. ST1114.2 +035700 EXIT. ST1114.2 +035800 SECT-ST111-0001 SECTION. ST1114.2 +035900 ST111-0001-01. ST1114.2 +036000 OPEN INPUT SORTIN-1K. ST1114.2 +036100 MOVE " ***** ST110 DOES NOT PRODUCE A PRINTED REPORT ***ST1114.2 +036200- "**" TO TEST-RESULTS. ST1114.2 +036300 PERFORM PRINT-DETAIL. ST1114.2 +036400 MOVE SPACE TO TEST-RESULTS. ST1114.2 +036500 PERFORM END-ROUTINE. ST1114.2 +036600 MOVE "SORT VARIABLE RECORD" TO FEATURE. ST1114.2 +036700 SORT-TEST-1. ST1114.2 +036800 MOVE "SORT-TEST-1" TO PAR-NAME. ST1114.2 +036900 PERFORM READ-SORTIN. ST1114.2 +037000 IF LONG-RECORD EQUAL TO LONG-WORK ST1114.2 +037100 PERFORM PASS GO TO SORT-WRITE-1. ST1114.2 +037200* NOTE FIRST RECORD. ST1114.2 +037300 SORT-FAIL-1. ST1114.2 +037400 MOVE 100 TO BREAKDOWN-LIMIT. ST1114.2 +037500 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +037600 MOVE LONG-WORK TO CORRECT-BREAKDOWN. ST1114.2 +037700 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +037800 SORT-WRITE-1. ST1114.2 +037900 PERFORM PRINT-DETAIL. ST1114.2 +038000 SORT-TEST-2. ST1114.2 +038100 MOVE "SORT-TEST-2" TO PAR-NAME. ST1114.2 +038200 PERFORM READ-SORTIN 12 TIMES. ST1114.2 +038300 IF LONG-RECORD EQUAL TO LONG-WORK ST1114.2 +038400 PERFORM PASS GO TO SORT-WRITE-2. ST1114.2 +038500* NOTE THIRTEENTH RECORD. ST1114.2 +038600 SORT-FAIL-2. ST1114.2 +038700 MOVE 100 TO BREAKDOWN-LIMIT. ST1114.2 +038800 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +038900 MOVE LONG-WORK TO CORRECT-BREAKDOWN. ST1114.2 +039000 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +039100 SORT-WRITE-2. ST1114.2 +039200 PERFORM PRINT-DETAIL. ST1114.2 +039300 SORT-TEST-3. ST1114.2 +039400 MOVE "SORT-TEST-3" TO PAR-NAME. ST1114.2 +039500 PERFORM READ-SORTIN. ST1114.2 +039600 IF MEDIUM-RECORD EQUAL TO MEDIUM-WORK ST1114.2 +039700 PERFORM PASS GO TO SORT-WRITE-3. ST1114.2 +039800* NOTE FOURTEENTH RECORD. ST1114.2 +039900 SORT-FAIL-3. ST1114.2 +040000 MOVE 75 TO BREAKDOWN-LIMIT. ST1114.2 +040100 MOVE MEDIUM-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +040200 MOVE MEDIUM-WORK TO CORRECT-BREAKDOWN. ST1114.2 +040300 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +040400 SORT-WRITE-3. ST1114.2 +040500 PERFORM PRINT-DETAIL. ST1114.2 +040600 SORT-TEST-4. ST1114.2 +040700 MOVE "SORT-TEST-4" TO PAR-NAME. ST1114.2 +040800 PERFORM READ-SORTIN 13 TIMES. ST1114.2 +040900 IF MEDIUM-RECORD EQUAL TO MEDIUM-WORK ST1114.2 +041000 PERFORM PASS GO TO SORT-WRITE-4. ST1114.2 +041100* NOTE TWENTY-SEVENTH RECORD. ST1114.2 +041200 SORT-FAIL-4. ST1114.2 +041300 MOVE 75 TO BREAKDOWN-LIMIT. ST1114.2 +041400 MOVE MEDIUM-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +041500 MOVE MEDIUM-WORK TO CORRECT-BREAKDOWN. ST1114.2 +041600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +041700 SORT-WRITE-4. ST1114.2 +041800 PERFORM PRINT-DETAIL. ST1114.2 +041900 SORT-TEST-5. ST1114.2 +042000 MOVE "SORT-TEST-5" TO PAR-NAME. ST1114.2 +042100 PERFORM READ-SORTIN. ST1114.2 +042200 IF SHORT-RECORD EQUAL TO SHORT-WORK ST1114.2 +042300 PERFORM PASS GO TO SORT-WRITE-5. ST1114.2 +042400* NOTE TWENTY-EIGHTH RECORD. ST1114.2 +042500 SORT-FAIL-5. ST1114.2 +042600 MOVE 50 TO BREAKDOWN-LIMIT. ST1114.2 +042700 MOVE SHORT-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +042800 MOVE SHORT-WORK TO CORRECT-BREAKDOWN. ST1114.2 +042900 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +043000 SORT-WRITE-5. ST1114.2 +043100 PERFORM PRINT-DETAIL. ST1114.2 +043200 SORT-TEST-6. ST1114.2 +043300 MOVE "SORT-TEST-6" TO PAR-NAME. ST1114.2 +043400 PERFORM READ-SORTIN 12 TIMES. ST1114.2 +043500 IF SHORT-RECORD EQUAL TO SHORT-WORK ST1114.2 +043600 PERFORM PASS GO TO SORT-WRITE-6. ST1114.2 +043700* NOTE FORTIETH RECORD. ST1114.2 +043800 SORT-FAIL-6. ST1114.2 +043900 MOVE 50 TO BREAKDOWN-LIMIT. ST1114.2 +044000 MOVE SHORT-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +044100 MOVE SHORT-WORK TO CORRECT-BREAKDOWN. ST1114.2 +044200 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +044300 SORT-WRITE-6. ST1114.2 +044400 PERFORM PRINT-DETAIL. ST1114.2 +044500 SORT-TEST-7. ST1114.2 +044600 MOVE "SORT-TEST-7" TO PAR-NAME. ST1114.2 +044700 READ SORTIN-1K AT END ST1114.2 +044800 PERFORM PASS GO TO SORT-WRITE-7. ST1114.2 +044900 SORT-FAIL-7. ST1114.2 +045000 MOVE 100 TO BREAKDOWN-LIMIT. ST1114.2 +045100 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1114.2 +045200 MOVE SPACE TO CORRECT-BREAKDOWN. ST1114.2 +045300 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1114.2 +045400 PERFORM PRINT-DETAIL. ST1114.2 +045500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1114.2 +045600 SORT-WRITE-7. ST1114.2 +045700 PERFORM PRINT-DETAIL. ST1114.2 +045800 CLOSE SORTIN-1K. ST1114.2 +045900 GO TO CCVS-EXIT. ST1114.2 +046000 BREAKDOWN-PARA. ST1114.2 +046100 PERFORM FAIL. ST1114.2 +046200 MOVE FIRST-20-CM TO COMPUTED-A. ST1114.2 +046300 MOVE FIRST-20-CR TO CORRECT-A. ST1114.2 +046400 MOVE "FIRST TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +046500 PERFORM PRINT-DETAIL. ST1114.2 +046600 MOVE SECOND-20-CM TO COMPUTED-A. ST1114.2 +046700 MOVE SECOND-20-CR TO CORRECT-A. ST1114.2 +046800 MOVE "SECOND TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +046900 PERFORM PRINT-DETAIL. ST1114.2 +047000 MOVE THIRD-20-CM TO COMPUTED-A. ST1114.2 +047100 MOVE THIRD-20-CR TO CORRECT-A. ST1114.2 +047200 MOVE "THIRD TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +047300 PERFORM PRINT-DETAIL. ST1114.2 +047400 IF BREAKDOWN-LIMIT LESS THAN 61 GO TO BREAKDOWN-EXIT. ST1114.2 +047500 MOVE FOURTH-20-CM TO COMPUTED-A. ST1114.2 +047600 MOVE FOURTH-20-CR TO CORRECT-A. ST1114.2 +047700 MOVE "FOURTH TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +047800 PERFORM PRINT-DETAIL. ST1114.2 +047900 IF BREAKDOWN-LIMIT LESS THAN 81 GO TO BREAKDOWN-EXIT. ST1114.2 +048000 MOVE FIFTH-20-CM TO COMPUTED-A. ST1114.2 +048100 MOVE FIFTH-20-CR TO CORRECT-A. ST1114.2 +048200 MOVE "FIFTH TWENTY CHARACTERS" TO RE-MARK. ST1114.2 +048300 BREAKDOWN-EXIT. ST1114.2 +048400 EXIT. ST1114.2 +048500 READ-SORTIN. ST1114.2 +048600 READ SORTIN-1K AT END GO TO READ-ERROR. ST1114.2 +048700 ADD 1 TO UTIL-CTR. ST1114.2 +048800 READ-ERROR. ST1114.2 +048900 MOVE UTIL-CTR TO COMPUTED-N. ST1114.2 +049000 MOVE 40 TO CORRECT-N. ST1114.2 +049100 MOVE "TOO FEW INPUT RECORDS" TO RE-MARK. ST1114.2 +049200 MOVE "READ-SORTIN" TO PAR-NAME. ST1114.2 +049300 PERFORM FAIL. ST1114.2 +049400 PERFORM PRINT-DETAIL. ST1114.2 +049500 CCVS-EXIT SECTION. ST1114.2 +049600 CCVS-999999. ST1114.2 +049700 GO TO CLOSE-FILES. ST1114.2 diff --git a/tests/cobol85/ST/ST112M.CBL b/tests/cobol85/ST/ST112M.CBL new file mode 100755 index 00000000..764eb01c --- /dev/null +++ b/tests/cobol85/ST/ST112M.CBL @@ -0,0 +1,386 @@ +000100 IDENTIFICATION DIVISION. ST1124.2 +000200 PROGRAM-ID. ST1124.2 +000300 ST112M. ST1124.2 +000400**************************************************************** ST1124.2 +000500* * ST1124.2 +000600* VALIDATION FOR:- * ST1124.2 +000700* * ST1124.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1124.2 +000900* * ST1124.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1124.2 +001100* * ST1124.2 +001200**************************************************************** ST1124.2 +001300* * ST1124.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1124.2 +001500* * ST1124.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1124.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1124.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1124.2 +001900* * ST1124.2 +002000**************************************************************** ST1124.2 +002100 ENVIRONMENT DIVISION. ST1124.2 +002200 CONFIGURATION SECTION. ST1124.2 +002300 SOURCE-COMPUTER. ST1124.2 +002400 Linux. ST1124.2 +002500 OBJECT-COMPUTER. ST1124.2 +002600 Linux. ST1124.2 +002700 INPUT-OUTPUT SECTION. ST1124.2 +002800 FILE-CONTROL. ST1124.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1124.2 +003000 "report.log". ST1124.2 +003100 SELECT SORTOUT-1L ASSIGN TO ST1124.2 +003200 "XXXXX006". ST1124.2 +003300 DATA DIVISION. ST1124.2 +003400 FILE SECTION. ST1124.2 +003500 FD PRINT-FILE. ST1124.2 +003600 01 PRINT-REC PICTURE X(120). ST1124.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1124.2 +003800 FD SORTOUT-1L ST1124.2 +003900 LABEL RECORDS STANDARD ST1124.2 +004000*C VALUE OF ST1124.2 +004100*C OCLABELID ST1124.2 +004200*C IS ST1124.2 +004300*C **** X-CARD UNDEFINED **** ST1124.2 +004400*G SYSIN ST1124.2 +004500 DATA RECORD IS SORT-KEY. ST1124.2 +004600 01 SORT-KEY PIC X(33). ST1124.2 +004700 WORKING-STORAGE SECTION. ST1124.2 +004800 77 UTIL-CTR PIC S99999 VALUE ZERO. ST1124.2 +004900 77 COMMENT-SENTENCE PICTURE X(118) VALUE "ST112M HAS CREATED A ST1124.2 +005000- "3-REEL FILE WHICH WILL BE PASSED TO ST113 FOR SORTING. THIS ST1124.2 +005100- "COMMENT IS THE ONLY OUTPUT FOR ST112". ST1124.2 +005200 01 TEST-RESULTS. ST1124.2 +005300 02 FILLER PIC X VALUE SPACE. ST1124.2 +005400 02 FEATURE PIC X(20) VALUE SPACE. ST1124.2 +005500 02 FILLER PIC X VALUE SPACE. ST1124.2 +005600 02 P-OR-F PIC X(5) VALUE SPACE. ST1124.2 +005700 02 FILLER PIC X VALUE SPACE. ST1124.2 +005800 02 PAR-NAME. ST1124.2 +005900 03 FILLER PIC X(19) VALUE SPACE. ST1124.2 +006000 03 PARDOT-X PIC X VALUE SPACE. ST1124.2 +006100 03 DOTVALUE PIC 99 VALUE ZERO. ST1124.2 +006200 02 FILLER PIC X(8) VALUE SPACE. ST1124.2 +006300 02 RE-MARK PIC X(61). ST1124.2 +006400 01 TEST-COMPUTED. ST1124.2 +006500 02 FILLER PIC X(30) VALUE SPACE. ST1124.2 +006600 02 FILLER PIC X(17) VALUE ST1124.2 +006700 " COMPUTED=". ST1124.2 +006800 02 COMPUTED-X. ST1124.2 +006900 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1124.2 +007000 03 COMPUTED-N REDEFINES COMPUTED-A ST1124.2 +007100 PIC -9(9).9(9). ST1124.2 +007200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1124.2 +007300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1124.2 +007400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1124.2 +007500 03 CM-18V0 REDEFINES COMPUTED-A. ST1124.2 +007600 04 COMPUTED-18V0 PIC -9(18). ST1124.2 +007700 04 FILLER PIC X. ST1124.2 +007800 03 FILLER PIC X(50) VALUE SPACE. ST1124.2 +007900 01 TEST-CORRECT. ST1124.2 +008000 02 FILLER PIC X(30) VALUE SPACE. ST1124.2 +008100 02 FILLER PIC X(17) VALUE " CORRECT =". ST1124.2 +008200 02 CORRECT-X. ST1124.2 +008300 03 CORRECT-A PIC X(20) VALUE SPACE. ST1124.2 +008400 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1124.2 +008500 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1124.2 +008600 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1124.2 +008700 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1124.2 +008800 03 CR-18V0 REDEFINES CORRECT-A. ST1124.2 +008900 04 CORRECT-18V0 PIC -9(18). ST1124.2 +009000 04 FILLER PIC X. ST1124.2 +009100 03 FILLER PIC X(2) VALUE SPACE. ST1124.2 +009200 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1124.2 +009300 01 CCVS-C-1. ST1124.2 +009400 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1124.2 +009500- "SS PARAGRAPH-NAME ST1124.2 +009600- " REMARKS". ST1124.2 +009700 02 FILLER PIC X(20) VALUE SPACE. ST1124.2 +009800 01 CCVS-C-2. ST1124.2 +009900 02 FILLER PIC X VALUE SPACE. ST1124.2 +010000 02 FILLER PIC X(6) VALUE "TESTED". ST1124.2 +010100 02 FILLER PIC X(15) VALUE SPACE. ST1124.2 +010200 02 FILLER PIC X(4) VALUE "FAIL". ST1124.2 +010300 02 FILLER PIC X(94) VALUE SPACE. ST1124.2 +010400 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1124.2 +010500 01 REC-CT PIC 99 VALUE ZERO. ST1124.2 +010600 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1124.2 +010700 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1124.2 +010800 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1124.2 +010900 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1124.2 +011000 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1124.2 +011100 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1124.2 +011200 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1124.2 +011300 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1124.2 +011400 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1124.2 +011500 01 CCVS-H-1. ST1124.2 +011600 02 FILLER PIC X(39) VALUE SPACES. ST1124.2 +011700 02 FILLER PIC X(42) VALUE ST1124.2 +011800 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1124.2 +011900 02 FILLER PIC X(39) VALUE SPACES. ST1124.2 +012000 01 CCVS-H-2A. ST1124.2 +012100 02 FILLER PIC X(40) VALUE SPACE. ST1124.2 +012200 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1124.2 +012300 02 FILLER PIC XXXX VALUE ST1124.2 +012400 "4.2 ". ST1124.2 +012500 02 FILLER PIC X(28) VALUE ST1124.2 +012600 " COPY - NOT FOR DISTRIBUTION". ST1124.2 +012700 02 FILLER PIC X(41) VALUE SPACE. ST1124.2 +012800 ST1124.2 +012900 01 CCVS-H-2B. ST1124.2 +013000 02 FILLER PIC X(15) VALUE ST1124.2 +013100 "TEST RESULT OF ". ST1124.2 +013200 02 TEST-ID PIC X(9). ST1124.2 +013300 02 FILLER PIC X(4) VALUE ST1124.2 +013400 " IN ". ST1124.2 +013500 02 FILLER PIC X(12) VALUE ST1124.2 +013600 " HIGH ". ST1124.2 +013700 02 FILLER PIC X(22) VALUE ST1124.2 +013800 " LEVEL VALIDATION FOR ". ST1124.2 +013900 02 FILLER PIC X(58) VALUE ST1124.2 +014000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1124.2 +014100 01 CCVS-H-3. ST1124.2 +014200 02 FILLER PIC X(34) VALUE ST1124.2 +014300 " FOR OFFICIAL USE ONLY ". ST1124.2 +014400 02 FILLER PIC X(58) VALUE ST1124.2 +014500 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1124.2 +014600 02 FILLER PIC X(28) VALUE ST1124.2 +014700 " COPYRIGHT 1985 ". ST1124.2 +014800 01 CCVS-E-1. ST1124.2 +014900 02 FILLER PIC X(52) VALUE SPACE. ST1124.2 +015000 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1124.2 +015100 02 ID-AGAIN PIC X(9). ST1124.2 +015200 02 FILLER PIC X(45) VALUE SPACES. ST1124.2 +015300 01 CCVS-E-2. ST1124.2 +015400 02 FILLER PIC X(31) VALUE SPACE. ST1124.2 +015500 02 FILLER PIC X(21) VALUE SPACE. ST1124.2 +015600 02 CCVS-E-2-2. ST1124.2 +015700 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1124.2 +015800 03 FILLER PIC X VALUE SPACE. ST1124.2 +015900 03 ENDER-DESC PIC X(44) VALUE ST1124.2 +016000 "ERRORS ENCOUNTERED". ST1124.2 +016100 01 CCVS-E-3. ST1124.2 +016200 02 FILLER PIC X(22) VALUE ST1124.2 +016300 " FOR OFFICIAL USE ONLY". ST1124.2 +016400 02 FILLER PIC X(12) VALUE SPACE. ST1124.2 +016500 02 FILLER PIC X(58) VALUE ST1124.2 +016600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1124.2 +016700 02 FILLER PIC X(13) VALUE SPACE. ST1124.2 +016800 02 FILLER PIC X(15) VALUE ST1124.2 +016900 " COPYRIGHT 1985". ST1124.2 +017000 01 CCVS-E-4. ST1124.2 +017100 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1124.2 +017200 02 FILLER PIC X(4) VALUE " OF ". ST1124.2 +017300 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1124.2 +017400 02 FILLER PIC X(40) VALUE ST1124.2 +017500 " TESTS WERE EXECUTED SUCCESSFULLY". ST1124.2 +017600 01 XXINFO. ST1124.2 +017700 02 FILLER PIC X(19) VALUE ST1124.2 +017800 "*** INFORMATION ***". ST1124.2 +017900 02 INFO-TEXT. ST1124.2 +018000 04 FILLER PIC X(8) VALUE SPACE. ST1124.2 +018100 04 XXCOMPUTED PIC X(20). ST1124.2 +018200 04 FILLER PIC X(5) VALUE SPACE. ST1124.2 +018300 04 XXCORRECT PIC X(20). ST1124.2 +018400 02 INF-ANSI-REFERENCE PIC X(48). ST1124.2 +018500 01 HYPHEN-LINE. ST1124.2 +018600 02 FILLER PIC IS X VALUE IS SPACE. ST1124.2 +018700 02 FILLER PIC IS X(65) VALUE IS "************************ST1124.2 +018800- "*****************************************". ST1124.2 +018900 02 FILLER PIC IS X(54) VALUE IS "************************ST1124.2 +019000- "******************************". ST1124.2 +019100 01 CCVS-PGM-ID PIC X(9) VALUE ST1124.2 +019200 "ST112M". ST1124.2 +019300 PROCEDURE DIVISION. ST1124.2 +019400 CCVS1 SECTION. ST1124.2 +019500 OPEN-FILES. ST1124.2 +019600 OPEN OUTPUT PRINT-FILE. ST1124.2 +019700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1124.2 +019800 MOVE SPACE TO TEST-RESULTS. ST1124.2 +019900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1124.2 +020000 GO TO CCVS1-EXIT. ST1124.2 +020100 CLOSE-FILES. ST1124.2 +020200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1124.2 +020300 TERMINATE-CCVS. ST1124.2 +020400*S EXIT PROGRAM. ST1124.2 +020500*SERMINATE-CALL. ST1124.2 +020600 STOP RUN. ST1124.2 +020700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1124.2 +020800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1124.2 +020900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1124.2 +021000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1124.2 +021100 MOVE "****TEST DELETED****" TO RE-MARK. ST1124.2 +021200 PRINT-DETAIL. ST1124.2 +021300 IF REC-CT NOT EQUAL TO ZERO ST1124.2 +021400 MOVE "." TO PARDOT-X ST1124.2 +021500 MOVE REC-CT TO DOTVALUE. ST1124.2 +021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1124.2 +021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1124.2 +021800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1124.2 +021900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1124.2 +022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1124.2 +022100 MOVE SPACE TO CORRECT-X. ST1124.2 +022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1124.2 +022300 MOVE SPACE TO RE-MARK. ST1124.2 +022400 HEAD-ROUTINE. ST1124.2 +022500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +022600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +022700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1124.2 +022800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1124.2 +022900 COLUMN-NAMES-ROUTINE. ST1124.2 +023000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +023100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +023200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +023300 END-ROUTINE. ST1124.2 +023400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1124.2 +023500 END-RTN-EXIT. ST1124.2 +023600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +023700 END-ROUTINE-1. ST1124.2 +023800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1124.2 +023900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1124.2 +024000 ADD PASS-COUNTER TO ERROR-HOLD. ST1124.2 +024100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1124.2 +024200 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1124.2 +024300 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1124.2 +024400 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1124.2 +024500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1124.2 +024600 END-ROUTINE-12. ST1124.2 +024700 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1124.2 +024800 IF ERROR-COUNTER IS EQUAL TO ZERO ST1124.2 +024900 MOVE "NO " TO ERROR-TOTAL ST1124.2 +025000 ELSE ST1124.2 +025100 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1124.2 +025200 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1124.2 +025300 PERFORM WRITE-LINE. ST1124.2 +025400 END-ROUTINE-13. ST1124.2 +025500 IF DELETE-COUNTER IS EQUAL TO ZERO ST1124.2 +025600 MOVE "NO " TO ERROR-TOTAL ELSE ST1124.2 +025700 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1124.2 +025800 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1124.2 +025900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +026000 IF INSPECT-COUNTER EQUAL TO ZERO ST1124.2 +026100 MOVE "NO " TO ERROR-TOTAL ST1124.2 +026200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1124.2 +026300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1124.2 +026400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +026500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1124.2 +026600 WRITE-LINE. ST1124.2 +026700 ADD 1 TO RECORD-COUNT. ST1124.2 +026800 IF RECORD-COUNT GREATER 42 ST1124.2 +026900 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1124.2 +027000 MOVE SPACE TO DUMMY-RECORD ST1124.2 +027100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1124.2 +027200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1124.2 +027300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1124.2 +027400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1124.2 +027500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1124.2 +027600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1124.2 +027700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1124.2 +027800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1124.2 +027900 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1124.2 +028000 MOVE ZERO TO RECORD-COUNT. ST1124.2 +028100 PERFORM WRT-LN. ST1124.2 +028200 WRT-LN. ST1124.2 +028300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1124.2 +028400 MOVE SPACE TO DUMMY-RECORD. ST1124.2 +028500 BLANK-LINE-PRINT. ST1124.2 +028600 PERFORM WRT-LN. ST1124.2 +028700 FAIL-ROUTINE. ST1124.2 +028800 IF COMPUTED-X NOT EQUAL TO SPACE ST1124.2 +028900 GO TO FAIL-ROUTINE-WRITE. ST1124.2 +029000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1124.2 +029100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1124.2 +029200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1124.2 +029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +029400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1124.2 +029500 GO TO FAIL-ROUTINE-EX. ST1124.2 +029600 FAIL-ROUTINE-WRITE. ST1124.2 +029700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1124.2 +029800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1124.2 +029900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1124.2 +030000 MOVE SPACES TO COR-ANSI-REFERENCE. ST1124.2 +030100 FAIL-ROUTINE-EX. EXIT. ST1124.2 +030200 BAIL-OUT. ST1124.2 +030300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1124.2 +030400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1124.2 +030500 BAIL-OUT-WRITE. ST1124.2 +030600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1124.2 +030700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1124.2 +030800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1124.2 +030900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1124.2 +031000 BAIL-OUT-EX. EXIT. ST1124.2 +031100 CCVS1-EXIT. ST1124.2 +031200 EXIT. ST1124.2 +031300 SECT-ST112M-001 SECTION. ST1124.2 +031400 ST112M-001-01. ST1124.2 +031500 OPEN OUTPUT SORTOUT-1L. ST1124.2 +031600 BUILD-REEL. ST1124.2 +031700 MOVE ALL "A" TO SORT-KEY. ST1124.2 +031800 PERFORM WRITE-SORT-KEY. ST1124.2 +031900 MOVE ALL "B" TO SORT-KEY. ST1124.2 +032000 PERFORM WRITE-SORT-KEY. ST1124.2 +032100 MOVE ALL "C" TO SORT-KEY. ST1124.2 +032200 PERFORM WRITE-SORT-KEY. ST1124.2 +032300 MOVE ALL "D" TO SORT-KEY. ST1124.2 +032400 PERFORM WRITE-SORT-KEY. ST1124.2 +032500 MOVE ALL "E" TO SORT-KEY. ST1124.2 +032600 PERFORM WRITE-SORT-KEY. ST1124.2 +032700 MOVE ALL "F" TO SORT-KEY. ST1124.2 +032800 PERFORM WRITE-SORT-KEY. ST1124.2 +032900 MOVE ALL "G" TO SORT-KEY. ST1124.2 +033000 PERFORM WRITE-SORT-KEY. ST1124.2 +033100 MOVE ALL "H" TO SORT-KEY. ST1124.2 +033200 PERFORM WRITE-SORT-KEY. ST1124.2 +033300 MOVE ALL "I" TO SORT-KEY. ST1124.2 +033400 PERFORM WRITE-SORT-KEY. ST1124.2 +033500 MOVE ALL "J" TO SORT-KEY. ST1124.2 +033600 PERFORM WRITE-SORT-KEY. ST1124.2 +033700 MOVE ALL "K" TO SORT-KEY. ST1124.2 +033800 PERFORM WRITE-SORT-KEY. ST1124.2 +033900 MOVE ALL "L" TO SORT-KEY. ST1124.2 +034000 PERFORM WRITE-SORT-KEY. ST1124.2 +034100 MOVE ALL "M" TO SORT-KEY. ST1124.2 +034200 PERFORM WRITE-SORT-KEY. ST1124.2 +034300 MOVE ALL "N" TO SORT-KEY. ST1124.2 +034400 PERFORM WRITE-SORT-KEY. ST1124.2 +034500 MOVE ALL "O" TO SORT-KEY. ST1124.2 +034600 PERFORM WRITE-SORT-KEY. ST1124.2 +034700 MOVE ALL "P" TO SORT-KEY. ST1124.2 +034800 PERFORM WRITE-SORT-KEY. ST1124.2 +034900 MOVE ALL "Q" TO SORT-KEY. ST1124.2 +035000 PERFORM WRITE-SORT-KEY. ST1124.2 +035100 MOVE ALL "R" TO SORT-KEY. ST1124.2 +035200 PERFORM WRITE-SORT-KEY. ST1124.2 +035300 MOVE ALL "S" TO SORT-KEY. ST1124.2 +035400 PERFORM WRITE-SORT-KEY. ST1124.2 +035500 MOVE ALL "T" TO SORT-KEY. ST1124.2 +035600 PERFORM WRITE-SORT-KEY. ST1124.2 +035700 MOVE ALL "U" TO SORT-KEY. ST1124.2 +035800 PERFORM WRITE-SORT-KEY. ST1124.2 +035900 MOVE ALL "V" TO SORT-KEY. ST1124.2 +036000 PERFORM WRITE-SORT-KEY. ST1124.2 +036100 MOVE ALL "W" TO SORT-KEY. ST1124.2 +036200 PERFORM WRITE-SORT-KEY. ST1124.2 +036300 MOVE ALL "X" TO SORT-KEY. ST1124.2 +036400 PERFORM WRITE-SORT-KEY. ST1124.2 +036500 MOVE ALL "Y" TO SORT-KEY. ST1124.2 +036600 PERFORM WRITE-SORT-KEY. ST1124.2 +036700 MOVE ALL "Z" TO SORT-KEY. ST1124.2 +036800 PERFORM WRITE-SORT-KEY. ST1124.2 +036900 CLOSE-REEL. ST1124.2 +037000 ADD 1 TO UTIL-CTR. ST1124.2 +037100 IF UTIL-CTR = 3 ST1124.2 +037200 GO TO ST112M-002-01. ST1124.2 +037300 CLOSE SORTOUT-1L REEL. ST1124.2 +037400* THE FOLLOWING OPTION CARDS APPEAR ONLY FOR *OPT3 = I (NO ST1124.2 +037500* CLOSE REEL) ST1124.2 +037600 GO TO BUILD-REEL. ST1124.2 +037700 ST112M-002-01. ST1124.2 +037800 MOVE COMMENT-SENTENCE TO PRINT-REC. ST1124.2 +037900 PERFORM WRITE-LINE. ST1124.2 +038000 CLOSE SORTOUT-1L. ST1124.2 +038100 GO TO CCVS-EXIT. ST1124.2 +038200 WRITE-SORT-KEY. ST1124.2 +038300 WRITE SORT-KEY. ST1124.2 +038400 CCVS-EXIT SECTION. ST1124.2 +038500 CCVS-999999. ST1124.2 +038600 GO TO CLOSE-FILES. ST1124.2 diff --git a/tests/cobol85/ST/ST113M.SUB b/tests/cobol85/ST/ST113M.SUB new file mode 100755 index 00000000..9ee52720 --- /dev/null +++ b/tests/cobol85/ST/ST113M.SUB @@ -0,0 +1,67 @@ +000100 IDENTIFICATION DIVISION. ST1134.2 +000200 PROGRAM-ID. ST1134.2 +000300 ST113M. ST1134.2 +000400**************************************************************** ST1134.2 +000500* * ST1134.2 +000600* VALIDATION FOR:- * ST1134.2 +000700* * ST1134.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1134.2 +000900* * ST1134.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1134.2 +001100* * ST1134.2 +001200**************************************************************** ST1134.2 +001300* * ST1134.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1134.2 +001500* * ST1134.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1134.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1134.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1134.2 +001900* * ST1134.2 +002000**************************************************************** ST1134.2 +002100 ENVIRONMENT DIVISION. ST1134.2 +002200 CONFIGURATION SECTION. ST1134.2 +002300 SOURCE-COMPUTER. ST1134.2 +002400 Linux. ST1134.2 +002500 OBJECT-COMPUTER. ST1134.2 +002600 Linux. ST1134.2 +002700 INPUT-OUTPUT SECTION. ST1134.2 +002800 FILE-CONTROL. ST1134.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1134.2 +003000 "report.log". ST1134.2 +003100 SELECT SORTIN-1M ASSIGN TO ST1134.2 +003200 "XXXXX006". ST1134.2 +003300 SELECT SORTOUT-1M ASSIGN TO ST1134.2 +003400 "XXXXX001". ST1134.2 +003500 SELECT SORTFILE-1M ASSIGN TO ST1134.2 +003600 "XXXXX027". ST1134.2 +003700 DATA DIVISION. ST1134.2 +003800 FILE SECTION. ST1134.2 +003900 FD PRINT-FILE. ST1134.2 +004000 01 PRINT-REC PICTURE X(120). ST1134.2 +004100 01 DUMMY-RECORD PICTURE X(120). ST1134.2 +004200 FD SORTIN-1M ST1134.2 +004300*C VALUE OF ST1134.2 +004400*C OCLABELID ST1134.2 +004500*C IS ST1134.2 +004600*C **** X-CARD UNDEFINED **** ST1134.2 +004700*G SYSIN ST1134.2 +004800 . ST1134.2 +004900 01 SORT-KEY-IN PICTURE X(33). ST1134.2 +005000 FD SORTOUT-1M ST1134.2 +005100*C VALUE OF ST1134.2 +005200*C OCLABELID ST1134.2 +005300*C IS ST1134.2 +005400*C "OCDUMMY" ST1134.2 +005500*G SYSIN ST1134.2 +005600 . ST1134.2 +005700 01 SORT-KEY-OUT PICTURE X(33). ST1134.2 +005800 SD SORTFILE-1M. ST1134.2 +005900 01 SORT-KEY PICTURE X(33). ST1134.2 +006000 PROCEDURE DIVISION. ST1134.2 +006100 SORT-PARA SECTION. ST1134.2 +006200 SORT-PARAGRAPH. ST1134.2 +006300 SORT SORTFILE-1M DESCENDING ST1134.2 +006400 SORT-KEY ST1134.2 +006500 USING SORTIN-1M ST1134.2 +006600 GIVING SORTOUT-1M. ST1134.2 +006700 STOP RUN. ST1134.2 diff --git a/tests/cobol85/ST/ST114M.SUB b/tests/cobol85/ST/ST114M.SUB new file mode 100755 index 00000000..17479999 --- /dev/null +++ b/tests/cobol85/ST/ST114M.SUB @@ -0,0 +1,467 @@ +000100 IDENTIFICATION DIVISION. ST1144.2 +000200 PROGRAM-ID. ST1144.2 +000300 ST114M. ST1144.2 +000400**************************************************************** ST1144.2 +000500* * ST1144.2 +000600* VALIDATION FOR:- * ST1144.2 +000700* * ST1144.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1144.2 +000900* * ST1144.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1144.2 +001100* * ST1144.2 +001200**************************************************************** ST1144.2 +001300* * ST1144.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1144.2 +001500* * ST1144.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1144.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1144.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1144.2 +001900* * ST1144.2 +002000**************************************************************** ST1144.2 +002100 ENVIRONMENT DIVISION. ST1144.2 +002200 CONFIGURATION SECTION. ST1144.2 +002300 SOURCE-COMPUTER. ST1144.2 +002400 Linux. ST1144.2 +002500 OBJECT-COMPUTER. ST1144.2 +002600 Linux. ST1144.2 +002700 INPUT-OUTPUT SECTION. ST1144.2 +002800 FILE-CONTROL. ST1144.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1144.2 +003000 "report.log". ST1144.2 +003100 SELECT SORTIN-1N ASSIGN TO ST1144.2 +003200 "XXXXX001". ST1144.2 +003300 DATA DIVISION. ST1144.2 +003400 FILE SECTION. ST1144.2 +003500 FD PRINT-FILE. ST1144.2 +003600 01 PRINT-REC PICTURE X(120). ST1144.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1144.2 +003800 FD SORTIN-1N ST1144.2 +003900 LABEL RECORDS STANDARD ST1144.2 +004000*C VALUE OF ST1144.2 +004100*C OCLABELID ST1144.2 +004200*C IS ST1144.2 +004300*C "OCDUMMY" ST1144.2 +004400*G SYSIN ST1144.2 +004500 DATA RECORDS ARE SORT-KEY. ST1144.2 +004600 01 SORT-KEY PICTURE X(33). ST1144.2 +004700 WORKING-STORAGE SECTION. ST1144.2 +004800 77 ALL-A PICTURE X(33) VALUE ST1144.2 +004900 ALL "A". ST1144.2 +005000 77 ALL-N PICTURE X(33) VALUE ST1144.2 +005100 ALL "N". ST1144.2 +005200 77 ALL-Z PICTURE X(33) VALUE ST1144.2 +005300 ALL "Z". ST1144.2 +005400 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1144.2 +005500 01 COMPUTED-BREAKDOWN. ST1144.2 +005600 02 FIRST-20-CM PICTURE X(20). ST1144.2 +005700 02 SECOND-20-CM PICTURE X(20). ST1144.2 +005800 01 CORRECT-BREAKDOWN. ST1144.2 +005900 02 FIRST-20-CR PICTURE X(20). ST1144.2 +006000 02 SECOND-20-CR PICTURE X(20). ST1144.2 +006100 01 TEST-RESULTS. ST1144.2 +006200 02 FILLER PIC X VALUE SPACE. ST1144.2 +006300 02 FEATURE PIC X(20) VALUE SPACE. ST1144.2 +006400 02 FILLER PIC X VALUE SPACE. ST1144.2 +006500 02 P-OR-F PIC X(5) VALUE SPACE. ST1144.2 +006600 02 FILLER PIC X VALUE SPACE. ST1144.2 +006700 02 PAR-NAME. ST1144.2 +006800 03 FILLER PIC X(19) VALUE SPACE. ST1144.2 +006900 03 PARDOT-X PIC X VALUE SPACE. ST1144.2 +007000 03 DOTVALUE PIC 99 VALUE ZERO. ST1144.2 +007100 02 FILLER PIC X(8) VALUE SPACE. ST1144.2 +007200 02 RE-MARK PIC X(61). ST1144.2 +007300 01 TEST-COMPUTED. ST1144.2 +007400 02 FILLER PIC X(30) VALUE SPACE. ST1144.2 +007500 02 FILLER PIC X(17) VALUE ST1144.2 +007600 " COMPUTED=". ST1144.2 +007700 02 COMPUTED-X. ST1144.2 +007800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1144.2 +007900 03 COMPUTED-N REDEFINES COMPUTED-A ST1144.2 +008000 PIC -9(9).9(9). ST1144.2 +008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1144.2 +008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1144.2 +008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1144.2 +008400 03 CM-18V0 REDEFINES COMPUTED-A. ST1144.2 +008500 04 COMPUTED-18V0 PIC -9(18). ST1144.2 +008600 04 FILLER PIC X. ST1144.2 +008700 03 FILLER PIC X(50) VALUE SPACE. ST1144.2 +008800 01 TEST-CORRECT. ST1144.2 +008900 02 FILLER PIC X(30) VALUE SPACE. ST1144.2 +009000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1144.2 +009100 02 CORRECT-X. ST1144.2 +009200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1144.2 +009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1144.2 +009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1144.2 +009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1144.2 +009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1144.2 +009700 03 CR-18V0 REDEFINES CORRECT-A. ST1144.2 +009800 04 CORRECT-18V0 PIC -9(18). ST1144.2 +009900 04 FILLER PIC X. ST1144.2 +010000 03 FILLER PIC X(2) VALUE SPACE. ST1144.2 +010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1144.2 +010200 01 CCVS-C-1. ST1144.2 +010300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1144.2 +010400- "SS PARAGRAPH-NAME ST1144.2 +010500- " REMARKS". ST1144.2 +010600 02 FILLER PIC X(20) VALUE SPACE. ST1144.2 +010700 01 CCVS-C-2. ST1144.2 +010800 02 FILLER PIC X VALUE SPACE. ST1144.2 +010900 02 FILLER PIC X(6) VALUE "TESTED". ST1144.2 +011000 02 FILLER PIC X(15) VALUE SPACE. ST1144.2 +011100 02 FILLER PIC X(4) VALUE "FAIL". ST1144.2 +011200 02 FILLER PIC X(94) VALUE SPACE. ST1144.2 +011300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1144.2 +011400 01 REC-CT PIC 99 VALUE ZERO. ST1144.2 +011500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1144.2 +011600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1144.2 +011700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1144.2 +011800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1144.2 +011900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1144.2 +012000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1144.2 +012100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1144.2 +012200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1144.2 +012300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1144.2 +012400 01 CCVS-H-1. ST1144.2 +012500 02 FILLER PIC X(39) VALUE SPACES. ST1144.2 +012600 02 FILLER PIC X(42) VALUE ST1144.2 +012700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1144.2 +012800 02 FILLER PIC X(39) VALUE SPACES. ST1144.2 +012900 01 CCVS-H-2A. ST1144.2 +013000 02 FILLER PIC X(40) VALUE SPACE. ST1144.2 +013100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1144.2 +013200 02 FILLER PIC XXXX VALUE ST1144.2 +013300 "4.2 ". ST1144.2 +013400 02 FILLER PIC X(28) VALUE ST1144.2 +013500 " COPY - NOT FOR DISTRIBUTION". ST1144.2 +013600 02 FILLER PIC X(41) VALUE SPACE. ST1144.2 +013700 ST1144.2 +013800 01 CCVS-H-2B. ST1144.2 +013900 02 FILLER PIC X(15) VALUE ST1144.2 +014000 "TEST RESULT OF ". ST1144.2 +014100 02 TEST-ID PIC X(9). ST1144.2 +014200 02 FILLER PIC X(4) VALUE ST1144.2 +014300 " IN ". ST1144.2 +014400 02 FILLER PIC X(12) VALUE ST1144.2 +014500 " HIGH ". ST1144.2 +014600 02 FILLER PIC X(22) VALUE ST1144.2 +014700 " LEVEL VALIDATION FOR ". ST1144.2 +014800 02 FILLER PIC X(58) VALUE ST1144.2 +014900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1144.2 +015000 01 CCVS-H-3. ST1144.2 +015100 02 FILLER PIC X(34) VALUE ST1144.2 +015200 " FOR OFFICIAL USE ONLY ". ST1144.2 +015300 02 FILLER PIC X(58) VALUE ST1144.2 +015400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1144.2 +015500 02 FILLER PIC X(28) VALUE ST1144.2 +015600 " COPYRIGHT 1985 ". ST1144.2 +015700 01 CCVS-E-1. ST1144.2 +015800 02 FILLER PIC X(52) VALUE SPACE. ST1144.2 +015900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1144.2 +016000 02 ID-AGAIN PIC X(9). ST1144.2 +016100 02 FILLER PIC X(45) VALUE SPACES. ST1144.2 +016200 01 CCVS-E-2. ST1144.2 +016300 02 FILLER PIC X(31) VALUE SPACE. ST1144.2 +016400 02 FILLER PIC X(21) VALUE SPACE. ST1144.2 +016500 02 CCVS-E-2-2. ST1144.2 +016600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1144.2 +016700 03 FILLER PIC X VALUE SPACE. ST1144.2 +016800 03 ENDER-DESC PIC X(44) VALUE ST1144.2 +016900 "ERRORS ENCOUNTERED". ST1144.2 +017000 01 CCVS-E-3. ST1144.2 +017100 02 FILLER PIC X(22) VALUE ST1144.2 +017200 " FOR OFFICIAL USE ONLY". ST1144.2 +017300 02 FILLER PIC X(12) VALUE SPACE. ST1144.2 +017400 02 FILLER PIC X(58) VALUE ST1144.2 +017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1144.2 +017600 02 FILLER PIC X(13) VALUE SPACE. ST1144.2 +017700 02 FILLER PIC X(15) VALUE ST1144.2 +017800 " COPYRIGHT 1985". ST1144.2 +017900 01 CCVS-E-4. ST1144.2 +018000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1144.2 +018100 02 FILLER PIC X(4) VALUE " OF ". ST1144.2 +018200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1144.2 +018300 02 FILLER PIC X(40) VALUE ST1144.2 +018400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1144.2 +018500 01 XXINFO. ST1144.2 +018600 02 FILLER PIC X(19) VALUE ST1144.2 +018700 "*** INFORMATION ***". ST1144.2 +018800 02 INFO-TEXT. ST1144.2 +018900 04 FILLER PIC X(8) VALUE SPACE. ST1144.2 +019000 04 XXCOMPUTED PIC X(20). ST1144.2 +019100 04 FILLER PIC X(5) VALUE SPACE. ST1144.2 +019200 04 XXCORRECT PIC X(20). ST1144.2 +019300 02 INF-ANSI-REFERENCE PIC X(48). ST1144.2 +019400 01 HYPHEN-LINE. ST1144.2 +019500 02 FILLER PIC IS X VALUE IS SPACE. ST1144.2 +019600 02 FILLER PIC IS X(65) VALUE IS "************************ST1144.2 +019700- "*****************************************". ST1144.2 +019800 02 FILLER PIC IS X(54) VALUE IS "************************ST1144.2 +019900- "******************************". ST1144.2 +020000 01 CCVS-PGM-ID PIC X(9) VALUE ST1144.2 +020100 "ST114M". ST1144.2 +020200 PROCEDURE DIVISION. ST1144.2 +020300 CCVS1 SECTION. ST1144.2 +020400 OPEN-FILES. ST1144.2 +020500 OPEN OUTPUT PRINT-FILE. ST1144.2 +020600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1144.2 +020700 MOVE SPACE TO TEST-RESULTS. ST1144.2 +020800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1144.2 +020900 GO TO CCVS1-EXIT. ST1144.2 +021000 CLOSE-FILES. ST1144.2 +021100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1144.2 +021200 TERMINATE-CCVS. ST1144.2 +021300*S EXIT PROGRAM. ST1144.2 +021400*SERMINATE-CALL. ST1144.2 +021500 STOP RUN. ST1144.2 +021600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1144.2 +021700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1144.2 +021800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1144.2 +021900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1144.2 +022000 MOVE "****TEST DELETED****" TO RE-MARK. ST1144.2 +022100 PRINT-DETAIL. ST1144.2 +022200 IF REC-CT NOT EQUAL TO ZERO ST1144.2 +022300 MOVE "." TO PARDOT-X ST1144.2 +022400 MOVE REC-CT TO DOTVALUE. ST1144.2 +022500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1144.2 +022600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1144.2 +022700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1144.2 +022800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1144.2 +022900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1144.2 +023000 MOVE SPACE TO CORRECT-X. ST1144.2 +023100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1144.2 +023200 MOVE SPACE TO RE-MARK. ST1144.2 +023300 HEAD-ROUTINE. ST1144.2 +023400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +023500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +023600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1144.2 +023700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1144.2 +023800 COLUMN-NAMES-ROUTINE. ST1144.2 +023900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +024000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +024100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +024200 END-ROUTINE. ST1144.2 +024300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1144.2 +024400 END-RTN-EXIT. ST1144.2 +024500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +024600 END-ROUTINE-1. ST1144.2 +024700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1144.2 +024800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1144.2 +024900 ADD PASS-COUNTER TO ERROR-HOLD. ST1144.2 +025000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1144.2 +025100 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1144.2 +025200 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1144.2 +025300 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1144.2 +025400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1144.2 +025500 END-ROUTINE-12. ST1144.2 +025600 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1144.2 +025700 IF ERROR-COUNTER IS EQUAL TO ZERO ST1144.2 +025800 MOVE "NO " TO ERROR-TOTAL ST1144.2 +025900 ELSE ST1144.2 +026000 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1144.2 +026100 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1144.2 +026200 PERFORM WRITE-LINE. ST1144.2 +026300 END-ROUTINE-13. ST1144.2 +026400 IF DELETE-COUNTER IS EQUAL TO ZERO ST1144.2 +026500 MOVE "NO " TO ERROR-TOTAL ELSE ST1144.2 +026600 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1144.2 +026700 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1144.2 +026800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +026900 IF INSPECT-COUNTER EQUAL TO ZERO ST1144.2 +027000 MOVE "NO " TO ERROR-TOTAL ST1144.2 +027100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1144.2 +027200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1144.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +027400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1144.2 +027500 WRITE-LINE. ST1144.2 +027600 ADD 1 TO RECORD-COUNT. ST1144.2 +027700 IF RECORD-COUNT GREATER 42 ST1144.2 +027800 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1144.2 +027900 MOVE SPACE TO DUMMY-RECORD ST1144.2 +028000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1144.2 +028100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1144.2 +028200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1144.2 +028300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1144.2 +028400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1144.2 +028500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1144.2 +028600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1144.2 +028700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1144.2 +028800 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1144.2 +028900 MOVE ZERO TO RECORD-COUNT. ST1144.2 +029000 PERFORM WRT-LN. ST1144.2 +029100 WRT-LN. ST1144.2 +029200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1144.2 +029300 MOVE SPACE TO DUMMY-RECORD. ST1144.2 +029400 BLANK-LINE-PRINT. ST1144.2 +029500 PERFORM WRT-LN. ST1144.2 +029600 FAIL-ROUTINE. ST1144.2 +029700 IF COMPUTED-X NOT EQUAL TO SPACE ST1144.2 +029800 GO TO FAIL-ROUTINE-WRITE. ST1144.2 +029900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1144.2 +030000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1144.2 +030100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1144.2 +030200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +030300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1144.2 +030400 GO TO FAIL-ROUTINE-EX. ST1144.2 +030500 FAIL-ROUTINE-WRITE. ST1144.2 +030600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1144.2 +030700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1144.2 +030800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1144.2 +030900 MOVE SPACES TO COR-ANSI-REFERENCE. ST1144.2 +031000 FAIL-ROUTINE-EX. EXIT. ST1144.2 +031100 BAIL-OUT. ST1144.2 +031200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1144.2 +031300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1144.2 +031400 BAIL-OUT-WRITE. ST1144.2 +031500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1144.2 +031600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1144.2 +031700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1144.2 +031800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1144.2 +031900 BAIL-OUT-EX. EXIT. ST1144.2 +032000 CCVS1-EXIT. ST1144.2 +032100 EXIT. ST1144.2 +032200 SECT-ST114-0001 SECTION. ST1144.2 +032300 ST114-0001-01. ST1144.2 +032400 OPEN INPUT SORTIN-1N. ST1144.2 +032500 MOVE " ************ ST113 WILL NOT PRODUCE ANY PRST1144.2 +032600- "INTED REPORT ************" TO TEST-RESULTS. ST1144.2 +032700 PERFORM PRINT-DETAIL. ST1144.2 +032800 MOVE SPACE TO TEST-RESULTS. ST1144.2 +032900 PERFORM END-ROUTINE. ST1144.2 +033000 PERFORM BLANK-LINE-PRINT. ST1144.2 +033100 SORT-INIT-A. ST1144.2 +033200 MOVE "SORT, MULTIPLE REEL" TO FEATURE. ST1144.2 +033300 SORT-TEST-1. ST1144.2 +033400 MOVE "SORT-TEST-1" TO PAR-NAME. ST1144.2 +033500 PERFORM READ-SORTIN. ST1144.2 +033600 IF SORT-KEY EQUAL TO ALL-Z ST1144.2 +033700 PERFORM PASS GO TO SORT-WRITE-1. ST1144.2 +033800 SORT-FAIL-1. ST1144.2 +033900 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +034000 MOVE ALL-Z TO CORRECT-BREAKDOWN. ST1144.2 +034100 PERFORM BREAKDOWN-PARA. ST1144.2 +034200 SORT-WRITE-1. ST1144.2 +034300 PERFORM PRINT-DETAIL. ST1144.2 +034400 SORT-TEST-2. ST1144.2 +034500 MOVE "SORT-TEST-2" TO PAR-NAME. ST1144.2 +034600 PERFORM READ-SORTIN. ST1144.2 +034700 IF SORT-KEY EQUAL TO ALL-Z ST1144.2 +034800 PERFORM PASS GO TO SORT-WRITE-2. ST1144.2 +034900 SORT-FAIL-2. ST1144.2 +035000 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +035100 MOVE ALL-Z TO CORRECT-BREAKDOWN. ST1144.2 +035200 PERFORM BREAKDOWN-PARA. ST1144.2 +035300 SORT-WRITE-2. ST1144.2 +035400 PERFORM PRINT-DETAIL. ST1144.2 +035500 SORT-TEST-3. ST1144.2 +035600 MOVE "SORT-TEST-3" TO PAR-NAME. ST1144.2 +035700 PERFORM READ-SORTIN. ST1144.2 +035800 IF SORT-KEY EQUAL TO ALL-Z ST1144.2 +035900 PERFORM PASS GO TO SORT-WRITE-3. ST1144.2 +036000 SORT-FAIL-3. ST1144.2 +036100 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +036200 MOVE ALL-Z TO CORRECT-BREAKDOWN. ST1144.2 +036300 PERFORM BREAKDOWN-PARA. ST1144.2 +036400 SORT-WRITE-3. ST1144.2 +036500 PERFORM PRINT-DETAIL. ST1144.2 +036600 SORT-TEST-4. ST1144.2 +036700 MOVE "SORT-TEST-4" TO PAR-NAME. ST1144.2 +036800 PERFORM READ-SORTIN 34 TIMES. ST1144.2 +036900 IF SORT-KEY EQUAL TO ALL-N ST1144.2 +037000 PERFORM PASS GO TO SORT-WRITE-4. ST1144.2 +037100 SORT-FAIL-4. ST1144.2 +037200 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +037300 MOVE ALL-N TO CORRECT-BREAKDOWN. ST1144.2 +037400 PERFORM BREAKDOWN-PARA. ST1144.2 +037500 SORT-WRITE-4. ST1144.2 +037600 PERFORM PRINT-DETAIL. ST1144.2 +037700 SORT-TEST-5. ST1144.2 +037800 MOVE "SORT-TEST-5" TO PAR-NAME. ST1144.2 +037900 PERFORM READ-SORTIN. ST1144.2 +038000 IF SORT-KEY EQUAL TO ALL-N ST1144.2 +038100 PERFORM PASS GO TO SORT-WRITE-5. ST1144.2 +038200 SORT-FAIL-5. ST1144.2 +038300 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +038400 MOVE ALL-N TO CORRECT-BREAKDOWN. ST1144.2 +038500 PERFORM BREAKDOWN-PARA. ST1144.2 +038600 SORT-WRITE-5. ST1144.2 +038700 PERFORM PRINT-DETAIL. ST1144.2 +038800 SORT-TEST-6. ST1144.2 +038900 PERFORM READ-SORTIN. ST1144.2 +039000 MOVE "SORT-TEST-6" TO PAR-NAME. ST1144.2 +039100 IF SORT-KEY EQUAL TO ALL-N ST1144.2 +039200 PERFORM PASS GO TO SORT-WRITE-6. ST1144.2 +039300 SORT-FAIL-6. ST1144.2 +039400 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +039500 MOVE ALL-N TO CORRECT-BREAKDOWN. ST1144.2 +039600 PERFORM BREAKDOWN-PARA. ST1144.2 +039700 SORT-WRITE-6. ST1144.2 +039800 PERFORM PRINT-DETAIL. ST1144.2 +039900 SORT-TEST-7. ST1144.2 +040000 MOVE "SORT-TEST-7" TO PAR-NAME. ST1144.2 +040100 PERFORM READ-SORTIN 37 TIMES. ST1144.2 +040200 IF SORT-KEY EQUAL TO ALL-A ST1144.2 +040300 PERFORM PASS GO TO SORT-WRITE-7. ST1144.2 +040400 SORT-FAIL-7. ST1144.2 +040500 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +040600 MOVE ALL-A TO CORRECT-BREAKDOWN. ST1144.2 +040700 PERFORM BREAKDOWN-PARA. ST1144.2 +040800 SORT-WRITE-7. ST1144.2 +040900 PERFORM PRINT-DETAIL. ST1144.2 +041000 SORT-TEST-8. ST1144.2 +041100 MOVE "SORT-TEST-8" TO PAR-NAME. ST1144.2 +041200 PERFORM READ-SORTIN. ST1144.2 +041300 IF SORT-KEY EQUAL TO ALL-A ST1144.2 +041400 PERFORM PASS GO TO SORT-WRITE-8. ST1144.2 +041500 SORT-FAIL-8. ST1144.2 +041600 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +041700 MOVE ALL-A TO CORRECT-BREAKDOWN. ST1144.2 +041800 PERFORM BREAKDOWN-PARA. ST1144.2 +041900 SORT-WRITE-8. ST1144.2 +042000 PERFORM PRINT-DETAIL. ST1144.2 +042100 SORT-TEST-9. ST1144.2 +042200 MOVE "SORT-TEST-9" TO PAR-NAME. ST1144.2 +042300 PERFORM READ-SORTIN. ST1144.2 +042400 IF SORT-KEY EQUAL TO ALL-A ST1144.2 +042500 PERFORM PASS GO TO SORT-WRITE-9. ST1144.2 +042600 SORT-FAIL-9. ST1144.2 +042700 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +042800 MOVE ALL-A TO CORRECT-BREAKDOWN. ST1144.2 +042900 PERFORM BREAKDOWN-PARA. ST1144.2 +043000 SORT-WRITE-9. ST1144.2 +043100 PERFORM PRINT-DETAIL. ST1144.2 +043200 SORT-TEST-10. ST1144.2 +043300 MOVE "SORT-TEST-10" TO PAR-NAME. ST1144.2 +043400 READ SORTIN-1N AT END ST1144.2 +043500 PERFORM PASS GO TO SORT-WRITE-10. ST1144.2 +043600 SORT-FAIL-10. ST1144.2 +043700 MOVE SORT-KEY TO COMPUTED-BREAKDOWN. ST1144.2 +043800 MOVE SPACE TO CORRECT-BREAKDOWN. ST1144.2 +043900 PERFORM BREAKDOWN-PARA. ST1144.2 +044000 PERFORM PRINT-DETAIL. ST1144.2 +044100 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1144.2 +044200 SORT-WRITE-10. ST1144.2 +044300 PERFORM PRINT-DETAIL. ST1144.2 +044400 CLOSE SORTIN-1N. ST1144.2 +044500 GO TO CCVS-EXIT. ST1144.2 +044600 BREAKDOWN-PARA. ST1144.2 +044700 PERFORM FAIL. ST1144.2 +044800 MOVE FIRST-20-CM TO COMPUTED-A. ST1144.2 +044900 MOVE FIRST-20-CR TO CORRECT-A. ST1144.2 +045000 MOVE "FIRST 20 CHARACTERS" TO RE-MARK. ST1144.2 +045100 PERFORM PRINT-DETAIL. ST1144.2 +045200 MOVE SECOND-20-CM TO COMPUTED-A. ST1144.2 +045300 MOVE SECOND-20-CR TO CORRECT-A. ST1144.2 +045400 MOVE "LAST 13 CHARACTERS" TO RE-MARK. ST1144.2 +045500 READ-SORTIN. ST1144.2 +045600 READ SORTIN-1N AT END GO TO READ-ERROR. ST1144.2 +045700 ADD 1 TO UTIL-CTR. ST1144.2 +045800 READ-ERROR. ST1144.2 +045900 MOVE "READ-SORTIN" TO PAR-NAME. ST1144.2 +046000 PERFORM FAIL. ST1144.2 +046100 MOVE UTIL-CTR TO COMPUTED-N. ST1144.2 +046200 MOVE 78 TO CORRECT-N. ST1144.2 +046300 MOVE "TOO FEW RECORDS IN FILE" TO RE-MARK. ST1144.2 +046400 PERFORM PRINT-DETAIL. ST1144.2 +046500 CCVS-EXIT SECTION. ST1144.2 +046600 CCVS-999999. ST1144.2 +046700 GO TO CLOSE-FILES. ST1144.2 diff --git a/tests/cobol85/ST/ST115A.CBL b/tests/cobol85/ST/ST115A.CBL new file mode 100755 index 00000000..f11646c0 --- /dev/null +++ b/tests/cobol85/ST/ST115A.CBL @@ -0,0 +1,518 @@ +000100 IDENTIFICATION DIVISION. ST1154.2 +000200 PROGRAM-ID. ST1154.2 +000300 ST115A. ST1154.2 +000400**************************************************************** ST1154.2 +000500* * ST1154.2 +000600* VALIDATION FOR:- * ST1154.2 +000700* * ST1154.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1154.2 +000900* * ST1154.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1154.2 +001100* * ST1154.2 +001200**************************************************************** ST1154.2 +001300* * ST1154.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1154.2 +001500* * ST1154.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1154.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1154.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1154.2 +001900* X-XXXP01 SQ-FS1 * ST1154.2 +002000* X-XXX065 4 DIGIT INTEGER FOR THE NUMBER * ST1154.2 +002100* RECORDS IN THE FILE SQ-FS1. * ST1154.2 +002200* * ST1154.2 +002300* * ST1154.2 +002400**************************************************************** ST1154.2 +002500* ST1154.2 +002600* ST1154.2 +002700* OBJECTIVE - ST1154.2 +002800* ROUTINE ST115 BUILDS A SEQUENTIAL FILE SQ-FS1 WHICH ST1154.2 +002900* IS THEN PASSED TO ST116 TO BE SORTED. ST1154.2 +003000* ST1154.2 +003100* ST1154.2 +003200* FEATURES TESTED - ST1154.2 +003300* * FIXED LENGTH RECORDS ST1154.2 +003400* * OCCURS CLAUSES ST1154.2 +003500* ST1154.2 +003600* ST1154.2 +003700* ST1154.2 +003800* FILES USED - ST1154.2 +003900* * FILE SQ-FS1 CAN BE ON MAGNETIC TAPE OR MASS-STORAGE. ST1154.2 +004000* ST1154.2 +004100* SQ-FS1 - ST1154.2 +004200* THE NUMBER OF RECORDS ON SQ-FS1 IS A VARIABLE (X-65). THIS ST1154.2 +004300* NUMBER SHOULD BE LARGE ENOUGH TO FORCE THE SORT ROUTINE ST1154.2 +004400* IN ST116 TO BE NON-CORE RESIDENT. THAT IS FORCE ST1154.2 +004500* THE SYSTEM TO USE SOME MEANS OF AUX. STORAGE FOR THE SORTST1154.2 +004600* SUB-STRINGS. ST1154.2 +004700* FIXED LENGTH RECORDS ( 507 CHARACTERS PER RECORD ) ST1154.2 +004800* BLOCKED 1 ST1154.2 +004900* RESERVE 2 AREAS ST1154.2 +005000* ST1154.2 +005100* ST1154.2 +005200* ST1154.2 +005300* OPTIONS RECOMMENDED - ST1154.2 +005400* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1154.2 +005500* FILE SQ-FS1 ONCE IT HAS BEEN CREATED. ST1154.2 +005600* ST1154.2 +005700* ST1154.2 +005800* TEST DESCRIPTIONS - ST1154.2 +005900* NOT APPLICABLE. ST1154.2 +006000* ST1154.2 +006100* ST1154.2 +006200* ************************************************************ ST1154.2 +006300 ENVIRONMENT DIVISION. ST1154.2 +006400 CONFIGURATION SECTION. ST1154.2 +006500 SOURCE-COMPUTER. ST1154.2 +006600 Linux. ST1154.2 +006700 OBJECT-COMPUTER. ST1154.2 +006800 Linux. ST1154.2 +006900 INPUT-OUTPUT SECTION. ST1154.2 +007000 FILE-CONTROL. ST1154.2 +007100 SELECT PRINT-FILE ASSIGN TO ST1154.2 +007200 "report.log". ST1154.2 +007300 SELECT SQ-FS1 ASSIGN TO ST1154.2 +007400 "XXXXX001" ST1154.2 +007500 ORGANIZATION IS SEQUENTIAL ST1154.2 +007600 ACCESS MODE IS SEQUENTIAL. ST1154.2 +007700 DATA DIVISION. ST1154.2 +007800 FILE SECTION. ST1154.2 +007900 FD PRINT-FILE. ST1154.2 +008000 01 PRINT-REC PICTURE X(120). ST1154.2 +008100 01 DUMMY-RECORD PICTURE X(120). ST1154.2 +008200 FD SQ-FS1 ST1154.2 +008300 LABEL RECORDS STANDARD ST1154.2 +008400*C VALUE OF ST1154.2 +008500*C OCLABELID ST1154.2 +008600*C IS ST1154.2 +008700*C "OCDUMMY" ST1154.2 +008800*G SYSIN ST1154.2 +008900 BLOCK CONTAINS 1 RECORDS ST1154.2 +009000 RECORD CONTAINS 507 CHARACTERS ST1154.2 +009100 DATA RECORD IS SQ-FS1R1-F-G-507. ST1154.2 +009200 01 SQ-FS1R1-F-G-507. ST1154.2 +009300 10 REC-PREAMBLE PIC X(120). ST1154.2 +009400 10 LENGTH-1 PIC 999. ST1154.2 +009500 10 THE-THREE-KEYS. ST1154.2 +009600 20 KEY-1. ST1154.2 +009700 30 ALPHAN-KEY PIC X. ST1154.2 +009800 30 NUM-KEY PIC 999. ST1154.2 +009900 20 KEY-2. ST1154.2 +010000 30 ALPHAN-KEY PIC X. ST1154.2 +010100 30 NUM-KEY PIC 999. ST1154.2 +010200 20 KEY-3. ST1154.2 +010300 30 ALPHAN-KEY PIC X. ST1154.2 +010400 30 NUM-KEY PIC 999. ST1154.2 +010500 10 STUFF-1 OCCURS ST1154.2 +010600 31 TIMES. ST1154.2 +010700 30 FILL-ME-UPS PIC X(12). ST1154.2 +010800 WORKING-STORAGE SECTION. ST1154.2 +010900 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1154.2 +011000 77 WRK-DU-999-0001 PIC 999. ST1154.2 +011100 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1154.2 +011200 77 WRK-DU-999-0002 PIC 999 VALUE 0. ST1154.2 +011300 77 WRK-DU-04V00 PIC 9(4) VALUE ZERO. ST1154.2 +011400*X7 COUNT-OF-RECS PIC 9(6) VALUE ZERO. ST1154.2 +011500 01 WRK-XN-0001 PIC X(51) VALUE ST1154.2 +011600 "/A.Z-B,Y+C*X)D(W$E$V F0U1G2T3H4S5I6R7J8Q9K;PMN". ST1154.2 +011700 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1154.2 +011800 02 CHAR PIC X OCCURS 51 TIMES. ST1154.2 +011900 01 FILE-RECORD-INFORMATION-REC. ST1154.2 +012000 03 FILE-RECORD-INFO-SKELETON. ST1154.2 +012100 05 FILLER PICTURE X(48) VALUE ST1154.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1154.2 +012300 05 FILLER PICTURE X(46) VALUE ST1154.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1154.2 +012500 05 FILLER PICTURE X(26) VALUE ST1154.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". ST1154.2 +012700 05 FILLER PICTURE X(37) VALUE ST1154.2 +012800 ",RECKEY= ". ST1154.2 +012900 05 FILLER PICTURE X(38) VALUE ST1154.2 +013000 ",ALTKEY1= ". ST1154.2 +013100 05 FILLER PICTURE X(38) VALUE ST1154.2 +013200 ",ALTKEY2= ". ST1154.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.ST1154.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1154.2 +013500 05 FILE-RECORD-INFO-P1-120. ST1154.2 +013600 07 FILLER PIC X(5). ST1154.2 +013700 07 XFILE-NAME PIC X(6). ST1154.2 +013800 07 FILLER PIC X(8). ST1154.2 +013900 07 XRECORD-NAME PIC X(6). ST1154.2 +014000 07 FILLER PIC X(1). ST1154.2 +014100 07 REELUNIT-NUMBER PIC 9(1). ST1154.2 +014200 07 FILLER PIC X(7). ST1154.2 +014300 07 XRECORD-NUMBER PIC 9(6). ST1154.2 +014400 07 FILLER PIC X(6). ST1154.2 +014500 07 UPDATE-NUMBER PIC 9(2). ST1154.2 +014600 07 FILLER PIC X(5). ST1154.2 +014700 07 ODO-NUMBER PIC 9(4). ST1154.2 +014800 07 FILLER PIC X(5). ST1154.2 +014900 07 XPROGRAM-NAME PIC X(5). ST1154.2 +015000 07 FILLER PIC X(7). ST1154.2 +015100 07 XRECORD-LENGTH PIC 9(6). ST1154.2 +015200 07 FILLER PIC X(7). ST1154.2 +015300 07 CHARS-OR-RECORDS PIC X(2). ST1154.2 +015400 07 FILLER PIC X(1). ST1154.2 +015500 07 XBLOCK-SIZE PIC 9(4). ST1154.2 +015600 07 FILLER PIC X(6). ST1154.2 +015700 07 RECORDS-IN-FILE PIC 9(6). ST1154.2 +015800 07 FILLER PIC X(5). ST1154.2 +015900 07 XFILE-ORGANIZATION PIC X(2). ST1154.2 +016000 07 FILLER PIC X(6). ST1154.2 +016100 07 XLABEL-TYPE PIC X(1). ST1154.2 +016200 05 FILE-RECORD-INFO-P121-240. ST1154.2 +016300 07 FILLER PIC X(8). ST1154.2 +016400 07 XRECORD-KEY PIC X(29). ST1154.2 +016500 07 FILLER PIC X(9). ST1154.2 +016600 07 ALTERNATE-KEY1 PIC X(29). ST1154.2 +016700 07 FILLER PIC X(9). ST1154.2 +016800 07 ALTERNATE-KEY2 PIC X(29). ST1154.2 +016900 07 FILLER PIC X(7). ST1154.2 +017000 01 TEST-RESULTS. ST1154.2 +017100 02 FILLER PIC X VALUE SPACE. ST1154.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. ST1154.2 +017300 02 FILLER PIC X VALUE SPACE. ST1154.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. ST1154.2 +017500 02 FILLER PIC X VALUE SPACE. ST1154.2 +017600 02 PAR-NAME. ST1154.2 +017700 03 FILLER PIC X(19) VALUE SPACE. ST1154.2 +017800 03 PARDOT-X PIC X VALUE SPACE. ST1154.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. ST1154.2 +018000 02 FILLER PIC X(8) VALUE SPACE. ST1154.2 +018100 02 RE-MARK PIC X(61). ST1154.2 +018200 01 TEST-COMPUTED. ST1154.2 +018300 02 FILLER PIC X(30) VALUE SPACE. ST1154.2 +018400 02 FILLER PIC X(17) VALUE ST1154.2 +018500 " COMPUTED=". ST1154.2 +018600 02 COMPUTED-X. ST1154.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1154.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A ST1154.2 +018900 PIC -9(9).9(9). ST1154.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1154.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1154.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1154.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. ST1154.2 +019400 04 COMPUTED-18V0 PIC -9(18). ST1154.2 +019500 04 FILLER PIC X. ST1154.2 +019600 03 FILLER PIC X(50) VALUE SPACE. ST1154.2 +019700 01 TEST-CORRECT. ST1154.2 +019800 02 FILLER PIC X(30) VALUE SPACE. ST1154.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1154.2 +020000 02 CORRECT-X. ST1154.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1154.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1154.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1154.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1154.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1154.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. ST1154.2 +020700 04 CORRECT-18V0 PIC -9(18). ST1154.2 +020800 04 FILLER PIC X. ST1154.2 +020900 03 FILLER PIC X(2) VALUE SPACE. ST1154.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1154.2 +021100 01 CCVS-C-1. ST1154.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1154.2 +021300- "SS PARAGRAPH-NAME ST1154.2 +021400- " REMARKS". ST1154.2 +021500 02 FILLER PIC X(20) VALUE SPACE. ST1154.2 +021600 01 CCVS-C-2. ST1154.2 +021700 02 FILLER PIC X VALUE SPACE. ST1154.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". ST1154.2 +021900 02 FILLER PIC X(15) VALUE SPACE. ST1154.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". ST1154.2 +022100 02 FILLER PIC X(94) VALUE SPACE. ST1154.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1154.2 +022300 01 REC-CT PIC 99 VALUE ZERO. ST1154.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1154.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1154.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1154.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1154.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1154.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1154.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1154.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1154.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1154.2 +023300 01 CCVS-H-1. ST1154.2 +023400 02 FILLER PIC X(39) VALUE SPACES. ST1154.2 +023500 02 FILLER PIC X(42) VALUE ST1154.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1154.2 +023700 02 FILLER PIC X(39) VALUE SPACES. ST1154.2 +023800 01 CCVS-H-2A. ST1154.2 +023900 02 FILLER PIC X(40) VALUE SPACE. ST1154.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1154.2 +024100 02 FILLER PIC XXXX VALUE ST1154.2 +024200 "4.2 ". ST1154.2 +024300 02 FILLER PIC X(28) VALUE ST1154.2 +024400 " COPY - NOT FOR DISTRIBUTION". ST1154.2 +024500 02 FILLER PIC X(41) VALUE SPACE. ST1154.2 +024600 ST1154.2 +024700 01 CCVS-H-2B. ST1154.2 +024800 02 FILLER PIC X(15) VALUE ST1154.2 +024900 "TEST RESULT OF ". ST1154.2 +025000 02 TEST-ID PIC X(9). ST1154.2 +025100 02 FILLER PIC X(4) VALUE ST1154.2 +025200 " IN ". ST1154.2 +025300 02 FILLER PIC X(12) VALUE ST1154.2 +025400 " HIGH ". ST1154.2 +025500 02 FILLER PIC X(22) VALUE ST1154.2 +025600 " LEVEL VALIDATION FOR ". ST1154.2 +025700 02 FILLER PIC X(58) VALUE ST1154.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1154.2 +025900 01 CCVS-H-3. ST1154.2 +026000 02 FILLER PIC X(34) VALUE ST1154.2 +026100 " FOR OFFICIAL USE ONLY ". ST1154.2 +026200 02 FILLER PIC X(58) VALUE ST1154.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1154.2 +026400 02 FILLER PIC X(28) VALUE ST1154.2 +026500 " COPYRIGHT 1985 ". ST1154.2 +026600 01 CCVS-E-1. ST1154.2 +026700 02 FILLER PIC X(52) VALUE SPACE. ST1154.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1154.2 +026900 02 ID-AGAIN PIC X(9). ST1154.2 +027000 02 FILLER PIC X(45) VALUE SPACES. ST1154.2 +027100 01 CCVS-E-2. ST1154.2 +027200 02 FILLER PIC X(31) VALUE SPACE. ST1154.2 +027300 02 FILLER PIC X(21) VALUE SPACE. ST1154.2 +027400 02 CCVS-E-2-2. ST1154.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1154.2 +027600 03 FILLER PIC X VALUE SPACE. ST1154.2 +027700 03 ENDER-DESC PIC X(44) VALUE ST1154.2 +027800 "ERRORS ENCOUNTERED". ST1154.2 +027900 01 CCVS-E-3. ST1154.2 +028000 02 FILLER PIC X(22) VALUE ST1154.2 +028100 " FOR OFFICIAL USE ONLY". ST1154.2 +028200 02 FILLER PIC X(12) VALUE SPACE. ST1154.2 +028300 02 FILLER PIC X(58) VALUE ST1154.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1154.2 +028500 02 FILLER PIC X(13) VALUE SPACE. ST1154.2 +028600 02 FILLER PIC X(15) VALUE ST1154.2 +028700 " COPYRIGHT 1985". ST1154.2 +028800 01 CCVS-E-4. ST1154.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1154.2 +029000 02 FILLER PIC X(4) VALUE " OF ". ST1154.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1154.2 +029200 02 FILLER PIC X(40) VALUE ST1154.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1154.2 +029400 01 XXINFO. ST1154.2 +029500 02 FILLER PIC X(19) VALUE ST1154.2 +029600 "*** INFORMATION ***". ST1154.2 +029700 02 INFO-TEXT. ST1154.2 +029800 04 FILLER PIC X(8) VALUE SPACE. ST1154.2 +029900 04 XXCOMPUTED PIC X(20). ST1154.2 +030000 04 FILLER PIC X(5) VALUE SPACE. ST1154.2 +030100 04 XXCORRECT PIC X(20). ST1154.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). ST1154.2 +030300 01 HYPHEN-LINE. ST1154.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. ST1154.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************ST1154.2 +030600- "*****************************************". ST1154.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************ST1154.2 +030800- "******************************". ST1154.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE ST1154.2 +031000 "ST115A". ST1154.2 +031100 PROCEDURE DIVISION. ST1154.2 +031200 CCVS1 SECTION. ST1154.2 +031300 OPEN-FILES. ST1154.2 +031400 OPEN OUTPUT PRINT-FILE. ST1154.2 +031500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1154.2 +031600 MOVE SPACE TO TEST-RESULTS. ST1154.2 +031700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1154.2 +031800 MOVE ZERO TO REC-SKL-SUB. ST1154.2 +031900 PERFORM CCVS-INIT-FILE 9 TIMES. ST1154.2 +032000 CCVS-INIT-FILE. ST1154.2 +032100 ADD 1 TO REC-SKL-SUB. ST1154.2 +032200 MOVE FILE-RECORD-INFO-SKELETON ST1154.2 +032300 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1154.2 +032400 CCVS-INIT-EXIT. ST1154.2 +032500 GO TO CCVS1-EXIT. ST1154.2 +032600 CLOSE-FILES. ST1154.2 +032700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1154.2 +032800 TERMINATE-CCVS. ST1154.2 +032900*S EXIT PROGRAM. ST1154.2 +033000*SERMINATE-CALL. ST1154.2 +033100 STOP RUN. ST1154.2 +033200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1154.2 +033300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1154.2 +033400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1154.2 +033500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1154.2 +033600 MOVE "****TEST DELETED****" TO RE-MARK. ST1154.2 +033700 PRINT-DETAIL. ST1154.2 +033800 IF REC-CT NOT EQUAL TO ZERO ST1154.2 +033900 MOVE "." TO PARDOT-X ST1154.2 +034000 MOVE REC-CT TO DOTVALUE. ST1154.2 +034100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1154.2 +034200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1154.2 +034300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1154.2 +034400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1154.2 +034500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1154.2 +034600 MOVE SPACE TO CORRECT-X. ST1154.2 +034700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1154.2 +034800 MOVE SPACE TO RE-MARK. ST1154.2 +034900 HEAD-ROUTINE. ST1154.2 +035000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +035100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +035200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1154.2 +035300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1154.2 +035400 COLUMN-NAMES-ROUTINE. ST1154.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +035800 END-ROUTINE. ST1154.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1154.2 +036000 END-RTN-EXIT. ST1154.2 +036100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +036200 END-ROUTINE-1. ST1154.2 +036300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1154.2 +036400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1154.2 +036500 ADD PASS-COUNTER TO ERROR-HOLD. ST1154.2 +036600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1154.2 +036700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1154.2 +036800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1154.2 +036900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1154.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1154.2 +037100 END-ROUTINE-12. ST1154.2 +037200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1154.2 +037300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1154.2 +037400 MOVE "NO " TO ERROR-TOTAL ST1154.2 +037500 ELSE ST1154.2 +037600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1154.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1154.2 +037800 PERFORM WRITE-LINE. ST1154.2 +037900 END-ROUTINE-13. ST1154.2 +038000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1154.2 +038100 MOVE "NO " TO ERROR-TOTAL ELSE ST1154.2 +038200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1154.2 +038300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1154.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +038500 IF INSPECT-COUNTER EQUAL TO ZERO ST1154.2 +038600 MOVE "NO " TO ERROR-TOTAL ST1154.2 +038700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1154.2 +038800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1154.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +039000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1154.2 +039100 WRITE-LINE. ST1154.2 +039200 ADD 1 TO RECORD-COUNT. ST1154.2 +039300 IF RECORD-COUNT GREATER 42 ST1154.2 +039400 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1154.2 +039500 MOVE SPACE TO DUMMY-RECORD ST1154.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1154.2 +039700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1154.2 +039800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1154.2 +039900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1154.2 +040000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1154.2 +040100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1154.2 +040200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1154.2 +040300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1154.2 +040400 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1154.2 +040500 MOVE ZERO TO RECORD-COUNT. ST1154.2 +040600 PERFORM WRT-LN. ST1154.2 +040700 WRT-LN. ST1154.2 +040800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1154.2 +040900 MOVE SPACE TO DUMMY-RECORD. ST1154.2 +041000 BLANK-LINE-PRINT. ST1154.2 +041100 PERFORM WRT-LN. ST1154.2 +041200 FAIL-ROUTINE. ST1154.2 +041300 IF COMPUTED-X NOT EQUAL TO SPACE ST1154.2 +041400 GO TO FAIL-ROUTINE-WRITE. ST1154.2 +041500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1154.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1154.2 +041700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1154.2 +041800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +041900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1154.2 +042000 GO TO FAIL-ROUTINE-EX. ST1154.2 +042100 FAIL-ROUTINE-WRITE. ST1154.2 +042200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1154.2 +042300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1154.2 +042400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1154.2 +042500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1154.2 +042600 FAIL-ROUTINE-EX. EXIT. ST1154.2 +042700 BAIL-OUT. ST1154.2 +042800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1154.2 +042900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1154.2 +043000 BAIL-OUT-WRITE. ST1154.2 +043100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1154.2 +043200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1154.2 +043300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1154.2 +043400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1154.2 +043500 BAIL-OUT-EX. EXIT. ST1154.2 +043600 CCVS1-EXIT. ST1154.2 +043700 EXIT. ST1154.2 +043800 SECT-ST115-0001 SECTION. ST1154.2 +043900 SRT-INIT-001. ST1154.2 +044000 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1154.2 +044100 OPEN OUTPUT SQ-FS1. ST1154.2 +044200 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1154.2 +044300 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1154.2 +044400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1154.2 +044500 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1154.2 +044600 MOVE 0001 TO XBLOCK-SIZE (1). ST1154.2 +044700 MOVE ST1154.2 +044800 1000 ST1154.2 +044900 TO RECORDS-IN-FILE (1). ST1154.2 +045000 MOVE 507 TO XRECORD-LENGTH (1). ST1154.2 +045100 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1154.2 +045200 MOVE "S" TO XLABEL-TYPE (1). ST1154.2 +045300 MOVE 000000 TO XRECORD-NUMBER (1). ST1154.2 +045400 SRT-TEST-001. ST1154.2 +045500 MOVE 001 TO WRK-DU-999-0001. ST1154.2 +045600 MOVE 1 TO WRK-DU-04V00. ST1154.2 +045700 SRT-TEST-001-01. ST1154.2 +045800 PERFORM SRT-TEST-001-BUILD. ST1154.2 +045900 ADD 1 TO WRK-DU-04V00. ST1154.2 +046000 IF WRK-DU-04V00 IS GREATER THAN ST1154.2 +046100 1000 ST1154.2 +046200 GO TO SRT-WRITE-001. ST1154.2 +046300 GO TO SRT-TEST-001-01. ST1154.2 +046400 SRT-TEST-001-BUILD. ST1154.2 +046500 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-1 ST1154.2 +046600 ALPHAN-KEY OF KEY-2 ALPHAN-KEY OF KEY-3. ST1154.2 +046700 MOVE WRK-DU-04V00 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1154.2 +046800 NUM-KEY OF KEY-3. ST1154.2 +046900 MOVE 507 TO LENGTH-1. ST1154.2 +047000 PERFORM PAD-THE-RECORD-LENGTH VARYING WRK-DU-999-0002 ST1154.2 +047100 FROM 1 BY 1 UNTIL WRK-DU-999-0002 IS GREATER THAN ST1154.2 +047200 31. ST1154.2 +047300 ADD 1 TO XRECORD-NUMBER (1). ST1154.2 +047400 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1154.2 +047500 ADD 001 TO WRK-DU-999-0001. ST1154.2 +047600 IF WRK-DU-999-0001 IS GREATER THAN 51 ST1154.2 +047700 MOVE 001 TO WRK-DU-999-0001. ST1154.2 +047800 WRITE SQ-FS1R1-F-G-507. ST1154.2 +047900 PAD-THE-RECORD-LENGTH. ST1154.2 +048000 MOVE THE-THREE-KEYS TO STUFF-1 (WRK-DU-999-0002). ST1154.2 +048100 SRT-DELETE-001. ST1154.2 +048200 PERFORM DE-LETE. ST1154.2 +048300 SRT-WRITE-001. ST1154.2 +048400 MOVE "FILE-CREATE" TO PAR-NAME. ST1154.2 +048500 MOVE "SQ-FS1 FILE CREATED" TO COMPUTED-A. ST1154.2 +048600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1154.2 +048700 MOVE "PASSED TO ST116 FOR SORTING" TO RE-MARK. ST1154.2 +048800 PERFORM PRINT-DETAIL. ST1154.2 +048900 MOVE " ************ ST116 WILL NOT PRODUCE ANY PRST1154.2 +049000- "INTED REPORT ************" TO PRINT-REC. ST1154.2 +049100 WRITE PRINT-REC AFTER ADVANCING 1 LINES. ST1154.2 +049200 CLOSE SQ-FS1. ST1154.2 +049300*XILEDUMP SECTION. ST1154.2 +049400*XILE-1-DUMP-INIT. ST1154.2 +049500*X OPEN INPUT SQ-FS1. ST1154.2 +049600*X MOVE ZERO TO COUNT-OF-RECS. ST1154.2 +049700*XILE-1-DUMP. ST1154.2 +049800*X READ SQ-FS1 RECORD ST1154.2 +049900*X AT END GO TO FILE-1-DUMP-END. ST1154.2 +050000*X ADD 1 TO COUNT-OF-RECS. ST1154.2 +050100*X IF COUNT-OF-RECS GREATER THAN ST1154.2 +050200*X 1000 ST1154.2 +050300*X GO TO FILE-1-DUMP-END. ST1154.2 +050400*X PERFORM FILE-1-DUMP-WRITE. ST1154.2 +050500*X GO TO FILE-1-DUMP. ST1154.2 +050600*XILE-1-DUMP-WRITE. ST1154.2 +050700*X MOVE SQ-FS1R1-F-G-507 TO DUMMY-RECORD. ST1154.2 +050800*X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1154.2 +050900*XILE-1-DUMP-END. ST1154.2 +051000*X MOVE " SQ-FS1 RECORDS TO SORTED BY ST116 SHOWN BELOW" ST1154.2 +051100*X TO DUMMY-RECORD. ST1154.2 +051200*X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1154.2 +051300*X MOVE COUNT-OF-RECS TO DUMMY-RECORD. ST1154.2 +051400*X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1154.2 +051500*X CLOSE SQ-FS1. ST1154.2 +051600 CCVS-EXIT SECTION. ST1154.2 +051700 CCVS-999999. ST1154.2 +051800 GO TO CLOSE-FILES. ST1154.2 diff --git a/tests/cobol85/ST/ST116A.SUB b/tests/cobol85/ST/ST116A.SUB new file mode 100755 index 00000000..e85c97d3 --- /dev/null +++ b/tests/cobol85/ST/ST116A.SUB @@ -0,0 +1,184 @@ +000100 IDENTIFICATION DIVISION. ST1164.2 +000200 PROGRAM-ID. ST1164.2 +000300 ST116A. ST1164.2 +000400**************************************************************** ST1164.2 +000500* * ST1164.2 +000600* VALIDATION FOR:- * ST1164.2 +000700* * ST1164.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1164.2 +000900* * ST1164.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1164.2 +001100* * ST1164.2 +001200**************************************************************** ST1164.2 +001300* * ST1164.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1164.2 +001500* * ST1164.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1164.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1164.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1164.2 +001900* X-XXXD01 - SQ-FS1 * ST1164.2 +002000* X-XXXP02 - SQ-FS2 * ST1164.2 +002100* X-XXX027 - SORT FILE ST-FS1 * ST1164.2 +002200* * ST1164.2 +002300**************************************************************** ST1164.2 +002400******************************************************************ST1164.2 +002500* ST1164.2 +002600* ST1164.2 +002700* ST116 ST1164.2 +002800* ST1164.2 +002900* ST1164.2 +003000* OBJECTIVE - ST1164.2 +003100* ROUTINE ST116 IS A TEST OF THE SORT STATEMENT USING ST1164.2 +003200* FIXED LENGTH RECORDS ( 507 CHARACTERS PER RECORD ). ST1164.2 +003300* ST1164.2 +003400* ST1164.2 +003500* FEATURES TESTED - ST1164.2 +003600* * COLLATING SEQUENCE IS NATIVE. NO COLLATING SEQUENCE ST1164.2 +003700* STATEMENT IS USED IN THE ACTUAL SORT STATEMENT. ST1164.2 +003800* * FIXED LENGTH RECORDS ST1164.2 +003900* * OCCURS CLAUSES ST1164.2 +004000* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1164.2 +004100* ST1164.2 +004200* * SORT SORT-FILE-NAME ST1164.2 +004300* ON ASCENDING KEY KEY-1 OF DATA-NAME-1 ST1164.2 +004400* ASCENDING KEY-2 OF DATA-NAME-2 ST1164.2 +004500* USING FILE-NAME-1 ST1164.2 +004600* GIVING FILE-NAME-2. ST1164.2 +004700* ST1164.2 +004800* ST1164.2 +004900* ANSI X3.23-1974 REFERENCES - ST1164.2 +005000* * SECTION 4.4 THE SORT STATEMENT PAGE VII-14 ST1164.2 +005100* ST1164.2 +005200* ST1164.2 +005300* FILES USED - ST1164.2 +005400* * FILES SQ-FS1 AND SQ-FS2 ON MAGNETIC TAPE OR MASS-STORAGE ST1164.2 +005500* ST1164.2 +005600* FILE SQ-FS1 IS CREATED IN ST115 AND PASSED TO ST116. THE ST1164.2 +005700* FILE SQ-FS2 IS PASSED TO ROUTINE ST117 FOR CHECKING. ST1164.2 +005800* ST1164.2 +005900* SQ-FS1 - ST1164.2 +006000* NUMBER OF RECORDS IS SET BY THE INTEGER X-65. ST1164.2 +006100* FIXED LENGTH ( 507 CHARACTERS PER RECORD ) ST1164.2 +006200* BLOCKED 1 ST1164.2 +006300* RESERVE 2 AREAS ST1164.2 +006400* ST1164.2 +006500* SQ-FS1 IS SORTED GIVING SQ-FS2. ST1164.2 +006600* ST1164.2 +006700* SQ-FS2 - ST1164.2 +006800* SAME NUMBER OF RECORDS AS IN SQ-FS1 ( SET BY X-65 ) ST1164.2 +006900* FIXED LENGTH ( 507 CHARACTERS PER RECORD ) ST1164.2 +007000* BLOCKED 2 ST1164.2 +007100* RESERVE 4 AREAS ST1164.2 +007200* ST1164.2 +007300* ST1164.2 +007400* ST1164.2 +007500* ST1164.2 +007600* OPTIONS RECOMMENDED - ST1164.2 +007700* NOT APPLICABLE. ST1164.2 +007800* ST1164.2 +007900* ST1164.2 +008000* TEST DESCRIPTIONS - ST1164.2 +008100* NOT APPLICABLE. ROUTINE ST116 ONLY CONTAINS THE SORT. ST1164.2 +008200* ST1164.2 +008300* ST1164.2 +008400* ************************************************************ ST1164.2 +008500 ENVIRONMENT DIVISION. ST1164.2 +008600 CONFIGURATION SECTION. ST1164.2 +008700 SOURCE-COMPUTER. ST1164.2 +008800 Linux. ST1164.2 +008900 OBJECT-COMPUTER. ST1164.2 +009000 Linux. ST1164.2 +009100 INPUT-OUTPUT SECTION. ST1164.2 +009200 FILE-CONTROL. ST1164.2 +009300 SELECT SQ-FS1 ASSIGN TO ST1164.2 +009400 "XXXXX001" ST1164.2 +009500 ORGANIZATION IS SEQUENTIAL ST1164.2 +009600 ACCESS MODE IS SEQUENTIAL. ST1164.2 +009700 SELECT SQ-FS2 ASSIGN TO ST1164.2 +009800 "XXXXX002" ST1164.2 +009900 ORGANIZATION IS SEQUENTIAL ST1164.2 +010000 ACCESS MODE IS SEQUENTIAL. ST1164.2 +010100 SELECT ST-FS1 ASSIGN TO ST1164.2 +010200 "XXXXX027". ST1164.2 +010300 DATA DIVISION. ST1164.2 +010400 FILE SECTION. ST1164.2 +010500 FD SQ-FS1 ST1164.2 +010600 LABEL RECORDS STANDARD ST1164.2 +010700*C VALUE OF ST1164.2 +010800*C OCLABELID ST1164.2 +010900*C IS ST1164.2 +011000*C "OCDUMMY" ST1164.2 +011100*G SYSIN ST1164.2 +011200 BLOCK CONTAINS 1 RECORDS ST1164.2 +011300 RECORD CONTAINS 507 CHARACTERS ST1164.2 +011400 DATA RECORD IS SQ-FS1R1-F-G-507. ST1164.2 +011500 01 SQ-FS1R1-F-G-507. ST1164.2 +011600 10 REC-PREAMBLE PIC X(120). ST1164.2 +011700 10 LENGTH-1 PIC 999. ST1164.2 +011800 10 THE-THREE-KEYS. ST1164.2 +011900 20 KEY-1. ST1164.2 +012000 30 ALPHAN-KEY PIC X. ST1164.2 +012100 30 NUM-KEY PIC 999. ST1164.2 +012200 20 KEY-2. ST1164.2 +012300 30 ALPHAN-KEY PIC X. ST1164.2 +012400 30 NUM-KEY PIC 999. ST1164.2 +012500 20 KEY-3. ST1164.2 +012600 30 ALPHAN-KEY PIC X. ST1164.2 +012700 30 NUM-KEY PIC 999. ST1164.2 +012800 10 STUFF-1 OCCURS ST1164.2 +012900 31 TIMES. ST1164.2 +013000 30 FILL-ME-UPS PIC X(12). ST1164.2 +013100 FD SQ-FS2 ST1164.2 +013200 LABEL RECORDS STANDARD ST1164.2 +013300*C VALUE OF ST1164.2 +013400*C OCLABELID ST1164.2 +013500*C IS ST1164.2 +013600*C "OCDUMMY" ST1164.2 +013700*G SYSIN ST1164.2 +013800 BLOCK CONTAINS 2 RECORDS ST1164.2 +013900 RECORD CONTAINS 507 CHARACTERS ST1164.2 +014000 DATA RECORD IS SQ-FS2R1-F-G-507. ST1164.2 +014100 01 SQ-FS2R1-F-G-507. ST1164.2 +014200 10 REC-PRE-2 PIC X(120). ST1164.2 +014300 10 LENGTH-2 PIC 999. ST1164.2 +014400 10 THE-NEW-KEYS. ST1164.2 +014500 20 KEY-4. ST1164.2 +014600 30 ALPHAN-KEY PIC X. ST1164.2 +014700 30 NUM-KEY PIC 999. ST1164.2 +014800 20 KEY-5. ST1164.2 +014900 30 ALPHAN-KEY PIC X. ST1164.2 +015000 30 NUM-KEY PIC 999. ST1164.2 +015100 20 KEY-6. ST1164.2 +015200 30 ALPHAN-KEY PIC X. ST1164.2 +015300 30 NUM-KEY PIC 999. ST1164.2 +015400 10 STUFF-2 OCCURS ST1164.2 +015500 31 TIMES. ST1164.2 +015600 30 FILLER PIC X(12). ST1164.2 +015700 SD ST-FS1 ST1164.2 +015800 RECORD CONTAINS 507 CHARACTERS ST1164.2 +015900 DATA RECORD IS ST-FS1R1-F-G-507. ST1164.2 +016000 01 ST-FS1R1-F-G-507. ST1164.2 +016100 02 FILLER PIC X(120). ST1164.2 +016200 02 LENGTH-3 PIC 999. ST1164.2 +016300 02 NON-KEY-1. ST1164.2 +016400 03 A-KEY-NK1 PIC X. ST1164.2 +016500 03 N-KEY-NK1 PIC 999. ST1164.2 +016600 02 SORT-KEY. ST1164.2 +016700 03 A-KEY-SK PIC X. ST1164.2 +016800 03 N-KEY-SK PIC 999. ST1164.2 +016900 02 NON-KEY-2. ST1164.2 +017000 03 A-KEY-NK2 PIC X. ST1164.2 +017100 03 N-KEY-NK2 PIC 999. ST1164.2 +017200 02 STUFF-3 OCCURS ST1164.2 +017300 31 TIMES. ST1164.2 +017400 03 FILLER PIC X(12). ST1164.2 +017500 PROCEDURE DIVISION. ST1164.2 +017600 SECT-ST116-0001 SECTION. ST1164.2 +017700 SRT-INIT-001. ST1164.2 +017800 SORT ST-FS1 ST1164.2 +017900 ON ASCENDING KEY A-KEY-SK ST1164.2 +018000 ASCENDING N-KEY-NK2 ST1164.2 +018100 USING SQ-FS1 ST1164.2 +018200 GIVING SQ-FS2. ST1164.2 +018300 STOP-THE-RUN. ST1164.2 +018400 STOP RUN. ST1164.2 diff --git a/tests/cobol85/ST/ST117A.SUB b/tests/cobol85/ST/ST117A.SUB new file mode 100755 index 00000000..1466e039 --- /dev/null +++ b/tests/cobol85/ST/ST117A.SUB @@ -0,0 +1,550 @@ +000100 IDENTIFICATION DIVISION. ST1174.2 +000200 PROGRAM-ID. ST1174.2 +000300 ST117A. ST1174.2 +000400**************************************************************** ST1174.2 +000500* * ST1174.2 +000600* VALIDATION FOR:- * ST1174.2 +000700* * ST1174.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2 +000900* * ST1174.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1174.2 +001100* * ST1174.2 +001200**************************************************************** ST1174.2 +001300* * ST1174.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1174.2 +001500* * ST1174.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1174.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1174.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1174.2 +001900* * ST1174.2 +002000**************************************************************** ST1174.2 +002100* ST1174.2 +002200* ST1174.2 +002300* ST117 ST1174.2 +002400* ST1174.2 +002500* ST1174.2 +002600* OBJECTIVE - ST1174.2 +002700* ROUTINE ST117 CHECKS THE FILE ( SQ-FS2 ) WHICH IS GIVEN ST1174.2 +002800* BY THE SORT IN ST116. THE ALPHANUMERIC KEYS AND NUMERIC KEYSST1174.2 +002900* ARE BOTH CHECKED BY ST117. ST1174.2 +003000* ST1174.2 +003100* ST1174.2 +003200* FEATURES TESTED - ST1174.2 +003300* * FIXED LENGTH RECORDS ST1174.2 +003400* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1174.2 +003500* ST1174.2 +003600* ST1174.2 +003700* ST1174.2 +003800* ANSI X3.23-1974 REFERENCES - ST1174.2 +003900* * SECTION 4.4 THE SORT STATEMENT PAGE VII-14 ST1174.2 +004000* ST1174.2 +004100* ST1174.2 +004200* FILES USED - ST1174.2 +004300* * FILE SQ-FS2 CAN BE ON MAGNETIC TAPE OR MASS-STORAGE. ST1174.2 +004400* ST1174.2 +004500* SQ-FS2 - ST1174.2 +004600* NUMBER OF RECORDS IS SET IN X-65 ST1174.2 +004700* FIXED LENGTH ( 507 CHARACTERS PER RECORD ) ST1174.2 +004800* BLOCKED 2 ST1174.2 +004900* RESERVE 4 AREAS ST1174.2 +005000* ST1174.2 +005100* ST1174.2 +005200* X-CARDS USED - ST1174.2 +005300* X-XXXD02 SQ-FS2 ST1174.2 +005400* X-XXX063 NATIVE COLLATING SEQUENCE ASCENDING ORDER (NOTE ST1174.2 +005500* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-63 ST1174.2 +005600* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1174.2 +005700* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1174.2 +005800* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1174.2 +005900* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-63 CARD..... ST1174.2 +006000* ST1174.2 +006100* X-63 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1174.2 +006200* ST1174.2 +006300* X-XXX065 4 DIGIT INTEGER FOR THE NUMBER OF RECORDS IN ST1174.2 +006400* THE FILE SQ-FS2. ST1174.2 +006500* ST1174.2 +006600* ST1174.2 +006700* OPTIONS RECOMMENDED - ST1174.2 +006800* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1174.2 +006900* FILE SQ-FS2. ST1174.2 +007000* ST1174.2 +007100* ST1174.2 +007200* TEST DESCRIPTIONS - ST1174.2 +007300* THE INTEGER X-65 IS DIVIDED BY 51. THIS IS THE NUMBER ST1174.2 +007400* OF DUPLICATE RECORD KEYS THAT ARE EXPECTED IN SQ-FS2. THESE ST1174.2 +007500* KEYS SHOULD BE THE LOWEST CHARACTER IN THE NATIVE COLLATING ST1174.2 +007600* SEQUENCE. ALL OF THE NUMERIC KEYS FOR THESE RECORDS SHOULD ST1174.2 +007700* BE IN ASCENDING ORDER. ST1174.2 +007800* ST1174.2 +007900* ST1174.2 +008000* ************************************************************ ST1174.2 +008100 ENVIRONMENT DIVISION. ST1174.2 +008200 CONFIGURATION SECTION. ST1174.2 +008300 SOURCE-COMPUTER. ST1174.2 +008400 Linux. ST1174.2 +008500 OBJECT-COMPUTER. ST1174.2 +008600 Linux. ST1174.2 +008700 INPUT-OUTPUT SECTION. ST1174.2 +008800 FILE-CONTROL. ST1174.2 +008900 SELECT PRINT-FILE ASSIGN TO ST1174.2 +009000 "report.log". ST1174.2 +009100 SELECT SQ-FS2 ASSIGN TO ST1174.2 +009200 "XXXXX002" ST1174.2 +009300 ORGANIZATION IS SEQUENTIAL ST1174.2 +009400 ACCESS MODE IS SEQUENTIAL. ST1174.2 +009500 DATA DIVISION. ST1174.2 +009600 FILE SECTION. ST1174.2 +009700 FD PRINT-FILE. ST1174.2 +009800 01 PRINT-REC PICTURE X(120). ST1174.2 +009900 01 DUMMY-RECORD PICTURE X(120). ST1174.2 +010000 FD SQ-FS2 ST1174.2 +010100 LABEL RECORDS STANDARD ST1174.2 +010200*C VALUE OF ST1174.2 +010300*C OCLABELID ST1174.2 +010400*C IS ST1174.2 +010500*C "OCDUMMY" ST1174.2 +010600*G SYSIN ST1174.2 +010700 BLOCK CONTAINS 2 RECORDS ST1174.2 +010800 RECORD CONTAINS 507 CHARACTERS ST1174.2 +010900 DATA RECORD SQ-FS2R1-F-G-507. ST1174.2 +011000 01 SQ-FS2R1-F-G-507. ST1174.2 +011100 10 REC-PRE-2 PIC X(120). ST1174.2 +011200 10 LENGTH-2 PIC 999. ST1174.2 +011300 10 THOSE-LOVABLE-KEYS. ST1174.2 +011400 20 KEY-4. ST1174.2 +011500 30 ALPHAN-KEY-K4 PIC X. ST1174.2 +011600 30 NUM-KEY-K4 PIC 999. ST1174.2 +011700 20 KEY-5. ST1174.2 +011800 30 ALPHAN-KEY-K5 PIC X. ST1174.2 +011900 30 NUM-KEY-K5 PIC 999. ST1174.2 +012000 20 KEY-6. ST1174.2 +012100 30 ALPHAN-KEY-K6 PIC X. ST1174.2 +012200 30 NUM-KEY-K6 PIC 999. ST1174.2 +012300 10 STUFF-FOR-FUN OCCURS ST1174.2 +012400 31 TIMES. ST1174.2 +012500 30 FILLER PIC X(12). ST1174.2 +012600 WORKING-STORAGE SECTION. ST1174.2 +012700 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1174.2 +012800 77 WRK-DU-9-2 PIC 9 VALUE 0. ST1174.2 +012900 77 WRK-DU-999-0001 PIC 999. ST1174.2 +013000 77 WRK-DU-999-2 PIC 999 VALUE 000. ST1174.2 +013100 77 WRK-DU-999-3 PIC 999 VALUE ZERO. ST1174.2 +013200 77 NUMBER-OF-SETS PIC 999 VALUE ZERO. ST1174.2 +013300*X7 COUNT-OF-RECS PIC 9(6) VALUE ZERO. ST1174.2 +013400 01 WRK-XN-2 PIC X(51) VALUE ST1174.2 +013500 " * G BAIRD, USNAVY ". ST1174.2 +013600 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1174.2 +013700 02 ANSWER PIC X OCCURS 51 TIMES. ST1174.2 +013800 01 FILE-RECORD-INFORMATION-REC. ST1174.2 +013900 03 FILE-RECORD-INFO-SKELETON. ST1174.2 +014000 05 FILLER PICTURE X(48) VALUE ST1174.2 +014100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1174.2 +014200 05 FILLER PICTURE X(46) VALUE ST1174.2 +014300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1174.2 +014400 05 FILLER PICTURE X(26) VALUE ST1174.2 +014500 ",LFIL=000000,ORG= ,LBLR= ". ST1174.2 +014600 05 FILLER PICTURE X(37) VALUE ST1174.2 +014700 ",RECKEY= ". ST1174.2 +014800 05 FILLER PICTURE X(38) VALUE ST1174.2 +014900 ",ALTKEY1= ". ST1174.2 +015000 05 FILLER PICTURE X(38) VALUE ST1174.2 +015100 ",ALTKEY2= ". ST1174.2 +015200 05 FILLER PICTURE X(7) VALUE SPACE.ST1174.2 +015300 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1174.2 +015400 05 FILE-RECORD-INFO-P1-120. ST1174.2 +015500 07 FILLER PIC X(5). ST1174.2 +015600 07 XFILE-NAME PIC X(6). ST1174.2 +015700 07 FILLER PIC X(8). ST1174.2 +015800 07 XRECORD-NAME PIC X(6). ST1174.2 +015900 07 FILLER PIC X(1). ST1174.2 +016000 07 REELUNIT-NUMBER PIC 9(1). ST1174.2 +016100 07 FILLER PIC X(7). ST1174.2 +016200 07 XRECORD-NUMBER PIC 9(6). ST1174.2 +016300 07 FILLER PIC X(6). ST1174.2 +016400 07 UPDATE-NUMBER PIC 9(2). ST1174.2 +016500 07 FILLER PIC X(5). ST1174.2 +016600 07 ODO-NUMBER PIC 9(4). ST1174.2 +016700 07 FILLER PIC X(5). ST1174.2 +016800 07 XPROGRAM-NAME PIC X(5). ST1174.2 +016900 07 FILLER PIC X(7). ST1174.2 +017000 07 XRECORD-LENGTH PIC 9(6). ST1174.2 +017100 07 FILLER PIC X(7). ST1174.2 +017200 07 CHARS-OR-RECORDS PIC X(2). ST1174.2 +017300 07 FILLER PIC X(1). ST1174.2 +017400 07 XBLOCK-SIZE PIC 9(4). ST1174.2 +017500 07 FILLER PIC X(6). ST1174.2 +017600 07 RECORDS-IN-FILE PIC 9(6). ST1174.2 +017700 07 FILLER PIC X(5). ST1174.2 +017800 07 XFILE-ORGANIZATION PIC X(2). ST1174.2 +017900 07 FILLER PIC X(6). ST1174.2 +018000 07 XLABEL-TYPE PIC X(1). ST1174.2 +018100 05 FILE-RECORD-INFO-P121-240. ST1174.2 +018200 07 FILLER PIC X(8). ST1174.2 +018300 07 XRECORD-KEY PIC X(29). ST1174.2 +018400 07 FILLER PIC X(9). ST1174.2 +018500 07 ALTERNATE-KEY1 PIC X(29). ST1174.2 +018600 07 FILLER PIC X(9). ST1174.2 +018700 07 ALTERNATE-KEY2 PIC X(29). ST1174.2 +018800 07 FILLER PIC X(7). ST1174.2 +018900 01 TEST-RESULTS. ST1174.2 +019000 02 FILLER PIC X VALUE SPACE. ST1174.2 +019100 02 FEATURE PIC X(20) VALUE SPACE. ST1174.2 +019200 02 FILLER PIC X VALUE SPACE. ST1174.2 +019300 02 P-OR-F PIC X(5) VALUE SPACE. ST1174.2 +019400 02 FILLER PIC X VALUE SPACE. ST1174.2 +019500 02 PAR-NAME. ST1174.2 +019600 03 FILLER PIC X(19) VALUE SPACE. ST1174.2 +019700 03 PARDOT-X PIC X VALUE SPACE. ST1174.2 +019800 03 DOTVALUE PIC 99 VALUE ZERO. ST1174.2 +019900 02 FILLER PIC X(8) VALUE SPACE. ST1174.2 +020000 02 RE-MARK PIC X(61). ST1174.2 +020100 01 TEST-COMPUTED. ST1174.2 +020200 02 FILLER PIC X(30) VALUE SPACE. ST1174.2 +020300 02 FILLER PIC X(17) VALUE ST1174.2 +020400 " COMPUTED=". ST1174.2 +020500 02 COMPUTED-X. ST1174.2 +020600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1174.2 +020700 03 COMPUTED-N REDEFINES COMPUTED-A ST1174.2 +020800 PIC -9(9).9(9). ST1174.2 +020900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1174.2 +021000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1174.2 +021100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1174.2 +021200 03 CM-18V0 REDEFINES COMPUTED-A. ST1174.2 +021300 04 COMPUTED-18V0 PIC -9(18). ST1174.2 +021400 04 FILLER PIC X. ST1174.2 +021500 03 FILLER PIC X(50) VALUE SPACE. ST1174.2 +021600 01 TEST-CORRECT. ST1174.2 +021700 02 FILLER PIC X(30) VALUE SPACE. ST1174.2 +021800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1174.2 +021900 02 CORRECT-X. ST1174.2 +022000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1174.2 +022100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1174.2 +022200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1174.2 +022300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1174.2 +022400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1174.2 +022500 03 CR-18V0 REDEFINES CORRECT-A. ST1174.2 +022600 04 CORRECT-18V0 PIC -9(18). ST1174.2 +022700 04 FILLER PIC X. ST1174.2 +022800 03 FILLER PIC X(2) VALUE SPACE. ST1174.2 +022900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1174.2 +023000 01 CCVS-C-1. ST1174.2 +023100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1174.2 +023200- "SS PARAGRAPH-NAME ST1174.2 +023300- " REMARKS". ST1174.2 +023400 02 FILLER PIC X(20) VALUE SPACE. ST1174.2 +023500 01 CCVS-C-2. ST1174.2 +023600 02 FILLER PIC X VALUE SPACE. ST1174.2 +023700 02 FILLER PIC X(6) VALUE "TESTED". ST1174.2 +023800 02 FILLER PIC X(15) VALUE SPACE. ST1174.2 +023900 02 FILLER PIC X(4) VALUE "FAIL". ST1174.2 +024000 02 FILLER PIC X(94) VALUE SPACE. ST1174.2 +024100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1174.2 +024200 01 REC-CT PIC 99 VALUE ZERO. ST1174.2 +024300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1174.2 +024400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1174.2 +024500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1174.2 +024600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1174.2 +024700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1174.2 +024800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1174.2 +024900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1174.2 +025000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1174.2 +025100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1174.2 +025200 01 CCVS-H-1. ST1174.2 +025300 02 FILLER PIC X(39) VALUE SPACES. ST1174.2 +025400 02 FILLER PIC X(42) VALUE ST1174.2 +025500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1174.2 +025600 02 FILLER PIC X(39) VALUE SPACES. ST1174.2 +025700 01 CCVS-H-2A. ST1174.2 +025800 02 FILLER PIC X(40) VALUE SPACE. ST1174.2 +025900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1174.2 +026000 02 FILLER PIC XXXX VALUE ST1174.2 +026100 "4.2 ". ST1174.2 +026200 02 FILLER PIC X(28) VALUE ST1174.2 +026300 " COPY - NOT FOR DISTRIBUTION". ST1174.2 +026400 02 FILLER PIC X(41) VALUE SPACE. ST1174.2 +026500 ST1174.2 +026600 01 CCVS-H-2B. ST1174.2 +026700 02 FILLER PIC X(15) VALUE ST1174.2 +026800 "TEST RESULT OF ". ST1174.2 +026900 02 TEST-ID PIC X(9). ST1174.2 +027000 02 FILLER PIC X(4) VALUE ST1174.2 +027100 " IN ". ST1174.2 +027200 02 FILLER PIC X(12) VALUE ST1174.2 +027300 " HIGH ". ST1174.2 +027400 02 FILLER PIC X(22) VALUE ST1174.2 +027500 " LEVEL VALIDATION FOR ". ST1174.2 +027600 02 FILLER PIC X(58) VALUE ST1174.2 +027700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2 +027800 01 CCVS-H-3. ST1174.2 +027900 02 FILLER PIC X(34) VALUE ST1174.2 +028000 " FOR OFFICIAL USE ONLY ". ST1174.2 +028100 02 FILLER PIC X(58) VALUE ST1174.2 +028200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1174.2 +028300 02 FILLER PIC X(28) VALUE ST1174.2 +028400 " COPYRIGHT 1985 ". ST1174.2 +028500 01 CCVS-E-1. ST1174.2 +028600 02 FILLER PIC X(52) VALUE SPACE. ST1174.2 +028700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1174.2 +028800 02 ID-AGAIN PIC X(9). ST1174.2 +028900 02 FILLER PIC X(45) VALUE SPACES. ST1174.2 +029000 01 CCVS-E-2. ST1174.2 +029100 02 FILLER PIC X(31) VALUE SPACE. ST1174.2 +029200 02 FILLER PIC X(21) VALUE SPACE. ST1174.2 +029300 02 CCVS-E-2-2. ST1174.2 +029400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1174.2 +029500 03 FILLER PIC X VALUE SPACE. ST1174.2 +029600 03 ENDER-DESC PIC X(44) VALUE ST1174.2 +029700 "ERRORS ENCOUNTERED". ST1174.2 +029800 01 CCVS-E-3. ST1174.2 +029900 02 FILLER PIC X(22) VALUE ST1174.2 +030000 " FOR OFFICIAL USE ONLY". ST1174.2 +030100 02 FILLER PIC X(12) VALUE SPACE. ST1174.2 +030200 02 FILLER PIC X(58) VALUE ST1174.2 +030300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1174.2 +030400 02 FILLER PIC X(13) VALUE SPACE. ST1174.2 +030500 02 FILLER PIC X(15) VALUE ST1174.2 +030600 " COPYRIGHT 1985". ST1174.2 +030700 01 CCVS-E-4. ST1174.2 +030800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1174.2 +030900 02 FILLER PIC X(4) VALUE " OF ". ST1174.2 +031000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1174.2 +031100 02 FILLER PIC X(40) VALUE ST1174.2 +031200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1174.2 +031300 01 XXINFO. ST1174.2 +031400 02 FILLER PIC X(19) VALUE ST1174.2 +031500 "*** INFORMATION ***". ST1174.2 +031600 02 INFO-TEXT. ST1174.2 +031700 04 FILLER PIC X(8) VALUE SPACE. ST1174.2 +031800 04 XXCOMPUTED PIC X(20). ST1174.2 +031900 04 FILLER PIC X(5) VALUE SPACE. ST1174.2 +032000 04 XXCORRECT PIC X(20). ST1174.2 +032100 02 INF-ANSI-REFERENCE PIC X(48). ST1174.2 +032200 01 HYPHEN-LINE. ST1174.2 +032300 02 FILLER PIC IS X VALUE IS SPACE. ST1174.2 +032400 02 FILLER PIC IS X(65) VALUE IS "************************ST1174.2 +032500- "*****************************************". ST1174.2 +032600 02 FILLER PIC IS X(54) VALUE IS "************************ST1174.2 +032700- "******************************". ST1174.2 +032800 01 CCVS-PGM-ID PIC X(9) VALUE ST1174.2 +032900 "ST117A". ST1174.2 +033000 PROCEDURE DIVISION. ST1174.2 +033100 CCVS1 SECTION. ST1174.2 +033200 OPEN-FILES. ST1174.2 +033300 OPEN OUTPUT PRINT-FILE. ST1174.2 +033400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1174.2 +033500 MOVE SPACE TO TEST-RESULTS. ST1174.2 +033600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1174.2 +033700 MOVE ZERO TO REC-SKL-SUB. ST1174.2 +033800 PERFORM CCVS-INIT-FILE 9 TIMES. ST1174.2 +033900 CCVS-INIT-FILE. ST1174.2 +034000 ADD 1 TO REC-SKL-SUB. ST1174.2 +034100 MOVE FILE-RECORD-INFO-SKELETON ST1174.2 +034200 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1174.2 +034300 CCVS-INIT-EXIT. ST1174.2 +034400 GO TO CCVS1-EXIT. ST1174.2 +034500 CLOSE-FILES. ST1174.2 +034600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1174.2 +034700 TERMINATE-CCVS. ST1174.2 +034800*S EXIT PROGRAM. ST1174.2 +034900*SERMINATE-CALL. ST1174.2 +035000 STOP RUN. ST1174.2 +035100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1174.2 +035200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1174.2 +035300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1174.2 +035400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1174.2 +035500 MOVE "****TEST DELETED****" TO RE-MARK. ST1174.2 +035600 PRINT-DETAIL. ST1174.2 +035700 IF REC-CT NOT EQUAL TO ZERO ST1174.2 +035800 MOVE "." TO PARDOT-X ST1174.2 +035900 MOVE REC-CT TO DOTVALUE. ST1174.2 +036000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1174.2 +036100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1174.2 +036200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1174.2 +036300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1174.2 +036400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1174.2 +036500 MOVE SPACE TO CORRECT-X. ST1174.2 +036600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1174.2 +036700 MOVE SPACE TO RE-MARK. ST1174.2 +036800 HEAD-ROUTINE. ST1174.2 +036900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +037000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +037100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1174.2 +037200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1174.2 +037300 COLUMN-NAMES-ROUTINE. ST1174.2 +037400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +037500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +037600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +037700 END-ROUTINE. ST1174.2 +037800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1174.2 +037900 END-RTN-EXIT. ST1174.2 +038000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +038100 END-ROUTINE-1. ST1174.2 +038200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1174.2 +038300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1174.2 +038400 ADD PASS-COUNTER TO ERROR-HOLD. ST1174.2 +038500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1174.2 +038600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1174.2 +038700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1174.2 +038800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1174.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1174.2 +039000 END-ROUTINE-12. ST1174.2 +039100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1174.2 +039200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1174.2 +039300 MOVE "NO " TO ERROR-TOTAL ST1174.2 +039400 ELSE ST1174.2 +039500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1174.2 +039600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1174.2 +039700 PERFORM WRITE-LINE. ST1174.2 +039800 END-ROUTINE-13. ST1174.2 +039900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1174.2 +040000 MOVE "NO " TO ERROR-TOTAL ELSE ST1174.2 +040100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1174.2 +040200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1174.2 +040300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +040400 IF INSPECT-COUNTER EQUAL TO ZERO ST1174.2 +040500 MOVE "NO " TO ERROR-TOTAL ST1174.2 +040600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1174.2 +040700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1174.2 +040800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +040900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1174.2 +041000 WRITE-LINE. ST1174.2 +041100 ADD 1 TO RECORD-COUNT. ST1174.2 +041200 IF RECORD-COUNT GREATER 42 ST1174.2 +041300 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1174.2 +041400 MOVE SPACE TO DUMMY-RECORD ST1174.2 +041500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1174.2 +041600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1174.2 +041700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1174.2 +041800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1174.2 +041900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1174.2 +042000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1174.2 +042100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1174.2 +042200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1174.2 +042300 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1174.2 +042400 MOVE ZERO TO RECORD-COUNT. ST1174.2 +042500 PERFORM WRT-LN. ST1174.2 +042600 WRT-LN. ST1174.2 +042700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2 +042800 MOVE SPACE TO DUMMY-RECORD. ST1174.2 +042900 BLANK-LINE-PRINT. ST1174.2 +043000 PERFORM WRT-LN. ST1174.2 +043100 FAIL-ROUTINE. ST1174.2 +043200 IF COMPUTED-X NOT EQUAL TO SPACE ST1174.2 +043300 GO TO FAIL-ROUTINE-WRITE. ST1174.2 +043400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1174.2 +043500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1174.2 +043600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1174.2 +043700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +043800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1174.2 +043900 GO TO FAIL-ROUTINE-EX. ST1174.2 +044000 FAIL-ROUTINE-WRITE. ST1174.2 +044100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1174.2 +044200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1174.2 +044300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1174.2 +044400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1174.2 +044500 FAIL-ROUTINE-EX. EXIT. ST1174.2 +044600 BAIL-OUT. ST1174.2 +044700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1174.2 +044800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1174.2 +044900 BAIL-OUT-WRITE. ST1174.2 +045000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1174.2 +045100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1174.2 +045200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1174.2 +045300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1174.2 +045400 BAIL-OUT-EX. EXIT. ST1174.2 +045500 CCVS1-EXIT. ST1174.2 +045600 EXIT. ST1174.2 +045700 SECT-ST117-0001 SECTION. ST1174.2 +045800 SRT-INIT. ST1174.2 +045900 OPEN INPUT SQ-FS2. ST1174.2 +046000 MOVE "BIG-SORT" TO PAR-NAME. ST1174.2 +046100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1174.2 +046200 MOVE 0 TO WRK-DU-9-0001. ST1174.2 +046300 MOVE 0 TO WRK-DU-9-2. ST1174.2 +046400 MOVE 0 TO WRK-DU-999-3. ST1174.2 +046500 DIVIDE ST1174.2 +046600 1000 ST1174.2 +046700 BY 51 GIVING NUMBER-OF-SETS. ST1174.2 +046800* ST1174.2 +046900* FOR EVERY SET OF 51 RECORDS CREATED AS THE ORIGINAL INPUT ST1174.2 +047000* FILE FOR THE SORT ( X-65 / 51 ), THEN THERE SHOULD BE AT ST1174.2 +047100* LEAST THAT NUMBER OF DUPLICATE ALPHANUMERIC KEYS AS THE ST1174.2 +047200* FIRST N RECORDS IN THE SORTED FILE SQ-FS2. THAT MANY ST1174.2 +047300* RECORDS WILL BE READ AND THE KEYS SHOULD BE THE LOWEST ST1174.2 +047400* CHARACTER IN THE NATIVE COLLATING SEQUENCE. THE NUMERIC ST1174.2 +047500* KEYS SHOULD ALWAYS BE ASCENDING. ST1174.2 +047600* ST1174.2 +047700 MOVE 1 TO WRK-DU-999-0001. ST1174.2 +047800 SRT-INIT-01. ST1174.2 +047900 PERFORM RD-2 THRU R2-EXIT. ST1174.2 +048000 ADD 1 TO WRK-DU-999-0001. ST1174.2 +048100 IF WRK-DU-999-0001 IS NOT GREATER THAN NUMBER-OF-SETS ST1174.2 +048200 GO TO SRT-INIT-01. ST1174.2 +048300 IF WRK-DU-9-2 IS EQUAL TO 0 ST1174.2 +048400 PERFORM PASS ST1174.2 +048500 GO TO SRT-WRITE ST1174.2 +048600 ELSE ST1174.2 +048700 PERFORM FAIL ST1174.2 +048800 MOVE "ERROR AT RECORD" TO COMPUTED-A ST1174.2 +048900 MOVE WRK-DU-999-2 TO CORRECT-18V0 ST1174.2 +049000 MOVE "FILE SQ-FS2 PASSED FROM ST116" TO RE-MARK ST1174.2 +049100 GO TO SRT-WRITE. ST1174.2 +049200 SRT-DELETE. ST1174.2 +049300 PERFORM DE-LETE. ST1174.2 +049400 SRT-WRITE. ST1174.2 +049500 PERFORM PRINT-DETAIL. ST1174.2 +049600 CLOSE SQ-FS2. ST1174.2 +049700 GO TO ST117-END. ST1174.2 +049800 RD-2. ST1174.2 +049900 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1174.2 +050000 GO TO R2-EXIT. ST1174.2 +050100 READ SQ-FS2 AT END GO TO PREMATURE-EOF. ST1174.2 +050200 IF ALPHAN-KEY-K6 IS NOT EQUAL TO ANSWER (1) ST1174.2 +050300 MOVE 1 TO WRK-DU-9-2 ST1174.2 +050400 MOVE WRK-DU-999-0001 TO WRK-DU-999-2 ST1174.2 +050500 MOVE 1 TO WRK-DU-9-0001. ST1174.2 +050600 IF NUM-KEY-K6 IS NOT GREATER THAN WRK-DU-999-3 ST1174.2 +050700 MOVE 1 TO WRK-DU-9-2 ST1174.2 +050800 MOVE WRK-DU-999-0001 TO WRK-DU-999-2 ST1174.2 +050900 MOVE 1 TO WRK-DU-9-0001 ST1174.2 +051000 ELSE ST1174.2 +051100 MOVE NUM-KEY-K6 TO WRK-DU-999-3 ST1174.2 +051200 GO TO R2-EXIT. ST1174.2 +051300 PREMATURE-EOF. ST1174.2 +051400 MOVE 1 TO WRK-DU-9-0001. ST1174.2 +051500 PERFORM FAIL. ST1174.2 +051600 MOVE "AT RECORD" TO COMPUTED-A. ST1174.2 +051700 MOVE WRK-DU-999-0001 TO CORRECT-18V0. ST1174.2 +051800 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1174.2 +051900 R2-EXIT. ST1174.2 +052000 EXIT. ST1174.2 +052100 ST117-END. ST1174.2 +052200 EXIT. ST1174.2 +052300*XILEDUMP SECTION. ST1174.2 +052400*XILE-2-DUMP-INIT. ST1174.2 +052500*X OPEN INPUT SQ-FS2. ST1174.2 +052600*X MOVE ZERO TO COUNT-OF-RECS. ST1174.2 +052700*XILE-2-DUMP. ST1174.2 +052800*X READ SQ-FS2 RECORD ST1174.2 +052900*X AT END GO TO FILE-2-DUMP-END. ST1174.2 +053000*X ADD 1 TO COUNT-OF-RECS. ST1174.2 +053100*X IF COUNT-OF-RECS GREATER THAN ST1174.2 +053200*X 1000 ST1174.2 +053300*X MOVE " TOO MANY RECORDS" TO DUMMY-RECORD ST1174.2 +053400*X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES ST1174.2 +053500*X GO TO FILE-2-DUMP-END. ST1174.2 +053600*X PERFORM FILE-2-DUMP-WRITE. ST1174.2 +053700*X GO TO FILE-2-DUMP. ST1174.2 +053800*XILE-2-DUMP-WRITE. ST1174.2 +053900*X MOVE SQ-FS2R1-F-G-507 TO DUMMY-RECORD. ST1174.2 +054000*X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2 +054100*XILE-2-DUMP-END. ST1174.2 +054200*X MOVE " NUMBER OF SORTED RECORDS ON SQ-FS2 SHOWN BELOW" ST1174.2 +054300*X TO DUMMY-RECORD. ST1174.2 +054400*X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2 +054500*X MOVE COUNT-OF-RECS TO DUMMY-RECORD. ST1174.2 +054600*X WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1174.2 +054700*X CLOSE SQ-FS2. ST1174.2 +054800 CCVS-EXIT SECTION. ST1174.2 +054900 CCVS-999999. ST1174.2 +055000 GO TO CLOSE-FILES. ST1174.2 diff --git a/tests/cobol85/ST/ST118A.CBL b/tests/cobol85/ST/ST118A.CBL new file mode 100755 index 00000000..1306eccb --- /dev/null +++ b/tests/cobol85/ST/ST118A.CBL @@ -0,0 +1,629 @@ +000100 IDENTIFICATION DIVISION. ST1184.2 +000200 PROGRAM-ID. ST1184.2 +000300 ST118A. ST1184.2 +000400**************************************************************** ST1184.2 +000500* * ST1184.2 +000600* VALIDATION FOR:- * ST1184.2 +000700* * ST1184.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1184.2 +000900* * ST1184.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1184.2 +001100* * ST1184.2 +001200**************************************************************** ST1184.2 +001300* * ST1184.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1184.2 +001500* * ST1184.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1184.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1184.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1184.2 +001900* * ST1184.2 +002000**************************************************************** ST1184.2 +002100* ST118 IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT ST1184.2 +002200* PROCEDURE BUILDS THE EIGHT-RECORD FILE SHOWN BELOW. THE ST1184.2 +002300* OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE ST1184.2 +002400* REPORT. ST1184.2 +002500* SORT SORT SORT SORT SORT SORT SORT SORT ST1184.2 +002600* KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8ST1184.2 +002700* S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 ST1184.2 +002800* SIGN JUST SIGN JUST SIGN ST1184.2 +002900* LEADING RIGHT TRAILIN RIGHT TRAIL ST1184.2 +003000* SEPARAT SEPARAT ST1184.2 +003100* ST1184.2 +003200* +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 ST1184.2 +003300* -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 ST1184.2 +003400* -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 ST1184.2 +003500* -054321 BBB -.1234 X A AAAAAAAA 501 +99 ST1184.2 +003600* -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 ST1184.2 +003700* -054321 BBB -.1234 BBBBBB A Z 501 +99 ST1184.2 +003800* -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 ST1184.2 +003900* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 ST1184.2 +004000* ST1184.2 +004100* THIS PROGRAM CHECKS THE COMPILER"S ABILITY TO HANDLE EIGHT ST1184.2 +004200* ASCENDING KEYS IN ONE FILE. ST1184.2 +004300* ST1184.2 +004400* ASCENDING KEYS IN ONE FILE. EACH OF THE KEYS IDENTIFIED ST1184.2 +004500* IN THE SORT STATEMENT ARE ELEMENTARY DATA ITEMS AND USE ST1184.2 +004600* VARIOUS COMBINATIONS OF PICTURE CHARACTER-STRING SYMBOLS AND ST1184.2 +004700* CLAUSES FOR DESCRIBING THE GENERAL CHARACTERISTICS OF THE ST1184.2 +004800* DATA ITEM. ST1184.2 +004900* THIS PROGRAM IS A REWRITE OF ST108. THE PURPOSE OF THIS ST1184.2 +005000* PROGRAM IS TO VERIFY THAT RECORDS ARE PROPERLY SORTED WHEN ST1184.2 +005100* THE SORT KEYS OF THE SORT STATEMENT USE DATA DEFINITIONS ST1184.2 +005200* WHICH INCLUDE THE SIGN CLAUSE. ST1184.2 +005300 ENVIRONMENT DIVISION. ST1184.2 +005400 CONFIGURATION SECTION. ST1184.2 +005500 SOURCE-COMPUTER. ST1184.2 +005600 Linux. ST1184.2 +005700 OBJECT-COMPUTER. ST1184.2 +005800 Linux. ST1184.2 +005900 INPUT-OUTPUT SECTION. ST1184.2 +006000 FILE-CONTROL. ST1184.2 +006100 SELECT PRINT-FILE ASSIGN TO ST1184.2 +006200 "report.log". ST1184.2 +006300 SELECT SORTFILE-1H ASSIGN TO ST1184.2 +006400 "XXXXX027". ST1184.2 +006500 DATA DIVISION. ST1184.2 +006600 FILE SECTION. ST1184.2 +006700 FD PRINT-FILE. ST1184.2 +006800 01 PRINT-REC PICTURE X(120). ST1184.2 +006900 01 DUMMY-RECORD PICTURE X(120). ST1184.2 +007000 SD SORTFILE-1H ST1184.2 +007100 DATA RECORD IS SORTFILE-REC. ST1184.2 +007200 01 SORTFILE-REC. ST1184.2 +007300 02 SORTKEY-8 PICTURE S99 SIGN IS TRAILING. ST1184.2 +007400 02 SORTKEY-1 PICTURE S9(6) SIGN IS LEADING SEPARATE. ST1184.2 +007500 02 SORTKEY-7 PICTURE 999. ST1184.2 +007600 02 SORTKEY-3 PICTURE SV9(16) SIGN IS TRAILING SEPARATE. ST1184.2 +007700 02 FILLER PICTURE XX. ST1184.2 +007800 02 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. ST1184.2 +007900 02 SORTKEY-6 PICTURE X(10). ST1184.2 +008000 02 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. ST1184.2 +008100 02 SORTKEY-5 PICTURE A(20). ST1184.2 +008200 02 FILLER PICTURE XXX. ST1184.2 +008300 WORKING-STORAGE SECTION. ST1184.2 +008400 77 UTIL-CTR PICTURE S99999. ST1184.2 +008500 77 SPAC-E PICTURE X VALUE " ". ST1184.2 +008600 01 TEST-RESULTS. ST1184.2 +008700 02 FILLER PIC X VALUE SPACE. ST1184.2 +008800 02 FEATURE PIC X(20) VALUE SPACE. ST1184.2 +008900 02 FILLER PIC X VALUE SPACE. ST1184.2 +009000 02 P-OR-F PIC X(5) VALUE SPACE. ST1184.2 +009100 02 FILLER PIC X VALUE SPACE. ST1184.2 +009200 02 PAR-NAME. ST1184.2 +009300 03 FILLER PIC X(19) VALUE SPACE. ST1184.2 +009400 03 PARDOT-X PIC X VALUE SPACE. ST1184.2 +009500 03 DOTVALUE PIC 99 VALUE ZERO. ST1184.2 +009600 02 FILLER PIC X(8) VALUE SPACE. ST1184.2 +009700 02 RE-MARK PIC X(61). ST1184.2 +009800 01 TEST-COMPUTED. ST1184.2 +009900 02 FILLER PIC X(30) VALUE SPACE. ST1184.2 +010000 02 FILLER PIC X(17) VALUE ST1184.2 +010100 " COMPUTED=". ST1184.2 +010200 02 COMPUTED-X. ST1184.2 +010300 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1184.2 +010400 03 COMPUTED-N REDEFINES COMPUTED-A ST1184.2 +010500 PIC -9(9).9(9). ST1184.2 +010600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1184.2 +010700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1184.2 +010800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1184.2 +010900 03 CM-18V0 REDEFINES COMPUTED-A. ST1184.2 +011000 04 COMPUTED-18V0 PIC -9(18). ST1184.2 +011100 04 FILLER PIC X. ST1184.2 +011200 03 FILLER PIC X(50) VALUE SPACE. ST1184.2 +011300 01 TEST-CORRECT. ST1184.2 +011400 02 FILLER PIC X(30) VALUE SPACE. ST1184.2 +011500 02 FILLER PIC X(17) VALUE " CORRECT =". ST1184.2 +011600 02 CORRECT-X. ST1184.2 +011700 03 CORRECT-A PIC X(20) VALUE SPACE. ST1184.2 +011800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1184.2 +011900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1184.2 +012000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1184.2 +012100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1184.2 +012200 03 CR-18V0 REDEFINES CORRECT-A. ST1184.2 +012300 04 CORRECT-18V0 PIC -9(18). ST1184.2 +012400 04 FILLER PIC X. ST1184.2 +012500 03 FILLER PIC X(2) VALUE SPACE. ST1184.2 +012600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1184.2 +012700 01 CCVS-C-1. ST1184.2 +012800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1184.2 +012900- "SS PARAGRAPH-NAME ST1184.2 +013000- " REMARKS". ST1184.2 +013100 02 FILLER PIC X(20) VALUE SPACE. ST1184.2 +013200 01 CCVS-C-2. ST1184.2 +013300 02 FILLER PIC X VALUE SPACE. ST1184.2 +013400 02 FILLER PIC X(6) VALUE "TESTED". ST1184.2 +013500 02 FILLER PIC X(15) VALUE SPACE. ST1184.2 +013600 02 FILLER PIC X(4) VALUE "FAIL". ST1184.2 +013700 02 FILLER PIC X(94) VALUE SPACE. ST1184.2 +013800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1184.2 +013900 01 REC-CT PIC 99 VALUE ZERO. ST1184.2 +014000 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1184.2 +014100 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1184.2 +014200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1184.2 +014300 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1184.2 +014400 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1184.2 +014500 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1184.2 +014600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1184.2 +014700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1184.2 +014800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1184.2 +014900 01 CCVS-H-1. ST1184.2 +015000 02 FILLER PIC X(39) VALUE SPACES. ST1184.2 +015100 02 FILLER PIC X(42) VALUE ST1184.2 +015200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1184.2 +015300 02 FILLER PIC X(39) VALUE SPACES. ST1184.2 +015400 01 CCVS-H-2A. ST1184.2 +015500 02 FILLER PIC X(40) VALUE SPACE. ST1184.2 +015600 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1184.2 +015700 02 FILLER PIC XXXX VALUE ST1184.2 +015800 "4.2 ". ST1184.2 +015900 02 FILLER PIC X(28) VALUE ST1184.2 +016000 " COPY - NOT FOR DISTRIBUTION". ST1184.2 +016100 02 FILLER PIC X(41) VALUE SPACE. ST1184.2 +016200 ST1184.2 +016300 01 CCVS-H-2B. ST1184.2 +016400 02 FILLER PIC X(15) VALUE ST1184.2 +016500 "TEST RESULT OF ". ST1184.2 +016600 02 TEST-ID PIC X(9). ST1184.2 +016700 02 FILLER PIC X(4) VALUE ST1184.2 +016800 " IN ". ST1184.2 +016900 02 FILLER PIC X(12) VALUE ST1184.2 +017000 " HIGH ". ST1184.2 +017100 02 FILLER PIC X(22) VALUE ST1184.2 +017200 " LEVEL VALIDATION FOR ". ST1184.2 +017300 02 FILLER PIC X(58) VALUE ST1184.2 +017400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1184.2 +017500 01 CCVS-H-3. ST1184.2 +017600 02 FILLER PIC X(34) VALUE ST1184.2 +017700 " FOR OFFICIAL USE ONLY ". ST1184.2 +017800 02 FILLER PIC X(58) VALUE ST1184.2 +017900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1184.2 +018000 02 FILLER PIC X(28) VALUE ST1184.2 +018100 " COPYRIGHT 1985 ". ST1184.2 +018200 01 CCVS-E-1. ST1184.2 +018300 02 FILLER PIC X(52) VALUE SPACE. ST1184.2 +018400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1184.2 +018500 02 ID-AGAIN PIC X(9). ST1184.2 +018600 02 FILLER PIC X(45) VALUE SPACES. ST1184.2 +018700 01 CCVS-E-2. ST1184.2 +018800 02 FILLER PIC X(31) VALUE SPACE. ST1184.2 +018900 02 FILLER PIC X(21) VALUE SPACE. ST1184.2 +019000 02 CCVS-E-2-2. ST1184.2 +019100 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1184.2 +019200 03 FILLER PIC X VALUE SPACE. ST1184.2 +019300 03 ENDER-DESC PIC X(44) VALUE ST1184.2 +019400 "ERRORS ENCOUNTERED". ST1184.2 +019500 01 CCVS-E-3. ST1184.2 +019600 02 FILLER PIC X(22) VALUE ST1184.2 +019700 " FOR OFFICIAL USE ONLY". ST1184.2 +019800 02 FILLER PIC X(12) VALUE SPACE. ST1184.2 +019900 02 FILLER PIC X(58) VALUE ST1184.2 +020000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1184.2 +020100 02 FILLER PIC X(13) VALUE SPACE. ST1184.2 +020200 02 FILLER PIC X(15) VALUE ST1184.2 +020300 " COPYRIGHT 1985". ST1184.2 +020400 01 CCVS-E-4. ST1184.2 +020500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1184.2 +020600 02 FILLER PIC X(4) VALUE " OF ". ST1184.2 +020700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1184.2 +020800 02 FILLER PIC X(40) VALUE ST1184.2 +020900 " TESTS WERE EXECUTED SUCCESSFULLY". ST1184.2 +021000 01 XXINFO. ST1184.2 +021100 02 FILLER PIC X(19) VALUE ST1184.2 +021200 "*** INFORMATION ***". ST1184.2 +021300 02 INFO-TEXT. ST1184.2 +021400 04 FILLER PIC X(8) VALUE SPACE. ST1184.2 +021500 04 XXCOMPUTED PIC X(20). ST1184.2 +021600 04 FILLER PIC X(5) VALUE SPACE. ST1184.2 +021700 04 XXCORRECT PIC X(20). ST1184.2 +021800 02 INF-ANSI-REFERENCE PIC X(48). ST1184.2 +021900 01 HYPHEN-LINE. ST1184.2 +022000 02 FILLER PIC IS X VALUE IS SPACE. ST1184.2 +022100 02 FILLER PIC IS X(65) VALUE IS "************************ST1184.2 +022200- "*****************************************". ST1184.2 +022300 02 FILLER PIC IS X(54) VALUE IS "************************ST1184.2 +022400- "******************************". ST1184.2 +022500 01 CCVS-PGM-ID PIC X(9) VALUE ST1184.2 +022600 "ST118A". ST1184.2 +022700 PROCEDURE DIVISION. ST1184.2 +022800 SORT-PARA SECTION. ST1184.2 +022900 SORT-PARAGRAPH. ST1184.2 +023000 SORT SORTFILE-1H ON ST1184.2 +023100 ASCENDING KEY SORTKEY-1 ST1184.2 +023200 ASCENDING SORTKEY-2 ST1184.2 +023300 ASCENDING SORTKEY-3 ST1184.2 +023400 ASCENDING SORTKEY-4 ST1184.2 +023500 ASCENDING SORTKEY-5 ST1184.2 +023600 ASCENDING SORTKEY-6 ST1184.2 +023700 ASCENDING SORTKEY-7 ST1184.2 +023800 ASCENDING SORTKEY-8 ST1184.2 +023900 INPUT PROCEDURE INPROC ST1184.2 +024000 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. ST1184.2 +024100 STOP RUN. ST1184.2 +024200 INPROC SECTION. ST1184.2 +024300 BUILD-FILE. ST1184.2 +024400 PERFORM BUILD-RECORD. ST1184.2 +024500 MOVE +123456 TO SORTKEY-1. ST1184.2 +024600 PERFORM RELEASE-RECORD. ST1184.2 +024700 PERFORM BUILD-RECORD. ST1184.2 +024800 MOVE "X" TO SORTKEY-2. ST1184.2 +024900 PERFORM RELEASE-RECORD. ST1184.2 +025000 PERFORM BUILD-RECORD. ST1184.2 +025100 MOVE +.6 TO SORTKEY-3. ST1184.2 +025200 PERFORM RELEASE-RECORD. ST1184.2 +025300 PERFORM BUILD-RECORD. ST1184.2 +025400 MOVE "X" TO SORTKEY-4. ST1184.2 +025500 PERFORM RELEASE-RECORD. ST1184.2 +025600 PERFORM BUILD-RECORD. ST1184.2 +025700 MOVE "Z" TO SORTKEY-5. ST1184.2 +025800 PERFORM RELEASE-RECORD. ST1184.2 +025900 PERFORM BUILD-RECORD. ST1184.2 +026000 MOVE "Z" TO SORTKEY-6. ST1184.2 +026100 PERFORM RELEASE-RECORD. ST1184.2 +026200 PERFORM BUILD-RECORD. ST1184.2 +026300 MOVE +418 TO SORTKEY-7. ST1184.2 +026400 PERFORM RELEASE-RECORD. ST1184.2 +026500 PERFORM BUILD-RECORD. ST1184.2 +026600 MOVE -14 TO SORTKEY-8. ST1184.2 +026700 PERFORM RELEASE-RECORD. ST1184.2 +026800 GO TO BUILD-EXIT. ST1184.2 +026900 BUILD-RECORD. ST1184.2 +027000 MOVE -054321 TO SORTKEY-1. ST1184.2 +027100 MOVE "BBB" TO SORTKEY-2. ST1184.2 +027200 MOVE -.1234567890123456 TO SORTKEY-3. ST1184.2 +027300 MOVE "BBBBBB" TO SORTKEY-4. ST1184.2 +027400 MOVE "A" TO SORTKEY-5. ST1184.2 +027500 MOVE "AAAAAAAA" TO SORTKEY-6. ST1184.2 +027600 MOVE -501 TO SORTKEY-7. ST1184.2 +027700* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED ST1184.2 +027800* FIELD. ST1184.2 +027900 MOVE +99 TO SORTKEY-8. ST1184.2 +028000 RELEASE-RECORD. ST1184.2 +028100 RELEASE SORTFILE-REC. ST1184.2 +028200 BUILD-EXIT. ST1184.2 +028300 EXIT. ST1184.2 +028400 OUTPROC SECTION. ST1184.2 +028500 OPEN-FILES. ST1184.2 +028600 OPEN OUTPUT PRINT-FILE. ST1184.2 +028700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1184.2 +028800 MOVE SPACE TO TEST-RESULTS. ST1184.2 +028900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1184.2 +029000 IF SPAC-E IS LESS THAN "B" ST1184.2 +029100 GO TO SPACE-IS-LESS-THAN-B. ST1184.2 +029200 B-IS-LESS-THAN-SPACE SECTION. ST1184.2 +029300 SORT-INIT-A. ST1184.2 +029400 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1184.2 +029500* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1184.2 +029600* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, ST1184.2 +029700* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, ST1184.2 +029800* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. ST1184.2 +029900 SORT-TEST-1. ST1184.2 +030000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +030100 IF SORTKEY-7 EQUAL TO 418 ST1184.2 +030200 PERFORM PASS GO TO SORT-WRITE-1. ST1184.2 +030300 SORT-FAIL-1. ST1184.2 +030400 PERFORM FAIL. ST1184.2 +030500 MOVE SORTKEY-7 TO COMPUTED-N. ST1184.2 +030600 MOVE 418 TO CORRECT-N. ST1184.2 +030700 SORT-WRITE-1. ST1184.2 +030800 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1184.2 +030900 PERFORM PRINT-DETAIL. ST1184.2 +031000 SORT-TEST-2. ST1184.2 +031100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +031200 IF SORTKEY-8 EQUAL TO -14 ST1184.2 +031300 PERFORM PASS GO TO SORT-WRITE-2. ST1184.2 +031400 SORT-FAIL-2. ST1184.2 +031500 PERFORM FAIL. ST1184.2 +031600 MOVE SORTKEY-8 TO COMPUTED-N. ST1184.2 +031700 MOVE -14 TO CORRECT-N. ST1184.2 +031800 SORT-WRITE-2. ST1184.2 +031900 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1184.2 +032000 PERFORM PRINT-DETAIL. ST1184.2 +032100 SORT-TEST-3. ST1184.2 +032200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +032300 IF SORTKEY-6 EQUAL TO "Z " ST1184.2 +032400 PERFORM PASS GO TO SORT-WRITE-3. ST1184.2 +032500 SORT-FAIL-3. ST1184.2 +032600 PERFORM FAIL. ST1184.2 +032700 MOVE SORTKEY-6 TO COMPUTED-A. ST1184.2 +032800 MOVE "Z " TO CORRECT-A. ST1184.2 +032900 SORT-WRITE-3. ST1184.2 +033000 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1184.2 +033100 PERFORM PRINT-DETAIL. ST1184.2 +033200 SORT-TEST-4. ST1184.2 +033300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +033400 IF SORTKEY-5 EQUAL TO "Z " ST1184.2 +033500 PERFORM PASS GO TO SORT-WRITE-4. ST1184.2 +033600 SORT-FAIL-4. ST1184.2 +033700 PERFORM FAIL. ST1184.2 +033800 MOVE SORTKEY-5 TO COMPUTED-A. ST1184.2 +033900 MOVE "Z " TO CORRECT-A. ST1184.2 +034000 SORT-WRITE-4. ST1184.2 +034100 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1184.2 +034200 PERFORM PRINT-DETAIL. ST1184.2 +034300 SORT-TEST-5. ST1184.2 +034400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +034500 IF SORTKEY-4 EQUAL TO " X" ST1184.2 +034600 PERFORM PASS GO TO SORT-WRITE-5. ST1184.2 +034700 SORT-FAIL-5. ST1184.2 +034800 PERFORM FAIL. ST1184.2 +034900 MOVE SORTKEY-4 TO COMPUTED-A. ST1184.2 +035000 MOVE " X" TO CORRECT-A. ST1184.2 +035100 SORT-WRITE-5. ST1184.2 +035200 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1184.2 +035300 PERFORM PRINT-DETAIL. ST1184.2 +035400 SORT-TEST-6. ST1184.2 +035500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +035600 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1184.2 +035700 PERFORM PASS GO TO SORT-WRITE-6. ST1184.2 +035800 SORT-FAIL-6. ST1184.2 +035900 PERFORM FAIL. ST1184.2 +036000 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1184.2 +036100 MOVE +.6000000000000000 TO CORRECT-0V18. ST1184.2 +036200 SORT-WRITE-6. ST1184.2 +036300 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1184.2 +036400 PERFORM PRINT-DETAIL. ST1184.2 +036500 SORT-TEST-7. ST1184.2 +036600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +036700 IF SORTKEY-2 EQUAL TO " X" ST1184.2 +036800 PERFORM PASS GO TO SORT-WRITE-7. ST1184.2 +036900 SORT-FAIL-7. ST1184.2 +037000 PERFORM FAIL. ST1184.2 +037100 MOVE SORTKEY-2 TO COMPUTED-A. ST1184.2 +037200 MOVE " X" TO CORRECT-A. ST1184.2 +037300 SORT-WRITE-7. ST1184.2 +037400 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1184.2 +037500 PERFORM PRINT-DETAIL. ST1184.2 +037600 SORT-TEST-8. ST1184.2 +037700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +037800 IF SORTKEY-1 EQUAL TO +123456 ST1184.2 +037900 PERFORM PASS GO TO SORT-WRITE-8. ST1184.2 +038000 SORT-FAIL-8. ST1184.2 +038100 PERFORM FAIL. ST1184.2 +038200 MOVE SORTKEY-1 TO COMPUTED-N. ST1184.2 +038300 MOVE +123456 TO CORRECT-N. ST1184.2 +038400 SORT-WRITE-8. ST1184.2 +038500 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1184.2 +038600 PERFORM PRINT-DETAIL. ST1184.2 +038700 SORT-REMARK-A. ST1184.2 +038800 MOVE SPACE TO FEATURE. ST1184.2 +038900 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1184.2 +039000 PERFORM PRINT-DETAIL. ST1184.2 +039100 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. ST1184.2 +039200 PERFORM PRINT-DETAIL. ST1184.2 +039300 MOVE "UNNECESSARY." TO RE-MARK. ST1184.2 +039400 PERFORM PRINT-DETAIL. ST1184.2 +039500 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1184.2 +039600 GO TO CONTINUE-TESTING. ST1184.2 +039700 SPACE-IS-LESS-THAN-B SECTION. ST1184.2 +039800 SORT-REMARK-B. ST1184.2 +039900 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1184.2 +040000 PERFORM PRINT-DETAIL. ST1184.2 +040100 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. ST1184.2 +040200 PERFORM PRINT-DETAIL. ST1184.2 +040300 MOVE "UNNECESSARY." TO RE-MARK. ST1184.2 +040400 PERFORM PRINT-DETAIL. ST1184.2 +040500 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1184.2 +040600* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1184.2 +040700* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, ST1184.2 +040800* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, ST1184.2 +040900* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. ST1184.2 +041000 SORT-TEST-9. ST1184.2 +041100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +041200 IF SORTKEY-2 EQUAL TO " X" ST1184.2 +041300 PERFORM PASS GO TO SORT-WRITE-9. ST1184.2 +041400 SORT-FAIL-9. ST1184.2 +041500 PERFORM FAIL. ST1184.2 +041600 MOVE SORTKEY-2 TO COMPUTED-A. ST1184.2 +041700 MOVE " X" TO CORRECT-A. ST1184.2 +041800 SORT-WRITE-9. ST1184.2 +041900 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1184.2 +042000 PERFORM PRINT-DETAIL. ST1184.2 +042100 SORT-TEST-10. ST1184.2 +042200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +042300 IF SORTKEY-4 EQUAL TO " X" ST1184.2 +042400 PERFORM PASS GO TO SORT-WRITE-10. ST1184.2 +042500 SORT-FAIL-10. ST1184.2 +042600 PERFORM FAIL. ST1184.2 +042700 MOVE SORTKEY-4 TO COMPUTED-A. ST1184.2 +042800 MOVE " X" TO CORRECT-A. ST1184.2 +042900 SORT-WRITE-10. ST1184.2 +043000 MOVE "SORT-TEST-10" TO PAR-NAME. ST1184.2 +043100 PERFORM PRINT-DETAIL. ST1184.2 +043200 SORT-TEST-11. ST1184.2 +043300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +043400 IF SORTKEY-7 EQUAL TO 418 ST1184.2 +043500 PERFORM PASS GO TO SORT-WRITE-11. ST1184.2 +043600 SORT-FAIL-11. ST1184.2 +043700 PERFORM FAIL. ST1184.2 +043800 MOVE SORTKEY-7 TO COMPUTED-N ST1184.2 +043900 MOVE 418 TO CORRECT-N. ST1184.2 +044000 SORT-WRITE-11. ST1184.2 +044100 MOVE "SORT-TEST-11" TO PAR-NAME. ST1184.2 +044200 PERFORM PRINT-DETAIL. ST1184.2 +044300 SORT-TEST-12. ST1184.2 +044400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +044500 IF SORTKEY-8 EQUAL TO -14 ST1184.2 +044600 PERFORM PASS GO TO SORT-WRITE-12. ST1184.2 +044700 SORT-FAIL-12. ST1184.2 +044800 PERFORM FAIL. ST1184.2 +044900 MOVE SORTKEY-8 TO COMPUTED-N. ST1184.2 +045000 MOVE -14 TO CORRECT-N. ST1184.2 +045100 SORT-WRITE-12. ST1184.2 +045200 MOVE "SORT-TEST-12" TO PAR-NAME. ST1184.2 +045300 PERFORM PRINT-DETAIL. ST1184.2 +045400 SORT-TEST-13. ST1184.2 +045500 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +045600 IF SORTKEY-6 EQUAL TO "Z " ST1184.2 +045700 PERFORM PASS GO TO SORT-WRITE-13. ST1184.2 +045800 SORT-FAIL-13. ST1184.2 +045900 PERFORM FAIL. ST1184.2 +046000 MOVE SORTKEY-6 TO COMPUTED-A. ST1184.2 +046100 MOVE "Z " TO CORRECT-A. ST1184.2 +046200 SORT-WRITE-13. ST1184.2 +046300 MOVE "SORT-TEST-13" TO PAR-NAME. ST1184.2 +046400 PERFORM PRINT-DETAIL. ST1184.2 +046500 SORT-TEST-14. ST1184.2 +046600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +046700 IF SORTKEY-5 EQUAL TO "Z " ST1184.2 +046800 PERFORM PASS GO TO SORT-WRITE-14. ST1184.2 +046900 SORT-FAIL-14. ST1184.2 +047000 PERFORM FAIL. ST1184.2 +047100 MOVE SORTKEY-5 TO COMPUTED-A. ST1184.2 +047200 MOVE "Z " TO CORRECT-A. ST1184.2 +047300 SORT-WRITE-14. ST1184.2 +047400 MOVE "SORT-TEST-14" TO PAR-NAME. ST1184.2 +047500 PERFORM PRINT-DETAIL. ST1184.2 +047600 SORT-TEST-15. ST1184.2 +047700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +047800 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1184.2 +047900 PERFORM PASS GO TO SORT-WRITE-15. ST1184.2 +048000 SORT-FAIL-15. ST1184.2 +048100 PERFORM FAIL. ST1184.2 +048200 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1184.2 +048300 MOVE +.6000000000000000 TO CORRECT-0V18. ST1184.2 +048400 SORT-WRITE-15. ST1184.2 +048500 MOVE "SORT-TEST-15" TO PAR-NAME. ST1184.2 +048600 PERFORM PRINT-DETAIL. ST1184.2 +048700 SORT-TEST-16. ST1184.2 +048800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1184.2 +048900 IF SORTKEY-1 EQUAL TO +123456 ST1184.2 +049000 PERFORM PASS GO TO SORT-WRITE-16. ST1184.2 +049100 SORT-FAIL-16. ST1184.2 +049200 PERFORM FAIL. ST1184.2 +049300 MOVE SORTKEY-1 TO COMPUTED-N. ST1184.2 +049400 MOVE +123456 TO CORRECT-N. ST1184.2 +049500 SORT-WRITE-16. ST1184.2 +049600 MOVE "SORT-TEST-16" TO PAR-NAME. ST1184.2 +049700 PERFORM PRINT-DETAIL. ST1184.2 +049800 CONTINUE-TESTING SECTION. ST1184.2 +049900 SORT-TEST-17. ST1184.2 +050000 RETURN SORTFILE-1H AT END ST1184.2 +050100 PERFORM PASS GO TO SORT-WRITE-17. ST1184.2 +050200 SORT-FAIL-17. ST1184.2 +050300 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1184.2 +050400 PERFORM FAIL. ST1184.2 +050500 SORT-WRITE-17. ST1184.2 +050600 MOVE "SORT-TEST-17" TO PAR-NAME. ST1184.2 +050700 PERFORM PRINT-DETAIL. ST1184.2 +050800 GO TO OUTPROC-EXIT. ST1184.2 +050900 RETURN-ERROR. ST1184.2 +051000 MOVE "RETURN-ERROR" TO PAR-NAME. ST1184.2 +051100 PERFORM FAIL. ST1184.2 +051200 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1184.2 +051300 PERFORM PRINT-DETAIL. ST1184.2 +051400 GO TO CCVS1-EXIT. ST1184.2 +051500 CLOSE-FILES. ST1184.2 +051600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1184.2 +051700 TERMINATE-CCVS. ST1184.2 +051800*S EXIT PROGRAM. ST1184.2 +051900*SERMINATE-CALL. ST1184.2 +052000 STOP RUN. ST1184.2 +052100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1184.2 +052200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1184.2 +052300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1184.2 +052400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1184.2 +052500 MOVE "****TEST DELETED****" TO RE-MARK. ST1184.2 +052600 PRINT-DETAIL. ST1184.2 +052700 IF REC-CT NOT EQUAL TO ZERO ST1184.2 +052800 MOVE "." TO PARDOT-X ST1184.2 +052900 MOVE REC-CT TO DOTVALUE. ST1184.2 +053000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1184.2 +053100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1184.2 +053200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1184.2 +053300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1184.2 +053400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1184.2 +053500 MOVE SPACE TO CORRECT-X. ST1184.2 +053600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1184.2 +053700 MOVE SPACE TO RE-MARK. ST1184.2 +053800 HEAD-ROUTINE. ST1184.2 +053900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +054000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +054100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1184.2 +054200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1184.2 +054300 COLUMN-NAMES-ROUTINE. ST1184.2 +054400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +054500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +054600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +054700 END-ROUTINE. ST1184.2 +054800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1184.2 +054900 END-RTN-EXIT. ST1184.2 +055000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +055100 END-ROUTINE-1. ST1184.2 +055200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1184.2 +055300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1184.2 +055400 ADD PASS-COUNTER TO ERROR-HOLD. ST1184.2 +055500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1184.2 +055600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1184.2 +055700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1184.2 +055800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1184.2 +055900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1184.2 +056000 END-ROUTINE-12. ST1184.2 +056100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1184.2 +056200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1184.2 +056300 MOVE "NO " TO ERROR-TOTAL ST1184.2 +056400 ELSE ST1184.2 +056500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1184.2 +056600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1184.2 +056700 PERFORM WRITE-LINE. ST1184.2 +056800 END-ROUTINE-13. ST1184.2 +056900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1184.2 +057000 MOVE "NO " TO ERROR-TOTAL ELSE ST1184.2 +057100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1184.2 +057200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1184.2 +057300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +057400 IF INSPECT-COUNTER EQUAL TO ZERO ST1184.2 +057500 MOVE "NO " TO ERROR-TOTAL ST1184.2 +057600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1184.2 +057700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1184.2 +057800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +057900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1184.2 +058000 WRITE-LINE. ST1184.2 +058100 ADD 1 TO RECORD-COUNT. ST1184.2 +058200 IF RECORD-COUNT GREATER 42 ST1184.2 +058300 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1184.2 +058400 MOVE SPACE TO DUMMY-RECORD ST1184.2 +058500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1184.2 +058600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1184.2 +058700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1184.2 +058800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1184.2 +058900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1184.2 +059000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1184.2 +059100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1184.2 +059200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1184.2 +059300 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1184.2 +059400 MOVE ZERO TO RECORD-COUNT. ST1184.2 +059500 PERFORM WRT-LN. ST1184.2 +059600 WRT-LN. ST1184.2 +059700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1184.2 +059800 MOVE SPACE TO DUMMY-RECORD. ST1184.2 +059900 BLANK-LINE-PRINT. ST1184.2 +060000 PERFORM WRT-LN. ST1184.2 +060100 FAIL-ROUTINE. ST1184.2 +060200 IF COMPUTED-X NOT EQUAL TO SPACE ST1184.2 +060300 GO TO FAIL-ROUTINE-WRITE. ST1184.2 +060400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1184.2 +060500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1184.2 +060600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1184.2 +060700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +060800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1184.2 +060900 GO TO FAIL-ROUTINE-EX. ST1184.2 +061000 FAIL-ROUTINE-WRITE. ST1184.2 +061100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1184.2 +061200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1184.2 +061300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1184.2 +061400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1184.2 +061500 FAIL-ROUTINE-EX. EXIT. ST1184.2 +061600 BAIL-OUT. ST1184.2 +061700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1184.2 +061800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1184.2 +061900 BAIL-OUT-WRITE. ST1184.2 +062000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1184.2 +062100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1184.2 +062200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1184.2 +062300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1184.2 +062400 BAIL-OUT-EX. EXIT. ST1184.2 +062500 CCVS1-EXIT. ST1184.2 +062600 EXIT. ST1184.2 +062700 OUTPROC-EXIT SECTION. ST1184.2 +062800 EXIT-ONLY. ST1184.2 +062900 PERFORM CLOSE-FILES. ST1184.2 diff --git a/tests/cobol85/ST/ST119A.CBL b/tests/cobol85/ST/ST119A.CBL new file mode 100755 index 00000000..30f15587 --- /dev/null +++ b/tests/cobol85/ST/ST119A.CBL @@ -0,0 +1,999 @@ +000100 IDENTIFICATION DIVISION. ST1194.2 +000200 PROGRAM-ID. ST1194.2 +000300 ST119A. ST1194.2 +000400**************************************************************** ST1194.2 +000500* * ST1194.2 +000600* VALIDATION FOR:- * ST1194.2 +000700* * ST1194.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1194.2 +000900* * ST1194.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1194.2 +001100* * ST1194.2 +001200**************************************************************** ST1194.2 +001300* * ST1194.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1194.2 +001500* * ST1194.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1194.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1194.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1194.2 +001900* * ST1194.2 +002000**************************************************************** ST1194.2 +002100 ENVIRONMENT DIVISION. ST1194.2 +002200 CONFIGURATION SECTION. ST1194.2 +002300 SOURCE-COMPUTER. ST1194.2 +002400 Linux. ST1194.2 +002500 OBJECT-COMPUTER. ST1194.2 +002600 Linux. ST1194.2 +002700 INPUT-OUTPUT SECTION. ST1194.2 +002800 FILE-CONTROL. ST1194.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1194.2 +003000 "report.log". ST1194.2 +003100 SELECT SORTFILE-1A ASSIGN TO ST1194.2 +003200 "XXXXX027". ST1194.2 +003300 SELECT SORTOUT-1A ASSIGN TO ST1194.2 +003400 "XXXXX001". ST1194.2 +003500 DATA DIVISION. ST1194.2 +003600 FILE SECTION. ST1194.2 +003700 FD PRINT-FILE. ST1194.2 +003800 01 PRINT-REC PICTURE X(120). ST1194.2 +003900 01 DUMMY-RECORD PICTURE X(120). ST1194.2 +004000 SD SORTFILE-1A ST1194.2 +004100 DATA RECORD IS S-RECORD. ST1194.2 +004200 01 S-RECORD. ST1194.2 +004300 02 KEYS-GROUP. ST1194.2 +004400 03 KEY-1 PICTURE 9. ST1194.2 +004500 03 KEY-2 PICTURE 99. ST1194.2 +004600 03 KEY-3 PICTURE 999. ST1194.2 +004700 03 KEY-4 PICTURE 9999. ST1194.2 +004800 03 KEY-5 PICTURE 9(5). ST1194.2 +004900 02 RDF-KEYS REDEFINES KEYS-GROUP PICTURE 9(15). ST1194.2 +005000 02 FILLER PICTURE X(105). ST1194.2 +005100 FD SORTOUT-1A ST1194.2 +005200 BLOCK CONTAINS 10 RECORDS ST1194.2 +005300 LABEL RECORDS ARE STANDARD ST1194.2 +005400*C VALUE OF ST1194.2 +005500*C OCLABELID ST1194.2 +005600*C IS ST1194.2 +005700*C "OCDUMMY" ST1194.2 +005800*G SYSIN ST1194.2 +005900 DATA RECORD IS SORTED. ST1194.2 +006000 01 SORTED PICTURE X(120). ST1194.2 +006100 WORKING-STORAGE SECTION. ST1194.2 +006200 77 COMMENT-SENTENCE PIC X(120) VALUE " THE FILE BUILT IN ST119A ST1194.2 +006300- "IS SORTED IN ST120A. ST120A DOES NOT PRODUCE A REPORT - THEST1194.2 +006400- " RESULTS ARE CHECKED IN ST121A.". ST1194.2 +006500 77 WRK-XN-00001-1 PIC X. ST1194.2 +006600 77 WRK-XN-00001-2 PIC X. ST1194.2 +006700 77 WRK-XN-00001-3 PIC X. ST1194.2 +006800 77 C0 PICTURE 9 VALUE 0. ST1194.2 +006900 77 C1 PICTURE 9 VALUE 1. ST1194.2 +007000 77 C2 PICTURE 9 VALUE 2. ST1194.2 +007100 77 C6 PICTURE 9 VALUE 6. ST1194.2 +007200 77 C3 PICTURE 9 VALUE 3. ST1194.2 +007300 01 WKEYS-GROUP. ST1194.2 +007400 02 WKEY-1 PICTURE 9. ST1194.2 +007500 02 WKEY-2 PICTURE 99. ST1194.2 +007600 02 WKEY-3 PICTURE 999. ST1194.2 +007700 02 WKEY-4 PICTURE 9999. ST1194.2 +007800 02 WKEY-5 PICTURE 9(5). ST1194.2 +007900 01 WKEYS-RDF REDEFINES WKEYS-GROUP PICTURE 9(15). ST1194.2 +008000 01 TEST-RESULTS. ST1194.2 +008100 02 FILLER PIC X VALUE SPACE. ST1194.2 +008200 02 FEATURE PIC X(20) VALUE SPACE. ST1194.2 +008300 02 FILLER PIC X VALUE SPACE. ST1194.2 +008400 02 P-OR-F PIC X(5) VALUE SPACE. ST1194.2 +008500 02 FILLER PIC X VALUE SPACE. ST1194.2 +008600 02 PAR-NAME. ST1194.2 +008700 03 FILLER PIC X(19) VALUE SPACE. ST1194.2 +008800 03 PARDOT-X PIC X VALUE SPACE. ST1194.2 +008900 03 DOTVALUE PIC 99 VALUE ZERO. ST1194.2 +009000 02 FILLER PIC X(8) VALUE SPACE. ST1194.2 +009100 02 RE-MARK PIC X(61). ST1194.2 +009200 01 TEST-COMPUTED. ST1194.2 +009300 02 FILLER PIC X(30) VALUE SPACE. ST1194.2 +009400 02 FILLER PIC X(17) VALUE ST1194.2 +009500 " COMPUTED=". ST1194.2 +009600 02 COMPUTED-X. ST1194.2 +009700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1194.2 +009800 03 COMPUTED-N REDEFINES COMPUTED-A ST1194.2 +009900 PIC -9(9).9(9). ST1194.2 +010000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1194.2 +010100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1194.2 +010200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1194.2 +010300 03 CM-18V0 REDEFINES COMPUTED-A. ST1194.2 +010400 04 COMPUTED-18V0 PIC -9(18). ST1194.2 +010500 04 FILLER PIC X. ST1194.2 +010600 03 FILLER PIC X(50) VALUE SPACE. ST1194.2 +010700 01 TEST-CORRECT. ST1194.2 +010800 02 FILLER PIC X(30) VALUE SPACE. ST1194.2 +010900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1194.2 +011000 02 CORRECT-X. ST1194.2 +011100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1194.2 +011200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1194.2 +011300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1194.2 +011400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1194.2 +011500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1194.2 +011600 03 CR-18V0 REDEFINES CORRECT-A. ST1194.2 +011700 04 CORRECT-18V0 PIC -9(18). ST1194.2 +011800 04 FILLER PIC X. ST1194.2 +011900 03 FILLER PIC X(2) VALUE SPACE. ST1194.2 +012000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1194.2 +012100 01 CCVS-C-1. ST1194.2 +012200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1194.2 +012300- "SS PARAGRAPH-NAME ST1194.2 +012400- " REMARKS". ST1194.2 +012500 02 FILLER PIC X(20) VALUE SPACE. ST1194.2 +012600 01 CCVS-C-2. ST1194.2 +012700 02 FILLER PIC X VALUE SPACE. ST1194.2 +012800 02 FILLER PIC X(6) VALUE "TESTED". ST1194.2 +012900 02 FILLER PIC X(15) VALUE SPACE. ST1194.2 +013000 02 FILLER PIC X(4) VALUE "FAIL". ST1194.2 +013100 02 FILLER PIC X(94) VALUE SPACE. ST1194.2 +013200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1194.2 +013300 01 REC-CT PIC 99 VALUE ZERO. ST1194.2 +013400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1194.2 +013500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1194.2 +013600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1194.2 +013700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1194.2 +013800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1194.2 +013900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1194.2 +014000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1194.2 +014100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1194.2 +014200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1194.2 +014300 01 CCVS-H-1. ST1194.2 +014400 02 FILLER PIC X(39) VALUE SPACES. ST1194.2 +014500 02 FILLER PIC X(42) VALUE ST1194.2 +014600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1194.2 +014700 02 FILLER PIC X(39) VALUE SPACES. ST1194.2 +014800 01 CCVS-H-2A. ST1194.2 +014900 02 FILLER PIC X(40) VALUE SPACE. ST1194.2 +015000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1194.2 +015100 02 FILLER PIC XXXX VALUE ST1194.2 +015200 "4.2 ". ST1194.2 +015300 02 FILLER PIC X(28) VALUE ST1194.2 +015400 " COPY - NOT FOR DISTRIBUTION". ST1194.2 +015500 02 FILLER PIC X(41) VALUE SPACE. ST1194.2 +015600 ST1194.2 +015700 01 CCVS-H-2B. ST1194.2 +015800 02 FILLER PIC X(15) VALUE ST1194.2 +015900 "TEST RESULT OF ". ST1194.2 +016000 02 TEST-ID PIC X(9). ST1194.2 +016100 02 FILLER PIC X(4) VALUE ST1194.2 +016200 " IN ". ST1194.2 +016300 02 FILLER PIC X(12) VALUE ST1194.2 +016400 " HIGH ". ST1194.2 +016500 02 FILLER PIC X(22) VALUE ST1194.2 +016600 " LEVEL VALIDATION FOR ". ST1194.2 +016700 02 FILLER PIC X(58) VALUE ST1194.2 +016800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1194.2 +016900 01 CCVS-H-3. ST1194.2 +017000 02 FILLER PIC X(34) VALUE ST1194.2 +017100 " FOR OFFICIAL USE ONLY ". ST1194.2 +017200 02 FILLER PIC X(58) VALUE ST1194.2 +017300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1194.2 +017400 02 FILLER PIC X(28) VALUE ST1194.2 +017500 " COPYRIGHT 1985 ". ST1194.2 +017600 01 CCVS-E-1. ST1194.2 +017700 02 FILLER PIC X(52) VALUE SPACE. ST1194.2 +017800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1194.2 +017900 02 ID-AGAIN PIC X(9). ST1194.2 +018000 02 FILLER PIC X(45) VALUE SPACES. ST1194.2 +018100 01 CCVS-E-2. ST1194.2 +018200 02 FILLER PIC X(31) VALUE SPACE. ST1194.2 +018300 02 FILLER PIC X(21) VALUE SPACE. ST1194.2 +018400 02 CCVS-E-2-2. ST1194.2 +018500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1194.2 +018600 03 FILLER PIC X VALUE SPACE. ST1194.2 +018700 03 ENDER-DESC PIC X(44) VALUE ST1194.2 +018800 "ERRORS ENCOUNTERED". ST1194.2 +018900 01 CCVS-E-3. ST1194.2 +019000 02 FILLER PIC X(22) VALUE ST1194.2 +019100 " FOR OFFICIAL USE ONLY". ST1194.2 +019200 02 FILLER PIC X(12) VALUE SPACE. ST1194.2 +019300 02 FILLER PIC X(58) VALUE ST1194.2 +019400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1194.2 +019500 02 FILLER PIC X(13) VALUE SPACE. ST1194.2 +019600 02 FILLER PIC X(15) VALUE ST1194.2 +019700 " COPYRIGHT 1985". ST1194.2 +019800 01 CCVS-E-4. ST1194.2 +019900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1194.2 +020000 02 FILLER PIC X(4) VALUE " OF ". ST1194.2 +020100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1194.2 +020200 02 FILLER PIC X(40) VALUE ST1194.2 +020300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1194.2 +020400 01 XXINFO. ST1194.2 +020500 02 FILLER PIC X(19) VALUE ST1194.2 +020600 "*** INFORMATION ***". ST1194.2 +020700 02 INFO-TEXT. ST1194.2 +020800 04 FILLER PIC X(8) VALUE SPACE. ST1194.2 +020900 04 XXCOMPUTED PIC X(20). ST1194.2 +021000 04 FILLER PIC X(5) VALUE SPACE. ST1194.2 +021100 04 XXCORRECT PIC X(20). ST1194.2 +021200 02 INF-ANSI-REFERENCE PIC X(48). ST1194.2 +021300 01 HYPHEN-LINE. ST1194.2 +021400 02 FILLER PIC IS X VALUE IS SPACE. ST1194.2 +021500 02 FILLER PIC IS X(65) VALUE IS "************************ST1194.2 +021600- "*****************************************". ST1194.2 +021700 02 FILLER PIC IS X(54) VALUE IS "************************ST1194.2 +021800- "******************************". ST1194.2 +021900 01 CCVS-PGM-ID PIC X(9) VALUE ST1194.2 +022000 "ST119A". ST1194.2 +022100 PROCEDURE DIVISION. ST1194.2 +022200 CCVS1 SECTION. ST1194.2 +022300 OPEN-FILES. ST1194.2 +022400 OPEN OUTPUT PRINT-FILE. ST1194.2 +022500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1194.2 +022600 MOVE SPACE TO TEST-RESULTS. ST1194.2 +022700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1194.2 +022800 GO TO CCVS1-EXIT. ST1194.2 +022900 CLOSE-FILES. ST1194.2 +023000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1194.2 +023100 TERMINATE-CCVS. ST1194.2 +023200*S EXIT PROGRAM. ST1194.2 +023300*SERMINATE-CALL. ST1194.2 +023400 STOP RUN. ST1194.2 +023500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1194.2 +023600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1194.2 +023700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1194.2 +023800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1194.2 +023900 MOVE "****TEST DELETED****" TO RE-MARK. ST1194.2 +024000 PRINT-DETAIL. ST1194.2 +024100 IF REC-CT NOT EQUAL TO ZERO ST1194.2 +024200 MOVE "." TO PARDOT-X ST1194.2 +024300 MOVE REC-CT TO DOTVALUE. ST1194.2 +024400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1194.2 +024500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1194.2 +024600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1194.2 +024700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1194.2 +024800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1194.2 +024900 MOVE SPACE TO CORRECT-X. ST1194.2 +025000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1194.2 +025100 MOVE SPACE TO RE-MARK. ST1194.2 +025200 HEAD-ROUTINE. ST1194.2 +025300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +025400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +025500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1194.2 +025600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1194.2 +025700 COLUMN-NAMES-ROUTINE. ST1194.2 +025800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +025900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +026000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +026100 END-ROUTINE. ST1194.2 +026200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1194.2 +026300 END-RTN-EXIT. ST1194.2 +026400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +026500 END-ROUTINE-1. ST1194.2 +026600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1194.2 +026700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1194.2 +026800 ADD PASS-COUNTER TO ERROR-HOLD. ST1194.2 +026900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1194.2 +027000 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1194.2 +027100 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1194.2 +027200 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1194.2 +027300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1194.2 +027400 END-ROUTINE-12. ST1194.2 +027500 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1194.2 +027600 IF ERROR-COUNTER IS EQUAL TO ZERO ST1194.2 +027700 MOVE "NO " TO ERROR-TOTAL ST1194.2 +027800 ELSE ST1194.2 +027900 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1194.2 +028000 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1194.2 +028100 PERFORM WRITE-LINE. ST1194.2 +028200 END-ROUTINE-13. ST1194.2 +028300 IF DELETE-COUNTER IS EQUAL TO ZERO ST1194.2 +028400 MOVE "NO " TO ERROR-TOTAL ELSE ST1194.2 +028500 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1194.2 +028600 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1194.2 +028700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +028800 IF INSPECT-COUNTER EQUAL TO ZERO ST1194.2 +028900 MOVE "NO " TO ERROR-TOTAL ST1194.2 +029000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1194.2 +029100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1194.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +029300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1194.2 +029400 WRITE-LINE. ST1194.2 +029500 ADD 1 TO RECORD-COUNT. ST1194.2 +029600 IF RECORD-COUNT GREATER 42 ST1194.2 +029700 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1194.2 +029800 MOVE SPACE TO DUMMY-RECORD ST1194.2 +029900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1194.2 +030000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1194.2 +030100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1194.2 +030200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1194.2 +030300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1194.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1194.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1194.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1194.2 +030700 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1194.2 +030800 MOVE ZERO TO RECORD-COUNT. ST1194.2 +030900 PERFORM WRT-LN. ST1194.2 +031000 WRT-LN. ST1194.2 +031100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1194.2 +031200 MOVE SPACE TO DUMMY-RECORD. ST1194.2 +031300 BLANK-LINE-PRINT. ST1194.2 +031400 PERFORM WRT-LN. ST1194.2 +031500 FAIL-ROUTINE. ST1194.2 +031600 IF COMPUTED-X NOT EQUAL TO SPACE ST1194.2 +031700 GO TO FAIL-ROUTINE-WRITE. ST1194.2 +031800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1194.2 +031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1194.2 +032000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1194.2 +032100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +032200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1194.2 +032300 GO TO FAIL-ROUTINE-EX. ST1194.2 +032400 FAIL-ROUTINE-WRITE. ST1194.2 +032500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1194.2 +032600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1194.2 +032700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1194.2 +032800 MOVE SPACES TO COR-ANSI-REFERENCE. ST1194.2 +032900 FAIL-ROUTINE-EX. EXIT. ST1194.2 +033000 BAIL-OUT. ST1194.2 +033100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1194.2 +033200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1194.2 +033300 BAIL-OUT-WRITE. ST1194.2 +033400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1194.2 +033500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1194.2 +033600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1194.2 +033700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1194.2 +033800 BAIL-OUT-EX. EXIT. ST1194.2 +033900 CCVS1-EXIT. ST1194.2 +034000 EXIT. ST1194.2 +034100 ST1194.2 +034200 SORT-INIT SECTION. ST1194.2 +034300 MAIN-SORT-PARAGRAPH. ST1194.2 +034400 SORT SORTFILE-1A ST1194.2 +034500 ON ASCENDING KEY KEY-1 ST1194.2 +034600 ON DESCENDING KEY KEY-2 ST1194.2 +034700 ON ASCENDING KEY KEY-3 ST1194.2 +034800 DESCENDING KEY-4 KEY-5 ST1194.2 +034900 INPUT PROCEDURE IS IN-1 THROUGH IN-EXIT ST1194.2 +035000 OUTPUT PROCEDURE IS OUT-PROC-1 THRU SORT-END. ST1194.2 +035100 ST1194.2 +035200 INTERNAL-OUTPUT-PROC-CODE SECTION. ST1194.2 +035300*================================= ST1194.2 +035400 INT-INIT-1. ST1194.2 +035500* ===--> ACCESSING OF CODE WITHIN THE OUTPUT PROCEDURE <--=== ST1194.2 +035600 MOVE "XI-19 4.4.4 GR(10)" TO ANSI-REFERENCE. ST1194.2 +035700 MOVE "INT-TEST-1" TO PAR-NAME. ST1194.2 +035800 MOVE "INTNL CODE PERFORMED" TO FEATURE. ST1194.2 +035900 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +036000 PERFORM INTERNAL-CODE-1. ST1194.2 +036100 GO TO INT-TEST-1. ST1194.2 +036200 INT-DELETE-1. ST1194.2 +036300 PERFORM DE-LETE. ST1194.2 +036400 PERFORM PRINT-DETAIL. ST1194.2 +036500 GO TO INT-INIT-2. ST1194.2 +036600 INT-TEST-1. ST1194.2 +036700 IF WRK-XN-00001-1 = "C" ST1194.2 +036800 PERFORM PASS ST1194.2 +036900 PERFORM PRINT-DETAIL ST1194.2 +037000 ELSE ST1194.2 +037100 MOVE "INTERNAL OUTPUT PROC CODE NOT PERFORMED" ST1194.2 +037200 TO RE-MARK ST1194.2 +037300 MOVE "C" TO CORRECT-X ST1194.2 +037400 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +037500 PERFORM FAIL ST1194.2 +037600 PERFORM PRINT-DETAIL. ST1194.2 +037700 ST1194.2 +037800 INT-INIT-2. ST1194.2 +037900* ===--> ACCESSING OF CODE WITHIN THE OUTPUT PROCEDURE <--=== ST1194.2 +038000 MOVE "XI-19 4.4.4 GR(10)" TO ANSI-REFERENCE. ST1194.2 +038100 MOVE "INT-TEST-2-1" TO PAR-NAME. ST1194.2 +038200 MOVE "GO TO INTERNAL CODE" TO FEATURE. ST1194.2 +038300 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +038400 MOVE "Y" TO WRK-XN-00001-2. ST1194.2 +038500 MOVE 1 TO REC-CT. ST1194.2 +038600 GO TO INTERNAL-CODE-2. ST1194.2 +038700 INT-FAIL-2-1. ST1194.2 +038800 MOVE "X" TO WRK-XN-00001-2. ST1194.2 +038900 GO TO INT-TEST-2-2. ST1194.2 +039000 INT-DELETE-2-1. ST1194.2 +039100 PERFORM DE-LETE. ST1194.2 +039200 PERFORM PRINT-DETAIL. ST1194.2 +039300 GO TO INT-INIT-3. ST1194.2 +039400 INT-TEST-2-1. ST1194.2 +039500 IF WRK-XN-00001-2 = "Y" ST1194.2 +039600 PERFORM PASS ST1194.2 +039700 PERFORM PRINT-DETAIL ST1194.2 +039800 GO TO INT-TEST-2-2. ST1194.2 +039900 MOVE "GO TO INTERNAL CODE ERROR OR RETURN FROM CODE ERROR" ST1194.2 +040000 TO RE-MARK. ST1194.2 +040100 MOVE "Y" TO CORRECT-X. ST1194.2 +040200 MOVE WRK-XN-00001-2 TO COMPUTED-X. ST1194.2 +040300 PERFORM FAIL. ST1194.2 +040400 PERFORM PRINT-DETAIL. ST1194.2 +040500 INT-TEST-2-2. ST1194.2 +040600 MOVE "INT-TEST-2-1" TO PAR-NAME. ST1194.2 +040700 ADD 1 TO REC-CT. ST1194.2 +040800 IF WRK-XN-00001-1 = "D" ST1194.2 +040900 PERFORM PASS ST1194.2 +041000 PERFORM PRINT-DETAIL ST1194.2 +041100 ELSE ST1194.2 +041200 MOVE "GO TO INTERNAL OUTPUT PROC. CODE ERROR" ST1194.2 +041300 TO RE-MARK ST1194.2 +041400 MOVE "D" TO CORRECT-X ST1194.2 +041500 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +041600 PERFORM FAIL ST1194.2 +041700 PERFORM PRINT-DETAIL. ST1194.2 +041800 ST1194.2 +041900 INTERNAL-INPUT-PROC-CODE SECTION. ST1194.2 +042000*================================ ST1194.2 +042100 INT-INIT-3. ST1194.2 +042200* ===--> ACCESSING OF CODE WITHIN THE INPUT PROCEDURE <--=== ST1194.2 +042300 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +042400 MOVE "INT-TEST-3" TO PAR-NAME. ST1194.2 +042500 MOVE "INTNL CODE PERFORMED" TO FEATURE. ST1194.2 +042600 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +042700 PERFORM INTERNAL-CODE-3. ST1194.2 +042800 GO TO INT-TEST-3. ST1194.2 +042900 INT-DELETE-3. ST1194.2 +043000 PERFORM DE-LETE. ST1194.2 +043100 PERFORM PRINT-DETAIL. ST1194.2 +043200 GO TO INT-INIT-4. ST1194.2 +043300 INT-TEST-3. ST1194.2 +043400 IF WRK-XN-00001-1 = "L" ST1194.2 +043500 PERFORM PASS ST1194.2 +043600 PERFORM PRINT-DETAIL ST1194.2 +043700 ELSE ST1194.2 +043800 MOVE "INTERNAL INPUT PROC CODE NOT PERFORMED" ST1194.2 +043900 TO RE-MARK ST1194.2 +044000 MOVE "L" TO CORRECT-X ST1194.2 +044100 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +044200 PERFORM FAIL ST1194.2 +044300 PERFORM PRINT-DETAIL. ST1194.2 +044400 ST1194.2 +044500 INT-INIT-4. ST1194.2 +044600* ===--> ACCESSING OF CODE WITHIN THE OUTPUT PROCEDURE <--=== ST1194.2 +044700 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +044800 MOVE "INT-TEST-4-1" TO PAR-NAME. ST1194.2 +044900 MOVE "GO TO INTERNAL CODE" TO FEATURE. ST1194.2 +045000 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +045100 MOVE "N" TO WRK-XN-00001-2. ST1194.2 +045200 MOVE 1 TO REC-CT. ST1194.2 +045300 GO TO INTERNAL-CODE-4. ST1194.2 +045400 INT-FAIL-4-1. ST1194.2 +045500 MOVE "O" TO WRK-XN-00001-2. ST1194.2 +045600 GO TO INT-TEST-4-1. ST1194.2 +045700 INT-DELETE-4. ST1194.2 +045800 PERFORM DE-LETE. ST1194.2 +045900 PERFORM PRINT-DETAIL. ST1194.2 +046000 GO TO I-2. ST1194.2 +046100 INT-TEST-4-1. ST1194.2 +046200 IF WRK-XN-00001-2 = "N" ST1194.2 +046300 PERFORM PASS ST1194.2 +046400 PERFORM PRINT-DETAIL ST1194.2 +046500 GO TO INT-TEST-4-2. ST1194.2 +046600 MOVE "GO TO INTERNAL CODE ERROR OR RETURN FROM CODE ERROR" ST1194.2 +046700 TO RE-MARK. ST1194.2 +046800 MOVE "N" TO CORRECT-X. ST1194.2 +046900 MOVE WRK-XN-00001-2 TO COMPUTED-X. ST1194.2 +047000 PERFORM FAIL. ST1194.2 +047100 PERFORM PRINT-DETAIL. ST1194.2 +047200 INT-TEST-4-2. ST1194.2 +047300 MOVE "INT-TEST-4-2" TO PAR-NAME. ST1194.2 +047400 ADD 1 TO REC-CT. ST1194.2 +047500 IF WRK-XN-00001-1 = "M" ST1194.2 +047600 PERFORM PASS ST1194.2 +047700 PERFORM PRINT-DETAIL ST1194.2 +047800 ELSE ST1194.2 +047900 MOVE "GO TO INTERNAL OUTPUT PROC. CODE ERROR" ST1194.2 +048000 TO RE-MARK ST1194.2 +048100 MOVE "M" TO CORRECT-X ST1194.2 +048200 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +048300 PERFORM FAIL ST1194.2 +048400 PERFORM PRINT-DETAIL. ST1194.2 +048500 ST1194.2 +048600 I-2. ST1194.2 +048700 GO TO CCVS-EXIT. ST1194.2 +048800 ST1194.2 +048900 IN-1. ST1194.2 +049000 INPT-INIT-1. ST1194.2 +049100* ===--> ACCESSING OF CODE OUTSIDE THE INPUT PROCEDURE <--=== ST1194.2 +049200 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +049300 MOVE "INPT-TEST-1" TO PAR-NAME. ST1194.2 +049400 MOVE "PERFORM EXTNL CODE" TO FEATURE. ST1194.2 +049500 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +049600 PERFORM EXTERNAL-CODE-3. ST1194.2 +049700 GO TO INPT-TEST-1. ST1194.2 +049800 INPT-DELETE-1. ST1194.2 +049900 PERFORM DE-LETE. ST1194.2 +050000 PERFORM PRINT-DETAIL. ST1194.2 +050100 GO TO INPT-INIT-2. ST1194.2 +050200 INPT-TEST-1. ST1194.2 +050300 IF WRK-XN-00001-1 = "J" ST1194.2 +050400 PERFORM PASS ST1194.2 +050500 PERFORM PRINT-DETAIL ST1194.2 +050600 ELSE ST1194.2 +050700 MOVE "EXTERNAL CODE NOT PERFORMED FROM INPUT PROC" ST1194.2 +050800 TO RE-MARK ST1194.2 +050900 MOVE "J" TO CORRECT-X ST1194.2 +051000 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +051100 PERFORM FAIL ST1194.2 +051200 PERFORM PRINT-DETAIL. ST1194.2 +051300 ST1194.2 +051400 INPT-INIT-2. ST1194.2 +051500 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +051600 MOVE "INPT-TEST-2-1" TO PAR-NAME. ST1194.2 +051700 MOVE "GO TO EXTERNAL CODE" TO FEATURE. ST1194.2 +051800 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +051900 MOVE "S" TO WRK-XN-00001-2. ST1194.2 +052000 MOVE 1 TO REC-CT. ST1194.2 +052100 GO TO EXTERNAL-CODE-4. ST1194.2 +052200 INPT-FAIL-2-1. ST1194.2 +052300 MOVE "W" TO WRK-XN-00001-1. ST1194.2 +052400 GO TO INPT-TEST-2-1. ST1194.2 +052500 INPT-DELETE-2. ST1194.2 +052600 PERFORM DE-LETE. ST1194.2 +052700 PERFORM PRINT-DETAIL. ST1194.2 +052800 GO TO IN-2. ST1194.2 +052900 INPT-TEST-2-1. ST1194.2 +053000 IF WRK-XN-00001-2 = "S" ST1194.2 +053100 PERFORM PASS ST1194.2 +053200 PERFORM PRINT-DETAIL ST1194.2 +053300 GO TO INPT-TEST-2-2. ST1194.2 +053400 MOVE "GO TO EXTERNAL CODE ERROR OR RETURN FROM CODE ERROR" ST1194.2 +053500 TO RE-MARK. ST1194.2 +053600 MOVE "S" TO CORRECT-X. ST1194.2 +053700 MOVE WRK-XN-00001-2 TO COMPUTED-X. ST1194.2 +053800 PERFORM FAIL. ST1194.2 +053900 PERFORM PRINT-DETAIL. ST1194.2 +054000 INPT-TEST-2-2. ST1194.2 +054100 MOVE "INPT-TEST-2-1" TO PAR-NAME. ST1194.2 +054200 ADD 1 TO REC-CT. ST1194.2 +054300 IF WRK-XN-00001-1 = "K" ST1194.2 +054400 PERFORM PASS ST1194.2 +054500 PERFORM PRINT-DETAIL ST1194.2 +054600 ELSE ST1194.2 +054700 MOVE "GO TO EXTERNAL CODE ERROR" ST1194.2 +054800 TO RE-MARK ST1194.2 +054900 MOVE "K" TO CORRECT-X ST1194.2 +055000 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +055100 PERFORM FAIL ST1194.2 +055200 PERFORM PRINT-DETAIL. ST1194.2 +055300 GO TO IN-2. ST1194.2 +055400* ST1194.2 +055500* THE FOLLOWING CODE IS ACCESSED FROM OUTSIDE THE INPUT ST1194.2 +055600* PROCEEDURE: ST1194.2 +055700* ST1194.2 +055800 INTERNAL-CODE-3. ST1194.2 +055900 MOVE "L" TO WRK-XN-00001-1. ST1194.2 +056000 INTERNAL-CODE-4. ST1194.2 +056100 MOVE "M" TO WRK-XN-00001-1. ST1194.2 +056200 GO TO INT-TEST-4-1. ST1194.2 +056300* ST1194.2 +056400* NOTE. ST1194.2 +056500* KEYS 1 AND 3 THRU 5 WILL VARY IN VALUE BETWEEN 1 AND 2. ST1194.2 +056600* KEY 2 VARIES FROM 1 THRU 6. THUS 96 RECORDS ARE CREATED ST1194.2 +056700* IN REVERSE SEQUENCE OF SORTING ORDER. TWO RECORDS ARE ST1194.2 +056800* ADDED TO EACH END OF THE SORTED STRING FOR HI-LOW CONTROL.ST1194.2 +056900* THE SORT STATEMENT TESTS THE SERIES AND THRU OPTIONS WITH ST1194.2 +057000* INCLUSION AND OMISSION OF OPTIONAL WORDS. THE SORT ST1194.2 +057100* STATEMENT REPRESENTS BASIC SORTING PERMITTED BY LEVEL 1 OFST1194.2 +057200* THE SORT MODULE. ST1194.2 +057300 IN-2. ST1194.2 +057400 MOVE 900009000000000 TO RDF-KEYS. ST1194.2 +057500 RELEASE S-RECORD. ST1194.2 +057600 MOVE 009000000900009 TO RDF-KEYS. ST1194.2 +057700 RELEASE S-RECORD. ST1194.2 +057800 MOVE 900008000000000 TO RDF-KEYS. ST1194.2 +057900 RELEASE S-RECORD. ST1194.2 +058000 MOVE 009000000900008 TO RDF-KEYS. ST1194.2 +058100 RELEASE S-RECORD. ST1194.2 +058200* NOTE HI-LOW CONTROL RECORDS DONE. ST1194.2 +058300 MOVE 300003000000000 TO WKEYS-RDF. ST1194.2 +058400 IN-3. ST1194.2 +058500 PERFORM IN-4 2 TIMES. ST1194.2 +058600 GO TO IN-EXIT. ST1194.2 +058700 IN-4. ST1194.2 +058800 SUBTRACT C1 FROM WKEY-1. ST1194.2 +058900 PERFORM IN-5 6 TIMES. ST1194.2 +059000 IN-5. ST1194.2 +059100 IF WKEY-2 IS EQUAL TO C6 ST1194.2 +059200 MOVE C0 TO WKEY-2. ST1194.2 +059300 ADD C1 TO WKEY-2. ST1194.2 +059400 PERFORM IN-6 2 TIMES. ST1194.2 +059500 IN-6. ST1194.2 +059600 IF WKEY-3 IS EQUAL TO C1 ST1194.2 +059700 MOVE C3 TO WKEY-3. ST1194.2 +059800 SUBTRACT C1 FROM WKEY-3. ST1194.2 +059900 PERFORM IN-7 2 TIMES. ST1194.2 +060000 IN-7. ST1194.2 +060100 IF WKEY-4 IS EQUAL TO C2 ST1194.2 +060200 MOVE C0 TO WKEY-4. ST1194.2 +060300 ADD C1 TO WKEY-4. ST1194.2 +060400 PERFORM IN-8 2 TIMES. ST1194.2 +060500 IN-8. ST1194.2 +060600 IF WKEY-5 IS EQUAL TO C2 ST1194.2 +060700 MOVE C0 TO WKEY-5. ST1194.2 +060800 ADD C1 TO WKEY-5. ST1194.2 +060900 MOVE WKEYS-RDF TO RDF-KEYS. ST1194.2 +061000 RELEASE S-RECORD. ST1194.2 +061100 IN-EXIT. ST1194.2 +061200 EXIT. ST1194.2 +061300 ST1194.2 +061400 OUT-PROC-1. ST1194.2 +061500 MOVE SPACES TO PAR-NAME. ST1194.2 +061600 MOVE SPACES TO FEATURE. ST1194.2 +061700 MOVE ZERO TO REC-CT. ST1194.2 +061800 MOVE "XI-19 4.4.4 GR(7)" TO ANSI-REFERENCE. ST1194.2 +061900 MOVE "ST119 GENERATES OUTPUT" TO RE-MARK. ST1194.2 +062000 PERFORM PRINT-DETAIL. ST1194.2 +062100 MOVE "WHICH AFFECTS PROGRAMS" TO RE-MARK. ST1194.2 +062200 PERFORM PRINT-DETAIL. ST1194.2 +062300 MOVE "ST120 AND ST121." TO RE-MARK. ST1194.2 +062400 PERFORM PRINT-DETAIL. ST1194.2 +062500 MOVE "SORT --- FIVE KEYS" TO FEATURE. ST1194.2 +062600 OPEN OUTPUT SORTOUT-1A. ST1194.2 +062700 SORT-TEST-1. ST1194.2 +062800 PERFORM RET-1. ST1194.2 +062900 IF RDF-KEYS EQUAL TO 009000000900009 ST1194.2 +063000 PERFORM PASS GO TO SORT-WRITE-1. ST1194.2 +063100 GO TO SORT-FAIL-1. ST1194.2 +063200 SORT-DELETE-1. ST1194.2 +063300 PERFORM DE-LETE. ST1194.2 +063400 GO TO SORT-WRITE-1. ST1194.2 +063500 SORT-FAIL-1. ST1194.2 +063600 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +063700 MOVE 009000000900009 TO CORRECT-18V0. ST1194.2 +063800 PERFORM FAIL. ST1194.2 +063900 SORT-WRITE-1. ST1194.2 +064000 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1194.2 +064100 PERFORM PRINT-DETAIL. ST1194.2 +064200 SORT-TEST-2. ST1194.2 +064300 PERFORM RET-1. ST1194.2 +064400 IF RDF-KEYS EQUAL TO 009000000900008 ST1194.2 +064500 PERFORM PASS GO TO SORT-WRITE-2. ST1194.2 +064600 GO TO SORT-FAIL-2. ST1194.2 +064700 SORT-DELETE-2. ST1194.2 +064800 PERFORM DE-LETE. ST1194.2 +064900 GO TO SORT-WRITE-2. ST1194.2 +065000 SORT-FAIL-2. ST1194.2 +065100 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +065200 MOVE 009000000900009 TO CORRECT-18V0. ST1194.2 +065300 PERFORM FAIL. ST1194.2 +065400 SORT-WRITE-2. ST1194.2 +065500 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1194.2 +065600 PERFORM PRINT-DETAIL. ST1194.2 +065700 SORT-TEST-3. ST1194.2 +065800 PERFORM RET-1. ST1194.2 +065900 IF RDF-KEYS EQUAL TO 106001000200002 ST1194.2 +066000 PERFORM PASS GO TO SORT-WRITE-3. ST1194.2 +066100 GO TO SORT-FAIL-3. ST1194.2 +066200 SORT-DELETE-3. ST1194.2 +066300 PERFORM DE-LETE. ST1194.2 +066400 GO TO SORT-WRITE-3. ST1194.2 +066500 SORT-FAIL-3. ST1194.2 +066600 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +066700 MOVE 106001000200002 TO CORRECT-18V0. ST1194.2 +066800 PERFORM FAIL. ST1194.2 +066900 SORT-WRITE-3. ST1194.2 +067000 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1194.2 +067100 PERFORM PRINT-DETAIL. ST1194.2 +067200 ST1194.2 +067300 SORT-TEST-4. ST1194.2 +067400 PERFORM RET-2 48 TIMES. ST1194.2 +067500 IF RDF-KEYS EQUAL TO 206001000200002 ST1194.2 +067600 PERFORM PASS GO TO SORT-WRITE-4. ST1194.2 +067700 GO TO SORT-FAIL-4. ST1194.2 +067800 SORT-DELETE-4. ST1194.2 +067900 PERFORM DE-LETE. ST1194.2 +068000 GO TO SORT-WRITE-4. ST1194.2 +068100 SORT-FAIL-4. ST1194.2 +068200 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +068300 MOVE 206001000200002 TO CORRECT-18V0. ST1194.2 +068400 PERFORM FAIL. ST1194.2 +068500 SORT-WRITE-4. ST1194.2 +068600 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1194.2 +068700 PERFORM PRINT-DETAIL. ST1194.2 +068800 SORT-TEST-5. ST1194.2 +068900 PERFORM RET-2 40 TIMES. ST1194.2 +069000 IF RDF-KEYS EQUAL TO 201001000200002 ST1194.2 +069100 PERFORM PASS GO TO SORT-WRITE-5. ST1194.2 +069200 GO TO SORT-FAIL-5. ST1194.2 +069300 SORT-DELETE-5. ST1194.2 +069400 PERFORM DE-LETE. ST1194.2 +069500 GO TO SORT-WRITE-5. ST1194.2 +069600 SORT-FAIL-5. ST1194.2 +069700 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +069800 MOVE 201001000200002 TO CORRECT-18V0. ST1194.2 +069900 PERFORM FAIL. ST1194.2 +070000 SORT-WRITE-5. ST1194.2 +070100 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1194.2 +070200 PERFORM PRINT-DETAIL. ST1194.2 +070300 SORT-TEST-6. ST1194.2 +070400 PERFORM RET-2. ST1194.2 +070500 PERFORM RET-3 THRU RET-3-EXIT. ST1194.2 +070600 PERFORM RET-4 THRU RET-4-EXIT. ST1194.2 +070700 PERFORM RET-5 THRU RET-5-EXIT. ST1194.2 +070800 PERFORM RET-6 THRU RET-6-EXIT. ST1194.2 +070900 PERFORM RET-7 THRU RET-7-EXIT. ST1194.2 +071000 PERFORM RET-8 THRU RET-8-EXIT. ST1194.2 +071100 IF RDF-KEYS EQUAL TO 201002000100001 ST1194.2 +071200 PERFORM PASS GO TO SORT-WRITE-6. ST1194.2 +071300 GO TO SORT-FAIL-6. ST1194.2 +071400 SORT-DELETE-6. ST1194.2 +071500 PERFORM DE-LETE. ST1194.2 +071600 GO TO SORT-WRITE-6. ST1194.2 +071700 SORT-FAIL-6. ST1194.2 +071800 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +071900 MOVE 201002000100001 TO CORRECT-18V0. ST1194.2 +072000 PERFORM FAIL. ST1194.2 +072100 SORT-WRITE-6. ST1194.2 +072200 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1194.2 +072300 PERFORM PRINT-DETAIL. ST1194.2 +072400 SORT-TEST-7. ST1194.2 +072500 PERFORM RET-2. ST1194.2 +072600 IF RDF-KEYS EQUAL TO 900008000000000 ST1194.2 +072700 PERFORM PASS GO TO SORT-WRITE-7. ST1194.2 +072800 GO TO SORT-FAIL-7. ST1194.2 +072900 SORT-DELETE-7. ST1194.2 +073000 PERFORM DE-LETE. ST1194.2 +073100 GO TO SORT-WRITE-7. ST1194.2 +073200 SORT-FAIL-7. ST1194.2 +073300 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +073400 MOVE 900008000000000 TO CORRECT-18V0. ST1194.2 +073500 PERFORM FAIL. ST1194.2 +073600 SORT-WRITE-7. ST1194.2 +073700 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1194.2 +073800 PERFORM PRINT-DETAIL. ST1194.2 +073900 SORT-TEST-8. ST1194.2 +074000 PERFORM RET-2. ST1194.2 +074100 IF RDF-KEYS EQUAL TO 900009000000000 ST1194.2 +074200 PERFORM PASS GO TO SORT-WRITE-8. ST1194.2 +074300 GO TO SORT-FAIL-8. ST1194.2 +074400 SORT-DELETE-8. ST1194.2 +074500 PERFORM DE-LETE. ST1194.2 +074600 GO TO SORT-WRITE-8. ST1194.2 +074700 SORT-FAIL-8. ST1194.2 +074800 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +074900 MOVE 900009000000000 TO CORRECT-18V0. ST1194.2 +075000 PERFORM FAIL. ST1194.2 +075100 SORT-WRITE-8. ST1194.2 +075200 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1194.2 +075300 PERFORM PRINT-DETAIL. ST1194.2 +075400 SORT-TEST-9. ST1194.2 +075500 RETURN SORTFILE-1A AT END ST1194.2 +075600 PERFORM PASS GO TO SORT-WRITE-9. ST1194.2 +075700 GO TO SORT-FAIL-9. ST1194.2 +075800 SORT-DELETE-9. ST1194.2 +075900 PERFORM DE-LETE. ST1194.2 +076000 GO TO SORT-WRITE-9. ST1194.2 +076100 SORT-FAIL-9. ST1194.2 +076200 MOVE RDF-KEYS TO COMPUTED-18V0. ST1194.2 +076300 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1194.2 +076400 PERFORM FAIL. ST1194.2 +076500 SORT-WRITE-9. ST1194.2 +076600 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1194.2 +076700 PERFORM PRINT-DETAIL. ST1194.2 +076800 SORT-INIT-10. ST1194.2 +076900 MOVE "XI-19 4.4.4 GR(10)" TO ANSI-REFERENCE. ST1194.2 +077000 MOVE "SORT-TEST-10" TO PAR-NAME. ST1194.2 +077100 MOVE "PERFORM EXTNL CODE" TO FEATURE. ST1194.2 +077200 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +077300 PERFORM EXTERNAL-CODE-1. ST1194.2 +077400 GO TO SORT-TEST-10. ST1194.2 +077500 SORT-DELETE-10. ST1194.2 +077600 PERFORM DE-LETE. ST1194.2 +077700 PERFORM PRINT-DETAIL. ST1194.2 +077800 GO TO SORT-INIT-11. ST1194.2 +077900 SORT-TEST-10. ST1194.2 +078000 IF WRK-XN-00001-1 = "A" ST1194.2 +078100 PERFORM PASS ST1194.2 +078200 PERFORM PRINT-DETAIL ST1194.2 +078300 ELSE ST1194.2 +078400 MOVE "EXTERNAL CODE NOT PERFORMED FROM OUTPUT PROC"ST1194.2 +078500 TO RE-MARK ST1194.2 +078600 MOVE "A" TO CORRECT-X ST1194.2 +078700 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +078800 PERFORM FAIL ST1194.2 +078900 PERFORM PRINT-DETAIL. ST1194.2 +079000 ST1194.2 +079100 SORT-INIT-11. ST1194.2 +079200 MOVE "XI-19 4.4.4 GR(10)" TO ANSI-REFERENCE. ST1194.2 +079300 MOVE "SORT-TEST-11-1" TO PAR-NAME. ST1194.2 +079400 MOVE "GO TO EXTERNAL CODE" TO FEATURE. ST1194.2 +079500 MOVE SPACE TO WRK-XN-00001-1. ST1194.2 +079600 MOVE "D" TO WRK-XN-00001-2. ST1194.2 +079700 MOVE 1 TO REC-CT. ST1194.2 +079800 GO TO EXTERNAL-CODE-2. ST1194.2 +079900 SORT-FAIL-11-1. ST1194.2 +080000 MOVE "Z" TO WRK-XN-00001-2. ST1194.2 +080100 GO TO SORT-TEST-11-1. ST1194.2 +080200 SORT-DELETE-11. ST1194.2 +080300 PERFORM DE-LETE. ST1194.2 +080400 PERFORM PRINT-DETAIL. ST1194.2 +080500 GO TO SORT-INIT-11. ST1194.2 +080600 SORT-TEST-11-1. ST1194.2 +080700 IF WRK-XN-00001-2 = "D" ST1194.2 +080800 PERFORM PASS ST1194.2 +080900 PERFORM PRINT-DETAIL ST1194.2 +081000 GO TO SORT-TEST-11-2. ST1194.2 +081100 MOVE "GO TO EXTERNAL CODE ERROR OR RETURN FROM CODE ERROR" ST1194.2 +081200 TO RE-MARK. ST1194.2 +081300 MOVE "D" TO CORRECT-X. ST1194.2 +081400 MOVE WRK-XN-00001-2 TO COMPUTED-X. ST1194.2 +081500 PERFORM FAIL. ST1194.2 +081600 PERFORM PRINT-DETAIL. ST1194.2 +081700 SORT-TEST-11-2. ST1194.2 +081800 MOVE "SORT-TEST-11-2" TO PAR-NAME. ST1194.2 +081900 ADD 1 TO REC-CT. ST1194.2 +082000 IF WRK-XN-00001-1 = "B" ST1194.2 +082100 PERFORM PASS ST1194.2 +082200 PERFORM PRINT-DETAIL ST1194.2 +082300 ELSE ST1194.2 +082400 MOVE "GO TO EXTERNAL CODE ERROR" ST1194.2 +082500 TO RE-MARK ST1194.2 +082600 MOVE "B" TO CORRECT-X ST1194.2 +082700 MOVE WRK-XN-00001-1 TO COMPUTED-X ST1194.2 +082800 PERFORM FAIL ST1194.2 +082900 PERFORM PRINT-DETAIL. ST1194.2 +083000 GO TO SORT-END. ST1194.2 +083100* ST1194.2 +083200* THE FOLLOWING CODE IS ACCESSED FROM OUTSIDE THE OUTPUT ST1194.2 +083300* PROCEEDURE: ST1194.2 +083400* ST1194.2 +083500 INTERNAL-CODE-1. ST1194.2 +083600 MOVE "C" TO WRK-XN-00001-1. ST1194.2 +083700 INTERNAL-CODE-2. ST1194.2 +083800 MOVE "D" TO WRK-XN-00001-1. ST1194.2 +083900 GO TO INT-TEST-2-1. ST1194.2 +084000 ST1194.2 +084100 SORT-END. ST1194.2 +084200 CLOSE SORTOUT-1A. ST1194.2 +084300 ST1194.2 +084400 BAD-FILE. ST1194.2 +084500 MOVE "BAD-FILE" TO PAR-NAME. ST1194.2 +084600 PERFORM FAIL. ST1194.2 +084700 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1194.2 +084800 PERFORM PRINT-DETAIL. ST1194.2 +084900 MOVE "REACHED, PREVIOUS TEST WAS" TO RE-MARK. ST1194.2 +085000 PERFORM PRINT-DETAIL. ST1194.2 +085100 MOVE "THE LAST SUCCESSFUL TEST." TO RE-MARK. ST1194.2 +085200 PERFORM PRINT-DETAIL. ST1194.2 +085300 MOVE SPACE TO FEATURE. ST1194.2 +085400 GO TO CCVS-EXIT. ST1194.2 +085500 RET-1. ST1194.2 +085600 RETURN SORTFILE-1A RECORD AT END GO TO BAD-FILE. ST1194.2 +085700 MOVE S-RECORD TO SORTED. ST1194.2 +085800 WRITE SORTED. ST1194.2 +085900* NOTE THE RETURN VERB WITH ALL OPTIONAL WORDS. ST1194.2 +086000 RET-2. ST1194.2 +086100 RETURN SORTFILE-1A END GO TO BAD-FILE. ST1194.2 +086200 MOVE S-RECORD TO SORTED. ST1194.2 +086300 WRITE SORTED. ST1194.2 +086400* NOTE THE RETURN VERB WITHOUT OPTIONAL WORDS. ST1194.2 +086500 RET-3. ST1194.2 +086600 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +086700 MOVE "RET-3" TO PAR-NAME. ST1194.2 +086800 RETURN SORTFILE-1A ST1194.2 +086900 AT END GO TO BAD-FILE ST1194.2 +087000 NOT AT END ST1194.2 +087100 PERFORM PASS ST1194.2 +087200 PERFORM PRINT-DETAIL ST1194.2 +087300 MOVE S-RECORD TO SORTED ST1194.2 +087400 WRITE SORTED ST1194.2 +087500 GO TO RET-3-EXIT. ST1194.2 +087600 RET-3-EXIT. ST1194.2 +087700 EXIT. ST1194.2 +087800 RET-4. ST1194.2 +087900 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +088000 MOVE "RET-4" TO PAR-NAME. ST1194.2 +088100 MOVE "A" TO WRK-XN-00001-3. ST1194.2 +088200 RETURN SORTFILE-1A ST1194.2 +088300 AT END GO TO BAD-FILE ST1194.2 +088400 END-RETURN ST1194.2 +088500 MOVE "S" TO WRK-XN-00001-3. ST1194.2 +088600 MOVE S-RECORD TO SORTED. ST1194.2 +088700 WRITE SORTED. ST1194.2 +088800 IF WRK-XN-00001-3 = "S" ST1194.2 +088900 PERFORM PASS ST1194.2 +089000 PERFORM PRINT-DETAIL ST1194.2 +089100 ELSE ST1194.2 +089200 MOVE "SCOPE DELIMITER IGNORED" TO RE-MARK ST1194.2 +089300 MOVE "S" TO CORRECT-X ST1194.2 +089400 MOVE WRK-XN-00001-3 TO COMPUTED-X ST1194.2 +089500 PERFORM FAIL ST1194.2 +089600 PERFORM PRINT-DETAIL. ST1194.2 +089700 RET-4-EXIT. ST1194.2 +089800 EXIT. ST1194.2 +089900 RET-5. ST1194.2 +090000 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +090100 MOVE "RET-5" TO PAR-NAME. ST1194.2 +090200 RETURN SORTFILE-1A ST1194.2 +090300 AT END ST1194.2 +090400 PERFORM FAIL ST1194.2 +090500 PERFORM PRINT-DETAIL ST1194.2 +090600 GO TO BAD-FILE ST1194.2 +090700 NOT AT END ST1194.2 +090800 PERFORM PASS ST1194.2 +090900 PERFORM PRINT-DETAIL ST1194.2 +091000 MOVE S-RECORD TO SORTED ST1194.2 +091100 WRITE SORTED. ST1194.2 +091200 RET-5-EXIT. ST1194.2 +091300 EXIT. ST1194.2 +091400 RET-6. ST1194.2 +091500 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +091600 MOVE "RET-6" TO PAR-NAME. ST1194.2 +091700 MOVE "V" TO WRK-XN-00001-3. ST1194.2 +091800 RETURN SORTFILE-1A ST1194.2 +091900 AT END ST1194.2 +092000 GO TO BAD-FILE ST1194.2 +092100 END-RETURN ST1194.2 +092200 MOVE "W" TO WRK-XN-00001-3. ST1194.2 +092300 MOVE S-RECORD TO SORTED. ST1194.2 +092400 WRITE SORTED. ST1194.2 +092500 IF WRK-XN-00001-3 = "W" ST1194.2 +092600 PERFORM PASS ST1194.2 +092700 PERFORM PRINT-DETAIL ST1194.2 +092800 ELSE ST1194.2 +092900 MOVE "SCOPE DELIMITER IGNORED" TO RE-MARK ST1194.2 +093000 MOVE "W" TO CORRECT-X ST1194.2 +093100 MOVE WRK-XN-00001-3 TO COMPUTED-X ST1194.2 +093200 PERFORM FAIL ST1194.2 +093300 PERFORM PRINT-DETAIL. ST1194.2 +093400 RET-6-EXIT. ST1194.2 +093500 EXIT. ST1194.2 +093600 RET-7. ST1194.2 +093700 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +093800 MOVE "RET-7" TO PAR-NAME. ST1194.2 +093900 MOVE "G" TO WRK-XN-00001-3. ST1194.2 +094000 RETURN SORTFILE-1A ST1194.2 +094100 AT END GO TO BAD-FILE ST1194.2 +094200 NOT AT END ST1194.2 +094300 MOVE S-RECORD TO SORTED ST1194.2 +094400 WRITE SORTED ST1194.2 +094500 END-RETURN ST1194.2 +094600 MOVE "K" TO WRK-XN-00001-3. ST1194.2 +094700 IF WRK-XN-00001-3 = "K" ST1194.2 +094800 PERFORM PASS ST1194.2 +094900 PERFORM PRINT-DETAIL ST1194.2 +095000 ELSE ST1194.2 +095100 MOVE "SCOPE DELIMITER IGNORED" TO RE-MARK ST1194.2 +095200 MOVE "K" TO CORRECT-X ST1194.2 +095300 MOVE WRK-XN-00001-3 TO COMPUTED-X ST1194.2 +095400 PERFORM FAIL ST1194.2 +095500 PERFORM PRINT-DETAIL. ST1194.2 +095600 RET-7-EXIT. ST1194.2 +095700 EXIT. ST1194.2 +095800 RET-8. ST1194.2 +095900 MOVE "XI-14 4.3.4 GR(2) & (4)" TO ANSI-REFERENCE. ST1194.2 +096000 MOVE "RET-8" TO PAR-NAME. ST1194.2 +096100 MOVE "X" TO WRK-XN-00001-3. ST1194.2 +096200 RETURN SORTFILE-1A ST1194.2 +096300 AT END ST1194.2 +096400 GO TO BAD-FILE ST1194.2 +096500 NOT AT END ST1194.2 +096600 MOVE S-RECORD TO SORTED ST1194.2 +096700 WRITE SORTED ST1194.2 +096800 END-RETURN ST1194.2 +096900 MOVE "T" TO WRK-XN-00001-3. ST1194.2 +097000 IF WRK-XN-00001-3 = "T" ST1194.2 +097100 PERFORM PASS ST1194.2 +097200 PERFORM PRINT-DETAIL ST1194.2 +097300 ELSE ST1194.2 +097400 MOVE "SCOPE DELIMITER IGNORED" TO RE-MARK ST1194.2 +097500 MOVE "T" TO CORRECT-X ST1194.2 +097600 MOVE WRK-XN-00001-3 TO COMPUTED-X ST1194.2 +097700 PERFORM FAIL ST1194.2 +097800 PERFORM PRINT-DETAIL. ST1194.2 +097900 MOVE SPACES TO TEST-RESULTS. ST1194.2 +098000 MOVE COMMENT-SENTENCE TO TEST-RESULTS. ST1194.2 +098100 PERFORM PRINT-DETAIL. ST1194.2 +098200 MOVE SPACES TO TEST-RESULTS. ST1194.2 +098300 RET-8-EXIT. ST1194.2 +098400 EXIT. ST1194.2 +098500 ST1194.2 +098600 EXTERNAL-CODE-1. ST1194.2 +098700 MOVE "A" TO WRK-XN-00001-1. ST1194.2 +098800 EXTERNAL-CODE-2. ST1194.2 +098900 MOVE "B" TO WRK-XN-00001-1. ST1194.2 +099000 GO TO SORT-TEST-11-1. ST1194.2 +099100 EXTERNAL-CODE-3. ST1194.2 +099200 MOVE "J" TO WRK-XN-00001-1. ST1194.2 +099300 EXTERNAL-CODE-4. ST1194.2 +099400 MOVE "K" TO WRK-XN-00001-1. ST1194.2 +099500 GO TO INPT-TEST-2-1. ST1194.2 +099600 ST1194.2 +099700 CCVS-EXIT SECTION. ST1194.2 +099800 CCVS-9999. ST1194.2 +099900 GO TO CLOSE-FILES. ST1194.2 diff --git a/tests/cobol85/ST/ST120A.SUB b/tests/cobol85/ST/ST120A.SUB new file mode 100755 index 00000000..61cd0c0b --- /dev/null +++ b/tests/cobol85/ST/ST120A.SUB @@ -0,0 +1,78 @@ +000100 IDENTIFICATION DIVISION. ST1204.2 +000200 PROGRAM-ID. ST1204.2 +000300 ST120A. ST1204.2 +000400**************************************************************** ST1204.2 +000500* * ST1204.2 +000600* VALIDATION FOR:- * ST1204.2 +000700* * ST1204.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1204.2 +000900* * ST1204.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1204.2 +001100* * ST1204.2 +001200**************************************************************** ST1204.2 +001300* * ST1204.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1204.2 +001500* * ST1204.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1204.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1204.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1204.2 +001900* * ST1204.2 +002000**************************************************************** ST1204.2 +002100 ENVIRONMENT DIVISION. ST1204.2 +002200 CONFIGURATION SECTION. ST1204.2 +002300 SOURCE-COMPUTER. ST1204.2 +002400 Linux. ST1204.2 +002500 OBJECT-COMPUTER. ST1204.2 +002600 Linux. ST1204.2 +002700 INPUT-OUTPUT SECTION. ST1204.2 +002800 FILE-CONTROL. ST1204.2 +002900 SELECT SORTFILE-1B ASSIGN TO ST1204.2 +003000 "XXXXX027". ST1204.2 +003100 SELECT SORTIN-1B ASSIGN TO ST1204.2 +003200 "XXXXX001". ST1204.2 +003300 SELECT SORTOUT-1B ASSIGN TO ST1204.2 +003400 "XXXXX002". ST1204.2 +003500 DATA DIVISION. ST1204.2 +003600 FILE SECTION. ST1204.2 +003700 SD SORTFILE-1B ST1204.2 +003800 RECORD CONTAINS 120 CHARACTERS ST1204.2 +003900 DATA RECORD S-RECORD. ST1204.2 +004000 01 S-RECORD. ST1204.2 +004100 02 KEYS-GROUP. ST1204.2 +004200 03 KEY-1 PICTURE 9. ST1204.2 +004300 03 KEY-2 PICTURE 99. ST1204.2 +004400 03 KEY-3 PICTURE 999. ST1204.2 +004500 03 KEY-4 PICTURE 9999. ST1204.2 +004600 03 KEY-5 PICTURE 9(5). ST1204.2 +004700 02 FILLER PICTURE X(105). ST1204.2 +004800 FD SORTIN-1B ST1204.2 +004900 BLOCK CONTAINS 10 RECORDS ST1204.2 +005000 LABEL RECORDS ARE STANDARD ST1204.2 +005100*C VALUE OF ST1204.2 +005200*C OCLABELID ST1204.2 +005300*C IS ST1204.2 +005400*C "OCDUMMY" ST1204.2 +005500*G SYSIN ST1204.2 +005600 DATA RECORD IS INSORT. ST1204.2 +005700 01 INSORT PICTURE X(120). ST1204.2 +005800 FD SORTOUT-1B ST1204.2 +005900 BLOCK CONTAINS 10 RECORDS ST1204.2 +006000 LABEL RECORD STANDARD ST1204.2 +006100*C VALUE OF ST1204.2 +006200*C OCLABELID ST1204.2 +006300*C IS ST1204.2 +006400*C "OCDUMMY" ST1204.2 +006500*G SYSIN ST1204.2 +006600 DATA RECORD OUTSORT. ST1204.2 +006700 01 OUTSORT PICTURE X(120). ST1204.2 +006800 PROCEDURE DIVISION. ST1204.2 +006900 SORT-STATEMENT. ST1204.2 +007000 SORT SORTFILE-1B ST1204.2 +007100 ON DESCENDING KEY KEY-1 ST1204.2 +007200 ON ASCENDING KEY KEY-2 ST1204.2 +007300 ON DESCENDING KEY KEY-3 ST1204.2 +007400 ASCENDING KEY-4 KEY-5 ST1204.2 +007500 USING SORTIN-1B ST1204.2 +007600 GIVING SORTOUT-1B. ST1204.2 +007700 STOP-RUN-STATEMENT. ST1204.2 +007800 STOP RUN. ST1204.2 diff --git a/tests/cobol85/ST/ST121A.SUB b/tests/cobol85/ST/ST121A.SUB new file mode 100755 index 00000000..a9797548 --- /dev/null +++ b/tests/cobol85/ST/ST121A.SUB @@ -0,0 +1,473 @@ +000100 IDENTIFICATION DIVISION. ST1214.2 +000200 PROGRAM-ID. ST1214.2 +000300 ST121A. ST1214.2 +000400**************************************************************** ST1214.2 +000500* * ST1214.2 +000600* VALIDATION FOR:- * ST1214.2 +000700* * ST1214.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1214.2 +000900* * ST1214.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1214.2 +001100* * ST1214.2 +001200**************************************************************** ST1214.2 +001300* * ST1214.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1214.2 +001500* * ST1214.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1214.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1214.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1214.2 +001900* * ST1214.2 +002000**************************************************************** ST1214.2 +002100 ENVIRONMENT DIVISION. ST1214.2 +002200 CONFIGURATION SECTION. ST1214.2 +002300 SOURCE-COMPUTER. ST1214.2 +002400 Linux. ST1214.2 +002500 OBJECT-COMPUTER. ST1214.2 +002600 Linux. ST1214.2 +002700 INPUT-OUTPUT SECTION. ST1214.2 +002800 FILE-CONTROL. ST1214.2 +002900 SELECT PRINT-FILE ASSIGN TO ST1214.2 +003000 "report.log". ST1214.2 +003100 SELECT SORTIN-1C ASSIGN TO ST1214.2 +003200 "XXXXX002". ST1214.2 +003300 DATA DIVISION. ST1214.2 +003400 FILE SECTION. ST1214.2 +003500 FD PRINT-FILE. ST1214.2 +003600 01 PRINT-REC PICTURE X(120). ST1214.2 +003700 01 DUMMY-RECORD PICTURE X(120). ST1214.2 +003800 FD SORTIN-1C ST1214.2 +003900 BLOCK CONTAINS 10 RECORDS ST1214.2 +004000 LABEL RECORD STANDARD ST1214.2 +004100*C VALUE OF ST1214.2 +004200*C OCLABELID ST1214.2 +004300*C IS ST1214.2 +004400*C "OCDUMMY" ST1214.2 +004500*G SYSIN ST1214.2 +004600 DATA RECORD IS SORTIN-REC. ST1214.2 +004700 01 SORTIN-REC. ST1214.2 +004800 02 KEYS-GROUP PICTURE 9(15). ST1214.2 +004900 02 FILLER PICTURE X(105). ST1214.2 +005000 WORKING-STORAGE SECTION. ST1214.2 +005100 01 TEST-RESULTS. ST1214.2 +005200 02 FILLER PIC X VALUE SPACE. ST1214.2 +005300 02 FEATURE PIC X(20) VALUE SPACE. ST1214.2 +005400 02 FILLER PIC X VALUE SPACE. ST1214.2 +005500 02 P-OR-F PIC X(5) VALUE SPACE. ST1214.2 +005600 02 FILLER PIC X VALUE SPACE. ST1214.2 +005700 02 PAR-NAME. ST1214.2 +005800 03 FILLER PIC X(19) VALUE SPACE. ST1214.2 +005900 03 PARDOT-X PIC X VALUE SPACE. ST1214.2 +006000 03 DOTVALUE PIC 99 VALUE ZERO. ST1214.2 +006100 02 FILLER PIC X(8) VALUE SPACE. ST1214.2 +006200 02 RE-MARK PIC X(61). ST1214.2 +006300 01 TEST-COMPUTED. ST1214.2 +006400 02 FILLER PIC X(30) VALUE SPACE. ST1214.2 +006500 02 FILLER PIC X(17) VALUE ST1214.2 +006600 " COMPUTED=". ST1214.2 +006700 02 COMPUTED-X. ST1214.2 +006800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1214.2 +006900 03 COMPUTED-N REDEFINES COMPUTED-A ST1214.2 +007000 PIC -9(9).9(9). ST1214.2 +007100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1214.2 +007200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1214.2 +007300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1214.2 +007400 03 CM-18V0 REDEFINES COMPUTED-A. ST1214.2 +007500 04 COMPUTED-18V0 PIC -9(18). ST1214.2 +007600 04 FILLER PIC X. ST1214.2 +007700 03 FILLER PIC X(50) VALUE SPACE. ST1214.2 +007800 01 TEST-CORRECT. ST1214.2 +007900 02 FILLER PIC X(30) VALUE SPACE. ST1214.2 +008000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1214.2 +008100 02 CORRECT-X. ST1214.2 +008200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1214.2 +008300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1214.2 +008400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1214.2 +008500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1214.2 +008600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1214.2 +008700 03 CR-18V0 REDEFINES CORRECT-A. ST1214.2 +008800 04 CORRECT-18V0 PIC -9(18). ST1214.2 +008900 04 FILLER PIC X. ST1214.2 +009000 03 FILLER PIC X(2) VALUE SPACE. ST1214.2 +009100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1214.2 +009200 01 CCVS-C-1. ST1214.2 +009300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1214.2 +009400- "SS PARAGRAPH-NAME ST1214.2 +009500- " REMARKS". ST1214.2 +009600 02 FILLER PIC X(20) VALUE SPACE. ST1214.2 +009700 01 CCVS-C-2. ST1214.2 +009800 02 FILLER PIC X VALUE SPACE. ST1214.2 +009900 02 FILLER PIC X(6) VALUE "TESTED". ST1214.2 +010000 02 FILLER PIC X(15) VALUE SPACE. ST1214.2 +010100 02 FILLER PIC X(4) VALUE "FAIL". ST1214.2 +010200 02 FILLER PIC X(94) VALUE SPACE. ST1214.2 +010300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1214.2 +010400 01 REC-CT PIC 99 VALUE ZERO. ST1214.2 +010500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1214.2 +010600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1214.2 +010700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1214.2 +010800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1214.2 +010900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1214.2 +011000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1214.2 +011100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1214.2 +011200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1214.2 +011300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1214.2 +011400 01 CCVS-H-1. ST1214.2 +011500 02 FILLER PIC X(39) VALUE SPACES. ST1214.2 +011600 02 FILLER PIC X(42) VALUE ST1214.2 +011700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1214.2 +011800 02 FILLER PIC X(39) VALUE SPACES. ST1214.2 +011900 01 CCVS-H-2A. ST1214.2 +012000 02 FILLER PIC X(40) VALUE SPACE. ST1214.2 +012100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1214.2 +012200 02 FILLER PIC XXXX VALUE ST1214.2 +012300 "4.2 ". ST1214.2 +012400 02 FILLER PIC X(28) VALUE ST1214.2 +012500 " COPY - NOT FOR DISTRIBUTION". ST1214.2 +012600 02 FILLER PIC X(41) VALUE SPACE. ST1214.2 +012700 ST1214.2 +012800 01 CCVS-H-2B. ST1214.2 +012900 02 FILLER PIC X(15) VALUE ST1214.2 +013000 "TEST RESULT OF ". ST1214.2 +013100 02 TEST-ID PIC X(9). ST1214.2 +013200 02 FILLER PIC X(4) VALUE ST1214.2 +013300 " IN ". ST1214.2 +013400 02 FILLER PIC X(12) VALUE ST1214.2 +013500 " HIGH ". ST1214.2 +013600 02 FILLER PIC X(22) VALUE ST1214.2 +013700 " LEVEL VALIDATION FOR ". ST1214.2 +013800 02 FILLER PIC X(58) VALUE ST1214.2 +013900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1214.2 +014000 01 CCVS-H-3. ST1214.2 +014100 02 FILLER PIC X(34) VALUE ST1214.2 +014200 " FOR OFFICIAL USE ONLY ". ST1214.2 +014300 02 FILLER PIC X(58) VALUE ST1214.2 +014400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1214.2 +014500 02 FILLER PIC X(28) VALUE ST1214.2 +014600 " COPYRIGHT 1985 ". ST1214.2 +014700 01 CCVS-E-1. ST1214.2 +014800 02 FILLER PIC X(52) VALUE SPACE. ST1214.2 +014900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1214.2 +015000 02 ID-AGAIN PIC X(9). ST1214.2 +015100 02 FILLER PIC X(45) VALUE SPACES. ST1214.2 +015200 01 CCVS-E-2. ST1214.2 +015300 02 FILLER PIC X(31) VALUE SPACE. ST1214.2 +015400 02 FILLER PIC X(21) VALUE SPACE. ST1214.2 +015500 02 CCVS-E-2-2. ST1214.2 +015600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1214.2 +015700 03 FILLER PIC X VALUE SPACE. ST1214.2 +015800 03 ENDER-DESC PIC X(44) VALUE ST1214.2 +015900 "ERRORS ENCOUNTERED". ST1214.2 +016000 01 CCVS-E-3. ST1214.2 +016100 02 FILLER PIC X(22) VALUE ST1214.2 +016200 " FOR OFFICIAL USE ONLY". ST1214.2 +016300 02 FILLER PIC X(12) VALUE SPACE. ST1214.2 +016400 02 FILLER PIC X(58) VALUE ST1214.2 +016500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1214.2 +016600 02 FILLER PIC X(13) VALUE SPACE. ST1214.2 +016700 02 FILLER PIC X(15) VALUE ST1214.2 +016800 " COPYRIGHT 1985". ST1214.2 +016900 01 CCVS-E-4. ST1214.2 +017000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1214.2 +017100 02 FILLER PIC X(4) VALUE " OF ". ST1214.2 +017200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1214.2 +017300 02 FILLER PIC X(40) VALUE ST1214.2 +017400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1214.2 +017500 01 XXINFO. ST1214.2 +017600 02 FILLER PIC X(19) VALUE ST1214.2 +017700 "*** INFORMATION ***". ST1214.2 +017800 02 INFO-TEXT. ST1214.2 +017900 04 FILLER PIC X(8) VALUE SPACE. ST1214.2 +018000 04 XXCOMPUTED PIC X(20). ST1214.2 +018100 04 FILLER PIC X(5) VALUE SPACE. ST1214.2 +018200 04 XXCORRECT PIC X(20). ST1214.2 +018300 02 INF-ANSI-REFERENCE PIC X(48). ST1214.2 +018400 01 HYPHEN-LINE. ST1214.2 +018500 02 FILLER PIC IS X VALUE IS SPACE. ST1214.2 +018600 02 FILLER PIC IS X(65) VALUE IS "************************ST1214.2 +018700- "*****************************************". ST1214.2 +018800 02 FILLER PIC IS X(54) VALUE IS "************************ST1214.2 +018900- "******************************". ST1214.2 +019000 01 CCVS-PGM-ID PIC X(9) VALUE ST1214.2 +019100 "ST121A". ST1214.2 +019200 PROCEDURE DIVISION. ST1214.2 +019300 CCVS1 SECTION. ST1214.2 +019400 OPEN-FILES. ST1214.2 +019500 OPEN OUTPUT PRINT-FILE. ST1214.2 +019600 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1214.2 +019700 MOVE SPACE TO TEST-RESULTS. ST1214.2 +019800 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1214.2 +019900 GO TO CCVS1-EXIT. ST1214.2 +020000 CLOSE-FILES. ST1214.2 +020100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1214.2 +020200 TERMINATE-CCVS. ST1214.2 +020300*S EXIT PROGRAM. ST1214.2 +020400*SERMINATE-CALL. ST1214.2 +020500 STOP RUN. ST1214.2 +020600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1214.2 +020700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1214.2 +020800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1214.2 +020900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1214.2 +021000 MOVE "****TEST DELETED****" TO RE-MARK. ST1214.2 +021100 PRINT-DETAIL. ST1214.2 +021200 IF REC-CT NOT EQUAL TO ZERO ST1214.2 +021300 MOVE "." TO PARDOT-X ST1214.2 +021400 MOVE REC-CT TO DOTVALUE. ST1214.2 +021500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1214.2 +021600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1214.2 +021700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1214.2 +021800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1214.2 +021900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1214.2 +022000 MOVE SPACE TO CORRECT-X. ST1214.2 +022100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1214.2 +022200 MOVE SPACE TO RE-MARK. ST1214.2 +022300 HEAD-ROUTINE. ST1214.2 +022400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +022500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +022600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1214.2 +022700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1214.2 +022800 COLUMN-NAMES-ROUTINE. ST1214.2 +022900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +023000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +023100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +023200 END-ROUTINE. ST1214.2 +023300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1214.2 +023400 END-RTN-EXIT. ST1214.2 +023500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +023600 END-ROUTINE-1. ST1214.2 +023700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1214.2 +023800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1214.2 +023900 ADD PASS-COUNTER TO ERROR-HOLD. ST1214.2 +024000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1214.2 +024100 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1214.2 +024200 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1214.2 +024300 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1214.2 +024400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1214.2 +024500 END-ROUTINE-12. ST1214.2 +024600 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1214.2 +024700 IF ERROR-COUNTER IS EQUAL TO ZERO ST1214.2 +024800 MOVE "NO " TO ERROR-TOTAL ST1214.2 +024900 ELSE ST1214.2 +025000 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1214.2 +025100 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1214.2 +025200 PERFORM WRITE-LINE. ST1214.2 +025300 END-ROUTINE-13. ST1214.2 +025400 IF DELETE-COUNTER IS EQUAL TO ZERO ST1214.2 +025500 MOVE "NO " TO ERROR-TOTAL ELSE ST1214.2 +025600 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1214.2 +025700 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1214.2 +025800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +025900 IF INSPECT-COUNTER EQUAL TO ZERO ST1214.2 +026000 MOVE "NO " TO ERROR-TOTAL ST1214.2 +026100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1214.2 +026200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1214.2 +026300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +026400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1214.2 +026500 WRITE-LINE. ST1214.2 +026600 ADD 1 TO RECORD-COUNT. ST1214.2 +026700 IF RECORD-COUNT GREATER 42 ST1214.2 +026800 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1214.2 +026900 MOVE SPACE TO DUMMY-RECORD ST1214.2 +027000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1214.2 +027100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1214.2 +027200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1214.2 +027300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1214.2 +027400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1214.2 +027500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1214.2 +027600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1214.2 +027700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1214.2 +027800 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1214.2 +027900 MOVE ZERO TO RECORD-COUNT. ST1214.2 +028000 PERFORM WRT-LN. ST1214.2 +028100 WRT-LN. ST1214.2 +028200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1214.2 +028300 MOVE SPACE TO DUMMY-RECORD. ST1214.2 +028400 BLANK-LINE-PRINT. ST1214.2 +028500 PERFORM WRT-LN. ST1214.2 +028600 FAIL-ROUTINE. ST1214.2 +028700 IF COMPUTED-X NOT EQUAL TO SPACE ST1214.2 +028800 GO TO FAIL-ROUTINE-WRITE. ST1214.2 +028900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1214.2 +029000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1214.2 +029100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1214.2 +029200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +029300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1214.2 +029400 GO TO FAIL-ROUTINE-EX. ST1214.2 +029500 FAIL-ROUTINE-WRITE. ST1214.2 +029600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1214.2 +029700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1214.2 +029800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1214.2 +029900 MOVE SPACES TO COR-ANSI-REFERENCE. ST1214.2 +030000 FAIL-ROUTINE-EX. EXIT. ST1214.2 +030100 BAIL-OUT. ST1214.2 +030200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1214.2 +030300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1214.2 +030400 BAIL-OUT-WRITE. ST1214.2 +030500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1214.2 +030600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1214.2 +030700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1214.2 +030800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1214.2 +030900 BAIL-OUT-EX. EXIT. ST1214.2 +031000 CCVS1-EXIT. ST1214.2 +031100 EXIT. ST1214.2 +031200 SECT-ST119A-0001 SECTION. ST1214.2 +031300 ST119A-0001-01. ST1214.2 +031400 OPEN INPUT SORTIN-1C. ST1214.2 +031500 MOVE "THIS PROGRAM TESTS THE" TO RE-MARK. ST1214.2 +031600 PERFORM PRINT-DETAIL. ST1214.2 +031700 MOVE "OUTPUT GENERATED BY ST120A," TO RE-MARK. ST1214.2 +031800 PERFORM PRINT-DETAIL. ST1214.2 +031900 MOVE "WHICH WAS IN TURN GENERATED" TO RE-MARK. ST1214.2 +032000 PERFORM PRINT-DETAIL. ST1214.2 +032100 MOVE "IN ST119A." TO RE-MARK. ST1214.2 +032200 PERFORM PRINT-DETAIL. ST1214.2 +032300 MOVE "SORT - USING, GIVING" TO FEATURE. ST1214.2 +032400 SORT-TEST-1. ST1214.2 +032500 PERFORM READ-SORTED-FILE. ST1214.2 +032600 IF KEYS-GROUP EQUAL TO 900009000000000 ST1214.2 +032700 PERFORM PASS GO TO SORT-WRITE-1. ST1214.2 +032800 GO TO SORT-FAIL-1. ST1214.2 +032900 SORT-DELETE-1. ST1214.2 +033000 PERFORM DE-LETE. ST1214.2 +033100 GO TO SORT-WRITE-1. ST1214.2 +033200 SORT-FAIL-1. ST1214.2 +033300 PERFORM FAIL. ST1214.2 +033400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +033500 MOVE 900009000000000 TO CORRECT-18V0. ST1214.2 +033600 SORT-WRITE-1. ST1214.2 +033700 MOVE "SORT-TEST-1" TO PAR-NAME. ST1214.2 +033800 PERFORM PRINT-DETAIL. ST1214.2 +033900 SORT-TEST-2. ST1214.2 +034000 PERFORM READ-SORTED-FILE. ST1214.2 +034100 IF KEYS-GROUP EQUAL TO 900008000000000 ST1214.2 +034200 PERFORM PASS GO TO SORT-WRITE-2. ST1214.2 +034300 GO TO SORT-FAIL-2. ST1214.2 +034400 SORT-DELETE-2. ST1214.2 +034500 PERFORM DE-LETE. ST1214.2 +034600 GO TO SORT-WRITE-2. ST1214.2 +034700 SORT-FAIL-2. ST1214.2 +034800 PERFORM FAIL. ST1214.2 +034900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +035000 MOVE 900008000000000 TO CORRECT-18V0. ST1214.2 +035100 SORT-WRITE-2. ST1214.2 +035200 MOVE "SORT-TEST-2" TO PAR-NAME. ST1214.2 +035300 PERFORM PRINT-DETAIL. ST1214.2 +035400 SORT-TEST-3. ST1214.2 +035500 PERFORM READ-SORTED-FILE. ST1214.2 +035600 IF KEYS-GROUP EQUAL TO 201002000100001 ST1214.2 +035700 PERFORM PASS GO TO SORT-WRITE-3. ST1214.2 +035800 GO TO SORT-FAIL-3. ST1214.2 +035900 SORT-DELETE-3. ST1214.2 +036000 PERFORM DE-LETE. ST1214.2 +036100 GO TO SORT-WRITE-3. ST1214.2 +036200 SORT-FAIL-3. ST1214.2 +036300 PERFORM FAIL. ST1214.2 +036400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +036500 MOVE 201002000100001 TO CORRECT-18V0. ST1214.2 +036600 SORT-WRITE-3. ST1214.2 +036700 MOVE "SORT-TEST-3" TO PAR-NAME. ST1214.2 +036800 PERFORM PRINT-DETAIL. ST1214.2 +036900 SORT-TEST-4. ST1214.2 +037000 PERFORM READ-SORTED-FILE 48 TIMES. ST1214.2 +037100 IF KEYS-GROUP EQUAL TO 101002000100001 ST1214.2 +037200 PERFORM PASS GO TO SORT-WRITE-4. ST1214.2 +037300 GO TO SORT-FAIL-4. ST1214.2 +037400 SORT-DELETE-4. ST1214.2 +037500 PERFORM DE-LETE. ST1214.2 +037600 GO TO SORT-WRITE-4. ST1214.2 +037700 SORT-FAIL-4. ST1214.2 +037800 PERFORM FAIL. ST1214.2 +037900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +038000 MOVE 101002000100001 TO CORRECT-18V0. ST1214.2 +038100 SORT-WRITE-4. ST1214.2 +038200 MOVE "SORT-TEST-4" TO PAR-NAME. ST1214.2 +038300 PERFORM PRINT-DETAIL. ST1214.2 +038400 SORT-TEST-5. ST1214.2 +038500 PERFORM READ-SORTED-FILE 40 TIMES. ST1214.2 +038600 IF KEYS-GROUP EQUAL TO 106002000100001 ST1214.2 +038700 PERFORM PASS GO TO SORT-WRITE-5. ST1214.2 +038800 GO TO SORT-FAIL-5. ST1214.2 +038900 SORT-DELETE-5. ST1214.2 +039000 PERFORM DE-LETE. ST1214.2 +039100 GO TO SORT-WRITE-5. ST1214.2 +039200 SORT-FAIL-5. ST1214.2 +039300 PERFORM FAIL. ST1214.2 +039400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +039500 MOVE 106002000100001 TO CORRECT-18V0. ST1214.2 +039600 SORT-WRITE-5. ST1214.2 +039700 MOVE "SORT-TEST-5" TO PAR-NAME. ST1214.2 +039800 PERFORM PRINT-DETAIL. ST1214.2 +039900 SORT-TEST-6. ST1214.2 +040000 PERFORM READ-SORTED-FILE 7 TIMES. ST1214.2 +040100 IF KEYS-GROUP EQUAL TO 106001000200002 ST1214.2 +040200 PERFORM PASS GO TO SORT-WRITE-6. ST1214.2 +040300 GO TO SORT-FAIL-6. ST1214.2 +040400 SORT-DELETE-6. ST1214.2 +040500 PERFORM DE-LETE. ST1214.2 +040600 GO TO SORT-WRITE-6. ST1214.2 +040700 SORT-FAIL-6. ST1214.2 +040800 PERFORM FAIL. ST1214.2 +040900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +041000 MOVE 106001000200002 TO CORRECT-18V0. ST1214.2 +041100 SORT-WRITE-6. ST1214.2 +041200 MOVE "SORT-TEST-6" TO PAR-NAME. ST1214.2 +041300 PERFORM PRINT-DETAIL. ST1214.2 +041400 SORT-TEST-7. ST1214.2 +041500 PERFORM READ-SORTED-FILE. ST1214.2 +041600 IF KEYS-GROUP EQUAL TO 009000000900008 ST1214.2 +041700 PERFORM PASS GO TO SORT-WRITE-7. ST1214.2 +041800 GO TO SORT-FAIL-7. ST1214.2 +041900 SORT-DELETE-7. ST1214.2 +042000 PERFORM DE-LETE. ST1214.2 +042100 GO TO SORT-WRITE-7. ST1214.2 +042200 SORT-FAIL-7. ST1214.2 +042300 PERFORM FAIL. ST1214.2 +042400 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +042500 MOVE 009000000900008 TO CORRECT-18V0. ST1214.2 +042600 SORT-WRITE-7. ST1214.2 +042700 MOVE "SORT-TEST-7" TO PAR-NAME. ST1214.2 +042800 PERFORM PRINT-DETAIL. ST1214.2 +042900 SORT-TEST-8. ST1214.2 +043000 PERFORM READ-SORTED-FILE. ST1214.2 +043100 IF KEYS-GROUP EQUAL TO 009000000900009 ST1214.2 +043200 PERFORM PASS GO TO SORT-WRITE-8. ST1214.2 +043300 GO TO SORT-FAIL-8. ST1214.2 +043400 SORT-DELETE-8. ST1214.2 +043500 PERFORM DE-LETE. ST1214.2 +043600 GO TO SORT-WRITE-8. ST1214.2 +043700 SORT-FAIL-8. ST1214.2 +043800 PERFORM FAIL. ST1214.2 +043900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +044000 MOVE 009000000900009 TO CORRECT-18V0. ST1214.2 +044100 SORT-WRITE-8. ST1214.2 +044200 MOVE "SORT-TEST-8" TO PAR-NAME. ST1214.2 +044300 PERFORM PRINT-DETAIL. ST1214.2 +044400 SORT-TEST-9. ST1214.2 +044500 READ SORTIN-1C AT END ST1214.2 +044600 PERFORM PASS GO TO SORT-WRITE-9. ST1214.2 +044700* NOTE THE FOLLOWING STATEMENTS SHOULD NOT BE EXECUTED. ST1214.2 +044800 PERFORM FAIL. ST1214.2 +044900 MOVE KEYS-GROUP TO COMPUTED-18V0. ST1214.2 +045000 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1214.2 +045100 GO TO SORT-WRITE-9. ST1214.2 +045200 SORT-DELETE-9. ST1214.2 +045300 PERFORM DE-LETE. ST1214.2 +045400 SORT-WRITE-9. ST1214.2 +045500 MOVE "SORT-TEST-9" TO PAR-NAME. ST1214.2 +045600 PERFORM PRINT-DETAIL. ST1214.2 +045700 CLOSE SORTIN-1C. ST1214.2 +045800 GO TO CCVS-EXIT. ST1214.2 +045900 READ-SORTED-FILE. ST1214.2 +046000 READ SORTIN-1C AT END GO TO BAD-FILE. ST1214.2 +046100 BAD-FILE. ST1214.2 +046200 PERFORM FAIL. ST1214.2 +046300 MOVE "BAD-FILE" TO PAR-NAME. ST1214.2 +046400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1214.2 +046500 PERFORM PRINT-DETAIL. ST1214.2 +046600 MOVE SPACE TO FEATURE. ST1214.2 +046700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1214.2 +046800 PERFORM PRINT-DETAIL. ST1214.2 +046900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. ST1214.2 +047000 PERFORM PRINT-DETAIL. ST1214.2 +047100 CCVS-EXIT SECTION. ST1214.2 +047200 CCVS-999999. ST1214.2 +047300 GO TO CLOSE-FILES. ST1214.2 diff --git a/tests/cobol85/ST/ST122A.CBL b/tests/cobol85/ST/ST122A.CBL new file mode 100755 index 00000000..e0ec4f38 --- /dev/null +++ b/tests/cobol85/ST/ST122A.CBL @@ -0,0 +1,377 @@ +000100 IDENTIFICATION DIVISION. ST1224.2 +000200 PROGRAM-ID. ST1224.2 +000300 ST122A. ST1224.2 +000400**************************************************************** ST1224.2 +000500* * ST1224.2 +000600* VALIDATION FOR:- * ST1224.2 +000700* * ST1224.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1224.2 +000900* * ST1224.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1224.2 +001100* * ST1224.2 +001200**************************************************************** ST1224.2 +001300* * ST1224.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1224.2 +001500* * ST1224.2 +001600* X-01 * ST1224.2 +001700* X-55 - SYSTEM PRINTER NAME. * ST1224.2 +001800* X-69 * ST1224.2 +001900* X-74 * ST1224.2 +002000* X-75 * ST1224.2 +002100* X-82 - SOURCE COMPUTER NAME. * ST1224.2 +002200* X-83 - OBJECT COMPUTER NAME. * ST1224.2 +002300* * ST1224.2 +002400**************************************************************** ST1224.2 +002500* ST122 BUILDS A FILE WHICH IS SORTED IN ST123 AND CHECKED IN* ST1224.2 +002600* ST124. THE CREATED FILE CONSISTS OF 40 RECORDS OF VARYING * ST1224.2 +002700* LENGTH (50, 75, 100 CHARACTERS). THE THREE RECORDS SHOWN * ST1224.2 +002800* BELOW REOCCUR UNTIL 40 IS REACHED. * ST1224.2 +002900* NON-KEY KEY-1 KEY-2 FILLER * ST1224.2 +003000* X(2) X(10) X(38) * ST1224.2 +003100* * ST1224.2 +003200* "BB" "LOWEST TWO" "MIDDLE TWO-FIRST" X(25) VALUE ZERO * ST1224.2 +003300* "CC" "LOWEST TWO" "MIDDLE TWO-SECOND" X(50) VALUE QUOTE* ST1224.2 +003400* "AA" "LOWEST ONE" "MIDDLE ONE-ONLY" (NONE) * ST1224.2 +003500* * ST1224.2 +003600* PROGRAMS ST122A, ST123A AND ST124A WILL BE USED * ST1224.2 +003700* ONLY IF LEVEL 2 OF THE SEQUENTIAL I-O MODULE IS SUPPORTED * ST1224.2 +003800* AS THE "RECORD IS VARYING IN SIZE" CLAUSE IS USED IN * ST1224.2 +003900* ST123A. * ST1224.2 +004000* * ST1224.2 +004100**************************************************************** ST1224.2 +004200 ST1224.2 +004300 ENVIRONMENT DIVISION. ST1224.2 +004400 CONFIGURATION SECTION. ST1224.2 +004500 SOURCE-COMPUTER. ST1224.2 +004600 Linux. ST1224.2 +004700 OBJECT-COMPUTER. ST1224.2 +004800 Linux. ST1224.2 +004900 INPUT-OUTPUT SECTION. ST1224.2 +005000 FILE-CONTROL. ST1224.2 +005100 SELECT PRINT-FILE ASSIGN TO ST1224.2 +005200 "report.log". ST1224.2 +005300 SELECT SORTOUT-1I ASSIGN TO ST1224.2 +005400 "XXXXX001". ST1224.2 +005500 DATA DIVISION. ST1224.2 +005600 FILE SECTION. ST1224.2 +005700 FD PRINT-FILE. ST1224.2 +005800 01 PRINT-REC PICTURE X(120). ST1224.2 +005900 01 DUMMY-RECORD PICTURE X(120). ST1224.2 +006000 FD SORTOUT-1I ST1224.2 +006100 LABEL RECORDS STANDARD ST1224.2 +006200*C VALUE OF ST1224.2 +006300*C OCLABELID ST1224.2 +006400*C IS ST1224.2 +006500*C "OCDUMMY" ST1224.2 +006600*G SYSIN ST1224.2 +006700 RECORD IS VARYING IN SIZE FROM 50 TO 100 CHARACTERS ST1224.2 +006800 DATA RECORDS ARE SHORT-RECORD ST1224.2 +006900 MEDIUM-RECORD ST1224.2 +007000 LONG-RECORD. ST1224.2 +007100 01 SHORT-RECORD PICTURE X(50). ST1224.2 +007200 01 MEDIUM-RECORD PICTURE X(75). ST1224.2 +007300 01 LONG-RECORD PICTURE X(100). ST1224.2 +007400 WORKING-STORAGE SECTION. ST1224.2 +007500 77 COMMENT-SENTENCE PICTURE X(119) VALUE " ST122A HAS CREATED AST1224.2 +007600- "FILE OF 40 VARIABLE-LENGTH-RECORDS. THESE RECORDS WILL BE SOST1224.2 +007700- "RTED IN ST123A AND CHECKED IN ST124A.". ST1224.2 +007800 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1224.2 +007900 01 SHORT-WORK. ST1224.2 +008000 02 FILLER PICTURE XX VALUE "AA". ST1224.2 +008100 02 FILLER PICTURE X(10) VALUE "LOWEST ONE". ST1224.2 +008200 02 FILLER PICTURE X(38) VALUE "MIDDLE ONE-ONLY". ST1224.2 +008300 01 MEDIUM-WORK. ST1224.2 +008400 02 FILLER PICTURE XX VALUE "BB". ST1224.2 +008500 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1224.2 +008600 02 FILLER PICTURE X(38) VALUE "MIDDLE TWO-FIRST". ST1224.2 +008700 02 FILLER PICTURE X(25) VALUE ZERO. ST1224.2 +008800 01 LONG-WORK. ST1224.2 +008900 02 FILLER PICTURE XX VALUE "CC". ST1224.2 +009000 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1224.2 +009100 02 FILLER PICTURE X(38) VALUE "MIDDLE TWO-SECOND". ST1224.2 +009200 02 FILLER PICTURE X(50) VALUE QUOTE. ST1224.2 +009300 01 TEST-RESULTS. ST1224.2 +009400 02 FILLER PIC X VALUE SPACE. ST1224.2 +009500 02 FEATURE PIC X(20) VALUE SPACE. ST1224.2 +009600 02 FILLER PIC X VALUE SPACE. ST1224.2 +009700 02 P-OR-F PIC X(5) VALUE SPACE. ST1224.2 +009800 02 FILLER PIC X VALUE SPACE. ST1224.2 +009900 02 PAR-NAME. ST1224.2 +010000 03 FILLER PIC X(19) VALUE SPACE. ST1224.2 +010100 03 PARDOT-X PIC X VALUE SPACE. ST1224.2 +010200 03 DOTVALUE PIC 99 VALUE ZERO. ST1224.2 +010300 02 FILLER PIC X(8) VALUE SPACE. ST1224.2 +010400 02 RE-MARK PIC X(61). ST1224.2 +010500 01 TEST-COMPUTED. ST1224.2 +010600 02 FILLER PIC X(30) VALUE SPACE. ST1224.2 +010700 02 FILLER PIC X(17) VALUE ST1224.2 +010800 " COMPUTED=". ST1224.2 +010900 02 COMPUTED-X. ST1224.2 +011000 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1224.2 +011100 03 COMPUTED-N REDEFINES COMPUTED-A ST1224.2 +011200 PIC -9(9).9(9). ST1224.2 +011300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1224.2 +011400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1224.2 +011500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1224.2 +011600 03 CM-18V0 REDEFINES COMPUTED-A. ST1224.2 +011700 04 COMPUTED-18V0 PIC -9(18). ST1224.2 +011800 04 FILLER PIC X. ST1224.2 +011900 03 FILLER PIC X(50) VALUE SPACE. ST1224.2 +012000 01 TEST-CORRECT. ST1224.2 +012100 02 FILLER PIC X(30) VALUE SPACE. ST1224.2 +012200 02 FILLER PIC X(17) VALUE " CORRECT =". ST1224.2 +012300 02 CORRECT-X. ST1224.2 +012400 03 CORRECT-A PIC X(20) VALUE SPACE. ST1224.2 +012500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1224.2 +012600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1224.2 +012700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1224.2 +012800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1224.2 +012900 03 CR-18V0 REDEFINES CORRECT-A. ST1224.2 +013000 04 CORRECT-18V0 PIC -9(18). ST1224.2 +013100 04 FILLER PIC X. ST1224.2 +013200 03 FILLER PIC X(2) VALUE SPACE. ST1224.2 +013300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1224.2 +013400 01 CCVS-C-1. ST1224.2 +013500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1224.2 +013600- "SS PARAGRAPH-NAME ST1224.2 +013700- " REMARKS". ST1224.2 +013800 02 FILLER PIC X(20) VALUE SPACE. ST1224.2 +013900 01 CCVS-C-2. ST1224.2 +014000 02 FILLER PIC X VALUE SPACE. ST1224.2 +014100 02 FILLER PIC X(6) VALUE "TESTED". ST1224.2 +014200 02 FILLER PIC X(15) VALUE SPACE. ST1224.2 +014300 02 FILLER PIC X(4) VALUE "FAIL". ST1224.2 +014400 02 FILLER PIC X(94) VALUE SPACE. ST1224.2 +014500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1224.2 +014600 01 REC-CT PIC 99 VALUE ZERO. ST1224.2 +014700 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1224.2 +014800 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1224.2 +014900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1224.2 +015000 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1224.2 +015100 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1224.2 +015200 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1224.2 +015300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1224.2 +015400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1224.2 +015500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1224.2 +015600 01 CCVS-H-1. ST1224.2 +015700 02 FILLER PIC X(39) VALUE SPACES. ST1224.2 +015800 02 FILLER PIC X(42) VALUE ST1224.2 +015900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1224.2 +016000 02 FILLER PIC X(39) VALUE SPACES. ST1224.2 +016100 01 CCVS-H-2A. ST1224.2 +016200 02 FILLER PIC X(40) VALUE SPACE. ST1224.2 +016300 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1224.2 +016400 02 FILLER PIC XXXX VALUE ST1224.2 +016500 "4.2 ". ST1224.2 +016600 02 FILLER PIC X(28) VALUE ST1224.2 +016700 " COPY - NOT FOR DISTRIBUTION". ST1224.2 +016800 02 FILLER PIC X(41) VALUE SPACE. ST1224.2 +016900 ST1224.2 +017000 01 CCVS-H-2B. ST1224.2 +017100 02 FILLER PIC X(15) VALUE ST1224.2 +017200 "TEST RESULT OF ". ST1224.2 +017300 02 TEST-ID PIC X(9). ST1224.2 +017400 02 FILLER PIC X(4) VALUE ST1224.2 +017500 " IN ". ST1224.2 +017600 02 FILLER PIC X(12) VALUE ST1224.2 +017700 " HIGH ". ST1224.2 +017800 02 FILLER PIC X(22) VALUE ST1224.2 +017900 " LEVEL VALIDATION FOR ". ST1224.2 +018000 02 FILLER PIC X(58) VALUE ST1224.2 +018100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1224.2 +018200 01 CCVS-H-3. ST1224.2 +018300 02 FILLER PIC X(34) VALUE ST1224.2 +018400 " FOR OFFICIAL USE ONLY ". ST1224.2 +018500 02 FILLER PIC X(58) VALUE ST1224.2 +018600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1224.2 +018700 02 FILLER PIC X(28) VALUE ST1224.2 +018800 " COPYRIGHT 1985 ". ST1224.2 +018900 01 CCVS-E-1. ST1224.2 +019000 02 FILLER PIC X(52) VALUE SPACE. ST1224.2 +019100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1224.2 +019200 02 ID-AGAIN PIC X(9). ST1224.2 +019300 02 FILLER PIC X(45) VALUE SPACES. ST1224.2 +019400 01 CCVS-E-2. ST1224.2 +019500 02 FILLER PIC X(31) VALUE SPACE. ST1224.2 +019600 02 FILLER PIC X(21) VALUE SPACE. ST1224.2 +019700 02 CCVS-E-2-2. ST1224.2 +019800 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1224.2 +019900 03 FILLER PIC X VALUE SPACE. ST1224.2 +020000 03 ENDER-DESC PIC X(44) VALUE ST1224.2 +020100 "ERRORS ENCOUNTERED". ST1224.2 +020200 01 CCVS-E-3. ST1224.2 +020300 02 FILLER PIC X(22) VALUE ST1224.2 +020400 " FOR OFFICIAL USE ONLY". ST1224.2 +020500 02 FILLER PIC X(12) VALUE SPACE. ST1224.2 +020600 02 FILLER PIC X(58) VALUE ST1224.2 +020700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1224.2 +020800 02 FILLER PIC X(13) VALUE SPACE. ST1224.2 +020900 02 FILLER PIC X(15) VALUE ST1224.2 +021000 " COPYRIGHT 1985". ST1224.2 +021100 01 CCVS-E-4. ST1224.2 +021200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1224.2 +021300 02 FILLER PIC X(4) VALUE " OF ". ST1224.2 +021400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1224.2 +021500 02 FILLER PIC X(40) VALUE ST1224.2 +021600 " TESTS WERE EXECUTED SUCCESSFULLY". ST1224.2 +021700 01 XXINFO. ST1224.2 +021800 02 FILLER PIC X(19) VALUE ST1224.2 +021900 "*** INFORMATION ***". ST1224.2 +022000 02 INFO-TEXT. ST1224.2 +022100 04 FILLER PIC X(8) VALUE SPACE. ST1224.2 +022200 04 XXCOMPUTED PIC X(20). ST1224.2 +022300 04 FILLER PIC X(5) VALUE SPACE. ST1224.2 +022400 04 XXCORRECT PIC X(20). ST1224.2 +022500 02 INF-ANSI-REFERENCE PIC X(48). ST1224.2 +022600 01 HYPHEN-LINE. ST1224.2 +022700 02 FILLER PIC IS X VALUE IS SPACE. ST1224.2 +022800 02 FILLER PIC IS X(65) VALUE IS "************************ST1224.2 +022900- "*****************************************". ST1224.2 +023000 02 FILLER PIC IS X(54) VALUE IS "************************ST1224.2 +023100- "******************************". ST1224.2 +023200 01 CCVS-PGM-ID PIC X(9) VALUE ST1224.2 +023300 "ST122A". ST1224.2 +023400 PROCEDURE DIVISION. ST1224.2 +023500 CCVS1 SECTION. ST1224.2 +023600 OPEN-FILES. ST1224.2 +023700 OPEN OUTPUT PRINT-FILE. ST1224.2 +023800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1224.2 +023900 MOVE SPACE TO TEST-RESULTS. ST1224.2 +024000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1224.2 +024100 GO TO CCVS1-EXIT. ST1224.2 +024200 CLOSE-FILES. ST1224.2 +024300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1224.2 +024400 TERMINATE-CCVS. ST1224.2 +024500*S EXIT PROGRAM. ST1224.2 +024600*SERMINATE-CALL. ST1224.2 +024700 STOP RUN. ST1224.2 +024800 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1224.2 +024900 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1224.2 +025000 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1224.2 +025100 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1224.2 +025200 MOVE "****TEST DELETED****" TO RE-MARK. ST1224.2 +025300 PRINT-DETAIL. ST1224.2 +025400 IF REC-CT NOT EQUAL TO ZERO ST1224.2 +025500 MOVE "." TO PARDOT-X ST1224.2 +025600 MOVE REC-CT TO DOTVALUE. ST1224.2 +025700 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1224.2 +025800 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1224.2 +025900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1224.2 +026000 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1224.2 +026100 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1224.2 +026200 MOVE SPACE TO CORRECT-X. ST1224.2 +026300 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1224.2 +026400 MOVE SPACE TO RE-MARK. ST1224.2 +026500 HEAD-ROUTINE. ST1224.2 +026600 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +026700 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +026800 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1224.2 +026900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1224.2 +027000 COLUMN-NAMES-ROUTINE. ST1224.2 +027100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +027200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +027300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +027400 END-ROUTINE. ST1224.2 +027500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1224.2 +027600 END-RTN-EXIT. ST1224.2 +027700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +027800 END-ROUTINE-1. ST1224.2 +027900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1224.2 +028000 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1224.2 +028100 ADD PASS-COUNTER TO ERROR-HOLD. ST1224.2 +028200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1224.2 +028300 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1224.2 +028400 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1224.2 +028500 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1224.2 +028600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1224.2 +028700 END-ROUTINE-12. ST1224.2 +028800 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1224.2 +028900 IF ERROR-COUNTER IS EQUAL TO ZERO ST1224.2 +029000 MOVE "NO " TO ERROR-TOTAL ST1224.2 +029100 ELSE ST1224.2 +029200 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1224.2 +029300 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1224.2 +029400 PERFORM WRITE-LINE. ST1224.2 +029500 END-ROUTINE-13. ST1224.2 +029600 IF DELETE-COUNTER IS EQUAL TO ZERO ST1224.2 +029700 MOVE "NO " TO ERROR-TOTAL ELSE ST1224.2 +029800 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1224.2 +029900 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1224.2 +030000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +030100 IF INSPECT-COUNTER EQUAL TO ZERO ST1224.2 +030200 MOVE "NO " TO ERROR-TOTAL ST1224.2 +030300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1224.2 +030400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1224.2 +030500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +030600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1224.2 +030700 WRITE-LINE. ST1224.2 +030800 ADD 1 TO RECORD-COUNT. ST1224.2 +030900 IF RECORD-COUNT GREATER 42 ST1224.2 +031000 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1224.2 +031100 MOVE SPACE TO DUMMY-RECORD ST1224.2 +031200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1224.2 +031300 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1224.2 +031400 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1224.2 +031500 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1224.2 +031600 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1224.2 +031700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1224.2 +031800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1224.2 +031900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1224.2 +032000 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1224.2 +032100 MOVE ZERO TO RECORD-COUNT. ST1224.2 +032200 PERFORM WRT-LN. ST1224.2 +032300 WRT-LN. ST1224.2 +032400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1224.2 +032500 MOVE SPACE TO DUMMY-RECORD. ST1224.2 +032600 BLANK-LINE-PRINT. ST1224.2 +032700 PERFORM WRT-LN. ST1224.2 +032800 FAIL-ROUTINE. ST1224.2 +032900 IF COMPUTED-X NOT EQUAL TO SPACE ST1224.2 +033000 GO TO FAIL-ROUTINE-WRITE. ST1224.2 +033100 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1224.2 +033200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1224.2 +033300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1224.2 +033400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +033500 MOVE SPACES TO INF-ANSI-REFERENCE. ST1224.2 +033600 GO TO FAIL-ROUTINE-EX. ST1224.2 +033700 FAIL-ROUTINE-WRITE. ST1224.2 +033800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1224.2 +033900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1224.2 +034000 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1224.2 +034100 MOVE SPACES TO COR-ANSI-REFERENCE. ST1224.2 +034200 FAIL-ROUTINE-EX. EXIT. ST1224.2 +034300 BAIL-OUT. ST1224.2 +034400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1224.2 +034500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1224.2 +034600 BAIL-OUT-WRITE. ST1224.2 +034700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1224.2 +034800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1224.2 +034900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1224.2 +035000 MOVE SPACES TO INF-ANSI-REFERENCE. ST1224.2 +035100 BAIL-OUT-EX. EXIT. ST1224.2 +035200 CCVS1-EXIT. ST1224.2 +035300 EXIT. ST1224.2 +035400 ST122A-0001-01. ST1224.2 +035500 OPEN OUTPUT SORTOUT-1I. ST1224.2 +035600 BUILD-LOOP. ST1224.2 +035700 MOVE MEDIUM-WORK TO MEDIUM-RECORD. ST1224.2 +035800 WRITE MEDIUM-RECORD. ST1224.2 +035900 ADD 1 TO UTIL-CTR. ST1224.2 +036000 IF UTIL-CTR GREATER 39 ST1224.2 +036100 GO TO ST122A-0002-01. ST1224.2 +036200 MOVE LONG-WORK TO LONG-RECORD. ST1224.2 +036300 WRITE LONG-RECORD. ST1224.2 +036400 ADD 1 TO UTIL-CTR. ST1224.2 +036500 MOVE SHORT-WORK TO SHORT-RECORD. ST1224.2 +036600 WRITE SHORT-RECORD. ST1224.2 +036700 ADD 1 TO UTIL-CTR. ST1224.2 +036800 GO TO BUILD-LOOP. ST1224.2 +036900 ST122A-0002-01. ST1224.2 +037000 MOVE SPACES TO TEST-RESULTS. ST1224.2 +037100 MOVE COMMENT-SENTENCE TO TEST-RESULTS. ST1224.2 +037200 PERFORM PRINT-DETAIL. ST1224.2 +037300 MOVE SPACES TO TEST-RESULTS. ST1224.2 +037400 CLOSE SORTOUT-1I. ST1224.2 +037500 CCVS-EXIT SECTION. ST1224.2 +037600 CCVS-999999. ST1224.2 +037700 GO TO CLOSE-FILES. ST1224.2 diff --git a/tests/cobol85/ST/ST123A.SUB b/tests/cobol85/ST/ST123A.SUB new file mode 100755 index 00000000..260ceb80 --- /dev/null +++ b/tests/cobol85/ST/ST123A.SUB @@ -0,0 +1,121 @@ +000100 IDENTIFICATION DIVISION. ST1234.2 +000200 PROGRAM-ID. ST1234.2 +000300 ST123A. ST1234.2 +000400**************************************************************** ST1234.2 +000500* * ST1234.2 +000600* VALIDATION FOR:- * ST1234.2 +000700* * ST1234.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1234.2 +000900* * ST1234.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1234.2 +001100* * ST1234.2 +001200**************************************************************** ST1234.2 +001300* * ST1234.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1234.2 +001500* * ST1234.2 +001600* X-01 * ST1234.2 +001700* X-02 * ST1234.2 +001800* X-27 * ST1234.2 +001900* X-55 - SYSTEM PRINTER NAME. * ST1234.2 +002000* X-69 * ST1234.2 +002100* X-74 * ST1234.2 +002200* X-75 * ST1234.2 +002300* X-76 * ST1234.2 +002400* X-82 - SOURCE COMPUTER NAME. * ST1234.2 +002500* X-83 - OBJECT COMPUTER NAME. * ST1234.2 +002600* * ST1234.2 +002700**************************************************************** ST1234.2 +002800* * ST1234.2 +002900* PROGRAM ST123A TESTS THE SORTING OF VARIABLE LENGTH * ST1234.2 +003000* RECORDS. THIS PROGRAM CAN BE USED ONLY IF LEVEL 2 OF THE * ST1234.2 +003100* SEQUENTIAL I-O MODULE IS SUPPORTED AS THE * ST1234.2 +003200* "RECORD IS VARYING IN SIZE" CLAUSE IS USED IN THE SD * ST1234.2 +003300* ENTRY. (ST123A WILL BE RUN AS PART OF THE SET ST122A, * ST1234.2 +003400* ST123A, ST124A). * ST1234.2 +003500* * ST1234.2 +003600**************************************************************** ST1234.2 +003700 ENVIRONMENT DIVISION. ST1234.2 +003800 CONFIGURATION SECTION. ST1234.2 +003900 SOURCE-COMPUTER. ST1234.2 +004000 Linux. ST1234.2 +004100 OBJECT-COMPUTER. ST1234.2 +004200 Linux. ST1234.2 +004300 INPUT-OUTPUT SECTION. ST1234.2 +004400 FILE-CONTROL. ST1234.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1234.2 +004600 "report.log". ST1234.2 +004700 SELECT SORTIN-1J ASSIGN TO ST1234.2 +004800 "XXXXX001". ST1234.2 +004900 SELECT SORTOUT-1J ASSIGN TO ST1234.2 +005000 "XXXXX002". ST1234.2 +005100 SELECT SORTFILE-1J ASSIGN TO ST1234.2 +005200 "XXXXX027". ST1234.2 +005300 DATA DIVISION. ST1234.2 +005400 FILE SECTION. ST1234.2 +005500 FD PRINT-FILE. ST1234.2 +005600 01 PRINT-REC PICTURE X(120). ST1234.2 +005700 01 DUMMY-RECORD PICTURE X(120). ST1234.2 +005800 FD SORTIN-1J ST1234.2 +005900 LABEL RECORDS STANDARD ST1234.2 +006000*C VALUE OF ST1234.2 +006100*C OCLABELID ST1234.2 +006200*C IS ST1234.2 +006300*C "OCDUMMY" ST1234.2 +006400*G SYSIN ST1234.2 +006500 RECORD IS VARYING IN SIZE ST1234.2 +006600 DATA RECORDS ARE SHORT-IN ST1234.2 +006700 MEDIUM-IN ST1234.2 +006800 LONG-IN. ST1234.2 +006900 01 SHORT-IN PICTURE X(50). ST1234.2 +007000 01 MEDIUM-IN PICTURE X(75). ST1234.2 +007100 01 LONG-IN. ST1234.2 +007200 02 FALSE-LENGTH-1 PICTURE X(25). ST1234.2 +007300 02 FALSE-LENGTH-2 PICTURE A(20). ST1234.2 +007400 02 FALSE-LENGTH-3 PICTURE 9(15). ST1234.2 +007500 02 FALSE-LENGTH-4 PICTURE X(40). ST1234.2 +007600 FD SORTOUT-1J ST1234.2 +007700 LABEL RECORDS ARE STANDARD ST1234.2 +007800*C VALUE OF ST1234.2 +007900*C OCLABELID ST1234.2 +008000*C IS ST1234.2 +008100*C "OCDUMMY" ST1234.2 +008200*G SYSIN ST1234.2 +008300 RECORD IS VARYING IN SIZE ST1234.2 +008400 DATA RECORD SHORT-OUT ST1234.2 +008500 MEDIUM-OUT ST1234.2 +008600 LONG-OUT. ST1234.2 +008700 01 SHORT-OUT. ST1234.2 +008800 02 FAKE-LENGTH-1 PICTURE X(10). ST1234.2 +008900 02 FAKE-LENGTH-2 PICTURE A(10). ST1234.2 +009000 02 FAKE-LENGTH-3 PICTURE 9(10). ST1234.2 +009100 02 FAKE-LENGTH-4 PICTURE X(20). ST1234.2 +009200 01 MEDIUM-OUT PICTURE X(75). ST1234.2 +009300 01 LONG-OUT PICTURE X(100). ST1234.2 +009400 SD SORTFILE-1J ST1234.2 +009500 RECORD IS VARYING IN SIZE ST1234.2 +009600 DATA RECORD SHORT-SORT ST1234.2 +009700 MEDIUM-SORT ST1234.2 +009800 LONG-SORT. ST1234.2 +009900 01 SHORT-SORT. ST1234.2 +010000 02 SHORT-NON-KEY PICTURE XX. ST1234.2 +010100 02 SHORT-KEY-1 PICTURE X(10). ST1234.2 +010200 02 SHORT-KEY-2 PICTURE X(38). ST1234.2 +010300 01 MEDIUM-SORT. ST1234.2 +010400 02 MEDIUM-NON-KEY PICTURE XX. ST1234.2 +010500 02 MEDIUM-KEY-1 PICTURE X(10). ST1234.2 +010600 02 MEDIUM-KEY-2 PICTURE X(38). ST1234.2 +010700 02 MEDIUM-FILLER PICTURE X(25). ST1234.2 +010800 01 LONG-SORT. ST1234.2 +010900 02 LONG-NON-KEY PICTURE XX. ST1234.2 +011000 02 LONG-KEY-1 PICTURE X(10). ST1234.2 +011100 02 LONG-KEY-2 PICTURE X(38). ST1234.2 +011200 02 LONG-FILLER PICTURE X(50). ST1234.2 +011300 PROCEDURE DIVISION. ST1234.2 +011400 SORT-PARAGRAPH. ST1234.2 +011500 SORT SORTFILE-1J ST1234.2 +011600 DESCENDING KEY ST1234.2 +011700 MEDIUM-KEY-1 ST1234.2 +011800 MEDIUM-KEY-2 ST1234.2 +011900 USING SORTIN-1J ST1234.2 +012000 GIVING SORTOUT-1J. ST1234.2 +012100 STOP RUN. ST1234.2 diff --git a/tests/cobol85/ST/ST124A.SUB b/tests/cobol85/ST/ST124A.SUB new file mode 100755 index 00000000..c6363bd2 --- /dev/null +++ b/tests/cobol85/ST/ST124A.SUB @@ -0,0 +1,510 @@ +000100 IDENTIFICATION DIVISION. ST1244.2 +000200 PROGRAM-ID. ST1244.2 +000300 ST124A. ST1244.2 +000400**************************************************************** ST1244.2 +000500* * ST1244.2 +000600* VALIDATION FOR:- * ST1244.2 +000700* * ST1244.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1244.2 +000900* * ST1244.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1244.2 +001100* * ST1244.2 +001200**************************************************************** ST1244.2 +001300* * ST1244.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1244.2 +001500* * ST1244.2 +001600* X-02 ST1244.2 +001700* X-55 - SYSTEM PRINTER NAME. * ST1244.2 +001800* X-69 * ST1244.2 +001900* X-74 * ST1244.2 +002000* X-76 * ST1244.2 +002100* X-82 - SOURCE COMPUTER NAME. * ST1244.2 +002200* X-83 - OBJECT COMPUTER NAME. * ST1244.2 +002300* * ST1244.2 +002400**************************************************************** ST1244.2 +002500* * ST1244.2 +002600* PROGRAM ST124A TESTS THE CONTENTS OF THE FILE PRODUCED BY * ST1244.2 +002700* ST123A. PROGRAMS ST122A, ST123A AND ST124A WILL BE USED * ST1244.2 +002800* ONLY IF LEVEL 2 OF THE SEQUENTIAL I-O MODULE IS SUPPORTED * ST1244.2 +002900* AS THE "RECORD IS VARYING IN SIZE" CLAUSE IS USED IN * ST1244.2 +003000* ST123A. * ST1244.2 +003100* * ST1244.2 +003200**************************************************************** ST1244.2 +003300* ST124A CHECKS THE OUTPUT FROM ST123A, WHICH IN TURN USED ST1244.2 +003400* INPUT FROM ST122A. ST1244.2 +003500* 40 VARIABLE-LENGTH RECORDS HAVE BEEN SORTED ST1244.2 +003600* SORTED AND SHOULD APPEAR AS SHOWN ST1244.2 +003700* NON-KEY KEY-1 KEY-2 FILLER ST1244.2 +003800* X(2) X(10) X(38) ST1244.2 +003900* ST1244.2 +004000* FIRST 13 RECORDS --- ST1244.2 +004100* "CC""LOWEST TWO""MIDDLE TWO-SECOND" X(50) VALUE QUOTEST1244.2 +004200* NEXT 14 RECORDS --- ST1244.2 +004300* "BB""LOWEST TWO""MIDDLE TWO-FIRST" X(25) VALUE ZERO ST1244.2 +004400* LAST 13 RECORDS --- ST1244.2 +004500* "AA""LOWEST ONE""MIDDLE ONE-ONLY" (NONE) ST1244.2 +004600* ST1244.2 +004700 ENVIRONMENT DIVISION. ST1244.2 +004800 CONFIGURATION SECTION. ST1244.2 +004900 SOURCE-COMPUTER. ST1244.2 +005000 Linux. ST1244.2 +005100 OBJECT-COMPUTER. ST1244.2 +005200 Linux. ST1244.2 +005300 INPUT-OUTPUT SECTION. ST1244.2 +005400 FILE-CONTROL. ST1244.2 +005500 SELECT PRINT-FILE ASSIGN TO ST1244.2 +005600 "report.log". ST1244.2 +005700 SELECT SORTIN-1K ASSIGN TO ST1244.2 +005800 "XXXXX002". ST1244.2 +005900 DATA DIVISION. ST1244.2 +006000 FILE SECTION. ST1244.2 +006100 FD PRINT-FILE. ST1244.2 +006200 01 PRINT-REC PICTURE X(120). ST1244.2 +006300 01 DUMMY-RECORD PICTURE X(120). ST1244.2 +006400 FD SORTIN-1K ST1244.2 +006500 LABEL RECORDS STANDARD ST1244.2 +006600*C VALUE OF ST1244.2 +006700*C OCLABELID ST1244.2 +006800*C IS ST1244.2 +006900*C "OCDUMMY" ST1244.2 +007000*G SYSIN ST1244.2 +007100 RECORD IS VARYING IN SIZE FROM 50 TO 100 CHARACTERS ST1244.2 +007200 DATA RECORDS ARE SHORT-RECORD ST1244.2 +007300 MEDIUM-RECORD ST1244.2 +007400 LONG-RECORD. ST1244.2 +007500 01 SHORT-RECORD PICTURE X(50). ST1244.2 +007600 01 MEDIUM-RECORD PICTURE X(75). ST1244.2 +007700 01 LONG-RECORD PICTURE X(100). ST1244.2 +007800 WORKING-STORAGE SECTION. ST1244.2 +007900 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1244.2 +008000 01 SHORT-WORK. ST1244.2 +008100 02 FILLER PICTURE XX VALUE "AA". ST1244.2 +008200 02 FILLER PICTURE X(10) VALUE "LOWEST ONE". ST1244.2 +008300 02 FILLER PICTURE X(38) ST1244.2 +008400 VALUE "MIDDLE ONE-ONLY ". ST1244.2 +008500 01 MEDIUM-WORK. ST1244.2 +008600 02 FILLER PICTURE XX VALUE "BB". ST1244.2 +008700 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1244.2 +008800 02 FILLER PICTURE X(38) ST1244.2 +008900 VALUE "MIDDLE TWO-FIRST ". ST1244.2 +009000 02 FILLER PICTURE X(25) VALUE ZERO. ST1244.2 +009100 01 LONG-WORK. ST1244.2 +009200 02 FILLER PICTURE XX VALUE "CC". ST1244.2 +009300 02 FILLER PICTURE X(10) VALUE "LOWEST TWO". ST1244.2 +009400 02 FILLER PICTURE X(38) ST1244.2 +009500 VALUE "MIDDLE TWO-SECOND ". ST1244.2 +009600 02 FILLER PICTURE X(50) VALUE QUOTE. ST1244.2 +009700 01 BREAKDOWN-LIMIT PICTURE 999. ST1244.2 +009800 01 COMPUTED-BREAKDOWN. ST1244.2 +009900 02 FIRST-20-CM PICTURE X(20). ST1244.2 +010000 02 SECOND-20-CM PICTURE X(20). ST1244.2 +010100 02 THIRD-20-CM PICTURE X(20). ST1244.2 +010200 02 FOURTH-20-CM PICTURE X(20). ST1244.2 +010300 02 FIFTH-20-CM PICTURE X(20). ST1244.2 +010400 01 CORRECT-BREAKDOWN. ST1244.2 +010500 02 FIRST-20-CR PICTURE X(20). ST1244.2 +010600 02 SECOND-20-CR PICTURE X(20). ST1244.2 +010700 02 THIRD-20-CR PICTURE X(20). ST1244.2 +010800 02 FOURTH-20-CR PICTURE X(20). ST1244.2 +010900 02 FIFTH-20-CR PICTURE X(20). ST1244.2 +011000 01 TEST-RESULTS. ST1244.2 +011100 02 FILLER PIC X VALUE SPACE. ST1244.2 +011200 02 FEATURE PIC X(20) VALUE SPACE. ST1244.2 +011300 02 FILLER PIC X VALUE SPACE. ST1244.2 +011400 02 P-OR-F PIC X(5) VALUE SPACE. ST1244.2 +011500 02 FILLER PIC X VALUE SPACE. ST1244.2 +011600 02 PAR-NAME. ST1244.2 +011700 03 FILLER PIC X(19) VALUE SPACE. ST1244.2 +011800 03 PARDOT-X PIC X VALUE SPACE. ST1244.2 +011900 03 DOTVALUE PIC 99 VALUE ZERO. ST1244.2 +012000 02 FILLER PIC X(8) VALUE SPACE. ST1244.2 +012100 02 RE-MARK PIC X(61). ST1244.2 +012200 01 TEST-COMPUTED. ST1244.2 +012300 02 FILLER PIC X(30) VALUE SPACE. ST1244.2 +012400 02 FILLER PIC X(17) VALUE ST1244.2 +012500 " COMPUTED=". ST1244.2 +012600 02 COMPUTED-X. ST1244.2 +012700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1244.2 +012800 03 COMPUTED-N REDEFINES COMPUTED-A ST1244.2 +012900 PIC -9(9).9(9). ST1244.2 +013000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1244.2 +013100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1244.2 +013200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1244.2 +013300 03 CM-18V0 REDEFINES COMPUTED-A. ST1244.2 +013400 04 COMPUTED-18V0 PIC -9(18). ST1244.2 +013500 04 FILLER PIC X. ST1244.2 +013600 03 FILLER PIC X(50) VALUE SPACE. ST1244.2 +013700 01 TEST-CORRECT. ST1244.2 +013800 02 FILLER PIC X(30) VALUE SPACE. ST1244.2 +013900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1244.2 +014000 02 CORRECT-X. ST1244.2 +014100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1244.2 +014200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1244.2 +014300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1244.2 +014400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1244.2 +014500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1244.2 +014600 03 CR-18V0 REDEFINES CORRECT-A. ST1244.2 +014700 04 CORRECT-18V0 PIC -9(18). ST1244.2 +014800 04 FILLER PIC X. ST1244.2 +014900 03 FILLER PIC X(2) VALUE SPACE. ST1244.2 +015000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1244.2 +015100 01 CCVS-C-1. ST1244.2 +015200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1244.2 +015300- "SS PARAGRAPH-NAME ST1244.2 +015400- " REMARKS". ST1244.2 +015500 02 FILLER PIC X(20) VALUE SPACE. ST1244.2 +015600 01 CCVS-C-2. ST1244.2 +015700 02 FILLER PIC X VALUE SPACE. ST1244.2 +015800 02 FILLER PIC X(6) VALUE "TESTED". ST1244.2 +015900 02 FILLER PIC X(15) VALUE SPACE. ST1244.2 +016000 02 FILLER PIC X(4) VALUE "FAIL". ST1244.2 +016100 02 FILLER PIC X(94) VALUE SPACE. ST1244.2 +016200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1244.2 +016300 01 REC-CT PIC 99 VALUE ZERO. ST1244.2 +016400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1244.2 +016500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1244.2 +016600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1244.2 +016700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1244.2 +016800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1244.2 +016900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1244.2 +017000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1244.2 +017100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1244.2 +017200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1244.2 +017300 01 CCVS-H-1. ST1244.2 +017400 02 FILLER PIC X(39) VALUE SPACES. ST1244.2 +017500 02 FILLER PIC X(42) VALUE ST1244.2 +017600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1244.2 +017700 02 FILLER PIC X(39) VALUE SPACES. ST1244.2 +017800 01 CCVS-H-2A. ST1244.2 +017900 02 FILLER PIC X(40) VALUE SPACE. ST1244.2 +018000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1244.2 +018100 02 FILLER PIC XXXX VALUE ST1244.2 +018200 "4.2 ". ST1244.2 +018300 02 FILLER PIC X(28) VALUE ST1244.2 +018400 " COPY - NOT FOR DISTRIBUTION". ST1244.2 +018500 02 FILLER PIC X(41) VALUE SPACE. ST1244.2 +018600 ST1244.2 +018700 01 CCVS-H-2B. ST1244.2 +018800 02 FILLER PIC X(15) VALUE ST1244.2 +018900 "TEST RESULT OF ". ST1244.2 +019000 02 TEST-ID PIC X(9). ST1244.2 +019100 02 FILLER PIC X(4) VALUE ST1244.2 +019200 " IN ". ST1244.2 +019300 02 FILLER PIC X(12) VALUE ST1244.2 +019400 " HIGH ". ST1244.2 +019500 02 FILLER PIC X(22) VALUE ST1244.2 +019600 " LEVEL VALIDATION FOR ". ST1244.2 +019700 02 FILLER PIC X(58) VALUE ST1244.2 +019800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1244.2 +019900 01 CCVS-H-3. ST1244.2 +020000 02 FILLER PIC X(34) VALUE ST1244.2 +020100 " FOR OFFICIAL USE ONLY ". ST1244.2 +020200 02 FILLER PIC X(58) VALUE ST1244.2 +020300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1244.2 +020400 02 FILLER PIC X(28) VALUE ST1244.2 +020500 " COPYRIGHT 1985 ". ST1244.2 +020600 01 CCVS-E-1. ST1244.2 +020700 02 FILLER PIC X(52) VALUE SPACE. ST1244.2 +020800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1244.2 +020900 02 ID-AGAIN PIC X(9). ST1244.2 +021000 02 FILLER PIC X(45) VALUE SPACES. ST1244.2 +021100 01 CCVS-E-2. ST1244.2 +021200 02 FILLER PIC X(31) VALUE SPACE. ST1244.2 +021300 02 FILLER PIC X(21) VALUE SPACE. ST1244.2 +021400 02 CCVS-E-2-2. ST1244.2 +021500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1244.2 +021600 03 FILLER PIC X VALUE SPACE. ST1244.2 +021700 03 ENDER-DESC PIC X(44) VALUE ST1244.2 +021800 "ERRORS ENCOUNTERED". ST1244.2 +021900 01 CCVS-E-3. ST1244.2 +022000 02 FILLER PIC X(22) VALUE ST1244.2 +022100 " FOR OFFICIAL USE ONLY". ST1244.2 +022200 02 FILLER PIC X(12) VALUE SPACE. ST1244.2 +022300 02 FILLER PIC X(58) VALUE ST1244.2 +022400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1244.2 +022500 02 FILLER PIC X(13) VALUE SPACE. ST1244.2 +022600 02 FILLER PIC X(15) VALUE ST1244.2 +022700 " COPYRIGHT 1985". ST1244.2 +022800 01 CCVS-E-4. ST1244.2 +022900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1244.2 +023000 02 FILLER PIC X(4) VALUE " OF ". ST1244.2 +023100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1244.2 +023200 02 FILLER PIC X(40) VALUE ST1244.2 +023300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1244.2 +023400 01 XXINFO. ST1244.2 +023500 02 FILLER PIC X(19) VALUE ST1244.2 +023600 "*** INFORMATION ***". ST1244.2 +023700 02 INFO-TEXT. ST1244.2 +023800 04 FILLER PIC X(8) VALUE SPACE. ST1244.2 +023900 04 XXCOMPUTED PIC X(20). ST1244.2 +024000 04 FILLER PIC X(5) VALUE SPACE. ST1244.2 +024100 04 XXCORRECT PIC X(20). ST1244.2 +024200 02 INF-ANSI-REFERENCE PIC X(48). ST1244.2 +024300 01 HYPHEN-LINE. ST1244.2 +024400 02 FILLER PIC IS X VALUE IS SPACE. ST1244.2 +024500 02 FILLER PIC IS X(65) VALUE IS "************************ST1244.2 +024600- "*****************************************". ST1244.2 +024700 02 FILLER PIC IS X(54) VALUE IS "************************ST1244.2 +024800- "******************************". ST1244.2 +024900 01 CCVS-PGM-ID PIC X(9) VALUE ST1244.2 +025000 "ST124A". ST1244.2 +025100 PROCEDURE DIVISION. ST1244.2 +025200 CCVS1 SECTION. ST1244.2 +025300 OPEN-FILES. ST1244.2 +025400 OPEN OUTPUT PRINT-FILE. ST1244.2 +025500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1244.2 +025600 MOVE SPACE TO TEST-RESULTS. ST1244.2 +025700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1244.2 +025800 GO TO CCVS1-EXIT. ST1244.2 +025900 CLOSE-FILES. ST1244.2 +026000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1244.2 +026100 TERMINATE-CCVS. ST1244.2 +026200*S EXIT PROGRAM. ST1244.2 +026300*SERMINATE-CALL. ST1244.2 +026400 STOP RUN. ST1244.2 +026500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1244.2 +026600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1244.2 +026700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1244.2 +026800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1244.2 +026900 MOVE "****TEST DELETED****" TO RE-MARK. ST1244.2 +027000 PRINT-DETAIL. ST1244.2 +027100 IF REC-CT NOT EQUAL TO ZERO ST1244.2 +027200 MOVE "." TO PARDOT-X ST1244.2 +027300 MOVE REC-CT TO DOTVALUE. ST1244.2 +027400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1244.2 +027500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1244.2 +027600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1244.2 +027700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1244.2 +027800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1244.2 +027900 MOVE SPACE TO CORRECT-X. ST1244.2 +028000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1244.2 +028100 MOVE SPACE TO RE-MARK. ST1244.2 +028200 HEAD-ROUTINE. ST1244.2 +028300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +028400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +028500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1244.2 +028600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1244.2 +028700 COLUMN-NAMES-ROUTINE. ST1244.2 +028800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +028900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +029000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +029100 END-ROUTINE. ST1244.2 +029200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1244.2 +029300 END-RTN-EXIT. ST1244.2 +029400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +029500 END-ROUTINE-1. ST1244.2 +029600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1244.2 +029700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1244.2 +029800 ADD PASS-COUNTER TO ERROR-HOLD. ST1244.2 +029900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1244.2 +030000 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1244.2 +030100 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1244.2 +030200 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1244.2 +030300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1244.2 +030400 END-ROUTINE-12. ST1244.2 +030500 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1244.2 +030600 IF ERROR-COUNTER IS EQUAL TO ZERO ST1244.2 +030700 MOVE "NO " TO ERROR-TOTAL ST1244.2 +030800 ELSE ST1244.2 +030900 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1244.2 +031000 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1244.2 +031100 PERFORM WRITE-LINE. ST1244.2 +031200 END-ROUTINE-13. ST1244.2 +031300 IF DELETE-COUNTER IS EQUAL TO ZERO ST1244.2 +031400 MOVE "NO " TO ERROR-TOTAL ELSE ST1244.2 +031500 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1244.2 +031600 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1244.2 +031700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +031800 IF INSPECT-COUNTER EQUAL TO ZERO ST1244.2 +031900 MOVE "NO " TO ERROR-TOTAL ST1244.2 +032000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1244.2 +032100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1244.2 +032200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +032300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1244.2 +032400 WRITE-LINE. ST1244.2 +032500 ADD 1 TO RECORD-COUNT. ST1244.2 +032600 IF RECORD-COUNT GREATER 42 ST1244.2 +032700 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1244.2 +032800 MOVE SPACE TO DUMMY-RECORD ST1244.2 +032900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1244.2 +033000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1244.2 +033100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1244.2 +033200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1244.2 +033300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1244.2 +033400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1244.2 +033500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1244.2 +033600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1244.2 +033700 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1244.2 +033800 MOVE ZERO TO RECORD-COUNT. ST1244.2 +033900 PERFORM WRT-LN. ST1244.2 +034000 WRT-LN. ST1244.2 +034100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1244.2 +034200 MOVE SPACE TO DUMMY-RECORD. ST1244.2 +034300 BLANK-LINE-PRINT. ST1244.2 +034400 PERFORM WRT-LN. ST1244.2 +034500 FAIL-ROUTINE. ST1244.2 +034600 IF COMPUTED-X NOT EQUAL TO SPACE ST1244.2 +034700 GO TO FAIL-ROUTINE-WRITE. ST1244.2 +034800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1244.2 +034900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1244.2 +035000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1244.2 +035100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +035200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1244.2 +035300 GO TO FAIL-ROUTINE-EX. ST1244.2 +035400 FAIL-ROUTINE-WRITE. ST1244.2 +035500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1244.2 +035600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1244.2 +035700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1244.2 +035800 MOVE SPACES TO COR-ANSI-REFERENCE. ST1244.2 +035900 FAIL-ROUTINE-EX. EXIT. ST1244.2 +036000 BAIL-OUT. ST1244.2 +036100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1244.2 +036200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1244.2 +036300 BAIL-OUT-WRITE. ST1244.2 +036400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1244.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1244.2 +036600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1244.2 +036700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1244.2 +036800 BAIL-OUT-EX. EXIT. ST1244.2 +036900 CCVS1-EXIT. ST1244.2 +037000 EXIT. ST1244.2 +037100 SECT-ST111-0001 SECTION. ST1244.2 +037200 ST124A-0001-01. ST1244.2 +037300 OPEN INPUT SORTIN-1K. ST1244.2 +037400 MOVE " ***** ST123A DOES NOT PRODUCE A PRINTED REPORT ST1244.2 +037500- "*****" TO TEST-RESULTS. ST1244.2 +037600 PERFORM PRINT-DETAIL. ST1244.2 +037700 MOVE SPACE TO TEST-RESULTS. ST1244.2 +037800 PERFORM END-ROUTINE. ST1244.2 +037900 MOVE "SORT VARIABLE RECORD" TO FEATURE. ST1244.2 +038000 SORT-TEST-1. ST1244.2 +038100 MOVE "SORT-TEST-1" TO PAR-NAME. ST1244.2 +038200 PERFORM READ-SORTIN. ST1244.2 +038300 IF LONG-RECORD EQUAL TO LONG-WORK ST1244.2 +038400 PERFORM PASS GO TO SORT-WRITE-1. ST1244.2 +038500* NOTE FIRST RECORD. ST1244.2 +038600 SORT-FAIL-1. ST1244.2 +038700 MOVE 100 TO BREAKDOWN-LIMIT. ST1244.2 +038800 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +038900 MOVE LONG-WORK TO CORRECT-BREAKDOWN. ST1244.2 +039000 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +039100 SORT-WRITE-1. ST1244.2 +039200 PERFORM PRINT-DETAIL. ST1244.2 +039300 SORT-TEST-2. ST1244.2 +039400 MOVE "SORT-TEST-2" TO PAR-NAME. ST1244.2 +039500 PERFORM READ-SORTIN 12 TIMES. ST1244.2 +039600 IF LONG-RECORD EQUAL TO LONG-WORK ST1244.2 +039700 PERFORM PASS GO TO SORT-WRITE-2. ST1244.2 +039800* NOTE THIRTEENTH RECORD. ST1244.2 +039900 SORT-FAIL-2. ST1244.2 +040000 MOVE 100 TO BREAKDOWN-LIMIT. ST1244.2 +040100 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +040200 MOVE LONG-WORK TO CORRECT-BREAKDOWN. ST1244.2 +040300 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +040400 SORT-WRITE-2. ST1244.2 +040500 PERFORM PRINT-DETAIL. ST1244.2 +040600 SORT-TEST-3. ST1244.2 +040700 MOVE "SORT-TEST-3" TO PAR-NAME. ST1244.2 +040800 PERFORM READ-SORTIN. ST1244.2 +040900 IF MEDIUM-RECORD EQUAL TO MEDIUM-WORK ST1244.2 +041000 PERFORM PASS GO TO SORT-WRITE-3. ST1244.2 +041100* NOTE FOURTEENTH RECORD. ST1244.2 +041200 SORT-FAIL-3. ST1244.2 +041300 MOVE 75 TO BREAKDOWN-LIMIT. ST1244.2 +041400 MOVE MEDIUM-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +041500 MOVE MEDIUM-WORK TO CORRECT-BREAKDOWN. ST1244.2 +041600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +041700 SORT-WRITE-3. ST1244.2 +041800 PERFORM PRINT-DETAIL. ST1244.2 +041900 SORT-TEST-4. ST1244.2 +042000 MOVE "SORT-TEST-4" TO PAR-NAME. ST1244.2 +042100 PERFORM READ-SORTIN 13 TIMES. ST1244.2 +042200 IF MEDIUM-RECORD EQUAL TO MEDIUM-WORK ST1244.2 +042300 PERFORM PASS GO TO SORT-WRITE-4. ST1244.2 +042400* NOTE TWENTY-SEVENTH RECORD. ST1244.2 +042500 SORT-FAIL-4. ST1244.2 +042600 MOVE 75 TO BREAKDOWN-LIMIT. ST1244.2 +042700 MOVE MEDIUM-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +042800 MOVE MEDIUM-WORK TO CORRECT-BREAKDOWN. ST1244.2 +042900 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +043000 SORT-WRITE-4. ST1244.2 +043100 PERFORM PRINT-DETAIL. ST1244.2 +043200 SORT-TEST-5. ST1244.2 +043300 MOVE "SORT-TEST-5" TO PAR-NAME. ST1244.2 +043400 PERFORM READ-SORTIN. ST1244.2 +043500 IF SHORT-RECORD EQUAL TO SHORT-WORK ST1244.2 +043600 PERFORM PASS GO TO SORT-WRITE-5. ST1244.2 +043700* NOTE TWENTY-EIGHTH RECORD. ST1244.2 +043800 SORT-FAIL-5. ST1244.2 +043900 MOVE 50 TO BREAKDOWN-LIMIT. ST1244.2 +044000 MOVE SHORT-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +044100 MOVE SHORT-WORK TO CORRECT-BREAKDOWN. ST1244.2 +044200 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +044300 SORT-WRITE-5. ST1244.2 +044400 PERFORM PRINT-DETAIL. ST1244.2 +044500 SORT-TEST-6. ST1244.2 +044600 MOVE "SORT-TEST-6" TO PAR-NAME. ST1244.2 +044700 PERFORM READ-SORTIN 12 TIMES. ST1244.2 +044800 IF SHORT-RECORD EQUAL TO SHORT-WORK ST1244.2 +044900 PERFORM PASS GO TO SORT-WRITE-6. ST1244.2 +045000* NOTE FORTIETH RECORD. ST1244.2 +045100 SORT-FAIL-6. ST1244.2 +045200 MOVE 50 TO BREAKDOWN-LIMIT. ST1244.2 +045300 MOVE SHORT-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +045400 MOVE SHORT-WORK TO CORRECT-BREAKDOWN. ST1244.2 +045500 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +045600 SORT-WRITE-6. ST1244.2 +045700 PERFORM PRINT-DETAIL. ST1244.2 +045800 SORT-TEST-7. ST1244.2 +045900 MOVE "SORT-TEST-7" TO PAR-NAME. ST1244.2 +046000 READ SORTIN-1K AT END ST1244.2 +046100 PERFORM PASS GO TO SORT-WRITE-7. ST1244.2 +046200 SORT-FAIL-7. ST1244.2 +046300 MOVE 100 TO BREAKDOWN-LIMIT. ST1244.2 +046400 MOVE LONG-RECORD TO COMPUTED-BREAKDOWN. ST1244.2 +046500 MOVE SPACE TO CORRECT-BREAKDOWN. ST1244.2 +046600 PERFORM BREAKDOWN-PARA THRU BREAKDOWN-EXIT. ST1244.2 +046700 PERFORM PRINT-DETAIL. ST1244.2 +046800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1244.2 +046900 SORT-WRITE-7. ST1244.2 +047000 PERFORM PRINT-DETAIL. ST1244.2 +047100 CLOSE SORTIN-1K. ST1244.2 +047200 GO TO CCVS-EXIT. ST1244.2 +047300 BREAKDOWN-PARA. ST1244.2 +047400 PERFORM FAIL. ST1244.2 +047500 MOVE FIRST-20-CM TO COMPUTED-A. ST1244.2 +047600 MOVE FIRST-20-CR TO CORRECT-A. ST1244.2 +047700 MOVE "FIRST TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +047800 PERFORM PRINT-DETAIL. ST1244.2 +047900 MOVE SECOND-20-CM TO COMPUTED-A. ST1244.2 +048000 MOVE SECOND-20-CR TO CORRECT-A. ST1244.2 +048100 MOVE "SECOND TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +048200 PERFORM PRINT-DETAIL. ST1244.2 +048300 MOVE THIRD-20-CM TO COMPUTED-A. ST1244.2 +048400 MOVE THIRD-20-CR TO CORRECT-A. ST1244.2 +048500 MOVE "THIRD TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +048600 PERFORM PRINT-DETAIL. ST1244.2 +048700 IF BREAKDOWN-LIMIT LESS THAN 61 GO TO BREAKDOWN-EXIT. ST1244.2 +048800 MOVE FOURTH-20-CM TO COMPUTED-A. ST1244.2 +048900 MOVE FOURTH-20-CR TO CORRECT-A. ST1244.2 +049000 MOVE "FOURTH TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +049100 PERFORM PRINT-DETAIL. ST1244.2 +049200 IF BREAKDOWN-LIMIT LESS THAN 81 GO TO BREAKDOWN-EXIT. ST1244.2 +049300 MOVE FIFTH-20-CM TO COMPUTED-A. ST1244.2 +049400 MOVE FIFTH-20-CR TO CORRECT-A. ST1244.2 +049500 MOVE "FIFTH TWENTY CHARACTERS" TO RE-MARK. ST1244.2 +049600 BREAKDOWN-EXIT. ST1244.2 +049700 EXIT. ST1244.2 +049800 READ-SORTIN. ST1244.2 +049900 READ SORTIN-1K AT END GO TO READ-ERROR. ST1244.2 +050000 ADD 1 TO UTIL-CTR. ST1244.2 +050100 READ-ERROR. ST1244.2 +050200 MOVE UTIL-CTR TO COMPUTED-N. ST1244.2 +050300 MOVE 40 TO CORRECT-N. ST1244.2 +050400 MOVE "TOO FEW INPUT RECORDS" TO RE-MARK. ST1244.2 +050500 MOVE "READ-SORTIN" TO PAR-NAME. ST1244.2 +050600 PERFORM FAIL. ST1244.2 +050700 PERFORM PRINT-DETAIL. ST1244.2 +050800 CCVS-EXIT SECTION. ST1244.2 +050900 CCVS-999999. ST1244.2 +051000 GO TO CLOSE-FILES. ST1244.2 diff --git a/tests/cobol85/ST/ST125A.CBL b/tests/cobol85/ST/ST125A.CBL new file mode 100755 index 00000000..2e09b54e --- /dev/null +++ b/tests/cobol85/ST/ST125A.CBL @@ -0,0 +1,434 @@ +000100 IDENTIFICATION DIVISION. ST1254.2 +000200 PROGRAM-ID. ST1254.2 +000300 ST125A. ST1254.2 +000400**************************************************************** ST1254.2 +000500* * ST1254.2 +000600* VALIDATION FOR:- * ST1254.2 +000700* * ST1254.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1254.2 +000900* * ST1254.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1254.2 +001100* * ST1254.2 +001200**************************************************************** ST1254.2 +001300* * ST1254.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1254.2 +001500* * ST1254.2 +001600* X-01 * ST1254.2 +001700* X-02 * ST1254.2 +001800* X-03 * ST1254.2 +001900* X-27 * ST1254.2 +002000* X-55 - SYSTEM PRINTER NAME. * ST1254.2 +002100* X-69 * ST1254.2 +002200* X-74 * ST1254.2 +002300* X-75 * ST1254.2 +002400* X-82 - SOURCE COMPUTER NAME. * ST1254.2 +002500* X-83 - OBJECT COMPUTER NAME. * ST1254.2 +002600* * ST1254.2 +002700**************************************************************** ST1254.2 +002800* ST1254.2 +002900* THIS PROGRAM TESTS THE FACILITY OF MULTIPLE FILES IN THE ST1254.2 +003000* "GIVING" PHRASE OF THE "SORT" STATEMENT. ST1254.2 +003100* THE CONTENT OF THE 3 OUTPUT FILES WILL BE VERIFIED IN ST1254.2 +003200* PROGRAM ST126A. ST1254.2 +003300* THIS PROGRAM BUILDS A FILE OF NINE RECORDS. EACH RECORD HAS ST1254.2 +003400* THREE KEYS, AND THE VALUES OF THE RECORDS ARE SHOWN BELOW- ST1254.2 +003500* S ST1254.2 +003600* O ST1254.2 +003700* R SORT ST1254.2 +003800* T SORT KEY ST1254.2 +003900* K KEY -2 ST1254.2 +004000* E -1 .. ST1254.2 +004100* Y .. . . ST1254.2 +004200* - . . . . ST1254.2 +004300* 3 . . . . ST1254.2 +004400* .. .. . ST1254.2 +004500* 11111112888888888888888888 ST1254.2 +004600* 11111112999999999999999999 ST1254.2 +004700* 11111112999999999999999999 ST1254.2 +004800* 00000001999999999999999999 ST1254.2 +004900* 000000001999999999999999999 ST1254.2 +005000* 000000001999999999999999999 ST1254.2 +005100* 000000001999999999999999999 ST1254.2 +005200* 000000001999999999999999999 ST1254.2 +005300* 000000001999999999999999999 ST1254.2 +005400* THERE IS AN ASSUMED DECIMAL POINT BETWEEN THE FIRST AND ST1254.2 +005500* SECOND COLUMNS OF SORTKEY-1. ST1254.2 +005600* ST1254.2 +005700 ENVIRONMENT DIVISION. ST1254.2 +005800 CONFIGURATION SECTION. ST1254.2 +005900 SOURCE-COMPUTER. ST1254.2 +006000 Linux. ST1254.2 +006100 OBJECT-COMPUTER. ST1254.2 +006200 Linux. ST1254.2 +006300 INPUT-OUTPUT SECTION. ST1254.2 +006400 FILE-CONTROL. ST1254.2 +006500 SELECT PRINT-FILE ASSIGN TO ST1254.2 +006600 "report.log". ST1254.2 +006700 SELECT SORTFILE-1F ASSIGN TO ST1254.2 +006800 "XXXXX027". ST1254.2 +006900 SELECT SORTOUT-1F ASSIGN TO ST1254.2 +007000 "XXXXX001". ST1254.2 +007100 SELECT SORTOUT-2F ASSIGN TO ST1254.2 +007200 "XXXXX002". ST1254.2 +007300 SELECT SORTOUT-3F ASSIGN TO ST1254.2 +007400 "XXXXX003". ST1254.2 +007500 DATA DIVISION. ST1254.2 +007600 FILE SECTION. ST1254.2 +007700 FD PRINT-FILE. ST1254.2 +007800 01 PRINT-REC PICTURE X(120). ST1254.2 +007900 01 DUMMY-RECORD PICTURE X(120). ST1254.2 +008000 FD SORTOUT-1F ST1254.2 +008100 LABEL RECORDS STANDARD ST1254.2 +008200*C VALUE OF ST1254.2 +008300*C OCLABELID ST1254.2 +008400*C IS ST1254.2 +008500*C "OCDUMMY" ST1254.2 +008600*G SYSIN ST1254.2 +008700 RECORD CONTAINS 27 CHARACTERS. ST1254.2 +008800 01 SORTOUT-REC-1. ST1254.2 +008900 02 FILLER PICTURE X(27). ST1254.2 +009000 FD SORTOUT-2F ST1254.2 +009100 LABEL RECORDS STANDARD ST1254.2 +009200*C VALUE OF ST1254.2 +009300*C OCLABELID ST1254.2 +009400*C IS ST1254.2 +009500*C "OCDUMMY" ST1254.2 +009600*G SYSIN ST1254.2 +009700 RECORD CONTAINS 27 CHARACTERS. ST1254.2 +009800 01 SORTOUT-REC-2. ST1254.2 +009900 02 FILLER PICTURE X(27). ST1254.2 +010000 FD SORTOUT-3F ST1254.2 +010100 LABEL RECORDS STANDARD ST1254.2 +010200*C VALUE OF ST1254.2 +010300*C OCLABELID ST1254.2 +010400*C IS ST1254.2 +010500*C "OCDUMMY" ST1254.2 +010600*G SYSIN ST1254.2 +010700 RECORD CONTAINS 27 CHARACTERS. ST1254.2 +010800 01 SORTOUT-REC-3. ST1254.2 +010900 02 FILLER PICTURE X(27). ST1254.2 +011000 SD SORTFILE-1F ST1254.2 +011100 RECORD CONTAINS 27 CHARACTERS. ST1254.2 +011200 01 SORT-GROUP. ST1254.2 +011300 02 SORTKEY-3 PICTURE X. ST1254.2 +011400 02 SORTKEY-1 PICTURE S9V9(7). ST1254.2 +011500 02 SORTKEY-2 PICTURE 9(18). ST1254.2 +011600 WORKING-STORAGE SECTION. ST1254.2 +011700 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1254.2 +011800 77 UTILITY-1 PICTURE S9V9(7) VALUE +1.1111112. ST1254.2 +011900 77 UTILITY-2 PICTURE 9(018) VALUE 888888888888888888. ST1254.2 +012000 77 UTILITY-3 PICTURE X VALUE SPACE. ST1254.2 +012100 01 TEST-RESULTS. ST1254.2 +012200 02 FILLER PIC X VALUE SPACE. ST1254.2 +012300 02 FEATURE PIC X(20) VALUE SPACE. ST1254.2 +012400 02 FILLER PIC X VALUE SPACE. ST1254.2 +012500 02 P-OR-F PIC X(5) VALUE SPACE. ST1254.2 +012600 02 FILLER PIC X VALUE SPACE. ST1254.2 +012700 02 PAR-NAME. ST1254.2 +012800 03 FILLER PIC X(19) VALUE SPACE. ST1254.2 +012900 03 PARDOT-X PIC X VALUE SPACE. ST1254.2 +013000 03 DOTVALUE PIC 99 VALUE ZERO. ST1254.2 +013100 02 FILLER PIC X(8) VALUE SPACE. ST1254.2 +013200 02 RE-MARK PIC X(61). ST1254.2 +013300 01 TEST-COMPUTED. ST1254.2 +013400 02 FILLER PIC X(30) VALUE SPACE. ST1254.2 +013500 02 FILLER PIC X(17) VALUE ST1254.2 +013600 " COMPUTED=". ST1254.2 +013700 02 COMPUTED-X. ST1254.2 +013800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1254.2 +013900 03 COMPUTED-N REDEFINES COMPUTED-A ST1254.2 +014000 PIC -9(9).9(9). ST1254.2 +014100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1254.2 +014200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1254.2 +014300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1254.2 +014400 03 CM-18V0 REDEFINES COMPUTED-A. ST1254.2 +014500 04 COMPUTED-18V0 PIC -9(18). ST1254.2 +014600 04 FILLER PIC X. ST1254.2 +014700 03 FILLER PIC X(50) VALUE SPACE. ST1254.2 +014800 01 TEST-CORRECT. ST1254.2 +014900 02 FILLER PIC X(30) VALUE SPACE. ST1254.2 +015000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1254.2 +015100 02 CORRECT-X. ST1254.2 +015200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1254.2 +015300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1254.2 +015400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1254.2 +015500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1254.2 +015600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1254.2 +015700 03 CR-18V0 REDEFINES CORRECT-A. ST1254.2 +015800 04 CORRECT-18V0 PIC -9(18). ST1254.2 +015900 04 FILLER PIC X. ST1254.2 +016000 03 FILLER PIC X(2) VALUE SPACE. ST1254.2 +016100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1254.2 +016200 01 CCVS-C-1. ST1254.2 +016300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1254.2 +016400- "SS PARAGRAPH-NAME ST1254.2 +016500- " REMARKS". ST1254.2 +016600 02 FILLER PIC X(20) VALUE SPACE. ST1254.2 +016700 01 CCVS-C-2. ST1254.2 +016800 02 FILLER PIC X VALUE SPACE. ST1254.2 +016900 02 FILLER PIC X(6) VALUE "TESTED". ST1254.2 +017000 02 FILLER PIC X(15) VALUE SPACE. ST1254.2 +017100 02 FILLER PIC X(4) VALUE "FAIL". ST1254.2 +017200 02 FILLER PIC X(94) VALUE SPACE. ST1254.2 +017300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1254.2 +017400 01 REC-CT PIC 99 VALUE ZERO. ST1254.2 +017500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1254.2 +017600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1254.2 +017700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1254.2 +017800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1254.2 +017900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1254.2 +018000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1254.2 +018100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1254.2 +018200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1254.2 +018300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1254.2 +018400 01 CCVS-H-1. ST1254.2 +018500 02 FILLER PIC X(39) VALUE SPACES. ST1254.2 +018600 02 FILLER PIC X(42) VALUE ST1254.2 +018700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1254.2 +018800 02 FILLER PIC X(39) VALUE SPACES. ST1254.2 +018900 01 CCVS-H-2A. ST1254.2 +019000 02 FILLER PIC X(40) VALUE SPACE. ST1254.2 +019100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1254.2 +019200 02 FILLER PIC XXXX VALUE ST1254.2 +019300 "4.2 ". ST1254.2 +019400 02 FILLER PIC X(28) VALUE ST1254.2 +019500 " COPY - NOT FOR DISTRIBUTION". ST1254.2 +019600 02 FILLER PIC X(41) VALUE SPACE. ST1254.2 +019700 ST1254.2 +019800 01 CCVS-H-2B. ST1254.2 +019900 02 FILLER PIC X(15) VALUE ST1254.2 +020000 "TEST RESULT OF ". ST1254.2 +020100 02 TEST-ID PIC X(9). ST1254.2 +020200 02 FILLER PIC X(4) VALUE ST1254.2 +020300 " IN ". ST1254.2 +020400 02 FILLER PIC X(12) VALUE ST1254.2 +020500 " HIGH ". ST1254.2 +020600 02 FILLER PIC X(22) VALUE ST1254.2 +020700 " LEVEL VALIDATION FOR ". ST1254.2 +020800 02 FILLER PIC X(58) VALUE ST1254.2 +020900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1254.2 +021000 01 CCVS-H-3. ST1254.2 +021100 02 FILLER PIC X(34) VALUE ST1254.2 +021200 " FOR OFFICIAL USE ONLY ". ST1254.2 +021300 02 FILLER PIC X(58) VALUE ST1254.2 +021400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1254.2 +021500 02 FILLER PIC X(28) VALUE ST1254.2 +021600 " COPYRIGHT 1985 ". ST1254.2 +021700 01 CCVS-E-1. ST1254.2 +021800 02 FILLER PIC X(52) VALUE SPACE. ST1254.2 +021900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1254.2 +022000 02 ID-AGAIN PIC X(9). ST1254.2 +022100 02 FILLER PIC X(45) VALUE SPACES. ST1254.2 +022200 01 CCVS-E-2. ST1254.2 +022300 02 FILLER PIC X(31) VALUE SPACE. ST1254.2 +022400 02 FILLER PIC X(21) VALUE SPACE. ST1254.2 +022500 02 CCVS-E-2-2. ST1254.2 +022600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1254.2 +022700 03 FILLER PIC X VALUE SPACE. ST1254.2 +022800 03 ENDER-DESC PIC X(44) VALUE ST1254.2 +022900 "ERRORS ENCOUNTERED". ST1254.2 +023000 01 CCVS-E-3. ST1254.2 +023100 02 FILLER PIC X(22) VALUE ST1254.2 +023200 " FOR OFFICIAL USE ONLY". ST1254.2 +023300 02 FILLER PIC X(12) VALUE SPACE. ST1254.2 +023400 02 FILLER PIC X(58) VALUE ST1254.2 +023500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1254.2 +023600 02 FILLER PIC X(13) VALUE SPACE. ST1254.2 +023700 02 FILLER PIC X(15) VALUE ST1254.2 +023800 " COPYRIGHT 1985". ST1254.2 +023900 01 CCVS-E-4. ST1254.2 +024000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1254.2 +024100 02 FILLER PIC X(4) VALUE " OF ". ST1254.2 +024200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1254.2 +024300 02 FILLER PIC X(40) VALUE ST1254.2 +024400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1254.2 +024500 01 XXINFO. ST1254.2 +024600 02 FILLER PIC X(19) VALUE ST1254.2 +024700 "*** INFORMATION ***". ST1254.2 +024800 02 INFO-TEXT. ST1254.2 +024900 04 FILLER PIC X(8) VALUE SPACE. ST1254.2 +025000 04 XXCOMPUTED PIC X(20). ST1254.2 +025100 04 FILLER PIC X(5) VALUE SPACE. ST1254.2 +025200 04 XXCORRECT PIC X(20). ST1254.2 +025300 02 INF-ANSI-REFERENCE PIC X(48). ST1254.2 +025400 01 HYPHEN-LINE. ST1254.2 +025500 02 FILLER PIC IS X VALUE IS SPACE. ST1254.2 +025600 02 FILLER PIC IS X(65) VALUE IS "************************ST1254.2 +025700- "*****************************************". ST1254.2 +025800 02 FILLER PIC IS X(54) VALUE IS "************************ST1254.2 +025900- "******************************". ST1254.2 +026000 01 CCVS-PGM-ID PIC X(9) VALUE ST1254.2 +026100 "ST125A". ST1254.2 +026200 PROCEDURE DIVISION. ST1254.2 +026300 SORTPARA SECTION. ST1254.2 +026400 SORT-PARAGRAPH. ST1254.2 +026500 SORT SORTFILE-1F ON ST1254.2 +026600 ASCENDING SORTKEY-1 ST1254.2 +026700 DESCENDING SORTKEY-2 ST1254.2 +026800 ASCENDING SORTKEY-3 ST1254.2 +026900 INPUT PROCEDURE INPROC THRU INPROC-EXIT ST1254.2 +027000 GIVING SORTOUT-1F ST1254.2 +027100 SORTOUT-2F ST1254.2 +027200 SORTOUT-3F. ST1254.2 +027300 STOP RUN. ST1254.2 +027400 INPROC SECTION. ST1254.2 +027500 OPEN-FILES. ST1254.2 +027600 OPEN OUTPUT PRINT-FILE. ST1254.2 +027700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1254.2 +027800 MOVE SPACE TO TEST-RESULTS. ST1254.2 +027900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1254.2 +028000 GO TO CCVS1-EXIT. ST1254.2 +028100 CLOSE-FILES. ST1254.2 +028200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1254.2 +028300 TERMINATE-CCVS. ST1254.2 +028400*S EXIT PROGRAM. ST1254.2 +028500*SERMINATE-CALL. ST1254.2 +028600 STOP RUN. ST1254.2 +028700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1254.2 +028800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1254.2 +028900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1254.2 +029000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1254.2 +029100 MOVE "****TEST DELETED****" TO RE-MARK. ST1254.2 +029200 PRINT-DETAIL. ST1254.2 +029300 IF REC-CT NOT EQUAL TO ZERO ST1254.2 +029400 MOVE "." TO PARDOT-X ST1254.2 +029500 MOVE REC-CT TO DOTVALUE. ST1254.2 +029600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1254.2 +029700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1254.2 +029800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1254.2 +029900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1254.2 +030000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1254.2 +030100 MOVE SPACE TO CORRECT-X. ST1254.2 +030200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1254.2 +030300 MOVE SPACE TO RE-MARK. ST1254.2 +030400 HEAD-ROUTINE. ST1254.2 +030500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +030600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +030700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1254.2 +030800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1254.2 +030900 COLUMN-NAMES-ROUTINE. ST1254.2 +031000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +031100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +031300 END-ROUTINE. ST1254.2 +031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1254.2 +031500 END-RTN-EXIT. ST1254.2 +031600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +031700 END-ROUTINE-1. ST1254.2 +031800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1254.2 +031900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1254.2 +032000 ADD PASS-COUNTER TO ERROR-HOLD. ST1254.2 +032100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1254.2 +032200 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1254.2 +032300 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1254.2 +032400 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1254.2 +032500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1254.2 +032600 END-ROUTINE-12. ST1254.2 +032700 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1254.2 +032800 IF ERROR-COUNTER IS EQUAL TO ZERO ST1254.2 +032900 MOVE "NO " TO ERROR-TOTAL ST1254.2 +033000 ELSE ST1254.2 +033100 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1254.2 +033200 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1254.2 +033300 PERFORM WRITE-LINE. ST1254.2 +033400 END-ROUTINE-13. ST1254.2 +033500 IF DELETE-COUNTER IS EQUAL TO ZERO ST1254.2 +033600 MOVE "NO " TO ERROR-TOTAL ELSE ST1254.2 +033700 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1254.2 +033800 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1254.2 +033900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +034000 IF INSPECT-COUNTER EQUAL TO ZERO ST1254.2 +034100 MOVE "NO " TO ERROR-TOTAL ST1254.2 +034200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1254.2 +034300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1254.2 +034400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +034500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1254.2 +034600 WRITE-LINE. ST1254.2 +034700 ADD 1 TO RECORD-COUNT. ST1254.2 +034800 IF RECORD-COUNT GREATER 42 ST1254.2 +034900 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1254.2 +035000 MOVE SPACE TO DUMMY-RECORD ST1254.2 +035100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1254.2 +035200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1254.2 +035300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1254.2 +035400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1254.2 +035500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1254.2 +035600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1254.2 +035700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1254.2 +035800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1254.2 +035900 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1254.2 +036000 MOVE ZERO TO RECORD-COUNT. ST1254.2 +036100 PERFORM WRT-LN. ST1254.2 +036200 WRT-LN. ST1254.2 +036300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1254.2 +036400 MOVE SPACE TO DUMMY-RECORD. ST1254.2 +036500 BLANK-LINE-PRINT. ST1254.2 +036600 PERFORM WRT-LN. ST1254.2 +036700 FAIL-ROUTINE. ST1254.2 +036800 IF COMPUTED-X NOT EQUAL TO SPACE ST1254.2 +036900 GO TO FAIL-ROUTINE-WRITE. ST1254.2 +037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1254.2 +037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1254.2 +037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1254.2 +037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +037400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1254.2 +037500 GO TO FAIL-ROUTINE-EX. ST1254.2 +037600 FAIL-ROUTINE-WRITE. ST1254.2 +037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1254.2 +037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1254.2 +037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1254.2 +038000 MOVE SPACES TO COR-ANSI-REFERENCE. ST1254.2 +038100 FAIL-ROUTINE-EX. EXIT. ST1254.2 +038200 BAIL-OUT. ST1254.2 +038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1254.2 +038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1254.2 +038500 BAIL-OUT-WRITE. ST1254.2 +038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1254.2 +038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1254.2 +038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1254.2 +038900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1254.2 +039000 BAIL-OUT-EX. EXIT. ST1254.2 +039100 CCVS1-EXIT. ST1254.2 +039200 EXIT. ST1254.2 +039300 ST125A-001-01. ST1254.2 +039400 MOVE "XI-20 4.4.4 GR(12)" TO ANSI-REFERENCE. ST1254.2 +039500 OPEN OUTPUT SORTOUT-1F. ST1254.2 +039600 OPEN OUTPUT SORTOUT-2F. ST1254.2 +039700 OPEN OUTPUT SORTOUT-3F. ST1254.2 +039800 MOVE "THIS PROGRAM BUILDS AND" TO RE-MARK. ST1254.2 +039900 PERFORM PRINT-DETAIL. ST1254.2 +040000 MOVE "SORTS 3 FILES AND PASSES" TO RE-MARK. ST1254.2 +040100 PERFORM PRINT-DETAIL. ST1254.2 +040200 MOVE "THE OUTPUT TO ST126A." TO RE-MARK. ST1254.2 +040300 PERFORM PRINT-DETAIL. ST1254.2 +040400 BUILD-FILE. ST1254.2 +040500 ADD 1 TO UTIL-CTR ST1254.2 +040600 IF UTIL-CTR EQUAL TO 2 ST1254.2 +040700 MOVE 999999999999999999 TO UTILITY-2. ST1254.2 +040800 IF UTIL-CTR EQUAL TO 4 ST1254.2 +040900 ADD -1.1111111 TO UTILITY-1. ST1254.2 +041000 IF UTIL-CTR EQUAL TO 5 ST1254.2 +041100 MOVE ZERO TO UTILITY-3. ST1254.2 +041200 MOVE UTILITY-1 TO SORTKEY-1. ST1254.2 +041300 MOVE UTILITY-3 TO SORTKEY-3. ST1254.2 +041400 MOVE UTILITY-2 TO SORTKEY-2. ST1254.2 +041500 RELEASE SORT-GROUP. ST1254.2 +041600 IF UTIL-CTR LESS THAN 9 GO TO BUILD-FILE. ST1254.2 +041700 BUILD-FILE-TEST. ST1254.2 +041800 IF UTIL-CTR EQUAL TO 9 ST1254.2 +041900 PERFORM PASS GO TO BUILD-FILE-WRITE. ST1254.2 +042000 BUILD-FILE-FAIL. ST1254.2 +042100 MOVE UTIL-CTR TO COMPUTED-N. ST1254.2 +042200 MOVE 9 TO CORRECT-N. ST1254.2 +042300 PERFORM FAIL. ST1254.2 +042400 BUILD-FILE-WRITE. ST1254.2 +042500 MOVE "CREATE A FILE" TO FEATURE. ST1254.2 +042600 MOVE "BUILD-FILE-TEST" TO PAR-NAME. ST1254.2 +042700 PERFORM PRINT-DETAIL. ST1254.2 +042800 CLOSE SORTOUT-1F. ST1254.2 +042900 CLOSE SORTOUT-2F. ST1254.2 +043000 CLOSE SORTOUT-3F. ST1254.2 +043100 ST1254.2 +043200 INPROC-EXIT SECTION. ST1254.2 +043300 EXITPARA. ST1254.2 +043400 PERFORM CLOSE-FILES. ST1254.2 diff --git a/tests/cobol85/ST/ST126A.SUB b/tests/cobol85/ST/ST126A.SUB new file mode 100755 index 00000000..fbf78f48 --- /dev/null +++ b/tests/cobol85/ST/ST126A.SUB @@ -0,0 +1,960 @@ +000100 IDENTIFICATION DIVISION. ST1264.2 +000200 PROGRAM-ID. ST1264.2 +000300 ST126A. ST1264.2 +000400**************************************************************** ST1264.2 +000500* * ST1264.2 +000600* VALIDATION FOR:- * ST1264.2 +000700* * ST1264.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1264.2 +000900* * ST1264.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1264.2 +001100* * ST1264.2 +001200**************************************************************** ST1264.2 +001300* * ST1264.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1264.2 +001500* * ST1264.2 +001600* X-01 * ST1264.2 +001700* X-55 - SYSTEM PRINTER NAME. * ST1264.2 +001800* X-69 * ST1264.2 +001900* X-74 * ST1264.2 +002000* X-75 * ST1264.2 +002100* X-82 - SOURCE COMPUTER NAME. * ST1264.2 +002200* X-83 - OBJECT COMPUTER NAME. * ST1264.2 +002300* * ST1264.2 +002400**************************************************************** ST1264.2 +002500* * ST1264.2 +002600* PROGRAM ST126A VERIFIES THE CONTENT OF THE THREE FILES * ST1264.2 +002700* PRODUCED BY ST125A. * ST1264.2 +002800* * ST1264.2 +002900**************************************************************** ST1264.2 +003000 ENVIRONMENT DIVISION. ST1264.2 +003100 CONFIGURATION SECTION. ST1264.2 +003200 SOURCE-COMPUTER. ST1264.2 +003300 Linux. ST1264.2 +003400 OBJECT-COMPUTER. ST1264.2 +003500 Linux. ST1264.2 +003600 INPUT-OUTPUT SECTION. ST1264.2 +003700 FILE-CONTROL. ST1264.2 +003800 SELECT PRINT-FILE ASSIGN TO ST1264.2 +003900 "report.log". ST1264.2 +004000 SELECT SORTIN-1G ASSIGN TO ST1264.2 +004100 "XXXXX001". ST1264.2 +004200 SELECT SORTIN-2G ASSIGN TO ST1264.2 +004300 "XXXXX002". ST1264.2 +004400 SELECT SORTIN-3G ASSIGN TO ST1264.2 +004500 "XXXXX003". ST1264.2 +004600 DATA DIVISION. ST1264.2 +004700 FILE SECTION. ST1264.2 +004800 FD PRINT-FILE. ST1264.2 +004900 01 PRINT-REC PICTURE X(120). ST1264.2 +005000 01 DUMMY-RECORD PICTURE X(120). ST1264.2 +005100 FD SORTIN-1G ST1264.2 +005200 LABEL RECORDS STANDARD ST1264.2 +005300*C VALUE OF ST1264.2 +005400*C OCLABELID ST1264.2 +005500*C IS ST1264.2 +005600*C "OCDUMMY" ST1264.2 +005700*G SYSIN ST1264.2 +005800 RECORD CONTAINS 27 CHARACTERS. ST1264.2 +005900 01 SORTIN-REC-1. ST1264.2 +006000 02 SORTKEY-3-1 PICTURE X. ST1264.2 +006100 02 SORTKEY-1-1 PICTURE S9V9(7). ST1264.2 +006200 02 SORTKEY-2-1 PICTURE 9(18). ST1264.2 +006300 FD SORTIN-2G ST1264.2 +006400 LABEL RECORDS STANDARD ST1264.2 +006500*C VALUE OF ST1264.2 +006600*C OCLABELID ST1264.2 +006700*C IS ST1264.2 +006800*C "OCDUMMY" ST1264.2 +006900*G SYSIN ST1264.2 +007000 RECORD CONTAINS 27 CHARACTERS. ST1264.2 +007100 01 SORTIN-REC-2. ST1264.2 +007200 02 SORTKEY-3-2 PICTURE X. ST1264.2 +007300 02 SORTKEY-1-2 PICTURE S9V9(7). ST1264.2 +007400 02 SORTKEY-2-2 PICTURE 9(18). ST1264.2 +007500 FD SORTIN-3G ST1264.2 +007600 LABEL RECORDS STANDARD ST1264.2 +007700*C VALUE OF ST1264.2 +007800*C OCLABELID ST1264.2 +007900*C IS ST1264.2 +008000*C "OCDUMMY" ST1264.2 +008100*G SYSIN ST1264.2 +008200 RECORD CONTAINS 27 CHARACTERS. ST1264.2 +008300 01 SORTIN-REC-3. ST1264.2 +008400 02 SORTKEY-3-3 PICTURE X. ST1264.2 +008500 02 SORTKEY-1-3 PICTURE S9V9(7). ST1264.2 +008600 02 SORTKEY-2-3 PICTURE 9(18). ST1264.2 +008700 WORKING-STORAGE SECTION. ST1264.2 +008800 77 UTIL-CTR PICTURE S99999 VALUE ZERO. ST1264.2 +008900 77 ITEM-3 PICTURE X(27) VALUE "FIRST OF 3 ITEMS IN RECORD ". ST1264.2 +009000 77 ITEM-1 PICTURE X(27) VALUE " SECOND OF 3 ITEMS ". ST1264.2 +009100 77 ITEM-2 PICTURE X(27) VALUE " THIRD OF 3 ITEMS ". ST1264.2 +009200 77 DUM-MY PICTURE X(27) VALUE "TEST UNNECESSARY - BYPASSED". ST1264.2 +009300 77 ZER-O PICTURE X VALUE "0". ST1264.2 +009400 77 SPAC-E PICTURE X VALUE " ". ST1264.2 +009500 01 UTILITY-KEYS. ST1264.2 +009600 02 UTILITY-3 PICTURE X. ST1264.2 +009700 02 UTILITY-1 PICTURE S9V9(7). ST1264.2 +009800 02 UTILITY-2 PICTURE 9(018). ST1264.2 +009900 01 TEST-RESULTS. ST1264.2 +010000 02 FILLER PIC X VALUE SPACE. ST1264.2 +010100 02 FEATURE PIC X(20) VALUE SPACE. ST1264.2 +010200 02 FILLER PIC X VALUE SPACE. ST1264.2 +010300 02 P-OR-F PIC X(5) VALUE SPACE. ST1264.2 +010400 02 FILLER PIC X VALUE SPACE. ST1264.2 +010500 02 PAR-NAME. ST1264.2 +010600 03 FILLER PIC X(19) VALUE SPACE. ST1264.2 +010700 03 PARDOT-X PIC X VALUE SPACE. ST1264.2 +010800 03 DOTVALUE PIC 99 VALUE ZERO. ST1264.2 +010900 02 FILLER PIC X(8) VALUE SPACE. ST1264.2 +011000 02 RE-MARK PIC X(61). ST1264.2 +011100 01 TEST-COMPUTED. ST1264.2 +011200 02 FILLER PIC X(30) VALUE SPACE. ST1264.2 +011300 02 FILLER PIC X(17) VALUE ST1264.2 +011400 " COMPUTED=". ST1264.2 +011500 02 COMPUTED-X. ST1264.2 +011600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1264.2 +011700 03 COMPUTED-N REDEFINES COMPUTED-A ST1264.2 +011800 PIC -9(9).9(9). ST1264.2 +011900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1264.2 +012000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1264.2 +012100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1264.2 +012200 03 CM-18V0 REDEFINES COMPUTED-A. ST1264.2 +012300 04 COMPUTED-18V0 PIC -9(18). ST1264.2 +012400 04 FILLER PIC X. ST1264.2 +012500 03 FILLER PIC X(50) VALUE SPACE. ST1264.2 +012600 01 TEST-CORRECT. ST1264.2 +012700 02 FILLER PIC X(30) VALUE SPACE. ST1264.2 +012800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1264.2 +012900 02 CORRECT-X. ST1264.2 +013000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1264.2 +013100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1264.2 +013200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1264.2 +013300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1264.2 +013400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1264.2 +013500 03 CR-18V0 REDEFINES CORRECT-A. ST1264.2 +013600 04 CORRECT-18V0 PIC -9(18). ST1264.2 +013700 04 FILLER PIC X. ST1264.2 +013800 03 FILLER PIC X(2) VALUE SPACE. ST1264.2 +013900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1264.2 +014000 01 CCVS-C-1. ST1264.2 +014100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1264.2 +014200- "SS PARAGRAPH-NAME ST1264.2 +014300- " REMARKS". ST1264.2 +014400 02 FILLER PIC X(20) VALUE SPACE. ST1264.2 +014500 01 CCVS-C-2. ST1264.2 +014600 02 FILLER PIC X VALUE SPACE. ST1264.2 +014700 02 FILLER PIC X(6) VALUE "TESTED". ST1264.2 +014800 02 FILLER PIC X(15) VALUE SPACE. ST1264.2 +014900 02 FILLER PIC X(4) VALUE "FAIL". ST1264.2 +015000 02 FILLER PIC X(94) VALUE SPACE. ST1264.2 +015100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1264.2 +015200 01 REC-CT PIC 99 VALUE ZERO. ST1264.2 +015300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1264.2 +015400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1264.2 +015500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1264.2 +015600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1264.2 +015700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1264.2 +015800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1264.2 +015900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1264.2 +016000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1264.2 +016100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1264.2 +016200 01 CCVS-H-1. ST1264.2 +016300 02 FILLER PIC X(39) VALUE SPACES. ST1264.2 +016400 02 FILLER PIC X(42) VALUE ST1264.2 +016500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1264.2 +016600 02 FILLER PIC X(39) VALUE SPACES. ST1264.2 +016700 01 CCVS-H-2A. ST1264.2 +016800 02 FILLER PIC X(40) VALUE SPACE. ST1264.2 +016900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1264.2 +017000 02 FILLER PIC XXXX VALUE ST1264.2 +017100 "4.2 ". ST1264.2 +017200 02 FILLER PIC X(28) VALUE ST1264.2 +017300 " COPY - NOT FOR DISTRIBUTION". ST1264.2 +017400 02 FILLER PIC X(41) VALUE SPACE. ST1264.2 +017500 ST1264.2 +017600 01 CCVS-H-2B. ST1264.2 +017700 02 FILLER PIC X(15) VALUE ST1264.2 +017800 "TEST RESULT OF ". ST1264.2 +017900 02 TEST-ID PIC X(9). ST1264.2 +018000 02 FILLER PIC X(4) VALUE ST1264.2 +018100 " IN ". ST1264.2 +018200 02 FILLER PIC X(12) VALUE ST1264.2 +018300 " HIGH ". ST1264.2 +018400 02 FILLER PIC X(22) VALUE ST1264.2 +018500 " LEVEL VALIDATION FOR ". ST1264.2 +018600 02 FILLER PIC X(58) VALUE ST1264.2 +018700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1264.2 +018800 01 CCVS-H-3. ST1264.2 +018900 02 FILLER PIC X(34) VALUE ST1264.2 +019000 " FOR OFFICIAL USE ONLY ". ST1264.2 +019100 02 FILLER PIC X(58) VALUE ST1264.2 +019200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1264.2 +019300 02 FILLER PIC X(28) VALUE ST1264.2 +019400 " COPYRIGHT 1985 ". ST1264.2 +019500 01 CCVS-E-1. ST1264.2 +019600 02 FILLER PIC X(52) VALUE SPACE. ST1264.2 +019700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1264.2 +019800 02 ID-AGAIN PIC X(9). ST1264.2 +019900 02 FILLER PIC X(45) VALUE SPACES. ST1264.2 +020000 01 CCVS-E-2. ST1264.2 +020100 02 FILLER PIC X(31) VALUE SPACE. ST1264.2 +020200 02 FILLER PIC X(21) VALUE SPACE. ST1264.2 +020300 02 CCVS-E-2-2. ST1264.2 +020400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1264.2 +020500 03 FILLER PIC X VALUE SPACE. ST1264.2 +020600 03 ENDER-DESC PIC X(44) VALUE ST1264.2 +020700 "ERRORS ENCOUNTERED". ST1264.2 +020800 01 CCVS-E-3. ST1264.2 +020900 02 FILLER PIC X(22) VALUE ST1264.2 +021000 " FOR OFFICIAL USE ONLY". ST1264.2 +021100 02 FILLER PIC X(12) VALUE SPACE. ST1264.2 +021200 02 FILLER PIC X(58) VALUE ST1264.2 +021300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1264.2 +021400 02 FILLER PIC X(13) VALUE SPACE. ST1264.2 +021500 02 FILLER PIC X(15) VALUE ST1264.2 +021600 " COPYRIGHT 1985". ST1264.2 +021700 01 CCVS-E-4. ST1264.2 +021800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1264.2 +021900 02 FILLER PIC X(4) VALUE " OF ". ST1264.2 +022000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1264.2 +022100 02 FILLER PIC X(40) VALUE ST1264.2 +022200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1264.2 +022300 01 XXINFO. ST1264.2 +022400 02 FILLER PIC X(19) VALUE ST1264.2 +022500 "*** INFORMATION ***". ST1264.2 +022600 02 INFO-TEXT. ST1264.2 +022700 04 FILLER PIC X(8) VALUE SPACE. ST1264.2 +022800 04 XXCOMPUTED PIC X(20). ST1264.2 +022900 04 FILLER PIC X(5) VALUE SPACE. ST1264.2 +023000 04 XXCORRECT PIC X(20). ST1264.2 +023100 02 INF-ANSI-REFERENCE PIC X(48). ST1264.2 +023200 01 HYPHEN-LINE. ST1264.2 +023300 02 FILLER PIC IS X VALUE IS SPACE. ST1264.2 +023400 02 FILLER PIC IS X(65) VALUE IS "************************ST1264.2 +023500- "*****************************************". ST1264.2 +023600 02 FILLER PIC IS X(54) VALUE IS "************************ST1264.2 +023700- "******************************". ST1264.2 +023800 01 CCVS-PGM-ID PIC X(9) VALUE ST1264.2 +023900 "ST126A". ST1264.2 +024000 PROCEDURE DIVISION. ST1264.2 +024100 CCVS1 SECTION. ST1264.2 +024200 OPEN-FILES. ST1264.2 +024300 OPEN OUTPUT PRINT-FILE. ST1264.2 +024400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1264.2 +024500 MOVE SPACE TO TEST-RESULTS. ST1264.2 +024600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1264.2 +024700 GO TO CCVS1-EXIT. ST1264.2 +024800 CLOSE-FILES. ST1264.2 +024900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1264.2 +025000 TERMINATE-CCVS. ST1264.2 +025100*S EXIT PROGRAM. ST1264.2 +025200*SERMINATE-CALL. ST1264.2 +025300 STOP RUN. ST1264.2 +025400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1264.2 +025500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1264.2 +025600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1264.2 +025700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1264.2 +025800 MOVE "****TEST DELETED****" TO RE-MARK. ST1264.2 +025900 PRINT-DETAIL. ST1264.2 +026000 IF REC-CT NOT EQUAL TO ZERO ST1264.2 +026100 MOVE "." TO PARDOT-X ST1264.2 +026200 MOVE REC-CT TO DOTVALUE. ST1264.2 +026300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1264.2 +026400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1264.2 +026500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1264.2 +026600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1264.2 +026700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1264.2 +026800 MOVE SPACE TO CORRECT-X. ST1264.2 +026900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1264.2 +027000 MOVE SPACE TO RE-MARK. ST1264.2 +027100 HEAD-ROUTINE. ST1264.2 +027200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +027300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +027400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1264.2 +027500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1264.2 +027600 COLUMN-NAMES-ROUTINE. ST1264.2 +027700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +027800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +027900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +028000 END-ROUTINE. ST1264.2 +028100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1264.2 +028200 END-RTN-EXIT. ST1264.2 +028300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +028400 END-ROUTINE-1. ST1264.2 +028500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1264.2 +028600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1264.2 +028700 ADD PASS-COUNTER TO ERROR-HOLD. ST1264.2 +028800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1264.2 +028900 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1264.2 +029000 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1264.2 +029100 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1264.2 +029200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1264.2 +029300 END-ROUTINE-12. ST1264.2 +029400 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1264.2 +029500 IF ERROR-COUNTER IS EQUAL TO ZERO ST1264.2 +029600 MOVE "NO " TO ERROR-TOTAL ST1264.2 +029700 ELSE ST1264.2 +029800 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1264.2 +029900 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1264.2 +030000 PERFORM WRITE-LINE. ST1264.2 +030100 END-ROUTINE-13. ST1264.2 +030200 IF DELETE-COUNTER IS EQUAL TO ZERO ST1264.2 +030300 MOVE "NO " TO ERROR-TOTAL ELSE ST1264.2 +030400 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1264.2 +030500 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1264.2 +030600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +030700 IF INSPECT-COUNTER EQUAL TO ZERO ST1264.2 +030800 MOVE "NO " TO ERROR-TOTAL ST1264.2 +030900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1264.2 +031000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1264.2 +031100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +031200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1264.2 +031300 WRITE-LINE. ST1264.2 +031400 ADD 1 TO RECORD-COUNT. ST1264.2 +031500 IF RECORD-COUNT GREATER 42 ST1264.2 +031600 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1264.2 +031700 MOVE SPACE TO DUMMY-RECORD ST1264.2 +031800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1264.2 +031900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1264.2 +032000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1264.2 +032100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1264.2 +032200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1264.2 +032300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1264.2 +032400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1264.2 +032500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1264.2 +032600 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1264.2 +032700 MOVE ZERO TO RECORD-COUNT. ST1264.2 +032800 PERFORM WRT-LN. ST1264.2 +032900 WRT-LN. ST1264.2 +033000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1264.2 +033100 MOVE SPACE TO DUMMY-RECORD. ST1264.2 +033200 BLANK-LINE-PRINT. ST1264.2 +033300 PERFORM WRT-LN. ST1264.2 +033400 FAIL-ROUTINE. ST1264.2 +033500 IF COMPUTED-X NOT EQUAL TO SPACE ST1264.2 +033600 GO TO FAIL-ROUTINE-WRITE. ST1264.2 +033700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1264.2 +033800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1264.2 +033900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1264.2 +034000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +034100 MOVE SPACES TO INF-ANSI-REFERENCE. ST1264.2 +034200 GO TO FAIL-ROUTINE-EX. ST1264.2 +034300 FAIL-ROUTINE-WRITE. ST1264.2 +034400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1264.2 +034500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1264.2 +034600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1264.2 +034700 MOVE SPACES TO COR-ANSI-REFERENCE. ST1264.2 +034800 FAIL-ROUTINE-EX. EXIT. ST1264.2 +034900 BAIL-OUT. ST1264.2 +035000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1264.2 +035100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1264.2 +035200 BAIL-OUT-WRITE. ST1264.2 +035300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1264.2 +035400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1264.2 +035500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1264.2 +035600 MOVE SPACES TO INF-ANSI-REFERENCE. ST1264.2 +035700 BAIL-OUT-EX. EXIT. ST1264.2 +035800 CCVS1-EXIT. ST1264.2 +035900 EXIT. ST1264.2 +036000 ST126A-001-01. ST1264.2 +036100 MOVE "XI-20 4.4.4 GR(12)" TO ANSI-REFERENCE. ST1264.2 +036200 OPEN INPUT SORTIN-1G. ST1264.2 +036300 OPEN INPUT SORTIN-2G. ST1264.2 +036400 OPEN INPUT SORTIN-3G. ST1264.2 +036500 MOVE "SORT, MIXED CLASSES" TO FEATURE. ST1264.2 +036600 IF ZER-O IS LESS THAN SPAC-E ST1264.2 +036700 GO TO ZERO-IS-LESS-THAN-SPACE. ST1264.2 +036800 SPACE-IS-LESS-THAN-ZERO SECTION. ST1264.2 +036900 SORT-INIT-A. ST1264.2 +037000 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +037100 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +037200 MOVE SPACE TO UTILITY-3. ST1264.2 +037300 SORT-TEST-1. ST1264.2 +037400 PERFORM READ-SORTIN. ST1264.2 +037500 MOVE "SORT-TEST-1" TO PAR-NAME. ST1264.2 +037600 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +037700 PERFORM PASS GO TO SORT-WRITE-1. ST1264.2 +037800 SORT-FAIL-1. ST1264.2 +037900 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +038000 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +038100 MOVE ITEM-3 TO RE-MARK. ST1264.2 +038200 PERFORM PRINT-DETAIL. ST1264.2 +038300 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +038400 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +038500 MOVE ITEM-1 TO RE-MARK. ST1264.2 +038600 PERFORM PRINT-DETAIL. ST1264.2 +038700 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +038800 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +038900 MOVE ITEM-2 TO RE-MARK. ST1264.2 +039000 PERFORM FAIL. ST1264.2 +039100 SORT-WRITE-1. ST1264.2 +039200 PERFORM PRINT-DETAIL. ST1264.2 +039300 SORT-INIT-B. ST1264.2 +039400 MOVE ZERO TO UTILITY-3. ST1264.2 +039500 PERFORM READ-SORTIN 4 TIMES. ST1264.2 +039600* NOTE SORT-TEST-2 CHECKS THE SIXTH RECORD IN THE FILE. ST1264.2 +039700 SORT-TEST-2. ST1264.2 +039800 PERFORM READ-SORTIN. ST1264.2 +039900 MOVE "SORT-TEST-2" TO PAR-NAME. ST1264.2 +040000 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +040100 PERFORM PASS GO TO SORT-WRITE-2. ST1264.2 +040200 SORT-FAIL-2. ST1264.2 +040300 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +040400 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +040500 MOVE ITEM-3 TO RE-MARK. ST1264.2 +040600 PERFORM PRINT-DETAIL. ST1264.2 +040700 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +040800 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +040900 MOVE ITEM-1 TO RE-MARK. ST1264.2 +041000 PERFORM PRINT-DETAIL. ST1264.2 +041100 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +041200 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +041300 MOVE ITEM-2 TO RE-MARK. ST1264.2 +041400 PERFORM FAIL. ST1264.2 +041500 SORT-WRITE-2. ST1264.2 +041600 PERFORM PRINT-DETAIL. ST1264.2 +041700 DUMMY-3-AND-4. ST1264.2 +041800 MOVE "SORT-TEST-3" TO PAR-NAME. ST1264.2 +041900 MOVE DUM-MY TO RE-MARK. ST1264.2 +042000 PERFORM PRINT-DETAIL. ST1264.2 +042100 MOVE "SORT-TEST-4" TO PAR-NAME. ST1264.2 +042200 MOVE DUM-MY TO RE-MARK. ST1264.2 +042300 PERFORM PRINT-DETAIL. ST1264.2 +042400 GO TO CONTINUE-TESTING. ST1264.2 +042500 ZERO-IS-LESS-THAN-SPACE SECTION. ST1264.2 +042600 SORT-INIT-C. ST1264.2 +042700 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +042800 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +042900 MOVE ZERO TO UTILITY-3. ST1264.2 +043000 DUMMY-1-AND-2. ST1264.2 +043100 MOVE "SORT-TEST-1" TO PAR-NAME. ST1264.2 +043200 MOVE DUM-MY TO RE-MARK. ST1264.2 +043300 PERFORM PRINT-DETAIL. ST1264.2 +043400 MOVE "SORT-TEST-2" TO PAR-NAME. ST1264.2 +043500 MOVE DUM-MY TO RE-MARK. ST1264.2 +043600 PERFORM PRINT-DETAIL. ST1264.2 +043700 SORT-TEST-3. ST1264.2 +043800 PERFORM READ-SORTIN. ST1264.2 +043900 MOVE "SORT-TEST-3" TO PAR-NAME. ST1264.2 +044000 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +044100 PERFORM PASS GO TO SORT-WRITE-3. ST1264.2 +044200 SORT-FAIL-3. ST1264.2 +044300 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +044400 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +044500 MOVE ITEM-3 TO RE-MARK. ST1264.2 +044600 PERFORM PRINT-DETAIL. ST1264.2 +044700 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +044800 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +044900 MOVE ITEM-1 TO RE-MARK. ST1264.2 +045000 PERFORM PRINT-DETAIL. ST1264.2 +045100 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +045200 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +045300 MOVE ITEM-2 TO RE-MARK. ST1264.2 +045400 PERFORM FAIL. ST1264.2 +045500 SORT-WRITE-3. ST1264.2 +045600 PERFORM PRINT-DETAIL. ST1264.2 +045700 SORT-INIT-D. ST1264.2 +045800 PERFORM READ-SORTIN 4 TIMES. ST1264.2 +045900 MOVE SPACE TO UTILITY-3. ST1264.2 +046000* NOTE SORT-TEST-4 CHECKS THE SIXTH RECORD IN THE FILE. ST1264.2 +046100 SORT-TEST-4. ST1264.2 +046200 PERFORM READ-SORTIN. ST1264.2 +046300 MOVE "SORT-TEST-4" TO PAR-NAME. ST1264.2 +046400 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +046500 PERFORM PASS GO TO SORT-WRITE-4. ST1264.2 +046600 SORT-FAIL-4. ST1264.2 +046700 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +046800 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +046900 MOVE ITEM-3 TO RE-MARK. ST1264.2 +047000 PERFORM PRINT-DETAIL. ST1264.2 +047100 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +047200 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +047300 MOVE ITEM-1 TO RE-MARK. ST1264.2 +047400 PERFORM PRINT-DETAIL. ST1264.2 +047500 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +047600 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +047700 MOVE ITEM-2 TO RE-MARK. ST1264.2 +047800 PERFORM FAIL. ST1264.2 +047900 SORT-WRITE-4. ST1264.2 +048000 PERFORM PRINT-DETAIL. ST1264.2 +048100 CONTINUE-TESTING SECTION. ST1264.2 +048200 SORT-INIT-E. ST1264.2 +048300 MOVE +1.1111112 TO UTILITY-1. ST1264.2 +048400 MOVE SPACE TO UTILITY-3. ST1264.2 +048500* NOTE SORT-TEST-5 CHECKS THE SEVENTH RECORD IN THE FILE. ST1264.2 +048600 SORT-TEST-5. ST1264.2 +048700 PERFORM READ-SORTIN. ST1264.2 +048800 MOVE "SORT-TEST-5" TO PAR-NAME. ST1264.2 +048900 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +049000 PERFORM PASS GO TO SORT-WRITE-5. ST1264.2 +049100 SORT-FAIL-5. ST1264.2 +049200 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +049300 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +049400 MOVE ITEM-3 TO RE-MARK. ST1264.2 +049500 PERFORM PRINT-DETAIL. ST1264.2 +049600 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +049700 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +049800 MOVE ITEM-1 TO RE-MARK. ST1264.2 +049900 PERFORM PRINT-DETAIL. ST1264.2 +050000 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +050100 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +050200 MOVE ITEM-2 TO RE-MARK. ST1264.2 +050300 PERFORM FAIL. ST1264.2 +050400 SORT-WRITE-5. ST1264.2 +050500 PERFORM PRINT-DETAIL. ST1264.2 +050600 SORT-INIT-F. ST1264.2 +050700 PERFORM READ-SORTIN. ST1264.2 +050800 MOVE 888888888888888888 TO UTILITY-2. ST1264.2 +050900* NOTE SORT-TEST-6 CHECKS THE NINTH RECORD IN THE FILE. ST1264.2 +051000 SORT-TEST-6. ST1264.2 +051100 PERFORM READ-SORTIN. ST1264.2 +051200 MOVE "SORT-TEST-6" TO PAR-NAME. ST1264.2 +051300 IF SORTIN-REC-1 EQUAL TO UTILITY-KEYS ST1264.2 +051400 PERFORM PASS GO TO SORT-WRITE-6. ST1264.2 +051500 SORT-FAIL-6. ST1264.2 +051600 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +051700 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +051800 MOVE ITEM-3 TO RE-MARK. ST1264.2 +051900 PERFORM PRINT-DETAIL. ST1264.2 +052000 MOVE SORTKEY-1-1 TO COMPUTED-4V14. ST1264.2 +052100 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +052200 MOVE ITEM-1 TO RE-MARK. ST1264.2 +052300 PERFORM PRINT-DETAIL. ST1264.2 +052400 MOVE SORTKEY-2-1 TO COMPUTED-18V0. ST1264.2 +052500 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +052600 MOVE ITEM-2 TO RE-MARK. ST1264.2 +052700 PERFORM FAIL. ST1264.2 +052800 SORT-WRITE-6. ST1264.2 +052900 PERFORM PRINT-DETAIL. ST1264.2 +053000 SORT-TEST-7. ST1264.2 +053100 READ SORTIN-1G AT END ST1264.2 +053200 PERFORM PASS GO TO SORT-WRITE-7. ST1264.2 +053300 SORT-FAIL-7. ST1264.2 +053400 MOVE SORTKEY-3-1 TO COMPUTED-A. ST1264.2 +053500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1264.2 +053600 PERFORM FAIL. ST1264.2 +053700 SORT-WRITE-7. ST1264.2 +053800 MOVE "SORT-TEST-7" TO PAR-NAME. ST1264.2 +053900 PERFORM PRINT-DETAIL. ST1264.2 +054000 SORT-TEST-8. ST1264.2 +054100 IF UTIL-CTR EQUAL TO 9 ST1264.2 +054200 PERFORM PASS GO TO SORT-WRITE-8. ST1264.2 +054300 SORT-FAIL-8. ST1264.2 +054400 MOVE UTIL-CTR TO COMPUTED-4V14. ST1264.2 +054500 MOVE 9 TO CORRECT-4V14. ST1264.2 +054600 PERFORM FAIL. ST1264.2 +054700 SORT-WRITE-8. ST1264.2 +054800 MOVE "SORT-TEST-8" TO PAR-NAME. ST1264.2 +054900 PERFORM PRINT-DETAIL. ST1264.2 +055000 CLOSE SORTIN-1G. ST1264.2 +055100 GO TO ST126A-001-02. ST1264.2 +055200 READ-SORTIN. ST1264.2 +055300 READ SORTIN-1G AT END GO TO READ-ERROR. ST1264.2 +055400 ADD 1 TO UTIL-CTR. ST1264.2 +055500 READ-ERROR. ST1264.2 +055600 MOVE "READ-ERROR" TO PAR-NAME. ST1264.2 +055700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1264.2 +055800 PERFORM FAIL. ST1264.2 +055900 PERFORM PRINT-DETAIL. ST1264.2 +056000* ST1264.2 +056100* ST1264.2 +056200 ST126A-001-02. ST1264.2 +056300 MOVE "SORT, MIXED CLASSES" TO FEATURE. ST1264.2 +056400 MOVE ZERO TO UTIL-CTR. ST1264.2 +056500 IF ZER-O IS LESS THAN SPAC-E ST1264.2 +056600 GO TO ZERO-IS-LESS-THAN-SPACE-2. ST1264.2 +056700 SPACE-IS-LESS-THAN-ZERO-2 SECTION. ST1264.2 +056800 SORT-INIT-A-2. ST1264.2 +056900 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +057000 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +057100 MOVE SPACE TO UTILITY-3. ST1264.2 +057200 SORT-TEST-1-2. ST1264.2 +057300 PERFORM READ-SORTIN-2. ST1264.2 +057400 MOVE "SORT-TEST-1-2" TO PAR-NAME. ST1264.2 +057500 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +057600 PERFORM PASS GO TO SORT-WRITE-1-2. ST1264.2 +057700 SORT-FAIL-1-2. ST1264.2 +057800 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +057900 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +058000 MOVE ITEM-3 TO RE-MARK. ST1264.2 +058100 PERFORM PRINT-DETAIL. ST1264.2 +058200 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +058300 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +058400 MOVE ITEM-1 TO RE-MARK. ST1264.2 +058500 PERFORM PRINT-DETAIL. ST1264.2 +058600 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +058700 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +058800 MOVE ITEM-2 TO RE-MARK. ST1264.2 +058900 PERFORM FAIL. ST1264.2 +059000 SORT-WRITE-1-2. ST1264.2 +059100 PERFORM PRINT-DETAIL. ST1264.2 +059200 SORT-INIT-B-2. ST1264.2 +059300 MOVE ZERO TO UTILITY-3. ST1264.2 +059400 PERFORM READ-SORTIN-2 4 TIMES. ST1264.2 +059500* NOTE SORT-TEST-2-2 CHECKS THE 6TH RECORD IN THE FILE. ST1264.2 +059600 SORT-TEST-2-2. ST1264.2 +059700 PERFORM READ-SORTIN-2. ST1264.2 +059800 MOVE "SORT-TEST-2-2" TO PAR-NAME. ST1264.2 +059900 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +060000 PERFORM PASS GO TO SORT-WRITE-2-2. ST1264.2 +060100 SORT-FAIL-2-2. ST1264.2 +060200 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +060300 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +060400 MOVE ITEM-3 TO RE-MARK. ST1264.2 +060500 PERFORM PRINT-DETAIL. ST1264.2 +060600 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +060700 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +060800 MOVE ITEM-1 TO RE-MARK. ST1264.2 +060900 PERFORM PRINT-DETAIL. ST1264.2 +061000 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +061100 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +061200 MOVE ITEM-2 TO RE-MARK. ST1264.2 +061300 PERFORM FAIL. ST1264.2 +061400 SORT-WRITE-2-2. ST1264.2 +061500 PERFORM PRINT-DETAIL. ST1264.2 +061600 DUMMY-3-AND-4-2. ST1264.2 +061700 MOVE "SORT-TEST-3-2" TO PAR-NAME. ST1264.2 +061800 MOVE DUM-MY TO RE-MARK. ST1264.2 +061900 PERFORM PRINT-DETAIL. ST1264.2 +062000 MOVE "SORT-TEST-4-2" TO PAR-NAME. ST1264.2 +062100 MOVE DUM-MY TO RE-MARK. ST1264.2 +062200 PERFORM PRINT-DETAIL. ST1264.2 +062300 GO TO CONTINUE-TESTING-2. ST1264.2 +062400 ZERO-IS-LESS-THAN-SPACE-2 SECTION. ST1264.2 +062500 SORT-INIT-C-2. ST1264.2 +062600 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +062700 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +062800 MOVE ZERO TO UTILITY-3. ST1264.2 +062900 DUMMY-1-AND-2-2. ST1264.2 +063000 MOVE "SORT-TEST-1-2" TO PAR-NAME. ST1264.2 +063100 MOVE DUM-MY TO RE-MARK. ST1264.2 +063200 PERFORM PRINT-DETAIL. ST1264.2 +063300 MOVE "SORT-TEST-2-2" TO PAR-NAME. ST1264.2 +063400 MOVE DUM-MY TO RE-MARK. ST1264.2 +063500 PERFORM PRINT-DETAIL. ST1264.2 +063600 SORT-TEST-3-2. ST1264.2 +063700 PERFORM READ-SORTIN-2. ST1264.2 +063800 MOVE "SORT-TEST-3-2" TO PAR-NAME. ST1264.2 +063900 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +064000 PERFORM PASS GO TO SORT-WRITE-3-2. ST1264.2 +064100 SORT-FAIL-3-2. ST1264.2 +064200 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +064300 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +064400 MOVE ITEM-3 TO RE-MARK. ST1264.2 +064500 PERFORM PRINT-DETAIL. ST1264.2 +064600 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +064700 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +064800 MOVE ITEM-1 TO RE-MARK. ST1264.2 +064900 PERFORM PRINT-DETAIL. ST1264.2 +065000 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +065100 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +065200 MOVE ITEM-2 TO RE-MARK. ST1264.2 +065300 PERFORM FAIL. ST1264.2 +065400 SORT-WRITE-3-2. ST1264.2 +065500 PERFORM PRINT-DETAIL. ST1264.2 +065600 SORT-INIT-D-2. ST1264.2 +065700 PERFORM READ-SORTIN-2 4 TIMES. ST1264.2 +065800 MOVE SPACE TO UTILITY-3. ST1264.2 +065900* NOTE SORT-TEST-4-2 CHECKS THE SIXTH RECORD IN THE FILE. ST1264.2 +066000 SORT-TEST-4-2. ST1264.2 +066100 PERFORM READ-SORTIN-2. ST1264.2 +066200 MOVE "SORT-TEST-4-2" TO PAR-NAME. ST1264.2 +066300 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +066400 PERFORM PASS GO TO SORT-WRITE-4-2. ST1264.2 +066500 SORT-FAIL-4-2. ST1264.2 +066600 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +066700 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +066800 MOVE ITEM-3 TO RE-MARK. ST1264.2 +066900 PERFORM PRINT-DETAIL. ST1264.2 +067000 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +067100 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +067200 MOVE ITEM-1 TO RE-MARK. ST1264.2 +067300 PERFORM PRINT-DETAIL. ST1264.2 +067400 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +067500 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +067600 MOVE ITEM-2 TO RE-MARK. ST1264.2 +067700 PERFORM FAIL. ST1264.2 +067800 SORT-WRITE-4-2. ST1264.2 +067900 PERFORM PRINT-DETAIL. ST1264.2 +068000 CONTINUE-TESTING-2 SECTION. ST1264.2 +068100 SORT-INIT-E-2. ST1264.2 +068200 MOVE +1.1111112 TO UTILITY-1. ST1264.2 +068300 MOVE SPACE TO UTILITY-3. ST1264.2 +068400* NOTE SORT-TEST-5-2 CHECKS THE 7TH RECORD IN THE FILE. ST1264.2 +068500 SORT-TEST-5-2. ST1264.2 +068600 PERFORM READ-SORTIN-2. ST1264.2 +068700 MOVE "SORT-TEST-5-2" TO PAR-NAME. ST1264.2 +068800 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +068900 PERFORM PASS GO TO SORT-WRITE-5-2. ST1264.2 +069000 SORT-FAIL-5-2. ST1264.2 +069100 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +069200 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +069300 MOVE ITEM-3 TO RE-MARK. ST1264.2 +069400 PERFORM PRINT-DETAIL. ST1264.2 +069500 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +069600 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +069700 MOVE ITEM-1 TO RE-MARK. ST1264.2 +069800 PERFORM PRINT-DETAIL. ST1264.2 +069900 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +070000 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +070100 MOVE ITEM-2 TO RE-MARK. ST1264.2 +070200 PERFORM FAIL. ST1264.2 +070300 SORT-WRITE-5-2. ST1264.2 +070400 PERFORM PRINT-DETAIL. ST1264.2 +070500 SORT-INIT-F-2. ST1264.2 +070600 PERFORM READ-SORTIN-2. ST1264.2 +070700 MOVE 888888888888888888 TO UTILITY-2. ST1264.2 +070800* NOTE SORT-TEST-6-2 CHECKS THE 9TH RECORD IN THE FILE. ST1264.2 +070900 SORT-TEST-6-2. ST1264.2 +071000 PERFORM READ-SORTIN-2. ST1264.2 +071100 MOVE "SORT-TEST-6-2" TO PAR-NAME. ST1264.2 +071200 IF SORTIN-REC-2 EQUAL TO UTILITY-KEYS ST1264.2 +071300 PERFORM PASS GO TO SORT-WRITE-6-2. ST1264.2 +071400 SORT-FAIL-6-2. ST1264.2 +071500 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +071600 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +071700 MOVE ITEM-3 TO RE-MARK. ST1264.2 +071800 PERFORM PRINT-DETAIL. ST1264.2 +071900 MOVE SORTKEY-1-2 TO COMPUTED-4V14. ST1264.2 +072000 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +072100 MOVE ITEM-1 TO RE-MARK. ST1264.2 +072200 PERFORM PRINT-DETAIL. ST1264.2 +072300 MOVE SORTKEY-2-2 TO COMPUTED-18V0. ST1264.2 +072400 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +072500 MOVE ITEM-2 TO RE-MARK. ST1264.2 +072600 PERFORM FAIL. ST1264.2 +072700 SORT-WRITE-6-2. ST1264.2 +072800 PERFORM PRINT-DETAIL. ST1264.2 +072900 SORT-TEST-7-2. ST1264.2 +073000 READ SORTIN-2G AT END ST1264.2 +073100 PERFORM PASS GO TO SORT-WRITE-7-2. ST1264.2 +073200 SORT-FAIL-7-2. ST1264.2 +073300 MOVE SORTKEY-3-2 TO COMPUTED-A. ST1264.2 +073400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1264.2 +073500 PERFORM FAIL. ST1264.2 +073600 SORT-WRITE-7-2. ST1264.2 +073700 MOVE "SORT-TEST-7-2" TO PAR-NAME. ST1264.2 +073800 PERFORM PRINT-DETAIL. ST1264.2 +073900 SORT-TEST-8-2. ST1264.2 +074000 IF UTIL-CTR EQUAL TO 9 ST1264.2 +074100 PERFORM PASS GO TO SORT-WRITE-8-2. ST1264.2 +074200 SORT-FAIL-8-2. ST1264.2 +074300 MOVE UTIL-CTR TO COMPUTED-4V14. ST1264.2 +074400 MOVE 9 TO CORRECT-4V14. ST1264.2 +074500 PERFORM FAIL. ST1264.2 +074600 SORT-WRITE-8-2. ST1264.2 +074700 MOVE "SORT-TEST-8-2" TO PAR-NAME. ST1264.2 +074800 PERFORM PRINT-DETAIL. ST1264.2 +074900 CLOSE SORTIN-2G. ST1264.2 +075000 GO TO ST126A-001-03. ST1264.2 +075100 READ-SORTIN-2. ST1264.2 +075200 READ SORTIN-2G AT END GO TO READ-ERROR-2. ST1264.2 +075300 ADD 1 TO UTIL-CTR. ST1264.2 +075400 READ-ERROR-2. ST1264.2 +075500 MOVE "READ-ERROR-2" TO PAR-NAME. ST1264.2 +075600 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1264.2 +075700 PERFORM FAIL. ST1264.2 +075800 PERFORM PRINT-DETAIL. ST1264.2 +075900* ST1264.2 +076000* ST1264.2 +076100 ST126A-001-03. ST1264.2 +076200 MOVE "SORT, MIXED CLASSES" TO FEATURE. ST1264.2 +076300 MOVE ZERO TO UTIL-CTR. ST1264.2 +076400 IF ZER-O IS LESS THAN SPAC-E ST1264.2 +076500 GO TO ZERO-IS-LESS-THAN-SPACE-3. ST1264.2 +076600 SPACE-IS-LESS-THAN-ZERO-3 SECTION. ST1264.2 +076700 SORT-INIT-A-3. ST1264.2 +076800 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +076900 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +077000 MOVE SPACE TO UTILITY-3. ST1264.2 +077100 SORT-TEST-1-3. ST1264.2 +077200 PERFORM READ-SORTIN-3. ST1264.2 +077300 MOVE "SORT-TEST-1-3" TO PAR-NAME. ST1264.2 +077400 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +077500 PERFORM PASS GO TO SORT-WRITE-1-3. ST1264.2 +077600 SORT-FAIL-1-3. ST1264.2 +077700 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +077800 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +077900 MOVE ITEM-3 TO RE-MARK. ST1264.2 +078000 PERFORM PRINT-DETAIL. ST1264.2 +078100 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +078200 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +078300 MOVE ITEM-1 TO RE-MARK. ST1264.2 +078400 PERFORM PRINT-DETAIL. ST1264.2 +078500 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +078600 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +078700 MOVE ITEM-2 TO RE-MARK. ST1264.2 +078800 PERFORM FAIL. ST1264.2 +078900 SORT-WRITE-1-3. ST1264.2 +079000 PERFORM PRINT-DETAIL. ST1264.2 +079100 SORT-INIT-B-3. ST1264.2 +079200 MOVE ZERO TO UTILITY-3. ST1264.2 +079300 PERFORM READ-SORTIN-3 4 TIMES. ST1264.2 +079400* NOTE SORT-TEST-2-3 CHECKS THE 6TH RECORD IN THE FILE. ST1264.2 +079500 SORT-TEST-2-3. ST1264.2 +079600 PERFORM READ-SORTIN-3. ST1264.2 +079700 MOVE "SORT-TEST-2-3" TO PAR-NAME. ST1264.2 +079800 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +079900 PERFORM PASS GO TO SORT-WRITE-2-3. ST1264.2 +080000 SORT-FAIL-2-3. ST1264.2 +080100 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +080200 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +080300 MOVE ITEM-3 TO RE-MARK. ST1264.2 +080400 PERFORM PRINT-DETAIL. ST1264.2 +080500 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +080600 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +080700 MOVE ITEM-1 TO RE-MARK. ST1264.2 +080800 PERFORM PRINT-DETAIL. ST1264.2 +080900 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +081000 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +081100 MOVE ITEM-2 TO RE-MARK. ST1264.2 +081200 PERFORM FAIL. ST1264.2 +081300 SORT-WRITE-2-3. ST1264.2 +081400 PERFORM PRINT-DETAIL. ST1264.2 +081500 DUMMY-3-AND-4-3. ST1264.2 +081600 MOVE "SORT-TEST-3-3" TO PAR-NAME. ST1264.2 +081700 MOVE DUM-MY TO RE-MARK. ST1264.2 +081800 PERFORM PRINT-DETAIL. ST1264.2 +081900 MOVE "SORT-TEST-4-3" TO PAR-NAME. ST1264.2 +082000 MOVE DUM-MY TO RE-MARK. ST1264.2 +082100 PERFORM PRINT-DETAIL. ST1264.2 +082200 GO TO CONTINUE-TESTING-3. ST1264.2 +082300 ZERO-IS-LESS-THAN-SPACE-3 SECTION. ST1264.2 +082400 SORT-INIT-C-3. ST1264.2 +082500 MOVE +0.0000001 TO UTILITY-1. ST1264.2 +082600 MOVE 999999999999999999 TO UTILITY-2. ST1264.2 +082700 MOVE ZERO TO UTILITY-3. ST1264.2 +082800 DUMMY-1-AND-2-3. ST1264.2 +082900 MOVE "SORT-TEST-1-3" TO PAR-NAME. ST1264.2 +083000 MOVE DUM-MY TO RE-MARK. ST1264.2 +083100 PERFORM PRINT-DETAIL. ST1264.2 +083200 MOVE "SORT-TEST-2-3" TO PAR-NAME. ST1264.2 +083300 MOVE DUM-MY TO RE-MARK. ST1264.2 +083400 PERFORM PRINT-DETAIL. ST1264.2 +083500 SORT-TEST-3-3. ST1264.2 +083600 PERFORM READ-SORTIN-3. ST1264.2 +083700 MOVE "SORT-TEST-3-3" TO PAR-NAME. ST1264.2 +083800 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +083900 PERFORM PASS GO TO SORT-WRITE-3-3. ST1264.2 +084000 SORT-FAIL-3-3. ST1264.2 +084100 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +084200 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +084300 MOVE ITEM-3 TO RE-MARK. ST1264.2 +084400 PERFORM PRINT-DETAIL. ST1264.2 +084500 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +084600 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +084700 MOVE ITEM-1 TO RE-MARK. ST1264.2 +084800 PERFORM PRINT-DETAIL. ST1264.2 +084900 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +085000 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +085100 MOVE ITEM-2 TO RE-MARK. ST1264.2 +085200 PERFORM FAIL. ST1264.2 +085300 SORT-WRITE-3-3. ST1264.2 +085400 PERFORM PRINT-DETAIL. ST1264.2 +085500 SORT-INIT-D-3. ST1264.2 +085600 PERFORM READ-SORTIN-3 4 TIMES. ST1264.2 +085700 MOVE SPACE TO UTILITY-3. ST1264.2 +085800* NOTE SORT-TEST-4-3 CHECKS THE SIXTH RECORD IN THE FILE. ST1264.2 +085900 SORT-TEST-4-3. ST1264.2 +086000 PERFORM READ-SORTIN-3. ST1264.2 +086100 MOVE "SORT-TEST-4-3" TO PAR-NAME. ST1264.2 +086200 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +086300 PERFORM PASS GO TO SORT-WRITE-4-3. ST1264.2 +086400 SORT-FAIL-4-3. ST1264.2 +086500 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +086600 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +086700 MOVE ITEM-3 TO RE-MARK. ST1264.2 +086800 PERFORM PRINT-DETAIL. ST1264.2 +086900 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +087000 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +087100 MOVE ITEM-1 TO RE-MARK. ST1264.2 +087200 PERFORM PRINT-DETAIL. ST1264.2 +087300 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +087400 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +087500 MOVE ITEM-2 TO RE-MARK. ST1264.2 +087600 PERFORM FAIL. ST1264.2 +087700 SORT-WRITE-4-3. ST1264.2 +087800 PERFORM PRINT-DETAIL. ST1264.2 +087900 CONTINUE-TESTING-3 SECTION. ST1264.2 +088000 SORT-INIT-E-3. ST1264.2 +088100 MOVE +1.1111112 TO UTILITY-1. ST1264.2 +088200 MOVE SPACE TO UTILITY-3. ST1264.2 +088300* NOTE SORT-TEST-5-3 CHECKS THE 7TH RECORD IN THE FILE. ST1264.2 +088400 SORT-TEST-5-3. ST1264.2 +088500 PERFORM READ-SORTIN-3. ST1264.2 +088600 MOVE "SORT-TEST-5-3" TO PAR-NAME. ST1264.2 +088700 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +088800 PERFORM PASS GO TO SORT-WRITE-5-3. ST1264.2 +088900 SORT-FAIL-5-3. ST1264.2 +089000 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +089100 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +089200 MOVE ITEM-3 TO RE-MARK. ST1264.2 +089300 PERFORM PRINT-DETAIL. ST1264.2 +089400 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +089500 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +089600 MOVE ITEM-1 TO RE-MARK. ST1264.2 +089700 PERFORM PRINT-DETAIL. ST1264.2 +089800 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +089900 MOVE UTILITY-2 TO CORRECT-18V0. ST1264.2 +090000 MOVE ITEM-2 TO RE-MARK. ST1264.2 +090100 PERFORM FAIL. ST1264.2 +090200 SORT-WRITE-5-3. ST1264.2 +090300 PERFORM PRINT-DETAIL. ST1264.2 +090400 SORT-INIT-F-3. ST1264.2 +090500 PERFORM READ-SORTIN-3. ST1264.2 +090600 MOVE 888888888888888888 TO UTILITY-2. ST1264.2 +090700* NOTE SORT-TEST-6-3 CHECKS THE 9TH RECORD IN THE FILE. ST1264.2 +090800 SORT-TEST-6-3. ST1264.2 +090900 PERFORM READ-SORTIN-3. ST1264.2 +091000 MOVE "SORT-TEST-6-3" TO PAR-NAME. ST1264.2 +091100 IF SORTIN-REC-3 EQUAL TO UTILITY-KEYS ST1264.2 +091200 PERFORM PASS GO TO SORT-WRITE-6-3. ST1264.2 +091300 SORT-FAIL-6-3. ST1264.2 +091400 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +091500 MOVE UTILITY-3 TO CORRECT-A. ST1264.2 +091600 MOVE ITEM-3 TO RE-MARK. ST1264.2 +091700 PERFORM PRINT-DETAIL. ST1264.2 +091800 MOVE SORTKEY-1-3 TO COMPUTED-4V14. ST1264.2 +091900 MOVE UTILITY-1 TO CORRECT-4V14. ST1264.2 +092000 MOVE ITEM-1 TO RE-MARK. ST1264.2 +092100 PERFORM PRINT-DETAIL. ST1264.2 +092200 MOVE SORTKEY-2-3 TO COMPUTED-18V0. ST1264.2 +092300 MOVE UTILITY-3 TO CORRECT-18V0. ST1264.2 +092400 MOVE ITEM-2 TO RE-MARK. ST1264.2 +092500 PERFORM FAIL. ST1264.2 +092600 SORT-WRITE-6-3. ST1264.2 +092700 PERFORM PRINT-DETAIL. ST1264.2 +092800 SORT-TEST-7-3. ST1264.2 +092900 READ SORTIN-3G AT END ST1264.2 +093000 PERFORM PASS GO TO SORT-WRITE-7-3. ST1264.2 +093100 SORT-FAIL-7-3. ST1264.2 +093200 MOVE SORTKEY-3-3 TO COMPUTED-A. ST1264.2 +093300 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1264.2 +093400 PERFORM FAIL. ST1264.2 +093500 SORT-WRITE-7-3. ST1264.2 +093600 MOVE "SORT-TEST-7-3" TO PAR-NAME. ST1264.2 +093700 PERFORM PRINT-DETAIL. ST1264.2 +093800 SORT-TEST-8-3. ST1264.2 +093900 IF UTIL-CTR EQUAL TO 9 ST1264.2 +094000 PERFORM PASS GO TO SORT-WRITE-8-3. ST1264.2 +094100 SORT-FAIL-8-3. ST1264.2 +094200 MOVE UTIL-CTR TO COMPUTED-4V14. ST1264.2 +094300 MOVE 9 TO CORRECT-4V14. ST1264.2 +094400 PERFORM FAIL. ST1264.2 +094500 SORT-WRITE-8-3. ST1264.2 +094600 MOVE "SORT-TEST-8-3" TO PAR-NAME. ST1264.2 +094700 PERFORM PRINT-DETAIL. ST1264.2 +094800 CLOSE SORTIN-3G. ST1264.2 +094900 GO TO CCVS-EXIT. ST1264.2 +095000 READ-SORTIN-3. ST1264.2 +095100 READ SORTIN-3G AT END GO TO READ-ERROR-3. ST1264.2 +095200 ADD 1 TO UTIL-CTR. ST1264.2 +095300 READ-ERROR-3. ST1264.2 +095400 MOVE "READ-ERROR-3" TO PAR-NAME. ST1264.2 +095500 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1264.2 +095600 PERFORM FAIL. ST1264.2 +095700 PERFORM PRINT-DETAIL. ST1264.2 +095800 CCVS-EXIT SECTION. ST1264.2 +095900 CCVS-999999. ST1264.2 +096000 GO TO CLOSE-FILES. ST1264.2 diff --git a/tests/cobol85/ST/ST127A.CBL b/tests/cobol85/ST/ST127A.CBL new file mode 100755 index 00000000..a8c92d25 --- /dev/null +++ b/tests/cobol85/ST/ST127A.CBL @@ -0,0 +1,1001 @@ +000100 IDENTIFICATION DIVISION. ST1274.2 +000200 PROGRAM-ID. ST1274.2 +000300 ST127A. ST1274.2 +000400**************************************************************** ST1274.2 +000500* * ST1274.2 +000600* VALIDATION FOR:- * ST1274.2 +000700* * ST1274.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1274.2 +000900* * ST1274.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1274.2 +001100* * ST1274.2 +001200**************************************************************** ST1274.2 +001300* * ST1274.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1274.2 +001500* * ST1274.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1274.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1274.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1274.2 +001900* X-27 - SORT-FILE-NAME-1 * ST1274.2 +002000* * ST1274.2 +002100**************************************************************** ST1274.2 +002200* ST127A IS A COMPLETELY SELF-CONTAINED PROGRAM. THE INPUT ST1274.2 +002300* PROCEDURE BUILDS THE 17-RECORD FILE SHOWN BELOW. THE ST1274.2 +002400* OUTPUT PROCEDURE CHECKS THE SORTED FILE AND GENERATES THE ST1274.2 +002500* REPORT. ST1274.2 +002600* SORT SORT SORT SORT SORT SORT SORT SORT LAST ST1274.2 +002700* KEY-1 KEY-2 KEY-3 KEY-4 KEY-5 KEY-6 KEY-7 KEY-8 CHAR ST1274.2 +002800* S9(6) A(5) SV9(16) X(10) A(20) X(10) 999 S99 PIC XST1274.2 +002900* USAGE JUST JUST USAGE ST1274.2 +003000* COMP RIGHT RIGHT COMP ST1274.2 +003100* ST1274.2 +003200* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 1 ST1274.2 +003300* +123456 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 ST1274.2 +003400* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 2 ST1274.2 +003500* -054321 X -.1234 BBBBBB A AAAAAAAA 501 +99 ST1274.2 +003600* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 3 ST1274.2 +003700* -054321 BBB +.6 BBBBBB A AAAAAAAA 501 +99 ST1274.2 +003800* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 4 ST1274.2 +003900* -054321 BBB -.1234 X A AAAAAAAA 501 +99 ST1274.2 +004000* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 5 ST1274.2 +004100* -054321 BBB -.1234 BBBBBB Z AAAAAAAA 501 +99 ST1274.2 +004200* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 6 ST1274.2 +004300* -054321 BBB -.1234 BBBBBB A Z 501 +99 ST1274.2 +004400* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 7 ST1274.2 +004500* -054321 BBB -.1234 BBBBBB A AAAAAAAA 418 +99 ST1274.2 +004600* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 8 ST1274.2 +004700* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 -14 ST1274.2 +004800* -054321 BBB -.1234 BBBBBB A AAAAAAAA 501 +99 9 ST1274.2 +004900* ST1274.2 +005000* THIS PROGRAM TESTS THE USE OF THE "DUPLICATES" PHRASE OF ST1274.2 +005100* THE "SORT" STATEMENT. THE ORDER OF RECORDS HAVING ST1274.2 +005200* DUPLICATE KEYS AFTER THE EXECUTION OF A "SORT" STATEMENT ST1274.2 +005300* MUST BE THE SAME AS THE ORDER OF THOSE RECORDS ON INPUT ST1274.2 +005400* TO THE "SORT" STATEMENT. ST1274.2 +005500 ST1274.2 +005600 ENVIRONMENT DIVISION. ST1274.2 +005700 CONFIGURATION SECTION. ST1274.2 +005800 SOURCE-COMPUTER. ST1274.2 +005900 Linux. ST1274.2 +006000 OBJECT-COMPUTER. ST1274.2 +006100 Linux. ST1274.2 +006200 INPUT-OUTPUT SECTION. ST1274.2 +006300 FILE-CONTROL. ST1274.2 +006400 SELECT PRINT-FILE ASSIGN TO ST1274.2 +006500 "report.log". ST1274.2 +006600 SELECT SORTFILE-1H ASSIGN TO ST1274.2 +006700 "XXXXX027". ST1274.2 +006800 DATA DIVISION. ST1274.2 +006900 FILE SECTION. ST1274.2 +007000 FD PRINT-FILE. ST1274.2 +007100 01 PRINT-REC PICTURE X(120). ST1274.2 +007200 01 DUMMY-RECORD PICTURE X(120). ST1274.2 +007300 SD SORTFILE-1H ST1274.2 +007400 DATA RECORD IS SORTFILE-REC. ST1274.2 +007500 01 SORTFILE-REC. ST1274.2 +007600 05 SORT-1. ST1274.2 +007700 10 SORTKEY-8 PICTURE S99 COMPUTATIONAL. ST1274.2 +007800 10 SORTKEY-1 PICTURE S9(6) COMPUTATIONAL. ST1274.2 +007900 10 SORTKEY-7 PICTURE 999. ST1274.2 +008000 10 SORTKEY-3 PICTURE SV9(16). ST1274.2 +008100 10 FILLER PICTURE XX. ST1274.2 +008200 10 SORTKEY-4 PICTURE X(10) JUSTIFIED RIGHT. ST1274.2 +008300 10 SORTKEY-6 PICTURE X(10). ST1274.2 +008400 10 SORTKEY-2 PICTURE A(05) JUSTIFIED RIGHT. ST1274.2 +008500 10 SORTKEY-5 PICTURE A(20). ST1274.2 +008600 10 FILLER PICTURE XXX. ST1274.2 +008700 05 SORT-IDENTIFIER PICTURE X. ST1274.2 +008800 WORKING-STORAGE SECTION. ST1274.2 +008900 77 WS-IDENTIFIER PIC 9. ST1274.2 +009000 01 WS-SORTFILE-REC. ST1274.2 +009100 02 WS-8 PICTURE S99 COMPUTATIONAL. ST1274.2 +009200 02 WS-1 PICTURE S9(6) COMPUTATIONAL. ST1274.2 +009300 02 WS-7 PICTURE 999. ST1274.2 +009400 02 WS-3 PICTURE SV9(16). ST1274.2 +009500 02 FILLER PICTURE XX. ST1274.2 +009600 02 WS-4 PICTURE X(10) JUSTIFIED RIGHT. ST1274.2 +009700 02 WS-6 PICTURE X(10). ST1274.2 +009800 02 WS-2 PICTURE A(05) JUSTIFIED RIGHT. ST1274.2 +009900 02 WS-5 PICTURE A(20). ST1274.2 +010000 02 FILLER PICTURE XXX. ST1274.2 +010100 77 UTIL-CTR PICTURE S99999. ST1274.2 +010200 77 SPAC-E PICTURE X VALUE " ". ST1274.2 +010300 01 TEST-RESULTS. ST1274.2 +010400 02 FILLER PIC X VALUE SPACE. ST1274.2 +010500 02 FEATURE PIC X(20) VALUE SPACE. ST1274.2 +010600 02 FILLER PIC X VALUE SPACE. ST1274.2 +010700 02 P-OR-F PIC X(5) VALUE SPACE. ST1274.2 +010800 02 FILLER PIC X VALUE SPACE. ST1274.2 +010900 02 PAR-NAME. ST1274.2 +011000 03 FILLER PIC X(19) VALUE SPACE. ST1274.2 +011100 03 PARDOT-X PIC X VALUE SPACE. ST1274.2 +011200 03 DOTVALUE PIC 99 VALUE ZERO. ST1274.2 +011300 02 FILLER PIC X(8) VALUE SPACE. ST1274.2 +011400 02 RE-MARK PIC X(61). ST1274.2 +011500 01 TEST-COMPUTED. ST1274.2 +011600 02 FILLER PIC X(30) VALUE SPACE. ST1274.2 +011700 02 FILLER PIC X(17) VALUE ST1274.2 +011800 " COMPUTED=". ST1274.2 +011900 02 COMPUTED-X. ST1274.2 +012000 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1274.2 +012100 03 COMPUTED-N REDEFINES COMPUTED-A ST1274.2 +012200 PIC -9(9).9(9). ST1274.2 +012300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1274.2 +012400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1274.2 +012500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1274.2 +012600 03 CM-18V0 REDEFINES COMPUTED-A. ST1274.2 +012700 04 COMPUTED-18V0 PIC -9(18). ST1274.2 +012800 04 FILLER PIC X. ST1274.2 +012900 03 FILLER PIC X(50) VALUE SPACE. ST1274.2 +013000 01 TEST-CORRECT. ST1274.2 +013100 02 FILLER PIC X(30) VALUE SPACE. ST1274.2 +013200 02 FILLER PIC X(17) VALUE " CORRECT =". ST1274.2 +013300 02 CORRECT-X. ST1274.2 +013400 03 CORRECT-A PIC X(20) VALUE SPACE. ST1274.2 +013500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1274.2 +013600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1274.2 +013700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1274.2 +013800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1274.2 +013900 03 CR-18V0 REDEFINES CORRECT-A. ST1274.2 +014000 04 CORRECT-18V0 PIC -9(18). ST1274.2 +014100 04 FILLER PIC X. ST1274.2 +014200 03 FILLER PIC X(2) VALUE SPACE. ST1274.2 +014300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1274.2 +014400 01 CCVS-C-1. ST1274.2 +014500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1274.2 +014600- "SS PARAGRAPH-NAME ST1274.2 +014700- " REMARKS". ST1274.2 +014800 02 FILLER PIC X(20) VALUE SPACE. ST1274.2 +014900 01 CCVS-C-2. ST1274.2 +015000 02 FILLER PIC X VALUE SPACE. ST1274.2 +015100 02 FILLER PIC X(6) VALUE "TESTED". ST1274.2 +015200 02 FILLER PIC X(15) VALUE SPACE. ST1274.2 +015300 02 FILLER PIC X(4) VALUE "FAIL". ST1274.2 +015400 02 FILLER PIC X(94) VALUE SPACE. ST1274.2 +015500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1274.2 +015600 01 REC-CT PIC 99 VALUE ZERO. ST1274.2 +015700 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1274.2 +015800 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1274.2 +015900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1274.2 +016000 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1274.2 +016100 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1274.2 +016200 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1274.2 +016300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1274.2 +016400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1274.2 +016500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1274.2 +016600 01 CCVS-H-1. ST1274.2 +016700 02 FILLER PIC X(39) VALUE SPACES. ST1274.2 +016800 02 FILLER PIC X(42) VALUE ST1274.2 +016900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1274.2 +017000 02 FILLER PIC X(39) VALUE SPACES. ST1274.2 +017100 01 CCVS-H-2A. ST1274.2 +017200 02 FILLER PIC X(40) VALUE SPACE. ST1274.2 +017300 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1274.2 +017400 02 FILLER PIC XXXX VALUE ST1274.2 +017500 "4.2 ". ST1274.2 +017600 02 FILLER PIC X(28) VALUE ST1274.2 +017700 " COPY - NOT FOR DISTRIBUTION". ST1274.2 +017800 02 FILLER PIC X(41) VALUE SPACE. ST1274.2 +017900 ST1274.2 +018000 01 CCVS-H-2B. ST1274.2 +018100 02 FILLER PIC X(15) VALUE ST1274.2 +018200 "TEST RESULT OF ". ST1274.2 +018300 02 TEST-ID PIC X(9). ST1274.2 +018400 02 FILLER PIC X(4) VALUE ST1274.2 +018500 " IN ". ST1274.2 +018600 02 FILLER PIC X(12) VALUE ST1274.2 +018700 " HIGH ". ST1274.2 +018800 02 FILLER PIC X(22) VALUE ST1274.2 +018900 " LEVEL VALIDATION FOR ". ST1274.2 +019000 02 FILLER PIC X(58) VALUE ST1274.2 +019100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1274.2 +019200 01 CCVS-H-3. ST1274.2 +019300 02 FILLER PIC X(34) VALUE ST1274.2 +019400 " FOR OFFICIAL USE ONLY ". ST1274.2 +019500 02 FILLER PIC X(58) VALUE ST1274.2 +019600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1274.2 +019700 02 FILLER PIC X(28) VALUE ST1274.2 +019800 " COPYRIGHT 1985 ". ST1274.2 +019900 01 CCVS-E-1. ST1274.2 +020000 02 FILLER PIC X(52) VALUE SPACE. ST1274.2 +020100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1274.2 +020200 02 ID-AGAIN PIC X(9). ST1274.2 +020300 02 FILLER PIC X(45) VALUE SPACES. ST1274.2 +020400 01 CCVS-E-2. ST1274.2 +020500 02 FILLER PIC X(31) VALUE SPACE. ST1274.2 +020600 02 FILLER PIC X(21) VALUE SPACE. ST1274.2 +020700 02 CCVS-E-2-2. ST1274.2 +020800 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1274.2 +020900 03 FILLER PIC X VALUE SPACE. ST1274.2 +021000 03 ENDER-DESC PIC X(44) VALUE ST1274.2 +021100 "ERRORS ENCOUNTERED". ST1274.2 +021200 01 CCVS-E-3. ST1274.2 +021300 02 FILLER PIC X(22) VALUE ST1274.2 +021400 " FOR OFFICIAL USE ONLY". ST1274.2 +021500 02 FILLER PIC X(12) VALUE SPACE. ST1274.2 +021600 02 FILLER PIC X(58) VALUE ST1274.2 +021700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1274.2 +021800 02 FILLER PIC X(13) VALUE SPACE. ST1274.2 +021900 02 FILLER PIC X(15) VALUE ST1274.2 +022000 " COPYRIGHT 1985". ST1274.2 +022100 01 CCVS-E-4. ST1274.2 +022200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1274.2 +022300 02 FILLER PIC X(4) VALUE " OF ". ST1274.2 +022400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1274.2 +022500 02 FILLER PIC X(40) VALUE ST1274.2 +022600 " TESTS WERE EXECUTED SUCCESSFULLY". ST1274.2 +022700 01 XXINFO. ST1274.2 +022800 02 FILLER PIC X(19) VALUE ST1274.2 +022900 "*** INFORMATION ***". ST1274.2 +023000 02 INFO-TEXT. ST1274.2 +023100 04 FILLER PIC X(8) VALUE SPACE. ST1274.2 +023200 04 XXCOMPUTED PIC X(20). ST1274.2 +023300 04 FILLER PIC X(5) VALUE SPACE. ST1274.2 +023400 04 XXCORRECT PIC X(20). ST1274.2 +023500 02 INF-ANSI-REFERENCE PIC X(48). ST1274.2 +023600 01 HYPHEN-LINE. ST1274.2 +023700 02 FILLER PIC IS X VALUE IS SPACE. ST1274.2 +023800 02 FILLER PIC IS X(65) VALUE IS "************************ST1274.2 +023900- "*****************************************". ST1274.2 +024000 02 FILLER PIC IS X(54) VALUE IS "************************ST1274.2 +024100- "******************************". ST1274.2 +024200 01 CCVS-PGM-ID PIC X(9) VALUE ST1274.2 +024300 "ST127A". ST1274.2 +024400 PROCEDURE DIVISION. ST1274.2 +024500 SORT-PARA SECTION. ST1274.2 +024600 SORT-PARAGRAPH. ST1274.2 +024700 MOVE "XI-18 4.4.4 GR(3)b" TO ANSI-REFERENCE. ST1274.2 +024800 SORT SORTFILE-1H ON ST1274.2 +024900 ASCENDING KEY SORTKEY-1 ST1274.2 +025000 ASCENDING SORTKEY-2 ST1274.2 +025100 ASCENDING SORTKEY-3 ST1274.2 +025200 ASCENDING SORTKEY-4 ST1274.2 +025300 ASCENDING SORTKEY-5 ST1274.2 +025400 ASCENDING SORTKEY-6 ST1274.2 +025500 ASCENDING SORTKEY-7 ST1274.2 +025600 ASCENDING SORTKEY-8 ST1274.2 +025700 WITH DUPLICATES IN ORDER ST1274.2 +025800 INPUT PROCEDURE INPROC ST1274.2 +025900 OUTPUT PROCEDURE OUTPROC THRU OUTPROC-EXIT. ST1274.2 +026000 STOP RUN. ST1274.2 +026100 INPROC SECTION. ST1274.2 +026200 BUILD-FILE. ST1274.2 +026300 MOVE ZERO TO WS-IDENTIFIER. ST1274.2 +026400 PERFORM BUILD-RECORD. ST1274.2 +026500 MOVE SORT-1 TO WS-SORTFILE-REC. ST1274.2 +026600 ADD 1 TO WS-IDENTIFIER. ST1274.2 +026700 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +026800 PERFORM RELEASE-RECORD. ST1274.2 +026900 MOVE +123456 TO SORTKEY-1. ST1274.2 +027000 PERFORM RELEASE-RECORD. ST1274.2 +027100 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +027200 ADD 1 TO WS-IDENTIFIER. ST1274.2 +027300 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +027400 PERFORM RELEASE-RECORD. ST1274.2 +027500 PERFORM BUILD-RECORD. ST1274.2 +027600 MOVE "X" TO SORTKEY-2. ST1274.2 +027700 PERFORM RELEASE-RECORD. ST1274.2 +027800 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +027900 ADD 1 TO WS-IDENTIFIER. ST1274.2 +028000 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +028100 PERFORM RELEASE-RECORD. ST1274.2 +028200 PERFORM BUILD-RECORD. ST1274.2 +028300 MOVE +.6 TO SORTKEY-3. ST1274.2 +028400 PERFORM RELEASE-RECORD. ST1274.2 +028500 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +028600 ADD 1 TO WS-IDENTIFIER. ST1274.2 +028700 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +028800 PERFORM RELEASE-RECORD. ST1274.2 +028900 PERFORM BUILD-RECORD. ST1274.2 +029000 MOVE "X" TO SORTKEY-4. ST1274.2 +029100 PERFORM RELEASE-RECORD. ST1274.2 +029200 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +029300 ADD 1 TO WS-IDENTIFIER. ST1274.2 +029400 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +029500 PERFORM RELEASE-RECORD. ST1274.2 +029600 PERFORM BUILD-RECORD. ST1274.2 +029700 MOVE "Z" TO SORTKEY-5. ST1274.2 +029800 PERFORM RELEASE-RECORD. ST1274.2 +029900 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +030000 ADD 1 TO WS-IDENTIFIER. ST1274.2 +030100 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +030200 PERFORM RELEASE-RECORD. ST1274.2 +030300 PERFORM BUILD-RECORD. ST1274.2 +030400 MOVE "Z" TO SORTKEY-6. ST1274.2 +030500 PERFORM RELEASE-RECORD. ST1274.2 +030600 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +030700 ADD 1 TO WS-IDENTIFIER. ST1274.2 +030800 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +030900 PERFORM RELEASE-RECORD. ST1274.2 +031000 PERFORM BUILD-RECORD. ST1274.2 +031100 MOVE +418 TO SORTKEY-7. ST1274.2 +031200 PERFORM RELEASE-RECORD. ST1274.2 +031300 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +031400 ADD 1 TO WS-IDENTIFIER. ST1274.2 +031500 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +031600 PERFORM RELEASE-RECORD. ST1274.2 +031700 PERFORM BUILD-RECORD. ST1274.2 +031800 MOVE -14 TO SORTKEY-8. ST1274.2 +031900 PERFORM RELEASE-RECORD. ST1274.2 +032000 MOVE WS-SORTFILE-REC TO SORTFILE-REC. ST1274.2 +032100 ADD 1 TO WS-IDENTIFIER. ST1274.2 +032200 MOVE WS-IDENTIFIER TO SORT-IDENTIFIER. ST1274.2 +032300 PERFORM RELEASE-RECORD. ST1274.2 +032400 GO TO BUILD-EXIT. ST1274.2 +032500 BUILD-RECORD. ST1274.2 +032600 MOVE -054321 TO SORTKEY-1. ST1274.2 +032700 MOVE "BBB" TO SORTKEY-2. ST1274.2 +032800 MOVE -.1234567890123456 TO SORTKEY-3. ST1274.2 +032900 MOVE "BBBBBB" TO SORTKEY-4. ST1274.2 +033000 MOVE "A" TO SORTKEY-5. ST1274.2 +033100 MOVE "AAAAAAAA" TO SORTKEY-6. ST1274.2 +033200 MOVE -501 TO SORTKEY-7. ST1274.2 +033300* NOTE THIS ITEM IS INTENTIONALLY MOVED TO AN UNSIGNED ST1274.2 +033400* FIELD. ST1274.2 +033500 MOVE +99 TO SORTKEY-8. ST1274.2 +033600 MOVE SPACE TO SORT-IDENTIFIER. ST1274.2 +033700 RELEASE-RECORD. ST1274.2 +033800 RELEASE SORTFILE-REC. ST1274.2 +033900 BUILD-EXIT. ST1274.2 +034000 EXIT. ST1274.2 +034100 OUTPROC SECTION. ST1274.2 +034200 OPEN-FILES. ST1274.2 +034300 OPEN OUTPUT PRINT-FILE. ST1274.2 +034400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1274.2 +034500 MOVE SPACE TO TEST-RESULTS. ST1274.2 +034600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1274.2 +034700 IF SPAC-E IS LESS THAN "B" ST1274.2 +034800 GO TO SPACE-IS-LESS-THAN-B. ST1274.2 +034900 B-IS-LESS-THAN-SPACE SECTION. ST1274.2 +035000 SORT-INIT-A. ST1274.2 +035100 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1274.2 +035200* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1274.2 +035300* ORDER --- 8 7 6 5 4 3 1 2 --- THAT IS, ST1274.2 +035400* THE 8TH RECORD SORTS UP TO THE 1ST POSITION, ST1274.2 +035500* THE 7TH RECORD SORTS UP TO THE 2ND POSITION, ETC. ST1274.2 +035600 SORT-TEST-1. ST1274.2 +035700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +035800 IF SORTKEY-7 EQUAL TO 418 ST1274.2 +035900 PERFORM PASS GO TO SORT-WRITE-1. ST1274.2 +036000 SORT-FAIL-1. ST1274.2 +036100 PERFORM FAIL. ST1274.2 +036200 MOVE SORTKEY-7 TO COMPUTED-N. ST1274.2 +036300 MOVE 418 TO CORRECT-N. ST1274.2 +036400 SORT-WRITE-1. ST1274.2 +036500 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1274.2 +036600 PERFORM PRINT-DETAIL. ST1274.2 +036700 SORT-TEST-2. ST1274.2 +036800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +036900 IF SORTKEY-8 EQUAL TO -14 ST1274.2 +037000 PERFORM PASS GO TO SORT-WRITE-2. ST1274.2 +037100 SORT-FAIL-2. ST1274.2 +037200 PERFORM FAIL. ST1274.2 +037300 MOVE SORTKEY-8 TO COMPUTED-N. ST1274.2 +037400 MOVE -14 TO CORRECT-N. ST1274.2 +037500 SORT-WRITE-2. ST1274.2 +037600 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1274.2 +037700 PERFORM PRINT-DETAIL. ST1274.2 +037800 SORT-TEST-3. ST1274.2 +037900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +038000 IF SORTKEY-6 EQUAL TO "Z " ST1274.2 +038100 PERFORM PASS GO TO SORT-WRITE-3. ST1274.2 +038200 SORT-FAIL-3. ST1274.2 +038300 PERFORM FAIL. ST1274.2 +038400 MOVE SORTKEY-6 TO COMPUTED-A. ST1274.2 +038500 MOVE "Z " TO CORRECT-A. ST1274.2 +038600 SORT-WRITE-3. ST1274.2 +038700 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1274.2 +038800 PERFORM PRINT-DETAIL. ST1274.2 +038900 SORT-TEST-4. ST1274.2 +039000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +039100 IF SORTKEY-5 EQUAL TO "Z " ST1274.2 +039200 PERFORM PASS GO TO SORT-WRITE-4. ST1274.2 +039300 SORT-FAIL-4. ST1274.2 +039400 PERFORM FAIL. ST1274.2 +039500 MOVE SORTKEY-5 TO COMPUTED-A. ST1274.2 +039600 MOVE "Z " TO CORRECT-A. ST1274.2 +039700 SORT-WRITE-4. ST1274.2 +039800 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1274.2 +039900 PERFORM PRINT-DETAIL. ST1274.2 +040000 SORT-TEST-5. ST1274.2 +040100 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +040200 IF SORTKEY-4 EQUAL TO " X" ST1274.2 +040300 PERFORM PASS GO TO SORT-WRITE-5. ST1274.2 +040400 SORT-FAIL-5. ST1274.2 +040500 PERFORM FAIL. ST1274.2 +040600 MOVE SORTKEY-4 TO COMPUTED-A. ST1274.2 +040700 MOVE " X" TO CORRECT-A. ST1274.2 +040800 SORT-WRITE-5. ST1274.2 +040900 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1274.2 +041000 PERFORM PRINT-DETAIL. ST1274.2 +041100 SORT-TEST-6. ST1274.2 +041200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +041300 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1274.2 +041400 PERFORM PASS GO TO SORT-WRITE-6. ST1274.2 +041500 SORT-FAIL-6. ST1274.2 +041600 PERFORM FAIL. ST1274.2 +041700 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1274.2 +041800 MOVE +.6000000000000000 TO CORRECT-0V18. ST1274.2 +041900 SORT-WRITE-6. ST1274.2 +042000 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1274.2 +042100 PERFORM PRINT-DETAIL. ST1274.2 +042200 SORT-TEST-7. ST1274.2 +042300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +042400 IF SORTKEY-2 EQUAL TO " X" ST1274.2 +042500 PERFORM PASS GO TO SORT-WRITE-7. ST1274.2 +042600 SORT-FAIL-7. ST1274.2 +042700 PERFORM FAIL. ST1274.2 +042800 MOVE SORTKEY-2 TO COMPUTED-A. ST1274.2 +042900 MOVE " X" TO CORRECT-A. ST1274.2 +043000 SORT-WRITE-7. ST1274.2 +043100 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1274.2 +043200 PERFORM PRINT-DETAIL. ST1274.2 +043300 SORT-TEST-8. ST1274.2 +043400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +043500 IF SORTKEY-1 EQUAL TO +123456 ST1274.2 +043600 PERFORM PASS GO TO SORT-WRITE-8. ST1274.2 +043700 SORT-FAIL-8. ST1274.2 +043800 PERFORM FAIL. ST1274.2 +043900 MOVE SORTKEY-1 TO COMPUTED-N. ST1274.2 +044000 MOVE +123456 TO CORRECT-N. ST1274.2 +044100 SORT-WRITE-8. ST1274.2 +044200 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1274.2 +044300 PERFORM PRINT-DETAIL. ST1274.2 +044400 SORT-REMARK-A. ST1274.2 +044500 MOVE SPACE TO FEATURE. ST1274.2 +044600 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1274.2 +044700 PERFORM PRINT-DETAIL. ST1274.2 +044800 MOVE "RENDERS TESTS 9 THRU 16" TO RE-MARK. ST1274.2 +044900 PERFORM PRINT-DETAIL. ST1274.2 +045000 MOVE "UNNECESSARY." TO RE-MARK. ST1274.2 +045100 PERFORM PRINT-DETAIL. ST1274.2 +045200 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1274.2 +045300 GO TO CONTINUE-TESTING. ST1274.2 +045400 SPACE-IS-LESS-THAN-B SECTION. ST1274.2 +045500 SORT-REMARK-B. ST1274.2 +045600 MOVE "THE COLLATING SEQUENCE" TO RE-MARK. ST1274.2 +045700 PERFORM PRINT-DETAIL. ST1274.2 +045800 MOVE "RENDERS TESTS 1 THRU 8" TO RE-MARK. ST1274.2 +045900 PERFORM PRINT-DETAIL. ST1274.2 +046000 MOVE "UNNECESSARY." TO RE-MARK. ST1274.2 +046100 PERFORM PRINT-DETAIL. ST1274.2 +046200 MOVE "SORT - 8 ASC. KEYS" TO FEATURE. ST1274.2 +046300* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1274.2 +046400* ORDER --- 8 1 7 2 6 5 3 4 --- THAT IS, ST1274.2 +046500* THE 1ST RECORD IS SORTED DOWN TO THE 8TH POSITION, ST1274.2 +046600* THE 2ND RECORD SORTS UP TO THE 1ST POSITION, ETC. ST1274.2 +046700 SORT-TEST-9. ST1274.2 +046800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +046900 IF SORTKEY-2 EQUAL TO " X" ST1274.2 +047000 PERFORM PASS GO TO SORT-WRITE-9. ST1274.2 +047100 SORT-FAIL-9. ST1274.2 +047200 PERFORM FAIL. ST1274.2 +047300 MOVE SORTKEY-2 TO COMPUTED-A. ST1274.2 +047400 MOVE " X" TO CORRECT-A. ST1274.2 +047500 SORT-WRITE-9. ST1274.2 +047600 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1274.2 +047700 PERFORM PRINT-DETAIL. ST1274.2 +047800* ST1274.2 +047900* PERFORM RETURN-DUPLICATE-RECORDS. ST1274.2 +048000* ST1274.2 +048100 SORT-TEST-10. ST1274.2 +048200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +048300 IF SORTKEY-4 EQUAL TO " X" ST1274.2 +048400 PERFORM PASS GO TO SORT-WRITE-10. ST1274.2 +048500 SORT-FAIL-10. ST1274.2 +048600 PERFORM FAIL. ST1274.2 +048700 MOVE SORTKEY-4 TO COMPUTED-A. ST1274.2 +048800 MOVE " X" TO CORRECT-A. ST1274.2 +048900 SORT-WRITE-10. ST1274.2 +049000 MOVE "SORT-TEST-10" TO PAR-NAME. ST1274.2 +049100 PERFORM PRINT-DETAIL. ST1274.2 +049200 SORT-TEST-11. ST1274.2 +049300 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +049400 IF SORTKEY-7 EQUAL TO 418 ST1274.2 +049500 PERFORM PASS GO TO SORT-WRITE-11. ST1274.2 +049600 SORT-FAIL-11. ST1274.2 +049700 PERFORM FAIL. ST1274.2 +049800 MOVE SORTKEY-7 TO COMPUTED-N ST1274.2 +049900 MOVE 418 TO CORRECT-N. ST1274.2 +050000 SORT-WRITE-11. ST1274.2 +050100 MOVE "SORT-TEST-11" TO PAR-NAME. ST1274.2 +050200 PERFORM PRINT-DETAIL. ST1274.2 +050300 SORT-TEST-12. ST1274.2 +050400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +050500 IF SORTKEY-8 EQUAL TO -14 ST1274.2 +050600 PERFORM PASS GO TO SORT-WRITE-12. ST1274.2 +050700 SORT-FAIL-12. ST1274.2 +050800 PERFORM FAIL. ST1274.2 +050900 MOVE SORTKEY-8 TO COMPUTED-N. ST1274.2 +051000 MOVE -14 TO CORRECT-N. ST1274.2 +051100 SORT-WRITE-12. ST1274.2 +051200 MOVE "SORT-TEST-12" TO PAR-NAME. ST1274.2 +051300 PERFORM PRINT-DETAIL. ST1274.2 +051400 PERFORM RETURN-DUPLICATE-RECORDS. ST1274.2 +051500 SORT-TEST-13. ST1274.2 +051600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +051700 IF SORTKEY-6 EQUAL TO "Z " ST1274.2 +051800 PERFORM PASS GO TO SORT-WRITE-13. ST1274.2 +051900 SORT-FAIL-13. ST1274.2 +052000 PERFORM FAIL. ST1274.2 +052100 MOVE SORTKEY-6 TO COMPUTED-A. ST1274.2 +052200 MOVE "Z " TO CORRECT-A. ST1274.2 +052300 SORT-WRITE-13. ST1274.2 +052400 MOVE "SORT-TEST-13" TO PAR-NAME. ST1274.2 +052500 PERFORM PRINT-DETAIL. ST1274.2 +052600 SORT-TEST-14. ST1274.2 +052700 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +052800 IF SORTKEY-5 EQUAL TO "Z " ST1274.2 +052900 PERFORM PASS GO TO SORT-WRITE-14. ST1274.2 +053000 SORT-FAIL-14. ST1274.2 +053100 PERFORM FAIL. ST1274.2 +053200 MOVE SORTKEY-5 TO COMPUTED-A. ST1274.2 +053300 MOVE "Z " TO CORRECT-A. ST1274.2 +053400 SORT-WRITE-14. ST1274.2 +053500 MOVE "SORT-TEST-14" TO PAR-NAME. ST1274.2 +053600 PERFORM PRINT-DETAIL. ST1274.2 +053700 SORT-TEST-15. ST1274.2 +053800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +053900 IF SORTKEY-3 EQUAL TO +.6000000000000000 ST1274.2 +054000 PERFORM PASS GO TO SORT-WRITE-15. ST1274.2 +054100 SORT-FAIL-15. ST1274.2 +054200 PERFORM FAIL. ST1274.2 +054300 MOVE SORTKEY-3 TO COMPUTED-0V18. ST1274.2 +054400 MOVE +.6000000000000000 TO CORRECT-0V18. ST1274.2 +054500 SORT-WRITE-15. ST1274.2 +054600 MOVE "SORT-TEST-15" TO PAR-NAME. ST1274.2 +054700 PERFORM PRINT-DETAIL. ST1274.2 +054800 SORT-TEST-16. ST1274.2 +054900 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +055000 IF SORTKEY-1 EQUAL TO +123456 ST1274.2 +055100 PERFORM PASS GO TO SORT-WRITE-16. ST1274.2 +055200 SORT-FAIL-16. ST1274.2 +055300 PERFORM FAIL. ST1274.2 +055400 MOVE SORTKEY-1 TO COMPUTED-N. ST1274.2 +055500 MOVE +123456 TO CORRECT-N. ST1274.2 +055600 SORT-WRITE-16. ST1274.2 +055700 MOVE "SORT-TEST-16" TO PAR-NAME. ST1274.2 +055800 PERFORM PRINT-DETAIL. ST1274.2 +055900 CONTINUE-TESTING SECTION. ST1274.2 +056000 SORT-TEST-17. ST1274.2 +056100 RETURN SORTFILE-1H AT END ST1274.2 +056200 PERFORM PASS GO TO SORT-WRITE-17. ST1274.2 +056300 SORT-FAIL-17. ST1274.2 +056400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1274.2 +056500 PERFORM FAIL. ST1274.2 +056600 SORT-WRITE-17. ST1274.2 +056700 MOVE "SORT-TEST-17" TO PAR-NAME. ST1274.2 +056800 PERFORM PRINT-DETAIL. ST1274.2 +056900 GO TO OUTPROC-EXIT. ST1274.2 +057000 RETURN-ERROR. ST1274.2 +057100 MOVE "RETURN-ERROR" TO PAR-NAME. ST1274.2 +057200 PERFORM FAIL. ST1274.2 +057300 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1274.2 +057400 PERFORM PRINT-DETAIL. ST1274.2 +057500 GO TO CCVS1-EXIT. ST1274.2 +057600 CLOSE-FILES. ST1274.2 +057700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1274.2 +057800 TERMINATE-CCVS. ST1274.2 +057900*S EXIT PROGRAM. ST1274.2 +058000*SERMINATE-CALL. ST1274.2 +058100 STOP RUN. ST1274.2 +058200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1274.2 +058300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1274.2 +058400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1274.2 +058500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1274.2 +058600 MOVE "****TEST DELETED****" TO RE-MARK. ST1274.2 +058700 PRINT-DETAIL. ST1274.2 +058800 IF REC-CT NOT EQUAL TO ZERO ST1274.2 +058900 MOVE "." TO PARDOT-X ST1274.2 +059000 MOVE REC-CT TO DOTVALUE. ST1274.2 +059100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1274.2 +059200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1274.2 +059300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1274.2 +059400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1274.2 +059500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1274.2 +059600 MOVE SPACE TO CORRECT-X. ST1274.2 +059700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1274.2 +059800 MOVE SPACE TO RE-MARK. ST1274.2 +059900 HEAD-ROUTINE. ST1274.2 +060000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +060100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +060200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1274.2 +060300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1274.2 +060400 COLUMN-NAMES-ROUTINE. ST1274.2 +060500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +060600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +060700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +060800 END-ROUTINE. ST1274.2 +060900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1274.2 +061000 END-RTN-EXIT. ST1274.2 +061100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +061200 END-ROUTINE-1. ST1274.2 +061300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1274.2 +061400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1274.2 +061500 ADD PASS-COUNTER TO ERROR-HOLD. ST1274.2 +061600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1274.2 +061700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1274.2 +061800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1274.2 +061900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1274.2 +062000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1274.2 +062100 END-ROUTINE-12. ST1274.2 +062200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1274.2 +062300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1274.2 +062400 MOVE "NO " TO ERROR-TOTAL ST1274.2 +062500 ELSE ST1274.2 +062600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1274.2 +062700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1274.2 +062800 PERFORM WRITE-LINE. ST1274.2 +062900 END-ROUTINE-13. ST1274.2 +063000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1274.2 +063100 MOVE "NO " TO ERROR-TOTAL ELSE ST1274.2 +063200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1274.2 +063300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1274.2 +063400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +063500 IF INSPECT-COUNTER EQUAL TO ZERO ST1274.2 +063600 MOVE "NO " TO ERROR-TOTAL ST1274.2 +063700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1274.2 +063800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1274.2 +063900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +064000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1274.2 +064100 WRITE-LINE. ST1274.2 +064200 ADD 1 TO RECORD-COUNT. ST1274.2 +064300 IF RECORD-COUNT GREATER 42 ST1274.2 +064400 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1274.2 +064500 MOVE SPACE TO DUMMY-RECORD ST1274.2 +064600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1274.2 +064700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1274.2 +064800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1274.2 +064900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1274.2 +065000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1274.2 +065100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1274.2 +065200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1274.2 +065300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1274.2 +065400 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1274.2 +065500 MOVE ZERO TO RECORD-COUNT. ST1274.2 +065600 PERFORM WRT-LN. ST1274.2 +065700 WRT-LN. ST1274.2 +065800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1274.2 +065900 MOVE SPACE TO DUMMY-RECORD. ST1274.2 +066000 BLANK-LINE-PRINT. ST1274.2 +066100 PERFORM WRT-LN. ST1274.2 +066200 FAIL-ROUTINE. ST1274.2 +066300 IF COMPUTED-X NOT EQUAL TO SPACE ST1274.2 +066400 GO TO FAIL-ROUTINE-WRITE. ST1274.2 +066500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1274.2 +066600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1274.2 +066700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1274.2 +066800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +066900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1274.2 +067000 GO TO FAIL-ROUTINE-EX. ST1274.2 +067100 FAIL-ROUTINE-WRITE. ST1274.2 +067200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1274.2 +067300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1274.2 +067400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1274.2 +067500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1274.2 +067600 FAIL-ROUTINE-EX. EXIT. ST1274.2 +067700 BAIL-OUT. ST1274.2 +067800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1274.2 +067900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1274.2 +068000 BAIL-OUT-WRITE. ST1274.2 +068100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1274.2 +068200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1274.2 +068300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1274.2 +068400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1274.2 +068500 BAIL-OUT-EX. EXIT. ST1274.2 +068600 CCVS1-EXIT. ST1274.2 +068700 EXIT. ST1274.2 +068800* ST1274.2 +068900 OUTPROC-EXIT SECTION. ST1274.2 +069000 EXIT-ONLY. ST1274.2 +069100 PERFORM CLOSE-FILES. ST1274.2 +069200* ST1274.2 +069300 RETURN-DUPLICATE-RECORDS SECTION. ST1274.2 +069400*================================ ST1274.2 +069500 SORT-INIT-18. ST1274.2 +069600 MOVE "DUPLICATE KEYS" TO FEATURE. ST1274.2 +069700* NOTE THE RECORDS SHOULD BE SORTED INTO THE FOLLOWING ST1274.2 +069800* ORDER OF THE LAST CHARACTER OF THE RECORD: ST1274.2 +069900* ---- 1 2 3 4 5 6 7 8 9 --- ST1274.2 +070000 SORT-TEST-18-1. ST1274.2 +070100 MOVE "SORT-TEST-18-1" TO PAR-NAME. ST1274.2 +070200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +070300 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +070400 PERFORM PASS ST1274.2 +070500 PERFORM PRINT-DETAIL ST1274.2 +070600 GO TO SORT-TEST-18-2. ST1274.2 +070700 SORT-FAIL-18-1. ST1274.2 +070800 PERFORM FAIL. ST1274.2 +070900 PERFORM CHECK-KEYS. ST1274.2 +071000 SORT-TEST-18-2. ST1274.2 +071100 MOVE "SORT-TEST-18-2" TO PAR-NAME. ST1274.2 +071200 IF SORT-IDENTIFIER = "1" ST1274.2 +071300 PERFORM PASS ST1274.2 +071400 PERFORM PRINT-DETAIL ST1274.2 +071500 GO TO SORT-TEST-19-1. ST1274.2 +071600 SORT-FAIL-18-2. ST1274.2 +071700 PERFORM FAIL. ST1274.2 +071800 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +071900 MOVE "1" TO CORRECT-X. ST1274.2 +072000 PERFORM PRINT-DETAIL. ST1274.2 +072100* ST1274.2 +072200 SORT-TEST-19-1. ST1274.2 +072300 MOVE "SORT-TEST-19-1" TO PAR-NAME. ST1274.2 +072400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +072500 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +072600 PERFORM PASS ST1274.2 +072700 PERFORM PRINT-DETAIL ST1274.2 +072800 GO TO SORT-TEST-19-2. ST1274.2 +072900 SORT-FAIL-19-1. ST1274.2 +073000 PERFORM FAIL. ST1274.2 +073100 PERFORM CHECK-KEYS. ST1274.2 +073200 SORT-TEST-19-2. ST1274.2 +073300 MOVE "SORT-TEST-19-2" TO PAR-NAME. ST1274.2 +073400 IF SORT-IDENTIFIER = "2" ST1274.2 +073500 PERFORM PASS ST1274.2 +073600 PERFORM PRINT-DETAIL ST1274.2 +073700 GO TO SORT-TEST-20-1. ST1274.2 +073800 SORT-FAIL-19-2. ST1274.2 +073900 PERFORM FAIL. ST1274.2 +074000 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +074100 MOVE "2" TO CORRECT-X. ST1274.2 +074200 PERFORM PRINT-DETAIL. ST1274.2 +074300* ST1274.2 +074400 SORT-TEST-20-1. ST1274.2 +074500 MOVE "SORT-TEST-20-1" TO PAR-NAME. ST1274.2 +074600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +074700 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +074800 PERFORM PASS ST1274.2 +074900 PERFORM PRINT-DETAIL ST1274.2 +075000 GO TO SORT-TEST-20-2. ST1274.2 +075100 SORT-FAIL-20-1. ST1274.2 +075200 PERFORM FAIL. ST1274.2 +075300 PERFORM CHECK-KEYS. ST1274.2 +075400 SORT-TEST-20-2. ST1274.2 +075500 MOVE "SORT-TEST-20-2" TO PAR-NAME. ST1274.2 +075600 IF SORT-IDENTIFIER = "3" ST1274.2 +075700 PERFORM PASS ST1274.2 +075800 PERFORM PRINT-DETAIL ST1274.2 +075900 GO TO SORT-TEST-21-1. ST1274.2 +076000 SORT-FAIL-20-2. ST1274.2 +076100 PERFORM FAIL. ST1274.2 +076200 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +076300 MOVE "3" TO CORRECT-X. ST1274.2 +076400 PERFORM PRINT-DETAIL. ST1274.2 +076500* ST1274.2 +076600 SORT-TEST-21-1. ST1274.2 +076700 MOVE "SORT-TEST-21-1" TO PAR-NAME. ST1274.2 +076800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +076900 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +077000 PERFORM PASS ST1274.2 +077100 PERFORM PRINT-DETAIL ST1274.2 +077200 GO TO SORT-TEST-21-2. ST1274.2 +077300 SORT-FAIL-21-1. ST1274.2 +077400 PERFORM FAIL. ST1274.2 +077500 PERFORM CHECK-KEYS. ST1274.2 +077600 SORT-TEST-21-2. ST1274.2 +077700 MOVE "SORT-TEST-21-2" TO PAR-NAME. ST1274.2 +077800 IF SORT-IDENTIFIER = "4" ST1274.2 +077900 PERFORM PASS ST1274.2 +078000 PERFORM PRINT-DETAIL ST1274.2 +078100 GO TO SORT-TEST-22-1. ST1274.2 +078200 SORT-FAIL-21-2. ST1274.2 +078300 PERFORM FAIL. ST1274.2 +078400 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +078500 MOVE "4" TO CORRECT-X. ST1274.2 +078600 PERFORM PRINT-DETAIL. ST1274.2 +078700* ST1274.2 +078800 SORT-TEST-22-1. ST1274.2 +078900 MOVE "SORT-TEST-22-1" TO PAR-NAME. ST1274.2 +079000 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +079100 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +079200 PERFORM PASS ST1274.2 +079300 PERFORM PRINT-DETAIL ST1274.2 +079400 GO TO SORT-TEST-22-2. ST1274.2 +079500 SORT-FAIL-22-1. ST1274.2 +079600 PERFORM FAIL. ST1274.2 +079700 PERFORM CHECK-KEYS. ST1274.2 +079800 SORT-TEST-22-2. ST1274.2 +079900 MOVE "SORT-TEST-22-2" TO PAR-NAME. ST1274.2 +080000 IF SORT-IDENTIFIER = "5" ST1274.2 +080100 PERFORM PASS ST1274.2 +080200 PERFORM PRINT-DETAIL ST1274.2 +080300 GO TO SORT-TEST-23-1. ST1274.2 +080400 SORT-FAIL-22-2. ST1274.2 +080500 PERFORM FAIL. ST1274.2 +080600 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +080700 MOVE "5" TO CORRECT-X. ST1274.2 +080800 PERFORM PRINT-DETAIL. ST1274.2 +080900* ST1274.2 +081000 SORT-TEST-23-1. ST1274.2 +081100 MOVE "SORT-TEST-23-1" TO PAR-NAME. ST1274.2 +081200 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +081300 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +081400 PERFORM PASS ST1274.2 +081500 PERFORM PRINT-DETAIL ST1274.2 +081600 GO TO SORT-TEST-23-2. ST1274.2 +081700 SORT-FAIL-23-1. ST1274.2 +081800 PERFORM FAIL. ST1274.2 +081900 PERFORM CHECK-KEYS. ST1274.2 +082000 SORT-TEST-23-2. ST1274.2 +082100 MOVE "SORT-TEST-23-2" TO PAR-NAME. ST1274.2 +082200 IF SORT-IDENTIFIER = "6" ST1274.2 +082300 PERFORM PASS ST1274.2 +082400 PERFORM PRINT-DETAIL ST1274.2 +082500 GO TO SORT-TEST-24-1. ST1274.2 +082600 SORT-FAIL-23-2. ST1274.2 +082700 PERFORM FAIL. ST1274.2 +082800 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +082900 MOVE "6" TO CORRECT-X. ST1274.2 +083000 PERFORM PRINT-DETAIL. ST1274.2 +083100* ST1274.2 +083200 SORT-TEST-24-1. ST1274.2 +083300 MOVE "SORT-TEST-24-1" TO PAR-NAME. ST1274.2 +083400 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +083500 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +083600 PERFORM PASS ST1274.2 +083700 PERFORM PRINT-DETAIL ST1274.2 +083800 GO TO SORT-TEST-24-2. ST1274.2 +083900 SORT-FAIL-24-1. ST1274.2 +084000 PERFORM FAIL. ST1274.2 +084100 PERFORM CHECK-KEYS. ST1274.2 +084200 SORT-TEST-24-2. ST1274.2 +084300 MOVE "SORT-TEST-24-2" TO PAR-NAME. ST1274.2 +084400 IF SORT-IDENTIFIER = "7" ST1274.2 +084500 PERFORM PASS ST1274.2 +084600 PERFORM PRINT-DETAIL ST1274.2 +084700 GO TO SORT-TEST-25-1. ST1274.2 +084800 SORT-FAIL-24-2. ST1274.2 +084900 PERFORM FAIL. ST1274.2 +085000 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +085100 MOVE "7" TO CORRECT-X. ST1274.2 +085200 PERFORM PRINT-DETAIL. ST1274.2 +085300* ST1274.2 +085400 SORT-TEST-25-1. ST1274.2 +085500 MOVE "SORT-TEST-25-1" TO PAR-NAME. ST1274.2 +085600 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +085700 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +085800 PERFORM PASS ST1274.2 +085900 PERFORM PRINT-DETAIL ST1274.2 +086000 GO TO SORT-TEST-25-2. ST1274.2 +086100 SORT-FAIL-25-1. ST1274.2 +086200 PERFORM FAIL. ST1274.2 +086300 PERFORM CHECK-KEYS. ST1274.2 +086400 SORT-TEST-25-2. ST1274.2 +086500 MOVE "SORT-TEST-25-2" TO PAR-NAME. ST1274.2 +086600 IF SORT-IDENTIFIER = "8" ST1274.2 +086700 PERFORM PASS ST1274.2 +086800 PERFORM PRINT-DETAIL ST1274.2 +086900 GO TO SORT-TEST-26-1. ST1274.2 +087000 SORT-FAIL-25-2. ST1274.2 +087100 PERFORM FAIL. ST1274.2 +087200 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +087300 MOVE "8" TO CORRECT-X. ST1274.2 +087400 PERFORM PRINT-DETAIL. ST1274.2 +087500* ST1274.2 +087600 SORT-TEST-26-1. ST1274.2 +087700 MOVE "SORT-TEST-26-1" TO PAR-NAME. ST1274.2 +087800 RETURN SORTFILE-1H AT END GO TO RETURN-ERROR. ST1274.2 +087900 IF SORT-1 = WS-SORTFILE-REC ST1274.2 +088000 PERFORM PASS ST1274.2 +088100 PERFORM PRINT-DETAIL ST1274.2 +088200 GO TO SORT-TEST-26-2. ST1274.2 +088300 SORT-FAIL-26-1. ST1274.2 +088400 PERFORM FAIL. ST1274.2 +088500 PERFORM CHECK-KEYS. ST1274.2 +088600 SORT-TEST-26-2. ST1274.2 +088700 MOVE "SORT-TEST-26-2" TO PAR-NAME. ST1274.2 +088800 IF SORT-IDENTIFIER = "9" ST1274.2 +088900 PERFORM PASS ST1274.2 +089000 PERFORM PRINT-DETAIL ST1274.2 +089100 GO TO DUPLICATE-RECORD-EXIT. ST1274.2 +089200 SORT-FAIL-26-2. ST1274.2 +089300 PERFORM FAIL. ST1274.2 +089400 MOVE SORT-IDENTIFIER TO COMPUTED-X. ST1274.2 +089500 MOVE "9" TO CORRECT-X. ST1274.2 +089600 PERFORM PRINT-DETAIL. ST1274.2 +089700 ST1274.2 +089800* ST1274.2 +089900 DUPLICATE-RECORD-EXIT. ST1274.2 +090000 EXIT. ST1274.2 +090100* ST1274.2 +090200* ST1274.2 +090300 CHECK-KEYS SECTION. ST1274.2 +090400*================== ST1274.2 +090500 CHK-TEST-1. ST1274.2 +090600 MOVE "CHK-TEST-1" TO PAR-NAME. ST1274.2 +090700 IF SORTKEY-1 = WS-1 ST1274.2 +090800 PERFORM PASS ST1274.2 +090900 PERFORM PRINT-DETAIL ST1274.2 +091000 GO TO CHK-TEST-2. ST1274.2 +091100 CHK-FAIL-1. ST1274.2 +091200 PERFORM FAIL. ST1274.2 +091300 MOVE SORTKEY-1 TO COMPUTED-N. ST1274.2 +091400 MOVE WS-1 TO CORRECT-N. ST1274.2 +091500 PERFORM PRINT-DETAIL. ST1274.2 +091600* ST1274.2 +091700 CHK-TEST-2. ST1274.2 +091800 MOVE "CHK-TEST-2" TO PAR-NAME. ST1274.2 +091900 IF SORTKEY-2 = WS-2 ST1274.2 +092000 PERFORM PASS ST1274.2 +092100 PERFORM PRINT-DETAIL ST1274.2 +092200 GO TO CHK-TEST-3. ST1274.2 +092300 CHK-FAIL-2. ST1274.2 +092400 PERFORM FAIL. ST1274.2 +092500 MOVE SORTKEY-1 TO COMPUTED-N. ST1274.2 +092600 MOVE WS-1 TO CORRECT-N. ST1274.2 +092700 PERFORM PRINT-DETAIL. ST1274.2 +092800* ST1274.2 +092900 CHK-TEST-3. ST1274.2 +093000 MOVE "CHK-TEST-3" TO PAR-NAME. ST1274.2 +093100 IF SORTKEY-3 = WS-3 ST1274.2 +093200 PERFORM PASS ST1274.2 +093300 PERFORM PRINT-DETAIL ST1274.2 +093400 GO TO CHK-TEST-4. ST1274.2 +093500 CHK-FAIL-3. ST1274.2 +093600 PERFORM FAIL. ST1274.2 +093700 MOVE SORTKEY-3 TO COMPUTED-X. ST1274.2 +093800 MOVE WS-1 TO CORRECT-X. ST1274.2 +093900 PERFORM PRINT-DETAIL. ST1274.2 +094000* ST1274.2 +094100 CHK-TEST-4. ST1274.2 +094200 MOVE "CHK-TEST-4" TO PAR-NAME. ST1274.2 +094300 IF SORTKEY-4 = WS-4 ST1274.2 +094400 PERFORM PASS ST1274.2 +094500 PERFORM PRINT-DETAIL ST1274.2 +094600 GO TO CHK-TEST-5. ST1274.2 +094700 CHK-FAIL-4. ST1274.2 +094800 PERFORM FAIL. ST1274.2 +094900 MOVE SORTKEY-4 TO COMPUTED-X. ST1274.2 +095000 MOVE WS-4 TO CORRECT-X. ST1274.2 +095100 PERFORM PRINT-DETAIL. ST1274.2 +095200 ST1274.2 +095300 CHK-TEST-5. ST1274.2 +095400 MOVE "CHK-TEST-5" TO PAR-NAME. ST1274.2 +095500 IF SORTKEY-5 = WS-5 ST1274.2 +095600 PERFORM PASS ST1274.2 +095700 PERFORM PRINT-DETAIL ST1274.2 +095800 GO TO CHK-TEST-6. ST1274.2 +095900 CHK-FAIL-5. ST1274.2 +096000 PERFORM FAIL. ST1274.2 +096100 MOVE SORTKEY-5 TO COMPUTED-X. ST1274.2 +096200 MOVE WS-5 TO CORRECT-X. ST1274.2 +096300 PERFORM PRINT-DETAIL. ST1274.2 +096400* ST1274.2 +096500 CHK-TEST-6. ST1274.2 +096600 MOVE "CHK-TEST-6" TO PAR-NAME. ST1274.2 +096700 IF SORTKEY-6 = WS-6 ST1274.2 +096800 PERFORM PASS ST1274.2 +096900 PERFORM PRINT-DETAIL ST1274.2 +097000 GO TO CHK-TEST-7. ST1274.2 +097100 CHK-FAIL-6. ST1274.2 +097200 PERFORM FAIL. ST1274.2 +097300 MOVE SORTKEY-6 TO COMPUTED-X. ST1274.2 +097400 MOVE WS-6 TO CORRECT-X. ST1274.2 +097500 PERFORM PRINT-DETAIL. ST1274.2 +097600* ST1274.2 +097700 CHK-TEST-7. ST1274.2 +097800 MOVE "CHK-TEST-7" TO PAR-NAME. ST1274.2 +097900 IF SORTKEY-7 = WS-7 ST1274.2 +098000 PERFORM PASS ST1274.2 +098100 PERFORM PRINT-DETAIL ST1274.2 +098200 GO TO CHK-TEST-8. ST1274.2 +098300 CHK-FAIL-7. ST1274.2 +098400 PERFORM FAIL. ST1274.2 +098500 MOVE SORTKEY-7 TO COMPUTED-X. ST1274.2 +098600 MOVE WS-7 TO CORRECT-X. ST1274.2 +098700 PERFORM PRINT-DETAIL. ST1274.2 +098800* ST1274.2 +098900 CHK-TEST-8. ST1274.2 +099000 MOVE "CHK-TEST-8" TO PAR-NAME. ST1274.2 +099100 IF SORTKEY-8 = WS-8 ST1274.2 +099200 PERFORM PASS ST1274.2 +099300 PERFORM PRINT-DETAIL ST1274.2 +099400 GO TO CHECK-KEYS-EXIT. ST1274.2 +099500 CHK-FAIL-8. ST1274.2 +099600 PERFORM FAIL. ST1274.2 +099700 MOVE SORTKEY-8 TO COMPUTED-N. ST1274.2 +099800 MOVE WS-8 TO CORRECT-N. ST1274.2 +099900 PERFORM PRINT-DETAIL. ST1274.2 +100000 CHECK-KEYS-EXIT. ST1274.2 +100100 EXIT. ST1274.2 diff --git a/tests/cobol85/ST/ST131A.CBL b/tests/cobol85/ST/ST131A.CBL new file mode 100755 index 00000000..a9c3843c --- /dev/null +++ b/tests/cobol85/ST/ST131A.CBL @@ -0,0 +1,960 @@ +000100 IDENTIFICATION DIVISION. ST1314.2 +000200 PROGRAM-ID. ST1314.2 +000300 ST131A. ST1314.2 +000400**************************************************************** ST1314.2 +000500* * ST1314.2 +000600* VALIDATION FOR:- * ST1314.2 +000700* * ST1314.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1314.2 +000900* * ST1314.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1314.2 +001100* * ST1314.2 +001200**************************************************************** ST1314.2 +001300* * ST1314.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1314.2 +001500* * ST1314.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1314.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1314.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1314.2 +001900* * ST1314.2 +002000**************************************************************** ST1314.2 +002100* THIS PROGRAM CONTAINS 3 SORTS USING NUMERIC OR ALPHABETIC ST1314.2 +002200* KEYS - BUT NOT BOTH IN THE SAME KEY DUE TO DIFFERING ST1314.2 +002300* COLLATING SEQUENCES AMONG COMPUTERS. EXTERNAL FILES ARE ST1314.2 +002400* GENERATED INTERNALLY FOR SUBSEQUENT USE. THE SELECT CLAUSE ST1314.2 +002500* IS HIGHLY DEPENDENT ON HARDWARE. THE USER SHOULD EXERCISE THEST1314.2 +002600* VARIOUS OPTIONS OF HARDWARE ASSIGNMENTS TO THE EXTENT THEY ST1314.2 +002700* ARE AVAILABLE. THE SORT OF A MULTI-REEL FILE IS EXERCISED ST1314.2 +002800* IN PROGRAM ST202. HOWEVER THE EXERCISE OF THE "FOR MULTIPLE ST1314.2 +002900* REEL-UNIT" OF THE GIVING OPTION IS NOT DUE TO THE INDETER- ST1314.2 +003000* MINATE LENGTH OF SUCH A FILE (E.G. RECORDING DENSITY OR SIZE ST1314.2 +003100* OF UNIT) AND PROCESSING COST. SORT INPUT-OUTPUT OPTIONS ST1314.2 +003200* WILL BE EXERCISED AS FOLLOWS. ST1314.2 +003300* SORT 1 USING GIVING ST1314.2 +003400* SORT 2 INPUT PROC GIVING ST1314.2 +003500* SORT 3 INPUT PROC OUTPUT PROC ST1314.2 +003600 ST1314.2 +003700 ENVIRONMENT DIVISION. ST1314.2 +003800 CONFIGURATION SECTION. ST1314.2 +003900 SOURCE-COMPUTER. ST1314.2 +004000 Linux. ST1314.2 +004100 OBJECT-COMPUTER. ST1314.2 +004200 Linux. ST1314.2 +004300 INPUT-OUTPUT SECTION. ST1314.2 +004400 FILE-CONTROL. ST1314.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1314.2 +004600 "report.log". ST1314.2 +004700 SELECT SORT1 ASSIGN TO ST1314.2 +004800 "XXXXX027". ST1314.2 +004900 SELECT SORT2 ASSIGN TO ST1314.2 +005000 "XXXXX028". ST1314.2 +005100 SELECT SORT3 ASSIGN TO ST1314.2 +005200 "XXXXX029". ST1314.2 +005300 SELECT FILE1 ASSIGN TO ST1314.2 +005400 "XXXXX001". ST1314.2 +005500 SELECT FILE2 ASSIGN TO ST1314.2 +005600 "XXXXX014". ST1314.2 +005700 SELECT FILE3 ASSIGN TO ST1314.2 +005800 "XXXXX015". ST1314.2 +005900 I-O-CONTROL. ST1314.2 +006000 SAME RECORD AREA FOR SORT1 SORT2 ST1314.2 +006100 SAME RECORD AREA FOR SORT3 FILE3. ST1314.2 +006200 DATA DIVISION. ST1314.2 +006300 FILE SECTION. ST1314.2 +006400 FD PRINT-FILE. ST1314.2 +006500 01 PRINT-REC PICTURE X(120). ST1314.2 +006600 01 DUMMY-RECORD PICTURE X(120). ST1314.2 +006700 FD FILE1 ST1314.2 +006800*C LABEL RECORDS ARE STANDARD ST1314.2 +006900*C VALUE OF ST1314.2 +007000*C OCLABELID ST1314.2 +007100*C IS ST1314.2 +007200*C "OCDUMMY" ST1314.2 +007300 BLOCK CONTAINS 10 RECORDS ST1314.2 +007400*C DATA RECORD R1 ST1314.2 +007500 . ST1314.2 +007600 01 R1. ST1314.2 +007700 02 FILLER PICTURE X(120). ST1314.2 +007800 FD FILE2 ST1314.2 +007900*C LABEL RECORDS ARE STANDARD ST1314.2 +008000*C VALUE OF ST1314.2 +008100*C OCLABELID ST1314.2 +008200*C IS ST1314.2 +008300*C "OCDUMMY" ST1314.2 +008400 BLOCK CONTAINS 10 RECORDS ST1314.2 +008500*C DATA RECORD R2 ST1314.2 +008600 . ST1314.2 +008700 01 R2. ST1314.2 +008800 02 R2-KEYS. ST1314.2 +008900 03 R2-1 PICTURE 999. ST1314.2 +009000 03 R2-2 PICTURE AA. ST1314.2 +009100 03 R2-3 PICTURE AA. ST1314.2 +009200 02 FILLER PICTURE X(113). ST1314.2 +009300 FD FILE3 ST1314.2 +009400 BLOCK CONTAINS 10 RECORDS ST1314.2 +009500*C LABEL RECORDS ARE STANDARD ST1314.2 +009600*C VALUE OF ST1314.2 +009700*C OCLABELID ST1314.2 +009800*C IS ST1314.2 +009900*C "OCDUMMY" ST1314.2 +010000*C DATA RECORD IS R3 ST1314.2 +010100 . ST1314.2 +010200 01 R3. ST1314.2 +010300 02 R3-KEYS. ST1314.2 +010400 03 R3-1 PICTURE 999. ST1314.2 +010500 03 R3-2 PICTURE AA. ST1314.2 +010600 03 R3-3 PICTURE AA. ST1314.2 +010700 03 R3-4 PICTURE 9999. ST1314.2 +010800 02 FILLER PICTURE X(109). ST1314.2 +010900 SD SORT1 ST1314.2 +011000 RECORD CONTAINS 120 CHARACTERS ST1314.2 +011100 DATA RECORD IS S1. ST1314.2 +011200 01 S1. ST1314.2 +011300 02 S1-KEYS. ST1314.2 +011400 03 S1-1 PICTURE 999. ST1314.2 +011500 03 S1-2 PICTURE AA. ST1314.2 +011600 02 FILLER PICTURE X(115). ST1314.2 +011700 SD SORT2 ST1314.2 +011800 RECORD 120 ST1314.2 +011900 DATA RECORD IS S2. ST1314.2 +012000 01 S2. ST1314.2 +012100 02 S2-KEYS. ST1314.2 +012200 03 S2-1 PICTURE 999. ST1314.2 +012300 03 S2-2 PICTURE AA. ST1314.2 +012400 03 S2-3 PICTURE AA. ST1314.2 +012500 02 FILLER PICTURE X(113). ST1314.2 +012600 SD SORT3 ST1314.2 +012700 RECORD 120 CHARACTERS ST1314.2 +012800 DATA RECORD S3. ST1314.2 +012900 01 S3. ST1314.2 +013000 02 S3-KEYS. ST1314.2 +013100 03 S3-1 PICTURE 999. ST1314.2 +013200 03 S3-2 PICTURE AA. ST1314.2 +013300 03 S3-3 PICTURE AA. ST1314.2 +013400 03 S3-4 PICTURE 9999. ST1314.2 +013500 02 FILLER PICTURE X(109). ST1314.2 +013600 WORKING-STORAGE SECTION. ST1314.2 +013700 77 SUBSCRIPT-1 PICTURE 99 COMPUTATIONAL VALUE ZERO. ST1314.2 +013800 77 C0 PICTURE 99 COMPUTATIONAL VALUE ZERO. ST1314.2 +013900 77 C1 PICTURE 99 COMPUTATIONAL VALUE 1. ST1314.2 +014000 77 CA PICTURE A VALUE "A". ST1314.2 +014100 77 CB PICTURE A VALUE "B". ST1314.2 +014200 01 ALPHA-TABLE. ST1314.2 +014300 02 ALPHA-TAB PICTURE IS A(25) VALUE IS "ABCDEFGHIJKLMNPQRSTUST1314.2 +014400- "VWXYZ". ST1314.2 +014500 02 ALPHA-TBL REDEFINES ALPHA-TAB PICTURE A OCCURS 25 TIMES. ST1314.2 +014600 01 W-KEYS. ST1314.2 +014700 02 W-S3-KEYS. ST1314.2 +014800 03 W-S2-KEYS. ST1314.2 +014900 04 W-S1-KEYS. ST1314.2 +015000 05 S1-1W PICTURE 999 VALUE 567. ST1314.2 +015100 05 S1-2W. ST1314.2 +015200 06 S1-2W-A PICTURE A. ST1314.2 +015300 06 S1-2W-B PICTURE A. ST1314.2 +015400 04 S2-3W. ST1314.2 +015500 05 S2-3W-A PICTURE A. ST1314.2 +015600 05 S2-3W-B PICTURE A. ST1314.2 +015700 03 S3-4W PICTURE 9999 VALUE 7051. ST1314.2 +015800 01 FILE-RECORD-INFORMATION-REC. ST1314.2 +015900 03 FILE-RECORD-INFO-SKELETON. ST1314.2 +016000 05 FILLER PICTURE X(48) VALUE ST1314.2 +016100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1314.2 +016200 05 FILLER PICTURE X(46) VALUE ST1314.2 +016300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1314.2 +016400 05 FILLER PICTURE X(26) VALUE ST1314.2 +016500 ",LFIL=000000,ORG= ,LBLR= ". ST1314.2 +016600 05 FILLER PICTURE X(37) VALUE ST1314.2 +016700 ",RECKEY= ". ST1314.2 +016800 05 FILLER PICTURE X(38) VALUE ST1314.2 +016900 ",ALTKEY1= ". ST1314.2 +017000 05 FILLER PICTURE X(38) VALUE ST1314.2 +017100 ",ALTKEY2= ". ST1314.2 +017200 05 FILLER PICTURE X(7) VALUE SPACE.ST1314.2 +017300 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1314.2 +017400 05 FILE-RECORD-INFO-P1-120. ST1314.2 +017500 07 FILLER PIC X(5). ST1314.2 +017600 07 XFILE-NAME PIC X(6). ST1314.2 +017700 07 FILLER PIC X(8). ST1314.2 +017800 07 XRECORD-NAME PIC X(6). ST1314.2 +017900 07 FILLER PIC X(1). ST1314.2 +018000 07 REELUNIT-NUMBER PIC 9(1). ST1314.2 +018100 07 FILLER PIC X(7). ST1314.2 +018200 07 XRECORD-NUMBER PIC 9(6). ST1314.2 +018300 07 FILLER PIC X(6). ST1314.2 +018400 07 UPDATE-NUMBER PIC 9(2). ST1314.2 +018500 07 FILLER PIC X(5). ST1314.2 +018600 07 ODO-NUMBER PIC 9(4). ST1314.2 +018700 07 FILLER PIC X(5). ST1314.2 +018800 07 XPROGRAM-NAME PIC X(5). ST1314.2 +018900 07 FILLER PIC X(7). ST1314.2 +019000 07 XRECORD-LENGTH PIC 9(6). ST1314.2 +019100 07 FILLER PIC X(7). ST1314.2 +019200 07 CHARS-OR-RECORDS PIC X(2). ST1314.2 +019300 07 FILLER PIC X(1). ST1314.2 +019400 07 XBLOCK-SIZE PIC 9(4). ST1314.2 +019500 07 FILLER PIC X(6). ST1314.2 +019600 07 RECORDS-IN-FILE PIC 9(6). ST1314.2 +019700 07 FILLER PIC X(5). ST1314.2 +019800 07 XFILE-ORGANIZATION PIC X(2). ST1314.2 +019900 07 FILLER PIC X(6). ST1314.2 +020000 07 XLABEL-TYPE PIC X(1). ST1314.2 +020100 05 FILE-RECORD-INFO-P121-240. ST1314.2 +020200 07 FILLER PIC X(8). ST1314.2 +020300 07 XRECORD-KEY PIC X(29). ST1314.2 +020400 07 FILLER PIC X(9). ST1314.2 +020500 07 ALTERNATE-KEY1 PIC X(29). ST1314.2 +020600 07 FILLER PIC X(9). ST1314.2 +020700 07 ALTERNATE-KEY2 PIC X(29). ST1314.2 +020800 07 FILLER PIC X(7). ST1314.2 +020900 01 TEST-RESULTS. ST1314.2 +021000 02 FILLER PIC X VALUE SPACE. ST1314.2 +021100 02 FEATURE PIC X(20) VALUE SPACE. ST1314.2 +021200 02 FILLER PIC X VALUE SPACE. ST1314.2 +021300 02 P-OR-F PIC X(5) VALUE SPACE. ST1314.2 +021400 02 FILLER PIC X VALUE SPACE. ST1314.2 +021500 02 PAR-NAME. ST1314.2 +021600 03 FILLER PIC X(19) VALUE SPACE. ST1314.2 +021700 03 PARDOT-X PIC X VALUE SPACE. ST1314.2 +021800 03 DOTVALUE PIC 99 VALUE ZERO. ST1314.2 +021900 02 FILLER PIC X(8) VALUE SPACE. ST1314.2 +022000 02 RE-MARK PIC X(61). ST1314.2 +022100 01 TEST-COMPUTED. ST1314.2 +022200 02 FILLER PIC X(30) VALUE SPACE. ST1314.2 +022300 02 FILLER PIC X(17) VALUE ST1314.2 +022400 " COMPUTED=". ST1314.2 +022500 02 COMPUTED-X. ST1314.2 +022600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1314.2 +022700 03 COMPUTED-N REDEFINES COMPUTED-A ST1314.2 +022800 PIC -9(9).9(9). ST1314.2 +022900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1314.2 +023000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1314.2 +023100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1314.2 +023200 03 CM-18V0 REDEFINES COMPUTED-A. ST1314.2 +023300 04 COMPUTED-18V0 PIC -9(18). ST1314.2 +023400 04 FILLER PIC X. ST1314.2 +023500 03 FILLER PIC X(50) VALUE SPACE. ST1314.2 +023600 01 TEST-CORRECT. ST1314.2 +023700 02 FILLER PIC X(30) VALUE SPACE. ST1314.2 +023800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1314.2 +023900 02 CORRECT-X. ST1314.2 +024000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1314.2 +024100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1314.2 +024200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1314.2 +024300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1314.2 +024400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1314.2 +024500 03 CR-18V0 REDEFINES CORRECT-A. ST1314.2 +024600 04 CORRECT-18V0 PIC -9(18). ST1314.2 +024700 04 FILLER PIC X. ST1314.2 +024800 03 FILLER PIC X(2) VALUE SPACE. ST1314.2 +024900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1314.2 +025000 01 CCVS-C-1. ST1314.2 +025100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1314.2 +025200- "SS PARAGRAPH-NAME ST1314.2 +025300- " REMARKS". ST1314.2 +025400 02 FILLER PIC X(20) VALUE SPACE. ST1314.2 +025500 01 CCVS-C-2. ST1314.2 +025600 02 FILLER PIC X VALUE SPACE. ST1314.2 +025700 02 FILLER PIC X(6) VALUE "TESTED". ST1314.2 +025800 02 FILLER PIC X(15) VALUE SPACE. ST1314.2 +025900 02 FILLER PIC X(4) VALUE "FAIL". ST1314.2 +026000 02 FILLER PIC X(94) VALUE SPACE. ST1314.2 +026100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1314.2 +026200 01 REC-CT PIC 99 VALUE ZERO. ST1314.2 +026300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1314.2 +026400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1314.2 +026500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1314.2 +026600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1314.2 +026700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1314.2 +026800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1314.2 +026900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1314.2 +027000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1314.2 +027100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1314.2 +027200 01 CCVS-H-1. ST1314.2 +027300 02 FILLER PIC X(39) VALUE SPACES. ST1314.2 +027400 02 FILLER PIC X(42) VALUE ST1314.2 +027500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1314.2 +027600 02 FILLER PIC X(39) VALUE SPACES. ST1314.2 +027700 01 CCVS-H-2A. ST1314.2 +027800 02 FILLER PIC X(40) VALUE SPACE. ST1314.2 +027900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1314.2 +028000 02 FILLER PIC XXXX VALUE ST1314.2 +028100 "4.2 ". ST1314.2 +028200 02 FILLER PIC X(28) VALUE ST1314.2 +028300 " COPY - NOT FOR DISTRIBUTION". ST1314.2 +028400 02 FILLER PIC X(41) VALUE SPACE. ST1314.2 +028500 ST1314.2 +028600 01 CCVS-H-2B. ST1314.2 +028700 02 FILLER PIC X(15) VALUE ST1314.2 +028800 "TEST RESULT OF ". ST1314.2 +028900 02 TEST-ID PIC X(9). ST1314.2 +029000 02 FILLER PIC X(4) VALUE ST1314.2 +029100 " IN ". ST1314.2 +029200 02 FILLER PIC X(12) VALUE ST1314.2 +029300 " HIGH ". ST1314.2 +029400 02 FILLER PIC X(22) VALUE ST1314.2 +029500 " LEVEL VALIDATION FOR ". ST1314.2 +029600 02 FILLER PIC X(58) VALUE ST1314.2 +029700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1314.2 +029800 01 CCVS-H-3. ST1314.2 +029900 02 FILLER PIC X(34) VALUE ST1314.2 +030000 " FOR OFFICIAL USE ONLY ". ST1314.2 +030100 02 FILLER PIC X(58) VALUE ST1314.2 +030200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1314.2 +030300 02 FILLER PIC X(28) VALUE ST1314.2 +030400 " COPYRIGHT 1985 ". ST1314.2 +030500 01 CCVS-E-1. ST1314.2 +030600 02 FILLER PIC X(52) VALUE SPACE. ST1314.2 +030700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1314.2 +030800 02 ID-AGAIN PIC X(9). ST1314.2 +030900 02 FILLER PIC X(45) VALUE SPACES. ST1314.2 +031000 01 CCVS-E-2. ST1314.2 +031100 02 FILLER PIC X(31) VALUE SPACE. ST1314.2 +031200 02 FILLER PIC X(21) VALUE SPACE. ST1314.2 +031300 02 CCVS-E-2-2. ST1314.2 +031400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1314.2 +031500 03 FILLER PIC X VALUE SPACE. ST1314.2 +031600 03 ENDER-DESC PIC X(44) VALUE ST1314.2 +031700 "ERRORS ENCOUNTERED". ST1314.2 +031800 01 CCVS-E-3. ST1314.2 +031900 02 FILLER PIC X(22) VALUE ST1314.2 +032000 " FOR OFFICIAL USE ONLY". ST1314.2 +032100 02 FILLER PIC X(12) VALUE SPACE. ST1314.2 +032200 02 FILLER PIC X(58) VALUE ST1314.2 +032300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1314.2 +032400 02 FILLER PIC X(13) VALUE SPACE. ST1314.2 +032500 02 FILLER PIC X(15) VALUE ST1314.2 +032600 " COPYRIGHT 1985". ST1314.2 +032700 01 CCVS-E-4. ST1314.2 +032800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1314.2 +032900 02 FILLER PIC X(4) VALUE " OF ". ST1314.2 +033000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1314.2 +033100 02 FILLER PIC X(40) VALUE ST1314.2 +033200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1314.2 +033300 01 XXINFO. ST1314.2 +033400 02 FILLER PIC X(19) VALUE ST1314.2 +033500 "*** INFORMATION ***". ST1314.2 +033600 02 INFO-TEXT. ST1314.2 +033700 04 FILLER PIC X(8) VALUE SPACE. ST1314.2 +033800 04 XXCOMPUTED PIC X(20). ST1314.2 +033900 04 FILLER PIC X(5) VALUE SPACE. ST1314.2 +034000 04 XXCORRECT PIC X(20). ST1314.2 +034100 02 INF-ANSI-REFERENCE PIC X(48). ST1314.2 +034200 01 HYPHEN-LINE. ST1314.2 +034300 02 FILLER PIC IS X VALUE IS SPACE. ST1314.2 +034400 02 FILLER PIC IS X(65) VALUE IS "************************ST1314.2 +034500- "*****************************************". ST1314.2 +034600 02 FILLER PIC IS X(54) VALUE IS "************************ST1314.2 +034700- "******************************". ST1314.2 +034800 01 CCVS-PGM-ID PIC X(9) VALUE ST1314.2 +034900 "ST131A". ST1314.2 +035000 PROCEDURE DIVISION. ST1314.2 +035100 CCVS1 SECTION. ST1314.2 +035200 OPEN-FILES. ST1314.2 +035300 OPEN OUTPUT PRINT-FILE. ST1314.2 +035400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1314.2 +035500 MOVE SPACE TO TEST-RESULTS. ST1314.2 +035600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1314.2 +035700 GO TO CCVS1-EXIT. ST1314.2 +035800 CLOSE-FILES. ST1314.2 +035900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1314.2 +036000 TERMINATE-CCVS. ST1314.2 +036100*S EXIT PROGRAM. ST1314.2 +036200*SERMINATE-CALL. ST1314.2 +036300 STOP RUN. ST1314.2 +036400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1314.2 +036500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1314.2 +036600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1314.2 +036700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1314.2 +036800 MOVE "****TEST DELETED****" TO RE-MARK. ST1314.2 +036900 PRINT-DETAIL. ST1314.2 +037000 IF REC-CT NOT EQUAL TO ZERO ST1314.2 +037100 MOVE "." TO PARDOT-X ST1314.2 +037200 MOVE REC-CT TO DOTVALUE. ST1314.2 +037300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1314.2 +037400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1314.2 +037500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1314.2 +037600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1314.2 +037700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1314.2 +037800 MOVE SPACE TO CORRECT-X. ST1314.2 +037900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1314.2 +038000 MOVE SPACE TO RE-MARK. ST1314.2 +038100 HEAD-ROUTINE. ST1314.2 +038200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +038300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +038400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1314.2 +038500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1314.2 +038600 COLUMN-NAMES-ROUTINE. ST1314.2 +038700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +038800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +038900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +039000 END-ROUTINE. ST1314.2 +039100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1314.2 +039200 END-RTN-EXIT. ST1314.2 +039300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +039400 END-ROUTINE-1. ST1314.2 +039500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1314.2 +039600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1314.2 +039700 ADD PASS-COUNTER TO ERROR-HOLD. ST1314.2 +039800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1314.2 +039900 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1314.2 +040000 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1314.2 +040100 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1314.2 +040200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1314.2 +040300 END-ROUTINE-12. ST1314.2 +040400 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1314.2 +040500 IF ERROR-COUNTER IS EQUAL TO ZERO ST1314.2 +040600 MOVE "NO " TO ERROR-TOTAL ST1314.2 +040700 ELSE ST1314.2 +040800 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1314.2 +040900 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1314.2 +041000 PERFORM WRITE-LINE. ST1314.2 +041100 END-ROUTINE-13. ST1314.2 +041200 IF DELETE-COUNTER IS EQUAL TO ZERO ST1314.2 +041300 MOVE "NO " TO ERROR-TOTAL ELSE ST1314.2 +041400 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1314.2 +041500 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1314.2 +041600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +041700 IF INSPECT-COUNTER EQUAL TO ZERO ST1314.2 +041800 MOVE "NO " TO ERROR-TOTAL ST1314.2 +041900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1314.2 +042000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1314.2 +042100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +042200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1314.2 +042300 WRITE-LINE. ST1314.2 +042400 ADD 1 TO RECORD-COUNT. ST1314.2 +042500 IF RECORD-COUNT GREATER 42 ST1314.2 +042600 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1314.2 +042700 MOVE SPACE TO DUMMY-RECORD ST1314.2 +042800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1314.2 +042900 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1314.2 +043000 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1314.2 +043100 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1314.2 +043200 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1314.2 +043300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1314.2 +043400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1314.2 +043500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1314.2 +043600 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1314.2 +043700 MOVE ZERO TO RECORD-COUNT. ST1314.2 +043800 PERFORM WRT-LN. ST1314.2 +043900 WRT-LN. ST1314.2 +044000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1314.2 +044100 MOVE SPACE TO DUMMY-RECORD. ST1314.2 +044200 BLANK-LINE-PRINT. ST1314.2 +044300 PERFORM WRT-LN. ST1314.2 +044400 FAIL-ROUTINE. ST1314.2 +044500 IF COMPUTED-X NOT EQUAL TO SPACE ST1314.2 +044600 GO TO FAIL-ROUTINE-WRITE. ST1314.2 +044700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1314.2 +044800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1314.2 +044900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1314.2 +045000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +045100 MOVE SPACES TO INF-ANSI-REFERENCE. ST1314.2 +045200 GO TO FAIL-ROUTINE-EX. ST1314.2 +045300 FAIL-ROUTINE-WRITE. ST1314.2 +045400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1314.2 +045500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1314.2 +045600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1314.2 +045700 MOVE SPACES TO COR-ANSI-REFERENCE. ST1314.2 +045800 FAIL-ROUTINE-EX. EXIT. ST1314.2 +045900 BAIL-OUT. ST1314.2 +046000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1314.2 +046100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1314.2 +046200 BAIL-OUT-WRITE. ST1314.2 +046300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1314.2 +046400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1314.2 +046500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1314.2 +046600 MOVE SPACES TO INF-ANSI-REFERENCE. ST1314.2 +046700 BAIL-OUT-EX. EXIT. ST1314.2 +046800 CCVS1-EXIT. ST1314.2 +046900 EXIT. ST1314.2 +047000 P1-CREATE-F1. ST1314.2 +047100 OPEN OUTPUT FILE1. ST1314.2 +047200 MOVE CA TO S1-2W-A. ST1314.2 +047300 MOVE CB TO S2-3W-A. ST1314.2 +047400 P2-CREATE-F1. ST1314.2 +047500 PERFORM P4-CREATE-F1 2 TIMES. ST1314.2 +047600 P3-CREATE-F1. ST1314.2 +047700 MOVE CA TO S2-3W-A. ST1314.2 +047800 PERFORM P4-CREATE-F1 2 TIMES. ST1314.2 +047900 CLOSE FILE1. ST1314.2 +048000 GO TO FIRST-SORT. ST1314.2 +048100 P4-CREATE-F1. ST1314.2 +048200 MOVE C0 TO SUBSCRIPT-1. ST1314.2 +048300 PERFORM P5-CREATE-F1 25 TIMES. ST1314.2 +048400 P5-CREATE-F1. ST1314.2 +048500 ADD C1 TO SUBSCRIPT-1. ST1314.2 +048600 SUBTRACT C1 FROM S3-4W. ST1314.2 +048700 MOVE ALPHA-TBL (SUBSCRIPT-1) TO S1-2W-B S2-3W-B. ST1314.2 +048800 MOVE W-S3-KEYS TO R1. ST1314.2 +048900 WRITE R1. ST1314.2 +049000 F1-NOTE. ST1314.2 +049100* NOTE. ST1314.2 +049200* KEY-1 WILL BE 567 IN ALL RECORDS. ST1314.2 +049300* KEY-2 WILL BE >A> IN FIRST LETTER WITH 4 OCCURRENCES OF THEST1314.2 +049400* ALPHABET IN THE SECOND LETTER. ST1314.2 +049500* KEY-3 WILL BE >A> OR >B> IN FIRST LETTER WITH 2 OCCURRENCESST1314.2 +049600* OF THE ALPHABET FOR EACH IN THE SECOND LETTER. ST1314.2 +049700* KEY-4 WILL VARY FROM 7050 THRU 6951. ST1314.2 +049800* THE LETTER "O" HAS BEEN OMITTED. ST1314.2 +049900 SRT-1 SECTION. ST1314.2 +050000 FIRST-SORT. ST1314.2 +050100 SORT SORT1 ST1314.2 +050200 ON DESCENDING KEY S1-1 ST1314.2 +050300 ON ASCENDING KEY S1-2 ST1314.2 +050400 USING FILE1 ST1314.2 +050500 GIVING FILE2. ST1314.2 +050600* NOTE SORT STATEMENT WITH ALL OPTIONAL WORDS. ST1314.2 +050700* NOTE OUTPUT WILL BE TESTED IN THE FOLLOWING INPUT PROCEDURE. ST1314.2 +050800 SRT-2 SECTION. ST1314.2 +050900 SECOND-SORT. ST1314.2 +051000 SORT SORT2 ST1314.2 +051100 ASCENDING S2-1 ST1314.2 +051200 DESCENDING S2-2 ST1314.2 +051300 ASCENDING S2-3 ST1314.2 +051400 INPUT PROCEDURE SRT-2-INPUT ST1314.2 +051500 GIVING FILE3. ST1314.2 +051600* NOTE SORT STATEMENT WITH ALL OPTIONAL WORDS OMITTED. ST1314.2 +051700 GO TO SRT-3. ST1314.2 +051800 SRT-2-INPUT SECTION. ST1314.2 +051900 OPEN-1. ST1314.2 +052000 OPEN INPUT FILE2. ST1314.2 +052100 MOVE "SORT, INPUT PROC" TO FEATURE. ST1314.2 +052200 SORT-TEST-1. ST1314.2 +052300 PERFORM READ-RELEASE-FILE2. ST1314.2 +052400 IF W-S1-KEYS EQUAL TO "567AA" ST1314.2 +052500 PERFORM PASS-1 GO TO SORT-WRITE-1. ST1314.2 +052600 GO TO SORT-FAIL-1. ST1314.2 +052700 SORT-DELETE-1. ST1314.2 +052800 PERFORM DE-LETE-1. ST1314.2 +052900 GO TO SORT-WRITE-1. ST1314.2 +053000 SORT-FAIL-1. ST1314.2 +053100 MOVE W-S1-KEYS TO COMPUTED-A. ST1314.2 +053200 MOVE "567AA" TO CORRECT-A. ST1314.2 +053300 PERFORM FAIL-1. ST1314.2 +053400 SORT-WRITE-1. ST1314.2 +053500 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1314.2 +053600 PERFORM PRINT-DETAIL-1. ST1314.2 +053700 SORT-TEST-2. ST1314.2 +053800 PERFORM READ-RELEASE-FILE2 35 TIMES. ST1314.2 +053900 IF W-S1-KEYS EQUAL TO "567AI" ST1314.2 +054000 PERFORM PASS-1 GO TO SORT-WRITE-2. ST1314.2 +054100 GO TO SORT-FAIL-2. ST1314.2 +054200 SORT-DELETE-2. ST1314.2 +054300 PERFORM DE-LETE-1. ST1314.2 +054400 GO TO SORT-WRITE-2. ST1314.2 +054500 SORT-FAIL-2. ST1314.2 +054600 MOVE W-S1-KEYS TO COMPUTED-A. ST1314.2 +054700 MOVE "567AI" TO CORRECT-A. ST1314.2 +054800 PERFORM FAIL-1. ST1314.2 +054900 SORT-WRITE-2. ST1314.2 +055000 MOVE "SORT-TEST-2 " TO PAR-NAME. ST1314.2 +055100 PERFORM PRINT-DETAIL-1. ST1314.2 +055200 SORT-TEST-3. ST1314.2 +055300 PERFORM READ-RELEASE-FILE2 35 TIMES. ST1314.2 +055400 IF W-S1-KEYS EQUAL TO "567AS" ST1314.2 +055500 PERFORM PASS-1 GO TO SORT-WRITE-3. ST1314.2 +055600 GO TO SORT-FAIL-3. ST1314.2 +055700 SORT-DELETE-3. ST1314.2 +055800 PERFORM DE-LETE-1. ST1314.2 +055900 GO TO SORT-WRITE-3. ST1314.2 +056000 SORT-FAIL-3. ST1314.2 +056100 MOVE W-S1-KEYS TO COMPUTED-A. ST1314.2 +056200 MOVE "567AS" TO CORRECT-A. ST1314.2 +056300 PERFORM FAIL-1. ST1314.2 +056400 SORT-WRITE-3. ST1314.2 +056500 MOVE "SORT-TEST-3 " TO PAR-NAME. ST1314.2 +056600 PERFORM PRINT-DETAIL-1. ST1314.2 +056700 SORT-TEST-4. ST1314.2 +056800 PERFORM READ-RELEASE-FILE2 29 TIMES. ST1314.2 +056900 IF W-S1-KEYS EQUAL TO "567AZ" ST1314.2 +057000 PERFORM PASS-1 GO TO SORT-WRITE-4. ST1314.2 +057100 GO TO SORT-FAIL-4. ST1314.2 +057200 SORT-DELETE-4. ST1314.2 +057300 PERFORM DE-LETE-1. ST1314.2 +057400 GO TO SORT-WRITE-4. ST1314.2 +057500 SORT-FAIL-4. ST1314.2 +057600 MOVE W-S1-KEYS TO COMPUTED-A. ST1314.2 +057700 MOVE "567AZ" TO CORRECT-A. ST1314.2 +057800 PERFORM FAIL-1. ST1314.2 +057900 SORT-WRITE-4. ST1314.2 +058000 MOVE "SORT-TEST-4 " TO PAR-NAME. ST1314.2 +058100 PERFORM PRINT-DETAIL-1. ST1314.2 +058200 CLOSE-1. ST1314.2 +058300 CLOSE FILE2. ST1314.2 +058400 GO TO EXIT-1. ST1314.2 +058500 READ-RELEASE-FILE2. ST1314.2 +058600 READ FILE2 AT END GO TO TERMINAL-1. ST1314.2 +058700 MOVE R2 TO W-S3-KEYS. ST1314.2 +058800 RELEASE S2 FROM R2. ST1314.2 +058900 TERMINAL-1. ST1314.2 +059000 PERFORM FAIL-1. ST1314.2 +059100 MOVE "TERMINAL-1" TO PAR-NAME. ST1314.2 +059200 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1314.2 +059300 PERFORM PRINT-DETAIL-1. ST1314.2 +059400 MOVE SPACE TO FEATURE. ST1314.2 +059500 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1314.2 +059600 PERFORM PRINT-DETAIL-1. ST1314.2 +059700 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. ST1314.2 +059800 PERFORM PRINT-DETAIL-1. ST1314.2 +059900 GO TO CLOSE-1. ST1314.2 +060000 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1314.2 +060100 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1314.2 +060200 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1314.2 +060300 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1314.2 +060400 MOVE "****TEST DELETED****" TO RE-MARK. ST1314.2 +060500 PRINT-DETAIL-1. ST1314.2 +060600 IF REC-CT NOT EQUAL TO ZERO ST1314.2 +060700 MOVE "." TO PARDOT-X ST1314.2 +060800 MOVE REC-CT TO DOTVALUE. ST1314.2 +060900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1314.2 +061000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1314.2 +061100 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1314.2 +061200 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1314.2 +061300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1314.2 +061400 MOVE SPACE TO CORRECT-X. ST1314.2 +061500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1314.2 +061600 MOVE SPACE TO RE-MARK. ST1314.2 +061700 WRITE-LINE-1. ST1314.2 +061800 ADD 1 TO RECORD-COUNT. ST1314.2 +061900 IF RECORD-COUNT GREATER 50 ST1314.2 +062000 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1314.2 +062100 MOVE SPACE TO DUMMY-RECORD ST1314.2 +062200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1314.2 +062300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1314.2 +062400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1314.2 +062500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1314.2 +062600 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1314.2 +062700 MOVE ZERO TO RECORD-COUNT. ST1314.2 +062800 PERFORM WRT-LN-1. ST1314.2 +062900 WRT-LN-1. ST1314.2 +063000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1314.2 +063100 MOVE SPACE TO DUMMY-RECORD. ST1314.2 +063200 BLANK-LINE-PRINT-1. ST1314.2 +063300 PERFORM WRT-LN-1. ST1314.2 +063400 FAIL-ROUTINE-1. ST1314.2 +063500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1314.2 +063600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1314.2 +063700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1314.2 +063800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1314.2 +063900 GO TO FAIL-ROUTINE-EX-1. ST1314.2 +064000 FAIL-RTN-WRITE-1. ST1314.2 +064100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1314.2 +064200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1314.2 +064300 FAIL-ROUTINE-EX-1. EXIT. ST1314.2 +064400 BAIL-OUT-1. ST1314.2 +064500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1314.2 +064600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1314.2 +064700 BAIL-OUT-WRITE-1. ST1314.2 +064800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1314.2 +064900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1314.2 +065000 BAIL-OUT-EX-1. EXIT. ST1314.2 +065100 EXIT-1. ST1314.2 +065200 EXIT. ST1314.2 +065300 SRT-3 SECTION. ST1314.2 +065400 THIRD-SORT. ST1314.2 +065500 SORT SORT3 ST1314.2 +065600 ON DESCENDING KEY S3-1 S3-2 S3-3 ST1314.2 +065700 ASCENDING S3-4 ST1314.2 +065800 INPUT PROCEDURE IS SRT3-INPUT ST1314.2 +065900 OUTPUT PROCEDURE SRT3-OUTPUT-1 THRU SRT3-OUTPUT-2. ST1314.2 +066000 NOTE-SORT-3. ST1314.2 +066100* NOTE SORT STATEMENT WITH INCLUSION-OMISSION OF OPTIONAL ST1314.2 +066200* WORDS AND THRU OPTION. THE OUTPUT OF SRT-2 IS TESTED ST1314.2 +066300* IN THE INPUT PROCEDURE OF THIS (THIRD) SORT. THE OUTPUT ST1314.2 +066400* OF THE THIRD SORT IS TESTED IN THE OUTPUT PROCEDURE ST1314.2 +066500* WITHOUT THE GENERATION OF AN OUTPUT FILE. ST1314.2 +066600 END-FIRST-PROGRAM. ST1314.2 +066700 GO TO CCVS-EXIT. ST1314.2 +066800 SRT3-INPUT SECTION. ST1314.2 +066900 OPEN-2. ST1314.2 +067000 OPEN INPUT FILE3. ST1314.2 +067100 MOVE "SORT, INPUT PROC" TO FEATURE. ST1314.2 +067200 SORT-TEST-5. ST1314.2 +067300 PERFORM READ-RELEASE-FILE3. ST1314.2 +067400 MOVE R3-KEYS TO W-S3-KEYS. ST1314.2 +067500 IF W-S2-KEYS EQUAL TO "567AZAZ" ST1314.2 +067600 PERFORM PASS-2 GO TO SORT-WRITE-5. ST1314.2 +067700 GO TO SORT-FAIL-5. ST1314.2 +067800 SORT-DELETE-5. ST1314.2 +067900 PERFORM DE-LETE-2. ST1314.2 +068000 GO TO SORT-WRITE-5. ST1314.2 +068100 SORT-FAIL-5. ST1314.2 +068200 MOVE W-S2-KEYS TO COMPUTED-A. ST1314.2 +068300 MOVE "567AZAZ" TO CORRECT-A. ST1314.2 +068400 PERFORM FAIL-2. ST1314.2 +068500 SORT-WRITE-5. ST1314.2 +068600 MOVE "SORT-TEST-5 " TO PAR-NAME. ST1314.2 +068700 PERFORM PRINT-DETAIL-2. ST1314.2 +068800 SORT-TEST-6. ST1314.2 +068900 PERFORM READ-RELEASE-FILE3 35 TIMES. ST1314.2 +069000 MOVE R3-KEYS TO W-S3-KEYS. ST1314.2 +069100 IF W-S2-KEYS EQUAL TO "567ARBR" ST1314.2 +069200 PERFORM PASS-2 GO TO SORT-WRITE-6. ST1314.2 +069300 GO TO SORT-FAIL-6. ST1314.2 +069400 SORT-DELETE-6. ST1314.2 +069500 PERFORM DE-LETE-2. ST1314.2 +069600 GO TO SORT-WRITE-6. ST1314.2 +069700 SORT-FAIL-6. ST1314.2 +069800 MOVE W-S2-KEYS TO COMPUTED-A. ST1314.2 +069900 MOVE "567ARBR" TO CORRECT-A. ST1314.2 +070000 PERFORM FAIL-2. ST1314.2 +070100 SORT-WRITE-6. ST1314.2 +070200 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1314.2 +070300 PERFORM PRINT-DETAIL-2. ST1314.2 +070400 SORT-TEST-7. ST1314.2 +070500 PERFORM READ-RELEASE-FILE3 35 TIMES. ST1314.2 +070600 MOVE R3-KEYS TO W-S3-KEYS. ST1314.2 +070700 IF W-S2-KEYS EQUAL TO "567AHBH" ST1314.2 +070800 PERFORM PASS-2 GO TO SORT-WRITE-7. ST1314.2 +070900 GO TO SORT-FAIL-7. ST1314.2 +071000 SORT-DELETE-7. ST1314.2 +071100 PERFORM DE-LETE-2. ST1314.2 +071200 GO TO SORT-WRITE-7. ST1314.2 +071300 SORT-FAIL-7. ST1314.2 +071400 MOVE W-S2-KEYS TO COMPUTED-A. ST1314.2 +071500 MOVE "567AHBH" TO CORRECT-A. ST1314.2 +071600 PERFORM FAIL-2. ST1314.2 +071700 SORT-WRITE-7. ST1314.2 +071800 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1314.2 +071900 PERFORM PRINT-DETAIL-2. ST1314.2 +072000 SORT-TEST-8. ST1314.2 +072100 PERFORM READ-RELEASE-FILE3 29 TIMES. ST1314.2 +072200 MOVE R3-KEYS TO W-S3-KEYS. ST1314.2 +072300 IF W-S2-KEYS EQUAL TO "567AABA" ST1314.2 +072400 PERFORM PASS-2 GO TO SORT-WRITE-8. ST1314.2 +072500 GO TO SORT-FAIL-8. ST1314.2 +072600 SORT-DELETE-8. ST1314.2 +072700 PERFORM DE-LETE-2. ST1314.2 +072800 GO TO SORT-WRITE-8. ST1314.2 +072900 SORT-FAIL-8. ST1314.2 +073000 MOVE W-S2-KEYS TO COMPUTED-A. ST1314.2 +073100 MOVE "567AABA" TO CORRECT-A. ST1314.2 +073200 PERFORM FAIL-2. ST1314.2 +073300 SORT-WRITE-8. ST1314.2 +073400 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1314.2 +073500 PERFORM PRINT-DETAIL-2. ST1314.2 +073600 CLOSE-2. ST1314.2 +073700 CLOSE FILE3. ST1314.2 +073800 GO TO EXIT-2. ST1314.2 +073900 READ-RELEASE-FILE3. ST1314.2 +074000 READ FILE3 AT END GO TO TERMINAL-2. ST1314.2 +074100 RELEASE S3. ST1314.2 +074200* NOTE READ AND RELEASE ARE THE ONLY STATEMENTS NECESSARY ST1314.2 +074300* TO USE FILE3 AS INPUT TO THE THIRD SORT. THIS IS SINCE ST1314.2 +074400* THE RECORD AREAS ARE THE SAME FROM THE CLAUSE ST1314.2 +074500* SAME RECORD AREA SORT3 FILE3. ST1314.2 +074600 TERMINAL-2. ST1314.2 +074700 PERFORM FAIL-2. ST1314.2 +074800 MOVE "TERMINAL-2" TO PAR-NAME. ST1314.2 +074900 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1314.2 +075000 PERFORM PRINT-DETAIL-2. ST1314.2 +075100 MOVE SPACE TO FEATURE. ST1314.2 +075200 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1314.2 +075300 PERFORM PRINT-DETAIL-2. ST1314.2 +075400 MOVE "LAST SUCCESSFUL TEST" TO RE-MARK. ST1314.2 +075500 PERFORM PRINT-DETAIL-2. ST1314.2 +075600 GO TO CLOSE-2. ST1314.2 +075700 INSPT-2. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1314.2 +075800 PASS-2. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1314.2 +075900 FAIL-2. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1314.2 +076000 DE-LETE-2. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1314.2 +076100 MOVE "****TEST DELETED****" TO RE-MARK. ST1314.2 +076200 PRINT-DETAIL-2. ST1314.2 +076300 IF REC-CT NOT EQUAL TO ZERO ST1314.2 +076400 MOVE "." TO PARDOT-X ST1314.2 +076500 MOVE REC-CT TO DOTVALUE. ST1314.2 +076600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-2. ST1314.2 +076700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-2 ST1314.2 +076800 PERFORM FAIL-ROUTINE-2 THRU FAIL-ROUTINE-EX-2 ST1314.2 +076900 ELSE PERFORM BAIL-OUT-2 THRU BAIL-OUT-EX-2. ST1314.2 +077000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1314.2 +077100 MOVE SPACE TO CORRECT-X. ST1314.2 +077200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1314.2 +077300 MOVE SPACE TO RE-MARK. ST1314.2 +077400 WRITE-LINE-2. ST1314.2 +077500 ADD 1 TO RECORD-COUNT. ST1314.2 +077600 IF RECORD-COUNT GREATER 50 ST1314.2 +077700 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1314.2 +077800 MOVE SPACE TO DUMMY-RECORD ST1314.2 +077900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1314.2 +078000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-2 ST1314.2 +078100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-2 2 TIMES ST1314.2 +078200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-2 ST1314.2 +078300 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1314.2 +078400 MOVE ZERO TO RECORD-COUNT. ST1314.2 +078500 PERFORM WRT-LN-2. ST1314.2 +078600 WRT-LN-2. ST1314.2 +078700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1314.2 +078800 MOVE SPACE TO DUMMY-RECORD. ST1314.2 +078900 BLANK-LINE-PRINT-2. ST1314.2 +079000 PERFORM WRT-LN-2. ST1314.2 +079100 FAIL-ROUTINE-2. ST1314.2 +079200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. ST1314.2 +079300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. ST1314.2 +079400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1314.2 +079500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. ST1314.2 +079600 GO TO FAIL-ROUTINE-EX-2. ST1314.2 +079700 FAIL-RTN-WRITE-2. ST1314.2 +079800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-2 ST1314.2 +079900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-2 2 TIMES. ST1314.2 +080000 FAIL-ROUTINE-EX-2. EXIT. ST1314.2 +080100 BAIL-OUT-2. ST1314.2 +080200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-2. ST1314.2 +080300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-2. ST1314.2 +080400 BAIL-OUT-WRITE-2. ST1314.2 +080500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1314.2 +080600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. ST1314.2 +080700 BAIL-OUT-EX-2. EXIT. ST1314.2 +080800 EXIT-2. ST1314.2 +080900 EXIT. ST1314.2 +081000 SRT3-OUTPUT-1 SECTION. ST1314.2 +081100 INIT-3. ST1314.2 +081200 MOVE "SORT, OUTPUT PROC" TO FEATURE. ST1314.2 +081300 SORT-TEST-9. ST1314.2 +081400 PERFORM RETURN-SORT3. ST1314.2 +081500 IF S3-KEYS EQUAL TO "567AZBZ7001" ST1314.2 +081600 PERFORM PASS-3 GO TO SORT-WRITE-9. ST1314.2 +081700 GO TO SORT-FAIL-9. ST1314.2 +081800 SORT-DELETE-9. ST1314.2 +081900 PERFORM DE-LETE-3. ST1314.2 +082000 GO TO SORT-WRITE-9. ST1314.2 +082100 SORT-FAIL-9. ST1314.2 +082200 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +082300 MOVE "567AZBZ7001" TO CORRECT-A. ST1314.2 +082400 PERFORM FAIL-3. ST1314.2 +082500 SORT-WRITE-9. ST1314.2 +082600 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1314.2 +082700 PERFORM PRINT-DETAIL-3. ST1314.2 +082800 SORT-TEST-10. ST1314.2 +082900 PERFORM RETURN-SORT3. ST1314.2 +083000 IF S3-KEYS EQUAL TO "567AZBZ7026" ST1314.2 +083100 PERFORM PASS-3 GO TO SORT-WRITE-10. ST1314.2 +083200 GO TO SORT-FAIL-10. ST1314.2 +083300 SORT-DELETE-10. ST1314.2 +083400 PERFORM DE-LETE-3. ST1314.2 +083500 GO TO SORT-WRITE-10. ST1314.2 +083600 SORT-FAIL-10. ST1314.2 +083700 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +083800 MOVE "567AZBZ7026" TO CORRECT-A. ST1314.2 +083900 PERFORM FAIL-3. ST1314.2 +084000 SORT-WRITE-10. ST1314.2 +084100 MOVE "SORT-TEST-10" TO PAR-NAME. ST1314.2 +084200 PERFORM PRINT-DETAIL-3. ST1314.2 +084300 SORT-TEST-11. ST1314.2 +084400 PERFORM RETURN-SORT3 35 TIMES. ST1314.2 +084500 IF S3-KEYS EQUAL TO "567AQBQ7010" ST1314.2 +084600 PERFORM PASS-3 GO TO SORT-WRITE-11. ST1314.2 +084700 GO TO SORT-FAIL-11. ST1314.2 +084800 SORT-DELETE-11. ST1314.2 +084900 PERFORM DE-LETE-3. ST1314.2 +085000 GO TO SORT-WRITE-11. ST1314.2 +085100 SORT-FAIL-11. ST1314.2 +085200 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +085300 MOVE "567AQBQ7010" TO CORRECT-A. ST1314.2 +085400 PERFORM FAIL-3. ST1314.2 +085500 SORT-WRITE-11. ST1314.2 +085600 MOVE "SORT-TEST-11" TO PAR-NAME. ST1314.2 +085700 PERFORM PRINT-DETAIL-3. ST1314.2 +085800 SORT-TEST-12. ST1314.2 +085900 PERFORM RETURN-SORT3. ST1314.2 +086000 IF S3-KEYS EQUAL TO "567AQBQ7035" ST1314.2 +086100 PERFORM PASS-3 GO TO SORT-WRITE-12. ST1314.2 +086200 GO TO SORT-FAIL-12. ST1314.2 +086300 SORT-DELETE-12. ST1314.2 +086400 PERFORM DE-LETE-3. ST1314.2 +086500 GO TO SORT-WRITE-12. ST1314.2 +086600 SORT-FAIL-12. ST1314.2 +086700 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +086800 MOVE "567AQBQ7035" TO CORRECT-A. ST1314.2 +086900 PERFORM FAIL-3. ST1314.2 +087000 SORT-WRITE-12. ST1314.2 +087100 MOVE "SORT-TEST-12" TO PAR-NAME. ST1314.2 +087200 PERFORM PRINT-DETAIL-3. ST1314.2 +087300 SORT-TEST-13. ST1314.2 +087400 PERFORM RETURN-SORT3 35 TIMES. ST1314.2 +087500 IF S3-KEYS EQUAL TO "567AGBG7019" ST1314.2 +087600 PERFORM PASS-3 GO TO SORT-WRITE-13. ST1314.2 +087700 GO TO SORT-FAIL-13. ST1314.2 +087800 SORT-DELETE-13. ST1314.2 +087900 PERFORM DE-LETE-3. ST1314.2 +088000 GO TO SORT-WRITE-13. ST1314.2 +088100 SORT-FAIL-13. ST1314.2 +088200 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +088300 MOVE "567AGBG7019" TO CORRECT-A. ST1314.2 +088400 PERFORM FAIL-3. ST1314.2 +088500 SORT-WRITE-13. ST1314.2 +088600 MOVE "SORT-TEST-13" TO PAR-NAME. ST1314.2 +088700 PERFORM PRINT-DETAIL-3. ST1314.2 +088800 SORT-TEST-14. ST1314.2 +088900 PERFORM RETURN-SORT3 27 TIMES. ST1314.2 +089000 IF S3-KEYS EQUAL TO "567AAAA7000" ST1314.2 +089100 PERFORM PASS-3 GO TO SORT-WRITE-14. ST1314.2 +089200 GO TO SORT-FAIL-14. ST1314.2 +089300 SORT-DELETE-14. ST1314.2 +089400 PERFORM DE-LETE-3. ST1314.2 +089500 GO TO SORT-WRITE-14. ST1314.2 +089600 SORT-FAIL-14. ST1314.2 +089700 MOVE S3-KEYS TO COMPUTED-A. ST1314.2 +089800 MOVE "567AAAA7000" TO CORRECT-A. ST1314.2 +089900 PERFORM FAIL-3. ST1314.2 +090000 SORT-WRITE-14. ST1314.2 +090100 MOVE "SORT-TEST-14" TO PAR-NAME. ST1314.2 +090200 PERFORM PRINT-DETAIL-3. ST1314.2 +090300 SORT-TEST-15. ST1314.2 +090400 RETURN SORT3 RECORD AT END ST1314.2 +090500 PERFORM PASS-3 GO TO SORT-WRITE-15. ST1314.2 +090600* NOTE THE FOLLOWING SENTENCES SHOULD NOT BE EXECUTED. ST1314.2 +090700 PERFORM FAIL-3. ST1314.2 +090800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1314.2 +090900 GO TO SORT-WRITE-15. ST1314.2 +091000 SORT-DELETE-15. ST1314.2 +091100 PERFORM DE-LETE-3. ST1314.2 +091200 SORT-WRITE-15. ST1314.2 +091300 MOVE "SORT-TEST-15" TO PAR-NAME. ST1314.2 +091400 PERFORM PRINT-DETAIL-3. ST1314.2 +091500 CLOSE-3. ST1314.2 +091600 GO TO EXIT-3. ST1314.2 +091700 SRT3-OUTPUT-2 SECTION. ST1314.2 +091800 RETURN-SORT3. ST1314.2 +091900 RETURN SORT3 RECORD AT END GO TO TERMINAL-3. ST1314.2 +092000* NOTE RETURN VERB WITH ALL OPTIONS EXCEPT INTO. ST1314.2 +092100 TERMINAL-3. ST1314.2 +092200 PERFORM FAIL-3. ST1314.2 +092300 MOVE "TERMINAL-3" TO PAR-NAME. ST1314.2 +092400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1314.2 +092500 PERFORM PRINT-DETAIL-3. ST1314.2 +092600 MOVE SPACE TO FEATURE. ST1314.2 +092700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1314.2 +092800 PERFORM PRINT-DETAIL-3. ST1314.2 +092900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK ST1314.2 +093000 PERFORM PRINT-DETAIL-3. ST1314.2 +093100 GO TO CLOSE-3. ST1314.2 +093200 PASS-3. ST1314.2 +093300 MOVE "PASS" TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1314.2 +093400 FAIL-3. ST1314.2 +093500 ADD 1 TO ERROR-COUNTER. ST1314.2 +093600 MOVE "FAIL*" TO P-OR-F. ST1314.2 +093700 DE-LETE-3. ST1314.2 +093800 MOVE SPACE TO P-OR-F. ST1314.2 +093900 MOVE " ************ " TO COMPUTED-A. ST1314.2 +094000 MOVE " ************ " TO CORRECT-A. ST1314.2 +094100 MOVE "****TEST DELETED****" TO RE-MARK. ST1314.2 +094200 ADD 1 TO DELETE-COUNTER. ST1314.2 +094300 PRINT-DETAIL-3. ST1314.2 +094400 IF REC-CT NOT EQUAL TO ZERO ST1314.2 +094500 MOVE "." TO PARDOT-X ST1314.2 +094600 MOVE REC-CT TO DOTVALUE. ST1314.2 +094700 MOVE TEST-RESULTS TO PRINT-REC. ST1314.2 +094800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1314.2 +094900 MOVE SPACE TO P-OR-F. ST1314.2 +095000 MOVE SPACE TO COMPUTED-A. ST1314.2 +095100 MOVE SPACE TO CORRECT-A. ST1314.2 +095200 IF REC-CT EQUAL TO ZERO ST1314.2 +095300 MOVE SPACE TO PAR-NAME. ST1314.2 +095400 MOVE SPACE TO RE-MARK. ST1314.2 +095500 EXIT-3. ST1314.2 +095600 EXIT. ST1314.2 +095700 END-CCVS SECTION. ST1314.2 +095800 CCVS-EXIT SECTION. ST1314.2 +095900 CCVS-999999. ST1314.2 +096000 GO TO CLOSE-FILES. ST1314.2 diff --git a/tests/cobol85/ST/ST132A.CBL b/tests/cobol85/ST/ST132A.CBL new file mode 100755 index 00000000..645b9e63 --- /dev/null +++ b/tests/cobol85/ST/ST132A.CBL @@ -0,0 +1,743 @@ +000100 IDENTIFICATION DIVISION. ST1324.2 +000200 PROGRAM-ID. ST1324.2 +000300 ST132A. ST1324.2 +000400**************************************************************** ST1324.2 +000500* * ST1324.2 +000600* VALIDATION FOR:- * ST1324.2 +000700* * ST1324.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1324.2 +000900* * ST1324.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1324.2 +001100* * ST1324.2 +001200**************************************************************** ST1324.2 +001300* * ST1324.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1324.2 +001500* * ST1324.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1324.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1324.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1324.2 +001900* * ST1324.2 +002000**************************************************************** ST1324.2 +002100* ST1324.2 +002200* THIS PROGRAM EXERCISES THE FOLLOWING ST1324.2 +002300* SAME SORT AREA CLAUSE ST1324.2 +002400* USING-OUTPUT PROCEDURE COMBINATION ST1324.2 +002500* MULTI REEL SORT ST1324.2 +002600* RELEASE FROM ST1324.2 +002700* RETURN INTO. ST1324.2 +002800* THERE ARE 3 SORTS. THE FIRST GENERATES THE INPUT DATA IN THE ST1324.2 +002900* INPUT PROCEDURE. THE SORT RESULTS ARE TESTED IN THE ST1324.2 +003000* OUTPUT PROCEDURE WHICH ALSO CREATES A 2-REEL FILE (VIA ST1324.2 +003100* CLOSE REEL) FOR INPUT TO THE SECOND SORT. ST1324.2 +003200* THE SECOND SORT (USING-OUTPUT PROCEDURE) IS TESTED IN THE ST1324.2 +003300* OUTPUT PROCEDURE. ST1324.2 +003400* THE THIRD SORT EXERCISES A SORT-FILE FOR THE SECOND TIME. ST1324.2 +003500* SUCCESSFUL EXECUTION IS THE SOLE TEST OF THIS SORT. ST1324.2 +003600 ST1324.2 +003700 ENVIRONMENT DIVISION. ST1324.2 +003800 CONFIGURATION SECTION. ST1324.2 +003900 SOURCE-COMPUTER. ST1324.2 +004000 Linux. ST1324.2 +004100 OBJECT-COMPUTER. ST1324.2 +004200 Linux. ST1324.2 +004300 INPUT-OUTPUT SECTION. ST1324.2 +004400 FILE-CONTROL. ST1324.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1324.2 +004600 "report.log". ST1324.2 +004700 SELECT SORT4 ASSIGN TO ST1324.2 +004800 "XXXXX027". ST1324.2 +004900 SELECT SORT5 ASSIGN TO ST1324.2 +005000 "XXXXX028". ST1324.2 +005100 SELECT FILE4 ASSIGN TO ST1324.2 +005200 "XXXXX006". ST1324.2 +005300 I-O-CONTROL. ST1324.2 +005400 SAME SORT AREA FOR SORT5 SORT4. ST1324.2 +005500 DATA DIVISION. ST1324.2 +005600 FILE SECTION. ST1324.2 +005700 FD PRINT-FILE. ST1324.2 +005800 01 PRINT-REC PICTURE X(120). ST1324.2 +005900 01 DUMMY-RECORD PICTURE X(120). ST1324.2 +006000 FD FILE4 ST1324.2 +006100 BLOCK CONTAINS 10 RECORDS ST1324.2 +006200 LABEL RECORDS ARE STANDARD ST1324.2 +006300*C VALUE OF ST1324.2 +006400*C OCLABELID ST1324.2 +006500*C IS ST1324.2 +006600*C "OCDUMMY" ST1324.2 +006700*G SYSIN ST1324.2 +006800 DATA RECORD IS R4. ST1324.2 +006900 01 R4 PICTURE X(120). ST1324.2 +007000 SD SORT4 ST1324.2 +007100 RECORD CONTAINS 120 ST1324.2 +007200 DATA RECORD IS S4. ST1324.2 +007300 01 S4. ST1324.2 +007400 02 S4-KEYS. ST1324.2 +007500 03 S4-KEY1 PICTURE A(10). ST1324.2 +007600 03 S4-KEY2 PICTURE 9(10). ST1324.2 +007700 02 FILLER PICTURE X(100). ST1324.2 +007800 SD SORT5 ST1324.2 +007900 RECORD 120 ST1324.2 +008000 DATA RECORD S5. ST1324.2 +008100 01 S5. ST1324.2 +008200 02 S5-KEYS. ST1324.2 +008300 03 S5-KEY1 PICTURE A(10). ST1324.2 +008400 03 S5-KEY2 PICTURE 9(10). ST1324.2 +008500 02 FILLER PICTURE X(100). ST1324.2 +008600 WORKING-STORAGE SECTION. ST1324.2 +008700 77 C0 PICTURE 9 COMPUTATIONAL VALUE ZERO. ST1324.2 +008800 77 C1 PICTURE 9 COMPUTATIONAL VALUE 1. ST1324.2 +008900 77 SUBSCRIPT-1 PICTURE 99 COMPUTATIONAL VALUE ZERO. ST1324.2 +009000 77 SUBSCRIPT-2 PICTURE 99 COMPUTATIONAL. ST1324.2 +009100 01 ALPHA-TABLE. ST1324.2 +009200 02 ALPHA-TAB PICTURE A(25) ST1324.2 +009300 VALUE "ABCDEFGHIJKLMNPQRSTUVWXYZ". ST1324.2 +009400 02 ALPHA-TBL REDEFINES ALPHA-TAB PICTURE A OCCURS 25 TIMES. ST1324.2 +009500 01 WKEYS. ST1324.2 +009600 02 WKEY-1. ST1324.2 +009700 03 FILLER PICTURE AAA VALUE "PQR". ST1324.2 +009800 03 WKEY-1A PICTURE A. ST1324.2 +009900 03 FILLER PICTURE A(5) VALUE "ABCDE". ST1324.2 +010000 03 WKEY-1B PICTURE A. ST1324.2 +010100 02 WKEY-2. ST1324.2 +010200 03 FILLER PICTURE 9 VALUE 7. ST1324.2 +010300 03 WKEY-2A PICTURE 9 VALUE ZERO. ST1324.2 +010400 03 FILLER PICTURE 9(7) VALUE 1234567. ST1324.2 +010500 03 WKEY-2B PICTURE 9 VALUE ZERO. ST1324.2 +010600 02 FILLER PICTURE X(100). ST1324.2 +010700 01 FILE-RECORD-INFORMATION-REC. ST1324.2 +010800 03 FILE-RECORD-INFO-SKELETON. ST1324.2 +010900 05 FILLER PICTURE X(48) VALUE ST1324.2 +011000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1324.2 +011100 05 FILLER PICTURE X(46) VALUE ST1324.2 +011200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1324.2 +011300 05 FILLER PICTURE X(26) VALUE ST1324.2 +011400 ",LFIL=000000,ORG= ,LBLR= ". ST1324.2 +011500 05 FILLER PICTURE X(37) VALUE ST1324.2 +011600 ",RECKEY= ". ST1324.2 +011700 05 FILLER PICTURE X(38) VALUE ST1324.2 +011800 ",ALTKEY1= ". ST1324.2 +011900 05 FILLER PICTURE X(38) VALUE ST1324.2 +012000 ",ALTKEY2= ". ST1324.2 +012100 05 FILLER PICTURE X(7) VALUE SPACE.ST1324.2 +012200 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1324.2 +012300 05 FILE-RECORD-INFO-P1-120. ST1324.2 +012400 07 FILLER PIC X(5). ST1324.2 +012500 07 XFILE-NAME PIC X(6). ST1324.2 +012600 07 FILLER PIC X(8). ST1324.2 +012700 07 XRECORD-NAME PIC X(6). ST1324.2 +012800 07 FILLER PIC X(1). ST1324.2 +012900 07 REELUNIT-NUMBER PIC 9(1). ST1324.2 +013000 07 FILLER PIC X(7). ST1324.2 +013100 07 XRECORD-NUMBER PIC 9(6). ST1324.2 +013200 07 FILLER PIC X(6). ST1324.2 +013300 07 UPDATE-NUMBER PIC 9(2). ST1324.2 +013400 07 FILLER PIC X(5). ST1324.2 +013500 07 ODO-NUMBER PIC 9(4). ST1324.2 +013600 07 FILLER PIC X(5). ST1324.2 +013700 07 XPROGRAM-NAME PIC X(5). ST1324.2 +013800 07 FILLER PIC X(7). ST1324.2 +013900 07 XRECORD-LENGTH PIC 9(6). ST1324.2 +014000 07 FILLER PIC X(7). ST1324.2 +014100 07 CHARS-OR-RECORDS PIC X(2). ST1324.2 +014200 07 FILLER PIC X(1). ST1324.2 +014300 07 XBLOCK-SIZE PIC 9(4). ST1324.2 +014400 07 FILLER PIC X(6). ST1324.2 +014500 07 RECORDS-IN-FILE PIC 9(6). ST1324.2 +014600 07 FILLER PIC X(5). ST1324.2 +014700 07 XFILE-ORGANIZATION PIC X(2). ST1324.2 +014800 07 FILLER PIC X(6). ST1324.2 +014900 07 XLABEL-TYPE PIC X(1). ST1324.2 +015000 05 FILE-RECORD-INFO-P121-240. ST1324.2 +015100 07 FILLER PIC X(8). ST1324.2 +015200 07 XRECORD-KEY PIC X(29). ST1324.2 +015300 07 FILLER PIC X(9). ST1324.2 +015400 07 ALTERNATE-KEY1 PIC X(29). ST1324.2 +015500 07 FILLER PIC X(9). ST1324.2 +015600 07 ALTERNATE-KEY2 PIC X(29). ST1324.2 +015700 07 FILLER PIC X(7). ST1324.2 +015800 01 TEST-RESULTS. ST1324.2 +015900 02 FILLER PIC X VALUE SPACE. ST1324.2 +016000 02 FEATURE PIC X(20) VALUE SPACE. ST1324.2 +016100 02 FILLER PIC X VALUE SPACE. ST1324.2 +016200 02 P-OR-F PIC X(5) VALUE SPACE. ST1324.2 +016300 02 FILLER PIC X VALUE SPACE. ST1324.2 +016400 02 PAR-NAME. ST1324.2 +016500 03 FILLER PIC X(19) VALUE SPACE. ST1324.2 +016600 03 PARDOT-X PIC X VALUE SPACE. ST1324.2 +016700 03 DOTVALUE PIC 99 VALUE ZERO. ST1324.2 +016800 02 FILLER PIC X(8) VALUE SPACE. ST1324.2 +016900 02 RE-MARK PIC X(61). ST1324.2 +017000 01 TEST-COMPUTED. ST1324.2 +017100 02 FILLER PIC X(30) VALUE SPACE. ST1324.2 +017200 02 FILLER PIC X(17) VALUE ST1324.2 +017300 " COMPUTED=". ST1324.2 +017400 02 COMPUTED-X. ST1324.2 +017500 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1324.2 +017600 03 COMPUTED-N REDEFINES COMPUTED-A ST1324.2 +017700 PIC -9(9).9(9). ST1324.2 +017800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1324.2 +017900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1324.2 +018000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1324.2 +018100 03 CM-18V0 REDEFINES COMPUTED-A. ST1324.2 +018200 04 COMPUTED-18V0 PIC -9(18). ST1324.2 +018300 04 FILLER PIC X. ST1324.2 +018400 03 FILLER PIC X(50) VALUE SPACE. ST1324.2 +018500 01 TEST-CORRECT. ST1324.2 +018600 02 FILLER PIC X(30) VALUE SPACE. ST1324.2 +018700 02 FILLER PIC X(17) VALUE " CORRECT =". ST1324.2 +018800 02 CORRECT-X. ST1324.2 +018900 03 CORRECT-A PIC X(20) VALUE SPACE. ST1324.2 +019000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1324.2 +019100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1324.2 +019200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1324.2 +019300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1324.2 +019400 03 CR-18V0 REDEFINES CORRECT-A. ST1324.2 +019500 04 CORRECT-18V0 PIC -9(18). ST1324.2 +019600 04 FILLER PIC X. ST1324.2 +019700 03 FILLER PIC X(2) VALUE SPACE. ST1324.2 +019800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1324.2 +019900 01 CCVS-C-1. ST1324.2 +020000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1324.2 +020100- "SS PARAGRAPH-NAME ST1324.2 +020200- " REMARKS". ST1324.2 +020300 02 FILLER PIC X(20) VALUE SPACE. ST1324.2 +020400 01 CCVS-C-2. ST1324.2 +020500 02 FILLER PIC X VALUE SPACE. ST1324.2 +020600 02 FILLER PIC X(6) VALUE "TESTED". ST1324.2 +020700 02 FILLER PIC X(15) VALUE SPACE. ST1324.2 +020800 02 FILLER PIC X(4) VALUE "FAIL". ST1324.2 +020900 02 FILLER PIC X(94) VALUE SPACE. ST1324.2 +021000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1324.2 +021100 01 REC-CT PIC 99 VALUE ZERO. ST1324.2 +021200 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1324.2 +021300 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1324.2 +021400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1324.2 +021500 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1324.2 +021600 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1324.2 +021700 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1324.2 +021800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1324.2 +021900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1324.2 +022000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1324.2 +022100 01 CCVS-H-1. ST1324.2 +022200 02 FILLER PIC X(39) VALUE SPACES. ST1324.2 +022300 02 FILLER PIC X(42) VALUE ST1324.2 +022400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1324.2 +022500 02 FILLER PIC X(39) VALUE SPACES. ST1324.2 +022600 01 CCVS-H-2A. ST1324.2 +022700 02 FILLER PIC X(40) VALUE SPACE. ST1324.2 +022800 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1324.2 +022900 02 FILLER PIC XXXX VALUE ST1324.2 +023000 "4.2 ". ST1324.2 +023100 02 FILLER PIC X(28) VALUE ST1324.2 +023200 " COPY - NOT FOR DISTRIBUTION". ST1324.2 +023300 02 FILLER PIC X(41) VALUE SPACE. ST1324.2 +023400 ST1324.2 +023500 01 CCVS-H-2B. ST1324.2 +023600 02 FILLER PIC X(15) VALUE ST1324.2 +023700 "TEST RESULT OF ". ST1324.2 +023800 02 TEST-ID PIC X(9). ST1324.2 +023900 02 FILLER PIC X(4) VALUE ST1324.2 +024000 " IN ". ST1324.2 +024100 02 FILLER PIC X(12) VALUE ST1324.2 +024200 " HIGH ". ST1324.2 +024300 02 FILLER PIC X(22) VALUE ST1324.2 +024400 " LEVEL VALIDATION FOR ". ST1324.2 +024500 02 FILLER PIC X(58) VALUE ST1324.2 +024600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1324.2 +024700 01 CCVS-H-3. ST1324.2 +024800 02 FILLER PIC X(34) VALUE ST1324.2 +024900 " FOR OFFICIAL USE ONLY ". ST1324.2 +025000 02 FILLER PIC X(58) VALUE ST1324.2 +025100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1324.2 +025200 02 FILLER PIC X(28) VALUE ST1324.2 +025300 " COPYRIGHT 1985 ". ST1324.2 +025400 01 CCVS-E-1. ST1324.2 +025500 02 FILLER PIC X(52) VALUE SPACE. ST1324.2 +025600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1324.2 +025700 02 ID-AGAIN PIC X(9). ST1324.2 +025800 02 FILLER PIC X(45) VALUE SPACES. ST1324.2 +025900 01 CCVS-E-2. ST1324.2 +026000 02 FILLER PIC X(31) VALUE SPACE. ST1324.2 +026100 02 FILLER PIC X(21) VALUE SPACE. ST1324.2 +026200 02 CCVS-E-2-2. ST1324.2 +026300 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1324.2 +026400 03 FILLER PIC X VALUE SPACE. ST1324.2 +026500 03 ENDER-DESC PIC X(44) VALUE ST1324.2 +026600 "ERRORS ENCOUNTERED". ST1324.2 +026700 01 CCVS-E-3. ST1324.2 +026800 02 FILLER PIC X(22) VALUE ST1324.2 +026900 " FOR OFFICIAL USE ONLY". ST1324.2 +027000 02 FILLER PIC X(12) VALUE SPACE. ST1324.2 +027100 02 FILLER PIC X(58) VALUE ST1324.2 +027200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1324.2 +027300 02 FILLER PIC X(13) VALUE SPACE. ST1324.2 +027400 02 FILLER PIC X(15) VALUE ST1324.2 +027500 " COPYRIGHT 1985". ST1324.2 +027600 01 CCVS-E-4. ST1324.2 +027700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1324.2 +027800 02 FILLER PIC X(4) VALUE " OF ". ST1324.2 +027900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1324.2 +028000 02 FILLER PIC X(40) VALUE ST1324.2 +028100 " TESTS WERE EXECUTED SUCCESSFULLY". ST1324.2 +028200 01 XXINFO. ST1324.2 +028300 02 FILLER PIC X(19) VALUE ST1324.2 +028400 "*** INFORMATION ***". ST1324.2 +028500 02 INFO-TEXT. ST1324.2 +028600 04 FILLER PIC X(8) VALUE SPACE. ST1324.2 +028700 04 XXCOMPUTED PIC X(20). ST1324.2 +028800 04 FILLER PIC X(5) VALUE SPACE. ST1324.2 +028900 04 XXCORRECT PIC X(20). ST1324.2 +029000 02 INF-ANSI-REFERENCE PIC X(48). ST1324.2 +029100 01 HYPHEN-LINE. ST1324.2 +029200 02 FILLER PIC IS X VALUE IS SPACE. ST1324.2 +029300 02 FILLER PIC IS X(65) VALUE IS "************************ST1324.2 +029400- "*****************************************". ST1324.2 +029500 02 FILLER PIC IS X(54) VALUE IS "************************ST1324.2 +029600- "******************************". ST1324.2 +029700 01 CCVS-PGM-ID PIC X(9) VALUE ST1324.2 +029800 "ST132A". ST1324.2 +029900 PROCEDURE DIVISION. ST1324.2 +030000 CCVS1 SECTION. ST1324.2 +030100 OPEN-FILES. ST1324.2 +030200 OPEN OUTPUT PRINT-FILE. ST1324.2 +030300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1324.2 +030400 MOVE SPACE TO TEST-RESULTS. ST1324.2 +030500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1324.2 +030600 MOVE ZERO TO REC-SKL-SUB. ST1324.2 +030700 PERFORM CCVS-INIT-FILE 9 TIMES. ST1324.2 +030800 CCVS-INIT-FILE. ST1324.2 +030900 ADD 1 TO REC-SKL-SUB. ST1324.2 +031000 MOVE FILE-RECORD-INFO-SKELETON ST1324.2 +031100 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1324.2 +031200 CCVS-INIT-EXIT. ST1324.2 +031300 GO TO CCVS1-EXIT. ST1324.2 +031400 CLOSE-FILES. ST1324.2 +031500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1324.2 +031600 TERMINATE-CCVS. ST1324.2 +031700*S EXIT PROGRAM. ST1324.2 +031800*SERMINATE-CALL. ST1324.2 +031900 STOP RUN. ST1324.2 +032000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1324.2 +032100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1324.2 +032200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1324.2 +032300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1324.2 +032400 MOVE "****TEST DELETED****" TO RE-MARK. ST1324.2 +032500 PRINT-DETAIL. ST1324.2 +032600 IF REC-CT NOT EQUAL TO ZERO ST1324.2 +032700 MOVE "." TO PARDOT-X ST1324.2 +032800 MOVE REC-CT TO DOTVALUE. ST1324.2 +032900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1324.2 +033000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1324.2 +033100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1324.2 +033200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1324.2 +033300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1324.2 +033400 MOVE SPACE TO CORRECT-X. ST1324.2 +033500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1324.2 +033600 MOVE SPACE TO RE-MARK. ST1324.2 +033700 HEAD-ROUTINE. ST1324.2 +033800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +033900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +034000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1324.2 +034100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1324.2 +034200 COLUMN-NAMES-ROUTINE. ST1324.2 +034300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +034400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +034500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +034600 END-ROUTINE. ST1324.2 +034700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1324.2 +034800 END-RTN-EXIT. ST1324.2 +034900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +035000 END-ROUTINE-1. ST1324.2 +035100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1324.2 +035200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1324.2 +035300 ADD PASS-COUNTER TO ERROR-HOLD. ST1324.2 +035400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1324.2 +035500 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1324.2 +035600 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1324.2 +035700 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1324.2 +035800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1324.2 +035900 END-ROUTINE-12. ST1324.2 +036000 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1324.2 +036100 IF ERROR-COUNTER IS EQUAL TO ZERO ST1324.2 +036200 MOVE "NO " TO ERROR-TOTAL ST1324.2 +036300 ELSE ST1324.2 +036400 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1324.2 +036500 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1324.2 +036600 PERFORM WRITE-LINE. ST1324.2 +036700 END-ROUTINE-13. ST1324.2 +036800 IF DELETE-COUNTER IS EQUAL TO ZERO ST1324.2 +036900 MOVE "NO " TO ERROR-TOTAL ELSE ST1324.2 +037000 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1324.2 +037100 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1324.2 +037200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +037300 IF INSPECT-COUNTER EQUAL TO ZERO ST1324.2 +037400 MOVE "NO " TO ERROR-TOTAL ST1324.2 +037500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1324.2 +037600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1324.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +037800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1324.2 +037900 WRITE-LINE. ST1324.2 +038000 ADD 1 TO RECORD-COUNT. ST1324.2 +038100 IF RECORD-COUNT GREATER 42 ST1324.2 +038200 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1324.2 +038300 MOVE SPACE TO DUMMY-RECORD ST1324.2 +038400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1324.2 +038500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1324.2 +038600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1324.2 +038700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1324.2 +038800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1324.2 +038900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1324.2 +039000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1324.2 +039100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1324.2 +039200 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1324.2 +039300 MOVE ZERO TO RECORD-COUNT. ST1324.2 +039400 PERFORM WRT-LN. ST1324.2 +039500 WRT-LN. ST1324.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1324.2 +039700 MOVE SPACE TO DUMMY-RECORD. ST1324.2 +039800 BLANK-LINE-PRINT. ST1324.2 +039900 PERFORM WRT-LN. ST1324.2 +040000 FAIL-ROUTINE. ST1324.2 +040100 IF COMPUTED-X NOT EQUAL TO SPACE ST1324.2 +040200 GO TO FAIL-ROUTINE-WRITE. ST1324.2 +040300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1324.2 +040400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1324.2 +040500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1324.2 +040600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +040700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1324.2 +040800 GO TO FAIL-ROUTINE-EX. ST1324.2 +040900 FAIL-ROUTINE-WRITE. ST1324.2 +041000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1324.2 +041100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1324.2 +041200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1324.2 +041300 MOVE SPACES TO COR-ANSI-REFERENCE. ST1324.2 +041400 FAIL-ROUTINE-EX. EXIT. ST1324.2 +041500 BAIL-OUT. ST1324.2 +041600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1324.2 +041700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1324.2 +041800 BAIL-OUT-WRITE. ST1324.2 +041900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1324.2 +042000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1324.2 +042100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1324.2 +042200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1324.2 +042300 BAIL-OUT-EX. EXIT. ST1324.2 +042400 CCVS1-EXIT. ST1324.2 +042500 EXIT. ST1324.2 +042600 SRT-4 SECTION. ST1324.2 +042700 FOURTH-SORT. ST1324.2 +042800 SORT SORT4 ST1324.2 +042900 DESCENDING S4-KEY1 S4-KEY2 ST1324.2 +043000 INPUT PROCEDURE SRT-4-INPUT ST1324.2 +043100 OUTPUT PROCEDURE SRT-4-OUTPUT. ST1324.2 +043200 GO TO SRT-5. ST1324.2 +043300 SRT-4-INPUT SECTION. ST1324.2 +043400 P1-CREATE-S4. ST1324.2 +043500 ADD C1 TO SUBSCRIPT-1. ST1324.2 +043600 PERFORM P3-CREATE-S4 2 TIMES. ST1324.2 +043700 P2-CREATE-S4. ST1324.2 +043800 PERFORM P1-CREATE-S4. ST1324.2 +043900 GO TO SRT-4-IN-EXIT. ST1324.2 +044000 P3-CREATE-S4. ST1324.2 +044100 MOVE ALPHA-TBL (SUBSCRIPT-1) TO WKEY-1A. ST1324.2 +044200 MOVE C0 TO SUBSCRIPT-2. ST1324.2 +044300 PERFORM P4-CREATE-S4 25 TIMES. ST1324.2 +044400 P4-CREATE-S4. ST1324.2 +044500 ADD C1 TO SUBSCRIPT-2. ST1324.2 +044600 MOVE ALPHA-TBL (SUBSCRIPT-2) TO WKEY-1B. ST1324.2 +044700 MOVE WKEYS TO S4. ST1324.2 +044800 RELEASE S4. ST1324.2 +044900 IF WKEY-2B IS EQUAL TO 9 ST1324.2 +045000 IF WKEY-2A IS EQUAL TO 9 ST1324.2 +045100 MOVE 0 TO WKEY-2A ST1324.2 +045200 ELSE ST1324.2 +045300 ADD C1 TO WKEY-2A ST1324.2 +045400 END-IF ST1324.2 +045500 MOVE C0 TO WKEY-2B ST1324.2 +045600 ELSE ADD C1 TO WKEY-2B. ST1324.2 +045700 SRT-4-IN-EXIT. ST1324.2 +045800 EXIT. ST1324.2 +045900 SRT-4-OUTPUT SECTION. ST1324.2 +046000 OPEN-SRT4-OUT. ST1324.2 +046100 OPEN OUTPUT FILE4. ST1324.2 +046200 MOVE "SORT, OUTPUT PROC" TO FEATURE. ST1324.2 +046300 SORT-TEST-16. ST1324.2 +046400 PERFORM RETURN-SORT4. ST1324.2 +046500 IF S4-KEYS EQUAL TO "PQRBABCDEZ7912345679" ST1324.2 +046600 PERFORM PASS-1 GO TO SORT-WRITE-16. ST1324.2 +046700 GO TO SORT-FAIL-16. ST1324.2 +046800 SORT-DELETE-16. ST1324.2 +046900 PERFORM DE-LETE-1. ST1324.2 +047000 GO TO SORT-WRITE-16. ST1324.2 +047100 SORT-FAIL-16. ST1324.2 +047200 MOVE S4-KEYS TO COMPUTED-A. ST1324.2 +047300 MOVE "PQRBABCDEZ7912345679" TO CORRECT-A. ST1324.2 +047400 PERFORM FAIL-1. ST1324.2 +047500 SORT-WRITE-16. ST1324.2 +047600 MOVE "SORT-TEST-16" TO PAR-NAME. ST1324.2 +047700 PERFORM PRINT-DETAIL-1. ST1324.2 +047800 SORT-TEST-17. ST1324.2 +047900 PERFORM RETURN-SORT4 59 TIMES. ST1324.2 +048000 IF S4-KEYS EQUAL TO "PQRAABCDEV7212345670" ST1324.2 +048100 PERFORM PASS-1 GO TO SORT-WRITE-17. ST1324.2 +048200 GO TO SORT-FAIL-17. ST1324.2 +048300 SORT-DELETE-17. ST1324.2 +048400 PERFORM DE-LETE-1. ST1324.2 +048500 GO TO SORT-WRITE-17. ST1324.2 +048600 SORT-FAIL-17. ST1324.2 +048700 MOVE S4-KEYS TO COMPUTED-A. ST1324.2 +048800 MOVE "PQRAABCDEV7212345670" TO CORRECT-A. ST1324.2 +048900 PERFORM FAIL-1. ST1324.2 +049000 SORT-WRITE-17. ST1324.2 +049100 MOVE "SORT-TEST-17" TO PAR-NAME. ST1324.2 +049200 PERFORM PRINT-DETAIL-1. ST1324.2 +049300 SORT-TEST-18. ST1324.2 +049400 CLOSE FILE4 REEL. ST1324.2 +049500 ST1324.2 +049600*I MOVE "MINOR *CLOSE REEL* DELETED" TO RE-MARK. ST1324.2 +049700* NOTE CLOSE REEL DELETED FOR THIS RUN XXXXX XXXXX. ST1324.2 +049800 PERFORM RETURN-SORT4 40 TIMES. ST1324.2 +049900 IF S4-KEYS EQUAL TO "PQRAABCDEA7012345670" ST1324.2 +050000 PERFORM PASS-1 GO TO SORT-WRITE-18. ST1324.2 +050100 GO TO SORT-FAIL-18. ST1324.2 +050200 SORT-DELETE-18. ST1324.2 +050300 PERFORM DE-LETE-1. ST1324.2 +050400 GO TO SORT-WRITE-18. ST1324.2 +050500 SORT-FAIL-18. ST1324.2 +050600 MOVE S4-KEYS TO COMPUTED-A. ST1324.2 +050700 MOVE "PQRAABCDEA7012345670" TO CORRECT-A. ST1324.2 +050800 PERFORM FAIL-1. ST1324.2 +050900 SORT-WRITE-18. ST1324.2 +051000 MOVE "SORT-TEST-18" TO PAR-NAME. ST1324.2 +051100 PERFORM PRINT-DETAIL-1. ST1324.2 +051200 CLOSE-1. ST1324.2 +051300 CLOSE FILE4. ST1324.2 +051400 GO TO EXIT-1. ST1324.2 +051500 RETURN-SORT4. ST1324.2 +051600 RETURN SORT4 RECORD INTO R4 AT END GO TO TERMINAL-1. ST1324.2 +051700* NOTE RETURN WITH ALL OPTIONAL WORDS. ST1324.2 +051800 WRITE R4. ST1324.2 +051900 TERMINAL-1. ST1324.2 +052000 PERFORM FAIL-1. ST1324.2 +052100 MOVE "TERMINAL-1" TO PAR-NAME. ST1324.2 +052200 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1324.2 +052300 PERFORM PRINT-DETAIL-1. ST1324.2 +052400 MOVE SPACE TO FEATURE. ST1324.2 +052500 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1324.2 +052600 PERFORM PRINT-DETAIL-1. ST1324.2 +052700 MOVE "LAST SUCCESSFUL TEST" TO RE-MARK. ST1324.2 +052800 PERFORM PRINT-DETAIL-1. ST1324.2 +052900 GO TO CLOSE-1. ST1324.2 +053000 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1324.2 +053100 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1324.2 +053200 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1324.2 +053300 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1324.2 +053400 MOVE "****TEST DELETED****" TO RE-MARK. ST1324.2 +053500 PRINT-DETAIL-1. ST1324.2 +053600 IF REC-CT NOT EQUAL TO ZERO ST1324.2 +053700 MOVE "." TO PARDOT-X ST1324.2 +053800 MOVE REC-CT TO DOTVALUE. ST1324.2 +053900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1324.2 +054000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1324.2 +054100 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1324.2 +054200 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1324.2 +054300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1324.2 +054400 MOVE SPACE TO CORRECT-X. ST1324.2 +054500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1324.2 +054600 MOVE SPACE TO RE-MARK. ST1324.2 +054700 WRITE-LINE-1. ST1324.2 +054800 ADD 1 TO RECORD-COUNT. ST1324.2 +054900 IF RECORD-COUNT GREATER 50 ST1324.2 +055000 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1324.2 +055100 MOVE SPACE TO DUMMY-RECORD ST1324.2 +055200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1324.2 +055300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1324.2 +055400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1324.2 +055500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1324.2 +055600 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1324.2 +055700 MOVE ZERO TO RECORD-COUNT. ST1324.2 +055800 PERFORM WRT-LN-1. ST1324.2 +055900 WRT-LN-1. ST1324.2 +056000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1324.2 +056100 MOVE SPACE TO DUMMY-RECORD. ST1324.2 +056200 BLANK-LINE-PRINT-1. ST1324.2 +056300 PERFORM WRT-LN-1. ST1324.2 +056400 FAIL-ROUTINE-1. ST1324.2 +056500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1324.2 +056600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1324.2 +056700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1324.2 +056800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1324.2 +056900 GO TO FAIL-ROUTINE-EX-1. ST1324.2 +057000 FAIL-RTN-WRITE-1. ST1324.2 +057100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1324.2 +057200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1324.2 +057300 FAIL-ROUTINE-EX-1. EXIT. ST1324.2 +057400 BAIL-OUT-1. ST1324.2 +057500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1324.2 +057600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1324.2 +057700 BAIL-OUT-WRITE-1. ST1324.2 +057800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1324.2 +057900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1324.2 +058000 BAIL-OUT-EX-1. EXIT. ST1324.2 +058100 EXIT-1. ST1324.2 +058200 EXIT. ST1324.2 +058300 SRT-5 SECTION. ST1324.2 +058400 FIFTH-SORT. ST1324.2 +058500 SORT SORT5 ST1324.2 +058600 ASCENDING S5-KEY1 S5-KEY2 ST1324.2 +058700 USING FILE4 ST1324.2 +058800 OUTPUT PROCEDURE SRT-5-OUTPUT. ST1324.2 +058900 GO TO SRT-6. ST1324.2 +059000 SRT-5-OUTPUT SECTION. ST1324.2 +059100 OPEN-SRT5-OUT. ST1324.2 +059200 OPEN OUTPUT FILE4. ST1324.2 +059300 MOVE "SORT, OUTPUT PROC" TO FEATURE. ST1324.2 +059400 SORT-TEST-19. ST1324.2 +059500 PERFORM RETURN-SORT5. ST1324.2 +059600 IF S5-KEYS EQUAL TO "PQRAABCDEA7012345670" ST1324.2 +059700 PERFORM PASS-2 GO TO SORT-WRITE-19. ST1324.2 +059800 GO TO SORT-FAIL-19. ST1324.2 +059900 SORT-DELETE-19. ST1324.2 +060000 PERFORM DE-LETE-2. ST1324.2 +060100 GO TO SORT-WRITE-19. ST1324.2 +060200 SORT-FAIL-19. ST1324.2 +060300 MOVE S5-KEYS TO COMPUTED-A. ST1324.2 +060400 MOVE "PQRAABCDEA7012345670" TO CORRECT-A. ST1324.2 +060500 PERFORM FAIL-2. ST1324.2 +060600 SORT-WRITE-19. ST1324.2 +060700 MOVE "SORT-TEST-19" TO PAR-NAME. ST1324.2 +060800 PERFORM PRINT-DETAIL-2. ST1324.2 +060900 SORT-TEST-20. ST1324.2 +061000 PERFORM RETURN-SORT5 99 TIMES. ST1324.2 +061100 IF S5-KEYS EQUAL TO "PQRBABCDEZ7912345679" ST1324.2 +061200 PERFORM PASS-2 GO TO SORT-WRITE-20. ST1324.2 +061300 GO TO SORT-FAIL-20. ST1324.2 +061400 SORT-DELETE-20. ST1324.2 +061500 PERFORM DE-LETE-2. ST1324.2 +061600 GO TO SORT-WRITE-20. ST1324.2 +061700 SORT-FAIL-20. ST1324.2 +061800 MOVE S5-KEYS TO COMPUTED-A. ST1324.2 +061900 MOVE "PQRBABCDEZ7912345679" TO CORRECT-A. ST1324.2 +062000 PERFORM FAIL-2. ST1324.2 +062100 SORT-WRITE-20. ST1324.2 +062200 MOVE "SORT-TEST-20" TO PAR-NAME. ST1324.2 +062300 PERFORM PRINT-DETAIL-2. ST1324.2 +062400 CLOSE-2. ST1324.2 +062500 CLOSE FILE4. ST1324.2 +062600 GO TO EXIT-2. ST1324.2 +062700 RETURN-SORT5. ST1324.2 +062800 RETURN SORT5 INTO R4 END GO TO TERMINAL-2. ST1324.2 +062900* NOTE RETURN WITHOUT OPTIONAL WORDS. ST1324.2 +063000 WRITE R4. ST1324.2 +063100 TERMINAL-2. ST1324.2 +063200 PERFORM FAIL-2. ST1324.2 +063300 MOVE "TERMINAL-2" TO PAR-NAME. ST1324.2 +063400 MOVE "END OF FILE PREMATURELY" TO RE-MARK. ST1324.2 +063500 PERFORM PRINT-DETAIL-2. ST1324.2 +063600 MOVE SPACE TO FEATURE. ST1324.2 +063700 MOVE "FOUND, PREVIOUS TEST WAS" TO RE-MARK. ST1324.2 +063800 PERFORM PRINT-DETAIL-2. ST1324.2 +063900 MOVE "LAST SUCCESSFUL TEST." TO RE-MARK. ST1324.2 +064000 PERFORM PRINT-DETAIL-2. ST1324.2 +064100 GO TO CLOSE-2. ST1324.2 +064200 INSPT-2. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1324.2 +064300 PASS-2. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1324.2 +064400 FAIL-2. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1324.2 +064500 DE-LETE-2. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1324.2 +064600 MOVE "****TEST DELETED****" TO RE-MARK. ST1324.2 +064700 PRINT-DETAIL-2. ST1324.2 +064800 IF REC-CT NOT EQUAL TO ZERO ST1324.2 +064900 MOVE "." TO PARDOT-X ST1324.2 +065000 MOVE REC-CT TO DOTVALUE. ST1324.2 +065100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-2. ST1324.2 +065200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-2 ST1324.2 +065300 PERFORM FAIL-ROUTINE-2 THRU FAIL-ROUTINE-EX-2 ST1324.2 +065400 ELSE PERFORM BAIL-OUT-2 THRU BAIL-OUT-EX-2. ST1324.2 +065500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1324.2 +065600 MOVE SPACE TO CORRECT-X. ST1324.2 +065700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1324.2 +065800 MOVE SPACE TO RE-MARK. ST1324.2 +065900 WRITE-LINE-2. ST1324.2 +066000 ADD 1 TO RECORD-COUNT. ST1324.2 +066100 IF RECORD-COUNT GREATER 50 ST1324.2 +066200 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1324.2 +066300 MOVE SPACE TO DUMMY-RECORD ST1324.2 +066400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1324.2 +066500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-2 ST1324.2 +066600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-2 2 TIMES ST1324.2 +066700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-2 ST1324.2 +066800 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1324.2 +066900 MOVE ZERO TO RECORD-COUNT. ST1324.2 +067000 PERFORM WRT-LN-2. ST1324.2 +067100 WRT-LN-2. ST1324.2 +067200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1324.2 +067300 MOVE SPACE TO DUMMY-RECORD. ST1324.2 +067400 BLANK-LINE-PRINT-2. ST1324.2 +067500 PERFORM WRT-LN-2. ST1324.2 +067600 FAIL-ROUTINE-2. ST1324.2 +067700 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. ST1324.2 +067800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-2. ST1324.2 +067900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1324.2 +068000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. ST1324.2 +068100 GO TO FAIL-ROUTINE-EX-2. ST1324.2 +068200 FAIL-RTN-WRITE-2. ST1324.2 +068300 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-2 ST1324.2 +068400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-2 2 TIMES. ST1324.2 +068500 FAIL-ROUTINE-EX-2. EXIT. ST1324.2 +068600 BAIL-OUT-2. ST1324.2 +068700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-2. ST1324.2 +068800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-2. ST1324.2 +068900 BAIL-OUT-WRITE-2. ST1324.2 +069000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1324.2 +069100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-2 2 TIMES. ST1324.2 +069200 BAIL-OUT-EX-2. EXIT. ST1324.2 +069300 EXIT-2. ST1324.2 +069400 EXIT. ST1324.2 +069500 SRT-6 SECTION. ST1324.2 +069600 SIXTH-SORT. ST1324.2 +069700 SORT SORT4 ST1324.2 +069800 ASCENDING S4-KEY2 ST1324.2 +069900 USING FILE4 ST1324.2 +070000 OUTPUT PROCEDURE SRT-6-OUTPUT. ST1324.2 +070100 STOP-RUN. ST1324.2 +070200 GO TO CCVS-EXIT. ST1324.2 +070300 SRT-6-OUTPUT SECTION. ST1324.2 +070400 SORT-TEST-21. ST1324.2 +070500 PERFORM PASS-3. ST1324.2 +070600 MOVE "2 SORTS ON ONE FILE" TO FEATURE. ST1324.2 +070700 MOVE "SORT-TEST-21" TO PAR-NAME. ST1324.2 +070800 PERFORM PRINT-DETAIL-3. ST1324.2 +070900* NOTE THIS TESTS THE ABILITY TO SORT A FILE A SECOND TIME.ST1324.2 +071000 GO TO EXIT-3. ST1324.2 +071100 RETURN-FOR-THE-HELLUVIT. ST1324.2 +071200 RETURN SORT4 AT END GO TO PASS-3. ST1324.2 +071300* NOTE THE STANDARD REQUIRES THAT EVERY OUTPUT PROCEDURE ST1324.2 +071400* HAVE AT LEAST ONE RETURN STATEMENT --- THE ABOVE ST1324.2 +071500* STATEMENT IS COMPILED BUT NEVER EXECUTED. ST1324.2 +071600 PASS-3. ST1324.2 +071700 MOVE "PASS" TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1324.2 +071800 FAIL-3. ST1324.2 +071900 ADD 1 TO ERROR-COUNTER. ST1324.2 +072000 MOVE "FAIL*" TO P-OR-F. ST1324.2 +072100 DE-LETE-3. ST1324.2 +072200 MOVE SPACE TO P-OR-F. ST1324.2 +072300 MOVE " ************ " TO COMPUTED-A. ST1324.2 +072400 MOVE " ************ " TO CORRECT-A. ST1324.2 +072500 MOVE "****TEST DELETED****" TO RE-MARK. ST1324.2 +072600 ADD 1 TO DELETE-COUNTER. ST1324.2 +072700 PRINT-DETAIL-3. ST1324.2 +072800 IF REC-CT NOT EQUAL TO ZERO ST1324.2 +072900 MOVE "." TO PARDOT-X ST1324.2 +073000 MOVE REC-CT TO DOTVALUE. ST1324.2 +073100 MOVE TEST-RESULTS TO PRINT-REC. ST1324.2 +073200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1324.2 +073300 MOVE SPACE TO P-OR-F. ST1324.2 +073400 MOVE SPACE TO COMPUTED-A. ST1324.2 +073500 MOVE SPACE TO CORRECT-A. ST1324.2 +073600 IF REC-CT EQUAL TO ZERO ST1324.2 +073700 MOVE SPACE TO PAR-NAME. ST1324.2 +073800 MOVE SPACE TO RE-MARK. ST1324.2 +073900 EXIT-3. ST1324.2 +074000 EXIT. ST1324.2 +074100 CCVS-EXIT SECTION. ST1324.2 +074200 CCVS-999999. ST1324.2 +074300 GO TO CLOSE-FILES. ST1324.2 diff --git a/tests/cobol85/ST/ST133A.CBL b/tests/cobol85/ST/ST133A.CBL new file mode 100755 index 00000000..a9110ff4 --- /dev/null +++ b/tests/cobol85/ST/ST133A.CBL @@ -0,0 +1,905 @@ +000100 IDENTIFICATION DIVISION. ST1334.2 +000200 PROGRAM-ID. ST1334.2 +000300 ST133A. ST1334.2 +000400**************************************************************** ST1334.2 +000500* * ST1334.2 +000600* VALIDATION FOR:- * ST1334.2 +000700* * ST1334.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1334.2 +000900* * ST1334.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1334.2 +001100* * ST1334.2 +001200**************************************************************** ST1334.2 +001300* * ST1334.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1334.2 +001500* * ST1334.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1334.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1334.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1334.2 +001900* * ST1334.2 +002000**************************************************************** ST1334.2 +002100* ST1334.2 +002200* ST133 DOES TWO SORTS ON THE SAME SET OF 80-CHARACTER RECORDS.ST1334.2 +002300* THESE RECORDS ARE SHOWN BELOW. THE FIRST SORT EMPLOYS THE ST1334.2 +002400* COMBINATION INPUT PROCEDURE, GIVING. THE SECOND SORT EMPLOYS ST1334.2 +002500* USING, OUTPUT PROCEDURE. THE OUTPUT FILE FROM THE FIRST SORT ST1334.2 +002600* BECOMES THE INPUT FILE FOR THE SECOND SORT. ST1334.2 +002700* ST1334.2 +002800* THE RESULTS OF BOTH SORTS ARE REFLECTED IN THE INPUT AND ST1334.2 +002900* OUTPUT FILES ASSOCIATED WITH THE SECOND SORT. BECAUSE OF ST1334.2 +003000* THIS, THE CONTENTS OF BOTH FILES ARE SPOT-CHECKED IN THE ST1334.2 +003100* OUTPUT PROCEDURE. TO DO THIS, IT IS NECESSARY TO REFER TO ST1334.2 +003200* BOTH FILES IN THE OUTPUT PROCEDURE. IN ADDITION, BOTH FILES ST1334.2 +003300* ARE REFERENCED IN THE MAINLINE BETWEEN THE SORTS. ST1334.2 +003400* BEFORE SORTS AFTER FIRST SORT AFTER SECOND SORT ST1334.2 +003500* NON-KEY KEY NON-KEY KEY NON-KEY KEY ST1334.2 +003600* X(72) S9(8) X(72) S9(8) X(72) S9(8) ST1334.2 +003700* ST1334.2 +003800* A 00000000 A +00000099 A -00000199 ST1334.2 +003900* A +00000001 A +00000098 A -00000198 ST1334.2 +004000* A +00000002 A +00000097 A -00000197 ST1334.2 +004100* . . . . . . ST1334.2 +004200* . . . . . . ST1334.2 +004300* . . . . . . ST1334.2 +004400* A +00000098 A +00000001 A -00000101 ST1334.2 +004500* A +00000099 A 00000000 A -00000100 ST1334.2 +004600* A -00000100 A -00000100 A 00000000 ST1334.2 +004700* A -00000101 A -00000101 A +00000001 ST1334.2 +004800* . . . . . . ST1334.2 +004900* . . . . . . ST1334.2 +005000* . . . . . . ST1334.2 +005100* A -00000199 A -00000199 A +00000099 ST1334.2 +005200* THE NON-KEY ITEMS ARE ALL JUSTIFIED RIGHT. ST1334.2 +005300* ST1334.2 +005400* THE SAME SORT AREA CLAUSE IS EXERCISED IN THIS PROGRAM. ST1334.2 +005500* ST1334.2 +005600 ENVIRONMENT DIVISION. ST1334.2 +005700 CONFIGURATION SECTION. ST1334.2 +005800 SOURCE-COMPUTER. ST1334.2 +005900 Linux. ST1334.2 +006000 OBJECT-COMPUTER. ST1334.2 +006100 Linux. ST1334.2 +006200 INPUT-OUTPUT SECTION. ST1334.2 +006300 FILE-CONTROL. ST1334.2 +006400 SELECT PRINT-FILE ASSIGN TO ST1334.2 +006500 "report.log". ST1334.2 +006600 SELECT FIRST-SORTFILE ASSIGN TO ST1334.2 +006700 "XXXXX027". ST1334.2 +006800 SELECT SECOND-SORTFILE ASSIGN TO ST1334.2 +006900 "XXXXX028". ST1334.2 +007000 SELECT SORTIN-2C ASSIGN TO ST1334.2 +007100 "XXXXX001". ST1334.2 +007200 SELECT SORTOUT-2C ASSIGN TO ST1334.2 +007300 "XXXXX002". ST1334.2 +007400 I-O-CONTROL. ST1334.2 +007500 SAME SORT AREA FOR FIRST-SORTFILE ST1334.2 +007600 SECOND-SORTFILE. ST1334.2 +007700 DATA DIVISION. ST1334.2 +007800 FILE SECTION. ST1334.2 +007900 FD PRINT-FILE. ST1334.2 +008000 01 PRINT-REC PICTURE X(120). ST1334.2 +008100 01 DUMMY-RECORD PICTURE X(120). ST1334.2 +008200 FD SORTIN-2C ST1334.2 +008300 LABEL RECORDS STANDARD ST1334.2 +008400*C VALUE OF ST1334.2 +008500*C OCLABELID ST1334.2 +008600*C IS ST1334.2 +008700*C "OCDUMMY" ST1334.2 +008800*G SYSIN ST1334.2 +008900 DATA RECORD IS SORTIN-REC. ST1334.2 +009000 01 SORTIN-REC. ST1334.2 +009100 02 SORTIN-NON-KEY PICTURE X(72) JUSTIFIED RIGHT. ST1334.2 +009200 02 SORTIN-KEY PICTURE S9(8) COMPUTATIONAL. ST1334.2 +009300 FD SORTOUT-2C ST1334.2 +009400 LABEL RECORDS STANDARD ST1334.2 +009500*C VALUE OF ST1334.2 +009600*C OCLABELID ST1334.2 +009700*C IS ST1334.2 +009800*C "OCDUMMY" ST1334.2 +009900*G SYSIN ST1334.2 +010000 DATA RECORD IS SORTOUT-REC. ST1334.2 +010100 01 SORTOUT-REC. ST1334.2 +010200 02 SORTOUT-NON-KEY PICTURE X(72) JUSTIFIED RIGHT. ST1334.2 +010300 02 SORTOUT-KEY PICTURE S9(8) COMPUTATIONAL. ST1334.2 +010400 SD FIRST-SORTFILE ST1334.2 +010500 DATA RECORD IS FIRST-SORTFILE-REC. ST1334.2 +010600 01 FIRST-SORTFILE-REC. ST1334.2 +010700 02 FIRST-NON-KEY PICTURE X(72) JUSTIFIED RIGHT. ST1334.2 +010800 02 FIRST-KEY PICTURE S9(8) USAGE IS COMPUTATIONAL. ST1334.2 +010900 SD SECOND-SORTFILE. ST1334.2 +011000 01 SECOND-SORTFILE-REC. ST1334.2 +011100 02 SECOND-NON-KEY PICTURE X(72) JUSTIFIED. ST1334.2 +011200 02 SECOND-KEY PICTURE S9(8) COMPUTATIONAL. ST1334.2 +011300 WORKING-STORAGE SECTION. ST1334.2 +011400 77 BREAKDOWN-SWITCH PICTURE 9 VALUE ZERO. ST1334.2 +011500 77 SP-ACE PICTURE X(14) VALUE " (SPACES)". ST1334.2 +011600 77 UTIL-CTR PICTURE S99999. ST1334.2 +011700 77 JUSTIFIED-A PICTURE X(72) VALUE " ST1334.2 +011800- " A". ST1334.2 +011900 01 COMPUTED-BREAKDOWN. ST1334.2 +012000 02 FIRST-20 PICTURE X(20). ST1334.2 +012100 02 SECOND-20 PICTURE X(20). ST1334.2 +012200 02 THIRD-20 PICTURE X(20). ST1334.2 +012300 02 FOURTH-20 PICTURE X(20). ST1334.2 +012400 01 FILE-RECORD-INFORMATION-REC. ST1334.2 +012500 03 FILE-RECORD-INFO-SKELETON. ST1334.2 +012600 05 FILLER PICTURE X(48) VALUE ST1334.2 +012700 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1334.2 +012800 05 FILLER PICTURE X(46) VALUE ST1334.2 +012900 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1334.2 +013000 05 FILLER PICTURE X(26) VALUE ST1334.2 +013100 ",LFIL=000000,ORG= ,LBLR= ". ST1334.2 +013200 05 FILLER PICTURE X(37) VALUE ST1334.2 +013300 ",RECKEY= ". ST1334.2 +013400 05 FILLER PICTURE X(38) VALUE ST1334.2 +013500 ",ALTKEY1= ". ST1334.2 +013600 05 FILLER PICTURE X(38) VALUE ST1334.2 +013700 ",ALTKEY2= ". ST1334.2 +013800 05 FILLER PICTURE X(7) VALUE SPACE.ST1334.2 +013900 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1334.2 +014000 05 FILE-RECORD-INFO-P1-120. ST1334.2 +014100 07 FILLER PIC X(5). ST1334.2 +014200 07 XFILE-NAME PIC X(6). ST1334.2 +014300 07 FILLER PIC X(8). ST1334.2 +014400 07 XRECORD-NAME PIC X(6). ST1334.2 +014500 07 FILLER PIC X(1). ST1334.2 +014600 07 REELUNIT-NUMBER PIC 9(1). ST1334.2 +014700 07 FILLER PIC X(7). ST1334.2 +014800 07 XRECORD-NUMBER PIC 9(6). ST1334.2 +014900 07 FILLER PIC X(6). ST1334.2 +015000 07 UPDATE-NUMBER PIC 9(2). ST1334.2 +015100 07 FILLER PIC X(5). ST1334.2 +015200 07 ODO-NUMBER PIC 9(4). ST1334.2 +015300 07 FILLER PIC X(5). ST1334.2 +015400 07 XPROGRAM-NAME PIC X(5). ST1334.2 +015500 07 FILLER PIC X(7). ST1334.2 +015600 07 XRECORD-LENGTH PIC 9(6). ST1334.2 +015700 07 FILLER PIC X(7). ST1334.2 +015800 07 CHARS-OR-RECORDS PIC X(2). ST1334.2 +015900 07 FILLER PIC X(1). ST1334.2 +016000 07 XBLOCK-SIZE PIC 9(4). ST1334.2 +016100 07 FILLER PIC X(6). ST1334.2 +016200 07 RECORDS-IN-FILE PIC 9(6). ST1334.2 +016300 07 FILLER PIC X(5). ST1334.2 +016400 07 XFILE-ORGANIZATION PIC X(2). ST1334.2 +016500 07 FILLER PIC X(6). ST1334.2 +016600 07 XLABEL-TYPE PIC X(1). ST1334.2 +016700 05 FILE-RECORD-INFO-P121-240. ST1334.2 +016800 07 FILLER PIC X(8). ST1334.2 +016900 07 XRECORD-KEY PIC X(29). ST1334.2 +017000 07 FILLER PIC X(9). ST1334.2 +017100 07 ALTERNATE-KEY1 PIC X(29). ST1334.2 +017200 07 FILLER PIC X(9). ST1334.2 +017300 07 ALTERNATE-KEY2 PIC X(29). ST1334.2 +017400 07 FILLER PIC X(7). ST1334.2 +017500 01 TEST-RESULTS. ST1334.2 +017600 02 FILLER PIC X VALUE SPACE. ST1334.2 +017700 02 FEATURE PIC X(20) VALUE SPACE. ST1334.2 +017800 02 FILLER PIC X VALUE SPACE. ST1334.2 +017900 02 P-OR-F PIC X(5) VALUE SPACE. ST1334.2 +018000 02 FILLER PIC X VALUE SPACE. ST1334.2 +018100 02 PAR-NAME. ST1334.2 +018200 03 FILLER PIC X(19) VALUE SPACE. ST1334.2 +018300 03 PARDOT-X PIC X VALUE SPACE. ST1334.2 +018400 03 DOTVALUE PIC 99 VALUE ZERO. ST1334.2 +018500 02 FILLER PIC X(8) VALUE SPACE. ST1334.2 +018600 02 RE-MARK PIC X(61). ST1334.2 +018700 01 TEST-COMPUTED. ST1334.2 +018800 02 FILLER PIC X(30) VALUE SPACE. ST1334.2 +018900 02 FILLER PIC X(17) VALUE ST1334.2 +019000 " COMPUTED=". ST1334.2 +019100 02 COMPUTED-X. ST1334.2 +019200 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1334.2 +019300 03 COMPUTED-N REDEFINES COMPUTED-A ST1334.2 +019400 PIC -9(9).9(9). ST1334.2 +019500 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1334.2 +019600 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1334.2 +019700 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1334.2 +019800 03 CM-18V0 REDEFINES COMPUTED-A. ST1334.2 +019900 04 COMPUTED-18V0 PIC -9(18). ST1334.2 +020000 04 FILLER PIC X. ST1334.2 +020100 03 FILLER PIC X(50) VALUE SPACE. ST1334.2 +020200 01 TEST-CORRECT. ST1334.2 +020300 02 FILLER PIC X(30) VALUE SPACE. ST1334.2 +020400 02 FILLER PIC X(17) VALUE " CORRECT =". ST1334.2 +020500 02 CORRECT-X. ST1334.2 +020600 03 CORRECT-A PIC X(20) VALUE SPACE. ST1334.2 +020700 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1334.2 +020800 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1334.2 +020900 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1334.2 +021000 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1334.2 +021100 03 CR-18V0 REDEFINES CORRECT-A. ST1334.2 +021200 04 CORRECT-18V0 PIC -9(18). ST1334.2 +021300 04 FILLER PIC X. ST1334.2 +021400 03 FILLER PIC X(2) VALUE SPACE. ST1334.2 +021500 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1334.2 +021600 01 CCVS-C-1. ST1334.2 +021700 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1334.2 +021800- "SS PARAGRAPH-NAME ST1334.2 +021900- " REMARKS". ST1334.2 +022000 02 FILLER PIC X(20) VALUE SPACE. ST1334.2 +022100 01 CCVS-C-2. ST1334.2 +022200 02 FILLER PIC X VALUE SPACE. ST1334.2 +022300 02 FILLER PIC X(6) VALUE "TESTED". ST1334.2 +022400 02 FILLER PIC X(15) VALUE SPACE. ST1334.2 +022500 02 FILLER PIC X(4) VALUE "FAIL". ST1334.2 +022600 02 FILLER PIC X(94) VALUE SPACE. ST1334.2 +022700 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1334.2 +022800 01 REC-CT PIC 99 VALUE ZERO. ST1334.2 +022900 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1334.2 +023000 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1334.2 +023100 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1334.2 +023200 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1334.2 +023300 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1334.2 +023400 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1334.2 +023500 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1334.2 +023600 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1334.2 +023700 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1334.2 +023800 01 CCVS-H-1. ST1334.2 +023900 02 FILLER PIC X(39) VALUE SPACES. ST1334.2 +024000 02 FILLER PIC X(42) VALUE ST1334.2 +024100 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1334.2 +024200 02 FILLER PIC X(39) VALUE SPACES. ST1334.2 +024300 01 CCVS-H-2A. ST1334.2 +024400 02 FILLER PIC X(40) VALUE SPACE. ST1334.2 +024500 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1334.2 +024600 02 FILLER PIC XXXX VALUE ST1334.2 +024700 "4.2 ". ST1334.2 +024800 02 FILLER PIC X(28) VALUE ST1334.2 +024900 " COPY - NOT FOR DISTRIBUTION". ST1334.2 +025000 02 FILLER PIC X(41) VALUE SPACE. ST1334.2 +025100 ST1334.2 +025200 01 CCVS-H-2B. ST1334.2 +025300 02 FILLER PIC X(15) VALUE ST1334.2 +025400 "TEST RESULT OF ". ST1334.2 +025500 02 TEST-ID PIC X(9). ST1334.2 +025600 02 FILLER PIC X(4) VALUE ST1334.2 +025700 " IN ". ST1334.2 +025800 02 FILLER PIC X(12) VALUE ST1334.2 +025900 " HIGH ". ST1334.2 +026000 02 FILLER PIC X(22) VALUE ST1334.2 +026100 " LEVEL VALIDATION FOR ". ST1334.2 +026200 02 FILLER PIC X(58) VALUE ST1334.2 +026300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1334.2 +026400 01 CCVS-H-3. ST1334.2 +026500 02 FILLER PIC X(34) VALUE ST1334.2 +026600 " FOR OFFICIAL USE ONLY ". ST1334.2 +026700 02 FILLER PIC X(58) VALUE ST1334.2 +026800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1334.2 +026900 02 FILLER PIC X(28) VALUE ST1334.2 +027000 " COPYRIGHT 1985 ". ST1334.2 +027100 01 CCVS-E-1. ST1334.2 +027200 02 FILLER PIC X(52) VALUE SPACE. ST1334.2 +027300 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1334.2 +027400 02 ID-AGAIN PIC X(9). ST1334.2 +027500 02 FILLER PIC X(45) VALUE SPACES. ST1334.2 +027600 01 CCVS-E-2. ST1334.2 +027700 02 FILLER PIC X(31) VALUE SPACE. ST1334.2 +027800 02 FILLER PIC X(21) VALUE SPACE. ST1334.2 +027900 02 CCVS-E-2-2. ST1334.2 +028000 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1334.2 +028100 03 FILLER PIC X VALUE SPACE. ST1334.2 +028200 03 ENDER-DESC PIC X(44) VALUE ST1334.2 +028300 "ERRORS ENCOUNTERED". ST1334.2 +028400 01 CCVS-E-3. ST1334.2 +028500 02 FILLER PIC X(22) VALUE ST1334.2 +028600 " FOR OFFICIAL USE ONLY". ST1334.2 +028700 02 FILLER PIC X(12) VALUE SPACE. ST1334.2 +028800 02 FILLER PIC X(58) VALUE ST1334.2 +028900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1334.2 +029000 02 FILLER PIC X(13) VALUE SPACE. ST1334.2 +029100 02 FILLER PIC X(15) VALUE ST1334.2 +029200 " COPYRIGHT 1985". ST1334.2 +029300 01 CCVS-E-4. ST1334.2 +029400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1334.2 +029500 02 FILLER PIC X(4) VALUE " OF ". ST1334.2 +029600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1334.2 +029700 02 FILLER PIC X(40) VALUE ST1334.2 +029800 " TESTS WERE EXECUTED SUCCESSFULLY". ST1334.2 +029900 01 XXINFO. ST1334.2 +030000 02 FILLER PIC X(19) VALUE ST1334.2 +030100 "*** INFORMATION ***". ST1334.2 +030200 02 INFO-TEXT. ST1334.2 +030300 04 FILLER PIC X(8) VALUE SPACE. ST1334.2 +030400 04 XXCOMPUTED PIC X(20). ST1334.2 +030500 04 FILLER PIC X(5) VALUE SPACE. ST1334.2 +030600 04 XXCORRECT PIC X(20). ST1334.2 +030700 02 INF-ANSI-REFERENCE PIC X(48). ST1334.2 +030800 01 HYPHEN-LINE. ST1334.2 +030900 02 FILLER PIC IS X VALUE IS SPACE. ST1334.2 +031000 02 FILLER PIC IS X(65) VALUE IS "************************ST1334.2 +031100- "*****************************************". ST1334.2 +031200 02 FILLER PIC IS X(54) VALUE IS "************************ST1334.2 +031300- "******************************". ST1334.2 +031400 01 CCVS-PGM-ID PIC X(9) VALUE ST1334.2 +031500 "ST133A". ST1334.2 +031600 PROCEDURE DIVISION. ST1334.2 +031700 CCVS1 SECTION. ST1334.2 +031800 OPEN-FILES. ST1334.2 +031900 OPEN OUTPUT PRINT-FILE. ST1334.2 +032000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1334.2 +032100 MOVE SPACE TO TEST-RESULTS. ST1334.2 +032200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1334.2 +032300 GO TO CCVS1-EXIT. ST1334.2 +032400 CLOSE-FILES. ST1334.2 +032500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1334.2 +032600 TERMINATE-CCVS. ST1334.2 +032700*S EXIT PROGRAM. ST1334.2 +032800*SERMINATE-CALL. ST1334.2 +032900 STOP RUN. ST1334.2 +033000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1334.2 +033100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1334.2 +033200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1334.2 +033300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1334.2 +033400 MOVE "****TEST DELETED****" TO RE-MARK. ST1334.2 +033500 PRINT-DETAIL. ST1334.2 +033600 IF REC-CT NOT EQUAL TO ZERO ST1334.2 +033700 MOVE "." TO PARDOT-X ST1334.2 +033800 MOVE REC-CT TO DOTVALUE. ST1334.2 +033900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1334.2 +034000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1334.2 +034100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1334.2 +034200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1334.2 +034300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1334.2 +034400 MOVE SPACE TO CORRECT-X. ST1334.2 +034500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1334.2 +034600 MOVE SPACE TO RE-MARK. ST1334.2 +034700 HEAD-ROUTINE. ST1334.2 +034800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +034900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +035000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1334.2 +035100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1334.2 +035200 COLUMN-NAMES-ROUTINE. ST1334.2 +035300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +035400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +035500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +035600 END-ROUTINE. ST1334.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1334.2 +035800 END-RTN-EXIT. ST1334.2 +035900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +036000 END-ROUTINE-1. ST1334.2 +036100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1334.2 +036200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1334.2 +036300 ADD PASS-COUNTER TO ERROR-HOLD. ST1334.2 +036400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1334.2 +036500 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1334.2 +036600 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1334.2 +036700 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1334.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1334.2 +036900 END-ROUTINE-12. ST1334.2 +037000 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1334.2 +037100 IF ERROR-COUNTER IS EQUAL TO ZERO ST1334.2 +037200 MOVE "NO " TO ERROR-TOTAL ST1334.2 +037300 ELSE ST1334.2 +037400 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1334.2 +037500 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1334.2 +037600 PERFORM WRITE-LINE. ST1334.2 +037700 END-ROUTINE-13. ST1334.2 +037800 IF DELETE-COUNTER IS EQUAL TO ZERO ST1334.2 +037900 MOVE "NO " TO ERROR-TOTAL ELSE ST1334.2 +038000 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1334.2 +038100 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1334.2 +038200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +038300 IF INSPECT-COUNTER EQUAL TO ZERO ST1334.2 +038400 MOVE "NO " TO ERROR-TOTAL ST1334.2 +038500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1334.2 +038600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1334.2 +038700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +038800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1334.2 +038900 WRITE-LINE. ST1334.2 +039000 ADD 1 TO RECORD-COUNT. ST1334.2 +039100 IF RECORD-COUNT GREATER 42 ST1334.2 +039200 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1334.2 +039300 MOVE SPACE TO DUMMY-RECORD ST1334.2 +039400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1334.2 +039500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1334.2 +039600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1334.2 +039700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1334.2 +039800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1334.2 +039900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1334.2 +040000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1334.2 +040100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1334.2 +040200 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1334.2 +040300 MOVE ZERO TO RECORD-COUNT. ST1334.2 +040400 PERFORM WRT-LN. ST1334.2 +040500 WRT-LN. ST1334.2 +040600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1334.2 +040700 MOVE SPACE TO DUMMY-RECORD. ST1334.2 +040800 BLANK-LINE-PRINT. ST1334.2 +040900 PERFORM WRT-LN. ST1334.2 +041000 FAIL-ROUTINE. ST1334.2 +041100 IF COMPUTED-X NOT EQUAL TO SPACE ST1334.2 +041200 GO TO FAIL-ROUTINE-WRITE. ST1334.2 +041300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1334.2 +041400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1334.2 +041500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1334.2 +041600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +041700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1334.2 +041800 GO TO FAIL-ROUTINE-EX. ST1334.2 +041900 FAIL-ROUTINE-WRITE. ST1334.2 +042000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1334.2 +042100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1334.2 +042200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1334.2 +042300 MOVE SPACES TO COR-ANSI-REFERENCE. ST1334.2 +042400 FAIL-ROUTINE-EX. EXIT. ST1334.2 +042500 BAIL-OUT. ST1334.2 +042600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1334.2 +042700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1334.2 +042800 BAIL-OUT-WRITE. ST1334.2 +042900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1334.2 +043000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1334.2 +043100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1334.2 +043200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1334.2 +043300 BAIL-OUT-EX. EXIT. ST1334.2 +043400 CCVS1-EXIT. ST1334.2 +043500 EXIT. ST1334.2 +043600 MAINLINE SECTION. ST1334.2 +043700 FIRST-SORT-PARA. ST1334.2 +043800 SORT FIRST-SORTFILE ON DESCENDING KEY ST1334.2 +043900 FIRST-KEY ST1334.2 +044000 INPUT PROCEDURE INPROC ST1334.2 +044100 GIVING SORTOUT-2C. ST1334.2 +044200 MOVE "FIRST SORT DONE" TO FEATURE. ST1334.2 +044300 PERFORM PRINT-DETAIL. ST1334.2 +044400 TAPECOPY-OPEN. ST1334.2 +044500 OPEN INPUT SORTOUT-2C. ST1334.2 +044600 OPEN OUTPUT SORTIN-2C. ST1334.2 +044700 TAPECOPY-LOOP. ST1334.2 +044800 READ SORTOUT-2C AT END GO TO TAPECOPY-CLOSE. ST1334.2 +044900 MOVE SORTOUT-REC TO SORTIN-REC. ST1334.2 +045000 WRITE SORTIN-REC. ST1334.2 +045100 GO TO TAPECOPY-LOOP. ST1334.2 +045200 TAPECOPY-CLOSE. ST1334.2 +045300 CLOSE SORTIN-2C. ST1334.2 +045400 CLOSE SORTOUT-2C. ST1334.2 +045500 MOVE "TAPE COPY DONE" TO FEATURE. ST1334.2 +045600 PERFORM PRINT-DETAIL. ST1334.2 +045700* NOTE THIS TAPECOPY ROUTINE HAS NO EFFECT ON THE SORTS ---ST1334.2 +045800* ITS ONLY FUNCTION IS TO EXERCISE THE OPEN, CLOSE, ST1334.2 +045900* READ, AND WRITE VERBS IN THE MAINLINE. ST1334.2 +046000 SECOND-SORT-PARA. ST1334.2 +046100 SORT SECOND-SORTFILE ON ASCENDING KEY ST1334.2 +046200 SECOND-KEY ST1334.2 +046300 USING SORTOUT-2C ST1334.2 +046400 OUTPUT PROCEDURE OUTPROC. ST1334.2 +046500 MOVE "SECOND SORT DONE" TO FEATURE. ST1334.2 +046600 PERFORM PRINT-DETAIL. ST1334.2 +046700 GO TO CCVS-EXIT. ST1334.2 +046800 INPROC SECTION. ST1334.2 +046900 INPROC-INIT. ST1334.2 +047000 MOVE ZERO TO UTIL-CTR. ST1334.2 +047100 INPROC-LOOP. ST1334.2 +047200 IF UTIL-CTR LESS THAN 100 ST1334.2 +047300 MOVE UTIL-CTR TO FIRST-KEY ST1334.2 +047400 ELSE ST1334.2 +047500 MULTIPLY UTIL-CTR BY -1 GIVING FIRST-KEY. ST1334.2 +047600 MOVE "A" TO FIRST-NON-KEY. ST1334.2 +047700 RELEASE FIRST-SORTFILE-REC. ST1334.2 +047800 ADD 1 TO UTIL-CTR. ST1334.2 +047900 IF UTIL-CTR LESS THAN 200 GO TO INPROC-LOOP. ST1334.2 +048000 INPROC-EXIT. ST1334.2 +048100 EXIT. ST1334.2 +048200 OUTPROC SECTION. ST1334.2 +048300 SORT-INIT-1. ST1334.2 +048400 MOVE ZERO TO UTIL-CTR. ST1334.2 +048500 SORT-TEST-1. ST1334.2 +048600 MOVE "NUMERIC KEY CHECKS" TO FEATURE. ST1334.2 +048700 MOVE "SORT-TEST-1 " TO PAR-NAME. ST1334.2 +048800 PERFORM RETURN-SORTFILE. ST1334.2 +048900 IF SECOND-KEY NOT EQUAL TO -199 GO TO SORT-FAIL-1. ST1334.2 +049000 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +049100 PERFORM PASS-1 GO TO SORT-WRITE-1. ST1334.2 +049200 SORT-FAIL-1. ST1334.2 +049300 PERFORM FAIL-1. ST1334.2 +049400 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +049500 MOVE -199 TO CORRECT-N ST1334.2 +049600 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +049700 PERFORM PRINT-DETAIL-1. ST1334.2 +049800 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +049900 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +050000 SORT-WRITE-1. ST1334.2 +050100 PERFORM PRINT-DETAIL-1. ST1334.2 +050200 SORT-TEST-2. ST1334.2 +050300 MOVE "SORT-TEST-2" TO PAR-NAME. ST1334.2 +050400 PERFORM RETURN-SORTFILE. ST1334.2 +050500 IF SECOND-KEY NOT EQUAL TO -198 GO TO SORT-FAIL-2. ST1334.2 +050600 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +050700 PERFORM PASS-1 GO TO SORT-WRITE-2. ST1334.2 +050800 SORT-FAIL-2. ST1334.2 +050900 PERFORM FAIL-1. ST1334.2 +051000 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +051100 MOVE -198 TO CORRECT-N ST1334.2 +051200 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +051300 PERFORM PRINT-DETAIL-1. ST1334.2 +051400 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +051500 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +051600 SORT-WRITE-2. ST1334.2 +051700 PERFORM PRINT-DETAIL-1. ST1334.2 +051800 SORT-TEST-3. ST1334.2 +051900 MOVE "SORT-TEST-3" TO PAR-NAME. ST1334.2 +052000 PERFORM RETURN-SORTFILE 98 TIMES. ST1334.2 +052100 IF SECOND-KEY NOT EQUAL TO -100 GO TO SORT-FAIL-3. ST1334.2 +052200 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +052300 PERFORM PASS-1 GO TO SORT-WRITE-3. ST1334.2 +052400 SORT-FAIL-3. ST1334.2 +052500 PERFORM FAIL-1. ST1334.2 +052600 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +052700 MOVE -100 TO CORRECT-N. ST1334.2 +052800 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +052900 PERFORM PRINT-DETAIL-1. ST1334.2 +053000 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +053100 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +053200 SORT-WRITE-3. ST1334.2 +053300 PERFORM PRINT-DETAIL-1. ST1334.2 +053400 SORT-TEST-4. ST1334.2 +053500 MOVE "SORT-TEST-4" TO PAR-NAME. ST1334.2 +053600 PERFORM RETURN-SORTFILE. ST1334.2 +053700 IF SECOND-KEY NOT EQUAL TO ZERO GO TO SORT-FAIL-4. ST1334.2 +053800 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +053900 PERFORM PASS-1 GO TO SORT-WRITE-4. ST1334.2 +054000 SORT-FAIL-4. ST1334.2 +054100 PERFORM FAIL-1. ST1334.2 +054200 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +054300 MOVE ZERO TO CORRECT-N. ST1334.2 +054400 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +054500 PERFORM PRINT-DETAIL-1. ST1334.2 +054600 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +054700 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +054800 SORT-WRITE-4. ST1334.2 +054900 PERFORM PRINT-DETAIL-1. ST1334.2 +055000 SORT-TEST-5. ST1334.2 +055100 MOVE "SORT-TEST-5" TO PAR-NAME. ST1334.2 +055200 PERFORM RETURN-SORTFILE 99 TIMES. ST1334.2 +055300 IF SECOND-KEY NOT EQUAL TO 99 GO TO SORT-FAIL-5. ST1334.2 +055400 IF SECOND-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +055500 PERFORM PASS-1 GO TO SORT-WRITE-5. ST1334.2 +055600 SORT-FAIL-5. ST1334.2 +055700 PERFORM FAIL-1. ST1334.2 +055800 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +055900 MOVE +99 TO CORRECT-N ST1334.2 +056000 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +056100 PERFORM PRINT-DETAIL-1. ST1334.2 +056200 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +056300 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +056400 SORT-WRITE-5. ST1334.2 +056500 PERFORM PRINT-DETAIL-1. ST1334.2 +056600 SORT-TEST-6. ST1334.2 +056700 MOVE "SORT-TEST-6 " TO PAR-NAME. ST1334.2 +056800 RETURN SECOND-SORTFILE AT END ST1334.2 +056900 PERFORM PASS-1 GO TO SORT-WRITE-6. ST1334.2 +057000 SORT-FAIL-6. ST1334.2 +057100 PERFORM FAIL-1. ST1334.2 +057200 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +057300 MOVE 201 TO CORRECT-N. ST1334.2 +057400 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1334.2 +057500 PERFORM PRINT-DETAIL-1. ST1334.2 +057600 MOVE SECOND-KEY TO COMPUTED-N. ST1334.2 +057700 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +057800 PERFORM PRINT-DETAIL-1. ST1334.2 +057900 MOVE SECOND-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +058000 MOVE 1 TO BREAKDOWN-SWITCH. ST1334.2 +058100 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +058200 MOVE ZERO TO BREAKDOWN-SWITCH. ST1334.2 +058300 SORT-WRITE-6. ST1334.2 +058400 PERFORM PRINT-DETAIL-1. ST1334.2 +058500 SORT-EXIT-A. ST1334.2 +058600 EXIT. ST1334.2 +058700 SORT-INIT-B. ST1334.2 +058800 MOVE ZERO TO UTIL-CTR. ST1334.2 +058900 OPEN INPUT SORTOUT-2C. ST1334.2 +059000 SORT-TEST-7. ST1334.2 +059100 MOVE "SORT-TEST-7 " TO PAR-NAME. ST1334.2 +059200 PERFORM READ-SORTOUT. ST1334.2 +059300 IF SORTOUT-KEY NOT EQUAL TO +99 GO TO SORT-FAIL-7. ST1334.2 +059400 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +059500 PERFORM PASS-1 GO TO SORT-WRITE-7. ST1334.2 +059600 SORT-FAIL-7. ST1334.2 +059700 PERFORM FAIL-1. ST1334.2 +059800 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +059900 MOVE +99 TO CORRECT-N ST1334.2 +060000 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +060100 PERFORM PRINT-DETAIL-1. ST1334.2 +060200 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +060300 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +060400 SORT-WRITE-7. ST1334.2 +060500 PERFORM PRINT-DETAIL-1. ST1334.2 +060600 SORT-TEST-8. ST1334.2 +060700 MOVE "SORT-TEST-8 " TO PAR-NAME. ST1334.2 +060800 PERFORM READ-SORTOUT. ST1334.2 +060900 IF SORTOUT-KEY NOT EQUAL TO +98 GO TO SORT-FAIL-8. ST1334.2 +061000 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +061100 PERFORM PASS-1 GO TO SORT-WRITE-8. ST1334.2 +061200 SORT-FAIL-8. ST1334.2 +061300 PERFORM FAIL-1. ST1334.2 +061400 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +061500 MOVE +98 TO CORRECT-N ST1334.2 +061600 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +061700 PERFORM PRINT-DETAIL-1. ST1334.2 +061800 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +061900 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +062000 SORT-WRITE-8. ST1334.2 +062100 PERFORM PRINT-DETAIL-1. ST1334.2 +062200 SORT-TEST-9. ST1334.2 +062300 MOVE "SORT-TEST-9 " TO PAR-NAME. ST1334.2 +062400 PERFORM READ-SORTOUT 98 TIMES. ST1334.2 +062500 IF SORTOUT-KEY NOT EQUAL TO ZERO GO TO SORT-FAIL-9. ST1334.2 +062600 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +062700 PERFORM PASS-1 GO TO SORT-WRITE-9. ST1334.2 +062800 SORT-FAIL-9. ST1334.2 +062900 PERFORM FAIL-1. ST1334.2 +063000 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +063100 MOVE ZERO TO CORRECT-N ST1334.2 +063200 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +063300 PERFORM PRINT-DETAIL-1. ST1334.2 +063400 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +063500 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +063600 SORT-WRITE-9. ST1334.2 +063700 PERFORM PRINT-DETAIL-1. ST1334.2 +063800 SORT-TEST-10. ST1334.2 +063900 MOVE "SORT-TEST-10 " TO PAR-NAME. ST1334.2 +064000 PERFORM READ-SORTOUT. ST1334.2 +064100 IF SORTOUT-KEY NOT EQUAL TO -100 GO TO SORT-FAIL-11. ST1334.2 +064200 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +064300 PERFORM PASS-1 GO TO SORT-WRITE-10. ST1334.2 +064400 SORT-FAIL-10. ST1334.2 +064500 PERFORM FAIL-1. ST1334.2 +064600 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +064700 MOVE -100 TO CORRECT-N ST1334.2 +064800 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +064900 PERFORM PRINT-DETAIL-1. ST1334.2 +065000 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +065100 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +065200 SORT-WRITE-10. ST1334.2 +065300 PERFORM PRINT-DETAIL-1. ST1334.2 +065400 SORT-TEST-11. ST1334.2 +065500 MOVE "SORT-TEST-11 " TO PAR-NAME. ST1334.2 +065600 PERFORM READ-SORTOUT 99 TIMES. ST1334.2 +065700 IF SORTOUT-KEY NOT EQUAL TO -199 GO TO SORT-FAIL-12. ST1334.2 +065800 IF SORTOUT-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +065900 PERFORM PASS-1 GO TO SORT-WRITE-11. ST1334.2 +066000 SORT-FAIL-11. ST1334.2 +066100 PERFORM FAIL-1. ST1334.2 +066200 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +066300 MOVE -199 TO CORRECT-N ST1334.2 +066400 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +066500 PERFORM PRINT-DETAIL-1. ST1334.2 +066600 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +066700 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +066800 SORT-WRITE-11. ST1334.2 +066900 PERFORM PRINT-DETAIL-1. ST1334.2 +067000 SORT-TEST-12. ST1334.2 +067100 MOVE "SORT-TEST-12 " TO PAR-NAME. ST1334.2 +067200 READ SORTOUT-2C AT END ST1334.2 +067300 PERFORM PASS-1 GO TO SORT-WRITE-12. ST1334.2 +067400 SORT-FAIL-12. ST1334.2 +067500 PERFORM FAIL-1. ST1334.2 +067600 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +067700 MOVE 201 TO CORRECT-N. ST1334.2 +067800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1334.2 +067900 PERFORM PRINT-DETAIL-1. ST1334.2 +068000 MOVE SORTOUT-KEY TO COMPUTED-N. ST1334.2 +068100 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +068200 PERFORM PRINT-DETAIL-1. ST1334.2 +068300 MOVE SORTOUT-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +068400 MOVE 1 TO BREAKDOWN-SWITCH. ST1334.2 +068500 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +068600 MOVE ZERO TO BREAKDOWN-SWITCH. ST1334.2 +068700 SORT-WRITE-12. ST1334.2 +068800 PERFORM PRINT-DETAIL-1. ST1334.2 +068900 SORT-EXIT-B. ST1334.2 +069000 EXIT. ST1334.2 +069100 SORT-INIT-C. ST1334.2 +069200 OPEN INPUT SORTIN-2C. ST1334.2 +069300 MOVE ZERO TO UTIL-CTR. ST1334.2 +069400 SORT-TEST-13. ST1334.2 +069500 MOVE "SORT-TEST-13 " TO PAR-NAME. ST1334.2 +069600 PERFORM READ-SORTIN. ST1334.2 +069700 IF SORTIN-KEY NOT EQUAL TO +99 GO TO SORT-FAIL-13. ST1334.2 +069800 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +069900 PERFORM PASS-1 GO TO SORT-WRITE-13. ST1334.2 +070000 SORT-FAIL-13. ST1334.2 +070100 PERFORM FAIL-1. ST1334.2 +070200 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +070300 MOVE +99 TO CORRECT-N ST1334.2 +070400 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +070500 PERFORM PRINT-DETAIL-1. ST1334.2 +070600 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +070700 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +070800 SORT-WRITE-13. ST1334.2 +070900 PERFORM PRINT-DETAIL-1. ST1334.2 +071000 SORT-TEST-14. ST1334.2 +071100 MOVE "SORT-TEST-14 " TO PAR-NAME. ST1334.2 +071200 PERFORM READ-SORTIN. ST1334.2 +071300 IF SORTIN-KEY NOT EQUAL TO +98 GO TO SORT-FAIL-14. ST1334.2 +071400 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +071500 PERFORM PASS-1 GO TO SORT-WRITE-14. ST1334.2 +071600 SORT-FAIL-14. ST1334.2 +071700 PERFORM FAIL-1. ST1334.2 +071800 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +071900 MOVE +98 TO CORRECT-N ST1334.2 +072000 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +072100 PERFORM PRINT-DETAIL-1. ST1334.2 +072200 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +072300 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +072400 SORT-WRITE-14. ST1334.2 +072500 PERFORM PRINT-DETAIL-1. ST1334.2 +072600 SORT-TEST-15. ST1334.2 +072700 MOVE "SORT-TEST-15 " TO PAR-NAME. ST1334.2 +072800 PERFORM READ-SORTIN 98 TIMES. ST1334.2 +072900 IF SORTIN-KEY NOT EQUAL TO ZERO GO TO SORT-FAIL-15. ST1334.2 +073000 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +073100 PERFORM PASS-1 GO TO SORT-WRITE-15. ST1334.2 +073200 SORT-FAIL-15. ST1334.2 +073300 PERFORM FAIL-1. ST1334.2 +073400 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +073500 MOVE ZERO TO CORRECT-N ST1334.2 +073600 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +073700 PERFORM PRINT-DETAIL-1. ST1334.2 +073800 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +073900 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +074000 SORT-WRITE-15. ST1334.2 +074100 PERFORM PRINT-DETAIL-1. ST1334.2 +074200 SORT-TEST-16. ST1334.2 +074300 MOVE "SORT-TEST-16 " TO PAR-NAME. ST1334.2 +074400 PERFORM READ-SORTIN. ST1334.2 +074500 IF SORTIN-KEY NOT EQUAL TO -100 GO TO SORT-FAIL-16. ST1334.2 +074600 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +074700 PERFORM PASS-1 GO TO SORT-WRITE-16. ST1334.2 +074800 SORT-FAIL-16. ST1334.2 +074900 PERFORM FAIL-1. ST1334.2 +075000 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +075100 MOVE -100 TO CORRECT-N ST1334.2 +075200 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +075300 PERFORM PRINT-DETAIL-1. ST1334.2 +075400 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +075500 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +075600 SORT-WRITE-16. ST1334.2 +075700 PERFORM PRINT-DETAIL-1. ST1334.2 +075800 SORT-TEST-17. ST1334.2 +075900 MOVE "SORT-TEST-17 " TO PAR-NAME. ST1334.2 +076000 PERFORM READ-SORTIN 99 TIMES. ST1334.2 +076100 IF SORTIN-KEY NOT EQUAL TO -199 GO TO SORT-FAIL-17. ST1334.2 +076200 IF SORTIN-NON-KEY EQUAL TO JUSTIFIED-A ST1334.2 +076300 PERFORM PASS-1 GO TO SORT-WRITE-17. ST1334.2 +076400 SORT-FAIL-17. ST1334.2 +076500 PERFORM FAIL-1. ST1334.2 +076600 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +076700 MOVE -199 TO CORRECT-N ST1334.2 +076800 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +076900 PERFORM PRINT-DETAIL-1. ST1334.2 +077000 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +077100 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +077200 SORT-WRITE-17. ST1334.2 +077300 PERFORM PRINT-DETAIL-1. ST1334.2 +077400 SORT-TEST-18. ST1334.2 +077500 MOVE "SORT-TEST-18" TO PAR-NAME. ST1334.2 +077600 READ SORTIN-2C AT END ST1334.2 +077700 PERFORM PASS-1 GO TO SORT-WRITE-18. ST1334.2 +077800 SORT-FAIL-18. ST1334.2 +077900 PERFORM FAIL-1. ST1334.2 +078000 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +078100 MOVE 201 TO CORRECT-N. ST1334.2 +078200 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1334.2 +078300 PERFORM PRINT-DETAIL-1. ST1334.2 +078400 MOVE SORTIN-KEY TO COMPUTED-N. ST1334.2 +078500 MOVE "KEY AREA" TO RE-MARK. ST1334.2 +078600 PERFORM PRINT-DETAIL-1. ST1334.2 +078700 MOVE SORTIN-NON-KEY TO COMPUTED-BREAKDOWN. ST1334.2 +078800 MOVE 1 TO BREAKDOWN-SWITCH. ST1334.2 +078900 PERFORM NON-KEY-BREAKDOWN. ST1334.2 +079000 MOVE ZERO TO BREAKDOWN-SWITCH. ST1334.2 +079100 SORT-WRITE-18. ST1334.2 +079200 PERFORM PRINT-DETAIL-1. ST1334.2 +079300 SORT-CLOSE-19. ST1334.2 +079400 CLOSE SORTIN-2C. ST1334.2 +079500 CLOSE SORTOUT-2C. ST1334.2 +079600 GO TO OUTPROC-EXIT. ST1334.2 +079700 NON-KEY-BREAKDOWN. ST1334.2 +079800 MOVE FIRST-20 TO COMPUTED-A. ST1334.2 +079900 IF BREAKDOWN-SWITCH EQUAL TO ZERO ST1334.2 +080000 MOVE SP-ACE TO CORRECT-A. ST1334.2 +080100 MOVE "FIRST 20 OF 72-CHAR FIELD" TO RE-MARK. ST1334.2 +080200 PERFORM PRINT-DETAIL-1. ST1334.2 +080300 MOVE SECOND-20 TO COMPUTED-A. ST1334.2 +080400 IF BREAKDOWN-SWITCH EQUAL TO ZERO ST1334.2 +080500 MOVE SP-ACE TO CORRECT-A. ST1334.2 +080600 MOVE "SECOND 20 OF 72-CHAR FIELD" TO RE-MARK. ST1334.2 +080700 PERFORM PRINT-DETAIL-1. ST1334.2 +080800 MOVE THIRD-20 TO COMPUTED-A. ST1334.2 +080900 IF BREAKDOWN-SWITCH EQUAL TO ZERO ST1334.2 +081000 MOVE SP-ACE TO CORRECT-A. ST1334.2 +081100 MOVE "THIRD 20 OF 72-CHAR FIELD" TO RE-MARK. ST1334.2 +081200 PERFORM PRINT-DETAIL-1. ST1334.2 +081300 MOVE FOURTH-20 TO COMPUTED-A. ST1334.2 +081400 IF BREAKDOWN-SWITCH EQUAL TO ZERO ST1334.2 +081500 MOVE " A" TO CORRECT-A. ST1334.2 +081600 MOVE "LAST 12 OF 72-CHAR FIELD" TO RE-MARK. ST1334.2 +081700 RETURN-SORTFILE. ST1334.2 +081800 ADD 1 TO UTIL-CTR. ST1334.2 +081900 RETURN SECOND-SORTFILE AT END GO TO RETURN-ERROR. ST1334.2 +082000 RETURN-ERROR. ST1334.2 +082100 MOVE "RETURN-ERROR" TO PAR-NAME. ST1334.2 +082200 PERFORM FAIL-1. ST1334.2 +082300 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +082400 MOVE 201 TO CORRECT-N. ST1334.2 +082500 MOVE "END OF SORT FILE PREMATURE" TO RE-MARK. ST1334.2 +082600 PERFORM PRINT-DETAIL-1. ST1334.2 +082700 GO TO SORT-EXIT-A. ST1334.2 +082800 READ-SORTOUT. ST1334.2 +082900 ADD 1 TO UTIL-CTR. ST1334.2 +083000 READ SORTOUT-2C AT END GO TO READ-SORTOUT-ERROR. ST1334.2 +083100 READ-SORTOUT-ERROR. ST1334.2 +083200 MOVE "READ-SORTOUT-ERROR" TO PAR-NAME. ST1334.2 +083300 PERFORM FAIL-1. ST1334.2 +083400 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +083500 MOVE 201 TO CORRECT-N. ST1334.2 +083600 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1334.2 +083700 PERFORM PRINT-DETAIL-1. ST1334.2 +083800 GO TO SORT-EXIT-B. ST1334.2 +083900 READ-SORTIN. ST1334.2 +084000 ADD 1 TO UTIL-CTR. ST1334.2 +084100 READ SORTIN-2C AT END GO TO READ-SORTIN-ERROR. ST1334.2 +084200 READ-SORTIN-ERROR. ST1334.2 +084300 MOVE "READ-SORTIN-ERROR" TO PAR-NAME. ST1334.2 +084400 PERFORM FAIL-1. ST1334.2 +084500 MOVE UTIL-CTR TO COMPUTED-N. ST1334.2 +084600 MOVE 201 TO CORRECT-N. ST1334.2 +084700 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1334.2 +084800 PERFORM PRINT-DETAIL-1. ST1334.2 +084900 GO TO SORT-CLOSE-19. ST1334.2 +085000 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1334.2 +085100 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1334.2 +085200 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1334.2 +085300 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1334.2 +085400 MOVE "****TEST DELETED****" TO RE-MARK. ST1334.2 +085500 PRINT-DETAIL-1. ST1334.2 +085600 IF REC-CT NOT EQUAL TO ZERO ST1334.2 +085700 MOVE "." TO PARDOT-X ST1334.2 +085800 MOVE REC-CT TO DOTVALUE. ST1334.2 +085900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1334.2 +086000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1334.2 +086100 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1334.2 +086200 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1334.2 +086300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1334.2 +086400 MOVE SPACE TO CORRECT-X. ST1334.2 +086500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1334.2 +086600 MOVE SPACE TO RE-MARK. ST1334.2 +086700 WRITE-LINE-1. ST1334.2 +086800 ADD 1 TO RECORD-COUNT. ST1334.2 +086900 IF RECORD-COUNT GREATER 50 ST1334.2 +087000 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1334.2 +087100 MOVE SPACE TO DUMMY-RECORD ST1334.2 +087200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1334.2 +087300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1334.2 +087400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1334.2 +087500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1334.2 +087600 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1334.2 +087700 MOVE ZERO TO RECORD-COUNT. ST1334.2 +087800 PERFORM WRT-LN-1. ST1334.2 +087900 WRT-LN-1. ST1334.2 +088000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1334.2 +088100 MOVE SPACE TO DUMMY-RECORD. ST1334.2 +088200 BLANK-LINE-PRINT-1. ST1334.2 +088300 PERFORM WRT-LN-1. ST1334.2 +088400 FAIL-ROUTINE-1. ST1334.2 +088500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1334.2 +088600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1334.2 +088700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1334.2 +088800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1334.2 +088900 GO TO FAIL-ROUTINE-EX-1. ST1334.2 +089000 FAIL-RTN-WRITE-1. ST1334.2 +089100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1334.2 +089200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1334.2 +089300 FAIL-ROUTINE-EX-1. EXIT. ST1334.2 +089400 BAIL-OUT-1. ST1334.2 +089500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1334.2 +089600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1334.2 +089700 BAIL-OUT-WRITE-1. ST1334.2 +089800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1334.2 +089900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1334.2 +090000 BAIL-OUT-EX-1. EXIT. ST1334.2 +090100 OUTPROC-EXIT. ST1334.2 +090200 EXIT. ST1334.2 +090300 CCVS-EXIT SECTION. ST1334.2 +090400 CCVS-999999. ST1334.2 +090500 GO TO CLOSE-FILES. ST1334.2 diff --git a/tests/cobol85/ST/ST134A.CBL b/tests/cobol85/ST/ST134A.CBL new file mode 100755 index 00000000..1e114bb5 --- /dev/null +++ b/tests/cobol85/ST/ST134A.CBL @@ -0,0 +1,617 @@ +000100 IDENTIFICATION DIVISION. ST1344.2 +000200 PROGRAM-ID. ST1344.2 +000300 ST134A. ST1344.2 +000400**************************************************************** ST1344.2 +000500* * ST1344.2 +000600* VALIDATION FOR:- * ST1344.2 +000700* * ST1344.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1344.2 +000900* * ST1344.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1344.2 +001100* * ST1344.2 +001200**************************************************************** ST1344.2 +001300* * ST1344.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1344.2 +001500* * ST1344.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1344.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1344.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1344.2 +001900* * ST1344.2 +002000**************************************************************** ST1344.2 +002100* ST134A DOES THE FOLLOWING --- ST1344.2 +002200* 1. CREATES A FILE CONSISTING OF RECORDS WITH A KEY ITEMST1344.2 +002300* AND TWO NON-KEY ITEMS. THIS CREATION OCCURS IN AN ST1344.2 +002400* INDEPENDENT SECTION OF THE PROGRAM. ST1344.2 +002500* 2. SORTS THE FILE, EMPLOYING INPUT AND OUTPUT ST1344.2 +002600* PROCEDURES. THESE PROCEDURES ARE EQUIVALENT TO THE ST1344.2 +002700* PROCEDURES GENERATED BY USING AND GIVING CLAUSES. ST1344.2 +002800* THE SORTED FILE IS IN THE SAME SEQUENCE AS THE ST1344.2 +002900* ORIGINAL FILE. ST1344.2 +003000* 3. SPOT-CHECKS THE RESULTS OF THE SORT IN ANOTHER ST1344.2 +003100* INDEPENDENT SECTION OF THE PROGRAM. ST1344.2 +003200* THE FILES SORTIN-2C AND SORTOUT-2C HAVE THE SAME RECORD AREA.ST1344.2 +003300* TEN RECORDS ARE SORTED. THE KEY ITEMS ARE SHOWN BELOW. ST1344.2 +003400* ST1344.2 +003500* -100 -80 -60 -40 -20 ZERO +20 +40 +60 +80 ST1344.2 +003600 ST1344.2 +003700 ENVIRONMENT DIVISION. ST1344.2 +003800 CONFIGURATION SECTION. ST1344.2 +003900 SOURCE-COMPUTER. ST1344.2 +004000 Linux. ST1344.2 +004100 OBJECT-COMPUTER. ST1344.2 +004200 Linux. ST1344.2 +004300 INPUT-OUTPUT SECTION. ST1344.2 +004400 FILE-CONTROL. ST1344.2 +004500 SELECT PRINT-FILE ASSIGN TO ST1344.2 +004600 "report.log". ST1344.2 +004700 SELECT SORTFILE-2D ASSIGN TO ST1344.2 +004800 "XXXXX027". ST1344.2 +004900 SELECT SORTIN-2D ASSIGN TO ST1344.2 +005000 "XXXXX001". ST1344.2 +005100 SELECT SORTOUT-2D ASSIGN TO ST1344.2 +005200 "XXXXX002". ST1344.2 +005300 I-O-CONTROL. ST1344.2 +005400 SAME RECORD AREA FOR ST1344.2 +005500 SORTIN-2D ST1344.2 +005600 SORTOUT-2D. ST1344.2 +005700 DATA DIVISION. ST1344.2 +005800 FILE SECTION. ST1344.2 +005900 FD PRINT-FILE. ST1344.2 +006000 01 PRINT-REC PICTURE X(120). ST1344.2 +006100 01 DUMMY-RECORD PICTURE X(120). ST1344.2 +006200 SD SORTFILE-2D ST1344.2 +006300 DATA RECORD IS SORTFILE-REC. ST1344.2 +006400 01 SORTFILE-REC. ST1344.2 +006500 02 SORTFILE-NON-KEY-1 PICTURE X(60). ST1344.2 +006600 02 SORTFILE-KEY PICTURE S9(8) COMPUTATIONAL. ST1344.2 +006700 02 SORTFILE-NON-KEY-2 PICTURE X(12). ST1344.2 +006800 FD SORTIN-2D ST1344.2 +006900 LABEL RECORDS STANDARD ST1344.2 +007000*C VALUE OF ST1344.2 +007100*C OCLABELID ST1344.2 +007200*C IS ST1344.2 +007300*C "OCDUMMY" ST1344.2 +007400*G SYSIN ST1344.2 +007500 DATA RECORD IS SORTIN-REC. ST1344.2 +007600 01 SORTIN-REC. ST1344.2 +007700 02 SORTIN-NON-KEY-1 PICTURE X(60). ST1344.2 +007800 02 SORTIN-KEY PICTURE S9(8) COMPUTATIONAL. ST1344.2 +007900 02 SORTIN-NON-KEY-2 PICTURE X(12). ST1344.2 +008000 FD SORTOUT-2D ST1344.2 +008100 LABEL RECORDS STANDARD ST1344.2 +008200*C VALUE OF ST1344.2 +008300*C OCLABELID ST1344.2 +008400*C IS ST1344.2 +008500*C "OCDUMMY" ST1344.2 +008600*G SYSIN ST1344.2 +008700 DATA RECORD IS SORTOUT-REC. ST1344.2 +008800 01 SORTOUT-REC. ST1344.2 +008900 02 SORTOUT-NON-KEY-1 PICTURE X(60). ST1344.2 +009000 02 SORTOUT-KEY PICTURE S9(8) COMPUTATIONAL. ST1344.2 +009100 02 SORTOUT-NON-KEY-2 PICTURE X(12). ST1344.2 +009200 WORKING-STORAGE SECTION. ST1344.2 +009300 77 UTIL-CTR PICTURE S99999. ST1344.2 +009400 01 LITERALS. ST1344.2 +009500 02 SP-ACE PICTURE X(14) VALUE " (SPACES)". ST1344.2 +009600 02 LITERAL-A PICTURE X(60) VALUE "A ST1344.2 +009700- " ". ST1344.2 +009800 02 LITERAL-B PICTURE X(12) VALUE "B ". ST1344.2 +009900 01 COMPUTED-BREAKDOWN. ST1344.2 +010000 02 FIRST-20 PICTURE X(20). ST1344.2 +010100 02 SECOND-20 PICTURE X(20). ST1344.2 +010200 02 THIRD-20 PICTURE X(20). ST1344.2 +010300 01 FILE-RECORD-INFORMATION-REC. ST1344.2 +010400 03 FILE-RECORD-INFO-SKELETON. ST1344.2 +010500 05 FILLER PICTURE X(48) VALUE ST1344.2 +010600 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1344.2 +010700 05 FILLER PICTURE X(46) VALUE ST1344.2 +010800 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1344.2 +010900 05 FILLER PICTURE X(26) VALUE ST1344.2 +011000 ",LFIL=000000,ORG= ,LBLR= ". ST1344.2 +011100 05 FILLER PICTURE X(37) VALUE ST1344.2 +011200 ",RECKEY= ". ST1344.2 +011300 05 FILLER PICTURE X(38) VALUE ST1344.2 +011400 ",ALTKEY1= ". ST1344.2 +011500 05 FILLER PICTURE X(38) VALUE ST1344.2 +011600 ",ALTKEY2= ". ST1344.2 +011700 05 FILLER PICTURE X(7) VALUE SPACE.ST1344.2 +011800 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1344.2 +011900 05 FILE-RECORD-INFO-P1-120. ST1344.2 +012000 07 FILLER PIC X(5). ST1344.2 +012100 07 XFILE-NAME PIC X(6). ST1344.2 +012200 07 FILLER PIC X(8). ST1344.2 +012300 07 XRECORD-NAME PIC X(6). ST1344.2 +012400 07 FILLER PIC X(1). ST1344.2 +012500 07 REELUNIT-NUMBER PIC 9(1). ST1344.2 +012600 07 FILLER PIC X(7). ST1344.2 +012700 07 XRECORD-NUMBER PIC 9(6). ST1344.2 +012800 07 FILLER PIC X(6). ST1344.2 +012900 07 UPDATE-NUMBER PIC 9(2). ST1344.2 +013000 07 FILLER PIC X(5). ST1344.2 +013100 07 ODO-NUMBER PIC 9(4). ST1344.2 +013200 07 FILLER PIC X(5). ST1344.2 +013300 07 XPROGRAM-NAME PIC X(5). ST1344.2 +013400 07 FILLER PIC X(7). ST1344.2 +013500 07 XRECORD-LENGTH PIC 9(6). ST1344.2 +013600 07 FILLER PIC X(7). ST1344.2 +013700 07 CHARS-OR-RECORDS PIC X(2). ST1344.2 +013800 07 FILLER PIC X(1). ST1344.2 +013900 07 XBLOCK-SIZE PIC 9(4). ST1344.2 +014000 07 FILLER PIC X(6). ST1344.2 +014100 07 RECORDS-IN-FILE PIC 9(6). ST1344.2 +014200 07 FILLER PIC X(5). ST1344.2 +014300 07 XFILE-ORGANIZATION PIC X(2). ST1344.2 +014400 07 FILLER PIC X(6). ST1344.2 +014500 07 XLABEL-TYPE PIC X(1). ST1344.2 +014600 05 FILE-RECORD-INFO-P121-240. ST1344.2 +014700 07 FILLER PIC X(8). ST1344.2 +014800 07 XRECORD-KEY PIC X(29). ST1344.2 +014900 07 FILLER PIC X(9). ST1344.2 +015000 07 ALTERNATE-KEY1 PIC X(29). ST1344.2 +015100 07 FILLER PIC X(9). ST1344.2 +015200 07 ALTERNATE-KEY2 PIC X(29). ST1344.2 +015300 07 FILLER PIC X(7). ST1344.2 +015400 01 TEST-RESULTS. ST1344.2 +015500 02 FILLER PIC X VALUE SPACE. ST1344.2 +015600 02 FEATURE PIC X(20) VALUE SPACE. ST1344.2 +015700 02 FILLER PIC X VALUE SPACE. ST1344.2 +015800 02 P-OR-F PIC X(5) VALUE SPACE. ST1344.2 +015900 02 FILLER PIC X VALUE SPACE. ST1344.2 +016000 02 PAR-NAME. ST1344.2 +016100 03 FILLER PIC X(19) VALUE SPACE. ST1344.2 +016200 03 PARDOT-X PIC X VALUE SPACE. ST1344.2 +016300 03 DOTVALUE PIC 99 VALUE ZERO. ST1344.2 +016400 02 FILLER PIC X(8) VALUE SPACE. ST1344.2 +016500 02 RE-MARK PIC X(61). ST1344.2 +016600 01 TEST-COMPUTED. ST1344.2 +016700 02 FILLER PIC X(30) VALUE SPACE. ST1344.2 +016800 02 FILLER PIC X(17) VALUE ST1344.2 +016900 " COMPUTED=". ST1344.2 +017000 02 COMPUTED-X. ST1344.2 +017100 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1344.2 +017200 03 COMPUTED-N REDEFINES COMPUTED-A ST1344.2 +017300 PIC -9(9).9(9). ST1344.2 +017400 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1344.2 +017500 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1344.2 +017600 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1344.2 +017700 03 CM-18V0 REDEFINES COMPUTED-A. ST1344.2 +017800 04 COMPUTED-18V0 PIC -9(18). ST1344.2 +017900 04 FILLER PIC X. ST1344.2 +018000 03 FILLER PIC X(50) VALUE SPACE. ST1344.2 +018100 01 TEST-CORRECT. ST1344.2 +018200 02 FILLER PIC X(30) VALUE SPACE. ST1344.2 +018300 02 FILLER PIC X(17) VALUE " CORRECT =". ST1344.2 +018400 02 CORRECT-X. ST1344.2 +018500 03 CORRECT-A PIC X(20) VALUE SPACE. ST1344.2 +018600 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1344.2 +018700 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1344.2 +018800 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1344.2 +018900 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1344.2 +019000 03 CR-18V0 REDEFINES CORRECT-A. ST1344.2 +019100 04 CORRECT-18V0 PIC -9(18). ST1344.2 +019200 04 FILLER PIC X. ST1344.2 +019300 03 FILLER PIC X(2) VALUE SPACE. ST1344.2 +019400 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1344.2 +019500 01 CCVS-C-1. ST1344.2 +019600 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1344.2 +019700- "SS PARAGRAPH-NAME ST1344.2 +019800- " REMARKS". ST1344.2 +019900 02 FILLER PIC X(20) VALUE SPACE. ST1344.2 +020000 01 CCVS-C-2. ST1344.2 +020100 02 FILLER PIC X VALUE SPACE. ST1344.2 +020200 02 FILLER PIC X(6) VALUE "TESTED". ST1344.2 +020300 02 FILLER PIC X(15) VALUE SPACE. ST1344.2 +020400 02 FILLER PIC X(4) VALUE "FAIL". ST1344.2 +020500 02 FILLER PIC X(94) VALUE SPACE. ST1344.2 +020600 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1344.2 +020700 01 REC-CT PIC 99 VALUE ZERO. ST1344.2 +020800 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1344.2 +020900 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1344.2 +021000 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1344.2 +021100 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1344.2 +021200 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1344.2 +021300 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1344.2 +021400 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1344.2 +021500 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1344.2 +021600 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1344.2 +021700 01 CCVS-H-1. ST1344.2 +021800 02 FILLER PIC X(39) VALUE SPACES. ST1344.2 +021900 02 FILLER PIC X(42) VALUE ST1344.2 +022000 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1344.2 +022100 02 FILLER PIC X(39) VALUE SPACES. ST1344.2 +022200 01 CCVS-H-2A. ST1344.2 +022300 02 FILLER PIC X(40) VALUE SPACE. ST1344.2 +022400 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1344.2 +022500 02 FILLER PIC XXXX VALUE ST1344.2 +022600 "4.2 ". ST1344.2 +022700 02 FILLER PIC X(28) VALUE ST1344.2 +022800 " COPY - NOT FOR DISTRIBUTION". ST1344.2 +022900 02 FILLER PIC X(41) VALUE SPACE. ST1344.2 +023000 ST1344.2 +023100 01 CCVS-H-2B. ST1344.2 +023200 02 FILLER PIC X(15) VALUE ST1344.2 +023300 "TEST RESULT OF ". ST1344.2 +023400 02 TEST-ID PIC X(9). ST1344.2 +023500 02 FILLER PIC X(4) VALUE ST1344.2 +023600 " IN ". ST1344.2 +023700 02 FILLER PIC X(12) VALUE ST1344.2 +023800 " HIGH ". ST1344.2 +023900 02 FILLER PIC X(22) VALUE ST1344.2 +024000 " LEVEL VALIDATION FOR ". ST1344.2 +024100 02 FILLER PIC X(58) VALUE ST1344.2 +024200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1344.2 +024300 01 CCVS-H-3. ST1344.2 +024400 02 FILLER PIC X(34) VALUE ST1344.2 +024500 " FOR OFFICIAL USE ONLY ". ST1344.2 +024600 02 FILLER PIC X(58) VALUE ST1344.2 +024700 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1344.2 +024800 02 FILLER PIC X(28) VALUE ST1344.2 +024900 " COPYRIGHT 1985 ". ST1344.2 +025000 01 CCVS-E-1. ST1344.2 +025100 02 FILLER PIC X(52) VALUE SPACE. ST1344.2 +025200 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1344.2 +025300 02 ID-AGAIN PIC X(9). ST1344.2 +025400 02 FILLER PIC X(45) VALUE SPACES. ST1344.2 +025500 01 CCVS-E-2. ST1344.2 +025600 02 FILLER PIC X(31) VALUE SPACE. ST1344.2 +025700 02 FILLER PIC X(21) VALUE SPACE. ST1344.2 +025800 02 CCVS-E-2-2. ST1344.2 +025900 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1344.2 +026000 03 FILLER PIC X VALUE SPACE. ST1344.2 +026100 03 ENDER-DESC PIC X(44) VALUE ST1344.2 +026200 "ERRORS ENCOUNTERED". ST1344.2 +026300 01 CCVS-E-3. ST1344.2 +026400 02 FILLER PIC X(22) VALUE ST1344.2 +026500 " FOR OFFICIAL USE ONLY". ST1344.2 +026600 02 FILLER PIC X(12) VALUE SPACE. ST1344.2 +026700 02 FILLER PIC X(58) VALUE ST1344.2 +026800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1344.2 +026900 02 FILLER PIC X(13) VALUE SPACE. ST1344.2 +027000 02 FILLER PIC X(15) VALUE ST1344.2 +027100 " COPYRIGHT 1985". ST1344.2 +027200 01 CCVS-E-4. ST1344.2 +027300 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1344.2 +027400 02 FILLER PIC X(4) VALUE " OF ". ST1344.2 +027500 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1344.2 +027600 02 FILLER PIC X(40) VALUE ST1344.2 +027700 " TESTS WERE EXECUTED SUCCESSFULLY". ST1344.2 +027800 01 XXINFO. ST1344.2 +027900 02 FILLER PIC X(19) VALUE ST1344.2 +028000 "*** INFORMATION ***". ST1344.2 +028100 02 INFO-TEXT. ST1344.2 +028200 04 FILLER PIC X(8) VALUE SPACE. ST1344.2 +028300 04 XXCOMPUTED PIC X(20). ST1344.2 +028400 04 FILLER PIC X(5) VALUE SPACE. ST1344.2 +028500 04 XXCORRECT PIC X(20). ST1344.2 +028600 02 INF-ANSI-REFERENCE PIC X(48). ST1344.2 +028700 01 HYPHEN-LINE. ST1344.2 +028800 02 FILLER PIC IS X VALUE IS SPACE. ST1344.2 +028900 02 FILLER PIC IS X(65) VALUE IS "************************ST1344.2 +029000- "*****************************************". ST1344.2 +029100 02 FILLER PIC IS X(54) VALUE IS "************************ST1344.2 +029200- "******************************". ST1344.2 +029300 01 CCVS-PGM-ID PIC X(9) VALUE ST1344.2 +029400 "ST134A". ST1344.2 +029500 PROCEDURE DIVISION. ST1344.2 +029600 CCVS1 SECTION. ST1344.2 +029700 OPEN-FILES. ST1344.2 +029800 OPEN OUTPUT PRINT-FILE. ST1344.2 +029900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1344.2 +030000 MOVE SPACE TO TEST-RESULTS. ST1344.2 +030100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1344.2 +030200 MOVE ZERO TO REC-SKL-SUB. ST1344.2 +030300 PERFORM CCVS-INIT-FILE 9 TIMES. ST1344.2 +030400 CCVS-INIT-FILE. ST1344.2 +030500 ADD 1 TO REC-SKL-SUB. ST1344.2 +030600 MOVE FILE-RECORD-INFO-SKELETON ST1344.2 +030700 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1344.2 +030800 CCVS-INIT-EXIT. ST1344.2 +030900 GO TO CCVS1-EXIT. ST1344.2 +031000 CLOSE-FILES. ST1344.2 +031100 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1344.2 +031200 TERMINATE-CCVS. ST1344.2 +031300*S EXIT PROGRAM. ST1344.2 +031400*SERMINATE-CALL. ST1344.2 +031500 STOP RUN. ST1344.2 +031600 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1344.2 +031700 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1344.2 +031800 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1344.2 +031900 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1344.2 +032000 MOVE "****TEST DELETED****" TO RE-MARK. ST1344.2 +032100 PRINT-DETAIL. ST1344.2 +032200 IF REC-CT NOT EQUAL TO ZERO ST1344.2 +032300 MOVE "." TO PARDOT-X ST1344.2 +032400 MOVE REC-CT TO DOTVALUE. ST1344.2 +032500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1344.2 +032600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1344.2 +032700 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1344.2 +032800 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1344.2 +032900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1344.2 +033000 MOVE SPACE TO CORRECT-X. ST1344.2 +033100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1344.2 +033200 MOVE SPACE TO RE-MARK. ST1344.2 +033300 HEAD-ROUTINE. ST1344.2 +033400 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +033500 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +033600 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1344.2 +033700 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1344.2 +033800 COLUMN-NAMES-ROUTINE. ST1344.2 +033900 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +034000 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +034100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +034200 END-ROUTINE. ST1344.2 +034300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1344.2 +034400 END-RTN-EXIT. ST1344.2 +034500 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +034600 END-ROUTINE-1. ST1344.2 +034700 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1344.2 +034800 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1344.2 +034900 ADD PASS-COUNTER TO ERROR-HOLD. ST1344.2 +035000* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1344.2 +035100 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1344.2 +035200 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1344.2 +035300 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1344.2 +035400 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1344.2 +035500 END-ROUTINE-12. ST1344.2 +035600 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1344.2 +035700 IF ERROR-COUNTER IS EQUAL TO ZERO ST1344.2 +035800 MOVE "NO " TO ERROR-TOTAL ST1344.2 +035900 ELSE ST1344.2 +036000 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1344.2 +036100 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1344.2 +036200 PERFORM WRITE-LINE. ST1344.2 +036300 END-ROUTINE-13. ST1344.2 +036400 IF DELETE-COUNTER IS EQUAL TO ZERO ST1344.2 +036500 MOVE "NO " TO ERROR-TOTAL ELSE ST1344.2 +036600 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1344.2 +036700 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1344.2 +036800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +036900 IF INSPECT-COUNTER EQUAL TO ZERO ST1344.2 +037000 MOVE "NO " TO ERROR-TOTAL ST1344.2 +037100 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1344.2 +037200 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1344.2 +037300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +037400 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1344.2 +037500 WRITE-LINE. ST1344.2 +037600 ADD 1 TO RECORD-COUNT. ST1344.2 +037700 IF RECORD-COUNT GREATER 42 ST1344.2 +037800 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1344.2 +037900 MOVE SPACE TO DUMMY-RECORD ST1344.2 +038000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1344.2 +038100 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1344.2 +038200 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1344.2 +038300 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1344.2 +038400 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1344.2 +038500 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1344.2 +038600 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1344.2 +038700 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1344.2 +038800 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1344.2 +038900 MOVE ZERO TO RECORD-COUNT. ST1344.2 +039000 PERFORM WRT-LN. ST1344.2 +039100 WRT-LN. ST1344.2 +039200 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1344.2 +039300 MOVE SPACE TO DUMMY-RECORD. ST1344.2 +039400 BLANK-LINE-PRINT. ST1344.2 +039500 PERFORM WRT-LN. ST1344.2 +039600 FAIL-ROUTINE. ST1344.2 +039700 IF COMPUTED-X NOT EQUAL TO SPACE ST1344.2 +039800 GO TO FAIL-ROUTINE-WRITE. ST1344.2 +039900 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1344.2 +040000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1344.2 +040100 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1344.2 +040200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +040300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1344.2 +040400 GO TO FAIL-ROUTINE-EX. ST1344.2 +040500 FAIL-ROUTINE-WRITE. ST1344.2 +040600 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1344.2 +040700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1344.2 +040800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1344.2 +040900 MOVE SPACES TO COR-ANSI-REFERENCE. ST1344.2 +041000 FAIL-ROUTINE-EX. EXIT. ST1344.2 +041100 BAIL-OUT. ST1344.2 +041200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1344.2 +041300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1344.2 +041400 BAIL-OUT-WRITE. ST1344.2 +041500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1344.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1344.2 +041700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1344.2 +041800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1344.2 +041900 BAIL-OUT-EX. EXIT. ST1344.2 +042000 CCVS1-EXIT. ST1344.2 +042100 EXIT. ST1344.2 +042200 MAIN-LINE SECTION. ST1344.2 +042300 MAIN-LINE-INIT. ST1344.2 +042400 PERFORM CREATE-INPUT-FILE. ST1344.2 +042500 SORT-PARAGRAPH. ST1344.2 +042600 SORT SORTFILE-2D ON ASCENDING ST1344.2 +042700 SORTFILE-KEY ST1344.2 +042800 INPUT PROCEDURE IS INPROC ST1344.2 +042900 OUTPUT PROCEDURE IS OUTPROC. ST1344.2 +043000 AFTER-SORT-PARA. ST1344.2 +043100 PERFORM SORT-TESTS. ST1344.2 +043200 GO TO CLOSE-AND-STOP. ST1344.2 +043300 CREATE-INPUT-FILE SECTION. ST1344.2 +043400 CREATE-INIT. ST1344.2 +043500 OPEN OUTPUT SORTIN-2D. ST1344.2 +043600 MOVE -100 TO UTIL-CTR. ST1344.2 +043700 CREATE-LOOP. ST1344.2 +043800 MOVE UTIL-CTR TO SORTIN-KEY. ST1344.2 +043900 MOVE "A" TO SORTIN-NON-KEY-1. ST1344.2 +044000 MOVE "B" TO SORTIN-NON-KEY-2. ST1344.2 +044100 WRITE SORTIN-REC. ST1344.2 +044200 ADD 20 TO UTIL-CTR. ST1344.2 +044300 IF UTIL-CTR LESS THAN +100 GO TO CREATE-LOOP. ST1344.2 +044400 CLOSE SORTIN-2D. ST1344.2 +044500 INPROC SECTION. ST1344.2 +044600 INPROC-INIT. ST1344.2 +044700 OPEN INPUT SORTIN-2D. ST1344.2 +044800 INPROC-LOOP. ST1344.2 +044900 READ SORTIN-2D AT END GO TO INPROC-EXIT. ST1344.2 +045000 MOVE SORTIN-REC TO SORTFILE-REC. ST1344.2 +045100 RELEASE SORTFILE-REC. ST1344.2 +045200 GO TO INPROC-LOOP. ST1344.2 +045300 INPROC-EXIT. ST1344.2 +045400 CLOSE SORTIN-2D. ST1344.2 +045500 OUTPROC SECTION. ST1344.2 +045600 OUTPROC-INIT. ST1344.2 +045700 OPEN OUTPUT SORTOUT-2D. ST1344.2 +045800 OUTPROC-LOOP. ST1344.2 +045900 RETURN SORTFILE-2D AT END GO TO OUTPROC-EXIT. ST1344.2 +046000 MOVE SORTFILE-REC TO SORTOUT-REC. ST1344.2 +046100 WRITE SORTOUT-REC. ST1344.2 +046200 GO TO OUTPROC-LOOP. ST1344.2 +046300 OUTPROC-EXIT. ST1344.2 +046400 CLOSE SORTOUT-2D. ST1344.2 +046500 SORT-TESTS SECTION. ST1344.2 +046600 SORT-INIT-A. ST1344.2 +046700 MOVE ZERO TO UTIL-CTR ST1344.2 +046800 OPEN INPUT SORTOUT-2D. ST1344.2 +046900 MOVE "SORT, SAME REC AREA" TO FEATURE. ST1344.2 +047000 PERFORM PRINT-DETAIL-1. ST1344.2 +047100 SORT-TEST-1. ST1344.2 +047200 MOVE " COMP SORT KEY" TO FEATURE. ST1344.2 +047300 MOVE "SORT-TEST-1" TO PAR-NAME. ST1344.2 +047400 PERFORM READ-SORTOUT. ST1344.2 +047500 IF SORTOUT-KEY NOT EQUAL TO -100 GO TO SORT-FAIL-1. ST1344.2 +047600 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-A ST1344.2 +047700 GO TO SORT-FAIL-1. ST1344.2 +047800 IF SORTOUT-NON-KEY-2 EQUAL TO LITERAL-B ST1344.2 +047900 PERFORM PASS-1 GO TO SORT-WRITE-1. ST1344.2 +048000 SORT-FAIL-1. ST1344.2 +048100 MOVE -100 TO CORRECT-N. ST1344.2 +048200 PERFORM BREAKDOWN-PARA. ST1344.2 +048300 SORT-WRITE-1. ST1344.2 +048400 PERFORM PRINT-DETAIL-1. ST1344.2 +048500 SORT-TEST-2. ST1344.2 +048600 MOVE " COMP SORT KEY" TO FEATURE. ST1344.2 +048700 MOVE "SORT-TEST-2" TO PAR-NAME. ST1344.2 +048800 PERFORM READ-SORTOUT 5 TIMES. ST1344.2 +048900 IF SORTOUT-KEY NOT EQUAL TO ZERO GO TO SORT-FAIL-2. ST1344.2 +049000 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-A ST1344.2 +049100 GO TO SORT-FAIL-2. ST1344.2 +049200 IF SORTOUT-NON-KEY-2 EQUAL TO LITERAL-B ST1344.2 +049300 PERFORM PASS-1 GO TO SORT-WRITE-2. ST1344.2 +049400 SORT-FAIL-2. ST1344.2 +049500 MOVE ZERO TO CORRECT-N. ST1344.2 +049600 PERFORM BREAKDOWN-PARA. ST1344.2 +049700 SORT-WRITE-2. ST1344.2 +049800 PERFORM PRINT-DETAIL-1. ST1344.2 +049900 SORT-TEST-3. ST1344.2 +050000 MOVE " COMP SORT KEY" TO FEATURE. ST1344.2 +050100 MOVE "SORT-TEST-3" TO PAR-NAME. ST1344.2 +050200 PERFORM READ-SORTOUT 4 TIMES. ST1344.2 +050300 IF SORTOUT-KEY NOT EQUAL TO +80 GO TO SORT-FAIL-3. ST1344.2 +050400 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-A ST1344.2 +050500 GO TO SORT-FAIL-3. ST1344.2 +050600 IF SORTOUT-NON-KEY-2 EQUAL TO LITERAL-B ST1344.2 +050700 PERFORM PASS-1 GO TO SORT-WRITE-3. ST1344.2 +050800 SORT-FAIL-3. ST1344.2 +050900 MOVE +80 TO CORRECT-N. ST1344.2 +051000 PERFORM BREAKDOWN-PARA. ST1344.2 +051100 SORT-WRITE-3. ST1344.2 +051200 PERFORM PRINT-DETAIL-1. ST1344.2 +051300 SORT-TEST-4. ST1344.2 +051400 MOVE " COMP SORT KEY" TO FEATURE. ST1344.2 +051500 MOVE "SORT-TEST-4" TO PAR-NAME. ST1344.2 +051600 READ SORTOUT-2D AT END ST1344.2 +051700 PERFORM PASS-1 GO TO SORT-WRITE-4. ST1344.2 +051800 SORT-FAIL-4. ST1344.2 +051900 MOVE SPACE TO LITERALS. ST1344.2 +052000 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1344.2 +052100 PERFORM PRINT-DETAIL-1. ST1344.2 +052200 PERFORM BREAKDOWN-PARA. ST1344.2 +052300 SORT-WRITE-4. ST1344.2 +052400 PERFORM PRINT-DETAIL-1. ST1344.2 +052500 SORT-EXIT. ST1344.2 +052600 EXIT. ST1344.2 +052700 CLOSE-AND-STOP SECTION. ST1344.2 +052800 CLOSE-AND-STOP-PARA. ST1344.2 +052900 CLOSE SORTOUT-2D. ST1344.2 +053000 GO TO CCVS-EXIT. ST1344.2 +053100 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1344.2 +053200 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1344.2 +053300 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1344.2 +053400 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1344.2 +053500 MOVE "****TEST DELETED****" TO RE-MARK. ST1344.2 +053600 PRINT-DETAIL-1. ST1344.2 +053700 IF REC-CT NOT EQUAL TO ZERO ST1344.2 +053800 MOVE "." TO PARDOT-X ST1344.2 +053900 MOVE REC-CT TO DOTVALUE. ST1344.2 +054000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1344.2 +054100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1344.2 +054200 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1344.2 +054300 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1344.2 +054400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1344.2 +054500 MOVE SPACE TO CORRECT-X. ST1344.2 +054600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1344.2 +054700 MOVE SPACE TO RE-MARK. ST1344.2 +054800 WRITE-LINE-1. ST1344.2 +054900 ADD 1 TO RECORD-COUNT. ST1344.2 +055000 IF RECORD-COUNT GREATER 50 ST1344.2 +055100 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1344.2 +055200 MOVE SPACE TO DUMMY-RECORD ST1344.2 +055300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1344.2 +055400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1344.2 +055500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1344.2 +055600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1344.2 +055700 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1344.2 +055800 MOVE ZERO TO RECORD-COUNT. ST1344.2 +055900 PERFORM WRT-LN-1. ST1344.2 +056000 WRT-LN-1. ST1344.2 +056100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1344.2 +056200 MOVE SPACE TO DUMMY-RECORD. ST1344.2 +056300 BLANK-LINE-PRINT-1. ST1344.2 +056400 PERFORM WRT-LN-1. ST1344.2 +056500 FAIL-ROUTINE-1. ST1344.2 +056600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1344.2 +056700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1344.2 +056800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1344.2 +056900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1344.2 +057000 GO TO FAIL-ROUTINE-EX-1. ST1344.2 +057100 FAIL-RTN-WRITE-1. ST1344.2 +057200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1344.2 +057300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1344.2 +057400 FAIL-ROUTINE-EX-1. EXIT. ST1344.2 +057500 BAIL-OUT-1. ST1344.2 +057600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1344.2 +057700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1344.2 +057800 BAIL-OUT-WRITE-1. ST1344.2 +057900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1344.2 +058000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1344.2 +058100 BAIL-OUT-EX-1. EXIT. ST1344.2 +058200 BREAKDOWN-PARA. ST1344.2 +058300 MOVE SORTOUT-KEY TO COMPUTED-N. ST1344.2 +058400 PERFORM FAIL-1. ST1344.2 +058500 MOVE "KEY AREA" TO RE-MARK. ST1344.2 +058600 PERFORM PRINT-DETAIL-1. ST1344.2 +058700 MOVE SPACE TO FEATURE. ST1344.2 +058800 MOVE SORTOUT-NON-KEY-1 TO COMPUTED-BREAKDOWN. ST1344.2 +058900 MOVE FIRST-20 TO COMPUTED-A. ST1344.2 +059000 MOVE LITERAL-A TO CORRECT-A. ST1344.2 +059100 MOVE "A 60-CHARACTER NON-KEY AREA" TO RE-MARK. ST1344.2 +059200 PERFORM PRINT-DETAIL-1. ST1344.2 +059300 MOVE SECOND-20 TO COMPUTED-A. ST1344.2 +059400 MOVE SP-ACE TO CORRECT-A. ST1344.2 +059500 MOVE "IS HERE SHOWN AS THREE" TO RE-MARK. ST1344.2 +059600 PERFORM PRINT-DETAIL-1. ST1344.2 +059700 MOVE THIRD-20 TO COMPUTED-A. ST1344.2 +059800 MOVE SP-ACE TO CORRECT-A. ST1344.2 +059900 MOVE "20-CHARACTER FIELDS." TO RE-MARK. ST1344.2 +060000 PERFORM PRINT-DETAIL-1. ST1344.2 +060100 MOVE SORTOUT-NON-KEY-2 TO COMPUTED-A. ST1344.2 +060200 MOVE LITERAL-B TO CORRECT-A. ST1344.2 +060300 MOVE "12-CHARACTER NON-KEY AREA" TO RE-MARK. ST1344.2 +060400 READ-SORTOUT. ST1344.2 +060500 READ SORTOUT-2D AT END GO TO SORTOUT-ERROR. ST1344.2 +060600 ADD 1 TO UTIL-CTR. ST1344.2 +060700 SORTOUT-ERROR. ST1344.2 +060800 MOVE "SORTOUT-ERROR" TO PAR-NAME. ST1344.2 +060900 PERFORM FAIL-1. ST1344.2 +061000 MOVE UTIL-CTR TO COMPUTED-N. ST1344.2 +061100 MOVE 10 TO CORRECT-N. ST1344.2 +061200 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1344.2 +061300 PERFORM PRINT-DETAIL-1. ST1344.2 +061400 GO TO CLOSE-AND-STOP-PARA. ST1344.2 +061500 CCVS-EXIT SECTION. ST1344.2 +061600 CCVS-999999. ST1344.2 +061700 GO TO CLOSE-FILES. ST1344.2 diff --git a/tests/cobol85/ST/ST135A.CBL b/tests/cobol85/ST/ST135A.CBL new file mode 100755 index 00000000..61d2b3a3 --- /dev/null +++ b/tests/cobol85/ST/ST135A.CBL @@ -0,0 +1,593 @@ +000100 IDENTIFICATION DIVISION. ST1354.2 +000200 PROGRAM-ID. ST1354.2 +000300 ST135A. ST1354.2 +000400**************************************************************** ST1354.2 +000500* * ST1354.2 +000600* VALIDATION FOR:- * ST1354.2 +000700* * ST1354.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1354.2 +000900* * ST1354.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1354.2 +001100* * ST1354.2 +001200**************************************************************** ST1354.2 +001300* * ST1354.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1354.2 +001500* * ST1354.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1354.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1354.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1354.2 +001900* * ST1354.2 +002000**************************************************************** ST1354.2 +002100* ST1354.2 +002200* ST205 BUILDS A FILE, SORTS IT, AND CHECKS IT IN AN OUTPUT ST1354.2 +002300* PROCEDURE. THE UNUSUAL FEATURE OF THIS PROGRAM IS THAT THE ST1354.2 +002400* FILES SHARE A NETWORK OF SAME AREA, SAME RECORD AREA, AND ST1354.2 +002500* SAME SORT AREA. IN ORDER TO THOROUGHLY EXERCISE THE "SAME" ST1354.2 +002600* OPTIONS, TWO DUMMY FILES, CALLED USELESS-FILE AND DEADWEIGHT-ST1354.2 +002700* FILE, ARE OPENED, CLOSED, READ, AND WRITTEN UPON. HOWEVER, ST1354.2 +002800* THE CONTENTS OF THESE TWO FILES ARE NEVER CHECKED. ST1354.2 +002900* SEE THE I-O-CONTROL PARAGRAPH FOR THE ACTUAL ORGANIZATION. ST1354.2 +003000 ST1354.2 +003100 ENVIRONMENT DIVISION. ST1354.2 +003200 CONFIGURATION SECTION. ST1354.2 +003300 SOURCE-COMPUTER. ST1354.2 +003400 Linux. ST1354.2 +003500 OBJECT-COMPUTER. ST1354.2 +003600 Linux. ST1354.2 +003700 INPUT-OUTPUT SECTION. ST1354.2 +003800 FILE-CONTROL. ST1354.2 +003900 SELECT PRINT-FILE ASSIGN TO ST1354.2 +004000 "report.log". ST1354.2 +004100 SELECT SORTIN-2E ASSIGN TO ST1354.2 +004200 "XXXXX001". ST1354.2 +004300 SELECT SORTOUT-2E ASSIGN TO ST1354.2 +004400 "XXXXX002". ST1354.2 +004500 SELECT USELESS-FILE ASSIGN TO ST1354.2 +004600 "XXXXX003". ST1354.2 +004700 SELECT DEADWEIGHT-FILE ASSIGN TO ST1354.2 +004800 "XXXXX004". ST1354.2 +004900 SELECT SORTFILE-2E ASSIGN TO ST1354.2 +005000 "XXXXX027". ST1354.2 +005100 I-O-CONTROL. ST1354.2 +005200 SAME RECORD AREA FOR ST1354.2 +005300 USELESS-FILE ST1354.2 +005400 DEADWEIGHT-FILE ST1354.2 +005500 SAME SORT ST1354.2 +005600 SORTFILE-2E ST1354.2 +005700 USELESS-FILE ST1354.2 +005800 SAME ST1354.2 +005900 SORTIN-2E ST1354.2 +006000 SORTOUT-2E. ST1354.2 +006100 DATA DIVISION. ST1354.2 +006200 FILE SECTION. ST1354.2 +006300 FD PRINT-FILE. ST1354.2 +006400 01 PRINT-REC PICTURE X(120). ST1354.2 +006500 01 DUMMY-RECORD PICTURE X(120). ST1354.2 +006600 FD SORTIN-2E ST1354.2 +006700 LABEL RECORDS STANDARD ST1354.2 +006800*C VALUE OF ST1354.2 +006900*C OCLABELID ST1354.2 +007000*C IS ST1354.2 +007100*C "OCDUMMY" ST1354.2 +007200*G SYSIN ST1354.2 +007300 DATA RECORD IS SORTIN-REC. ST1354.2 +007400 01 SORTIN-REC. ST1354.2 +007500 02 SORTIN-NON-KEY-1 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +007600 02 SORTIN-KEY PICTURE 9(8) USAGE DISPLAY. ST1354.2 +007700 02 SORTIN-NON-KEY-2 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +007800 FD SORTOUT-2E ST1354.2 +007900 LABEL RECORDS STANDARD ST1354.2 +008000*C VALUE OF ST1354.2 +008100*C OCLABELID ST1354.2 +008200*C IS ST1354.2 +008300*C "OCDUMMY" ST1354.2 +008400*G SYSIN ST1354.2 +008500 DATA RECORD IS SORTOUT-REC. ST1354.2 +008600 01 SORTOUT-REC. ST1354.2 +008700 02 SORTOUT-NON-KEY-1 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +008800 02 SORTOUT-KEY PICTURE 9(8). ST1354.2 +008900 02 SORTOUT-NON-KEY-2 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +009000 FD USELESS-FILE ST1354.2 +009100 LABEL RECORDS STANDARD ST1354.2 +009200*C VALUE OF ST1354.2 +009300*C OCLABELID ST1354.2 +009400*C IS ST1354.2 +009500*C "OCDUMMY" ST1354.2 +009600*G SYSIN ST1354.2 +009700 DATA RECORD IS USELESS-REC. ST1354.2 +009800 01 USELESS-REC. ST1354.2 +009900 02 FILLER PICTURE X(80). ST1354.2 +010000 FD DEADWEIGHT-FILE ST1354.2 +010100 LABEL RECORDS STANDARD ST1354.2 +010200*C VALUE OF ST1354.2 +010300*C OCLABELID ST1354.2 +010400*C IS ST1354.2 +010500*C **** X-CARD UNDEFINED **** ST1354.2 +010600*G SYSIN ST1354.2 +010700 DATA RECORD IS DEADWEIGHT-REC. ST1354.2 +010800 01 DEADWEIGHT-REC PICTURE X(80). ST1354.2 +010900 SD SORTFILE-2E ST1354.2 +011000 DATA RECORD IS SORTFILE-REC. ST1354.2 +011100 01 SORTFILE-REC. ST1354.2 +011200 02 SORTFILE-NON-KEY-1 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +011300 02 SORTFILE-KEY PICTURE 9(8). ST1354.2 +011400 02 SORTFILE-NON-KEY-2 PICTURE A(36) JUSTIFIED RIGHT. ST1354.2 +011500 WORKING-STORAGE SECTION. ST1354.2 +011600 77 COMMENT-1 PICTURE X(27) VALUE "FIRST 20 OF 36-CHAR FIELD ". ST1354.2 +011700 77 COMMENT-2 PICTURE X(27) VALUE "LAST 16 OF 36-CHAR FIELD ". ST1354.2 +011800 77 UTIL-CTR PICTURE S99999. ST1354.2 +011900 01 LITERALS. ST1354.2 +012000 02 SP-ACE PICTURE X(14) VALUE " (SPACES)". ST1354.2 +012100 02 LITERAL-A PICTURE X(16) VALUE " A". ST1354.2 +012200 02 LITERAL-B PICTURE X(16) VALUE " B". ST1354.2 +012300 01 COMPUTED-BREAKDOWN. ST1354.2 +012400 02 FIRST-20 PICTURE X(20). ST1354.2 +012500 02 LAST-20 PICTURE X(20). ST1354.2 +012600 01 TEST-RESULTS. ST1354.2 +012700 02 FILLER PIC X VALUE SPACE. ST1354.2 +012800 02 FEATURE PIC X(20) VALUE SPACE. ST1354.2 +012900 02 FILLER PIC X VALUE SPACE. ST1354.2 +013000 02 P-OR-F PIC X(5) VALUE SPACE. ST1354.2 +013100 02 FILLER PIC X VALUE SPACE. ST1354.2 +013200 02 PAR-NAME. ST1354.2 +013300 03 FILLER PIC X(19) VALUE SPACE. ST1354.2 +013400 03 PARDOT-X PIC X VALUE SPACE. ST1354.2 +013500 03 DOTVALUE PIC 99 VALUE ZERO. ST1354.2 +013600 02 FILLER PIC X(8) VALUE SPACE. ST1354.2 +013700 02 RE-MARK PIC X(61). ST1354.2 +013800 01 TEST-COMPUTED. ST1354.2 +013900 02 FILLER PIC X(30) VALUE SPACE. ST1354.2 +014000 02 FILLER PIC X(17) VALUE ST1354.2 +014100 " COMPUTED=". ST1354.2 +014200 02 COMPUTED-X. ST1354.2 +014300 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1354.2 +014400 03 COMPUTED-N REDEFINES COMPUTED-A ST1354.2 +014500 PIC -9(9).9(9). ST1354.2 +014600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1354.2 +014700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1354.2 +014800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1354.2 +014900 03 CM-18V0 REDEFINES COMPUTED-A. ST1354.2 +015000 04 COMPUTED-18V0 PIC -9(18). ST1354.2 +015100 04 FILLER PIC X. ST1354.2 +015200 03 FILLER PIC X(50) VALUE SPACE. ST1354.2 +015300 01 TEST-CORRECT. ST1354.2 +015400 02 FILLER PIC X(30) VALUE SPACE. ST1354.2 +015500 02 FILLER PIC X(17) VALUE " CORRECT =". ST1354.2 +015600 02 CORRECT-X. ST1354.2 +015700 03 CORRECT-A PIC X(20) VALUE SPACE. ST1354.2 +015800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1354.2 +015900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1354.2 +016000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1354.2 +016100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1354.2 +016200 03 CR-18V0 REDEFINES CORRECT-A. ST1354.2 +016300 04 CORRECT-18V0 PIC -9(18). ST1354.2 +016400 04 FILLER PIC X. ST1354.2 +016500 03 FILLER PIC X(2) VALUE SPACE. ST1354.2 +016600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1354.2 +016700 01 CCVS-C-1. ST1354.2 +016800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1354.2 +016900- "SS PARAGRAPH-NAME ST1354.2 +017000- " REMARKS". ST1354.2 +017100 02 FILLER PIC X(20) VALUE SPACE. ST1354.2 +017200 01 CCVS-C-2. ST1354.2 +017300 02 FILLER PIC X VALUE SPACE. ST1354.2 +017400 02 FILLER PIC X(6) VALUE "TESTED". ST1354.2 +017500 02 FILLER PIC X(15) VALUE SPACE. ST1354.2 +017600 02 FILLER PIC X(4) VALUE "FAIL". ST1354.2 +017700 02 FILLER PIC X(94) VALUE SPACE. ST1354.2 +017800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1354.2 +017900 01 REC-CT PIC 99 VALUE ZERO. ST1354.2 +018000 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1354.2 +018100 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1354.2 +018200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1354.2 +018300 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1354.2 +018400 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1354.2 +018500 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1354.2 +018600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1354.2 +018700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1354.2 +018800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1354.2 +018900 01 CCVS-H-1. ST1354.2 +019000 02 FILLER PIC X(39) VALUE SPACES. ST1354.2 +019100 02 FILLER PIC X(42) VALUE ST1354.2 +019200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1354.2 +019300 02 FILLER PIC X(39) VALUE SPACES. ST1354.2 +019400 01 CCVS-H-2A. ST1354.2 +019500 02 FILLER PIC X(40) VALUE SPACE. ST1354.2 +019600 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1354.2 +019700 02 FILLER PIC XXXX VALUE ST1354.2 +019800 "4.2 ". ST1354.2 +019900 02 FILLER PIC X(28) VALUE ST1354.2 +020000 " COPY - NOT FOR DISTRIBUTION". ST1354.2 +020100 02 FILLER PIC X(41) VALUE SPACE. ST1354.2 +020200 ST1354.2 +020300 01 CCVS-H-2B. ST1354.2 +020400 02 FILLER PIC X(15) VALUE ST1354.2 +020500 "TEST RESULT OF ". ST1354.2 +020600 02 TEST-ID PIC X(9). ST1354.2 +020700 02 FILLER PIC X(4) VALUE ST1354.2 +020800 " IN ". ST1354.2 +020900 02 FILLER PIC X(12) VALUE ST1354.2 +021000 " HIGH ". ST1354.2 +021100 02 FILLER PIC X(22) VALUE ST1354.2 +021200 " LEVEL VALIDATION FOR ". ST1354.2 +021300 02 FILLER PIC X(58) VALUE ST1354.2 +021400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1354.2 +021500 01 CCVS-H-3. ST1354.2 +021600 02 FILLER PIC X(34) VALUE ST1354.2 +021700 " FOR OFFICIAL USE ONLY ". ST1354.2 +021800 02 FILLER PIC X(58) VALUE ST1354.2 +021900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1354.2 +022000 02 FILLER PIC X(28) VALUE ST1354.2 +022100 " COPYRIGHT 1985 ". ST1354.2 +022200 01 CCVS-E-1. ST1354.2 +022300 02 FILLER PIC X(52) VALUE SPACE. ST1354.2 +022400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1354.2 +022500 02 ID-AGAIN PIC X(9). ST1354.2 +022600 02 FILLER PIC X(45) VALUE SPACES. ST1354.2 +022700 01 CCVS-E-2. ST1354.2 +022800 02 FILLER PIC X(31) VALUE SPACE. ST1354.2 +022900 02 FILLER PIC X(21) VALUE SPACE. ST1354.2 +023000 02 CCVS-E-2-2. ST1354.2 +023100 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1354.2 +023200 03 FILLER PIC X VALUE SPACE. ST1354.2 +023300 03 ENDER-DESC PIC X(44) VALUE ST1354.2 +023400 "ERRORS ENCOUNTERED". ST1354.2 +023500 01 CCVS-E-3. ST1354.2 +023600 02 FILLER PIC X(22) VALUE ST1354.2 +023700 " FOR OFFICIAL USE ONLY". ST1354.2 +023800 02 FILLER PIC X(12) VALUE SPACE. ST1354.2 +023900 02 FILLER PIC X(58) VALUE ST1354.2 +024000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1354.2 +024100 02 FILLER PIC X(13) VALUE SPACE. ST1354.2 +024200 02 FILLER PIC X(15) VALUE ST1354.2 +024300 " COPYRIGHT 1985". ST1354.2 +024400 01 CCVS-E-4. ST1354.2 +024500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1354.2 +024600 02 FILLER PIC X(4) VALUE " OF ". ST1354.2 +024700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1354.2 +024800 02 FILLER PIC X(40) VALUE ST1354.2 +024900 " TESTS WERE EXECUTED SUCCESSFULLY". ST1354.2 +025000 01 XXINFO. ST1354.2 +025100 02 FILLER PIC X(19) VALUE ST1354.2 +025200 "*** INFORMATION ***". ST1354.2 +025300 02 INFO-TEXT. ST1354.2 +025400 04 FILLER PIC X(8) VALUE SPACE. ST1354.2 +025500 04 XXCOMPUTED PIC X(20). ST1354.2 +025600 04 FILLER PIC X(5) VALUE SPACE. ST1354.2 +025700 04 XXCORRECT PIC X(20). ST1354.2 +025800 02 INF-ANSI-REFERENCE PIC X(48). ST1354.2 +025900 01 HYPHEN-LINE. ST1354.2 +026000 02 FILLER PIC IS X VALUE IS SPACE. ST1354.2 +026100 02 FILLER PIC IS X(65) VALUE IS "************************ST1354.2 +026200- "*****************************************". ST1354.2 +026300 02 FILLER PIC IS X(54) VALUE IS "************************ST1354.2 +026400- "******************************". ST1354.2 +026500 01 CCVS-PGM-ID PIC X(9) VALUE ST1354.2 +026600 "ST135A". ST1354.2 +026700 PROCEDURE DIVISION. ST1354.2 +026800 CCVS1 SECTION. ST1354.2 +026900 OPEN-FILES. ST1354.2 +027000 OPEN OUTPUT PRINT-FILE. ST1354.2 +027100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1354.2 +027200 MOVE SPACE TO TEST-RESULTS. ST1354.2 +027300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1354.2 +027400 GO TO CCVS1-EXIT. ST1354.2 +027500 CLOSE-FILES. ST1354.2 +027600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1354.2 +027700 TERMINATE-CCVS. ST1354.2 +027800*S EXIT PROGRAM. ST1354.2 +027900*SERMINATE-CALL. ST1354.2 +028000 STOP RUN. ST1354.2 +028100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1354.2 +028200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1354.2 +028300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1354.2 +028400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1354.2 +028500 MOVE "****TEST DELETED****" TO RE-MARK. ST1354.2 +028600 PRINT-DETAIL. ST1354.2 +028700 IF REC-CT NOT EQUAL TO ZERO ST1354.2 +028800 MOVE "." TO PARDOT-X ST1354.2 +028900 MOVE REC-CT TO DOTVALUE. ST1354.2 +029000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1354.2 +029100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1354.2 +029200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1354.2 +029300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1354.2 +029400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1354.2 +029500 MOVE SPACE TO CORRECT-X. ST1354.2 +029600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1354.2 +029700 MOVE SPACE TO RE-MARK. ST1354.2 +029800 HEAD-ROUTINE. ST1354.2 +029900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +030000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +030100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1354.2 +030200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1354.2 +030300 COLUMN-NAMES-ROUTINE. ST1354.2 +030400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +030500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +030700 END-ROUTINE. ST1354.2 +030800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1354.2 +030900 END-RTN-EXIT. ST1354.2 +031000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +031100 END-ROUTINE-1. ST1354.2 +031200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1354.2 +031300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1354.2 +031400 ADD PASS-COUNTER TO ERROR-HOLD. ST1354.2 +031500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1354.2 +031600 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1354.2 +031700 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1354.2 +031800 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1354.2 +031900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1354.2 +032000 END-ROUTINE-12. ST1354.2 +032100 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1354.2 +032200 IF ERROR-COUNTER IS EQUAL TO ZERO ST1354.2 +032300 MOVE "NO " TO ERROR-TOTAL ST1354.2 +032400 ELSE ST1354.2 +032500 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1354.2 +032600 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1354.2 +032700 PERFORM WRITE-LINE. ST1354.2 +032800 END-ROUTINE-13. ST1354.2 +032900 IF DELETE-COUNTER IS EQUAL TO ZERO ST1354.2 +033000 MOVE "NO " TO ERROR-TOTAL ELSE ST1354.2 +033100 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1354.2 +033200 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1354.2 +033300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +033400 IF INSPECT-COUNTER EQUAL TO ZERO ST1354.2 +033500 MOVE "NO " TO ERROR-TOTAL ST1354.2 +033600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1354.2 +033700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1354.2 +033800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +033900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1354.2 +034000 WRITE-LINE. ST1354.2 +034100 ADD 1 TO RECORD-COUNT. ST1354.2 +034200 IF RECORD-COUNT GREATER 42 ST1354.2 +034300 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1354.2 +034400 MOVE SPACE TO DUMMY-RECORD ST1354.2 +034500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1354.2 +034600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1354.2 +034700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1354.2 +034800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1354.2 +034900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1354.2 +035000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1354.2 +035100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1354.2 +035200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1354.2 +035300 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1354.2 +035400 MOVE ZERO TO RECORD-COUNT. ST1354.2 +035500 PERFORM WRT-LN. ST1354.2 +035600 WRT-LN. ST1354.2 +035700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1354.2 +035800 MOVE SPACE TO DUMMY-RECORD. ST1354.2 +035900 BLANK-LINE-PRINT. ST1354.2 +036000 PERFORM WRT-LN. ST1354.2 +036100 FAIL-ROUTINE. ST1354.2 +036200 IF COMPUTED-X NOT EQUAL TO SPACE ST1354.2 +036300 GO TO FAIL-ROUTINE-WRITE. ST1354.2 +036400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1354.2 +036500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1354.2 +036600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1354.2 +036700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +036800 MOVE SPACES TO INF-ANSI-REFERENCE. ST1354.2 +036900 GO TO FAIL-ROUTINE-EX. ST1354.2 +037000 FAIL-ROUTINE-WRITE. ST1354.2 +037100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1354.2 +037200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1354.2 +037300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1354.2 +037400 MOVE SPACES TO COR-ANSI-REFERENCE. ST1354.2 +037500 FAIL-ROUTINE-EX. EXIT. ST1354.2 +037600 BAIL-OUT. ST1354.2 +037700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1354.2 +037800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1354.2 +037900 BAIL-OUT-WRITE. ST1354.2 +038000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1354.2 +038100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1354.2 +038200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1354.2 +038300 MOVE SPACES TO INF-ANSI-REFERENCE. ST1354.2 +038400 BAIL-OUT-EX. EXIT. ST1354.2 +038500 CCVS1-EXIT. ST1354.2 +038600 EXIT. ST1354.2 +038700 BUILD-AND-SORT-AND-CHECK SECTION. ST1354.2 +038800 BASAC. ST1354.2 +038900 OPEN OUTPUT SORTIN-2E. ST1354.2 +039000 OPEN OUTPUT USELESS-FILE. ST1354.2 +039100 OPEN OUTPUT DEADWEIGHT-FILE. ST1354.2 +039200 MOVE +10 TO UTIL-CTR. ST1354.2 +039300 BUILD-LOOP. ST1354.2 +039400 MOVE UTIL-CTR TO SORTIN-KEY. ST1354.2 +039500* NOTE UTIL-CTR IS INTENTIONALLY MOVED TO AN UNSIGNED ITEM.ST1354.2 +039600 MOVE "A" TO SORTIN-NON-KEY-1. ST1354.2 +039700 MOVE "B" TO SORTIN-NON-KEY-2. ST1354.2 +039800 WRITE SORTIN-REC. ST1354.2 +039900 MOVE SPACE TO USELESS-REC. ST1354.2 +040000 MOVE SPACE TO DEADWEIGHT-REC. ST1354.2 +040100 WRITE USELESS-REC. ST1354.2 +040200 WRITE DEADWEIGHT-REC. ST1354.2 +040300 SUBTRACT +1 FROM UTIL-CTR. ST1354.2 +040400 IF UTIL-CTR GREATER THAN -11 GO TO BUILD-LOOP. ST1354.2 +040500 CLOSE SORTIN-2E. ST1354.2 +040600 CLOSE USELESS-FILE. ST1354.2 +040700 CLOSE DEADWEIGHT-FILE. ST1354.2 +040800 BUILD-TEST. ST1354.2 +040900 IF UTIL-CTR EQUAL TO -11 ST1354.2 +041000 PERFORM PASS GO TO BUILD-WRITE. ST1354.2 +041100 BUILD-FAIL. ST1354.2 +041200 PERFORM FAIL. ST1354.2 +041300 MOVE UTIL-CTR TO COMPUTED-N. ST1354.2 +041400 MOVE -11 TO CORRECT-N. ST1354.2 +041500 BUILD-WRITE. ST1354.2 +041600 MOVE "TAPE BEING BUILT" TO FEATURE. ST1354.2 +041700 MOVE "BUILD-TEST" TO PAR-NAME. ST1354.2 +041800 PERFORM PRINT-DETAIL. ST1354.2 +041900 SORT-PARAGRAPH. ST1354.2 +042000 SORT SORTFILE-2E ON ASCENDING ST1354.2 +042100 SORTFILE-KEY ST1354.2 +042200 USING SORTIN-2E ST1354.2 +042300 OUTPUT PROCEDURE OUTPROC. ST1354.2 +042400 SORT-INIT. ST1354.2 +042500 OPEN INPUT SORTOUT-2E. ST1354.2 +042600 OPEN INPUT USELESS-FILE. ST1354.2 +042700 OPEN INPUT DEADWEIGHT-FILE. ST1354.2 +042800 MOVE +0 TO UTIL-CTR. ST1354.2 +042900 MOVE "SORT ---" TO FEATURE. ST1354.2 +043000 PERFORM PRINT-DETAIL. ST1354.2 +043100 MOVE " SAME AREA" TO FEATURE. ST1354.2 +043200 SORT-TEST-1. ST1354.2 +043300 MOVE "SORT-TEST-1" TO PAR-NAME. ST1354.2 +043400 PERFORM READ-SORTOUT. ST1354.2 +043500 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +043600- " A" GO TO SORT-FAIL-1. ST1354.2 +043700 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +043800- " B" GO TO SORT-FAIL-1. ST1354.2 +043900 IF SORTOUT-KEY EQUAL TO ZERO ST1354.2 +044000 PERFORM PASS GO TO SORT-WRITE-1. ST1354.2 +044100 SORT-FAIL-1. ST1354.2 +044200 MOVE ZERO TO CORRECT-N. ST1354.2 +044300 PERFORM BREAKDOWN-PARA. ST1354.2 +044400 SORT-WRITE-1. ST1354.2 +044500 PERFORM PRINT-DETAIL. ST1354.2 +044600 SORT-TEST-2. ST1354.2 +044700 MOVE "SORT-TEST-2" TO PAR-NAME. ST1354.2 +044800 PERFORM READ-SORTOUT. ST1354.2 +044900 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +045000- " A" GO TO SORT-FAIL-2. ST1354.2 +045100 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +045200- " B" GO TO SORT-FAIL-2. ST1354.2 +045300 IF SORTOUT-KEY EQUAL TO 1 ST1354.2 +045400 PERFORM PASS GO TO SORT-WRITE-2. ST1354.2 +045500 SORT-FAIL-2. ST1354.2 +045600 MOVE 1 TO CORRECT-N. ST1354.2 +045700 PERFORM BREAKDOWN-PARA. ST1354.2 +045800 SORT-WRITE-2. ST1354.2 +045900 PERFORM PRINT-DETAIL. ST1354.2 +046000 SORT-TEST-3. ST1354.2 +046100 MOVE "SORT-TEST-3" TO PAR-NAME. ST1354.2 +046200 PERFORM READ-SORTOUT. ST1354.2 +046300 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +046400- " A" GO TO SORT-FAIL-3. ST1354.2 +046500 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +046600- " B" GO TO SORT-FAIL-3. ST1354.2 +046700 IF SORTOUT-KEY EQUAL TO 1 ST1354.2 +046800 PERFORM PASS GO TO SORT-WRITE-3. ST1354.2 +046900 SORT-FAIL-3. ST1354.2 +047000 MOVE 1 TO CORRECT-N. ST1354.2 +047100 PERFORM BREAKDOWN-PARA. ST1354.2 +047200 SORT-WRITE-3. ST1354.2 +047300 PERFORM PRINT-DETAIL. ST1354.2 +047400 SORT-TEST-4. ST1354.2 +047500 MOVE "SORT-TEST-4" TO PAR-NAME. ST1354.2 +047600 PERFORM READ-SORTOUT 10 TIMES. ST1354.2 +047700 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +047800- " A" GO TO SORT-FAIL-4. ST1354.2 +047900 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +048000- " B" GO TO SORT-FAIL-4. ST1354.2 +048100 IF SORTOUT-KEY EQUAL TO 6 ST1354.2 +048200 PERFORM PASS GO TO SORT-WRITE-4. ST1354.2 +048300 SORT-FAIL-4. ST1354.2 +048400 MOVE 6 TO CORRECT-N. ST1354.2 +048500 PERFORM BREAKDOWN-PARA. ST1354.2 +048600 SORT-WRITE-4. ST1354.2 +048700 PERFORM PRINT-DETAIL. ST1354.2 +048800 SORT-TEST-5. ST1354.2 +048900 MOVE "SORT-TEST-5" TO PAR-NAME. ST1354.2 +049000 PERFORM READ-SORTOUT. ST1354.2 +049100 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +049200- " A" GO TO SORT-FAIL-5. ST1354.2 +049300 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +049400- " B" GO TO SORT-FAIL-5. ST1354.2 +049500 IF SORTOUT-KEY EQUAL TO 7 ST1354.2 +049600 PERFORM PASS GO TO SORT-WRITE-5. ST1354.2 +049700 SORT-FAIL-5. ST1354.2 +049800 MOVE 7 TO CORRECT-N. ST1354.2 +049900 PERFORM BREAKDOWN-PARA. ST1354.2 +050000 SORT-WRITE-5. ST1354.2 +050100 PERFORM PRINT-DETAIL. ST1354.2 +050200 SORT-TEST-6. ST1354.2 +050300 MOVE "SORT-TEST-6" TO PAR-NAME. ST1354.2 +050400 PERFORM READ-SORTOUT 6 TIMES ST1354.2 +050500 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +050600- " A" GO TO SORT-FAIL-6. ST1354.2 +050700 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +050800- " B" GO TO SORT-FAIL-6. ST1354.2 +050900 IF SORTOUT-KEY EQUAL TO 10 ST1354.2 +051000 PERFORM PASS GO TO SORT-WRITE-6. ST1354.2 +051100 SORT-FAIL-6. ST1354.2 +051200 MOVE 10 TO CORRECT-N. ST1354.2 +051300 PERFORM BREAKDOWN-PARA. ST1354.2 +051400 SORT-WRITE-6. ST1354.2 +051500 PERFORM PRINT-DETAIL. ST1354.2 +051600 SORT-TEST-7. ST1354.2 +051700 MOVE "SORT-TEST-7" TO PAR-NAME. ST1354.2 +051800 PERFORM READ-SORTOUT. ST1354.2 +051900 IF SORTOUT-NON-KEY-1 NOT EQUAL TO " ST1354.2 +052000- " A" GO TO SORT-FAIL-7. ST1354.2 +052100 IF SORTOUT-NON-KEY-2 NOT EQUAL TO " ST1354.2 +052200- " B" GO TO SORT-FAIL-7. ST1354.2 +052300 IF SORTOUT-KEY EQUAL TO 10 ST1354.2 +052400 PERFORM PASS GO TO SORT-WRITE-7. ST1354.2 +052500 SORT-FAIL-7. ST1354.2 +052600 MOVE 10 TO CORRECT-N. ST1354.2 +052700 PERFORM BREAKDOWN-PARA. ST1354.2 +052800 SORT-WRITE-7. ST1354.2 +052900 PERFORM PRINT-DETAIL. ST1354.2 +053000 SORT-TEST-8. ST1354.2 +053100 MOVE "SORT-TEST-8" TO PAR-NAME. ST1354.2 +053200 READ SORTOUT-2E AT END ST1354.2 +053300 PERFORM PASS GO TO SORT-WRITE-8. ST1354.2 +053400 SORT-FAIL-8. ST1354.2 +053500 MOVE SPACE TO LITERALS. ST1354.2 +053600 MOVE UTIL-CTR TO COMPUTED-N. ST1354.2 +053700 MOVE 21 TO CORRECT-N. ST1354.2 +053800 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1354.2 +053900 PERFORM PRINT-DETAIL. ST1354.2 +054000 PERFORM BREAKDOWN-PARA. ST1354.2 +054100 SORT-WRITE-8. ST1354.2 +054200 PERFORM PRINT-DETAIL. ST1354.2 +054300 CLOSE-SORT-FILES. ST1354.2 +054400 CLOSE USELESS-FILE. ST1354.2 +054500 CLOSE DEADWEIGHT-FILE. ST1354.2 +054600 CLOSE SORTOUT-2E. ST1354.2 +054700 GO TO CCVS-EXIT. ST1354.2 +054800 BREAKDOWN-PARA. ST1354.2 +054900 MOVE SORTOUT-KEY TO COMPUTED-N. ST1354.2 +055000 PERFORM FAIL. ST1354.2 +055100 MOVE "KEY AREA" TO RE-MARK. ST1354.2 +055200 PERFORM PRINT-DETAIL. ST1354.2 +055300 MOVE SORTOUT-NON-KEY-1 TO COMPUTED-BREAKDOWN. ST1354.2 +055400 MOVE FIRST-20 TO COMPUTED-A. ST1354.2 +055500 MOVE SP-ACE TO CORRECT-A. ST1354.2 +055600 MOVE COMMENT-1 TO RE-MARK. ST1354.2 +055700 PERFORM PRINT-DETAIL. ST1354.2 +055800 MOVE LAST-20 TO COMPUTED-A. ST1354.2 +055900 MOVE LITERAL-A TO CORRECT-A. ST1354.2 +056000 MOVE COMMENT-2 TO RE-MARK. ST1354.2 +056100 PERFORM PRINT-DETAIL. ST1354.2 +056200 MOVE SORTOUT-NON-KEY-2 TO COMPUTED-BREAKDOWN. ST1354.2 +056300 MOVE FIRST-20 TO COMPUTED-A. ST1354.2 +056400 MOVE SP-ACE TO CORRECT-A. ST1354.2 +056500 MOVE COMMENT-1 TO RE-MARK. ST1354.2 +056600 PERFORM PRINT-DETAIL. ST1354.2 +056700 MOVE LAST-20 TO COMPUTED-A. ST1354.2 +056800 MOVE SP-ACE TO CORRECT-A. ST1354.2 +056900 MOVE COMMENT-2 TO RE-MARK. ST1354.2 +057000 READ-SORTOUT. ST1354.2 +057100 READ SORTOUT-2E AT END GO TO READ-ERROR. ST1354.2 +057200 ADD 1 TO UTIL-CTR. ST1354.2 +057300 READ-ERROR. ST1354.2 +057400 PERFORM FAIL. ST1354.2 +057500 MOVE "READ-ERROR" TO PAR-NAME. ST1354.2 +057600 MOVE UTIL-CTR TO COMPUTED-N. ST1354.2 +057700 MOVE 21 TO CORRECT-N. ST1354.2 +057800 MOVE "EOF PREMATURELY FOUND" TO RE-MARK. ST1354.2 +057900 PERFORM PRINT-DETAIL. ST1354.2 +058000 GO TO CLOSE-SORT-FILES. ST1354.2 +058100 OUTPROC SECTION. ST1354.2 +058200 OUTPROC-OPEN. ST1354.2 +058300 OPEN OUTPUT SORTOUT-2E. ST1354.2 +058400 OUTPROC-RETURN. ST1354.2 +058500 RETURN SORTFILE-2E AT END GO TO OUTPROC-CLOSE. ST1354.2 +058600 MOVE SORTFILE-REC TO SORTOUT-REC. ST1354.2 +058700 WRITE SORTOUT-REC. ST1354.2 +058800 GO TO OUTPROC-RETURN. ST1354.2 +058900 OUTPROC-CLOSE. ST1354.2 +059000 CLOSE SORTOUT-2E. ST1354.2 +059100 CCVS-EXIT SECTION. ST1354.2 +059200 CCVS-999999. ST1354.2 +059300 GO TO CLOSE-FILES. ST1354.2 diff --git a/tests/cobol85/ST/ST136A.CBL b/tests/cobol85/ST/ST136A.CBL new file mode 100755 index 00000000..b49e5cf0 --- /dev/null +++ b/tests/cobol85/ST/ST136A.CBL @@ -0,0 +1,554 @@ +000100 IDENTIFICATION DIVISION. ST1364.2 +000200 PROGRAM-ID. ST1364.2 +000300 ST136A. ST1364.2 +000400 ST1364.2 +000500**************************************************************** ST1364.2 +000600* * ST1364.2 +000700* VALIDATION FOR:- * ST1364.2 +000800* * ST1364.2 +000900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1364.2 +001000* * ST1364.2 +001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1364.2 +001200* * ST1364.2 +001300**************************************************************** ST1364.2 +001400* * ST1364.2 +001500* X-CARDS USED BY THIS PROGRAM ARE :- * ST1364.2 +001600* * ST1364.2 +001700* X-55 - SYSTEM PRINTER NAME. * ST1364.2 +001800* X-82 - SOURCE COMPUTER NAME. * ST1364.2 +001900* X-83 - OBJECT COMPUTER NAME. * ST1364.2 +002000* * ST1364.2 +002100**************************************************************** ST1364.2 +002200* ST206 TESTS THE FROM OPTION OF THE RELEASE VERB. TEN RECORDS ST1364.2 +002300* ARE CREATED WITH THE NUMERICAL KEY DESCENDING FROM 10 THRU 1.ST1364.2 +002400* THE RECORDS ARE THEN SORTED INTO ASCENDING SEQUENCE AND THE ST1364.2 +002500* RESULTS ARE SPOT-CHECKED. ST1364.2 +002600* ST1364.2 +002700 ENVIRONMENT DIVISION. ST1364.2 +002800 CONFIGURATION SECTION. ST1364.2 +002900 SOURCE-COMPUTER. ST1364.2 +003000 Linux. ST1364.2 +003100 OBJECT-COMPUTER. ST1364.2 +003200 Linux. ST1364.2 +003300 INPUT-OUTPUT SECTION. ST1364.2 +003400 FILE-CONTROL. ST1364.2 +003500 SELECT PRINT-FILE ASSIGN TO ST1364.2 +003600 "report.log". ST1364.2 +003700 SELECT SORTOUT-2F ASSIGN TO ST1364.2 +003800 "XXXXX001". ST1364.2 +003900 SELECT SORTFILE-2F ASSIGN TO ST1364.2 +004000 "XXXXX027". ST1364.2 +004100 DATA DIVISION. ST1364.2 +004200 FILE SECTION. ST1364.2 +004300 FD PRINT-FILE. ST1364.2 +004400 01 PRINT-REC PICTURE X(120). ST1364.2 +004500 01 DUMMY-RECORD PICTURE X(120). ST1364.2 +004600 FD SORTOUT-2F ST1364.2 +004700 LABEL RECORDS STANDARD ST1364.2 +004800*C VALUE OF ST1364.2 +004900*C OCLABELID ST1364.2 +005000*C IS ST1364.2 +005100*C "OCDUMMY" ST1364.2 +005200*G SYSIN ST1364.2 +005300 DATA RECORD IS SORTOUT-REC. ST1364.2 +005400 01 SORTOUT-REC. ST1364.2 +005500 02 SORTOUT-NON-KEY-1 PICTURE A(12). ST1364.2 +005600 02 SORTOUT-KEY PICTURE S9(8). ST1364.2 +005700 02 SORTOUT-NON-KEY-2 PICTURE A(60). ST1364.2 +005800 SD SORTFILE-2F ST1364.2 +005900 DATA RECORD IS SORTFILE-REC. ST1364.2 +006000 01 SORTFILE-REC. ST1364.2 +006100 02 SORTFILE-NON-KEY-1 PICTURE X(12). ST1364.2 +006200 02 SORTFILE-KEY PICTURE S9(8). ST1364.2 +006300 02 SORTFILE-NON-KEY-2 PICTURE X(60). ST1364.2 +006400 WORKING-STORAGE SECTION. ST1364.2 +006500 77 LITERAL-B PICTURE X(12) VALUE "B ". ST1364.2 +006600 77 UTIL-CTR PICTURE S99999. ST1364.2 +006700 77 COMMENT-1 PICTURE X(27) VALUE "KEY AREA ". ST1364.2 +006800 77 COMMENT-2 PICTURE X(27) VALUE "FIRST 20 OF 60-CHAR FIELD ". ST1364.2 +006900 77 COMMENT-3 PICTURE X(27) VALUE "SECOND 20 OF 60-CHAR FIELD ". ST1364.2 +007000 77 COMMENT-4 PICTURE X(27) VALUE "THIRD 20 OF 60-CHAR FIELD ". ST1364.2 +007100 77 ALL-A PICTURE X(60) VALUE ALL "A". ST1364.2 +007200 77 ALL-X PICTURE X(60) VALUE ALL "X". ST1364.2 +007300 77 ALL-Z PICTURE X(60) VALUE ALL "Z". ST1364.2 +007400 01 WORK-REC. ST1364.2 +007500 02 WORK-NON-KEY-1 PICTURE X(12). ST1364.2 +007600 02 WORK-KEY PICTURE S9(8). ST1364.2 +007700 02 WORK-NON-KEY-2 PICTURE X(60). ST1364.2 +007800 01 COMPUTED-BREAKDOWN. ST1364.2 +007900 02 FIRST-20CM PICTURE X(20). ST1364.2 +008000 02 SECOND-20CM PICTURE X(20). ST1364.2 +008100 02 THIRD-20CM PICTURE X(20). ST1364.2 +008200 01 CORRECT-BREAKDOWN. ST1364.2 +008300 02 FIRST-20CR PICTURE X(20). ST1364.2 +008400 02 SECOND-20CR PICTURE X(20). ST1364.2 +008500 02 THIRD-20CR PICTURE X(20). ST1364.2 +008600 01 HOLD-REC. ST1364.2 +008700 02 HOLD-NON-KEY-1 PICTURE X(12). ST1364.2 +008800 02 HOLD-KEY PICTURE S9(8). ST1364.2 +008900 02 HOLD-NON-KEY-2 PICTURE X(60). ST1364.2 +009000 01 TEST-RESULTS. ST1364.2 +009100 02 FILLER PIC X VALUE SPACE. ST1364.2 +009200 02 FEATURE PIC X(20) VALUE SPACE. ST1364.2 +009300 02 FILLER PIC X VALUE SPACE. ST1364.2 +009400 02 P-OR-F PIC X(5) VALUE SPACE. ST1364.2 +009500 02 FILLER PIC X VALUE SPACE. ST1364.2 +009600 02 PAR-NAME. ST1364.2 +009700 03 FILLER PIC X(19) VALUE SPACE. ST1364.2 +009800 03 PARDOT-X PIC X VALUE SPACE. ST1364.2 +009900 03 DOTVALUE PIC 99 VALUE ZERO. ST1364.2 +010000 02 FILLER PIC X(8) VALUE SPACE. ST1364.2 +010100 02 RE-MARK PIC X(61). ST1364.2 +010200 01 TEST-COMPUTED. ST1364.2 +010300 02 FILLER PIC X(30) VALUE SPACE. ST1364.2 +010400 02 FILLER PIC X(17) VALUE ST1364.2 +010500 " COMPUTED=". ST1364.2 +010600 02 COMPUTED-X. ST1364.2 +010700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1364.2 +010800 03 COMPUTED-N REDEFINES COMPUTED-A ST1364.2 +010900 PIC -9(9).9(9). ST1364.2 +011000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1364.2 +011100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1364.2 +011200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1364.2 +011300 03 CM-18V0 REDEFINES COMPUTED-A. ST1364.2 +011400 04 COMPUTED-18V0 PIC -9(18). ST1364.2 +011500 04 FILLER PIC X. ST1364.2 +011600 03 FILLER PIC X(50) VALUE SPACE. ST1364.2 +011700 01 TEST-CORRECT. ST1364.2 +011800 02 FILLER PIC X(30) VALUE SPACE. ST1364.2 +011900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1364.2 +012000 02 CORRECT-X. ST1364.2 +012100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1364.2 +012200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1364.2 +012300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1364.2 +012400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1364.2 +012500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1364.2 +012600 03 CR-18V0 REDEFINES CORRECT-A. ST1364.2 +012700 04 CORRECT-18V0 PIC -9(18). ST1364.2 +012800 04 FILLER PIC X. ST1364.2 +012900 03 FILLER PIC X(2) VALUE SPACE. ST1364.2 +013000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1364.2 +013100 01 CCVS-C-1. ST1364.2 +013200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1364.2 +013300- "SS PARAGRAPH-NAME ST1364.2 +013400- " REMARKS". ST1364.2 +013500 02 FILLER PIC X(20) VALUE SPACE. ST1364.2 +013600 01 CCVS-C-2. ST1364.2 +013700 02 FILLER PIC X VALUE SPACE. ST1364.2 +013800 02 FILLER PIC X(6) VALUE "TESTED". ST1364.2 +013900 02 FILLER PIC X(15) VALUE SPACE. ST1364.2 +014000 02 FILLER PIC X(4) VALUE "FAIL". ST1364.2 +014100 02 FILLER PIC X(94) VALUE SPACE. ST1364.2 +014200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1364.2 +014300 01 REC-CT PIC 99 VALUE ZERO. ST1364.2 +014400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1364.2 +014500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1364.2 +014600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1364.2 +014700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1364.2 +014800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1364.2 +014900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1364.2 +015000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1364.2 +015100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1364.2 +015200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1364.2 +015300 01 CCVS-H-1. ST1364.2 +015400 02 FILLER PIC X(39) VALUE SPACES. ST1364.2 +015500 02 FILLER PIC X(42) VALUE ST1364.2 +015600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1364.2 +015700 02 FILLER PIC X(39) VALUE SPACES. ST1364.2 +015800 01 CCVS-H-2A. ST1364.2 +015900 02 FILLER PIC X(40) VALUE SPACE. ST1364.2 +016000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1364.2 +016100 02 FILLER PIC XXXX VALUE ST1364.2 +016200 "4.2 ". ST1364.2 +016300 02 FILLER PIC X(28) VALUE ST1364.2 +016400 " COPY - NOT FOR DISTRIBUTION". ST1364.2 +016500 02 FILLER PIC X(41) VALUE SPACE. ST1364.2 +016600 ST1364.2 +016700 01 CCVS-H-2B. ST1364.2 +016800 02 FILLER PIC X(15) VALUE ST1364.2 +016900 "TEST RESULT OF ". ST1364.2 +017000 02 TEST-ID PIC X(9). ST1364.2 +017100 02 FILLER PIC X(4) VALUE ST1364.2 +017200 " IN ". ST1364.2 +017300 02 FILLER PIC X(12) VALUE ST1364.2 +017400 " HIGH ". ST1364.2 +017500 02 FILLER PIC X(22) VALUE ST1364.2 +017600 " LEVEL VALIDATION FOR ". ST1364.2 +017700 02 FILLER PIC X(58) VALUE ST1364.2 +017800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1364.2 +017900 01 CCVS-H-3. ST1364.2 +018000 02 FILLER PIC X(34) VALUE ST1364.2 +018100 " FOR OFFICIAL USE ONLY ". ST1364.2 +018200 02 FILLER PIC X(58) VALUE ST1364.2 +018300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1364.2 +018400 02 FILLER PIC X(28) VALUE ST1364.2 +018500 " COPYRIGHT 1985 ". ST1364.2 +018600 01 CCVS-E-1. ST1364.2 +018700 02 FILLER PIC X(52) VALUE SPACE. ST1364.2 +018800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1364.2 +018900 02 ID-AGAIN PIC X(9). ST1364.2 +019000 02 FILLER PIC X(45) VALUE SPACES. ST1364.2 +019100 01 CCVS-E-2. ST1364.2 +019200 02 FILLER PIC X(31) VALUE SPACE. ST1364.2 +019300 02 FILLER PIC X(21) VALUE SPACE. ST1364.2 +019400 02 CCVS-E-2-2. ST1364.2 +019500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1364.2 +019600 03 FILLER PIC X VALUE SPACE. ST1364.2 +019700 03 ENDER-DESC PIC X(44) VALUE ST1364.2 +019800 "ERRORS ENCOUNTERED". ST1364.2 +019900 01 CCVS-E-3. ST1364.2 +020000 02 FILLER PIC X(22) VALUE ST1364.2 +020100 " FOR OFFICIAL USE ONLY". ST1364.2 +020200 02 FILLER PIC X(12) VALUE SPACE. ST1364.2 +020300 02 FILLER PIC X(58) VALUE ST1364.2 +020400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1364.2 +020500 02 FILLER PIC X(13) VALUE SPACE. ST1364.2 +020600 02 FILLER PIC X(15) VALUE ST1364.2 +020700 " COPYRIGHT 1985". ST1364.2 +020800 01 CCVS-E-4. ST1364.2 +020900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1364.2 +021000 02 FILLER PIC X(4) VALUE " OF ". ST1364.2 +021100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1364.2 +021200 02 FILLER PIC X(40) VALUE ST1364.2 +021300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1364.2 +021400 01 XXINFO. ST1364.2 +021500 02 FILLER PIC X(19) VALUE ST1364.2 +021600 "*** INFORMATION ***". ST1364.2 +021700 02 INFO-TEXT. ST1364.2 +021800 04 FILLER PIC X(8) VALUE SPACE. ST1364.2 +021900 04 XXCOMPUTED PIC X(20). ST1364.2 +022000 04 FILLER PIC X(5) VALUE SPACE. ST1364.2 +022100 04 XXCORRECT PIC X(20). ST1364.2 +022200 02 INF-ANSI-REFERENCE PIC X(48). ST1364.2 +022300 01 HYPHEN-LINE. ST1364.2 +022400 02 FILLER PIC IS X VALUE IS SPACE. ST1364.2 +022500 02 FILLER PIC IS X(65) VALUE IS "************************ST1364.2 +022600- "*****************************************". ST1364.2 +022700 02 FILLER PIC IS X(54) VALUE IS "************************ST1364.2 +022800- "******************************". ST1364.2 +022900 01 CCVS-PGM-ID PIC X(9) VALUE ST1364.2 +023000 "ST136A". ST1364.2 +023100 PROCEDURE DIVISION. ST1364.2 +023200 CCVS1 SECTION. ST1364.2 +023300 OPEN-FILES. ST1364.2 +023400 OPEN OUTPUT PRINT-FILE. ST1364.2 +023500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1364.2 +023600 MOVE SPACE TO TEST-RESULTS. ST1364.2 +023700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1364.2 +023800 GO TO CCVS1-EXIT. ST1364.2 +023900 CLOSE-FILES. ST1364.2 +024000 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1364.2 +024100 TERMINATE-CCVS. ST1364.2 +024200*S EXIT PROGRAM. ST1364.2 +024300*SERMINATE-CALL. ST1364.2 +024400 STOP RUN. ST1364.2 +024500 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1364.2 +024600 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1364.2 +024700 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1364.2 +024800 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1364.2 +024900 MOVE "****TEST DELETED****" TO RE-MARK. ST1364.2 +025000 PRINT-DETAIL. ST1364.2 +025100 IF REC-CT NOT EQUAL TO ZERO ST1364.2 +025200 MOVE "." TO PARDOT-X ST1364.2 +025300 MOVE REC-CT TO DOTVALUE. ST1364.2 +025400 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1364.2 +025500 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1364.2 +025600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1364.2 +025700 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1364.2 +025800 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1364.2 +025900 MOVE SPACE TO CORRECT-X. ST1364.2 +026000 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1364.2 +026100 MOVE SPACE TO RE-MARK. ST1364.2 +026200 HEAD-ROUTINE. ST1364.2 +026300 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +026400 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +026500 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1364.2 +026600 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1364.2 +026700 COLUMN-NAMES-ROUTINE. ST1364.2 +026800 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +026900 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +027000 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +027100 END-ROUTINE. ST1364.2 +027200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1364.2 +027300 END-RTN-EXIT. ST1364.2 +027400 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +027500 END-ROUTINE-1. ST1364.2 +027600 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1364.2 +027700 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1364.2 +027800 ADD PASS-COUNTER TO ERROR-HOLD. ST1364.2 +027900* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1364.2 +028000 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1364.2 +028100 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1364.2 +028200 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1364.2 +028300 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1364.2 +028400 END-ROUTINE-12. ST1364.2 +028500 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1364.2 +028600 IF ERROR-COUNTER IS EQUAL TO ZERO ST1364.2 +028700 MOVE "NO " TO ERROR-TOTAL ST1364.2 +028800 ELSE ST1364.2 +028900 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1364.2 +029000 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1364.2 +029100 PERFORM WRITE-LINE. ST1364.2 +029200 END-ROUTINE-13. ST1364.2 +029300 IF DELETE-COUNTER IS EQUAL TO ZERO ST1364.2 +029400 MOVE "NO " TO ERROR-TOTAL ELSE ST1364.2 +029500 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1364.2 +029600 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1364.2 +029700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +029800 IF INSPECT-COUNTER EQUAL TO ZERO ST1364.2 +029900 MOVE "NO " TO ERROR-TOTAL ST1364.2 +030000 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1364.2 +030100 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1364.2 +030200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +030300 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1364.2 +030400 WRITE-LINE. ST1364.2 +030500 ADD 1 TO RECORD-COUNT. ST1364.2 +030600 IF RECORD-COUNT GREATER 42 ST1364.2 +030700 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1364.2 +030800 MOVE SPACE TO DUMMY-RECORD ST1364.2 +030900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1364.2 +031000 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1364.2 +031100 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1364.2 +031200 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1364.2 +031300 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1364.2 +031400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1364.2 +031500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1364.2 +031600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1364.2 +031700 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1364.2 +031800 MOVE ZERO TO RECORD-COUNT. ST1364.2 +031900 PERFORM WRT-LN. ST1364.2 +032000 WRT-LN. ST1364.2 +032100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1364.2 +032200 MOVE SPACE TO DUMMY-RECORD. ST1364.2 +032300 BLANK-LINE-PRINT. ST1364.2 +032400 PERFORM WRT-LN. ST1364.2 +032500 FAIL-ROUTINE. ST1364.2 +032600 IF COMPUTED-X NOT EQUAL TO SPACE ST1364.2 +032700 GO TO FAIL-ROUTINE-WRITE. ST1364.2 +032800 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1364.2 +032900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1364.2 +033000 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1364.2 +033100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +033200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1364.2 +033300 GO TO FAIL-ROUTINE-EX. ST1364.2 +033400 FAIL-ROUTINE-WRITE. ST1364.2 +033500 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1364.2 +033600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1364.2 +033700 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1364.2 +033800 MOVE SPACES TO COR-ANSI-REFERENCE. ST1364.2 +033900 FAIL-ROUTINE-EX. EXIT. ST1364.2 +034000 BAIL-OUT. ST1364.2 +034100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1364.2 +034200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1364.2 +034300 BAIL-OUT-WRITE. ST1364.2 +034400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1364.2 +034500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1364.2 +034600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1364.2 +034700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1364.2 +034800 BAIL-OUT-EX. EXIT. ST1364.2 +034900 CCVS1-EXIT. ST1364.2 +035000 EXIT. ST1364.2 +035100 SORT-PARA SECTION. ST1364.2 +035200 SORT-PARAGRAPH. ST1364.2 +035300 SORT SORTFILE-2F ON ASCENDING KEY ST1364.2 +035400 SORTFILE-KEY ST1364.2 +035500 INPUT PROCEDURE INPROC ST1364.2 +035600 GIVING SORTOUT-2F. ST1364.2 +035700 GO TO SORT-TESTS. ST1364.2 +035800 INPROC SECTION. ST1364.2 +035900 INPROC-SYSIN. ST1364.2 +036000 MOVE "RELEASE FROM" TO FEATURE. ST1364.2 +036100 MOVE 10 TO UTIL-CTR. ST1364.2 +036200 SORT-TEST-1. ST1364.2 +036300 MOVE "SORT-TEST-1" TO PAR-NAME. ST1364.2 +036400 PERFORM RELEASE-SORTFILE-REC. ST1364.2 +036500 IF WORK-REC EQUAL TO HOLD-REC ST1364.2 +036600 PERFORM PASS-1 GO TO SORT-WRITE-1. ST1364.2 +036700 SORT-FAIL-1. ST1364.2 +036800 MOVE WORK-NON-KEY-1 TO COMPUTED-A. ST1364.2 +036900 MOVE HOLD-NON-KEY-1 TO CORRECT-A. ST1364.2 +037000 PERFORM FAIL-1. ST1364.2 +037100 PERFORM PRINT-DETAIL-1. ST1364.2 +037200 MOVE WORK-KEY TO COMPUTED-N. ST1364.2 +037300 MOVE HOLD-KEY TO CORRECT-N. ST1364.2 +037400 MOVE COMMENT-1 TO RE-MARK. ST1364.2 +037500 PERFORM PRINT-DETAIL-1. ST1364.2 +037600 MOVE WORK-NON-KEY-2 TO COMPUTED-BREAKDOWN. ST1364.2 +037700 MOVE HOLD-NON-KEY-2 TO CORRECT-BREAKDOWN. ST1364.2 +037800 MOVE FIRST-20CM TO COMPUTED-A. ST1364.2 +037900 MOVE FIRST-20CR TO CORRECT-A. ST1364.2 +038000 MOVE COMMENT-2 TO RE-MARK. ST1364.2 +038100 PERFORM PRINT-DETAIL-1. ST1364.2 +038200 MOVE SECOND-20CM TO COMPUTED-A. ST1364.2 +038300 MOVE SECOND-20CR TO CORRECT-A. ST1364.2 +038400 MOVE COMMENT-3 TO RE-MARK. ST1364.2 +038500 PERFORM PRINT-DETAIL-1. ST1364.2 +038600 MOVE THIRD-20CM TO COMPUTED-A. ST1364.2 +038700 MOVE THIRD-20CR TO CORRECT-A. ST1364.2 +038800 MOVE COMMENT-4 TO RE-MARK. ST1364.2 +038900 SORT-WRITE-1. ST1364.2 +039000 PERFORM PRINT-DETAIL-1. ST1364.2 +039100 INPROC-CONTINUE. ST1364.2 +039200 PERFORM RELEASE-SORTFILE-REC 9 TIMES. ST1364.2 +039300 GO TO INPROC-EXIT. ST1364.2 +039400 RELEASE-SORTFILE-REC. ST1364.2 +039500 MOVE ALL-A TO WORK-NON-KEY-2. ST1364.2 +039600 MOVE UTIL-CTR TO WORK-KEY. ST1364.2 +039700 MOVE "B" TO WORK-NON-KEY-1. ST1364.2 +039800 MOVE ALL-Z TO SORTFILE-NON-KEY-1. ST1364.2 +039900 MOVE -12345 TO SORTFILE-KEY. ST1364.2 +040000 MOVE ALL-X TO SORTFILE-NON-KEY-2. ST1364.2 +040100* NOTE A FALSE RECORD HAS BEEN MOVED TO SORTFILE-REC --- ST1364.2 +040200* THE RELEASE STATEMENT WHICH FOLLOWS SHOULD CLOBBER ST1364.2 +040300* IT COMPLETELY. ST1364.2 +040400 MOVE WORK-REC TO HOLD-REC. ST1364.2 +040500 RELEASE SORTFILE-REC FROM WORK-REC. ST1364.2 +040600 SUBTRACT 1 FROM UTIL-CTR. ST1364.2 +040700 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1364.2 +040800 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1364.2 +040900 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1364.2 +041000 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1364.2 +041100 MOVE "****TEST DELETED****" TO RE-MARK. ST1364.2 +041200 PRINT-DETAIL-1. ST1364.2 +041300 IF REC-CT NOT EQUAL TO ZERO ST1364.2 +041400 MOVE "." TO PARDOT-X ST1364.2 +041500 MOVE REC-CT TO DOTVALUE. ST1364.2 +041600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1364.2 +041700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1364.2 +041800 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1364.2 +041900 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1364.2 +042000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1364.2 +042100 MOVE SPACE TO CORRECT-X. ST1364.2 +042200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1364.2 +042300 MOVE SPACE TO RE-MARK. ST1364.2 +042400 WRITE-LINE-1. ST1364.2 +042500 ADD 1 TO RECORD-COUNT. ST1364.2 +042600 IF RECORD-COUNT GREATER 50 ST1364.2 +042700 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1364.2 +042800 MOVE SPACE TO DUMMY-RECORD ST1364.2 +042900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1364.2 +043000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1364.2 +043100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1364.2 +043200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1364.2 +043300 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1364.2 +043400 MOVE ZERO TO RECORD-COUNT. ST1364.2 +043500 PERFORM WRT-LN-1. ST1364.2 +043600 WRT-LN-1. ST1364.2 +043700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1364.2 +043800 MOVE SPACE TO DUMMY-RECORD. ST1364.2 +043900 BLANK-LINE-PRINT-1. ST1364.2 +044000 PERFORM WRT-LN-1. ST1364.2 +044100 FAIL-ROUTINE-1. ST1364.2 +044200 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1364.2 +044300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1364.2 +044400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1364.2 +044500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1364.2 +044600 GO TO FAIL-ROUTINE-EX-1. ST1364.2 +044700 FAIL-RTN-WRITE-1. ST1364.2 +044800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1364.2 +044900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1364.2 +045000 FAIL-ROUTINE-EX-1. EXIT. ST1364.2 +045100 BAIL-OUT-1. ST1364.2 +045200 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1364.2 +045300 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1364.2 +045400 BAIL-OUT-WRITE-1. ST1364.2 +045500 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1364.2 +045600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1364.2 +045700 BAIL-OUT-EX-1. EXIT. ST1364.2 +045800 INPROC-EXIT. ST1364.2 +045900 EXIT. ST1364.2 +046000 SORT-TESTS SECTION. ST1364.2 +046100 SORT-INIT. ST1364.2 +046200 OPEN INPUT SORTOUT-2F. ST1364.2 +046300 MOVE ZERO TO UTIL-CTR. ST1364.2 +046400 SORT-TEST-2. ST1364.2 +046500 MOVE "SORT-TEST-2" TO PAR-NAME. ST1364.2 +046600 PERFORM READ-SORTOUT. ST1364.2 +046700 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-B ST1364.2 +046800 GO TO SORT-FAIL-2. ST1364.2 +046900 IF SORTOUT-KEY NOT EQUAL TO 1 ST1364.2 +047000 GO TO SORT-FAIL-2. ST1364.2 +047100 IF SORTOUT-NON-KEY-2 EQUAL TO ALL-A ST1364.2 +047200 PERFORM PASS GO TO SORT-WRITE-2. ST1364.2 +047300 SORT-FAIL-2. ST1364.2 +047400 MOVE 1 TO CORRECT-N. ST1364.2 +047500 PERFORM BREAKDOWN-PARA. ST1364.2 +047600 SORT-WRITE-2. ST1364.2 +047700 PERFORM PRINT-DETAIL. ST1364.2 +047800 SORT-TEST-3. ST1364.2 +047900 MOVE "SORT-TEST-3" TO PAR-NAME. ST1364.2 +048000 PERFORM READ-SORTOUT 6 TIMES. ST1364.2 +048100 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-B ST1364.2 +048200 GO TO SORT-FAIL-3. ST1364.2 +048300 IF SORTOUT-KEY NOT EQUAL TO 7 ST1364.2 +048400 GO TO SORT-FAIL-3. ST1364.2 +048500 IF SORTOUT-NON-KEY-2 EQUAL TO ALL-A ST1364.2 +048600 PERFORM PASS GO TO SORT-WRITE-3. ST1364.2 +048700 SORT-FAIL-3. ST1364.2 +048800 MOVE 7 TO CORRECT-N. ST1364.2 +048900 PERFORM BREAKDOWN-PARA. ST1364.2 +049000 SORT-WRITE-3. ST1364.2 +049100 PERFORM PRINT-DETAIL. ST1364.2 +049200 SORT-TEST-4. ST1364.2 +049300 MOVE "SORT-TEST-4" TO PAR-NAME. ST1364.2 +049400 PERFORM READ-SORTOUT 3 TIMES. ST1364.2 +049500 IF SORTOUT-NON-KEY-1 NOT EQUAL TO LITERAL-B ST1364.2 +049600 GO TO SORT-FAIL-4. ST1364.2 +049700 IF SORTOUT-KEY NOT EQUAL TO 10 ST1364.2 +049800 GO TO SORT-FAIL-4. ST1364.2 +049900 IF SORTOUT-NON-KEY-2 EQUAL TO ALL-A ST1364.2 +050000 PERFORM PASS GO TO SORT-WRITE-4. ST1364.2 +050100 SORT-FAIL-4. ST1364.2 +050200 MOVE 10 TO CORRECT-N. ST1364.2 +050300 PERFORM BREAKDOWN-PARA. ST1364.2 +050400 SORT-WRITE-4. ST1364.2 +050500 PERFORM PRINT-DETAIL. ST1364.2 +050600 SORT-TEST-5. ST1364.2 +050700 MOVE "SORT-TEST-5" TO PAR-NAME. ST1364.2 +050800 READ SORTOUT-2F AT END ST1364.2 +050900 PERFORM PASS GO TO SORT-WRITE-5. ST1364.2 +051000 SORT-FAIL-5. ST1364.2 +051100 MOVE SPACE TO ALL-A. ST1364.2 +051200 MOVE SPACE TO LITERAL-B ST1364.2 +051300 PERFORM BREAKDOWN-PARA. ST1364.2 +051400 PERFORM PRINT-DETAIL. ST1364.2 +051500 MOVE "END OF FILE NOT FOUND" TO RE-MARK. ST1364.2 +051600 SORT-WRITE-5. ST1364.2 +051700 PERFORM PRINT-DETAIL. ST1364.2 +051800 CLOSE-SORT-FILES. ST1364.2 +051900 CLOSE SORTOUT-2F. ST1364.2 +052000 GO TO CCVS-EXIT. ST1364.2 +052100 BREAKDOWN-PARA. ST1364.2 +052200 MOVE SORTOUT-KEY TO COMPUTED-N. ST1364.2 +052300 MOVE COMMENT-1 TO RE-MARK. ST1364.2 +052400 PERFORM FAIL. ST1364.2 +052500 PERFORM PRINT-DETAIL. ST1364.2 +052600 MOVE SORTOUT-NON-KEY-1 TO COMPUTED-A. ST1364.2 +052700 MOVE LITERAL-B TO CORRECT-A. ST1364.2 +052800 PERFORM PRINT-DETAIL. ST1364.2 +052900 MOVE SORTOUT-NON-KEY-2 TO COMPUTED-BREAKDOWN. ST1364.2 +053000 MOVE FIRST-20CM TO COMPUTED-A. ST1364.2 +053100 MOVE ALL-A TO CORRECT-A. ST1364.2 +053200 MOVE COMMENT-2 TO RE-MARK. ST1364.2 +053300 PERFORM PRINT-DETAIL. ST1364.2 +053400 MOVE SECOND-20CM TO COMPUTED-A. ST1364.2 +053500 MOVE ALL-A TO CORRECT-A. ST1364.2 +053600 MOVE COMMENT-3 TO RE-MARK. ST1364.2 +053700 PERFORM PRINT-DETAIL. ST1364.2 +053800 MOVE THIRD-20CM TO COMPUTED-A. ST1364.2 +053900 MOVE ALL-A TO CORRECT-A. ST1364.2 +054000 MOVE COMMENT-4 TO RE-MARK. ST1364.2 +054100 READ-SORTOUT. ST1364.2 +054200 READ SORTOUT-2F AT END GO TO READ-ERROR. ST1364.2 +054300 ADD 1 TO UTIL-CTR. ST1364.2 +054400 READ-ERROR. ST1364.2 +054500 MOVE UTIL-CTR TO COMPUTED-N. ST1364.2 +054600 MOVE 10 TO CORRECT-N. ST1364.2 +054700 MOVE "TOO FEW RECORDS IN FILE" TO RE-MARK. ST1364.2 +054800 PERFORM FAIL. ST1364.2 +054900 MOVE "READ-ERROR" TO PAR-NAME ST1364.2 +055000 PERFORM PRINT-DETAIL. ST1364.2 +055100 GO TO CLOSE-SORT-FILES. ST1364.2 +055200 CCVS-EXIT SECTION. ST1364.2 +055300 CCVS-999999. ST1364.2 +055400 GO TO CLOSE-FILES. ST1364.2 diff --git a/tests/cobol85/ST/ST137A.CBL b/tests/cobol85/ST/ST137A.CBL new file mode 100755 index 00000000..85ca285a --- /dev/null +++ b/tests/cobol85/ST/ST137A.CBL @@ -0,0 +1,747 @@ +000100 IDENTIFICATION DIVISION. ST1374.2 +000200 PROGRAM-ID. ST1374.2 +000300 ST137A. ST1374.2 +000400**************************************************************** ST1374.2 +000500* * ST1374.2 +000600* VALIDATION FOR:- * ST1374.2 +000700* * ST1374.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1374.2 +000900* * ST1374.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1374.2 +001100* * ST1374.2 +001200**************************************************************** ST1374.2 +001300* OBJECTIVE - ST1374.2 +001400* ROUTINE ST207 IS A TEST OF THE SORT STATEMENT USING ST1374.2 +001500* VARIABLE LENGTH RECORDS WHICH CONTAIN ODO (OCCURS DEPENDING ST1374.2 +001600* ON) CLAUSES IN THEIR RECORD DESCRIPTIONS. ST1374.2 +001700* ST1374.2 +001800* ST1374.2 +001900* FEATURES TESTED - ST1374.2 +002000* * COLLATING SEQUENCE IS NATIVE. NO COLLATING SEQUENCE ST1374.2 +002100* STATEMENT IS USED IN THE ACTUAL SORT STATEMENT. ST1374.2 +002200* * VARIABLE LENGTH RECORDS ST1374.2 +002300* * OCCURS DEPENDING ON CLAUSES ST1374.2 +002400* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1374.2 +002500* ST1374.2 +002600* * SORT SORT-FILE-NAME ST1374.2 +002700* ON ASCENDING KEY KEY-1 OF DATA-NAME-1 ST1374.2 +002800* ASCENDING KEY-2 OF DATA-NAME-2 ST1374.2 +002900* USING FILE-NAME-1 ST1374.2 +003000* GIVING FILE-NAME-2. ST1374.2 +003100* ST1374.2 +003200* ST1374.2 +003300* ANSI X3.23-1974 REFERENCES - ST1374.2 +003400* * SECTION 2.1 OCCURS DEPENDING ON PAGE III-2 ST1374.2 +003500* * SECTION 4.4 THE SORT STATEMENT PAGE VII-14 ST1374.2 +003600* ST1374.2 +003700* ST1374.2 +003800* FILES USED - ST1374.2 +003900* * FILES SQ-FS1 AND SQ-FS2 ON MAGNETIC TAPE OR MASS-STORAGE ST1374.2 +004000* ARE FIRST CREATED BY ROUTINE ST207. THE FIRST FILE (SQ-FS1) ST1374.2 +004100* IS THEN SORTED GIVING THE SECOND FILE (SQ-FS2). ST1374.2 +004200* ST1374.2 +004300* SQ-FS1 - ST1374.2 +004400* 51 RECORDS ST1374.2 +004500* VARIABLE LENGTH RECORDS (148 TO 1435 CHARACTERS) USING ODO ST1374.2 +004600* BLOCKED 1 ST1374.2 +004700* RESERVE 2 AREAS ST1374.2 +004800* ST1374.2 +004900* SQ-FS2 - ST1374.2 +005000* 51 RECORDS ST1374.2 +005100* VARIABLE LENGTH RECORDS FORMAT WITH ODO BUT ACTUALLY ALL ST1374.2 +005200* RECORDS ARE FIXED LENGTH 148 CHARACTERS. ST1374.2 +005300* BLOCKED 2 ST1374.2 +005400* RESERVE 4 AREAS ST1374.2 +005500* ST1374.2 +005600* NOTE THAT SQ-FS2 IS OVERWRITTEN AS A RESULT OF THE SORT ST1374.2 +005700* AND SHOULD CONTAIN A FINAL TOTAL OF 51 RECORDS. ST1374.2 +005800* ST1374.2 +005900* ST1374.2 +006000* X-CARDS USED - ST1374.2 +006100* X-XXX014 SQ-FS1 ST1374.2 +006200* X-XXX015 SQ-FS2 ST1374.2 +006300* X-XXX027 SORT FILE ST-FS1 ST1374.2 +006400* X-XXX063 NATIVE COLLATING SEQUENCE ASCENDING ORDER (NOTE ST1374.2 +006500* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-63 ST1374.2 +006600* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1374.2 +006700* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1374.2 +006800* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1374.2 +006900* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-63 CARD..... ST1374.2 +007000* ST1374.2 +007100* X-63 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1374.2 +007200* ST1374.2 +007300* ST1374.2 +007400* OPTIONS RECOMMENDED - ST1374.2 +007500* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1374.2 +007600* FILES AS THEY ARE CREATED AND READ DURING ST1374.2 +007700* TESTS 3 THRU 6. ST1374.2 +007800* ST1374.2 +007900* ST1374.2 +008000* TEST DESCRIPTIONS - ST1374.2 +008100* SRT-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1374.2 +008200* SRT-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1374.2 +008300* SRT-TEST-003 TESTS RECORDS 1-20 ON SORTED SQ-FS2 ST1374.2 +008400* SRT-TEST-004 TESTS RECORDS 21-40 ON SORTED SQ-FS2 ST1374.2 +008500* SRT-TEST-005 TESTS RECORDS 41-51 ON SORTED SQ-FS2 ST1374.2 +008600* SRT-TEST-006 AN EOF CHECK ON SQ-FS2 ST1374.2 +008700* ST1374.2 +008800* ST1374.2 +008900* ************************************************************ ST1374.2 +009000 ENVIRONMENT DIVISION. ST1374.2 +009100 CONFIGURATION SECTION. ST1374.2 +009200 SOURCE-COMPUTER. ST1374.2 +009300 Linux. ST1374.2 +009400 OBJECT-COMPUTER. ST1374.2 +009500 Linux. ST1374.2 +009600 INPUT-OUTPUT SECTION. ST1374.2 +009700 FILE-CONTROL. ST1374.2 +009800 SELECT PRINT-FILE ASSIGN TO ST1374.2 +009900 "report.log". ST1374.2 +010000 SELECT SQ-FS1 ASSIGN TO ST1374.2 +010100 "XXXXX014" ST1374.2 +010200 ORGANIZATION IS SEQUENTIAL ST1374.2 +010300 ACCESS MODE IS SEQUENTIAL ST1374.2 +010400 RESERVE 2 AREAS. ST1374.2 +010500 SELECT SQ-FS2 ASSIGN TO ST1374.2 +010600 "XXXXX015" ST1374.2 +010700 ORGANIZATION IS SEQUENTIAL ST1374.2 +010800 ACCESS MODE IS SEQUENTIAL ST1374.2 +010900 RESERVE 4 AREAS. ST1374.2 +011000 SELECT ST-FS1 ASSIGN TO ST1374.2 +011100 "XXXXX027". ST1374.2 +011200 DATA DIVISION. ST1374.2 +011300 FILE SECTION. ST1374.2 +011400 FD PRINT-FILE. ST1374.2 +011500 01 PRINT-REC PICTURE X(120). ST1374.2 +011600 01 DUMMY-RECORD PICTURE X(120). ST1374.2 +011700 FD SQ-FS1 ST1374.2 +011800 LABEL RECORDS STANDARD ST1374.2 +011900*C VALUE OF ST1374.2 +012000*C OCLABELID ST1374.2 +012100*C IS ST1374.2 +012200*C "OCDUMMY" ST1374.2 +012300*G SYSIN ST1374.2 +012400 BLOCK CONTAINS 1 RECORDS ST1374.2 +012500 RECORD CONTAINS 148 TO 1435 CHARACTERS. ST1374.2 +012600 01 SQ-FS1R1-F-G-132. ST1374.2 +012700 10 REC-PREAMBLE PIC X(120). ST1374.2 +012800 10 REST-OF-1. ST1374.2 +012900 20 LENGTH-1 PIC 999. ST1374.2 +013000 20 KEY-1. ST1374.2 +013100 30 ALPHAN-KEY PIC X. ST1374.2 +013200 30 NUM-KEY PIC 999. ST1374.2 +013300 20 KEY-2. ST1374.2 +013400 30 ALPHAN-KEY PIC X. ST1374.2 +013500 30 NUM-KEY PIC 999. ST1374.2 +013600 20 KEY-3. ST1374.2 +013700 30 ALPHAN-KEY PIC X. ST1374.2 +013800 30 NUM-KEY PIC 999. ST1374.2 +013900 20 STUFF-1 OCCURS 1 TO 100 TIMES DEPENDING ON LENGTH-1. ST1374.2 +014000 30 FILLER PIC X(13). ST1374.2 +014100 FD SQ-FS2 ST1374.2 +014200 LABEL RECORDS STANDARD ST1374.2 +014300*C VALUE OF ST1374.2 +014400*C OCLABELID ST1374.2 +014500*C IS ST1374.2 +014600*C "OCDUMMY" ST1374.2 +014700*G SYSIN ST1374.2 +014800 BLOCK CONTAINS 2 RECORDS ST1374.2 +014900 RECORD CONTAINS 148 TO 1435 CHARACTERS ST1374.2 +015000 DATA RECORD SQ-FS2R1-F-G-132. ST1374.2 +015100 01 SQ-FS2R1-F-G-132. ST1374.2 +015200 10 REC-PRE-2 PIC X(120). ST1374.2 +015300 10 REST-OF-2. ST1374.2 +015400 20 LENGTH-2 PIC 999. ST1374.2 +015500 20 KEY-4. ST1374.2 +015600 30 ALPHAN-KEY PIC X. ST1374.2 +015700 30 NUM-KEY PIC 999. ST1374.2 +015800 20 KEY-5. ST1374.2 +015900 30 ALPHAN-KEY PIC X. ST1374.2 +016000 30 NUM-KEY PIC 999. ST1374.2 +016100 20 KEY-6. ST1374.2 +016200 30 ALPHAN-KEY PIC X. ST1374.2 +016300 30 NUM-KEY PIC 999. ST1374.2 +016400 20 STUFF-2 OCCURS 1 TO 100 TIMES DEPENDING ON LENGTH-100. ST1374.2 +016500 30 FILLER PIC X(13). ST1374.2 +016600 SD ST-FS1 ST1374.2 +016700 RECORD CONTAINS 148 TO 1435 CHARACTERS ST1374.2 +016800 DATA RECORD IS ST-FS1R1-F-G-132. ST1374.2 +016900 01 ST-FS1R1-F-G-132. ST1374.2 +017000 02 FILLER PIC X(120). ST1374.2 +017100 02 LENGTH-3 PIC 999. ST1374.2 +017200 02 NON-KEY-1. ST1374.2 +017300 03 A-KEY PIC X. ST1374.2 +017400 03 N-KEY PIC 999. ST1374.2 +017500 02 SORT-KEY. ST1374.2 +017600 03 A-KEY PIC X. ST1374.2 +017700 03 N-KEY PIC 999. ST1374.2 +017800 02 NON-KEY-2. ST1374.2 +017900 03 A-KEY PIC X. ST1374.2 +018000 03 N-KEY PIC 999. ST1374.2 +018100 02 STUFF-3 OCCURS 1 TO 100 TIMES DEPENDING ON LENGTH-100. ST1374.2 +018200 03 FILLER PIC X(13). ST1374.2 +018300 WORKING-STORAGE SECTION. ST1374.2 +018400 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1374.2 +018500 77 WRK-DU-999-0001 PIC 999. ST1374.2 +018600 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1374.2 +018700 77 WRK-DU-999-0002 PIC 999 VALUE 0. ST1374.2 +018800 77 LENGTH-100 PIC 999 VALUE 100. ST1374.2 +018900 01 WRK-XN-0001 PIC X(51) VALUE ST1374.2 +019000 "/A.Z-B,Y+C*X)D(W$E$V F0U1G2T3H4S5I6R7J8Q9K;PMN". ST1374.2 +019100 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1374.2 +019200 02 CHAR PIC X OCCURS 51 TIMES. ST1374.2 +019300 01 WRK-XN-2 PIC X(51) VALUE ST1374.2 +019400 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1374.2 +019500 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1374.2 +019600 02 ASCIIS PIC X OCCURS 51 TIMES. ST1374.2 +019700 01 WRK-XN-O020F-0001. ST1374.2 +019800 02 COMPU PIC X OCCURS 20 TIMES. ST1374.2 +019900 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1374.2 +020000 02 FILLER PIC X(20). ST1374.2 +020100 01 WRK-XN-O120F-1. ST1374.2 +020200 02 COLLS PIC X OCCURS 120 TIMES. ST1374.2 +020300 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1374.2 +020400 02 WRK-XN-0002 PIC X(20). ST1374.2 +020500 02 WRK-XN-0003 PIC X(20). ST1374.2 +020600 02 WRK-XN-0004 PIC X(20). ST1374.2 +020700 02 WRK-XN-0005 PIC X(20). ST1374.2 +020800 02 WRK-XN-0006 PIC X(20). ST1374.2 +020900 02 WRK-XN-0007 PIC X(20). ST1374.2 +021000 01 FILE-RECORD-INFORMATION-REC. ST1374.2 +021100 03 FILE-RECORD-INFO-SKELETON. ST1374.2 +021200 05 FILLER PICTURE X(48) VALUE ST1374.2 +021300 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1374.2 +021400 05 FILLER PICTURE X(46) VALUE ST1374.2 +021500 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1374.2 +021600 05 FILLER PICTURE X(26) VALUE ST1374.2 +021700 ",LFIL=000000,ORG= ,LBLR= ". ST1374.2 +021800 05 FILLER PICTURE X(37) VALUE ST1374.2 +021900 ",RECKEY= ". ST1374.2 +022000 05 FILLER PICTURE X(38) VALUE ST1374.2 +022100 ",ALTKEY1= ". ST1374.2 +022200 05 FILLER PICTURE X(38) VALUE ST1374.2 +022300 ",ALTKEY2= ". ST1374.2 +022400 05 FILLER PICTURE X(7) VALUE SPACE.ST1374.2 +022500 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1374.2 +022600 05 FILE-RECORD-INFO-P1-120. ST1374.2 +022700 07 FILLER PIC X(5). ST1374.2 +022800 07 XFILE-NAME PIC X(6). ST1374.2 +022900 07 FILLER PIC X(8). ST1374.2 +023000 07 XRECORD-NAME PIC X(6). ST1374.2 +023100 07 FILLER PIC X(1). ST1374.2 +023200 07 REELUNIT-NUMBER PIC 9(1). ST1374.2 +023300 07 FILLER PIC X(7). ST1374.2 +023400 07 XRECORD-NUMBER PIC 9(6). ST1374.2 +023500 07 FILLER PIC X(6). ST1374.2 +023600 07 UPDATE-NUMBER PIC 9(2). ST1374.2 +023700 07 FILLER PIC X(5). ST1374.2 +023800 07 ODO-NUMBER PIC 9(4). ST1374.2 +023900 07 FILLER PIC X(5). ST1374.2 +024000 07 XPROGRAM-NAME PIC X(5). ST1374.2 +024100 07 FILLER PIC X(7). ST1374.2 +024200 07 XRECORD-LENGTH PIC 9(6). ST1374.2 +024300 07 FILLER PIC X(7). ST1374.2 +024400 07 CHARS-OR-RECORDS PIC X(2). ST1374.2 +024500 07 FILLER PIC X(1). ST1374.2 +024600 07 XBLOCK-SIZE PIC 9(4). ST1374.2 +024700 07 FILLER PIC X(6). ST1374.2 +024800 07 RECORDS-IN-FILE PIC 9(6). ST1374.2 +024900 07 FILLER PIC X(5). ST1374.2 +025000 07 XFILE-ORGANIZATION PIC X(2). ST1374.2 +025100 07 FILLER PIC X(6). ST1374.2 +025200 07 XLABEL-TYPE PIC X(1). ST1374.2 +025300 05 FILE-RECORD-INFO-P121-240. ST1374.2 +025400 07 FILLER PIC X(8). ST1374.2 +025500 07 XRECORD-KEY PIC X(29). ST1374.2 +025600 07 FILLER PIC X(9). ST1374.2 +025700 07 ALTERNATE-KEY1 PIC X(29). ST1374.2 +025800 07 FILLER PIC X(9). ST1374.2 +025900 07 ALTERNATE-KEY2 PIC X(29). ST1374.2 +026000 07 FILLER PIC X(7). ST1374.2 +026100 01 TEST-RESULTS. ST1374.2 +026200 02 FILLER PIC X VALUE SPACE. ST1374.2 +026300 02 FEATURE PIC X(20) VALUE SPACE. ST1374.2 +026400 02 FILLER PIC X VALUE SPACE. ST1374.2 +026500 02 P-OR-F PIC X(5) VALUE SPACE. ST1374.2 +026600 02 FILLER PIC X VALUE SPACE. ST1374.2 +026700 02 PAR-NAME. ST1374.2 +026800 03 FILLER PIC X(19) VALUE SPACE. ST1374.2 +026900 03 PARDOT-X PIC X VALUE SPACE. ST1374.2 +027000 03 DOTVALUE PIC 99 VALUE ZERO. ST1374.2 +027100 02 FILLER PIC X(8) VALUE SPACE. ST1374.2 +027200 02 RE-MARK PIC X(61). ST1374.2 +027300 01 TEST-COMPUTED. ST1374.2 +027400 02 FILLER PIC X(30) VALUE SPACE. ST1374.2 +027500 02 FILLER PIC X(17) VALUE ST1374.2 +027600 " COMPUTED=". ST1374.2 +027700 02 COMPUTED-X. ST1374.2 +027800 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1374.2 +027900 03 COMPUTED-N REDEFINES COMPUTED-A ST1374.2 +028000 PIC -9(9).9(9). ST1374.2 +028100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1374.2 +028200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1374.2 +028300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1374.2 +028400 03 CM-18V0 REDEFINES COMPUTED-A. ST1374.2 +028500 04 COMPUTED-18V0 PIC -9(18). ST1374.2 +028600 04 FILLER PIC X. ST1374.2 +028700 03 FILLER PIC X(50) VALUE SPACE. ST1374.2 +028800 01 TEST-CORRECT. ST1374.2 +028900 02 FILLER PIC X(30) VALUE SPACE. ST1374.2 +029000 02 FILLER PIC X(17) VALUE " CORRECT =". ST1374.2 +029100 02 CORRECT-X. ST1374.2 +029200 03 CORRECT-A PIC X(20) VALUE SPACE. ST1374.2 +029300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1374.2 +029400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1374.2 +029500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1374.2 +029600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1374.2 +029700 03 CR-18V0 REDEFINES CORRECT-A. ST1374.2 +029800 04 CORRECT-18V0 PIC -9(18). ST1374.2 +029900 04 FILLER PIC X. ST1374.2 +030000 03 FILLER PIC X(2) VALUE SPACE. ST1374.2 +030100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1374.2 +030200 01 CCVS-C-1. ST1374.2 +030300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1374.2 +030400- "SS PARAGRAPH-NAME ST1374.2 +030500- " REMARKS". ST1374.2 +030600 02 FILLER PIC X(20) VALUE SPACE. ST1374.2 +030700 01 CCVS-C-2. ST1374.2 +030800 02 FILLER PIC X VALUE SPACE. ST1374.2 +030900 02 FILLER PIC X(6) VALUE "TESTED". ST1374.2 +031000 02 FILLER PIC X(15) VALUE SPACE. ST1374.2 +031100 02 FILLER PIC X(4) VALUE "FAIL". ST1374.2 +031200 02 FILLER PIC X(94) VALUE SPACE. ST1374.2 +031300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1374.2 +031400 01 REC-CT PIC 99 VALUE ZERO. ST1374.2 +031500 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1374.2 +031600 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1374.2 +031700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1374.2 +031800 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1374.2 +031900 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1374.2 +032000 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1374.2 +032100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1374.2 +032200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1374.2 +032300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1374.2 +032400 01 CCVS-H-1. ST1374.2 +032500 02 FILLER PIC X(39) VALUE SPACES. ST1374.2 +032600 02 FILLER PIC X(42) VALUE ST1374.2 +032700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1374.2 +032800 02 FILLER PIC X(39) VALUE SPACES. ST1374.2 +032900 01 CCVS-H-2A. ST1374.2 +033000 02 FILLER PIC X(40) VALUE SPACE. ST1374.2 +033100 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1374.2 +033200 02 FILLER PIC XXXX VALUE ST1374.2 +033300 "4.2 ". ST1374.2 +033400 02 FILLER PIC X(28) VALUE ST1374.2 +033500 " COPY - NOT FOR DISTRIBUTION". ST1374.2 +033600 02 FILLER PIC X(41) VALUE SPACE. ST1374.2 +033700 ST1374.2 +033800 01 CCVS-H-2B. ST1374.2 +033900 02 FILLER PIC X(15) VALUE ST1374.2 +034000 "TEST RESULT OF ". ST1374.2 +034100 02 TEST-ID PIC X(9). ST1374.2 +034200 02 FILLER PIC X(4) VALUE ST1374.2 +034300 " IN ". ST1374.2 +034400 02 FILLER PIC X(12) VALUE ST1374.2 +034500 " HIGH ". ST1374.2 +034600 02 FILLER PIC X(22) VALUE ST1374.2 +034700 " LEVEL VALIDATION FOR ". ST1374.2 +034800 02 FILLER PIC X(58) VALUE ST1374.2 +034900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1374.2 +035000 01 CCVS-H-3. ST1374.2 +035100 02 FILLER PIC X(34) VALUE ST1374.2 +035200 " FOR OFFICIAL USE ONLY ". ST1374.2 +035300 02 FILLER PIC X(58) VALUE ST1374.2 +035400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1374.2 +035500 02 FILLER PIC X(28) VALUE ST1374.2 +035600 " COPYRIGHT 1985 ". ST1374.2 +035700 01 CCVS-E-1. ST1374.2 +035800 02 FILLER PIC X(52) VALUE SPACE. ST1374.2 +035900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1374.2 +036000 02 ID-AGAIN PIC X(9). ST1374.2 +036100 02 FILLER PIC X(45) VALUE SPACES. ST1374.2 +036200 01 CCVS-E-2. ST1374.2 +036300 02 FILLER PIC X(31) VALUE SPACE. ST1374.2 +036400 02 FILLER PIC X(21) VALUE SPACE. ST1374.2 +036500 02 CCVS-E-2-2. ST1374.2 +036600 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1374.2 +036700 03 FILLER PIC X VALUE SPACE. ST1374.2 +036800 03 ENDER-DESC PIC X(44) VALUE ST1374.2 +036900 "ERRORS ENCOUNTERED". ST1374.2 +037000 01 CCVS-E-3. ST1374.2 +037100 02 FILLER PIC X(22) VALUE ST1374.2 +037200 " FOR OFFICIAL USE ONLY". ST1374.2 +037300 02 FILLER PIC X(12) VALUE SPACE. ST1374.2 +037400 02 FILLER PIC X(58) VALUE ST1374.2 +037500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1374.2 +037600 02 FILLER PIC X(13) VALUE SPACE. ST1374.2 +037700 02 FILLER PIC X(15) VALUE ST1374.2 +037800 " COPYRIGHT 1985". ST1374.2 +037900 01 CCVS-E-4. ST1374.2 +038000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1374.2 +038100 02 FILLER PIC X(4) VALUE " OF ". ST1374.2 +038200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1374.2 +038300 02 FILLER PIC X(40) VALUE ST1374.2 +038400 " TESTS WERE EXECUTED SUCCESSFULLY". ST1374.2 +038500 01 XXINFO. ST1374.2 +038600 02 FILLER PIC X(19) VALUE ST1374.2 +038700 "*** INFORMATION ***". ST1374.2 +038800 02 INFO-TEXT. ST1374.2 +038900 04 FILLER PIC X(8) VALUE SPACE. ST1374.2 +039000 04 XXCOMPUTED PIC X(20). ST1374.2 +039100 04 FILLER PIC X(5) VALUE SPACE. ST1374.2 +039200 04 XXCORRECT PIC X(20). ST1374.2 +039300 02 INF-ANSI-REFERENCE PIC X(48). ST1374.2 +039400 01 HYPHEN-LINE. ST1374.2 +039500 02 FILLER PIC IS X VALUE IS SPACE. ST1374.2 +039600 02 FILLER PIC IS X(65) VALUE IS "************************ST1374.2 +039700- "*****************************************". ST1374.2 +039800 02 FILLER PIC IS X(54) VALUE IS "************************ST1374.2 +039900- "******************************". ST1374.2 +040000 01 CCVS-PGM-ID PIC X(9) VALUE ST1374.2 +040100 "ST137A". ST1374.2 +040200 PROCEDURE DIVISION. ST1374.2 +040300 DECLARATIVES. ST1374.2 +040400 SECT-ST216-DEC SECTION. ST1374.2 +040500 USE AFTER STANDARD ERROR PROCEDURE ON OUTPUT. ST1374.2 +040600 SRT-WRITE-DEC. ST1374.2 +040700 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1374.2 +040800 MOVE "SRT-TEST-DEC" TO PAR-NAME. ST1374.2 +040900 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1374.2 +041000 STOP RUN. ST1374.2 +041100 END DECLARATIVES. ST1374.2 +041200 CCVS1 SECTION. ST1374.2 +041300 OPEN-FILES. ST1374.2 +041400 OPEN OUTPUT PRINT-FILE. ST1374.2 +041500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1374.2 +041600 MOVE SPACE TO TEST-RESULTS. ST1374.2 +041700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1374.2 +041800 MOVE ZERO TO REC-SKL-SUB. ST1374.2 +041900 PERFORM CCVS-INIT-FILE 9 TIMES. ST1374.2 +042000 CCVS-INIT-FILE. ST1374.2 +042100 ADD 1 TO REC-SKL-SUB. ST1374.2 +042200 MOVE FILE-RECORD-INFO-SKELETON ST1374.2 +042300 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1374.2 +042400 CCVS-INIT-EXIT. ST1374.2 +042500 GO TO CCVS1-EXIT. ST1374.2 +042600 CLOSE-FILES. ST1374.2 +042700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1374.2 +042800 TERMINATE-CCVS. ST1374.2 +042900*S EXIT PROGRAM. ST1374.2 +043000*SERMINATE-CALL. ST1374.2 +043100 STOP RUN. ST1374.2 +043200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1374.2 +043300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1374.2 +043400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1374.2 +043500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1374.2 +043600 MOVE "****TEST DELETED****" TO RE-MARK. ST1374.2 +043700 PRINT-DETAIL. ST1374.2 +043800 IF REC-CT NOT EQUAL TO ZERO ST1374.2 +043900 MOVE "." TO PARDOT-X ST1374.2 +044000 MOVE REC-CT TO DOTVALUE. ST1374.2 +044100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1374.2 +044200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1374.2 +044300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1374.2 +044400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1374.2 +044500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1374.2 +044600 MOVE SPACE TO CORRECT-X. ST1374.2 +044700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1374.2 +044800 MOVE SPACE TO RE-MARK. ST1374.2 +044900 HEAD-ROUTINE. ST1374.2 +045000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +045100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +045200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1374.2 +045300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1374.2 +045400 COLUMN-NAMES-ROUTINE. ST1374.2 +045500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +045600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +045700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +045800 END-ROUTINE. ST1374.2 +045900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1374.2 +046000 END-RTN-EXIT. ST1374.2 +046100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +046200 END-ROUTINE-1. ST1374.2 +046300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1374.2 +046400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1374.2 +046500 ADD PASS-COUNTER TO ERROR-HOLD. ST1374.2 +046600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1374.2 +046700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1374.2 +046800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1374.2 +046900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1374.2 +047000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1374.2 +047100 END-ROUTINE-12. ST1374.2 +047200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1374.2 +047300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1374.2 +047400 MOVE "NO " TO ERROR-TOTAL ST1374.2 +047500 ELSE ST1374.2 +047600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1374.2 +047700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1374.2 +047800 PERFORM WRITE-LINE. ST1374.2 +047900 END-ROUTINE-13. ST1374.2 +048000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1374.2 +048100 MOVE "NO " TO ERROR-TOTAL ELSE ST1374.2 +048200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1374.2 +048300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1374.2 +048400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +048500 IF INSPECT-COUNTER EQUAL TO ZERO ST1374.2 +048600 MOVE "NO " TO ERROR-TOTAL ST1374.2 +048700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1374.2 +048800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1374.2 +048900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +049000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1374.2 +049100 WRITE-LINE. ST1374.2 +049200 ADD 1 TO RECORD-COUNT. ST1374.2 +049300 IF RECORD-COUNT GREATER 42 ST1374.2 +049400 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1374.2 +049500 MOVE SPACE TO DUMMY-RECORD ST1374.2 +049600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1374.2 +049700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1374.2 +049800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1374.2 +049900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1374.2 +050000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1374.2 +050100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1374.2 +050200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1374.2 +050300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1374.2 +050400 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1374.2 +050500 MOVE ZERO TO RECORD-COUNT. ST1374.2 +050600 PERFORM WRT-LN. ST1374.2 +050700 WRT-LN. ST1374.2 +050800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1374.2 +050900 MOVE SPACE TO DUMMY-RECORD. ST1374.2 +051000 BLANK-LINE-PRINT. ST1374.2 +051100 PERFORM WRT-LN. ST1374.2 +051200 FAIL-ROUTINE. ST1374.2 +051300 IF COMPUTED-X NOT EQUAL TO SPACE ST1374.2 +051400 GO TO FAIL-ROUTINE-WRITE. ST1374.2 +051500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1374.2 +051600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1374.2 +051700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1374.2 +051800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +051900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1374.2 +052000 GO TO FAIL-ROUTINE-EX. ST1374.2 +052100 FAIL-ROUTINE-WRITE. ST1374.2 +052200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1374.2 +052300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1374.2 +052400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1374.2 +052500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1374.2 +052600 FAIL-ROUTINE-EX. EXIT. ST1374.2 +052700 BAIL-OUT. ST1374.2 +052800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1374.2 +052900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1374.2 +053000 BAIL-OUT-WRITE. ST1374.2 +053100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1374.2 +053200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1374.2 +053300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1374.2 +053400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1374.2 +053500 BAIL-OUT-EX. EXIT. ST1374.2 +053600 CCVS1-EXIT. ST1374.2 +053700 EXIT. ST1374.2 +053800 SECT-ST216-0001 SECTION. ST1374.2 +053900 SRT-INIT-001. ST1374.2 +054000 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1374.2 +054100 OPEN OUTPUT SQ-FS1. ST1374.2 +054200 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1374.2 +054300 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1374.2 +054400 MOVE ".XXX." TO XPROGRAM-NAME (1). ST1374.2 +054500 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1374.2 +054600 MOVE 0001 TO XBLOCK-SIZE (1). ST1374.2 +054700 MOVE 000051 TO RECORDS-IN-FILE (1). ST1374.2 +054800 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1374.2 +054900 MOVE "S" TO XLABEL-TYPE (1). ST1374.2 +055000 MOVE 000001 TO XRECORD-NUMBER (1). ST1374.2 +055100 MOVE SPACES TO WRK-XN-O120F-1. ST1374.2 +055200 SRT-TEST-001. ST1374.2 +055300 PERFORM SRT-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1374.2 +055400 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1374.2 +055500*X MOVE SPACES TO PRINT-REC. ST1374.2 +055600*X WRITE PRINT-REC. ST1374.2 +055700 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1374.2 +055800 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1374.2 +055900 ELSE ST1374.2 +056000 PERFORM PASS. ST1374.2 +056100 GO TO SRT-WRITE-001. ST1374.2 +056200 SRT-TEST-001-BUILD. ST1374.2 +056300 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-1 ST1374.2 +056400 ALPHAN-KEY OF KEY-2 ALPHAN-KEY OF KEY-3. ST1374.2 +056500 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1374.2 +056600 NUM-KEY OF KEY-3. ST1374.2 +056700 MULTIPLY WRK-DU-999-0001 BY 13 ST1374.2 +056800 GIVING XRECORD-LENGTH (1) ROUNDED. ST1374.2 +056900 ADD 135 TO XRECORD-LENGTH (1). ST1374.2 +057000 MOVE WRK-DU-999-0001 TO LENGTH-1. ST1374.2 +057100 PERFORM STUFF-IT VARYING WRK-DU-999-0002 ST1374.2 +057200 FROM 1 BY 1 UNTIL WRK-DU-999-0002 IS GREATER THAN ST1374.2 +057300 WRK-DU-999-0001. ST1374.2 +057400 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1374.2 +057500 ADD 1 TO XRECORD-NUMBER (1). ST1374.2 +057600 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1374.2 +057700 ADD 1 TO WRK-DU-999-2. ST1374.2 +057800*X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1374.2 +057900*X WRITE PRINT-REC FROM REST-OF-1. ST1374.2 +058000*X MOVE SPACES TO PRINT-REC. ST1374.2 +058100 WRITE SQ-FS1R1-F-G-132. ST1374.2 +058200 STUFF-IT. ST1374.2 +058300 MOVE WRK-DU-999-0002 TO STUFF-1 (WRK-DU-999-0002). ST1374.2 +058400 SRT-DELETE-001. ST1374.2 +058500 PERFORM DE-LETE. ST1374.2 +058600 SRT-WRITE-001. ST1374.2 +058700 MOVE "SRT-TEST-001" TO PAR-NAME. ST1374.2 +058800 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1374.2 +058900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1374.2 +059000 PERFORM PRINT-DETAIL. ST1374.2 +059100*X MOVE SPACES TO PRINT-REC. ST1374.2 +059200*X WRITE PRINT-REC. ST1374.2 +059300 CLOSE SQ-FS1. ST1374.2 +059400 SRT-INIT-002. ST1374.2 +059500 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1374.2 +059600 OPEN OUTPUT SQ-FS2. ST1374.2 +059700 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1374.2 +059800 MOVE 000001 TO XRECORD-NUMBER (1). ST1374.2 +059900 MOVE 000148 TO XRECORD-LENGTH (1). ST1374.2 +060000 MOVE 0002 TO XBLOCK-SIZE (1). ST1374.2 +060100 SRT-TEST-002. ST1374.2 +060200 PERFORM SRT-TEST-002-BUILD VARYING WRK-DU-999-0001 ST1374.2 +060300 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1374.2 +060400*X MOVE SPACES TO PRINT-REC. ST1374.2 +060500*X WRITE PRINT-REC. ST1374.2 +060600 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1374.2 +060700 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1374.2 +060800 ELSE ST1374.2 +060900 PERFORM PASS. ST1374.2 +061000 GO TO SRT-WRITE-002. ST1374.2 +061100 SRT-TEST-002-BUILD. ST1374.2 +061200 MOVE 100 TO LENGTH-2. ST1374.2 +061300 MOVE SPACES TO STUFF-2 (1). ST1374.2 +061400 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1374.2 +061500 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1374.2 +061600 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1374.2 +061700 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1374.2 +061800 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1374.2 +061900 ADD 000001 TO XRECORD-NUMBER (1). ST1374.2 +062000*X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1374.2 +062100*X WRITE PRINT-REC FROM REST-OF-2. ST1374.2 +062200*X MOVE SPACES TO PRINT-REC. ST1374.2 +062300 WRITE SQ-FS2R1-F-G-132. ST1374.2 +062400 SRT-DELETE-002. ST1374.2 +062500 PERFORM DE-LETE. ST1374.2 +062600 SRT-WRITE-002. ST1374.2 +062700 MOVE "SRT-TEST-002" TO PAR-NAME. ST1374.2 +062800 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1374.2 +062900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1374.2 +063000 PERFORM PRINT-DETAIL. ST1374.2 +063100*X MOVE SPACES TO PRINT-REC. ST1374.2 +063200*X WRITE PRINT-REC. ST1374.2 +063300 CLOSE SQ-FS2. ST1374.2 +063400 SRT-INIT-003. ST1374.2 +063500 MOVE 100 TO LENGTH-100. ST1374.2 +063600 SORT ST-FS1 ST1374.2 +063700 ON ASCENDING KEY A-KEY OF SORT-KEY ST1374.2 +063800 ASCENDING N-KEY OF NON-KEY-2 ST1374.2 +063900 USING SQ-FS1 ST1374.2 +064000 GIVING SQ-FS2. ST1374.2 +064100 SRT-TEST-003. ST1374.2 +064200 MOVE SPACES TO WRK-XN-X-0001. ST1374.2 +064300 OPEN INPUT SQ-FS2. ST1374.2 +064400 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1374.2 +064500 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1374.2 +064600*X MOVE SPACES TO PRINT-REC. ST1374.2 +064700*X WRITE PRINT-REC. ST1374.2 +064800 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1374.2 +064900 PERFORM FAIL GO TO SRT-FAIL-003 ST1374.2 +065000 ELSE ST1374.2 +065100 PERFORM PASS. ST1374.2 +065200 GO TO SRT-WRITE-003. ST1374.2 +065300 SRT-DELETE-003. ST1374.2 +065400 PERFORM DE-LETE. ST1374.2 +065500 GO TO SRT-WRITE-003. ST1374.2 +065600 SRT-FAIL-003. ST1374.2 +065700 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1374.2 +065800 MOVE WRK-XN-0002 TO CORRECT-A. ST1374.2 +065900 SRT-WRITE-003. ST1374.2 +066000 MOVE "SRT-TEST-003" TO PAR-NAME. ST1374.2 +066100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1374.2 +066200 PERFORM PRINT-DETAIL. ST1374.2 +066300*X MOVE SPACES TO PRINT-REC. ST1374.2 +066400*X WRITE PRINT-REC. ST1374.2 +066500 SRT-INIT-004. ST1374.2 +066600 MOVE SPACES TO WRK-XN-X-0001. ST1374.2 +066700 SRT-TEST-004. ST1374.2 +066800 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1374.2 +066900 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1374.2 +067000*X MOVE SPACES TO PRINT-REC. ST1374.2 +067100*X WRITE PRINT-REC. ST1374.2 +067200 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1374.2 +067300 PERFORM FAIL GO TO SRT-FAIL-004 ST1374.2 +067400 ELSE ST1374.2 +067500 PERFORM PASS. ST1374.2 +067600 GO TO SRT-WRITE-004. ST1374.2 +067700 SRT-DELETE-004. ST1374.2 +067800 PERFORM DE-LETE. ST1374.2 +067900 GO TO SRT-WRITE-004. ST1374.2 +068000 SRT-FAIL-004. ST1374.2 +068100 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1374.2 +068200 MOVE WRK-XN-0003 TO CORRECT-A. ST1374.2 +068300 SRT-WRITE-004. ST1374.2 +068400 MOVE "SRT-TEST-004" TO PAR-NAME. ST1374.2 +068500 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1374.2 +068600 PERFORM PRINT-DETAIL. ST1374.2 +068700*X MOVE SPACES TO PRINT-REC. ST1374.2 +068800*X WRITE PRINT-REC. ST1374.2 +068900 SRT-INIT-005. ST1374.2 +069000 MOVE SPACES TO WRK-XN-X-0001. ST1374.2 +069100 SRT-TEST-005. ST1374.2 +069200 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1374.2 +069300 UNTIL WRK-DU-999-0001 IS GREATER THAN 11. ST1374.2 +069400*X MOVE SPACES TO PRINT-REC. ST1374.2 +069500*X WRITE PRINT-REC. ST1374.2 +069600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1374.2 +069700 PERFORM FAIL GO TO SRT-FAIL-005 ST1374.2 +069800 ELSE ST1374.2 +069900 PERFORM PASS. ST1374.2 +070000 GO TO SRT-WRITE-005. ST1374.2 +070100 SRT-DELETE-005. ST1374.2 +070200 PERFORM DE-LETE. ST1374.2 +070300 GO TO SRT-WRITE-005. ST1374.2 +070400 SRT-FAIL-005. ST1374.2 +070500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1374.2 +070600 MOVE WRK-XN-0004 TO CORRECT-A. ST1374.2 +070700 SRT-WRITE-005. ST1374.2 +070800 MOVE "SRT-TEST-005" TO PAR-NAME. ST1374.2 +070900 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1374.2 +071000 PERFORM PRINT-DETAIL. ST1374.2 +071100 SRT-TEST-006. ST1374.2 +071200 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1374.2 +071300 GO TO SRT-FAIL-006. ST1374.2 +071400 READ SQ-FS2 AT END PERFORM PASS ST1374.2 +071500 GO TO SRT-WRITE-006. ST1374.2 +071600 GO TO SRT-FAIL-006. ST1374.2 +071700 SRT-DELETE-006. ST1374.2 +071800 PERFORM DE-LETE. ST1374.2 +071900 SRT-FAIL-006. ST1374.2 +072000 MOVE "EOF NOT FOUND" TO RE-MARK. ST1374.2 +072100 PERFORM FAIL . ST1374.2 +072200 SRT-WRITE-006. ST1374.2 +072300 MOVE "EOF CHECK SQ-FS2" TO FEATURE. ST1374.2 +072400 MOVE "SRT-TEST-006" TO PAR-NAME. ST1374.2 +072500 PERFORM PRINT-DETAIL. ST1374.2 +072600 CLOSE SQ-FS2. ST1374.2 +072700 GO TO CCVS-999999. ST1374.2 +072800 READ-SQ-FS1 SECTION. ST1374.2 +072900 RD-1. ST1374.2 +073000 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1374.2 +073100 GO TO R1-EXIT. ST1374.2 +073200 READ SQ-FS2 AT END GO TO PREMATURE-EOF. ST1374.2 +073300*X MOVE LENGTH-2 TO LENGTH-100. ST1374.2 +073400*X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1374.2 +073500*X WRITE PRINT-REC FROM REST-OF-2. ST1374.2 +073600*X MOVE 100 TO LENGTH-100. ST1374.2 +073700*X MOVE SPACES TO PRINT-REC. ST1374.2 +073800 MOVE ALPHAN-KEY OF KEY-6 TO COMPU (WRK-DU-999-0001). ST1374.2 +073900 GO TO R1-EXIT. ST1374.2 +074000 PREMATURE-EOF. ST1374.2 +074100 MOVE 1 TO WRK-DU-9-0001. ST1374.2 +074200 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1374.2 +074300 R1-EXIT. ST1374.2 +074400 EXIT. ST1374.2 +074500 CCVS-EXIT SECTION. ST1374.2 +074600 CCVS-999999. ST1374.2 +074700 GO TO CLOSE-FILES. ST1374.2 diff --git a/tests/cobol85/ST/ST139A.CBL b/tests/cobol85/ST/ST139A.CBL new file mode 100755 index 00000000..833d78d3 --- /dev/null +++ b/tests/cobol85/ST/ST139A.CBL @@ -0,0 +1,864 @@ +000100 IDENTIFICATION DIVISION. ST1394.2 +000200 PROGRAM-ID. ST1394.2 +000300 ST139A. ST1394.2 +000400**************************************************************** ST1394.2 +000500* * ST1394.2 +000600* VALIDATION FOR:- * ST1394.2 +000700* * ST1394.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1394.2 +000900* * ST1394.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1394.2 +001100* * ST1394.2 +001200**************************************************************** ST1394.2 +001300* ST1394.2 +001400* OBJECTIVE - ST1394.2 +001500* ROUTINE ST209 IS A TEST OF THE MERGE STATEMENT USING ST1394.2 +001600* THE ASCII COLLATING SEQUENCE AND FIXED LENGTH RECORDS. ST1394.2 +001700* ST1394.2 +001800* TWO FILES ARE FIRST CREATED BY THE ROUTINE IN ASCENDING ST1394.2 +001900* ASCII ORDER. THE ALPHABET NAME CLAUSE AND MERGE STATEMENT ST1394.2 +002000* WITH THE COLLATING SEQUENCE PHRASE ARE USED TO TEST THE ST1394.2 +002100* ABILITY OF THE COMPILER TO MERGE THE TWO FILES INTO A THIRD ST1394.2 +002200* FILE IN ASCENDING ASCII ORDER. ST1394.2 +002300* ST1394.2 +002400* ST1394.2 +002500* FEATURES TESTED - ST1394.2 +002600* * ALPHABET-NAME IS STANDARD-1 (THE ASCII COLLATING SEQ.) ST1394.2 +002700* * COLLATING SEQUENCE IS ALPHABET-NAME ST1394.2 +002800* * FIXED LENGTH RECORDS ST1394.2 +002900* * SAME SORT-MERGE AREA IN THE I-O-CONTROL PARAGRAPH ST1394.2 +003000* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1394.2 +003100* * USING FILE-NAME SERIES ST1394.2 +003200* ST1394.2 +003300* * MERGE MERGE-FILE-NAME ST1394.2 +003400* ASCENDING KEY-1 OF DATA-NAME-1 ST1394.2 +003500* ON ASCENDING KEY KEY-2 OF DATA-NAME-2 ST1394.2 +003600* SEQUENCE ALPHABET-ASCII-NAME ST1394.2 +003700* USING FILE-NAME-2 FILE-NAME-1 ST1394.2 +003800* GIVING FILE-NAME-3. ST1394.2 +003900* ST1394.2 +004000* ST1394.2 +004100* FILES USED - ST1394.2 +004200* * FILES SQ-FS1 AND SQ-FS2 ON MAGNETIC TAPE OR MASS-STORAGE ST1394.2 +004300* ARE FIRST CREATED BY ROUTINE ST209. THE MERGE STATEMENT ST1394.2 +004400* USES BOTH OF THE FILES AND CREATES A THIRD FILE SQ-FS3. ST1394.2 +004500* ST1394.2 +004600* SQ-FS1 ST1394.2 +004700* 51 RECORDS ST1394.2 +004800* FIXED LENGTH RECORDS 132 CHARACTERS ST1394.2 +004900* BLOCKED 1 ST1394.2 +005000* RESERVE 2 AREAS ST1394.2 +005100* ST1394.2 +005200* SQ-FS2 ST1394.2 +005300* 51 RECORDS ST1394.2 +005400* FIXED LENGTH RECORDS 132 CHARACTERS ST1394.2 +005500* BLOCKED 2 ST1394.2 +005600* RESERVE 4 AREAS ST1394.2 +005700* ST1394.2 +005800* SQ-FS3 ST1394.2 +005900* FINAL TOTAL OF 102 RECORDS ST1394.2 +006000* FIXED LENGTH RECORDS 132 CHARACTERS ST1394.2 +006100* BLOCKED 3 ST1394.2 +006200* RESERVE 4 AREAS ST1394.2 +006300* ST1394.2 +006400* NOTE THAT SQ-FS3 IS THE RESULT OF MERGING SQ-FS1 AND ST1394.2 +006500* SQ-FS2. THE RECORDS IN SQ-FS3 SHOULD ALTERNATE BETWEEN ST1394.2 +006600* SQ-FS1 AND SQ-FS2 BECAUSE THE ALPHANUMERIC KEYS ARE THE SAME ST1394.2 +006700* FOR BOTH FILES AND THE NUMERIC KEYS WERE MERGED INTO ST1394.2 +006800* ASCENDING ORDER. ST1394.2 +006900* ST1394.2 +007000* ST1394.2 +007100* X-CARDS USED - ST1394.2 +007200* X-XXX014 SQ-FS1 ST1394.2 +007300* X-XXX015 SQ-FS2 ST1394.2 +007400* X-XXX016 SQ-FS3 ST1394.2 +007500* X-XXX060 SQ-FS4 ST1394.2 +007600* X-XXX027 MERGE FILE ST-FS1 ST1394.2 +007700* X-55 SYSTEM PRINTER NAME. ST1394.2 +007800* X-82 SOURCE COMPUTER NAME. ST1394.2 +007900* X-83 OBJECT COMPUTER NAME. ST1394.2 +008000* ST1394.2 +008100* ST1394.2 +008200* OPTIONS RECOMMENDED - ST1394.2 +008300* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1394.2 +008400* FILES AS THEY ARE CREATED AND READ DURING ST1394.2 +008500* TESTS 3 THRU 8. ST1394.2 +008600* ST1394.2 +008700* ST1394.2 +008800* TEST DESCRIPTIONS - ST1394.2 +008900* MRG-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1394.2 +009000* MRG-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1394.2 +009100* MRG-TEST-003 TESTS RECORDS 1-20 ON MERGE RESULT SQ-FS3 ST1394.2 +009200* MRG-TEST-004 TESTS RECORDS 21-40 ON MERGE RESULT SQ-FS3 ST1394.2 +009300* MRG-TEST-005 TESTS RECORDS 41-60 ON MERGE RESULT SQ-FS3 ST1394.2 +009400* MRG-TEST-006 TESTS RECORDS 61-80 ON MERGE RESULT SQ-FS3 ST1394.2 +009500* MRG-TEST-007 TESTS RECORDS 81-100 ON MERGE RESULT SQ-FS3 ST1394.2 +009600* MRG-TEST-008 TESTS RECORDS 101-102 ON MERGE RESULT SQ-FS3ST1394.2 +009700* MRG-TEST-009 AN EOF CHECK ON SQ-FS3 ST1394.2 +009800* MRG-TEST-010 CHECK THAT THE NUMERIC KEY ON THE LAST ST1394.2 +009900* RECORD ON SQ-FS3 EQUALS 102 ST1394.2 +010000* ST1394.2 +010100* ST1394.2 +010200* ************************************************************ ST1394.2 +010300 ENVIRONMENT DIVISION. ST1394.2 +010400 CONFIGURATION SECTION. ST1394.2 +010500 SOURCE-COMPUTER. ST1394.2 +010600 Linux. ST1394.2 +010700 OBJECT-COMPUTER. ST1394.2 +010800 Linux. ST1394.2 +010900 SPECIAL-NAMES. ST1394.2 +011000 ALPHABET MY-FAVORITE-ALPHABET IS STANDARD-1. ST1394.2 +011100 INPUT-OUTPUT SECTION. ST1394.2 +011200 FILE-CONTROL. ST1394.2 +011300 SELECT PRINT-FILE ASSIGN TO ST1394.2 +011400 "report.log". ST1394.2 +011500 SELECT SQ-FS1 ASSIGN ST1394.2 +011600 "XXXXX014" ST1394.2 +011700 ; ORGANIZATION IS SEQUENTIAL ST1394.2 +011800 ; ACCESS MODE SEQUENTIAL ST1394.2 +011900 ; RESERVE 2 AREAS. ST1394.2 +012000 SELECT SQ-FS2 ASSIGN TO ST1394.2 +012100 "XXXXX015" ST1394.2 +012200 ORGANIZATION IS SEQUENTIAL ST1394.2 +012300 ACCESS MODE IS SEQUENTIAL ST1394.2 +012400 RESERVE 4 AREAS. ST1394.2 +012500 SELECT SQ-FS3 ASSIGN TO ST1394.2 +012600 "XXXXX016" ST1394.2 +012700 ORGANIZATION IS SEQUENTIAL ST1394.2 +012800 ; ACCESS MODE IS SEQUENTIAL ST1394.2 +012900 RESERVE 4 AREAS. ST1394.2 +013000 SELECT SQ-FS4 ASSIGN ST1394.2 +013100 "XXXXX060". ST1394.2 +013200 SELECT ST-FS1 ASSIGN TO ST1394.2 +013300 "XXXXX027". ST1394.2 +013400 I-O-CONTROL. ST1394.2 +013500 SAME SORT-MERGE AREA FOR SQ-FS4, ST-FS1. ST1394.2 +013600 DATA DIVISION. ST1394.2 +013700 FILE SECTION. ST1394.2 +013800 FD PRINT-FILE. ST1394.2 +013900 01 PRINT-REC PICTURE X(120). ST1394.2 +014000 01 DUMMY-RECORD PICTURE X(120). ST1394.2 +014100 FD SQ-FS1 ST1394.2 +014200 LABEL RECORDS STANDARD ST1394.2 +014300*C VALUE OF ST1394.2 +014400*C OCLABELID ST1394.2 +014500*C "OCDUMMY" ST1394.2 +014600*C BLOCK CONTAINS 1 RECORDS ST1394.2 +014700*G SYSIN ST1394.2 +014800 RECORD CONTAINS 132 CHARACTERS. ST1394.2 +014900 01 SQ-FS1R1-F-G-132. ST1394.2 +015000 10 REC-PREAMBLE PIC X(120). ST1394.2 +015100 10 REST-OF-1. ST1394.2 +015200 20 KEY-1. ST1394.2 +015300 30 ALPHAN-KEY PIC X. ST1394.2 +015400 30 NUM-KEY PIC 999. ST1394.2 +015500 20 KEY-2. ST1394.2 +015600 30 ALPHAN-KEY PIC X. ST1394.2 +015700 30 NUM-KEY PIC 999. ST1394.2 +015800 20 KEY-3. ST1394.2 +015900 30 ALPHAN-KEY PIC X. ST1394.2 +016000 30 NUM-KEY PIC 999. ST1394.2 +016100 FD SQ-FS2 ST1394.2 +016200 LABEL RECORD IS STANDARD ST1394.2 +016300*C ; VALUE OF ST1394.2 +016400*C OCLABELID ST1394.2 +016500*C IS ST1394.2 +016600*C "OCDUMMY" ST1394.2 +016700*G SYSIN ST1394.2 +016800 ; BLOCK CONTAINS 2 RECORDS ST1394.2 +016900 ; RECORD CONTAINS 132 CHARACTERS ST1394.2 +017000 DATA RECORD SQ-FS2R1-F-G-132. ST1394.2 +017100 01 SQ-FS2R1-F-G-132. ST1394.2 +017200 10 REC-PRE-2 PIC X(120). ST1394.2 +017300 10 REST-OF-2. ST1394.2 +017400 20 KEY-4. ST1394.2 +017500 30 ALPHAN-KEY PIC X. ST1394.2 +017600 30 NUM-KEY PIC 999. ST1394.2 +017700 20 KEY-5. ST1394.2 +017800 30 ALPHAN-KEY PIC X. ST1394.2 +017900 30 NUM-KEY PIC 999. ST1394.2 +018000 20 KEY-6. ST1394.2 +018100 30 ALPHAN-KEY PIC X. ST1394.2 +018200 30 NUM-KEY PIC 999. ST1394.2 +018300 FD SQ-FS3 ST1394.2 +018400 LABEL RECORD IS STANDARD ST1394.2 +018500*C ; VALUE OF ST1394.2 +018600*C OCLABELID ST1394.2 +018700*C IS ST1394.2 +018800*C "OCDUMMY" ST1394.2 +018900*G SYSIN ST1394.2 +019000 ; BLOCK CONTAINS 3 RECORDS ST1394.2 +019100 RECORD CONTAINS 132 CHARACTERS ST1394.2 +019200 DATA RECORD SQ-FS3R1-F-G-132. ST1394.2 +019300 01 SQ-FS3R1-F-G-132. ST1394.2 +019400 10 REC-PRE-3 PIC X(120). ST1394.2 +019500 10 REST-OF-3. ST1394.2 +019600 20 KEY-7. ST1394.2 +019700 30 ALPHAN-KEY PIC X. ST1394.2 +019800 30 NUM-KEY PIC 999. ST1394.2 +019900 20 KEY-8. ST1394.2 +020000 30 ALPHAN-KEY PIC X. ST1394.2 +020100 30 NUM-KEY PIC 999. ST1394.2 +020200 20 KEY-9. ST1394.2 +020300 30 ALPHAN-KEY PIC X. ST1394.2 +020400 30 NUM-KEY PIC 999. ST1394.2 +020500 FD SQ-FS4. ST1394.2 +020600 01 SQ-FS4R1-F-6-132. ST1394.2 +020700 02 REC-2 PIC X(132). ST1394.2 +020800 SD ST-FS1 ST1394.2 +020900 RECORD CONTAINS 132 CHARACTERS ST1394.2 +021000 DATA RECORD IS ST-FS1R1-F-G-132. ST1394.2 +021100 01 ST-FS1R1-F-G-132. ST1394.2 +021200 02 FILLER PIC X(120). ST1394.2 +021300 02 NON-KEY-1. ST1394.2 +021400 03 A-KEY PIC X. ST1394.2 +021500 03 N-KEY PIC 999. ST1394.2 +021600 02 SORT-KEY. ST1394.2 +021700 03 A-KEY PIC X. ST1394.2 +021800 03 N-KEY PIC 999. ST1394.2 +021900 02 NON-KEY-2. ST1394.2 +022000 03 A-KEY PIC X. ST1394.2 +022100 03 N-KEY PIC 999. ST1394.2 +022200 WORKING-STORAGE SECTION. ST1394.2 +022300 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1394.2 +022400 77 WRK-DU-999-0001 PIC 999. ST1394.2 +022500 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1394.2 +022600 77 LAST-REC-NUM PIC 999 VALUE ZERO. ST1394.2 +022700 01 WRK-XN-0001 PIC X(51) VALUE ST1394.2 +022800 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1394.2 +022900 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1394.2 +023000 02 CHAR PIC X OCCURS 51 TIMES. ST1394.2 +023100 01 WRK-XN-2 PIC X(51) VALUE ST1394.2 +023200 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1394.2 +023300 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1394.2 +023400 02 ASCIIS PIC X OCCURS 51 TIMES. ST1394.2 +023500 01 WRK-XN-O020F-0001. ST1394.2 +023600 02 COMPU PIC X OCCURS 20 TIMES. ST1394.2 +023700 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1394.2 +023800 02 FILLER PIC X(20). ST1394.2 +023900 01 WRK-XN-O120F-1. ST1394.2 +024000 02 COLLS PIC X OCCURS 120 TIMES. ST1394.2 +024100 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1394.2 +024200 02 WRK-XN-0002 PIC X(20). ST1394.2 +024300 02 WRK-XN-0003 PIC X(20). ST1394.2 +024400 02 WRK-XN-0004 PIC X(20). ST1394.2 +024500 02 WRK-XN-0005 PIC X(20). ST1394.2 +024600 02 WRK-XN-0006 PIC X(20). ST1394.2 +024700 02 WRK-XN-0007 PIC X(20). ST1394.2 +024800 01 FILE-RECORD-INFORMATION-REC. ST1394.2 +024900 03 FILE-RECORD-INFO-SKELETON. ST1394.2 +025000 05 FILLER PICTURE X(48) VALUE ST1394.2 +025100 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1394.2 +025200 05 FILLER PICTURE X(46) VALUE ST1394.2 +025300 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1394.2 +025400 05 FILLER PICTURE X(26) VALUE ST1394.2 +025500 ",LFIL=000000,ORG= ,LBLR= ". ST1394.2 +025600 05 FILLER PICTURE X(37) VALUE ST1394.2 +025700 ",RECKEY= ". ST1394.2 +025800 05 FILLER PICTURE X(38) VALUE ST1394.2 +025900 ",ALTKEY1= ". ST1394.2 +026000 05 FILLER PICTURE X(38) VALUE ST1394.2 +026100 ",ALTKEY2= ". ST1394.2 +026200 05 FILLER PICTURE X(7) VALUE SPACE.ST1394.2 +026300 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1394.2 +026400 05 FILE-RECORD-INFO-P1-120. ST1394.2 +026500 07 FILLER PIC X(5). ST1394.2 +026600 07 XFILE-NAME PIC X(6). ST1394.2 +026700 07 FILLER PIC X(8). ST1394.2 +026800 07 XRECORD-NAME PIC X(6). ST1394.2 +026900 07 FILLER PIC X(1). ST1394.2 +027000 07 REELUNIT-NUMBER PIC 9(1). ST1394.2 +027100 07 FILLER PIC X(7). ST1394.2 +027200 07 XRECORD-NUMBER PIC 9(6). ST1394.2 +027300 07 FILLER PIC X(6). ST1394.2 +027400 07 UPDATE-NUMBER PIC 9(2). ST1394.2 +027500 07 FILLER PIC X(5). ST1394.2 +027600 07 ODO-NUMBER PIC 9(4). ST1394.2 +027700 07 FILLER PIC X(5). ST1394.2 +027800 07 XPROGRAM-NAME PIC X(5). ST1394.2 +027900 07 FILLER PIC X(7). ST1394.2 +028000 07 XRECORD-LENGTH PIC 9(6). ST1394.2 +028100 07 FILLER PIC X(7). ST1394.2 +028200 07 CHARS-OR-RECORDS PIC X(2). ST1394.2 +028300 07 FILLER PIC X(1). ST1394.2 +028400 07 XBLOCK-SIZE PIC 9(4). ST1394.2 +028500 07 FILLER PIC X(6). ST1394.2 +028600 07 RECORDS-IN-FILE PIC 9(6). ST1394.2 +028700 07 FILLER PIC X(5). ST1394.2 +028800 07 XFILE-ORGANIZATION PIC X(2). ST1394.2 +028900 07 FILLER PIC X(6). ST1394.2 +029000 07 XLABEL-TYPE PIC X(1). ST1394.2 +029100 05 FILE-RECORD-INFO-P121-240. ST1394.2 +029200 07 FILLER PIC X(8). ST1394.2 +029300 07 XRECORD-KEY PIC X(29). ST1394.2 +029400 07 FILLER PIC X(9). ST1394.2 +029500 07 ALTERNATE-KEY1 PIC X(29). ST1394.2 +029600 07 FILLER PIC X(9). ST1394.2 +029700 07 ALTERNATE-KEY2 PIC X(29). ST1394.2 +029800 07 FILLER PIC X(7). ST1394.2 +029900 01 TEST-RESULTS. ST1394.2 +030000 02 FILLER PIC X VALUE SPACE. ST1394.2 +030100 02 FEATURE PIC X(20) VALUE SPACE. ST1394.2 +030200 02 FILLER PIC X VALUE SPACE. ST1394.2 +030300 02 P-OR-F PIC X(5) VALUE SPACE. ST1394.2 +030400 02 FILLER PIC X VALUE SPACE. ST1394.2 +030500 02 PAR-NAME. ST1394.2 +030600 03 FILLER PIC X(19) VALUE SPACE. ST1394.2 +030700 03 PARDOT-X PIC X VALUE SPACE. ST1394.2 +030800 03 DOTVALUE PIC 99 VALUE ZERO. ST1394.2 +030900 02 FILLER PIC X(8) VALUE SPACE. ST1394.2 +031000 02 RE-MARK PIC X(61). ST1394.2 +031100 01 TEST-COMPUTED. ST1394.2 +031200 02 FILLER PIC X(30) VALUE SPACE. ST1394.2 +031300 02 FILLER PIC X(17) VALUE ST1394.2 +031400 " COMPUTED=". ST1394.2 +031500 02 COMPUTED-X. ST1394.2 +031600 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1394.2 +031700 03 COMPUTED-N REDEFINES COMPUTED-A ST1394.2 +031800 PIC -9(9).9(9). ST1394.2 +031900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1394.2 +032000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1394.2 +032100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1394.2 +032200 03 CM-18V0 REDEFINES COMPUTED-A. ST1394.2 +032300 04 COMPUTED-18V0 PIC -9(18). ST1394.2 +032400 04 FILLER PIC X. ST1394.2 +032500 03 FILLER PIC X(50) VALUE SPACE. ST1394.2 +032600 01 TEST-CORRECT. ST1394.2 +032700 02 FILLER PIC X(30) VALUE SPACE. ST1394.2 +032800 02 FILLER PIC X(17) VALUE " CORRECT =". ST1394.2 +032900 02 CORRECT-X. ST1394.2 +033000 03 CORRECT-A PIC X(20) VALUE SPACE. ST1394.2 +033100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1394.2 +033200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1394.2 +033300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1394.2 +033400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1394.2 +033500 03 CR-18V0 REDEFINES CORRECT-A. ST1394.2 +033600 04 CORRECT-18V0 PIC -9(18). ST1394.2 +033700 04 FILLER PIC X. ST1394.2 +033800 03 FILLER PIC X(2) VALUE SPACE. ST1394.2 +033900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1394.2 +034000 01 CCVS-C-1. ST1394.2 +034100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1394.2 +034200- "SS PARAGRAPH-NAME ST1394.2 +034300- " REMARKS". ST1394.2 +034400 02 FILLER PIC X(20) VALUE SPACE. ST1394.2 +034500 01 CCVS-C-2. ST1394.2 +034600 02 FILLER PIC X VALUE SPACE. ST1394.2 +034700 02 FILLER PIC X(6) VALUE "TESTED". ST1394.2 +034800 02 FILLER PIC X(15) VALUE SPACE. ST1394.2 +034900 02 FILLER PIC X(4) VALUE "FAIL". ST1394.2 +035000 02 FILLER PIC X(94) VALUE SPACE. ST1394.2 +035100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1394.2 +035200 01 REC-CT PIC 99 VALUE ZERO. ST1394.2 +035300 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1394.2 +035400 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1394.2 +035500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1394.2 +035600 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1394.2 +035700 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1394.2 +035800 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1394.2 +035900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1394.2 +036000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1394.2 +036100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1394.2 +036200 01 CCVS-H-1. ST1394.2 +036300 02 FILLER PIC X(39) VALUE SPACES. ST1394.2 +036400 02 FILLER PIC X(42) VALUE ST1394.2 +036500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1394.2 +036600 02 FILLER PIC X(39) VALUE SPACES. ST1394.2 +036700 01 CCVS-H-2A. ST1394.2 +036800 02 FILLER PIC X(40) VALUE SPACE. ST1394.2 +036900 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1394.2 +037000 02 FILLER PIC XXXX VALUE ST1394.2 +037100 "4.2 ". ST1394.2 +037200 02 FILLER PIC X(28) VALUE ST1394.2 +037300 " COPY - NOT FOR DISTRIBUTION". ST1394.2 +037400 02 FILLER PIC X(41) VALUE SPACE. ST1394.2 +037500 ST1394.2 +037600 01 CCVS-H-2B. ST1394.2 +037700 02 FILLER PIC X(15) VALUE ST1394.2 +037800 "TEST RESULT OF ". ST1394.2 +037900 02 TEST-ID PIC X(9). ST1394.2 +038000 02 FILLER PIC X(4) VALUE ST1394.2 +038100 " IN ". ST1394.2 +038200 02 FILLER PIC X(12) VALUE ST1394.2 +038300 " HIGH ". ST1394.2 +038400 02 FILLER PIC X(22) VALUE ST1394.2 +038500 " LEVEL VALIDATION FOR ". ST1394.2 +038600 02 FILLER PIC X(58) VALUE ST1394.2 +038700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1394.2 +038800 01 CCVS-H-3. ST1394.2 +038900 02 FILLER PIC X(34) VALUE ST1394.2 +039000 " FOR OFFICIAL USE ONLY ". ST1394.2 +039100 02 FILLER PIC X(58) VALUE ST1394.2 +039200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1394.2 +039300 02 FILLER PIC X(28) VALUE ST1394.2 +039400 " COPYRIGHT 1985 ". ST1394.2 +039500 01 CCVS-E-1. ST1394.2 +039600 02 FILLER PIC X(52) VALUE SPACE. ST1394.2 +039700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1394.2 +039800 02 ID-AGAIN PIC X(9). ST1394.2 +039900 02 FILLER PIC X(45) VALUE SPACES. ST1394.2 +040000 01 CCVS-E-2. ST1394.2 +040100 02 FILLER PIC X(31) VALUE SPACE. ST1394.2 +040200 02 FILLER PIC X(21) VALUE SPACE. ST1394.2 +040300 02 CCVS-E-2-2. ST1394.2 +040400 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1394.2 +040500 03 FILLER PIC X VALUE SPACE. ST1394.2 +040600 03 ENDER-DESC PIC X(44) VALUE ST1394.2 +040700 "ERRORS ENCOUNTERED". ST1394.2 +040800 01 CCVS-E-3. ST1394.2 +040900 02 FILLER PIC X(22) VALUE ST1394.2 +041000 " FOR OFFICIAL USE ONLY". ST1394.2 +041100 02 FILLER PIC X(12) VALUE SPACE. ST1394.2 +041200 02 FILLER PIC X(58) VALUE ST1394.2 +041300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1394.2 +041400 02 FILLER PIC X(13) VALUE SPACE. ST1394.2 +041500 02 FILLER PIC X(15) VALUE ST1394.2 +041600 " COPYRIGHT 1985". ST1394.2 +041700 01 CCVS-E-4. ST1394.2 +041800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1394.2 +041900 02 FILLER PIC X(4) VALUE " OF ". ST1394.2 +042000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1394.2 +042100 02 FILLER PIC X(40) VALUE ST1394.2 +042200 " TESTS WERE EXECUTED SUCCESSFULLY". ST1394.2 +042300 01 XXINFO. ST1394.2 +042400 02 FILLER PIC X(19) VALUE ST1394.2 +042500 "*** INFORMATION ***". ST1394.2 +042600 02 INFO-TEXT. ST1394.2 +042700 04 FILLER PIC X(8) VALUE SPACE. ST1394.2 +042800 04 XXCOMPUTED PIC X(20). ST1394.2 +042900 04 FILLER PIC X(5) VALUE SPACE. ST1394.2 +043000 04 XXCORRECT PIC X(20). ST1394.2 +043100 02 INF-ANSI-REFERENCE PIC X(48). ST1394.2 +043200 01 HYPHEN-LINE. ST1394.2 +043300 02 FILLER PIC IS X VALUE IS SPACE. ST1394.2 +043400 02 FILLER PIC IS X(65) VALUE IS "************************ST1394.2 +043500- "*****************************************". ST1394.2 +043600 02 FILLER PIC IS X(54) VALUE IS "************************ST1394.2 +043700- "******************************". ST1394.2 +043800 01 CCVS-PGM-ID PIC X(9) VALUE ST1394.2 +043900 "ST139A". ST1394.2 +044000 PROCEDURE DIVISION. ST1394.2 +044100 DECLARATIVES. ST1394.2 +044200 SECT-ST209-DEC SECTION. ST1394.2 +044300 USE AFTER STANDARD ERROR PROCEDURE ON OUTPUT. ST1394.2 +044400 MRG-WRITE-DEC. ST1394.2 +044500 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1394.2 +044600 MOVE "MRG-TEST-DEC" TO PAR-NAME. ST1394.2 +044700 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1394.2 +044800 STOP RUN. ST1394.2 +044900 END DECLARATIVES. ST1394.2 +045000 CCVS1 SECTION. ST1394.2 +045100 OPEN-FILES. ST1394.2 +045200 OPEN OUTPUT PRINT-FILE. ST1394.2 +045300 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1394.2 +045400 MOVE SPACE TO TEST-RESULTS. ST1394.2 +045500 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1394.2 +045600 MOVE ZERO TO REC-SKL-SUB. ST1394.2 +045700 PERFORM CCVS-INIT-FILE 9 TIMES. ST1394.2 +045800 CCVS-INIT-FILE. ST1394.2 +045900 ADD 1 TO REC-SKL-SUB. ST1394.2 +046000 MOVE FILE-RECORD-INFO-SKELETON ST1394.2 +046100 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1394.2 +046200 CCVS-INIT-EXIT. ST1394.2 +046300 GO TO CCVS1-EXIT. ST1394.2 +046400 CLOSE-FILES. ST1394.2 +046500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1394.2 +046600 TERMINATE-CCVS. ST1394.2 +046700*S EXIT PROGRAM. ST1394.2 +046800*SERMINATE-CALL. ST1394.2 +046900 STOP RUN. ST1394.2 +047000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1394.2 +047100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1394.2 +047200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1394.2 +047300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1394.2 +047400 MOVE "****TEST DELETED****" TO RE-MARK. ST1394.2 +047500 PRINT-DETAIL. ST1394.2 +047600 IF REC-CT NOT EQUAL TO ZERO ST1394.2 +047700 MOVE "." TO PARDOT-X ST1394.2 +047800 MOVE REC-CT TO DOTVALUE. ST1394.2 +047900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1394.2 +048000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1394.2 +048100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1394.2 +048200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1394.2 +048300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1394.2 +048400 MOVE SPACE TO CORRECT-X. ST1394.2 +048500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1394.2 +048600 MOVE SPACE TO RE-MARK. ST1394.2 +048700 HEAD-ROUTINE. ST1394.2 +048800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +048900 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +049000 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1394.2 +049100 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1394.2 +049200 COLUMN-NAMES-ROUTINE. ST1394.2 +049300 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +049400 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +049500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +049600 END-ROUTINE. ST1394.2 +049700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1394.2 +049800 END-RTN-EXIT. ST1394.2 +049900 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +050000 END-ROUTINE-1. ST1394.2 +050100 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1394.2 +050200 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1394.2 +050300 ADD PASS-COUNTER TO ERROR-HOLD. ST1394.2 +050400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1394.2 +050500 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1394.2 +050600 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1394.2 +050700 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1394.2 +050800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1394.2 +050900 END-ROUTINE-12. ST1394.2 +051000 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1394.2 +051100 IF ERROR-COUNTER IS EQUAL TO ZERO ST1394.2 +051200 MOVE "NO " TO ERROR-TOTAL ST1394.2 +051300 ELSE ST1394.2 +051400 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1394.2 +051500 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1394.2 +051600 PERFORM WRITE-LINE. ST1394.2 +051700 END-ROUTINE-13. ST1394.2 +051800 IF DELETE-COUNTER IS EQUAL TO ZERO ST1394.2 +051900 MOVE "NO " TO ERROR-TOTAL ELSE ST1394.2 +052000 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1394.2 +052100 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1394.2 +052200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +052300 IF INSPECT-COUNTER EQUAL TO ZERO ST1394.2 +052400 MOVE "NO " TO ERROR-TOTAL ST1394.2 +052500 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1394.2 +052600 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1394.2 +052700 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +052800 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1394.2 +052900 WRITE-LINE. ST1394.2 +053000 ADD 1 TO RECORD-COUNT. ST1394.2 +053100 IF RECORD-COUNT GREATER 42 ST1394.2 +053200 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1394.2 +053300 MOVE SPACE TO DUMMY-RECORD ST1394.2 +053400 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1394.2 +053500 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1394.2 +053600 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1394.2 +053700 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1394.2 +053800 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1394.2 +053900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1394.2 +054000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1394.2 +054100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1394.2 +054200 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1394.2 +054300 MOVE ZERO TO RECORD-COUNT. ST1394.2 +054400 PERFORM WRT-LN. ST1394.2 +054500 WRT-LN. ST1394.2 +054600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1394.2 +054700 MOVE SPACE TO DUMMY-RECORD. ST1394.2 +054800 BLANK-LINE-PRINT. ST1394.2 +054900 PERFORM WRT-LN. ST1394.2 +055000 FAIL-ROUTINE. ST1394.2 +055100 IF COMPUTED-X NOT EQUAL TO SPACE ST1394.2 +055200 GO TO FAIL-ROUTINE-WRITE. ST1394.2 +055300 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1394.2 +055400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1394.2 +055500 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1394.2 +055600 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +055700 MOVE SPACES TO INF-ANSI-REFERENCE. ST1394.2 +055800 GO TO FAIL-ROUTINE-EX. ST1394.2 +055900 FAIL-ROUTINE-WRITE. ST1394.2 +056000 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1394.2 +056100 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1394.2 +056200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1394.2 +056300 MOVE SPACES TO COR-ANSI-REFERENCE. ST1394.2 +056400 FAIL-ROUTINE-EX. EXIT. ST1394.2 +056500 BAIL-OUT. ST1394.2 +056600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1394.2 +056700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1394.2 +056800 BAIL-OUT-WRITE. ST1394.2 +056900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1394.2 +057000 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1394.2 +057100 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1394.2 +057200 MOVE SPACES TO INF-ANSI-REFERENCE. ST1394.2 +057300 BAIL-OUT-EX. EXIT. ST1394.2 +057400 CCVS1-EXIT. ST1394.2 +057500 EXIT. ST1394.2 +057600 SECT-ST209-0001 SECTION. ST1394.2 +057700 MRG-INIT-001. ST1394.2 +057800 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1394.2 +057900 OPEN OUTPUT SQ-FS1. ST1394.2 +058000 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1394.2 +058100 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1394.2 +058200 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1394.2 +058300 MOVE 000132 TO XRECORD-LENGTH (1). ST1394.2 +058400 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1394.2 +058500 MOVE 0001 TO XBLOCK-SIZE (1). ST1394.2 +058600 MOVE 000051 TO RECORDS-IN-FILE (1). ST1394.2 +058700 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1394.2 +058800 MOVE "S" TO XLABEL-TYPE (1). ST1394.2 +058900 MOVE 000001 TO XRECORD-NUMBER (1). ST1394.2 +059000 MOVE SPACES TO WRK-XN-O120F-1. ST1394.2 +059100 MRG-TEST-001. ST1394.2 +059200 PERFORM MRG-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1394.2 +059300 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1394.2 +059400*X MOVE SPACES TO PRINT-REC. ST1394.2 +059500*X WRITE PRINT-REC. ST1394.2 +059600 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1394.2 +059700 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1394.2 +059800 ELSE ST1394.2 +059900 PERFORM PASS. ST1394.2 +060000 GO TO MRG-WRITE-001. ST1394.2 +060100 MRG-TEST-001-BUILD. ST1394.2 +060200 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-1 ST1394.2 +060300 ALPHAN-KEY OF KEY-2 ALPHAN-KEY OF KEY-3. ST1394.2 +060400 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1394.2 +060500 NUM-KEY OF KEY-3. ST1394.2 +060600 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1394.2 +060700 ADD 1 TO XRECORD-NUMBER (1). ST1394.2 +060800 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1394.2 +060900 ADD 1 TO WRK-DU-999-2. ST1394.2 +061000 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1394.2 +061100 ADD 1 TO WRK-DU-999-2. ST1394.2 +061200*X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1394.2 +061300*X WRITE PRINT-REC FROM REST-OF-1. ST1394.2 +061400*X MOVE SPACES TO PRINT-REC. ST1394.2 +061500 WRITE SQ-FS1R1-F-G-132. ST1394.2 +061600 MRG-DELETE-001. ST1394.2 +061700 PERFORM DE-LETE. ST1394.2 +061800 MRG-WRITE-001. ST1394.2 +061900 MOVE "MRG-TEST-001" TO PAR-NAME. ST1394.2 +062000 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1394.2 +062100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1394.2 +062200 PERFORM PRINT-DETAIL. ST1394.2 +062300*X MOVE SPACES TO PRINT-REC. ST1394.2 +062400*X WRITE PRINT-REC. ST1394.2 +062500 CLOSE SQ-FS1. ST1394.2 +062600 MRG-INIT-002. ST1394.2 +062700 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1394.2 +062800 OPEN OUTPUT SQ-FS2. ST1394.2 +062900 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1394.2 +063000 MOVE 000001 TO XRECORD-NUMBER (1). ST1394.2 +063100 MOVE 0002 TO XBLOCK-SIZE (1). ST1394.2 +063200 MRG-TEST-002. ST1394.2 +063300 PERFORM MRG-TEST-002-BUILD VARYING WRK-DU-999-0001 ST1394.2 +063400 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1394.2 +063500*X MOVE SPACES TO PRINT-REC. ST1394.2 +063600*X WRITE PRINT-REC. ST1394.2 +063700 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 52 ST1394.2 +063800 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1394.2 +063900 ELSE ST1394.2 +064000 PERFORM PASS. ST1394.2 +064100 GO TO MRG-WRITE-002. ST1394.2 +064200 MRG-TEST-002-BUILD. ST1394.2 +064300 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1394.2 +064400 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1394.2 +064500 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1394.2 +064600 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1394.2 +064700 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1394.2 +064800 ADD 000001 TO XRECORD-NUMBER (1). ST1394.2 +064900*X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1394.2 +065000*X WRITE PRINT-REC FROM REST-OF-2. ST1394.2 +065100*X MOVE SPACES TO PRINT-REC. ST1394.2 +065200 WRITE SQ-FS2R1-F-G-132. ST1394.2 +065300 MRG-DELETE-002. ST1394.2 +065400 PERFORM DE-LETE. ST1394.2 +065500 MRG-WRITE-002. ST1394.2 +065600 MOVE "MRG-TEST-002" TO PAR-NAME. ST1394.2 +065700 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1394.2 +065800 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1394.2 +065900 PERFORM PRINT-DETAIL. ST1394.2 +066000*X MOVE SPACES TO PRINT-REC. ST1394.2 +066100*X WRITE PRINT-REC. ST1394.2 +066200 CLOSE SQ-FS2. ST1394.2 +066300 MRG-INIT-003. ST1394.2 +066400 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +066500 MERGE ST-FS1 ST1394.2 +066600 ASCENDING A-KEY OF SORT-KEY ST1394.2 +066700 ON ASCENDING KEY N-KEY OF NON-KEY-1 ST1394.2 +066800 SEQUENCE MY-FAVORITE-ALPHABET ST1394.2 +066900 USING SQ-FS2 SQ-FS1 ST1394.2 +067000 GIVING SQ-FS3. ST1394.2 +067100 MRG-TEST-003. ST1394.2 +067200 OPEN INPUT SQ-FS3. ST1394.2 +067300 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +067400 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +067500*X MOVE SPACES TO PRINT-REC. ST1394.2 +067600*X WRITE PRINT-REC. ST1394.2 +067700 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1394.2 +067800 PERFORM FAIL GO TO MRG-FAIL-003 ST1394.2 +067900 ELSE ST1394.2 +068000 PERFORM PASS. ST1394.2 +068100 GO TO MRG-WRITE-003. ST1394.2 +068200 MRG-DELETE-003. ST1394.2 +068300 PERFORM DE-LETE. ST1394.2 +068400 GO TO MRG-WRITE-003. ST1394.2 +068500 MRG-FAIL-003. ST1394.2 +068600 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +068700 MOVE WRK-XN-0002 TO CORRECT-A. ST1394.2 +068800 MRG-WRITE-003. ST1394.2 +068900 MOVE "MRG-TEST-003" TO PAR-NAME. ST1394.2 +069000 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +069100 PERFORM PRINT-DETAIL. ST1394.2 +069200*X MOVE SPACES TO PRINT-REC. ST1394.2 +069300*X WRITE PRINT-REC. ST1394.2 +069400 MRG-INIT-004. ST1394.2 +069500 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +069600 MRG-TEST-004. ST1394.2 +069700 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +069800 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +069900*X MOVE SPACES TO PRINT-REC. ST1394.2 +070000*X WRITE PRINT-REC. ST1394.2 +070100 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1394.2 +070200 PERFORM FAIL GO TO MRG-FAIL-004 ST1394.2 +070300 ELSE ST1394.2 +070400 PERFORM PASS. ST1394.2 +070500 GO TO MRG-WRITE-004. ST1394.2 +070600 MRG-DELETE-004. ST1394.2 +070700 PERFORM DE-LETE. ST1394.2 +070800 GO TO MRG-WRITE-004. ST1394.2 +070900 MRG-FAIL-004. ST1394.2 +071000 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +071100 MOVE WRK-XN-0003 TO CORRECT-A. ST1394.2 +071200 MRG-WRITE-004. ST1394.2 +071300 MOVE "MRG-TEST-004" TO PAR-NAME. ST1394.2 +071400 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +071500 PERFORM PRINT-DETAIL. ST1394.2 +071600*X MOVE SPACES TO PRINT-REC. ST1394.2 +071700*X WRITE PRINT-REC. ST1394.2 +071800 MRG-INIT-005. ST1394.2 +071900 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +072000 MRG-TEST-005. ST1394.2 +072100 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +072200 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +072300*X MOVE SPACES TO PRINT-REC. ST1394.2 +072400*X WRITE PRINT-REC. ST1394.2 +072500 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1394.2 +072600 PERFORM FAIL GO TO MRG-FAIL-005 ST1394.2 +072700 ELSE ST1394.2 +072800 PERFORM PASS. ST1394.2 +072900 GO TO MRG-WRITE-005. ST1394.2 +073000 MRG-DELETE-005. ST1394.2 +073100 PERFORM DE-LETE. ST1394.2 +073200 GO TO MRG-WRITE-005. ST1394.2 +073300 MRG-FAIL-005. ST1394.2 +073400 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +073500 MOVE WRK-XN-0004 TO CORRECT-A. ST1394.2 +073600 MRG-WRITE-005. ST1394.2 +073700 MOVE "MRG-TEST-005" TO PAR-NAME. ST1394.2 +073800 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +073900 PERFORM PRINT-DETAIL. ST1394.2 +074000*X MOVE SPACES TO PRINT-REC. ST1394.2 +074100*X WRITE PRINT-REC. ST1394.2 +074200 MRG-INIT-006. ST1394.2 +074300 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +074400 MRG-TEST-006. ST1394.2 +074500 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +074600 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +074700*X MOVE SPACES TO PRINT-REC. ST1394.2 +074800*X WRITE PRINT-REC. ST1394.2 +074900 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1394.2 +075000 PERFORM FAIL GO TO MRG-FAIL-006 ST1394.2 +075100 ELSE ST1394.2 +075200 PERFORM PASS. ST1394.2 +075300 GO TO MRG-WRITE-006. ST1394.2 +075400 MRG-DELETE-006. ST1394.2 +075500 PERFORM DE-LETE. ST1394.2 +075600 GO TO MRG-WRITE-006. ST1394.2 +075700 MRG-FAIL-006. ST1394.2 +075800 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +075900 MOVE WRK-XN-0005 TO CORRECT-A. ST1394.2 +076000 MRG-WRITE-006. ST1394.2 +076100 MOVE "MRG-TEST-006" TO PAR-NAME. ST1394.2 +076200 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +076300 PERFORM PRINT-DETAIL. ST1394.2 +076400*X MOVE SPACES TO PRINT-REC. ST1394.2 +076500*X WRITE PRINT-REC. ST1394.2 +076600 MRG-INIT-007. ST1394.2 +076700 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +076800 MRG-TEST-007. ST1394.2 +076900 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +077000 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1394.2 +077100*X MOVE SPACES TO PRINT-REC. ST1394.2 +077200*X WRITE PRINT-REC. ST1394.2 +077300 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1394.2 +077400 PERFORM FAIL GO TO MRG-FAIL-007 ST1394.2 +077500 ELSE ST1394.2 +077600 PERFORM PASS. ST1394.2 +077700 GO TO MRG-WRITE-007. ST1394.2 +077800 MRG-DELETE-007. ST1394.2 +077900 PERFORM DE-LETE. ST1394.2 +078000 GO TO MRG-WRITE-007. ST1394.2 +078100 MRG-FAIL-007. ST1394.2 +078200 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +078300 MOVE WRK-XN-0006 TO CORRECT-A. ST1394.2 +078400 MRG-WRITE-007. ST1394.2 +078500 MOVE "MRG-TEST-007" TO PAR-NAME. ST1394.2 +078600 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +078700 PERFORM PRINT-DETAIL. ST1394.2 +078800*X MOVE SPACES TO PRINT-REC. ST1394.2 +078900*X WRITE PRINT-REC. ST1394.2 +079000 MRG-INIT-008. ST1394.2 +079100 MOVE SPACES TO WRK-XN-X-0001. ST1394.2 +079200 MRG-TEST-008. ST1394.2 +079300 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1394.2 +079400 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1394.2 +079500*X MOVE SPACES TO PRINT-REC. ST1394.2 +079600*X WRITE PRINT-REC. ST1394.2 +079700 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1394.2 +079800 PERFORM FAIL GO TO MRG-FAIL-008 ST1394.2 +079900 ELSE ST1394.2 +080000 PERFORM PASS. ST1394.2 +080100 GO TO MRG-WRITE-008. ST1394.2 +080200 MRG-DELETE-008. ST1394.2 +080300 PERFORM DE-LETE. ST1394.2 +080400 GO TO MRG-WRITE-008. ST1394.2 +080500 MRG-FAIL-008. ST1394.2 +080600 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1394.2 +080700 MOVE WRK-XN-0007 TO CORRECT-A. ST1394.2 +080800 MRG-WRITE-008. ST1394.2 +080900 MOVE "MRG-TEST-008" TO PAR-NAME. ST1394.2 +081000 MOVE "STAND. COLLATING SEQ." TO FEATURE. ST1394.2 +081100 PERFORM PRINT-DETAIL. ST1394.2 +081200 MOVE NUM-KEY OF KEY-7 TO LAST-REC-NUM. ST1394.2 +081300 MRG-TEST-009. ST1394.2 +081400 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1394.2 +081500 GO TO MRG-FAIL-009. ST1394.2 +081600 READ SQ-FS3 END PERFORM PASS ST1394.2 +081700 GO TO MRG-WRITE-009. ST1394.2 +081800 GO TO MRG-FAIL-009. ST1394.2 +081900 MRG-DELETE-009. ST1394.2 +082000 PERFORM DE-LETE. ST1394.2 +082100 GO TO MRG-WRITE-009. ST1394.2 +082200 MRG-FAIL-009. ST1394.2 +082300 MOVE "EOF NOT FOUND" TO RE-MARK. ST1394.2 +082400 PERFORM FAIL . ST1394.2 +082500 MRG-WRITE-009. ST1394.2 +082600 MOVE "EOF CHECK SQ-FS3" TO FEATURE. ST1394.2 +082700 MOVE "MRG-TEST-009" TO PAR-NAME. ST1394.2 +082800 PERFORM PRINT-DETAIL. ST1394.2 +082900 MRG-TEST-010. ST1394.2 +083000 IF LAST-REC-NUM IS NOT EQUAL TO 102 ST1394.2 +083100 PERFORM FAIL GO TO MRG-FAIL-010 ST1394.2 +083200 ELSE ST1394.2 +083300 PERFORM PASS. ST1394.2 +083400 GO TO MRG-WRITE-010. ST1394.2 +083500 MRG-DELETE-010. ST1394.2 +083600 PERFORM DE-LETE. ST1394.2 +083700 GO TO MRG-WRITE-010. ST1394.2 +083800 MRG-FAIL-010. ST1394.2 +083900 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1394.2 +084000 MOVE 102 TO CR-18V0. ST1394.2 +084100 MRG-WRITE-010. ST1394.2 +084200 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1394.2 +084300 MOVE "MRG-TEST-010" TO PAR-NAME. ST1394.2 +084400 PERFORM PRINT-DETAIL. ST1394.2 +084500 CLOSE SQ-FS3. ST1394.2 +084600 GO TO CCVS-999999. ST1394.2 +084700 READ-SQ-FS1 SECTION. ST1394.2 +084800 RD-1. ST1394.2 +084900 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1394.2 +085000 GO TO R1-EXIT. ST1394.2 +085100 READ SQ-FS3 AT END GO TO PREMATURE-EOF. ST1394.2 +085200*X WRITE PRINT-REC FROM SQ-FS3R1-F-G-132. ST1394.2 +085300*X WRITE PRINT-REC FROM REST-OF-3. ST1394.2 +085400*X MOVE SPACES TO PRINT-REC. ST1394.2 +085500 MOVE ALPHAN-KEY OF KEY-8 TO COMPU (WRK-DU-999-0001). ST1394.2 +085600 GO TO R1-EXIT. ST1394.2 +085700 PREMATURE-EOF. ST1394.2 +085800 MOVE 1 TO WRK-DU-9-0001. ST1394.2 +085900 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1394.2 +086000 R1-EXIT. ST1394.2 +086100 EXIT. ST1394.2 +086200 CCVS-EXIT SECTION. ST1394.2 +086300 CCVS-999999. ST1394.2 +086400 GO TO CLOSE-FILES. ST1394.2 diff --git a/tests/cobol85/ST/ST140A.CBL b/tests/cobol85/ST/ST140A.CBL new file mode 100755 index 00000000..8a260785 --- /dev/null +++ b/tests/cobol85/ST/ST140A.CBL @@ -0,0 +1,947 @@ +000100 IDENTIFICATION DIVISION. ST1404.2 +000200 PROGRAM-ID. ST1404.2 +000300 ST140A. ST1404.2 +000400**************************************************************** ST1404.2 +000500* * ST1404.2 +000600* VALIDATION FOR:- * ST1404.2 +000700* * ST1404.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1404.2 +000900* * ST1404.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1404.2 +001100* * ST1404.2 +001200**************************************************************** ST1404.2 +001300* ST1404.2 +001400* OBJECTIVE - ST1404.2 +001500* ROUTINE ST210 IS A TEST OF THE MERGE STATEMENT USING ST1404.2 +001600* THE ASCII COLLATING SEQUENCE AND MULTIPLE FILE TAPE. ST1404.2 +001700* THIS ROUTINE IS A TEST OF THE COMPILERS ABILITY TO MERGE ST1404.2 +001800* THE SECOND FILE OF A MULTI-FILE REEL WITH A MASS-STORAGE ST1404.2 +001900* FILE TO PRODUCE A MASS-STORAGE FILE. ST1404.2 +002000* ST1404.2 +002100* ST1404.2 +002200* FEATURES TESTED - ST1404.2 +002300* * ALPHABET-NAME IS STANDARD-1 (THE ASCII COLLATING SEQ.) ST1404.2 +002400* * COLLATING SEQUENCE IS ALPHABET-NAME ST1404.2 +002500* * MULTIPLE FILE TAPE ST1404.2 +002600* * FIXED LENGTH RECORDS ST1404.2 +002700* * SAME SORT AREA IN THE I-O-CONTROL PARAGRAPH ST1404.2 +002800* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1404.2 +002900* * USING FILE-NAME SERIES ST1404.2 +003000* * OUTPUT PROCEDURE IS SECTION-NAME ST1404.2 +003100* * RETURN RECORD INTO PART OF THE OUTPUT PROCEDURE ST1404.2 +003200* ST1404.2 +003300* * MERGE MERGE-FILE-NAME ST1404.2 +003400* ON DESCENDING KEY KEY-1 OF DATA-NAME-1 ST1404.2 +003500* ASCENDING KEY-2 OF DATA-NAME-2 ST1404.2 +003600* COLLATING SEQUENCE IS ALPHABET-NAME ST1404.2 +003700* OUTPUT PROCEDURE IS SECTION-NAME. ST1404.2 +003800* ST1404.2 +003900* ST1404.2 +004000* ST1404.2 +004100* ST1404.2 +004200* FILES USED - ST1404.2 +004300* * FILES SQ-FS1 AND SQ-FS3 ARE WRITTEN ONTO A MULTIPLE ST1404.2 +004400* FILE TAPE. FILE SQ-FS2 IS WRITTEN ONTO MASS-STORAGE. ST1404.2 +004500* THEN THE MERGE STATEMENT USES SQ-FS3 AND SQ-FS2 TO CREATE A ST1404.2 +004600* NEW MASS-STORAGE FILE SQ-FS4. ALL FILES HAVE FIXED LENGTH ST1404.2 +004700* RECORDS AND 132 CHARACTERS PER RECORD. ST1404.2 +004800* ST1404.2 +004900* SQ-FS1 ST1404.2 +005000* 51 RECORDS ST1404.2 +005100* FIXED LENGTH RECORDS 132 CHARACTERS ST1404.2 +005200* BLOCKED 1 ST1404.2 +005300* RESERVE 2 AREAS ST1404.2 +005400* ST1404.2 +005500* SQ-FS2 ST1404.2 +005600* 51 RECORDS ST1404.2 +005700* FIXED LENGTH RECORDS 132 CHARACTERS ST1404.2 +005800* BLOCKED 2 ST1404.2 +005900* RESERVE 4 AREAS ST1404.2 +006000* ST1404.2 +006100* SQ-FS3 ST1404.2 +006200* 51 RECORDS ST1404.2 +006300* FIXED LENGTH RECORDS 132 CHARACTERS ST1404.2 +006400* BLOCKED 1 ST1404.2 +006500* RESERVE 6 AREAS ST1404.2 +006600* ST1404.2 +006700* NOTE THAT FILE SQ-FS3 IS THE SECOND POSITION ST1404.2 +006800* ON A MULTIPLE FILE TAPE. BOTH FILES SQ-FS1 AND SQ-FS3 ARE ST1404.2 +006900* ON THE SAME MULTIPLE FILE TAPE. ST1404.2 +007000* ST1404.2 +007100* SQ-FS4 ST1404.2 +007200* FINAL TOTAL OF 102 RECORDS AS A RESULT OF THE MERGE ST1404.2 +007300* FIXED LENGTH RECORDS 132 CHARACTERS ST1404.2 +007400* BLOCKED 3 ST1404.2 +007500* RESERVE 4 AREAS ST1404.2 +007600* ST1404.2 +007700* ST1404.2 +007800* X-CARDS USED - ST1404.2 +007900* X-XXX008 SQ-FS1 ST1404.2 +008000* X-XXX014 SQ-FS2 ST1404.2 +008100* X-XXX009 SQ-FS3 ST1404.2 +008200* X-XXX015 SQ-FS4 ST1404.2 +008300* X-XXX027 MERGE FILE ST-FS1 ST1404.2 +008400* X-55 SYSTEM PRINTER NAME. ST1404.2 +008500* X-82 SOURCE COMPUTER NAME. ST1404.2 +008600* X-83 OBJECT COMPUTER NAME. ST1404.2 +008700* ST1404.2 +008800* ST1404.2 +008900* OPTIONS RECOMMENDED - ST1404.2 +009000* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1404.2 +009100* FILES AS THEY ARE CREATED AND READ DURING ST1404.2 +009200* MRG-TESTS 3 THRU 8. ST1404.2 +009300* ST1404.2 +009400* ST1404.2 +009500* TEST DESCRIPTIONS - ST1404.2 +009600* BLD-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1404.2 +009700* BLD-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1404.2 +009800* BLD-TEST-003 CHECKS THE CREATION OF SQ-FS3 ST1404.2 +009900* MRG-TEST-003 TESTS RECORDS 1-20 ON MERGE RESULT SQ-FS4 ST1404.2 +010000* MRG-TEST-004 TESTS RECORDS 21-40 ON MERGE RESULT SQ-FS4 ST1404.2 +010100* MRG-TEST-005 TESTS RECORDS 41-60 ON MERGE RESULT SQ-FS4 ST1404.2 +010200* MRG-TEST-006 TESTS RECORDS 61-80 ON MERGE RESULT SQ-FS4 ST1404.2 +010300* MRG-TEST-007 TESTS RECORDS 81-100 ON MERGE RESULT SQ-FS4 ST1404.2 +010400* MRG-TEST-008 TESTS RECORDS 101-102 ON MERGE RESULT SQ-FS4ST1404.2 +010500* MRG-TEST-009 AN EOF CHECK ON SQ-FS4 ST1404.2 +010600* MRG-TEST-010 CHECK THAT THE NUMERIC KEY ON THE LAST ST1404.2 +010700* RECORD ON SQ-FS4 EQUALS 102 ST1404.2 +010800* ST1404.2 +010900* ST1404.2 +011000* ************************************************************ ST1404.2 +011100 ENVIRONMENT DIVISION. ST1404.2 +011200 CONFIGURATION SECTION. ST1404.2 +011300 SOURCE-COMPUTER. ST1404.2 +011400 Linux. ST1404.2 +011500 OBJECT-COMPUTER. ST1404.2 +011600 Linux. ST1404.2 +011700 SPECIAL-NAMES. ST1404.2 +011800 ALPHABET MY-FAVORITE-ALPHABET IS STANDARD-1. ST1404.2 +011900 INPUT-OUTPUT SECTION. ST1404.2 +012000 FILE-CONTROL. ST1404.2 +012100 SELECT PRINT-FILE ASSIGN TO ST1404.2 +012200 "report.log". ST1404.2 +012300 SELECT SQ-FS1 ASSIGN ST1404.2 +012400 "XXXXX008" ST1404.2 +012500 ; ORGANIZATION IS SEQUENTIAL ST1404.2 +012600 ACCESS MODE SEQUENTIAL ST1404.2 +012700 RESERVE 2 AREAS. ST1404.2 +012800 SELECT SQ-FS2 ASSIGN TO ST1404.2 +012900 "XXXXX014" ST1404.2 +013000 ORGANIZATION IS SEQUENTIAL ST1404.2 +013100 ACCESS MODE IS SEQUENTIAL ST1404.2 +013200 RESERVE 4 AREAS. ST1404.2 +013300 SELECT SQ-FS3 ASSIGN TO ST1404.2 +013400 "XXXXX009" ST1404.2 +013500 ORGANIZATION SEQUENTIAL ST1404.2 +013600 ; ACCESS MODE IS SEQUENTIAL ST1404.2 +013700 RESERVE 6 AREAS. ST1404.2 +013800 SELECT SQ-FS4 ASSIGN TO ST1404.2 +013900 "XXXXX015" ST1404.2 +014000 ORGANIZATION IS SEQUENTIAL ST1404.2 +014100 ; ACCESS MODE IS SEQUENTIAL ST1404.2 +014200 RESERVE 4 AREAS. ST1404.2 +014300 SELECT ST-FS1 ASSIGN TO ST1404.2 +014400 "XXXXX027". ST1404.2 +014500 I-O-CONTROL. ST1404.2 +014600 SAME SORT AREA FOR SQ-FS1 ST-FS1, ST1404.2 +014700 MULTIPLE FILE TAPE CONTAINS SQ-FS1 POSITION 1 ST1404.2 +014800 SQ-FS3 POSITION 2. ST1404.2 +014900 DATA DIVISION. ST1404.2 +015000 FILE SECTION. ST1404.2 +015100 FD PRINT-FILE. ST1404.2 +015200 01 PRINT-REC PICTURE X(120). ST1404.2 +015300 01 DUMMY-RECORD PICTURE X(120). ST1404.2 +015400 FD SQ-FS1 ST1404.2 +015500 LABEL RECORDS STANDARD ST1404.2 +015600*C VALUE OF ST1404.2 +015700*C OCLABELID ST1404.2 +015800*C IS ST1404.2 +015900*C "OCDUMMY" ST1404.2 +016000*G SYSIN ST1404.2 +016100 BLOCK CONTAINS 1 RECORDS ST1404.2 +016200 RECORD CONTAINS 132 CHARACTERS ST1404.2 +016300 DATA RECORDS SQ-FS1R1-F-G-132, SQ-FS1R2-F-G-132. ST1404.2 +016400 01 SQ-FS1R1-F-G-132. ST1404.2 +016500 10 REC-PREAMBLE PIC X(120). ST1404.2 +016600 10 REST-OF-1. ST1404.2 +016700 20 KEY-1. ST1404.2 +016800 30 ALPHAN-KEY PIC X. ST1404.2 +016900 30 NUM-KEY PIC 999. ST1404.2 +017000 20 KEY-2. ST1404.2 +017100 30 ALPHAN-KEY PIC X. ST1404.2 +017200 30 NUM-KEY PIC 999. ST1404.2 +017300 20 KEY-3. ST1404.2 +017400 30 ALPHAN-KEY PIC X. ST1404.2 +017500 30 NUM-KEY PIC 999. ST1404.2 +017600 01 SQ-FS1R2-F-G-132. ST1404.2 +017700 02 FILLER PIC X(120). ST1404.2 +017800 02 GARBAGE PIC X(12). ST1404.2 +017900 FD SQ-FS2 ST1404.2 +018000 LABEL RECORD STANDARD ST1404.2 +018100*C VALUE OF ST1404.2 +018200*C OCLABELID ST1404.2 +018300*C IS ST1404.2 +018400*C "OCDUMMY" ST1404.2 +018500*G SYSIN ST1404.2 +018600 BLOCK CONTAINS 2 RECORDS ST1404.2 +018700 RECORD CONTAINS 132 CHARACTERS ST1404.2 +018800 DATA RECORD SQ-FS2R1-F-G-132. ST1404.2 +018900 01 SQ-FS2R1-F-G-132. ST1404.2 +019000 10 REC-PRE-2 PIC X(120). ST1404.2 +019100 10 REST-OF-2. ST1404.2 +019200 20 KEY-4. ST1404.2 +019300 30 ALPHAN-KEY PIC X. ST1404.2 +019400 30 NUM-KEY PIC 999. ST1404.2 +019500 20 KEY-5. ST1404.2 +019600 30 ALPHAN-KEY PIC X. ST1404.2 +019700 30 NUM-KEY PIC 999. ST1404.2 +019800 20 KEY-6. ST1404.2 +019900 30 ALPHAN-KEY PIC X. ST1404.2 +020000 30 NUM-KEY PIC 999. ST1404.2 +020100 FD SQ-FS3 ST1404.2 +020200 LABEL RECORDS STANDARD ST1404.2 +020300*C VALUE OF ST1404.2 +020400*C OCLABELID ST1404.2 +020500*C IS ST1404.2 +020600*C "OCDUMMY" ST1404.2 +020700*G SYSIN ST1404.2 +020800 BLOCK CONTAINS 1 RECORDS ST1404.2 +020900 RECORD CONTAINS 132 CHARACTERS ST1404.2 +021000 DATA RECORD SQ-FS3R1-F-G-132. ST1404.2 +021100 01 SQ-FS3R1-F-G-132. ST1404.2 +021200 10 REC-PRE-3 PIC X(120). ST1404.2 +021300 10 REST-OF-3. ST1404.2 +021400 20 KEY-7. ST1404.2 +021500 30 ALPHAN-KEY PIC X. ST1404.2 +021600 30 NUM-KEY PIC 999. ST1404.2 +021700 20 KEY-8. ST1404.2 +021800 30 ALPHAN-KEY PIC X. ST1404.2 +021900 30 NUM-KEY PIC 999. ST1404.2 +022000 20 KEY-9. ST1404.2 +022100 30 ALPHAN-KEY PIC X. ST1404.2 +022200 30 NUM-KEY PIC 999. ST1404.2 +022300 FD SQ-FS4 ST1404.2 +022400 LABEL RECORD IS STANDARD ST1404.2 +022500*C ; VALUE OF ST1404.2 +022600*C OCLABELID ST1404.2 +022700*C IS ST1404.2 +022800*C **** X-CARD UNDEFINED **** ST1404.2 +022900*G SYSIN ST1404.2 +023000 ; BLOCK CONTAINS 3 RECORDS ST1404.2 +023100 RECORD CONTAINS 132 CHARACTERS ST1404.2 +023200 DATA RECORD SQ-FS4R1-F-G-132. ST1404.2 +023300 01 SQ-FS4R1-F-G-132. ST1404.2 +023400 10 REC-PRE-4 PIC X(120). ST1404.2 +023500 10 REST-OF-4. ST1404.2 +023600 20 KEY-10. ST1404.2 +023700 30 ALPHAN-KEY PIC X. ST1404.2 +023800 30 NUM-KEY PIC 999. ST1404.2 +023900 20 KEY-11. ST1404.2 +024000 30 ALPHAN-KEY PIC X. ST1404.2 +024100 30 NUM-KEY PIC 999. ST1404.2 +024200 20 KEY-12. ST1404.2 +024300 30 ALPHAN-KEY PIC X. ST1404.2 +024400 30 NUM-KEY PIC 999. ST1404.2 +024500 SD ST-FS1 ST1404.2 +024600 RECORD CONTAINS 132 CHARACTERS ST1404.2 +024700 DATA RECORD IS ST-FS1R1-F-G-132. ST1404.2 +024800 01 ST-FS1R1-F-G-132. ST1404.2 +024900 02 FILLER PIC X(120). ST1404.2 +025000 02 NON-KEY-1. ST1404.2 +025100 03 A-KEY PIC X. ST1404.2 +025200 03 N-KEY PIC 999. ST1404.2 +025300 02 SORT-KEY. ST1404.2 +025400 03 A-KEY PIC X. ST1404.2 +025500 03 N-KEY PIC 999. ST1404.2 +025600 02 NON-KEY-2. ST1404.2 +025700 03 A-KEY PIC X. ST1404.2 +025800 03 N-KEY PIC 999. ST1404.2 +025900 WORKING-STORAGE SECTION. ST1404.2 +026000 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1404.2 +026100 77 WRK-DU-999-0001 PIC 999. ST1404.2 +026200 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1404.2 +026300 77 LAST-REC-NUM PIC 999 VALUE ZERO. ST1404.2 +026400 01 WRK-XN-0001 PIC X(51) VALUE ST1404.2 +026500 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ ". ST1404.2 +026600 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1404.2 +026700 02 CHAR PIC X OCCURS 51 TIMES. ST1404.2 +026800 01 WRK-XN-2 PIC X(51) VALUE ST1404.2 +026900 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ ". ST1404.2 +027000 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1404.2 +027100 02 ASCIIS PIC X OCCURS 51 TIMES. ST1404.2 +027200 01 WRK-XN-O020F-0001. ST1404.2 +027300 02 COMPU PIC X OCCURS 20 TIMES. ST1404.2 +027400 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1404.2 +027500 02 FILLER PIC X(20). ST1404.2 +027600 01 WRK-XN-O120F-1. ST1404.2 +027700 02 COLLS PIC X OCCURS 120 TIMES. ST1404.2 +027800 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1404.2 +027900 02 WRK-XN-0002 PIC X(20). ST1404.2 +028000 02 WRK-XN-0003 PIC X(20). ST1404.2 +028100 02 WRK-XN-0004 PIC X(20). ST1404.2 +028200 02 WRK-XN-0005 PIC X(20). ST1404.2 +028300 02 WRK-XN-0006 PIC X(20). ST1404.2 +028400 02 WRK-XN-0007 PIC X(20). ST1404.2 +028500 01 FILE-RECORD-INFORMATION-REC. ST1404.2 +028600 03 FILE-RECORD-INFO-SKELETON. ST1404.2 +028700 05 FILLER PICTURE X(48) VALUE ST1404.2 +028800 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1404.2 +028900 05 FILLER PICTURE X(46) VALUE ST1404.2 +029000 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1404.2 +029100 05 FILLER PICTURE X(26) VALUE ST1404.2 +029200 ",LFIL=000000,ORG= ,LBLR= ". ST1404.2 +029300 05 FILLER PICTURE X(37) VALUE ST1404.2 +029400 ",RECKEY= ". ST1404.2 +029500 05 FILLER PICTURE X(38) VALUE ST1404.2 +029600 ",ALTKEY1= ". ST1404.2 +029700 05 FILLER PICTURE X(38) VALUE ST1404.2 +029800 ",ALTKEY2= ". ST1404.2 +029900 05 FILLER PICTURE X(7) VALUE SPACE.ST1404.2 +030000 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1404.2 +030100 05 FILE-RECORD-INFO-P1-120. ST1404.2 +030200 07 FILLER PIC X(5). ST1404.2 +030300 07 XFILE-NAME PIC X(6). ST1404.2 +030400 07 FILLER PIC X(8). ST1404.2 +030500 07 XRECORD-NAME PIC X(6). ST1404.2 +030600 07 FILLER PIC X(1). ST1404.2 +030700 07 REELUNIT-NUMBER PIC 9(1). ST1404.2 +030800 07 FILLER PIC X(7). ST1404.2 +030900 07 XRECORD-NUMBER PIC 9(6). ST1404.2 +031000 07 FILLER PIC X(6). ST1404.2 +031100 07 UPDATE-NUMBER PIC 9(2). ST1404.2 +031200 07 FILLER PIC X(5). ST1404.2 +031300 07 ODO-NUMBER PIC 9(4). ST1404.2 +031400 07 FILLER PIC X(5). ST1404.2 +031500 07 XPROGRAM-NAME PIC X(5). ST1404.2 +031600 07 FILLER PIC X(7). ST1404.2 +031700 07 XRECORD-LENGTH PIC 9(6). ST1404.2 +031800 07 FILLER PIC X(7). ST1404.2 +031900 07 CHARS-OR-RECORDS PIC X(2). ST1404.2 +032000 07 FILLER PIC X(1). ST1404.2 +032100 07 XBLOCK-SIZE PIC 9(4). ST1404.2 +032200 07 FILLER PIC X(6). ST1404.2 +032300 07 RECORDS-IN-FILE PIC 9(6). ST1404.2 +032400 07 FILLER PIC X(5). ST1404.2 +032500 07 XFILE-ORGANIZATION PIC X(2). ST1404.2 +032600 07 FILLER PIC X(6). ST1404.2 +032700 07 XLABEL-TYPE PIC X(1). ST1404.2 +032800 05 FILE-RECORD-INFO-P121-240. ST1404.2 +032900 07 FILLER PIC X(8). ST1404.2 +033000 07 XRECORD-KEY PIC X(29). ST1404.2 +033100 07 FILLER PIC X(9). ST1404.2 +033200 07 ALTERNATE-KEY1 PIC X(29). ST1404.2 +033300 07 FILLER PIC X(9). ST1404.2 +033400 07 ALTERNATE-KEY2 PIC X(29). ST1404.2 +033500 07 FILLER PIC X(7). ST1404.2 +033600 01 TEST-RESULTS. ST1404.2 +033700 02 FILLER PIC X VALUE SPACE. ST1404.2 +033800 02 FEATURE PIC X(20) VALUE SPACE. ST1404.2 +033900 02 FILLER PIC X VALUE SPACE. ST1404.2 +034000 02 P-OR-F PIC X(5) VALUE SPACE. ST1404.2 +034100 02 FILLER PIC X VALUE SPACE. ST1404.2 +034200 02 PAR-NAME. ST1404.2 +034300 03 FILLER PIC X(19) VALUE SPACE. ST1404.2 +034400 03 PARDOT-X PIC X VALUE SPACE. ST1404.2 +034500 03 DOTVALUE PIC 99 VALUE ZERO. ST1404.2 +034600 02 FILLER PIC X(8) VALUE SPACE. ST1404.2 +034700 02 RE-MARK PIC X(61). ST1404.2 +034800 01 TEST-COMPUTED. ST1404.2 +034900 02 FILLER PIC X(30) VALUE SPACE. ST1404.2 +035000 02 FILLER PIC X(17) VALUE ST1404.2 +035100 " COMPUTED=". ST1404.2 +035200 02 COMPUTED-X. ST1404.2 +035300 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1404.2 +035400 03 COMPUTED-N REDEFINES COMPUTED-A ST1404.2 +035500 PIC -9(9).9(9). ST1404.2 +035600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1404.2 +035700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1404.2 +035800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1404.2 +035900 03 CM-18V0 REDEFINES COMPUTED-A. ST1404.2 +036000 04 COMPUTED-18V0 PIC -9(18). ST1404.2 +036100 04 FILLER PIC X. ST1404.2 +036200 03 FILLER PIC X(50) VALUE SPACE. ST1404.2 +036300 01 TEST-CORRECT. ST1404.2 +036400 02 FILLER PIC X(30) VALUE SPACE. ST1404.2 +036500 02 FILLER PIC X(17) VALUE " CORRECT =". ST1404.2 +036600 02 CORRECT-X. ST1404.2 +036700 03 CORRECT-A PIC X(20) VALUE SPACE. ST1404.2 +036800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1404.2 +036900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1404.2 +037000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1404.2 +037100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1404.2 +037200 03 CR-18V0 REDEFINES CORRECT-A. ST1404.2 +037300 04 CORRECT-18V0 PIC -9(18). ST1404.2 +037400 04 FILLER PIC X. ST1404.2 +037500 03 FILLER PIC X(2) VALUE SPACE. ST1404.2 +037600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1404.2 +037700 01 CCVS-C-1. ST1404.2 +037800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1404.2 +037900- "SS PARAGRAPH-NAME ST1404.2 +038000- " REMARKS". ST1404.2 +038100 02 FILLER PIC X(20) VALUE SPACE. ST1404.2 +038200 01 CCVS-C-2. ST1404.2 +038300 02 FILLER PIC X VALUE SPACE. ST1404.2 +038400 02 FILLER PIC X(6) VALUE "TESTED". ST1404.2 +038500 02 FILLER PIC X(15) VALUE SPACE. ST1404.2 +038600 02 FILLER PIC X(4) VALUE "FAIL". ST1404.2 +038700 02 FILLER PIC X(94) VALUE SPACE. ST1404.2 +038800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1404.2 +038900 01 REC-CT PIC 99 VALUE ZERO. ST1404.2 +039000 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1404.2 +039100 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1404.2 +039200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1404.2 +039300 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1404.2 +039400 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1404.2 +039500 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1404.2 +039600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1404.2 +039700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1404.2 +039800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1404.2 +039900 01 CCVS-H-1. ST1404.2 +040000 02 FILLER PIC X(39) VALUE SPACES. ST1404.2 +040100 02 FILLER PIC X(42) VALUE ST1404.2 +040200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1404.2 +040300 02 FILLER PIC X(39) VALUE SPACES. ST1404.2 +040400 01 CCVS-H-2A. ST1404.2 +040500 02 FILLER PIC X(40) VALUE SPACE. ST1404.2 +040600 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1404.2 +040700 02 FILLER PIC XXXX VALUE ST1404.2 +040800 "4.2 ". ST1404.2 +040900 02 FILLER PIC X(28) VALUE ST1404.2 +041000 " COPY - NOT FOR DISTRIBUTION". ST1404.2 +041100 02 FILLER PIC X(41) VALUE SPACE. ST1404.2 +041200 ST1404.2 +041300 01 CCVS-H-2B. ST1404.2 +041400 02 FILLER PIC X(15) VALUE ST1404.2 +041500 "TEST RESULT OF ". ST1404.2 +041600 02 TEST-ID PIC X(9). ST1404.2 +041700 02 FILLER PIC X(4) VALUE ST1404.2 +041800 " IN ". ST1404.2 +041900 02 FILLER PIC X(12) VALUE ST1404.2 +042000 " HIGH ". ST1404.2 +042100 02 FILLER PIC X(22) VALUE ST1404.2 +042200 " LEVEL VALIDATION FOR ". ST1404.2 +042300 02 FILLER PIC X(58) VALUE ST1404.2 +042400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1404.2 +042500 01 CCVS-H-3. ST1404.2 +042600 02 FILLER PIC X(34) VALUE ST1404.2 +042700 " FOR OFFICIAL USE ONLY ". ST1404.2 +042800 02 FILLER PIC X(58) VALUE ST1404.2 +042900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1404.2 +043000 02 FILLER PIC X(28) VALUE ST1404.2 +043100 " COPYRIGHT 1985 ". ST1404.2 +043200 01 CCVS-E-1. ST1404.2 +043300 02 FILLER PIC X(52) VALUE SPACE. ST1404.2 +043400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1404.2 +043500 02 ID-AGAIN PIC X(9). ST1404.2 +043600 02 FILLER PIC X(45) VALUE SPACES. ST1404.2 +043700 01 CCVS-E-2. ST1404.2 +043800 02 FILLER PIC X(31) VALUE SPACE. ST1404.2 +043900 02 FILLER PIC X(21) VALUE SPACE. ST1404.2 +044000 02 CCVS-E-2-2. ST1404.2 +044100 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1404.2 +044200 03 FILLER PIC X VALUE SPACE. ST1404.2 +044300 03 ENDER-DESC PIC X(44) VALUE ST1404.2 +044400 "ERRORS ENCOUNTERED". ST1404.2 +044500 01 CCVS-E-3. ST1404.2 +044600 02 FILLER PIC X(22) VALUE ST1404.2 +044700 " FOR OFFICIAL USE ONLY". ST1404.2 +044800 02 FILLER PIC X(12) VALUE SPACE. ST1404.2 +044900 02 FILLER PIC X(58) VALUE ST1404.2 +045000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1404.2 +045100 02 FILLER PIC X(13) VALUE SPACE. ST1404.2 +045200 02 FILLER PIC X(15) VALUE ST1404.2 +045300 " COPYRIGHT 1985". ST1404.2 +045400 01 CCVS-E-4. ST1404.2 +045500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1404.2 +045600 02 FILLER PIC X(4) VALUE " OF ". ST1404.2 +045700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1404.2 +045800 02 FILLER PIC X(40) VALUE ST1404.2 +045900 " TESTS WERE EXECUTED SUCCESSFULLY". ST1404.2 +046000 01 XXINFO. ST1404.2 +046100 02 FILLER PIC X(19) VALUE ST1404.2 +046200 "*** INFORMATION ***". ST1404.2 +046300 02 INFO-TEXT. ST1404.2 +046400 04 FILLER PIC X(8) VALUE SPACE. ST1404.2 +046500 04 XXCOMPUTED PIC X(20). ST1404.2 +046600 04 FILLER PIC X(5) VALUE SPACE. ST1404.2 +046700 04 XXCORRECT PIC X(20). ST1404.2 +046800 02 INF-ANSI-REFERENCE PIC X(48). ST1404.2 +046900 01 HYPHEN-LINE. ST1404.2 +047000 02 FILLER PIC IS X VALUE IS SPACE. ST1404.2 +047100 02 FILLER PIC IS X(65) VALUE IS "************************ST1404.2 +047200- "*****************************************". ST1404.2 +047300 02 FILLER PIC IS X(54) VALUE IS "************************ST1404.2 +047400- "******************************". ST1404.2 +047500 01 CCVS-PGM-ID PIC X(9) VALUE ST1404.2 +047600 "ST140A". ST1404.2 +047700 PROCEDURE DIVISION. ST1404.2 +047800 DECLARATIVES. ST1404.2 +047900 SECT-ST210-DEC SECTION. ST1404.2 +048000 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. ST1404.2 +048100 SRT-WRITE-DEC. ST1404.2 +048200 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1404.2 +048300 MOVE "SRT-TEST-DEC" TO PAR-NAME. ST1404.2 +048400 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1404.2 +048500 STOP RUN. ST1404.2 +048600 END DECLARATIVES. ST1404.2 +048700 CCVS1 SECTION. ST1404.2 +048800 OPEN-FILES. ST1404.2 +048900 OPEN OUTPUT PRINT-FILE. ST1404.2 +049000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1404.2 +049100 MOVE SPACE TO TEST-RESULTS. ST1404.2 +049200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1404.2 +049300 MOVE ZERO TO REC-SKL-SUB. ST1404.2 +049400 PERFORM CCVS-INIT-FILE 9 TIMES. ST1404.2 +049500 CCVS-INIT-FILE. ST1404.2 +049600 ADD 1 TO REC-SKL-SUB. ST1404.2 +049700 MOVE FILE-RECORD-INFO-SKELETON ST1404.2 +049800 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1404.2 +049900 CCVS-INIT-EXIT. ST1404.2 +050000 GO TO CCVS1-EXIT. ST1404.2 +050100 CLOSE-FILES. ST1404.2 +050200 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1404.2 +050300 TERMINATE-CCVS. ST1404.2 +050400*S EXIT PROGRAM. ST1404.2 +050500*SERMINATE-CALL. ST1404.2 +050600 STOP RUN. ST1404.2 +050700 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1404.2 +050800 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1404.2 +050900 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1404.2 +051000 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1404.2 +051100 MOVE "****TEST DELETED****" TO RE-MARK. ST1404.2 +051200 PRINT-DETAIL. ST1404.2 +051300 IF REC-CT NOT EQUAL TO ZERO ST1404.2 +051400 MOVE "." TO PARDOT-X ST1404.2 +051500 MOVE REC-CT TO DOTVALUE. ST1404.2 +051600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1404.2 +051700 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1404.2 +051800 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1404.2 +051900 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1404.2 +052000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1404.2 +052100 MOVE SPACE TO CORRECT-X. ST1404.2 +052200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1404.2 +052300 MOVE SPACE TO RE-MARK. ST1404.2 +052400 HEAD-ROUTINE. ST1404.2 +052500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +052600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +052700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1404.2 +052800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1404.2 +052900 COLUMN-NAMES-ROUTINE. ST1404.2 +053000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +053100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +053200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +053300 END-ROUTINE. ST1404.2 +053400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1404.2 +053500 END-RTN-EXIT. ST1404.2 +053600 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +053700 END-ROUTINE-1. ST1404.2 +053800 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1404.2 +053900 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1404.2 +054000 ADD PASS-COUNTER TO ERROR-HOLD. ST1404.2 +054100* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1404.2 +054200 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1404.2 +054300 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1404.2 +054400 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1404.2 +054500 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1404.2 +054600 END-ROUTINE-12. ST1404.2 +054700 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1404.2 +054800 IF ERROR-COUNTER IS EQUAL TO ZERO ST1404.2 +054900 MOVE "NO " TO ERROR-TOTAL ST1404.2 +055000 ELSE ST1404.2 +055100 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1404.2 +055200 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1404.2 +055300 PERFORM WRITE-LINE. ST1404.2 +055400 END-ROUTINE-13. ST1404.2 +055500 IF DELETE-COUNTER IS EQUAL TO ZERO ST1404.2 +055600 MOVE "NO " TO ERROR-TOTAL ELSE ST1404.2 +055700 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1404.2 +055800 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1404.2 +055900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +056000 IF INSPECT-COUNTER EQUAL TO ZERO ST1404.2 +056100 MOVE "NO " TO ERROR-TOTAL ST1404.2 +056200 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1404.2 +056300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1404.2 +056400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +056500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1404.2 +056600 WRITE-LINE. ST1404.2 +056700 ADD 1 TO RECORD-COUNT. ST1404.2 +056800 IF RECORD-COUNT GREATER 42 ST1404.2 +056900 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1404.2 +057000 MOVE SPACE TO DUMMY-RECORD ST1404.2 +057100 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1404.2 +057200 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1404.2 +057300 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1404.2 +057400 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1404.2 +057500 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1404.2 +057600 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1404.2 +057700 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1404.2 +057800 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1404.2 +057900 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1404.2 +058000 MOVE ZERO TO RECORD-COUNT. ST1404.2 +058100 PERFORM WRT-LN. ST1404.2 +058200 WRT-LN. ST1404.2 +058300 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1404.2 +058400 MOVE SPACE TO DUMMY-RECORD. ST1404.2 +058500 BLANK-LINE-PRINT. ST1404.2 +058600 PERFORM WRT-LN. ST1404.2 +058700 FAIL-ROUTINE. ST1404.2 +058800 IF COMPUTED-X NOT EQUAL TO SPACE ST1404.2 +058900 GO TO FAIL-ROUTINE-WRITE. ST1404.2 +059000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1404.2 +059100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1404.2 +059200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1404.2 +059300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +059400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1404.2 +059500 GO TO FAIL-ROUTINE-EX. ST1404.2 +059600 FAIL-ROUTINE-WRITE. ST1404.2 +059700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1404.2 +059800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1404.2 +059900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1404.2 +060000 MOVE SPACES TO COR-ANSI-REFERENCE. ST1404.2 +060100 FAIL-ROUTINE-EX. EXIT. ST1404.2 +060200 BAIL-OUT. ST1404.2 +060300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1404.2 +060400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1404.2 +060500 BAIL-OUT-WRITE. ST1404.2 +060600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1404.2 +060700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1404.2 +060800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1404.2 +060900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1404.2 +061000 BAIL-OUT-EX. EXIT. ST1404.2 +061100 CCVS1-EXIT. ST1404.2 +061200 EXIT. ST1404.2 +061300 SECT-ST210-0001 SECTION. ST1404.2 +061400 BLD-INIT-001. ST1404.2 +061500 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1404.2 +061600 OPEN OUTPUT SQ-FS1. ST1404.2 +061700 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1404.2 +061800 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1404.2 +061900 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1404.2 +062000 MOVE 000132 TO XRECORD-LENGTH (1). ST1404.2 +062100 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1404.2 +062200 MOVE 0001 TO XBLOCK-SIZE (1). ST1404.2 +062300 MOVE 000051 TO RECORDS-IN-FILE (1). ST1404.2 +062400 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1404.2 +062500 MOVE "S" TO XLABEL-TYPE (1). ST1404.2 +062600 MOVE 000001 TO XRECORD-NUMBER (1). ST1404.2 +062700 MOVE SPACES TO WRK-XN-O120F-1. ST1404.2 +062800 BLD-TEST-001. ST1404.2 +062900 PERFORM BLD-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1404.2 +063000 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1404.2 +063100*X MOVE SPACES TO PRINT-REC. ST1404.2 +063200*X WRITE PRINT-REC. ST1404.2 +063300 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1404.2 +063400 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1404.2 +063500 ELSE ST1404.2 +063600 PERFORM PASS. ST1404.2 +063700 GO TO BLD-WRITE-001. ST1404.2 +063800 BLD-TEST-001-BUILD. ST1404.2 +063900 MOVE "JUNKSLOPJUNK" TO GARBAGE. ST1404.2 +064000 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1404.2 +064100 NUM-KEY OF KEY-3. ST1404.2 +064200 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1404.2 +064300 ADD 1 TO XRECORD-NUMBER (1). ST1404.2 +064400 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1404.2 +064500 ADD 1 TO WRK-DU-999-2. ST1404.2 +064600 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1404.2 +064700 ADD 1 TO WRK-DU-999-2. ST1404.2 +064800*X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1404.2 +064900*X WRITE PRINT-REC FROM REST-OF-1. ST1404.2 +065000*X MOVE SPACES TO PRINT-REC. ST1404.2 +065100 WRITE SQ-FS1R1-F-G-132. ST1404.2 +065200 BLD-DELETE-001. ST1404.2 +065300 PERFORM DE-LETE. ST1404.2 +065400 BLD-WRITE-001. ST1404.2 +065500 MOVE "BLD-TEST-001" TO PAR-NAME. ST1404.2 +065600 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1404.2 +065700 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1404.2 +065800 PERFORM PRINT-DETAIL. ST1404.2 +065900*X MOVE SPACES TO PRINT-REC. ST1404.2 +066000*X WRITE PRINT-REC. ST1404.2 +066100 CLOSE SQ-FS1 WITH NO REWIND. ST1404.2 +066200 BLD-INIT-002. ST1404.2 +066300 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1404.2 +066400 OPEN OUTPUT SQ-FS2. ST1404.2 +066500 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1404.2 +066600 MOVE 000001 TO XRECORD-NUMBER (1). ST1404.2 +066700 MOVE 0002 TO XBLOCK-SIZE (1). ST1404.2 +066800 BLD-TEST-002. ST1404.2 +066900 PERFORM BLD-TEST-002-BUILD VARYING WRK-DU-999-0001 FROM ST1404.2 +067000 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1404.2 +067100*X MOVE SPACES TO PRINT-REC. ST1404.2 +067200*X WRITE PRINT-REC. ST1404.2 +067300 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1404.2 +067400 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1404.2 +067500 ELSE ST1404.2 +067600 PERFORM PASS. ST1404.2 +067700 GO TO BLD-WRITE-002. ST1404.2 +067800 BLD-TEST-002-BUILD. ST1404.2 +067900 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1404.2 +068000 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1404.2 +068100 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1404.2 +068200 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1404.2 +068300 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1404.2 +068400 ADD 000001 TO XRECORD-NUMBER (1). ST1404.2 +068500*X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1404.2 +068600*X WRITE PRINT-REC FROM REST-OF-2. ST1404.2 +068700*X MOVE SPACES TO PRINT-REC. ST1404.2 +068800 WRITE SQ-FS2R1-F-G-132. ST1404.2 +068900 BLD-DELETE-002. ST1404.2 +069000 PERFORM DE-LETE. ST1404.2 +069100 BLD-WRITE-002. ST1404.2 +069200 MOVE "BLD-TEST-002" TO PAR-NAME. ST1404.2 +069300 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1404.2 +069400 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1404.2 +069500 PERFORM PRINT-DETAIL. ST1404.2 +069600*X MOVE SPACES TO PRINT-REC. ST1404.2 +069700*X WRITE PRINT-REC. ST1404.2 +069800 CLOSE SQ-FS2. ST1404.2 +069900 BLD-INIT-003. ST1404.2 +070000 MOVE "CREATE FILE SQ-FS3" TO FEATURE. ST1404.2 +070100 MOVE "SQ-FS3" TO XFILE-NAME (1). ST1404.2 +070200 MOVE 000001 TO XRECORD-NUMBER (1). ST1404.2 +070300 MOVE 0001 TO XBLOCK-SIZE (1). ST1404.2 +070400 OPEN OUTPUT SQ-FS3. ST1404.2 +070500 BLD-TEST-003. ST1404.2 +070600 PERFORM BLD-TEST-003-BUILD VARYING WRK-DU-999-0001 FROM ST1404.2 +070700 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1404.2 +070800*X MOVE SPACES TO PRINT-REC. ST1404.2 +070900*X WRITE PRINT-REC. ST1404.2 +071000 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 52 ST1404.2 +071100 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1404.2 +071200 ELSE ST1404.2 +071300 PERFORM PASS. ST1404.2 +071400 GO TO BLD-WRITE-003. ST1404.2 +071500 BLD-TEST-003-BUILD. ST1404.2 +071600 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-7 ST1404.2 +071700 ALPHAN-KEY OF KEY-8 ALPHAN-KEY OF KEY-9. ST1404.2 +071800 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-7 NUM-KEY OF KEY-8 ST1404.2 +071900 NUM-KEY OF KEY-9. ST1404.2 +072000 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-3. ST1404.2 +072100 ADD 000001 TO XRECORD-NUMBER (1). ST1404.2 +072200*X WRITE PRINT-REC FROM SQ-FS3R1-F-G-132. ST1404.2 +072300*X WRITE PRINT-REC FROM REST-OF-3. ST1404.2 +072400*X MOVE SPACES TO PRINT-REC. ST1404.2 +072500 WRITE SQ-FS3R1-F-G-132. ST1404.2 +072600 BLD-DELETE-003. ST1404.2 +072700 PERFORM DE-LETE. ST1404.2 +072800 BLD-WRITE-003. ST1404.2 +072900 MOVE "BLD-TEST-003" TO PAR-NAME. ST1404.2 +073000 MOVE "3RD FILE CREATED" TO COMPUTED-A. ST1404.2 +073100 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1404.2 +073200 PERFORM PRINT-DETAIL. ST1404.2 +073300*X MOVE SPACES TO PRINT-REC. ST1404.2 +073400*X WRITE PRINT-REC. ST1404.2 +073500 CLOSE SQ-FS3. ST1404.2 +073600 MRG-INIT-001. ST1404.2 +073700 MERGE ST-FS1 ST1404.2 +073800 ON DESCENDING KEY A-KEY OF SORT-KEY ST1404.2 +073900 ASCENDING N-KEY OF NON-KEY-2 ST1404.2 +074000 COLLATING SEQUENCE IS MY-FAVORITE-ALPHABET ST1404.2 +074100 USING SQ-FS2, SQ-FS3 ST1404.2 +074200 OUTPUT PROCEDURE IS SECT-ST210-0002. ST1404.2 +074300 SRT-TEST-003. ST1404.2 +074400 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +074500 OPEN INPUT SQ-FS4. ST1404.2 +074600 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +074700 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +074800*X MOVE SPACES TO PRINT-REC. ST1404.2 +074900*X WRITE PRINT-REC. ST1404.2 +075000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1404.2 +075100 PERFORM FAIL GO TO SRT-FAIL-003 ST1404.2 +075200 ELSE ST1404.2 +075300 PERFORM PASS. ST1404.2 +075400 GO TO SRT-WRITE-003. ST1404.2 +075500 SRT-DELETE-003. ST1404.2 +075600 PERFORM DE-LETE. ST1404.2 +075700 GO TO SRT-WRITE-003. ST1404.2 +075800 SRT-FAIL-003. ST1404.2 +075900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +076000 MOVE WRK-XN-0002 TO CORRECT-A. ST1404.2 +076100 SRT-WRITE-003. ST1404.2 +076200 MOVE "MRG-TEST-003" TO PAR-NAME. ST1404.2 +076300 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +076400 PERFORM PRINT-DETAIL. ST1404.2 +076500*X MOVE SPACES TO PRINT-REC. ST1404.2 +076600*X WRITE PRINT-REC. ST1404.2 +076700 SRT-INIT-004. ST1404.2 +076800 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +076900 SRT-TEST-004. ST1404.2 +077000 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +077100 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +077200*X MOVE SPACES TO PRINT-REC. ST1404.2 +077300*X WRITE PRINT-REC. ST1404.2 +077400 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1404.2 +077500 PERFORM FAIL GO TO SRT-FAIL-004 ST1404.2 +077600 ELSE ST1404.2 +077700 PERFORM PASS. ST1404.2 +077800 GO TO SRT-WRITE-004. ST1404.2 +077900 SRT-DELETE-004. ST1404.2 +078000 PERFORM DE-LETE. ST1404.2 +078100 GO TO SRT-WRITE-004. ST1404.2 +078200 SRT-FAIL-004. ST1404.2 +078300 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +078400 MOVE WRK-XN-0003 TO CORRECT-A. ST1404.2 +078500 SRT-WRITE-004. ST1404.2 +078600 MOVE "MRG-TEST-004" TO PAR-NAME. ST1404.2 +078700 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +078800 PERFORM PRINT-DETAIL. ST1404.2 +078900*X MOVE SPACES TO PRINT-REC. ST1404.2 +079000*X WRITE PRINT-REC. ST1404.2 +079100 SRT-INIT-005. ST1404.2 +079200 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +079300 SRT-TEST-005. ST1404.2 +079400 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +079500 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +079600*X MOVE SPACES TO PRINT-REC. ST1404.2 +079700*X WRITE PRINT-REC. ST1404.2 +079800 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1404.2 +079900 PERFORM FAIL GO TO SRT-FAIL-005 ST1404.2 +080000 ELSE ST1404.2 +080100 PERFORM PASS. ST1404.2 +080200 GO TO SRT-WRITE-005. ST1404.2 +080300 SRT-DELETE-005. ST1404.2 +080400 PERFORM DE-LETE. ST1404.2 +080500 GO TO SRT-WRITE-005. ST1404.2 +080600 SRT-FAIL-005. ST1404.2 +080700 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +080800 MOVE WRK-XN-0004 TO CORRECT-A. ST1404.2 +080900 SRT-WRITE-005. ST1404.2 +081000 MOVE "MRG-TEST-005" TO PAR-NAME. ST1404.2 +081100 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +081200 PERFORM PRINT-DETAIL. ST1404.2 +081300*X MOVE SPACES TO PRINT-REC. ST1404.2 +081400*X WRITE PRINT-REC. ST1404.2 +081500 SRT-INIT-006. ST1404.2 +081600 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +081700 SRT-TEST-006. ST1404.2 +081800 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +081900 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +082000*X MOVE SPACES TO PRINT-REC. ST1404.2 +082100*X WRITE PRINT-REC. ST1404.2 +082200 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1404.2 +082300 PERFORM FAIL GO TO SRT-FAIL-006 ST1404.2 +082400 ELSE ST1404.2 +082500 PERFORM PASS. ST1404.2 +082600 GO TO SRT-WRITE-006. ST1404.2 +082700 SRT-DELETE-006. ST1404.2 +082800 PERFORM DE-LETE. ST1404.2 +082900 GO TO SRT-WRITE-006. ST1404.2 +083000 SRT-FAIL-006. ST1404.2 +083100 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +083200 MOVE WRK-XN-0005 TO CORRECT-A. ST1404.2 +083300 SRT-WRITE-006. ST1404.2 +083400 MOVE "MRG-TEST-006" TO PAR-NAME. ST1404.2 +083500 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +083600 PERFORM PRINT-DETAIL. ST1404.2 +083700*X MOVE SPACES TO PRINT-REC. ST1404.2 +083800*X WRITE PRINT-REC. ST1404.2 +083900 SRT-INIT-007. ST1404.2 +084000 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +084100 SRT-TEST-007. ST1404.2 +084200 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +084300 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1404.2 +084400*X MOVE SPACES TO PRINT-REC. ST1404.2 +084500*X WRITE PRINT-REC. ST1404.2 +084600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1404.2 +084700 PERFORM FAIL GO TO SRT-FAIL-007 ST1404.2 +084800 ELSE ST1404.2 +084900 PERFORM PASS. ST1404.2 +085000 GO TO SRT-WRITE-007. ST1404.2 +085100 SRT-DELETE-007. ST1404.2 +085200 PERFORM DE-LETE. ST1404.2 +085300 GO TO SRT-WRITE-007. ST1404.2 +085400 SRT-FAIL-007. ST1404.2 +085500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +085600 MOVE WRK-XN-0006 TO CORRECT-A. ST1404.2 +085700 SRT-WRITE-007. ST1404.2 +085800 MOVE "MRG-TEST-007" TO PAR-NAME. ST1404.2 +085900 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +086000 PERFORM PRINT-DETAIL. ST1404.2 +086100*X MOVE SPACES TO PRINT-REC. ST1404.2 +086200*X WRITE PRINT-REC. ST1404.2 +086300 SRT-INIT-008. ST1404.2 +086400 MOVE SPACES TO WRK-XN-X-0001. ST1404.2 +086500 SRT-TEST-008. ST1404.2 +086600 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1404.2 +086700 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1404.2 +086800*X MOVE SPACES TO PRINT-REC. ST1404.2 +086900*X WRITE PRINT-REC. ST1404.2 +087000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1404.2 +087100 PERFORM FAIL GO TO SRT-FAIL-008 ST1404.2 +087200 ELSE ST1404.2 +087300 PERFORM PASS. ST1404.2 +087400 GO TO SRT-WRITE-008. ST1404.2 +087500 SRT-DELETE-008. ST1404.2 +087600 PERFORM DE-LETE. ST1404.2 +087700 GO TO SRT-WRITE-008. ST1404.2 +087800 SRT-FAIL-008. ST1404.2 +087900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1404.2 +088000 MOVE WRK-XN-0007 TO CORRECT-A. ST1404.2 +088100 SRT-WRITE-008. ST1404.2 +088200 MOVE "MRG-TEST-008" TO PAR-NAME. ST1404.2 +088300 MOVE "STAN. COLLATING SEQ." TO FEATURE. ST1404.2 +088400 PERFORM PRINT-DETAIL. ST1404.2 +088500 MOVE NUM-KEY OF KEY-11 TO LAST-REC-NUM. ST1404.2 +088600 SRT-TEST-009. ST1404.2 +088700 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1404.2 +088800 GO TO SRT-FAIL-009. ST1404.2 +088900 READ SQ-FS4 AT END PERFORM PASS ST1404.2 +089000 GO TO SRT-WRITE-009. ST1404.2 +089100 GO TO SRT-FAIL-009. ST1404.2 +089200 SRT-DELETE-009. ST1404.2 +089300 PERFORM DE-LETE. ST1404.2 +089400 GO TO SRT-WRITE-009. ST1404.2 +089500 SRT-FAIL-009. ST1404.2 +089600 MOVE "EOF NOT FOUND" TO RE-MARK. ST1404.2 +089700 PERFORM FAIL . ST1404.2 +089800 SRT-WRITE-009. ST1404.2 +089900 MOVE "EOF CHECK SQ-FS4" TO FEATURE. ST1404.2 +090000 MOVE "MRG-TEST-009" TO PAR-NAME. ST1404.2 +090100 PERFORM PRINT-DETAIL. ST1404.2 +090200 SRT-TEST-010. ST1404.2 +090300 IF LAST-REC-NUM IS NOT EQUAL TO 102 ST1404.2 +090400 PERFORM FAIL GO TO SRT-FAIL-010 ST1404.2 +090500 ELSE ST1404.2 +090600 PERFORM PASS. ST1404.2 +090700 GO TO SRT-WRITE-010. ST1404.2 +090800 SRT-DELETE-010. ST1404.2 +090900 PERFORM DE-LETE. ST1404.2 +091000 GO TO SRT-WRITE-010. ST1404.2 +091100 SRT-FAIL-010. ST1404.2 +091200 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1404.2 +091300 MOVE 102 TO CR-18V0. ST1404.2 +091400 SRT-WRITE-010. ST1404.2 +091500 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1404.2 +091600 MOVE "MRG-TEST-010" TO PAR-NAME. ST1404.2 +091700 PERFORM PRINT-DETAIL. ST1404.2 +091800 CLOSE SQ-FS4. ST1404.2 +091900 GO TO CCVS-999999. ST1404.2 +092000 READ-SQ-FS1 SECTION. ST1404.2 +092100 RD-1. ST1404.2 +092200 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1404.2 +092300 GO TO R1-EXIT. ST1404.2 +092400 READ SQ-FS4 AT END GO TO PREMATURE-EOF. ST1404.2 +092500 MOVE ALPHAN-KEY OF KEY-12 TO COMPU (WRK-DU-999-0001). ST1404.2 +092600 GO TO R1-EXIT. ST1404.2 +092700 PREMATURE-EOF. ST1404.2 +092800 MOVE 1 TO WRK-DU-9-0001. ST1404.2 +092900 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1404.2 +093000 R1-EXIT. ST1404.2 +093100 EXIT. ST1404.2 +093200 SECT-ST210-0002 SECTION. ST1404.2 +093300 SORT-OUTPUT-PROC. ST1404.2 +093400 OPEN OUTPUT SQ-FS4. ST1404.2 +093500 RETURN-THE-OLD-RECORDS. ST1404.2 +093600 RETURN ST-FS1 RECORD INTO SQ-FS4R1-F-G-132 ST1404.2 +093700 AT END GO TO CLOSE-AFTER-SORT. ST1404.2 +093800*X WRITE PRINT-REC FROM SQ-FS4R1-F-G-132. ST1404.2 +093900*X WRITE PRINT-REC FROM REST-OF-4. ST1404.2 +094000*X MOVE SPACES TO PRINT-REC. ST1404.2 +094100 WRITE SQ-FS4R1-F-G-132. ST1404.2 +094200 GO TO RETURN-THE-OLD-RECORDS. ST1404.2 +094300 CLOSE-AFTER-SORT. ST1404.2 +094400 CLOSE SQ-FS4. ST1404.2 +094500 CCVS-EXIT SECTION. ST1404.2 +094600 CCVS-999999. ST1404.2 +094700 GO TO CLOSE-FILES. ST1404.2 diff --git a/tests/cobol85/ST/ST144A.CBL b/tests/cobol85/ST/ST144A.CBL new file mode 100755 index 00000000..3bbc850e --- /dev/null +++ b/tests/cobol85/ST/ST144A.CBL @@ -0,0 +1,951 @@ +000100 IDENTIFICATION DIVISION. ST1444.2 +000200 PROGRAM-ID. ST1444.2 +000300 ST144A. ST1444.2 +000400**************************************************************** ST1444.2 +000500* * ST1444.2 +000600* VALIDATION FOR:- * ST1444.2 +000700* * ST1444.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1444.2 +000900* * ST1444.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1444.2 +001100* * ST1444.2 +001200**************************************************************** ST1444.2 +001300* ST1444.2 +001400* OBJECTIVE - ST1444.2 +001500* ROUTINE ST144A IS A TEST OF THE MERGE STATEMENT USING ST1444.2 +001600* A NATIVE COLLATING SEQUENCE AND MULTIPLE FILE TAPE. ST1444.2 +001700* THIS ROUTINE IS A TEST OF THE COMPILERS ABILITY TO MERGE ST1444.2 +001800* THE SECOND FILE OF A MULTI-FILE REEL WITH A MASS-STORAGE ST1444.2 +001900* FILE TO PRODUCE A MASS-STORAGE FILE. ST1444.2 +002000* ST1444.2 +002100* ST1444.2 +002200* FEATURES TESTED - ST1444.2 +002300* * MULTIPLE FILE TAPE ST1444.2 +002400* * FIXED LENGTH RECORDS ST1444.2 +002500* * SAME SORT AREA IN THE I-O-CONTROL PARAGRAPH ST1444.2 +002600* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1444.2 +002700* * USING FILE-NAME SERIES ST1444.2 +002800* * OUTPUT PROCEDURE IS SECTION-NAME ST1444.2 +002900* * RETURN RECORD INTO PART OF THE OUTPUT PROCEDURE ST1444.2 +003000* ST1444.2 +003100* * MERGE MERGE-FILE-NAME ST1444.2 +003200* ON DESCENDING KEY KEY-1 OF DATA-NAME-1 ST1444.2 +003300* ASCENDING KEY-2 OF DATA-NAME-2 ST1444.2 +003400* USING FILE-NAME-2, FILE-NAME-3 ST1444.2 +003500* OUTPUT PROCEDURE IS SECTION-NAME. ST1444.2 +003600* ST1444.2 +003700* ST1444.2 +003800* FILES USED - ST1444.2 +003900* * FILES SQ-FS1 AND SQ-FS3 ARE WRITTEN ONTO A MULTIPLE ST1444.2 +004000* FILE TAPE. FILE SQ-FS2 IS WRITTEN ONTO MASS-STORAGE. ST1444.2 +004100* THEN THE MERGE STATEMENT USES SQ-FS3 AND SQ-FS2 TO CREATE A ST1444.2 +004200* NEW MASS-STORAGE FILE SQ-FS4. ALL FILES HAVE FIXED LENGTH ST1444.2 +004300* RECORDS AND 132 CHARACTERS PER RECORD. ST1444.2 +004400* ST1444.2 +004500* SQ-FS1 ST1444.2 +004600* 51 RECORDS ST1444.2 +004700* FIXED LENGTH RECORDS 132 CHARACTERS ST1444.2 +004800* BLOCKED 1 ST1444.2 +004900* RESERVE 2 AREAS ST1444.2 +005000* ST1444.2 +005100* SQ-FS2 ST1444.2 +005200* 51 RECORDS ST1444.2 +005300* FIXED LENGTH RECORDS 132 CHARACTERS ST1444.2 +005400* BLOCKED 2 ST1444.2 +005500* RESERVE 4 AREAS ST1444.2 +005600* ST1444.2 +005700* SQ-FS3 ST1444.2 +005800* 51 RECORDS ST1444.2 +005900* FIXED LENGTH RECORDS 132 CHARACTERS ST1444.2 +006000* BLOCKED 1 ST1444.2 +006100* RESERVE 6 AREAS ST1444.2 +006200* ST1444.2 +006300* NOTE THAT FILE SQ-FS3 IS THE SECOND POSITION ST1444.2 +006400* ON A MULTIPLE FILE TAPE. BOTH FILES SQ-FS1 AND SQ-FS3 ARE ST1444.2 +006500* ON THE SAME MULTIPLE FILE TAPE. ST1444.2 +006600* ST1444.2 +006700* SQ-FS4 ST1444.2 +006800* FINAL TOTAL OF 102 RECORDS AS A RESULT OF THE MERGE ST1444.2 +006900* FIXED LENGTH RECORDS 132 CHARACTERS ST1444.2 +007000* BLOCKED 3 ST1444.2 +007100* RESERVE 4 AREAS ST1444.2 +007200* ST1444.2 +007300* ST1444.2 +007400* X-CARDS USED - ST1444.2 +007500* X-XXX008 SQ-FS1 ST1444.2 +007600* X-XXX014 SQ-FS2 ST1444.2 +007700* X-XXX009 SQ-FS3 ST1444.2 +007800* X-XXX015 SQ-FS4 ST1444.2 +007900* X-XXX027 MERGE FILE ST-FS1 ST1444.2 +008000* X-55 SYSTEM PRINTER NAME. ST1444.2 +008100* X-XXX064 NATIVE COLLATING SEQUENCE DESCENDING ORDER-NOTE ST1444.2 +008200* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-64 ST1444.2 +008300* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1444.2 +008400* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1444.2 +008500* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1444.2 +008600* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-64 CARD..... ST1444.2 +008700* ST1444.2 +008800* X-64 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ ". ST1444.2 +008900* X-82 SOURCE COMPUTER NAME. ST1444.2 +009000* X-83 OBJECT COMPUTER NAME. ST1444.2 +009100* ST1444.2 +009200* ST1444.2 +009300* OPTIONS RECOMMENDED - ST1444.2 +009400* * *OPT8 X TO BE USED IF NECESSARY TO DUMP THE ST1444.2 +009500* FILES AS THEY ARE CREATED AND READ DURING ST1444.2 +009600* MRG-TESTS 3 THRU 8. ST1444.2 +009700* ST1444.2 +009800* ST1444.2 +009900* TEST DESCRIPTIONS - ST1444.2 +010000* BLD-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1444.2 +010100* BLD-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1444.2 +010200* BLD-TEST-003 CHECKS THE CREATION OF SQ-FS3 ST1444.2 +010300* MRG-TEST-003 TESTS RECORDS 1-20 ON MERGE RESULT SQ-FS4 ST1444.2 +010400* MRG-TEST-004 TESTS RECORDS 21-40 ON MERGE RESULT SQ-FS4 ST1444.2 +010500* MRG-TEST-005 TESTS RECORDS 41-60 ON MERGE RESULT SQ-FS4 ST1444.2 +010600* MRG-TEST-006 TESTS RECORDS 61-80 ON MERGE RESULT SQ-FS4 ST1444.2 +010700* MRG-TEST-007 TESTS RECORDS 81-100 ON MERGE RESULT SQ-FS4 ST1444.2 +010800* MRG-TEST-008 TESTS RECORDS 101-102 ON MERGE RESULT SQ-FS4ST1444.2 +010900* MRG-TEST-009 AN EOF CHECK ON SQ-FS4 ST1444.2 +011000* MRG-TEST-010 CHECK THAT THE NUMERIC KEY ON THE LAST ST1444.2 +011100* RECORD ON SQ-FS4 EQUALS 102 ST1444.2 +011200* ST1444.2 +011300* ST1444.2 +011400* ************************************************************ ST1444.2 +011500 ENVIRONMENT DIVISION. ST1444.2 +011600 CONFIGURATION SECTION. ST1444.2 +011700 SOURCE-COMPUTER. ST1444.2 +011800 Linux. ST1444.2 +011900 OBJECT-COMPUTER. ST1444.2 +012000 Linux. ST1444.2 +012100 INPUT-OUTPUT SECTION. ST1444.2 +012200 FILE-CONTROL. ST1444.2 +012300 SELECT PRINT-FILE ASSIGN TO ST1444.2 +012400 "report.log". ST1444.2 +012500 SELECT SQ-FS1 ASSIGN ST1444.2 +012600 "XXXXX008" ST1444.2 +012700 ; ORGANIZATION IS SEQUENTIAL ST1444.2 +012800 ACCESS MODE SEQUENTIAL ST1444.2 +012900 RESERVE 2 AREAS. ST1444.2 +013000 SELECT SQ-FS2 ASSIGN TO ST1444.2 +013100 "XXXXX014" ST1444.2 +013200 ORGANIZATION IS SEQUENTIAL ST1444.2 +013300 ACCESS MODE IS SEQUENTIAL ST1444.2 +013400 RESERVE 4 AREAS. ST1444.2 +013500 SELECT SQ-FS3 ASSIGN TO ST1444.2 +013600 "XXXXX009" ST1444.2 +013700 ORGANIZATION SEQUENTIAL ST1444.2 +013800 ; ACCESS MODE IS SEQUENTIAL ST1444.2 +013900 RESERVE 6 AREAS. ST1444.2 +014000 SELECT SQ-FS4 ASSIGN TO ST1444.2 +014100 "XXXXX015" ST1444.2 +014200 ORGANIZATION IS SEQUENTIAL ST1444.2 +014300 ; ACCESS MODE IS SEQUENTIAL ST1444.2 +014400 RESERVE 4 AREAS. ST1444.2 +014500 SELECT ST-FS1 ASSIGN TO ST1444.2 +014600 "XXXXX027". ST1444.2 +014700 I-O-CONTROL. ST1444.2 +014800 SAME SORT AREA FOR SQ-FS1 ST-FS1, ST1444.2 +014900 MULTIPLE FILE TAPE CONTAINS SQ-FS1 POSITION 1 ST1444.2 +015000 SQ-FS3 POSITION 2. ST1444.2 +015100 DATA DIVISION. ST1444.2 +015200 FILE SECTION. ST1444.2 +015300 FD PRINT-FILE. ST1444.2 +015400 01 PRINT-REC PICTURE X(120). ST1444.2 +015500 01 DUMMY-RECORD PICTURE X(120). ST1444.2 +015600 FD SQ-FS1 ST1444.2 +015700 LABEL RECORDS STANDARD ST1444.2 +015800*C VALUE OF ST1444.2 +015900*C OCLABELID ST1444.2 +016000*C IS ST1444.2 +016100*C "OCDUMMY" ST1444.2 +016200*G SYSIN ST1444.2 +016300 BLOCK CONTAINS 1 RECORDS ST1444.2 +016400 RECORD CONTAINS 132 CHARACTERS ST1444.2 +016500 DATA RECORDS SQ-FS1R1-F-G-132, SQ-FS1R2-F-G-132. ST1444.2 +016600 01 SQ-FS1R1-F-G-132. ST1444.2 +016700 10 REC-PREAMBLE PIC X(120). ST1444.2 +016800 10 REST-OF-1. ST1444.2 +016900 20 KEY-1. ST1444.2 +017000 30 ALPHAN-KEY PIC X. ST1444.2 +017100 30 NUM-KEY PIC 999. ST1444.2 +017200 20 KEY-2. ST1444.2 +017300 30 ALPHAN-KEY PIC X. ST1444.2 +017400 30 NUM-KEY PIC 999. ST1444.2 +017500 20 KEY-3. ST1444.2 +017600 30 ALPHAN-KEY PIC X. ST1444.2 +017700 30 NUM-KEY PIC 999. ST1444.2 +017800 01 SQ-FS1R2-F-G-132. ST1444.2 +017900 02 FILLER PIC X(120). ST1444.2 +018000 02 GARBAGE PIC X(12). ST1444.2 +018100 FD SQ-FS2 ST1444.2 +018200 LABEL RECORD STANDARD ST1444.2 +018300*C VALUE OF ST1444.2 +018400*C OCLABELID ST1444.2 +018500*C IS ST1444.2 +018600*C "OCDUMMY" ST1444.2 +018700*G SYSIN ST1444.2 +018800 BLOCK CONTAINS 2 RECORDS ST1444.2 +018900 RECORD CONTAINS 132 CHARACTERS ST1444.2 +019000 DATA RECORD SQ-FS2R1-F-G-132. ST1444.2 +019100 01 SQ-FS2R1-F-G-132. ST1444.2 +019200 10 REC-PRE-2 PIC X(120). ST1444.2 +019300 10 REST-OF-2. ST1444.2 +019400 20 KEY-4. ST1444.2 +019500 30 ALPHAN-KEY PIC X. ST1444.2 +019600 30 NUM-KEY PIC 999. ST1444.2 +019700 20 KEY-5. ST1444.2 +019800 30 ALPHAN-KEY PIC X. ST1444.2 +019900 30 NUM-KEY PIC 999. ST1444.2 +020000 20 KEY-6. ST1444.2 +020100 30 ALPHAN-KEY PIC X. ST1444.2 +020200 30 NUM-KEY PIC 999. ST1444.2 +020300 FD SQ-FS3 ST1444.2 +020400 LABEL RECORDS STANDARD ST1444.2 +020500*C VALUE OF ST1444.2 +020600*C OCLABELID ST1444.2 +020700*C IS ST1444.2 +020800*C "OCDUMMY" ST1444.2 +020900*G SYSIN ST1444.2 +021000 BLOCK CONTAINS 1 RECORDS ST1444.2 +021100 RECORD CONTAINS 132 CHARACTERS ST1444.2 +021200 DATA RECORD SQ-FS3R1-F-G-132. ST1444.2 +021300 01 SQ-FS3R1-F-G-132. ST1444.2 +021400 10 REC-PRE-3 PIC X(120). ST1444.2 +021500 10 REST-OF-3. ST1444.2 +021600 20 KEY-7. ST1444.2 +021700 30 ALPHAN-KEY PIC X. ST1444.2 +021800 30 NUM-KEY PIC 999. ST1444.2 +021900 20 KEY-8. ST1444.2 +022000 30 ALPHAN-KEY PIC X. ST1444.2 +022100 30 NUM-KEY PIC 999. ST1444.2 +022200 20 KEY-9. ST1444.2 +022300 30 ALPHAN-KEY PIC X. ST1444.2 +022400 30 NUM-KEY PIC 999. ST1444.2 +022500 FD SQ-FS4 ST1444.2 +022600 LABEL RECORD IS STANDARD ST1444.2 +022700*C ; VALUE OF ST1444.2 +022800*C OCLABELID ST1444.2 +022900*C IS ST1444.2 +023000*C **** X-CARD UNDEFINED **** ST1444.2 +023100*G SYSIN ST1444.2 +023200 ; BLOCK CONTAINS 3 RECORDS ST1444.2 +023300 RECORD CONTAINS 132 CHARACTERS ST1444.2 +023400 DATA RECORD SQ-FS4R1-F-G-132. ST1444.2 +023500 01 SQ-FS4R1-F-G-132. ST1444.2 +023600 10 REC-PRE-4 PIC X(120). ST1444.2 +023700 10 REST-OF-4. ST1444.2 +023800 20 KEY-10. ST1444.2 +023900 30 ALPHAN-KEY PIC X. ST1444.2 +024000 30 NUM-KEY PIC 999. ST1444.2 +024100 20 KEY-11. ST1444.2 +024200 30 ALPHAN-KEY PIC X. ST1444.2 +024300 30 NUM-KEY PIC 999. ST1444.2 +024400 20 KEY-12. ST1444.2 +024500 30 ALPHAN-KEY PIC X. ST1444.2 +024600 30 NUM-KEY PIC 999. ST1444.2 +024700 SD ST-FS1 ST1444.2 +024800 RECORD CONTAINS 132 CHARACTERS ST1444.2 +024900 DATA RECORD IS ST-FS1R1-F-G-132. ST1444.2 +025000 01 ST-FS1R1-F-G-132. ST1444.2 +025100 02 FILLER PIC X(120). ST1444.2 +025200 02 NON-KEY-1. ST1444.2 +025300 03 A-KEY PIC X. ST1444.2 +025400 03 N-KEY PIC 999. ST1444.2 +025500 02 SORT-KEY. ST1444.2 +025600 03 A-KEY PIC X. ST1444.2 +025700 03 N-KEY PIC 999. ST1444.2 +025800 02 NON-KEY-2. ST1444.2 +025900 03 A-KEY PIC X. ST1444.2 +026000 03 N-KEY PIC 999. ST1444.2 +026100 WORKING-STORAGE SECTION. ST1444.2 +026200 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1444.2 +026300 77 WRK-DU-999-0001 PIC 999. ST1444.2 +026400 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1444.2 +026500 77 LAST-REC-NUM PIC 999 VALUE ZERO. ST1444.2 +026600 01 WRK-XN-0001 PIC X(51) VALUE ST1444.2 +026700 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ ". ST1444.2 +026800 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1444.2 +026900 02 CHAR PIC X OCCURS 51 TIMES. ST1444.2 +027000 01 WRK-XN-2 PIC X(51) VALUE ST1444.2 +027100 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ ". ST1444.2 +027200 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1444.2 +027300 02 ASCIIS PIC X OCCURS 51 TIMES. ST1444.2 +027400 01 WRK-XN-O020F-0001. ST1444.2 +027500 02 COMPU PIC X OCCURS 20 TIMES. ST1444.2 +027600 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1444.2 +027700 02 FILLER PIC X(20). ST1444.2 +027800 01 WRK-XN-O120F-1. ST1444.2 +027900 02 COLLS PIC X OCCURS 120 TIMES. ST1444.2 +028000 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1444.2 +028100 02 WRK-XN-0002 PIC X(20). ST1444.2 +028200 02 WRK-XN-0003 PIC X(20). ST1444.2 +028300 02 WRK-XN-0004 PIC X(20). ST1444.2 +028400 02 WRK-XN-0005 PIC X(20). ST1444.2 +028500 02 WRK-XN-0006 PIC X(20). ST1444.2 +028600 02 WRK-XN-0007 PIC X(20). ST1444.2 +028700 01 FILE-RECORD-INFORMATION-REC. ST1444.2 +028800 03 FILE-RECORD-INFO-SKELETON. ST1444.2 +028900 05 FILLER PICTURE X(48) VALUE ST1444.2 +029000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1444.2 +029100 05 FILLER PICTURE X(46) VALUE ST1444.2 +029200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1444.2 +029300 05 FILLER PICTURE X(26) VALUE ST1444.2 +029400 ",LFIL=000000,ORG= ,LBLR= ". ST1444.2 +029500 05 FILLER PICTURE X(37) VALUE ST1444.2 +029600 ",RECKEY= ". ST1444.2 +029700 05 FILLER PICTURE X(38) VALUE ST1444.2 +029800 ",ALTKEY1= ". ST1444.2 +029900 05 FILLER PICTURE X(38) VALUE ST1444.2 +030000 ",ALTKEY2= ". ST1444.2 +030100 05 FILLER PICTURE X(7) VALUE SPACE.ST1444.2 +030200 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1444.2 +030300 05 FILE-RECORD-INFO-P1-120. ST1444.2 +030400 07 FILLER PIC X(5). ST1444.2 +030500 07 XFILE-NAME PIC X(6). ST1444.2 +030600 07 FILLER PIC X(8). ST1444.2 +030700 07 XRECORD-NAME PIC X(6). ST1444.2 +030800 07 FILLER PIC X(1). ST1444.2 +030900 07 REELUNIT-NUMBER PIC 9(1). ST1444.2 +031000 07 FILLER PIC X(7). ST1444.2 +031100 07 XRECORD-NUMBER PIC 9(6). ST1444.2 +031200 07 FILLER PIC X(6). ST1444.2 +031300 07 UPDATE-NUMBER PIC 9(2). ST1444.2 +031400 07 FILLER PIC X(5). ST1444.2 +031500 07 ODO-NUMBER PIC 9(4). ST1444.2 +031600 07 FILLER PIC X(5). ST1444.2 +031700 07 XPROGRAM-NAME PIC X(5). ST1444.2 +031800 07 FILLER PIC X(7). ST1444.2 +031900 07 XRECORD-LENGTH PIC 9(6). ST1444.2 +032000 07 FILLER PIC X(7). ST1444.2 +032100 07 CHARS-OR-RECORDS PIC X(2). ST1444.2 +032200 07 FILLER PIC X(1). ST1444.2 +032300 07 XBLOCK-SIZE PIC 9(4). ST1444.2 +032400 07 FILLER PIC X(6). ST1444.2 +032500 07 RECORDS-IN-FILE PIC 9(6). ST1444.2 +032600 07 FILLER PIC X(5). ST1444.2 +032700 07 XFILE-ORGANIZATION PIC X(2). ST1444.2 +032800 07 FILLER PIC X(6). ST1444.2 +032900 07 XLABEL-TYPE PIC X(1). ST1444.2 +033000 05 FILE-RECORD-INFO-P121-240. ST1444.2 +033100 07 FILLER PIC X(8). ST1444.2 +033200 07 XRECORD-KEY PIC X(29). ST1444.2 +033300 07 FILLER PIC X(9). ST1444.2 +033400 07 ALTERNATE-KEY1 PIC X(29). ST1444.2 +033500 07 FILLER PIC X(9). ST1444.2 +033600 07 ALTERNATE-KEY2 PIC X(29). ST1444.2 +033700 07 FILLER PIC X(7). ST1444.2 +033800 01 TEST-RESULTS. ST1444.2 +033900 02 FILLER PIC X VALUE SPACE. ST1444.2 +034000 02 FEATURE PIC X(20) VALUE SPACE. ST1444.2 +034100 02 FILLER PIC X VALUE SPACE. ST1444.2 +034200 02 P-OR-F PIC X(5) VALUE SPACE. ST1444.2 +034300 02 FILLER PIC X VALUE SPACE. ST1444.2 +034400 02 PAR-NAME. ST1444.2 +034500 03 FILLER PIC X(19) VALUE SPACE. ST1444.2 +034600 03 PARDOT-X PIC X VALUE SPACE. ST1444.2 +034700 03 DOTVALUE PIC 99 VALUE ZERO. ST1444.2 +034800 02 FILLER PIC X(8) VALUE SPACE. ST1444.2 +034900 02 RE-MARK PIC X(61). ST1444.2 +035000 01 TEST-COMPUTED. ST1444.2 +035100 02 FILLER PIC X(30) VALUE SPACE. ST1444.2 +035200 02 FILLER PIC X(17) VALUE ST1444.2 +035300 " COMPUTED=". ST1444.2 +035400 02 COMPUTED-X. ST1444.2 +035500 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1444.2 +035600 03 COMPUTED-N REDEFINES COMPUTED-A ST1444.2 +035700 PIC -9(9).9(9). ST1444.2 +035800 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1444.2 +035900 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1444.2 +036000 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1444.2 +036100 03 CM-18V0 REDEFINES COMPUTED-A. ST1444.2 +036200 04 COMPUTED-18V0 PIC -9(18). ST1444.2 +036300 04 FILLER PIC X. ST1444.2 +036400 03 FILLER PIC X(50) VALUE SPACE. ST1444.2 +036500 01 TEST-CORRECT. ST1444.2 +036600 02 FILLER PIC X(30) VALUE SPACE. ST1444.2 +036700 02 FILLER PIC X(17) VALUE " CORRECT =". ST1444.2 +036800 02 CORRECT-X. ST1444.2 +036900 03 CORRECT-A PIC X(20) VALUE SPACE. ST1444.2 +037000 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1444.2 +037100 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1444.2 +037200 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1444.2 +037300 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1444.2 +037400 03 CR-18V0 REDEFINES CORRECT-A. ST1444.2 +037500 04 CORRECT-18V0 PIC -9(18). ST1444.2 +037600 04 FILLER PIC X. ST1444.2 +037700 03 FILLER PIC X(2) VALUE SPACE. ST1444.2 +037800 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1444.2 +037900 01 CCVS-C-1. ST1444.2 +038000 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1444.2 +038100- "SS PARAGRAPH-NAME ST1444.2 +038200- " REMARKS". ST1444.2 +038300 02 FILLER PIC X(20) VALUE SPACE. ST1444.2 +038400 01 CCVS-C-2. ST1444.2 +038500 02 FILLER PIC X VALUE SPACE. ST1444.2 +038600 02 FILLER PIC X(6) VALUE "TESTED". ST1444.2 +038700 02 FILLER PIC X(15) VALUE SPACE. ST1444.2 +038800 02 FILLER PIC X(4) VALUE "FAIL". ST1444.2 +038900 02 FILLER PIC X(94) VALUE SPACE. ST1444.2 +039000 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1444.2 +039100 01 REC-CT PIC 99 VALUE ZERO. ST1444.2 +039200 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1444.2 +039300 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1444.2 +039400 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1444.2 +039500 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1444.2 +039600 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1444.2 +039700 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1444.2 +039800 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1444.2 +039900 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1444.2 +040000 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1444.2 +040100 01 CCVS-H-1. ST1444.2 +040200 02 FILLER PIC X(39) VALUE SPACES. ST1444.2 +040300 02 FILLER PIC X(42) VALUE ST1444.2 +040400 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1444.2 +040500 02 FILLER PIC X(39) VALUE SPACES. ST1444.2 +040600 01 CCVS-H-2A. ST1444.2 +040700 02 FILLER PIC X(40) VALUE SPACE. ST1444.2 +040800 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1444.2 +040900 02 FILLER PIC XXXX VALUE ST1444.2 +041000 "4.2 ". ST1444.2 +041100 02 FILLER PIC X(28) VALUE ST1444.2 +041200 " COPY - NOT FOR DISTRIBUTION". ST1444.2 +041300 02 FILLER PIC X(41) VALUE SPACE. ST1444.2 +041400 ST1444.2 +041500 01 CCVS-H-2B. ST1444.2 +041600 02 FILLER PIC X(15) VALUE ST1444.2 +041700 "TEST RESULT OF ". ST1444.2 +041800 02 TEST-ID PIC X(9). ST1444.2 +041900 02 FILLER PIC X(4) VALUE ST1444.2 +042000 " IN ". ST1444.2 +042100 02 FILLER PIC X(12) VALUE ST1444.2 +042200 " HIGH ". ST1444.2 +042300 02 FILLER PIC X(22) VALUE ST1444.2 +042400 " LEVEL VALIDATION FOR ". ST1444.2 +042500 02 FILLER PIC X(58) VALUE ST1444.2 +042600 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1444.2 +042700 01 CCVS-H-3. ST1444.2 +042800 02 FILLER PIC X(34) VALUE ST1444.2 +042900 " FOR OFFICIAL USE ONLY ". ST1444.2 +043000 02 FILLER PIC X(58) VALUE ST1444.2 +043100 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1444.2 +043200 02 FILLER PIC X(28) VALUE ST1444.2 +043300 " COPYRIGHT 1985 ". ST1444.2 +043400 01 CCVS-E-1. ST1444.2 +043500 02 FILLER PIC X(52) VALUE SPACE. ST1444.2 +043600 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1444.2 +043700 02 ID-AGAIN PIC X(9). ST1444.2 +043800 02 FILLER PIC X(45) VALUE SPACES. ST1444.2 +043900 01 CCVS-E-2. ST1444.2 +044000 02 FILLER PIC X(31) VALUE SPACE. ST1444.2 +044100 02 FILLER PIC X(21) VALUE SPACE. ST1444.2 +044200 02 CCVS-E-2-2. ST1444.2 +044300 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1444.2 +044400 03 FILLER PIC X VALUE SPACE. ST1444.2 +044500 03 ENDER-DESC PIC X(44) VALUE ST1444.2 +044600 "ERRORS ENCOUNTERED". ST1444.2 +044700 01 CCVS-E-3. ST1444.2 +044800 02 FILLER PIC X(22) VALUE ST1444.2 +044900 " FOR OFFICIAL USE ONLY". ST1444.2 +045000 02 FILLER PIC X(12) VALUE SPACE. ST1444.2 +045100 02 FILLER PIC X(58) VALUE ST1444.2 +045200 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1444.2 +045300 02 FILLER PIC X(13) VALUE SPACE. ST1444.2 +045400 02 FILLER PIC X(15) VALUE ST1444.2 +045500 " COPYRIGHT 1985". ST1444.2 +045600 01 CCVS-E-4. ST1444.2 +045700 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1444.2 +045800 02 FILLER PIC X(4) VALUE " OF ". ST1444.2 +045900 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1444.2 +046000 02 FILLER PIC X(40) VALUE ST1444.2 +046100 " TESTS WERE EXECUTED SUCCESSFULLY". ST1444.2 +046200 01 XXINFO. ST1444.2 +046300 02 FILLER PIC X(19) VALUE ST1444.2 +046400 "*** INFORMATION ***". ST1444.2 +046500 02 INFO-TEXT. ST1444.2 +046600 04 FILLER PIC X(8) VALUE SPACE. ST1444.2 +046700 04 XXCOMPUTED PIC X(20). ST1444.2 +046800 04 FILLER PIC X(5) VALUE SPACE. ST1444.2 +046900 04 XXCORRECT PIC X(20). ST1444.2 +047000 02 INF-ANSI-REFERENCE PIC X(48). ST1444.2 +047100 01 HYPHEN-LINE. ST1444.2 +047200 02 FILLER PIC IS X VALUE IS SPACE. ST1444.2 +047300 02 FILLER PIC IS X(65) VALUE IS "************************ST1444.2 +047400- "*****************************************". ST1444.2 +047500 02 FILLER PIC IS X(54) VALUE IS "************************ST1444.2 +047600- "******************************". ST1444.2 +047700 01 CCVS-PGM-ID PIC X(9) VALUE ST1444.2 +047800 "ST144A". ST1444.2 +047900 PROCEDURE DIVISION. ST1444.2 +048000 DECLARATIVES. ST1444.2 +048100 SECT-ST214-DEC SECTION. ST1444.2 +048200 USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT. ST1444.2 +048300 SRT-WRITE-DEC. ST1444.2 +048400 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1444.2 +048500 MOVE "SRT-TEST-DEC" TO PAR-NAME. ST1444.2 +048600 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1444.2 +048700 STOP RUN. ST1444.2 +048800 END DECLARATIVES. ST1444.2 +048900 CCVS1 SECTION. ST1444.2 +049000 OPEN-FILES. ST1444.2 +049100 OPEN OUTPUT PRINT-FILE. ST1444.2 +049200 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1444.2 +049300 MOVE SPACE TO TEST-RESULTS. ST1444.2 +049400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1444.2 +049500 MOVE ZERO TO REC-SKL-SUB. ST1444.2 +049600 PERFORM CCVS-INIT-FILE 9 TIMES. ST1444.2 +049700 CCVS-INIT-FILE. ST1444.2 +049800 ADD 1 TO REC-SKL-SUB. ST1444.2 +049900 MOVE FILE-RECORD-INFO-SKELETON ST1444.2 +050000 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1444.2 +050100 CCVS-INIT-EXIT. ST1444.2 +050200 GO TO CCVS1-EXIT. ST1444.2 +050300 CLOSE-FILES. ST1444.2 +050400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1444.2 +050500 TERMINATE-CCVS. ST1444.2 +050600*S EXIT PROGRAM. ST1444.2 +050700*SERMINATE-CALL. ST1444.2 +050800 STOP RUN. ST1444.2 +050900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1444.2 +051000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1444.2 +051100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1444.2 +051200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1444.2 +051300 MOVE "****TEST DELETED****" TO RE-MARK. ST1444.2 +051400 PRINT-DETAIL. ST1444.2 +051500 IF REC-CT NOT EQUAL TO ZERO ST1444.2 +051600 MOVE "." TO PARDOT-X ST1444.2 +051700 MOVE REC-CT TO DOTVALUE. ST1444.2 +051800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1444.2 +051900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1444.2 +052000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1444.2 +052100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1444.2 +052200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1444.2 +052300 MOVE SPACE TO CORRECT-X. ST1444.2 +052400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1444.2 +052500 MOVE SPACE TO RE-MARK. ST1444.2 +052600 HEAD-ROUTINE. ST1444.2 +052700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +052800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +052900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1444.2 +053000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1444.2 +053100 COLUMN-NAMES-ROUTINE. ST1444.2 +053200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +053300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +053400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +053500 END-ROUTINE. ST1444.2 +053600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1444.2 +053700 END-RTN-EXIT. ST1444.2 +053800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +053900 END-ROUTINE-1. ST1444.2 +054000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1444.2 +054100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1444.2 +054200 ADD PASS-COUNTER TO ERROR-HOLD. ST1444.2 +054300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1444.2 +054400 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1444.2 +054500 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1444.2 +054600 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1444.2 +054700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1444.2 +054800 END-ROUTINE-12. ST1444.2 +054900 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1444.2 +055000 IF ERROR-COUNTER IS EQUAL TO ZERO ST1444.2 +055100 MOVE "NO " TO ERROR-TOTAL ST1444.2 +055200 ELSE ST1444.2 +055300 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1444.2 +055400 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1444.2 +055500 PERFORM WRITE-LINE. ST1444.2 +055600 END-ROUTINE-13. ST1444.2 +055700 IF DELETE-COUNTER IS EQUAL TO ZERO ST1444.2 +055800 MOVE "NO " TO ERROR-TOTAL ELSE ST1444.2 +055900 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1444.2 +056000 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1444.2 +056100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +056200 IF INSPECT-COUNTER EQUAL TO ZERO ST1444.2 +056300 MOVE "NO " TO ERROR-TOTAL ST1444.2 +056400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1444.2 +056500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1444.2 +056600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +056700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1444.2 +056800 WRITE-LINE. ST1444.2 +056900 ADD 1 TO RECORD-COUNT. ST1444.2 +057000 IF RECORD-COUNT GREATER 42 ST1444.2 +057100 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1444.2 +057200 MOVE SPACE TO DUMMY-RECORD ST1444.2 +057300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1444.2 +057400 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1444.2 +057500 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1444.2 +057600 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1444.2 +057700 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1444.2 +057800 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1444.2 +057900 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1444.2 +058000 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1444.2 +058100 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1444.2 +058200 MOVE ZERO TO RECORD-COUNT. ST1444.2 +058300 PERFORM WRT-LN. ST1444.2 +058400 WRT-LN. ST1444.2 +058500 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1444.2 +058600 MOVE SPACE TO DUMMY-RECORD. ST1444.2 +058700 BLANK-LINE-PRINT. ST1444.2 +058800 PERFORM WRT-LN. ST1444.2 +058900 FAIL-ROUTINE. ST1444.2 +059000 IF COMPUTED-X NOT EQUAL TO SPACE ST1444.2 +059100 GO TO FAIL-ROUTINE-WRITE. ST1444.2 +059200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1444.2 +059300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1444.2 +059400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1444.2 +059500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +059600 MOVE SPACES TO INF-ANSI-REFERENCE. ST1444.2 +059700 GO TO FAIL-ROUTINE-EX. ST1444.2 +059800 FAIL-ROUTINE-WRITE. ST1444.2 +059900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1444.2 +060000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1444.2 +060100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1444.2 +060200 MOVE SPACES TO COR-ANSI-REFERENCE. ST1444.2 +060300 FAIL-ROUTINE-EX. EXIT. ST1444.2 +060400 BAIL-OUT. ST1444.2 +060500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1444.2 +060600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1444.2 +060700 BAIL-OUT-WRITE. ST1444.2 +060800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1444.2 +060900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1444.2 +061000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1444.2 +061100 MOVE SPACES TO INF-ANSI-REFERENCE. ST1444.2 +061200 BAIL-OUT-EX. EXIT. ST1444.2 +061300 CCVS1-EXIT. ST1444.2 +061400 EXIT. ST1444.2 +061500 SECT-ST214-0001 SECTION. ST1444.2 +061600 BLD-INIT-001. ST1444.2 +061700 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1444.2 +061800 OPEN OUTPUT SQ-FS1. ST1444.2 +061900 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1444.2 +062000 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1444.2 +062100 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1444.2 +062200 MOVE 000132 TO XRECORD-LENGTH (1). ST1444.2 +062300 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1444.2 +062400 MOVE 0001 TO XBLOCK-SIZE (1). ST1444.2 +062500 MOVE 000051 TO RECORDS-IN-FILE (1). ST1444.2 +062600 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1444.2 +062700 MOVE "S" TO XLABEL-TYPE (1). ST1444.2 +062800 MOVE 000001 TO XRECORD-NUMBER (1). ST1444.2 +062900 MOVE SPACES TO WRK-XN-O120F-1. ST1444.2 +063000 BLD-TEST-001. ST1444.2 +063100 PERFORM BLD-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1444.2 +063200 FROM 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1444.2 +063300*X MOVE SPACES TO PRINT-REC. ST1444.2 +063400*X WRITE PRINT-REC. ST1444.2 +063500 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1444.2 +063600 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1444.2 +063700 ELSE ST1444.2 +063800 PERFORM PASS. ST1444.2 +063900 GO TO BLD-WRITE-001. ST1444.2 +064000 BLD-TEST-001-BUILD. ST1444.2 +064100 MOVE "JUNKSLOPJUNK" TO GARBAGE. ST1444.2 +064200 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1444.2 +064300 NUM-KEY OF KEY-3. ST1444.2 +064400 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1444.2 +064500 ADD 1 TO XRECORD-NUMBER (1). ST1444.2 +064600 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1444.2 +064700 ADD 1 TO WRK-DU-999-2. ST1444.2 +064800 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1444.2 +064900 ADD 1 TO WRK-DU-999-2. ST1444.2 +065000*X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1444.2 +065100*X WRITE PRINT-REC FROM REST-OF-1. ST1444.2 +065200*X MOVE SPACES TO PRINT-REC. ST1444.2 +065300 WRITE SQ-FS1R1-F-G-132. ST1444.2 +065400 BLD-DELETE-001. ST1444.2 +065500 PERFORM DE-LETE. ST1444.2 +065600 BLD-WRITE-001. ST1444.2 +065700 MOVE "BLD-TEST-001" TO PAR-NAME. ST1444.2 +065800 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1444.2 +065900 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1444.2 +066000 PERFORM PRINT-DETAIL. ST1444.2 +066100*X MOVE SPACES TO PRINT-REC. ST1444.2 +066200*X WRITE PRINT-REC. ST1444.2 +066300 CLOSE SQ-FS1 WITH NO REWIND. ST1444.2 +066400 BLD-INIT-002. ST1444.2 +066500 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1444.2 +066600 OPEN OUTPUT SQ-FS2. ST1444.2 +066700 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1444.2 +066800 MOVE 000001 TO XRECORD-NUMBER (1). ST1444.2 +066900 MOVE 0002 TO XBLOCK-SIZE (1). ST1444.2 +067000 BLD-TEST-002. ST1444.2 +067100 PERFORM BLD-TEST-002-BUILD VARYING WRK-DU-999-0001 FROM ST1444.2 +067200 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1444.2 +067300*X MOVE SPACES TO PRINT-REC. ST1444.2 +067400*X WRITE PRINT-REC. ST1444.2 +067500 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1444.2 +067600 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1444.2 +067700 ELSE ST1444.2 +067800 PERFORM PASS. ST1444.2 +067900 GO TO BLD-WRITE-002. ST1444.2 +068000 BLD-TEST-002-BUILD. ST1444.2 +068100 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1444.2 +068200 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1444.2 +068300 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1444.2 +068400 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1444.2 +068500 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1444.2 +068600 ADD 000001 TO XRECORD-NUMBER (1). ST1444.2 +068700*X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1444.2 +068800*X WRITE PRINT-REC FROM REST-OF-2. ST1444.2 +068900*X MOVE SPACES TO PRINT-REC. ST1444.2 +069000 WRITE SQ-FS2R1-F-G-132. ST1444.2 +069100 BLD-DELETE-002. ST1444.2 +069200 PERFORM DE-LETE. ST1444.2 +069300 BLD-WRITE-002. ST1444.2 +069400 MOVE "BLD-TEST-002" TO PAR-NAME. ST1444.2 +069500 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1444.2 +069600 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1444.2 +069700 PERFORM PRINT-DETAIL. ST1444.2 +069800*X MOVE SPACES TO PRINT-REC. ST1444.2 +069900*X WRITE PRINT-REC. ST1444.2 +070000 CLOSE SQ-FS2. ST1444.2 +070100 BLD-INIT-003. ST1444.2 +070200 MOVE "CREATE FILE SQ-FS3" TO FEATURE. ST1444.2 +070300 OPEN OUTPUT SQ-FS3. ST1444.2 +070400 MOVE "SQ-FS3" TO XFILE-NAME (1). ST1444.2 +070500 MOVE 000001 TO XRECORD-NUMBER (1). ST1444.2 +070600 MOVE 0001 TO XBLOCK-SIZE (1). ST1444.2 +070700 BLD-TEST-003. ST1444.2 +070800 PERFORM BLD-TEST-003-BUILD VARYING WRK-DU-999-0001 FROM ST1444.2 +070900 1 BY 1 UNTIL WRK-DU-999-0001 IS GREATER THAN 51. ST1444.2 +071000*X MOVE SPACES TO PRINT-REC. ST1444.2 +071100*X WRITE PRINT-REC. ST1444.2 +071200 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 52 ST1444.2 +071300 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1444.2 +071400 ELSE ST1444.2 +071500 PERFORM PASS. ST1444.2 +071600 GO TO BLD-WRITE-003. ST1444.2 +071700 BLD-TEST-003-BUILD. ST1444.2 +071800 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-7 ST1444.2 +071900 ALPHAN-KEY OF KEY-8 ALPHAN-KEY OF KEY-9. ST1444.2 +072000 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-7 NUM-KEY OF KEY-8 ST1444.2 +072100 NUM-KEY OF KEY-9. ST1444.2 +072200 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-3. ST1444.2 +072300 ADD 000001 TO XRECORD-NUMBER (1). ST1444.2 +072400*X WRITE PRINT-REC FROM SQ-FS3R1-F-G-132. ST1444.2 +072500*X WRITE PRINT-REC FROM REST-OF-3. ST1444.2 +072600*X MOVE SPACES TO PRINT-REC. ST1444.2 +072700 WRITE SQ-FS3R1-F-G-132. ST1444.2 +072800 BLD-DELETE-003. ST1444.2 +072900 PERFORM DE-LETE. ST1444.2 +073000 BLD-WRITE-003. ST1444.2 +073100 MOVE "BLD-TEST-003" TO PAR-NAME. ST1444.2 +073200 MOVE "3RD FILE CREATED" TO COMPUTED-A. ST1444.2 +073300 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1444.2 +073400 PERFORM PRINT-DETAIL. ST1444.2 +073500*X MOVE SPACES TO PRINT-REC. ST1444.2 +073600*X WRITE PRINT-REC. ST1444.2 +073700 CLOSE SQ-FS3. ST1444.2 +073800 MRG-INIT-001. ST1444.2 +073900 MERGE ST-FS1 ST1444.2 +074000 ON DESCENDING KEY A-KEY OF SORT-KEY ST1444.2 +074100 ASCENDING N-KEY OF NON-KEY-2 ST1444.2 +074200 USING SQ-FS2, SQ-FS3 ST1444.2 +074300 OUTPUT PROCEDURE IS SECT-ST214-0002. ST1444.2 +074400 SRT-TEST-003. ST1444.2 +074500 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +074600 OPEN INPUT SQ-FS4. ST1444.2 +074700 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +074800 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +074900*X MOVE SPACES TO PRINT-REC. ST1444.2 +075000*X WRITE PRINT-REC. ST1444.2 +075100 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1444.2 +075200 PERFORM FAIL GO TO SRT-FAIL-003 ST1444.2 +075300 ELSE ST1444.2 +075400 PERFORM PASS. ST1444.2 +075500 GO TO SRT-WRITE-003. ST1444.2 +075600 SRT-DELETE-003. ST1444.2 +075700 PERFORM DE-LETE. ST1444.2 +075800 GO TO SRT-WRITE-003. ST1444.2 +075900 SRT-FAIL-003. ST1444.2 +076000 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +076100 MOVE WRK-XN-0002 TO CORRECT-A. ST1444.2 +076200 SRT-WRITE-003. ST1444.2 +076300 MOVE "MRG-TEST-003" TO PAR-NAME. ST1444.2 +076400 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +076500 PERFORM PRINT-DETAIL. ST1444.2 +076600*X MOVE SPACES TO PRINT-REC. ST1444.2 +076700*X WRITE PRINT-REC. ST1444.2 +076800 SRT-INIT-004. ST1444.2 +076900 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +077000 SRT-TEST-004. ST1444.2 +077100 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +077200 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +077300*X MOVE SPACES TO PRINT-REC. ST1444.2 +077400*X WRITE PRINT-REC. ST1444.2 +077500 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1444.2 +077600 PERFORM FAIL GO TO SRT-FAIL-004 ST1444.2 +077700 ELSE ST1444.2 +077800 PERFORM PASS. ST1444.2 +077900 GO TO SRT-WRITE-004. ST1444.2 +078000 SRT-DELETE-004. ST1444.2 +078100 PERFORM DE-LETE. ST1444.2 +078200 GO TO SRT-WRITE-004. ST1444.2 +078300 SRT-FAIL-004. ST1444.2 +078400 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +078500 MOVE WRK-XN-0003 TO CORRECT-A. ST1444.2 +078600 SRT-WRITE-004. ST1444.2 +078700 MOVE "MRG-TEST-004" TO PAR-NAME. ST1444.2 +078800 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +078900 PERFORM PRINT-DETAIL. ST1444.2 +079000*X MOVE SPACES TO PRINT-REC. ST1444.2 +079100*X WRITE PRINT-REC. ST1444.2 +079200 SRT-INIT-005. ST1444.2 +079300 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +079400 SRT-TEST-005. ST1444.2 +079500 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +079600 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +079700*X MOVE SPACES TO PRINT-REC. ST1444.2 +079800*X WRITE PRINT-REC. ST1444.2 +079900 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1444.2 +080000 PERFORM FAIL GO TO SRT-FAIL-005 ST1444.2 +080100 ELSE ST1444.2 +080200 PERFORM PASS. ST1444.2 +080300 GO TO SRT-WRITE-005. ST1444.2 +080400 SRT-DELETE-005. ST1444.2 +080500 PERFORM DE-LETE. ST1444.2 +080600 GO TO SRT-WRITE-005. ST1444.2 +080700 SRT-FAIL-005. ST1444.2 +080800 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +080900 MOVE WRK-XN-0004 TO CORRECT-A. ST1444.2 +081000 SRT-WRITE-005. ST1444.2 +081100 MOVE "MRG-TEST-005" TO PAR-NAME. ST1444.2 +081200 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +081300 PERFORM PRINT-DETAIL. ST1444.2 +081400*X MOVE SPACES TO PRINT-REC. ST1444.2 +081500*X WRITE PRINT-REC. ST1444.2 +081600 SRT-INIT-006. ST1444.2 +081700 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +081800 SRT-TEST-006. ST1444.2 +081900 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +082000 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +082100*X MOVE SPACES TO PRINT-REC. ST1444.2 +082200*X WRITE PRINT-REC. ST1444.2 +082300 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1444.2 +082400 PERFORM FAIL GO TO SRT-FAIL-006 ST1444.2 +082500 ELSE ST1444.2 +082600 PERFORM PASS. ST1444.2 +082700 GO TO SRT-WRITE-006. ST1444.2 +082800 SRT-DELETE-006. ST1444.2 +082900 PERFORM DE-LETE. ST1444.2 +083000 GO TO SRT-WRITE-006. ST1444.2 +083100 SRT-FAIL-006. ST1444.2 +083200 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +083300 MOVE WRK-XN-0005 TO CORRECT-A. ST1444.2 +083400 SRT-WRITE-006. ST1444.2 +083500 MOVE "MRG-TEST-006" TO PAR-NAME. ST1444.2 +083600 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +083700 PERFORM PRINT-DETAIL. ST1444.2 +083800*X MOVE SPACES TO PRINT-REC. ST1444.2 +083900*X WRITE PRINT-REC. ST1444.2 +084000 SRT-INIT-007. ST1444.2 +084100 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +084200 SRT-TEST-007. ST1444.2 +084300 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +084400 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1444.2 +084500*X MOVE SPACES TO PRINT-REC. ST1444.2 +084600*X WRITE PRINT-REC. ST1444.2 +084700 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1444.2 +084800 PERFORM FAIL GO TO SRT-FAIL-007 ST1444.2 +084900 ELSE ST1444.2 +085000 PERFORM PASS. ST1444.2 +085100 GO TO SRT-WRITE-007. ST1444.2 +085200 SRT-DELETE-007. ST1444.2 +085300 PERFORM DE-LETE. ST1444.2 +085400 GO TO SRT-WRITE-007. ST1444.2 +085500 SRT-FAIL-007. ST1444.2 +085600 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +085700 MOVE WRK-XN-0006 TO CORRECT-A. ST1444.2 +085800 SRT-WRITE-007. ST1444.2 +085900 MOVE "MRG-TEST-007" TO PAR-NAME. ST1444.2 +086000 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +086100 PERFORM PRINT-DETAIL. ST1444.2 +086200*X MOVE SPACES TO PRINT-REC. ST1444.2 +086300*X WRITE PRINT-REC. ST1444.2 +086400 SRT-INIT-008. ST1444.2 +086500 MOVE SPACES TO WRK-XN-X-0001. ST1444.2 +086600 SRT-TEST-008. ST1444.2 +086700 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1444.2 +086800 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1444.2 +086900*X MOVE SPACES TO PRINT-REC. ST1444.2 +087000*X WRITE PRINT-REC. ST1444.2 +087100 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1444.2 +087200 PERFORM FAIL GO TO SRT-FAIL-008 ST1444.2 +087300 ELSE ST1444.2 +087400 PERFORM PASS. ST1444.2 +087500 GO TO SRT-WRITE-008. ST1444.2 +087600 SRT-DELETE-008. ST1444.2 +087700 PERFORM DE-LETE. ST1444.2 +087800 GO TO SRT-WRITE-008. ST1444.2 +087900 SRT-FAIL-008. ST1444.2 +088000 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1444.2 +088100 MOVE WRK-XN-0007 TO CORRECT-A. ST1444.2 +088200 SRT-WRITE-008. ST1444.2 +088300 MOVE "MRG-TEST-008" TO PAR-NAME. ST1444.2 +088400 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1444.2 +088500 PERFORM PRINT-DETAIL. ST1444.2 +088600 MOVE NUM-KEY OF KEY-11 TO LAST-REC-NUM. ST1444.2 +088700 SRT-TEST-009. ST1444.2 +088800 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1444.2 +088900 GO TO SRT-FAIL-009. ST1444.2 +089000 READ SQ-FS4 AT END PERFORM PASS ST1444.2 +089100 GO TO SRT-WRITE-009. ST1444.2 +089200 GO TO SRT-FAIL-009. ST1444.2 +089300 SRT-DELETE-009. ST1444.2 +089400 PERFORM DE-LETE. ST1444.2 +089500 GO TO SRT-WRITE-009. ST1444.2 +089600 SRT-FAIL-009. ST1444.2 +089700 MOVE "EOF NOT FOUND" TO RE-MARK. ST1444.2 +089800 PERFORM FAIL . ST1444.2 +089900 SRT-WRITE-009. ST1444.2 +090000 MOVE "EOF CHECK SQ-FS4" TO FEATURE. ST1444.2 +090100 MOVE "MRG-TEST-009" TO PAR-NAME. ST1444.2 +090200 PERFORM PRINT-DETAIL. ST1444.2 +090300 SRT-TEST-010. ST1444.2 +090400 IF LAST-REC-NUM IS NOT EQUAL TO 102 ST1444.2 +090500 PERFORM FAIL GO TO SRT-FAIL-010 ST1444.2 +090600 ELSE ST1444.2 +090700 PERFORM PASS. ST1444.2 +090800 GO TO SRT-WRITE-010. ST1444.2 +090900 SRT-DELETE-010. ST1444.2 +091000 PERFORM DE-LETE. ST1444.2 +091100 GO TO SRT-WRITE-010. ST1444.2 +091200 SRT-FAIL-010. ST1444.2 +091300 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1444.2 +091400 MOVE 102 TO CR-18V0. ST1444.2 +091500 SRT-WRITE-010. ST1444.2 +091600 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1444.2 +091700 MOVE "MRG-TEST-010" TO PAR-NAME. ST1444.2 +091800 PERFORM PRINT-DETAIL. ST1444.2 +091900 CLOSE SQ-FS4. ST1444.2 +092000 GO TO CCVS-999999. ST1444.2 +092100 READ-SQ-FS1 SECTION. ST1444.2 +092200 RD-1. ST1444.2 +092300 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1444.2 +092400 GO TO R1-EXIT. ST1444.2 +092500 READ SQ-FS4 AT END GO TO PREMATURE-EOF. ST1444.2 +092600*X WRITE PRINT-REC FROM SQ-FS4R1-F-G-132. ST1444.2 +092700*X WRITE PRINT-REC FROM REST-OF-4. ST1444.2 +092800*X MOVE SPACES TO PRINT-REC. ST1444.2 +092900 MOVE ALPHAN-KEY OF KEY-12 TO COMPU (WRK-DU-999-0001). ST1444.2 +093000 GO TO R1-EXIT. ST1444.2 +093100 PREMATURE-EOF. ST1444.2 +093200 MOVE 1 TO WRK-DU-9-0001. ST1444.2 +093300 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1444.2 +093400 R1-EXIT. ST1444.2 +093500 EXIT. ST1444.2 +093600 SECT-ST214-0002 SECTION. ST1444.2 +093700 SORT-OUTPUT-PROC. ST1444.2 +093800 OPEN OUTPUT SQ-FS4. ST1444.2 +093900 RETURN-THE-OLD-RECORDS. ST1444.2 +094000 RETURN ST-FS1 RECORD INTO SQ-FS4R1-F-G-132 ST1444.2 +094100 AT END GO TO CLOSE-AFTER-SORT. ST1444.2 +094200*X WRITE PRINT-REC FROM SQ-FS4R1-F-G-132. ST1444.2 +094300*X WRITE PRINT-REC FROM REST-OF-4. ST1444.2 +094400*X MOVE SPACES TO PRINT-REC. ST1444.2 +094500 WRITE SQ-FS4R1-F-G-132. ST1444.2 +094600 GO TO RETURN-THE-OLD-RECORDS. ST1444.2 +094700 CLOSE-AFTER-SORT. ST1444.2 +094800 CLOSE SQ-FS4. ST1444.2 +094900 CCVS-EXIT SECTION. ST1444.2 +095000 CCVS-999999. ST1444.2 +095100 GO TO CLOSE-FILES. ST1444.2 diff --git a/tests/cobol85/ST/ST146A.CBL b/tests/cobol85/ST/ST146A.CBL new file mode 100755 index 00000000..e54498e4 --- /dev/null +++ b/tests/cobol85/ST/ST146A.CBL @@ -0,0 +1,688 @@ +000100 IDENTIFICATION DIVISION. ST1464.2 +000200 PROGRAM-ID. ST1464.2 +000300 ST146A. ST1464.2 +000400**************************************************************** ST1464.2 +000500* * ST1464.2 +000600* VALIDATION FOR:- * ST1464.2 +000700* * ST1464.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1464.2 +000900* * ST1464.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1464.2 +001100* * ST1464.2 +001200**************************************************************** ST1464.2 +001300* * ST1464.2 +001400* X-CARDS USED BY THIS PROGRAM ARE :- * ST1464.2 +001500* * ST1464.2 +001600* X-55 - SYSTEM PRINTER NAME. * ST1464.2 +001700* X-82 - SOURCE COMPUTER NAME. * ST1464.2 +001800* X-83 - OBJECT COMPUTER NAME. * ST1464.2 +001900* * ST1464.2 +002000**************************************************************** ST1464.2 +002100* ST1464.2 +002200* ST146A TESTS OPERATIONS INVOLVING FORMAT 2 OCCURS CLAUSES, ST1464.2 +002300* I.E. ...OCCURS INTEGER-1 TO INTEGER-2 TIMES DEPENDING ON ST1464.2 +002400* DATA-NAME-1 .... ST1464.2 +002500* X3.23-1976, PAGE III-4, 2.1.4(3) STATES, IN PART, THAT ST1464.2 +002600* INTEGER-2 REPRESENTS THE MAXIMUM NUMBER OF OCCURRENCES AND ST1464.2 +002700* THAT ONLY THE NUMBER OF OCCURRENCES, AND NOT THE ITEM LENGTH,ST1464.2 +002800* IS VARIABLE. WHENEVER THE PARENT GROUP ITEM IS REFERENCED, ST1464.2 +002900* ONLY THE PORTION OF THE TABLE SPECIFIED BY THE CURRENT VALUE ST1464.2 +003000* OF DATA-NAME-1 WILL BE USED IN THE OPERATION. ST1464.2 +003100* ST1464.2 +003200* THE SORT VERB IS EXERCIZED BUT NOT CHECKED FOR ITS ST1464.2 +003300* CAPABILITY TO MEANINGFULLY SORT A FILE. INSTEAD, THE ST1464.2 +003400* OBJECT OF ST146A IS TO CHECK THE BEHAVIOR OF VARIABLE ST1464.2 +003500* LENGTH TABLES BEING HANDLED IN THE IMPLICIT MOVES ST1464.2 +003600* RESULTING FROM ST1464.2 +003700* RELEASE ... FROM ... ST1464.2 +003800* AND ST1464.2 +003900* RETURN ... INTO ... ST1464.2 +004000* STATEMENTS. ST1464.2 +004100* ST1464.2 +004200* ST1464.2 +004300 ENVIRONMENT DIVISION. ST1464.2 +004400 CONFIGURATION SECTION. ST1464.2 +004500 SOURCE-COMPUTER. ST1464.2 +004600 Linux. ST1464.2 +004700 OBJECT-COMPUTER. ST1464.2 +004800 Linux. ST1464.2 +004900 INPUT-OUTPUT SECTION. ST1464.2 +005000 FILE-CONTROL. ST1464.2 +005100 SELECT PRINT-FILE ASSIGN TO ST1464.2 +005200 "report.log". ST1464.2 +005300 SELECT SQ-FS1 ASSIGN TO ST1464.2 +005400 "XXXXX014". ST1464.2 +005500 SELECT SQ-FS2 ASSIGN TO ST1464.2 +005600 "XXXXX015". ST1464.2 +005700 SELECT ST-FR1 ASSIGN TO ST1464.2 +005800 "XXXXX027". ST1464.2 +005900 DATA DIVISION. ST1464.2 +006000 FILE SECTION. ST1464.2 +006100 FD PRINT-FILE. ST1464.2 +006200 01 PRINT-REC PICTURE X(120). ST1464.2 +006300 01 DUMMY-RECORD PICTURE X(120). ST1464.2 +006400 FD SQ-FS1 ST1464.2 +006500*C VALUE OF ST1464.2 +006600*C OCLABELID ST1464.2 +006700*C IS ST1464.2 +006800*C "OCDUMMY" ST1464.2 +006900*G SYSIN ST1464.2 +007000 LABEL RECORD IS STANDARD. ST1464.2 +007100 01 SQ-FS1R1-F-G-140. ST1464.2 +007200 02 FS1R1-XN-120 PIC X(120). ST1464.2 +007300 02 FS1R1-XN-20 PIC X(20). ST1464.2 +007400 FD SQ-FS2 ST1464.2 +007500*C VALUE OF ST1464.2 +007600*C OCLABELID ST1464.2 +007700*C IS ST1464.2 +007800*C "OCDUMMY" ST1464.2 +007900*G SYSIN ST1464.2 +008000 LABEL RECORD IS STANDARD. ST1464.2 +008100 01 SQ-FS2R1-F-G-140. ST1464.2 +008200 02 FS2R1-XN-120 PIC X(120). ST1464.2 +008300 02 FS2R1-XN-20 PIC X(20). ST1464.2 +008400 SD ST-FR1. ST1464.2 +008500 01 ST-FR1R1-F-G-140. ST1464.2 +008600 02 FILLER PIC X(34). ST1464.2 +008700 02 SORT-KEY-FIELD-XN-00006 PIC X(6). ST1464.2 +008800 02 FILLER PIC X(100). ST1464.2 +008900 WORKING-STORAGE SECTION. ST1464.2 +009000 01 ODO-RECORD. ST1464.2 +009100 02 FILLER PIC X(5). ST1464.2 +009200 02 SO-FILE-NAME PIC X(6). ST1464.2 +009300 02 FILLER PIC X(23). ST1464.2 +009400 02 SO-RECNO PIC X(6). ST1464.2 +009500 02 FILLER PIC X(80). ST1464.2 +009600 02 GRP-ODO. ST1464.2 +009700 03 DOI-DU-01V00 PIC 9. ST1464.2 +009800 03 ODO-XN-00009 PIC X(9). ST1464.2 +009900 03 ODO-GRP-00009. ST1464.2 +010000 04 ODO-XN-00001-O009D OCCURS 1 TO 9 TIMES DEPENDING ON ST1464.2 +010100 DOI-DU-01V00 ASCENDING KEY ODO-XN-00001-O009D ST1464.2 +010200 INDEXED BY ODO-IX PIC X. ST1464.2 +010300 01 STATIC-VALUE. ST1464.2 +010400 02 FILLER PIC 9 VALUE 9. ST1464.2 +010500 02 FILLER PIC X(18) VALUE " ACTIVE: 123456789". ST1464.2 +010600 01 WRK-GRP-00019. ST1464.2 +010700 02 WRK-DU-01V00 PIC 9. ST1464.2 +010800 02 WRK-XN-00009-1 PIC X(9). ST1464.2 +010900 02 WRK-XN-00009-2 PIC X(9). ST1464.2 +011000 01 WRK-GRP-00009. ST1464.2 +011100 02 ODO-XN-00003 PIC X(3). ST1464.2 +011200 02 ODO-XN-00006 PIC X(6). ST1464.2 +011300 01 WRK-GRP-0009A REDEFINES WRK-GRP-00009. ST1464.2 +011400 02 ODO-XN-00005 PIC X(5). ST1464.2 +011500 02 ODO-XN-00004 PIC X(4). ST1464.2 +011600 01 WRK-DU-05V00 PIC 9(5). ST1464.2 +011700 01 WRK-XN-00020 PIC X(20). ST1464.2 +011800 01 WRK-XN-00010 PIC X(10). ST1464.2 +011900 01 FILE-RECORD-INFORMATION-REC. ST1464.2 +012000 03 FILE-RECORD-INFO-SKELETON. ST1464.2 +012100 05 FILLER PICTURE X(48) VALUE ST1464.2 +012200 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1464.2 +012300 05 FILLER PICTURE X(46) VALUE ST1464.2 +012400 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1464.2 +012500 05 FILLER PICTURE X(26) VALUE ST1464.2 +012600 ",LFIL=000000,ORG= ,LBLR= ". ST1464.2 +012700 05 FILLER PICTURE X(37) VALUE ST1464.2 +012800 ",RECKEY= ". ST1464.2 +012900 05 FILLER PICTURE X(38) VALUE ST1464.2 +013000 ",ALTKEY1= ". ST1464.2 +013100 05 FILLER PICTURE X(38) VALUE ST1464.2 +013200 ",ALTKEY2= ". ST1464.2 +013300 05 FILLER PICTURE X(7) VALUE SPACE.ST1464.2 +013400 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1464.2 +013500 05 FILE-RECORD-INFO-P1-120. ST1464.2 +013600 07 FILLER PIC X(5). ST1464.2 +013700 07 XFILE-NAME PIC X(6). ST1464.2 +013800 07 FILLER PIC X(8). ST1464.2 +013900 07 XRECORD-NAME PIC X(6). ST1464.2 +014000 07 FILLER PIC X(1). ST1464.2 +014100 07 REELUNIT-NUMBER PIC 9(1). ST1464.2 +014200 07 FILLER PIC X(7). ST1464.2 +014300 07 XRECORD-NUMBER PIC 9(6). ST1464.2 +014400 07 FILLER PIC X(6). ST1464.2 +014500 07 UPDATE-NUMBER PIC 9(2). ST1464.2 +014600 07 FILLER PIC X(5). ST1464.2 +014700 07 ODO-NUMBER PIC 9(4). ST1464.2 +014800 07 FILLER PIC X(5). ST1464.2 +014900 07 XPROGRAM-NAME PIC X(5). ST1464.2 +015000 07 FILLER PIC X(7). ST1464.2 +015100 07 XRECORD-LENGTH PIC 9(6). ST1464.2 +015200 07 FILLER PIC X(7). ST1464.2 +015300 07 CHARS-OR-RECORDS PIC X(2). ST1464.2 +015400 07 FILLER PIC X(1). ST1464.2 +015500 07 XBLOCK-SIZE PIC 9(4). ST1464.2 +015600 07 FILLER PIC X(6). ST1464.2 +015700 07 RECORDS-IN-FILE PIC 9(6). ST1464.2 +015800 07 FILLER PIC X(5). ST1464.2 +015900 07 XFILE-ORGANIZATION PIC X(2). ST1464.2 +016000 07 FILLER PIC X(6). ST1464.2 +016100 07 XLABEL-TYPE PIC X(1). ST1464.2 +016200 05 FILE-RECORD-INFO-P121-240. ST1464.2 +016300 07 FILLER PIC X(8). ST1464.2 +016400 07 XRECORD-KEY PIC X(29). ST1464.2 +016500 07 FILLER PIC X(9). ST1464.2 +016600 07 ALTERNATE-KEY1 PIC X(29). ST1464.2 +016700 07 FILLER PIC X(9). ST1464.2 +016800 07 ALTERNATE-KEY2 PIC X(29). ST1464.2 +016900 07 FILLER PIC X(7). ST1464.2 +017000 01 TEST-RESULTS. ST1464.2 +017100 02 FILLER PIC X VALUE SPACE. ST1464.2 +017200 02 FEATURE PIC X(20) VALUE SPACE. ST1464.2 +017300 02 FILLER PIC X VALUE SPACE. ST1464.2 +017400 02 P-OR-F PIC X(5) VALUE SPACE. ST1464.2 +017500 02 FILLER PIC X VALUE SPACE. ST1464.2 +017600 02 PAR-NAME. ST1464.2 +017700 03 FILLER PIC X(19) VALUE SPACE. ST1464.2 +017800 03 PARDOT-X PIC X VALUE SPACE. ST1464.2 +017900 03 DOTVALUE PIC 99 VALUE ZERO. ST1464.2 +018000 02 FILLER PIC X(8) VALUE SPACE. ST1464.2 +018100 02 RE-MARK PIC X(61). ST1464.2 +018200 01 TEST-COMPUTED. ST1464.2 +018300 02 FILLER PIC X(30) VALUE SPACE. ST1464.2 +018400 02 FILLER PIC X(17) VALUE ST1464.2 +018500 " COMPUTED=". ST1464.2 +018600 02 COMPUTED-X. ST1464.2 +018700 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1464.2 +018800 03 COMPUTED-N REDEFINES COMPUTED-A ST1464.2 +018900 PIC -9(9).9(9). ST1464.2 +019000 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1464.2 +019100 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1464.2 +019200 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1464.2 +019300 03 CM-18V0 REDEFINES COMPUTED-A. ST1464.2 +019400 04 COMPUTED-18V0 PIC -9(18). ST1464.2 +019500 04 FILLER PIC X. ST1464.2 +019600 03 FILLER PIC X(50) VALUE SPACE. ST1464.2 +019700 01 TEST-CORRECT. ST1464.2 +019800 02 FILLER PIC X(30) VALUE SPACE. ST1464.2 +019900 02 FILLER PIC X(17) VALUE " CORRECT =". ST1464.2 +020000 02 CORRECT-X. ST1464.2 +020100 03 CORRECT-A PIC X(20) VALUE SPACE. ST1464.2 +020200 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1464.2 +020300 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1464.2 +020400 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1464.2 +020500 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1464.2 +020600 03 CR-18V0 REDEFINES CORRECT-A. ST1464.2 +020700 04 CORRECT-18V0 PIC -9(18). ST1464.2 +020800 04 FILLER PIC X. ST1464.2 +020900 03 FILLER PIC X(2) VALUE SPACE. ST1464.2 +021000 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1464.2 +021100 01 CCVS-C-1. ST1464.2 +021200 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1464.2 +021300- "SS PARAGRAPH-NAME ST1464.2 +021400- " REMARKS". ST1464.2 +021500 02 FILLER PIC X(20) VALUE SPACE. ST1464.2 +021600 01 CCVS-C-2. ST1464.2 +021700 02 FILLER PIC X VALUE SPACE. ST1464.2 +021800 02 FILLER PIC X(6) VALUE "TESTED". ST1464.2 +021900 02 FILLER PIC X(15) VALUE SPACE. ST1464.2 +022000 02 FILLER PIC X(4) VALUE "FAIL". ST1464.2 +022100 02 FILLER PIC X(94) VALUE SPACE. ST1464.2 +022200 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1464.2 +022300 01 REC-CT PIC 99 VALUE ZERO. ST1464.2 +022400 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1464.2 +022500 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1464.2 +022600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1464.2 +022700 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1464.2 +022800 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1464.2 +022900 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1464.2 +023000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1464.2 +023100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1464.2 +023200 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1464.2 +023300 01 CCVS-H-1. ST1464.2 +023400 02 FILLER PIC X(39) VALUE SPACES. ST1464.2 +023500 02 FILLER PIC X(42) VALUE ST1464.2 +023600 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1464.2 +023700 02 FILLER PIC X(39) VALUE SPACES. ST1464.2 +023800 01 CCVS-H-2A. ST1464.2 +023900 02 FILLER PIC X(40) VALUE SPACE. ST1464.2 +024000 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1464.2 +024100 02 FILLER PIC XXXX VALUE ST1464.2 +024200 "4.2 ". ST1464.2 +024300 02 FILLER PIC X(28) VALUE ST1464.2 +024400 " COPY - NOT FOR DISTRIBUTION". ST1464.2 +024500 02 FILLER PIC X(41) VALUE SPACE. ST1464.2 +024600 ST1464.2 +024700 01 CCVS-H-2B. ST1464.2 +024800 02 FILLER PIC X(15) VALUE ST1464.2 +024900 "TEST RESULT OF ". ST1464.2 +025000 02 TEST-ID PIC X(9). ST1464.2 +025100 02 FILLER PIC X(4) VALUE ST1464.2 +025200 " IN ". ST1464.2 +025300 02 FILLER PIC X(12) VALUE ST1464.2 +025400 " HIGH ". ST1464.2 +025500 02 FILLER PIC X(22) VALUE ST1464.2 +025600 " LEVEL VALIDATION FOR ". ST1464.2 +025700 02 FILLER PIC X(58) VALUE ST1464.2 +025800 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1464.2 +025900 01 CCVS-H-3. ST1464.2 +026000 02 FILLER PIC X(34) VALUE ST1464.2 +026100 " FOR OFFICIAL USE ONLY ". ST1464.2 +026200 02 FILLER PIC X(58) VALUE ST1464.2 +026300 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1464.2 +026400 02 FILLER PIC X(28) VALUE ST1464.2 +026500 " COPYRIGHT 1985 ". ST1464.2 +026600 01 CCVS-E-1. ST1464.2 +026700 02 FILLER PIC X(52) VALUE SPACE. ST1464.2 +026800 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1464.2 +026900 02 ID-AGAIN PIC X(9). ST1464.2 +027000 02 FILLER PIC X(45) VALUE SPACES. ST1464.2 +027100 01 CCVS-E-2. ST1464.2 +027200 02 FILLER PIC X(31) VALUE SPACE. ST1464.2 +027300 02 FILLER PIC X(21) VALUE SPACE. ST1464.2 +027400 02 CCVS-E-2-2. ST1464.2 +027500 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1464.2 +027600 03 FILLER PIC X VALUE SPACE. ST1464.2 +027700 03 ENDER-DESC PIC X(44) VALUE ST1464.2 +027800 "ERRORS ENCOUNTERED". ST1464.2 +027900 01 CCVS-E-3. ST1464.2 +028000 02 FILLER PIC X(22) VALUE ST1464.2 +028100 " FOR OFFICIAL USE ONLY". ST1464.2 +028200 02 FILLER PIC X(12) VALUE SPACE. ST1464.2 +028300 02 FILLER PIC X(58) VALUE ST1464.2 +028400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1464.2 +028500 02 FILLER PIC X(13) VALUE SPACE. ST1464.2 +028600 02 FILLER PIC X(15) VALUE ST1464.2 +028700 " COPYRIGHT 1985". ST1464.2 +028800 01 CCVS-E-4. ST1464.2 +028900 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1464.2 +029000 02 FILLER PIC X(4) VALUE " OF ". ST1464.2 +029100 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1464.2 +029200 02 FILLER PIC X(40) VALUE ST1464.2 +029300 " TESTS WERE EXECUTED SUCCESSFULLY". ST1464.2 +029400 01 XXINFO. ST1464.2 +029500 02 FILLER PIC X(19) VALUE ST1464.2 +029600 "*** INFORMATION ***". ST1464.2 +029700 02 INFO-TEXT. ST1464.2 +029800 04 FILLER PIC X(8) VALUE SPACE. ST1464.2 +029900 04 XXCOMPUTED PIC X(20). ST1464.2 +030000 04 FILLER PIC X(5) VALUE SPACE. ST1464.2 +030100 04 XXCORRECT PIC X(20). ST1464.2 +030200 02 INF-ANSI-REFERENCE PIC X(48). ST1464.2 +030300 01 HYPHEN-LINE. ST1464.2 +030400 02 FILLER PIC IS X VALUE IS SPACE. ST1464.2 +030500 02 FILLER PIC IS X(65) VALUE IS "************************ST1464.2 +030600- "*****************************************". ST1464.2 +030700 02 FILLER PIC IS X(54) VALUE IS "************************ST1464.2 +030800- "******************************". ST1464.2 +030900 01 CCVS-PGM-ID PIC X(9) VALUE ST1464.2 +031000 "ST146A". ST1464.2 +031100 PROCEDURE DIVISION. ST1464.2 +031200 CCVS1 SECTION. ST1464.2 +031300 OPEN-FILES. ST1464.2 +031400 OPEN OUTPUT PRINT-FILE. ST1464.2 +031500 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1464.2 +031600 MOVE SPACE TO TEST-RESULTS. ST1464.2 +031700 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1464.2 +031800 MOVE ZERO TO REC-SKL-SUB. ST1464.2 +031900 PERFORM CCVS-INIT-FILE 9 TIMES. ST1464.2 +032000 CCVS-INIT-FILE. ST1464.2 +032100 ADD 1 TO REC-SKL-SUB. ST1464.2 +032200 MOVE FILE-RECORD-INFO-SKELETON ST1464.2 +032300 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1464.2 +032400 CCVS-INIT-EXIT. ST1464.2 +032500 GO TO CCVS1-EXIT. ST1464.2 +032600 CLOSE-FILES. ST1464.2 +032700 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1464.2 +032800 TERMINATE-CCVS. ST1464.2 +032900*S EXIT PROGRAM. ST1464.2 +033000*SERMINATE-CALL. ST1464.2 +033100 STOP RUN. ST1464.2 +033200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1464.2 +033300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1464.2 +033400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1464.2 +033500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1464.2 +033600 MOVE "****TEST DELETED****" TO RE-MARK. ST1464.2 +033700 PRINT-DETAIL. ST1464.2 +033800 IF REC-CT NOT EQUAL TO ZERO ST1464.2 +033900 MOVE "." TO PARDOT-X ST1464.2 +034000 MOVE REC-CT TO DOTVALUE. ST1464.2 +034100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1464.2 +034200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1464.2 +034300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1464.2 +034400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1464.2 +034500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1464.2 +034600 MOVE SPACE TO CORRECT-X. ST1464.2 +034700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1464.2 +034800 MOVE SPACE TO RE-MARK. ST1464.2 +034900 HEAD-ROUTINE. ST1464.2 +035000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +035100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +035200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1464.2 +035300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1464.2 +035400 COLUMN-NAMES-ROUTINE. ST1464.2 +035500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +035600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +035700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +035800 END-ROUTINE. ST1464.2 +035900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1464.2 +036000 END-RTN-EXIT. ST1464.2 +036100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +036200 END-ROUTINE-1. ST1464.2 +036300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1464.2 +036400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1464.2 +036500 ADD PASS-COUNTER TO ERROR-HOLD. ST1464.2 +036600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1464.2 +036700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1464.2 +036800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1464.2 +036900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1464.2 +037000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1464.2 +037100 END-ROUTINE-12. ST1464.2 +037200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1464.2 +037300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1464.2 +037400 MOVE "NO " TO ERROR-TOTAL ST1464.2 +037500 ELSE ST1464.2 +037600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1464.2 +037700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1464.2 +037800 PERFORM WRITE-LINE. ST1464.2 +037900 END-ROUTINE-13. ST1464.2 +038000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1464.2 +038100 MOVE "NO " TO ERROR-TOTAL ELSE ST1464.2 +038200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1464.2 +038300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1464.2 +038400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +038500 IF INSPECT-COUNTER EQUAL TO ZERO ST1464.2 +038600 MOVE "NO " TO ERROR-TOTAL ST1464.2 +038700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1464.2 +038800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1464.2 +038900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +039000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1464.2 +039100 WRITE-LINE. ST1464.2 +039200 ADD 1 TO RECORD-COUNT. ST1464.2 +039300 IF RECORD-COUNT GREATER 42 ST1464.2 +039400 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1464.2 +039500 MOVE SPACE TO DUMMY-RECORD ST1464.2 +039600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1464.2 +039700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1464.2 +039800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1464.2 +039900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1464.2 +040000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1464.2 +040100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1464.2 +040200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1464.2 +040300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1464.2 +040400 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1464.2 +040500 MOVE ZERO TO RECORD-COUNT. ST1464.2 +040600 PERFORM WRT-LN. ST1464.2 +040700 WRT-LN. ST1464.2 +040800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1464.2 +040900 MOVE SPACE TO DUMMY-RECORD. ST1464.2 +041000 BLANK-LINE-PRINT. ST1464.2 +041100 PERFORM WRT-LN. ST1464.2 +041200 FAIL-ROUTINE. ST1464.2 +041300 IF COMPUTED-X NOT EQUAL TO SPACE ST1464.2 +041400 GO TO FAIL-ROUTINE-WRITE. ST1464.2 +041500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1464.2 +041600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1464.2 +041700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1464.2 +041800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +041900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1464.2 +042000 GO TO FAIL-ROUTINE-EX. ST1464.2 +042100 FAIL-ROUTINE-WRITE. ST1464.2 +042200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1464.2 +042300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1464.2 +042400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1464.2 +042500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1464.2 +042600 FAIL-ROUTINE-EX. EXIT. ST1464.2 +042700 BAIL-OUT. ST1464.2 +042800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1464.2 +042900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1464.2 +043000 BAIL-OUT-WRITE. ST1464.2 +043100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1464.2 +043200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1464.2 +043300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1464.2 +043400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1464.2 +043500 BAIL-OUT-EX. EXIT. ST1464.2 +043600 CCVS1-EXIT. ST1464.2 +043700 EXIT. ST1464.2 +043800 BEGIN-ST216-TESTS SECTION. ST1464.2 +043900 INIT-WRK-AREA. ST1464.2 +044000 MOVE STATIC-VALUE TO WRK-GRP-00019. ST1464.2 +044100 MOVE 9 TO DOI-DU-01V00. ST1464.2 +044200 MOVE " ACTIVE: " TO ODO-XN-00009. ST1464.2 +044300 MOVE "1" TO ODO-XN-00001-O009D (1). ST1464.2 +044400 MOVE "2" TO ODO-XN-00001-O009D (2). ST1464.2 +044500 MOVE "3" TO ODO-XN-00001-O009D (3). ST1464.2 +044600 MOVE "4" TO ODO-XN-00001-O009D (4). ST1464.2 +044700 MOVE "5" TO ODO-XN-00001-O009D (5). ST1464.2 +044800 MOVE "6" TO ODO-XN-00001-O009D (6). ST1464.2 +044900 MOVE "7" TO ODO-XN-00001-O009D (7). ST1464.2 +045000 MOVE "8" TO ODO-XN-00001-O009D (8). ST1464.2 +045100 MOVE "9" TO ODO-XN-00001-O009D (9). ST1464.2 +045200 BUILD-SQ-FS1 SECTION. ST1464.2 +045300 BUILD-SQ-FS1-PARA1. ST1464.2 +045400 OPEN OUTPUT SQ-FS1. ST1464.2 +045500 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1464.2 +045600 MOVE "FS1R1 " TO XRECORD-NAME (1). ST1464.2 +045700 MOVE "ST216" TO XPROGRAM-NAME (1). ST1464.2 +045800 MOVE 140 TO XRECORD-LENGTH (1). ST1464.2 +045900 MOVE "1R" TO CHARS-OR-RECORDS (1). ST1464.2 +046000 MOVE 4000 TO RECORDS-IN-FILE (1). ST1464.2 +046100 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1464.2 +046200 MOVE "S" TO XLABEL-TYPE (1). ST1464.2 +046300 PERFORM BUILD-SQ-FS1-PARA2 VARYING ODO-IX FROM 1 BY 1 ST1464.2 +046400 UNTIL ODO-IX IS GREATER THAN 1000. ST1464.2 +046500 GO TO BUILD-SQ-FS1-PARA3. ST1464.2 +046600 BUILD-SQ-FS1-PARA2. ST1464.2 +046700 SET XRECORD-NUMBER (1) TO ODO-IX. ST1464.2 +046800 MOVE 9 TO ODO-NUMBER (1). ST1464.2 +046900 MOVE FILE-RECORD-INFO-P1-120 (1) TO ODO-RECORD. ST1464.2 +047000 PERFORM INIT-WRK-AREA. ST1464.2 +047100 WRITE SQ-FS1R1-F-G-140 FROM ODO-RECORD. ST1464.2 +047200 BUILD-SQ-FS1-PARA3. ST1464.2 +047300 CLOSE SQ-FS1. ST1464.2 +047400 END-OF-BUILD-SQ-FS1 SECTION. ST1464.2 +047500 EXECUTE-THE-SORT. ST1464.2 +047600 SORT ST-FR1 ON ASCENDING KEY SORT-KEY-FIELD-XN-00006 ST1464.2 +047700 INPUT PROCEDURE IS SORT-INPUT-PROCEDURES ST1464.2 +047800 OUTPUT PROCEDURE IS SORT-OUTPUT-PROCEDURES. ST1464.2 +047900*XILE-DUMP SECTION. ST1464.2 +048000*X-D-1. ST1464.2 +048100*X PERFORM END-ROUTINE. ST1464.2 +048200*X MOVE " DUMP OF FIRST 10 (OF 1000) RECORDS FROM SQ-FS1:" ST1464.2 +048300*X TO PRINT-REC. ST1464.2 +048400*X PERFORM WRITE-LINE. ST1464.2 +048500*X PERFORM F-D-2 10 TIMES. ST1464.2 +048600*X GO TO F-D-3. ST1464.2 +048700*X-D-2. ST1464.2 +048800*X READ SQ-FS1 AT END GO TO F-D-3. ST1464.2 +048900*X MOVE FS1R1-XN-120 TO PRINT-REC. ST1464.2 +049000*X PERFORM WRITE-LINE. ST1464.2 +049100*X MOVE FS1R1-XN-20 TO PRINT-REC. ST1464.2 +049200*X PERFORM WRITE-LINE. ST1464.2 +049300*X-D-3. ST1464.2 +049400*X CLOSE SQ-FS1. ST1464.2 +049500*X OPEN INPUT SQ-FS2. ST1464.2 +049600*X PERFORM END-ROUTINE. ST1464.2 +049700*X MOVE " DUMP OF FIRST 10 (OF 1000) RECORDS FROM SQ-FS2:" ST1464.2 +049800*X TO PRINT-REC. ST1464.2 +049900*X PERFORM WRITE-LINE. ST1464.2 +050000*X PERFORM F-D-4 10 TIMES. ST1464.2 +050100*X GO TO F-D-5. ST1464.2 +050200*X-D-4. ST1464.2 +050300*X READ SQ-FS2 AT END GO TO F-D-5. ST1464.2 +050400*X MOVE FS2R1-XN-120 TO PRINT-REC. ST1464.2 +050500*X PERFORM WRITE-LINE. ST1464.2 +050600*X MOVE FS2R1-XN-20 TO PRINT-REC. ST1464.2 +050700*X PERFORM WRITE-LINE. ST1464.2 +050800*X-D-5. ST1464.2 +050900*X CLOSE SQ-FS2. ST1464.2 +051000 CCVS-EXIT SECTION. ST1464.2 +051100 CCVS-999999. ST1464.2 +051200 GO TO CLOSE-FILES. ST1464.2 +051300 SORT-INPUT-PROCEDURES SECTION. ST1464.2 +051400 S-I-P-1. ST1464.2 +051500 OPEN INPUT SQ-FS1. ST1464.2 +051600 MOVE 9 TO DOI-DU-01V00. ST1464.2 +051700 READ SQ-FS1 INTO ODO-RECORD AT END GO TO S-I-P-3. ST1464.2 +051800 MOVE 3 TO ODO-NUMBER (1). ST1464.2 +051900 MOVE 3 TO DOI-DU-01V00. ST1464.2 +052000 RELEASE ST-FR1R1-F-G-140 FROM ODO-RECORD. ST1464.2 +052100 MOVE 9 TO DOI-DU-01V00. ST1464.2 +052200 READ SQ-FS1 INTO ODO-RECORD AT END GO TO S-I-P-3. ST1464.2 +052300 MOVE 7 TO ODO-NUMBER (1). ST1464.2 +052400 MOVE 7 TO DOI-DU-01V00. ST1464.2 +052500 RELEASE ST-FR1R1-F-G-140 FROM ODO-RECORD. ST1464.2 +052600 S-I-P-2. ST1464.2 +052700 MOVE 9 TO DOI-DU-01V00. ST1464.2 +052800 READ SQ-FS1 INTO ODO-RECORD AT END GO TO S-I-P-3. ST1464.2 +052900 MOVE 9 TO DOI-DU-01V00. ST1464.2 +053000 RELEASE ST-FR1R1-F-G-140 FROM ODO-RECORD. ST1464.2 +053100 GO TO S-I-P-2. ST1464.2 +053200 S-I-P-3. ST1464.2 +053300 CLOSE SQ-FS1. ST1464.2 +053400 SORT-OUTPUT-PROCEDURES SECTION. ST1464.2 +053500 S-O-P-1. ST1464.2 +053600 OPEN OUTPUT SQ-FS2. ST1464.2 +053700 MOVE "OCCURS DEPENDING ON" TO FEATURE. ST1464.2 +053800 CLEAR-ODO-RECORD. ST1464.2 +053900 MOVE 9 TO DOI-DU-01V00. ST1464.2 +054000 MOVE SPACES TO ODO-RECORD. ST1464.2 +054100 MOVE 9 TO DOI-DU-01V00. ST1464.2 +054200 RELEASE-TEST-1. ST1464.2 +054300 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO RELEASE-DELETE-1. ST1464.2 +054400 IF SO-RECNO NOT EQUAL TO "000001" GO TO RELEASE-DELETE-1. ST1464.2 +054500 MOVE 9 TO DOI-DU-01V00. ST1464.2 +054600 MOVE ODO-GRP-00009 TO WRK-GRP-00009. ST1464.2 +054700 IF ODO-XN-00003 IS EQUAL TO "123" AND ST1464.2 +054800 ODO-XN-00006 IS NOT EQUAL TO "456789" ST1464.2 +054900 PERFORM PASS-1 ST1464.2 +055000 ELSE ST1464.2 +055100 PERFORM FAIL-1 ST1464.2 +055200 MOVE "3 ACTIVE: 123" TO CORRECT-A ST1464.2 +055300 MOVE 9 TO DOI-DU-01V00 ST1464.2 +055400 MOVE GRP-ODO TO COMPUTED-A. ST1464.2 +055500 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +055600 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +055700 GO TO RELEASE-WRITE-1. ST1464.2 +055800 RELEASE-DELETE-1. ST1464.2 +055900 PERFORM DE-LETE-1. ST1464.2 +056000 RELEASE-WRITE-1. ST1464.2 +056100 MOVE "RELEASE-TEST-1" TO PAR-NAME. ST1464.2 +056200 MOVE "RELEASE 3 ODO - RETURN 9 ODO" TO RE-MARK. ST1464.2 +056300 PERFORM PRINT-DETAIL-1. ST1464.2 +056400 RETURN-TEST-1. ST1464.2 +056500 PERFORM CLEAR-ODO-RECORD. ST1464.2 +056600 MOVE 5 TO DOI-DU-01V00. ST1464.2 +056700 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO RETURN-DELETE-1. ST1464.2 +056800 IF SO-RECNO NOT EQUAL TO "000002" GO TO RETURN-DELETE-1. ST1464.2 +056900 MOVE 9 TO DOI-DU-01V00. ST1464.2 +057000 MOVE ODO-GRP-00009 TO WRK-GRP-00009. ST1464.2 +057100 IF ODO-XN-00005 IS EQUAL TO "12345" AND ST1464.2 +057200 ODO-XN-00004 IS NOT EQUAL TO "6789" ST1464.2 +057300 PERFORM PASS-1 ST1464.2 +057400 ELSE ST1464.2 +057500 PERFORM FAIL-1 ST1464.2 +057600 MOVE "7 ACTIVE: 12345" TO CORRECT-A ST1464.2 +057700 MOVE 7 TO DOI-DU-01V00 ST1464.2 +057800 MOVE GRP-ODO TO COMPUTED-A. ST1464.2 +057900 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +058000 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +058100 GO TO RETURN-WRITE-1. ST1464.2 +058200 RETURN-DELETE-1. ST1464.2 +058300 PERFORM DE-LETE-1. ST1464.2 +058400 RETURN-WRITE-1. ST1464.2 +058500 MOVE "RETURN-TEST-1" TO PAR-NAME. ST1464.2 +058600 MOVE "RELEASE 7 ODO - RETURN 5 ODO" TO RE-MARK. ST1464.2 +058700 PERFORM PRINT-DETAIL-1. ST1464.2 +058800 RELEASE-TEST-2. ST1464.2 +058900 PERFORM CLEAR-ODO-RECORD. ST1464.2 +059000 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO RELEASE-DELETE-2. ST1464.2 +059100 IF SO-RECNO NOT EQUAL TO "000003" GO TO RELEASE-DELETE-2. ST1464.2 +059200 IF GRP-ODO IS EQUAL TO "9 ACTIVE: 123456789" ST1464.2 +059300 PERFORM PASS-1 ST1464.2 +059400 ELSE ST1464.2 +059500 PERFORM FAIL-1 ST1464.2 +059600 MOVE "9 ACTIVE: 123456789" TO CORRECT-A ST1464.2 +059700 MOVE GRP-ODO TO COMPUTED-A. ST1464.2 +059800 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +059900 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +060000 GO TO RELEASE-WRITE-2. ST1464.2 +060100 RELEASE-DELETE-2. ST1464.2 +060200 PERFORM DE-LETE-1. ST1464.2 +060300 RELEASE-WRITE-2. ST1464.2 +060400 MOVE "RELEASE-TEST-2" TO PAR-NAME. ST1464.2 +060500 MOVE "RELEASE 9 ODO - RETURN 9 ODO" TO RE-MARK. ST1464.2 +060600 PERFORM PRINT-DETAIL-1. ST1464.2 +060700 RETURN-TEST-2. ST1464.2 +060800 PERFORM CLEAR-ODO-RECORD. ST1464.2 +060900 MOVE 3 TO DOI-DU-01V00. ST1464.2 +061000 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO RETURN-DELETE-2. ST1464.2 +061100 IF SO-RECNO NOT EQUAL TO "000004" GO TO RETURN-DELETE-2. ST1464.2 +061200 MOVE 9 TO DOI-DU-01V00. ST1464.2 +061300 MOVE ODO-GRP-00009 TO WRK-GRP-00009. ST1464.2 +061400 IF ODO-XN-00003 IS EQUAL TO "123" AND ST1464.2 +061500 ODO-XN-00006 IS EQUAL TO "456789" ST1464.2 +061600 PERFORM PASS-1 ST1464.2 +061700 ELSE ST1464.2 +061800 PERFORM FAIL-1 ST1464.2 +061900 MOVE "9 ACTIVE: 123456789" TO CORRECT-A ST1464.2 +062000 MOVE GRP-ODO TO COMPUTED-A. ST1464.2 +062100 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +062200 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +062300 GO TO RETURN-WRITE-2. ST1464.2 +062400 RETURN-DELETE-2. ST1464.2 +062500 PERFORM DE-LETE-1. ST1464.2 +062600 RETURN-WRITE-2. ST1464.2 +062700 MOVE "RETURN-TEST-2" TO PAR-NAME. ST1464.2 +062800 MOVE "RELEASE 9 ODO - RETURN 6 ODO" TO RE-MARK. ST1464.2 +062900 PERFORM PRINT-DETAIL-1. ST1464.2 +063000 S-O-P-2. ST1464.2 +063100 PERFORM CLEAR-ODO-RECORD. ST1464.2 +063200 RETURN ST-FR1 INTO ODO-RECORD AT END GO TO S-O-P-3. ST1464.2 +063300 MOVE "SQ-FS2" TO SO-FILE-NAME. ST1464.2 +063400 WRITE SQ-FS2R1-F-G-140 FROM ODO-RECORD. ST1464.2 +063500 GO TO S-O-P-2. ST1464.2 +063600 INSPT-1. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1464.2 +063700 PASS-1. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1464.2 +063800 FAIL-1. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1464.2 +063900 DE-LETE-1. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1464.2 +064000 MOVE "****TEST DELETED****" TO RE-MARK. ST1464.2 +064100 PRINT-DETAIL-1. ST1464.2 +064200 IF REC-CT NOT EQUAL TO ZERO ST1464.2 +064300 MOVE "." TO PARDOT-X ST1464.2 +064400 MOVE REC-CT TO DOTVALUE. ST1464.2 +064500 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE-1. ST1464.2 +064600 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE-1 ST1464.2 +064700 PERFORM FAIL-ROUTINE-1 THRU FAIL-ROUTINE-EX-1 ST1464.2 +064800 ELSE PERFORM BAIL-OUT-1 THRU BAIL-OUT-EX-1. ST1464.2 +064900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1464.2 +065000 MOVE SPACE TO CORRECT-X. ST1464.2 +065100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1464.2 +065200 MOVE SPACE TO RE-MARK. ST1464.2 +065300 WRITE-LINE-1. ST1464.2 +065400 ADD 1 TO RECORD-COUNT. ST1464.2 +065500 IF RECORD-COUNT GREATER 50 ST1464.2 +065600 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1464.2 +065700 MOVE SPACE TO DUMMY-RECORD ST1464.2 +065800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1464.2 +065900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN-1 ST1464.2 +066000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN-1 2 TIMES ST1464.2 +066100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN-1 ST1464.2 +066200 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1464.2 +066300 MOVE ZERO TO RECORD-COUNT. ST1464.2 +066400 PERFORM WRT-LN-1. ST1464.2 +066500 WRT-LN-1. ST1464.2 +066600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1464.2 +066700 MOVE SPACE TO DUMMY-RECORD. ST1464.2 +066800 BLANK-LINE-PRINT-1. ST1464.2 +066900 PERFORM WRT-LN-1. ST1464.2 +067000 FAIL-ROUTINE-1. ST1464.2 +067100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1464.2 +067200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-RTN-WRITE-1. ST1464.2 +067300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1464.2 +067400 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1464.2 +067500 GO TO FAIL-ROUTINE-EX-1. ST1464.2 +067600 FAIL-RTN-WRITE-1. ST1464.2 +067700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE-1 ST1464.2 +067800 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE-1 2 TIMES. ST1464.2 +067900 FAIL-ROUTINE-EX-1. EXIT. ST1464.2 +068000 BAIL-OUT-1. ST1464.2 +068100 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE-1. ST1464.2 +068200 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX-1. ST1464.2 +068300 BAIL-OUT-WRITE-1. ST1464.2 +068400 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1464.2 +068500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE-1 2 TIMES. ST1464.2 +068600 BAIL-OUT-EX-1. EXIT. ST1464.2 +068700 S-O-P-3. ST1464.2 +068800 CLOSE SQ-FS2. ST1464.2 diff --git a/tests/cobol85/ST/ST147A.CBL b/tests/cobol85/ST/ST147A.CBL new file mode 100755 index 00000000..74a5109f --- /dev/null +++ b/tests/cobol85/ST/ST147A.CBL @@ -0,0 +1,1315 @@ +000100 IDENTIFICATION DIVISION. ST1474.2 +000200 PROGRAM-ID. ST1474.2 +000300 ST147A. ST1474.2 +000400**************************************************************** ST1474.2 +000500* * ST1474.2 +000600* VALIDATION FOR:- * ST1474.2 +000700* * ST1474.2 +000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1474.2 +000900* * ST1474.2 +001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1474.2 +001100* * ST1474.2 +001200**************************************************************** ST1474.2 +001300* ST1474.2 +001400* OBJECTIVE - ST1474.2 +001500* ROUTINE ST147A IS A TEST OF THE MERGE STATEMENT USING ST1474.2 +001600* A NATIVE COLLATING SEQUENCE AND FIXED LENGTH RECORDS. ST1474.2 +001700* ST1474.2 +001800* TWO FILES ARE FIRST CREATED BY THE ROUTINE IN DESCENDING ST1474.2 +001900* NATIVE ORDER. THE MERGE STATEMENT IS USED TO MERGE THE TWO ST1474.2 +002000* FILES AND PRODUCE, IN DESCENDING NATIVE COLLATING ST1474.2 +002100* SEQUENCE ORDER, 3 OUTPUT FILES FROM A SINGLE "MERGE" ST1474.2 +002200* STATEMENT. ST1474.2 +002300* ST1474.2 +002400* FEATURES TESTED - ST1474.2 +002500* * FIXED LENGTH RECORDS ST1474.2 +002600* * SAME SORT-MERGE AREA IN THE I-O-CONTROL PARAGRAPH ST1474.2 +002700* * QUALIFIED ALPHANUMERIC AND NUMERIC SORT KEYS ST1474.2 +002800* * USING FILE-NAME SERIES ST1474.2 +002900* ST1474.2 +003000* * MERGE MERGE-FILE-NAME ST1474.2 +003100* DESCENDING KEY-1 OF DATA-NAME-1 ST1474.2 +003200* ON DESCENDING KEY KEY-2 OF DATA-NAME-2 ST1474.2 +003300* USING FILE-NAME-2 FILE-NAME-1 ST1474.2 +003400* GIVING FILE-NAME-3, FILE-NAME-4, FILE-NAME-5. ST1474.2 +003500* ST1474.2 +003600* FILES USED - ST1474.2 +003700* * FILES SQ-FS1 AND SQ-FS2 ON MAGNETIC TAPE OR MASS-STORAGE ST1474.2 +003800* ARE FIRST CREATED. THE MERGE STATEMENT ST1474.2 +003900* USES BOTH OF THESE FILES AND CREATES OUTPUT FILES ST1474.2 +004000* SQ-FS3, SQ-FS4 AND SQ-FS5. ST1474.2 +004100* ST1474.2 +004200* SQ-FS1 ST1474.2 +004300* 51 RECORDS ST1474.2 +004400* FIXED LENGTH RECORDS 132 CHARACTERS ST1474.2 +004500* BLOCKED 1 ST1474.2 +004600* RESERVE 2 AREAS ST1474.2 +004700* ST1474.2 +004800* SQ-FS2 ST1474.2 +004900* 51 RECORDS ST1474.2 +005000* FIXED LENGTH RECORDS 132 CHARACTERS ST1474.2 +005100* BLOCKED 2 ST1474.2 +005200* RESERVE 4 AREAS ST1474.2 +005300* ST1474.2 +005400* SQ-FS3, SQ-FS4 AND SQ-FS5 ST1474.2 +005500* FINAL TOTAL OF 102 RECORDS ST1474.2 +005600* FIXED LENGTH RECORDS 132 CHARACTERS ST1474.2 +005700* BLOCKED 3 ST1474.2 +005800* RESERVE 4 AREAS ST1474.2 +005900* ST1474.2 +006000* NOTE THAT SQ-FS3 IS THE RESULT OF MERGING SQ-FS1 AND ST1474.2 +006100* SQ-FS2. THE RECORDS IN SQ-FS3 SHOULD ALTERNATE BETWEEN ST1474.2 +006200* SQ-FS1 AND SQ-FS2 BECAUSE THE ALPHANUMERIC KEYS ARE THE SAME ST1474.2 +006300* FOR BOTH FILES AND THE NUMERIC KEYS WERE MERGED INTO ST1474.2 +006400* DESCENDING ORDER. FILES SQ-FS4 AND SQ-FS5 ARE ST1474.2 +006500* IDENTICAL TO SQ-FS3. ST1474.2 +006600* ST1474.2 +006700* X-CARDS USED - ST1474.2 +006800* X-XXX014 SQ-FS1 ST1474.2 +006900* X-XXX015 SQ-FS2 ST1474.2 +007000* X-XXX016 SQ-FS3 ST1474.2 +007100* X-XXX018 SQ-FS5 ST1474.2 +007200* X-XXX027 MERGE FILE ST-FS1 ST1474.2 +007300* X-55 SYSTEM PRINTER NAME. ST1474.2 +007400* X-60 SQ-FS4 ST1474.2 +007500* X-XXX063 NATIVE COLLATING SEQUENCE ASCENDING ORDER-NOTE ST1474.2 +007600* THAT THE QUOTE CHARACTER IS NOT TO APPEAR IN THE X-64 ST1474.2 +007700* CARD AND THE DOLLAR SIGN $ IS TO APPEAR TWICE WHEREVER ST1474.2 +007800* THE $ BELONGS IN THE NATIVE COLLATING SEQUENCE). IF ST1474.2 +007900* THE NATIVE COLLATING SEQUENCE IS ACTUALLY THE ASCII ST1474.2 +008000* COLLATING SEQUENCE SEE BELOW FOR A SAMPLE X-64 CARD..... ST1474.2 +008100* ST1474.2 +008200* X-63 " $$()*+,./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1474.2 +008300* X-69 OPTIONAL VALUE OF CLAUSE ST1474.2 +008400* X-74 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008500* X-75 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008600* X-76 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008700* X-77 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008800* X-78 VALUE OF CLAUSE NAME PHRASES ST1474.2 +008900* X-79 VALUE OF CLAUSE NAME PHRASES ST1474.2 +009000* X-82 SOURCE COMPUTER NAME. ST1474.2 +009100* X-83 OBJECT COMPUTER NAME. ST1474.2 +009200* ST1474.2 +009300* ST1474.2 +009400* OPTIONS RECOMMENDED - ST1474.2 +009500* * OPT SW6 - X TO BE USED IF NECESSARY TO DUMP THE ST1474.2 +009600* FILES AS THEY ARE CREATED AND READ ST1474.2 +009700* DURING TESTS 3 THRU 8, 11 THRU 16, ST1474.2 +009800* AND 19 THRU 24. ST1474.2 +009900* ST1474.2 +010000* TEST DESCRIPTIONS - ST1474.2 +010100* MRG-TEST-001 CHECKS THE CREATION OF SQ-FS1 ST1474.2 +010200* MRG-TEST-002 CHECKS THE CREATION OF SQ-FS2 ST1474.2 +010300* MRG-TEST-003 TESTS RECORDS 1-20 ON MERGE RESULT SQ-FS3 ST1474.2 +010400* MRG-TEST-004 TESTS RECORDS 21-40 ON MERGE RESULT SQ-FS3 ST1474.2 +010500* MRG-TEST-005 TESTS RECORDS 41-60 ON MERGE RESULT SQ-FS3 ST1474.2 +010600* MRG-TEST-006 TESTS RECORDS 61-80 ON MERGE RESULT SQ-FS3 ST1474.2 +010700* MRG-TEST-007 TESTS RECORDS 81-100 ON MERGE RESULT SQ-FS3 ST1474.2 +010800* MRG-TEST-008 TESTS RECORDS 101-102 ON MERGE RESULT SQ-FS3ST1474.2 +010900* MRG-TEST-009 AN EOF CHECK ON SQ-FS3 ST1474.2 +011000* MRG-TEST-010 CHECK THAT THE NUMERIC KEY ON THE LAST ST1474.2 +011100* RECORD ON SQ-FS3 EQUALS 51 ST1474.2 +011200* MRG-TEST-011 ST1474.2 +011300* TO ST1474.2 +011400* MRG-TEST-018 SAME TESTS ON SQ-FS4 ST1474.2 +011500* MRG-TEST-019 ST1474.2 +011600* TO ST1474.2 +011700* MRG-TEST-026 SAME TESTS ON SQ-FS5 ST1474.2 +011800* ST1474.2 +011900* ************************************************************ ST1474.2 +012000 ENVIRONMENT DIVISION. ST1474.2 +012100 CONFIGURATION SECTION. ST1474.2 +012200 SOURCE-COMPUTER. ST1474.2 +012300 Linux. ST1474.2 +012400 OBJECT-COMPUTER. ST1474.2 +012500 Linux. ST1474.2 +012600 INPUT-OUTPUT SECTION. ST1474.2 +012700 FILE-CONTROL. ST1474.2 +012800 SELECT PRINT-FILE ASSIGN TO ST1474.2 +012900 "report.log". ST1474.2 +013000 SELECT SQ-FS1 ASSIGN ST1474.2 +013100 "XXXXX014" ST1474.2 +013200 ; ORGANIZATION IS SEQUENTIAL ST1474.2 +013300 ; ACCESS MODE SEQUENTIAL ST1474.2 +013400 ; RESERVE 2 AREAS. ST1474.2 +013500 SELECT SQ-FS2 ASSIGN TO ST1474.2 +013600 "XXXXX015" ST1474.2 +013700 ORGANIZATION IS SEQUENTIAL ST1474.2 +013800 ACCESS MODE IS SEQUENTIAL ST1474.2 +013900 RESERVE 4 AREAS. ST1474.2 +014000 SELECT SQ-FS3 ASSIGN TO ST1474.2 +014100 "XXXXX016" ST1474.2 +014200 ORGANIZATION IS SEQUENTIAL ST1474.2 +014300 ; ACCESS MODE IS SEQUENTIAL ST1474.2 +014400 RESERVE 4 AREAS. ST1474.2 +014500 SELECT SQ-FS4 ASSIGN TO ST1474.2 +014600 "XXXXX060" ST1474.2 +014700 ORGANIZATION IS SEQUENTIAL ST1474.2 +014800 ; ACCESS MODE IS SEQUENTIAL ST1474.2 +014900 RESERVE 4 AREAS. ST1474.2 +015000 SELECT SQ-FS5 ASSIGN TO ST1474.2 +015100 "XXXXX018" ST1474.2 +015200 ORGANIZATION IS SEQUENTIAL ST1474.2 +015300 ; ACCESS MODE IS SEQUENTIAL ST1474.2 +015400 RESERVE 4 AREAS. ST1474.2 +015500 SELECT ST-FS1 ASSIGN TO ST1474.2 +015600 "XXXXX027". ST1474.2 +015700 I-O-CONTROL. ST1474.2 +015800* SAME SORT-MERGE AREA FOR SQ-FS1, ST-FS1. ST1474.2 +015900 DATA DIVISION. ST1474.2 +016000 FILE SECTION. ST1474.2 +016100 FD PRINT-FILE. ST1474.2 +016200 01 PRINT-REC PICTURE X(120). ST1474.2 +016300 01 DUMMY-RECORD PICTURE X(120). ST1474.2 +016400 FD SQ-FS1 ST1474.2 +016500 LABEL RECORDS STANDARD ST1474.2 +016600*C VALUE OF ST1474.2 +016700*C OCLABELID ST1474.2 +016800*C "OCDUMMY" ST1474.2 +016900*C BLOCK CONTAINS 1 RECORDS ST1474.2 +017000*G SYSIN ST1474.2 +017100 RECORD CONTAINS 132 CHARACTERS. ST1474.2 +017200 01 SQ-FS1R1-F-G-132. ST1474.2 +017300 10 REC-PREAMBLE PIC X(120). ST1474.2 +017400 10 REST-OF-1. ST1474.2 +017500 20 KEY-1. ST1474.2 +017600 30 ALPHAN-KEY PIC X. ST1474.2 +017700 30 NUM-KEY PIC 999. ST1474.2 +017800 20 KEY-2. ST1474.2 +017900 30 ALPHAN-KEY PIC X. ST1474.2 +018000 30 NUM-KEY PIC 999. ST1474.2 +018100 20 KEY-3. ST1474.2 +018200 30 ALPHAN-KEY PIC X. ST1474.2 +018300 30 NUM-KEY PIC 999. ST1474.2 +018400 FD SQ-FS2 ST1474.2 +018500 LABEL RECORD IS STANDARD ST1474.2 +018600*C ; VALUE OF ST1474.2 +018700*C OCLABELID ST1474.2 +018800*C IS ST1474.2 +018900*C "OCDUMMY" ST1474.2 +019000*G SYSIN ST1474.2 +019100 ; BLOCK CONTAINS 2 RECORDS ST1474.2 +019200 ; RECORD CONTAINS 132 CHARACTERS ST1474.2 +019300 DATA RECORD SQ-FS2R1-F-G-132. ST1474.2 +019400 01 SQ-FS2R1-F-G-132. ST1474.2 +019500 10 REC-PRE-2 PIC X(120). ST1474.2 +019600 10 REST-OF-2. ST1474.2 +019700 20 KEY-4. ST1474.2 +019800 30 ALPHAN-KEY PIC X. ST1474.2 +019900 30 NUM-KEY PIC 999. ST1474.2 +020000 20 KEY-5. ST1474.2 +020100 30 ALPHAN-KEY PIC X. ST1474.2 +020200 30 NUM-KEY PIC 999. ST1474.2 +020300 20 KEY-6. ST1474.2 +020400 30 ALPHAN-KEY PIC X. ST1474.2 +020500 30 NUM-KEY PIC 999. ST1474.2 +020600 FD SQ-FS3 ST1474.2 +020700 LABEL RECORD IS STANDARD ST1474.2 +020800*C ; VALUE OF ST1474.2 +020900*C OCLABELID ST1474.2 +021000*C IS ST1474.2 +021100*C "OCDUMMY" ST1474.2 +021200*G SYSIN ST1474.2 +021300 ; BLOCK CONTAINS 3 RECORDS ST1474.2 +021400 RECORD CONTAINS 132 CHARACTERS ST1474.2 +021500 DATA RECORD SQ-FS3R1-F-G-132. ST1474.2 +021600 01 SQ-FS3R1-F-G-132. ST1474.2 +021700 10 REC-PRE-3 PIC X(120). ST1474.2 +021800 10 REST-OF-3. ST1474.2 +021900 20 KEY-7. ST1474.2 +022000 30 ALPHAN-KEY PIC X. ST1474.2 +022100 30 NUM-KEY PIC 999. ST1474.2 +022200 20 KEY-8. ST1474.2 +022300 30 ALPHAN-KEY PIC X. ST1474.2 +022400 30 NUM-KEY PIC 999. ST1474.2 +022500 20 KEY-9. ST1474.2 +022600 30 ALPHAN-KEY PIC X. ST1474.2 +022700 30 NUM-KEY PIC 999. ST1474.2 +022800 FD SQ-FS4 ST1474.2 +022900 LABEL RECORD IS STANDARD ST1474.2 +023000*C ; VALUE OF ST1474.2 +023100*C OCLABELID ST1474.2 +023200*C IS ST1474.2 +023300*C **** X-CARD UNDEFINED **** ST1474.2 +023400*G SYSIN ST1474.2 +023500 ; BLOCK CONTAINS 3 RECORDS ST1474.2 +023600 RECORD CONTAINS 132 CHARACTERS ST1474.2 +023700 DATA RECORD SQ-FS4R1-F-G-132. ST1474.2 +023800 01 SQ-FS4R1-F-G-132. ST1474.2 +023900 10 REC-PRE-4 PIC X(120). ST1474.2 +024000 10 REST-OF-4. ST1474.2 +024100 20 KEY-10. ST1474.2 +024200 30 ALPHAN-KEY PIC X. ST1474.2 +024300 30 NUM-KEY PIC 999. ST1474.2 +024400 20 KEY-11. ST1474.2 +024500 30 ALPHAN-KEY PIC X. ST1474.2 +024600 30 NUM-KEY PIC 999. ST1474.2 +024700 20 KEY-12. ST1474.2 +024800 30 ALPHAN-KEY PIC X. ST1474.2 +024900 30 NUM-KEY PIC 999. ST1474.2 +025000 FD SQ-FS5 ST1474.2 +025100 LABEL RECORD IS STANDARD ST1474.2 +025200*C ; VALUE OF ST1474.2 +025300*C OCLABELID ST1474.2 +025400*C IS ST1474.2 +025500*C **** X-CARD UNDEFINED **** ST1474.2 +025600*G SYSIN ST1474.2 +025700 ; BLOCK CONTAINS 3 RECORDS ST1474.2 +025800 RECORD CONTAINS 132 CHARACTERS ST1474.2 +025900 DATA RECORD SQ-FS5R1-F-G-132. ST1474.2 +026000 01 SQ-FS5R1-F-G-132. ST1474.2 +026100 10 REC-PRE-5 PIC X(120). ST1474.2 +026200 10 REST-OF-5. ST1474.2 +026300 20 KEY-13. ST1474.2 +026400 30 ALPHAN-KEY PIC X. ST1474.2 +026500 30 NUM-KEY PIC 999. ST1474.2 +026600 20 KEY-14. ST1474.2 +026700 30 ALPHAN-KEY PIC X. ST1474.2 +026800 30 NUM-KEY PIC 999. ST1474.2 +026900 20 KEY-15. ST1474.2 +027000 30 ALPHAN-KEY PIC X. ST1474.2 +027100 30 NUM-KEY PIC 999. ST1474.2 +027200 SD ST-FS1 ST1474.2 +027300 RECORD CONTAINS 132 CHARACTERS ST1474.2 +027400 DATA RECORD IS ST-FS1R1-F-G-132. ST1474.2 +027500 01 ST-FS1R1-F-G-132. ST1474.2 +027600 02 FILLER PIC X(120). ST1474.2 +027700 02 NON-KEY-1. ST1474.2 +027800 03 A-KEY PIC X. ST1474.2 +027900 03 N-KEY PIC 999. ST1474.2 +028000 02 SORT-KEY. ST1474.2 +028100 03 A-KEY PIC X. ST1474.2 +028200 03 N-KEY PIC 999. ST1474.2 +028300 02 NON-KEY-2. ST1474.2 +028400 03 A-KEY PIC X. ST1474.2 +028500 03 N-KEY PIC 999. ST1474.2 +028600 WORKING-STORAGE SECTION. ST1474.2 +028700 77 WRK-DU-9-0001 PIC 9 VALUE 0. ST1474.2 +028800 77 WRK-DU-999-0001 PIC 999. ST1474.2 +028900 77 WRK-DU-999-2 PIC 999 VALUE 001. ST1474.2 +029000 77 LAST-REC-NUM PIC 999 VALUE ZERO. ST1474.2 +029100 01 WRK-XN-0001 PIC X(51) VALUE ST1474.2 +029200 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1474.2 +029300 01 WRK-XN-O051F-X-0001 REDEFINES WRK-XN-0001. ST1474.2 +029400 02 CHAR PIC X OCCURS 51 TIMES. ST1474.2 +029500 01 WRK-XN-2 PIC X(51) VALUE ST1474.2 +029600 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ". ST1474.2 +029700 01 WRK-XN-0051F-X-0002 REDEFINES WRK-XN-2. ST1474.2 +029800 02 ASCIIS PIC X OCCURS 51 TIMES. ST1474.2 +029900 01 WRK-XN-O020F-0001. ST1474.2 +030000 02 COMPU PIC X OCCURS 20 TIMES. ST1474.2 +030100 01 WRK-XN-X-0001 REDEFINES WRK-XN-O020F-0001. ST1474.2 +030200 02 FILLER PIC X(20). ST1474.2 +030300 01 WRK-XN-O120F-1. ST1474.2 +030400 02 COLLS PIC X OCCURS 120 TIMES. ST1474.2 +030500 01 WRK-XN-X-2 REDEFINES WRK-XN-O120F-1. ST1474.2 +030600 02 WRK-XN-0002 PIC X(20). ST1474.2 +030700 02 WRK-XN-0003 PIC X(20). ST1474.2 +030800 02 WRK-XN-0004 PIC X(20). ST1474.2 +030900 02 WRK-XN-0005 PIC X(20). ST1474.2 +031000 02 WRK-XN-0006 PIC X(20). ST1474.2 +031100 02 WRK-XN-0007 PIC X(20). ST1474.2 +031200 01 FILE-RECORD-INFORMATION-REC. ST1474.2 +031300 03 FILE-RECORD-INFO-SKELETON. ST1474.2 +031400 05 FILLER PICTURE X(48) VALUE ST1474.2 +031500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". ST1474.2 +031600 05 FILLER PICTURE X(46) VALUE ST1474.2 +031700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". ST1474.2 +031800 05 FILLER PICTURE X(26) VALUE ST1474.2 +031900 ",LFIL=000000,ORG= ,LBLR= ". ST1474.2 +032000 05 FILLER PICTURE X(37) VALUE ST1474.2 +032100 ",RECKEY= ". ST1474.2 +032200 05 FILLER PICTURE X(38) VALUE ST1474.2 +032300 ",ALTKEY1= ". ST1474.2 +032400 05 FILLER PICTURE X(38) VALUE ST1474.2 +032500 ",ALTKEY2= ". ST1474.2 +032600 05 FILLER PICTURE X(7) VALUE SPACE.ST1474.2 +032700 03 FILE-RECORD-INFO OCCURS 10 TIMES. ST1474.2 +032800 05 FILE-RECORD-INFO-P1-120. ST1474.2 +032900 07 FILLER PIC X(5). ST1474.2 +033000 07 XFILE-NAME PIC X(6). ST1474.2 +033100 07 FILLER PIC X(8). ST1474.2 +033200 07 XRECORD-NAME PIC X(6). ST1474.2 +033300 07 FILLER PIC X(1). ST1474.2 +033400 07 REELUNIT-NUMBER PIC 9(1). ST1474.2 +033500 07 FILLER PIC X(7). ST1474.2 +033600 07 XRECORD-NUMBER PIC 9(6). ST1474.2 +033700 07 FILLER PIC X(6). ST1474.2 +033800 07 UPDATE-NUMBER PIC 9(2). ST1474.2 +033900 07 FILLER PIC X(5). ST1474.2 +034000 07 ODO-NUMBER PIC 9(4). ST1474.2 +034100 07 FILLER PIC X(5). ST1474.2 +034200 07 XPROGRAM-NAME PIC X(5). ST1474.2 +034300 07 FILLER PIC X(7). ST1474.2 +034400 07 XRECORD-LENGTH PIC 9(6). ST1474.2 +034500 07 FILLER PIC X(7). ST1474.2 +034600 07 CHARS-OR-RECORDS PIC X(2). ST1474.2 +034700 07 FILLER PIC X(1). ST1474.2 +034800 07 XBLOCK-SIZE PIC 9(4). ST1474.2 +034900 07 FILLER PIC X(6). ST1474.2 +035000 07 RECORDS-IN-FILE PIC 9(6). ST1474.2 +035100 07 FILLER PIC X(5). ST1474.2 +035200 07 XFILE-ORGANIZATION PIC X(2). ST1474.2 +035300 07 FILLER PIC X(6). ST1474.2 +035400 07 XLABEL-TYPE PIC X(1). ST1474.2 +035500 05 FILE-RECORD-INFO-P121-240. ST1474.2 +035600 07 FILLER PIC X(8). ST1474.2 +035700 07 XRECORD-KEY PIC X(29). ST1474.2 +035800 07 FILLER PIC X(9). ST1474.2 +035900 07 ALTERNATE-KEY1 PIC X(29). ST1474.2 +036000 07 FILLER PIC X(9). ST1474.2 +036100 07 ALTERNATE-KEY2 PIC X(29). ST1474.2 +036200 07 FILLER PIC X(7). ST1474.2 +036300 01 TEST-RESULTS. ST1474.2 +036400 02 FILLER PIC X VALUE SPACE. ST1474.2 +036500 02 FEATURE PIC X(20) VALUE SPACE. ST1474.2 +036600 02 FILLER PIC X VALUE SPACE. ST1474.2 +036700 02 P-OR-F PIC X(5) VALUE SPACE. ST1474.2 +036800 02 FILLER PIC X VALUE SPACE. ST1474.2 +036900 02 PAR-NAME. ST1474.2 +037000 03 FILLER PIC X(19) VALUE SPACE. ST1474.2 +037100 03 PARDOT-X PIC X VALUE SPACE. ST1474.2 +037200 03 DOTVALUE PIC 99 VALUE ZERO. ST1474.2 +037300 02 FILLER PIC X(8) VALUE SPACE. ST1474.2 +037400 02 RE-MARK PIC X(61). ST1474.2 +037500 01 TEST-COMPUTED. ST1474.2 +037600 02 FILLER PIC X(30) VALUE SPACE. ST1474.2 +037700 02 FILLER PIC X(17) VALUE ST1474.2 +037800 " COMPUTED=". ST1474.2 +037900 02 COMPUTED-X. ST1474.2 +038000 03 COMPUTED-A PIC X(20) VALUE SPACE. ST1474.2 +038100 03 COMPUTED-N REDEFINES COMPUTED-A ST1474.2 +038200 PIC -9(9).9(9). ST1474.2 +038300 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). ST1474.2 +038400 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). ST1474.2 +038500 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). ST1474.2 +038600 03 CM-18V0 REDEFINES COMPUTED-A. ST1474.2 +038700 04 COMPUTED-18V0 PIC -9(18). ST1474.2 +038800 04 FILLER PIC X. ST1474.2 +038900 03 FILLER PIC X(50) VALUE SPACE. ST1474.2 +039000 01 TEST-CORRECT. ST1474.2 +039100 02 FILLER PIC X(30) VALUE SPACE. ST1474.2 +039200 02 FILLER PIC X(17) VALUE " CORRECT =". ST1474.2 +039300 02 CORRECT-X. ST1474.2 +039400 03 CORRECT-A PIC X(20) VALUE SPACE. ST1474.2 +039500 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). ST1474.2 +039600 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). ST1474.2 +039700 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). ST1474.2 +039800 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). ST1474.2 +039900 03 CR-18V0 REDEFINES CORRECT-A. ST1474.2 +040000 04 CORRECT-18V0 PIC -9(18). ST1474.2 +040100 04 FILLER PIC X. ST1474.2 +040200 03 FILLER PIC X(2) VALUE SPACE. ST1474.2 +040300 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. ST1474.2 +040400 01 CCVS-C-1. ST1474.2 +040500 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAST1474.2 +040600- "SS PARAGRAPH-NAME ST1474.2 +040700- " REMARKS". ST1474.2 +040800 02 FILLER PIC X(20) VALUE SPACE. ST1474.2 +040900 01 CCVS-C-2. ST1474.2 +041000 02 FILLER PIC X VALUE SPACE. ST1474.2 +041100 02 FILLER PIC X(6) VALUE "TESTED". ST1474.2 +041200 02 FILLER PIC X(15) VALUE SPACE. ST1474.2 +041300 02 FILLER PIC X(4) VALUE "FAIL". ST1474.2 +041400 02 FILLER PIC X(94) VALUE SPACE. ST1474.2 +041500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. ST1474.2 +041600 01 REC-CT PIC 99 VALUE ZERO. ST1474.2 +041700 01 DELETE-COUNTER PIC 999 VALUE ZERO. ST1474.2 +041800 01 ERROR-COUNTER PIC 999 VALUE ZERO. ST1474.2 +041900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. ST1474.2 +042000 01 PASS-COUNTER PIC 999 VALUE ZERO. ST1474.2 +042100 01 TOTAL-ERROR PIC 999 VALUE ZERO. ST1474.2 +042200 01 ERROR-HOLD PIC 999 VALUE ZERO. ST1474.2 +042300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. ST1474.2 +042400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. ST1474.2 +042500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. ST1474.2 +042600 01 CCVS-H-1. ST1474.2 +042700 02 FILLER PIC X(39) VALUE SPACES. ST1474.2 +042800 02 FILLER PIC X(42) VALUE ST1474.2 +042900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". ST1474.2 +043000 02 FILLER PIC X(39) VALUE SPACES. ST1474.2 +043100 01 CCVS-H-2A. ST1474.2 +043200 02 FILLER PIC X(40) VALUE SPACE. ST1474.2 +043300 02 FILLER PIC X(7) VALUE "CCVS85 ". ST1474.2 +043400 02 FILLER PIC XXXX VALUE ST1474.2 +043500 "4.2 ". ST1474.2 +043600 02 FILLER PIC X(28) VALUE ST1474.2 +043700 " COPY - NOT FOR DISTRIBUTION". ST1474.2 +043800 02 FILLER PIC X(41) VALUE SPACE. ST1474.2 +043900 ST1474.2 +044000 01 CCVS-H-2B. ST1474.2 +044100 02 FILLER PIC X(15) VALUE ST1474.2 +044200 "TEST RESULT OF ". ST1474.2 +044300 02 TEST-ID PIC X(9). ST1474.2 +044400 02 FILLER PIC X(4) VALUE ST1474.2 +044500 " IN ". ST1474.2 +044600 02 FILLER PIC X(12) VALUE ST1474.2 +044700 " HIGH ". ST1474.2 +044800 02 FILLER PIC X(22) VALUE ST1474.2 +044900 " LEVEL VALIDATION FOR ". ST1474.2 +045000 02 FILLER PIC X(58) VALUE ST1474.2 +045100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1474.2 +045200 01 CCVS-H-3. ST1474.2 +045300 02 FILLER PIC X(34) VALUE ST1474.2 +045400 " FOR OFFICIAL USE ONLY ". ST1474.2 +045500 02 FILLER PIC X(58) VALUE ST1474.2 +045600 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".ST1474.2 +045700 02 FILLER PIC X(28) VALUE ST1474.2 +045800 " COPYRIGHT 1985 ". ST1474.2 +045900 01 CCVS-E-1. ST1474.2 +046000 02 FILLER PIC X(52) VALUE SPACE. ST1474.2 +046100 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". ST1474.2 +046200 02 ID-AGAIN PIC X(9). ST1474.2 +046300 02 FILLER PIC X(45) VALUE SPACES. ST1474.2 +046400 01 CCVS-E-2. ST1474.2 +046500 02 FILLER PIC X(31) VALUE SPACE. ST1474.2 +046600 02 FILLER PIC X(21) VALUE SPACE. ST1474.2 +046700 02 CCVS-E-2-2. ST1474.2 +046800 03 ERROR-TOTAL PIC XXX VALUE SPACE. ST1474.2 +046900 03 FILLER PIC X VALUE SPACE. ST1474.2 +047000 03 ENDER-DESC PIC X(44) VALUE ST1474.2 +047100 "ERRORS ENCOUNTERED". ST1474.2 +047200 01 CCVS-E-3. ST1474.2 +047300 02 FILLER PIC X(22) VALUE ST1474.2 +047400 " FOR OFFICIAL USE ONLY". ST1474.2 +047500 02 FILLER PIC X(12) VALUE SPACE. ST1474.2 +047600 02 FILLER PIC X(58) VALUE ST1474.2 +047700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".ST1474.2 +047800 02 FILLER PIC X(13) VALUE SPACE. ST1474.2 +047900 02 FILLER PIC X(15) VALUE ST1474.2 +048000 " COPYRIGHT 1985". ST1474.2 +048100 01 CCVS-E-4. ST1474.2 +048200 02 CCVS-E-4-1 PIC XXX VALUE SPACE. ST1474.2 +048300 02 FILLER PIC X(4) VALUE " OF ". ST1474.2 +048400 02 CCVS-E-4-2 PIC XXX VALUE SPACE. ST1474.2 +048500 02 FILLER PIC X(40) VALUE ST1474.2 +048600 " TESTS WERE EXECUTED SUCCESSFULLY". ST1474.2 +048700 01 XXINFO. ST1474.2 +048800 02 FILLER PIC X(19) VALUE ST1474.2 +048900 "*** INFORMATION ***". ST1474.2 +049000 02 INFO-TEXT. ST1474.2 +049100 04 FILLER PIC X(8) VALUE SPACE. ST1474.2 +049200 04 XXCOMPUTED PIC X(20). ST1474.2 +049300 04 FILLER PIC X(5) VALUE SPACE. ST1474.2 +049400 04 XXCORRECT PIC X(20). ST1474.2 +049500 02 INF-ANSI-REFERENCE PIC X(48). ST1474.2 +049600 01 HYPHEN-LINE. ST1474.2 +049700 02 FILLER PIC IS X VALUE IS SPACE. ST1474.2 +049800 02 FILLER PIC IS X(65) VALUE IS "************************ST1474.2 +049900- "*****************************************". ST1474.2 +050000 02 FILLER PIC IS X(54) VALUE IS "************************ST1474.2 +050100- "******************************". ST1474.2 +050200 01 CCVS-PGM-ID PIC X(9) VALUE ST1474.2 +050300 "ST147A". ST1474.2 +050400 PROCEDURE DIVISION. ST1474.2 +050500 DECLARATIVES. ST1474.2 +050600 SECT-ST209-DEC SECTION. ST1474.2 +050700 USE AFTER STANDARD ERROR PROCEDURE ON OUTPUT. ST1474.2 +050800 MRG-WRITE-DEC. ST1474.2 +050900 MOVE "ERROR ON OUTPUT DECL." TO FEATURE. ST1474.2 +051000 MOVE "MRG-TEST-DEC" TO PAR-NAME. ST1474.2 +051100 WRITE PRINT-REC FROM TEST-RESULTS AFTER ADVANCING 2 LINES. ST1474.2 +051200 STOP RUN. ST1474.2 +051300 END DECLARATIVES. ST1474.2 +051400 CCVS1 SECTION. ST1474.2 +051500 OPEN-FILES. ST1474.2 +051600 OPEN OUTPUT PRINT-FILE. ST1474.2 +051700 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. ST1474.2 +051800 MOVE SPACE TO TEST-RESULTS. ST1474.2 +051900 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. ST1474.2 +052000 MOVE ZERO TO REC-SKL-SUB. ST1474.2 +052100 PERFORM CCVS-INIT-FILE 9 TIMES. ST1474.2 +052200 CCVS-INIT-FILE. ST1474.2 +052300 ADD 1 TO REC-SKL-SUB. ST1474.2 +052400 MOVE FILE-RECORD-INFO-SKELETON ST1474.2 +052500 TO FILE-RECORD-INFO (REC-SKL-SUB). ST1474.2 +052600 CCVS-INIT-EXIT. ST1474.2 +052700 GO TO CCVS1-EXIT. ST1474.2 +052800 CLOSE-FILES. ST1474.2 +052900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. ST1474.2 +053000 TERMINATE-CCVS. ST1474.2 +053100 STOP RUN. ST1474.2 +053200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. ST1474.2 +053300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. ST1474.2 +053400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. ST1474.2 +053500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. ST1474.2 +053600 MOVE "****TEST DELETED****" TO RE-MARK. ST1474.2 +053700 PRINT-DETAIL. ST1474.2 +053800 IF REC-CT NOT EQUAL TO ZERO ST1474.2 +053900 MOVE "." TO PARDOT-X ST1474.2 +054000 MOVE REC-CT TO DOTVALUE. ST1474.2 +054100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. ST1474.2 +054200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE ST1474.2 +054300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX ST1474.2 +054400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. ST1474.2 +054500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. ST1474.2 +054600 MOVE SPACE TO CORRECT-X. ST1474.2 +054700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. ST1474.2 +054800 MOVE SPACE TO RE-MARK. ST1474.2 +054900 HEAD-ROUTINE. ST1474.2 +055000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +055100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +055200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1474.2 +055300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. ST1474.2 +055400 COLUMN-NAMES-ROUTINE. ST1474.2 +055500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +055600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +055700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +055800 END-ROUTINE. ST1474.2 +055900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.ST1474.2 +056000 END-RTN-EXIT. ST1474.2 +056100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +056200 END-ROUTINE-1. ST1474.2 +056300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO ST1474.2 +056400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. ST1474.2 +056500 ADD PASS-COUNTER TO ERROR-HOLD. ST1474.2 +056600* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. ST1474.2 +056700 MOVE PASS-COUNTER TO CCVS-E-4-1. ST1474.2 +056800 MOVE ERROR-HOLD TO CCVS-E-4-2. ST1474.2 +056900 MOVE CCVS-E-4 TO CCVS-E-2-2. ST1474.2 +057000 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. ST1474.2 +057100 END-ROUTINE-12. ST1474.2 +057200 MOVE "TEST(S) FAILED" TO ENDER-DESC. ST1474.2 +057300 IF ERROR-COUNTER IS EQUAL TO ZERO ST1474.2 +057400 MOVE "NO " TO ERROR-TOTAL ST1474.2 +057500 ELSE ST1474.2 +057600 MOVE ERROR-COUNTER TO ERROR-TOTAL. ST1474.2 +057700 MOVE CCVS-E-2 TO DUMMY-RECORD. ST1474.2 +057800 PERFORM WRITE-LINE. ST1474.2 +057900 END-ROUTINE-13. ST1474.2 +058000 IF DELETE-COUNTER IS EQUAL TO ZERO ST1474.2 +058100 MOVE "NO " TO ERROR-TOTAL ELSE ST1474.2 +058200 MOVE DELETE-COUNTER TO ERROR-TOTAL. ST1474.2 +058300 MOVE "TEST(S) DELETED " TO ENDER-DESC. ST1474.2 +058400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +058500 IF INSPECT-COUNTER EQUAL TO ZERO ST1474.2 +058600 MOVE "NO " TO ERROR-TOTAL ST1474.2 +058700 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. ST1474.2 +058800 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. ST1474.2 +058900 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +059000 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. ST1474.2 +059100 WRITE-LINE. ST1474.2 +059200 ADD 1 TO RECORD-COUNT. ST1474.2 +059300 IF RECORD-COUNT GREATER 42 ST1474.2 +059400 MOVE DUMMY-RECORD TO DUMMY-HOLD ST1474.2 +059500 MOVE SPACE TO DUMMY-RECORD ST1474.2 +059600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE ST1474.2 +059700 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1474.2 +059800 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES ST1474.2 +059900 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1474.2 +060000 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES ST1474.2 +060100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN ST1474.2 +060200 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN ST1474.2 +060300 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN ST1474.2 +060400 MOVE DUMMY-HOLD TO DUMMY-RECORD ST1474.2 +060500 MOVE ZERO TO RECORD-COUNT. ST1474.2 +060600 PERFORM WRT-LN. ST1474.2 +060700 WRT-LN. ST1474.2 +060800 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. ST1474.2 +060900 MOVE SPACE TO DUMMY-RECORD. ST1474.2 +061000 BLANK-LINE-PRINT. ST1474.2 +061100 PERFORM WRT-LN. ST1474.2 +061200 FAIL-ROUTINE. ST1474.2 +061300 IF COMPUTED-X NOT EQUAL TO SPACE ST1474.2 +061400 GO TO FAIL-ROUTINE-WRITE. ST1474.2 +061500 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.ST1474.2 +061600 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1474.2 +061700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. ST1474.2 +061800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +061900 MOVE SPACES TO INF-ANSI-REFERENCE. ST1474.2 +062000 GO TO FAIL-ROUTINE-EX. ST1474.2 +062100 FAIL-ROUTINE-WRITE. ST1474.2 +062200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE ST1474.2 +062300 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. ST1474.2 +062400 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. ST1474.2 +062500 MOVE SPACES TO COR-ANSI-REFERENCE. ST1474.2 +062600 FAIL-ROUTINE-EX. EXIT. ST1474.2 +062700 BAIL-OUT. ST1474.2 +062800 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. ST1474.2 +062900 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. ST1474.2 +063000 BAIL-OUT-WRITE. ST1474.2 +063100 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. ST1474.2 +063200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. ST1474.2 +063300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. ST1474.2 +063400 MOVE SPACES TO INF-ANSI-REFERENCE. ST1474.2 +063500 BAIL-OUT-EX. EXIT. ST1474.2 +063600 CCVS1-EXIT. ST1474.2 +063700 EXIT. ST1474.2 +063800 SECT-ST417-001 SECTION. ST1474.2 +063900 MRG-INIT-001. ST1474.2 +064000 MOVE "CREATE FILE SQ-FS1" TO FEATURE. ST1474.2 +064100 OPEN OUTPUT SQ-FS1. ST1474.2 +064200 MOVE "SQ-FS1" TO XFILE-NAME (1). ST1474.2 +064300 MOVE "R1-F-G" TO XRECORD-NAME (1). ST1474.2 +064400 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). ST1474.2 +064500 MOVE 000132 TO XRECORD-LENGTH (1). ST1474.2 +064600 MOVE "RC" TO CHARS-OR-RECORDS (1). ST1474.2 +064700 MOVE 0001 TO XBLOCK-SIZE (1). ST1474.2 +064800 MOVE 000051 TO RECORDS-IN-FILE (1). ST1474.2 +064900 MOVE "SQ" TO XFILE-ORGANIZATION (1). ST1474.2 +065000 MOVE "S" TO XLABEL-TYPE (1). ST1474.2 +065100 MOVE 000001 TO XRECORD-NUMBER (1). ST1474.2 +065200 MOVE SPACES TO WRK-XN-O120F-1. ST1474.2 +065300 MRG-TEST-001. ST1474.2 +065400 PERFORM MRG-TEST-001-BUILD VARYING WRK-DU-999-0001 ST1474.2 +065500 FROM 51 BY -1 UNTIL WRK-DU-999-0001 IS LESS THAN 1. ST1474.2 +065600*X MOVE SPACES TO PRINT-REC. ST1474.2 +065700*X WRITE PRINT-REC. ST1474.2 +065800 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 000052 ST1474.2 +065900 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1474.2 +066000 ELSE ST1474.2 +066100 PERFORM PASS. ST1474.2 +066200 GO TO MRG-WRITE-001. ST1474.2 +066300 MRG-TEST-001-BUILD. ST1474.2 +066400 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-1 ST1474.2 +066500 ALPHAN-KEY OF KEY-2 ALPHAN-KEY OF KEY-3. ST1474.2 +066600 MOVE WRK-DU-999-0001 TO NUM-KEY OF KEY-1 NUM-KEY OF KEY-2 ST1474.2 +066700 NUM-KEY OF KEY-3. ST1474.2 +066800 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PREAMBLE. ST1474.2 +066900 ADD 1 TO XRECORD-NUMBER (1). ST1474.2 +067000 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1474.2 +067100 ADD 1 TO WRK-DU-999-2. ST1474.2 +067200 MOVE ASCIIS (WRK-DU-999-0001) TO COLLS (WRK-DU-999-2). ST1474.2 +067300 ADD 1 TO WRK-DU-999-2. ST1474.2 +067400*X WRITE PRINT-REC FROM SQ-FS1R1-F-G-132. ST1474.2 +067500*X WRITE PRINT-REC FROM REST-OF-1. ST1474.2 +067600*X MOVE SPACES TO PRINT-REC. ST1474.2 +067700 WRITE SQ-FS1R1-F-G-132. ST1474.2 +067800 MRG-DELETE-001. ST1474.2 +067900 PERFORM DE-LETE. ST1474.2 +068000 MRG-WRITE-001. ST1474.2 +068100 MOVE "MRG-TEST-001" TO PAR-NAME. ST1474.2 +068200 MOVE "FIRST FILE CREATED" TO COMPUTED-A. ST1474.2 +068300 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1474.2 +068400 PERFORM PRINT-DETAIL. ST1474.2 +068500*X MOVE SPACES TO PRINT-REC. ST1474.2 +068600*X WRITE PRINT-REC. ST1474.2 +068700 CLOSE SQ-FS1. ST1474.2 +068800 MRG-INIT-002. ST1474.2 +068900 MOVE "CREATE FILE SQ-FS2" TO FEATURE. ST1474.2 +069000 OPEN OUTPUT SQ-FS2. ST1474.2 +069100 MOVE "SQ-FS2" TO XFILE-NAME (1). ST1474.2 +069200 MOVE 000001 TO XRECORD-NUMBER (1). ST1474.2 +069300 MOVE 0002 TO XBLOCK-SIZE (1). ST1474.2 +069400 MRG-TEST-002. ST1474.2 +069500 PERFORM MRG-TEST-002-BUILD VARYING WRK-DU-999-0001 ST1474.2 +069600 FROM 51 BY -1 UNTIL WRK-DU-999-0001 IS LESS THAN 1. ST1474.2 +069700*X MOVE SPACES TO PRINT-REC. ST1474.2 +069800*X WRITE PRINT-REC. ST1474.2 +069900 IF XRECORD-NUMBER (1) IS NOT EQUAL TO 52 ST1474.2 +070000 PERFORM FAIL MOVE "INCORR. NO. OF RECS." TO RE-MARK ST1474.2 +070100 ELSE ST1474.2 +070200 PERFORM PASS. ST1474.2 +070300 GO TO MRG-WRITE-002. ST1474.2 +070400 MRG-TEST-002-BUILD. ST1474.2 +070500 MOVE CHAR (WRK-DU-999-0001) TO ALPHAN-KEY OF KEY-4 ST1474.2 +070600 ALPHAN-KEY OF KEY-5 ALPHAN-KEY OF KEY-6. ST1474.2 +070700 ADD 51 WRK-DU-999-0001 GIVING NUM-KEY OF KEY-4 ST1474.2 +070800 NUM-KEY OF KEY-5 NUM-KEY OF KEY-6. ST1474.2 +070900 MOVE FILE-RECORD-INFO-P1-120 (1) TO REC-PRE-2. ST1474.2 +071000 ADD 000001 TO XRECORD-NUMBER (1). ST1474.2 +071100*X WRITE PRINT-REC FROM SQ-FS2R1-F-G-132. ST1474.2 +071200*X WRITE PRINT-REC FROM REST-OF-2. ST1474.2 +071300*X MOVE SPACES TO PRINT-REC. ST1474.2 +071400 WRITE SQ-FS2R1-F-G-132. ST1474.2 +071500 MRG-DELETE-002. ST1474.2 +071600 PERFORM DE-LETE. ST1474.2 +071700 MRG-WRITE-002. ST1474.2 +071800 MOVE "MRG-TEST-002" TO PAR-NAME. ST1474.2 +071900 MOVE "2ND FILE CREATED" TO COMPUTED-A. ST1474.2 +072000 MOVE XRECORD-NUMBER (1) TO CORRECT-18V0. ST1474.2 +072100 PERFORM PRINT-DETAIL. ST1474.2 +072200*X MOVE SPACES TO PRINT-REC. ST1474.2 +072300*X WRITE PRINT-REC. ST1474.2 +072400 CLOSE SQ-FS2. ST1474.2 +072500 MRG-INIT-003. ST1474.2 +072600* ==--> MULTIPLE "GIVING" FILES <--== ST1474.2 +072700 MOVE "XI-11 4.1.4 GR (11)" TO ANSI-REFERENCE. ST1474.2 +072800 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +072900 MERGE ST-FS1 ST1474.2 +073000 DESCENDING A-KEY OF SORT-KEY ST1474.2 +073100 ON DESCENDING KEY N-KEY OF NON-KEY-1 ST1474.2 +073200 USING SQ-FS2 SQ-FS1 ST1474.2 +073300 GIVING SQ-FS3 SQ-FS4 SQ-FS5. ST1474.2 +073400 MRG-TEST-003. ST1474.2 +073500 OPEN INPUT SQ-FS3. ST1474.2 +073600 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +073700 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +073800*X MOVE SPACES TO PRINT-REC. ST1474.2 +073900*X WRITE PRINT-REC. ST1474.2 +074000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1474.2 +074100 PERFORM FAIL GO TO MRG-FAIL-003 ST1474.2 +074200 ELSE ST1474.2 +074300 PERFORM PASS. ST1474.2 +074400 GO TO MRG-WRITE-003. ST1474.2 +074500 MRG-DELETE-003. ST1474.2 +074600 PERFORM DE-LETE. ST1474.2 +074700 GO TO MRG-WRITE-003. ST1474.2 +074800 MRG-FAIL-003. ST1474.2 +074900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +075000 MOVE WRK-XN-0002 TO CORRECT-A. ST1474.2 +075100 MRG-WRITE-003. ST1474.2 +075200 MOVE "MRG-TEST-003" TO PAR-NAME. ST1474.2 +075300 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +075400 PERFORM PRINT-DETAIL. ST1474.2 +075500*X MOVE SPACES TO PRINT-REC. ST1474.2 +075600*X WRITE PRINT-REC. ST1474.2 +075700 MRG-INIT-004. ST1474.2 +075800 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +075900 MRG-TEST-004. ST1474.2 +076000 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +076100 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +076200*X MOVE SPACES TO PRINT-REC. ST1474.2 +076300*X WRITE PRINT-REC. ST1474.2 +076400 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1474.2 +076500 PERFORM FAIL GO TO MRG-FAIL-004 ST1474.2 +076600 ELSE ST1474.2 +076700 PERFORM PASS. ST1474.2 +076800 GO TO MRG-WRITE-004. ST1474.2 +076900 MRG-DELETE-004. ST1474.2 +077000 PERFORM DE-LETE. ST1474.2 +077100 GO TO MRG-WRITE-004. ST1474.2 +077200 MRG-FAIL-004. ST1474.2 +077300 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +077400 MOVE WRK-XN-0003 TO CORRECT-A. ST1474.2 +077500 MRG-WRITE-004. ST1474.2 +077600 MOVE "MRG-TEST-004" TO PAR-NAME. ST1474.2 +077700 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +077800 PERFORM PRINT-DETAIL. ST1474.2 +077900*X MOVE SPACES TO PRINT-REC. ST1474.2 +078000*X WRITE PRINT-REC. ST1474.2 +078100 MRG-INIT-005. ST1474.2 +078200 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +078300 MRG-TEST-005. ST1474.2 +078400 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +078500 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +078600*X MOVE SPACES TO PRINT-REC. ST1474.2 +078700*X WRITE PRINT-REC. ST1474.2 +078800 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1474.2 +078900 PERFORM FAIL GO TO MRG-FAIL-005 ST1474.2 +079000 ELSE ST1474.2 +079100 PERFORM PASS. ST1474.2 +079200 GO TO MRG-WRITE-005. ST1474.2 +079300 MRG-DELETE-005. ST1474.2 +079400 PERFORM DE-LETE. ST1474.2 +079500 GO TO MRG-WRITE-005. ST1474.2 +079600 MRG-FAIL-005. ST1474.2 +079700 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +079800 MOVE WRK-XN-0004 TO CORRECT-A. ST1474.2 +079900 MRG-WRITE-005. ST1474.2 +080000 MOVE "MRG-TEST-005" TO PAR-NAME. ST1474.2 +080100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +080200 PERFORM PRINT-DETAIL. ST1474.2 +080300*X MOVE SPACES TO PRINT-REC. ST1474.2 +080400*X WRITE PRINT-REC. ST1474.2 +080500 MRG-INIT-006. ST1474.2 +080600 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +080700 MRG-TEST-006. ST1474.2 +080800 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +080900 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +081000*X MOVE SPACES TO PRINT-REC. ST1474.2 +081100*X WRITE PRINT-REC. ST1474.2 +081200 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1474.2 +081300 PERFORM FAIL GO TO MRG-FAIL-006 ST1474.2 +081400 ELSE ST1474.2 +081500 PERFORM PASS. ST1474.2 +081600 GO TO MRG-WRITE-006. ST1474.2 +081700 MRG-DELETE-006. ST1474.2 +081800 PERFORM DE-LETE. ST1474.2 +081900 GO TO MRG-WRITE-006. ST1474.2 +082000 MRG-FAIL-006. ST1474.2 +082100 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +082200 MOVE WRK-XN-0005 TO CORRECT-A. ST1474.2 +082300 MRG-WRITE-006. ST1474.2 +082400 MOVE "MRG-TEST-006" TO PAR-NAME. ST1474.2 +082500 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +082600 PERFORM PRINT-DETAIL. ST1474.2 +082700*X MOVE SPACES TO PRINT-REC. ST1474.2 +082800*X WRITE PRINT-REC. ST1474.2 +082900 MRG-INIT-007. ST1474.2 +083000 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +083100 MRG-TEST-007. ST1474.2 +083200 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +083300 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +083400*X MOVE SPACES TO PRINT-REC. ST1474.2 +083500*X WRITE PRINT-REC. ST1474.2 +083600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1474.2 +083700 PERFORM FAIL GO TO MRG-FAIL-007 ST1474.2 +083800 ELSE ST1474.2 +083900 PERFORM PASS. ST1474.2 +084000 GO TO MRG-WRITE-007. ST1474.2 +084100 MRG-DELETE-007. ST1474.2 +084200 PERFORM DE-LETE. ST1474.2 +084300 GO TO MRG-WRITE-007. ST1474.2 +084400 MRG-FAIL-007. ST1474.2 +084500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +084600 MOVE WRK-XN-0006 TO CORRECT-A. ST1474.2 +084700 MRG-WRITE-007. ST1474.2 +084800 MOVE "MRG-TEST-007" TO PAR-NAME. ST1474.2 +084900 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +085000 PERFORM PRINT-DETAIL. ST1474.2 +085100*X MOVE SPACES TO PRINT-REC. ST1474.2 +085200*X WRITE PRINT-REC. ST1474.2 +085300 MRG-INIT-008. ST1474.2 +085400 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +085500 MRG-TEST-008. ST1474.2 +085600 PERFORM RD-1 THRU R1-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +085700 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1474.2 +085800*X MOVE SPACES TO PRINT-REC. ST1474.2 +085900*X WRITE PRINT-REC. ST1474.2 +086000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1474.2 +086100 PERFORM FAIL GO TO MRG-FAIL-008 ST1474.2 +086200 ELSE ST1474.2 +086300 PERFORM PASS. ST1474.2 +086400 GO TO MRG-WRITE-008. ST1474.2 +086500 MRG-DELETE-008. ST1474.2 +086600 PERFORM DE-LETE. ST1474.2 +086700 GO TO MRG-WRITE-008. ST1474.2 +086800 MRG-FAIL-008. ST1474.2 +086900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +087000 MOVE WRK-XN-0007 TO CORRECT-A. ST1474.2 +087100 MRG-WRITE-008. ST1474.2 +087200 MOVE "MRG-TEST-008" TO PAR-NAME. ST1474.2 +087300 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +087400 PERFORM PRINT-DETAIL. ST1474.2 +087500 MOVE NUM-KEY OF KEY-7 TO LAST-REC-NUM. ST1474.2 +087600 MRG-TEST-009. ST1474.2 +087700 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +087800 GO TO MRG-FAIL-009. ST1474.2 +087900 READ SQ-FS3 END PERFORM PASS ST1474.2 +088000 GO TO MRG-WRITE-009. ST1474.2 +088100 GO TO MRG-FAIL-009. ST1474.2 +088200 MRG-DELETE-009. ST1474.2 +088300 PERFORM DE-LETE. ST1474.2 +088400 GO TO MRG-WRITE-009. ST1474.2 +088500 MRG-FAIL-009. ST1474.2 +088600 MOVE "EOF NOT FOUND" TO RE-MARK. ST1474.2 +088700 PERFORM FAIL . ST1474.2 +088800 MRG-WRITE-009. ST1474.2 +088900 MOVE "MRG-TEST-009" TO PAR-NAME. ST1474.2 +089000 MOVE "EOF CHECK SQ-FS3" TO FEATURE. ST1474.2 +089100 PERFORM PRINT-DETAIL. ST1474.2 +089200 MRG-TEST-010. ST1474.2 +089300 IF LAST-REC-NUM IS NOT EQUAL TO 1 ST1474.2 +089400 PERFORM FAIL GO TO MRG-FAIL-010 ST1474.2 +089500 ELSE ST1474.2 +089600 PERFORM PASS. ST1474.2 +089700 GO TO MRG-WRITE-010. ST1474.2 +089800 MRG-DELETE-010. ST1474.2 +089900 PERFORM DE-LETE. ST1474.2 +090000 GO TO MRG-WRITE-010. ST1474.2 +090100 MRG-FAIL-010. ST1474.2 +090200 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1474.2 +090300 MOVE 1 TO CR-18V0. ST1474.2 +090400 MRG-WRITE-010. ST1474.2 +090500 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1474.2 +090600 MOVE "MRG-TEST-010" TO PAR-NAME. ST1474.2 +090700 PERFORM PRINT-DETAIL. ST1474.2 +090800 CLOSE SQ-FS3. ST1474.2 +090900 GO TO MRG-TEST-011. ST1474.2 +091000 READ-SQ-FS3 SECTION. ST1474.2 +091100 RD-1. ST1474.2 +091200 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +091300 GO TO R1-EXIT. ST1474.2 +091400 READ SQ-FS3 AT END GO TO PREMATURE-EOF-1. ST1474.2 +091500*X WRITE PRINT-REC FROM SQ-FS3R1-F-G-132. ST1474.2 +091600*X WRITE PRINT-REC FROM REST-OF-3. ST1474.2 +091700*X MOVE SPACES TO PRINT-REC. ST1474.2 +091800 MOVE ALPHAN-KEY OF KEY-8 TO COMPU (WRK-DU-999-0001). ST1474.2 +091900 GO TO R1-EXIT. ST1474.2 +092000 PREMATURE-EOF-1. ST1474.2 +092100 MOVE 1 TO WRK-DU-9-0001. ST1474.2 +092200 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1474.2 +092300 R1-EXIT. ST1474.2 +092400 EXIT. ST1474.2 +092500* ST1474.2 +092600* ST1474.2 +092700 MRG-TEST-011. ST1474.2 +092800 OPEN INPUT SQ-FS4. ST1474.2 +092900 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +093000 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +093100*X MOVE SPACES TO PRINT-REC. ST1474.2 +093200*X WRITE PRINT-REC. ST1474.2 +093300 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1474.2 +093400 PERFORM FAIL GO TO MRG-FAIL-011 ST1474.2 +093500 ELSE ST1474.2 +093600 PERFORM PASS. ST1474.2 +093700 GO TO MRG-WRITE-011. ST1474.2 +093800 MRG-DELETE-011. ST1474.2 +093900 PERFORM DE-LETE. ST1474.2 +094000 GO TO MRG-WRITE-011. ST1474.2 +094100 MRG-FAIL-011. ST1474.2 +094200 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +094300 MOVE WRK-XN-0002 TO CORRECT-A. ST1474.2 +094400 MRG-WRITE-011. ST1474.2 +094500 MOVE "MRG-TEST-011" TO PAR-NAME. ST1474.2 +094600 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +094700 PERFORM PRINT-DETAIL. ST1474.2 +094800*X MOVE SPACES TO PRINT-REC. ST1474.2 +094900*X WRITE PRINT-REC. ST1474.2 +095000 MRG-INIT-012. ST1474.2 +095100 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +095200 MRG-TEST-012. ST1474.2 +095300 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +095400 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +095500*X MOVE SPACES TO PRINT-REC. ST1474.2 +095600*X WRITE PRINT-REC. ST1474.2 +095700 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1474.2 +095800 PERFORM FAIL GO TO MRG-FAIL-012 ST1474.2 +095900 ELSE ST1474.2 +096000 PERFORM PASS. ST1474.2 +096100 GO TO MRG-WRITE-012. ST1474.2 +096200 MRG-DELETE-012. ST1474.2 +096300 PERFORM DE-LETE. ST1474.2 +096400 GO TO MRG-WRITE-012. ST1474.2 +096500 MRG-FAIL-012. ST1474.2 +096600 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +096700 MOVE WRK-XN-0003 TO CORRECT-A. ST1474.2 +096800 MRG-WRITE-012. ST1474.2 +096900 MOVE "MRG-TEST-012" TO PAR-NAME. ST1474.2 +097000 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +097100 PERFORM PRINT-DETAIL. ST1474.2 +097200*X MOVE SPACES TO PRINT-REC. ST1474.2 +097300*X WRITE PRINT-REC. ST1474.2 +097400 MRG-INIT-013. ST1474.2 +097500 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +097600 MRG-TEST-013. ST1474.2 +097700 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +097800 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +097900*X MOVE SPACES TO PRINT-REC. ST1474.2 +098000*X WRITE PRINT-REC. ST1474.2 +098100 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1474.2 +098200 PERFORM FAIL GO TO MRG-FAIL-013 ST1474.2 +098300 ELSE ST1474.2 +098400 PERFORM PASS. ST1474.2 +098500 GO TO MRG-WRITE-013. ST1474.2 +098600 MRG-DELETE-013. ST1474.2 +098700 PERFORM DE-LETE. ST1474.2 +098800 GO TO MRG-WRITE-013. ST1474.2 +098900 MRG-FAIL-013. ST1474.2 +099000 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +099100 MOVE WRK-XN-0004 TO CORRECT-A. ST1474.2 +099200 MRG-WRITE-013. ST1474.2 +099300 MOVE "MRG-TEST-013" TO PAR-NAME. ST1474.2 +099400 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +099500 PERFORM PRINT-DETAIL. ST1474.2 +099600*X MOVE SPACES TO PRINT-REC. ST1474.2 +099700*X WRITE PRINT-REC. ST1474.2 +099800 MRG-INIT-014. ST1474.2 +099900 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +100000 MRG-TEST-014. ST1474.2 +100100 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +100200 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +100300*X MOVE SPACES TO PRINT-REC. ST1474.2 +100400*X WRITE PRINT-REC. ST1474.2 +100500 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1474.2 +100600 PERFORM FAIL GO TO MRG-FAIL-014 ST1474.2 +100700 ELSE ST1474.2 +100800 PERFORM PASS. ST1474.2 +100900 GO TO MRG-WRITE-014. ST1474.2 +101000 MRG-DELETE-014. ST1474.2 +101100 PERFORM DE-LETE. ST1474.2 +101200 GO TO MRG-WRITE-014. ST1474.2 +101300 MRG-FAIL-014. ST1474.2 +101400 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +101500 MOVE WRK-XN-0005 TO CORRECT-A. ST1474.2 +101600 MRG-WRITE-014. ST1474.2 +101700 MOVE "MRG-TEST-014" TO PAR-NAME. ST1474.2 +101800 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +101900 PERFORM PRINT-DETAIL. ST1474.2 +102000*X MOVE SPACES TO PRINT-REC. ST1474.2 +102100*X WRITE PRINT-REC. ST1474.2 +102200 MRG-INIT-015. ST1474.2 +102300 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +102400 MRG-TEST-015. ST1474.2 +102500 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +102600 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +102700*X MOVE SPACES TO PRINT-REC. ST1474.2 +102800*X WRITE PRINT-REC. ST1474.2 +102900 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1474.2 +103000 PERFORM FAIL GO TO MRG-FAIL-015 ST1474.2 +103100 ELSE ST1474.2 +103200 PERFORM PASS. ST1474.2 +103300 GO TO MRG-WRITE-015. ST1474.2 +103400 MRG-DELETE-015. ST1474.2 +103500 PERFORM DE-LETE. ST1474.2 +103600 GO TO MRG-WRITE-015. ST1474.2 +103700 MRG-FAIL-015. ST1474.2 +103800 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +103900 MOVE WRK-XN-0006 TO CORRECT-A. ST1474.2 +104000 MRG-WRITE-015. ST1474.2 +104100 MOVE "MRG-TEST-015" TO PAR-NAME. ST1474.2 +104200 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +104300 PERFORM PRINT-DETAIL. ST1474.2 +104400*X MOVE SPACES TO PRINT-REC. ST1474.2 +104500*X WRITE PRINT-REC. ST1474.2 +104600 MRG-INIT-016. ST1474.2 +104700 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +104800 MRG-TEST-016. ST1474.2 +104900 PERFORM RD-2 THRU R2-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +105000 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1474.2 +105100*X MOVE SPACES TO PRINT-REC. ST1474.2 +105200*X WRITE PRINT-REC. ST1474.2 +105300 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1474.2 +105400 PERFORM FAIL GO TO MRG-FAIL-016 ST1474.2 +105500 ELSE ST1474.2 +105600 PERFORM PASS. ST1474.2 +105700 GO TO MRG-WRITE-016. ST1474.2 +105800 MRG-DELETE-016. ST1474.2 +105900 PERFORM DE-LETE. ST1474.2 +106000 GO TO MRG-WRITE-016. ST1474.2 +106100 MRG-FAIL-016. ST1474.2 +106200 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +106300 MOVE WRK-XN-0007 TO CORRECT-A. ST1474.2 +106400 MRG-WRITE-016. ST1474.2 +106500 MOVE "MRG-TEST-016" TO PAR-NAME. ST1474.2 +106600 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +106700 PERFORM PRINT-DETAIL. ST1474.2 +106800 MOVE NUM-KEY OF KEY-10 TO LAST-REC-NUM. ST1474.2 +106900 MRG-TEST-017. ST1474.2 +107000 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +107100 GO TO MRG-FAIL-017. ST1474.2 +107200 READ SQ-FS4 END PERFORM PASS ST1474.2 +107300 GO TO MRG-WRITE-017. ST1474.2 +107400 GO TO MRG-FAIL-017. ST1474.2 +107500 MRG-DELETE-017. ST1474.2 +107600 PERFORM DE-LETE. ST1474.2 +107700 GO TO MRG-WRITE-017. ST1474.2 +107800 MRG-FAIL-017. ST1474.2 +107900 MOVE "EOF NOT FOUND" TO RE-MARK. ST1474.2 +108000 PERFORM FAIL . ST1474.2 +108100 MRG-WRITE-017. ST1474.2 +108200 MOVE "MRG-TEST-017" TO PAR-NAME. ST1474.2 +108300 MOVE "EOF CHECK SQ-FS4" TO FEATURE. ST1474.2 +108400 PERFORM PRINT-DETAIL. ST1474.2 +108500 MRG-TEST-018. ST1474.2 +108600 IF LAST-REC-NUM IS NOT EQUAL TO 1 ST1474.2 +108700 PERFORM FAIL GO TO MRG-FAIL-018 ST1474.2 +108800 ELSE ST1474.2 +108900 PERFORM PASS. ST1474.2 +109000 GO TO MRG-WRITE-018. ST1474.2 +109100 MRG-DELETE-018. ST1474.2 +109200 PERFORM DE-LETE. ST1474.2 +109300 GO TO MRG-WRITE-018. ST1474.2 +109400 MRG-FAIL-018. ST1474.2 +109500 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1474.2 +109600 MOVE 1 TO CR-18V0. ST1474.2 +109700 MRG-WRITE-018. ST1474.2 +109800 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1474.2 +109900 MOVE "MRG-TEST-018" TO PAR-NAME. ST1474.2 +110000 PERFORM PRINT-DETAIL. ST1474.2 +110100 CLOSE SQ-FS4. ST1474.2 +110200 GO TO MRG-TEST-019. ST1474.2 +110300 READ-SQ-FS4 SECTION. ST1474.2 +110400 RD-2. ST1474.2 +110500 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +110600 GO TO R2-EXIT. ST1474.2 +110700 READ SQ-FS4 AT END GO TO PREMATURE-EOF-2. ST1474.2 +110800*X WRITE PRINT-REC FROM SQ-FS4R1-F-G-132. ST1474.2 +110900*X WRITE PRINT-REC FROM REST-OF-4. ST1474.2 +111000*X MOVE SPACES TO PRINT-REC. ST1474.2 +111100 MOVE ALPHAN-KEY OF KEY-11 TO COMPU (WRK-DU-999-0001). ST1474.2 +111200 GO TO R2-EXIT. ST1474.2 +111300 PREMATURE-EOF-2. ST1474.2 +111400 MOVE 1 TO WRK-DU-9-0001. ST1474.2 +111500 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1474.2 +111600 R2-EXIT. ST1474.2 +111700 EXIT. ST1474.2 +111800* ST1474.2 +111900* ST1474.2 +112000 MRG-TEST-019. ST1474.2 +112100 OPEN INPUT SQ-FS5. ST1474.2 +112200 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +112300 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +112400*X MOVE SPACES TO PRINT-REC. ST1474.2 +112500*X WRITE PRINT-REC. ST1474.2 +112600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0002 ST1474.2 +112700 PERFORM FAIL GO TO MRG-FAIL-019 ST1474.2 +112800 ELSE ST1474.2 +112900 PERFORM PASS. ST1474.2 +113000 GO TO MRG-WRITE-019. ST1474.2 +113100 MRG-DELETE-019. ST1474.2 +113200 PERFORM DE-LETE. ST1474.2 +113300 GO TO MRG-WRITE-019. ST1474.2 +113400 MRG-FAIL-019. ST1474.2 +113500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +113600 MOVE WRK-XN-0002 TO CORRECT-A. ST1474.2 +113700 MRG-WRITE-019. ST1474.2 +113800 MOVE "MRG-TEST-019" TO PAR-NAME. ST1474.2 +113900 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +114000 PERFORM PRINT-DETAIL. ST1474.2 +114100*X MOVE SPACES TO PRINT-REC. ST1474.2 +114200*X WRITE PRINT-REC. ST1474.2 +114300 MRG-INIT-020. ST1474.2 +114400 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +114500 MRG-TEST-020. ST1474.2 +114600 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +114700 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +114800*X MOVE SPACES TO PRINT-REC. ST1474.2 +114900*X WRITE PRINT-REC. ST1474.2 +115000 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0003 ST1474.2 +115100 PERFORM FAIL GO TO MRG-FAIL-020 ST1474.2 +115200 ELSE ST1474.2 +115300 PERFORM PASS. ST1474.2 +115400 GO TO MRG-WRITE-020. ST1474.2 +115500 MRG-DELETE-020. ST1474.2 +115600 PERFORM DE-LETE. ST1474.2 +115700 GO TO MRG-WRITE-020. ST1474.2 +115800 MRG-FAIL-020. ST1474.2 +115900 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +116000 MOVE WRK-XN-0003 TO CORRECT-A. ST1474.2 +116100 MRG-WRITE-020. ST1474.2 +116200 MOVE "MRG-TEST-020" TO PAR-NAME. ST1474.2 +116300 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +116400 PERFORM PRINT-DETAIL. ST1474.2 +116500*X MOVE SPACES TO PRINT-REC. ST1474.2 +116600*X WRITE PRINT-REC. ST1474.2 +116700 MRG-INIT-021. ST1474.2 +116800 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +116900 MRG-TEST-021. ST1474.2 +117000 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +117100 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +117200*X MOVE SPACES TO PRINT-REC. ST1474.2 +117300*X WRITE PRINT-REC. ST1474.2 +117400 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0004 ST1474.2 +117500 PERFORM FAIL GO TO MRG-FAIL-021 ST1474.2 +117600 ELSE ST1474.2 +117700 PERFORM PASS. ST1474.2 +117800 GO TO MRG-WRITE-021. ST1474.2 +117900 MRG-DELETE-021. ST1474.2 +118000 PERFORM DE-LETE. ST1474.2 +118100 GO TO MRG-WRITE-021. ST1474.2 +118200 MRG-FAIL-021. ST1474.2 +118300 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +118400 MOVE WRK-XN-0004 TO CORRECT-A. ST1474.2 +118500 MRG-WRITE-021. ST1474.2 +118600 MOVE "MRG-TEST-021" TO PAR-NAME. ST1474.2 +118700 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +118800 PERFORM PRINT-DETAIL. ST1474.2 +118900*X MOVE SPACES TO PRINT-REC. ST1474.2 +119000*X WRITE PRINT-REC. ST1474.2 +119100 MRG-INIT-022. ST1474.2 +119200 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +119300 MRG-TEST-022. ST1474.2 +119400 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +119500 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +119600*X MOVE SPACES TO PRINT-REC. ST1474.2 +119700*X WRITE PRINT-REC. ST1474.2 +119800 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0005 ST1474.2 +119900 PERFORM FAIL GO TO MRG-FAIL-022 ST1474.2 +120000 ELSE ST1474.2 +120100 PERFORM PASS. ST1474.2 +120200 GO TO MRG-WRITE-022. ST1474.2 +120300 MRG-DELETE-022. ST1474.2 +120400 PERFORM DE-LETE. ST1474.2 +120500 GO TO MRG-WRITE-022. ST1474.2 +120600 MRG-FAIL-022. ST1474.2 +120700 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +120800 MOVE WRK-XN-0005 TO CORRECT-A. ST1474.2 +120900 MRG-WRITE-022. ST1474.2 +121000 MOVE "MRG-TEST-022" TO PAR-NAME. ST1474.2 +121100 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +121200 PERFORM PRINT-DETAIL. ST1474.2 +121300*X MOVE SPACES TO PRINT-REC. ST1474.2 +121400*X WRITE PRINT-REC. ST1474.2 +121500 MRG-INIT-023. ST1474.2 +121600 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +121700 MRG-TEST-023. ST1474.2 +121800 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +121900 UNTIL WRK-DU-999-0001 IS GREATER THAN 20. ST1474.2 +122000*X MOVE SPACES TO PRINT-REC. ST1474.2 +122100*X WRITE PRINT-REC. ST1474.2 +122200 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0006 ST1474.2 +122300 PERFORM FAIL GO TO MRG-FAIL-023 ST1474.2 +122400 ELSE ST1474.2 +122500 PERFORM PASS. ST1474.2 +122600 GO TO MRG-WRITE-023. ST1474.2 +122700 MRG-DELETE-023. ST1474.2 +122800 PERFORM DE-LETE. ST1474.2 +122900 GO TO MRG-WRITE-023. ST1474.2 +123000 MRG-FAIL-023. ST1474.2 +123100 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +123200 MOVE WRK-XN-0006 TO CORRECT-A. ST1474.2 +123300 MRG-WRITE-023. ST1474.2 +123400 MOVE "MRG-TEST-023" TO PAR-NAME. ST1474.2 +123500 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +123600 PERFORM PRINT-DETAIL. ST1474.2 +123700*X MOVE SPACES TO PRINT-REC. ST1474.2 +123800*X WRITE PRINT-REC. ST1474.2 +123900 MRG-INIT-024. ST1474.2 +124000 MOVE SPACES TO WRK-XN-X-0001. ST1474.2 +124100 MRG-TEST-024. ST1474.2 +124200 PERFORM RD-3 THRU R3-EXIT VARYING WRK-DU-999-0001 FROM 1 BY 1ST1474.2 +124300 UNTIL WRK-DU-999-0001 IS GREATER THAN 2. ST1474.2 +124400*X MOVE SPACES TO PRINT-REC. ST1474.2 +124500*X WRITE PRINT-REC. ST1474.2 +124600 IF WRK-XN-X-0001 IS NOT EQUAL TO WRK-XN-0007 ST1474.2 +124700 PERFORM FAIL GO TO MRG-FAIL-024 ST1474.2 +124800 ELSE ST1474.2 +124900 PERFORM PASS. ST1474.2 +125000 GO TO MRG-WRITE-024. ST1474.2 +125100 MRG-DELETE-024. ST1474.2 +125200 PERFORM DE-LETE. ST1474.2 +125300 GO TO MRG-WRITE-024. ST1474.2 +125400 MRG-FAIL-024. ST1474.2 +125500 MOVE WRK-XN-X-0001 TO COMPUTED-A. ST1474.2 +125600 MOVE WRK-XN-0007 TO CORRECT-A. ST1474.2 +125700 MRG-WRITE-024. ST1474.2 +125800 MOVE "MRG-TEST-024" TO PAR-NAME. ST1474.2 +125900 MOVE "NATIVE COLL.SEQUENCE " TO FEATURE. ST1474.2 +126000 PERFORM PRINT-DETAIL. ST1474.2 +126100 MOVE NUM-KEY OF KEY-13 TO LAST-REC-NUM. ST1474.2 +126200 MRG-TEST-025. ST1474.2 +126300 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +126400 GO TO MRG-FAIL-025. ST1474.2 +126500 READ SQ-FS5 END PERFORM PASS ST1474.2 +126600 GO TO MRG-WRITE-025. ST1474.2 +126700 GO TO MRG-FAIL-025. ST1474.2 +126800 MRG-DELETE-025. ST1474.2 +126900 PERFORM DE-LETE. ST1474.2 +127000 GO TO MRG-WRITE-025. ST1474.2 +127100 MRG-FAIL-025. ST1474.2 +127200 MOVE "EOF NOT FOUND" TO RE-MARK. ST1474.2 +127300 PERFORM FAIL . ST1474.2 +127400 MRG-WRITE-025. ST1474.2 +127500 MOVE "MRG-TEST-025" TO PAR-NAME. ST1474.2 +127600 MOVE "EOF CHECK SQ-FS5" TO FEATURE. ST1474.2 +127700 PERFORM PRINT-DETAIL. ST1474.2 +127800 MRG-TEST-026. ST1474.2 +127900 IF LAST-REC-NUM IS NOT EQUAL TO 1 ST1474.2 +128000 PERFORM FAIL GO TO MRG-FAIL-026 ST1474.2 +128100 ELSE ST1474.2 +128200 PERFORM PASS. ST1474.2 +128300 GO TO MRG-WRITE-026. ST1474.2 +128400 MRG-DELETE-026. ST1474.2 +128500 PERFORM DE-LETE. ST1474.2 +128600 GO TO MRG-WRITE-026. ST1474.2 +128700 MRG-FAIL-026. ST1474.2 +128800 MOVE LAST-REC-NUM TO COMPUTED-18V0. ST1474.2 +128900 MOVE 1 TO CR-18V0. ST1474.2 +129000 MRG-WRITE-026. ST1474.2 +129100 MOVE "NUMER. SEQ. CHECK" TO FEATURE. ST1474.2 +129200 MOVE "MRG-TEST-026" TO PAR-NAME. ST1474.2 +129300 PERFORM PRINT-DETAIL. ST1474.2 +129400 CLOSE SQ-FS5. ST1474.2 +129500 GO TO CLOSE-FILES. ST1474.2 +129600 ST1474.2 +129700 READ-SQ-FS5 SECTION. ST1474.2 +129800 RD-3. ST1474.2 +129900 IF WRK-DU-9-0001 IS NOT EQUAL TO ZERO ST1474.2 +130000 GO TO R3-EXIT. ST1474.2 +130100 READ SQ-FS5 AT END GO TO PREMATURE-EOF-3. ST1474.2 +130200*X WRITE PRINT-REC FROM SQ-FS5R1-F-G-132. ST1474.2 +130300*X WRITE PRINT-REC FROM REST-OF-5. ST1474.2 +130400*X MOVE SPACES TO PRINT-REC. ST1474.2 +130500 MOVE ALPHAN-KEY OF KEY-14 TO COMPU (WRK-DU-999-0001). ST1474.2 +130600 GO TO R3-EXIT. ST1474.2 +130700 PREMATURE-EOF-3. ST1474.2 +130800 MOVE 1 TO WRK-DU-9-0001. ST1474.2 +130900 MOVE "PREMATURE EOF FOUND" TO RE-MARK. ST1474.2 +131000 R3-EXIT. ST1474.2 +131100 EXIT. ST1474.2 +131200* ST1474.2 +131300 CCVS-EXIT SECTION. ST1474.2 +131400 CCVS-999999. ST1474.2 +131500 GO TO CLOSE-FILES. ST1474.2 diff --git a/tests/cobol85/ST/ST301M.CBL b/tests/cobol85/ST/ST301M.CBL new file mode 100755 index 00000000..d74b1237 --- /dev/null +++ b/tests/cobol85/ST/ST301M.CBL @@ -0,0 +1,84 @@ +000100 IDENTIFICATION DIVISION. ST3014.2 +000200 PROGRAM-ID. ST3014.2 +000300 ST301M. ST3014.2 +000400*The following program tests the flagging of intermediate ST3014.2 +000500*subset features that are used in sort-merge functions ST3014.2 +000600 ENVIRONMENT DIVISION. ST3014.2 +000700 CONFIGURATION SECTION. ST3014.2 +000800 SOURCE-COMPUTER. ST3014.2 +000900 Linux. ST3014.2 +001000 OBJECT-COMPUTER. ST3014.2 +001100 Linux. ST3014.2 +001200 INPUT-OUTPUT SECTION. ST3014.2 +001300 FILE-CONTROL. ST3014.2 +001400 SELECT TFIL ASSIGN ST3014.2 +001500 "XXXXX027". ST3014.2 +001600 SELECT TFIL-2 ASSIGN ST3014.2 +001700 "XXXXX001" ST3014.2 +001800 ACCESS MODE IS SEQUENTIAL. ST3014.2 +001900 SELECT TFIL-3 ASSIGN ST3014.2 +002000 "XXXXX002" ST3014.2 +002100 ACCESS MODE IS SEQUENTIAL. ST3014.2 +002200 SELECT TFIL-4 ASSIGN ST3014.2 +002300 "XXXXX003" ST3014.2 +002400 ACCESS MODE IS SEQUENTIAL. ST3014.2 +002500 SELECT TFIL-5 ASSIGN ST3014.2 +002600 "XXXXX004" ST3014.2 +002700 ACCESS MODE IS SEQUENTIAL. ST3014.2 +002800 ST3014.2 +002900 I-O-CONTROL. ST3014.2 +003000 SAME SORT-MERGE AREA FOR TFIL-5, TFIL. ST3014.2 +003100*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +003200 DATA DIVISION. ST3014.2 +003300 FILE SECTION. ST3014.2 +003400 SD TFIL. ST3014.2 +003500*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +003600 01 FREC. ST3014.2 +003700 03 DATA-1 PIC X(80). ST3014.2 +003800 ST3014.2 +003900 FD TFIL-2. ST3014.2 +004000 01 FREC-2. ST3014.2 +004100 03 DATA-2 PIC X(80). ST3014.2 +004200 ST3014.2 +004300 FD TFIL-3. ST3014.2 +004400 01 FREC-3. ST3014.2 +004500 03 DATA-3 PIC X(80). ST3014.2 +004600 ST3014.2 +004700 FD TFIL-4. ST3014.2 +004800 01 FREC-4. ST3014.2 +004900 03 DATA-4 PIC X(80). ST3014.2 +005000 ST3014.2 +005100 FD TFIL-5. ST3014.2 +005200 01 FREC-5. ST3014.2 +005300 03 DATA-5 PIC X(80). ST3014.2 +005400 ST3014.2 +005500 PROCEDURE DIVISION. ST3014.2 +005600 ST3014.2 +005700 ST301M-CONTROL. ST3014.2 +005800 PERFORM ST301M-MERGE THRU ST301M-SORT 1 TIMES. ST3014.2 +005900 STOP RUN. ST3014.2 +006000 ST3014.2 +006100 ST301M-MERGE. ST3014.2 +006200 MERGE TFIL ON ASCENDING KEY DATA-1 ST3014.2 +006300 USING TFIL-2 TFIL-3 ST3014.2 +006400 OUTPUT PROCEDURE IS ST301M-RETURN. ST3014.2 +006500 ST3014.2 +006600*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +006700 ST3014.2 +006800 ST301M-RELEASE. ST3014.2 +006900 RELEASE FREC. ST3014.2 +007000*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +007100 ST3014.2 +007200 ST301M-RETURN. ST3014.2 +007300 RETURN TFIL RECORD ST3014.2 +007400 AT END DISPLAY "AT END". ST3014.2 +007500*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +007600 ST3014.2 +007700 ST301M-SORT. ST3014.2 +007800 SORT TFIL ON ASCENDING KEY DATA-1 ST3014.2 +007900 INPUT PROCEDURE IS ST301M-RELEASE ST3014.2 +008000 GIVING TFIL-4. ST3014.2 +008100*Message expected for above statement: NON-CONFORMING STANDARD ST3014.2 +008200 ST3014.2 +008300 ST3014.2 +008400*TOTAL NUMBER OF FLAGS EXPECTED = 6. ST3014.2 diff --git a/tests/cobol85/copy/ALTLB b/tests/cobol85/copy/ALTLB new file mode 100755 index 00000000..f083030c --- /dev/null +++ b/tests/cobol85/copy/ALTLB @@ -0,0 +1,5 @@ +000100* THIS TEXT MUST BE PLACED IN THE LIBRARY WHOSE NAME IS ALTLB4.2 +000200* EQUATED TO THE X-47 (XXXXX047) CARD. ALTLB4.2 +000300 MOVE SPACES TO RE-MARK. ALTLB4.2 +000400 PERFORM PASS. ALTLB4.2 +000500 SUBTRACT 1 FROM ERROR-COUNTER. ALTLB4.2 diff --git a/tests/cobol85/copy/K101A b/tests/cobol85/copy/K101A new file mode 100755 index 00000000..b944fad2 --- /dev/null +++ b/tests/cobol85/copy/K101A @@ -0,0 +1,3 @@ +000100 . K101A4.2 +000200 02 TST-FLD-1 PICTURE 9(5). K101A4.2 +000300 02 FILLER PICTURE X(115). K101A4.2 diff --git a/tests/cobol85/copy/K1DAA b/tests/cobol85/copy/K1DAA new file mode 100755 index 00000000..c7e2518e --- /dev/null +++ b/tests/cobol85/copy/K1DAA @@ -0,0 +1,5 @@ +000100 SELECT RL-FS1 K1DAA4.2 +000200 ASSIGN TO K1DAA4.2 +000300 "XXXXX021" K1DAA4.2 +000400 ORGANIZATION IS RELATIVE K1DAA4.2 +000500 ACCESS IS SEQUENTIAL. K1DAA4.2 diff --git a/tests/cobol85/copy/K1FDA b/tests/cobol85/copy/K1FDA new file mode 100755 index 00000000..cb3188ce --- /dev/null +++ b/tests/cobol85/copy/K1FDA @@ -0,0 +1,7 @@ +000100 LABEL RECORDS STANDARD K1FDA4.2 +000200*C VALUE OF K1FDA4.2 +000300*C OCLABELID K1FDA4.2 +000400*C IS K1FDA4.2 +000500*C "OCDUMMY" K1FDA4.2 +000600*G SYSIN K1FDA4.2 +000700 DATA RECORD IS TST-TEST. K1FDA4.2 diff --git a/tests/cobol85/copy/K1P01 b/tests/cobol85/copy/K1P01 new file mode 100755 index 00000000..5281a6f1 --- /dev/null +++ b/tests/cobol85/copy/K1P01 @@ -0,0 +1 @@ +000100 RCD-1 K1P014.2 diff --git a/tests/cobol85/copy/K1PRA b/tests/cobol85/copy/K1PRA new file mode 100755 index 00000000..41b8820f --- /dev/null +++ b/tests/cobol85/copy/K1PRA @@ -0,0 +1 @@ +000100 MOVE PROC-1 TO PROC-2. K1PRA4.2 diff --git a/tests/cobol85/copy/K1PRB b/tests/cobol85/copy/K1PRB new file mode 100755 index 00000000..607d552d --- /dev/null +++ b/tests/cobol85/copy/K1PRB @@ -0,0 +1,3 @@ +000100 MOVE WSTR4C TO WSTR91. K1PRB4.2 +000200 MOVE WSTR4B TO WSTR93. K1PRB4.2 +000300 MOVE WSTR4A TO WSTR92. K1PRB4.2 diff --git a/tests/cobol85/copy/K1PRC b/tests/cobol85/copy/K1PRC new file mode 100755 index 00000000..0abe3a6a --- /dev/null +++ b/tests/cobol85/copy/K1PRC @@ -0,0 +1 @@ +000100 IF Z-E-R-O-E-S EQUAL TO O-N-E - 1 K1PRC4.2 diff --git a/tests/cobol85/copy/K1SEA b/tests/cobol85/copy/K1SEA new file mode 100755 index 00000000..d2edb2a8 --- /dev/null +++ b/tests/cobol85/copy/K1SEA @@ -0,0 +1,8 @@ +000100 SECT-COPY-1. K1SEA4.2 +000200 MOVE 95427 TO COPYSECT-1. K1SEA4.2 +000300 SECT-COPY-2. K1SEA4.2 +000400 MOVE 23121 TO COPYSECT-2. K1SEA4.2 +000500 SECT-COPY-3. K1SEA4.2 +000600 MOVE "LIBCO" TO COPYSECT-3. K1SEA4.2 +000700 SECT-COPY-4. K1SEA4.2 +000800 MOVE "PYTST" TO COPYSECT-4. K1SEA4.2 diff --git a/tests/cobol85/copy/K1W01 b/tests/cobol85/copy/K1W01 new file mode 100755 index 00000000..a6e59ce3 --- /dev/null +++ b/tests/cobol85/copy/K1W01 @@ -0,0 +1,2 @@ +000100 PICTURE 9(5) VALUE 97523. K1W014.2 +000200 77 RCD-2 PICTURE 9(5) VALUE 23497. K1W014.2 diff --git a/tests/cobol85/copy/K1W02 b/tests/cobol85/copy/K1W02 new file mode 100755 index 00000000..32314bb8 --- /dev/null +++ b/tests/cobol85/copy/K1W02 @@ -0,0 +1,2 @@ +000100 RCD-4 PIC 9(5) VALUE 02734. K1W024.2 +000200 77 RCD-5 PICTURE IS 99999 VALUE IS K1W024.2 diff --git a/tests/cobol85/copy/K1W03 b/tests/cobol85/copy/K1W03 new file mode 100755 index 00000000..6804b21c --- /dev/null +++ b/tests/cobol85/copy/K1W03 @@ -0,0 +1 @@ +000100 RCD-7 PIC 9(5) K1W034.2 diff --git a/tests/cobol85/copy/K1W04 b/tests/cobol85/copy/K1W04 new file mode 100755 index 00000000..9385ff30 --- /dev/null +++ b/tests/cobol85/copy/K1W04 @@ -0,0 +1,5 @@ +000100 01 GRP-001. K1W044.2 +000200 02 WRK-DS-05V00 PIC S9(5) K1W044.2 +000300 VALUE K1W044.2 +000400 IS K1W044.2 +000500 ZERO. K1W044.2 diff --git a/tests/cobol85/copy/K1WKA b/tests/cobol85/copy/K1WKA new file mode 100755 index 00000000..fcf4d680 --- /dev/null +++ b/tests/cobol85/copy/K1WKA @@ -0,0 +1,2 @@ +000100 02 WSTR-2A PICTURE X(3) VALUE "AK1WKA4.2 +000200- "BC". K1WKA4.2 diff --git a/tests/cobol85/copy/K1WKB b/tests/cobol85/copy/K1WKB new file mode 100755 index 00000000..a6fd40f6 --- /dev/null +++ b/tests/cobol85/copy/K1WKB @@ -0,0 +1,3 @@ +000100 02 WSTR4A PICTURE XXX VALUE "ABC". K1WKB4.2 +000200 02 WSTR4B PICTURE XXX VALUE "DEF". K1WKB4.2 +000300 02 WSTR4C PICTURE XXX VALUE "GHI". K1WKB4.2 diff --git a/tests/cobol85/copy/K1WKC b/tests/cobol85/copy/K1WKC new file mode 100755 index 00000000..edd01e86 --- /dev/null +++ b/tests/cobol85/copy/K1WKC @@ -0,0 +1,2 @@ +000100 01 Z-E-R-O-E-S PICTURE 9(2) VALUE ZEROES. K1WKC4.2 +000200 01 O-N-E PICTURE 9(2) VALUE 01. K1WKC4.2 diff --git a/tests/cobol85/copy/K1WKY b/tests/cobol85/copy/K1WKY new file mode 100755 index 00000000..0aaeb976 --- /dev/null +++ b/tests/cobol85/copy/K1WKY @@ -0,0 +1,2 @@ +000100 02 WSTR-2A PICTURE XXX VALUE "AK1WKY4.2 +000200- "BC". K1WKY4.2 diff --git a/tests/cobol85/copy/K1WKZ b/tests/cobol85/copy/K1WKZ new file mode 100755 index 00000000..0ac81967 --- /dev/null +++ b/tests/cobol85/copy/K1WKZ @@ -0,0 +1,3 @@ +000100 02 WSTR4A PICTURE XXX VALUE "ABC". K1WKZ4.2 +000200 02 WSTR4B PICTURE XXX VALUE "DEF". K1WKZ4.2 +000300 02 WSTR4C PICTURE XXX VALUE "GHI". K1WKZ4.2 diff --git a/tests/cobol85/copy/K2PRA b/tests/cobol85/copy/K2PRA new file mode 100755 index 00000000..407bbcde --- /dev/null +++ b/tests/cobol85/copy/K2PRA @@ -0,0 +1,7 @@ +000100 MOVE FALSE-DATA-1 TO AREA-1. K2PRA4.2 +000200 MOVE FALSE-DATA-2 TO AREA-2. K2PRA4.2 +000300 MOVE FALSE-DATA-3 TO AREA-3. K2PRA4.2 +000400 MOVE FALSE-DATA-4 TO AREA-4. K2PRA4.2 +000500 IF TOTAL-AREA EQUAL TO "TRUE TWO + 2 = 4" K2PRA4.2 +000600 PERFORM PASS ELSE PERFORM FAIL. K2PRA4.2 +000700 GO TO COPY-WRITE-16. K2PRA4.2 diff --git a/tests/cobol85/copy/K2SEA b/tests/cobol85/copy/K2SEA new file mode 100755 index 00000000..bd262a59 --- /dev/null +++ b/tests/cobol85/copy/K2SEA @@ -0,0 +1,10 @@ +000100 PARA-1. K2SEA4.2 +rogerw GO TO PARA-4. +000300 PARA-2. K2SEA4.2 +000400 GO TO 12345. K2SEA4.2 +000500 12345. K2SEA4.2 +000600 PERFORM FAIL. K2SEA4.2 +000700 GO TO COPY-WRITE-15. K2SEA4.2 +000800 PARA-4. K2SEA4.2 +000900 PERFORM DUMMY-PASS. K2SEA4.2 +001000 GO TO COPY-WRITE-15. K2SEA4.2 diff --git a/tests/cobol85/copy/K3FCA b/tests/cobol85/copy/K3FCA new file mode 100755 index 00000000..4b582248 --- /dev/null +++ b/tests/cobol85/copy/K3FCA @@ -0,0 +1,6 @@ +000100 SELECT TEST-FILE ASSIGN TO K3FCA4.2 +000200 "XXXXX001". K3FCA4.2 +000300 SELECT TEST-FILE2 ASSIGN TO K3FCA4.2 +000400 "XXXXX002". K3FCA4.2 +000500 SELECT PRINT-FILE ASSIGN TO K3FCA4.2 +000600 "report.log". K3FCA4.2 diff --git a/tests/cobol85/copy/K3FCB b/tests/cobol85/copy/K3FCB new file mode 100755 index 00000000..96b2e5f8 --- /dev/null +++ b/tests/cobol85/copy/K3FCB @@ -0,0 +1,4 @@ +000100 SELECT PRINT-FILE ASSIGN TO K3FCB4.2 +000200 "report.log". K3FCB4.2 +000300 SELECT DUMMY-TEST-FILE ASSIGN TO K3FCB4.2 +000400 "XXXXX002". K3FCB4.2 diff --git a/tests/cobol85/copy/K3IOA b/tests/cobol85/copy/K3IOA new file mode 100755 index 00000000..3c49c77a --- /dev/null +++ b/tests/cobol85/copy/K3IOA @@ -0,0 +1,2 @@ +000100 SAME AREA FOR TEST-FILE K3IOA4.2 +000200 TEST-FILE2. K3IOA4.2 diff --git a/tests/cobol85/copy/K3IOB b/tests/cobol85/copy/K3IOB new file mode 100755 index 00000000..7f1a3595 --- /dev/null +++ b/tests/cobol85/copy/K3IOB @@ -0,0 +1 @@ +000100 SAME RECORD AREA FOR TEST-FILE, DUMMY-PRINT-FILE. K3IOB4.2 diff --git a/tests/cobol85/copy/K3LGE b/tests/cobol85/copy/K3LGE new file mode 100755 index 00000000..972d2826 --- /dev/null +++ b/tests/cobol85/copy/K3LGE @@ -0,0 +1,6 @@ +000100 MOVE 1 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADDK3LGE4.2 +000200 1 TO WRK-DU-99, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-99, ADD 1K3LGE4.2 +000300 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 K3LGE4.2 +000400 TO WRK-DU-9, ADD 1 TO WRK-DU-9, ADD 1 TO WRK-DU-99, ADD 1 TO K3LGE4.2 +000500 WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 1 TO WRK-DU-99, ADD 10 TO K3LGE4.2 +000600 WRK-DU-99-LONGER. K3LGE4.2 diff --git a/tests/cobol85/copy/K3OCA b/tests/cobol85/copy/K3OCA new file mode 100755 index 00000000..90f75605 --- /dev/null +++ b/tests/cobol85/copy/K3OCA @@ -0,0 +1 @@ +000100 Linux. K3OCA4.2 diff --git a/tests/cobol85/copy/K3SCA b/tests/cobol85/copy/K3SCA new file mode 100755 index 00000000..60b334b4 --- /dev/null +++ b/tests/cobol85/copy/K3SCA @@ -0,0 +1 @@ +000100 Linux. K3SCA4.2 diff --git a/tests/cobol85/copy/K3SML b/tests/cobol85/copy/K3SML new file mode 100755 index 00000000..fd5d539c --- /dev/null +++ b/tests/cobol85/copy/K3SML @@ -0,0 +1 @@ +000100 8 K3SML4.2 diff --git a/tests/cobol85/copy/K3SNA b/tests/cobol85/copy/K3SNA new file mode 100755 index 00000000..3f62e811 --- /dev/null +++ b/tests/cobol85/copy/K3SNA @@ -0,0 +1 @@ +000100 DECIMAL-POINT IS COMMA. K3SNA4.2 diff --git a/tests/cobol85/copy/K3SNB b/tests/cobol85/copy/K3SNB new file mode 100755 index 00000000..91ce0189 --- /dev/null +++ b/tests/cobol85/copy/K3SNB @@ -0,0 +1,4 @@ +000100 SWITCH-1 K3SNB4.2 +000200 IS DUMMY-SW-1 K3SNB4.2 +000300 ON STATUS IS DUMMY-ON K3SNB4.2 +000400 OFF STATUS IS DUMMY-OFF. K3SNB4.2 diff --git a/tests/cobol85/copy/K4NTA b/tests/cobol85/copy/K4NTA new file mode 100755 index 00000000..434c5e45 --- /dev/null +++ b/tests/cobol85/copy/K4NTA @@ -0,0 +1,3 @@ +000100 NOTEPAR1-FAIL. K4NTA4.2 +000200 PERFORM FAIL. K4NTA4.2 +000300 GO TO COPY-WRITE-1. K4NTA4.2 diff --git a/tests/cobol85/copy/K501A b/tests/cobol85/copy/K501A new file mode 100755 index 00000000..5aa55c51 --- /dev/null +++ b/tests/cobol85/copy/K501A @@ -0,0 +1,8 @@ +000100 02 KEYS-GROUP. K501A4.2 +000200 03 KEY-1 PICTURE 9. K501A4.2 +000300 03 KEY-2 PICTURE 99. K501A4.2 +000400 03 KEY-3 PICTURE 999. K501A4.2 +000500 03 KEY-4 PICTURE 9999. K501A4.2 +000600 03 KEY-5 PICTURE 99999. K501A4.2 +000700 02 RDF-KEYS REDEFINES KEYS-GROUP PICTURE 9(15). K501A4.2 +000800 02 FILLER PICTURE X(105). K501A4.2 diff --git a/tests/cobol85/copy/K501B b/tests/cobol85/copy/K501B new file mode 100755 index 00000000..6705bbc1 --- /dev/null +++ b/tests/cobol85/copy/K501B @@ -0,0 +1,8 @@ +000100 02 KEYS-GROUP. K501B4.2 +000200 03 KEY-A PICTURE 9. K501B4.2 +000300 03 KEY-2 PICTURE 99. K501B4.2 +000400 03 KEY-3 PICTURE 999. K501B4.2 +000500 03 KEY-4 PICTURE 9999. K501B4.2 +000600 03 KEY-5 PICTURE 99999. K501B4.2 +000700 02 XYZ-KEYS REDEFINES KEYS-GROUP PICTURE 9(15). K501B4.2 +000800 02 FILLER PICTURE X(105). K501B4.2 diff --git a/tests/cobol85/copy/K5SDA b/tests/cobol85/copy/K5SDA new file mode 100755 index 00000000..5788e8df --- /dev/null +++ b/tests/cobol85/copy/K5SDA @@ -0,0 +1 @@ +000100 DATA RECORD S-RECORD. K5SDA4.2 diff --git a/tests/cobol85/copy/K5SDB b/tests/cobol85/copy/K5SDB new file mode 100755 index 00000000..0773bcc6 --- /dev/null +++ b/tests/cobol85/copy/K5SDB @@ -0,0 +1 @@ +000100 DATA RECORD J-RECORD. K5SDB4.2 diff --git a/tests/cobol85/copy/K6SCA b/tests/cobol85/copy/K6SCA new file mode 100755 index 00000000..215e51a2 --- /dev/null +++ b/tests/cobol85/copy/K6SCA @@ -0,0 +1,290 @@ +000100 CONFIGURATION SECTION. K6SCA4.2 +000200 SOURCE-COMPUTER. K6SCA4.2 +000300 Linux. K6SCA4.2 +000400 OBJECT-COMPUTER. K6SCA4.2 +000500 Linux. K6SCA4.2 +000600 INPUT-OUTPUT SECTION. K6SCA4.2 +000700 FILE-CONTROL. K6SCA4.2 +000800 SELECT PRINT-FILE ASSIGN TO K6SCA4.2 +000900 "report.log". K6SCA4.2 +001000 DATA DIVISION. K6SCA4.2 +001100 FILE SECTION. K6SCA4.2 +001200 FD PRINT-FILE. K6SCA4.2 +001300 01 PRINT-REC PICTURE X(120). K6SCA4.2 +001400 01 DUMMY-RECORD PICTURE X(120). K6SCA4.2 +001500 WORKING-STORAGE SECTION. K6SCA4.2 +001600 01 TEST-RESULTS. K6SCA4.2 +001700 02 FILLER PIC X VALUE SPACE. K6SCA4.2 +001800 02 FEATURE PIC X(20) VALUE SPACE. K6SCA4.2 +001900 02 FILLER PIC X VALUE SPACE. K6SCA4.2 +002000 02 P-OR-F PIC X(5) VALUE SPACE. K6SCA4.2 +002100 02 FILLER PIC X VALUE SPACE. K6SCA4.2 +002200 02 PAR-NAME. K6SCA4.2 +002300 03 FILLER PIC X(19) VALUE SPACE. K6SCA4.2 +002400 03 PARDOT-X PIC X VALUE SPACE. K6SCA4.2 +002500 03 DOTVALUE PIC 99 VALUE ZERO. K6SCA4.2 +002600 02 FILLER PIC X(8) VALUE SPACE. K6SCA4.2 +002700 02 RE-MARK PIC X(61). K6SCA4.2 +002800 01 TEST-COMPUTED. K6SCA4.2 +002900 02 FILLER PIC X(30) VALUE SPACE. K6SCA4.2 +003000 02 FILLER PIC X(17) VALUE K6SCA4.2 +003100 " COMPUTED=". K6SCA4.2 +003200 02 COMPUTED-X. K6SCA4.2 +003300 03 COMPUTED-A PIC X(20) VALUE SPACE. K6SCA4.2 +003400 03 COMPUTED-N REDEFINES COMPUTED-A K6SCA4.2 +003500 PIC -9(9).9(9). K6SCA4.2 +003600 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). K6SCA4.2 +003700 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). K6SCA4.2 +003800 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). K6SCA4.2 +003900 03 CM-18V0 REDEFINES COMPUTED-A. K6SCA4.2 +004000 04 COMPUTED-18V0 PIC -9(18). K6SCA4.2 +004100 04 FILLER PIC X. K6SCA4.2 +004200 03 FILLER PIC X(50) VALUE SPACE. K6SCA4.2 +004300 01 TEST-CORRECT. K6SCA4.2 +004400 02 FILLER PIC X(30) VALUE SPACE. K6SCA4.2 +004500 02 FILLER PIC X(17) VALUE " CORRECT =". K6SCA4.2 +004600 02 CORRECT-X. K6SCA4.2 +004700 03 CORRECT-A PIC X(20) VALUE SPACE. K6SCA4.2 +004800 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). K6SCA4.2 +004900 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). K6SCA4.2 +005000 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). K6SCA4.2 +005100 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). K6SCA4.2 +005200 03 CR-18V0 REDEFINES CORRECT-A. K6SCA4.2 +005300 04 CORRECT-18V0 PIC -9(18). K6SCA4.2 +005400 04 FILLER PIC X. K6SCA4.2 +005500 03 FILLER PIC X(2) VALUE SPACE. K6SCA4.2 +005600 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. K6SCA4.2 +005700 01 CCVS-C-1. K6SCA4.2 +005800 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAK6SCA4.2 +005900- "SS PARAGRAPH-NAME K6SCA4.2 +006000- " REMARKS". K6SCA4.2 +006100 02 FILLER PIC X(20) VALUE SPACE. K6SCA4.2 +006200 01 CCVS-C-2. K6SCA4.2 +006300 02 FILLER PIC X VALUE SPACE. K6SCA4.2 +006400 02 FILLER PIC X(6) VALUE "TESTED". K6SCA4.2 +006500 02 FILLER PIC X(15) VALUE SPACE. K6SCA4.2 +006600 02 FILLER PIC X(4) VALUE "FAIL". K6SCA4.2 +006700 02 FILLER PIC X(94) VALUE SPACE. K6SCA4.2 +006800 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. K6SCA4.2 +006900 01 REC-CT PIC 99 VALUE ZERO. K6SCA4.2 +007000 01 DELETE-COUNTER PIC 999 VALUE ZERO. K6SCA4.2 +007100 01 ERROR-COUNTER PIC 999 VALUE ZERO. K6SCA4.2 +007200 01 INSPECT-COUNTER PIC 999 VALUE ZERO. K6SCA4.2 +007300 01 PASS-COUNTER PIC 999 VALUE ZERO. K6SCA4.2 +007400 01 TOTAL-ERROR PIC 999 VALUE ZERO. K6SCA4.2 +007500 01 ERROR-HOLD PIC 999 VALUE ZERO. K6SCA4.2 +007600 01 DUMMY-HOLD PIC X(120) VALUE SPACE. K6SCA4.2 +007700 01 RECORD-COUNT PIC 9(5) VALUE ZERO. K6SCA4.2 +007800 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. K6SCA4.2 +007900 01 CCVS-H-1. K6SCA4.2 +008000 02 FILLER PIC X(39) VALUE SPACES. K6SCA4.2 +008100 02 FILLER PIC X(42) VALUE K6SCA4.2 +008200 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". K6SCA4.2 +008300 02 FILLER PIC X(39) VALUE SPACES. K6SCA4.2 +008400 01 CCVS-H-2A. K6SCA4.2 +008500 02 FILLER PIC X(40) VALUE SPACE. K6SCA4.2 +008600 02 FILLER PIC X(7) VALUE "CCVS85 ". K6SCA4.2 +008700 02 FILLER PIC XXXX VALUE K6SCA4.2 +008800 "4.2 ". K6SCA4.2 +008900 02 FILLER PIC X(28) VALUE K6SCA4.2 +009000 " COPY - NOT FOR DISTRIBUTION". K6SCA4.2 +009100 02 FILLER PIC X(41) VALUE SPACE. K6SCA4.2 +009200 K6SCA4.2 +009300 01 CCVS-H-2B. K6SCA4.2 +009400 02 FILLER PIC X(15) VALUE K6SCA4.2 +009500 "TEST RESULT OF ". K6SCA4.2 +009600 02 TEST-ID PIC X(9). K6SCA4.2 +009700 02 FILLER PIC X(4) VALUE K6SCA4.2 +009800 " IN ". K6SCA4.2 +009900 02 FILLER PIC X(12) VALUE K6SCA4.2 +010000 " HIGH ". K6SCA4.2 +010100 02 FILLER PIC X(22) VALUE K6SCA4.2 +010200 " LEVEL VALIDATION FOR ". K6SCA4.2 +010300 02 FILLER PIC X(58) VALUE K6SCA4.2 +010400 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".K6SCA4.2 +010500 01 CCVS-H-3. K6SCA4.2 +010600 02 FILLER PIC X(34) VALUE K6SCA4.2 +010700 " FOR OFFICIAL USE ONLY ". K6SCA4.2 +010800 02 FILLER PIC X(58) VALUE K6SCA4.2 +010900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".K6SCA4.2 +011000 02 FILLER PIC X(28) VALUE K6SCA4.2 +011100 " COPYRIGHT 1985 ". K6SCA4.2 +011200 01 CCVS-E-1. K6SCA4.2 +011300 02 FILLER PIC X(52) VALUE SPACE. K6SCA4.2 +011400 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". K6SCA4.2 +011500 02 ID-AGAIN PIC X(9). K6SCA4.2 +011600 02 FILLER PIC X(45) VALUE SPACES. K6SCA4.2 +011700 01 CCVS-E-2. K6SCA4.2 +011800 02 FILLER PIC X(31) VALUE SPACE. K6SCA4.2 +011900 02 FILLER PIC X(21) VALUE SPACE. K6SCA4.2 +012000 02 CCVS-E-2-2. K6SCA4.2 +012100 03 ERROR-TOTAL PIC XXX VALUE SPACE. K6SCA4.2 +012200 03 FILLER PIC X VALUE SPACE. K6SCA4.2 +012300 03 ENDER-DESC PIC X(44) VALUE K6SCA4.2 +012400 "ERRORS ENCOUNTERED". K6SCA4.2 +012500 01 CCVS-E-3. K6SCA4.2 +012600 02 FILLER PIC X(22) VALUE K6SCA4.2 +012700 " FOR OFFICIAL USE ONLY". K6SCA4.2 +012800 02 FILLER PIC X(12) VALUE SPACE. K6SCA4.2 +012900 02 FILLER PIC X(58) VALUE K6SCA4.2 +013000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".K6SCA4.2 +013100 02 FILLER PIC X(13) VALUE SPACE. K6SCA4.2 +013200 02 FILLER PIC X(15) VALUE K6SCA4.2 +013300 " COPYRIGHT 1985". K6SCA4.2 +013400 01 CCVS-E-4. K6SCA4.2 +013500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. K6SCA4.2 +013600 02 FILLER PIC X(4) VALUE " OF ". K6SCA4.2 +013700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. K6SCA4.2 +013800 02 FILLER PIC X(40) VALUE K6SCA4.2 +013900 " TESTS WERE EXECUTED SUCCESSFULLY". K6SCA4.2 +014000 01 XXINFO. K6SCA4.2 +014100 02 FILLER PIC X(19) VALUE K6SCA4.2 +014200 "*** INFORMATION ***". K6SCA4.2 +014300 02 INFO-TEXT. K6SCA4.2 +014400 04 FILLER PIC X(8) VALUE SPACE. K6SCA4.2 +014500 04 XXCOMPUTED PIC X(20). K6SCA4.2 +014600 04 FILLER PIC X(5) VALUE SPACE. K6SCA4.2 +014700 04 XXCORRECT PIC X(20). K6SCA4.2 +014800 02 INF-ANSI-REFERENCE PIC X(48). K6SCA4.2 +014900 01 HYPHEN-LINE. K6SCA4.2 +015000 02 FILLER PIC IS X VALUE IS SPACE. K6SCA4.2 +015100 02 FILLER PIC IS X(65) VALUE IS "************************K6SCA4.2 +015200- "*****************************************". K6SCA4.2 +015300 02 FILLER PIC IS X(54) VALUE IS "************************K6SCA4.2 +015400- "******************************". K6SCA4.2 +015500 01 CCVS-PGM-ID PIC X(9) VALUE K6SCA4.2 +015600 "K6SCA". K6SCA4.2 +015700 PROCEDURE DIVISION. K6SCA4.2 +015800 CCVS1 SECTION. K6SCA4.2 +015900 OPEN-FILES. K6SCA4.2 +016000 OPEN OUTPUT PRINT-FILE. K6SCA4.2 +016100 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. K6SCA4.2 +016200 MOVE SPACE TO TEST-RESULTS. K6SCA4.2 +016300 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. K6SCA4.2 +016400 GO TO CCVS1-EXIT. K6SCA4.2 +016500 CLOSE-FILES. K6SCA4.2 +016600 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. K6SCA4.2 +016700 TERMINATE-CCVS. K6SCA4.2 +016800*S EXIT PROGRAM. K6SCA4.2 +016900*SERMINATE-CALL. K6SCA4.2 +017000 STOP RUN. K6SCA4.2 +017100 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. K6SCA4.2 +017200 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. K6SCA4.2 +017300 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. K6SCA4.2 +017400 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. K6SCA4.2 +017500 MOVE "****TEST DELETED****" TO RE-MARK. K6SCA4.2 +017600 PRINT-DETAIL. K6SCA4.2 +017700 IF REC-CT NOT EQUAL TO ZERO K6SCA4.2 +017800 MOVE "." TO PARDOT-X K6SCA4.2 +017900 MOVE REC-CT TO DOTVALUE. K6SCA4.2 +018000 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. K6SCA4.2 +018100 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE K6SCA4.2 +018200 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX K6SCA4.2 +018300 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. K6SCA4.2 +018400 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. K6SCA4.2 +018500 MOVE SPACE TO CORRECT-X. K6SCA4.2 +018600 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. K6SCA4.2 +018700 MOVE SPACE TO RE-MARK. K6SCA4.2 +018800 HEAD-ROUTINE. K6SCA4.2 +018900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +019000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +019100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. K6SCA4.2 +019200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. K6SCA4.2 +019300 COLUMN-NAMES-ROUTINE. K6SCA4.2 +019400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +019500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +019600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +019700 END-ROUTINE. K6SCA4.2 +019800 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.K6SCA4.2 +019900 END-RTN-EXIT. K6SCA4.2 +020000 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +020100 END-ROUTINE-1. K6SCA4.2 +020200 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO K6SCA4.2 +020300 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. K6SCA4.2 +020400 ADD PASS-COUNTER TO ERROR-HOLD. K6SCA4.2 +020500* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. K6SCA4.2 +020600 MOVE PASS-COUNTER TO CCVS-E-4-1. K6SCA4.2 +020700 MOVE ERROR-HOLD TO CCVS-E-4-2. K6SCA4.2 +020800 MOVE CCVS-E-4 TO CCVS-E-2-2. K6SCA4.2 +020900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. K6SCA4.2 +021000 END-ROUTINE-12. K6SCA4.2 +021100 MOVE "TEST(S) FAILED" TO ENDER-DESC. K6SCA4.2 +021200 IF ERROR-COUNTER IS EQUAL TO ZERO K6SCA4.2 +021300 MOVE "NO " TO ERROR-TOTAL K6SCA4.2 +021400 ELSE K6SCA4.2 +021500 MOVE ERROR-COUNTER TO ERROR-TOTAL. K6SCA4.2 +021600 MOVE CCVS-E-2 TO DUMMY-RECORD. K6SCA4.2 +021700 PERFORM WRITE-LINE. K6SCA4.2 +021800 END-ROUTINE-13. K6SCA4.2 +021900 IF DELETE-COUNTER IS EQUAL TO ZERO K6SCA4.2 +022000 MOVE "NO " TO ERROR-TOTAL ELSE K6SCA4.2 +022100 MOVE DELETE-COUNTER TO ERROR-TOTAL. K6SCA4.2 +022200 MOVE "TEST(S) DELETED " TO ENDER-DESC. K6SCA4.2 +022300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +022400 IF INSPECT-COUNTER EQUAL TO ZERO K6SCA4.2 +022500 MOVE "NO " TO ERROR-TOTAL K6SCA4.2 +022600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. K6SCA4.2 +022700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. K6SCA4.2 +022800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +022900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. K6SCA4.2 +023000 WRITE-LINE. K6SCA4.2 +023100 ADD 1 TO RECORD-COUNT. K6SCA4.2 +023200 IF RECORD-COUNT GREATER 42 K6SCA4.2 +023300 MOVE DUMMY-RECORD TO DUMMY-HOLD K6SCA4.2 +023400 MOVE SPACE TO DUMMY-RECORD K6SCA4.2 +023500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE K6SCA4.2 +023600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES K6SCA4.2 +023700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES K6SCA4.2 +023800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES K6SCA4.2 +023900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES K6SCA4.2 +024000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN K6SCA4.2 +024100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN K6SCA4.2 +024200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN K6SCA4.2 +024300 MOVE DUMMY-HOLD TO DUMMY-RECORD K6SCA4.2 +024400 MOVE ZERO TO RECORD-COUNT. K6SCA4.2 +024500 PERFORM WRT-LN. K6SCA4.2 +024600 WRT-LN. K6SCA4.2 +024700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. K6SCA4.2 +024800 MOVE SPACE TO DUMMY-RECORD. K6SCA4.2 +024900 BLANK-LINE-PRINT. K6SCA4.2 +025000 PERFORM WRT-LN. K6SCA4.2 +025100 FAIL-ROUTINE. K6SCA4.2 +025200 IF COMPUTED-X NOT EQUAL TO SPACE K6SCA4.2 +025300 GO TO FAIL-ROUTINE-WRITE. K6SCA4.2 +025400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.K6SCA4.2 +025500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. K6SCA4.2 +025600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. K6SCA4.2 +025700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +025800 MOVE SPACES TO INF-ANSI-REFERENCE. K6SCA4.2 +025900 GO TO FAIL-ROUTINE-EX. K6SCA4.2 +026000 FAIL-ROUTINE-WRITE. K6SCA4.2 +026100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE K6SCA4.2 +026200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. K6SCA4.2 +026300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +026400 MOVE SPACES TO COR-ANSI-REFERENCE. K6SCA4.2 +026500 FAIL-ROUTINE-EX. EXIT. K6SCA4.2 +026600 BAIL-OUT. K6SCA4.2 +026700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. K6SCA4.2 +026800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. K6SCA4.2 +026900 BAIL-OUT-WRITE. K6SCA4.2 +027000 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. K6SCA4.2 +027100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. K6SCA4.2 +027200 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. K6SCA4.2 +027300 MOVE SPACES TO INF-ANSI-REFERENCE. K6SCA4.2 +027400 BAIL-OUT-EX. EXIT. K6SCA4.2 +027500 CCVS1-EXIT. K6SCA4.2 +027600 EXIT. K6SCA4.2 +027700 LB106A-INIT SECTION. K6SCA4.2 +027800 LB106A-001. K6SCA4.2 +027900 MOVE " REGARDLESS OF WHAT APPEARS ABOVE OR BELOW, THIS IS THK6SCA4.2 +028000- "E REPORT FOR SM106A" TO PRINT-REC. K6SCA4.2 +028100 PERFORM WRITE-LINE. K6SCA4.2 +028200 PERFORM BLANK-LINE-PRINT. K6SCA4.2 +028300 MOVE " THE PRESENCE OF THIS MESSAGE INDICATES THAT TEXT FK6SCA4.2 +028400- "OR ALL 3 DIVISIONS CAN BE GENERATED BY ONE COPY STATEMENT." K6SCA4.2 +028500 TO PRINT-REC. K6SCA4.2 +028600 PERFORM WRITE-LINE. K6SCA4.2 +028700 PERFORM INSPT. K6SCA4.2 +028800 CCVS-EXIT SECTION. K6SCA4.2 +028900 CCVS-999999. K6SCA4.2 +029000 GO TO CLOSE-FILES. K6SCA4.2 diff --git a/tests/cobol85/copy/K7SEA b/tests/cobol85/copy/K7SEA new file mode 100755 index 00000000..c5375bf4 --- /dev/null +++ b/tests/cobol85/copy/K7SEA @@ -0,0 +1,1599 @@ +000100 COPY-TEST-1. K7SEA4.2 +000200 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +000300 MOVE "COPY-TEST-1 " TO PAR-NAME. K7SEA4.2 +000400 PERFORM PASS. K7SEA4.2 +000500 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +000600 MOVE SPACE TO CORRECT-A. K7SEA4.2 +000700 MOVE SPACE TO RE-MARK. K7SEA4.2 +000800 PERFORM PRINT-DETAIL. K7SEA4.2 +000900 COPY-TEST-2. K7SEA4.2 +001000 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +001100 MOVE "COPY-TEST-2 " TO PAR-NAME. K7SEA4.2 +001200 PERFORM PASS. K7SEA4.2 +001300 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +001400 MOVE SPACE TO CORRECT-A. K7SEA4.2 +001500 MOVE SPACE TO RE-MARK. K7SEA4.2 +001600 PERFORM PRINT-DETAIL. K7SEA4.2 +001700 COPY-TEST-3. K7SEA4.2 +001800 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +001900 MOVE "COPY-TEST-3 " TO PAR-NAME. K7SEA4.2 +002000 PERFORM PASS. K7SEA4.2 +002100 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +002200 MOVE SPACE TO CORRECT-A. K7SEA4.2 +002300 MOVE SPACE TO RE-MARK. K7SEA4.2 +002400 PERFORM PRINT-DETAIL. K7SEA4.2 +002500 COPY-TEST-4. K7SEA4.2 +002600 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +002700 MOVE "COPY-TEST-4 " TO PAR-NAME. K7SEA4.2 +002800 PERFORM PASS. K7SEA4.2 +002900 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +003000 MOVE SPACE TO CORRECT-A. K7SEA4.2 +003100 MOVE SPACE TO RE-MARK. K7SEA4.2 +003200 PERFORM PRINT-DETAIL. K7SEA4.2 +003300 COPY-TEST-5. K7SEA4.2 +003400 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +003500 MOVE "COPY-TEST-5 " TO PAR-NAME. K7SEA4.2 +003600 PERFORM PASS. K7SEA4.2 +003700 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +003800 MOVE SPACE TO CORRECT-A. K7SEA4.2 +003900 MOVE SPACE TO RE-MARK. K7SEA4.2 +004000 PERFORM PRINT-DETAIL. K7SEA4.2 +004100 COPY-TEST-6. K7SEA4.2 +004200 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +004300 MOVE "COPY-TEST-6 " TO PAR-NAME. K7SEA4.2 +004400 PERFORM PASS. K7SEA4.2 +004500 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +004600 MOVE SPACE TO CORRECT-A. K7SEA4.2 +004700 MOVE SPACE TO RE-MARK. K7SEA4.2 +004800 PERFORM PRINT-DETAIL. K7SEA4.2 +004900 COPY-TEST-7. K7SEA4.2 +005000 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +005100 MOVE "COPY-TEST-7 " TO PAR-NAME. K7SEA4.2 +005200 PERFORM PASS. K7SEA4.2 +005300 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +005400 MOVE SPACE TO CORRECT-A. K7SEA4.2 +005500 MOVE SPACE TO RE-MARK. K7SEA4.2 +005600 PERFORM PRINT-DETAIL. K7SEA4.2 +005700 COPY-TEST-8. K7SEA4.2 +005800 MOVE "COPY-TEST-8 " TO PAR-NAME. K7SEA4.2 +005900 PERFORM PASS. K7SEA4.2 +006000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +006100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +006200 MOVE SPACE TO RE-MARK. K7SEA4.2 +006300 PERFORM PRINT-DETAIL. K7SEA4.2 +006400 COPY-TEST-9. K7SEA4.2 +006500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +006600 MOVE "COPY-TEST-9 " TO PAR-NAME. K7SEA4.2 +006700 PERFORM PASS. K7SEA4.2 +006800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +006900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +007000 MOVE SPACE TO RE-MARK. K7SEA4.2 +007100 PERFORM PRINT-DETAIL. K7SEA4.2 +007200 COPY-TEST-10. K7SEA4.2 +007300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +007400 MOVE "COPY-TEST-10 " TO PAR-NAME. K7SEA4.2 +007500 PERFORM PASS. K7SEA4.2 +007600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +007700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +007800 MOVE SPACE TO RE-MARK. K7SEA4.2 +007900 PERFORM PRINT-DETAIL. K7SEA4.2 +008000 COPY-TEST-11. K7SEA4.2 +008100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +008200 MOVE "COPY-TEST-11 " TO PAR-NAME. K7SEA4.2 +008300 PERFORM PASS. K7SEA4.2 +008400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +008500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +008600 MOVE SPACE TO RE-MARK. K7SEA4.2 +008700 PERFORM PRINT-DETAIL. K7SEA4.2 +008800 COPY-TEST-12. K7SEA4.2 +008900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +009000 MOVE "COPY-TEST-12 " TO PAR-NAME. K7SEA4.2 +009100 PERFORM PASS. K7SEA4.2 +009200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +009300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +009400 MOVE SPACE TO RE-MARK. K7SEA4.2 +009500 PERFORM PRINT-DETAIL. K7SEA4.2 +009600 COPY-TEST-13. K7SEA4.2 +009700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +009800 MOVE "COPY-TEST-13 " TO PAR-NAME. K7SEA4.2 +009900 PERFORM PASS. K7SEA4.2 +010000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +010100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +010200 MOVE SPACE TO RE-MARK. K7SEA4.2 +010300 PERFORM PRINT-DETAIL. K7SEA4.2 +010400 COPY-TEST-14. K7SEA4.2 +010500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +010600 MOVE "COPY-TEST-14 " TO PAR-NAME. K7SEA4.2 +010700 PERFORM PASS. K7SEA4.2 +010800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +010900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +011000 MOVE SPACE TO RE-MARK. K7SEA4.2 +011100 PERFORM PRINT-DETAIL. K7SEA4.2 +011200 COPY-TEST-15. K7SEA4.2 +011300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +011400 MOVE "COPY-TEST-15 " TO PAR-NAME. K7SEA4.2 +011500 PERFORM PASS. K7SEA4.2 +011600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +011700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +011800 MOVE SPACE TO RE-MARK. K7SEA4.2 +011900 PERFORM PRINT-DETAIL. K7SEA4.2 +012000 COPY-TEST-16. K7SEA4.2 +012100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +012200 MOVE "COPY-TEST-16 " TO PAR-NAME. K7SEA4.2 +012300 PERFORM PASS. K7SEA4.2 +012400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +012500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +012600 MOVE SPACE TO RE-MARK. K7SEA4.2 +012700 PERFORM PRINT-DETAIL. K7SEA4.2 +012800 COPY-TEST-17. K7SEA4.2 +012900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +013000 MOVE "COPY-TEST-17 " TO PAR-NAME. K7SEA4.2 +013100 PERFORM PASS. K7SEA4.2 +013200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +013300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +013400 MOVE SPACE TO RE-MARK. K7SEA4.2 +013500 PERFORM PRINT-DETAIL. K7SEA4.2 +013600 COPY-TEST-18. K7SEA4.2 +013700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +013800 MOVE "COPY-TEST-18 " TO PAR-NAME. K7SEA4.2 +013900 PERFORM PASS. K7SEA4.2 +014000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +014100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +014200 MOVE SPACE TO RE-MARK. K7SEA4.2 +014300 PERFORM PRINT-DETAIL. K7SEA4.2 +014400 COPY-TEST-19. K7SEA4.2 +014500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +014600 MOVE "COPY-TEST-19 " TO PAR-NAME. K7SEA4.2 +014700 PERFORM PASS. K7SEA4.2 +014800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +014900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +015000 MOVE SPACE TO RE-MARK. K7SEA4.2 +015100 PERFORM PRINT-DETAIL. K7SEA4.2 +015200 COPY-TEST-20. K7SEA4.2 +015300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +015400 MOVE "COPY-TEST-20 " TO PAR-NAME. K7SEA4.2 +015500 PERFORM PASS. K7SEA4.2 +015600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +015700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +015800 MOVE SPACE TO RE-MARK. K7SEA4.2 +015900 PERFORM PRINT-DETAIL. K7SEA4.2 +016000 COPY-TEST-21. K7SEA4.2 +016100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +016200 MOVE "COPY-TEST-21 " TO PAR-NAME. K7SEA4.2 +016300 PERFORM PASS. K7SEA4.2 +016400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +016500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +016600 MOVE SPACE TO RE-MARK. K7SEA4.2 +016700 PERFORM PRINT-DETAIL. K7SEA4.2 +016800 COPY-TEST-2I. K7SEA4.2 +016900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +017000 MOVE "COPY-TEST-22 " TO PAR-NAME. K7SEA4.2 +017100 PERFORM PASS. K7SEA4.2 +017200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +017300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +017400 MOVE SPACE TO RE-MARK. K7SEA4.2 +017500 PERFORM PRINT-DETAIL. K7SEA4.2 +017600 COPY-TEST-23. K7SEA4.2 +017700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +017800 MOVE "COPY-TEST-23 " TO PAR-NAME. K7SEA4.2 +017900 PERFORM PASS. K7SEA4.2 +018000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +018100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +018200 MOVE SPACE TO RE-MARK. K7SEA4.2 +018300 PERFORM PRINT-DETAIL. K7SEA4.2 +018400 COPY-TEST-24. K7SEA4.2 +018500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +018600 MOVE "COPY-TEST-24 " TO PAR-NAME. K7SEA4.2 +018700 PERFORM PASS. K7SEA4.2 +018800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +018900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +019000 MOVE SPACE TO RE-MARK. K7SEA4.2 +019100 PERFORM PRINT-DETAIL. K7SEA4.2 +019200 COPY-TEST-25. K7SEA4.2 +019300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +019400 MOVE "COPY-TEST-25 " TO PAR-NAME. K7SEA4.2 +019500 PERFORM PASS. K7SEA4.2 +019600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +019700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +019800 MOVE SPACE TO RE-MARK. K7SEA4.2 +019900 PERFORM PRINT-DETAIL. K7SEA4.2 +020000 COPY-TEST-26. K7SEA4.2 +020100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +020200 MOVE "COPY-TEST-26 " TO PAR-NAME. K7SEA4.2 +020300 PERFORM PASS. K7SEA4.2 +020400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +020500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +020600 MOVE SPACE TO RE-MARK. K7SEA4.2 +020700 PERFORM PRINT-DETAIL. K7SEA4.2 +020800 COPY-TEST-27. K7SEA4.2 +020900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +021000 MOVE "COPY-TEST-27 " TO PAR-NAME. K7SEA4.2 +021100 PERFORM PASS. K7SEA4.2 +021200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +021300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +021400 MOVE SPACE TO RE-MARK. K7SEA4.2 +021500 PERFORM PRINT-DETAIL. K7SEA4.2 +021600 COPY-TEST-28. K7SEA4.2 +021700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +021800 MOVE "COPY-TEST-28 " TO PAR-NAME. K7SEA4.2 +021900 PERFORM PASS. K7SEA4.2 +022000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +022100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +022200 MOVE SPACE TO RE-MARK. K7SEA4.2 +022300 PERFORM PRINT-DETAIL. K7SEA4.2 +022400 COPY-TEST-29. K7SEA4.2 +022500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +022600 MOVE "COPY-TEST-29 " TO PAR-NAME. K7SEA4.2 +022700 PERFORM PASS. K7SEA4.2 +022800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +022900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +023000 MOVE SPACE TO RE-MARK. K7SEA4.2 +023100 PERFORM PRINT-DETAIL. K7SEA4.2 +023200 COPY-TEST-30. K7SEA4.2 +023300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +023400 MOVE "COPY-TEST-30 " TO PAR-NAME. K7SEA4.2 +023500 PERFORM PASS. K7SEA4.2 +023600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +023700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +023800 MOVE SPACE TO RE-MARK. K7SEA4.2 +023900 PERFORM PRINT-DETAIL. K7SEA4.2 +024000 COPY-TEST-31. K7SEA4.2 +024100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +024200 MOVE "COPY-TEST-31 " TO PAR-NAME. K7SEA4.2 +024300 PERFORM PASS. K7SEA4.2 +024400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +024500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +024600 MOVE SPACE TO RE-MARK. K7SEA4.2 +024700 PERFORM PRINT-DETAIL. K7SEA4.2 +024800 COPY-TEST-32. K7SEA4.2 +024900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +025000 MOVE "COPY-TEST-32 " TO PAR-NAME. K7SEA4.2 +025100 PERFORM PASS. K7SEA4.2 +025200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +025300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +025400 MOVE SPACE TO RE-MARK. K7SEA4.2 +025500 PERFORM PRINT-DETAIL. K7SEA4.2 +025600 COPY-TEST-33. K7SEA4.2 +025700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +025800 MOVE "COPY-TEST-33 " TO PAR-NAME. K7SEA4.2 +025900 PERFORM PASS. K7SEA4.2 +026000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +026100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +026200 MOVE SPACE TO RE-MARK. K7SEA4.2 +026300 PERFORM PRINT-DETAIL. K7SEA4.2 +026400 COPY-TEST-34. K7SEA4.2 +026500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +026600 MOVE "COPY-TEST-34 " TO PAR-NAME. K7SEA4.2 +026700 PERFORM PASS. K7SEA4.2 +026800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +026900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +027000 MOVE SPACE TO RE-MARK. K7SEA4.2 +027100 PERFORM PRINT-DETAIL. K7SEA4.2 +027200 COPY-TEST-35. K7SEA4.2 +027300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +027400 MOVE "COPY-TEST-35 " TO PAR-NAME. K7SEA4.2 +027500 PERFORM PASS. K7SEA4.2 +027600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +027700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +027800 MOVE SPACE TO RE-MARK. K7SEA4.2 +027900 PERFORM PRINT-DETAIL. K7SEA4.2 +028000 COPY-TEST-36. K7SEA4.2 +028100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +028200 MOVE "COPY-TEST-36 " TO PAR-NAME. K7SEA4.2 +028300 PERFORM PASS. K7SEA4.2 +028400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +028500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +028600 MOVE SPACE TO RE-MARK. K7SEA4.2 +028700 PERFORM PRINT-DETAIL. K7SEA4.2 +028800 COPY-TEST-37. K7SEA4.2 +028900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +029000 MOVE "COPY-TEST-37 " TO PAR-NAME. K7SEA4.2 +029100 PERFORM PASS. K7SEA4.2 +029200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +029300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +029400 MOVE SPACE TO RE-MARK. K7SEA4.2 +029500 PERFORM PRINT-DETAIL. K7SEA4.2 +029600 COPY-TEST-38. K7SEA4.2 +029700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +029800 MOVE "COPY-TEST-38 " TO PAR-NAME. K7SEA4.2 +029900 PERFORM PASS. K7SEA4.2 +030000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +030100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +030200 MOVE SPACE TO RE-MARK. K7SEA4.2 +030300 PERFORM PRINT-DETAIL. K7SEA4.2 +030400 COPY-TEST-39. K7SEA4.2 +030500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +030600 MOVE "COPY-TEST-39 " TO PAR-NAME. K7SEA4.2 +030700 PERFORM PASS. K7SEA4.2 +030800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +030900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +031000 MOVE SPACE TO RE-MARK. K7SEA4.2 +031100 PERFORM PRINT-DETAIL. K7SEA4.2 +031200 COPY-TEST-40. K7SEA4.2 +031300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +031400 MOVE "COPY-TEST-40 " TO PAR-NAME. K7SEA4.2 +031500 PERFORM PASS. K7SEA4.2 +031600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +031700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +031800 MOVE SPACE TO RE-MARK. K7SEA4.2 +031900 PERFORM PRINT-DETAIL. K7SEA4.2 +032000 COPY-TEST-41. K7SEA4.2 +032100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +032200 MOVE "COPY-TEST-41 " TO PAR-NAME. K7SEA4.2 +032300 PERFORM PASS. K7SEA4.2 +032400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +032500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +032600 MOVE SPACE TO RE-MARK. K7SEA4.2 +032700 PERFORM PRINT-DETAIL. K7SEA4.2 +032800 COPY-TEST-42. K7SEA4.2 +032900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +033000 MOVE "COPY-TEST-42 " TO PAR-NAME. K7SEA4.2 +033100 PERFORM PASS. K7SEA4.2 +033200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +033300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +033400 MOVE SPACE TO RE-MARK. K7SEA4.2 +033500 PERFORM PRINT-DETAIL. K7SEA4.2 +033600 COPY-TEST-43. K7SEA4.2 +033700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +033800 MOVE "COPY-TEST-43 " TO PAR-NAME. K7SEA4.2 +033900 PERFORM PASS. K7SEA4.2 +034000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +034100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +034200 MOVE SPACE TO RE-MARK. K7SEA4.2 +034300 PERFORM PRINT-DETAIL. K7SEA4.2 +034400 COPY-TEST-44. K7SEA4.2 +034500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +034600 MOVE "COPY-TEST-44 " TO PAR-NAME. K7SEA4.2 +034700 PERFORM PASS. K7SEA4.2 +034800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +034900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +035000 MOVE SPACE TO RE-MARK. K7SEA4.2 +035100 PERFORM PRINT-DETAIL. K7SEA4.2 +035200 COPY-TEST-45. K7SEA4.2 +035300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +035400 MOVE "COPY-TEST-45 " TO PAR-NAME. K7SEA4.2 +035500 PERFORM PASS. K7SEA4.2 +035600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +035700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +035800 MOVE SPACE TO RE-MARK. K7SEA4.2 +035900 PERFORM PRINT-DETAIL. K7SEA4.2 +036000 COPY-TEST-46. K7SEA4.2 +036100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +036200 MOVE "COPY-TEST-46 " TO PAR-NAME. K7SEA4.2 +036300 PERFORM PASS. K7SEA4.2 +036400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +036500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +036600 MOVE SPACE TO RE-MARK. K7SEA4.2 +036700 PERFORM PRINT-DETAIL. K7SEA4.2 +036800 COPY-TEST-47. K7SEA4.2 +036900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +037000 MOVE "COPY-TEST-47 " TO PAR-NAME. K7SEA4.2 +037100 PERFORM PASS. K7SEA4.2 +037200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +037300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +037400 MOVE SPACE TO RE-MARK. K7SEA4.2 +037500 PERFORM PRINT-DETAIL. K7SEA4.2 +037600 COPY-TEST-48. K7SEA4.2 +037700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +037800 MOVE "COPY-TEST-48 " TO PAR-NAME. K7SEA4.2 +037900 PERFORM PASS. K7SEA4.2 +038000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +038100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +038200 MOVE SPACE TO RE-MARK. K7SEA4.2 +038300 PERFORM PRINT-DETAIL. K7SEA4.2 +038400 COPY-TEST-49. K7SEA4.2 +038500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +038600 MOVE "COPY-TEST-49 " TO PAR-NAME. K7SEA4.2 +038700 PERFORM PASS. K7SEA4.2 +038800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +038900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +039000 MOVE SPACE TO RE-MARK. K7SEA4.2 +039100 PERFORM PRINT-DETAIL. K7SEA4.2 +039200 COPY-TEST-50. K7SEA4.2 +039300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +039400 MOVE "COPY-TEST-50 " TO PAR-NAME. K7SEA4.2 +039500 PERFORM PASS. K7SEA4.2 +039600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +039700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +039800 MOVE SPACE TO RE-MARK. K7SEA4.2 +039900 PERFORM PRINT-DETAIL. K7SEA4.2 +040000 COPY-TEST-51. K7SEA4.2 +040100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +040200 MOVE "COPY-TEST-51 " TO PAR-NAME. K7SEA4.2 +040300 PERFORM PASS. K7SEA4.2 +040400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +040500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +040600 MOVE SPACE TO RE-MARK. K7SEA4.2 +040700 PERFORM PRINT-DETAIL. K7SEA4.2 +040800 COPY-TEST-52. K7SEA4.2 +040900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +041000 MOVE "COPY-TEST-52 " TO PAR-NAME. K7SEA4.2 +041100 PERFORM PASS. K7SEA4.2 +041200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +041300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +041400 MOVE SPACE TO RE-MARK. K7SEA4.2 +041500 PERFORM PRINT-DETAIL. K7SEA4.2 +041600 COPY-TEST-53. K7SEA4.2 +041700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +041800 MOVE "COPY-TEST-53 " TO PAR-NAME. K7SEA4.2 +041900 PERFORM PASS. K7SEA4.2 +042000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +042100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +042200 MOVE SPACE TO RE-MARK. K7SEA4.2 +042300 PERFORM PRINT-DETAIL. K7SEA4.2 +042400 COPY-TEST-54. K7SEA4.2 +042500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +042600 MOVE "COPY-TEST-54 " TO PAR-NAME. K7SEA4.2 +042700 PERFORM PASS. K7SEA4.2 +042800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +042900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +043000 MOVE SPACE TO RE-MARK. K7SEA4.2 +043100 PERFORM PRINT-DETAIL. K7SEA4.2 +043200 COPY-TEST-55. K7SEA4.2 +043300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +043400 MOVE "COPY-TEST-55 " TO PAR-NAME. K7SEA4.2 +043500 PERFORM PASS. K7SEA4.2 +043600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +043700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +043800 MOVE SPACE TO RE-MARK. K7SEA4.2 +043900 PERFORM PRINT-DETAIL. K7SEA4.2 +044000 COPY-TEST-56. K7SEA4.2 +044100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +044200 MOVE "COPY-TEST-56 " TO PAR-NAME. K7SEA4.2 +044300 PERFORM PASS. K7SEA4.2 +044400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +044500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +044600 MOVE SPACE TO RE-MARK. K7SEA4.2 +044700 PERFORM PRINT-DETAIL. K7SEA4.2 +044800 COPY-TEST-57. K7SEA4.2 +044900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +045000 MOVE "COPY-TEST-57 " TO PAR-NAME. K7SEA4.2 +045100 PERFORM PASS. K7SEA4.2 +045200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +045300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +045400 MOVE SPACE TO RE-MARK. K7SEA4.2 +045500 PERFORM PRINT-DETAIL. K7SEA4.2 +045600 COPY-TEST-58. K7SEA4.2 +045700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +045800 MOVE "COPY-TEST-58 " TO PAR-NAME. K7SEA4.2 +045900 PERFORM PASS. K7SEA4.2 +046000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +046100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +046200 MOVE SPACE TO RE-MARK. K7SEA4.2 +046300 PERFORM PRINT-DETAIL. K7SEA4.2 +046400 COPY-TEST-59. K7SEA4.2 +046500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +046600 MOVE "COPY-TEST-59 " TO PAR-NAME. K7SEA4.2 +046700 PERFORM PASS. K7SEA4.2 +046800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +046900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +047000 MOVE SPACE TO RE-MARK. K7SEA4.2 +047100 PERFORM PRINT-DETAIL. K7SEA4.2 +047200 COPY-TEST-60. K7SEA4.2 +047300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +047400 MOVE "COPY-TEST-60 " TO PAR-NAME. K7SEA4.2 +047500 PERFORM PASS. K7SEA4.2 +047600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +047700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +047800 MOVE SPACE TO RE-MARK. K7SEA4.2 +047900 PERFORM PRINT-DETAIL. K7SEA4.2 +048000 COPY-TEST-61. K7SEA4.2 +048100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +048200 MOVE "COPY-TEST-61 " TO PAR-NAME. K7SEA4.2 +048300 PERFORM PASS. K7SEA4.2 +048400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +048500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +048600 MOVE SPACE TO RE-MARK. K7SEA4.2 +048700 PERFORM PRINT-DETAIL. K7SEA4.2 +048800 COPY-TEST-62. K7SEA4.2 +048900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +049000 MOVE "COPY-TEST-62 " TO PAR-NAME. K7SEA4.2 +049100 PERFORM PASS. K7SEA4.2 +049200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +049300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +049400 MOVE SPACE TO RE-MARK. K7SEA4.2 +049500 PERFORM PRINT-DETAIL. K7SEA4.2 +049600 COPY-TEST-63. K7SEA4.2 +049700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +049800 MOVE "COPY-TEST-63 " TO PAR-NAME. K7SEA4.2 +049900 PERFORM PASS. K7SEA4.2 +050000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +050100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +050200 MOVE SPACE TO RE-MARK. K7SEA4.2 +050300 PERFORM PRINT-DETAIL. K7SEA4.2 +050400 COPY-TEST-64. K7SEA4.2 +050500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +050600 MOVE "COPY-TEST-64 " TO PAR-NAME. K7SEA4.2 +050700 PERFORM PASS. K7SEA4.2 +050800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +050900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +051000 MOVE SPACE TO RE-MARK. K7SEA4.2 +051100 PERFORM PRINT-DETAIL. K7SEA4.2 +051200 COPY-TEST-65. K7SEA4.2 +051300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +051400 MOVE "COPY-TEST-65 " TO PAR-NAME. K7SEA4.2 +051500 PERFORM PASS. K7SEA4.2 +051600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +051700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +051800 MOVE SPACE TO RE-MARK. K7SEA4.2 +051900 PERFORM PRINT-DETAIL. K7SEA4.2 +052000 COPY-TEST-66. K7SEA4.2 +052100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +052200 MOVE "COPY-TEST-66 " TO PAR-NAME. K7SEA4.2 +052300 PERFORM PASS. K7SEA4.2 +052400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +052500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +052600 MOVE SPACE TO RE-MARK. K7SEA4.2 +052700 PERFORM PRINT-DETAIL. K7SEA4.2 +052800 COPY-TEST-67. K7SEA4.2 +052900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +053000 MOVE "COPY-TEST-67 " TO PAR-NAME. K7SEA4.2 +053100 PERFORM PASS. K7SEA4.2 +053200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +053300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +053400 MOVE SPACE TO RE-MARK. K7SEA4.2 +053500 PERFORM PRINT-DETAIL. K7SEA4.2 +053600 COPY-TEST-68. K7SEA4.2 +053700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +053800 MOVE "COPY-TEST-68 " TO PAR-NAME. K7SEA4.2 +053900 PERFORM PASS. K7SEA4.2 +054000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +054100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +054200 MOVE SPACE TO RE-MARK. K7SEA4.2 +054300 PERFORM PRINT-DETAIL. K7SEA4.2 +054400 COPY-TEST-69. K7SEA4.2 +054500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +054600 MOVE "COPY-TEST-69 " TO PAR-NAME. K7SEA4.2 +054700 PERFORM PASS. K7SEA4.2 +054800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +054900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +055000 MOVE SPACE TO RE-MARK. K7SEA4.2 +055100 PERFORM PRINT-DETAIL. K7SEA4.2 +055200 COPY-TEST-70. K7SEA4.2 +055300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +055400 MOVE "COPY-TEST-70 " TO PAR-NAME. K7SEA4.2 +055500 PERFORM PASS. K7SEA4.2 +055600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +055700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +055800 MOVE SPACE TO RE-MARK. K7SEA4.2 +055900 PERFORM PRINT-DETAIL. K7SEA4.2 +056000 COPY-TEST-71. K7SEA4.2 +056100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +056200 MOVE "COPY-TEST-71 " TO PAR-NAME. K7SEA4.2 +056300 PERFORM PASS. K7SEA4.2 +056400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +056500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +056600 MOVE SPACE TO RE-MARK. K7SEA4.2 +056700 PERFORM PRINT-DETAIL. K7SEA4.2 +056800 COPY-TEST-72. K7SEA4.2 +056900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +057000 MOVE "COPY-TEST-72 " TO PAR-NAME. K7SEA4.2 +057100 PERFORM PASS. K7SEA4.2 +057200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +057300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +057400 MOVE SPACE TO RE-MARK. K7SEA4.2 +057500 PERFORM PRINT-DETAIL. K7SEA4.2 +057600 COPY-TEST-73. K7SEA4.2 +057700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +057800 MOVE "COPY-TEST-73 " TO PAR-NAME. K7SEA4.2 +057900 PERFORM PASS. K7SEA4.2 +058000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +058100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +058200 MOVE SPACE TO RE-MARK. K7SEA4.2 +058300 PERFORM PRINT-DETAIL. K7SEA4.2 +058400 COPY-TEST-74. K7SEA4.2 +058500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +058600 MOVE "COPY-TEST-74 " TO PAR-NAME. K7SEA4.2 +058700 PERFORM PASS. K7SEA4.2 +058800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +058900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +059000 MOVE SPACE TO RE-MARK. K7SEA4.2 +059100 PERFORM PRINT-DETAIL. K7SEA4.2 +059200 COPY-TEST-75. K7SEA4.2 +059300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +059400 MOVE "COPY-TEST-75 " TO PAR-NAME. K7SEA4.2 +059500 PERFORM PASS. K7SEA4.2 +059600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +059700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +059800 MOVE SPACE TO RE-MARK. K7SEA4.2 +059900 PERFORM PRINT-DETAIL. K7SEA4.2 +060000 COPY-TEST-76. K7SEA4.2 +060100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +060200 MOVE "COPY-TEST-76 " TO PAR-NAME. K7SEA4.2 +060300 PERFORM PASS. K7SEA4.2 +060400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +060500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +060600 MOVE SPACE TO RE-MARK. K7SEA4.2 +060700 PERFORM PRINT-DETAIL. K7SEA4.2 +060800 COPY-TEST-77. K7SEA4.2 +060900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +061000 MOVE "COPY-TEST-77 " TO PAR-NAME. K7SEA4.2 +061100 PERFORM PASS. K7SEA4.2 +061200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +061300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +061400 MOVE SPACE TO RE-MARK. K7SEA4.2 +061500 PERFORM PRINT-DETAIL. K7SEA4.2 +061600 COPY-TEST-78. K7SEA4.2 +061700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +061800 MOVE "COPY-TEST-78 " TO PAR-NAME. K7SEA4.2 +061900 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +062000 MOVE SPACE TO CORRECT-A. K7SEA4.2 +062100 PERFORM PASS. K7SEA4.2 +062200 MOVE SPACE TO RE-MARK. K7SEA4.2 +062300 PERFORM PRINT-DETAIL. K7SEA4.2 +062400 COPY-TEST-79. K7SEA4.2 +062500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +062600 MOVE "COPY-TEST-79 " TO PAR-NAME. K7SEA4.2 +062700 PERFORM PASS. K7SEA4.2 +062800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +062900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +063000 MOVE SPACE TO RE-MARK. K7SEA4.2 +063100 PERFORM PRINT-DETAIL. K7SEA4.2 +063200 COPY-TEST-80. K7SEA4.2 +063300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +063400 MOVE "COPY-TEST-80 " TO PAR-NAME. K7SEA4.2 +063500 PERFORM PASS. K7SEA4.2 +063600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +063700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +063800 MOVE SPACE TO RE-MARK. K7SEA4.2 +063900 PERFORM PRINT-DETAIL. K7SEA4.2 +064000 COPY-TEST-81. K7SEA4.2 +064100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +064200 MOVE "COPY-TEST-81 " TO PAR-NAME. K7SEA4.2 +064300 PERFORM PASS. K7SEA4.2 +064400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +064500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +064600 MOVE SPACE TO RE-MARK. K7SEA4.2 +064700 PERFORM PRINT-DETAIL. K7SEA4.2 +064800 COPY-TEST-82. K7SEA4.2 +064900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +065000 MOVE "COPY-TEST-82 " TO PAR-NAME. K7SEA4.2 +065100 PERFORM PASS. K7SEA4.2 +065200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +065300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +065400 MOVE SPACE TO RE-MARK. K7SEA4.2 +065500 PERFORM PRINT-DETAIL. K7SEA4.2 +065600 COPY-TEST-83. K7SEA4.2 +065700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +065800 MOVE "COPY-TEST-83 " TO PAR-NAME. K7SEA4.2 +065900 PERFORM PASS. K7SEA4.2 +066000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +066100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +066200 MOVE SPACE TO RE-MARK. K7SEA4.2 +066300 PERFORM PRINT-DETAIL. K7SEA4.2 +066400 COPY-TEST-84. K7SEA4.2 +066500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +066600 MOVE "COPY-TEST-84 " TO PAR-NAME. K7SEA4.2 +066700 PERFORM PASS. K7SEA4.2 +066800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +066900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +067000 MOVE SPACE TO RE-MARK. K7SEA4.2 +067100 PERFORM PRINT-DETAIL. K7SEA4.2 +067200 COPY-TEST-85. K7SEA4.2 +067300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +067400 MOVE "COPY-TEST-85 " TO PAR-NAME. K7SEA4.2 +067500 PERFORM PASS. K7SEA4.2 +067600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +067700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +067800 MOVE SPACE TO RE-MARK. K7SEA4.2 +067900 PERFORM PRINT-DETAIL. K7SEA4.2 +068000 COPY-TEST-86. K7SEA4.2 +068100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +068200 MOVE "COPY-TEST-86 " TO PAR-NAME. K7SEA4.2 +068300 PERFORM PASS. K7SEA4.2 +068400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +068500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +068600 MOVE SPACE TO RE-MARK. K7SEA4.2 +068700 PERFORM PRINT-DETAIL. K7SEA4.2 +068800 COPY-TEST-87. K7SEA4.2 +068900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +069000 MOVE "COPY-TEST-87 " TO PAR-NAME. K7SEA4.2 +069100 PERFORM PASS. K7SEA4.2 +069200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +069300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +069400 MOVE SPACE TO RE-MARK. K7SEA4.2 +069500 PERFORM PRINT-DETAIL. K7SEA4.2 +069600 COPY-TEST-88. K7SEA4.2 +069700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +069800 MOVE "COPY-TEST-88 " TO PAR-NAME. K7SEA4.2 +069900 PERFORM PASS. K7SEA4.2 +070000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +070100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +070200 MOVE SPACE TO RE-MARK. K7SEA4.2 +070300 PERFORM PRINT-DETAIL. K7SEA4.2 +070400 COPY-TEST-89. K7SEA4.2 +070500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +070600 MOVE "COPY-TEST-89 " TO PAR-NAME. K7SEA4.2 +070700 PERFORM PASS. K7SEA4.2 +070800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +070900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +071000 MOVE SPACE TO RE-MARK. K7SEA4.2 +071100 PERFORM PRINT-DETAIL. K7SEA4.2 +071200 COPY-TEST-90. K7SEA4.2 +071300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +071400 MOVE "COPY-TEST-90 " TO PAR-NAME. K7SEA4.2 +071500 PERFORM PASS. K7SEA4.2 +071600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +071700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +071800 MOVE SPACE TO RE-MARK. K7SEA4.2 +071900 PERFORM PRINT-DETAIL. K7SEA4.2 +072000 COPY-TEST-91. K7SEA4.2 +072100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +072200 MOVE "COPY-TEST-91 " TO PAR-NAME. K7SEA4.2 +072300 PERFORM PASS. K7SEA4.2 +072400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +072500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +072600 MOVE SPACE TO RE-MARK. K7SEA4.2 +072700 PERFORM PRINT-DETAIL. K7SEA4.2 +072800 COPY-TEST-92. K7SEA4.2 +072900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +073000 MOVE "COPY-TEST-92 " TO PAR-NAME. K7SEA4.2 +073100 PERFORM PASS. K7SEA4.2 +073200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +073300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +073400 MOVE SPACE TO RE-MARK. K7SEA4.2 +073500 PERFORM PRINT-DETAIL. K7SEA4.2 +073600 COPY-TEST-93. K7SEA4.2 +073700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +073800 MOVE "COPY-TEST-93 " TO PAR-NAME. K7SEA4.2 +073900 PERFORM PASS. K7SEA4.2 +074000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +074100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +074200 MOVE SPACE TO RE-MARK. K7SEA4.2 +074300 PERFORM PRINT-DETAIL. K7SEA4.2 +074400 COPY-TEST-94. K7SEA4.2 +074500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +074600 MOVE "COPY-TEST-94 " TO PAR-NAME. K7SEA4.2 +074700 PERFORM PASS. K7SEA4.2 +074800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +074900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +075000 MOVE SPACE TO RE-MARK. K7SEA4.2 +075100 PERFORM PRINT-DETAIL. K7SEA4.2 +075200 COPY-TEST-95. K7SEA4.2 +075300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +075400 MOVE "COPY-TEST-95 " TO PAR-NAME. K7SEA4.2 +075500 PERFORM PASS. K7SEA4.2 +075600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +075700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +075800 MOVE SPACE TO RE-MARK. K7SEA4.2 +075900 PERFORM PRINT-DETAIL. K7SEA4.2 +076000 COPY-TEST-96. K7SEA4.2 +076100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +076200 MOVE "COPY-TEST-96 " TO PAR-NAME. K7SEA4.2 +076300 PERFORM PASS. K7SEA4.2 +076400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +076500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +076600 MOVE SPACE TO RE-MARK. K7SEA4.2 +076700 PERFORM PRINT-DETAIL. K7SEA4.2 +076800 COPY-TEST-97. K7SEA4.2 +076900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +077000 MOVE "COPY-TEST-97 " TO PAR-NAME. K7SEA4.2 +077100 PERFORM PASS. K7SEA4.2 +077200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +077300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +077400 MOVE SPACE TO RE-MARK. K7SEA4.2 +077500 PERFORM PRINT-DETAIL. K7SEA4.2 +077600 COPY-TEST-98. K7SEA4.2 +077700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +077800 MOVE "COPY-TEST-98 " TO PAR-NAME. K7SEA4.2 +077900 PERFORM PASS. K7SEA4.2 +078000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +078100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +078200 MOVE SPACE TO RE-MARK. K7SEA4.2 +078300 PERFORM PRINT-DETAIL. K7SEA4.2 +078400 COPY-TEST-99. K7SEA4.2 +078500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +078600 MOVE "COPY-TEST-99 " TO PAR-NAME. K7SEA4.2 +078700 PERFORM PASS. K7SEA4.2 +078800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +078900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +079000 MOVE SPACE TO RE-MARK. K7SEA4.2 +079100 PERFORM PRINT-DETAIL. K7SEA4.2 +079200 COPY-TEST-100. K7SEA4.2 +079300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +079400 MOVE "COPY-TEST-100" TO PAR-NAME. K7SEA4.2 +079500 PERFORM PASS. K7SEA4.2 +079600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +079700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +079800 MOVE SPACE TO RE-MARK. K7SEA4.2 +079900 PERFORM PRINT-DETAIL. K7SEA4.2 +080000 COPY-TEST-101. K7SEA4.2 +080100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +080200 MOVE "COPY-TEST-101" TO PAR-NAME. K7SEA4.2 +080300 PERFORM PASS. K7SEA4.2 +080400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +080500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +080600 MOVE SPACE TO RE-MARK. K7SEA4.2 +080700 PERFORM PRINT-DETAIL. K7SEA4.2 +080800 COPY-TEST-102. K7SEA4.2 +080900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +081000 MOVE "COPY-TEST-102" TO PAR-NAME. K7SEA4.2 +081100 PERFORM PASS. K7SEA4.2 +081200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +081300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +081400 MOVE SPACE TO RE-MARK. K7SEA4.2 +081500 PERFORM PRINT-DETAIL. K7SEA4.2 +081600 COPY-TEST-103. K7SEA4.2 +081700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +081800 MOVE "COPY-TEST-103" TO PAR-NAME. K7SEA4.2 +081900 PERFORM PASS. K7SEA4.2 +082000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +082100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +082200 MOVE SPACE TO RE-MARK. K7SEA4.2 +082300 PERFORM PRINT-DETAIL. K7SEA4.2 +082400 COPY-TEST-104. K7SEA4.2 +082500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +082600 MOVE "COPY-TEST-104" TO PAR-NAME. K7SEA4.2 +082700 PERFORM PASS. K7SEA4.2 +082800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +082900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +083000 MOVE SPACE TO RE-MARK. K7SEA4.2 +083100 PERFORM PRINT-DETAIL. K7SEA4.2 +083200 COPY-TEST-105. K7SEA4.2 +083300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +083400 MOVE "COPY-TEST-105" TO PAR-NAME. K7SEA4.2 +083500 PERFORM PASS. K7SEA4.2 +083600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +083700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +083800 MOVE SPACE TO RE-MARK. K7SEA4.2 +083900 PERFORM PRINT-DETAIL. K7SEA4.2 +084000 COPY-TEST-106. K7SEA4.2 +084100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +084200 MOVE "COPY-TEST-106" TO PAR-NAME. K7SEA4.2 +084300 PERFORM PASS. K7SEA4.2 +084400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +084500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +084600 MOVE SPACE TO RE-MARK. K7SEA4.2 +084700 PERFORM PRINT-DETAIL. K7SEA4.2 +084800 COPY-TEST-107. K7SEA4.2 +084900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +085000 MOVE "COPY-TEST-107" TO PAR-NAME. K7SEA4.2 +085100 PERFORM PASS. K7SEA4.2 +085200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +085300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +085400 MOVE SPACE TO RE-MARK. K7SEA4.2 +085500 PERFORM PRINT-DETAIL. K7SEA4.2 +085600 COPY-TEST-108. K7SEA4.2 +085700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +085800 MOVE "COPY-TEST-108" TO PAR-NAME. K7SEA4.2 +085900 PERFORM PASS. K7SEA4.2 +086000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +086100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +086200 MOVE SPACE TO RE-MARK. K7SEA4.2 +086300 PERFORM PRINT-DETAIL. K7SEA4.2 +086400 COPY-TEST-109. K7SEA4.2 +086500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +086600 MOVE "COPY-TEST-109" TO PAR-NAME. K7SEA4.2 +086700 PERFORM PASS. K7SEA4.2 +086800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +086900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +087000 MOVE SPACE TO RE-MARK. K7SEA4.2 +087100 PERFORM PRINT-DETAIL. K7SEA4.2 +087200 COPY-TEST-110. K7SEA4.2 +087300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +087400 MOVE "COPY-TEST-110" TO PAR-NAME. K7SEA4.2 +087500 PERFORM PASS. K7SEA4.2 +087600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +087700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +087800 MOVE SPACE TO RE-MARK. K7SEA4.2 +087900 PERFORM PRINT-DETAIL. K7SEA4.2 +088000 COPY-TEST-111. K7SEA4.2 +088100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +088200 MOVE "COPY-TEST-111" TO PAR-NAME. K7SEA4.2 +088300 PERFORM PASS. K7SEA4.2 +088400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +088500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +088600 MOVE SPACE TO RE-MARK. K7SEA4.2 +088700 PERFORM PRINT-DETAIL. K7SEA4.2 +088800 COPY-TEST-112. K7SEA4.2 +088900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +089000 MOVE "COPY-TEST-112" TO PAR-NAME. K7SEA4.2 +089100 PERFORM PASS. K7SEA4.2 +089200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +089300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +089400 MOVE SPACE TO RE-MARK. K7SEA4.2 +089500 PERFORM PRINT-DETAIL. K7SEA4.2 +089600 COPY-TEST-113. K7SEA4.2 +089700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +089800 MOVE "COPY-TEST-113" TO PAR-NAME. K7SEA4.2 +089900 PERFORM PASS. K7SEA4.2 +090000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +090100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +090200 MOVE SPACE TO RE-MARK. K7SEA4.2 +090300 PERFORM PRINT-DETAIL. K7SEA4.2 +090400 COPY-TEST-114. K7SEA4.2 +090500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +090600 MOVE "COPY-TEST-114" TO PAR-NAME. K7SEA4.2 +090700 PERFORM PASS. K7SEA4.2 +090800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +090900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +091000 MOVE SPACE TO RE-MARK. K7SEA4.2 +091100 PERFORM PRINT-DETAIL. K7SEA4.2 +091200 COPY-TEST-115. K7SEA4.2 +091300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +091400 MOVE "COPY-TEST-115" TO PAR-NAME. K7SEA4.2 +091500 PERFORM PASS. K7SEA4.2 +091600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +091700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +091800 MOVE SPACE TO RE-MARK. K7SEA4.2 +091900 PERFORM PRINT-DETAIL. K7SEA4.2 +092000 COPY-TEST-116. K7SEA4.2 +092100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +092200 MOVE "COPY-TEST-116" TO PAR-NAME. K7SEA4.2 +092300 PERFORM PASS. K7SEA4.2 +092400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +092500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +092600 MOVE SPACE TO RE-MARK. K7SEA4.2 +092700 PERFORM PRINT-DETAIL. K7SEA4.2 +092800 COPY-TEST-117. K7SEA4.2 +092900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +093000 MOVE "COPY-TEST-117" TO PAR-NAME. K7SEA4.2 +093100 PERFORM PASS. K7SEA4.2 +093200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +093300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +093400 MOVE SPACE TO RE-MARK. K7SEA4.2 +093500 PERFORM PRINT-DETAIL. K7SEA4.2 +093600 COPY-TEST-118. K7SEA4.2 +093700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +093800 MOVE "COPY-TEST-118" TO PAR-NAME. K7SEA4.2 +093900 PERFORM PASS. K7SEA4.2 +094000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +094100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +094200 MOVE SPACE TO RE-MARK. K7SEA4.2 +094300 PERFORM PRINT-DETAIL. K7SEA4.2 +094400 COPY-TEST-119. K7SEA4.2 +094500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +094600 MOVE "COPY-TEST-119" TO PAR-NAME. K7SEA4.2 +094700 PERFORM PASS. K7SEA4.2 +094800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +094900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +095000 MOVE SPACE TO RE-MARK. K7SEA4.2 +095100 PERFORM PRINT-DETAIL. K7SEA4.2 +095200 COPY-TEST-120. K7SEA4.2 +095300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +095400 MOVE "COPY-TEST-120" TO PAR-NAME. K7SEA4.2 +095500 PERFORM PASS. K7SEA4.2 +095600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +095700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +095800 MOVE SPACE TO RE-MARK. K7SEA4.2 +095900 PERFORM PRINT-DETAIL. K7SEA4.2 +096000 COPY-TEST-121. K7SEA4.2 +096100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +096200 MOVE "COPY-TEST-121" TO PAR-NAME. K7SEA4.2 +096300 PERFORM PASS. K7SEA4.2 +096400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +096500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +096600 MOVE SPACE TO RE-MARK. K7SEA4.2 +096700 PERFORM PRINT-DETAIL. K7SEA4.2 +096800 COPY-TEST-122. K7SEA4.2 +096900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +097000 MOVE "COPY-TEST-122" TO PAR-NAME. K7SEA4.2 +097100 PERFORM PASS. K7SEA4.2 +097200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +097300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +097400 MOVE SPACE TO RE-MARK. K7SEA4.2 +097500 PERFORM PRINT-DETAIL. K7SEA4.2 +097600 COPY-TEST-123. K7SEA4.2 +097700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +097800 MOVE "COPY-TEST-123" TO PAR-NAME. K7SEA4.2 +097900 PERFORM PASS. K7SEA4.2 +098000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +098100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +098200 MOVE SPACE TO RE-MARK. K7SEA4.2 +098300 PERFORM PRINT-DETAIL. K7SEA4.2 +098400 COPY-TEST-124. K7SEA4.2 +098500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +098600 MOVE "COPY-TEST-124" TO PAR-NAME. K7SEA4.2 +098700 PERFORM PASS. K7SEA4.2 +098800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +098900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +099000 MOVE SPACE TO RE-MARK. K7SEA4.2 +099100 PERFORM PRINT-DETAIL. K7SEA4.2 +099200 COPY-TEST-125. K7SEA4.2 +099300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +099400 MOVE "COPY-TEST-125" TO PAR-NAME. K7SEA4.2 +099500 PERFORM PASS. K7SEA4.2 +099600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +099700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +099800 MOVE SPACE TO RE-MARK. K7SEA4.2 +099900 PERFORM PRINT-DETAIL. K7SEA4.2 +100000 COPY-TEST-126. K7SEA4.2 +100100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +100200 MOVE "COPY-TEST-126" TO PAR-NAME. K7SEA4.2 +100300 PERFORM PASS. K7SEA4.2 +100400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +100500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +100600 MOVE SPACE TO RE-MARK. K7SEA4.2 +100700 PERFORM PRINT-DETAIL. K7SEA4.2 +100800 COPY-TEST-127. K7SEA4.2 +100900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +101000 MOVE "COPY-TEST-127" TO PAR-NAME. K7SEA4.2 +101100 PERFORM PASS. K7SEA4.2 +101200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +101300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +101400 MOVE SPACE TO RE-MARK. K7SEA4.2 +101500 PERFORM PRINT-DETAIL. K7SEA4.2 +101600 COPY-TEST-128. K7SEA4.2 +101700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +101800 MOVE "COPY-TEST-128" TO PAR-NAME. K7SEA4.2 +101900 PERFORM PASS. K7SEA4.2 +102000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +102100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +102200 MOVE SPACE TO RE-MARK. K7SEA4.2 +102300 PERFORM PRINT-DETAIL. K7SEA4.2 +102400 COPY-TEST-129. K7SEA4.2 +102500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +102600 MOVE "COPY-TEST-129" TO PAR-NAME. K7SEA4.2 +102700 PERFORM PASS. K7SEA4.2 +102800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +102900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +103000 MOVE SPACE TO RE-MARK. K7SEA4.2 +103100 PERFORM PRINT-DETAIL. K7SEA4.2 +103200 COPY-TEST-130. K7SEA4.2 +103300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +103400 MOVE "COPY-TEST-130" TO PAR-NAME. K7SEA4.2 +103500 PERFORM PASS. K7SEA4.2 +103600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +103700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +103800 MOVE SPACE TO RE-MARK. K7SEA4.2 +103900 PERFORM PRINT-DETAIL. K7SEA4.2 +104000 COPY-TEST-131. K7SEA4.2 +104100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +104200 MOVE "COPY-TEST-131" TO PAR-NAME. K7SEA4.2 +104300 PERFORM PASS. K7SEA4.2 +104400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +104500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +104600 MOVE SPACE TO RE-MARK. K7SEA4.2 +104700 PERFORM PRINT-DETAIL. K7SEA4.2 +104800 COPY-TEST-132. K7SEA4.2 +104900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +105000 MOVE "COPY-TEST-132" TO PAR-NAME. K7SEA4.2 +105100 PERFORM PASS. K7SEA4.2 +105200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +105300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +105400 MOVE SPACE TO RE-MARK. K7SEA4.2 +105500 PERFORM PRINT-DETAIL. K7SEA4.2 +105600 COPY-TEST-133. K7SEA4.2 +105700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +105800 MOVE "COPY-TEST-133" TO PAR-NAME. K7SEA4.2 +105900 PERFORM PASS. K7SEA4.2 +106000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +106100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +106200 MOVE SPACE TO RE-MARK. K7SEA4.2 +106300 PERFORM PRINT-DETAIL. K7SEA4.2 +106400 COPY-TEST-134. K7SEA4.2 +106500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +106600 MOVE "COPY-TEST-134" TO PAR-NAME. K7SEA4.2 +106700 PERFORM PASS. K7SEA4.2 +106800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +106900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +107000 MOVE SPACE TO RE-MARK. K7SEA4.2 +107100 PERFORM PRINT-DETAIL. K7SEA4.2 +107200 COPY-TEST-135. K7SEA4.2 +107300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +107400 MOVE "COPY-TEST-135" TO PAR-NAME. K7SEA4.2 +107500 PERFORM PASS. K7SEA4.2 +107600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +107700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +107800 MOVE SPACE TO RE-MARK. K7SEA4.2 +107900 PERFORM PRINT-DETAIL. K7SEA4.2 +108000 COPY-TEST-136. K7SEA4.2 +108100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +108200 MOVE "COPY-TEST-136" TO PAR-NAME. K7SEA4.2 +108300 PERFORM PASS. K7SEA4.2 +108400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +108500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +108600 MOVE SPACE TO RE-MARK. K7SEA4.2 +108700 PERFORM PRINT-DETAIL. K7SEA4.2 +108800 COPY-TEST-137. K7SEA4.2 +108900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +109000 MOVE "COPY-TEST-137" TO PAR-NAME. K7SEA4.2 +109100 PERFORM PASS. K7SEA4.2 +109200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +109300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +109400 MOVE SPACE TO RE-MARK. K7SEA4.2 +109500 PERFORM PRINT-DETAIL. K7SEA4.2 +109600 COPY-TEST-138. K7SEA4.2 +109700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +109800 MOVE "COPY-TEST-138" TO PAR-NAME. K7SEA4.2 +109900 PERFORM PASS. K7SEA4.2 +110000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +110100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +110200 MOVE SPACE TO RE-MARK. K7SEA4.2 +110300 PERFORM PRINT-DETAIL. K7SEA4.2 +110400 COPY-TEST-139. K7SEA4.2 +110500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +110600 MOVE "COPY-TEST-139" TO PAR-NAME. K7SEA4.2 +110700 PERFORM PASS. K7SEA4.2 +110800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +110900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +111000 MOVE SPACE TO RE-MARK. K7SEA4.2 +111100 PERFORM PRINT-DETAIL. K7SEA4.2 +111200 COPY-TEST-140. K7SEA4.2 +111300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +111400 MOVE "COPY-TEST-140" TO PAR-NAME. K7SEA4.2 +111500 PERFORM PASS. K7SEA4.2 +111600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +111700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +111800 MOVE SPACE TO RE-MARK. K7SEA4.2 +111900 PERFORM PRINT-DETAIL. K7SEA4.2 +112000 COPY-TEST-141. K7SEA4.2 +112100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +112200 MOVE "COPY-TEST-141" TO PAR-NAME. K7SEA4.2 +112300 PERFORM PASS. K7SEA4.2 +112400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +112500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +112600 MOVE SPACE TO RE-MARK. K7SEA4.2 +112700 PERFORM PRINT-DETAIL. K7SEA4.2 +112800 COPY-TEST-142. K7SEA4.2 +112900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +113000 MOVE "COPY-TEST-142" TO PAR-NAME. K7SEA4.2 +113100 PERFORM PASS. K7SEA4.2 +113200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +113300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +113400 MOVE SPACE TO RE-MARK. K7SEA4.2 +113500 PERFORM PRINT-DETAIL. K7SEA4.2 +113600 COPY-TEST-143. K7SEA4.2 +113700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +113800 MOVE "COPY-TEST-143" TO PAR-NAME. K7SEA4.2 +113900 PERFORM PASS. K7SEA4.2 +114000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +114100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +114200 MOVE SPACE TO RE-MARK. K7SEA4.2 +114300 PERFORM PRINT-DETAIL. K7SEA4.2 +114400 COPY-TEST-144. K7SEA4.2 +114500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +114600 MOVE "COPY-TEST-144" TO PAR-NAME. K7SEA4.2 +114700 PERFORM PASS. K7SEA4.2 +114800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +114900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +115000 MOVE SPACE TO RE-MARK. K7SEA4.2 +115100 PERFORM PRINT-DETAIL. K7SEA4.2 +115200 COPY-TEST-145. K7SEA4.2 +115300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +115400 MOVE "COPY-TEST-145" TO PAR-NAME. K7SEA4.2 +115500 PERFORM PASS. K7SEA4.2 +115600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +115700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +115800 MOVE SPACE TO RE-MARK. K7SEA4.2 +115900 PERFORM PRINT-DETAIL. K7SEA4.2 +116000 COPY-TEST-146. K7SEA4.2 +116100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +116200 MOVE "COPY-TEST-146" TO PAR-NAME. K7SEA4.2 +116300 PERFORM PASS. K7SEA4.2 +116400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +116500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +116600 MOVE SPACE TO RE-MARK. K7SEA4.2 +116700 PERFORM PRINT-DETAIL. K7SEA4.2 +116800 COPY-TEST-147. K7SEA4.2 +116900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +117000 MOVE "COPY-TEST-147" TO PAR-NAME. K7SEA4.2 +117100 PERFORM PASS. K7SEA4.2 +117200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +117300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +117400 MOVE SPACE TO RE-MARK. K7SEA4.2 +117500 PERFORM PRINT-DETAIL. K7SEA4.2 +117600 COPY-TEST-148. K7SEA4.2 +117700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +117800 MOVE "COPY-TEST-148" TO PAR-NAME. K7SEA4.2 +117900 PERFORM PASS. K7SEA4.2 +118000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +118100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +118200 MOVE SPACE TO RE-MARK. K7SEA4.2 +118300 PERFORM PRINT-DETAIL. K7SEA4.2 +118400 COPY-TEST-149. K7SEA4.2 +118500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +118600 MOVE "COPY-TEST-149" TO PAR-NAME. K7SEA4.2 +118700 PERFORM PASS. K7SEA4.2 +118800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +118900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +119000 MOVE SPACE TO RE-MARK. K7SEA4.2 +119100 PERFORM PRINT-DETAIL. K7SEA4.2 +119200 COPY-TEST-150. K7SEA4.2 +119300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +119400 MOVE "COPY-TEST-150" TO PAR-NAME. K7SEA4.2 +119500 PERFORM PASS. K7SEA4.2 +119600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +119700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +119800 MOVE SPACE TO RE-MARK. K7SEA4.2 +119900 PERFORM PRINT-DETAIL. K7SEA4.2 +120000 COPY-TEST-151. K7SEA4.2 +120100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +120200 MOVE "COPY-TEST-151" TO PAR-NAME. K7SEA4.2 +120300 PERFORM PASS. K7SEA4.2 +120400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +120500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +120600 MOVE SPACE TO RE-MARK. K7SEA4.2 +120700 PERFORM PRINT-DETAIL. K7SEA4.2 +120800 COPY-TEST-152. K7SEA4.2 +120900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +121000 MOVE "COPY-TEST-152" TO PAR-NAME. K7SEA4.2 +121100 PERFORM PASS. K7SEA4.2 +121200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +121300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +121400 MOVE SPACE TO RE-MARK. K7SEA4.2 +121500 PERFORM PRINT-DETAIL. K7SEA4.2 +121600 COPY-TEST-153. K7SEA4.2 +121700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +121800 MOVE "COPY-TEST-153" TO PAR-NAME. K7SEA4.2 +121900 PERFORM PASS. K7SEA4.2 +122000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +122100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +122200 MOVE SPACE TO RE-MARK. K7SEA4.2 +122300 PERFORM PRINT-DETAIL. K7SEA4.2 +122400 COPY-TEST-154. K7SEA4.2 +122500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +122600 MOVE "COPY-TEST-154" TO PAR-NAME. K7SEA4.2 +122700 PERFORM PASS. K7SEA4.2 +122800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +122900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +123000 MOVE SPACE TO RE-MARK. K7SEA4.2 +123100 PERFORM PRINT-DETAIL. K7SEA4.2 +123200 COPY-TEST-155. K7SEA4.2 +123300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +123400 MOVE "COPY-TEST-155" TO PAR-NAME. K7SEA4.2 +123500 PERFORM PASS. K7SEA4.2 +123600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +123700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +123800 MOVE SPACE TO RE-MARK. K7SEA4.2 +123900 PERFORM PRINT-DETAIL. K7SEA4.2 +124000 COPY-TEST-156. K7SEA4.2 +124100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +124200 MOVE "COPY-TEST-156" TO PAR-NAME. K7SEA4.2 +124300 PERFORM PASS. K7SEA4.2 +124400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +124500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +124600 MOVE SPACE TO RE-MARK. K7SEA4.2 +124700 PERFORM PRINT-DETAIL. K7SEA4.2 +124800 COPY-TEST-157. K7SEA4.2 +124900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +125000 MOVE "COPY-TEST-157" TO PAR-NAME. K7SEA4.2 +125100 PERFORM PASS. K7SEA4.2 +125200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +125300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +125400 MOVE SPACE TO RE-MARK. K7SEA4.2 +125500 PERFORM PRINT-DETAIL. K7SEA4.2 +125600 COPY-TEST-158. K7SEA4.2 +125700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +125800 MOVE "COPY-TEST-158" TO PAR-NAME. K7SEA4.2 +125900 PERFORM PASS. K7SEA4.2 +126000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +126100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +126200 MOVE SPACE TO RE-MARK. K7SEA4.2 +126300 PERFORM PRINT-DETAIL. K7SEA4.2 +126400 COPY-TEST-159. K7SEA4.2 +126500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +126600 MOVE "COPY-TEST-159" TO PAR-NAME. K7SEA4.2 +126700 PERFORM PASS. K7SEA4.2 +126800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +126900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +127000 MOVE SPACE TO RE-MARK. K7SEA4.2 +127100 PERFORM PRINT-DETAIL. K7SEA4.2 +127200 COPY-TEST-160. K7SEA4.2 +127300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +127400 MOVE "COPY-TEST-160" TO PAR-NAME. K7SEA4.2 +127500 PERFORM PASS. K7SEA4.2 +127600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +127700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +127800 MOVE SPACE TO RE-MARK. K7SEA4.2 +127900 PERFORM PRINT-DETAIL. K7SEA4.2 +128000 COPY-TEST-161. K7SEA4.2 +128100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +128200 MOVE "COPY-TEST-161" TO PAR-NAME. K7SEA4.2 +128300 PERFORM PASS. K7SEA4.2 +128400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +128500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +128600 MOVE SPACE TO RE-MARK. K7SEA4.2 +128700 PERFORM PRINT-DETAIL. K7SEA4.2 +128800 COPY-TEST-162. K7SEA4.2 +128900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +129000 MOVE "COPY-TEST-162" TO PAR-NAME. K7SEA4.2 +129100 PERFORM PASS. K7SEA4.2 +129200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +129300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +129400 MOVE SPACE TO RE-MARK. K7SEA4.2 +129500 PERFORM PRINT-DETAIL. K7SEA4.2 +129600 COPY-TEST-163. K7SEA4.2 +129700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +129800 MOVE "COPY-TEST-163" TO PAR-NAME. K7SEA4.2 +129900 PERFORM PASS. K7SEA4.2 +130000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +130100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +130200 MOVE SPACE TO RE-MARK. K7SEA4.2 +130300 PERFORM PRINT-DETAIL. K7SEA4.2 +130400 COPY-TEST-164. K7SEA4.2 +130500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +130600 MOVE "COPY-TEST-164" TO PAR-NAME. K7SEA4.2 +130700 PERFORM PASS. K7SEA4.2 +130800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +130900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +131000 MOVE SPACE TO RE-MARK. K7SEA4.2 +131100 PERFORM PRINT-DETAIL. K7SEA4.2 +131200 COPY-TEST-165. K7SEA4.2 +131300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +131400 MOVE "COPY-TEST-165" TO PAR-NAME. K7SEA4.2 +131500 PERFORM PASS. K7SEA4.2 +131600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +131700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +131800 MOVE SPACE TO RE-MARK. K7SEA4.2 +131900 PERFORM PRINT-DETAIL. K7SEA4.2 +132000 COPY-TEST-166. K7SEA4.2 +132100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +132200 MOVE "COPY-TEST-166" TO PAR-NAME. K7SEA4.2 +132300 PERFORM PASS. K7SEA4.2 +132400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +132500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +132600 MOVE SPACE TO RE-MARK. K7SEA4.2 +132700 PERFORM PRINT-DETAIL. K7SEA4.2 +132800 COPY-TEST-167. K7SEA4.2 +132900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +133000 MOVE "COPY-TEST-167" TO PAR-NAME. K7SEA4.2 +133100 PERFORM PASS. K7SEA4.2 +133200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +133300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +133400 MOVE SPACE TO RE-MARK. K7SEA4.2 +133500 PERFORM PRINT-DETAIL. K7SEA4.2 +133600 COPY-TEST-168. K7SEA4.2 +133700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +133800 MOVE "COPY-TEST-168" TO PAR-NAME. K7SEA4.2 +133900 PERFORM PASS. K7SEA4.2 +134000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +134100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +134200 MOVE SPACE TO RE-MARK. K7SEA4.2 +134300 PERFORM PRINT-DETAIL. K7SEA4.2 +134400 COPY-TEST-169. K7SEA4.2 +134500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +134600 MOVE "COPY-TEST-169" TO PAR-NAME. K7SEA4.2 +134700 PERFORM PASS. K7SEA4.2 +134800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +134900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +135000 MOVE SPACE TO RE-MARK. K7SEA4.2 +135100 PERFORM PRINT-DETAIL. K7SEA4.2 +135200 COPY-TEST-170. K7SEA4.2 +135300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +135400 MOVE "COPY-TEST-170" TO PAR-NAME. K7SEA4.2 +135500 PERFORM PASS. K7SEA4.2 +135600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +135700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +135800 MOVE SPACE TO RE-MARK. K7SEA4.2 +135900 PERFORM PRINT-DETAIL. K7SEA4.2 +136000 COPY-TEST-171. K7SEA4.2 +136100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +136200 MOVE "COPY-TEST-171" TO PAR-NAME. K7SEA4.2 +136300 PERFORM PASS. K7SEA4.2 +136400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +136500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +136600 MOVE SPACE TO RE-MARK. K7SEA4.2 +136700 PERFORM PRINT-DETAIL. K7SEA4.2 +136800 COPY-TEST-172. K7SEA4.2 +136900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +137000 MOVE "COPY-TEST-172" TO PAR-NAME. K7SEA4.2 +137100 PERFORM PASS. K7SEA4.2 +137200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +137300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +137400 MOVE SPACE TO RE-MARK. K7SEA4.2 +137500 PERFORM PRINT-DETAIL. K7SEA4.2 +137600 COPY-TEST-173. K7SEA4.2 +137700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +137800 MOVE "COPY-TEST-173" TO PAR-NAME. K7SEA4.2 +137900 PERFORM PASS. K7SEA4.2 +138000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +138100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +138200 MOVE SPACE TO RE-MARK. K7SEA4.2 +138300 PERFORM PRINT-DETAIL. K7SEA4.2 +138400 COPY-TEST-174. K7SEA4.2 +138500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +138600 MOVE "COPY-TEST-174" TO PAR-NAME. K7SEA4.2 +138700 PERFORM PASS. K7SEA4.2 +138800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +138900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +139000 MOVE SPACE TO RE-MARK. K7SEA4.2 +139100 PERFORM PRINT-DETAIL. K7SEA4.2 +139200 COPY-TEST-175. K7SEA4.2 +139300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +139400 MOVE "COPY-TEST-175" TO PAR-NAME. K7SEA4.2 +139500 PERFORM PASS. K7SEA4.2 +139600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +139700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +139800 MOVE SPACE TO RE-MARK. K7SEA4.2 +139900 PERFORM PRINT-DETAIL. K7SEA4.2 +140000 COPY-TEST-176. K7SEA4.2 +140100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +140200 MOVE "COPY-TEST-176" TO PAR-NAME. K7SEA4.2 +140300 PERFORM PASS. K7SEA4.2 +140400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +140500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +140600 MOVE SPACE TO RE-MARK. K7SEA4.2 +140700 PERFORM PRINT-DETAIL. K7SEA4.2 +140800 COPY-TEST-177. K7SEA4.2 +140900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +141000 MOVE "COPY-TEST-177" TO PAR-NAME. K7SEA4.2 +141100 PERFORM PASS. K7SEA4.2 +141200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +141300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +141400 MOVE SPACE TO RE-MARK. K7SEA4.2 +141500 PERFORM PRINT-DETAIL. K7SEA4.2 +141600 COPY-TEST-178. K7SEA4.2 +141700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +141800 MOVE "COPY-TEST-178" TO PAR-NAME. K7SEA4.2 +141900 PERFORM PASS. K7SEA4.2 +142000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +142100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +142200 MOVE SPACE TO RE-MARK. K7SEA4.2 +142300 PERFORM PRINT-DETAIL. K7SEA4.2 +142400 COPY-TEST-179. K7SEA4.2 +142500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +142600 MOVE "COPY-TEST-179" TO PAR-NAME. K7SEA4.2 +142700 PERFORM PASS. K7SEA4.2 +142800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +142900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +143000 MOVE SPACE TO RE-MARK. K7SEA4.2 +143100 PERFORM PRINT-DETAIL. K7SEA4.2 +143200 COPY-TEST-180. K7SEA4.2 +143300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +143400 MOVE "COPY-TEST-180" TO PAR-NAME. K7SEA4.2 +143500 PERFORM PASS. K7SEA4.2 +143600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +143700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +143800 MOVE SPACE TO RE-MARK. K7SEA4.2 +143900 PERFORM PRINT-DETAIL. K7SEA4.2 +144000 COPY-TEST-181. K7SEA4.2 +144100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +144200 MOVE "COPY-TEST-181" TO PAR-NAME. K7SEA4.2 +144300 PERFORM PASS. K7SEA4.2 +144400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +144500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +144600 MOVE SPACE TO RE-MARK. K7SEA4.2 +144700 PERFORM PRINT-DETAIL. K7SEA4.2 +144800 COPY-TEST-182. K7SEA4.2 +144900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +145000 MOVE "COPY-TEST-182" TO PAR-NAME. K7SEA4.2 +145100 PERFORM PASS. K7SEA4.2 +145200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +145300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +145400 MOVE SPACE TO RE-MARK. K7SEA4.2 +145500 PERFORM PRINT-DETAIL. K7SEA4.2 +145600 COPY-TEST-183. K7SEA4.2 +145700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +145800 MOVE "COPY-TEST-183" TO PAR-NAME. K7SEA4.2 +145900 PERFORM PASS. K7SEA4.2 +146000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +146100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +146200 MOVE SPACE TO RE-MARK. K7SEA4.2 +146300 PERFORM PRINT-DETAIL. K7SEA4.2 +146400 COPY-TEST-184. K7SEA4.2 +146500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +146600 MOVE "COPY-TEST-184" TO PAR-NAME. K7SEA4.2 +146700 PERFORM PASS. K7SEA4.2 +146800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +146900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +147000 MOVE SPACE TO RE-MARK. K7SEA4.2 +147100 PERFORM PRINT-DETAIL. K7SEA4.2 +147200 COPY-TEST-185. K7SEA4.2 +147300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +147400 MOVE "COPY-TEST-185" TO PAR-NAME. K7SEA4.2 +147500 PERFORM PASS. K7SEA4.2 +147600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +147700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +147800 MOVE SPACE TO RE-MARK. K7SEA4.2 +147900 PERFORM PRINT-DETAIL. K7SEA4.2 +148000 COPY-TEST-186. K7SEA4.2 +148100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +148200 MOVE "COPY-TEST-186" TO PAR-NAME. K7SEA4.2 +148300 PERFORM PASS. K7SEA4.2 +148400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +148500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +148600 MOVE SPACE TO RE-MARK. K7SEA4.2 +148700 PERFORM PRINT-DETAIL. K7SEA4.2 +148800 COPY-TEST-187. K7SEA4.2 +148900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +149000 MOVE "COPY-TEST-187" TO PAR-NAME. K7SEA4.2 +149100 PERFORM PASS. K7SEA4.2 +149200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +149300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +149400 MOVE SPACE TO RE-MARK. K7SEA4.2 +149500 PERFORM PRINT-DETAIL. K7SEA4.2 +149600 COPY-TEST-188. K7SEA4.2 +149700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +149800 MOVE "COPY-TEST-188" TO PAR-NAME. K7SEA4.2 +149900 PERFORM PASS. K7SEA4.2 +150000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +150100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +150200 MOVE SPACE TO RE-MARK. K7SEA4.2 +150300 PERFORM PRINT-DETAIL. K7SEA4.2 +150400 COPY-TEST-189. K7SEA4.2 +150500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +150600 MOVE "COPY-TEST-189" TO PAR-NAME. K7SEA4.2 +150700 PERFORM PASS. K7SEA4.2 +150800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +150900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +151000 MOVE SPACE TO RE-MARK. K7SEA4.2 +151100 PERFORM PRINT-DETAIL. K7SEA4.2 +151200 COPY-TEST-190. K7SEA4.2 +151300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +151400 MOVE "COPY-TEST-190" TO PAR-NAME. K7SEA4.2 +151500 PERFORM PASS. K7SEA4.2 +151600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +151700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +151800 MOVE SPACE TO RE-MARK. K7SEA4.2 +151900 PERFORM PRINT-DETAIL. K7SEA4.2 +152000 COPY-TEST-191. K7SEA4.2 +152100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +152200 MOVE "COPY-TEST-191" TO PAR-NAME. K7SEA4.2 +152300 PERFORM PASS. K7SEA4.2 +152400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +152500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +152600 MOVE SPACE TO RE-MARK. K7SEA4.2 +152700 PERFORM PRINT-DETAIL. K7SEA4.2 +152800 COPY-TEST-192. K7SEA4.2 +152900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +153000 MOVE "COPY-TEST-192" TO PAR-NAME. K7SEA4.2 +153100 PERFORM PASS. K7SEA4.2 +153200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +153300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +153400 MOVE SPACE TO RE-MARK. K7SEA4.2 +153500 PERFORM PRINT-DETAIL. K7SEA4.2 +153600 COPY-TEST-193. K7SEA4.2 +153700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +153800 MOVE "COPY-TEST-193" TO PAR-NAME. K7SEA4.2 +153900 PERFORM PASS. K7SEA4.2 +154000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +154100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +154200 MOVE SPACE TO RE-MARK. K7SEA4.2 +154300 PERFORM PRINT-DETAIL. K7SEA4.2 +154400 COPY-TEST-194. K7SEA4.2 +154500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +154600 MOVE "COPY-TEST-194" TO PAR-NAME. K7SEA4.2 +154700 PERFORM PASS. K7SEA4.2 +154800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +154900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +155000 MOVE SPACE TO RE-MARK. K7SEA4.2 +155100 PERFORM PRINT-DETAIL. K7SEA4.2 +155200 COPY-TEST-195. K7SEA4.2 +155300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +155400 MOVE "COPY-TEST-195" TO PAR-NAME. K7SEA4.2 +155500 PERFORM PASS. K7SEA4.2 +155600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +155700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +155800 MOVE SPACE TO RE-MARK. K7SEA4.2 +155900 PERFORM PRINT-DETAIL. K7SEA4.2 +156000 COPY-TEST-196. K7SEA4.2 +156100 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +156200 MOVE "COPY-TEST-196" TO PAR-NAME. K7SEA4.2 +156300 PERFORM PASS. K7SEA4.2 +156400 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +156500 MOVE SPACE TO CORRECT-A. K7SEA4.2 +156600 MOVE SPACE TO RE-MARK. K7SEA4.2 +156700 PERFORM PRINT-DETAIL. K7SEA4.2 +156800 COPY-TEST-197. K7SEA4.2 +156900 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +157000 MOVE "COPY-TEST-197" TO PAR-NAME. K7SEA4.2 +157100 PERFORM PASS. K7SEA4.2 +157200 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +157300 MOVE SPACE TO CORRECT-A. K7SEA4.2 +157400 MOVE SPACE TO RE-MARK. K7SEA4.2 +157500 PERFORM PRINT-DETAIL. K7SEA4.2 +157600 COPY-TEST-198. K7SEA4.2 +157700 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +157800 MOVE "COPY-TEST-198" TO PAR-NAME. K7SEA4.2 +157900 PERFORM PASS. K7SEA4.2 +158000 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +158100 MOVE SPACE TO CORRECT-A. K7SEA4.2 +158200 MOVE SPACE TO RE-MARK. K7SEA4.2 +158300 PERFORM PRINT-DETAIL. K7SEA4.2 +158400 COPY-TEST-199. K7SEA4.2 +158500 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +158600 MOVE "COPY-TEST-199" TO PAR-NAME. K7SEA4.2 +158700 PERFORM PASS. K7SEA4.2 +158800 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +158900 MOVE SPACE TO CORRECT-A. K7SEA4.2 +159000 MOVE SPACE TO RE-MARK. K7SEA4.2 +159100 PERFORM PRINT-DETAIL. K7SEA4.2 +159200 COPY-TEST-200. K7SEA4.2 +159300 MOVE "1600-CARD LIBRARY" TO FEATURE. K7SEA4.2 +159400 MOVE "COPY-TEST-200" TO PAR-NAME. K7SEA4.2 +159500 PERFORM PASS. K7SEA4.2 +159600 MOVE SPACE TO COMPUTED-A. K7SEA4.2 +159700 MOVE SPACE TO CORRECT-A. K7SEA4.2 +159800 MOVE SPACE TO RE-MARK. K7SEA4.2 +159900 PERFORM PRINT-DETAIL. K7SEA4.2 diff --git a/tests/cobol85/copy/KK208A b/tests/cobol85/copy/KK208A new file mode 100755 index 00000000..4f3d8ee7 --- /dev/null +++ b/tests/cobol85/copy/KK208A @@ -0,0 +1 @@ +000100 MOVE "FAIL" TO P-OR-F. KK2084.2 diff --git a/tests/cobol85/copy/KP001 b/tests/cobol85/copy/KP001 new file mode 100755 index 00000000..b509f788 --- /dev/null +++ b/tests/cobol85/copy/KP001 @@ -0,0 +1,10 @@ +000100 PST-TEST-001. KP0014.2 +000200 MOVE "PSEUDO-TEXT" TO FEATURE. KP0014.2 +000300* THIS TEXT IS COPIED INTO A SOURCE PROGRAM THE PSEUDO KP0014.2 +000400* TEXT CONTAINING PERFORM FAIL IS REPLACED WITH A NULL KP0014.2 +000500* PSEUDO TEXT. KP0014.2 +000600 MOVE "PST-TEST-001" TO PAR-NAME KP0014.2 +000700 PERFORM PASS. KP0014.2 +000800 PERFORM FAIL. KP0014.2 +000900 PST-WRITE-001. KP0014.2 +001000 PERFORM PRINT-DETAIL. KP0014.2 diff --git a/tests/cobol85/copy/KP002 b/tests/cobol85/copy/KP002 new file mode 100755 index 00000000..2c0dbfbe --- /dev/null +++ b/tests/cobol85/copy/KP002 @@ -0,0 +1,9 @@ +000100 MOVE +00009 TO WRK-DS-05V00-O005-001 IN WRK-XN-00050-O005FKP0024.2 +000200- -001 OF GRP-006 OF GRP-004 IN GRP-003 ( 2 ). KP0024.2 +000300 ADD KP0024.2 +000400 +00001 TO KP0024.2 +000500 WRK-DS-09V00-901 KP0024.2 +000600 SUBTRACT KP0024.2 +000700 1 KP0024.2 +000800 FROM KP0024.2 +000900 WRK-DS-05V00-O005-001 IN GRP-002 (1). KP0024.2 diff --git a/tests/cobol85/copy/KP003 b/tests/cobol85/copy/KP003 new file mode 100755 index 00000000..e8211f2b --- /dev/null +++ b/tests/cobol85/copy/KP003 @@ -0,0 +1,5 @@ +000100 PST-TEST-003. KP0034.2 +000200 MOVE +0009 TO WRK-DS-05V00-O005-001 IN GRP-003 (3). KP0034.2 +000300 ADD +00001 TO WRK-DS-09V00-901. KP0034.2 +000400 SUBTRACT 1 FROM WRK-DS-05V00-O005-001 IN GRP-002 (3). KP0034.2 +000500 PST-EXIT-003-X. KP0034.2 diff --git a/tests/cobol85/copy/KP004 b/tests/cobol85/copy/KP004 new file mode 100755 index 00000000..62c93c62 --- /dev/null +++ b/tests/cobol85/copy/KP004 @@ -0,0 +1,15 @@ +000100* THIS COMMENT IS THE FIRST IMAGE IN KP004 KP0044.2 +000200* ADD 1 TO THE LIST. KP0044.2 +000300 PST-INIT-004. KP0044.2 +000400 MOVE "PSEUDO-TEXT/WORD" TO FEATURE. KP0044.2 +000500 MOVE ZERO TO WRK-DS-09V00-901. KP0044.2 +000600 MOVE "PST-TEST-004" TO PAR-NAME. KP0044.2 +000700 PST-TEST-004. KP0044.2 +000800 ADD 5 TO WRK-DS-09V00-901. KP0044.2 +000900 THIS IS NOT REAL COBOL-74 SYNTAX HOWEVER KP0044.2 +001000 SHOVE +2 TO WRK-DS-09V00-902. KP0044.2 +001100 GO TO PST-EXIT-004. KP0044.2 +001200 PST-DELETE-004. KP0044.2 +001300 PERFORM DELETE. KP0044.2 +001400 PST-EXIT-004. KP0044.2 +001500 EXIT. KP0044.2 diff --git a/tests/cobol85/copy/KP005 b/tests/cobol85/copy/KP005 new file mode 100755 index 00000000..0dce5ea8 --- /dev/null +++ b/tests/cobol85/copy/KP005 @@ -0,0 +1 @@ +000100 MOVE 1 TO WRK-DS-09V00-901. KP0054.2 diff --git a/tests/cobol85/copy/KP006 b/tests/cobol85/copy/KP006 new file mode 100755 index 00000000..fa043089 --- /dev/null +++ b/tests/cobol85/copy/KP006 @@ -0,0 +1,2 @@ +000100 ADD 001 KP0064.2 +000200- 005 TO WRK-DS-09V00-901. KP0064.2 diff --git a/tests/cobol85/copy/KP007 b/tests/cobol85/copy/KP007 new file mode 100755 index 00000000..cb654d41 --- /dev/null +++ b/tests/cobol85/copy/KP007 @@ -0,0 +1,3 @@ +000100 PERFORM FAIL. KP0074.2 +000200* THIS COMMENT SHOULD NOT AFFECT PSEUDO-TEXT MATCHING. KP0074.2 +000300 SUBTRACT 1 FROM ERROR-COUNTER. KP0074.2 diff --git a/tests/cobol85/copy/KP008 b/tests/cobol85/copy/KP008 new file mode 100755 index 00000000..5c645085 --- /dev/null +++ b/tests/cobol85/copy/KP008 @@ -0,0 +1,3 @@ +000100 PERFORM FAIL. KP0084.2 +000200D THIS IS GARBAGE. KP0084.2 +000300 SUBTRACT 1 FROM ERROR-COUNTER. KP0084.2 diff --git a/tests/cobol85/copy/KP009 b/tests/cobol85/copy/KP009 new file mode 100755 index 00000000..562dbdc2 --- /dev/null +++ b/tests/cobol85/copy/KP009 @@ -0,0 +1 @@ +000100 IF WRK-XN-00001 = "G" KP0094.2 diff --git a/tests/cobol85/copy/KP010 b/tests/cobol85/copy/KP010 new file mode 100755 index 00000000..0d0835f7 --- /dev/null +++ b/tests/cobol85/copy/KP010 @@ -0,0 +1,6 @@ +000100 YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000200- YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000300- YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000400- YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000500- YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYKP0104.2 +000600- YYYYYYYYYYYYYYYYY KP0104.2 diff --git a/tests/cobol85/copy/KSM31 b/tests/cobol85/copy/KSM31 new file mode 100755 index 00000000..7db790a4 --- /dev/null +++ b/tests/cobol85/copy/KSM31 @@ -0,0 +1 @@ +000100 DISPLAY " ". KSM314.2 diff --git a/tests/cobol85/copy/KSM41 b/tests/cobol85/copy/KSM41 new file mode 100755 index 00000000..ffb5f86f --- /dev/null +++ b/tests/cobol85/copy/KSM41 @@ -0,0 +1 @@ +000100 DISPLAY "COW SHEEP PIG HORSE LAMB DOG CAT ". KSM414.2 diff --git a/tests/cobol85/copyalt/ALTLB b/tests/cobol85/copyalt/ALTLB new file mode 100755 index 00000000..a9bcb17a --- /dev/null +++ b/tests/cobol85/copyalt/ALTLB @@ -0,0 +1,5 @@ +000100* THIS TEXT MUST BE PLACED IN THE LIBRARY WHOSE NAME IS ALTL14.2 +000200* EQUATED TO THE X-48 (XXXXX048) CARD. ALTL14.2 +000300 PERFORM FAIL. ALTL14.2 +000400 SUBTRACT 1 FROM ERROR-COUNTER. ALTL14.2 +000500 MOVE "TEXT COPIED FROM WRONG LIBRARY" TO RE-MARK. ALTL14.2 diff --git a/tests/cobol85/newcob.val b/tests/cobol85/newcob.val old mode 100644 new mode 100755 diff --git a/tests/cobol85/report.pl b/tests/cobol85/report.pl old mode 100644 new mode 100755 diff --git a/tests/cobol85/summary.pl b/tests/cobol85/summary.pl old mode 100644 new mode 100755 diff --git a/tests/cobol85/summary.txt b/tests/cobol85/summary.txt old mode 100644 new mode 100755 diff --git a/tests/data-rep.src/binary.at b/tests/data-rep.src/binary.at index 6d927bb6..6a3dab9a 100644 --- a/tests/data-rep.src/binary.at +++ b/tests/data-rep.src/binary.at @@ -218,6 +218,7 @@ AT_CLEANUP # 2-4-8 native AT_SETUP([BINARY: 2-4-8 native]) +AT_CHECK([${SKIP_TEST}]) if test "x$COB_BIGENDIAN" = "xyes"; then AT_CHECK([true]) @@ -618,6 +619,7 @@ AT_CLEANUP # 1-2-4-8 native AT_SETUP([BINARY: 1-2-4-8 native]) +AT_CHECK([${SKIP_TEST}]) if test "x$COB_BIGENDIAN" = "xyes"; then AT_CHECK([true]) @@ -822,6 +824,7 @@ AT_CLEANUP # 1--8 big-endian AT_SETUP([BINARY: 1--8 big-endian]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([test.conf], [ include "cobol2002.conf" @@ -1019,6 +1022,7 @@ AT_CLEANUP # 1--8 native AT_SETUP([BINARY: 1--8 native]) +AT_CHECK([${SKIP_TEST}]) if test "x$COB_BIGENDIAN" = "xyes"; then AT_CHECK([true]) @@ -1222,6 +1226,7 @@ AT_CLEANUP # full-print AT_SETUP([BINARY: full-print]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([test.conf], [ include "cobol2002.conf" diff --git a/tests/data-rep.src/display.at b/tests/data-rep.src/display.at index 7c07e555..b836fd1c 100644 --- a/tests/data-rep.src/display.at +++ b/tests/data-rep.src/display.at @@ -123,6 +123,7 @@ AT_CLEANUP AT_SETUP([DISPLAY: Sign EBCDIC]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -207,6 +208,7 @@ AT_CLEANUP AT_SETUP([DISPLAY: Initialize Sign ASCII]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -239,6 +241,7 @@ AT_CLEANUP AT_SETUP([DISPLAY: Initialize Sign EBCDIC]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/data-rep.src/packed.at b/tests/data-rep.src/packed.at index 54a4c6a5..1564efa3 100644 --- a/tests/data-rep.src/packed.at +++ b/tests/data-rep.src/packed.at @@ -23,6 +23,7 @@ # dump AT_SETUP([PACKED-DECIMAL dump]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([dump.c], [ #include @@ -322,6 +323,7 @@ AT_CLEANUP # numeric test AT_SETUP([PACKED-DECIMAL numeric test]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/data-rep.src/pointer.at b/tests/data-rep.src/pointer.at index 53e2b791..cab58d1e 100644 --- a/tests/data-rep.src/pointer.at +++ b/tests/data-rep.src/pointer.at @@ -20,6 +20,7 @@ AT_SETUP([POINTER: display]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/i18n_sjis.src/limits.at b/tests/i18n_sjis.src/limits.at index d14dfabc..467c6c31 100644 --- a/tests/i18n_sjis.src/limits.at +++ b/tests/i18n_sjis.src/limits.at @@ -1,4 +1,5 @@ AT_SETUP([Field length limit PIC A/VALID]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -15,6 +16,7 @@ AT_CHECK([cobc -m prog.cob], [0]) AT_CLEANUP AT_SETUP([Field length limit PIC A/TOO LONG]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -33,6 +35,7 @@ AT_CHECK([cobc -m prog.cob], [1], [], AT_CLEANUP AT_SETUP([Field length limit PIC X/VALID]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -49,6 +52,7 @@ AT_CHECK([cobc -m prog.cob], [0]) AT_CLEANUP AT_SETUP([Field length limit PIC X/TOO LONG]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -67,6 +71,7 @@ AT_CHECK([cobc -m prog.cob], [1], [], AT_CLEANUP AT_SETUP([Field length limit PIC B9/VALID]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -83,6 +88,7 @@ AT_CHECK([cobc -m prog.cob], [0]) AT_CLEANUP AT_SETUP([Field length limit PIC B9/TOO LONG]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -101,6 +107,7 @@ AT_CHECK([cobc -m prog.cob], [1], [], AT_CLEANUP AT_SETUP([Field length limit PIC B/VALID]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -117,6 +124,7 @@ AT_CHECK([cobc -m prog.cob], [0]) AT_CLEANUP AT_SETUP([Field length limit PIC B/TOO LONG]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -135,6 +143,7 @@ AT_CHECK([cobc -m prog.cob], [1], [], AT_CLEANUP AT_SETUP([Field length limit PIC BA/VALID]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -151,6 +160,7 @@ AT_CHECK([cobc -m prog.cob], [0]) AT_CLEANUP AT_SETUP([Field length limit PIC BA/TOO LONG]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -169,6 +179,7 @@ AT_CHECK([cobc -m prog.cob], [1], [], AT_CLEANUP AT_SETUP([Field length limit PIC BX/VALID]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -185,6 +196,7 @@ AT_CHECK([cobc -m prog.cob], [0]) AT_CLEANUP AT_SETUP([Field length limit PIC BX/TOO LONG]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -203,6 +215,7 @@ AT_CHECK([cobc -m prog.cob], [1], [], AT_CLEANUP AT_SETUP([Field length limit PIC N/VALID (SJIS)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -219,6 +232,7 @@ AT_CHECK([cobc -m prog.cob], [0]) AT_CLEANUP AT_SETUP([Field length limit PIC N/TOO LONG (SJIS)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -237,6 +251,7 @@ AT_CHECK([cobc -m prog.cob], [1], [], AT_CLEANUP AT_SETUP([Field length limit PIC BN/VALID (SJIS)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -253,6 +268,7 @@ AT_CHECK([cobc -m prog.cob], [0]) AT_CLEANUP AT_SETUP([Field length limit PIC BN/TOO LONG (SJIS)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/i18n_sjis.src/mb-space.at b/tests/i18n_sjis.src/mb-space.at index 1888dfc0..d0a8e253 100644 --- a/tests/i18n_sjis.src/mb-space.at +++ b/tests/i18n_sjis.src/mb-space.at @@ -1,4 +1,5 @@ AT_SETUP([Zenkaku SPC delims in headings]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION@DIVISION. @@ -17,6 +18,7 @@ AT_CHECK([java prog], [0], [OK]) AT_CLEANUP AT_SETUP([Zenkaku SPC delims in record def]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -41,6 +43,7 @@ AT_CHECK([java prog], [0], [Zen SPC between item name and PIC clause]) AT_CLEANUP AT_SETUP([Zenkaku SPC delims in COPY stmt]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([inc.cpy], [ 01 ځ@PIC X(2) VALUE "OK". diff --git a/tests/i18n_sjis.src/national.at b/tests/i18n_sjis.src/national.at index 258bfe3d..66ed83c7 100644 --- a/tests/i18n_sjis.src/national.at +++ b/tests/i18n_sjis.src/national.at @@ -1,4 +1,5 @@ AT_SETUP([FUNCTION NATIONAL single-byte]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -20,6 +21,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([FUNCTION NATIONAL multi-byte]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -41,6 +43,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([FUNCTION NATIONAL KIGOU-exclamation]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -62,6 +65,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([FUNCTION NATIONAL KIGOU-yen]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -83,6 +87,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([FUNCTION NATIONAL KIGOU-plus]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -104,6 +109,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([FUNCTION NATIONAL (HanKana w/ Daku-on)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -125,6 +131,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([FUNCTION NATIONAL (HanKana w/ Han-daku-on)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -146,6 +153,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([N Literal (NO zenakaku conversion)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -171,6 +179,7 @@ ABC AT_CLEANUP AT_SETUP([NC Literal (NO zenakaku conversion)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -196,6 +205,7 @@ ABC AT_CLEANUP AT_SETUP([ND Literal (NO zenakaku conversion)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -221,6 +231,7 @@ ABC AT_CLEANUP AT_SETUP([NX Literal]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/i18n_sjis.src/pic-n.at b/tests/i18n_sjis.src/pic-n.at index bb673d43..ec03f26d 100644 --- a/tests/i18n_sjis.src/pic-n.at +++ b/tests/i18n_sjis.src/pic-n.at @@ -1,4 +1,5 @@ AT_SETUP([PIC N Value clause]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -17,6 +18,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Move]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -36,6 +38,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Move with trunc]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -60,6 +63,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Move with padding by full-width SPC]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -79,6 +83,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Move with justify]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -98,6 +103,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N EDITED w/ VALUE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -116,6 +122,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([INITIALIZE PIC N EDITED]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -136,6 +143,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([INITIALIZE PIC N EDITED TO VALUE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -156,6 +164,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Move to NATIONAL EDITED]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -175,6 +184,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Move with half-width alnum conv.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -194,6 +204,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Move with half-width kana conv.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -214,6 +225,7 @@ AT_CHECK([java prog | od -tx1 -An | sed -e 's/ */ /g' -e 's/ *$//'], [0], [ 83 AT_CLEANUP AT_SETUP([PIC N Ref mod(n:)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -233,6 +245,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Ref mod(n:m)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -252,6 +265,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N STRING by size]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -275,6 +289,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N STRING with delimiter (causes warn)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -298,6 +313,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N STRING with NATIONAL delimiter]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -321,6 +337,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N STRING with pointer]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -345,6 +362,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N INSPECT REPLACING]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -364,6 +382,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N INSPECT REPLACING by ZERO]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -383,6 +402,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N INSPECT REPLACING by NATIONAL ZERO]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -402,6 +422,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N INSPECT TALLYING]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -422,6 +443,7 @@ AT_CHECK([java prog], [0], [02]) AT_CLEANUP AT_SETUP([PIC N Move with half-width dakuten kana.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -441,6 +463,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([PIC N Move with half-width han-dakuten kana.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/i18n_sjis.src/pic-x.at b/tests/i18n_sjis.src/pic-x.at index 37ad47ce..c6255588 100644 --- a/tests/i18n_sjis.src/pic-x.at +++ b/tests/i18n_sjis.src/pic-x.at @@ -1,4 +1,5 @@ AT_SETUP([Value clause]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -17,6 +18,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -36,6 +38,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move with trunc]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -60,6 +63,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move ALL with trunc and trimming]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -80,6 +84,7 @@ AT_CHECK([java prog | od -tx1 -An | sed -e 's/ */ /g' -e 's/ *$//'], [0], [ 8a AT_CLEANUP AT_SETUP([Move with trunc and trimming 1]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -105,6 +110,7 @@ AT_CHECK([java prog | od -tx1 -An | sed -e 's/ */ /g' -e 's/ *$//'], [0], [ 93 AT_CLEANUP AT_SETUP([Move from field with trunc and trimming 1]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -126,6 +132,7 @@ AT_CHECK([java prog | od -tx1 -An | sed -e 's/ */ /g' -e 's/ *$//'], [0], [ 93 AT_CLEANUP AT_SETUP([Move with padding]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -145,6 +152,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move with justify]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -164,6 +172,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move to alnum EDITED]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -183,6 +192,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move to alnum EDITED (pic too short)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -206,6 +216,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move to alnum EDITED (pic too long)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -225,6 +236,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move to alnum EDITED (No char break)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -244,6 +256,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Move to alnum EDITED (char break & junk chars)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -264,6 +277,7 @@ AT_CHECK([java prog | od -tx1 -An | sed -e 's/ */ /g' -e 's/ *$//'], [0], [ 93 AT_CLEANUP AT_SETUP([Move group to group in bad alignment]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -289,6 +303,7 @@ AT_CHECK([java prog | od -tx1 -An | sed -e 's/ */ /g' -e 's/ *$//'], [0], [ 93 AT_CLEANUP AT_SETUP([Redifinition breaking char pos.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -314,6 +329,7 @@ AT_CLEANUP AT_SETUP([Ref mod(n:)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -333,6 +349,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([Ref mod(n:m)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -352,6 +369,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([STRING by size]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -375,6 +393,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([STRING with delimiter]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -402,6 +421,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([STRING with pointer]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -426,6 +446,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([INSPECT REPLACING]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -445,6 +466,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([INSPECT REPLACING by ZERO]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -464,6 +486,7 @@ AT_CHECK([java prog], [0], [ AT_CLEANUP AT_SETUP([INSPECT TALLYING]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/i18n_sjis.src/program-id.at b/tests/i18n_sjis.src/program-id.at index c24dcc5c..eb6d28d0 100644 --- a/tests/i18n_sjis.src/program-id.at +++ b/tests/i18n_sjis.src/program-id.at @@ -1,4 +1,5 @@ AT_SETUP([PROGRAM-ID NATIONAL C89 no warning]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([test.conf], [ include "default.conf" @@ -18,6 +19,7 @@ AT_CHECK([${COMPILE} -conf=test.conf -x prog.cob], [0]) AT_CLEANUP AT_SETUP([PROGRAM-ID NATIONAL C89 warning]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([test.conf], [ include "default.conf" @@ -40,6 +42,7 @@ prog.cob:6: Warning: PROGRAM-ID length exceeds C89 function name limit AT_CLEANUP AT_SETUP([PROGRAM-ID NATIONAL C89 ignore]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -54,6 +57,7 @@ AT_CHECK([${COMPILE} -x prog.cob], [0]) AT_CLEANUP AT_SETUP([PROGRAM-ID NATIONAL 32 character no over]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/i18n_sjis.src/user-defined-word.at b/tests/i18n_sjis.src/user-defined-word.at index a6d2981e..bc5d11e1 100644 --- a/tests/i18n_sjis.src/user-defined-word.at +++ b/tests/i18n_sjis.src/user-defined-word.at @@ -1,4 +1,5 @@ AT_SETUP([Program name]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -12,6 +13,7 @@ AT_CHECK([${COMPILE} -x prog.cob]) AT_CLEANUP AT_SETUP([Field name]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -31,6 +33,7 @@ AT_CHECK([java prog], [0], [Unicode]) AT_CLEANUP AT_SETUP([Long field name]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -56,6 +59,7 @@ AT_CLEANUP AT_SETUP([Field lookup]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -75,6 +79,7 @@ AT_CHECK([java prog], [0], [AB]) AT_CLEANUP AT_SETUP([Section name]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -97,6 +102,7 @@ AT_CHECK([java prog], [0], [Hello, and good bye.]) AT_CLEANUP AT_SETUP([Long section name]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -143,6 +149,7 @@ prog.cob:9: Error: User defined name must be less than 32 characters AT_CLEANUP AT_SETUP([Nihongo Filename]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -178,6 +185,7 @@ AT_CHECK([java prog], [0], [OK]) AT_CLEANUP AT_SETUP([Nihongo field name in numeric test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -201,6 +209,7 @@ AT_CHECK([java prog], [1], [], AT_CLEANUP AT_SETUP([Nihongo field name in BASED test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -222,6 +231,7 @@ AT_CHECK([java prog], [1], [], AT_CLEANUP AT_SETUP([Nihongo field name in ODO test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -244,6 +254,7 @@ AT_CHECK([java prog], [1], [], AT_CLEANUP AT_SETUP([Nihongo field name in Subscript test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -266,6 +277,7 @@ AT_CHECK([java prog], [1], [], AT_CLEANUP AT_SETUP([Nihongo field name in length of ref_mod test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -288,6 +300,7 @@ AT_CHECK([java prog], [1], [], AT_CLEANUP AT_SETUP([Nihongo field name in offset of ref_mod test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -310,6 +323,7 @@ AT_CHECK([java prog], [1], [], AT_CLEANUP AT_SETUP([Nihongo field name in length of N_refmod test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -332,6 +346,7 @@ AT_CHECK([java prog], [1], [], AT_CLEANUP AT_SETUP([Nihongo field name in offset of N_refmod test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -354,6 +369,7 @@ AT_CHECK([java prog], [1], [], AT_CLEANUP AT_SETUP([Nihongo field name in extaddr test msg.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/catch-exception.at b/tests/jp-compat.src/catch-exception.at index 12f969a3..4b3a674e 100644 --- a/tests/jp-compat.src/catch-exception.at +++ b/tests/jp-compat.src/catch-exception.at @@ -49,6 +49,7 @@ AT_CLEANUP # 3) DONE AT_SETUP([Divide by zero: by variable - option yes]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -149,6 +150,7 @@ AT_CLEANUP # 7) DONE AT_SETUP([Divide by zero: by variable compute - option yes]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -202,6 +204,7 @@ AT_CLEANUP # 9) DONE AT_SETUP([Divide by zero: by variable with on size error]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/file-control.at b/tests/jp-compat.src/file-control.at index 75b5ff02..b9727cd7 100644 --- a/tests/jp-compat.src/file-control.at +++ b/tests/jp-compat.src/file-control.at @@ -61,6 +61,7 @@ AT_CHECK([export OC_IO_CREATES=yes && ${RUN_MODULE} prog], [0], [00 AT_CLEANUP AT_SETUP([Allow no file open (I-O, RELATIVE)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -189,6 +190,7 @@ AT_CHECK([export OC_EXTEND_CREATES=yes && ${RUN_MODULE} prog], [0], [00 AT_CLEANUP AT_SETUP([Allow no file open (EXTEND, RELATIVE)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -255,6 +257,7 @@ AT_CHECK([export OC_EXTEND_CREATES=yes && ${RUN_MODULE} prog], [0], [00 AT_CLEANUP AT_SETUP([Allow file delete (SEQUENTIAL)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -287,6 +290,7 @@ AT_CHECK([${RUN_MODULE} prog], [0], [00 AT_CLEANUP AT_SETUP([Allow file delete (LINE SEQ)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -319,6 +323,7 @@ AT_CHECK([${RUN_MODULE} prog], [0], [00 AT_CLEANUP AT_SETUP([Allow file delete (RELATIVE)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -353,6 +358,7 @@ AT_CHECK([${RUN_MODULE} prog], [0], [00 AT_CLEANUP AT_SETUP([Allow file delete (INDEXED)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "yes" || exit 77]) @@ -425,6 +431,7 @@ AT_CHECK([${RUN_MODULE} prog], [0], [91 AT_CLEANUP AT_SETUP([Assume REWRITE for WRITE on OPEN I-O]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/file-desc.at b/tests/jp-compat.src/file-desc.at index 556c2154..b53c9763 100644 --- a/tests/jp-compat.src/file-desc.at +++ b/tests/jp-compat.src/file-desc.at @@ -30,6 +30,7 @@ AT_CHECK([od -An -tx1 TEST-FILE | sed -e 's/ */ /g' -e 's/ *$//'], [0], [ 41 41 AT_CLEANUP AT_SETUP([ignore invalid (too large) RECORD CONTAINS ]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/file-userfh.at b/tests/jp-compat.src/file-userfh.at index 2fa0d53a..6263c7e8 100644 --- a/tests/jp-compat.src/file-userfh.at +++ b/tests/jp-compat.src/file-userfh.at @@ -1,4 +1,5 @@ AT_SETUP([USERFH - READ LOCK - so]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $SHREXT != "dll" || exit 77]) diff --git a/tests/jp-compat.src/intr-funcs.at b/tests/jp-compat.src/intr-funcs.at index 9c895b72..6d02efe0 100644 --- a/tests/jp-compat.src/intr-funcs.at +++ b/tests/jp-compat.src/intr-funcs.at @@ -1,4 +1,5 @@ AT_SETUP([FUNCTION LENG (fixed)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -19,6 +20,7 @@ AT_CHECK([java prog], [0], [08]) AT_CLEANUP AT_SETUP([FUNCTION LENG (occur. depending)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -42,6 +44,7 @@ AT_CHECK([java prog], [0], [04]) AT_CLEANUP AT_SETUP([FUNCTION LENGTH-AN (fixed)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -62,6 +65,7 @@ AT_CHECK([java prog], [0], [08]) AT_CLEANUP AT_SETUP([FUNCTION LENGTH-AN (occur. depending)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/job-date.at b/tests/jp-compat.src/job-date.at index d6240f47..04d7466b 100644 --- a/tests/jp-compat.src/job-date.at +++ b/tests/jp-compat.src/job-date.at @@ -195,6 +195,7 @@ AT_CHECK([diff out1.txt out2.txt], [0]) AT_CLEANUP AT_SETUP([COB_DATE FUNC. CURRENT-DATE of time]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $SHREXT != "dll" || exit 77]) diff --git a/tests/jp-compat.src/nibble-c-for-unsigned.at b/tests/jp-compat.src/nibble-c-for-unsigned.at index a35a13ee..05ac0f6b 100644 --- a/tests/jp-compat.src/nibble-c-for-unsigned.at +++ b/tests/jp-compat.src/nibble-c-for-unsigned.at @@ -1,4 +1,5 @@ AT_SETUP([Decimal nibble C as unsigned]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/sort-key-is.at b/tests/jp-compat.src/sort-key-is.at index 790d8410..e093c169 100644 --- a/tests/jp-compat.src/sort-key-is.at +++ b/tests/jp-compat.src/sort-key-is.at @@ -1,4 +1,5 @@ AT_SETUP([SORT KEY IS]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/special-names.at b/tests/jp-compat.src/special-names.at index f3792d17..f9029469 100644 --- a/tests/jp-compat.src/special-names.at +++ b/tests/jp-compat.src/special-names.at @@ -1,4 +1,5 @@ AT_SETUP([ACCEPT ARGUMENT-NUMBER]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -22,6 +23,7 @@ AT_CHECK([java prog this is arg], [0], [03]) AT_CLEANUP AT_SETUP([ACCEPT ARGUMENT-VALUE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -46,6 +48,7 @@ AT_CHECK([java prog this is arg], [0], [arg ]) AT_CLEANUP AT_SETUP([ACCEPT ENVIRONMENT-VALUE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -70,6 +73,7 @@ AT_CHECK([export TESTENV=envvalue && java prog], [0], [envvalue]) AT_CLEANUP AT_SETUP([DISPLAY ARGUMENT-NUMBER]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -94,6 +98,7 @@ AT_CHECK([java prog this is arg], [0], [arg ]) AT_CLEANUP AT_SETUP([DISPLAY ENVIRONMENT-NAME]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -118,6 +123,7 @@ AT_CHECK([export TESTENV=envvalue && java prog], [0], [envvalue]) AT_CLEANUP AT_SETUP([DISPLAY ENVIRONMENT-VALUE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/spl-registers.at b/tests/jp-compat.src/spl-registers.at index 0687e772..8e20cf18 100644 --- a/tests/jp-compat.src/spl-registers.at +++ b/tests/jp-compat.src/spl-registers.at @@ -1,4 +1,6 @@ AT_SETUP([PROGRAM-STATUS]) +AT_CHECK([${SKIP_TEST}]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -14,6 +16,7 @@ AT_CHECK([java prog], [99]) AT_CLEANUP AT_SETUP([SORT-STATUS (alias SORT-RETURN)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -30,6 +33,8 @@ AT_CHECK([java prog], [0], [+000000016]) AT_CLEANUP AT_SETUP([SORT-STATUS (Break in input section)]) +AT_CHECK([${SKIP_TEST}]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -94,6 +99,8 @@ AT_CHECK([if test -f output.txt ; then echo -n NG ; else echo -n OK ; fi], [0], AT_CLEANUP AT_SETUP([SORT-STATUS (Break in output section)]) +AT_CHECK([${SKIP_TEST}]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -158,6 +165,8 @@ AT_CHECK([cat output.txt], [0], [0103]) AT_CLEANUP AT_SETUP([SORT-STATUS (Break in section with THRU)]) +AT_CHECK([${SKIP_TEST}]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -226,6 +235,8 @@ AT_CHECK([cat output.txt], [0], [0103]) AT_CLEANUP AT_SETUP([SORT-STATUS break in MERGE]) +AT_CHECK([${SKIP_TEST}]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -286,6 +297,8 @@ AT_CHECK([cat output.txt], [0], [0103]) AT_CLEANUP AT_SETUP([SORT-STATUS break with No SORT-STATUS in pgm]) +AT_CHECK([${SKIP_TEST}]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/split-keys.at b/tests/jp-compat.src/split-keys.at index fb70ccdd..9e3b9053 100644 --- a/tests/jp-compat.src/split-keys.at +++ b/tests/jp-compat.src/split-keys.at @@ -1,4 +1,5 @@ AT_SETUP([SPLIT KEYS (ALTERNATE KEY)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "yes" || exit 77]) @@ -51,6 +52,7 @@ AT_CHECK([java prog], [0], [BBBB]) AT_CLEANUP AT_SETUP([SPLIT KEYS (ALTERNATE KEY - NOT YET)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "no" || exit 77]) @@ -105,6 +107,7 @@ prog.cob:38: Warning: 'SPLIT KEYS' not implemented AT_CLEANUP AT_SETUP([SPLIT KEYS (RECORD KEY)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "yes" || exit 77]) @@ -169,6 +172,7 @@ AT_CHECK([java prog], [0], [ALT2]) AT_CLEANUP AT_SETUP([SPLIT KEYS (RECORD KEY - NOT YET)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "no" || exit 77]) @@ -236,6 +240,7 @@ prog.cob:50: Warning: 'SPLIT KEYS' not implemented AT_CLEANUP AT_SETUP([SPLIT KEYS (START Syntax - EQUAL)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "yes" || exit 77]) @@ -300,6 +305,7 @@ AT_CHECK([java prog], [0], [ALT2]) AT_CLEANUP AT_SETUP([SPLIT KEYS (START Syntax - EQUAL - NOT YET)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "no" || exit 77]) @@ -367,6 +373,7 @@ prog.cob:49: Warning: 'SPLIT KEYS' not implemented AT_CLEANUP AT_SETUP([SPLIT KEYS (START Syntax - GREATER THAN)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "yes" || exit 77]) @@ -431,6 +438,7 @@ AT_CHECK([java prog], [0], [ALT3]) AT_CLEANUP AT_SETUP([SPLIT KEYS (START Syntax - GREATER THAN - NOT YET)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "no" || exit 77]) @@ -498,6 +506,7 @@ prog.cob:49: Warning: 'SPLIT KEYS' not implemented AT_CLEANUP AT_SETUP([SPLIT KEYS (key unmatch)]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $COB_SPLITKEY_FLAGS = "yes" || exit 77]) diff --git a/tests/jp-compat.src/system-routine.at b/tests/jp-compat.src/system-routine.at index ef7a6902..fb2b0020 100644 --- a/tests/jp-compat.src/system-routine.at +++ b/tests/jp-compat.src/system-routine.at @@ -1,4 +1,5 @@ AT_SETUP([CALL C$CALLEDBY]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -43,6 +44,7 @@ AT_CHECK([./caller], [0], AT_CLEANUP AT_SETUP([CALL C$LIST-DIRECTORY]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/jp-compat.src/verbose-runtime.at b/tests/jp-compat.src/verbose-runtime.at index 66fb84c4..ba31cf44 100644 --- a/tests/jp-compat.src/verbose-runtime.at +++ b/tests/jp-compat.src/verbose-runtime.at @@ -1,4 +1,5 @@ AT_SETUP([COB_VERBOSE file sort]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/run.src/extensions.at b/tests/run.src/extensions.at index 9db032d6..d3f54fda 100644 --- a/tests/run.src/extensions.at +++ b/tests/run.src/extensions.at @@ -22,6 +22,7 @@ AT_SETUP([COMP-5]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([dump.c], [ #include @@ -118,6 +119,7 @@ AT_CLEANUP ## ADDRESS OF AT_SETUP([ADDRESS OF]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -238,6 +240,7 @@ AT_CLEANUP ## OCCURS AT_SETUP([Complex OCCURS DEPENDING ON]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -357,6 +360,7 @@ AT_CLEANUP ## CALL AT_SETUP([CALL USING file-name - so]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $SHREXT != "dll" || exit 77]) @@ -447,6 +451,7 @@ AT_CHECK([test -e TESTFILE], [0]) AT_CLEANUP AT_SETUP([CALL unusual PROGRAM-ID.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([A@B.cob], [ IDENTIFICATION DIVISION. @@ -556,6 +561,7 @@ AT_CHECK([java prog], [0], [OK]) AT_CLEANUP AT_SETUP([Quoted PROGRAM-ID]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -742,6 +748,7 @@ AT_CLEANUP # Number of call parameters AT_SETUP([NUMBER-OF-CALL-PARAMETERS]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -798,6 +805,7 @@ AT_CLEANUP # Program parameters AT_SETUP([PROCEDURE DIVISION USING BY ...]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -847,6 +855,7 @@ X = X Y = 56 Z = 34 AT_CLEANUP AT_SETUP([PROCEDURE DIVISION CHAINING ...]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -892,6 +901,7 @@ AT_CLEANUP # ENTRY AT_SETUP([ENTRY]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([caller.cob], [ IDENTIFICATION DIVISION. @@ -1039,6 +1049,7 @@ AT_CLEANUP AT_SETUP([ASSIGN to KEYBOARD/DISPLAY]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([TEST-FILE], [a @@ -1095,6 +1106,7 @@ abcdef AT_CLEANUP AT_SETUP([Environment/Argument variable]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1140,6 +1152,7 @@ AT_CHECK([java prog CHECKPAR], [0], AT_CLEANUP AT_SETUP([DECIMAL-POINT is COMMA (1)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1166,6 +1179,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([DECIMAL-POINT is COMMA (2)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1192,6 +1206,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([DECIMAL-POINT is COMMA (3)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1218,6 +1233,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([DECIMAL-POINT is COMMA (4)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1244,6 +1260,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([DECIMAL-POINT is COMMA (5)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/run.src/functions.at b/tests/run.src/functions.at index 8189bf1f..66c5afba 100644 --- a/tests/run.src/functions.at +++ b/tests/run.src/functions.at @@ -20,6 +20,7 @@ ### ISO+IEC+1989-2002 15 Intrinsic Functions AT_SETUP([FUNCTION ABS]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -70,6 +71,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION ANNUITY]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -179,6 +181,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION COMBINED-DATETIME]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -199,6 +202,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION CONCATENATE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -221,6 +225,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION CONCATENATE with reference modding]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -293,6 +298,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION DATE-TO-YYYYMMDD]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -333,6 +339,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION DAY-TO-YYYYDDD]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -373,6 +380,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION EXCEPTION-FILE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -403,6 +411,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION EXCEPTION-LOCATION]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -437,6 +446,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION EXCEPTION-STATEMENT]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -467,6 +477,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION EXCEPTION-STATUS]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -497,6 +508,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION EXP]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -545,6 +557,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION FRACTION-PART]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -671,6 +684,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION LOCALE-DATE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -695,6 +709,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION LOCALE-TIME]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -719,6 +734,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION LOCALE-TIME-FROM-SECONDS]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -743,6 +759,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION LOG]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -772,6 +789,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION LOG10]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -903,6 +921,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION MIDRANGE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1025,6 +1044,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION ORD-MAX]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1045,6 +1065,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION ORD-MIN]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1085,6 +1106,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION PRESENT-VALUE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1187,6 +1209,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION SECONDS-FROM-FORMATTED-TIME]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1216,6 +1239,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION SECONDS-PAST-MIDNIGHT]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1243,6 +1267,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION SIGN]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1301,6 +1326,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION SQRT]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1330,6 +1356,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION STANDARD-DEVIATION]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1358,6 +1385,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION STORED-CHAR-LENGTH]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1380,6 +1408,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION SUBSTITUTE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1402,6 +1431,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION SUBSTITUTE with reference modding]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1425,6 +1455,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION SUBSTITUTE-CASE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1447,6 +1478,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION SUBSTITUTE-CASE with reference mod]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1470,6 +1502,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION TAN]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1499,6 +1532,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION TRIM]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1523,6 +1557,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION TRIM with reference modding]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1589,6 +1624,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([FUNCTION VARIANCE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/run.src/fundamental.at b/tests/run.src/fundamental.at index 1933d115..728d1901 100644 --- a/tests/run.src/fundamental.at +++ b/tests/run.src/fundamental.at @@ -58,6 +58,7 @@ AT_CLEANUP AT_SETUP([DISPLAY literals, DECIMAL-POINT is COMMA]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -86,6 +87,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([Hexadecimal literal]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([dump.c], [ #include @@ -213,6 +215,7 @@ AT_CLEANUP AT_SETUP([GLOBAL at same level]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -261,6 +264,7 @@ AT_CLEANUP AT_SETUP([GLOBAL at lower level]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/run.src/miscellaneous.at b/tests/run.src/miscellaneous.at index 05409633..6090fe98 100644 --- a/tests/run.src/miscellaneous.at +++ b/tests/run.src/miscellaneous.at @@ -19,6 +19,7 @@ ## Boston, MA 02110-1301 USA AT_SETUP([Source file not found]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([${COMPILE_ONLY} prog.cob], [1], , [cobc: prog.cob: No such file or directory @@ -45,6 +46,7 @@ AT_CLEANUP AT_SETUP([LOCAL-STORAGE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -87,6 +89,7 @@ AT_CLEANUP AT_SETUP([EXTERNAL data item]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -129,6 +132,7 @@ AT_CLEANUP AT_SETUP([EXTERNAL AS data item]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -175,6 +179,7 @@ AT_CLEANUP AT_SETUP([cobcrun validation]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -259,6 +264,7 @@ AT_CHECK([java prog], [0], [1000]) AT_CLEANUP AT_SETUP([MOVE with refmod (variable)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -324,6 +330,7 @@ AT_CHECK([java prog], [0], [0]) AT_CLEANUP AT_SETUP([MOVE X'00']) +AT_CHECK([${SKIP_TEST}]) AT_DATA([dump.c], [ #include @@ -479,6 +486,7 @@ AT_CLEANUP ## CALL statement AT_SETUP([Dynamic call with static linking]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -504,6 +512,7 @@ AT_CHECK([java prog], [0], [OK]) AT_CLEANUP AT_SETUP([CALL m1. CALL m2. CALL m1.]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([m1.cob], [ IDENTIFICATION DIVISION. @@ -557,6 +566,7 @@ AT_CHECK([./caller], [0], AT_CLEANUP AT_SETUP([CANCEL ALL]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -606,6 +616,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([CALL binary literal parameter/LENGTH OF - so]) +AT_CHECK([${SKIP_TEST}]) AT_CHECK([test $SHREXT != "dll" || exit 77]) @@ -883,6 +894,7 @@ AT_CHECK([java prog], [0], [000003]) AT_CLEANUP AT_SETUP([INSPECT REPLACING TRAILING ZEROS BY SPACES]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -903,6 +915,7 @@ AT_CHECK([java prog], [0], [1 ]) AT_CLEANUP AT_SETUP([INSPECT REPLACING complex]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1032,6 +1045,7 @@ AT_CLEANUP ## (= the same as in MF-LRM "EXIT" FORMAT 2 ... ) AT_SETUP([EXIT PERFORM CYCLE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1318,6 +1332,7 @@ AT_CLEANUP AT_SETUP([REWRITE a RELATIVE file with RANDOM access]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1372,6 +1387,7 @@ AT_CLEANUP AT_SETUP([SORT: table sort]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1409,6 +1425,7 @@ e1d4c5b2a3 AT_CLEANUP AT_SETUP([SORT: EBCDIC table sort]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1606,6 +1623,7 @@ AT_CLEANUP AT_SETUP([Sticky LINKAGE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([test.conf], [ include "default.conf" @@ -1656,6 +1674,7 @@ AT_CHECK([./caller], [0], AT_CLEANUP AT_SETUP([COB_PRE_LOAD test]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -1680,6 +1699,7 @@ AT_CHECK([export COB_PRE_LOAD=callee; ./caller], [0], [OK]) AT_CLEANUP AT_SETUP([COB_LOAD_CASE=UPPER test]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([CALLEE.cob], [ IDENTIFICATION DIVISION. @@ -1729,6 +1749,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([ALLOCATE/FREE with BASED item]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1776,6 +1797,7 @@ AT_CHECK([java prog], [0], AT_CLEANUP AT_SETUP([CALL with OMITTED parameter]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -1814,6 +1836,7 @@ AT_CHECK([./caller], [0], AT_CLEANUP AT_SETUP([ANY LENGTH]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([callee.cob], [ IDENTIFICATION DIVISION. @@ -1887,6 +1910,7 @@ AT_CHECK([${COMPILE} -o prog prog.cob], [0], [], AT_CLEANUP AT_SETUP([SORT - missing fcd in variable-length WRITE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -1974,6 +1998,7 @@ AT_CHECK([java prog], [0], [027021013]) AT_CLEANUP AT_SETUP([READ - missing fcd in variable-length WRITE]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -2029,6 +2054,7 @@ AT_CLEANUP AT_SETUP([MOVE x TO numeric]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -2051,6 +2077,7 @@ AT_CLEANUP AT_SETUP([COMPUTE include string]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/run.src/ref-mod.at b/tests/run.src/ref-mod.at index f0e6ed44..4f4c10e1 100644 --- a/tests/run.src/ref-mod.at +++ b/tests/run.src/ref-mod.at @@ -88,6 +88,7 @@ d:d AT_CLEANUP AT_SETUP([Dynamic reference modification]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -148,6 +149,7 @@ prog.cob:14: Error: Length of 'X' out of bounds: 5 AT_CLEANUP AT_SETUP([Offset underflow]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -170,6 +172,7 @@ AT_CHECK([java prog], [1], , AT_CLEANUP AT_SETUP([Offset overflow]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -192,6 +195,7 @@ AT_CHECK([java prog], [1], , AT_CLEANUP AT_SETUP([Length underflow]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -214,6 +218,7 @@ AT_CHECK([java prog], [1], , AT_CLEANUP AT_SETUP([Length overflow]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -239,6 +244,7 @@ AT_CLEANUP # 6) TODO AT_SETUP([Offset out of bounds in MOVE (1)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -262,6 +268,7 @@ AT_CLEANUP AT_SETUP([Offset out of bounds in MOVE (2)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/run.src/return-code.at b/tests/run.src/return-code.at index d8e49668..0140cd1d 100644 --- a/tests/run.src/return-code.at +++ b/tests/run.src/return-code.at @@ -87,6 +87,7 @@ AT_CHECK([java prog], [0], [+000000000+000000001+000000001+000000000]) AT_CLEANUP AT_SETUP([RETURN-CODE nested]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/run.src/subscripts.at b/tests/run.src/subscripts.at index ef45c1a8..90e0b19a 100644 --- a/tests/run.src/subscripts.at +++ b/tests/run.src/subscripts.at @@ -26,6 +26,7 @@ # 1) TODO AT_SETUP([non-numeric subscript]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -54,6 +55,7 @@ AT_CLEANUP # 2) DONE AT_SETUP([The range of subscripts]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -94,6 +96,7 @@ AT_CLEANUP AT_SETUP([Subscript out of bounds (1)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -118,6 +121,7 @@ AT_CLEANUP AT_SETUP([Subscript out of bounds (2)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -141,6 +145,7 @@ AT_CHECK([java prog], [1], , AT_CLEANUP AT_SETUP([Subscript out of bounds (3-1)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -164,6 +169,7 @@ AT_CHECK([java prog], [1], , AT_CLEANUP AT_SETUP([Subscript out of bounds (3-2)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -187,6 +193,7 @@ AT_CHECK([java prog], [1], , AT_CLEANUP AT_SETUP([Subscript out of bounds (3-3)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -210,6 +217,7 @@ AT_CHECK([java prog], [1], , AT_CLEANUP AT_SETUP([Subscript out of bounds (3-4)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -233,6 +241,7 @@ AT_CHECK([java prog], [1], , AT_CLEANUP AT_SETUP([Value of DEPENDING ON N out of bounds (lower)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -257,6 +266,7 @@ AT_CLEANUP AT_SETUP([Value of DEPENDING ON N out of bounds (upper)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -327,6 +337,7 @@ AT_CLEANUP AT_SETUP([Subscript bounds with ODO]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -353,6 +364,7 @@ AT_CLEANUP ## AT_SETUP([Subscript by arithmetic expression]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -376,6 +388,7 @@ AT_CLEANUP AT_SETUP([Subscript out of bounds in MOVE (1)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -400,6 +413,7 @@ AT_CLEANUP AT_SETUP([Subscript out of bounds in MOVE (2)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -424,6 +438,7 @@ AT_CLEANUP AT_SETUP([Subscript out of bounds without debug]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -446,6 +461,7 @@ AT_CLEANUP AT_SETUP([Subscript out of bounds check option]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/syntax.src/assign-external.at b/tests/syntax.src/assign-external.at index a32b4b1b..18766f2e 100644 --- a/tests/syntax.src/assign-external.at +++ b/tests/syntax.src/assign-external.at @@ -1,4 +1,5 @@ AT_SETUP([ASSIGN TO DYNAMIC create file (assign_external)]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/syntax.src/free-1col-aster.at b/tests/syntax.src/free-1col-aster.at index d274ebcb..eeffdd7a 100644 --- a/tests/syntax.src/free-1col-aster.at +++ b/tests/syntax.src/free-1col-aster.at @@ -1,4 +1,5 @@ AT_SETUP([free_1col_aster OPTION]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/syntax.src/indicator.at b/tests/syntax.src/indicator.at index 686c8a03..645dda62 100644 --- a/tests/syntax.src/indicator.at +++ b/tests/syntax.src/indicator.at @@ -1,4 +1,5 @@ AT_SETUP([dollarif defined - true]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -17,6 +18,7 @@ AT_CHECK([${COBCRUN} prog], [0], [SW1 DEFINED AT_CLEANUP AT_SETUP([dollarif defined - false]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -37,6 +39,7 @@ AT_CHECK([${COBCRUN} prog], [0], [SW2 DEFINED AT_CLEANUP AT_SETUP([dollarif value match - true]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -57,6 +60,7 @@ AT_CHECK([${COBCRUN} prog], [0], [SW3 = 1 AT_CLEANUP AT_SETUP([dollarif value match - false]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -77,6 +81,7 @@ AT_CHECK([${COBCRUN} prog], [0], [SW3 != 1 AT_CLEANUP AT_SETUP([dollarif value match - not true]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -97,6 +102,7 @@ AT_CHECK([${COBCRUN} prog], [0], [SW4 != 1 AT_CLEANUP AT_SETUP([dollarif value match - not false]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -117,6 +123,7 @@ AT_CHECK([${COBCRUN} prog], [0], [SW4 = 1 AT_CLEANUP AT_SETUP([column 7 is undefined value]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. diff --git a/tests/syntax.src/move.at b/tests/syntax.src/move.at index 70a2c85d..4a752153 100644 --- a/tests/syntax.src/move.at +++ b/tests/syntax.src/move.at @@ -35,6 +35,7 @@ # 5) DONE AT_SETUP([MOVE SPACE TO numeric or numeric-edited item]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -60,6 +61,7 @@ AT_CLEANUP # 6) DONE AT_SETUP([MOVE ZERO TO alphabetic item]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -85,6 +87,7 @@ AT_CLEANUP # 8) TODO AT_SETUP([MOVE alphabetic TO x]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -140,6 +143,7 @@ AT_CHECK([${COMPILE_ONLY} prog.cob], [0]) AT_CLEANUP AT_SETUP([MOVE alphanumeric-edited TO x]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -169,6 +173,7 @@ prog.cob:17: Error: Invalid MOVE statement AT_CLEANUP AT_SETUP([MOVE numeric (integer) TO x]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -197,6 +202,7 @@ AT_CHECK([${COMPILE_ONLY} prog.cob], [1], , AT_CLEANUP AT_SETUP([MOVE numeric (non-integer) TO x]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -227,6 +233,7 @@ prog.cob:15: Error: Invalid MOVE statement AT_CLEANUP AT_SETUP([MOVE numeric-edited TO x]) +AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. From 4dc2311d4c836add1327527919ccf4837a3d1b10 Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Fri, 13 Jan 2023 13:28:58 +0900 Subject: [PATCH 08/17] Improve tests and CI (Fix #66) (#67) --- .github/workflows/cicd.yml | 110 ++++++++++++++++++------------------- 1 file changed, 53 insertions(+), 57 deletions(-) diff --git a/.github/workflows/cicd.yml b/.github/workflows/cicd.yml index b085369d..258f2083 100644 --- a/.github/workflows/cicd.yml +++ b/.github/workflows/cicd.yml @@ -8,18 +8,19 @@ jobs: run-tests: strategy: matrix: - os: ["ubuntu:22.04", "almalinux:9"] + #os: ["ubuntu:22.04", "almalinux:9"] + os: ["almalinux:9"] runs-on: ubuntu-latest container: image: ${{ matrix.os }} steps: - name: Install dependencies on Ubuntu 22.04 - if: matrix.os == 'ubuntu:22.04' + if: matrix.os == 'ubuntu:20.04' run: | - apt-get update -y - apt-get install -y default-jdk - apt-get install -y build-essential bison flex gettext texinfo automake autoconf libtool + apt update -y + apt install -y default-jdk + apt install -y build-essential bison flex gettext texinfo - name: Install dependencies on AlmaLinux 9 if: matrix.os == 'almalinux:9' @@ -38,61 +39,55 @@ jobs: ./configure --prefix=/usr/ make make install - export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - - #- name: Make test scripts - # run: | - # cd tests/ - # make - # cd ../ + export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - #- name: Run tests "command-line-options" - # run: | - # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - # cd tests/ - # ./command-line-options - # cd ../ + - name: Run tests "command-line-options" + run: | + export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + cd tests/ + ./command-line-options + cd ../ - #- name: Run tests "misc" - # run: | - # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - # cd tests/ - # ./misc - # cd ../ + - name: Run tests "misc" + run: | + export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + cd tests/ + ./misc + cd ../ - #- name: Run tests "data-rep" - # run: | - # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - # cd tests/ - # ./data-rep - # cd ../ + - name: Run tests "data-rep" + run: | + export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + cd tests/ + ./data-rep + cd ../ - #- name: Run tests "i18n_sjis" - # run: | - # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - # cd tests/ - # ./i18n_sjis + - name: Run tests "i18n_sjis" + run: | + export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + cd tests/ + ./i18n_sjis - #- name: Run tests "jp-compat" - # run: | - # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - # cd tests/ - # ./jp-compat - # cd ../ + - name: Run tests "jp-compat" + run: | + export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + cd tests/ + ./jp-compat + cd ../ - #- name: Run tests "run" - # run: | - # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - # cd tests/ - # ./run - # cd ../ + - name: Run tests "run" + run: | + export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + cd tests/ + ./run + cd ../ - #- name: Run tests "syntax" - # run: | - # export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" - # cd tests/ - # ./syntax - # cd ../ + - name: Run tests "syntax" + run: | + export CLASSPATH=":/usr/lib/opensourcecobol4j/libcobj.jar:$HOME/.java_lib/sqlite.jar" + cd tests/ + ./syntax + cd ../ - name: Run NIST test run: | @@ -116,10 +111,11 @@ jobs: # Checkout opensource COBOL - name: Checkout opensource COBOL 4j uses: actions/checkout@v2 - - - name: Install dependencies - run: | - sudo apt-get install default-jdk + + - uses: actions/setup-java@v3 + with: + distribution: 'temurin' + java-version: '17' # Download google-java-format and PMD - name: Install dependencies From 7b27ad5c97c355ebcfe48e19e0617ec8dd5a54f3 Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Thu, 19 Jan 2023 14:15:30 +0900 Subject: [PATCH 09/17] Improve Java interface (#69) --- cobj/codegen.c | 185 ++++++- libcobj/Makefile.am | 8 +- libcobj/Makefile.in | 8 +- .../libcobj/data/AbstractCobolField.java | 83 ++- .../data/CobolAlphanumericEditedField.java | 6 - .../libcobj/data/CobolAlphanumericField.java | 5 - .../libcobj/data/CobolGroupField.java | 6 - .../data/CobolNationalEditedField.java | 5 - .../libcobj/data/CobolNationalField.java | 5 - .../libcobj/data/CobolNumericBinaryField.java | 6 - .../libcobj/data/CobolNumericEditedField.java | 5 - .../libcobj/data/CobolNumericField.java | 19 +- .../libcobj/data/CobolNumericPackedField.java | 16 - .../libcobj/ui/CobolCallResult.java | 15 + .../libcobj/ui/CobolResultDouble.java | 13 + .../libcobj/ui/CobolResultInt.java | 13 + .../libcobj/ui/CobolResultSet.java | 36 ++ .../libcobj/ui/CobolResultSetException.java | 7 + .../libcobj/ui/CobolResultString.java | 13 + tests/Makefile.am | 3 +- tests/Makefile.in | 3 +- tests/misc.at | 1 + tests/misc.src/java-interface.at | 475 ++++++++++++++++++ 23 files changed, 853 insertions(+), 83 deletions(-) create mode 100644 libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolCallResult.java create mode 100644 libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultDouble.java create mode 100644 libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultInt.java create mode 100644 libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSet.java create mode 100644 libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSetException.java create mode 100644 libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultString.java create mode 100644 tests/misc.src/java-interface.at diff --git a/cobj/codegen.c b/cobj/codegen.c index 8a42cb4a..494c0e83 100644 --- a/cobj/codegen.c +++ b/cobj/codegen.c @@ -4150,6 +4150,113 @@ joutput_initial_values (struct cb_field *p) } } +struct call_parameter_list { + struct call_paramter_list* next; + struct cb_field* field; + cb_tree x; +}; +struct call_parameter_list* call_parameter_cache = NULL; + +static void +joutput_java_entrypoint (struct cb_program *prog, cb_tree parameter_list) +{ + cb_tree l; + struct cb_field *f; + char arg_field_name[COB_SMALL_BUFF]; + + joutput_prefix(); + joutput ("CobolResultSet execute ("); + + int k; + for (l = parameter_list; l; l = CB_CHAIN (l)) { + struct cb_field* arg_field = cb_field (CB_VALUE (l)); + int type = cb_tree_type(CB_TREE(arg_field)); + char* field_name = get_java_identifier_field(arg_field); + get_java_identifier_helper(arg_field, arg_field_name); + if(type & COB_TYPE_NUMERIC) { + if(arg_field->pic->scale > 0) { + joutput("double"); + } else { + joutput("int"); + } + } else { + joutput("String"); + } + joutput(" %s", arg_field_name); + if(CB_CHAIN(l)) { + joutput(", "); + } + + struct call_parameter_list* call_parameter = malloc(sizeof(struct call_parameter_list)); + call_parameter->next = call_parameter_cache; + call_parameter->field = arg_field; + call_parameter->x = CB_VALUE (l); + call_parameter_cache = call_parameter; + } + + joutput(") {\n"); + joutput_indent_level += 2; + + for (l = parameter_list; l; l = CB_CHAIN (l)) { + struct cb_field* arg_field = cb_field (CB_VALUE (l)); + char* field_name = get_java_identifier_field(arg_field); + char* base_name = get_java_identifier_base(arg_field); + get_java_identifier_helper(arg_field, arg_field_name); + joutput_line("this.%s.setDataStorage(new CobolDataStorage(%d));", + field_name, + arg_field->size + ); + joutput_line("this.%s.moveFrom(%s);", + field_name, + arg_field_name); + joutput_line("this.%s = this.%s.getDataStorage();", base_name, field_name); + free(field_name); + free(base_name); + } + + joutput_line("int returnCode = run_module(0);", prog->program_id); + + joutput_prefix(); + joutput("return new CobolResultSet(returnCode"); + if(parameter_list) { + joutput(",\n"); + joutput_indent_level += 2; + for (l = parameter_list; l; l = CB_CHAIN (l)) { + struct cb_field* arg_field = cb_field (CB_VALUE (l)); + char* field_name = get_java_identifier_field(arg_field); + int type = cb_tree_type(CB_TREE(arg_field)); + joutput_prefix(); + const char* constructor; + const char* getter; + if(type & COB_TYPE_NUMERIC) { + if(arg_field->pic->scale > 0) { + constructor = "CobolResultDouble"; + getter = "getDouble"; + } else { + constructor = "CobolResultInt"; + getter = "getInt"; + } + } else { + constructor = "CobolResultString"; + getter = "getString"; + } + joutput("new %s(%s.%s())", + constructor, + field_name, + getter + ); + joutput(CB_CHAIN(l) ? ",\n" : "\n"); + free(field_name); + } + joutput_indent_level -= 2; + joutput_prefix(); + } + + joutput(");\n"); + joutput_indent_level -= 2; + joutput_line("}\n"); +} + static void joutput_internal_function (struct cb_program *prog, cb_tree parameter_list) { @@ -4193,9 +4300,13 @@ joutput_internal_function (struct cb_program *prog, cb_tree parameter_list) parmnum++; } } - + joutput_line("return this.run_module(entry);"); + joutput_indent_level -=2; + joutput_line("}"); joutput("\n"); + joutput_line ("int run_module (int entry) {"); + joutput_indent_level += 2; //if (!prog->flag_chained) { // for (l = parameter_list; l; l = CB_CHAIN (l)) { // joutput_line ("if (fields.length > %d) {", parmnum); @@ -4939,23 +5050,54 @@ void joutput_init_method(struct cb_program *prog) { joutput_prefix(); char* field_name = get_java_identifier_field(k->f); - joutput ("%s\t= ", field_name); - free(field_name); + if (!k->f->flag_local && !k->f->flag_item_external) { + joutput ("%s\t= ", field_name); joutput_field (k->x); } else { + joutput ("%s\t= ", field_name); joutput ("CobolFieldFactory.makeCobolField("); joutput_size (k->x); - joutput (", (CobolDataStorage)null, "); + joutput(", (CobolDataStorage)null, "); joutput_attr (k->x); joutput (")"); } + + free(field_name); joutput (";\t/* %s */\n", k->f->name); } joutput("\n"); joutput_line ("/* End of fields */\n\n"); } + if(call_parameter_cache) { + joutput_line("/* Call parameters */"); + struct call_parameter_list* l; + for(l = call_parameter_cache; l; l=l->next) { + int cached = 0; + char* call_parameter_field_name = get_java_identifier_field(l->field); + if(field_cache) { + struct field_list* f; + for(f = field_cache; f; f=f->next) { + char* field_name = get_java_identifier_field(f->f); + if(f->f == l->field && strcmp(call_parameter_field_name, field_name) == 0) { + cached = 1; + free(field_name); + break; + } + free(field_name); + } + } + if(!cached) { + joutput_prefix(); + joutput("%s = CobolFieldFactory.makeCobolField(", call_parameter_field_name); + joutput("%d, (CobolDataStorage)null, ", l->field->size); + joutput_attr (l->x); + joutput (");\n"); + } + free(call_parameter_field_name); + } + } /* AbstractCobolField型変数の初期化(定数) */ if (literal_cache) { @@ -5308,13 +5450,6 @@ void joutput_declare_member_variables(struct cb_program *prog, cb_tree parameter joutput_line ("/* End of data storage */\n\n"); } - joutput_line("/* Call parameters */"); - for (l = parameter_list; l; l = CB_CHAIN (l)) { - char* base_name = get_java_identifier_base(cb_field (CB_VALUE (l))); - joutput_line("private CobolDataStorage %s;", base_name); - free(base_name); - } - /* Dangling linkage section items */ int seen = 0; for (f = prog->linkage_storage; f; f = f->sister) { @@ -5408,6 +5543,32 @@ void joutput_declare_member_variables(struct cb_program *prog, cb_tree parameter joutput_line ("private CobolFieldAttribute %s%d;", CB_PREFIX_ATTR, j->id); } + joutput("\n"); + } + + if(call_parameter_cache) { + joutput_line("/* Call parameters */"); + struct call_parameter_list* l; + for(l = call_parameter_cache; l; l=l->next) { + int cached = 0; + if(field_cache) { + struct field_list* f; + for(f = field_cache; f; f=f->next) { + if(f->f == l->field) { + cached = 1; + break; + } + } + } + if(!cached) { + char* field_name = get_java_identifier_field(l->field); + joutput_line("private AbstractCobolField %s;", field_name); + free(field_name); + } + char* base_name = get_java_identifier_base(l->field); + joutput_line("private CobolDataStorage %s;", base_name); + free(base_name); + } } joutput("\n"); @@ -5770,6 +5931,7 @@ codegen (struct cb_program *prog, const int nested, char** program_id_list) joutput_line("import jp.osscons.opensourcecobol.libcobj.termio.*;"); joutput_line("import jp.osscons.opensourcecobol.libcobj.call.*;"); joutput_line("import jp.osscons.opensourcecobol.libcobj.file.*;"); + joutput_line("import jp.osscons.opensourcecobol.libcobj.ui.*;"); joutput_line("import java.util.Optional;"); joutput("\n"); @@ -5830,6 +5992,7 @@ codegen (struct cb_program *prog, const int nested, char** program_id_list) //} create_label_id_map(prog); + joutput_java_entrypoint(prog, prog->parameter_list); joutput_internal_function (prog, prog->parameter_list); joutput_execution_list(prog); diff --git a/libcobj/Makefile.am b/libcobj/Makefile.am index e632f41f..47f0f83f 100644 --- a/libcobj/Makefile.am +++ b/libcobj/Makefile.am @@ -61,7 +61,13 @@ SRC_FILES = \ ./src/jp/osscons/opensourcecobol/libcobj/file/CobolSequentialFile.java \ ./src/jp/osscons/opensourcecobol/libcobj/file/FileStruct.java \ ./src/jp/osscons/opensourcecobol/libcobj/file/KeyComponent.java \ - ./src/jp/osscons/opensourcecobol/libcobj/termio/CobolTerminal.java + ./src/jp/osscons/opensourcecobol/libcobj/termio/CobolTerminal.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSetException.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSet.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolCallResult.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultInt.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultString.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultDouble.java all: libcobj.jar diff --git a/libcobj/Makefile.in b/libcobj/Makefile.in index 87c53dd4..d2035574 100644 --- a/libcobj/Makefile.in +++ b/libcobj/Makefile.in @@ -339,7 +339,13 @@ SRC_FILES = \ ./src/jp/osscons/opensourcecobol/libcobj/file/CobolSequentialFile.java \ ./src/jp/osscons/opensourcecobol/libcobj/file/FileStruct.java \ ./src/jp/osscons/opensourcecobol/libcobj/file/KeyComponent.java \ - ./src/jp/osscons/opensourcecobol/libcobj/termio/CobolTerminal.java + ./src/jp/osscons/opensourcecobol/libcobj/termio/CobolTerminal.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSetException.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSet.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolCallResult.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultInt.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultString.java \ + ./src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultDouble.java all: all-am diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/AbstractCobolField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/AbstractCobolField.java index 5405eafd..2b26b0d5 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/AbstractCobolField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/AbstractCobolField.java @@ -20,6 +20,7 @@ import java.math.BigDecimal; import java.nio.ByteBuffer; +import java.nio.charset.Charset; import jp.osscons.opensourcecobol.libcobj.common.CobolConstant; import jp.osscons.opensourcecobol.libcobj.common.CobolModule; import jp.osscons.opensourcecobol.libcobj.common.CobolUtil; @@ -163,7 +164,13 @@ public int getInt() { /** * @return */ - public abstract double getDouble(); + public double getDouble() { + try { + return Double.parseDouble(this.getString()); + } catch (Exception e) { + return 0; + } + } /** * 数値を表すデータが実装すべきメソッド. 保持する数値データをCobolDecimal型に変換する. @@ -585,19 +592,87 @@ protected void moveFromAll(AbstractCobolField src) { * * @param field 代入元のデータ(String型) */ - public abstract void moveFrom(String string); + public void moveFrom(String s) { + // The maximum number of digits of int type in decimal is 10 + + byte[] bytes = s.getBytes(Charset.forName("SJIS")); + + CobolDataStorage storage = new CobolDataStorage(bytes.length); + storage.memcpy(bytes); + + CobolFieldAttribute attr = + new CobolFieldAttribute( + CobolFieldAttribute.COB_TYPE_ALPHANUMERIC, + bytes.length, + 0, + 0, + String.format("X(%d)", bytes.length)); + + AbstractCobolField tmp = CobolFieldFactory.makeCobolField(bytes.length, storage, attr); + this.moveFrom(tmp); + } /** * 引数で与えらえられたデータからthisへの代入を行う * * @param field 代入元のデータ(int型) */ - public abstract void moveFrom(int number); + public void moveFrom(int number) { + // The maximum number of digits of int type in decimal is 10 + final int length = 10; + + CobolDataStorage storage = new CobolDataStorage(length); + String formatted_number_string = String.format("%10d", Math.abs(number)); + storage.memcpy(formatted_number_string, length); + if (number < 0) { + storage.setByte(length - 1, (byte) (storage.getByte(length - 1) + 0x40)); + } + + CobolFieldAttribute attr = + new CobolFieldAttribute( + CobolFieldAttribute.COB_TYPE_NUMERIC_DISPLAY, + length, + 0, + CobolFieldAttribute.COB_FLAG_HAVE_SIGN, + "S9(10)"); + + AbstractCobolField tmp = CobolFieldFactory.makeCobolField(length, storage, attr); + this.moveFrom(tmp); + } /** * 引数で与えらえられたデータからthisへの代入を行う * * @param field 代入元のデータ(double型) */ - public abstract void moveFrom(double number); + public void moveFrom(double number) { + String s = Double.toString(Math.abs(number)); + String ss; + int scale; + ss = s.replace("+", "").replace("-", ""); + int pointIndex = ss.indexOf('.'); + if (pointIndex < 0) { + scale = 0; + } else { + scale = ss.length() - 1 - pointIndex; + ss = ss.replace(".", ""); + } + + CobolDataStorage storage = new CobolDataStorage(ss.length()); + storage.memcpy(ss, ss.length()); + + CobolFieldAttribute attr = + new CobolFieldAttribute( + CobolFieldAttribute.COB_TYPE_NUMERIC_DISPLAY, + ss.length(), + scale, + CobolFieldAttribute.COB_FLAG_HAVE_SIGN, + ""); + + AbstractCobolField tmp = CobolFieldFactory.makeCobolField(ss.length(), storage, attr); + if (number < 0) { + tmp.putSign(-1); + } + this.moveFrom(tmp); + } /** * 引数で与えらえられたデータからthisへの代入を行う * diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolAlphanumericEditedField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolAlphanumericEditedField.java index f303b878..1ef5a377 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolAlphanumericEditedField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolAlphanumericEditedField.java @@ -47,12 +47,6 @@ public String getString() { return null; } - @Override - public double getDouble() { - // TODO Auto-generated method stub - return 0; - } - @Override public CobolDecimal getDecimal() { // TODO Auto-generated method stub diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolAlphanumericField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolAlphanumericField.java index 299fdb63..4a84669c 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolAlphanumericField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolAlphanumericField.java @@ -64,11 +64,6 @@ public int getInt() { throw new CobolRuntimeException(CobolRuntimeException.COBOL_FITAL_ERROR, "未対応"); } - @Override - public double getDouble() { - throw new CobolRuntimeException(CobolRuntimeException.COBOL_FITAL_ERROR, "未対応"); - } - @Override public void setDecimal(BigDecimal decimal) { // TODO 自動生成されたメソッド・スタブ diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolGroupField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolGroupField.java index 78140f00..faa0bbee 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolGroupField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolGroupField.java @@ -63,12 +63,6 @@ public int getInt() { return 0; } - /** TODO */ - @Override - public double getDouble() { - return 0; - } - /** TODO */ @Override public CobolDecimal getDecimal() { diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNationalEditedField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNationalEditedField.java index df80494b..3890d927 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNationalEditedField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNationalEditedField.java @@ -46,11 +46,6 @@ public String getString() { return null; } - @Override - public double getDouble() { - return 0; - } - @Override public CobolDecimal getDecimal() { return null; diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNationalField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNationalField.java index 4e975390..bde0d27b 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNationalField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNationalField.java @@ -64,11 +64,6 @@ public int getInt() { return 0; } - @Override - public double getDouble() { - return 0; - } - @Override public CobolDecimal getDecimal() { return null; diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericBinaryField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericBinaryField.java index f48f1996..35e5401a 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericBinaryField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericBinaryField.java @@ -125,12 +125,6 @@ public int getSign() { } } - /** TODO */ - @Override - public double getDouble() { - return 0; - } - /** TODO */ @Override public void setDecimal(BigDecimal decimal) {} diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericEditedField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericEditedField.java index cc6a3499..efd849fe 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericEditedField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericEditedField.java @@ -46,11 +46,6 @@ public String getString() { return null; } - @Override - public double getDouble() { - return 0; - } - @Override public CobolDecimal getDecimal() { return null; diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericField.java index 968a9d4c..b2b2a44e 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericField.java @@ -146,12 +146,6 @@ public int getInt() { return val; } - /** TODO */ - @Override - public double getDouble() { - throw new CobolRuntimeException(CobolRuntimeException.COBOL_FITAL_ERROR, "未対応"); - } - @Override public void setDecimal(BigDecimal decimal) { byte[] decimalBytes = decimal.toPlainString().getBytes(); @@ -810,13 +804,18 @@ public void moveFrom(String string) { */ @Override public void moveFrom(int number) { + int n = Math.abs(number); for (int i = 0; i < this.size; ++i) { this.dataStorage.setByte(i, (byte) 0x30); } for (int i = this.size - 1; i >= 0; --i) { - this.dataStorage.setByte(i, (byte) (0x30 + number % 10)); - number /= 10; + this.dataStorage.setByte(i, (byte) (0x30 + n % 10)); + n /= 10; + } + + if (number < 0 && this.getAttribute().isFlagHaveSign()) { + this.putSign(-1); } } @@ -1027,10 +1026,10 @@ public CobolNumericField getNumericField() { * * @param field 代入元のデータ(double型) */ - @Override + /*@Override public void moveFrom(double number) { this.moveFrom((int) number); - } + }*/ /** * 引数で与えらえられたデータからthisへの代入を行う diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericPackedField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericPackedField.java index eeede058..54f327d1 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericPackedField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericPackedField.java @@ -186,12 +186,6 @@ public String getString() { } } - /** TODO */ - @Override - public double getDouble() { - throw new CobolRuntimeException(CobolRuntimeException.COBOL_FITAL_ERROR, "未対応"); - } - @Override public void setDecimal(BigDecimal decimal) { byte[] decimalBytes = decimal.toPlainString().getBytes(); @@ -460,16 +454,6 @@ public CobolNumericField getNumericField() { return field; } - /** - * 引数で与えらえられたデータからthisへの代入を行う - * - * @param field 代入元のデータ(double型) - */ - @Override - public void moveFrom(double number) { - this.moveFrom((int) number); - } - /** * 引数で与えらえられたデータからthisへの代入を行う * diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolCallResult.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolCallResult.java new file mode 100644 index 00000000..39105dbc --- /dev/null +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolCallResult.java @@ -0,0 +1,15 @@ +package jp.osscons.opensourcecobol.libcobj.ui; + +public class CobolCallResult { + public int getInt() throws CobolResultSetException { + throw new CobolResultSetException("The result type is not 'int'"); + } + + public double getDouble() throws CobolResultSetException { + throw new CobolResultSetException("The result type is not 'double'"); + } + + public String getString() throws CobolResultSetException { + throw new CobolResultSetException("The result type is not 'String'"); + } +} diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultDouble.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultDouble.java new file mode 100644 index 00000000..1b4bbefc --- /dev/null +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultDouble.java @@ -0,0 +1,13 @@ +package jp.osscons.opensourcecobol.libcobj.ui; + +public class CobolResultDouble extends CobolCallResult { + private double value; + + public CobolResultDouble(double d) { + this.value = d; + } + + public double getDouble() throws CobolResultSetException { + return this.value; + } +} diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultInt.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultInt.java new file mode 100644 index 00000000..3cbc2499 --- /dev/null +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultInt.java @@ -0,0 +1,13 @@ +package jp.osscons.opensourcecobol.libcobj.ui; + +public class CobolResultInt extends CobolCallResult { + private int value; + + public CobolResultInt(int i) { + this.value = i; + } + + public int getInt() throws CobolResultSetException { + return this.value; + } +} diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSet.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSet.java new file mode 100644 index 00000000..4dda4a9a --- /dev/null +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSet.java @@ -0,0 +1,36 @@ +package jp.osscons.opensourcecobol.libcobj.ui; + +public class CobolResultSet { + private CobolCallResult results[]; + private int returnCode; + + public CobolResultSet(int returnCode, CobolCallResult... results) { + this.returnCode = returnCode; + this.results = results; + } + + private void checkIndexInValidRange(int index) throws CobolResultSetException { + if (results.length == 0 || index < 1 || this.results.length < index) { + throw new CobolResultSetException("The index is out of range."); + } + } + + public int getReturnCode() { + return this.returnCode; + } + + public String getString(int index) throws CobolResultSetException { + this.checkIndexInValidRange(index); + return this.results[index - 1].getString(); + } + + public int getInt(int index) throws CobolResultSetException { + this.checkIndexInValidRange(index); + return this.results[index - 1].getInt(); + } + + public double getDouble(int index) throws CobolResultSetException { + this.checkIndexInValidRange(index); + return this.results[index - 1].getDouble(); + } +} diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSetException.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSetException.java new file mode 100644 index 00000000..e8a72613 --- /dev/null +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultSetException.java @@ -0,0 +1,7 @@ +package jp.osscons.opensourcecobol.libcobj.ui; + +public class CobolResultSetException extends Exception { + public CobolResultSetException(String message) { + super(message); + } +} diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultString.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultString.java new file mode 100644 index 00000000..28200631 --- /dev/null +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/ui/CobolResultString.java @@ -0,0 +1,13 @@ +package jp.osscons.opensourcecobol.libcobj.ui; + +public class CobolResultString extends CobolCallResult { + private String value; + + public CobolResultString(String s) { + this.value = s; + } + + public String getString() throws CobolResultSetException { + return this.value; + } +} diff --git a/tests/Makefile.am b/tests/Makefile.am index 38dfe88a..00df3fce 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -160,7 +160,8 @@ misc_DEPENDENCIES = \ misc.src/current-date.at \ misc.src/comp3-is-numeric.at \ misc.src/high-low-value.at \ - misc.src/move-sign-leading-separate-to-signed-comp3.at + misc.src/move-sign-leading-separate-to-signed-comp3.at \ + misc.src/java-interface.at EXTRA_DIST = $(srcdir)/package.m4 \ $(TESTS) \ diff --git a/tests/Makefile.in b/tests/Makefile.in index eac835f7..ffd02b1a 100644 --- a/tests/Makefile.in +++ b/tests/Makefile.in @@ -699,7 +699,8 @@ misc_DEPENDENCIES = \ misc.src/current-date.at \ misc.src/comp3-is-numeric.at \ misc.src/high-low-value.at \ - misc.src/move-sign-leading-separate-to-signed-comp3.at + misc.src/move-sign-leading-separate-to-signed-comp3.at \ + misc.src/java-interface.at EXTRA_DIST = $(srcdir)/package.m4 \ $(TESTS) \ diff --git a/tests/misc.at b/tests/misc.at index bebc36f9..078c4ccb 100644 --- a/tests/misc.at +++ b/tests/misc.at @@ -23,3 +23,4 @@ m4_include([current-date.at]) m4_include([comp3-is-numeric.at]) m4_include([high-low-value.at]) m4_include([move-sign-leading-separate-to-signed-comp3.at]) +m4_include([java-interface.at]) diff --git a/tests/misc.src/java-interface.at b/tests/misc.src/java-interface.at new file mode 100644 index 00000000..904a07a9 --- /dev/null +++ b/tests/misc.src/java-interface.at @@ -0,0 +1,475 @@ +AT_SETUP([no-argument]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + procedure division. + display " b". +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs = prog.execute(); + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0], +[ b +]) + +AT_CLEANUP + +AT_SETUP([PIC 9(3)]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg pic 9(3). + procedure division using arg. + display " arg: " arg. + add 1 to arg. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs; + int@<:@@:>@ data_list = {0, 1, 2, 998}; + try{ + for(int data : data_list) { + rs = prog.execute(data); + System.out.println(" arg: " + rs.getInt(1)); + } + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0], +[ arg: 000 + arg: 1 + arg: 001 + arg: 2 + arg: 002 + arg: 3 + arg: 998 + arg: 999 +]) + +AT_CLEANUP + +AT_SETUP([PIC S9(3)]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg pic S9(3). + procedure division using arg. + display " arg: " arg. + add 1 to arg. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs; + int@<:@@:>@ data_list = {-999, -2, -1, 0, 1, 2, 998}; + try{ + for(int data : data_list) { + rs = prog.execute(data); + System.out.println(" arg: " + rs.getInt(1)); + } + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0], +[ arg: -999 + arg: -998 + arg: -002 + arg: -1 + arg: -001 + arg: 0 + arg: +000 + arg: 1 + arg: +001 + arg: 2 + arg: +002 + arg: 3 + arg: +998 + arg: 999 +]) + +AT_CLEANUP + +AT_SETUP([PIC S9(3)V99]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg pic S9(3)V99. + procedure division using arg. + display " arg: " arg. + add 1 to arg. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs; + double@<:@@:>@ data_list = {-999.99, -2.01, -1.01, -1.00, 0, 1.01, 2.01, 998.99}; + try{ + for(double data : data_list) { + rs = prog.execute(data); + System.out.println(" arg: " + rs.getDouble(1)); + } + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0], +[ arg: -999.99 + arg: -998.99 + arg: -002.01 + arg: -1.01 + arg: -001.01 + arg: -0.01 + arg: -001.00 + arg: 0.0 + arg: +000.00 + arg: 1.0 + arg: +001.01 + arg: 2.01 + arg: +002.01 + arg: 3.01 + arg: +998.99 + arg: 999.99 +]) + +AT_CLEANUP + + +AT_SETUP([PIC 9(3) USAGE COMP-3]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg pic 9(3) USAGE COMP-3. + procedure division using arg. + display " arg: " arg. + add 1 to arg. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs; + int@<:@@:>@ data_list = {0, 1, 2, 998}; + try{ + for(int data : data_list) { + rs = prog.execute(data); + System.out.println(" arg: " + rs.getInt(1)); + } + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0], +[ arg: 000 + arg: 1 + arg: 001 + arg: 2 + arg: 002 + arg: 3 + arg: 998 + arg: 999 +]) + +AT_CLEANUP + +AT_SETUP([PIC S9(3) USAGE COMP-3]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg pic S9(3) USAGE COMP-3. + procedure division using arg. + display " arg: " arg. + add 1 to arg. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs; + int@<:@@:>@ data_list = {-999, -2, -1, 0, 1, 2, 998}; + try{ + for(int data : data_list) { + rs = prog.execute(data); + System.out.println(" arg: " + rs.getInt(1)); + } + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0], +[ arg: -999 + arg: -998 + arg: -002 + arg: -1 + arg: -001 + arg: 0 + arg: +000 + arg: 1 + arg: +001 + arg: 2 + arg: +002 + arg: 3 + arg: +998 + arg: 999 +]) + +AT_CLEANUP + +AT_SETUP([PIC S9(3)V99 USAGE COMP-3]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg pic S9(3)V99 USAGE COMP-3. + procedure division using arg. + display " arg: " arg. + add 1 to arg. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs; + double@<:@@:>@ data_list = {-999.99, -2.01, -1.01, -1.00, 0, 1.01, 2.01, 998.99}; + try{ + for(double data : data_list) { + rs = prog.execute(data); + System.out.println(" arg: " + rs.getDouble(1)); + } + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0], +[ arg: -999.99 + arg: -998.99 + arg: -002.01 + arg: -1.01 + arg: -001.01 + arg: -0.01 + arg: -001.00 + arg: 0.0 + arg: +000.00 + arg: 1.0 + arg: +001.01 + arg: 2.01 + arg: +002.01 + arg: 3.01 + arg: +998.99 + arg: 999.99 +]) + +AT_CLEANUP + +AT_SETUP([PIC X(3)]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg pic X(3). + procedure division using arg. + display " arg: " arg. + MOVE "123" TO arg. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs; + try{ + rs = prog.execute("abc"); + System.out.println(" arg: " + rs.getString(1)); + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0], +[ arg: abc + arg: 123 +]) + +AT_CLEANUP + +AT_SETUP([Out of range]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg pic 9(3). + procedure division using arg. + add 1 to arg. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs; + try{ + rs = prog.execute(0); + System.out.println(" arg: " + rs.getInt(2)); + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a 2>&1 | grep 'The index is out of range' > /dev/null], [0]) +AT_CLEANUP + +AT_SETUP([Type mismatch]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg-i pic 9(3). + 01 arg-d pic 9(3)V9. + 01 arg-s pic X(3). + procedure division using arg-i arg-d arg-s. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs = prog.execute(1, 1.1, "abc"); + try{ + rs.getDouble(1); + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + try{ + rs.getString(1); + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + try{ + rs.getInt(2); + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + try{ + rs.getString(2); + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + try{ + rs.getInt(3); + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + try{ + rs.getDouble(3); + } catch(CobolResultSetException e) { + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac a.java]) +AT_CHECK([java a 2>&1 | grep 'jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException'], [0], +[jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type is not 'double' +jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type is not 'String' +jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type is not 'int' +jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type is not 'String' +jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type is not 'int' +jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type is not 'double' +]) +AT_CLEANUP \ No newline at end of file From 95d121ccd4fa1aaa89bbd23a62af30dc5674cbad Mon Sep 17 00:00:00 2001 From: kio-watanabe <111848844+kio-watanabe@users.noreply.github.com> Date: Thu, 19 Jan 2023 17:33:47 +0900 Subject: [PATCH 10/17] Created cob_delete_file method (#68) --- cobj/typeck.c | 8336 ++++++++++------- .../libcobj/file/CobolFile.java | 137 +- tests/jp-compat.src/file-control.at | 2 - 3 files changed, 4957 insertions(+), 3518 deletions(-) diff --git a/cobj/typeck.c b/cobj/typeck.c index 90ad6671..0d75c0d0 100644 --- a/cobj/typeck.c +++ b/cobj/typeck.c @@ -29,24 +29,26 @@ #ifdef HAVE_SYS_TIME_H #include #endif -#ifdef _WIN32 +#ifdef _WIN32 #define WIN32_LEAN_AND_MEAN #include -#endif +#endif -#ifdef HAVE_LOCALE_H +#ifdef HAVE_LOCALE_H #include -#endif +#endif #include "cobj.h" #include "tree.h" -struct system_table { - const char *syst_name; - const int syst_params; +struct system_table +{ + const char *syst_name; + const int syst_params; }; -struct expr_node { +struct expr_node +{ /* The token of this node. * 'x' - values (cb_tree) * '+', '-', '*', '/', '^' - arithmetic operators @@ -54,51 +56,50 @@ struct expr_node { * '!', '&', '|' - logical operators * '(', ')' - parentheses */ - int token; + int token; /* The value itself if this node is a value */ - cb_tree value; + cb_tree value; }; -#define START_STACK_SIZE 32 -#define TOKEN(offset) (expr_stack[expr_index + offset].token) -#define VALUE(offset) (expr_stack[expr_index + offset].value) +#define START_STACK_SIZE 32 +#define TOKEN(offset) (expr_stack[expr_index + offset].token) +#define VALUE(offset) (expr_stack[expr_index + offset].value) -#define dpush(x) decimal_stack = cb_cons (x, decimal_stack) +#define dpush(x) decimal_stack = cb_cons(x, decimal_stack) #define cb_emit(x) \ - current_statement->body = cb_list_add (current_statement->body, x) + current_statement->body = cb_list_add(current_statement->body, x) #define cb_emit_list(l) \ - current_statement->body = cb_list_append (current_statement->body, l) + current_statement->body = cb_list_append(current_statement->body, l) /* Global variables */ -size_t sending_id = 0; -size_t suppress_warn = 0; +size_t sending_id = 0; +size_t suppress_warn = 0; /* Local variables */ -static cb_tree decimal_stack = NULL; +static cb_tree decimal_stack = NULL; -static const char *inspect_func; -static cb_tree inspect_data; +static const char *inspect_func; +static cb_tree inspect_data; -static int expr_op; /* last operator */ -static cb_tree expr_lh; /* last left hand */ +static int expr_op; /* last operator */ +static cb_tree expr_lh; /* last left hand */ -static int expr_index; /* stack index */ -static int expr_stack_size; /* stack max size */ -static struct expr_node *expr_stack; /* expr node stack */ +static int expr_index; /* stack index */ +static int expr_stack_size; /* stack max size */ +static struct expr_node *expr_stack; /* expr node stack */ -static char expr_prio[256]; +static char expr_prio[256]; -static const struct system_table system_tab[] = { -#undef COB_SYSTEM_GEN -#define COB_SYSTEM_GEN(x, y, z) { x, y }, +static const struct system_table system_tab[] = { +#undef COB_SYSTEM_GEN +#define COB_SYSTEM_GEN(x, y, z) {x, y}, #include - { NULL, 0 } -}; + {NULL, 0}}; -static const char *const bin_set_funcs[] = { +static const char *const bin_set_funcs[] = { NULL, "setSwpU16Binary", "setSwpU24Binary", @@ -114,10 +115,9 @@ static const char *const bin_set_funcs[] = { "setSwpS40Binary", "setSwpS48Binary", "setSwpS56Binary", - "setSwpS64Binary" -}; + "setSwpS64Binary"}; -static const char *const bin_compare_funcs[] = { +static const char *const bin_compare_funcs[] = { "cmpU8Binary", "cmpU16Binary", "cmpU24Binary", @@ -149,10 +149,9 @@ static const char *const bin_compare_funcs[] = { "cmpSwpS40Binary", "cmpSwpS48Binary", "cmpSwpS56Binary", - "cmpSwpS64Binary" -}; + "cmpSwpS64Binary"}; -static const char *const bin_add_funcs[] = { +static const char *const bin_add_funcs[] = { "addU8Binary", "addU16Binary", "addU24Binary", @@ -184,10 +183,9 @@ static const char *const bin_add_funcs[] = { "addSwpS40Binary", "addSwpS48Binary", "addSwpS56Binary", - "addSwpS64Binary" -}; + "addSwpS64Binary"}; -static const char *const bin_sub_funcs[] = { +static const char *const bin_sub_funcs[] = { "subU8Binary", "subU16Binary", "subU24Binary", @@ -219,29 +217,33 @@ static const char *const bin_sub_funcs[] = { "subSwpS40Binary", "subSwpS48Binary", "subSwpS56Binary", - "subSwpS64Binary" -}; + "subSwpS64Binary"}; /* functions */ static size_t -cb_validate_one (cb_tree x) +cb_validate_one(cb_tree x) { - cb_tree y; + cb_tree y; - if (x == cb_error_node) { + if (x == cb_error_node) + { return 1; } - if (!x) { + if (!x) + { return 0; } - if (CB_REFERENCE_P (x)) { - y = cb_ref (x); - if (y == cb_error_node) { + if (CB_REFERENCE_P(x)) + { + y = cb_ref(x); + if (y == cb_error_node) + { return 1; } - if (CB_FIELD_P (y) && CB_FIELD (y)->level == 88) { - cb_error_x (x, _("Invalid use of 88 level item")); + if (CB_FIELD_P(y) && CB_FIELD(y)->level == 88) + { + cb_error_x(x, _("Invalid use of 88 level item")); return 1; } } @@ -249,29 +251,35 @@ cb_validate_one (cb_tree x) } static size_t -cb_validate_numeric (cb_tree x) +cb_validate_numeric(cb_tree x) { - if (x == cb_error_node) { + if (x == cb_error_node) + { return 1; } - if (!x) { + if (!x) + { return 0; } - if (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) { + if (CB_TREE_CATEGORY(x) == CB_CATEGORY_NUMERIC) + { return 0; } - cb_error_x (x, _("'%s' must be a numeric type!"), cb_name (x)); + cb_error_x(x, _("'%s' must be a numeric type!"), cb_name(x)); return 1; } static size_t -cb_validate_list (cb_tree l) +cb_validate_list(cb_tree l) { - if (l == cb_error_node) { + if (l == cb_error_node) + { return 1; } - for (; l; l = CB_CHAIN (l)) { - if (cb_validate_one (CB_VALUE (l))) { + for (; l; l = CB_CHAIN(l)) + { + if (cb_validate_one(CB_VALUE(l))) + { return 1; } } @@ -279,113 +287,125 @@ cb_validate_list (cb_tree l) } static cb_tree -cb_check_group_name (cb_tree x) +cb_check_group_name(cb_tree x) { - cb_tree y; + cb_tree y; - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (CB_REFERENCE_P (x)) { - y = cb_ref (x); - if (y == cb_error_node) { + if (CB_REFERENCE_P(x)) + { + y = cb_ref(x); + if (y == cb_error_node) + { return cb_error_node; } - if (CB_FIELD_P (y) && CB_FIELD (y)->children != NULL && - CB_REFERENCE (x)->offset == NULL) { + if (CB_FIELD_P(y) && CB_FIELD(y)->children != NULL && + CB_REFERENCE(x)->offset == NULL) + { return x; } } - cb_error_x (x, _("'%s' is not group name"), cb_name (x)); + cb_error_x(x, _("'%s' is not group name"), cb_name(x)); return cb_error_node; } static cb_tree -cb_check_numeric_name (cb_tree x) +cb_check_numeric_name(cb_tree x) { - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (CB_REFERENCE_P (x) - && CB_FIELD_P (cb_ref (x)) - && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) { + if (CB_REFERENCE_P(x) && CB_FIELD_P(cb_ref(x)) && CB_TREE_CATEGORY(x) == CB_CATEGORY_NUMERIC) + { return x; } - cb_error_x (x, _("'%s' is not a numeric name"), cb_name (x)); + cb_error_x(x, _("'%s' is not a numeric name"), cb_name(x)); return cb_error_node; } static cb_tree -cb_check_numeric_edited_name (cb_tree x) +cb_check_numeric_edited_name(cb_tree x) { - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (CB_REFERENCE_P (x) - && CB_FIELD_P (cb_ref (x)) - && (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC - || CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC_EDITED)) { + if (CB_REFERENCE_P(x) && CB_FIELD_P(cb_ref(x)) && (CB_TREE_CATEGORY(x) == CB_CATEGORY_NUMERIC || CB_TREE_CATEGORY(x) == CB_CATEGORY_NUMERIC_EDITED)) + { return x; } - cb_error_x (x, _("'%s' is not numeric or numeric-edited name"), cb_name (x)); + cb_error_x(x, _("'%s' is not numeric or numeric-edited name"), cb_name(x)); return cb_error_node; } cb_tree -cb_check_numeric_value (cb_tree x) +cb_check_numeric_value(cb_tree x) { - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) { + if (CB_TREE_CATEGORY(x) == CB_CATEGORY_NUMERIC) + { return x; } - cb_error_x (x, _("'%s' is not a numeric value"), cb_name (x)); + cb_error_x(x, _("'%s' is not a numeric value"), cb_name(x)); return cb_error_node; } static cb_tree -cb_check_integer_value (cb_tree x) +cb_check_integer_value(cb_tree x) { - struct cb_literal *l; - struct cb_field *f; - cb_tree y; + struct cb_literal *l; + struct cb_field *f; + cb_tree y; - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC) { + if (CB_TREE_CATEGORY(x) != CB_CATEGORY_NUMERIC) + { goto invalid; } - switch (CB_TREE_TAG (x)) { + switch (CB_TREE_TAG(x)) + { case CB_TAG_CONST: - if (x != cb_zero) { + if (x != cb_zero) + { goto invalid; } return x; case CB_TAG_LITERAL: - l = CB_LITERAL (x); - if (l->sign < 0 || l->scale > 0) { + l = CB_LITERAL(x); + if (l->sign < 0 || l->scale > 0) + { goto invliteral; } return x; case CB_TAG_REFERENCE: - y = cb_ref (x); - if (y == cb_error_node) { + y = cb_ref(x); + if (y == cb_error_node) + { return cb_error_node; } - f = CB_FIELD (y); - if (f->pic->scale > 0) { + f = CB_FIELD(y); + if (f->pic->scale > 0) + { goto invalid; } return x; @@ -396,195 +416,221 @@ cb_check_integer_value (cb_tree x) /* TODO: need to check */ return x; default: -invalid: - cb_error_x (x, _("'%s' is not an integer value"), cb_name (x)); + invalid: + cb_error_x(x, _("'%s' is not an integer value"), cb_name(x)); return cb_error_node; } invliteral: - cb_error_x (x, _("A positive numeric integer is required here")); + cb_error_x(x, _("A positive numeric integer is required here")); return cb_error_node; } -void -cb_build_registers (void) +void cb_build_registers(void) { #if !defined(__linux__) && !defined(__CYGWIN__) && defined(HAVE_TIMEZONE) - long contz; + long contz; #endif - time_t t; - char buff[48]; + time_t t; + char buff[48]; /* RETURN-CODE */ - if (!current_program->nested_level) { + if (!current_program->nested_level) + { current_program->cb_return_code = - cb_build_index (cb_build_reference ("RETURN-CODE"), - cb_zero, 0, NULL); - cb_field (current_program->cb_return_code)->flag_is_global = 1; + cb_build_index(cb_build_reference("RETURN-CODE"), + cb_zero, 0, NULL); + cb_field(current_program->cb_return_code)->flag_is_global = 1; } /* SORT-RETURN */ current_program->cb_sort_return = - cb_build_index (cb_build_reference ("SORT-RETURN"), cb_zero, 0, NULL); - cb_field (current_program->cb_sort_return)->flag_no_init = 1; + cb_build_index(cb_build_reference("SORT-RETURN"), cb_zero, 0, NULL); + cb_field(current_program->cb_sort_return)->flag_no_init = 1; /* NUMBER-OF-CALL-PARAMETERS */ current_program->cb_call_params = - cb_build_index (cb_build_reference ("NUMBER-OF-CALL-PARAMETERS"), cb_zero, 0, NULL); - cb_field (current_program->cb_call_params)->flag_no_init = 1; + cb_build_index(cb_build_reference("NUMBER-OF-CALL-PARAMETERS"), cb_zero, 0, NULL); + cb_field(current_program->cb_call_params)->flag_no_init = 1; /* TALLY */ /* 01 TALLY GLOBAL PICTURE 9(9) USAGE COMP-5 VALUE ZERO. */ /* TALLY/EXAMINE not standard/supported */ - t = time (NULL); + t = time(NULL); /* WHEN-COMPILED */ - memset (buff, 0, sizeof (buff)); - strftime (buff, 17, "%m/%d/%y%H.%M.%S", localtime (&t)); - cb_build_constant (cb_build_reference ("WHEN-COMPILED"), - cb_build_alphanumeric_literal ((ucharptr)buff, 16)); + memset(buff, 0, sizeof(buff)); + strftime(buff, 17, "%m/%d/%y%H.%M.%S", localtime(&t)); + cb_build_constant(cb_build_reference("WHEN-COMPILED"), + cb_build_alphanumeric_literal((ucharptr)buff, 16)); /* FUNCTION WHEN-COMPILED */ - memset (buff, 0, sizeof (buff)); + memset(buff, 0, sizeof(buff)); #if defined(__linux__) || defined(__CYGWIN__) - strftime (buff, 22, "%Y%m%d%H%M%S00%z", localtime (&t)); + strftime(buff, 22, "%Y%m%d%H%M%S00%z", localtime(&t)); #elif defined(HAVE_TIMEZONE) - strftime (buff, 17, "%Y%m%d%H%M%S00", localtime (&t)); - if (timezone <= 0) { + strftime(buff, 17, "%Y%m%d%H%M%S00", localtime(&t)); + if (timezone <= 0) + { contz = -timezone; buff[16] = '+'; - } else { + } + else + { contz = timezone; buff[16] = '-'; } - sprintf (&buff[17], "%2.2ld%2.2ld", contz / 3600, contz % 60); + sprintf(&buff[17], "%2.2ld%2.2ld", contz / 3600, contz % 60); #else - strftime (buff, 22, "%Y%m%d%H%M%S0000000", localtime (&t)); + strftime(buff, 22, "%Y%m%d%H%M%S0000000", localtime(&t)); #endif - cb_intr_whencomp = cb_build_alphanumeric_literal ((ucharptr)buff, 21); + cb_intr_whencomp = cb_build_alphanumeric_literal((ucharptr)buff, 21); /* FUNCTION PI */ - memset (buff, 0, sizeof (buff)); - strcpy (buff, "31415926535897932384626433832795029"); - cb_intr_pi = cb_build_numeric_literal (0, (ucharptr)buff, 34); + memset(buff, 0, sizeof(buff)); + strcpy(buff, "31415926535897932384626433832795029"); + cb_intr_pi = cb_build_numeric_literal(0, (ucharptr)buff, 34); /* FUNCTION E */ - memset (buff, 0, sizeof (buff)); - strcpy (buff, "27182818284590452353602874713526625"); - cb_intr_e = cb_build_numeric_literal (0, (ucharptr)buff, 34); + memset(buff, 0, sizeof(buff)); + strcpy(buff, "27182818284590452353602874713526625"); + cb_intr_e = cb_build_numeric_literal(0, (ucharptr)buff, 34); } char * -cb_encode_program_id (const char *name) +cb_encode_program_id(const char *name) { - unsigned char *p; - const unsigned char *s; - unsigned char buff[COB_SMALL_BUFF]; + unsigned char *p; + const unsigned char *s; + unsigned char buff[COB_SMALL_BUFF]; p = buff; s = (const unsigned char *)name; /* encode the initial digit */ - if (isdigit (*s)) { - p += sprintf ((char *)p, "_%02X", *s++); + if (isdigit(*s)) + { + p += sprintf((char *)p, "_%02X", *s++); } /* encode invalid letters */ - for (; *s; s++) { - if (isalnum (*s) || *s == '_') { + for (; *s; s++) + { + if (isalnum(*s) || *s == '_') + { *p++ = *s; - } else if (*s == '-') { + } + else if (*s == '-') + { *p++ = '_'; *p++ = '_'; - } else { - p += sprintf ((char *)p, "_%02X", *s); + } + else + { + p += sprintf((char *)p, "_%02X", *s); } } *p = 0; - return strdup ((char *)buff); + return strdup((char *)buff); } const char * -cb_build_program_id (cb_tree name, cb_tree alt_name) +cb_build_program_id(cb_tree name, cb_tree alt_name) { - const char *s; + const char *s; -/* This needs some more thought, should we generate an entry - point per program source name ? - if (alt_name) { - s = (char *)CB_LITERAL (alt_name)->data; - } else if (CB_LITERAL_P (name)) { - s = (char *)CB_LITERAL (name)->data; - } else { - s = (char *)CB_NAME (name); - } + /* This needs some more thought, should we generate an entry + point per program source name ? + if (alt_name) { + s = (char *)CB_LITERAL (alt_name)->data; + } else if (CB_LITERAL_P (name)) { + s = (char *)CB_LITERAL (name)->data; + } else { + s = (char *)CB_NAME (name); + } - if (!cb_flag_main && strcmp (s, source_name)) { - cb_warning (_("Source name '%s' differs from PROGRAM-ID '%s'"), - source_name, s); - current_program->source_name = strdup (source_name); - } - End comment out */ + if (!cb_flag_main && strcmp (s, source_name)) { + cb_warning (_("Source name '%s' differs from PROGRAM-ID '%s'"), + source_name, s); + current_program->source_name = strdup (source_name); + } + End comment out */ - if (alt_name) { - current_program->orig_source_name = strdup ((char *)CB_LITERAL (alt_name)->data); - s = (char *)CB_LITERAL (alt_name)->data; - } else if (CB_LITERAL_P (name)) { - current_program->orig_source_name = strdup ((char *)CB_LITERAL (name)->data); - s = cb_encode_program_id ((char *)CB_LITERAL (name)->data); - } else { - current_program->orig_source_name = strdup (CB_NAME (name)); - s = cb_encode_program_id (CB_NAME (name)); + if (alt_name) + { + current_program->orig_source_name = strdup((char *)CB_LITERAL(alt_name)->data); + s = (char *)CB_LITERAL(alt_name)->data; } - if (cobc_check_valid_name (current_program->orig_source_name)) { - cb_error (_("PROGRAM-ID '%s' invalid"), current_program->orig_source_name); + else if (CB_LITERAL_P(name)) + { + current_program->orig_source_name = strdup((char *)CB_LITERAL(name)->data); + s = cb_encode_program_id((char *)CB_LITERAL(name)->data); + } + else + { + current_program->orig_source_name = strdup(CB_NAME(name)); + s = cb_encode_program_id(CB_NAME(name)); + } + if (cobc_check_valid_name(current_program->orig_source_name)) + { + cb_error(_("PROGRAM-ID '%s' invalid"), current_program->orig_source_name); } return s; } -void -cb_define_switch_name (cb_tree name, cb_tree sname, cb_tree flag, cb_tree ref) +void cb_define_switch_name(cb_tree name, cb_tree sname, cb_tree flag, cb_tree ref) { cb_tree switch_id; cb_tree value; - if (name == cb_error_node) { + if (name == cb_error_node) + { return; } - if (sname == cb_error_node) { + if (sname == cb_error_node) + { return; } - if (CB_SYSTEM_NAME (sname)->category != CB_SWITCH_NAME) { - if (!ref) { - cb_error_x (ref, _("Switch-name is expected '%s'"), CB_NAME (ref)); - } else { - cb_error_x (name, _("'%s' with no Switch-name"), CB_NAME (name)); + if (CB_SYSTEM_NAME(sname)->category != CB_SWITCH_NAME) + { + if (!ref) + { + cb_error_x(ref, _("Switch-name is expected '%s'"), CB_NAME(ref)); } - } else { - switch_id = cb_int (CB_SYSTEM_NAME (sname)->token); - value = cb_build_funcall_1 ("CobolUtil.getSwitch", switch_id); - if (flag == cb_int0) { - value = cb_build_negation (value); + else + { + cb_error_x(name, _("'%s' with no Switch-name"), CB_NAME(name)); } - cb_build_constant (name, value); + } + else + { + switch_id = cb_int(CB_SYSTEM_NAME(sname)->token); + value = cb_build_funcall_1("CobolUtil.getSwitch", switch_id); + if (flag == cb_int0) + { + value = cb_build_negation(value); + } + cb_build_constant(name, value); } } cb_tree -cb_build_section_name (cb_tree name, int sect_or_para) +cb_build_section_name(cb_tree name, int sect_or_para) { cb_tree x; - if (name == cb_error_node) { + if (name == cb_error_node) + { return cb_error_node; } - if (CB_REFERENCE (name)->word->count > 0) { - x = CB_VALUE (CB_REFERENCE (name)->word->items); + if (CB_REFERENCE(name)->word->count > 0) + { + x = CB_VALUE(CB_REFERENCE(name)->word->items); /* Used as a non-label name or used as a section name. Duplicate paragraphs are allowed if not referenced; Checked in typeck.c */ - if (!CB_LABEL_P (x) || sect_or_para == 0 - || (sect_or_para && CB_LABEL_P (x) && CB_LABEL (x)->is_section)) { - redefinition_error (name); + if (!CB_LABEL_P(x) || sect_or_para == 0 || (sect_or_para && CB_LABEL_P(x) && CB_LABEL(x)->is_section)) + { + redefinition_error(name); return cb_error_node; } } @@ -593,22 +639,26 @@ cb_build_section_name (cb_tree name, int sect_or_para) } static char * -get_coded_filename (const char *cname, int idx) +get_coded_filename(const char *cname, int idx) { - const char *p = cname; - int cnt = 0; - char *rt = NULL; + const char *p = cname; + int cnt = 0; + char *rt = NULL; - while (*p && cnt < idx) { - if (*p == '-') { + while (*p && cnt < idx) + { + if (*p == '-') + { cnt++; } p++; } - if (*p) { - rt = strdup (p); - p = rt; - while (*p && *p != '-') { + if (*p) + { + rt = strdup(p); + p = rt; + while (*p && *p != '-') + { p++; } rt[p - rt] = '\0'; @@ -617,81 +667,96 @@ get_coded_filename (const char *cname, int idx) } cb_tree -cb_build_assignment_name (struct cb_file *cfile, cb_tree name) +cb_build_assignment_name(struct cb_file *cfile, cb_tree name) { - const char *s; - const char *p; - cb_tree x; - char *pp; + const char *s; + const char *p; + cb_tree x; + char *pp; - if (name == cb_error_node) { + if (name == cb_error_node) + { return cb_error_node; } - if (cfile->fileid_assign == 1 && cfile->external_assign != 1) { + if (cfile->fileid_assign == 1 && cfile->external_assign != 1) + { return NULL; } - switch (CB_TREE_TAG (name)) { + switch (CB_TREE_TAG(name)) + { case CB_TAG_LITERAL: - if (strcmp ((char *)(CB_LITERAL(name)->data), "$#@DUMMY@#$") == 0) { + if (strcmp((char *)(CB_LITERAL(name)->data), "$#@DUMMY@#$") == 0) + { cfile->special = 2; } return name; case CB_TAG_REFERENCE: - s = CB_REFERENCE (name)->word->name; - if (strcasecmp (s, "KEYBOARD") == 0) { + s = CB_REFERENCE(name)->word->name; + if (strcasecmp(s, "KEYBOARD") == 0) + { s = "#DUMMY#"; cfile->special = 1; - return cb_build_alphanumeric_literal ((ucharptr)s, strlen (s)); + return cb_build_alphanumeric_literal((ucharptr)s, strlen(s)); } - switch (cb_assign_clause) { + switch (cb_assign_clause) + { case CB_ASSIGN_COBOL2002: /* TODO */ return cb_error_node; case CB_ASSIGN_MF: - if (cfile->external_assign) { - p = strrchr (s, '-'); - if (p) { + if (cfile->external_assign) + { + p = strrchr(s, '-'); + if (p) + { s = p + 1; } - return cb_build_alphanumeric_literal ((ucharptr)s, strlen (s)); + return cb_build_alphanumeric_literal((ucharptr)s, strlen(s)); } current_program->reference_list = - cb_list_add (current_program->reference_list, name); + cb_list_add(current_program->reference_list, name); return name; case CB_ASSIGN_IBM: /* check organization */ - if (strncmp (s, "S-", 2) == 0 || - strncmp (s, "AS-", 3) == 0) { + if (strncmp(s, "S-", 2) == 0 || + strncmp(s, "AS-", 3) == 0) + { goto org; } /* skip the device label if exists */ - if ((p = strchr (s, '-')) != NULL) { + if ((p = strchr(s, '-')) != NULL) + { s = p + 1; } /* check organization again */ - if (strncmp (s, "S-", 2) == 0 || - strncmp (s, "AS-", 3) == 0) { -org: + if (strncmp(s, "S-", 2) == 0 || + strncmp(s, "AS-", 3) == 0) + { + org: /* skip it for now */ - s = strchr (s, '-') + 1; + s = strchr(s, '-') + 1; } /* convert the name into literal */ - return cb_build_alphanumeric_literal ((ucharptr)s, strlen (s)); + return cb_build_alphanumeric_literal((ucharptr)s, strlen(s)); case CB_ASSIGN_JPH1: - if (!(pp = get_coded_filename (s, 4))) { - pp = get_coded_filename (s, 0); + if (!(pp = get_coded_filename(s, 4))) + { + pp = get_coded_filename(s, 0); } - if (pp) { - x = cb_build_alphanumeric_literal ((ucharptr)pp, strlen (pp)); - free (pp); - } else { - x = cb_build_alphanumeric_literal ((ucharptr)s, strlen (s)); + if (pp) + { + x = cb_build_alphanumeric_literal((ucharptr)pp, strlen(pp)); + free(pp); + } + else + { + x = cb_build_alphanumeric_literal((ucharptr)s, strlen(s)); } return x; } @@ -701,74 +766,90 @@ cb_build_assignment_name (struct cb_file *cfile, cb_tree name) } cb_tree -cb_build_index (cb_tree x, cb_tree values, int indexed_by, struct cb_field *qual) +cb_build_index(cb_tree x, cb_tree values, int indexed_by, struct cb_field *qual) { - struct cb_field *f; + struct cb_field *f; - f = CB_FIELD (cb_build_field (x)); + f = CB_FIELD(cb_build_field(x)); f->usage = CB_USAGE_INDEX; - cb_validate_field (f); - if (values) { - f->values = cb_list_init (values); + cb_validate_field(f); + if (values) + { + f->values = cb_list_init(values); } - if (qual) { + if (qual) + { f->index_qual = qual; } f->flag_indexed_by = indexed_by; - current_program->working_storage = cb_field_add (current_program->working_storage, f); + current_program->working_storage = cb_field_add(current_program->working_storage, f); return x; } -int -cb_reference_type_check (cb_tree ref, cb_tree x, const char *name, int size, int *retsize, int type) +int cb_reference_type_check(cb_tree ref, cb_tree x, const char *name, int size, int *retsize, int type) { - struct cb_field *pTmp; - struct cb_binary_op *p; - struct cb_reference *r; - char strbuf[256]; - int offset = 0 ; - int ret = 0; + struct cb_field *pTmp; + struct cb_binary_op *p; + struct cb_reference *r; + char strbuf[256]; + int offset = 0; + int ret = 0; COB_UNUSED(r); - r = CB_REFERENCE (ref); - switch (CB_TREE_TAG (x)) { + r = CB_REFERENCE(ref); + switch (CB_TREE_TAG(x)) + { case CB_TAG_REFERENCE: - pTmp = CB_FIELD (cb_ref (x)); - if (CB_TREE (pTmp) != cb_error_node) { - if (pTmp->pic) { - if (pTmp->pic->category != CB_CATEGORY_NUMERIC) { - cb_error_x (x, _("'%s' is not a numeric value"), pTmp->name); + pTmp = CB_FIELD(cb_ref(x)); + if (CB_TREE(pTmp) != cb_error_node) + { + if (pTmp->pic) + { + if (pTmp->pic->category != CB_CATEGORY_NUMERIC) + { + cb_error_x(x, _("'%s' is not a numeric value"), pTmp->name); ret = 1; } } } break; case CB_TAG_LITERAL: - if (!cb_is_digist_data (x)) { - memset (strbuf, 0, sizeof (strbuf)); - sprintf (strbuf, "%s", CB_LITERAL (x)->data); - if (type) { - cb_error_x (x, _("Offset of '%s' out of bounds: %s "), name, strbuf); - } else { - cb_error_x (x, _("Length of '%s' out of bounds: %s "), name, strbuf); + if (!cb_is_digist_data(x)) + { + memset(strbuf, 0, sizeof(strbuf)); + sprintf(strbuf, "%s", CB_LITERAL(x)->data); + if (type) + { + cb_error_x(x, _("Offset of '%s' out of bounds: %s "), name, strbuf); + } + else + { + cb_error_x(x, _("Length of '%s' out of bounds: %s "), name, strbuf); } ret = 1; - } else { - offset = cb_get_int (x); - if (offset < 1 || offset > size) { - if (type) { - cb_error_x (x, _("Offset of '%s' out of bounds: %d"), name, offset); - } else { - cb_error_x (x, _("Length of '%s' out of bounds: %d"), name, offset); + } + else + { + offset = cb_get_int(x); + if (offset < 1 || offset > size) + { + if (type) + { + cb_error_x(x, _("Offset of '%s' out of bounds: %d"), name, offset); + } + else + { + cb_error_x(x, _("Length of '%s' out of bounds: %d"), name, offset); } ret = 1; } } break; case CB_TAG_BINARY_OP: - if (cb_tree_category (ref) == CB_CATEGORY_NATIONAL || cb_tree_category (ref) == CB_CATEGORY_NATIONAL_EDITED) { - p = CB_BINARY_OP (x); - return cb_reference_type_check (ref, p->x, name, size, retsize, type); + if (cb_tree_category(ref) == CB_CATEGORY_NATIONAL || cb_tree_category(ref) == CB_CATEGORY_NATIONAL_EDITED) + { + p = CB_BINARY_OP(x); + return cb_reference_type_check(ref, p->x, name, size, retsize, type); } default: break; @@ -778,139 +859,162 @@ cb_reference_type_check (cb_tree ref, cb_tree x, const char *name, int size, int } cb_tree -cb_build_identifier (cb_tree x) -{ - struct cb_reference *r; - struct cb_field *f; - struct cb_field *p; - const char *name; - cb_tree v; - cb_tree e1; - cb_tree e2; - cb_tree l; - cb_tree sub; - int size; - int n; - - if (x == cb_error_node) { +cb_build_identifier(cb_tree x) +{ + struct cb_reference *r; + struct cb_field *f; + struct cb_field *p; + const char *name; + cb_tree v; + cb_tree e1; + cb_tree e2; + cb_tree l; + cb_tree sub; + int size; + int n; + + if (x == cb_error_node) + { return cb_error_node; } - r = CB_REFERENCE (x); + r = CB_REFERENCE(x); name = r->word->name; /* resolve reference */ - v = cb_ref (x); - if (v == cb_error_node) { + v = cb_ref(x); + if (v == cb_error_node) + { return cb_error_node; } /* check if it is a data name */ - if (!CB_FIELD_P (v)) { - if (r->subs) { - cb_error_x (x, _("'%s' cannot be subscripted"), name); + if (!CB_FIELD_P(v)) + { + if (r->subs) + { + cb_error_x(x, _("'%s' cannot be subscripted"), name); return cb_error_node; } - if (r->offset) { - cb_error_x (x, _("'%s' cannot be reference modified"), name); + if (r->offset) + { + cb_error_x(x, _("'%s' cannot be reference modified"), name); return cb_error_node; } return x; } - f = CB_FIELD (v); + f = CB_FIELD(v); /* BASED check */ - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_PTR)) { - for (p = f; p->parent; p = p->parent) { + if (CB_EXCEPTION_ENABLE(COB_EC_BOUND_PTR)) + { + for (p = f; p->parent; p = p->parent) + { ; } - if (current_statement) { + if (current_statement) + { if (p->flag_item_based || - (f->storage == CB_STORAGE_LINKAGE && - !p->flag_is_pdiv_parm)) { - current_statement->null_check = cb_build_funcall_2 ( + (f->storage == CB_STORAGE_LINKAGE && + !p->flag_is_pdiv_parm)) + { + current_statement->null_check = cb_build_funcall_2( "cob_check_based", - cb_build_address (cb_build_field_reference (p, NULL)), - cb_build_string0 ((ucharptr)name)); + cb_build_address(cb_build_field_reference(p, NULL)), + cb_build_string0((ucharptr)name)); } } } /* check the number of subscripts */ - if (!r->all && cb_list_length (r->subs) != f->indexes) { - switch (f->indexes) { + if (!r->all && cb_list_length(r->subs) != f->indexes) + { + switch (f->indexes) + { case 0: - cb_error_x (x, _("'%s' cannot be subscripted"), name); + cb_error_x(x, _("'%s' cannot be subscripted"), name); return cb_error_node; case 1: - cb_error_x (x, _("'%s' requires 1 subscript"), name); + cb_error_x(x, _("'%s' requires 1 subscript"), name); return cb_error_node; default: - cb_error_x (x, _("'%s' requires %d subscripts"), name, f->indexes); + cb_error_x(x, _("'%s' requires %d subscripts"), name, f->indexes); return cb_error_node; } } /* subscript check */ - if (!r->all && r->subs) { + if (!r->all && r->subs) + { l = r->subs; - for (p = f; p; p = p->parent) { - if (p->flag_occurs) { - sub = cb_check_integer_value (CB_VALUE (l)); + for (p = f; p; p = p->parent) + { + if (p->flag_occurs) + { + sub = cb_check_integer_value(CB_VALUE(l)); - l = CB_CHAIN (l); + l = CB_CHAIN(l); - if (sub == cb_error_node) { + if (sub == cb_error_node) + { continue; } /* compile-time check */ - if (CB_LITERAL_P (sub)) { - n = cb_get_int (sub); - if (n < 1 || n > p->occurs_max) { - cb_error_x (x, _("Subscript of '%s' out of bounds: %d"), - name, n); + if (CB_LITERAL_P(sub)) + { + n = cb_get_int(sub); + if (n < 1 || n > p->occurs_max) + { + cb_error_x(x, _("Subscript of '%s' out of bounds: %d"), + name, n); } } /* run-time check */ - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) { - if (p->occurs_depending) { - if (CB_FIELD (cb_ref (p->occurs_depending))->values) { - e1 = cb_build_funcall_4 ("CobolCheck.checkOdo", - cb_build_cast_integer (p->occurs_depending), - cb_int (p->occurs_min), - cb_int (p->occurs_max), - cb_build_string0 - ((ucharptr)(cb_field (p->occurs_depending)->name))); - e2 = cb_build_funcall_4 ("CobolCheck.checkSubscript", - cb_build_cast_integer (sub), - cb_int1, - cb_build_cast_integer (p->occurs_depending), - cb_build_string0 ((ucharptr)name)); - } else { - e1 = cb_build_funcall_4 ("CobolCheck.checkOdo", - cb_int (p->occurs_max), - cb_int (p->occurs_min), - cb_int (p->occurs_max), - cb_build_string0 - ((ucharptr)(cb_field (p->occurs_depending)->name))); - e2 = cb_build_funcall_4 ("CobolCheck.checkSubscript", - cb_build_cast_integer (sub), - cb_int1, - cb_int (p->occurs_max), - cb_build_string0 ((ucharptr)name)); + if (CB_EXCEPTION_ENABLE(COB_EC_BOUND_SUBSCRIPT)) + { + if (p->occurs_depending) + { + if (CB_FIELD(cb_ref(p->occurs_depending))->values) + { + e1 = cb_build_funcall_4("CobolCheck.checkOdo", + cb_build_cast_integer(p->occurs_depending), + cb_int(p->occurs_min), + cb_int(p->occurs_max), + cb_build_string0((ucharptr)(cb_field(p->occurs_depending)->name))); + e2 = cb_build_funcall_4("CobolCheck.checkSubscript", + cb_build_cast_integer(sub), + cb_int1, + cb_build_cast_integer(p->occurs_depending), + cb_build_string0((ucharptr)name)); } - r->check = cb_list_add (r->check, e1); - r->check = cb_list_add (r->check, e2); - } else { - if (!CB_LITERAL_P (sub)) { - e1 = cb_build_funcall_4 ("CobolCheck.checkSubscript", - cb_build_cast_integer (sub), - cb_int1, - cb_int (p->occurs_max), - cb_build_string0 ((ucharptr)name)); - r->check = cb_list_add (r->check, e1); + else + { + e1 = cb_build_funcall_4("CobolCheck.checkOdo", + cb_int(p->occurs_max), + cb_int(p->occurs_min), + cb_int(p->occurs_max), + cb_build_string0((ucharptr)(cb_field(p->occurs_depending)->name))); + e2 = cb_build_funcall_4("CobolCheck.checkSubscript", + cb_build_cast_integer(sub), + cb_int1, + cb_int(p->occurs_max), + cb_build_string0((ucharptr)name)); + } + r->check = cb_list_add(r->check, e1); + r->check = cb_list_add(r->check, e2); + } + else + { + if (!CB_LITERAL_P(sub)) + { + e1 = cb_build_funcall_4("CobolCheck.checkSubscript", + cb_build_cast_integer(sub), + cb_int1, + cb_int(p->occurs_max), + cb_build_string0((ucharptr)name)); + r->check = cb_list_add(r->check, e1); } } } @@ -919,32 +1023,44 @@ cb_build_identifier (cb_tree x) } /* reference modification check */ - if (r->offset) { + if (r->offset) + { /* compile-time check */ -#ifdef I18N_UTF8 +#ifdef I18N_UTF8 /* I18N_UTF8: No wide char support. */ size = 0; - if (!cb_reference_type_check (x, r->offset, name, f->size, &size, 1)) { - if (size <= f->size && r->length) { - cb_reference_type_check (x, r->length, name, f->size - size + 1, &size, 0); + if (!cb_reference_type_check(x, r->offset, name, f->size, &size, 1)) + { + if (size <= f->size && r->length) + { + cb_reference_type_check(x, r->length, name, f->size - size + 1, &size, 0); } } -#else /*!I18N_UTF8*/ +#else /*!I18N_UTF8*/ size = 0; - if (cb_tree_category (CB_TREE (r)) == CB_CATEGORY_NATIONAL || - cb_tree_category (CB_TREE (r)) == CB_CATEGORY_NATIONAL_EDITED) { - if (!cb_reference_type_check (x, r->offset, name, (f->size)/2, &size, 1)) { - if (size <= (f->size)/2) { - if (r->length) { - cb_reference_type_check (x, r->length, name, (f->size)/2 - size + 1, &size, 0); + if (cb_tree_category(CB_TREE(r)) == CB_CATEGORY_NATIONAL || + cb_tree_category(CB_TREE(r)) == CB_CATEGORY_NATIONAL_EDITED) + { + if (!cb_reference_type_check(x, r->offset, name, (f->size) / 2, &size, 1)) + { + if (size <= (f->size) / 2) + { + if (r->length) + { + cb_reference_type_check(x, r->length, name, (f->size) / 2 - size + 1, &size, 0); } } } - } else { - if (!cb_reference_type_check (x, r->offset, name, (f->size), &size, 1)) { - if (size <= (f->size)) { - if (r->length) { - cb_reference_type_check (x, r->length, name, (f->size) - size + 1, &size, 0); + } + else + { + if (!cb_reference_type_check(x, r->offset, name, (f->size), &size, 1)) + { + if (size <= (f->size)) + { + if (r->length) + { + cb_reference_type_check(x, r->length, name, (f->size) - size + 1, &size, 0); } } } @@ -952,248 +1068,294 @@ cb_build_identifier (cb_tree x) #endif /*I18N_UTF8*/ /* run-time check */ -#ifdef I18N_UTF8 +#ifdef I18N_UTF8 /* I18N_UTF8: No wide char support. */ - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_REF_MOD)) { - if (!CB_LITERAL_P (r->offset) || - (r->length && !CB_LITERAL_P (r->length))) { - e1 = cb_build_funcall_4 ("cob_check_ref_mod", - cb_build_cast_integer (r->offset), - r->length ? cb_build_cast_integer (r->length) : - cb_int1, cb_int (f->size), - cb_build_string0 ((ucharptr)f->name)); - r->check = cb_list_add (r->check, e1); - } - } -#else /*!I18N_UTF8*/ - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_REF_MOD)) { - if (!CB_LITERAL_P (r->offset) || - (r->length && !CB_LITERAL_P (r->length))) { - if (cb_tree_category (CB_TREE (r)) == CB_CATEGORY_NATIONAL || - cb_tree_category (CB_TREE (r)) == CB_CATEGORY_NATIONAL_EDITED) { - e1 = cb_build_funcall_4 ("cob_check_ref_mod_national", - cb_build_cast_integer (r->offset), - r->length ? cb_build_cast_integer (r->length) : - cb_int2, cb_int (f->size), - cb_build_string0 ((ucharptr)f->name)); - } else { - e1 = cb_build_funcall_4 ("cob_check_ref_mod", - cb_build_cast_integer (r->offset), - r->length ? cb_build_cast_integer (r->length) : - cb_int1, cb_int (f->size), - cb_build_string0 ((ucharptr)f->name)); - } - r->check = cb_list_add (r->check, e1); + if (CB_EXCEPTION_ENABLE(COB_EC_BOUND_REF_MOD)) + { + if (!CB_LITERAL_P(r->offset) || + (r->length && !CB_LITERAL_P(r->length))) + { + e1 = cb_build_funcall_4("cob_check_ref_mod", + cb_build_cast_integer(r->offset), + r->length ? cb_build_cast_integer(r->length) : cb_int1, cb_int(f->size), + cb_build_string0((ucharptr)f->name)); + r->check = cb_list_add(r->check, e1); + } + } +#else /*!I18N_UTF8*/ + if (CB_EXCEPTION_ENABLE(COB_EC_BOUND_REF_MOD)) + { + if (!CB_LITERAL_P(r->offset) || + (r->length && !CB_LITERAL_P(r->length))) + { + if (cb_tree_category(CB_TREE(r)) == CB_CATEGORY_NATIONAL || + cb_tree_category(CB_TREE(r)) == CB_CATEGORY_NATIONAL_EDITED) + { + e1 = cb_build_funcall_4("cob_check_ref_mod_national", + cb_build_cast_integer(r->offset), + r->length ? cb_build_cast_integer(r->length) : cb_int2, cb_int(f->size), + cb_build_string0((ucharptr)f->name)); + } + else + { + e1 = cb_build_funcall_4("cob_check_ref_mod", + cb_build_cast_integer(r->offset), + r->length ? cb_build_cast_integer(r->length) : cb_int1, cb_int(f->size), + cb_build_string0((ucharptr)f->name)); + } + r->check = cb_list_add(r->check, e1); } } #endif /*I18N_UTF8*/ } - if (f->storage == CB_STORAGE_CONSTANT) { - return CB_VALUE (f->values); + if (f->storage == CB_STORAGE_CONSTANT) + { + return CB_VALUE(f->values); } return x; } static cb_tree -cb_build_length_1 (cb_tree x) +cb_build_length_1(cb_tree x) { struct cb_field *f; - cb_tree e; - cb_tree size; + cb_tree e; + cb_tree size; - f = CB_FIELD (cb_ref (x)); + f = CB_FIELD(cb_ref(x)); - if (cb_field_variable_size (f) == NULL) { + if (cb_field_variable_size(f) == NULL) + { /* constant size */ - return cb_int (cb_field_size (x)); - } else { + return cb_int(cb_field_size(x)); + } + else + { /* variable size */ e = NULL; - for (f = f->children; f; f = f->sister) { - size = cb_build_length_1 (cb_build_field_reference (f, x)); - if (f->occurs_depending) { - size = cb_build_binary_op (size, '*', f->occurs_depending); - } else if (f->occurs_max > 1) { - size = cb_build_binary_op (size, '*', cb_int (f->occurs_max)); + for (f = f->children; f; f = f->sister) + { + size = cb_build_length_1(cb_build_field_reference(f, x)); + if (f->occurs_depending) + { + size = cb_build_binary_op(size, '*', f->occurs_depending); + } + else if (f->occurs_max > 1) + { + size = cb_build_binary_op(size, '*', cb_int(f->occurs_max)); } - e = e ? cb_build_binary_op (e, '+', size) : size; + e = e ? cb_build_binary_op(e, '+', size) : size; } return e; } } cb_tree -cb_build_const_length (cb_tree x) +cb_build_const_length(cb_tree x) { - struct cb_field *f; - char buff[64]; + struct cb_field *f; + char buff[64]; - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) { + if (CB_REFERENCE_P(x) && cb_ref(x) == cb_error_node) + { return cb_error_node; } - memset (buff, 0, sizeof (buff)); - f = CB_FIELD (cb_ref (x)); - if (f->flag_any_length) { - cb_error (_("ANY LENGTH item not allowed here")); + memset(buff, 0, sizeof(buff)); + f = CB_FIELD(cb_ref(x)); + if (f->flag_any_length) + { + cb_error(_("ANY LENGTH item not allowed here")); return cb_error_node; } - if (f->level == 88) { - cb_error (_("88 level item not allowed here")); + if (f->level == 88) + { + cb_error(_("88 level item not allowed here")); return cb_error_node; } - if (!f->flag_is_verified) { - cb_validate_field (f); + if (!f->flag_is_verified) + { + cb_validate_field(f); } - sprintf (buff, "%d", f->memory_size); - return cb_build_numeric_literal (0, (ucharptr)buff, 0); + sprintf(buff, "%d", f->memory_size); + return cb_build_numeric_literal(0, (ucharptr)buff, 0); } cb_tree -cb_build_length (cb_tree x) +cb_build_length(cb_tree x) { - struct cb_field *f; - struct cb_literal *l; - cb_tree temp; - char buff[64]; + struct cb_field *f; + struct cb_literal *l; + cb_tree temp; + char buff[64]; - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) { + if (CB_REFERENCE_P(x) && cb_ref(x) == cb_error_node) + { return cb_error_node; } - memset (buff, 0, sizeof (buff)); - if (CB_LITERAL_P (x)) { - l = CB_LITERAL (x); - sprintf (buff, "%d", (int)l->size); - return cb_build_numeric_literal (0, (ucharptr)buff, 0); + memset(buff, 0, sizeof(buff)); + if (CB_LITERAL_P(x)) + { + l = CB_LITERAL(x); + sprintf(buff, "%d", (int)l->size); + return cb_build_numeric_literal(0, (ucharptr)buff, 0); } - if (CB_REF_OR_FIELD_P (x)) { - f = CB_FIELD (cb_ref (x)); - if (f->flag_any_length) { - return cb_build_any_intrinsic (cb_list_init (x)); + if (CB_REF_OR_FIELD_P(x)) + { + f = CB_FIELD(cb_ref(x)); + if (f->flag_any_length) + { + return cb_build_any_intrinsic(cb_list_init(x)); } - if (cb_field_variable_size (f) == NULL) { - sprintf (buff, "%d", cb_field_size (x)); - return cb_build_numeric_literal (0, (ucharptr)buff, 0); + if (cb_field_variable_size(f) == NULL) + { + sprintf(buff, "%d", cb_field_size(x)); + return cb_build_numeric_literal(0, (ucharptr)buff, 0); } } - if (CB_INTRINSIC_P (x)) { - return cb_build_any_intrinsic (cb_list_init (x)); + if (CB_INTRINSIC_P(x)) + { + return cb_build_any_intrinsic(cb_list_init(x)); } - temp = cb_build_index (cb_build_filler (), NULL, 0, NULL); - CB_FIELD (cb_ref (temp))->usage = CB_USAGE_LENGTH; - CB_FIELD (cb_ref (temp))->count++; - cb_emit (cb_build_assign (temp, cb_build_length_1 (x))); + temp = cb_build_index(cb_build_filler(), NULL, 0, NULL); + CB_FIELD(cb_ref(temp))->usage = CB_USAGE_LENGTH; + CB_FIELD(cb_ref(temp))->count++; + cb_emit(cb_build_assign(temp, cb_build_length_1(x))); return temp; } -#ifdef I18N_UTF8 +#ifdef I18N_UTF8 /* I18N_UTF8: No wide char support. cb_build_lengths() is not needed. */ -#else /*!I18N_UTF8*/ +#else /*!I18N_UTF8*/ cb_tree -cb_build_lengths (cb_tree x) +cb_build_lengths(cb_tree x) { - char buff[64]; + char buff[64]; - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) { + if (CB_REFERENCE_P(x) && cb_ref(x) == cb_error_node) + { return cb_error_node; } - if ((cb_tree_class (x) == CB_CLASS_NATIONAL) || - (CB_TREE_CATEGORY (x) == CB_CATEGORY_NATIONAL) || - (CB_TREE_CATEGORY (x) == CB_CATEGORY_NATIONAL_EDITED)) { - sprintf (buff, "%d", (cb_field_size (x)) / 2); + if ((cb_tree_class(x) == CB_CLASS_NATIONAL) || + (CB_TREE_CATEGORY(x) == CB_CATEGORY_NATIONAL) || + (CB_TREE_CATEGORY(x) == CB_CATEGORY_NATIONAL_EDITED)) + { + sprintf(buff, "%d", (cb_field_size(x)) / 2); } - return cb_build_numeric_literal (0, (ucharptr)buff, 0); + return cb_build_numeric_literal(0, (ucharptr)buff, 0); } #endif /*I18N_UTF8*/ cb_tree -cb_build_address (cb_tree x) +cb_build_address(cb_tree x) { if (x == cb_error_node || - (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node)) { + (CB_REFERENCE_P(x) && cb_ref(x) == cb_error_node)) + { return cb_error_node; } - return cb_build_cast_address (x); + return cb_build_cast_address(x); } cb_tree -cb_build_ppointer (cb_tree x) +cb_build_ppointer(cb_tree x) { - struct cb_field *f; + struct cb_field *f; if (x == cb_error_node || - (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node)) { + (CB_REFERENCE_P(x) && cb_ref(x) == cb_error_node)) + { return cb_error_node; } - if (CB_REFERENCE_P (x)) { - f = cb_field (cb_ref(x)); + if (CB_REFERENCE_P(x)) + { + f = cb_field(cb_ref(x)); f->count++; } - return cb_build_cast_ppointer (x); + return cb_build_cast_ppointer(x); } /* validate program */ static int -get_value (cb_tree x) +get_value(cb_tree x) { - if (x == cb_space) { + if (x == cb_space) + { return ' '; - } else if (x == cb_zero) { + } + else if (x == cb_zero) + { return '0'; - } else if (x == cb_quote) { + } + else if (x == cb_quote) + { return '"'; - } else if (x == cb_norm_low) { + } + else if (x == cb_norm_low) + { return 0; - } else if (x == cb_norm_high) { + } + else if (x == cb_norm_high) + { return 255; - } else if (x == cb_null) { + } + else if (x == cb_null) + { return 0; - } else if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - return cb_get_int (x) - 1; - } else { - return CB_LITERAL (x)->data[0]; - } -} - -void -cb_validate_program_environment (struct cb_program *prog) -{ - cb_tree x; - cb_tree y; - cb_tree l; - cb_tree ls; - struct cb_alphabet_name *ap; - unsigned char *data; - size_t dupls; - size_t unvals; - size_t count; - int lower; - int upper; - int size; - int n; - int i; - int lastval; - int values[256]; + } + else if (CB_TREE_CLASS(x) == CB_CLASS_NUMERIC) + { + return cb_get_int(x) - 1; + } + else + { + return CB_LITERAL(x)->data[0]; + } +} + +void cb_validate_program_environment(struct cb_program *prog) +{ + cb_tree x; + cb_tree y; + cb_tree l; + cb_tree ls; + struct cb_alphabet_name *ap; + unsigned char *data; + size_t dupls; + size_t unvals; + size_t count; + int lower; + int upper; + int size; + int n; + int i; + int lastval; + int values[256]; /* Check ALPHABET clauses */ - for (l = current_program->alphabet_name_list; l; l = CB_CHAIN (l)) { - ap = CB_ALPHABET_NAME (CB_VALUE (l)); - if (ap->type != CB_ALPHABET_CUSTOM) { + for (l = current_program->alphabet_name_list; l; l = CB_CHAIN(l)) + { + ap = CB_ALPHABET_NAME(CB_VALUE(l)); + if (ap->type != CB_ALPHABET_CUSTOM) + { continue; } ap->low_val_char = 0; @@ -1202,111 +1364,148 @@ cb_validate_program_environment (struct cb_program *prog) unvals = 0; count = 0; lastval = 0; - for (n = 0; n < 256; n++) { + for (n = 0; n < 256; n++) + { values[n] = -1; } - for (y = ap->custom_list; y; y = CB_CHAIN (y)) { - if (count > 255) { + for (y = ap->custom_list; y; y = CB_CHAIN(y)) + { + if (count > 255) + { unvals = 1; break; } - x = CB_VALUE (y); - if (CB_PAIR_P (x)) { + x = CB_VALUE(y); + if (CB_PAIR_P(x)) + { /* X THRU Y */ - lower = get_value (CB_PAIR_X (x)); - upper = get_value (CB_PAIR_Y (x)); + lower = get_value(CB_PAIR_X(x)); + upper = get_value(CB_PAIR_Y(x)); lastval = upper; - if (!count) { + if (!count) + { ap->low_val_char = lower; } - if (lower < 0 || lower > 255) { + if (lower < 0 || lower > 255) + { unvals = 1; continue; } - if (upper < 0 || upper > 255) { + if (upper < 0 || upper > 255) + { unvals = 1; continue; } - if (lower <= upper) { - for (i = lower; i <= upper; i++) { - if (values[i] != -1) { + if (lower <= upper) + { + for (i = lower; i <= upper; i++) + { + if (values[i] != -1) + { dupls = 1; } values[i] = i; count++; } - } else { - for (i = lower; i >= upper; i--) { - if (values[i] != -1) { + } + else + { + for (i = lower; i >= upper; i--) + { + if (values[i] != -1) + { dupls = 1; } values[i] = i; count++; } } - } else if (CB_LIST_P (x)) { + } + else if (CB_LIST_P(x)) + { /* X ALSO Y ... */ - if (!count) { - ap->low_val_char = get_value (CB_VALUE (x)); + if (!count) + { + ap->low_val_char = get_value(CB_VALUE(x)); } - for (ls = x; ls; ls = CB_CHAIN (ls)) { - n = get_value (CB_VALUE (ls)); - if (!CB_CHAIN (ls)) { + for (ls = x; ls; ls = CB_CHAIN(ls)) + { + n = get_value(CB_VALUE(ls)); + if (!CB_CHAIN(ls)) + { lastval = n; } - if (n < 0 || n > 255) { + if (n < 0 || n > 255) + { unvals = 1; continue; } - if (values[n] != -1) { + if (values[n] != -1) + { dupls = 1; } values[n] = n; count++; } - } else { + } + else + { /* literal */ - if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - n = get_value (x); + if (CB_TREE_CLASS(x) == CB_CLASS_NUMERIC) + { + n = get_value(x); lastval = n; - if (!count) { + if (!count) + { ap->low_val_char = n; } - if (n < 0 || n > 255) { + if (n < 0 || n > 255) + { unvals = 1; continue; } - if (values[n] != -1) { + if (values[n] != -1) + { dupls = 1; } values[n] = n; count++; - } else if (CB_LITERAL_P (x)) { - size = (int)CB_LITERAL (x)->size; - data = CB_LITERAL (x)->data; - if (!count) { + } + else if (CB_LITERAL_P(x)) + { + size = (int)CB_LITERAL(x)->size; + data = CB_LITERAL(x)->data; + if (!count) + { ap->low_val_char = data[0]; } lastval = data[size - 1]; - for (i = 0; i < size; i++) { + for (i = 0; i < size; i++) + { n = data[i]; - if (values[n] != -1) { + if (values[n] != -1) + { dupls = 1; } values[n] = n; count++; } - } else { - n = get_value (x); + } + else + { + n = get_value(x); lastval = n; - if (!count) { + if (!count) + { ap->low_val_char = n; } - if (n < 0 || n > 255) { + if (n < 0 || n > 255) + { unvals = 1; continue; } - if (values[n] != -1) { + if (values[n] != -1) + { dupls = 1; } values[n] = n; @@ -1314,14 +1513,17 @@ cb_validate_program_environment (struct cb_program *prog) } } } - if (dupls || unvals) { - if (dupls) { - cb_error_x (l, _("Duplicate character values in alphabet '%s'"), - cb_name (CB_VALUE(l))); + if (dupls || unvals) + { + if (dupls) + { + cb_error_x(l, _("Duplicate character values in alphabet '%s'"), + cb_name(CB_VALUE(l))); } - if (unvals) { - cb_error_x (l, _("Invalid character values in alphabet '%s'"), - cb_name (CB_VALUE(l))); + if (unvals) + { + cb_error_x(l, _("Invalid character values in alphabet '%s'"), + cb_name(CB_VALUE(l))); } ap->low_val_char = 0; ap->high_val_char = 255; @@ -1331,11 +1533,16 @@ cb_validate_program_environment (struct cb_program *prog) /* If all 256 values have been specified, HIGH-VALUE is the last one */ /* Otherwise if HIGH-VALUE has been specified, find the highest */ /* value that has not been used */ - if (count == 256) { + if (count == 256) + { ap->high_val_char = lastval; - } else if (values[255] != -1) { - for (n = 254; n >= 0; n--) { - if (values[n] == -1) { + } + else if (values[255] != -1) + { + for (n = 254; n >= 0; n--) + { + if (values[n] == -1) + { ap->high_val_char = n; break; } @@ -1346,131 +1553,162 @@ cb_validate_program_environment (struct cb_program *prog) cb_low = cb_norm_low; cb_high = cb_norm_high; /* resolve the program collating sequence */ - if (!prog->collating_sequence) { + if (!prog->collating_sequence) + { return; } - x = cb_ref (prog->collating_sequence); -/* RXWRXW - if (x == cb_error_node) { - prog->collating_sequence = NULL; - return; - } -*/ - if (!CB_ALPHABET_NAME_P (x)) { - cb_error_x (prog->collating_sequence, _("'%s' not alphabet name"), - cb_name (prog->collating_sequence)); + x = cb_ref(prog->collating_sequence); + /* RXWRXW + if (x == cb_error_node) { + prog->collating_sequence = NULL; + return; + } + */ + if (!CB_ALPHABET_NAME_P(x)) + { + cb_error_x(prog->collating_sequence, _("'%s' not alphabet name"), + cb_name(prog->collating_sequence)); prog->collating_sequence = NULL; return; } - if (CB_ALPHABET_NAME (x)->type != CB_ALPHABET_CUSTOM) { + if (CB_ALPHABET_NAME(x)->type != CB_ALPHABET_CUSTOM) + { return; } - if (CB_ALPHABET_NAME (x)->low_val_char) { - cb_low = cb_build_alphanumeric_literal ((ucharptr)"\0", 1); - CB_LITERAL(cb_low)->data[0] = CB_ALPHABET_NAME (x)->low_val_char; + if (CB_ALPHABET_NAME(x)->low_val_char) + { + cb_low = cb_build_alphanumeric_literal((ucharptr) "\0", 1); + CB_LITERAL(cb_low)->data[0] = CB_ALPHABET_NAME(x)->low_val_char; CB_LITERAL(cb_low)->all = 1; } - if (CB_ALPHABET_NAME (x)->high_val_char != 255){ - cb_high = cb_build_alphanumeric_literal ((ucharptr)"\0", 1); - CB_LITERAL(cb_high)->data[0] = CB_ALPHABET_NAME (x)->high_val_char; + if (CB_ALPHABET_NAME(x)->high_val_char != 255) + { + cb_high = cb_build_alphanumeric_literal((ucharptr) "\0", 1); + CB_LITERAL(cb_high)->data[0] = CB_ALPHABET_NAME(x)->high_val_char; CB_LITERAL(cb_high)->all = 1; } } -void -cb_validate_program_data (struct cb_program *prog) +void cb_validate_program_data(struct cb_program *prog) { - cb_tree l; - cb_tree x; - cb_tree assign; - struct cb_field *p; - struct cb_file *f; - unsigned char *c; + cb_tree l; + cb_tree x; + cb_tree assign; + struct cb_field *p; + struct cb_file *f; + unsigned char *c; - for (l = current_program->file_list; l; l = CB_CHAIN (l)) { - f = CB_FILE (CB_VALUE (l)); - if (!f->finalized) { - finalize_file (f, NULL); + for (l = current_program->file_list; l; l = CB_CHAIN(l)) + { + f = CB_FILE(CB_VALUE(l)); + if (!f->finalized) + { + finalize_file(f, NULL); } } /* build undeclared assignment name now */ - if (cb_assign_clause == CB_ASSIGN_MF) { - for (l = current_program->file_list; l; l = CB_CHAIN (l)) { - assign = CB_FILE (CB_VALUE (l))->assign; - if (!assign) { + if (cb_assign_clause == CB_ASSIGN_MF) + { + for (l = current_program->file_list; l; l = CB_CHAIN(l)) + { + assign = CB_FILE(CB_VALUE(l))->assign; + if (!assign) + { continue; } - if (CB_REFERENCE_P (assign)) { - for (x = current_program->file_list; x; x = CB_CHAIN (x)) { - if (!strcmp (CB_FILE (CB_VALUE (x))->name, - CB_REFERENCE (assign)->word->name)) { - redefinition_error (assign); + if (CB_REFERENCE_P(assign)) + { + for (x = current_program->file_list; x; x = CB_CHAIN(x)) + { + if (!strcmp(CB_FILE(CB_VALUE(x))->name, + CB_REFERENCE(assign)->word->name)) + { + redefinition_error(assign); } } - p = check_level_78 (CB_REFERENCE (assign)->word->name); - if (p) { + p = check_level_78(CB_REFERENCE(assign)->word->name); + if (p) + { c = (unsigned char *)CB_LITERAL(CB_VALUE(p->values))->data; - assign = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, c, strlen ((char *)c))); - CB_FILE (CB_VALUE (l))->assign = assign; + assign = CB_TREE(build_literal(CB_CATEGORY_ALPHANUMERIC, c, strlen((char *)c))); + CB_FILE(CB_VALUE(l))->assign = assign; } } - if (CB_REFERENCE_P (assign) && CB_REFERENCE (assign)->word->count == 0) { - if (cb_warn_implicit_define) { - cb_warning (_("'%s' will be implicitly defined"), CB_NAME (assign)); + if (CB_REFERENCE_P(assign) && CB_REFERENCE(assign)->word->count == 0) + { + if (cb_warn_implicit_define) + { + cb_warning(_("'%s' will be implicitly defined"), CB_NAME(assign)); } - x = cb_build_implicit_field (assign, COB_SMALL_BUFF); + x = cb_build_implicit_field(assign, COB_SMALL_BUFF); p = current_program->working_storage; - CB_FIELD (x)->count++; - if (p) { - while (p->sister) { + CB_FIELD(x)->count++; + if (p) + { + while (p->sister) + { p = p->sister; } - p->sister = CB_FIELD (x); - } else { - current_program->working_storage = CB_FIELD (x); + p->sister = CB_FIELD(x); + } + else + { + current_program->working_storage = CB_FIELD(x); } } - if (CB_REFERENCE_P (assign)) { - x = cb_ref (assign); - if (CB_FIELD_P (x) && CB_FIELD (x)->level == 88) { - cb_error_x (assign, _("ASSIGN data item '%s' invalid"), CB_NAME (assign)); + if (CB_REFERENCE_P(assign)) + { + x = cb_ref(assign); + if (CB_FIELD_P(x) && CB_FIELD(x)->level == 88) + { + cb_error_x(assign, _("ASSIGN data item '%s' invalid"), CB_NAME(assign)); } } } } - if (prog->cursor_pos) { - x = cb_ref (prog->cursor_pos); - if (x == cb_error_node) { + if (prog->cursor_pos) + { + x = cb_ref(prog->cursor_pos); + if (x == cb_error_node) + { prog->cursor_pos = NULL; - } else if (CB_FIELD(x)->size != 6 && CB_FIELD(x)->size != 4) { - cb_error_x (prog->cursor_pos, _("'%s' CURSOR is not 4 or 6 characters long"), - cb_name (prog->cursor_pos)); + } + else if (CB_FIELD(x)->size != 6 && CB_FIELD(x)->size != 4) + { + cb_error_x(prog->cursor_pos, _("'%s' CURSOR is not 4 or 6 characters long"), + cb_name(prog->cursor_pos)); prog->cursor_pos = NULL; } } - if (prog->crt_status) { - x = cb_ref (prog->crt_status); - if (x == cb_error_node) { + if (prog->crt_status) + { + x = cb_ref(prog->crt_status); + if (x == cb_error_node) + { prog->crt_status = NULL; - } else if (CB_FIELD(x)->size != 4) { - cb_error_x (prog->crt_status, _("'%s' CRT STATUS is not 4 characters long"), - cb_name (prog->crt_status)); + } + else if (CB_FIELD(x)->size != 4) + { + cb_error_x(prog->crt_status, _("'%s' CRT STATUS is not 4 characters long"), + cb_name(prog->crt_status)); prog->crt_status = NULL; } - } else { - l = cb_build_reference ("COB-CRT-STATUS"); - p = CB_FIELD (cb_build_field (l)); + } + else + { + l = cb_build_reference("COB-CRT-STATUS"); + p = CB_FIELD(cb_build_field(l)); p->usage = CB_USAGE_DISPLAY; - p->pic = CB_PICTURE (cb_build_picture ("9(4)")); - cb_validate_field (p); + p->pic = CB_PICTURE(cb_build_picture("9(4)")); + cb_validate_field(p); p->flag_no_init = 1; /* Do not initialize/bump ref count here p->values = cb_list_init (cb_zero); p->count++; */ current_program->working_storage = - cb_field_add (current_program->working_storage, p); + cb_field_add(current_program->working_storage, p); prog->crt_status = l; /* RXWRXW - Maybe better prog->crt_status = cb_build_index (cb_build_reference ("COB-CRT-STATUS"), cb_zero, 0, NULL); @@ -1478,29 +1716,34 @@ cb_validate_program_data (struct cb_program *prog) } /* resolve all references so far */ - for (l = cb_list_reverse (prog->reference_list); l; l = CB_CHAIN (l)) { - cb_ref (CB_VALUE (l)); - } - for (l = current_program->file_list; l; l = CB_CHAIN (l)) { - f = CB_FILE (CB_VALUE (l)); - if (f->record_depending && f->record_depending != cb_error_node) { + for (l = cb_list_reverse(prog->reference_list); l; l = CB_CHAIN(l)) + { + cb_ref(CB_VALUE(l)); + } + for (l = current_program->file_list; l; l = CB_CHAIN(l)) + { + f = CB_FILE(CB_VALUE(l)); + if (f->record_depending && f->record_depending != cb_error_node) + { x = f->record_depending; - if (cb_ref (x) != cb_error_node) { -/* RXW - This breaks old legacy programs - if (CB_REF_OR_FIELD_P(x)) { - p = cb_field (x); - switch (p->storage) { - case CB_STORAGE_WORKING: - case CB_STORAGE_LOCAL: - case CB_STORAGE_LINKAGE: - break; - default: - cb_error (_("RECORD DEPENDING item must be in WORKING/LOCAL/LINKAGE section")); - } - } else { -*/ - if (!CB_REFERENCE_P(x) && !CB_FIELD_P(x)) { - cb_error (_("Invalid RECORD DEPENDING item")); + if (cb_ref(x) != cb_error_node) + { + /* RXW - This breaks old legacy programs + if (CB_REF_OR_FIELD_P(x)) { + p = cb_field (x); + switch (p->storage) { + case CB_STORAGE_WORKING: + case CB_STORAGE_LOCAL: + case CB_STORAGE_LINKAGE: + break; + default: + cb_error (_("RECORD DEPENDING item must be in WORKING/LOCAL/LINKAGE section")); + } + } else { + */ + if (!CB_REFERENCE_P(x) && !CB_FIELD_P(x)) + { + cb_error(_("Invalid RECORD DEPENDING item")); } } } @@ -1508,121 +1751,165 @@ cb_validate_program_data (struct cb_program *prog) } static int -check_section_escape (cb_tree x) +check_section_escape(cb_tree x) { - cb_tree l; - struct cb_goto *gp; - struct cb_label *lp; - int rt = 0; + cb_tree l; + struct cb_goto *gp; + struct cb_label *lp; + int rt = 0; - if (!x) { + if (!x) + { /* return 0 */ - } else if (CB_TREE_TAG (x) == CB_TAG_STATEMENT) { - current_statement = CB_STATEMENT (x); - rt += check_section_escape (current_statement->null_check); - rt += check_section_escape (current_statement->body); - rt += check_section_escape (current_statement->handler1); - rt += check_section_escape (current_statement->handler2); - } else if (CB_TREE_TAG (x) == CB_TAG_LABEL) { - lp = CB_LABEL (x); - if (lp->is_section) { + } + else if (CB_TREE_TAG(x) == CB_TAG_STATEMENT) + { + current_statement = CB_STATEMENT(x); + rt += check_section_escape(current_statement->null_check); + rt += check_section_escape(current_statement->body); + rt += check_section_escape(current_statement->handler1); + rt += check_section_escape(current_statement->handler2); + } + else if (CB_TREE_TAG(x) == CB_TAG_LABEL) + { + lp = CB_LABEL(x); + if (lp->is_section) + { current_section = lp; current_paragraph = NULL; - } else { + } + else + { current_paragraph = lp; } - } else if (CB_TREE_TAG (x) == CB_TAG_SEARCH) { - struct cb_search *p = CB_SEARCH (x); - rt += check_section_escape (p->end_stmt); - rt += check_section_escape (p->whens); - } else if (CB_TREE_TAG (x) == CB_TAG_CALL) { - struct cb_call *p = CB_CALL (x); - rt += check_section_escape (p->stmt1); - rt += check_section_escape (p->stmt2); - } else if (CB_TREE_TAG (x) == CB_TAG_PERFORM) { - struct cb_perform *p = CB_PERFORM (x); - if (p->body && !CB_PAIR_P (p->body)) { - rt += check_section_escape (p->body); - } - } else if (CB_TREE_TAG (x) == CB_TAG_GOTO) { - gp = CB_GOTO (x); - if (gp->depending) { - for (l = gp->target; l; l = CB_CHAIN (l)) { - lp = CB_LABEL (cb_ref (CB_VALUE (l))); - if (current_section && lp->section != current_section) { - if (!lp->section) { - cb_warning_x (CB_TREE (current_statement), - _("GO TO escape from SECTION %s"), - current_section->name); - } else { - cb_warning_x (CB_TREE (current_statement), - _("GO TO escape from SECTION %s to %s"), - current_section->name, - lp->section->name); + } + else if (CB_TREE_TAG(x) == CB_TAG_SEARCH) + { + struct cb_search *p = CB_SEARCH(x); + rt += check_section_escape(p->end_stmt); + rt += check_section_escape(p->whens); + } + else if (CB_TREE_TAG(x) == CB_TAG_CALL) + { + struct cb_call *p = CB_CALL(x); + rt += check_section_escape(p->stmt1); + rt += check_section_escape(p->stmt2); + } + else if (CB_TREE_TAG(x) == CB_TAG_PERFORM) + { + struct cb_perform *p = CB_PERFORM(x); + if (p->body && !CB_PAIR_P(p->body)) + { + rt += check_section_escape(p->body); + } + } + else if (CB_TREE_TAG(x) == CB_TAG_GOTO) + { + gp = CB_GOTO(x); + if (gp->depending) + { + for (l = gp->target; l; l = CB_CHAIN(l)) + { + lp = CB_LABEL(cb_ref(CB_VALUE(l))); + if (current_section && lp->section != current_section) + { + if (!lp->section) + { + cb_warning_x(CB_TREE(current_statement), + _("GO TO escape from SECTION %s"), + current_section->name); + } + else + { + cb_warning_x(CB_TREE(current_statement), + _("GO TO escape from SECTION %s to %s"), + current_section->name, + lp->section->name); } rt++; } } - } else if (gp->target == NULL || gp->target == cb_int1) { + } + else if (gp->target == NULL || gp->target == cb_int1) + { /* goto exit_program */ - } else { - lp = CB_LABEL (cb_ref (gp->target)); - if (current_section && lp->section != current_section) { - if (!lp->section) { - cb_warning_x (CB_TREE (current_statement), - _("GO TO escape from SECTION %s"), - current_section->name); - } else { - cb_warning_x (CB_TREE (current_statement), - _("GO TO escape from SECTION %s to %s"), - current_section->name, - lp->section->name); + } + else + { + lp = CB_LABEL(cb_ref(gp->target)); + if (current_section && lp->section != current_section) + { + if (!lp->section) + { + cb_warning_x(CB_TREE(current_statement), + _("GO TO escape from SECTION %s"), + current_section->name); + } + else + { + cb_warning_x(CB_TREE(current_statement), + _("GO TO escape from SECTION %s to %s"), + current_section->name, + lp->section->name); } rt++; } } - } else if (CB_TREE_TAG (x) == CB_TAG_IF) { - if (CB_IF (x)->stmt1) { - rt += check_section_escape (CB_IF (x)->stmt1); + } + else if (CB_TREE_TAG(x) == CB_TAG_IF) + { + if (CB_IF(x)->stmt1) + { + rt += check_section_escape(CB_IF(x)->stmt1); } - if (CB_IF (x)->stmt2) { - rt += check_section_escape (CB_IF (x)->stmt2); + if (CB_IF(x)->stmt2) + { + rt += check_section_escape(CB_IF(x)->stmt2); } - } else if (CB_TREE_TAG (x) == CB_TAG_LIST) { - for (; x; x = CB_CHAIN (x)) { - rt += check_section_escape (CB_VALUE (x)); + } + else if (CB_TREE_TAG(x) == CB_TAG_LIST) + { + for (; x; x = CB_CHAIN(x)) + { + rt += check_section_escape(CB_VALUE(x)); } } return rt; } -void -cb_validate_program_body (struct cb_program *prog) +void cb_validate_program_body(struct cb_program *prog) { /* resolve all labels */ - cb_tree l; - cb_tree x; - cb_tree v; + cb_tree l; + cb_tree x; + cb_tree v; - for (l = cb_list_reverse (prog->label_list); l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - v = cb_ref (x); - if (CB_LABEL_P (v)) { - CB_LABEL (v)->need_begin = 1; - if (CB_REFERENCE (x)->length) { - CB_LABEL (v)->need_return = 1; + for (l = cb_list_reverse(prog->label_list); l; l = CB_CHAIN(l)) + { + x = CB_VALUE(l); + v = cb_ref(x); + if (CB_LABEL_P(v)) + { + CB_LABEL(v)->need_begin = 1; + if (CB_REFERENCE(x)->length) + { + CB_LABEL(v)->need_return = 1; } - } else if (v != cb_error_node) { - cb_error_x (x, _("'%s' not procedure name"), cb_name (x)); + } + else if (v != cb_error_node) + { + cb_error_x(x, _("'%s' not procedure name"), cb_name(x)); } } - prog->file_list = cb_list_reverse (prog->file_list); - prog->exec_list = cb_list_reverse (prog->exec_list); + prog->file_list = cb_list_reverse(prog->file_list); + prog->exec_list = cb_list_reverse(prog->exec_list); - if (cb_warn_compat) { - for (l = prog->exec_list; l; l = CB_CHAIN (l)) { - check_section_escape (CB_VALUE (l)); + if (cb_warn_compat) + { + for (l = prog->exec_list; l; l = CB_CHAIN(l)) + { + check_section_escape(CB_VALUE(l)); } } } @@ -1632,11 +1919,12 @@ cb_validate_program_body (struct cb_program *prog) */ static void -cb_expr_init (void) +cb_expr_init(void) { static int initialized = 0; - if (initialized == 0) { + if (initialized == 0) + { /* init priority talble */ expr_prio['x'] = 0; expr_prio['^'] = 1; @@ -1658,10 +1946,10 @@ cb_expr_init (void) expr_prio[0] = 10; /* init stack */ expr_stack_size = START_STACK_SIZE; - expr_stack = cobc_malloc (sizeof (struct expr_node) * START_STACK_SIZE); - expr_stack[0].token = 0; /* dummy */ - expr_stack[1].token = 0; /* dummy */ - expr_stack[2].token = 0; /* dummy */ + expr_stack = cobc_malloc(sizeof(struct expr_node) * START_STACK_SIZE); + expr_stack[0].token = 0; /* dummy */ + expr_stack[1].token = 0; /* dummy */ + expr_stack[2].token = 0; /* dummy */ initialized = 1; } @@ -1671,19 +1959,21 @@ cb_expr_init (void) } static int -expr_reduce (int token) +expr_reduce(int token) { /* Example: * index: -3 -2 -1 0 * token: 'x' '*' 'x' '+' ... */ - int op; + int op; - while (expr_prio[TOKEN (-2)] <= expr_prio[token]) { + while (expr_prio[TOKEN(-2)] <= expr_prio[token]) + { /* Reduce the expression depending on the last operator */ - op = TOKEN (-2); - switch (op) { + op = TOKEN(-2); + switch (op) + { case 'x': return 0; @@ -1693,57 +1983,64 @@ expr_reduce (int token) case '/': case '^': /* Arithmetic operators: 'x' op 'x' */ - if (TOKEN (-1) != 'x' || TOKEN (-3) != 'x') { + if (TOKEN(-1) != 'x' || TOKEN(-3) != 'x') + { return -1; } - TOKEN (-3) = 'x'; - VALUE (-3) = cb_build_binary_op (VALUE (-3), op, VALUE (-1)); + TOKEN(-3) = 'x'; + VALUE(-3) = cb_build_binary_op(VALUE(-3), op, VALUE(-1)); expr_index -= 2; break; case '!': /* Negation: '!' 'x' */ - if (TOKEN (-1) != 'x') { + if (TOKEN(-1) != 'x') + { return -1; } /* 'x' '=' 'x' '|' '!' 'x' */ - if (expr_lh) { - if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1)); + if (expr_lh) + { + if (CB_TREE_CLASS(VALUE(-1)) != CB_CLASS_BOOLEAN) + { + VALUE(-1) = cb_build_binary_op(expr_lh, expr_op, VALUE(-1)); } } - TOKEN (-2) = 'x'; - VALUE (-2) = cb_build_negation (VALUE (-1)); + TOKEN(-2) = 'x'; + VALUE(-2) = cb_build_negation(VALUE(-1)); expr_index -= 1; break; case '&': case '|': /* Logical AND/OR: 'x' op 'x' */ - if (TOKEN (-1) != 'x' || TOKEN (-3) != 'x') { + if (TOKEN(-1) != 'x' || TOKEN(-3) != 'x') + { return -1; } /* 'x' '=' 'x' '|' 'x' */ - if (expr_lh) { - if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1)); + if (expr_lh) + { + if (CB_TREE_CLASS(VALUE(-1)) != CB_CLASS_BOOLEAN) + { + VALUE(-1) = cb_build_binary_op(expr_lh, expr_op, VALUE(-1)); } - if (CB_TREE_CLASS (VALUE (-3)) != CB_CLASS_BOOLEAN) { - VALUE (-3) = cb_build_binary_op (expr_lh, expr_op, VALUE (-3)); + if (CB_TREE_CLASS(VALUE(-3)) != CB_CLASS_BOOLEAN) + { + VALUE(-3) = cb_build_binary_op(expr_lh, expr_op, VALUE(-3)); } } /* warning for complex expressions without explicit parentheses (i.e., "a OR b AND c" or "a AND b OR c") */ - if (cb_warn_parentheses && op == '|') { - if ((CB_BINARY_OP_P (VALUE (-3)) - && CB_BINARY_OP (VALUE (-3))->op == '&') - || (CB_BINARY_OP_P (VALUE (-1)) - && CB_BINARY_OP (VALUE (-1))->op == '&')) { - cb_warning (_("Suggest parentheses around AND within OR")); + if (cb_warn_parentheses && op == '|') + { + if ((CB_BINARY_OP_P(VALUE(-3)) && CB_BINARY_OP(VALUE(-3))->op == '&') || (CB_BINARY_OP_P(VALUE(-1)) && CB_BINARY_OP(VALUE(-1))->op == '&')) + { + cb_warning(_("Suggest parentheses around AND within OR")); } } - TOKEN (-3) = 'x'; - VALUE (-3) = cb_build_binary_op (VALUE (-3), op, VALUE (-1)); + TOKEN(-3) = 'x'; + VALUE(-3) = cb_build_binary_op(VALUE(-3), op, VALUE(-1)); expr_index -= 2; break; @@ -1753,34 +2050,46 @@ expr_reduce (int token) default: /* Relational operators */ - if (TOKEN (-1) != 'x') { + if (TOKEN(-1) != 'x') + { return -1; } - switch (TOKEN (-3)) { + switch (TOKEN(-3)) + { case 'x': /* Simple condition: 'x' op 'x' */ - if (VALUE (-3) == cb_error_node || VALUE (-1) == cb_error_node) { - VALUE (-3) = cb_error_node; - } else { - expr_lh = VALUE (-3); - if (CB_REF_OR_FIELD_P (expr_lh)) { - if (cb_field (expr_lh)->level == 88) { - VALUE (-3) = cb_error_node; + if (VALUE(-3) == cb_error_node || VALUE(-1) == cb_error_node) + { + VALUE(-3) = cb_error_node; + } + else + { + expr_lh = VALUE(-3); + if (CB_REF_OR_FIELD_P(expr_lh)) + { + if (cb_field(expr_lh)->level == 88) + { + VALUE(-3) = cb_error_node; return -1; } } - if (CB_REF_OR_FIELD_P (VALUE(-1))) { - if (cb_field (VALUE(-1))->level == 88) { - VALUE (-3) = cb_error_node; + if (CB_REF_OR_FIELD_P(VALUE(-1))) + { + if (cb_field(VALUE(-1))->level == 88) + { + VALUE(-3) = cb_error_node; return -1; } } expr_op = op; - TOKEN (-3) = 'x'; - if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - VALUE (-3) = cb_build_binary_op (expr_lh, op, VALUE (-1)); - } else { - VALUE (-3) = VALUE (-1); + TOKEN(-3) = 'x'; + if (CB_TREE_CLASS(VALUE(-1)) != CB_CLASS_BOOLEAN) + { + VALUE(-3) = cb_build_binary_op(expr_lh, op, VALUE(-1)); + } + else + { + VALUE(-3) = VALUE(-1); } } expr_index -= 2; @@ -1788,15 +2097,21 @@ expr_reduce (int token) case '&': case '|': /* Complex condition: 'x' '=' 'x' '|' op 'x' */ - if (VALUE (-1) == cb_error_node) { - VALUE (-2) = cb_error_node; - } else { + if (VALUE(-1) == cb_error_node) + { + VALUE(-2) = cb_error_node; + } + else + { expr_op = op; - TOKEN (-2) = 'x'; - if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - VALUE (-2) = cb_build_binary_op (expr_lh, op, VALUE (-1)); - } else { - VALUE (-2) = VALUE (-1); + TOKEN(-2) = 'x'; + if (CB_TREE_CLASS(VALUE(-1)) != CB_CLASS_BOOLEAN) + { + VALUE(-2) = cb_build_binary_op(expr_lh, op, VALUE(-1)); + } + else + { + VALUE(-2) = VALUE(-1); } } expr_index -= 1; @@ -1809,92 +2124,107 @@ expr_reduce (int token) } /* handle special case "op OR x AND" */ - if (token == '&' && TOKEN (-2) == '|' && CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - TOKEN (-1) = 'x'; - VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1)); + if (token == '&' && TOKEN(-2) == '|' && CB_TREE_CLASS(VALUE(-1)) != CB_CLASS_BOOLEAN) + { + TOKEN(-1) = 'x'; + VALUE(-1) = cb_build_binary_op(expr_lh, expr_op, VALUE(-1)); } return 0; } static void -cb_expr_shift_sign (const int op) +cb_expr_shift_sign(const int op) { - int have_not = 0; + int have_not = 0; - if (TOKEN (-1) == '!') { + if (TOKEN(-1) == '!') + { have_not = 1; expr_index--; } - expr_reduce ('='); - if (TOKEN (-1) == 'x') { - VALUE (-1) = cb_build_binary_op (VALUE (-1), op, cb_zero); - if (have_not) { - VALUE (-1) = cb_build_negation (VALUE (-1)); + expr_reduce('='); + if (TOKEN(-1) == 'x') + { + VALUE(-1) = cb_build_binary_op(VALUE(-1), op, cb_zero); + if (have_not) + { + VALUE(-1) = cb_build_negation(VALUE(-1)); } } } static void -cb_expr_shift_class (const char *name) +cb_expr_shift_class(const char *name) { - int have_not = 0; + int have_not = 0; - if (TOKEN (-1) == '!') { + if (TOKEN(-1) == '!') + { have_not = 1; expr_index--; } - expr_reduce ('='); - if (TOKEN (-1) == 'x') { - VALUE (-1) = cb_build_funcall_1 (name, VALUE (-1)); - if (have_not) { - VALUE (-1) = cb_build_negation (VALUE (-1)); + expr_reduce('='); + if (TOKEN(-1) == 'x') + { + VALUE(-1) = cb_build_funcall_1(name, VALUE(-1)); + if (have_not) + { + VALUE(-1) = cb_build_negation(VALUE(-1)); } } } static void -cb_expr_shift_class_method_call (const char *name) +cb_expr_shift_class_method_call(const char *name) { - int have_not = 0; + int have_not = 0; - if (TOKEN (-1) == '!') { + if (TOKEN(-1) == '!') + { have_not = 1; expr_index--; } - expr_reduce ('='); - if (TOKEN (-1) == 'x') { - VALUE (-1) = cb_build_method_call_1 (name, VALUE (-1)); - if (have_not) { - VALUE (-1) = cb_build_negation (VALUE (-1)); + expr_reduce('='); + if (TOKEN(-1) == 'x') + { + VALUE(-1) = cb_build_method_call_1(name, VALUE(-1)); + if (have_not) + { + VALUE(-1) = cb_build_negation(VALUE(-1)); } } } static void -cb_expr_shift (int token, cb_tree value) +cb_expr_shift(int token, cb_tree value) { - switch (token) { + switch (token) + { case 'x': /* sign ZERO condition */ - if (value == cb_zero) { - if (TOKEN (-1) == 'x' || TOKEN (-1) == '!') { - cb_expr_shift_sign ('='); + if (value == cb_zero) + { + if (TOKEN(-1) == 'x' || TOKEN(-1) == '!') + { + cb_expr_shift_sign('='); return; } } /* class condition */ - if (CB_REFERENCE_P (value) - && CB_CLASS_NAME_P (cb_ref (value))) { - cb_expr_shift_class (CB_CLASS_NAME (cb_ref (value))->cname); + if (CB_REFERENCE_P(value) && CB_CLASS_NAME_P(cb_ref(value))) + { + cb_expr_shift_class(CB_CLASS_NAME(cb_ref(value))->cname); return; } /* unary sign */ - if ((TOKEN (-1) == '+' || TOKEN (-1) == '-') && TOKEN (-2) != 'x') { - if (TOKEN (-1) == '-') { - value = cb_build_binary_op (cb_zero, '-', value); + if ((TOKEN(-1) == '+' || TOKEN(-1) == '-') && TOKEN(-2) != 'x') + { + if (TOKEN(-1) == '-') + { + value = cb_build_binary_op(cb_zero, '-', value); } expr_index -= 1; } @@ -1902,27 +2232,30 @@ cb_expr_shift (int token, cb_tree value) case '(': /* 'x' op '(' --> '(' 'x' op */ - switch (TOKEN (-1)) { + switch (TOKEN(-1)) + { case '=': case '~': case '<': case '>': case '[': case ']': - expr_op = TOKEN (-1); - if (TOKEN (-2) == 'x') { - expr_lh = VALUE (-2); + expr_op = TOKEN(-1); + if (TOKEN(-2) == 'x') + { + expr_lh = VALUE(-2); } } break; case ')': /* enclose by parentheses */ - expr_reduce (token); - if (TOKEN (-2) == '(') { - value = cb_build_parenthesis (VALUE (-1)); + expr_reduce(token); + if (TOKEN(-2) == '(') + { + value = cb_build_parenthesis(VALUE(-1)); expr_index -= 2; - cb_expr_shift ('x', value); + cb_expr_shift('x', value); return; } break; @@ -1930,14 +2263,17 @@ cb_expr_shift (int token, cb_tree value) default: /* '<' '|' '=' --> '[' */ /* '>' '|' '=' --> ']' */ - if (token == '=' && TOKEN (-1) == '|' && (TOKEN (-2) == '<' || TOKEN (-2) == '>')) { - token = (TOKEN (-2) == '<') ? '[' : ']'; + if (token == '=' && TOKEN(-1) == '|' && (TOKEN(-2) == '<' || TOKEN(-2) == '>')) + { + token = (TOKEN(-2) == '<') ? '[' : ']'; expr_index -= 2; } /* '!' '=' --> '~', etc. */ - if (TOKEN (-1) == '!') { - switch (token) { + if (TOKEN(-1) == '!') + { + switch (token) + { case '=': token = '~'; expr_index--; @@ -1968,160 +2304,179 @@ cb_expr_shift (int token, cb_tree value) } /* reduce */ - expr_reduce (token); + expr_reduce(token); /* allocate sufficient stack memory */ - if (expr_index >= expr_stack_size) { + if (expr_index >= expr_stack_size) + { expr_stack_size *= 2; - expr_stack = cobc_realloc (expr_stack, sizeof (struct expr_node) * expr_stack_size); + expr_stack = cobc_realloc(expr_stack, sizeof(struct expr_node) * expr_stack_size); } /* put on the stack */ - TOKEN (0) = token; - VALUE (0) = value; + TOKEN(0) = token; + VALUE(0) = value; expr_index++; } static void -expr_expand (cb_tree *x) +expr_expand(cb_tree *x) { - struct cb_binary_op *p; + struct cb_binary_op *p; start: /* remove parenthesis */ - if (CB_BINARY_OP_P (*x)) { - p = CB_BINARY_OP (*x); - if (p->op == '@') { + if (CB_BINARY_OP_P(*x)) + { + p = CB_BINARY_OP(*x); + if (p->op == '@') + { *x = p->x; goto start; } - expr_expand (&p->x); - if (p->y) { - expr_expand (&p->y); + expr_expand(&p->x); + if (p->y) + { + expr_expand(&p->y); } } } static cb_tree -cb_expr_finish (void) +cb_expr_finish(void) { - expr_reduce (0); /* reduce all */ + expr_reduce(0); /* reduce all */ - if (expr_index != 4) { - cb_error (_("Invalid expression")); + if (expr_index != 4) + { + cb_error(_("Invalid expression")); return cb_error_node; } - if (!expr_stack[3].value) { - cb_error (_("Invalid expression")); + if (!expr_stack[3].value) + { + cb_error(_("Invalid expression")); return cb_error_node; } - expr_expand (&expr_stack[3].value); - if (expr_stack[3].token != 'x') { - cb_error (_("Invalid expression")); + expr_expand(&expr_stack[3].value); + if (expr_stack[3].token != 'x') + { + cb_error(_("Invalid expression")); return cb_error_node; } return expr_stack[3].value; } static int -check_div_mul_order (cb_tree n) +check_div_mul_order(cb_tree n) { int flg = 0; - if (CB_BINARY_OP (n)->x && CB_BINARY_OP_P (CB_BINARY_OP (n)->x)) { - flg = check_div_mul_order (CB_BINARY_OP (n)->x); + if (CB_BINARY_OP(n)->x && CB_BINARY_OP_P(CB_BINARY_OP(n)->x)) + { + flg = check_div_mul_order(CB_BINARY_OP(n)->x); } - if (CB_BINARY_OP (n)->y && CB_BINARY_OP_P (CB_BINARY_OP (n)->y)) { - flg = check_div_mul_order (CB_BINARY_OP (n)->y); + if (CB_BINARY_OP(n)->y && CB_BINARY_OP_P(CB_BINARY_OP(n)->y)) + { + flg = check_div_mul_order(CB_BINARY_OP(n)->y); } - if (CB_BINARY_OP (n)->op == '/') { + if (CB_BINARY_OP(n)->op == '/') + { flg = 1; - } else if (CB_BINARY_OP (n)->op == '*') { - if (flg) { - cb_warning (_("MUL operation after DIV can cause the precision issue.")); + } + else if (CB_BINARY_OP(n)->op == '*') + { + if (flg) + { + cb_warning(_("MUL operation after DIV can cause the precision issue.")); flg = 0; } - } else { + } + else + { flg = 0; } return flg; } static cb_tree -cb_validate_expr (cb_tree x) +cb_validate_expr(cb_tree x) { - if (cb_warn_compat) { - if (CB_BINARY_OP_P(x)) { - check_div_mul_order (x); + if (cb_warn_compat) + { + if (CB_BINARY_OP_P(x)) + { + check_div_mul_order(x); } } return x; } cb_tree -cb_build_expr (cb_tree list) +cb_build_expr(cb_tree list) { cb_tree l; -/* RXW - cb_tree x; -*/ - int op; - - cb_expr_init (); - - for (l = list; l; l = CB_CHAIN (l)) { - op = CB_PURPOSE_INT (l); - switch (op) { + /* RXW + cb_tree x; + */ + int op; + + cb_expr_init(); + + for (l = list; l; l = CB_CHAIN(l)) + { + op = CB_PURPOSE_INT(l); + switch (op) + { case '9': /* NUMERIC */ - cb_expr_shift_class_method_call ("isNumeric"); + cb_expr_shift_class_method_call("isNumeric"); break; case 'A': /* ALPHABETIC */ - cb_expr_shift_class_method_call ("isAlpha"); + cb_expr_shift_class_method_call("isAlpha"); break; case 'L': /* ALPHABETIC_LOWER */ - cb_expr_shift_class_method_call ("isLower"); + cb_expr_shift_class_method_call("isLower"); break; case 'U': /* ALPHABETIC_UPPER */ - cb_expr_shift_class_method_call ("isUpper"); + cb_expr_shift_class_method_call("isUpper"); break; case 'P': /* POSITIVE */ - cb_expr_shift_sign ('>'); + cb_expr_shift_sign('>'); break; case 'N': /* NEGATIVE */ - cb_expr_shift_sign ('<'); + cb_expr_shift_sign('<'); break; case 'O': /* OMITTED */ current_statement->null_check = NULL; - cb_expr_shift_class_method_call ("isOmitted"); + cb_expr_shift_class_method_call("isOmitted"); break; -/* RXW - case 'x': - if (CB_VALUE (l) && CB_REFERENCE_P (CB_VALUE (l))) { - x = CB_CHAIN (l); - if (x && cb_field (CB_VALUE (l))->level == 88) { - switch (CB_PURPOSE_INT (x)) { - case '&': - case '|': - case '(': - case ')': - break; - default: - cb_error (_("Invalid condition")); + /* RXW + case 'x': + if (CB_VALUE (l) && CB_REFERENCE_P (CB_VALUE (l))) { + x = CB_CHAIN (l); + if (x && cb_field (CB_VALUE (l))->level == 88) { + switch (CB_PURPOSE_INT (x)) { + case '&': + case '|': + case '(': + case ')': + break; + default: + cb_error (_("Invalid condition")); + break; + } + } + } + cb_expr_shift (op, CB_VALUE (l)); break; - } - } - } - cb_expr_shift (op, CB_VALUE (l)); - break; -*/ + */ default: - cb_expr_shift (op, CB_VALUE (l)); + cb_expr_shift(op, CB_VALUE(l)); break; } } - return cb_validate_expr (cb_expr_finish ()); + return cb_validate_expr(cb_expr_finish()); } /* @@ -2129,71 +2484,81 @@ cb_build_expr (cb_tree list) */ static cb_tree -build_store_option (cb_tree x, cb_tree round_opt) +build_store_option(cb_tree x, cb_tree round_opt) { int opt = 0; - if (round_opt == cb_int1) { + if (round_opt == cb_int1) + { opt |= COB_STORE_ROUND; } - switch (CB_FIELD (cb_ref (x))->usage) { + switch (CB_FIELD(cb_ref(x))->usage) + { case CB_USAGE_COMP_5: case CB_USAGE_COMP_X: - if (current_statement->handler1) { + if (current_statement->handler1) + { opt |= COB_STORE_KEEP_ON_OVERFLOW; } break; default: - if (!cb_binary_truncate) { - if (current_statement->handler1) { + if (!cb_binary_truncate) + { + if (current_statement->handler1) + { opt |= COB_STORE_KEEP_ON_OVERFLOW; } break; } -/* RXW Fixme - It seems as though we have NEVER implemented TRUNC, - Code has always been wrong. Hmm. The following statement would - activate what was intended but ... - What should we do here? - if (current_statement->handler1) { -*/ - if (current_statement->handler_id) { + /* RXW Fixme - It seems as though we have NEVER implemented TRUNC, + Code has always been wrong. Hmm. The following statement would + activate what was intended but ... + What should we do here? + if (current_statement->handler1) { + */ + if (current_statement->handler_id) + { opt |= COB_STORE_KEEP_ON_OVERFLOW; - } else if (cb_binary_truncate) { + } + else if (cb_binary_truncate) + { opt |= COB_STORE_TRUNC_ON_OVERFLOW; } break; } - return cb_int (opt); + return cb_int(opt); } static cb_tree -decimal_alloc (void) +decimal_alloc(void) { cb_tree x; - x = cb_build_decimal (current_program->decimal_index); + x = cb_build_decimal(current_program->decimal_index); current_program->decimal_index++; - if (current_program->decimal_index > current_program->decimal_index_max) { + if (current_program->decimal_index > current_program->decimal_index_max) + { current_program->decimal_index_max = current_program->decimal_index; } return x; } static void -decimal_free (void) +decimal_free(void) { current_program->decimal_index--; } static int -decimal_compute (const int op, cb_tree x, cb_tree y) +decimal_compute(const int op, cb_tree x, cb_tree y) { const char *func; - switch (op) { + switch (op) + { case '+': func = "add"; break; @@ -2210,195 +2575,236 @@ decimal_compute (const int op, cb_tree x, cb_tree y) func = "pow"; break; default: - fprintf (stderr, "Unexpected operation %d\n", op); + fprintf(stderr, "Unexpected operation %d\n", op); return 1; /* don't ABORT (), continue parsing */ } - dpush (cb_build_method_call_2 (func, x, y)); + dpush(cb_build_method_call_2(func, x, y)); return 0; } static int -decimal_expand (cb_tree d, cb_tree x) +decimal_expand(cb_tree d, cb_tree x) { - struct cb_literal *l; - struct cb_field *f; - struct cb_binary_op *p; - cb_tree t; + struct cb_literal *l; + struct cb_field *f; + struct cb_binary_op *p; + cb_tree t; int rt = 0; - switch (CB_TREE_TAG (x)) { + switch (CB_TREE_TAG(x)) + { case CB_TAG_CONST: - if (x == cb_zero) { - dpush (cb_build_method_call_2 ("set", d, cb_int0)); + if (x == cb_zero) + { + dpush(cb_build_method_call_2("set", d, cb_int0)); current_program->gen_decset = 1; - } else { - fprintf (stderr, "Unexpected constant expansion\n"); + } + else + { + fprintf(stderr, "Unexpected constant expansion\n"); rt = 1; /* don't ABORT (), continue parsing */ } break; case CB_TAG_LITERAL: /* set d, N */ - l = CB_LITERAL (x); - if (l->size < 10 && l->scale == 0) { - dpush (cb_build_method_call_2 ("set", d, cb_build_cast_integer (x))); + l = CB_LITERAL(x); + if (l->size < 10 && l->scale == 0) + { + dpush(cb_build_method_call_2("set", d, cb_build_cast_integer(x))); current_program->gen_decset = 1; - } else { - dpush (cb_build_method_call_2 ("setField", d, x)); + } + else + { + dpush(cb_build_method_call_2("setField", d, x)); } break; case CB_TAG_REFERENCE: /* set d, X */ - f = cb_field (x); + f = cb_field(x); /* check numeric */ - if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE)) { - if (f->usage == CB_USAGE_DISPLAY || f->usage == CB_USAGE_PACKED) { - dpush (cb_build_method_call_2 ("checkNumeric", - x, cb_build_string0 ((ucharptr)(f->name)))); + if (CB_EXCEPTION_ENABLE(COB_EC_DATA_INCOMPATIBLE)) + { + if (f->usage == CB_USAGE_DISPLAY || f->usage == CB_USAGE_PACKED) + { + dpush(cb_build_method_call_2("checkNumeric", + x, cb_build_string0((ucharptr)(f->name)))); } } - if (cb_fits_int (x)) { - if (f->pic->have_sign) { - dpush (cb_build_method_call_2 ("set", d, cb_build_cast_integer (x))); + if (cb_fits_int(x)) + { + if (f->pic->have_sign) + { + dpush(cb_build_method_call_2("set", d, cb_build_cast_integer(x))); current_program->gen_decset = 1; - } else { - dpush (cb_build_method_call_2 ("set", d, cb_build_cast_integer (x))); + } + else + { + dpush(cb_build_method_call_2("set", d, cb_build_cast_integer(x))); current_program->gen_udecset = 1; } - } else { - dpush (cb_build_method_call_2 ("setField", d, x)); + } + else + { + dpush(cb_build_method_call_2("setField", d, x)); } break; case CB_TAG_BINARY_OP: /* set d, X * set t, Y * OP d, t */ - p = CB_BINARY_OP (x); - t = decimal_alloc (); - if (decimal_expand (d, p->x) || - decimal_expand (t, p->y) || - decimal_compute (p->op, d, t)) { + p = CB_BINARY_OP(x); + t = decimal_alloc(); + if (decimal_expand(d, p->x) || + decimal_expand(t, p->y) || + decimal_compute(p->op, d, t)) + { rt = 1; } - decimal_free (); + decimal_free(); break; case CB_TAG_INTRINSIC: - dpush (cb_build_method_call_2 ("setField", d, x)); + dpush(cb_build_method_call_2("setField", d, x)); break; default: - fprintf (stderr, "Unexpected tree tag %d\n", CB_TREE_TAG (x)); + fprintf(stderr, "Unexpected tree tag %d\n", CB_TREE_TAG(x)); rt = 1; /* don't ABORT (), continue parsing */ } return rt; } static void -decimal_assign (cb_tree x, cb_tree d, cb_tree round_opt) +decimal_assign(cb_tree x, cb_tree d, cb_tree round_opt) { - dpush (cb_build_method_call_3 ("getField", d, x, build_store_option (x, round_opt))); + dpush(cb_build_method_call_3("getField", d, x, build_store_option(x, round_opt))); } static cb_tree -build_decimal_assign (cb_tree vars, int op, cb_tree val) +build_decimal_assign(cb_tree vars, int op, cb_tree val) { cb_tree l; cb_tree t; cb_tree s1 = NULL; cb_tree d; - d = decimal_alloc (); + d = decimal_alloc(); /* set d, VAL */ - if (decimal_expand (d, val)) { + if (decimal_expand(d, val)) + { s1 = NULL; - } else if (op == 0) { - for (l = vars; l; l = CB_CHAIN (l)) { + } + else if (op == 0) + { + for (l = vars; l; l = CB_CHAIN(l)) + { /* set VAR, d */ - decimal_assign (CB_VALUE (l), d, CB_PURPOSE (l)); - s1 = cb_list_add (s1, cb_list_reverse (decimal_stack)); + decimal_assign(CB_VALUE(l), d, CB_PURPOSE(l)); + s1 = cb_list_add(s1, cb_list_reverse(decimal_stack)); decimal_stack = NULL; } - } else { - t = decimal_alloc (); - for (l = vars; l; l = CB_CHAIN (l)) { + } + else + { + t = decimal_alloc(); + for (l = vars; l; l = CB_CHAIN(l)) + { /* set t, VAR * OP t, d * set VAR, t */ - if (decimal_expand (t, CB_VALUE (l)) || - decimal_compute (op, t, d)) { + if (decimal_expand(t, CB_VALUE(l)) || + decimal_compute(op, t, d)) + { s1 = NULL; - } else { - decimal_assign (CB_VALUE (l), t, CB_PURPOSE (l)); - s1 = cb_list_add (s1, cb_list_reverse (decimal_stack)); + } + else + { + decimal_assign(CB_VALUE(l), t, CB_PURPOSE(l)); + s1 = cb_list_add(s1, cb_list_reverse(decimal_stack)); } decimal_stack = NULL; } - decimal_free (); + decimal_free(); } - decimal_free (); + decimal_free(); return s1; } -void -cb_emit_arithmetic (cb_tree vars, int op, cb_tree val) +void cb_emit_arithmetic(cb_tree vars, int op, cb_tree val) { - cb_tree l; - cb_tree t; - struct cb_field *f; + cb_tree l; + cb_tree t; + struct cb_field *f; - val = cb_check_numeric_value (val); - if (op) { - cb_list_map (cb_check_numeric_name, vars); - } else { - cb_list_map (cb_check_numeric_edited_name, vars); + val = cb_check_numeric_value(val); + if (op) + { + cb_list_map(cb_check_numeric_name, vars); + } + else + { + cb_list_map(cb_check_numeric_edited_name, vars); } - if (cb_validate_one (val)) { + if (cb_validate_one(val)) + { return; } - if (cb_validate_list (vars)) { + if (cb_validate_list(vars)) + { return; } - if (!CB_BINARY_OP_P (val)) { - if (op == '+' || op == '-') { - if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE) && - (CB_REF_OR_FIELD_P (val))) { - f = cb_field (val); + if (!CB_BINARY_OP_P(val)) + { + if (op == '+' || op == '-') + { + if (CB_EXCEPTION_ENABLE(COB_EC_DATA_INCOMPATIBLE) && + (CB_REF_OR_FIELD_P(val))) + { + f = cb_field(val); if (f->usage == CB_USAGE_DISPLAY || - f->usage == CB_USAGE_PACKED) { - cb_emit (cb_build_method_call_2 ("checkNumeric", - val, - cb_build_string0 ((ucharptr)(f->name)))); + f->usage == CB_USAGE_PACKED) + { + cb_emit(cb_build_method_call_2("checkNumeric", + val, + cb_build_string0((ucharptr)(f->name)))); } } - for (l = vars; l; l = CB_CHAIN (l)) { - if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE) && - (CB_REF_OR_FIELD_P (CB_VALUE(l)))) { - f = cb_field (CB_VALUE(l)); + for (l = vars; l; l = CB_CHAIN(l)) + { + if (CB_EXCEPTION_ENABLE(COB_EC_DATA_INCOMPATIBLE) && + (CB_REF_OR_FIELD_P(CB_VALUE(l)))) + { + f = cb_field(CB_VALUE(l)); if (f->usage == CB_USAGE_DISPLAY || - f->usage == CB_USAGE_PACKED) { - cb_emit (cb_build_method_call_2 ("checkNumeric", - CB_VALUE(l), - cb_build_string0 ((ucharptr)(f->name)))); + f->usage == CB_USAGE_PACKED) + { + cb_emit(cb_build_method_call_2("checkNumeric", + CB_VALUE(l), + cb_build_string0((ucharptr)(f->name)))); } } - if (op == '+') { - CB_VALUE (l) = cb_build_add (CB_VALUE (l), val, CB_PURPOSE (l)); - } else { - CB_VALUE (l) = cb_build_sub (CB_VALUE (l), val, CB_PURPOSE (l)); + if (op == '+') + { + CB_VALUE(l) = cb_build_add(CB_VALUE(l), val, CB_PURPOSE(l)); + } + else + { + CB_VALUE(l) = cb_build_sub(CB_VALUE(l), val, CB_PURPOSE(l)); } } - cb_emit_list (vars); + cb_emit_list(vars); return; } } - t = build_decimal_assign (vars, op, val); - if (t) { - cb_emit (t); + t = build_decimal_assign(vars, op, val); + if (t) + { + cb_emit(t); } } @@ -2407,115 +2813,144 @@ cb_emit_arithmetic (cb_tree vars, int op, cb_tree val) */ static cb_tree -build_cond_88 (cb_tree x) +build_cond_88(cb_tree x) { - struct cb_field *f; - cb_tree l; - cb_tree t; - cb_tree c1 = NULL; - cb_tree c2; + struct cb_field *f; + cb_tree l; + cb_tree t; + cb_tree c1 = NULL; + cb_tree c2; - f = cb_field (x); + f = cb_field(x); /* refer to parent's data storage */ - x = cb_build_field_reference (f->parent, x); + x = cb_build_field_reference(f->parent, x); f->parent->count++; /* build condition */ - for (l = f->values; l; l = CB_CHAIN (l)) { - t = CB_VALUE (l); - if (CB_PAIR_P (t)) { + for (l = f->values; l; l = CB_CHAIN(l)) + { + t = CB_VALUE(l); + if (CB_PAIR_P(t)) + { /* VALUE THRU VALUE */ - c2 = cb_build_binary_op (cb_build_binary_op (CB_PAIR_X (t), '[', x), - '&', cb_build_binary_op (x, '[', CB_PAIR_Y (t))); - } else { + c2 = cb_build_binary_op(cb_build_binary_op(CB_PAIR_X(t), '[', x), + '&', cb_build_binary_op(x, '[', CB_PAIR_Y(t))); + } + else + { /* VALUE */ - c2 = cb_build_binary_op (x, '=', t); + c2 = cb_build_binary_op(x, '=', t); } - if (c1 == NULL) { + if (c1 == NULL) + { c1 = c2; - } else { - c1 = cb_build_binary_op (c1, '|', c2); + } + else + { + c1 = cb_build_binary_op(c1, '|', c2); } } return c1; } static cb_tree -cb_build_optim_cond (struct cb_binary_op *p) +cb_build_optim_cond(struct cb_binary_op *p) { - struct cb_field *f; - struct cb_field *fy; - const char *s; - size_t n; + struct cb_field *f; + struct cb_field *fy; + const char *s; + size_t n; - if (CB_REF_OR_FIELD_P (p->y)) { - fy = cb_field (p->y); + if (CB_REF_OR_FIELD_P(p->y)) + { + fy = cb_field(p->y); if (!fy->pic->have_sign && (fy->usage == CB_USAGE_BINARY || - fy->usage == CB_USAGE_COMP_5 || - fy->usage == CB_USAGE_COMP_X)) { - return cb_build_method_call_2 ("cmpUint", p->x, cb_build_cast_integer (p->y)); - } - } - if (CB_REF_OR_FIELD_P (p->x)) { - f = cb_field (p->x); - if (!f->pic->scale && f->usage == CB_USAGE_PACKED) { - if (f->pic->digits < 10) { - return cb_build_method_call_2 ("cmpInt", - p->x, - cb_build_cast_integer (p->y)); - } else { - return cb_build_method_call_2 ("cmpInt", - p->x, - cb_build_cast_integer (p->y)); + fy->usage == CB_USAGE_COMP_5 || + fy->usage == CB_USAGE_COMP_X)) + { + return cb_build_method_call_2("cmpUint", p->x, cb_build_cast_integer(p->y)); + } + } + if (CB_REF_OR_FIELD_P(p->x)) + { + f = cb_field(p->x); + if (!f->pic->scale && f->usage == CB_USAGE_PACKED) + { + if (f->pic->digits < 10) + { + return cb_build_method_call_2("cmpInt", + p->x, + cb_build_cast_integer(p->y)); + } + else + { + return cb_build_method_call_2("cmpInt", + p->x, + cb_build_cast_integer(p->y)); } } if (!f->pic->scale && f->usage == CB_USAGE_DISPLAY && - !f->flag_sign_leading && !f->flag_sign_separate) { - if (cb_fits_int (p->x)) { - if (!f->pic->have_sign) { - return cb_build_method_call_3 ("cmpNumdisp", - cb_build_cast_address (p->x), - cb_int (f->size), - cb_build_cast_integer (p->y)); - } else { - return cb_build_method_call_3 ("cmpSignNumdisp", - cb_build_cast_address (p->x), - cb_int (f->size), - cb_build_cast_integer (p->y)); - } - } else if (cb_fits_long_long (p->x)) { - if (!f->pic->have_sign) { - return cb_build_method_call_3 ("cmpLongNumdisp", - cb_build_cast_address (p->x), - cb_int (f->size), - cb_build_cast_integer (p->y)); - } else { - return cb_build_method_call_3 ("cmpLongSignNumdisp", - cb_build_cast_address (p->x), - cb_int (f->size), - cb_build_cast_integer (p->y)); + !f->flag_sign_leading && !f->flag_sign_separate) + { + if (cb_fits_int(p->x)) + { + if (!f->pic->have_sign) + { + return cb_build_method_call_3("cmpNumdisp", + cb_build_cast_address(p->x), + cb_int(f->size), + cb_build_cast_integer(p->y)); + } + else + { + return cb_build_method_call_3("cmpSignNumdisp", + cb_build_cast_address(p->x), + cb_int(f->size), + cb_build_cast_integer(p->y)); + } + } + else if (cb_fits_long_long(p->x)) + { + if (!f->pic->have_sign) + { + return cb_build_method_call_3("cmpLongNumdisp", + cb_build_cast_address(p->x), + cb_int(f->size), + cb_build_cast_integer(p->y)); + } + else + { + return cb_build_method_call_3("cmpLongSignNumdisp", + cb_build_cast_address(p->x), + cb_int(f->size), + cb_build_cast_integer(p->y)); } } } if (!f->pic->scale && (f->usage == CB_USAGE_BINARY || - f->usage == CB_USAGE_COMP_5 || - f->usage == CB_USAGE_INDEX || - f->usage == CB_USAGE_COMP_X)) { + f->usage == CB_USAGE_COMP_5 || + f->usage == CB_USAGE_INDEX || + f->usage == CB_USAGE_COMP_X)) + { n = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0)) + (16 * (f->flag_binary_swap ? 1 : 0)); -#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) - switch (f->size) { +#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) + switch (f->size) + { case 2: -#ifdef COB_SHORT_BORK +#ifdef COB_SHORT_BORK s = bin_compare_funcs[n]; break; #endif case 4: case 8: if (f->storage != CB_STORAGE_LINKAGE && - f->indexes == 0 && (f->offset % f->size) == 0) { + f->indexes == 0 && (f->offset % f->size) == 0) + { s = align_bin_compare_funcs[n]; - } else { + } + else + { s = bin_compare_funcs[n]; } break; @@ -2526,236 +2961,276 @@ cb_build_optim_cond (struct cb_binary_op *p) #else s = bin_compare_funcs[n]; #endif - if (s) { - return cb_build_method_call_2 (s, - cb_build_cast_address (p->x), - cb_build_cast_integer (p->y)); + if (s) + { + return cb_build_method_call_2(s, + cb_build_cast_address(p->x), + cb_build_cast_integer(p->y)); } } } - return cb_build_method_call_2 ("cmpInt", p->x, cb_build_cast_integer (p->y)); + return cb_build_method_call_2("cmpInt", p->x, cb_build_cast_integer(p->y)); } static int -cb_chk_num_cond (cb_tree x, cb_tree y) +cb_chk_num_cond(cb_tree x, cb_tree y) { - struct cb_field *fx; - struct cb_field *fy; + struct cb_field *fx; + struct cb_field *fy; - if (!CB_REFERENCE_P (x) && !CB_FIELD_P (x)) { + if (!CB_REFERENCE_P(x) && !CB_FIELD_P(x)) + { return 0; } - if (!CB_REFERENCE_P (y) && !CB_FIELD_P (y)) { + if (!CB_REFERENCE_P(y) && !CB_FIELD_P(y)) + { return 0; } - if (CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC) { + if (CB_TREE_CATEGORY(x) != CB_CATEGORY_NUMERIC) + { return 0; } - if (CB_TREE_CATEGORY (y) != CB_CATEGORY_NUMERIC) { + if (CB_TREE_CATEGORY(y) != CB_CATEGORY_NUMERIC) + { return 0; } - if (CB_TREE_CLASS (x) != CB_CLASS_NUMERIC) { + if (CB_TREE_CLASS(x) != CB_CLASS_NUMERIC) + { return 0; } - if (CB_TREE_CLASS (y) != CB_CLASS_NUMERIC) { + if (CB_TREE_CLASS(y) != CB_CLASS_NUMERIC) + { return 0; } - fx = cb_field (x); - fy = cb_field (y); - if (fx->usage != CB_USAGE_DISPLAY) { + fx = cb_field(x); + fy = cb_field(y); + if (fx->usage != CB_USAGE_DISPLAY) + { return 0; } - if (fy->usage != CB_USAGE_DISPLAY) { + if (fy->usage != CB_USAGE_DISPLAY) + { return 0; } - if (fx->pic->have_sign || fy->pic->have_sign) { + if (fx->pic->have_sign || fy->pic->have_sign) + { return 0; } - if (fx->size != fy->size) { + if (fx->size != fy->size) + { return 0; } - if (fx->pic->scale != fy->pic->scale) { + if (fx->pic->scale != fy->pic->scale) + { return 0; } return 1; } static int -cb_chk_alpha_cond (cb_tree x) +cb_chk_alpha_cond(cb_tree x) { - if (current_program->alphabet_name_list) { + if (current_program->alphabet_name_list) + { return 0; } - if (CB_LITERAL_P (x)) { + if (CB_LITERAL_P(x)) + { return 1; } - if (!CB_REFERENCE_P (x) && !CB_FIELD_P (x)) { + if (!CB_REFERENCE_P(x) && !CB_FIELD_P(x)) + { return 0; } - if (CB_TREE_CATEGORY (x) != CB_CATEGORY_ALPHANUMERIC && - CB_TREE_CATEGORY (x) != CB_CATEGORY_ALPHABETIC) { + if (CB_TREE_CATEGORY(x) != CB_CATEGORY_ALPHANUMERIC && + CB_TREE_CATEGORY(x) != CB_CATEGORY_ALPHABETIC) + { return 0; } - if (cb_field_variable_size (cb_field (x))) { + if (cb_field_variable_size(cb_field(x))) + { return 0; } - if (cb_field_size (x) < 0) { + if (cb_field_size(x) < 0) + { return 0; } return 1; } static int -national_kanji_comparison (cb_tree x, cb_tree y) -{ - if (((CB_LITERAL_P (x) && - (CB_TREE_CATEGORY (x) == CB_CATEGORY_NATIONAL)) || - ((CB_REF_OR_FIELD_P (x)) && - (CB_TREE_CATEGORY (x) == CB_CATEGORY_NATIONAL || - CB_TREE_CATEGORY (x) == CB_CATEGORY_NATIONAL_EDITED))) && - ((CB_TREE_CATEGORY (y) == CB_CATEGORY_ALPHABETIC || - CB_TREE_CATEGORY (y) == CB_CATEGORY_NUMERIC) && - y != cb_zero && - y != cb_space)) { +national_kanji_comparison(cb_tree x, cb_tree y) +{ + if (((CB_LITERAL_P(x) && + (CB_TREE_CATEGORY(x) == CB_CATEGORY_NATIONAL)) || + ((CB_REF_OR_FIELD_P(x)) && + (CB_TREE_CATEGORY(x) == CB_CATEGORY_NATIONAL || + CB_TREE_CATEGORY(x) == CB_CATEGORY_NATIONAL_EDITED))) && + ((CB_TREE_CATEGORY(y) == CB_CATEGORY_ALPHABETIC || + CB_TREE_CATEGORY(y) == CB_CATEGORY_NUMERIC) && + y != cb_zero && + y != cb_space)) + { return 1; - } else { + } + else + { return 0; } } cb_tree -cb_build_cond (cb_tree x) +cb_build_cond(cb_tree x) { - int size1; - int size2; - struct cb_field *f; - struct cb_binary_op *p; - cb_tree d1; - cb_tree d2; - cb_tree err = NULL; + int size1; + int size2; + struct cb_field *f; + struct cb_binary_op *p; + cb_tree d1; + cb_tree d2; + cb_tree err = NULL; - switch (CB_TREE_TAG (x)) { + switch (CB_TREE_TAG(x)) + { case CB_TAG_CONST: case CB_TAG_FUNCALL: return x; case CB_TAG_REFERENCE: - if (!CB_FIELD_P (cb_ref (x))) { - return cb_build_cond (cb_ref (x)); + if (!CB_FIELD_P(cb_ref(x))) + { + return cb_build_cond(cb_ref(x)); } - f = cb_field (x); + f = cb_field(x); /* level 88 condition */ - if (f->level == 88) { + if (f->level == 88) + { /* We need to build a 88 condition at every occurrence instead of once at the beginning because a 88 item may be subscripted (i.e., it is not a constant tree). */ - return cb_build_cond (build_cond_88 (x)); + return cb_build_cond(build_cond_88(x)); } - cb_error_x (x, _("Invalid expression")); + cb_error_x(x, _("Invalid expression")); return cb_error_node; case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); - switch (p->op) { + p = CB_BINARY_OP(x); + switch (p->op) + { case '!': - return cb_build_negation (cb_build_cond (p->x)); + return cb_build_negation(cb_build_cond(p->x)); case '&': case '|': - return cb_build_binary_op (cb_build_cond (p->x), p->op, cb_build_cond (p->y)); + return cb_build_binary_op(cb_build_cond(p->x), p->op, cb_build_cond(p->y)); default: - if (CB_INDEX_P (p->x) || CB_INDEX_P (p->y) - || CB_TREE_CLASS (p->x) == CB_CLASS_POINTER - || CB_TREE_CLASS (p->y) == CB_CLASS_POINTER) { - x = cb_build_binary_op (p->x, '-', p->y); - } else if (CB_BINARY_OP_P (p->x) || CB_BINARY_OP_P (p->y)) { + if (CB_INDEX_P(p->x) || CB_INDEX_P(p->y) || CB_TREE_CLASS(p->x) == CB_CLASS_POINTER || CB_TREE_CLASS(p->y) == CB_CLASS_POINTER) + { + x = cb_build_binary_op(p->x, '-', p->y); + } + else if (CB_BINARY_OP_P(p->x) || CB_BINARY_OP_P(p->y)) + { /* decimal comparison */ - d1 = decimal_alloc (); - d2 = decimal_alloc (); + d1 = decimal_alloc(); + d2 = decimal_alloc(); - if (decimal_expand (d1, p->x)) { + if (decimal_expand(d1, p->x)) + { err = p->x; - } else if (decimal_expand (d2, p->y)) { + } + else if (decimal_expand(d2, p->y)) + { err = p->y; } - if (err) { - decimal_free (); - decimal_free (); + if (err) + { + decimal_free(); + decimal_free(); decimal_stack = NULL; - cb_error_x (err, _("Invalid expression")); + cb_error_x(err, _("Invalid expression")); return cb_error_node; } - dpush (cb_build_method_call_2 ("compareTo", d1, d2)); - decimal_free (); - decimal_free (); - x = cb_list_reverse (decimal_stack); + dpush(cb_build_method_call_2("compareTo", d1, d2)); + decimal_free(); + decimal_free(); + x = cb_list_reverse(decimal_stack); decimal_stack = NULL; - } else { + } + else + { /* field comparison */ - if (national_kanji_comparison (p->x, p->y) || - national_kanji_comparison (p->y, p->x)) { - cb_error_x (x, _("Invalid expression test")); + if (national_kanji_comparison(p->x, p->y) || + national_kanji_comparison(p->y, p->x)) + { + cb_error_x(x, _("Invalid expression test")); } - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) { + if (CB_EXCEPTION_ENABLE(COB_EC_BOUND_SUBSCRIPT)) + { /* optim'ed funcs below don't check subscript boundary */ - x = cb_build_method_call_2 ("compareTo", p->x, p->y); + x = cb_build_method_call_2("compareTo", p->x, p->y); break; } - if (cb_chk_num_cond (p->x, p->y)) { - size1 = cb_field_size (p->x); - x = cb_build_method_call_3 ("memcmp", - cb_build_cast_address (p->x), - cb_build_cast_address (p->y), - cb_int (size1)); + if (cb_chk_num_cond(p->x, p->y)) + { + size1 = cb_field_size(p->x); + x = cb_build_method_call_3("memcmp", + cb_build_cast_address(p->x), + cb_build_cast_address(p->y), + cb_int(size1)); break; } - if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC - && CB_TREE_CLASS (p->y) == CB_CLASS_NUMERIC - && cb_fits_int (p->y)) { - x = cb_build_optim_cond (p); + if (CB_TREE_CLASS(p->x) == CB_CLASS_NUMERIC && CB_TREE_CLASS(p->y) == CB_CLASS_NUMERIC && cb_fits_int(p->y)) + { + x = cb_build_optim_cond(p); break; } - if ((CB_REF_OR_FIELD_P (p->x)) - && (CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHANUMERIC || - CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHABETIC) - && (cb_field_size (p->x) == 1) - && (!current_program->alphabet_name_list) - && (p->y == cb_space || p->y == cb_low || - p->y == cb_high || p->y == cb_zero)) { - x = cb_build_funcall_2 ("$G", p->x, p->y); + if ((CB_REF_OR_FIELD_P(p->x)) && (CB_TREE_CATEGORY(p->x) == CB_CATEGORY_ALPHANUMERIC || CB_TREE_CATEGORY(p->x) == CB_CATEGORY_ALPHABETIC) && (cb_field_size(p->x) == 1) && (!current_program->alphabet_name_list) && (p->y == cb_space || p->y == cb_low || p->y == cb_high || p->y == cb_zero)) + { + x = cb_build_funcall_2("$G", p->x, p->y); break; } - if (cb_chk_alpha_cond (p->x) && cb_chk_alpha_cond (p->y)) { - size1 = cb_field_size (p->x); - size2 = cb_field_size (p->y); - } else { + if (cb_chk_alpha_cond(p->x) && cb_chk_alpha_cond(p->y)) + { + size1 = cb_field_size(p->x); + size2 = cb_field_size(p->y); + } + else + { size1 = 0; size2 = 0; } - if (size1 == 1 && size2 == 1) { - x = cb_build_funcall_2 ("$G", p->x, p->y); - } else if (size1 != 0 && size1 == size2) { - x = cb_build_method_call_3 ("memcmp", - cb_build_cast_address (p->x), - cb_build_cast_address (p->y), - cb_int (size1)); - } else { - if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC && p->y == cb_zero) { - x = cb_build_optim_cond (p); - } else { - x = cb_build_method_call_2 ("compareTo", p->x, p->y); + if (size1 == 1 && size2 == 1) + { + x = cb_build_funcall_2("$G", p->x, p->y); + } + else if (size1 != 0 && size1 == size2) + { + x = cb_build_method_call_3("memcmp", + cb_build_cast_address(p->x), + cb_build_cast_address(p->y), + cb_int(size1)); + } + else + { + if (CB_TREE_CLASS(p->x) == CB_CLASS_NUMERIC && p->y == cb_zero) + { + x = cb_build_optim_cond(p); + } + else + { + x = cb_build_method_call_2("compareTo", p->x, p->y); } } } } - return cb_build_binary_op (x, p->op, p->y); + return cb_build_binary_op(x, p->op, p->y); default: break; } - cb_error_x (x, _("Invalid expression")); - return cb_error_node; + cb_error_x(x, _("Invalid expression")); + return cb_error_node; } /* @@ -2763,32 +3238,38 @@ cb_build_cond (cb_tree x) */ static cb_tree -cb_build_optim_add (cb_tree v, cb_tree n) +cb_build_optim_add(cb_tree v, cb_tree n) { - size_t z; - const char *s; - struct cb_field *f; + size_t z; + const char *s; + struct cb_field *f; - if (CB_REF_OR_FIELD_P (v)) { - f = cb_field (v); + if (CB_REF_OR_FIELD_P(v)) + { + f = cb_field(v); if (!f->pic->scale && (f->usage == CB_USAGE_BINARY || - f->usage == CB_USAGE_COMP_5 || - f->usage == CB_USAGE_COMP_X)) { + f->usage == CB_USAGE_COMP_5 || + f->usage == CB_USAGE_COMP_X)) + { z = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0)) + (16 * (f->flag_binary_swap ? 1 : 0)); -#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) - switch (f->size) { +#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) + switch (f->size) + { case 2: -#ifdef COB_SHORT_BORK +#ifdef COB_SHORT_BORK s = bin_add_funcs[z]; break; #endif case 4: case 8: if (f->storage != CB_STORAGE_LINKAGE && - f->indexes == 0 && (f->offset % f->size) == 0) { + f->indexes == 0 && (f->offset % f->size) == 0) + { s = align_bin_add_funcs[z]; - } else { + } + else + { s = bin_add_funcs[z]; } break; @@ -2797,59 +3278,69 @@ cb_build_optim_add (cb_tree v, cb_tree n) break; } #else - if (f->usage == CB_USAGE_COMP_5) { - switch (f->size) { + if (f->usage == CB_USAGE_COMP_5) + { + switch (f->size) + { case 1: case 2: case 4: case 8: - return cb_build_assign (v, cb_build_binary_op (v, '+', n)); + return cb_build_assign(v, cb_build_binary_op(v, '+', n)); } } s = bin_add_funcs[z]; #endif - if (s) { - return cb_build_method_call_2 (s, - cb_build_cast_address (v), - cb_build_cast_integer (n)); + if (s) + { + return cb_build_method_call_2(s, + cb_build_cast_address(v), + cb_build_cast_integer(n)); } - } else if (!f->pic->scale && f->usage == CB_USAGE_PACKED && - f->pic->digits < 10) { - return cb_build_method_call_2 ("addPackedInt", - v, cb_build_cast_integer (n)); } - + else if (!f->pic->scale && f->usage == CB_USAGE_PACKED && + f->pic->digits < 10) + { + return cb_build_method_call_2("addPackedInt", + v, cb_build_cast_integer(n)); + } } - return cb_build_method_call_2 ("addInt", v, cb_build_cast_integer (n)); + return cb_build_method_call_2("addInt", v, cb_build_cast_integer(n)); } static cb_tree -cb_build_optim_sub (cb_tree v, cb_tree n) +cb_build_optim_sub(cb_tree v, cb_tree n) { - size_t z; - const char *s; - struct cb_field *f; + size_t z; + const char *s; + struct cb_field *f; - if (CB_REF_OR_FIELD_P (v)) { - f = cb_field (v); + if (CB_REF_OR_FIELD_P(v)) + { + f = cb_field(v); if (!f->pic->scale && (f->usage == CB_USAGE_BINARY || - f->usage == CB_USAGE_COMP_5 || - f->usage == CB_USAGE_COMP_X)) { + f->usage == CB_USAGE_COMP_5 || + f->usage == CB_USAGE_COMP_X)) + { z = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0)) + (16 * (f->flag_binary_swap ? 1 : 0)); -#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) - switch (f->size) { +#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) + switch (f->size) + { case 2: -#ifdef COB_SHORT_BORK +#ifdef COB_SHORT_BORK s = bin_sub_funcs[z]; break; #endif case 4: case 8: if (f->storage != CB_STORAGE_LINKAGE && - f->indexes == 0 && (f->offset % f->size) == 0) { + f->indexes == 0 && (f->offset % f->size) == 0) + { s = align_bin_sub_funcs[z]; - } else { + } + else + { s = bin_sub_funcs[z]; } break; @@ -2858,124 +3349,150 @@ cb_build_optim_sub (cb_tree v, cb_tree n) break; } #else - if (f->usage == CB_USAGE_COMP_5) { - switch (f->size) { + if (f->usage == CB_USAGE_COMP_5) + { + switch (f->size) + { case 1: case 2: case 4: case 8: - return cb_build_assign (v, cb_build_binary_op (v, '-', n)); + return cb_build_assign(v, cb_build_binary_op(v, '-', n)); } } s = bin_sub_funcs[z]; #endif - if (s) { - return cb_build_method_call_2 (s, - cb_build_cast_address (v), - cb_build_cast_integer (n)); + if (s) + { + return cb_build_method_call_2(s, + cb_build_cast_address(v), + cb_build_cast_integer(n)); } } - } - return cb_build_funcall_2 ("cob_sub_int", v, cb_build_cast_integer (n)); + return cb_build_funcall_2("cob_sub_int", v, cb_build_cast_integer(n)); } cb_tree -cb_build_add (cb_tree v, cb_tree n, cb_tree round_opt) +cb_build_add(cb_tree v, cb_tree n, cb_tree round_opt) { - cb_tree opt; - struct cb_field *f; + cb_tree opt; + struct cb_field *f; -#ifdef COB_NON_ALIGNED - if (CB_INDEX_P (v)) { - return cb_build_move (cb_build_binary_op (v, '+', n), v); +#ifdef COB_NON_ALIGNED + if (CB_INDEX_P(v)) + { + return cb_build_move(cb_build_binary_op(v, '+', n), v); } - if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) { + if (CB_TREE_CLASS(v) == CB_CLASS_POINTER) + { current_program->gen_ptrmanip = 1; - return cb_build_funcall_3 ("cob_pointer_manip", v, n, cb_int0); + return cb_build_funcall_3("cob_pointer_manip", v, n, cb_int0); } #else - if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) { - return cb_build_move (cb_build_binary_op (v, '+', n), v); + if (CB_INDEX_P(v) || CB_TREE_CLASS(v) == CB_CLASS_POINTER) + { + return cb_build_move(cb_build_binary_op(v, '+', n), v); } #endif - if (CB_REF_OR_FIELD_P (v)) { - f = cb_field (v); + if (CB_REF_OR_FIELD_P(v)) + { + f = cb_field(v); f->count++; } - if (CB_REF_OR_FIELD_P (n)) { - f = cb_field (n); + if (CB_REF_OR_FIELD_P(n)) + { + f = cb_field(n); f->count++; } - if (round_opt == cb_high) { - if (cb_fits_int (n)) { - return cb_build_optim_add (v, n); - } else { - return cb_build_method_call_3 ("add", v, n, cb_int0); + if (round_opt == cb_high) + { + if (cb_fits_int(n)) + { + return cb_build_optim_add(v, n); + } + else + { + return cb_build_method_call_3("add", v, n, cb_int0); } } - opt = build_store_option (v, round_opt); - if (opt == cb_int0 && cb_fits_int (n)) { - return cb_build_optim_add (v, n); + opt = build_store_option(v, round_opt); + if (opt == cb_int0 && cb_fits_int(n)) + { + return cb_build_optim_add(v, n); } - return cb_build_method_call_3 ("add", v, n, opt); + return cb_build_method_call_3("add", v, n, opt); } cb_tree -cb_build_sub (cb_tree v, cb_tree n, cb_tree round_opt) +cb_build_sub(cb_tree v, cb_tree n, cb_tree round_opt) { - cb_tree opt; - struct cb_field *f; + cb_tree opt; + struct cb_field *f; -#ifdef COB_NON_ALIGNED - if (CB_INDEX_P (v)) { - return cb_build_move (cb_build_binary_op (v, '-', n), v); +#ifdef COB_NON_ALIGNED + if (CB_INDEX_P(v)) + { + return cb_build_move(cb_build_binary_op(v, '-', n), v); } - if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) { + if (CB_TREE_CLASS(v) == CB_CLASS_POINTER) + { current_program->gen_ptrmanip = 1; - return cb_build_funcall_3 ("cob_pointer_manip", v, n, cb_int1); + return cb_build_funcall_3("cob_pointer_manip", v, n, cb_int1); } #else - if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) { - return cb_build_move (cb_build_binary_op (v, '-', n), v); + if (CB_INDEX_P(v) || CB_TREE_CLASS(v) == CB_CLASS_POINTER) + { + return cb_build_move(cb_build_binary_op(v, '-', n), v); } #endif - if (CB_REF_OR_FIELD_P (v)) { - f = cb_field (v); + if (CB_REF_OR_FIELD_P(v)) + { + f = cb_field(v); f->count++; } - if (CB_REF_OR_FIELD_P (n)) { - f = cb_field (n); + if (CB_REF_OR_FIELD_P(n)) + { + f = cb_field(n); f->count++; } - opt = build_store_option (v, round_opt); - if (opt == cb_int0 && cb_fits_int (n)) { - return cb_build_optim_sub (v, n); + opt = build_store_option(v, round_opt); + if (opt == cb_int0 && cb_fits_int(n)) + { + return cb_build_optim_sub(v, n); } - return cb_build_method_call_3 ("sub", v, n, opt); + return cb_build_method_call_3("sub", v, n, opt); } static void -emit_corresponding (cb_tree (*func) (cb_tree f1, cb_tree f2, cb_tree f3), - cb_tree x1, cb_tree x2, cb_tree opt) +emit_corresponding(cb_tree (*func)(cb_tree f1, cb_tree f2, cb_tree f3), + cb_tree x1, cb_tree x2, cb_tree opt) { struct cb_field *f1, *f2; - cb_tree t1; - cb_tree t2; - - for (f1 = cb_field (x1)->children; f1; f1 = f1->sister) { - if (!f1->redefines && !f1->flag_occurs) { - for (f2 = cb_field (x2)->children; f2; f2 = f2->sister) { - if (!f2->redefines && !f2->flag_occurs) { - if (strcmp (f1->name, f2->name) == 0) { - t1 = cb_build_field_reference (f1, x1); - t2 = cb_build_field_reference (f2, x2); - if (f1->children && f2->children) { - emit_corresponding (func, t1, t2, opt); - } else { - cb_emit (func (t1, t2, opt)); + cb_tree t1; + cb_tree t2; + + for (f1 = cb_field(x1)->children; f1; f1 = f1->sister) + { + if (!f1->redefines && !f1->flag_occurs) + { + for (f2 = cb_field(x2)->children; f2; f2 = f2->sister) + { + if (!f2->redefines && !f2->flag_occurs) + { + if (strcmp(f1->name, f2->name) == 0) + { + t1 = cb_build_field_reference(f1, x1); + t2 = cb_build_field_reference(f2, x2); + if (f1->children && f2->children) + { + emit_corresponding(func, t1, t2, opt); + } + else + { + cb_emit(func(t1, t2, opt)); } } } @@ -2984,41 +3501,50 @@ emit_corresponding (cb_tree (*func) (cb_tree f1, cb_tree f2, cb_tree f3), } } -void -cb_emit_corresponding (cb_tree (*func) (cb_tree f1, cb_tree f2, cb_tree f3), - cb_tree x1, cb_tree x2, cb_tree opt) +void cb_emit_corresponding(cb_tree (*func)(cb_tree f1, cb_tree f2, cb_tree f3), + cb_tree x1, cb_tree x2, cb_tree opt) { - x1 = cb_check_group_name (x1); - x2 = cb_check_group_name (x2); + x1 = cb_check_group_name(x1); + x2 = cb_check_group_name(x2); - if (cb_validate_one (x1)) { + if (cb_validate_one(x1)) + { return; } - if (cb_validate_one (x2)) { + if (cb_validate_one(x2)) + { return; } - emit_corresponding (func, x1, x2, opt); + emit_corresponding(func, x1, x2, opt); } static void -emit_move_corresponding (cb_tree x1, cb_tree x2) +emit_move_corresponding(cb_tree x1, cb_tree x2) { struct cb_field *f1, *f2; - cb_tree t1; - cb_tree t2; - - for (f1 = cb_field (x1)->children; f1; f1 = f1->sister) { - if (!f1->redefines && !f1->flag_occurs) { - for (f2 = cb_field (x2)->children; f2; f2 = f2->sister) { - if (!f2->redefines && !f2->flag_occurs) { - if (strcmp (f1->name, f2->name) == 0) { - t1 = cb_build_field_reference (f1, x1); - t2 = cb_build_field_reference (f2, x2); - if (f1->children && f2->children) { - emit_move_corresponding (t1, t2); - } else { - cb_emit (cb_build_move (t1, t2)); + cb_tree t1; + cb_tree t2; + + for (f1 = cb_field(x1)->children; f1; f1 = f1->sister) + { + if (!f1->redefines && !f1->flag_occurs) + { + for (f2 = cb_field(x2)->children; f2; f2 = f2->sister) + { + if (!f2->redefines && !f2->flag_occurs) + { + if (strcmp(f1->name, f2->name) == 0) + { + t1 = cb_build_field_reference(f1, x1); + t2 = cb_build_field_reference(f2, x2); + if (f1->children && f2->children) + { + emit_move_corresponding(t1, t2); + } + else + { + cb_emit(cb_build_move(t1, t2)); } } } @@ -3027,63 +3553,71 @@ emit_move_corresponding (cb_tree x1, cb_tree x2) } } -void -cb_emit_move_corresponding (cb_tree x1, cb_tree x2) +void cb_emit_move_corresponding(cb_tree x1, cb_tree x2) { - cb_tree l; - cb_tree v; + cb_tree l; + cb_tree v; - x1 = cb_check_group_name (x1); - if (cb_validate_one (x1)) { + x1 = cb_check_group_name(x1); + if (cb_validate_one(x1)) + { return; } - for (l = x2; l; l = CB_CHAIN(l)) { + for (l = x2; l; l = CB_CHAIN(l)) + { v = CB_VALUE(l); - v = cb_check_group_name (v); - if (cb_validate_one (v)) { + v = cb_check_group_name(v); + if (cb_validate_one(v)) + { return; } - emit_move_corresponding (x1, v); + emit_move_corresponding(x1, v); } } static void -output_screen_from (struct cb_field *p, const size_t sisters) +output_screen_from(struct cb_field *p, const size_t sisters) { int type; - if (sisters && p->sister) { - output_screen_from (p->sister, 1); + if (sisters && p->sister) + { + output_screen_from(p->sister, 1); } - if (p->children) { - output_screen_from (p->children, 1); + if (p->children) + { + output_screen_from(p->children, 1); } - type = (p->children ? COB_SCREEN_TYPE_GROUP : - p->values ? COB_SCREEN_TYPE_VALUE : - (p->size > 0) ? COB_SCREEN_TYPE_FIELD : COB_SCREEN_TYPE_ATTRIBUTE); - if (type == COB_SCREEN_TYPE_FIELD && p->screen_from) { - cb_emit (cb_build_method_call_2 ("moveFrom", p->screen_from, CB_TREE (p))); + type = (p->children ? COB_SCREEN_TYPE_GROUP : p->values ? COB_SCREEN_TYPE_VALUE + : (p->size > 0) ? COB_SCREEN_TYPE_FIELD + : COB_SCREEN_TYPE_ATTRIBUTE); + if (type == COB_SCREEN_TYPE_FIELD && p->screen_from) + { + cb_emit(cb_build_method_call_2("moveFrom", p->screen_from, CB_TREE(p))); } } static void -output_screen_to (struct cb_field *p, const size_t sisters) +output_screen_to(struct cb_field *p, const size_t sisters) { int type; - if (sisters && p->sister) { - output_screen_to (p->sister, 1); + if (sisters && p->sister) + { + output_screen_to(p->sister, 1); } - if (p->children) { - output_screen_to (p->children, 1); + if (p->children) + { + output_screen_to(p->children, 1); } - type = (p->children ? COB_SCREEN_TYPE_GROUP : - p->values ? COB_SCREEN_TYPE_VALUE : - (p->size > 0) ? COB_SCREEN_TYPE_FIELD : COB_SCREEN_TYPE_ATTRIBUTE); - if (type == COB_SCREEN_TYPE_FIELD && p->screen_to) { - cb_emit (cb_build_method_call_2 ("moveFrom", CB_TREE (p), p->screen_to)); + type = (p->children ? COB_SCREEN_TYPE_GROUP : p->values ? COB_SCREEN_TYPE_VALUE + : (p->size > 0) ? COB_SCREEN_TYPE_FIELD + : COB_SCREEN_TYPE_ATTRIBUTE); + if (type == COB_SCREEN_TYPE_FIELD && p->screen_to) + { + cb_emit(cb_build_method_call_2("moveFrom", CB_TREE(p), p->screen_to)); } } @@ -3091,266 +3625,307 @@ output_screen_to (struct cb_field *p, const size_t sisters) * ACCEPT statement */ -void -cb_emit_accept (cb_tree var, cb_tree pos, cb_tree fgc, cb_tree bgc, - cb_tree scroll, int dispattrs) +void cb_emit_accept(cb_tree var, cb_tree pos, cb_tree fgc, cb_tree bgc, + cb_tree scroll, int dispattrs) { - cb_tree line; - cb_tree column; + cb_tree line; + cb_tree column; - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - if (cb_validate_one (pos)) { + if (cb_validate_one(pos)) + { return; } - if (cb_validate_one (fgc)) { + if (cb_validate_one(fgc)) + { return; } - if (cb_validate_one (bgc)) { + if (cb_validate_one(bgc)) + { return; } - if (cb_validate_one (scroll)) { + if (cb_validate_one(scroll)) + { return; } - if (current_program->flag_screen) { + if (current_program->flag_screen) + { /* Bump ref count to force CRT STATUS field generation */ - if(current_program->crt_status != NULL) { - cb_field (current_program->crt_status)->count++; - } - if ((CB_REF_OR_FIELD_P (var)) && - CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) { - output_screen_from (CB_FIELD (cb_ref (var)), 0); + if (current_program->crt_status != NULL) + { + cb_field(current_program->crt_status)->count++; + } + if ((CB_REF_OR_FIELD_P(var)) && + CB_FIELD(cb_ref(var))->storage == CB_STORAGE_SCREEN) + { + output_screen_from(CB_FIELD(cb_ref(var)), 0); gen_screen_ptr = 1; - if (pos) { - if (CB_PAIR_P (pos)) { - line = CB_PAIR_X (pos); - column = CB_PAIR_Y (pos); - cb_emit (cb_build_funcall_3 ("cob_screen_accept", - var, line, column)); - } else { - cb_emit (cb_build_funcall_3 ("cob_screen_accept", - var, pos, NULL)); - } - } else { - cb_emit (cb_build_funcall_3 ("cob_screen_accept", - var, NULL, NULL)); + if (pos) + { + if (CB_PAIR_P(pos)) + { + line = CB_PAIR_X(pos); + column = CB_PAIR_Y(pos); + cb_emit(cb_build_funcall_3("cob_screen_accept", + var, line, column)); + } + else + { + cb_emit(cb_build_funcall_3("cob_screen_accept", + var, pos, NULL)); + } + } + else + { + cb_emit(cb_build_funcall_3("cob_screen_accept", + var, NULL, NULL)); } gen_screen_ptr = 0; - output_screen_to (CB_FIELD (cb_ref (var)), 0); - } else { - if (pos || fgc || bgc) { - if (!pos) { - cb_emit (cb_build_funcall_7 ("cob_field_accept", - var, NULL, NULL, fgc, bgc, - scroll, cb_int (dispattrs))); - } else if (CB_PAIR_P (pos)) { - line = CB_PAIR_X (pos); - column = CB_PAIR_Y (pos); - cb_emit (cb_build_funcall_7 ("cob_field_accept", - var, line, column, fgc, bgc, - scroll, cb_int (dispattrs))); - } else { - cb_emit (cb_build_funcall_7 ("cob_field_accept", - var, pos, NULL, fgc, bgc, - scroll, cb_int (dispattrs))); - } - } else { - cb_emit (cb_build_funcall_7 ("cob_field_accept", - var, NULL, NULL, fgc, bgc, - scroll, cb_int (dispattrs))); - } - } - } else if (pos || fgc || bgc || scroll) { + output_screen_to(CB_FIELD(cb_ref(var)), 0); + } + else + { + if (pos || fgc || bgc) + { + if (!pos) + { + cb_emit(cb_build_funcall_7("cob_field_accept", + var, NULL, NULL, fgc, bgc, + scroll, cb_int(dispattrs))); + } + else if (CB_PAIR_P(pos)) + { + line = CB_PAIR_X(pos); + column = CB_PAIR_Y(pos); + cb_emit(cb_build_funcall_7("cob_field_accept", + var, line, column, fgc, bgc, + scroll, cb_int(dispattrs))); + } + else + { + cb_emit(cb_build_funcall_7("cob_field_accept", + var, pos, NULL, fgc, bgc, + scroll, cb_int(dispattrs))); + } + } + else + { + cb_emit(cb_build_funcall_7("cob_field_accept", + var, NULL, NULL, fgc, bgc, + scroll, cb_int(dispattrs))); + } + } + } + else if (pos || fgc || bgc || scroll) + { /* Bump ref count to force CRT STATUS field generation */ - if(current_program->crt_status != NULL) { - cb_field (current_program->crt_status)->count++; - } - if (!pos) { - cb_emit (cb_build_funcall_7 ("cob_field_accept", - var, NULL, NULL, fgc, bgc, scroll, - cb_int (dispattrs))); - } else if (CB_PAIR_P (pos)) { - line = CB_PAIR_X (pos); - column = CB_PAIR_Y (pos); - cb_emit (cb_build_funcall_7 ("cob_field_accept", - var, line, column, fgc, bgc, scroll, - cb_int (dispattrs))); - } else { - cb_emit (cb_build_funcall_7 ("cob_field_accept", - var, pos, NULL, fgc, bgc, scroll, - cb_int (dispattrs))); + if (current_program->crt_status != NULL) + { + cb_field(current_program->crt_status)->count++; + } + if (!pos) + { + cb_emit(cb_build_funcall_7("cob_field_accept", + var, NULL, NULL, fgc, bgc, scroll, + cb_int(dispattrs))); } - } else { - cb_emit (cb_build_funcall_1 ("CobolTerminal.accept", var)); + else if (CB_PAIR_P(pos)) + { + line = CB_PAIR_X(pos); + column = CB_PAIR_Y(pos); + cb_emit(cb_build_funcall_7("cob_field_accept", + var, line, column, fgc, bgc, scroll, + cb_int(dispattrs))); + } + else + { + cb_emit(cb_build_funcall_7("cob_field_accept", + var, pos, NULL, fgc, bgc, scroll, + cb_int(dispattrs))); + } + } + else + { + cb_emit(cb_build_funcall_1("CobolTerminal.accept", var)); } } -void -cb_emit_accept_line_or_col (cb_tree var, const int l_or_c) +void cb_emit_accept_line_or_col(cb_tree var, const int l_or_c) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_2 ("cob_screen_line_col", var, cb_int (l_or_c))); + cb_emit(cb_build_funcall_2("cob_screen_line_col", var, cb_int(l_or_c))); } -void -cb_emit_accept_date (cb_tree var) +void cb_emit_accept_date(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptDate", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptDate", var)); } -void -cb_emit_accept_date_yyyymmdd (cb_tree var) +void cb_emit_accept_date_yyyymmdd(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptDate_yyyymmdd", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptDate_yyyymmdd", var)); } -void -cb_emit_accept_day (cb_tree var) +void cb_emit_accept_day(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptDay", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptDay", var)); } -void -cb_emit_accept_day_yyyyddd (cb_tree var) +void cb_emit_accept_day_yyyyddd(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptDay_yyyyddd", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptDay_yyyyddd", var)); } -void -cb_emit_accept_day_of_week (cb_tree var) +void cb_emit_accept_day_of_week(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptDayOfWeek", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptDayOfWeek", var)); } -void -cb_emit_accept_time (cb_tree var) +void cb_emit_accept_time(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptTime", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptTime", var)); } -void -cb_emit_accept_command_line (cb_tree var) +void cb_emit_accept_command_line(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptCommandLine", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptCommandLine", var)); } -void -cb_emit_get_environment (cb_tree envvar, cb_tree envval) +void cb_emit_get_environment(cb_tree envvar, cb_tree envval) { - if (cb_validate_one (envvar)) { + if (cb_validate_one(envvar)) + { return; } - if (cb_validate_one (envval)) { + if (cb_validate_one(envval)) + { return; } - cb_emit (cb_build_funcall_2 ("CobolUtil.getEnvironment", envvar, envval)); + cb_emit(cb_build_funcall_2("CobolUtil.getEnvironment", envvar, envval)); } -void -cb_emit_accept_environment (cb_tree var) +void cb_emit_accept_environment(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptEnvironment", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptEnvironment", var)); } -void -cb_emit_accept_arg_number (cb_tree var) +void cb_emit_accept_arg_number(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptArgNumber", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptArgNumber", var)); } -void -cb_emit_accept_arg_value (cb_tree var) +void cb_emit_accept_arg_value(cb_tree var) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.acceptArgValue", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.acceptArgValue", var)); } -void -cb_emit_accept_mnemonic (cb_tree var, cb_tree mnemonic) +void cb_emit_accept_mnemonic(cb_tree var, cb_tree mnemonic) { - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - if (CB_SYSTEM_NAME (cb_ref (mnemonic))->category == CB_DEVICE_NAME) { - switch (CB_SYSTEM_NAME (cb_ref (mnemonic))->token) { + if (CB_SYSTEM_NAME(cb_ref(mnemonic))->category == CB_DEVICE_NAME) + { + switch (CB_SYSTEM_NAME(cb_ref(mnemonic))->token) + { case CB_DEVICE_CONSOLE: case CB_DEVICE_SYSIN: - cb_emit (cb_build_funcall_1 ("CobolTerminal.accept", var)); + cb_emit(cb_build_funcall_1("CobolTerminal.accept", var)); break; default: - cb_error_x (mnemonic, _("Invalid input stream '%s'"), - cb_name (mnemonic)); + cb_error_x(mnemonic, _("Invalid input stream '%s'"), + cb_name(mnemonic)); break; } } - if (CB_SYSTEM_NAME (cb_ref (mnemonic))->category == CB_INTERFACE_NAME) { - switch (CB_SYSTEM_NAME (cb_ref (mnemonic))->token) { + if (CB_SYSTEM_NAME(cb_ref(mnemonic))->category == CB_INTERFACE_NAME) + { + switch (CB_SYSTEM_NAME(cb_ref(mnemonic))->token) + { case CB_ARGUMENT_NUMBER: - cb_emit_accept_arg_number (var); + cb_emit_accept_arg_number(var); break; case CB_ARGUMENT_VALUE: - cb_emit_accept_arg_value (var); + cb_emit_accept_arg_value(var); break; case CB_ENVIRONMENT_VALUE: - cb_emit_accept_environment (var); + cb_emit_accept_environment(var); break; default: - cb_error_x (mnemonic, _("Invalid interface name '%s'"), - cb_name (mnemonic)); + cb_error_x(mnemonic, _("Invalid interface name '%s'"), + cb_name(mnemonic)); break; } } } -void -cb_emit_accept_name (cb_tree var, cb_tree name) +void cb_emit_accept_name(cb_tree var, cb_tree name) { cb_tree sys; - if (cb_validate_one (var)) { + if (cb_validate_one(var)) + { return; } - if (CB_REFERENCE (name)->word->count == 0) { - sys = lookup_system_name (CB_NAME (name)); + if (CB_REFERENCE(name)->word->count == 0) + { + sys = lookup_system_name(CB_NAME(name)); - if (sys != cb_error_node) { - switch (CB_SYSTEM_NAME (sys)->token) { + if (sys != cb_error_node) + { + switch (CB_SYSTEM_NAME(sys)->token) + { case CB_DEVICE_CONSOLE: case CB_DEVICE_SYSIN: - cb_warning_x (name, _("'%s' undefined in SPECIAL-NAMES"), CB_NAME (name)); - cb_emit (cb_build_funcall_1 ("CobolTerminal.accept", var)); + cb_warning_x(name, _("'%s' undefined in SPECIAL-NAMES"), CB_NAME(name)); + cb_emit(cb_build_funcall_1("CobolTerminal.accept", var)); return; default: break; @@ -3358,121 +3933,145 @@ cb_emit_accept_name (cb_tree var, cb_tree name) } } - cb_error_x (name, _("'%s' undefined in SPECIAL-NAMES"), CB_NAME (name)); + cb_error_x(name, _("'%s' undefined in SPECIAL-NAMES"), CB_NAME(name)); } /* * ALLOCATE statement */ -void -cb_emit_allocate (cb_tree target1, cb_tree target2, cb_tree size, cb_tree initialize) +void cb_emit_allocate(cb_tree target1, cb_tree target2, cb_tree size, cb_tree initialize) { - cb_tree x; - char buff[32]; + cb_tree x; + char buff[32]; - if (cb_validate_one (target1)) { + if (cb_validate_one(target1)) + { return; } - if (cb_validate_one (target2)) { + if (cb_validate_one(target2)) + { return; } - if (cb_validate_one (size)) { + if (cb_validate_one(size)) + { return; } - if (target1) { + if (target1) + { if (!(CB_REFERENCE_P(target1) && - cb_field (target1)->flag_item_based)) { - cb_error_x (CB_TREE(current_statement), - _("Target of ALLOCATE is not a BASED item")); + cb_field(target1)->flag_item_based)) + { + cb_error_x(CB_TREE(current_statement), + _("Target of ALLOCATE is not a BASED item")); } } - if (target2) { + if (target2) + { if (!(CB_REFERENCE_P(target2) && - CB_TREE_CLASS (target2) == CB_CLASS_POINTER)) { - cb_error_x (CB_TREE(current_statement), - _("Target of RETURNING is not a data pointer")); - } - } - if (size) { - if (CB_TREE_CLASS (size) != CB_CLASS_NUMERIC) { - cb_error_x (CB_TREE(current_statement), - _("The CHARACTERS field of ALLOCATE must be numeric")); - } - } - if (target1) { - sprintf (buff, "%d", cb_field (target1)->memory_size); - x = cb_build_numeric_literal (0, (ucharptr)buff, 0); - cb_emit (cb_build_funcall_3 ("cob_allocate", - cb_build_cast_addr_of_addr (target1), target2, x)); - } else { - cb_emit (cb_build_funcall_3 ("cob_allocate", - NULL, target2, size)); - } - if (initialize && target1) { + CB_TREE_CLASS(target2) == CB_CLASS_POINTER)) + { + cb_error_x(CB_TREE(current_statement), + _("Target of RETURNING is not a data pointer")); + } + } + if (size) + { + if (CB_TREE_CLASS(size) != CB_CLASS_NUMERIC) + { + cb_error_x(CB_TREE(current_statement), + _("The CHARACTERS field of ALLOCATE must be numeric")); + } + } + if (target1) + { + sprintf(buff, "%d", cb_field(target1)->memory_size); + x = cb_build_numeric_literal(0, (ucharptr)buff, 0); + cb_emit(cb_build_funcall_3("cob_allocate", + cb_build_cast_addr_of_addr(target1), target2, x)); + } + else + { + cb_emit(cb_build_funcall_3("cob_allocate", + NULL, target2, size)); + } + if (initialize && target1) + { current_statement->handler2 = - cb_build_initialize (target1, cb_true, NULL, cb_true, 0); + cb_build_initialize(target1, cb_true, NULL, cb_true, 0); } } - /* * CALL statement */ -void -cb_emit_call (cb_tree prog, cb_tree cb_using, cb_tree returning, - cb_tree on_exception, cb_tree not_on_exception) +void cb_emit_call(cb_tree prog, cb_tree cb_using, cb_tree returning, + cb_tree on_exception, cb_tree not_on_exception) { - cb_tree l; - cb_tree x; - const struct system_table *psyst; - int is_sys_call = 0; - - if (CB_INTRINSIC_P (prog)) { - if (CB_INTRINSIC(prog)->intr_tab->category != CB_CATEGORY_ALPHANUMERIC) { - cb_error (_("Only alphanumeric FUNCTION types are allowed here")); + cb_tree l; + cb_tree x; + const struct system_table *psyst; + int is_sys_call = 0; + + if (CB_INTRINSIC_P(prog)) + { + if (CB_INTRINSIC(prog)->intr_tab->category != CB_CATEGORY_ALPHANUMERIC) + { + cb_error(_("Only alphanumeric FUNCTION types are allowed here")); return; } } - if (returning) { + if (returning) + { if (CB_TREE_CLASS(returning) != CB_CLASS_NUMERIC && - CB_TREE_CLASS(returning) != CB_CLASS_POINTER) { - cb_error (_("Invalid RETURNING field")); + CB_TREE_CLASS(returning) != CB_CLASS_POINTER) + { + cb_error(_("Invalid RETURNING field")); return; } } - for (l = cb_using; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (x == cb_error_node) { + for (l = cb_using; l; l = CB_CHAIN(l)) + { + x = CB_VALUE(l); + if (x == cb_error_node) + { continue; } - if (CB_CONST_P (x) && x != cb_null) { - cb_error_x (x, _("Figurative constant invalid here")); + if (CB_CONST_P(x) && x != cb_null) + { + cb_error_x(x, _("Figurative constant invalid here")); } - if ((CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) - || CB_FIELD_P (x)) { - if (cb_field (x)->level == 88) { - cb_error_x (x, _("'%s' Not a data name"), CB_NAME (x)); + if ((CB_REFERENCE_P(x) && CB_FIELD_P(CB_REFERENCE(x)->value)) || CB_FIELD_P(x)) + { + if (cb_field(x)->level == 88) + { + cb_error_x(x, _("'%s' Not a data name"), CB_NAME(x)); return; } if (cb_warn_call_params && - CB_PURPOSE_INT (l) == CB_CALL_BY_REFERENCE) { - if (cb_field (x)->level != 01 && - cb_field (x)->level != 77) { - cb_warning_x (x, _("'%s' is not 01 or 77 level item"), CB_NAME (x)); + CB_PURPOSE_INT(l) == CB_CALL_BY_REFERENCE) + { + if (cb_field(x)->level != 01 && + cb_field(x)->level != 77) + { + cb_warning_x(x, _("'%s' is not 01 or 77 level item"), CB_NAME(x)); } } } } - if (CB_LITERAL_P(prog)) { - for (psyst = (const struct system_table *)&system_tab[0]; psyst->syst_name; psyst++) { + if (CB_LITERAL_P(prog)) + { + for (psyst = (const struct system_table *)&system_tab[0]; psyst->syst_name; psyst++) + { if (!strcmp((const char *)CB_LITERAL(prog)->data, - (const char *)psyst->syst_name)) { - if (psyst->syst_params > cb_list_length (cb_using)) { - cb_error (_("Wrong number of CALL parameters for '%s'"), - (char *)psyst->syst_name); + (const char *)psyst->syst_name)) + { + if (psyst->syst_params > cb_list_length(cb_using)) + { + cb_error(_("Wrong number of CALL parameters for '%s'"), + (char *)psyst->syst_name); return; } is_sys_call = 1; @@ -3481,188 +4080,198 @@ cb_emit_call (cb_tree prog, cb_tree cb_using, cb_tree returning, } } - cb_emit (cb_build_call (prog, cb_using, on_exception, not_on_exception, - returning, is_sys_call)); + cb_emit(cb_build_call(prog, cb_using, on_exception, not_on_exception, + returning, is_sys_call)); } /* * CANCEL statement */ -void -cb_emit_cancel (cb_tree prog) +void cb_emit_cancel(cb_tree prog) { - if (cb_validate_one (prog)) { + if (cb_validate_one(prog)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolResolve.fieldCancel", prog)); + cb_emit(cb_build_funcall_1("CobolResolve.fieldCancel", prog)); } -void -cb_emit_cancel_all () +void cb_emit_cancel_all() { - cb_emit (cb_build_funcall_0 ("cob_cancel_all")); + cb_emit(cb_build_funcall_0("cob_cancel_all")); } /* * CLOSE statement */ -void -cb_emit_close (cb_tree file, cb_tree opt) +void cb_emit_close(cb_tree file, cb_tree opt) { - if (file == cb_error_node) { + if (file == cb_error_node) + { return; } - file = cb_ref (file); - if (file == cb_error_node) { + file = cb_ref(file); + if (file == cb_error_node) + { return; } current_statement->file = file; - if (CB_FILE (file)->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("Operation not allowed on SORT files")); + if (CB_FILE(file)->organization == COB_ORG_SORT) + { + cb_error_x(CB_TREE(current_statement), + _("Operation not allowed on SORT files")); } - cb_emit (cb_build_method_call_3 ("close", file, opt, - CB_FILE(file)->file_status)); + cb_emit(cb_build_method_call_3("close", file, opt, + CB_FILE(file)->file_status)); } /* * COMMIT statement */ -void -cb_emit_commit (void) +void cb_emit_commit(void) { - cb_emit (cb_build_funcall_0 ("CobolFile.commit")); + cb_emit(cb_build_funcall_0("CobolFile.commit")); } /* * CONTINUE statement */ -void -cb_emit_continue (void) +void cb_emit_continue(void) { - cb_emit (cb_build_continue ()); + cb_emit(cb_build_continue()); } /* * DELETE statement */ -void -cb_emit_delete (cb_tree file) +void cb_emit_delete(cb_tree file) { - if (file == cb_error_node) { + if (file == cb_error_node) + { return; } - file = cb_ref (file); - if (file == cb_error_node) { + file = cb_ref(file); + if (file == cb_error_node) + { return; } current_statement->file = file; - if (CB_FILE (file)->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("Operation not allowed on SORT files")); + if (CB_FILE(file)->organization == COB_ORG_SORT) + { + cb_error_x(CB_TREE(current_statement), + _("Operation not allowed on SORT files")); } - cb_emit (cb_build_method_call_2 ("delete", file, CB_FILE(file)->file_status)); + cb_emit(cb_build_method_call_2("delete", file, CB_FILE(file)->file_status)); } /* * DELETE FILE statement */ -void -cb_emit_delete_file (cb_tree file) +void cb_emit_delete_file(cb_tree file) { - if (file == cb_error_node) { + if (file == cb_error_node) + { return; } - file = cb_ref (file); - if (file == cb_error_node) { + file = cb_ref(file); + if (file == cb_error_node) + { return; } current_statement->file = file; - if (CB_FILE (file)->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("Operation not allowed on SORT files")); + if (CB_FILE(file)->organization == COB_ORG_SORT) + { + cb_error_x(CB_TREE(current_statement), + _("Operation not allowed on SORT files")); } - cb_emit (cb_build_funcall_2 ("cob_delete_file", file, CB_FILE (file)->file_status)); + cb_emit(cb_build_method_call_2("cob_delete_file", file, CB_FILE(file)->file_status)); } /* * DISPLAY statement */ -void -cb_emit_env_name (cb_tree value) +void cb_emit_env_name(cb_tree value) { - if (cb_validate_one (value)) { + if (cb_validate_one(value)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.displayEnvironment", value)); + cb_emit(cb_build_funcall_1("CobolTerminal.displayEnvironment", value)); } -void -cb_emit_env_value (cb_tree value) +void cb_emit_env_value(cb_tree value) { - if (cb_validate_one (value)) { + if (cb_validate_one(value)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.displayEnvValue", value)); + cb_emit(cb_build_funcall_1("CobolTerminal.displayEnvValue", value)); } -void -cb_emit_arg_number (cb_tree value) +void cb_emit_arg_number(cb_tree value) { - if (cb_validate_one (value)) { + if (cb_validate_one(value)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.displayArgNumber", value)); + cb_emit(cb_build_funcall_1("CobolTerminal.displayArgNumber", value)); } -void -cb_emit_command_line (cb_tree value) +void cb_emit_command_line(cb_tree value) { - if (cb_validate_one (value)) { + if (cb_validate_one(value)) + { return; } - cb_emit (cb_build_funcall_1 ("CobolTerminal.displayCommandLine", value)); + cb_emit(cb_build_funcall_1("CobolTerminal.displayCommandLine", value)); } -void -cb_emit_display (cb_tree values, cb_tree upon, cb_tree no_adv, cb_tree pos, - cb_tree fgc, cb_tree bgc, cb_tree scroll, int dispattrs) +void cb_emit_display(cb_tree values, cb_tree upon, cb_tree no_adv, cb_tree pos, + cb_tree fgc, cb_tree bgc, cb_tree scroll, int dispattrs) { - cb_tree l; - cb_tree x; - cb_tree line; - cb_tree column; - cb_tree p; + cb_tree l; + cb_tree x; + cb_tree line; + cb_tree column; + cb_tree p; - if (cb_validate_list (values)) { + if (cb_validate_list(values)) + { return; } - if (cb_validate_one (pos)) { + if (cb_validate_one(pos)) + { return; } - if (cb_validate_one (fgc)) { + if (cb_validate_one(fgc)) + { return; } - if (cb_validate_one (bgc)) { + if (cb_validate_one(bgc)) + { return; } - if (cb_validate_one (scroll)) { + if (cb_validate_one(scroll)) + { return; } - for (l = values; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (x == cb_error_node) { + for (l = values; l; l = CB_CHAIN(l)) + { + x = CB_VALUE(l); + if (x == cb_error_node) + { return; } - switch (CB_TREE_TAG (x)) { + switch (CB_TREE_TAG(x)) + { case CB_TAG_LITERAL: case CB_TAG_INTRINSIC: case CB_TAG_CONST: @@ -3670,148 +4279,181 @@ cb_emit_display (cb_tree values, cb_tree upon, cb_tree no_adv, cb_tree pos, case CB_TAG_INTEGER: break; case CB_TAG_REFERENCE: - if (!CB_FIELD_P(CB_REFERENCE(x)->value)) { - cb_error_x (x, _("'%s' is an invalid type for DISPLAY operand"), cb_name (x)); + if (!CB_FIELD_P(CB_REFERENCE(x)->value)) + { + cb_error_x(x, _("'%s' is an invalid type for DISPLAY operand"), cb_name(x)); return; } break; default: - cb_error_x (x, _("Invalid type for DISPLAY operand")); + cb_error_x(x, _("Invalid type for DISPLAY operand")); return; } } - if (upon == cb_error_node) { + if (upon == cb_error_node) + { return; } - - x = CB_VALUE (values); - if ((CB_REF_OR_FIELD_P (x)) && - CB_FIELD (cb_ref (x))->storage == CB_STORAGE_SCREEN) { - output_screen_from (CB_FIELD (cb_ref (x)), 0); + + x = CB_VALUE(values); + if ((CB_REF_OR_FIELD_P(x)) && + CB_FIELD(cb_ref(x))->storage == CB_STORAGE_SCREEN) + { + output_screen_from(CB_FIELD(cb_ref(x)), 0); gen_screen_ptr = 1; - if (pos) { - if (CB_PAIR_P (pos)) { - line = CB_PAIR_X (pos); - column = CB_PAIR_Y (pos); - if (line == NULL) { + if (pos) + { + if (CB_PAIR_P(pos)) + { + line = CB_PAIR_X(pos); + column = CB_PAIR_Y(pos); + if (line == NULL) + { line = cb_one; } - if (column == NULL) { + if (column == NULL) + { column = cb_one; } - cb_emit (cb_build_funcall_3 ("cob_screen_display", x, - line, column)); - } else { - cb_emit (cb_build_funcall_3 ("cob_screen_display", x, - pos, NULL)); + cb_emit(cb_build_funcall_3("cob_screen_display", x, + line, column)); + } + else + { + cb_emit(cb_build_funcall_3("cob_screen_display", x, + pos, NULL)); } - } else { - cb_emit (cb_build_funcall_3 ("cob_screen_display", x, - NULL, NULL)); + } + else + { + cb_emit(cb_build_funcall_3("cob_screen_display", x, + NULL, NULL)); } gen_screen_ptr = 0; - } else if (pos || fgc || bgc || scroll || dispattrs) { - if (!pos) { - cb_emit (cb_build_funcall_7 ("cob_field_display", - CB_VALUE (values), NULL, NULL, fgc, bgc, - scroll, cb_int (dispattrs))); - } else if (CB_PAIR_P (pos)) { - line = CB_PAIR_X (pos); - column = CB_PAIR_Y (pos); - if (line == NULL) { + } + else if (pos || fgc || bgc || scroll || dispattrs) + { + if (!pos) + { + cb_emit(cb_build_funcall_7("cob_field_display", + CB_VALUE(values), NULL, NULL, fgc, bgc, + scroll, cb_int(dispattrs))); + } + else if (CB_PAIR_P(pos)) + { + line = CB_PAIR_X(pos); + column = CB_PAIR_Y(pos); + if (line == NULL) + { line = cb_one; } - if (column == NULL) { + if (column == NULL) + { column = cb_one; } - cb_emit (cb_build_funcall_7 ("cob_field_display", - CB_VALUE (values), line, column, fgc, bgc, - scroll, cb_int (dispattrs))); - } else { - cb_emit (cb_build_funcall_7 ("cob_field_display", - CB_VALUE (values), pos, NULL, fgc, bgc, - scroll, cb_int (dispattrs))); + cb_emit(cb_build_funcall_7("cob_field_display", + CB_VALUE(values), line, column, fgc, bgc, + scroll, cb_int(dispattrs))); + } + else + { + cb_emit(cb_build_funcall_7("cob_field_display", + CB_VALUE(values), pos, NULL, fgc, bgc, + scroll, cb_int(dispattrs))); } - } else { + } + else + { /* DISPLAY x ... [UPON device-name] */ - p = cb_build_funcall_3 ("CobolTerminal.display", upon, no_adv, values); - CB_FUNCALL(p)->varcnt = cb_list_length (values); - cb_emit (p); - for (l = values; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (CB_FIELD_P (x)) { - CB_FIELD (cb_ref (x))->count++; + p = cb_build_funcall_3("CobolTerminal.display", upon, no_adv, values); + CB_FUNCALL(p)->varcnt = cb_list_length(values); + cb_emit(p); + for (l = values; l; l = CB_CHAIN(l)) + { + x = CB_VALUE(l); + if (CB_FIELD_P(x)) + { + CB_FIELD(cb_ref(x))->count++; } } } } -void -cb_emit_display_mnemonic (cb_tree values, cb_tree mnemonic, cb_tree no_adv, - cb_tree pos, cb_tree fgc, cb_tree bgc, - cb_tree scroll, int dispattrs) +void cb_emit_display_mnemonic(cb_tree values, cb_tree mnemonic, cb_tree no_adv, + cb_tree pos, cb_tree fgc, cb_tree bgc, + cb_tree scroll, int dispattrs) { - if (CB_SYSTEM_NAME (cb_ref (mnemonic))->category == CB_INTERFACE_NAME) { + if (CB_SYSTEM_NAME(cb_ref(mnemonic))->category == CB_INTERFACE_NAME) + { cb_tree v = CB_VALUE(values); - switch (CB_SYSTEM_NAME (cb_ref (mnemonic))->token) { + switch (CB_SYSTEM_NAME(cb_ref(mnemonic))->token) + { case CB_ARGUMENT_NUMBER: - cb_emit_arg_number (v); + cb_emit_arg_number(v); break; case CB_ENVIRONMENT_NAME: - cb_emit_env_name (v); + cb_emit_env_name(v); break; case CB_ENVIRONMENT_VALUE: - cb_emit_env_value (v); + cb_emit_env_value(v); break; default: - cb_error_x (mnemonic, _("Invalid interface name '%s'"), cb_name (mnemonic)); + cb_error_x(mnemonic, _("Invalid interface name '%s'"), cb_name(mnemonic)); break; } - } else { - cb_tree var = cb_build_display_upon (mnemonic); - cb_emit_display (values, var, no_adv, pos, fgc, bgc, scroll, dispattrs); + } + else + { + cb_tree var = cb_build_display_upon(mnemonic); + cb_emit_display(values, var, no_adv, pos, fgc, bgc, scroll, dispattrs); } } cb_tree -cb_build_display_upon (cb_tree x) +cb_build_display_upon(cb_tree x) { - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - switch (CB_SYSTEM_NAME (cb_ref (x))->token) { + switch (CB_SYSTEM_NAME(cb_ref(x))->token) + { case CB_DEVICE_CONSOLE: case CB_DEVICE_SYSOUT: return cb_int0; case CB_DEVICE_SYSERR: return cb_int1; default: - cb_error_x (x, _("Invalid output stream")); + cb_error_x(x, _("Invalid output stream")); return cb_error_node; } } cb_tree -cb_build_display_upon_direct (cb_tree x) +cb_build_display_upon_direct(cb_tree x) { - const char *name; - cb_tree sys; + const char *name; + cb_tree sys; - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - name = CB_NAME (x); - if (CB_REFERENCE (x)->word->count == 0) { - sys = lookup_system_name (CB_NAME (x)); - if (sys != cb_error_node) { - switch (CB_SYSTEM_NAME (sys)->token) { + name = CB_NAME(x); + if (CB_REFERENCE(x)->word->count == 0) + { + sys = lookup_system_name(CB_NAME(x)); + if (sys != cb_error_node) + { + switch (CB_SYSTEM_NAME(sys)->token) + { case CB_DEVICE_CONSOLE: case CB_DEVICE_SYSOUT: - cb_warning_x (x, _("'%s' undefined in SPECIAL-NAMES"), name); + cb_warning_x(x, _("'%s' undefined in SPECIAL-NAMES"), name); return cb_int0; case CB_DEVICE_SYSERR: - cb_warning_x (x, _("'%s' undefined in SPECIAL-NAMES"), name); + cb_warning_x(x, _("'%s' undefined in SPECIAL-NAMES"), name); return cb_int1; default: break; @@ -3819,7 +4461,7 @@ cb_build_display_upon_direct (cb_tree x) } } - cb_error_x (x, _("'%s' undefined in SPECIAL-NAMES"), name); + cb_error_x(x, _("'%s' undefined in SPECIAL-NAMES"), name); return cb_error_node; } @@ -3827,30 +4469,33 @@ cb_build_display_upon_direct (cb_tree x) * DIVIDE statement */ -void -cb_emit_divide (cb_tree dividend, cb_tree divisor, cb_tree quotient, cb_tree remainder) +void cb_emit_divide(cb_tree dividend, cb_tree divisor, cb_tree quotient, cb_tree remainder) { - if (cb_validate_one (dividend)) { + if (cb_validate_one(dividend)) + { return; } - if (cb_validate_one (divisor)) { + if (cb_validate_one(divisor)) + { return; } - CB_VALUE (quotient) = cb_check_numeric_edited_name (CB_VALUE (quotient)); - CB_VALUE (remainder) = cb_check_numeric_edited_name (CB_VALUE (remainder)); + CB_VALUE(quotient) = cb_check_numeric_edited_name(CB_VALUE(quotient)); + CB_VALUE(remainder) = cb_check_numeric_edited_name(CB_VALUE(remainder)); - if (cb_validate_one (CB_VALUE (quotient))) { + if (cb_validate_one(CB_VALUE(quotient))) + { return; } - if (cb_validate_one (CB_VALUE (remainder))) { + if (cb_validate_one(CB_VALUE(remainder))) + { return; } - cb_emit (cb_build_method_call_4 ("divQuotient", dividend, divisor, - CB_VALUE (quotient), - build_store_option (CB_VALUE (quotient), CB_PURPOSE (quotient)))); - cb_emit (cb_build_method_call_2 ("divRemainder", CB_VALUE (remainder), - build_store_option (CB_VALUE (remainder), cb_int0))); + cb_emit(cb_build_method_call_4("divQuotient", dividend, divisor, + CB_VALUE(quotient), + build_store_option(CB_VALUE(quotient), CB_PURPOSE(quotient)))); + cb_emit(cb_build_method_call_2("divRemainder", CB_VALUE(remainder), + build_store_option(CB_VALUE(remainder), cb_int0))); } /* @@ -3858,83 +4503,100 @@ cb_emit_divide (cb_tree dividend, cb_tree divisor, cb_tree quotient, cb_tree rem */ static cb_tree -evaluate_test (cb_tree s, cb_tree o) +evaluate_test(cb_tree s, cb_tree o) { - int flag; + int flag; cb_tree x, y; cb_tree t; /* ANY is always true */ - if (o == cb_any) { + if (o == cb_any) + { return cb_true; } /* object TRUE or FALSE */ - if (o == cb_true) { + if (o == cb_true) + { return s; } - if (o == cb_false) { - return cb_build_negation (s); + if (o == cb_false) + { + return cb_build_negation(s); } - flag = CB_PURPOSE_INT (o); - x = CB_PAIR_X (CB_VALUE (o)); - y = CB_PAIR_Y (CB_VALUE (o)); + flag = CB_PURPOSE_INT(o); + x = CB_PAIR_X(CB_VALUE(o)); + y = CB_PAIR_Y(CB_VALUE(o)); /* subject TRUE or FALSE */ - if (s == cb_true) { - return flag ? cb_build_negation (x) : x; + if (s == cb_true) + { + return flag ? cb_build_negation(x) : x; } - if (s == cb_false) { - return flag ? x : cb_build_negation (x); + if (s == cb_false) + { + return flag ? x : cb_build_negation(x); } /* x THRU y */ - if (y) { - t = cb_build_binary_op (cb_build_binary_op (x, '[', s), - '&', - cb_build_binary_op (s, '[', y)); + if (y) + { + t = cb_build_binary_op(cb_build_binary_op(x, '[', s), + '&', + cb_build_binary_op(s, '[', y)); - return flag ? cb_build_negation (t) : t; + return flag ? cb_build_negation(t) : t; } if (CB_REFERENCE_P(x) && CB_FIELD_P(CB_REFERENCE(x)->value) && - CB_FIELD(CB_REFERENCE(x)->value)->level == 88) { - cb_error_x (CB_TREE (current_statement), - _("Invalid use of 88 level in WHEN expression")); + CB_FIELD(CB_REFERENCE(x)->value)->level == 88) + { + cb_error_x(CB_TREE(current_statement), + _("Invalid use of 88 level in WHEN expression")); return NULL; } /* regular comparison */ - if (flag) { - return cb_build_binary_op (s, '~', x); - } else { - return cb_build_binary_op (s, '=', x); + if (flag) + { + return cb_build_binary_op(s, '~', x); + } + else + { + return cb_build_binary_op(s, '=', x); } } static int -check_error_node (cb_tree x) +check_error_node(cb_tree x) { int rt = 0; - if (x == cb_error_node) { + if (x == cb_error_node) + { rt = 1; - } else if (CB_LIST_P (x)) { - if (CB_PURPOSE (x) == cb_error_node) { + } + else if (CB_LIST_P(x)) + { + if (CB_PURPOSE(x) == cb_error_node) + { rt = 1; - } else if (CB_VALUE (x)) { - rt = check_error_node (CB_VALUE (x)); } - if (!rt && CB_CHAIN (x)) { - rt = check_error_node (CB_CHAIN (x)); + else if (CB_VALUE(x)) + { + rt = check_error_node(CB_VALUE(x)); + } + if (!rt && CB_CHAIN(x)) + { + rt = check_error_node(CB_CHAIN(x)); } } return rt; } static cb_tree -build_evaluate (cb_tree subject_list, cb_tree case_list) +build_evaluate(cb_tree subject_list, cb_tree case_list) { cb_tree c1 = NULL; cb_tree c2; @@ -3945,103 +4607,128 @@ build_evaluate (cb_tree subject_list, cb_tree case_list) cb_tree stmt; cb_tree dummy_cond = NULL; - if (case_list == NULL) { + if (case_list == NULL) + { return NULL; } - whens = CB_VALUE (case_list); - stmt = CB_VALUE (whens); - whens = CB_CHAIN (whens); + whens = CB_VALUE(case_list); + stmt = CB_VALUE(whens); + whens = CB_CHAIN(whens); /* for each WHEN sequence */ - for (; whens; whens = CB_CHAIN (whens)) { + for (; whens; whens = CB_CHAIN(whens)) + { c2 = NULL; dummy_cond = NULL; /* single WHEN test */ - for (subjs = subject_list, objs = CB_VALUE (whens); - subjs && objs; subjs = CB_CHAIN (subjs), objs = CB_CHAIN (objs)) { - if (check_error_node (CB_VALUE (subjs)) || - check_error_node (CB_VALUE (objs))) { + for (subjs = subject_list, objs = CB_VALUE(whens); + subjs && objs; subjs = CB_CHAIN(subjs), objs = CB_CHAIN(objs)) + { + if (check_error_node(CB_VALUE(subjs)) || + check_error_node(CB_VALUE(objs))) + { dummy_cond = cb_false; break; } - c3 = evaluate_test (CB_VALUE (subjs), CB_VALUE (objs)); - if (c3 == NULL) { + c3 = evaluate_test(CB_VALUE(subjs), CB_VALUE(objs)); + if (c3 == NULL) + { return NULL; } - if (c2 == NULL) { + if (c2 == NULL) + { c2 = c3; - } else { - c2 = cb_build_binary_op (c2, '&', c3); + } + else + { + c2 = cb_build_binary_op(c2, '&', c3); } } - if (!dummy_cond && (subjs || objs)) { - cb_error_x (CB_VALUE (whens) ? CB_VALUE (whens) : whens, - _("Wrong number of WHEN parameters")); + if (!dummy_cond && (subjs || objs)) + { + cb_error_x(CB_VALUE(whens) ? CB_VALUE(whens) : whens, + _("Wrong number of WHEN parameters")); dummy_cond = cb_false; /* suppress redundant error */ } /* connect multiple WHEN's */ - if (c1 == NULL) { + if (c1 == NULL) + { c1 = c2; - } else { - c1 = cb_build_binary_op (c1, '|', c2); + } + else + { + c1 = cb_build_binary_op(c1, '|', c2); } } - if (c1 == NULL) { + if (c1 == NULL) + { return stmt; - } else { - return cb_build_if ((dummy_cond ? dummy_cond : cb_build_cond (c1)), stmt, - build_evaluate (subject_list, CB_CHAIN (case_list))); + } + else + { + return cb_build_if((dummy_cond ? dummy_cond : cb_build_cond(c1)), stmt, + build_evaluate(subject_list, CB_CHAIN(case_list))); } } -void -cb_emit_evaluate (cb_tree subject_list, cb_tree case_list) +void cb_emit_evaluate(cb_tree subject_list, cb_tree case_list) { - cb_emit (build_evaluate (subject_list, case_list)); + cb_emit(build_evaluate(subject_list, case_list)); } /* * FREE statement */ -void -cb_emit_free (cb_tree vars) +void cb_emit_free(cb_tree vars) { - cb_tree l; - struct cb_field *f; - int i; + cb_tree l; + struct cb_field *f; + int i; - if (cb_validate_list (vars)) { + if (cb_validate_list(vars)) + { return; } - for (l = vars, i = 1; l; l = CB_CHAIN (l), i++) { - if (CB_TREE_CLASS (CB_VALUE (l)) == CB_CLASS_POINTER) { - if (CB_CAST_P (CB_VALUE (l))) { - f = cb_field (CB_CAST (CB_VALUE(l))->val); - if (!f->flag_item_based) { - cb_error_x (CB_TREE (current_statement), - _("Target %d of FREE, a data address identifier, must address a BASED data item"), i); - } - cb_emit (cb_build_funcall_2 ("cob_free_alloc", - cb_build_cast_address (CB_VALUE (l)), NULL)); - } else { - cb_emit (cb_build_funcall_2 ("cob_free_alloc", - NULL, cb_build_cast_address (CB_VALUE (l)))); - } - } else if (CB_REF_OR_FIELD_P (CB_VALUE (l))) { - f = cb_field (CB_VALUE (l)); - if (!f->flag_item_based) { - cb_error_x (CB_TREE (current_statement), - _("Target %d of FREE, a data address identifier, must address a BASED data item"), i); - } - cb_emit (cb_build_funcall_2 ("cob_free_alloc", - cb_build_cast_addr_of_addr (CB_VALUE (l)), NULL)); - } else { - cb_error_x (CB_TREE (current_statement), - _("Target %d of FREE must be a data pointer"), i); + for (l = vars, i = 1; l; l = CB_CHAIN(l), i++) + { + if (CB_TREE_CLASS(CB_VALUE(l)) == CB_CLASS_POINTER) + { + if (CB_CAST_P(CB_VALUE(l))) + { + f = cb_field(CB_CAST(CB_VALUE(l))->val); + if (!f->flag_item_based) + { + cb_error_x(CB_TREE(current_statement), + _("Target %d of FREE, a data address identifier, must address a BASED data item"), i); + } + cb_emit(cb_build_funcall_2("cob_free_alloc", + cb_build_cast_address(CB_VALUE(l)), NULL)); + } + else + { + cb_emit(cb_build_funcall_2("cob_free_alloc", + NULL, cb_build_cast_address(CB_VALUE(l)))); + } + } + else if (CB_REF_OR_FIELD_P(CB_VALUE(l))) + { + f = cb_field(CB_VALUE(l)); + if (!f->flag_item_based) + { + cb_error_x(CB_TREE(current_statement), + _("Target %d of FREE, a data address identifier, must address a BASED data item"), i); + } + cb_emit(cb_build_funcall_2("cob_free_alloc", + cb_build_cast_addr_of_addr(CB_VALUE(l)), NULL)); + } + else + { + cb_error_x(CB_TREE(current_statement), + _("Target %d of FREE must be a data pointer"), i); } } } @@ -4050,49 +4737,55 @@ cb_emit_free (cb_tree vars) * GO TO statement */ -void -cb_emit_goto (cb_tree target, cb_tree depending) +void cb_emit_goto(cb_tree target, cb_tree depending) { - if (target == cb_error_node) { + if (target == cb_error_node) + { return; } - if (depending) { + if (depending) + { /* GO TO procedure-name ... DEPENDING ON identifier */ - cb_emit (cb_build_goto (target, depending)); - } else { + cb_emit(cb_build_goto(target, depending)); + } + else + { /* GO TO procedure-name */ - if (target == NULL) { - cb_verify (cb_goto_statement_without_name, "GO TO without procedure-name"); - } else if (CB_CHAIN (target)) { - cb_error (_("GO TO with multiple procedure-names")); - } else { - cb_emit (cb_build_goto (CB_VALUE (target), NULL)); + if (target == NULL) + { + cb_verify(cb_goto_statement_without_name, "GO TO without procedure-name"); + } + else if (CB_CHAIN(target)) + { + cb_error(_("GO TO with multiple procedure-names")); + } + else + { + cb_emit(cb_build_goto(CB_VALUE(target), NULL)); } } } - -void -cb_emit_java_continue () +void cb_emit_java_continue() { - cb_emit(make_tree (CB_TAG_JAVA_CONTINUE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_tree_common))); + cb_emit(make_tree(CB_TAG_JAVA_CONTINUE, CB_CATEGORY_UNKNOWN, sizeof(struct cb_tree_common))); } - -void -cb_emit_java_break () +void cb_emit_java_break() { - cb_emit(make_tree (CB_TAG_JAVA_BREAK, CB_CATEGORY_UNKNOWN, sizeof (struct cb_tree_common))); + cb_emit(make_tree(CB_TAG_JAVA_BREAK, CB_CATEGORY_UNKNOWN, sizeof(struct cb_tree_common))); } -void -cb_emit_exit (size_t goback) +void cb_emit_exit(size_t goback) { - if (goback) { - cb_emit (cb_build_goto (cb_int1, NULL)); - } else { - cb_emit (cb_build_goto (NULL, NULL)); + if (goback) + { + cb_emit(cb_build_goto(cb_int1, NULL)); + } + else + { + cb_emit(cb_build_goto(NULL, NULL)); } } @@ -4100,33 +4793,35 @@ cb_emit_exit (size_t goback) * IF statement */ -void -cb_emit_if (cb_tree cond, cb_tree stmt1, cb_tree stmt2) +void cb_emit_if(cb_tree cond, cb_tree stmt1, cb_tree stmt2) { - cb_emit (cb_build_if (cond, stmt1, stmt2)); + cb_emit(cb_build_if(cond, stmt1, stmt2)); } /* * INITIALIZE statement */ -void -cb_emit_initialize (cb_tree vars, cb_tree fillinit, cb_tree value, cb_tree replacing, cb_tree def) +void cb_emit_initialize(cb_tree vars, cb_tree fillinit, cb_tree value, cb_tree replacing, cb_tree def) { cb_tree l; int fill_init = 1; - if (cb_validate_list (vars)) { + if (cb_validate_list(vars)) + { return; } - if (value == NULL && replacing == NULL) { + if (value == NULL && replacing == NULL) + { def = cb_true; } - if (fillinit == cb_true) { + if (fillinit == cb_true) + { fill_init = 0; } - for (l = vars; l; l = CB_CHAIN (l)) { - cb_emit (cb_build_initialize (CB_VALUE (l), value, replacing, def, fill_init)); + for (l = vars; l; l = CB_CHAIN(l)) + { + cb_emit(cb_build_initialize(CB_VALUE(l), value, replacing, def, fill_init)); } } @@ -4134,182 +4829,204 @@ cb_emit_initialize (cb_tree vars, cb_tree fillinit, cb_tree value, cb_tree repla * INSPECT statement */ -void -cb_emit_inspect (cb_tree var, cb_tree body, cb_tree replacing, int replconv) +void cb_emit_inspect(cb_tree var, cb_tree body, cb_tree replacing, int replconv) { - switch (CB_TREE_TAG(var)) { + switch (CB_TREE_TAG(var)) + { case CB_TAG_REFERENCE: break; case CB_TAG_INTRINSIC: - switch (CB_TREE_CATEGORY(var)) { + switch (CB_TREE_CATEGORY(var)) + { case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: case CB_CATEGORY_NATIONAL: break; default: - cb_error (_("Invalid target for INSPECT")); + cb_error(_("Invalid target for INSPECT")); return; } break; case CB_TAG_LITERAL: break; default: - cb_error (_("Invalid target for REPLACING/CONVERTING")); + cb_error(_("Invalid target for REPLACING/CONVERTING")); return; } - if (replconv && sending_id) { - cb_error (_("Invalid target for REPLACING/CONVERTING")); + if (replconv && sending_id) + { + cb_error(_("Invalid target for REPLACING/CONVERTING")); } - cb_emit (cb_build_funcall_2 ("CobolInspect.init", var, replacing)); - cb_emit_list (body); - cb_emit (cb_build_funcall_0 ("CobolInspect.finish")); + cb_emit(cb_build_funcall_2("CobolInspect.init", var, replacing)); + cb_emit_list(body); + cb_emit(cb_build_funcall_0("CobolInspect.finish")); } -void -cb_init_tarrying (void) +void cb_init_tarrying(void) { inspect_func = NULL; inspect_data = NULL; } cb_tree -cb_build_tarrying_data (cb_tree x) +cb_build_tarrying_data(cb_tree x) { inspect_data = x; return NULL; } cb_tree -cb_build_tarrying_characters (cb_tree l) +cb_build_tarrying_characters(cb_tree l) { - if (inspect_data == NULL) { - cb_error (_("Data name expected before CHARACTERS")); + if (inspect_data == NULL) + { + cb_error(_("Data name expected before CHARACTERS")); } inspect_func = NULL; - return cb_list_add (l, cb_build_funcall_1 ("CobolInspect.characters", inspect_data)); + return cb_list_add(l, cb_build_funcall_1("CobolInspect.characters", inspect_data)); } cb_tree -cb_build_tarrying_all (void) +cb_build_tarrying_all(void) { - if (inspect_data == NULL) { - cb_error (_("Data name expected before ALL")); + if (inspect_data == NULL) + { + cb_error(_("Data name expected before ALL")); } inspect_func = "CobolInspect.all"; return NULL; } cb_tree -cb_build_tarrying_leading (void) +cb_build_tarrying_leading(void) { - if (inspect_data == NULL) { - cb_error (_("Data name expected before LEADING")); + if (inspect_data == NULL) + { + cb_error(_("Data name expected before LEADING")); } inspect_func = "CobolInspect.leading"; return NULL; } cb_tree -cb_build_tarrying_trailing (void) +cb_build_tarrying_trailing(void) { - if (inspect_data == NULL) { - cb_error (_("Data name expected before TRAILING")); + if (inspect_data == NULL) + { + cb_error(_("Data name expected before TRAILING")); } inspect_func = "CobolInspect.trailing"; return NULL; } cb_tree -cb_build_tarrying_value (cb_tree x, cb_tree l) +cb_build_tarrying_value(cb_tree x, cb_tree l) { - if (inspect_func == NULL) { - cb_error_x (x, _("ALL, LEADING or TRAILING expected before '%s'"), cb_name (x)); + if (inspect_func == NULL) + { + cb_error_x(x, _("ALL, LEADING or TRAILING expected before '%s'"), cb_name(x)); } - return cb_list_add (l, cb_build_funcall_2 (inspect_func, inspect_data, x)); + return cb_list_add(l, cb_build_funcall_2(inspect_func, inspect_data, x)); } -#ifdef I18N_UTF8 +#ifdef I18N_UTF8 static int -cb_validate_single_char_data (cb_tree x) +cb_validate_single_char_data(cb_tree x) { char msgbuf[256]; int rt = 0; - if (CB_LITERAL_P (x)) { - struct cb_literal *lp = CB_LITERAL (x); - if (lp->size != COB_U8BYTE_1(lp->data[0])) { + if (CB_LITERAL_P(x)) + { + struct cb_literal *lp = CB_LITERAL(x); + if (lp->size != COB_U8BYTE_1(lp->data[0])) + { - memset (msgbuf, 0, sizeof (msgbuf)); - strncpy (msgbuf, (char *)lp->data, 253); - cb_error_x (x, "Illegal replacement size: '%s'.", msgbuf); + memset(msgbuf, 0, sizeof(msgbuf)); + strncpy(msgbuf, (char *)lp->data, 253); + cb_error_x(x, "Illegal replacement size: '%s'.", msgbuf); rt = 1; } - } else { + } + else + { /* can't determine char length statically. */ } return rt; } - static int -check_equal_data_size (cb_tree x, cb_tree y) +check_equal_data_size(cb_tree x, cb_tree y) { char msgbuf1[256], msgbuf2[256]; size_t len1 = 0, len2 = 0; int rt = 0; - memset (msgbuf1, 0, sizeof (msgbuf1)); - memset (msgbuf2, 0, sizeof (msgbuf2)); - - if (CB_LITERAL_P (x)) { - len1 = CB_LITERAL (x)->size; - strcat (msgbuf1, "'"); - strncat (msgbuf1, (char *)CB_LITERAL (x)->data, 253); - strcat (msgbuf1, "'"); - } else if (CB_REFERENCE_P (x)) { - len1 = CB_FIELD (cb_ref (x))->size; - cb_get_jisword_buff ((char *)CB_FIELD (cb_ref (x))->name, msgbuf1, sizeof (msgbuf1)); - } else { - cb_error_x (x, "Unexpected tag %d.", CB_TREE_TAG (x)); + memset(msgbuf1, 0, sizeof(msgbuf1)); + memset(msgbuf2, 0, sizeof(msgbuf2)); + + if (CB_LITERAL_P(x)) + { + len1 = CB_LITERAL(x)->size; + strcat(msgbuf1, "'"); + strncat(msgbuf1, (char *)CB_LITERAL(x)->data, 253); + strcat(msgbuf1, "'"); + } + else if (CB_REFERENCE_P(x)) + { + len1 = CB_FIELD(cb_ref(x))->size; + cb_get_jisword_buff((char *)CB_FIELD(cb_ref(x))->name, msgbuf1, sizeof(msgbuf1)); + } + else + { + cb_error_x(x, "Unexpected tag %d.", CB_TREE_TAG(x)); rt = 1; } - if (CB_LITERAL_P (y)) { - len2 = CB_LITERAL (y)->size; - strcat (msgbuf2, "'"); - strncat (msgbuf2, (char *)CB_LITERAL (y)->data, 253); - strcat (msgbuf2, "'"); - } else if (CB_REFERENCE_P (y)) { - len2 = CB_FIELD (cb_ref (y))->size; - cb_get_jisword_buff ((char *)CB_FIELD (cb_ref (y))->name, msgbuf2, sizeof (msgbuf2)); - } else { - cb_error_x (y, "Unexpected tag %d.", CB_TREE_TAG (y)); + if (CB_LITERAL_P(y)) + { + len2 = CB_LITERAL(y)->size; + strcat(msgbuf2, "'"); + strncat(msgbuf2, (char *)CB_LITERAL(y)->data, 253); + strcat(msgbuf2, "'"); + } + else if (CB_REFERENCE_P(y)) + { + len2 = CB_FIELD(cb_ref(y))->size; + cb_get_jisword_buff((char *)CB_FIELD(cb_ref(y))->name, msgbuf2, sizeof(msgbuf2)); + } + else + { + cb_error_x(y, "Unexpected tag %d.", CB_TREE_TAG(y)); rt = 1; } - if (!rt && len1 != len2) { - cb_error_x (x, "%s and %s have not same size!", - msgbuf1, msgbuf2); + if (!rt && len1 != len2) + { + cb_error_x(x, "%s and %s have not same size!", + msgbuf1, msgbuf2); rt = (int)(len1 - len2); } return rt; } static int -cb_validate_inspect_replaceable (cb_tree x, cb_tree y) +cb_validate_inspect_replaceable(cb_tree x, cb_tree y) { int rt = 0; - if (y == cb_zero || y == cb_space || y == cb_quote - || y == cb_high || y == cb_low) { + if (y == cb_zero || y == cb_space || y == cb_quote || y == cb_high || y == cb_low) + { /* always replaceable */ - } else if (check_equal_data_size (x, y)) { + } + else if (check_equal_data_size(x, y)) + { rt = 1; } return rt; } static int -cb_validate_inspect_convertible (cb_tree x, cb_tree y) +cb_validate_inspect_convertible(cb_tree x, cb_tree y) { unsigned char *data1; unsigned char *data2; @@ -4318,170 +5035,204 @@ cb_validate_inspect_convertible (cb_tree x, cb_tree y) /* should be convertible char by char in UTF-8 mode */ - if (y == cb_zero || y == cb_space || y == cb_quote - || y == cb_high || y == cb_low) { - if (CB_LITERAL_P (x)) { + if (y == cb_zero || y == cb_space || y == cb_quote || y == cb_high || y == cb_low) + { + if (CB_LITERAL_P(x)) + { data1 = CB_LITERAL(x)->data; - n = CB_LITERAL(x)->size; - for (i = 0, nc = 0; !rt && i < n; i += nc) { - nc = COB_U8BYTE_1 (data1[i]); - if (!nc) { - cb_error_x (x, "Unexpected char in literal."); - rt = 1; - } else if (nc != 1 && nc != COB_U8CSIZ) { - cb_error_x (x, "Illegal conversion chars."); - rt = 1; + n = CB_LITERAL(x)->size; + for (i = 0, nc = 0; !rt && i < n; i += nc) + { + nc = COB_U8BYTE_1(data1[i]); + if (!nc) + { + cb_error_x(x, "Unexpected char in literal."); + rt = 1; + } + else if (nc != 1 && nc != COB_U8CSIZ) + { + cb_error_x(x, "Illegal conversion chars."); + rt = 1; + } } } - - } else { + else + { /* can't determine char length statically. */ } - } else if (check_equal_data_size (x, y)) { + } + else if (check_equal_data_size(x, y)) + { /* should be at least in same length */ rt = 1; - } else if (CB_LITERAL_P (x) && CB_LITERAL_P (y)) { + } + else if (CB_LITERAL_P(x) && CB_LITERAL_P(y)) + { data1 = CB_LITERAL(x)->data; data2 = CB_LITERAL(y)->data; - n = CB_LITERAL(x)->size; - for (i = 0, nc = 0; !rt && i < n; i += nc) { - nc = COB_U8BYTE_1 (data1[i]); - if (!nc) { - cb_error_x (x, "Unexpected char in literal."); + n = CB_LITERAL(x)->size; + for (i = 0, nc = 0; !rt && i < n; i += nc) + { + nc = COB_U8BYTE_1(data1[i]); + if (!nc) + { + cb_error_x(x, "Unexpected char in literal."); rt = 1; - } else if (nc != COB_U8BYTE_1 (data2[i])) { - cb_error_x (x, "Illegal conversion chars."); + } + else if (nc != COB_U8BYTE_1(data2[i])) + { + cb_error_x(x, "Illegal conversion chars."); rt = 1; } } - } else { + } + else + { /* can't determine char length statically. */ } return rt; } -int -cb_validate_inspect (cb_tree var, cb_tree x, cb_tree y) +int cb_validate_inspect(cb_tree var, cb_tree x, cb_tree y) { /* * never return error result(<0), as original * cb_validate_inspect() also doesn't. */ - cb_validate_inspect_convertible (x, y); + cb_validate_inspect_convertible(x, y); return 0; } -#else /*I18N_UTF8*/ +#else /*I18N_UTF8*/ -int -cb_validate_inspect (cb_tree var, cb_tree x, cb_tree y) +int cb_validate_inspect(cb_tree var, cb_tree x, cb_tree y) { - int s1, s2; - struct cb_field *pfield; - struct cb_literal *pliteral; - char name1[256], name2[256]; + int s1, s2; + struct cb_field *pfield; + struct cb_literal *pliteral; + char name1[256], name2[256]; - memset (name1, 0, sizeof (name1)); - memset (name2, 0, sizeof (name2)); + memset(name1, 0, sizeof(name1)); + memset(name2, 0, sizeof(name2)); - switch (CB_TREE_TAG (x)) { + switch (CB_TREE_TAG(x)) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (x)); + pfield = CB_FIELD(cb_ref(x)); s1 = pfield->size; - cb_get_jisword_buff ((char*)pfield->name, name1, sizeof (name1)); + cb_get_jisword_buff((char *)pfield->name, name1, sizeof(name1)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (x); + pliteral = CB_LITERAL(x); s1 = pliteral->size; - strcpy (name1, "\'"); - if (s1 >= 253) { - memcpy (name1+1, pliteral->data, 253); - } else { - memcpy (name1+1, pliteral->data, s1); + strcpy(name1, "\'"); + if (s1 >= 253) + { + memcpy(name1 + 1, pliteral->data, 253); + } + else + { + memcpy(name1 + 1, pliteral->data, s1); } - strcat (name1, "\'"); + strcat(name1, "\'"); break; default: s1 = 0; break; } - if (y == 0) { + if (y == 0) + { if (x != cb_zero && - x != cb_space && - x != cb_quote && - x != cb_high && - x != cb_low) { - if (CB_TREE_CATEGORY (var) == CB_CATEGORY_NATIONAL || - CB_TREE_CATEGORY (var) == CB_CATEGORY_NATIONAL_EDITED) { - if (s1 != 2) { - cb_error_x (x, "Illegal replacement size: %s", name1); + x != cb_space && + x != cb_quote && + x != cb_high && + x != cb_low) + { + if (CB_TREE_CATEGORY(var) == CB_CATEGORY_NATIONAL || + CB_TREE_CATEGORY(var) == CB_CATEGORY_NATIONAL_EDITED) + { + if (s1 != 2) + { + cb_error_x(x, "Illegal replacement size: %s", name1); } - } else { - if (s1 != 1) { - cb_error_x (x, "Illegal replacement size: %s", name1); + } + else + { + if (s1 != 1) + { + cb_error_x(x, "Illegal replacement size: %s", name1); } } } return 0; } - switch (CB_TREE_TAG (y)) { + switch (CB_TREE_TAG(y)) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (y)); + pfield = CB_FIELD(cb_ref(y)); s2 = pfield->size; - cb_get_jisword_buff ((char*)pfield->name, name2, sizeof (name2)); + cb_get_jisword_buff((char *)pfield->name, name2, sizeof(name2)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (y); + pliteral = CB_LITERAL(y); s2 = pliteral->size; - strcpy (name2, "\'"); - if (s1>= 253) { - memcpy (name2+1, pliteral->data, 253); - } else { - memcpy (name2+1, pliteral->data, s2); + strcpy(name2, "\'"); + if (s1 >= 253) + { + memcpy(name2 + 1, pliteral->data, 253); } - strcat (name2, "\'"); + else + { + memcpy(name2 + 1, pliteral->data, s2); + } + strcat(name2, "\'"); break; default: s2 = 0; break; } if (s1 != s2 && y != cb_zero && - y != cb_space && - y != cb_quote && - y != cb_high && - y != cb_low && - x != cb_zero && - x != cb_space && - x != cb_quote && - x != cb_high && - x != cb_low) { - cb_error_x (x, "%s and %s have not same size!", name1, name2); + y != cb_space && + y != cb_quote && + y != cb_high && + y != cb_low && + x != cb_zero && + x != cb_space && + x != cb_quote && + x != cb_high && + x != cb_low) + { + cb_error_x(x, "%s and %s have not same size!", name1, name2); return 0; } - switch (CB_TREE_CATEGORY (var)) { + switch (CB_TREE_CATEGORY(var)) + { case CB_CATEGORY_NATIONAL: case CB_CATEGORY_NATIONAL_EDITED: - if (CB_TREE_CATEGORY (x) == CB_CATEGORY_NATIONAL || - CB_TREE_CATEGORY (x) == CB_CATEGORY_NATIONAL_EDITED) { - if (CB_TREE_CATEGORY (y) != CB_CATEGORY_NATIONAL && - CB_TREE_CATEGORY (y) != CB_CATEGORY_NATIONAL_EDITED && - y != cb_zero && - y != cb_space && - y != cb_quote && - y != cb_high && - y != cb_low) { - cb_warning_x (y, _("%s and %s have not same type!"), name1, name2); + if (CB_TREE_CATEGORY(x) == CB_CATEGORY_NATIONAL || + CB_TREE_CATEGORY(x) == CB_CATEGORY_NATIONAL_EDITED) + { + if (CB_TREE_CATEGORY(y) != CB_CATEGORY_NATIONAL && + CB_TREE_CATEGORY(y) != CB_CATEGORY_NATIONAL_EDITED && + y != cb_zero && + y != cb_space && + y != cb_quote && + y != cb_high && + y != cb_low) + { + cb_warning_x(y, _("%s and %s have not same type!"), name1, name2); } } break; default: - if (CB_TREE_CATEGORY (y) != CB_TREE_CATEGORY (x) && - y != cb_zero && - y != cb_space && - y != cb_quote && - y != cb_high && - y != cb_low) { - cb_warning_x (y, _("%s and %s have not same type!"), name1, name2); + if (CB_TREE_CATEGORY(y) != CB_TREE_CATEGORY(x) && + y != cb_zero && + y != cb_space && + y != cb_quote && + y != cb_high && + y != cb_low) + { + cb_warning_x(y, _("%s and %s have not same type!"), name1, name2); } break; } @@ -4490,74 +5241,79 @@ cb_validate_inspect (cb_tree var, cb_tree x, cb_tree y) #endif /*I18N_UTF8*/ cb_tree -cb_build_replacing_characters (cb_tree x, cb_tree l, cb_tree var) +cb_build_replacing_characters(cb_tree x, cb_tree l, cb_tree var) { -#ifdef I18N_UTF8 - cb_validate_single_char_data (x); -#else /*I18N_UTF8*/ +#ifdef I18N_UTF8 + cb_validate_single_char_data(x); +#else /*I18N_UTF8*/ /* * caution: cb_validate_inspect() never returns error (<0) */ - if (cb_validate_inspect (var, x, 0) < 0) { + if (cb_validate_inspect(var, x, 0) < 0) + { return cb_error_node; } #endif /*I18N_UTF8*/ - return cb_list_add (l, cb_build_funcall_1 ("CobolInspect.characters", x)); + return cb_list_add(l, cb_build_funcall_1("CobolInspect.characters", x)); } cb_tree -cb_build_replacing_all (cb_tree x, cb_tree y, cb_tree l, cb_tree var) +cb_build_replacing_all(cb_tree x, cb_tree y, cb_tree l, cb_tree var) { -#ifdef I18N_UTF8 - cb_validate_inspect_replaceable (x, y); -#else /*I18N_UTF8*/ +#ifdef I18N_UTF8 + cb_validate_inspect_replaceable(x, y); +#else /*I18N_UTF8*/ /* * caution: cb_validate_inspect() never returns error (<0) */ - if (cb_validate_inspect (var, x, y) < 0) { + if (cb_validate_inspect(var, x, y) < 0) + { return cb_error_node; } #endif /*I18N_UTF8*/ - return cb_list_add (l, cb_build_funcall_2 ("CobolInspect.all", y, x)); + return cb_list_add(l, cb_build_funcall_2("CobolInspect.all", y, x)); } cb_tree -cb_build_replacing_leading (cb_tree x, cb_tree y, cb_tree l) +cb_build_replacing_leading(cb_tree x, cb_tree y, cb_tree l) { - return cb_list_add (l, cb_build_funcall_2 ("CobolInspect.leading", y, x)); + return cb_list_add(l, cb_build_funcall_2("CobolInspect.leading", y, x)); } cb_tree -cb_build_replacing_first (cb_tree x, cb_tree y, cb_tree l) +cb_build_replacing_first(cb_tree x, cb_tree y, cb_tree l) { - return cb_list_add (l, cb_build_funcall_2 ("CobolInspect.first", y, x)); + return cb_list_add(l, cb_build_funcall_2("CobolInspect.first", y, x)); } cb_tree -cb_build_replacing_trailing (cb_tree x, cb_tree y, cb_tree l) +cb_build_replacing_trailing(cb_tree x, cb_tree y, cb_tree l) { - return cb_list_add (l, cb_build_funcall_2 ("CobolInspect.trailing", y, x)); + return cb_list_add(l, cb_build_funcall_2("CobolInspect.trailing", y, x)); } cb_tree -cb_build_converting (cb_tree x, cb_tree y, cb_tree l) +cb_build_converting(cb_tree x, cb_tree y, cb_tree l) { - return cb_list_add (l, cb_build_funcall_2 ("CobolInspect.converting", x, y)); + return cb_list_add(l, cb_build_funcall_2("CobolInspect.converting", x, y)); } cb_tree -cb_build_inspect_region_start (void) +cb_build_inspect_region_start(void) { - return cb_list_init (cb_build_funcall_0 ("CobolInspect.start")); + return cb_list_init(cb_build_funcall_0("CobolInspect.start")); } cb_tree -cb_build_inspect_region (cb_tree l, cb_tree pos, cb_tree x) +cb_build_inspect_region(cb_tree l, cb_tree pos, cb_tree x) { - if (pos == CB_BEFORE) { - return cb_list_add (l, cb_build_funcall_1 ("CobolInspect.before", x)); - } else { - return cb_list_add (l, cb_build_funcall_1 ("CobolInspect.after", x)); + if (pos == CB_BEFORE) + { + return cb_list_add(l, cb_build_funcall_1("CobolInspect.before", x)); + } + else + { + return cb_list_add(l, cb_build_funcall_1("CobolInspect.after", x)); } } @@ -4566,52 +5322,64 @@ cb_build_inspect_region (cb_tree l, cb_tree pos, cb_tree x) */ static void -warning_destination (cb_tree x) +warning_destination(cb_tree x) { - struct cb_reference *r; - struct cb_field *f; - cb_tree loc; + struct cb_reference *r; + struct cb_field *f; + cb_tree loc; - r = CB_REFERENCE (x); - f = CB_FIELD (r->value); - loc = CB_TREE (f); + r = CB_REFERENCE(x); + f = CB_FIELD(r->value); + loc = CB_TREE(f); - if (r->offset) { + if (r->offset) + { return; } - if (!strcmp (f->name, "RETURN-CODE") || - !strcmp (f->name, "SORT-RETURN") || - !strcmp (f->name, "NUMBER-OF-CALL-PARAMETERS")) { - cb_warning (_("Internal register '%s' defined as BINARY-LONG"), f->name); - } else if (f->pic) { - cb_warning_x (loc, _("'%s' defined here as PIC %s"), check_filler_name ((char *)f->name), f->pic->orig); - } else { - cb_warning_x (loc, _("'%s' defined here as a group of length %d"), check_filler_name ((char *)f->name), f->size); + if (!strcmp(f->name, "RETURN-CODE") || + !strcmp(f->name, "SORT-RETURN") || + !strcmp(f->name, "NUMBER-OF-CALL-PARAMETERS")) + { + cb_warning(_("Internal register '%s' defined as BINARY-LONG"), f->name); + } + else if (f->pic) + { + cb_warning_x(loc, _("'%s' defined here as PIC %s"), check_filler_name((char *)f->name), f->pic->orig); + } + else + { + cb_warning_x(loc, _("'%s' defined here as a group of length %d"), check_filler_name((char *)f->name), f->size); } } static int -move_error (cb_tree src, cb_tree dst, const size_t value_flag, const int flag, - const int src_flag, const char *msg) +move_error(cb_tree src, cb_tree dst, const size_t value_flag, const int flag, + const int src_flag, const char *msg) { cb_tree loc; - if (suppress_warn) { + if (suppress_warn) + { return 0; } loc = src->source_line ? src : dst; - if (value_flag) { + if (value_flag) + { /* VALUE clause */ - cb_warning_x (loc, msg); - } else { + cb_warning_x(loc, msg); + } + else + { /* MOVE statement */ - if (flag) { - cb_warning_x (loc, msg); - if (src_flag) { - warning_destination (src); + if (flag) + { + cb_warning_x(loc, msg); + if (src_flag) + { + warning_destination(src); } - warning_destination (dst); + warning_destination(dst); } } @@ -4619,49 +5387,60 @@ move_error (cb_tree src, cb_tree dst, const size_t value_flag, const int flag, } static void -error_destination (cb_tree x) +error_destination(cb_tree x) { - struct cb_reference *r; - struct cb_field *f; - cb_tree loc; + struct cb_reference *r; + struct cb_field *f; + cb_tree loc; - r = CB_REFERENCE (x); - f = CB_FIELD (r->value); - loc = CB_TREE (f); + r = CB_REFERENCE(x); + f = CB_FIELD(r->value); + loc = CB_TREE(f); - if (r->offset) { + if (r->offset) + { return; } - if (!strcmp (f->name, "RETURN-CODE") || - !strcmp (f->name, "SORT-RETURN") || - !strcmp (f->name, "NUMBER-OF-CALL-PARAMETERS")) { - cb_error (_("Internal register '%s' defined as BINARY-LONG"), f->name); - } else if (f->pic) { - cb_error_x (loc, _("'%s' defined here as PIC %s"), check_filler_name ((char *)f->name), f->pic->orig); - } else { - cb_error_x (loc, _("'%s' defined here as a group of length %d"), check_filler_name ((char *)f->name), f->size); + if (!strcmp(f->name, "RETURN-CODE") || + !strcmp(f->name, "SORT-RETURN") || + !strcmp(f->name, "NUMBER-OF-CALL-PARAMETERS")) + { + cb_error(_("Internal register '%s' defined as BINARY-LONG"), f->name); + } + else if (f->pic) + { + cb_error_x(loc, _("'%s' defined here as PIC %s"), check_filler_name((char *)f->name), f->pic->orig); + } + else + { + cb_error_x(loc, _("'%s' defined here as a group of length %d"), check_filler_name((char *)f->name), f->size); } } static int -move_error2 (cb_tree src, cb_tree dst, const size_t value_flag, const int flag, - const int src_flag, const char *msg) +move_error2(cb_tree src, cb_tree dst, const size_t value_flag, const int flag, + const int src_flag, const char *msg) { cb_tree loc; loc = src->source_line ? src : dst; - if (value_flag) { + if (value_flag) + { /* VALUE clause */ - cb_error_x (loc, msg); - } else { + cb_error_x(loc, msg); + } + else + { /* MOVE statement */ - if (flag) { - cb_error_x (loc, msg); - if (src_flag) { - error_destination (src); + if (flag) + { + cb_error_x(loc, msg); + if (src_flag) + { + error_destination(src); } - error_destination (dst); + error_destination(dst); } } @@ -4670,76 +5449,93 @@ move_error2 (cb_tree src, cb_tree dst, const size_t value_flag, const int flag, /* count the number of free places in an alphanumeric edited field */ static int -count_pic_alphanumeric_edited (struct cb_field *field) +count_pic_alphanumeric_edited(struct cb_field *field) { - int count; - int repeat; - unsigned char *p; + int count; + int repeat; + unsigned char *p; count = 0; - for (p = (unsigned char *)(field->pic->str); *p; p += 5) { - if (*p == '9' || *p == 'A' || *p == 'X') { - memcpy ((unsigned char *)&repeat, p + 1, sizeof(int)); + for (p = (unsigned char *)(field->pic->str); *p; p += 5) + { + if (*p == '9' || *p == 'A' || *p == 'X') + { + memcpy((unsigned char *)&repeat, p + 1, sizeof(int)); count += repeat; } } return count; } -int -validate_move (cb_tree src, cb_tree dst, size_t is_value) -{ - struct cb_field *f; - struct cb_field *pTmp; - struct cb_literal *l; - unsigned char *p; - cb_tree loc; - long long val; - size_t i; - size_t is_numeric_edited = 0; - int src_scale_mod; - int dst_scale_mod; - int dst_size_mod; - int size; - int most_significant; - int least_significant; +int validate_move(cb_tree src, cb_tree dst, size_t is_value) +{ + struct cb_field *f; + struct cb_field *pTmp; + struct cb_literal *l; + unsigned char *p; + cb_tree loc; + long long val; + size_t i; + size_t is_numeric_edited = 0; + int src_scale_mod; + int dst_scale_mod; + int dst_size_mod; + int size; + int most_significant; + int least_significant; loc = src->source_line ? src : dst; - if (CB_REFERENCE_P (dst) && CB_ALPHABET_NAME_P (CB_REFERENCE (dst)->value)) { + if (CB_REFERENCE_P(dst) && CB_ALPHABET_NAME_P(CB_REFERENCE(dst)->value)) + { goto invalid; } - if (CB_REFERENCE_P (dst) && CB_FILE_P (CB_REFERENCE (dst)->value)) { + if (CB_REFERENCE_P(dst) && CB_FILE_P(CB_REFERENCE(dst)->value)) + { goto invalid; } - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_BOOLEAN) { - cb_error_x (loc, _("Invalid destination for MOVE")); + if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_BOOLEAN) + { + cb_error_x(loc, _("Invalid destination for MOVE")); return -1; } - if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) { - if (CB_TREE_CLASS (src) == CB_CLASS_POINTER) { + if (CB_TREE_CLASS(dst) == CB_CLASS_POINTER) + { + if (CB_TREE_CLASS(src) == CB_CLASS_POINTER) + { return 0; - } else { + } + else + { goto invalid; } } - f = cb_field (dst); - if (CB_TREE_TAG (dst) == CB_TAG_REFERENCE) { - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NATIONAL || - CB_TREE_CATEGORY (dst) == CB_CATEGORY_NATIONAL_EDITED) { - if (CB_REFERENCE (dst)->offset) { - switch (CB_TREE_CATEGORY (src)) { + f = cb_field(dst); + if (CB_TREE_TAG(dst) == CB_TAG_REFERENCE) + { + if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_NATIONAL || + CB_TREE_CATEGORY(dst) == CB_CATEGORY_NATIONAL_EDITED) + { + if (CB_REFERENCE(dst)->offset) + { + switch (CB_TREE_CATEGORY(src)) + { case CB_CATEGORY_ALPHABETIC: goto invalid; break; case CB_CATEGORY_NUMERIC: - if (CB_REFERENCE_P (src)) { - pTmp = CB_FIELD (cb_ref (src)); - if (CB_TREE (pTmp) != cb_error_node) { - if (pTmp->pic) { - if (pTmp->pic->category == CB_CATEGORY_NUMERIC) { - if (pTmp->pic->scale > 0) { + if (CB_REFERENCE_P(src)) + { + pTmp = CB_FIELD(cb_ref(src)); + if (CB_TREE(pTmp) != cb_error_node) + { + if (pTmp->pic) + { + if (pTmp->pic->category == CB_CATEGORY_NUMERIC) + { + if (pTmp->pic->scale > 0) + { goto invalid; } } @@ -4753,16 +5549,22 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) } } } - switch (CB_TREE_TAG (src)) { + switch (CB_TREE_TAG(src)) + { case CB_TAG_CONST: - if (src == cb_space) { - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC || - (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED && - !is_value)) { + if (src == cb_space) + { + if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_NUMERIC || + (CB_TREE_CATEGORY(dst) == CB_CATEGORY_NUMERIC_EDITED && + !is_value)) + { goto invalid; } - } else if (src == cb_zero) { - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHABETIC) { + } + else if (src == cb_zero) + { + if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_ALPHABETIC) + { goto invalid; } } @@ -4770,243 +5572,325 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) case CB_TAG_LITERAL: /* TODO: ALL literal */ - l = CB_LITERAL (src); - if (CB_TREE_CLASS (src) == CB_CLASS_NUMERIC) { + l = CB_LITERAL(src); + if (CB_TREE_CLASS(src) == CB_CLASS_NUMERIC) + { /* Numeric literal */ - if (l->all) { + if (l->all) + { goto invalid; } most_significant = -999; least_significant = 999; /* compute the most significant figure place */ - for (i = 0; i < l->size; i++) { - if (l->data[i] != '0') { + for (i = 0; i < l->size; i++) + { + if (l->data[i] != '0') + { break; } } - if (i != l->size) { - most_significant = (int) (l->size - l->scale - i - 1); + if (i != l->size) + { + most_significant = (int)(l->size - l->scale - i - 1); } /* compute the least significant figure place */ - for (i = 0; i < l->size; i++) { - if (l->data[l->size - i - 1] != '0') { + for (i = 0; i < l->size; i++) + { + if (l->data[l->size - i - 1] != '0') + { break; } } - if (i != l->size) { - least_significant = (int) (-l->scale + i); + if (i != l->size) + { + least_significant = (int)(-l->scale + i); } /* value check */ - switch (CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_NATIONAL: case CB_CATEGORY_NATIONAL_EDITED: - if (is_value) { + if (is_value) + { goto expect_national; } - if (l->scale == 0) { + if (l->scale == 0) + { goto expect_national; - } else { + } + else + { goto invalid; } case CB_CATEGORY_ALPHANUMERIC: case CB_CATEGORY_ALPHANUMERIC_EDITED: - if (is_value) { + if (is_value) + { goto expect_alphanumeric; } - if (l->scale == 0) { + if (l->scale == 0) + { goto expect_alphanumeric; - } else { + } + else + { goto invalid; } case CB_CATEGORY_NUMERIC: - if (f->pic->scale < 0) { + if (f->pic->scale < 0) + { /* check for PIC 9(n)P(m) */ - if (least_significant < -f->pic->scale) { + if (least_significant < -f->pic->scale) + { goto value_mismatch; } - } else if (f->pic->scale > f->pic->size) { + } + else if (f->pic->scale > f->pic->size) + { /* check for PIC P(n)9(m) */ - if (most_significant >= f->pic->size - f->pic->scale) { + if (most_significant >= f->pic->size - f->pic->scale) + { goto value_mismatch; } } break; case CB_CATEGORY_NUMERIC_EDITED: - if (is_value) { + if (is_value) + { goto expect_alphanumeric; } /* TODO */ break; default: - if (is_value) { + if (is_value) + { goto expect_alphanumeric; } goto invalid; } /* sign check */ - if (l->sign != 0 && !f->pic->have_sign) { - if (is_value) { - cb_error_x (loc, _("Data item not signed")); + if (l->sign != 0 && !f->pic->have_sign) + { + if (is_value) + { + cb_error_x(loc, _("Data item not signed")); return -1; } - if (cb_warn_constant) { - cb_warning_x (loc, _("Ignoring negative sign")); + if (cb_warn_constant) + { + cb_warning_x(loc, _("Ignoring negative sign")); } } /* size check */ - if (f->flag_real_binary || - ((f->usage == CB_USAGE_COMP_5 || - f->usage == CB_USAGE_COMP_X || - f->usage == CB_USAGE_BINARY) && - f->pic->scale == 0)) { + if (f->flag_real_binary || + ((f->usage == CB_USAGE_COMP_5 || + f->usage == CB_USAGE_COMP_X || + f->usage == CB_USAGE_BINARY) && + f->pic->scale == 0)) + { p = l->data; - for (i = 0; i < l->size; i++) { - if (l->data[i] != '0') { + for (i = 0; i < l->size; i++) + { + if (l->data[i] != '0') + { p = &l->data[i]; break; } } i = l->size - i; - switch (f->size) { + switch (f->size) + { case 1: - if (i > 18) { + if (i > 18) + { goto numlit_overflow; } - val = cb_get_long_long (src); - if (f->pic->have_sign) { + val = cb_get_long_long(src); + if (f->pic->have_sign) + { if (val < -128LL || - val > 127LL) { + val > 127LL) + { goto numlit_overflow; } - } else { - if (val > 255LL) { + } + else + { + if (val > 255LL) + { goto numlit_overflow; } } break; case 2: - if (i > 18) { + if (i > 18) + { goto numlit_overflow; } - val = cb_get_long_long (src); - if (f->pic->have_sign) { + val = cb_get_long_long(src); + if (f->pic->have_sign) + { if (val < -32768LL || - val > 32767LL) { + val > 32767LL) + { goto numlit_overflow; } - } else { - if (val > 65535LL) { + } + else + { + if (val > 65535LL) + { goto numlit_overflow; } } break; case 3: - if (i > 18) { + if (i > 18) + { goto numlit_overflow; } - val = cb_get_long_long (src); - if (f->pic->have_sign) { + val = cb_get_long_long(src); + if (f->pic->have_sign) + { if (val < -8388608LL || - val > 8388607LL) { + val > 8388607LL) + { goto numlit_overflow; } - } else { - if (val > 16777215LL) { + } + else + { + if (val > 16777215LL) + { goto numlit_overflow; } } break; case 4: - if (i > 18) { + if (i > 18) + { goto numlit_overflow; } - val = cb_get_long_long (src); - if (f->pic->have_sign) { + val = cb_get_long_long(src); + if (f->pic->have_sign) + { if (val < -2147483648LL || - val > 2147483647LL) { + val > 2147483647LL) + { goto numlit_overflow; } - } else { - if (val > 4294967295LL) { + } + else + { + if (val > 4294967295LL) + { goto numlit_overflow; } } break; case 5: - if (i > 18) { + if (i > 18) + { goto numlit_overflow; } - val = cb_get_long_long (src); - if (f->pic->have_sign) { + val = cb_get_long_long(src); + if (f->pic->have_sign) + { if (val < -549755813888LL || - val > 549755813887LL) { + val > 549755813887LL) + { goto numlit_overflow; } - } else { - if (val > 1099511627775LL) { + } + else + { + if (val > 1099511627775LL) + { goto numlit_overflow; } } break; case 6: - if (i > 18) { + if (i > 18) + { goto numlit_overflow; } - val = cb_get_long_long (src); - if (f->pic->have_sign) { + val = cb_get_long_long(src); + if (f->pic->have_sign) + { if (val < -140737488355328LL || - val > 140737488355327LL) { + val > 140737488355327LL) + { goto numlit_overflow; } - } else { - if (val > 281474976710655LL) { + } + else + { + if (val > 281474976710655LL) + { goto numlit_overflow; } } break; case 7: - if (i > 18) { + if (i > 18) + { goto numlit_overflow; } - val = cb_get_long_long (src); - if (f->pic->have_sign) { + val = cb_get_long_long(src); + if (f->pic->have_sign) + { if (val < -36028797018963968LL || - val > 36028797018963967LL) { + val > 36028797018963967LL) + { goto numlit_overflow; } - } else { - if (val > 72057594037927935LL) { + } + else + { + if (val > 72057594037927935LL) + { goto numlit_overflow; } } break; default: - if (f->pic->have_sign) { - if (i < 19) { + if (f->pic->have_sign) + { + if (i < 19) + { break; } - if (i > 19) { + if (i > 19) + { goto numlit_overflow; } - if (memcmp (p, "9223372036854775807", 19) > 0) { + if (memcmp(p, "9223372036854775807", 19) > 0) + { goto numlit_overflow; } - } else { - if (i < 20) { + } + else + { + if (i < 20) + { break; } - if (i > 20) { + if (i > 20) + { goto numlit_overflow; } - if (memcmp (p, "18446744073709551615", 20) > 0) { + if (memcmp(p, "18446744073709551615", 20) > 0) + { goto numlit_overflow; } } @@ -5014,24 +5898,33 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) } return 0; } - if (least_significant < -f->pic->scale) { + if (least_significant < -f->pic->scale) + { goto size_overflow; } - if (f->pic->scale > 0) { + if (f->pic->scale > 0) + { size = f->pic->digits - f->pic->scale; - } else { + } + else + { size = f->pic->digits; } - if (most_significant >= size) { + if (most_significant >= size) + { goto size_overflow; } - } else { + } + else + { /* Alphanumeric literal */ /* value check */ - switch (CB_TREE_CATEGORY (src)) { + switch (CB_TREE_CATEGORY(src)) + { case CB_CATEGORY_NATIONAL: - switch(CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: @@ -5040,10 +5933,13 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) break; } default: - switch (CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_ALPHABETIC: - for (i = 0; i < l->size; i++) { - if (!isalpha (l->data[i]) && !isspace (l->data[i])) { + for (i = 0; i < l->size; i++) + { + if (!isalpha(l->data[i]) && !isspace(l->data[i])) + { goto value_mismatch; } } @@ -5051,7 +5947,8 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) case CB_CATEGORY_NUMERIC: goto expect_numeric; case CB_CATEGORY_NUMERIC_EDITED: - if (!is_value) { + if (!is_value) + { goto expect_numeric; } @@ -5063,22 +5960,28 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) } /* size check */ - size = cb_field_size (dst); -#ifdef I18N_UTF8 - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NATIONAL) { + size = cb_field_size(dst); +#ifdef I18N_UTF8 + if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_NATIONAL) + { /* I18N_UTF8: check in converted length. */ - i = utf8_national_length (l->data, l->size); - if ((int)i < 0) { + i = utf8_national_length(l->data, l->size); + if ((int)i < 0) + { goto invalid_national; } - if (size >= 0 && i > size) { + if (size >= 0 && i > size) + { goto size_overflow; } - } else if (size >= 0 && (int)l->size > size) { + } + else if (size >= 0 && (int)l->size > size) + { goto size_overflow; } -#else /*!I18N_UTF8*/ - if (size >= 0 && (int)l->size > size) { +#else /*!I18N_UTF8*/ + if (size >= 0 && (int)l->size > size) + { goto size_overflow; } #endif /*I18N_UTF8*/ @@ -5086,52 +5989,63 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) break; case CB_TAG_FIELD: case CB_TAG_REFERENCE: - if (CB_REFERENCE_P (src) && - CB_ALPHABET_NAME_P (CB_REFERENCE (src)->value)) { + if (CB_REFERENCE_P(src) && + CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) + { break; } - if (CB_REFERENCE_P (src) && - CB_FILE_P (CB_REFERENCE (src)->value)) { + if (CB_REFERENCE_P(src) && + CB_FILE_P(CB_REFERENCE(src)->value)) + { goto invalid; } - size = cb_field_size (src); - if (size < 0) { - size = cb_field (src)->size; + size = cb_field_size(src); + if (size < 0) + { + size = cb_field(src)->size; } /* non-elementary move */ - if (cb_field (src)->children || cb_field (dst)->children) { - if (size > cb_field (dst)->size) { + if (cb_field(src)->children || cb_field(dst)->children) + { + if (size > cb_field(dst)->size) + { goto size_overflow_1; } break; } /* elementary move */ - switch (CB_TREE_CATEGORY (src)) { + switch (CB_TREE_CATEGORY(src)) + { case CB_CATEGORY_ALPHANUMERIC: - switch (CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - if (size > cb_field (dst)->pic->digits) { + if (size > cb_field(dst)->pic->digits) + { goto size_overflow_2; } break; case CB_CATEGORY_ALPHANUMERIC_EDITED: case CB_CATEGORY_NATIONAL_EDITED: if (size > - count_pic_alphanumeric_edited (cb_field (dst))) { + count_pic_alphanumeric_edited(cb_field(dst))) + { goto size_overflow_1; } break; default: - if (size > cb_field (dst)->size) { + if (size > cb_field(dst)->size) + { goto size_overflow_1; } break; } break; case CB_CATEGORY_NATIONAL: - switch (CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: @@ -5139,12 +6053,14 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) case CB_CATEGORY_ALPHANUMERIC_EDITED: case CB_CATEGORY_NATIONAL_EDITED: if (size > - count_pic_alphanumeric_edited (cb_field (dst))) { + count_pic_alphanumeric_edited(cb_field(dst))) + { goto size_overflow_1; } break; default: - if (size > cb_field (dst)->size) { + if (size > cb_field(dst)->size) + { goto size_overflow_1; } break; @@ -5152,135 +6068,150 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) break; case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC_EDITED: - switch (CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: goto invalid; case CB_CATEGORY_ALPHANUMERIC_EDITED: if (size > - count_pic_alphanumeric_edited(cb_field (dst))) { + count_pic_alphanumeric_edited(cb_field(dst))) + { goto size_overflow_1; } break; default: - if (size > cb_field (dst)->size) { + if (size > cb_field(dst)->size) + { goto size_overflow_1; } break; } break; case CB_CATEGORY_NATIONAL_EDITED: - switch (CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: goto invalid; case CB_CATEGORY_ALPHANUMERIC_EDITED: if (size > - count_pic_alphanumeric_edited (cb_field (dst))) { + count_pic_alphanumeric_edited(cb_field(dst))) + { goto size_overflow_1; } break; default: - if (size > cb_field (dst)->size) { + if (size > cb_field(dst)->size) + { goto size_overflow_1; } break; } break; case CB_CATEGORY_NUMERIC: - switch (CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_ALPHABETIC: goto invalid; case CB_CATEGORY_ALPHANUMERIC_EDITED: is_numeric_edited = 1; /* Drop through */ case CB_CATEGORY_ALPHANUMERIC: - if (is_numeric_edited) { - dst_size_mod = count_pic_alphanumeric_edited (cb_field (dst)); - } else { - dst_size_mod = cb_field (dst)->size; - } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC - && cb_field (src)->pic->scale > 0) { - if (cb_move_noninteger_to_alphanumeric == CB_ERROR) { + if (is_numeric_edited) + { + dst_size_mod = count_pic_alphanumeric_edited(cb_field(dst)); + } + else + { + dst_size_mod = cb_field(dst)->size; + } + if (CB_TREE_CATEGORY(src) == CB_CATEGORY_NUMERIC && cb_field(src)->pic->scale > 0) + { + if (cb_move_noninteger_to_alphanumeric == CB_ERROR) + { goto invalid; } - cb_warning_x (loc, _("Move non-integer to alphanumeric")); + cb_warning_x(loc, _("Move non-integer to alphanumeric")); break; } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC - && cb_field (src)->pic->digits > dst_size_mod) { + if (CB_TREE_CATEGORY(src) == CB_CATEGORY_NUMERIC && cb_field(src)->pic->digits > dst_size_mod) + { goto size_overflow_2; } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC_EDITED - && cb_field (src)->size > dst_size_mod) { + if (CB_TREE_CATEGORY(src) == CB_CATEGORY_NUMERIC_EDITED && cb_field(src)->size > dst_size_mod) + { goto size_overflow_1; } break; case CB_CATEGORY_NATIONAL_EDITED: case CB_CATEGORY_NATIONAL: - if (cb_field (src)->pic->scale > 0) { + if (cb_field(src)->pic->scale > 0) + { goto invalid; } default: - src_scale_mod = cb_field (src)->pic->scale < 0 ? - 0 : cb_field (src)->pic->scale; - dst_scale_mod = cb_field (dst)->pic->scale < 0 ? - 0 : cb_field (dst)->pic->scale; - if (cb_field (src)->pic->digits - src_scale_mod > - cb_field (dst)->pic->digits - dst_scale_mod || - src_scale_mod > dst_scale_mod) { + src_scale_mod = cb_field(src)->pic->scale < 0 ? 0 : cb_field(src)->pic->scale; + dst_scale_mod = cb_field(dst)->pic->scale < 0 ? 0 : cb_field(dst)->pic->scale; + if (cb_field(src)->pic->digits - src_scale_mod > + cb_field(dst)->pic->digits - dst_scale_mod || + src_scale_mod > dst_scale_mod) + { goto size_overflow_2; } break; } break; case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_TREE_CATEGORY (dst)) { + switch (CB_TREE_CATEGORY(dst)) + { case CB_CATEGORY_ALPHABETIC: goto invalid; case CB_CATEGORY_ALPHANUMERIC_EDITED: is_numeric_edited = 1; /* Drop through */ case CB_CATEGORY_ALPHANUMERIC: - if (is_numeric_edited) { - dst_size_mod = count_pic_alphanumeric_edited (cb_field (dst)); - } else { - dst_size_mod = cb_field (dst)->size; - } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC - && cb_field (src)->pic->scale > 0) { - if (cb_move_noninteger_to_alphanumeric == CB_ERROR) { + if (is_numeric_edited) + { + dst_size_mod = count_pic_alphanumeric_edited(cb_field(dst)); + } + else + { + dst_size_mod = cb_field(dst)->size; + } + if (CB_TREE_CATEGORY(src) == CB_CATEGORY_NUMERIC && cb_field(src)->pic->scale > 0) + { + if (cb_move_noninteger_to_alphanumeric == CB_ERROR) + { goto invalid; } - cb_warning_x (loc, _("Move non-integer to alphanumeric")); + cb_warning_x(loc, _("Move non-integer to alphanumeric")); break; } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC - && cb_field (src)->pic->digits > dst_size_mod) { + if (CB_TREE_CATEGORY(src) == CB_CATEGORY_NUMERIC && cb_field(src)->pic->digits > dst_size_mod) + { goto size_overflow_2; } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC_EDITED - && cb_field (src)->size > dst_size_mod) { + if (CB_TREE_CATEGORY(src) == CB_CATEGORY_NUMERIC_EDITED && cb_field(src)->size > dst_size_mod) + { goto size_overflow_1; } break; default: - src_scale_mod = cb_field (src)->pic->scale < 0 ? - 0 : cb_field (src)->pic->scale; - dst_scale_mod = cb_field (dst)->pic->scale < 0 ? - 0 : cb_field (dst)->pic->scale; - if (cb_field (src)->pic->digits - src_scale_mod > - cb_field (dst)->pic->digits - dst_scale_mod || - src_scale_mod > dst_scale_mod) { + src_scale_mod = cb_field(src)->pic->scale < 0 ? 0 : cb_field(src)->pic->scale; + dst_scale_mod = cb_field(dst)->pic->scale < 0 ? 0 : cb_field(dst)->pic->scale; + if (cb_field(src)->pic->digits - src_scale_mod > + cb_field(dst)->pic->digits - dst_scale_mod || + src_scale_mod > dst_scale_mod) + { goto size_overflow_2; } break; } break; default: - cb_error_x (loc, _("Invalid source for MOVE")); + cb_error_x(loc, _("Invalid source for MOVE")); return -1; } break; @@ -5290,139 +6221,158 @@ validate_move (cb_tree src, cb_tree dst, size_t is_value) /* TODO: check this */ break; default: - fprintf (stderr, "Invalid tree tag %d\n", CB_TREE_TAG (src)); - goto invalid; /* don't ABORT (), continue parsing */ + fprintf(stderr, "Invalid tree tag %d\n", CB_TREE_TAG(src)); + goto invalid; /* don't ABORT (), continue parsing */ } return 0; invalid: - if (is_value) { - cb_error_x (loc, _("Invalid VALUE clause")); - } else { - //cb_error_x (loc, _("Invalid MOVE statement")); + if (is_value) + { + cb_error_x(loc, _("Invalid VALUE clause")); + } + else + { + // cb_error_x (loc, _("Invalid MOVE statement")); return 0; } return -1; numlit_overflow: - if (is_value) { - cb_error_x (loc, _("Invalid VALUE clause - literal exceeds data size")); + if (is_value) + { + cb_error_x(loc, _("Invalid VALUE clause - literal exceeds data size")); return -1; } - if (cb_warn_constant) { - cb_warning_x (loc, _("Numeric literal exceeds data size")); + if (cb_warn_constant) + { + cb_warning_x(loc, _("Numeric literal exceeds data size")); } return 0; expect_numeric: - if (cb_enable_expect_numeric_error) { - return move_error2 (src, dst, is_value, 1, 0, - _("Numeric value is expected")); + if (cb_enable_expect_numeric_error) + { + return move_error2(src, dst, is_value, 1, 0, + _("Numeric value is expected")); } - return move_error (src, dst, is_value, cb_warn_strict_typing, 0, - _("Numeric value is expected")); + return move_error(src, dst, is_value, cb_warn_strict_typing, 0, + _("Numeric value is expected")); expect_alphanumeric: - return move_error (src, dst, is_value, cb_warn_strict_typing, 0, - _("Alphanumeric value is expected")); + return move_error(src, dst, is_value, cb_warn_strict_typing, 0, + _("Alphanumeric value is expected")); expect_national: - return move_error (src, dst, is_value, cb_warn_strict_typing, 0, - _("National value is expected")); + return move_error(src, dst, is_value, cb_warn_strict_typing, 0, + _("National value is expected")); value_mismatch: - return move_error (src, dst, is_value, cb_warn_constant, 0, - _("Value does not fit the picture string")); + return move_error(src, dst, is_value, cb_warn_constant, 0, + _("Value does not fit the picture string")); size_overflow: - return move_error (src, dst, is_value, cb_warn_constant, 0, - _("Value size exceeds data size")); + return move_error(src, dst, is_value, cb_warn_constant, 0, + _("Value size exceeds data size")); size_overflow_1: - return move_error (src, dst, is_value, cb_warn_truncate, 1, - _("Sending field larger than receiving field")); + return move_error(src, dst, is_value, cb_warn_truncate, 1, + _("Sending field larger than receiving field")); size_overflow_2: - return move_error (src, dst, is_value, cb_warn_truncate, 1, - _("Some digits may be truncated")); - -#ifdef I18N_UTF8 + return move_error(src, dst, is_value, cb_warn_truncate, 1, + _("Some digits may be truncated")); + +#ifdef I18N_UTF8 invalid_national: - return move_error (src, dst, is_value, cb_warn_constant, 1, - _("Invalid NATIONAL string.")); + return move_error(src, dst, is_value, cb_warn_constant, 1, + _("Invalid NATIONAL string.")); #endif /*I18N_UTF8*/ } static cb_tree -cb_build_memset (cb_tree x, int c) +cb_build_memset(cb_tree x, int c) { - int size = cb_field_size (x); + int size = cb_field_size(x); - if (cb_field (x)->pic) { - if (cb_field (x)->pic->national == 1) { - return cb_build_funcall_2 ("cob_la_memset", x, cb_int (c)); + if (cb_field(x)->pic) + { + if (cb_field(x)->pic->national == 1) + { + return cb_build_funcall_2("cob_la_memset", x, cb_int(c)); } } - if (size == 1) { - return cb_build_funcall_2 ("$E", x, cb_int (c)); - } else { - return cb_build_method_call_3 ("fillBytes", - cb_build_cast_address (x), - cb_int (c), cb_build_cast_length (x)); + if (size == 1) + { + return cb_build_funcall_2("$E", x, cb_int(c)); + } + else + { + return cb_build_method_call_3("fillBytes", + cb_build_cast_address(x), + cb_int(c), cb_build_cast_length(x)); } } static cb_tree -cb_build_move_copy (cb_tree src, cb_tree dst) +cb_build_move_copy(cb_tree src, cb_tree dst) { - int size = cb_field_size (dst); + int size = cb_field_size(dst); - if (size == 1) { - return cb_build_funcall_2 ("$F", dst, src); - } else { - return cb_build_method_call_3 ("setBytes", - cb_build_cast_address (dst), - cb_build_cast_address (src), cb_build_cast_length (dst)); + if (size == 1) + { + return cb_build_funcall_2("$F", dst, src); + } + else + { + return cb_build_method_call_3("setBytes", + cb_build_cast_address(dst), + cb_build_cast_address(src), cb_build_cast_length(dst)); } } static cb_tree -cb_build_move_call (cb_tree src, cb_tree dst) +cb_build_move_call(cb_tree src, cb_tree dst) { - return cb_build_method_call_2 ("moveFrom", dst, src); + return cb_build_method_call_2("moveFrom", dst, src); } static cb_tree -cb_build_move_num_zero (cb_tree x) +cb_build_move_num_zero(cb_tree x) { - struct cb_field *f; + struct cb_field *f; - f = cb_field (x); - switch (f->usage) { + f = cb_field(x); + switch (f->usage) + { case CB_USAGE_BINARY: case CB_USAGE_COMP_5: case CB_USAGE_COMP_X: - if (f->flag_binary_swap) { - return cb_build_memset (x, 0); + if (f->flag_binary_swap) + { + return cb_build_memset(x, 0); } - switch (f->size) { -#ifdef COB_NON_ALIGNED + switch (f->size) + { +#ifdef COB_NON_ALIGNED case 1: - return cb_build_assign (x, cb_int0); + return cb_build_assign(x, cb_int0); case 2: -#ifdef COB_SHORT_BORK +#ifdef COB_SHORT_BORK if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && - (f->offset % 4 == 0)) { - return cb_build_assign (x, cb_int0); + (f->offset % 4 == 0)) + { + return cb_build_assign(x, cb_int0); } break; #endif case 4: case 8: if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && - (f->offset % f->size == 0)) { - return cb_build_assign (x, cb_int0); + (f->offset % f->size == 0)) + { + return cb_build_assign(x, cb_int0); } break; #else @@ -5430,122 +6380,142 @@ cb_build_move_num_zero (cb_tree x) case 2: case 4: case 8: - return cb_build_assign (x, cb_int0); + return cb_build_assign(x, cb_int0); #endif } - return cb_build_memset (x, 0); + return cb_build_memset(x, 0); case CB_USAGE_DISPLAY: - if (f->flag_sign_separate) { - return cb_build_move_call (cb_zero, x); - } else if (cb_display_sign == COB_DISPLAY_SIGN_EBCDIC - && f->pic->have_sign) { - return cb_build_move_call (cb_zero, x); - } else { - return cb_build_memset (x, '0'); + if (f->flag_sign_separate) + { + return cb_build_move_call(cb_zero, x); + } + else if (cb_display_sign == COB_DISPLAY_SIGN_EBCDIC && f->pic->have_sign) + { + return cb_build_move_call(cb_zero, x); + } + else + { + return cb_build_memset(x, '0'); } case CB_USAGE_PACKED: - return cb_build_method_call_1 ("setZero", x); + return cb_build_method_call_1("setZero", x); default: - return cb_build_move_call (cb_zero, x); + return cb_build_move_call(cb_zero, x); } } static cb_tree -cb_build_move_space (cb_tree x) +cb_build_move_space(cb_tree x) { - switch (CB_TREE_CATEGORY (x)) { + switch (CB_TREE_CATEGORY(x)) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: - return cb_build_memset (x, ' '); + return cb_build_memset(x, ' '); default: - return cb_build_move_call (cb_space, x); + return cb_build_move_call(cb_space, x); } } static cb_tree -cb_build_move_blank (cb_tree x) +cb_build_move_blank(cb_tree x) { - switch (CB_TREE_CATEGORY (x)) { + switch (CB_TREE_CATEGORY(x)) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: - return cb_build_memset (x, ' '); + return cb_build_memset(x, ' '); default: - return cb_build_move_call (cb_blank, x); + return cb_build_move_call(cb_blank, x); } } static cb_tree -cb_build_move_zero (cb_tree x) +cb_build_move_zero(cb_tree x) { - switch (CB_TREE_CATEGORY (x)) { + switch (CB_TREE_CATEGORY(x)) + { case CB_CATEGORY_NUMERIC: - if (cb_field (x)->flag_blank_zero) { - return cb_build_move_space (x); - } else { - return cb_build_move_num_zero (x); + if (cb_field(x)->flag_blank_zero) + { + return cb_build_move_space(x); + } + else + { + return cb_build_move_num_zero(x); } case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: - return cb_build_memset (x, '0'); + return cb_build_memset(x, '0'); default: - return cb_build_move_call (cb_zero, x); + return cb_build_move_call(cb_zero, x); } } static cb_tree -cb_build_move_high (cb_tree x) +cb_build_move_high(cb_tree x) { - switch (CB_TREE_CATEGORY (x)) { + switch (CB_TREE_CATEGORY(x)) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: - if (cb_high == cb_norm_high) { - return cb_build_memset (x, 255); - } else { - return cb_build_move_call (cb_high, x); + if (cb_high == cb_norm_high) + { + return cb_build_memset(x, 255); + } + else + { + return cb_build_move_call(cb_high, x); } default: - return cb_build_move_call (cb_high, x); + return cb_build_move_call(cb_high, x); } } static cb_tree -cb_build_move_low (cb_tree x) +cb_build_move_low(cb_tree x) { - switch (CB_TREE_CATEGORY (x)) { + switch (CB_TREE_CATEGORY(x)) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: - if (cb_low == cb_norm_low) { - return cb_build_memset (x, 0); - } else { - return cb_build_move_call (cb_low, x); + if (cb_low == cb_norm_low) + { + return cb_build_memset(x, 0); + } + else + { + return cb_build_move_call(cb_low, x); } default: - return cb_build_move_call (cb_low, x); + return cb_build_move_call(cb_low, x); } } static cb_tree -cb_build_move_quote (cb_tree x) +cb_build_move_quote(cb_tree x) { - switch (CB_TREE_CATEGORY (x)) { + switch (CB_TREE_CATEGORY(x)) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: - return cb_build_memset (x, '"'); + return cb_build_memset(x, '"'); default: - return cb_build_move_call (cb_quote, x); + return cb_build_move_call(cb_quote, x); } } -#ifdef COB_EBCDIC_MACHINE +#ifdef COB_EBCDIC_MACHINE static void -cob_put_sign_ascii (unsigned char *p) +cob_put_sign_ascii(unsigned char *p) { - switch (*p) { + switch (*p) + { case '0': *p = (unsigned char)'p'; return; @@ -5581,10 +6551,12 @@ cob_put_sign_ascii (unsigned char *p) #endif static void -cob_put_sign_ebcdic (unsigned char *p, const int sign) +cob_put_sign_ebcdic(unsigned char *p, const int sign) { - if (sign < 0) { - switch (*p) { + if (sign < 0) + { + switch (*p) + { case '0': *p = (unsigned char)'}'; return; @@ -5621,7 +6593,8 @@ cob_put_sign_ebcdic (unsigned char *p, const int sign) return; } } - switch (*p) { + switch (*p) + { case '0': *p = (unsigned char)'{'; return; @@ -5657,255 +6630,303 @@ cob_put_sign_ebcdic (unsigned char *p, const int sign) *p = (unsigned char)'{'; return; } -/* NOT REACHED */ + /* NOT REACHED */ } static cb_tree -cb_build_move_literal (cb_tree src, cb_tree dst) -{ - struct cb_literal *l; - struct cb_field *f; - unsigned char *buff; - unsigned char *p; - enum cb_category cat; - int i; - int diff; - int val; - int n; - unsigned char bbyte; - - l = CB_LITERAL (src); - f = cb_field (dst); - cat = CB_TREE_CATEGORY (dst); - - if (l->all) { - if (cat == CB_CATEGORY_NUMERIC || cat == CB_CATEGORY_NUMERIC_EDITED) { - return cb_build_move_call (src, dst); - } else if (cat == CB_CATEGORY_NATIONAL_EDITED || cat == CB_CATEGORY_NATIONAL) { - return cb_build_move_call (src, dst); - } else if (cat == CB_CATEGORY_ALPHANUMERIC || cat == CB_CATEGORY_ALPHANUMERIC_EDITED) { - return cb_build_move_call (src, dst); - } - if (l->size == 1) { - return cb_build_method_call_3 ("fillBytes", - cb_build_cast_address (dst), - cb_int (l->data[0]), cb_build_cast_length (dst)); +cb_build_move_literal(cb_tree src, cb_tree dst) +{ + struct cb_literal *l; + struct cb_field *f; + unsigned char *buff; + unsigned char *p; + enum cb_category cat; + int i; + int diff; + int val; + int n; + unsigned char bbyte; + + l = CB_LITERAL(src); + f = cb_field(dst); + cat = CB_TREE_CATEGORY(dst); + + if (l->all) + { + if (cat == CB_CATEGORY_NUMERIC || cat == CB_CATEGORY_NUMERIC_EDITED) + { + return cb_build_move_call(src, dst); + } + else if (cat == CB_CATEGORY_NATIONAL_EDITED || cat == CB_CATEGORY_NATIONAL) + { + return cb_build_move_call(src, dst); + } + else if (cat == CB_CATEGORY_ALPHANUMERIC || cat == CB_CATEGORY_ALPHANUMERIC_EDITED) + { + return cb_build_move_call(src, dst); + } + if (l->size == 1) + { + return cb_build_method_call_3("fillBytes", + cb_build_cast_address(dst), + cb_int(l->data[0]), cb_build_cast_length(dst)); } bbyte = l->data[0]; - for (i = 0; i < (int)l->size; i++) { - if (bbyte != l->data[i]) { + for (i = 0; i < (int)l->size; i++) + { + if (bbyte != l->data[i]) + { break; } bbyte = l->data[i]; } - if (i == (int)l->size) { - return cb_build_method_call_3 ("fillBytes", - cb_build_cast_address (dst), - cb_int (l->data[0]), cb_build_cast_length (dst)); + if (i == (int)l->size) + { + return cb_build_method_call_3("fillBytes", + cb_build_cast_address(dst), + cb_int(l->data[0]), cb_build_cast_length(dst)); } - if (f->size > 128) { - return cb_build_move_call (src, dst); + if (f->size > 128) + { + return cb_build_move_call(src, dst); } - buff = cobc_malloc ((size_t)f->size); - for (i = 0; i < f->size; i++) { + buff = cobc_malloc((size_t)f->size); + for (i = 0; i < f->size; i++) + { buff[i] = l->data[i % l->size]; } -#ifdef I18N_UTF8 +#ifdef I18N_UTF8 /* I18N_UTF8: termination of multi octet charactrer sequence is pending. */ -#else /*!I18N_UTF8*/ - if ((0x81 <= buff[i-1] && buff[i-1] <= 0x9F) || - (0xE0 <= buff[i-1] && buff[i-1] <= 0xFC)) { - buff[i-1] = ' '; +#else /*!I18N_UTF8*/ + if ((0x81 <= buff[i - 1] && buff[i - 1] <= 0x9F) || + (0xE0 <= buff[i - 1] && buff[i - 1] <= 0xFC)) + { + buff[i - 1] = ' '; } #endif /*I18N_UTF8*/ - return cb_build_method_call_3 ("setBytes", - cb_build_cast_address (dst), - cb_build_string (buff, f->size), cb_build_cast_length (dst)); - } else if ((cat == CB_CATEGORY_NUMERIC - && f->usage == CB_USAGE_DISPLAY - && f->pic->scale == l->scale && !f->flag_sign_leading && !f->flag_sign_separate) - || ((cat == CB_CATEGORY_ALPHABETIC || cat == CB_CATEGORY_ALPHANUMERIC) - && f->size < (int) (l->size + 16) && !cb_field_variable_size (f))) { - buff = cobc_malloc ((size_t)f->size); - diff = (int) (f->size - l->size); - if (cat == CB_CATEGORY_NUMERIC) { - if (diff <= 0) { - memcpy (buff, l->data - diff, (size_t)f->size); - } else { - memset (buff, '0', (size_t)diff); - memcpy (buff + diff, l->data, (size_t)l->size); - } - if (f->pic->have_sign) { + return cb_build_method_call_3("setBytes", + cb_build_cast_address(dst), + cb_build_string(buff, f->size), cb_build_cast_length(dst)); + } + else if ((cat == CB_CATEGORY_NUMERIC && f->usage == CB_USAGE_DISPLAY && f->pic->scale == l->scale && !f->flag_sign_leading && !f->flag_sign_separate) || ((cat == CB_CATEGORY_ALPHABETIC || cat == CB_CATEGORY_ALPHANUMERIC) && f->size < (int)(l->size + 16) && !cb_field_variable_size(f))) + { + buff = cobc_malloc((size_t)f->size); + diff = (int)(f->size - l->size); + if (cat == CB_CATEGORY_NUMERIC) + { + if (diff <= 0) + { + memcpy(buff, l->data - diff, (size_t)f->size); + } + else + { + memset(buff, '0', (size_t)diff); + memcpy(buff + diff, l->data, (size_t)l->size); + } + if (f->pic->have_sign) + { p = &buff[f->size - 1]; - if (cb_display_sign) { - cob_put_sign_ebcdic (p, l->sign); - } else if (l->sign < 0) { -#ifdef COB_EBCDIC_MACHINE - cob_put_sign_ascii (p); + if (cb_display_sign) + { + cob_put_sign_ebcdic(p, l->sign); + } + else if (l->sign < 0) + { +#ifdef COB_EBCDIC_MACHINE + cob_put_sign_ascii(p); #else *p += 0x40; #endif } } - } else { - if (f->flag_justified) { - if (diff <= 0) { - memcpy (buff, l->data - diff, (size_t)f->size); - } else { - memset (buff, ' ', (size_t)diff); - memcpy (buff + diff, l->data, (size_t)l->size); + } + else + { + if (f->flag_justified) + { + if (diff <= 0) + { + memcpy(buff, l->data - diff, (size_t)f->size); } - } else { - if (diff <= 0) { - memcpy (buff, l->data, (size_t)f->size); - } else { - memcpy (buff, l->data, (size_t)l->size); - memset (buff + l->size, ' ', (size_t)diff); + else + { + memset(buff, ' ', (size_t)diff); + memcpy(buff + diff, l->data, (size_t)l->size); + } + } + else + { + if (diff <= 0) + { + memcpy(buff, l->data, (size_t)f->size); + } + else + { + memcpy(buff, l->data, (size_t)l->size); + memset(buff + l->size, ' ', (size_t)diff); } } } bbyte = *buff; - if (f->size == 1) { - free (buff); - return cb_build_funcall_2 ("$E", dst, cb_int (bbyte)); - } - for (i = 0; i < f->size; i++) { - if (bbyte != buff[i]) { + if (f->size == 1) + { + free(buff); + return cb_build_funcall_2("$E", dst, cb_int(bbyte)); + } + for (i = 0; i < f->size; i++) + { + if (bbyte != buff[i]) + { break; } } - if (i == f->size) { - free (buff); - return cb_build_method_call_3 ("fillBytes", - cb_build_cast_address (dst), - cb_int (bbyte), cb_build_cast_length (dst)); - } - return cb_build_method_call_3 ("setBytes", - cb_build_cast_address (dst), - cb_build_string (buff, f->size), - cb_build_cast_length (dst)); - } else if (cb_fits_int (src) && f->size <= 8 && - (f->usage == CB_USAGE_BINARY || f->usage == CB_USAGE_COMP_5 || - f->usage == CB_USAGE_COMP_X)) { - val = cb_get_int (src); + if (i == f->size) + { + free(buff); + return cb_build_method_call_3("fillBytes", + cb_build_cast_address(dst), + cb_int(bbyte), cb_build_cast_length(dst)); + } + return cb_build_method_call_3("setBytes", + cb_build_cast_address(dst), + cb_build_string(buff, f->size), + cb_build_cast_length(dst)); + } + else if (cb_fits_int(src) && f->size <= 8 && + (f->usage == CB_USAGE_BINARY || f->usage == CB_USAGE_COMP_5 || + f->usage == CB_USAGE_COMP_X)) + { + val = cb_get_int(src); n = f->pic->scale - l->scale; - if ((l->size + n) > 9) { - return cb_build_move_call (src, dst); + if ((l->size + n) > 9) + { + return cb_build_move_call(src, dst); } - for (; n > 0; n--) { + for (; n > 0; n--) + { val *= 10; } - for (; n < 0; n++) { + for (; n < 0; n++) + { val /= 10; } - if (val == 0) { - return cb_build_move_num_zero (dst); + if (val == 0) + { + return cb_build_move_num_zero(dst); } - if (f->size == 1) { - return cb_build_assign (dst, cb_int (val)); + if (f->size == 1) + { + return cb_build_assign(dst, cb_int(val)); } - if (f->flag_binary_swap) { + if (f->flag_binary_swap) + { i = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0)); - return cb_build_method_call_2 (bin_set_funcs[i], - cb_build_cast_address (dst), - cb_int (val)); - + return cb_build_method_call_2(bin_set_funcs[i], + cb_build_cast_address(dst), + cb_int(val)); } - switch (f->size) { + switch (f->size) + { case 2: -#ifdef COB_SHORT_BORK +#ifdef COB_SHORT_BORK if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && - (f->offset % 4 == 0)) { - return cb_build_assign (dst, cb_int (val)); + (f->offset % 4 == 0)) + { + return cb_build_assign(dst, cb_int(val)); } break; #endif case 4: case 8: -#ifdef COB_NON_ALIGNED +#ifdef COB_NON_ALIGNED if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && - (f->offset % f->size == 0)) { - return cb_build_assign (dst, cb_int (val)); + (f->offset % f->size == 0)) + { + return cb_build_assign(dst, cb_int(val)); } break; #else - return cb_build_assign (dst, cb_int (val)); + return cb_build_assign(dst, cb_int(val)); #endif } - return cb_build_move_call (src, dst); - } else if (cb_fits_int (src) && f->usage == CB_USAGE_PACKED) { - if (f->pic->scale < 0) { - return cb_build_move_call (src, dst); + return cb_build_move_call(src, dst); + } + else if (cb_fits_int(src) && f->usage == CB_USAGE_PACKED) + { + if (f->pic->scale < 0) + { + return cb_build_move_call(src, dst); } - val = cb_get_int (src); + val = cb_get_int(src); n = f->pic->scale - l->scale; - if ((l->size + n) > 9) { - return cb_build_move_call (src, dst); + if ((l->size + n) > 9) + { + return cb_build_move_call(src, dst); } - for (; n > 0; n--) { + for (; n > 0; n--) + { val *= 10; } - for (; n < 0; n++) { + for (; n < 0; n++) + { val /= 10; } - if (val == 0) { - return cb_build_move_num_zero (dst); + if (val == 0) + { + return cb_build_move_num_zero(dst); } - return cb_build_method_call_2("moveFrom", dst, cb_int (val)); - } else { - return cb_build_move_call (src, dst); + return cb_build_method_call_2("moveFrom", dst, cb_int(val)); + } + else + { + return cb_build_move_call(src, dst); } } static cb_tree -cb_build_move_field (cb_tree src, cb_tree dst) -{ - struct cb_field *src_f; - struct cb_field *dst_f; - int src_size; - int dst_size; - - src_f = cb_field (src); - src_size = cb_field_size (src); - dst_f = cb_field (dst); - dst_size = cb_field_size (dst); - - if ((src_size > 0 && dst_size > 0 && src_size >= dst_size) - && (!cb_field_variable_size (src_f) && !cb_field_variable_size (dst_f))) { - switch (CB_TREE_CATEGORY (src)) { +cb_build_move_field(cb_tree src, cb_tree dst) +{ + struct cb_field *src_f; + struct cb_field *dst_f; + int src_size; + int dst_size; + + src_f = cb_field(src); + src_size = cb_field_size(src); + dst_f = cb_field(dst); + dst_size = cb_field_size(dst); + + if ((src_size > 0 && dst_size > 0 && src_size >= dst_size) && (!cb_field_variable_size(src_f) && !cb_field_variable_size(dst_f))) + { + switch (CB_TREE_CATEGORY(src)) + { case CB_CATEGORY_ALPHABETIC: - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHABETIC - || CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC) { - if (dst_f->flag_justified == 0) { - return cb_build_move_copy (src, dst); + if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_ALPHABETIC || CB_TREE_CATEGORY(dst) == CB_CATEGORY_ALPHANUMERIC) + { + if (dst_f->flag_justified == 0) + { + return cb_build_move_copy(src, dst); } } break; case CB_CATEGORY_ALPHANUMERIC: - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC) { - if (dst_f->flag_justified == 0) { - return cb_build_move_copy (src, dst); + if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_ALPHANUMERIC) + { + if (dst_f->flag_justified == 0) + { + return cb_build_move_copy(src, dst); } } break; case CB_CATEGORY_NUMERIC: - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC - && src_f->usage == dst_f->usage - && src_f->pic->size == dst_f->pic->size - && src_f->pic->digits == dst_f->pic->digits - && src_f->pic->scale == dst_f->pic->scale - && src_f->pic->have_sign == dst_f->pic->have_sign - && src_f->flag_binary_swap == dst_f->flag_binary_swap - && src_f->flag_sign_leading == dst_f->flag_sign_leading - && src_f->flag_sign_separate == dst_f->flag_sign_separate) { - return cb_build_move_copy (src, dst); - } else if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC - && src_f->usage == CB_USAGE_DISPLAY - && src_f->pic->have_sign == 0 - && !src_f->flag_sign_leading - && !src_f->flag_sign_separate) { - return cb_build_move_copy (src, dst); + if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_NUMERIC && src_f->usage == dst_f->usage && src_f->pic->size == dst_f->pic->size && src_f->pic->digits == dst_f->pic->digits && src_f->pic->scale == dst_f->pic->scale && src_f->pic->have_sign == dst_f->pic->have_sign && src_f->flag_binary_swap == dst_f->flag_binary_swap && src_f->flag_sign_leading == dst_f->flag_sign_leading && src_f->flag_sign_separate == dst_f->flag_sign_separate) + { + return cb_build_move_copy(src, dst); + } + else if (CB_TREE_CATEGORY(dst) == CB_CATEGORY_ALPHANUMERIC && src_f->usage == CB_USAGE_DISPLAY && src_f->pic->have_sign == 0 && !src_f->flag_sign_leading && !src_f->flag_sign_separate) + { + return cb_build_move_copy(src, dst); } break; default: @@ -5913,114 +6934,149 @@ cb_build_move_field (cb_tree src, cb_tree dst) } } - return cb_build_move_call (src, dst); + return cb_build_move_call(src, dst); } cb_tree -cb_build_move (cb_tree src, cb_tree dst) +cb_build_move(cb_tree src, cb_tree dst) { struct cb_field *f; struct cb_field *p; - if (src == cb_error_node || dst == cb_error_node) { + if (src == cb_error_node || dst == cb_error_node) + { return cb_error_node; } - if (validate_move (src, dst, 0) < 0) { + if (validate_move(src, dst, 0) < 0) + { return cb_error_node; } - if (CB_REFERENCE_P (src)) { - CB_REFERENCE (src)->type = CB_SENDING_OPERAND; + if (CB_REFERENCE_P(src)) + { + CB_REFERENCE(src)->type = CB_SENDING_OPERAND; } - if (CB_REFERENCE_P (dst)) { - CB_REFERENCE (dst)->type = CB_RECEIVING_OPERAND; + if (CB_REFERENCE_P(dst)) + { + CB_REFERENCE(dst)->type = CB_RECEIVING_OPERAND; } - if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) { - return cb_build_assign (dst, src); + if (CB_TREE_CLASS(dst) == CB_CLASS_POINTER) + { + return cb_build_assign(dst, src); } - if (CB_REFERENCE_P (src) && CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) { - return cb_build_move_call (src, dst); + if (CB_REFERENCE_P(src) && CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) + { + return cb_build_move_call(src, dst); } - if (CB_INDEX_P (dst)) { - if (src == cb_null) { - return cb_build_assign (dst, cb_zero); + if (CB_INDEX_P(dst)) + { + if (src == cb_null) + { + return cb_build_assign(dst, cb_zero); } - return cb_build_assign (dst, src); + return cb_build_assign(dst, src); } - if (CB_INDEX_P (src)) { - return cb_build_method_call_2 ("setInt", dst, cb_build_cast_integer (src)); + if (CB_INDEX_P(src)) + { + return cb_build_method_call_2("setInt", dst, cb_build_cast_integer(src)); } - if (CB_INTRINSIC_P (src) || CB_INTRINSIC_P (dst)) { - return cb_build_move_call (src, dst); + if (CB_INTRINSIC_P(src) || CB_INTRINSIC_P(dst)) + { + return cb_build_move_call(src, dst); } - f = cb_field (dst); + f = cb_field(dst); - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) { - for (p = f; p; p = p->parent) { - if (p->flag_occurs) { - return cb_build_move_call (src, dst); + if (CB_EXCEPTION_ENABLE(COB_EC_BOUND_SUBSCRIPT)) + { + for (p = f; p; p = p->parent) + { + if (p->flag_occurs) + { + return cb_build_move_call(src, dst); } } - if (CB_REF_OR_FIELD_P (src)) { - for (p = cb_field (src); p; p = p->parent) { - if (p->flag_occurs) { - return cb_build_move_call (src, dst); + if (CB_REF_OR_FIELD_P(src)) + { + for (p = cb_field(src); p; p = p->parent) + { + if (p->flag_occurs) + { + return cb_build_move_call(src, dst); } } } } - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_REF_MOD)) { - if ((CB_REFERENCE_P (src) && CB_REFERENCE (src)->offset != NULL) || - (CB_REFERENCE_P (dst) && CB_REFERENCE (dst)->offset != NULL)) { - return cb_build_move_call (src, dst); - } + if (CB_EXCEPTION_ENABLE(COB_EC_BOUND_REF_MOD)) + { + if ((CB_REFERENCE_P(src) && CB_REFERENCE(src)->offset != NULL) || + (CB_REFERENCE_P(dst) && CB_REFERENCE(dst)->offset != NULL)) + { + return cb_build_move_call(src, dst); + } } /* output optimal code */ - if (src == cb_zero) { - return cb_build_move_zero (dst); - } else if (src == cb_space) { - return cb_build_move_space (dst); - } else if (src == cb_blank) { - return cb_build_move_blank (dst); - } else if (src == cb_high) { - return cb_build_move_high (dst); - } else if (src == cb_low) { - return cb_build_move_low (dst); - } else if (src == cb_quote) { - return cb_build_move_quote (dst); - } else if (CB_LITERAL_P (src)) { - return cb_build_move_literal (src, dst); - } - return cb_build_move_field (src, dst); -} - -void -cb_emit_move (cb_tree src, cb_tree dsts) + if (src == cb_zero) + { + return cb_build_move_zero(dst); + } + else if (src == cb_space) + { + return cb_build_move_space(dst); + } + else if (src == cb_blank) + { + return cb_build_move_blank(dst); + } + else if (src == cb_high) + { + return cb_build_move_high(dst); + } + else if (src == cb_low) + { + return cb_build_move_low(dst); + } + else if (src == cb_quote) + { + return cb_build_move_quote(dst); + } + else if (CB_LITERAL_P(src)) + { + return cb_build_move_literal(src, dst); + } + return cb_build_move_field(src, dst); +} + +void cb_emit_move(cb_tree src, cb_tree dsts) { cb_tree l; - if (cb_validate_one (src)) { + if (cb_validate_one(src)) + { return; } - if (cb_validate_list (dsts)) { + if (cb_validate_list(dsts)) + { return; } - for (l = dsts; l; l = CB_CHAIN (l)) { - if (cb_enable_expect_numeric_error) { - if (CB_TREE_TAG (src) == CB_TAG_REFERENCE) { - cb_emit (cb_build_method_call_2 ("checkMoveStrNum", src, CB_VALUE (l))); + for (l = dsts; l; l = CB_CHAIN(l)) + { + if (cb_enable_expect_numeric_error) + { + if (CB_TREE_TAG(src) == CB_TAG_REFERENCE) + { + cb_emit(cb_build_method_call_2("checkMoveStrNum", src, CB_VALUE(l))); } } - cb_emit (cb_build_move (src, CB_VALUE (l))); + cb_emit(cb_build_move(src, CB_VALUE(l))); } } @@ -6028,107 +7084,114 @@ cb_emit_move (cb_tree src, cb_tree dsts) * OPEN statement */ -void -cb_emit_open (cb_tree file, cb_tree mode, cb_tree sharing) +void cb_emit_open(cb_tree file, cb_tree mode, cb_tree sharing) { - if (file == cb_error_node) { + if (file == cb_error_node) + { return; } - file = cb_ref (file); - if (file == cb_error_node) { + file = cb_ref(file); + if (file == cb_error_node) + { return; } current_statement->file = file; - if (CB_FILE (file)->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("Operation not allowed on SORT files")); + if (CB_FILE(file)->organization == COB_ORG_SORT) + { + cb_error_x(CB_TREE(current_statement), + _("Operation not allowed on SORT files")); } - if (sharing == NULL) { - sharing = CB_FILE (file)->sharing ? CB_FILE (file)->sharing : cb_int0; + if (sharing == NULL) + { + sharing = CB_FILE(file)->sharing ? CB_FILE(file)->sharing : cb_int0; } /* READ ONLY */ - if (sharing == cb_int0 && CB_INTEGER (mode)->val != COB_OPEN_INPUT) { + if (sharing == cb_int0 && CB_INTEGER(mode)->val != COB_OPEN_INPUT) + { sharing = cb_int1; } - cb_emit (cb_build_method_call_4 ("open", file, mode, - sharing, CB_FILE(file)->file_status)); + cb_emit(cb_build_method_call_4("open", file, mode, + sharing, CB_FILE(file)->file_status)); } /* * PERFORM statement */ -void -cb_emit_perform (cb_tree perform, cb_tree body) +void cb_emit_perform(cb_tree perform, cb_tree body) { - if (perform == cb_error_node) { + if (perform == cb_error_node) + { return; } - CB_PERFORM (perform)->body = body; - cb_emit (perform); + CB_PERFORM(perform)->body = body; + cb_emit(perform); } cb_tree -cb_build_perform_once (cb_tree body) +cb_build_perform_once(cb_tree body) { cb_tree x; - if (body == cb_error_node) { + if (body == cb_error_node) + { return cb_error_node; } - x = cb_build_perform (CB_PERFORM_ONCE); - CB_PERFORM (x)->body = body; + x = cb_build_perform(CB_PERFORM_ONCE); + CB_PERFORM(x)->body = body; return x; } cb_tree -cb_build_perform_times (cb_tree times) +cb_build_perform_times(cb_tree times) { cb_tree x; - if (cb_check_integer_value (times) == cb_error_node) { + if (cb_check_integer_value(times) == cb_error_node) + { return cb_error_node; } - x = cb_build_perform (CB_PERFORM_TIMES); - CB_PERFORM (x)->data = times; + x = cb_build_perform(CB_PERFORM_TIMES); + CB_PERFORM(x)->data = times; return x; } cb_tree -cb_build_perform_until (cb_tree condition, cb_tree varying) +cb_build_perform_until(cb_tree condition, cb_tree varying) { cb_tree x; - x = cb_build_perform (CB_PERFORM_UNTIL); - CB_PERFORM (x)->test = condition; - CB_PERFORM (x)->varying = varying; + x = cb_build_perform(CB_PERFORM_UNTIL); + CB_PERFORM(x)->test = condition; + CB_PERFORM(x)->varying = varying; return x; } cb_tree -cb_build_perform_forever (cb_tree body) +cb_build_perform_forever(cb_tree body) { cb_tree x; - if (body == cb_error_node) { + if (body == cb_error_node) + { return cb_error_node; } - x = cb_build_perform (CB_PERFORM_FOREVER); - CB_PERFORM (x)->body = body; + x = cb_build_perform(CB_PERFORM_FOREVER); + CB_PERFORM(x)->body = body; return x; } cb_tree -cb_build_perform_exit (struct cb_label *label) +cb_build_perform_exit(struct cb_label *label) { cb_tree x; - x = cb_build_perform (CB_PERFORM_EXIT); - CB_PERFORM (x)->data = CB_TREE (label); + x = cb_build_perform(CB_PERFORM_EXIT); + CB_PERFORM(x)->data = CB_TREE(label); return x; } @@ -6137,34 +7200,41 @@ cb_build_perform_exit (struct cb_label *label) */ static int -match_compound_key (struct cb_key_component *pkcomp, struct cb_list *keys) +match_compound_key(struct cb_key_component *pkcomp, struct cb_list *keys) { - struct cb_field *pfld; - struct cb_reference *pref; + struct cb_field *pfld; + struct cb_reference *pref; - while (pkcomp && keys) { - pfld = CB_FIELD (CB_REFERENCE (keys->value)->value); - pref = CB_REFERENCE (pkcomp->component); - if (pfld != CB_FIELD (pref->value)) { + while (pkcomp && keys) + { + pfld = CB_FIELD(CB_REFERENCE(keys->value)->value); + pref = CB_REFERENCE(pkcomp->component); + if (pfld != CB_FIELD(pref->value)) + { break; } pkcomp = pkcomp->next; - keys = (keys->chain) ? CB_LIST (keys->chain): NULL; + keys = (keys->chain) ? CB_LIST(keys->chain) : NULL; } return (!pkcomp && !keys); } static cb_tree -lookup_compound_key (struct cb_file *f, struct cb_list *keys) +lookup_compound_key(struct cb_file *f, struct cb_list *keys) { - struct cb_alt_key *paltkey; - cb_tree key = NULL; + struct cb_alt_key *paltkey; + cb_tree key = NULL; - if (match_compound_key (f->component_list, keys)) { + if (match_compound_key(f->component_list, keys)) + { key = f->key; - } else { - for (paltkey = f->alt_key_list; paltkey; paltkey = paltkey->next) { - if (match_compound_key (paltkey->component_list, keys)) { + } + else + { + for (paltkey = f->alt_key_list; paltkey; paltkey = paltkey->next) + { + if (match_compound_key(paltkey->component_list, keys)) + { key = paltkey->key; break; } @@ -6173,73 +7243,96 @@ lookup_compound_key (struct cb_file *f, struct cb_list *keys) return key; } -void -cb_emit_read (cb_tree ref, cb_tree next, cb_tree into, cb_tree keys, cb_tree lock_opts) +void cb_emit_read(cb_tree ref, cb_tree next, cb_tree into, cb_tree keys, cb_tree lock_opts) { - int read_opts = 0; - cb_tree file; - cb_tree rec; + int read_opts = 0; + cb_tree file; + cb_tree rec; cb_tree key = NULL; - if (lock_opts == cb_int1) { + if (lock_opts == cb_int1) + { read_opts = COB_READ_LOCK; - } else if (lock_opts == cb_int2) { + } + else if (lock_opts == cb_int2) + { read_opts = COB_READ_NO_LOCK; - } else if (lock_opts == cb_int3) { + } + else if (lock_opts == cb_int3) + { read_opts = COB_READ_IGNORE_LOCK; - } else if (lock_opts == cb_int4) { + } + else if (lock_opts == cb_int4) + { read_opts = COB_READ_WAIT_LOCK; } - if (ref == cb_error_node) { + if (ref == cb_error_node) + { return; } - file = cb_ref (ref); - if (file == cb_error_node) { + file = cb_ref(ref); + if (file == cb_error_node) + { return; } - rec = cb_build_field_reference (CB_FILE (file)->record, ref); - if (CB_FILE (file)->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("Operation not allowed on SORT files")); + rec = cb_build_field_reference(CB_FILE(file)->record, ref); + if (CB_FILE(file)->organization == COB_ORG_SORT) + { + cb_error_x(CB_TREE(current_statement), + _("Operation not allowed on SORT files")); } if (next == cb_int1 || next == cb_int2 || - CB_FILE (file)->access_mode == COB_ACCESS_SEQUENTIAL) { + CB_FILE(file)->access_mode == COB_ACCESS_SEQUENTIAL) + { /* READ NEXT/PREVIOUS */ - if (next == cb_int2) { - if (CB_FILE (file)->organization != COB_ORG_INDEXED) { - cb_error_x (CB_TREE (current_statement), - _("READ PREVIOUS only allowed for INDEXED SEQUENTIAL files")); + if (next == cb_int2) + { + if (CB_FILE(file)->organization != COB_ORG_INDEXED) + { + cb_error_x(CB_TREE(current_statement), + _("READ PREVIOUS only allowed for INDEXED SEQUENTIAL files")); } read_opts |= COB_READ_PREVIOUS; - } else { + } + else + { read_opts |= COB_READ_NEXT; } - if (keys) { - cb_warning (_("KEY ignored with sequential READ")); - } - cb_emit (cb_build_method_call_4 ("read", file, cb_int0, - CB_FILE(file)->file_status, - cb_int (read_opts))); - } else { - if (keys) { - if (CB_LIST (keys)->chain != NULL) { - key = lookup_compound_key (CB_FILE (file), - CB_LIST (keys)); - } else { - key = CB_LIST (keys)->value; - } - if (!key) { - cb_error_x (CB_TREE (current_statement), _("Undefined compound keys")); + if (keys) + { + cb_warning(_("KEY ignored with sequential READ")); + } + cb_emit(cb_build_method_call_4("read", file, cb_int0, + CB_FILE(file)->file_status, + cb_int(read_opts))); + } + else + { + if (keys) + { + if (CB_LIST(keys)->chain != NULL) + { + key = lookup_compound_key(CB_FILE(file), + CB_LIST(keys)); + } + else + { + key = CB_LIST(keys)->value; + } + if (!key) + { + cb_error_x(CB_TREE(current_statement), _("Undefined compound keys")); return; } - } + } /* READ */ - cb_emit (cb_build_method_call_4 ("read", - file, key ? key : CB_FILE (file)->key, - CB_FILE(file)->file_status, cb_int (read_opts))); + cb_emit(cb_build_method_call_4("read", + file, key ? key : CB_FILE(file)->key, + CB_FILE(file)->file_status, cb_int(read_opts))); } - if (into) { - current_statement->handler3 = cb_build_move (rec, into); + if (into) + { + current_statement->handler3 = cb_build_move(rec, into); } current_statement->file = file; } @@ -6248,115 +7341,134 @@ cb_emit_read (cb_tree ref, cb_tree next, cb_tree into, cb_tree keys, cb_tree loc * REWRITE statement */ -void -cb_emit_rewrite (cb_tree record, cb_tree from, cb_tree lockopt) +void cb_emit_rewrite(cb_tree record, cb_tree from, cb_tree lockopt) { cb_tree file; - int opts = 0; + int opts = 0; - if (record == cb_error_node || cb_ref (record) == cb_error_node) { + if (record == cb_error_node || cb_ref(record) == cb_error_node) + { return; } - if (!CB_REF_OR_FIELD_P (cb_ref (record))) { - cb_error_x (CB_TREE (current_statement), - _("REWRITE requires a record name as subject")); + if (!CB_REF_OR_FIELD_P(cb_ref(record))) + { + cb_error_x(CB_TREE(current_statement), + _("REWRITE requires a record name as subject")); return; } - if (cb_field (record)->storage != CB_STORAGE_FILE) { - cb_error_x (CB_TREE (current_statement), - _("REWRITE subject does not refer to a record name")); + if (cb_field(record)->storage != CB_STORAGE_FILE) + { + cb_error_x(CB_TREE(current_statement), + _("REWRITE subject does not refer to a record name")); return; } - file = CB_TREE (CB_FIELD (cb_ref (record))->file); + file = CB_TREE(CB_FIELD(cb_ref(record))->file); current_statement->file = file; - if (CB_FILE (file)->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("Operation not allowed on SORT files")); - } else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY && - (CB_FILE(file)->organization != COB_ORG_RELATIVE && - CB_FILE(file)->organization != COB_ORG_INDEXED)) { - cb_error_x (CB_TREE(current_statement), - _("INVALID KEY clause invalid with this file type")); - } else if ((CB_FILE (file)->lock_mode & COB_LOCK_AUTOMATIC) && lockopt) { - cb_error_x (CB_TREE (current_statement), - _("LOCK clause invalid with file LOCK AUTOMATIC")); - } else if (lockopt == cb_int1) { + if (CB_FILE(file)->organization == COB_ORG_SORT) + { + cb_error_x(CB_TREE(current_statement), + _("Operation not allowed on SORT files")); + } + else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY && + (CB_FILE(file)->organization != COB_ORG_RELATIVE && + CB_FILE(file)->organization != COB_ORG_INDEXED)) + { + cb_error_x(CB_TREE(current_statement), + _("INVALID KEY clause invalid with this file type")); + } + else if ((CB_FILE(file)->lock_mode & COB_LOCK_AUTOMATIC) && lockopt) + { + cb_error_x(CB_TREE(current_statement), + _("LOCK clause invalid with file LOCK AUTOMATIC")); + } + else if (lockopt == cb_int1) + { opts = COB_WRITE_LOCK; } - if (from) { - cb_emit (cb_build_move (from, record)); + if (from) + { + cb_emit(cb_build_move(from, record)); } - cb_emit (cb_build_method_call_4 ("rewrite", file, record, - cb_int (opts), CB_FILE(file)->file_status)); + cb_emit(cb_build_method_call_4("rewrite", file, record, + cb_int(opts), CB_FILE(file)->file_status)); } /* * RELEASE statement */ -void -cb_emit_release (cb_tree record, cb_tree from) +void cb_emit_release(cb_tree record, cb_tree from) { - struct cb_field *f; - cb_tree file; + struct cb_field *f; + cb_tree file; - if (record == cb_error_node) { + if (record == cb_error_node) + { return; } - if (from == cb_error_node) { + if (from == cb_error_node) + { return; } - if (cb_ref (record) == cb_error_node) { + if (cb_ref(record) == cb_error_node) + { return; } - if (!CB_REF_OR_FIELD_P (cb_ref (record))) { - cb_error_x (CB_TREE (current_statement), - _("RELEASE requires a record name as subject")); + if (!CB_REF_OR_FIELD_P(cb_ref(record))) + { + cb_error_x(CB_TREE(current_statement), + _("RELEASE requires a record name as subject")); return; } - if (cb_field (record)->storage != CB_STORAGE_FILE) { - cb_error_x (CB_TREE (current_statement), - _("RELEASE subject does not refer to a record name")); + if (cb_field(record)->storage != CB_STORAGE_FILE) + { + cb_error_x(CB_TREE(current_statement), + _("RELEASE subject does not refer to a record name")); return; } - f = CB_FIELD (cb_ref (record)); - file = CB_TREE (f->file); - if (CB_FILE (file)->organization != COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("RELEASE not allowed on this record item")); + f = CB_FIELD(cb_ref(record)); + file = CB_TREE(f->file); + if (CB_FILE(file)->organization != COB_ORG_SORT) + { + cb_error_x(CB_TREE(current_statement), + _("RELEASE not allowed on this record item")); return; } current_statement->file = file; - if (from) { - cb_emit (cb_build_move (from, record)); + if (from) + { + cb_emit(cb_build_move(from, record)); } - cb_emit (cb_build_release (file, cb_build_cast_address (current_program->cb_sort_return))); + cb_emit(cb_build_release(file, cb_build_cast_address(current_program->cb_sort_return))); } /* * RETURN statement */ -void -cb_emit_return (cb_tree ref, cb_tree into) +void cb_emit_return(cb_tree ref, cb_tree into) { cb_tree file; cb_tree rec; - if (ref == cb_error_node) { + if (ref == cb_error_node) + { return; } - if (into == cb_error_node) { + if (into == cb_error_node) + { return; } - file = cb_ref (ref); - if (file == cb_error_node) { + file = cb_ref(ref); + if (file == cb_error_node) + { return; } - rec = cb_build_field_reference (CB_FILE (file)->record, ref); - cb_emit (cb_build_return (file, cb_build_cast_address (current_program->cb_sort_return))); - if (into) { - current_statement->handler3 = cb_build_move (rec, into); + rec = cb_build_field_reference(CB_FILE(file)->record, ref); + cb_emit(cb_build_return(file, cb_build_cast_address(current_program->cb_sort_return))); + if (into) + { + current_statement->handler3 = cb_build_move(rec, into); } current_statement->file = file; } @@ -6365,10 +7477,9 @@ cb_emit_return (cb_tree ref, cb_tree into) * ROLLBACK statement */ -void -cb_emit_rollback (void) +void cb_emit_rollback(void) { - cb_emit (cb_build_funcall_0 ("CobolFile.rollback")); + cb_emit(cb_build_funcall_0("CobolFile.rollback")); } /* @@ -6376,36 +7487,44 @@ cb_emit_rollback (void) */ static void -search_set_keys (struct cb_field *f, cb_tree x) +search_set_keys(struct cb_field *f, cb_tree x) { - struct cb_binary_op *p; - int i; + struct cb_binary_op *p; + int i; - if (CB_REFERENCE_P (x)) { - x = build_cond_88 (x); + if (CB_REFERENCE_P(x)) + { + x = build_cond_88(x); } - p = CB_BINARY_OP (x); - switch (p->op) { + p = CB_BINARY_OP(x); + switch (p->op) + { case '&': - search_set_keys (f, p->x); - search_set_keys (f, p->y); + search_set_keys(f, p->x); + search_set_keys(f, p->y); break; case '=': - for (i = 0; i < f->nkeys; i++) { - if (cb_field (p->x) == cb_field (f->keys[i].key)) { + for (i = 0; i < f->nkeys; i++) + { + if (cb_field(p->x) == cb_field(f->keys[i].key)) + { f->keys[i].ref = p->x; f->keys[i].val = p->y; break; } } - if (cb_allow_search_key_in_rhs) { + if (cb_allow_search_key_in_rhs) + { /* relaxed syntax: try to find key in RHS to accept * also L<->R reversed conditional expresssion. */ - if (i == f->nkeys && CB_REFERENCE_P (p->y) && CB_FIELD_P (cb_ref (p->y))) { - for (i = 0; i < f->nkeys; i++) { - if (cb_field (p->y) == cb_field (f->keys[i].key)) { + if (i == f->nkeys && CB_REFERENCE_P(p->y) && CB_FIELD_P(cb_ref(p->y))) + { + for (i = 0; i < f->nkeys; i++) + { + if (cb_field(p->y) == cb_field(f->keys[i].key)) + { f->keys[i].ref = p->y; f->keys[i].val = p->x; break; @@ -6413,102 +7532,115 @@ search_set_keys (struct cb_field *f, cb_tree x) } } } - if (i == f->nkeys) { - cb_error_x (x, _("Undeclared key '%s'"), cb_field (p->x)->name); + if (i == f->nkeys) + { + cb_error_x(x, _("Undeclared key '%s'"), cb_field(p->x)->name); } break; default: - cb_error_x (x, _("Invalid SEARCH ALL condition")); + cb_error_x(x, _("Invalid SEARCH ALL condition")); break; } } static cb_tree -cb_build_search_all (cb_tree table, cb_tree cond) +cb_build_search_all(cb_tree table, cb_tree cond) { - cb_tree c1 = NULL; - cb_tree c2; - struct cb_field *f; - int i; + cb_tree c1 = NULL; + cb_tree c2; + struct cb_field *f; + int i; - f = cb_field (table); + f = cb_field(table); /* set keys */ - for (i = 0; i < f->nkeys; i++) { + for (i = 0; i < f->nkeys; i++) + { f->keys[i].ref = NULL; } - search_set_keys (f, cond); + search_set_keys(f, cond); /* build condition */ - for (i = 0; i < f->nkeys; i++) { - if (f->keys[i].ref) { - if (f->keys[i].dir == COB_ASCENDING) { - c2 = cb_build_binary_op (f->keys[i].ref, '=', f->keys[i].val); - } else { - c2 = cb_build_binary_op (f->keys[i].val, '=', f->keys[i].ref); - } - if (c1 == NULL) { + for (i = 0; i < f->nkeys; i++) + { + if (f->keys[i].ref) + { + if (f->keys[i].dir == COB_ASCENDING) + { + c2 = cb_build_binary_op(f->keys[i].ref, '=', f->keys[i].val); + } + else + { + c2 = cb_build_binary_op(f->keys[i].val, '=', f->keys[i].ref); + } + if (c1 == NULL) + { c1 = c2; - } else { - c1 = cb_build_binary_op (c1, '&', c2); + } + else + { + c1 = cb_build_binary_op(c1, '&', c2); } } } - return cb_build_cond (c1); + return cb_build_cond(c1); } -void -cb_emit_search (cb_tree table, cb_tree varying, cb_tree at_end, cb_tree whens) +void cb_emit_search(cb_tree table, cb_tree varying, cb_tree at_end, cb_tree whens) { - if (cb_validate_one (table)) { + if (cb_validate_one(table)) + { return; } - if (cb_validate_one (varying)) { + if (cb_validate_one(varying)) + { return; } - if (table == cb_error_node) { + if (table == cb_error_node) + { return; } - cb_emit (cb_build_search (0, table, varying, at_end, whens)); + cb_emit(cb_build_search(0, table, varying, at_end, whens)); } -void -cb_emit_search_all (cb_tree table, cb_tree at_end, cb_tree when, cb_tree stmts) +void cb_emit_search_all(cb_tree table, cb_tree at_end, cb_tree when, cb_tree stmts) { - if (cb_validate_one (table)) { + if (cb_validate_one(table)) + { return; } - if (table == cb_error_node) { + if (table == cb_error_node) + { return; } - cb_emit (cb_build_search (1, table, NULL, at_end, - cb_build_if (cb_build_search_all (table, when), stmts, NULL))); + cb_emit(cb_build_search(1, table, NULL, at_end, + cb_build_if(cb_build_search_all(table, when), stmts, NULL))); } /* * SET statement */ -void -cb_emit_setenv (cb_tree x, cb_tree y) +void cb_emit_setenv(cb_tree x, cb_tree y) { - cb_emit (cb_build_funcall_2 ("CobolTerminal.setEnvironment", x, y)); + cb_emit(cb_build_funcall_2("CobolTerminal.setEnvironment", x, y)); } -void -cb_emit_set_to (cb_tree vars, cb_tree x) +void cb_emit_set_to(cb_tree vars, cb_tree x) { - cb_tree l; - cb_tree v; - struct cb_cast *p; + cb_tree l; + cb_tree v; + struct cb_cast *p; #if 0 enum cb_class class = CB_CLASS_UNKNOWN; #endif - if (cb_validate_one (x)) { + if (cb_validate_one(x)) + { return; } - if (cb_validate_list (vars)) { + if (cb_validate_list(vars)) + { return; } @@ -6530,143 +7662,165 @@ cb_emit_set_to (cb_tree vars, cb_tree x) } #endif - if (CB_CAST_P (x)) { - p = CB_CAST (x); - if (p->type == CB_CAST_PROGRAM_POINTER) { - for (l = vars; l; l = CB_CHAIN (l)) { - v = CB_VALUE (l); - if (!CB_REFERENCE_P (v)) { - cb_error_x (CB_TREE (current_statement), - _("SET targets must be PROGRAM-POINTER")); - CB_VALUE (l) = cb_error_node; - } else if (CB_FIELD(cb_ref(v))->usage != CB_USAGE_PROGRAM_POINTER) { - cb_error_x (CB_TREE (current_statement), - _("SET targets must be PROGRAM-POINTER")); - CB_VALUE (l) = cb_error_node; + if (CB_CAST_P(x)) + { + p = CB_CAST(x); + if (p->type == CB_CAST_PROGRAM_POINTER) + { + for (l = vars; l; l = CB_CHAIN(l)) + { + v = CB_VALUE(l); + if (!CB_REFERENCE_P(v)) + { + cb_error_x(CB_TREE(current_statement), + _("SET targets must be PROGRAM-POINTER")); + CB_VALUE(l) = cb_error_node; + } + else if (CB_FIELD(cb_ref(v))->usage != CB_USAGE_PROGRAM_POINTER) + { + cb_error_x(CB_TREE(current_statement), + _("SET targets must be PROGRAM-POINTER")); + CB_VALUE(l) = cb_error_node; } } } } /* validate the targets */ - for (l = vars; l; l = CB_CHAIN (l)) { - v = CB_VALUE (l); - if (CB_CAST_P (v)) { - p = CB_CAST (v); - if (p->type == CB_CAST_ADDRESS - && !CB_FIELD (cb_ref (p->val))->flag_item_based - && CB_FIELD (cb_ref (p->val))->storage != CB_STORAGE_LINKAGE) { - cb_error_x (p->val, _("The address of '%s' cannot be changed"), - cb_name (p->val)); - CB_VALUE (l) = cb_error_node; + for (l = vars; l; l = CB_CHAIN(l)) + { + v = CB_VALUE(l); + if (CB_CAST_P(v)) + { + p = CB_CAST(v); + if (p->type == CB_CAST_ADDRESS && !CB_FIELD(cb_ref(p->val))->flag_item_based && CB_FIELD(cb_ref(p->val))->storage != CB_STORAGE_LINKAGE) + { + cb_error_x(p->val, _("The address of '%s' cannot be changed"), + cb_name(p->val)); + CB_VALUE(l) = cb_error_node; } } } - if (cb_validate_list (vars)) { + if (cb_validate_list(vars)) + { return; } - for (l = vars; l; l = CB_CHAIN (l)) { - cb_emit (cb_build_move (x, CB_VALUE (l))); + for (l = vars; l; l = CB_CHAIN(l)) + { + cb_emit(cb_build_move(x, CB_VALUE(l))); } } -void -cb_emit_set_up_down (cb_tree l, cb_tree flag, cb_tree x) +void cb_emit_set_up_down(cb_tree l, cb_tree flag, cb_tree x) { - if (cb_validate_one (x)) { + if (cb_validate_one(x)) + { return; } - if (cb_validate_list (l)) { + if (cb_validate_list(l)) + { return; } - for (; l; l = CB_CHAIN (l)) { - if (flag == cb_int0) { - cb_emit (cb_build_add (CB_VALUE (l), x, cb_int0)); - } else { - cb_emit (cb_build_sub (CB_VALUE (l), x, cb_int0)); + for (; l; l = CB_CHAIN(l)) + { + if (flag == cb_int0) + { + cb_emit(cb_build_add(CB_VALUE(l), x, cb_int0)); + } + else + { + cb_emit(cb_build_sub(CB_VALUE(l), x, cb_int0)); } } } -void -cb_emit_set_on_off (cb_tree l, cb_tree flag) +void cb_emit_set_on_off(cb_tree l, cb_tree flag) { struct cb_system_name *s; - if (cb_validate_list (l)) { + if (cb_validate_list(l)) + { return; } - for (; l; l = CB_CHAIN (l)) { - s = CB_SYSTEM_NAME (cb_ref (CB_VALUE (l))); - cb_emit (cb_build_funcall_2 ("CobolUtil.setSwitch", cb_int (s->token), flag)); + for (; l; l = CB_CHAIN(l)) + { + s = CB_SYSTEM_NAME(cb_ref(CB_VALUE(l))); + cb_emit(cb_build_funcall_2("CobolUtil.setSwitch", cb_int(s->token), flag)); } } -void -cb_emit_set_true (cb_tree l) +void cb_emit_set_true(cb_tree l) { - cb_tree x; + cb_tree x; struct cb_field *f; - cb_tree ref; - cb_tree val; - - for (; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (x == cb_error_node) { + cb_tree ref; + cb_tree val; + + for (; l; l = CB_CHAIN(l)) + { + x = CB_VALUE(l); + if (x == cb_error_node) + { return; } - if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) - && !CB_FIELD_P (x)) { - cb_error_x (x, _("Invalid SET statement")); + if (!(CB_REFERENCE_P(x) && CB_FIELD_P(CB_REFERENCE(x)->value)) && !CB_FIELD_P(x)) + { + cb_error_x(x, _("Invalid SET statement")); return; } - f = cb_field (x); - if (f->level != 88) { - cb_error_x (x, _("Invalid SET statement")); + f = cb_field(x); + if (f->level != 88) + { + cb_error_x(x, _("Invalid SET statement")); return; } - ref = cb_build_field_reference (f->parent, x); - val = CB_VALUE (f->values); - if (CB_PAIR_P (val)) { - val = CB_PAIR_X (val); + ref = cb_build_field_reference(f->parent, x); + val = CB_VALUE(f->values); + if (CB_PAIR_P(val)) + { + val = CB_PAIR_X(val); } - cb_emit (cb_build_move (val, ref)); + cb_emit(cb_build_move(val, ref)); } } -void -cb_emit_set_false (cb_tree l) +void cb_emit_set_false(cb_tree l) { - cb_tree x; + cb_tree x; struct cb_field *f; - cb_tree ref; - cb_tree val; - - for (; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (x == cb_error_node) { + cb_tree ref; + cb_tree val; + + for (; l; l = CB_CHAIN(l)) + { + x = CB_VALUE(l); + if (x == cb_error_node) + { return; } - if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) - && !CB_FIELD_P (x)) { - cb_error_x (x, _("Invalid SET statement")); + if (!(CB_REFERENCE_P(x) && CB_FIELD_P(CB_REFERENCE(x)->value)) && !CB_FIELD_P(x)) + { + cb_error_x(x, _("Invalid SET statement")); return; } - f = cb_field (x); - if (f->level != 88) { - cb_error_x (x, _("Invalid SET statement")); + f = cb_field(x); + if (f->level != 88) + { + cb_error_x(x, _("Invalid SET statement")); return; } - if (!f->false_88) { - cb_error_x (x, _("Field does not have FALSE clause")); + if (!f->false_88) + { + cb_error_x(x, _("Field does not have FALSE clause")); return; } - ref = cb_build_field_reference (f->parent, x); - val = CB_VALUE (f->false_88); - if (CB_PAIR_P (val)) { - val = CB_PAIR_X (val); + ref = cb_build_field_reference(f->parent, x); + val = CB_VALUE(f->false_88); + if (CB_PAIR_P(val)) + { + val = CB_PAIR_X(val); } - cb_emit (cb_build_move (val, ref)); + cb_emit(cb_build_move(val, ref)); } } @@ -6674,145 +7828,161 @@ cb_emit_set_false (cb_tree l) * SORT statement */ -void -cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col) +void cb_emit_sort_init(cb_tree name, cb_tree keys, cb_tree col) { - cb_tree l; - struct cb_field *f; + cb_tree l; + struct cb_field *f; - if (cb_validate_list (keys)) { + if (cb_validate_list(keys)) + { return; } - for (l = keys; l; l = CB_CHAIN (l)) { - if (CB_VALUE (l) == NULL) { - CB_VALUE (l) = name; + for (l = keys; l; l = CB_CHAIN(l)) + { + if (CB_VALUE(l) == NULL) + { + CB_VALUE(l) = name; } - cb_ref (CB_VALUE (l)); + cb_ref(CB_VALUE(l)); } - if (CB_FILE_P (cb_ref (name))) { - if (CB_FILE (cb_ref (name))->organization != COB_ORG_SORT) { - cb_error_x (name, _("Invalid SORT filename")); + if (CB_FILE_P(cb_ref(name))) + { + if (CB_FILE(cb_ref(name))->organization != COB_ORG_SORT) + { + cb_error_x(name, _("Invalid SORT filename")); } - cb_field (current_program->cb_sort_return)->count++; + cb_field(current_program->cb_sort_return)->count++; /*cb_emit (cb_build_sort_init ("cob_file_sort_init", cb_ref (name), - cb_int (cb_list_length (keys)), col, - cb_build_cast_address (current_program->cb_sort_return), - CB_FILE(cb_ref (name))->file_status));*/ - cb_emit (cb_build_funcall_5 ("CobolFileSort.sortInit", cb_ref (name), - cb_int (cb_list_length (keys)), col, - cb_build_cast_address (current_program->cb_sort_return), - CB_FILE(cb_ref (name))->file_status)); - for (l = keys; l; l = CB_CHAIN (l)) { - cb_emit (cb_build_funcall_4 ("CobolFileSort.sortInitKey", cb_ref (name), - CB_PURPOSE (l), - CB_VALUE (l), - cb_int (cb_field (CB_VALUE(l))->offset))); - } - } else { - f = CB_FIELD (cb_ref (name)); - if (keys == NULL) { - cb_error_x (name, _("Table sort without keys not implemented yet")); - } - cb_emit (cb_build_funcall_2 ("CobolFileSort.sortTableInit", cb_int (cb_list_length (keys)), col)); - for (l = keys; l; l = CB_CHAIN (l)) { - cb_emit (cb_build_funcall_3 ("CobolFileSort.sortTableInitKey", - CB_PURPOSE (l), - CB_VALUE (l), - cb_int (cb_field (CB_VALUE(l))->offset))); - } - cb_emit (cb_build_funcall_2 ("CobolFileSort.sortTable", name, - (f->occurs_depending - ? cb_build_cast_integer (f->occurs_depending) - : cb_int (f->occurs_max)))); - } -} - -void -cb_emit_sort_using (cb_tree file, cb_tree l) -{ - if (cb_validate_list (l)) { + cb_int (cb_list_length (keys)), col, + cb_build_cast_address (current_program->cb_sort_return), + CB_FILE(cb_ref (name))->file_status));*/ + cb_emit(cb_build_funcall_5("CobolFileSort.sortInit", cb_ref(name), + cb_int(cb_list_length(keys)), col, + cb_build_cast_address(current_program->cb_sort_return), + CB_FILE(cb_ref(name))->file_status)); + for (l = keys; l; l = CB_CHAIN(l)) + { + cb_emit(cb_build_funcall_4("CobolFileSort.sortInitKey", cb_ref(name), + CB_PURPOSE(l), + CB_VALUE(l), + cb_int(cb_field(CB_VALUE(l))->offset))); + } + } + else + { + f = CB_FIELD(cb_ref(name)); + if (keys == NULL) + { + cb_error_x(name, _("Table sort without keys not implemented yet")); + } + cb_emit(cb_build_funcall_2("CobolFileSort.sortTableInit", cb_int(cb_list_length(keys)), col)); + for (l = keys; l; l = CB_CHAIN(l)) + { + cb_emit(cb_build_funcall_3("CobolFileSort.sortTableInitKey", + CB_PURPOSE(l), + CB_VALUE(l), + cb_int(cb_field(CB_VALUE(l))->offset))); + } + cb_emit(cb_build_funcall_2("CobolFileSort.sortTable", name, + (f->occurs_depending + ? cb_build_cast_integer(f->occurs_depending) + : cb_int(f->occurs_max)))); + } +} + +void cb_emit_sort_using(cb_tree file, cb_tree l) +{ + if (cb_validate_list(l)) + { return; } - for (; l; l = CB_CHAIN (l)) { - if (CB_FILE (cb_ref(CB_VALUE(l)))->organization == COB_ORG_SORT) { - cb_error (_("Invalid SORT USING parameter")); + for (; l; l = CB_CHAIN(l)) + { + if (CB_FILE(cb_ref(CB_VALUE(l)))->organization == COB_ORG_SORT) + { + cb_error(_("Invalid SORT USING parameter")); } - cb_emit (cb_build_funcall_2 ("CobolFileSort.sortUsing", - cb_ref (file), cb_ref (CB_VALUE (l)))); + cb_emit(cb_build_funcall_2("CobolFileSort.sortUsing", + cb_ref(file), cb_ref(CB_VALUE(l)))); } } -void -cb_emit_sort_input (cb_tree proc, cb_tree file) +void cb_emit_sort_input(cb_tree proc, cb_tree file) { - cb_emit (cb_build_sort_proc (proc, cb_ref (file), - cb_build_cast_address (current_program->cb_sort_return))); + cb_emit(cb_build_sort_proc(proc, cb_ref(file), + cb_build_cast_address(current_program->cb_sort_return))); } -void -cb_emit_sort_giving (cb_tree file, cb_tree l) +void cb_emit_sort_giving(cb_tree file, cb_tree l) { - cb_tree p; - int listlen; + cb_tree p; + int listlen; - if (cb_validate_list (l)) { + if (cb_validate_list(l)) + { return; } - for (p = l; p; p = CB_CHAIN (p)) { - if (CB_FILE (cb_ref(CB_VALUE(p)))->organization == COB_ORG_SORT) { - cb_error (_("Invalid SORT GIVING parameter")); + for (p = l; p; p = CB_CHAIN(p)) + { + if (CB_FILE(cb_ref(CB_VALUE(p)))->organization == COB_ORG_SORT) + { + cb_error(_("Invalid SORT GIVING parameter")); } } - listlen = cb_list_length (l); - p = cb_build_funcall_2 ("CobolFileSort.sortGiving", cb_ref (file), l); + listlen = cb_list_length(l); + p = cb_build_funcall_2("CobolFileSort.sortGiving", cb_ref(file), l); CB_FUNCALL(p)->varcnt = listlen; - cb_emit (p); + cb_emit(p); } -void -cb_emit_sort_output (cb_tree proc, cb_tree file) +void cb_emit_sort_output(cb_tree proc, cb_tree file) { - cb_emit (cb_build_sort_proc (proc, cb_ref (file), - cb_build_cast_address (current_program->cb_sort_return))); + cb_emit(cb_build_sort_proc(proc, cb_ref(file), + cb_build_cast_address(current_program->cb_sort_return))); } -void -cb_emit_sort_finish (cb_tree file) +void cb_emit_sort_finish(cb_tree file) { - cb_emit (cb_build_sort_finish ((CB_FILE_P (cb_ref (file)))? cb_ref (file): NULL, - cb_build_cast_address (current_program->cb_sort_return))); + cb_emit(cb_build_sort_finish((CB_FILE_P(cb_ref(file))) ? cb_ref(file) : NULL, + cb_build_cast_address(current_program->cb_sort_return))); } /* * START statement */ -void -cb_emit_start (cb_tree file, cb_tree op, cb_tree keys) +void cb_emit_start(cb_tree file, cb_tree op, cb_tree keys) { - cb_tree key = NULL; + cb_tree key = NULL; - if (cb_validate_one (keys)) { + if (cb_validate_one(keys)) + { return; } - if (keys) { - if (CB_LIST (keys)->chain != NULL) { - key = lookup_compound_key (CB_FILE (cb_ref (file)), - CB_LIST (keys)); - } else { - key = CB_LIST (keys)->value; + if (keys) + { + if (CB_LIST(keys)->chain != NULL) + { + key = lookup_compound_key(CB_FILE(cb_ref(file)), + CB_LIST(keys)); } - if (!key) { - cb_error_x (CB_TREE (current_statement), _("Undefined compound keys")); + else + { + key = CB_LIST(keys)->value; + } + if (!key) + { + cb_error_x(CB_TREE(current_statement), _("Undefined compound keys")); return; } } - if (file != cb_error_node) { - current_statement->file = cb_ref (file); - cb_emit (cb_build_method_call_4 ("start", cb_ref (file), op, - key ? key : CB_FILE (cb_ref (file))->key, - CB_FILE(cb_ref(file))->file_status)); + if (file != cb_error_node) + { + current_statement->file = cb_ref(file); + cb_emit(cb_build_method_call_4("start", cb_ref(file), op, + key ? key : CB_FILE(cb_ref(file))->key, + CB_FILE(cb_ref(file))->file_status)); } } @@ -6820,10 +7990,9 @@ cb_emit_start (cb_tree file, cb_tree op, cb_tree keys) * STOP statement */ -void -cb_emit_stop_run (cb_tree x) +void cb_emit_stop_run(cb_tree x) { - cb_emit (cb_build_funcall_1 ("CobolStopRunException.throwException", cb_build_cast_integer (x))); + cb_emit(cb_build_funcall_1("CobolStopRunException.throwException", cb_build_cast_integer(x))); } /* @@ -6831,112 +8000,134 @@ cb_emit_stop_run (cb_tree x) */ static void -cb_validate_string (cb_tree items, cb_tree into) +cb_validate_string(cb_tree items, cb_tree into) { - cb_tree item_value; - cb_tree item_purpose; - cb_tree start; + cb_tree item_value; + cb_tree item_purpose; + cb_tree start; - char name1[256], name2[256], name3[256]; - struct cb_field *pfield; - struct cb_literal *pliteral; - int size; + char name1[256], name2[256], name3[256]; + struct cb_field *pfield; + struct cb_literal *pliteral; + int size; start = items; - while (start) { - memset (name1, 0, sizeof (name1)); - memset (name2, 0, sizeof (name2)); - memset (name3, 0, sizeof (name3)); - - for (item_value = start; item_value; item_value = CB_CHAIN (item_value)) { - if (CB_VALUE (item_value) && !CB_PAIR_P (CB_VALUE (item_value))) { + while (start) + { + memset(name1, 0, sizeof(name1)); + memset(name2, 0, sizeof(name2)); + memset(name3, 0, sizeof(name3)); + + for (item_value = start; item_value; item_value = CB_CHAIN(item_value)) + { + if (CB_VALUE(item_value) && !CB_PAIR_P(CB_VALUE(item_value))) + { break; } } - for (item_purpose = item_value; item_purpose; item_purpose = CB_CHAIN (item_purpose)) { - if (CB_VALUE (item_purpose) && CB_PAIR_P (CB_VALUE (item_purpose))) { + for (item_purpose = item_value; item_purpose; item_purpose = CB_CHAIN(item_purpose)) + { + if (CB_VALUE(item_purpose) && CB_PAIR_P(CB_VALUE(item_purpose))) + { break; } } - if (item_value) { - switch (CB_TREE_TAG (CB_PAIR_Y (item_value))) { + if (item_value) + { + switch (CB_TREE_TAG(CB_PAIR_Y(item_value))) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (CB_PAIR_Y (item_value))); - cb_get_jisword_buff ((char*)pfield->name, name1, sizeof (name1)); + pfield = CB_FIELD(cb_ref(CB_PAIR_Y(item_value))); + cb_get_jisword_buff((char *)pfield->name, name1, sizeof(name1)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (CB_PAIR_Y (item_value)); + pliteral = CB_LITERAL(CB_PAIR_Y(item_value)); size = pliteral->size; - strcpy (name1, "\'"); - if (size >= 253) { - memcpy (name1+1, pliteral->data, 253); - } else { - memcpy (name1+1, pliteral->data, size); + strcpy(name1, "\'"); + if (size >= 253) + { + memcpy(name1 + 1, pliteral->data, 253); } - strcat (name1, "\'"); + else + { + memcpy(name1 + 1, pliteral->data, size); + } + strcat(name1, "\'"); break; default: break; } - if (item_purpose != NULL && CB_PAIR_X (CB_VALUE (item_purpose)) != cb_int0 && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_zero && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_space && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_quote && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_high && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_low) { - switch (CB_TREE_TAG (CB_PAIR_X (CB_VALUE (item_purpose)))) { + if (item_purpose != NULL && CB_PAIR_X(CB_VALUE(item_purpose)) != cb_int0 && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_zero && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_space && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_quote && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_high && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_low) + { + switch (CB_TREE_TAG(CB_PAIR_X(CB_VALUE(item_purpose)))) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (CB_PAIR_X (CB_VALUE (item_purpose)))); - cb_get_jisword_buff ((char*)pfield->name, name2, sizeof (name2)); + pfield = CB_FIELD(cb_ref(CB_PAIR_X(CB_VALUE(item_purpose)))); + cb_get_jisword_buff((char *)pfield->name, name2, sizeof(name2)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (CB_PAIR_X (CB_VALUE (item_purpose))); + pliteral = CB_LITERAL(CB_PAIR_X(CB_VALUE(item_purpose))); size = pliteral->size; - strcpy (name2, "\'"); - if (size >= 253) { - memcpy (name2+1, pliteral->data, 253); - } else { - memcpy (name2+1, pliteral->data, size); + strcpy(name2, "\'"); + if (size >= 253) + { + memcpy(name2 + 1, pliteral->data, 253); + } + else + { + memcpy(name2 + 1, pliteral->data, size); } - strcat (name2, "\'"); + strcat(name2, "\'"); break; default: break; } } - switch (CB_TREE_TAG (into)) { + switch (CB_TREE_TAG(into)) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (into)); - cb_get_jisword_buff ((char*)pfield->name, name3, sizeof (name3)); + pfield = CB_FIELD(cb_ref(into)); + cb_get_jisword_buff((char *)pfield->name, name3, sizeof(name3)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (into); + pliteral = CB_LITERAL(into); size = pliteral->size; - strcpy (name3, "\'"); - if (size >= 253) { - memcpy (name3+1, pliteral->data, 253); - } else { - memcpy (name3+1, pliteral->data, size); + strcpy(name3, "\'"); + if (size >= 253) + { + memcpy(name3 + 1, pliteral->data, 253); + } + else + { + memcpy(name3 + 1, pliteral->data, size); } - strcat (name3, "\'"); + strcat(name3, "\'"); break; default: break; } - switch (CB_TREE_CATEGORY (into)) { + switch (CB_TREE_CATEGORY(into)) + { case CB_CATEGORY_ALPHANUMERIC_EDITED: case CB_CATEGORY_NATIONAL_EDITED: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_TREE_CATEGORY (CB_PAIR_Y (item_value))) { + switch (CB_TREE_CATEGORY(CB_PAIR_Y(item_value))) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_PAIR_Y (item_value)))->usage) { + switch (CB_FIELD(cb_ref(CB_PAIR_Y(item_value)))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_Y (item_value), _("%s must be a non-comp type!"), name1); + cb_warning_x(CB_PAIR_Y(item_value), _("%s must be a non-comp type!"), name1); break; default: break; @@ -6945,16 +8136,18 @@ cb_validate_string (cb_tree items, cb_tree into) default: break; } - switch (CB_TREE_CATEGORY (CB_PAIR_X (CB_VALUE (item_purpose)))) { + switch (CB_TREE_CATEGORY(CB_PAIR_X(CB_VALUE(item_purpose)))) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_PAIR_X (CB_VALUE (item_purpose))))->usage) { + switch (CB_FIELD(cb_ref(CB_PAIR_X(CB_VALUE(item_purpose))))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_X (CB_VALUE (item_purpose)), _("%s must be a non-comp type!"), name2); + cb_warning_x(CB_PAIR_X(CB_VALUE(item_purpose)), _("%s must be a non-comp type!"), name2); break; default: break; @@ -6963,99 +8156,108 @@ cb_validate_string (cb_tree items, cb_tree into) default: break; } - cb_error_x (into, "%s must be a non-edit type!", name3); + cb_error_x(into, "%s must be a non-edit type!", name3); break; case CB_CATEGORY_NUMERIC: - switch (CB_TREE_CATEGORY (CB_PAIR_Y (item_value))) { + switch (CB_TREE_CATEGORY(CB_PAIR_Y(item_value))) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_PAIR_Y (item_value)))->usage) { + switch (CB_FIELD(cb_ref(CB_PAIR_Y(item_value)))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_Y (item_value), _("%s must be a non-comp type!"), name1); + cb_warning_x(CB_PAIR_Y(item_value), _("%s must be a non-comp type!"), name1); break; default: break; } break; -#ifndef I18N_UTF8 +#ifndef I18N_UTF8 case CB_CATEGORY_NATIONAL: case CB_CATEGORY_NATIONAL_EDITED: - cb_warning_x (into, _("%s and %s and %s have not same national type!"), name1, name2, name3); + cb_warning_x(into, _("%s and %s and %s have not same national type!"), name1, name2, name3); break; #endif /*I18N_UTF8*/ default: break; } - switch (CB_TREE_CATEGORY (CB_PAIR_X (CB_VALUE (item_purpose)))) { + switch (CB_TREE_CATEGORY(CB_PAIR_X(CB_VALUE(item_purpose)))) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_PAIR_X (CB_VALUE (item_purpose))))->usage) { + switch (CB_FIELD(cb_ref(CB_PAIR_X(CB_VALUE(item_purpose))))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_X (CB_VALUE (item_purpose)), _("%s must be a non-comp type!"), name2); + cb_warning_x(CB_PAIR_X(CB_VALUE(item_purpose)), _("%s must be a non-comp type!"), name2); break; default: break; } break; -#ifndef I18N_UTF8 +#ifndef I18N_UTF8 case CB_CATEGORY_NATIONAL: case CB_CATEGORY_NATIONAL_EDITED: - cb_warning_x (into, _("%s and %s and %s have not same national type!"), name1, name2, name3); + cb_warning_x(into, _("%s and %s and %s have not same national type!"), name1, name2, name3); break; #endif /*I18N_UTF8*/ default: break; } - switch (CB_FIELD (cb_ref (into))->usage) { + switch (CB_FIELD(cb_ref(into))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (into, _("%s must be a non-comp type!"), name3); + cb_warning_x(into, _("%s must be a non-comp type!"), name3); break; default: break; } break; case CB_CATEGORY_NATIONAL: - switch (CB_TREE_CATEGORY (CB_PAIR_Y (item_value))) { + switch (CB_TREE_CATEGORY(CB_PAIR_Y(item_value))) + { case CB_CATEGORY_NATIONAL: case CB_CATEGORY_NATIONAL_EDITED: - if (item_purpose != NULL && CB_PAIR_X (CB_VALUE (item_purpose)) != cb_int0 && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_zero && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_space && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_quote && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_high && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_low) { - switch (CB_TREE_CATEGORY (CB_PAIR_X (CB_VALUE (item_purpose)))) { + if (item_purpose != NULL && CB_PAIR_X(CB_VALUE(item_purpose)) != cb_int0 && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_zero && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_space && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_quote && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_high && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_low) + { + switch (CB_TREE_CATEGORY(CB_PAIR_X(CB_VALUE(item_purpose)))) + { case CB_CATEGORY_NATIONAL: case CB_CATEGORY_NATIONAL_EDITED: break; case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_PAIR_X (CB_VALUE (item_purpose))))->usage) { + switch (CB_FIELD(cb_ref(CB_PAIR_X(CB_VALUE(item_purpose))))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_X (CB_VALUE (item_purpose)), _("%s must be a non-comp type!"), name2); + cb_warning_x(CB_PAIR_X(CB_VALUE(item_purpose)), _("%s must be a non-comp type!"), name2); break; default: break; } default: -#ifndef I18N_UTF8 - cb_warning_x (into, _("%s and %s and %s have not same national type!"), name1, name2, name3); +#ifndef I18N_UTF8 + cb_warning_x(into, _("%s and %s and %s have not same national type!"), name1, name2, name3); #endif /*I18N_UTF8*/ break; } @@ -7063,27 +8265,31 @@ cb_validate_string (cb_tree items, cb_tree into) break; case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_PAIR_Y (item_value)))->usage) { + switch (CB_FIELD(cb_ref(CB_PAIR_Y(item_value)))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_Y (item_value), _("%s must be a non-comp type!"), name1); + cb_warning_x(CB_PAIR_Y(item_value), _("%s must be a non-comp type!"), name1); break; default: break; } default: -#ifndef I18N_UTF8 - if (CB_PAIR_X (CB_VALUE (item_purpose)) == cb_zero || - CB_PAIR_X (CB_VALUE (item_purpose)) == cb_space || - CB_PAIR_X (CB_VALUE (item_purpose)) == cb_quote || - CB_PAIR_X (CB_VALUE (item_purpose)) == cb_high || - CB_PAIR_X (CB_VALUE (item_purpose)) == cb_low) { - cb_warning_x (into, _("%s and %s have not same national type!"), name1, name3); - } else { - cb_warning_x (into, _("%s and %s and %s have not same national type!"), name1, name2, name3); +#ifndef I18N_UTF8 + if (CB_PAIR_X(CB_VALUE(item_purpose)) == cb_zero || + CB_PAIR_X(CB_VALUE(item_purpose)) == cb_space || + CB_PAIR_X(CB_VALUE(item_purpose)) == cb_quote || + CB_PAIR_X(CB_VALUE(item_purpose)) == cb_high || + CB_PAIR_X(CB_VALUE(item_purpose)) == cb_low) + { + cb_warning_x(into, _("%s and %s have not same national type!"), name1, name3); + } + else + { + cb_warning_x(into, _("%s and %s and %s have not same national type!"), name1, name2, name3); } #endif /*I18N_UTF8*/ break; @@ -7091,38 +8297,42 @@ cb_validate_string (cb_tree items, cb_tree into) break; case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: - switch (CB_TREE_CATEGORY (CB_PAIR_Y (item_value))) { + switch (CB_TREE_CATEGORY(CB_PAIR_Y(item_value))) + { case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: case CB_CATEGORY_ALPHANUMERIC_EDITED: - if (item_purpose != NULL && CB_PAIR_X (CB_VALUE (item_purpose)) != cb_int0 && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_zero && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_space && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_quote && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_high && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_low) { - switch (CB_TREE_CATEGORY (CB_PAIR_X (CB_VALUE (item_purpose)))) { + if (item_purpose != NULL && CB_PAIR_X(CB_VALUE(item_purpose)) != cb_int0 && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_zero && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_space && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_quote && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_high && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_low) + { + switch (CB_TREE_CATEGORY(CB_PAIR_X(CB_VALUE(item_purpose)))) + { case CB_CATEGORY_ALPHABETIC: case CB_CATEGORY_ALPHANUMERIC: case CB_CATEGORY_ALPHANUMERIC_EDITED: break; case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_PAIR_X (CB_VALUE (item_purpose))))->usage) { + switch (CB_FIELD(cb_ref(CB_PAIR_X(CB_VALUE(item_purpose))))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_X (CB_VALUE (item_purpose)), _("%s must be a non-comp type!"), name2); + cb_warning_x(CB_PAIR_X(CB_VALUE(item_purpose)), _("%s must be a non-comp type!"), name2); break; default: break; } break; default: -#ifndef I18N_UTF8 - cb_warning_x (into, _("%s and %s and %s have not same national type!"), name1, name2, name3); +#ifndef I18N_UTF8 + cb_warning_x(into, _("%s and %s and %s have not same national type!"), name1, name2, name3); #endif /*I18N_UTF8*/ break; } @@ -7130,39 +8340,43 @@ cb_validate_string (cb_tree items, cb_tree into) break; case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - if (item_purpose != NULL && CB_PAIR_X (CB_VALUE (item_purpose)) != cb_int0 && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_zero && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_space && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_quote && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_high && - CB_PAIR_X (CB_VALUE (item_purpose)) != cb_low) { - switch (CB_FIELD (cb_ref (CB_PAIR_Y (item_value)))->usage) { + if (item_purpose != NULL && CB_PAIR_X(CB_VALUE(item_purpose)) != cb_int0 && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_zero && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_space && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_quote && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_high && + CB_PAIR_X(CB_VALUE(item_purpose)) != cb_low) + { + switch (CB_FIELD(cb_ref(CB_PAIR_Y(item_value)))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_Y (item_value), _("%s must be a non-comp type!"), name1); + cb_warning_x(CB_PAIR_Y(item_value), _("%s must be a non-comp type!"), name1); break; default: break; } - switch (CB_TREE_CATEGORY (CB_PAIR_X (CB_VALUE (item_purpose)))) { -#ifndef I18N_UTF8 + switch (CB_TREE_CATEGORY(CB_PAIR_X(CB_VALUE(item_purpose)))) + { +#ifndef I18N_UTF8 case CB_CATEGORY_NATIONAL: case CB_CATEGORY_NATIONAL_EDITED: - cb_warning_x (into, _("%s and %s and %s have not same national type!"), name1, name2, name3); + cb_warning_x(into, _("%s and %s and %s have not same national type!"), name1, name2, name3); break; #endif /*I18N_UTF8*/ case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_PAIR_X (CB_VALUE (item_purpose))))->usage) { + switch (CB_FIELD(cb_ref(CB_PAIR_X(CB_VALUE(item_purpose))))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_PAIR_X (CB_VALUE (item_purpose)), _("%s must be a non-comp type!"), name2); + cb_warning_x(CB_PAIR_X(CB_VALUE(item_purpose)), _("%s must be a non-comp type!"), name2); break; default: break; @@ -7174,8 +8388,8 @@ cb_validate_string (cb_tree items, cb_tree into) } break; default: -#ifndef I18N_UTF8 - cb_warning_x (into, _("%s and %s and %s have not same national type!"), name1, name2, name3); +#ifndef I18N_UTF8 + cb_warning_x(into, _("%s and %s and %s have not same national type!"), name1, name2, name3); #endif /*I18N_UTF8*/ break; } @@ -7184,63 +8398,68 @@ cb_validate_string (cb_tree items, cb_tree into) break; } } - start = item_value ? CB_CHAIN (item_value) : NULL; + start = item_value ? CB_CHAIN(item_value) : NULL; } } -void -cb_emit_string (cb_tree items, cb_tree into, cb_tree pointer) +void cb_emit_string(cb_tree items, cb_tree into, cb_tree pointer) { cb_tree start; cb_tree l; cb_tree end; cb_tree dlm; - if (cb_validate_one (into)) { + if (cb_validate_one(into)) + { return; } - if (cb_validate_one (pointer) || cb_validate_numeric (pointer)) { + if (cb_validate_one(pointer) || cb_validate_numeric(pointer)) + { return; } - cb_validate_string (items, into); + cb_validate_string(items, into); start = items; - cb_emit (cb_build_funcall_2 ("CobolString.stringInit", into, pointer)); - while (start) { + cb_emit(cb_build_funcall_2("CobolString.stringInit", into, pointer)); + while (start) + { /* find DELIMITED item */ - for (end = start; end; end = CB_CHAIN (end)) { - if (CB_PAIR_P (CB_VALUE (end))) { + for (end = start; end; end = CB_CHAIN(end)) + { + if (CB_PAIR_P(CB_VALUE(end))) + { break; } } /* cob_string_delimited */ - dlm = end ? CB_PAIR_X (CB_VALUE (end)) : cb_int0; - cb_emit (cb_build_funcall_1 ("CobolString.stringDelimited", dlm)); + dlm = end ? CB_PAIR_X(CB_VALUE(end)) : cb_int0; + cb_emit(cb_build_funcall_1("CobolString.stringDelimited", dlm)); /* cob_string_append */ - for (l = start; l != end; l = CB_CHAIN (l)) { - cb_emit (cb_build_funcall_1 ("CobolString.stringAppend", CB_VALUE (l))); + for (l = start; l != end; l = CB_CHAIN(l)) + { + cb_emit(cb_build_funcall_1("CobolString.stringAppend", CB_VALUE(l))); } - start = end ? CB_CHAIN (end) : NULL; + start = end ? CB_CHAIN(end) : NULL; } - cb_emit (cb_build_funcall_0 ("CobolString.stringFinish")); + cb_emit(cb_build_funcall_0("CobolString.stringFinish")); } /* * UNLOCK statement */ -void -cb_emit_unlock (cb_tree ref) +void cb_emit_unlock(cb_tree ref) { - cb_tree file; + cb_tree file; - if (ref != cb_error_node) { - file = cb_ref (ref); - cb_emit (cb_build_method_call_2 ("unlock", - file, CB_FILE(file)->file_status)); + if (ref != cb_error_node) + { + file = cb_ref(ref); + cb_emit(cb_build_method_call_2("unlock", + file, CB_FILE(file)->file_status)); current_statement->file = file; } } @@ -7250,54 +8469,60 @@ cb_emit_unlock (cb_tree ref) */ static void -cb_validate_unstring (cb_tree name, cb_tree delimited, cb_tree into) -{ - cb_tree item_value1; - cb_tree item_value2; - cb_tree start1; - cb_tree start2; - - char name1[256], name2[256], name3[256], name4[256], name5[256]; - struct cb_field *pfield; - struct cb_literal *pliteral; - int size; - int nationalflg = 0; - int nationalflg2 = 0; - char buff[1024]; - - memset (buff, 0, sizeof (buff)); - memset (name1, 0, sizeof (name1)); - switch (CB_TREE_TAG (name)) { +cb_validate_unstring(cb_tree name, cb_tree delimited, cb_tree into) +{ + cb_tree item_value1; + cb_tree item_value2; + cb_tree start1; + cb_tree start2; + + char name1[256], name2[256], name3[256], name4[256], name5[256]; + struct cb_field *pfield; + struct cb_literal *pliteral; + int size; + int nationalflg = 0; + int nationalflg2 = 0; + char buff[1024]; + + memset(buff, 0, sizeof(buff)); + memset(name1, 0, sizeof(name1)); + switch (CB_TREE_TAG(name)) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (name)); - cb_get_jisword_buff ((char*)pfield->name, name1, sizeof (name1)); + pfield = CB_FIELD(cb_ref(name)); + cb_get_jisword_buff((char *)pfield->name, name1, sizeof(name1)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (name); + pliteral = CB_LITERAL(name); size = pliteral->size; - strcpy (name1, "\'"); - if (size >= 253) { - memcpy (name1+1, pliteral->data, 253); - } else { - memcpy (name1+1, pliteral->data, size); + strcpy(name1, "\'"); + if (size >= 253) + { + memcpy(name1 + 1, pliteral->data, 253); } - strcat (name1, "\'"); + else + { + memcpy(name1 + 1, pliteral->data, size); + } + strcat(name1, "\'"); break; default: break; } - switch (CB_TREE_CATEGORY (name)) { + switch (CB_TREE_CATEGORY(name)) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - strcpy (buff, name1); - strcat (buff, ","); - switch (CB_FIELD (cb_ref (name))->usage) { + strcpy(buff, name1); + strcat(buff, ","); + switch (CB_FIELD(cb_ref(name))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (name, _("%s must be a non-comp type!"), name1); + cb_warning_x(name, _("%s must be a non-comp type!"), name1); break; default: break; @@ -7309,56 +8534,69 @@ cb_validate_unstring (cb_tree name, cb_tree delimited, cb_tree into) nationalflg2 = 1; break; default: - strcpy (buff, name1); - strcat (buff, ","); + strcpy(buff, name1); + strcat(buff, ","); break; } start1 = delimited; - while (start1) { - for (item_value1 = start1; item_value1; item_value1 = CB_CHAIN (item_value1)) { - memset (name2, 0, sizeof (name2)); - if (CB_VALUE (item_value1)) { - switch (CB_TREE_TAG (CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0])) { + while (start1) + { + for (item_value1 = start1; item_value1; item_value1 = CB_CHAIN(item_value1)) + { + memset(name2, 0, sizeof(name2)); + if (CB_VALUE(item_value1)) + { + switch (CB_TREE_TAG(CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0])) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0])); - cb_get_jisword_buff ((char*)pfield->name, name2, sizeof (name2)); + pfield = CB_FIELD(cb_ref(CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0])); + cb_get_jisword_buff((char *)pfield->name, name2, sizeof(name2)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0]); + pliteral = CB_LITERAL(CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0]); size = pliteral->size; - strcpy (name2, "\'"); - if (size >= 253) { - memcpy (name2+1, pliteral->data, 253); - } else { - memcpy (name2+1, pliteral->data, size); + strcpy(name2, "\'"); + if (size >= 253) + { + memcpy(name2 + 1, pliteral->data, 253); + } + else + { + memcpy(name2 + 1, pliteral->data, size); } - strcat (name2, "\'"); + strcat(name2, "\'"); break; default: break; } if (item_value1 != NULL && - CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0] != cb_zero && - CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0] != cb_space && - CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0] != cb_quote && - CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0] != cb_high && - CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0] != cb_low) { - switch (CB_TREE_CATEGORY (CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0])) { + CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0] != cb_zero && + CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0] != cb_space && + CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0] != cb_quote && + CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0] != cb_high && + CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0] != cb_low) + { + switch (CB_TREE_CATEGORY(CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0])) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - if (sizeof (buff) == 0) { - strcpy (buff, name2); - } else { - strcat (buff, name2); + if (sizeof(buff) == 0) + { + strcpy(buff, name2); } - strcat (buff, ","); - switch (CB_FIELD (cb_ref (CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0]))->usage) { + else + { + strcat(buff, name2); + } + strcat(buff, ","); + switch (CB_FIELD(cb_ref(CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0]))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_FUNCALL (CB_PAIR_Y (item_value1))->argv[0], _("%s must be a non-comp type!"), name2); + cb_warning_x(CB_FUNCALL(CB_PAIR_Y(item_value1))->argv[0], _("%s must be a non-comp type!"), name2); break; default: break; @@ -7370,65 +8608,81 @@ cb_validate_unstring (cb_tree name, cb_tree delimited, cb_tree into) nationalflg2 = 1; break; default: - if (sizeof (buff) == 0) { - strcpy (buff, name2); - } else { - strcat (buff, name2); + if (sizeof(buff) == 0) + { + strcpy(buff, name2); + } + else + { + strcat(buff, name2); } - strcat (buff, ","); + strcat(buff, ","); nationalflg &= 0; break; } } } } - start1 = item_value1 ? CB_CHAIN (item_value1) : NULL; + start1 = item_value1 ? CB_CHAIN(item_value1) : NULL; } start2 = into; - while (start2) { - for (item_value2 = start2; item_value2; item_value2 = CB_CHAIN (item_value2)) { - memset (name3, 0, sizeof (name3)); - if (CB_VALUE (item_value2)) { - switch (CB_TREE_TAG (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0])) { + while (start2) + { + for (item_value2 = start2; item_value2; item_value2 = CB_CHAIN(item_value2)) + { + memset(name3, 0, sizeof(name3)); + if (CB_VALUE(item_value2)) + { + switch (CB_TREE_TAG(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0])) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0])); - cb_get_jisword_buff ((char*)pfield->name, name3, sizeof (name3)); + pfield = CB_FIELD(cb_ref(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0])); + cb_get_jisword_buff((char *)pfield->name, name3, sizeof(name3)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0]); + pliteral = CB_LITERAL(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0]); size = pliteral->size; - strcpy (name3, "\'"); - if (size >= 253) { - memcpy (name3+1, pliteral->data, 253); - } else { - memcpy (name3+1, pliteral->data, size); + strcpy(name3, "\'"); + if (size >= 253) + { + memcpy(name3 + 1, pliteral->data, 253); } - strcat (name3, "\'"); + else + { + memcpy(name3 + 1, pliteral->data, size); + } + strcat(name3, "\'"); break; default: break; } if (item_value2 != NULL && - CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0] != cb_zero && - CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0] != cb_space && - CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0] != cb_quote && - CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0] != cb_high && - CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0] != cb_low) { - switch (CB_TREE_CATEGORY (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0])) { + CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0] != cb_zero && + CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0] != cb_space && + CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0] != cb_quote && + CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0] != cb_high && + CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0] != cb_low) + { + switch (CB_TREE_CATEGORY(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0])) + { case CB_CATEGORY_NUMERIC: - if (sizeof (buff) == 0) { - strcpy (buff, name3); - } else { - strcat (buff, name3); + if (sizeof(buff) == 0) + { + strcpy(buff, name3); + } + else + { + strcat(buff, name3); } - strcat (buff, ","); - switch (CB_FIELD (cb_ref (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0]))->usage) { + strcat(buff, ","); + switch (CB_FIELD(cb_ref(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0]))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0], _("%s must be a non-comp type!"), name3); + cb_warning_x(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0], _("%s must be a non-comp type!"), name3); break; default: break; @@ -7440,59 +8694,72 @@ cb_validate_unstring (cb_tree name, cb_tree delimited, cb_tree into) break; case CB_CATEGORY_ALPHANUMERIC_EDITED: case CB_CATEGORY_NUMERIC_EDITED: - if (sizeof (buff) == 0) { - strcpy (buff, name3); - } else { - strcat (buff, name3); + if (sizeof(buff) == 0) + { + strcpy(buff, name3); + } + else + { + strcat(buff, name3); } - strcat (buff, ","); - cb_error_x (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0], "%s must be a non-edit type!", name3); + strcat(buff, ","); + cb_error_x(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0], "%s must be a non-edit type!", name3); break; case CB_CATEGORY_NATIONAL_EDITED: - cb_error_x (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[0], "%s must be a non-edit type!", name3); + cb_error_x(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[0], "%s must be a non-edit type!", name3); break; default: - if (sizeof (buff) == 0) { - strcpy (buff, name3); - } else { - strcat (buff, name3); + if (sizeof(buff) == 0) + { + strcpy(buff, name3); } - strcat (buff, ","); + else + { + strcat(buff, name3); + } + strcat(buff, ","); nationalflg &= 0; break; } } - memset (name4, 0, sizeof (name4)); - switch (CB_TREE_TAG (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[1])) { + memset(name4, 0, sizeof(name4)); + switch (CB_TREE_TAG(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[1])) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[1])); - cb_get_jisword_buff ((char*)pfield->name, name4, sizeof (name4)); + pfield = CB_FIELD(cb_ref(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[1])); + cb_get_jisword_buff((char *)pfield->name, name4, sizeof(name4)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[1]); + pliteral = CB_LITERAL(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[1]); size = pliteral->size; - strcpy (name4, "\'"); - if (size >= 253) { - memcpy (name4+1, pliteral->data, 253); - } else { - memcpy (name4+1, pliteral->data, size); + strcpy(name4, "\'"); + if (size >= 253) + { + memcpy(name4 + 1, pliteral->data, 253); + } + else + { + memcpy(name4 + 1, pliteral->data, size); } - strcat (name4, "\'"); + strcat(name4, "\'"); break; default: break; } - if (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[1] != cb_int0) { - switch (CB_TREE_CATEGORY (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[1])) { + if (CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[1] != cb_int0) + { + switch (CB_TREE_CATEGORY(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[1])) + { case CB_CATEGORY_NUMERIC: case CB_CATEGORY_NUMERIC_EDITED: - switch (CB_FIELD (cb_ref (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[1]))->usage) { + switch (CB_FIELD(cb_ref(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[1]))->usage) + { case CB_USAGE_BINARY: case CB_USAGE_FLOAT: case CB_USAGE_DOUBLE: case CB_USAGE_PACKED: case CB_USAGE_COMP_5: - cb_warning_x (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[1], _("%s must be a non-comp type!"), name4); + cb_warning_x(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[1], _("%s must be a non-comp type!"), name4); break; default: break; @@ -7502,189 +8769,225 @@ cb_validate_unstring (cb_tree name, cb_tree delimited, cb_tree into) break; } } - memset (name5, 0, sizeof (name5)); - switch (CB_TREE_TAG (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[2])) { + memset(name5, 0, sizeof(name5)); + switch (CB_TREE_TAG(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[2])) + { case CB_TAG_REFERENCE: - pfield = CB_FIELD (cb_ref (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[2])); - cb_get_jisword_buff ((char*)pfield->name, name5, sizeof (name5)); + pfield = CB_FIELD(cb_ref(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[2])); + cb_get_jisword_buff((char *)pfield->name, name5, sizeof(name5)); break; case CB_TAG_LITERAL: - pliteral = CB_LITERAL (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[2]); + pliteral = CB_LITERAL(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[2]); size = pliteral->size; - strcpy (name5, "\'"); - if (size >= 253) { - memcpy (name5+1, pliteral->data, 253); - } else { - memcpy (name5+1, pliteral->data, size); + strcpy(name5, "\'"); + if (size >= 253) + { + memcpy(name5 + 1, pliteral->data, 253); + } + else + { + memcpy(name5 + 1, pliteral->data, size); } - strcat (name5, "\'"); + strcat(name5, "\'"); break; default: break; } - if (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[2] != cb_int0) { - switch (CB_TREE_CATEGORY (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[2])) { + if (CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[2] != cb_int0) + { + switch (CB_TREE_CATEGORY(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[2])) + { case CB_CATEGORY_NUMERIC: break; default: - cb_error_x (CB_FUNCALL (CB_PAIR_Y (item_value2))->argv[2], "%s must be a numeric type!", name5); + cb_error_x(CB_FUNCALL(CB_PAIR_Y(item_value2))->argv[2], "%s must be a numeric type!", name5); break; } } } } - start2 = item_value2 ? CB_CHAIN (item_value2) : NULL; + start2 = item_value2 ? CB_CHAIN(item_value2) : NULL; } - if (strlen (buff) != 0) { - buff[strlen (buff) - 1] = '\0'; + if (strlen(buff) != 0) + { + buff[strlen(buff) - 1] = '\0'; } - if (nationalflg != 1 && nationalflg2 == 1) { - cb_warning_x (name, _("%s must be national type!"), buff); + if (nationalflg != 1 && nationalflg2 == 1) + { + cb_warning_x(name, _("%s must be national type!"), buff); } } -void -cb_emit_unstring (cb_tree name, cb_tree delimited, cb_tree into, cb_tree pointer, cb_tree tallying) +void cb_emit_unstring(cb_tree name, cb_tree delimited, cb_tree into, cb_tree pointer, cb_tree tallying) { - if (cb_validate_one (name)) { + if (cb_validate_one(name)) + { return; } - if (cb_validate_one (tallying) || cb_validate_numeric (tallying)) { + if (cb_validate_one(tallying) || cb_validate_numeric(tallying)) + { return; } - if (cb_validate_list (delimited)) { + if (cb_validate_list(delimited)) + { return; } - if (cb_validate_list (into)) { + if (cb_validate_list(into)) + { return; } - if (cb_validate_one (pointer) ||cb_validate_numeric(pointer)) { + if (cb_validate_one(pointer) || cb_validate_numeric(pointer)) + { return; } - cb_validate_unstring (name, delimited, into); - cb_emit (cb_build_funcall_3 ("CobolString.unstringInit", name, pointer, - cb_int (cb_list_length (delimited)))); - cb_emit_list (delimited); - cb_emit_list (into); - if (tallying) { - cb_emit (cb_build_funcall_1 ("CobolString.unstringTallying", tallying)); + cb_validate_unstring(name, delimited, into); + cb_emit(cb_build_funcall_3("CobolString.unstringInit", name, pointer, + cb_int(cb_list_length(delimited)))); + cb_emit_list(delimited); + cb_emit_list(into); + if (tallying) + { + cb_emit(cb_build_funcall_1("CobolString.unstringTallying", tallying)); } - cb_emit (cb_build_funcall_0 ("CobolString.unstringFinish")); + cb_emit(cb_build_funcall_0("CobolString.unstringFinish")); } cb_tree -cb_build_unstring_delimited (cb_tree all, cb_tree value) +cb_build_unstring_delimited(cb_tree all, cb_tree value) { - if (cb_validate_one (value)) { + if (cb_validate_one(value)) + { return cb_error_node; } - return cb_build_funcall_2 ("CobolString.unstringDelimited", value, all); + return cb_build_funcall_2("CobolString.unstringDelimited", value, all); } cb_tree -cb_build_unstring_into (cb_tree name, cb_tree delimiter, cb_tree count) +cb_build_unstring_into(cb_tree name, cb_tree delimiter, cb_tree count) { - if (cb_validate_one (name)) { + if (cb_validate_one(name)) + { return cb_error_node; } - if (delimiter == NULL) { + if (delimiter == NULL) + { delimiter = cb_int0; } - if (count == NULL) { + if (count == NULL) + { count = cb_int0; } - return cb_build_funcall_3 ("CobolString.unstringInto", name, delimiter, count); + return cb_build_funcall_3("CobolString.unstringInto", name, delimiter, count); } /* * WRITE statement */ -void -cb_emit_write (cb_tree record, cb_tree from, cb_tree opt, cb_tree lockopt) +void cb_emit_write(cb_tree record, cb_tree from, cb_tree opt, cb_tree lockopt) { - cb_tree file; - int val; - - if (record != cb_error_node && cb_ref (record) != cb_error_node) { - if (!CB_REF_OR_FIELD_P (cb_ref (record))) { - cb_error_x (CB_TREE (current_statement), - _("WRITE requires a record name as subject")); + cb_tree file; + int val; + + if (record != cb_error_node && cb_ref(record) != cb_error_node) + { + if (!CB_REF_OR_FIELD_P(cb_ref(record))) + { + cb_error_x(CB_TREE(current_statement), + _("WRITE requires a record name as subject")); return; } - if (cb_field (record)->storage != CB_STORAGE_FILE) { - cb_error_x (CB_TREE (current_statement), - _("WRITE subject does not refer to a record name")); + if (cb_field(record)->storage != CB_STORAGE_FILE) + { + cb_error_x(CB_TREE(current_statement), + _("WRITE subject does not refer to a record name")); return; } - file = CB_TREE (CB_FIELD (cb_ref (record))->file); + file = CB_TREE(CB_FIELD(cb_ref(record))->file); current_statement->file = file; - if (CB_FILE (file)->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("Operation not allowed on SORT files")); - } else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY && - (CB_FILE(file)->organization != COB_ORG_RELATIVE && - CB_FILE(file)->organization != COB_ORG_INDEXED)) { - cb_error_x (CB_TREE(current_statement), - _("INVALID KEY clause invalid with this file type")); - } else if (lockopt) { - if ((CB_FILE (file)->lock_mode & COB_LOCK_AUTOMATIC)) { - cb_error_x (CB_TREE (current_statement), - _("LOCK clause invalid with file LOCK AUTOMATIC")); - } else if (opt != cb_int0) { - cb_error_x (CB_TREE (current_statement), - _("LOCK clause invalid here")); - } else if (lockopt == cb_int1) { - opt = cb_int (COB_WRITE_LOCK); - } - } - if (from) { - cb_emit (cb_build_move (from, record)); - } - if (CB_FILE (file)->organization == COB_ORG_LINE_SEQUENTIAL && - opt == cb_int0) { - opt = cb_int (COB_WRITE_BEFORE | COB_WRITE_LINES | 1); + if (CB_FILE(file)->organization == COB_ORG_SORT) + { + cb_error_x(CB_TREE(current_statement), + _("Operation not allowed on SORT files")); + } + else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY && + (CB_FILE(file)->organization != COB_ORG_RELATIVE && + CB_FILE(file)->organization != COB_ORG_INDEXED)) + { + cb_error_x(CB_TREE(current_statement), + _("INVALID KEY clause invalid with this file type")); + } + else if (lockopt) + { + if ((CB_FILE(file)->lock_mode & COB_LOCK_AUTOMATIC)) + { + cb_error_x(CB_TREE(current_statement), + _("LOCK clause invalid with file LOCK AUTOMATIC")); + } + else if (opt != cb_int0) + { + cb_error_x(CB_TREE(current_statement), + _("LOCK clause invalid here")); + } + else if (lockopt == cb_int1) + { + opt = cb_int(COB_WRITE_LOCK); + } + } + if (from) + { + cb_emit(cb_build_move(from, record)); + } + if (CB_FILE(file)->organization == COB_ORG_LINE_SEQUENTIAL && + opt == cb_int0) + { + opt = cb_int(COB_WRITE_BEFORE | COB_WRITE_LINES | 1); } /* RXW - This is horrible */ if (current_statement->handler_id == COB_EC_I_O_EOP && - current_statement->handler1) { - if (CB_CAST_P(opt)) { + current_statement->handler1) + { + if (CB_CAST_P(opt)) + { val = CB_INTEGER(CB_BINARY_OP(CB_CAST(opt)->val)->x)->val; val |= COB_WRITE_EOP; - CB_BINARY_OP(CB_CAST(opt)->val)->x = cb_int (val); - } else { + CB_BINARY_OP(CB_CAST(opt)->val)->x = cb_int(val); + } + else + { val = CB_INTEGER(opt)->val; val |= COB_WRITE_EOP; - opt = cb_int (val); + opt = cb_int(val); } } - cb_emit (cb_build_method_call_4 ("write", file, record, opt, - CB_FILE(file)->file_status)); + cb_emit(cb_build_method_call_4("write", file, record, opt, + CB_FILE(file)->file_status)); } } cb_tree -cb_build_write_advancing_lines (cb_tree pos, cb_tree lines) +cb_build_write_advancing_lines(cb_tree pos, cb_tree lines) { - cb_tree e; - int opt; + cb_tree e; + int opt; opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER; - e = cb_build_binary_op (cb_int (opt | COB_WRITE_LINES), '+', lines); - return cb_build_cast_integer (e); + e = cb_build_binary_op(cb_int(opt | COB_WRITE_LINES), '+', lines); + return cb_build_cast_integer(e); } cb_tree -cb_build_write_advancing_mnemonic (cb_tree pos, cb_tree mnemonic) +cb_build_write_advancing_mnemonic(cb_tree pos, cb_tree mnemonic) { - int opt; - int token; + int opt; + int token; - token = CB_SYSTEM_NAME (cb_ref (mnemonic))->token; - switch (token) { + token = CB_SYSTEM_NAME(cb_ref(mnemonic))->token; + switch (token) + { case CB_FEATURE_FORMFEED: opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER; - return cb_int (opt | COB_WRITE_PAGE); + return cb_int(opt | COB_WRITE_PAGE); case CB_FEATURE_C01: case CB_FEATURE_C02: case CB_FEATURE_C03: @@ -7698,34 +9001,37 @@ cb_build_write_advancing_mnemonic (cb_tree pos, cb_tree mnemonic) case CB_FEATURE_C11: case CB_FEATURE_C12: opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER; - return cb_int (opt | COB_WRITE_CHANNEL | COB_WRITE_PAGE | token); + return cb_int(opt | COB_WRITE_CHANNEL | COB_WRITE_PAGE | token); default: - cb_error_x (mnemonic, _("Invalid mnemonic name")); + cb_error_x(mnemonic, _("Invalid mnemonic name")); return cb_error_node; } } cb_tree -cb_build_write_advancing_page (cb_tree pos) +cb_build_write_advancing_page(cb_tree pos) { int opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER; - return cb_int (opt | COB_WRITE_PAGE); + return cb_int(opt | COB_WRITE_PAGE); } cb_tree -cb_check_zero_division (cb_tree x) +cb_check_zero_division(cb_tree x) { - if (x == cb_error_node) { + if (x == cb_error_node) + { return cb_error_node; } - if (! CB_NUMERIC_LITERAL_P (x)) { + if (!CB_NUMERIC_LITERAL_P(x)) + { return x; } - if (cb_get_int(x) == 0) { - cb_error_x (x, _("Detected division by zero.")); + if (cb_get_int(x) == 0) + { + cb_error_x(x, _("Detected division by zero.")); return cb_error_node; } diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java index b78ef712..f154d2e1 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java @@ -25,6 +25,7 @@ import java.nio.channels.NonWritableChannelException; import java.nio.channels.OverlappingFileLockException; import java.nio.file.Files; +import java.nio.file.Path; import java.nio.file.Paths; import java.nio.file.StandardOpenOption; import java.util.ArrayList; @@ -146,6 +147,7 @@ public class CobolFile { protected static final int EACCESS = 13; protected static final int EISDIR = 21; protected static final int EROFS = 30; + protected static final int EAGAIN = 11; public static CobolFile errorFile; @@ -1294,7 +1296,9 @@ public static void rollback() { public static void exitFileIO() { for (CobolFile f : file_cache) { if (f.open_mode != COB_OPEN_CLOSED && f.open_mode != COB_OPEN_LOCKED) { - System.err.println(String.format("WRNING - IMPLICIT CLOSE of %s", f.select_name)); + String filename = f.assign.fieldToString(); + System.err.print( + String.format("WARNING - Implicit CLOSE of %s (\"%s\") \n", f.select_name, filename)); } } } @@ -1415,4 +1419,135 @@ public static void defaultErrorHandle() { String filename = CobolFile.errorFile.assign.fieldToString(); CobolUtil.runtimeError(String.format("%s (STATUS = %02d) File : '%s'", msg, status, filename)); } + + public void cob_delete_file(AbstractCobolField fnstatus) { + String openMode = String.format("%02d", (int) this.last_open_mode); + if (invokeFun(COB_IO_DELETE_FILE, this, null, null, fnstatus, openMode, null, null) != 0) { + return; + } + + if (this.open_mode == COB_OPEN_LOCKED) { + saveStatus(COB_STATUS_38_CLOSED_WITH_LOCK, fnstatus); + return; + } + + /* file is already open */ + if (this.open_mode != COB_OPEN_CLOSED) { + saveStatus(COB_STATUS_41_ALREADY_OPEN, fnstatus); + return; + } + + if (this.special != 0) { + saveStatus(COB_STATUS_30_PERMANENT_ERROR, fnstatus); + return; + } + + if (this.assign == null) { + file_open_name = this.select_name; + } else { + file_open_name = this.assign.fieldToString(); + } + + byte[] src; + byte[] dst; + boolean simple; + if (CobolModule.getCurrentModule().flag_filename_mapping != 0) { + src = file_open_name.getBytes(); + dst = file_open_buff; + simple = true; + int src_i = 0; + int dst_i = 0; + while (src_i < src.length) { + char c = (char) src[src_i]; + if (!Character.isLetterOrDigit(c) && c != '_' && c != '-') { + simple = false; + } + if (c == '$') { + int i; + for (i = 1; src_i + i < src.length; i++) { + char d = (char) src[src_i + i]; + if (!Character.isLetterOrDigit(d) && d != '_' && c != '-') { + break; + } + } + for (int j = 0; j < i - 1; ++j) { + file_open_env[j] = src[src_i + 1 + j]; + } + file_open_env[i - 1] = 0; + String p = System.getenv(new String(Arrays.copyOfRange(file_open_env, 0, i - 1))); + if (p != null) { + byte[] pbytes = p.getBytes(); + for (int j = 0; j < pbytes.length; ++j) { + dst[dst_i + j] = pbytes[j]; + } + dst_i += pbytes.length; + } + src_i += i; + } else { + dst[dst_i++] = src[src_i++]; + } + } + + file_open_name = new String(Arrays.copyOfRange(dst, 0, dst_i)); + + byte[] file_open_name_bytes = file_open_name.getBytes(); + cb_get_jisword_buff(file_open_buff, file_open_name_bytes, COB_SMALL_BUFF); + + if (simple) { + int i; + for (i = 0; i < NUM_PREFIX; i++) { + byte[] file_open_buff = String.format("%s%s", prefix[i], file_open_name).getBytes(); + String p; + if ((p = System.getenv(new String(file_open_buff))) != null) { + file_open_name_bytes = p.getBytes(); + break; + } + } + + if (i == NUM_PREFIX && cob_file_path != null) { + byte[] file_open_buff = String.format("%s/%s", cob_file_path, file_open_name).getBytes(); + file_open_name_bytes = file_open_buff; + } + } + + file_open_name = new String(file_open_name_bytes); + } + + Path filePath = Paths.get(this.assign.fieldToString()); + try { + saveStatus(COB_STATUS_00_SUCCESS, fnstatus); + Files.delete(filePath); + return; + } catch (IOException e) { + int mode = (int) this.last_open_mode; + try { + switch (this.open_(file_open_name, mode, 0)) { + case ENOENT: + saveStatus(COB_STATUS_35_NOT_EXISTS, fnstatus); + return; + case EACCESS: + case EISDIR: + case EROFS: + saveStatus(COB_STATUS_37_PERMISSION_DENIED, fnstatus); + return; + case EAGAIN: + case COB_STATUS_61_FILE_SHARING: + saveStatus(COB_STATUS_61_FILE_SHARING, fnstatus); + return; + case COB_STATUS_91_NOT_AVAILABLE: + saveStatus(COB_STATUS_91_NOT_AVAILABLE, fnstatus); + return; + case COB_LINAGE_INVALID: + saveStatus(COB_STATUS_57_I_O_LINAGE, fnstatus); + return; + default: + saveStatus(COB_STATUS_30_PERMANENT_ERROR, fnstatus); + return; + } + } catch (IOException e1) { + saveStatus(COB_STATUS_30_PERMANENT_ERROR, fnstatus); + return; + } + } + } } diff --git a/tests/jp-compat.src/file-control.at b/tests/jp-compat.src/file-control.at index b9727cd7..63367291 100644 --- a/tests/jp-compat.src/file-control.at +++ b/tests/jp-compat.src/file-control.at @@ -257,7 +257,6 @@ AT_CHECK([export OC_EXTEND_CREATES=yes && ${RUN_MODULE} prog], [0], [00 AT_CLEANUP AT_SETUP([Allow file delete (SEQUENTIAL)]) -AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. @@ -290,7 +289,6 @@ AT_CHECK([${RUN_MODULE} prog], [0], [00 AT_CLEANUP AT_SETUP([Allow file delete (LINE SEQ)]) -AT_CHECK([${SKIP_TEST}]) AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. From 6068c82fb877a54b006cd04dbbab0fec96d30ced Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Fri, 20 Jan 2023 17:39:20 +0900 Subject: [PATCH 11/17] Implement -java-package option (#70) --- cobj/cobj.c | 36 +++++++++++-------- cobj/cobj.h | 2 ++ cobj/codegen.c | 8 +++-- tests/Makefile.am | 3 +- tests/Makefile.in | 3 +- tests/command-line-options.at | 1 + .../command-line-options.src/java-package.at | 15 ++++++++ 7 files changed, 50 insertions(+), 18 deletions(-) create mode 100644 tests/command-line-options.src/java-package.at diff --git a/cobj/cobj.c b/cobj/cobj.c index be28febf..437a81b6 100644 --- a/cobj/cobj.c +++ b/cobj/cobj.c @@ -163,6 +163,7 @@ int cb_saveargc; char **cb_saveargv; const char *cob_config_dir; +extern char *cb_java_package_name = NULL; #define PROGRAM_ID_LIST_MAX_LEN 1024 char* program_id_list[PROGRAM_ID_LIST_MAX_LEN]; @@ -296,6 +297,7 @@ static const struct option long_options[] = { {"list-intrinsics", no_argument, NULL, '6'}, {"list-mnemonics", no_argument, NULL, 'q'}, {"save-temps", optional_argument, NULL, '_'}, + {"java-package", optional_argument, NULL, 'P'}, {"std", required_argument, NULL, '$'}, {"conf", required_argument, NULL, '&'}, {"debug", no_argument, NULL, 'd'}, @@ -834,19 +836,20 @@ cobc_print_usage (void) { puts (_("Usage: cobj [options] file...")); puts (_("Options:")); - puts (_(" --help Display this message")); - puts (_(" --version, -V Display compiler version")); - puts (_(" -m Create jar files instead of class files (an experimental feature)")); - puts (_(" -free Use free source format")); - puts (_(" -free_1col_aster Use free(1col_aster) source format")); - puts (_(" -g Enable Java compiler debug")); - puts (_(" -E Preprocess only; do not compile or link")); - puts (_(" -C Translation only; convert COBOL to Java")); - puts (_(" -t Generate and place a program listing into ")); - puts (_(" -I Add to copy files search path")); - puts (_(" -B Add to the Java compiler")); - puts (_(" --list-reserved Display reserved words")); - puts (_(" -assign_external Set the file assign to external")); + puts (_(" --help Display this message")); + puts (_(" --version, -V Display compiler version")); + puts (_(" -m Create jar files instead of class files (an experimental feature)")); + puts (_(" -free Use free source format")); + puts (_(" -free_1col_aster Use free(1col_aster) source format")); + puts (_(" -g Enable Java compiler debug")); + puts (_(" -E Preprocess only; do not compile or link")); + puts (_(" -C Translation only; convert COBOL to Java")); + puts (_(" -t Generate and place a program listing into ")); + puts (_(" -I Add to copy files search path")); + puts (_(" -B Add to the Java compiler")); + puts (_(" --list-reserved Display reserved words")); + puts (_(" -assign_external Set the file assign to external")); + puts (_(" -java-package(=) Specify the package name of the generated source code")); putchar ('\n'); #undef CB_WARNDEF @@ -1036,6 +1039,11 @@ process_command_line (const int argc, char *argv[]) } } break; + case 'P': + /* --java-package : Java package name to be written in the head of generated source code */ + if(optarg) { + cb_java_package_name = optarg; + } case '3': /* --constant */ if (optarg) { @@ -1723,7 +1731,7 @@ process_compile (struct filename *fn) } for(char** program_id = program_id_list; *program_id; ++program_id) { - sprintf(buff, "javac %s -encoding SJIS %s.java", + sprintf(buff, "javac %s -encoding SJIS -d . %s.java", cob_java_flags, *program_id); ret = process (buff); diff --git a/cobj/cobj.h b/cobj/cobj.h index 7fa07933..72338bbd 100644 --- a/cobj/cobj.h +++ b/cobj/cobj.h @@ -138,6 +138,8 @@ extern int cb_source_line; extern const char *cob_config_dir; +extern char *cb_java_package_name; + extern char *source_name; extern char *demangle_name; extern FILE *cb_storage_file; diff --git a/cobj/codegen.c b/cobj/codegen.c index 494c0e83..e5e49c15 100644 --- a/cobj/codegen.c +++ b/cobj/codegen.c @@ -4165,7 +4165,7 @@ joutput_java_entrypoint (struct cb_program *prog, cb_tree parameter_list) char arg_field_name[COB_SMALL_BUFF]; joutput_prefix(); - joutput ("CobolResultSet execute ("); + joutput ("public CobolResultSet execute ("); int k; for (l = parameter_list; l; l = CB_CHAIN (l)) { @@ -4286,7 +4286,7 @@ joutput_internal_function (struct cb_program *prog, cb_tree parameter_list) //output (")\n"); //output_indent ("{"); - joutput_line ("int %s_ (int entry, CobolDataStorage ...argStorages) {", prog->program_id); + joutput_line ("public int %s_ (int entry, CobolDataStorage ...argStorages) {", prog->program_id); joutput_indent_level += 2; joutput_line("this.entry = entry;"); @@ -5923,6 +5923,10 @@ codegen (struct cb_program *prog, const int nested, char** program_id_list) //output ("\n"); } + if(cb_java_package_name) { + joutput_line("package %s;\n", cb_java_package_name); + } + joutput_line("import java.io.UnsupportedEncodingException;"); joutput_line("import jp.osscons.opensourcecobol.libcobj.*;"); joutput_line("import jp.osscons.opensourcecobol.libcobj.common.*;"); diff --git a/tests/Makefile.am b/tests/Makefile.am index 00df3fce..d043afc3 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -151,7 +151,8 @@ command_line_options_DEPENDENCIES = \ command-line-options.src/ftrace-ftraceall.at \ command-line-options.src/fsyntax-only.at \ command-line-options.src/fserial-variable.at \ - command-line-options.src/fshort-variable.at + command-line-options.src/fshort-variable.at \ + command-line-options.src/java-package.at misc_DEPENDENCIES = \ misc.src/signed-comp3.at \ diff --git a/tests/Makefile.in b/tests/Makefile.in index ffd02b1a..0825d99d 100644 --- a/tests/Makefile.in +++ b/tests/Makefile.in @@ -690,7 +690,8 @@ command_line_options_DEPENDENCIES = \ command-line-options.src/ftrace-ftraceall.at \ command-line-options.src/fsyntax-only.at \ command-line-options.src/fserial-variable.at \ - command-line-options.src/fshort-variable.at + command-line-options.src/fshort-variable.at \ + command-line-options.src/java-package.at misc_DEPENDENCIES = \ misc.src/signed-comp3.at \ diff --git a/tests/command-line-options.at b/tests/command-line-options.at index 1197e7eb..bd198127 100644 --- a/tests/command-line-options.at +++ b/tests/command-line-options.at @@ -8,6 +8,7 @@ m4_include([t.at]) m4_include([B.at]) m4_include([list-reserved.at]) m4_include([assign_external.at]) +m4_include([java-package.at]) m4_include([Wunreachable.at]) m4_include([ftrace-ftraceall.at]) m4_include([fsyntax-only.at]) diff --git a/tests/command-line-options.src/java-package.at b/tests/command-line-options.src/java-package.at new file mode 100644 index 00000000..b387c4e9 --- /dev/null +++ b/tests/command-line-options.src/java-package.at @@ -0,0 +1,15 @@ +AT_SETUP([-java-package]) + +AT_DATA([prog.cbl], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + DISPLAY "Hello". +]) + +AT_CHECK([${COBJ} -java-package=libcobj.test prog.cbl]) +AT_CHECK([java libcobj.test.prog], [0], +[Hello +]) + +AT_CLEANUP From a5f1bf20f13da9e4cf62d221e659508514e609af Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Wed, 25 Jan 2023 15:06:56 +0900 Subject: [PATCH 12/17] Fix cmpInt of CobolNumericPackedField and add tests (#71) --- .../libcobj/data/CobolNumericPackedField.java | 6 +- tests/Makefile.am | 3 +- tests/Makefile.in | 3 +- tests/misc.at | 1 + tests/misc.src/comp3-int.at | 70 +++++++++++++++++++ 5 files changed, 79 insertions(+), 4 deletions(-) create mode 100644 tests/misc.src/comp3-int.at diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericPackedField.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericPackedField.java index 54f327d1..7887ded7 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericPackedField.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/data/CobolNumericPackedField.java @@ -911,9 +911,11 @@ private int cmpPacked(int n) { for (size = 0; size < 20; size++) { if (val1[size] != CobolDecimal.packedValue[size]) { if (sign < 0) { - return CobolDecimal.packedValue[size] - val1[size]; + return Byte.toUnsignedInt(CobolDecimal.packedValue[size]) + - Byte.toUnsignedInt(val1[size]); } else { - return val1[size] - CobolDecimal.packedValue[size]; + return Byte.toUnsignedInt(val1[size]) + - Byte.toUnsignedInt(CobolDecimal.packedValue[size]); } } } diff --git a/tests/Makefile.am b/tests/Makefile.am index d043afc3..512c6437 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -162,7 +162,8 @@ misc_DEPENDENCIES = \ misc.src/comp3-is-numeric.at \ misc.src/high-low-value.at \ misc.src/move-sign-leading-separate-to-signed-comp3.at \ - misc.src/java-interface.at + misc.src/java-interface.at \ + misc.src/comp3-int.at EXTRA_DIST = $(srcdir)/package.m4 \ $(TESTS) \ diff --git a/tests/Makefile.in b/tests/Makefile.in index 0825d99d..b8ce468a 100644 --- a/tests/Makefile.in +++ b/tests/Makefile.in @@ -701,7 +701,8 @@ misc_DEPENDENCIES = \ misc.src/comp3-is-numeric.at \ misc.src/high-low-value.at \ misc.src/move-sign-leading-separate-to-signed-comp3.at \ - misc.src/java-interface.at + misc.src/java-interface.at \ + misc.src/comp3-int.at EXTRA_DIST = $(srcdir)/package.m4 \ $(TESTS) \ diff --git a/tests/misc.at b/tests/misc.at index 078c4ccb..b31872a2 100644 --- a/tests/misc.at +++ b/tests/misc.at @@ -24,3 +24,4 @@ m4_include([comp3-is-numeric.at]) m4_include([high-low-value.at]) m4_include([move-sign-leading-separate-to-signed-comp3.at]) m4_include([java-interface.at]) +m4_include([comp3-int.at]) \ No newline at end of file diff --git a/tests/misc.src/comp3-int.at b/tests/misc.src/comp3-int.at new file mode 100644 index 00000000..1d48cfbb --- /dev/null +++ b/tests/misc.src/comp3-int.at @@ -0,0 +1,70 @@ +AT_SETUP([Compare comp3 and int]) + +AT_DATA([a.java],[ +import java.util.stream.Collectors; +import java.util.stream.IntStream; +import jp.osscons.opensourcecobol.libcobj.data.*; + +public class a { + public static void main(String@<:@@:>@ args) { + byte@<:@@:>@ data = new byte@<:@7@:>@; + CobolNumericPackedField packedField = new CobolNumericPackedField( + 7, + new CobolDataStorage(data), + new CobolFieldAttribute( + CobolFieldAttribute.COB_TYPE_NUMERIC_PACKED, + 13, + 0, + CobolFieldAttribute.COB_FLAG_HAVE_SIGN, + null + ) + ); + int@<:@@:>@ positive_data = { + 1, + 2, + 99, + 999, + 9999, + 99999, + 999999, + 9999999, + 99999999, + 999999999, + Integer.MAX_VALUE + }; + int@<:@@:>@ negative_data = { + -1, + -2, + -99, + -999, + -9999, + -99999, + -999999, + -9999999, + -99999999, + -999999999, + Integer.MIN_VALUE+1 + }; + for(int v : positive_data) { + packedField.moveFrom(v); + if(packedField.cmpInt(0) <= 0) { + System.out.println("error: " + v); + } + } + for(int v : negative_data) { + packedField.moveFrom(v); + if(packedField.cmpInt(0) >= 0) { + System.out.println("error: " + v); + } + } + packedField.moveFrom(0); + if(packedField.cmpInt(0) != 0) { + System.out.println("error: " + 0); + } + } +} +]) +AT_CHECK([javac a.java]) +AT_CHECK([java a], [0],[]) + +AT_CLEANUP \ No newline at end of file From f027ab46c2584d467c5791a328c74eb98b0a5ec5 Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Thu, 26 Jan 2023 11:14:05 +0900 Subject: [PATCH 13/17] Implement "SET ENVIRONMENT" statement (#72) --- cobj/typeck.c | 2 +- .../libcobj/call/CobolResolve.java | 9 ++-- .../libcobj/common/CobolUtil.java | 44 ++++++++++++++++--- .../libcobj/file/CobolFile.java | 22 +++++----- .../libcobj/file/CobolFileSort.java | 6 +-- .../libcobj/termio/CobolTerminal.java | 2 +- tests/Makefile.am | 3 +- tests/Makefile.in | 3 +- tests/misc.at | 3 +- tests/misc.src/env.at | 35 +++++++++++++++ 10 files changed, 101 insertions(+), 28 deletions(-) create mode 100644 tests/misc.src/env.at diff --git a/cobj/typeck.c b/cobj/typeck.c index 0d75c0d0..1130c5da 100644 --- a/cobj/typeck.c +++ b/cobj/typeck.c @@ -7623,7 +7623,7 @@ void cb_emit_search_all(cb_tree table, cb_tree at_end, cb_tree when, cb_tree stm void cb_emit_setenv(cb_tree x, cb_tree y) { - cb_emit(cb_build_funcall_2("CobolTerminal.setEnvironment", x, y)); + cb_emit(cb_build_funcall_2("CobolUtil.setEnv", x, y)); } void cb_emit_set_to(cb_tree vars, cb_tree x) diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/call/CobolResolve.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/call/CobolResolve.java index 4bbe80fd..03358f53 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/call/CobolResolve.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/call/CobolResolve.java @@ -29,6 +29,7 @@ import java.util.Map.Entry; import java.util.UUID; import jp.osscons.opensourcecobol.libcobj.common.CobolConstant; +import jp.osscons.opensourcecobol.libcobj.common.CobolUtil; import jp.osscons.opensourcecobol.libcobj.data.AbstractCobolField; import jp.osscons.opensourcecobol.libcobj.data.CobolDataStorage; import jp.osscons.opensourcecobol.libcobj.exceptions.CobolCallException; @@ -72,7 +73,7 @@ public static void CobolInitCall() { // call_entry_buff = cob_malloc (COB_SMALL_BUFF); // call_entry2_buff = cob_malloc (COB_SMALL_BUFF); - s = System.getenv("COB_LOAD_CASE"); + s = CobolUtil.getEnv("COB_LOAD_CASE"); if (s != null) { String sU = s.toUpperCase(); if (sU.equals("LOWER")) { @@ -82,7 +83,7 @@ public static void CobolInitCall() { } } - s = System.getenv("COB_LIBRARY_PATH"); + s = CobolUtil.getEnv("COB_LIBRARY_PATH"); if (s == null || s.equals("")) { buf = "." + System.getProperty("path.separator") + CobolConstant.COB_LIBRARY_PATH; } else { @@ -95,11 +96,11 @@ public static void CobolInitCall() { } setLibraryPath(buf); - s = System.getenv("COB_PACKAGE_PATH"); + s = CobolUtil.getEnv("COB_PACKAGE_PATH"); setPackagePath(s); // TODO プリロードの扱いを検討する - s = System.getenv("COB_PRE_LOAD"); + s = CobolUtil.getEnv("COB_PRE_LOAD"); // 用途不明 // call_buffer = cob_malloc (CALL_BUFF_SIZE); diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/common/CobolUtil.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/common/CobolUtil.java index 2c4d2eaf..244a2e71 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/common/CobolUtil.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/common/CobolUtil.java @@ -21,6 +21,7 @@ import java.time.DateTimeException; import java.time.LocalDateTime; import java.util.Calendar; +import java.util.Properties; import java.util.Scanner; import java.util.regex.Matcher; import java.util.regex.Pattern; @@ -76,6 +77,8 @@ abstract class handlerlist { public static final int FERROR_CHAINING = 2; public static final int FERROR_STACK = 3; + private static Properties envVarTable = new Properties(); + /** * libcob/common.cのcob_check_envの実装 * @@ -88,7 +91,7 @@ public static int checkEnv(String name, String value) { return 0; } - String s = System.getenv(name); + String s = CobolUtil.getEnv(name); if (s != null) { if (s.contentEquals(value)) { return 1; @@ -108,10 +111,11 @@ public static void cob_init(String[] argv, boolean cob_initialized) { CobolInspect.initString(); CobolFile.cob_init_fileio(); CobolIntrinsic.init(); + CobolUtil.envVarTable = new Properties(); for (int i = 0; i < 8; ++i) { String envVariableName = String.format("COB_SWITCH_%d", i + 1); - String envValue = System.getenv(envVariableName); + String envValue = CobolUtil.getEnv(envVariableName); if (envValue == null) { CobolUtil.cobSwitch[i] = false; } else { @@ -121,7 +125,7 @@ public static void cob_init(String[] argv, boolean cob_initialized) { } cal = Calendar.getInstance(); - String s = System.getenv("COB_DATE"); + String s = CobolUtil.getEnv("COB_DATE"); if (s != null) { Scanner scan = new Scanner(s); Pattern p = Pattern.compile("([0-9]{4})/([0-9]{2})/([0-9]{2})"); @@ -150,7 +154,7 @@ public static void cob_init(String[] argv, boolean cob_initialized) { } } - s = System.getenv("COB_VERBOSE"); + s = CobolUtil.getEnv("COB_VERBOSE"); if (s != null && s.length() > 0 && (s.charAt(0) == 'y' || s.charAt(0) == 'Y')) { CobolUtil.cob_verbose = true; } @@ -226,7 +230,7 @@ public static void runtimeError(String s) { * @param envval */ public static void getEnvironment(AbstractCobolField envname, AbstractCobolField envval) { - String p = System.getenv(envname.fieldToString()); + String p = CobolUtil.getEnv(envname.fieldToString()); if (p == null) { CobolException.setException(CobolExceptionId.COB_EC_IMP_ACCEPT); p = " "; @@ -668,4 +672,34 @@ public static void setLocation( System.err.flush(); } } + + public static String getEnv(String envVarName) { + String envVarInTable = CobolUtil.envVarTable.getProperty(envVarName); + if (envVarInTable != null) { + return envVarInTable; + } else { + return System.getenv(envVarName); + } + } + + /** + * get environemnt variable + * + * @param envVarName the name of an environment variable. + * @return the value of envVarName, or null if the envVarName is not defined. + */ + public static void setEnv(String envVarName, String envVarValue) { + CobolUtil.envVarTable.setProperty(envVarName, envVarValue); + } + + /** + * Set environemnt variable + * + * @param envVarName the name of an environment variable. The leading and trailing spaces are + * ignored. + * @param envVarValue the value of an environment variable to be set. + */ + public static void setEnv(AbstractCobolField envVarName, AbstractCobolField envVarValue) { + CobolUtil.envVarTable.setProperty(envVarName.getString().trim(), envVarValue.getString()); + } } diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java index f154d2e1..6cef8532 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFile.java @@ -333,7 +333,7 @@ public static int invokeFun( byte[] tmpfnstatus = String.format("%02d", 0).getBytes(); byte[] pTmpfnstatus = tmpfnstatus; String p_excpcode = ""; - String s = System.getenv(TIS_DEFINE_USERFH); + String s = CobolUtil.getEnv(TIS_DEFINE_USERFH); int iRet = 0; char ret = '0'; int status1 = 0; @@ -645,7 +645,7 @@ public void open(int mode, int sharing, AbstractCobolField fnstatus) { file_open_env[j] = src[src_i + 1 + j]; } file_open_env[i - 1] = 0; - String p = System.getenv(new String(Arrays.copyOfRange(file_open_env, 0, i - 1))); + String p = CobolUtil.getEnv(new String(Arrays.copyOfRange(file_open_env, 0, i - 1))); if (p != null) { byte[] pbytes = p.getBytes(); for (int j = 0; j < pbytes.length; ++j) { @@ -669,7 +669,7 @@ public void open(int mode, int sharing, AbstractCobolField fnstatus) { for (i = 0; i < NUM_PREFIX; i++) { byte[] file_open_buff = String.format("%s%s", prefix[i], file_open_name).getBytes(); String p; - if ((p = System.getenv(new String(file_open_buff))) != null) { + if ((p = CobolUtil.getEnv(new String(file_open_buff))) != null) { file_open_name_bytes = p.getBytes(); break; } @@ -690,8 +690,8 @@ public void open(int mode, int sharing, AbstractCobolField fnstatus) { was_not_exist = true; if (mode != COB_OPEN_OUTPUT && !this.flag_optional - && (mode != COB_OPEN_I_O || !System.getenv(COB_IO_CREATES).equals("yes")) - && (mode != COB_OPEN_EXTEND || !System.getenv(COB_EXTEND_CREATES).equals("yes"))) { + && (mode != COB_OPEN_I_O || !CobolUtil.getEnv(COB_IO_CREATES).equals("yes")) + && (mode != COB_OPEN_EXTEND || !CobolUtil.getEnv(COB_EXTEND_CREATES).equals("yes"))) { saveStatus(COB_STATUS_35_NOT_EXISTS, fnstatus); return; } @@ -1319,7 +1319,7 @@ protected void cob_sync(CobolFile f, int mode) { /** libcob/fileio.cのcob_init_fileioの実装 */ public static void cob_init_fileio() { - String s = System.getenv("COB_SYNC"); + String s = CobolUtil.getEnv("COB_SYNC"); if (s != null) { if (s.charAt(0) == 'Y' || s.charAt(0) == 'y') { cob_do_sync = 1; @@ -1329,15 +1329,15 @@ public static void cob_init_fileio() { } } - cob_file_path = System.getenv("COB_FILE_PATH"); + cob_file_path = CobolUtil.getEnv("COB_FILE_PATH"); if (cob_file_path != null) { if (cob_file_path.charAt(0) == '\0' || cob_file_path.charAt(0) == ' ') { cob_file_path = null; } } - cob_ls_nulls = System.getenv("COB_LS_NULLS"); - cob_ls_fixed = System.getenv("COB_LS_FIXED"); + cob_ls_nulls = CobolUtil.getEnv("COB_LS_NULLS"); + cob_ls_fixed = CobolUtil.getEnv("COB_LS_FIXED"); file_open_env = new byte[COB_SMALL_BUFF]; // file_open_name = new byte[COB_SMALL_BUFF]; @@ -1474,7 +1474,7 @@ public void cob_delete_file(AbstractCobolField fnstatus) { file_open_env[j] = src[src_i + 1 + j]; } file_open_env[i - 1] = 0; - String p = System.getenv(new String(Arrays.copyOfRange(file_open_env, 0, i - 1))); + String p = CobolUtil.getEnv(new String(Arrays.copyOfRange(file_open_env, 0, i - 1))); if (p != null) { byte[] pbytes = p.getBytes(); for (int j = 0; j < pbytes.length; ++j) { @@ -1498,7 +1498,7 @@ public void cob_delete_file(AbstractCobolField fnstatus) { for (i = 0; i < NUM_PREFIX; i++) { byte[] file_open_buff = String.format("%s%s", prefix[i], file_open_name).getBytes(); String p; - if ((p = System.getenv(new String(file_open_buff))) != null) { + if ((p = CobolUtil.getEnv(new String(file_open_buff))) != null) { file_open_name_bytes = p.getBytes(); break; } diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFileSort.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFileSort.java index 13d6578f..4bbee6cd 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFileSort.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/file/CobolFileSort.java @@ -167,9 +167,9 @@ private static CobolItem newItem(CobolSort hp) { private static FileIO tmpfile() { String s; FileIO fp = new FileIO(); - if ((s = System.getenv("TMPDIR")) == null - && (s = System.getenv("TMP")) == null - && (s = System.getenv("TEMP")) == null) { + if ((s = CobolUtil.getEnv("TMPDIR")) == null + && (s = CobolUtil.getEnv("TMP")) == null + && (s = CobolUtil.getEnv("TEMP")) == null) { s = "/tmp"; } if (cob_process_id.equals("")) { diff --git a/libcobj/src/jp/osscons/opensourcecobol/libcobj/termio/CobolTerminal.java b/libcobj/src/jp/osscons/opensourcecobol/libcobj/termio/CobolTerminal.java index 4e7049cf..e7da4e81 100644 --- a/libcobj/src/jp/osscons/opensourcecobol/libcobj/termio/CobolTerminal.java +++ b/libcobj/src/jp/osscons/opensourcecobol/libcobj/termio/CobolTerminal.java @@ -229,7 +229,7 @@ public static void displayEnvValue(AbstractCobolField f) { public static void acceptEnvironment(AbstractCobolField f) { String p = null; if (CobolUtil.cobLocalEnv != null) { - p = System.getenv(CobolUtil.cobLocalEnv); + p = CobolUtil.getEnv(CobolUtil.cobLocalEnv); } if (p == null) { diff --git a/tests/Makefile.am b/tests/Makefile.am index 512c6437..1a71b87a 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -163,7 +163,8 @@ misc_DEPENDENCIES = \ misc.src/high-low-value.at \ misc.src/move-sign-leading-separate-to-signed-comp3.at \ misc.src/java-interface.at \ - misc.src/comp3-int.at + misc.src/comp3-int.at \ + misc.src/env.at EXTRA_DIST = $(srcdir)/package.m4 \ $(TESTS) \ diff --git a/tests/Makefile.in b/tests/Makefile.in index b8ce468a..7dc9475b 100644 --- a/tests/Makefile.in +++ b/tests/Makefile.in @@ -702,7 +702,8 @@ misc_DEPENDENCIES = \ misc.src/high-low-value.at \ misc.src/move-sign-leading-separate-to-signed-comp3.at \ misc.src/java-interface.at \ - misc.src/comp3-int.at + misc.src/comp3-int.at \ + misc.src/env.at EXTRA_DIST = $(srcdir)/package.m4 \ $(TESTS) \ diff --git a/tests/misc.at b/tests/misc.at index b31872a2..f42529d3 100644 --- a/tests/misc.at +++ b/tests/misc.at @@ -24,4 +24,5 @@ m4_include([comp3-is-numeric.at]) m4_include([high-low-value.at]) m4_include([move-sign-leading-separate-to-signed-comp3.at]) m4_include([java-interface.at]) -m4_include([comp3-int.at]) \ No newline at end of file +m4_include([comp3-int.at]) +m4_include([env.at]) diff --git a/tests/misc.src/env.at b/tests/misc.src/env.at new file mode 100644 index 00000000..f5768bdb --- /dev/null +++ b/tests/misc.src/env.at @@ -0,0 +1,35 @@ +AT_SETUP([Environment variable]) + +AT_DATA([prog.cbl],[ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 env-var-name PIC X(14) value "COB_ENV_TEST". + 01 env-var-name1 PIC X(12) value "COB_ENV_TEST". + 01 env-var-value PIC X(10). + PROCEDURE DIVISION. + accept env-var-value from environment env-var-name + end-accept. + display env-var-value. + + set environment env-var-name to "world". + accept env-var-value from environment env-var-name + end-accept. + display env-var-value. + + initialize env-var-value. + set environment env-var-name1 to "world". + accept env-var-value from environment env-var-name1 + end-accept. + display env-var-value. +]) + +AT_CHECK([${COBJ} prog.cbl]) +AT_CHECK([COB_ENV_TEST=hello java prog], [0], +[hello @&t@ +world @&t@ +world @&t@ +]) + +AT_CLEANUP From b2ff21ecab2d9bf3f62e940dbd1f9623d86b80ec Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Tue, 31 Jan 2023 09:15:20 +0900 Subject: [PATCH 14/17] Add a test for exchanging Japanese data between COBOL and Java (#73) --- tests/misc.src/java-interface.at | 44 ++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/tests/misc.src/java-interface.at b/tests/misc.src/java-interface.at index 904a07a9..3f57ce38 100644 --- a/tests/misc.src/java-interface.at +++ b/tests/misc.src/java-interface.at @@ -472,4 +472,48 @@ jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type i jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type is not 'int' jp.osscons.opensourcecobol.libcobj.ui.CobolResultSetException: The result type is not 'double' ]) +AT_CLEANUP + +AT_SETUP([Japanese]) + +AT_DATA([b.cbl], [ + identification division. + program-id. b. + data division. + linkage section. + 01 arg-1 pic 9(3). + 01 arg-2 pic N(5). + procedure division using arg-1 arg-2. + display arg-1. + display arg-2. + add 1 to arg-1. + move N"" to arg-2. +]) + +AT_DATA([a.java], [ +import jp.osscons.opensourcecobol.libcobj.ui.*; +public class a { + public static void main(String@<:@@:>@ args) { + b prog = new b(); + CobolResultSet rs = prog.execute(100, ""); + try{ + int ret1 = rs.getInt(1); + String ret2 = rs.getString(2); + System.out.println("ret1: " + ret1); + System.out.println("ret2: " + ret2); + } catch(CobolResultSetException e){ + e.printStackTrace(); + } + } +} +]) + +AT_CHECK([cobj b.cbl]) +AT_CHECK([javac -encoding SJIS a.java]) +AT_CHECK([java -Dfile.encoding=SJIS a], [0], +[100 + +ret1: 101 +ret2: +]) AT_CLEANUP \ No newline at end of file From 5375a14ba67939f748a8a6729a183e9d0e2ec8cf Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Tue, 31 Jan 2023 10:36:10 +0900 Subject: [PATCH 15/17] Prepare to release v1.0.7 (#74) --- ChangeLog | 8 ++++++++ NEWS | 46 +++++++++++++++++++++++++++++++++++++++------- README.md | 2 +- README_JP.md | 2 +- configure | 28 ++++++++++++++-------------- configure.ac | 2 +- tests/package.m4 | 8 ++++---- 7 files changed, 68 insertions(+), 28 deletions(-) diff --git a/ChangeLog b/ChangeLog index 93ddc490..8bbbb243 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2023-01-31 OSS Consortium + + * opensource COBOL 4J v1.0.7 released. + +2022-12-29 OSS Consortium + + * opensource COBOL 4J v1.0.6 released. + 2022-11-22 OSS Consortium * opensource COBOL 4J v1.0.5 released. diff --git a/NEWS b/NEWS index e8ede7bb..3bb819eb 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,38 @@ NEWS - user visible changes -*- outline -*- -* opensource cobol 4j 1.0.5 +* opensource cobol 4J 1.0.7 + +** New Features + (1) Implement DELETE statement of SEQUENTIAL files. + (2) Improve Java interface. + (3) Add -java-package option + (4) Implement SET ENVIRONMENT statement + +** Bug fixes + (1) Fix a bug concerning the environment variables COB_OPEN_I_O and COB_OPEN_EXTEND. + (2) Fix the comparsion process of COMP-3 + (3) Fix EXIT PERFORM and EXIT PERFORM CYCLE + +** Miscellaneous + (1) Format all Java source code using Google Java Format + +----------------------------------------------------------------------- + +* opensource cobol 4J 1.0.6 + +** New Features + (1) Add -fshort-variable option + (2) make install command installs libcobj.jar in ${prefix}/lib/opensourcecobol4j + +** Bug fixes + (1) Fix FUNCTION CURRENT-DATE + +** Miscellaneous + (1) Build and run tests on AlmaLinux 9 + +----------------------------------------------------------------------- + +* opensource cobol 4J 1.0.5 ** New Features (1) -m option and cobjrun command (an experimental feature) @@ -30,7 +62,7 @@ NEWS - user visible changes -*- outline -*- ----------------------------------------------------------------------- -* opensource cobol 4j 1.0.4 +* opensource cobol 4J 1.0.4 ** New Features (1) Rename cobc, the compile command, to cobj. @@ -59,14 +91,14 @@ NEWS - user visible changes -*- outline -*- ----------------------------------------------------------------------- -* opensource cobol 4j 1.0.3 +* opensource cobol 4J 1.0.3 ** New features (1) Change the storage library for indexed file to SQLite. ----------------------------------------------------------------------- -* opensource cobol 4j 1.0.2 +* opensource cobol 4J 1.0.2 ** New features (1) Upgrade the license to GPL3. @@ -76,14 +108,14 @@ NEWS - user visible changes -*- outline -*- ----------------------------------------------------------------------- -* opensource cobol 4j 1.0.1 +* opensource cobol 4J 1.0.1 ** Bug fixes (1) Fix the transformation of call arguments ----------------------------------------------------------------------- -* opensource cobol 4j 1.0.0 +* opensource cobol 4J 1.0.0 ** Bug fixes (1) Fix the status code after opening indexed files. @@ -91,6 +123,6 @@ NEWS - user visible changes -*- outline -*- ----------------------------------------------------------------------- -* release opensource COBOL4J developers edition. +* release opensource COBOL 4J developers edition. ----------------------------------------------------------------------- diff --git a/README.md b/README.md index 4ba5a204..5b40740e 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # opensource COBOL 4J -[日本語版README](https://github.com/opensourcecobol/opensourcecobol4j/blob/main/README_JP.md) +[日本語版README](./README_JP.md) "opensource COBOL 4J" is a COBOL compiler that translates COBOL parograms to Java programs. This compiler is deeply inspired by ["opensource COBOL"](https://github.com/opensourcecobol/opensource-cobol) which translates COBOL programs to C programs. diff --git a/README_JP.md b/README_JP.md index fc1542b9..8ce345fb 100644 --- a/README_JP.md +++ b/README_JP.md @@ -1,6 +1,6 @@ # opensource COBOL 4J -[English version README](https://github.com/opensourcecobol/opensourcecobol4j/blob/main/README.md) +[English version README](./README.md) opensource COBOL 4JはCOBOLソースコードをJavaソースコードに変換するCOBOLコンパイラです. opensource COBOL 4JはCOBOLからCに変換するCOBOLコンパイラ["opensource COBOL"](https://github.com/opensourcecobol/opensource-cobol)をもとに開発されています. diff --git a/configure b/configure index 000c5cc3..2396da5e 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for opensource COBOL 4j 1.0.5. +# Generated by GNU Autoconf 2.69 for opensource COBOL 4J 1.0.7. # # Report bugs to . # @@ -588,10 +588,10 @@ MFLAGS= MAKEFLAGS= # Identity of this package. -PACKAGE_NAME='opensource COBOL 4j' -PACKAGE_TARNAME='opensource-cobol-4j-1.0.5' -PACKAGE_VERSION='1.0.5' -PACKAGE_STRING='opensource COBOL 4j 1.0.5' +PACKAGE_NAME='opensource COBOL 4J' +PACKAGE_TARNAME='opensource-cobol-4j-1.0.7' +PACKAGE_VERSION='1.0.7' +PACKAGE_STRING='opensource COBOL 4J 1.0.7' PACKAGE_BUGREPORT='ws-opensource-cobol-contact@osscons.jp' PACKAGE_URL='' @@ -1379,7 +1379,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures opensource COBOL 4j 1.0.5 to adapt to many kinds of systems. +\`configure' configures opensource COBOL 4J 1.0.7 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1429,7 +1429,7 @@ Fine tuning of the installation directories: --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root - [DATAROOTDIR/doc/opensource-cobol-4j-1.0.5] + [DATAROOTDIR/doc/opensource-cobol-4j-1.0.7] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] @@ -1451,7 +1451,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of opensource COBOL 4j 1.0.5:";; + short | recursive ) echo "Configuration of opensource COBOL 4J 1.0.7:";; esac cat <<\_ACEOF @@ -1581,7 +1581,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -opensource COBOL 4j configure 1.0.5 +opensource COBOL 4J configure 1.0.7 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -2133,7 +2133,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by opensource COBOL 4j $as_me 1.0.5, which was +It was created by opensource COBOL 4J $as_me 1.0.7, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -3023,8 +3023,8 @@ fi # Define the identity of the package. - PACKAGE='opensource-cobol-4j-1.0.5' - VERSION='1.0.5' + PACKAGE='opensource-cobol-4j-1.0.7' + VERSION='1.0.7' cat >>confdefs.h <<_ACEOF @@ -23482,7 +23482,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by opensource COBOL 4j $as_me 1.0.5, which was +This file was extended by opensource COBOL 4J $as_me 1.0.7, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -23548,7 +23548,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -opensource COBOL 4j config.status 1.0.5 +opensource COBOL 4J config.status 1.0.7 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/configure.ac b/configure.ac index a29ccb27..ad30082e 100644 --- a/configure.ac +++ b/configure.ac @@ -19,7 +19,7 @@ AC_PREREQ(2.59) -AC_INIT([opensource COBOL 4j],[1.0.5],[ws-opensource-cobol-contact@osscons.jp],[opensource-cobol-4j-1.0.5]) +AC_INIT([opensource COBOL 4J],[1.0.7],[ws-opensource-cobol-contact@osscons.jp],[opensource-cobol-4j-1.0.7]) AC_CONFIG_SRCDIR([libcob.h]) AC_CONFIG_HEADERS([config.h]) AC_CONFIG_TESTDIR([tests]) diff --git a/tests/package.m4 b/tests/package.m4 index a7246a52..e7ed9281 100644 --- a/tests/package.m4 +++ b/tests/package.m4 @@ -1,6 +1,6 @@ # Signature of the current package. -m4_define([AT_PACKAGE_NAME], [opensource COBOL 4j]) -m4_define([AT_PACKAGE_TARNAME], [opensource-cobol-4j-1.0.5]) -m4_define([AT_PACKAGE_VERSION], [1.0.5]) -m4_define([AT_PACKAGE_STRING], [opensource COBOL 4j 1.0.5]) +m4_define([AT_PACKAGE_NAME], [opensource COBOL 4J]) +m4_define([AT_PACKAGE_TARNAME], [opensource-cobol-4j-1.0.7]) +m4_define([AT_PACKAGE_VERSION], [1.0.7]) +m4_define([AT_PACKAGE_STRING], [opensource COBOL 4J 1.0.7]) m4_define([AT_PACKAGE_BUGREPORT], [ws-opensource-cobol-contact@osscons.jp]) From 64916515f46f50700b7797791d9013d781189e5e Mon Sep 17 00:00:00 2001 From: yutaro-sakamoto <80912876+yutaro-sakamoto@users.noreply.github.com> Date: Tue, 31 Jan 2023 14:47:40 +0900 Subject: [PATCH 16/17] Fix EXIT PERFORM and EXIT PERFORM CYCLE (#75) --- cobj/parser.c | 2054 ++++++++++++++++---------------- cobj/parser.y | 12 - tests/Makefile.am | 3 +- tests/misc.at | 1 + tests/misc.src/exit-perform.at | 72 ++ 5 files changed, 1096 insertions(+), 1046 deletions(-) create mode 100644 tests/misc.src/exit-perform.at diff --git a/cobj/parser.c b/cobj/parser.c index a4e65318..864685a5 100644 --- a/cobj/parser.c +++ b/cobj/parser.c @@ -1360,74 +1360,74 @@ static const yytype_int16 yyrline[] = 4763, 4782, 4783, 4794, 4803, 4808, 4816, 4845, 4846, 4852, 4851, 4867, 4871, 4870, 4885, 4886, 4891, 4892, 4903, 4932, 4933, 4934, 4937, 4938, 4942, 4943, 4952, 4952, 4957, 4958, - 4966, 4983, 5000, 5018, 5043, 5043, 5056, 5056, 5069, 5069, - 5078, 5082, 5095, 5095, 5108, 5110, 5108, 5121, 5126, 5130, - 5129, 5143, 5144, 5153, 5153, 5161, 5162, 5166, 5167, 5168, - 5172, 5173, 5178, 5179, 5184, 5188, 5189, 5190, 5191, 5192, - 5193, 5194, 5198, 5199, 5208, 5208, 5221, 5220, 5230, 5231, - 5232, 5236, 5237, 5241, 5242, 5243, 5249, 5249, 5254, 5255, - 5259, 5260, 5261, 5262, 5263, 5264, 5270, 5274, 5275, 5279, - 5284, 5288, 5289, 5290, 5291, 5292, 5296, 5322, 5335, 5336, - 5340, 5340, 5348, 5348, 5358, 5358, 5363, 5367, 5379, 5379, - 5385, 5389, 5396, 5397, 5406, 5406, 5410, 5411, 5425, 5426, - 5427, 5428, 5432, 5433, 5437, 5438, 5439, 5451, 5451, 5456, - 5461, 5460, 5470, 5477, 5478, 5482, 5487, 5496, 5499, 5503, - 5508, 5515, 5522, 5523, 5527, 5528, 5533, 5545, 5545, 5574, - 5575, 5579, 5580, 5584, 5588, 5592, 5596, 5603, 5604, 5618, - 5619, 5620, 5624, 5625, 5634, 5634, 5649, 5649, 5660, 5661, - 5670, 5670, 5687, 5688, 5692, 5699, 5700, 5709, 5722, 5722, - 5728, 5733, 5732, 5743, 5744, 5748, 5750, 5749, 5760, 5761, - 5766, 5765, 5776, 5777, 5786, 5786, 5791, 5792, 5793, 5794, - 5795, 5801, 5810, 5814, 5823, 5830, 5831, 5837, 5838, 5842, - 5851, 5852, 5856, 5860, 5872, 5872, 5878, 5877, 5894, 5897, - 5918, 5919, 5922, 5923, 5927, 5928, 5933, 5938, 5946, 5958, - 5963, 5971, 5987, 5988, 5987, 6008, 6009, 6025, 6026, 6027, - 6028, 6029, 6033, 6034, 6043, 6043, 6048, 6048, 6055, 6056, - 6057, 6066, 6066, 6075, 6076, 6080, 6081, 6082, 6086, 6087, - 6091, 6092, 6101, 6101, 6107, 6111, 6115, 6122, 6123, 6132, - 6139, 6140, 6148, 6148, 6161, 6161, 6177, 6177, 6186, 6188, - 6189, 6198, 6198, 6208, 6209, 6214, 6215, 6220, 6227, 6228, - 6233, 6240, 6241, 6245, 6246, 6250, 6251, 6255, 6256, 6265, - 6266, 6267, 6271, 6295, 6298, 6306, 6316, 6321, 6326, 6331, - 6338, 6339, 6342, 6343, 6347, 6347, 6351, 6351, 6355, 6355, - 6358, 6359, 6363, 6370, 6371, 6375, 6387, 6387, 6404, 6405, - 6410, 6413, 6417, 6421, 6428, 6429, 6432, 6433, 6434, 6438, - 6439, 6452, 6460, 6467, 6469, 6468, 6478, 6480, 6479, 6494, - 6498, 6500, 6499, 6510, 6512, 6511, 6528, 6534, 6536, 6535, - 6545, 6547, 6546, 6562, 6567, 6572, 6582, 6581, 6593, 6592, - 6608, 6613, 6618, 6628, 6627, 6639, 6638, 6653, 6654, 6658, - 6663, 6668, 6678, 6677, 6689, 6688, 6705, 6708, 6720, 6727, - 6734, 6734, 6744, 6745, 6747, 6748, 6749, 6750, 6751, 6752, - 6754, 6755, 6756, 6757, 6758, 6759, 6761, 6762, 6764, 6765, - 6766, 6769, 6771, 6772, 6773, 6775, 6776, 6777, 6779, 6780, - 6782, 6783, 6784, 6785, 6786, 6788, 6789, 6790, 6791, 6792, - 6793, 6795, 6796, 6797, 6798, 6799, 6800, 6802, 6803, 6806, - 6806, 6806, 6807, 6807, 6808, 6808, 6809, 6809, 6809, 6810, - 6810, 6810, 6815, 6816, 6819, 6820, 6821, 6825, 6826, 6827, - 6828, 6829, 6830, 6831, 6832, 6833, 6844, 6856, 6871, 6872, - 6877, 6883, 6905, 6925, 6929, 6945, 6959, 6960, 6965, 6971, - 6972, 6977, 6986, 6987, 6988, 6992, 7003, 7004, 7008, 7018, - 7019, 7023, 7024, 7028, 7029, 7035, 7055, 7056, 7060, 7061, - 7065, 7066, 7070, 7071, 7072, 7073, 7074, 7075, 7076, 7077, - 7078, 7082, 7083, 7084, 7085, 7086, 7087, 7088, 7092, 7093, - 7097, 7098, 7102, 7103, 7107, 7108, 7119, 7120, 7124, 7125, - 7126, 7130, 7131, 7132, 7140, 7144, 7145, 7146, 7147, 7151, - 7152, 7156, 7166, 7184, 7211, 7223, 7224, 7234, 7235, 7239, - 7240, 7241, 7242, 7243, 7244, 7245, 7253, 7257, 7261, 7265, - 7269, 7273, 7277, 7281, 7285, 7289, 7293, 7297, 7304, 7305, - 7306, 7310, 7311, 7315, 7316, 7321, 7328, 7335, 7345, 7352, - 7362, 7369, 7383, 7393, 7394, 7398, 7399, 7403, 7404, 7408, - 7409, 7410, 7414, 7415, 7419, 7420, 7424, 7425, 7429, 7430, - 7437, 7437, 7438, 7438, 7439, 7439, 7440, 7440, 7442, 7442, - 7443, 7443, 7444, 7444, 7445, 7445, 7446, 7446, 7447, 7447, - 7448, 7448, 7449, 7449, 7450, 7450, 7451, 7451, 7452, 7452, - 7453, 7453, 7454, 7454, 7455, 7455, 7456, 7456, 7457, 7457, - 7458, 7458, 7459, 7459, 7459, 7460, 7460, 7461, 7461, 7461, - 7462, 7462, 7463, 7463, 7464, 7464, 7465, 7465, 7466, 7466, - 7467, 7467, 7468, 7468, 7468, 7469, 7469, 7470, 7470, 7471, - 7471, 7472, 7472, 7473, 7473, 7474, 7474, 7475, 7475, 7475, - 7476, 7476, 7477, 7477, 7478, 7478, 7479, 7479, 7480, 7480, - 7481, 7481, 7482, 7482, 7484, 7484, 7485, 7485 + 4966, 4977, 4988, 5006, 5031, 5031, 5044, 5044, 5057, 5057, + 5066, 5070, 5083, 5083, 5096, 5098, 5096, 5109, 5114, 5118, + 5117, 5131, 5132, 5141, 5141, 5149, 5150, 5154, 5155, 5156, + 5160, 5161, 5166, 5167, 5172, 5176, 5177, 5178, 5179, 5180, + 5181, 5182, 5186, 5187, 5196, 5196, 5209, 5208, 5218, 5219, + 5220, 5224, 5225, 5229, 5230, 5231, 5237, 5237, 5242, 5243, + 5247, 5248, 5249, 5250, 5251, 5252, 5258, 5262, 5263, 5267, + 5272, 5276, 5277, 5278, 5279, 5280, 5284, 5310, 5323, 5324, + 5328, 5328, 5336, 5336, 5346, 5346, 5351, 5355, 5367, 5367, + 5373, 5377, 5384, 5385, 5394, 5394, 5398, 5399, 5413, 5414, + 5415, 5416, 5420, 5421, 5425, 5426, 5427, 5439, 5439, 5444, + 5449, 5448, 5458, 5465, 5466, 5470, 5475, 5484, 5487, 5491, + 5496, 5503, 5510, 5511, 5515, 5516, 5521, 5533, 5533, 5562, + 5563, 5567, 5568, 5572, 5576, 5580, 5584, 5591, 5592, 5606, + 5607, 5608, 5612, 5613, 5622, 5622, 5637, 5637, 5648, 5649, + 5658, 5658, 5675, 5676, 5680, 5687, 5688, 5697, 5710, 5710, + 5716, 5721, 5720, 5731, 5732, 5736, 5738, 5737, 5748, 5749, + 5754, 5753, 5764, 5765, 5774, 5774, 5779, 5780, 5781, 5782, + 5783, 5789, 5798, 5802, 5811, 5818, 5819, 5825, 5826, 5830, + 5839, 5840, 5844, 5848, 5860, 5860, 5866, 5865, 5882, 5885, + 5906, 5907, 5910, 5911, 5915, 5916, 5921, 5926, 5934, 5946, + 5951, 5959, 5975, 5976, 5975, 5996, 5997, 6013, 6014, 6015, + 6016, 6017, 6021, 6022, 6031, 6031, 6036, 6036, 6043, 6044, + 6045, 6054, 6054, 6063, 6064, 6068, 6069, 6070, 6074, 6075, + 6079, 6080, 6089, 6089, 6095, 6099, 6103, 6110, 6111, 6120, + 6127, 6128, 6136, 6136, 6149, 6149, 6165, 6165, 6174, 6176, + 6177, 6186, 6186, 6196, 6197, 6202, 6203, 6208, 6215, 6216, + 6221, 6228, 6229, 6233, 6234, 6238, 6239, 6243, 6244, 6253, + 6254, 6255, 6259, 6283, 6286, 6294, 6304, 6309, 6314, 6319, + 6326, 6327, 6330, 6331, 6335, 6335, 6339, 6339, 6343, 6343, + 6346, 6347, 6351, 6358, 6359, 6363, 6375, 6375, 6392, 6393, + 6398, 6401, 6405, 6409, 6416, 6417, 6420, 6421, 6422, 6426, + 6427, 6440, 6448, 6455, 6457, 6456, 6466, 6468, 6467, 6482, + 6486, 6488, 6487, 6498, 6500, 6499, 6516, 6522, 6524, 6523, + 6533, 6535, 6534, 6550, 6555, 6560, 6570, 6569, 6581, 6580, + 6596, 6601, 6606, 6616, 6615, 6627, 6626, 6641, 6642, 6646, + 6651, 6656, 6666, 6665, 6677, 6676, 6693, 6696, 6708, 6715, + 6722, 6722, 6732, 6733, 6735, 6736, 6737, 6738, 6739, 6740, + 6742, 6743, 6744, 6745, 6746, 6747, 6749, 6750, 6752, 6753, + 6754, 6757, 6759, 6760, 6761, 6763, 6764, 6765, 6767, 6768, + 6770, 6771, 6772, 6773, 6774, 6776, 6777, 6778, 6779, 6780, + 6781, 6783, 6784, 6785, 6786, 6787, 6788, 6790, 6791, 6794, + 6794, 6794, 6795, 6795, 6796, 6796, 6797, 6797, 6797, 6798, + 6798, 6798, 6803, 6804, 6807, 6808, 6809, 6813, 6814, 6815, + 6816, 6817, 6818, 6819, 6820, 6821, 6832, 6844, 6859, 6860, + 6865, 6871, 6893, 6913, 6917, 6933, 6947, 6948, 6953, 6959, + 6960, 6965, 6974, 6975, 6976, 6980, 6991, 6992, 6996, 7006, + 7007, 7011, 7012, 7016, 7017, 7023, 7043, 7044, 7048, 7049, + 7053, 7054, 7058, 7059, 7060, 7061, 7062, 7063, 7064, 7065, + 7066, 7070, 7071, 7072, 7073, 7074, 7075, 7076, 7080, 7081, + 7085, 7086, 7090, 7091, 7095, 7096, 7107, 7108, 7112, 7113, + 7114, 7118, 7119, 7120, 7128, 7132, 7133, 7134, 7135, 7139, + 7140, 7144, 7154, 7172, 7199, 7211, 7212, 7222, 7223, 7227, + 7228, 7229, 7230, 7231, 7232, 7233, 7241, 7245, 7249, 7253, + 7257, 7261, 7265, 7269, 7273, 7277, 7281, 7285, 7292, 7293, + 7294, 7298, 7299, 7303, 7304, 7309, 7316, 7323, 7333, 7340, + 7350, 7357, 7371, 7381, 7382, 7386, 7387, 7391, 7392, 7396, + 7397, 7398, 7402, 7403, 7407, 7408, 7412, 7413, 7417, 7418, + 7425, 7425, 7426, 7426, 7427, 7427, 7428, 7428, 7430, 7430, + 7431, 7431, 7432, 7432, 7433, 7433, 7434, 7434, 7435, 7435, + 7436, 7436, 7437, 7437, 7438, 7438, 7439, 7439, 7440, 7440, + 7441, 7441, 7442, 7442, 7443, 7443, 7444, 7444, 7445, 7445, + 7446, 7446, 7447, 7447, 7447, 7448, 7448, 7449, 7449, 7449, + 7450, 7450, 7451, 7451, 7452, 7452, 7453, 7453, 7454, 7454, + 7455, 7455, 7456, 7456, 7456, 7457, 7457, 7458, 7458, 7459, + 7459, 7460, 7460, 7461, 7461, 7462, 7462, 7463, 7463, 7463, + 7464, 7464, 7465, 7465, 7466, 7466, 7467, 7467, 7468, 7468, + 7469, 7469, 7470, 7470, 7472, 7472, 7473, 7473 }; #endif @@ -9687,20 +9687,14 @@ yyparse (void) if (!perform_stack) { cb_error (_("EXIT PERFORM is only valid with inline PERFORM")); } else { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (!p->exit_label) { - sprintf (name, "EXIT PERFORM %d", cb_id); - p->exit_label = cb_build_reference (name); - CB_LABEL (cb_build_label (p->exit_label, current_section))->need_begin = 1; - } cb_emit_java_break (); } } -#line 9700 "parser.c" +#line 9694 "parser.c" break; case 921: -#line 4984 "parser.y" +#line 4978 "parser.y" { struct cb_perform *p; char name[64]; @@ -9708,20 +9702,14 @@ yyparse (void) if (!perform_stack) { cb_error (_("EXIT PERFORM is only valid with inline PERFORM")); } else { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (!p->cycle_label) { - sprintf (name, "EXIT PERFORM CYCLE %d", cb_id); - p->cycle_label = cb_build_reference (name); - CB_LABEL (cb_build_label (p->cycle_label, current_section))->need_begin = 1; - } cb_emit_java_continue (); } } -#line 9721 "parser.c" +#line 9709 "parser.c" break; case 922: -#line 5001 "parser.y" +#line 4989 "parser.y" { cb_tree plabel; char name[64]; @@ -9739,11 +9727,11 @@ yyparse (void) cb_emit_goto (cb_list_init (current_section->exit_label_ref), NULL); } } -#line 9743 "parser.c" +#line 9731 "parser.c" break; case 923: -#line 5019 "parser.y" +#line 5007 "parser.y" { cb_tree plabel; char name[64]; @@ -9761,461 +9749,461 @@ yyparse (void) cb_emit_goto (cb_list_init (current_paragraph->exit_label_ref), NULL); } } -#line 9765 "parser.c" +#line 9753 "parser.c" break; case 924: -#line 5043 "parser.y" +#line 5031 "parser.y" { BEGIN_STATEMENT ("FREE", 0); } -#line 9771 "parser.c" +#line 9759 "parser.c" break; case 925: -#line 5045 "parser.y" +#line 5033 "parser.y" { cb_emit_free (yyvsp[0]); } -#line 9779 "parser.c" +#line 9767 "parser.c" break; case 926: -#line 5056 "parser.y" +#line 5044 "parser.y" { BEGIN_STATEMENT ("GENERATE", 0); } -#line 9785 "parser.c" +#line 9773 "parser.c" break; case 927: -#line 5058 "parser.y" +#line 5046 "parser.y" { PENDING("GENERATE"); } -#line 9793 "parser.c" +#line 9781 "parser.c" break; case 928: -#line 5069 "parser.y" +#line 5057 "parser.y" { BEGIN_STATEMENT ("GO TO", 0); } -#line 9799 "parser.c" +#line 9787 "parser.c" break; case 929: -#line 5071 "parser.y" +#line 5059 "parser.y" { cb_emit_goto (yyvsp[-1], yyvsp[0]); } -#line 9807 "parser.c" +#line 9795 "parser.c" break; case 930: -#line 5078 "parser.y" +#line 5066 "parser.y" { check_unreached = 1; yyval = NULL; } -#line 9816 "parser.c" +#line 9804 "parser.c" break; case 931: -#line 5083 "parser.y" +#line 5071 "parser.y" { check_unreached = 0; yyval = yyvsp[0]; } -#line 9825 "parser.c" +#line 9813 "parser.c" break; case 932: -#line 5095 "parser.y" +#line 5083 "parser.y" { BEGIN_STATEMENT ("GOBACK", 0); } -#line 9831 "parser.c" +#line 9819 "parser.c" break; case 933: -#line 5096 "parser.y" +#line 5084 "parser.y" { check_unreached = 1; cb_emit_exit (1); } -#line 9840 "parser.c" +#line 9828 "parser.c" break; case 934: -#line 5108 "parser.y" +#line 5096 "parser.y" { BEGIN_STATEMENT ("IF", TERM_IF); } -#line 9846 "parser.c" +#line 9834 "parser.c" break; case 935: -#line 5110 "parser.y" +#line 5098 "parser.y" { check_unreached = 0; } -#line 9854 "parser.c" +#line 9842 "parser.c" break; case 936: -#line 5115 "parser.y" +#line 5103 "parser.y" { if (!cb_allow_empty_imperative_statement && yyvsp[-2] == NULL) { cb_error (_("syntax error")); } cb_emit_if (yyvsp[-5], yyvsp[-2], yyvsp[-1]); } -#line 9865 "parser.c" +#line 9853 "parser.c" break; case 938: -#line 5126 "parser.y" +#line 5114 "parser.y" { yyval = NULL; } -#line 9873 "parser.c" +#line 9861 "parser.c" break; case 939: -#line 5130 "parser.y" +#line 5118 "parser.y" { check_unreached = 0; } -#line 9881 "parser.c" +#line 9869 "parser.c" break; case 940: -#line 5134 "parser.y" +#line 5122 "parser.y" { if (!cb_allow_empty_imperative_statement && yyvsp[0] == NULL) { cb_error (_("syntax error")); } yyval = yyvsp[0]; } -#line 9892 "parser.c" +#line 9880 "parser.c" break; case 941: -#line 5143 "parser.y" +#line 5131 "parser.y" { terminator_warning (TERM_IF); } -#line 9898 "parser.c" +#line 9886 "parser.c" break; case 942: -#line 5144 "parser.y" +#line 5132 "parser.y" { terminator_clear (TERM_IF); } -#line 9904 "parser.c" +#line 9892 "parser.c" break; case 943: -#line 5153 "parser.y" +#line 5141 "parser.y" { BEGIN_STATEMENT ("INITIALIZE", 0); } -#line 9910 "parser.c" +#line 9898 "parser.c" break; case 944: -#line 5155 "parser.y" +#line 5143 "parser.y" { cb_emit_initialize (yyvsp[-4], yyvsp[-3], yyvsp[-2], yyvsp[-1], yyvsp[0]); } -#line 9918 "parser.c" +#line 9906 "parser.c" break; case 945: -#line 5161 "parser.y" +#line 5149 "parser.y" { yyval = NULL; } -#line 9924 "parser.c" +#line 9912 "parser.c" break; case 946: -#line 5162 "parser.y" +#line 5150 "parser.y" { yyval = cb_true; } -#line 9930 "parser.c" +#line 9918 "parser.c" break; case 947: -#line 5166 "parser.y" +#line 5154 "parser.y" { yyval = NULL; } -#line 9936 "parser.c" +#line 9924 "parser.c" break; case 948: -#line 5167 "parser.y" +#line 5155 "parser.y" { yyval = cb_true; } -#line 9942 "parser.c" +#line 9930 "parser.c" break; case 949: -#line 5168 "parser.y" +#line 5156 "parser.y" { yyval = yyvsp[-2]; } -#line 9948 "parser.c" +#line 9936 "parser.c" break; case 950: -#line 5172 "parser.y" +#line 5160 "parser.y" { yyval = NULL; } -#line 9954 "parser.c" +#line 9942 "parser.c" break; case 951: -#line 5174 "parser.y" +#line 5162 "parser.y" { yyval = yyvsp[0]; } -#line 9960 "parser.c" +#line 9948 "parser.c" break; case 952: -#line 5178 "parser.y" +#line 5166 "parser.y" { yyval = yyvsp[0]; } -#line 9966 "parser.c" +#line 9954 "parser.c" break; case 953: -#line 5180 "parser.y" +#line 5168 "parser.y" { yyval = cb_list_append (yyvsp[-1], yyvsp[0]); } -#line 9972 "parser.c" +#line 9960 "parser.c" break; case 954: -#line 5184 "parser.y" +#line 5172 "parser.y" { yyval = cb_build_pair (yyvsp[-3], yyvsp[0]); } -#line 9978 "parser.c" +#line 9966 "parser.c" break; case 955: -#line 5188 "parser.y" +#line 5176 "parser.y" { yyval = cb_int (CB_CATEGORY_ALPHABETIC); } -#line 9984 "parser.c" +#line 9972 "parser.c" break; case 956: -#line 5189 "parser.y" +#line 5177 "parser.y" { yyval = cb_int (CB_CATEGORY_ALPHANUMERIC); } -#line 9990 "parser.c" +#line 9978 "parser.c" break; case 957: -#line 5190 "parser.y" +#line 5178 "parser.y" { yyval = cb_int (CB_CATEGORY_NUMERIC); } -#line 9996 "parser.c" +#line 9984 "parser.c" break; case 958: -#line 5191 "parser.y" +#line 5179 "parser.y" { yyval = cb_int (CB_CATEGORY_ALPHANUMERIC_EDITED); } -#line 10002 "parser.c" +#line 9990 "parser.c" break; case 959: -#line 5192 "parser.y" +#line 5180 "parser.y" { yyval = cb_int (CB_CATEGORY_NUMERIC_EDITED); } -#line 10008 "parser.c" +#line 9996 "parser.c" break; case 960: -#line 5193 "parser.y" +#line 5181 "parser.y" { yyval = cb_int (CB_CATEGORY_NATIONAL); } -#line 10014 "parser.c" +#line 10002 "parser.c" break; case 961: -#line 5194 "parser.y" +#line 5182 "parser.y" { yyval = cb_int (CB_CATEGORY_NATIONAL_EDITED); } -#line 10020 "parser.c" +#line 10008 "parser.c" break; case 962: -#line 5198 "parser.y" +#line 5186 "parser.y" { yyval = NULL; } -#line 10026 "parser.c" +#line 10014 "parser.c" break; case 963: -#line 5199 "parser.y" +#line 5187 "parser.y" { yyval = cb_true; } -#line 10032 "parser.c" +#line 10020 "parser.c" break; case 964: -#line 5208 "parser.y" +#line 5196 "parser.y" { BEGIN_STATEMENT ("INITIATE", 0); } -#line 10038 "parser.c" +#line 10026 "parser.c" break; case 965: -#line 5210 "parser.y" +#line 5198 "parser.y" { PENDING("INITIATE"); } -#line 10046 "parser.c" +#line 10034 "parser.c" break; case 966: -#line 5221 "parser.y" +#line 5209 "parser.y" { BEGIN_STATEMENT ("INSPECT", 0); sending_id = 0; inspect_keyword = 0; } -#line 10056 "parser.c" +#line 10044 "parser.c" break; case 968: -#line 5230 "parser.y" +#line 5218 "parser.y" { save_tree_1 = yyvsp[0]; sending_id = 0; } -#line 10062 "parser.c" +#line 10050 "parser.c" break; case 969: -#line 5231 "parser.y" +#line 5219 "parser.y" { save_tree_1 = yyvsp[0]; sending_id = 1; } -#line 10068 "parser.c" +#line 10056 "parser.c" break; case 970: -#line 5232 "parser.y" +#line 5220 "parser.y" { save_tree_1 = yyvsp[0]; sending_id = 1; } -#line 10074 "parser.c" +#line 10062 "parser.c" break; case 973: -#line 5241 "parser.y" +#line 5229 "parser.y" { cb_emit_inspect (save_tree_1, yyvsp[0], cb_int0, 0); } -#line 10080 "parser.c" +#line 10068 "parser.c" break; case 974: -#line 5242 "parser.y" +#line 5230 "parser.y" { cb_emit_inspect (save_tree_1, yyvsp[0], cb_int1, 1); } -#line 10086 "parser.c" +#line 10074 "parser.c" break; case 975: -#line 5243 "parser.y" +#line 5231 "parser.y" { cb_emit_inspect (save_tree_1, yyvsp[0], cb_int0, 2); } -#line 10092 "parser.c" +#line 10080 "parser.c" break; case 976: -#line 5249 "parser.y" +#line 5237 "parser.y" { cb_init_tarrying (); } -#line 10098 "parser.c" +#line 10086 "parser.c" break; case 977: -#line 5250 "parser.y" +#line 5238 "parser.y" { yyval = yyvsp[0]; } -#line 10104 "parser.c" +#line 10092 "parser.c" break; case 978: -#line 5254 "parser.y" +#line 5242 "parser.y" { yyval = yyvsp[0]; } -#line 10110 "parser.c" +#line 10098 "parser.c" break; case 979: -#line 5255 "parser.y" +#line 5243 "parser.y" { yyval = cb_list_append (yyvsp[-1], yyvsp[0]); } -#line 10116 "parser.c" +#line 10104 "parser.c" break; case 980: -#line 5259 "parser.y" +#line 5247 "parser.y" { yyval = cb_build_tarrying_data (yyvsp[-1]); } -#line 10122 "parser.c" +#line 10110 "parser.c" break; case 981: -#line 5260 "parser.y" +#line 5248 "parser.y" { yyval = cb_build_tarrying_characters (yyvsp[0]); } -#line 10128 "parser.c" +#line 10116 "parser.c" break; case 982: -#line 5261 "parser.y" +#line 5249 "parser.y" { yyval = cb_build_tarrying_all (); } -#line 10134 "parser.c" +#line 10122 "parser.c" break; case 983: -#line 5262 "parser.y" +#line 5250 "parser.y" { yyval = cb_build_tarrying_leading (); } -#line 10140 "parser.c" +#line 10128 "parser.c" break; case 984: -#line 5263 "parser.y" +#line 5251 "parser.y" { yyval = cb_build_tarrying_trailing (); } -#line 10146 "parser.c" +#line 10134 "parser.c" break; case 985: -#line 5264 "parser.y" +#line 5252 "parser.y" { yyval = cb_build_tarrying_value (yyvsp[-1], yyvsp[0]); } -#line 10152 "parser.c" +#line 10140 "parser.c" break; case 986: -#line 5270 "parser.y" +#line 5258 "parser.y" { yyval = yyvsp[0]; inspect_keyword = 0; } -#line 10158 "parser.c" +#line 10146 "parser.c" break; case 987: -#line 5274 "parser.y" +#line 5262 "parser.y" { yyval = yyvsp[0]; } -#line 10164 "parser.c" +#line 10152 "parser.c" break; case 988: -#line 5275 "parser.y" +#line 5263 "parser.y" { yyval = cb_list_append (yyvsp[-1], yyvsp[0]); } -#line 10170 "parser.c" +#line 10158 "parser.c" break; case 989: -#line 5280 "parser.y" +#line 5268 "parser.y" { yyval = cb_build_replacing_characters (yyvsp[-1], yyvsp[0], save_tree_1); inspect_keyword = 0; } -#line 10179 "parser.c" +#line 10167 "parser.c" break; case 990: -#line 5284 "parser.y" +#line 5272 "parser.y" { yyval = yyvsp[0]; } -#line 10185 "parser.c" +#line 10173 "parser.c" break; case 991: -#line 5288 "parser.y" +#line 5276 "parser.y" { /* Nothing */ } -#line 10191 "parser.c" +#line 10179 "parser.c" break; case 992: -#line 5289 "parser.y" +#line 5277 "parser.y" { inspect_keyword = 1; } -#line 10197 "parser.c" +#line 10185 "parser.c" break; case 993: -#line 5290 "parser.y" +#line 5278 "parser.y" { inspect_keyword = 2; } -#line 10203 "parser.c" +#line 10191 "parser.c" break; case 994: -#line 5291 "parser.y" +#line 5279 "parser.y" { inspect_keyword = 3; } -#line 10209 "parser.c" +#line 10197 "parser.c" break; case 995: -#line 5292 "parser.y" +#line 5280 "parser.y" { inspect_keyword = 4; } -#line 10215 "parser.c" +#line 10203 "parser.c" break; case 996: -#line 5297 "parser.y" +#line 5285 "parser.y" { switch (inspect_keyword) { case 1: @@ -10236,11 +10224,11 @@ yyparse (void) break; } } -#line 10240 "parser.c" +#line 10228 "parser.c" break; case 997: -#line 5323 "parser.y" +#line 5311 "parser.y" { if (cb_validate_inspect (save_tree_1, yyvsp[-3], yyvsp[-1]) < 0 ) { yyval = cb_error_node; @@ -10248,91 +10236,91 @@ yyparse (void) yyval = cb_build_converting (yyvsp[-3], yyvsp[-1], yyvsp[0]); } } -#line 10252 "parser.c" +#line 10240 "parser.c" break; case 998: -#line 5335 "parser.y" +#line 5323 "parser.y" { yyval = cb_build_inspect_region_start (); } -#line 10258 "parser.c" +#line 10246 "parser.c" break; case 999: -#line 5337 "parser.y" +#line 5325 "parser.y" { yyval = cb_build_inspect_region (yyvsp[-3], yyvsp[-2], yyvsp[0]); } -#line 10264 "parser.c" +#line 10252 "parser.c" break; case 1002: -#line 5348 "parser.y" +#line 5336 "parser.y" { BEGIN_STATEMENT ("MERGE", 0); } -#line 10270 "parser.c" +#line 10258 "parser.c" break; case 1004: -#line 5358 "parser.y" +#line 5346 "parser.y" { BEGIN_STATEMENT ("MOVE", 0); } -#line 10276 "parser.c" +#line 10264 "parser.c" break; case 1006: -#line 5364 "parser.y" +#line 5352 "parser.y" { cb_emit_move (yyvsp[-2], yyvsp[0]); } -#line 10284 "parser.c" +#line 10272 "parser.c" break; case 1007: -#line 5368 "parser.y" +#line 5356 "parser.y" { cb_emit_move_corresponding (yyvsp[-2], yyvsp[0]); } -#line 10292 "parser.c" +#line 10280 "parser.c" break; case 1008: -#line 5379 "parser.y" +#line 5367 "parser.y" { BEGIN_STATEMENT ("MULTIPLY", TERM_MULTIPLY); } -#line 10298 "parser.c" +#line 10286 "parser.c" break; case 1010: -#line 5386 "parser.y" +#line 5374 "parser.y" { cb_emit_arithmetic (yyvsp[-1], '*', yyvsp[-3]); } -#line 10306 "parser.c" +#line 10294 "parser.c" break; case 1011: -#line 5390 "parser.y" +#line 5378 "parser.y" { cb_emit_arithmetic (yyvsp[-1], 0, cb_build_binary_op (yyvsp[-5], '*', yyvsp[-3])); } -#line 10314 "parser.c" +#line 10302 "parser.c" break; case 1012: -#line 5396 "parser.y" +#line 5384 "parser.y" { terminator_warning (TERM_MULTIPLY); } -#line 10320 "parser.c" +#line 10308 "parser.c" break; case 1013: -#line 5397 "parser.y" +#line 5385 "parser.y" { terminator_clear (TERM_MULTIPLY); } -#line 10326 "parser.c" +#line 10314 "parser.c" break; case 1014: -#line 5406 "parser.y" +#line 5394 "parser.y" { BEGIN_STATEMENT ("OPEN", 0); } -#line 10332 "parser.c" +#line 10320 "parser.c" break; case 1017: -#line 5413 "parser.y" +#line 5401 "parser.y" { cb_tree l; for (l = yyvsp[-1]; l; l = CB_CHAIN (l)) { @@ -10342,217 +10330,217 @@ yyparse (void) } } } -#line 10346 "parser.c" +#line 10334 "parser.c" break; case 1018: -#line 5425 "parser.y" +#line 5413 "parser.y" { yyval = cb_int (COB_OPEN_INPUT); } -#line 10352 "parser.c" +#line 10340 "parser.c" break; case 1019: -#line 5426 "parser.y" +#line 5414 "parser.y" { yyval = cb_int (COB_OPEN_OUTPUT); } -#line 10358 "parser.c" +#line 10346 "parser.c" break; case 1020: -#line 5427 "parser.y" +#line 5415 "parser.y" { yyval = cb_int (COB_OPEN_I_O); } -#line 10364 "parser.c" +#line 10352 "parser.c" break; case 1021: -#line 5428 "parser.y" +#line 5416 "parser.y" { yyval = cb_int (COB_OPEN_EXTEND); } -#line 10370 "parser.c" +#line 10358 "parser.c" break; case 1022: -#line 5432 "parser.y" +#line 5420 "parser.y" { yyval = NULL; } -#line 10376 "parser.c" +#line 10364 "parser.c" break; case 1023: -#line 5433 "parser.y" +#line 5421 "parser.y" { yyval = yyvsp[0]; } -#line 10382 "parser.c" +#line 10370 "parser.c" break; case 1024: -#line 5437 "parser.y" +#line 5425 "parser.y" { yyval = NULL; } -#line 10388 "parser.c" +#line 10376 "parser.c" break; case 1025: -#line 5438 "parser.y" +#line 5426 "parser.y" { yyval = NULL; } -#line 10394 "parser.c" +#line 10382 "parser.c" break; case 1026: -#line 5439 "parser.y" +#line 5427 "parser.y" { PENDING ("OPEN ... WITH LOCK"); } -#line 10400 "parser.c" +#line 10388 "parser.c" break; case 1027: -#line 5451 "parser.y" +#line 5439 "parser.y" { BEGIN_STATEMENT ("PERFORM", TERM_PERFORM); } -#line 10406 "parser.c" +#line 10394 "parser.c" break; case 1029: -#line 5457 "parser.y" +#line 5445 "parser.y" { cb_emit_perform (yyvsp[0], yyvsp[-1]); } -#line 10414 "parser.c" +#line 10402 "parser.c" break; case 1030: -#line 5461 "parser.y" +#line 5449 "parser.y" { perform_stack = cb_cons (yyvsp[0], perform_stack); check_unreached = 0; } -#line 10423 "parser.c" +#line 10411 "parser.c" break; case 1031: -#line 5466 "parser.y" +#line 5454 "parser.y" { perform_stack = CB_CHAIN (perform_stack); cb_emit_perform (yyvsp[-3], yyvsp[-1]); } -#line 10432 "parser.c" +#line 10420 "parser.c" break; case 1032: -#line 5471 "parser.y" +#line 5459 "parser.y" { cb_emit_perform (yyvsp[-1], NULL); } -#line 10440 "parser.c" +#line 10428 "parser.c" break; case 1033: -#line 5477 "parser.y" +#line 5465 "parser.y" { terminator_error (); } -#line 10446 "parser.c" +#line 10434 "parser.c" break; case 1034: -#line 5478 "parser.y" +#line 5466 "parser.y" { terminator_clear (TERM_PERFORM); } -#line 10452 "parser.c" +#line 10440 "parser.c" break; case 1035: -#line 5483 "parser.y" +#line 5471 "parser.y" { CB_REFERENCE (yyvsp[0])->length = cb_true; /* return from $1 */ yyval = cb_build_pair (yyvsp[0], yyvsp[0]); } -#line 10461 "parser.c" +#line 10449 "parser.c" break; case 1036: -#line 5488 "parser.y" +#line 5476 "parser.y" { CB_REFERENCE (yyvsp[0])->length = cb_true; /* return from $3 */ yyval = cb_build_pair (yyvsp[-2], yyvsp[0]); } -#line 10470 "parser.c" +#line 10458 "parser.c" break; case 1037: -#line 5496 "parser.y" +#line 5484 "parser.y" { yyval = cb_build_perform_once (NULL); } -#line 10478 "parser.c" +#line 10466 "parser.c" break; case 1038: -#line 5500 "parser.y" +#line 5488 "parser.y" { yyval = cb_build_perform_forever (NULL); } -#line 10486 "parser.c" +#line 10474 "parser.c" break; case 1039: -#line 5504 "parser.y" +#line 5492 "parser.y" { yyval = cb_build_perform_times (yyvsp[-1]); current_program->loop_counter++; } -#line 10495 "parser.c" +#line 10483 "parser.c" break; case 1040: -#line 5509 "parser.y" +#line 5497 "parser.y" { cb_tree varying; varying = cb_list_init (cb_build_perform_varying (NULL, NULL, NULL, yyvsp[0])); yyval = cb_build_perform_until (yyvsp[-2], varying); } -#line 10506 "parser.c" +#line 10494 "parser.c" break; case 1041: -#line 5516 "parser.y" +#line 5504 "parser.y" { yyval = cb_build_perform_until (yyvsp[-2], yyvsp[0]); } -#line 10514 "parser.c" +#line 10502 "parser.c" break; case 1042: -#line 5522 "parser.y" +#line 5510 "parser.y" { yyval = CB_BEFORE; } -#line 10520 "parser.c" +#line 10508 "parser.c" break; case 1043: -#line 5523 "parser.y" +#line 5511 "parser.y" { yyval = yyvsp[0]; } -#line 10526 "parser.c" +#line 10514 "parser.c" break; case 1044: -#line 5527 "parser.y" +#line 5515 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 10532 "parser.c" +#line 10520 "parser.c" break; case 1045: -#line 5529 "parser.y" +#line 5517 "parser.y" { yyval = cb_list_add (yyvsp[-2], yyvsp[0]); } -#line 10538 "parser.c" +#line 10526 "parser.c" break; case 1046: -#line 5534 "parser.y" +#line 5522 "parser.y" { yyval = cb_build_perform_varying (yyvsp[-6], yyvsp[-4], yyvsp[-2], yyvsp[0]); } -#line 10546 "parser.c" +#line 10534 "parser.c" break; case 1047: -#line 5545 "parser.y" +#line 5533 "parser.y" { BEGIN_STATEMENT ("READ", TERM_READ); } -#line 10552 "parser.c" +#line 10540 "parser.c" break; case 1048: -#line 5548 "parser.y" +#line 5536 "parser.y" { if (yyvsp[-7] != cb_error_node) { if (cb_use_invalidkey_handler_on_status34 && @@ -10576,75 +10564,75 @@ yyparse (void) } } } -#line 10580 "parser.c" +#line 10568 "parser.c" break; case 1049: -#line 5574 "parser.y" +#line 5562 "parser.y" { yyval = NULL; } -#line 10586 "parser.c" +#line 10574 "parser.c" break; case 1050: -#line 5575 "parser.y" +#line 5563 "parser.y" { yyval = yyvsp[0]; } -#line 10592 "parser.c" +#line 10580 "parser.c" break; case 1051: -#line 5579 "parser.y" +#line 5567 "parser.y" { yyval = NULL; } -#line 10598 "parser.c" +#line 10586 "parser.c" break; case 1052: -#line 5581 "parser.y" +#line 5569 "parser.y" { yyval = cb_int3; } -#line 10606 "parser.c" +#line 10594 "parser.c" break; case 1053: -#line 5585 "parser.y" +#line 5573 "parser.y" { yyval = cb_int1; } -#line 10614 "parser.c" +#line 10602 "parser.c" break; case 1054: -#line 5589 "parser.y" +#line 5577 "parser.y" { yyval = cb_int2; } -#line 10622 "parser.c" +#line 10610 "parser.c" break; case 1055: -#line 5593 "parser.y" +#line 5581 "parser.y" { yyval = cb_int3; } -#line 10630 "parser.c" +#line 10618 "parser.c" break; case 1056: -#line 5597 "parser.y" +#line 5585 "parser.y" { yyval = cb_int4; } -#line 10638 "parser.c" +#line 10626 "parser.c" break; case 1057: -#line 5603 "parser.y" +#line 5591 "parser.y" { yyval = NULL; } -#line 10644 "parser.c" +#line 10632 "parser.c" break; case 1058: -#line 5605 "parser.y" +#line 5593 "parser.y" { #if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) || defined(WITH_INDEX_EXTFH) yyval = yyvsp[0]; @@ -10656,73 +10644,73 @@ yyparse (void) } #endif } -#line 10660 "parser.c" +#line 10648 "parser.c" break; case 1062: -#line 5624 "parser.y" +#line 5612 "parser.y" { terminator_warning (TERM_READ); } -#line 10666 "parser.c" +#line 10654 "parser.c" break; case 1063: -#line 5625 "parser.y" +#line 5613 "parser.y" { terminator_clear (TERM_READ); } -#line 10672 "parser.c" +#line 10660 "parser.c" break; case 1064: -#line 5634 "parser.y" +#line 5622 "parser.y" { BEGIN_STATEMENT ("RELEASE", 0); } -#line 10678 "parser.c" +#line 10666 "parser.c" break; case 1065: -#line 5636 "parser.y" +#line 5624 "parser.y" { if (yyvsp[-1] != cb_error_node) { cb_emit_release (yyvsp[-1], yyvsp[0]); } } -#line 10688 "parser.c" +#line 10676 "parser.c" break; case 1066: -#line 5649 "parser.y" +#line 5637 "parser.y" { BEGIN_STATEMENT ("RETURN", TERM_RETURN); } -#line 10694 "parser.c" +#line 10682 "parser.c" break; case 1067: -#line 5652 "parser.y" +#line 5640 "parser.y" { if (yyvsp[-4] != cb_error_node) { cb_emit_return (yyvsp[-4], yyvsp[-2]); } } -#line 10704 "parser.c" +#line 10692 "parser.c" break; case 1068: -#line 5660 "parser.y" +#line 5648 "parser.y" { terminator_warning (TERM_RETURN); } -#line 10710 "parser.c" +#line 10698 "parser.c" break; case 1069: -#line 5661 "parser.y" +#line 5649 "parser.y" { terminator_clear (TERM_RETURN); } -#line 10716 "parser.c" +#line 10704 "parser.c" break; case 1070: -#line 5670 "parser.y" +#line 5658 "parser.y" { BEGIN_STATEMENT ("REWRITE", TERM_REWRITE); } -#line 10722 "parser.c" +#line 10710 "parser.c" break; case 1071: -#line 5673 "parser.y" +#line 5661 "parser.y" { if (yyvsp[-4] != cb_error_node) { if (cb_use_invalidkey_handler_on_status34 && @@ -10734,238 +10722,238 @@ yyparse (void) cb_emit_rewrite (yyvsp[-4], yyvsp[-3], yyvsp[-2]); } } -#line 10738 "parser.c" +#line 10726 "parser.c" break; case 1072: -#line 5687 "parser.y" +#line 5675 "parser.y" { yyval = NULL; } -#line 10744 "parser.c" +#line 10732 "parser.c" break; case 1073: -#line 5689 "parser.y" +#line 5677 "parser.y" { yyval = cb_int1; } -#line 10752 "parser.c" +#line 10740 "parser.c" break; case 1074: -#line 5693 "parser.y" +#line 5681 "parser.y" { yyval = cb_int2; } -#line 10760 "parser.c" +#line 10748 "parser.c" break; case 1075: -#line 5699 "parser.y" +#line 5687 "parser.y" { terminator_warning (TERM_REWRITE); } -#line 10766 "parser.c" +#line 10754 "parser.c" break; case 1076: -#line 5700 "parser.y" +#line 5688 "parser.y" { terminator_clear (TERM_REWRITE); } -#line 10772 "parser.c" +#line 10760 "parser.c" break; case 1077: -#line 5710 "parser.y" +#line 5698 "parser.y" { BEGIN_STATEMENT ("ROLLBACK", 0); cb_emit_rollback (); } -#line 10781 "parser.c" +#line 10769 "parser.c" break; case 1078: -#line 5722 "parser.y" +#line 5710 "parser.y" { BEGIN_STATEMENT ("SEARCH", TERM_SEARCH); } -#line 10787 "parser.c" +#line 10775 "parser.c" break; case 1080: -#line 5729 "parser.y" +#line 5717 "parser.y" { cb_emit_search (yyvsp[-3], yyvsp[-2], yyvsp[-1], yyvsp[0]); } -#line 10795 "parser.c" +#line 10783 "parser.c" break; case 1081: -#line 5733 "parser.y" +#line 5721 "parser.y" { check_unreached = 0; } -#line 10803 "parser.c" +#line 10791 "parser.c" break; case 1082: -#line 5737 "parser.y" +#line 5725 "parser.y" { cb_emit_search_all (yyvsp[-5], yyvsp[-4], yyvsp[-2], yyvsp[0]); } -#line 10811 "parser.c" +#line 10799 "parser.c" break; case 1083: -#line 5743 "parser.y" +#line 5731 "parser.y" { yyval = NULL; } -#line 10817 "parser.c" +#line 10805 "parser.c" break; case 1084: -#line 5744 "parser.y" +#line 5732 "parser.y" { yyval = yyvsp[0]; } -#line 10823 "parser.c" +#line 10811 "parser.c" break; case 1085: -#line 5748 "parser.y" +#line 5736 "parser.y" { yyval = NULL; } -#line 10829 "parser.c" +#line 10817 "parser.c" break; case 1086: -#line 5750 "parser.y" +#line 5738 "parser.y" { check_unreached = 0; } -#line 10837 "parser.c" +#line 10825 "parser.c" break; case 1087: -#line 5754 "parser.y" +#line 5742 "parser.y" { yyval = yyvsp[0]; } -#line 10845 "parser.c" +#line 10833 "parser.c" break; case 1088: -#line 5760 "parser.y" +#line 5748 "parser.y" { yyval = yyvsp[0]; } -#line 10851 "parser.c" +#line 10839 "parser.c" break; case 1089: -#line 5761 "parser.y" +#line 5749 "parser.y" { yyval = yyvsp[-1]; CB_IF (yyvsp[-1])->stmt2 = yyvsp[0]; } -#line 10857 "parser.c" +#line 10845 "parser.c" break; case 1090: -#line 5766 "parser.y" +#line 5754 "parser.y" { check_unreached = 0; } -#line 10865 "parser.c" +#line 10853 "parser.c" break; case 1091: -#line 5770 "parser.y" +#line 5758 "parser.y" { yyval = cb_build_if (yyvsp[-2], yyvsp[0], NULL); } -#line 10873 "parser.c" +#line 10861 "parser.c" break; case 1092: -#line 5776 "parser.y" +#line 5764 "parser.y" { terminator_warning (TERM_SEARCH); } -#line 10879 "parser.c" +#line 10867 "parser.c" break; case 1093: -#line 5777 "parser.y" +#line 5765 "parser.y" { terminator_clear (TERM_SEARCH); } -#line 10885 "parser.c" +#line 10873 "parser.c" break; case 1094: -#line 5786 "parser.y" +#line 5774 "parser.y" { BEGIN_STATEMENT ("SET", 0); } -#line 10891 "parser.c" +#line 10879 "parser.c" break; case 1101: -#line 5802 "parser.y" +#line 5790 "parser.y" { cb_emit_setenv (yyvsp[-2], yyvsp[0]); } -#line 10899 "parser.c" +#line 10887 "parser.c" break; case 1102: -#line 5811 "parser.y" +#line 5799 "parser.y" { cb_emit_set_to (yyvsp[-3], cb_build_ppointer (yyvsp[0])); } -#line 10907 "parser.c" +#line 10895 "parser.c" break; case 1103: -#line 5815 "parser.y" +#line 5803 "parser.y" { cb_emit_set_to (yyvsp[-2], yyvsp[0]); } -#line 10915 "parser.c" +#line 10903 "parser.c" break; case 1104: -#line 5824 "parser.y" +#line 5812 "parser.y" { cb_emit_set_up_down (yyvsp[-3], yyvsp[-2], yyvsp[0]); } -#line 10923 "parser.c" +#line 10911 "parser.c" break; case 1105: -#line 5830 "parser.y" +#line 5818 "parser.y" { yyval = cb_int0; } -#line 10929 "parser.c" +#line 10917 "parser.c" break; case 1106: -#line 5831 "parser.y" +#line 5819 "parser.y" { yyval = cb_int1; } -#line 10935 "parser.c" +#line 10923 "parser.c" break; case 1109: -#line 5843 "parser.y" +#line 5831 "parser.y" { cb_emit_set_on_off (yyvsp[-2], yyvsp[0]); } -#line 10943 "parser.c" +#line 10931 "parser.c" break; case 1112: -#line 5857 "parser.y" +#line 5845 "parser.y" { cb_emit_set_true (yyvsp[-2]); } -#line 10951 "parser.c" +#line 10939 "parser.c" break; case 1113: -#line 5861 "parser.y" +#line 5849 "parser.y" { cb_emit_set_false (yyvsp[-2]); } -#line 10959 "parser.c" +#line 10947 "parser.c" break; case 1114: -#line 5872 "parser.y" +#line 5860 "parser.y" { BEGIN_STATEMENT ("SORT", 0); } -#line 10965 "parser.c" +#line 10953 "parser.c" break; case 1116: -#line 5878 "parser.y" +#line 5866 "parser.y" { cb_emit_sort_init (yyvsp[-3], yyvsp[-2], yyvsp[0]); if (CB_FILE_P (cb_ref (yyvsp[-3])) && yyvsp[-2] == NULL) { @@ -10974,27 +10962,27 @@ yyparse (void) /* used in sort_input/sort_output */ save_tree_1 = yyvsp[-3]; } -#line 10978 "parser.c" +#line 10966 "parser.c" break; case 1117: -#line 5887 "parser.y" +#line 5875 "parser.y" { cb_emit_sort_finish (yyvsp[-6]); } -#line 10986 "parser.c" +#line 10974 "parser.c" break; case 1118: -#line 5894 "parser.y" +#line 5882 "parser.y" { yyval = NULL; } -#line 10994 "parser.c" +#line 10982 "parser.c" break; case 1119: -#line 5899 "parser.y" +#line 5887 "parser.y" { cb_tree l; @@ -11011,51 +10999,51 @@ yyparse (void) yyval = cb_list_append (yyvsp[-5], yyvsp[0]); } } -#line 11015 "parser.c" +#line 11003 "parser.c" break; case 1120: -#line 5918 "parser.y" +#line 5906 "parser.y" { yyval = NULL; } -#line 11021 "parser.c" +#line 11009 "parser.c" break; case 1121: -#line 5919 "parser.y" +#line 5907 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 11027 "parser.c" +#line 11015 "parser.c" break; case 1123: -#line 5923 "parser.y" +#line 5911 "parser.y" { /* nothing */ } -#line 11033 "parser.c" +#line 11021 "parser.c" break; case 1124: -#line 5927 "parser.y" +#line 5915 "parser.y" { yyval = cb_null; } -#line 11039 "parser.c" +#line 11027 "parser.c" break; case 1125: -#line 5928 "parser.y" +#line 5916 "parser.y" { yyval = cb_ref (yyvsp[0]); } -#line 11045 "parser.c" +#line 11033 "parser.c" break; case 1126: -#line 5933 "parser.y" +#line 5921 "parser.y" { if (CB_FILE_P (cb_ref (save_tree_1))) { cb_error (_("File sort requires USING or INPUT PROCEDURE")); } } -#line 11055 "parser.c" +#line 11043 "parser.c" break; case 1127: -#line 5939 "parser.y" +#line 5927 "parser.y" { if (!CB_FILE_P (cb_ref (save_tree_1))) { cb_error (_("USING invalid with table SORT")); @@ -11063,11 +11051,11 @@ yyparse (void) cb_emit_sort_using (save_tree_1, yyvsp[0]); } } -#line 11067 "parser.c" +#line 11055 "parser.c" break; case 1128: -#line 5947 "parser.y" +#line 5935 "parser.y" { if (!CB_FILE_P (cb_ref (save_tree_1))) { cb_error (_("INPUT PROCEDURE invalid with table SORT")); @@ -11075,21 +11063,21 @@ yyparse (void) cb_emit_sort_input (yyvsp[0], save_tree_1); } } -#line 11079 "parser.c" +#line 11067 "parser.c" break; case 1129: -#line 5958 "parser.y" +#line 5946 "parser.y" { if (CB_FILE_P (cb_ref (save_tree_1))) { cb_error (_("File sort requires GIVING or OUTPUT PROCEDURE")); } } -#line 11089 "parser.c" +#line 11077 "parser.c" break; case 1130: -#line 5964 "parser.y" +#line 5952 "parser.y" { if (!CB_FILE_P (cb_ref (save_tree_1))) { cb_error (_("GIVING invalid with table SORT")); @@ -11097,11 +11085,11 @@ yyparse (void) cb_emit_sort_giving (save_tree_1, yyvsp[0]); } } -#line 11101 "parser.c" +#line 11089 "parser.c" break; case 1131: -#line 5972 "parser.y" +#line 5960 "parser.y" { if (!CB_FILE_P (cb_ref (save_tree_1))) { cb_error (_("OUTPUT PROCEDURE invalid with table SORT")); @@ -11109,23 +11097,23 @@ yyparse (void) cb_emit_sort_output (yyvsp[0], save_tree_1); } } -#line 11113 "parser.c" +#line 11101 "parser.c" break; case 1132: -#line 5987 "parser.y" +#line 5975 "parser.y" { BEGIN_STATEMENT ("START", TERM_START); } -#line 11119 "parser.c" +#line 11107 "parser.c" break; case 1133: -#line 5988 "parser.y" +#line 5976 "parser.y" { yyval = cb_int (COB_EQ); } -#line 11125 "parser.c" +#line 11113 "parser.c" break; case 1134: -#line 5991 "parser.y" +#line 5979 "parser.y" { if (CB_FILE_P (cb_ref (yyvsp[-4]))) { if (CB_FILE (cb_ref (yyvsp[-4]))->organization != COB_ORG_INDEXED && @@ -11140,17 +11128,17 @@ yyparse (void) yyval = cb_error_node; } } -#line 11144 "parser.c" +#line 11132 "parser.c" break; case 1135: -#line 6008 "parser.y" +#line 5996 "parser.y" { yyval = NULL; } -#line 11150 "parser.c" +#line 11138 "parser.c" break; case 1136: -#line 6010 "parser.y" +#line 5998 "parser.y" { yyvsp[-4] = yyvsp[-1]; #if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) || defined(WITH_INDEX_EXTFH) @@ -11163,379 +11151,379 @@ yyparse (void) } #endif } -#line 11167 "parser.c" +#line 11155 "parser.c" break; case 1137: -#line 6025 "parser.y" +#line 6013 "parser.y" { yyval = cb_int ((yyvsp[-1] == cb_int1) ? COB_NE : COB_EQ); } -#line 11173 "parser.c" +#line 11161 "parser.c" break; case 1138: -#line 6026 "parser.y" +#line 6014 "parser.y" { yyval = cb_int ((yyvsp[-1] == cb_int1) ? COB_LE : COB_GT); } -#line 11179 "parser.c" +#line 11167 "parser.c" break; case 1139: -#line 6027 "parser.y" +#line 6015 "parser.y" { yyval = cb_int ((yyvsp[-1] == cb_int1) ? COB_GE : COB_LT); } -#line 11185 "parser.c" +#line 11173 "parser.c" break; case 1140: -#line 6028 "parser.y" +#line 6016 "parser.y" { yyval = cb_int ((yyvsp[-1] == cb_int1) ? COB_LT : COB_GE); } -#line 11191 "parser.c" +#line 11179 "parser.c" break; case 1141: -#line 6029 "parser.y" +#line 6017 "parser.y" { yyval = cb_int ((yyvsp[-1] == cb_int1) ? COB_GT : COB_LE); } -#line 11197 "parser.c" +#line 11185 "parser.c" break; case 1142: -#line 6033 "parser.y" +#line 6021 "parser.y" { terminator_warning (TERM_START); } -#line 11203 "parser.c" +#line 11191 "parser.c" break; case 1143: -#line 6034 "parser.y" +#line 6022 "parser.y" { terminator_clear (TERM_START); } -#line 11209 "parser.c" +#line 11197 "parser.c" break; case 1144: -#line 6043 "parser.y" +#line 6031 "parser.y" { BEGIN_STATEMENT ("STOP", 0); } -#line 11215 "parser.c" +#line 11203 "parser.c" break; case 1145: -#line 6045 "parser.y" +#line 6033 "parser.y" { cb_emit_stop_run (yyvsp[0]); } -#line 11223 "parser.c" +#line 11211 "parser.c" break; case 1146: -#line 6048 "parser.y" +#line 6036 "parser.y" { BEGIN_STATEMENT ("STOP", 0); } -#line 11229 "parser.c" +#line 11217 "parser.c" break; case 1147: -#line 6049 "parser.y" +#line 6037 "parser.y" { cb_verify (cb_stop_literal_statement, "STOP literal"); } -#line 11237 "parser.c" +#line 11225 "parser.c" break; case 1148: -#line 6055 "parser.y" +#line 6043 "parser.y" { yyval = current_program->cb_return_code; } -#line 11243 "parser.c" +#line 11231 "parser.c" break; case 1149: -#line 6056 "parser.y" +#line 6044 "parser.y" { yyval = yyvsp[0]; } -#line 11249 "parser.c" +#line 11237 "parser.c" break; case 1150: -#line 6057 "parser.y" +#line 6045 "parser.y" { yyval = yyvsp[0]; } -#line 11255 "parser.c" +#line 11243 "parser.c" break; case 1151: -#line 6066 "parser.y" +#line 6054 "parser.y" { BEGIN_STATEMENT ("STRING", TERM_STRING); } -#line 11261 "parser.c" +#line 11249 "parser.c" break; case 1152: -#line 6069 "parser.y" +#line 6057 "parser.y" { cb_emit_string (yyvsp[-5], yyvsp[-3], yyvsp[-2]); } -#line 11269 "parser.c" +#line 11257 "parser.c" break; case 1153: -#line 6075 "parser.y" +#line 6063 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 11275 "parser.c" +#line 11263 "parser.c" break; case 1154: -#line 6076 "parser.y" +#line 6064 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 11281 "parser.c" +#line 11269 "parser.c" break; case 1155: -#line 6080 "parser.y" +#line 6068 "parser.y" { yyval = yyvsp[0]; } -#line 11287 "parser.c" +#line 11275 "parser.c" break; case 1156: -#line 6081 "parser.y" +#line 6069 "parser.y" { yyval = cb_build_pair (cb_int0, NULL); } -#line 11293 "parser.c" +#line 11281 "parser.c" break; case 1157: -#line 6082 "parser.y" +#line 6070 "parser.y" { yyval = cb_build_pair (yyvsp[0], NULL); } -#line 11299 "parser.c" +#line 11287 "parser.c" break; case 1158: -#line 6086 "parser.y" +#line 6074 "parser.y" { yyval = cb_int0; } -#line 11305 "parser.c" +#line 11293 "parser.c" break; case 1159: -#line 6087 "parser.y" +#line 6075 "parser.y" { yyval = yyvsp[0]; } -#line 11311 "parser.c" +#line 11299 "parser.c" break; case 1160: -#line 6091 "parser.y" +#line 6079 "parser.y" { terminator_warning (TERM_STRING); } -#line 11317 "parser.c" +#line 11305 "parser.c" break; case 1161: -#line 6092 "parser.y" +#line 6080 "parser.y" { terminator_clear (TERM_STRING); } -#line 11323 "parser.c" +#line 11311 "parser.c" break; case 1162: -#line 6101 "parser.y" +#line 6089 "parser.y" { BEGIN_STATEMENT ("SUBTRACT", TERM_SUBTRACT); } -#line 11329 "parser.c" +#line 11317 "parser.c" break; case 1164: -#line 6108 "parser.y" +#line 6096 "parser.y" { cb_emit_arithmetic (yyvsp[-1], '-', cb_build_binary_list (yyvsp[-3], '+')); } -#line 11337 "parser.c" +#line 11325 "parser.c" break; case 1165: -#line 6112 "parser.y" +#line 6100 "parser.y" { cb_emit_arithmetic (yyvsp[-1], 0, cb_build_binary_list (cb_cons (yyvsp[-3], yyvsp[-5]), '-')); } -#line 11345 "parser.c" +#line 11333 "parser.c" break; case 1166: -#line 6116 "parser.y" +#line 6104 "parser.y" { cb_emit_corresponding (cb_build_sub, yyvsp[-2], yyvsp[-4], yyvsp[-1]); } -#line 11353 "parser.c" +#line 11341 "parser.c" break; case 1167: -#line 6122 "parser.y" +#line 6110 "parser.y" { terminator_warning (TERM_SUBTRACT); } -#line 11359 "parser.c" +#line 11347 "parser.c" break; case 1168: -#line 6123 "parser.y" +#line 6111 "parser.y" { terminator_clear (TERM_SUBTRACT); } -#line 11365 "parser.c" +#line 11353 "parser.c" break; case 1169: -#line 6133 "parser.y" +#line 6121 "parser.y" { BEGIN_STATEMENT ("SUPPRESS", 0); PENDING("SUPPRESS"); } -#line 11374 "parser.c" +#line 11362 "parser.c" break; case 1172: -#line 6148 "parser.y" +#line 6136 "parser.y" { BEGIN_STATEMENT ("TERMINATE", 0); } -#line 11380 "parser.c" +#line 11368 "parser.c" break; case 1173: -#line 6150 "parser.y" +#line 6138 "parser.y" { PENDING("TERMINATE"); } -#line 11388 "parser.c" +#line 11376 "parser.c" break; case 1174: -#line 6161 "parser.y" +#line 6149 "parser.y" { BEGIN_STATEMENT ("TRANSFORM", 0); } -#line 11394 "parser.c" +#line 11382 "parser.c" break; case 1175: -#line 6163 "parser.y" +#line 6151 "parser.y" { cb_tree x; x = cb_build_converting (yyvsp[-2], yyvsp[0], cb_build_inspect_region_start ()); cb_emit_inspect (yyvsp[-4], x, cb_int0, 2); } -#line 11405 "parser.c" +#line 11393 "parser.c" break; case 1176: -#line 6177 "parser.y" +#line 6165 "parser.y" { BEGIN_STATEMENT ("UNLOCK", 0); } -#line 11411 "parser.c" +#line 11399 "parser.c" break; case 1177: -#line 6179 "parser.y" +#line 6167 "parser.y" { if (yyvsp[-1] != cb_error_node) { cb_emit_unlock (yyvsp[-1]); } } -#line 11421 "parser.c" +#line 11409 "parser.c" break; case 1181: -#line 6198 "parser.y" +#line 6186 "parser.y" { BEGIN_STATEMENT ("UNSTRING", TERM_UNSTRING); } -#line 11427 "parser.c" +#line 11415 "parser.c" break; case 1182: -#line 6202 "parser.y" +#line 6190 "parser.y" { cb_emit_unstring (yyvsp[-6], yyvsp[-5], yyvsp[-4], yyvsp[-3], yyvsp[-2]); } -#line 11435 "parser.c" +#line 11423 "parser.c" break; case 1183: -#line 6208 "parser.y" +#line 6196 "parser.y" { yyval = NULL; } -#line 11441 "parser.c" +#line 11429 "parser.c" break; case 1184: -#line 6210 "parser.y" +#line 6198 "parser.y" { yyval = yyvsp[0]; } -#line 11447 "parser.c" +#line 11435 "parser.c" break; case 1185: -#line 6214 "parser.y" +#line 6202 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 11453 "parser.c" +#line 11441 "parser.c" break; case 1186: -#line 6216 "parser.y" +#line 6204 "parser.y" { yyval = cb_list_add (yyvsp[-2], yyvsp[0]); } -#line 11459 "parser.c" +#line 11447 "parser.c" break; case 1187: -#line 6221 "parser.y" +#line 6209 "parser.y" { yyval = cb_build_unstring_delimited (yyvsp[-1], yyvsp[0]); } -#line 11467 "parser.c" +#line 11455 "parser.c" break; case 1188: -#line 6227 "parser.y" +#line 6215 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 11473 "parser.c" +#line 11461 "parser.c" break; case 1189: -#line 6229 "parser.y" +#line 6217 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 11479 "parser.c" +#line 11467 "parser.c" break; case 1190: -#line 6234 "parser.y" +#line 6222 "parser.y" { yyval = cb_build_unstring_into (yyvsp[-2], yyvsp[-1], yyvsp[0]); } -#line 11487 "parser.c" +#line 11475 "parser.c" break; case 1191: -#line 6240 "parser.y" +#line 6228 "parser.y" { yyval = NULL; } -#line 11493 "parser.c" +#line 11481 "parser.c" break; case 1192: -#line 6241 "parser.y" +#line 6229 "parser.y" { yyval = yyvsp[0]; } -#line 11499 "parser.c" +#line 11487 "parser.c" break; case 1193: -#line 6245 "parser.y" +#line 6233 "parser.y" { yyval = NULL; } -#line 11505 "parser.c" +#line 11493 "parser.c" break; case 1194: -#line 6246 "parser.y" +#line 6234 "parser.y" { yyval = yyvsp[0]; } -#line 11511 "parser.c" +#line 11499 "parser.c" break; case 1195: -#line 6250 "parser.y" +#line 6238 "parser.y" { yyval = NULL; } -#line 11517 "parser.c" +#line 11505 "parser.c" break; case 1196: -#line 6251 "parser.y" +#line 6239 "parser.y" { yyval = yyvsp[0]; } -#line 11523 "parser.c" +#line 11511 "parser.c" break; case 1197: -#line 6255 "parser.y" +#line 6243 "parser.y" { terminator_warning (TERM_UNSTRING); } -#line 11529 "parser.c" +#line 11517 "parser.c" break; case 1198: -#line 6256 "parser.y" +#line 6244 "parser.y" { terminator_clear (TERM_UNSTRING); } -#line 11535 "parser.c" +#line 11523 "parser.c" break; case 1202: -#line 6274 "parser.y" +#line 6262 "parser.y" { if (!in_declaratives) { cb_error (_("USE statement must be within DECLARATIVES")); @@ -11553,28 +11541,28 @@ yyparse (void) } } } -#line 11557 "parser.c" +#line 11545 "parser.c" break; case 1203: -#line 6295 "parser.y" +#line 6283 "parser.y" { use_global_ind = 0; } -#line 11565 "parser.c" +#line 11553 "parser.c" break; case 1204: -#line 6299 "parser.y" +#line 6287 "parser.y" { use_global_ind = 1; current_program->flag_global_use = 1; } -#line 11574 "parser.c" +#line 11562 "parser.c" break; case 1205: -#line 6307 "parser.y" +#line 6295 "parser.y" { cb_tree l; @@ -11584,69 +11572,69 @@ yyparse (void) } } } -#line 11588 "parser.c" +#line 11576 "parser.c" break; case 1206: -#line 6317 "parser.y" +#line 6305 "parser.y" { current_program->global_handler[COB_OPEN_INPUT].handler_label = current_section; current_program->global_handler[COB_OPEN_INPUT].handler_prog = current_program; } -#line 11597 "parser.c" +#line 11585 "parser.c" break; case 1207: -#line 6322 "parser.y" +#line 6310 "parser.y" { current_program->global_handler[COB_OPEN_OUTPUT].handler_label = current_section; current_program->global_handler[COB_OPEN_OUTPUT].handler_prog = current_program; } -#line 11606 "parser.c" +#line 11594 "parser.c" break; case 1208: -#line 6327 "parser.y" +#line 6315 "parser.y" { current_program->global_handler[COB_OPEN_I_O].handler_label = current_section; current_program->global_handler[COB_OPEN_I_O].handler_prog = current_program; } -#line 11615 "parser.c" +#line 11603 "parser.c" break; case 1209: -#line 6332 "parser.y" +#line 6320 "parser.y" { current_program->global_handler[COB_OPEN_EXTEND].handler_label = current_section; current_program->global_handler[COB_OPEN_EXTEND].handler_prog = current_program; } -#line 11624 "parser.c" +#line 11612 "parser.c" break; case 1222: -#line 6364 "parser.y" +#line 6352 "parser.y" { PENDING ("USE FOR DEBUGGING"); } -#line 11632 "parser.c" +#line 11620 "parser.c" break; case 1225: -#line 6376 "parser.y" +#line 6364 "parser.y" { PENDING ("USE BEFORE REPORTING"); } -#line 11640 "parser.c" +#line 11628 "parser.c" break; case 1226: -#line 6387 "parser.y" +#line 6375 "parser.y" { BEGIN_STATEMENT ("WRITE", TERM_WRITE); } -#line 11646 "parser.c" +#line 11634 "parser.c" break; case 1227: -#line 6390 "parser.y" +#line 6378 "parser.y" { if (yyvsp[-5] != cb_error_node) { if (cb_use_invalidkey_handler_on_status34 && @@ -11658,759 +11646,759 @@ yyparse (void) cb_emit_write (yyvsp[-5], yyvsp[-4], yyvsp[-2], yyvsp[-3]); } } -#line 11662 "parser.c" +#line 11650 "parser.c" break; case 1228: -#line 6404 "parser.y" +#line 6392 "parser.y" { yyval = NULL; } -#line 11668 "parser.c" +#line 11656 "parser.c" break; case 1229: -#line 6405 "parser.y" +#line 6393 "parser.y" { yyval = yyvsp[0]; } -#line 11674 "parser.c" +#line 11662 "parser.c" break; case 1230: -#line 6410 "parser.y" +#line 6398 "parser.y" { yyval = cb_int0; } -#line 11682 "parser.c" +#line 11670 "parser.c" break; case 1231: -#line 6414 "parser.y" +#line 6402 "parser.y" { yyval = cb_build_write_advancing_lines (yyvsp[-3], yyvsp[-1]); } -#line 11690 "parser.c" +#line 11678 "parser.c" break; case 1232: -#line 6418 "parser.y" +#line 6406 "parser.y" { yyval = cb_build_write_advancing_mnemonic (yyvsp[-2], yyvsp[0]); } -#line 11698 "parser.c" +#line 11686 "parser.c" break; case 1233: -#line 6422 "parser.y" +#line 6410 "parser.y" { yyval = cb_build_write_advancing_page (yyvsp[-2]); } -#line 11706 "parser.c" +#line 11694 "parser.c" break; case 1234: -#line 6428 "parser.y" +#line 6416 "parser.y" { yyval = CB_BEFORE; } -#line 11712 "parser.c" +#line 11700 "parser.c" break; case 1235: -#line 6429 "parser.y" +#line 6417 "parser.y" { yyval = CB_AFTER; } -#line 11718 "parser.c" +#line 11706 "parser.c" break; case 1239: -#line 6438 "parser.y" +#line 6426 "parser.y" { terminator_warning (TERM_WRITE); } -#line 11724 "parser.c" +#line 11712 "parser.c" break; case 1240: -#line 6439 "parser.y" +#line 6427 "parser.y" { terminator_clear (TERM_WRITE); } -#line 11730 "parser.c" +#line 11718 "parser.c" break; case 1241: -#line 6454 "parser.y" +#line 6442 "parser.y" { current_statement->handler_id = COB_EC_IMP_ACCEPT; } -#line 11738 "parser.c" +#line 11726 "parser.c" break; case 1242: -#line 6462 "parser.y" +#line 6450 "parser.y" { current_statement->handler_id = COB_EC_IMP_DISPLAY; } -#line 11746 "parser.c" +#line 11734 "parser.c" break; case 1244: -#line 6469 "parser.y" +#line 6457 "parser.y" { check_unreached = 0; } -#line 11754 "parser.c" +#line 11742 "parser.c" break; case 1245: -#line 6473 "parser.y" +#line 6461 "parser.y" { current_statement->handler1 = yyvsp[0]; } -#line 11762 "parser.c" +#line 11750 "parser.c" break; case 1247: -#line 6480 "parser.y" +#line 6468 "parser.y" { check_unreached = 0; } -#line 11770 "parser.c" +#line 11758 "parser.c" break; case 1248: -#line 6484 "parser.y" +#line 6472 "parser.y" { current_statement->handler2 = yyvsp[0]; } -#line 11778 "parser.c" +#line 11766 "parser.c" break; case 1251: -#line 6500 "parser.y" +#line 6488 "parser.y" { check_unreached = 0; current_statement->handler_id = COB_EC_SIZE; } -#line 11787 "parser.c" +#line 11775 "parser.c" break; case 1252: -#line 6505 "parser.y" +#line 6493 "parser.y" { current_statement->handler1 = yyvsp[0]; } -#line 11795 "parser.c" +#line 11783 "parser.c" break; case 1254: -#line 6512 "parser.y" +#line 6500 "parser.y" { check_unreached = 0; current_statement->handler_id = COB_EC_SIZE; } -#line 11804 "parser.c" +#line 11792 "parser.c" break; case 1255: -#line 6517 "parser.y" +#line 6505 "parser.y" { current_statement->handler2 = yyvsp[0]; } -#line 11812 "parser.c" +#line 11800 "parser.c" break; case 1256: -#line 6529 "parser.y" +#line 6517 "parser.y" { current_statement->handler_id = COB_EC_OVERFLOW; } -#line 11820 "parser.c" +#line 11808 "parser.c" break; case 1258: -#line 6536 "parser.y" +#line 6524 "parser.y" { check_unreached = 0; } -#line 11828 "parser.c" +#line 11816 "parser.c" break; case 1259: -#line 6540 "parser.y" +#line 6528 "parser.y" { current_statement->handler1 = yyvsp[0]; } -#line 11836 "parser.c" +#line 11824 "parser.c" break; case 1261: -#line 6547 "parser.y" +#line 6535 "parser.y" { check_unreached = 0; } -#line 11844 "parser.c" +#line 11832 "parser.c" break; case 1262: -#line 6551 "parser.y" +#line 6539 "parser.y" { current_statement->handler2 = yyvsp[0]; } -#line 11852 "parser.c" +#line 11840 "parser.c" break; case 1263: -#line 6563 "parser.y" +#line 6551 "parser.y" { current_statement->handler_id = COB_EC_I_O_AT_END; current_statement->handler1 = yyvsp[0]; } -#line 11861 "parser.c" +#line 11849 "parser.c" break; case 1264: -#line 6568 "parser.y" +#line 6556 "parser.y" { current_statement->handler_id = COB_EC_I_O_AT_END; current_statement->handler2 = yyvsp[0]; } -#line 11870 "parser.c" +#line 11858 "parser.c" break; case 1265: -#line 6573 "parser.y" +#line 6561 "parser.y" { current_statement->handler_id = COB_EC_I_O_AT_END; current_statement->handler1 = yyvsp[-1]; current_statement->handler2 = yyvsp[0]; } -#line 11880 "parser.c" +#line 11868 "parser.c" break; case 1266: -#line 6582 "parser.y" +#line 6570 "parser.y" { check_unreached = 0; } -#line 11888 "parser.c" +#line 11876 "parser.c" break; case 1267: -#line 6586 "parser.y" +#line 6574 "parser.y" { yyval = yyvsp[0]; } -#line 11896 "parser.c" +#line 11884 "parser.c" break; case 1268: -#line 6593 "parser.y" +#line 6581 "parser.y" { check_unreached = 0; } -#line 11904 "parser.c" +#line 11892 "parser.c" break; case 1269: -#line 6597 "parser.y" +#line 6585 "parser.y" { yyval = yyvsp[0]; } -#line 11912 "parser.c" +#line 11900 "parser.c" break; case 1270: -#line 6609 "parser.y" +#line 6597 "parser.y" { current_statement->handler_id = COB_EC_I_O_EOP; current_statement->handler1 = yyvsp[0]; } -#line 11921 "parser.c" +#line 11909 "parser.c" break; case 1271: -#line 6614 "parser.y" +#line 6602 "parser.y" { current_statement->handler_id = COB_EC_I_O_EOP; current_statement->handler2 = yyvsp[0]; } -#line 11930 "parser.c" +#line 11918 "parser.c" break; case 1272: -#line 6619 "parser.y" +#line 6607 "parser.y" { current_statement->handler_id = COB_EC_I_O_EOP; current_statement->handler1 = yyvsp[-1]; current_statement->handler2 = yyvsp[0]; } -#line 11940 "parser.c" +#line 11928 "parser.c" break; case 1273: -#line 6628 "parser.y" +#line 6616 "parser.y" { check_unreached = 0; } -#line 11948 "parser.c" +#line 11936 "parser.c" break; case 1274: -#line 6632 "parser.y" +#line 6620 "parser.y" { yyval = yyvsp[0]; } -#line 11956 "parser.c" +#line 11944 "parser.c" break; case 1275: -#line 6639 "parser.y" +#line 6627 "parser.y" { check_unreached = 0; } -#line 11964 "parser.c" +#line 11952 "parser.c" break; case 1276: -#line 6643 "parser.y" +#line 6631 "parser.y" { yyval = yyvsp[0]; } -#line 11972 "parser.c" +#line 11960 "parser.c" break; case 1279: -#line 6659 "parser.y" +#line 6647 "parser.y" { current_statement->handler_id = COB_EC_I_O_INVALID_KEY; current_statement->handler1 = yyvsp[0]; } -#line 11981 "parser.c" +#line 11969 "parser.c" break; case 1280: -#line 6664 "parser.y" +#line 6652 "parser.y" { current_statement->handler_id = COB_EC_I_O_INVALID_KEY; current_statement->handler2 = yyvsp[0]; } -#line 11990 "parser.c" +#line 11978 "parser.c" break; case 1281: -#line 6669 "parser.y" +#line 6657 "parser.y" { current_statement->handler_id = COB_EC_I_O_INVALID_KEY; current_statement->handler1 = yyvsp[-1]; current_statement->handler2 = yyvsp[0]; } -#line 12000 "parser.c" +#line 11988 "parser.c" break; case 1282: -#line 6678 "parser.y" +#line 6666 "parser.y" { check_unreached = 0; } -#line 12008 "parser.c" +#line 11996 "parser.c" break; case 1283: -#line 6682 "parser.y" +#line 6670 "parser.y" { yyval = yyvsp[0]; } -#line 12016 "parser.c" +#line 12004 "parser.c" break; case 1284: -#line 6689 "parser.y" +#line 6677 "parser.y" { check_unreached = 0; } -#line 12024 "parser.c" +#line 12012 "parser.c" break; case 1285: -#line 6693 "parser.y" +#line 6681 "parser.y" { yyval = yyvsp[0]; } -#line 12032 "parser.c" +#line 12020 "parser.c" break; case 1286: -#line 6705 "parser.y" +#line 6693 "parser.y" { yyval = cb_one; } -#line 12040 "parser.c" +#line 12028 "parser.c" break; case 1287: -#line 6709 "parser.y" +#line 6697 "parser.y" { yyval = yyvsp[-1]; } -#line 12048 "parser.c" +#line 12036 "parser.c" break; case 1288: -#line 6721 "parser.y" +#line 6709 "parser.y" { yyval = cb_build_cond (yyvsp[0]); } -#line 12056 "parser.c" +#line 12044 "parser.c" break; case 1289: -#line 6728 "parser.y" +#line 6716 "parser.y" { yyval = cb_build_expr (yyvsp[0]); } -#line 12064 "parser.c" +#line 12052 "parser.c" break; case 1290: -#line 6734 "parser.y" +#line 6722 "parser.y" { current_expr = NULL; } -#line 12072 "parser.c" +#line 12060 "parser.c" break; case 1291: -#line 6738 "parser.y" +#line 6726 "parser.y" { yyval = cb_list_reverse (current_expr); } -#line 12080 "parser.c" +#line 12068 "parser.c" break; case 1292: -#line 6744 "parser.y" +#line 6732 "parser.y" { push_expr ('x', yyvsp[0]); } -#line 12086 "parser.c" +#line 12074 "parser.c" break; case 1293: -#line 6745 "parser.y" +#line 6733 "parser.y" { push_expr (')', NULL); } -#line 12092 "parser.c" +#line 12080 "parser.c" break; case 1294: -#line 6747 "parser.y" +#line 6735 "parser.y" { push_expr ('O', NULL); } -#line 12098 "parser.c" +#line 12086 "parser.c" break; case 1295: -#line 6748 "parser.y" +#line 6736 "parser.y" { push_expr ('9', NULL); } -#line 12104 "parser.c" +#line 12092 "parser.c" break; case 1296: -#line 6749 "parser.y" +#line 6737 "parser.y" { push_expr ('A', NULL); } -#line 12110 "parser.c" +#line 12098 "parser.c" break; case 1297: -#line 6750 "parser.y" +#line 6738 "parser.y" { push_expr ('L', NULL); } -#line 12116 "parser.c" +#line 12104 "parser.c" break; case 1298: -#line 6751 "parser.y" +#line 6739 "parser.y" { push_expr ('U', NULL); } -#line 12122 "parser.c" +#line 12110 "parser.c" break; case 1299: -#line 6752 "parser.y" +#line 6740 "parser.y" { push_expr ('x', yyvsp[0]); } -#line 12128 "parser.c" +#line 12116 "parser.c" break; case 1300: -#line 6754 "parser.y" +#line 6742 "parser.y" { push_expr ('O', NULL); } -#line 12134 "parser.c" +#line 12122 "parser.c" break; case 1301: -#line 6755 "parser.y" +#line 6743 "parser.y" { push_expr ('9', NULL); } -#line 12140 "parser.c" +#line 12128 "parser.c" break; case 1302: -#line 6756 "parser.y" +#line 6744 "parser.y" { push_expr ('A', NULL); } -#line 12146 "parser.c" +#line 12134 "parser.c" break; case 1303: -#line 6757 "parser.y" +#line 6745 "parser.y" { push_expr ('L', NULL); } -#line 12152 "parser.c" +#line 12140 "parser.c" break; case 1304: -#line 6758 "parser.y" +#line 6746 "parser.y" { push_expr ('U', NULL); } -#line 12158 "parser.c" +#line 12146 "parser.c" break; case 1305: -#line 6759 "parser.y" +#line 6747 "parser.y" { push_expr ('x', yyvsp[0]); } -#line 12164 "parser.c" +#line 12152 "parser.c" break; case 1306: -#line 6761 "parser.y" +#line 6749 "parser.y" { push_expr ('P', NULL); } -#line 12170 "parser.c" +#line 12158 "parser.c" break; case 1307: -#line 6762 "parser.y" +#line 6750 "parser.y" { push_expr ('N', NULL); } -#line 12176 "parser.c" +#line 12164 "parser.c" break; case 1308: -#line 6764 "parser.y" +#line 6752 "parser.y" { push_expr ('P', NULL); } -#line 12182 "parser.c" +#line 12170 "parser.c" break; case 1309: -#line 6765 "parser.y" +#line 6753 "parser.y" { push_expr ('N', NULL); } -#line 12188 "parser.c" +#line 12176 "parser.c" break; case 1310: -#line 6766 "parser.y" +#line 6754 "parser.y" { push_expr ('x', cb_zero); } -#line 12194 "parser.c" +#line 12182 "parser.c" break; case 1314: -#line 6773 "parser.y" +#line 6761 "parser.y" { push_expr ('(', NULL); } -#line 12200 "parser.c" +#line 12188 "parser.c" break; case 1315: -#line 6775 "parser.y" +#line 6763 "parser.y" { push_expr ('+', NULL); } -#line 12206 "parser.c" +#line 12194 "parser.c" break; case 1316: -#line 6776 "parser.y" +#line 6764 "parser.y" { push_expr ('-', NULL); } -#line 12212 "parser.c" +#line 12200 "parser.c" break; case 1317: -#line 6777 "parser.y" +#line 6765 "parser.y" { push_expr ('^', NULL); } -#line 12218 "parser.c" +#line 12206 "parser.c" break; case 1318: -#line 6779 "parser.y" +#line 6767 "parser.y" { push_expr ('!', NULL); } -#line 12224 "parser.c" +#line 12212 "parser.c" break; case 1319: -#line 6780 "parser.y" +#line 6768 "parser.y" { push_expr ('!', NULL); } -#line 12230 "parser.c" +#line 12218 "parser.c" break; case 1320: -#line 6782 "parser.y" +#line 6770 "parser.y" { push_expr ('+', NULL); } -#line 12236 "parser.c" +#line 12224 "parser.c" break; case 1321: -#line 6783 "parser.y" +#line 6771 "parser.y" { push_expr ('-', NULL); } -#line 12242 "parser.c" +#line 12230 "parser.c" break; case 1322: -#line 6784 "parser.y" +#line 6772 "parser.y" { push_expr ('*', NULL); } -#line 12248 "parser.c" +#line 12236 "parser.c" break; case 1323: -#line 6785 "parser.y" +#line 6773 "parser.y" { push_expr ('/', NULL); } -#line 12254 "parser.c" +#line 12242 "parser.c" break; case 1324: -#line 6786 "parser.y" +#line 6774 "parser.y" { push_expr ('^', NULL); } -#line 12260 "parser.c" +#line 12248 "parser.c" break; case 1325: -#line 6788 "parser.y" +#line 6776 "parser.y" { push_expr ('=', NULL); } -#line 12266 "parser.c" +#line 12254 "parser.c" break; case 1326: -#line 6789 "parser.y" +#line 6777 "parser.y" { push_expr ('>', NULL); } -#line 12272 "parser.c" +#line 12260 "parser.c" break; case 1327: -#line 6790 "parser.y" +#line 6778 "parser.y" { push_expr ('<', NULL); } -#line 12278 "parser.c" +#line 12266 "parser.c" break; case 1328: -#line 6791 "parser.y" +#line 6779 "parser.y" { push_expr (']', NULL); } -#line 12284 "parser.c" +#line 12272 "parser.c" break; case 1329: -#line 6792 "parser.y" +#line 6780 "parser.y" { push_expr ('[', NULL); } -#line 12290 "parser.c" +#line 12278 "parser.c" break; case 1330: -#line 6793 "parser.y" +#line 6781 "parser.y" { push_expr ('~', NULL); } -#line 12296 "parser.c" +#line 12284 "parser.c" break; case 1331: -#line 6795 "parser.y" +#line 6783 "parser.y" { push_expr ('=', NULL); } -#line 12302 "parser.c" +#line 12290 "parser.c" break; case 1332: -#line 6796 "parser.y" +#line 6784 "parser.y" { push_expr ('>', NULL); } -#line 12308 "parser.c" +#line 12296 "parser.c" break; case 1333: -#line 6797 "parser.y" +#line 6785 "parser.y" { push_expr ('<', NULL); } -#line 12314 "parser.c" +#line 12302 "parser.c" break; case 1334: -#line 6798 "parser.y" +#line 6786 "parser.y" { push_expr (']', NULL); } -#line 12320 "parser.c" +#line 12308 "parser.c" break; case 1335: -#line 6799 "parser.y" +#line 6787 "parser.y" { push_expr ('[', NULL); } -#line 12326 "parser.c" +#line 12314 "parser.c" break; case 1336: -#line 6800 "parser.y" +#line 6788 "parser.y" { push_expr ('~', NULL); } -#line 12332 "parser.c" +#line 12320 "parser.c" break; case 1337: -#line 6802 "parser.y" +#line 6790 "parser.y" { push_expr ('&', NULL); } -#line 12338 "parser.c" +#line 12326 "parser.c" break; case 1338: -#line 6803 "parser.y" +#line 6791 "parser.y" { push_expr ('|', NULL); } -#line 12344 "parser.c" +#line 12332 "parser.c" break; case 1352: -#line 6815 "parser.y" +#line 6803 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 12350 "parser.c" +#line 12338 "parser.c" break; case 1353: -#line 6816 "parser.y" +#line 6804 "parser.y" { yyval = cb_list_add (yyvsp[-2], yyvsp[0]); } -#line 12356 "parser.c" +#line 12344 "parser.c" break; case 1357: -#line 6825 "parser.y" +#line 6813 "parser.y" { yyval = yyvsp[0]; } -#line 12362 "parser.c" +#line 12350 "parser.c" break; case 1358: -#line 6826 "parser.y" +#line 6814 "parser.y" { yyval = cb_build_binary_op (yyvsp[-2], '+', yyvsp[0]); } -#line 12368 "parser.c" +#line 12356 "parser.c" break; case 1359: -#line 6827 "parser.y" +#line 6815 "parser.y" { yyval = cb_build_binary_op (yyvsp[-2], '-', yyvsp[0]); } -#line 12374 "parser.c" +#line 12362 "parser.c" break; case 1360: -#line 6828 "parser.y" +#line 6816 "parser.y" { yyval = cb_build_binary_op (yyvsp[-2], '*', yyvsp[0]); } -#line 12380 "parser.c" +#line 12368 "parser.c" break; case 1361: -#line 6829 "parser.y" +#line 6817 "parser.y" { yyval = cb_build_binary_op (yyvsp[-2], '/', yyvsp[0]); } -#line 12386 "parser.c" +#line 12374 "parser.c" break; case 1362: -#line 6830 "parser.y" +#line 6818 "parser.y" { yyval = yyvsp[0]; } -#line 12392 "parser.c" +#line 12380 "parser.c" break; case 1363: -#line 6831 "parser.y" +#line 6819 "parser.y" { yyval = cb_build_binary_op (cb_zero, '-', yyvsp[0]); } -#line 12398 "parser.c" +#line 12386 "parser.c" break; case 1364: -#line 6832 "parser.y" +#line 6820 "parser.y" { yyval = cb_build_binary_op (yyvsp[-2], '^', yyvsp[0]); } -#line 12404 "parser.c" +#line 12392 "parser.c" break; case 1365: -#line 6833 "parser.y" +#line 6821 "parser.y" { yyval = yyvsp[-1]; } -#line 12410 "parser.c" +#line 12398 "parser.c" break; case 1366: -#line 6845 "parser.y" +#line 6833 "parser.y" { if (current_linage > 1) { cb_error (_("LINAGE-COUNTER must be qualified here")); @@ -12422,11 +12410,11 @@ yyparse (void) yyval = linage_file->linage_ctr; } } -#line 12426 "parser.c" +#line 12414 "parser.c" break; case 1367: -#line 6857 "parser.y" +#line 6845 "parser.y" { if (CB_FILE_P (cb_ref (yyvsp[0]))) { yyval = CB_FILE (cb_ref (yyvsp[0]))->linage_ctr; @@ -12435,29 +12423,29 @@ yyparse (void) yyval = cb_error_node; } } -#line 12439 "parser.c" +#line 12427 "parser.c" break; case 1368: -#line 6871 "parser.y" +#line 6859 "parser.y" { yyval = yyvsp[0]; } -#line 12445 "parser.c" +#line 12433 "parser.c" break; case 1369: -#line 6873 "parser.y" +#line 6861 "parser.y" { yyval = cb_list_append (yyvsp[-1], yyvsp[0]); } -#line 12451 "parser.c" +#line 12439 "parser.c" break; case 1370: -#line 6877 "parser.y" +#line 6865 "parser.y" { yyval = cb_build_pair (yyvsp[0], yyvsp[-1]); } -#line 12457 "parser.c" +#line 12445 "parser.c" break; case 1371: -#line 6884 "parser.y" +#line 6872 "parser.y" { cb_tree x; cb_tree r; @@ -12474,11 +12462,11 @@ yyparse (void) } yyval = x; } -#line 12478 "parser.c" +#line 12466 "parser.c" break; case 1372: -#line 6906 "parser.y" +#line 6894 "parser.y" { cb_tree x; @@ -12493,19 +12481,19 @@ yyparse (void) yyval = yyvsp[0]; } } -#line 12497 "parser.c" +#line 12485 "parser.c" break; case 1373: -#line 6926 "parser.y" +#line 6914 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 12505 "parser.c" +#line 12493 "parser.c" break; case 1374: -#line 6930 "parser.y" +#line 6918 "parser.y" { cb_tree l; @@ -12518,11 +12506,11 @@ yyparse (void) yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } } -#line 12522 "parser.c" +#line 12510 "parser.c" break; case 1375: -#line 6946 "parser.y" +#line 6934 "parser.y" { if (CB_FILE_P (cb_ref (yyvsp[0]))) { yyval = yyvsp[0]; @@ -12531,106 +12519,106 @@ yyparse (void) yyval = cb_error_node; } } -#line 12535 "parser.c" +#line 12523 "parser.c" break; case 1376: -#line 6959 "parser.y" +#line 6947 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 12541 "parser.c" +#line 12529 "parser.c" break; case 1377: -#line 6961 "parser.y" +#line 6949 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 12547 "parser.c" +#line 12535 "parser.c" break; case 1378: -#line 6965 "parser.y" +#line 6953 "parser.y" { yyval = yyvsp[0]; } -#line 12553 "parser.c" +#line 12541 "parser.c" break; case 1379: -#line 6971 "parser.y" +#line 6959 "parser.y" { yyval = NULL; } -#line 12559 "parser.c" +#line 12547 "parser.c" break; case 1380: -#line 6973 "parser.y" +#line 6961 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 12565 "parser.c" +#line 12553 "parser.c" break; case 1381: -#line 6978 "parser.y" +#line 6966 "parser.y" { yyval = yyvsp[0]; CB_REFERENCE (yyval)->offset = CB_TREE (current_section); current_program->label_list = cb_cons (yyval, current_program->label_list); } -#line 12575 "parser.c" +#line 12563 "parser.c" break; case 1385: -#line 6993 "parser.y" +#line 6981 "parser.y" { yyval = cb_build_reference ((char *)(CB_LITERAL (yyvsp[0])->data)); yyval->source_file = yyvsp[0]->source_file; yyval->source_line = yyvsp[0]->source_line; } -#line 12585 "parser.c" +#line 12573 "parser.c" break; case 1386: -#line 7003 "parser.y" +#line 6991 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 12591 "parser.c" +#line 12579 "parser.c" break; case 1387: -#line 7004 "parser.y" +#line 6992 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 12597 "parser.c" +#line 12585 "parser.c" break; case 1388: -#line 7009 "parser.y" +#line 6997 "parser.y" { yyval = yyvsp[0]; current_program->reference_list = cb_cons (yyval, current_program->reference_list); } -#line 12606 "parser.c" +#line 12594 "parser.c" break; case 1389: -#line 7018 "parser.y" +#line 7006 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 12612 "parser.c" +#line 12600 "parser.c" break; case 1390: -#line 7019 "parser.y" +#line 7007 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 12618 "parser.c" +#line 12606 "parser.c" break; case 1391: -#line 7023 "parser.y" +#line 7011 "parser.y" { yyval = NULL; } -#line 12624 "parser.c" +#line 12612 "parser.c" break; case 1392: -#line 7024 "parser.y" +#line 7012 "parser.y" { yyval = yyvsp[0]; } -#line 12630 "parser.c" +#line 12618 "parser.c" break; case 1395: -#line 7036 "parser.y" +#line 7024 "parser.y" { yyval = yyvsp[0]; if (CB_REFERENCE (yyval)->word->count > 0) { @@ -12638,160 +12626,160 @@ yyparse (void) yyval = cb_error_node; } } -#line 12642 "parser.c" +#line 12630 "parser.c" break; case 1396: -#line 7055 "parser.y" +#line 7043 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 12648 "parser.c" +#line 12636 "parser.c" break; case 1397: -#line 7056 "parser.y" +#line 7044 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 12654 "parser.c" +#line 12642 "parser.c" break; case 1399: -#line 7061 "parser.y" +#line 7049 "parser.y" { yyval = cb_build_address (yyvsp[0]); } -#line 12660 "parser.c" +#line 12648 "parser.c" break; case 1400: -#line 7065 "parser.y" +#line 7053 "parser.y" { yyval = cb_list_init (yyvsp[0]); } -#line 12666 "parser.c" +#line 12654 "parser.c" break; case 1401: -#line 7066 "parser.y" +#line 7054 "parser.y" { yyval = cb_list_add (yyvsp[-1], yyvsp[0]); } -#line 12672 "parser.c" +#line 12660 "parser.c" break; case 1403: -#line 7071 "parser.y" +#line 7059 "parser.y" { yyval = cb_build_length (yyvsp[0]); } -#line 12678 "parser.c" +#line 12666 "parser.c" break; case 1404: -#line 7072 "parser.y" +#line 7060 "parser.y" { yyval = cb_build_length (yyvsp[0]); } -#line 12684 "parser.c" +#line 12672 "parser.c" break; case 1405: -#line 7073 "parser.y" +#line 7061 "parser.y" { yyval = cb_build_length (yyvsp[0]); } -#line 12690 "parser.c" +#line 12678 "parser.c" break; case 1406: -#line 7074 "parser.y" +#line 7062 "parser.y" { yyval = cb_build_ppointer (yyvsp[0]); } -#line 12696 "parser.c" +#line 12684 "parser.c" break; case 1407: -#line 7075 "parser.y" +#line 7063 "parser.y" { yyval = cb_build_address (yyvsp[0]); } -#line 12702 "parser.c" +#line 12690 "parser.c" break; case 1412: -#line 7083 "parser.y" +#line 7071 "parser.y" { yyval = cb_build_length (yyvsp[0]); } -#line 12708 "parser.c" +#line 12696 "parser.c" break; case 1413: -#line 7084 "parser.y" +#line 7072 "parser.y" { yyval = cb_build_length (yyvsp[0]); } -#line 12714 "parser.c" +#line 12702 "parser.c" break; case 1414: -#line 7085 "parser.y" +#line 7073 "parser.y" { yyval = cb_build_length (yyvsp[0]); } -#line 12720 "parser.c" +#line 12708 "parser.c" break; case 1420: -#line 7097 "parser.y" +#line 7085 "parser.y" { yyval = yyvsp[0]; } -#line 12726 "parser.c" +#line 12714 "parser.c" break; case 1421: -#line 7098 "parser.y" +#line 7086 "parser.y" { yyval = yyvsp[0]; } -#line 12732 "parser.c" +#line 12720 "parser.c" break; case 1433: -#line 7132 "parser.y" +#line 7120 "parser.y" { yyval = cb_zero; } -#line 12738 "parser.c" +#line 12726 "parser.c" break; case 1434: -#line 7140 "parser.y" +#line 7128 "parser.y" { yyval = cb_build_identifier (yyvsp[0]); } -#line 12744 "parser.c" +#line 12732 "parser.c" break; case 1435: -#line 7144 "parser.y" +#line 7132 "parser.y" { yyval = yyvsp[0]; } -#line 12750 "parser.c" +#line 12738 "parser.c" break; case 1436: -#line 7145 "parser.y" +#line 7133 "parser.y" { yyval = yyvsp[-1]; } -#line 12756 "parser.c" +#line 12744 "parser.c" break; case 1437: -#line 7146 "parser.y" +#line 7134 "parser.y" { yyval = yyvsp[-1]; } -#line 12762 "parser.c" +#line 12750 "parser.c" break; case 1438: -#line 7147 "parser.y" +#line 7135 "parser.y" { yyval = yyvsp[-2]; } -#line 12768 "parser.c" +#line 12756 "parser.c" break; case 1439: -#line 7151 "parser.y" +#line 7139 "parser.y" { yyval = yyvsp[0]; } -#line 12774 "parser.c" +#line 12762 "parser.c" break; case 1440: -#line 7152 "parser.y" +#line 7140 "parser.y" { yyval = yyvsp[-2]; CB_REFERENCE (yyvsp[-2])->chain = yyvsp[0]; } -#line 12780 "parser.c" +#line 12768 "parser.c" break; case 1441: -#line 7157 "parser.y" +#line 7145 "parser.y" { if (cb_ref (yyvsp[-3]) != cb_error_node) { yyval = yyvsp[-3]; CB_REFERENCE (yyvsp[-3])->subs = cb_list_reverse (yyvsp[-1]); } } -#line 12791 "parser.c" +#line 12779 "parser.c" break; case 1442: -#line 7167 "parser.y" +#line 7155 "parser.y" { if (cb_ref (yyvsp[-4]) != cb_error_node) { CB_REFERENCE (yyvsp[-4])->value = CB_TREE (cb_field (yyvsp[-4])); @@ -12809,11 +12797,11 @@ yyparse (void) CB_REFERENCE (yyvsp[-4])->offset = yyvsp[-2]; } } -#line 12813 "parser.c" +#line 12801 "parser.c" break; case 1443: -#line 7185 "parser.y" +#line 7173 "parser.y" { if (cb_ref (yyvsp[-5]) != cb_error_node) { CB_REFERENCE (yyvsp[-5])->value = CB_TREE (cb_field (yyvsp[-5])); @@ -12833,11 +12821,11 @@ yyparse (void) CB_REFERENCE (yyvsp[-5])->length = yyvsp[-1]; } } -#line 12837 "parser.c" +#line 12825 "parser.c" break; case 1444: -#line 7212 "parser.y" +#line 7200 "parser.y" { if (cb_tree_category (yyvsp[0]) != CB_CATEGORY_NUMERIC) { cb_error (_("Integer value expected")); @@ -12846,437 +12834,437 @@ yyparse (void) } yyval = yyvsp[0]; } -#line 12850 "parser.c" +#line 12838 "parser.c" break; case 1445: -#line 7223 "parser.y" +#line 7211 "parser.y" { yyval = yyvsp[0]; } -#line 12856 "parser.c" +#line 12844 "parser.c" break; case 1446: -#line 7225 "parser.y" +#line 7213 "parser.y" { yyval = yyvsp[0]; if (CB_LITERAL_P (yyvsp[0])) { CB_LITERAL (yyvsp[0])->all = 1; } } -#line 12867 "parser.c" +#line 12855 "parser.c" break; case 1447: -#line 7234 "parser.y" +#line 7222 "parser.y" { yyval = yyvsp[0]; } -#line 12873 "parser.c" +#line 12861 "parser.c" break; case 1448: -#line 7235 "parser.y" +#line 7223 "parser.y" { yyval = cb_concat_literals (yyvsp[-2], yyvsp[0]); } -#line 12879 "parser.c" +#line 12867 "parser.c" break; case 1449: -#line 7239 "parser.y" +#line 7227 "parser.y" { yyval = yyvsp[0]; } -#line 12885 "parser.c" +#line 12873 "parser.c" break; case 1450: -#line 7240 "parser.y" +#line 7228 "parser.y" { yyval = cb_space; } -#line 12891 "parser.c" +#line 12879 "parser.c" break; case 1451: -#line 7241 "parser.y" +#line 7229 "parser.y" { yyval = cb_zero; } -#line 12897 "parser.c" +#line 12885 "parser.c" break; case 1452: -#line 7242 "parser.y" +#line 7230 "parser.y" { yyval = cb_quote; } -#line 12903 "parser.c" +#line 12891 "parser.c" break; case 1453: -#line 7243 "parser.y" +#line 7231 "parser.y" { yyval = cb_high; } -#line 12909 "parser.c" +#line 12897 "parser.c" break; case 1454: -#line 7244 "parser.y" +#line 7232 "parser.y" { yyval = cb_low; } -#line 12915 "parser.c" +#line 12903 "parser.c" break; case 1455: -#line 7245 "parser.y" +#line 7233 "parser.y" { yyval = cb_null; } -#line 12921 "parser.c" +#line 12909 "parser.c" break; case 1456: -#line 7254 "parser.y" +#line 7242 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-1], NULL, yyvsp[0]); } -#line 12929 "parser.c" +#line 12917 "parser.c" break; case 1457: -#line 7258 "parser.y" +#line 7246 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-1], NULL, yyvsp[0]); } -#line 12937 "parser.c" +#line 12925 "parser.c" break; case 1458: -#line 7262 "parser.y" +#line 7250 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-4], cb_list_init (yyvsp[-2]), yyvsp[0]); } -#line 12945 "parser.c" +#line 12933 "parser.c" break; case 1459: -#line 7266 "parser.y" +#line 7254 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-4], cb_list_init (yyvsp[-2]), yyvsp[0]); } -#line 12953 "parser.c" +#line 12941 "parser.c" break; case 1460: -#line 7270 "parser.y" +#line 7258 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-4], cb_list_init (yyvsp[-2]), yyvsp[0]); } -#line 12961 "parser.c" +#line 12949 "parser.c" break; case 1461: -#line 7274 "parser.y" +#line 7262 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-4], yyvsp[-2], yyvsp[0]); } -#line 12969 "parser.c" +#line 12957 "parser.c" break; case 1462: -#line 7278 "parser.y" +#line 7266 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-4], yyvsp[-2], yyvsp[0]); } -#line 12977 "parser.c" +#line 12965 "parser.c" break; case 1463: -#line 7282 "parser.y" +#line 7270 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-4], yyvsp[-2], yyvsp[0]); } -#line 12985 "parser.c" +#line 12973 "parser.c" break; case 1464: -#line 7286 "parser.y" +#line 7274 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-4], yyvsp[-2], yyvsp[0]); } -#line 12993 "parser.c" +#line 12981 "parser.c" break; case 1465: -#line 7290 "parser.y" +#line 7278 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-3], yyvsp[-1], NULL); } -#line 13001 "parser.c" +#line 12989 "parser.c" break; case 1466: -#line 7294 "parser.y" +#line 7282 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-4], yyvsp[-2], yyvsp[0]); } -#line 13009 "parser.c" +#line 12997 "parser.c" break; case 1467: -#line 7298 "parser.y" +#line 7286 "parser.y" { yyval = cb_build_intrinsic (yyvsp[-1], yyvsp[0], NULL); } -#line 13017 "parser.c" +#line 13005 "parser.c" break; case 1468: -#line 7304 "parser.y" +#line 7292 "parser.y" { yyval = NULL; } -#line 13023 "parser.c" +#line 13011 "parser.c" break; case 1469: -#line 7305 "parser.y" +#line 7293 "parser.y" { yyval = cb_build_pair (yyvsp[-2], NULL); } -#line 13029 "parser.c" +#line 13017 "parser.c" break; case 1470: -#line 7306 "parser.y" +#line 7294 "parser.y" { yyval = cb_build_pair (yyvsp[-3], yyvsp[-1]); } -#line 13035 "parser.c" +#line 13023 "parser.c" break; case 1471: -#line 7310 "parser.y" +#line 7298 "parser.y" { yyval = NULL; } -#line 13041 "parser.c" +#line 13029 "parser.c" break; case 1472: -#line 7311 "parser.y" +#line 7299 "parser.y" { yyval = yyvsp[-1]; } -#line 13047 "parser.c" +#line 13035 "parser.c" break; case 1473: -#line 7315 "parser.y" +#line 7303 "parser.y" { yyval = NULL; } -#line 13053 "parser.c" +#line 13041 "parser.c" break; case 1474: -#line 7316 "parser.y" +#line 7304 "parser.y" { yyval = yyvsp[0]; } -#line 13059 "parser.c" +#line 13047 "parser.c" break; case 1475: -#line 7322 "parser.y" +#line 7310 "parser.y" { cb_tree x; x = cb_list_init (yyvsp[0]); yyval = cb_list_add (x, cb_int0); } -#line 13070 "parser.c" +#line 13058 "parser.c" break; case 1476: -#line 7329 "parser.y" +#line 7317 "parser.y" { cb_tree x; x = cb_list_init (yyvsp[-2]); yyval = cb_list_add (x, cb_int1); } -#line 13081 "parser.c" +#line 13069 "parser.c" break; case 1477: -#line 7336 "parser.y" +#line 7324 "parser.y" { cb_tree x; x = cb_list_init (yyvsp[-2]); yyval = cb_list_add (x, cb_int2); } -#line 13092 "parser.c" +#line 13080 "parser.c" break; case 1478: -#line 7346 "parser.y" +#line 7334 "parser.y" { cb_tree x; x = cb_list_init (yyvsp[0]); yyval = cb_list_add (x, cb_null); } -#line 13103 "parser.c" +#line 13091 "parser.c" break; case 1479: -#line 7353 "parser.y" +#line 7341 "parser.y" { cb_tree x; x = cb_list_init (yyvsp[-2]); yyval = cb_list_add (x, yyvsp[0]); } -#line 13114 "parser.c" +#line 13102 "parser.c" break; case 1480: -#line 7363 "parser.y" +#line 7351 "parser.y" { cb_tree x; x = cb_list_init (yyvsp[0]); yyval = cb_list_add (x, cb_null); } -#line 13125 "parser.c" +#line 13113 "parser.c" break; case 1481: -#line 7370 "parser.y" +#line 7358 "parser.y" { cb_tree x; x = cb_list_init (yyvsp[-2]); yyval = cb_list_add (x, cb_ref (yyvsp[0])); } -#line 13136 "parser.c" +#line 13124 "parser.c" break; case 1482: -#line 7383 "parser.y" +#line 7371 "parser.y" { non_const_word = 1; } -#line 13144 "parser.c" +#line 13132 "parser.c" break; case 1483: -#line 7393 "parser.y" +#line 7381 "parser.y" { yyval = cb_int0; } -#line 13150 "parser.c" +#line 13138 "parser.c" break; case 1484: -#line 7394 "parser.y" +#line 7382 "parser.y" { yyval = cb_int1; } -#line 13156 "parser.c" +#line 13144 "parser.c" break; case 1485: -#line 7398 "parser.y" +#line 7386 "parser.y" { yyval = cb_int0; } -#line 13162 "parser.c" +#line 13150 "parser.c" break; case 1486: -#line 7399 "parser.y" +#line 7387 "parser.y" { yyval = cb_int1; } -#line 13168 "parser.c" +#line 13156 "parser.c" break; case 1487: -#line 7403 "parser.y" +#line 7391 "parser.y" { yyval = NULL; } -#line 13174 "parser.c" +#line 13162 "parser.c" break; case 1488: -#line 7404 "parser.y" +#line 7392 "parser.y" { yyval = cb_int1; } -#line 13180 "parser.c" +#line 13168 "parser.c" break; case 1489: -#line 7408 "parser.y" +#line 7396 "parser.y" { yyval = cb_int0; } -#line 13186 "parser.c" +#line 13174 "parser.c" break; case 1490: -#line 7409 "parser.y" +#line 7397 "parser.y" { yyval = cb_int1; } -#line 13192 "parser.c" +#line 13180 "parser.c" break; case 1491: -#line 7410 "parser.y" +#line 7398 "parser.y" { yyval = cb_int2; } -#line 13198 "parser.c" +#line 13186 "parser.c" break; case 1492: -#line 7414 "parser.y" +#line 7402 "parser.y" { yyval = cb_int0; } -#line 13204 "parser.c" +#line 13192 "parser.c" break; case 1493: -#line 7415 "parser.y" +#line 7403 "parser.y" { yyval = cb_int1; } -#line 13210 "parser.c" +#line 13198 "parser.c" break; case 1494: -#line 7419 "parser.y" +#line 7407 "parser.y" { yyval = cb_int0; } -#line 13216 "parser.c" +#line 13204 "parser.c" break; case 1495: -#line 7420 "parser.y" +#line 7408 "parser.y" { yyval = cb_int1; } -#line 13222 "parser.c" +#line 13210 "parser.c" break; case 1496: -#line 7424 "parser.y" +#line 7412 "parser.y" { yyval = cb_int0; } -#line 13228 "parser.c" +#line 13216 "parser.c" break; case 1497: -#line 7425 "parser.y" +#line 7413 "parser.y" { yyval = cb_int1; } -#line 13234 "parser.c" +#line 13222 "parser.c" break; case 1498: -#line 7429 "parser.y" +#line 7417 "parser.y" { yyval = cb_int0; } -#line 13240 "parser.c" +#line 13228 "parser.c" break; case 1499: -#line 7430 "parser.y" +#line 7418 "parser.y" { yyval = cb_int1; } -#line 13246 "parser.c" +#line 13234 "parser.c" break; case 1511: -#line 7443 "parser.y" +#line 7431 "parser.y" { yyval = cb_int1; } -#line 13252 "parser.c" +#line 13240 "parser.c" break; case 1540: -#line 7458 "parser.y" +#line 7446 "parser.y" { yyval = NULL; } -#line 13258 "parser.c" +#line 13246 "parser.c" break; case 1541: -#line 7458 "parser.y" +#line 7446 "parser.y" { yyval = cb_int1; } -#line 13264 "parser.c" +#line 13252 "parser.c" break; case 1552: -#line 7463 "parser.y" +#line 7451 "parser.y" { yyval = NULL; } -#line 13270 "parser.c" +#line 13258 "parser.c" break; case 1553: -#line 7463 "parser.y" +#line 7451 "parser.y" { yyval = yyvsp[0]; } -#line 13276 "parser.c" +#line 13264 "parser.c" break; -#line 13280 "parser.c" +#line 13268 "parser.c" default: break; } @@ -13508,5 +13496,5 @@ yyparse (void) #endif return yyresult; } -#line 7488 "parser.y" +#line 7476 "parser.y" diff --git a/cobj/parser.y b/cobj/parser.y index b64331c9..9c3121d4 100644 --- a/cobj/parser.y +++ b/cobj/parser.y @@ -4971,12 +4971,6 @@ exit_body: if (!perform_stack) { cb_error (_("EXIT PERFORM is only valid with inline PERFORM")); } else { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (!p->exit_label) { - sprintf (name, "EXIT PERFORM %d", cb_id); - p->exit_label = cb_build_reference (name); - CB_LABEL (cb_build_label (p->exit_label, current_section))->need_begin = 1; - } cb_emit_java_break (); } } @@ -4988,12 +4982,6 @@ exit_body: if (!perform_stack) { cb_error (_("EXIT PERFORM is only valid with inline PERFORM")); } else { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (!p->cycle_label) { - sprintf (name, "EXIT PERFORM CYCLE %d", cb_id); - p->cycle_label = cb_build_reference (name); - CB_LABEL (cb_build_label (p->cycle_label, current_section))->need_begin = 1; - } cb_emit_java_continue (); } } diff --git a/tests/Makefile.am b/tests/Makefile.am index 1a71b87a..bb80ea4e 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -164,7 +164,8 @@ misc_DEPENDENCIES = \ misc.src/move-sign-leading-separate-to-signed-comp3.at \ misc.src/java-interface.at \ misc.src/comp3-int.at \ - misc.src/env.at + misc.src/env.at \ + misc.src/exit-perform.at EXTRA_DIST = $(srcdir)/package.m4 \ $(TESTS) \ diff --git a/tests/misc.at b/tests/misc.at index f42529d3..16a853ef 100644 --- a/tests/misc.at +++ b/tests/misc.at @@ -26,3 +26,4 @@ m4_include([move-sign-leading-separate-to-signed-comp3.at]) m4_include([java-interface.at]) m4_include([comp3-int.at]) m4_include([env.at]) +m4_include([exit-perform.at]) diff --git a/tests/misc.src/exit-perform.at b/tests/misc.src/exit-perform.at new file mode 100644 index 00000000..f5d50789 --- /dev/null +++ b/tests/misc.src/exit-perform.at @@ -0,0 +1,72 @@ +AT_SETUP([exit perform]) +AT_DATA([prog.cbl], [ + identification division. + program-id. prog. + + data division. + + working-storage section. + 01 I PIC 9. + procedure division. + main section. + perform b-proc. + stop run. + + a-proc section. + a-proc-1. + perform varying i from i by 1 until i>4 + display "perform varying " i + exit perform + end-perform. + + b-proc section. + display "b-proc". + b-proc-1. + display "b-proc-1". + b-proc-2. + display "b-proc-2". +]) + +AT_CHECK([${COBJ} prog.cbl]) +AT_CHECK([java prog], [0], +[b-proc +b-proc-1 +b-proc-2 +]) + +AT_DATA([prog2.cbl], [ + identification division. + program-id. prog2. + + data division. + + working-storage section. + 01 I PIC 9. + procedure division. + main section. + perform b-proc. + stop run. + + a-proc section. + a-proc-1. + perform varying i from i by 1 until i>4 + display "perform varying " i + exit perform cycle + end-perform. + + b-proc section. + display "b-proc". + b-proc-1. + display "b-proc-1". + b-proc-2. + display "b-proc-2". +]) + +AT_CHECK([${COBJ} prog2.cbl]) +AT_CHECK([java prog2], [0], +[b-proc +b-proc-1 +b-proc-2 +]) + +AT_CLEANUP From 3193854474c37bdd68c58570e04148ec8d6f6e36 Mon Sep 17 00:00:00 2001 From: Yutaro Sakamoto Date: Tue, 31 Jan 2023 15:07:30 +0900 Subject: [PATCH 17/17] Update NEWS --- NEWS | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/NEWS b/NEWS index 3bb819eb..1a1f3f1a 100644 --- a/NEWS +++ b/NEWS @@ -1,24 +1,24 @@ NEWS - user visible changes -*- outline -*- -* opensource cobol 4J 1.0.7 +* opensource COBOL 4J 1.0.7 ** New Features - (1) Implement DELETE statement of SEQUENTIAL files. - (2) Improve Java interface. + (1) Implement DELETE FILE statement of SEQUENTIAL files and LINE SEQUENTIAL files + (2) Improve Java interface, much better way to call COBOL from Java (3) Add -java-package option (4) Implement SET ENVIRONMENT statement ** Bug fixes - (1) Fix a bug concerning the environment variables COB_OPEN_I_O and COB_OPEN_EXTEND. - (2) Fix the comparsion process of COMP-3 + (1) Fix the bug involved with the environment variables COB_I_O_CREATE and COB_EXTEND_CREATE + (2) Fix the comparison process of COMP-3 (3) Fix EXIT PERFORM and EXIT PERFORM CYCLE ** Miscellaneous - (1) Format all Java source code using Google Java Format + (1) Format all Java source code in libcobj/ using Google Java Format ----------------------------------------------------------------------- -* opensource cobol 4J 1.0.6 +* opensource COBOL 4J 1.0.6 ** New Features (1) Add -fshort-variable option @@ -32,7 +32,7 @@ NEWS - user visible changes -*- outline -*- ----------------------------------------------------------------------- -* opensource cobol 4J 1.0.5 +* opensource COBOL 4J 1.0.5 ** New Features (1) -m option and cobjrun command (an experimental feature) @@ -62,7 +62,7 @@ NEWS - user visible changes -*- outline -*- ----------------------------------------------------------------------- -* opensource cobol 4J 1.0.4 +* opensource COBOL 4J 1.0.4 ** New Features (1) Rename cobc, the compile command, to cobj. @@ -91,14 +91,14 @@ NEWS - user visible changes -*- outline -*- ----------------------------------------------------------------------- -* opensource cobol 4J 1.0.3 +* opensource COBOL 4J 1.0.3 ** New features (1) Change the storage library for indexed file to SQLite. ----------------------------------------------------------------------- -* opensource cobol 4J 1.0.2 +* opensource COBOL 4J 1.0.2 ** New features (1) Upgrade the license to GPL3. @@ -108,14 +108,14 @@ NEWS - user visible changes -*- outline -*- ----------------------------------------------------------------------- -* opensource cobol 4J 1.0.1 +* opensource COBOL 4J 1.0.1 ** Bug fixes (1) Fix the transformation of call arguments ----------------------------------------------------------------------- -* opensource cobol 4J 1.0.0 +* opensource COBOL 4J 1.0.0 ** Bug fixes (1) Fix the status code after opening indexed files.